emacs-19.30/ 40777 12120 1 0 6055530476 11023 5ustar rmsdaemonemacs-19.30/GETTING.GNU.SOFTWARE100664 13035 12 11201 5566513715 13721 0ustar gnustaff-*- text -*- Getting GNU Software, 14 May 94 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc. Permission is granted to anyone to make or distribute verbatim copies of this document provided that the copyright notice and this permission notice are preserved, and that the distributor grants the recipient permission for further redistribution as permitted by this notice. * GNU and the Free Software Foundation Project GNU is organized as part of the Free Software Foundation, Inc. The Free Software Foundation has the following goals: 1) to create GNU as a full development/operating system. 2) to distribute GNU and other useful software with source code and permission to copy and redistribute. Further information on the rationale for GNU is in file `/pub/gnu/GNUinfo/GNU' (all files referred to are on the Internet host prep.ai.mit.edu). Information on GNU Internet mailing lists and gnUSENET newsgroups can be found in `/pub/gnu/GNUinfo/MAILINGLISTS'. * How To Get The Software The easiest way to get a copy of the distribution is from someone else who has it. You need not ask for permission to do so, or tell any one else; just copy it. The second easiest is to ftp it over the Internet. The third easiest way is to uucp it. Ftp and uucp information is in `/pub/gnu/GNUinfo/FTP'. If you cannot get a copy any of these ways, or if you would feel more confident getting copies straight from us, or if you would like to get some funds to us to help in our efforts, you can order one from the Free Software Foundation. See `/pub/gnu/GNUinfo/DISTRIB' and `/pub/gnu/GNUinfo/ORDERS'. * What format are the *.gz files in? Because the unix `compress' utility is patented (by two separate patents, in fact), we cannot use it; it's not free software. Therefore, the GNU Project has chosen a new compression utility, `gzip', which is free of any known software patents and which tends to compress better anyway. As of March 1993, all compressed files in the GNU anonymous FTP area, `prep.ai.mit.edu:/pub/gnu', have been converted to the new format. Files compressed with this new compression program end in `.gz' (as opposed to `compress'-compressed files, which end in `.Z'). Gzip can uncompress `compress'-compressed files and `pack'-compressed files (which end in `.z'). This is possible because the various decompression algorithms are not patented---only compression is. The gzip program is available from any GNU mirror site (see `/pub/gnu/GNUinfo/FTP' for a list of mirror sites) in shar, tar, or gzipped tar format (for those who already have a prior version of gzip and want faster data transmission). It works on virtually every unix system, MSDOS, OS/2, and VMS. * Available Software ** GNU Emacs The GNU Emacs distribution includes: - manual source in TeX format. - an enhanced regex (regular expression) library. See files `/pub/gnu/GNUinfo/MACHINES*' for the status of porting Emacs to various machines and operating systems. ** C Scheme - a block structured dialect of LISP. The Free Software Foundation distributes C Scheme for the MIT Scheme Project on its Scheme tapes. The full ftp distribution can be gotten via anonymous FTP from altdorf.ai.mit.edu in directory /archive. Problems with the C Scheme distribution and its ftp distribution should be referred to: . There are two general mailing lists: and . Send requests to join either list to: or . ** Other GNU Software A full list of available software are in `/pub/gnu/GNUinfo/ORDERS' and `/pub/gnu/DESCRIPTIONS'. * No Warranties We distribute software in the hope that it will be useful, but without any warranty. No author or distributor of this software accepts responsibility to anyone for the consequences of using it or for whether it serves any particular purpose or works at all, unless he says so in writing. * If You Like The Software If you like the software developed and distributed by the Free Software Foundation, please express your satisfaction with a donation. Your donations will help to support the foundation and make our future efforts successful, including a complete development and operating system, called GNU (Gnu's Not Un*x), which will run Un*x user programs. Please note that donations and funds raised by selling tapes, CD-ROMs, and floppy diskettes are the major source of funding for our work. For more information on GNU and the Foundation, contact us at Internet address or the foundation's US Mail address found in file `/pub/gnu/GNUinfo/ORDERS'. emacs-19.30/INSTALL100444 75424 1 57515 6002546634 12375 0ustar kwzhdaemonGNU Emacs Installation Guide Copyright (c) 1992, 1994 Free software Foundation, Inc. Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the copyright notice and permission notice are preserved, and that the distributor grants the recipient permission for further redistribution as permitted by this notice. Permission is granted to distribute modified versions of this document, or of portions of it, under the above conditions, provided also that they carry prominent notices stating who last changed them, and that any new or changed statements about the activities of the Free Software Foundation are approved by the Foundation. BUILDING AND INSTALLATION: (This is for a Unix or Unix-like system. For MSDOS, see below; search for MSDOG. For Windows NT, see the file nt/install.) 1) Make sure your system has enough swapping space allocated to handle a program whose pure code is 900k bytes and whose data area is at least 400k and can reach 8Mb or more. If the swapping space is insufficient, you will get an error in the command `temacs -batch -l loadup dump', found in `./src/Makefile.in.in', or possibly when running the final dumped Emacs. Building Emacs requires about 70 Mb of disk space (including the Emacs sources). Once installed, Emacs occupies about 35 Mb in the file system where it is installed; this includes the executable files, Lisp libraries, miscellaneous data files, and on-line documentation. If the building and installation take place in different directories, then the installation procedure momentarily requires 70+35 Mb. 2) Consult `./etc/MACHINES' to see what configuration name you should give to the `configure' program. That file offers hints for getting around some possible installation problems. 3) In the top directory of the Emacs distribution, run the program `configure' as follows: ./configure CONFIGURATION-NAME [--OPTION[=VALUE]] ... The CONFIGURATION-NAME argument should be a configuration name given in `./etc/MACHINES'. If omitted, `configure' will try to guess your system type; if it cannot, you must find the appropriate configuration name in `./etc/MACHINES' and specify it explicitly. If you don't want X support, specify `--with-x=no'. If you omit this option, `configure' will try to figure out for itself whether your system has X, and arrange to use it if present. The `--x-includes=DIR' and `--x-libraries=DIR' options tell the build process where the compiler should look for the include files and object libraries used with the X Window System. Normally, `configure' is able to find them; these options are necessary if you have your X Window System files installed in unusual places. These options also accept a list of directories, separated with colons. To get more attractive menus, you can specify an X toolkit when you configure Emacs; use the option `--with-x-toolkit=TOOLKIT', where TOOLKIT is `athena' or `motif' (`yes' and `lucid' are synonyms for `athena'). On some systems, it does not work to use a toolkit with shared libraries. The `--with-gcc' option specifies that the build process should compile Emacs using GCC. If you don't want to use GCC, specify `--with-gcc=no'. If you omit this option, `configure' will search for GCC in your path, and use it if present. You can build Emacs for several different machine types from a single source directory. To do this, you must use a version of `make' that supports the `VPATH' variable, such as GNU `make'. Make separate build directories for the different configuration types, and in each one, run the Emacs `configure' script. `configure' looks for the Emacs source code in the directory that `configure' is in. The `--prefix=PREFIXDIR' option specifies where the installation process should put emacs and its data files. This defaults to `/usr/local'. - Emacs (and the other utilities users run) go in PREFIXDIR/bin (unless the `--exec-prefix' option says otherwise). - The architecture-independent files go in PREFIXDIR/share/emacs/VERSION (where VERSION is the version number of Emacs, like `19.27'). - The architecture-dependent files go in PREFIXDIR/libexec/emacs/VERSION/CONFIGURATION (where CONFIGURATION is the configuration name, like mips-dec-ultrix4.2), unless the `--exec-prefix' option says otherwise. The `--exec-prefix=EXECDIR' option allows you to specify a separate portion of the directory tree for installing architecture-specific files, like executables and utility programs. If specified, - Emacs (and the other utilities users run) go in EXECDIR/bin, and - The architecture-dependent files go in EXECDIR/libexec/emacs/VERSION/CONFIGURATION. EXECDIR/bin should be a directory that is normally in users' PATHs. For example, the command ./configure mips-dec-ultrix --with-x11 configures Emacs to build for a DECstation running Ultrix, with support for the X11 window system. `configure' doesn't do any compilation or installation itself. It just creates the files that influence those things: `./Makefile', `lib-src/Makefile', `oldXMenu/Makefile', `lwlib/Makefile', `src/Makefile', and `./src/config.h'. For details on exactly what it does, see the section called `CONFIGURATION BY HAND', below. When it is done, `configure' prints a description of what it did and creates a shell script `config.status' which, when run, recreates the same configuration. If `configure' exits with an error after disturbing the status quo, it removes `config.status'. `configure' also creates a file `config.cache' that saves the results of its tests to make reconfiguring faster, and a file `config.log' containing compiler output (useful mainly for debugging `configure'). You can give `configure' the option `--cache-file=FILE' to use the results of the tests in FILE instead of `config.cache'. Set FILE to `/dev/null' to disable caching, for debugging `configure'. The work of `configure' can be done by editing various files in the distribution, but using `configure' is supposed to be simpler. See the section called "CONFIGURATION BY HAND" below if you want to do the configuration yourself. 4) Look at `./lisp/paths.el'; if some of those values are not right for your system, set up the file `./lisp/site-init.el' with Emacs Lisp code to override them; it is not a good idea to edit paths.el itself. YOU MUST USE THE LISP FUNCTION `setq' TO ASSIGN VALUES, rather than `defvar', as used by `./lisp/paths.el'. For example, (setq news-inews-program "/usr/bin/inews") is how you would override the default value of the variable news-inews-program (which is "/usr/local/inews"). Before you override a variable this way, *look at the value* that the variable gets by default! Make sure you know what kind of value the variable should have. If you don't pay attention to what you are doing, you'll make a mistake. 5) Put into `./lisp/site-init.el' or `./lisp/site-load.el' any Emacs Lisp code you want Emacs to load before it is dumped out. Use site-load.el for additional libraries if you arrange for their documentation strings to be in the etc/DOC file (see src/Makefile.in.in if you wish to figure out how to do that). For all else, use site-init.el. If you set load-path to a different value in site-init.el or site-load.el, Emacs will use *precisely* that value when it starts up again. If you do this, you are on your own! Note that, on some systems, the code you place in site-init.el must not use expand-file-name or any other function which may look something up in the system's password and user information database. See `./PROBLEMS' for more details on which systems this affects. The `site-*.el' files are nonexistent in the distribution. You do not need to create them if you have nothing to put in them. 6) Refer to the file `./etc/TERMS' for information on fields you may wish to add to various termcap entries. The files `./etc/termcap.ucb' and `./etc/termcap.dat' may already contain appropriately-modified entries. 7) Run `make' in the top directory of the Emacs distribution to finish building Emacs in the standard way. The final executable file is named `src/emacs'. You can execute this file "in place" without copying it, if you wish; then it automatically uses the sibling directories ../lisp, ../lib-src, ../info. Or you can "install" the executable and the other Emacs into their installed locations, with `make install'. By default, Emacs's files are installed in the following directories: `/usr/local/bin' holds the executable programs users normally run - `emacs', `etags', `ctags', `b2m', `emacsclient', and `rcs-checkin'. `/usr/local/share/emacs/VERSION/lisp' holds the Emacs Lisp library; `VERSION' stands for the number of the Emacs version you are installing, like `18.59' or `19.27'. Since the lisp library changes from one version of Emacs to another, including the version number in the path allows you to have several versions of Emacs installed at the same time; this means that you don't have to make Emacs unavailable while installing a new version. Emacs searches for its lisp files in `/usr/local/share/emacs/site-lisp', then in this directory. `/usr/local/share/emacs/VERSION/etc' holds the Emacs tutorial, the DOC file, the `yow' database, and other architecture-independent files Emacs might need while running. VERSION is as specified for `.../lisp'. `/usr/local/com/emacs/lock' contains files indicating who is editing what, so Emacs can detect editing clashes between users. `/usr/local/libexec/emacs/VERSION/CONFIGURATION-NAME' contains executable programs used by Emacs that users are not expected to run themselves. `VERSION' is the number of the Emacs version you are installing, and `CONFIGURATION-NAME' is the argument you gave to the `configure' program to identify the architecture and operating system of your machine, like `mips-dec-ultrix' or `sparc-sun-sunos'. Since these files are specific to the version of Emacs, operating system, and architecture in use, including the configuration name in the path allows you to have several versions of Emacs for any mix of machines and operating systems installed at the same time; this is useful for sites at which different kinds of machines share the file system Emacs is installed on. `/usr/local/info' holds the on-line documentation for Emacs, known as "info files". Many other GNU programs are documented using info files as well, so this directory stands apart from the other, Emacs-specific directories. `/usr/local/man/man1' holds the man pages for the programs installed in `/usr/local/bin'. If these directories are not what you want, you can specify where to install Emacs's libraries and data files or where Emacs should search for its lisp files by giving values for `make' variables as part of the command. See the section below called `MAKE VARIABLES' for more information on this. 8) Check the file `dir' in your site's info directory (usually /usr/local/info) to make sure that it has a menu entry for the Emacs info files. 9) If your system uses lock files to interlock access to mailer inbox files, then you might need to make the movemail program setuid or setgid to enable it to write the lock files. We believe this is safe. 10) You are done! You can remove executables and object files from the build directory by typing `make clean'. To also remove the files that `configure' created (so you can compile Emacs for a different configuration), type `make distclean'. MAKE VARIABLES You can change where the build process installs Emacs and its data files by specifying values for `make' variables as part of the `make' command line. For example, if you type make install bindir=/usr/local/gnubin the `bindir=/usr/local/gnubin' argument indicates that the Emacs executable files should go in `/usr/local/gnubin', not `/usr/local/bin'. Here is a complete list of the variables you may want to set. `bindir' indicates where to put executable programs that users can run. This defaults to /usr/local/bin. `datadir' indicates where to put the architecture-independent read-only data files that Emacs refers to while it runs; it defaults to /usr/local/share. We create the following subdirectories under `datadir': - `emacs/VERSION/lisp', containing the Emacs lisp library, and - `emacs/VERSION/etc', containing the Emacs tutorial, the DOC file, and the `yow' database. `VERSION' is the number of the Emacs version you are installing, like `18.59' or `19.0'. Since these files vary from one version of Emacs to another, including the version number in the path allows you to have several versions of Emacs installed at the same time; this means that you don't have to make Emacs unavailable while installing a new version. `sharedstatedir' indicates where to put architecture-independent data files that Emacs modifies while it runs; it defaults to /usr/local/com. We create the following subdirectories under `sharedstatedir': - `emacs/lock', containing files indicating who is editing what, so Emacs can detect editing clashes between users. `libexecdir' indicates where to put architecture-specific data files that Emacs refers to as it runs; it defaults to `/usr/local/libexec'. We create the following subdirectories under `libexecdir': - `emacs/VERSION/CONFIGURATION-NAME', containing executable programs used by Emacs that users are not expected to run themselves. `VERSION' is the number of the Emacs version you are installing, and `CONFIGURATION-NAME' is the argument you gave to the `configure' program to identify the architecture and operating system of your machine, like `mips-dec-ultrix' or `sparc-sun-sunos'. Since these files are specific to the version of Emacs, operating system, and architecture in use, including the configuration name in the path allows you to have several versions of Emacs for any mix of machines and operating systems installed at the same time; this is useful for sites at which different kinds of machines share the file system Emacs is installed on. `infodir' indicates where to put the info files distributed with Emacs; it defaults to `/usr/local/info'. `mandir' indicates where to put the man pages for Emacs and its utilities (like `etags'); it defaults to `/usr/local/man/man1'. `manext' gives the extension the man pages should be installed with. It should contain a period, followed by the appropriate digit. It defaults to `.1'. For example given the default values for `mandir' and `manext', the Emacs man page would be installed as `/usr/local/man/man1/emacs.1'. `prefix' doesn't give a path for any specific part of Emacs; instead, its value is used to determine the defaults for all the architecture-independent path variables - `datadir', `sharedstatedir', `infodir', and `mandir'. Its default value is `/usr/local'; the other variables add on `lib' or `man' to it by default. For example, suppose your site generally places GNU software under `/usr/users/software/gnusoft' instead of `/usr/local'. By including `prefix=/usr/users/software/gnusoft' in the arguments to `make', you can instruct the build process to place all of the Emacs data files in the appropriate directories under that path. `exec_prefix' serves the same purpose as `prefix', but instead determines the default values for the architecture-dependent path variables - `bindir' and `libexecdir'. The above variables serve analogous purposes in the makefiles for all GNU software; here are some variables specific to Emacs. `lispdir' indicates where Emacs installs and expects its lisp library. Its default value, based on `datadir' (see above), is `/usr/local/share/emacs/VERSION/lisp' (where `VERSION' is as described above). `locallisppath' indicates where Emacs should search for lisp files specific to your site. It should be a colon-separated list of directories; Emacs checks them in order before checking `lispdir'. Its default value, based on `datadir' (see above), is `/usr/local/share/emacs/site-lisp'. `lisppath' is the complete list of directories Emacs should search for its lisp files; its default value is the concatenation of `lispdir' and `locallisppath'. It should be a colon-separated list of directories; Emacs checks them in the order they appear. `etcdir' indicates where Emacs should install and expect the rest of its architecture-independent data, like the tutorial, DOC file, and yow database. Its default value, based on `datadir' (which see), is `/usr/local/share/emacs/VERSION/etc'. `lockdir' indicates the directory where Emacs keeps track of its locking information. Its default value, based on `sharedstatedir' (which see), is `/usr/local/com/emacs/lock'. `archlibdir' indicates where Emacs installs and expects the executable files and other architecture-dependent data it uses while running. Its default value, based on `libexecdir' (which see), is `/usr/local/libexec/emacs/VERSION/CONFIGURATION-NAME' (where VERSION and CONFIGURATION-NAME are as described above). Remember that you must specify any variable values you need each time you run `make' in the top directory. If you run `make' once to build emacs, test it, and then run `make' again to install the files, you must provide the same variable settings each time. To make the settings persist, you can edit them into the `Makefile' in the top directory, but be aware that running the `configure' program erases `Makefile' and rebuilds it from `Makefile.in'. The top-level Makefile stores the variable settings it used in the Makefiles for the subdirectories, so you don't have to specify them when running make in the subdirectories. CONFIGURATION BY HAND Instead of running the `configure' program, you have to perform the following steps. 1) Copy `./src/config.h.in' to `./src/config.h'. 2) Consult `./etc/MACHINES' to see what configuration name you should use for your system. Look at the code of the `configure' script to see which operating system and architecture description files from `src/s' and `src/m' should be used for that configuration name. Edit `src/config.h', and change the two `#include' directives to include the appropriate system and architecture description files. 2) Edit `./src/config.h' to set the right options for your system. If you need to override any of the definitions in the s/*.h and m/*.h files for your system and machine, do so by editing config.h, not by changing the s/*.h and m/*.h files. Occasionally you may need to redefine parameters used in `./lib-src/movemail.c'. 3) Create src/Makefile and lib-src/Makefile from the corresponding `Makefile.in.in' files. First copy `Makefile.in.in' to `Makefile.in', then edit in appropriate substituions for the @...@ constructs, and then copy the shell commands near the end of `configure' that run cpp to construct `Makefile'. 4) Create `Makefile' files in various other directories from the corresponding `Makefile.in' files. This isn't so hard, just a matter of substitution. The `configure' script is built from `configure.in' by the `autoconf' program. You need version 2.0 or newer of `autoconf' to rebuild `configure'. BUILDING GNU EMACS BY HAND Once Emacs is configured, running `make' in the top directory performs the following steps. 1) Run `make src/paths.h' in the top directory. This produces `./src/paths.h' from the template file `./src/paths.h.in', changing the paths to the values specified in `./Makefile'. 2) Go to directory `./lib-src' and run `make'. This creates executables named `ctags' and `etags' and `wakeup' and `make-docfile' and `digest-doc' and `test-distrib'. And others. 3) Go to directory `./src' and Run `make'. This refers to files in the `./lisp' and `./lib-src' subdirectories using names `../lisp' and `../lib-src'. This creates a file `./src/emacs' which is the runnable Emacs, which has another name that contains a version number. Each time you do this, that version number increments in the last place. It also creates a file in `./etc' whose name is `DOC' followed by the current Emacs version. This file contains documentation strings for all the functions in Emacs. Each time you run make to make a new emacs, a new DOC file with a new name is made. You must keep the DOC file for an Emacs version as long as you keep using that Emacs version. INSTALLATION BY HAND The steps below are done by running `make install' in the main directory of the Emacs distribution. 1) Copy `./lisp' and its subdirectories, `./etc', and the executables in `./lib-src' to their final destinations, as selected in `./src/paths.h'. Strictly speaking, not all of the executables in `./lib-src' need be copied. - The programs `cvtmail', `emacsserver', `fakemail', `hexl', `movemail', `profile', `rcs2log', `timer', `vcdiff', `wakeup', and `yow' are used by Emacs; they do need to be copied. - The programs `etags', `ctags', `emacsclient', `b2m', and `rcs-checkin' are intended to be run by users; they are handled below. - The programs `make-docfile' and `test-distrib' were used in building Emacs, and are not needed any more. - The programs `digest-doc' and `sorted-doc' convert a `DOC' file into a file for users to read. There is no important reason to move them. 2) Copy the files in `./info' to the place specified in `./lisp/site-init.el' or `./lisp/paths.el'. Note that if the destination directory already contains a file named `dir', you probably don't want to replace it with the `dir' file in the Emacs distribution. Instead, you should make sure that the existing `dir' file contains an appropriate menu entry for the Emacs info. 3) Create a directory for Emacs to use for clash detection, named as indicated by the PATH_LOCK macro in `./src/paths.h'. 4) Copy `./src/emacs' to `/usr/local/bin', or to some other directory in users' search paths. `./src/emacs' has an alternate name `./src/emacs-EMACSVERSION'; you may wish to make a symbolic link named `/usr/local/bin/emacs' pointing to that alternate name, as an easy way of installing different versions. You can delete `./src/temacs'. 5) Copy the programs `b2m', `emacsclient', `ctags', `etags', and `rcs-checkin' from `./lib-src' to `/usr/local/bin'. These programs are intended for users to run. 6) Copy the man pages in `./etc' for emacs, ctags, and etags into the appropriate man directories. 7) The files in the `./src' subdirectory, except for `emacs', are not used by Emacs once it is built. However, it is very desirable to keep the source on line for debugging. PROBLEMS See the file PROBLEMS in this directory for a list of various problems sometimes encountered, and what to do about them. Installation on MSDOG (a.k.a. MSDOS) To install on MSDOG, you need to have the GNU C compiler for MSDOG (also known as djgpp), GNU Make, rm, mv, chmod, and sed. Some users report that running Emacs 19.29 requires dpmi memory management. We do not know why this is so, since 19.28 did not need it. If we find out what change introduced this requirement, we will try to eliminate it. It is possible that this problem happens only when there is not enough physical memory on the machine. You can find out if you have a dpmi host by running go32 (part of djgpp) without arguments; it will tell you if it uses dpmi memory. For more information about dpmi memory, consult the djgpp FAQ. To build and install Emacs, type these commands: config msdos make install You may need to work around a type conflict between gmalloc.c and the header file djgppstd.h regarding declarations of memalign and valloc. Temporarily deleting those declarations from djgppstd.h while compiling Emacs or while compiling gmalloc.c should do it. We found out about this problem too late to include a more convenient fix--sorry. To save disk space, Emacs is built with the idea that you will execute it from the same place in the file system where you built it. As the /usr/local/ subtree does not exist on most MSDOG systems, the executables are placed in /emacs/bin/. MSDOG is a not a multitasking operating system, so Emacs features such as asynchronous subprocesses that depend on multitasking will not work. Synchronous subprocesses do work. emacs-19.30/PROBLEMS100666 12120 1 161030 6050707750 12323 0ustar rmsdaemonThis file describes various problems that have been encountered in compiling, installing and running GNU Emacs. * "Cannot find callback list" messages from dialog boxes on HPUX, in Emacs built with Motif. This problem resulted from a bug in GCC 2.4.5. Newer GCC versions such as 2.7.0 fix the problem. * On Irix 6.0, make tries (and fails) to build a program named unexelfsgi A compiler bug inserts spaces into the string "unexelfsgi . o" in src/Makefile. Edit src/Makefile, after configure is run, find that string, and take out the spaces. Compiler fixes in Irix 6.0.1 should eliminate this problem. * With certain fonts, when the cursor appears on a character, the character doesn't appear--you get a solid box instead. One user on a Linux-based GNU system reported that this problem went away with installation of a new X server. The failing server was XFree86 3.1.1. XFree86 3.1.2 works. * On SunOS 4.1.3, Emacs unpredictably crashes in _yp_dobind_soft. This happens if you configure Emacs specifying just `sparc-sun-sunos4' on a system that is version 4.1.3. You must specify the precise version number (or let configure figure out the configuration, which it can do perfectly well for SunOS). * On SunOS 4, Emacs processes keep going after you kill the X server (or log out, if you logged in using X). Someone reported that recompiling with GCC 2.7.0 fixed this problem. * On AIX 4, some programs fail when run in a Shell buffer with an error message like No terminfo entry for "unknown". On AIX, many terminal type definitions are not installed by default. `unknown' is one of them. Install the "Special Generic Terminal Definitions" to make them defined. * On SunOS, you get linker errors ld: Undefined symbol _get_wmShellWidgetClass _get_applicationShellWidgetClass The fix to this is to install patch 100573 for OpenWindows 3.0 or link libXmu statically. * On AIX 4.1.2, linker error messages such as ld: 0711-212 SEVERE ERROR: Symbol .__quous, found in the global symbol table of archive /usr/lib/libIM.a, was not defined in archive member shr.o. This is a problem in libIM.a. You can work around it by executing these shell commands in the src subdirectory of the directory where you build Emacs: cp /usr/lib/libIM.a . chmod 664 libIM.a ranlib libIM.a Then change -lIM to ./libIM.a in the command to link temacs (in Makefile). * Unpredictable segmentation faults on Solaris 2.3 and 2.4. A user reported that this happened in 19.29 when it was compiled with the Sun compiler, but not when he recompiled with GCC 2.7.0. We do not know whether something in Emacs is partly to blame for this. * Emacs exits with "X protocol error" when run with an X server for Windows. A certain X server for Windows had a bug which caused this. Supposedly the newer 32-bit version of this server doesn't have the problem. * Emacs crashes at startup on MSDOS. Some users report that Emacs 19.29 requires dpmi memory management, and crashes on startup if the system does not have it. We don't yet know why this happens--perhaps these machines don't have enough real memory, or perhaps something is wrong in Emacs or the compiler. However, arranging to use dpmi support is a workaround. You can find out if you have a dpmi host by running go32 without arguments; it will tell you if it uses dpmi memory. For more information about dpmi memory, consult the djgpp FAQ. (djgpp is the GNU C compiler as packaged for MSDOS.) Compiling Emacs under MSDOS is extremely sensitive for proper memory configuration. If you experience problems during compilation, consider removing some or all memory resident programs (notably disk caches) and make sure that your memory managers are properly configured. See the djgpp faq for configuration hints. * A position you specified in .Xdefaults is ignored, using twm. twm normally ignores "program-specified" positions. You can tell it to obey them with this command in your `.twmrc' file: UsePPosition "on" #allow clents to request a position * Compiling lib-src says there is no rule to make test-distrib.c. This results from a bug in a VERY old version of GNU Sed. To solve the problem, install the current version of GNU Sed, then rerun Emacs's configure script. * Compiling wakeup, in lib-src, says it can't make wakeup.c. This results from a bug in GNU Sed version 2.03. To solve the problem, install the current version of GNU Sed, then rerun Emacs's configure script. * On Sunos 4.1.1, there are errors compiling sysdep.c. If you get errors such as "sysdep.c", line 2017: undefined structure or union "sysdep.c", line 2017: undefined structure or union "sysdep.c", line 2019: nodename undefined This can result from defining LD_LIBRARY_PATH. It is very tricky to use that environment variable with Emacs. The Emacs configure script links many test programs with the system libraries; you must make sure that the libraries available to configure are the same ones available when you build Emacs. * The right Alt key works wrong on German HP keyboards (and perhaps other non-English HP keyboards too). This is because HPUX defines the modifiers wrong in X. Here is a shell script to fix the problem; be sure that it is run after VUE configures the X server. xmodmap 2> /dev/null - << EOF keysym Alt_L = Meta_L keysym Alt_R = Meta_R EOF xmodmap - << EOF clear mod1 keysym Mode_switch = NoSymbol add mod1 = Meta_L keysym Meta_R = Mode_switch add mod2 = Mode_switch EOF * The Emacs window disappears when you type M-q. Some versions of the Open Look window manager interpret M-q as a quit command for whatever window you are typing at. If you want to use Emacs with that window manager, you should try to configure the window manager to use some other command. You can disable the shortcut keys entirely by adding this line to ~/.OWdefaults: OpenWindows.WindowMenuAccelerators: False * Emacs does not notice when you release the mouse. There are reports that this happened with (some) Microsoft mice and that replacing the mouse made it stop. * Trouble using ptys on IRIX, or running out of ptys. The program mkpts (which may be in `/usr/adm' or `/usr/sbin') needs to be set-UID to root, or non-root programs like Emacs will not be able to allocate ptys reliably. * On Irix 5.2, unexelfsgi.c can't find cmplrs/stsupport.h. The file cmplrs/stsupport.h was included in the wrong file set in the Irix 5.2 distribution. You can find it in the optional fileset compiler_dev, or copy it from some other Irix 5.2 system. A kludgy workaround is to change unexelfsgi.c to include sym.h instead of syms.h. * Slow startup on Linux-based GNU systems. People using systems based on the Linux kernel sometimes report that startup takes 10 to 15 seconds longer than `usual'. This is because Emacs looks up the host name when it starts. Normally, this takes negligible time; the extra delay is due to improper system configuration. This problem can occur for both networked and non-networked machines. Here is how to fix the configuration. It requires being root. ** Networked Case First, make sure the files `/etc/hosts' and `/etc/host.conf' both exist. The first line in the `/etc/hosts' file should look like this (replace HOSTNAME with your host name): 127.0.0.1 HOSTNAME Also make sure that the `/etc/host.conf' files contains the following lines: order hosts, bind multi on Any changes, permanent and temporary, to the host name should be indicated in the `/etc/hosts' file, since it acts a limited local database of addresses and names (e.g., some SLIP connections dynamically allocate ip addresses). ** Non-Networked Case The solution described in the networked case applies here as well. However, if you never intend to network your machine, you can use a simpler solution: create an empty `/etc/host.conf' file. The command `touch /etc/host.conf' suffices to create the file. The `/etc/hosts' file is not necessary with this approach. * On Solaris 2.4, Dired hangs and C-g does not work. Or Emacs hangs forever waiting for termination of a subprocess that is a zombie. casper@fwi.uva.nl says the problem is in X11R6. Rebuild libX11.so after changing the file xc/config/cf/sunLib.tmpl. Change the lines #if ThreadedX #define SharedX11Reqs -lthread #endif to: #if OSMinorVersion < 4 #if ThreadedX #define SharedX11Reqs -lthread #endif #endif Be sure also to edit x/config/cf/sun.cf so that OSMinorVersion is 4 (as it should be for Solaris 2.4). The file has three definitions for OSMinorVersion: the first is for x86, the second for SPARC under Solaris, and the third for SunOS 4. Make sure to update the definition for your type of machine and system. Then do `make Everything' in the top directory of X11R6, to rebuild the makefiles and rebuild X. The X built this way work only on Solaris 2.4, not on 2.3. For multithreaded X to work it necessary to install patch 101925-02 to fix problems in header files [2.4]. You need to reinstall gcc or re-run just-fixinc after installing that patch. However, Frank Rust used a simpler solution: he changed #define ThreadedX YES to #define ThreadedX NO in sun.cf and did `make World' to rebuild X11R6. Removing all `-DXTHREAD*' flags and `-lthread' entries from lib/X11/Makefile and typing 'make install' in that directory also seemed to work. * With M-x enable-flow-control, you need to type C-\ twice to do incremental search--a single C-\ gets no response. This has been traced to communicating with your machine via kermit, with C-\ as the kermit escape character. One solution is to use another escape character in kermit. One user did set escape-character 17 in his .kermrc file, to make C-q the kermit escape character. * The Motif version of Emacs paints the screen a solid color. This has been observed to result from the following X resource: Emacs*default.attributeFont: -*-courier-medium-r-*-*-*-140-*-*-*-*-iso8859-* That the resource has this effect indicates a bug in something, but we do not yet know what. If it is an Emacs bug, we hope someone can explain what the bug is so we can fix it. In the mean time, removing the resource prevents the problem. * Emacs gets hung shortly after startup, on Sunos 4.1.3. We think this is due to a bug in Sunos. The word is that one of these Sunos patches fixes the bug: 100075-11 100224-06 100347-03 100482-05 100557-02 100623-03 100804-03 101080-01 100103-12 100249-09 100496-02 100564-07 100630-02 100891-10 101134-01 100170-09 100296-04 100377-09 100507-04 100567-04 100650-02 101070-01 101145-01 100173-10 100305-15 100383-06 100513-04 100570-05 100689-01 101071-03 101200-02 100178-09 100338-05 100421-03 100536-02 100584-05 100784-01 101072-01 101207-01 We don't know which of these patches really matter. If you find out which ones, please inform bug-gnu-emacs@prep.ai.mit.edu. * Emacs aborts while starting up, only when run without X. This problem often results from compiling Emacs with GCC when GCC was installed incorrectly. The usual error in installing GCC is to specify --includedir=/usr/include. Installation of GCC makes corrected copies of the system header files. GCC is supposed to use the corrected copies in preference to the original system headers. Specifying --includedir=/usr/include causes the original system header files to be used. On some systems, the definition of ioctl in the original system header files is invalid for ANSI C and causes Emacs not to work. The fix is to reinstall GCC, and this time do not specify --includedir when you configure it. Then recompile Emacs. Specifying --includedir is appropriate only in very special cases and it should *never* be the same directory where system header files are kept. * The Compose key on a DEC keyboard does not work as Meta key. This shell command should fix it: xmodmap -e 'keycode 0xb1 = Meta_L' * Regular expressions matching bugs on SCO systems. On SCO, there are problems in regexp matching when Emacs is compiled with the system compiler. The compiler version is "Microsoft C version 6", SCO 4.2.0h Dev Sys Maintenance Supplement 01/06/93; Quick C Compiler Version 1.00.46 (Beta). The solution is to compile with GCC. * On Sunos 4, you get the error ld: Undefined symbol __lib_version. This is the result of using cc or gcc with the shared library meant for acc (the Sunpro compiler). Check your LD_LIBRARY_PATH and delete /usr/lang/SC2.0.1 or some similar directory. * You can't select from submenus (in the X toolkit version). On certain systems, mouse-tracking and selection in top-level menus works properly with the X toolkit, but neither of them works when you bring up a submenu (such as Bookmarks or Compare or Apply Patch, in the Files menu). This works on most systems. There is speculation that the failure is due to bugs in old versions of X toolkit libraries, but no one really knows. If someone debugs this and finds the precise cause, perhaps a workaround can be found. * Unusable default font on SCO 3.2v4. The Open Desktop environment comes with default X resource settings that tell Emacs to use a variable-width font. Emacs cannot use such fonts, so it does not work. This is caused by the file /usr/lib/X11/app-defaults/ScoTerm, which is the application-specific resource file for the `scoterm' terminal emulator program. It contains several extremely general X resources that affect other programs besides `scoterm'. In particular, these resources affect Emacs also: *Font: -*-helvetica-medium-r-*--12-*-p-* *Background: scoBackground *Foreground: scoForeground The best solution is to create an application-specific resource file for Emacs, /usr/lib/X11/app-defaults/Emacs, with the following contents: Emacs*Font: -*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1 Emacs*Background: white Emacs*Foreground: black (or whatever other defaults you prefer). These resource files are not normally shared across a network of SCO machines; you must create the file on each machine individually. * rcs2log gives you the awk error message "too many fields". This is due to an arbitrary limit in certain versions of awk. The solution is to use gawk (GNU awk). * Emacs is slow using X11R5 on HP/UX. This happens if you use the MIT versions of the X libraries--it doesn't run as fast as HP's version. People sometimes use the version because they see the HP version doesn't have the libraries libXaw.a, libXmu.a, libXext.a and others. HP/UX normally doesn't come with those libraries installed. To get good performance, you need to install them and rebuild Emacs. * Loading fonts is very slow. You might be getting scalable fonts instead of precomputed bitmaps. Known scalable font directories are "Type1" and "Speedo". A font directory contains scalable fonts if it contains the file "fonts.scale". If this is so, re-order your X windows font path to put the scalable font directories last. See the documentatoin of `xset' for details. With some X servers, it may be necessary to take the scalable font directories out of your path entirely, at least for Emacs 19.26. Changes in the future may make this unnecessary. * On AIX 3.2.4, releasing Ctrl/Act key has no effect, if Shift is down. Due to a feature of AIX, pressing or releasing the Ctrl/Act key is ignored when the Shift, Alt or AltGr keys are held down. This can lead to the keyboard being "control-locked"--ordinary letters are treated as control characters. You can get out of this "control-locked" state by pressing and releasing Ctrl/Act while not pressing or holding any other keys. * display-time causes kernel problems on ISC systems. Under Interactive Unix versions 3.0.1 and 4.0 (and probably other versions), display-time causes the loss of large numbers of STREVENT cells. Eventually the kernel's supply of these cells is exhausted. This makes emacs and the whole system run slow, and can make other processes die, in particular pcnfsd. Other emacs functions that communicate with remote processes may have the same problem. Display-time seems to be far the worst. The only known fix: Don't run display-time. * On Solaris, C-x doesn't get through to Emacs when you use the console. This is a Solaris feature (at least on Intel x86 cpus). Type C-r C-r C-t, to toggle whether C-x gets through to Emacs. * Error message `Symbol's value as variable is void: x', followed by segmentation fault and core dump. This has been tracked to a bug in tar! People report that tar erroneously added a line like this at the beginning of files of Lisp code: x FILENAME, N bytes, B tape blocks If your tar has this problem, install GNU tar--if you can manage to untar it :-). * Link failure when using acc on a Sun. To use acc, you need additional options just before the libraries, such as /usr/lang/SC2.0.1/values-Xt.o -L/usr/lang/SC2.0.1/cg87 -L/usr/lang/SC2.0.1 and you need to add -lansi just before -lc. The precise file names depend on the compiler version, so we cannot easily arrange to supply them. * Link failure on IBM AIX 1.3 ptf 0013. There is a real duplicate definition of the function `_slibc_free' in the library /lib/libc_s.a (just do nm on it to verify). The workaround/fix is: cd /lib ar xv libc_s.a NLtmtime.o ar dv libc_s.a NLtmtime.o * Undefined symbols _dlopen, _dlsym and/or _dlclose on a Sun. If you see undefined symbols _dlopen, _dlsym, or _dlclose when linking with -lX11, compile and link against the file mit/util/misc/dlsym.c in the MIT X11R5 distribution. Alternatively, link temacs using shared libraries with s/sunos4shr.h. (This doesn't work if you use the X toolkit.) If you get the additional error that the linker could not find lib_version.o, try extracting it from X11/usr/lib/X11/libvim.a in X11R4, then use it in the link. * Error messages `Wrong number of arguments: #, 5' This typically results from having the powerkey library loaded. Powerkey was designed for Emacs 19.22. It is obsolete now because Emacs 19 now has this feature built in; and powerkey also calls where-is-internal in an obsolete way. So the fix is to arrange not to load powerkey. * In Shell mode, you get a ^M at the end of every line. This happens to people who use tcsh, because it is trying to be too smart. It sees that the Shell uses terminal type `unknown' and turns on the flag to output ^M at the end of each line. You can fix the problem by adding this to your .cshrc file: if ($?EMACS) then if ($EMACS == "t") then unset edit stty -icrnl -onlcr -echo susp ^Z endif endif * An error message such as `X protocol error: BadMatch (invalid parameter attributes) on protocol request 93'. This comes from having an invalid X resource, such as emacs*Cursor: black (which is invalid because it specifies a color name for something that isn't a color.) The fix is to correct your X resources. * Undefined symbols when linking on Sunos 4.1 using --with-x-toolkit. If you get the undefined symbols _atowc _wcslen, _iswprint, _iswspace, _iswcntrl, _wcscpy, and _wcsncpy, then you need to add -lXwchar after -lXaw in the command that links temacs. This problem seems to arise only when the international language extensions to X11R5 are installed. * Typing C-c C-c in Shell mode kills your X server. This happens with Linux kernel 1.0 thru 1.04, approximately. The workaround is to define SIGNALS_VIA_CHARACTERS in config.h and recompile Emacs. Newer Linux kernel versions don't have this problem. * src/Makefile and lib-src/Makefile are truncated--most of the file missing. This can happen if configure uses GNU sed version 2.03. That version had a bug. GNU sed version 2.05 works properly. * Slow startup on X11R6 with X windows. If Emacs takes two minutes to start up on X11R6, see if your X resources specify any Adobe fonts. That causes the type-1 font renderer to start up, even if the font you asked for is not a type-1 font. One way to avoid this problem is to eliminate the type-1 fonts from your font path, like this: xset -fp /usr/X11R6/lib/X11/fonts/Type1/ * Pull-down menus appear in the wrong place, in the toolkit version of Emacs. An X resource of this form can cause the problem: Emacs*geometry: 80x55+0+0 This resource is supposed to apply, and does apply, to the menus individually as well as to Emacs frames. If that is not what you want, rewrite the resource. To check thoroughly for such resource specifications, use `xrdb -query' to see what resources the X server records, and also look at the user's ~/.Xdefaults and ~/.Xdefaults-* files. * --with-x-toolkit version crashes when used with shared libraries. On some systems, including Sunos 4 and DGUX 5.4.2 and perhaps others, unexec doesn't work properly with the shared library for the X toolkit. You might be able to work around this by using a nonshared libXt.a library. The real fix is to upgrade the various versions of unexec and/or ralloc. We think this has been fixed on Sunos 4 and Solaris in version 19.29. * `make install' fails on install-doc with `Error 141'. This happens on Ultrix 4.2 due to failure of a pipeline of tar commands. We don't know why they fail, but the bug seems not to be in Emacs. The workaround is to run the shell command in install-doc by hand. * --with-x-toolkit option configures wrong on BSD/386. This problem is due to bugs in the shell in version 1.0 of BSD/386. The workaround is to edit the configure file to use some other shell, such as bash. * Subprocesses remain, hanging but not zombies, on Sunos 5.3. A bug in Sunos 5.3 causes Emacs subprocesses to remain after Emacs exits. Sun patch # 101415-02 is part of the fix for this, but it only applies to ptys, and doesn't fix the problem with subprocesses communicating through pipes. * Mail is lost when sent to local aliases. Many emacs mail user agents (VM and rmail, for instance) use the sendmail.el library. This library can arrange for mail to be delivered by passing messages to the /usr/lib/sendmail (usually) program . In doing so, it passes the '-t' flag to sendmail, which means that the name of the recipient of the message is not on the command line and, therefore, that sendmail must parse the message to obtain the destination address. There is a bug in the SunOS4.1.1 and SunOS4.1.3 versions of sendmail. In short, when given the -t flag, the SunOS sendmail won't recognize non-local (i.e. NIS) aliases. It has been reported that the Solaris 2.x versions of sendmail do not have this bug. For those using SunOS 4.1, the best fix is to install sendmail V8 or IDA sendmail (which have other advantages over the regular sendmail as well). At the time of this writing, these official versions are available: Sendmail V8 on ftp.cs.berkeley.edu in /ucb/sendmail: sendmail.8.6.9.base.tar.Z (the base system source & documentation) sendmail.8.6.9.cf.tar.Z (configuration files) sendmail.8.6.9.misc.tar.Z (miscellaneous support programs) sendmail.8.6.9.xdoc.tar.Z (extended documentation, with postscript) IDA sendmail on vixen.cso.uiuc.edu in /pub: sendmail-5.67b+IDA-1.5.tar.gz * On AIX, you get this message when running Emacs: Could not load program emacs Symbol smtcheckinit in csh is undefined Error was: Exec format error or this one: Could not load program .emacs Symbol _system_con in csh is undefined Symbol _fp_trapsta in csh is undefined Error was: Exec format error These can happen when you try to run on AIX 3.2.5 a program that was compiled with 3.2.4. The fix is to recompile. * On AIX, you get this compiler error message: Processing include file ./XMenuInt.h 1501-106: (S) Include file X11/Xlib.h not found. This means your system was installed with only the X11 runtime i.d libraries. You have to find your sipo (bootable tape) and install X11Dev... with smit. * You "lose characters" after typing Compose Character key. This is because the Compose Character key is defined as the keysym Multi_key, and Emacs (seeing that) does the proper X11 character-composition processing. If you don't want your Compose key to do that, you can redefine it with xmodmap. For example, here's one way to turn it into a Meta key: xmodmap -e "keysym Multi_key = Meta_L" If all users at your site of a particular keyboard prefer Meta to Compose, you can make the remapping happen automatically by adding the xmodmap command to the xdm setup script for that display. * C-z just refreshes the screen instead of suspending Emacs. You are probably using a shell that doesn't support job control, even though the system itself is capable of it. Either use a different shell, or set the variable `cannot-suspend' to a non-nil value. * Watch out for .emacs files and EMACSLOADPATH environment vars These control the actions of Emacs. ~/.emacs is your Emacs init file. EMACSLOADPATH overrides which directories the function "load" will search. If you observe strange problems, check for these and get rid of them, then try again. * After running emacs once, subsequent invocations crash. Some versions of SVR4 have a serious bug in the implementation of the mmap () system call in the kernel; this causes emacs to run correctly the first time, and then crash when run a second time. Contact your vendor and ask for the mmap bug fix; in the mean time, you may be able to work around the problem by adding a line to your operating system description file (whose name is reported by the configure script) that reads: #define SYSTEM_MALLOC This makes Emacs use memory less efficiently, but seems to work around the kernel bug. * Inability to send an Alt-modified key, when Emacs is communicating directly with an X server. If you have tried to bind an Alt-modified key as a command, and it does not work to type the command, the first thing you should check is whether the key is getting through to Emacs. To do this, type C-h c followed by the Alt-modified key. C-h c should say what kind of event it read. If it says it read an Alt-modified key, then make sure you have made the key binding correctly. If C-h c reports an event that doesn't have the Alt modifier, it may 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. Note that if you have Alt keys but no Meta keys, Emacs translates Alt into Meta. This is because of the great importance of Meta in Emacs. * `Pid xxx killed due to text modification or page I/O error' On HP/UX, you can get that error when the Emacs executable is on an NFS file system. HP/UX responds this way if it tries to swap in a page and does not get a response from the server within a timeout whose default value is just ten seconds. If this happens to you, extend the timeout period. * `expand-file-name' fails to work on any but the machine you dumped Emacs on. On Ultrix, if you use any of the functions which look up information in the passwd database before dumping Emacs (say, by using expand-file-name in site-init.el), then those functions will not work in the dumped Emacs on any host but the one Emacs was dumped on. The solution? Don't use expand-file-name in site-init.el, or in anything it loads. Yuck - some solution. I'm not sure why this happens; if you can find out exactly what is going on, and perhaps find a fix or a workaround, please let us know. Perhaps the YP functions cache some information, the cache is included in the dumped Emacs, and is then inaccurate on any other host. * On some variants of SVR4, Emacs does not work at all with X. Try defining BROKEN_FIONREAD in your config.h file. If this solves the problem, please send a bug report to tell us this is needed; be sure to say exactly what type of machine and system you are using. * Linking says that the functions insque and remque are undefined. Change oldXMenu/Makefile by adding insque.o to the variable OBJS. * Emacs fails to understand most Internet host names, even though the names work properly with other programs on the same system. * Emacs won't work with X-windows if the value of DISPLAY is HOSTNAME:0. * GNUs can't make contact with the specified host for nntp. This typically happens on Suns and other systems that use shared libraries. The cause is that the site has installed a version of the shared library which uses a name server--but has not installed a similar version of the unshared library which Emacs uses. The result is that most programs, using the shared library, work with the nameserver, but Emacs does not. The fix is to install an unshared library that corresponds to what you installed in the shared library, and then relink Emacs. On SunOS 4.1, simply define HAVE_RES_INIT. If you have already installed the name resolver in the file libresolv.a, then you need to compile Emacs to use that library. The easiest way to do this is to add to config.h a definition of LIBS_SYSTEM, LIBS_MACHINE or LIB_STANDARD which uses -lresolv. Watch out! If you redefine a macro that is already in use in your configuration to supply some other libraries, be careful not to lose the others. Thus, you could start by adding this to config.h: #define LIBS_SYSTEM -lresolv Then if this gives you an error for redefining a macro, and you see that the s- file defines LIBS_SYSTEM as -lfoo -lbar, you could change config.h again to say this: #define LIBS_SYSTEM -lresolv -lfoo -lbar * On a Sun running SunOS 4.1.1, you get this error message from GNU ld: /lib/libc.a(_Q_sub.o): Undefined symbol __Q_get_rp_rd referenced from text segment The problem is in the Sun shared C library, not in GNU ld. The solution is to install Patch-ID# 100267-03 from Sun. * Self documentation messages are garbled. This means that the file `etc/DOC-...' doesn't properly correspond with the Emacs executable. Redumping Emacs and then installing the corresponding pair of files should fix the problem. * Trouble using ptys on AIX. People often install the pty devices on AIX incorrectly. Use `smit pty' to reinstall them properly. * Shell mode on HP/UX gives the message, "`tty`: Ambiguous". christos@theory.tn.cornell.edu says: The problem is that in your .cshrc you have something that tries to execute `tty`. If you are not running the shell on a real tty then tty will print "not a tty". Csh expects one word in some places, but tty is giving it back 3. The solution is to add a pair of quotes around `tty` to make it a single word: if (`tty` == "/dev/console") should be changed to: if ("`tty`" == "/dev/console") Even better, move things that set up terminal sections out of .cshrc and into .login. * Using X Windows, control-shift-leftbutton makes Emacs hang. Use the shell command `xset bc' to make the old X Menu package work. * Emacs running under X Windows does not handle mouse clicks. * `emacs -geometry 80x20' finds a file named `80x20'. One cause of such problems is having (setq term-file-prefix nil) in your .emacs file. Another cause is a bad value of EMACSLOADPATH in the environment. * Emacs gets error message from linker on Sun. If the error message says that a symbol such as `f68881_used' or `ffpa_used' or `start_float' is undefined, this probably indicates that you have compiled some libraries, such as the X libraries, with a floating point option other than the default. It's not terribly hard to make this work with small changes in crt0.c together with linking with Fcrt1.o, Wcrt1.o or Mcrt1.o. However, the easiest approach is to build Xlib with the default floating point option: -fsoft. * Emacs fails to get default settings from X Windows server. The X library in X11R4 has a bug; it interchanges the 2nd and 3rd arguments to XGetDefaults. Define the macro XBACKWARDS in config.h to tell Emacs to compensate for this. I don't believe there is any way Emacs can determine for itself whether this problem is present on a given system. * Keyboard input gets confused after a beep when using a DECserver as a concentrator. This problem seems to be a matter of configuring the DECserver to use 7 bit characters rather than 8 bit characters. * M-x shell persistently reports "Process shell exited abnormally with code 1". This happened on Suns as a result of what is said to be a bug in Sunos version 4.0.x. The only fix was to reboot the machine. * Programs running under terminal emulator do not recognize `emacs' terminal type. The cause of this is a shell startup file that sets the TERMCAP environment variable. The terminal emulator uses that variable to provide the information on the special terminal type that Emacs emulates. Rewrite your shell startup file so that it does not change TERMCAP in such a case. You could use the following conditional which sets it only if it is undefined. if ( ! ${?TERMCAP} ) setenv TERMCAP ~/my-termcap-file Or you could set TERMCAP only when you set TERM--which should not happen in a non-login shell. * X Windows doesn't work if DISPLAY uses a hostname. People have reported kernel bugs in certain systems that cause Emacs not to work with X Windows if DISPLAY is set using a host name. But the problem does not occur if DISPLAY is set to `unix:0.0'. I think the bug has to do with SIGIO or FIONREAD. You may be able to compensate for the bug by doing (set-input-mode nil nil). However, that has the disadvantage of turning off interrupts, so that you are unable to quit out of a Lisp program by typing C-g. The easy way to do this is to put (setq x-sigio-bug t) in your site-init.el file. * Problem with remote X server on Suns. On a Sun, running Emacs on one machine with the X server on another may not work if you have used the unshared system libraries. This is because the unshared libraries fail to use YP for host name lookup. As a result, the host name you specify may not be recognized. * Shell mode ignores interrupts on Apollo Domain You may find that M-x shell prints the following message: Warning: no access to tty; thus no job control in this shell... This can happen if there are not enough ptys on your system. Here is how to make more of them. % cd /dev % ls pty* # shows how many pty's you have. I had 8, named pty0 to pty7) % /etc/crpty 8 # creates eight new pty's * Fatal signal in the command temacs -l loadup inc dump This command is the final stage of building Emacs. It is run by the Makefile in the src subdirectory, or by build.com on VMS. It has been known to get fatal errors due to insufficient swapping space available on the machine. On 68000's, it has also happened because of bugs in the subroutine `alloca'. Verify that `alloca' works right, even for large blocks (many pages). * test-distrib says that the distribution has been clobbered * or, temacs prints "Command key out of range 0-127" * or, temacs runs and dumps emacs, but emacs totally fails to work. * or, temacs gets errors dumping emacs This can be because the .elc files have been garbled. Do not be fooled by the fact that most of a .elc file is text: these are binary files and can contain all 256 byte values. In particular `shar' cannot be used for transmitting GNU Emacs. It typically truncates "lines". What appear to be "lines" in a binary file can of course be of any length. Even once `shar' itself is made to work correctly, `sh' discards null characters when unpacking the shell archive. I have also seen character \177 changed into \377. I do not know what transfer means caused this problem. Various network file transfer programs are suspected of clobbering the high bit. If you have a copy of Emacs that has been damaged in its nonprinting characters, you can fix them: 1) Record the names of all the .elc files. 2) Delete all the .elc files. 3) Recompile alloc.c with a value of PURESIZE twice as large. (See puresize.h.) You might as well save the old alloc.o. 4) Remake emacs. It should work now. 5) Running emacs, do Meta-x byte-compile-file repeatedly to recreate all the .elc files that used to exist. You may need to increase the value of the variable max-lisp-eval-depth to succeed in running the compiler interpreted on certain .el files. 400 was sufficient as of last report. 6) Reinstall the old alloc.o (undoing changes to alloc.c if any) and remake temacs. 7) Remake emacs. It should work now, with valid .elc files. * temacs prints "Pure Lisp storage exhausted" This means that the Lisp code loaded from the .elc and .el files during temacs -l loadup inc dump took up more space than was allocated. This could be caused by 1) adding code to the preloaded Lisp files 2) adding more preloaded files in loadup.el 3) having a site-init.el or site-load.el which loads files. Note that ANY site-init.el or site-load.el is nonstandard; if you have received Emacs from some other site and it contains a site-init.el or site-load.el file, consider deleting that file. 4) getting the wrong .el or .elc files (not from the directory you expected). 5) deleting some .elc files that are supposed to exist. This would cause the source files (.el files) to be loaded instead. They take up more room, so you lose. 6) a bug in the Emacs distribution which underestimates the space required. If the need for more space is legitimate, change the definition of PURESIZE in puresize.h. But in some of the cases listed above, this problem is a consequence of something else that is wrong. Be sure to check and fix the real problem. * Changes made to .el files do not take effect. You may have forgotten to recompile them into .elc files. Then the old .elc files will be loaded, and your changes will not be seen. To fix this, do M-x byte-recompile-directory and specify the directory that contains the Lisp files. Emacs should print a warning when loading a .elc file which is older than the corresponding .el file. * The dumped Emacs crashes when run, trying to write pure data. Two causes have been seen for such problems. 1) On a system where getpagesize is not a system call, it is defined as a macro. If the definition (in both unexec.c and malloc.c) is wrong, it can cause problems like this. You might be able to find the correct value in the man page for a.out (5). 2) Some systems allocate variables declared static among the initialized variables. Emacs makes all initialized variables in most of its files pure after dumping, but the variables declared static and not initialized are not supposed to be pure. On these systems you may need to add "#define static" to the m- or the s- file. * Compilation errors on VMS. You will get warnings when compiling on VMS because there are variable names longer than 32 (or whatever it is) characters. This is not an error. Ignore it. VAX C does not support #if defined(foo). Uses of this construct were removed, but some may have crept back in. They must be rewritten. There is a bug in the C compiler which fails to sign extend characters in conditional expressions. The bug is: char c = -1, d = 1; int i; i = d ? c : d; The result is i == 255; the fix is to typecast the char in the conditional expression as an (int). Known occurrences of such constructs in Emacs have been fixed. * rmail gets error getting new mail rmail gets new mail from /usr/spool/mail/$USER using a program called `movemail'. This program interlocks with /bin/mail using the protocol defined by /bin/mail. There are two different protocols in general use. One of them uses the `flock' system call. The other involves creating a lock file; `movemail' must be able to write in /usr/spool/mail in order to do this. You control which one is used by defining, or not defining, the macro MAIL_USE_FLOCK in config.h or the m- or s- file it includes. IF YOU DON'T USE THE FORM OF INTERLOCKING THAT IS NORMAL ON YOUR SYSTEM, YOU CAN LOSE MAIL! If your system uses the lock file protocol, and fascist restrictions prevent ordinary users from writing the lock files in /usr/spool/mail, you may need to make `movemail' setgid to a suitable group such as `mail'. You can use these commands (as root): chgrp mail movemail chmod 2755 movemail If your system uses the lock file protocol, and fascist restrictions prevent ordinary users from writing the lock files in /usr/spool/mail, you may need to make `movemail' setgid to a suitable group such as `mail'. To do this, use the following commands (as root) after doing the make install. chgrp mail movemail chmod 2755 movemail Installation normally copies movemail from the build directory to an installation directory which is usually under /usr/local/lib. The installed copy of movemail is usually in the directory /usr/local/lib/emacs/VERSION/TARGET. You must change the group and mode of the installed copy; changing the group and mode of the build directory copy is ineffective. * Emacs spontaneously displays "I-search: " at the bottom of the screen. This means that Control-S/Control-Q (XON/XOFF) "flow control" is being used. C-s/C-q flow control is bad for Emacs editors because it takes away C-s and C-q as user commands. Since editors do not output long streams of text without user commands, there is no need for a user-issuable "stop output" command in an editor; therefore, a properly designed flow control mechanism would transmit all possible input characters without interference. Designing such a mechanism is easy, for a person with at least half a brain. There are three possible reasons why flow control could be taking place: 1) Terminal has not been told to disable flow control 2) Insufficient padding for the terminal in use 3) Some sort of terminal concentrator or line switch is responsible First of all, many terminals have a set-up mode which controls whether they generate XON/XOFF flow control characters. This must be set to "no XON/XOFF" in order for Emacs to work. Sometimes there is an escape sequence that the computer can send to turn flow control off and on. If so, perhaps the termcap `ti' string should turn flow control off, and the `te' string should turn it on. Once the terminal has been told "no flow control", you may find it needs more padding. The amount of padding Emacs sends is controlled by the termcap entry for the terminal in use, and by the output baud rate as known by the kernel. The shell command `stty' will print your output baud rate; `stty' with suitable arguments will set it if it is wrong. Setting to a higher speed causes increased padding. If the results are wrong for the correct speed, there is probably a problem in the termcap entry. You must speak to a local Unix wizard to fix this. Perhaps you are just using the wrong terminal type. For terminals that lack a "no flow control" mode, sometimes just giving lots of padding will prevent actual generation of flow control codes. You might as well try it. If you are really unlucky, your terminal is connected to the computer through a concentrator which sends XON/XOFF flow control to the computer, or it insists on sending flow control itself no matter how much padding you give it. Unless you can figure out how to turn flow control off on this concentrator (again, refer to your local wizard), you are screwed! You should have the terminal or concentrator replaced with a properly designed one. In the mean time, some drastic measures can make Emacs semi-work. You can make Emacs ignore C-s and C-q and let the operating system handle them. To do this on a per-session basis, just type M-x enable-flow-control RET. You will see a message that C-\ and C-^ are now translated to C-s and C-q. (Use the same command M-x enable-flow-control to turn *off* this special mode. It toggles flow control handling.) If C-\ and C-^ are inconvenient for you (for example, if one of them is the escape character of your terminal concentrator), you can choose other characters by setting the variables flow-control-c-s-replacement and flow-control-c-q-replacement. But choose carefully, since all other control characters are already used by emacs. IMPORTANT: if you type C-s by accident while flow control is enabled, Emacs output will freeze, and you will have to remember to type C-q in order to continue. If you work in an environment where a majority of terminals of a certain type are flow control hobbled, you can use the function `enable-flow-control-on' to turn on this flow control avoidance scheme automatically. Here is an example: (enable-flow-control-on "vt200" "vt300" "vt101" "vt131") If this isn't quite correct (e.g. you have a mixture of flow-control hobbled and good vt200 terminals), you can still run enable-flow-control manually. I have no intention of ever redesigning the Emacs command set for the assumption that terminals use C-s/C-q flow control. XON/XOFF flow control technique is a bad design, and terminals that need it are bad merchandise and should not be purchased. Now that X is becoming widespread, XON/XOFF seems to be on the way out. If you can get some use out of GNU Emacs on inferior terminals, more power to you, but I will not make Emacs worse for properly designed systems for the sake of inferior systems. * Control-S and Control-Q commands are ignored completely. For some reason, your system is using brain-damaged C-s/C-q flow control despite Emacs's attempts to turn it off. Perhaps your terminal is connected to the computer through a concentrator that wants to use flow control. You should first try to tell the concentrator not to use flow control. If you succeed in this, try making the terminal work without flow control, as described in the preceding section. If that line of approach is not successful, map some other characters into C-s and C-q using keyboard-translate-table. The example above shows how to do this with C-^ and C-\. * Control-S and Control-Q commands are ignored completely on a net connection. Some versions of rlogin (and possibly telnet) do not pass flow control characters to the remote system to which they connect. On such systems, emacs on the remote system cannot disable flow control on the local system. One way to cure this is to disable flow control on the local host (the one running rlogin, not the one running rlogind) using the stty command, before starting the rlogin process. On many systems, "stty start u stop u" will do this. Some versions of tcsh will prevent even this from working. One way around this is to start another shell before starting rlogin, and issue the stty command to disable flow control from that shell. If none of these methods work, the best solution is to type M-x enable-flow-control at the beginning of your emacs session, or if you expect the problem to continue, add a line such as the following to your .emacs (on the host running rlogind): (enable-flow-control-on "vt200" "vt300" "vt101" "vt131") See the entry about spontaneous display of I-search (above) for more info. * Screen is updated wrong, but only on one kind of terminal. This could mean that the termcap entry you are using for that terminal is wrong, or it could mean that Emacs has a bug handing the combination of features specified for that terminal. The first step in tracking this down is to record what characters Emacs is sending to the terminal. Execute the Lisp expression (open-termscript "./emacs-script") to make Emacs write all terminal output into the file ~/emacs-script as well; then do what makes the screen update wrong, and look at the file and decode the characters using the manual for the terminal. There are several possibilities: 1) The characters sent are correct, according to the terminal manual. In this case, there is no obvious bug in Emacs, and most likely you need more padding, or possibly the terminal manual is wrong. 2) The characters sent are incorrect, due to an obscure aspect of the terminal behavior not described in an obvious way by termcap. This case is hard. It will be necessary to think of a way for Emacs to distinguish between terminals with this kind of behavior and other terminals that behave subtly differently but are classified the same by termcap; or else find an algorithm for Emacs to use that avoids the difference. Such changes must be tested on many kinds of terminals. 3) The termcap entry is wrong. See the file etc/TERMS for information on changes that are known to be needed in commonly used termcap entries for certain terminals. 4) The characters sent are incorrect, and clearly cannot be right for any terminal with the termcap entry you were using. This is unambiguously an Emacs bug, and can probably be fixed in termcap.c, tparam.c, term.c, scroll.c, cm.c or dispnew.c. * Output from Control-V is slow. On many bit-map terminals, scrolling operations are fairly slow. Often the termcap entry for the type of terminal in use fails to inform Emacs of this. The two lines at the bottom of the screen before a Control-V command are supposed to appear at the top after the Control-V command. If Emacs thinks scrolling the lines is fast, it will scroll them to the top of the screen. If scrolling is slow but Emacs thinks it is fast, the usual reason is that the termcap entry for the terminal you are using does not specify any padding time for the `al' and `dl' strings. Emacs concludes that these operations take only as much time as it takes to send the commands at whatever line speed you are using. You must fix the termcap entry to specify, for the `al' and `dl', as much time as the operations really take. Currently Emacs thinks in terms of serial lines which send characters at a fixed rate, so that any operation which takes time for the terminal to execute must also be padded. With bit-map terminals operated across networks, often the network provides some sort of flow control so that padding is never needed no matter how slow an operation is. You must still specify a padding time if you want Emacs to realize that the operation takes a long time. This will cause padding characters to be sent unnecessarily, but they do not really cost much. They will be transmitted while the scrolling is happening and then discarded quickly by the terminal. Most bit-map terminals provide commands for inserting or deleting multiple lines at once. Define the `AL' and `DL' strings in the termcap entry to say how to do these things, and you will have fast output without wasted padding characters. These strings should each contain a single %-spec saying how to send the number of lines to be scrolled. These %-specs are like those in the termcap `cm' string. You should also define the `IC' and `DC' strings if your terminal has a command to insert or delete multiple characters. These take the number of positions to insert or delete as an argument. A `cs' string to set the scrolling region will reduce the amount of motion you see on the screen when part of the screen is scrolled. * Your Delete key sends a Backspace to the terminal, using an AIXterm. The solution is to include in your .Xdefaults the lines: *aixterm.Translations: #override BackSpace: string(0x7f) aixterm*ttyModes: erase ^? This makes your Backspace key send DEL (ASCII 127). * You type Control-H (Backspace) expecting to delete characters. Put `stty dec' in your .login file and your problems will disappear after a day or two. The choice of Backspace for erasure was based on confusion, caused by the fact that backspacing causes erasure (later, when you type another character) on most display terminals. But it is a mistake. Deletion of text is not the same thing as backspacing followed by failure to overprint. I do not wish to propagate this confusion by conforming to it. For this reason, I believe `stty dec' is the right mode to use, and I have designed Emacs to go with that. If there were a thousand other control characters, I would define Control-h to delete as well; but there are not very many other control characters, and I think that providing the most mnemonic possible Help character is more important than adapting to people who don't use `stty dec'. If you are obstinate about confusing buggy overprinting with deletion, you can redefine Backspace in your .emacs file: (global-set-key "\b" 'delete-backward-char) You can probably access help-command via f1. * Editing files through RFS gives spurious "file has changed" warnings. It is possible that a change in Emacs 18.37 gets around this problem, but in case not, here is a description of how to fix the RFS bug that causes it. There was a serious pair of bugs in the handling of the fsync() system call in the RFS server. The first is that the fsync() call is handled as another name for the close() system call (!!). It appears that fsync() is not used by very many programs; Emacs version 18 does an fsync() before closing files to make sure that the bits are on the disk. This is fixed by the enclosed patch to the RFS server. The second, more serious problem, is that fsync() is treated as a non-blocking system call (i.e., it's implemented as a message that gets sent to the remote system without waiting for a reply). Fsync is a useful tool for building atomic file transactions. Implementing it as a non-blocking RPC call (when the local call blocks until the sync is done) is a bad idea; unfortunately, changing it will break the RFS protocol. No fix was supplied for this problem. (as always, your line numbers may vary) % rcsdiff -c -r1.2 serversyscall.c RCS file: RCS/serversyscall.c,v retrieving revision 1.2 diff -c -r1.2 serversyscall.c *** /tmp/,RCSt1003677 Wed Jan 28 15:15:02 1987 --- serversyscall.c Wed Jan 28 15:14:48 1987 *************** *** 163,169 **** /* * No return sent for close or fsync! */ ! if (syscall == RSYS_close || syscall == RSYS_fsync) proc->p_returnval = deallocate_fd(proc, msg->m_args[0]); else { --- 166,172 ---- /* * No return sent for close or fsync! */ ! if (syscall == RSYS_close) proc->p_returnval = deallocate_fd(proc, msg->m_args[0]); else { * Vax C compiler bugs affecting Emacs. You may get one of these problems compiling Emacs: foo.c line nnn: compiler error: no table entry for op STASG foo.c: fatal error in /lib/ccom These are due to bugs in the C compiler; the code is valid C. Unfortunately, the bugs are unpredictable: the same construct may compile properly or trigger one of these bugs, depending on what else is in the source file being compiled. Even changes in header files that should not affect the file being compiled can affect whether the bug happens. In addition, sometimes files that compile correctly on one machine get this bug on another machine. As a result, it is hard for me to make sure this bug will not affect you. I have attempted to find and alter these constructs, but more can always appear. However, I can tell you how to deal with it if it should happen. The bug comes from having an indexed reference to an array of Lisp_Objects, as an argument in a function call: Lisp_Object *args; ... ... foo (5, args[i], ...)... putting the argument into a temporary variable first, as in Lisp_Object *args; Lisp_Object tem; ... tem = args[i]; ... foo (r, tem, ...)... causes the problem to go away. The `contents' field of a Lisp vector is an array of Lisp_Objects, so you may see the problem happening with indexed references to that. * 68000 C compiler problems Various 68000 compilers have different problems. These are some that have been observed. ** Using value of assignment expression on union type loses. This means that x = y = z; or foo (x = z); does not work if x is of type Lisp_Object. ** "cannot reclaim" error. This means that an expression is too complicated. You get the correct line number in the error message. The code must be rewritten with simpler expressions. ** XCONS, XSTRING, etc macros produce incorrect code. If temacs fails to run at all, this may be the cause. Compile this test program and look at the assembler code: struct foo { char x; unsigned int y : 24; }; lose (arg) struct foo arg; { test ((int *) arg.y); } If the code is incorrect, your compiler has this problem. In the XCONS, etc., macros in lisp.h you must replace (a).u.val with ((a).u.val + coercedummy) where coercedummy is declared as int. This problem will not happen if the m-...h file for your type of machine defines NO_UNION_TYPE. That is the recommended setting now. * C compilers lose on returning unions I hear that some C compilers cannot handle returning a union type. Most of the functions in GNU Emacs return type Lisp_Object, which is defined as a union on some rare architectures. This problem will not happen if the m-...h file for your type of machine defines NO_UNION_TYPE. emacs-19.30/README100666 12120 1 7570 6055530467 12011 0ustar rmsdaemonThis directory tree holds version 19.30 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. You may encounter bugs in this release. If you do, please 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 file BUGS for more information on how to report bugs. See the files `etc/NEWS' and `etc/news.texi' for information on new features and other user-visible changes since the last version of Emacs. The file INSTALL in this directory says how to bring up GNU Emacs on Unix, once you have loaded the entire subtree of this directory. Note that the Emacs installation procedure has changed since version 18; you will probably want to read the file INSTALL even if you have installed Emacs before. The new procedure is intended to simplify Emacs installation, and make it easier to have several versions of Emacs for several architectures installed simultaneously. The file PROBLEMS contains information on many common problems that occur in building, installing and running Emacs. Reports of bugs in Emacs should be sent to the mailing list bug-gnu-emacs@prep.ai.mit.edu. See the "Bugs" section of the Emacs manual for more information on how to report bugs. (The file `BUGS' in this directory explains how you can find and read that section using the Info files that come with Emacs.) See `etc/MAILINGLISTS' for more information on mailing lists relating to GNU packages. The `etc' subdirectory contains several other files, named in capital letters, which you should look at when installing GNU Emacs. The file `configure' is a shell script to acclimate Emacs to the oddities of your processor and operating system. It creates the file `Makefile' (a script for the `make' program), which automates the process of building and installing Emacs. See INSTALL for more detailed information. The file `configure.in' is the input used by the autoconf program to construct the `configure' script. Since Emacs has configuration requirements that autoconf can't meet, `configure.in' uses an unholy marriage of custom-baked configuration code and autoconf macros; it may be wise to avoid rebuilding `configure' from `configure.in' when possible. The file `Makefile.in' is a template used by `configure' to create `Makefile'. The file `make-dist' is a shell script to build a distribution tar file from the current Emacs tree, containing only those files appropriate for distribution. If you make extensive changes to Emacs, this script will help you distribute your version to others. There are several subdirectories: `src' holds the C code for Emacs (the Emacs Lisp interpreter and its primitives, the redisplay code, and some basic editing functions). `lisp' holds the Emacs Lisp code for Emacs (most everything else). `lib-src' holds the source code for some utility programs for use by or with Emacs, like movemail and etags. `etc' holds miscellaneous architecture-independent data files Emacs uses, like the tutorial text and the Zippy the Pinhead quote database. The contents of the `lisp', `info' and `man' subdirectories are architecture-independent too. `info' holds the Info documentation tree for Emacs. `man' holds the source code for the Emacs manual. Note that the Emacs Lisp manual sources are distributed separately. (They are twice as large as the Emacs manual in the man subdirectory.) `msdos' holds configuration files for compiling Emacs under MSDOG. See the file etc/MSDOS for more information. `cpp' holds a C preprocessor for use instead of the installed one when the installed one fails to distinguish more than 8 characters in a symbol name. `vms' holds instructions and useful files for running Emacs under VMS. `nt' holds various command files and documentation files that pertain to running Emacs on Windows NT. emacs-19.30/BUGS100644 12120 1 1651 5600343344 11571 0ustar rmsdaemonIf you think you may have found a bug in GNU Emacs, please read the Bugs section of the Emacs manual for advice on (1) how to tell when to report a bug, and (2) how to write a useful bug report and what information it needs to have. There are three ways to read the Bugs section. (1) In a printed copy of the Emacs manual. You can order one from the Free Software Foundation; see the file etc/ORDERS. But if you don't have a copy on hand and you think you have found a bug, you shouldn't wait to get a printed manual; you should read the section right away as described below. (2) With Info. Start Emacs, do C-h i to enter Info, then m Emacs RET to get to the Emacs manual, then m Bugs RET to get to the section on bugs. Or use standalone Info in a like manner. (Standalone Info is part of the Texinfo distribution, not part of the Emacs distribution.) (3) By hand. Do cat info/emacs* | more "+/^File: emacs, Node: Bugs," emacs-19.30/move-if-change100777 13437 13 201 5205663037 13472 0ustar jimbuser#!/bin/sh if test -r $2 then if cmp $1 $2 > /dev/null then echo $2 is unchanged rm -f $1 else mv -f $1 $2 fi else mv -f $1 $2 fi emacs-19.30/ChangeLog100666 12120 1 325031 6055527202 12727 0ustar rmsdaemonFri Nov 24 23:40:55 1995 Richard Stallman * Version 19.30 released. * make-dist (lisp): Exclude subdirs.el. Wed Nov 22 17:44:34 1995 Richard Stallman * make-dist (etc): Delete *.orig and *.rej. Thu Nov 16 16:59:07 1995 Richard Stallman * Makefile.in (install-arch-indep): Rename old info/dir only if exists. Wed Nov 15 16:50:17 1995 Richard Stallman * configure.in (hppa*-hp-hpux10*): Use s/hpux10.h. Tue Nov 14 14:39:08 1995 Geoff Voelker * make-dist (nt): Rename install, readme, and todo to INSTALL, README, and TODO. Fri Nov 10 01:07:35 1995 Richard Stallman * make-dist (lisp): Don't distribute site-start. Mon Nov 6 17:00:58 1995 Karl Heuer * make-dist: Break the hard link on alloca.c. Sat Nov 4 12:41:57 1995 Richard Stallman * configure.in (LIBS): Add libsrc_libs and keep the old LIBS. Thu Nov 2 18:29:03 1995 Karl Heuer * make-dist (src, lib-src): Don't distribute Makefile.c. (etc/e): Do cleanup in $tempdir/etc/e, not $tempdir/etc. Tue Oct 31 15:57:22 1995 Richard Stallman * Makefile.in (mkdir): Create man1dir, not mandir. (uninstall): Use man1dir, not mandir. Mon Oct 30 12:49:31 1995 Richard Stallman * Makefile.in (man1dir): New variable. (install-arch-indep): Use man1dir. * configure.in (sparc-*-nextstep*): Remove incorrect .h's. * make-dist: Create lisp/MANIFEST. Sat Oct 28 17:01:41 1995 Andreas Schwab * configure.in (m68k-*-linux*): New alternative. Fri Oct 27 02:28:47 1995 Richard Stallman * make-dist: Use new names config.in, paths.in, and {src,lib-src}/Makefile.in. Wed Oct 25 15:23:23 1995 Karl Heuer * configure.in: Don't bother checking for drem. Fri Oct 20 18:07:42 1995 Richard Stallman * Makefile.in (distclean): Delete line with just a tab in it. (install-arch-indep): Delete spaces that precede tabs. Delete spurious `fi' left from previous change. (install): Supply `true' as command, to avoid null command. Thu Oct 5 12:35:26 1995 Richard Stallman * configure.in (--with-x-toolkit)): Add `athen' as alias for `athena'. Sat Sep 30 23:42:45 1995 Richard Stallman * configure.in (powerpc-*-solaris2): New alternative.x Tue Sep 12 13:42:33 1995 Karl Heuer * Makefile.in (src/paths.h, paths-force): Use paths.h.$$ instead of paths.h.tmp$$, to avoid going beyond 14 characters. Sun Sep 10 11:15:55 1995 Richard Stallman * configure.in: Improve error msg for invalid --with-x-toolkit value. Wed Sep 6 04:25:50 1995 Paul Eggert * configure.in (LOCALTIME_CACHE): Define if tzset exists and if localtime caches TZ. Check for tzset. Fri Sep 1 12:12:02 1995 Richard Stallman * config.bat: Simplify using new names file names src/makefile.in, config.in, paths.in. Change Echo commands not to use `. Thu Aug 31 22:39:51 1995 Richard Stallman * Makefile.in (install-arch-indep): Always install the new dir file; rename the previous dir file to dir.bak or dir.old. Mon Aug 14 19:13:37 1995 Richard Stallman * configure.in (RANLIB): Substitute this into makefiles. Set it specially on solaris; set it by default on other systems. * configure.in: Fix previous Alpha change. Sun Aug 13 01:08:48 1995 Richard Stallman * configure.in (i*386-*-isc4.*): Set GCC_TEST_OPTIONS and NON_GCC_TEST_OPTIONS. Thu Aug 10 01:00:49 1995 Richard Stallman * configure.in (CFLAGS): When computing CFLAGS and REAL_CFLAGS from config.h, use SPECIFIED_CFLAGS to get what the user specified. * configure.in (alpha-*-linux*): New configuration. Sat Aug 5 01:58:56 1995 Richard Stallman * configure.in (m68*-next-*): Use m68k.h and nextstep.h. (m68k-next-nextstep*): New alias for that. (i*86-*-nextstep*): Use nextstep.h. (sparc-*-nextstep*): New configuration. Wed Aug 2 22:05:03 1995 Richard Stallman * configure.in (CPP): Save original CFLAGS value in SPECIFIED_CFLAGS. And get CFLAGS from config.h if SPECIFIED_CFLAGS is null. Thu Jul 27 20:34:27 1995 Richard Stallman * configure.in: Handle sunos4shr by sharing; not like sunos4*. Determine GETTIMEOFDAY_ONE_ARGUMENT by experiment. Tue Jul 18 11:47:04 1995 Mike Long * make-dist: Fix update of finder-inf.el, and byte-compile it. Tue Jul 18 01:27:54 1995 Richard Stallman * Makefile.in (src/paths.h, paths-force): Rename src/paths.h.in to src/paths.in. (Makefile): Depend on src/Makefile.in, not src/Makefile.in.in. * configure.in: Rename {src,lib-src}/Makefile.in.in to Makefile.in. Use Makefile.c for intermediate file. Rename src/config.h.in to src/config.in. Mon Jul 17 17:53:57 1995 Richard Stallman * configure.in (mips-dec-ultrix*): Assume version 4.3. (mips-dec-ultrix4.[12]): New alternative for old versions. Thu Jul 6 14:08:34 1995 Karl Heuer * make-dist: Don't break intra-tree links. Thu Jul 6 01:42:51 1995 David J. MacKenzie * configure.in: Put back archlibdir initialization. Require autoconf 2.4.1 or later. Sat Jul 1 00:58:41 1995 Richard Stallman * configure.in: Use sunos4shr normally for Sunos 4.1.[3-9]. (mips-mips-riscos5*): New alternative. Thu Jun 29 20:04:21 1995 Richard Stallman * Makefile.in (uninstall, install-arch-indep): Install info/ediff*. Tue Jun 27 19:00:12 1995 Richard Stallman * configure.in (bindir, datadir, sharedstatedir, libexecdir) (mandir, infodir, archlibdir): Initializations deleted. * configure.in: On hpux9, use hpux9-x11r4.h if we have X11R4. On hpux9shr, use hpux9shxr4.h. Sat Jun 24 18:58:17 1995 Morten Welinder * configure.in: Added target mips-dec-mach_bsd4.3. * config.guess: Guess mips-dec-mach_bsd4.3. Sat Jun 24 14:42:51 1995 Richard Stallman * Makefile.in (mkdir): Use symbolic chmod. Thu Jun 22 07:45:40 1995 Paul Eggert * configure.in: Treat SunOS 4.1.4 like SunOS 4.1.3. (Likewise for SunOS 4.1.5 thorugh 4.1.9, should they ever exist.) Thu Jun 22 02:32:58 1995 Paul Eggert * Makefile.in (SUBDIR_MAKEFILES): Add man/Makefile, so `make distclean' removes it. (top_distclean): Add config.log to the list of files to be removed. Mon Jun 19 22:50:10 1995 Richard Stallman * Version 19.29 released. Sat Jun 17 08:43:47 1995 Richard Stallman * configure.in: Fix the previous change to verify that the -b option really solves the problem. * make-dist (nt): Explicitly include makefile.nt and makefile.def only. Fri Jun 16 11:26:47 1995 Richard Stallman * configure.in: Test whether XFree86 needs -b i486-linuxaout to link. Thu Jun 15 01:12:13 1995 Richard Stallman * configure.in: Report more clearly when there is no special dir to search for X includes or libraries. Tue Jun 13 17:44:10 1995 Karl Heuer * configure.in: Check for -lpthreads, not -lpthread. Fri Jun 9 22:09:46 1995 Geoff Voelker * make-dist: Copy new files nt/addpm.c and nt/emacs.bat.in. Thu Jun 8 23:09:14 1995 Karl Heuer * configure.in: Check for -lpthread. Mon Jun 5 23:09:10 1995 Karl Heuer * Makefile.in (install-arch-indep): Install info files for mh-e. (uninstall): Uninstall info files for dired-x, gnus, mh-e, and sc. Thu Jun 1 20:43:53 1995 Karl Heuer * configure.in (*-solaris2.5): New configuration. * make-dist: Copy new files config.nt and config.w95. Tue May 30 19:24:31 1995 Karl Heuer * configure.in: Use x_includes, not x_libraries, for -I. Make bitmapdir a colon-separated list. Sat May 27 23:18:21 1995 Richard Stallman * configure.in (hppa*-hp-hpux10*, m68k-hp-hpux10*): New configurations. * configure.in: Allow x_libraries and x_includes to be paths. Thu May 25 11:53:13 1995 Karl Heuer * configure.in: Fix typo. Wed May 24 16:50:02 1995 Karl Heuer * INSTALL: Clarify use of site-init.el. Mon May 22 18:28:23 1995 enami tsugutomo * configure.in: pass arg to sqrt. Thu May 18 23:52:46 1995 Karl Heuer * make-dist: Fix May 6 change. Wed May 17 15:42:16 1995 Karl Heuer * vpath.sed: Delete reference to ymakefile. Tue May 9 14:10:07 1995 David J. MacKenzie * configure.in: Use sqrt (more portable) instead of fmod in -lm check. Tue May 9 00:26:22 1995 Richard Stallman * make-dist: Put nt/emacs.ico and nt/emacs.rc in dist. * update-subdirs: Specify /bin/sh to run the script. Sat May 6 17:54:06 1995 Richard Stallman * make-dist: Put src/makefile.nt in dist. * configure.in (i[345]86-*-bsdi2*): New configuration. (vax-dec-bsd386*): Deleted. Sat May 6 17:27:25 1995 David J. MacKenzie * configure.in: Make sure CDPATH doesn't mess up PWD check. Check whether X bitmaps are in X11/bitmaps instead of bitmaps. Use fmod instead of logb in -lm check. Wed May 3 15:28:44 1995 Richard Stallman * configure.in (m68*-apollo-*): Renamed from m68*-apollo*. Use bsd4-3. Don't set NON_GNU_CPP. * make-dist: Don't copy in src/s/*.inp. Don't copy nt/src. In nt. copy various different things, but not *.cmd. Fix the ln commands for the subdirs of nt. Sat Apr 29 01:47:36 1995 Richard Stallman * configure.in (*-sun-sunos4.1.3*): Use sunos4shr.h. Thu Apr 27 21:23:32 1995 Karl Heuer * configure.in (*-sun-sunos4.1.3*): Use shared libraries, since that's what the header file expects. Mon Apr 24 14:23:35 1995 Francesco Potorti` (pot@cnuce.cnr.it) * configure.in (m68k-motorola-sysv*): Distinguish between 68030 and 68040 based machines when choosing options for gnucc. Thu Apr 13 00:56:10 1995 Richard Stallman * Makefile.in (top_distclean): Delete config.cache. Fri Apr 7 14:21:11 1995 Richard Stallman * Makefile.in (install-arch-indep): Delete .#* when copying subdirs. * configure.in: Use m/ncr386.h. Thu Apr 6 17:52:31 1995 Richard Stallman * Makefile.in (install-arch-indep): Undo Sep 23 change. Thu Apr 6 16:58:26 1995 Karl Heuer * make-dist (lib-src): Don't copy *.lex; it doesn't exist anymore. (man): Don't copy texindex.c and getopt.c; they're deleted. (etc): Omit `e'; it's a subdirectory. (etc/e): Use `../..', not `..', to reference top level. Thu Apr 6 18:00:24 1995 Simon Leinen * Makefile.in (install-arch-indep, dist): look for `update-subdir' in $(srcdir). Thu Apr 6 15:50:22 1995 Richard Stallman * make-dist: Include mkinstalldirs in distribution. Wed Apr 5 16:45:13 1995 Karl Heuer * make-dist: Add missing close backquote. Sun Apr 2 18:14:00 1995 Richard Stallman * make-dist: Don't distribute shortnames directory. Sun Mar 12 01:11:14 1995 Richard Stallman * Makefile.in (blessmail): Pass archlibdir to the sub-make. Sat Feb 25 22:42:47 1995 Richard Stallman * configure.in (m88k-motorola-sysv4*): Use usg5-4-2. Thu Feb 23 19:45:30 1995 Karl Heuer * configure.in (EMACS_CONFIG_OPTIONS): Use $ac_configure_args. Mon Feb 13 19:53:22 1995 Richard Stallman * configure.in (mips-sgi-irix6): New configuration. Tue Feb 7 18:50:09 1995 Richard Stallman * Makefile.in (maintainer-clean): Renamed from realclean. Thu Feb 2 11:18:47 1995 David J. MacKenzie * configure.in: Create a .gdbinit that sources the real one, if using a different build directory. Mon Jan 23 18:33:59 1995 Karl Heuer * configure.in: Check for sys/select.h. Mon Jan 2 03:49:12 1995 Richard Stallman * configure.in: On sunos4.1.3 and sunus4shr, set NON_GNU_CPP. Tue Dec 27 12:55:07 1994 Richard Stallman * configure.in: Handle isc 4.1 operating system. Sat Dec 10 16:50:12 1994 Richard Stallman * configure.in (rs6000-ibm-aix4.1*): New alternative. (rs6000-ibm-aix4*): New alternative. Tue Dec 6 18:44:31 1994 Richard Stallman * configure.in: For SVR4.2, set NON_GNU_CPP if not already set. Wed Nov 30 17:13:58 1994 David J. MacKenzie * configure.in: Don't try to make directories that are guaranteed to already exist. Wed Nov 23 15:16:28 1994 Richard Stallman * configure.in: Generate man/Makefile from man/Makefile.in. Create the man subdir. * Makefile.in (dvi): Run Make in our man subdir. * make-dist: Create subdir etc/e. Make links to it. Put man/Makefile.in in dist, instead of man/Makefile. Mon Nov 21 22:17:37 1994 David J. MacKenzie (djm@mole.gnu.ai.mit.edu) * configure.in: Add --with-pop, --with-kerberos, and --with-hesiod for movemail. Thu Nov 17 10:13:02 1994 Richard Stallman * configure.in (m68*-apollo*): Use s/domain.h. Mon Nov 14 23:23:00 1994 Richard Stallman * configure.in (m68*-apollo*): Set NON_GNU_CPP. Mon Nov 14 12:06:48 1994 David J. MacKenzie (djm@geech.gnu.ai.mit.edu) * configure.in: Don't add -I, -L, -R options for cc if their arguments would be empty. Fri Nov 11 09:54:09 1994 Richard Stallman * configure.in (i860-intel-osf1*): New alternative. (mips-sgi-irix5.[01]*): Distinguish from irix5*. (mips-sgi-irix*): Now an alias for mips-sgi-irix5*. Wed Nov 9 16:09:31 1994 David J. MacKenzie * configure.in: Make h_errno check not use nested functions. Wed Nov 9 06:47:46 1994 Richard Stallman * Makefile.in (install-arch-indep): Delete *.orig in copied dirs. Tue Nov 8 19:25:41 1994 Roland McGrath * Makefile.in (install-arch-indep): Avoid continued comment swallowing target line. Tue Nov 8 00:21:18 1994 David J. MacKenzie (djm@churchy.gnu.ai.mit.edu) * configure.in: Protect a character class with `changequote'. Mon Nov 7 21:50:37 1994 Karl Heuer * configure.in: Accept `news' as a synonym for `newsos'. Thu Nov 3 15:23:24 1994 Karl Heuer * Makefile.in: Don't rm files if cd fails. Tue Nov 1 05:38:27 1994 Richard Stallman * make-dist: Put nt subdir and its subdirs in the dist. (lib-src): Put makefile.nt in the dist. (lisp): Put makefile.nt in the dist. Sat Oct 29 08:44:36 1994 David J. MacKenzie (djm@geech.gnu.ai.mit.edu) * configure.in: Change a stray `[' to `test'. Fri Oct 28 11:29:07 1994 David J. MacKenzie * configure.in: Adapt for Autoconf v2. Use the standard argument parser, host type canonicalizer, X11 finder, and message printing macros. Use the new macro names. Use `test' instead of `['. Wed Oct 26 19:18:49 1994 Richard Stallman * configure.in: Check for getpagesize. Mon Oct 17 21:44:25 1994 Richard Stallman * make-dist (msdos): Put sed* in the distribution. Mon Oct 17 03:33:32 1994 Morten Welinder * config.bat: New option, `--with-x', for configuring Emacs for use with the X11 system DesqView/X. New option, `--no-debug', for compiling Emacs without debug information thus saving disk space. (src/config.h, src/paths.h): Use `update' (which is like `move-if-changed') to change the file. (src/config.h): When configuring for X11 perform extra changes. (src/makefile): When configuring for X11 perform extra changes. (lib-src): Remove temporary files. (): Check that `sed', `rm', `mv', and `gcc' are available. Mon Oct 17 00:27:09 1994 Richard Stallman * Makefile.in (sharedstatedir): Substitute sharedstatedir properly. * configure.in (bitmapdirs): Default to /usr/include/X11/bitmaps. Sun Oct 16 05:20:37 1994 Richard Stallman * configure.in (EMACS_CONFIGURATION): Use $canonical as value. * configure.in (canonical): Substitute var into makefiles. (bitmapdir): Likewise. * Makefile.in (bitmapdir): New variable. (src/paths.h, paths-force): Edit PATH_BITMAPS. Sat Oct 15 23:53:15 1994 Richard Stallman * make-dist: Put update-subdirs and lisp/subdirs.el in the dist. * Makefile.in (dist, install-arch-indep): Run update-subdirs. * update-subdirs: New shell script. Thu Oct 13 00:02:35 1994 Richard Stallman * Makefile.in (top_distclean): Don't rm build-install. (SOURCES): Delete build-install.in. * make-dist: Don't distribute build-ins.in. * build-ins.in: File deleted. Wed Oct 12 19:29:05 1994 David J. MacKenzie (djm@duality.gnu.ai.mit.edu) * Makefile.in (mkdir): Use mkinstalldirs instead of make-path. Tue Oct 11 04:05:30 1994 Richard Stallman * Makefile.in: Use libexecdir and sharedstatedir as appropriate. * configure.in (libexecdir): Renamed from libdir. New default. (sharedstatedir): Renamed from statedir. New default. (datadir): New default. * make-dist: Don't distribute subdirs.el. Fri Oct 7 04:38:54 1994 Richard Stallman * configure.in (eaccess): Check for it. Tue Oct 4 05:00:42 1994 Richard Stallman * configure.in (mktime): Check for it. Sun Oct 2 07:30:52 1994 Paul Reilly * configure.in (motif): Add support for usage and option checking. Sat Sep 24 20:36:04 1994 Richard Stallman * configure.in (utimes): Check for it. Fri Sep 23 21:54:03 1994 Richard Stallman * Makefile.in (install-arch-indep): Don't do mkdir here. Wed Sep 21 17:56:10 1994 Richard Stallman * configure.in (arm-acorn-riscix1.1*, arm-acorn-riscix1.2*): riscix.h renamed to acorn.h. Wed Sep 21 17:51:58 1994 Michael Ben-Gershon (mybg@cs.huji.ac.il) * configure.in (arm-acorn-riscix1.1*, arm-acorn-riscix1.2*): New configurations. Wed Sep 21 12:59:04 1994 David J. MacKenzie (djm@geech.gnu.ai.mit.edu) * configure.in: Remove trailing slashes from srcdir. Wed Sep 21 05:28:03 1994 Richard Stallman * configure.in (i[345]86-sequent-ptx*): Handle Tue Sep 20 18:16:15 1994 Richard Stallman * Makefile.in (paths-force): Depend on src/paths.h Mon Sep 19 14:13:58 1994 Karl Heuer * configure.in (config_options): Save all arguments, not just some. Sun Sep 18 14:40:00 1994 Karl Heuer * Makefile.in (install-arch-indep): Copy DOC-*, not DOC* * configure.in: Add AC_AIX. Add checks to set HAVE_STRUCT_UTIMBUF, HAVE_TIMEVAL, HAVE_SELECT. Sun Sep 18 04:18:20 1994 Richard Stallman * configure.in (parsing options): Simplify sed command to delete -'s. Fri Sep 16 22:06:49 1994 Karl Heuer * configure.in (config_options): New shell variable. Pass its value to C code in EMACS_CONFIG_OPTIONS. Fri Sep 16 19:35:47 1994 Richard Stallman * configure.in (alpha-dec-osf*): New target. * Makefile.in: Use just one FRC target. Thu Sep 15 20:02:04 1994 Richard Stallman * Makefile.in (removenullpaths, paths-force): Use name paths.h.tmp$$, which depends on the pid. Wed Sep 14 23:42:03 1994 Richard Stallman * Makefile.in (removenullpaths, paths-force): Put paths.h.tmp in top-level dir, not in src. Sun Sep 11 14:56:01 1994 Richard Stallman * Version 19.27 released. Wed Sep 7 03:53:50 1994 Richard Stallman * Version 19.26 released. Sun Sep 4 03:02:15 1994 Richard Stallman * configure.in: Check for lrand48, not rand48. Sat Sep 3 18:44:55 1994 Richard Stallman * configure.in (powerpc-ibm-aix3.1*, powerpc-ibm-aix3.2.5) (powerpc-ibm-aix*): New aliases. Sun Aug 21 14:02:00 1994 Richard Stallman * make-dist (src/m, src/s): Put *.inp in distribution. Fri Aug 19 20:01:09 1994 Richard Stallman * configure.in: Accept i586 and i486 along with i386. Mon Aug 15 05:18:12 1994 Richard Stallman * configure.in: Do compute unexec, LIBX, system_malloc, etc even if CPP env var was set by the user. * configure.in (i[34]86-*-*): For SCO 3.2v4, fix NON_GNU_CPP value. Sun Aug 14 00:10:08 1994 Jonathan I. Kamens (jik@gza-client1.aktis.com) * Makefile.in: Uninstall "$(EMACS)", not "emacs". Sat Aug 13 16:34:59 1994 Richard Stallman * configure.in (i[34]86-*-*): For SCO 3.2v4, set NON_GNU_CPP. Tue Aug 9 23:20:18 1994 Richard Stallman * configure.in: Check more specifically for i*86-sun-sunos. Wed Aug 3 21:53:58 PDT 1994 Caveh Jalali (caveh@eng.sun.com) * configure.in: Handle solaris 2.4. Wed Jul 27 13:34:18 1994 Richard Stallman * configure.in (rand48): Check for it. Tue Jul 26 15:52:58 1994 Richard Stallman * make-dist: Update the info files. Mon Jul 25 16:35:16 1994 Richard Stallman * configure.in: Make "checking..." messages' style consistent. (HAVE_H_ERRNO): New test. Sun Jul 24 16:18:09 1994 Richard Stallman * configure.in (i860-*-sysv4*): Set NON_GNU_CC and NON_GNU_CPP. Tue Jul 12 00:03:39 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (CFLAGS): If the envvar was specified, use that. And set REAL_CFLAGS from it too. Mon Jul 11 16:28:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-dist: Update finder-inf.el. Thu Jul 7 12:57:42 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-dist (msdos): Include sed4.inp in dist. * Makefile.in (libsrc_libs): Var deleted. Wed Jul 6 22:39:26 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (mkdir, removenullpaths): Put g in sed replace commands. Sun Jun 26 12:26:40 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (mips-sony-newsos4*): New alias. Thu Jun 23 15:21:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (*-convex-bsd*): Set NON_GNU_CPP. (*-convex-convexos*): Accept this as alias. Sun Jun 19 11:40:01 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Get CFLAGS both with and without THIS_IS_CONFIGURE, for two different uses. Wed Jun 15 22:30:18 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Define THIS_IS_CONFIGURE when extracting CFLAGS etc. Tue Jun 14 10:51:06 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-dist: Put ./BUGS into the distrib. Mon Jun 13 17:12:32 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Handle 386 running Solaris 2. Mon Jun 6 04:46:27 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (mips-siemens-sysv*): Use cpp, not cc -E. Sun Jun 5 06:44:16 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (mips-sony-newsos*): Use news-risc.h. * configure.in: Accept bsdi as opsys, like bsd386. Wed Jun 1 20:03:31 1994 Morten Welinder (terra@diku.dk) * config.bat (src/paths.h): Use sed script msdos/sed4.inp. Mon May 30 04:33:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.25 released. * make-dist (shortversion): Don't assume another period follows. Fri May 27 01:45:34 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (install-arch-indep): Use /bin/pwd uniformly, not pwd. (uninstall): Use /bin/pwd. * Makefile.in (blessmail): Depend on src. (all): Don't depend on blessmail. * Makefile.in (src/paths.h): Don't force recomputation. (paths-force): New target; force recomputation of paths.h. (all): Depend on paths-force. (src, lib-src): Depend on src/paths.h. * configure.in (*-sun-sunos4*): Set GCC_TEST_OPTIONS, NON_GCC_TEST_OPTIONS. Thu May 26 05:04:55 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Don't insist on subversions for irix. Tue May 24 00:03:58 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (hppa*-hp-hpux9shr): Move alternative up. * configure.in (i[34]86-next-*): New alternative. Mon May 23 03:07:50 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.24 released. * configure.in: New config hppa*-hp-hpux9shr*. Sun May 22 18:30:22 1994 Morten Welinder (terra@tyr.diku.dk) * config.bat: Doc fix. Sat May 21 03:17:49 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (mostlyclean, clean, distclean, realclean) (extraclean): Don't act on man subdir if it doesn't exist. Fri May 20 18:03:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (GCC_TEST_OPTIONS, NON_GCC_TEST_OPTIONS): New vars. Use them to set up CC. (*-sun-sunos4.1.3): Set them. Thu May 19 11:54:43 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (lib-src): Don't depend on src/paths.h. Wed May 18 01:35:38 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * build-ins.in (copydests): Get rid of spurious `-'s. * configure.in: Define EMACS_CONFIGURATION instead of CONFIGURATION. Tue May 17 00:41:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.23 released. * configure.in [HAVE_X11]: Merge $C_SWITCH_X_SITE into CFLAGS for the Xlib and Xt checks; then restore old CFLAGS. Sun May 15 01:20:57 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (HAVE_X11XTR6): Add newline before #if. Add newline after #endif. Fri May 13 17:01:41 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (HAVE_X11XTR6): Arrange to define it. Thu May 12 06:51:21 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (install): Depend on blessmail. Thu May 12 03:35:55 1994 David J. MacKenzie (djm@nutrimat.gnu.ai.mit.edu) * configure.in (mips-siemens-sysv*): Put quotes around value containing blanks. Wed May 11 22:20:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (TAGS): Use the makefile in src subdir. Tue May 10 16:50:14 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * configure.in (opsys): Recognize `gnu'. Tue May 10 16:08:30 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (using NON_GNU_CPP): Fix test for CPP already set. Mon May 9 10:24:59 1994 David J. MacKenzie (djm@nutrimat.gnu.ai.mit.edu) * configure.in: Remove AC_LANG_C call. Not needed with Autoconf version > 1.8. Sun May 8 07:35:11 1994 Morten Welinder (terra@diku.dk) * config.bat: Forcibly remove "# " style comments from makefiles. Sun May 8 15:50:34 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (uninstall): When processing lispdir and etcdir, do nothing unless it exists and is a directory. Fri May 6 19:21:54 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (install-arch-indep): Do install info/dired-x*. Merge code in from install-doc. (install-doc): Merge code back into install-arch-indep. (install-arch-dep): Don't depend on install-doc. * configure.in (run_in_place): Don't use pwd for archlibdir and docdir. Wed May 4 15:40:03 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (making src/Makefile and lib-src/Makefile): Split off the autoconf substitutions and don't pass them thru cpp. (undefs): Use $canonical as well as $configuration. * make-dist: Distribute lisp/Makefile. * configure.in: Recognize m88k-dg-dgux5.4.3* and m88k-dg-dgux5.4.2*. Use lower case names for the s files. Fri May 3 12:01:09 1994 Morten Welinder (terra@diku.dk) * config.bat: Added possibility for different file name transscriptions in lib-src. Tue May 3 04:17:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (lib-src): Undo previous change. (blessmail): New target to run maybe-blessmail in lib-src. (all): Depend on blessmail. * Makefile.in (lib-src): Depend on src. Sat Apr 30 15:28:58 1994 Paul Reilly (pmr@churchy.gnu.ai.mit.edu) * configure.in (m88k-dg-dgux5.4R3): Use dgux5-4R3. (m88k-dg-dgux5.4R2): dgux5.4R2. Fri Apr 29 15:25:39 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (window_system): Restore accidentally deleted code that uses AC_FIND_X. * make-dist: Distribute config.bat. Fri Apr 29 00:38:09 1994 Morten Welinder (terra@diku.dk) * config.bat: Corrected the configuration of lib-src to keep up with configure. Add note about dos version 3 or better needed (djgpp needs that). Add note explaining that either install in c:/emacs or edit the script. Don't change to c:/emacs, but assume we're there (to minimize the number of places to change). * config.bat: Build-in the first step towards X11 support with the X11 emulator that exists. At this time it won't work, and several files are missing. Thu Apr 28 00:13:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Use m/hp800.h in place of m/hp9000s800.h. Don't look for -lresolv. * Makefile.in (lib-src): Depend on src/paths.h. Wed Apr 27 01:12:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Restore deleted AC_SUBST of `configuration'. Improve error message for bad --with-x-toolkit value. * configure.in: Define CONFIGURATION in src/config.h rather than substituting in src/Makefile.in. Tue Apr 26 18:05:01 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * Makefile.in (install-doc): New target. (install-arch-dep): Depend on install-doc. (mkdir): Create docdir. Fri Apr 22 21:39:24 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Test for libresolv.a. Substitute machfile and opsysfile. Fri Apr 22 21:03:11 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * Makefile.in (.PHONY, install): Kill reference to obsolete do-install. (install-arch-dep): Install under the name $(EMACS). Thu Apr 21 02:06:52 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (version): Use entire value of emacs-version. (mips-siemens-sysv*): New alternative. Tue Apr 19 19:12:35 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (install-arch-indep): Don't install dired-x*. Mon Apr 18 20:39:12 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * configure.in (src/Makefile, lib-src/Makefile): Delete ^L. Fix definition of $undefs. Sun Apr 17 20:02:17 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (window_system): Obey --with-x11=no and --with-x10=no. * configure.in (lib-src/Makefile.in): Use src, not lib-src, in -I. Sat Apr 16 15:02:02 1994 David J. MacKenzie (djm@nutrimat.gnu.ai.mit.edu) * configure.in: Call AC_LANG_C, if it's defined, after AC_PREPARE. Sat Apr 16 00:22:39 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (lib-src/Makefile.in): Make this from Makefile.in.in and run it thru cpp, as with src/Makefile.in. * configure.in: Use AC_SET_MAKE. Fri Apr 15 21:08:30 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (i[34]86-ncr-sysv*): Use usg5-4-2. Wed Apr 13 13:51:27 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (MAKE): Don't just assign it--use @SET_MAKE@. * configure.in (CFLAGS): Exclude ${CFLAGS} from singlequotes. (printing the choices): Make the toolkit message unconditional. (USE_X_TOOLKIT): Use `none', not `no', if none. (include libsrc_libs): Include config.h, and specify -I for srcdir. Get rid of temp file foofoo1. Wed Apr 13 13:12:30 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * configure.in (CFLAGS): Use shell syntax, not Makefile. Tue Apr 12 11:23:19 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (window_system): If no X, set USE_X_TOOLKIT=no. (printing the choices): State choice of toolkit. (libsrc_libs): Recalculate after writing config.h; then update lib-src/Makefile. Mon Apr 11 21:55:23 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Add sunos4shr as alternative for suns. Conditionals testing for null $CC were backwards. Sun Apr 10 05:08:40 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-dist (msdos): Don't link patch1. Link sed*.inp, not sed.in*. Sat Apr 9 17:42:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Handle -isc4.0*. Wed Mar 30 23:39:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (esix5): Set NON_GNU_CPP. Thu Mar 24 18:41:36 1994 Roland McGrath (roland@mole.gnu.ai.mit.edu) * Makefile.in (thisdir): Nonsensical variable removed. (install-arch-indep): Set shell var thisdir=`pwd` before cd and cd back to $thisdir, rather than the directory `this_dir'. Thu Mar 17 19:31:18 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * Makefile.in (install-arch-indep): Add missing backslash after a `then'. Mon Mar 14 17:06:48 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (thisdir): New variable. (install-arch-indep): Go back to thisdir to run INSTALL_DATA. Tue Mar 8 17:37:19 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * configure.in: Add freebsd. Tue Mar 8 01:52:10 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * configure.in: Check for fpathconf. Wed Mar 2 00:56:50 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * configure.in (with_x_toolkit): Fix typo in previous change. Tue Mar 1 22:21:55 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * configure.in: New s-file for rs60000-ibm-aix3.2.5. Sat Feb 26 17:04:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (with_x_toolkit): Don't allow motif or open-look. Thu Feb 24 16:16:10 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * configure.in: Fix value of docdir. * Makefile.in (install-arch-indep): Install DOC* in docdir. Thu Feb 24 15:41:16 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (*-sysv4.1): Set NON_GNU_CPP. Tue Feb 22 19:05:02 1994 Karl Heuer (kwzh@geech.gnu.ai.mit.edu) * configure.in: New variable docdir to control where the docstring file goes. Makefile.in: Use it to initialize PATH_DOC in paths.h. Tue Feb 22 16:52:54 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * configure.in: When --run-in-place, don't inherit archlibdir. Sat Feb 19 22:23:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (install-arch-dep, install-arch-indep): New targets split up former do-install rule. (do-install): Target deleted. Wed Feb 16 21:16:54 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (mips-sony-newsos*): New configuration. Mon Feb 14 11:38:35 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * configure.in (rs6000-bull-bosx*): Added support for BULL dpx20. Fri Feb 11 21:27:09 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * configure.in: Fix misspelled symbol LD_SWITCH_X_SITE_AUX. Fri Feb 11 16:29:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Don't initialize CC. Thu Feb 10 21:48:39 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * configure.in (creating src/Makefile): Also generate -U switches for symbols in the $configuration value. * configure.in: Check for sys_siglist being declared in system header. Thu Feb 10 14:32:21 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (creating src/Makefile): Delete blank lines along with lines of whitespace. (m68k-motorola-sysv*, m68000-motorola-sysv*): Compute proper CC value. Wed Feb 9 16:02:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Get, use, and substitute C_SWITCH_MACHINE like C_SWITCH_SYSTEM. (m68*-motorola-sysv*): Set CC. Require cpu type to be m68k or m68000. Fri Feb 4 15:21:29 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * configure.in (drem): Check for this function. Thu Feb 3 00:53:53 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (Using NON_GNU_CPP): Don't lose if it has spaces. If CPP was inherited from environment, don't use NON_GNU_CPP. (NON_GNU_CC): Likewise. (handling with_gcc): Use explicit if in the `no' case. (cc_specified): New variable; if set, don't use NON_GNU_CC. Wed Feb 2 17:34:19 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (mips-mips-riscos4*): Set NON_GNU_CPP. Tue Feb 1 18:16:09 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * configure.in: Check whether fmod exists. Mon Jan 31 18:57:56 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * make-dist: Distribute {src,lisp}/ChangeLog.? instead of {src,lisp}/OChangeLog. Sat Jan 22 18:18:23 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * configure.in: Restore Jan 8 and Jan 16 changes. The -U hack is necessary for proper operation. This code works with the current released version of Autoconf. Fri Jan 21 01:36:39 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (with_x_toolkit): Treat values athena and lucid alike. (USE_X_TOOLKIT): Define it for all values except `no'. * configure.in: Undo first Jan 8 change and Jan 16 change. Tue Jan 18 18:47:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Handle --with-x-toolkit. Produce lwlib/Makefile. Substitute USE_X_TOOLKIT as both C macro and Make variable. * Makefile.in (lwlib/Makefile): New target. (SUBDIR_MAKEFILES): Depend on lwlib/Makefile. (clean, mostlyclean, distclean, realclean): Handle lwlib subdir. (unlock, relock): Handle lwlib subdir. * Makefile.in: Add some .PHONY targets. * make-dist: Handle lwlib subdir like oldXMenu subdir. * lwlib: New subdirectory. Mon Jan 17 17:17:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: If CPP has a value that is a directory, discard the value. Sun Jan 16 04:58:47 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * configure.in (srcdir_undefs): Add g flag to sed substitution to remove -U[0-9]*. Sat Jan 15 10:14:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (do-install): Install the dired-x info files. * configure.in: Provide for variable LD_SWITCH_X_SITE_AUX. (See src/s/sol2.h.) Wed Jan 12 23:43:08 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (m68k-harris-cxux*, m88k-harris-cxux*): New configs. Sat Jan 8 16:37:36 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * configure.in (creating src/Makefile): Put code inside 2nd arg to AC_OUTPUT as it should be; hopefully noone will again see fit to gratuitously break this and not make a change log entry. Optimized sed processing of Makefile.in and cpp output; now preserves comments previously removed from the cpp input. Eliminated temp file for cpp output. Generate -U switches to undefine all identifiers that appear in the directory name ${srcdir}; pass these to cpp. * configure.in (version): Fix sed regexp to match two-elt version number. * configure.in: Check for strerror. Fri Jan 7 00:55:28 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Test for bcmp. Thu Jan 6 07:36:28 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-dist (tempdir): Put subdir msdos into the distribution. Fri Jan 7 22:20:15 1993 Morten Welinder (terra@diku.dk) * config.bat: New file. Sun Jan 2 13:54:12 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (${SUBDIR} target): Pass down LDFLAGS and CPPFLAGS. Sat Jan 1 12:11:53 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (m68*-next-*): Don't care about which os is specified. (i[34]86-*-*): Check for *-nextstop*. Fri Dec 24 20:43:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Check for setsid. Fri Dec 17 13:11:44 1993 Richard Stallman (rms@srarc2) * configure.in (*-sun-solaris*): Add special case for Solaris 2.3. Wed Dec 15 14:03:05 1993 Richard Stallman (rms@srarc2) * Makefile.in (mkdir): Make only the lockdir writable. * configure.in (i860-*-sysv4): Renamed from i860-*-sysvr4. Sat Dec 11 15:56:10 1993 Richard Stallman (rms@srarc2) * Makefile.in (libdir): Use @libdir@. Wed Dec 8 22:30:27 1993 Richard Stallman (rms@srarc2) * Makefile.in (install): Add empty command. Sat Dec 4 14:15:50 1993 Richard Stallman (rms@srarc2) * make-dist: Put man/getopt.c in the dist. * configure.in (LIBS): Add test for existence of XSetWMProtocols. * Makefile.in (install): Depend on ${SUBDIR}, not `all'. Fri Dec 3 16:41:58 1993 Richard Stallman (rms@srarc2) * configure.in (solaris): Set NON_GNU_CPP instead of CPP. Set it for all solaris versions. (mips-mips-riscos4*): Set NON_GNU_CC, not CC. (after checking for GCC): If not GCC, and NON_GNU_CPP is set, set CPP. Likewise for NON_GNU_CC and CC. Wed Dec 1 22:59:18 1993 Richard Stallman (rms@srarc2) * configure.in (mips-mips-riscos4*): Assign variable CC. (checking ${with_gcc}): If "no", don't override CC if already set. (CC): Initialize it as empty. Tue Nov 30 14:54:34 1993 Richard Stallman (rms at srarc2) * configure.in (Suns): Set CPP if *-solaris2.3*. Sat Nov 27 04:14:28 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.22 released. * Makefile.in (do-install): Use umask 022 in copying etc and lisp dirs. Thu Nov 25 16:46:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-dist: When breaking links, use cp -p. Copy install.sh into distribution. Move the temp dir up into the parent dir; don't leave the staging dir make-dist.tmp... in existence. * install.sh: New file. Sun Nov 21 04:01:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (i[34]86-ncr-sysv*): New specific alternative. Sat Nov 20 01:03:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (version): When --run-in-place, exclude ${datadir}/emacs/site-lisp from locallisppath. Thu Nov 18 00:56:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Delete jumk.c before writing it. Tue Nov 16 00:56:51 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.21 released. * Makefile.in (mkdir): Ignore error from chmod. Mon Nov 15 05:11:55 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-dist: Don't put lisp/forms.README in the distribution. Sat Nov 13 04:37:15 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (creating src/Makefile): Before running cpp, discard all lines that start with `# Generated' or /**/#. Thu Nov 11 09:52:37 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.20 released. * make-dist: Use build-ins.in, not build-install.in. Don't bother updating TAGS since it's not included. * build-ins.in: Renamed from build-install.in. Wed Nov 10 16:02:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-dist: Don't try to link *.texinfo--there are none now. When running make in lib-src, specify YACC var value. Sun Oct 3 15:55:17 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * configure.in (extrasub): Add vpath patterns for %.[yls]. * configure.in: Don't do seddery on config.status after AC_OUTPUT. Instead just include the commands to make src/Makefile as the second arg to AC_OUTPUT. * configure.in: Use : instead of dnl for comment inside $makefile_command. * configure.in: No longer use vpath_sed. Instead, when we notice srcdir already configured, set extrasub to hack vpath in the makefiles. * configure.in: In cmds to make src/Makefile, chmod Makefile.new before moving it. * Makefile.in (VPATH): Define to @srcdir@. Tue Sep 28 03:25:46 1993 Brian Fox (bfox@cubit) * configure.in: Don't copy ${srcdir}/src/Makefile.in; that file doesn't exist. Just copy src/Makefile.in instead. Touch all of the Makefiles after editing config.status. * INSTALL: Update documentation to match new configuration mechanism. Mon Sep 27 08:51:38 1993 Brian Fox (bfox@ai.mit.edu) * configure.in: Allow any of the path or directory Makefile variables to be set with flags to configure. Create all Makefiles at configure time. Edit special commands into config.status after src/Makefile.in is built from src/Makefile. * Makefile.in (src/Makefile, lib-src/Makefile, oldXMenu/Makefile): If these files are out of date, simply have config.status rebuild them; don't rebuild them explicitly. Sat Sep 25 12:00:38 1993 Brian Fox (bfox@ai.mit.edu) * build-install.in: Change src/xemacs to src/emacs. We no longer create src/xemacs, so the file wouldn't be found. * make-dist: Remove `src/ymakefile', add `src/Makefile.in.in'. Fri Sep 24 03:07:35 1993 Brian Fox (bfox@albert.gnu.ai.mit.edu) * configure.in: Avoid forcing the search of /usr/include before fixed include files by resetting C_SWITCH_X_SITE if it is "-I/usr/include". Mon Sep 20 09:47:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (@rip_paths@locallisppath): Delete ${datadir}/emacs/site-lisp. Sun Sep 15 19:54:04 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * configure.in: Use AC_QUOTE_SQUOTE twice to properly quote vpath_sed value. Remove ${extra_output} from AC_OUTPUT call. Fri Sep 17 13:22:22 1993 Brian Fox (bfox@inferno) * make-dist: Quote backquotes found in strings to be echoed. * configure.in: Use "sh -c pwd" when we want to avoid having the shell fix up the value of $PWD. Mon Sep 13 21:06:16 1993 Brian Fox (bfox@inferno) * Makefile.in (do-install): Don't abort if ln or chmod at the end of the installation fail. Suggested by Karl Berry. Mon Aug 30 07:41:04 1993 Brian Fox (bfox@inferno) * Makefile.in (*clean): Use "$(MAKE) $(MAKEFLAGS)" wherever "make" was used. Set MAKEFLAGS from MFLAGS. Thu Sep 16 16:08:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Test for res_init in libc. Mon Sep 13 11:56:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: In the file ${tempcname}, use configure___ instead of @configure@. Sun Sep 12 10:51:49 1993 Roland McGrath (roland@sugar-bombs.gnu.ai.mit.edu) * make-dist: Dist vpath.sed * Makefile.in (lib-src/Makefile, src/Makefile, oldXMenu/Makefile): Depend on vpath.sed. Replace sed comand for VPATH with @vpath_sed@. * configure.in: Substitute variable `vpath_sed'. If not in $srcdir and $srcdir is configured, issue warning that GNU make is required, and set vpath_sed to use vpath.sed script. Fri Sep 10 01:18:13 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * configure.in: Remove check for $srcdir being configured. This pretty much works now. Grok {m68*-hp,i[34]86-*}-netbsd* and set opsys=netbsd. Check for XFree86 (/usr/X386/include) independent of whether -lXbsd exists. * Makefile.in (info, dvi, clean, mostlyclean, distclean, realclean, unlock, relock): Use `$(MAKE)' in place of plain `make'. Sat Aug 14 01:31:37 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.19 released. * configure.in (i386-*-sunos4): Assume Sunos 4.0. Fri Aug 13 18:17:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Check for XScreenNumberOfScreen. Thu Aug 12 01:01:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Add * to end of all configuration alternatives. (m68*-sony-newsos3*): New alternative. Wed Aug 11 00:12:45 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-dist: Include getdate.c in distribution. * configure.in: For --help, use $PAGER if it is set. (LIB_X11_LIB): Default to -lX11. (mips-sgi-irix5.*): New alternative. * Makefile.in (do-install): Install info/gnus* and info/sc*. * configure.in (m68*-hp-hpux*, hppa*-hp-hpux*): Recognize *.B8.* as hpux version 8. (m68*-tektronix-bsd*): Fix typo in tek4300. (AC_HAVE_FUNCS): Add ftime. Tue Aug 10 17:30:07 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (m88k-tektronix-sysv3*): Added the missing *. Use tekxd88, not tekXD88. Tue Aug 10 14:16:57 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * configure.in: Check for -lm. Then can check for frexp and logb. Sun Aug 8 13:42:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.18 released. * make-dist (src): Don't put gnu-hp300 in dist. (src, lisp): Include OChangeLog in dist. Sun Aug 8 01:52:55 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * configure.in: Test for presence of logb and frexp functions. Thu Aug 5 17:10:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (machine): Add i370-ibm-aix*. Tue Aug 3 02:55:17 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * configure.in (function checks): Test for mkdir and rmdir. * configure.in (function checks): Don't test for random and bcopy only when we're building with X; look for them all the time. Fri Jul 30 21:07:00 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * configure.in: Test for availability of bcopy functions, searching the X libraries if we're using X. * configure.in: Test for the presence of/usr/lpp/X11/bin/smt.exp, and #define HAVE_AIX_SMT_EXP if we do. This is present in some versions of AIX, and needs to be passed to the loader. * configure.in: Test for the availablility of the XScreenResourceString function. Fri Jul 30 20:54:58 1993 David J. MacKenzie (djm@frob.eng.umd.edu) * configure.in: If we found X on our own, set C_SWITCH_X_SITE and LD_SWITCH_X_SITE and assume --with-x11. Only look for X11 files if we weren't told about a window system or if we were told to use X11 but not told where. Search the libraries from the s and/or m files when checking for functions. * configure.in: Remove any trailing slashes in prefix and exec_prefix. Tue Jul 27 19:43:41 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * make-dist: Include lisp/dired.todo in the distribution. Fri Jul 23 15:51:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Add code to set HAVE_INET_SOCKETS. Wed Jul 21 18:05:58 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: If we do find x_includes and x_libraries via AC_FIND_X, set C_SWITCH_X_SITE and LD_SWITCH_X_SITE. Mon Jul 19 15:19:23 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-dist: Include src/gnu-hp300 in the dist. * configure.in (canonical): New variable holds the canonicalized configuration. Don't alter `configuration'. Use `configuration' for Makefile.in for file naming. (testing x_includes and x_libraries): Use =, not ==. Sat Jul 17 19:53:06 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * 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) * Version 19.16 released. Wed Jun 23 21:52:34 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * configure.in: Add --verbose flag. Sat Jun 19 17:14:27 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * version 19.15 released. Fri Jun 18 11:59:35 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Makefile.in (top_distclean): Use -f switch when cleaning out lock dir; it might be empty. * configure.in: Only check for -lXbsd once. Thu Jun 17 19:29:56 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.14 released. Thu Jun 17 00:53:41 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-dist: If using gzip, create distribution with '.gz' extension. * make-dist (lisp/term): This doesn't have a ChangeLog anymore. (lisp/forms-mode): This doesn't exist anymore. * configure.in: Look for the closedir function. Wed Jun 16 16:48:35 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * configure.in (CPP): Autoconf sets this to a shell variable reference, which doesn't work when it's edited into a makefile. Expand that variable reference. * Makefile.in (CPP): New variable. (src/Makefile): Edit CPP into src/Makefile. * Makefile.in (src/Makefile): Don't bother exiting single quotes and entering double quotes to get the values of LD_SWITCH_X_SITE and the other make variables; make substitutes them in anyway. * Makefile.in (uninstall): Don't remove the lisp and etc directories if they're in the source tree. Bring mumbleclean targets into conformance with GNU coding standards. * Makefile.in (mostlyclean, clean): Separate these two; just have them pass the request to the subdirectory makefiles. (distclean): Pass the request down, and then get rid of the files configure built, and get rid of the Makefiles. (realclean): Pass the request down, and then do the same things distclean does. (uninstall, info, dvi): New targets. * configure.in: Move clause for PC-compatible i386 box to the end of the case statement, to avoid masking configurations below. * configure.in: Add case for m88k-motorola-sysv4. * configure.in: Add support for HP/UX versions 7, 8, and 9 on the HP 68000 machines. * configure.in: Put the arguments to LD_SWITCH_X_SITE's and C_SWITCH_X_SITE's -L and -I switches in quotes, so the preprocessor won't fiddle with them. Sun Jun 13 04:23:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (TAGS): cd to src to run etags. Sat Jun 12 05:54:23 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * configure.in (version): Check the X libraries for XrmSetDatabase and random, and see if we have -lXbsd. Fri Jun 11 02:35:54 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * configure.in: Pass "-Isrc" to the CPP we run to examine the s/*.h and m/*.h files. Martin Tomes says ISC Unix 3.0.1 needs it. Thu Jun 10 19:03:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Move i386-prime-sysv* and i386-sequent-bsd* above the general i386 alternative. Thu Jun 10 01:45:45 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * configure.in: Recognize configuration name for Data General AViiON machines. * configure.in: Use AC_LONG_FILE_NAMES. Wed Jun 9 00:05:06 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * configure.in: Test for bison. * Makefile.in (YACC): New variable. (lib-src/Makefile.in): Edit YACC into the makefile. Tue Jun 8 02:42:18 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Version 19.13 released. * configure.in (CFLAGS): Don't set this according to the value of the GCC shell variable. Instead, consult the machine and system files for the values of C_OPTIMIZE_SWITCH and C_DEBUG_SWITCH, and test __GNUC__ while we're at it. * configure.in: Remove extra ;; from hpux cases. Mon Jun 7 23:55:41 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * configure.in: Check to see if the system has -ldnet. Tue Jun 8 00:22:46 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-dist: Add clauses to distribute lisp/forms-mode. Mon Jun 7 13:53:54 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in (machine): Fix the versions in hpux version number test. Do not guess based on cpu type. Do check for explicit system version. Thu Jun 3 16:42:57 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Do NOT look for `unknown' as company name. Wed Jun 2 12:10:09 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Fix typo in message. Tue Jun 1 00:08:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.12 released. * Makefile.in (do-install): Correct previous etc-copying change. Partially rewrite using `if'. (src/Makefile): Insert --x-libraries option into LD_SWITCH_X_SITE. * Version 19.11 released. * configure.in: Handle 386bsd. Mon May 31 00:23:47 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-dist: Update getdate.c. * configure.in: Handle bsd386. * Makefile.in (do-install): Use `-' in tar options. * configure.in: Change ! "${...}" to x"${...}" = x. * Makefile.in (do-install): Copy the DOC-* files from the build etc directory, as well as lots of things from ${srcdir}/etc. * make-dist: Copy config.guess. * configure.in: Handle AIX versions 1.2, 1.3. Sun May 30 15:37:57 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * configure.in: Use s/bsd4-3.h for mips-mips-riscos4, and add the configuration name mips-mips-usg* to represent USG systems. * configure.in: Fix logic to detect if srcdir is already configured. * Makefile.in: Pass in LD_SWITCH_X_SITE. * Makefile.in (mkdir, clean, mostlyclean, do-install): Use `(cd foo && pwd)` instead of `(cd foo ; pwd)` to get the canonical name of a directory; cd might fail, and have pwd print out the current directory. Sun May 30 14:55:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: When looking for sources, use '.', not `.`. Also '..'. Sun May 30 14:23:50 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * configure.in: Complain if srcdir points at an already-configured tree. Sun May 30 00:15:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.10 released. Sat May 29 16:52:24 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Makefile.in: Use Makefile comments, not C comments. * configure.in: Add case for the Tektronix XD88. Sat May 29 16:30:13 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Handle sysv4.2 and sysvr4.2. Sat May 29 15:30:00 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * configure.in: Traverse the argument list without destroying it; don't use shift. It turns out that "set - ${saved_arguments}" doesn't work portably. * configure.in: Add missing "fi". * make-dist: Rebuild configure if configure.in is newer. * Makefile.in (src:, lib-src:, FRC:): force the src and lib-src targets to be executed even if make remembers that it has already stisfied FRC. Sat May 29 02:09:15 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (do-install): Delete redundant code to copy etc twice. * configure.in (romp): Handle various version numbers with aos and bsd. Fri May 28 17:02:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Fix message text. Fri May 28 00:31:48 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * make-dist: Make a `site-lisp' directory in the distribution, instead of a `local-lisp' directory, which hasn't been the appropriate name for a long time. * Makefile.in (@rip_paths@locallisppath): Use site-lisp directory from the distribution first, then /usr/local/lib/emacs/site-lisp. * Makefile.in (do-install): Correctly detect if ./etc and ${srcdir}/etc are the same. * configure.in: Extract UNEXEC from the system configuration files, compute the name of the source file corresponding to the object file, and #define it as UNEXEC_SRC in config.h. * configure.in: If srcdir is '.', then try using PWD to make it absolute. * configure.in: Include ${srcdir} in the printed report, to help people notice if it's an automounter path. Thu May 27 23:23:58 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * configure.in (prefix): Don't run pwd on srcdir unnecessarily. Thu May 27 18:01:54 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (do-install): Delete the dest dir, not the source dir, when they are different. Add `shift' command. (COPYDESTS, COPYDIR): Delete external-lisp dir. (externallispdir): Var deleted. * configure.in: Delete spurious paren outputting short_usage. Thu May 27 02:35:32 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.9 released. Wed May 26 14:23:27 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Makefile.in (${SUBDIR}): Pass the value of the make variable to subdirectory makes. * make-dist: Check for .elc files with no corresponding .el file. * Makefile.in (mkdir): Make all the directories in locallisppath. * config.guess: New file. * configure.in: Use it, tentatively. * INSTNALL: Mention its usage. * configure.in (hppa-hp-hpux): Use uname -r instead of uname -m; the former gives you the operating system rev directly. Use s/hpux.h if we don't recognize what we got. * Makefile.in (do-install): Don't remove a destination directory if it's the same as the source. If ${srcdir}/info == ${infodir}, don't try to copy the info files. * Makefile.in (COPYDIR, COPYDESTS): Don't mention etc twice; this doesn't work if you're not using a separate source directory. (do-install): Copy the build tree's etc directory only after making sure it's not also the source tree's etc directory. Wed May 26 13:43:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Handle sunos4.1.3 specially. Tue May 25 12:47:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (INSTALL): Add definition. * configure.in: Fix some messages. Support -with-gnu-cc. At the end, use `set --', not `set -'. Delete spurious `.h' in hpux alternatives. Tue May 25 05:15:14 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.8 released. Tue May 25 00:55:45 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * configure.in: When looking for source in the same directory as the configure script, make the path thus discovered absolute. If the user specifies the `--srcdir' switch, make that directory absolute too. * Makefile.in (srcdir): Remove comment saying this doesn't work. * Makefile.in (src/paths.h): Edit the `infodir' variable into this too, as the value of the PATH_INFO macro. * configure.in: Check to see if the source lives in the same directory as the configure script. Mon May 24 12:14:41 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Makefile.in (install): Split this into `install' and `do-install', to give people more control over exactly what gets done. (do-install): New target, containing the guts of `install'. Don't remove and recreate the directories inside the copying loop - do it all before the copying loop. Pass more flags to the lib-src make. (mkdir): Create ${infodir}, ${mandir}, and ${sitelispdir} here, to avoid errors and warnings. * configure.in: For generic IBM PC boxes, insist on "unknown" for the manufacturer - the more general case was blocking other i386 configuration names below, and that's how the names are written in MACHINES anyway. * make-dist: When breaking links, remove the link before moving the copy onto it, to avoid interactive behavior. * Makefile.in: Doc fix. * configure.in: Doc fix. * INSTALL: Mention --exec-prefix option. * configure.in: Add support for the `--exec-prefix' option. * Makefile.in: Accept that support. * configure.in: Use the AC_PROG_INSTALL macro. * Makefile.in (INSTALL): Variable removed. (INSTALL_PROGRAM, INSTALL_DATA): Accept these values from configure. * configure.in: Distinguish between hp800's and hp700's by calling "uname -m". Mon May 24 00:12:26 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Recognize configuration names for i860 boxes running SYSV. Sun May 23 00:37:44 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * configure.in: Distinguish between hp800's and hp700's by the version of HP/UX they run, since that's something people are more likely to know - hp700's run 8.0. Add HP 700 configuration. * configure.in: Test for the presence of the `rename' function. * Makefile.in (C_SWITCH_X_SITE): New variable - get this from configure.in. (oldXMenu/Makefile): Edit C_SWITCH_X_SITE into this. * make-dist: Break intra-tree links. * configure.in: Explain that this is an autoconf script, and give instructions for rebuilding configure from it. Arrange to put comments in configure explaining this too. * configure.in: Make the first line of the configure script be "#!/bin/sh". Leaving the first line blank didn't work. * configure.in (long_usage): Removed; made short_usage describe the options briefly. * configure.in: Implement the --prefix option. * Makefile.in (prefix): Add support for it here. * INSTALL: Document it here. * Makefile.in (install): Don't assume that the files in the `info' subdirectory match *.info. They don't have that prefix. Sat May 22 22:53:24 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * configure.in: Add case for version 5 of Esix. Sat May 22 17:24:06 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.7 released. * make-dist: There aren't any *.com files in lib-src anymore. * make-dist: Copy texinfo.tex and texindex.c, rather than linking them; they're symlinks to other filesystems on the GNU machines. * make-dist: Check that the manual reflects the same version of Emacs as stated in lisp/version.el. Edit that version number into the README file. Fri May 21 17:32:41 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * configure.in: Remove the hack of AC_DEFINE; use AC_DEFINE_UNQUOTED. Thu May 20 01:24:24 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-dist: Don't distribute precomp.com, compile.com, or link.com from ./src; they're in ./vms now. Some time-handling patches from Paul Eggert: * configure.in: Add AC_TIMEZONE. Wed May 19 20:56:26 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * configure.in: Recognize Linux as a valid operating system for the i386. Tue May 18 16:31:50 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-dist: Distribute some VMS files we got from Richard Levitte. * Makefile.in (oldXMenu/Makefile): Take oldXMenu/Makefile.in as the source for the sed command, not oldXMenu/Makefile. Mon May 17 19:33:55 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * INSTALL: Don't claim the srcdir option doesn't work. Sun May 16 18:41:27 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * configure.in: Include remarks saying what order the autoconf tests should go in, and remind people to change config.h.in whenever they add autoconf tests which make #definitions. * make-dist: Distribute oldXMenu/Makefile.in, not oldXMenu/Makefile. Sat May 15 16:47:50 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Makefile.in (oldXMenu/Makefile): Make this depend on ${srcdir}/oldXMenu/Makefile.in, not itself. * PROBLEMS: Some updates from David J. Mackenzie. More changes from David J. Mackenzie. * Makefile.in (install.sysv, install.xenix, install.aix): Targets removed; autoconf and config.h should specify all these differences. (buildlisppath): Make this path depend on ${srcdir}. (INSTALLFLAGS): Removed. (INSTALL): Include the -c flag. (install): Change the way we invoke install accordingly. Install ${srcdir} changes from DJM. * Makefile.in (SUBDIR_MAKEFILES): Add oldXMenu/Makefile to this list. (COPYDIR, COPYDESTS): Install files from both the etc directory in the source tree and the etc directory in the object tree. (${SUBDIR}): Pass the prefix variable down to submakes. (everywhere): Use `sed', not `/bin/sed'. Not all systems have sed in /bin. (lib-src/Makefile, src/Makefile, oldXMenu/Makefile): Edit in values for srcdir and VPATH. (install): Add `v' flag to tar command. Make sure that `dir' exists in ${srcdir}/info before copying it. Remember that the man pages come from the source tree, not the object tree. * configure.in: Remove remarks saying that the --srcdir option doesn't work. Create the etc directory in the object tree. Recognize configuration names of the form *-sun-solaris*. Recognize sunos5 and solaris as operating system names. * configure.in: Use the AC_TIME_WITH_SYS_TIME macro, for lib-src/getdate.y and src/systime.h. Sat May 15 00:12:26 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-dist: Make links in info subdir. Thu May 13 15:28:19 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * configure.in: Call AC_STDC_HEADERS. Mon May 10 15:19:03 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * configure.in: Sidestep autoconf's quoting of the second argument of AC_DEFINE, so we can specify the value to put there. It would be nice if autoconf provided some way to specify computed values for macros. Sun May 9 17:30:48 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in (DEFS): Deleted; since we're using AC_CONFIG_HEADER, this is always just -DHAVE_CONFIG_H. The GNU coding standards specify that CFLAGS should be left for users to set. * Makefile.in (CFLAGS): Let configure determine the default value for this. Don't have it default to DEFS. (${SUBDIR}): Pass CFLAGS down to submakes, not DEFS. (lib-src/Makefile, src/Makefile): Edit the default value for CFLAGS into these files, not DEFS. * configure.in (CFLAGS): Choose a default value for this - "-g" normally, or "-g -O" if we're using GCC. Edit it into the top-level Makefile. * configure.in: When scanning the machine and system description #include files, write their names to conftest.c properly. Fri May 7 00:57:13 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * configure.in: In configuration name case for Apallos running Domainios, set opsys, not opsysfile. * configure.in: Use the autoconf AC_CONFIG_HEADER macro to produce src/config.h, instead of AC_OUTPUT; the latter overwrites src/config.h even when it hasn't changed, puts a makefile-style comment at the top even though it's C code, and produces a config.status script which doesn't do the job right. * configure.in: Add AC_LN_S test, so we can tell whether or not we can use a symbolic link to get the X Menu library into src. * Makefile.in (LN_S): New variable. (src/Makefile): Edit the value of LN_S into this makefile. Thu May 6 14:03:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure.in: Support *-sco3.2v4* as opsystem. * make-dist: Don't include calc directory. Exclude many files in the man directory; copy a few. Tue May 4 10:15:32 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * configure.in: Use AC_HAVE_HEADERS to test for sys/time.h, and call AC_STRUCT_TM to see what's in time.h. * configure.in: Employ quoting stupidity to get the value of CPP to expand properly. Tue Apr 27 13:00:28 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * configure.in: Use the AC_PROG_CPP macro, and then use the CPP variable to scan the machine and system description files. * configure.in: Use the AC_HAVE_HEADERS to check for sys/timeb.h, so that getdate.y builds correctly. Mon Apr 26 19:11:45 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * configure.in (tempcname): Change this to "conftest.c", so it will work properly on systems with short filenames; this is the name autoconf uses. * configure.in: Also detect the availability of dup2 and gethostname. * configure.in: Use the AC_ALLOCA test. * Makefile.in (ALLOCA): New variable, to be set by ./configure. (lib-src/Makefile): Edit the value of ALLOCA into lib-src/Makefile. Sat Apr 24 23:41:48 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * make-dist: Distribute configure, as well as configure.in. Oversight. Fri Apr 23 17:32:12 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in (install): Print out the name of the directory we're copying, so people can have some idea of whether we're making progress. * Makefile.in (install.aix, install.xenix, install.sysv, install): Don't forget to re-create the COPYDESTS directories after we clear them out. Tue Apr 13 00:58:01 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in: Add autoconf cookies so that the configure script can comment out sections of path variable definitions to choose between the installable configuration and the run-in-place configuration. * configure.in: Add new option `--run-in-place', to select the run-in-place path definitions. * configure.in: Add a clause to the big configuration name case for the NeXT machine. Mon Apr 12 22:20:30 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in (install, install.sysv, install.xenix, install.aix): Make sure that each source directory exists, and is different from the destination directory; then, delete the destination before copying over the source. * make-dist: Distribute configure.in, instead of configure. Sat Apr 10 04:29:06 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * configure.in: Don't set CC to "gcc -O" if the user specifies `--with-gcc'. Add -O to DEFS if GCC is set. Fri Apr 9 07:20:40 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in (clean mostlyclean): Missing right paren. * configure.in: When checking for X windows, search for an X11 subdirectory of ${x_includes}. * configure.in: Check for gettimeofday function, for getdate.y. Change `configure' to a mixture of custom code and autoconf stuff. autoconf can't derive all the information we need, but we'd really like to be able to take advantage of some of its tests, and its file-editing facilities. * configure.in: Renamed from configure. Quote the sections of shell script we want copied literally to the configure script. (compile): Initialize this to make the autoconf macros' code happy. Use AC_PROG_CC, AC_CONST, and AC_RETSIGTYPE instead of writing out code to do their jobs. Use autoconf to produce Makefile and src/config.h. Remove the Makefile-style comment that autoconf places at the top of src/config.h. (config_h_opts): Removed - no longer necessary. * Makefile.in (configname): Renamed to configuration. (CONFIG_CFLAGS): Renamed to DEFS. (CC, DEFS, C_SWITCH_SYSTEM, version, configuration): Adjusted to get values via autoload @cookies@. (libsrc_libs): Get this from autoconf. We used to do nothing about this. (${SUBDIR}): Pass DEFS to submakes instead of CONFIG_CFLAGS. * Makefile.in (src/paths.h, lib-src/Makefile, src/Makefile): Don't echo the move-if-change command. Thu Apr 8 05:29:14 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * make-dist: Distribute lib-src/rcs-checkin. * make-dist: It's oldXMenu/compile.com, not oldXMenu/compile.mms. Don't try to make links to the RCS or Old subdirectories. Use the appropriate extension for the compression type in use. Create the tar file in the shell's initial default directory, not in ${tempparent}. Erase the whole ${tempparent} tree, not just ${tempdir}. Tue Mar 30 15:32:59 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Makefile.in (src/paths.h): Don't echo the huge sed command we use to build paths.h. (lib-src/Makefile, src/Makefile): Similarly. * configure: Extend test for working `const' keyword to handle AIX 3.2 cc. Wed Mar 24 20:12:05 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * make-dist: Distribute lisp/term/ChangeLog. Arrange for C compilation throughout the tree to get C_SWITCH_SYSTEM from the configuration files. * configure: Extract C_SWITCH_SYSTEM from the machine and system-dependent files, and save it in the top-level Makefile. * Makefile.in (C_SWITCH_SYSTEM): New flag for configure to edit. (lib-src/Makefile): Edit C_SWITCH_SYSTEM into lib-src/Makefile. * make-dist: Include the VMS support files in oldXMenu in the distribution. * configure: Doc fix. * configure: Fix corrupted config_h_opts. * configure: Properly report option names in error messages. * configure: Properly recognize --x-includes and --x-libraries options. * configure: Fix syntax errors in code handling XFree386. Tue Mar 23 00:29:52 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * configure: Add special code to detect XFree386, and tell config.h about it. * configure: Properly handle extracting values of LIBS_MACHINE and LIBS_SYSTEM that contain spaces. * configure: Add `--x-includes' and `--x-libraries' options. I think these are dopey, but no less than three alpha testers, at large sites, have said they have their X files installed in odd places. Implement them by setting C_SWITCH_X_SITE and LD_SWITCH_X_SITE in src/config.h. Mon Mar 22 14:57:04 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * make-dist: Don't distribute etc/Old files. * GETTING.GNU.SOFTWARE, PROBLEMS: Registered into RCS with their backups. Sat Mar 20 13:11:55 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * make-dist: Fix typo. Fri Mar 19 08:08:04 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * make-dist: Corrected typo, fixed it to discard = and TAGS files in some cases where it should but didn't seen to. * Makefile.in: Added unlock and relock productions. Thu Mar 18 23:12:47 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * make-dist: Add a --compress option to force make-dist to use compress. * make-dist: Use gzip, if we can find it. * configure: Recognize rs6000-ibm-aix32 and rs6000-ibm-aix, and make rs6000-ibm-aix default to -aix32. Wed Mar 17 13:23:14 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * Makefile.in: Added `Developer's configuration' section. Wed Mar 17 08:30:52 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * Makefile.in: Add commented-out variable settings for developer's configuration. Sun Mar 14 20:16:21 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-dist: Distribute `src/bitmaps' too. Sun Mar 14 17:16:53 1993 Charles Hannum (mycroft@hal.gnu.ai.mit.edu) * configure: Recognize rs6000-ibm-aix32 and rs6000-ibm-aix, and make rs6000-ibm-aix default to -aix32. Tue Mar 9 11:05:00 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * configure: Recognize strings like "sysvr0" or "sysvr1" as System V. * Makefile.in (install.sysv): Add a second `$' in front of `${dest}', so that the shell will expand it, instead of Make. * configure: When processing the name of the configure script, collapse `././' to `./', but leave a single `./' prefix alone. * configure: Doc fix. Thu Mar 4 09:42:29 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * configure: Handle isc3.0 correctly. Thu Feb 25 00:31:33 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * make-dist: Don't try to copy the COPYING notice into external-lisp; we're not distributing that directory any more. Wed Feb 24 17:25:27 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in (install, install.aix, install.xenix, install.sysv): Remove CVS subdirectories from the installed directory trees, as well as RCS directories. Tue Feb 23 06:54:11 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-dist: Only copy gmalloc.c if we couldn't link it. Don't try to copy man/{README,Makefile} unless they actually exist. * Makefile.in (lisppath): Don't include externallispdir in this. We're not sure whether we're even going to distribute the directory yet. Wed Feb 17 20:19:06 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * make-dist: Don't distribute the external-lisp directory anymore. * INSTALL: Remove all references to external-lisp. * configure: Detect whether the compiler supports `const' properly, and edit src/config.h accordingly. * configure: Tweak layout of final report. * Makefile.in (${SUBDIR}): Pass CONFIG_CFLAGS to the submakes, not CFLAGS. * Makefile.in (locallisppath): Make this default to ${datadir}/emacs/site-lisp, instead of ${datadir}/emacs/local-lisp. ${datadir} and ${statedir} are often the same thing, and local-lisp causes completion conflicts with lock. (lisppath): Add ${externallispdir} to this. * INSTALL: Adjust installation directions. * Makefile.in (externallispdir): New variable, to say where to install the externally-maintained lisp files. (COPYDIR, COPYDESTS): Copy the external lisp directory just like the others. * INSTALL: Describe external-lisp and the new externallispdir variable. Sun Feb 14 08:47:04 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * configure (progname): New option `--with-gcc'. Make it clearer how we are trying to guess whether or not we have GCC. * INSTALL: Document the `--with-gcc' option, and improve description of `--with-x' options. Sat Feb 6 19:55:48 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in (COPYDIR, COPYDESTS): Remove ${srcdir}/info and ${infodir} from these variables; we have written out explicit code to install the info files. Mon Jan 25 23:27:53 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * make-dist: Don't distributed the RCS files in the etc directory. Sun Jan 24 20:48:02 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in: Some makes can't handle comments in the middle of commands; move them to before the whole rule. Sat Jan 16 00:37:46 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * README: Mention what Emacs is. Thu Jan 14 12:27:38 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-dist: Include `./lisp/calc-2.02' in the distribution. Add `./cpp' and `./man' back into the distribution. Wed Jan 13 17:20:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in: Define MAKE, and use where appropriate. Thu Jan 7 04:37:46 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * make-dist: Remember that the authoritative COPYING notice is `etc/COPYING', not `../etc/COPYING'. Sun Dec 20 23:59:43 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * make-dist: Make sure that the COPYING notices in each directory are copies, not symlinks. Sat Dec 19 06:46:05 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * INSTALL: The build process produces an executable called `emacs' now. Change references. * Makefile.in: Adjust `install.mumble' targets to install `src/emacs', not `src/xemacs'. * configure: Start with a blank line; this keeps some old CSH's from thinking it's a CSH script. Most systems will just use /bin/sh to run it, which is what we're expecting; the only other shells which might try to interpret it themselves are probably Bourne-compatible. Mon Dec 14 07:09:36 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * INSTALL: Improvements suggested by David Mackenzie. Sat Dec 12 00:31:46 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in (install, install.sysv, install.xenix, install.aix): Don't try to copy the info files if there aren't any; the unexpanded globbing pattern disappoints `install'. Ignore the return status of that command. * INSTALL: Updated for new configuration arrangement. * configure: Don't make the top-level Makefile read-only - people may want to edit the values of the path variables. * Makefile.in (install, install.sysv, install.xenix, install.aix): Install the info files in ${infodir}. Install the executable under both `emacs' and `emacs-VERSION'. * Makefile.in: Doc fix. * Makefile.in (exec_prefix): New variable, as per latest version of coding standards. (bindir, libdir): Use it, instead of `prefix'. (lib-src/Makefile): Edit value of exec_prefix into lib-src/Makefile. * Makefile.in (mandir): Make the default value for this depend on $(prefix). * Makefile.in (datadir, statedir, libdir): Make these all default to ${prefix}/lib. (lispdir, locallisppath, etcdir, lockdir, archlibdir): Adjusted to compensate. * Makefile.in (install, install.sysv, install.xenix, install.aix): Install the etags and ctags man pages too. * Makefile.in (distclean): Don't delete backup files; that's the job of extraclean. (extraclean): Like distclean, but deletes backup and autosave files. Thu Dec 10 21:10:40 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) Make path specification conform to GNU coding standards. * configure (long_usage): Remove all traces of old arguments from usage messages, and document the options we do accept in more detail: -with-x... and --srcdir. (options, boolean_opts): Deleted; we don't have enough options to make this worthwhile. (prefix, bindir, lisppath, datadir, libdir, lockdir): Deleted, along with the code which supported them; these should be set as arguments to the top-level make. (config_h_opts): Since this no longer doubles as a list of option names, make them upper case; this simplifies the code which uses them to build the sed command to edit src/config.h. Change the code which sets them. (cc, g, O): Don't allow the user to set these using options; they should be specified using `CC=' and `CFLAGS=' arguments to the top-level make. Just choose reasonable default values for them, and edit them into Makefile.in's default CC and CONFIG_CFLAGS values. (gnu_malloc, rel_alloc): Don't allow the user to set these using options; use them whenever the configuration files say they're possible. Simplify the argument processing loop. Don't accept abbreviations for option names; these might conflict with other configuration options in the future. Add some support for the `--srcdir' option. Check for the sources in . and .. if `--srcdir' is omitted. If the directories we will compile in don't exist yet, create them under the current directory. Note that the rest of the build process doesn't really support this. Edit only the top Makefile. That should edit the others. Edit into the makefile: `version', from lisp/version.el, `configname' and `srcdir' from the configuration arguments, `CC' and `CONFIG_CFLAGS' as guessed from the presence or absence of GCC in the user's path, and LOADLIBES as gleaned from the system description files. Simplify the report generated; it doesn't need to include any description of paths now. Make `config.status' exec configure instead of just calling it, so there's no harm in overwriting `config.status'. * Makefile.in (version, configname): New variables, used to choose the default values for datadir and libdir. Path variables rearranged into two clearer groups: - In the first group are the variables specified by the GNU coding standards (prefix, bindir, datadir, statedir, libdir, mandir, manext, infodir, and srcdir). - In the second are the variables actually used for Emacs's paths (lispdir, locallisppath, lisppath, buildlisppath, etcdir, lockdir, archlibdir), which depend on the first category. datadir and libdir default to directories under ${prefix}/lib/emacs instead of ${prefix}/emacs, by popular demand. etcdir and lispdir default to subdirectories of datadir. archlibdir defaults to libdir. The new installation tree is a bit deeper than it used to be, so use the new make-path program in lib-src to build them all. Always build a new src/paths.h.tmp and then move-if-change it to src/paths.h, to avoid unnecessary rebuilds while responding to the right changes. Remove all mention of arch-lib. Run utility commands from lib-src, and let the executables be copied into archlibdir when Emacs is installed. Add targets for src/Makefile, lib-src/Makefile, and oldXMenu/Makefile, editing the values of the path variables into them. Let lib-src do its own installation. (datadir): Default to putting data files under ${prefix}/lib/emacs/${version}, not /usr/local/emacs. (emacsdir): Variable deleted; it would only be confusing to use. (lispdir, etcdir): Default to ${datadir}/lisp. (mkdir): Use make-path for this. (lockdir): Do this in mkdir. (Makefile): New target. * configure (usage_message): Rename to long_usage. * make-dist: Don't bother creating an arch-lib directory; that's only for installation now. Fri Nov 20 06:15:14 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * configure: Use GCC-style configuration names, using config.sub. Change the usage and help messages. * configure: Initialize window_system, not indow_system. * configure: Report which window system, compiler, and signal handler return type we decide to use. * make-dist: Explain what's going on if config.sub and gmalloc.c can't be linked. Place the code which copies them near the code which links the rest of the files around them. Sun Nov 15 20:59:55 1992 Jim Blandy (jimb@apple-gunkies.gnu.ai.mit.edu) * make-dist: Don't bother to distribute src/*.com, or src/vmsbuild; those have all been moved to `../vms'. Sat Nov 7 15:11:39 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-dist: Don't forget that the way to avoid filenames starting with `=' is to use the pattern `[a-zA-Z0-9]*.h', not `[a-zA-Z0-9].h'. Add a new section for dealing with files that we couldn't make hard links to, since we have two already, and perhaps more to come. Wed Nov 4 15:09:07 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * configure: When editing parameters into lib-src/Makefile, change the definition of CONFIG_CFLAGS instead of CFLAGS itself; CFLAGS needs some other flags too. Tue Nov 3 05:42:55 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * configure: Remove spurious echo of the configuration name. * make-dist: Don't distribute files in src/m and src/s whose names begin with `='. Tue Oct 27 04:06:30 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure: Update GNU_MALLOC and REL_ALLOC in config.h. Also LISP_FLOAT_TYPE. Mon Oct 26 19:55:01 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-dist: Copy config.sub, since it's a symbolic link to a file on another file system. Sat Oct 17 17:04:24 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * make-dist: Include lib-src/makedoc.com and emacs.csh in the distribution. * config.sub: New file, to help us recognize configuration names. * make-dist: Include it in the distribution. Mon Sep 14 17:43:50 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * configure: Convert `-' to `_' in specified option names. Accept options with --. Delete --highpri and --have-x-menu options. New options --with-x and --with-x10 replace -window-system. Don't mention options --gnu-malloc, --rel-alloc or --lisp-float-type in help message. Sun Sep 13 06:30:52 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * make-dist: Include the `vms' subdirectory in the distribution. Thu Sep 10 16:14:21 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * configure: Remove lines starting with "# DIST: " when building lib-src/Makefile and src/Makefile. This allows us to mark the "Makefile.in" files with explanatory comments which won't also get stuck in the Makefiles. Sat Sep 5 07:10:43 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * make-dist: Don't use the '+' operator in the sed regular expression that extracts the version number from lisp/version.el; Ultrix sed doesn't seem support the operator. Just double the operand and use *. Tue Sep 1 15:56:14 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Makefile.in: Doc fix. Mon Aug 31 00:25:44 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * configure: Rewrite sed command to remove at most one ./ prefix; Ultrix's sed doesn't allow us to apply the * operator to a \( \) group. Tue Aug 25 18:57:41 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (src/paths.h): Use sed, not /bin/sed. Tue Aug 18 16:02:22 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * make-dist: Go ahead and build a new TAGS file, unless the --newer option was specified. Don't try to delete a TAGS file from etc; it's not kept there, and shouldn't be deleted anyway. Fri Aug 14 12:54:25 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * make-dist: If the lisp directory contains a default.el, don't distribute it. * configure: When searching signal.h for the type of a signal return handler, make a copy of it, not a symbolic link to it; that way, it will work on systems that don't have symbolic links. Fri Aug 14 12:31:45 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * make-dist: taught it about vcdiff and rcs2log, added --newer option for generating incremental distributions. Stopped it from generating a TAGS file into the distribution; that sucker is *big*, and easily enough generated with the toplevel makefile. Thu Aug 13 13:02:31 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * configure: When writing config.status, don't prefix progname with a '.'; it might be absolute. Wed Aug 5 13:54:39 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * configure: Choose to use X11 if either /usr/lib/libX11.a or /usr/include/X11 exist, not only if both exist. Mon Jul 27 17:41:50 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-dist: Make the new external-lisp directory a duplicate of the external-lisp directory, not the lisp directory. Tue Jul 7 14:47:31 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Makefile.in (clean, mostlyclean): Don't bother trying to `make clean' in arch-lib; it doesn't even have a Makefile. * Makefile.in (clean, mostlyclean): In the test which tries to distinguish between the build directory, which should be cleaned, and the installed directory, which shouldn't, cd to `${emacsdir}', not `${DESTDIR}${LIBDIR}'. Tue Jun 30 05:05:29 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * make-dist: Be sure to delete the .c and .h files that YACC and BISON create from getdate.y. * external-lisp: New directory; see `external-lisp/README'. * make-dist: Added support for the external-lisp subdirectory. * make-dist: Changed message which complains that make-dist wasn't invoked in the right directory to indicate which files it was looking for. Mon Jun 29 16:24:41 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * configure: Add comments explaining why we can't translate character ranges or control characters in `tr'. Wed Jun 24 00:18:54 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * configure: When generating the configuration message, we used to build the message from the start so that each line began with "# " so that it would be a comment in `config.status'. However, this causes trouble if any of the variables we use in the message expand to more than one line of text - as gnu_malloc_reason sometimes does. So instead, we build the message as it should be printed to the user (i.e. without the "# " prefixes), and stick on the "# "s when we write it to `config.status'. * Makefile.in (clean, mostlyclean): Don't neglect to clean out `lib-src' and `arch-lib'. * configure: When generating report and `config.status' file, note that bindir only determines where `make install' and `build-install' will place the executables; this should make it clear that the ordinary build process will not try to install things. Wed Jun 10 19:20:27 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-dist: Change messages to say that we are 'making links to X', rather than 'copying X'. And put `' quotes around file names. * make-dist: Include '.tmp' in the name of the staging directory. * make-dist: Pass the `-f' option to rm when you're not sure that the files you're removing actually exist. * make-dist: When setting up etc/COPYING, always nuke whatever is there, and then copy it in, to make sure we get a real file. * make-dist: Don't try to distribute *.defns files any more. The only such file was for simula.el, which has been superceded by a version which doesn't have a separate .defns file. Thu May 28 09:51:46 1992 Ken Raeburn (Raeburn@Cygnus.COM) * make-dist: Don't distribute configured versions of config.h.in, paths.h.in, Makefile.in in src. * configure: Delete .tmp files before creating them; don't bother trying to make final targets writeable first, since it won't matter to move-if-change. Tue May 19 18:33:04 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Makefile.in (mkdir, lockdir): Don't put dashes in front of the mkdir and chmod in the center of all the conditionals. GNU Make will strip these out, but other makes won't. Mon May 18 03:14:40 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * make-dist: Include move-if-change in list of files to distribute. Mon May 4 20:46:16 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * configure: Remove any "." elements from the program name. * configure: Don't record the values of all the possible arguments in config.status; only record the options that the user specified. * configure: Use move-if-change to move in the new src/config.h. Wed Apr 29 23:13:25 1992 Ken Raeburn (Raeburn@Cygnus.COM) * move-if-change: New file, copied from gcc release. * Makefile.in (src/paths.h): Use it, and put the "sed" output into a temp file, so we don't update paths.h if an error occurs or if it doesn't need changing. Tue Apr 28 17:00:07 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Makefile.in (src/paths.h): Do not install a value for the PATH_SUPERLOCK value; that macro doesn't exist anymore. * build-install.in: Same thing. Fri Apr 24 02:10:56 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * make-dist: Check the flag called "make_tar", not "make_dir"; the latter, being a typo, is always false, resulting in a program whose default behaviour is to painstakingly build a copy of the source tree, and then delete it. Rah. * Makefile.in: Add dist target, and comment for it. * configure: When scanning for a declaration for signal, create a symbolic link with a name ending in .c, so the compiler won't complain that it's only been given .h files. * configure: Check whether there are any arguments available before shifting to get the value of a non-boolean parameter. * make-dist: Doc fix. Mon Apr 20 09:54:48 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * configure: Instead of grepping /usr/include/signal.h for a signal declaration, run /usr/include/signal.h or /usr/include/sys/signal.h through cpp and grep for the declaration. * configure: Redirect the output of grep to /dev/null instead of using grep -s - that flag means different things on other systems. * Makefile.in: Use 'buildlisppath' instead of 'dumplisppath', since the former is recognizable even if you don't know what 'dumping' is. * configure: Accomodate that change. * configure: Accept options for all of the directories you can change in the Makefile. * configure: Accept "-OPTION VALUE" as well as "-OPTION=VALUE". * INSTALL: Mention that you have to copy all the 'FOO.in' files to FOO before you can use them. * build-install.in: Made the "Where To Install Things" section conform with the similar section from Makefile.in. Copied section which builds src/paths.h from src/paths.h.in from the Makefile. Sun Apr 19 05:29:03 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * configure: Write config.status to pass its command-line arguments on to configure, so that people can use it to recreate an old configuration, with minor changes. Thu Apr 16 22:49:13 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * configure: Don't rely on option variables being unset if their values are the empty string. In particular, when producing the English report, don't assume that highpri will be unset when no increased priority has been requested; -highpri='' should be the same as omitting -highpri altogether. * configure: Fix dumb bug: when running the system and machine description files through cpp, mark those lines that we want to evaluate with the string '@configure@', and then only evaluate them. This way if the files include anything that actually generates text (type definitions or external declarations, say), we won't try to eval it. Sat Apr 11 16:00:52 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * make-dist: New shell script. * configure: When creating foo from foo.in, make foo read-only to remind people to edit the .in file instead. * INSTALL: Changed references to config.h-dist to config.h.in. The "BUILDING GNU EMACS BY HAND" section neglected to mention how to build src/paths.h from src/paths.h.in; added a paragraph to do this. * configure, Makefile, build-install: Changed filenames like FOO-dist to FOO.in. Wed Apr 8 00:58:46 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Makefile, build-install: Renamed to Makefile.in and build-install.in; the configure script will edit these to produce the usable Makefile and build-install. * configure: Changed to produce ./Makefile, ./build-install, lib-src/Makefile, and src/Makefile from their *.in counterparts, instead of editing them in place. Tue Apr 7 16:44:54 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Makefile: Re-arranged so that the undumped Emacs will search ../lisp *after* the site's local elisp files. (locallisppath, dumplisppath): New variables. (lisppath): This variable's default value is now chosen based on $(locallisppath) and $(lispdir); while it used to be the customization point for adding site-local elisp directories to load-path, that job is now handled mostly by locallisppath. (src/paths.h): Edit the value of a new macro, PATH_DUMPLOADSEARCH. Check the values being assigned to the *LOADSEARCH macros for null path elements (like '::' in 'foo::bar'). * configure: When checking if the machine- and system-dependent files define a particular macro or not, actually run them through CPP and test the macros with #ifs, instead of just grepping for the macros' names. In particular, check for SYSTEM_MALLOC in this way. Fri Apr 3 22:25:50 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile (install): Don't use -s in install. (Keep the symbols.) Thu Apr 2 01:54:22 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * configure: Make the config.status file an executable shell script which will recreate the same configuration. Include the verbal description of the current configuration as a comment in the script. * INSTALL: Doc fix. * Makefile: brought the Makefile up to the GNU coding standards, as described in standards.text: (TAGS): New name for the target which rebuilds the tags table. (check): New target; doesn't do anything yet. (mostlyclean): New target, synonymous with clean. (realclean): New target. Currently, this just calls the subdirectories's makefiles and then deletes config.status. (INSTALL, INSTALLFLAGS, INSTALL_PROGRAM, INSTALL_DATA): New variables. Installation directory variables changed to conform. (install, install.sysv, install.xenix, install.aix): Changed the code which copies the directories into their installed location to allow the installed locations to be in several different directories; the old version assumed that they would all be in $(emacsdir). (mkdir, lockdir): Allow the installed locations to be in several different directories. * INSTALL: Doc fix. * build-install: Use the same variable names as the Makefile. Allow the installed locations to be in several different directories. Tue Mar 31 10:25:57 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Makefile (src/paths.h): Instead of using a single sed command to edit both the PATH_LOCK and PATH_SUPERLOCK macros, edit the two separately, and don't forget to append "/!!!SuperLock!!!" to the value of the PATH_SUPERLOCK macro. * config.emacs: Renamed to configure, for consistency with other GNU products. Internal references changed. INSTALL, Makefile: References changed. * lock: New directory, which should always be empty. If this directory doesn't exist, Emacs won't complain; it just won't lock. Having this here means that people can just unpack Emacs, build it, and have locking work. * share-lib: Re-renamed to etc, for the sake of tradition. * config.emacs: Changed default value for datadir to ../etc. * INSTALL, README: Adjusted. Wed Mar 18 15:54:58 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * config.emacs: Guess the value for LOADLIBES in lib-src/Makefile by running CPP on the appropriate s/*.h and m/*.h files. Mon Mar 16 17:38:50 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * config.emacs: Make sure to set the "exit on error" flag once we've removed config.status; errors should abort the configuration. Sat Feb 15 17:23:07 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * config.emacs: Added -distribute option, so that the Makefile paths are in their proper form. I don't know why this matters. Fri Feb 14 13:58:57 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * local-lisp: New directory, empty in the distribution, for people to put local elisp code in. * config.emacs: Include it in the default load path. * README: Document it. Thu Jan 30 10:26:45 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * config.emacs: Guess the type of signal handling functions based on the contents of /usr/include/signal.h. * config.emacs: Print out progress report messages. * Makefile (src/paths.h): Don't generically replace /usr/local/lib/emacs with LIBROOT. This can hide bugs in the editing of the other entries, and each entry should be dealt with explicitly anyway. * build-install: Converted from C-shell to Bourne shell. * config.emacs: Edit build-install properly. * config.emacs: Doc fix. Mon Jan 27 16:29:53 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile (install): Remove `B' from tar xf command. Mon Jan 13 12:00:14 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * config.emacs: Removed support for the `maintain-environment' option; the only important difference between this and its absence has been removed. * INSTALL: Removed mention of `maintain-environment'. * config.emacs: Fix arguments to sed when processing boolean arguments. Thu Dec 5 14:39:44 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * config.emacs: New file, to help automate the installation process. * Makefile: Lots of changes to support the separation of etc into architecture-dependent and -independent files: (EMACSROOT): New variable, giving the directory under which all of Emacs's libraries should be installed. Changed rest of file to use it. (LIBDIR): Now denotes only architecture-dependent dir - relevant cha (DATADIR): New variable, denoting architecture-independent dir. (LOCKDIR): New variable, for completeness. (SUBDIR): No more etc, new lib-src. (COPYDIR): No more etc, new arch-lib and share-lib. (src/paths.h): Set PATH_DATA and the LOCK macros too. (src): Now depends on lib-src, not etc. * build-install: Changes parallel to the above. * README: Describe the new arrangement. * vms: New subdirectory for all the VMS stuff. Tue Dec 3 22:06:59 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * Makefile (LISPPATH): New variable. (src/paths.h): Define PATH_LOADSEARCH according to LISPPATH. Fri Sep 28 22:36:32 1990 Richard Stallman (rms at mole.ai.mit.edu) * Makefile (install, install.sysv, install.xenix): Install wakeup instead of loadst. No need for setuid or setgid. Tue Aug 7 13:19:35 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * Makefile (clean): Clean etc if that's not the installation dir. Thu Apr 26 13:36:18 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * Makefile (paths.h): Make sed alter each name in the path. Tue Aug 30 13:43:43 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * Makefile (install.sysv): Use cpio, not tar. Wed Aug 3 19:20:13 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * Makefile (lockdir): Rename `lock' target. Depend on it from install*, not from `all'. Mon May 16 02:08:08 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * Makefile: Changed LIBDIR and BINDIR back to /usr/local/{emacs,bin} to match build-install and paths.h. emacs-19.30/Makefile.in100444 12120 1 47651 6052671611 13206 0ustar rmsdaemon# DIST: This is the distribution Makefile for Emacs. configure can # DIST: make most of the changes to this file you might want, so try # DIST: that first. # make all to compile and build Emacs. # make install to install it. # make TAGS to update tags tables. # # make clean or make mostlyclean # Delete all files from the current directory that are normally # created by building the program. Don't delete the files that # record the configuration. Also preserve files that could be made # by building, but normally aren't because the distribution comes # with them. # # Delete `.dvi' files here if they are not part of the distribution. # # make distclean # Delete all files from the current directory that are created by # configuring or building the program. If you have unpacked the # source and built the program without creating any other files, # `make distclean' should leave only the files that were in the # distribution. # # make maintainer-clean # Delete everything from the current directory that can be # reconstructed with this Makefile. This typically includes # everything deleted by distclean, plus more: C source files # produced by Bison, tags tables, info files, and so on. # # make extraclean # Still more severe - delete backup and autosave files, too. SHELL = /bin/sh # If Make doesn't predefine MAKE, set it here. @SET_MAKE@ # ==================== Things `configure' Might Edit ==================== CC=@CC@ CPP=@CPP@ C_SWITCH_SYSTEM=@c_switch_system@ ALLOCA=@ALLOCA@ LN_S=@LN_S@ CFLAGS=@CFLAGS@ C_SWITCH_X_SITE=@C_SWITCH_X_SITE@ LD_SWITCH_X_SITE=@LD_SWITCH_X_SITE@ YACC=@YACC@ ### These help us choose version- and architecture-specific directories ### to install files in. ### This should be the number of the Emacs version we're building, ### like `18.59' or `19.0'. version=@version@ ### This should be the name of the configuration we're building Emacs ### for, like `mips-dec-ultrix' or `sparc-sun-sunos'. configuration=@configuration@ # ==================== Where To Install Things ==================== # The default location for installation. Everything is placed in # subdirectories of this directory. The default values for many of # the variables below are expressed in terms of this one, so you may # not need to change them. This defaults to /usr/local. prefix=@prefix@ # Like `prefix', but used for architecture-specific files. exec_prefix=@exec_prefix@ # Where to install Emacs and other binaries that people will want to # run directly (like etags). bindir=@bindir@ # Where to install architecture-independent data files. ${lispdir} # and ${etcdir} are subdirectories of this. datadir=@datadir@ # Where to install and expect the files that Emacs modifies as it # runs. These files are all architecture-independent. Right now, the # only such data is the locking directory; ${lockdir} is a # subdirectory of this. sharedstatedir=@sharedstatedir@ # Where to install and expect executable files to be run by Emacs # rather than directly by users, and other architecture-dependent # data. ${archlibdir} is a subdirectory of this. libexecdir=@libexecdir@ # Where to install Emacs's man pages, and what extension they should have. mandir=@mandir@ manext=.1 man1dir=$(mandir)/man1 # Where to install and expect the info files describing Emacs. In the # past, this defaulted to a subdirectory of ${prefix}/lib/emacs, but # since there are now many packages documented with the texinfo # system, it is inappropriate to imply that it is part of Emacs. infodir=@infodir@ # Where to look for bitmap files. bitmapdir=@bitmapdir@ # Where to find the source code. The source code for Emacs's C kernel is # expected to be in ${srcdir}/src, and the source code for Emacs's # utility programs is expected to be in ${srcdir}/lib-src. This is # set by the configure script's `--srcdir' option. srcdir=@srcdir@ # Tell make where to find source files; this is needed for the makefiles. VPATH=@srcdir@ # ==================== Emacs-specific directories ==================== # These variables hold the values Emacs will actually use. They are # based on the values of the standard Make variables above. # Where to install the lisp files distributed with # Emacs. This includes the Emacs version, so that the # lisp files for different versions of Emacs will install # themselves in separate directories. lispdir=@lispdir@ # Directories Emacs should search for lisp files specific # to this site (i.e. customizations), before consulting # ${lispdir}. This should be a colon-separated list of # directories. locallisppath=@locallisppath@ # Where Emacs will search to find its lisp files. Before # changing this, check to see if your purpose wouldn't # better be served by changing locallisppath. This # should be a colon-separated list of directories. lisppath=@lisppath@ # Where Emacs will search for its lisp files while # building. This is only used during the process of # compiling Emacs, to help Emacs find its lisp files # before they've been installed in their final location. # It's usually identical to lisppath, except that # it does not include locallisppath, and the # entry for the directory containing the installed lisp # files has been replaced with ../lisp. This should be a # colon-separated list of directories. buildlisppath=${srcdir}/lisp # Where to install the other architecture-independent # data files distributed with Emacs (like the tutorial, # the cookie recipes and the Zippy database). This path # usually contains the Emacs version number, so the data # files for multiple versions of Emacs may be installed # at once. etcdir=@etcdir@ # Where to create and expect the locking directory, where # the Emacs locking code keeps track of which files are # currently being edited. lockdir=@lockdir@ # Where to put executables to be run by Emacs rather than # the user. This path usually includes the Emacs version # and configuration name, so that multiple configurations # for multiple versions of Emacs may be installed at # once. archlibdir=@archlibdir@ # Where to put the docstring file. docdir=@docdir@ # ==================== Utility Programs for the Build ==================== # Allow the user to specify the install program. INSTALL = @INSTALL@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_DATA = @INSTALL_DATA@ # ============================= Targets ============================== # What emacs should be called when installed. EMACS = emacs # Subdirectories to make recursively. `lisp' is not included # because the compiled lisp files are part of the distribution # and you cannot remake them without installing Emacs first. SUBDIR = lib-src src # The makefiles of the directories in $SUBDIR. SUBDIR_MAKEFILES = lib-src/Makefile man/Makefile src/Makefile oldXMenu/Makefile lwlib/Makefile # Subdirectories to install, and where they'll go. # lib-src's makefile knows how to install it, so we don't do that here. # When installing the info files, we need to do special things to # avoid nuking an existing dir file, so we don't do that here; # instead, we have written out explicit code in the `install' targets. COPYDIR = ${srcdir}/etc ${srcdir}/lisp COPYDESTS = ${etcdir} ${lispdir} all: paths-force ${SUBDIR} removenullpaths=sed -e 's/^://g' -e 's/:$$//g' -e 's/::/:/g' # Note that sed is not in /bin on 386bsd. src/paths.h: Makefile ${srcdir}/src/paths.in @echo "Producing \`src/paths.h' from \`src/paths.in'." @(lisppath=`echo ${lisppath} | ${removenullpaths}` ; \ buildlisppath=`echo ${buildlisppath} | ${removenullpaths}` ; \ sed < ${srcdir}/src/paths.in > paths.h.$$$$ \ -e 's;\(#.*PATH_LOADSEARCH\).*$$;\1 "'$${lisppath}'";' \ -e 's;\(#.*PATH_DUMPLOADSEARCH\).*$$;\1 "'$${buildlisppath}'";' \ -e 's;\(#.*PATH_EXEC\).*$$;\1 "${archlibdir}";' \ -e 's;\(#.*PATH_INFO\).*$$;\1 "${infodir}";' \ -e 's;\(#.*PATH_DATA\).*$$;\1 "${etcdir}";' \ -e 's;\(#.*PATH_BITMAPS\).*$$;\1 "${bitmapdir}";' \ -e 's;\(#.*PATH_DOC\).*$$;\1 "${docdir}";' \ -e 's;\(#.*PATH_LOCK\).*$$;\1 "${lockdir}/";') && \ ${srcdir}/move-if-change paths.h.$$$$ src/paths.h # For `make all', # we force the rebuilding of src/paths.h because the user might give # make different values for the various directories. Since we use # move-if-change, src/paths.h only actually changes if the user did # something notable, so the only unnecessary work we do is in building # paths.h.$$, which isn't much. # Note that sed is not in /bin on 386bsd. # We depend on src/paths.h here to prevent simultaneous execution of # that rule and this one, in a parallel make. # It is possible for paths.h to be updated twice--but that would happen anyway. paths-force: FRC src/paths.h @echo "Producing \`src/paths.h' from \`src/paths.in'." @(lisppath=`echo ${lisppath} | ${removenullpaths}` ; \ buildlisppath=`echo ${buildlisppath} | ${removenullpaths}` ; \ sed < ${srcdir}/src/paths.in > paths.h.$$$$ \ -e 's;\(#.*PATH_LOADSEARCH\).*$$;\1 "'$${lisppath}'";' \ -e 's;\(#.*PATH_DUMPLOADSEARCH\).*$$;\1 "'$${buildlisppath}'";' \ -e 's;\(#.*PATH_EXEC\).*$$;\1 "${archlibdir}";' \ -e 's;\(#.*PATH_INFO\).*$$;\1 "${infodir}";' \ -e 's;\(#.*PATH_DATA\).*$$;\1 "${etcdir}";' \ -e 's;\(#.*PATH_BITMAPS\).*$$;\1 "${bitmapdir}";' \ -e 's;\(#.*PATH_DOC\).*$$;\1 "${docdir}";' \ -e 's;\(#.*PATH_LOCK\).*$$;\1 "${lockdir}/";') && \ ${srcdir}/move-if-change paths.h.$$$$ src/paths.h src: lib-src FRC src/paths.h # This ought to depend on src/paths.h, so that in parallel make # src/paths.h will be available for the compilations in lib-src. # But that causes trouble in `make install' if a different prefix # is specified at that time. lib-src: FRC src/paths.h .RECURSIVE: ${SUBDIR} ${SUBDIR}: ${SUBDIR_MAKEFILES} FRC cd $@; $(MAKE) all $(MFLAGS) \ CC='${CC}' CFLAGS='${CFLAGS}' CPPFLAGS='${CPPFLAGS}' \ LDFLAGS='${LDFLAGS}' MAKE='${MAKE}' blessmail: ${SUBDIR_MAKEFILES} src FRC cd lib-src; $(MAKE) maybe-blessmail $(MFLAGS) \ MAKE='${MAKE}' archlibdir='$(archlibdir)' Makefile: Makefile.in config.status ./config.status src/Makefile: src/Makefile.in config.status ./config.status lib-src/Makefile: lib-src/Makefile.in config.status ./config.status oldXMenu/Makefile: oldXMenu/Makefile.in config.status ./config.status lwlib/Makefile: lwlib/Makefile.in config.status ./config.status # ==================== Installation ==================== ## If we let lib-src do its own installation, that means we ## don't have to duplicate the list of utilities to install in ## this Makefile as well. ## On AIX, use tar xBf. ## On Xenix, use tar xpf. .PHONY: install mkdir ## We delete each directory in ${COPYDESTS} before we copy into it; ## that way, we can reinstall over directories that have been put in ## place with their files read-only (perhaps because they are checked ## into RCS). In order to make this safe, we make sure that the ## source exists and is distinct from the destination. ## We don't depend on `all', but rather on ${SUBDIR}, so that we won't ## ever modify src/paths.h. install: ${SUBDIR} install-arch-dep install-arch-indep blessmail @true ### Note that we copy the DOC-* files from the build etc directory ### as well as lots of things from ${srcdir}/etc. install-arch-dep: mkdir (cd lib-src; \ $(MAKE) install $(MFLAGS) prefix=${prefix} \ exec_prefix=${exec_prefix} bindir=${bindir} \ libexecdir=${libexecdir} archlibdir=${archlibdir}) ${INSTALL_PROGRAM} src/emacs ${bindir}/emacs-${version} -chmod 1755 ${bindir}/emacs-${version} rm -f ${bindir}/$(EMACS) -ln ${bindir}/emacs-${version} ${bindir}/$(EMACS) ### Note that we copy the DOC-* files from the build etc directory ### as well as lots of things from ${srcdir}/etc. ### Note that we copy DOC* and then delete DOC ### as a workaround for a bug in tar on Ultrix 4.2. install-arch-indep: mkdir -set ${COPYDESTS} ; \ for dir in ${COPYDIR} ; do \ if [ `(cd $$1 && /bin/pwd)` != `(cd $${dir} && /bin/pwd)` ] ; then \ rm -rf $$1 ; \ fi ; \ shift ; \ done -set ${COPYDESTS} ; \ mkdir ${COPYDESTS} ; \ chmod ugo+rx ${COPYDESTS} ; \ for dir in ${COPYDIR} ; do \ dest=$$1 ; shift ; \ [ -d $${dir} ] \ && [ `(cd $${dir} && /bin/pwd)` != `(cd $${dest} && /bin/pwd)` ] \ && (echo "Copying $${dir}..." ; \ (cd $${dir}; tar -cf - . )|(cd $${dest};umask 022; tar -xvf - ); \ for subdir in `find $${dest} -type d ! -name RCS -print` ; do \ rm -rf $${subdir}/RCS ; \ rm -rf $${subdir}/CVS ; \ rm -f $${subdir}/\#* ; \ rm -f $${subdir}/.\#* ; \ rm -f $${subdir}/*~ ; \ rm -f $${subdir}/*.orig ; \ done) ; \ done -rm -f ${lispdir}/subdirs.el $(srcdir)/update-subdirs ${lispdir} if [ `(cd ./etc; /bin/pwd)` != `(cd ${docdir}; /bin/pwd)` ]; \ then \ echo "Copying etc/DOC-* ..." ; \ (cd etc; tar -cf - DOC*)|(cd ${docdir}; umask 0; tar -xvf - ); \ (cd $(docdir); rm DOC) \ else true; fi thisdir=`/bin/pwd`; \ if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd ${infodir} && /bin/pwd)` ]; \ then \ (cd ${infodir}; \ if [ -f dir ] && [ ! -f dir.old ]; then mv -f dir dir.old; \ else mv -f dir dir.bak; fi; \ cd ${srcdir}/info ; \ (cd $${thisdir}; ${INSTALL_DATA} ${srcdir}/info/dir ${infodir}/dir); \ for f in cl* dired-x* ediff* emacs* forms* gnus* info* mh-e* sc* vip*; do \ (cd $${thisdir}; ${INSTALL_DATA} ${srcdir}/info/$$f ${infodir}/$$f); \ done); \ else true; fi thisdir=`/bin/pwd`; cd ${srcdir}/etc; for page in emacs etags ctags ; do \ (cd $${thisdir}; ${INSTALL_DATA} ${srcdir}/etc/$${page}.1 ${man1dir}/$${page}${manext}); \ done ### Build all the directories we're going to install Emacs in. Since ### we may be creating several layers of directories (for example, ### /usr/local/lib/emacs/19.0/mips-dec-ultrix4.2), we use mkinstalldirs ### instead of mkdir. Not all systems' mkdir programs have the `-p' flag. mkdir: FRC $(srcdir)/mkinstalldirs ${COPYDESTS} ${lockdir} ${infodir} ${man1dir} \ ${bindir} ${datadir} ${docdir} ${libexecdir} \ `echo ${locallisppath} | sed 's/:/ /g'` -chmod a+rwx ${lockdir} ### Delete all the installed files that the `install' target would ### create (but not the noninstalled files such as `make all' would ### create). ### ### Don't delete the lisp and etc directories if they're in the source tree. uninstall: (cd lib-src; \ $(MAKE) $(MFLAGS) uninstall \ prefix=${prefix} exec_prefix=${exec_prefix} \ bindir=${bindir} libexecdir=${libexecdir} archlibdir=${archlibdir}) for dir in ${lispdir} ${etcdir} ; do \ if [ -d $${dir} ]; then \ case `(cd $${dir} ; /bin/pwd)` in \ `(cd ${srcdir} ; /bin/pwd)`* ) ;; \ * ) rm -rf $${dir} ;; \ esac ; \ case $${dir} in \ ${datadir}/emacs/${version}/* ) \ rm -rf ${datadir}/emacs/${version} \ ;; \ esac ; \ fi ; \ done (cd ${infodir} && rm -f cl* dired-x* ediff* emacs* forms* gnus* info* mh-e* sc* vip*) (cd ${man1dir} && rm -f emacs.1 etags.1 ctags.1) (cd ${bindir} && rm -f emacs-${version} $(EMACS)) FRC: # ==================== Cleaning up and miscellanea ==================== .PHONY: mostlyclean clean distclean maintainer-clean extraclean ### `mostlyclean' ### Like `clean', but may refrain from deleting a few files that people ### normally don't want to recompile. For example, the `mostlyclean' ### target for GCC does not delete `libgcc.a', because recompiling it ### is rarely necessary and takes a lot of time. mostlyclean: FRC (cd src; $(MAKE) $(MFLAGS) mostlyclean) (cd oldXMenu; $(MAKE) $(MFLAGS) mostlyclean) (cd lwlib; $(MAKE) $(MFLAGS) mostlyclean) (cd lib-src; $(MAKE) $(MFLAGS) mostlyclean) -(cd man && $(MAKE) $(MFLAGS) mostlyclean) ### `clean' ### Delete all files from the current directory that are normally ### created by building the program. Don't delete the files that ### record the configuration. Also preserve files that could be made ### by building, but normally aren't because the distribution comes ### with them. ### ### Delete `.dvi' files here if they are not part of the distribution. clean: FRC (cd src; $(MAKE) $(MFLAGS) clean) (cd oldXMenu; $(MAKE) $(MFLAGS) clean) (cd lwlib; $(MAKE) $(MFLAGS) clean) (cd lib-src; $(MAKE) $(MFLAGS) clean) -(cd man && $(MAKE) $(MFLAGS) clean) ### `distclean' ### Delete all files from the current directory that are created by ### configuring or building the program. If you have unpacked the ### source and built the program without creating any other files, ### `make distclean' should leave only the files that were in the ### distribution. top_distclean=\ rm -f config.status config.cache config.log ; \ rm -f Makefile ${SUBDIR_MAKEFILES} ; \ (cd lock && rm -f *) distclean: FRC (cd src; $(MAKE) $(MFLAGS) distclean) (cd oldXMenu; $(MAKE) $(MFLAGS) distclean) (cd lwlib; $(MAKE) $(MFLAGS) distclean) (cd lib-src; $(MAKE) $(MFLAGS) distclean) (cd man && $(MAKE) $(MFLAGS) distclean) ${top_distclean} ### `maintainer-clean' ### Delete everything from the current directory that can be ### reconstructed with this Makefile. This typically includes ### everything deleted by distclean, plus more: C source files ### produced by Bison, tags tables, info files, and so on. ### ### One exception, however: `make maintainer-clean' should not delete ### `configure' even if `configure' can be remade using a rule in the ### Makefile. More generally, `make maintainer-clean' should not delete ### anything that needs to exist in order to run `configure' and then ### begin to build the program. maintainer-clean: FRC (cd src; $(MAKE) $(MFLAGS) maintainer-clean) (cd oldXMenu; $(MAKE) $(MFLAGS) maintainer-clean) (cd lwlib; $(MAKE) $(MFLAGS) maintainer-clean) (cd lib-src; $(MAKE) $(MFLAGS) maintainer-clean) -(cd man && $(MAKE) $(MFLAGS) maintainer-clean) ${top_distclean} ### This doesn't actually appear in the coding standards, but Karl ### says GCC supports it, and that's where the configuration part of ### the coding standards seem to come from. It's like distclean, but ### it deletes backup and autosave files too. extraclean: for i in ${SUBDIR}; do (cd $$i; $(MAKE) $(MFLAGS) extraclean); done -(cd lock && rm *) -rm config.status config-tmp-* -rm -f *~ \#* ### Unlocking and relocking. The idea of these productions is to reduce ### hassles when installing an incremental tar of Emacs. Do `make unlock' ### before unlocking the file to take the write locks off all sources so ### that tar xvof will overwrite them without fuss. Then do `make relock' ### afterward so that VC mode will know which files should be checked in ### if you want to mung them. ### ### Note: it's no disaster if these productions miss a file or two; tar ### and VC will swiftly let you know if this happens, and it is easily ### corrected. SOURCES = ChangeLog GETTING.GNU.SOFTWARE INSTALL Makefile.in PROBLEMS \ README configure make-dist move-if-change .PHONY: unlock relock unlock: chmod u+w $(SOURCES) cpp/* -(cd elisp; chmod u+w Makefile README *.texi) (cd etc; $(MAKE) $(MFLAGS) unlock) (cd lib-src; $(MAKE) $(MFLAGS) unlock) (cd lisp; $(MAKE) $(MFLAGS) unlock) (cd lisp/term; chmod u+w README *.el) (cd man; chmod u+w *texi* ChangeLog split-man) (cd oldXMenu; chmod u+w *.[ch] Makefile README) (cd lwlib; chmod u+w *.[ch] Makefile README) (cd src; $(MAKE) $(MFLAGS) unlock) relock: chmod u-w $(SOURCES) cpp/* -(cd elisp; chmod u-w Makefile README *.texi) (cd etc; $(MAKE) $(MFLAGS) relock) (cd lib-src; $(MAKE) $(MFLAGS) relock) (cd lisp; $(MAKE) $(MFLAGS) relock) (cd lisp/term; chmod u+w README *.el) (cd man; chmod u+w *texi* ChangeLog split-man) (cd oldXMenu; chmod u+w *.[ch] Makefile README) (cd lwlib; chmod u+w *.[ch] Makefile README) (cd src; $(MAKE) $(MFLAGS) relock) TAGS tags: lib-src cd ${srcdir}/src; $(MAKE) tags check: @echo "We don't have any tests for GNU Emacs yet." dist: $(srcdir)/update-subdirs ${srcdir}/lisp cd ${srcdir}; make-dist .PHONY: info dvi dist check force-info: info: force-info (cd ${srcdir}/man; $(MAKE) $(MFLAGS) info) dvi: (cd man; $(MAKE) $(MFLAGS) dvi) emacs-19.30/configure100777 12120 1 323542 6054021512 13061 0ustar rmsdaemon#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated automatically using autoconf version 2.5 # Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. # Defaults: ac_help= ac_default_prefix=/usr/local # Any additions from configure.in: ac_help="$ac_help --with-gcc use GCC to compile Emacs" ac_help="$ac_help --with-pop support POP for mail retrieval" ac_help="$ac_help --with-kerberos support Kerberos-authenticated POP" ac_help="$ac_help --with-hesiod support Hesiod to get the POP server host" ac_help="$ac_help --with-x-toolkit=KIT use an X toolkit (KIT = yes/lucid/athena/motif)" ac_help="$ac_help --with-x use the X Window System" # Initialize some variables set by options. # The variables have the same names as the options, with # dashes changed to underlines. build=NONE cache_file=./config.cache exec_prefix=NONE host=NONE no_create= nonopt=NONE no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= target=NONE verbose= x_includes=NONE x_libraries=NONE bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' # Initialize some other variables. subdirs= MFLAGS= MAKEFLAGS= ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi case "$ac_option" in -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; *) ac_optarg= ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case "$ac_option" in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir="$ac_optarg" ;; -build | --build | --buil | --bui | --bu) ac_prev=build ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build="$ac_optarg" ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file="$ac_optarg" ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir="$ac_optarg" ;; -disable-* | --disable-*) ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } fi ac_feature=`echo $ac_feature| sed 's/-/_/g'` eval "enable_${ac_feature}=no" ;; -enable-* | --enable-*) ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } fi ac_feature=`echo $ac_feature| sed 's/-/_/g'` case "$ac_option" in *=*) ;; *) ac_optarg=yes ;; esac eval "enable_${ac_feature}='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix="$ac_optarg" ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he) # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat << EOF Usage: configure [options] [host] Options: [defaults in brackets after descriptions] Configuration: --cache-file=FILE cache test results in FILE --help print this message --no-create do not create output files --quiet, --silent do not print \`checking...' messages --version print the version of autoconf that created configure Directory and file names: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [same as prefix] --bindir=DIR user executables in DIR [EPREFIX/bin] --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] --libexecdir=DIR program executables in DIR [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data in DIR [PREFIX/share] --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data in DIR [PREFIX/com] --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] --libdir=DIR object code libraries in DIR [EPREFIX/lib] --includedir=DIR C header files in DIR [PREFIX/include] --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] --infodir=DIR info documentation in DIR [PREFIX/info] --mandir=DIR man documentation in DIR [PREFIX/man] --srcdir=DIR find the sources in DIR [configure dir or ..] --program-prefix=PREFIX prepend PREFIX to installed program names --program-suffix=SUFFIX append SUFFIX to installed program names --program-transform-name=PROGRAM run sed PROGRAM on installed program names EOF cat << EOF Host type: --build=BUILD configure for building on BUILD [BUILD=HOST] --host=HOST configure for HOST [guessed] --target=TARGET configure for TARGET [TARGET=HOST] Features and packages: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --x-includes=DIR X include files are in DIR --x-libraries=DIR X library files are in DIR --enable and --with options recognized:$ac_help EOF exit 0 ;; -host | --host | --hos | --ho) ac_prev=host ;; -host=* | --host=* | --hos=* | --ho=*) host="$ac_optarg" ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir="$ac_optarg" ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir="$ac_optarg" ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir="$ac_optarg" ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir="$ac_optarg" ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir="$ac_optarg" ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir="$ac_optarg" ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir="$ac_optarg" ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix="$ac_optarg" ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix="$ac_optarg" ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix="$ac_optarg" ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name="$ac_optarg" ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir="$ac_optarg" ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir="$ac_optarg" ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site="$ac_optarg" ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir="$ac_optarg" ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir="$ac_optarg" ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target="$ac_optarg" ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers) echo "configure generated by autoconf version 2.5" exit 0 ;; -with-* | --with-*) ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } fi ac_package=`echo $ac_package| sed 's/-/_/g'` case "$ac_option" in *=*) ;; *) ac_optarg=yes ;; esac eval "with_${ac_package}='$ac_optarg'" ;; -without-* | --without-*) ac_package=`echo $ac_option|sed -e 's/-*without-//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } fi ac_package=`echo $ac_package| sed 's/-/_/g'` eval "with_${ac_package}=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes="$ac_optarg" ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries="$ac_optarg" ;; -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } ;; *) if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then echo "configure: warning: $ac_option: invalid host type" 1>&2 fi if test "x$nonopt" != xNONE; then { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } fi nonopt="$ac_option" ;; esac done if test -n "$ac_prev"; then { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } fi trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 # File descriptor usage: # 0 standard input # 1 file creation # 2 errors and warnings # 3 some systems may open it to /dev/tty # 4 used on the Kubota Titan # 6 checking for... messages and results # 5 compiler messages saved in config.log if test "$silent" = yes; then exec 6>/dev/null else exec 6>&1 fi exec 5>./config.log echo "\ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. " 1>&5 # Strip out --no-create and --no-recursion so they do not pile up. # Also quote any args containing shell metacharacters. ac_configure_args= for ac_arg do case "$ac_arg" in -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c) ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) ac_configure_args="$ac_configure_args '$ac_arg'" ;; *) ac_configure_args="$ac_configure_args $ac_arg" ;; esac done # NLS nuisances. # Only set LANG and LC_ALL to C if already set. # These must not be set unconditionally because not all systems understand # e.g. LANG=C (notably SCO). if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi if test "${LANG+set}" = set; then LANG=C; export LANG; fi # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo > confdefs.h # A filename unique to this package, relative to the directory that # configure is in, which we can look for to find out if srcdir is correct. ac_unique_file=src/lisp.h # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_prog=$0 ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } else { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } fi fi srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then echo "loading site script $ac_site_file" . "$ac_site_file" fi done if test -r "$cache_file"; then echo "loading cache $cache_file" . $cache_file else echo "creating cache $cache_file" > $cache_file fi ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='echo $CPP $CPPFLAGS 1>&5; $CPP $CPPFLAGS' ac_compile='echo ${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5; ${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5 2>&5' ac_link='echo ${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5; ${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5 2>&5' if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then ac_n= ac_c=' ' ac_t=' ' else ac_n=-n ac_c= ac_t= fi else ac_n= ac_c='\c' ac_t= fi lispdir='${datadir}/emacs/${version}/lisp' locallisppath='${datadir}/emacs/site-lisp' lisppath='${locallisppath}:${lispdir}' etcdir='${datadir}/emacs/${version}/etc' lockdir='${sharedstatedir}/emacs/lock' archlibdir='${libexecdir}/emacs/${version}/${configuration}' docdir='${datadir}/emacs/${version}/etc' # Check whether --with-gcc or --without-gcc was given. if test "${with_gcc+set}" = set; then withval="$with_gcc" : fi # Check whether --with-pop or --without-pop was given. if test "${with_pop+set}" = set; then withval="$with_pop" cat >> confdefs.h <<\EOF #define MAIL_USE_POP 1 EOF fi # Check whether --with-kerberos or --without-kerberos was given. if test "${with_kerberos+set}" = set; then withval="$with_kerberos" cat >> confdefs.h <<\EOF #define KERBEROS 1 EOF fi # Check whether --with-hesiod or --without-hesiod was given. if test "${with_hesiod+set}" = set; then withval="$with_hesiod" cat >> confdefs.h <<\EOF #define HESIOD 1 EOF fi # Check whether --with-x-toolkit or --without-x-toolkit was given. if test "${with_x_toolkit+set}" = set; then withval="$with_x_toolkit" case "${withval}" in y | ye | yes ) val=athena ;; n | no ) val=no ;; l | lu | luc | luci | lucid ) val=lucid ;; a | at | ath | athe | athen | athena ) val=athena ;; m | mo | mot | moti | motif ) val=motif ;; * ) { echo "configure: error: \`--with-x-toolkit=$withval' is invalid\; this option's value should be \`yes', \`no', \`lucid', \`athena', or \`motif'. Currently, \`yes', \`athena' and \`lucid' are synonyms." 1>&2; exit 1; } ;; esac with_x_toolkit=$val fi #### Make srcdir absolute, if it isn't already. It's important to #### avoid running the path through pwd unnecessary, since pwd can #### give you automounter prefixes, which can go away. We do all this #### so Emacs can find its files when run uninstalled. case "${srcdir}" in /* ) ;; . ) ## We may be able to use the $PWD environment variable to make this ## absolute. But sometimes PWD is inaccurate. ## Make sure CDPATH doesn't affect cd (in case PWD is relative). CDPATH= if test "${PWD}" != "" && test "`(cd ${PWD} ; sh -c pwd)`" = "`pwd`" ; then srcdir="$PWD" else srcdir="`(cd ${srcdir}; pwd)`" fi ;; * ) srcdir="`(cd ${srcdir}; pwd)`" ;; esac #### Check if the source directory already has a configured system in it. if test `pwd` != `(cd ${srcdir} && pwd)` \ && test -f "${srcdir}/src/config.h" ; then echo "configure: warning: The directory tree \`${srcdir}' is being used as a build directory right now; it has been configured in its own right. To configure in another directory as well, you MUST use GNU make. If you do not have GNU make, then you must now do \`make distclean' in ${srcdir}, and then run $0 again." 1>&2 extrasub='/^VPATH[ ]*=/c\ vpath %.c $(srcdir)\ vpath %.h $(srcdir)\ vpath %.y $(srcdir)\ vpath %.l $(srcdir)\ vpath %.s $(srcdir)\ vpath %.in $(srcdir)' fi #### Given the configuration name, set machfile and opsysfile to the #### names of the m/*.h and s/*.h files we should use. ### Canonicalize the configuration name. ac_aux_dir= for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do if test -f $ac_dir/install-sh; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install-sh -c" break elif test -f $ac_dir/install.sh; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install.sh -c" break fi done if test -z "$ac_aux_dir"; then { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; } fi ac_config_guess=$ac_aux_dir/config.guess ac_config_sub=$ac_aux_dir/config.sub ac_configure=$ac_aux_dir/configure # This should be Cygnus configure. # Make sure we can run config.sub. if $ac_config_sub sun4 >/dev/null 2>&1; then : else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; } fi echo $ac_n "checking host system type""... $ac_c" 1>&6 host_alias=$host case "$host_alias" in NONE) case $nonopt in NONE) if host_alias=`$ac_config_guess`; then : else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; } fi ;; *) host_alias=$nonopt ;; esac ;; esac host=`$ac_config_sub $host_alias` host_cpu=`echo $host | sed 's/^\(.*\)-\(.*\)-\(.*\)$/\1/'` host_vendor=`echo $host | sed 's/^\(.*\)-\(.*\)-\(.*\)$/\2/'` host_os=`echo $host | sed 's/^\(.*\)-\(.*\)-\(.*\)$/\3/'` echo "$ac_t""$host" 1>&6 canonical=$host configuration=$host_alias ### If you add support for a new configuration, add code to this ### switch statement to recognize your configuration name and select ### the appropriate operating system and machine description files. ### You would hope that you could choose an m/*.h file pretty much ### based on the machine portion of the configuration name, and an s- ### file based on the operating system portion. However, it turns out ### that each m/*.h file is pretty manufacturer-specific - for ### example, apollo.h, hp9000s300.h, mega68k, news.h, and tad68k are ### all 68000 machines; mips.h, pmax.h, and news-risc are all MIPS ### machines. So we basically have to have a special case for each ### configuration name. ### ### As far as handling version numbers on operating systems is ### concerned, make sure things will fail in a fixable way. If ### /etc/MACHINES doesn't say anything about version numbers, be ### prepared to handle anything reasonably. If version numbers ### matter, be sure /etc/MACHINES says something about it. ### ### Eric Raymond says we should accept strings like "sysvr4" to mean ### "System V Release 4"; he writes, "The old convention encouraged ### confusion between `system' and `release' levels'." machine='' opsys='' unported=no case "${canonical}" in ## NetBSD ports *-*-netbsd* ) opsys=netbsd case "${canonical}" in i[345]86-*-netbsd*) machine=intel386 ;; m68k-*-netbsd*) # This is somewhat bogus. machine=hp9000s300 ;; mips-*-netbsd*) machine=pmax ;; ns32k-*-netbsd*) machine=ns32000 ;; sparc-*-netbsd*) machine=sparc ;; esac ;; ## Acorn RISCiX: arm-acorn-riscix1.1* ) machine=acorn opsys=riscix1-1 ;; arm-acorn-riscix1.2* | arm-acorn-riscix ) machine=acorn opsys=riscix1-2 ;; ## Alliant machines ## Strictly speaking, we need the version of the alliant operating ## system to choose the right machine file, but currently the ## configuration name doesn't tell us enough to choose the right ## one; we need to give alliants their own operating system name to ## do this right. When someone cares, they can help us. fx80-alliant-* ) machine=alliant4 opsys=bsd4-2 ;; i860-alliant-* ) machine=alliant-2800 opsys=bsd4-3 ;; ## Alpha (DEC) machines. alpha-dec-osf* ) machine=alpha opsys=osf1 ;; alpha-*-linux* ) machine=alpha opsys=linux ;; ## Altos 3068 m68*-altos-sysv* ) machine=altos opsys=usg5-2 ;; ## Amdahl UTS 580-amdahl-sysv* ) machine=amdahl opsys=usg5-2-2 ;; ## Apollo, Domain/OS m68*-apollo-* ) machine=apollo opsys=bsd4-3 ;; ## AT&T 3b2, 3b5, 3b15, 3b20 we32k-att-sysv* ) machine=att3b opsys=usg5-2-2 ;; ## AT&T 3b1 - The Mighty Unix PC! m68*-att-sysv* ) machine=7300 opsys=usg5-2-2 ;; ## Bull dpx20 rs6000-bull-bosx* ) machine=ibmrs6000 opsys=aix3-2 ;; ## Bull dpx2 m68*-bull-sysv3* ) machine=dpx2 opsys=usg5-3 ;; ## Bull sps7 m68*-bull-sysv2* ) machine=sps7 opsys=usg5-2 ;; ## CCI 5/32, 6/32 -- see "Tahoe". ## Celerity ## I don't know what configuration name to use for this; config.sub ## doesn't seem to know anything about it. Hey, Celerity users, get ## in touch with us! celerity-celerity-bsd* ) machine=celerity opsys=bsd4-2 ;; ## Clipper ## What operating systems does this chip run that Emacs has been ## tested on? clipper-* ) machine=clipper ## We'll use the catch-all code at the bottom to guess the ## operating system. ;; ## Convex *-convex-bsd* | *-convex-convexos* ) machine=convex opsys=bsd4-3 ## Prevents suprious white space in makefiles - d.m.cooke@larc.nasa.gov NON_GNU_CPP="cc -E -P" ;; ## Cubix QBx/386 i[345]86-cubix-sysv* ) machine=intel386 opsys=usg5-3 ;; ## Cydra 5 cydra*-cydrome-sysv* ) machine=cydra5 opsys=usg5-3 ;; ## Data General AViiON Machines m88k-dg-dgux5.4R3* | m88k-dg-dgux5.4.3* ) machine=aviion opsys=dgux5-4r3 ;; m88k-dg-dgux5.4R2* | m88k-dg-dgux5.4.2* ) machine=aviion opsys=dgux5-4r2 ;; m88k-dg-dgux* ) machine=aviion opsys=dgux ;; ## DECstations mips-dec-ultrix[0-3].* | mips-dec-ultrix4.0* | mips-dec-bsd4.2* ) machine=pmax opsys=bsd4-2 ;; mips-dec-ultrix4.[12]* | mips-dec-bsd* ) machine=pmax opsys=bsd4-3 ;; mips-dec-ultrix* ) machine=pmax opsys=ultrix4-3 ;; mips-dec-osf* ) machine=pmax opsys=osf1 ;; mips-dec-mach_bsd4.3* ) machine=pmax opsys=mach-bsd4-3 ;; ## Motorola Delta machines m68k-motorola-sysv* | m68000-motorola-sysv* ) machine=delta opsys=usg5-3 if test -z "`type gnucc | grep 'not found'`" then if test -s /etc/167config then CC="gnucc -m68040" else CC="gnucc -m68881" fi else if test -z "`type gcc | grep 'not found'`" then CC=gcc else CC=cc fi fi ;; m88k-motorola-sysv4* ) # jbotte@bnr.ca says that UNIX_System_V 4.0 R40V4.3 m88k mc88110 # needs POSIX_SIGNALS and therefore needs usg5-4-2. # I hope there are not other 4.0 versions for this machine # which really need usg5-4 instead. machine=delta88k opsys=usg5-4-2 ;; m88k-motorola-sysv* | m88k-motorola-m88kbcs* ) machine=delta88k opsys=usg5-3 ;; ## Dual machines m68*-dual-sysv* ) machine=dual opsys=usg5-2 ;; m68*-dual-uniplus* ) machine=dual opsys=unipl5-2 ;; ## Elxsi 6400 elxsi-elxsi-sysv* ) machine=elxsi opsys=usg5-2 ;; ## Encore machines ns16k-encore-bsd* ) machine=ns16000 opsys=umax ;; ## The GEC 93 - apparently, this port isn't really finished yet. ## Gould Power Node and NP1 pn-gould-bsd4.2* ) machine=gould opsys=bsd4-2 ;; pn-gould-bsd4.3* ) machine=gould opsys=bsd4-3 ;; np1-gould-bsd* ) machine=gould-np1 opsys=bsd4-3 ;; ## Harris Night Hawk machines running CX/UX (a 5000 looks just like a 4000 ## as far as Emacs is concerned). m88k-harris-cxux* ) # Build needs to be different on 7.0 and later releases case "`uname -r`" in [56].[0-9] ) machine=nh4000 opsys=cxux ;; [7].[0-9] ) machine=nh4000 opsys=cxux7 ;; esac ;; ## Harris ecx or gcx running CX/UX (Series 1200, Series 3000) m68k-harris-cxux* ) machine=nh3000 opsys=cxux ;; ## Honeywell XPS100 xps*-honeywell-sysv* ) machine=xps100 opsys=usg5-2 ;; ## HP 9000 series 200 or 300 m68*-hp-bsd* ) machine=hp9000s300 opsys=bsd4-3 ;; ## HP/UX 7, 8, 9, and 10 are supported on these machines. m68*-hp-hpux* ) case "`uname -r`" in ## Someone's system reports A.B8.05 for this. ## I wonder what other possibilities there are. *.B8.* ) machine=hp9000s300 opsys=hpux8 ;; *.08.* ) machine=hp9000s300 opsys=hpux8 ;; *.09.* ) machine=hp9000s300 opsys=hpux9 ;; *.10.* ) machine=hp9000s300 opsys=hpux9shr ;; *) machine=hp9000s300 opsys=hpux ;; esac ;; ## HP 9000 series 700 and 800, running HP/UX hppa*-hp-hpux7* ) machine=hp800 opsys=hpux ;; hppa*-hp-hpux8* ) machine=hp800 opsys=hpux8 ;; hppa*-hp-hpux9shr* ) machine=hp800 opsys=hpux9shr ;; hppa*-hp-hpux9* ) machine=hp800 opsys=hpux9 ;; hppa*-hp-hpux10* ) machine=hp800 opsys=hpux10 ;; ## HP 9000 series 700 and 800, running HP/UX hppa*-hp-hpux* ) ## Cross-compilation? Nah! case "`uname -r`" in ## Someone's system reports A.B8.05 for this. ## I wonder what other possibilities there are. *.B8.* ) machine=hp800 opsys=hpux8 ;; *.08.* ) machine=hp800 opsys=hpux8 ;; *.09.* ) machine=hp800 opsys=hpux9 ;; *) machine=hp800 opsys=hpux ;; esac ;; ## Orion machines orion-orion-bsd* ) machine=orion opsys=bsd4-2 ;; clipper-orion-bsd* ) machine=orion105 opsys=bsd4-2 ;; ## IBM machines i[345]86-ibm-aix1.1* ) machine=ibmps2-aix opsys=usg5-2-2 ;; i[345]86-ibm-aix1.[23]* | i[345]86-ibm-aix* ) machine=ibmps2-aix opsys=usg5-3 ;; i370-ibm-aix*) machine=ibm370aix opsys=usg5-3 ;; rs6000-ibm-aix3.1* | powerpc-ibm-aix3.1* ) machine=ibmrs6000 opsys=aix3-1 ;; rs6000-ibm-aix3.2.5 | powerpc-ibm-aix3.2.5 ) machine=ibmrs6000 opsys=aix3-2-5 ;; rs6000-ibm-aix4.1* | powerpc-ibm-aix4.1* ) machine=ibmrs6000 opsys=aix4-1 ;; rs6000-ibm-aix4* | powerpc-ibm-aix4* ) machine=ibmrs6000 opsys=aix4 ;; rs6000-ibm-aix* | powerpc-ibm-aix* ) machine=ibmrs6000 opsys=aix3-2 ;; romp-ibm-bsd4.3* ) machine=ibmrt opsys=bsd4-3 ;; romp-ibm-bsd4.2* ) machine=ibmrt opsys=bsd4-2 ;; romp-ibm-aos4.3* ) machine=ibmrt opsys=bsd4-3 ;; romp-ibm-aos4.2* ) machine=ibmrt opsys=bsd4-2 ;; romp-ibm-aos* ) machine=ibmrt opsys=bsd4-3 ;; romp-ibm-bsd* ) machine=ibmrt opsys=bsd4-3 ;; romp-ibm-aix* ) machine=ibmrt-aix opsys=usg5-2-2 ;; ## Integrated Solutions `Optimum V' m68*-isi-bsd4.2* ) machine=isi-ov opsys=bsd4-2 ;; m68*-isi-bsd4.3* ) machine=isi-ov opsys=bsd4-3 ;; ## Intel 386 machines where we do care about the manufacturer i[345]86-intsys-sysv* ) machine=is386 opsys=usg5-2-2 ;; ## Prime EXL i[345]86-prime-sysv* ) machine=i386 opsys=usg5-3 ;; ## Sequent Symmetry running Dynix i[345]86-sequent-bsd* ) machine=symmetry opsys=bsd4-3 ;; ## Sequent Symmetry running DYNIX/ptx ## Use the old cpp rather than the newer ANSI one. i[345]86-sequent-ptx* ) machine=sequent-ptx opsys=ptx NON_GNU_CPP="/lib/cpp" ;; ## Unspecified sysv on an ncr machine defaults to svr4.2. ## (Plain usg5-4 doesn't turn on POSIX signals, which we need.) i[345]86-ncr-sysv* ) machine=ncr386 opsys=usg5-4-2 ;; ## Intel Paragon OSF/1 i860-intel-osf1* ) machine=paragon opsys=osf1 NON_GNU_CPP=/usr/mach/lib/cpp ;; ## Intel 860 i860-*-sysv4* ) machine=i860 opsys=usg5-4 NON_GNU_CC="/bin/cc" # Ie, not the one in /usr/ucb/cc. NON_GNU_CPP="/usr/ccs/lib/cpp" # cc -E tokenizes macro expansion. ;; ## Masscomp machines m68*-masscomp-rtu* ) machine=masscomp opsys=rtu ;; ## Megatest machines m68*-megatest-bsd* ) machine=mega68 opsys=bsd4-2 ;; ## Workstations sold by MIPS ## This is not necessarily all workstations using the MIPS processor - ## Irises are produced by SGI, and DECstations by DEC. ## etc/MACHINES lists mips.h and mips4.h as possible machine files, ## and usg5-2-2 and bsd4-3 as possible OS files. The only guidance ## it gives for choosing between the alternatives seems to be "Use ## -machine=mips4 for RISCOS version 4; use -opsystem=bsd4-3 with ## the BSD world." I'll assume that these are instructions for ## handling two odd situations, and that every other situation ## should use mips.h and usg5-2-2, they being listed first. mips-mips-usg* ) machine=mips4 ## Fall through to the general code at the bottom to decide on the OS. ;; mips-mips-riscos4* ) machine=mips4 opsys=bsd4-3 NON_GNU_CC="cc -systype bsd43" NON_GNU_CPP="cc -systype bsd43 -E" ;; mips-mips-riscos5* ) machine=mips4 opsys=riscos5 NON_GNU_CC="cc -systype bsd43" NON_GNU_CPP="cc -systype bsd43 -E" ;; mips-mips-bsd* ) machine=mips opsys=bsd4-3 ;; mips-mips-* ) machine=mips opsys=usg5-2-2 ;; ## NeXT m68*-next-* | m68k-*-nextstep* ) machine=m68k opsys=nextstep ;; ## The complete machine from National Semiconductor ns32k-ns-genix* ) machine=ns32000 opsys=usg5-2 ;; ## NCR machines m68*-ncr-sysv2* | m68*-ncr-sysvr2* ) machine=tower32 opsys=usg5-2-2 ;; m68*-ncr-sysv3* | m68*-ncr-sysvr3* ) machine=tower32v3 opsys=usg5-3 ;; ## Nixdorf Targon 31 m68*-nixdorf-sysv* ) machine=targon31 opsys=usg5-2-2 ;; ## Nu (TI or LMI) m68*-nu-sysv* ) machine=nu opsys=usg5-2 ;; ## Plexus m68*-plexus-sysv* ) machine=plexus opsys=usg5-2 ;; ## Pyramid machines ## I don't really have any idea what sort of processor the Pyramid has, ## so I'm assuming it is its own architecture. pyramid-pyramid-bsd* ) machine=pyramid opsys=bsd4-2 ;; ## Sequent Balance ns32k-sequent-bsd4.2* ) machine=sequent opsys=bsd4-2 ;; ns32k-sequent-bsd4.3* ) machine=sequent opsys=bsd4-3 ;; ## Siemens Nixdorf mips-siemens-sysv* ) machine=mips-siemens opsys=usg5-4 NON_GNU_CC=/usr/ccs/bin/cc NON_GNU_CPP=/usr/ccs/lib/cpp ;; ## Silicon Graphics machines ## Iris 2500 and Iris 2500 Turbo (aka the Iris 3030) m68*-sgi-iris3.5* ) machine=irist opsys=iris3-5 ;; m68*-sgi-iris3.6* | m68*-sgi-iris*) machine=irist opsys=iris3-6 ;; ## Iris 4D mips-sgi-irix3* ) machine=iris4d opsys=irix3-3 ;; mips-sgi-irix4* ) machine=iris4d opsys=irix4-0 ;; mips-sgi-irix6* ) machine=iris4d opsys=irix6-0 ;; mips-sgi-irix5.[01]* ) machine=iris4d opsys=irix5-0 ;; mips-sgi-irix5* | mips-sgi-irix* ) machine=iris4d opsys=irix5-2 ;; ## SONY machines m68*-sony-bsd4.2* ) machine=news opsys=bsd4-2 ;; m68*-sony-bsd4.3* ) machine=news opsys=bsd4-3 ;; m68*-sony-newsos3* | m68*-sony-news3*) machine=news opsys=bsd4-3 ;; mips-sony-bsd* | mips-sony-newsos4* | mips-sony-news4*) machine=news-risc opsys=bsd4-3 ;; mips-sony-news* ) machine=news-risc opsys=newsos5 ;; ## Stride m68*-stride-sysv* ) machine=stride opsys=usg5-2 ;; ## Suns *-sun-sunos* | *-sun-bsd* | *-sun-solaris* \ | i[345]86-*-solaris2* | i[345]86-*-sunos5* | powerpc*-*-solaris2* \ | rs6000-*-solaris2*) case "${canonical}" in m68*-sunos1* ) machine=sun1 ;; m68*-sunos2* ) machine=sun2 ;; m68* ) machine=sun3 ;; i[345]86-sun-sunos[34]* ) machine=sun386 ;; i[345]86-*-* ) machine=intel386 ;; powerpc* | rs6000* ) machine=rs6000 ;; sparc* ) machine=sparc ;; * ) unported=yes ;; esac case "${canonical}" in ## The Sun386 didn't get past 4.0. i[345]86-*-sunos4 ) opsys=sunos4-0 ;; *-sunos4.0* ) opsys=sunos4-0 ;; *-sunos4.1.[3-9]* | *-sunos4shr*) opsys=sunos4shr NON_GNU_CPP=/usr/lib/cpp ;; *-sunos4* | *-sunos ) opsys=sunos4-1 NON_GCC_TEST_OPTIONS=-Bstatic GCC_TEST_OPTIONS=-static ;; *-sunos5.3* | *-solaris2.3* ) opsys=sol2-3 NON_GNU_CPP=/usr/ccs/lib/cpp ;; *-sunos5.4* | *-solaris2.4* ) opsys=sol2-4 NON_GNU_CPP=/usr/ccs/lib/cpp RANLIB="ar -ts" ;; *-sunos5.5* | *-solaris2.5* ) opsys=sol2-5 NON_GNU_CPP=/usr/ccs/lib/cpp RANLIB="ar -ts" ;; *-sunos5* | *-solaris* ) opsys=sol2 NON_GNU_CPP=/usr/ccs/lib/cpp ;; * ) opsys=bsd4-2 ;; esac ;; sparc-*-nextstep* ) machine=sparc opsys=nextstep ;; ## Tadpole 68k m68*-tadpole-sysv* ) machine=tad68k opsys=usg5-3 ;; ## Tahoe machines tahoe-tahoe-bsd4.2* ) machine=tahoe opsys=bsd4-2 ;; tahoe-tahoe-bsd4.3* ) machine=tahoe opsys=bsd4-3 ;; ## Tandem Integrity S2 mips-tandem-sysv* ) machine=tandem-s2 opsys=usg5-3 ;; ## Tektronix XD88 m88k-tektronix-sysv3* ) machine=tekxd88 opsys=usg5-3 ;; ## Tektronix 16000 box (6130?) ns16k-tektronix-bsd* ) machine=ns16000 opsys=bsd4-2 ;; ## Tektronix 4300 ## src/m/tek4300.h hints that this is a m68k machine. m68*-tektronix-bsd* ) machine=tek4300 opsys=bsd4-3 ;; ## Titan P2 or P3 ## We seem to have lost the machine-description file titan.h! titan-titan-sysv* ) machine=titan opsys=usg5-3 ;; ## Ustation E30 (SS5E) m68*-unisys-uniplus* ) machine=ustation opsystem=unipl5-2 ;; ## Vaxen. vax-dec-* ) machine=vax case "${canonical}" in *-bsd4.1* ) opsys=bsd4-1 ;; *-bsd4.2* | *-ultrix[0-3].* | *-ultrix4.0* ) opsys=bsd4-2 ;; *-bsd4.3* | *-ultrix* ) opsys=bsd4-3 ;; *-sysv[01]* | *-sysvr[01]* ) opsys=usg5-0 ;; *-sysv2* | *-sysvr2* ) opsys=usg5-2 ;; *-vms* ) opsys=vms ;; * ) unported=yes esac ;; ## Whitechapel MG1 ns16k-whitechapel-* ) machine=mg1 ## We don't know what sort of OS runs on these; we'll let the ## operating system guessing code below try. ;; ## Wicat m68*-wicat-sysv* ) machine=wicat opsys=usg5-2 ;; ## Intel 386 machines where we don't care about the manufacturer i[345]86-*-* ) machine=intel386 case "${canonical}" in *-isc1.* | *-isc2.[01]* ) opsys=386-ix ;; *-isc2.2* ) opsys=isc2-2 ;; *-isc4.0* ) opsys=isc4-0 ;; *-isc4.* ) opsys=isc4-1 GCC_TEST_OPTIONS=-posix NON_GCC_TEST_OPTIONS=-Xp ;; *-isc* ) opsys=isc3-0 ;; *-esix5* ) opsys=esix5r4; NON_GNU_CPP=/usr/lib/cpp ;; *-esix* ) opsys=esix ;; *-xenix* ) opsys=xenix ;; *-linux* ) opsys=linux ;; *-sco3.2v4* ) opsys=sco4 ; NON_GNU_CPP=/lib/cpp ;; *-bsd386* | *-bsdi1* ) opsys=bsd386 ;; *-bsdi2* ) opsys=bsdos2 ;; *-386bsd* ) opsys=386bsd ;; *-freebsd* ) opsys=freebsd ;; *-nextstep* ) opsys=nextstep ;; ## Otherwise, we'll fall through to the generic opsys code at the bottom. esac ;; ## Linux/68k m68k-*-linux* ) machine=m68k opsys=linux ;; * ) unported=yes ;; esac ### If the code above didn't choose an operating system, just choose ### an operating system based on the configuration name. You really ### only want to use this when you have no idea what the right ### operating system is; if you know what operating systems a machine ### runs, it's cleaner to make it explicit in the case statement ### above. if test x"${opsys}" = x; then case "${canonical}" in *-gnu* ) opsys=gnu ;; *-bsd4.[01] ) opsys=bsd4-1 ;; *-bsd4.2 ) opsys=bsd4-2 ;; *-bsd4.3 ) opsys=bsd4-3 ;; *-sysv0 | *-sysvr0 ) opsys=usg5-0 ;; *-sysv2 | *-sysvr2 ) opsys=usg5-2 ;; *-sysv2.2 | *-sysvr2.2 ) opsys=usg5-2-2 ;; *-sysv3* | *-sysvr3* ) opsys=usg5-3 ;; *-sysv4.1* | *-sysvr4.1* ) NON_GNU_CPP=/usr/lib/cpp opsys=usg5-4 ;; *-sysv4.[2-9]* | *-sysvr4.[2-9]* ) if [ x$NON_GNU_CPP = x ]; then NON_GNU_CPP=/usr/ccs/lib/cpp fi opsys=usg5-4-2 ;; *-sysv4* | *-sysvr4* ) opsys=usg5-4 ;; * ) unported=yes ;; esac fi if test "x$RANLIB" = x; then RANLIB=ranlib fi if test $unported = yes; then { echo "configure: error: Emacs hasn't been ported to \`${canonical}' systems. Check \`etc/MACHINES' for recognized configuration names." 1>&2; exit 1; } fi machfile="m/${machine}.h" opsysfile="s/${opsys}.h" #### Choose a compiler. test -n "$CC" && cc_specified=yes # Save the value of CFLAGS that the user specified. SPECIFIED_CFLAGS="$CFLAGS" case ${with_gcc} in "yes" ) CC="gcc" GCC=yes ;; "no" ) : ${CC=cc} ;; * ) # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" for ac_dir in $PATH; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_CC="gcc" break fi done IFS="$ac_save_ifs" test -z "$ac_cv_prog_CC" && ac_cv_prog_CC="cc" fi fi CC="$ac_cv_prog_CC" if test -n "$CC"; then echo "$ac_t""$CC" 1>&6 else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.c <&5 | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no fi fi echo "$ac_t""$ac_cv_prog_gcc" 1>&6 if test $ac_cv_prog_gcc = yes; then GCC=yes if test "${CFLAGS+set}" != set; then echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_prog_gcc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else echo 'void f(){}' > conftest.c if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then ac_cv_prog_gcc_g=yes else ac_cv_prog_gcc_g=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_prog_gcc_g" 1>&6 if test $ac_cv_prog_gcc_g = yes; then CFLAGS="-g -O" else CFLAGS="-O" fi fi else GCC= test "${CFLAGS+set}" = set || CFLAGS="-g" fi esac # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi #### Some systems specify a CPP to use unless we are using GCC. #### Now that we know whether we are using GCC, we can decide whether #### to use that one. if test "x$NON_GNU_CPP" != x && test x$GCC != xyes && test "x$CPP" = x then CPP="$NON_GNU_CPP" fi #### Some systems specify a CC to use unless we are using GCC. #### Now that we know whether we are using GCC, we can decide whether #### to use that one. if test "x$NON_GNU_CC" != x && test x$GCC != xyes && test x$cc_specified != xyes then CC="$NON_GNU_CC" fi if test x$GCC = xyes && test "x$GCC_TEST_OPTIONS" != x then CC="$CC $GCC_TEST_OPTIONS" fi if test x$GCC = x && test "x$NON_GCC_TEST_OPTIONS" != x then CC="$CC $NON_GCC_TEST_OPTIONS" fi #### Some other nice autoconf tests. If you add a test here which #### should make an entry in src/config.h, don't forget to add an #### #undef clause to src/config.h.in for autoconf to modify. echo $ac_n "checking whether ln -s works""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_prog_LN_S'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else rm -f conftestdata if ln -s X conftestdata 2>/dev/null then rm -f conftestdata ac_cv_prog_LN_S="ln -s" else ac_cv_prog_LN_S=ln fi fi LN_S="$ac_cv_prog_LN_S" if test "$ac_cv_prog_LN_S" = "ln -s"; then echo "$ac_t""yes" 1>&6 else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else # This must be in double quotes, not single quotes, because CPP may get # substituted into the Makefile and "${CC-cc}" will confuse make. CPP="${CC-cc} -E" # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF eval "$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : else echo "$ac_err" >&5 rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF eval "$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : else echo "$ac_err" >&5 rm -rf conftest* CPP=/lib/cpp fi rm -f conftest* fi rm -f conftest* ac_cv_prog_CPP="$CPP" fi CPP="$ac_cv_prog_CPP" else ac_cv_prog_CPP="$CPP" fi echo "$ac_t""$CPP" 1>&6 # Find a good install program. We prefer a C program (faster), # so one script is as good as another. But avoid the broken or # incompatible versions: # SysV /etc/install, /usr/sbin/install # SunOS /usr/etc/install # IRIX /sbin/install # AIX /bin/install # AFS /usr/afsws/bin/install, which mishandles nonexistent args # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # ./install, which can be erroneously created by make from ./install.sh. echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 if test -z "$INSTALL"; then if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" for ac_dir in $PATH; do # Account for people who put trailing slashes in PATH elements. case "$ac_dir/" in /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;; *) # OSF1 and SCO ODT 3.0 have their own names for install. for ac_prog in ginstall installbsd scoinst install; do if test -f $ac_dir/$ac_prog; then if test $ac_prog = install && grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then # AIX install. It has an incompatible calling convention. # OSF/1 installbsd also uses dspmsg, but is usable. : else ac_cv_path_install="$ac_dir/$ac_prog -c" break 2 fi fi done ;; esac done IFS="$ac_save_ifs" fi if test "${ac_cv_path_install+set}" = set; then INSTALL="$ac_cv_path_install" else # As a last resort, use the slow shell script. We don't cache a # path for INSTALL within a source directory, because that will # break other packages using the cache if that directory is # removed, or if the path is relative. INSTALL="$ac_install_sh" fi fi echo "$ac_t""$INSTALL" 1>&6 # Use test -z because SunOS4 sh mishandles braces in ${var-val}. # It thinks the first close brace ends the variable substitution. test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' for ac_prog in 'bison -y' byacc do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_prog_YACC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$YACC"; then ac_cv_prog_YACC="$YACC" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" for ac_dir in $PATH; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_YACC="$ac_prog" break fi done IFS="$ac_save_ifs" fi fi YACC="$ac_cv_prog_YACC" if test -n "$YACC"; then echo "$ac_t""$YACC" 1>&6 else echo "$ac_t""no" 1>&6 fi test -n "$YACC" && break done test -n "$YACC" || YACC="yacc" echo $ac_n "checking for AIX""... $ac_c" 1>&6 cat > conftest.$ac_ext <&5 | egrep "yes" >/dev/null 2>&1; then rm -rf conftest* echo "$ac_t""yes" 1>&6; cat >> confdefs.h <<\EOF #define _ALL_SOURCE 1 EOF else rm -rf conftest* echo "$ac_t""no" 1>&6 fi rm -f conftest* for ac_hdr in sys/select.h sys/timeb.h sys/time.h unistd.h utime.h do ac_safe=`echo "$ac_hdr" | tr './\055' '___'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF eval "$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 rm -rf conftest* eval "ac_cv_header_$ac_safe=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then echo "$ac_t""yes" 1>&6 ac_tr_hdr=HAVE_`echo $ac_hdr | tr 'abcdefghijklmnopqrstuvwxyz./\055' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ___'` cat >> confdefs.h <&6 fi done # If we cannot run a trivial program, we must be cross compiling. echo $ac_n "checking whether cross-compiling""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_c_cross'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test "$cross_compiling" = yes; then ac_cv_c_cross=yes else cat > conftest.$ac_ext </dev/null; then ac_cv_c_cross=no else ac_cv_c_cross=yes fi fi rm -fr conftest* fi echo "$ac_t""$ac_cv_c_cross" 1>&6 cross_compiling=$ac_cv_c_cross echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include #include #include EOF eval "$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* ac_cv_header_stdc=yes else echo "$ac_err" >&5 rm -rf conftest* ac_cv_header_stdc=no fi rm -f conftest* if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | egrep "memchr" >/dev/null 2>&1; then : else rm -rf conftest* ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | egrep "free" >/dev/null 2>&1; then : else rm -rf conftest* ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then ac_cv_header_stdc=no else cat > conftest.$ac_ext < #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') #define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } EOF eval $ac_link if test -s conftest && (./conftest; exit) 2>/dev/null; then : else ac_cv_header_stdc=no fi fi rm -fr conftest* fi fi echo "$ac_t""$ac_cv_header_stdc" 1>&6 if test $ac_cv_header_stdc = yes; then cat >> confdefs.h <<\EOF #define STDC_HEADERS 1 EOF fi echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include #include int main() { return 0; } int t() { struct tm *tp; ; return 0; } EOF if eval $ac_compile; then rm -rf conftest* ac_cv_header_time=yes else rm -rf conftest* ac_cv_header_time=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_header_time" 1>&6 if test $ac_cv_header_time = yes; then cat >> confdefs.h <<\EOF #define TIME_WITH_SYS_TIME 1 EOF fi echo $ac_n "checking for sys_siglist declaration in signal.h or unistd.h""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_decl_sys_siglist'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include /* NetBSD declares sys_siglist in unistd.h. */ #ifdef HAVE_UNISTD_H #include #endif int main() { return 0; } int t() { char *msg = *(sys_siglist + 1); ; return 0; } EOF if eval $ac_compile; then rm -rf conftest* ac_cv_decl_sys_siglist=yes else rm -rf conftest* ac_cv_decl_sys_siglist=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_decl_sys_siglist" 1>&6 if test $ac_cv_decl_sys_siglist = yes; then cat >> confdefs.h <<\EOF #define SYS_SIGLIST_DECLARED 1 EOF fi echo $ac_n "checking for struct utimbuf""... $ac_c" 1>&6 cat > conftest.$ac_ext < #include #else #ifdef HAVE_SYS_TIME_H #include #else #include #endif #endif #ifdef HAVE_UTIME_H #include #endif int main() { return 0; } int t() { static struct utimbuf x; x.actime = x.modtime; ; return 0; } EOF if eval $ac_compile; then rm -rf conftest* echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_STRUCT_UTIMBUF 1 EOF else rm -rf conftest* echo "$ac_t""no" 1>&6 fi rm -f conftest* echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include #ifdef signal #undef signal #endif #ifdef __cplusplus extern "C" #endif void (*signal ()) (); int main() { return 0; } int t() { int i; ; return 0; } EOF if eval $ac_compile; then rm -rf conftest* ac_cv_type_signal=void else rm -rf conftest* ac_cv_type_signal=int fi rm -f conftest* fi echo "$ac_t""$ac_cv_type_signal" 1>&6 cat >> confdefs.h <&6 cat > conftest.$ac_ext < #include #else #ifdef HAVE_SYS_TIME_H #include #else #include #endif #endif int main() { return 0; } int t() { static struct timeval x; x.tv_sec = x.tv_usec; ; return 0; } EOF if eval $ac_compile; then rm -rf conftest* echo "$ac_t""yes" 1>&6 HAVE_TIMEVAL=yes cat >> confdefs.h <<\EOF #define HAVE_TIMEVAL 1 EOF else rm -rf conftest* echo "$ac_t""no" 1>&6 fi rm -f conftest* echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include int main() { return 0; } int t() { struct tm *tp; tp->tm_sec; ; return 0; } EOF if eval $ac_compile; then rm -rf conftest* ac_cv_struct_tm=time.h else rm -rf conftest* ac_cv_struct_tm=sys/time.h fi rm -f conftest* fi echo "$ac_t""$ac_cv_struct_tm" 1>&6 if test $ac_cv_struct_tm = sys/time.h; then cat >> confdefs.h <<\EOF #define TM_IN_SYS_TIME 1 EOF fi echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_struct_tm_zone'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include <$ac_cv_struct_tm> int main() { return 0; } int t() { struct tm tm; tm.tm_zone; ; return 0; } EOF if eval $ac_compile; then rm -rf conftest* ac_cv_struct_tm_zone=yes else rm -rf conftest* ac_cv_struct_tm_zone=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_struct_tm_zone" 1>&6 if test "$ac_cv_struct_tm_zone" = yes; then cat >> confdefs.h <<\EOF #define HAVE_TM_ZONE 1 EOF else echo $ac_n "checking for tzname""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_var_tzname'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #ifndef tzname /* For SGI. */ extern char *tzname[]; /* RS6000 and others reject char **tzname. */ #endif int main() { return 0; } int t() { atoi(*tzname); ; return 0; } EOF if eval $ac_link; then rm -rf conftest* ac_cv_var_tzname=yes else rm -rf conftest* ac_cv_var_tzname=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_var_tzname" 1>&6 if test $ac_cv_var_tzname = yes; then cat >> confdefs.h <<\EOF #define HAVE_TZNAME 1 EOF fi fi echo $ac_n "checking for working const""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <j = 5; } { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ const int foo = 10; } ; return 0; } EOF if eval $ac_compile; then rm -rf conftest* ac_cv_c_const=yes else rm -rf conftest* ac_cv_c_const=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_c_const" 1>&6 if test $ac_cv_c_const = no; then cat >> confdefs.h <<\EOF #define const EOF fi echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 set dummy ${MAKE-make}; ac_make=$2 if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftestmake <<\EOF all: @echo 'ac_maketemp="${MAKE}"' EOF # GNU make sometimes prints "make[1]: Entering...", which would confuse us. eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=` if test -n "$ac_maketemp"; then eval ac_cv_prog_make_${ac_make}_set=yes else eval ac_cv_prog_make_${ac_make}_set=no fi rm -f conftestmake fi if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then echo "$ac_t""yes" 1>&6 SET_MAKE= else echo "$ac_t""no" 1>&6 SET_MAKE="MAKE=${MAKE-make}" fi echo $ac_n "checking for long file names""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_sys_long_file_names'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_cv_sys_long_file_names=yes # Test for long file names in all the places we know might matter: # . the current directory, where building will happen # /tmp where it might want to write temporary files # /var/tmp likewise # /usr/tmp likewise # $prefix/lib where we will be installing things # $exec_prefix/lib likewise # eval it to expand exec_prefix. for ac_dir in `eval echo . /tmp /var/tmp /usr/tmp $prefix/lib $exec_prefix/lib` ; do test -d $ac_dir || continue test -w $ac_dir || continue # It is less confusing to not echo anything here. (echo 1 > $ac_dir/conftest9012345) 2>/dev/null (echo 2 > $ac_dir/conftest9012346) 2>/dev/null val=`cat $ac_dir/conftest9012345 2>/dev/null` if test ! -f $ac_dir/conftest9012345 || test "$val" != 1; then ac_cv_sys_long_file_names=no rm -f $ac_dir/conftest9012345 $ac_dir/conftest9012346 2>/dev/null break fi rm -f $ac_dir/conftest9012345 $ac_dir/conftest9012346 2>/dev/null done fi echo "$ac_t""$ac_cv_sys_long_file_names" 1>&6 if test $ac_cv_sys_long_file_names = yes; then cat >> confdefs.h <<\EOF #define HAVE_LONG_FILE_NAMES 1 EOF fi #### Choose a window system. # If we find X, set shell vars x_includes and x_libraries to the # paths, otherwise set no_x=yes. # Uses ac_ vars as temps to allow command line to override cache and checks. # --without-x overrides everything else, but does not touch the cache. echo $ac_n "checking for X""... $ac_c" 1>&6 # Check whether --with-x or --without-x was given. if test "${with_x+set}" = set; then withval="$with_x" : fi if test "x$with_x" = xno; then no_x=yes else if test "x$x_includes" != xNONE && test "x$x_libraries" != xNONE; then no_x= else if eval "test \"`echo '$''{'ac_cv_path_x'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else # One or both of the vars are not set, and there is no cached value. no_x=yes rm -fr conftestdir if mkdir conftestdir; then cd conftestdir # Make sure to not put "make" in the Imakefile rules, since we grep it out. cat > Imakefile <<'EOF' acfindx: @echo 'ac_im_incroot="${INCROOT}"; ac_im_usrlibdir="${USRLIBDIR}"; ac_im_libdir="${LIBDIR}"' EOF if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then no_x= # GNU make sometimes prints "make[1]: Entering...", which would confuse us. eval `make acfindx 2>/dev/null | grep -v make` # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR. for ac_extension in a so sl; do if test ! -f $ac_im_usrlibdir/libX11.$ac_extension && test -f $ac_im_libdir/libX11.$ac_extension; then ac_im_usrlibdir=$ac_im_libdir; break fi done # Screen out bogus values from the imake configuration. case "$ac_im_incroot" in /usr/include) ;; *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes="$ac_im_incroot" ;; esac case "$ac_im_usrlibdir" in /usr/lib | /lib) ;; *) test -d "$ac_im_usrlibdir" && ac_x_libraries="$ac_im_usrlibdir" ;; esac fi cd .. rm -fr conftestdir fi if test "$no_x" = yes; then test -z "$x_direct_test_library" && x_direct_test_library=Xt test -z "$x_direct_test_function" && x_direct_test_function=XtMalloc test -z "$x_direct_test_include" && x_direct_test_include=X11/Intrinsic.h cat > conftest.$ac_ext < EOF eval "$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* no_x= ac_x_includes= else echo "$ac_err" >&5 rm -rf conftest* for ac_dir in \ /usr/X11R6/include \ /usr/X11R5/include \ /usr/X11R4/include \ \ /usr/include/X11R6 \ /usr/include/X11R5 \ /usr/include/X11R4 \ \ /usr/local/X11R6/include \ /usr/local/X11R5/include \ /usr/local/X11R4/include \ \ /usr/local/include/X11R6 \ /usr/local/include/X11R5 \ /usr/local/include/X11R4 \ \ /usr/X11/include \ /usr/include/X11 \ /usr/local/X11/include \ /usr/local/include/X11 \ \ /usr/X386/include \ /usr/x386/include \ /usr/XFree86/include/X11 \ \ /usr/include \ /usr/local/include \ /usr/unsupported/include \ /usr/athena/include \ /usr/local/x11r5/include \ /usr/lpp/Xamples/include \ \ /usr/openwin/include \ /usr/openwin/share/include \ ; \ do if test -r "$ac_dir/$x_direct_test_include"; then no_x= ac_x_includes=$ac_dir break fi done fi rm -f conftest* # Check for the libraries. # See if we find them without any special options. # Don't add to $LIBS permanently. ac_save_LIBS="$LIBS" LIBS="-l$x_direct_test_library $LIBS" cat > conftest.$ac_ext <&6 else test "x$x_includes" = xNONE && x_includes=$ac_x_includes test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries ac_cv_path_x="no_x= ac_x_includes=$x_includes ac_x_libraries=$x_libraries" echo "$ac_t""libraries $x_libraries, headers $x_includes" 1>&6 fi if test "$no_x" = yes; then window_system=none else window_system=x11 fi if test "${x_libraries}" != NONE && test -n "${x_libraries}"; then LD_SWITCH_X_SITE=-L`echo ${x_libraries} | sed -e "s/:/ -L/g"` LD_SWITCH_X_SITE_AUX=-R`echo ${x_libraries} | sed -e "s/:/ -R/g"` fi if test "${x_includes}" != NONE && test -n "${x_includes}"; then C_SWITCH_X_SITE=-I`echo ${x_includes} | sed -e "s/:/ -I/g"` fi if test x"${x_includes}" = x; then bitmapdir=/usr/include/X11/bitmaps else # accumulate include directories that have X11 bitmap sudirectories bmd_acc="dummyval" for bmd in `echo ${x_includes} | sed -e "s/:/ /g"`; do if test -d "${bmd}/X11/bitmaps"; then bmd_acc="${bmd_acc}:${bmd}/X11/bitmaps" elif test -d "${bmd}/bitmaps"; then bmd_acc="${bmd_acc}:${bmd}/bitmaps" fi done if test ${bmd_acc} != "dummyval"; then bitmapdir=`echo ${bmd_acc} | sed -e "s/^dummyval://"` fi fi case "${window_system}" in x11 ) HAVE_X_WINDOWS=yes HAVE_X11=yes case "${with_x_toolkit}" in athena | lucid ) USE_X_TOOLKIT=LUCID ;; motif ) USE_X_TOOLKIT=MOTIF ;; * ) USE_X_TOOLKIT=none ;; esac ;; none ) HAVE_X_WINDOWS=no HAVE_X11=no USE_X_TOOLKIT=none ;; esac X_TOOLKIT_TYPE=$USE_X_TOOLKIT ### If we're using X11, we should use the X menu package. HAVE_X_MENU=no case ${HAVE_X11} in yes ) HAVE_X_MENU=yes ;; esac if test "${opsys}" = "hpux9"; then case "${x_libraries}" in *X11R4* ) opsysfile="s/hpux9-x11r4.h" ;; esac fi if test "${opsys}" = "hpux9shr"; then case "${x_libraries}" in *X11R4* ) opsysfile="s/hpux9shxr4.h" ;; esac fi #### Extract some information from the operating system and machine files. echo "checking the machine- and system-dependent files to find out - which libraries the lib-src programs will want, and - whether the GNU malloc routines are usable" 1>&6 ### First figure out CFLAGS (which we use for running the compiler here) ### and REAL_CFLAGS (which we use for real compilation). ### The two are the same except on a few systems, where they are made ### different to work around various lossages. For example, ### GCC 2.5 on Linux needs them to be different because it treats -g ### as implying static linking. ### If the CFLAGS env var is specified, we use that value ### instead of the default. ### It's not important that this name contain the PID; you can't run ### two configures in the same directory and have anything work ### anyway. tempcname="conftest.c" echo ' #include "'${srcdir}'/src/'${opsysfile}'" #include "'${srcdir}'/src/'${machfile}'" #ifndef LIBS_MACHINE #define LIBS_MACHINE #endif #ifndef LIBS_SYSTEM #define LIBS_SYSTEM #endif #ifndef C_SWITCH_SYSTEM #define C_SWITCH_SYSTEM #endif #ifndef C_SWITCH_MACHINE #define C_SWITCH_MACHINE #endif configure___ libsrc_libs=LIBS_MACHINE LIBS_SYSTEM configure___ c_switch_system=C_SWITCH_SYSTEM configure___ c_switch_machine=C_SWITCH_MACHINE #ifndef LIB_X11_LIB #define LIB_X11_LIB -lX11 #endif #ifndef LIBX11_MACHINE #define LIBX11_MACHINE #endif #ifndef LIBX11_SYSTEM #define LIBX11_SYSTEM #endif configure___ LIBX=LIB_X11_LIB LIBX11_MACHINE LIBX11_SYSTEM #ifdef UNEXEC configure___ unexec=UNEXEC #else configure___ unexec=unexec.o #endif #ifdef SYSTEM_MALLOC configure___ system_malloc=yes #else configure___ system_malloc=no #endif #ifndef C_DEBUG_SWITCH #define C_DEBUG_SWITCH -g #endif #ifndef C_OPTIMIZE_SWITCH #define C_OPTIMIZE_SWITCH -O #endif #ifdef THIS_IS_CONFIGURE /* Get the CFLAGS for tests in configure. */ #ifdef __GNUC__ configure___ CFLAGS=C_DEBUG_SWITCH C_OPTIMIZE_SWITCH '${SPECIFIED_CFLAGS}' #else configure___ CFLAGS=C_DEBUG_SWITCH '${SPECIFIED_CFLAGS}' #endif #else /* not THIS_IS_CONFIGURE */ /* Get the CFLAGS for real compilation. */ #ifdef __GNUC__ configure___ REAL_CFLAGS=C_DEBUG_SWITCH C_OPTIMIZE_SWITCH '${SPECIFIED_CFLAGS}' #else configure___ REAL_CFLAGS=C_DEBUG_SWITCH '${SPECIFIED_CFLAGS}' #endif #endif /* not THIS_IS_CONFIGURE */ ' > ${tempcname} # The value of CPP is a quoted variable reference, so we need to do this # to get its actual value... CPP=`eval "echo $CPP"` eval `${CPP} -Isrc ${tempcname} \ | sed -n -e 's/^configure___ \([^=]*=\)\(.*\)$/\1"\2"/p'` if test "x$SPECIFIED_CFLAGS" = x; then eval `${CPP} -Isrc -DTHIS_IS_CONFIGURE ${tempcname} \ | sed -n -e 's/^configure___ \([^=]*=\)\(.*\)$/\1"\2"/p'` else REAL_CFLAGS="$CFLAGS" fi rm ${tempcname} ### Compute the unexec source name from the object name. UNEXEC_SRC="`echo ${unexec} | sed 's/\.o/.c/'`" # Do the opsystem or machine files prohibit the use of the GNU malloc? # Assume not, until told otherwise. GNU_MALLOC=yes if test "${system_malloc}" = "yes"; then GNU_MALLOC=no GNU_MALLOC_reason=" (The GNU allocators don't work with this system configuration.)" fi if test x"${REL_ALLOC}" = x; then REL_ALLOC=${GNU_MALLOC} fi LISP_FLOAT_TYPE=yes #### Add the libraries to LIBS and check for some functions. CPPFLAGS="$c_switch_system $c_switch_machine $CPPFLAGS" LIBS="$libsrc_libs $LIBS" echo $ac_n "checking for -ldnet""... $ac_c" 1>&6 ac_lib_var=`echo dnet | tr './+' '__p'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-ldnet $LIBS" cat > conftest.$ac_ext <&6 ac_tr_lib=HAVE_LIB`echo dnet | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` cat >> confdefs.h <&6 fi echo $ac_n "checking for -lXbsd""... $ac_c" 1>&6 ac_lib_var=`echo Xbsd | tr './+' '__p'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-lXbsd $LIBS" cat > conftest.$ac_ext <&6 LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -lXbsd" else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking for -lpthreads""... $ac_c" 1>&6 ac_lib_var=`echo pthreads | tr './+' '__p'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-lpthreads $LIBS" cat > conftest.$ac_ext <&6 ac_tr_lib=HAVE_LIB`echo pthreads | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` cat >> confdefs.h <&6 fi echo $ac_n "checking for XFree86""... $ac_c" 1>&6 if test -d /usr/X386/include; then HAVE_XFREE386=yes : ${C_SWITCH_X_SITE="-I/usr/X386/include"} else HAVE_XFREE386=no fi echo "$ac_t""$HAVE_XFREE386" 1>&6 # Change CFLAGS temporarily so that C_SWITCH_X_SITE gets used # for the tests that follow. We set it back to REAL_CFLAGS later on. if test "${HAVE_X11}" = "yes"; then DEFS="$C_SWITCH_X_SITE $DEFS" LIBS="$LD_SWITCH_X_SITE $LIBX $LIBS" CFLAGS="$C_SWITCH_X_SITE $CFLAGS" if test "${opsys}" = "linux"; then echo $ac_n "checking whether X on GNU/Linux needs -b to link""... $ac_c" 1>&6 cat > conftest.$ac_ext < conftest.$ac_ext <&6 else echo "$ac_t""yes" 1>&6 fi else echo "$ac_t""no" 1>&6 fi fi for ac_func in XrmSetDatabase XScreenResourceString \ XScreenNumberOfScreen XSetWMProtocols do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ char $ac_func(); int main() { return 0; } int t() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else $ac_func(); #endif ; return 0; } EOF if eval $ac_link; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else rm -rf conftest* eval "ac_cv_func_$ac_func=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then echo "$ac_t""yes" 1>&6 ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` cat >> confdefs.h <&6 fi done fi if test "${USE_X_TOOLKIT}" != "none"; then echo $ac_n "checking X11 toolkit version""... $ac_c" 1>&6 cat > conftest.$ac_ext < int main() { return 0; } int t() { #if XtSpecificationRelease < 6 fail; #endif ; return 0; } EOF if eval $ac_link; then rm -rf conftest* echo "$ac_t""6" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_X11XTR6 1 EOF else rm -rf conftest* echo "$ac_t""not 6" 1>&6 fi rm -f conftest* fi # If netdb.h doesn't declare h_errno, we must declare it by hand. echo $ac_n "checking whether netdb declares h_errno""... $ac_c" 1>&6 cat > conftest.$ac_ext < int main() { return 0; } int t() { return h_errno; ; return 0; } EOF if eval $ac_link; then rm -rf conftest* echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_H_ERRNO 1 EOF else rm -rf conftest* echo "$ac_t""no" 1>&6 fi rm -f conftest* # The Ultrix 4.2 mips builtin alloca declared by alloca.h only works # for constant arguments. Useless! echo $ac_n "checking for working alloca.h""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_header_alloca_h'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < int main() { return 0; } int t() { char *p = alloca(2 * sizeof(int)); ; return 0; } EOF if eval $ac_link; then rm -rf conftest* ac_cv_header_alloca_h=yes else rm -rf conftest* ac_cv_header_alloca_h=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_header_alloca_h" 1>&6 if test $ac_cv_header_alloca_h = yes; then cat >> confdefs.h <<\EOF #define HAVE_ALLOCA_H 1 EOF fi echo $ac_n "checking for alloca""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_func_alloca'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < # else # ifdef _AIX #pragma alloca # else # ifndef alloca /* predefined by HP cc +Olibcalls */ char *alloca (); # endif # endif # endif #endif int main() { return 0; } int t() { char *p = (char *) alloca(1); ; return 0; } EOF if eval $ac_link; then rm -rf conftest* ac_cv_func_alloca=yes else rm -rf conftest* ac_cv_func_alloca=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_func_alloca" 1>&6 if test $ac_cv_func_alloca = yes; then cat >> confdefs.h <<\EOF #define HAVE_ALLOCA 1 EOF fi if test $ac_cv_func_alloca = no; then # The SVR3 libPW and SVR4 libucb both contain incompatible functions # that cause trouble. Some versions do not even contain alloca or # contain a buggy version. If you still want to use their alloca, # use ar to extract alloca.o from them instead of compiling alloca.c. ALLOCA=alloca.o cat >> confdefs.h <<\EOF #define C_ALLOCA 1 EOF echo $ac_n "checking whether alloca needs Cray hooks""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_os_cray'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5 | egrep "webecray" >/dev/null 2>&1; then rm -rf conftest* ac_cv_os_cray=yes else rm -rf conftest* ac_cv_os_cray=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_os_cray" 1>&6 if test $ac_cv_os_cray = yes; then for ac_func in _getb67 GETB67 getb67; do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ char $ac_func(); int main() { return 0; } int t() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else $ac_func(); #endif ; return 0; } EOF if eval $ac_link; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else rm -rf conftest* eval "ac_cv_func_$ac_func=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <&6 fi done fi echo $ac_n "checking stack direction for C alloca""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_c_stack_direction'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test "$cross_compiling" = yes; then ac_cv_c_stack_direction=0 else cat > conftest.$ac_ext < addr) ? 1 : -1; } main () { exit (find_stack_direction() < 0); } EOF eval $ac_link if test -s conftest && (./conftest; exit) 2>/dev/null; then ac_cv_c_stack_direction=1 else ac_cv_c_stack_direction=-1 fi fi rm -fr conftest* fi echo "$ac_t""$ac_cv_c_stack_direction" 1>&6 cat >> confdefs.h <&6 ac_lib_var=`echo m | tr './+' '__p'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-lm $LIBS" cat > conftest.$ac_ext <&6 ac_tr_lib=HAVE_LIB`echo m | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` cat >> confdefs.h <&6 fi for ac_func in gettimeofday gethostname dup2 rename closedir mkdir rmdir \ random lrand48 bcopy bcmp logb frexp fmod ftime res_init setsid \ strerror fpathconf select mktime eaccess getpagesize tzset do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ char $ac_func(); int main() { return 0; } int t() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else $ac_func(); #endif ; return 0; } EOF if eval $ac_link; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else rm -rf conftest* eval "ac_cv_func_$ac_func=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then echo "$ac_t""yes" 1>&6 ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` cat >> confdefs.h <&6 fi done echo $ac_n "checking whether localtime caches TZ""... $ac_c" 1>&6 if eval "test \"`echo '$''{'emacs_cv_localtime_cache'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test $ac_cv_func_tzset = yes; then if test "$cross_compiling" = yes; then # If we have tzset, assume the worst when cross-compiling. emacs_cv_localtime_cache=yes else cat > conftest.$ac_ext < #if STDC_HEADERS # include #endif main() { time_t now = time ((time_t *) 0); int hour; if (putenv ("TZ=GMT0") != 0) exit (1); hour = localtime (&now)->tm_hour; if (putenv ("TZ=PST8") != 0) exit (1); exit (localtime (&now)->tm_hour == hour); } EOF eval $ac_link if test -s conftest && (./conftest; exit) 2>/dev/null; then emacs_cv_localtime_cache=no else emacs_cv_localtime_cache=yes fi fi rm -fr conftest* else # If we lack tzset, report that localtime does not cache TZ, # since we can't invalidate the cache if we don't have tzset. emacs_cv_localtime_cache=no fi fi echo "$ac_t""$emacs_cv_localtime_cache" 1>&6 if test $emacs_cv_localtime_cache = yes; then cat >> confdefs.h <<\EOF #define LOCALTIME_CACHE 1 EOF fi if test $HAVE_TIMEVAL = yes; then echo $ac_n "checking whether gettimeofday can't accept two arguments""... $ac_c" 1>&6 cat > conftest.$ac_ext < #include #else #ifdef HAVE_SYS_TIME_H #include #else #include #endif #endif int main() { return 0; } int t() { struct timeval time; struct timezone dummy; gettimeofday (&time, &dummy); ; return 0; } EOF if eval $ac_link; then rm -rf conftest* echo "$ac_t""no" 1>&6 else rm -rf conftest* echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define GETTIMEOFDAY_ONE_ARGUMENT 1 EOF fi rm -f conftest* fi ok_so_far=yes echo $ac_n "checking for socket""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_func_socket'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ char socket(); int main() { return 0; } int t() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_socket) || defined (__stub___socket) choke me #else socket(); #endif ; return 0; } EOF if eval $ac_link; then rm -rf conftest* eval "ac_cv_func_socket=yes" else rm -rf conftest* eval "ac_cv_func_socket=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_func_'socket`\" = yes"; then echo "$ac_t""yes" 1>&6 : else echo "$ac_t""no" 1>&6 ok_so_far=no fi if test $ok_so_far = yes; then ac_safe=`echo "netinet/in.h" | tr './\055' '___'` echo $ac_n "checking for netinet/in.h""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF eval "$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 rm -rf conftest* eval "ac_cv_header_$ac_safe=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then echo "$ac_t""yes" 1>&6 : else echo "$ac_t""no" 1>&6 ok_so_far=no fi fi if test $ok_so_far = yes; then ac_safe=`echo "arpa/inet.h" | tr './\055' '___'` echo $ac_n "checking for arpa/inet.h""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF eval "$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 rm -rf conftest* eval "ac_cv_header_$ac_safe=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then echo "$ac_t""yes" 1>&6 : else echo "$ac_t""no" 1>&6 ok_so_far=no fi fi if test $ok_so_far = yes; then cat >> confdefs.h <<\EOF #define HAVE_INET_SOCKETS 1 EOF fi if test -f /usr/lpp/X11/bin/smt.exp; then cat >> confdefs.h <<\EOF #define HAVE_AIX_SMT_EXP 1 EOF fi # Set up the CFLAGS for real compilation, so we can substitute it. CFLAGS="$REAL_CFLAGS" #### Find out which version of Emacs this is. version=`grep 'defconst[ ]*emacs-version' ${srcdir}/lisp/version.el \ | sed -e 's/^[^"]*"\([^"]*\)".*$/\1/'` if test x"${version}" = x; then { echo "configure: error: can't find current emacs version in \`${srcdir}/lisp/version.el'." 1>&2; exit 1; } fi ### Specify what sort of things we'll be editing into Makefile and config.h. ### Use configuration here uncanonicalized to avoid exceeding size limits. cat >> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <<\EOF #define HAVE_X_WINDOWS 1 EOF fi if test "${USE_X_TOOLKIT}" != "none" ; then cat >> confdefs.h <<\EOF #define USE_X_TOOLKIT 1 EOF fi if test "${HAVE_X11}" = "yes" ; then cat >> confdefs.h <<\EOF #define HAVE_X11 1 EOF fi if test "${HAVE_XFREE386}" = "yes" ; then cat >> confdefs.h <<\EOF #define HAVE_XFREE386 1 EOF fi if test "${HAVE_X_MENU}" = "yes" ; then cat >> confdefs.h <<\EOF #define HAVE_X_MENU 1 EOF fi if test "${GNU_MALLOC}" = "yes" ; then cat >> confdefs.h <<\EOF #define GNU_MALLOC 1 EOF fi if test "${REL_ALLOC}" = "yes" ; then cat >> confdefs.h <<\EOF #define REL_ALLOC 1 EOF fi if test "${LISP_FLOAT_TYPE}" = "yes" ; then cat >> confdefs.h <<\EOF #define LISP_FLOAT_TYPE 1 EOF fi #### Report on what we decided to do. echo " Configured for \`${canonical}'. Where should the build process find the source code? ${srcdir} What operating system and machine description files should Emacs use? \`${opsysfile}' and \`${machfile}' What compiler should emacs be built with? ${CC} ${CFLAGS} Should Emacs use the GNU version of malloc? ${GNU_MALLOC}${GNU_MALLOC_reason} Should Emacs use the relocating allocator for buffers? ${REL_ALLOC} What window system should Emacs use? ${window_system} What toolkit should Emacs use? ${USE_X_TOOLKIT}" if test -n "${x_includes}"; then echo " Where do we find X Windows header files? ${x_includes}" else echo " Where do we find X Windows header files? Standard dirs" fi if test -n "${x_libraries}"; then echo " Where do we find X Windows libraries? ${x_libraries}" else echo " Where do we find X Windows libraries? Standard dirs" fi echo # Remove any trailing slashes in these variables. test "${prefix}" != NONE && prefix=`echo "${prefix}" | sed 's,\([^/]\)/*$,\1,'` test "${exec_prefix}" != NONE && exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'` trap '' 1 2 15 cat > confcache <<\EOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs. It is not useful on other systems. # If it contains results you don't want to keep, you may remove or edit it. # # By default, configure uses ./config.cache as the cache file, # creating it if it does not exist already. You can give configure # the --cache-file=FILE option to use a different cache file; that is # what configure does when it calls configure scripts in # subdirectories, so they share the cache. # Giving --cache-file=/dev/null disables caching, for debugging configure. # config.status only pays attention to the cache file if you give it the # --recheck option to rerun configure. # EOF # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. (set) 2>&1 | sed -n "s/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=\${\1='\2'}/p" \ >> confcache if cmp -s $cache_file confcache; then : else if test -w $cache_file; then echo "updating cache $cache_file" cat confcache > $cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # Any assignment to VPATH causes Sun make to only execute # the first set of double-colon rules, so remove it if not needed. # If there is a colon in the path, we need to keep it. if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' fi trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 DEFS=-DHAVE_CONFIG_H # Without the "./", some shells look in PATH for config.status. : ${CONFIG_STATUS=./config.status} echo creating $CONFIG_STATUS rm -f $CONFIG_STATUS cat > $CONFIG_STATUS </dev/null | sed 1q`: # # $0 $ac_configure_args # # Compiler output produced by configure, useful for debugging # configure, is in ./config.log if it exists. ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" for ac_option do case "\$ac_option" in -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) echo "$CONFIG_STATUS generated by autoconf version 2.5" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; *) echo "\$ac_cs_usage"; exit 1 ;; esac done ac_given_srcdir=$srcdir ac_given_INSTALL="$INSTALL" trap 'rm -fr `echo "Makefile lib-src/Makefile.c:lib-src/Makefile.in oldXMenu/Makefile \ man/Makefile lwlib/Makefile src/Makefile.c:src/Makefile.in src/config.h:src/config.in" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 # Protect against being on the right side of a sed subst in config.status. sed 's/%@/@@/; s/@%/@@/; s/%g$/@g/; /@g$/s/[\\\\&%]/\\\\&/g; s/@@/%@/; s/@@/@%/; s/@g$/%g/' > conftest.subs <<\CEOF $ac_vpsub $extrasub s%@CFLAGS@%$CFLAGS%g s%@CPPFLAGS@%$CPPFLAGS%g s%@CXXFLAGS@%$CXXFLAGS%g s%@DEFS@%$DEFS%g s%@LDFLAGS@%$LDFLAGS%g s%@LIBS@%$LIBS%g s%@exec_prefix@%$exec_prefix%g s%@prefix@%$prefix%g s%@program_transform_name@%$program_transform_name%g s%@bindir@%$bindir%g s%@sbindir@%$sbindir%g s%@libexecdir@%$libexecdir%g s%@datadir@%$datadir%g s%@sysconfdir@%$sysconfdir%g s%@sharedstatedir@%$sharedstatedir%g s%@localstatedir@%$localstatedir%g s%@libdir@%$libdir%g s%@includedir@%$includedir%g s%@oldincludedir@%$oldincludedir%g s%@infodir@%$infodir%g s%@mandir@%$mandir%g s%@host@%$host%g s%@host_alias@%$host_alias%g s%@host_cpu@%$host_cpu%g s%@host_vendor@%$host_vendor%g s%@host_os@%$host_os%g s%@CC@%$CC%g s%@LN_S@%$LN_S%g s%@CPP@%$CPP%g s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g s%@INSTALL_DATA@%$INSTALL_DATA%g s%@YACC@%$YACC%g s%@SET_MAKE@%$SET_MAKE%g s%@ALLOCA@%$ALLOCA%g s%@version@%$version%g s%@configuration@%$configuration%g s%@canonical@%$canonical%g s%@srcdir@%$srcdir%g s%@lispdir@%$lispdir%g s%@locallisppath@%$locallisppath%g s%@lisppath@%$lisppath%g s%@etcdir@%$etcdir%g s%@lockdir@%$lockdir%g s%@archlibdir@%$archlibdir%g s%@docdir@%$docdir%g s%@bitmapdir@%$bitmapdir%g s%@c_switch_system@%$c_switch_system%g s%@c_switch_machine@%$c_switch_machine%g s%@LD_SWITCH_X_SITE@%$LD_SWITCH_X_SITE%g s%@LD_SWITCH_X_SITE_AUX@%$LD_SWITCH_X_SITE_AUX%g s%@C_SWITCH_X_SITE@%$C_SWITCH_X_SITE%g s%@X_TOOLKIT_TYPE@%$X_TOOLKIT_TYPE%g s%@machfile@%$machfile%g s%@opsysfile@%$opsysfile%g s%@RANLIB@%$RANLIB%g CEOF EOF cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then # Support "outfile[:infile]", defaulting infile="outfile.in". case "$ac_file" in *:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'` ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; *) ac_file_in="${ac_file}.in" ;; esac # Adjust relative srcdir, etc. for subdirectories. # Remove last slash and all that follows it. Not all systems have dirname. ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then # The file is in a subdirectory. test ! -d "$ac_dir" && mkdir "$ac_dir" ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" # A "../" for each directory in $ac_dir_suffix. ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` else ac_dir_suffix= ac_dots= fi case "$ac_given_srcdir" in .) srcdir=. if test -z "$ac_dots"; then top_srcdir=. else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; *) # Relative path. srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" top_srcdir="$ac_dots$ac_given_srcdir" ;; esac case "$ac_given_INSTALL" in [/$]*) INSTALL="$ac_given_INSTALL" ;; *) INSTALL="$ac_dots$ac_given_INSTALL" ;; esac echo creating "$ac_file" rm -f "$ac_file" configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." case "$ac_file" in *Makefile*) ac_comsub="1i\\ # $configure_input" ;; *) ac_comsub= ;; esac sed -e "$ac_comsub s%@configure_input@%$configure_input%g s%@srcdir@%$srcdir%g s%@top_srcdir@%$top_srcdir%g s%@INSTALL@%$INSTALL%g " -f conftest.subs $ac_given_srcdir/$ac_file_in > $ac_file fi; done rm -f conftest.subs # These sed commands are passed to sed as "A NAME B NAME C VALUE D", where # NAME is the cpp macro being defined and VALUE is the value it is being given. # # ac_d sets the value in "#define NAME VALUE" lines. ac_dA='s%^\([ ]*\)#\([ ]*define[ ][ ]*\)' ac_dB='\([ ][ ]*\)[^ ]*%\1#\2' ac_dC='\3' ac_dD='%g' # ac_u turns "#undef NAME" with trailing blanks into "#define NAME VALUE". ac_uA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' ac_uB='\([ ]\)%\1#\2define\3' ac_uC=' ' ac_uD='\4%g' # ac_e turns "#undef NAME" without trailing blanks into "#define NAME VALUE". ac_eA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' ac_eB='$%\1#\2define\3' ac_eC=' ' ac_eD='%g' CONFIG_HEADERS=${CONFIG_HEADERS-"src/config.h:src/config.in"} for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then # Support "outfile[:infile]", defaulting infile="outfile.in". case "$ac_file" in *:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'` ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; *) ac_file_in="${ac_file}.in" ;; esac echo creating $ac_file rm -f conftest.frag conftest.in conftest.out cp $ac_given_srcdir/$ac_file_in conftest.in EOF # Transform confdefs.h into a sed script conftest.vals that substitutes # the proper values into config.h.in to produce config.h. And first: # Protect against being on the right side of a sed subst in config.status. # Protect against being in an unquoted here document in config.status. rm -f conftest.vals cat > conftest.hdr <<\EOF s/[\\&%]/\\&/g s%[\\$`]%\\&%g s%#define \([A-Za-z_][A-Za-z0-9_]*\) \(.*\)%${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD}%gp s%ac_d%ac_u%gp s%ac_u%ac_e%gp EOF sed -n -f conftest.hdr confdefs.h > conftest.vals rm -f conftest.hdr # This sed command replaces #undef with comments. This is necessary, for # example, in the case of _POSIX_SOURCE, which is predefined and required # on some systems where configure will not decide to define it. cat >> conftest.vals <<\EOF s%^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */% EOF # Break up conftest.vals because some shells have a limit on # the size of here documents, and old seds have small limits too. # Maximum number of lines to put in a single here document. ac_max_here_lines=12 rm -f conftest.tail while : do ac_lines=`grep -c . conftest.vals` # grep -c gives empty output for an empty file on some AIX systems. if test -z "$ac_lines" || test "$ac_lines" -eq 0; then break; fi # Write a limited-size here document to conftest.frag. echo ' cat > conftest.frag <> $CONFIG_STATUS sed ${ac_max_here_lines}q conftest.vals >> $CONFIG_STATUS echo 'CEOF sed -f conftest.frag conftest.in > conftest.out rm -f conftest.in mv conftest.out conftest.in ' >> $CONFIG_STATUS sed 1,${ac_max_here_lines}d conftest.vals > conftest.tail rm -f conftest.vals mv conftest.tail conftest.vals done rm -f conftest.vals cat >> $CONFIG_STATUS <<\EOF rm -f conftest.frag conftest.h echo "/* $ac_file. Generated automatically by configure. */" > conftest.h cat conftest.in >> conftest.h rm -f conftest.in if cmp -s $ac_file conftest.h 2>/dev/null; then echo "$ac_file is unchanged" rm -f conftest.h else rm -f $ac_file mv conftest.h $ac_file fi fi; done EOF cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF ### Make the necessary directories, if they don't exist. for dir in cpp etc ; do test -d ${dir} || mkdir ${dir} done # Build src/Makefile from ${srcdir}/src/Makefile.c # and lib-src/Makefile from ${srcdir}/lib-src/Makefile.c # This must be done after src/config.h is built, since we rely on that file. # Now get this: Some word that is part of the ${srcdir} directory name # or the ${configuration} value might, just might, happen to be an # identifier like `sun4' or `i386' or something, and be predefined by # the C preprocessor to some helpful value like 1, or maybe the empty # string. Needless to say consequent macro substitutions are less # than conducive to the makefile finding the correct directory. undefs="`echo $top_srcdir $configuration $canonical | sed -e 's/[^a-zA-Z0-9_]/ /g' -e 's/^/ /' -e 's/ *$//' \ -e 's/ */ -U/g' -e 's/-U[0-9][^ ]*//g' \ `" echo creating lib-src/Makefile ( cd lib-src rm -f junk.c junk1.c junk2.c sed -e '/start of cpp stuff/q' \ < Makefile.c > junk1.c sed -e '1,/start of cpp stuff/d'\ -e 's@/\*\*/#\(.*\)$@/* \1 */@' \ < Makefile.c > junk.c $CPP $undefs -I. -I$top_srcdir/src $CPPFLAGS junk.c | \ sed -e 's/^ / /' -e '/^#/d' -e '/^[ ]*$/d' > junk2.c cat junk1.c junk2.c > Makefile.new rm -f junk.c junk1.c junk2.c chmod 444 Makefile.new mv -f Makefile.new Makefile ) echo creating src/Makefile ( cd src rm -f junk.c junk1.c junk2.c sed -e '/start of cpp stuff/q' \ < Makefile.c > junk1.c sed -e '1,/start of cpp stuff/d'\ -e 's@/\*\*/#\(.*\)$@/* \1 */@' \ < Makefile.c > junk.c $CPP $undefs -I. -I$top_srcdir/src $CPPFLAGS junk.c | \ sed -e 's/^ / /' -e '/^#/d' -e '/^[ ]*$/d' > junk2.c cat junk1.c junk2.c > Makefile.new rm -f junk.c junk1.c junk2.c chmod 444 Makefile.new mv -f Makefile.new Makefile ) if test ! -f src/.gdbinit && test -f $top_srcdir/src/.gdbinit; then echo creating src/.gdbinit echo source $top_srcdir/src/.gdbinit > src/.gdbinit fi exit 0 EOF chmod +x $CONFIG_STATUS rm -fr confdefs* $ac_clean_files test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 emacs-19.30/configure.in100444 12120 1 117052 6052460221 13454 0ustar rmsdaemondnl This is an autoconf script. dnl To rebuild the `configure' script from this, execute the command dnl autoconf dnl in the directory containing this script. AC_PREREQ(2.4.1)dnl AC_INIT(src/lisp.h) AC_CONFIG_HEADER(src/config.h:src/config.in) lispdir='${datadir}/emacs/${version}/lisp' locallisppath='${datadir}/emacs/site-lisp' lisppath='${locallisppath}:${lispdir}' etcdir='${datadir}/emacs/${version}/etc' lockdir='${sharedstatedir}/emacs/lock' archlibdir='${libexecdir}/emacs/${version}/${configuration}' docdir='${datadir}/emacs/${version}/etc' AC_ARG_WITH(gcc, [ --with-gcc use GCC to compile Emacs]) AC_ARG_WITH(pop, [ --with-pop support POP for mail retrieval], [AC_DEFINE(MAIL_USE_POP)]) AC_ARG_WITH(kerberos, [ --with-kerberos support Kerberos-authenticated POP], [AC_DEFINE(KERBEROS)]) AC_ARG_WITH(hesiod, [ --with-hesiod support Hesiod to get the POP server host], [AC_DEFINE(HESIOD)]) dnl This should be the last --with option, because --with-x is dnl added later on when we find the path of X, and it's best to dnl keep them together visually. AC_ARG_WITH(x-toolkit, [ --with-x-toolkit=KIT use an X toolkit (KIT = yes/lucid/athena/motif)], [ case "${withval}" in y | ye | yes ) val=athena ;; n | no ) val=no ;; l | lu | luc | luci | lucid ) val=lucid ;; a | at | ath | athe | athen | athena ) val=athena ;; m | mo | mot | moti | motif ) val=motif ;; dnl These don't currently work. dnl o | op | ope | open | open- | open-l | open-lo \ dnl | open-loo | open-look ) val=open-look ;; * ) dnl AC_MSG_ERROR([the \`--with-x-toolkit' option is supposed to have a value dnl which is \`yes', \`no', \`lucid', \`athena', \`motif' or \`open-look'.]) AC_MSG_ERROR([\`--with-x-toolkit=$withval' is invalid\; this option's value should be \`yes', \`no', \`lucid', \`athena', or \`motif'. Currently, \`yes', \`athena' and \`lucid' are synonyms.]) ;; esac with_x_toolkit=$val ]) #### Make srcdir absolute, if it isn't already. It's important to #### avoid running the path through pwd unnecessary, since pwd can #### give you automounter prefixes, which can go away. We do all this #### so Emacs can find its files when run uninstalled. case "${srcdir}" in /* ) ;; . ) ## We may be able to use the $PWD environment variable to make this ## absolute. But sometimes PWD is inaccurate. ## Make sure CDPATH doesn't affect cd (in case PWD is relative). CDPATH= if test "${PWD}" != "" && test "`(cd ${PWD} ; sh -c pwd)`" = "`pwd`" ; then srcdir="$PWD" else srcdir="`(cd ${srcdir}; pwd)`" fi ;; * ) srcdir="`(cd ${srcdir}; pwd)`" ;; esac #### Check if the source directory already has a configured system in it. if test `pwd` != `(cd ${srcdir} && pwd)` \ && test -f "${srcdir}/src/config.h" ; then AC_MSG_WARN([The directory tree \`${srcdir}' is being used as a build directory right now; it has been configured in its own right. To configure in another directory as well, you MUST use GNU make. If you do not have GNU make, then you must now do \`make distclean' in ${srcdir}, and then run $0 again.]) changequote(, )dnl extrasub='/^VPATH[ ]*=/c\ changequote([, ])dnl vpath %.c $(srcdir)\ vpath %.h $(srcdir)\ vpath %.y $(srcdir)\ vpath %.l $(srcdir)\ vpath %.s $(srcdir)\ vpath %.in $(srcdir)' fi #### Given the configuration name, set machfile and opsysfile to the #### names of the m/*.h and s/*.h files we should use. ### Canonicalize the configuration name. AC_CANONICAL_HOST canonical=$host configuration=$host_alias changequote(, )dnl ### If you add support for a new configuration, add code to this ### switch statement to recognize your configuration name and select ### the appropriate operating system and machine description files. ### You would hope that you could choose an m/*.h file pretty much ### based on the machine portion of the configuration name, and an s- ### file based on the operating system portion. However, it turns out ### that each m/*.h file is pretty manufacturer-specific - for ### example, apollo.h, hp9000s300.h, mega68k, news.h, and tad68k are ### all 68000 machines; mips.h, pmax.h, and news-risc are all MIPS ### machines. So we basically have to have a special case for each ### configuration name. ### ### As far as handling version numbers on operating systems is ### concerned, make sure things will fail in a fixable way. If ### /etc/MACHINES doesn't say anything about version numbers, be ### prepared to handle anything reasonably. If version numbers ### matter, be sure /etc/MACHINES says something about it. ### ### Eric Raymond says we should accept strings like "sysvr4" to mean ### "System V Release 4"; he writes, "The old convention encouraged ### confusion between `system' and `release' levels'." machine='' opsys='' unported=no case "${canonical}" in ## NetBSD ports *-*-netbsd* ) opsys=netbsd case "${canonical}" in i[345]86-*-netbsd*) machine=intel386 ;; m68k-*-netbsd*) # This is somewhat bogus. machine=hp9000s300 ;; mips-*-netbsd*) machine=pmax ;; ns32k-*-netbsd*) machine=ns32000 ;; sparc-*-netbsd*) machine=sparc ;; esac ;; ## Acorn RISCiX: arm-acorn-riscix1.1* ) machine=acorn opsys=riscix1-1 ;; arm-acorn-riscix1.2* | arm-acorn-riscix ) machine=acorn opsys=riscix1-2 ;; ## Alliant machines ## Strictly speaking, we need the version of the alliant operating ## system to choose the right machine file, but currently the ## configuration name doesn't tell us enough to choose the right ## one; we need to give alliants their own operating system name to ## do this right. When someone cares, they can help us. fx80-alliant-* ) machine=alliant4 opsys=bsd4-2 ;; i860-alliant-* ) machine=alliant-2800 opsys=bsd4-3 ;; ## Alpha (DEC) machines. alpha-dec-osf* ) machine=alpha opsys=osf1 ;; alpha-*-linux* ) machine=alpha opsys=linux ;; ## Altos 3068 m68*-altos-sysv* ) machine=altos opsys=usg5-2 ;; ## Amdahl UTS 580-amdahl-sysv* ) machine=amdahl opsys=usg5-2-2 ;; ## Apollo, Domain/OS m68*-apollo-* ) machine=apollo opsys=bsd4-3 ;; ## AT&T 3b2, 3b5, 3b15, 3b20 we32k-att-sysv* ) machine=att3b opsys=usg5-2-2 ;; ## AT&T 3b1 - The Mighty Unix PC! m68*-att-sysv* ) machine=7300 opsys=usg5-2-2 ;; ## Bull dpx20 rs6000-bull-bosx* ) machine=ibmrs6000 opsys=aix3-2 ;; ## Bull dpx2 m68*-bull-sysv3* ) machine=dpx2 opsys=usg5-3 ;; ## Bull sps7 m68*-bull-sysv2* ) machine=sps7 opsys=usg5-2 ;; ## CCI 5/32, 6/32 -- see "Tahoe". ## Celerity ## I don't know what configuration name to use for this; config.sub ## doesn't seem to know anything about it. Hey, Celerity users, get ## in touch with us! celerity-celerity-bsd* ) machine=celerity opsys=bsd4-2 ;; ## Clipper ## What operating systems does this chip run that Emacs has been ## tested on? clipper-* ) machine=clipper ## We'll use the catch-all code at the bottom to guess the ## operating system. ;; ## Convex *-convex-bsd* | *-convex-convexos* ) machine=convex opsys=bsd4-3 ## Prevents suprious white space in makefiles - d.m.cooke@larc.nasa.gov NON_GNU_CPP="cc -E -P" ;; ## Cubix QBx/386 i[345]86-cubix-sysv* ) machine=intel386 opsys=usg5-3 ;; ## Cydra 5 cydra*-cydrome-sysv* ) machine=cydra5 opsys=usg5-3 ;; ## Data General AViiON Machines m88k-dg-dgux5.4R3* | m88k-dg-dgux5.4.3* ) machine=aviion opsys=dgux5-4r3 ;; m88k-dg-dgux5.4R2* | m88k-dg-dgux5.4.2* ) machine=aviion opsys=dgux5-4r2 ;; m88k-dg-dgux* ) machine=aviion opsys=dgux ;; ## DECstations mips-dec-ultrix[0-3].* | mips-dec-ultrix4.0* | mips-dec-bsd4.2* ) machine=pmax opsys=bsd4-2 ;; mips-dec-ultrix4.[12]* | mips-dec-bsd* ) machine=pmax opsys=bsd4-3 ;; mips-dec-ultrix* ) machine=pmax opsys=ultrix4-3 ;; mips-dec-osf* ) machine=pmax opsys=osf1 ;; mips-dec-mach_bsd4.3* ) machine=pmax opsys=mach-bsd4-3 ;; ## Motorola Delta machines m68k-motorola-sysv* | m68000-motorola-sysv* ) machine=delta opsys=usg5-3 if test -z "`type gnucc | grep 'not found'`" then if test -s /etc/167config then CC="gnucc -m68040" else CC="gnucc -m68881" fi else if test -z "`type gcc | grep 'not found'`" then CC=gcc else CC=cc fi fi ;; m88k-motorola-sysv4* ) # jbotte@bnr.ca says that UNIX_System_V 4.0 R40V4.3 m88k mc88110 # needs POSIX_SIGNALS and therefore needs usg5-4-2. # I hope there are not other 4.0 versions for this machine # which really need usg5-4 instead. machine=delta88k opsys=usg5-4-2 ;; m88k-motorola-sysv* | m88k-motorola-m88kbcs* ) machine=delta88k opsys=usg5-3 ;; ## Dual machines m68*-dual-sysv* ) machine=dual opsys=usg5-2 ;; m68*-dual-uniplus* ) machine=dual opsys=unipl5-2 ;; ## Elxsi 6400 elxsi-elxsi-sysv* ) machine=elxsi opsys=usg5-2 ;; ## Encore machines ns16k-encore-bsd* ) machine=ns16000 opsys=umax ;; ## The GEC 93 - apparently, this port isn't really finished yet. ## Gould Power Node and NP1 pn-gould-bsd4.2* ) machine=gould opsys=bsd4-2 ;; pn-gould-bsd4.3* ) machine=gould opsys=bsd4-3 ;; np1-gould-bsd* ) machine=gould-np1 opsys=bsd4-3 ;; ## Harris Night Hawk machines running CX/UX (a 5000 looks just like a 4000 ## as far as Emacs is concerned). m88k-harris-cxux* ) # Build needs to be different on 7.0 and later releases case "`uname -r`" in [56].[0-9] ) machine=nh4000 opsys=cxux ;; [7].[0-9] ) machine=nh4000 opsys=cxux7 ;; esac ;; ## Harris ecx or gcx running CX/UX (Series 1200, Series 3000) m68k-harris-cxux* ) machine=nh3000 opsys=cxux ;; ## Honeywell XPS100 xps*-honeywell-sysv* ) machine=xps100 opsys=usg5-2 ;; ## HP 9000 series 200 or 300 m68*-hp-bsd* ) machine=hp9000s300 opsys=bsd4-3 ;; ## HP/UX 7, 8, 9, and 10 are supported on these machines. m68*-hp-hpux* ) case "`uname -r`" in ## Someone's system reports A.B8.05 for this. ## I wonder what other possibilities there are. *.B8.* ) machine=hp9000s300 opsys=hpux8 ;; *.08.* ) machine=hp9000s300 opsys=hpux8 ;; *.09.* ) machine=hp9000s300 opsys=hpux9 ;; *.10.* ) machine=hp9000s300 opsys=hpux9shr ;; *) machine=hp9000s300 opsys=hpux ;; esac ;; ## HP 9000 series 700 and 800, running HP/UX hppa*-hp-hpux7* ) machine=hp800 opsys=hpux ;; hppa*-hp-hpux8* ) machine=hp800 opsys=hpux8 ;; hppa*-hp-hpux9shr* ) machine=hp800 opsys=hpux9shr ;; hppa*-hp-hpux9* ) machine=hp800 opsys=hpux9 ;; hppa*-hp-hpux10* ) machine=hp800 opsys=hpux10 ;; ## HP 9000 series 700 and 800, running HP/UX hppa*-hp-hpux* ) ## Cross-compilation? Nah! case "`uname -r`" in ## Someone's system reports A.B8.05 for this. ## I wonder what other possibilities there are. *.B8.* ) machine=hp800 opsys=hpux8 ;; *.08.* ) machine=hp800 opsys=hpux8 ;; *.09.* ) machine=hp800 opsys=hpux9 ;; *) machine=hp800 opsys=hpux ;; esac ;; ## Orion machines orion-orion-bsd* ) machine=orion opsys=bsd4-2 ;; clipper-orion-bsd* ) machine=orion105 opsys=bsd4-2 ;; ## IBM machines i[345]86-ibm-aix1.1* ) machine=ibmps2-aix opsys=usg5-2-2 ;; i[345]86-ibm-aix1.[23]* | i[345]86-ibm-aix* ) machine=ibmps2-aix opsys=usg5-3 ;; i370-ibm-aix*) machine=ibm370aix opsys=usg5-3 ;; rs6000-ibm-aix3.1* | powerpc-ibm-aix3.1* ) machine=ibmrs6000 opsys=aix3-1 ;; rs6000-ibm-aix3.2.5 | powerpc-ibm-aix3.2.5 ) machine=ibmrs6000 opsys=aix3-2-5 ;; rs6000-ibm-aix4.1* | powerpc-ibm-aix4.1* ) machine=ibmrs6000 opsys=aix4-1 ;; rs6000-ibm-aix4* | powerpc-ibm-aix4* ) machine=ibmrs6000 opsys=aix4 ;; rs6000-ibm-aix* | powerpc-ibm-aix* ) machine=ibmrs6000 opsys=aix3-2 ;; romp-ibm-bsd4.3* ) machine=ibmrt opsys=bsd4-3 ;; romp-ibm-bsd4.2* ) machine=ibmrt opsys=bsd4-2 ;; romp-ibm-aos4.3* ) machine=ibmrt opsys=bsd4-3 ;; romp-ibm-aos4.2* ) machine=ibmrt opsys=bsd4-2 ;; romp-ibm-aos* ) machine=ibmrt opsys=bsd4-3 ;; romp-ibm-bsd* ) machine=ibmrt opsys=bsd4-3 ;; romp-ibm-aix* ) machine=ibmrt-aix opsys=usg5-2-2 ;; ## Integrated Solutions `Optimum V' m68*-isi-bsd4.2* ) machine=isi-ov opsys=bsd4-2 ;; m68*-isi-bsd4.3* ) machine=isi-ov opsys=bsd4-3 ;; ## Intel 386 machines where we do care about the manufacturer i[345]86-intsys-sysv* ) machine=is386 opsys=usg5-2-2 ;; ## Prime EXL i[345]86-prime-sysv* ) machine=i386 opsys=usg5-3 ;; ## Sequent Symmetry running Dynix i[345]86-sequent-bsd* ) machine=symmetry opsys=bsd4-3 ;; ## Sequent Symmetry running DYNIX/ptx ## Use the old cpp rather than the newer ANSI one. i[345]86-sequent-ptx* ) machine=sequent-ptx opsys=ptx NON_GNU_CPP="/lib/cpp" ;; ## Unspecified sysv on an ncr machine defaults to svr4.2. ## (Plain usg5-4 doesn't turn on POSIX signals, which we need.) i[345]86-ncr-sysv* ) machine=ncr386 opsys=usg5-4-2 ;; ## Intel Paragon OSF/1 i860-intel-osf1* ) machine=paragon opsys=osf1 NON_GNU_CPP=/usr/mach/lib/cpp ;; ## Intel 860 i860-*-sysv4* ) machine=i860 opsys=usg5-4 NON_GNU_CC="/bin/cc" # Ie, not the one in /usr/ucb/cc. NON_GNU_CPP="/usr/ccs/lib/cpp" # cc -E tokenizes macro expansion. ;; ## Masscomp machines m68*-masscomp-rtu* ) machine=masscomp opsys=rtu ;; ## Megatest machines m68*-megatest-bsd* ) machine=mega68 opsys=bsd4-2 ;; ## Workstations sold by MIPS ## This is not necessarily all workstations using the MIPS processor - ## Irises are produced by SGI, and DECstations by DEC. ## etc/MACHINES lists mips.h and mips4.h as possible machine files, ## and usg5-2-2 and bsd4-3 as possible OS files. The only guidance ## it gives for choosing between the alternatives seems to be "Use ## -machine=mips4 for RISCOS version 4; use -opsystem=bsd4-3 with ## the BSD world." I'll assume that these are instructions for ## handling two odd situations, and that every other situation ## should use mips.h and usg5-2-2, they being listed first. mips-mips-usg* ) machine=mips4 ## Fall through to the general code at the bottom to decide on the OS. ;; mips-mips-riscos4* ) machine=mips4 opsys=bsd4-3 NON_GNU_CC="cc -systype bsd43" NON_GNU_CPP="cc -systype bsd43 -E" ;; mips-mips-riscos5* ) machine=mips4 opsys=riscos5 NON_GNU_CC="cc -systype bsd43" NON_GNU_CPP="cc -systype bsd43 -E" ;; mips-mips-bsd* ) machine=mips opsys=bsd4-3 ;; mips-mips-* ) machine=mips opsys=usg5-2-2 ;; ## NeXT m68*-next-* | m68k-*-nextstep* ) machine=m68k opsys=nextstep ;; ## The complete machine from National Semiconductor ns32k-ns-genix* ) machine=ns32000 opsys=usg5-2 ;; ## NCR machines m68*-ncr-sysv2* | m68*-ncr-sysvr2* ) machine=tower32 opsys=usg5-2-2 ;; m68*-ncr-sysv3* | m68*-ncr-sysvr3* ) machine=tower32v3 opsys=usg5-3 ;; ## Nixdorf Targon 31 m68*-nixdorf-sysv* ) machine=targon31 opsys=usg5-2-2 ;; ## Nu (TI or LMI) m68*-nu-sysv* ) machine=nu opsys=usg5-2 ;; ## Plexus m68*-plexus-sysv* ) machine=plexus opsys=usg5-2 ;; ## Pyramid machines ## I don't really have any idea what sort of processor the Pyramid has, ## so I'm assuming it is its own architecture. pyramid-pyramid-bsd* ) machine=pyramid opsys=bsd4-2 ;; ## Sequent Balance ns32k-sequent-bsd4.2* ) machine=sequent opsys=bsd4-2 ;; ns32k-sequent-bsd4.3* ) machine=sequent opsys=bsd4-3 ;; ## Siemens Nixdorf mips-siemens-sysv* ) machine=mips-siemens opsys=usg5-4 NON_GNU_CC=/usr/ccs/bin/cc NON_GNU_CPP=/usr/ccs/lib/cpp ;; ## Silicon Graphics machines ## Iris 2500 and Iris 2500 Turbo (aka the Iris 3030) m68*-sgi-iris3.5* ) machine=irist opsys=iris3-5 ;; m68*-sgi-iris3.6* | m68*-sgi-iris*) machine=irist opsys=iris3-6 ;; ## Iris 4D mips-sgi-irix3* ) machine=iris4d opsys=irix3-3 ;; mips-sgi-irix4* ) machine=iris4d opsys=irix4-0 ;; mips-sgi-irix6* ) machine=iris4d opsys=irix6-0 ;; mips-sgi-irix5.[01]* ) machine=iris4d opsys=irix5-0 ;; mips-sgi-irix5* | mips-sgi-irix* ) machine=iris4d opsys=irix5-2 ;; ## SONY machines m68*-sony-bsd4.2* ) machine=news opsys=bsd4-2 ;; m68*-sony-bsd4.3* ) machine=news opsys=bsd4-3 ;; m68*-sony-newsos3* | m68*-sony-news3*) machine=news opsys=bsd4-3 ;; mips-sony-bsd* | mips-sony-newsos4* | mips-sony-news4*) machine=news-risc opsys=bsd4-3 ;; mips-sony-news* ) machine=news-risc opsys=newsos5 ;; ## Stride m68*-stride-sysv* ) machine=stride opsys=usg5-2 ;; ## Suns *-sun-sunos* | *-sun-bsd* | *-sun-solaris* \ | i[345]86-*-solaris2* | i[345]86-*-sunos5* | powerpc*-*-solaris2* \ | rs6000-*-solaris2*) case "${canonical}" in m68*-sunos1* ) machine=sun1 ;; m68*-sunos2* ) machine=sun2 ;; m68* ) machine=sun3 ;; i[345]86-sun-sunos[34]* ) machine=sun386 ;; i[345]86-*-* ) machine=intel386 ;; powerpc* | rs6000* ) machine=rs6000 ;; sparc* ) machine=sparc ;; * ) unported=yes ;; esac case "${canonical}" in ## The Sun386 didn't get past 4.0. i[345]86-*-sunos4 ) opsys=sunos4-0 ;; *-sunos4.0* ) opsys=sunos4-0 ;; *-sunos4.1.[3-9]* | *-sunos4shr*) opsys=sunos4shr NON_GNU_CPP=/usr/lib/cpp ;; *-sunos4* | *-sunos ) opsys=sunos4-1 NON_GCC_TEST_OPTIONS=-Bstatic GCC_TEST_OPTIONS=-static ;; *-sunos5.3* | *-solaris2.3* ) opsys=sol2-3 NON_GNU_CPP=/usr/ccs/lib/cpp ;; *-sunos5.4* | *-solaris2.4* ) opsys=sol2-4 NON_GNU_CPP=/usr/ccs/lib/cpp RANLIB="ar -ts" ;; *-sunos5.5* | *-solaris2.5* ) opsys=sol2-5 NON_GNU_CPP=/usr/ccs/lib/cpp RANLIB="ar -ts" ;; *-sunos5* | *-solaris* ) opsys=sol2 NON_GNU_CPP=/usr/ccs/lib/cpp ;; * ) opsys=bsd4-2 ;; esac ;; sparc-*-nextstep* ) machine=sparc opsys=nextstep ;; ## Tadpole 68k m68*-tadpole-sysv* ) machine=tad68k opsys=usg5-3 ;; ## Tahoe machines tahoe-tahoe-bsd4.2* ) machine=tahoe opsys=bsd4-2 ;; tahoe-tahoe-bsd4.3* ) machine=tahoe opsys=bsd4-3 ;; ## Tandem Integrity S2 mips-tandem-sysv* ) machine=tandem-s2 opsys=usg5-3 ;; ## Tektronix XD88 m88k-tektronix-sysv3* ) machine=tekxd88 opsys=usg5-3 ;; ## Tektronix 16000 box (6130?) ns16k-tektronix-bsd* ) machine=ns16000 opsys=bsd4-2 ;; ## Tektronix 4300 ## src/m/tek4300.h hints that this is a m68k machine. m68*-tektronix-bsd* ) machine=tek4300 opsys=bsd4-3 ;; ## Titan P2 or P3 ## We seem to have lost the machine-description file titan.h! titan-titan-sysv* ) machine=titan opsys=usg5-3 ;; ## Ustation E30 (SS5E) m68*-unisys-uniplus* ) machine=ustation opsystem=unipl5-2 ;; ## Vaxen. vax-dec-* ) machine=vax case "${canonical}" in *-bsd4.1* ) opsys=bsd4-1 ;; *-bsd4.2* | *-ultrix[0-3].* | *-ultrix4.0* ) opsys=bsd4-2 ;; *-bsd4.3* | *-ultrix* ) opsys=bsd4-3 ;; *-sysv[01]* | *-sysvr[01]* ) opsys=usg5-0 ;; *-sysv2* | *-sysvr2* ) opsys=usg5-2 ;; *-vms* ) opsys=vms ;; * ) unported=yes esac ;; ## Whitechapel MG1 ns16k-whitechapel-* ) machine=mg1 ## We don't know what sort of OS runs on these; we'll let the ## operating system guessing code below try. ;; ## Wicat m68*-wicat-sysv* ) machine=wicat opsys=usg5-2 ;; ## Intel 386 machines where we don't care about the manufacturer i[345]86-*-* ) machine=intel386 case "${canonical}" in *-isc1.* | *-isc2.[01]* ) opsys=386-ix ;; *-isc2.2* ) opsys=isc2-2 ;; *-isc4.0* ) opsys=isc4-0 ;; *-isc4.* ) opsys=isc4-1 GCC_TEST_OPTIONS=-posix NON_GCC_TEST_OPTIONS=-Xp ;; *-isc* ) opsys=isc3-0 ;; *-esix5* ) opsys=esix5r4; NON_GNU_CPP=/usr/lib/cpp ;; *-esix* ) opsys=esix ;; *-xenix* ) opsys=xenix ;; *-linux* ) opsys=linux ;; *-sco3.2v4* ) opsys=sco4 ; NON_GNU_CPP=/lib/cpp ;; *-bsd386* | *-bsdi1* ) opsys=bsd386 ;; *-bsdi2* ) opsys=bsdos2 ;; *-386bsd* ) opsys=386bsd ;; *-freebsd* ) opsys=freebsd ;; *-nextstep* ) opsys=nextstep ;; ## Otherwise, we'll fall through to the generic opsys code at the bottom. esac ;; ## Linux/68k m68k-*-linux* ) machine=m68k opsys=linux ;; * ) unported=yes ;; esac ### If the code above didn't choose an operating system, just choose ### an operating system based on the configuration name. You really ### only want to use this when you have no idea what the right ### operating system is; if you know what operating systems a machine ### runs, it's cleaner to make it explicit in the case statement ### above. if test x"${opsys}" = x; then case "${canonical}" in *-gnu* ) opsys=gnu ;; *-bsd4.[01] ) opsys=bsd4-1 ;; *-bsd4.2 ) opsys=bsd4-2 ;; *-bsd4.3 ) opsys=bsd4-3 ;; *-sysv0 | *-sysvr0 ) opsys=usg5-0 ;; *-sysv2 | *-sysvr2 ) opsys=usg5-2 ;; *-sysv2.2 | *-sysvr2.2 ) opsys=usg5-2-2 ;; *-sysv3* | *-sysvr3* ) opsys=usg5-3 ;; *-sysv4.1* | *-sysvr4.1* ) NON_GNU_CPP=/usr/lib/cpp opsys=usg5-4 ;; *-sysv4.[2-9]* | *-sysvr4.[2-9]* ) if [ x$NON_GNU_CPP = x ]; then NON_GNU_CPP=/usr/ccs/lib/cpp fi opsys=usg5-4-2 ;; *-sysv4* | *-sysvr4* ) opsys=usg5-4 ;; * ) unported=yes ;; esac fi if test "x$RANLIB" = x; then RANLIB=ranlib fi changequote([, ])dnl if test $unported = yes; then AC_MSG_ERROR([Emacs hasn't been ported to \`${canonical}' systems. Check \`etc/MACHINES' for recognized configuration names.]) fi machfile="m/${machine}.h" opsysfile="s/${opsys}.h" #### Choose a compiler. test -n "$CC" && cc_specified=yes # Save the value of CFLAGS that the user specified. SPECIFIED_CFLAGS="$CFLAGS" case ${with_gcc} in "yes" ) CC="gcc" GCC=yes ;; "no" ) : ${CC=cc} ;; * ) AC_PROG_CC esac # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi #### Some systems specify a CPP to use unless we are using GCC. #### Now that we know whether we are using GCC, we can decide whether #### to use that one. if test "x$NON_GNU_CPP" != x && test x$GCC != xyes && test "x$CPP" = x then CPP="$NON_GNU_CPP" fi #### Some systems specify a CC to use unless we are using GCC. #### Now that we know whether we are using GCC, we can decide whether #### to use that one. if test "x$NON_GNU_CC" != x && test x$GCC != xyes && test x$cc_specified != xyes then CC="$NON_GNU_CC" fi if test x$GCC = xyes && test "x$GCC_TEST_OPTIONS" != x then CC="$CC $GCC_TEST_OPTIONS" fi if test x$GCC = x && test "x$NON_GCC_TEST_OPTIONS" != x then CC="$CC $NON_GCC_TEST_OPTIONS" fi #### Some other nice autoconf tests. If you add a test here which #### should make an entry in src/config.h, don't forget to add an #### #undef clause to src/config.h.in for autoconf to modify. dnl checks for programs AC_PROG_LN_S AC_PROG_CPP AC_PROG_INSTALL AC_PROG_YACC dnl checks for Unix variants AC_AIX dnl checks for header files AC_CHECK_HEADERS(sys/select.h sys/timeb.h sys/time.h unistd.h utime.h) AC_HEADER_STDC AC_HEADER_TIME AC_DECL_SYS_SIGLIST dnl Some systems have utime.h but don't declare the struct anyplace. AC_MSG_CHECKING(for struct utimbuf) AC_TRY_COMPILE([#ifdef TIME_WITH_SYS_TIME #include #include #else #ifdef HAVE_SYS_TIME_H #include #else #include #endif #endif #ifdef HAVE_UTIME_H #include #endif], [static struct utimbuf x; x.actime = x.modtime;], [AC_MSG_RESULT(yes) AC_DEFINE(HAVE_STRUCT_UTIMBUF)], AC_MSG_RESULT(no)) dnl checks for typedefs AC_TYPE_SIGNAL AC_MSG_CHECKING(for struct timeval) AC_TRY_COMPILE([#ifdef TIME_WITH_SYS_TIME #include #include #else #ifdef HAVE_SYS_TIME_H #include #else #include #endif #endif], [static struct timeval x; x.tv_sec = x.tv_usec;], [AC_MSG_RESULT(yes) HAVE_TIMEVAL=yes AC_DEFINE(HAVE_TIMEVAL)], AC_MSG_RESULT(no)) dnl checks for structure members AC_STRUCT_TM AC_STRUCT_TIMEZONE dnl checks for compiler characteristics AC_C_CONST dnl check for Make feature AC_PROG_MAKE_SET dnl checks for operating system services AC_SYS_LONG_FILE_NAMES #### Choose a window system. AC_PATH_X if test "$no_x" = yes; then window_system=none else window_system=x11 fi if test "${x_libraries}" != NONE && test -n "${x_libraries}"; then LD_SWITCH_X_SITE=-L`echo ${x_libraries} | sed -e "s/:/ -L/g"` LD_SWITCH_X_SITE_AUX=-R`echo ${x_libraries} | sed -e "s/:/ -R/g"` fi if test "${x_includes}" != NONE && test -n "${x_includes}"; then C_SWITCH_X_SITE=-I`echo ${x_includes} | sed -e "s/:/ -I/g"` fi if test x"${x_includes}" = x; then bitmapdir=/usr/include/X11/bitmaps else # accumulate include directories that have X11 bitmap sudirectories bmd_acc="dummyval" for bmd in `echo ${x_includes} | sed -e "s/:/ /g"`; do if test -d "${bmd}/X11/bitmaps"; then bmd_acc="${bmd_acc}:${bmd}/X11/bitmaps" elif test -d "${bmd}/bitmaps"; then bmd_acc="${bmd_acc}:${bmd}/bitmaps" fi done if test ${bmd_acc} != "dummyval"; then bitmapdir=`echo ${bmd_acc} | sed -e "s/^dummyval://"` fi fi case "${window_system}" in x11 ) HAVE_X_WINDOWS=yes HAVE_X11=yes case "${with_x_toolkit}" in athena | lucid ) USE_X_TOOLKIT=LUCID ;; motif ) USE_X_TOOLKIT=MOTIF ;; dnl open-look ) USE_X_TOOLKIT=OPEN_LOOK ;; * ) USE_X_TOOLKIT=none ;; esac ;; none ) HAVE_X_WINDOWS=no HAVE_X11=no USE_X_TOOLKIT=none ;; esac X_TOOLKIT_TYPE=$USE_X_TOOLKIT ### If we're using X11, we should use the X menu package. HAVE_X_MENU=no case ${HAVE_X11} in yes ) HAVE_X_MENU=yes ;; esac if test "${opsys}" = "hpux9"; then case "${x_libraries}" in *X11R4* ) opsysfile="s/hpux9-x11r4.h" ;; esac fi if test "${opsys}" = "hpux9shr"; then case "${x_libraries}" in *X11R4* ) opsysfile="s/hpux9shxr4.h" ;; esac fi #### Extract some information from the operating system and machine files. AC_CHECKING([the machine- and system-dependent files to find out - which libraries the lib-src programs will want, and - whether the GNU malloc routines are usable]) ### First figure out CFLAGS (which we use for running the compiler here) ### and REAL_CFLAGS (which we use for real compilation). ### The two are the same except on a few systems, where they are made ### different to work around various lossages. For example, ### GCC 2.5 on Linux needs them to be different because it treats -g ### as implying static linking. ### If the CFLAGS env var is specified, we use that value ### instead of the default. ### It's not important that this name contain the PID; you can't run ### two configures in the same directory and have anything work ### anyway. tempcname="conftest.c" echo ' #include "'${srcdir}'/src/'${opsysfile}'" #include "'${srcdir}'/src/'${machfile}'" #ifndef LIBS_MACHINE #define LIBS_MACHINE #endif #ifndef LIBS_SYSTEM #define LIBS_SYSTEM #endif #ifndef C_SWITCH_SYSTEM #define C_SWITCH_SYSTEM #endif #ifndef C_SWITCH_MACHINE #define C_SWITCH_MACHINE #endif configure___ libsrc_libs=LIBS_MACHINE LIBS_SYSTEM configure___ c_switch_system=C_SWITCH_SYSTEM configure___ c_switch_machine=C_SWITCH_MACHINE #ifndef LIB_X11_LIB #define LIB_X11_LIB -lX11 #endif #ifndef LIBX11_MACHINE #define LIBX11_MACHINE #endif #ifndef LIBX11_SYSTEM #define LIBX11_SYSTEM #endif configure___ LIBX=LIB_X11_LIB LIBX11_MACHINE LIBX11_SYSTEM #ifdef UNEXEC configure___ unexec=UNEXEC #else configure___ unexec=unexec.o #endif #ifdef SYSTEM_MALLOC configure___ system_malloc=yes #else configure___ system_malloc=no #endif #ifndef C_DEBUG_SWITCH #define C_DEBUG_SWITCH -g #endif #ifndef C_OPTIMIZE_SWITCH #define C_OPTIMIZE_SWITCH -O #endif #ifdef THIS_IS_CONFIGURE /* Get the CFLAGS for tests in configure. */ #ifdef __GNUC__ configure___ CFLAGS=C_DEBUG_SWITCH C_OPTIMIZE_SWITCH '${SPECIFIED_CFLAGS}' #else configure___ CFLAGS=C_DEBUG_SWITCH '${SPECIFIED_CFLAGS}' #endif #else /* not THIS_IS_CONFIGURE */ /* Get the CFLAGS for real compilation. */ #ifdef __GNUC__ configure___ REAL_CFLAGS=C_DEBUG_SWITCH C_OPTIMIZE_SWITCH '${SPECIFIED_CFLAGS}' #else configure___ REAL_CFLAGS=C_DEBUG_SWITCH '${SPECIFIED_CFLAGS}' #endif #endif /* not THIS_IS_CONFIGURE */ ' > ${tempcname} # The value of CPP is a quoted variable reference, so we need to do this # to get its actual value... CPP=`eval "echo $CPP"` changequote(, )dnl eval `${CPP} -Isrc ${tempcname} \ | sed -n -e 's/^configure___ \([^=]*=\)\(.*\)$/\1"\2"/p'` if test "x$SPECIFIED_CFLAGS" = x; then eval `${CPP} -Isrc -DTHIS_IS_CONFIGURE ${tempcname} \ | sed -n -e 's/^configure___ \([^=]*=\)\(.*\)$/\1"\2"/p'` else REAL_CFLAGS="$CFLAGS" fi changequote([, ])dnl rm ${tempcname} ### Compute the unexec source name from the object name. UNEXEC_SRC="`echo ${unexec} | sed 's/\.o/.c/'`" # Do the opsystem or machine files prohibit the use of the GNU malloc? # Assume not, until told otherwise. GNU_MALLOC=yes if test "${system_malloc}" = "yes"; then GNU_MALLOC=no GNU_MALLOC_reason=" (The GNU allocators don't work with this system configuration.)" fi if test x"${REL_ALLOC}" = x; then REL_ALLOC=${GNU_MALLOC} fi LISP_FLOAT_TYPE=yes #### Add the libraries to LIBS and check for some functions. CPPFLAGS="$c_switch_system $c_switch_machine $CPPFLAGS" LIBS="$libsrc_libs $LIBS" dnl If found, this defines HAVE_LIBDNET, which m/pmax.h checks, dnl and also adds -ldnet to LIBS, which Autoconf uses for checks. AC_CHECK_LIB(dnet, dnet_ntoa) dnl This causes -lresolv to get used in subsequent tests, dnl which causes failures on some systems such as HPUX 9. dnl AC_CHECK_LIB(resolv, gethostbyname) dnl FIXME replace main with a function we actually want from this library. AC_CHECK_LIB(Xbsd, main, LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -lXbsd") AC_CHECK_LIB(pthreads, cma_open) AC_MSG_CHECKING(for XFree86) if test -d /usr/X386/include; then HAVE_XFREE386=yes : ${C_SWITCH_X_SITE="-I/usr/X386/include"} else HAVE_XFREE386=no fi AC_MSG_RESULT($HAVE_XFREE386) # Change CFLAGS temporarily so that C_SWITCH_X_SITE gets used # for the tests that follow. We set it back to REAL_CFLAGS later on. if test "${HAVE_X11}" = "yes"; then DEFS="$C_SWITCH_X_SITE $DEFS" LIBS="$LD_SWITCH_X_SITE $LIBX $LIBS" CFLAGS="$C_SWITCH_X_SITE $CFLAGS" if test "${opsys}" = "linux"; then AC_MSG_CHECKING(whether X on GNU/Linux needs -b to link) AC_TRY_LINK([], [XOpenDisplay ("foo");], [xlinux_first_failure=no], [xlinux_first_failure=yes]) if test "${xlinux_first_failure}" = "yes"; then OLD_LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE" OLD_C_SWITCH_X_SITE="$C_SWITCH_X_SITE" OLD_CPPFLAGS="$CPPFLAGS" OLD_LIBS="$LIBS" LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -b i486-linuxaout" C_SWITCH_X_SITE="$C_SWITCH_X_SITE -b i486-linuxaout" CPPFLAGS="$CPPFLAGS -b i486-linuxaout" LIBS="$LIBS -b i486-linuxaout" AC_TRY_LINK([], [XOpenDisplay ("foo");], [xlinux_second_failure=no], [xlinux_second_failure=yes]) if test "${xlinux_second_failure}" = "yes"; then # If we get the same failure with -b, there is no use adding -b. # So take it out. This plays safe. LD_SWITCH_X_SITE="$OLD_LD_SWITCH_X_SITE" C_SWITCH_X_SITE="$OLD_C_SWITCH_X_SITE" CPPFLAGS="$OLD_CPPFLAGS" LIBS="$OLD_LIBS" AC_MSG_RESULT(no) else AC_MSG_RESULT(yes) fi else AC_MSG_RESULT(no) fi fi AC_CHECK_FUNCS(XrmSetDatabase XScreenResourceString \ XScreenNumberOfScreen XSetWMProtocols) fi if test "${USE_X_TOOLKIT}" != "none"; then AC_MSG_CHECKING(X11 toolkit version) AC_TRY_LINK([#include ], [#if XtSpecificationRelease < 6 fail; #endif ], [AC_MSG_RESULT(6) AC_DEFINE(HAVE_X11XTR6)], [AC_MSG_RESULT(not 6)]) fi # If netdb.h doesn't declare h_errno, we must declare it by hand. AC_MSG_CHECKING(whether netdb declares h_errno) AC_TRY_LINK([#include ], [return h_errno;], [AC_MSG_RESULT(yes) AC_DEFINE(HAVE_H_ERRNO)], [AC_MSG_RESULT(no)]) AC_FUNC_ALLOCA # fmod, logb, and frexp are found in -lm on most systems. # On HPUX 9.01, -lm does not contain logb, so check for sqrt. AC_CHECK_LIB(m, sqrt(0.0) + t) AC_CHECK_FUNCS(gettimeofday gethostname dup2 rename closedir mkdir rmdir \ random lrand48 bcopy bcmp logb frexp fmod ftime res_init setsid \ strerror fpathconf select mktime eaccess getpagesize tzset) AC_MSG_CHECKING(whether localtime caches TZ) AC_CACHE_VAL(emacs_cv_localtime_cache, [if test $ac_cv_func_tzset = yes; then AC_TRY_RUN([#include #if STDC_HEADERS # include #endif main() { time_t now = time ((time_t *) 0); int hour; if (putenv ("TZ=GMT0") != 0) exit (1); hour = localtime (&now)->tm_hour; if (putenv ("TZ=PST8") != 0) exit (1); exit (localtime (&now)->tm_hour == hour); }], emacs_cv_localtime_cache=no, emacs_cv_localtime_cache=yes, [# If we have tzset, assume the worst when cross-compiling. emacs_cv_localtime_cache=yes]) else # If we lack tzset, report that localtime does not cache TZ, # since we can't invalidate the cache if we don't have tzset. emacs_cv_localtime_cache=no fi])dnl AC_MSG_RESULT($emacs_cv_localtime_cache) if test $emacs_cv_localtime_cache = yes; then AC_DEFINE(LOCALTIME_CACHE) fi if test $HAVE_TIMEVAL = yes; then AC_MSG_CHECKING(whether gettimeofday can't accept two arguments) AC_TRY_LINK([ #ifdef TIME_WITH_SYS_TIME #include #include #else #ifdef HAVE_SYS_TIME_H #include #else #include #endif #endif ], [ struct timeval time; struct timezone dummy; gettimeofday (&time, &dummy); ], [AC_MSG_RESULT(no)], [AC_MSG_RESULT(yes) AC_DEFINE(GETTIMEOFDAY_ONE_ARGUMENT)]) fi ok_so_far=yes AC_CHECK_FUNC(socket, , ok_so_far=no) if test $ok_so_far = yes; then AC_CHECK_HEADER(netinet/in.h, , ok_so_far=no) fi if test $ok_so_far = yes; then AC_CHECK_HEADER(arpa/inet.h, , ok_so_far=no) fi if test $ok_so_far = yes; then AC_DEFINE(HAVE_INET_SOCKETS) fi if test -f /usr/lpp/X11/bin/smt.exp; then AC_DEFINE(HAVE_AIX_SMT_EXP) fi # Set up the CFLAGS for real compilation, so we can substitute it. CFLAGS="$REAL_CFLAGS" changequote(, )dnl #### Find out which version of Emacs this is. version=`grep 'defconst[ ]*emacs-version' ${srcdir}/lisp/version.el \ | sed -e 's/^[^"]*"\([^"]*\)".*$/\1/'` changequote([, ])dnl if test x"${version}" = x; then AC_MSG_ERROR(can't find current emacs version in \`${srcdir}/lisp/version.el'.) fi ### Specify what sort of things we'll be editing into Makefile and config.h. ### Use configuration here uncanonicalized to avoid exceeding size limits. AC_SUBST(version) AC_SUBST(configuration) AC_SUBST(canonical) AC_SUBST(srcdir) AC_SUBST(prefix) AC_SUBST(exec_prefix) AC_SUBST(bindir) AC_SUBST(datadir) AC_SUBST(sharedstatedir) AC_SUBST(libexecdir) AC_SUBST(mandir) AC_SUBST(infodir) AC_SUBST(lispdir) AC_SUBST(locallisppath) AC_SUBST(lisppath) AC_SUBST(etcdir) AC_SUBST(lockdir) AC_SUBST(archlibdir) AC_SUBST(docdir) AC_SUBST(bitmapdir) AC_SUBST(c_switch_system) AC_SUBST(c_switch_machine) AC_SUBST(LD_SWITCH_X_SITE) AC_SUBST(LD_SWITCH_X_SITE_AUX) AC_SUBST(C_SWITCH_X_SITE) AC_SUBST(CFLAGS) AC_SUBST(X_TOOLKIT_TYPE) AC_SUBST(machfile) AC_SUBST(opsysfile) AC_SUBST(RANLIB) AC_DEFINE_UNQUOTED(EMACS_CONFIGURATION, "${canonical}") AC_DEFINE_UNQUOTED(EMACS_CONFIG_OPTIONS, "${ac_configure_args}") AC_DEFINE_UNQUOTED(config_machfile, "${machfile}") AC_DEFINE_UNQUOTED(config_opsysfile, "${opsysfile}") AC_DEFINE_UNQUOTED(LD_SWITCH_X_SITE, ${LD_SWITCH_X_SITE}) AC_DEFINE_UNQUOTED(LD_SWITCH_X_SITE_AUX, ${LD_SWITCH_X_SITE_AUX}) AC_DEFINE_UNQUOTED(C_SWITCH_X_SITE, ${C_SWITCH_X_SITE}) AC_DEFINE_UNQUOTED(UNEXEC_SRC, ${UNEXEC_SRC}) if test "${HAVE_X_WINDOWS}" = "yes" ; then AC_DEFINE(HAVE_X_WINDOWS) fi if test "${USE_X_TOOLKIT}" != "none" ; then AC_DEFINE(USE_X_TOOLKIT) fi if test "${HAVE_X11}" = "yes" ; then AC_DEFINE(HAVE_X11) fi if test "${HAVE_XFREE386}" = "yes" ; then AC_DEFINE(HAVE_XFREE386) fi if test "${HAVE_X_MENU}" = "yes" ; then AC_DEFINE(HAVE_X_MENU) fi if test "${GNU_MALLOC}" = "yes" ; then AC_DEFINE(GNU_MALLOC) fi if test "${REL_ALLOC}" = "yes" ; then AC_DEFINE(REL_ALLOC) fi if test "${LISP_FLOAT_TYPE}" = "yes" ; then AC_DEFINE(LISP_FLOAT_TYPE) fi #### Report on what we decided to do. echo " Configured for \`${canonical}'. Where should the build process find the source code? ${srcdir} What operating system and machine description files should Emacs use? \`${opsysfile}' and \`${machfile}' What compiler should emacs be built with? ${CC} ${CFLAGS} Should Emacs use the GNU version of malloc? ${GNU_MALLOC}${GNU_MALLOC_reason} Should Emacs use the relocating allocator for buffers? ${REL_ALLOC} What window system should Emacs use? ${window_system} What toolkit should Emacs use? ${USE_X_TOOLKIT}" if test -n "${x_includes}"; then echo " Where do we find X Windows header files? ${x_includes}" else echo " Where do we find X Windows header files? Standard dirs" fi if test -n "${x_libraries}"; then echo " Where do we find X Windows libraries? ${x_libraries}" else echo " Where do we find X Windows libraries? Standard dirs" fi echo # Remove any trailing slashes in these variables. changequote(, )dnl test "${prefix}" != NONE && prefix=`echo "${prefix}" | sed 's,\([^/]\)/*$,\1,'` test "${exec_prefix}" != NONE && exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'` changequote([, ])dnl AC_OUTPUT(Makefile lib-src/Makefile.c:lib-src/Makefile.in oldXMenu/Makefile \ man/Makefile lwlib/Makefile src/Makefile.c:src/Makefile.in, [ ### Make the necessary directories, if they don't exist. for dir in cpp etc ; do test -d ${dir} || mkdir ${dir} done # Build src/Makefile from ${srcdir}/src/Makefile.c # and lib-src/Makefile from ${srcdir}/lib-src/Makefile.c # This must be done after src/config.h is built, since we rely on that file. changequote(, )dnl The horror, the horror. # Now get this: Some word that is part of the ${srcdir} directory name # or the ${configuration} value might, just might, happen to be an # identifier like `sun4' or `i386' or something, and be predefined by # the C preprocessor to some helpful value like 1, or maybe the empty # string. Needless to say consequent macro substitutions are less # than conducive to the makefile finding the correct directory. undefs="`echo $top_srcdir $configuration $canonical | sed -e 's/[^a-zA-Z0-9_]/ /g' -e 's/^/ /' -e 's/ *$//' \ -e 's/ */ -U/g' -e 's/-U[0-9][^ ]*//g' \ `" changequote([, ])dnl echo creating lib-src/Makefile ( cd lib-src rm -f junk.c junk1.c junk2.c sed -e '/start of cpp stuff/q' \ < Makefile.c > junk1.c sed -e '1,/start of cpp stuff/d'\ -e 's@/\*\*/#\(.*\)$@/* \1 */@' \ < Makefile.c > junk.c $CPP $undefs -I. -I$top_srcdir/src $CPPFLAGS junk.c | \ sed -e 's/^ / /' -e '/^#/d' -e '/^[ ]*$/d' > junk2.c cat junk1.c junk2.c > Makefile.new rm -f junk.c junk1.c junk2.c chmod 444 Makefile.new mv -f Makefile.new Makefile ) echo creating src/Makefile ( cd src rm -f junk.c junk1.c junk2.c sed -e '/start of cpp stuff/q' \ < Makefile.c > junk1.c sed -e '1,/start of cpp stuff/d'\ -e 's@/\*\*/#\(.*\)$@/* \1 */@' \ < Makefile.c > junk.c $CPP $undefs -I. -I$top_srcdir/src $CPPFLAGS junk.c | \ sed -e 's/^ / /' -e '/^#/d' -e '/^[ ]*$/d' > junk2.c cat junk1.c junk2.c > Makefile.new rm -f junk.c junk1.c junk2.c chmod 444 Makefile.new mv -f Makefile.new Makefile ) if test ! -f src/.gdbinit && test -f $top_srcdir/src/.gdbinit; then echo creating src/.gdbinit echo source $top_srcdir/src/.gdbinit > src/.gdbinit fi ], [CPP="$CPP" CPPFLAGS="$CPPFLAGS"]) emacs-19.30/config.bat100444 12120 1 12412 6021630156 13054 0ustar rmsdaemon@echo off rem ---------------------------------------------------------------------- rem Configuration script for MSDOS rem Copyright (C) 1994 Free Software Foundation, Inc. rem This file is part of GNU Emacs. rem GNU Emacs is free software; you can redistribute it and/or modify rem it under the terms of the GNU General Public License as published by rem the Free Software Foundation; either version 2, or (at your option) rem any later version. rem GNU Emacs is distributed in the hope that it will be useful, rem but WITHOUT ANY WARRANTY; without even the implied warranty of rem MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the rem GNU General Public License for more details. rem You should have received a copy of the GNU General Public License rem along with GNU Emacs; see the file COPYING. If not, write to rem the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. rem ---------------------------------------------------------------------- rem YOU'LL NEED THE FOLLOWING UTILITIES TO MAKE EMACS: rem rem + msdos version 3 or better. rem + djgpp version 1,11 maint 4 or better. rem + make utility that allows breaking of the 128 chars limit on rem command lines. ndmake (as of version 4.5) won't work due to a rem line length limit. rem + rm, mv, chmod (From GNU file utilities). rem + sed. rem rem You should be able to get all the above utilities from all rem Simtel repositories, e.g., oak.oakland.edu in the directories rem "/pub/msdos/djgpp" and "/pub/msdos/gnuish". As usual, please rem use your local mirroring site to reduce trans-Atlantic traffic. rem ---------------------------------------------------------------------- set X11= set nodebug= :again if "%1" == "" goto usage if "%1" == "--with-x" goto withx if "%1" == "--no-debug" goto nodebug if "%1" == "msdos" goto msdos :usage echo Usage: config [--with-x] [--no-debug] msdos echo [Read the script before you run it.] goto end rem ---------------------------------------------------------------------- :withx set X11=Y shift goto again rem ---------------------------------------------------------------------- :nodebug set nodebug=Y shift goto again rem ---------------------------------------------------------------------- :msdos Echo Checking whether 'sed' is available... sed -e "w junk.$$$" junk.1 mv junk.1 junk.2 If Exist junk.2 Goto mvOk Echo To configure 'Emacs' you need to have 'mv'! rm -f junk.1 Goto End :mvOk rm -f junk.2 Echo Checking whether 'gcc' is available... echo main(){} >junk.c gcc -c junk.c if exist junk.o goto gccOk Echo To configure 'Emacs' you need to have 'gcc'! rm -f junk.c Goto End :gccOk rm -f junk.c junk.o Rem ---------------------------------------------------------------------- Echo Configuring the source directory... cd src rem Create "paths.h" sed -f ../msdos/sed4.inp paths.tmp update paths.tmp paths.h >nul rm -f paths.tmp rem Create "config.h" rm -f config.h2 config.tmp cp config.in config.tmp if "%X11%" == "" goto src4 sed -f ../msdos/sed2x.inp config.tmp :src4 sed -f ../msdos/sed2.inp config.h2 update config.h2 config.h >nul rm -f config.tmp config.h2 rem On my system dir.h gets in the way. It's a VMS file so who cares. if exist dir.h ren dir.h vmsdir.h rem Create "makefile" from "makefile.in". rm -f makefile junk.c sed -e "1,/cpp stuff/s@^# .*$@@" junk.c gcc -E junk.c | sed -f ../msdos/sed1.inp >makefile rm -f junk.c if "%X11%" == "" goto src5 mv makefile makefile.tmp sed -f ../msdos/sed1x.inp makefile rm -f makefile.tmp :src5 if "%nodebug%" == "" goto src6 sed -e "/^CFLAGS *=/s/ *-g//" makefile.tmp mv -f makefile.tmp makefile :src6 cd .. rem ---------------------------------------------------------------------- Echo Configuring the library source directory... cd lib-src rem Create "makefile" from "makefile.in". sed -e "1,/cpp stuff/s@^# .*$@@" junk.c gcc -E -I. -I../src junk.c | sed -e "s/^ / /" -e "/^#/d" -e "/^[ ]*$/d" >makefile.new sed -f ../msdos/sed3.inp makefile rm -f makefile.new junk.c if "%nodebug%" == "" goto libsrc2 sed -e "/^CFLAGS *=/s/ *-g//" makefile.tmp mv -f makefile.tmp makefile :libsrc2 cd .. rem ---------------------------------------------------------------------- if "%X11%" == "" goto oldx1 Echo Configuring the oldxmenu directory... cd oldxmenu sed -f ../msdos/sed5x.inp makefile if "%nodebug%" == "" goto oldx2 sed -e "/^CFLAGS *=/s/ *-g//" makefile.tmp mv -f makefile.tmp makefile :oldx2 cd .. :oldx1 rem ---------------------------------------------------------------------- Echo Configuring the main directory... copy msdos\mainmake makefile >nul rem ---------------------------------------------------------------------- :end set X11= set nodebug= emacs-19.30/make-dist100555 12120 1 33005 6055526546 12742 0ustar rmsdaemon#!/bin/sh #### make-dist: create an Emacs distribution tar file from the current #### source tree. This basically creates a duplicate directory #### structure, and then hard links into it only those files that should #### be distributed. This means that if you add a file with an odd name, #### you should make sure that this script will include it. # Copyright (C) 1995 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. progname="$0" ### Exit if a command fails. ### set -e ### Print out each line we read, for debugging's sake. ### set -v clean_up=yes make_tar=yes newer="" while [ $# -gt 0 ]; do case "$1" in ## This option tells make-dist not to delete the staging directory ## after it's done making the tar file. "--no-clean-up" ) clean_up=no ;; ## This option tells make-dist not to make a tar file. Since it's ## rather pointless to build the whole staging directory and then ## nuke it, using this option also selects '--no-clean-up'. "--no-tar" ) make_tar=no clean_up=no ;; ## This option tells make-dist to make the distribution normally, then ## remove all files older than the given timestamp file. This is useful ## for creating incremental or patch distributions. "--newer") newer="$2" new_extension=".new" shift ;; ## This option tells make-dist to use `compress' instead of gzip. ## Normally, make-dist uses gzip whenever it is present. "--compress") default_gzip="compress" ;; * ) echo "${progname}: Unrecognized argument: $1" >&2 exit 1 ;; esac shift done ### Make sure we're running in the right place. if [ ! -d src -o ! -f src/lisp.h -o ! -d lisp -o ! -f lisp/version.el ]; then echo "${progname}: Can't find \`src/lisp.h' and \`lisp/version.el'." >&2 echo "${progname} must be run in the top directory of the Emacs" >&2 echo "distribution tree. cd to that directory and try again." >&2 exit 1 fi ### Find out which version of Emacs this is. shortversion=`grep 'defconst[ ]*emacs-version' lisp/version.el \ | sed -e 's/^.*"\([0-9][0-9]*\.[0-9][0-9]*\).*$/\1/'` version=`grep 'defconst[ ]*emacs-version' lisp/version.el \ | sed -e 's/^[^"]*"\([^"]*\)".*$/\1/'` if [ ! "${version}" ]; then echo "${progname}: can't find current Emacs version in \`./lisp/version.el'." >&2 exit 1 fi echo $version and $shortversion if grep -s "GNU Emacs version ${shortversion}" ./man/emacs.texi > /dev/null; then true else echo "You must update the version number in \`./man/emacs.texi'" sleep 5 fi ### Make sure we don't already have a directory emacs-${version}. emacsname="emacs-${version}${new_extension}" if [ -d ${emacsname} ] then echo Directory "${emacsname}" already exists >&2 exit 1 fi ### Make sure the subdirectory is available. tempparent="make-dist.tmp.$$" if [ -d ${tempparent} ]; then echo "${progname}: staging directory \`${tempparent}' already exists. Perhaps a previous invocation of \`${progname}' failed to clean up after itself. Check that directories whose names are of the form \`make-dist.tmp.NNNNN' don't contain any important information, remove them, and try again." >&2 exit 1 fi ### Check for .elc files with no corresponding .el file. ls -1 lisp/*.el | sed 's/\.el$/.elc/' > /tmp/el ls -1 lisp/*.elc > /tmp/elc bogosities="`comm -13 /tmp/el /tmp/elc`" if [ "${bogosities}" != "" ]; then echo "The following .elc files have no corresponding .el files:" echo "${bogosities}" fi rm -f /tmp/el /tmp/elc ### Make sure configure is newer than configure.in. if [ "x`ls -t configure configure.in | head -1`" != "xconfigure" ]; then echo "\`./configure.in' seems to be newer than \`./configure.'" >&2 echo "Attempting to run autoconf." >&2 autoconf fi ### Update getdate.c. (cd lib-src; make -f Makefile getdate.c YACC="bison -y") echo "Updating Info files." (cd man; make info) echo "Updating finder-inf.el." ### update finder-inf.el. (cd lisp; ../src/emacs -batch -l finder -f finder-compile-keywords) (cd lisp; ../src/emacs -batch -f batch-byte-compile finder-inf.el) echo "Making lisp/MANIFEST" (cd lisp; head -1 *.el | grep '^;' | sed -e 's/;;; //' > MANIFEST) echo "Creating staging directory: \`${tempparent}'" mkdir ${tempparent} tempdir="${tempparent}/${emacsname}" ### This trap ensures that the staging directory will be cleaned up even ### when the script is interrupted in mid-career. if [ "${clean_up}" = yes ]; then trap "echo 'Interrupted...cleaning up the staging directory.'; rm -rf ${tempparent}; exit 1" 1 2 15 fi echo "Creating top directory: \`${tempdir}'" mkdir ${tempdir} ### We copy in the top-level files before creating the subdirectories in ### hopes that this will make the top-level files appear first in the ### tar file; this means that people can start reading the INSTALL and ### README while the rest of the tar file is still unpacking. Whoopee. echo "Making links to top-level files." ln GETTING.GNU.SOFTWARE INSTALL PROBLEMS README BUGS move-if-change ${tempdir} ln ChangeLog Makefile.in configure configure.in ${tempdir} ln config.bat make-dist update-subdirs vpath.sed ${tempdir} ### Copy these files; they're cross-filesystem symlinks. cp mkinstalldirs ${tempdir} cp config.sub ${tempdir} cp config.guess ${tempdir} cp install.sh ${tempdir} echo "Updating version number in README." (cd ${tempdir} awk \ '$1 " " $2 " " $3 " " $4 " " $5 == "This directory tree holds version" { $6 = version; print $0 } $1 " " $2 " " $3 " " $4 " " $5 != "This directory tree holds version"' \ version=${version} README > tmp.README mv tmp.README README) echo "Creating subdirectories." for subdir in lisp lisp/term site-lisp \ src src/m src/s src/bitmaps lib-src oldXMenu lwlib \ nt nt/inc nt/inc/sys \ etc etc/e lock cpp info man msdos vms; do mkdir ${tempdir}/${subdir} done echo "Making links to \`lisp'." ### Don't distribute TAGS, =*.el files, site-init.el, site-load.el, or default.el. (cd lisp ln [a-zA-Z]*.el ../${tempdir}/lisp ln [a-zA-Z]*.elc ../${tempdir}/lisp ln [a-zA-Z]*.dat ../${tempdir}/lisp ## simula.el doesn't keep abbreviations in simula.defns any more. ## ln [a-zA-Z]*.defns ../${tempdir}/lisp ln ChangeLog Makefile makefile.nt ChangeLog.? README dired.todo ../${tempdir}/lisp cd ../${tempdir}/lisp rm -f TAGS =* rm -f subdirs.el rm -f site-init site-init.el site-init.elc rm -f site-load site-load.el site-load.elc rm -f site-start site-start.el site-start.elc rm -f default default.el default.elc) #echo "Making links to \`lisp/calc-2.02'." #### Don't distribute =*.el files, TAGS or backups. #(cd lisp/calc-2.02 # ln [a-zA-Z]*.el ../../${tempdir}/lisp/calc-2.02 # ln [a-zA-Z]*.elc ../../${tempdir}/lisp/calc-2.02 # ln calc.info* calc.texinfo calc-refcard.* ../../${tempdir}/lisp/calc-2.02 # ln INSTALL Makefile README README.prev ../../${tempdir}/lisp/calc-2.02 # cd ../../${tempdir}/lisp/calc-2.02 # rm -f *~ TAGS) echo "Making links to \`lisp/term'." ### Don't distribute =*.el files or TAGS. (cd lisp/term ln [a-zA-Z]*.el ../../${tempdir}/lisp/term ln [a-zA-Z]*.elc ../../${tempdir}/lisp/term ln README ../../${tempdir}/lisp/term rm -f =* TAGS) echo "Making links to \`src'." ### Don't distribute =*.[ch] files, or the configured versions of ### config.in, paths.in, or Makefile.in, or TAGS. (cd src echo " (If we can't link gmalloc.c, that's okay.)" ln [a-zA-Z]*.c ../${tempdir}/src ## Might be a symlink to a file on another filesystem. test -f ../${tempdir}/src/gmalloc.c || cp gmalloc.c ../${tempdir}/src ln [a-zA-Z]*.h ../${tempdir}/src ln [a-zA-Z]*.s ../${tempdir}/src ln README Makefile.in ChangeLog ChangeLog.? config.in paths.in \ ../${tempdir}/src ln makefile.nt ../${tempdir}/src ln .gdbinit .dbxinit ../${tempdir}/src ln *.opt vms-pp.trans ../${tempdir}/src cd ../${tempdir}/src rm -f config.h paths.h Makefile Makefile.c rm -f =* TAGS) echo "Making links to \`src/bitmaps'." (cd src/bitmaps ln README *.xbm ../../${tempdir}/src/bitmaps) echo "Making links to \`src/m'." (cd src/m # We call files for miscellaneous input (to linker etc) .inp. ln README [a-zA-Z0-9]*.h *.inp ../../${tempdir}/src/m) echo "Making links to \`src/s'." (cd src/s ln README [a-zA-Z0-9]*.h ../../${tempdir}/src/s) echo "Making links to \`lib-src'." (cd lib-src ln [a-zA-Z]*.[chy] ../${tempdir}/lib-src ln ChangeLog Makefile.in README testfile vcdiff ../${tempdir}/lib-src ln emacs.csh rcs2log rcs-checkin makefile.nt ../${tempdir}/lib-src cd ../${tempdir}/lib-src rm -f getdate.tab.c y.tab.c y.tab.h Makefile.c rm -f =* TAGS) echo "Making links to \`nt'." (cd nt ln emacs.ico emacs.rc config.nt config.w95 [a-z]*.in [a-z]*.c ../${tempdir}/nt ln [a-z]*.bat [a-z]*.h makefile.def makefile.nt ../${tempdir}/nt ln TODO ChangeLog INSTALL README ../${tempdir}/nt) echo "Making links to \`nt/inc'." (cd nt/inc ln [a-z]*.h ../../${tempdir}/nt/inc) echo "Making links to \`nt/inc/sys'." (cd nt/inc/sys ln [a-z]*.h ../../../${tempdir}/nt/inc/sys) echo "Making links to \`msdos'." (cd msdos ln ChangeLog emacs.ico emacs.pif ../${tempdir}/msdos ln mainmake sed*.inp ../${tempdir}/msdos cd ../${tempdir}/msdos rm -f =*) echo "Making links to \`oldXMenu'." (cd oldXMenu ln *.c *.h *.in ../${tempdir}/oldXMenu ln README Imakefile ChangeLog ../${tempdir}/oldXMenu ln compile.com descrip.mms ../${tempdir}/oldXMenu) echo "Making links to \`lwlib'." (cd lwlib ln *.c *.h *.in ../${tempdir}/lwlib ln README Imakefile ChangeLog ../${tempdir}/lwlib) echo "Making links to \`etc'." ### Don't distribute = files, TAGS, DOC files, backups, autosaves, or ### tex litter. (cd etc ln `ls -d * | grep -v 'RCS' | grep -v 'Old' | grep -v '^e$'` ../${tempdir}/etc cd ../${tempdir}/etc rm -f DOC* *~ \#*\# *.dvi *.log *.orig *.rej *,v =* core rm -f TAGS) echo "Making links to \`etc/e'." (cd etc/e ln `ls -d * | grep -v 'RCS'` ../../${tempdir}/etc/e cd ../../${tempdir}/etc/e rm -f *~ \#*\# *,v =* core) echo "Making links to \`cpp'." (cd cpp ln cccp.c cexp.y Makefile README ../${tempdir}/cpp) echo "Making links to \`info'." # Don't distribute backups or autosaves. (cd info ln [a-zA-Z]* ../${tempdir}/info cd ../${tempdir}/info # Avoid an error when expanding the wildcards later. ln emacs dummy~ ; ln emacs \#dummy\# rm -f *~ \#*\# core) echo "Making links to \`man'." (cd man ln *.texi *.aux *.cps *.fns *.kys *.vrs ../${tempdir}/man test -f README && ln README ../${tempdir}/man test -f Makefile.in && ln Makefile.in ../${tempdir}/man ln ChangeLog split-man ../${tempdir}/man cp texinfo.tex ../${tempdir}/man cd ../${tempdir}/man rm -f \#*\# =* *~ core emacs-index* *.Z *.z xmail rm -f emacs.?? termcap.?? gdb.?? *.log *.toc *.dvi *.oaux) echo "Making links to \`vms'." (cd vms ln [0-9a-zA-Z]* ../${tempdir}/vms cd ../${tempdir}/vms rm -f *~) ### It would be nice if they could all be symlinks to etc's copy, but ### you're not supposed to have any symlinks in distribution tar files. echo "Making sure copying notices are all copies of \`etc/COPYING'." rm -f ${tempdir}/etc/COPYING cp etc/COPYING ${tempdir}/etc/COPYING for subdir in lisp src lib-src info msdos; do if [ -f ${tempdir}/${subdir}/COPYING ]; then rm ${tempdir}/${subdir}/COPYING fi cp etc/COPYING ${tempdir}/${subdir} done #### Make sure that there aren't any hard links between files in the #### distribution; people with afs can't deal with that. Okay, #### actually we just re-copy anything with a link count greater #### than two. (Yes, strictly greater than 2 is correct; since we #### created these files by linking them in from the original tree, #### they'll have exactly two links normally.) #### #### Commented out since it's not stricly necessary; it should suffice #### to just break the link on alloca.c. #echo "Breaking intra-tree links." #find ${tempdir} ! -type d -links +2 \ # -exec cp -p {} $$ \; -exec rm -f {} \; -exec mv $$ {} \; rm -f $tempdir/lib-src/alloca.c cp $tempdir/src/alloca.c $tempdir/lib-src/alloca.c if [ "${newer}" ]; then echo "Removing files older than $newer." ## We remove .elc files unconditionally, on the theory that anyone picking ## up an incremental distribution already has a running Emacs to byte-compile ## them with. find ${tempparent} \( -name '*.elc' -o ! -newer ${newer} \) -exec rm -f {} \; fi if [ "${make_tar}" = yes ]; then if [ "${default_gzip}" = "" ]; then echo "Looking for gzip." temppath=`echo $PATH | sed 's/^:/.:/ s/::/:.:/g s/:$/:./ s/:/ /g'` default_gzip=`( for dir in ${temppath}; do if [ -f ${dir}/gzip ]; then echo 'gzip --best'; exit 0; fi done echo compress )` fi case "${default_gzip}" in compress* ) gzip_extension=.Z ;; * ) gzip_extension=.gz ;; esac echo "Creating tar file." (cd ${tempparent} ; tar cvf - ${emacsname} ) \ | ${default_gzip} \ > ${emacsname}.tar${gzip_extension} fi if [ "${clean_up}" = yes ]; then echo "Cleaning up the staging directory." rm -rf ${tempparent} else (cd ${tempparent}; mv ${emacsname} ..) rm -rf ${tempparent} fi ### make-dist ends here emacs-19.30/update-subdirs100777 12120 1 736 5753567355 14001 0ustar rmsdaemon#!/bin/sh # Write into $1/subdirs.el a list of subdirs of directory $1. cd $1 for file in *; do case $file in *.elc | *.el | term | RCS | . | .. | =* | *~ | *.orig | *.rej) ;; *) if [ -d $file ]; then subdirs="\"$file\" $subdirs" fi ;; esac done echo ";; In load-path, after this directory should come ;; certain of its subdirectories. Here we specify them." > subdirs.el echo "(normal-top-level-add-to-load-path '($subdirs))" >> subdirs.el emacs-19.30/vpath.sed100444 75424 1 333 5756450602 13111 0ustar kwzhdaemon/^VPATH *=/c\ # This works only in GNU make. Using the patterns avoids\ # object files being found by VPATH, and thus permits building\ # when $srcdir is configured itself.\ vpath %.c $(srcdir)\ vpath %.h $(srcdir)\ \ emacs-19.30/mkinstalldirs100555 12120 1 1136 6055530464 13716 0ustar rmsdaemon#! /bin/sh # mkinstalldirs --- make directory hierarchy # Author: Noah Friedman # Created: 1993-05-16 # Public domain errstatus=0 for file do set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'` shift pathcomp= for d in ${1+"$@"} ; do pathcomp="$pathcomp$d" case "$pathcomp" in -* ) pathcomp=./$pathcomp ;; esac if test ! -d "$pathcomp"; then echo "mkdir $pathcomp" 1>&2 mkdir "$pathcomp" || errstatus=$? fi pathcomp="$pathcomp/" done done exit $errstatus # mkinstalldirs ends here emacs-19.30/config.sub100555 12120 1 41144 6055530465 13117 0ustar rmsdaemon#! /bin/sh # Configuration validation subroutine script, version 1.1. # Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. # This file is (in principle) common to ALL GNU software. # The presence of a machine in this file suggests that SOME GNU software # can handle that machine. It does not imply ALL GNU software can. # # This file is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. # Each package is responsible for reporting which valid configurations # it does not support. The user should be able to distinguish # a failure to support a valid configuration from a meaningless # configuration. # The goal of this file is to map all the various variations of a given # machine specification into a single specification in the form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM # It is wrong to echo any other type of specification. if [ x$1 = x ] then echo Configuration name missing. 1>&2 echo "Usage: $0 CPU-MFR-OPSYS" 1>&2 echo "or $0 ALIAS" 1>&2 echo where ALIAS is a recognized configuration type. 1>&2 exit 1 fi # First pass through any local machine types. case $1 in *local*) echo $1 exit 0 ;; *) ;; esac # Separate what the user gave into CPU-COMPANY and OS (if any). basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] then os=`echo $1 | sed 's/.*-/-/'` else os=; fi ### Let's recognize common machines as not being operating systems so ### that things like config.sub decstation-3100 work. We also ### recognize some manufacturers as not being operating systems, so we ### can provide default operating systems below. case $os in -sun*os*) # Prevent following clause from handling this invalid input. ;; -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp ) os= basic_machine=$1 ;; -hiux*) os=-hiuxwe2 ;; -sco4) os=-sco3.2v4 basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; -sco3.2.[4-9]*) os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; -sco3.2v[4-9]*) # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; -sco*) os=-sco3.2v2 basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; -isc) os=-isc2.2 basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; -clix*) basic_machine=clipper-intergraph ;; -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; -lynx*) os=-lynxos ;; -ptx*) basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` ;; -windowsnt*) os=`echo $os | sed -e 's/windowsnt/winnt/'` ;; esac # Decode aliases for certain CPU-COMPANY combinations. case $basic_machine in # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. tahoe | i[345]86 | i860 | m68k | m68000 | m88k | ns32k | arm | pyramid \ | tron | a29k | 580 | i960 | h8300 | hppa1.0 | hppa1.1 \ | alpha | we32k | ns16k | clipper | sparclite | i370 | sh \ | powerpc | sparc64 | 1750a | dsp16xx | mips64 | mipsel \ | pdp11 | mips64el | mips64orion | mips64orionel \ | sparc) basic_machine=$basic_machine-unknown ;; # Object if more than one company name word. *-*-*) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; # Recognize the basic CPU types with company name. vax-* | tahoe-* | i[345]86-* | i860-* | m68k-* | m68000-* | m88k-* \ | sparc-* | ns32k-* | fx80-* | arm-* | c[123]* \ | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \ | none-* | 580-* | cray2-* | h8300-* | i960-* | xmp-* | ymp-* \ | hppa1.0-* | hppa1.1-* | alpha-* | we32k-* | cydra-* | ns16k-* \ | pn-* | np1-* | xps100-* | clipper-* | orion-* | sparclite-* \ | pdp11-* | sh-* | powerpc-* | sparc64-* | mips64-* | mipsel-* \ | mips64el-* | mips64orion-* | mips64orionel-*) ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) basic_machine=m68000-att ;; 3b*) basic_machine=we32k-att ;; alliant | fx80) basic_machine=fx80-alliant ;; altos | altos3068) basic_machine=m68k-altos ;; am29k) basic_machine=a29k-none os=-bsd ;; amdahl) basic_machine=580-amdahl os=-sysv ;; amiga | amiga-*) basic_machine=m68k-cbm ;; amigados) basic_machine=m68k-cbm os=-amigados ;; amigaunix | amix) basic_machine=m68k-cbm os=-sysv4 ;; apollo68) basic_machine=m68k-apollo os=-sysv ;; balance) basic_machine=ns32k-sequent os=-dynix ;; convex-c1) basic_machine=c1-convex os=-bsd ;; convex-c2) basic_machine=c2-convex os=-bsd ;; convex-c32) basic_machine=c32-convex os=-bsd ;; convex-c34) basic_machine=c34-convex os=-bsd ;; convex-c38) basic_machine=c38-convex os=-bsd ;; cray | ymp) basic_machine=ymp-cray os=-unicos ;; cray2) basic_machine=cray2-cray os=-unicos ;; crds | unos) basic_machine=m68k-crds ;; da30 | da30-*) basic_machine=m68k-da30 ;; decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) basic_machine=mips-dec ;; delta | 3300 | motorola-3300 | motorola-delta \ | 3300-motorola | delta-motorola) basic_machine=m68k-motorola ;; delta88) basic_machine=m88k-motorola os=-sysv3 ;; dpx20 | dpx20-*) basic_machine=rs6000-bull os=-bosx ;; dpx2* | dpx2*-bull) basic_machine=m68k-bull os=-sysv3 ;; ebmon29k) basic_machine=a29k-amd os=-ebmon ;; elxsi) basic_machine=elxsi-elxsi os=-bsd ;; encore | umax | mmax) basic_machine=ns32k-encore ;; fx2800) basic_machine=i860-alliant ;; genix) basic_machine=ns32k-ns ;; gmicro) basic_machine=tron-gmicro os=-sysv ;; h3050r* | hiux*) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; h8300hms) basic_machine=h8300-hitachi os=-hms ;; harris) basic_machine=m88k-harris os=-sysv3 ;; hp300-*) basic_machine=m68k-hp ;; hp300bsd) basic_machine=m68k-hp os=-bsd ;; hp300hpux) basic_machine=m68k-hp os=-hpux ;; hp9k2[0-9][0-9] | hp9k31[0-9]) basic_machine=m68000-hp ;; hp9k3[2-9][0-9]) basic_machine=m68k-hp ;; hp9k7[0-9][0-9] | hp7[0-9][0-9] | hp9k8[0-9]7 | hp8[0-9]7) basic_machine=hppa1.1-hp ;; hp9k8[0-9][0-9] | hp8[0-9][0-9]) basic_machine=hppa1.0-hp ;; i370-ibm* | ibm*) basic_machine=i370-ibm os=-mvs ;; # I'm not sure what "Sysv32" means. Should this be sysv3.2? i[345]86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'` os=-sysv32 ;; i[345]86v4*) basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'` os=-sysv4 ;; i[345]86v) basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'` os=-sysv ;; i[345]86sol2) basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'` os=-solaris2 ;; iris | iris4d) basic_machine=mips-sgi case $os in -irix*) ;; *) os=-irix4 ;; esac ;; isi68 | isi) basic_machine=m68k-isi os=-sysv ;; m88k-omron*) basic_machine=m88k-omron ;; magnum | m3230) basic_machine=mips-mips os=-sysv ;; merlin) basic_machine=ns32k-utek os=-sysv ;; miniframe) basic_machine=m68000-convergent ;; mips3*-*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` ;; mips3*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown ;; ncr3000) basic_machine=i486-ncr os=-sysv4 ;; news | news700 | news800 | news900) basic_machine=m68k-sony os=-newsos ;; news1000) basic_machine=m68030-sony os=-newsos ;; news-3600 | risc-news) basic_machine=mips-sony os=-newsos ;; next | m*-next ) basic_machine=m68k-next case $os in -nextstep* ) ;; -ns2*) os=-nextstep2 ;; *) os=-nextstep3 ;; esac ;; nh3000) basic_machine=m68k-harris os=-cxux ;; nh[45]000) basic_machine=m88k-harris os=-cxux ;; nindy960) basic_machine=i960-intel os=-nindy ;; np1) basic_machine=np1-gould ;; pa-hitachi) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; paragon) basic_machine=i860-intel os=-osf ;; pbd) basic_machine=sparc-tti ;; pbb) basic_machine=m68k-tti ;; pc532 | pc532-*) basic_machine=ns32k-pc532 ;; pentium-*) # We will change tis to say i586 once there has been # time for various packages to start to recognize that. basic_machine=i486-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pn) basic_machine=pn-gould ;; ps2) basic_machine=i386-ibm ;; rm[46]00) basic_machine=mips-siemens ;; rtpc | rtpc-*) basic_machine=romp-ibm ;; sequent) basic_machine=i386-sequent ;; sh) basic_machine=sh-hitachi os=-hms ;; sps7) basic_machine=m68k-bull os=-sysv2 ;; spur) basic_machine=spur-unknown ;; sun2) basic_machine=m68000-sun ;; sun2os3) basic_machine=m68000-sun os=-sunos3 ;; sun2os4) basic_machine=m68000-sun os=-sunos4 ;; sun3os3) basic_machine=m68k-sun os=-sunos3 ;; sun3os4) basic_machine=m68k-sun os=-sunos4 ;; sun4os3) basic_machine=sparc-sun os=-sunos3 ;; sun4os4) basic_machine=sparc-sun os=-sunos4 ;; sun4sol2) basic_machine=sparc-sun os=-solaris2 ;; sun3 | sun3-*) basic_machine=m68k-sun ;; sun4) basic_machine=sparc-sun ;; sun386 | sun386i | roadrunner) basic_machine=i386-sun ;; symmetry) basic_machine=i386-sequent os=-dynix ;; tower | tower-32) basic_machine=m68k-ncr ;; udi29k) basic_machine=a29k-amd os=-udi ;; ultra3) basic_machine=a29k-nyu os=-sym1 ;; vaxv) basic_machine=vax-dec os=-sysv ;; vms) basic_machine=vax-dec os=-vms ;; vxworks960) basic_machine=i960-wrs os=-vxworks ;; vxworks68) basic_machine=m68k-wrs os=-vxworks ;; xmp) basic_machine=xmp-cray os=-unicos ;; xps | xps100) basic_machine=xps100-honeywell ;; none) basic_machine=none-none os=-none ;; # Here we handle the default manufacturer of certain CPU types. It is in # some cases the only manufacturer, in others, it is the most popular. mips) basic_machine=mips-mips ;; romp) basic_machine=romp-ibm ;; rs6000) basic_machine=rs6000-ibm ;; vax) basic_machine=vax-dec ;; pdp11) basic_machine=pdp11-dec ;; we32k) basic_machine=we32k-att ;; sparc) basic_machine=sparc-sun ;; cydra) basic_machine=cydra-cydrome ;; orion) basic_machine=orion-highlevel ;; orion105) basic_machine=clipper-highlevel ;; *) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; esac # Here we canonicalize certain aliases for manufacturers. case $basic_machine in *-digital*) basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` ;; *-commodore*) basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` ;; *) ;; esac # Decode manufacturer-specific aliases for certain operating systems. if [ x"$os" != x"" ] then case $os in # -solaris* is a basic system type, with this one exception. -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; -solaris) os=-solaris2 ;; -unixware* | svr4*) os=-sysv4 ;; -gnu/linux*) os=`echo $os | sed -e 's|gnu/linux|linux|'` ;; # First accept the basic system types. # The portable systems comes first. # Each alternative must end in a *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ | -vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[345]* \ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ | -amigados* | -msdos* | -newsos* | -unicos* | -aos* \ | -nindy* | -vxworks* | -ebmon* | -hms* | -mvs* | -clix* \ | -riscos* | -linux* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -netbsd* | -freebsd* | -riscix* \ | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta | -udi | -eabi) ;; -sunos5*) os=`echo $os | sed -e 's|sunos5|solaris2|'` ;; -sunos6*) os=`echo $os | sed -e 's|sunos6|solaris3|'` ;; -osfrose*) os=-osfrose ;; -osf*) os=-osf ;; -utek*) os=-bsd ;; -dynix*) os=-bsd ;; -acis*) os=-aos ;; -ctix* | -uts*) os=-sysv ;; # Preserve the version number of sinix5. -sinix5.*) os=`echo $os | sed -e 's|sinix|sysv|'` ;; -sinix*) os=-sysv4 ;; -triton*) os=-sysv3 ;; -oss*) os=-sysv3 ;; -svr4) os=-sysv4 ;; -svr3) os=-sysv3 ;; -sysvr4) os=-sysv4 ;; # This must come after -sysvr4. -sysv*) ;; -xenix) os=-xenix ;; -none) ;; *) # Get rid of the `-' at the beginning of $os. os=`echo $os | sed 's/[^-]*-//'` echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 exit 1 ;; esac else # Here we handle the default operating systems that come with various machines. # The value should be what the vendor currently ships out the door with their # machine or put another way, the most popular os provided with the machine. # Note that if you're going to try to match "-MANUFACTURER" here (say, # "-sun"), then you have to tell the case statement up towards the top # that MANUFACTURER isn't an operating system. Otherwise, code above # will signal an error saying that MANUFACTURER isn't an operating # system, and we'll never get to this point. case $basic_machine in *-acorn) os=-riscix1.2 ;; pdp11-*) os=-none ;; *-dec | vax-*) os=-ultrix4.2 ;; m68*-apollo) os=-domain ;; i386-sun) os=-sunos4.0.2 ;; m68000-sun) os=-sunos3 # This also exists in the configure program, but was not the # default. # os=-sunos4 ;; *-tti) # must be before sparc entry or we get the wrong os. os=-sysv3 ;; sparc-* | *-sun) os=-sunos4.1.1 ;; *-ibm) os=-aix ;; *-hp) os=-hpux ;; *-hitachi) os=-hiux ;; i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) os=-sysv ;; *-cbm) os=-amigados ;; *-dg) os=-dgux ;; *-dolphin) os=-sysv3 ;; m68k-ccur) os=-rtu ;; m88k-omron*) os=-luna ;; *-sequent) os=-ptx ;; *-crds) os=-unos ;; *-ns) os=-genix ;; i370-*) os=-mvs ;; *-next) os=-nextstep3 ;; *-gould) os=-sysv ;; *-highlevel) os=-bsd ;; *-encore) os=-bsd ;; *-sgi) os=-irix ;; *-siemens) os=-sysv4 ;; *-masscomp) os=-rtu ;; *) os=-none ;; esac fi # Here we handle the case where we know the os, and the CPU type, but not the # manufacturer. We pick the logical manufacturer. vendor=unknown case $basic_machine in *-unknown) case $os in -riscix*) vendor=acorn ;; -sunos*) vendor=sun ;; -lynxos*) vendor=lynx ;; -aix*) vendor=ibm ;; -hpux*) vendor=hp ;; -hiux*) vendor=hitachi ;; -unos*) vendor=crds ;; -dgux*) vendor=dg ;; -luna*) vendor=omron ;; -genix*) vendor=ns ;; -mvs*) vendor=ibm ;; -ptx*) vendor=sequent ;; -vxworks*) vendor=wrs ;; esac basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` ;; esac echo $basic_machine$os emacs-19.30/config.guess100555 12120 1 37241 6055530465 13457 0ustar rmsdaemon#! /bin/sh # Attempt to guess a canonical system name. # Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. # # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Written by Per Bothner . # The master version of this file is at the FSF in /home/gd/gnu/lib. # # This script attempts to guess a canonical system name similar to # config.sub. If it succeeds, it prints the system name on stdout, and # exits with 0. Otherwise, it exits with 1. # # The plan is that this can be called by configure scripts if you # don't specify an explicit system type (host/target name). # # Only a few systems have been added to this list; please add others # (but try to keep the structure clean). # # This is needed to find uname on a Pyramid OSx when run in the BSD universe. # (ghazi@noc.rutgers.edu 8/24/94.) if (test -f /.attbin/uname) >/dev/null 2>&1 ; then PATH=$PATH:/.attbin ; export PATH fi UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown trap 'rm -f dummy.c dummy.o dummy; exit 1' 1 2 15 # Note: order is significant - the case branches are not exclusive. case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in alpha:OSF1:V*:*) # After 1.2, OSF1 uses "V1.3" for uname -r. echo alpha-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^V//'` exit 0 ;; alpha:OSF1:*:*) # 1.2 uses "1.2" for uname -r. echo alpha-dec-osf${UNAME_RELEASE} exit 0 ;; 21064:Windows_NT:50:3) echo alpha-dec-winnt3.5 exit 0 ;; amiga:NetBSD:*:*) echo m68k-cbm-netbsd${UNAME_RELEASE} exit 0 ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit 0;; Pyramid*:OSx*:*:*) if test "`(/bin/universe) 2>/dev/null`" = att ; then echo pyramid-pyramid-sysv3 else echo pyramid-pyramid-bsd fi exit 0 ;; sun4*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit 0 ;; i86pc:SunOS:5.*:*) echo i386-unknown-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:*:*) case "`/usr/bin/arch -k`" in Series*|S4*) UNAME_RELEASE=`uname -v` ;; esac # Japanese Language versions have a version number like `4.1.3-JL'. echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` exit 0 ;; sun3*:SunOS:*:*) echo m68k-sun-sunos${UNAME_RELEASE} exit 0 ;; atari*:NetBSD:*:*) echo m68k-atari-netbsd${UNAME_RELEASE} exit 0 ;; sun3*:NetBSD:*:*) echo m68k-sun-netbsd${UNAME_RELEASE} exit 0 ;; mac68k:NetBSD:*:*) echo m68k-apple-netbsd${UNAME_RELEASE} exit 0 ;; RISC*:ULTRIX:*:*) echo mips-dec-ultrix${UNAME_RELEASE} exit 0 ;; VAX*:ULTRIX*:*:*) echo vax-dec-ultrix${UNAME_RELEASE} exit 0 ;; mips:*:4*:UMIPS) echo mips-mips-riscos4sysv exit 0 ;; mips:*:5*:RISCos) echo mips-mips-riscos${UNAME_RELEASE} exit 0 ;; m88k:CX/UX:7*:*) echo m88k-harris-cxux7 exit 0 ;; m88k:*:4*:R4*) echo m88k-motorola-sysv4 exit 0 ;; m88k:*:3*:R3*) echo m88k-motorola-sysv3 exit 0 ;; AViiON:dgux:*:*) if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx \ -o ${TARGET_BINARY_INTERFACE}x = x ] ; then echo m88k-dg-dgux${UNAME_RELEASE} else echo m88k-dg-dguxbcs${UNAME_RELEASE} fi exit 0 ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit 0 ;; M88*:*:R3*:*) # Delta 88k system running SVR3 echo m88k-motorola-sysv3 exit 0 ;; XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) echo m88k-tektronix-sysv3 exit 0 ;; Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) echo m68k-tektronix-bsd exit 0 ;; *:IRIX*:*:*) echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` exit 0 ;; ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX ' i[34]86:AIX:*:*) echo i386-ibm-aix exit 0 ;; *:AIX:2:3) if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then sed 's/^ //' << EOF >dummy.c #include main() { if (!__power_pc()) exit(1); puts("powerpc-ibm-aix3.2.5"); exit(0); } EOF ${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0 rm -f dummy.c dummy echo rs6000-ibm-aix3.2.5 elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then echo rs6000-ibm-aix3.2.4 else echo rs6000-ibm-aix3.2 fi exit 0 ;; *:AIX:*:4) if /usr/sbin/lsattr -EHl proc0 | grep POWER >/dev/null 2>&1; then IBM_ARCH=rs6000 else IBM_ARCH=powerpc fi if [ -x /usr/bin/oslevel ] ; then IBM_REV=`/usr/bin/oslevel` else IBM_REV=4.${UNAME_RELEASE} fi echo ${IBM_ARCH}-ibm-aix${IBM_REV} exit 0 ;; *:AIX:*:*) echo rs6000-ibm-aix exit 0 ;; ibmrt:4.4BSD:*|romp-ibm:BSD:*) echo romp-ibm-bsd4.4 exit 0 ;; ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC NetBSD and echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to exit 0 ;; # report: romp-ibm BSD 4.3 *:BOSX:*:*) echo rs6000-bull-bosx exit 0 ;; DPX/2?00:B.O.S.:*:*) echo m68k-bull-sysv3 exit 0 ;; 9000/[34]??:4.3bsd:1.*:*) echo m68k-hp-bsd exit 0 ;; hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) echo m68k-hp-bsd4.4 exit 0 ;; 9000/[3478]??:HP-UX:*:*) case "${UNAME_MACHINE}" in 9000/31? ) HP_ARCH=m68000 ;; 9000/[34]?? ) HP_ARCH=m68k ;; 9000/7?? | 9000/8?[79] ) HP_ARCH=hppa1.1 ;; 9000/8?? ) HP_ARCH=hppa1.0 ;; esac HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` echo ${HP_ARCH}-hp-hpux${HPUX_REV} exit 0 ;; 3050*:HI-UX:*:*) sed 's/^ //' << EOF >dummy.c #include int main () { long cpu = sysconf (_SC_CPU_VERSION); /* The order matters, because CPU_IS_HP_MC68K erroneously returns true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct results, however. */ if (CPU_IS_PA_RISC (cpu)) { switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; default: puts ("hppa-hitachi-hiuxwe2"); break; } } else if (CPU_IS_HP_MC68K (cpu)) puts ("m68k-hitachi-hiuxwe2"); else puts ("unknown-hitachi-hiuxwe2"); exit (0); } EOF ${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0 rm -f dummy.c dummy echo unknown-hitachi-hiuxwe2 exit 0 ;; 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) echo hppa1.1-hp-bsd exit 0 ;; 9000/8??:4.3bsd:*:*) echo hppa1.0-hp-bsd exit 0 ;; hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) echo hppa1.1-hp-osf exit 0 ;; hp8??:OSF1:*:*) echo hppa1.0-hp-osf exit 0 ;; parisc*:Lites*:*:*) echo hppa1.1-hp-lites exit 0 ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd exit 0 ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit 0 ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd exit 0 ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd exit 0 ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd exit 0 ;; CRAY*X-MP:*:*:*) echo xmp-cray-unicos exit 0 ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} exit 0 ;; CRAY*C90:*:*:*) echo c90-cray-unicos${UNAME_RELEASE} exit 0 ;; CRAY-2:*:*:*) echo cray2-cray-unicos exit 0 ;; hp3[0-9][05]:NetBSD:*:*) echo m68k-hp-netbsd${UNAME_RELEASE} exit 0 ;; i[34]86:BSD/386:*:* | *:BSD/OS:*:*) echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit 0 ;; *:FreeBSD:*:*) echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit 0 ;; *:NetBSD:*:*) echo ${UNAME_MACHINE}-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` exit 0 ;; *:GNU:*:*) echo `echo ${UNAME_MACHINE}|sed -e 's,/.*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` exit 0 ;; *:Linux:*:*) # The BFD linker knows what the default object file format is, so # first see if it will tell us. ld_help_string=`ld --help 2>&1` if echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: elf_i[345]86"; then echo "${UNAME_MACHINE}-unknown-linux" ; exit 0 elif echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i[345]86linux"; then echo "${UNAME_MACHINE}-unknown-linuxaout" ; exit 0 elif echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i[345]86coff"; then echo "${UNAME_MACHINE}-unknown-linuxcoff" ; exit 0 elif test "${UNAME_MACHINE}" = "alpha" ; then echo alpha-unknown-linux ; exit 0 else # Either a pre-BFD a.out linker (linuxoldld) or one that does not give us # useful --help. Gcc wants to distinguish between linuxoldld and linuxaout. test ! -d /usr/lib/ldscripts/. \ && echo "${UNAME_MACHINE}-unknown-linuxoldld" && exit 0 # Determine whether the default compiler is a.out or elf cat >dummy.c </dev/null && ./dummy "${UNAME_MACHINE}" && rm dummy.c dummy && exit 0 rm -f dummy.c dummy fi ;; # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. earlier versions # are messed up and put the nodename in both sysname and nodename. i[34]86:DYNIX/ptx:4*:*) echo i386-sequent-sysv4 exit 0 ;; i[34]86:*:4.*:* | i[34]86:SYSTEM_V: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:*) if test -f /usr/options/cb.name; then UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')` (/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486 echo ${UNAME_MACHINE}-unknown-sco$UNAME_REL else echo ${UNAME_MACHINE}-unknown-sysv32 fi exit 0 ;; Intel:Mach:3*:*) echo i386-unknown-mach3 exit 0 ;; paragon:*:*:*) echo i860-intel-osf1 exit 0 ;; i860:*:4.*:*) # i860-SVR4 if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 else # Add other i860-SVR4 vendors below as they are discovered. echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 fi exit 0 ;; mini*:CTIX:SYS*5:*) # "miniframe" echo m68010-convergent-sysv exit 0 ;; M680[234]0:*:R3V[567]*:*) test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;; 3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0) uname -p 2>/dev/null | grep 86 >/dev/null \ && echo i486-ncr-sysv4.3 && exit 0 ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) uname -p 2>/dev/null | grep 86 >/dev/null \ && echo i486-ncr-sysv4 && exit 0 ;; m680[234]0:LynxOS:2.[23]*:*) echo m68k-lynx-lynxos${UNAME_RELEASE} exit 0 ;; mc68030:UNIX_System_V:4.*:*) echo m68k-atari-sysv4 exit 0 ;; i[34]86:LynxOS:2.[23]*:*) echo i386-lynx-lynxos${UNAME_RELEASE} exit 0 ;; TSUNAMI:LynxOS:2.[23]*:*) echo sparc-lynx-lynxos${UNAME_RELEASE} exit 0 ;; rs6000:LynxOS:2.[23]*:*) echo rs6000-lynx-lynxos${UNAME_RELEASE} exit 0 ;; RM*:SINIX-*:*:*) echo mips-sni-sysv4 exit 0 ;; *:SINIX-*:*:*) if uname -p 2>/dev/null >/dev/null ; then UNAME_MACHINE=`(uname -p) 2>/dev/null` echo ${UNAME_MACHINE}-sni-sysv4 else echo ns32k-sni-sysv fi 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 cat >dummy.c < # include #endif main () { #if defined (sony) #if defined (MIPSEB) /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, I don't know.... */ printf ("mips-sony-bsd\n"); exit (0); #else #include printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 "4" #else "" #endif ); exit (0); #endif #endif #if defined (__arm) && defined (__acorn) && defined (__unix) printf ("arm-acorn-riscix"); exit (0); #endif #if defined (hp300) && !defined (hpux) printf ("m68k-hp-bsd\n"); exit (0); #endif #if defined (NeXT) #if !defined (__ARCHITECTURE__) #define __ARCHITECTURE__ "m68k" #endif int version; version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; printf ("%s-next-nextstep%s\n", __ARCHITECTURE__, version==2 ? "2" : "3"); exit (0); #endif #if defined (MULTIMAX) || defined (n16) #if defined (UMAXV) printf ("ns32k-encore-sysv\n"); exit (0); #else #if defined (CMU) printf ("ns32k-encore-mach\n"); exit (0); #else printf ("ns32k-encore-bsd\n"); exit (0); #endif #endif #endif #if defined (__386BSD__) printf ("i386-unknown-bsd\n"); exit (0); #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_) struct utsname un; uname(&un); if (strncmp(un.version, "V2", 2) == 0) { printf ("i386-sequent-ptx2\n"); exit (0); } if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ printf ("i386-sequent-ptx1\n"); exit (0); } printf ("i386-sequent-ptx\n"); exit (0); #endif #if defined (vax) #if !defined (ultrix) printf ("vax-dec-bsd\n"); exit (0); #else printf ("vax-dec-ultrix\n"); exit (0); #endif #endif #if defined (alliant) && defined (i860) printf ("i860-alliant-bsd\n"); exit (0); #endif exit (1); } EOF ${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy && rm dummy.c dummy && exit 0 rm -f dummy.c dummy # Apollos put the system type in the environment. test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; } # Convex versions that predate uname can use getsysinfo(1) if [ -x /usr/convex/getsysinfo ] then case `getsysinfo -f cpu_type` in c1*) echo c1-convex-bsd exit 0 ;; c2*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit 0 ;; c34*) echo c34-convex-bsd exit 0 ;; c38*) echo c38-convex-bsd exit 0 ;; c4*) echo c4-convex-bsd exit 0 ;; esac fi #echo '(Unable to guess system type)' 1>&2 exit 1 emacs-19.30/install.sh100555 12120 1 11244 6055530466 13140 0ustar rmsdaemon#! /bin/sh # # install - install a program, script, or datafile # This comes from X11R5. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. # # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" mkdirprog="${MKDIRPROG-mkdir}" tranformbasename="" transform_arg="" instcmd="$mvprog" chmodcmd="$chmodprog 0755" chowncmd="" chgrpcmd="" stripcmd="" rmcmd="$rmprog -f" mvcmd="$mvprog" src="" dst="" dir_arg="" while [ x"$1" != x ]; do case $1 in -c) instcmd="$cpprog" shift continue;; -d) dir_arg=true shift continue;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; -s) stripcmd="$stripprog" shift continue;; -t=*) transformarg=`echo $1 | sed 's/-t=//'` shift continue;; -b=*) transformbasename=`echo $1 | sed 's/-b=//'` shift continue;; *) if [ x"$src" = x ] then src=$1 else # this colon is to work around a 386BSD /bin/sh bug : dst=$1 fi shift continue;; esac done if [ x"$src" = x ] then echo "install: no input file specified" exit 1 else true fi if [ x"$dir_arg" != x ]; then dst=$src src="" if [ -d $dst ]; then instcmd=: else instcmd=mkdir fi else # Waiting for this to be detected by the "$instcmd $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if [ -f $src -o -d $src ] then true else echo "install: $src does not exist" exit 1 fi if [ x"$dst" = x ] then echo "install: no destination specified" exit 1 else true fi # If destination is a directory, append the input filename; if your system # does not like double slashes in filenames, you may need to add some logic if [ -d $dst ] then dst="$dst"/`basename $src` else true fi fi ## this sed command emulates the dirname command dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` # Make sure that the destination directory exists. # this part is taken from Noah Friedman's mkinstalldirs script # Skip lots of stat calls in the usual case. if [ ! -d "$dstdir" ]; then defaultIFS=' ' IFS="${IFS-${defaultIFS}}" oIFS="${IFS}" # Some sh's can't handle IFS=/ for some reason. IFS='%' set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` IFS="${oIFS}" pathcomp='' while [ $# -ne 0 ] ; do pathcomp="${pathcomp}${1}" shift if [ ! -d "${pathcomp}" ] ; then $mkdirprog "${pathcomp}" else true fi pathcomp="${pathcomp}/" done fi if [ x"$dir_arg" != x ] then $doit $instcmd $dst && if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi else # If we're going to rename the final executable, determine the name now. if [ x"$transformarg" = x ] then dstfile=`basename $dst` else dstfile=`basename $dst $transformbasename | sed $transformarg`$transformbasename fi # don't allow the sed command to completely eliminate the filename if [ x"$dstfile" = x ] then dstfile=`basename $dst` else true fi # Make a temp file name in the proper directory. dsttmp=$dstdir/#inst.$$# # Move or copy the file name to the temp name $doit $instcmd $src $dsttmp && trap "rm -f ${dsttmp}" 0 && # and set any options; do chmod last to preserve setuid bits # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $instcmd $src $dsttmp" command. if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && # Now rename the file to the real destination. $doit $rmcmd -f $dstdir/$dstfile && $doit $mvcmd $dsttmp $dstdir/$dstfile fi && exit 0 emacs-19.30/lisp/ 40777 12120 1 0 6055530745 11771 5ustar rmsdaemonemacs-19.30/lisp/term/ 40777 12120 1 0 6055530624 12734 5ustar rmsdaemonemacs-19.30/lisp/term/AT386.el100466 74777 1 4244 5351764747 14161 0ustar esrdaemon;; AT386.el --- terminal support package for IBM AT keyboards ;; Author: Eric S. Raymond ;; Keywords: terminals ;; Copyright (C) 1992 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: ;;; Uses the Emacs 19 terminal initialization features --- won't work with 18. ;;; Code: (if (boundp 'AT386-keypad-map) nil ;; The terminal initialization should already have set up some keys (setq AT386-keypad-map (lookup-key function-key-map "\e[")) (if (not (keymapp AT386-keypad-map)) (error "What? Your AT386 termcap/terminfo has no keycaps in it.")) ;; Equivalents of these are set up automatically by termcap/terminfo ;; (define-key AT386-keypad-map "A" [up]) ;; (define-key AT386-keypad-map "B" [down]) ;; (define-key AT386-keypad-map "C" [right]) ;; (define-key AT386-keypad-map "D" [left]) ;; These would be set up by terminfo, but not termcap (define-key AT386-keypad-map "H" [home]) (define-key AT386-keypad-map "Y" [end]) (define-key AT386-keypad-map "U" [next]) ;; PgDn (define-key AT386-keypad-map "V" [prior]) ;; PgUp (define-key AT386-keypad-map "@" [insert]) ;; Ins key ;; These are not normally set up by either (define-key AT386-keypad-map "G" [kp-5]) ;; Unlabeled center key (define-key AT386-keypad-map "S" [kp-subtract]) (define-key AT386-keypad-map "T" [kp-add]) ;; Arrange for the ALT key to be equivalent to ESC (define-key function-key-map "\eN" [27]) ; ALT map ) ;;; AT386.el ends here emacs-19.30/lisp/term/apollo.el100444 12120 1 32 5402026713 14560 0ustar rmsdaemon(load "term/vt100" nil t) emacs-19.30/lisp/term/bg-mouse.el100444 12120 1 25570 5257324270 15115 0ustar rmsdaemon;;; bg-mouse.el --- GNU Emacs code for BBN Bitgraph mouse. ;; Copyright (C) Free Software Foundation, Inc. Oct 1985. ;; Author: John Robinson ;; Stephen Gildea ;; Maintainer: FSF ;; Keywords: hardware ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;;; Original version by John Robinson (jr@bbn-unix.arpa, bbncca!jr), Oct 1985 ;;; Modularized and enhanced by gildea@bbn.com Nov 1987 ;;; Time stamp <89/03/21 14:27:08 gildea> ;;; User customization option: (defvar bg-mouse-fast-select-window nil "*Non-nil for mouse hits to select new window, then execute; else just select.") ;;; These numbers are summed to make the index into the mouse-map. ;;; The low three bits correspond to what the mouse actually sends. (defconst bg-button-r 1) (defconst bg-button-m 2) (defconst bg-button-c 2) (defconst bg-button-l 4) (defconst bg-in-modeline 8) (defconst bg-in-scrollbar 16) (defconst bg-in-minibuf 24) ;;; semicolon screws up indenting, so use this instead (defconst semicolon ?\;) ;;; Defuns: (defun bg-mouse-report (prefix-arg) "Read, parse, and execute a BBN BitGraph mouse click. L-- move point | These apply for mouse click in a window. --R set mark | If bg-mouse-fast-select-window is nil, L-R kill region | these commands on a nonselected window -C- move point and yank | just select that window. LC- yank-pop | -CR or LCR undo | \"Scroll bar\" is right-hand window column. on modeline: on \"scroll bar\": in minibuffer: L-- scroll-up line to top execute-extended-command --R scroll-down line to bottom eval-expression -C- proportional goto-char line to middle suspend-emacs To reinitialize the mouse if the terminal is reset, type ESC : RET" (interactive "P") (bg-get-tty-num semicolon) (let* ((screen-mouse-x (min (1- (frame-width)) ;don't hit column 86! (/ (bg-get-tty-num semicolon) 9))) (screen-mouse-y (- (1- (frame-height)) ;assume default font size. (/ (bg-get-tty-num semicolon) 16))) (bg-mouse-buttons (% (bg-get-tty-num ?c) 8)) (bg-mouse-window (bg-window-from-x-y screen-mouse-x screen-mouse-y)) (bg-cursor-window (selected-window)) (edges (window-edges bg-mouse-window)) (minibuf-p (= screen-mouse-y (1- (screen-height)))) (in-modeline-p (and (not minibuf-p) (= screen-mouse-y (1- (nth 3 edges))))) (in-scrollbar-p (and (not minibuf-p) (not in-modeline-p) (>= screen-mouse-x (1- (nth 2 edges))))) (same-window-p (eq bg-mouse-window bg-cursor-window)) (in-minibuf-p (and minibuf-p (not bg-mouse-window))) ;minibuf must be inactive (bg-mode-bits (+ (if in-minibuf-p bg-in-minibuf 0) (if in-modeline-p bg-in-modeline 0) (if in-scrollbar-p bg-in-scrollbar 0))) (bg-command (lookup-key mouse-map (char-to-string (+ bg-mode-bits bg-mouse-buttons)))) (bg-mouse-x (- screen-mouse-x (nth 0 edges))) (bg-mouse-y (- screen-mouse-y (nth 1 edges)))) (cond ((or in-modeline-p in-scrollbar-p) (select-window bg-mouse-window) (bg-command-execute bg-command) (select-window bg-cursor-window)) ((or same-window-p in-minibuf-p) (bg-command-execute bg-command)) (t ;in another window (select-window bg-mouse-window) (if bg-mouse-fast-select-window (bg-command-execute bg-command))) ))) ;;; Library of commands: (defun bg-set-point () "Move point to location of BitGraph mouse." (interactive) (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) (setq this-command 'next-line) ;make subsequent line moves work (setq temporary-goal-column bg-mouse-x)) (defun bg-set-mark () "Set mark at location of BitGraph mouse." (interactive) (push-mark) (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) (exchange-point-and-mark)) (defun bg-yank () "Move point to location of BitGraph mouse and yank." (interactive "*") (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) (setq this-command 'yank) (yank)) (defun yank-pop-1 () (interactive "*") (yank-pop 1)) (defun bg-yank-or-pop () "Move point to location of BitGraph mouse and yank. If last command was a yank, do a yank-pop." (interactive "*") (if (eql last-command 'yank) (yank-pop 1) (bg-yank))) ;;; In 18.51, Emacs Lisp doesn't provide most-positive-fixnum (defconst bg-most-positive-fixnum 8388607) (defun bg-move-by-percentage () "Go to location in buffer that is the same percentage of the way through the buffer as the BitGraph mouse's X position in the window." (interactive) ;; check carefully for overflow in intermediate calculations (goto-char (cond ((zerop bg-mouse-x) 0) ((< (buffer-size) (/ bg-most-positive-fixnum bg-mouse-x)) ;; no danger of overflow: compute it exactly (/ (* bg-mouse-x (buffer-size)) (1- (window-width)))) (t ;; overflow possible: approximate (* (/ (buffer-size) (1- (window-width))) bg-mouse-x)))) (beginning-of-line) (what-cursor-position)) (defun bg-mouse-line-to-top () "Scroll the line pointed to by the BitGraph mouse to the top of the window." (interactive) (scroll-up bg-mouse-y)) (defun bg-mouse-line-to-center () "Scroll the line pointed to by the BitGraph mouse to the center of the window" (interactive) (scroll-up (/ (+ 2 bg-mouse-y bg-mouse-y (- (window-height))) 2))) (defun bg-mouse-line-to-bottom () "Scroll the line pointed to by the mouse to the bottom of the window." (interactive) (scroll-up (+ bg-mouse-y (- 2 (window-height))))) (defun bg-kill-region () (interactive "*") (kill-region (region-beginning) (region-end))) (defun bg-insert-moused-sexp () "Insert a copy of the word (actually sexp) that the mouse is pointing at. Sexp is inserted into the buffer at point (where the text cursor is)." (interactive) (let ((moused-text (save-excursion (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) (if (looking-at "\\s)") (forward-char 1) (forward-sexp 1)) (buffer-substring (save-excursion (backward-sexp 1) (point)) (point))))) (select-window bg-cursor-window) (delete-horizontal-space) (cond ((bolp) (indent-according-to-mode)) ;; In Lisp assume double-quote is closing; in Text assume opening. ;; Why? Because it does the right thing most often. ((save-excursion (forward-char -1) (and (not (looking-at "\\s\"")) (looking-at "[`'\"\\]\\|\\s("))) nil) (t (insert-string " "))) (insert-string moused-text) (or (eolp) (looking-at "\\s.\\|\\s)") (and (looking-at "'") (looking-at "\\sw")) ;hack for text mode (save-excursion (insert-string " "))))) ;;; Utility functions: (defun bg-get-tty-num (term-char) "Read from terminal until TERM-CHAR is read, and return intervening number. If non-numeric not matching TERM-CHAR, reprogram the mouse and signal an error." (let ((num 0) (char (- (read-char) 48))) (while (and (>= char 0) (<= char 9)) (setq num (+ (* num 10) char)) (setq char (- (read-char) 48))) (or (eq term-char (+ char 48)) (progn (bg-program-mouse) (error "Invalid data format in bg-mouse command: mouse reinitialized."))) num)) ;;; Note that this fails in the minibuf because move-to-column doesn't ;;; allow for the width of the prompt. (defun bg-move-point-to-x-y (x y) "Position cursor in window coordinates. X and Y are 0-based character positions in the window." (move-to-window-line y) ;; if not on a wrapped line, zero-column will be 0 (let ((zero-column (current-column)) (scroll-offset (window-hscroll))) ;; scrolling takes up column 0 to display the $ (if (> scroll-offset 0) (setq scroll-offset (1- scroll-offset))) (move-to-column (+ zero-column scroll-offset x)) )) ;;; Returns the window that screen position (x, y) is in or nil if none, ;;; meaning we are in the echo area with a non-active minibuffer. ;;; If coordinates-in-window-p were not in an X-windows-specific file ;;; we could use that. In Emacs 19 can even use locate-window-from-coordinates (defun bg-window-from-x-y (x y) "Find window corresponding to screen coordinates. X and Y are 0-based character positions on the screen." (let ((edges (window-edges)) (window nil)) (while (and (not (eq window (selected-window))) (or (< y (nth 1 edges)) (>= y (nth 3 edges)) (< x (nth 0 edges)) (>= x (nth 2 edges)))) (setq window (next-window window)) (setq edges (window-edges window))) (cond ((eq window (selected-window)) nil) ;we've looped: not found ((not window) (selected-window)) ;just starting: current window (t window)) )) (defun bg-command-execute (bg-command) (if (commandp bg-command) (command-execute bg-command) (ding))) (defun bg-program-mouse () (send-string-to-terminal "\e:0;7;;;360;512;9;16;9;16c")) ;;; Note that the doc string for mouse-map (as defined in subr.el) ;;; says it is for the X-window mouse. This is wrong; that keymap ;;; should be used for your mouse no matter what terminal you have. (or (keymapp mouse-map) (setq mouse-map (make-keymap))) (defun bind-bg-mouse-click (click-code function) "Bind bg-mouse CLICK-CODE to run FUNCTION." (define-key mouse-map (char-to-string click-code) function)) (bind-bg-mouse-click bg-button-l 'bg-set-point) (bind-bg-mouse-click bg-button-m 'bg-yank) (bind-bg-mouse-click bg-button-r 'bg-set-mark) (bind-bg-mouse-click (+ bg-button-l bg-button-m) 'yank-pop-1) (bind-bg-mouse-click (+ bg-button-l bg-button-r) 'bg-kill-region) (bind-bg-mouse-click (+ bg-button-m bg-button-r) 'undo) (bind-bg-mouse-click (+ bg-button-l bg-button-m bg-button-r) 'undo) (bind-bg-mouse-click (+ bg-in-modeline bg-button-l) 'scroll-up) (bind-bg-mouse-click (+ bg-in-modeline bg-button-m) 'bg-move-by-percentage) (bind-bg-mouse-click (+ bg-in-modeline bg-button-r) 'scroll-down) (bind-bg-mouse-click (+ bg-in-scrollbar bg-button-l) 'bg-mouse-line-to-top) (bind-bg-mouse-click (+ bg-in-scrollbar bg-button-m) 'bg-mouse-line-to-center) (bind-bg-mouse-click (+ bg-in-scrollbar bg-button-r) 'bg-mouse-line-to-bottom) (bind-bg-mouse-click (+ bg-in-minibuf bg-button-l) 'execute-extended-command) (bind-bg-mouse-click (+ bg-in-minibuf bg-button-m) 'suspend-emacs) (bind-bg-mouse-click (+ bg-in-minibuf bg-button-r) 'eval-expression) (provide 'bg-mouse) ;;; bg-mouse.el ends here emacs-19.30/lisp/term/bobcat.el100444 12120 1 140 5402026572 14547 0ustar rmsdaemon;;; HP terminals usually encourage using ^H as the rubout character (load "term/keyswap" nil t) emacs-19.30/lisp/term/internal.el100444 12120 1 6626 6050707005 15165 0ustar rmsdaemon;; internal.el -- setup support for PC keyboards and screens, internal terminal ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: Morten Welinder ;; Version: 1,02 ;; 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. ;; --------------------------------------------------------------------------- ;; screen setup -- that's easy! (standard-display-8bit 127 254) ;; --------------------------------------------------------------------------- ;; keyboard setup -- that's simple! (set-input-mode nil nil 0) (define-key function-key-map [backspace] "\177") ; Normal behaviour for BS (define-key function-key-map [delete] "\C-d") ; ... and Delete (define-key function-key-map [tab] [?\t]) (define-key function-key-map [linefeed] [?\n]) (define-key function-key-map [clear] [11]) (define-key function-key-map [return] [13]) (define-key function-key-map [escape] [?\e]) (define-key function-key-map [M-backspace] [?\M-\d]) (define-key function-key-map [M-delete] [?\M-\d]) (define-key function-key-map [M-tab] [?\M-\t]) (define-key function-key-map [M-linefeed] [?\M-\n]) (define-key function-key-map [M-clear] [?\M-\013]) (define-key function-key-map [M-return] [?\M-\015]) (define-key function-key-map [M-escape] [?\M-\e]) (put 'backspace 'ascii-character 127) (put 'delete 'ascii-character 127) (put 'tab 'ascii-character ?\t) (put 'linefeed 'ascii-character ?\n) (put 'clear 'ascii-character 12) (put 'return 'ascii-character 13) (put 'escape 'ascii-character ?\e) ;; --------------------------------------------------------------------------- ;; We want to do this when Emacs is started because it depends on the ;; country code. (let* ((i 128) (modify (function (lambda (ch sy) (modify-syntax-entry ch sy text-mode-syntax-table) (if (boundp 'tex-mode-syntax-table) (modify-syntax-entry ch sy tex-mode-syntax-table)) (modify-syntax-entry ch sy (standard-syntax-table)) ))) (table (standard-case-table)) ;; The following are strings of letters, first lower then upper case. ;; This will look funny on terminals which display other code pages. (chars (cond ((= dos-codepage 850) "‡€š‚ƒ¶„Ž…·†ÆÇ µˆÒ‰ÓŠÔ‹ØŒ×Þ¡Ö‘’“â”™•ã¢à›–ê£é—ë˜Yìí¡I£é¤¥ÐÑçè") ((= dos-codepage 865) "‡€š‚ƒA„Ž…A†ˆE‰EŠE‹IŒII‘’“O”™•O–U£U˜Y› A¡I¢O£U¤¥") ;; default is 437 (t "‡€š‚ƒA„Ž…A†ˆE‰EŠE‹IŒII‘’“O”™•O–U£U˜Y A¡I¢O£U¤¥")))) (while (< i 256) (funcall modify i "_") (setq i (1+ i))) (setq i 0) (while (< i (length chars)) (let ((ch1 (aref chars i)) (ch2 (aref chars (1+ i)))) (if (> ch2 127) (set-case-syntax-pair ch2 ch1 table)) (setq i (+ i 2)))) (save-excursion (mapcar (lambda (b) (set-buffer b) (set-case-table table)) (buffer-list))) (set-standard-case-table table)) emacs-19.30/lisp/term/keyswap.el100444 12120 1 2362 5402026624 15026 0ustar rmsdaemon;; keyswap.el --- swap BS and DEL keys ;; Author: Eric S. Raymond ;; Keywords: terminals ;; Copyright (C) 1992 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 package is meant to be called by other terminal packages. ;;; Code: (let ((the-table (make-string 128 0))) (let ((i 0)) (while (< i 128) (aset the-table i i) (setq i (1+ i)))) ;; Swap ^H and DEL (aset the-table ?\177 ?\^h) (aset the-table ?\^h ?\177) (setq keyboard-translate-table the-table)) ;;; keyswap.el ends here emacs-19.30/lisp/term/lk201.el100444 12120 1 5556 5551615517 14216 0ustar rmsdaemon;; Define function key sequences for DEC terminals. ;; Termcap or terminfo should set these. ;; (define-key function-key-map "\e[A" [up]) ;; (define-key function-key-map "\e[B" [down]) ;; (define-key function-key-map "\e[C" [right]) ;; (define-key function-key-map "\e[D" [left]) (define-key function-key-map "\e[1~" [find]) (define-key function-key-map "\e[2~" [insert]) (define-key function-key-map "\e[3~" [delete]) (define-key function-key-map "\e[4~" [select]) (define-key function-key-map "\e[5~" [prior]) (define-key function-key-map "\e[6~" [next]) (define-key function-key-map "\e[11~" [f1]) (define-key function-key-map "\e[12~" [f2]) (define-key function-key-map "\e[13~" [f3]) (define-key function-key-map "\e[14~" [f4]) (define-key function-key-map "\e[15~" [f5]) (define-key function-key-map "\e[17~" [f6]) (define-key function-key-map "\e[18~" [f7]) (define-key function-key-map "\e[19~" [f8]) (define-key function-key-map "\e[20~" [f9]) (define-key function-key-map "\e[21~" [f10]) ;; Customarily F11 is used as the ESC key. ;; The file that includes this one, takes care of that. (define-key function-key-map "\e[23~" [f11]) (define-key function-key-map "\e[24~" [f12]) (define-key function-key-map "\e[25~" [f13]) (define-key function-key-map "\e[26~" [f14]) (define-key function-key-map "\e[28~" [help]) (define-key function-key-map "\e[29~" [menu]) (define-key function-key-map "\e[31~" [f17]) (define-key function-key-map "\e[32~" [f18]) (define-key function-key-map "\e[33~" [f19]) (define-key function-key-map "\e[34~" [f20]) ;; Termcap or terminfo should set these. ;; (define-key function-key-map "\eOA" [up]) ;; (define-key function-key-map "\eOB" [down]) ;; (define-key function-key-map "\eOC" [right]) ;; (define-key function-key-map "\eOD" [left]) ;; Termcap or terminfo should set these, but doesn't properly. ;; Termcap sets these to k1-k4, which get mapped to f1-f4 in term.c (define-key function-key-map "\eOP" [kp-f1]) (define-key function-key-map "\eOQ" [kp-f2]) (define-key function-key-map "\eOR" [kp-f3]) (define-key function-key-map "\eOS" [kp-f4]) (define-key function-key-map "\eOI" [kp-tab]) (define-key function-key-map "\eOj" [kp-multiply]) (define-key function-key-map "\eOk" [kp-add]) (define-key function-key-map "\eOl" [kp-separator]) (define-key function-key-map "\eOM" [kp-enter]) (define-key function-key-map "\eOm" [kp-subtract]) (define-key function-key-map "\eOn" [kp-decimal]) (define-key function-key-map "\eOo" [kp-divide]) (define-key function-key-map "\eOp" [kp-0]) (define-key function-key-map "\eOq" [kp-1]) (define-key function-key-map "\eOr" [kp-2]) (define-key function-key-map "\eOs" [kp-3]) (define-key function-key-map "\eOt" [kp-4]) (define-key function-key-map "\eOu" [kp-5]) (define-key function-key-map "\eOv" [kp-6]) (define-key function-key-map "\eOw" [kp-7]) (define-key function-key-map "\eOx" [kp-8]) (define-key function-key-map "\eOy" [kp-9]) emacs-19.30/lisp/term/news.el100444 12120 1 5237 5625710437 14334 0ustar rmsdaemon;; news.el --- keypad and function key bindings for the Sony NEWS keyboard ;; Author: FSF ;; Keywords: terminals ;; Copyright (C) 1989, 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: ;;; Uses the Emacs 19 terminal initialization features --- won't work with 18. ;;; Code: (if (boundp 'news-fkey-prefix) nil ;; The terminal initialization should already have set up some keys (setq news-fkey-prefix (lookup-key function-key-map "\eO")) (if (not (keymapp news-fkey-prefix)) (error "What? Your news termcap/terminfo has no keycaps in it.")) ;; Termcap or terminfo will set these ;; (define-key news-fkey-prefix "P" [f1]) ;; (define-key news-fkey-prefix "Q" [f2]) ;; (define-key news-fkey-prefix "R" [f3]) ;; (define-key news-fkey-prefix "S" [f4]) ;; (define-key news-fkey-prefix "T" [f5]) ;; (define-key news-fkey-prefix "U" [f6]) ;; (define-key news-fkey-prefix "V" [f7]) ;; (define-key news-fkey-prefix "W" [f8]) ;; (define-key news-fkey-prefix "X" [f9]) ;; (define-key news-fkey-prefix "Y" [f10]) ;; Terminfo will set these (define-key news-fkey-prefix "a" [execute]) (define-key news-fkey-prefix "b" [select]) (define-key news-fkey-prefix "c" [cancel]) (define-key news-fkey-prefix "M" [kp-enter]) (define-key news-fkey-prefix "q" [kp-1]) (define-key news-fkey-prefix "s" [kp-3]) (define-key news-fkey-prefix "u" [kp-5]) (define-key news-fkey-prefix "w" [kp-7]) (define-key news-fkey-prefix "y" [kp-9]) ;; These aren't in either termcap or terminfo's repertoire (define-key news-fkey-prefix "m" [kp-subtract]) (define-key news-fkey-prefix "k" [kp-add]) (define-key news-fkey-prefix "l" [kp-separator]) (define-key news-fkey-prefix "n" [kp-decimal]) (define-key news-fkey-prefix "p" [kp-0]) (define-key news-fkey-prefix "r" [kp-2]) (define-key news-fkey-prefix "t" [kp-4]) (define-key news-fkey-prefix "v" [kp-6]) (define-key news-fkey-prefix "x" [kp-8]) ) ;;; news.el ends here emacs-19.30/lisp/term/pc-win.el100444 12120 1 17127 6054624514 14573 0ustar rmsdaemon;; pc-win.el -- setup support for `PC windows' (whatever that is). ;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Author: Morten Welinder ;; Version: 1,00 ;; 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. ;; --------------------------------------------------------------------------- (load "term/internal" nil t) ;; Color translation -- doesn't really need to be fast (defvar msdos-color-aliases '(("purple" . "magenta") ("firebrick" . "red") ; ? ("pink" . "lightred") ("royalblue" . "blue") ("cadetblue" . "blue") ("forestgreen" . "green") ("darkolivegreen" . "green") ("darkgoldenrod" . "brown") ("goldenrod" . "yellow") ("grey40" . "darkgray") ("rosybrown" . "brown") ("blue" . "lightblue") ;; from here: for Enriched Text ("darkslategray" . "darkgray") ("orange" . "brown") ("light blue" . "lightblue") ;; from here: for cpp-highlight ("light cyan" . "lightcyan") ("light yellow" . "yellow") ("light pink" . "lightred") ("pale green" . "lightgreen") ("beige" . "brown") ("medium purple" . "magenta") ("turquoise" . "lightgreen") ("violet" . "magenta")) "List of alternate names for colors.") (defun msdos-color-translate (name) (setq name (downcase name)) (let* ((len (length name)) (val (cdr (assoc name '(("black" . 0) ("blue" . 1) ("green" . 2) ("cyan" . 3) ("red" . 4) ("magenta" . 5) ("brown" . 6) ("lightgray" . 7) ("light gray" . 7) ("darkgray" . 8) ("dark gray" . 8) ("lightblue" . 9) ("lightgreen" . 10) ("lightcyan" . 11) ("lightred" . 12) ("lightmagenta" . 13) ("yellow" . 14) ("white" . 15))))) (try)) (or val (and (setq try (cdr (assoc name msdos-color-aliases))) (msdos-color-translate try)) (and (> len 5) (string= "light" (substring name 0 4)) (setq try (msdos-color-translate (substring name 5))) (logior try 8)) (and (> len 6) (string= "light " (substring name 0 5)) (setq try (msdos-color-translate (substring name 6))) (logior try 8)) (and (> len 4) (string= "dark" (substring name 0 3)) (msdos-color-translate (substring name 4))) (and (> len 5) (string= "dark " (substring name 0 4)) (msdos-color-translate (substring name 5)))))) ;; --------------------------------------------------------------------------- ;; We want to delay setting frame parameters until the faces are setup (defvar default-frame-alist nil) (defun msdos-face-setup () (modify-frame-parameters (selected-frame) default-frame-alist) (set-face-foreground 'bold "yellow") (set-face-foreground 'italic "red") (set-face-foreground 'bold-italic "lightred") (set-face-foreground 'underline "white") (set-face-background 'region "green") (make-face 'msdos-menu-active-face) (make-face 'msdos-menu-passive-face) (make-face 'msdos-menu-select-face) (set-face-foreground 'msdos-menu-active-face "white") (set-face-foreground 'msdos-menu-passive-face "lightgray") (set-face-background 'msdos-menu-active-face "blue") (set-face-background 'msdos-menu-passive-face "blue") (set-face-background 'msdos-menu-select-face "red")) ;; We have only one font, so... (add-hook 'before-init-hook 'msdos-face-setup) ;; --------------------------------------------------------------------------- ;; More or less useful immitations of certain X-functions. A lot of the ;; values returned are questionable, but usually only the form of the ;; returned value matters. Also, by the way, recall that `ignore' is ;; a useful function for returning 'nil regardless of argument. ;; From src/xfns.c (defun x-display-color-p (&optional display) 't) (fset 'focus-frame 'ignore) (fset 'unfocus-frame 'ignore) (defun x-list-fonts (pattern &optional face frame) (list "default")) (defun x-color-defined-p (color) (numberp (msdos-color-translate color))) (defun x-display-pixel-width (&optional frame) (* 8 (frame-width frame))) (defun x-display-pixel-height (&optional frame) (* 8 (frame-height frame))) (defun x-display-planes (&optional frame) 4) ; 3 for background, actually (defun x-display-color-cells (&optional frame) 16) ; ??? (defun x-server-max-request-size (&optional frame) 1000000) ; ??? (defun x-server-vendor (&optional frame) t "GNU") (defun x-server-version (&optional frame) '(1 0 0)) (defun x-display-screens (&optional frame) 1) (defun x-display-mm-height (&optional frame) 200) ; Guess the size of my (defun x-display-mm-width (&optional frame) 253) ; monitor, MW... (defun x-display-backing-store (&optional frame) 'not-useful) (defun x-display-visual-class (&optional frame) 'static-color) (fset 'x-display-save-under 'ignore) (fset 'x-get-resource 'ignore) ;; From lisp/term/x-win.el (setq x-display-name "pc") (setq split-window-keep-point t) ;; From lisp/select.el (defun x-get-selection (&rest rest) "") (fset 'x-set-selection 'ignore) ;; From lisp/faces.el: we only have one font, so always return ;; it, no matter which variety they've asked for. (defun x-frob-font-slant (font which) font) ;; From lisp/frame.el (fset 'set-default-font 'ignore) (fset 'set-mouse-color 'ignore) ; We cannot, I think. (fset 'set-cursor-color 'ignore) ; Hardware determined by char under. (fset 'set-border-color 'ignore) ; Not useful. (fset 'auto-raise-mode 'ignore) (fset 'auto-lower-mode 'ignore) (defun set-background-color (color-name) "Set the background color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use." (interactive "sColor: ") (modify-frame-parameters (selected-frame) (list (cons 'background-color color-name)))) (defun set-foreground-color (color-name) "Set the foreground color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use." (interactive "sColor: ") (modify-frame-parameters (selected-frame) (list (cons 'foreground-color color-name)))) ;; --------------------------------------------------------------------------- ;; Handle the X-like command line parameters "-fg" and "-bg" (defun msdos-handle-args (args) (let ((rest nil)) (while args (let ((this (car args))) (setq args (cdr args)) (cond ((or (string= this "-fg") (string= this "-foreground")) (if args (setq default-frame-alist (cons (cons 'foreground-color (car args)) default-frame-alist) args (cdr args)))) ((or (string= this "-bg") (string= this "-background")) (if args (setq default-frame-alist (cons (cons 'background-color (car args)) default-frame-alist) args (cdr args)))) (t (setq rest (cons this rest)))))) (nreverse rest))) (setq command-line-args (msdos-handle-args command-line-args)) ;; --------------------------------------------------------------------------- (require 'faces) (if (msdos-mouse-p) (progn (require 'menu-bar) (menu-bar-mode t))) emacs-19.30/lisp/term/sun-mouse.el100444 13437 1 60024 5405344500 15450 0ustar jimbdaemon;;; sun-mouse.el --- mouse handling for Sun windows ;; Copyright (C) 1987 Free Software Foundation, Inc. ;; Author: Jeff Peck ;; Maintainer: FSF ;; Keywords: hardware ;; 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: ;;; Jeff Peck, Sun Microsystems, Jan 1987. ;;; Original idea by Stan Jefferson ;;; ;;; Modelled after the GNUEMACS keymap interface. ;;; ;;; User Functions: ;;; make-mousemap, copy-mousemap, ;;; define-mouse, global-set-mouse, local-set-mouse, ;;; use-global-mousemap, use-local-mousemap, ;;; mouse-lookup, describe-mouse-bindings ;;; ;;; Options: ;;; extra-click-wait, scrollbar-width ;;; ;;; Code: (defvar extra-click-wait 150 "*Number of milliseconds to wait for an extra click. Set this to zero if you don't want chords or double clicks.") (defvar scrollbar-width 5 "*The character width of the scrollbar. The cursor is deemed to be in the right edge scrollbar if it is this near the right edge, and more than two chars past the end of the indicated line. Setting to nil limits the scrollbar to the edge or vertical dividing bar.") ;;; ;;; Mousemaps ;;; (defun make-mousemap () "Returns a new mousemap." (cons 'mousemap nil)) (defun copy-mousemap (mousemap) "Return a copy of mousemap." (copy-alist mousemap)) (defun define-mouse (mousemap mouse-list def) "Args MOUSEMAP, MOUSE-LIST, DEF. Define MOUSE-LIST in MOUSEMAP as DEF. MOUSE-LIST is a list of atoms specifying a mouse hit according to these rules: * One of these atoms specifies the active region of the definition. text, scrollbar, modeline, minibuffer * One or two or these atoms specify the button or button combination. left, middle, right, double * Any combination of these atoms specify the active shift keys. control, shift, meta * With a single unshifted button, you can add up to indicate an up-click. The atom `double' is used with a button designator to denote a double click. Two button chords are denoted by listing the two buttons. See sun-mouse-handler for the treatment of the form DEF." (mousemap-set (mouse-list-to-mouse-code mouse-list) mousemap def)) (defun global-set-mouse (mouse-list def) "Give MOUSE-EVENT-LIST a local definition of DEF. See define-mouse for a description of MOUSE-EVENT-LIST and DEF. Note that if MOUSE-EVENT-LIST has a local definition in the current buffer, that local definition will continue to shadow any global definition." (interactive "xMouse event: \nxDefinition: ") (define-mouse current-global-mousemap mouse-list def)) (defun local-set-mouse (mouse-list def) "Give MOUSE-EVENT-LIST a local definition of DEF. See define-mouse for a description of the arguments. The definition goes in the current buffer's local mousemap. Normally buffers in the same major mode share a local mousemap." (interactive "xMouse event: \nxDefinition: ") (if (null current-local-mousemap) (setq current-local-mousemap (make-mousemap))) (define-mouse current-local-mousemap mouse-list def)) (defun use-global-mousemap (mousemap) "Selects MOUSEMAP as the global mousemap." (setq current-global-mousemap mousemap)) (defun use-local-mousemap (mousemap) "Selects MOUSEMAP as the local mousemap. nil for MOUSEMAP means no local mousemap." (setq current-local-mousemap mousemap)) ;;; ;;; Interface to the Mouse encoding defined in Emacstool.c ;;; ;;; Called when mouse-prefix is sent to emacs, additional ;;; information is read in as a list (button x y time-delta) ;;; ;;; First, some generally useful functions: ;;; (defun logtest (x y) "True if any bits set in X are also set in Y. Just like the Common Lisp function of the same name." (not (zerop (logand x y)))) ;;; ;;; Hit accessors. ;;; (defconst sm::ButtonBits 7) ; Lowest 3 bits. (defconst sm::ShiftmaskBits 56) ; Second lowest 3 bits (56 = 63 - 7). (defconst sm::DoubleBits 64) ; Bit 7. (defconst sm::UpBits 128) ; Bit 8. ;;; All the useful code bits (defmacro sm::hit-code (hit) (` (nth 0 (, hit)))) ;;; The button, or buttons if a chord. (defmacro sm::hit-button (hit) (` (logand sm::ButtonBits (nth 0 (, hit))))) ;;; The shift, control, and meta flags. (defmacro sm::hit-shiftmask (hit) (` (logand sm::ShiftmaskBits (nth 0 (, hit))))) ;;; Set if a double click (but not a chord). (defmacro sm::hit-double (hit) (` (logand sm::DoubleBits (nth 0 (, hit))))) ;;; Set on button release (as opposed to button press). (defmacro sm::hit-up (hit) (` (logand sm::UpBits (nth 0 (, hit))))) ;;; Screen x position. (defmacro sm::hit-x (hit) (list 'nth 1 hit)) ;;; Screen y position. (defmacro sm::hit-y (hit) (list 'nth 2 hit)) ;;; Milliseconds since last hit. (defmacro sm::hit-delta (hit) (list 'nth 3 hit)) (defmacro sm::hit-up-p (hit) ; A predicate. (` (not (zerop (sm::hit-up (, hit)))))) ;;; ;;; Loc accessors. for sm::window-xy ;;; (defmacro sm::loc-w (loc) (list 'nth 0 loc)) (defmacro sm::loc-x (loc) (list 'nth 1 loc)) (defmacro sm::loc-y (loc) (list 'nth 2 loc)) (defmacro eval-in-buffer (buffer &rest forms) "Macro to switches to BUFFER, evaluates FORMS, returns to original buffer." ;; When you don't need the complete window context of eval-in-window (` (let ((StartBuffer (current-buffer))) (unwind-protect (progn (set-buffer (, buffer)) (,@ forms)) (set-buffer StartBuffer))))) (put 'eval-in-buffer 'lisp-indent-function 1) ;;; this is used extensively by sun-fns.el ;;; (defmacro eval-in-window (window &rest forms) "Switch to WINDOW, evaluate FORMS, return to original window." (` (let ((OriginallySelectedWindow (selected-window))) (unwind-protect (progn (select-window (, window)) (,@ forms)) (select-window OriginallySelectedWindow))))) (put 'eval-in-window 'lisp-indent-function 1) ;;; ;;; handy utility, generalizes window_loop ;;; ;;; It's a macro (and does not evaluate its arguments). (defmacro eval-in-windows (form &optional yesmini) "Switches to each window and evaluates FORM. Optional argument YESMINI says to include the minibuffer as a window. This is a macro, and does not evaluate its arguments." (` (let ((OriginallySelectedWindow (selected-window))) (unwind-protect (while (progn (, form) (not (eq OriginallySelectedWindow (select-window (next-window nil (, yesmini))))))) (select-window OriginallySelectedWindow))))) (put 'eval-in-window 'lisp-indent-function 0) (defun move-to-loc (x y) "Move cursor to window location X, Y. Handles wrapped and horizontally scrolled lines correctly." (move-to-window-line y) ;; window-line-end expects this to return the window column it moved to. (let ((cc (current-column)) (nc (move-to-column (if (zerop (window-hscroll)) (+ (current-column) (min (- (window-width) 2) ; To stay on the line. x)) (+ (window-hscroll) -1 (min (1- (window-width)) ; To stay on the line. x)))))) (- nc cc))) (defun minibuffer-window-p (window) "True iff this WINDOW is minibuffer." (= (frame-height) (nth 3 (window-edges window)) ; The bottom edge. )) (defun sun-mouse-handler (&optional hit) "Evaluates the function or list associated with a mouse hit. Expecting to read a hit, which is a list: (button x y delta). A form bound to button by define-mouse is found by mouse-lookup. The variables: *mouse-window*, *mouse-x*, *mouse-y* are bound. If the form is a symbol (symbolp), it is funcall'ed with *mouse-window*, *mouse-x*, and *mouse-y* as arguments; if the form is a list (listp), the form is eval'ed; if the form is neither of these, it is an error. Returns nil." (interactive) (if (null hit) (setq hit (sm::combined-hits))) (let ((loc (sm::window-xy (sm::hit-x hit) (sm::hit-y hit)))) (let ((*mouse-window* (sm::loc-w loc)) (*mouse-x* (sm::loc-x loc)) (*mouse-y* (sm::loc-y loc)) (mouse-code (mouse-event-code hit loc))) (let ((form (eval-in-buffer (window-buffer *mouse-window*) (mouse-lookup mouse-code)))) (cond ((null form) (if (not (sm::hit-up-p hit)) ; undefined up hits are ok. (error "Undefined mouse event: %s" (prin1-to-string (mouse-code-to-mouse-list mouse-code))))) ((symbolp form) (setq this-command form) (funcall form *mouse-window* *mouse-x* *mouse-y*)) ((listp form) (setq this-command (car form)) (eval form)) (t (error "Mouse action must be symbol or list, but was: %s" form)))))) ;; Don't let 'sun-mouse-handler get on last-command, ;; since this function should be transparent. (if (eq this-command 'sun-mouse-handler) (setq this-command last-command)) ;; (message (prin1-to-string this-command)) ; to see what your buttons did nil) (defun sm::combined-hits () "Read and return next mouse-hit, include possible double click" (let ((hit1 (mouse-hit-read))) (if (not (sm::hit-up-p hit1)) ; Up hits dont start doubles or chords. (let ((hit2 (mouse-second-hit extra-click-wait))) (if hit2 ; we cons'd it, we can smash it. ; (setf (sm::hit-code hit1) (logior (sm::hit-code hit1) ...)) (setcar hit1 (logior (sm::hit-code hit1) (sm::hit-code hit2) (if (= (sm::hit-button hit1) (sm::hit-button hit2)) sm::DoubleBits 0)))))) hit1)) (defun mouse-hit-read () "Read mouse-hit list from keyboard. Like (read 'read-char), but that uses minibuffer, and mucks up last-command." (let ((char-list nil) (char nil)) (while (not (equal 13 ; Carriage return. (prog1 (setq char (read-char)) (setq char-list (cons char char-list)))))) (read (mapconcat 'char-to-string (nreverse char-list) "")) )) ;;; Second Click Hackery.... ;;; if prefix is not mouse-prefix, need a way to unread the char... ;;; or else have mouse flush input queue, or else need a peek at next char. ;;; There is no peek, but since one character can be unread, we only ;;; have to flush the queue when the command after a mouse click ;;; starts with mouse-prefix1 (see below). ;;; Something to do later: We could buffer the read commands and ;;; execute them ourselves after doing the mouse command (using ;;; lookup-key ??). (defvar mouse-prefix1 24 ; C-x "First char of mouse-prefix. Used to detect double clicks and chords.") (defvar mouse-prefix2 0 ; C-@ "Second char of mouse-prefix. Used to detect double clicks and chords.") (defun mouse-second-hit (hit-wait) "Returns the next mouse hit occurring within HIT-WAIT milliseconds." (if (sit-for-millisecs hit-wait) nil ; No input within hit-wait millisecs. (let ((pc1 (read-char))) (if (or (not (equal pc1 mouse-prefix1)) (sit-for-millisecs 3)) ; a mouse prefix will have second char ;; Can get away with one unread. (progn (setq unread-command-events (list pc1)) nil) ; Next input not mouse event. (let ((pc2 (read-char))) (if (not (equal pc2 mouse-prefix2)) (progn (setq unread-command-events (list pc1)) ; put back the ^X ;;; Too bad can't do two: (setq unread-command-event (list pc1 pc2)) ;;; Well, now we can, but I don't understand this code well enough to fix it... (ding) ; user will have to retype that pc2. nil) ; This input is not a mouse event. ;; Next input has mouse prefix and is within time limit. (let ((new-hit (mouse-hit-read))) ; Read the new hit. (if (sm::hit-up-p new-hit) ; Ignore up events when timing. (mouse-second-hit (- hit-wait (sm::hit-delta new-hit))) new-hit ; New down hit within limit, return it. )))))))) (defun sm::window-xy (x y) "Find window containing screen coordinates X and Y. Returns list (window x y) where x and y are relative to window." (or (catch 'found (eval-in-windows (let ((we (window-edges (selected-window)))) (let ((le (nth 0 we)) (te (nth 1 we)) (re (nth 2 we)) (be (nth 3 we))) (if (= re (frame-width)) ;; include the continuation column with this window (setq re (1+ re))) (if (= be (frame-height)) ;; include partial line at bottom of frame with this window ;; id est, if window is not multple of char size. (setq be (1+ be))) (if (and (>= x le) (< x re) (>= y te) (< y be)) (throw 'found (list (selected-window) (- x le) (- y te)))))) t)) ; include minibuffer in eval-in-windows ;;If x,y from a real mouse click, we shouldn't get here. (list nil x y) )) (defun sm::window-region (loc) "Parse LOC into a region symbol. Returns one of (text scrollbar modeline minibuffer)" (let ((w (sm::loc-w loc)) (x (sm::loc-x loc)) (y (sm::loc-y loc))) (let ((right (1- (window-width w))) (bottom (1- (window-height w)))) (cond ((minibuffer-window-p w) 'minibuffer) ((>= y bottom) 'modeline) ((>= x right) 'scrollbar) ;; far right column (window separator) is always a scrollbar ((and scrollbar-width ;; mouse within scrollbar-width of edge. (>= x (- right scrollbar-width)) ;; mouse a few chars past the end of line. (>= x (+ 2 (window-line-end w x y)))) 'scrollbar) (t 'text))))) (defun window-line-end (w x y) "Return WINDOW column (ignore X) containing end of line Y" (eval-in-window w (save-excursion (move-to-loc (frame-width) y)))) ;;; ;;; The encoding of mouse events into a mousemap. ;;; These values must agree with coding in emacstool: ;;; (defconst sm::keyword-alist '((left . 1) (middle . 2) (right . 4) (shift . 8) (control . 16) (meta . 32) (double . 64) (up . 128) (text . 256) (scrollbar . 512) (modeline . 1024) (minibuffer . 2048) )) (defun mouse-event-code (hit loc) "Maps MOUSE-HIT and LOC into a mouse-code." ;;;Region is a code for one of text, modeline, scrollbar, or minibuffer. (logior (sm::hit-code hit) (mouse-region-to-code (sm::window-region loc)))) (defun mouse-region-to-code (region) "Returns partial mouse-code for specified REGION." (cdr (assq region sm::keyword-alist))) (defun mouse-list-to-mouse-code (mouse-list) "Map a MOUSE-LIST to a mouse-code." (apply 'logior (mapcar (function (lambda (x) (cdr (assq x sm::keyword-alist)))) mouse-list))) (defun mouse-code-to-mouse-list (mouse-code) "Map a MOUSE-CODE to a mouse-list." (apply 'nconc (mapcar (function (lambda (x) (if (logtest mouse-code (cdr x)) (list (car x))))) sm::keyword-alist))) (defun mousemap-set (code mousemap value) (let* ((alist (cdr mousemap)) (assq-result (assq code alist))) (if assq-result (setcdr assq-result value) (setcdr mousemap (cons (cons code value) alist))))) (defun mousemap-get (code mousemap) (cdr (assq code (cdr mousemap)))) (defun mouse-lookup (mouse-code) "Look up MOUSE-EVENT and return the definition. nil means undefined." (or (mousemap-get mouse-code current-local-mousemap) (mousemap-get mouse-code current-global-mousemap))) ;;; ;;; I (jpeck) don't understand the utility of the next four functions ;;; ask Steven Greenbaum ;;; (defun mouse-mask-lookup (mask list) "Args MASK (a bit mask) and LIST (a list of (code . form) pairs). Returns a list of elements of LIST whose code or'ed with MASK is non-zero." (let ((result nil)) (while list (if (logtest mask (car (car list))) (setq result (cons (car list) result))) (setq list (cdr list))) result)) (defun mouse-union (l l-unique) "Return the union of list of mouse (code . form) pairs L and L-UNIQUE, where L-UNIQUE is considered to be union'ized already." (let ((result l-unique)) (while l (let ((code-form-pair (car l))) (if (not (assq (car code-form-pair) result)) (setq result (cons code-form-pair result)))) (setq l (cdr l))) result)) (defun mouse-union-first-preferred (l1 l2) "Return the union of lists of mouse (code . form) pairs L1 and L2, based on the code's, with preference going to elements in L1." (mouse-union l2 (mouse-union l1 nil))) (defun mouse-code-function-pairs-of-region (region) "Return a list of (code . function) pairs, where each code is currently set in the REGION." (let ((mask (mouse-region-to-code region))) (mouse-union-first-preferred (mouse-mask-lookup mask (cdr current-local-mousemap)) (mouse-mask-lookup mask (cdr current-global-mousemap)) ))) ;;; ;;; Functions for DESCRIBE-MOUSE-BINDINGS ;;; And other mouse documentation functions ;;; Still need a good procedure to print out a help sheet in readable format. ;;; (defun one-line-doc-string (function) "Returns first line of documentation string for FUNCTION. If there is no documentation string, then the string \"No documentation\" is returned." (while (consp function) (setq function (car function))) (let ((doc (documentation function))) (if (null doc) "No documentation." (string-match "^.*$" doc) (substring doc 0 (match-end 0))))) (defun print-mouse-format (binding) (princ (car binding)) (princ ": ") (mapcar (function (lambda (mouse-list) (princ mouse-list) (princ " "))) (cdr binding)) (terpri) (princ " ") (princ (one-line-doc-string (car binding))) (terpri) ) (defun print-mouse-bindings (region) "Prints mouse-event bindings for REGION." (mapcar 'print-mouse-format (sm::event-bindings region))) (defun sm::event-bindings (region) "Returns an alist of (function . (mouse-list1 ... mouse-listN)) for REGION, where each mouse-list is bound to the function in REGION." (let ((mouse-bindings (mouse-code-function-pairs-of-region region)) (result nil)) (while mouse-bindings (let* ((code-function-pair (car mouse-bindings)) (current-entry (assoc (cdr code-function-pair) result))) (if current-entry (setcdr current-entry (cons (mouse-code-to-mouse-list (car code-function-pair)) (cdr current-entry))) (setq result (cons (cons (cdr code-function-pair) (list (mouse-code-to-mouse-list (car code-function-pair)))) result)))) (setq mouse-bindings (cdr mouse-bindings)) ) result)) (defun describe-mouse-bindings () "Lists all current mouse-event bindings." (interactive) (with-output-to-temp-buffer "*Help*" (princ "Text Region") (terpri) (princ "---- ------") (terpri) (print-mouse-bindings 'text) (terpri) (princ "Modeline Region") (terpri) (princ "-------- ------") (terpri) (print-mouse-bindings 'modeline) (terpri) (princ "Scrollbar Region") (terpri) (princ "--------- ------") (terpri) (print-mouse-bindings 'scrollbar))) (defun describe-mouse-briefly (mouse-list) "Print a short description of the function bound to MOUSE-LIST." (interactive "xDescibe mouse list briefly: ") (let ((function (mouse-lookup (mouse-list-to-mouse-code mouse-list)))) (if function (message "%s runs the command %s" mouse-list function) (message "%s is undefined" mouse-list)))) (defun mouse-help-menu (function-and-binding) (cons (prin1-to-string (car function-and-binding)) (menu-create ; Two sub-menu items of form ("String" . nil) (list (list (one-line-doc-string (car function-and-binding))) (list (prin1-to-string (cdr function-and-binding))))))) (defun mouse-help-region (w x y &optional region) "Displays a menu of mouse functions callable in this region." (let* ((region (or region (sm::window-region (list w x y)))) (mlist (mapcar (function mouse-help-menu) (sm::event-bindings region))) (menu (menu-create (cons (list (symbol-name region)) mlist))) (item (sun-menu-evaluate w 0 y menu)) ))) ;;; ;;; Menu interface functions ;;; ;;; use defmenu, because this interface is subject to change ;;; really need a menu-p, but we use vectorp and the context... ;;; (defun menu-create (items) "Functional form for defmenu, given a list of ITEMS returns a menu. Each ITEM is a (STRING . VALUE) pair." (apply 'vector items) ) (defmacro defmenu (menu &rest itemlist) "Defines MENU to be a menu, the ITEMS are (STRING . VALUE) pairs. See sun-menu-evaluate for interpretation of ITEMS." (list 'defconst menu (funcall 'menu-create itemlist)) ) (defun sun-menu-evaluate (*menu-window* *menu-x* *menu-y* menu) "Display a pop-up menu in WINDOW at X Y and evaluate selected item of MENU. MENU (or its symbol-value) should be a menu defined by defmenu. A menu ITEM is a (STRING . FORM) pair; the FORM associated with the selected STRING is evaluated, and the resulting value is returned. Generally these FORMs are evaluated for their side-effects rather than their values. If the selected form is a menu or a symbol whose value is a menu, then it is displayed and evaluated as a pullright menu item. If the the FORM of the first ITEM is nil, the STRING of the item is used as a label for the menu, i.e. it's inverted and not selectable." (if (symbolp menu) (setq menu (symbol-value menu))) (eval (sun-menu-internal *menu-window* *menu-x* *menu-y* 4 menu))) (defun sun-get-frame-data (code) "Sends the tty-sub-window escape sequence CODE to terminal, and returns a cons of the two numbers in returned escape sequence. That is it returns (cons ) from \"\\E[n;;t\". CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars." (send-string-to-terminal (concat "\033[" (int-to-string code) "t")) (let (char str x y) (while (not (equal 116 (setq char (read-char)))) ; #\t = 116 (setq str (cons char str))) (setq str (mapconcat 'char-to-string (nreverse str) "")) (string-match ";[0-9]*" str) (setq y (substring str (1+ (match-beginning 0)) (match-end 0))) (setq str (substring str (match-end 0))) (string-match ";[0-9]*" str) (setq x (substring str (1+ (match-beginning 0)) (match-end 0))) (cons (string-to-int y) (string-to-int x)))) (defun sm::font-size () "Returns font size in pixels: (cons Ysize Xsize)" (let ((pix (sun-get-frame-data 14)) ; returns size in pixels (chr (sun-get-frame-data 18))) ; returns size in chars (cons (/ (car pix) (car chr)) (/ (cdr pix) (cdr chr))))) (defvar sm::menu-kludge-x nil "Cached frame-to-window X-Offset for sm::menu-kludge") (defvar sm::menu-kludge-y nil "Cached frame-to-window Y-Offset for sm::menu-kludge") (defun sm::menu-kludge () "If sunfns.c uses this function must be here!" (or sm::menu-kludge-y (let ((fs (sm::font-size))) (setq sm::menu-kludge-y (+ 8 (car fs)) ; a title line and borders sm::menu-kludge-x 4))) ; best values depend on .defaults/Menu (let ((wl (sun-get-frame-data 13))) ; returns frame location (cons (+ (car wl) sm::menu-kludge-y) (+ (cdr wl) sm::menu-kludge-x)))) ;;; ;;; Function interface to selection/region ;;; primitive functions are defined in sunfns.c ;;; (defun sun-yank-selection () "Set mark and yank the contents of the current sunwindows selection. Insert contents into the current buffer at point." (interactive "*") (set-mark-command nil) (insert-string (sun-get-selection))) (defun sun-select-region (beg end) "Set the sunwindows selection to the region in the current buffer." (interactive "r") (sun-set-selection (buffer-substring beg end))) ;;; ;;; Support for emacstool ;;; This closes the window instead of stopping emacs. ;;; (defun suspend-emacstool (&optional stuffstring) "Suspend emacstool. If running under as a detached process emacstool, you don't want to suspend (there is no way to resume), just close the window, and wait for reopening." (interactive) (run-hooks 'suspend-hook) (if stuffstring (send-string-to-terminal stuffstring)) (send-string-to-terminal "\033[2t") ; To close EmacsTool window. (run-hooks 'suspend-resume-hook)) ;;; ;;; initialize mouse maps ;;; (make-variable-buffer-local 'current-local-mousemap) (setq-default current-local-mousemap nil) (defvar current-global-mousemap (make-mousemap)) (provide 'sun-mouse) ;;; sun-mouse.el ends here emacs-19.30/lisp/term/sun.el100444 12120 1 23261 5471657241 14204 0ustar rmsdaemon;; sun.el --- keybinding for standard default sunterm keys ;; Author: Jeff Peck ;; Keywords: terminals ;; Copyright (C) 1987 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: ;; The function key sequences for the console have been converted for ;; use with function-key-map, but the *tool stuff hasn't been touched. ;;; Code: (defun ignore-key () "interactive version of ignore" (interactive) (ignore)) (defun scroll-down-in-place (n) (interactive "p") (previous-line n) (scroll-down n)) (defun scroll-up-in-place (n) (interactive "p") (next-line n) (scroll-up n)) (defun kill-region-and-unmark (beg end) "Like kill-region, but pops the mark [which equals point, anyway.]" (interactive "r") (kill-region beg end) (setq this-command 'kill-region-and-unmark) (set-mark-command t)) (defun select-previous-complex-command () "Select Previous-complex-command" (interactive) (if (zerop (minibuffer-depth)) (repeat-complex-command 1) (previous-complex-command 1))) (defun rerun-prev-command () "Repeat Previous-complex-command." (interactive) (eval (nth 0 command-history))) (defvar grep-arg nil "Default arg for RE-search") (defun grep-arg () (if (memq last-command '(research-forward research-backward)) grep-arg (let* ((command (car command-history)) (command-name (symbol-name (car command))) (search-arg (car (cdr command))) (search-command (and command-name (string-match "search" command-name))) ) (if (and search-command (stringp search-arg)) (setq grep-arg search-arg) (setq search-command this-command grep-arg (read-string "REsearch: " grep-arg) this-command search-command) grep-arg)))) (defun research-forward () "Repeat RE search forward." (interactive) (re-search-forward (grep-arg))) (defun research-backward () "Repeat RE search backward." (interactive) (re-search-backward (grep-arg))) ;;; ;;; handle sun's extra function keys ;;; this version for those who run with standard .ttyswrc and no emacstool ;;; ;;; sunview picks up expose and open on the way UP, ;;; so we ignore them on the way down ;;; (defvar sun-esc-bracket nil "*If non-nil, rebind ESC [ as prefix for Sun function keys.") (defvar sun-raw-prefix (make-sparse-keymap)) (define-key function-key-map "\e[" sun-raw-prefix) (define-key sun-raw-prefix "210z" [r3]) (define-key sun-raw-prefix "213z" [r6]) (define-key sun-raw-prefix "214z" [r7]) (define-key sun-raw-prefix "216z" [r9]) (define-key sun-raw-prefix "218z" [r11]) (define-key sun-raw-prefix "220z" [r13]) (define-key sun-raw-prefix "222z" [r15]) (define-key sun-raw-prefix "193z" [redo]) (define-key sun-raw-prefix "194z" [props]) (define-key sun-raw-prefix "195z" [undo]) ; (define-key sun-raw-prefix "196z" 'ignore-key) ; Expose-down ; (define-key sun-raw-prefix "197z" [put]) ; (define-key sun-raw-prefix "198z" 'ignore-key) ; Open-down ; (define-key sun-raw-prefix "199z" [get]) (define-key sun-raw-prefix "200z" [find]) ; (define-key sun-raw-prefix "201z" 'kill-region-and-unmark) ; Delete (define-key sun-raw-prefix "226z" [t3]) (define-key sun-raw-prefix "227z" [t4]) (define-key sun-raw-prefix "229z" [t6]) (define-key sun-raw-prefix "230z" [t7]) (define-key sun-raw-prefix "A" [up]) ; R8 (define-key sun-raw-prefix "B" [down]) ; R14 (define-key sun-raw-prefix "C" [right]) ; R12 (define-key sun-raw-prefix "D" [left]) ; R10 (global-set-key [r3] 'backward-page) (global-set-key [r6] 'forward-page) (global-set-key [r7] 'beginning-of-buffer) (global-set-key [r9] 'scroll-down) (global-set-key [r11] 'recenter) (global-set-key [r13] 'end-of-buffer) (global-set-key [r15] 'scroll-up) (global-set-key [redo] 'redraw-display) (global-set-key [props] 'list-buffers) (global-set-key [undo] 'undo) (global-set-key [put] 'sun-select-region) (global-set-key [get] 'sun-yank-selection) (global-set-key [find] 'exchange-point-and-mark) (global-set-key [t3] 'scroll-down-in-place) (global-set-key [t4] 'scroll-up-in-place) (global-set-key [t6] 'shrink-window) (global-set-key [t7] 'enlarge-window) (if sun-esc-bracket (global-unset-key "\e[")) ;;; Since .emacs gets loaded before this file, a hook is supplied ;;; for you to put your own bindings in. (defvar sun-raw-prefix-hooks nil "List of forms to evaluate after setting sun-raw-prefix.") (let ((hooks sun-raw-prefix-hooks)) (while hooks (eval (car hooks)) (setq hooks (cdr hooks)) )) ;;; This section adds definitions for the emacstool users ;;; emacstool event filter converts function keys to C-x*{c}{lrt} ;;; ;;; for example the Open key (L7) would be encoded as "\C-x*gl" ;;; the control, meta, and shift keys modify the character {lrt} ;;; note that (unshifted) C-l is ",", C-r is "2", and C-t is "4" ;;; ;;; {c} is [a-j] for LEFT, [a-i] for TOP, [a-o] for RIGHT. ;;; A higher level insists on encoding {h,j,l,n}{r} (the arrow keys) ;;; as ANSI escape sequences. Use the shell command ;;; % setkeys noarrows ;;; if you want these to come through for emacstool. ;;; ;;; If you are not using EmacsTool, ;;; you can also use this by creating a .ttyswrc file to do the conversion. ;;; but it won't include the CONTROL, META, or SHIFT keys! ;;; ;;; Important to define SHIFTed sequence before matching unshifted sequence. ;;; (talk about bletcherous old uppercase terminal conventions!*$#@&%*&#$%) ;;; this is worse than C-S/C-Q flow control anyday! ;;; Do *YOU* run in capslock mode? ;;; ;;; Note: al, el and gl are trapped by EmacsTool, so they never make it here. (defvar meta-flag t) (defvar suntool-map (make-sparse-keymap) "*Keymap for Emacstool bindings.") (define-key suntool-map "gr" 'beginning-of-buffer) ; r7 (define-key suntool-map "iR" 'backward-page) ; R9 (define-key suntool-map "ir" 'scroll-down) ; r9 (define-key suntool-map "kr" 'recenter) ; r11 (define-key suntool-map "mr" 'end-of-buffer) ; r13 (define-key suntool-map "oR" 'forward-page) ; R15 (define-key suntool-map "or" 'scroll-up) ; r15 (define-key suntool-map "b\M-L" 'rerun-prev-command) ; M-AGAIN (define-key suntool-map "b\M-l" 'prev-complex-command) ; M-Again (define-key suntool-map "bl" 'redraw-display) ; Again (define-key suntool-map "cl" 'list-buffers) ; Props (define-key suntool-map "dl" 'undo) ; Undo (define-key suntool-map "el" 'ignore-key) ; Expose-Open (define-key suntool-map "fl" 'sun-select-region) ; Put (define-key suntool-map "f," 'copy-region-as-kill) ; C-Put (define-key suntool-map "gl" 'ignore-key) ; Open-Open (define-key suntool-map "hl" 'sun-yank-selection) ; Get (define-key suntool-map "h," 'yank) ; C-Get (define-key suntool-map "il" 'research-forward) ; Find (define-key suntool-map "i," 're-search-forward) ; C-Find (define-key suntool-map "i\M-l" 'research-backward) ; M-Find (define-key suntool-map "i\M-," 're-search-backward) ; C-M-Find (define-key suntool-map "jL" 'yank) ; DELETE (define-key suntool-map "jl" 'kill-region-and-unmark) ; Delete (define-key suntool-map "j\M-l" 'exchange-point-and-mark); M-Delete (define-key suntool-map "j," '(lambda () (interactive) (pop-mark 1))) ; C-Delete (define-key suntool-map "fT" 'shrink-window-horizontally) ; T6 (define-key suntool-map "gT" 'enlarge-window-horizontally) ; T7 (define-key suntool-map "ft" 'shrink-window) ; t6 (define-key suntool-map "gt" 'enlarge-window) ; t7 (define-key suntool-map "cT" '(lambda(n) (interactive "p") (scroll-down n))) (define-key suntool-map "dT" '(lambda(n) (interactive "p") (scroll-up n))) (define-key suntool-map "ct" 'scroll-down-in-place) ; t3 (define-key suntool-map "dt" 'scroll-up-in-place) ; t4 (define-key ctl-x-map "*" suntool-map) ;;; Since .emacs gets loaded before this file, a hook is supplied ;;; for you to put your own bindings in. (defvar suntool-map-hooks nil "List of forms to evaluate after setting suntool-map.") (let ((hooks suntool-map-hooks)) (while hooks (eval (car hooks)) (setq hooks (cdr hooks)) )) ;;; ;;; If running under emacstool, arrange to call suspend-emacstool ;;; instead of suspend-emacs. ;;; ;;; First mouse blip is a clue that we are in emacstool. ;;; ;;; C-x C-@ is the mouse command prefix. (autoload 'sun-mouse-handler "sun-mouse" "Sun Emacstool handler for mouse blips (not loaded)." t) (defun emacstool-init () "Set up Emacstool window, if you know you are in an emacstool." ;; Make sure sun-mouse and sun-fns are loaded. (require 'sun-fns) (define-key ctl-x-map "\C-@" 'sun-mouse-handler) (if (< (sun-window-init) 0) (message "Not a Sun Window") (progn (substitute-key-definition 'suspend-emacs 'suspend-emacstool global-map) (substitute-key-definition 'suspend-emacs 'suspend-emacstool esc-map) (substitute-key-definition 'suspend-emacs 'suspend-emacstool ctl-x-map)) (send-string-to-terminal (concat "\033]lEmacstool - GNU Emacs " emacs-version "\033\\")) )) (defun sun-mouse-once () "Converts to emacstool and sun-mouse-handler on first mouse hit." (interactive) (emacstool-init) (sun-mouse-handler) ; Now, execute this mouse blip. ) (define-key ctl-x-map "\C-@" 'sun-mouse-once) ;;; sun.el ends here emacs-19.30/lisp/term/sup-mouse.el100444 12120 1 13570 5257330247 15332 0ustar rmsdaemon;;; sup-mouse.el --- supdup mouse support for lisp machines ;; Copyright (C) Free Software Foundation 1985, 1986 ;; Author: Wolfgang Rupprecht ;; Maintainer: FSF ;; Created: 21 Nov 1986 ;; Keywords: hardware ;; (from code originally written by John Robinson@bbn for the bitgraph) ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;;; User customization option: (defvar sup-mouse-fast-select-window nil "*Non-nil for mouse hits to select new window, then execute; else just select.") (defconst mouse-left 0) (defconst mouse-center 1) (defconst mouse-right 2) (defconst mouse-2left 4) (defconst mouse-2center 5) (defconst mouse-2right 6) (defconst mouse-3left 8) (defconst mouse-3center 9) (defconst mouse-3right 10) ;;; Defuns: (defun sup-mouse-report () "This function is called directly by the mouse, it parses and executes the mouse commands. L move point * |---- These apply for mouse click in a window. 2L delete word | 3L copy word | If sup-mouse-fast-select-window is nil, C move point and yank * | just selects that window. 2C yank pop | R set mark * | 2R delete region | 3R copy region | on modeline on \"scroll bar\" in minibuffer L scroll-up line to top execute-extended-command C proportional goto-char line to middle mouse-help R scroll-down line to bottom eval-expression" (interactive) (let* ;; expect a string of :;;c ((buttons (sup-get-tty-num ?\;)) (x (sup-get-tty-num ?\;)) (y (sup-get-tty-num ?c)) (window (sup-pos-to-window x y)) (edges (window-edges window)) (old-window (selected-window)) (in-minibuf-p (eq y (1- (frame-height)))) (same-window-p (and (not in-minibuf-p) (eq window old-window))) (in-modeline-p (eq y (1- (nth 3 edges)))) (in-scrollbar-p (>= x (1- (nth 2 edges))))) (setq x (- x (nth 0 edges))) (setq y (- y (nth 1 edges))) ; (error "mouse-hit %d %d %d" buttons x y) ;;;; debug (cond (in-modeline-p (select-window window) (cond ((= buttons mouse-left) (scroll-up)) ((= buttons mouse-right) (scroll-down)) ((= buttons mouse-center) (goto-char (/ (* x (- (point-max) (point-min))) (1- (window-width)))) (beginning-of-line) (what-cursor-position))) (select-window old-window)) (in-scrollbar-p (select-window window) (scroll-up (cond ((= buttons mouse-left) y) ((= buttons mouse-right) (+ y (- 2 (window-height)))) ((= buttons mouse-center) (/ (+ 2 y y (- (window-height))) 2)) (t 0))) (select-window old-window)) (same-window-p (cond ((= buttons mouse-left) (sup-move-point-to-x-y x y)) ((= buttons mouse-2left) (sup-move-point-to-x-y x y) (kill-word 1)) ((= buttons mouse-3left) (sup-move-point-to-x-y x y) (save-excursion (copy-region-as-kill (point) (progn (forward-word 1) (point)))) (setq this-command 'yank) ) ((= buttons mouse-right) (push-mark) (sup-move-point-to-x-y x y) (exchange-point-and-mark)) ((= buttons mouse-2right) (push-mark) (sup-move-point-to-x-y x y) (kill-region (mark) (point))) ((= buttons mouse-3right) (push-mark) (sup-move-point-to-x-y x y) (copy-region-as-kill (mark) (point)) (setq this-command 'yank)) ((= buttons mouse-center) (sup-move-point-to-x-y x y) (setq this-command 'yank) (yank)) ((= buttons mouse-2center) (yank-pop 1)) ) ) (in-minibuf-p (cond ((= buttons mouse-right) (call-interactively 'eval-expression)) ((= buttons mouse-left) (call-interactively 'execute-extended-command)) ((= buttons mouse-center) (describe-function 'sup-mouse-report)); silly self help )) (t ;in another window (select-window window) (cond ((not sup-mouse-fast-select-window)) ((= buttons mouse-left) (sup-move-point-to-x-y x y)) ((= buttons mouse-right) (push-mark) (sup-move-point-to-x-y x y) (exchange-point-and-mark)) ((= buttons mouse-center) (sup-move-point-to-x-y x y) (setq this-command 'yank) (yank)) )) ))) (defun sup-get-tty-num (term-char) "Read from terminal until TERM-CHAR is read, and return intervening number. Upon non-numeric not matching TERM-CHAR signal an error." (let ((num 0) (char (read-char))) (while (and (>= char ?0) (<= char ?9)) (setq num (+ (* num 10) (- char ?0))) (setq char (read-char))) (or (eq term-char char) (error "Invalid data format in mouse command")) num)) (defun sup-move-point-to-x-y (x y) "Position cursor in window coordinates. X and Y are 0-based character positions in the window." (move-to-window-line y) (move-to-column x) ) (defun sup-pos-to-window (x y) "Find window corresponding to frame coordinates. X and Y are 0-based character positions on the frame." (let ((edges (window-edges)) (window nil)) (while (and (not (eq window (selected-window))) (or (< y (nth 1 edges)) (>= y (nth 3 edges)) (< x (nth 0 edges)) (>= x (nth 2 edges)))) (setq window (next-window window)) (setq edges (window-edges window)) ) (or window (selected-window)) ) ) ;;; sup-mouse.el ends here emacs-19.30/lisp/term/tvi970.el100444 74777 1 10247 5351766437 14470 0ustar esrdaemon;;; tvi970.el --- terminal support for the Televideo 970 ;; Author: Jim Blandy , January 1992 ;; Keywords: terminals ;; Copyright (C) 1992 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: ;;; Uses the Emacs 19 terminal initialization features --- won't work with 18. ;;; Code: (or (lookup-key function-key-map "\e[") (define-key function-key-map "\e[" (make-keymap))) ;; (or (lookup-key function-key-map "\eO") ;; (define-key function-key-map "\eO" (make-keymap))) ;; Miscellaneous keys (mapcar (function (lambda (key-binding) (define-key function-key-map (car key-binding) (nth 1 key-binding)))) '( ;; These are set up by termcap or terminfo ;; ("\eOP" [kp-f1]) ;; ("\eOQ" [kp-f2]) ;; ("\eOR" [kp-f3]) ;; ("\eOS" [kp-f4]) ;; These might br set by terminfo ("\e[H" [home]) ("\e[Z" [backtab]) ("\e[i" [print]) ("\e[@" [insert]) ("\e[L" [insertline]) ("\e[M" [deleteline]) ("\e[U" [next]) ;; actually the `page' key ;; These won't be set up by either ("\eOm" [kp-subtract]) ("\eOl" [kp-separator]) ("\eOn" [kp-decimal]) ("\eOM" [kp-enter]) ;; These won't be set up by either either ("\e[K" [key_eol]) ;; Not an X keysym ("\e[J" [key_eos]) ;; Not an X keysym ("\e[2J" [key_clear]) ;; Not an X keysym ("\e[P" [key_dc]) ;; Not an X keysym ("\e[g" [S-tab]) ;; Not an X keysym ("\e[2N" [clearentry]) ;; Not an X keysym ("\e[2K" [S-clearentry]) ;; Not an X keysym ("\e[E" [?\C-j]) ;; Not an X keysym ("\e[g" [S-backtab]) ;; Not an X keysym ("\e[?1i" [key_sprint]) ;; Not an X keysym ("\e[4h" [key_sic]) ;; Not an X keysym ("\e[4l" [S-delete]) ;; Not an X keysym ("\e[Q" [S-insertline]) ;; Not an X keysym ("\e[1Q" [key_sdl]) ;; Not an X keysym ("\e[19l" [key_seol]) ;; Not an X keysym ("\e[19h" [S-erasepage]) ;; Not an X keysym ("\e[V" [S-page]) ;; Not an X keysym ("\eS" [send]) ;; Not an X keysym ("\e5" [S-send]) ;; Not an X keysym )) ;; The numeric keypad keys. (let ((i 0)) (while (< i 10) (define-key function-key-map (format "\eO%c" (+ i ?p)) (vector (intern (format "kp-%d" i)))) (setq i (1+ i)))) ;; The numbered function keys. (let ((i 0)) (while (< i 16) (define-key function-key-map (format "\e?%c" (+ i ?a)) (vector (intern (format "f%d" (1+ i))))) (define-key function-key-map (format "\e?%c" (+ i ?A)) (vector (intern (format "S-f%d" (1+ i))))) (setq i (1+ i)))) ;;; Should keypad numbers send ordinary digits or distinct escape sequences? (defvar tvi970-keypad-numeric nil "The terminal should be in numeric keypad mode iff this variable is non-nil. Do not set this variable! Call the function ``tvi970-set-keypad-mode''.") (defun tvi970-set-keypad-mode (&optional arg) "Set the current mode of the TVI 970 numeric keypad. In ``numeric keypad mode'', the number keys on the keypad act as ordinary digits. In ``alternate keypad mode'', the keys send distinct escape sequences, meaning that they can have their own bindings, independent of the normal number keys. With no argument, toggle between the two possible modes. With a positive argument, select alternate keypad mode. With a negative argument, select numeric keypad mode." (interactive "P") (setq tvi970-keypad-numeric (if (null arg) (not tvi970-keypad-numeric) (> (prefix-numeric-value arg) 0))) (send-string-to-terminal (if tvi970-keypad-numeric "\e=" "\e>"))) (tvi970-set-keypad-mode 1) ;;; tv970 ends here emacs-19.30/lisp/term/vt100.el100444 12120 1 4074 5402026103 14207 0ustar rmsdaemon;;; vt100.el --- define VT100 function key sequences in function-key-map ;; Author: FSF ;; Keywords: terminals ;; Copyright (C) 1989, 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: ;; Uses the Emacs 19 terminal initialization features --- won't work with 18. ;; Handles all VT100 clones, including the Apollo terminal. Also handles ;; the VT200 --- its PF- and arrow- keys are different, but all those ;; are really set up by the terminal initialization code, which mines them ;; out of termcap. This package is here to define the keypad comma, dash ;; and period (which aren't in termcap's repertoire) and the function for ;; changing from 80 to 132 columns & vv. ;;; Code: ;; Set up function-key-map entries that termcap and terminfo don't know. (load "term/lk201" nil t) ;;; Controlling the screen width. (defconst vt100-wide-mode (= (frame-width) 132) "t if vt100 is in 132-column mode.") (defun vt100-wide-mode (&optional arg) "Toggle 132/80 column mode for vt100s. With positive argument, switch to 132-column mode. With negative argument, switch to 80-column mode." (interactive "P") (setq vt100-wide-mode (if (null arg) (not vt100-wide-mode) (> (prefix-numeric-value arg) 0))) (send-string-to-terminal (if vt100-wide-mode "\e[?3h" "\e[?3l")) (set-frame-width terminal-frame (if vt100-wide-mode 132 80))) ;;; vt100.el ends here emacs-19.30/lisp/term/vt102.el100666 12120 1 32 5402027043 14151 0ustar rmsdaemon(load "term/vt100" nil t) emacs-19.30/lisp/term/vt125.el100666 12120 1 32 5402027050 14154 0ustar rmsdaemon(load "term/vt100" nil t) emacs-19.30/lisp/term/vt200.el100444 12120 1 334 5410016710 14165 0ustar rmsdaemon;; For our purposes we can treat the vt200 and vt100 almost alike. ;; Most differences are handled by the termcap entry. (load "term/vt100" nil t) ;; Make F11 an escape key. (define-key function-key-map "\e[23~" [?\e]) emacs-19.30/lisp/term/vt201.el100444 12120 1 335 5515523776 14214 0ustar rmsdaemon;; For our purposes we can treat the vt200 and vt100 almost alike. ;; Most differences are handled by the termcap entry. (load "term/vt100" nil t) ;; Make F11 an escape key. (define-key function-key-map "\e[23~" [?\e]) emacs-19.30/lisp/term/vt220.el100444 12120 1 335 5515524010 14173 0ustar rmsdaemon;; For our purposes we can treat the vt200 and vt100 almost alike. ;; Most differences are handled by the termcap entry. (load "term/vt100" nil t) ;; Make F11 an escape key. (define-key function-key-map "\e[23~" [?\e]) emacs-19.30/lisp/term/vt240.el100444 12120 1 334 5515524021 14176 0ustar rmsdaemon;; For our purposes we can treat the vt200 and vt100 almost alike. ;; Most differences are handled by the termcap entry. (load "term/vt100" nil t) ;; Make F11 an escape key. (define-key function-key-map "\e[23~" [?\e]) emacs-19.30/lisp/term/vt300.el100666 12120 1 143 5551615364 14212 0ustar rmsdaemon(load "term/vt100" nil t) ;; Make F11 an escape key. (define-key function-key-map "\e[23~" [?\e]) emacs-19.30/lisp/term/vt320.el100666 12120 1 143 5551615415 14211 0ustar rmsdaemon(load "term/vt100" nil t) ;; Make F11 an escape key. (define-key function-key-map "\e[23~" [?\e]) emacs-19.30/lisp/term/vt400.el100666 12120 1 143 5551615425 14211 0ustar rmsdaemon(load "term/vt100" nil t) ;; Make F11 an escape key. (define-key function-key-map "\e[23~" [?\e]) emacs-19.30/lisp/term/vt420.el100666 12120 1 143 5551615435 14214 0ustar rmsdaemon(load "term/vt100" nil t) ;; Make F11 an escape key. (define-key function-key-map "\e[23~" [?\e]) emacs-19.30/lisp/term/win32-win.el100444 23073 1 44312 6047607611 16007 0ustar voelkerdaemon;;; win32-win.el --- parse switches controlling interface with win32 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: Kevin Gallo ;; Keywords: terminals ;;; 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: ;; win32-win.el: this file is loaded from ../lisp/startup.el when it recognizes ;; that win32 windows are to be used. Command line switches are parsed and those ;; pertaining to win32 are processed and removed from the command line. The ;; win32 display is opened and hooks are set for popping up the initial window. ;; startup.el will then examine startup files, and eventually call the hooks ;; which create the first window (s). ;;; Code: ;; These are the standard X switches from the Xt Initialize.c file of ;; Release 4. ;; Command line Resource Manager string ;; +rv *reverseVideo ;; +synchronous *synchronous ;; -background *background ;; -bd *borderColor ;; -bg *background ;; -bordercolor *borderColor ;; -borderwidth .borderWidth ;; -bw .borderWidth ;; -display .display ;; -fg *foreground ;; -fn *font ;; -font *font ;; -foreground *foreground ;; -geometry .geometry ;; -i .iconType ;; -itype .iconType ;; -iconic .iconic ;; -name .name ;; -reverse *reverseVideo ;; -rv *reverseVideo ;; -selectionTimeout .selectionTimeout ;; -synchronous *synchronous ;; -xrm ;; An alist of X options and the function which handles them. See ;; ../startup.el. (if (not (eq window-system 'win32)) (error "%s: Loading win32-win.el but not compiled for win32" (invocation-name))) (require 'frame) (require 'mouse) (require 'scroll-bar) (require 'faces) (require 'select) (require 'menu-bar) (defvar x-invocation-args) (defvar x-command-line-resources nil) (defconst x-option-alist '(("-bw" . x-handle-numeric-switch) ("-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) ("-rv" . x-handle-switch) ("-reverse" . x-handle-switch) ("-fn" . x-handle-switch) ("-font" . x-handle-switch) ("-ib" . x-handle-numeric-switch) ("-g" . x-handle-geometry) ("-geometry" . x-handle-geometry) ("-fg" . x-handle-switch) ("-foreground". x-handle-switch) ("-bg" . x-handle-switch) ("-background". x-handle-switch) ("-ms" . x-handle-switch) ("-itype" . x-handle-switch) ("-i" . x-handle-switch) ("-iconic" . x-handle-iconic) ("-xrm" . x-handle-xrm-switch) ("-cr" . x-handle-switch) ("-vb" . x-handle-switch) ("-hb" . x-handle-switch) ("-bd" . x-handle-switch))) (defconst x-long-option-alist '(("--border-width" . "-bw") ("--display" . "-d") ("--name" . "-name") ("--title" . "-T") ("--reverse-video" . "-reverse") ("--font" . "-font") ("--internal-border" . "-ib") ("--geometry" . "-geometry") ("--foreground-color" . "-fg") ("--background-color" . "-bg") ("--mouse-color" . "-ms") ("--icon-type" . "-itype") ("--iconic" . "-iconic") ("--xrm" . "-xrm") ("--cursor-color" . "-cr") ("--vertical-scroll-bars" . "-vb") ("--border-color" . "-bd"))) (defconst x-switch-definitions '(("-name" name) ("-T" name) ("-r" reverse t) ("-rv" reverse t) ("-reverse" reverse t) ("-fn" font) ("-font" font) ("-ib" internal-border-width) ("-fg" foreground-color) ("-foreground" foreground-color) ("-bg" background-color) ("-background" background-color) ("-ms" mouse-color) ("-cr" cursor-color) ("-itype" icon-type t) ("-i" icon-type t) ("-vb" vertical-scroll-bars t) ("-hb" horizontal-scroll-bars t) ("-bd" border-color) ("-bw" border-width))) ;; Handler for switches of the form "-switch value" or "-switch". (defun x-handle-switch (switch) (let ((aelt (assoc switch x-switch-definitions))) (if aelt (if (nth 2 aelt) (setq default-frame-alist (cons (cons (nth 1 aelt) (nth 2 aelt)) default-frame-alist)) (setq default-frame-alist (cons (cons (nth 1 aelt) (car x-invocation-args)) default-frame-alist) x-invocation-args (cdr x-invocation-args)))))) ;; Make -iconic apply only to the initial frame! (defun x-handle-iconic (switch) (setq initial-frame-alist (cons '(visibility . icon) initial-frame-alist))) ;; Handler for switches of the form "-switch n" (defun x-handle-numeric-switch (switch) (let ((aelt (assoc switch x-switch-definitions))) (if aelt (setq default-frame-alist (cons (cons (nth 1 aelt) (string-to-int (car x-invocation-args))) default-frame-alist) x-invocation-args (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))) ;; Handle the geometry option (defun x-handle-geometry (switch) (let ((geo (x-parse-geometry (car x-invocation-args)))) (setq initial-frame-alist (append initial-frame-alist (if (or (assq 'left geo) (assq 'top geo)) '((user-position . t))) (if (or (assq 'height geo) (assq 'width geo)) '((user-size . t))) geo) 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 display name specifying server and frame.") (defun x-handle-display (switch) (setq x-display-name (car x-invocation-args) x-invocation-args (cdr x-invocation-args))) (defvar x-invocation-args nil) (defun x-handle-args (args) "Process the X-related command line options in ARGS. This is done before the user's startup file is loaded. They are copied to x-invocation args from which the X-related things are extracted, first the switch (e.g., \"-fg\") in the following code, and possible values \(e.g., \"black\") in the option handler code (e.g., x-handle-switch). This returns ARGS with the arguments that have been processed removed." (message "%s" args) (setq x-invocation-args args args nil) (while x-invocation-args (let* ((this-switch (car x-invocation-args)) (orig-this-switch this-switch) completion argval aelt) (setq x-invocation-args (cdr x-invocation-args)) ;; Check for long options with attached arguments ;; and separate out the attached option argument into argval. (if (string-match "^--[^=]*=" this-switch) (setq argval (substring this-switch (match-end 0)) this-switch (substring this-switch 0 (1- (match-end 0))))) (setq completion (try-completion this-switch x-long-option-alist)) (if (eq completion t) ;; Exact match for long option. (setq this-switch (cdr (assoc this-switch x-long-option-alist))) (if (stringp completion) (let ((elt (assoc completion x-long-option-alist))) ;; Check for abbreviated long option. (or elt (error "Option `%s' is ambiguous" this-switch)) (setq this-switch (cdr elt))) ;; Check for a short option. (setq argval nil this-switch orig-this-switch))) (setq aelt (assoc this-switch x-option-alist)) (if aelt (if argval (let ((x-invocation-args (cons argval x-invocation-args))) (funcall (cdr aelt) this-switch)) (funcall (cdr aelt) this-switch)) (setq args (cons this-switch args))))) (setq args (nreverse args))) ;; ;; Available colors ;; (defvar x-colors '("aquamarine" "Aquamarine" "medium aquamarine" "MediumAquamarine" "black" "Black" "blue" "Blue" "cadet blue" "CadetBlue" "cornflower blue" "CornflowerBlue" "dark slate blue" "DarkSlateBlue" "light blue" "LightBlue" "light steel blue" "LightSteelBlue" "medium blue" "MediumBlue" "medium slate blue" "MediumSlateBlue" "midnight blue" "MidnightBlue" "navy blue" "NavyBlue" "navy" "Navy" "sky blue" "SkyBlue" "slate blue" "SlateBlue" "steel blue" "SteelBlue" "coral" "Coral" "cyan" "Cyan" "firebrick" "Firebrick" "brown" "Brown" "gold" "Gold" "goldenrod" "Goldenrod" "green" "Green" "dark green" "DarkGreen" "dark olive green" "DarkOliveGreen" "forest green" "ForestGreen" "lime green" "LimeGreen" "medium sea green" "MediumSeaGreen" "medium spring green" "MediumSpringGreen" "pale green" "PaleGreen" "sea green" "SeaGreen" "spring green" "SpringGreen" "yellow green" "YellowGreen" "dark slate grey" "DarkSlateGrey" "dark slate gray" "DarkSlateGray" "dim grey" "DimGrey" "dim gray" "DimGray" "light grey" "LightGrey" "light gray" "LightGray" "gray" "grey" "Gray" "Grey" "khaki" "Khaki" "magenta" "Magenta" "maroon" "Maroon" "orange" "Orange" "orchid" "Orchid" "dark orchid" "DarkOrchid" "medium orchid" "MediumOrchid" "pink" "Pink" "plum" "Plum" "red" "Red" "indian red" "IndianRed" "medium violet red" "MediumVioletRed" "orange red" "OrangeRed" "violet red" "VioletRed" "salmon" "Salmon" "sienna" "Sienna" "tan" "Tan" "thistle" "Thistle" "turquoise" "Turquoise" "dark turquoise" "DarkTurquoise" "medium turquoise" "MediumTurquoise" "violet" "Violet" "blue violet" "BlueViolet" "wheat" "Wheat" "white" "White" "yellow" "Yellow" "green yellow" "GreenYellow") "The full list of X colors from the `rgb.text' file.") (defun x-defined-colors (&optional frame) "Return a list of colors supported for a particular frame. The argument FRAME specifies which frame to try. The value may be different for frames on different X displays." (or frame (setq frame (selected-frame))) (let ((all-colors x-colors) (this-color nil) (defined-colors nil)) (while all-colors (setq this-color (car all-colors) all-colors (cdr all-colors)) (and (face-color-supported-p frame this-color t) (setq defined-colors (cons this-color defined-colors)))) defined-colors)) ;;;; Function keys (defun iconify-or-deiconify-frame () "Iconify the selected frame, or deiconify if it's currently an icon." (interactive) (if (eq (cdr (assq 'visibility (frame-parameters))) t) (iconify-frame) (make-frame-visible))) (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame global-map) ;; Map certain keypad keys into ASCII characters ;; that people usually expect. (define-key function-key-map [backspace] [127]) (define-key function-key-map [delete] [127]) (define-key function-key-map [tab] [?\t]) (define-key function-key-map [linefeed] [?\n]) (define-key function-key-map [clear] [11]) (define-key function-key-map [return] [13]) (define-key function-key-map [escape] [?\e]) (define-key function-key-map [M-backspace] [?\M-\d]) (define-key function-key-map [M-delete] [?\M-\d]) (define-key function-key-map [M-tab] [?\M-\t]) (define-key function-key-map [M-linefeed] [?\M-\n]) (define-key function-key-map [M-clear] [?\M-\013]) (define-key function-key-map [M-return] [?\M-\015]) (define-key function-key-map [M-escape] [?\M-\e]) ;; These tell read-char how to convert ;; these special chars to ASCII. (put 'backspace 'ascii-character 127) (put 'delete 'ascii-character 127) (put 'tab 'ascii-character ?\t) (put 'linefeed 'ascii-character ?\n) (put 'clear 'ascii-character 12) (put 'return 'ascii-character 13) (put 'escape 'ascii-character ?\e) ;;;; Selections and cut buffers ;;; We keep track of the last text selected here, so we can check the ;;; current selection against it, and avoid passing back our own text ;;; from x-cut-buffer-or-selection-value. (defvar x-last-selected-text nil) ;;; It is said that overlarge strings are slow to put into the cut buffer. ;;; Note this value is overridden below. (defvar x-cut-buffer-max 20000 "Max number of characters to put in the cut buffer.") (defvar x-select-enable-clipboard t "Non-nil means cutting and pasting uses the clipboard. This is in addition to the primary selection.") (defun x-select-text (text &optional push) (if x-select-enable-clipboard (win32-set-clipboard-data text))) ;;; Return the value of the current selection. ;;; Consult the selection, then the cut buffer. Treat empty strings ;;; as if they were unset. (defun x-get-selection-value () (if x-select-enable-clipboard (let (text) ;; Don't die if x-get-selection signals an error. (condition-case c (setq text (win32-get-clipboard-data)) (error (message "win32-get-clipboard-data:%s" c))) (if (string= text "") (setq text nil)) text))) ;;; Do the actual Windows setup here; the above code just defines ;;; functions and variables that we use now. (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 ?-)))) ;; For the benefit of older Emacses (19.27 and earlier) that are sharing ;; the same lisp directory, don't pass the third argument unless we seem ;; to have the multi-display support. (if (fboundp 'x-close-connection) (x-open-connection "" x-command-line-resources ;; Exit Emacs with fatal error if this fails. t) (x-open-connection "" x-command-line-resources)) (setq frame-creation-function 'x-create-frame-with-faces) (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) x-cut-buffer-max)) ;; Win32 expects the menu bar cut and paste commands to use the clipboard. ;; This has ,? to match both on Sunos and on Solaris. (menu-bar-enable-clipboard) ;; Apply a geometry resource to the initial frame. Put it at the end ;; of the alist, so that anything specified on the command line takes ;; precedence. (let* ((res-geometry (x-get-resource "geometry" "Geometry")) parsed) (if res-geometry (progn (setq parsed (x-parse-geometry res-geometry)) ;; If the resource specifies a position, ;; call the position and size "user-specified". (if (or (assq 'top parsed) (assq 'left parsed)) (setq parsed (cons '(user-position . t) (cons '(user-size . t) parsed)))) ;; All geometry parms apply to the initial frame. (setq initial-frame-alist (append initial-frame-alist parsed)) ;; The size parms apply to all frames. (if (assq 'height parsed) (setq default-frame-alist (cons (cons 'height (cdr (assq 'height parsed))) default-frame-alist))) (if (assq 'width parsed) (setq default-frame-alist (cons (cons 'width (cdr (assq 'width parsed))) default-frame-alist)))))) ;; 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. (let ((res-selection-timeout (x-get-resource "selectionTimeout" "SelectionTimeout"))) (setq x-selection-timeout 20000) (if res-selection-timeout (setq x-selection-timeout (string-to-number res-selection-timeout)))) (defun x-win-suspend-error () (error "Suspending an emacs running under Win32 makes no sense")) (add-hook 'suspend-hook 'x-win-suspend-error) ;;; Arrange for the kill and yank functions to set and check the clipboard. (setq interprogram-cut-function 'x-select-text) (setq interprogram-paste-function 'x-get-selection-value) ;;; Turn off window-splitting optimization; win32 is usually fast enough ;;; that this is only annoying. (setq split-window-keep-point t) ;; Don't show the frame name; that's redundant. (setq-default mode-line-buffer-identification '("Emacs: %12b")) ;;; Set to a system sound if you want a fancy bell. (set-message-beep 'ok) ;; Remap some functions to call win32 common dialogs (defun internal-face-interactive (what &optional bool) (let* ((fn (intern (concat "face-" what))) (prompt (concat "Set " what " of face")) (face (read-face-name (concat prompt ": "))) (default (if (fboundp fn) (or (funcall fn face (selected-frame)) (funcall fn 'default (selected-frame))))) (fn-win (intern (concat (symbol-name window-system) "-select-" what))) (value (if (fboundp fn-win) (funcall fn-win) (if bool (y-or-n-p (concat "Should face " (symbol-name face) " be " bool "? ")) (read-string (concat prompt " " (symbol-name face) " to: ") default))))) (list face (if (equal value "") nil value)))) ;; Redefine the font selection to use the Win32 dialog (defun mouse-set-font (&rest fonts) (interactive) (set-default-font (win32-select-font))) ;;; win32-win.el ends here emacs-19.30/lisp/term/wyse50.el100444 75424 13 11401 5561560730 14460 0ustar kwzhuser;;; wyse50.el --- terminal support code for Wyse 50 ;; Copyright (C) 1989, 1993, 1994 Free Software Foundation, Inc. ;; Author: Daniel Pfieffer January 1991 ;; Jim Blandy ;; Keywords: terminals ;;; 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: ;; Uses the Emacs 19 terminal initialization features --- won't work with 18. ;; Rewritten for Emacs 19 by jimb, January 1992 ;; Cleaned up for new terminal package conventions by esr, March 1993 ;; Should work well for Televideo TVI 925 although it's overkill. ;; ;; The Wyse50 is ergonomically wonderful, but its escape-sequence design sucks ;; rocks. The left-arrow key emits a backspace (!) and the down-arrow a line ;; feed (!!). Thus, you have to unbind some commonly-used Emacs keys to ;; enable the arrows. ;;; Code: (define-key function-key-map "\C-a" (make-keymap)) (mapcar (function (lambda (key-definition) (define-key function-key-map (car key-definition) (nth 1 key-definition)))) '( ;; These might be set up by termcap and terminfo ("\C-k" [up]) ("\C-j" [down]) ("\C-l" [right]) ("\C-h" [left]) ("\^a@\^m" [f1]) ("\^aA\^m" [f2]) ("\^aB\^m" [f3]) ("\^aC\^m" [f4]) ("\^aD\^m" [f5]) ("\^aE\^m" [f6]) ("\^aF\^m" [f7]) ("\^aG\^m" [f8]) ("\^aH\^m" [f9]) ;; These might be set up by terminfo ("\eK" [next]) ("\eT" [clearline]) ("\^^" [home]) ("\e\^^" [end]) ("\eQ" [insert]) ("\eE" [insertline]) ("\eR" [deleteline]) ("\eP" [print]) ("\er" [replace]) ("\^aI\^m" [f10]) ("\^aJ\^m" [f11]) ("\^aK\^m" [f12]) ("\^aL\^m" [f13]) ("\^aM\^m" [f14]) ("\^aN\^m" [f15]) ("\^aO\^m" [f16]) ("\^a`\^m" [f17]) ("\^aa\^m" [f18]) ("\^ab\^m" [f19]) ("\^ac\^m" [f20]) ("\^ad\^m" [f21]) ("\^ae\^m" [f22]) ("\^af\^m" [f23]) ("\^ag\^m" [f24]) ("\^ah\^m" [f25]) ("\^ai\^m" [f26]) ("\^aj\^m" [f27]) ("\^ak\^m" [f28]) ("\^al\^m" [f29]) ("\^am\^m" [f30]) ("\^an\^m" [f31]) ("\^ao\^m" [f32]) ;; Terminfo may know about these, but X won't ("\eI" [key-stab]) ;; Not an X keysym ("\eJ" [key-snext]) ;; Not an X keysym ("\eY" [key-clear]) ;; Not an X keysym ;; These are totally strange :-) ("\eW" [?\C-?]) ;; Not an X keysym ("\^a\^k\^m" [funct-up]) ;; Not an X keysym ("\^a\^j\^m" [funct-down]) ;; Not an X keysym ("\^a\^l\^m" [funct-right]) ;; Not an X keysym ("\^a\^h\^m" [funct-left]) ;; Not an X keysym ("\^a\^m\^m" [funct-return]) ;; Not an X keysym ("\^a\^i\^m" [funct-tab]) ;; Not an X keysym )) (defun enable-arrow-keys () "To be called by term-setup-hook. Overrides 6 Emacs standard keys whose functions are then typed as follows: C-a Funct Left-arrow C-h M-? LFD Funct Return, some modes override down-arrow via LFD C-k CLR Line C-l Scrn CLR M-r M-x move-to-window-line, Funct up-arrow or down-arrow are similar " (interactive) (mapcar (function (lambda (key-definition) (global-set-key (car key-definition) (nth 1 key-definition)))) ;; By unsetting C-a and then binding it to a prefix, we ;; allow the rest of the function keys which start with C-a ;; to be recognized. '(("\C-a" nil) ("\C-k" nil) ("\C-j" nil) ("\C-l" nil) ("\C-h" nil) ("\er" nil))) (fset 'enable-arrow-keys nil)) ;;; Miscellaneous hacks ;;; This is an ugly hack for a nasty problem: ;;; Wyse 50 takes one character cell to store video attributes (which seems to ;;; explain width 79 rather than 80, column 1 is not used!!!). ;;; On killing (C-x C-c) the end inverse code (on column 1 of line 24) ;;; of the mode line is overwritten AFTER all the y-or-n questions. ;;; This causes the attribute to remain in effect until the mode line has ;;; scrolled of the screen. Suspending (C-z) does not cause this problem. ;;; On such terminals, Emacs should sacrifice the first and last character of ;;; each mode line, rather than a whole screen column! (add-hook 'kill-emacs-hook (function (lambda () (interactive) (send-string-to-terminal (concat "\ea23R" (1+ (frame-width)) "C\eG0"))))) ;;; wyse50.el ends here emacs-19.30/lisp/term/x-win.el100444 75424 13 55313 6046045404 14373 0ustar kwzhuser;;; x-win.el --- parse switches controlling interface with X window system ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: FSF ;; Keywords: terminals ;;; 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: ;; X-win.el: this file is loaded from ../lisp/startup.el when it recognizes ;; that X windows are to be used. Command line switches are parsed and those ;; pertaining to X are processed and removed from the command line. The ;; X display is opened and hooks are set for popping up the initial window. ;; startup.el will then examine startup files, and eventually call the hooks ;; which create the first window (s). ;;; Code: ;; These are the standard X switches from the Xt Initialize.c file of ;; Release 4. ;; Command line Resource Manager string ;; +rv *reverseVideo ;; +synchronous *synchronous ;; -background *background ;; -bd *borderColor ;; -bg *background ;; -bordercolor *borderColor ;; -borderwidth .borderWidth ;; -bw .borderWidth ;; -display .display ;; -fg *foreground ;; -fn *font ;; -font *font ;; -foreground *foreground ;; -geometry .geometry ;; -i .iconType ;; -itype .iconType ;; -iconic .iconic ;; -name .name ;; -reverse *reverseVideo ;; -rv *reverseVideo ;; -selectionTimeout .selectionTimeout ;; -synchronous *synchronous ;; -xrm ;; An alist of X options and the function which handles them. See ;; ../startup.el. (if (not (eq window-system 'x)) (error "%s: Loading x-win.el but not compiled for X" (invocation-name))) (require 'frame) (require 'mouse) (require 'scroll-bar) (require 'faces) (require 'select) (require 'menu-bar) (defvar x-invocation-args) (defvar x-command-line-resources nil) (defconst x-option-alist '(("-bw" . x-handle-numeric-switch) ("-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) ("-rv" . x-handle-switch) ("-reverse" . x-handle-switch) ("-fn" . x-handle-switch) ("-font" . x-handle-switch) ("-ib" . x-handle-numeric-switch) ("-g" . x-handle-geometry) ("-geometry" . x-handle-geometry) ("-fg" . x-handle-switch) ("-foreground". x-handle-switch) ("-bg" . x-handle-switch) ("-background". x-handle-switch) ("-ms" . x-handle-switch) ("-itype" . x-handle-switch) ("-i" . x-handle-switch) ("-iconic" . x-handle-iconic) ("-xrm" . x-handle-xrm-switch) ("-cr" . x-handle-switch) ("-vb" . x-handle-switch) ("-hb" . x-handle-switch) ("-bd" . x-handle-switch))) (defconst x-long-option-alist '(("--border-width" . "-bw") ("--display" . "-d") ("--name" . "-name") ("--title" . "-T") ("--reverse-video" . "-reverse") ("--font" . "-font") ("--internal-border" . "-ib") ("--geometry" . "-geometry") ("--foreground-color" . "-fg") ("--background-color" . "-bg") ("--mouse-color" . "-ms") ("--icon-type" . "-itype") ("--iconic" . "-iconic") ("--xrm" . "-xrm") ("--cursor-color" . "-cr") ("--vertical-scroll-bars" . "-vb") ("--border-color" . "-bd"))) (defconst x-switch-definitions '(("-name" name) ("-T" name) ("-r" reverse t) ("-rv" reverse t) ("-reverse" reverse t) ("-fn" font) ("-font" font) ("-ib" internal-border-width) ("-fg" foreground-color) ("-foreground" foreground-color) ("-bg" background-color) ("-background" background-color) ("-ms" mouse-color) ("-cr" cursor-color) ("-itype" icon-type t) ("-i" icon-type t) ("-vb" vertical-scroll-bars t) ("-hb" horizontal-scroll-bars t) ("-bd" border-color) ("-bw" border-width))) ;; Handler for switches of the form "-switch value" or "-switch". (defun x-handle-switch (switch) (let ((aelt (assoc switch x-switch-definitions))) (if aelt (if (nth 2 aelt) (setq default-frame-alist (cons (cons (nth 1 aelt) (nth 2 aelt)) default-frame-alist)) (setq default-frame-alist (cons (cons (nth 1 aelt) (car x-invocation-args)) default-frame-alist) x-invocation-args (cdr x-invocation-args)))))) ;; Make -iconic apply only to the initial frame! (defun x-handle-iconic (switch) (setq initial-frame-alist (cons '(visibility . icon) initial-frame-alist))) ;; Handler for switches of the form "-switch n" (defun x-handle-numeric-switch (switch) (let ((aelt (assoc switch x-switch-definitions))) (if aelt (setq default-frame-alist (cons (cons (nth 1 aelt) (string-to-int (car x-invocation-args))) default-frame-alist) x-invocation-args (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))) ;; Handle the geometry option (defun x-handle-geometry (switch) (let ((geo (x-parse-geometry (car x-invocation-args)))) (setq initial-frame-alist (append initial-frame-alist (if (or (assq 'left geo) (assq 'top geo)) '((user-position . t))) (if (or (assq 'height geo) (assq 'width geo)) '((user-size . t))) geo) 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.") (defun x-handle-display (switch) (setq x-display-name (car x-invocation-args) x-invocation-args (cdr x-invocation-args))) (defvar x-invocation-args nil) (defun x-handle-args (args) "Process the X-related command line options in ARGS. This is done before the user's startup file is loaded. They are copied to x-invocation args from which the X-related things are extracted, first the switch (e.g., \"-fg\") in the following code, and possible values \(e.g., \"black\") in the option handler code (e.g., x-handle-switch). This returns ARGS with the arguments that have been processed removed." (message "%s" args) (setq x-invocation-args args args nil) (while x-invocation-args (let* ((this-switch (car x-invocation-args)) (orig-this-switch this-switch) completion argval aelt) (setq x-invocation-args (cdr x-invocation-args)) ;; Check for long options with attached arguments ;; and separate out the attached option argument into argval. (if (string-match "^--[^=]*=" this-switch) (setq argval (substring this-switch (match-end 0)) this-switch (substring this-switch 0 (1- (match-end 0))))) (setq completion (try-completion this-switch x-long-option-alist)) (if (eq completion t) ;; Exact match for long option. (setq this-switch (cdr (assoc this-switch x-long-option-alist))) (if (stringp completion) (let ((elt (assoc completion x-long-option-alist))) ;; Check for abbreviated long option. (or elt (error "Option `%s' is ambiguous" this-switch)) (setq this-switch (cdr elt))) ;; Check for a short option. (setq argval nil this-switch orig-this-switch))) (setq aelt (assoc this-switch x-option-alist)) (if aelt (if argval (let ((x-invocation-args (cons argval x-invocation-args))) (funcall (cdr aelt) this-switch)) (funcall (cdr aelt) this-switch)) (setq args (cons this-switch args))))) (setq args (nreverse args))) ;; ;; Standard X cursor shapes, courtesy of Mr. Fox, who wanted ALL of them. ;; (defconst x-pointer-X-cursor 0) (defconst x-pointer-arrow 2) (defconst x-pointer-based-arrow-down 4) (defconst x-pointer-based-arrow-up 6) (defconst x-pointer-boat 8) (defconst x-pointer-bogosity 10) (defconst x-pointer-bottom-left-corner 12) (defconst x-pointer-bottom-right-corner 14) (defconst x-pointer-bottom-side 16) (defconst x-pointer-bottom-tee 18) (defconst x-pointer-box-spiral 20) (defconst x-pointer-center-ptr 22) (defconst x-pointer-circle 24) (defconst x-pointer-clock 26) (defconst x-pointer-coffee-mug 28) (defconst x-pointer-cross 30) (defconst x-pointer-cross-reverse 32) (defconst x-pointer-crosshair 34) (defconst x-pointer-diamond-cross 36) (defconst x-pointer-dot 38) (defconst x-pointer-dotbox 40) (defconst x-pointer-double-arrow 42) (defconst x-pointer-draft-large 44) (defconst x-pointer-draft-small 46) (defconst x-pointer-draped-box 48) (defconst x-pointer-exchange 50) (defconst x-pointer-fleur 52) (defconst x-pointer-gobbler 54) (defconst x-pointer-gumby 56) (defconst x-pointer-hand1 58) (defconst x-pointer-hand2 60) (defconst x-pointer-heart 62) (defconst x-pointer-icon 64) (defconst x-pointer-iron-cross 66) (defconst x-pointer-left-ptr 68) (defconst x-pointer-left-side 70) (defconst x-pointer-left-tee 72) (defconst x-pointer-leftbutton 74) (defconst x-pointer-ll-angle 76) (defconst x-pointer-lr-angle 78) (defconst x-pointer-man 80) (defconst x-pointer-middlebutton 82) (defconst x-pointer-mouse 84) (defconst x-pointer-pencil 86) (defconst x-pointer-pirate 88) (defconst x-pointer-plus 90) (defconst x-pointer-question-arrow 92) (defconst x-pointer-right-ptr 94) (defconst x-pointer-right-side 96) (defconst x-pointer-right-tee 98) (defconst x-pointer-rightbutton 100) (defconst x-pointer-rtl-logo 102) (defconst x-pointer-sailboat 104) (defconst x-pointer-sb-down-arrow 106) (defconst x-pointer-sb-h-double-arrow 108) (defconst x-pointer-sb-left-arrow 110) (defconst x-pointer-sb-right-arrow 112) (defconst x-pointer-sb-up-arrow 114) (defconst x-pointer-sb-v-double-arrow 116) (defconst x-pointer-shuttle 118) (defconst x-pointer-sizing 120) (defconst x-pointer-spider 122) (defconst x-pointer-spraycan 124) (defconst x-pointer-star 126) (defconst x-pointer-target 128) (defconst x-pointer-tcross 130) (defconst x-pointer-top-left-arrow 132) (defconst x-pointer-top-left-corner 134) (defconst x-pointer-top-right-corner 136) (defconst x-pointer-top-side 138) (defconst x-pointer-top-tee 140) (defconst x-pointer-trek 142) (defconst x-pointer-ul-angle 144) (defconst x-pointer-umbrella 146) (defconst x-pointer-ur-angle 148) (defconst x-pointer-watch 150) (defconst x-pointer-xterm 152) ;; ;; Available colors ;; (defvar x-colors '("aquamarine" "Aquamarine" "medium aquamarine" "MediumAquamarine" "black" "Black" "blue" "Blue" "cadet blue" "CadetBlue" "cornflower blue" "CornflowerBlue" "dark slate blue" "DarkSlateBlue" "light blue" "LightBlue" "light steel blue" "LightSteelBlue" "medium blue" "MediumBlue" "medium slate blue" "MediumSlateBlue" "midnight blue" "MidnightBlue" "navy blue" "NavyBlue" "navy" "Navy" "sky blue" "SkyBlue" "slate blue" "SlateBlue" "steel blue" "SteelBlue" "coral" "Coral" "cyan" "Cyan" "firebrick" "Firebrick" "brown" "Brown" "gold" "Gold" "goldenrod" "Goldenrod" "green" "Green" "dark green" "DarkGreen" "dark olive green" "DarkOliveGreen" "forest green" "ForestGreen" "lime green" "LimeGreen" "medium sea green" "MediumSeaGreen" "medium spring green" "MediumSpringGreen" "pale green" "PaleGreen" "sea green" "SeaGreen" "spring green" "SpringGreen" "yellow green" "YellowGreen" "dark slate grey" "DarkSlateGrey" "dark slate gray" "DarkSlateGray" "dim grey" "DimGrey" "dim gray" "DimGray" "light grey" "LightGrey" "light gray" "LightGray" "gray" "grey" "Gray" "Grey" "khaki" "Khaki" "magenta" "Magenta" "maroon" "Maroon" "orange" "Orange" "orchid" "Orchid" "dark orchid" "DarkOrchid" "medium orchid" "MediumOrchid" "pink" "Pink" "plum" "Plum" "red" "Red" "indian red" "IndianRed" "medium violet red" "MediumVioletRed" "orange red" "OrangeRed" "violet red" "VioletRed" "salmon" "Salmon" "sienna" "Sienna" "tan" "Tan" "thistle" "Thistle" "turquoise" "Turquoise" "dark turquoise" "DarkTurquoise" "medium turquoise" "MediumTurquoise" "violet" "Violet" "blue violet" "BlueViolet" "wheat" "Wheat" "white" "White" "yellow" "Yellow" "green yellow" "GreenYellow") "The list of X colors from the `rgb.txt' file.") (defun x-defined-colors (&optional frame) "Return a list of colors supported for a particular frame. The argument FRAME specifies which frame to try. The value may be different for frames on different X displays." (or frame (setq frame (selected-frame))) (let ((all-colors x-colors) (this-color nil) (defined-colors nil)) (while all-colors (setq this-color (car all-colors) all-colors (cdr all-colors)) (and (face-color-supported-p frame this-color t) (setq defined-colors (cons this-color defined-colors)))) defined-colors)) ;;;; Function keys (defun iconify-or-deiconify-frame () "Iconify the selected frame, or deiconify if it's currently an icon." (interactive) (if (eq (cdr (assq 'visibility (frame-parameters))) t) (iconify-frame) (make-frame-visible))) (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame global-map) ;; Map certain keypad keys into ASCII characters ;; that people usually expect. (define-key function-key-map [backspace] [127]) (define-key function-key-map [delete] [127]) (define-key function-key-map [tab] [?\t]) (define-key function-key-map [linefeed] [?\n]) (define-key function-key-map [clear] [?\C-l]) (define-key function-key-map [return] [?\C-m]) (define-key function-key-map [escape] [?\e]) (define-key function-key-map [M-backspace] [?\M-\d]) (define-key function-key-map [M-delete] [?\M-\d]) (define-key function-key-map [M-tab] [?\M-\t]) (define-key function-key-map [M-linefeed] [?\M-\n]) (define-key function-key-map [M-clear] [?\M-\C-l]) (define-key function-key-map [M-return] [?\M-\C-m]) (define-key function-key-map [M-escape] [?\M-\e]) ;; These tell read-char how to convert ;; these special chars to ASCII. (put 'backspace 'ascii-character 127) (put 'delete 'ascii-character 127) (put 'tab 'ascii-character ?\t) (put 'linefeed 'ascii-character ?\n) (put 'clear 'ascii-character 12) (put 'return 'ascii-character 13) (put 'escape 'ascii-character ?\e) (defun vendor-specific-keysyms (vendor) "Return the appropriate value of system-key-alist for VENDOR. VENDOR is a string containing the name of the X Server's vendor, as returned by (x-server-vendor)." (cond ((string-equal vendor "Apollo Computer Inc.") '((65280 . linedel) (65281 . chardel) (65282 . copy) (65283 . cut) (65284 . paste) (65285 . move) (65286 . grow) (65287 . cmd) (65288 . shell) (65289 . leftbar) (65290 . rightbar) (65291 . leftbox) (65292 . rightbox) (65293 . upbox) (65294 . downbox) (65295 . pop) (65296 . read) (65297 . edit) (65298 . save) (65299 . exit) (65300 . repeat))) ((or (string-equal vendor "Hewlett-Packard Incorporated") (string-equal vendor "Hewlett-Packard Company")) '(( 168 . mute-acute) ( 169 . mute-grave) ( 170 . mute-asciicircum) ( 171 . mute-diaeresis) ( 172 . mute-asciitilde) ( 175 . lira) ( 190 . guilder) ( 252 . block) ( 256 . longminus) (65388 . reset) (65389 . system) (65390 . user) (65391 . clearline) (65392 . insertline) (65393 . deleteline) (65394 . insertchar) (65395 . deletechar) (65396 . backtab) (65397 . kp-backtab))) ((or (string-equal vendor "X11/NeWS - Sun Microsystems Inc.") (string-equal vendor "X Consortium")) '((392976 . f36) (392977 . f37) (393056 . req) ;; These are for Sun under X11R6 (393072 . props) (393073 . front) (393074 . copy) (393075 . open) (393076 . paste) (393077 . cut))) (t ;; This is used by DEC's X server. '((65280 . remove))))) ;;;; Selections and cut buffers ;;; We keep track of the last text selected here, so we can check the ;;; current selection against it, and avoid passing back our own text ;;; from x-cut-buffer-or-selection-value. (defvar x-last-selected-text nil) ;;; It is said that overlarge strings are slow to put into the cut buffer. ;;; Note this value is overridden below. (defvar x-cut-buffer-max 20000 "Max number of characters to put in the cut buffer.") (defvar x-select-enable-clipboard nil "Non-nil means cutting and pasting uses the clipboard. This is in addition to the primary selection.") ;;; Make TEXT, a string, the primary X selection. ;;; Also, set the value of X cut buffer 0, for backward compatibility ;;; with older X applications. ;;; gildea@lcs.mit.edu says it's not desirable to put kills ;;; in the clipboard. (defun x-select-text (text &optional push) ;; Don't send the cut buffer too much text. ;; It becomes slow, and if really big it causes errors. (if (< (length text) x-cut-buffer-max) (x-set-cut-buffer text push) (x-set-cut-buffer "" push)) (x-set-selection 'PRIMARY text) (if x-select-enable-clipboard (x-set-selection 'CLIPBOARD text)) (setq x-last-selected-text text)) ;;; Return the value of the current X selection. ;;; Consult the selection, then the cut buffer. Treat empty strings ;;; as if they were unset. (defun x-cut-buffer-or-selection-value () (let (text) ;; Don't die if x-get-selection signals an error. (condition-case c (setq text (x-get-selection 'PRIMARY)) (error (message "%s" c))) (if (string= text "") (setq text nil)) (if x-select-enable-clipboard (condition-case c (setq text (x-get-selection 'CLIPBOARD)) (error (message "%s" c)))) (if (string= text "") (setq text nil)) (or text (setq text (x-get-cut-buffer 0))) (if (string= text "") (setq text nil)) (cond ((not text) nil) ((eq text x-last-selected-text) nil) ((string= text x-last-selected-text) ;; Record the newer string, so subsequent calls can use the `eq' test. (setq x-last-selected-text text) nil) (t (setq x-last-selected-text text))))) ;;; Do the actual X Windows setup here; the above code just defines ;;; functions and variables that we use now. (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 ?-)))) ;; For the benefit of older Emacses (19.27 and earlier) that are sharing ;; the same lisp directory, don't pass the third argument unless we seem ;; to have the multi-display support. (if (fboundp 'x-close-connection) (x-open-connection (or x-display-name (setq x-display-name (getenv "DISPLAY"))) x-command-line-resources ;; Exit Emacs with fatal error if this fails. t) (x-open-connection (or x-display-name (setq x-display-name (getenv "DISPLAY"))) x-command-line-resources)) (setq frame-creation-function 'x-create-frame-with-faces) (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) x-cut-buffer-max)) ;; Sun expects the menu bar cut and paste commands to use the clipboard. ;; This has ,? to match both on Sunos and on Solaris. (if (string-match "Sun Microsystems,? Inc\\." (x-server-vendor)) (menu-bar-enable-clipboard)) ;; Apply a geometry resource to the initial frame. Put it at the end ;; of the alist, so that anything specified on the command line takes ;; precedence. (let* ((res-geometry (x-get-resource "geometry" "Geometry")) parsed) (if res-geometry (progn (setq parsed (x-parse-geometry res-geometry)) ;; If the resource specifies a position, ;; call the position and size "user-specified". (if (or (assq 'top parsed) (assq 'left parsed)) (setq parsed (cons '(user-position . t) (cons '(user-size . t) parsed)))) ;; All geometry parms apply to the initial frame. (setq initial-frame-alist (append initial-frame-alist parsed)) ;; The size parms apply to all frames. (if (assq 'height parsed) (setq default-frame-alist (cons (cons 'height (cdr (assq 'height parsed))) default-frame-alist))) (if (assq 'width parsed) (setq default-frame-alist (cons (cons 'width (cdr (assq 'width parsed))) default-frame-alist)))))) ;; 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. (let ((res-selection-timeout (x-get-resource "selectionTimeout" "SelectionTimeout"))) (setq x-selection-timeout 20000) (if res-selection-timeout (setq x-selection-timeout (string-to-number res-selection-timeout)))) (defun x-win-suspend-error () (error "Suspending an emacs running under X makes no sense")) (add-hook 'suspend-hook 'x-win-suspend-error) ;;; Arrange for the kill and yank functions to set and check the clipboard. (setq interprogram-cut-function 'x-select-text) (setq interprogram-paste-function 'x-cut-buffer-or-selection-value) ;;; Turn off window-splitting optimization; X is usually fast enough ;;; that this is only annoying. (setq split-window-keep-point t) ;; Don't show the frame name; that's redundant with X. (setq-default mode-line-buffer-identification '("Emacs: %12b")) ;;; x-win.el ends here emacs-19.30/lisp/term/xterm.el100444 75424 1 3464 5765730523 14724 0ustar kwzhdaemon;;; xterm.el --- define function key sequences for xterm ;; Author: FSF ;; Keywords: terminals ;; Copyright (C) 1995 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. ;;;; Code: (define-key function-key-map "\e[A" [up]) (define-key function-key-map "\e[B" [down]) (define-key function-key-map "\e[C" [right]) (define-key function-key-map "\e[D" [left]) (define-key function-key-map "\e[2~" [insert]) (define-key function-key-map "\e[4~" [select]) (define-key function-key-map "\e[5~" [prior]) (define-key function-key-map "\e[6~" [next]) (define-key function-key-map "\e[11~" [f1]) (define-key function-key-map "\e[12~" [f2]) (define-key function-key-map "\e[13~" [f3]) (define-key function-key-map "\e[14~" [f4]) (define-key function-key-map "\e[15~" [f5]) (define-key function-key-map "\e[17~" [f6]) (define-key function-key-map "\e[18~" [f7]) (define-key function-key-map "\e[19~" [f8]) (define-key function-key-map "\e[20~" [f9]) (define-key function-key-map "\e[21~" [f10]) (define-key function-key-map "\e[23~" [f11]) (define-key function-key-map "\e[24~" [f12]) (define-key function-key-map "\e[29~" [print]) emacs-19.30/lisp/term/apollo.elc100666 13437 1 760 6003026157 15115 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jul 18 17:49:34 1995 ;;; from file /home/fsf/rms/e19/lisp/term/apollo.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`apollo.el' was compiled for Emacs 19.29 or later")) (load "term/vt100" nil t) emacs-19.30/lisp/term/bg-mouse.elc100666 74777 1 15177 6003026170 15276 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jul 18 17:49:36 1995 ;;; from file /home/fsf/rms/e19/lisp/term/bg-mouse.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`bg-mouse.el' was compiled for Emacs 19.29 or later")) #@79 *Non-nil for mouse hits to select new window, then execute; else just select. (defvar bg-mouse-fast-select-window nil (#$ . -479)) (byte-code "ÀÁ\nBÃÄ\nBÃÅ\nBÆÇ\nBÈ É\nBÊ Ë\nBÌ Í\nBÎÏ\nBÀ‡" [1 bg-button-r current-load-list 2 bg-button-m bg-button-c 4 bg-button-l 8 bg-in-modeline 16 bg-in-scrollbar 24 bg-in-minibuf 59 semicolon] 2) #@683 Read, parse, and execute a BBN BitGraph mouse click. L-- move point | These apply for mouse click in a window. --R set mark | If bg-mouse-fast-select-window is nil, L-R kill region | these commands on a nonselected window -C- move point and yank | just select that window. LC- yank-pop | -CR or LCR undo | "Scroll bar" is right-hand window column. on modeline: on "scroll bar": in minibuffer: L-- scroll-up line to top execute-extended-command --R scroll-down line to bottom eval-expression -C- proportional goto-char line to middle suspend-emacs To reinitialize the mouse if the terminal is reset, type ESC : RET (defalias 'bg-mouse-report #[(prefix-arg) "À !ˆÂ SÀ !Ã¥^Å SÀ !Æ¥ZÀÈ!ɦ\nË\f\"\fÍ Ï\f!Ñ SU‰?…FÓ8SU?…[?…[\fÕ8SY\f=…l\f?‰ƒw‚xÚƒ‚‚ƒÚƒ‚ŽÚ\\\\Þà\n\\!\"!\f@Z\"A@Z#„¹ƒÊä\f!ˆå!!ˆä!‚é„ÔƒÛå!!‚éä\f!ˆ&…éå!!.‡" [bg-get-tty-num semicolon frame-width 9 screen-mouse-x frame-height 16 screen-mouse-y 99 8 bg-mouse-buttons bg-window-from-x-y bg-mouse-window selected-window bg-cursor-window window-edges edges screen-height minibuf-p 3 in-modeline-p 2 in-scrollbar-p same-window-p in-minibuf-p bg-in-minibuf 0 bg-in-modeline bg-in-scrollbar bg-mode-bits lookup-key mouse-map char-to-string bg-command bg-mouse-x bg-mouse-y select-window bg-command-execute bg-mouse-fast-select-window] 6 (#$ . 837) "P"]) #@43 Move point to location of BitGraph mouse. (defalias 'bg-set-point #[nil "À \n\"ˆÃ ‰‡" [bg-move-point-to-x-y bg-mouse-x bg-mouse-y next-line this-command temporary-goal-column] 3 (#$ . 2312) nil]) #@41 Set mark at location of BitGraph mouse. (defalias 'bg-set-mark #[nil "À ˆÁ\n \"ˆÄ ‡" [push-mark bg-move-point-to-x-y bg-mouse-x bg-mouse-y exchange-point-and-mark] 3 (#$ . 2516) nil]) #@52 Move point to location of BitGraph mouse and yank. (defalias 'bg-yank #[nil "À \n\"ˆÃà ‡" [bg-move-point-to-x-y bg-mouse-x bg-mouse-y yank this-command] 3 (#$ . 2706) "*"]) (defalias 'yank-pop-1 #[nil "ÀÁ!‡" [yank-pop 1] 2 nil "*"]) #@96 Move point to location of BitGraph mouse and yank. If last command was a yank, do a yank-pop. (defalias 'bg-yank-or-pop #[nil "Á=ƒ\nÂÃ!‡Ä ‡" [last-command yank yank-pop 1 bg-yank] 2 (#$ . 2946) "*"]) (byte-code "ÀÁ\nBÀ‡" [8388607 bg-most-positive-fixnum current-load-list] 2) #@134 Go to location in buffer that is the same percentage of the way through the buffer as the BitGraph mouse's X position in the window. (defalias 'bg-move-by-percentage #[nil "ÁUƒ\nÁ‚& ¥Wƒ _Ä S¥‚&Â Ä S¥_bˆÁyˆÅ ‡" [bg-mouse-x 0 buffer-size bg-most-positive-fixnum window-width what-cursor-position] 3 (#$ . 3234) nil]) #@76 Scroll the line pointed to by the BitGraph mouse to the top of the window. (defalias 'bg-mouse-line-to-top #[nil "À !‡" [scroll-up bg-mouse-y] 2 (#$ . 3567) nil]) #@79 Scroll the line pointed to by the BitGraph mouse to the center of the window (defalias 'bg-mouse-line-to-center #[nil "À ‰Â [Ã\\\\\\Ã¥!‡" [scroll-up bg-mouse-y window-height 2] 5 (#$ . 3736) nil]) #@70 Scroll the line pointed to by the mouse to the bottom of the window. (defalias 'bg-mouse-line-to-bottom #[nil "À Âà Z\\!‡" [scroll-up bg-mouse-y 2 window-height] 4 (#$ . 3940) nil]) (defalias 'bg-kill-region #[nil "ÀÁ  \"‡" [kill-region region-beginning region-end] 3 nil "*"]) #@144 Insert a copy of the word (actually sexp) that the mouse is pointing at. Sexp is inserted into the buffer at point (where the text cursor is). (defalias 'bg-insert-moused-sexp #[nil "ŠÀ \n\"ˆÃÄ!ƒÅuˆ‚ÆÅ!ˆŠÇÅ!ˆ`)`{)É\n!ˆË ˆnƒ4Ì ˆ‚JŠÍuˆÃÎ!?…BÃÏ!)„JÐÑ!ˆÐ!ˆl†jÃÒ!†jÃÓ!ƒeÃÔ!†jŠÐÑ!))‡" [bg-move-point-to-x-y bg-mouse-x bg-mouse-y looking-at "\\s)" 1 forward-sexp backward-sexp moused-text select-window bg-cursor-window delete-horizontal-space indent-according-to-mode -1 "\\s\"" "[`'\"\\]\\|\\s(" insert-string " " "\\s.\\|\\s)" "'" "\\sw"] 3 (#$ . 4226) nil]) #@156 Read from terminal until TERM-CHAR is read, and return intervening number. If non-numeric not matching TERM-CHAR, reprogram the mouse and signal an error. (defalias 'bg-get-tty-num #[(term-char) "ÀÁ ÂZ ÀYƒ\" ÅXƒ\"\fÆ_ \\Á ÂZ‰‚ Â\\=„2È ˆÉÊ!ˆ\f*‡" [0 read-char 48 char num 9 10 term-char bg-program-mouse error "Invalid data format in bg-mouse command: mouse reinitialized."] 4 (#$ . 4805)]) #@95 Position cursor in window coordinates. X and Y are 0-based character positions in the window. (defalias 'bg-move-point-to-x-y #[(x y) "À !ˆi  ÅVƒ SÆ\f \\\\!*‡" [move-to-window-line y window-hscroll scroll-offset zero-column 0 move-to-column x] 4 (#$ . 5212)]) #@105 Find window corresponding to screen coordinates. X and Y are 0-based character positions on the screen. (defalias 'bg-window-from-x-y #[(x y) "À Á\nÄ =„8 A@W„- Æ 8Y„- @W„-È 8Yƒ8É\n!À\n!‚\nÄ =ƒCÁ‚M\n„LÄ ‚M\n*‡" [window-edges nil window edges selected-window y 3 x 2 next-window] 3 (#$ . 5487)]) (defalias 'bg-command-execute #[(bg-command) "À !ƒ\n !‡Ã ‡" [commandp bg-command command-execute ding] 2]) (defalias 'bg-program-mouse #[nil "ÀÁ!‡" [send-string-to-terminal ":0;7;;;360;512;9;16;9;16c"] 2]) (byte-code "À !„  À‡" [keymapp mouse-map make-keymap] 2) #@43 Bind bg-mouse CLICK-CODE to run FUNCTION. (defalias 'bind-bg-mouse-click #[(click-code function) "À  !\f#‡" [define-key mouse-map char-to-string click-code function] 4 (#$ . 6076)]) (byte-code "À Â\"ˆÀ Ä\"ˆÀ Æ\"ˆÀ \\Ç\"ˆÀ \\È\"ˆÀ \\É\"ˆÀ \\\\É\"ˆÀ\n \\Ë\"ˆÀ\n \\Ì\"ˆÀ\n \\Í\"ˆÀ \\Ï\"ˆÀ \\Ð\"ˆÀ \\Ñ\"ˆÀ \\Ó\"ˆÀ \\Ô\"ˆÀ \\Õ\"ˆÖ×!‡" [bind-bg-mouse-click bg-button-l bg-set-point bg-button-m bg-yank bg-button-r bg-set-mark yank-pop-1 bg-kill-region undo bg-in-modeline scroll-up bg-move-by-percentage scroll-down bg-in-scrollbar bg-mouse-line-to-top bg-mouse-line-to-center bg-mouse-line-to-bottom bg-in-minibuf execute-extended-command suspend-emacs eval-expression provide bg-mouse] 4) emacs-19.30/lisp/term/news.elc100666 13437 1 1735 6003026176 14627 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jul 18 17:49:49 1995 ;;; from file /home/fsf/rms/e19/lisp/term/news.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`news.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!„ Ä\"Å !„ÆÇ!ˆÈ ÉÊ#ˆÈ ËÌ#ˆÈ ÍÎ#ˆÈ ÏÐ#ˆÈ ÑÒ#ˆÈ ÓÔ#ˆÈ ÕÖ#ˆÈ ×Ø#ˆÈ ÙÚ#ˆÈ ÛÜ#ˆÈ ÝÞ#ˆÈ ßà#ˆÈ áâ#ˆÈ ãä#ˆÈ åæ#ˆÈ çè#ˆÈ éê#ˆÈ ëì#ˆÀ‡" [boundp news-fkey-prefix lookup-key function-key-map "O" keymapp error "What? Your news termcap/terminfo has no keycaps in it." define-key "a" [execute] "b" [select] "c" [cancel] "M" [kp-enter] "q" [kp-1] "s" [kp-3] "u" [kp-5] "w" [kp-7] "y" [kp-9] "m" [kp-subtract] "k" [kp-add] "l" [kp-separator] "n" [kp-decimal] "p" [kp-0] "r" [kp-2] "t" [kp-4] "v" [kp-6] "x" [kp-8]] 4) emacs-19.30/lisp/term/pc-win.elc100666 22075 1 11465 6054643712 15272 0ustar terradaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 22 10:54:45 1995 ;;; from file /home/fsf/rms/e19/lisp/term/pc-win.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`pc-win.el' was compiled for Emacs 19.29 or later")) (load "term/internal" nil t) #@37 List of alternate names for colors. (defvar msdos-color-aliases (quote (("purple" . "magenta") ("firebrick" . "red") ("pink" . "lightred") ("royalblue" . "blue") ("cadetblue" . "blue") ("forestgreen" . "green") ("darkolivegreen" . "green") ("darkgoldenrod" . "brown") ("goldenrod" . "yellow") ("grey40" . "darkgray") ("rosybrown" . "brown") ("blue" . "lightblue") ("darkslategray" . "darkgray") ("orange" . "brown") ("light blue" . "lightblue") ("light cyan" . "lightcyan") ("light yellow" . "yellow") ("light pink" . "lightred") ("pale green" . "lightgreen") ("beige" . "brown") ("medium purple" . "magenta") ("turquoise" . "lightgreen") ("violet" . "magenta"))) (#$ . 504)) (defalias 'msdos-color-translate #[(name) "—‰GÂÃ\"AÅ\f†™Â\"A‰ƒ&È!†™ ÉVƒIÊËO̘ƒIÈÉÅO!‰ƒIÍÎ\"†™ ÏVƒlÊÉOИƒlÈÏÅO!‰ƒlÍÎ\"†™ ËVƒ„ÊÑOÒ˜ƒ„ÈËÅO!†™ ÉV…™ÊËOÓ˜…™ÈÉÅO!+‡" [name len assoc (("black" . 0) ("blue" . 1) ("green" . 2) ("cyan" . 3) ("red" . 4) ("magenta" . 5) ("brown" . 6) ("lightgray" . 7) ("light gray" . 7) ("darkgray" . 8) ("dark gray" . 8) ("lightblue" . 9) ("lightgreen" . 10) ("lightcyan" . 11) ("lightred" . 12) ("lightmagenta" . 13) ("yellow" . 14) ("white" . 15)) val nil try msdos-color-aliases msdos-color-translate 5 0 4 "light" logior 8 6 "light " 3 "dark" "dark "] 5]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp default-frame-alist nil current-load-list] 2) (defalias 'msdos-face-setup #[nil "ÀÁ \n\"ˆÃÄÅ\"ˆÃÆÇ\"ˆÃÈÉ\"ˆÃÊË\"ˆÌÍÎ\"ˆÏÐ!ˆÏÑ!ˆÏÒ!ˆÃÐË\"ˆÃÑÓ\"ˆÌÐÔ\"ˆÌÑÔ\"ˆÌÒÇ\"‡" [modify-frame-parameters selected-frame default-frame-alist set-face-foreground bold "yellow" italic "red" bold-italic "lightred" underline "white" set-face-background region "green" make-face msdos-menu-active-face msdos-menu-passive-face msdos-menu-select-face "lightgray" "blue"] 3]) (add-hook (quote before-init-hook) (quote msdos-face-setup)) (defalias 'x-display-color-p #[(&optional display) "À‡" [t] 1]) (byte-code "ÀÁMˆÂÁM‡" [focus-frame ignore unfocus-frame] 2) (defalias 'x-list-fonts #[(pattern &optional face frame) "ÀC‡" ["default"] 1]) (defalias 'x-color-defined-p #[(color) "À !§‡" [msdos-color-translate color] 2]) (defalias 'x-display-pixel-width #[(&optional frame) "À !Â_‡" [frame-width frame 8] 2]) (defalias 'x-display-pixel-height #[(&optional frame) "À !Â_‡" [frame-height frame 8] 2]) (defalias 'x-display-planes #[(&optional frame) "À‡" [4] 1]) (defalias 'x-display-color-cells #[(&optional frame) "À‡" [16] 1]) (defalias 'x-server-max-request-size #[(&optional frame) "À‡" [1000000] 1]) (defalias 'x-server-vendor #[(&optional frame) "À‡" ["GNU"] 1]) (defalias 'x-server-version #[(&optional frame) "À‡" [(1 0 0)] 1]) (defalias 'x-display-screens #[(&optional frame) "À‡" [1] 1]) (defalias 'x-display-mm-height #[(&optional frame) "À‡" [200] 1]) (defalias 'x-display-mm-width #[(&optional frame) "À‡" [253] 1]) (defalias 'x-display-backing-store #[(&optional frame) "À‡" [not-useful] 1]) (defalias 'x-display-visual-class #[(&optional frame) "À‡" [static-color] 1]) (byte-code "ÀÁMˆÂÁMˆÃÅÀ‡" [x-display-save-under ignore x-get-resource "pc" x-display-name t split-window-keep-point] 2) #@2  (defalias 'x-get-selection #[(&rest rest) "À‡" [nil] 1 (#$ . 3629)]) (fset (quote x-set-selection) (quote ignore)) (defalias 'x-frob-font-slant #[(font which) "‡" [font] 1]) (byte-code "ÀÁMˆÂÁMˆÃÁMˆÄÁMˆÅÁMˆÆÁM‡" [set-default-font ignore set-mouse-color set-cursor-color set-border-color auto-raise-mode auto-lower-mode] 2) #@126 Set the background color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use. (defalias 'set-background-color #[(color-name) "ÀÁ  BC\"‡" [modify-frame-parameters selected-frame background-color color-name] 4 (#$ . 3961) "sColor: "]) #@126 Set the foreground color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use. (defalias 'set-foreground-color #[(color-name) "ÀÁ  BC\"‡" [modify-frame-parameters selected-frame foreground-color color-name] 4 (#$ . 4249) "sColor: "]) (defalias 'msdos-handle-args #[(args) "À\nƒR\n@\nA Ę„ Řƒ+\nƒNÆ\n@BB\nA‚N Ș„7 ɘƒJ\nƒNÊ\n@BB\nA‚N B)‚ Ÿ)‡" [nil rest args this "-fg" "-foreground" foreground-color default-frame-alist "-bg" "-background" background-color] 2]) (byte-code "À !ÂÃ!ˆÄ ƒÂÅ!ˆÆÇ!ˆÀ‡" [msdos-handle-args command-line-args require faces msdos-mouse-p menu-bar menu-bar-mode t] 2) emacs-19.30/lisp/term/sun-mouse.elc100666 13437 1 42525 6003026225 15623 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jul 18 17:49:58 1995 ;;; from file /home/fsf/rms/e19/lisp/term/sun-mouse.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`sun-mouse.el' was compiled for Emacs 19.29 or later")) #@113 *Number of milliseconds to wait for an extra click. Set this to zero if you don't want chords or double clicks. (defvar extra-click-wait 150 (#$ . -482)) #@264 *The character width of the scrollbar. The cursor is deemed to be in the right edge scrollbar if it is this near the right edge, and more than two chars past the end of the indicated line. Setting to nil limits the scrollbar to the edge or vertical dividing bar. (defvar scrollbar-width 5 (#$ . -643)) #@25 Returns a new mousemap. (defalias 'make-mousemap #[nil "ÀÁB‡" [mousemap nil] 2 (#$ . 951)]) #@28 Return a copy of mousemap. (defalias 'copy-mousemap #[(mousemap) "À !‡" [copy-alist mousemap] 2 (#$ . 1049)]) #@736 Args MOUSEMAP, MOUSE-LIST, DEF. Define MOUSE-LIST in MOUSEMAP as DEF. MOUSE-LIST is a list of atoms specifying a mouse hit according to these rules: * One of these atoms specifies the active region of the definition. text, scrollbar, modeline, minibuffer * One or two or these atoms specify the button or button combination. left, middle, right, double * Any combination of these atoms specify the active shift keys. control, shift, meta * With a single unshifted button, you can add up to indicate an up-click. The atom `double' is used with a button designator to denote a double click. Two button chords are denoted by listing the two buttons. See sun-mouse-handler for the treatment of the form DEF. (defalias 'define-mouse #[(mousemap mouse-list def) "ÀÁ\n! \f#‡" [mousemap-set mouse-list-to-mouse-code mouse-list mousemap def] 4 (#$ . 1166)]) #@259 Give MOUSE-EVENT-LIST a local definition of DEF. See define-mouse for a description of MOUSE-EVENT-LIST and DEF. Note that if MOUSE-EVENT-LIST has a local definition in the current buffer, that local definition will continue to shadow any global definition. (defalias 'global-set-mouse #[(mouse-list def) "À \n #‡" [define-mouse current-global-mousemap mouse-list def] 4 (#$ . 2053) "xMouse event: \nxDefinition: "]) #@227 Give MOUSE-EVENT-LIST a local definition of DEF. See define-mouse for a description of the arguments. The definition goes in the current buffer's local mousemap. Normally buffers in the same major mode share a local mousemap. (defalias 'local-set-mouse #[(mouse-list def) "„Á  \f#‡" [current-local-mousemap make-mousemap define-mouse mouse-list def] 4 (#$ . 2477) "xMouse event: \nxDefinition: "]) #@42 Selects MOUSEMAP as the global mousemap. (defalias 'use-global-mousemap #[(mousemap) "‰‡" [mousemap current-global-mousemap] 2 (#$ . 2887)]) #@83 Selects MOUSEMAP as the local mousemap. nil for MOUSEMAP means no local mousemap. (defalias 'use-local-mousemap #[(mousemap) "‰‡" [mousemap current-local-mousemap] 2 (#$ . 3036)]) #@99 True if any bits set in X are also set in Y. Just like the Common Lisp function of the same name. (defalias 'logtest #[(x y) "À \n\"ÃU?‡" [logand x y 0] 3 (#$ . 3224)]) (byte-code "ÀÁ\nBÃÄ\nBÅÆ\nBÇÈ\nBÀ‡" [7 sm::ButtonBits current-load-list 56 sm::ShiftmaskBits 64 sm::DoubleBits 128 sm::UpBits] 2) (defalias 'sm::hit-code '(macro . #[(hit) "ÀÁ\nE‡" [nth 0 hit] 3])) (defalias 'sm::hit-button '(macro . #[(hit) "ÀÁÂÃ\fEE‡" [logand sm::ButtonBits nth 0 hit] 5])) (defalias 'sm::hit-shiftmask '(macro . #[(hit) "ÀÁÂÃ\fEE‡" [logand sm::ShiftmaskBits nth 0 hit] 5])) (defalias 'sm::hit-double '(macro . #[(hit) "ÀÁÂÃ\fEE‡" [logand sm::DoubleBits nth 0 hit] 5])) (defalias 'sm::hit-up '(macro . #[(hit) "ÀÁÂÃ\fEE‡" [logand sm::UpBits nth 0 hit] 5])) (defalias 'sm::hit-x '(macro . #[(hit) "ÀÁ\nE‡" [nth 1 hit] 3])) (defalias 'sm::hit-y '(macro . #[(hit) "ÀÁ\nE‡" [nth 2 hit] 3])) (defalias 'sm::hit-delta '(macro . #[(hit) "ÀÁ\nE‡" [nth 3 hit] 3])) (defalias 'sm::hit-up-p '(macro . #[(hit) "ÀÁ DDD‡" [not zerop sm::hit-up hit] 4])) (defalias 'sm::loc-w '(macro . #[(loc) "ÀÁ\nE‡" [nth 0 loc] 3])) (defalias 'sm::loc-x '(macro . #[(loc) "ÀÁ\nE‡" [nth 1 loc] 3])) (defalias 'sm::loc-y '(macro . #[(loc) "ÀÁ\nE‡" [nth 2 loc] 3])) #@75 Macro to switches to BUFFER, evaluates FORMS, returns to original buffer. (defalias 'eval-in-buffer '(macro . #[(buffer &rest forms) "ÀÁÂÃÄ DBBÇBBE‡" [let ((StartBuffer (current-buffer))) unwind-protect progn set-buffer buffer forms ((set-buffer StartBuffer))] 6 (#$ . 4464)])) (put (quote eval-in-buffer) (quote lisp-indent-function) 1) #@62 Switch to WINDOW, evaluate FORMS, return to original window. (defalias 'eval-in-window '(macro . #[(window &rest forms) "ÀÁÂÃÄ DBBÇBBE‡" [let ((OriginallySelectedWindow (selected-window))) unwind-protect progn select-window window forms ((select-window OriginallySelectedWindow))] 6 (#$ . 4810)])) (put (quote eval-in-window) (quote lisp-indent-function) 1) #@170 Switches to each window and evaluates FORM. Optional argument YESMINI says to include the minibuffer as a window. This is a macro, and does not evaluate its arguments. (defalias 'eval-in-windows '(macro . #[(form &optional yesmini) "ÀÁÂÃÄ ÆÇÈÉÊË\fEDEDEDÍBBE‡" [let ((OriginallySelectedWindow (selected-window))) unwind-protect while progn form not eq OriginallySelectedWindow select-window next-window nil yesmini ((select-window OriginallySelectedWindow))] 13 (#$ . 5177)])) (put (quote eval-in-window) (quote lisp-indent-function) 0) #@97 Move cursor to window location X, Y. Handles wrapped and horizontally scrolled lines correctly. (defalias 'move-to-loc #[(x y) "À !ˆiÂà ÄUƒiÅ ÆZ^\\‚$à ŠS^È\\\\! \n \nZ*‡" [move-to-window-line y move-to-column window-hscroll 0 window-width 2 x -1 nc cc] 5 (#$ . 5721)]) #@37 True iff this WINDOW is minibuffer. (defalias 'minibuffer-window-p #[(window) "À Á !8U‡" [frame-height 3 window-edges window] 4 (#$ . 6008)]) #@482 Evaluates the function or list associated with a mouse hit. Expecting to read a hit, which is a list: (button x y delta). A form bound to button by define-mouse is found by mouse-lookup. The variables: *mouse-window*, *mouse-x*, *mouse-y* are bound. If the form is a symbol (symbolp), it is funcall'ed with *mouse-window*, *mouse-x*, and *mouse-y* as arguments; if the form is a list (listp), the form is eval'ed; if the form is neither of these, it is an error. Returns nil. (defalias 'sun-mouse-handler #[(&optional hit) "„Á ÂA@Ã8\"‰@\fA@Ã\f8Å\f\" p\nËŽÌ !qˆÍ!*‰„RÏ@\"ÑUƒ‚ÒÓÔÕ!!\"ˆ‚‚9ƒi #ˆ‚‚<ƒ|@×!ˆ‚‚ÒØ\"ˆ.Ù=ƒÛ‡" [hit sm::combined-hits sm::window-xy 2 loc mouse-event-code mouse-code *mouse-y* *mouse-x* *mouse-window* StartBuffer ((set-buffer StartBuffer)) window-buffer mouse-lookup form logand sm::UpBits 0 error "Undefined mouse event: %s" prin1-to-string mouse-code-to-mouse-list this-command eval "Mouse action must be symbol or list, but was: %s" sun-mouse-handler last-command nil] 7 (#$ . 6158) nil]) #@63 Read and return next mouse-hit, include possible double click (defalias 'sm::combined-hits #[nil "À  @\"ÄUƒ9Å!‰ƒ8 È @@ @\" @\"Uƒ4\n‚5Ä# ˆ) )‡" [mouse-hit-read hit1 logand sm::UpBits 0 mouse-second-hit extra-click-wait hit2 logior sm::ButtonBits sm::DoubleBits] 9 (#$ . 7246)]) #@114 Read mouse-hit list from keyboard. Like (read 'read-char), but that uses minibuffer, and mucks up last-command. (defalias 'mouse-hit-read #[nil "À‰à ‰‰\nBÄšƒÅÆÇ\nŸÈ#!*‡" [nil char char-list read-char 13 read mapconcat char-to-string ""] 5 (#$ . 7551)]) #@71 First char of mouse-prefix. Used to detect double clicks and chords. (defvar mouse-prefix1 24 (#$ . 7817)) #@72 Second char of mouse-prefix. Used to detect double clicks and chords. (defvar mouse-prefix2 0 (#$ . 7931)) #@68 Returns the next mouse hit occurring within HIT-WAIT milliseconds. (defalias 'mouse-second-hit #[(hit-wait) "À !?…T ‰\fšƒÀÅ!ƒ CÇ‚S ‰ š„4 CÊ ˆÇ‚RË \fÍ\f@\"ÏU„OÐ Å\f8Z!‚Q\f)))‡" [sit-for-millisecs hit-wait read-char pc1 mouse-prefix1 3 unread-command-events nil pc2 mouse-prefix2 ding mouse-hit-read new-hit logand sm::UpBits 0 mouse-second-hit] 5 (#$ . 8045)]) #@116 Find window containing screen coordinates X and Y. Returns list (window x y) where x and y are relative to window. (defalias 'sm::window-xy #[(x y) "ÀÁ†\n \fE‡" [found (byte-code "À ÂŽÃÀ !‰@\fA@Å\f8Æ\f8 \nË Uƒ*TÌ Uƒ7T \nYƒh Wƒh YƒhWƒhÏÐÀ  \nZ ZE\"ˆ- ÑÒÓÔ\"!=?…x‚*‡" [selected-window OriginallySelectedWindow ((select-window OriginallySelectedWindow)) window-edges we 2 3 be re te le frame-width frame-height x y throw found select-window next-window nil t] 7) nil x y] 3 (#$ . 8438)]) #@85 Parse LOC into a region symbol. Returns one of (text scrollbar modeline minibuffer) (defalias 'sm::window-region #[(loc) "@A@Á8Å\f!SÆ\f!SÉ\f!ƒ!Ê‚W\nYƒ,Ë‚W Yƒ7Ì‚W ƒV  ZYƒV Î\f \n#Á\\YƒVÌ‚WÏ-‡" [loc 2 y x w window-width window-height bottom right minibuffer-window-p minibuffer modeline scrollbar scrollbar-width window-line-end text] 5 (#$ . 8978)]) #@58 Return WINDOW column (ignore X) containing end of line Y (defalias 'window-line-end #[(w x y) "À ÂŽÃ\f!ˆŠÅÆ \"+‡" [selected-window OriginallySelectedWindow ((select-window OriginallySelectedWindow)) select-window w move-to-loc frame-width y] 3 (#$ . 9361)]) (byte-code "ÀÁ\nBÁ‡" [((left . 1) (middle . 2) (right . 4) (shift . 8) (control . 16) (meta . 32) (double . 64) (up . 128) (text . 256) (scrollbar . 512) (modeline . 1024) (minibuffer . 2048)) sm::keyword-alist current-load-list] 2) #@43 Maps MOUSE-HIT and LOC into a mouse-code. (defalias 'mouse-event-code #[(hit loc) "À @ÂÃ\f!!\"‡" [logior hit mouse-region-to-code sm::window-region loc] 5 (#$ . 9863)]) #@50 Returns partial mouse-code for specified REGION. (defalias 'mouse-region-to-code #[(region) " žA‡" [region sm::keyword-alist] 2 (#$ . 10038)]) #@35 Map a MOUSE-LIST to a mouse-code. (defalias 'mouse-list-to-mouse-code #[(mouse-list) "ÀÁÂÃ\f\"\"‡" [apply logior mapcar #[(x) " žA‡" [x sm::keyword-alist] 2] mouse-list] 5 (#$ . 10188)]) #@35 Map a MOUSE-CODE to a mouse-list. (defalias 'mouse-code-to-mouse-list #[(mouse-code) "ÀÁÂÃ\f\"\"‡" [apply nconc mapcar #[(x) "À \nA\"… \n@C‡" [logtest mouse-code x] 3] sm::keyword-alist] 5 (#$ . 10382)]) (defalias 'mousemap-set #[(code mousemap value) "A\n ž‰ƒ \f¡‚\n\fB B¡*‡" [mousemap alist code assq-result value] 4]) (defalias 'mousemap-get #[(code mousemap) " AžA‡" [code mousemap] 2]) #@69 Look up MOUSE-EVENT and return the definition. nil means undefined. (defalias 'mouse-lookup #[(mouse-code) "À \n\"† À \"‡" [mousemap-get mouse-code current-local-mousemap current-global-mousemap] 3 (#$ . 10789)]) #@141 Args MASK (a bit mask) and LIST (a list of (code . form) pairs). Returns a list of elements of LIST whose code or'ed with MASK is non-zero. (defalias 'mouse-mask-lookup #[(mask list) "À\nƒÃ\f\n@@\"ƒ\n@ B\nA‰„ )‡" [nil result list logtest mask] 4 (#$ . 11011)]) #@126 Return the union of list of mouse (code . form) pairs L and L-UNIQUE, where L-UNIQUE is considered to be union'ized already. (defalias 'mouse-union #[(l l-unique) "\nƒ\n@‰@ ž„ B)\nA‰„ )‡" [l-unique result l code-form-pair] 3 (#$ . 11288)]) #@129 Return the union of lists of mouse (code . form) pairs L1 and L2, based on the code's, with preference going to elements in L1. (defalias 'mouse-union-first-preferred #[(l1 l2) "À À\nÃ\"\"‡" [mouse-union l2 l1 nil] 5 (#$ . 11547)]) #@91 Return a list of (code . function) pairs, where each code is currently set in the REGION. (defalias 'mouse-code-function-pairs-of-region #[(region) "À !ÃÄ\n A\"Ä\nA\"\")‡" [mouse-region-to-code region mask mouse-union-first-preferred mouse-mask-lookup current-local-mousemap current-global-mousemap] 5 (#$ . 11785)]) #@143 Returns first line of documentation string for FUNCTION. If there is no documentation string, then the string "No documentation" is returned. (defalias 'one-line-doc-string #[(function) ":ƒ\f@‰‚Á!‰„Â\"ÄÅ\n\"ˆ\nƉ•O)‡" [function documentation doc "No documentation." string-match "^.*$" 0] 4 (#$ . 12112)]) (defalias 'print-mouse-format #[(binding) "À @!ˆÀÂ!ˆÃÄ A\"ˆÅ ˆÀÆ!ˆÀÇ @!!ˆÅ ‡" [princ binding ": " mapcar #[(mouse-list) "À !ˆÀÂ!‡" [princ mouse-list " "] 2] terpri " " one-line-doc-string] 3]) #@41 Prints mouse-event bindings for REGION. (defalias 'print-mouse-bindings #[(region) "ÀÁ !\"‡" [mapcar print-mouse-format sm::event-bindings region] 4 (#$ . 12630)]) #@134 Returns an alist of (function . (mouse-list1 ... mouse-listN)) for REGION, where each mouse-list is bound to the function in REGION. (defalias 'sm::event-bindings #[(region) "À !‰ƒ:\f@Æ A \"‰ƒ'È @!AB¡ˆ‚2 AÈ @!CB B*\fA‰„\n *‡" [mouse-code-function-pairs-of-region region nil result mouse-bindings code-function-pair assoc current-entry mouse-code-to-mouse-list] 4 (#$ . 12802)]) #@41 Lists all current mouse-event bindings. (defalias 'describe-mouse-bindings #[nil "ÀÁÂ!ˆÃ ˆÁÄ!ˆÃ ˆÅÆ!ˆÃ ˆÁÇ!ˆÃ ˆÁÈ!ˆÃ ˆÅÉ!ˆÃ ˆÁÊ!ˆÃ ˆÁË!ˆÃ ˆÅÌ!‘‡" ["*Help*" princ "Text Region" terpri "---- ------" print-mouse-bindings text "Modeline Region" "-------- ------" modeline "Scrollbar Region" "--------- ------" scrollbar] 3 (#$ . 13202) nil]) #@64 Print a short description of the function bound to MOUSE-LIST. (defalias 'describe-mouse-briefly #[(mouse-list) "ÀÁ\n!!‰ƒÄÅ\n #‚ÄÆ\n\")‡" [mouse-lookup mouse-list-to-mouse-code mouse-list function message "%s runs the command %s" "%s is undefined"] 5 (#$ . 13547) "xDescibe mouse list briefly: "]) (defalias 'mouse-help-menu #[(function-and-binding) "À @!Âà @!CÀ A!CD!B‡" [prin1-to-string function-and-binding menu-create one-line-doc-string] 5]) #@61 Displays a menu of mouse functions callable in this region. (defalias 'mouse-help-region #[(w x y &optional region) "†\nÁ\n \fE!ÅÆÇ!\"ÉÊ!CB! Ì\nÍ\f $ˆ+·" [region sm::window-region w x y mapcar mouse-help-menu sm::event-bindings mlist menu-create symbol-name menu sun-menu-evaluate 0 nil] 5 (#$ . 14005)]) #@106 Functional form for defmenu, given a list of ITEMS returns a menu. Each ITEM is a (STRING . VALUE) pair. (defalias 'menu-create #[(items) "ÀÁ\n\"‡" [apply vector items] 3 (#$ . 14329)]) #@117 Defines MENU to be a menu, the ITEMS are (STRING . VALUE) pairs. See sun-menu-evaluate for interpretation of ITEMS. (defalias 'defmenu '(macro . #[(menu &rest itemlist) "À  !E‡" [defconst menu menu-create itemlist] 4 (#$ . 14522)])) #@633 Display a pop-up menu in WINDOW at X Y and evaluate selected item of MENU. MENU (or its symbol-value) should be a menu defined by defmenu. A menu ITEM is a (STRING . FORM) pair; the FORM associated with the selected STRING is evaluated, and the resulting value is returned. Generally these FORMs are evaluated for their side-effects rather than their values. If the selected form is a menu or a symbol whose value is a menu, then it is displayed and evaluated as a pullright menu item. If the the FORM of the first ITEM is nil, the STRING of the item is used as a label for the menu, i.e. it's inverted and not selectable. (defalias 'sun-menu-evaluate #[(*menu-window* *menu-x* *menu-y* menu) "9ƒJÁ \f Æ%!‡" [menu eval sun-menu-internal *menu-window* *menu-x* *menu-y* 4] 7 (#$ . 14763)]) #@266 Sends the tty-sub-window escape sequence CODE to terminal, and returns a cons of the two numbers in returned escape sequence. That is it returns (cons ) from "\E[n;;t". CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars. (defalias 'sun-get-frame-data #[(code) "ÀÁ !ÄQ!ˆÅ‰‰‰ Ê ‰ Ëš„) B‚ÌÍŸÎ#ÏÐ\"ˆÑ”TÑ•OÑ•ÅOÏÐ\"ˆÑ”TÑ•OÒ!Ò!,B‡" [send-string-to-terminal "[" int-to-string code "t" nil y x str char read-char 116 mapconcat char-to-string "" string-match ";[0-9]*" 0 string-to-int] 4 (#$ . 15575)]) #@49 Returns font size in pixels: (cons Ysize Xsize) (defalias 'sm::font-size #[nil "ÀÁ!ÀÂ!‰@ @¥\fA A¥*B‡" [sun-get-frame-data 14 18 chr pix] 4 (#$ . 16160)]) #@53 Cached frame-to-window X-Offset for sm::menu-kludge (defvar sm::menu-kludge-x nil (#$ . 16322)) #@53 Cached frame-to-window Y-Offset for sm::menu-kludge (defvar sm::menu-kludge-y nil (#$ . 16424)) #@65 If sunfns.c uses this function must be here! (defalias 'sm::menu-kludge #[nil "„Á ‰@Ã\\Ä)ÆÇ!‰@\\A \\)B‡" [sm::menu-kludge-y sm::font-size fs 8 4 sm::menu-kludge-x sun-get-frame-data 13 wl] 4 (#$ . 16526)]) #@119 Set mark and yank the contents of the current sunwindows selection. Insert contents into the current buffer at point. (defalias 'sun-yank-selection #[nil "ÀÁ!ˆÂà !‡" [set-mark-command nil insert-string sun-get-selection] 2 (#$ . 16769) "*"]) #@67 Set the sunwindows selection to the region in the current buffer. (defalias 'sun-select-region #[(beg end) "À \n{!‡" [sun-set-selection beg end] 3 (#$ . 17017) "r"]) #@174 Suspend emacstool. If running under as a detached process emacstool, you don't want to suspend (there is no way to resume), just close the window, and wait for reopening. (defalias 'suspend-emacstool #[(&optional stuffstring) "ÀÁ!ˆ\nƒ\fÃ\n!ˆÃÄ!ˆÀÅ!‡" [run-hooks suspend-hook stuffstring send-string-to-terminal "" suspend-resume-hook] 2 (#$ . 17190) nil]) (byte-code "ÀÁ!ˆÂÁÃ\"ˆÄÅ!„Æ ÅBÈÉ!‡" [make-variable-buffer-local current-local-mousemap set-default nil boundp current-global-mousemap make-mousemap current-load-list provide sun-mouse] 3) emacs-19.30/lisp/term/sun.elc100666 13437 1 12357 6003026234 14475 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jul 18 17:50:14 1995 ;;; from file /home/fsf/rms/e19/lisp/term/sun.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`sun.el' was compiled for Emacs 19.29 or later")) #@31 interactive version of ignore (defalias 'ignore-key #[nil "À ‡" [ignore] 1 (#$ . 469) nil]) (defalias 'scroll-down-in-place #[(n) "À !ˆÂ !‡" [previous-line n scroll-down] 2 nil "p"]) (defalias 'scroll-up-in-place #[(n) "À !ˆÂ !‡" [next-line n scroll-up] 2 nil "p"]) #@67 Like kill-region, but pops the mark [which equals point, anyway.] (defalias 'kill-region-and-unmark #[(beg end) "À \n\"ˆÃÅÆ!‡" [kill-region beg end kill-region-and-unmark this-command set-mark-command t] 3 (#$ . 741) "r"]) #@33 Select Previous-complex-command (defalias 'select-previous-complex-command #[nil "À ÁUƒ ÂÃ!‡ÄÃ!‡" [minibuffer-depth 0 repeat-complex-command 1 previous-complex-command] 2 (#$ . 971) nil]) #@34 Repeat Previous-complex-command. (defalias 'rerun-prev-command #[nil "À @!‡" [eval command-history] 2 (#$ . 1166) nil]) #@27 Default arg for RE-search (defvar grep-arg nil (#$ . 1292)) (defalias 'grep-arg #[nil "Á>ƒ\n‡ @Å\f@!\fA@… ÈÉ\"‰\nƒ3;ƒ3‰‚A \nÌÍ\n\"\n \n,‡" [last-command (research-forward research-backward) grep-arg command-history command symbol-name command-name search-arg string-match "search" search-command this-command read-string "REsearch: "] 4]) #@27 Repeat RE search forward. (defalias 'research-forward #[nil "ÀÁ !‡" [re-search-forward grep-arg] 2 (#$ . 1664) nil]) #@28 Repeat RE search backward. (defalias 'research-backward #[nil "ÀÁ !‡" [re-search-backward grep-arg] 2 (#$ . 1787) nil]) #@60 *If non-nil, rebind ESC [ as prefix for Sun function keys. (defvar sun-esc-bracket nil (#$ . -1913)) (byte-code "ÀÁ!„  Á BÄ Æ #ˆÄ ÇÈ#ˆÄ ÉÊ#ˆÄ ËÌ#ˆÄ ÍÎ#ˆÄ ÏÐ#ˆÄ ÑÒ#ˆÄ ÓÔ#ˆÄ ÕÖ#ˆÄ ×Ø#ˆÄ ÙÚ#ˆÄ ÛÜ#ˆÄ ÝÞ#ˆÄ ßà#ˆÄ áâ#ˆÄ ãä#ˆÄ åæ#ˆÄ çè#ˆÄ éê#ˆÄ ëì#ˆíîï\"ˆíðñ\"ˆíòó\"ˆíôõ\"ˆíö÷\"ˆíøù\"ˆíúû\"ˆíüý\"ˆíþÿ\"ˆí@A\"ˆíBC\"ˆíDE\"ˆíFG\"ˆíHI\"ˆíJK\"ˆíLM\"ˆíNO\"ˆPƒQÆ!ˆÀ‡" [boundp sun-raw-prefix make-sparse-keymap current-load-list define-key function-key-map "[" "210z" [r3] "213z" [r6] "214z" [r7] "216z" [r9] "218z" [r11] "220z" [r13] "222z" [r15] "193z" [redo] "194z" [props] "195z" [undo] "200z" [find] "226z" [t3] "227z" [t4] "229z" [t6] "230z" [t7] "A" [up] "B" [down] "C" [right] "D" [left] global-set-key [r3] backward-page [r6] forward-page [r7] beginning-of-buffer [r9] scroll-down [r11] recenter [r13] end-of-buffer [r15] scroll-up [redo] redraw-display [props] list-buffers [undo] undo [put] sun-select-region [get] sun-yank-selection [find] exchange-point-and-mark [t3] scroll-down-in-place [t4] scroll-up-in-place [t6] shrink-window [t7] enlarge-window sun-esc-bracket global-unset-key] 4) #@57 List of forms to evaluate after setting sun-raw-prefix. (defvar sun-raw-prefix-hooks nil (#$ . 3048)) (byte-code "‰ƒ @!ˆ A‰„)ÃÄ!„ÅÄB‡" [sun-raw-prefix-hooks hooks eval boundp meta-flag t current-load-list] 3) #@33 *Keymap for Emacstool bindings. (defvar suntool-map (make-sparse-keymap) (#$ . -3279)) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆÀ ØÙ#ˆÀ ÚÛ#ˆÀ ÜÝ#ˆÀ Þß#ˆÀ àÛ#ˆÀ áâ#ˆÀ ãä#ˆÀ åæ#ˆÀ çè#ˆÀ éê#ˆÀ ëì#ˆÀ íä#ˆÀ îï#ˆÀ ðñ#ˆÀ òó#ˆÀ ôõ#ˆÀ ö÷#ˆÀ øù#ˆÀ úû#ˆÀ üý#ˆÀ þÿ#ˆÀ @A#ˆÀ BC#ˆÀDE #‡" [define-key suntool-map "gr" beginning-of-buffer "iR" backward-page "ir" scroll-down "kr" recenter "mr" end-of-buffer "oR" forward-page "or" scroll-up "bÌ" rerun-prev-command "bì" prev-complex-command "bl" redraw-display "cl" list-buffers "dl" undo "el" ignore-key "fl" sun-select-region "f," copy-region-as-kill "gl" "hl" sun-yank-selection "h," yank "il" research-forward "i," re-search-forward "iì" research-backward "i¬" re-search-backward "jL" "jl" kill-region-and-unmark "jì" exchange-point-and-mark "j," (lambda nil (interactive) (pop-mark 1)) "fT" shrink-window-horizontally "gT" enlarge-window-horizontally "ft" shrink-window "gt" enlarge-window "cT" (lambda (n) (interactive "p") (scroll-down n)) "dT" (lambda (n) (interactive "p") (scroll-up n)) "ct" scroll-down-in-place "dt" scroll-up-in-place ctl-x-map "*"] 4) #@54 List of forms to evaluate after setting suntool-map. (defvar suntool-map-hooks nil (#$ . 4432)) (byte-code "‰ƒ @!ˆ A‰„)‡" [suntool-map-hooks hooks eval] 3) #@53 Sun Emacstool handler for mouse blips (not loaded). (autoload (quote sun-mouse-handler) "sun-mouse" '(#$ . 4603) t) #@63 Set up Emacstool window, if you know you are in an emacstool. (defalias 'emacstool-init #[nil "ÀÁ!ˆÂ ÄÅ#ˆÆ ÇWƒÈÉ!‡ÊËÌ #ˆÊËÌ#ˆÊËÌ #ˆÏÐÒQ!‡" [require sun-fns define-key ctl-x-map "" sun-mouse-handler sun-window-init 0 message "Not a Sun Window" substitute-key-definition suspend-emacs suspend-emacstool global-map esc-map send-string-to-terminal "]lEmacstool - GNU Emacs " emacs-version "\\"] 4 (#$ . 4725)]) #@65 Converts to emacstool and sun-mouse-handler on first mouse hit. (defalias 'sun-mouse-once #[nil "À ˆÁ ‡" [emacstool-init sun-mouse-handler] 1 (#$ . 5148) nil]) (define-key ctl-x-map "" (quote sun-mouse-once)) emacs-19.30/lisp/term/sup-mouse.elc100666 13437 1 6701 6003026245 15603 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jul 18 17:50:22 1995 ;;; from file /home/fsf/rms/e19/lisp/term/sup-mouse.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`sup-mouse.el' was compiled for Emacs 19.29 or later")) #@79 *Non-nil for mouse hits to select new window, then execute; else just select. (defvar sup-mouse-fast-select-window nil (#$ . -481)) (byte-code "ÀÁ\nBÃÄ\nBÅÆ\nBÇÈ\nBÉ\nÊ\nBË\fÌ\nBÍÎ\nBÏÐ\nBÑÒ\nBÀ‡" [0 mouse-left current-load-list 1 mouse-center 2 mouse-right 4 mouse-2left 5 mouse-2center 6 mouse-2right 8 mouse-3left 9 mouse-3center 10 mouse-3right] 2) #@600 This function is called directly by the mouse, it parses and executes the mouse commands. L move point * |---- These apply for mouse click in a window. 2L delete word | 3L copy word | If sup-mouse-fast-select-window is nil, C move point and yank * | just selects that window. 2C yank pop | R set mark * | 2R delete region | 3R copy region | on modeline on "scroll bar" in minibuffer L scroll-up line to top execute-extended-command C proportional goto-char line to middle mouse-help R scroll-down line to bottom eval-expression (defalias 'sup-mouse-report #[nil "ÀÁ!ÀÁ!ÀÄ!Æ \"È! Ê  Ì S=‰ ?…- = Ï 8S= Ñ 8SY  @Z  A@Zƒ‘Ó!ˆ\nUƒeÕ ˆ‚Š\nUƒr× ˆ‚Š\nUƒŠ deZ_Ù S¥bˆÚyˆÛ ˆÓ !‚êƒÖÓ!ˆÕ\nUƒ§ ‚Í\nUƒ· ÑÜ Z\\‚Í\nUƒÌ ‰Ü [Ñ\\\\\\Ñ¥‚ÍÚ!ˆÓ !‚ꃀ\nUƒéÝ \"‚ê\nUƒûÝ \"ˆßà!‚ê\n!UƒÝ \"ˆŠâ`àvˆ`\"ˆ)ã‰$‚ê\nUƒ,å ˆÝ \"ˆæ ‚ê\n'UƒCå ˆÝ \"ˆèé `\"‚ê\n*Uƒ_å ˆÝ \"ˆâé `\"ˆã‰$‚ê\nUƒsÝ \"ˆã$ã ‚ê\n+U…êìà!‚ê ƒ¬\nUƒ’íî!‚ê\nUƒŸíï!‚ê\nU…êðñ!‚êÓ!ˆ2?†ê\nUƒÅÝ \"‚ê\nUƒÙå ˆÝ \"ˆæ ‚ê\nU…êÝ \"ˆã$ã .\n‡" [sup-get-tty-num 59 buttons x 99 y sup-pos-to-window window window-edges edges selected-window old-window frame-height in-minibuf-p same-window-p 3 in-modeline-p 2 in-scrollbar-p select-window mouse-left scroll-up mouse-right scroll-down mouse-center window-width 0 what-cursor-position window-height sup-move-point-to-x-y mouse-2left kill-word 1 mouse-3left copy-region-as-kill yank this-command push-mark exchange-point-and-mark mouse-2right kill-region mark mouse-3right mouse-2center yank-pop call-interactively eval-expression execute-extended-command describe-function sup-mouse-report sup-mouse-fast-select-window] 6 (#$ . 864) nil]) #@133 Read from terminal until TERM-CHAR is read, and return intervening number. Upon non-numeric not matching TERM-CHAR signal an error. (defalias 'sup-get-tty-num #[(term-char) "ÀÁ \nÄYƒ \nÅXƒ Æ_\nÄZ\\Á ‰‚\n=„+ÈÉ!ˆ *‡" [0 read-char char num 48 57 10 term-char error "Invalid data format in mouse command"] 4 (#$ . 2680)]) #@95 Position cursor in window coordinates. X and Y are 0-based character positions in the window. (defalias 'sup-move-point-to-x-y #[(x y) "À !ˆÂ !‡" [move-to-window-line y move-to-column x] 2 (#$ . 3016)]) #@103 Find window corresponding to frame coordinates. X and Y are 0-based character positions on the frame. (defalias 'sup-pos-to-window #[(x y) "À Á\nÄ =„8 A@W„- Æ 8Y„- @W„-È 8Yƒ8É\n!À\n!‚\n†>Ä *‡" [window-edges nil window edges selected-window y 3 x 2 next-window] 3 (#$ . 3226)]) emacs-19.30/lisp/term/tvi970.elc100666 13437 1 4366 6003026250 14711 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jul 18 17:50:30 1995 ;;; from file /home/fsf/rms/e19/lisp/term/tvi970.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`tvi970.el' was compiled for Emacs 19.29 or later")) (byte-code "À Â\"„à ÂÄ #ˆÅÆÇ\"ˆÈ ÈÊWƒ9à ËÌ Í\\\"ÎÏËÐ \"!!#ˆ T‰ ‚)È ÈÑWƒvà ËÒ Ó\\\"ÎÏËÔ T\"!!#ˆÃ ËÒ Õ\\\"ÎÏËÖ T\"!!#ˆ T‰ ‚>)À‡" [lookup-key function-key-map "[" define-key make-keymap mapcar #[(key-binding) "À \n@\nA@#‡" [define-key function-key-map key-binding] 4] (("" [home]) ("" [backtab]) ("" [print]) ("[@" [insert]) ("" [insertline]) ("" [deleteline]) ("" [next]) ("Om" [kp-subtract]) ("Ol" [kp-separator]) ("On" [kp-decimal]) ("OM" [kp-enter]) ("" [key_eol]) ("" [key_eos]) ("" [key_clear]) ("" [key_dc]) ("" [S-tab]) ("" [clearentry]) ("" [S-clearentry]) ("" [10]) ("" [S-backtab]) ("[?1i" [key_sprint]) ("" [key_sic]) ("" [S-delete]) ("" [S-insertline]) ("" [key_sdl]) ("" [key_seol]) ("" [S-erasepage]) ("" [S-page]) ("S" [send]) ("5" [S-send])) 0 i 10 format "O%c" 112 vector intern "kp-%d" 16 "?%c" 97 "f%d" 65 "S-f%d"] 9) #@150 The terminal should be in numeric keypad mode iff this variable is non-nil. Do not set this variable! Call the function ``tvi970-set-keypad-mode''. (defvar tvi970-keypad-numeric nil (#$ . 1417)) #@460 Set the current mode of the TVI 970 numeric keypad. In ``numeric keypad mode'', the number keys on the keypad act as ordinary digits. In ``alternate keypad mode'', the keys send distinct escape sequences, meaning that they can have their own bindings, independent of the normal number keys. With no argument, toggle between the two possible modes. With a positive argument, select alternate keypad mode. With a negative argument, select numeric keypad mode. (defalias 'tvi970-set-keypad-mode #[(&optional arg) "„ ?‚Â!ÃVÄ ƒÅ‚Æ!‡" [arg tvi970-keypad-numeric prefix-numeric-value 0 send-string-to-terminal "=" ">"] 2 (#$ . 1620) "P"]) (tvi970-set-keypad-mode 1) emacs-19.30/lisp/term/vt100.elc100666 13437 1 1736 6003026255 14524 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jul 18 17:50:36 1995 ;;; from file /home/fsf/rms/e19/lisp/term/vt100.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`vt100.el' was compiled for Emacs 19.29 or later")) (load "term/lk201" nil t) #@35 t if vt100 is in 132-column mode. (defconst vt100-wide-mode (byte-code "À ÁU‡" [frame-width 132] 2) (#$ . 499)) #@140 Toggle 132/80 column mode for vt100s. With positive argument, switch to 132-column mode. With negative argument, switch to 80-column mode. (defalias 'vt100-wide-mode #[(&optional arg) "„ ?‚Â!ÃVÄ ƒÅ‚Æ!ˆÇ ƒ&É‚'Ê\"‡" [arg vt100-wide-mode prefix-numeric-value 0 send-string-to-terminal "[?3h" "[?3l" set-frame-width terminal-frame 132 80] 3 (#$ . 618) "P"]) emacs-19.30/lisp/term/vt200.elc100666 13437 1 1064 6003026257 14521 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jul 18 17:50:38 1995 ;;; from file /home/fsf/rms/e19/lisp/term/vt200.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`vt200.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁÂÃ#ˆÄ ÆÇ#‡" [load "term/vt100" nil t define-key function-key-map "[23~" [27]] 4) emacs-19.30/lisp/term/wyse50.elc100666 13437 1 4105 6003026261 14774 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jul 18 17:50:40 1995 ;;; from file /home/fsf/rms/e19/lisp/term/wyse50.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`wyse50.el' was compiled for Emacs 19.29 or later")) (byte-code "À Âà #ˆÄÅÆ\"‡" [define-key function-key-map "" make-keymap mapcar #[(key-definition) "À \n@\nA@#‡" [define-key function-key-map key-definition] 4] ((" " [up]) ("\n" [down]) ("\f" [right]) ("" [left]) ("@ " [f1]) ("A " [f2]) ("B " [f3]) ("C " [f4]) ("D " [f5]) ("E " [f6]) ("F " [f7]) ("G " [f8]) ("H " [f9]) ("K" [next]) ("T" [clearline]) ("" [home]) ("" [end]) ("Q" [insert]) ("E" [insertline]) ("R" [deleteline]) ("P" [print]) ("r" [replace]) ("I " [f10]) ("J " [f11]) ("K " [f12]) ("L " [f13]) ("M " [f14]) ("N " [f15]) ("O " [f16]) ("` " [f17]) ("a " [f18]) ("b " [f19]) ("c " [f20]) ("d " [f21]) ("e " [f22]) ("f " [f23]) ("g " [f24]) ("h " [f25]) ("i " [f26]) ("j " [f27]) ("k " [f28]) ("l " [f29]) ("m " [f30]) ("n " [f31]) ("o " [f32]) ("I" [key-stab]) ("J" [key-snext]) ("Y" [key-clear]) ("W" [127]) (" " [funct-up]) ("\n " [funct-down]) ("\f " [funct-right]) (" " [funct-left]) (" " [funct-return]) (" " [funct-tab]))] 4) #@292 To be called by term-setup-hook. Overrides 6 Emacs standard keys whose functions are then typed as follows: C-a Funct Left-arrow C-h M-? LFD Funct Return, some modes override down-arrow via LFD C-k CLR Line C-l Scrn CLR M-r M-x move-to-window-line, Funct up-arrow or down-arrow are similar  (defalias 'enable-arrow-keys #[nil "ÀÁÂ\"ˆÃÄM‡" [mapcar #[(key-definition) "À @ A@\"‡" [global-set-key key-definition] 3] (("" nil) (" " nil) ("\n" nil) ("\f" nil) ("" nil) ("r" nil)) enable-arrow-keys nil] 3 (#$ . 1478) nil]) (add-hook (quote kill-emacs-hook) #[nil "ÀÁ TÃQ!‡" [send-string-to-terminal "a23R" frame-width "CG0"] 4 nil nil]) emacs-19.30/lisp/term/x-win.elc100666 13437 1 33203 6051030123 14716 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 00:10:30 1995 ;;; from file /home/fsf/rms/e19/lisp/term/x-win.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`x-win.el' was compiled for Emacs 19.29 or later")) (byte-code "Á=„\fÂÃÄ \"ˆÅÆ!ˆÅÇ!ˆÅÈ!ˆÅÉ!ˆÅÊ!ˆÅË!ˆÌ B ÎÏ!„3ÐÏ B ÑÒ B ÓÔ B ÕÖ B Ї" [window-system x error "%s: Loading x-win.el but not compiled for X" invocation-name require frame mouse scroll-bar faces select menu-bar x-invocation-args current-load-list boundp x-command-line-resources nil (("-bw" . x-handle-numeric-switch) ("-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) ("-rv" . x-handle-switch) ("-reverse" . x-handle-switch) ("-fn" . x-handle-switch) ("-font" . x-handle-switch) ("-ib" . x-handle-numeric-switch) ("-g" . x-handle-geometry) ("-geometry" . x-handle-geometry) ("-fg" . x-handle-switch) ("-foreground" . x-handle-switch) ("-bg" . x-handle-switch) ("-background" . x-handle-switch) ("-ms" . x-handle-switch) ("-itype" . x-handle-switch) ("-i" . x-handle-switch) ("-iconic" . x-handle-iconic) ("-xrm" . x-handle-xrm-switch) ("-cr" . x-handle-switch) ("-vb" . x-handle-switch) ("-hb" . x-handle-switch) ("-bd" . x-handle-switch)) x-option-alist (("--border-width" . "-bw") ("--display" . "-d") ("--name" . "-name") ("--title" . "-T") ("--reverse-video" . "-reverse") ("--font" . "-font") ("--internal-border" . "-ib") ("--geometry" . "-geometry") ("--foreground-color" . "-fg") ("--background-color" . "-bg") ("--mouse-color" . "-ms") ("--icon-type" . "-itype") ("--iconic" . "-iconic") ("--xrm" . "-xrm") ("--cursor-color" . "-cr") ("--vertical-scroll-bars" . "-vb") ("--border-color" . "-bd")) x-long-option-alist (("-name" name) ("-T" name) ("-r" reverse t) ("-rv" reverse t) ("-reverse" reverse t) ("-fn" font) ("-font" font) ("-ib" internal-border-width) ("-fg" foreground-color) ("-foreground" foreground-color) ("-bg" background-color) ("-background" background-color) ("-ms" mouse-color) ("-cr" cursor-color) ("-itype" icon-type t) ("-i" icon-type t) ("-vb" vertical-scroll-bars t) ("-hb" horizontal-scroll-bars t) ("-bd" border-color) ("-bw" border-width)) x-switch-definitions] 3) (defalias 'x-handle-switch #[(switch) "À \n\"‰…-Ä 8ƒ A@Ä 8B B‰‚- A@@B BA‰)‡" [assoc switch x-switch-definitions aelt 2 default-frame-alist x-invocation-args] 4]) (defalias 'x-handle-iconic #[(switch) "À B‰‡" [(visibility . icon) initial-frame-alist] 2]) (defalias 'x-handle-numeric-switch #[(switch) "À \n\"‰… A@Ä @!BB A‰)‡" [assoc switch x-switch-definitions aelt string-to-int x-invocation-args default-frame-alist] 4]) (defalias 'x-handle-xrm-switch #[(switch) ":„\fÁÂà \f#ˆ@A‰‡" [x-invocation-args error "%s: missing argument to `%s' option" invocation-name switch x-command-line-resources] 4]) (defalias 'x-handle-geometry #[(switch) "À @!Ã\fÅ\nž„Æ\nž…ÇÈ\nž„ É\nž…!Ê\n$ A‰)‡" [x-parse-geometry x-invocation-args geo append initial-frame-alist left top ((user-position . t)) height width ((user-size . t))] 5]) (defalias 'x-handle-name-rn-switch #[(switch) ":„\fÁÂà \f#ˆ@A\fƘ…!Ç BB‰‡" [x-invocation-args error "%s: missing argument to `%s' option" invocation-name switch x-resource-name "-name" name initial-frame-alist] 4]) #@51 The X display name specifying server and X frame. (defvar x-display-name nil (#$ . 3611)) (defalias 'x-handle-display #[(switch) "@A‰‡" [x-invocation-args x-display-name] 2]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp x-invocation-args nil current-load-list] 2) #@406 Process the X-related command line options in ARGS. This is done before the user's startup file is loaded. They are copied to x-invocation args from which the X-related things are extracted, first the switch (e.g., "-fg") in the following code, and possible values (e.g., "black") in the option handler code (e.g., x-handle-switch). This returns ARGS with the arguments that have been processed removed. (defalias 'x-handle-args #[(args) "ÀÁ\n\"ˆ\nÄ ƒ  @‰ÄÄÄ AÊË \"ƒ4 Ì•ÄO ̉•SOÍ \"‰Ï=ƒKÐ \"A‚p;ƒjÐ\"‰„bÒÓ \"ˆA)‚pÄÐ \"‰ ƒ˜ƒ B A !ˆ)‚œ A !ˆ‚œ \nB-‚ \nŸ‰‡" [message "%s" args x-invocation-args nil this-switch orig-this-switch completion argval aelt string-match "^--[^=]*=" 0 try-completion x-long-option-alist t assoc elt error "Option `%s' is ambiguous" x-option-alist] 4 (#$ . 3877)]) (byte-code "ÀÁ\nBÃÄ\nBÅÆ\nBÇÈ\nBÉ\nÊ\nBË\fÌ\nBÍÎ\nBÏÐ\nBÑÒ\nBÓÔ\nBÕÖ\nB×Ø\nBÙÚ\nBÛÜ\nBÝÞ\nBß à\nBá\"â\nBã$ä\nBå&æ\nBç(è\nBé*ê\nBë,ì\nBí.î\nBï0ð\nBñ2ò\nBó4ô\nBõ6ö\nB÷8ø\nBù:ú\nBû<ü\nBý>þ\nBÿ@@\nBABB\nBCDD\nBEFF\nBGHH\nBIJJ\nBKLL\nBMNN\nBOPP\nBQRR\nBSTT\nBUVV\nBWXX\nBYZZ\nB[\\\\\nB]^^\nB_``\nBabb\nBcdd\nBeff\nBghh\nBijj\nBkll\nBmnn\nBopp\nBqrr\nBstt\nBuvv\nBwxx\nByzz\nB{||\nB}~~\nB€€\nB‚‚\nBƒ„„\nB…††\nB‡ˆˆ\nB‰ŠŠ\nB‹ŒŒ\nBŽŽ\nB\nB‘’’\nB“””\nB•––\nB—˜˜\nB™šš\nBÀ‡" [0 x-pointer-X-cursor current-load-list 2 x-pointer-arrow 4 x-pointer-based-arrow-down 6 x-pointer-based-arrow-up 8 x-pointer-boat 10 x-pointer-bogosity 12 x-pointer-bottom-left-corner 14 x-pointer-bottom-right-corner 16 x-pointer-bottom-side 18 x-pointer-bottom-tee 20 x-pointer-box-spiral 22 x-pointer-center-ptr 24 x-pointer-circle 26 x-pointer-clock 28 x-pointer-coffee-mug 30 x-pointer-cross 32 x-pointer-cross-reverse 34 x-pointer-crosshair 36 x-pointer-diamond-cross 38 x-pointer-dot 40 x-pointer-dotbox 42 x-pointer-double-arrow 44 x-pointer-draft-large 46 x-pointer-draft-small 48 x-pointer-draped-box 50 x-pointer-exchange 52 x-pointer-fleur 54 x-pointer-gobbler 56 x-pointer-gumby 58 x-pointer-hand1 60 x-pointer-hand2 62 x-pointer-heart 64 x-pointer-icon 66 x-pointer-iron-cross 68 x-pointer-left-ptr 70 x-pointer-left-side 72 x-pointer-left-tee 74 x-pointer-leftbutton 76 x-pointer-ll-angle 78 x-pointer-lr-angle 80 x-pointer-man 82 x-pointer-middlebutton 84 x-pointer-mouse 86 x-pointer-pencil 88 x-pointer-pirate 90 x-pointer-plus 92 x-pointer-question-arrow 94 x-pointer-right-ptr 96 x-pointer-right-side 98 x-pointer-right-tee 100 x-pointer-rightbutton 102 x-pointer-rtl-logo 104 x-pointer-sailboat 106 x-pointer-sb-down-arrow 108 x-pointer-sb-h-double-arrow 110 x-pointer-sb-left-arrow 112 x-pointer-sb-right-arrow 114 x-pointer-sb-up-arrow 116 x-pointer-sb-v-double-arrow 118 x-pointer-shuttle 120 x-pointer-sizing 122 x-pointer-spider 124 x-pointer-spraycan 126 x-pointer-star 128 x-pointer-target 130 x-pointer-tcross 132 x-pointer-top-left-arrow 134 x-pointer-top-left-corner 136 x-pointer-top-right-corner 138 x-pointer-top-side 140 x-pointer-top-tee 142 x-pointer-trek 144 x-pointer-ul-angle 146 x-pointer-umbrella 148 x-pointer-ur-angle 150 x-pointer-watch 152 x-pointer-xterm] 2) #@47 The list of X colors from the `rgb.txt' file. (defvar x-colors (quote ("aquamarine" "Aquamarine" "medium aquamarine" "MediumAquamarine" "black" "Black" "blue" "Blue" "cadet blue" "CadetBlue" "cornflower blue" "CornflowerBlue" "dark slate blue" "DarkSlateBlue" "light blue" "LightBlue" "light steel blue" "LightSteelBlue" "medium blue" "MediumBlue" "medium slate blue" "MediumSlateBlue" "midnight blue" "MidnightBlue" "navy blue" "NavyBlue" "navy" "Navy" "sky blue" "SkyBlue" "slate blue" "SlateBlue" "steel blue" "SteelBlue" "coral" "Coral" "cyan" "Cyan" "firebrick" "Firebrick" "brown" "Brown" "gold" "Gold" "goldenrod" "Goldenrod" "green" "Green" "dark green" "DarkGreen" "dark olive green" "DarkOliveGreen" "forest green" "ForestGreen" "lime green" "LimeGreen" "medium sea green" "MediumSeaGreen" "medium spring green" "MediumSpringGreen" "pale green" "PaleGreen" "sea green" "SeaGreen" "spring green" "SpringGreen" "yellow green" "YellowGreen" "dark slate grey" "DarkSlateGrey" "dark slate gray" "DarkSlateGray" "dim grey" "DimGrey" "dim gray" "DimGray" "light grey" "LightGrey" "light gray" "LightGray" "gray" "grey" "Gray" "Grey" "khaki" "Khaki" "magenta" "Magenta" "maroon" "Maroon" "orange" "Orange" "orchid" "Orchid" "dark orchid" "DarkOrchid" "medium orchid" "MediumOrchid" "pink" "Pink" "plum" "Plum" "red" "Red" "indian red" "IndianRed" "medium violet red" "MediumVioletRed" "orange red" "OrangeRed" "violet red" "VioletRed" "salmon" "Salmon" "sienna" "Sienna" "tan" "Tan" "thistle" "Thistle" "turquoise" "Turquoise" "dark turquoise" "DarkTurquoise" "medium turquoise" "MediumTurquoise" "violet" "Violet" "blue violet" "BlueViolet" "wheat" "Wheat" "white" "White" "yellow" "Yellow" "green yellow" "GreenYellow")) (#$ . 7356)) #@171 Return a list of colors supported for a particular frame. The argument FRAME specifies which frame to try. The value may be different for frames on different X displays. (defalias 'x-defined-colors #[(&optional frame) "„Á \nɃ+@AÇ È#ƒ \fB‚\f+‡" [frame selected-frame x-colors nil defined-colors this-color all-colors face-color-supported-p t] 4 (#$ . 9101)]) #@69 Iconify the selected frame, or deiconify if it's currently an icon. (defalias 'iconify-or-deiconify-frame #[nil "ÀÁ žAÂ=ƒ à ‡Ä ‡" [visibility frame-parameters t iconify-frame make-frame-visible] 2 (#$ . 9491) nil]) (byte-code "ÀÁ #ˆÄ ÆÇ#ˆÄ ÈÉ#ˆÄ ÊË#ˆÄ ÌÍ#ˆÄ ÎÏ#ˆÄ ÐÑ#ˆÄ ÒÓ#ˆÄ ÔÕ#ˆÄ Ö×#ˆÄ ØÙ#ˆÄ ÚÛ#ˆÄ ÜÝ#ˆÄ Þß#ˆÄ àá#ˆâãäå#ˆâæäå#ˆâçäè#ˆâéäê#ˆâëäì#ˆâíäî#ˆâïäð#‡" [substitute-key-definition suspend-emacs iconify-or-deiconify-frame global-map define-key function-key-map [backspace] [127] [delete] [127] [tab] [9] [linefeed] [10] [clear] [12] [return] [13] [escape] [27] [M-backspace] [-134217601] [M-delete] [-134217601] [M-tab] [-134217719] [M-linefeed] [-134217718] [M-clear] [-134217716] [M-return] [-134217715] [M-escape] [-134217701] put backspace ascii-character 127 delete tab 9 linefeed 10 clear 12 return 13 escape 27] 4) #@161 Return the appropriate value of system-key-alist for VENDOR. VENDOR is a string containing the name of the X Server's vendor, as returned by (x-server-vendor). (defalias 'vendor-specific-keysyms #[(vendor) "Á˜ƒ‡Ø„ĘƒŇƘ„\"ǘƒ$ȇɇ" [vendor "Apollo Computer Inc." ((65280 . linedel) (65281 . chardel) (65282 . copy) (65283 . cut) (65284 . paste) (65285 . move) (65286 . grow) (65287 . cmd) (65288 . shell) (65289 . leftbar) (65290 . rightbar) (65291 . leftbox) (65292 . rightbox) (65293 . upbox) (65294 . downbox) (65295 . pop) (65296 . read) (65297 . edit) (65298 . save) (65299 . exit) (65300 . repeat)) "Hewlett-Packard Incorporated" "Hewlett-Packard Company" ((168 . mute-acute) (169 . mute-grave) (170 . mute-asciicircum) (171 . mute-diaeresis) (172 . mute-asciitilde) (175 . lira) (190 . guilder) (252 . block) (256 . longminus) (65388 . reset) (65389 . system) (65390 . user) (65391 . clearline) (65392 . insertline) (65393 . deleteline) (65394 . insertchar) (65395 . deletechar) (65396 . backtab) (65397 . kp-backtab)) "X11/NeWS - Sun Microsystems Inc." "X Consortium" ((392976 . f36) (392977 . f37) (393056 . req) (393072 . props) (393073 . front) (393074 . copy) (393075 . open) (393076 . paste) (393077 . cut)) ((65280 . remove))] 2 (#$ . 10328)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp x-last-selected-text nil current-load-list] 2) #@52 Max number of characters to put in the cut buffer. (defvar x-cut-buffer-max 20000 (#$ . 11691)) #@101 Non-nil means cutting and pasting uses the clipboard. This is in addition to the primary selection. (defvar x-select-enable-clipboard nil (#$ . 11794)) (defalias 'x-select-text #[(text &optional push) "G WƒÂ \"ˆ‚ÂÄ \"ˆÅÆ\"ˆƒ#ÅÈ\"ˆ‰ ‡" [text x-cut-buffer-max x-set-cut-buffer push "" x-set-selection PRIMARY x-select-enable-clipboard CLIPBOARD x-last-selected-text] 3]) (defalias 'x-cut-buffer-or-selection-value #[nil "ÀÂÃĈ ŘƒÀƒÂÇȈ Řƒ!À „)ÉÊ! Řƒ1À „9À‚V  =ƒDÀ‚V  ˜ƒR  À‚V ‰ )‡" [nil text c (byte-code "ÀÁ!À‡" [x-get-selection PRIMARY text] 2) ((error (message "%s" c))) "" x-select-enable-clipboard (byte-code "ÀÁ!À‡" [x-get-selection CLIPBOARD text] 2) ((error (message "%s" c))) x-get-cut-buffer 0 x-last-selected-text] 3]) (byte-code "À !\n;„ ÃÅ ÆÇ\n\"‰ƒ\n\fÈIˆ‚)ÉÊ!ƒ:Ë\f†2ÍÎ!‰\fÐ#ˆ‚JË\f†FÍÎ!‰\f\"ˆÑÓ Ô¥ÕZ^Æ×Ø \"ƒcÙ ˆÚÛÜ\"ûß!àž„…ឃâãBBä%\"%枃¨æ‰žAB'B'螃»è‰žAB'B'*Ð)Úêë\"‰,ƒ×Æí,\"ƒ×î'B'*Úïð\"1ò31ƒìô1!3)Ç" [x-handle-args command-line-args x-resource-name nil i invocation-name string-match "[.*]" 45 fboundp x-close-connection x-open-connection x-display-name getenv "DISPLAY" x-command-line-resources t x-create-frame-with-faces frame-creation-function x-server-max-request-size 2 100 x-cut-buffer-max "Sun Microsystems,? Inc\\." x-server-vendor menu-bar-enable-clipboard x-get-resource "geometry" "Geometry" res-geometry parsed x-parse-geometry top left (user-position . t) (user-size . t) append initial-frame-alist height default-frame-alist width case-fold-search "reverseVideo" "ReverseVideo" rv "^\\(true\\|yes\\|on\\)$" (reverse . t) "selectionTimeout" "SelectionTimeout" res-selection-timeout 20000 x-selection-timeout string-to-number] 5) (defalias 'x-win-suspend-error #[nil "ÀÁ!‡" [error "Suspending an emacs running under X makes no sense"] 2]) (byte-code "ÀÁÂ\"ˆÃÅÇÉÊË\"‡" [add-hook suspend-hook x-win-suspend-error x-select-text interprogram-cut-function x-cut-buffer-or-selection-value interprogram-paste-function t split-window-keep-point set-default mode-line-buffer-identification ("Emacs: %12b")] 3) emacs-19.30/lisp/term/xterm.elc100666 75424 1 1655 5766720155 15076 0ustar kwzhdaemon;ELC ;;; compiled by kwzh@churchy.gnu.ai.mit.edu on Sun Jun 11 22:03:19 1995 ;;; from file /home/gd/gnu/emacs/19.0/lisp/term/xterm.el ;;; emacs version 19.28.92.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`xterm.el' was compiled for Emacs 19.29 or later")) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆÀ ØÙ#ˆÀ ÚÛ#ˆÀ ÜÝ#ˆÀ Þß#ˆÀ àá#ˆÀ âã#ˆÀ äå#ˆÀ æç#ˆÀ èé#ˆÀ êë#‡" [define-key function-key-map "" [up] "" [down] "" [right] "" [left] "[2~" [insert] "[4~" [select] "[5~" [prior] "[6~" [next] "[11~" [f1] "[12~" [f2] "[13~" [f3] "[14~" [f4] "[15~" [f5] "[17~" [f6] "[18~" [f7] "[19~" [f8] "[20~" [f9] "[21~" [f10] "[23~" [f11] "[24~" [f12] "[29~" [print]] 4) emacs-19.30/lisp/term/README100444 13437 1 20354 5405344473 14066 0ustar jimbdaemon This directory contains files of elisp that customize Emacs for certain terminal types. When Emacs starts, it checks the TERM environment variable to see what type of terminal the user is running on, checks for an elisp file named "term/${TERM}.el", and if one exists, loads it. If that doesn't yield a file that exists, the last hyphen and what follows it is stripped. If that doesn't yield a file that exists, the previous hyphen is stripped, and so on until all hyphens are gone. For example, if the terminal type is `aaa-48-foo', Emacs will try first `term/aaa-48-foo.el', then `term/aaa-48.el' and finally `term/aaa.el'. When writing terminal packages, there are some things it is good to keep in mind. First, about keycap names. Your terminal package can create any keycap cookies it likes, but there are good reasons to stick to the set recognized by the X-windows code whenever possible. The key symbols recognized by Emacs are listed in src/term.c; look for the string `keys' in that file. For one thing, it means that you'll have the same Emacs key bindings on in terminal mode as on an X console. If there are differences, you can bet they'll frustrate you after you've forgotten about them. For another, the X keysms provide a standard set of names that Emacs knows about. It tries to bind many of them to useful things at startup, before your .emacs is read (so you can override them). In some ways, the X keysym standard is a admittedly poor one; it's incomplete, and not well matched to the set of `virtual keys' that UNIX terminfo(3) provides. But, trust us, the alternatives were worse. This doesn't mean that if your terminal has a "Cokebottle" key you shouldn't define a [cokebottle] keycap. But if you must define cookies that aren't in that set, try to pattern them on the standard terminfo variable names for clarity; also, for a fighting chance that your binding may be useful to someone else someday. For example, if your terminal has a `find' key, observe that terminfo supports a key_find capability and call your cookie [key-find]. Here is a complete list, with corresponding X keysyms. ----------------------------------------------------------------------------- Variable name cap X Keysym Description -------------- --- ------------ ------------------------------------- key_down kd down Sent by terminal down arrow key key_up ku up Sent by terminal up arrow key key_left kl left Sent by terminal left arrow key key_right kr right Sent by terminal right arrow key key_home kh home Sent by home key. key_backspace kb Sent by backspace key key_dl kd deleteline Sent by delete line key. key_il kA insertline Sent by insert line. key_dc kD Sent by delete character key. key_ic kI insertchar (1) Sent by ins char/enter ins mode key. key_eic KM Sent by rmir or smir in insert mode. key_clear kC Sent by clear screen or erase key. key_eos kS Sent by clear-to-end-of-screen key. key_eol kE Sent by clear-to-end-of-line key. key_sf kF Sent by scroll-forward/down key key_sr kR Sent by scroll-backward/up key key_npage kN next (2) Sent by next-page key key_ppage kP prior (2) Sent by previous-page key key_stab kT Sent by set-tab key key_ctab kt Sent by clear-tab key key_catab ka Sent by clear-all-tabs key. key_enter @8 kp-enter Enter/send (unreliable) key_print %9 print print or copy key_ll kH Sent by home-down key key_a1 K1 kp-1 Upper left of keypad key_a3 K3 kp-3 Upper right of keypad key_b2 K2 kp-5 Center of keypad key_c1 K4 kp-7 Lower left of keypad key_c3 K5 kp-9 Lower right of keypad key_btab kB backtab Back tab key key_beg @1 begin beg(inning) key key_cancel @2 cancel cancel key key_close @3 close key key_command @4 execute (3) cmd (command) key key_copy @5 copy key key_create @6 create key key_end @7 end end key key_exit @9 exit key key_find @0 find key key_help %1 help key key_mark %2 mark key key_message %3 message key key_move %4 move key key_next %5 next (2) next object key key_open %6 open key key_options %7 menu (3) options key key_previous %8 previous (2) previous object key key_redo %0 redo redo key key_reference &1 ref(erence) key key_refresh &2 refresh key key_replace &3 replace key key_restart &4 reset (3) restart key key_resume &5 resume key key_save &6 save key key_sbeg &9 shifted beginning key key_select *6 select select key key_suspend &7 suspend key key_undo &8 undo undo key key_scancel &0 shifted cancel key key_scommand *1 shifted command key key_scopy *2 shifted copy key key_screate *3 shifted create key key_sdc *4 shifted delete char key key_sdl *5 shifted delete line key key_send *7 shifted end key key_seol *8 shifted clear line key key_sexit *9 shifted exit key key_sf kF shifted find key key_shelp #1 shifted help key key_shome #2 shifted home key key_sic #3 shifted input key key_sleft #4 shifted left arrow key key_smessage %a shifted message key key_smove %b shifted move key key_snext %c shifted next key key_soptions %d shifted options key key_sprevious %e shifted prev key key_sprint %f shifted print key key_sredo %g shifted redo key key_sreplace %h shifted replace key key_sright %i shifted right arrow key_sresume %j shifted resume key key_ssave !1 shifted save key key_suspend !2 shifted suspend key key_sundo !3 shifted undo key key_f0 k0 f0 (4) function key 0 key_f1 k1 f1 function key 1 key_f2 k2 f2 function key 2 key_f3 k3 f3 function key 3 key_f4 k4 f4 function key 4 key_f5 k5 f5 function key 5 key_f6 k6 f6 function key 6 key_f7 k7 f7 function key 7 key_f8 k8 f8 function key 8 key_f9 k9 f9 function key 9 key_f10 k; f10 (4) function key 10 key_f11 F1 f11 function key 11 : : : : key_f35 FP f35 function key 35 key_f36 FQ function key 36 : : : : key_f64 k1 function key 64 (1) The terminfo documentation says this may be the 'insert character' or `enter insert mode' key. Accordingly, key_ic is mapped to the `insertchar' keysym if there is also a key_dc key; otherwise it's mapped to `insert'. The presumption is that keyboards with `insert character' keys usually have `delete character' keys paired with them. (2) If there is no key_next key but there is a key_npage key, key_npage will be bound to the `next' keysym. If there is no key_previous key but there is a key_ppage key, key_ppage will be bound to the `previous' keysym. (3) Sorry, these are not exact but they're the best we can do. (4) The uses of the "k0" capability are inconsistent; sometimes it describes F10, whereas othertimes it describes F0 and "k;" describes F10. Emacs attempts to politely accommodate both systems by testing for "k;", and if it is present, assuming that "k0" denotes F0, otherwise F10. ----------------------------------------------------------------------------- The following X keysyms do *not* have terminfo equivalents. These are the cookies your terminal package will have to set up itself, if you want them: break system user kp-backtab kp-space kp-tab kp-f1 kp-f2 kp-f3 kp-f4 kp-multiply kp-add kp-separator kp-subtract kp-decimal kp-divide kp-0 kp-2 kp-4 kp-6 kp-8 kp-equal In general, you should not bind any of the standard keysym names to functions in a terminal package. There's code in loaddefs.el that does that; the less people make exceptions to that, the more consistent an interface Emacs will have across different keyboards. Those exceptions should go in your .emacs file. Finally, if you're using a USL UNIX or a Sun box or anything else with the USL version of curses(3) on it, bear in mind that the original curses(3) had (and still has) a very much smaller set of keycaps. In fact, the reliable ones were just the arrow keys and the first ten function keys. If you care about making your package portable to older Berkeley machines, don't count on the setup code to bind anything else. If your terminal's arrow key sequences are so funky that they conflict with normal Emacs key bindings, the package should set up a function called (enable-foo-arrow-keys), where `foo' becomes the terminal name, and leave it up to the user's .emacs file whether to call it. Before writing a terminal-support package, it's a good idea to read the existing ones and learn the common conventions. emacs-19.30/lisp/abbrev.el100444 75424 12 24437 5747253672 13771 0ustar kwzhstaff;;; abbrev.el --- abbrev mode commands for Emacs ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. ;; Keywords: abbrev ;; 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 facility is documented in the Emacs Manual. ;;; Code: (defconst only-global-abbrevs nil "\ *t means user plans to use global abbrevs only. Makes the commands to define mode-specific abbrevs define global ones instead.") (defun abbrev-mode (arg) "Toggle abbrev mode. With argument ARG, turn abbrev mode on iff ARG is positive. In abbrev mode, inserting an abbreviation causes it to expand and be replaced by its expansion." (interactive "P") (setq abbrev-mode (if (null arg) (not abbrev-mode) (> (prefix-numeric-value arg) 0))) (force-mode-line-update)) (defvar edit-abbrevs-map nil "Keymap used in edit-abbrevs.") (if edit-abbrevs-map nil (setq edit-abbrevs-map (make-sparse-keymap)) (define-key edit-abbrevs-map "\C-x\C-s" 'edit-abbrevs-redefine) (define-key edit-abbrevs-map "\C-c\C-c" 'edit-abbrevs-redefine)) (defun kill-all-abbrevs () "Undefine all defined abbrevs." (interactive) (let ((tables abbrev-table-name-list)) (while tables (clear-abbrev-table (symbol-value (car tables))) (setq tables (cdr tables))))) (defun insert-abbrevs () "Insert after point a description of all defined abbrevs. Mark is set after the inserted text." (interactive) (push-mark (save-excursion (let ((tables abbrev-table-name-list)) (while tables (insert-abbrev-table-description (car tables) t) (setq tables (cdr tables)))) (point)))) (defun list-abbrevs () "Display a list of all defined abbrevs." (interactive) (display-buffer (prepare-abbrev-list-buffer))) (defun prepare-abbrev-list-buffer () (save-excursion (set-buffer (get-buffer-create "*Abbrevs*")) (erase-buffer) (let ((tables abbrev-table-name-list)) (while tables (insert-abbrev-table-description (car tables) t) (setq tables (cdr tables)))) (goto-char (point-min)) (set-buffer-modified-p nil) (edit-abbrevs-mode)) (get-buffer-create "*Abbrevs*")) (defun edit-abbrevs-mode () "Major mode for editing the list of abbrev definitions. \\{edit-abbrevs-map}" (interactive) (setq major-mode 'edit-abbrevs-mode) (setq mode-name "Edit-Abbrevs") (use-local-map edit-abbrevs-map)) (defun edit-abbrevs () "Alter abbrev definitions by editing a list of them. Selects a buffer containing a list of abbrev definitions. You can edit them and type \\\\[edit-abbrevs-redefine] to redefine abbrevs according to your editing. Buffer contains a header line for each abbrev table, which is the abbrev table name in parentheses. This is followed by one line per abbrev in that table: NAME USECOUNT EXPANSION HOOK where NAME and EXPANSION are strings with quotes, USECOUNT is an integer, and HOOK is any valid function or may be omitted (it is usually omitted)." (interactive) (switch-to-buffer (prepare-abbrev-list-buffer))) (defun edit-abbrevs-redefine () "Redefine abbrevs according to current buffer contents." (interactive) (define-abbrevs t) (set-buffer-modified-p nil)) (defun define-abbrevs (&optional arg) "Define abbrevs according to current visible buffer contents. See documentation of `edit-abbrevs' for info on the format of the text you must have in the buffer. With argument, eliminate all abbrev definitions except the ones defined from the buffer now." (interactive "P") (if arg (kill-all-abbrevs)) (save-excursion (goto-char (point-min)) (while (and (not (eobp)) (re-search-forward "^(" nil t)) (let* ((buf (current-buffer)) (table (read buf)) abbrevs name hook exp count) (forward-line 1) (while (progn (forward-line 1) (not (eolp))) (setq name (read buf) count (read buf) exp (read buf)) (skip-chars-backward " \t\n\f") (setq hook (if (not (eolp)) (read buf))) (skip-chars-backward " \t\n\f") (setq abbrevs (cons (list name exp hook count) abbrevs))) (define-abbrev-table table abbrevs))))) (defun read-abbrev-file (&optional file quietly) "Read abbrev definitions from file written with `write-abbrev-file'. Optional argument FILE is the name of the file to read; it defaults to the value of `abbrev-file-name'. Optional second argument QUIETLY non-nil means don't print anything." (interactive "fRead abbrev file: ") (load (if (and file (> (length file) 0)) file abbrev-file-name) nil quietly) (setq save-abbrevs t abbrevs-changed nil)) (defun quietly-read-abbrev-file (&optional file) "Read abbrev definitions from file written with write-abbrev-file. Optional argument FILE is the name of the file to read; it defaults to the value of `abbrev-file-name'. Does not print anything." ;(interactive "fRead abbrev file: ") (read-abbrev-file file t)) (defun write-abbrev-file (file) "Write all abbrev definitions to a file of Lisp code. The file written can be loaded in another session to define the same abbrevs. The argument FILE is the file name to write." (interactive (list (read-file-name "Write abbrev file: " (file-name-directory (expand-file-name abbrev-file-name)) abbrev-file-name))) (or (and file (> (length file) 0)) (setq file abbrev-file-name)) (save-excursion (set-buffer (get-buffer-create " write-abbrev-file")) (erase-buffer) (let ((tables abbrev-table-name-list)) (while tables (insert-abbrev-table-description (car tables) nil) (setq tables (cdr tables)))) (write-region 1 (point-max) file) (erase-buffer))) (defun add-mode-abbrev (arg) "Define mode-specific abbrev for last word(s) before point. Argument is how many words before point form the expansion; or zero means the region is the expansion. A negative argument means to undefine the specified abbrev. Reads the abbreviation in the minibuffer. Don't use this function in a Lisp program; use `define-abbrev' instead." (interactive "p") (add-abbrev (if only-global-abbrevs global-abbrev-table (or local-abbrev-table (error "No per-mode abbrev table"))) "Mode" arg)) (defun add-global-abbrev (arg) "Define global (all modes) abbrev for last word(s) before point. The prefix argument specifies the number of words before point that form the expansion; or zero means the region is the expansion. A negative argument means to undefine the specified abbrev. This command uses the minibuffer to read the abbreviation. Don't use this function in a Lisp program; use `define-abbrev' instead." (interactive "p") (add-abbrev global-abbrev-table "Global" arg)) (defun add-abbrev (table type arg) (let ((exp (and (>= arg 0) (buffer-substring (point) (if (= arg 0) (mark) (save-excursion (forward-word (- arg)) (point)))))) name) (setq name (read-string (format (if exp "%s abbrev for \"%s\": " "Undefine %s abbrev: ") type exp))) (set-text-properties 0 (length name) nil name) (if (or (null exp) (not (abbrev-expansion name table)) (y-or-n-p (format "%s expands to \"%s\"; redefine? " name (abbrev-expansion name table)))) (define-abbrev table (downcase name) exp)))) (defun inverse-add-mode-abbrev (arg) "Define last word before point as a mode-specific abbrev. With prefix argument N, defines the Nth word before point. This command uses the minibuffer to read the expansion. Expands the abbreviation after defining it." (interactive "p") (inverse-add-abbrev (if only-global-abbrevs global-abbrev-table (or local-abbrev-table (error "No per-mode abbrev table"))) "Mode" arg)) (defun inverse-add-global-abbrev (arg) "Define last word before point as a global (mode-independent) abbrev. With prefix argument N, defines the Nth word before point. This command uses the minibuffer to read the expansion. Expands the abbreviation after defining it." (interactive "p") (inverse-add-abbrev global-abbrev-table "Global" arg)) (defun inverse-add-abbrev (table type arg) (let (name nameloc exp) (save-excursion (forward-word (- arg)) (setq name (buffer-substring (point) (progn (forward-word 1) (setq nameloc (point)))))) (set-text-properties 0 (length name) nil name) (setq exp (read-string (format "%s expansion for \"%s\": " type name))) (if (or (not (abbrev-expansion name table)) (y-or-n-p (format "%s expands to \"%s\"; redefine? " name (abbrev-expansion name table)))) (progn (define-abbrev table (downcase name) exp) (save-excursion (goto-char nameloc) (expand-abbrev)))))) (defun abbrev-prefix-mark (&optional arg) "Mark current point as the beginning of an abbrev. Abbrev to be expanded starts here rather than at beginning of word. This way, you can expand an abbrev with a prefix: insert the prefix, use this command, then insert the abbrev." (interactive "P") (or arg (expand-abbrev)) (setq abbrev-start-location (point-marker) abbrev-start-location-buffer (current-buffer)) (insert "-")) (defun expand-region-abbrevs (start end &optional noquery) "For abbrev occurrence in the region, offer to expand it. The user is asked to type y or n for each occurrence. A prefix argument means don't query; expand all abbrevs. If called from a Lisp program, arguments are START END &optional NOQUERY." (interactive "r\nP") (save-excursion (goto-char start) (let ((lim (- (point-max) end)) pnt string) (while (and (not (eobp)) (progn (forward-word 1) (<= (setq pnt (point)) (- (point-max) lim)))) (if (abbrev-expansion (setq string (buffer-substring (save-excursion (forward-word -1) (point)) pnt))) (if (or noquery (y-or-n-p (format "Expand `%s'? " string))) (expand-abbrev))))))) ;;; abbrev.el ends here emacs-19.30/lisp/abbrevlist.el100444 12241 12 3412 5444560656 15110 0ustar rolandstaff;;; abbrevlist.el --- list one abbrev table alphabetically ordered. ;; Copyright (C) 1986, 1992 Free Software Foundation, Inc. ;; Suggested by a previous version by Gildea. ;; Maintainer: FSF ;; Keywords: abbrev ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (defun list-one-abbrev-table (abbrev-table output-buffer) "Display alphabetical listing of ABBREV-TABLE in buffer OUTPUT-BUFFER." (with-output-to-temp-buffer output-buffer (save-excursion (let ((abbrev-list nil) (first-column 0)) (set-buffer standard-output) (mapatoms (function (lambda (abbrev) (setq abbrev-list (cons abbrev abbrev-list)))) abbrev-table) (setq abbrev-list (sort abbrev-list 'string-lessp)) (while abbrev-list (if (> (+ first-column 40) (frame-width)) (progn (insert "\n") (setq first-column 0))) (indent-to first-column) (insert (symbol-name (car abbrev-list))) (indent-to (+ first-column 8)) (insert (symbol-value (car abbrev-list))) (setq first-column (+ first-column 40)) (setq abbrev-list (cdr abbrev-list))))))) (provide 'abbrevlist) ;;; abbrevlist.el ends here emacs-19.30/lisp/ada-mode.el100444 12120 1 351012 6045200504 14075 0ustar rmsdaemon;;; ada-mode.el --- An Emacs major-mode for editing Ada source. ;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;;; Authors: Markus Heritsch ;;; Rolf Ebert ;;; 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. ;;; This mode is a complete rewrite of a major mode for editing Ada 83 ;;; and Ada 95 source code under Emacs-19. It contains completely new ;;; indenting code and support for code browsing (see ada-xref). ;;; USAGE ;;; ===== ;;; Emacs should enter ada-mode when you load an ada source (*.ad[abs]). ;;; ;;; When you have entered ada-mode, you may get more info by pressing ;;; C-h m. You may also get online help describing various functions by: ;;; C-h d ;;; HISTORY ;;; ======= ;;; The first Ada mode for GNU Emacs was written by V. Broman in ;;; 1985. He based his work on the already existing Modula-2 mode. ;;; This was distributed as ada.el in versions of Emacs prior to 19.29. ;;; ;;; Lynn Slater wrote an extensive Ada mode in 1989. It consisted of ;;; several files with support for dired commands and other nice ;;; things. It is currently available from the PAL ;;; (wuarchive.wustl.edu:/languages/ada) as ada-mode-1.06a.tar.Z. ;;; ;;; The probably very first Ada mode (called electric-ada.el) was ;;; written by Steven D. Litvintchouk and Steven M. Rosen for the ;;; Gosling Emacs. L. Slater based his development on ada.el and ;;; electric-ada.el. ;;; ;;; The current Ada mode is a complete rewrite by M. Heritsch and ;;; R. Ebert. Some ideas from the ada-mode mailing list have been ;;; added. Some of the functionality of L. Slater's mode has not ;;; (yet) been recoded in this new mode. Perhaps you prefer sticking ;;; to his version. ;;; KNOWN BUGS ;;; ========== ;;; ;;; In the presence of comments and/or incorrect syntax ;;; ada-format-paramlist produces weird results. ;;; ------------------- ;;; Indenting of some tasking constructs is still buggy. ;;; ------------------- ;;; package Test is ;;; -- If I hit return on the "type" line it will indent the next line ;;; -- in another 3 space instead of heading out to the "(". If I hit ;;; -- tab or return it reindents the line correctly but does not initially. ;;; type Wait_Return is (Read_Success, Read_Timeout, Wait_Timeout, ;;; Nothing_To_Wait_For_In_Wait_List); ;;; ------------------- ;;; CREDITS ;;; ======= ;;; ;;; Many thanks to ;;; Philippe Warroquiers (PW) in particular, ;;; woodruff@stc.llnl.gov (John Woodruff) ;;; jj@ddci.dk (Jesper Joergensen) ;;; gse@ocsystems.com (Scott Evans) ;;; comar@LANG8.CS.NYU.EDU (Cyrille Comar) ;;; and others for their valuable hints. ;;;-------------------- ;;; USER OPTIONS ;;;-------------------- ;; ---- configure indentation (defvar ada-indent 3 "*Defines the size of Ada indentation.") (defvar ada-broken-indent 2 "*# of columns to indent the continuation of a broken line.") (defvar ada-label-indent -4 "*# of columns to indent a label.") (defvar ada-stmt-end-indent 0 "*# of columns to indent a statement end keyword in a separate line. Examples are 'is', 'loop', 'record', ...") (defvar ada-when-indent 3 "*Defines the indentation for 'when' relative to 'exception' or 'case'.") (defvar ada-indent-record-rel-type 3 "*Defines the indentation for 'record' relative to 'type' or 'use'.") (defvar ada-indent-comment-as-code t "*If non-nil, comment-lines get indented as Ada code.") (defvar ada-indent-is-separate t "*If non-nil, 'is separate' or 'is abstract' on a single line are indented.") (defvar ada-indent-to-open-paren t "*If non-nil, indent according to the innermost open parenthesis.") (defvar ada-search-paren-char-count-limit 3000 "*Search that many characters for an open parenthesis.") ;; ---- other user options (defvar ada-tab-policy 'indent-auto "*Control behaviour of the TAB key. Must be one of `indent-rigidly', `indent-auto', `gei', `indent-af' or `always-tab'. `indent-rigidly' : always adds ada-indent blanks at the beginning of the line. `indent-auto' : use indentation functions in this file. `gei' : use David Kågedal's Generic Indentation Engine. `indent-af' : use Gary E. Barnes' ada-format.el `always-tab' : do indent-relative.") (defvar ada-move-to-declaration nil "*If non-nil, `ada-move-to-start' moves point to the subprog declaration, not to 'begin'.") (defvar ada-spec-suffix ".ads" "*Suffix of Ada specification files.") (defvar ada-body-suffix ".adb" "*Suffix of Ada body files.") (defvar ada-language-version 'ada95 "*Do we program in `ada83' or `ada95'?") (defvar ada-case-keyword 'downcase-word "*Function to call to adjust the case of Ada keyworrds. It may be `downcase-word', `upcase-word', `ada-loose-case-word' or `capitalize-word'.") (defvar ada-case-identifier 'ada-loose-case-word "*Function to call to adjust the case of an Ada identifier. It may be `downcase-word', `upcase-word', `ada-loose-case-word' or `capitalize-word'.") (defvar ada-case-attribute 'capitalize-word "*Function to call to adjust the case of Ada attributes. It may be `downcase-word', `upcase-word', `ada-loose-case-word' or `capitalize-word'.") (defvar ada-auto-case t "*Non-nil automatically changes casing of preceeding word while typing. Casing is done according to `ada-case-keyword', `ada-case-identifier' and `ada-cacse-attribute'.") (defvar ada-clean-buffer-before-saving nil "*If non-nil, `remove-trailing-spaces' and `untabify' buffer before saving.") (defvar ada-mode-hook nil "*List of functions to call when Ada Mode is invoked. This is a good place to add Ada environment specific bindings.") (defvar ada-external-pretty-print-program "aimap" "*External pretty printer to call from within Ada Mode.") (defvar ada-tmp-directory "/tmp/" "*Directory to store the temporary file for the Ada pretty printer.") (defvar ada-fill-comment-prefix "-- " "*This is inserted in the first columns when filling a comment paragraph.") (defvar ada-fill-comment-postfix " --" "*This is inserted at the end of each line when filling a comment paragraph. with `ada-fill-comment-paragraph-postfix'.") (defvar ada-krunch-args "0" "*Argument of gnatk8, a string containing the max number of characters. Set to 0, if you dont use crunched filenames.") ;;; ---- end of user configurable variables (defvar ada-mode-abbrev-table nil "Abbrev table used in Ada mode.") (define-abbrev-table 'ada-mode-abbrev-table ()) (defvar ada-mode-map () "Local keymap used for Ada Mode.") (defvar ada-mode-syntax-table nil "Syntax table to be used for editing Ada source code.") (defvar ada-mode-symbol-syntax-table nil "Syntax table for Ada, where `_' is a word constituent.") (defconst ada-83-keywords "\\<\\(abort\\|abs\\|accept\\|access\\|all\\|and\\|array\\|\ at\\|begin\\|body\\|case\\|constant\\|declare\\|delay\\|delta\\|\ digits\\|do\\|else\\|elsif\\|end\\|entry\\|exception\\|exit\\|for\\|\ function\\|generic\\|goto\\|if\\|in\\|is\\|limited\\|loop\\|mod\\|\ new\\|not\\|null\\|of\\|or\\|others\\|out\\|package\\|pragma\\|\ private\\|procedure\\|raise\\|range\\|record\\|rem\\|renames\\|\ return\\|reverse\\|select\\|separate\\|subtype\\|task\\|terminate\\|\ then\\|type\\|use\\|when\\|while\\|with\\|xor\\)\\>" ; "\\<\\(a\\(b\\(ort\\|s\\)\\|cce\\(pt\\|ss\\)\\|ll\\|nd\\|rray\\|t\\)\\|\ ;b\\(egin\\|ody\\)\\|c\\(ase\\|onstant\\)\\|\ ;d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|\ ;e\\(ls\\(e\\|if\\)\\|n\\(d\\|try\\)\\|x\\(ception\\|it\\)\\)\\|\ ;f\\(or\\|unction\\)\\|g\\(eneric\\|oto\\)\\|i[fns]\\|l\\(imited\\|oop\\)\\|\ ;mod\\|n\\(ew\\|ot\\|ull\\)\\|o\\([fr]\\|thers\\|ut\\)\\|\ ;p\\(ackage\\|r\\(agma\\|ivate\\|ocedure\\)\\)\\|\ ;r\\(a\\(ise\\|nge\\)\\|e\\(cord\\|m\\|names\\|turn\\|verse\\)\\)\\|\ ;s\\(e\\(lect\\|parate\\)\\|ubtype\\)\\|use\\| ;t\\(ask\\|erminate\\|hen\\|ype\\)\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\|xor\\)\\>" "regular expression for looking at Ada83 keywords.") (defconst ada-95-keywords "\\<\\(abort\\|abs\\|abstract\\|accept\\|access\\|aliased\\|\ all\\|and\\|array\\|at\\|begin\\|body\\|case\\|constant\\|declare\\|\ delay\\|delta\\|digits\\|do\\|else\\|elsif\\|end\\|entry\\|\ exception\\|exit\\|for\\|function\\|generic\\|goto\\|if\\|in\\|\ is\\|limited\\|loop\\|mod\\|new\\|not\\|null\\|of\\|or\\|others\\|\ out\\|package\\|pragma\\|private\\|procedure\\|protected\\|raise\\|\ range\\|record\\|rem\\|renames\\|requeue\\|return\\|reverse\\|\ select\\|separate\\|subtype\\|tagged\\|task\\|terminate\\|then\\|\ type\\|until\\|use\\|when\\|while\\|with\\|xor\\)\\>" "regular expression for looking at Ada95 keywords.") (defvar ada-keywords ada-95-keywords "Regular expression for looking at Ada keywords.") (defvar ada-ret-binding nil "Variable to save key binding of RET when casing is activated.") (defvar ada-lfd-binding nil "Variable to save key binding of LFD when casing is activated.") ;;; ---- Regexps to find procedures/functions/packages (defconst ada-ident-re "[a-zA-Z0-9_\\.]+" "Regexp matching Ada (qualified) identifiers.") (defvar ada-procedure-start-regexp "^[ \t]*\\(procedure\\|function\\|task\\)[ \t\n]+\\([a-zA-Z0-9_\\.]+\\)" "Regexp used to find Ada procedures/functions.") (defvar ada-package-start-regexp "^[ \t]*\\(package\\)" "Regexp used to find Ada packages") ;;; ---- regexps for indentation functions (defvar ada-block-start-re "\\<\\(begin\\|select\\|declare\\|private\\|or\\|generic\\|\ exception\\|loop\\|else\\|\ \\(\\(limited\\|abstract\\|tagged\\)[ \t]+\\)*record\\)\\>" "Regexp for keywords starting Ada blocks.") (defvar ada-end-stmt-re "\\(;\\|=>\\|^[ \t]*separate[ \t]+([a-zA-Z0-9_\\.]+)\\|\ \\<\\(begin\\|else\\|record\\|loop\\|select\\|do\\|\ declare\\|generic\\|private\\)\\>\\|\ ^[ \t]*\\(package\\|procedure\\|function\\)[ \ta-zA-Z0-9_\\.]+is\\|\ ^[ \t]*exception\\>\\)" "Regexp of possible ends for a non-broken statement. A new statement starts after these.") (defvar ada-loop-start-re "\\<\\(for\\|while\\|loop\\)\\>" "Regexp for the start of a loop.") (defvar ada-subprog-start-re "\\<\\(procedure\\|protected\\|package\\|function\\|\ task\\|accept\\|entry\\)\\>" "Regexp for the start of a subprogram.") ;; Written by Christian Egli ;; (defvar ada-imenu-generic-expression '((nil "^\\s-*\\(procedure\\|function\\)\\s-+\\([A-Za-z0-9_]+\\)" 2) ("Type Defs" "^\\s-*\\(sub\\)?type\\s-+\\([A-Za-z0-9_]+\\)" 2)) "Imenu generic expression for Ada mode. See `imenu-generic-expression'.") ;;;------------- ;;; functions ;;;------------- (defun ada-xemacs () (or (string-match "Lucid" emacs-version) (string-match "XEmacs" emacs-version))) (defun ada-create-syntax-table () "Create the syntax table for Ada Mode." ;; There are two different syntax-tables. The standard one declares ;; `_' as a symbol constituent, in the second one, it is a word ;; constituent. For some search and replacing routines we ;; temporarily switch between the two. (setq ada-mode-syntax-table (make-syntax-table)) (set-syntax-table ada-mode-syntax-table) ;; define string brackets (% is alternative string bracket) (modify-syntax-entry ?% "\"" ada-mode-syntax-table) (modify-syntax-entry ?\" "\"" ada-mode-syntax-table) (modify-syntax-entry ?\# "$" ada-mode-syntax-table) (modify-syntax-entry ?: "." ada-mode-syntax-table) (modify-syntax-entry ?\; "." ada-mode-syntax-table) (modify-syntax-entry ?& "." ada-mode-syntax-table) (modify-syntax-entry ?\| "." ada-mode-syntax-table) (modify-syntax-entry ?+ "." ada-mode-syntax-table) (modify-syntax-entry ?* "." ada-mode-syntax-table) (modify-syntax-entry ?/ "." ada-mode-syntax-table) (modify-syntax-entry ?= "." ada-mode-syntax-table) (modify-syntax-entry ?< "." ada-mode-syntax-table) (modify-syntax-entry ?> "." ada-mode-syntax-table) (modify-syntax-entry ?$ "." ada-mode-syntax-table) (modify-syntax-entry ?\[ "." ada-mode-syntax-table) (modify-syntax-entry ?\] "." ada-mode-syntax-table) (modify-syntax-entry ?\{ "." ada-mode-syntax-table) (modify-syntax-entry ?\} "." ada-mode-syntax-table) (modify-syntax-entry ?. "." ada-mode-syntax-table) (modify-syntax-entry ?\\ "." ada-mode-syntax-table) (modify-syntax-entry ?\' "." ada-mode-syntax-table) ;; a single hyphen is punctuation, but a double hyphen starts a comment (modify-syntax-entry ?- ". 12" ada-mode-syntax-table) ;; and \f and \n end a comment (modify-syntax-entry ?\f "> " ada-mode-syntax-table) (modify-syntax-entry ?\n "> " ada-mode-syntax-table) ;; define what belongs in ada symbols (modify-syntax-entry ?_ "_" ada-mode-syntax-table) ;; define parentheses to match (modify-syntax-entry ?\( "()" ada-mode-syntax-table) (modify-syntax-entry ?\) ")(" ada-mode-syntax-table) (setq ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table)) (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table) ) ;;;###autoload (defun ada-mode () "Ada Mode is the major mode for editing Ada code. Bindings are as follows: (Note: 'LFD' is control-j.) Indent line '\\[ada-tab]' Indent line, insert newline and indent the new line. '\\[newline-and-indent]' Re-format the parameter-list point is in '\\[ada-format-paramlist]' Indent all lines in region '\\[ada-indent-region]' Call external pretty printer program '\\[ada-call-pretty-printer]' Adjust case of identifiers and keywords in region '\\[ada-adjust-case-region]' Adjust case of identifiers and keywords in buffer '\\[ada-adjust-case-buffer]' Call EXTERNAL pretty printer (if you have one) '\\[ada-call-pretty-printer]' Fill comment paragraph '\\[ada-fill-comment-paragraph]' Fill comment paragraph and justify each line '\\[ada-fill-comment-paragraph-justify]' Fill comment paragraph, justify and append postfix '\\[ada-fill-comment-paragraph-postfix]' Next func/proc/task '\\[ada-next-procedure]' Previous func/proc/task '\\[ada-previous-procedure]' Next package '\\[ada-next-package]' Previous package '\\[ada-previous-package]' Goto matching start of current 'end ...;' '\\[ada-move-to-start]' Goto end of current block '\\[ada-move-to-end]' Comments are handled using standard GNU Emacs conventions, including: Start a comment '\\[indent-for-comment]' Comment region '\\[comment-region]' Uncomment region '\\[ada-uncomment-region]' Continue comment on next line '\\[indent-new-comment-line]' If you use imenu.el: Display index-menu of functions & procedures '\\[imenu]' If you use find-file.el: Switch to other file (Body <-> Spec) '\\[ff-find-other-file]' or '\\[ff-mouse-find-other-file] Switch to other file in other window '\\[ada-ff-other-window]' or '\\[ff-mouse-find-other-file-other-window] If you use this function in a spec and no body is available, it gets created with body stubs. If you use ada-xref.el: Goto declaration: '\\[ada-point-and-xref]' on the identifier or '\\[ada-goto-declaration]' with point on the identifier Complete identifier: '\\[ada-complete-identifier]' Execute Gnatf: '\\[ada-gnatf-current]'" (interactive) (kill-all-local-variables) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'comment-start) (setq comment-start "-- ") ;; comment end must be set because it may hold a wrong value if ;; this buffer had been in another mode before. RE (make-local-variable 'comment-end) (setq comment-end "") (make-local-variable 'comment-start-skip) ;; used by autofill (setq comment-start-skip "--+[ \t]*") (make-local-variable 'indent-line-function) (setq indent-line-function 'ada-indent-current-function) (make-local-variable 'fill-column) (setq fill-column 75) (make-local-variable 'comment-column) (setq comment-column 40) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (make-local-variable 'case-fold-search) (setq case-fold-search t) (make-local-variable 'fill-paragraph-function) (setq fill-paragraph-function 'ada-fill-comment-paragraph) (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression ada-imenu-generic-expression) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '((ada-font-lock-keywords ada-font-lock-keywords-1 ada-font-lock-keywords-2) nil t ((?\_ . "w")) beginning-of-line)) (setq major-mode 'ada-mode) (setq mode-name "Ada") (setq blink-matching-paren t) (use-local-map ada-mode-map) (if ada-mode-syntax-table (set-syntax-table ada-mode-syntax-table) (ada-create-syntax-table)) (if ada-clean-buffer-before-saving (progn ;; remove all spaces at the end of lines in the whole buffer. (add-hook 'local-write-file-hooks 'ada-remove-trailing-spaces) ;; convert all tabs to the correct number of spaces. (add-hook 'local-write-file-hooks 'ada-untabify-buffer))) ;; add menu 'Ada' to the menu bar (ada-add-ada-menu) (run-hooks 'ada-mode-hook) ;; the following has to be done after running the ada-mode-hook ;; because users might want to set the values of these variable ;; inside the hook (MH) (cond ((eq ada-language-version 'ada83) (setq ada-keywords ada-83-keywords)) ((eq ada-language-version 'ada95) (setq ada-keywords ada-95-keywords))) (if ada-auto-case (ada-activate-keys-for-case))) ;;;-------------------------- ;;; Fill Comment Paragraph ;;;-------------------------- (defun ada-fill-comment-paragraph-justify () "Fills current comment paragraph and justifies each line as well." (interactive) (ada-fill-comment-paragraph t)) (defun ada-fill-comment-paragraph-postfix () "Fills current comment paragraph and justifies each line as well. Prompts for a postfix to be appended to each line." (interactive) (ada-fill-comment-paragraph t t)) (defun ada-fill-comment-paragraph (&optional justify postfix) "Fills the current comment paragraph. If JUSTIFY is non-nil, each line is justified as well. If POSTFIX and JUSTIFY are non-nil, `ada-fill-comment-postfix' is appended to each filled and justified line. If `ada-indent-comment-as-code' is non-nil, the paragraph is idented." (interactive "P") (let ((opos (point-marker)) (begin nil) (end nil) (end-2 nil) (indent nil) (ada-fill-comment-old-postfix "") (fill-prefix nil)) ;; check if inside comment (if (not (ada-in-comment-p)) (error "not inside comment")) ;; prompt for postfix if wanted (if (and justify postfix) (setq ada-fill-comment-postfix (read-from-minibuffer "enter new postfix string: " ada-fill-comment-postfix))) ;; prompt for old postfix to remove if necessary (if (and justify postfix) (setq ada-fill-comment-old-postfix (read-from-minibuffer "enter already existing postfix string: " ada-fill-comment-postfix))) ;; ;; find limits of paragraph ;; (message "filling comment paragraph ...") (save-excursion (back-to-indentation) ;; find end of paragraph (while (and (looking-at "--.*$") (not (looking-at "--[ \t]*$"))) (forward-line 1) (back-to-indentation)) (beginning-of-line) (setq end (point-marker)) (goto-char opos) ;; find begin of paragraph (back-to-indentation) (while (and (looking-at "--.*$") (not (looking-at "--[ \t]*$"))) (forward-line -1) (back-to-indentation)) (forward-line 1) ;; get indentation to calculate width for filling (ada-indent-current) (back-to-indentation) (setq indent (current-column)) (setq begin (point-marker))) ;; delete old postfix if necessary (if (and justify postfix) (save-excursion (goto-char begin) (while (re-search-forward (concat ada-fill-comment-old-postfix "\n") end t) (replace-match "\n")))) ;; delete leading whitespace and uncomment (save-excursion (goto-char begin) (beginning-of-line) (while (re-search-forward "^[ \t]*--[ \t]*" end t) (replace-match ""))) ;; calculate fill width (setq fill-column (- fill-column indent (length ada-fill-comment-prefix) (if postfix (length ada-fill-comment-postfix) 0))) ;; fill paragraph (fill-region begin (1- end) justify) (setq fill-column (+ fill-column indent (length ada-fill-comment-prefix) (if postfix (length ada-fill-comment-postfix) 0))) ;; find end of second last line (save-excursion (goto-char end) (forward-line -2) (end-of-line) (setq end-2 (point-marker))) ;; re-comment and re-indent region (save-excursion (goto-char begin) (indent-to indent) (insert ada-fill-comment-prefix) (while (re-search-forward "\n" (1- end-2) t) (replace-match (concat "\n" ada-fill-comment-prefix)) (beginning-of-line) (indent-to indent))) ;; append postfix if wanted (if (and justify postfix ada-fill-comment-postfix) (progn ;; append postfix up to there (save-excursion (goto-char begin) (while (re-search-forward "\n" (1- end-2) t) (replace-match (concat ada-fill-comment-postfix "\n"))) ;; fill last line and append postfix (end-of-line) (insert-char ? (- fill-column (current-column) (length ada-fill-comment-postfix))) (insert ada-fill-comment-postfix)))) ;; delete the extra line that gets inserted somehow(??) (save-excursion (goto-char (1- end)) (end-of-line) (delete-char 1)) (message "filling comment paragraph ... done") (goto-char opos)) t) ;;;--------------------------------;;; ;;; Call External Pretty Printer ;;; ;;;--------------------------------;;; (defun ada-call-pretty-printer () "Calls the external Pretty Printer. The name is specified in `ada-external-pretty-print-program'. Saves the current buffer in a directory specified by `ada-tmp-directory', starts the pretty printer as external process on that file and then reloads the beautyfied program in the buffer and cleans up `ada-tmp-directory'." (interactive) (let ((filename-with-path buffer-file-name) (curbuf (current-buffer)) (orgpos (point)) (mesgbuf nil) ;; for byte-compiling (file-path (file-name-directory buffer-file-name)) (filename-without-path (file-name-nondirectory buffer-file-name)) (tmp-file-with-directory (concat ada-tmp-directory (file-name-nondirectory buffer-file-name)))) ;; ;; save buffer in temporary file ;; (message "saving current buffer to temporary file ...") (write-file tmp-file-with-directory) (auto-save-mode nil) (message "saving current buffer to temporary file ... done") ;; ;; call external pretty printer program ;; (message "running external pretty printer ...") ;; create a temporary buffer for messages of pretty printer (setq mesgbuf (get-buffer-create "Pretty Printer Messages")) ;; execute pretty printer on temporary file (call-process ada-external-pretty-print-program nil mesgbuf t tmp-file-with-directory) ;; display messages if there are some (if (buffer-modified-p mesgbuf) ;; show the message buffer (display-buffer mesgbuf t) ;; kill the message buffer (kill-buffer mesgbuf)) (message "running external pretty printer ... done") ;; ;; kill current buffer and load pretty printer output ;; or restore old buffer ;; (if (y-or-n-p "Really replace current buffer with pretty printer output ? ") (progn (set-buffer-modified-p nil) (kill-buffer curbuf) (find-file tmp-file-with-directory)) (message "old buffer contents restored")) ;; ;; delete temporary file and restore information of current buffer ;; (delete-file tmp-file-with-directory) (set-visited-file-name filename-with-path) (auto-save-mode t) (goto-char orgpos))) ;;;--------------- ;;; auto-casing ;;;--------------- ;; from Philippe Waroquiers ;; modifiedby RE and MH (defun ada-after-keyword-p () ;; returns t if cursor is after a keyword. (save-excursion (forward-word -1) (and (save-excursion (or (= (point) (point-min)) (backward-char 1)) (not (looking-at "_"))) ; (MH) (looking-at (concat ada-keywords "[^_]"))))) (defun ada-after-char-p () ;; returns t if after ada character "'". This is interpreted as being ;; in a character constant. (save-excursion (if (> (point) 2) (progn (forward-char -2) (looking-at "'")) nil))) (defun ada-adjust-case (&optional force-identifier) "Adjust the case of the word before the just typed character. Respect options `ada-case-keyword', `ada-case-identifier', and `ada-case-attribute'. If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier." ; (MH) (forward-char -1) (if (and (> (point) 1) (not (or (ada-in-string-p) (ada-in-comment-p) (ada-after-char-p)))) (if (eq (char-syntax (char-after (1- (point)))) ?w) (if (save-excursion (forward-word -1) (or (= (point) (point-min)) (backward-char 1)) (looking-at "'")) (funcall ada-case-attribute -1) (if (and (not force-identifier) ; (MH) (ada-after-keyword-p)) (funcall ada-case-keyword -1) (funcall ada-case-identifier -1))))) (forward-char 1)) (defun ada-adjust-case-interactive (arg) (interactive "P") (let ((lastk last-command-char)) (cond ((or (eq lastk ?\n) (eq lastk ?\r)) ;; horrible kludge (insert " ") (ada-adjust-case) ;; horrible dekludge (delete-backward-char 1) ;; some special keys and their bindings (cond ((eq lastk ?\n) (funcall ada-lfd-binding)) ((eq lastk ?\r) (funcall ada-ret-binding)))) ((eq lastk ?\C-i) (ada-tab)) ((self-insert-command (prefix-numeric-value arg)))) ;; if there is a keyword in front of the underscore ;; then it should be part of an identifier (MH) (if (eq lastk ?_) (ada-adjust-case t) (ada-adjust-case)))) (defun ada-activate-keys-for-case () ;; save original keybindings to allow swapping ret/lfd ;; when casing is activated ;; the 'or ...' is there to be sure that the value will not ;; be changed again when Ada Mode is called more than once (MH) (or ada-ret-binding (setq ada-ret-binding (key-binding "\C-M"))) (or ada-lfd-binding (setq ada-lfd-binding (key-binding "\C-j"))) ;; call case modifying function after certain keys. (mapcar (function (lambda(key) (define-key ada-mode-map (char-to-string key) 'ada-adjust-case-interactive))) '( ?` ?~ ?! ?@ ?# ?$ ?% ?^ ?& ?* ?( ?) ?- ?= ?+ ?[ ?{ ?] ?} ?_ ?\\ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?? ?/ ?\n 32 ?\r ))) ;; deleted ?\t from above list ;; ;; added by MH ;; (defun ada-loose-case-word (&optional arg) "Capitalizes the first letter and the letters following `_'. ARG is ignored, it's there to fit the standard casing functions' style." (let ((pos (point)) (first t)) (skip-chars-backward "a-zA-Z0-9_") (while (or first (search-forward "_" pos t)) (and first (setq first nil)) (insert-char (upcase (following-char)) 1) (delete-char 1)) (goto-char pos))) ;; ;; added by MH ;; (defun ada-adjust-case-region (from to) "Adjusts the case of all words in the region. Attention: This function might take very long for big regions !" (interactive "*r") (let ((begin nil) (end nil) (keywordp nil) (reldiff nil)) (unwind-protect (save-excursion (set-syntax-table ada-mode-symbol-syntax-table) (goto-char to) ;; ;; loop: look for all identifiers and keywords ;; (while (re-search-backward "[^a-zA-Z0-9_]\\([a-zA-Z0-9_]+\\)[^a-zA-Z0-9_]" from t) ;; ;; print status message ;; (setq reldiff (- (point) from)) (message (format "adjusting case ... %5d characters left" (- (point) from))) (forward-char 1) (or ;; do nothing if it is a string or comment (ada-in-string-or-comment-p) (progn ;; ;; get the identifier or keyword ;; (setq begin (point)) (setq keywordp (looking-at (concat ada-keywords "[^_]"))) (skip-chars-forward "a-zA-Z0-9_") ;; ;; casing according to user-option ;; (if keywordp (funcall ada-case-keyword -1) (funcall ada-case-identifier -1)) (goto-char begin)))) (message "adjusting case ... done")) (set-syntax-table ada-mode-syntax-table)))) ;; ;; added by MH ;; (defun ada-adjust-case-buffer () "Adjusts the case of all words in the whole buffer. ATTENTION: This function might take very long for big buffers !" (interactive "*") (ada-adjust-case-region (point-min) (point-max))) ;;;------------------------;;; ;;; Format Parameter Lists ;;; ;;;------------------------;;; (defun ada-format-paramlist () "Reformats a parameter list. ATTENTION: 1) Comments inside the list are killed ! 2) If the syntax is not correct (especially, if there are semicolons missing), it can get totally confused ! In such a case, use `undo', correct the syntax and try again." (interactive) (let ((begin nil) (end nil) (delend nil) (paramlist nil)) (unwind-protect (progn (set-syntax-table ada-mode-symbol-syntax-table) ;; check if really inside parameter list (or (ada-in-paramlist-p) (error "not in parameter list")) ;; ;; find start of current parameter-list ;; (ada-search-ignore-string-comment (concat ada-subprog-start-re "\\|\\" ) t nil) (ada-search-ignore-string-comment "(" nil nil t) (backward-char 1) (setq begin (point)) ;; ;; find end of parameter-list ;; (forward-sexp 1) (setq delend (point)) (delete-char -1) ;; ;; find end of last parameter-declaration ;; (ada-search-ignore-string-comment "[^ \t\n]" t nil t) (forward-char 1) (setq end (point)) ;; ;; build a list of all elements of the parameter-list ;; (setq paramlist (ada-scan-paramlist (1+ begin) end)) ;; ;; delete the original parameter-list ;; (delete-region begin (1- delend)) ;; ;; insert the new parameter-list ;; (goto-char begin) (ada-insert-paramlist paramlist)) ;; ;; restore syntax-table ;; (set-syntax-table ada-mode-syntax-table) ))) (defun ada-scan-paramlist (begin end) ;; Scans a parameter-list between BEGIN and END and returns a list ;; of its contents. ;; The list has the following format: ;; ;; Name of Param in? out? access? Name of Type Default-Exp or nil ;; ;; ( ('Name_Param_1' t nil t Type_Param_1 ':= expression') ;; ('Name_Param_2' nil nil t Type_Param_2 nil) ) (let ((paramlist (list)) (param (list)) (notend t) (apos nil) (epos nil) (semipos nil) (match-cons nil)) (goto-char begin) ;; ;; loop until end of last parameter ;; (while notend ;; ;; find first character of parameter-declaration ;; (ada-goto-next-non-ws) (setq apos (point)) ;; ;; find last character of parameter-declaration ;; (if (setq match-cons (ada-search-ignore-string-comment "[ \t\n]*;" nil end t)) (progn (setq epos (car match-cons)) (setq semipos (cdr match-cons))) (setq epos end)) ;; ;; read name(s) of parameter(s) ;; (goto-char apos) (looking-at "\\([a-zA-Z0-9_, \t\n]*[a-zA-Z0-9_]\\)[ \t\n]*:[^=]") (setq param (list (buffer-substring (match-beginning 1) (match-end 1)))) (ada-search-ignore-string-comment ":" nil epos t) ;; ;; look for 'in' ;; (setq apos (point)) (setq param (append param (list (consp (ada-search-ignore-string-comment "\\" nil epos t))))) ;; ;; look for 'out' ;; (goto-char apos) (setq param (append param (list (consp (ada-search-ignore-string-comment "\\" nil epos t))))) ;; ;; look for 'access' ;; (goto-char apos) (setq param (append param (list (consp (ada-search-ignore-string-comment "\\" nil epos t))))) ;; ;; skip 'in'/'out'/'access' ;; (goto-char apos) (ada-goto-next-non-ws) (while (looking-at "\\<\\(in\\|out\\|access\\)\\>") (forward-word 1) (ada-goto-next-non-ws)) ;; ;; read type of parameter ;; (looking-at "\\<[a-zA-Z0-9_\\.]+\\>") (setq param (append param (list (buffer-substring (match-beginning 0) (match-end 0))))) ;; ;; read default-expression, if there is one ;; (goto-char (setq apos (match-end 0))) (setq param (append param (list (if (setq match-cons (ada-search-ignore-string-comment ":=" nil epos t)) (buffer-substring (car match-cons) epos) nil)))) ;; ;; add this parameter-declaration to the list ;; (setq paramlist (append paramlist (list param))) ;; ;; check if it was the last parameter ;; (if (eq epos end) (setq notend nil) (goto-char semipos)) ) ; end of loop (reverse paramlist))) (defun ada-insert-paramlist (paramlist) ;; Inserts a formatted PARAMLIST in the buffer. ;; See doc of `ada-scan-paramlist' for the format. (let ((i (length paramlist)) (parlen 0) (typlen 0) (temp 0) (inp nil) (outp nil) (accessp nil) (column nil) (orgpoint 0) (firstcol nil)) ;; ;; loop until last parameter ;; (while (not (zerop i)) (setq i (1- i)) ;; ;; get max length of parameter-name ;; (setq parlen (if (<= parlen (setq temp (length (nth 0 (nth i paramlist))))) temp parlen)) ;; ;; get max length of type-name ;; (setq typlen (if (<= typlen (setq temp (length (nth 4 (nth i paramlist))))) temp typlen)) ;; ;; is there any 'in' ? ;; (setq inp (or inp (nth 1 (nth i paramlist)))) ;; ;; is there any 'out' ? ;; (setq outp (or outp (nth 2 (nth i paramlist)))) ;; ;; is there any 'access' ? ;; (setq accessp (or accessp (nth 3 (nth i paramlist))))) ; end of loop ;; ;; does paramlist already start on a separate line ? ;; (if (save-excursion (re-search-backward "^.\\|[^ \t]" nil t) (looking-at "^.")) ;; yes => re-indent it (ada-indent-current) ;; ;; no => insert newline and indent it ;; (progn (ada-indent-current) (newline) (delete-horizontal-space) (setq orgpoint (point)) (setq column (save-excursion (funcall (ada-indent-function) orgpoint))) (indent-to column) )) (insert "(") (setq firstcol (current-column)) (setq i (length paramlist)) ;; ;; loop until last parameter ;; (while (not (zerop i)) (setq i (1- i)) (setq column firstcol) ;; ;; insert parameter-name, space and colon ;; (insert (nth 0 (nth i paramlist))) (indent-to (+ column parlen 1)) (insert ": ") (setq column (current-column)) ;; ;; insert 'in' or space ;; (if (nth 1 (nth i paramlist)) (insert "in ") (if (and (or inp accessp) (not (nth 3 (nth i paramlist)))) (insert " "))) ;; ;; insert 'out' or space ;; (if (nth 2 (nth i paramlist)) (insert "out ") (if (and (or outp accessp) (not (nth 3 (nth i paramlist)))) (insert " "))) ;; ;; insert 'access' ;; (if (nth 3 (nth i paramlist)) (insert "access ")) (setq column (current-column)) ;; ;; insert type-name and, if necessary, space and default-expression ;; (insert (nth 4 (nth i paramlist))) (if (nth 5 (nth i paramlist)) (progn (indent-to (+ column typlen 1)) (insert (nth 5 (nth i paramlist))))) ;; ;; check if it was the last parameter ;; (if (not (zerop i)) ;; no => insert ';' and newline and indent (progn (insert ";") (newline) (indent-to firstcol)) ;; yes (insert ")")) ) ; end of loop ;; ;; if anything follows, except semicolon: ;; put it in a new line and indent it ;; (if (not (looking-at "[ \t]*[;\n]")) (ada-indent-newline-indent)) )) ;;;----------------------------;;; ;;; Move To Matching Start/End ;;; ;;;----------------------------;;; (defun ada-move-to-start () "Moves point to the matching start of the current Ada structure." (interactive) (let ((pos (point))) (unwind-protect (progn (set-syntax-table ada-mode-symbol-syntax-table) (message "searching for block start ...") (save-excursion ;; ;; do nothing if in string or comment or not on 'end ...;' ;; or if an error occurs during processing ;; (or (ada-in-string-or-comment-p) (and (progn (or (looking-at "[ \t]*\\") (backward-word 1)) (or (looking-at "[ \t]*\\") (backward-word 1)) (or (looking-at "[ \t]*\\") (error "not on end ...;"))) (ada-goto-matching-start 1) (setq pos (point)) ;; ;; on 'begin' => go on, according to user option ;; ada-move-to-declaration (looking-at "\\") (ada-goto-matching-decl-start) (setq pos (point)))) ) ; end of save-excursion ;; now really move to the found position (goto-char pos) (message "searching for block start ... done")) ;; ;; restore syntax-table ;; (set-syntax-table ada-mode-syntax-table)))) (defun ada-move-to-end () "Moves point to the matching end of the current block around point. Moves to 'begin' if in a declarative part." (interactive) (let ((pos (point)) (decstart nil) (packdecl nil)) (unwind-protect (progn (set-syntax-table ada-mode-symbol-syntax-table) (message "searching for block end ...") (save-excursion (forward-char 1) (cond ;; directly on 'begin' ((save-excursion (ada-goto-previous-word) (looking-at "\\")) (ada-goto-matching-end 1)) ;; on first line of defun declaration ((save-excursion (and (ada-goto-stmt-start) (looking-at "\\\\|\\" ))) (ada-search-ignore-string-comment "\\")) ;; on first line of task declaration ((save-excursion (and (ada-goto-stmt-start) (looking-at "\\" ) (forward-word 1) (ada-search-ignore-string-comment "[^ \n\t]") (not (backward-char 1)) (looking-at "\\"))) (ada-search-ignore-string-comment "\\")) ;; accept block start ((save-excursion (and (ada-goto-stmt-start) (looking-at "\\" ))) (ada-goto-matching-end 0)) ;; package start ((save-excursion (and (ada-goto-matching-decl-start t) (looking-at "\\"))) (ada-goto-matching-end 1)) ;; inside a 'begin' ... 'end' block ((save-excursion (ada-goto-matching-decl-start t)) (ada-search-ignore-string-comment "\\")) ;; (hopefully ;-) everything else (t (ada-goto-matching-end 1))) (setq pos (point)) ) ; end of save-excursion ;; now really move to the found position (goto-char pos) (message "searching for block end ... done")) ;; ;; restore syntax-table ;; (set-syntax-table ada-mode-syntax-table)))) ;;;-----------------------------;;; ;;; Functions For Indentation ;;; ;;;-----------------------------;;; ;; ---- main functions for indentation (defun ada-indent-region (beg end) "Indents the region using `ada-indent-current' on each line." (interactive "*r") (goto-char beg) (let ((block-done 0) (lines-remaining (count-lines beg end)) (msg (format "indenting %4d lines %%4d lines remaining ..." (count-lines beg end))) (endmark (copy-marker end))) ;; catch errors while indenting (condition-case err (while (< (point) endmark) (if (> block-done 9) (progn (message (format msg lines-remaining)) (setq block-done 0))) (if (looking-at "^$") nil (ada-indent-current)) (forward-line 1) (setq block-done (1+ block-done)) (setq lines-remaining (1- lines-remaining))) ;; show line number where the error occured (error (error (format "line %d: %s" (1+ (count-lines (point-min) (point))) err) nil))) (message "indenting ... done"))) (defun ada-indent-newline-indent () "Indents the current line, inserts a newline and then indents the new line." (interactive "*") (let ((column) (orgpoint)) (ada-indent-current) (newline) (delete-horizontal-space) (setq orgpoint (point)) (unwind-protect (progn (set-syntax-table ada-mode-symbol-syntax-table) (setq column (save-excursion (funcall (ada-indent-function) orgpoint)))) ;; ;; restore syntax-table ;; (set-syntax-table ada-mode-syntax-table)) (indent-to column) ;; The following is needed to ensure that indentation will still be ;; correct if something follows behind point when typing LFD ;; For example: Imagine point to be there (*) when LFD is typed: ;; while cond loop ;; null; *end loop; ;; Result without the following statement would be: ;; while cond loop ;; null; ;; *end loop; ;; You would then have to type TAB to correct it. ;; If that doesn't bother you, you can comment out the following ;; statement to speed up indentation a LITTLE bit. (if (not (looking-at "[ \t]*$")) (ada-indent-current)) )) (defun ada-indent-current () "Indents current line as Ada code. This works by two steps: 1) It moves point to the end of the previous code line. Then it calls the function to calculate the indentation for the following line as if a newline would be inserted there. The calculated column # is saved and the old position of point is restored. 2) Then another function is called to calculate the indentation for the current line, based on the previously calculated column #." (interactive) (unwind-protect (progn (set-syntax-table ada-mode-symbol-syntax-table) (let ((line-end) (orgpoint (point-marker)) (cur-indent) (prev-indent) (prevline t)) ;; ;; first step ;; (save-excursion (if (ada-goto-prev-nonblank-line t) ;; ;; we are not in the first accessible line in the buffer ;; (progn ;;(end-of-line) ;;(forward-char 1) ;; we are already at the BOL (forward-line 1) (setq line-end (point)) (setq prev-indent (save-excursion (funcall (ada-indent-function) line-end)))) (progn ; first line of buffer -> set indent (beginning-of-line) ; to 0 (delete-horizontal-space) (setq prevline nil)))) (if prevline ;; ;; we are not in the first accessible line in the buffer ;; (progn ;; ;; second step ;; (back-to-indentation) (setq cur-indent (ada-get-current-indent prev-indent)) ;; only reindent if indentation is different then the current (if (= (current-column) cur-indent) nil (delete-horizontal-space) (indent-to cur-indent)) ;; ;; restore position of point ;; (goto-char orgpoint) (if (< (current-column) (current-indentation)) (back-to-indentation)))))) ;; ;; restore syntax-table ;; (set-syntax-table ada-mode-syntax-table))) (defun ada-get-current-indent (prev-indent) ;; Returns the column # to indent the current line to. ;; PREV-INDENT is the indentation resulting from the previous lines. (let ((column nil) (pos nil) (match-cons nil)) (cond ;; ;; in open parenthesis, but not in parameter-list ;; ((and ada-indent-to-open-paren (not (ada-in-paramlist-p)) (setq column (ada-in-open-paren-p))) ;; check if we have something like this (Table_Component_Type => ;; Source_File_Record,) (save-excursion (if (and (ada-search-ignore-string-comment "[^ \t]" t nil) (looking-at "\n") (ada-search-ignore-string-comment "[^ \t\n]" t nil) (looking-at ">")) (setq column (+ ada-broken-indent column)))) column) ;; ;; end ;; ((looking-at "\\") (save-excursion (ada-goto-matching-start 1) ;; ;; found 'loop' => skip back to 'while' or 'for' ;; if 'loop' is not on a separate line ;; (if (and (looking-at "\\") (save-excursion (back-to-indentation) (not (looking-at "\\")))) (if (save-excursion (and (setq match-cons (ada-search-ignore-string-comment ada-loop-start-re t nil)) (not (looking-at "\\")))) (goto-char (car match-cons)))) (current-indentation))) ;; ;; exception ;; ((looking-at "\\") (save-excursion (ada-goto-matching-start 1) (current-indentation))) ;; ;; when ;; ((looking-at "\\") (save-excursion (ada-goto-matching-start 1) (+ (current-indentation) ada-when-indent))) ;; ;; else ;; ((looking-at "\\") (if (save-excursion (ada-goto-previous-word) (looking-at "\\")) prev-indent (save-excursion (ada-goto-matching-start 1 nil t) (current-indentation)))) ;; ;; elsif ;; ((looking-at "\\") (save-excursion (ada-goto-matching-start 1 nil t) (current-indentation))) ;; ;; then ;; ((looking-at "\\") (if (save-excursion (ada-goto-previous-word) (looking-at "\\")) prev-indent (save-excursion (ada-search-ignore-string-comment "\\\\|\\" t nil) (+ (current-indentation) ada-stmt-end-indent)))) ;; ;; loop ;; ((looking-at "\\") (setq pos (point)) (save-excursion (goto-char (match-end 0)) (ada-goto-stmt-start) (if (looking-at "\\\\|\\") prev-indent (progn (if (not (looking-at ada-loop-start-re)) (ada-search-ignore-string-comment ada-loop-start-re nil pos)) (if (looking-at "\\") prev-indent (+ (current-indentation) ada-stmt-end-indent)))))) ;; ;; begin ;; ((looking-at "\\") (save-excursion (if (ada-goto-matching-decl-start t) (current-indentation) (progn (message "no matching declaration start") prev-indent)))) ;; ;; is ;; ((looking-at "\\") (if (and ada-indent-is-separate (save-excursion (goto-char (match-end 0)) (ada-goto-next-non-ws (save-excursion (end-of-line) (point))) (looking-at "\\\\|\\"))) (save-excursion (ada-goto-stmt-start) (+ (current-indentation) ada-indent)) (save-excursion (ada-goto-stmt-start) (+ (current-indentation) ada-stmt-end-indent)))) ;; ;; record ;; ((looking-at "\\") (save-excursion (ada-search-ignore-string-comment "\\<\\(type\\|use\\)\\>" t nil) (if (looking-at "\\") (ada-search-ignore-string-comment "\\" t nil)) (+ (current-indentation) ada-indent-record-rel-type))) ;; ;; or as statement-start ;; ((ada-looking-at-semi-or) (save-excursion (ada-goto-matching-start 1) (current-indentation))) ;; ;; private as statement-start ;; ((ada-looking-at-semi-private) (save-excursion (ada-goto-matching-decl-start) (current-indentation))) ;; ;; new/abstract/separate ;; ((looking-at "\\<\\(new\\|abstract\\|separate\\)\\>") (- prev-indent ada-indent (- ada-broken-indent))) ;; ;; return ;; ((looking-at "\\") (save-excursion (forward-sexp -1) (if (and (looking-at "(") (save-excursion (backward-sexp 2) (looking-at "\\"))) (1+ (current-column)) prev-indent))) ;; ;; do ;; ((looking-at "\\") (save-excursion (ada-goto-stmt-start) (+ (current-indentation) ada-stmt-end-indent))) ;; ;; package/function/procedure ;; ((and (looking-at "\\<\\(package\\|function\\|procedure\\)\\>") (save-excursion (forward-char 1) (ada-goto-stmt-start) (looking-at "\\<\\(package\\|function\\|procedure\\)\\>"))) (save-excursion ;; look for 'generic' (if (and (ada-goto-matching-decl-start t) (looking-at "generic")) (current-column) prev-indent))) ;; ;; label ;; ((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*:[^=]") (if (ada-in-decl-p) prev-indent (+ prev-indent ada-label-indent))) ;; ;; identifier and other noindent-statements ;; ((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*") prev-indent) ;; ;; beginning of a parameter list ;; ((looking-at "(") prev-indent) ;; ;; end of a parameter list ;; ((looking-at ")") (save-excursion (forward-char 1) (backward-sexp 1) (current-column))) ;; ;; comment ;; ((looking-at "--") (if ada-indent-comment-as-code prev-indent (current-indentation))) ;; ;; unknown syntax - maybe this should signal an error ? ;; (t prev-indent)))) (defun ada-indent-function (&optional nomove) ;; Returns the function to calculate the indentation for the current ;; line according to the previous statement, ignoring the contents ;; of the current line after point. Moves point to the beginning of ;; the current statement, if NOMOVE is nil. (let ((orgpoint (point)) (func nil) (stmt-start nil)) ;; ;; inside a parameter-list ;; (if (ada-in-paramlist-p) (setq func 'ada-get-indent-paramlist) (progn ;; ;; move to beginning of current statement ;; (if (not nomove) (setq stmt-start (ada-goto-stmt-start))) ;; ;; no beginning found => don't change indentation ;; (if (and (eq orgpoint (point)) (not nomove)) (setq func 'ada-get-indent-nochange) (cond ;; ((and ada-indent-to-open-paren (ada-in-open-paren-p)) (setq func 'ada-get-indent-open-paren)) ;; ((looking-at "\\") (setq func 'ada-get-indent-end)) ;; ((looking-at ada-loop-start-re) (setq func 'ada-get-indent-loop)) ;; ((looking-at ada-subprog-start-re) (setq func 'ada-get-indent-subprog)) ;; ((looking-at "\\") (setq func 'ada-get-indent-subprog)) ; maybe it needs a ; special function ; sometimes ? ;; ((looking-at ada-block-start-re) (setq func 'ada-get-indent-block-start)) ;; ((looking-at "\\") (setq func 'ada-get-indent-type)) ;; ((looking-at "\\<\\(els\\)?if\\>") (setq func 'ada-get-indent-if)) ;; ((looking-at "\\") (setq func 'ada-get-indent-case)) ;; ((looking-at "\\") (setq func 'ada-get-indent-when)) ;; ((looking-at "--") (setq func 'ada-get-indent-comment)) ;; ((looking-at "[a-zA-Z0-9_]+[ \t\n]*:[^=]") (setq func 'ada-get-indent-label)) ;; ((looking-at "\\") (setq func 'ada-get-indent-nochange)) (t (setq func 'ada-get-indent-noindent)))))) func)) ;; ---- functions to return indentation for special cases (defun ada-get-indent-open-paren (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. ;; Assumes point to be behind an open paranthesis not yet closed. (ada-in-open-paren-p)) (defun ada-get-indent-nochange (orgpoint) ;; Returns the indentation (column #) of the current line. (save-excursion (forward-line -1) (current-indentation))) (defun ada-get-indent-paramlist (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. ;; Assumes point to be inside a parameter-list. (save-excursion (ada-search-ignore-string-comment "[^ \t\n]" t nil t) (cond ;; ;; in front of the first parameter ;; ((looking-at "(") (goto-char (match-end 0)) (current-column)) ;; ;; in front of another parameter ;; ((looking-at ";") (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t))) (ada-goto-next-non-ws) (current-column)) ;; ;; inside a parameter declaration ;; (t (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t))) (ada-goto-next-non-ws) (+ (current-column) ada-broken-indent))))) (defun ada-get-indent-end (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. ;; Assumes point to be at the beginning of an end-statement. ;; Therefore it has to find the corresponding start. This can be a little ;; slow, if it has to search through big files with many nested blocks. ;; Signals an error if the corresponding block-start doesn't match. (let ((defun-name nil) (indent nil)) ;; ;; is the line already terminated by ';' ? ;; (if (save-excursion (ada-search-ignore-string-comment ";" nil orgpoint)) ;; ;; yes, look what's following 'end' ;; (progn (forward-word 1) (ada-goto-next-non-ws) (cond ;; ;; loop/select/if/case/record/select ;; ((looking-at "\\<\\(loop\\|select\\|if\\|case\\|record\\)\\>") (save-excursion (ada-check-matching-start (buffer-substring (match-beginning 0) (match-end 0))) (if (looking-at "\\<\\(loop\\|record\\)\\>") (progn (forward-word 1) (ada-goto-stmt-start))) ;; a label ? => skip it (if (looking-at "[a-zA-Z0-9_]+[ \n\t]+:") (progn (goto-char (match-end 0)) (ada-goto-next-non-ws))) ;; really looking-at the right thing ? (or (looking-at (concat "\\<\\(" "loop\\|select\\|if\\|case\\|" "record\\|while\\|type\\)\\>")) (progn (ada-search-ignore-string-comment (concat "\\<\\(" "loop\\|select\\|if\\|case\\|" "record\\|while\\|type\\)\\>"))) (backward-word 1)) (current-indentation))) ;; ;; a named block end ;; ((looking-at ada-ident-re) (setq defun-name (buffer-substring (match-beginning 0) (match-end 0))) (save-excursion (ada-goto-matching-start 0) (ada-check-defun-name defun-name) (current-indentation))) ;; ;; a block-end without name ;; ((looking-at ";") (save-excursion (ada-goto-matching-start 0) (if (looking-at "\\") (progn (setq indent (current-column)) (if (ada-goto-matching-decl-start t) (current-indentation) indent))))) ;; ;; anything else - should maybe signal an error ? ;; (t (+ (current-indentation) ada-broken-indent)))) (+ (current-indentation) ada-broken-indent)))) (defun ada-get-indent-case (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. ;; Assumes point to be at the beginning of an case-statement. (let ((cur-indent (current-indentation)) (match-cons nil) (opos (point))) (cond ;; ;; case..is..when..=> ;; ((save-excursion (setq match-cons (ada-search-ignore-string-comment "[ \t\n]+=>" nil orgpoint))) (save-excursion (goto-char (car match-cons)) (if (not (ada-search-ignore-string-comment "\\" t opos)) (error "missing 'when' between 'case' and '=>'")) (+ (current-indentation) ada-indent))) ;; ;; case..is..when ;; ((save-excursion (setq match-cons (ada-search-ignore-string-comment "\\" nil orgpoint))) (goto-char (cdr match-cons)) (+ (current-indentation) ada-broken-indent)) ;; ;; case..is ;; ((save-excursion (setq match-cons (ada-search-ignore-string-comment "\\" nil orgpoint))) (+ (current-indentation) ada-when-indent)) ;; ;; incomplete case ;; (t (+ (current-indentation) ada-broken-indent))))) (defun ada-get-indent-when (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. ;; Assumes point to be at the beginning of an when-statement. (let ((cur-indent (current-indentation))) (if (ada-search-ignore-string-comment "[ \t\n]+=>" nil orgpoint) (+ cur-indent ada-indent) (+ cur-indent ada-broken-indent)))) (defun ada-get-indent-if (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. ;; Assumes point to be at the beginning of an if-statement. (let ((cur-indent (current-indentation)) (match-cons nil)) ;; ;; if..then ? ;; (if (ada-search-but-not "\\" "\\[ \t\n]+\\" nil orgpoint) (progn ;; ;; 'then' first in separate line ? ;; => indent according to 'then' ;; (if (save-excursion (back-to-indentation) (looking-at "\\")) (setq cur-indent (current-indentation))) (forward-word 1) ;; ;; something follows 'then' ? ;; (if (setq match-cons (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)) (progn (goto-char (car match-cons)) (+ ada-indent (- cur-indent (current-indentation)) (funcall (ada-indent-function t) orgpoint))) (+ cur-indent ada-indent))) (+ cur-indent ada-broken-indent)))) (defun ada-get-indent-block-start (orgpoint) ;; Returns the indentation (column #) for the new line after ;; ORGPOINT. Assumes point to be at the beginning of a block start ;; keyword. (let ((cur-indent (current-indentation)) (pos nil)) (cond ((save-excursion (forward-word 1) (setq pos (car (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)))) (goto-char pos) (save-excursion (funcall (ada-indent-function t) orgpoint))) ;; ;; nothing follows the block-start ;; (t (+ (current-indentation) ada-indent))))) (defun ada-get-indent-subprog (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. ;; Assumes point to be at the beginning of a subprog-/package-declaration. (let ((match-cons nil) (cur-indent (current-indentation)) (foundis nil) (addind 0) (fstart (point))) ;; ;; is there an 'is' in front of point ? ;; (if (save-excursion (setq match-cons (ada-search-ignore-string-comment "\\\\|\\" nil orgpoint))) ;; ;; yes, then skip to its end ;; (progn (setq foundis t) (goto-char (cdr match-cons))) ;; ;; no, then goto next non-ws, if there is one in front of point ;; (progn (if (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint) (ada-goto-next-non-ws) (goto-char orgpoint)))) (cond ;; ;; nothing follows 'is' ;; ((and foundis (save-excursion (not (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint t)))) (+ cur-indent ada-indent)) ;; ;; is abstract/separate/new ... ;; ((and foundis (save-excursion (setq match-cons (ada-search-ignore-string-comment "\\<\\(separate\\|new\\|abstract\\)\\>" nil orgpoint)))) (goto-char (car match-cons)) (ada-search-ignore-string-comment ada-subprog-start-re t) (ada-get-indent-noindent orgpoint)) ;; ;; something follows 'is' ;; ((and foundis (save-excursion (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)) (ada-goto-next-non-ws) (funcall (ada-indent-function t) orgpoint))) ;; ;; no 'is' but ';' ;; ((save-excursion (ada-search-ignore-string-comment ";" nil orgpoint)) cur-indent) ;; ;; no 'is' or ';' ;; (t (+ cur-indent ada-broken-indent))))) (defun ada-get-indent-noindent (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. ;; Assumes point to be at the beginning of a 'noindent statement'. (if (save-excursion (ada-search-ignore-string-comment ";" nil orgpoint)) (current-indentation) (+ (current-indentation) ada-broken-indent))) (defun ada-get-indent-label (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. ;; Assumes point to be at the beginning of a label or variable declaration. ;; Checks the context to decide if it's a label or a variable declaration. ;; This check might be a bit slow. (let ((match-cons nil) (cur-indent (current-indentation))) (goto-char (cdr (ada-search-ignore-string-comment ":"))) (cond ;; ;; loop label ;; ((save-excursion (setq match-cons (ada-search-ignore-string-comment ada-loop-start-re nil orgpoint))) (goto-char (car match-cons)) (ada-get-indent-loop orgpoint)) ;; ;; declare label ;; ((save-excursion (setq match-cons (ada-search-ignore-string-comment "\\" nil orgpoint))) (save-excursion (goto-char (car match-cons)) (+ (current-indentation) ada-indent))) ;; ;; complete statement following colon ;; ((save-excursion (ada-search-ignore-string-comment ";" nil orgpoint)) (if (ada-in-decl-p) cur-indent ; variable-declaration (- cur-indent ada-label-indent))) ; label ;; ;; broken statement ;; ((save-excursion (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)) (if (ada-in-decl-p) (+ cur-indent ada-broken-indent) (+ cur-indent ada-broken-indent (- ada-label-indent)))) ;; ;; nothing follows colon ;; (t (if (ada-in-decl-p) (+ cur-indent ada-broken-indent) ; variable-declaration (- cur-indent ada-label-indent)))))) ; label (defun ada-get-indent-loop (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. ;; Assumes point to be at the beginning of a loop statement ;; or (unfortunately) also a for ... use statement. (let ((match-cons nil) (pos (point))) (cond ;; ;; statement complete ;; ((save-excursion (ada-search-ignore-string-comment ";" nil orgpoint)) (current-indentation)) ;; ;; simple loop ;; ((looking-at "loop\\>") (ada-get-indent-block-start orgpoint)) ;; ;; 'for'- loop (or also a for ... use statement) ;; ((looking-at "for\\>") (cond ;; ;; for ... use ;; ((save-excursion (and (goto-char (match-end 0)) (ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint) (not (backward-char 1)) (not (zerop (skip-chars-forward "_a-zA-Z0-9'"))) (ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint) (not (backward-char 1)) (looking-at "\\") ;; ;; check if there is a 'record' before point ;; (progn (setq match-cons (ada-search-ignore-string-comment "\\" nil orgpoint)) t))) (if match-cons (goto-char (car match-cons))) (+ (current-indentation) ada-indent)) ;; ;; for..loop ;; ((save-excursion (setq match-cons (ada-search-ignore-string-comment "\\" nil orgpoint))) (goto-char (car match-cons)) ;; ;; indent according to 'loop', if it's first in the line; ;; otherwise to 'for' ;; (if (not (save-excursion (back-to-indentation) (looking-at "\\"))) (goto-char pos)) (+ (current-indentation) ada-indent)) ;; ;; for-statement is broken ;; (t (+ (current-indentation) ada-broken-indent)))) ;; ;; 'while'-loop ;; ((looking-at "while\\>") ;; ;; while..loop ? ;; (if (save-excursion (setq match-cons (ada-search-ignore-string-comment "\\" nil orgpoint))) (progn (goto-char (car match-cons)) ;; ;; indent according to 'loop', if it's first in the line; ;; otherwise to 'while'. ;; (if (not (save-excursion (back-to-indentation) (looking-at "\\"))) (goto-char pos)) (+ (current-indentation) ada-indent)) (+ (current-indentation) ada-broken-indent)))))) (defun ada-get-indent-type (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. ;; Assumes point to be at the beginning of a type statement. (let ((match-dat nil)) (cond ;; ;; complete record declaration ;; ((save-excursion (and (setq match-dat (ada-search-ignore-string-comment "\\" nil orgpoint)) (ada-goto-next-non-ws) (looking-at "\\") (forward-word 1) (ada-goto-next-non-ws) (looking-at ";"))) (goto-char (car match-dat)) (current-indentation)) ;; ;; record type ;; ((save-excursion (setq match-dat (ada-search-ignore-string-comment "\\" nil orgpoint))) (goto-char (car match-dat)) (+ (current-indentation) ada-indent)) ;; ;; complete type declaration ;; ((save-excursion (ada-search-ignore-string-comment ";" nil orgpoint)) (current-indentation)) ;; ;; "type ... is", but not "type ... is ...", which is broken ;; ((save-excursion (and (ada-search-ignore-string-comment "\\" nil orgpoint) (not (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)))) (+ (current-indentation) ada-indent)) ;; ;; broken statement ;; (t (+ (current-indentation) ada-broken-indent))))) ;;; ---- support-functions for indentation ;;; ---- searching and matching (defun ada-goto-stmt-start (&optional limit) ;; Moves point to the beginning of the statement that point is in or ;; after. Returns the new position of point. Beginnings are found ;; by searching for 'ada-end-stmt-re' and then moving to the ;; following non-ws that is not a comment. LIMIT is actually not ;; used by the indentation functions. (let ((match-dat nil) (orgpoint (point))) (setq match-dat (ada-search-prev-end-stmt limit)) (if match-dat ;; ;; found a previous end-statement => check if anything follows ;; (progn (if (not (save-excursion (goto-char (cdr match-dat)) (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))) ;; ;; nothing follows => it's the end-statement directly in ;; front of point => search again ;; (setq match-dat (ada-search-prev-end-stmt limit))) ;; ;; if found the correct end-stetement => goto next non-ws ;; (if match-dat (goto-char (cdr match-dat))) (ada-goto-next-non-ws)) ;; ;; no previous end-statement => we are at the beginning of the ;; accessible part of the buffer ;; (progn (goto-char (point-min)) ;; ;; skip to the very first statement, if there is one ;; (if (setq match-dat (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)) (goto-char (car match-dat)) (goto-char orgpoint)))) (point))) (defun ada-search-prev-end-stmt (&optional limit) ;; Moves point to previous end-statement. Returns a cons cell whose ;; car is the beginning and whose cdr the end of the match. ;; End-statements are defined by 'ada-end-stmt-re'. Checks for ;; certain keywords if they follow 'end', which means they are no ;; end-statement there. (interactive) ;; DEBUG (let ((match-dat nil) (pos nil) (found nil)) ;; ;; search until found or beginning-of-buffer ;; (while (and (not found) (setq match-dat (ada-search-ignore-string-comment ada-end-stmt-re t limit))) (goto-char (car match-dat)) (if (not (ada-in-open-paren-p)) ;; ;; check if there is an 'end' in front of the match ;; (if (not (and (looking-at "\\<\\(record\\|loop\\|select\\)\\>") (save-excursion (ada-goto-previous-word) (looking-at "\\")))) (setq found t) (forward-word -1)))) ; end of loop (if found match-dat nil))) (defun ada-goto-next-non-ws (&optional limit) ;; Skips whitespaces, newlines and comments to next non-ws ;; character. Signals an error if there is no more such character ;; and limit is nil. (let ((match-cons nil)) (setq match-cons (ada-search-ignore-string-comment "[^ \t\n]" nil limit t)) (if match-cons (goto-char (car match-cons)) (if (not limit) (error "no more non-ws") nil)))) (defun ada-goto-stmt-end (&optional limit) ;; Moves point to the end of the statement that point is in or ;; before. Returns the new position of point or nil if not found. (if (ada-search-ignore-string-comment ada-end-stmt-re nil limit) (point) nil)) (defun ada-goto-previous-word () ;; Moves point to the beginning of the previous word of Ada code. ;; Returns the new position of point or nil if not found. (let ((match-cons nil) (orgpoint (point))) (if (setq match-cons (ada-search-ignore-string-comment "[^ \t\n]" t nil t)) ;; ;; move to the beginning of the word found ;; (progn (goto-char (cdr match-cons)) (skip-chars-backward "_a-zA-Z0-9") (point)) ;; ;; if not found, restore old position of point ;; (progn (goto-char orgpoint) 'nil)))) (defun ada-check-matching-start (keyword) ;; Signals an error if matching block start is not KEYWORD. ;; Moves point to the matching block start. (ada-goto-matching-start 0) (if (not (looking-at (concat "\\<" keyword "\\>"))) (error (concat "matching start is not '" keyword "'")))) (defun ada-check-defun-name (defun-name) ;; Checks if the name of the matching defun really is DEFUN-NAME. ;; Assumes point to be already positioned by 'ada-goto-matching-start'. ;; Moves point to the beginning of the declaration. ;; ;; 'accept' or 'package' ? ;; (if (not (looking-at "\\<\\(accept\\|package\\|task\\|protected\\)\\>")) (ada-goto-matching-decl-start)) ;; ;; 'begin' of 'procedure'/'function'/'task' or 'declare' ;; (save-excursion ;; ;; a named 'declare'-block ? ;; (if (looking-at "\\") (ada-goto-stmt-start) ;; ;; no, => 'procedure'/'function'/'task'/'protected' ;; (progn (forward-word 2) (backward-word 1) ;; ;; skip 'body' 'protected' 'type' ;; (if (looking-at "\\<\\(body\\|type\\)\\>") (forward-word 1)) (forward-sexp 1) (backward-sexp 1))) ;; ;; should be looking-at the correct name ;; (if (not (looking-at (concat "\\<" defun-name "\\>"))) (error (concat "matching defun has different name: " (buffer-substring (point) (progn (forward-sexp 1) (point)))))))) (defun ada-goto-matching-decl-start (&optional noerror nogeneric) ;; Moves point to the matching declaration start of the current 'begin'. ;; If NOERROR is non-nil, it only returns nil if no match was found. (interactive) ;; DEBUG (let ((nest-count 1) (pos nil) (first t) (flag nil)) ;; ;; search backward for interesting keywords ;; (while (and (not (zerop nest-count)) (ada-search-ignore-string-comment (concat "\\<\\(" "is\\|separate\\|end\\|declare\\|new\\|begin\\|generic" "\\)\\>") t)) ;; ;; calculate nest-depth ;; (cond ;; ((looking-at "end") (ada-goto-matching-start 1 noerror) (if (looking-at "begin") (setq nest-count (1+ nest-count)))) ;; ((looking-at "declare\\|generic") (setq nest-count (1- nest-count)) (setq first nil)) ;; ((looking-at "is") ;; check if it is only a type definition, but not a protected ;; type definition, which should be handled like a procedure. (if (save-excursion (ada-goto-previous-word) (skip-chars-backward "a-zA-Z0-9_.'") (if (save-excursion (backward-char 1) (looking-at ")")) (progn (forward-char 1) (backward-sexp 1) (skip-chars-backward "a-zA-Z0-9_.'") )) (ada-goto-previous-word) (and (looking-at "\\") (save-match-data (ada-goto-previous-word) (not (looking-at "\\")))) ); end of save-excursion (goto-char (match-beginning 0)) (progn (setq nest-count (1- nest-count)) (setq first nil)))) ;; ((looking-at "new") (if (save-excursion (ada-goto-previous-word) (looking-at "is")) (goto-char (match-beginning 0)))) ;; ((and first (looking-at "begin")) (setq nest-count 0) (setq flag t)) ;; (t (setq nest-count (1+ nest-count)) (setq first nil))) ) ;; end of loop ;; check if declaration-start is really found (if (not (and (zerop nest-count) (not flag) (progn (if (looking-at "is") (ada-search-ignore-string-comment ada-subprog-start-re t) (looking-at "declare\\|generic"))))) (if noerror nil (error "no matching proc/func/task/declare/package/protected")) t))) (defun ada-goto-matching-start (&optional nest-level noerror gotothen) ;; Moves point to the beginning of a block-start. Which block ;; depends on the value of NEST-LEVEL, which defaults to zero. If ;; NOERROR is non-nil, it only returns nil if no matching start was ;; found. If GOTOTHEN is non-nil, point moves to the 'then' ;; following 'if'. (let ((nest-count (if nest-level nest-level 0)) (found nil) (pos nil)) ;; ;; search backward for interesting keywords ;; (while (and (not found) (ada-search-ignore-string-comment (concat "\\<\\(" "end\\|loop\\|select\\|begin\\|case\\|do\\|" "if\\|task\\|package\\|record\\|protected\\)\\>") t)) ;; ;; calculate nest-depth ;; (cond ;; found block end => increase nest depth ((looking-at "end") (setq nest-count (1+ nest-count))) ;; found loop/select/record/case/if => check if it starts or ;; ends a block ((looking-at "loop\\|select\\|record\\|case\\|if") (setq pos (point)) (save-excursion ;; ;; check if keyword follows 'end' ;; (ada-goto-previous-word) (if (looking-at "\\") ;; it ends a block => increase nest depth (progn (setq nest-count (1+ nest-count)) (setq pos (point))) ;; it starts a block => decrease nest depth (setq nest-count (1- nest-count)))) (goto-char pos)) ;; found package start => check if it really is a block ((looking-at "package") (save-excursion (ada-search-ignore-string-comment "\\") (ada-goto-next-non-ws) ;; ignore it if it is only a declaration with 'new' (if (not (looking-at "\\")) (setq nest-count (1- nest-count))))) ;; found task start => check if it has a body ((looking-at "task") (save-excursion (forward-word 1) (ada-goto-next-non-ws) ;; ignore it if it has no body (if (not (looking-at "\\")) (setq nest-count (1- nest-count))))) ;; all the other block starts (t (setq nest-count (1- nest-count)))) ; end of 'cond' ;; match is found, if nest-depth is zero ;; (setq found (zerop nest-count))) ; end of loop (if found ;; ;; match found => is there anything else to do ? ;; (progn (cond ;; ;; found 'if' => skip to 'then', if it's on a separate line ;; and GOTOTHEN is non-nil ;; ((and gotothen (looking-at "if") (save-excursion (ada-search-ignore-string-comment "\\" nil nil) (back-to-indentation) (looking-at "\\"))) (goto-char (match-beginning 0))) ;; ;; found 'do' => skip back to 'accept' ;; ((looking-at "do") (if (not (ada-search-ignore-string-comment "\\" t nil)) (error "missing 'accept' in front of 'do'")))) (point)) (if noerror nil (error "no matching start"))))) (defun ada-goto-matching-end (&optional nest-level noerror) ;; Moves point to the end of a block. Which block depends on the ;; value of NEST-LEVEL, which defaults to zero. If NOERROR is ;; non-nil, it only returns nil if found no matching start. (let ((nest-count (if nest-level nest-level 0)) (found nil)) ;; ;; search forward for interesting keywords ;; (while (and (not found) (ada-search-ignore-string-comment (concat "\\<\\(end\\|loop\\|select\\|begin\\|case\\|" "if\\|task\\|package\\|record\\|do\\)\\>"))) ;; ;; calculate nest-depth ;; (backward-word 1) (cond ;; found block end => decrease nest depth ((looking-at "\\") (setq nest-count (1- nest-count)) ;; skip the following keyword (if (progn (skip-chars-forward "end") (ada-goto-next-non-ws) (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>")) (forward-word 1))) ;; found package start => check if it really starts a block ((looking-at "\\") (ada-search-ignore-string-comment "\\") (ada-goto-next-non-ws) ;; ignore and skip it if it is only a 'new' package (if (not (looking-at "\\")) (setq nest-count (1+ nest-count)) (skip-chars-forward "new"))) ;; all the other block starts (t (setq nest-count (1+ nest-count)) (forward-word 1))) ; end of 'cond' ;; match is found, if nest-depth is zero ;; (setq found (zerop nest-count))) ; end of loop (if (not found) (if noerror nil (error "no matching end")) t))) (defun ada-forward-sexp-ignore-comment () ;; Skips one sexp forward, ignoring comments. (while (looking-at "[ \t\n]*--") (skip-chars-forward "[ \t\n]") (end-of-line)) (forward-sexp 1)) (defun ada-search-ignore-string-comment (search-re &optional backward limit paramlists) ;; Regexp-Search for SEARCH-RE, ignoring comments, strings and ;; parameter lists, if PARAMLISTS is nil. Returns a cons cell of ;; begin and end of match data or nil, if not found. (let ((found nil) (begin nil) (end nil) (pos nil) (search-func (if backward 're-search-backward 're-search-forward))) ;; ;; search until found or end-of-buffer ;; (while (and (not found) (funcall search-func search-re limit 1)) (setq begin (match-beginning 0)) (setq end (match-end 0)) (cond ;; ;; found in comment => skip it ;; ((ada-in-comment-p) (if backward (progn (re-search-backward "--" nil 1) (goto-char (match-beginning 0))) (progn (forward-line 1) (beginning-of-line)))) ;; ;; found in string => skip it ;; ((ada-in-string-p) (if backward (progn (re-search-backward "\"" nil 1) ; "\"\\|#" don't treat # (goto-char (match-beginning 0)))) (re-search-forward "\"" nil 1)) ;; ;; found character constant => ignore it ;; ((save-excursion (setq pos (- (point) (if backward 1 2))) (and (char-after pos) (= (char-after pos) ?') (= (char-after (+ pos 2)) ?'))) ()) ;; ;; found a parameter-list but should ignore it => skip it ;; ((and (not paramlists) (ada-in-paramlist-p)) (if backward (ada-search-ignore-string-comment "(" t nil t))) ;; ;; directly in front of a comment => skip it, if searching forward ;; ((save-excursion (goto-char begin) (looking-at "--")) (if (not backward) (progn (forward-line 1) (beginning-of-line)))) ;; ;; found what we were looking for ;; (t (setq found t)))) ; end of loop (if found (cons begin end) nil))) (defun ada-search-but-not (search-re not-search-re &optional backward limit) ;; Searches SEARCH-RE, ignoring parts of NOT-SEARCH-RE, strings, ;; comments and parameter-lists. (let ((begin nil) (end nil) (begin-not nil) (begin-end nil) (end-not nil) (ret-cons nil) (found nil)) ;; ;; search until found or end-of-buffer ;; (while (and (not found) (save-excursion (setq ret-cons (ada-search-ignore-string-comment search-re backward limit)) (if (consp ret-cons) (progn (setq begin (car ret-cons)) (setq end (cdr ret-cons)) t) nil))) (if (or ;; ;; if no NO-SEARCH-RE was found ;; (not (save-excursion (setq ret-cons (ada-search-ignore-string-comment not-search-re backward nil)) (if (consp ret-cons) (progn (setq begin-not (car ret-cons)) (setq end-not (cdr ret-cons)) t) nil))) ;; ;; or this NO-SEARCH-RE is not a part of the SEARCH-RE ;; found before. ;; (or (<= end-not begin) (>= begin-not end))) (setq found t) ;; ;; not found the correct match => skip this match ;; (goto-char (if backward begin end)))) ; end of loop (if found (progn (goto-char begin) (cons begin end)) nil))) (defun ada-goto-prev-nonblank-line ( &optional ignore-comment) ;; Moves point to the beginning of previous non-blank line, ;; ignoring comments if IGNORE-COMMENT is non-nil. ;; It returns t if a matching line was found. (let ((notfound t) (newpoint nil)) (save-excursion ;; ;; backward one line, if there is one ;; (if (zerop (forward-line -1)) ;; ;; there is some kind of previous line ;; (progn (beginning-of-line) (setq newpoint (point)) ;; ;; search until found or beginning-of-buffer ;; (while (and (setq notfound (or (looking-at "[ \t]*$") (and (looking-at "[ \t]*--") ignore-comment))) (not (ada-in-limit-line-p))) (forward-line -1) ;;(beginning-of-line) (setq newpoint (point))) ; end of loop )) ; end of if ) ; end of save-excursion (if notfound nil (progn (goto-char newpoint) t)))) (defun ada-goto-next-nonblank-line ( &optional ignore-comment) ;; Moves point to next non-blank line, ;; ignoring comments if IGNORE-COMMENT is non-nil. ;; It returns t if a matching line was found. (let ((notfound t) (newpoint nil)) (save-excursion ;; ;; forward one line ;; (if (zerop (forward-line 1)) ;; ;; there is some kind of previous line ;; (progn (beginning-of-line) (setq newpoint (point)) ;; ;; search until found or end-of-buffer ;; (while (and (setq notfound (or (looking-at "[ \t]*$") (and (looking-at "[ \t]*--") ignore-comment))) (not (ada-in-limit-line-p))) (forward-line 1) (beginning-of-line) (setq newpoint (point))) ; end of loop )) ; end of if ) ; end of save-excursion (if notfound nil (progn (goto-char newpoint) t)))) ;; ---- boolean functions for indentation (defun ada-in-decl-p () ;; Returns t if point is inside a declarative part. ;; Assumes point to be at the end of a statement. (or (ada-in-paramlist-p) (save-excursion (ada-goto-matching-decl-start t)))) (defun ada-looking-at-semi-or () ;; Returns t if looking-at an 'or' following a semicolon. (save-excursion (and (looking-at "\\") (progn (forward-word 1) (ada-goto-stmt-start) (looking-at "\\"))))) (defun ada-looking-at-semi-private () ;; Returns t if looking-at an 'private' following a semicolon. (save-excursion (and (looking-at "\\") (progn (forward-word 1) (ada-goto-stmt-start) (looking-at "\\"))))) ;;; make a faster??? ada-in-limit-line-p not using count-lines (defun ada-in-limit-line-p () ;; return t if point is in first or last accessible line. (or (save-excursion (beginning-of-line) (= (point-min) (point))) (save-excursion (end-of-line) (= (point-max) (point))))) (defun ada-in-comment-p () ;; Returns t if inside a comment. ;; (save-excursion (and (re-search-backward "\\(--\\|\n\\)" nil 1) ;; (looking-at "-")))) (nth 4 (parse-partial-sexp (save-excursion (beginning-of-line) (point)) (point)))) (defun ada-in-string-p () ;; Returns t if point is inside a string ;; (Taken from pascal-mode.el, modified by MH). (save-excursion (and (nth 3 (parse-partial-sexp (save-excursion (beginning-of-line) (point)) (point))) ;; check if 'string quote' is only a character constant (progn (re-search-backward "\"" nil t) ; # not a string delimiter anymore (not (= (char-after (1- (point))) ?')))))) (defun ada-in-string-or-comment-p () ;; Returns t if point is inside a string or a comment. (or (ada-in-comment-p) (ada-in-string-p))) (defun ada-in-paramlist-p () ;; Returns t if point is inside a parameter-list ;; following 'function'/'procedure'/'package'. (save-excursion (and (re-search-backward "(\\|)" nil t) ;; inside parentheses ? (looking-at "(") (backward-word 2) ;; right keyword before paranthesis ? (looking-at (concat "\\<\\(" "procedure\\|function\\|body\\|package\\|" "task\\|entry\\|accept\\)\\>")) (re-search-forward ")\\|:" nil t) ;; at least one ':' inside the parentheses ? (not (backward-char 1)) (looking-at ":")))) ;; not really a boolean function ... (defun ada-in-open-paren-p () ;; If point is somewhere behind an open parenthesis not yet closed, ;; it returns the column # of the first non-ws behind this open ;; parenthesis, otherwise nil." (let ((start (if (< (point) ada-search-paren-char-count-limit) 1 (- (point) ada-search-paren-char-count-limit))) parse-result (col nil)) (setq parse-result (parse-partial-sexp start (point))) (if (nth 1 parse-result) (save-excursion (goto-char (1+ (nth 1 parse-result))) (if (save-excursion (re-search-forward "[^ \t]" nil 1) (backward-char 1) (and (not (looking-at "\n")) (setq col (current-column)))) col (current-column))) nil))) ;;;----------------------;;; ;;; Behaviour Of TAB Key ;;; ;;;----------------------;;; (defun ada-tab () "Do indenting or tabbing according to `ada-tab-policy'." (interactive) (cond ((eq ada-tab-policy 'indent-and-tab) (error "not implemented")) ;; ada-indent-and-tab ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard)) ((eq ada-tab-policy 'indent-auto) (ada-indent-current)) ((eq ada-tab-policy 'gei) (ada-tab-gei)) ((eq ada-tab-policy 'indent-af) (af-indent-line)) ; GEB ((eq ada-tab-policy 'always-tab) (error "not implemented")) )) (defun ada-untab (arg) "Delete leading indenting according to `ada-tab-policy'." (interactive "P") (cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard)) ((eq ada-tab-policy 'indent-af) (backward-delete-char-untabify ; GEB (prefix-numeric-value arg) ; GEB arg)) ; GEB ((eq ada-tab-policy 'indent-auto) (error "not implemented")) ((eq ada-tab-policy 'always-tab) (error "not implemented")) )) (defun ada-indent-current-function () "Ada Mode version of the indent-line-function." (interactive "*") (let ((starting-point (point-marker))) (ada-beginning-of-line) (ada-tab) (if (< (point) starting-point) (goto-char starting-point)) (set-marker starting-point nil) )) (defun ada-tab-hard () "Indent current line to next tab stop." (interactive) (save-excursion (beginning-of-line) (insert-char ? ada-indent)) (if (save-excursion (= (point) (progn (beginning-of-line) (point)))) (forward-char ada-indent))) (defun ada-untab-hard () "indent current line to previous tab stop." (interactive) (let ((bol (save-excursion (progn (beginning-of-line) (point)))) (eol (save-excursion (progn (end-of-line) (point))))) (indent-rigidly bol eol (- 0 ada-indent)))) ;;;---------------;;; ;;; Miscellaneous ;;; ;;;---------------;;; (defun ada-remove-trailing-spaces () "remove trailing spaces in the whole buffer." (interactive) (save-match-data (save-excursion (save-restriction (widen) (goto-char (point-min)) (while (re-search-forward "[ \t]+$" (point-max) t) (replace-match "" nil nil)))))) (defun ada-untabify-buffer () ;; change all tabs to spaces (save-excursion (untabify (point-min) (point-max)))) (defun ada-uncomment-region (beg end) "delete `comment-start' at the beginning of a line in the region." (interactive "r") (comment-region beg end -1)) ;; define a function to support find-file.el if loaded (defun ada-ff-other-window () "Find other file in other window using `ff-find-other-file'." (interactive) (and (fboundp 'ff-find-other-file) (ff-find-other-file t))) ;;;-------------------------------;;; ;;; Moving To Procedures/Packages ;;; ;;;-------------------------------;;; (defun ada-next-procedure () "Moves point to next procedure." (interactive) (end-of-line) (if (re-search-forward ada-procedure-start-regexp nil t) (goto-char (match-beginning 1)) (error "No more functions/procedures/tasks"))) (defun ada-previous-procedure () "Moves point to previous procedure." (interactive) (beginning-of-line) (if (re-search-backward ada-procedure-start-regexp nil t) (goto-char (match-beginning 1)) (error "No more functions/procedures/tasks"))) (defun ada-next-package () "Moves point to next package." (interactive) (end-of-line) (if (re-search-forward ada-package-start-regexp nil t) (goto-char (match-beginning 1)) (error "No more packages"))) (defun ada-previous-package () "Moves point to previous package." (interactive) (beginning-of-line) (if (re-search-backward ada-package-start-regexp nil t) (goto-char (match-beginning 1)) (error "No more packages"))) ;;;----------------------- ;;; define keymap for Ada ;;;----------------------- (if (not ada-mode-map) (progn (setq ada-mode-map (make-sparse-keymap)) ;; Indentation and Formatting (define-key ada-mode-map "\C-j" 'ada-indent-newline-indent) (define-key ada-mode-map "\t" 'ada-tab) (define-key ada-mode-map "\C-c\C-l" 'ada-indent-region) (if (ada-xemacs) (define-key ada-mode-map '(shift tab) 'ada-untab) (define-key ada-mode-map [S-tab] 'ada-untab)) (define-key ada-mode-map "\C-c\C-f" 'ada-format-paramlist) (define-key ada-mode-map "\C-c\C-p" 'ada-call-pretty-printer) ;;; We don't want to make meta-characters case-specific. ;;; (define-key ada-mode-map "\M-Q" 'ada-fill-comment-paragraph-justify) (define-key ada-mode-map "\M-\C-q" 'ada-fill-comment-paragraph-postfix) ;; Movement ;;; It isn't good to redefine these. What should be done instead? -- rms. ;;; (define-key ada-mode-map "\M-e" 'ada-next-package) ;;; (define-key ada-mode-map "\M-a" 'ada-previous-package) (define-key ada-mode-map "\M-\C-e" 'ada-next-procedure) (define-key ada-mode-map "\M-\C-a" 'ada-previous-procedure) (define-key ada-mode-map "\C-c\C-a" 'ada-move-to-start) (define-key ada-mode-map "\C-c\C-e" 'ada-move-to-end) ;; Compilation (define-key ada-mode-map "\C-c\C-c" 'compile) ;; Casing (define-key ada-mode-map "\C-c\C-r" 'ada-adjust-case-region) (define-key ada-mode-map "\C-c\C-b" 'ada-adjust-case-buffer) (define-key ada-mode-map "\177" 'backward-delete-char-untabify) ;; Use predefined function of emacs19 for comments (RE) (define-key ada-mode-map "\C-c;" 'comment-region) (define-key ada-mode-map "\C-c:" 'ada-uncomment-region) ;; Change basic functionality ;; `substitute-key-definition' is not defined equally in GNU Emacs ;; and XEmacs, you cannot put in an optional 4th parameter in ;; XEmacs. I don't think it's necessary, so I leave it out for ;; GNU Emacs as well. If you encounter any problems with the ;; following three functions, please tell me. RE (mapcar (function (lambda (pair) (substitute-key-definition (car pair) (cdr pair) ada-mode-map))) '((beginning-of-line . ada-beginning-of-line) (end-of-line . ada-end-of-line) (forward-to-indentation . ada-forward-to-indentation) )) ;; else GNU Emacs ;;(mapcar (lambda (pair) ;; (substitute-key-definition (car pair) (cdr pair) ;; ada-mode-map global-map)) )) ;;;------------------- ;;; define menu 'Ada' ;;;------------------- (require 'easymenu) (defun ada-add-ada-menu () "Adds the menu 'Ada' to the menu bar in Ada Mode." (easy-menu-define ada-mode-menu ada-mode-map "Menu keymap for Ada mode." '("Ada" ["Next Package" ada-next-package t] ["Previous Package" ada-previous-package t] ["Next Procedure" ada-next-procedure t] ["Previous Procedure" ada-previous-procedure t] ["Goto Start" ada-move-to-start t] ["Goto End" ada-move-to-end t] ["------------------" nil nil] ["Indent Current Line (TAB)" ada-indent-current-function t] ["Indent Lines in Region" ada-indent-region t] ["Format Parameter List" ada-format-paramlist t] ["Pretty Print Buffer" ada-call-pretty-printer t] ["------------" nil nil] ["Fill Comment Paragraph" ada-fill-comment-paragraph t] ["Justify Comment Paragraph" ada-fill-comment-paragraph-justify t] ["Postfix Comment Paragraph" ada-fill-comment-paragraph-postfix t] ["------------" nil nil] ["Adjust Case Region" ada-adjust-case-region t] ["Adjust Case Buffer" ada-adjust-case-buffer t] ["----------" nil nil] ["Comment Region" comment-region t] ["Uncomment Region" ada-uncomment-region t] ["----------------" nil nil] ["Compile" compile (fboundp 'compile)] ["Next Error" next-error (fboundp 'next-error)] ["---------------" nil nil] ["Index" imenu (fboundp 'imenu)] ["--------------" nil nil] ["Other File Other Window" ada-ff-other-window (fboundp 'ff-find-other-file)] ["Other File" ff-find-other-file (fboundp 'ff-find-other-file)])) (if (ada-xemacs) (progn (easy-menu-add ada-mode-menu) (setq mode-popup-menu (cons "Ada Mode" ada-mode-menu))))) ;;;------------------------------- ;;; Define Some Support Functions ;;;------------------------------- (defun ada-beginning-of-line (&optional arg) (interactive "P") (cond ((eq ada-tab-policy 'indent-af) (af-beginning-of-line arg)) (t (beginning-of-line arg)) )) (defun ada-end-of-line (&optional arg) (interactive "P") (cond ((eq ada-tab-policy 'indent-af) (af-end-of-line arg)) (t (end-of-line arg)) )) (defun ada-current-column () (cond ((eq ada-tab-policy 'indent-af) (af-current-column)) (t (current-column)) )) (defun ada-forward-to-indentation (&optional arg) (interactive "P") (cond ((eq ada-tab-policy 'indent-af) (af-forward-to-indentation arg)) (t (forward-to-indentation arg)) )) ;;;--------------------------------------------------- ;;; support for find-file ;;;--------------------------------------------------- ;;;###autoload (defun ada-make-filename-from-adaname (adaname) "Determine the filename of a package/procedure from its own Ada name." ;; this is done simply by calling gkrunch, when we work with GNAT. It ;; must be a more complex function in other compiler environments. (interactive "s") ;; things that should really be done by the external process ;; since gnat-2.0, gnatk8 can do these things. If you still use a ;; previous version, just uncomment the following lines. (let (krunch-buf) (setq krunch-buf (generate-new-buffer "*gkrunch*")) (save-excursion (set-buffer krunch-buf) ; (insert (downcase adaname)) ; (goto-char (point-min)) ; (while (search-forward "." nil t) ; (replace-match "-" nil t)) ; (setq adaname (buffer-substring (point-min) ; (progn ; (goto-char (point-min)) ; (end-of-line) ; (point)))) ; ;; clean the buffer ; (delete-region (point-min) (point-max)) ;; send adaname to external process "gnatk8" (call-process "gnatk8" nil krunch-buf nil adaname ada-krunch-args) ;; fetch output of that process (setq adaname (buffer-substring (point-min) (progn (goto-char (point-min)) (end-of-line) (point)))) (kill-buffer krunch-buf))) (setq adaname adaname) ;; can I avoid this statement? ) ;;; functions for placing the cursor on the corresponding subprogram (defun ada-which-function-are-we-in () "Determine whether we are on a function definition/declaration. If that is the case remember the name of that function." (setq ff-function-name nil) (save-excursion (if (re-search-backward ada-procedure-start-regexp nil t) (setq ff-function-name (buffer-substring (match-beginning 0) (match-end 0))) ; we didn't find a procedure start, perhaps there is a package (if (re-search-backward ada-package-start-regexp nil t) (setq ff-function-name (buffer-substring (match-beginning 0) (match-end 0))) )))) ;;;--------------------------------------------------- ;;; support for imenu ;;;--------------------------------------------------- (defun imenu-create-ada-index (&optional regexp) "Create index alist for Ada files." (let ((index-alist '()) prev-pos char) (goto-char (point-min)) ;(imenu-progress-message prev-pos 0) ;; Search for functions/procedures (save-match-data (while (re-search-forward (or regexp ada-procedure-start-regexp) nil t) ;(imenu-progress-message prev-pos) ;; do not store forward definitions ;; right now we store them. We want to avoid them only in ;; package bodies, not in the specs!! ???RE??? (save-match-data ; (if (not (looking-at (concat ; "[ \t\n]*" ; WS ; "\([^)]+\)" ; parameterlist ; "\\([ \n\t]+return[ \n\t]+"; potential return ; "[a-zA-Z0-9_\\.]+\\)?" ; "[ \t]*" ; WS ; ";" ;; THIS is what we really look for ; ))) ; ; (push (imenu-example--name-and-position) index-alist) (setq index-alist (cons (imenu-example--name-and-position) index-alist)) ; ) ) ;(imenu-progress-message 100) )) (nreverse index-alist))) ;;;--------------------------------------------------- ;;; support for font-lock ;;;--------------------------------------------------- ;; Strings are a real pain in Ada because both ' and " can appear in a ;; non-string quote context (the former as an operator, the latter as ;; a character string). We follow the least losing solution, in which ;; only " is a string quote. Therefore a character string of the form ;; '"' will throw fontification off on the wrong track. (defconst ada-font-lock-keywords-1 (list ;; ;; accept, entry, function, package (body), protected (body|type), ;; pragma, procedure, task (body) plus name. (list (concat "\\<\\(" "accept\\|" "entry\\|" "function\\|" "package[ \t]+body\\|" "package\\|" "pragma\\|" "procedure\\|" "protected[ \t]+body\\|" "protected[ \t]+type\\|" "protected\\|" ;; "p\\(\\(ackage\\|rotected\\)\\(\\|[ \t]+\\(body\\|type\\)\\)\ ;;\\|r\\(agma\\|ocedure\\)\\)\\|" "task\\|" "task[ \t]+body\\|" "task[ \t]+type" ;; "task\\(\\|[ \t]+body\\)" "\\)\\>[ \t]*" "\\(\\sw+\\(\\.\\sw*\\)*\\)?") '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t))) "Subdued level highlighting for Ada mode.") (defconst ada-font-lock-keywords-2 (append ada-font-lock-keywords-1 (list ;; ;; Main keywords, except those treated specially below. (concat "\\<\\(" ; ("abort" "abs" "abstract" "accept" "access" "aliased" "all" ; "and" "array" "at" "begin" "case" "declare" "delay" "delta" ; "digits" "do" "else" "elsif" "entry" "exception" "exit" "for" ; "generic" "if" "in" "is" "limited" "loop" "mod" "not" ; "null" "or" "others" "private" "protected" ; "range" "record" "rem" "renames" "requeue" "return" "reverse" ; "select" "separate" "tagged" "task" "terminate" "then" "until" ; "while" "xor") "a\\(b\\(ort\\|s\\(\\|tract\\)\\)\\|cce\\(pt\\|ss\\)\\|" "l\\(iased\\|l\\)\\|nd\\|rray\\|t\\)\\|begin\\|case\\|" "d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|" "e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|for\\|" "generic\\|i[fns]\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ot\\|ull\\)\\|" "o\\(r\\|thers\\|ut\\)\\|pr\\(ivate\\|otected\\)\\|" "r\\(ange\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|" "se\\(lect\\|parate\\)\\|" "t\\(agged\\|erminate\\|hen\\)\\|until\\|" ; task removed "wh\\(ile\\|en\\)\\|xor" ; "when" added "\\)\\>") ;; ;; Anything following end and not already fontified is a body name. '("\\<\\(end\\)\\>[ \t]+\\([a-zA-Z0-9_\\.]+\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) ;; ;; Variable name plus optional keywords followed by a type name. Slow. ; (list (concat "\\<\\(\\sw+\\)\\>[ \t]*:?[ \t]*" ; "\\(access\\|constant\\|in\\|in[ \t]+out\\|out\\)?[ \t]*" ; "\\(\\sw+\\)?") ; '(1 font-lock-variable-name-face) ; '(2 font-lock-keyword-face nil t) '(3 font-lock-type-face nil t)) ;; ;; Optional keywords followed by a type name. (list (concat ; ":[ \t]*" "\\<\\(access\\|constant\\|in\\|in[ \t]+out\\|out\\)\\>" "[ \t]*" "\\(\\sw+\\)?") '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t)) ;; ;; Keywords followed by a type or function name. (list (concat "\\<\\(" "new\\|of\\|subtype\\|type" "\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*\\((\\)?") '(1 font-lock-keyword-face) '(2 (if (match-beginning 4) font-lock-function-name-face font-lock-type-face) nil t)) ;; ;; Keywords followed by a (comma separated list of) reference. (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)\\>" ; "when" removed ; "[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?") ; RE "[ \t]*\\([a-zA-Z0-9_\\.\\|, ]+\\)\\W") '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t)) ;; ;; Goto tags. '("<<\\(\\sw+\\)>>" 1 font-lock-reference-face) )) "Gaudy level highlighting for Ada mode.") (defvar ada-font-lock-keywords ada-font-lock-keywords-2 "Default Expressions to highlight in Ada mode. See the doc to `font-lock-maximum-decoration' for user configuration.") ;;; ;;; ???? ;;; (defun ada-gen-comment-until-proc () ;; comment until spec of a procedure or a function. (forward-line 1) (set-mark-command (point)) (if (re-search-forward ada-procedure-start-regexp nil t) (progn (goto-char (match-beginning 1)) (comment-region (mark) (point))) (error "No more functions/procedures"))) (defun ada-gen-treat-proc (match) ;; make dummy body of a procedure/function specification. ;; MATCH is a cons cell containing the start and end location of the ;; last search for ada-procedure-start-regexp. (goto-char (car match)) (let (proc-found func-found procname functype) (cond ((or (setq proc-found (looking-at "^[ \t]*procedure")) (setq func-found (looking-at "^[ \t]*function"))) ;; treat it as a proc/func (forward-word 2) (forward-word -1) (setq procname (buffer-substring (point) (cdr match))) ; store proc name ;; goto end of procname (goto-char (cdr match)) ;; skip over parameterlist (forward-sexp) ;; if function, skip over 'return' and result type. (if func-found (progn (forward-word 1) (skip-chars-forward " \t\n") (setq functype (buffer-substring (point) (progn (skip-chars-forward "a-zA-Z0-9_\.") (point)))))) ;; look for next non WS (cond ((looking-at "[ \t]*;") (delete-region (match-beginning 0) (match-end 0)) ;; delete the ';' (ada-indent-newline-indent) (insert " is") (ada-indent-newline-indent) (if func-found (progn (insert "Result : ") (insert functype) (insert ";") (ada-indent-newline-indent))) (insert "begin -- ") (insert procname) (ada-indent-newline-indent) (insert "null;") (ada-indent-newline-indent) (if func-found (progn (insert "return Result;") (ada-indent-newline-indent))) (insert "end ") (insert procname) (insert ";") (ada-indent-newline-indent) ) ;; else ((looking-at "[ \t\n]*is") ;; do nothing ) ((looking-at "[ \t\n]*rename") ;; do nothing ) (t (message "unknown syntax"))) )))) (defun ada-make-body () "Create an Ada package body in the current buffer. The potential old buffer contents is deleted first, then we copy the spec buffer in here and modify it to make it a body. This function typically is to be hooked into `ff-file-created-hooks'." (interactive) (delete-region (point-min) (point-max)) (insert-buffer (car (cdr (buffer-list)))) (ada-mode) (let (found) (if (setq found (ada-search-ignore-string-comment ada-package-start-regexp)) (progn (goto-char (cdr found)) (insert " body") ;; (forward-line -1) ;;(comment-region (point-min) (point)) ) (error "No package")) ;; (comment-until-proc) ;; does not work correctly ;; must be done by hand (while (setq found (ada-search-ignore-string-comment ada-procedure-start-regexp)) (ada-gen-treat-proc found)))) ;;; provide ourself (provide 'ada-mode) ;;; ada-mode.el ends here emacs-19.30/lisp/add-log.el100444 12120 1 50272 6055510646 13735 0ustar rmsdaemon;;; add-log.el --- change log maintenance commands for Emacs ;; Copyright (C) 1985, 1986, 1988, 1993, 1994 Free Software Foundation, Inc. ;; Keywords: maint ;; 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 facility is documented in the Emacs Manual. ;;; Code: (defvar change-log-default-name nil "*Name of a change log file for \\[add-change-log-entry].") (defvar add-log-current-defun-function nil "\ *If non-nil, function to guess name of current function from surrounding text. \\[add-change-log-entry] calls this function (if nil, `add-log-current-defun' instead) with no arguments. It returns a string or nil if it cannot guess.") (defvar add-log-full-name nil "*Full name of user, for inclusion in ChangeLog daily headers. This defaults to the value returned by the `user-full-name' function.") (defvar add-log-mailing-address nil "*Electronic mail address of user, for inclusion in ChangeLog daily headers. This defaults to the value of `user-mail-address'.") (defvar change-log-font-lock-keywords '(("^[SMTWF].+" . font-lock-function-name-face) ; Date line. ("^\t\\* \\([^ :\n]+\\)" 1 font-lock-comment-face) ; File name. ("\(\\([^)\n]+\\)\)" 1 font-lock-keyword-face)) ; Function name. "Additional expressions to highlight in Change Log mode.") (defvar change-log-mode-map nil "Keymap for Change Log major mode.") (if change-log-mode-map nil (setq change-log-mode-map (make-sparse-keymap)) (define-key change-log-mode-map "\M-q" 'change-log-fill-paragraph)) (defun change-log-name () (or change-log-default-name (if (eq system-type 'vax-vms) "$CHANGE_LOG$.TXT" (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt)) "changelo" "ChangeLog")))) ;;;###autoload (defun prompt-for-change-log-name () "Prompt for a change log name." (let* ((default (change-log-name)) (name (expand-file-name (read-file-name (format "Log file (default %s): " default) nil default)))) ;; Handle something that is syntactically a directory name. ;; Look for ChangeLog or whatever in that directory. (if (string= (file-name-nondirectory name) "") (expand-file-name (file-name-nondirectory default) name) ;; Handle specifying a file that is a directory. (if (file-directory-p name) (expand-file-name (file-name-nondirectory default) (file-name-as-directory name)) name)))) ;;;###autoload (defun find-change-log (&optional file-name) "Find a change log file for \\[add-change-log-entry] and return the name. Optional arg FILE-NAME specifies the file to use. If FILE-NAME is nil, use the value of `change-log-default-name'. If 'change-log-default-name' is nil, behave as though it were 'ChangeLog' \(or whatever we use on this operating system). If 'change-log-default-name' contains a leading directory component, then simply find it in the current directory. Otherwise, search in the current directory and its successive parents for a file so named. Once a file is found, `change-log-default-name' is set locally in the current buffer to the complete file name." ;; If user specified a file name or if this buffer knows which one to use, ;; just use that. (or file-name (setq file-name (and change-log-default-name (file-name-directory change-log-default-name) change-log-default-name)) (progn ;; Chase links in the source file ;; and use the change log in the dir where it points. (setq file-name (or (and buffer-file-name (file-name-directory (file-chase-links buffer-file-name))) default-directory)) (if (file-directory-p file-name) (setq file-name (expand-file-name (change-log-name) file-name))) ;; Chase links before visiting the file. ;; This makes it easier to use a single change log file ;; for several related directories. (setq file-name (file-chase-links file-name)) (setq file-name (expand-file-name file-name)) ;; Move up in the dir hierarchy till we find a change log file. (let ((file1 file-name) parent-dir) (while (and (not (or (get-file-buffer file1) (file-exists-p file1))) (progn (setq parent-dir (file-name-directory (directory-file-name (file-name-directory file1)))) ;; Give up if we are already at the root dir. (not (string= (file-name-directory file1) parent-dir)))) ;; Move up to the parent dir and try again. (setq file1 (expand-file-name (file-name-nondirectory (change-log-name)) parent-dir))) ;; If we found a change log in a parent, use that. (if (or (get-file-buffer file1) (file-exists-p file1)) (setq file-name file1))))) ;; Make a local variable in this buffer so we needn't search again. (set (make-local-variable 'change-log-default-name) file-name) file-name) ;;;###autoload (defun add-change-log-entry (&optional whoami file-name other-window new-entry) "Find change log file and add an entry for today. Optional arg (interactive prefix) non-nil means prompt for user name and site. Second arg is file name of change log. If nil, uses `change-log-default-name'. Third arg OTHER-WINDOW non-nil means visit in other window. Fourth arg NEW-ENTRY non-nil means always create a new entry at the front; never append to an existing entry." (interactive (list current-prefix-arg (prompt-for-change-log-name))) (or add-log-full-name (setq add-log-full-name (user-full-name))) (or add-log-mailing-address (setq add-log-mailing-address user-mail-address)) (if whoami (progn (setq add-log-full-name (read-input "Full name: " add-log-full-name)) ;; Note that some sites have room and phone number fields in ;; full name which look silly when inserted. Rather than do ;; anything about that here, let user give prefix argument so that ;; s/he can edit the full name field in prompter if s/he wants. (setq add-log-mailing-address (read-input "Mailing address: " add-log-mailing-address)))) (let ((defun (funcall (or add-log-current-defun-function 'add-log-current-defun))) paragraph-end entry) (setq file-name (expand-file-name (find-change-log file-name))) ;; Set ENTRY to the file name to use in the new entry. (and buffer-file-name ;; Never want to add a change log entry for the ChangeLog file itself. (not (string= buffer-file-name file-name)) (setq entry (if (string-match (concat "^" (regexp-quote (file-name-directory file-name))) buffer-file-name) (substring buffer-file-name (match-end 0)) (file-name-nondirectory buffer-file-name)))) (if (and other-window (not (equal file-name buffer-file-name))) (find-file-other-window file-name) (find-file file-name)) (or (eq major-mode 'change-log-mode) (change-log-mode)) (undo-boundary) (goto-char (point-min)) (if (looking-at (concat (regexp-quote (substring (current-time-string) 0 10)) ".* " (regexp-quote add-log-full-name) " <" (regexp-quote add-log-mailing-address))) (forward-line 1) (insert (current-time-string) " " add-log-full-name " <" add-log-mailing-address ">\n\n")) ;; Search only within the first paragraph. (if (looking-at "\n*[^\n* \t]") (skip-chars-forward "\n") (forward-paragraph 1)) (setq paragraph-end (point)) (goto-char (point-min)) ;; Now insert the new line for this entry. (cond ((re-search-forward "^\\s *\\*\\s *$" paragraph-end t) ;; Put this file name into the existing empty entry. (if entry (insert entry))) ((and (not new-entry) (let (case-fold-search) (re-search-forward (concat (regexp-quote (concat "* " entry)) ;; Don't accept `foo.bar' when ;; looking for `foo': "\\(\\s \\|[(),:]\\)") paragraph-end t))) ;; Add to the existing entry for the same file. (re-search-forward "^\\s *$\\|^\\s \\*") (goto-char (match-beginning 0)) ;; Delete excess empty lines; make just 2. (while (and (not (eobp)) (looking-at "^\\s *$")) (delete-region (point) (save-excursion (forward-line 1) (point)))) (insert "\n\n") (forward-line -2) (indent-relative-maybe)) (t ;; Make a new entry. (forward-line 1) (while (looking-at "\\sW") (forward-line 1)) (while (and (not (eobp)) (looking-at "^\\s *$")) (delete-region (point) (save-excursion (forward-line 1) (point)))) (insert "\n\n\n") (forward-line -2) (indent-to left-margin) (insert "* " (or entry "")))) ;; Now insert the function name, if we have one. ;; Point is at the entry for this file, ;; either at the end of the line or at the first blank line. (if defun (progn ;; Make it easy to get rid of the function name. (undo-boundary) (insert (if (save-excursion (beginning-of-line 1) (looking-at "\\s *$")) "" " ") "(" defun "): ")) ;; No function name, so put in a colon unless we have just a star. (if (not (save-excursion (beginning-of-line 1) (looking-at "\\s *\\(\\*\\s *\\)?$"))) (insert ": "))))) ;;;###autoload (defun add-change-log-entry-other-window (&optional whoami file-name) "Find change log file in other window and add an entry for today. Optional arg (interactive prefix) non-nil means prompt for user name and site. Second arg is file name of change log. \ If nil, uses `change-log-default-name'." (interactive (if current-prefix-arg (list current-prefix-arg (prompt-for-change-log-name)))) (add-change-log-entry whoami file-name t)) ;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window) ;;;###autoload (defun change-log-mode () "Major mode for editing change logs; like Indented Text Mode. Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74. New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window]. Each entry behaves as a paragraph, and the entries for one day as a page. Runs `change-log-mode-hook'." (interactive) (kill-all-local-variables) (indented-text-mode) (setq major-mode 'change-log-mode mode-name "Change Log" left-margin 8 fill-column 74) (use-local-map change-log-mode-map) ;; Let each entry behave as one paragraph: ;; We really do want "^" in paragraph-start below: it is only the lines that ;; begin at column 0 (despite the left-margin of 8) that we are looking for. (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\sw") (set (make-local-variable 'paragraph-separate) "\\s *$\\|\f\\|^\\sw") ;; Let all entries for one day behave as one page. ;; Match null string on the date-line so that the date-line ;; is grouped with what follows. (set (make-local-variable 'page-delimiter) "^\\<\\|^\f") (set (make-local-variable 'version-control) 'never) (set (make-local-variable 'adaptive-fill-regexp) "\\s *") (set (make-local-variable 'font-lock-defaults) '(change-log-font-lock-keywords t)) (run-hooks 'change-log-mode-hook)) ;; It might be nice to have a general feature to replace this. The idea I ;; have is a variable giving a regexp matching text which should not be ;; moved from bol by filling. change-log-mode would set this to "^\\s *\\s(". ;; But I don't feel up to implementing that today. (defun change-log-fill-paragraph (&optional justify) "Fill the paragraph, but preserve open parentheses at beginning of lines. Prefix arg means justify as well." (interactive "P") (let ((end (save-excursion (forward-paragraph) (point))) (beg (save-excursion (backward-paragraph)(point))) (paragraph-start (concat paragraph-start "\\|\\s *\\s("))) (fill-region beg end justify))) (defvar add-log-current-defun-header-regexp "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[-_a-zA-Z]+\\)[ \t]*[:=]" "*Heuristic regexp used by `add-log-current-defun' for unknown major modes.") ;;;###autoload (defun add-log-current-defun () "Return name of function definition point is in, or nil. Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...), Texinfo (@node titles), Perl, and Fortran. Other modes are handled by a heuristic that looks in the 10K before point for uppercase headings starting in the first column or identifiers followed by `:' or `=', see variable `add-log-current-defun-header-regexp'. Has a preference of looking backwards." (condition-case nil (save-excursion (let ((location (point))) (cond ((memq major-mode '(emacs-lisp-mode lisp-mode scheme-mode lisp-interaction-mode)) ;; If we are now precisely at the beginning of a defun, ;; make sure beginning-of-defun finds that one ;; rather than the previous one. (or (eobp) (forward-char 1)) (beginning-of-defun) ;; Make sure we are really inside the defun found, not after it. (if (and (progn (end-of-defun) (< location (point))) (progn (forward-sexp -1) (>= location (point)))) (progn (if (looking-at "\\s(") (forward-char 1)) (forward-sexp 1) (skip-chars-forward " '") (buffer-substring (point) (progn (forward-sexp 1) (point)))))) ((and (memq major-mode '(c-mode c++-mode c++-c-mode objc-mode)) (save-excursion (beginning-of-line) ;; Use eq instead of = here to avoid ;; error when at bob and char-after ;; returns nil. (while (eq (char-after (- (point) 2)) ?\\) (forward-line -1)) (looking-at "[ \t]*#[ \t]*define[ \t]"))) ;; Handle a C macro definition. (beginning-of-line) (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above (forward-line -1)) (search-forward "define") (skip-chars-forward " \t") (buffer-substring (point) (progn (forward-sexp 1) (point)))) ((memq major-mode '(c-mode c++-mode c++-c-mode objc-mode)) (beginning-of-line) ;; See if we are in the beginning part of a function, ;; before the open brace. If so, advance forward. (while (not (looking-at "{\\|\\(\\s *$\\)")) (forward-line 1)) (or (eobp) (forward-char 1)) (beginning-of-defun) (if (progn (end-of-defun) (< location (point))) (progn (backward-sexp 1) (let (beg tem) (forward-line -1) ;; Skip back over typedefs of arglist. (while (and (not (bobp)) (looking-at "[ \t\n]")) (forward-line -1)) ;; See if this is using the DEFUN macro used in Emacs, ;; or the DEFUN macro used by the C library. (if (condition-case nil (and (save-excursion (end-of-line) (while (= (preceding-char) ?\\) (end-of-line 2)) (backward-sexp 1) (beginning-of-line) (setq tem (point)) (looking-at "DEFUN\\b")) (>= location tem)) (error nil)) (progn (goto-char tem) (down-list 1) (if (= (char-after (point)) ?\") (progn (forward-sexp 1) (skip-chars-forward " ,"))) (buffer-substring (point) (progn (forward-sexp 1) (point)))) (if (looking-at "^[+-]") (get-method-definition) ;; Ordinary C function syntax. (setq beg (point)) (if (and (condition-case nil ;; Protect against "Unbalanced parens" error. (progn (down-list 1) ; into arglist (backward-up-list 1) (skip-chars-backward " \t") t) (error nil)) ;; Verify initial pos was after ;; real start of function. (save-excursion (goto-char beg) ;; For this purpose, include the line ;; that has the decl keywords. This ;; may also include some of the ;; comments before the function. (while (and (not (bobp)) (save-excursion (forward-line -1) (looking-at "[^\n\f]"))) (forward-line -1)) (>= location (point))) ;; Consistency check: going down and up ;; shouldn't take us back before BEG. (> (point) beg)) (let (end middle) ;; Don't include any final newline ;; in the name we use. (if (= (preceding-char) ?\n) (forward-char -1)) (setq end (point)) (backward-sexp 1) ;; Now find the right beginning of the name. ;; Include certain keywords if they ;; precede the name. (setq middle (point)) (forward-word -1) ;; Ignore these subparts of a class decl ;; and move back to the class name itself. (while (looking-at "public \\|private ") (skip-chars-backward " \t:") (setq end (point)) (backward-sexp 1) (setq middle (point)) (forward-word -1)) (and (bolp) (looking-at "struct \\|union \\|class ") (setq middle (point))) (buffer-substring middle end))))))))) ((memq major-mode '(TeX-mode plain-TeX-mode LaTeX-mode;; tex-mode.el plain-tex-mode latex-mode;; cmutex.el )) (if (re-search-backward "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t) (progn (goto-char (match-beginning 0)) (buffer-substring (1+ (point));; without initial backslash (progn (end-of-line) (point)))))) ((eq major-mode 'texinfo-mode) (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t) (buffer-substring (match-beginning 1) (match-end 1)))) ((eq major-mode 'perl-mode) (if (re-search-backward "^sub[ \t]+\\([^ \t\n]+\\)" nil t) (buffer-substring (match-beginning 1) (match-end 1)))) ((eq major-mode 'fortran-mode) ;; must be inside function body for this to work (beginning-of-fortran-subprogram) (let ((case-fold-search t)) ; case-insensitive ;; search for fortran subprogram start (if (re-search-forward "^[ \t]*\\(program\\|subroutine\\|function\ \\|[ \ta-z0-9*]*[ \t]+function\\)" nil t) (progn ;; move to EOL or before first left paren (if (re-search-forward "[(\n]" nil t) (progn (forward-char -1) (skip-chars-backward " \t")) (end-of-line)) ;; Use the name preceding that. (buffer-substring (point) (progn (forward-sexp -1) (point))))))) (t ;; If all else fails, try heuristics (let (case-fold-search) (end-of-line) (if (re-search-backward add-log-current-defun-header-regexp (- (point) 10000) t) (buffer-substring (match-beginning 1) (match-end 1)))))))) (error nil))) (defvar get-method-definition-md) ;; Subroutine used within get-method-definition. ;; Add the last match in the buffer to the end of `md', ;; followed by the string END; move to the end of that match. (defun get-method-definition-1 (end) (setq get-method-definition-md (concat get-method-definition-md (buffer-substring (match-beginning 1) (match-end 1)) end)) (goto-char (match-end 0))) ;; For objective C, return the method name if we are in a method. (defun get-method-definition () (let ((get-method-definition-md "[")) (save-excursion (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t) (get-method-definition-1 " "))) (save-excursion (cond ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t) (get-method-definition-1 "") (while (not (looking-at "[{;]")) (looking-at "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*") (get-method-definition-1 "")) (concat get-method-definition-md "]")))))) (provide 'add-log) ;;; add-log.el ends here emacs-19.30/lisp/advice.el100444 12120 1 512031 5731740002 13664 0ustar rmsdaemon;;; advice.el --- an overloading mechanism for Emacs Lisp functions ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: Hans Chalupsky ;; Created: 12 Dec 1992 ;; Version: advice.el,v 2.14 1994/08/05 03:42:04 hans Exp ;; Keywords: extensions, lisp, tools ;; 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. ;; LCD Archive Entry: ;; advice|Hans Chalupsky|hans@cs.buffalo.edu| ;; Overloading mechanism for Emacs Lisp functions| ;; 1994/08/05 03:42:04|2.14|~/packages/advice.el.Z| ;;; Commentary: ;; NOTE: This documentation is slightly out of date. In particular, all the ;; references to Emacs-18 are obsolete now, because it is not any longer ;; supported by this version of Advice. An up-to-date version will soon be ;; available as an info file (thanks to the kind help of Jack Vinson and ;; David M. Smith). ;; @ Introduction: ;; =============== ;; This package implements a full-fledged Lisp-style advice mechanism ;; for Emacs Lisp. Advice is a clean and efficient way to modify the ;; behavior of Emacs Lisp functions without having to keep personal ;; modified copies of such functions around. A great number of such ;; modifications can be achieved by treating the original function as a ;; black box and specifying a different execution environment for it ;; with a piece of advice. Think of a piece of advice as a kind of fancy ;; hook that you can attach to any function/macro/subr. ;; @ Highlights: ;; ============= ;; - Clean definition of multiple, named before/around/after advices ;; for functions, macros, subrs and special forms ;; - Full control over the arguments an advised function will receive, ;; the binding environment in which it will be executed, as well as the ;; value it will return. ;; - Allows re/definition of interactive behavior for functions and subrs ;; - Every piece of advice can have its documentation string which will be ;; combined with the original documentation of the advised function at ;; call-time of `documentation' for proper command-key substitution. ;; - The execution of every piece of advice can be protected against error ;; and non-local exits in preceding code or advices. ;; - Simple argument access either by name, or, more portable but as ;; efficient, via access macros ;; - Allows the specification of a different argument list for the advised ;; version of a function. ;; - Advised functions can be byte-compiled either at file-compile time ;; (see preactivation) or activation time. ;; - Separation of advice definition and activation ;; - Forward advice is possible, that is ;; as yet undefined or autoload functions can be advised without having to ;; preload the file in which they are defined. ;; - Forward redefinition is possible because around advice can be used to ;; completely redefine a function. ;; - A caching mechanism for advised definition provides for cheap deactivation ;; and reactivation of advised functions. ;; - Preactivation allows efficient construction and compilation of advised ;; definitions at file compile time without giving up the flexibility of ;; the advice mechanism. ;; - En/disablement mechanism allows the use of different "views" of advised ;; functions depending on what pieces of advice are currently en/disabled ;; - Provides manipulation mechanisms for sets of advised functions via ;; regular expressions that match advice names ;; @ How to get Advice for Emacs-18: ;; ================================= ;; `advice18.el', a version of Advice that also works in Emacs-18 is available ;; either via anonymous ftp from `ftp.cs.buffalo.edu (128.205.32.9)' with ;; pathname `/pub/Emacs/advice18.el', or from one of the Emacs Lisp archive ;; sites, or send email to and I'll mail it to you. ;; @ Overview, or how to read this file: ;; ===================================== ;; NOTE: This documentation is slightly out of date. In particular, all the ;; references to Emacs-18 are obsolete now, because it is not any longer ;; supported by this version of Advice. An up-to-date version will soon be ;; available as an info file (thanks to the kind help of Jack Vinson and ;; David M. Smith). Until then you can use `outline-mode' to help you read ;; this documentation (set `outline-regexp' to `";; @+"'). ;; ;; The four major sections of this file are: ;; ;; @ This initial information ...installation, customization etc. ;; @ Advice documentation: ...general documentation ;; @ Foo games: An advice tutorial ...teaches about Advice by example ;; @ Advice implementation: ...actual code, yeah!! ;; ;; The latter three are actual headings which you can search for ;; directly in case `outline-mode' doesn't work for you. ;; @ Restrictions: ;; =============== ;; - This version of Advice only works for Emacs 19.26 and later. It uses ;; new versions of the built-in functions `fset/defalias' which are not ;; yet available in Lucid Emacs, hence, it won't work there. ;; - Advised functions/macros/subrs will only exhibit their advised behavior ;; when they are invoked via their function cell. This means that advice will ;; not work for the following: ;; + advised subrs that are called directly from other subrs or C-code ;; + advised subrs that got replaced with their byte-code during ;; byte-compilation (e.g., car) ;; + advised macros which were expanded during byte-compilation before ;; their advice was activated. ;; @ Credits: ;; ========== ;; This package is an extension and generalization of packages such as ;; insert-hooks.el written by Noah S. Friedman, and advise.el written by ;; Raul J. Acevedo. Some ideas used in here come from these packages, ;; others come from the various Lisp advice mechanisms I've come across ;; so far, and a few are simply mine. ;; @ Comments, suggestions, bug reports: ;; ===================================== ;; If you find any bugs, have suggestions for new advice features, find the ;; documentation wrong, confusing, incomplete, or otherwise unsatisfactory, ;; have any questions about Advice, or have otherwise enlightening ;; comments feel free to send me email at . ;; @ Safety Rules and Emergency Exits: ;; =================================== ;; Before we begin: CAUTION!! ;; Advice provides you with a lot of rope to hang yourself on very ;; easily accessible trees, so, here are a few important things you ;; should know: Once Advice has been started with `ad-start-advice' ;; (which happens automatically when you load this file), it ;; generates an advised definition of the `documentation' function, and ;; it will enable automatic advice activation when functions get defined. ;; All of this can be undone at any time with `M-x ad-stop-advice'. ;; ;; If you experience any strange behavior/errors etc. that you attribute to ;; Advice or to some ill-advised function do one of the following: ;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what ;; function gives you problems) ;; - M-x ad-deactivate-all (if you don't have a clue what's going wrong) ;; - M-x ad-stop-advice (if you think the problem is related to the ;; advised functions used by Advice itself) ;; - M-x ad-recover-normality (for real emergencies) ;; - If none of the above solves your Advice-related problem go to another ;; terminal, kill your Emacs process and send me some hate mail. ;; The first three measures have restarts, i.e., once you've figured out ;; the problem you can reactivate advised functions with either `ad-activate', ;; `ad-activate-all', or `ad-start-advice'. `ad-recover-normality' unadvises ;; everything so you won't be able to reactivate any advised functions, you'll ;; have to stick with their standard incarnations for the rest of the session. ;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before ;; you byte-compile a file, because advised special forms and macros can lead ;; to unwanted compilation results. When you are done compiling use ;; `M-x ad-activate-all' to go back to the advised state of all your ;; advised functions. ;; RELAX: Advice is pretty safe even if you are oblivious to the above. ;; I use it extensively and haven't run into any serious trouble in a long ;; time. Just wanted you to be warned. ;; @ Customization: ;; ================ ;; Look at the documentation of `ad-redefinition-action' for possible values ;; of this variable. Its default value is `warn' which will print a warning ;; message when an already defined advised function gets redefined with a ;; new original definition and de/activated. ;; Look at the documentation of `ad-default-compilation-action' for possible ;; values of this variable. Its default value is `maybe' which will compile ;; advised definitions during activation in case the byte-compiler is already ;; loaded. Otherwise, it will leave them uncompiled. ;; @ Motivation: ;; ============= ;; Before I go on explaining how advice works, here are four simple examples ;; how this package can be used. The first three are very useful, the last one ;; is just a joke: ;;(defadvice switch-to-buffer (before existing-buffers-only activate) ;; "When called interactively switch to existing buffers only, unless ;;when called with a prefix argument." ;; (interactive ;; (list (read-buffer "Switch to buffer: " (other-buffer) ;; (null current-prefix-arg))))) ;; ;;(defadvice switch-to-buffer (around confirm-non-existing-buffers activate) ;; "Switch to non-existing buffers only upon confirmation." ;; (interactive "BSwitch to buffer: ") ;; (if (or (get-buffer (ad-get-arg 0)) ;; (y-or-n-p (format "`%s' does not exist, create? " (ad-get-arg 0)))) ;; ad-do-it)) ;; ;;(defadvice find-file (before existing-files-only activate) ;; "Find existing files only" ;; (interactive "fFind file: ")) ;; ;;(defadvice car (around interactive activate) ;; "Make `car' an interactive function." ;; (interactive "xCar of list: ") ;; ad-do-it ;; (if (interactive-p) ;; (message "%s" ad-return-value))) ;; @ Advice documentation: ;; ======================= ;; Below is general documentation of the various features of advice. For more ;; concrete examples check the corresponding sections in the tutorial part. ;; @@ Terminology: ;; =============== ;; - Emacs, Emacs-19: FSF's version of Emacs with major version 19 ;; - Lemacs: Lucid's version of Emacs with major version 19 ;; - v18: Any Emacs with major version 18 or built as an extension to that ;; (such as Epoch) ;; - v19: Any Emacs with major version 19 ;; - jwz: Jamie Zawinski - keeper of Lemacs and creator of the optimizing ;; byte-compiler used in v19s. ;; - Advice: The name of this package. ;; - advices: Short for "pieces of advice". ;; @@ Defining a piece of advice with `defadvice': ;; =============================================== ;; The main means of defining a piece of advice is the macro `defadvice', ;; there is no interactive way of specifying a piece of advice. A call to ;; `defadvice' has the following syntax which is similar to the syntax of ;; `defun/defmacro': ;; ;; (defadvice ( [] [] {}*) ;; [ [] [] ] ;; {}* ) ;; is the name of the function/macro/subr to be advised. ;; is the class of the advice which has to be one of `before', ;; `around', `after', `activation' or `deactivation' (the last two allow ;; definition of special act/deactivation hooks). ;; is the name of the advice which has to be a non-nil symbol. ;; Names uniquely identify a piece of advice in a certain advice class, ;; hence, advices can be redefined by defining an advice with the same class ;; and name. Advice names are global symbols, hence, the same name space ;; conventions used for function names should be applied. ;; An optional specifies where in the current list of advices of ;; the specified this new advice will be placed. has to ;; be either `first', `last' or a number that specifies a zero-based ;; position (`first' is equivalent to 0). If no position is specified ;; `first' will be used as a default. If this call to `defadvice' redefines ;; an already existing advice (see above) then the position argument will ;; be ignored and the position of the already existing advice will be used. ;; An optional which has to be a list can be used to define the ;; argument list of the advised function. This argument list should of ;; course be compatible with the argument list of the original function, ;; otherwise functions that call the advised function with the original ;; argument list in mind will break. If more than one advice specify an ;; argument list then the first one (the one with the smallest position) ;; found in the list of before/around/after advices will be used. ;; is a list of symbols that specify further information about the ;; advice. All flags can be specified with unambiguous initial substrings. ;; `activate': Specifies that the advice information of the advised ;; function should be activated right after this advice has been ;; defined. In forward advices `activate' will be ignored. ;; `protect': Specifies that this advice should be protected against ;; non-local exits and errors in preceding code/advices. ;; `compile': Specifies that the advised function should be byte-compiled. ;; This flag will be ignored unless `activate' is also specified. ;; `disable': Specifies that the defined advice should be disabled, hence, ;; it will not be used in an activation until somebody enables it. ;; `preactivate': Specifies that the advised function should get preactivated ;; at macro-expansion/compile time of this `defadvice'. This ;; generates a compiled advised definition according to the ;; current advice state which will be used during activation ;; if appropriate. Only use this if the `defadvice' gets ;; actually compiled (with a v18 byte-compiler put the `defadvice' ;; into the body of a `defun' to accomplish proper compilation). ;; An optional can be supplied to document the advice. ;; On call of the `documentation' function it will be combined with the ;; documentation strings of the original function and other advices. ;; An optional form can be supplied to change/add ;; interactive behavior of the original function. If more than one advice ;; has an `(interactive ...)' specification then the first one (the one ;; with the smallest position) found in the list of before/around/after ;; advices will be used. ;; A possibly empty list of specifies the body of the advice in ;; an implicit progn. The body of an advice can access/change arguments, ;; the return value, the binding environment, and can have all sorts of ;; other side effects. ;; @@ Assembling advised definitions: ;; ================================== ;; Suppose a function/macro/subr/special-form has N pieces of before advice, ;; M pieces of around advice and K pieces of after advice. Assuming none of ;; the advices is protected, its advised definition will look like this ;; (body-form indices correspond to the position of the respective advice in ;; that advice class): ;; ([macro] lambda ;; [ [] [(interactive ...)] ] ;; (let (ad-return-value) ;; {}* ;; .... ;; {}* ;; {}* ;; {}* ;; .... ;; {}* ;; (setq ad-return-value ;; >) ;; {}* ;; .... ;; {}* ;; {}* ;; {}* ;; .... ;; {}* ;; ad-return-value)) ;; Macros and special forms will be redefined as macros, hence the optional ;; [macro] in the beginning of the definition. ;; is either the argument list of the original function or the ;; first argument list defined in the list of before/around/after advices. ;; The values of variables can be accessed/changed in the body of ;; an advice by simply referring to them by their original name, however, ;; more portable argument access macros are also provided (see below). For ;; subrs/special-forms for which neither explicit argument list definitions ;; are available, nor their documentation strings contain such definitions ;; (as they do v19s), `(&rest ad-subr-args)' will be used. ;; is an optional, special documentation string which will ;; be expanded into a proper documentation string upon call of `documentation'. ;; (interactive ...) is an optional interactive form either taken from the ;; original function or from a before/around/after advice. For advised ;; interactive subrs that do not have an interactive form specified in any ;; advice we have to use (interactive) and then call the subr interactively ;; if the advised function was called interactively, because the ;; interactive specification of subrs is not accessible. This is the only ;; case where changing the values of arguments will not have an affect ;; because they will be reset by the interactive specification of the subr. ;; If this is a problem one can always specify an interactive form in a ;; before/around/after advice to gain control over argument values that ;; were supplied interactively. ;; ;; Then the body forms of the various advices in the various classes of advice ;; are assembled in order. The forms of around advice L are normally part of ;; one of the forms of around advice L-1. An around advice can specify where ;; the forms of the wrapped or surrounded forms should go with the special ;; keyword `ad-do-it', which will be substituted with a `progn' containing the ;; forms of the surrounded code. ;; The innermost part of the around advice onion is ;; > ;; whose form depends on the type of the original function. The variable ;; `ad-return-value' will be set to its result. This variable is visible to ;; all pieces of advice which can access and modify it before it gets returned. ;; ;; The semantic structure of advised functions that contain protected pieces ;; of advice is the same. The only difference is that `unwind-protect' forms ;; make sure that the protected advice gets executed even if some previous ;; piece of advice had an error or a non-local exit. If any around advice is ;; protected then the whole around advice onion will be protected. ;; @@ Argument access in advised functions: ;; ======================================== ;; As already mentioned, the simplest way to access the arguments of an ;; advised function in the body of an advice is to refer to them by name. To ;; do that, the advice programmer needs to know either the names of the ;; argument variables of the original function, or the names used in the ;; argument list redefinition given in a piece of advice. While this simple ;; method might be sufficient in many cases, it has the disadvantage that it ;; is not very portable because it hardcodes the argument names into the ;; advice. If the definition of the original function changes the advice ;; might break even though the code might still be correct. Situations like ;; that arise, for example, if one advises a subr like `eval-region' which ;; gets redefined in a non-advice style into a function by the edebug ;; package. If the advice assumes `eval-region' to be a subr it might break ;; once edebug is loaded. Similar situations arise when one wants to use the ;; same piece of advice across different versions of Emacs. Some subrs in a ;; v18 Emacs are functions in v19 and vice versa, but for the most part the ;; semantics remain the same, hence, the same piece of advice might be usable ;; in both Emacs versions. ;; As a solution to that advice provides argument list access macros that get ;; translated into the proper access forms at activation time, i.e., when the ;; advised definition gets constructed. Access macros access actual arguments ;; by position regardless of how these actual argument get distributed onto ;; the argument variables of a function. The rational behind this is that in ;; Emacs Lisp the semantics of an argument is strictly determined by its ;; position (there are no keyword arguments). ;; Suppose the function `foo' is defined as ;; ;; (defun foo (x y &optional z &rest r) ....) ;; ;; and is then called with ;; ;; (foo 0 1 2 3 4 5 6) ;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that ;; the semantics of an actual argument is determined by its position. It is ;; this semantics that has to be known by the advice programmer. Then s/he ;; can access these arguments in a piece of advice with some of the ;; following macros (the arrows indicate what value they will return): ;; (ad-get-arg 0) -> 0 ;; (ad-get-arg 1) -> 1 ;; (ad-get-arg 2) -> 2 ;; (ad-get-arg 3) -> 3 ;; (ad-get-args 2) -> (2 3 4 5 6) ;; (ad-get-args 4) -> (4 5 6) ;; `(ad-get-arg )' will return the actual argument that was supplied ;; at , `(ad-get-args )' will return the list of actual ;; arguments supplied starting at . Note that these macros can be ;; used without any knowledge about the form of the actual argument list of ;; the original function. ;; Similarly, `(ad-set-arg )' can be used to set the ;; value of the actual argument at to . For example, ;; ;; (ad-set-arg 5 "five") ;; ;; will have the effect that R=(3 4 "five" 6) once the original function is ;; called. `(ad-set-args )' can be used to set ;; the list of actual arguments starting at to . ;; For example, ;; ;; (ad-set-args 0 '(5 4 3 2 1 0)) ;; ;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original ;; function is called. ;; All these access macros are text macros rather than real Lisp macros. When ;; the advised definition gets constructed they get replaced with actual access ;; forms depending on the argument list of the advised function, i.e., after ;; that argument access is in most cases as efficient as using the argument ;; variable names directly. ;; @@@ Accessing argument bindings of arbitrary functions: ;; ======================================================= ;; Some functions (such as `trace-function' defined in trace.el) need a ;; method of accessing the names and bindings of the arguments of an ;; arbitrary advised function. To do that within an advice one can use the ;; special keyword `ad-arg-bindings' which is a text macro that will be ;; substituted with a form that will evaluate to a list of binding ;; specifications, one for every argument variable. These binding ;; specifications can then be examined in the body of the advice. For ;; example, somewhere in an advice we could do this: ;; ;; (let* ((bindings ad-arg-bindings) ;; (firstarg (car bindings)) ;; (secondarg (car (cdr bindings)))) ;; ;; Print info about first argument ;; (print (format "%s=%s (%s)" ;; (ad-arg-binding-field firstarg 'name) ;; (ad-arg-binding-field firstarg 'value) ;; (ad-arg-binding-field firstarg 'type))) ;; ....) ;; ;; The `type' of an argument is either `required', `optional' or `rest'. ;; Wherever `ad-arg-bindings' appears a form will be inserted that evaluates ;; to the list of bindings, hence, in order to avoid multiple unnecessary ;; evaluations one should always bind it to some variable. ;; @@@ Argument list mapping: ;; ========================== ;; Because `defadvice' allows the specification of the argument list of the ;; advised function we need a mapping mechanism that maps this argument list ;; onto that of the original function. For example, somebody might specify ;; `(sym newdef)' as the argument list of `fset', while advice might use ;; `(&rest ad-subr-args)' as the argument list of the original function ;; (depending on what Emacs version is used). Hence SYM and NEWDEF have to ;; be properly mapped onto the &rest variable when the original definition is ;; called. Advice automatically takes care of that mapping, hence, the advice ;; programmer can specify an argument list without having to know about the ;; exact structure of the original argument list as long as the new argument ;; list takes a compatible number/magnitude of actual arguments. ;; @@@ Definition of subr argument lists: ;; ====================================== ;; When advice constructs the advised definition of a function it has to ;; know the argument list of the original function. For functions and macros ;; the argument list can be determined from the actual definition, however, ;; for subrs there is no such direct access available. In Lemacs and for some ;; subrs in Emacs-19 the argument list of a subr can be determined from ;; its documentation string, in a v18 Emacs even that is not possible. If ;; advice cannot at all determine the argument list of a subr it uses ;; `(&rest ad-subr-args)' which will always work but is inefficient because ;; it conses up arguments. The macro `ad-define-subr-args' can be used by ;; the advice programmer to explicitly tell advice about the argument list ;; of a certain subr, for example, ;; ;; (ad-define-subr-args 'fset '(sym newdef)) ;; ;; is used by advice itself to tell a v18 Emacs about the arguments of `fset'. ;; The following can be used to undo such a definition: ;; ;; (ad-undefine-subr-args 'fset) ;; ;; The argument list definition is stored on the property list of the subr ;; name symbol. When an argument list could be determined from the ;; documentation string it will be cached under that property. The general ;; mechanism for looking up the argument list of a subr is the following: ;; 1) look for a definition stored on the property list ;; 2) if that failed try to infer it from the documentation string and ;; if successful cache it on the property list ;; 3) otherwise use `(&rest ad-subr-args)' ;; @@ Activation and deactivation: ;; =============================== ;; The definition of an advised function does not change until all its advice ;; gets actually activated. Activation can either happen with the `activate' ;; flag specified in the `defadvice', with an explicit call or interactive ;; invocation of `ad-activate', or if forward advice is enabled (i.e., the ;; value of `ad-activate-on-definition' is t) at the time an already advised ;; function gets defined. ;; When a function gets first activated its original definition gets saved, ;; all defined and enabled pieces of advice will get combined with the ;; original definition, the resulting definition might get compiled depending ;; on some conditions described below, and then the function will get ;; redefined with the advised definition. This also means that undefined ;; functions cannot get activated even though they might be already advised. ;; The advised definition will get compiled either if `ad-activate' was called ;; interactively with a prefix argument, or called explicitly with its second ;; argument as t, or, if `ad-default-compilation-action' justifies it according ;; to the current system state. If the advised definition was ;; constructed during "preactivation" (see below) then that definition will ;; be already compiled because it was constructed during byte-compilation of ;; the file that contained the `defadvice' with the `preactivate' flag. ;; `ad-deactivate' can be used to back-define an advised function to its ;; original definition. It can be called interactively or directly. Because ;; `ad-activate' caches the advised definition the function can be ;; reactivated via `ad-activate' with only minor overhead (it is checked ;; whether the current advice state is consistent with the cached ;; definition, see the section on caching below). ;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate ;; all currently advised function that have a piece of advice with a name that ;; contains a match for a regular expression. These functions can be used to ;; de/activate sets of functions depending on certain advice naming ;; conventions. ;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to ;; de/activate all currently advised functions. These are useful to ;; (temporarily) return to an un/advised state. ;; @@@ Reasons for the separation of advice definition and activation: ;; =================================================================== ;; As already mentioned, advising happens in two stages: ;; 1) definition of various pieces of advice ;; 2) activation of all advice currently defined and enabled ;; The advantage of this is that various pieces of advice can be defined ;; before they get combined into an advised definition which avoids ;; unnecessary constructions of intermediate advised definitions. The more ;; important advantage is that it allows the implementation of forward advice. ;; Advice information for a certain function accumulates as the value of the ;; `advice-info' property of the function symbol. This accumulation is ;; completely independent of the fact that that function might not yet be ;; defined. The special forms `defun' and `defmacro' have been advised to ;; check whether the function/macro they defined had advice information ;; associated with it. If so and forward advice is enabled, the original ;; definition will be saved, and then the advice will be activated. When a ;; file is loaded in a v18 Emacs the functions/macros it defines are also ;; defined with calls to `defun/defmacro'. Hence, we can forward advise ;; functions/macros which will be defined later during a load/autoload of some ;; file (for compiled files generated by jwz's byte-compiler in a v19 Emacs ;; this is slightly more complicated but the basic idea is the same). ;; @@ Enabling/disabling pieces or sets of advice: ;; =============================================== ;; A major motivation for the development of this advice package was to bring ;; a little bit more structure into the function overloading chaos in Emacs ;; Lisp. Many packages achieve some of their functionality by adding a little ;; bit (or a lot) to the standard functionality of some Emacs Lisp function. ;; ange-ftp is a very popular package that achieves its magic by overloading ;; most Emacs Lisp functions that deal with files. A popular function that's ;; overloaded by many packages is `expand-file-name'. The situation that one ;; function is multiply overloaded can arise easily. ;; Once in a while it would be desirable to be able to disable some/all ;; overloads of a particular package while keeping all the rest. Ideally - ;; at least in my opinion - these overloads would all be done with advice, ;; I know I am dreaming right now... In that ideal case the enable/disable ;; mechanism of advice could be used to achieve just that. ;; Every piece of advice is associated with an enablement flag. When the ;; advised definition of a particular function gets constructed (e.g., during ;; activation) only the currently enabled pieces of advice will be considered. ;; This mechanism allows one to have different "views" of an advised function ;; dependent on what pieces of advice are currently enabled. ;; Another motivation for this mechanism is that it allows one to define a ;; piece of advice for some function yet keep it dormant until a certain ;; condition is met. Until then activation of the function will not make use ;; of that piece of advice. Once the condition is met the advice can be ;; enabled and a reactivation of the function will add its functionality as ;; part of the new advised definition. For example, the advices of `defun' ;; etc. used by advice itself will stay disabled until `ad-start-advice' is ;; called and some variables have the proper values. Hence, if somebody ;; else advised these functions too and activates them the advices defined ;; by advice will get used only if they are intended to be used. ;; The main interface to this mechanism are the interactive functions ;; `ad-enable-advice' and `ad-disable-advice'. For example, the following ;; would disable a particular advice of the function `foo': ;; ;; (ad-disable-advice 'foo 'before 'my-advice) ;; ;; This call by itself only changes the flag, to get the proper effect in ;; the advised definition too one has to activate `foo' with ;; ;; (ad-activate 'foo) ;; ;; or interactively. To disable whole sets of advices one can use a regular ;; expression mechanism. For example, let us assume that ange-ftp actually ;; used advice to overload all its functions, and that it used the ;; "ange-ftp-" prefix for all its advice names, then we could temporarily ;; disable all its advices with ;; ;; (ad-disable-regexp "^ange-ftp-") ;; ;; and the following call would put that actually into effect: ;; ;; (ad-activate-regexp "^ange-ftp-") ;; ;; A saver way would have been to use ;; ;; (ad-update-regexp "^ange-ftp-") ;; ;; instead which would have only reactivated currently actively advised ;; functions, but not functions that were currently deactivated. All these ;; functions can also be called interactively. ;; A certain piece of advice is considered a match if its name contains a ;; match for the regular expression. To enable ange-ftp again we would use ;; `ad-enable-regexp' and then activate or update again. ;; @@ Forward advice, automatic advice activation: ;; =============================================== ;; Because most Emacs Lisp packages are loaded on demand via an autoload ;; mechanism it is essential to be able to "forward advise" functions. ;; Otherwise, proper advice definition and activation would make it necessary ;; to preload every file that defines a certain function before it can be ;; advised, which would partly defeat the purpose of the advice mechanism. ;; In the following, "forward advice" always implies its automatic activation ;; once a function gets defined, and not just the accumulation of advice ;; information for a possibly undefined function. ;; Advice implements forward advice mainly via the following: 1) Separation ;; of advice definition and activation that makes it possible to accumulate ;; advice information without having the original function already defined, ;; 2) special versions of the built-in functions `fset/defalias' which check ;; for advice information whenever they define a function. If advice ;; information was found then the advice will immediately get activated when ;; the function gets defined. ;; Automatic advice activation means, that whenever a function gets defined ;; with either `defun', `defmacro', `fset' or by loading a byte-compiled ;; file, and the function has some advice-info stored with it then that ;; advice will get activated right away. ;; @@@ Enabling automatic advice activation: ;; ========================================= ;; Automatic advice activation is enabled by default. It can be disabled by ;; doint `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'. ;; @@ Caching of advised definitions: ;; ================================== ;; After an advised definition got constructed it gets cached as part of the ;; advised function's advice-info so it can be reused, for example, after an ;; intermediate deactivation. Because the advice-info of a function might ;; change between the time of caching and reuse a cached definition gets ;; a cache-id associated with it so it can be verified whether the cached ;; definition is still valid (the main application of this is preactivation ;; - see below). ;; When an advised function gets activated and a verifiable cached definition ;; is available, then that definition will be used instead of creating a new ;; advised definition from scratch. If you want to make sure that a new ;; definition gets constructed then you should use `ad-clear-cache' before you ;; activate the advised function. ;; @@ Preactivation: ;; ================= ;; Constructing an advised definition is moderately expensive. In a situation ;; where one package defines a lot of advised functions it might be ;; prohibitively expensive to do all the advised definition construction at ;; runtime. Preactivation is a mechanism that allows compile-time construction ;; of compiled advised definitions that can be activated cheaply during ;; runtime. Preactivation uses the caching mechanism to do that. Here's how it ;; works: ;; When the byte-compiler compiles a `defadvice' that has the `preactivate' ;; flag specified, it uses the current original definition of the advised ;; function plus the advice specified in this `defadvice' (even if it is ;; specified as disabled) and all other currently enabled pieces of advice to ;; construct an advised definition and an identifying cache-id and makes them ;; part of the `defadvice' expansion which will then be compiled by the ;; byte-compiler (to ensure that in a v18 emacs you have to put the ;; `defadvice' inside a `defun' to get it compiled and then you have to call ;; that compiled `defun' in order to actually execute the `defadvice'). When ;; the file with the compiled, preactivating `defadvice' gets loaded the ;; precompiled advised definition will be cached on the advised function's ;; advice-info. When it gets activated (can be immediately on execution of the ;; `defadvice' or any time later) the cache-id gets checked against the ;; current state of advice and if it is verified the precompiled definition ;; will be used directly (the verification is pretty cheap). If it couldn't get ;; verified a new advised definition for that function will be built from ;; scratch, hence, the efficiency added by the preactivation mechanism does ;; not at all impair the flexibility of the advice mechanism. ;; MORAL: In order get all the efficiency out of preactivation the advice ;; state of an advised function at the time the file with the ;; preactivating `defadvice' gets byte-compiled should be exactly ;; the same as it will be when the advice of that function gets ;; actually activated. If it is not there is a high chance that the ;; cache-id will not match and hence a new advised definition will ;; have to be constructed at runtime. ;; Preactivation and forward advice do not contradict each other. It is ;; perfectly ok to load a file with a preactivating `defadvice' before the ;; original definition of the advised function is available. The constructed ;; advised definition will be used once the original function gets defined and ;; its advice gets activated. The only constraint is that at the time the ;; file with the preactivating `defadvice' got compiled the original function ;; definition was available. ;; TIPS: Here are some indications that a preactivation did not work the way ;; you intended it to work: ;; - Activation of the advised function takes longer than usual/expected ;; - The byte-compiler gets loaded while an advised function gets ;; activated ;; - `byte-compile' is part of the `features' variable even though you ;; did not use the byte-compiler ;; Right now advice does not provide an elegant way to find out whether ;; and why a preactivation failed. What you can do is to trace the ;; function `ad-cache-id-verification-code' (with the function ;; `trace-function-background' defined in my trace.el package) before ;; any of your advised functions get activated. After they got ;; activated check whether all calls to `ad-cache-id-verification-code' ;; returned `verified' as a result. Other values indicate why the ;; verification failed which should give you enough information to ;; fix your preactivation/compile/load/activation sequence. ;; IMPORTANT: There is one case (that I am aware of) that can make ;; preactivation fail, i.e., a preconstructed advised definition that does ;; NOT match the current state of advice gets used nevertheless. That case ;; arises if one package defines a certain piece of advice which gets used ;; during preactivation, and another package incompatibly redefines that ;; very advice (i.e., same function/class/name), and it is the second advice ;; that is available when the preconstructed definition gets activated, and ;; that was the only definition of that advice so far (`ad-add-advice' ;; catches advice redefinitions and clears the cache in such a case). ;; Catching that would make the cache verification too expensive. ;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with ;; George Walker Bush), and why would you redefine your own advice anyway? ;; Advice is a mechanism to facilitate function redefinition, not advice ;; redefinition (wait until I write Meta-Advice :-). If you really have ;; to undo somebody else's advice try to write a "neutralizing" advice. ;; @@ Advising macros and special forms and other dangerous things: ;; ================================================================ ;; Look at the corresponding tutorial sections for more information on ;; these topics. Here it suffices to point out that the special treatment ;; of macros and special forms by the byte-compiler can lead to problems ;; when they get advised. Macros can create problems because they get ;; expanded at compile time, hence, they might not have all the necessary ;; runtime support and such advice cannot be de/activated or changed as ;; it is possible for functions. Special forms create problems because they ;; have to be advised "into" macros, i.e., an advised special form is a ;; implemented as a macro, hence, in most cases the byte-compiler will ;; not recognize it as a special form anymore which can lead to very strange ;; results. ;; ;; MORAL: - Only advise macros or special forms when you are absolutely sure ;; what you are doing. ;; - As a safety measure, always do `ad-deactivate-all' before you ;; byte-compile a file to make sure that even if some inconsiderate ;; person advised some special forms you'll get proper compilation ;; results. After compilation do `ad-activate-all' to get back to ;; the previous state. ;; @@ Adding a piece of advice with `ad-add-advice': ;; ================================================= ;; The non-interactive function `ad-add-advice' can be used to add a piece of ;; advice to some function without using `defadvice'. This is useful if advice ;; has to be added somewhere by a function (also look at `ad-make-advice'). ;; @@ Activation/deactivation advices, file load hooks: ;; ==================================================== ;; There are two special classes of advice called `activation' and ;; `deactivation'. The body forms of these advices are not included into the ;; advised definition of a function, rather they are assembled into a hook ;; form which will be evaluated whenever the advice-info of the advised ;; function gets activated or deactivated. One application of this mechanism ;; is to define file load hooks for files that do not provide such hooks ;; (v19s already come with a general file-load-hook mechanism, v18s don't). ;; For example, suppose you want to print a message whenever `file-x' gets ;; loaded, and suppose the last function defined in `file-x' is ;; `file-x-last-fn'. Then we can define the following advice: ;; ;; (defadvice file-x-last-fn (activation file-x-load-hook) ;; "Executed whenever file-x is loaded" ;; (if load-in-progress (message "Loaded file-x"))) ;; ;; This will constitute a forward advice for function `file-x-last-fn' which ;; will get activated when `file-x' is loaded (only if forward advice is ;; enabled of course). Because there are no "real" pieces of advice ;; available for it, its definition will not be changed, but the activation ;; advice will be run during its activation which is equivalent to having a ;; file load hook for `file-x'. ;; @@ Summary of main advice concepts: ;; =================================== ;; - Definition: ;; A piece of advice gets defined with `defadvice' and added to the ;; `advice-info' property of a function. ;; - Enablement: ;; Every piece of advice has an enablement flag associated with it. Only ;; enabled advices are considered during construction of an advised ;; definition. ;; - Activation: ;; Redefine an advised function with its advised definition. Constructs ;; an advised definition from scratch if no verifiable cached advised ;; definition is available and caches it. ;; - Deactivation: ;; Back-define an advised function to its original definition. ;; - Update: ;; Reactivate an advised function but only if its advice is currently ;; active. This can be used to bring all currently advised function up ;; to date with the current state of advice without also activating ;; currently deactivated functions. ;; - Caching: ;; Is the saving of an advised definition and an identifying cache-id so ;; it can be reused, for example, for activation after deactivation. ;; - Preactivation: ;; Is the construction of an advised definition according to the current ;; state of advice during byte-compilation of a file with a preactivating ;; `defadvice'. That advised definition can then rather cheaply be used ;; during activation without having to construct an advised definition ;; from scratch at runtime. ;; @@ Summary of interactive advice manipulation functions: ;; ======================================================== ;; The following interactive functions can be used to manipulate the state ;; of advised functions (all of them support completion on function names, ;; advice classes and advice names): ;; - ad-activate to activate the advice of a FUNCTION ;; - ad-deactivate to deactivate the advice of a FUNCTION ;; - ad-update to activate the advice of a FUNCTION unless it was not ;; yet activated or is currently deactivated. ;; - ad-unadvise deactivates a FUNCTION and removes all of its advice ;; information, hence, it cannot be activated again ;; - ad-recover tries to redefine a FUNCTION to its original definition and ;; discards all advice information (a low-level `ad-unadvise'). ;; Use only in emergencies. ;; - ad-remove-advice removes a particular piece of advice of a FUNCTION. ;; You still have to do call `ad-activate' or `ad-update' to ;; activate the new state of advice. ;; - ad-enable-advice enables a particular piece of advice of a FUNCTION. ;; - ad-disable-advice disables a particular piece of advice of a FUNCTION. ;; - ad-enable-regexp maps over all currently advised functions and enables ;; every advice whose name contains a match for a regular ;; expression. ;; - ad-disable-regexp disables matching advices. ;; - ad-activate-regexp activates all advised function with a matching advice ;; - ad-deactivate-regexp deactivates all advised function with matching advice ;; - ad-update-regexp updates all advised function with a matching advice ;; - ad-activate-all activates all advised functions ;; - ad-deactivate-all deactivates all advised functions ;; - ad-update-all updates all advised functions ;; - ad-unadvise-all unadvises all advised functions ;; - ad-recover-all recovers all advised functions ;; - ad-compile byte-compiles a function/macro if it is compilable. ;; @@ Summary of forms with special meanings when used within an advice: ;; ===================================================================== ;; ad-return-value name of the return value variable (get/settable) ;; ad-subr-args name of &rest argument variable used for advised ;; subrs whose actual argument list cannot be ;; determined (get/settable) ;; (ad-get-arg ), (ad-get-args ), ;; (ad-set-arg ), (ad-set-args ) ;; argument access text macros to get/set the values of ;; actual arguments at a certain position ;; ad-arg-bindings text macro that returns the actual names, values ;; and types of the arguments as a list of bindings. The ;; order of the bindings corresponds to the order of the ;; arguments. The individual fields of every binding (name, ;; value and type) can be accessed with the function ;; `ad-arg-binding-field' (see example above). ;; ad-do-it text macro that identifies the place where the original ;; or wrapped definition should go in an around advice ;; @ Foo games: An advice tutorial ;; =============================== ;; The following tutorial was created in Emacs 18.59. Left-justified ;; s-expressions are input forms followed by one or more result forms. ;; First we have to start the advice magic: ;; ;; (ad-start-advice) ;; nil ;; ;; We start by defining an innocent looking function `foo' that simply ;; adds 1 to its argument X: ;; ;; (defun foo (x) ;; "Add 1 to X." ;; (1+ x)) ;; foo ;; ;; (foo 3) ;; 4 ;; ;; @@ Defining a simple piece of advice: ;; ===================================== ;; Now let's define the first piece of advice for `foo'. To do that we ;; use the macro `defadvice' which takes a function name, a list of advice ;; specifiers and a list of body forms as arguments. The first element of ;; the advice specifiers is the class of the advice, the second is its name, ;; the third its position and the rest are some flags. The class of our ;; first advice is `before', its name is `fg-add2', its position among the ;; currently defined before advices (none so far) is `first', and the advice ;; will be `activate'ed immediately. Advice names are global symbols, hence, ;; the name space conventions used for function names should be applied. All ;; advice names in this tutorial will be prefixed with `fg' for `Foo Games' ;; (because everybody has the right to be inconsistent all the function names ;; used in this tutorial do NOT follow this convention). ;; ;; In the body of an advice we can refer to the argument variables of the ;; original function by name. Here we add 1 to X so the effect of calling ;; `foo' will be to actually add 2. All of the advice definitions below only ;; have one body form for simplicity, but there is no restriction to that ;; extent. Every piece of advice can have a documentation string which will ;; be combined with the documentation of the original function. ;; ;; (defadvice foo (before fg-add2 first activate) ;; "Add 2 to X." ;; (setq x (1+ x))) ;; foo ;; ;; (foo 3) ;; 5 ;; ;; @@ Specifying the position of an advice: ;; ======================================== ;; Now we define the second before advice which will cancel the effect of ;; the previous advice. This time we specify the position as 0 which is ;; equivalent to `first'. A number can be used to specify the zero-based ;; position of an advice among the list of advices in the same class. This ;; time we already have one before advice hence the position specification ;; actually has an effect. So, after the following definition the position ;; of the previous advice will be 1 even though we specified it with `first' ;; above, the reason for this is that the position argument is relative to ;; the currently defined pieces of advice which by now has changed. ;; ;; (defadvice foo (before fg-cancel-add2 0 activate) ;; "Again only add 1 to X." ;; (setq x (1- x))) ;; foo ;; ;; (foo 3) ;; 4 ;; ;; @@ Redefining a piece of advice: ;; ================================ ;; Now we define an advice with the same class and same name but with a ;; different position. Defining an advice in a class in which an advice with ;; that name already exists is interpreted as a redefinition of that ;; particular advice, in which case the position argument will be ignored ;; and the previous position of the redefined piece of advice is used. ;; Advice flags can be specified with non-ambiguous initial substrings, hence, ;; from now on we'll use `act' instead of the verbose `activate'. ;; ;; (defadvice foo (before fg-cancel-add2 last act) ;; "Again only add 1 to X." ;; (setq x (1- x))) ;; foo ;; ;; @@ Assembly of advised documentation: ;; ===================================== ;; The documentation strings of the various pieces of advice are assembled ;; in order which shows that advice `fg-cancel-add2' is still the first ;; `before' advice even though we specified position `last' above: ;; ;; (documentation 'foo) ;; "Add 1 to X. ;; ;; This function is advised with the following advice(s): ;; ;; fg-cancel-add2 (before): ;; Again only add 1 to X. ;; ;; fg-add2 (before): ;; Add 2 to X." ;; ;; @@ Advising interactive behavior: ;; ================================= ;; We can make a function interactive (or change its interactive behavior) ;; by specifying an interactive form in one of the before or around ;; advices (there could also be body forms in this advice). The particular ;; definition always assigns 5 as an argument to X which gives us 6 as a ;; result when we call foo interactively: ;; ;; (defadvice foo (before fg-inter last act) ;; "Use 5 as argument when called interactively." ;; (interactive (list 5))) ;; foo ;; ;; (call-interactively 'foo) ;; 6 ;; ;; If more than one advice have an interactive declaration, then the one of ;; the advice with the smallest position will be used (before advices go ;; before around and after advices), hence, the declaration below does ;; not have any effect: ;; ;; (defadvice foo (before fg-inter2 last act) ;; (interactive (list 6))) ;; foo ;; ;; (call-interactively 'foo) ;; 6 ;; ;; Let's have a look at what the definition of `foo' looks like now ;; (indentation added by hand for legibility): ;; ;; (symbol-function 'foo) ;; (lambda (x) ;; "$ad-doc: foo$" ;; (interactive (list 5)) ;; (let (ad-return-value) ;; (setq x (1- x)) ;; (setq x (1+ x)) ;; (setq ad-return-value (ad-Orig-foo x)) ;; ad-return-value)) ;; ;; @@ Around advices: ;; ================== ;; Now we'll try some `around' advices. An around advice is a wrapper around ;; the original definition. It can shadow or establish bindings for the ;; original definition, and it can look at and manipulate the value returned ;; by the original function. The position of the special keyword `ad-do-it' ;; specifies where the code of the original function will be executed. The ;; keyword can appear multiple times which will result in multiple calls of ;; the original function in the resulting advised code. Note, that if we don't ;; specify a position argument (i.e., `first', `last' or a number), then ;; `first' (or 0) is the default): ;; ;; (defadvice foo (around fg-times-2 act) ;; "First double X." ;; (let ((x (* x 2))) ;; ad-do-it)) ;; foo ;; ;; (foo 3) ;; 7 ;; ;; Around advices are assembled like onion skins where the around advice ;; with position 0 is the outermost skin and the advice at the last position ;; is the innermost skin which is directly wrapped around the call of the ;; original definition of the function. Hence, after the next `defadvice' we ;; will first multiply X by 2 then add 1 and then call the original ;; definition (i.e., add 1 again): ;; ;; (defadvice foo (around fg-add-1 last act) ;; "Add 1 to X." ;; (let ((x (1+ x))) ;; ad-do-it)) ;; foo ;; ;; (foo 3) ;; 8 ;; ;; Again, let's see what the definition of `foo' looks like so far: ;; ;; (symbol-function 'foo) ;; (lambda (x) ;; "$ad-doc: foo$" ;; (interactive (list 5)) ;; (let (ad-return-value) ;; (setq x (1- x)) ;; (setq x (1+ x)) ;; (let ((x (* x 2))) ;; (let ((x (1+ x))) ;; (setq ad-return-value (ad-Orig-foo x)))) ;; ad-return-value)) ;; ;; @@ Controlling advice activation: ;; ================================= ;; In every `defadvice' so far we have used the flag `activate' to activate ;; the advice immediately after its definition, and that's what we want in ;; most cases. However, if we define multiple pieces of advice for a single ;; function then activating every advice immediately is inefficient. A ;; better way to do this is to only activate the last defined advice. ;; For example: ;; ;; (defadvice foo (after fg-times-x) ;; "Multiply the result with X." ;; (setq ad-return-value (* ad-return-value x))) ;; foo ;; ;; This still yields the same result as before: ;; (foo 3) ;; 8 ;; ;; Now we define another advice and activate which will also activate the ;; previous advice `fg-times-x'. Note the use of the special variable ;; `ad-return-value' in the body of the advice which is set to the result of ;; the original function. If we change its value then the value returned by ;; the advised function will be changed accordingly: ;; ;; (defadvice foo (after fg-times-x-again act) ;; "Again multiply the result with X." ;; (setq ad-return-value (* ad-return-value x))) ;; foo ;; ;; Now the advices have an effect: ;; ;; (foo 3) ;; 72 ;; ;; @@ Protecting advice execution: ;; =============================== ;; Once in a while we define an advice to perform some cleanup action, ;; for example: ;; ;; (defadvice foo (after fg-cleanup last act) ;; "Do some cleanup." ;; (print "Let's clean up now!")) ;; foo ;; ;; However, in case of an error the cleanup won't be performed: ;; ;; (condition-case error ;; (foo t) ;; (error 'error-in-foo)) ;; error-in-foo ;; ;; To make sure a certain piece of advice gets executed even if some error or ;; non-local exit occurred in any preceding code, we can protect it by using ;; the `protect' keyword. (if any of the around advices is protected then the ;; whole around advice onion will be protected): ;; ;; (defadvice foo (after fg-cleanup prot act) ;; "Do some protected cleanup." ;; (print "Let's clean up now!")) ;; foo ;; ;; Now the cleanup form will be executed even in case of an error: ;; ;; (condition-case error ;; (foo t) ;; (error 'error-in-foo)) ;; "Let's clean up now!" ;; error-in-foo ;; ;; Again, let's see what `foo' looks like: ;; ;; (symbol-function 'foo) ;; (lambda (x) ;; "$ad-doc: foo$" ;; (interactive (list 5)) ;; (let (ad-return-value) ;; (unwind-protect ;; (progn (setq x (1- x)) ;; (setq x (1+ x)) ;; (let ((x (* x 2))) ;; (let ((x (1+ x))) ;; (setq ad-return-value (ad-Orig-foo x)))) ;; (setq ad-return-value (* ad-return-value x)) ;; (setq ad-return-value (* ad-return-value x))) ;; (print "Let's clean up now!")) ;; ad-return-value)) ;; ;; @@ Compilation of advised definitions: ;; ====================================== ;; Finally, we can specify the `compile' keyword in a `defadvice' to say ;; that we want the resulting advised function to be byte-compiled ;; (`compile' will be ignored unless we also specified `activate'): ;; ;; (defadvice foo (after fg-cleanup prot act comp) ;; "Do some protected cleanup." ;; (print "Let's clean up now!")) ;; foo ;; ;; Now `foo' is byte-compiled: ;; ;; (symbol-function 'foo) ;; (lambda (x) ;; "$ad-doc: foo$" ;; (interactive (byte-code "....." [5] 1)) ;; (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6)) ;; ;; (foo 3) ;; "Let's clean up now!" ;; 72 ;; ;; @@ Enabling and disabling pieces of advice: ;; =========================================== ;; Once in a while it is desirable to temporarily disable a piece of advice ;; so that it won't be considered during activation, for example, if two ;; different packages advise the same function and one wants to temporarily ;; neutralize the effect of the advice of one of the packages. ;; ;; The following disables the after advice `fg-times-x' in the function `foo'. ;; All that does is to change a flag for this particular advice. All the ;; other information defining it will be left unchanged (e.g., its relative ;; position in this advice class, etc.). ;; ;; (ad-disable-advice 'foo 'after 'fg-times-x) ;; nil ;; ;; For this to have an effect we have to activate `foo': ;; ;; (ad-activate 'foo) ;; foo ;; ;; (foo 3) ;; "Let's clean up now!" ;; 24 ;; ;; If we want to disable all multiplication advices in `foo' we can use a ;; regular expression that matches the names of such advices. Actually, any ;; advice name that contains a match for the regular expression will be ;; called a match. A special advice class `any' can be used to consider ;; all advice classes: ;; ;; (ad-disable-advice 'foo 'any "^fg-.*times") ;; nil ;; ;; (ad-activate 'foo) ;; foo ;; ;; (foo 3) ;; "Let's clean up now!" ;; 5 ;; ;; To enable the disabled advice we could use either `ad-enable-advice' ;; similar to `ad-disable-advice', or as an alternative `ad-enable-regexp' ;; which will enable matching advices in ALL currently advised functions. ;; Hence, this can be used to dis/enable advices made by a particular ;; package to a set of functions as long as that package obeys standard ;; advice name conventions. We prefixed all advice names with `fg-', hence ;; the following will do the trick (`ad-enable-regexp' returns the number ;; of matched advices): ;; ;; (ad-enable-regexp "^fg-") ;; 9 ;; ;; The following will activate all currently active advised functions that ;; contain some advice matched by the regular expression. This is a save ;; way to update the activation of advised functions whose advice changed ;; in some way or other without accidentally also activating currently ;; deactivated functions: ;; ;; (ad-update-regexp "^fg-") ;; nil ;; ;; (foo 3) ;; "Let's clean up now!" ;; 72 ;; ;; Another use for the dis/enablement mechanism is to define a piece of advice ;; and keep it "dormant" until a particular condition is satisfied, i.e., until ;; then the advice will not be used during activation. The `disable' flag lets ;; one do that with `defadvice': ;; ;; (defadvice foo (before fg-1-more dis) ;; "Add yet 1 more." ;; (setq x (1+ x))) ;; foo ;; ;; (ad-activate 'foo) ;; foo ;; ;; (foo 3) ;; "Let's clean up now!" ;; 72 ;; ;; (ad-enable-advice 'foo 'before 'fg-1-more) ;; nil ;; ;; (ad-activate 'foo) ;; foo ;; ;; (foo 3) ;; "Let's clean up now!" ;; 160 ;; ;; @@ Caching: ;; =========== ;; Advised definitions get cached to allow efficient activation/deactivation ;; without having to reconstruct them if nothing in the advice-info of a ;; function has changed. The following idiom can be used to temporarily ;; deactivate functions that have a piece of advice defined by a certain ;; package (we save the old definition to check out caching): ;; ;; (setq old-definition (symbol-function 'foo)) ;; (lambda (x) ....) ;; ;; (ad-deactivate-regexp "^fg-") ;; nil ;; ;; (foo 3) ;; 4 ;; ;; (ad-activate-regexp "^fg-") ;; nil ;; ;; (eq old-definition (symbol-function 'foo)) ;; t ;; ;; (foo 3) ;; "Let's clean up now!" ;; 160 ;; ;; @@ Forward advice: ;; ================== ;; To enable automatic activation of forward advice we first have to set ;; `ad-activate-on-definition' to t and restart advice: ;; ;; (setq ad-activate-on-definition t) ;; t ;; ;; (ad-start-advice) ;; (ad-activate-defined-function) ;; ;; Let's define a piece of advice for an undefined function: ;; ;; (defadvice bar (before fg-sub-1-more act) ;; "Subtract one more from X." ;; (setq x (1- x))) ;; bar ;; ;; `bar' is not yet defined: ;; (fboundp 'bar) ;; nil ;; ;; Now we define it and the forward advice will get activated (only because ;; `ad-activate-on-definition' was t when we started advice above with ;; `ad-start-advice'): ;; ;; (defun bar (x) ;; "Subtract 1 from X." ;; (1- x)) ;; bar ;; ;; (bar 4) ;; 2 ;; ;; Redefinition will activate any available advice if the value of ;; `ad-redefinition-action' is either `warn', `accept' or `discard': ;; ;; (defun bar (x) ;; "Subtract 2 from X." ;; (- x 2)) ;; bar ;; ;; (bar 4) ;; 1 ;; ;; @@ Preactivation: ;; ================= ;; Constructing advised definitions is moderately expensive, hence, it is ;; desirable to have a way to construct them at byte-compile time. ;; Preactivation is a mechanism that allows one to do that. ;; ;; (defun fie (x) ;; "Multiply X by 2." ;; (* x 2)) ;; fie ;; ;; (defadvice fie (before fg-times-4 preact) ;; "Multiply X by 4." ;; (setq x (* x 2))) ;; fie ;; ;; This advice did not affect `fie'... ;; ;; (fie 2) ;; 4 ;; ;; ...but it constructed a cached definition that will be used once `fie' gets ;; activated as long as its current advice state is the same as it was during ;; preactivation: ;; ;; (setq cached-definition (ad-get-cache-definition 'fie)) ;; (lambda (x) ....) ;; ;; (ad-activate 'fie) ;; fie ;; ;; (eq cached-definition (symbol-function 'fie)) ;; t ;; ;; (fie 2) ;; 8 ;; ;; If you put a preactivating `defadvice' into a Lisp file that gets byte- ;; compiled then the constructed advised definition will get compiled by ;; the byte-compiler. For that to occur in a v18 emacs you have to put the ;; `defadvice' inside a `defun' because the v18 compiler does not compile ;; top-level forms other than `defun' or `defmacro', for example, ;; ;; (defun fg-defadvice-fum () ;; (defadvice fum (before fg-times-4 preact act) ;; "Multiply X by 4." ;; (setq x (* x 2)))) ;; fg-defadvice-fum ;; ;; So far, no `defadvice' for `fum' got executed, but when we compile ;; `fg-defadvice-fum' the `defadvice' will be expanded by the byte compiler. ;; In order for preactivation to be effective we have to have a proper ;; definition of `fum' around at preactivation time, hence, we define it now: ;; ;; (defun fum (x) ;; "Multiply X by 2." ;; (* x 2)) ;; fum ;; ;; Now we compile the defining function which will construct an advised ;; definition during expansion of the `defadvice', compile it and store it ;; as part of the compiled `fg-defadvice-fum': ;; ;; (ad-compile-function 'fg-defadvice-fum) ;; (lambda nil (byte-code ...)) ;; ;; `fum' is still completely unaffected: ;; ;; (fum 2) ;; 4 ;; ;; (ad-get-advice-info 'fum) ;; nil ;; ;; (fg-defadvice-fum) ;; fum ;; ;; Now the advised version of `fum' is compiled because the compiled definition ;; constructed during preactivation was used, even though we did not specify ;; the `compile' flag: ;; ;; (symbol-function 'fum) ;; (lambda (x) ;; "$ad-doc: fum$" ;; (byte-code "....." [ad-return-value x nil * 2 ad-Orig-fum] 4)) ;; ;; (fum 2) ;; 8 ;; ;; A preactivated definition will only be used if it matches the current ;; function definition and advice information. If it does not match it ;; will simply be discarded and a new advised definition will be constructed ;; from scratch. For example, let's first remove all advice-info for `fum': ;; ;; (ad-unadvise 'fum) ;; (("fie") ("bar") ("foo") ...) ;; ;; And now define a new piece of advice: ;; ;; (defadvice fum (before fg-interactive act) ;; "Make fum interactive." ;; (interactive "nEnter x: ")) ;; fum ;; ;; When we now try to use a preactivation it will not be used because the ;; current advice state is different from the one at preactivation time. This ;; is no tragedy, everything will work as expected just not as efficient, ;; because a new advised definition has to be constructed from scratch: ;; ;; (fg-defadvice-fum) ;; fum ;; ;; A new uncompiled advised definition got constructed: ;; ;; (ad-compiled-p (symbol-function 'fum)) ;; nil ;; ;; (fum 2) ;; 8 ;; ;; MORAL: To get all the efficiency out of preactivation the function ;; definition and advice state at preactivation time must be the same as the ;; state at activation time. Preactivation does work with forward advice, all ;; that's necessary is that the definition of the forward advised function is ;; available when the `defadvice' with the preactivation gets compiled. ;; ;; @@ Portable argument access: ;; ============================ ;; So far, we always used the actual argument variable names to access an ;; argument in a piece of advice. For many advice applications this is ;; perfectly ok and keeps advices simple. However, it decreases portability ;; of advices because it assumes specific argument variable names. For example, ;; if one advises a subr such as `eval-region' which then gets redefined by ;; some package (e.g., edebug) into a function with different argument names, ;; then a piece of advice written for `eval-region' that was written with ;; the subr arguments in mind will break. Similar situations arise when one ;; switches between major Emacs versions, e.g., certain subrs in v18 are ;; functions in v19 and vice versa. Also, in v19s subr argument lists ;; are available and will be used, while they are not available in v18. ;; ;; Argument access text macros allow one to access arguments of an advised ;; function in a portable way without having to worry about all these ;; possibilities. These macros will be translated into the proper access forms ;; at activation time, hence, argument access will be as efficient as if ;; the arguments had been used directly in the definition of the advice. ;; ;; (defun fuu (x y z) ;; "Add 3 numbers." ;; (+ x y z)) ;; fuu ;; ;; (fuu 1 1 1) ;; 3 ;; ;; Argument access macros specify actual arguments at a certain position. ;; Position 0 access the first actual argument, position 1 the second etc. ;; For example, the following advice adds 1 to each of the 3 arguments: ;; ;; (defadvice fuu (before fg-add-1-to-all act) ;; "Adds 1 to all arguments." ;; (ad-set-arg 0 (1+ (ad-get-arg 0))) ;; (ad-set-arg 1 (1+ (ad-get-arg 1))) ;; (ad-set-arg 2 (1+ (ad-get-arg 2)))) ;; fuu ;; ;; (fuu 1 1 1) ;; 6 ;; ;; Now suppose somebody redefines `fuu' with a rest argument. Our advice ;; will still work because we used access macros (note, that automatic ;; advice activation is still in effect, hence, the redefinition of `fuu' ;; will automatically activate all its advice): ;; ;; (defun fuu (&rest numbers) ;; "Add NUMBERS." ;; (apply '+ numbers)) ;; fuu ;; ;; (fuu 1 1 1) ;; 6 ;; ;; (fuu 1 1 1 1 1 1) ;; 9 ;; ;; What's important to notice is that argument access macros access actual ;; arguments regardless of how they got distributed onto argument variables. ;; In Emacs Lisp the semantics of an actual argument is determined purely ;; by position, hence, as long as nobody changes the semantics of what a ;; certain actual argument at a certain position means the access macros ;; will do the right thing. ;; ;; Because of &rest arguments we need a second kind of access macro that ;; can access all actual arguments starting from a certain position: ;; ;; (defadvice fuu (before fg-print-args act) ;; "Print all arguments." ;; (print (ad-get-args 0))) ;; fuu ;; ;; (fuu 1 2 3 4 5) ;; (1 2 3 4 5) ;; 18 ;; ;; (defadvice fuu (before fg-set-args act) ;; "Swaps 2nd and 3rd arg and discards all the rest." ;; (ad-set-args 1 (list (ad-get-arg 2) (ad-get-arg 1)))) ;; fuu ;; ;; (fuu 1 2 3 4 4 4 4 4 4) ;; (1 3 2) ;; 9 ;; ;; (defun fuu (x y z) ;; "Add 3 numbers." ;; (+ x y z)) ;; ;; (fuu 1 2 3) ;; (1 3 2) ;; 9 ;; ;; @@ Defining the argument list of an advised function: ;; ===================================================== ;; Once in a while it might be desirable to advise a function and additionally ;; give it an extra argument that controls the advised code, for example, one ;; might want to make an interactive function sensitive to a prefix argument. ;; For such cases `defadvice' allows the specification of an argument list ;; for the advised function. Similar to the redefinition of interactive ;; behavior, the first argument list specification found in the list of before/ ;; around/after advices will be used. Of course, the specified argument list ;; should be downward compatible with the original argument list, otherwise ;; functions that call the advised function with the original argument list ;; in mind will break. ;; ;; (defun fii (x) ;; "Add 1 to X." ;; (1+ x)) ;; fii ;; ;; Now we advise `fii' to use an optional second argument that controls the ;; amount of incrementation. A list following the (optional) position ;; argument of the advice will be interpreted as an argument list ;; specification. This means you cannot specify an empty argument list, and ;; why would you want to anyway? ;; ;; (defadvice fii (before fg-inc-x (x &optional incr) act) ;; "Increment X by INCR (default is 1)." ;; (setq x (+ x (1- (or incr 1))))) ;; fii ;; ;; (fii 3) ;; 4 ;; ;; (fii 3 2) ;; 5 ;; ;; @@ Specifying argument lists of subrs: ;; ====================================== ;; The argument lists of subrs cannot be determined directly from Lisp. ;; This means that Advice has to use `(&rest ad-subr-args)' as the ;; argument list of the advised subr which is not very efficient. In Lemacs ;; subr argument lists can be determined from their documentation string, in ;; Emacs-19 this is the case for some but not all subrs. To accommodate ;; for the cases where the argument lists cannot be determined (e.g., in a ;; v18 Emacs) Advice comes with a specification mechanism that allows the ;; advice programmer to tell advice what the argument list of a certain subr ;; really is. ;; ;; In a v18 Emacs the following will return the &rest idiom: ;; ;; (ad-arglist (symbol-function 'car)) ;; (&rest ad-subr-args) ;; ;; To tell advice what the argument list of `car' really is we ;; can do the following: ;; ;; (ad-define-subr-args 'car '(list)) ;; ((list)) ;; ;; Now `ad-arglist' will return the proper argument list (this method is ;; actually used by advice itself for the advised definition of `fset'): ;; ;; (ad-arglist (symbol-function 'car)) ;; (list) ;; ;; The defined argument list will be stored on the property list of the ;; subr name symbol. When advice looks for a subr argument list it first ;; checks for a definition on the property list, if that fails it tries ;; to infer it from the documentation string and caches it on the property ;; list if it was successful, otherwise `(&rest ad-subr-args)' will be used. ;; ;; @@ Advising interactive subrs: ;; ============================== ;; For the most part there is no difference between advising functions and ;; advising subrs. There is one situation though where one might have to write ;; slightly different advice code for subrs than for functions. This case ;; arises when one wants to access subr arguments in a before/around advice ;; when the arguments were determined by an interactive call to the subr. ;; Advice cannot determine what `interactive' form determines the interactive ;; behavior of the subr, hence, when it calls the original definition in an ;; interactive subr invocation it has to use `call-interactively' to generate ;; the proper interactive behavior. Thus up to that call the arguments of the ;; interactive subr will be nil. For example, the following advice for ;; `kill-buffer' will not work in an interactive invocation... ;; ;; (defadvice kill-buffer (before fg-kill-buffer-hook first act preact comp) ;; (my-before-kill-buffer-hook (ad-get-arg 0))) ;; kill-buffer ;; ;; ...because the buffer argument will be nil in that case. The way out of ;; this dilemma is to provide an `interactive' specification that mirrors ;; the interactive behavior of the unadvised subr, for example, the following ;; will do the right thing even when `kill-buffer' is called interactively: ;; ;; (defadvice kill-buffer (before fg-kill-buffer-hook first act preact comp) ;; (interactive "bKill buffer: ") ;; (my-before-kill-buffer-hook (ad-get-arg 0))) ;; kill-buffer ;; ;; @@ Advising macros: ;; =================== ;; Advising macros is slightly different because there are two significant ;; time points in the invocation of a macro: Expansion and evaluation time. ;; For an advised macro instead of evaluating the original definition we ;; use `macroexpand', that is, changing argument values and binding ;; environments by pieces of advice has an affect during macro expansion ;; but not necessarily during evaluation. In particular, any side effects ;; of pieces of advice will occur during macro expansion. To also affect ;; the behavior during evaluation time one has to change the value of ;; `ad-return-value' in a piece of after advice. For example: ;; ;; (defmacro foom (x) ;; (` (list (, x)))) ;; foom ;; ;; (foom '(a)) ;; ((a)) ;; ;; (defadvice foom (before fg-print-x act) ;; "Print the value of X." ;; (print x)) ;; foom ;; ;; The following works as expected because evaluation immediately follows ;; macro expansion: ;; ;; (foom '(a)) ;; (quote (a)) ;; ((a)) ;; ;; However, the printing happens during expansion (or byte-compile) time: ;; ;; (macroexpand '(foom '(a))) ;; (quote (a)) ;; (list (quote (a))) ;; ;; If we want it to happen during evaluation time we have to do the ;; following (first remove the old advice): ;; ;; (ad-remove-advice 'foom 'before 'fg-print-x) ;; nil ;; ;; (defadvice foom (after fg-print-x act) ;; "Print the value of X." ;; (setq ad-return-value ;; (` (progn (print (, x)) ;; (, ad-return-value))))) ;; foom ;; ;; (macroexpand '(foom '(a))) ;; (progn (print (quote (a))) (list (quote (a)))) ;; ;; (foom '(a)) ;; (a) ;; ((a)) ;; ;; While this method might seem somewhat cumbersome, it is very general ;; because it allows one to influence macro expansion as well as evaluation. ;; In general, advising macros should be a rather rare activity anyway, in ;; particular, because compile-time macro expansion takes away a lot of the ;; flexibility and effectiveness of the advice mechanism. Macros that were ;; compile-time expanded before the advice was activated will of course never ;; exhibit the advised behavior. ;; ;; @@ Advising special forms: ;; ========================== ;; Now for something that should be even more rare than advising macros: ;; Advising special forms. Because special forms are irregular in their ;; argument evaluation behavior (e.g., `setq' evaluates the second but not ;; the first argument) they have to be advised into macros. A dangerous ;; consequence of this is that the byte-compiler will not recognize them ;; as special forms anymore (well, in most cases) and use their expansion ;; rather than the proper byte-code. Also, because the original definition ;; of a special form cannot be `funcall'ed, `eval' has to be used instead ;; which is less efficient. ;; ;; MORAL: Do not advise special forms unless you are completely sure about ;; what you are doing (some of the forward advice behavior is ;; implemented via advice of the special forms `defun' and `defmacro'). ;; As a safety measure one should always do `ad-deactivate-all' before ;; one byte-compiles a file to avoid any interference of advised ;; special forms. ;; ;; Apart from the safety concerns advising special forms is not any different ;; from advising plain functions or subrs. ;;; Code: ;; @ Advice implementation: ;; ======================== ;; @@ Compilation idiosyncrasies: ;; ============================== ;; `defadvice' expansion needs quite a few advice functions and variables, ;; hence, I need to preload the file before it can be compiled. To avoid ;; interference of bogus compiled files I always preload the source file: (provide 'advice-preload) ;; During a normal load this is a noop: (require 'advice-preload "advice.el") (defmacro ad-lemacs-p () ;;Expands into Non-nil constant if we run Lucid's version of Emacs-19. ;;Unselected conditional code will be optimized away during compilation. (string-match "Lucid" emacs-version)) ;; @@ Variable definitions: ;; ======================== (defconst ad-version "2.14") ;;;###autoload (defvar ad-redefinition-action 'warn "*Defines what to do with redefinitions during Advice de/activation. Redefinition occurs if a previously activated function that already has an original definition associated with it gets redefined and then de/activated. In such a case we can either accept the current definition as the new original definition, discard the current definition and replace it with the old original, or keep it and raise an error. The values `accept', `discard', `error' or `warn' govern what will be done. `warn' is just like `accept' but it additionally prints a warning message. All other values will be interpreted as `error'.") ;;;###autoload (defvar ad-default-compilation-action 'maybe "*Defines whether to compile advised definitions during activation. A value of `always' will result in unconditional compilation, `never' will always avoid compilation, `maybe' will compile if the byte-compiler is already loaded, and `like-original' will compile if the original definition of the advised function is compiled or a built-in function. Every other value will be interpreted as `maybe'. This variable will only be considered if the COMPILE argument of `ad-activate' was supplied as nil.") ;; @@ Some utilities: ;; ================== ;; We don't want the local arguments to interfere with anything ;; referenced in the supplied functions => the cryptic casing: (defun ad-substitute-tree (sUbTrEe-TeSt fUnCtIoN tReE) ;;"Substitutes qualifying subTREEs with result of FUNCTION(subTREE). ;;Only proper subtrees are considered, for example, if TREE is (1 (2 (3)) 4) ;;then the subtrees will be 1 (2 (3)) 2 (3) 3 4, dotted structures are ;;allowed too. Once a qualifying subtree has been found its subtrees will ;;not be considered anymore. (ad-substitute-tree 'atom 'identity tree) ;;generates a copy of TREE." (cond ((consp tReE) (cons (if (funcall sUbTrEe-TeSt (car tReE)) (funcall fUnCtIoN (car tReE)) (if (consp (car tReE)) (ad-substitute-tree sUbTrEe-TeSt fUnCtIoN (car tReE)) (car tReE))) (ad-substitute-tree sUbTrEe-TeSt fUnCtIoN (cdr tReE)))) ((funcall sUbTrEe-TeSt tReE) (funcall fUnCtIoN tReE)) (t tReE))) ;; this is just faster than `ad-substitute-tree': (defun ad-copy-tree (tree) ;;"Returns a copy of the list structure of TREE." (cond ((consp tree) (cons (ad-copy-tree (car tree)) (ad-copy-tree (cdr tree)))) (t tree))) (defmacro ad-dolist (varform &rest body) "A Common-Lisp-style dolist iterator with the following syntax: (ad-dolist (VAR INIT-FORM [RESULT-FORM]) BODY-FORM...) which will iterate over the list yielded by INIT-FORM binding VAR to the current head at every iteration. If RESULT-FORM is supplied its value will be returned at the end of the iteration, nil otherwise. The iteration can be exited prematurely with `(ad-do-return [VALUE])'." (let ((expansion (` (let ((ad-dO-vAr (, (car (cdr varform)))) (, (car varform))) (while ad-dO-vAr (setq (, (car varform)) (car ad-dO-vAr)) (,@ body) ;;work around a backquote bug: ;;(` ((,@ '(foo)) (bar))) => (append '(foo) '(((bar)))) wrong ;;(` ((,@ '(foo)) (, '(bar)))) => (append '(foo) (list '(bar))) (, '(setq ad-dO-vAr (cdr ad-dO-vAr)))) (, (car (cdr (cdr varform)))))))) ;;ok, this wastes some cons cells but only during compilation: (if (catch 'contains-return (ad-substitute-tree (function (lambda (subtree) (cond ((eq (car-safe subtree) 'ad-dolist)) ((eq (car-safe subtree) 'ad-do-return) (throw 'contains-return t))))) 'identity body) nil) (` (catch 'ad-dO-eXiT (, expansion))) expansion))) (defmacro ad-do-return (value) (` (throw 'ad-dO-eXiT (, value)))) (if (not (get 'ad-dolist 'lisp-indent-hook)) (put 'ad-dolist 'lisp-indent-hook 1)) ;; @@ Save real definitions of subrs used by Advice: ;; ================================================= ;; Advice depends on the real, unmodified functionality of various subrs, ;; we save them here so advised versions will not interfere (eventually, ;; we will save all subrs used in code generated by Advice): (defmacro ad-save-real-definition (function) (let ((saved-function (intern (format "ad-real-%s" function)))) ;; Make sure the compiler is loaded during macro expansion: (require 'byte-compile "bytecomp") (` (if (not (fboundp '(, saved-function))) (progn (fset '(, saved-function) (symbol-function '(, function))) ;; Copy byte-compiler properties: (,@ (if (get function 'byte-compile) (` ((put '(, saved-function) 'byte-compile '(, (get function 'byte-compile))))))) (,@ (if (get function 'byte-opcode) (` ((put '(, saved-function) 'byte-opcode '(, (get function 'byte-opcode)))))))))))) (defun ad-save-real-definitions () ;; Macro expansion will hardcode the values of the various byte-compiler ;; properties into the compiled version of this function such that the ;; proper values will be available at runtime without loading the compiler: (ad-save-real-definition fset) (ad-save-real-definition documentation)) (ad-save-real-definitions) ;; @@ Advice info access fns: ;; ========================== ;; Advice information for a particular function is stored on the ;; advice-info property of the function symbol. It is stored as an ;; alist of the following format: ;; ;; ((active . t/nil) ;; (before adv1 adv2 ...) ;; (around adv1 adv2 ...) ;; (after adv1 adv2 ...) ;; (activation adv1 adv2 ...) ;; (deactivation adv1 adv2 ...) ;; (origname . ) ;; (cache . ( . ))) ;; List of currently advised though not necessarily activated functions ;; (this list is maintained as a completion table): (defvar ad-advised-functions nil) (defmacro ad-pushnew-advised-function (function) ;;"Add FUNCTION to `ad-advised-functions' unless its already there." (` (if (not (assoc (symbol-name (, function)) ad-advised-functions)) (setq ad-advised-functions (cons (list (symbol-name (, function))) ad-advised-functions))))) (defmacro ad-pop-advised-function (function) ;;"Remove FUNCTION from `ad-advised-functions'." (` (setq ad-advised-functions (delq (assoc (symbol-name (, function)) ad-advised-functions) ad-advised-functions)))) (defmacro ad-do-advised-functions (varform &rest body) ;;"`ad-dolist'-style iterator that maps over `ad-advised-functions'. ;; (ad-do-advised-functions (VAR [RESULT-FORM]) ;; BODY-FORM...) ;;Also see `ad-dolist'. On each iteration VAR will be bound to the ;;name of an advised function (a symbol)." (` (ad-dolist ((, (car varform)) ad-advised-functions (, (car (cdr varform)))) (setq (, (car varform)) (intern (car (, (car varform))))) (,@ body)))) (if (not (get 'ad-do-advised-functions 'lisp-indent-hook)) (put 'ad-do-advised-functions 'lisp-indent-hook 1)) (defmacro ad-get-advice-info (function) (` (get (, function) 'ad-advice-info))) (defmacro ad-set-advice-info (function advice-info) (` (put (, function) 'ad-advice-info (, advice-info)))) (defmacro ad-copy-advice-info (function) (` (ad-copy-tree (get (, function) 'ad-advice-info)))) (defmacro ad-is-advised (function) ;;"Returns non-nil if FUNCTION has any advice info associated with it. ;;This does not mean that the advice is also active." (list 'ad-get-advice-info function)) (defun ad-initialize-advice-info (function) ;;"Initializes the advice info for FUNCTION. ;;Assumes that FUNCTION has not yet been advised." (ad-pushnew-advised-function function) (ad-set-advice-info function (list (cons 'active nil)))) (defmacro ad-get-advice-info-field (function field) ;;"Retrieves the value of the advice info FIELD of FUNCTION." (` (cdr (assq (, field) (ad-get-advice-info (, function)))))) (defun ad-set-advice-info-field (function field value) ;;"Destructively modifies VALUE of the advice info FIELD of FUNCTION." (and (ad-is-advised function) (cond ((assq field (ad-get-advice-info function)) ;; A field with that name is already present: (rplacd (assq field (ad-get-advice-info function)) value)) (t;; otherwise, create a new field with that name: (nconc (ad-get-advice-info function) (list (cons field value))))))) ;; Don't make this a macro so we can use it as a predicate: (defun ad-is-active (function) ;;"non-nil if FUNCTION is advised and activated." (ad-get-advice-info-field function 'active)) ;; @@ Access fns for single pieces of advice and related predicates: ;; ================================================================= (defun ad-make-advice (name protect enable definition) "Constructs single piece of advice to be stored in some advice-info. NAME should be a non-nil symbol, PROTECT and ENABLE should each be either t or nil, and DEFINITION should be a list of the form `(advice lambda ARGLIST [DOCSTRING] [INTERACTIVE-FORM] BODY...)'." (list name protect enable definition)) ;; ad-find-advice uses the alist structure directly -> ;; change if this data structure changes!! (defmacro ad-advice-name (advice) (list 'car advice)) (defmacro ad-advice-protected (advice) (list 'nth 1 advice)) (defmacro ad-advice-enabled (advice) (list 'nth 2 advice)) (defmacro ad-advice-definition (advice) (list 'nth 3 advice)) (defun ad-advice-set-enabled (advice flag) (rplaca (cdr (cdr advice)) flag)) (defun ad-class-p (thing) (memq thing ad-advice-classes)) (defun ad-name-p (thing) (and thing (symbolp thing))) (defun ad-position-p (thing) (or (natnump thing) (memq thing '(first last)))) ;; @@ Advice access functions: ;; =========================== ;; List of defined advice classes: (defvar ad-advice-classes '(before around after activation deactivation)) (defun ad-has-enabled-advice (function class) ;;"True if at least one of FUNCTION's advices in CLASS is enabled." (ad-dolist (advice (ad-get-advice-info-field function class)) (if (ad-advice-enabled advice) (ad-do-return t)))) (defun ad-has-redefining-advice (function) ;;"True if FUNCTION's advice info defines at least 1 redefining advice. ;;Redefining advices affect the construction of an advised definition." (and (ad-is-advised function) (or (ad-has-enabled-advice function 'before) (ad-has-enabled-advice function 'around) (ad-has-enabled-advice function 'after)))) (defun ad-has-any-advice (function) ;;"True if the advice info of FUNCTION defines at least one advice." (and (ad-is-advised function) (ad-dolist (class ad-advice-classes nil) (if (ad-get-advice-info-field function class) (ad-do-return t))))) (defun ad-get-enabled-advices (function class) ;;"Returns the list of enabled advices of FUNCTION in CLASS." (let (enabled-advices) (ad-dolist (advice (ad-get-advice-info-field function class)) (if (ad-advice-enabled advice) (setq enabled-advices (cons advice enabled-advices)))) (reverse enabled-advices))) ;; @@ Dealing with automatic advice activation via `fset/defalias': ;; ================================================================ ;; Since Emacs 19.26 the built-in versions of `fset' and `defalias' ;; take care of automatic advice activation, hence, we don't have to ;; hack it anymore by advising `fset/defun/defmacro/byte-code/etc'. ;; The functionality of the new `fset' is as follows: ;; ;; fset(sym,newdef) ;; assign NEWDEF to SYM ;; if (get SYM 'ad-advice-info) ;; ad-activate(SYM, nil) ;; return (symbol-function SYM) ;; ;; Whether advised definitions created by automatic activations will be ;; compiled depends on the value of `ad-default-compilation-action'. ;; Since calling `ad-activate' in the built-in definition of `fset' can ;; create major disasters we have to be a bit careful. One precaution is ;; to provide a dummy definition for `ad-activate' which can be used to ;; turn off automatic advice activation (e.g., when `ad-stop-advice' or ;; `ad-recover-normality' are called). Another is to avoid recursive calls ;; to `ad-activate-on' by using `ad-with-auto-activation-disabled' where ;; appropriate, especially in a safe version of `fset'. ;; For now define `ad-activate' to the dummy definition: (defun ad-activate (function &optional compile) "Automatic advice activation is disabled. `ad-start-advice' enables it." nil) ;; This is just a copy of the above: (defun ad-activate-off (function &optional compile) "Automatic advice activation is disabled. `ad-start-advice' enables it." nil) ;; This will be t for top-level calls to `ad-activate-on': (defvar ad-activate-on-top-level t) (defmacro ad-with-auto-activation-disabled (&rest body) (` (let ((ad-activate-on-top-level nil)) (,@ body)))) (defun ad-safe-fset (symbol definition) ;; A safe `fset' which will never call `ad-activate' recursively. (ad-with-auto-activation-disabled (ad-real-fset symbol definition))) ;; @@ Access functions for original definitions: ;; ============================================ ;; The advice-info of an advised function contains its `origname' which is ;; a symbol that is fbound to the original definition available at the first ;; proper activation of the function after a legal re/definition. If the ;; original was defined via fcell indirection then `origname' will be defined ;; just so. Hence, to get hold of the actual original definition of a function ;; we need to use `ad-real-orig-definition'. (defun ad-make-origname (function) ;;"Makes name to be used to call the original FUNCTION." (intern (format "ad-Orig-%s" function))) (defmacro ad-get-orig-definition (function) (` (let ((origname (ad-get-advice-info-field (, function) 'origname))) (if (fboundp origname) (symbol-function origname))))) (defmacro ad-set-orig-definition (function definition) (` (ad-safe-fset (ad-get-advice-info-field function 'origname) (, definition)))) (defmacro ad-clear-orig-definition (function) (` (fmakunbound (ad-get-advice-info-field (, function) 'origname)))) ;; @@ Interactive input functions: ;; =============================== (defun ad-read-advised-function (&optional prompt predicate default) ;;"Reads name of advised function with completion from the minibuffer. ;;An optional PROMPT will be used to prompt for the function. PREDICATE ;;plays the same role as for `try-completion' (which see). DEFAULT will ;;be returned on empty input (defaults to the first advised function for ;;which PREDICATE returns non-nil)." (if (null ad-advised-functions) (error "ad-read-advised-function: There are no advised functions")) (setq default (or default (ad-do-advised-functions (function) (if (or (null predicate) (funcall predicate function)) (ad-do-return function))) (error "ad-read-advised-function: %s" "There are no qualifying advised functions"))) (let* ((ad-pReDiCaTe predicate) (function (completing-read (format "%s(default %s) " (or prompt "Function: ") default) ad-advised-functions (if predicate (function (lambda (function) ;; Oops, no closures - the joys of dynamic scoping: ;; `predicate' clashed with the `predicate' argument ;; of Lemacs' `completing-read'..... (funcall ad-pReDiCaTe (intern (car function)))))) t))) (if (equal function "") (if (ad-is-advised default) default (error "ad-read-advised-function: `%s' is not advised" default)) (intern function)))) (defvar ad-advice-class-completion-table (mapcar '(lambda (class) (list (symbol-name class))) ad-advice-classes)) (defun ad-read-advice-class (function &optional prompt default) ;;"Reads a legal advice class with completion from the minibuffer. ;;An optional PROMPT will be used to prompt for the class. DEFAULT will ;;be returned on empty input (defaults to the first non-empty advice ;;class of FUNCTION)." (setq default (or default (ad-dolist (class ad-advice-classes) (if (ad-get-advice-info-field function class) (ad-do-return class))) (error "ad-read-advice-class: `%s' has no advices" function))) (let ((class (completing-read (format "%s(default %s) " (or prompt "Class: ") default) ad-advice-class-completion-table nil t))) (if (equal class "") default (intern class)))) (defun ad-read-advice-name (function class &optional prompt) ;;"Reads name of existing advice of CLASS for FUNCTION with completion. ;;An optional PROMPT is used to prompt for the name." (let* ((name-completion-table (mapcar (function (lambda (advice) (list (symbol-name (ad-advice-name advice))))) (ad-get-advice-info-field function class))) (default (if (null name-completion-table) (error "ad-read-advice-name: `%s' has no %s advice" function class) (car (car name-completion-table)))) (prompt (format "%s(default %s) " (or prompt "Name: ") default)) (name (completing-read prompt name-completion-table nil t))) (if (equal name "") (intern default) (intern name)))) (defun ad-read-advice-specification (&optional prompt) ;;"Reads a complete function/class/name specification from minibuffer. ;;The list of read symbols will be returned. The optional PROMPT will ;;be used to prompt for the function." (let* ((function (ad-read-advised-function prompt)) (class (ad-read-advice-class function)) (name (ad-read-advice-name function class))) (list function class name))) ;; Use previous regexp as a default: (defvar ad-last-regexp "") (defun ad-read-regexp (&optional prompt) ;;"Reads a regular expression from the minibuffer." (let ((regexp (read-from-minibuffer (concat (or prompt "Regular expression: ") (if (equal ad-last-regexp "") "" (format "(default \"%s\") " ad-last-regexp)))))) (setq ad-last-regexp (if (equal regexp "") ad-last-regexp regexp)))) ;; @@ Finding, enabling, adding and removing pieces of advice: ;; =========================================================== (defmacro ad-find-advice (function class name) ;;"Finds the first advice of FUNCTION in CLASS with NAME." (` (assq (, name) (ad-get-advice-info-field (, function) (, class))))) (defun ad-advice-position (function class name) ;;"Returns position of first advice of FUNCTION in CLASS with NAME." (let* ((found-advice (ad-find-advice function class name)) (advices (ad-get-advice-info-field function class))) (if found-advice (- (length advices) (length (memq found-advice advices)))))) (defun ad-find-some-advice (function class name) "Finds the first of FUNCTION's advices in CLASS matching NAME. NAME can be a symbol or a regular expression matching part of an advice name. If CLASS is `any' all legal advice classes will be checked." (if (ad-is-advised function) (let (found-advice) (ad-dolist (advice-class ad-advice-classes) (if (or (eq class 'any) (eq advice-class class)) (setq found-advice (ad-dolist (advice (ad-get-advice-info-field function advice-class)) (if (or (and (stringp name) (string-match name (symbol-name (ad-advice-name advice)))) (eq name (ad-advice-name advice))) (ad-do-return advice))))) (if found-advice (ad-do-return found-advice)))))) (defun ad-enable-advice-internal (function class name flag) ;;"Sets enable FLAG of FUNCTION's advices in CLASS matching NAME. ;;If NAME is a string rather than a symbol then it's interpreted as a regular ;;expression and all advices whose name contain a match for it will be ;;affected. If CLASS is `any' advices in all legal advice classes will be ;;considered. The number of changed advices will be returned (or nil if ;;FUNCTION was not advised)." (if (ad-is-advised function) (let ((matched-advices 0)) (ad-dolist (advice-class ad-advice-classes) (if (or (eq class 'any) (eq advice-class class)) (ad-dolist (advice (ad-get-advice-info-field function advice-class)) (cond ((or (and (stringp name) (string-match name (symbol-name (ad-advice-name advice)))) (eq name (ad-advice-name advice))) (setq matched-advices (1+ matched-advices)) (ad-advice-set-enabled advice flag)))))) matched-advices))) (defun ad-enable-advice (function class name) "Enables the advice of FUNCTION with CLASS and NAME." (interactive (ad-read-advice-specification "Enable advice of: ")) (if (ad-is-advised function) (if (eq (ad-enable-advice-internal function class name t) 0) (error "ad-enable-advice: `%s' has no %s advice matching `%s'" function class name)) (error "ad-enable-advice: `%s' is not advised" function))) (defun ad-disable-advice (function class name) "Disables the advice of FUNCTION with CLASS and NAME." (interactive (ad-read-advice-specification "Disable advice of: ")) (if (ad-is-advised function) (if (eq (ad-enable-advice-internal function class name nil) 0) (error "ad-disable-advice: `%s' has no %s advice matching `%s'" function class name)) (error "ad-disable-advice: `%s' is not advised" function))) (defun ad-enable-regexp-internal (regexp class flag) ;;"Sets enable FLAGs of all CLASS advices whose name contains a REGEXP match. ;;If CLASS is `any' all legal advice classes are considered. The number of ;;affected advices will be returned." (let ((matched-advices 0)) (ad-do-advised-functions (advised-function) (setq matched-advices (+ matched-advices (or (ad-enable-advice-internal advised-function class regexp flag) 0)))) matched-advices)) (defun ad-enable-regexp (regexp) "Enables all advices with names that contain a match for REGEXP. All currently advised functions will be considered." (interactive (list (ad-read-regexp "Enable advices via regexp: "))) (let ((matched-advices (ad-enable-regexp-internal regexp 'any t))) (if (interactive-p) (message "%d matching advices enabled" matched-advices)) matched-advices)) (defun ad-disable-regexp (regexp) "Disables all advices with names that contain a match for REGEXP. All currently advised functions will be considered." (interactive (list (ad-read-regexp "Disable advices via regexp: "))) (let ((matched-advices (ad-enable-regexp-internal regexp 'any nil))) (if (interactive-p) (message "%d matching advices disabled" matched-advices)) matched-advices)) (defun ad-remove-advice (function class name) "Removes FUNCTION's advice with NAME from its advices in CLASS. If such an advice was found it will be removed from the list of advices in that CLASS." (interactive (ad-read-advice-specification "Remove advice of: ")) (if (ad-is-advised function) (let* ((advice-to-remove (ad-find-advice function class name))) (if advice-to-remove (ad-set-advice-info-field function class (delq advice-to-remove (ad-get-advice-info-field function class))) (error "ad-remove-advice: `%s' has no %s advice `%s'" function class name))) (error "ad-remove-advice: `%s' is not advised" function))) ;;;###autoload (defun ad-add-advice (function advice class position) "Adds a piece of ADVICE to FUNCTION's list of advices in CLASS. If FUNCTION already has one or more pieces of advice of the specified CLASS then POSITION determines where the new piece will go. The value of POSITION can either be `first', `last' or a number where 0 corresponds to `first'. Numbers outside the range will be mapped to the closest extreme position. If there was already a piece of ADVICE with the same name, then the position argument will be ignored and the old advice will be overwritten with the new one. If the FUNCTION was not advised already, then its advice info will be initialized. Redefining a piece of advice whose name is part of the cache-id will clear the cache." (cond ((not (ad-is-advised function)) (ad-initialize-advice-info function) (ad-set-advice-info-field function 'origname (ad-make-origname function)))) (let* ((previous-position (ad-advice-position function class (ad-advice-name advice))) (advices (ad-get-advice-info-field function class)) ;; Determine a numerical position for the new advice: (position (cond (previous-position) ((eq position 'first) 0) ((eq position 'last) (length advices)) ((numberp position) (max 0 (min position (length advices)))) (t 0)))) ;; Check whether we have to clear the cache: (if (memq (ad-advice-name advice) (ad-get-cache-class-id function class)) (ad-clear-cache function)) (if previous-position (setcar (nthcdr position advices) advice) (if (= position 0) (ad-set-advice-info-field function class (cons advice advices)) (setcdr (nthcdr (1- position) advices) (cons advice (nthcdr position advices))))))) ;; @@ Accessing and manipulating function definitions: ;; =================================================== (defmacro ad-macrofy (definition) ;;"Takes a lambda function DEFINITION and makes a macro out of it." (` (cons 'macro (, definition)))) (defmacro ad-lambdafy (definition) ;;"Takes a macro function DEFINITION and makes a lambda out of it." (` (cdr (, definition)))) ;; There is no way to determine whether some subr is a special form or not, ;; hence we need this list (which is probably out of date): (defvar ad-special-forms (mapcar 'symbol-function '(and catch cond condition-case defconst defmacro defun defvar function if interactive let let* or prog1 prog2 progn quote save-excursion save-restriction save-window-excursion setq setq-default unwind-protect while with-output-to-temp-buffer))) (defmacro ad-special-form-p (definition) ;;"non-nil if DEFINITION is a special form." (list 'memq definition 'ad-special-forms)) (defmacro ad-interactive-p (definition) ;;"non-nil if DEFINITION can be called interactively." (list 'commandp definition)) (defmacro ad-subr-p (definition) ;;"non-nil if DEFINITION is a subr." (list 'subrp definition)) (defmacro ad-macro-p (definition) ;;"non-nil if DEFINITION is a macro." (` (eq (car-safe (, definition)) 'macro))) (defmacro ad-lambda-p (definition) ;;"non-nil if DEFINITION is a lambda expression." (` (eq (car-safe (, definition)) 'lambda))) ;; see ad-make-advice for the format of advice definitions: (defmacro ad-advice-p (definition) ;;"non-nil if DEFINITION is a piece of advice." (` (eq (car-safe (, definition)) 'advice))) ;; Emacs/Lemacs cross-compatibility ;; (compiled-function-p is an obsolete function in Emacs): (if (and (not (fboundp 'byte-code-function-p)) (fboundp 'compiled-function-p)) (ad-safe-fset 'byte-code-function-p 'compiled-function-p)) (defmacro ad-compiled-p (definition) ;;"non-nil if DEFINITION is a compiled byte-code object." (` (or (byte-code-function-p (, definition)) (and (ad-macro-p (, definition)) (byte-code-function-p (ad-lambdafy (, definition))))))) (defmacro ad-compiled-code (compiled-definition) ;;"Returns the byte-code object of a COMPILED-DEFINITION." (` (if (ad-macro-p (, compiled-definition)) (ad-lambdafy (, compiled-definition)) (, compiled-definition)))) (defun ad-lambda-expression (definition) ;;"Returns the lambda expression of a function/macro/advice DEFINITION." (cond ((ad-lambda-p definition) definition) ((ad-macro-p definition) (ad-lambdafy definition)) ((ad-advice-p definition) (cdr definition)) (t nil))) (defun ad-arglist (definition &optional name) ;;"Returns the argument list of DEFINITION. ;;If DEFINITION could be from a subr then its NAME should be ;;supplied to make subr arglist lookup more efficient." (cond ((ad-compiled-p definition) (aref (ad-compiled-code definition) 0)) ((consp definition) (car (cdr (ad-lambda-expression definition)))) ((ad-subr-p definition) (if name (ad-subr-arglist name) ;; otherwise get it from its printed representation: (setq name (format "%s" definition)) (string-match "^#]+\\)>$" name) (ad-subr-arglist (intern (substring name (match-beginning 1) (match-end 1)))))))) ;; Store subr-args as `((arg1 arg2 ...))' so I can distinguish ;; a defined empty arglist `(nil)' from an undefined arglist: (defmacro ad-define-subr-args (subr arglist) (` (put (, subr) 'ad-subr-arglist (list (, arglist))))) (defmacro ad-undefine-subr-args (subr) (` (put (, subr) 'ad-subr-arglist nil))) (defmacro ad-subr-args-defined-p (subr) (` (get (, subr) 'ad-subr-arglist))) (defmacro ad-get-subr-args (subr) (` (car (get (, subr) 'ad-subr-arglist)))) (defun ad-subr-arglist (subr-name) ;;"Retrieve arglist of the subr with SUBR-NAME. ;;Either use the one stored under the `ad-subr-arglist' property, ;;or try to retrieve it from the docstring and cache it under ;;that property, or otherwise use `(&rest ad-subr-args)'." (cond ((ad-subr-args-defined-p subr-name) (ad-get-subr-args subr-name)) ;; says jwz: Should use this for Lemacs 19.8 and above: ;;((fboundp 'subr-min-args) ;; ...) ;; says hans: I guess what Jamie means is that I should use the values ;; of `subr-min-args' and `subr-max-args' to construct the subr arglist ;; without having to look it up via parsing the docstring, e.g., ;; values 1 and 2 would suggest `(arg1 &optional arg2)' as an ;; argument list. However, that won't work because there is no ;; way to distinguish a subr with args `(a &optional b &rest c)' from ;; one with args `(a &rest c)' using that mechanism. Also, the argument ;; names from the docstring are more meaningful. Hence, I'll stick with ;; the old way of doing things. (t (let ((doc (or (ad-real-documentation subr-name t) ""))) (cond ((string-match "^\\(([^\)]+)\\)\n?\\'" doc) (ad-define-subr-args subr-name (cdr (car (read-from-string (downcase (substring doc (match-beginning 1) (match-end 1))))))) (ad-get-subr-args subr-name)) ;; this is the old format used before Emacs 19.24: ((string-match "[\n\t ]*\narguments: ?\\((.*)\\)\n?\\'" doc) (ad-define-subr-args subr-name (car (read-from-string doc (match-beginning 1) (match-end 1)))) (ad-get-subr-args subr-name)) (t '(&rest ad-subr-args))))))) (defun ad-docstring (definition) ;;"Returns the unexpanded docstring of DEFINITION." (let ((docstring (if (ad-compiled-p definition) (ad-real-documentation definition t) (car (cdr (cdr (ad-lambda-expression definition))))))) (if (or (stringp docstring) (natnump docstring)) docstring))) (defun ad-interactive-form (definition) ;;"Returns the interactive form of DEFINITION." (cond ((ad-compiled-p definition) (and (commandp definition) (list 'interactive (aref (ad-compiled-code definition) 5)))) ((or (ad-advice-p definition) (ad-lambda-p definition)) (commandp (ad-lambda-expression definition))))) (defun ad-body-forms (definition) ;;"Returns the list of body forms of DEFINITION." (cond ((ad-compiled-p definition) nil) ((consp definition) (nthcdr (+ (if (ad-docstring definition) 1 0) (if (ad-interactive-form definition) 1 0)) (cdr (cdr (ad-lambda-expression definition))))))) ;; Matches the docstring of an advised definition. ;; The first group of the regexp matches the function name: (defvar ad-advised-definition-docstring-regexp "^\\$ad-doc: \\(.+\\)\\$$") (defun ad-make-advised-definition-docstring (function) ;; Makes an identifying docstring for the advised definition of FUNCTION. ;; Put function name into the documentation string so we can infer ;; the name of the advised function from the docstring. This is needed ;; to generate a proper advised docstring even if we are just given a ;; definition (also see the defadvice for `documentation'): (format "$ad-doc: %s$" (prin1-to-string function))) (defun ad-advised-definition-p (definition) ;;"non-nil if DEFINITION was generated from advice information." (if (or (ad-lambda-p definition) (ad-macro-p definition) (ad-compiled-p definition)) (let ((docstring (ad-docstring definition))) (and (stringp docstring) (string-match ad-advised-definition-docstring-regexp docstring))))) (defun ad-definition-type (definition) ;;"Returns symbol that describes the type of DEFINITION." (if (ad-macro-p definition) 'macro (if (ad-subr-p definition) (if (ad-special-form-p definition) 'special-form 'subr) (if (or (ad-lambda-p definition) (ad-compiled-p definition)) 'function (if (ad-advice-p definition) 'advice))))) (defun ad-has-proper-definition (function) ;;"True if FUNCTION is a symbol with a proper definition. ;;For that it has to be fbound with a non-autoload definition." (and (symbolp function) (fboundp function) (not (eq (car-safe (symbol-function function)) 'autoload)))) ;; The following two are necessary for the sake of packages such as ;; ange-ftp which redefine functions via fcell indirection: (defun ad-real-definition (function) ;;"Finds FUNCTION's definition at the end of function cell indirection." (if (ad-has-proper-definition function) (let ((definition (symbol-function function))) (if (symbolp definition) (ad-real-definition definition) definition)))) (defun ad-real-orig-definition (function) ;;"Finds FUNCTION's real original definition starting from its `origname'." (if (ad-is-advised function) (ad-real-definition (ad-get-advice-info-field function 'origname)))) (defun ad-is-compilable (function) ;;"True if FUNCTION has an interpreted definition that can be compiled." (and (ad-has-proper-definition function) (or (ad-lambda-p (symbol-function function)) (ad-macro-p (symbol-function function))) (not (ad-compiled-p (symbol-function function))))) (defun ad-compile-function (function) "Byte-compiles FUNCTION (or macro) if it is not yet compiled." (interactive "aByte-compile function: ") (if (ad-is-compilable function) ;; Need to turn off auto-activation ;; because `byte-compile' uses `fset': (ad-with-auto-activation-disabled (byte-compile function)))) ;; @@ Constructing advised definitions: ;; ==================================== ;; ;; Main design decisions about the form of advised definitions: ;; ;; A) How will original definitions be called? ;; B) What will argument lists of advised functions look like? ;; ;; Ad A) ;; I chose to use function indirection for all four types of original ;; definitions (functions, macros, subrs and special forms), i.e., create ;; a unique symbol `ad-Orig-' which is fbound to the original ;; definition and call it according to type and arguments. Functions and ;; subrs that don't have any &rest arguments can be called directly in a ;; `(ad-Orig- ....)' form. If they have a &rest argument we have to ;; use `apply'. Macros will be called with ;; `(macroexpand '(ad-Orig- ....))', and special forms also need a ;; form like that with `eval' instead of `macroexpand'. ;; ;; Ad B) ;; Use original arguments where possible and `(&rest ad-subr-args)' ;; otherwise, even though this seems to be more complicated and less ;; uniform than a general `(&rest args)' approach. My reason to still ;; do it that way is that in most cases my approach leads to the more ;; efficient form for the advised function, and portability (e.g., to ;; make the same advice work regardless of whether something is a ;; function or a subr) can still be achieved with argument access macros. (defun ad-prognify (forms) (cond ((<= (length forms) 1) (car forms)) (t (cons 'progn forms)))) ;; @@@ Accessing argument lists: ;; ============================= (defun ad-parse-arglist (arglist) ;;"Parses ARGLIST into its required, optional and rest parameters. ;;A three-element list is returned, where the 1st element is the list of ;;required arguments, the 2nd is the list of optional arguments, and the 3rd ;;is the name of an optional rest parameter (or nil)." (let* (required optional rest) (setq rest (car (cdr (memq '&rest arglist)))) (if rest (setq arglist (reverse (cdr (memq '&rest (reverse arglist)))))) (setq optional (cdr (memq '&optional arglist))) (if optional (setq required (reverse (cdr (memq '&optional (reverse arglist))))) (setq required arglist)) (list required optional rest))) (defun ad-retrieve-args-form (arglist) ;;"Generates a form which evaluates into names/values/types of ARGLIST. ;;When the form gets evaluated within a function with that argument list ;;it will result in a list with one entry for each argument, where the ;;first element of each entry is the name of the argument, the second ;;element is its actual current value, and the third element is either ;;`required', `optional' or `rest' depending on the type of the argument." (let* ((parsed-arglist (ad-parse-arglist arglist)) (rest (nth 2 parsed-arglist))) (` (list (,@ (mapcar (function (lambda (req) (` (list '(, req) (, req) 'required)))) (nth 0 parsed-arglist))) (,@ (mapcar (function (lambda (opt) (` (list '(, opt) (, opt) 'optional)))) (nth 1 parsed-arglist))) (,@ (if rest (list (` (list '(, rest) (, rest) 'rest))))) )))) (defun ad-arg-binding-field (binding field) (cond ((eq field 'name) (car binding)) ((eq field 'value) (car (cdr binding))) ((eq field 'type) (car (cdr (cdr binding)))))) (defun ad-list-access (position list) (cond ((= position 0) list) ((= position 1) (list 'cdr list)) (t (list 'nthcdr position list)))) (defun ad-element-access (position list) (cond ((= position 0) (list 'car list)) ((= position 1) (` (car (cdr (, list))))) (t (list 'nth position list)))) (defun ad-access-argument (arglist index) ;;"Tells how to access ARGLIST's actual argument at position INDEX. ;;For a required/optional arg it simply returns it, if a rest argument has ;;to be accessed, it returns a list with the index and name." (let* ((parsed-arglist (ad-parse-arglist arglist)) (reqopt-args (append (nth 0 parsed-arglist) (nth 1 parsed-arglist))) (rest-arg (nth 2 parsed-arglist))) (cond ((< index (length reqopt-args)) (nth index reqopt-args)) (rest-arg (list (- index (length reqopt-args)) rest-arg))))) (defun ad-get-argument (arglist index) ;;"Returns form to access ARGLIST's actual argument at position INDEX." (let ((argument-access (ad-access-argument arglist index))) (cond ((consp argument-access) (ad-element-access (car argument-access) (car (cdr argument-access)))) (argument-access)))) (defun ad-set-argument (arglist index value-form) ;;"Returns form to set ARGLIST's actual arg at INDEX to VALUE-FORM." (let ((argument-access (ad-access-argument arglist index))) (cond ((consp argument-access) ;; should this check whether there actually is something to set? (` (setcar (, (ad-list-access (car argument-access) (car (cdr argument-access)))) (, value-form)))) (argument-access (` (setq (, argument-access) (, value-form)))) (t (error "ad-set-argument: No argument at position %d of `%s'" index arglist))))) (defun ad-get-arguments (arglist index) ;;"Returns form to access all actual arguments starting at position INDEX." (let* ((parsed-arglist (ad-parse-arglist arglist)) (reqopt-args (append (nth 0 parsed-arglist) (nth 1 parsed-arglist))) (rest-arg (nth 2 parsed-arglist)) args-form) (if (< index (length reqopt-args)) (setq args-form (` (list (,@ (nthcdr index reqopt-args)))))) (if rest-arg (if args-form (setq args-form (` (nconc (, args-form) (, rest-arg)))) (setq args-form (ad-list-access (- index (length reqopt-args)) rest-arg)))) args-form)) (defun ad-set-arguments (arglist index values-form) ;;"Makes form to assign elements of VALUES-FORM as actual ARGLIST args. ;;The assignment starts at position INDEX." (let ((values-index 0) argument-access set-forms) (while (setq argument-access (ad-access-argument arglist index)) (if (symbolp argument-access) (setq set-forms (cons (ad-set-argument arglist index (ad-element-access values-index 'ad-vAlUeS)) set-forms)) (setq set-forms (cons (if (= (car argument-access) 0) (list 'setq (car (cdr argument-access)) (ad-list-access values-index 'ad-vAlUeS)) (list 'setcdr (ad-list-access (1- (car argument-access)) (car (cdr argument-access))) (ad-list-access values-index 'ad-vAlUeS))) set-forms)) ;; terminate loop (setq arglist nil)) (setq index (1+ index)) (setq values-index (1+ values-index))) (if (null set-forms) (error "ad-set-arguments: No argument at position %d of `%s'" index arglist) (if (= (length set-forms) 1) ;; For exactly one set-form we can use values-form directly,... (ad-substitute-tree (function (lambda (form) (eq form 'ad-vAlUeS))) (function (lambda (form) values-form)) (car set-forms)) ;; ...if we have more we have to bind it to a variable: (` (let ((ad-vAlUeS (, values-form))) (,@ (reverse set-forms)) ;; work around the old backquote bug: (, 'ad-vAlUeS))))))) (defun ad-insert-argument-access-forms (definition arglist) ;;"Expands arg-access text macros in DEFINITION according to ARGLIST." (ad-substitute-tree (function (lambda (form) (or (eq form 'ad-arg-bindings) (and (memq (car-safe form) '(ad-get-arg ad-get-args ad-set-arg ad-set-args)) (integerp (car-safe (cdr form))))))) (function (lambda (form) (if (eq form 'ad-arg-bindings) (ad-retrieve-args-form arglist) (let ((accessor (car form)) (index (car (cdr form))) (val (car (cdr (ad-insert-argument-access-forms (cdr form) arglist))))) (cond ((eq accessor 'ad-get-arg) (ad-get-argument arglist index)) ((eq accessor 'ad-set-arg) (ad-set-argument arglist index val)) ((eq accessor 'ad-get-args) (ad-get-arguments arglist index)) ((eq accessor 'ad-set-args) (ad-set-arguments arglist index val))))))) definition)) ;; @@@ Mapping argument lists: ;; =========================== ;; Here is the problem: ;; Suppose function foo was called with (foo 1 2 3 4 5), and foo has the ;; argument list (x y &rest z), and we want to call the function bar which ;; has argument list (a &rest b) with a combination of x, y and z so that ;; the effect is just as if we had called (bar 1 2 3 4 5) directly. ;; The mapping should work for any two argument lists. (defun ad-map-arglists (source-arglist target-arglist) "Makes `funcall/apply' form to map SOURCE-ARGLIST to TARGET-ARGLIST. The arguments supplied to TARGET-ARGLIST will be taken from SOURCE-ARGLIST just as if they had been supplied to a function with TARGET-ARGLIST directly. Excess source arguments will be neglected, missing source arguments will be supplied as nil. Returns a `funcall' or `apply' form with the second element being `function' which has to be replaced by an actual function argument. Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return `(funcall function a (car args) (car (cdr args)) (nth 2 args))'." (let* ((parsed-source-arglist (ad-parse-arglist source-arglist)) (source-reqopt-args (append (nth 0 parsed-source-arglist) (nth 1 parsed-source-arglist))) (source-rest-arg (nth 2 parsed-source-arglist)) (parsed-target-arglist (ad-parse-arglist target-arglist)) (target-reqopt-args (append (nth 0 parsed-target-arglist) (nth 1 parsed-target-arglist))) (target-rest-arg (nth 2 parsed-target-arglist)) (need-apply (and source-rest-arg target-rest-arg)) (target-arg-index -1)) ;; This produces ``error-proof'' target function calls with the exception ;; of a case like (&rest a) mapped onto (x &rest y) where the actual args ;; supplied to A might not be enough to supply the required target arg X (append (list (if need-apply 'apply 'funcall) 'function) (cond (need-apply ;; `apply' can take care of that directly: (append source-reqopt-args (list source-rest-arg))) (t (mapcar (function (lambda (arg) (setq target-arg-index (1+ target-arg-index)) (ad-get-argument source-arglist target-arg-index))) (append target-reqopt-args (and target-rest-arg ;; If we have a rest arg gobble up ;; remaining source args: (nthcdr (length target-reqopt-args) source-reqopt-args))))))))) (defun ad-make-mapped-call (source-arglist target-arglist target-function) ;;"Makes form to call TARGET-FUNCTION with args from SOURCE-ARGLIST." (let* ((mapped-form (ad-map-arglists source-arglist target-arglist))) (if (eq (car mapped-form) 'funcall) (cons target-function (cdr (cdr mapped-form))) (prog1 mapped-form (setcar (cdr mapped-form) (list 'quote target-function)))))) ;; @@@ Making an advised documentation string: ;; =========================================== ;; New policy: The documentation string for an advised function will be built ;; at the time the advised `documentation' function is called. This has the ;; following advantages: ;; 1) command-key substitutions will automatically be correct ;; 2) No wasted string space due to big advised docstrings in caches or ;; compiled files that contain preactivations ;; The overall overhead for this should be negligible because people normally ;; don't lookup documentation for the same function over and over again. (defun ad-make-single-advice-docstring (advice class &optional style) (let ((advice-docstring (ad-docstring (ad-advice-definition advice)))) (cond ((eq style 'plain) advice-docstring) ((eq style 'freeze) (format "Permanent %s-advice `%s':%s%s" class (ad-advice-name advice) (if advice-docstring "\n" "") (or advice-docstring ""))) (t (format "%s-advice `%s':%s%s" (capitalize (symbol-name class)) (ad-advice-name advice) (if advice-docstring "\n" "") (or advice-docstring "")))))) (defun ad-make-advised-docstring (function &optional style) ;;"Constructs a documentation string for the advised FUNCTION. ;;It concatenates the original documentation with the documentation ;;strings of the individual pieces of advice which will be formatted ;;according to STYLE. STYLE can be `plain' or `freeze', everything else ;;will be interpreted as `default'. The order of the advice documentation ;;strings corresponds to before/around/after and the individual ordering ;;in any of these classes." (let* ((origdef (ad-real-orig-definition function)) (origtype (symbol-name (ad-definition-type origdef))) (origdoc ;; Retrieve raw doc, key substitution will be taken care of later: (ad-real-documentation origdef t)) paragraphs advice-docstring) (if origdoc (setq paragraphs (list origdoc))) (if (not (eq style 'plain)) (setq paragraphs (cons (concat "This " origtype " is advised.") paragraphs))) (ad-dolist (class ad-advice-classes) (ad-dolist (advice (ad-get-enabled-advices function class)) (setq advice-docstring (ad-make-single-advice-docstring advice class style)) (if advice-docstring (setq paragraphs (cons advice-docstring paragraphs))))) (if paragraphs ;; separate paragraphs with blank lines: (mapconcat 'identity (nreverse paragraphs) "\n\n")))) (defun ad-make-plain-docstring (function) (ad-make-advised-docstring function 'plain)) (defun ad-make-freeze-docstring (function) (ad-make-advised-docstring function 'freeze)) ;; @@@ Accessing overriding arglists and interactive forms: ;; ======================================================== (defun ad-advised-arglist (function) ;;"Finds first defined arglist in FUNCTION's redefining advices." (ad-dolist (advice (append (ad-get-enabled-advices function 'before) (ad-get-enabled-advices function 'around) (ad-get-enabled-advices function 'after))) (let ((arglist (ad-arglist (ad-advice-definition advice)))) (if arglist ;; We found the first one, use it: (ad-do-return arglist))))) (defun ad-advised-interactive-form (function) ;;"Finds first interactive form in FUNCTION's redefining advices." (ad-dolist (advice (append (ad-get-enabled-advices function 'before) (ad-get-enabled-advices function 'around) (ad-get-enabled-advices function 'after))) (let ((interactive-form (ad-interactive-form (ad-advice-definition advice)))) (if interactive-form ;; We found the first one, use it: (ad-do-return interactive-form))))) ;; @@@ Putting it all together: ;; ============================ (defun ad-make-advised-definition (function) ;;"Generates an advised definition of FUNCTION from its advice info." (if (and (ad-is-advised function) (ad-has-redefining-advice function)) (let* ((origdef (ad-real-orig-definition function)) (origname (ad-get-advice-info-field function 'origname)) (orig-interactive-p (ad-interactive-p origdef)) (orig-subr-p (ad-subr-p origdef)) (orig-special-form-p (ad-special-form-p origdef)) (orig-macro-p (ad-macro-p origdef)) ;; Construct the individual pieces that we need for assembly: (orig-arglist (ad-arglist origdef function)) (advised-arglist (or (ad-advised-arglist function) orig-arglist)) (advised-interactive-form (ad-advised-interactive-form function)) (interactive-form (cond (orig-macro-p nil) (advised-interactive-form) ((ad-interactive-form origdef)) ;; Otherwise we must have a subr: make it interactive if ;; we have to and initialize required arguments in case ;; it is called interactively: (orig-interactive-p (let ((reqargs (car (ad-parse-arglist advised-arglist)))) (if reqargs (` (interactive '(, (make-list (length reqargs) nil)))) '(interactive)))))) (orig-form (cond ((or orig-special-form-p orig-macro-p) ;; Special forms and macros will be advised into macros. ;; The trick is to construct an expansion for the advised ;; macro that does the correct thing when it gets eval'ed. ;; For macros we'll just use the expansion of the original ;; macro and return that. This way compiled advised macros ;; will be expanded into something useful. Note that after ;; advices have full control over whether they want to ;; evaluate the expansion (the value of `ad-return-value') ;; at macro expansion time or not. For special forms there ;; is no solution that interacts reasonably with the ;; compiler, hence we just evaluate the original at macro ;; expansion time and return the result. The moral of that ;; is that one should always deactivate advised special ;; forms before one byte-compiles a file. (` ((, (if orig-macro-p 'macroexpand 'eval)) (cons '(, origname) (, (ad-get-arguments advised-arglist 0)))))) ((and orig-subr-p orig-interactive-p (not advised-interactive-form)) ;; Check whether we were called interactively ;; in order to do proper prompting: (` (if (interactive-p) (call-interactively '(, origname)) (, (ad-make-mapped-call orig-arglist advised-arglist origname))))) ;; And now for normal functions and non-interactive subrs ;; (or subrs whose interactive behavior was advised): (t (ad-make-mapped-call advised-arglist orig-arglist origname))))) ;; Finally, build the sucker: (ad-assemble-advised-definition (cond (orig-macro-p 'macro) (orig-special-form-p 'special-form) (t 'function)) advised-arglist (ad-make-advised-definition-docstring function) interactive-form orig-form (ad-get-enabled-advices function 'before) (ad-get-enabled-advices function 'around) (ad-get-enabled-advices function 'after))))) (defun ad-assemble-advised-definition (type args docstring interactive orig &optional befores arounds afters) ;;"Assembles an original and its advices into an advised function. ;;It constructs a function or macro definition according to TYPE which has to ;;be either `macro', `function' or `special-form'. ARGS is the argument list ;;that has to be used, DOCSTRING if non-nil defines the documentation of the ;;definition, INTERACTIVE if non-nil is the interactive form to be used, ;;ORIG is a form that calls the body of the original unadvised function, ;;and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG ;;should be modified. The assembled function will be returned." (let (before-forms around-form around-form-protected after-forms definition) (ad-dolist (advice befores) (cond ((and (ad-advice-protected advice) before-forms) (setq before-forms (` ((unwind-protect (, (ad-prognify before-forms)) (,@ (ad-body-forms (ad-advice-definition advice)))))))) (t (setq before-forms (append before-forms (ad-body-forms (ad-advice-definition advice))))))) (setq around-form (` (setq ad-return-value (, orig)))) (ad-dolist (advice (reverse arounds)) ;; If any of the around advices is protected then we ;; protect the complete around advice onion: (if (ad-advice-protected advice) (setq around-form-protected t)) (setq around-form (ad-substitute-tree (function (lambda (form) (eq form 'ad-do-it))) (function (lambda (form) around-form)) (ad-prognify (ad-body-forms (ad-advice-definition advice)))))) (setq after-forms (if (and around-form-protected before-forms) (` ((unwind-protect (, (ad-prognify before-forms)) (, around-form)))) (append before-forms (list around-form)))) (ad-dolist (advice afters) (cond ((and (ad-advice-protected advice) after-forms) (setq after-forms (` ((unwind-protect (, (ad-prognify after-forms)) (,@ (ad-body-forms (ad-advice-definition advice)))))))) (t (setq after-forms (append after-forms (ad-body-forms (ad-advice-definition advice))))))) (setq definition (` ((,@ (if (memq type '(macro special-form)) '(macro))) lambda (, args) (,@ (if docstring (list docstring))) (,@ (if interactive (list interactive))) (let (ad-return-value) (,@ after-forms) (, (if (eq type 'special-form) '(list 'quote ad-return-value) 'ad-return-value)))))) (ad-insert-argument-access-forms definition args))) ;; This is needed for activation/deactivation hooks: (defun ad-make-hook-form (function hook-name) ;;"Makes hook-form from FUNCTION's advice bodies in class HOOK-NAME." (let ((hook-forms (mapcar (function (lambda (advice) (ad-body-forms (ad-advice-definition advice)))) (ad-get-enabled-advices function hook-name)))) (if hook-forms (ad-prognify (apply 'append hook-forms))))) ;; @@ Caching: ;; =========== ;; Generating an advised definition of a function is moderately expensive, ;; hence, it makes sense to cache it so we can reuse it in appropriate ;; circumstances. Of course, it only makes sense to reuse a cached ;; definition if the current advice and function definition state is the ;; same as it was at the time when the cached definition was generated. ;; For that purpose we associate every cache with an id so we can verify ;; if it is still valid at a certain point in time. This id mechanism ;; makes it possible to preactivate advised functions, write the compiled ;; advised definitions to a file and reuse them during the actual ;; activation without having to risk that the resulting definition will be ;; incorrect, well, almost. ;; ;; A cache id is a list with six elements: ;; 1) the list of names of enabled before advices ;; 2) the list of names of enabled around advices ;; 3) the list of names of enabled after advices ;; 4) the type of the original function (macro, subr, etc.) ;; 5) the arglist of the original definition (or t if it was equal to the ;; arglist of the cached definition) ;; 6) t if the interactive form of the original definition was equal to the ;; interactive form of the cached definition ;; ;; Here's how a cache can get invalidated or be incorrect: ;; A) a piece of advice used in the cache gets redefined ;; B) the current list of enabled advices is different from the ones used ;; for the cache ;; C) the type of the original function changed, e.g., a function became a ;; macro, or a subr became a function ;; D) the arglist of the original function changed ;; E) the interactive form of the original function changed ;; F) a piece of advice used in the cache got redefined before the ;; defadvice with the cached definition got loaded: This is a PROBLEM! ;; ;; Cases A and B are the normal ones. A is taken care of by `ad-add-advice' ;; which clears the cache in such a case, B is easily checked during ;; verification at activation time. ;; ;; Cases C, D and E have to be considered if one is slightly paranoid, i.e., ;; if one considers the case that the original function could be different ;; from the one available at caching time (e.g., for forward advice of ;; functions that get redefined by some packages - such as `eval-region' gets ;; redefined by edebug). All these cases can be easily checked during ;; verification. Element 4 of the id lets one check case C, element 5 takes ;; care of case D (using t in the equality case saves some space, because the ;; arglist can be recovered at validation time from the cached definition), ;; and element 6 takes care of case E which is only a problem if the original ;; was actually a function whose interactive form was not overridden by a ;; piece of advice. ;; ;; Case F is the only one which will lead to an incorrect advised function. ;; There is no way to avoid this without storing the complete advice definition ;; in the cache-id which is not feasible. ;; ;; The cache-id of a typical advised function with one piece of advice and ;; no arglist redefinition takes 7 conses which is a small price to pay for ;; the added efficiency. The validation itself is also pretty cheap, certainly ;; a lot cheaper than reconstructing an advised definition. (defmacro ad-get-cache-definition (function) (` (car (ad-get-advice-info-field (, function) 'cache)))) (defmacro ad-get-cache-id (function) (` (cdr (ad-get-advice-info-field (, function) 'cache)))) (defmacro ad-set-cache (function definition id) (` (ad-set-advice-info-field (, function) 'cache (cons (, definition) (, id))))) (defun ad-clear-cache (function) "Clears a previously cached advised definition of FUNCTION. Clear the cache if you want to force `ad-activate' to construct a new advised definition from scratch." (interactive (list (ad-read-advised-function "Clear cached definition of: "))) (ad-set-advice-info-field function 'cache nil)) (defun ad-make-cache-id (function) ;;"Generates an identifying image of the current advices of FUNCTION." (let ((original-definition (ad-real-orig-definition function)) (cached-definition (ad-get-cache-definition function))) (list (mapcar (function (lambda (advice) (ad-advice-name advice))) (ad-get-enabled-advices function 'before)) (mapcar (function (lambda (advice) (ad-advice-name advice))) (ad-get-enabled-advices function 'around)) (mapcar (function (lambda (advice) (ad-advice-name advice))) (ad-get-enabled-advices function 'after)) (ad-definition-type original-definition) (if (equal (ad-arglist original-definition function) (ad-arglist cached-definition)) t (ad-arglist original-definition function)) (if (eq (ad-definition-type original-definition) 'function) (equal (ad-interactive-form original-definition) (ad-interactive-form cached-definition)))))) (defun ad-get-cache-class-id (function class) ;;"Returns the part of FUNCTION's cache id that identifies CLASS." (let ((cache-id (ad-get-cache-id function))) (if (eq class 'before) (car cache-id) (if (eq class 'around) (nth 1 cache-id) (nth 2 cache-id))))) (defun ad-verify-cache-class-id (cache-class-id advices) (ad-dolist (advice advices (null cache-class-id)) (if (ad-advice-enabled advice) (if (eq (car cache-class-id) (ad-advice-name advice)) (setq cache-class-id (cdr cache-class-id)) (ad-do-return nil))))) ;; There should be a way to monitor if and why a cache verification failed ;; in order to determine whether a certain preactivation could be used or ;; not. Right now the only way to find out is to trace ;; `ad-cache-id-verification-code'. The code it returns indicates where the ;; verification failed. Tracing `ad-verify-cache-class-id' might provide ;; some additional useful information. (defun ad-cache-id-verification-code (function) (let ((cache-id (ad-get-cache-id function)) (code 'before-advice-mismatch)) (and (ad-verify-cache-class-id (car cache-id) (ad-get-advice-info-field function 'before)) (setq code 'around-advice-mismatch) (ad-verify-cache-class-id (nth 1 cache-id) (ad-get-advice-info-field function 'around)) (setq code 'after-advice-mismatch) (ad-verify-cache-class-id (nth 2 cache-id) (ad-get-advice-info-field function 'after)) (setq code 'definition-type-mismatch) (let ((original-definition (ad-real-orig-definition function)) (cached-definition (ad-get-cache-definition function))) (and (eq (nth 3 cache-id) (ad-definition-type original-definition)) (setq code 'arglist-mismatch) (equal (if (eq (nth 4 cache-id) t) (ad-arglist original-definition function) (nth 4 cache-id) ) (ad-arglist cached-definition)) (setq code 'interactive-form-mismatch) (or (null (nth 5 cache-id)) (equal (ad-interactive-form original-definition) (ad-interactive-form cached-definition))) (setq code 'verified)))) code)) (defun ad-verify-cache-id (function) ;;"True if FUNCTION's cache-id is compatible with its current advices." (eq (ad-cache-id-verification-code function) 'verified)) ;; @@ Preactivation: ;; ================= ;; Preactivation can be used to generate compiled advised definitions ;; at compile time without having to give up the dynamic runtime flexibility ;; of the advice mechanism. Preactivation is a special feature of `defadvice', ;; it involves the following steps: ;; - remembering the function's current state (definition and advice-info) ;; - advising it with the defined piece of advice ;; - clearing its cache ;; - generating an interpreted advised definition by activating it, this will ;; make use of all its current active advice and its current definition ;; - saving the so generated cached definition and id ;; - resetting the function's advice and definition state to what it was ;; before the preactivation ;; - Returning the saved definition and its id to be used in the expansion of ;; `defadvice' to assign it as an initial cache, hence it will be compiled ;; at time the `defadvice' gets compiled. ;; Naturally, for preactivation to be effective it has to be applied/compiled ;; at the right time, i.e., when the current state of advices and function ;; definition exactly reflects the state at activation time. Should that not ;; be the case, the precompiled definition will just be discarded and a new ;; advised definition will be generated. (defun ad-preactivate-advice (function advice class position) ;;"Preactivates FUNCTION and returns the constructed cache." (let* ((function-defined-p (fboundp function)) (old-definition (if function-defined-p (symbol-function function))) (old-advice-info (ad-copy-advice-info function)) (ad-advised-functions ad-advised-functions)) (unwind-protect (progn (ad-add-advice function advice class position) (ad-enable-advice function class (ad-advice-name advice)) (ad-clear-cache function) (ad-activate-on function -1) (if (and (ad-is-active function) (ad-get-cache-definition function)) (list (ad-get-cache-definition function) (ad-get-cache-id function)))) (ad-set-advice-info function old-advice-info) ;; Don't `fset' function to nil if it was previously unbound: (if function-defined-p (ad-safe-fset function old-definition) (fmakunbound function))))) ;; @@ Freezing: ;; ============ ;; Freezing transforms a `defadvice' into a redefining `defun/defmacro' ;; for the advised function without keeping any advice information. This ;; feature was jwz's idea: It generates a dumpable function definition ;; whose documentation can be written to the DOC file, and the generated ;; code does not need any Advice runtime support. Of course, frozen advices ;; cannot be undone. ;; Freezing only considers the advice of the particular `defadvice', other ;; already existing advices for the same function will be ignored. To ensure ;; proper interaction when an already advised function gets redefined with ;; a frozen advice, frozen advices always use the actual original definition ;; of the function, i.e., they are always at the core of the onion. E.g., if ;; an already advised function gets redefined with a frozen advice and then ;; unadvised, the frozen advice remains as the new definition of the function. ;; While multiple freeze advices for a single function or freeze-advising ;; of an already advised function are possible, they are better avoided, ;; because definition/compile/load ordering is relevant, and it becomes ;; incomprehensible pretty quickly. (defun ad-make-freeze-definition (function advice class position) (if (not (ad-has-proper-definition function)) (error "ad-make-freeze-definition: `%s' is not yet defined" function)) (let* ((name (ad-advice-name advice)) ;; With a unique origname we can have multiple freeze advices ;; for the same function, each overloading the previous one: (unique-origname (intern (format "%s-%s-%s" (ad-make-origname function) class name))) (orig-definition ;; If FUNCTION is already advised, we'll use its current origdef ;; as the original definition of the frozen advice: (or (ad-get-orig-definition function) (symbol-function function))) (old-advice-info (if (ad-is-advised function) (ad-copy-advice-info function))) (real-docstring-fn (symbol-function 'ad-make-advised-definition-docstring)) (real-origname-fn (symbol-function 'ad-make-origname)) (frozen-definition (unwind-protect (progn ;; Make sure we construct a proper docstring: (ad-safe-fset 'ad-make-advised-definition-docstring 'ad-make-freeze-docstring) ;; Make sure `unique-origname' is used as the origname: (ad-safe-fset 'ad-make-origname '(lambda (x) unique-origname)) ;; No we reset all current advice information to nil and ;; generate an advised definition that's solely determined ;; by ADVICE and the current origdef of FUNCTION: (ad-set-advice-info function nil) (ad-add-advice function advice class position) ;; The following will provide proper real docstrings as ;; well as a definition that will make the compiler happy: (ad-set-orig-definition function orig-definition) (ad-make-advised-definition function)) ;; Restore the old advice state: (ad-set-advice-info function old-advice-info) ;; Restore functions: (ad-safe-fset 'ad-make-advised-definition-docstring real-docstring-fn) (ad-safe-fset 'ad-make-origname real-origname-fn)))) (if frozen-definition (let* ((macro-p (ad-macro-p frozen-definition)) (body (cdr (if macro-p (ad-lambdafy frozen-definition) frozen-definition)))) (` (progn (if (not (fboundp '(, unique-origname))) (fset '(, unique-origname) ;; avoid infinite recursion in case the function ;; we want to freeze is already advised: (or (ad-get-orig-definition '(, function)) (symbol-function '(, function))))) ((, (if macro-p 'defmacro 'defun)) (, function) (,@ body)))))))) ;; @@ Activation and definition handling: ;; ====================================== (defun ad-should-compile (function compile) ;;"Returns non-nil if the advised FUNCTION should be compiled. ;;If COMPILE is non-nil and not a negative number then it returns t. ;;If COMPILE is a negative number then it returns nil. ;;If COMPILE is nil then the result depends on the value of ;;`ad-default-compilation-action' (which see)." (if (integerp compile) (>= compile 0) (if compile compile (cond ((eq ad-default-compilation-action 'never) nil) ((eq ad-default-compilation-action 'always) t) ((eq ad-default-compilation-action 'like-original) (or (ad-subr-p (ad-get-orig-definition function)) (ad-compiled-p (ad-get-orig-definition function)))) ;; everything else means `maybe': (t (featurep 'byte-compile)))))) (defun ad-activate-advised-definition (function compile) ;;"Redefines FUNCTION with its advised definition from cache or scratch. ;;The resulting FUNCTION will be compiled if `ad-should-compile' returns t. ;;The current definition and its cache-id will be put into the cache." (let ((verified-cached-definition (if (ad-verify-cache-id function) (ad-get-cache-definition function)))) (ad-safe-fset function (or verified-cached-definition (ad-make-advised-definition function))) (if (ad-should-compile function compile) (ad-compile-function function)) (if verified-cached-definition (if (not (eq verified-cached-definition (symbol-function function))) ;; we must have compiled, cache the compiled definition: (ad-set-cache function (symbol-function function) (ad-get-cache-id function))) ;; We created a new advised definition, cache it with a proper id: (ad-clear-cache function) ;; ad-make-cache-id needs the new cached definition: (ad-set-cache function (symbol-function function) nil) (ad-set-cache function (symbol-function function) (ad-make-cache-id function))))) (defun ad-handle-definition (function) "Handles re/definition of an advised FUNCTION during de/activation. If FUNCTION does not have an original definition associated with it and the current definition is usable, then it will be stored as FUNCTION's original definition. If no current definition is available (even in the case of undefinition) nothing will be done. In the case of redefinition the action taken depends on the value of `ad-redefinition-action' (which see). Redefinition occurs when FUNCTION already has an original definition associated with it but got redefined with a new definition and then de/activated. If you do not like the current redefinition action change the value of `ad-redefinition-action' and de/activate again." (let ((original-definition (ad-get-orig-definition function)) (current-definition (if (ad-real-definition function) (symbol-function function)))) (if original-definition (if current-definition (if (and (not (eq current-definition original-definition)) ;; Redefinition with an advised definition from a ;; different function won't count as such: (not (ad-advised-definition-p current-definition))) ;; we have a redefinition: (if (not (memq ad-redefinition-action '(accept discard warn))) (error "ad-handle-definition (see its doc): `%s' %s" function "illegally redefined") (if (eq ad-redefinition-action 'discard) (ad-safe-fset function original-definition) (ad-set-orig-definition function current-definition) (if (eq ad-redefinition-action 'warn) (message "ad-handle-definition: `%s' got redefined" function)))) ;; either advised def or correct original is in place: nil) ;; we have an undefinition, ignore it: nil) (if current-definition ;; we have a first definition, save it as original: (ad-set-orig-definition function current-definition) ;; we don't have anything noteworthy: nil)))) ;; @@ The top-level advice interface: ;; ================================== (defun ad-activate-on (function &optional compile) "Activates all the advice information of an advised FUNCTION. If FUNCTION has a proper original definition then an advised definition will be generated from FUNCTION's advice info and the definition of FUNCTION will be replaced with it. If a previously cached advised definition was available, it will be used. The optional COMPILE argument determines whether the resulting function or a compilable cached definition will be compiled. If it is negative no compilation will be performed, if it is positive or otherwise non-nil the resulting function will be compiled, if it is nil the behavior depends on the value of `ad-default-compilation-action' (which see). Activation of an advised function that has an advice info but no actual pieces of advice is equivalent to a call to `ad-unadvise'. Activation of an advised function that has actual pieces of advice but none of them are enabled is equivalent to a call to `ad-deactivate'. The current advised definition will always be cached for later usage." (interactive (list (ad-read-advised-function "Activate advice of: ") current-prefix-arg)) (if ad-activate-on-top-level ;; avoid recursive calls to `ad-activate-on': (ad-with-auto-activation-disabled (if (not (ad-is-advised function)) (error "ad-activate: `%s' is not advised" function) (ad-handle-definition function) ;; Just return for forward advised and not yet defined functions: (if (ad-get-orig-definition function) (if (not (ad-has-any-advice function)) (ad-unadvise function) ;; Otherwise activate the advice: (cond ((ad-has-redefining-advice function) (ad-activate-advised-definition function compile) (ad-set-advice-info-field function 'active t) (eval (ad-make-hook-form function 'activation)) function) ;; Here we are if we have all disabled advices: (t (ad-deactivate function))))))))) (defun ad-deactivate (function) "Deactivates the advice of an actively advised FUNCTION. If FUNCTION has a proper original definition, then the current definition of FUNCTION will be replaced with it. All the advice information will still be available so it can be activated again with a call to `ad-activate'." (interactive (list (ad-read-advised-function "Deactivate advice of: " 'ad-is-active))) (if (not (ad-is-advised function)) (error "ad-deactivate: `%s' is not advised" function) (cond ((ad-is-active function) (ad-handle-definition function) (if (not (ad-get-orig-definition function)) (error "ad-deactivate: `%s' has no original definition" function) (ad-safe-fset function (ad-get-orig-definition function)) (ad-set-advice-info-field function 'active nil) (eval (ad-make-hook-form function 'deactivation)) function))))) (defun ad-update (function &optional compile) "Update the advised definition of FUNCTION if its advice is active. See `ad-activate-on' for documentation on the optional COMPILE argument." (interactive (list (ad-read-advised-function "Update advised definition of: " 'ad-is-active))) (if (ad-is-active function) (ad-activate-on function compile))) (defun ad-unadvise (function) "Deactivates FUNCTION and then removes all its advice information. If FUNCTION was not advised this will be a noop." (interactive (list (ad-read-advised-function "Unadvise function: "))) (cond ((ad-is-advised function) (if (ad-is-active function) (ad-deactivate function)) (ad-clear-orig-definition function) (ad-set-advice-info function nil) (ad-pop-advised-function function)))) (defun ad-recover (function) "Tries to recover FUNCTION's original definition and unadvises it. This is more low-level than `ad-unadvise' because it does not do any deactivation which might run hooks and get into other trouble. Use in emergencies." ;; Use more primitive interactive behavior here: Accept any symbol that's ;; currently defined in obarray, not necessarily with a function definition: (interactive (list (intern (completing-read "Recover advised function: " obarray nil t)))) (cond ((ad-is-advised function) (cond ((ad-get-orig-definition function) (ad-safe-fset function (ad-get-orig-definition function)) (ad-clear-orig-definition function))) (ad-set-advice-info function nil) (ad-pop-advised-function function)))) (defun ad-activate-regexp (regexp &optional compile) "Activates functions with an advice name containing a REGEXP match. See `ad-activate-on' for documentation on the optional COMPILE argument." (interactive (list (ad-read-regexp "Activate via advice regexp: ") current-prefix-arg)) (ad-do-advised-functions (function) (if (ad-find-some-advice function 'any regexp) (ad-activate-on function compile)))) (defun ad-deactivate-regexp (regexp) "Deactivates functions with an advice name containing REGEXP match." (interactive (list (ad-read-regexp "Deactivate via advice regexp: "))) (ad-do-advised-functions (function) (if (ad-find-some-advice function 'any regexp) (ad-deactivate function)))) (defun ad-update-regexp (regexp &optional compile) "Updates functions with an advice name containing a REGEXP match. See `ad-activate-on' for documentation on the optional COMPILE argument." (interactive (list (ad-read-regexp "Update via advice regexp: ") current-prefix-arg)) (ad-do-advised-functions (function) (if (ad-find-some-advice function 'any regexp) (ad-update function compile)))) (defun ad-activate-all (&optional compile) "Activates all currently advised functions. See `ad-activate-on' for documentation on the optional COMPILE argument." (interactive "P") (ad-do-advised-functions (function) (ad-activate-on function compile))) (defun ad-deactivate-all () "Deactivates all currently advised functions." (interactive) (ad-do-advised-functions (function) (ad-deactivate function))) (defun ad-update-all (&optional compile) "Updates all currently advised functions. With prefix argument compiles resulting advised definitions." (interactive "P") (ad-do-advised-functions (function) (ad-update function compile))) (defun ad-unadvise-all () "Unadvises all currently advised functions." (interactive) (ad-do-advised-functions (function) (ad-unadvise function))) (defun ad-recover-all () "Recovers all currently advised functions. Use in emergencies." (interactive) (ad-do-advised-functions (function) (condition-case nil (ad-recover function) (error nil)))) ;; Completion alist of legal `defadvice' flags (defvar ad-defadvice-flags '(("protect") ("disable") ("activate") ("compile") ("preactivate") ("freeze"))) ;;;###autoload (defmacro defadvice (function args &rest body) "Defines a piece of advice for FUNCTION (a symbol). The syntax of `defadvice' is as follows: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) [DOCSTRING] [INTERACTIVE-FORM] BODY... ) FUNCTION ::= Name of the function to be advised. CLASS ::= `before' | `around' | `after' | `activation' | `deactivation'. NAME ::= Non-nil symbol that names this piece of advice. POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first', see also `ad-add-advice'. ARGLIST ::= An optional argument list to be used for the advised function instead of the argument list of the original. The first one found in before/around/after-advices will be used. FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'. All flags can be specified with unambiguous initial substrings. DOCSTRING ::= Optional documentation for this piece of advice. INTERACTIVE-FORM ::= Optional interactive form to be used for the advised function. The first one found in before/around/after-advices will be used. BODY ::= Any s-expression. Semantics of the various flags: `protect': The piece of advice will be protected against non-local exits in any code that precedes it. If any around-advice of a function is protected then automatically all around-advices will be protected (the complete onion). `activate': All advice of FUNCTION will be activated immediately if FUNCTION has been properly defined prior to this application of `defadvice'. `compile': In conjunction with `activate' specifies that the resulting advised function should be compiled. `disable': The defined advice will be disabled, hence, it will not be used during activation until somebody enables it. `preactivate': Preactivates the advised FUNCTION at macro-expansion/compile time. This generates a compiled advised definition according to the current advice state that will be used during activation if appropriate. Only use this if the `defadvice' gets actually compiled. `freeze': Expands the `defadvice' into a redefining `defun/defmacro' according to this particular single advice. No other advice information will be saved. Frozen advices cannot be undone, they behave like a hard redefinition of the advised function. `freeze' implies `activate' and `preactivate'. The documentation of the advised function can be dumped onto the `DOC' file during preloading. Look at the file `advice.el' for comprehensive documentation." (if (not (ad-name-p function)) (error "defadvice: Illegal function name: %s" function)) (let* ((class (car args)) (name (if (not (ad-class-p class)) (error "defadvice: Illegal advice class: %s" class) (nth 1 args))) (position (if (not (ad-name-p name)) (error "defadvice: Illegal advice name: %s" name) (setq args (nthcdr 2 args)) (if (ad-position-p (car args)) (prog1 (car args) (setq args (cdr args)))))) (arglist (if (listp (car args)) (prog1 (car args) (setq args (cdr args))))) (flags (mapcar (function (lambda (flag) (let ((completion (try-completion (symbol-name flag) ad-defadvice-flags))) (cond ((eq completion t) flag) ((assoc completion ad-defadvice-flags) (intern completion)) (t (error "defadvice: Illegal or ambiguous flag: %s" flag)))))) args)) (advice (ad-make-advice name (memq 'protect flags) (not (memq 'disable flags)) (` (advice lambda (, arglist) (,@ body))))) (preactivation (if (memq 'preactivate flags) (ad-preactivate-advice function advice class position)))) ;; Now for the things to be done at evaluation time: (if (memq 'freeze flags) ;; jwz's idea: Freeze the advised definition into a dumpable ;; defun/defmacro whose docs can be written to the DOC file: (ad-make-freeze-definition function advice class position) ;; the normal case: (` (progn (ad-add-advice '(, function) '(, advice) '(, class) '(, position)) (,@ (if preactivation (` ((ad-set-cache '(, function) ;; the function will get compiled: (, (cond ((ad-macro-p (car preactivation)) (` (ad-macrofy (function (, (ad-lambdafy (car preactivation))))))) (t (` (function (, (car preactivation))))))) '(, (car (cdr preactivation)))))))) (,@ (if (memq 'activate flags) (` ((ad-activate-on '(, function) (, (if (memq 'compile flags) t))))))) '(, function)))))) ;; @@ Tools: ;; ========= (defmacro ad-with-originals (functions &rest body) "Binds FUNCTIONS to their original definitions and executes BODY. For any members of FUNCTIONS that are not currently advised the rebinding will be a noop. Any modifications done to the definitions of FUNCTIONS will be undone on exit of this macro." (let* ((index -1) ;; Make let-variables to store current definitions: (current-bindings (mapcar (function (lambda (function) (setq index (1+ index)) (list (intern (format "ad-oRiGdEf-%d" index)) (` (symbol-function '(, function)))))) functions))) (` (let (, current-bindings) (unwind-protect (progn (,@ (progn ;; Make forms to redefine functions to their ;; original definitions if they are advised: (setq index -1) (mapcar (function (lambda (function) (setq index (1+ index)) (` (ad-safe-fset '(, function) (or (ad-get-orig-definition '(, function)) (, (car (nth index current-bindings)))))))) functions))) (,@ body)) (,@ (progn ;; Make forms to back-define functions to the definitions ;; they had outside this macro call: (setq index -1) (mapcar (function (lambda (function) (setq index (1+ index)) (` (ad-safe-fset '(, function) (, (car (nth index current-bindings))))))) functions)))))))) (if (not (get 'ad-with-originals 'lisp-indent-hook)) (put 'ad-with-originals 'lisp-indent-hook 1)) ;; @@ Advising `documentation': ;; ============================ ;; Use the advice mechanism to advise `documentation' to make it ;; generate proper documentation strings for advised definitions: (defadvice documentation (after ad-advised-docstring first disable preact) "Builds an advised docstring if FUNCTION is advised." ;; Because we get the function name from the advised docstring ;; this will work for function names as well as for definitions: (if (and (stringp ad-return-value) (string-match ad-advised-definition-docstring-regexp ad-return-value)) (let ((function (car (read-from-string ad-return-value (match-beginning 1) (match-end 1))))) (cond ((ad-is-advised function) (setq ad-return-value (ad-make-advised-docstring function)) ;; Handle optional `raw' argument: (if (not (ad-get-arg 1)) (setq ad-return-value (substitute-command-keys ad-return-value)))))))) ;; @@ Starting, stopping and recovering from the advice package magic: ;; =================================================================== (defun ad-start-advice () "Starts the automatic advice handling magic." (interactive) ;; Advising `ad-activate' means death!! (ad-set-advice-info 'ad-activate nil) (ad-safe-fset 'ad-activate 'ad-activate-on) (ad-enable-advice 'documentation 'after 'ad-advised-docstring) (ad-activate-on 'documentation 'compile)) (defun ad-stop-advice () "Stops the automatic advice handling magic. You should only need this in case of Advice-related emergencies." (interactive) ;; Advising `ad-activate' means death!! (ad-set-advice-info 'ad-activate nil) (ad-disable-advice 'documentation 'after 'ad-advised-docstring) (ad-update 'documentation) (ad-safe-fset 'ad-activate 'ad-activate-off)) (defun ad-recover-normality () "Undoes all advice related redefinitions and unadvises everything. Use only in REAL emergencies." (interactive) ;; Advising `ad-activate' means death!! (ad-set-advice-info 'ad-activate nil) (ad-safe-fset 'ad-activate 'ad-activate-off) (ad-recover-all) (setq ad-advised-functions nil)) ;; Until the Advice-related changes to `data.c' are part of Lemacs we ;; have to load the old implementation of advice activation hooks: (if (ad-lemacs-p) (require 'ad-hooks)) (ad-start-advice) (provide 'advice) ;;; advice.el ends here emacs-19.30/lisp/allout.el100444 12120 1 514571 6045200566 13751 0ustar rmsdaemon;;; allout.el --- Extensive outline mode for use alone and with other modes. ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. ;; Author: Ken Manheimer ;; Maintainer: Ken Manheimer ;; Created: Dec 1991 - first release to usenet ;; Version: Id: allout.el,v 4.3 1994/05/12 17:43:08 klm Exp || ;; Keywords: outline mode ;; 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: ;; Allout outline mode provides extensive outline formatting and ;; manipulation capabilities, subsuming and well beyond that of ;; standard emacs outline mode. It is specifically aimed at ;; supporting outline structuring and manipulation of syntax- ;; sensitive text, eg programming languages. (For an example, see the ;; allout code itself, which is organized in outline structure.) ;; ;; It also includes such things as topic-oriented repositioning, cut, and ;; paste; integral outline exposure-layout; incremental search with ;; dynamic exposure/conceament of concealed text; automatic topic-number ;; maintenance; and many other features. ;; ;; See the docstring of the variables `outline-layout' and ;; `outline-auto-activation' for details on automatic activation of ;; allout outline-mode as a minor mode. (It has changed since allout ;; 3.x, for those of you that depend on the old method.) ;; ;; Note - the lines beginning with ';;;_' are outline topic headers. ;; Just 'ESC-x eval-current-buffer' to give it a whirl. ;;Ken Manheimer 301 975-3539 ;;ken.manheimer@nist.gov FAX: 301 963-9137 ;; ;;Computer Systems and Communications Division ;; ;; Nat'l Institute of Standards and Technology ;; Technology A151 ;; Gaithersburg, MD 20899 ;;;_* Provide (provide 'outline) (provide 'allout) ;;;_* USER CUSTOMIZATION VARIABLES: ;;;_ + Layout, Mode, and Topic Header Configuration ;;;_ = outline-auto-activation (defvar outline-auto-activation nil "*Regulates auto-activation modality of allout outlines - see `outline-init'. Setq-default by `outline-init' to regulate whether or not allout outline mode is automatically activated when the buffer-specific variable `outline-layout' is non-nil, and whether or not the layout dictated by `outline-layout' should be imposed on mode activation. With value `t', auto-mode-activation and auto-layout are enabled. \(This also depends on `outline-find-file-hooks' being installed in `find-file-hooks', which is also done by `outline-init'.) With value `ask', auto-mode-activation is enabled, and endorsement for performing auto-layout is asked of the user each time. With value `activate', only auto-mode-activation is enabled, auto- layout is not. With value `nil', neither auto-mode-activation nor auto-layout are enabled. See the docstring for `outline-init' for the proper interface to this variable.") ;;;_ = outline-layout (defvar outline-layout nil "*Layout specification and provisional mode trigger for allout outlines. Buffer-specific. A list value specifies a default layout for the current buffer, to be applied upon activation of allout outline-mode. Any non-nil value will automatically trigger allout outline-mode, provided `outline- init' has been called to enable it. See the docstring for `outline-init' for details on setting up for auto-mode-activation, and for `outline-expose-topic' for the format of the layout specification. You can associate a particular outline layout with a file by setting this var via the file's local variables. For example, the following lines at the bottom of an Emacs Lisp file: ;;;Local variables: ;;;outline-layout: \(0 : -1 -1 0\) ;;;End: will, modulo the above-mentioned conditions, cause the mode to be activated when the file is visited, followed by the equivalent of `\(outline-expose-topic 0 : -1 -1 0\)'. \(This is the layout used for the allout.el, itself.) Also, allout's mode-specific provisions will make topic prefixes default to the comment-start string, if any, of the language of the file. This is modulo the setting of `outline-use-mode-specific- leader', which see.") (make-variable-buffer-local 'outline-layout) ;;;_ = outline-header-prefix (defvar outline-header-prefix "." "*Leading string which helps distinguish topic headers. Outline topic header lines are identified by a leading topic header prefix, which mostly have the value of this var at their front. \(Level 1 topics are exceptions. They consist of only a single character, which is typically set to the outline-primary-bullet. Many outlines start at level 2 to avoid this discrepancy.") (make-variable-buffer-local 'outline-header-prefix) ;;;_ = outline-primary-bullet (defvar outline-primary-bullet "*" "Bullet used for top-level outline topics. Outline topic header lines are identified by a leading topic header prefix, which is concluded by bullets that includes the value of this var and the respective outline-*-bullets-string vars. The value of an asterisk ('*') provides for backwards compatability with the original emacs outline mode. See outline-plain-bullets-string and outline-distinctive-bullets-string for the range of available bullets.") (make-variable-buffer-local 'outline-primary-bullet) ;;;_ = outline-plain-bullets-string (defvar outline-plain-bullets-string (concat outline-primary-bullet "+-:.;,") "*The bullets normally used in outline topic prefixes. See 'outline-distinctive-bullets-string' for the other kind of bullets. DO NOT include the close-square-bracket, ']', as a bullet. Outline mode has to be reactivated in order for changes to the value of this var to take effect.") (make-variable-buffer-local 'outline-plain-bullets-string) ;;;_ = outline-distinctive-bullets-string (defvar outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~\\" "*Persistent outline header bullets used to distinguish special topics. These bullets are not offered among the regular, level-specific rotation, and are not altered by automatic rebulleting, as when shifting the level of a topic. See `outline-plain-bullets-string' for the selection of alternating bullets. You must run 'set-outline-regexp' in order for changes to the value of this var to effect outline-mode operation. DO NOT include the close-square-bracket, ']', on either of the bullet strings.") (make-variable-buffer-local 'outline-distinctive-bullets-string) ;;;_ = outline-use-mode-specific-leader (defvar outline-use-mode-specific-leader t "*When non-nil, use mode-specific topic-header prefixes. Allout outline mode will use the mode-specific `outline-mode-leaders' and/or comment-start string, if any, to lead the topic prefix string, so topic headers look like comments in the programming language. String values are used as they stand. Value `t' means to first check for assoc value in `outline-mode-leaders' alist, then use comment-start string, if any, then use default \(`.'). \(See note about use of comment-start strings, below.\) Set to the symbol for either of `outline-mode-leaders' or `comment-start' to use only one of them, respectively. Value `nil' means to always use the default \(`.'\). comment-start strings that do not end in spaces are tripled, and an '_' underscore is tacked on the end, to distinguish them from regular comment strings. comment-start strings that do end in spaces are not tripled, but an underscore is substituted for the space. \[This presumes that the space is for appearance, not comment syntax. You can use `outline-mode-leaders' to override this behavior, when incorrect.\]") ;;;_ = outline-mode-leaders (defvar outline-mode-leaders '() "Specific outline-prefix leading strings per major modes. Entries will be used in the stead (or lieu) of mode-specific comment-start strings. See also `outline-use-mode-specific-leader'. If you're constructing a string that will comment-out outline structuring so it can be included in program code, append an extra character, like an \"_\" underscore, to distinguish the lead string from regular comments that start at bol.") ;;;_ = outline-old-style-prefixes (defvar outline-old-style-prefixes nil "*When non-nil, use only old-and-crusty outline-mode '*' topic prefixes. Non-nil restricts the topic creation and modification functions to asterix-padded prefixes, so they look exactly like the original emacs-outline style prefixes. Whatever the setting of this variable, both old and new style prefixes are always respected by the topic maneuvering functions.") (make-variable-buffer-local 'outline-old-style-prefixes) ;;;_ = outline-stylish-prefixes - alternating bullets (defvar outline-stylish-prefixes t "*Do fancy stuff with topic prefix bullets according to level, etc. Non-nil enables topic creation, modification, and repositioning functions to vary the topic bullet char (the char that marks the topic depth) just preceding the start of the topic text) according to level. Otherwise, only asterisks ('*') and distinctive bullets are used. This is how an outline can look (but sans indentation) with stylish prefixes: * Top level .* A topic . + One level 3 subtopic . . One level 4 subtopic . . A second 4 subtopic . + Another level 3 subtopic . #1 A numbered level 4 subtopic . #2 Another . ! Another level 4 subtopic with a different distinctive bullet . #4 And another numbered level 4 subtopic This would be an outline with stylish prefixes inhibited (but the numbered and other distinctive bullets retained): * Top level .* A topic . * One level 3 subtopic . * One level 4 subtopic . * A second 4 subtopic . * Another level 3 subtopic . #1 A numbered level 4 subtopic . #2 Another . ! Another level 4 subtopic with a different distinctive bullet . #4 And another numbered level 4 subtopic Stylish and constant prefixes (as well as old-style prefixes) are always respected by the topic maneuvering functions, regardless of this variable setting. The setting of this var is not relevant when outline-old-style-prefixes is non-nil.") (make-variable-buffer-local 'outline-stylish-prefixes) ;;;_ = outline-numbered-bullet (defvar outline-numbered-bullet "#" "*String designating bullet of topics that have auto-numbering; nil for none. Topics having this bullet have automatic maintainence of a sibling sequence-number tacked on, just after the bullet. Conventionally set to \"#\", you can set it to a bullet of your choice. A nil value disables numbering maintainence.") (make-variable-buffer-local 'outline-numbered-bullet) ;;;_ = outline-file-xref-bullet (defvar outline-file-xref-bullet "@" "*Bullet signifying file cross-references, for `outline-resolve-xref'. Set this var to the bullet you want to use for file cross-references. Set it 'nil' if you want to inhibit this capability.") ;;;_ + LaTeX formatting ;;;_ - outline-number-pages (defvar outline-number-pages nil "*Non-nil turns on page numbering for LaTeX formatting of an outline.") ;;;_ - outline-label-style (defvar outline-label-style "\\large\\bf" "*Font and size of labels for LaTeX formatting of an outline.") ;;;_ - outline-head-line-style (defvar outline-head-line-style "\\large\\sl " "*Font and size of entries for LaTeX formatting of an outline.") ;;;_ - outline-body-line-style (defvar outline-body-line-style " " "*Font and size of entries for LaTeX formatting of an outline.") ;;;_ - outline-title-style (defvar outline-title-style "\\Large\\bf" "*Font and size of titles for LaTeX formatting of an outline.") ;;;_ - outline-title (defvar outline-title '(or buffer-file-name (current-buffer-name)) "*Expression to be evaluated to determine the title for LaTeX formatted copy.") ;;;_ - outline-line-skip (defvar outline-line-skip ".05cm" "*Space between lines for LaTeX formatting of an outline.") ;;;_ - outline-indent (defvar outline-indent ".3cm" "*LaTeX formatted depth-indent spacing.") ;;;_ + Miscellaneous customization ;;;_ = outline-keybindings-list ;;; You have to reactivate outline-mode - '(outline-mode t)' - to ;;; institute changes to this var. (defvar outline-keybindings-list () "*List of outline-mode key / function bindings. These bindings will be locally bound on the outline-mode-map. The keys will be prefixed by outline-command-prefix, unless the cell contains a third, no-nil element, in which case the initial string will be used as is.") (setq outline-keybindings-list '( ; Motion commands: ("?t" outline-latexify-exposed) ("\C-n" outline-next-visible-heading) ("\C-p" outline-previous-visible-heading) ("\C-u" outline-up-current-level) ("\C-f" outline-forward-current-level) ("\C-b" outline-backward-current-level) ("\C-a" outline-beginning-of-current-entry) ("\C-e" outline-end-of-current-entry) ;;("\C-n" outline-next-line-or-topic) ;;("\C-p" outline-previous-line-or-topic) ; Exposure commands: ("\C-i" outline-show-children) ("\C-s" outline-show-current-subtree) ("\C-h" outline-hide-current-subtree) ("\C-o" outline-show-current-entry) ("!" outline-show-all) ; Alteration commands: (" " outline-open-sibtopic) ("." outline-open-subtopic) ("," outline-open-supertopic) ("'" outline-shift-in) (">" outline-shift-in) ("<" outline-shift-out) ("\C-m" outline-rebullet-topic) ("*" outline-rebullet-current-heading) ("#" outline-number-siblings) ("\C-k" outline-kill-line t) ("\C-y" outline-yank t) ("\M-y" outline-yank-pop t) ("\C-k" outline-kill-topic) ; Miscellaneous commands: ("\C-@" outline-mark-topic) ("@" outline-resolve-xref) ("?c" outline-copy-exposed))) ;;;_ = outline-command-prefix (defvar outline-command-prefix "\C-c" "*Key sequence to be used as prefix for outline mode command key bindings.") ;;;_ = outline-enwrap-isearch-mode (defvar outline-enwrap-isearch-mode t "*Set non-nil to enable automatic exposure of concealed isearch targets. If non-nil, isearch will expose hidden text encountered in the course of a search, and to reconceal it if the search is continued past it.") ;;;_ = outline-use-hanging-indents (defvar outline-use-hanging-indents t "*If non-nil, topic body text auto-indent defaults to indent of the header. Ie, it is indented to be just past the header prefix. This is relevant mostly for use with indented-text-mode, or other situations where auto-fill occurs. [This feature no longer depends in any way on the 'filladapt.el' lisp-archive package.]") (make-variable-buffer-local 'outline-use-hanging-indents) ;;;_ = outline-reindent-bodies (defvar outline-reindent-bodies (if outline-use-hanging-indents 'text) "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts. When active, topic body lines that are indented even with or beyond their topic header are reindented to correspond with depth shifts of the header. A value of `t' enables reindent in non-programming-code buffers, ie those that do not have the variable `comment-start' set. A value of `force' enables reindent whether or not `comment-start' is set.") (make-variable-buffer-local 'outline-reindent-bodies) ;;;_ = outline-inhibit-protection (defvar outline-inhibit-protection nil "*Non-nil disables warnings and confirmation-checks for concealed-text edits. Outline mode uses emacs change-triggered functions to detect unruly changes to concealed regions. Set this var non-nil to disable the protection, potentially increasing text-entry responsiveness a bit. This var takes effect at outline-mode activation, so you may have to deactivate and then reactivate the mode if you want to toggle the behavior.") ;;;_* CODE - no user customizations below. ;;;_ #1 Internal Outline Formatting and Configuration ;;;_ - Version ;;;_ = outline-version (defvar outline-version (let ((rcs-rev "Revision: 4.3")) (condition-case err (save-match-data (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) (substring rcs-rev (match-beginning 1) (match-end 1))) (error rcs-rev))) "Revision number of currently loaded outline package. \(allout.el)") ;;;_ > outline-version (defun outline-version (&optional here) "Return string describing the loaded outline version." (interactive "P") (let ((msg (concat "Allout Outline Mode v " outline-version))) (if here (insert-string msg)) (message "%s" msg) msg)) ;;;_ - Topic header format ;;;_ = outline-regexp (defvar outline-regexp "" "*Regular expression to match the beginning of a heading line. Any line whose beginning matches this regexp is considered a heading. This var is set according to the user configuration vars by set-outline-regexp.") (make-variable-buffer-local 'outline-regexp) ;;;_ = outline-bullets-string (defvar outline-bullets-string "" "A string dictating the valid set of outline topic bullets. This var should *not* be set by the user - it is set by 'set-outline-regexp', and is produced from the elements of 'outline-plain-bullets-string' and 'outline-distinctive-bullets-string'.") (make-variable-buffer-local 'outline-bullets-string) ;;;_ = outline-bullets-string-len (defvar outline-bullets-string-len 0 "Length of current buffers' outline-plain-bullets-string.") (make-variable-buffer-local 'outline-bullets-string-len) ;;;_ = outline-line-boundary-regexp (defvar outline-line-boundary-regexp () "Outline-regexp with outline-style beginning-of-line anchor. \(Ie, C-j, *or* C-m, for prefixes of hidden topics). This is properly set when outline-regexp is produced by 'set-outline-regexp', so that (match-beginning 2) and (match-end 2) delimit the prefix.") (make-variable-buffer-local 'outline-line-boundary-regexp) ;;;_ = outline-bob-regexp (defvar outline-bob-regexp () "Like outline-line-boundary-regexp, for headers at beginning of buffer. \(match-beginning 2) and (match-end 2) delimit the prefix.") (make-variable-buffer-local 'outline-bob-regexp) ;;;_ = outline-header-subtraction (defvar outline-header-subtraction (1- (length outline-header-prefix)) "Outline-header prefix length to subtract when computing topic depth.") (make-variable-buffer-local 'outline-header-subtraction) ;;;_ = outline-plain-bullets-string-len (defvar outline-plain-bullets-string-len (length outline-plain-bullets-string) "Length of outline-plain-bullets-string, updated by set-outline-regexp.") (make-variable-buffer-local 'outline-plain-bullets-string-len) ;;;_ X outline-reset-header-lead (header-lead) (defun outline-reset-header-lead (header-lead) "*Reset the leading string used to identify topic headers." (interactive "sNew lead string: ") (setq outline-header-prefix header-lead) (setq outline-header-subtraction (1- (length outline-header-prefix))) (set-outline-regexp)) ;;;_ X outline-lead-with-comment-string (header-lead) (defun outline-lead-with-comment-string (&optional header-lead) "*Set the topic-header leading string to specified string. Useful when for encapsulating outline structure in programming language comments. Returns the leading string." (interactive "P") (if (not (stringp header-lead)) (setq header-lead (read-string "String prefix for topic headers: "))) (setq outline-reindent-bodies nil) (outline-reset-header-lead header-lead) header-lead) ;;;_ > outline-infer-header-lead () (defun outline-infer-header-lead () "Determine appropriate `outline-header-prefix'. Works according to settings of: `comment-start' `outline-header-prefix' (default) `outline-use-mode-specific-leader' and `outline-mode-leaders'. Apply this via \(re\)activation of `outline-mode', rather than invoking it directly." (let* ((use-leader (and (boundp 'outline-use-mode-specific-leader) (if (or (stringp outline-use-mode-specific-leader) (memq outline-use-mode-specific-leader '(outline-mode-leaders comment-start t))) outline-use-mode-specific-leader ;; Oops - garbled value, equate with effect of 't: t))) (leader (cond ((not use-leader) nil) ;; Use the explicitly designated leader: ((stringp use-leader) use-leader) (t (or (and (memq use-leader '(t outline-mode-leaders)) ;; Get it from outline mode leaders? (cdr (assq major-mode outline-mode-leaders))) ;; ... didn't get from outline-mode-leaders... (and (memq use-leader '(t comment-start)) comment-start ;; Use comment-start, maybe tripled, and with ;; underscore: (concat (if (string= " " (substring comment-start (1- (length comment-start)))) ;; Use comment-start, sans trailing space: (substring comment-start 0 -1) (concat comment-start comment-start comment-start)) ;; ... and append underscore, whichever: "_"))))))) (if (not leader) nil (if (string= leader outline-header-prefix) nil ; no change, nothing to do. (setq outline-header-prefix leader) outline-header-prefix)))) ;;;_ > outline-infer-body-reindent () (defun outline-infer-body-reindent () "Determine proper setting for `outline-reindent-bodies'. Depends on default setting of `outline-reindent-bodies' \(which see) and presence of setting for `comment-start', to tell whether the file is programming code." (if (and outline-reindent-bodies comment-start (not (eq 'force outline-reindent-bodies))) (setq outline-reindent-bodies nil))) ;;;_ > set-outline-regexp () (defun set-outline-regexp () "Generate proper topic-header regexp form for outline functions. Works with respect to `outline-plain-bullets-string' and `outline-distinctive-bullets-string'." (interactive) ;; Derive outline-bullets-string from user configured components: (setq outline-bullets-string "") (let ((strings (list 'outline-plain-bullets-string 'outline-distinctive-bullets-string)) cur-string cur-len cur-char cur-char-string index new-string) (while strings (setq new-string "") (setq index 0) (setq cur-len (length (setq cur-string (symbol-value (car strings))))) (while (< index cur-len) (setq cur-char (aref cur-string index)) (setq outline-bullets-string (concat outline-bullets-string (cond ; Single dash would denote a ; sequence, repeated denotes ; a dash: ((eq cur-char ?-) "--") ; literal close-square-bracket ; doesn't work right in the ; expr, exclude it: ((eq cur-char ?\]) "") (t (regexp-quote (char-to-string cur-char)))))) (setq index (1+ index))) (setq strings (cdr strings))) ) ;; Derive next for repeated use in outline-pending-bullet: (setq outline-plain-bullets-string-len (length outline-plain-bullets-string)) (setq outline-header-subtraction (1- (length outline-header-prefix))) ;; Produce the new outline-regexp: (setq outline-regexp (concat "\\(\\" outline-header-prefix "[ \t]*[" outline-bullets-string "]\\)\\|\\" outline-primary-bullet "+\\|\^l")) (setq outline-line-boundary-regexp (concat "\\([\n\r]\\)\\(" outline-regexp "\\)")) (setq outline-bob-regexp (concat "\\(\\`\\)\\(" outline-regexp "\\)")) ) ;;;_ - Key bindings ;;;_ = outline-mode-map (defvar outline-mode-map nil "Keybindings for (allout) outline minor mode.") ;;;_ > produce-outline-mode-map (keymap-alist &optional base-map) (defun produce-outline-mode-map (keymap-list &optional base-map) "Produce keymap for use as outline-mode-map, from keymap-list. Built on top of optional BASE-MAP, or empty sparse map if none specified. See doc string for outline-keybindings-list for format of binding list." (let ((map (or base-map (make-sparse-keymap)))) (mapcar (lambda (cell) (apply 'define-key map (if (null (cdr (cdr cell))) (cons (concat outline-command-prefix (car cell)) (cdr cell)) (list (car cell) (car (cdr cell)))))) keymap-list) map)) ;;;_ = outline-prior-bindings - being deprecated. (defvar outline-prior-bindings nil "Variable for use in V18, with outline-added-bindings, for resurrecting, on mode deactivation, bindings that existed before activation. Being deprecated.") ;;;_ = outline-added-bindings - being deprecated (defvar outline-added-bindings nil "Variable for use in V18, with outline-prior-bindings, for resurrecting, on mode deactivation, bindings that existed before activation. Being deprecated.") ;;;_ - Mode-Specific Variable Maintenance Utilities ;;;_ = outline-mode-prior-settings (defvar outline-mode-prior-settings nil "Internal outline mode use; settings to be resumed on mode deactivation.") (make-variable-buffer-local 'outline-mode-prior-settings) ;;;_ > outline-resumptions (name &optional value) (defun outline-resumptions (name &optional value) "Registers or resumes settings over outline-mode activation/deactivation. First arg is NAME of variable affected. Optional second arg is list containing outline-mode-specific VALUE to be imposed on named variable, and to be registered. (It's a list so you can specify registrations of null values.) If no value is specified, the registered value is returned (encapsulated in the list, so the caller can distinguish nil vs no value), and the registration is popped from the list." (let ((on-list (assq name outline-mode-prior-settings)) prior-capsule ; By 'capsule' i mean a list ; containing a value, so we can ; distinguish nil from no value. ) (if value ;; Registering: (progn (if on-list nil ; Already preserved prior value - don't mess with it. ;; Register the old value, or nil if previously unbound: (setq outline-mode-prior-settings (cons (list name (if (boundp name) (list (symbol-value name)))) outline-mode-prior-settings))) ; And impose the new value, locally: (progn (make-local-variable name) (set name (car value)))) ;; Relinquishing: (if (not on-list) ;; Oops, not registered - leave it be: nil ;; Some registration: ; reestablish it: (setq prior-capsule (car (cdr on-list))) (if prior-capsule (set name (car prior-capsule)) ; Some prior value - reestablish it. (makunbound name)) ; Previously unbound - demolish var. ; Remove registration: (let (rebuild) (while outline-mode-prior-settings (if (not (eq (car outline-mode-prior-settings) on-list)) (setq rebuild (cons (car outline-mode-prior-settings) rebuild))) (setq outline-mode-prior-settings (cdr outline-mode-prior-settings))) (setq outline-mode-prior-settings rebuild))))) ) ;;;_ - Mode-specific incidentals ;;;_ = outline-during-write-cue nil (defvar outline-during-write-cue nil "Used to inhibit outline change-protection during file write. See also `outline-post-command-business', `outline-write-file-hook', `outline-before-change-protect', and `outline-post-command-business' functions.") ;;;_ = outline-override-protect nil (defvar outline-override-protect nil "Used in outline-mode for regulate of concealed-text protection mechanism. Allout outline mode regulates alteration of concealed text to protect against inadvertant, unnoticed changes. This is for use by specific, native outline functions to temporarily override that protection. It's automatically reset to nil after every buffer modification.") (make-variable-buffer-local 'outline-override-protect) ;;;_ > outline-unprotected (expr) (defmacro outline-unprotected (expr) "Evaluate EXPRESSION with `outline-override-protect' let-bound 't'." (` (let ((outline-override-protect t)) (, expr)))) ;;;_ = outline-undo-aggregation (defvar outline-undo-aggregation 30 "Amount of successive self-insert actions to bunch together per undo. This is purely a kludge variable, regulating the compensation for a bug in the way that before-change-function and undo interact.") (make-variable-buffer-local 'outline-undo-aggregation) ;;;_ = file-var-bug hack (defvar outline-v18/9-file-var-hack nil "Horrible hack used to prevent invalid multiple triggering of outline mode from prop-line file-var activation. Used by outline-mode function to track repeats.") ;;;_ > outline-write-file-hook () (defun outline-write-file-hook () "In outline mode, run as a local-write-file-hooks activity. Currently just sets 'outline-during-write-cue', so outline-change- protection knows to keep inactive during file write." (setq outline-during-write-cue t) nil) ;;;_ #2 Mode activation ;;;_ = outline-mode (defvar outline-mode () "Allout outline mode minor-mode flag.") (make-variable-buffer-local 'outline-mode) ;;;_ > outline-mode-p () (defmacro outline-mode-p () "Return t if outline-mode is active in current buffer." 'outline-mode) ;;;_ = outline-explicitly-deactivated (defvar outline-explicitly-deactivated nil "Outline-mode was last deliberately deactived. So outline-post-command-business should not reactivate it...") (make-variable-buffer-local 'outline-explicitly-deactivated) ;;;_ > outline-init (&optional mode) (defun outline-init (&optional mode) "Prime outline-mode to enable/disable auto-activation, wrt `outline-layout'. MODE is one of the following symbols: - nil \(or no argument) deactivate auto-activation/layou; - 'activate', enable auto-activation only; - 'ask', enable auto-activation, and enable auto-layout but with confirmation for layout operation solicitated from user each time; - 'report', just report and return the current auto-activation state; - anything else \(eg, t) for auto-activation and auto-layout, without any confirmation check. Use this function to setup your emacs session for automatic activation of allout outline mode, contingent to the buffer-specific setting of the `outline-layout' variable. (See `outline-layout' and `outline-expose-topic' docstrings for more details on auto layout). `outline-init' works by setting up (or removing) the outline-mode find-file-hook, and giving `outline-auto-activation' a suitable setting. To prime your emacs session for full auto-outline operation, include the following two lines in your emacs init file: \(require 'allout) \(outline-init t)" (interactive) (if (interactive-p) (progn (setq mode (completing-read (concat "Select outline auto setup mode " "(empty for report, ? for options) ") '(("nil")("full")("activate")("deactivate") ("ask") ("report") ("")) nil t)) (if (string= mode "") (setq mode 'report) (setq mode (intern-soft mode))))) (let ;; convenience aliases, for consistent ref to respective vars: ((hook 'outline-find-file-hook) (curr-mode 'outline-auto-activation)) (cond ((not mode) (setq find-file-hooks (delq hook find-file-hooks)) (if (interactive-p) (message "Allout outline mode auto-activation inhibited."))) ((eq mode 'report) (if (not (memq hook find-file-hooks)) (outline-init nil) ;; Just punt and use the reports from each of the modes: (outline-init (symbol-value curr-mode)))) (t (add-hook 'find-file-hooks hook) (set curr-mode ; 'set', not 'setq'! (cond ((eq mode 'activate) (message "Outline mode auto-activation enabled.") 'activate) ((eq mode 'report) ;; Return the current mode setting: (outline-init mode)) ((eq mode 'ask) (message (concat "Outline mode auto-activation and " "-layout \(upon confirmation) enabled.")) 'ask) ((message "Outline mode auto-activation and -layout enabled.") 'full))))))) ;;;_ > outline-mode (&optional toggle) ;;;_ : Defun: (defun outline-mode (&optional toggle) ;;;_ . Doc string: "Toggle minor mode for controlling exposure and editing of text outlines. Optional arg forces mode reactivation iff arg is positive num or symbol. Allout outline mode provides extensive outline formatting and manipulation capabilities. It is specifically aimed at supporting outline structuring and manipulation of syntax-sensitive text, eg programming languages. \(For an example, see the allout code itself, which is organized in outline structure.\) It also includes such things as topic-oriented repositioning, cut, and paste; integral outline exposure-layout; incremental search with dynamic exposure/conceament of concealed text; automatic topic-number maintenance; and many other features. See the docstring of the variable `outline-init' for instructions on priming your emacs session for automatic activation of outline-mode, according to file-var settings of the `outline-layout' variable. Below is a description of the bindings, and then explanation of special outline-mode features and terminology. The bindings themselves are established according to the values of variables `outline-keybindings-list' and `outline-command-prefix', each time the mode is invoked. Prior bindings are resurrected when the mode is revoked. Navigation: Exposure Control: ---------- ---------------- C-c C-n outline-next-visible-heading | C-c C-h outline-hide-current-subtree C-c C-p outline-previous-visible-heading | C-c C-i outline-show-children C-c C-u outline-up-current-level | C-c C-s outline-show-current-subtree C-c C-f outline-forward-current-level | C-c C-o outline-show-current-entry C-c C-b outline-backward-current-level | ^U C-c C-s outline-show-all C-c C-e outline-end-of-current-entry | outline-hide-current-leaves C-c C-a outline-beginning-of-current-entry, alternately, goes to hot-spot Topic Header Production: ----------------------- C-c outline-open-sibtopic Create a new sibling after current topic. C-c . outline-open-subtopic ... an offspring of current topic. C-c , outline-open-supertopic ... a sibling of the current topic's parent. Topic Level and Prefix Adjustment: --------------------------------- C-c > outline-shift-in Shift current topic and all offspring deeper. C-c < outline-shift-out ... less deep. C-c outline-rebullet-topic Reconcile bullets of topic and its' offspring - distinctive bullets are not changed, others alternated according to nesting depth. C-c * outline-rebullet-current-heading Prompt for alternate bullet for current topic. C-c # outline-number-siblings Number bullets of topic and siblings - the offspring are not affected. With repeat count, revoke numbering. Topic-oriented Killing and Yanking: ---------------------------------- C-c C-k outline-kill-topic Kill current topic, including offspring. C-k outline-kill-line Like kill-line, but reconciles numbering, etc. C-y outline-yank Yank, adjusting depth of yanked topic to depth of heading if yanking into bare topic heading (ie, prefix sans text). M-y outline-yank-pop Is to outline-yank as yank-pop is to yank Misc commands: ------------- C-c @ outline-resolve-xref pop-to-buffer named by xref (cf outline-file-xref-bullet) C-c c outline-copy-exposed Copy current topic outline sans concealed text, to buffer with name derived from current buffer - \"XXX exposed\" M-x outlineify-sticky Activate outline mode for current buffer, and establish a default file-var setting for `outline-layout'. ESC ESC (outline-init t) Setup emacs session for outline mode auto-activation. HOT-SPOT Operation Hot-spot operation provides a means for easy, single-keystroke outline navigation and exposure control. \\ When the text cursor is positioned directly on the bullet character of a topic, regular characters (a to z) invoke the commands of the corresponding outline-mode keymap control chars. For example, \"f\" would invoke the command typically bound to \"C-c C-f\" \(\\[outline-forward-current-level] `outline-forward-current-level'). Thus, by positioning the cursor on a topic bullet, you can execute the outline navigation and manipulation commands with a single keystroke. Non-literal chars never get this special translation, so you can use them to get away from the hot-spot, and back to normal operation. Note that the command `outline-beginning-of-current-entry' \(\\[outline-beginning-of-current-entry]\) will move to the hot-spot when the cursor is already located at the beginning of the current entry, so you can simply hit \\[outline-beginning-of-current-entry] twice in a row to get to the hot-spot. Terminology Topic hierarchy constituents - TOPICS and SUBTOPICS: TOPIC: A basic, coherent component of an emacs outline. It can contain other topics, and it can be subsumed by other topics, CURRENT topic: The visible topic most immediately containing the cursor. DEPTH: The degree of nesting of a topic; it increases with containment. Also called the: LEVEL: The same as DEPTH. ANCESTORS: The topics that contain a topic. PARENT: A topic's immediate ancestor. It has a depth one less than the topic. OFFSPRING: The topics contained by a topic; SUBTOPIC: An immediate offspring of a topic; CHILDREN: The immediate offspring of a topic. SIBLINGS: Topics having the same parent and depth. Topic text constituents: HEADER: The first line of a topic, include the topic PREFIX and header text. PREFIX: The leading text of a topic which which distinguishes it from normal text. It has a strict form, which consists of a prefix-lead string, padding, and a bullet. The bullet may be followed by a number, indicating the ordinal number of the topic among its siblings, a space, and then the header text. The relative length of the PREFIX determines the nesting depth of the topic. PREFIX-LEAD: The string at the beginning of a topic prefix, normally a '.'. It can be customized by changing the setting of `outline-header-prefix' and then reinitializing outline-mode. By setting the prefix-lead to the comment-string of a programming language, you can embed outline-structuring in program code without interfering with the language processing of that code. See `outline-use-mode-specific-leader' docstring for more detail. PREFIX-PADDING: Spaces or asterisks which separate the prefix-lead and the bullet, according to the depth of the topic. BULLET: A character at the end of the topic prefix, it must be one of the characters listed on 'outline-plain-bullets-string' or 'outline-distinctive-bullets-string'. (See the documentation for these variables for more details.) The default choice of bullet when generating varies in a cycle with the depth of the topic. ENTRY: The text contained in a topic before any offspring. BODY: Same as ENTRY. EXPOSURE: The state of a topic which determines the on-screen visibility of its' offspring and contained text. CONCEALED: Topics and entry text whose display is inhibited. Contiguous units of concealed text is represented by '...' ellipses. (Ref the 'selective-display' var.) Concealed topics are effectively collapsed within an ancestor. CLOSED: A topic whose immediate offspring and body-text is concealed. OPEN: A topic that is not closed, though its' offspring or body may be." ;;;_ . Code (interactive "P") (let* ((active (and (not (equal major-mode 'outline)) (outline-mode-p))) ; Massage universal-arg 'toggle' val: (toggle (and toggle (or (and (listp toggle)(car toggle)) toggle))) ; Activation specficially demanded? (explicit-activation (or ;; (and toggle (or (symbolp toggle) (and (natnump toggle) (not (zerop toggle))))))) ;; outline-mode already called once during this complex command? (same-complex-command (eq outline-v18/9-file-var-hack (car command-history))) do-layout ) ; See comments below re v19.18,.19 bug. (setq outline-v18/9-file-var-hack (car command-history)) (cond ;; Provision for v19.18, 19.19 bug - ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated ;; modes twice when file is visited. We have to avoid toggling mode ;; off on second invocation, so we detect it as best we can, and ;; skip everything. ((and same-complex-command ; Still in same complex command ; as last time outline-mode invoked. active ; Already activated. (not explicit-activation) ; Prop-line file-vars don't have args. (string-match "^19.1[89]" ; Bug only known to be in v19.18 and emacs-version)); 19.19. t) ;; Deactivation: ((and (not explicit-activation) (or active toggle)) ; Activation not explicitly ; requested, and either in ; active state or *de*activation ; specifically requested: (setq outline-explicitly-deactivated t) (if (string-match "^18\." emacs-version) ; Revoke those keys that remain ; as we set them: (let ((curr-loc (current-local-map))) (mapcar '(lambda (cell) (if (eq (lookup-key curr-loc (car cell)) (car (cdr cell))) (define-key curr-loc (car cell) (assq (car cell) outline-prior-bindings)))) outline-added-bindings) (outline-resumptions 'outline-added-bindings) (outline-resumptions 'outline-prior-bindings))) (if outline-old-style-prefixes (progn (outline-resumptions 'outline-primary-bullet) (outline-resumptions 'outline-old-style-prefixes))) (outline-resumptions 'selective-display) (if (and (boundp 'before-change-function) before-change-function) (outline-resumptions 'before-change-function)) (setq pre-command-hook (delq 'outline-pre-command-business pre-command-hook)) (setq local-write-file-hooks (delq 'outline-write-file-hook local-write-file-hooks)) (outline-resumptions 'paragraph-start) (outline-resumptions 'paragraph-separate) (outline-resumptions (if (string-match "^18" emacs-version) 'auto-fill-hook 'auto-fill-function)) (outline-resumptions 'outline-former-auto-filler) (setq outline-mode nil)) ;; Activation: ((not active) (setq outline-explicitly-deactivated nil) (if outline-old-style-prefixes (progn ; Inhibit all the fancy formatting: (outline-resumptions 'outline-primary-bullet '("*")) (outline-resumptions 'outline-old-style-prefixes '(())))) (outline-infer-header-lead) (outline-infer-body-reindent) (set-outline-regexp) ; Produce map from current version ; of outline-keybindings-list: (if (boundp 'minor-mode-map-alist) (progn ; V19, and maybe lucid and ; epoch, minor-mode key bindings: (setq outline-mode-map (produce-outline-mode-map outline-keybindings-list)) (fset 'outline-mode-map outline-mode-map) ; Include on minor-mode-map-alist, ; if not already there: (if (not (member '(outline-mode . outline-mode-map) minor-mode-map-alist)) (setq minor-mode-map-alist (cons '(outline-mode . outline-mode-map) minor-mode-map-alist)))) ; V18 minor-mode key bindings: ; Stash record of added bindings ; for later revocation: (outline-resumptions 'outline-added-bindings (list outline-keybindings-list)) (outline-resumptions 'outline-prior-bindings (list (current-local-map))) ; and add them: (use-local-map (produce-outline-mode-map outline-keybindings-list (current-local-map))) ) ; selective-display is the ; emacs conditional exposure ; mechanism: (outline-resumptions 'selective-display '(t)) (if outline-inhibit-protection t (outline-resumptions 'before-change-function '(outline-before-change-protect))) ; Temporarily set by any outline ; functions that can be trusted to ; deal properly with concealed text. (add-hook 'local-write-file-hooks 'outline-write-file-hook) ; Custom auto-fill func, to support ; respect for topic headline, ; hanging-indents, etc: (let* ((fill-func-var (if (string-match "^18" emacs-version) 'auto-fill-hook 'auto-fill-function)) (fill-func (symbol-value fill-func-var))) ;; Register prevailing fill func for use by outline-auto-fill: (outline-resumptions 'outline-former-auto-filler (list fill-func)) ;; Register outline-auto-fill to be used if filling is active: (outline-resumptions fill-func-var '(outline-auto-fill))) ;; Paragraphs are broken by topic headlines. (make-local-variable 'paragraph-start) (outline-resumptions 'paragraph-start (list (concat paragraph-start "\\|\\(" outline-regexp "\\)"))) (make-local-variable 'paragraph-separate) (outline-resumptions 'paragraph-separate (list (concat paragraph-separate "\\|\\(" outline-regexp "\\)"))) (or (assq 'outline-mode minor-mode-alist) (setq minor-mode-alist (cons '(outline-mode " Outl") minor-mode-alist))) (if outline-layout (setq do-layout t)) (if outline-enwrap-isearch-mode (outline-enwrap-isearch)) (run-hooks 'outline-mode-hook) (setq outline-mode t)) ;; Reactivation: ((setq do-layout t) (outline-infer-body-reindent)) ) ; cond (if (and do-layout outline-auto-activation (listp outline-layout) (and (not (eq outline-auto-activation 'activate)) (if (eq outline-auto-activation 'ask) (if (y-or-n-p (format "Expose %s with layout '%s'? " (buffer-name) outline-layout)) t (message "Skipped %s layout." (buffer-name)) nil) t))) (save-excursion (message "Adjusting '%s' exposure..." (buffer-name)) (goto-char 0) (outline-this-or-next-heading) (condition-case err (progn (apply 'outline-expose-topic (list outline-layout)) (message "Adjusting '%s' exposure... done." (buffer-name))) ;; Problem applying exposure - notify user, but don't ;; interrupt, eg, file visit: (error (message "%s" (car (cdr err))) (sit-for 1))))) outline-mode ) ; let* ) ; defun ;;;_ #3 Internal Position State-Tracking - "outline-recent-*" funcs ;;; All the basic outline functions that directly do string matches to ;;; evaluate heading prefix location set the variables ;;; `outline-recent-prefix-beginning' and `outline-recent-prefix-end' ;;; when successful. Functions starting with `outline-recent-' all ;;; use this state, providing the means to avoid redundant searches ;;; for just-established data. This optimization can provide ;;; significant speed improvement, but it must be employed carefully. ;;;_ = outline-recent-prefix-beginning (defvar outline-recent-prefix-beginning 0 "Buffer point of the start of the last topic prefix encountered.") (make-variable-buffer-local 'outline-recent-prefix-beginning) ;;;_ = outline-recent-prefix-end (defvar outline-recent-prefix-end 0 "Buffer point of the end of the last topic prefix encountered.") (make-variable-buffer-local 'outline-recent-prefix-end) ;;;_ = outline-recent-end-of-subtree (defvar outline-recent-end-of-subtree 0 "Buffer point last returned by outline-end-of-current-subtree.") (make-variable-buffer-local 'outline-recent-end-of-subtree) ;;;_ > outline-prefix-data (beg end) (defmacro outline-prefix-data (beg end) "Register outline-prefix state data - BEGINNING and END of prefix. For reference by 'outline-recent' funcs. Returns BEGINNING." (` (setq outline-recent-prefix-end (, end) outline-recent-prefix-beginning (, beg)))) ;;;_ > outline-recent-depth () (defmacro outline-recent-depth () "Return depth of last heading encountered by an outline maneuvering function. All outline functions which directly do string matches to assess headings set the variables outline-recent-prefix-beginning and outline-recent-prefix-end if successful. This function uses those settings to return the current depth." '(max 1 (- outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction))) ;;;_ > outline-recent-prefix () (defmacro outline-recent-prefix () "Like outline-recent-depth, but returns text of last encountered prefix. All outline functions which directly do string matches to assess headings set the variables outline-recent-prefix-beginning and outline-recent-prefix-end if successful. This function uses those settings to return the current depth." '(buffer-substring outline-recent-prefix-beginning outline-recent-prefix-end)) ;;;_ > outline-recent-bullet () (defmacro outline-recent-bullet () "Like outline-recent-prefix, but returns bullet of last encountered prefix. All outline functions which directly do string matches to assess headings set the variables outline-recent-prefix-beginning and outline-recent-prefix-end if successful. This function uses those settings to return the current depth of the most recently matched topic." '(buffer-substring (1- outline-recent-prefix-end) outline-recent-prefix-end)) ;;;_ #4 Navigation ;;;_ - Position Assessment ;;;_ : Location Predicates ;;;_ > outline-on-current-heading-p () (defun outline-on-current-heading-p () "Return non-nil if point is on current visible topics' header line. Actually, returns prefix beginning point." (save-excursion (beginning-of-line) (and (looking-at outline-regexp) (outline-prefix-data (match-beginning 0) (match-end 0))))) ;;;_ > outline-e-o-prefix-p () (defun outline-e-o-prefix-p () "True if point is located where current topic prefix ends, heading begins." (and (save-excursion (beginning-of-line) (looking-at outline-regexp)) (= (point)(save-excursion (outline-end-of-prefix)(point))))) ;;;_ > outline-hidden-p () (defmacro outline-hidden-p () "True if point is in hidden text." '(save-excursion (and (re-search-backward "[\n\r]" () t) (= ?\r (following-char))))) ;;;_ > outline-visible-p () (defmacro outline-visible-p () "True if point is not in hidden text." (interactive) '(not (outline-hidden-p))) ;;;_ : Location attributes ;;;_ > outline-depth () (defmacro outline-depth () "Like outline-current-depth, but respects hidden as well as visible topics." '(save-excursion (if (outline-goto-prefix) (outline-recent-depth) (progn ;; Oops, no prefix, zero prefix data: (outline-prefix-data (point)(point)) ;; ... and return 0: 0)))) ;;;_ > outline-current-depth () (defmacro outline-current-depth () "Return nesting depth of visible topic most immediately containing point." '(save-excursion (if (outline-back-to-current-heading) (max 1 (- outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction)) 0))) ;;;_ > outline-get-current-prefix () (defun outline-get-current-prefix () "Topic prefix of the current topic." (save-excursion (if (outline-goto-prefix) (outline-recent-prefix)))) ;;;_ > outline-get-bullet () (defun outline-get-bullet () "Return bullet of containing topic (visible or not)." (save-excursion (and (outline-goto-prefix) (outline-recent-bullet)))) ;;;_ > outline-current-bullet () (defun outline-current-bullet () "Return bullet of current (visible) topic heading, or none if none found." (condition-case err (save-excursion (outline-back-to-current-heading) (buffer-substring (- outline-recent-prefix-end 1) outline-recent-prefix-end)) ;; Quick and dirty provision, ostensibly for missing bullet: (args-out-of-range nil)) ) ;;;_ > outline-get-prefix-bullet (prefix) (defun outline-get-prefix-bullet (prefix) "Return the bullet of the header prefix string PREFIX." ;; Doesn't make sense if we're old-style prefixes, but this just ;; oughtn't be called then, so forget about it... (if (string-match outline-regexp prefix) (substring prefix (1- (match-end 0)) (match-end 0)))) ;;;_ - Navigation macros ;;;_ > outline-next-heading () (defmacro outline-next-heading () "Move to the heading for the topic \(possibly invisible) before this one. Returns the location of the heading, or nil if none found." '(if (and (bobp) (not (eobp))) (forward-char 1)) '(if (re-search-forward outline-line-boundary-regexp nil 0) (progn ; Got valid location state - set vars: (outline-prefix-data (goto-char (or (match-beginning 2) outline-recent-prefix-beginning)) (or (match-end 2) outline-recent-prefix-end))))) ;;;_ : outline-this-or-next-heading (defun outline-this-or-next-heading () "Position cursor on current or next heading." ;; A throwaway non-macro that is defined after outline-next-heading ;; and usable by outline-mode. (if (not (outline-goto-prefix)) (outline-next-heading))) ;;;_ > outline-previous-heading () (defmacro outline-previous-heading () "Move to the prior \(possibly invisible) heading line. Return the location of the beginning of the heading, or nil if not found." '(if (bobp) nil (outline-goto-prefix) (if ;; searches are unbounded and return nil if failed: (or (re-search-backward outline-line-boundary-regexp nil 0) (looking-at outline-bob-regexp)) (progn ; Got valid location state - set vars: (outline-prefix-data (goto-char (or (match-beginning 2) outline-recent-prefix-beginning)) (or (match-end 2) outline-recent-prefix-end)))))) ;;;_ - Subtree Charting ;;;_ " These routines either produce or assess charts, which are ;;; nested lists of the locations of topics within a subtree. ;;; ;;; Use of charts enables efficient navigation of subtrees, by ;;; requiring only a single regexp-search based traversal, to scope ;;; out the subtopic locations. The chart then serves as the basis ;;; for whatever assessment or adjustment of the subtree that is ;;; required, without requiring redundant topic-traversal procedures. ;;;_ > outline-chart-subtree (&optional levels orig-depth prev-depth) (defun outline-chart-subtree (&optional levels orig-depth prev-depth) "Produce a location \"chart\" of subtopics of the containing topic. Optional argument LEVELS specifies the depth \(releative to start depth\) for the chart. Subsequent optional args are not for public use. Charts are used to capture outline structure, so that outline-altering routines need assess the structure only once, and then use the chart for their elaborate manipulations. Topics are entered in the chart so the last one is at the car. The entry for each topic consists of an integer indicating the point at the beginning of the topic. Charts for offspring consists of a list containing, recursively, the charts for the respective subtopics. The chart for a topics' offspring precedes the entry for the topic itself. The other function parameters are for internal recursion, and should not be specified by external callers. ORIG-DEPTH is depth of topic at starting point, and PREV-DEPTH is depth of prior topic." (let ((original (not orig-depth)) ; 'orig-depth' set only in recursion. chart curr-depth) (if original ; Just starting? ; Register initial settings and ; position to first offspring: (progn (setq orig-depth (outline-depth)) (or prev-depth (setq prev-depth (1+ orig-depth))) (outline-next-heading))) ;; Loop over the current levels' siblings. Besides being more ;; efficient than tail-recursing over a level, it avoids exceeding ;; the typically quite constrained emacs max-lisp-eval-depth. ;; Probably would speed things up to implement loop-based stack ;; operation rather than recursing for lower levels. Bah. (while (and (not (eobp)) ; Still within original topic? (< orig-depth (setq curr-depth (outline-recent-depth))) (cond ((= prev-depth curr-depth) ;; Register this one and move on: (setq chart (cons (point) chart)) (if (and levels (<= levels 1)) ;; At depth limit - skip sublevels: (or (outline-next-sibling curr-depth) ;; or no more siblings - proceed to ;; next heading at lesser depth: (while (and (<= curr-depth (outline-recent-depth)) (outline-next-heading)))) (outline-next-heading))) ((and (< prev-depth curr-depth) (or (not levels) (> levels 0))) ;; Recurse on deeper level of curr topic: (setq chart (cons (outline-chart-subtree (and levels (1- levels)) orig-depth curr-depth) chart)) ;; ... then continue with this one. ) ;; ... else nil if we've ascended back to prev-depth. ))) (if original ; We're at the last sibling on ; the original level. Position ; to the end of it: (progn (and (not (eobp)) (forward-char -1)) (and (memq (preceding-char) '(?\n ?\^M)) (memq (aref (buffer-substring (max 1 (- (point) 3)) (point)) 1) '(?\n ?\^M)) (forward-char -1)) (setq outline-recent-end-of-subtree (point)))) chart ; (nreverse chart) not necessary, ; and maybe not preferable. )) ;;;_ > outline-chart-siblings (&optional start end) (defun outline-chart-siblings (&optional start end) "Produce a list of locations of this and succeeding sibling topics. Effectively a top-level chart of siblings. See 'outline-chart-subtree' for an explanation of charts." (save-excursion (if (outline-goto-prefix) (let ((chart (list (point)))) (while (outline-next-sibling) (setq chart (cons (point) chart))) (if chart (setq chart (nreverse chart))))))) ;;;_ > outline-chart-to-reveal (chart depth) (defun outline-chart-to-reveal (chart depth) "Return a flat list of hidden points in subtree CHART, up to DEPTH. Note that point can be left at any of the points on chart, or at the start point." (let (result here) (while (and (or (eq depth t) (> depth 0)) chart) (setq here (car chart)) (if (listp here) (let ((further (outline-chart-to-reveal here (or (eq depth t) (1- depth))))) ;; We're on the start of a subtree - recurse with it, if there's ;; more depth to go: (if further (setq result (append further result))) (setq chart (cdr chart))) (goto-char here) (if (= (preceding-char) ?\r) (setq result (cons here result))) (setq chart (cdr chart)))) result)) ;;;_ X outline-chart-spec (chart spec &optional exposing) (defun outline-chart-spec (chart spec &optional exposing) "Not yet \(if ever\) implemented. Produce exposure directives given topic/subtree CHART and an exposure SPEC. Exposure spec indicates the locations to be exposed and the prescribed exposure status. Optional arg EXPOSING is an integer, with 0 indicating pending concealment, anything higher indicating depth to which subtopic headers should be exposed, and negative numbers indicating (negative of) the depth to which subtopic headers and bodies should be exposed. The produced list can have two types of entries. Bare numbers indicate points in the buffer where topic headers that should be exposed reside. - bare negative numbers indicates that the topic starting at the point which is the negative of the number should be opened, including their entries. - bare positive values indicate that this topic header should be openned. - Lists signify the beginning and end points of regions that should be flagged, and the flag to employ. (For concealment: '\(\?r\)', and exposure:" (while spec (cond ((listp spec) ) ) (setq spec (cdr spec))) ) ;;;_ - Within Topic ;;;_ > outline-goto-prefix () (defun outline-goto-prefix () "Put point at beginning of outline prefix for immediately containing topic. Goes to first subsequent topic if none immediately containing. Not sensitive to topic visibility. Returns a the point at the beginning of the prefix, or nil if none." (let (done) (while (and (not done) (re-search-backward "[\n\r]" nil 1)) (forward-char 1) (if (looking-at outline-regexp) (setq done (outline-prefix-data (match-beginning 0) (match-end 0))) (forward-char -1))) (if (bobp) (cond ((looking-at outline-regexp) (outline-prefix-data (match-beginning 0)(match-end 0))) ((outline-next-heading) (outline-prefix-data (match-beginning 0)(match-end 0))) (done)) done))) ;;;_ > outline-end-of-prefix () (defun outline-end-of-prefix (&optional ignore-decorations) "Position cursor at beginning of header text. If optional IGNORE-DECORATIONS is non-nil, put just after bullet, otherwise skip white space between bullet and ensuing text." (if (not (outline-goto-prefix)) nil (let ((match-data (match-data))) (goto-char (match-end 0)) (if ignore-decorations t (while (looking-at "[0-9]") (forward-char 1)) (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1))) (store-match-data match-data)) ;; Reestablish where we are: (outline-current-depth))) ;;;_ > outline-current-bullet-pos () (defun outline-current-bullet-pos () "Return position of current \(visible) topic's bullet." (if (not (outline-current-depth)) nil (1- (match-end 0)))) ;;;_ > outline-back-to-current-heading () (defun outline-back-to-current-heading () "Move to heading line of current topic, or beginning if already on the line." (beginning-of-line) (prog1 (or (outline-on-current-heading-p) (and (re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move) (outline-prefix-data (match-beginning 1)(match-end 1)))) (if (interactive-p) (outline-end-of-prefix)))) ;;;_ > outline-pre-next-preface () (defun outline-pre-next-preface () "Skip forward to just before the next heading line. Returns that character position." (if (re-search-forward outline-line-boundary-regexp nil 'move) (prog1 (goto-char (match-beginning 0)) (outline-prefix-data (match-beginning 2)(match-end 2))))) ;;;_ > outline-end-of-current-subtree () (defun outline-end-of-current-subtree () "Put point at the end of the last leaf in the currently visible topic." (interactive) (outline-back-to-current-heading) (let ((level (outline-recent-depth))) (outline-next-heading) (while (and (not (eobp)) (> (outline-recent-depth) level)) (outline-next-heading)) (and (not (eobp)) (forward-char -1)) (and (memq (preceding-char) '(?\n ?\^M)) (memq (aref (buffer-substring (max 1 (- (point) 3)) (point)) 1) '(?\n ?\^M)) (forward-char -1)) (setq outline-recent-end-of-subtree (point)))) ;;;_ > outline-beginning-of-current-entry () (defun outline-beginning-of-current-entry () "When not already there, position point at beginning of current topic's body. If already there, move cursor to bullet for hot-spot operation. \(See outline-mode doc string for details on hot-spot operation.)" (interactive) (let ((start-point (point))) (outline-end-of-prefix) (if (and (interactive-p) (= (point) start-point)) (goto-char (outline-current-bullet-pos))))) ;;;_ > outline-end-of-current-entry () (defun outline-end-of-current-entry () "Position the point at the end of the current topics' entry." (interactive) (outline-show-entry) (prog1 (outline-pre-next-preface) (if (and (not (bobp))(looking-at "^$")) (forward-char -1)))) ;;;_ - Depth-wise ;;;_ > outline-ascend-to-depth (depth) (defun outline-ascend-to-depth (depth) "Ascend to depth DEPTH, returning depth if successful, nil if not." (if (and (> depth 0)(<= depth (outline-depth))) (let ((last-good (point))) (while (and (< depth (outline-depth)) (setq last-good (point)) (outline-beginning-of-level) (outline-previous-heading))) (if (= (outline-recent-depth) depth) (progn (goto-char outline-recent-prefix-beginning) depth) (goto-char last-good) nil)) (if (interactive-p) (outline-end-of-prefix)))) ;;;_ > outline-descend-to-depth (depth) (defun outline-descend-to-depth (depth) "Descend to depth DEPTH within current topic. Returning depth if successful, nil if not." (let ((start-point (point)) (start-depth (outline-depth))) (while (and (> (outline-depth) 0) (not (= depth (outline-recent-depth))) ; ... not there yet (outline-next-heading) ; ... go further (< start-depth (outline-recent-depth)))) ; ... still in topic (if (and (> (outline-depth) 0) (= (outline-recent-depth) depth)) depth (goto-char start-point) nil)) ) ;;;_ > outline-up-current-level (arg &optional dont-complain) (defun outline-up-current-level (arg &optional dont-complain) "Move out ARG levels from current visible topic. Positions on heading line of containing topic. Error if unable to ascend that far, or nil if unable to ascend but optional arg DONT-COMPLAIN is non-nil." (interactive "p") (outline-back-to-current-heading) (let ((present-level (outline-recent-depth)) (last-good (point)) failed return) ;; Loop for iterating arg: (while (and (> (outline-recent-depth) 1) (> arg 0) (not (bobp)) (not failed)) (setq last-good (point)) ;; Loop for going back over current or greater depth: (while (and (not (< (outline-recent-depth) present-level)) (or (outline-previous-visible-heading 1) (not (setq failed present-level))))) (setq present-level (outline-current-depth)) (setq arg (- arg 1))) (if (or failed (> arg 0)) (progn (goto-char last-good) (if (interactive-p) (outline-end-of-prefix)) (if (not dont-complain) (error "Can't ascend past outermost level.") (if (interactive-p) (outline-end-of-prefix)) nil)) (if (interactive-p) (outline-end-of-prefix)) outline-recent-prefix-beginning))) ;;;_ - Linear ;;;_ > outline-next-sibling (&optional depth backward) (defun outline-next-sibling (&optional depth backward) "Like outline-forward-current-level, but respects invisible topics. Traverse at optional DEPTH, or current depth if none specified. Go backward if optional arg BACKWARD is non-nil. Return depth if successful, nil otherwise." (if (and backward (bobp)) nil (let ((start-depth (or depth (outline-depth))) (start-point (point)) last-depth) (while (and (not (if backward (bobp) (eobp))) (if backward (outline-previous-heading) (outline-next-heading)) (> (setq last-depth (outline-recent-depth)) start-depth))) (if (and (not (eobp)) (and (> (or last-depth (outline-depth)) 0) (= (outline-recent-depth) start-depth))) outline-recent-prefix-beginning (goto-char start-point) (if depth (outline-depth) start-depth) nil)))) ;;;_ > outline-previous-sibling (&optional depth backward) (defun outline-previous-sibling (&optional depth backward) "Like outline-forward-current-level,but backwards & respect invisible topics. Optional DEPTH specifies depth to traverse, default current depth. Optional BACKWARD reverses direction. Return depth if successful, nil otherwise." (outline-next-sibling depth (not backward)) ) ;;;_ > outline-snug-back () (defun outline-snug-back () "Position cursor at end of previous topic Presumes point is at the start of a topic prefix." (if (or (bobp) (eobp)) nil (forward-char -1)) (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M)))) nil (forward-char -1) (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M)))) (forward-char -1))) (point)) ;;;_ > outline-beginning-of-level () (defun outline-beginning-of-level () "Go back to the first sibling at this level, visible or not." (outline-end-of-level 'backward)) ;;;_ > outline-end-of-level (&optional backward) (defun outline-end-of-level (&optional backward) "Go to the last sibling at this level, visible or not." (let ((depth (outline-depth))) (while (outline-previous-sibling depth nil)) (prog1 (outline-recent-depth) (if (interactive-p) (outline-end-of-prefix))))) ;;;_ > outline-next-visible-heading (arg) (defun outline-next-visible-heading (arg) "Move to the next ARG'th visible heading line, backward if arg is negative. Move as far as possible in indicated direction \(beginning or end of buffer\) if headings are exhausted." (interactive "p") (let* ((backward (if (< arg 0) (setq arg (* -1 arg)))) (step (if backward -1 1)) (start-point (point)) prev got) (while (> arg 0) ; limit condition (while (and (not (if backward (bobp)(eobp))) ; boundary condition ;; Move, skipping over all those concealed lines: (< -1 (forward-line step)) (not (setq got (looking-at outline-regexp))))) ;; Register this got, it may be the last: (if got (setq prev got)) (setq arg (1- arg))) (cond (got ; Last move was to a prefix: (outline-prefix-data (match-beginning 0) (match-end 0)) (outline-end-of-prefix)) (prev ; Last move wasn't, but prev was: (outline-prefix-data (match-beginning 0) (match-end 0))) ((not backward) (end-of-line) nil)))) ;;;_ > outline-previous-visible-heading (arg) (defun outline-previous-visible-heading (arg) "Move to the previous heading line. With argument, repeats or can move forward if negative. A heading line is one that starts with a `*' (or that outline-regexp matches)." (interactive "p") (outline-next-visible-heading (- arg))) ;;;_ > outline-forward-current-level (arg) (defun outline-forward-current-level (arg) "Position point at the next heading of the same level. Takes optional repeat-count, goes backward if count is negative. Returns resulting position, else nil if none found." (interactive "p") (let ((start-depth (outline-current-depth)) (start-point (point)) (start-arg arg) (backward (> 0 arg)) last-depth (last-good (point)) at-boundary) (if (= 0 start-depth) (error "No siblings, not in a topic...")) (if backward (setq arg (* -1 arg))) (while (not (or (zerop arg) at-boundary)) (while (and (not (if backward (bobp) (eobp))) (if backward (outline-previous-visible-heading 1) (outline-next-visible-heading 1)) (> (setq last-depth (outline-recent-depth)) start-depth))) (if (and last-depth (= last-depth start-depth) (not (if backward (bobp) (eobp)))) (setq last-good (point) arg (1- arg)) (setq at-boundary t))) (if (and (not (eobp)) (= arg 0) (and (> (or last-depth (outline-depth)) 0) (= (outline-recent-depth) start-depth))) outline-recent-prefix-beginning (goto-char last-good) (if (not (interactive-p)) nil (outline-end-of-prefix) (error "Hit %s level %d topic, traversed %d of %d requested." (if backward "first" "last") (outline-recent-depth) (- (abs start-arg) arg) (abs start-arg)))))) ;;;_ > outline-backward-current-level (arg) (defun outline-backward-current-level (arg) "Inverse of `outline-forward-current-level'." (interactive "p") (if (interactive-p) (let ((current-prefix-arg (* -1 arg))) (call-interactively 'outline-forward-current-level)) (outline-forward-current-level (* -1 arg)))) ;;;_ #5 Alteration ;;;_ - Fundamental ;;;_ > outline-before-change-protect (beg end) (defun outline-before-change-protect (beg end) "Outline before-change hook, regulates changes to concealed text. Reveal concealed text that would be changed by current command, and offer user choice to commit or forego the change. Unchanged text is reconcealed. User has option to have changed text reconcealed. Undo commands are specially treated - the user is not prompted for choice, the undoes are always committed (based on presumption that the things being undone were already subject to this regulation routine), and undoes always leave the changed stuff exposed. Changes to concealed regions are ignored while file is being written. \(This is for the sake of functions that do change the file during writes, like crypt and zip modes.) Locally bound in outline buffers to 'before-change-function', which in emacs 19 is run before any change to the buffer. (Has no effect in Emacs 18, which doesn't support before-change-function.) Any functions which set ['this-command' to 'undo', or which set] 'outline-override-protect' non-nil (as does, eg, outline-flag-chars) are exempt from this restriction." (if (and (outline-mode-p) ; outline-override-protect ; set by functions that know what ; they're doing, eg outline internals: (not outline-override-protect) (not outline-during-write-cue) (save-match-data ; Preserve operation position state. ; Both beginning and end chars must ; be exposed: (save-excursion (if (memq this-command '(newline open-line)) ;; Compensate for stupid emacs {new, ;; open-}line display optimization: (setq beg (1+ beg) end (1+ end))) (goto-char beg) (or (outline-hidden-p) (and (not (= beg end)) (goto-char end) (outline-hidden-p)))))) (save-match-data (if (equal this-command 'undo) ;; Allow undo without inhibition. ;; - Undoing new and open-line hits stupid emacs redisplay ;; optimization (em 19 cmds.c, ~ line 200). ;; - Presumably, undoing what was properly protected when ;; done. ;; - Undo may be users' only recourse in protection faults. ;; So, expose what getting changed: (progn (message "Undo! - exposing concealed target...") (if (outline-hidden-p) (outline-show-children)) (message "Undo!")) (let (response (rehide-completely (save-excursion (outline-goto-prefix) (outline-hidden-p))) rehide-place) (save-excursion (if (condition-case err ;; Condition case to catch keyboard quits during reads. (progn ; Give them a peek where (save-excursion (if (eolp) (setq rehide-place (outline-goto-prefix))) (outline-show-entry)) ; Present the message, but... ; leave the cursor at the location ; until they respond: ; Then interpret the response: (while (progn (message (concat "Change inside concealed" " region - do it? " "(n or 'y'/'r'eclose)")) (setq response (read-char)) (not (cond ((memq response '(?r ?R)) (setq response 'reclose)) ((memq response '(?y ?Y ? )) (setq response t)) ((memq response '(?n ?N 127)) (setq response nil) t) ((eq response ??) (message "'r' means 'yes, then reclose") nil) (t (message "Please answer y, n, or r") (sit-for 1) nil))))) response) (quit nil)) ; Continue: (if (eq response 'reclose) (save-excursion (if rehide-place (goto-char rehide-place)) (if rehide-completely (outline-hide-current-entry-completely) (outline-hide-current-entry))) (if (outline-ascend-to-depth (1- (outline-recent-depth))) (outline-show-children) (outline-show-to-offshoot))) ; Prevent: (if rehide-completely (save-excursion (if rehide-place (goto-char rehide-place)) (outline-hide-current-entry-completely)) (outline-hide-current-entry)) (error (concat "Change within concealed region prevented."))))))) ) ; if ) ; defun ;;;_ = outline-post-goto-bullet (defvar outline-post-goto-bullet nil "Outline internal var, for `outline-pre-command-business' hot-spot operation. When set, tells post-processing to reposition on topic bullet, and then unset it. Set by outline-pre-command-business when implementing hot-spot operation, where literal characters typed over a topic bullet are mapped to the command of the corresponding control-key on the outline-mode-map.") (make-variable-buffer-local 'outline-post-goto-bullet) ;;;_ > outline-post-command-business () (defun outline-post-command-business () "Outline post-command-hook function. - Null outline-override-protect, so it's not left open. - Implement (and clear) outline-post-goto-bullet, for hot-spot outline commands. - Massages buffer-undo-list so successive, standard character self-inserts are aggregated. This kludge compensates for lack of undo bunching when before-change-function is used." ; Apply any external change func: (if (not (outline-mode-p)) ; In outline-mode. nil (setq outline-override-protect nil) (if outline-during-write-cue ;; Was used by outline-before-change-protect, done with it now: (setq outline-during-write-cue nil)) ;; Undo bunching business: (if (and (listp buffer-undo-list) ; Undo history being kept. (equal this-command 'self-insert-command) (equal last-command 'self-insert-command)) (let* ((prev-stuff (cdr buffer-undo-list)) (before-prev-stuff (cdr (cdr prev-stuff))) cur-cell cur-from cur-to prev-cell prev-from prev-to) (if (and before-prev-stuff ; Goes back far enough to bother, (not (car prev-stuff)) ; and break before current, (not (car before-prev-stuff)) ; !and break before prev! (setq prev-cell (car (cdr prev-stuff))) ; contents now, (setq cur-cell (car buffer-undo-list)) ; contents prev. ;; cur contents denote a single char insertion: (numberp (setq cur-from (car cur-cell))) (numberp (setq cur-to (cdr cur-cell))) (= 1 (- cur-to cur-from)) ;; prev contents denote fewer than aggregate-limit ;; insertions: (numberp (setq prev-from (car prev-cell))) (numberp (setq prev-to (cdr prev-cell))) ; Below threshold: (> outline-undo-aggregation (- prev-to prev-from))) (setq buffer-undo-list (cons (cons prev-from cur-to) (cdr (cdr (cdr buffer-undo-list)))))))) ;; Implement -post-goto-bullet, if set: (must be after undo business) (if (and outline-post-goto-bullet (outline-current-bullet-pos)) (progn (goto-char (outline-current-bullet-pos)) (setq outline-post-goto-bullet nil))) )) ;;;_ > outline-pre-command-business () (defun outline-pre-command-business () "Outline pre-command-hook function for outline buffers. Implements special behavior when cursor is on bullet char. Self-insert characters are reinterpreted control-character references into the outline-mode-map. The outline-mode post-command hook will position a cursor that has moved as a result of such reinterpretation, on the destination topic's bullet, when the cursor wound up in the The upshot is that you can get easy, single (unmodified) key outline maneuvering and general operations by positioning the cursor on the bullet char, and it continues until you deliberately some non-outline motion command to relocate the cursor off of a bullet char." (if (and (boundp 'outline-mode) outline-mode (eq this-command 'self-insert-command) (eq (point)(outline-current-bullet-pos))) (let* ((this-key-num (if (numberp last-command-event) last-command-event)) mapped-binding) ; Map upper-register literals ; to lower register: (if (<= 96 this-key-num) (setq this-key-num (- this-key-num 32))) ; Check if we have a literal: (if (and (<= 64 this-key-num) (>= 96 this-key-num)) (setq mapped-binding (lookup-key 'outline-mode-map (concat outline-command-prefix (char-to-string (- this-key-num 64)))))) (if mapped-binding (setq outline-post-goto-bullet t this-command mapped-binding))))) ;;;_ > outline-find-file-hook () (defun outline-find-file-hook () "Activate outline-mode when `outline-auto-activation' & `outline-layout' are non-nil. See `outline-init' for setup instructions." (if (and outline-auto-activation (not (outline-mode-p)) outline-layout) (outline-mode t))) ;;;_ : Establish the hooks (add-hook 'post-command-hook 'outline-post-command-business) (add-hook 'pre-command-hook 'outline-pre-command-business) ;;;_ - Topic Format Assessment ;;;_ > outline-solicit-alternate-bullet (depth &optional current-bullet) (defun outline-solicit-alternate-bullet (depth &optional current-bullet) "Prompt for and return a bullet char as an alternative to the current one. Offer one suitable for current depth DEPTH as default." (let* ((default-bullet (or current-bullet (outline-bullet-for-depth depth))) (sans-escapes (regexp-sans-escapes outline-bullets-string)) (choice (solicit-char-in-string (format "Select bullet: %s ('%s' default): " sans-escapes default-bullet) sans-escapes t))) (if (string= choice "") default-bullet choice)) ) ;;;_ > outline-sibling-index (&optional depth) (defun outline-sibling-index (&optional depth) "Item number of this prospective topic among its siblings. If optional arg depth is greater than current depth, then we're opening a new level, and return 0. If less than this depth, ascend to that depth and count..." (save-excursion (cond ((and depth (<= depth 0) 0)) ((or (not depth) (= depth (outline-depth))) (let ((index 1)) (while (outline-previous-sibling (outline-recent-depth) nil) (setq index (1+ index))) index)) ((< depth (outline-recent-depth)) (outline-ascend-to-depth depth) (outline-sibling-index)) (0)))) ;;;_ > outline-distinctive-bullet (bullet) (defun outline-distinctive-bullet (bullet) "True if bullet is one of those on outline-distinctive-bullets-string." (string-match (regexp-quote bullet) outline-distinctive-bullets-string)) ;;;_ > outline-numbered-type-prefix (&optional prefix) (defun outline-numbered-type-prefix (&optional prefix) "True if current header prefix bullet is numbered bullet." (and outline-numbered-bullet (string= outline-numbered-bullet (if prefix (outline-get-prefix-bullet prefix) (outline-get-bullet))))) ;;;_ > outline-bullet-for-depth (&optional depth) (defun outline-bullet-for-depth (&optional depth) "Return outline topic bullet suited to optional DEPTH, or current depth." ;; Find bullet in plain-bullets-string modulo DEPTH. (if outline-stylish-prefixes (char-to-string (aref outline-plain-bullets-string (% (max 0 (- depth 2)) outline-plain-bullets-string-len))) outline-primary-bullet) ) ;;;_ - Topic Production ;;;_ > outline-make-topic-prefix (&optional prior-bullet (defun outline-make-topic-prefix (&optional prior-bullet new depth solicit number-control index) ;; Depth null means use current depth, non-null means we're either ;; opening a new topic after current topic, lower or higher, or we're ;; changing level of current topic. ;; Solicit dominates specified bullet-char. ;;;_ . Doc string: "Generate a topic prefix suitable for optional arg DEPTH, or current depth. All the arguments are optional. PRIOR-BULLET indicates the bullet of the prefix being changed, or nil if none. This bullet may be preserved (other options notwithstanding) if it is on the outline-distinctive-bullets-string, for instance. Second arg NEW indicates that a new topic is being opened after the topic at point, if non-nil. Default bullet for new topics, eg, may be set (contingent to other args) to numbered bullets if previous sibling is one. The implication otherwise is that the current topic is being adjusted - shifted or rebulleted - and we don't consider bullet or previous sibling. Third arg DEPTH forces the topic prefix to that depth, regardless of the current topics' depth. Fourth arg SOLICIT non-nil provokes solicitation from the user of a choice among the valid bullets. (This overrides other all the options, including, eg, a distinctive PRIOR-BULLET.) Fifth arg, NUMBER-CONTROL, matters only if 'outline-numbered-bullet' is non-nil *and* soliciting was not explicitly invoked. Then NUMBER-CONTROL non-nil forces prefix to either numbered or denumbered format, depending on the value of the sixth arg, INDEX. \(Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...) If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then the prefix of the topic is forced to be numbered. Non-nil NUMBER-CONTROL and nil INDEX forces non-numbered format on the bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means that the index for the numbered prefix will be derived, by counting siblings back to start of level. If INDEX is a number, then that number is used as the index for the numbered prefix (allowing, eg, sequential renumbering to not requre this function counting back the index for each successive sibling)." ;;;_ . Code: ;; The options are ordered in likely frequence of use, most common ;; highest, least lowest. Ie, more likely to be doing prefix ;; adjustments than soliciting, and yet more than numbering. ;; Current prefix is least dominant, but most likely to be commonly ;; specified... (let* (body numbering denumbering (depth (or depth (outline-depth))) (header-lead outline-header-prefix) (bullet-char ;; Getting value for bullet char is practically the whole job: (cond ; Simplest situation - level 1: ((<= depth 1) (setq header-lead "") outline-primary-bullet) ; Simple, too: all asterisks: (outline-old-style-prefixes ;; Cheat - make body the whole thing, null out header-lead and ;; bullet-char: (setq body (make-string depth (string-to-char outline-primary-bullet))) (setq header-lead "") "") ;; (Neither level 1 nor old-style, so we're space padding. ;; Sneak it in the condition of the next case, whatever it is.) ;; Solicitation overrides numbering and other cases: ((progn (setq body (make-string (- depth 2) ?\ )) ;; The actual condition: solicit) (let* ((got (outline-solicit-alternate-bullet depth))) ;; Gotta check whether we're numbering and got a numbered bullet: (setq numbering (and outline-numbered-bullet (not (and number-control (not index))) (string= got outline-numbered-bullet))) ;; Now return what we got, regardless: got)) ;; Numbering invoked through args: ((and outline-numbered-bullet number-control) (if (setq numbering (not (setq denumbering (not index)))) outline-numbered-bullet (if (and prior-bullet (not (string= outline-numbered-bullet prior-bullet))) prior-bullet (outline-bullet-for-depth depth)))) ;;; Neither soliciting nor controlled numbering ;;; ;;; (may be controlled denumbering, tho) ;;; ;; Check wrt previous sibling: ((and new ; only check for new prefixes (<= depth (outline-depth)) outline-numbered-bullet ; ... & numbering enabled (not denumbering) (let ((sibling-bullet (save-excursion ;; Locate correct sibling: (or (>= depth (outline-depth)) (outline-ascend-to-depth depth)) (outline-get-bullet)))) (if (and sibling-bullet (string= outline-numbered-bullet sibling-bullet)) (setq numbering sibling-bullet))))) ;; Distinctive prior bullet? ((and prior-bullet (outline-distinctive-bullet prior-bullet) ;; Either non-numbered: (or (not (and outline-numbered-bullet (string= prior-bullet outline-numbered-bullet))) ;; or numbered, and not denumbering: (setq numbering (not denumbering))) ;; Here 'tis: prior-bullet)) ;; Else, standard bullet per depth: ((outline-bullet-for-depth depth))))) (concat header-lead body bullet-char (if numbering (format "%d" (cond ((and index (numberp index)) index) (new (1+ (outline-sibling-index depth))) ((outline-sibling-index)))))) ) ) ;;;_ > outline-open-topic (relative-depth &optional before) (defun outline-open-topic (relative-depth &optional before) "Open a new topic at depth DEPTH. New topic is situated after current one, unless optional flag BEFORE is non-nil, or unless current line is complete empty (not even whitespace), in which case open is done on current line. Nuances: - Creation of new topics is with respect to the visible topic containing the cursor, regardless of intervening concealed ones. - New headers are generally created after/before the body of a topic. However, they are created right at cursor location if the cursor is on a blank line, even if that breaks the current topic body. This is intentional, to provide a simple means for deliberately dividing topic bodies. - Double spacing of topic lists is preserved. Also, the first level two topic is created double-spaced (and so would be subsequent siblings, if that's left intact). Otherwise, single-spacing is used. - Creation of sibling or nested topics is with respect to the topic you're starting from, even when creating backwards. This way you can easily create a sibling in front of the current topic without having to go to its preceeding sibling, and then open forward from there." (let* ((depth (+ (outline-current-depth) relative-depth)) (opening-on-blank (if (looking-at "^\$") (not (setq before nil)))) opening-numbered ; Will get while computing ref-topic, below ref-depth ; Will get while computing ref-topic, next (ref-topic (save-excursion (cond ((< relative-depth 0) (outline-ascend-to-depth depth)) ((>= relative-depth 1) nil) (t (outline-back-to-current-heading))) (setq ref-depth (outline-recent-depth)) (setq opening-numbered (save-excursion (and outline-numbered-bullet (or (<= relative-depth 0) (outline-descend-to-depth depth)) (if (outline-numbered-type-prefix) outline-numbered-bullet)))) (point))) dbl-space doing-beginning) (if (not opening-on-blank) ; Positioning and vertical ; padding - only if not ; opening-on-blank: (progn (goto-char ref-topic) (setq dbl-space ; Determine double space action: (or (and (<= relative-depth 0) ; not descending; (save-excursion ;; at b-o-b or preceeded by a blank line? (or (> 0 (forward-line -1)) (looking-at "^\\s-*$") (bobp))) (save-excursion ;; succeeded by a blank line? (outline-end-of-current-subtree) (bolp))) (and (= ref-depth 1) (or before (= depth 1) (save-excursion ;; Don't already have following ;; vertical padding: (not (outline-pre-next-preface))))))) ; Position to prior heading, ; if inserting backwards, and ; not going outwards: (if (and before (>= relative-depth 0)) (progn (outline-back-to-current-heading) (setq doing-beginning (bobp)) (if (not (bobp)) (outline-previous-heading))) (if (and before (bobp)) (outline-unprotected (open-line 1)))) (if (<= relative-depth 0) ;; Not going inwards, don't snug up: (if doing-beginning (outline-unprotected (open-line (if dbl-space 2 1))) (if before (progn (end-of-line) (outline-pre-next-preface) (while (= ?\r (following-char)) (forward-char 1)) (if (not (looking-at "^$")) (outline-unprotected (open-line 1)))) (outline-end-of-current-subtree))) ;; Going inwards - double-space if first offspring is, ;; otherwise snug up. (end-of-line) ; So we skip any concealed progeny. (outline-pre-next-preface) (if (bolp) ;; Blank lines between current header body and next ;; header - get to last substantive (non-white-space) ;; line in body: (re-search-backward "[^ \t\n]" nil t)) (if (save-excursion (outline-next-heading) (if (> (outline-recent-depth) ref-depth) ;; This is an offspring. (progn (forward-line -1) (looking-at "^\\s-*$")))) (progn (forward-line 1) (outline-unprotected (open-line 1)))) (end-of-line)) ;;(if doing-beginning (goto-char doing-beginning)) (if (not (bobp)) (progn (if (and (not (> depth ref-depth)) (not before)) (outline-unprotected (open-line 1)) (if (> depth ref-depth) (outline-unprotected (newline 1)) (if dbl-space (outline-unprotected (open-line 1)) (if (not before) (outline-unprotected (newline 1)))))) (if dbl-space (outline-unprotected (newline 1))) (if (and (not (eobp)) (not (bolp))) (forward-char 1)))) )) (insert-string (concat (outline-make-topic-prefix opening-numbered t depth) " ")) ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1)))) (outline-rebullet-heading nil ;;; solicit depth ;;; depth nil ;;; number-control nil ;;; index t) (end-of-line) ) ) ;;;_ . open-topic contingencies ;;;_ ; base topic - one from which open was issued ;;;_ , beginning char ;;;_ , amount of space before will be used, unless openning in place ;;;_ , end char will be used, unless opening before (and it still may) ;;;_ ; absolute depth of new topic ;;;_ ! insert in place - overrides most stuff ;;;_ ; relative depth of new re base ;;;_ ; before or after base topic ;;;_ ; spacing around topic, if any, prior to new topic and at same depth ;;;_ ; buffer boundaries - special provisions for beginning and end ob ;;;_ ; level 1 topics have special provisions also - double space. ;;;_ ; location of new topic ;;;_ . ;;;_ > outline-open-subtopic (arg) (defun outline-open-subtopic (arg) "Open new topic header at deeper level than the current one. Negative universal arg means to open deeper, but place the new topic prior to the current one." (interactive "p") (outline-open-topic 1 (> 0 arg))) ;;;_ > outline-open-sibtopic (arg) (defun outline-open-sibtopic (arg) "Open new topic header at same level as the current one. Negative universal arg means to place the new topic prior to the current one." (interactive "p") (outline-open-topic 0 (> 0 arg))) ;;;_ > outline-open-supertopic (arg) (defun outline-open-supertopic (arg) "Open new topic header at shallower level than the current one. Negative universal arg means to open shallower, but place the new topic prior to the current one." (interactive "p") (outline-open-topic -1 (> 0 arg))) ;;;_ - Outline Alteration ;;;_ : Topic Modification ;;;_ = outline-former-auto-filler (defvar outline-former-auto-filler nil "Name of modal fill function being wrapped by outline-auto-fill.") ;;;_ > outline-auto-fill () (defun outline-auto-fill () "Outline-mode autofill function. Maintains outline hanging topic indentation if `outline-use-hanging-indents' is set." (let ((fill-prefix (if outline-use-hanging-indents ;; Check for topic header indentation: (save-excursion (beginning-of-line) (if (looking-at outline-regexp) ;; ... construct indentation to account for ;; length of topic prefix: (make-string (progn (outline-end-of-prefix) (current-column)) ?\ )))))) (if (or outline-former-auto-filler outline-use-hanging-indents) (do-auto-fill)))) ;;;_ > outline-reindent-body (old-depth new-depth &optional number) (defun outline-reindent-body (old-depth new-depth &optional number) "Reindent body lines which were indented at old-depth to new-depth. Optional arg NUMBER indicates numbering is being added, and it must be accomodated. Note that refill of indented paragraphs is not done." (save-excursion (outline-end-of-prefix) (let* ((new-margin (current-column)) excess old-indent-begin old-indent-end curr-ind ;; We want the column where the header-prefix text started ;; *before* the prefix was changed, so we infer it relative ;; to the new margin and the shift in depth: (old-margin (+ old-depth (- new-margin new-depth)))) ;; Process lines up to (but excluding) next topic header: (outline-unprotected (save-match-data (while (and (re-search-forward "[\n\r]\\(\\s-*\\)" nil t) ;; Register the indent data, before we reset the ;; match data with a subsequent 'looking-at': (setq old-indent-begin (match-beginning 1) old-indent-end (match-end 1)) (not (looking-at outline-regexp))) (if (> 0 (setq excess (- (current-column) old-margin))) ;; Text starts left of old margin - don't adjust: nil ;; Text was hanging at or right of old left margin - ;; reindent it, preserving its existing indentation ;; beyond the old margin: (delete-region old-indent-begin old-indent-end) (indent-to (+ new-margin excess))))))))) ;;;_ > outline-rebullet-current-heading (arg) (defun outline-rebullet-current-heading (arg) "Like non-interactive version 'outline-rebullet-heading'. But \(only\) affects visible heading containing point. With repeat count, solicit for bullet." (interactive "P") (save-excursion (outline-back-to-current-heading) (outline-end-of-prefix) (outline-rebullet-heading (not arg) ;;; solicit nil ;;; depth nil ;;; number-control nil ;;; index t) ;;; do-successors ) ) ;;;_ > outline-rebullet-heading (&optional solicit ...) (defun outline-rebullet-heading (&optional solicit new-depth number-control index do-successors) "Adjust bullet of current topic prefix. All args are optional. If SOLICIT is non-nil then the choice of bullet is solicited from user. Otherwise the distinctiveness of the bullet or the topic depth determines it. Second arg DEPTH forces the topic prefix to that depth, regardless of the topics current depth. Third arg NUMBER-CONTROL can force the prefix to or away from numbered form. It has effect only if 'outline-numbered-bullet' is non-nil and soliciting was not explicitly invoked (via first arg). Its effect, numbering or denumbering, then depends on the setting of the forth arg, INDEX. If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the prefix of the topic is forced to be non-numbered. Null index and non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil INDEX is a number, then that number is used for the numbered prefix. Non-nil and non-number means that the index for the numbered prefix will be derived by outline-make-topic-prefix. Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding siblings. Cf vars 'outline-stylish-prefixes', 'outline-old-style-prefixes', and 'outline-numbered-bullet', which all affect the behavior of this function." (let* ((current-depth (outline-depth)) (new-depth (or new-depth current-depth)) (mb outline-recent-prefix-beginning) (me outline-recent-prefix-end) (current-bullet (buffer-substring (- me 1) me)) (new-prefix (outline-make-topic-prefix current-bullet nil new-depth solicit number-control index))) ;; Is new one is identical to old? (if (and (= current-depth new-depth) (string= current-bullet (substring new-prefix (1- (length new-prefix))))) ;; Nothing to do: t ;; New prefix probably different from old: ; get rid of old one: (outline-unprotected (delete-region mb me)) (goto-char mb) ; Dispense with number if ; numbered-bullet prefix: (if (and outline-numbered-bullet (string= outline-numbered-bullet current-bullet) (looking-at "[0-9]+")) (outline-unprotected (delete-region (match-beginning 0)(match-end 0)))) ; Put in new prefix: (outline-unprotected (insert-string new-prefix)) ;; Reindent the body if elected and margin changed: (if (and outline-reindent-bodies (not (= new-depth current-depth))) (outline-reindent-body current-depth new-depth)) ;; Recursively rectify successive siblings of orig topic if ;; caller elected for it: (if do-successors (save-excursion (while (outline-next-sibling new-depth nil) (setq index (cond ((numberp index) (1+ index)) ((not number-control) (outline-sibling-index)))) (if (outline-numbered-type-prefix) (outline-rebullet-heading nil ;;; solicit new-depth ;;; new-depth number-control;;; number-control index ;;; index nil))))) ;;;(dont!)do-successors ) ; (if (and (= current-depth new-depth)...)) ) ; let* ((current-depth (outline-depth))...) ) ; defun ;;;_ > outline-rebullet-topic (arg) (defun outline-rebullet-topic (arg) "Like outline-rebullet-topic-grunt, but start from topic visible at point. Descends into invisible as well as visible topics, however. With repeat count, shift topic depth by that amount." (interactive "P") (let ((start-col (current-column)) (was-eol (eolp))) (save-excursion ;; Normalize arg: (cond ((null arg) (setq arg 0)) ((listp arg) (setq arg (car arg)))) ;; Fill the user in, in case we're shifting a big topic: (if (not (zerop arg)) (message "Shifting...")) (outline-back-to-current-heading) (if (<= (+ (outline-recent-depth) arg) 0) (error "Attempt to shift topic below level 1")) (outline-rebullet-topic-grunt arg) (if (not (zerop arg)) (message "Shifting... done."))) (move-to-column (max 0 (+ start-col arg))))) ;;;_ > outline-rebullet-topic-grunt (&optional relative-depth ...) (defun outline-rebullet-topic-grunt (&optional relative-depth starting-depth starting-point index do-successors) "Rebullet the topic at point, visible or invisible, and all contained subtopics. See outline-rebullet-heading for rebulleting behavior. All arguments are optional. First arg RELATIVE-DEPTH means to shift the depth of the entire topic that amount. The rest of the args are for internal recursive use by the function itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX." (let* ((relative-depth (or relative-depth 0)) (new-depth (outline-depth)) (starting-depth (or starting-depth new-depth)) (on-starting-call (null starting-point)) (index (or index ;; Leave index null on starting call, so rebullet-heading ;; calculates it at what might be new depth: (and (or (zerop relative-depth) (not on-starting-call)) (outline-sibling-index)))) (moving-outwards (< 0 relative-depth)) (starting-point (or starting-point (point)))) ;; Sanity check for excessive promotion done only on starting call: (and on-starting-call moving-outwards (> 0 (+ starting-depth relative-depth)) (error "Attempt to shift topic out beyond level 1.")) ;;; ====> (cond ((= starting-depth new-depth) ;; We're at depth to work on this one: (outline-rebullet-heading nil ;;; solicit (+ starting-depth ;;; starting-depth relative-depth) nil ;;; number index ;;; index ;; Every contained topic will get hit, ;; and we have to get to outside ones ;; deliberately: nil) ;;; do-successors ;; ... and work on subsequent ones which are at greater depth: (setq index 0) (outline-next-heading) (while (and (not (eobp)) (< starting-depth (outline-recent-depth))) (setq index (1+ index)) (outline-rebullet-topic-grunt relative-depth ;;; relative-depth (1+ starting-depth);;;starting-depth starting-point ;;; starting-point index))) ;;; index ((< starting-depth new-depth) ;; Rare case - subtopic more than one level deeper than parent. ;; Treat this one at an even deeper level: (outline-rebullet-topic-grunt relative-depth ;;; relative-depth new-depth ;;; starting-depth starting-point ;;; starting-point index))) ;;; index (if on-starting-call (progn ;; Rectify numbering of former siblings of the adjusted topic, ;; if topic has changed depth (if (or do-successors (and (not (zerop relative-depth)) (or (= (outline-recent-depth) starting-depth) (= (outline-recent-depth) (+ starting-depth relative-depth))))) (outline-rebullet-heading nil nil nil nil t)) ;; Now rectify numbering of new siblings of the adjusted topic, ;; if depth has been changed: (progn (goto-char starting-point) (if (not (zerop relative-depth)) (outline-rebullet-heading nil nil nil nil t))))) ) ) ;;;_ > outline-renumber-to-depth (&optional depth) (defun outline-renumber-to-depth (&optional depth) "Renumber siblings at current depth. Affects superior topics if optional arg DEPTH is less than current depth. Returns final depth." ;; Proceed by level, processing subsequent siblings on each, ;; ascending until we get shallower than the start depth: (let ((ascender (outline-depth))) (while (and (not (eobp)) (outline-depth) (>= (outline-recent-depth) depth) (>= ascender depth)) ; Skip over all topics at ; lesser depths, which can not ; have been disturbed: (while (and (not (eobp)) (> (outline-recent-depth) ascender)) (outline-next-heading)) ; Prime ascender for ascension: (setq ascender (1- (outline-recent-depth))) (if (>= (outline-recent-depth) depth) (outline-rebullet-heading nil ;;; solicit nil ;;; depth nil ;;; number-control nil ;;; index t))));;; do-successors (outline-recent-depth)) ;;;_ > outline-number-siblings (&optional denumber) (defun outline-number-siblings (&optional denumber) "Assign numbered topic prefix to this topic and its siblings. With universal argument, denumber - assign default bullet to this topic and its siblings. With repeated universal argument (`^U^U'), solicit bullet for each rebulleting each topic at this level." (interactive "P") (save-excursion (outline-back-to-current-heading) (outline-beginning-of-level) (let ((depth (outline-recent-depth)) (index (if (not denumber) 1)) (use-bullet (equal '(16) denumber)) (more t)) (while more (outline-rebullet-heading use-bullet ;;; solicit depth ;;; depth t ;;; number-control index ;;; index nil) ;;; do-successors (if index (setq index (1+ index))) (setq more (outline-next-sibling depth nil)))))) ;;;_ > outline-shift-in (arg) (defun outline-shift-in (arg) "Increase depth of current heading and any topics collapsed within it." (interactive "p") (outline-rebullet-topic arg)) ;;;_ > outline-shift-out (arg) (defun outline-shift-out (arg) "Decrease depth of current heading and any topics collapsed within it." (interactive "p") (outline-rebullet-topic (* arg -1))) ;;;_ : Surgery (kill-ring) functions with special provisions for outlines: ;;;_ > outline-kill-line (&optional arg) (defun outline-kill-line (&optional arg) "Kill line, adjusting subsequent lines suitably for outline mode." (interactive "*P") (if (not (and (outline-mode-p) ; active outline mode, outline-numbered-bullet ; numbers may need adjustment, (bolp) ; may be clipping topic head, (looking-at outline-regexp))) ; are clipping topic head. ;; Above conditions do not obtain - just do a regular kill: (kill-line arg) ;; Ah, have to watch out for adjustments: (let* ((depth (outline-depth))) ; Do the kill: (kill-line arg) ; Provide some feedback: (sit-for 0) (save-excursion ; Start with the topic ; following killed line: (if (not (looking-at outline-regexp)) (outline-next-heading)) (outline-renumber-to-depth depth))))) ;;;_ > outline-kill-topic () (defun outline-kill-topic () "Kill topic together with subtopics. Leaves primary topic's trailing vertical whitespace, if any." ;; Some finagling is done to make complex topic kills appear faster ;; than they actually are. A redisplay is performed immediately ;; after the region is disposed of, though the renumbering process ;; has yet to be performed. This means that there may appear to be ;; a lag *after* the kill has been performed. (interactive) (let* ((beg (prog1 (outline-back-to-current-heading)(beginning-of-line))) (depth (outline-recent-depth))) (outline-end-of-current-subtree) (if (not (eobp)) (if (or (not (looking-at "^$")) ;; A blank line - cut it with this topic *unless* this ;; is the last topic at this level, in which case ;; we'll leave the blank line as part of the ;; containing topic: (save-excursion (and (outline-next-heading) (>= (outline-recent-depth) depth)))) (forward-char 1))) (kill-region beg (point)) (sit-for 0) (save-excursion (outline-renumber-to-depth depth)))) ;;;_ > outline-yank-processing () (defun outline-yank-processing (&optional arg) "Incidental outline-specific business to be done just after text yanks. Does depth adjustment of yanked topics, when: 1 the stuff being yanked starts with a valid outline header prefix, and 2 it is being yanked at the end of a line which consists of only a valid topic prefix. Also, adjusts numbering of subsequent siblings when appropropriate. Depth adjustment alters the depth of all the topics being yanked the amount it takes to make the first topic have the depth of the header into which it's being yanked. The point is left in front of yanked, adjusted topics, rather than at the end (and vice-versa with the mark). Non-adjusted yanks, however, are left exactly like normal, non-outline-specific yanks." (interactive "*P") ; Get to beginning, leaving ; region around subject: (if (< (mark-marker) (point)) (exchange-point-and-mark)) (let* ((subj-beg (point)) (subj-end (mark-marker)) ;; 'resituate' if yanking an entire topic into topic header: (resituate (and (outline-e-o-prefix-p) (looking-at (concat "\\(" outline-regexp "\\)")) (outline-prefix-data (match-beginning 1) (match-end 1)))) ;; 'rectify-numbering' if resituating (where several topics may ;; be resituating) or yanking a topic into a topic slot (bol): (rectify-numbering (or resituate (and (bolp) (looking-at outline-regexp))))) (if resituate ; The yanked stuff is a topic: (let* ((prefix-len (- (match-end 1) subj-beg)) (subj-depth (outline-recent-depth)) (prefix-bullet (outline-recent-bullet)) (adjust-to-depth ;; Nil if adjustment unnecessary, otherwise depth to which ;; adjustment should be made: (save-excursion (and (goto-char subj-end) (eolp) (goto-char subj-beg) (and (looking-at outline-regexp) (progn (beginning-of-line) (not (= (point) subj-beg))) (looking-at outline-regexp) (outline-prefix-data (match-beginning 0) (match-end 0))) (outline-recent-depth)))) done (more t)) (setq rectify-numbering outline-numbered-bullet) (if adjust-to-depth ; Do the adjustment: (progn (message "... yanking") (sit-for 0) (save-restriction (narrow-to-region subj-beg subj-end) ; Trim off excessive blank ; line at end, if any: (goto-char (point-max)) (if (looking-at "^$") (outline-unprotected (delete-char -1))) ; Work backwards, with each ; shallowest level, ; successively excluding the ; last processed topic from ; the narrow region: (while more (outline-back-to-current-heading) ; go as high as we can in each bunch: (while (outline-ascend-to-depth (1- (outline-depth)))) (save-excursion (outline-rebullet-topic-grunt (- adjust-to-depth subj-depth)) (outline-depth)) (if (setq more (not (bobp))) (progn (widen) (forward-char -1) (narrow-to-region subj-beg (point)))))) (message "") ;; Preserve new bullet if it's a distinctive one, otherwise ;; use old one: (if (string-match (regexp-quote prefix-bullet) outline-distinctive-bullets-string) ; Delete from bullet of old to ; before bullet of new: (progn (beginning-of-line) (delete-region (point) subj-beg) (set-marker (mark-marker) subj-end) (goto-char subj-beg) (outline-end-of-prefix)) ; Delete base subj prefix, ; leaving old one: (delete-region (point) (+ (point) prefix-len (- adjust-to-depth subj-depth))) ; and delete residual subj ; prefix digits and space: (while (looking-at "[0-9]") (delete-char 1)) (if (looking-at " ") (delete-char 1)))) (exchange-point-and-mark)))) (if rectify-numbering (progn (save-excursion ; Give some preliminary feedback: (message "... reconciling numbers") (sit-for 0) ; ... and renumber, in case necessary: (goto-char subj-beg) (if (outline-goto-prefix) (outline-rebullet-heading nil ;;; solicit (outline-depth) ;;; depth nil ;;; number-control nil ;;; index t)) (message "")))) (if (not resituate) (exchange-point-and-mark)))) ;;;_ > outline-yank (&optional arg) (defun outline-yank (&optional arg) "Outline-mode yank, with depth and numbering adjustment of yanked topics. Non-topic yanks work no differntly than normal yanks. If a topic is being yanked into a bare topic prefix, the depth of the yanked topic is adjusted to the depth of the topic prefix. 1 we're yanking in an outline-mode buffer 2 the stuff being yanked starts with a valid outline header prefix, and 3 it is being yanked at the end of a line which consists of only a valid topic prefix. If these conditions hold then the depth of the yanked topics are all adjusted the amount it takes to make the first one at the depth of the header into which it's being yanked. The point is left in front of yanked, adjusted topics, rather than at the end (and vice-versa with the mark). Non-adjusted yanks, however, (ones that don't qualify for adjustment) are handled exactly like normal yanks. Numbering of yanked topics, and the succesive siblings at the depth into which they're being yanked, is adjusted. Outline-yank-pop works with outline-yank just like normal yank-pop works with normal yank in non-outline buffers." (interactive "*P") (setq this-command 'yank) (yank arg) (if (outline-mode-p) (outline-yank-processing))) ;;;_ > outline-yank-pop (&optional arg) (defun outline-yank-pop (&optional arg) "Yank-pop like outline-yank when popping to bare outline prefixes. Adapts level of popped topics to level of fresh prefix. Note - prefix changes to distinctive bullets will stick, if followed by pops to non-distinctive yanks. Bug..." (interactive "*p") (setq this-command 'yank) (yank-pop arg) (if (outline-mode-p) (outline-yank-processing))) ;;;_ - Specialty bullet functions ;;;_ : File Cross references ;;;_ > outline-resolve-xref () (defun outline-resolve-xref () "Pop to file associated with current heading, if it has an xref bullet. \(Works according to setting of `outline-file-xref-bullet')." (interactive) (if (not outline-file-xref-bullet) (error "outline cross references disabled - no 'outline-file-xref-bullet'") (if (not (string= (outline-current-bullet) outline-file-xref-bullet)) (error "current heading lacks cross-reference bullet '%s'" outline-file-xref-bullet) (let (file-name) (save-excursion (let* ((text-start outline-recent-prefix-end) (heading-end (progn (outline-pre-next-preface) (point)))) (goto-char text-start) (setq file-name (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t) (buffer-substring (match-beginning 1) (match-end 1)))))) (setq file-name (if (not (= (aref file-name 0) ?:)) (expand-file-name file-name) ; A registry-files ref, strip the ':' ; and try to follow it: (let ((reg-ref (reference-registered-file (substring file-name 1) nil t))) (if reg-ref (car (cdr reg-ref)))))) (if (or (file-exists-p file-name) (if (file-writable-p file-name) (y-or-n-p (format "%s not there, create one? " file-name)) (error "%s not found and can't be created" file-name))) (condition-case failure (find-file-other-window file-name) (error failure)) (error "%s not found" file-name)) ) ) ) ) ;;;_ #6 Exposure Control and Processing ;;;_ - Fundamental ;;;_ > outline-flag-region (from to flag) (defmacro outline-flag-region (from to flag) "Hide or show lines from FROM to TO, via emacs selective-display FLAG char. Ie, text following flag C-m \(carriage-return) is hidden until the next C-j (newline) char. Returns the endpoint of the region." (` (let ((buffer-read-only nil) (outline-override-protect t)) (subst-char-in-region (, from) (, to) (if (= (, flag) ?\n) ?\r ?\n) (, flag) t)))) ;;;_ > outline-flag-current-subtree (flag) (defun outline-flag-current-subtree (flag) "Hide or show subtree of currently-visible topic. See `outline-flag-region' for more details." (save-excursion (outline-back-to-current-heading) (outline-flag-region (point) (progn (outline-end-of-current-subtree) (1- (point))) flag))) ;;;_ - Mapping and processing of topics ;;;_ " See also chart functions, in navigation ;;;_ > outline-listify-exposed (&optional start end) (defun outline-listify-exposed (&optional start end) "Produce a list representing exposed topics in current region. This list can then be used by 'outline-process-exposed' to manipulate the subject region. List is composed of elements that may themselves be lists representing exposed components in subtopic. Each component list contains: - a number representing the depth of the topic, - a string representing the header-prefix (ref. 'outline-header-prefix'), - a string representing the bullet character, - and a series of strings, each containing one line of the exposed portion of the topic entry." (interactive "r") (save-excursion (let* (strings pad result depth bullet beg next done) ; State vars. (goto-char start) (beginning-of-line) (if (not (outline-goto-prefix)) ; Get initial position within a topic: (outline-next-visible-heading 1)) (while (and (not done) (not (eobp)) ; Loop until we've covered the region. (not (> (point) end))) (setq depth (outline-recent-depth) ; Current topics' depth, bullet (outline-recent-bullet) ; ... bullet, beg (progn (outline-end-of-prefix t) (point))) ; and beginning. (setq done ; The boundary for the current topic: (not (outline-next-visible-heading 1))) (beginning-of-line) (setq next (point)) (goto-char beg) (setq strings nil) (while (> next (point)) ; Get all the exposed text in (setq strings (cons (buffer-substring beg ;To hidden text or end of line: (progn (search-forward "\r" (save-excursion (end-of-line) (point)) 1) (if (= (preceding-char) ?\r) (1- (point)) (point)))) strings)) (if (< (point) next) ; Resume from after hid text, if any. (forward-line 1)) (setq beg (point))) ;; Accumulate list for this topic: (setq result (cons (append (list depth outline-header-prefix bullet) (nreverse strings)) result))) ;; Put the list with first at front, to last at back: (nreverse result)))) ;;;_ > outline-process-exposed (arg &optional tobuf) (defun outline-process-exposed (&optional func from to frombuf tobuf) "Map function on exposed parts of current topic; results to another buffer. Apply FUNCTION \(default 'outline-insert-listified) to exposed portions FROM position TO position \(default region, or the entire buffer if no region active) in buffer FROMBUF \(default current buffer) to buffer TOBUF \(default is buffer named like frombuf but with \"*\" prepended and \" exposed*\" appended). The function must as its arguments the elements of the list representations of topic entries produced by outline-listify-exposed." ; Resolve arguments, ; defaulting if necessary: (if (not func) (setq func 'outline-insert-listified)) (if (not (and from to)) (if mark-active (setq from (region-beginning) to (region-end)) (setq from (point-min) to (point-max)))) (if frombuf (if (not (bufferp frombuf)) ;; Specified but not a buffer - get it: (let ((got (get-buffer frombuf))) (if (not got) (error (concat "outline-process-exposed: source buffer " frombuf " not found.")) (setq frombuf got)))) ;; not specified - default it: (setq frombuf (current-buffer))) (if tobuf (if (not (bufferp tobuf)) (setq tobuf (get-buffer-create tobuf))) ;; not specified - default it: (setq tobuf (concat "*" (buffer-name frombuf) " exposed*"))) (let* ((listified (progn (set-buffer frombuf) (outline-listify-exposed from to))) (prefix outline-header-prefix) ; ... as set in frombuf. curr) (set-buffer tobuf) (while listified (setq curr (car listified)) (setq listified (cdr listified)) (apply func (list (car curr) ; depth (car (cdr curr)) ; header-prefix (car (cdr (cdr curr))) ; bullet (cdr (cdr (cdr curr)))))) ; list of text lines (pop-to-buffer tobuf))) ;;;_ - Topic-specific ;;;_ > outline-show-entry () ; outline-show-entry basically for isearch dynamic exposure, as is... (defun outline-show-entry () "Like `outline-show-current-entry', reveals entries nested in hidden topics. This is a way to give restricted peek at a concealed locality without the expense of exposing its context, but can leave the outline with aberrant exposure. outline-hide-current-entry-completely or outline-show-offshoot should be used after the peek to rectify the exposure." (interactive) (save-excursion (outline-goto-prefix) (outline-flag-region (if (bobp) (point) (1- (point))) (or (outline-pre-next-preface) (point)) ?\n))) ;;;_ > outline-show-children (&optional level strict) (defun outline-show-children (&optional level strict) "If point is visible, show all direct subheadings of this heading. Otherwise, do outline-show-to-offshoot, and then show subheadings. Optional LEVEL specifies how many levels below the current level should be shown, or all levels if t. Default is 1. Optional STRICT means don't resort to -show-to-offshoot, no matter what. This is basically so -show-to-offshoot, which is called by this function, can employ the pure offspring-revealing capabilities of it. Returns point at end of subtree that was opened, if any. (May get a point of non-opened subtree?)" (interactive "p") (let (max-pos) (if (and (not strict) (outline-hidden-p)) (progn (outline-show-to-offshoot) ; Point's concealed, open to ; expose it. ;; Then recurse, but with "strict" set so we don't ;; infinite regress: (setq max-pos (outline-show-children level t))) (save-excursion (save-restriction (let* ((start-pt (point)) (chart (outline-chart-subtree (or level 1))) (to-reveal (outline-chart-to-reveal chart (or level 1)))) (goto-char start-pt) (if (and strict (= (preceding-char) ?\r)) ;; Concealed root would already have been taken care of, ;; unless strict was set. (outline-flag-region (point) (outline-snug-back) ?\n)) (while to-reveal (goto-char (car to-reveal)) (outline-flag-region (point) (outline-snug-back) ?\n) (setq to-reveal (cdr to-reveal))))))))) ;;;_ x outline-show-current-children (&optional level strict) (defun outline-show-current-children (&optional level strict) "This command was misnamed, use `outline-show-children' instead. \(The \"current\" in the name is supposed to imply that it works on the visible topic containing point, while it really works with respect to the most immediate topic, concealed or not. I'll leave this old name around for a bit, but i'll soon activate an annoying message to warn people about the change, and then deprecate this alias." (interactive "p") ;;(beep) ;;(message (format "Use '%s' instead of '%s' (%s)." ;; "outline-show-children" ;; "outline-show-current-children" ;; (buffer-name (current-buffer)))) (outline-show-children level strict)) ;;;_ > outline-hide-point-reconcile () (defun outline-hide-reconcile () "Like `outline-hide-current-entry'; hides completely if within hidden region. Specifically intended for aberrant exposure states, like entries that were exposed by outline-show-entry but are within otherwise concealed regions." (interactive) (save-excursion (outline-goto-prefix) (outline-flag-region (if (not (bobp)) (1- (point)) (point)) (progn (outline-pre-next-preface) (if (= ?\r (following-char)) (point) (1- (point)))) ?\r))) ;;;_ > outline-show-to-offshoot () (defun outline-show-to-offshoot () "Like outline-show-entry, but reveals opens all concealed ancestors, as well. As with outline-hide-current-entry-completely, useful for rectifying aberrant exposure states produced by outline-show-entry." (interactive) (save-excursion (let ((orig-pt (point)) (orig-pref (outline-goto-prefix)) (last-at (point)) bag-it) (while (or bag-it (= (preceding-char) ?\r)) (beginning-of-line) (if (= last-at (setq last-at (point))) ;; Oops, we're not making any progress! Show the current ;; topic completely, and bag this try. (progn (beginning-of-line) (outline-show-current-subtree) (goto-char orig-pt) (setq bag-it t) (beep) (message "%s: %s" "outline-show-to-offshoot: " "Aberrant nesting encountered."))) (outline-show-children) (goto-char orig-pref)) (goto-char orig-pt))) (if (outline-hidden-p) (outline-show-entry))) ;;;_ > outline-hide-current-entry () (defun outline-hide-current-entry () "Hide the body directly following this heading." (interactive) (outline-back-to-current-heading) (save-excursion (outline-flag-region (point) (progn (outline-end-of-current-entry) (point)) ?\^M))) ;;;_ > outline-show-current-entry (&optional arg) (defun outline-show-current-entry (&optional arg) "Show body following current heading, or hide the entry if repeat count." (interactive "P") (if arg (outline-hide-current-entry) (save-excursion (outline-flag-region (point) (progn (outline-end-of-current-entry) (point)) ?\n)))) ;;;_ > outline-hide-current-entry-completely () ; ... outline-hide-current-entry-completely also for isearch dynamic exposure: (defun outline-hide-current-entry-completely () "Like outline-hide-current-entry, but conceal topic completely. Specifically intended for aberrant exposure states, like entries that were exposed by outline-show-entry but are within otherwise concealed regions." (interactive) (save-excursion (outline-goto-prefix) (outline-flag-region (if (not (bobp)) (1- (point)) (point)) (progn (outline-pre-next-preface) (if (= ?\r (following-char)) (point) (1- (point)))) ?\r))) ;;;_ > outline-show-current-subtree (&optional arg) (defun outline-show-current-subtree (&optional arg) "Show everything within the current topic. With a repeat-count, expose this topic and its' siblings." (interactive "P") (save-excursion (if (<= (outline-current-depth) 0) ;; Outside any topics - try to get to the first: (if (not (outline-next-heading)) (error "No topics.") ;; got to first, outermost topic - set to expose it and siblings: (message "Above outermost topic - exposing all.") (outline-flag-region (point-min)(point-max) ?\n)) (if (not arg) (outline-flag-current-subtree ?\n) (outline-beginning-of-level) (outline-expose-topic '(* :)))))) ;;;_ > outline-hide-current-subtree (&optional just-close) (defun outline-hide-current-subtree (&optional just-close) "Close the current topic, or containing topic if this one is already closed. If this topic is closed and it's a top level topic, close this topic and its' siblings. If optional arg JUST-CLOSE is non-nil, do not treat the parent or siblings, even if the target topic is already closed." (interactive) (let ((from (point)) (orig-eol (progn (end-of-line) (if (not (outline-goto-prefix)) (error "No topics found.") (end-of-line)(point))))) (outline-flag-current-subtree ?\^M) (goto-char from) (if (and (= orig-eol (progn (goto-char orig-eol) (end-of-line) (point))) (not just-close) ;; Structure didn't change - try hiding current level: (goto-char from) (if (outline-up-current-level 1 t) t (goto-char 0) (let ((msg "Top-level topic already closed - closing siblings...")) (message msg) (outline-expose-topic '(0 :)) (message (concat msg " Done."))) nil) (/= (outline-recent-depth) 0)) (outline-hide-current-subtree)) (goto-char from))) ;;;_ > outline-show-current-branches () (defun outline-show-current-branches () "Show all subheadings of this heading, but not their bodies." (interactive) (beginning-of-line) (outline-show-children t)) ;;;_ > outline-hide-current-leaves () (defun outline-hide-current-leaves () "Hide the bodies of the current topic and all its' offspring." (interactive) (outline-back-to-current-heading) (outline-hide-region-body (point) (progn (outline-end-of-current-subtree) (point)))) ;;;_ - Region and beyond ;;;_ > outline-show-all () (defun outline-show-all () "Show all of the text in the buffer." (interactive) (message "Exposing entire buffer...") (outline-flag-region (point-min) (point-max) ?\n) (message "Exposing entire buffer... Done.")) ;;;_ > outline-hide-bodies () (defun outline-hide-bodies () "Hide all of buffer except headings." (interactive) (outline-hide-region-body (point-min) (point-max))) ;;;_ > outline-hide-region-body (start end) (defun outline-hide-region-body (start end) "Hide all body lines in the region, but not headings." (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) (while (not (eobp)) (outline-flag-region (point) (progn (outline-pre-next-preface) (point)) ?\^M) (if (not (eobp)) (forward-char (if (looking-at "[\n\r][\n\r]") 2 1))))))) ;;;_ > outline-expose-topic (spec) (defun outline-expose-topic (spec) "Apply exposure specs to successive outline topic items. Use the more convenient frontend, `outline-new-exposure', if you don't need evaluation of the arguments, or even better, the `outline-layout' variable-keyed mode-activation/auto-exposure feature of allout outline mode. See the respective documentation strings for more details. Cursor is left at start position. SPEC is either a number or a list. Successive specs on a list are applied to successive sibling topics. A simple spec \(either a number, one of a few symbols, or the null list) dictates the exposure for the corresponding topic. Non-null lists recursively designate exposure specs for respective subtopics of the current topic. The ':' repeat spec is used to specify exposure for any number of successive siblings, up to the trailing ones for which there are explicit specs following the ':'. Simple (numeric and null-list) specs are interpreted as follows: Numbers indicate the relative depth to open the corresponding topic. - negative numbers force the topic to be closed before opening to the absolute value of the number, so all siblings are open only to that level. - positive numbers open to the relative depth indicated by the number, but do not force already opened subtopics to be closed. - 0 means to close topic - hide all offspring. : - 'repeat' apply prior element to all siblings at current level, *up to* those siblings that would be covered by specs following the ':' on the list. Ie, apply to all topics at level but the last ones. \(Only first of multiple colons at same level is respected - subsequent ones are discarded.) * - completely opens the topic, including bodies. + - shows all the sub headers, but not the bodies - - exposes the body of the corresponding topic. Examples: \(outline-expose-topic '(-1 : 0)) Close this and all following topics at current level, exposing only their immediate children, but close down the last topic at this current level completely. \(outline-expose-topic '(-1 () : 1 0)) Close current topic so only the immediate subtopics are shown; show the children in the second to last topic, and completely close the last one. \(outline-expose-topic '(-2 : -1 *)) Expose children and grandchildren of all topics at current level except the last two; expose children of the second to last and completely open the last one." (interactive "xExposure spec: ") (if (not (listp spec)) nil (let ((depth (outline-depth)) (max-pos 0) prev-elem curr-elem stay done snug-back ) (while spec (setq prev-elem curr-elem curr-elem (car spec) spec (cdr spec)) (cond ; Do current element: ((null curr-elem) nil) ((symbolp curr-elem) (cond ((eq curr-elem '*) (outline-show-current-subtree) (if (> outline-recent-end-of-subtree max-pos) (setq max-pos outline-recent-end-of-subtree))) ((eq curr-elem '+) (outline-show-current-branches) (if (> outline-recent-end-of-subtree max-pos) (setq max-pos outline-recent-end-of-subtree))) ((eq curr-elem '-) (outline-show-current-entry)) ((eq curr-elem ':) (setq stay t) ;; Expand the 'repeat' spec to an explicit version, ;; w.r.t. remaining siblings: (let ((residue ; = # of sibs not covered by remaining spec ;; Dang - could be nice to make use of the chart, sigh: (- (length (outline-chart-siblings)) (length spec)))) (if (< 0 residue) ;; Some residue - cover it with prev-elem: (setq spec (append (make-list residue prev-elem) spec))))))) ((numberp curr-elem) (if (and (>= 0 curr-elem) (outline-visible-p)) (save-excursion (outline-hide-current-subtree t) (if (> 0 curr-elem) nil (if (> outline-recent-end-of-subtree max-pos) (setq max-pos outline-recent-end-of-subtree))))) (if (> (abs curr-elem) 0) (progn (outline-show-children (abs curr-elem)) (if (> outline-recent-end-of-subtree max-pos) (setq max-pos outline-recent-end-of-subtree))))) ((listp curr-elem) (if (outline-descend-to-depth (1+ depth)) (let ((got (outline-expose-topic curr-elem))) (if (and got (> got max-pos)) (setq max-pos got)))))) (cond (stay (setq stay nil)) ((listp (car spec)) nil) ((> max-pos (point)) ;; Capitalize on max-pos state to get us nearer next sibling: (progn (goto-char (min (point-max) max-pos)) (outline-next-heading))) ((outline-next-sibling depth)))) max-pos))) ;;;_ > outline-old-expose-topic (spec &rest followers) (defun outline-old-expose-topic (spec &rest followers) "Deprecated. Use outline-expose-topic \(with different schema format\) instead. Dictate wholesale exposure scheme for current topic, according to SPEC. SPEC is either a number or a list. Optional successive args dictate exposure for subsequent siblings of current topic. A simple spec (either a number, a special symbol, or the null list) dictates the overall exposure for a topic. Non null lists are composite specs whose first element dictates the overall exposure for a topic, with the subsequent elements in the list interpreted as specs that dictate the exposure for the successive offspring of the topic. Simple (numeric and null-list) specs are interpreted as follows: - Numbers indicate the relative depth to open the corresponding topic: - negative numbers force the topic to be close before opening to the absolute value of the number. - positive numbers just open to the relative depth indicated by the number. - 0 just closes - '*' completely opens the topic, including bodies. - '+' shows all the sub headers, but not the bodies - '-' exposes the body and immediate offspring of the corresponding topic. If the spec is a list, the first element must be a number, which dictates the exposure depth of the topic as a whole. Subsequent elements of the list are nested SPECs, dictating the specific exposure for the corresponding offspring of the topic. Optional FOLLOWER arguments dictate exposure for succeeding siblings." (interactive "xExposure spec: ") (let ((depth (outline-current-depth)) done max-pos) (cond ((null spec) nil) ((symbolp spec) (if (eq spec '*) (outline-show-current-subtree)) (if (eq spec '+) (outline-show-current-branches)) (if (eq spec '-) (outline-show-current-entry))) ((numberp spec) (if (>= 0 spec) (save-excursion (outline-hide-current-subtree t) (end-of-line) (if (or (not max-pos) (> (point) max-pos)) (setq max-pos (point))) (if (> 0 spec) (setq spec (* -1 spec))))) (if (> spec 0) (outline-show-children spec))) ((listp spec) ;(let ((got (outline-old-expose-topic (car spec)))) ; (if (and got (or (not max-pos) (> got max-pos))) ; (setq max-pos got))) (let ((new-depth (+ (outline-current-depth) 1)) got) (setq max-pos (outline-old-expose-topic (car spec))) (setq spec (cdr spec)) (if (and spec (outline-descend-to-depth new-depth) (not (outline-hidden-p))) (progn (setq got (apply 'outline-old-expose-topic spec)) (if (and got (or (not max-pos) (> got max-pos))) (setq max-pos got))))))) (while (and followers (progn (if (and max-pos (< (point) max-pos)) (progn (goto-char max-pos) (setq max-pos nil))) (end-of-line) (outline-next-sibling depth))) (outline-old-expose-topic (car followers)) (setq followers (cdr followers))) max-pos)) ;;;_ > outline-new-exposure '() (defmacro outline-new-exposure (&rest spec) "Literal frontend for `outline-expose-topic', doesn't evaluate arguments. Some arguments that would need to be quoted in outline-expose-topic need not be quoted in outline-new-exposure. Cursor is left at start position. Use this instead of obsolete 'outline-exposure'. Examples: \(outline-exposure (-1 () () () 1) 0) Close current topic at current level so only the immediate subtopics are shown, except also show the children of the third subtopic; and close the next topic at the current level. \(outline-exposure : -1 0) Close all topics at current level to expose only their immediate children, except for the last topic at the current level, in which even its' immediate children are hidden. \(outline-exposure -2 : -1 *) Expose children and grandchildren of first topic at current level, and expose children of subsequent topics at current level *except* for the last, which should be opened completely." (list 'save-excursion '(if (not (or (outline-goto-prefix) (outline-next-heading))) (error "outline-new-exposure: Can't find any outline topics.")) (list 'outline-expose-topic (list 'quote spec)))) ;;;_ > outline-exposure '() (defmacro outline-exposure (&rest spec) "Being deprecated - use more recent 'outline-new-exposure' instead. Literal frontend for `outline-old-expose-topic', doesn't evaluate arguments and retains start position." (list 'save-excursion '(if (not (or (outline-goto-prefix) (outline-next-heading))) (error "Can't find any outline topics.")) (cons 'outline-old-expose-topic (mapcar '(lambda (x) (list 'quote x)) spec)))) ;;;_ #7 ISearch with Dynamic Exposure ;;;_ = outline-search-reconceal (defvar outline-search-reconceal nil "Track whether current search match was concealed outside of search. The value is the location of the match, if it was concealed, regular if the entire topic was concealed, in a list if the entry was concealed.") ;;;_ = outline-search-quitting (defconst outline-search-quitting nil "Distinguishes isearch conclusion and cancellation. Used by isearch-terminate/outline-provisions and isearch-done/outline-provisions") ;;;_ > outline-enwrap-isearch () (defun outline-enwrap-isearch () "Impose outline-mode isearch-mode wrappers for dynamic exposure in isearch. Isearch progressively exposes and reconceals hidden topics when working in outline mode, but works normally elsewhere. The function checks to ensure that the rebindings are done only once." ; Should isearch-mode be employed, (if (or (not outline-enwrap-isearch-mode) ; or are preparations already done? (fboundp 'real-isearch-terminate)) ;; ... no - skip this all: nil ;; ... yes: ; Ensure load of isearch-mode: (if (or (and (fboundp 'isearch-mode) (fboundp 'isearch-quote-char)) (condition-case error (load-library outline-enwrap-isearch-mode) (file-error (message "Skipping isearch-mode provisions - %s '%s'" (car (cdr error)) (car (cdr (cdr error)))) (sit-for 1) ;; Inhibit subsequent tries and return nil: (setq outline-enwrap-isearch-mode nil)))) ;; Isearch-mode loaded, encapsulate specific entry points for ;; outline dynamic-exposure business: (progn ;; stash crucial isearch-mode funcs under known, private ;; names, then register wrapper functions under the old ;; names, in their stead: 'isearch-quit' is pre isearch v 1.2. (fset 'real-isearch-terminate ; 'isearch-quit is pre v 1.2: (or (if (fboundp 'isearch-quit) (symbol-function 'isearch-quit)) (if (fboundp 'isearch-abort) ; 'isearch-abort' is v 1.2 and on: (symbol-function 'isearch-abort)))) (fset 'isearch-quit 'isearch-terminate/outline-provisions) (fset 'isearch-abort 'isearch-terminate/outline-provisions) (fset 'real-isearch-done (symbol-function 'isearch-done)) (fset 'isearch-done 'isearch-done/outline-provisions) (fset 'real-isearch-update (symbol-function 'isearch-update)) (fset 'isearch-update 'isearch-update/outline-provisions) (make-variable-buffer-local 'outline-search-reconceal))))) ;;;_ > outline-isearch-arrival-business () (defun outline-isearch-arrival-business () "Do outline business like exposing current point, if necessary. Registers reconcealment requirements in outline-search-reconceal accordingly. Set outline-search-reconceal to nil if current point is not concealed, to value of point if entire topic is concealed, and a list containing point if only the topic body is concealed. This will be used to determine whether outline-hide-current-entry or outline-hide-current-entry-completely will be necessary to restore the prior concealment state." (if (outline-mode-p) (setq outline-search-reconceal (if (outline-hidden-p) (save-excursion (if (re-search-backward outline-line-boundary-regexp nil 1) ;; Nil value means we got to b-o-b - wouldn't need ;; to advance. (forward-char 1)) ; We'll return point or list ; containing point, depending ; on concealment state of ; topic prefix. (prog1 (if (outline-hidden-p) (point) (list (point))) ; And reveal the current ; search target: (outline-show-entry))))))) ;;;_ > outline-isearch-advancing-business () (defun outline-isearch-advancing-business () "Do outline business like deexposing current point, if necessary. Works according to reconceal state registration." (if (and (outline-mode-p) outline-search-reconceal) (save-excursion (if (listp outline-search-reconceal) ;; Leave the topic visible: (progn (goto-char (car outline-search-reconceal)) (outline-hide-current-entry)) ;; Rehide the entire topic: (goto-char outline-search-reconceal) (outline-hide-current-entry-completely))))) ;;;_ > isearch-terminate/outline-provisions () (defun isearch-terminate/outline-provisions () (interactive) (if (and (outline-mode-p) outline-enwrap-isearch-mode) (outline-isearch-advancing-business)) (let ((outline-search-quitting t) (outline-search-reconceal nil)) (real-isearch-terminate))) ;;;_ > isearch-done/outline-provisions () (defun isearch-done/outline-provisions (&optional nopush) (interactive) (if (and (outline-mode-p) outline-enwrap-isearch-mode) (progn (if (and outline-search-reconceal (not (listp outline-search-reconceal))) ;; The topic was concealed - reveal it, its siblings, ;; and any ancestors that are still concealed: (save-excursion (message "(exposing destination)")(sit-for 0) (outline-goto-prefix) ; There may be a closed blank ; line between prior and ; current topic that would be ; missed - provide for it: (if (not (bobp)) (progn (forward-char -1) ; newline (if (eq ?\r (preceding-char)) (outline-flag-region (1- (point)) (point) ?\n)) (forward-char 1))) ; Goto parent (outline-ascend-to-depth (1- (outline-recent-depth))) (outline-show-children))) (if (and (boundp 'outline-search-quitting) outline-search-quitting) nil ; We're concluding abort: (outline-isearch-arrival-business) (outline-show-children)))) (if nopush ;; isearch-done in newer version of isearch mode takes arg: (real-isearch-done nopush) (real-isearch-done))) ;;;_ > isearch-update/outline-provisions () (defun isearch-update/outline-provisions () "Wrapper dynamically adjusts isearch target exposure. Appropriately exposes and reconceals hidden outline portions, as necessary, in the course of searching." (if (not (and (outline-mode-p) outline-enwrap-isearch-mode)) ;; Just do the plain business: (real-isearch-update) ;; Ah - provide for outline conditions: (outline-isearch-advancing-business) (real-isearch-update) (cond (isearch-success (outline-isearch-arrival-business)) ((not isearch-success) (outline-isearch-advancing-business))))) ;;;_ #8 Copying and printing ;;;_ - Copy exposed ;;;_ > outline-insert-listified (depth prefix bullet text) (defun outline-insert-listified (depth prefix bullet text) "Insert contents of listified outline portion in current buffer." (insert-string (concat (if (> depth 1) prefix "") (make-string (1- depth) ?\ ) bullet)) (while text (insert-string (car text)) (if (setq text (cdr text)) (insert-string "\n"))) (insert-string "\n")) ;;;_ > outline-copy-exposed (arg &optional tobuf) (defun outline-copy-exposed (arg &optional tobuf) "Duplicate exposed portions of current topic to another buffer. Other buffer has current buffers' name with \" exposed\" appended to it. With repeat count, copy the exposed portions of entire buffer." (interactive "P") (if (not tobuf) (setq tobuf (get-buffer-create (concat "*" (buffer-name) " exposed*")))) (let* ((start-pt (point)) (beg (if arg (point-min) (outline-back-to-current-heading))) (end (if arg (point-max) (outline-end-of-current-subtree))) (buf (current-buffer))) (save-excursion (set-buffer tobuf)(erase-buffer)) (outline-process-exposed 'outline-insert-listified beg end (current-buffer) tobuf) (goto-char (point-min)) (pop-to-buffer buf) (goto-char start-pt))) ;;;_ - LaTeX formatting ;;;_ > outline-latex-verb-quote (str &optional flow) (defun outline-latex-verb-quote (str &optional flow) "Return copy of STRING for literal reproduction across latex processing. Expresses the original characters \(including carriage returns) of the string across latex processing." (mapconcat '(lambda (char) ;;;mess: (cond ((memq char '(?"" ?$ ?% ?# ?& ?- ?" ?` ?^ ?- ?*));;;")))) (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*)) (concat "\\char" (number-to-string char) "{}")) ((= char ?\n) "\\\\") (t (char-to-string char)))) str "")) ;;;_ > outline-latex-verbatim-quote-curr-line () (defun outline-latex-verbatim-quote-curr-line () "Express line for exact \(literal\) representation across latex processing. Adjust line contents so it is unaltered \(from the original line) across latex processing, within the context of a 'verbatim' environment. Leaves point at the end of the line." (beginning-of-line) (let ((beg (point)) (end (progn (end-of-line)(point)))) (goto-char beg) (while (re-search-forward "\\\\" ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" end ; bounded by end-of-line 1) ; no matches, move to end & return nil (goto-char (match-beginning 0)) (insert-string "\\") (setq end (1+ end)) (goto-char (1+ (match-end 0)))))) ;;;_ > outline-insert-latex-header (buf) (defun outline-insert-latex-header (buf) "Insert initial latex commands at point in BUFFER." ;; Much of this is being derived from the stuff in appendix of E in ;; the TeXBook, pg 421. (set-buffer buf) (let ((doc-style (format "\n\\documentstyle{%s}\n" "report")) (page-numbering (if outline-number-pages "\\pagestyle{empty}\n" "")) (linesdef (concat "\\def\\beginlines{" "\\par\\begingroup\\nobreak\\medskip" "\\parindent=0pt\n" " \\kern1pt\\nobreak \\obeylines \\obeyspaces " "\\everypar{\\strut}}\n" "\\def\\endlines{" "\\kern1pt\\endgroup\\medbreak\\noindent}\n")) (titlecmd (format "\\newcommand{\\titlecmd}[1]{{%s #1}}\n" outline-title-style)) (labelcmd (format "\\newcommand{\\labelcmd}[1]{{%s #1}}\n" outline-label-style)) (headlinecmd (format "\\newcommand{\\headlinecmd}[1]{{%s #1}}\n" outline-head-line-style)) (bodylinecmd (format "\\newcommand{\\bodylinecmd}[1]{{%s #1}}\n" outline-body-line-style)) (setlength (format "%s%s%s%s" "\\newlength{\\stepsize}\n" "\\setlength{\\stepsize}{" outline-indent "}\n")) (oneheadline (format "%s%s%s%s%s%s%s" "\\newcommand{\\OneHeadLine}[3]{%\n" "\\noindent%\n" "\\hspace*{#2\\stepsize}%\n" "\\labelcmd{#1}\\hspace*{.2cm}" "\\headlinecmd{#3}\\\\[" outline-line-skip "]\n}\n")) (onebodyline (format "%s%s%s%s%s%s" "\\newcommand{\\OneBodyLine}[2]{%\n" "\\noindent%\n" "\\hspace*{#1\\stepsize}%\n" "\\bodylinecmd{#2}\\\\[" outline-line-skip "]\n}\n")) (begindoc "\\begin{document}\n\\begin{center}\n") (title (format "%s%s%s%s" "\\titlecmd{" (outline-latex-verb-quote (if outline-title (condition-case err (eval outline-title) (error "")) "Unnamed Outline")) "}\n" "\\end{center}\n\n")) (hsize "\\hsize = 7.5 true in\n") (hoffset "\\hoffset = -1.5 true in\n") (vspace "\\vspace{.1cm}\n\n")) (insert (concat doc-style page-numbering titlecmd labelcmd headlinecmd bodylinecmd setlength oneheadline onebodyline begindoc title hsize hoffset vspace) ))) ;;;_ > outline-insert-latex-trailer (buf) (defun outline-insert-latex-trailer (buf) "Insert concluding latex commands at point in BUFFER." (set-buffer buf) (insert "\n\\end{document}\n")) ;;;_ > outline-latexify-one-item (depth prefix bullet text) (defun outline-latexify-one-item (depth prefix bullet text) "Insert LaTeX commands for formatting one outline item. Args are the topics' numeric DEPTH, the header PREFIX lead string, the BULLET string, and a list of TEXT strings for the body." (let* ((head-line (if text (car text))) (body-lines (cdr text)) (curr-line) body-content bop) ; Do the head line: (insert-string (concat "\\OneHeadLine{\\verb\1 " (outline-latex-verb-quote bullet) "\1}{" depth "}{\\verb\1 " (if head-line (outline-latex-verb-quote head-line) "") "\1}\n")) (if (not body-lines) nil ;;(insert-string "\\beginlines\n") (insert-string "\\begin{verbatim}\n") (while body-lines (setq curr-line (car body-lines)) (if (and (not body-content) (not (string-match "^\\s-*$" curr-line))) (setq body-content t)) ; Mangle any occurrences of ; "\end{verbatim}" in text, ; it's special: (if (and body-content (setq bop (string-match "\\end{verbatim}" curr-line))) (setq curr-line (concat (substring curr-line 0 bop) ">" (substring curr-line bop)))) ;;(insert-string "|" (car body-lines) "|") (insert-string curr-line) (outline-latex-verbatim-quote-curr-line) (insert-string "\n") (setq body-lines (cdr body-lines))) (if body-content (setq body-content nil) (forward-char -1) (insert-string "\\ ") (forward-char 1)) ;;(insert-string "\\endlines\n") (insert-string "\\end{verbatim}\n") ))) ;;;_ > outline-latexify-exposed (arg &optional tobuf) (defun outline-latexify-exposed (arg &optional tobuf) "Format current topic's exposed portions to TOBUF for latex processing. TOBUF defaults to a buffer named the same as the current buffer, but with \"*\" prepended and \" latex-formed*\" appended. With repeat count, copy the exposed portions of entire buffer." (interactive "P") (if (not tobuf) (setq tobuf (get-buffer-create (concat "*" (buffer-name) " latexified*")))) (let* ((start-pt (point)) (beg (if arg (point-min) (outline-back-to-current-heading))) (end (if arg (point-max) (outline-end-of-current-subtree))) (buf (current-buffer))) (set-buffer tobuf) (erase-buffer) (outline-insert-latex-header tobuf) (goto-char (point-max)) (outline-process-exposed 'outline-latexify-one-item beg end buf tobuf) (goto-char (point-max)) (outline-insert-latex-trailer tobuf) (goto-char (point-min)) (pop-to-buffer buf) (goto-char start-pt))) ;;;_ #9 miscellaneous ;;;_ > outline-mark-topic () (defun outline-mark-topic () "Put the region around topic currently containing point." (interactive) (beginning-of-line) (outline-goto-prefix) (push-mark (point)) (outline-end-of-current-subtree) (exchange-point-and-mark)) ;;;_ > outlineify-sticky () ;; outlinify-sticky is correct spelling; provide this alias for sticklers: (defalias 'outlinify-sticky 'outlineify-sticky) (defun outlineify-sticky (&optional arg) "Activate outline mode and establish file var so it is started subseqently. See doc-string for `outline-layout' and `outline-init' for details on setup for auto-startup." (interactive "P") (outline-mode t) (save-excursion (goto-char (point-min)) (if (looking-at outline-regexp) t (outline-open-topic 2) (insert-string (concat "Dummy outline topic header - see" "`outline-mode' docstring for info.")) (next-line 1) (goto-char (point-max)) (next-line 1) (outline-open-topic 0) (insert-string "Local emacs vars.\n") (outline-open-topic 1) (insert-string "(`outline-layout' is for allout.el outline-mode)\n") (outline-open-topic 0) (insert-string "Local variables:\n") (outline-open-topic 0) (insert-string (format "outline-layout: %s\n" (or outline-layout '(1 : 0)))) (outline-open-topic 0) (insert-string "End:\n")))) ;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) (defun solicit-char-in-string (prompt string &optional do-defaulting) "Solicit (with first arg PROMPT) choice of a character from string STRING. Optional arg DO-DEFAULTING indicates to accept empty input (CR)." (let ((new-prompt prompt) got) (while (not got) (message "%s" new-prompt) ;; We do our own reading here, so we can circumvent, eg, special ;; treatment for '?' character. (Might oughta change minibuffer ;; keymap instead, oh well.) (setq got (char-to-string (let ((cursor-in-echo-area nil)) (read-char)))) (if (null (string-match (regexp-quote got) string)) (if (and do-defaulting (string= got "\^M")) ;; We're defaulting, return null string to indicate that: (setq got "") ;; Failed match and not defaulting, ;; set the prompt to give feedback, (setq new-prompt (concat prompt got " ...pick from: " string "")) ;; and set loop to try again: (setq got nil)) ;; Got a match - give feedback: (message ""))) ;; got something out of loop - return it: got) ) ;;;_ > regexp-sans-escapes (string) (defun regexp-sans-escapes (regexp &optional successive-backslashes) "Return a copy of REGEXP with all character escapes stripped out. Representations of actual backslashes - '\\\\\\\\' - are left as a single backslash. Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." (if (string= regexp "") "" ;; Set successive-backslashes to number if current char is ;; backslash, or else to nil: (setq successive-backslashes (if (= (aref regexp 0) ?\\) (if successive-backslashes (1+ successive-backslashes) 1) nil)) (if (or (not successive-backslashes) (= 2 successive-backslashes)) ;; Include first char: (concat (substring regexp 0 1) (regexp-sans-escapes (substring regexp 1))) ;; Exclude first char, but maintain count: (regexp-sans-escapes (substring regexp 1) successive-backslashes)))) ;;;_ - add-hook definition for divergent emacsen ;;;_ > add-hook (hook function &optional append) (if (not (fboundp 'add-hook)) (defun add-hook (hook function &optional append) "Add to the value of HOOK the function FUNCTION unless already present. \(It becomes the first hook on the list unless optional APPEND is non-nil, in which case it becomes the last). HOOK should be a symbol, and FUNCTION may be any valid function. HOOK's value should be a list of functions, not a single function. If HOOK is void, it is first set to nil." (or (boundp hook) (set hook nil)) (or (if (consp function) ;; Clever way to tell whether a given lambda-expression ;; is equal to anything in the hook. (let ((tail (assoc (cdr function) (symbol-value hook)))) (equal function tail)) (memq function (symbol-value hook))) (set hook (if append (nconc (symbol-value hook) (list function)) (cons function (symbol-value hook))))))) ;;;_ #10 Under development ;;;_ > outline-bullet-isearch (&optional bullet) (defun outline-bullet-isearch (&optional bullet) "Isearch \(regexp\) for topic with bullet BULLET." (interactive) (if (not bullet) (setq bullet (solicit-char-in-string "ISearch for topic with bullet: " (regexp-sans-escapes outline-bullets-string)))) (let ((isearch-regexp t) (isearch-string (concat "^" outline-header-prefix "[ \t]*" bullet))) (isearch-repeat 'forward) (isearch-mode t))) ;;;_ ? Re hooking up with isearch - use isearch-op-fun rather than ;;; wrapping the isearch functions. ;;;_* Local emacs vars. ;;; The following `outline-layout' local variable setting: ;;; - closes all topics from the first topic to just before the third-to-last, ;;; - shows the children of the third to last (config vars) ;;; - and the second to last (code section), ;;; - and closes the last topic (this local-variables section). ;;;Local variables: ;;;outline-layout: (0 : -1 -1 0) ;;;End: ;; allout.el ends here emacs-19.30/lisp/ange-ftp.el100444 12120 1 625201 6052735302 14142 0ustar rmsdaemon;;; ange-ftp.el --- transparent FTP support for GNU Emacs ;;; Copyright (C) 1989,90,91,92,93,94,95 Free Software Foundation, Inc. ;;; ;; Author: Andy Norman (ange@hplb.hpl.hp.com) ;; Keywords: comm ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2, or (at your option) ;;; any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; A copy of the GNU General Public License can be obtained from this ;;; program's author (send electronic mail to ange@hplb.hpl.hp.com) or from ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA ;;; 02139, USA. ;;; Commentary: ;;; ;;; This package attempts to make accessing files and directories using FTP ;;; from within GNU Emacs as simple and transparent as possible. A subset of ;;; the common file-handling routines are extended to interact with FTP. ;;; Usage: ;;; ;;; Some of the common GNU Emacs file-handling operations have been made ;;; FTP-smart. If one of these routines is given a filename that matches ;;; '/user@host:name' then it will spawn an FTP process connecting to machine ;;; 'host' as account 'user' and perform its operation on the file 'name'. ;;; ;;; For example: if find-file is given a filename of: ;;; ;;; /ange@anorman:/tmp/notes ;;; ;;; then ange-ftp spawns an FTP process, connect to the host 'anorman' as ;;; user 'ange', get the file '/tmp/notes' and pop up a buffer containing the ;;; contents of that file as if it were on the local filesystem. If ange-ftp ;;; needs a password to connect then it reads one in the echo area. ;;; Extended filename syntax: ;;; ;;; The default extended filename syntax is '/user@host:name', where the ;;; 'user@' part may be omitted. This syntax can be customised to a certain ;;; extent by changing ange-ftp-name-format. There are limitations. ;;; ;;; If the user part is omitted then ange-ftp generates a default user ;;; instead whose value depends on the variable ange-ftp-default-user. ;;; Passwords: ;;; ;;; A password is required for each host/user pair. Ange-ftp reads passwords ;;; as needed. You can also specify a password with ange-ftp-set-passwd, or ;;; in a *valid* ~/.netrc file. ;;; Passwords for user "anonymous": ;;; ;;; Passwords for the user "anonymous" (or "ftp") are handled ;;; specially. The variable `ange-ftp-generate-anonymous-password' ;;; controls what happens: if the value of this variable is a string, ;;; then this is used as the password; if non-nil (the default), then ;;; the value of `user-mail-address' is used; if nil then the user ;;; is prompted for a password as normal. ;;; "Dumb" UNIX hosts: ;;; ;;; The FTP servers on some UNIX machines have problems if the 'ls' command is ;;; used. ;;; ;;; The routine ange-ftp-add-dumb-unix-host can be called to tell ange-ftp to ;;; limit itself to the DIR command and not 'ls' for a given UNIX host. Note ;;; that this change will take effect for the current GNU Emacs session only. ;;; See below for a discussion of non-UNIX hosts. If a large number of ;;; machines with similar hostnames have this problem then it is easier to set ;;; the value of ange-ftp-dumb-unix-host-regexp in your .emacs file. ange-ftp ;;; is unable to automatically recognize dumb unix hosts. ;;; File name completion: ;;; ;;; Full file-name completion is supported on UNIX, VMS, CMS, and MTS hosts. ;;; To do filename completion, ange-ftp needs a listing from the remote host. ;;; Therefore, for very slow connections, it might not save any time. ;;; FTP processes: ;;; ;;; When ange-ftp starts up an FTP process, it leaves it running for speed ;;; purposes. Some FTP servers will close the connection after a period of ;;; time, but ange-ftp should be able to quietly reconnect the next time that ;;; the process is needed. ;;; ;;; Killing the "*ftp user@host*" buffer also kills the ftp process. ;;; This should not cause ange-ftp any grief. ;;; Binary file transfers: ;;; ;;; By default ange-ftp transfers files in ASCII mode. If a file being ;;; transferred matches the value of ange-ftp-binary-file-name-regexp then ;;; binary mode is used for that transfer. ;;; Account passwords: ;;; ;;; Some FTP servers require an additional password which is sent by the ;;; ACCOUNT command. ange-ftp partially supports this by allowing the user to ;;; specify an account password by either calling ange-ftp-set-account, or by ;;; specifying an account token in the .netrc file. If the account password ;;; is set by either of these methods then ange-ftp will issue an ACCOUNT ;;; command upon starting the FTP process. ;;; Preloading: ;;; ;;; ange-ftp can be preloaded, but must be put in the site-init.el file and ;;; not the site-load.el file in order for the documentation strings for the ;;; functions being overloaded to be available. ;;; Status reports: ;;; ;;; Most ange-ftp commands that talk to the FTP process output a status ;;; message on what they are doing. In addition, ange-ftp can take advantage ;;; of the FTP client's HASH command to display the status of transferring ;;; files and listing directories. See the documentation for the variables ;;; ange-ftp-{ascii,binary}-hash-mark-size, ange-ftp-send-hash and ;;; ange-ftp-process-verbose for more details. ;;; Gateways: ;;; ;;; Sometimes it is necessary for the FTP process to be run on a different ;;; machine than the machine running GNU Emacs. This can happen when the ;;; local machine has restrictions on what hosts it can access. ;;; ;;; ange-ftp has support for running the ftp process on a different (gateway) ;;; machine. The way it works is as follows: ;;; ;;; 1) Set the variable 'ange-ftp-gateway-host' to the name of a machine ;;; that doesn't have the access restrictions. ;;; ;;; 2) Set the variable 'ange-ftp-local-host-regexp' to a regular expression ;;; that matches hosts that can be contacted from running a local ftp ;;; process, but fails to match hosts that can't be accessed locally. For ;;; example: ;;; ;;; "\\.hp\\.com$\\|^[^.]*$" ;;; ;;; will match all hosts that are in the .hp.com domain, or don't have an ;;; explicit domain in their name, but will fail to match hosts with ;;; explicit domains or that are specified by their ip address. ;;; ;;; 3) Using NFS and symlinks, make sure that there is a shared directory with ;;; the *same* name between the local machine and the gateway machine. ;;; This directory is necessary for temporary files created by ange-ftp. ;;; ;;; 4) Set the variable 'ange-ftp-gateway-tmp-name-template' to the name of ;;; this directory plus an identifying filename prefix. For example: ;;; ;;; "/nfs/hplose/ange/ange-ftp" ;;; ;;; where /nfs/hplose/ange is a directory that is shared between the ;;; gateway machine and the local machine. ;;; ;;; The simplest way of getting a ftp process running on the gateway machine ;;; is if you can spawn a remote shell using either 'rsh' or 'remsh'. If you ;;; can't do this for some reason such as security then points 7 onwards will ;;; discuss an alternative approach. ;;; ;;; 5) Set the variable ange-ftp-gateway-program to the name of the remote ;;; shell process such as 'remsh' or 'rsh' if the default isn't correct. ;;; ;;; 6) Set the variable ange-ftp-gateway-program-interactive to nil if it ;;; isn't already. This tells ange-ftp that you are using a remote shell ;;; rather than logging in using telnet or rlogin. ;;; ;;; That should be all you need to allow ange-ftp to spawn a ftp process on ;;; the gateway machine. If you have to use telnet or rlogin to get to the ;;; gateway machine then follow the instructions below. ;;; ;;; 7) Set the variable ange-ftp-gateway-program to the name of the program ;;; that lets you log onto the gateway machine. This may be something like ;;; telnet or rlogin. ;;; ;;; 8) Set the variable ange-ftp-gateway-prompt-pattern to a regular ;;; expression that matches the prompt you get when you login to the ;;; gateway machine. Be very specific here; this regexp must not match ;;; *anything* in your login banner except this prompt. ;;; shell-prompt-pattern is far too general as it appears to match some ;;; login banners from Sun machines. For example: ;;; ;;; "^$*$ *" ;;; ;;; 9) Set the variable ange-ftp-gateway-program-interactive to 't' to let ;;; ange-ftp know that it has to "hand-hold" the login to the gateway ;;; machine. ;;; ;;; 10) Set the variable ange-ftp-gateway-setup-term-command to a UNIX command ;;; that will put the pty connected to the gateway machine into a ;;; no-echoing mode, and will strip off carriage-returns from output from ;;; the gateway machine. For example: ;;; ;;; "stty -onlcr -echo" ;;; ;;; will work on HP-UX machines, whereas: ;;; ;;; "stty -echo nl" ;;; ;;; appears to work for some Sun machines. ;;; ;;; That's all there is to it. ;;; Smart gateways: ;;; ;;; If you have a "smart" ftp program that allows you to issue commands like ;;; "USER foo@bar" which do nice proxy things, then look at the variables ;;; ange-ftp-smart-gateway and ange-ftp-smart-gateway-port. ;;; ;;; Otherwise, if there is an alternate ftp program that implements proxy in ;;; a transparent way (i.e. w/o specifying the proxy host), that will ;;; connect you directly to the desired destination host: ;;; Set ange-ftp-gateway-ftp-program-name to that program's name. ;;; Set ange-ftp-local-host-regexp to a value as stated earlier on. ;;; Leave ange-ftp-gateway-host set to nil. ;;; Set ange-ftp-smart-gateway to t. ;;; Tips for using ange-ftp: ;;; ;;; 1. For dired to work on a host which marks symlinks with a trailing @ in ;;; an ls -alF listing, you need to (setq dired-ls-F-marks-symlinks t). ;;; Most UNIX systems do not do this, but ULTRIX does. If you think that ;;; there is a chance you might connect to an ULTRIX machine (such as ;;; prep.ai.mit.edu), then set this variable accordingly. This will have ;;; the side effect that dired will have problems with symlinks whose names ;;; end in an @. If you get yourself into this situation then editing ;;; dired's ls-switches to remove "F", will temporarily fix things. ;;; ;;; 2. If you know that you are connecting to a certain non-UNIX machine ;;; frequently, and ange-ftp seems to be unable to guess its host-type, ;;; then setting the appropriate host-type regexp ;;; (ange-ftp-vms-host-regexp, ange-ftp-mts-host-regexp, or ;;; ange-ftp-cms-host-regexp) accordingly should help. Also, please report ;;; ange-ftp's inability to recognize the host-type as a bug. ;;; ;;; 3. For slow connections, you might get "listing unreadable" error ;;; messages, or get an empty buffer for a file that you know has something ;;; in it. The solution is to increase the value of ange-ftp-retry-time. ;;; Its default value is 5 which is plenty for reasonable connections. ;;; However, for some transatlantic connections I set this to 20. ;;; ;;; 4. Beware of compressing files on non-UNIX hosts. Ange-ftp will do it by ;;; copying the file to the local machine, compressing it there, and then ;;; sending it back. Binary file transfers between machines of different ;;; architectures can be a risky business. Test things out first on some ;;; test files. See "Bugs" below. Also, note that ange-ftp copies files by ;;; moving them through the local machine. Again, be careful when doing ;;; this with binary files on non-Unix machines. ;;; ;;; 5. Beware that dired over ftp will use your setting of dired-no-confirm ;;; (list of dired commands for which confirmation is not asked). You ;;; might want to reconsider your setting of this variable, because you ;;; might want confirmation for more commands on remote direds than on ;;; local direds. For example, I strongly recommend that you not include ;;; compress and uncompress in this list. If there is enough demand it ;;; might be a good idea to have an alist ange-ftp-dired-no-confirm of ;;; pairs ( TYPE . LIST ), where TYPE is an operating system type and LIST ;;; is a list of commands for which confirmation would be suppressed. Then ;;; remote dired listings would take their (buffer-local) value of ;;; dired-no-confirm from this alist. Who votes for this? ;;; --------------------------------------------------------------------- ;;; Non-UNIX support: ;;; --------------------------------------------------------------------- ;;; VMS support: ;;; ;;; Ange-ftp has full support for VMS hosts. It ;;; should be able to automatically recognize any VMS machine. However, if it ;;; fails to do this, you can use the command ange-ftp-add-vms-host. As well, ;;; you can set the variable ange-ftp-vms-host-regexp in your .emacs file. We ;;; would be grateful if you would report any failures to automatically ;;; recognize a VMS host as a bug. ;;; ;;; Filename Syntax: ;;; ;;; For ease of *implementation*, the user enters the VMS filename syntax in a ;;; UNIX-y way. For example: ;;; PUB$:[ANONYMOUS.SDSCPUB.NEXT]README.TXT;1 ;;; would be entered as: ;;; /PUB$$:/ANONYMOUS/SDSCPUB/NEXT/README.TXT;1 ;;; i.e. to log in as anonymous on ymir.claremont.edu and grab the file: ;;; [.CSV.POLICY]RULES.MEM ;;; you would type: ;;; C-x C-f /anonymous@ymir.claremont.edu:CSV/POLICY/RULES.MEM ;;; ;;; A legal VMS filename is of the form: FILE.TYPE;## ;;; where FILE can be up to 39 characters ;;; TYPE can be up to 39 characters ;;; ## is a version number (an integer between 1 and 32,767) ;;; Valid characters in FILE and TYPE are A-Z 0-9 _ - $ ;;; $ cannot begin a filename, and - cannot be used as the first or last ;;; character. ;;; ;;; Tips: ;;; 1. Although VMS is not case sensitive, EMACS running under UNIX is. ;;; Therefore, to access a VMS file, you must enter the filename with upper ;;; case letters. ;;; 2. To access the latest version of file under VMS, you use the filename ;;; without the ";" and version number. You should always edit the latest ;;; version of a file. If you want to edit an earlier version, copy it to a ;;; new file first. This has nothing to do with ange-ftp, but is simply ;;; good VMS operating practice. Therefore, to edit FILE.TXT;3 (say 3 is ;;; latest version), do C-x C-f /ymir.claremont.edu:FILE.TXT. If you ;;; inadvertently do C-x C-f /ymir.claremont.edu:FILE.TXT;3, you will find ;;; that VMS will not allow you to save the file because it will refuse to ;;; overwrite FILE.TXT;3, but instead will want to create FILE.TXT;4, and ;;; attach the buffer to this file. To get out of this situation, M-x ;;; write-file /ymir.claremont.edu:FILE.TXT will attach the buffer to ;;; latest version of the file. For this reason, in dired "f" ;;; (dired-find-file), always loads the file sans version, whereas "v", ;;; (dired-view-file), always loads the explicit version number. The ;;; reasoning being that it reasonable to view old versions of a file, but ;;; not to edit them. ;;; 3. EMACS has a feature in which it does environment variable substitution ;;; in filenames. Therefore, to enter a $ in a filename, you must quote it ;;; by typing $$. ;;; MTS support: ;;; ;;; Ange-ftp has full support for hosts running ;;; the Michigan terminal system. It should be able to automatically ;;; recognize any MTS machine. However, if it fails to do this, you can use ;;; the command ange-ftp-add-mts-host. As well, you can set the variable ;;; ange-ftp-mts-host-regexp in your .emacs file. We would be grateful if you ;;; would report any failures to automatically recognize a MTS host as a bug. ;;; ;;; Filename syntax: ;;; ;;; MTS filenames are entered in a UNIX-y way. For example, if your account ;;; was YYYY, the file FILE in the account XXXX: on mtsg.ubc.ca would be ;;; entered as ;;; /YYYY@mtsg.ubc.ca:/XXXX:/FILE ;;; In other words, MTS accounts are treated as UNIX directories. Of course, ;;; to access a file in another account, you must have access permission for ;;; it. If FILE were in your own account, then you could enter it in a ;;; relative name fashion as ;;; /YYYY@mtsg.ubc.ca:FILE ;;; MTS filenames can be up to 12 characters. Like UNIX, the structure of the ;;; filename does not contain a TYPE (i.e. it can have as many "."'s as you ;;; like.) MTS filenames are always in upper case, and hence be sure to enter ;;; them as such! MTS is not case sensitive, but an EMACS running under UNIX ;;; is. ;;; CMS support: ;;; ;;; Ange-ftp has full support for hosts running ;;; CMS. It should be able to automatically recognize any CMS machine. ;;; However, if it fails to do this, you can use the command ;;; ange-ftp-add-cms-host. As well, you can set the variable ;;; ange-ftp-cms-host-regexp in your .emacs file. We would be grateful if you ;;; would report any failures to automatically recognize a CMS host as a bug. ;;; ;;; Filename syntax: ;;; ;;; CMS filenames are entered in a UNIX-y way. In otherwords, minidisks are ;;; treated as UNIX directories. For example to access the file READ.ME in ;;; minidisk *.311 on cuvmb.cc.columbia.edu, you would enter ;;; /anonymous@cuvmb.cc.columbia.edu:/*.311/READ.ME ;;; If *.301 is the default minidisk for this account, you could access ;;; FOO.BAR on this minidisk as ;;; /anonymous@cuvmb.cc.columbia.edu:FOO.BAR ;;; CMS filenames are of the form FILE.TYPE, where both FILE and TYPE can be ;;; up to 8 characters. Again, beware that CMS filenames are always upper ;;; case, and hence must be entered as such. ;;; ;;; Tips: ;;; 1. CMS machines, with the exception of anonymous accounts, nearly always ;;; need an account password. To have ange-ftp send an account password, ;;; you can either include it in your .netrc file, or use ;;; ange-ftp-set-account. ;;; 2. Ange-ftp cannot send "write passwords" for a minidisk. Hopefully, we ;;; can fix this. ;;; ;;; ------------------------------------------------------------------ ;;; Bugs: ;;; ------------------------------------------------------------------ ;;; ;;; 1. Umask problems: ;;; Be warned that files created by using ange-ftp will take account of the ;;; umask of the ftp daemon process rather than the umask of the creating ;;; user. This is particularly important when logging in as the root user. ;;; The way that I tighten up the ftp daemon's umask under HP-UX is to make ;;; sure that the umask is changed to 027 before I spawn /etc/inetd. I ;;; suspect that there is something similar on other systems. ;;; ;;; 2. Some combinations of FTP clients and servers break and get out of sync ;;; when asked to list a non-existent directory. Some of the ai.mit.edu ;;; machines cause this problem for some FTP clients. Using ;;; ange-ftp-kill-ftp-process can restart the ftp process, which ;;; should get things back in synch. ;;; ;;; 3. Ange-ftp does not check to make sure that when creating a new file, ;;; you provide a valid filename for the remote operating system. ;;; If you do not, then the remote FTP server will most likely ;;; translate your filename in some way. This may cause ange-ftp to ;;; get confused about what exactly is the name of the file. The ;;; most common causes of this are using lower case filenames on systems ;;; which support only upper case, and using filenames which are too ;;; long. ;;; ;;; 4. Null (blank) passwords confuse both ange-ftp and some FTP daemons. ;;; ;;; 5. Ange-ftp likes to use pty's to talk to its FTP processes. If GNU Emacs ;;; for some reason creates a FTP process that only talks via pipes then ;;; ange-ftp won't be getting the information it requires at the time that ;;; it wants it since pipes flush at different times to pty's. One ;;; disgusting way around this problem is to talk to the FTP process via ;;; rlogin which does the 'right' things with pty's. ;;; ;;; 6. For CMS support, we send too many cd's. Since cd's are cheap, I haven't ;;; worried about this too much. Eventually, we should have some caching ;;; of the current minidisk. ;;; ;;; 7. Some CMS machines do not assign a default minidisk when you ftp them as ;;; anonymous. It is then necessary to guess a valid minidisk name, and cd ;;; to it. This is (understandably) beyond ange-ftp. ;;; ;;; 8. Remote to remote copying of files on non-Unix machines can be risky. ;;; Depending on the variable ange-ftp-binary-file-name-regexp, ange-ftp ;;; will use binary mode for the copy. Between systems of different ;;; architecture, this still may not be enough to guarantee the integrity ;;; of binary files. Binary file transfers from VMS machines are ;;; particularly problematical. Should ange-ftp-binary-file-name-regexp be ;;; an alist of OS type, regexp pairs? ;;; ;;; 9. The code to do compression of files over ftp is not as careful as it ;;; should be. It deletes the old remote version of the file, before ;;; actually checking if the local to remote transfer of the compressed ;;; file succeeds. Of course to delete the original version of the file ;;; after transferring the compressed version back is also dangerous, ;;; because some OS's have severe restrictions on the length of filenames, ;;; and when the compressed version is copied back the "-Z" or ".Z" may be ;;; truncated. Then, ange-ftp would delete the only remaining version of ;;; the file. Maybe ange-ftp should make backups when it compresses files ;;; (of course, the backup "~" could also be truncated off, sigh...). ;;; Suggestions? ;;; ;;; 10. If a dir listing is attempted for an empty directory on (at least ;;; some) VMS hosts, an ftp error is given. This is really an ftp bug, and ;;; I don't know how to get ange-ftp work to around it. ;;; ;;; 11. Bombs on filenames that start with a space. Deals well with filenames ;;; containing spaces, but beware that the remote ftpd may not like them ;;; much. ;;; ;;; 12. The dired support for non-Unix-like systems does not currently work. ;;; It needs to be reimplemented by modifying the parse-...-listing ;;; functions to convert the directory listing to ls -l format. ;;; ;;; 13. The famous @ bug. As mentioned above in TIPS, ULTRIX marks symlinks ;;; with a trailing @ in a ls -alF listing. In order to account for this ;;; ange-ftp looks to chop trailing @'s off of symlink names when it is ;;; parsing a listing with the F switch. This will cause ange-ftp to ;;; incorrectly get the name of a symlink on a non-ULTRIX host if its name ;;; ends in an @. ange-ftp will correct itself if you take F out of the ;;; dired ls switches (C-u s will allow you to edit the switches). The ;;; dired buffer will be automatically reverted, which will allow ange-ftp ;;; to fix its files hashtable. A cookie to anyone who can think of a ;;; fast, sure-fire way to recognize ULTRIX over ftp. ;;; If you find any bugs or problems with this package, PLEASE either e-mail ;;; the above author, or send a message to the ange-ftp-lovers mailing list ;;; below. Ideas and constructive comments are especially welcome. ;;; ange-ftp-lovers: ;;; ;;; ange-ftp has its own mailing list modestly called ange-ftp-lovers. All ;;; users of ange-ftp are welcome to subscribe (see below) and to discuss ;;; aspects of ange-ftp. New versions of ange-ftp are posted periodically to ;;; the mailing list. ;;; ;;; To [un]subscribe to ange-ftp-lovers, or to report mailer problems with the ;;; list, please mail one of the following addresses: ;;; ;;; ange-ftp-lovers-request@anorman.hpl.hp.com ;;; or ;;; ange-ftp-lovers-request%anorman.hpl.hp.com@hplb.hpl.hp.com ;;; ;;; Please don't forget the -request part. ;;; ;;; For mail to be posted directly to ange-ftp-lovers, send to one of the ;;; following addresses: ;;; ;;; ange-ftp-lovers@anorman.hpl.hp.com ;;; or ;;; ange-ftp-lovers%anorman.hpl.hp.com@hplb.hpl.hp.com ;;; ;;; Alternatively, there is a mailing list that only gets announcements of new ;;; ange-ftp releases. This is called ange-ftp-lovers-announce, and can be ;;; subscribed to by e-mailing to the -request address as above. Please make ;;; it clear in the request which mailing list you wish to join. ;;; The latest version of ange-ftp can usually be obtained via anonymous ftp ;;; from: ;;; alpha.gnu.ai.mit.edu:ange-ftp/ange-ftp.tar.Z ;;; or: ;;; ugle.unit.no:/pub/gnu/emacs-lisp/ange-ftp.tar.Z ;;; or: ;;; archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/ange-ftp.tar.Z ;;; The archives for ange-ftp-lovers can be found via anonymous ftp under: ;;; ;;; ftp.reed.edu:pub/mailing-lists/ange-ftp/ ;;; ----------------------------------------------------------- ;;; Technical information on this package: ;;; ----------------------------------------------------------- ;;; ange-ftp works by putting a handler on file-name-handler-alist ;;; which is called by many primitives, and a few non-primitives, ;;; whenever they see a file name of the appropriate sort. ;;; Checklist for adding non-UNIX support for TYPE ;;; ;;; The following functions may need TYPE versions: ;;; (not all functions will be needed for every OS) ;;; ;;; ange-ftp-fix-name-for-TYPE ;;; ange-ftp-fix-dir-name-for-TYPE ;;; ange-ftp-TYPE-host ;;; ange-ftp-TYPE-add-host ;;; ange-ftp-parse-TYPE-listing ;;; ange-ftp-TYPE-delete-file-entry ;;; ange-ftp-TYPE-add-file-entry ;;; ange-ftp-TYPE-file-name-as-directory ;;; ange-ftp-TYPE-make-compressed-filename ;;; ange-ftp-TYPE-file-name-sans-versions ;;; ;;; Variables: ;;; ;;; ange-ftp-TYPE-host-regexp ;;; May need to add TYPE to ange-ftp-dumb-host-types ;;; ;;; Check the following functions for OS dependent coding: ;;; ;;; ange-ftp-host-type ;;; ange-ftp-guess-host-type ;;; ange-ftp-allow-child-lookup ;;; Host type conventions: ;;; ;;; The function ange-ftp-host-type and the variable ange-ftp-dired-host-type ;;; (mostly) follow the following conventions for remote host types. At ;;; least, I think that future code should try to follow these conventions, ;;; and the current code should eventually be made compliant. ;;; ;;; nil = local host type, whatever that is (probably unix). ;;; Think nil as in "not a remote host". This value is used by ;;; ange-ftp-dired-host-type for local buffers. ;;; ;;; t = a remote host of unknown type. Think t is in true, it's remote. ;;; Currently, 'unix is used as the default remote host type. ;;; Maybe we should use t. ;;; ;;; 'type = a remote host of TYPE type. ;;; ;;; 'type:list = a remote host of TYPE type, using a specialized ftp listing ;;; program called list. This is currently only used for Unix ;;; dl (descriptive listings), when ange-ftp-dired-host-type ;;; is set to 'unix:dl. ;;; Bug report codes: ;;; ;;; Because of their naive faith in this code, there are certain situations ;;; which the writers of this program believe could never happen. However, ;;; being realists they have put calls to `error' in the program at these ;;; points. These errors provide a code, which is an integer, greater than 1. ;;; To aid debugging. the error codes, and the functions in which they reside ;;; are listed below. ;;; ;;; 1: See ange-ftp-ls ;;; ;;; ----------------------------------------------------------- ;;; Hall of fame: ;;; ----------------------------------------------------------- ;;; ;;; Thanks to Roland McGrath for improving the filename syntax handling, ;;; for suggesting many enhancements and for numerous cleanups to the code. ;;; ;;; Thanks to Jamie Zawinski for bugfixes and for ideas such as gateways. ;;; ;;; Thanks to Ken Laprade for improved .netrc parsing, password reading, and ;;; dired / shell auto-loading. ;;; ;;; Thanks to Sebastian Kremer for dired support and for many ideas and ;;; bugfixes. ;;; ;;; Thanks to Joe Wells for bugfixes, the original non-UNIX system support, ;;; VOS support, and hostname completion. ;;; ;;; Thanks to Nakagawa Takayuki for many good ideas, filename-completion, help ;;; with file-name expansion, efficiency worries, stylistic concerns and many ;;; bugfixes. ;;; ;;; Thanks to Sandy Rutherford who re-wrote most of ange-ftp to support VMS, ;;; MTS, CMS and UNIX-dls. Sandy also added dired-support for non-UNIX OS and ;;; auto-recognition of the host type. ;;; ;;; Thanks to Dave Smith who wrote the info file for ange-ftp. ;;; ;;; Finally, thanks to Keith Waclena, Mark D. Baushke, Terence Kelleher, Ping ;;; Zhou, Edward Vielmetti, Jack Repenning, Mike Balenger, Todd Kaufmann, ;;; Kjetil Svarstad, Tom Wurgler, Linus Tolke, Niko Makila, Carl Edman, Bill ;;; Trost, Dave Brennan, Dan Jacobson, Andy Scott, Steve Anderson, Sanjay ;;; Mathur, the folks on the ange-ftp-lovers mailing list and many others ;;; whose names I've forgotten who have helped to debug and fix problems with ;;; ange-ftp.el. ;;; Code: (require 'comint) ;;;; ------------------------------------------------------------ ;;;; User customization variables. ;;;; ------------------------------------------------------------ (defvar ange-ftp-name-format '("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*\\):\\(.*\\)" . (3 2 4)) "*Format of a fully expanded remote file name. This is a list of the form \(REGEXP HOST USER NAME\), where REGEXP is a regular expression matching the full remote name, and HOST, USER, and NAME are the numbers of parenthesized expressions in REGEXP for the components (in that order).") ;; ange-ftp-multi-skip-msgs should only match ###-, where ### is one of ;; the number codes corresponding to ange-ftp-good-msgs or ange-ftp-fatal-msgs. ;; Otherwise, ange-ftp will go into multi-skip mode, and never come out. (defvar ange-ftp-multi-msgs "^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^331-\\|^4[25]1-\\|^530-" "*Regular expression matching the start of a multiline ftp reply.") (defvar ange-ftp-good-msgs "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark" "*Regular expression matching ftp \"success\" messages.") ;; CMS and the odd VMS machine say 200 Port rather than 200 PORT. ;; Also CMS machines use a multiline 550- reply to say that you ;; don't have write permission. ange-ftp gets into multi-line skip ;; mode and hangs. Have it ignore 550- instead. It will then barf ;; when it gets the 550 line, as it should. (defvar ange-ftp-skip-msgs (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|" "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|" "^Data connection \\|" "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye") "*Regular expression matching ftp messages that can be ignored.") (defvar ange-ftp-fatal-msgs (concat "^ftp: \\|^Not connected\\|^530 \\|^4[25]1 \\|rcmd: \\|" "^No control connection\\|unknown host\\|^lost connection") "*Regular expression matching ftp messages that indicate serious errors. These mean that the FTP process should (or already has) been killed.") (defvar ange-ftp-gateway-fatal-msgs "No route to host\\|Connection closed\\|No such host\\|Login incorrect" "*Regular expression matching login failure messages from rlogin/telnet.") (defvar ange-ftp-xfer-size-msgs "^150 .* connection for .* (\\([0-9]+\\) bytes)" "*Regular expression used to determine the number of bytes in a FTP transfer.") (defvar ange-ftp-tmp-name-template "/tmp/ange-ftp" "*Template used to create temporary files.") (defvar ange-ftp-gateway-tmp-name-template "/tmp/ange-ftp" "*Template used to create temporary files when ftp-ing through a gateway. Files starting with this prefix need to be accessible from BOTH the local machine and the gateway machine, and need to have the SAME name on both machines, that is, /tmp is probably NOT what you want, since that is rarely cross-mounted.") (defvar ange-ftp-netrc-filename "~/.netrc" "*File in .netrc format to search for passwords.") (defvar ange-ftp-disable-netrc-security-check nil "*If non-nil avoid checking permissions on the .netrc file.") (defvar ange-ftp-default-user nil "*User name to use when none is specied in a file name. If nil, then the name under which the user is logged in is used. If non-nil but not a string, the user is prompted for the name.") (defvar ange-ftp-default-password nil "*Password to use when the user is the same as ange-ftp-default-user.") (defvar ange-ftp-default-account nil "*Account password to use when the user is the same as ange-ftp-default-user.") (defvar ange-ftp-generate-anonymous-password t "*If t, use value of `user-mail-address' as password for anonymous ftp. If a string, then use that string as the password. If nil, prompt the user for a password.") (defvar ange-ftp-dumb-unix-host-regexp nil "*If non-nil, regexp matching hosts on which `dir' command lists directory.") (defvar ange-ftp-binary-file-name-regexp (concat "\\.[zZ]$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|" "\\.dvi$\\|\\.ps$\\|\\.elc$\\|TAGS$\\|\\.gif$\\|" "\\.EXE\\(;[0-9]+\\)?$\\|\\.[zZ]-part-..$\\|\\.gz$\\|" "\\.taz$\\|\\.tgz$") "*If a file matches this regexp then it is transferred in binary mode.") (defvar ange-ftp-gateway-host nil "*Name of host to use as gateway machine when local FTP isn't possible.") (defvar ange-ftp-local-host-regexp ".*" "*Regexp selecting hosts which can be reached directly with ftp. For other hosts the FTP process is started on \`ange-ftp-gateway-host\' instead, and/or reached via \`ange-ftp-gateway-ftp-program-name\'.") (defvar ange-ftp-gateway-program-interactive nil "*If non-nil then the gateway program should give a shell prompt. Both telnet and rlogin do something like this.") (defvar ange-ftp-gateway-program remote-shell-program "*Name of program to spawn a shell on the gateway machine. Valid candidates are rsh (remsh on some systems), telnet and rlogin. See also the gateway variable above.") (defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;\n]*[#$%>;] *" "*Regexp matching prompt after complete login sequence on gateway machine. A match for this means the shell is now awaiting input. Make this regexp as strict as possible; it shouldn't match *anything* at all except the user's initial prompt. The above string will fail under most SUN-3's since it matches the login banner.") (defvar ange-ftp-gateway-setup-term-command (if (eq system-type 'hpux) "stty -onlcr -echo\n" "stty -echo nl\n") "*Set up terminal after logging in to the gateway machine. This command should stop the terminal from echoing each command, and arrange to strip out trailing ^M characters.") (defvar ange-ftp-smart-gateway nil "*Non-nil means the ftp gateway and/or the gateway ftp program is smart. Don't bother telnetting, etc., already connected to desired host transparently, or just issue a user@host command in case \`ange-ftp-gateway-host\' is non-nil.") (defvar ange-ftp-smart-gateway-port "21" "*Port on gateway machine to use when smart gateway is in operation.") (defvar ange-ftp-send-hash t "*If non-nil, send the HASH command to the FTP client.") (defvar ange-ftp-binary-hash-mark-size nil "*Default size, in bytes, between hash-marks when transferring a binary file. If NIL, this variable will be locally overridden if the FTP client outputs a suitable response to the HASH command. If non-NIL then this value takes precedence over the local value.") (defvar ange-ftp-ascii-hash-mark-size 1024 "*Default size, in bytes, between hash-marks when transferring an ASCII file. This variable is buffer-local and will be locally overridden if the FTP client outputs a suitable response to the HASH command.") (defvar ange-ftp-process-verbose t "*If non-NIL then be chatty about interaction with the FTP process.") (defvar ange-ftp-ftp-program-name "ftp" "*Name of FTP program to run.") (defvar ange-ftp-gateway-ftp-program-name "ftp" "*Name of FTP program to run when accessing non-local hosts. Some AT&T folks claim to use something called `pftp' here.") (defvar ange-ftp-ftp-program-args '("-i" "-n" "-g" "-v") "*A list of arguments passed to the FTP program when started.") (defvar ange-ftp-nslookup-program nil "*If non-NIL then a string naming nslookup program." ) (defvar ange-ftp-make-backup-files () "*Non-nil means make backup files for \"magic\" remote files.") (defvar ange-ftp-retry-time 5 "*Number of seconds to wait before retry if file or listing doesn't arrive. This might need to be increased for very slow connections.") (defvar ange-ftp-auto-save 0 "If 1, allows ange-ftp files to be auto-saved. If 0, suppresses auto-saving of ange-ftp files. Don't use any other value.") ;;;; ------------------------------------------------------------ ;;;; Hash table support. ;;;; ------------------------------------------------------------ (require 'backquote) (defun ange-ftp-make-hashtable (&optional size) "Make an obarray suitable for use as a hashtable. SIZE, if supplied, should be a prime number." (make-vector (or size 31) 0)) (defun ange-ftp-map-hashtable (fun tbl) "Call FUNCTION on each key and value in HASHTABLE." (mapatoms (function (lambda (sym) (funcall fun (get sym 'key) (get sym 'val)))) tbl)) (defmacro ange-ftp-make-hash-key (key) "Convert KEY into a suitable key for a hashtable." (` (if (stringp (, key)) (, key) (prin1-to-string (, key))))) (defun ange-ftp-get-hash-entry (key tbl) "Return the value associated with KEY in HASHTABLE." (let ((sym (intern-soft (ange-ftp-make-hash-key key) tbl))) (and sym (get sym 'val)))) (defun ange-ftp-put-hash-entry (key val tbl) "Record an association between KEY and VALUE in HASHTABLE." (let ((sym (intern (ange-ftp-make-hash-key key) tbl))) (put sym 'val val) (put sym 'key key))) (defun ange-ftp-del-hash-entry (key tbl) "Copy all symbols except KEY in HASHTABLE and return modified hashtable." (let* ((len (length tbl)) (new-tbl (ange-ftp-make-hashtable len)) (i (1- len))) (ange-ftp-map-hashtable (function (lambda (k v) (or (equal k key) (ange-ftp-put-hash-entry k v new-tbl)))) tbl) (while (>= i 0) (aset tbl i (aref new-tbl i)) (setq i (1- i))) tbl)) (defun ange-ftp-hash-entry-exists-p (key tbl) "Return whether there is an association for KEY in TABLE." (intern-soft (ange-ftp-make-hash-key key) tbl)) (defun ange-ftp-hash-table-keys (tbl) "Return a sorted list of all the active keys in TABLE, as strings." (sort (all-completions "" tbl) (function string-lessp))) ;;;; ------------------------------------------------------------ ;;;; Internal variables. ;;;; ------------------------------------------------------------ (defvar ange-ftp-data-buffer-name " *ftp data*" "Buffer name to hold directory listing data received from ftp process.") (defvar ange-ftp-netrc-modtime nil "Last modified time of the netrc file from file-attributes.") (defvar ange-ftp-user-hashtable (ange-ftp-make-hashtable) "Hash table holding associations between HOST, USER pairs.") (defvar ange-ftp-passwd-hashtable (ange-ftp-make-hashtable) "Mapping between a HOST, USER pair and a PASSWORD for them.") (defvar ange-ftp-account-hashtable (ange-ftp-make-hashtable) "Mapping between a HOST, USER pair and a ACCOUNT password for them.") (defvar ange-ftp-files-hashtable (ange-ftp-make-hashtable 97) "Hash table for storing directories and their respective files.") (defvar ange-ftp-ls-cache-lsargs nil "Last set of args used by ange-ftp-ls.") (defvar ange-ftp-ls-cache-file nil "Last file passed to ange-ftp-ls.") (defvar ange-ftp-ls-cache-res nil "Last result returned from ange-ftp-ls.") (defconst ange-ftp-expand-dir-hashtable (ange-ftp-make-hashtable)) (defconst ange-ftp-expand-dir-regexp "^5.0 \\([^: ]+\\):") ;; These are local variables in each FTP process buffer. (defvar ange-ftp-hash-mark-unit nil) (defvar ange-ftp-hash-mark-count nil) (defvar ange-ftp-xfer-size nil) (defvar ange-ftp-process-string nil) (defvar ange-ftp-process-result-line nil) (defvar ange-ftp-process-busy nil) (defvar ange-ftp-process-result nil) (defvar ange-ftp-process-multi-skip nil) (defvar ange-ftp-process-msg nil) (defvar ange-ftp-process-continue nil) (defvar ange-ftp-last-percent nil) ;; These variables are bound by one function and examined by another. ;; Leave them void globally for error checking. (defvar ange-ftp-this-file) (defvar ange-ftp-this-dir) (defvar ange-ftp-this-user) (defvar ange-ftp-this-host) (defvar ange-ftp-this-msg) (defvar ange-ftp-completion-ignored-pattern) (defvar ange-ftp-trample-marker) ;; New error symbols. (put 'ftp-error 'error-conditions '(ftp-error file-error error)) ;; (put 'ftp-error 'error-message "FTP error") ;;; ------------------------------------------------------------ ;;; Enhanced message support. ;;; ------------------------------------------------------------ (defun ange-ftp-message (fmt &rest args) "Display message in echo area, but indicate if truncated. Args are as in `message': a format string, plus arguments to be formatted." (let ((msg (apply (function format) fmt args)) (max (window-width (minibuffer-window)))) (if noninteractive msg (if (>= (length msg) max) ;; Take just the last MAX - 3 chars of the string. (setq msg (concat "> " (substring msg (- 3 max))))) (message "%s" msg)))) (defun ange-ftp-abbreviate-filename (file &optional new) "Abbreviate the file name FILE relative to the default-directory. If the optional parameter NEW is given and the non-directory parts match, only return the directory part of FILE." (save-match-data (if (and default-directory (string-match (concat "^" (regexp-quote default-directory) ".") file)) (setq file (substring file (1- (match-end 0))))) (if (and new (string-equal (file-name-nondirectory file) (file-name-nondirectory new))) (setq file (file-name-directory file))) (or file "./"))) ;;;; ------------------------------------------------------------ ;;;; User / Host mapping support. ;;;; ------------------------------------------------------------ (defun ange-ftp-set-user (host user) "For a given HOST, set or change the default USER." (interactive "sHost: \nsUser: ") (ange-ftp-put-hash-entry host user ange-ftp-user-hashtable)) (defun ange-ftp-get-user (host) "Given a HOST, return the default USER." (ange-ftp-parse-netrc) (let ((user (ange-ftp-get-hash-entry host ange-ftp-user-hashtable))) (or user (prog1 (setq user (cond ((stringp ange-ftp-default-user) ;; We have a default name. Use it. ange-ftp-default-user) (ange-ftp-default-user ;; Ask the user. (let ((enable-recursive-minibuffers t)) (read-string (format "User for %s: " host) (user-login-name)))) ;; Default to the user's login name. (t (user-login-name)))) (ange-ftp-set-user host user))))) ;;;; ------------------------------------------------------------ ;;;; Password support. ;;;; ------------------------------------------------------------ (defun ange-ftp-read-passwd (prompt &optional default) "Read a password, echoing `.' for each character typed. End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. Optional DEFAULT is password to start with." (let ((pass (if default default "")) (c 0) (echo-keystrokes 0) (cursor-in-echo-area t)) (while (progn (message "%s%s" prompt (make-string (length pass) ?.)) (setq c (read-char)) (and (/= c ?\r) (/= c ?\n) (/= c ?\e))) (if (= c ?\C-u) (setq pass "") (if (and (/= c ?\b) (/= c ?\177)) (setq pass (concat pass (char-to-string c))) (if (> (length pass) 0) (setq pass (substring pass 0 -1)))))) (message "") (ange-ftp-repaint-minibuffer) pass)) (defmacro ange-ftp-generate-passwd-key (host user) (` (concat (, host) "/" (, user)))) (defmacro ange-ftp-lookup-passwd (host user) (` (ange-ftp-get-hash-entry (ange-ftp-generate-passwd-key (, host) (, user)) ange-ftp-passwd-hashtable))) (defun ange-ftp-set-passwd (host user passwd) "For a given HOST and USER, set or change the associated PASSWORD." (interactive (list (read-string "Host: ") (read-string "User: ") (ange-ftp-read-passwd "Password: "))) (ange-ftp-put-hash-entry (ange-ftp-generate-passwd-key host user) passwd ange-ftp-passwd-hashtable)) (defun ange-ftp-get-host-with-passwd (user) "Given a USER, return a host we know the password for." (ange-ftp-parse-netrc) (catch 'found-one (ange-ftp-map-hashtable (function (lambda (host val) (if (ange-ftp-lookup-passwd host user) (throw 'found-one host)))) ange-ftp-user-hashtable) (save-match-data (ange-ftp-map-hashtable (function (lambda (key value) (if (string-match "^[^/]*\\(/\\).*$" key) (let ((host (substring key 0 (match-beginning 1)))) (if (and (string-equal user (substring key (match-end 1))) value) (throw 'found-one host)))))) ange-ftp-passwd-hashtable)) nil)) (defun ange-ftp-get-passwd (host user) "Return the password for specified HOST and USER, asking user if necessary." (ange-ftp-parse-netrc) ;; look up password in the hash table first; user might have overridden the ;; defaults. (cond ((ange-ftp-lookup-passwd host user)) ;; see if default user and password set from the .netrc file. ((and (stringp ange-ftp-default-user) ange-ftp-default-password (string-equal user ange-ftp-default-user)) ange-ftp-default-password) ;; anonymous ftp password is handled specially since there is an ;; unwritten rule about how that is used on the Internet. ((and (or (string-equal user "anonymous") (string-equal user "ftp")) ange-ftp-generate-anonymous-password) (if (stringp ange-ftp-generate-anonymous-password) ange-ftp-generate-anonymous-password user-mail-address)) ;; see if same user has logged in to other hosts; if so then prompt ;; with the password that was used there. (t (let* ((other (ange-ftp-get-host-with-passwd user)) (passwd (if other ;; found another machine with the same user. ;; Try that account. (ange-ftp-read-passwd (format "passwd for %s@%s (same as %s@%s): " user host user other) (ange-ftp-lookup-passwd other user)) ;; I give up. Ask the user for the password. (ange-ftp-read-passwd (format "Password for %s@%s: " user host))))) (ange-ftp-set-passwd host user passwd) passwd)))) ;;;; ------------------------------------------------------------ ;;;; Account support ;;;; ------------------------------------------------------------ ;; Account passwords must be either specified in the .netrc file, or set ;; manually by calling ange-ftp-set-account. For the moment, ange-ftp doesn't ;; check to see whether the FTP process is actually prompting for an account ;; password. (defun ange-ftp-set-account (host user account) "For a given HOST and USER, set or change the associated ACCOUNT password." (interactive (list (read-string "Host: ") (read-string "User: ") (ange-ftp-read-passwd "Account password: "))) (ange-ftp-put-hash-entry (ange-ftp-generate-passwd-key host user) account ange-ftp-account-hashtable)) (defun ange-ftp-get-account (host user) "Given a HOST and USER, return the FTP account." (ange-ftp-parse-netrc) (or (ange-ftp-get-hash-entry (ange-ftp-generate-passwd-key host user) ange-ftp-account-hashtable) (and (stringp ange-ftp-default-user) (string-equal user ange-ftp-default-user) ange-ftp-default-account))) ;;;; ------------------------------------------------------------ ;;;; ~/.netrc support ;;;; ------------------------------------------------------------ (defun ange-ftp-chase-symlinks (file) "Return the filename that FILE references, following all symbolic links." (let (temp) (while (setq temp (ange-ftp-real-file-symlink-p file)) (setq file (if (file-name-absolute-p temp) temp (concat (file-name-directory file) temp))))) file) ;; Move along current line looking for the value of the TOKEN. ;; Valid separators between TOKEN and its value are commas and ;; whitespace. Second arg LIMIT is a limit for the search. (defun ange-ftp-parse-netrc-token (token limit) (if (search-forward token limit t) (let (beg) (skip-chars-forward ", \t\r\n" limit) (if (eq (following-char) ?\") ;quoted token value (progn (forward-char 1) (setq beg (point)) (skip-chars-forward "^\"" limit) (forward-char 1) (buffer-substring beg (1- (point)))) (setq beg (point)) (skip-chars-forward "^, \t\r\n" limit) (buffer-substring beg (point)))))) ;; Extract the values for the tokens `machine', `login', ;; `password' and `account' in the current buffer. If successful, ;; record the information found. (defun ange-ftp-parse-netrc-group () (let ((start (point)) (end (save-excursion (if (looking-at "machine\\>") ;; Skip `machine' and the machine name that follows. (progn (skip-chars-forward "^ \t\n") (skip-chars-forward " \t\n") (skip-chars-forward "^ \t\n")) ;; Skip `default'. (skip-chars-forward "^ \t\n")) ;; Find start of the next `machine' or `default' ;; or the end of the buffer. (if (re-search-forward "machine\\>\\|default\\>" nil t) (match-beginning 0) (point-max)))) machine login password account) (setq machine (ange-ftp-parse-netrc-token "machine" end) login (ange-ftp-parse-netrc-token "login" end) password (ange-ftp-parse-netrc-token "password" end) account (ange-ftp-parse-netrc-token "account" end)) (if (and machine login) ;; found a `machine` token. (progn (ange-ftp-set-user machine login) (ange-ftp-set-passwd machine login password) (and account (ange-ftp-set-account machine login account))) (goto-char start) (if (search-forward "default" end t) ;; found a `default' token (progn (setq login (ange-ftp-parse-netrc-token "login" end) password (ange-ftp-parse-netrc-token "password" end) account (ange-ftp-parse-netrc-token "account" end)) (and login (setq ange-ftp-default-user login)) (and password (setq ange-ftp-default-password password)) (and account (setq ange-ftp-default-account account))))) (goto-char end))) ;; Read in ~/.netrc, if one exists. If ~/.netrc file exists and has ;; the correct permissions then extract the \`machine\', \`login\', ;; \`password\' and \`account\' information from within. (defun ange-ftp-parse-netrc () ;; We set this before actually doing it to avoid the possibility ;; of an infinite loop if ange-ftp-netrc-filename is an FTP file. (interactive) (let (file attr) (let ((default-directory "/")) (setq file (ange-ftp-chase-symlinks (ange-ftp-real-expand-file-name ange-ftp-netrc-filename))) (setq attr (ange-ftp-real-file-attributes file))) (if (and attr ; file exists. (not (equal (nth 5 attr) ange-ftp-netrc-modtime))) ; file changed (save-match-data (if (or ange-ftp-disable-netrc-security-check (and (eq (nth 2 attr) (user-uid)) ; Same uids. (string-match ".r..------" (nth 8 attr)))) (save-excursion ;; we are cheating a bit here. I'm trying to do the equivalent ;; of find-file on the .netrc file, but then nuke it afterwards. ;; with the bit of logic below we should be able to have ;; encrypted .netrc files. (set-buffer (generate-new-buffer "*ftp-.netrc*")) (ange-ftp-real-insert-file-contents file) (setq buffer-file-name file) (setq default-directory (file-name-directory file)) (normal-mode t) (mapcar 'funcall find-file-hooks) (setq buffer-file-name nil) (goto-char (point-min)) (skip-chars-forward " \t\n") (while (not (eobp)) (ange-ftp-parse-netrc-group)) (kill-buffer (current-buffer))) (ange-ftp-message "%s either not owned by you or badly protected." ange-ftp-netrc-filename) (sit-for 1)) (setq ange-ftp-netrc-modtime (nth 5 attr)))))) ;; Return a list of prefixes of the form 'user@host:' to be used when ;; completion is done in the root directory. (defun ange-ftp-generate-root-prefixes () (ange-ftp-parse-netrc) (save-match-data (let (res) (ange-ftp-map-hashtable (function (lambda (key value) (if (string-match "^[^/]*\\(/\\).*$" key) (let ((host (substring key 0 (match-beginning 1))) (user (substring key (match-end 1)))) (setq res (cons (list (concat user "@" host ":")) res)))))) ange-ftp-passwd-hashtable) (ange-ftp-map-hashtable (function (lambda (host user) (setq res (cons (list (concat host ":")) res)))) ange-ftp-user-hashtable) (or res (list nil))))) ;;;; ------------------------------------------------------------ ;;;; Remote file name syntax support. ;;;; ------------------------------------------------------------ (defmacro ange-ftp-ftp-name-component (n ns name) "Extract the Nth ftp file name component from NS." (` (let ((elt (nth (, n) (, ns)))) (if (match-beginning elt) (substring (, name) (match-beginning elt) (match-end elt)))))) (defvar ange-ftp-ftp-name-arg "") (defvar ange-ftp-ftp-name-res nil) ;; Parse NAME according to `ange-ftp-name-format' (which see). ;; Returns a list (HOST USER NAME), or nil if NAME does not match the format. (defun ange-ftp-ftp-name (name) (if (string-equal name ange-ftp-ftp-name-arg) ange-ftp-ftp-name-res (setq ange-ftp-ftp-name-arg name ange-ftp-ftp-name-res (save-match-data (if (posix-string-match (car ange-ftp-name-format) name) (let* ((ns (cdr ange-ftp-name-format)) (host (ange-ftp-ftp-name-component 0 ns name)) (user (ange-ftp-ftp-name-component 1 ns name)) (name (ange-ftp-ftp-name-component 2 ns name))) (if (zerop (length user)) (setq user (ange-ftp-get-user host))) (list host user name)) nil))))) ;; Take a FULLNAME that matches according to ange-ftp-name-format and ;; replace the name component with NAME. (defun ange-ftp-replace-name-component (fullname name) (save-match-data (if (posix-string-match (car ange-ftp-name-format) fullname) (let* ((ns (cdr ange-ftp-name-format)) (elt (nth 2 ns))) (concat (substring fullname 0 (match-beginning elt)) name (substring fullname (match-end elt))))))) ;;;; ------------------------------------------------------------ ;;;; Miscellaneous utils. ;;;; ------------------------------------------------------------ ;; (setq ange-ftp-tmp-keymap (make-sparse-keymap)) ;; (define-key ange-ftp-tmp-keymap "\C-m" 'exit-minibuffer) (defun ange-ftp-repaint-minibuffer () "Clear any existing minibuffer message; let the minibuffer contents show." (message nil)) ;; Return the name of the buffer that collects output from the ftp process ;; connected to the given HOST and USER pair. (defun ange-ftp-ftp-process-buffer (host user) (concat "*ftp " user "@" host "*")) ;; Display the last chunk of output from the ftp process for the given HOST ;; USER pair, and signal an error including MSG in the text. (defun ange-ftp-error (host user msg) (let ((cur (selected-window)) (pop-up-windows t)) (pop-to-buffer (get-buffer-create (ange-ftp-ftp-process-buffer host user))) (goto-char (point-max)) (select-window cur)) (signal 'ftp-error (list (format "FTP Error: %s" msg)))) (defun ange-ftp-set-buffer-mode () "Set correct modes for the current buffer if visiting a remote file." (if (and (stringp buffer-file-name) (ange-ftp-ftp-name buffer-file-name)) (auto-save-mode ange-ftp-auto-save))) (defun ange-ftp-kill-ftp-process (buffer) "Kill the FTP process associated with BUFFER. If the BUFFER's visited filename or default-directory is an ftp filename then kill the related ftp process." (interactive "bKill FTP process associated with buffer: ") (if (null buffer) (setq buffer (current-buffer))) (let ((file (or (buffer-file-name) default-directory))) (if file (let ((parsed (ange-ftp-ftp-name (expand-file-name file)))) (if parsed (let ((host (nth 0 parsed)) (user (nth 1 parsed))) (kill-buffer (ange-ftp-ftp-process-buffer host user)))))))) (defun ange-ftp-quote-string (string) "Quote any characters in STRING that may confuse the ftp process." (apply (function concat) (mapcar (function (lambda (char) (if (or (<= char ? ) (> char ?\~) (= char ?\") (= char ?\\)) (vector ?\\ char) (vector char)))) string))) (defun ange-ftp-barf-if-not-directory (directory) (or (file-directory-p directory) (signal 'file-error (list "Opening directory" (if (file-exists-p directory) "not a directory" "no such file or directory") directory)))) ;;;; ------------------------------------------------------------ ;;;; FTP process filter support. ;;;; ------------------------------------------------------------ (defun ange-ftp-process-handle-line (line proc) "Look at the given LINE from the ftp process PROC. Try to categorize it into one of four categories: good, skip, fatal, or unknown." (cond ((string-match ange-ftp-xfer-size-msgs line) (setq ange-ftp-xfer-size (ash (string-to-int (substring line (match-beginning 1) (match-end 1))) -10))) ((string-match ange-ftp-skip-msgs line) t) ((string-match ange-ftp-good-msgs line) (setq ange-ftp-process-busy nil ange-ftp-process-result t ange-ftp-process-result-line line)) ;; Check this before checking for errors. ;; Otherwise the last line of these three seems to be an error: ;; 230-see a significant impact from the move. For those of you who can't ;; 230-use DNS to resolve hostnames and get an error message like ;; 230-"ftp.stsci.edu: unknown host", the new IP address will be... ((string-match ange-ftp-multi-msgs line) (setq ange-ftp-process-multi-skip t)) ((string-match ange-ftp-fatal-msgs line) (delete-process proc) (setq ange-ftp-process-busy nil ange-ftp-process-result-line line)) (ange-ftp-process-multi-skip t) (t (setq ange-ftp-process-busy nil ange-ftp-process-result-line line)))) (defun ange-ftp-set-xfer-size (host user bytes) "Set the size of the next FTP transfer in bytes." (let ((proc (ange-ftp-get-process host user))) (if proc (let ((buf (process-buffer proc))) (if buf (save-excursion (set-buffer buf) (setq ange-ftp-xfer-size (ash bytes -10)))))))) (defun ange-ftp-process-handle-hash (str) "Remove hash marks from STRING and display count so far." (setq str (concat (substring str 0 (match-beginning 0)) (substring str (match-end 0))) ange-ftp-hash-mark-count (+ (- (match-end 0) (match-beginning 0)) ange-ftp-hash-mark-count)) (and ange-ftp-hash-mark-unit ange-ftp-process-msg ange-ftp-process-verbose (not (eq (selected-window) (minibuffer-window))) (not (boundp 'search-message)) ;screws up isearch otherwise (not cursor-in-echo-area) ;screws up y-or-n-p otherwise (let ((kbytes (ash (* ange-ftp-hash-mark-unit ange-ftp-hash-mark-count) -6))) (if (zerop ange-ftp-xfer-size) (ange-ftp-message "%s...%dk" ange-ftp-process-msg kbytes) (let ((percent (/ (* 100 kbytes) ange-ftp-xfer-size))) ;; cut out the redisplay of identical %-age messages. (if (not (eq percent ange-ftp-last-percent)) (progn (setq ange-ftp-last-percent percent) (ange-ftp-message "%s...%d%%" ange-ftp-process-msg percent))))))) str) ;; Call the function specified by CONT. CONT can be either a function ;; or a list of a function and some args. The first two parameters ;; passed to the function will be RESULT and LINE. The remaining args ;; will be taken from CONT if a list was passed. (defun ange-ftp-call-cont (cont result line) (if cont (if (and (listp cont) (not (eq (car cont) 'lambda))) (apply (car cont) result line (cdr cont)) (funcall cont result line)))) ;; Build up a complete line of output from the ftp PROCESS and pass it ;; on to ange-ftp-process-handle-line to deal with. (defun ange-ftp-process-filter (proc str) (let ((buffer (process-buffer proc)) (old-buffer (current-buffer))) ;; see if the buffer is still around... it could have been deleted. (if (buffer-name buffer) (unwind-protect (progn (set-buffer (process-buffer proc)) ;; handle hash mark printing (and ange-ftp-process-busy (string-match "^#+$" str) (setq str (ange-ftp-process-handle-hash str))) (comint-output-filter proc str) ;; Replace STR by the result of the comint processing. (setq str (buffer-substring comint-last-output-start (process-mark proc))) (if ange-ftp-process-busy (progn (setq ange-ftp-process-string (concat ange-ftp-process-string str)) ;; if we gave an empty password to the USER command earlier ;; then we should send a null password now. (if (string-match "Password: *$" ange-ftp-process-string) (send-string proc "\n")))) (while (and ange-ftp-process-busy (string-match "\n" ange-ftp-process-string)) (let ((line (substring ange-ftp-process-string 0 (match-beginning 0)))) (setq ange-ftp-process-string (substring ange-ftp-process-string (match-end 0))) (while (string-match "^ftp> *" line) (setq line (substring line (match-end 0)))) (ange-ftp-process-handle-line line proc))) ;; has the ftp client finished? if so then do some clean-up ;; actions. (if (not ange-ftp-process-busy) (progn ;; reset the xfer size (setq ange-ftp-xfer-size 0) ;; issue the "done" message since we've finished. (if (and ange-ftp-process-msg ange-ftp-process-verbose ange-ftp-process-result) (progn (ange-ftp-message "%s...done" ange-ftp-process-msg) (ange-ftp-repaint-minibuffer) (setq ange-ftp-process-msg nil))) ;; is there a continuation we should be calling? if so, ;; we'd better call it, making sure we only call it once. (if ange-ftp-process-continue (let ((cont ange-ftp-process-continue)) (setq ange-ftp-process-continue nil) (ange-ftp-call-cont cont ange-ftp-process-result ange-ftp-process-result-line)))))) (set-buffer old-buffer))))) (defun ange-ftp-process-sentinel (proc str) "When ftp process changes state, nuke all file-entries in cache." (let ((name (process-name proc))) (if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)\\*" name) (let ((user (substring name (match-beginning 1) (match-end 1))) (host (substring name (match-beginning 2) (match-end 2)))) (ange-ftp-wipe-file-entries host user)))) (setq ange-ftp-ls-cache-file nil)) ;;;; ------------------------------------------------------------ ;;;; Gateway support. ;;;; ------------------------------------------------------------ (defun ange-ftp-use-gateway-p (host) "Returns whether to access this host via a normal (non-smart) gateway." ;; yes, I know that I could simplify the following expression, but it is ;; clearer (to me at least) this way. (and (not ange-ftp-smart-gateway) (save-match-data (not (string-match ange-ftp-local-host-regexp host))))) (defun ange-ftp-use-smart-gateway-p (host) "Returns whether to access this host via a smart gateway." (and ange-ftp-smart-gateway (save-match-data (not (string-match ange-ftp-local-host-regexp host))))) ;;; ------------------------------------------------------------ ;;; Temporary file location and deletion... ;;; ------------------------------------------------------------ (defvar ange-ftp-tmp-name-files ()) (defvar ange-ftp-tmp-name-hashtable (ange-ftp-make-hashtable 10)) (defvar ange-ftp-pid nil) (defun ange-ftp-get-pid () "Half-hearted attempt to get the current process's id." (setq ange-ftp-pid (substring (make-temp-name "") 1))) (defun ange-ftp-make-tmp-name (host) "This routine will return the name of a new file." (let* ((template (if (ange-ftp-use-gateway-p host) ange-ftp-gateway-tmp-name-template ange-ftp-tmp-name-template)) (pid (or ange-ftp-pid (ange-ftp-get-pid))) (start ?a) file entry) (while (progn (setq file (format "%s%c%s" template start pid)) (setq entry (intern file ange-ftp-tmp-name-hashtable)) (or (memq entry ange-ftp-tmp-name-files) (ange-ftp-real-file-exists-p file))) (if (> (setq start (1+ start)) ?z) (progn (setq template (concat template "X")) (setq start ?a)))) (setq ange-ftp-tmp-name-files (cons entry ange-ftp-tmp-name-files)) file)) (defun ange-ftp-del-tmp-name (temp) (setq ange-ftp-tmp-name-files (delq (intern temp ange-ftp-tmp-name-hashtable) ange-ftp-tmp-name-files)) (condition-case () (ange-ftp-real-delete-file temp) (error nil))) ;;;; ------------------------------------------------------------ ;;;; Interactive gateway program support. ;;;; ------------------------------------------------------------ (defvar ange-ftp-gwp-running t) (defvar ange-ftp-gwp-status nil) (defun ange-ftp-gwp-sentinel (proc str) (setq ange-ftp-gwp-running nil)) (defun ange-ftp-gwp-filter (proc str) (comint-output-filter proc str) (save-excursion (set-buffer (process-buffer proc)) ;; Replace STR by the result of the comint processing. (setq str (buffer-substring comint-last-output-start (process-mark proc)))) (cond ((string-match "login: *$" str) (send-string proc (concat (let ((ange-ftp-default-user t)) (ange-ftp-get-user ange-ftp-gateway-host)) "\n"))) ((string-match "Password: *$" str) (send-string proc (concat (ange-ftp-get-passwd ange-ftp-gateway-host (ange-ftp-get-user ange-ftp-gateway-host)) "\n"))) ((string-match ange-ftp-gateway-fatal-msgs str) (delete-process proc) (setq ange-ftp-gwp-running nil)) ((string-match ange-ftp-gateway-prompt-pattern str) (setq ange-ftp-gwp-running nil ange-ftp-gwp-status t)))) (defun ange-ftp-gwp-start (host user name args) "Login to the gateway machine and fire up an ftp process." (let* ((gw-user (ange-ftp-get-user ange-ftp-gateway-host)) ;; It would be nice to make process-connection-type nil, ;; but that doesn't work: ftp never responds. ;; Can anyone find a fix for that? (proc (let ((process-connection-type t)) (start-process name name ange-ftp-gateway-program ange-ftp-gateway-host))) (ftp (mapconcat (function identity) args " "))) (process-kill-without-query proc) (set-process-sentinel proc (function ange-ftp-gwp-sentinel)) (set-process-filter proc (function ange-ftp-gwp-filter)) (save-excursion (set-buffer (process-buffer proc)) (internal-ange-ftp-mode) (set-marker (process-mark proc) (point))) (setq ange-ftp-gwp-running t ange-ftp-gwp-status nil) (ange-ftp-message "Connecting to gateway %s..." ange-ftp-gateway-host) (while ange-ftp-gwp-running ;perform login sequence (accept-process-output proc)) (if (not ange-ftp-gwp-status) (ange-ftp-error host user "unable to login to gateway")) (ange-ftp-message "Connecting to gateway %s...done" ange-ftp-gateway-host) (setq ange-ftp-gwp-running t ange-ftp-gwp-status nil) (process-send-string proc ange-ftp-gateway-setup-term-command) (while ange-ftp-gwp-running ;zap ^M's and double echoing. (accept-process-output proc)) (if (not ange-ftp-gwp-status) (ange-ftp-error host user "unable to set terminal modes on gateway")) (setq ange-ftp-gwp-running t ange-ftp-gwp-status nil) (process-send-string proc (concat "exec " ftp "\n")) ;spawn ftp process proc)) ;;;; ------------------------------------------------------------ ;;;; Support for sending commands to the ftp process. ;;;; ------------------------------------------------------------ (defun ange-ftp-raw-send-cmd (proc cmd &optional msg cont nowait) "Low-level routine to send the given ftp CMD to the ftp PROCESS. MSG is an optional message to output before and after the command. If CONT is non-NIL then it is either a function or a list of function and some arguments. The function will be called when the ftp command has completed. If CONT is NIL then this routine will return \( RESULT . LINE \) where RESULT is whether the command was successful, and LINE is the line from the FTP process that caused the command to complete. If NOWAIT is given then the routine will return immediately the command has been queued with no result. CONT will still be called, however." (if (memq (process-status proc) '(run open)) (save-excursion (set-buffer (process-buffer proc)) (while ange-ftp-process-busy ;; This is a kludge to let user quit in case ftp gets hung. ;; It matters because this function can be called from the filter. ;; It is bad to allow quitting in a filter, but getting hung ;; is worse. By binding quit-flag to nil, we might avoid ;; most of the probability of getting screwed because the user ;; wants to quit some command. (let ((quit-flag nil) (inhibit-quit nil)) (accept-process-output))) (setq ange-ftp-process-string "" ange-ftp-process-result-line "" ange-ftp-process-busy t ange-ftp-process-result nil ange-ftp-process-multi-skip nil ange-ftp-process-msg msg ange-ftp-process-continue cont ange-ftp-hash-mark-count 0 ange-ftp-last-percent -1 cmd (concat cmd "\n")) (and msg ange-ftp-process-verbose (ange-ftp-message "%s..." msg)) (goto-char (point-max)) (move-marker comint-last-input-start (point)) ;; don't insert the password into the buffer on the USER command. (save-match-data (if (string-match "^user \"[^\"]*\"" cmd) (insert (substring cmd 0 (match-end 0)) " Turtle Power!\n") (insert cmd))) (move-marker comint-last-input-end (point)) (send-string proc cmd) (set-marker (process-mark proc) (point)) (if nowait nil ;; hang around for command to complete (while ange-ftp-process-busy ;; This is a kludge to let user quit in case ftp gets hung. ;; It matters because this function can be called from the filter. (let ((quit-flag nil) (inhibit-quit nil)) (accept-process-output proc))) (if cont nil ;cont has already been called (cons ange-ftp-process-result ange-ftp-process-result-line)))))) (defun ange-ftp-nslookup-host (host) "Attempt to resolve the given HOSTNAME using nslookup if possible." (interactive "sHost: ") (if ange-ftp-nslookup-program (let ((default-directory (if (file-accessible-directory-p default-directory) default-directory exec-directory)) ;; It would be nice to make process-connection-type nil, ;; but that doesn't work: ftp never responds. ;; Can anyone find a fix for that? (proc (let ((process-connection-type t)) (start-process " *nslookup*" " *nslookup*" ange-ftp-nslookup-program host))) (res host)) (process-kill-without-query proc) (save-excursion (set-buffer (process-buffer proc)) (while (memq (process-status proc) '(run open)) (accept-process-output proc)) (goto-char (point-min)) (if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t) (setq res (buffer-substring (match-beginning 1) (match-end 1)))) (kill-buffer (current-buffer))) res) host)) (defun ange-ftp-start-process (host user name) "Spawn a new ftp process ready to connect to machine HOST and give it NAME. If HOST is only ftp-able through a gateway machine then spawn a shell on the gateway machine to do the ftp instead." (let* ((use-gateway (ange-ftp-use-gateway-p host)) (use-smart-ftp (and (not ange-ftp-gateway-host) (ange-ftp-use-smart-gateway-p host))) (ftp-prog (if (or use-gateway use-smart-ftp) ange-ftp-gateway-ftp-program-name ange-ftp-ftp-program-name)) (args (append (list ftp-prog) ange-ftp-ftp-program-args)) ;; Without the following binding, ange-ftp-start-process ;; recurses on file-accessible-directory-p, since it needs to ;; restart its process in order to determine anything about ;; default-directory. (file-name-handler-alist) (default-directory (if (file-accessible-directory-p default-directory) default-directory exec-directory)) proc) ;; It would be nice to make process-connection-type nil, ;; but that doesn't work: ftp never responds. ;; Can anyone find a fix for that? (let ((process-connection-type t)) (if use-gateway (if ange-ftp-gateway-program-interactive (setq proc (ange-ftp-gwp-start host user name args)) (setq proc (apply 'start-process name name (append (list ange-ftp-gateway-program ange-ftp-gateway-host) args)))) (setq proc (apply 'start-process name name args)))) (process-kill-without-query proc) (save-excursion (set-buffer (process-buffer proc)) (internal-ange-ftp-mode)) (set-process-sentinel proc (function ange-ftp-process-sentinel)) (set-process-filter proc (function ange-ftp-process-filter)) (accept-process-output proc) ;wait for ftp startup message proc)) (defun internal-ange-ftp-mode () "Major mode for interacting with the FTP process. \\{comint-mode-map}" (interactive) (comint-mode) (setq major-mode 'internal-ange-ftp-mode) (setq mode-name "Internal Ange-ftp") (let ((proc (get-buffer-process (current-buffer)))) (goto-char (point-max)) (set-marker (process-mark proc) (point)) (make-local-variable 'ange-ftp-process-string) (setq ange-ftp-process-string "") (make-local-variable 'ange-ftp-process-busy) (make-local-variable 'ange-ftp-process-result) (make-local-variable 'ange-ftp-process-msg) (make-local-variable 'ange-ftp-process-multi-skip) (make-local-variable 'ange-ftp-process-result-line) (make-local-variable 'ange-ftp-process-continue) (make-local-variable 'ange-ftp-hash-mark-count) (make-local-variable 'ange-ftp-binary-hash-mark-size) (make-local-variable 'ange-ftp-ascii-hash-mark-size) (make-local-variable 'ange-ftp-hash-mark-unit) (make-local-variable 'ange-ftp-xfer-size) (make-local-variable 'ange-ftp-last-percent) (setq ange-ftp-hash-mark-count 0) (setq ange-ftp-xfer-size 0) (setq ange-ftp-process-result-line "") (setq comint-prompt-regexp "^ftp> ") (make-local-variable 'comint-password-prompt-regexp) ;; This is a regexp that can't match anything. ;; ange-ftp has its own ways of handling passwords. (setq comint-password-prompt-regexp "^a\\'z") (make-local-variable 'paragraph-start) (setq paragraph-start comint-prompt-regexp))) (defun ange-ftp-smart-login (host user pass account proc) "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT. PROC is the FTP-client's process. This routine uses the smart-gateway host specified in ``ange-ftp-gateway-host''." (let ((result (ange-ftp-raw-send-cmd proc (format "open %s %s" (ange-ftp-nslookup-host ange-ftp-gateway-host) ange-ftp-smart-gateway-port) (format "Opening FTP connection to %s via %s" host ange-ftp-gateway-host)))) (or (car result) (ange-ftp-error host user (concat "OPEN request failed: " (cdr result)))) (setq result (ange-ftp-raw-send-cmd proc (format "user \"%s\"@%s %s %s" user (ange-ftp-nslookup-host host) pass account) (format "Logging in as user %s@%s" user host))) (or (car result) (progn (ange-ftp-set-passwd host user nil) ; reset password (ange-ftp-set-account host user nil) ; reset account (ange-ftp-error host user (concat "USER request failed: " (cdr result))))))) (defun ange-ftp-normal-login (host user pass account proc) "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT. PROC is the process to the FTP-client." (let* ((nshost (ange-ftp-nslookup-host host)) (result (ange-ftp-raw-send-cmd proc (format "open %s" nshost) (format "Opening FTP connection to %s" host)))) (or (car result) (ange-ftp-error host user (concat "OPEN request failed: " (cdr result)))) (setq result (ange-ftp-raw-send-cmd proc (if (ange-ftp-use-smart-gateway-p host) (format "user \"%s\"@%s %s %s" user nshost pass account) (format "user \"%s\" %s %s" user pass account)) (format "Logging in as user %s@%s" user host))) (or (car result) (progn (ange-ftp-set-passwd host user nil) ;reset password. (ange-ftp-set-account host user nil) ;reset account. (ange-ftp-error host user (concat "USER request failed: " (cdr result))))))) ;; ange@hplb.hpl.hp.com says this should not be changed. (defvar ange-ftp-hash-mark-msgs "[hH]ash mark [^0-9]*\\([0-9]+\\)" "*Regexp matching the FTP client's output upon doing a HASH command.") (defun ange-ftp-guess-hash-mark-size (proc) (if ange-ftp-send-hash (save-excursion (set-buffer (process-buffer proc)) (let* ((status (ange-ftp-raw-send-cmd proc "hash")) (result (car status)) (line (cdr status))) (save-match-data (if (string-match ange-ftp-hash-mark-msgs line) (let ((size (string-to-int (substring line (match-beginning 1) (match-end 1))))) (setq ange-ftp-ascii-hash-mark-size size ange-ftp-hash-mark-unit (ash size -4)) ;; if a default value for this is set, use that value. (or ange-ftp-binary-hash-mark-size (setq ange-ftp-binary-hash-mark-size size))))))))) (defun ange-ftp-get-process (host user) "Return an FTP subprocess connected to HOST and logged in as USER. Create a new process if needed." (let* ((name (ange-ftp-ftp-process-buffer host user)) (proc (get-process name))) (if (and proc (memq (process-status proc) '(run open))) proc (let ((pass (ange-ftp-quote-string (ange-ftp-get-passwd host user))) (account (ange-ftp-quote-string (ange-ftp-get-account host user)))) ;; grab a suitable process. (setq proc (ange-ftp-start-process host user name)) ;; login to FTP server. (if (and (ange-ftp-use-smart-gateway-p host) ange-ftp-gateway-host) (ange-ftp-smart-login host user pass account proc) (ange-ftp-normal-login host user pass account proc)) ;; Tell client to send back hash-marks as progress. It isn't usually ;; fatal if this command fails. (ange-ftp-guess-hash-mark-size proc) ;; Guess at the host type. (ange-ftp-guess-host-type host user) ;; Run any user-specified hooks. Note that proc, host and user are ;; dynamically bound at this point. (run-hooks 'ange-ftp-process-startup-hook)) proc))) ;; Variables for caching host and host-type (defvar ange-ftp-host-cache nil) (defvar ange-ftp-host-type-cache nil) ;; If ange-ftp-host-type is called with the optional user ;; argument, it will attempt to guess the host type by connecting ;; as user, if necessary. For efficiency, I have tried to give this ;; optional second argument only when necessary. Have I missed any calls ;; to ange-ftp-host-type where it should have been supplied? (defun ange-ftp-host-type (host &optional user) "Return a symbol which represents the type of the HOST given. If the optional argument USER is given, attempts to guess the host-type by logging in as USER." (if (eq host ange-ftp-host-cache) ange-ftp-host-type-cache ;; Trigger an ftp connection, in case we need to guess at the host type. (if (and user (ange-ftp-get-process host user) (eq host ange-ftp-host-cache)) ange-ftp-host-type-cache (setq ange-ftp-host-cache host ange-ftp-host-type-cache (cond ((ange-ftp-dumb-unix-host host) 'dumb-unix) ;; ((and (fboundp 'ange-ftp-vos-host) ;; (ange-ftp-vos-host host)) ;; 'vos) ((and (fboundp 'ange-ftp-vms-host) (ange-ftp-vms-host host)) 'vms) ((and (fboundp 'ange-ftp-mts-host) (ange-ftp-mts-host host)) 'mts) ((and (fboundp 'ange-ftp-cms-host) (ange-ftp-cms-host host)) 'cms) (t 'unix)))))) ;; It would be nice to abstract the functions ange-ftp-TYPE-host and ;; ange-ftp-add-TYPE-host. The trick is to abstract these functions ;; without sacrificing speed. Also, having separate variables ;; ange-ftp-TYPE-regexp is more user friendly then requiring the user to ;; set an alist to indicate that a host is of a given type. Even with ;; automatic host type recognition, setting a regexp is still a good idea ;; (for efficiency) if you log into a particular non-UNIX host frequently. (defvar ange-ftp-fix-name-func-alist nil "Alist saying how to convert file name to the host's syntax. Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine which can change a UNIX file name into a name more suitable for a host of type TYPE.") (defvar ange-ftp-fix-dir-name-func-alist nil "Alist saying how to convert directory name to the host's syntax. Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine which can change UNIX directory name into a directory name more suitable for a host of type TYPE.") ;; *** Perhaps the sense of this variable should be inverted, since there ;; *** is only 1 host type that can take ls-style listing options. (defvar ange-ftp-dumb-host-types '(dumb-unix) "List of host types that can't take UNIX ls-style listing options.") (defun ange-ftp-send-cmd (host user cmd &optional msg cont nowait) "Find an ftp process connected to HOST logged in as USER and send it CMD. MSG is an optional status message to be output before and after issuing the command. See the documentation for ange-ftp-raw-send-cmd for a description of CONT and NOWAIT." ;; Handle conversion to remote file name syntax and remote ls option ;; capability. (let ((cmd0 (car cmd)) (cmd1 (nth 1 cmd)) (ange-ftp-this-user user) (ange-ftp-this-host host) (ange-ftp-this-msg msg) cmd2 cmd3 host-type fix-name-func) (cond ;; pwd case (We don't care what host-type.) ((null cmd1)) ;; cmd == 'dir "remote-name" "local-name" "ls-switches" ((progn (setq cmd2 (nth 2 cmd) host-type (ange-ftp-host-type host user)) ;; This will trigger an FTP login, if one doesn't exist (eq cmd0 'dir)) (setq cmd1 (funcall (or (cdr (assq host-type ange-ftp-fix-dir-name-func-alist)) 'identity) cmd1) cmd3 (nth 3 cmd)) ;; Need to deal with the HP-UX ftp bug. This should also allow ;; us to resolve symlinks to directories on SysV machines. (Sebastian will ;; be happy.) (and (eq host-type 'unix) (string-match "/$" cmd1) (not (string-match "R" cmd3)) (setq cmd1 (concat cmd1 "."))) ;; If the remote ls can take switches, put them in (or (memq host-type ange-ftp-dumb-host-types) (setq cmd0 'ls cmd1 (format "\"%s %s\"" cmd3 cmd1)))) ;; First argument is the remote name ((progn (setq fix-name-func (or (cdr (assq host-type ange-ftp-fix-name-func-alist)) 'identity)) (memq cmd0 '(get delete mkdir rmdir cd))) (setq cmd1 (funcall fix-name-func cmd1))) ;; Second argument is the remote name ((memq cmd0 '(append put chmod)) (setq cmd2 (funcall fix-name-func cmd2))) ;; Both arguments are remote names ((eq cmd0 'rename) (setq cmd1 (funcall fix-name-func cmd1) cmd2 (funcall fix-name-func cmd2)))) ;; Turn the command into one long string (setq cmd0 (symbol-name cmd0)) (setq cmd (concat cmd0 (and cmd1 (concat " " cmd1)) (and cmd2 (concat " " cmd2)))) ;; Actually send the resulting command. (let (afsc-result afsc-line) (ange-ftp-raw-send-cmd (ange-ftp-get-process host user) cmd msg (list (function (lambda (result line host user cmd msg cont nowait) (or cont (setq afsc-result result afsc-line line)) (if result (ange-ftp-call-cont cont result line) (ange-ftp-raw-send-cmd (ange-ftp-get-process host user) cmd msg (list (function (lambda (result line cont) (or cont (setq afsc-result result afsc-line line)) (ange-ftp-call-cont cont result line))) cont) nowait)))) host user cmd msg cont nowait) nowait) (if nowait nil (if cont nil (cons afsc-result afsc-line)))))) ;; It might be nice to message users about the host type identified, ;; but there is so much other messaging going on, it would not be ;; seen. No point in slowing things down just so users can read ;; a host type message. (defconst ange-ftp-cms-name-template (concat "^[-A-Z0-9$*][-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?" "[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?\\.[0-9][0-9][0-9A-Z]$")) (defconst ange-ftp-vms-name-template "^[-A-Z0-9_$]+:\\[[-A-Z0-9_$]+\\(\\.[-A-Z0-9_$]+\\)*\\]$") (defconst ange-ftp-mts-name-template "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$") (defun ange-ftp-guess-host-type (host user) "Guess at the the host type of HOST. Works by doing a pwd and examining the directory syntax." (let ((host-type (ange-ftp-host-type host)) (key (concat host "/" user "/~"))) (if (eq host-type 'unix) ;; Note that ange-ftp-host-type returns unix as the default value. (save-match-data (let* ((result (ange-ftp-get-pwd host user)) (dir (car result)) fix-name-func) (cond ((null dir) (message "Warning! Unable to get home directory") (sit-for 1) (if (string-match "^450 No current working directory defined$" (cdr result)) ;; We'll assume that if pwd bombs with this ;; error message, then it's CMS. (progn (ange-ftp-add-cms-host host) (setq ange-ftp-host-cache host ange-ftp-host-type-cache 'cms)))) ;; try for VMS ((string-match ange-ftp-vms-name-template dir) (ange-ftp-add-vms-host host) ;; The add-host functions clear the host type cache. ;; Therefore, need to set the cache afterwards. (setq ange-ftp-host-cache host ange-ftp-host-type-cache 'vms)) ;; try for MTS ((string-match ange-ftp-mts-name-template dir) (ange-ftp-add-mts-host host) (setq ange-ftp-host-cache host ange-ftp-host-type-cache 'mts)) ;; try for CMS ((string-match ange-ftp-cms-name-template dir) (ange-ftp-add-cms-host host) (setq ange-ftp-host-cache host ange-ftp-host-type-cache 'cms)) ;; assume UN*X (t (setq ange-ftp-host-cache host ange-ftp-host-type-cache 'unix))) ;; Now that we have done a pwd, might as well put it in ;; the expand-dir hashtable. (let ((ange-ftp-this-user user) (ange-ftp-this-host host)) (setq fix-name-func (cdr (assq ange-ftp-host-type-cache ange-ftp-fix-name-func-alist))) (if fix-name-func (setq dir (funcall fix-name-func dir 'reverse)))) (ange-ftp-put-hash-entry key dir ange-ftp-expand-dir-hashtable)))) ;; In the special case of CMS make sure that know the ;; expansion of the home minidisk now, because we will ;; be doing a lot of cd's. (if (and (eq host-type 'cms) (not (ange-ftp-hash-entry-exists-p key ange-ftp-expand-dir-hashtable))) (let ((dir (car (ange-ftp-get-pwd host user)))) (if dir (ange-ftp-put-hash-entry key (concat "/" dir) ange-ftp-expand-dir-hashtable) (message "Warning! Unable to get home directory") (sit-for 1)))))) ;;;; ------------------------------------------------------------ ;;;; Remote file and directory listing support. ;;;; ------------------------------------------------------------ ;; Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands ;; to take switch arguments. (defun ange-ftp-dumb-unix-host (host) (and host ange-ftp-dumb-unix-host-regexp (save-match-data (string-match ange-ftp-dumb-unix-host-regexp host)))) (defun ange-ftp-add-dumb-unix-host (host) "Interactively adds a given HOST to ange-ftp-dumb-unix-host-regexp." (interactive (list (read-string "Host: " (let ((name (or (buffer-file-name) default-directory))) (and name (car (ange-ftp-ftp-name name))))))) (if (not (ange-ftp-dumb-unix-host host)) (setq ange-ftp-dumb-unix-host-regexp (concat "^" (regexp-quote host) "$" (and ange-ftp-dumb-unix-host-regexp "\\|") ange-ftp-dumb-unix-host-regexp) ange-ftp-host-cache nil))) (defvar ange-ftp-parse-list-func-alist nil "Alist saying how to parse directory listings for certain OS types. Association list of \( TYPE \. FUNC \) pairs. The FUNC is a routine which can parse the output from a DIR listing for a host of type TYPE.") ;; With no-error nil, this function returns: ;; an error if file is not an ange-ftp-name ;; (This should never happen.) ;; an error if either the listing is unreadable or there is an ftp error. ;; the listing (a string), if everything works. ;; ;; With no-error t, it returns: ;; an error if not an ange-ftp-name ;; error if listing is unreable (most likely caused by a slow connection) ;; nil if ftp error (this is because although asking to list a nonexistent ;; directory on a remote unix machine usually (except ;; maybe for dumb hosts) returns an ls error, but no ;; ftp error, if the same is done on a VMS machine, ;; an ftp error is returned. Need to trap the error ;; so we can go on and try to list the parent.) ;; the listing, if everything works. ;; If WILDCARD is non-nil, then this implements the guts of insert-directory ;; in the wildcard case. Then we make a relative directory listing ;; of FILE within the directory specified by `default-directory'. (defun ange-ftp-ls (file lsargs parse &optional no-error wildcard) "Return the output of an `DIR' or `ls' command done over ftp. FILE is the full name of the remote file, LSARGS is any args to pass to the `ls' command, and PARSE specifies that the output should be parsed and stored away in the internal cache." ;; If parse is t, we assume that file is a directory. i.e. we only parse ;; full directory listings. (let* ((ange-ftp-this-file (ange-ftp-expand-file-name file)) (parsed (ange-ftp-ftp-name ange-ftp-this-file))) (if parsed (let* ((host (nth 0 parsed)) (user (nth 1 parsed)) (name (ange-ftp-quote-string (nth 2 parsed))) (key (directory-file-name ange-ftp-this-file)) (host-type (ange-ftp-host-type host user)) (dumb (memq host-type ange-ftp-dumb-host-types)) result temp lscmd parse-func) (if (string-equal name "") (setq name (ange-ftp-real-file-name-as-directory (ange-ftp-expand-dir host user "~")))) (if (and ange-ftp-ls-cache-file (string-equal key ange-ftp-ls-cache-file) ;; Don't care about lsargs for dumb hosts. (or dumb (string-equal lsargs ange-ftp-ls-cache-lsargs))) ange-ftp-ls-cache-res (setq temp (ange-ftp-make-tmp-name host)) (if wildcard (progn (ange-ftp-cd host user (file-name-directory name)) (setq lscmd (list 'dir file temp lsargs))) (setq lscmd (list 'dir name temp lsargs))) (unwind-protect (if (car (setq result (ange-ftp-send-cmd host user lscmd (format "Listing %s" (ange-ftp-abbreviate-filename ange-ftp-this-file))))) (save-excursion (set-buffer (get-buffer-create ange-ftp-data-buffer-name)) (erase-buffer) (if (ange-ftp-real-file-readable-p temp) (ange-ftp-real-insert-file-contents temp) (sleep-for ange-ftp-retry-time) ;wait for file to possibly appear (if (ange-ftp-real-file-readable-p temp) ;; Try again. (ange-ftp-real-insert-file-contents temp) (ange-ftp-error host user (format "list data file %s not readable" temp)))) (if parse (ange-ftp-set-files ange-ftp-this-file (if (setq parse-func (cdr (assq host-type ange-ftp-parse-list-func-alist))) (funcall parse-func) (ange-ftp-parse-dired-listing lsargs)))) (setq ange-ftp-ls-cache-file key ange-ftp-ls-cache-lsargs lsargs ; For dumb hosts-types this is ; meaningless but harmless. ange-ftp-ls-cache-res (buffer-string)) ;; (kill-buffer (current-buffer)) ange-ftp-ls-cache-res) (if no-error nil (ange-ftp-error host user (concat "DIR failed: " (cdr result))))) (ange-ftp-del-tmp-name temp)))) (error "Should never happen. Please report. Bug ref. no.: 1")))) ;;;; ------------------------------------------------------------ ;;;; Directory information caching support. ;;;; ------------------------------------------------------------ (defconst ange-ftp-date-regexp (concat " \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct" "\\|Nov\\|Dec\\) +[0-3]?[0-9] ")) (defvar ange-ftp-add-file-entry-alist nil "Alist saying how to add file entries on certain OS types. Association list of pairs \( TYPE \. FUNC \), where FUNC is a function to be used to add a file entry for the OS TYPE. The main reason for this alist is to deal with file versions in VMS.") (defvar ange-ftp-delete-file-entry-alist nil "Alist saying how to delete files on certain OS types. Association list of pairs \( TYPE \. FUNC \), where FUNC is a function to be used to delete a file entry for the OS TYPE. The main reason for this alist is to deal with file versions in VMS.") (defun ange-ftp-add-file-entry (name &optional dir-p) "Add a file entry for file NAME, if its directory info exists." (funcall (or (cdr (assq (ange-ftp-host-type (car (ange-ftp-ftp-name name))) ange-ftp-add-file-entry-alist)) 'ange-ftp-internal-add-file-entry) name dir-p) (setq ange-ftp-ls-cache-file nil)) (defun ange-ftp-delete-file-entry (name &optional dir-p) "Delete the file entry for file NAME, if its directory info exists." (funcall (or (cdr (assq (ange-ftp-host-type (car (ange-ftp-ftp-name name))) ange-ftp-delete-file-entry-alist)) 'ange-ftp-internal-delete-file-entry) name dir-p) (setq ange-ftp-ls-cache-file nil)) (defmacro ange-ftp-parse-filename () ;;Extract the filename from the current line of a dired-like listing. (` (let ((eol (progn (end-of-line) (point)))) (beginning-of-line) (if (re-search-forward ange-ftp-date-regexp eol t) (progn (skip-chars-forward " ") (skip-chars-forward "^ " eol) (skip-chars-forward " " eol) ;; We bomb on filenames starting with a space. (buffer-substring (point) eol)))))) ;; This deals with the F switch. Should also do something about ;; unquoting names obtained with the SysV b switch and the GNU Q ;; switch. See Sebastian's dired-get-filename. (defmacro ange-ftp-ls-parser () ;; Note that switches is dynamically bound. ;; Meant to be called by ange-ftp-parse-dired-listing (` (let ((tbl (ange-ftp-make-hashtable)) (used-F (and (stringp switches) (string-match "F" switches))) file-type symlink directory file) (while (setq file (ange-ftp-parse-filename)) (beginning-of-line) (skip-chars-forward "\t 0-9") (setq file-type (following-char) directory (eq file-type ?d)) (if (eq file-type ?l) (if (string-match " -> " file) (setq symlink (substring file (match-end 0)) file (substring file 0 (match-beginning 0))) ;; Shouldn't happen (setq symlink "")) (setq symlink nil)) ;; Only do a costly regexp search if the F switch was used. (if (and used-F (not (string-equal file "")) (looking-at ".[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)")) (let ((socket (eq file-type ?s)) (executable (and (not symlink) ; x bits don't mean a thing for symlinks (string-match "[xst]" (concat (buffer-substring (match-beginning 1) (match-end 1)) (buffer-substring (match-beginning 2) (match-end 2)) (buffer-substring (match-beginning 3) (match-end 3))))))) ;; Some ls's with the F switch mark symlinks with an @ (ULTRIX) ;; and others don't. (sigh...) Beware, that some Unix's don't ;; seem to believe in the F-switch (if (or (and symlink (string-match "@$" file)) (and directory (string-match "/$" file)) (and executable (string-match "*$" file)) (and socket (string-match "=$" file))) (setq file (substring file 0 -1))))) (ange-ftp-put-hash-entry file (or symlink directory) tbl) (forward-line 1)) (ange-ftp-put-hash-entry "." t tbl) (ange-ftp-put-hash-entry ".." t tbl) tbl))) ;;; The dl stuff for descriptive listings (defvar ange-ftp-dl-dir-regexp nil "Regexp matching directories which are listed in dl format. This regexp should not be anchored with a trailing `$', because it should match subdirectories as well.") (defun ange-ftp-add-dl-dir (dir) "Interactively adds a DIR to ange-ftp-dl-dir-regexp." (interactive (list (read-string "Directory: " (let ((name (or (buffer-file-name) default-directory))) (and name (ange-ftp-ftp-name name) (file-name-directory name)))))) (if (not (and ange-ftp-dl-dir-regexp (string-match ange-ftp-dl-dir-regexp dir))) (setq ange-ftp-dl-dir-regexp (concat "^" (regexp-quote dir) (and ange-ftp-dl-dir-regexp "\\|") ange-ftp-dl-dir-regexp)))) (defmacro ange-ftp-dl-parser () ;; Parse the current buffer, which is assumed to be a descriptive ;; listing, and return a hashtable. (` (let ((tbl (ange-ftp-make-hashtable))) (while (not (eobp)) (ange-ftp-put-hash-entry (buffer-substring (point) (progn (skip-chars-forward "^ /\n") (point))) (eq (following-char) ?/) tbl) (forward-line 1)) (ange-ftp-put-hash-entry "." t tbl) (ange-ftp-put-hash-entry ".." t tbl) tbl))) ;; Parse the current buffer which is assumed to be in a dired-like listing ;; format, and return a hashtable as the result. If the listing is not really ;; a listing, then return nil. (defun ange-ftp-parse-dired-listing (&optional switches) (save-match-data (cond ((looking-at "^total [0-9]+$") (forward-line 1) ;; Some systems put in a blank line here. (if (eolp) (forward-line 1)) (ange-ftp-ls-parser)) ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'") ;; It's an ls error message. nil) ((eobp) ; i.e. (zerop (buffer-size)) ;; This could be one of: ;; (1) An Ultrix ls error message ;; (2) A listing with the A switch of an empty directory ;; on a machine which doesn't give a total line. ;; (3) The twilight zone. ;; We'll assume (1) for now. nil) ((re-search-forward ange-ftp-date-regexp nil t) (beginning-of-line) (ange-ftp-ls-parser)) ((re-search-forward "^[^ \n\t]+ +\\([0-9]+\\|-\\|=\\) " nil t) ;; It's a dl listing (I hope). ;; file is bound by the call to ange-ftp-ls (ange-ftp-add-dl-dir ange-ftp-this-file) (beginning-of-line) (ange-ftp-dl-parser)) (t nil)))) (defun ange-ftp-set-files (directory files) "For a given DIRECTORY, set or change the associated FILES hashtable." (and files (ange-ftp-put-hash-entry (file-name-as-directory directory) files ange-ftp-files-hashtable))) (defun ange-ftp-get-files (directory &optional no-error) "Given a given DIRECTORY, return a hashtable of file entries. This will give an error or return nil, depending on the value of NO-ERROR, if a listing for DIRECTORY cannot be obtained." (setq directory (file-name-as-directory directory)) ;normalize (or (ange-ftp-get-hash-entry directory ange-ftp-files-hashtable) (save-match-data (and (ange-ftp-ls directory ;; This is an efficiency hack. We try to ;; anticipate what sort of listing dired ;; might want, and cache just such a listing. (if (and (boundp 'dired-actual-switches) (stringp dired-actual-switches) ;; We allow the A switch, which lists ;; all files except "." and "..". ;; This is OK because we manually ;; insert these entries ;; in the hash table. (string-match "[aA]" dired-actual-switches) (string-match "l" dired-actual-switches) (not (string-match "R" dired-actual-switches))) dired-actual-switches (if (and (boundp 'dired-listing-switches) (stringp dired-listing-switches) (string-match "[aA]" dired-listing-switches) (string-match "l" dired-listing-switches) (not (string-match "R" dired-listing-switches))) dired-listing-switches "-al")) t no-error) (ange-ftp-get-hash-entry directory ange-ftp-files-hashtable))))) ;; Given NAME, return the file part that can be used for looking up the ;; file's entry in a hashtable. (defmacro ange-ftp-get-file-part (name) (` (let ((file (file-name-nondirectory (, name)))) (if (string-equal file "") "." file)))) ;; Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are ;; allowed to determine if NAME is a sub-directory by listing it directly, ;; rather than listing its parent directory. This is used for efficiency so ;; that a wasted listing is not done: ;; 1. When looking for a .dired file in dired-x.el. ;; 2. The syntax of FILE and DIR make it impossible that FILE could be a valid ;; subdirectory. This is of course an OS dependent judgement. (defmacro ange-ftp-allow-child-lookup (dir file) (` (not (let* ((efile (, file)) ; expand once. (edir (, dir)) (parsed (ange-ftp-ftp-name edir)) (host-type (ange-ftp-host-type (car parsed)))) (or ;;; This variable seems not to exist in Emacs 19 -- rms. ;;; ;; Deal with dired ;;; (and (boundp 'dired-local-variables-file) ;;; (stringp dired-local-variables-file) ;;; (string-equal dired-local-variables-file efile)) ;; No dots in dir names in vms. (and (eq host-type 'vms) (string-match "\\." efile)) ;; No subdirs in mts of cms. (and (memq host-type '(mts cms)) (not (string-equal "/" (nth 2 parsed))))))))) (defun ange-ftp-file-entry-p (name) "Given NAME, return whether there is a file entry for it." (let* ((name (directory-file-name name)) (dir (file-name-directory name)) (ent (ange-ftp-get-hash-entry dir ange-ftp-files-hashtable)) (file (ange-ftp-get-file-part name))) (if ent (ange-ftp-hash-entry-exists-p file ent) (or (and (ange-ftp-allow-child-lookup dir file) (setq ent (ange-ftp-get-files name t)) ;; Try a child lookup. i.e. try to list file as a ;; subdirectory of dir. This is a good idea because ;; we may not have read permission for file's parent. Also, ;; people tend to work down directory trees anyway. We use ;; no-error ;; because if file does not exist as a subdir., ;; then dumb hosts will give an ftp error. Smart unix hosts ;; will simply send back the ls ;; error message. (ange-ftp-get-hash-entry "." ent)) ;; Child lookup failed. Try the parent. If this bombs, ;; we are at wits end -- signal an error. ;; Problem: If this signals an error, the error message ;; may not have a lot to do with what went wrong. (ange-ftp-hash-entry-exists-p file (ange-ftp-get-files dir)))))) (defun ange-ftp-get-file-entry (name) "Given NAME, return the given file entry. The entry will be either t for a directory, nil for a normal file, or a string for a symlink. If the file isn't in the hashtable, this also returns nil." (let* ((name (directory-file-name name)) (dir (file-name-directory name)) (ent (ange-ftp-get-hash-entry dir ange-ftp-files-hashtable)) (file (ange-ftp-get-file-part name))) (if ent (ange-ftp-get-hash-entry file ent) (or (and (ange-ftp-allow-child-lookup dir file) (setq ent (ange-ftp-get-files name t)) (ange-ftp-get-hash-entry "." ent)) ;; i.e. it's a directory by child lookup (ange-ftp-get-hash-entry file (ange-ftp-get-files dir)))))) (defun ange-ftp-internal-delete-file-entry (name &optional dir-p) (if dir-p (progn (setq name (file-name-as-directory name)) (ange-ftp-del-hash-entry name ange-ftp-files-hashtable) (setq name (directory-file-name name)))) ;; Note that file-name-as-directory followed by directory-file-name ;; serves to canonicalize directory file names to their unix form. ;; i.e. in VMS, FOO.DIR -> FOO/ -> FOO (let ((files (ange-ftp-get-hash-entry (file-name-directory name) ange-ftp-files-hashtable))) (if files (ange-ftp-del-hash-entry (ange-ftp-get-file-part name) files)))) (defun ange-ftp-internal-add-file-entry (name &optional dir-p) (and dir-p (setq name (directory-file-name name))) (let ((files (ange-ftp-get-hash-entry (file-name-directory name) ange-ftp-files-hashtable))) (if files (ange-ftp-put-hash-entry (ange-ftp-get-file-part name) dir-p files)))) (defun ange-ftp-wipe-file-entries (host user) "Get rid of entry for HOST, USER pair from file entry information hashtable." (let ((new-tbl (ange-ftp-make-hashtable (length ange-ftp-files-hashtable)))) (ange-ftp-map-hashtable (function (lambda (key val) (let ((parsed (ange-ftp-ftp-name key))) (if parsed (let ((h (nth 0 parsed)) (u (nth 1 parsed))) (or (and (equal host h) (equal user u)) (ange-ftp-put-hash-entry key val new-tbl))))))) ange-ftp-files-hashtable) (setq ange-ftp-files-hashtable new-tbl))) ;;;; ------------------------------------------------------------ ;;;; File transfer mode support. ;;;; ------------------------------------------------------------ (defun ange-ftp-set-binary-mode (host user) "Tell the ftp process for the given HOST & USER to switch to binary mode." (let ((result (ange-ftp-send-cmd host user '(type "binary")))) (if (not (car result)) (ange-ftp-error host user (concat "BINARY failed: " (cdr result))) (save-excursion (set-buffer (process-buffer (ange-ftp-get-process host user))) (and ange-ftp-binary-hash-mark-size (setq ange-ftp-hash-mark-unit (ash ange-ftp-binary-hash-mark-size -4))))))) (defun ange-ftp-set-ascii-mode (host user) "Tell the ftp process for the given HOST & USER to switch to ascii mode." (let ((result (ange-ftp-send-cmd host user '(type "ascii")))) (if (not (car result)) (ange-ftp-error host user (concat "ASCII failed: " (cdr result))) (save-excursion (set-buffer (process-buffer (ange-ftp-get-process host user))) (and ange-ftp-ascii-hash-mark-size (setq ange-ftp-hash-mark-unit (ash ange-ftp-ascii-hash-mark-size -4))))))) (defun ange-ftp-cd (host user dir) (let ((result (ange-ftp-send-cmd host user (list 'cd dir) "Doing CD"))) (or (car result) (ange-ftp-error host user (concat "CD failed: " (cdr result)))))) (defun ange-ftp-get-pwd (host user) "Attempts to get the current working directory for the given HOST/USER pair. Returns \( DIR . LINE \) where DIR is either the directory or NIL if not found, and LINE is the relevant success or fail line from the FTP-client." (let* ((result (ange-ftp-send-cmd host user '(pwd) "Getting PWD")) (line (cdr result)) dir) (if (car result) (save-match-data (and (or (string-match "\"\\([^\"]*\\)\"" line) (string-match " \\([^ ]+\\) " line)) ; stone-age VMS servers! (setq dir (substring line (match-beginning 1) (match-end 1)))))) (cons dir line))) ;;; ------------------------------------------------------------ ;;; expand-file-name and friends...which currently don't work ;;; ------------------------------------------------------------ (defun ange-ftp-expand-dir (host user dir) "Return the result of doing a PWD in the current FTP session. Use the connection to machine HOST logged in as user USER and cd'd to directory DIR." (let* ((host-type (ange-ftp-host-type host user)) ;; It is more efficient to call ange-ftp-host-type ;; before binding res, because ange-ftp-host-type sometimes ;; adds to the info in the expand-dir-hashtable. (fix-name-func (cdr (assq host-type ange-ftp-fix-name-func-alist))) (key (concat host "/" user "/" dir)) (res (ange-ftp-get-hash-entry key ange-ftp-expand-dir-hashtable))) (or res (progn (or (string-equal user "anonymous") (string-equal user "ftp") (not (eq host-type 'unix)) (let* ((ange-ftp-good-msgs (concat ange-ftp-expand-dir-regexp "\\|" ange-ftp-good-msgs)) (result (ange-ftp-send-cmd host user (list 'get dir "/dev/null") (format "expanding %s" dir))) (line (cdr result))) (setq res (if (string-match ange-ftp-expand-dir-regexp line) (substring line (match-beginning 1) (match-end 1)))))) (or res (if (string-equal dir "~") (setq res (car (ange-ftp-get-pwd host user))) (let ((home (ange-ftp-expand-dir host user "~"))) (unwind-protect (and (ange-ftp-cd host user dir) (setq res (car (ange-ftp-get-pwd host user)))) (ange-ftp-cd host user home))))) (if res (let ((ange-ftp-this-user user) (ange-ftp-this-host host)) (if fix-name-func (setq res (funcall fix-name-func res 'reverse))) (ange-ftp-put-hash-entry key res ange-ftp-expand-dir-hashtable))) res)))) (defun ange-ftp-canonize-filename (n) "Take a string and short-circuit //, /. and /.." (if (string-match "[^:]+//" n) ;don't upset Apollo users (setq n (substring n (1- (match-end 0))))) (let ((parsed (ange-ftp-ftp-name n))) (if parsed (let ((host (car parsed)) (user (nth 1 parsed)) (name (nth 2 parsed))) ;; See if remote name is absolute. If so then just expand it and ;; replace the name component of the overall name. (cond ((string-match "^/" name) name) ;; Name starts with ~ or ~user. Resolve that part of the name ;; making it absolute then re-expand it. ((string-match "^~[^/]*" name) (let* ((tilda (substring name (match-beginning 0) (match-end 0))) (rest (substring name (match-end 0))) (dir (ange-ftp-expand-dir host user tilda))) (if dir (setq name (concat dir rest)) (error "User \"%s\" is not known" (substring tilda 1))))) ;; relative name. Tack on homedir and re-expand. (t (let ((dir (ange-ftp-expand-dir host user "~"))) (if dir (setq name (concat (ange-ftp-real-file-name-as-directory dir) name)) (error "Unable to obtain CWD"))))) ;; If name starts with //, preserve that, for apollo system. (if (not (string-match "^//" name)) (progn (setq name (ange-ftp-real-expand-file-name name)) (if (string-match "^//" name) (setq name (substring name 1))))) ;; Now substitute the expanded name back into the overall filename. (ange-ftp-replace-name-component n name)) ;; non-ange-ftp name. Just expand normally. (if (eq (string-to-char n) ?/) (ange-ftp-real-expand-file-name n) (ange-ftp-real-expand-file-name (ange-ftp-real-file-name-nondirectory n) (ange-ftp-real-file-name-directory n)))))) (defun ange-ftp-expand-file-name (name &optional default) "Documented as original." (save-match-data (if (eq (string-to-char name) ?/) (while (cond ((string-match "[^:]+//" name) ;don't upset Apollo users (setq name (substring name (1- (match-end 0))))) ((string-match "/~" name) (setq name (substring name (1- (match-end 0)))))))) (cond ((eq (string-to-char name) ?~) (ange-ftp-real-expand-file-name name)) ((eq (string-to-char name) ?/) (ange-ftp-canonize-filename name)) ((zerop (length name)) (ange-ftp-canonize-filename (or default default-directory))) ((ange-ftp-canonize-filename (concat (file-name-as-directory (or default default-directory)) name)))))) ;;; These are problems--they are currently not enabled. (defvar ange-ftp-file-name-as-directory-alist nil "Association list of \( TYPE \. FUNC \) pairs. FUNC converts a filename to a directory name for the operating system TYPE.") (defun ange-ftp-file-name-as-directory (name) "Documented as original." (let ((parsed (ange-ftp-ftp-name name))) (if parsed (if (string-equal (nth 2 parsed) "") name (funcall (or (cdr (assq (ange-ftp-host-type (car parsed)) ange-ftp-file-name-as-directory-alist)) 'ange-ftp-real-file-name-as-directory) name)) (ange-ftp-real-file-name-as-directory name)))) (defun ange-ftp-file-name-directory (name) "Documented as original." (let ((parsed (ange-ftp-ftp-name name))) (if parsed (let ((filename (nth 2 parsed))) (if (save-match-data (string-match "^~[^/]*$" filename)) name (ange-ftp-replace-name-component name (ange-ftp-real-file-name-directory filename)))) (ange-ftp-real-file-name-directory name)))) (defun ange-ftp-file-name-nondirectory (name) "Documented as original." (let ((parsed (ange-ftp-ftp-name name))) (if parsed (let ((filename (nth 2 parsed))) (if (save-match-data (string-match "^~[^/]*$" filename)) "" (ange-ftp-real-file-name-nondirectory name))) (ange-ftp-real-file-name-nondirectory name)))) (defun ange-ftp-directory-file-name (dir) "Documented as original." (let ((parsed (ange-ftp-ftp-name dir))) (if parsed (ange-ftp-replace-name-component dir (ange-ftp-real-directory-file-name (nth 2 parsed))) (ange-ftp-real-directory-file-name dir)))) ;;; Hooks that handle Emacs primitives. ;; Returns non-nil if should transfer FILE in binary mode. (defun ange-ftp-binary-file (file) (save-match-data (string-match ange-ftp-binary-file-name-regexp file))) (defun ange-ftp-write-region (start end filename &optional append visit) (setq filename (expand-file-name filename)) (let ((parsed (ange-ftp-ftp-name filename))) (if parsed (let* ((host (nth 0 parsed)) (user (nth 1 parsed)) (name (ange-ftp-quote-string (nth 2 parsed))) (temp (ange-ftp-make-tmp-name host)) (binary (or (ange-ftp-binary-file filename) (eq (ange-ftp-host-type host user) 'unix))) (cmd (if append 'append 'put)) (abbr (ange-ftp-abbreviate-filename filename))) (unwind-protect (progn (let ((executing-macro t) (filename (buffer-file-name)) (mod-p (buffer-modified-p))) (unwind-protect (ange-ftp-real-write-region start end temp nil visit) ;; cleanup forms (setq buffer-file-name filename) (set-buffer-modified-p mod-p))) (if binary (ange-ftp-set-binary-mode host user)) ;; tell the process filter what size the transfer will be. (let ((attr (file-attributes temp))) (if attr (ange-ftp-set-xfer-size host user (nth 7 attr)))) ;; put or append the file. (let ((result (ange-ftp-send-cmd host user (list cmd temp name) (format "Writing %s" abbr)))) (or (car result) (signal 'ftp-error (list "Opening output file" (format "FTP Error: \"%s\"" (cdr result)) filename))))) (ange-ftp-del-tmp-name temp) (if binary (ange-ftp-set-ascii-mode host user))) (if (eq visit t) (progn (set-visited-file-modtime '(0 0)) (ange-ftp-set-buffer-mode) (setq buffer-file-name filename) (set-buffer-modified-p nil))) (ange-ftp-message "Wrote %s" abbr) (ange-ftp-add-file-entry filename)) (ange-ftp-real-write-region start end filename append visit)))) (defun ange-ftp-insert-file-contents (filename &optional visit beg end replace) (barf-if-buffer-read-only) (setq filename (expand-file-name filename)) (let ((parsed (ange-ftp-ftp-name filename))) (if parsed (progn (if visit (setq buffer-file-name filename)) (if (or (file-exists-p filename) (progn (setq ange-ftp-ls-cache-file nil) (ange-ftp-del-hash-entry (file-name-directory filename) ange-ftp-files-hashtable) (file-exists-p filename))) (let* ((host (nth 0 parsed)) (user (nth 1 parsed)) (name (ange-ftp-quote-string (nth 2 parsed))) (temp (ange-ftp-make-tmp-name host)) (binary (or (ange-ftp-binary-file filename) (eq (ange-ftp-host-type host user) 'unix))) (abbr (ange-ftp-abbreviate-filename filename)) size) (unwind-protect (progn (if binary (ange-ftp-set-binary-mode host user)) (let ((result (ange-ftp-send-cmd host user (list 'get name temp) (format "Retrieving %s" abbr)))) (or (car result) (signal 'ftp-error (list "Opening input file" (format "FTP Error: \"%s\"" (cdr result)) filename)))) (if (or (ange-ftp-real-file-readable-p temp) (sleep-for ange-ftp-retry-time) ;; Wait for file to hopefully appear. (ange-ftp-real-file-readable-p temp)) (setq size (nth 1 (ange-ftp-real-insert-file-contents temp visit beg end replace))) (signal 'ftp-error (list "Opening input file:" (format "FTP Error: %s not arrived or readable" filename))))) (if binary (ange-ftp-set-ascii-mode host user)) (ange-ftp-del-tmp-name temp)) (if visit (progn (set-visited-file-modtime '(0 0)) (setq buffer-file-name filename))) (list filename size)) (signal 'file-error (list "Opening input file" filename)))) (ange-ftp-real-insert-file-contents filename visit beg end replace)))) (defun ange-ftp-expand-symlink (file dir) (if (file-name-absolute-p file) (ange-ftp-replace-name-component dir file) (expand-file-name file dir))) (defun ange-ftp-file-symlink-p (file) ;; call ange-ftp-expand-file-name rather than the normal ;; expand-file-name to stop loops when using a package that ;; redefines both file-symlink-p and expand-file-name. (setq file (ange-ftp-expand-file-name file)) (if (ange-ftp-ftp-name file) (let ((file-ent (ange-ftp-get-hash-entry (ange-ftp-get-file-part file) (ange-ftp-get-files (file-name-directory file))))) (if (stringp file-ent) (if (file-name-absolute-p file-ent) (ange-ftp-replace-name-component (file-name-directory file) file-ent) file-ent))) (ange-ftp-real-file-symlink-p file))) (defun ange-ftp-file-exists-p (name) (setq name (expand-file-name name)) (if (ange-ftp-ftp-name name) (if (ange-ftp-file-entry-p name) (let ((file-ent (ange-ftp-get-file-entry name))) (if (stringp file-ent) (file-exists-p (ange-ftp-expand-symlink file-ent (file-name-directory (directory-file-name name)))) t))) (ange-ftp-real-file-exists-p name))) (defun ange-ftp-file-directory-p (name) (setq name (expand-file-name name)) (if (ange-ftp-ftp-name name) ;; We do a file-name-as-directory on name here because some ;; machines (VMS) use a .DIR to indicate the filename associated ;; with a directory. This needs to be canonicalized. (let ((file-ent (ange-ftp-get-file-entry (ange-ftp-file-name-as-directory name)))) (if (stringp file-ent) (file-directory-p (ange-ftp-expand-symlink file-ent (file-name-directory (directory-file-name name)))) file-ent)) (ange-ftp-real-file-directory-p name))) (defun ange-ftp-directory-files (directory &optional full match &rest v19-args) (setq directory (expand-file-name directory)) (if (ange-ftp-ftp-name directory) (progn (ange-ftp-barf-if-not-directory directory) (let ((tail (ange-ftp-hash-table-keys (ange-ftp-get-files directory))) files f) (setq directory (file-name-as-directory directory)) (save-match-data (while tail (setq f (car tail) tail (cdr tail)) (if (or (not match) (string-match match f)) (setq files (cons (if full (concat directory f) f) files))))) (nreverse files))) (apply 'ange-ftp-real-directory-files directory full match v19-args))) (defun ange-ftp-file-attributes (file) (setq file (expand-file-name file)) (let ((parsed (ange-ftp-ftp-name file))) (if parsed (let ((part (ange-ftp-get-file-part file)) (files (ange-ftp-get-files (file-name-directory file)))) (if (ange-ftp-hash-entry-exists-p part files) (let ((host (nth 0 parsed)) (user (nth 1 parsed)) (name (nth 2 parsed)) (dirp (ange-ftp-get-hash-entry part files))) (list (if (and (stringp dirp) (file-name-absolute-p dirp)) (ange-ftp-expand-symlink dirp (file-name-directory file)) dirp) ;0 file type -1 ;1 link count -1 ;2 uid -1 ;3 gid '(0 0) ;4 atime '(0 0) ;5 mtime '(0 0) ;6 ctime -1 ;7 size (concat (if (stringp dirp) "l" (if dirp "d" "-")) "?????????") ;8 mode nil ;9 gid weird ;; Hack to give remote files a unique "inode number". ;; It's actually the sum of the characters in its name. (apply '+ (nconc (mapcar 'identity host) (mapcar 'identity user) (mapcar 'identity (directory-file-name name)))) -1 ;11 device number [v19 only] )))) (ange-ftp-real-file-attributes file)))) (defun ange-ftp-file-writable-p (file) (setq file (expand-file-name file)) (if (ange-ftp-ftp-name file) (or (file-exists-p file) ;guess here for speed (file-directory-p (file-name-directory file))) (ange-ftp-real-file-writable-p file))) (defun ange-ftp-file-readable-p (file) (setq file (expand-file-name file)) (if (ange-ftp-ftp-name file) (file-exists-p file) (ange-ftp-real-file-readable-p file))) (defun ange-ftp-file-executable-p (file) (setq file (expand-file-name file)) (if (ange-ftp-ftp-name file) (file-exists-p file) (ange-ftp-real-file-executable-p file))) (defun ange-ftp-delete-file (file) (interactive "fDelete file: ") (setq file (expand-file-name file)) (let ((parsed (ange-ftp-ftp-name file))) (if parsed (let* ((host (nth 0 parsed)) (user (nth 1 parsed)) (name (ange-ftp-quote-string (nth 2 parsed))) (abbr (ange-ftp-abbreviate-filename file)) (result (ange-ftp-send-cmd host user (list 'delete name) (format "Deleting %s" abbr)))) (or (car result) (signal 'ftp-error (list "Removing old name" (format "FTP Error: \"%s\"" (cdr result)) file))) (ange-ftp-delete-file-entry file)) (ange-ftp-real-delete-file file)))) (defun ange-ftp-verify-visited-file-modtime (buf) (let ((name (buffer-file-name buf))) (if (and (stringp name) (ange-ftp-ftp-name name)) t (ange-ftp-real-verify-visited-file-modtime buf)))) ;;;; ------------------------------------------------------------ ;;;; File copying support... totally re-written 6/24/92. ;;;; ------------------------------------------------------------ (defun ange-ftp-barf-or-query-if-file-exists (absname querystring interactive) (if (file-exists-p absname) (if (not interactive) (signal 'file-already-exists (list absname)) (if (not (yes-or-no-p (format "File %s already exists; %s anyway? " absname querystring))) (signal 'file-already-exists (list absname)))))) ;; async local copy commented out for now since I don't seem to get ;; the process sentinel called for some processes. ;; ;; (defun ange-ftp-copy-file-locally (filename newname ok-if-already-exists ;; keep-date cont) ;; "Kludge to copy a local file and call a continuation when the copy ;; finishes." ;; ;; check to see if we can overwrite ;; (if (or (not ok-if-already-exists) ;; (numberp ok-if-already-exists)) ;; (ange-ftp-barf-or-query-if-file-exists newname "copy to it" ;; (numberp ok-if-already-exists))) ;; (let ((proc (start-process " *copy*" ;; (generate-new-buffer "*copy*") ;; "cp" ;; filename ;; newname)) ;; res) ;; (set-process-sentinel proc (function ange-ftp-copy-file-locally-sentinel)) ;; (process-kill-without-query proc) ;; (save-excursion ;; (set-buffer (process-buffer proc)) ;; (make-variable-buffer-local 'copy-cont) ;; (setq copy-cont cont)))) ;; ;; (defun ange-ftp-copy-file-locally-sentinel (proc status) ;; (save-excursion ;; (set-buffer (process-buffer proc)) ;; (let ((cont copy-cont) ;; (result (buffer-string))) ;; (unwind-protect ;; (if (and (string-equal status "finished\n") ;; (zerop (length result))) ;; (ange-ftp-call-cont cont t nil) ;; (ange-ftp-call-cont cont ;; nil ;; (if (zerop (length result)) ;; (substring status 0 -1) ;; (substring result 0 -1)))) ;; (kill-buffer (current-buffer)))))) ;; this is the extended version of ange-ftp-copy-file-internal that works ;; asynchronously if asked nicely. (defun ange-ftp-copy-file-internal (filename newname ok-if-already-exists keep-date &optional msg cont nowait) (setq filename (expand-file-name filename) newname (expand-file-name newname)) ;; canonicalize newname if a directory. (if (file-directory-p newname) (setq newname (expand-file-name (file-name-nondirectory filename) newname))) (let ((f-parsed (ange-ftp-ftp-name filename)) (t-parsed (ange-ftp-ftp-name newname))) ;; local file to local file copy? (if (and (not f-parsed) (not t-parsed)) (progn (ange-ftp-real-copy-file filename newname ok-if-already-exists keep-date) (if cont (ange-ftp-call-cont cont t "Copied locally"))) ;; one or both files are remote. (let* ((f-host (and f-parsed (nth 0 f-parsed))) (f-user (and f-parsed (nth 1 f-parsed))) (f-name (and f-parsed (ange-ftp-quote-string (nth 2 f-parsed)))) (f-abbr (ange-ftp-abbreviate-filename filename)) (t-host (and t-parsed (nth 0 t-parsed))) (t-user (and t-parsed (nth 1 t-parsed))) (t-name (and t-parsed (ange-ftp-quote-string (nth 2 t-parsed)))) (t-abbr (ange-ftp-abbreviate-filename newname filename)) (binary (or (ange-ftp-binary-file filename) (ange-ftp-binary-file newname) (and (eq (ange-ftp-host-type f-host f-user) 'unix) (eq (ange-ftp-host-type t-host t-user) 'unix)))) temp1 temp2) ;; check to see if we can overwrite (if (or (not ok-if-already-exists) (numberp ok-if-already-exists)) (ange-ftp-barf-or-query-if-file-exists newname "copy to it" (numberp ok-if-already-exists))) ;; do the copying. (if f-parsed ;; filename was remote. (progn (if (or (ange-ftp-use-gateway-p f-host) t-parsed) ;; have to use intermediate file if we are getting via ;; gateway machine or we are doing a remote to remote copy. (setq temp1 (ange-ftp-make-tmp-name f-host))) (if binary (ange-ftp-set-binary-mode f-host f-user)) (ange-ftp-send-cmd f-host f-user (list 'get f-name (or temp1 newname)) (or msg (if (and temp1 t-parsed) (format "Getting %s" f-abbr) (format "Copying %s to %s" f-abbr t-abbr))) (list (function ange-ftp-cf1) filename newname binary msg f-parsed f-host f-user f-name f-abbr t-parsed t-host t-user t-name t-abbr temp1 temp2 cont nowait) nowait)) ;; filename wasn't remote. newname must be remote. call the ;; function which does the remainder of the copying work. (ange-ftp-cf1 t nil filename newname binary msg f-parsed f-host f-user f-name f-abbr t-parsed t-host t-user t-name t-abbr nil nil cont nowait)))))) ;; next part of copying routine. (defun ange-ftp-cf1 (result line filename newname binary msg f-parsed f-host f-user f-name f-abbr t-parsed t-host t-user t-name t-abbr temp1 temp2 cont nowait) (if line ;; filename must have been remote, and we must have just done a GET. (unwind-protect (or result ;; GET failed for some reason. Clean up and get out. (progn (and temp1 (ange-ftp-del-tmp-name temp1)) (or cont (signal 'ftp-error (list "Opening input file" (format "FTP Error: \"%s\"" line) filename))))) ;; cleanup (if binary (ange-ftp-set-ascii-mode f-host f-user)))) (if result ;; We now have to copy either temp1 or filename to newname. (if t-parsed ;; newname was remote. (progn (if (ange-ftp-use-gateway-p t-host) (setq temp2 (ange-ftp-make-tmp-name t-host))) ;; make sure data is moved into the right place for the ;; outgoing transfer. gateway temporary files complicate ;; things nicely. (if temp1 (if temp2 (if (string-equal temp1 temp2) (setq temp1 nil) (ange-ftp-real-copy-file temp1 temp2 t)) (setq temp2 temp1 temp1 nil)) (if temp2 (ange-ftp-real-copy-file filename temp2 t))) (if binary (ange-ftp-set-binary-mode t-host t-user)) ;; tell the process filter what size the file is. (let ((attr (file-attributes (or temp2 filename)))) (if attr (ange-ftp-set-xfer-size t-host t-user (nth 7 attr)))) (ange-ftp-send-cmd t-host t-user (list 'put (or temp2 filename) t-name) (or msg (if (and temp2 f-parsed) (format "Putting %s" newname) (format "Copying %s to %s" f-abbr t-abbr))) (list (function ange-ftp-cf2) newname t-host t-user binary temp1 temp2 cont) nowait)) ;; newname wasn't remote. (ange-ftp-cf2 t nil newname t-host t-user binary temp1 temp2 cont)) ;; first copy failed, tell caller (ange-ftp-call-cont cont result line))) ;; last part of copying routine. (defun ange-ftp-cf2 (result line newname t-host t-user binary temp1 temp2 cont) (unwind-protect (if line ;; result from doing a local to remote copy. (unwind-protect (progn (or result (or cont (signal 'ftp-error (list "Opening output file" (format "FTP Error: \"%s\"" line) newname)))) (ange-ftp-add-file-entry newname)) ;; cleanup. (if binary (ange-ftp-set-ascii-mode t-host t-user))) ;; newname was local. (if temp1 (ange-ftp-real-copy-file temp1 newname t))) ;; clean up (and temp1 (ange-ftp-del-tmp-name temp1)) (and temp2 (ange-ftp-del-tmp-name temp2)) (ange-ftp-call-cont cont result line))) (defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists keep-date) (interactive "fCopy file: \nFCopy %s to file: \np") (ange-ftp-copy-file-internal filename newname ok-if-already-exists keep-date nil nil (interactive-p))) ;;;; ------------------------------------------------------------ ;;;; File renaming support. ;;;; ------------------------------------------------------------ (defun ange-ftp-rename-remote-to-remote (filename newname f-parsed t-parsed) "Rename remote file FILE to remote file NEWNAME." (let ((f-host (nth 0 f-parsed)) (f-user (nth 1 f-parsed)) (t-host (nth 0 t-parsed)) (t-user (nth 1 t-parsed))) (if (and (string-equal f-host t-host) (string-equal f-user t-user)) (let* ((f-name (ange-ftp-quote-string (nth 2 f-parsed))) (t-name (ange-ftp-quote-string (nth 2 t-parsed))) (cmd (list 'rename f-name t-name)) (fabbr (ange-ftp-abbreviate-filename filename)) (nabbr (ange-ftp-abbreviate-filename newname filename)) (result (ange-ftp-send-cmd f-host f-user cmd (format "Renaming %s to %s" fabbr nabbr)))) (or (car result) (signal 'ftp-error (list "Renaming" (format "FTP Error: \"%s\"" (cdr result)) filename newname))) (ange-ftp-add-file-entry newname) (ange-ftp-delete-file-entry filename)) (ange-ftp-copy-file-internal filename newname t nil) (delete-file filename)))) (defun ange-ftp-rename-local-to-remote (filename newname) "Rename local FILENAME to remote file NEWNAME." (let* ((fabbr (ange-ftp-abbreviate-filename filename)) (nabbr (ange-ftp-abbreviate-filename newname filename)) (msg (format "Renaming %s to %s" fabbr nabbr))) (ange-ftp-copy-file-internal filename newname t nil msg) (let (ange-ftp-process-verbose) (delete-file filename)))) (defun ange-ftp-rename-remote-to-local (filename newname) "Rename remote file FILENAME to local file NEWNAME." (let* ((fabbr (ange-ftp-abbreviate-filename filename)) (nabbr (ange-ftp-abbreviate-filename newname filename)) (msg (format "Renaming %s to %s" fabbr nabbr))) (ange-ftp-copy-file-internal filename newname t nil msg) (let (ange-ftp-process-verbose) (delete-file filename)))) (defun ange-ftp-rename-file (filename newname &optional ok-if-already-exists) (interactive "fRename file: \nFRename %s to file: \np") (setq filename (expand-file-name filename)) (setq newname (expand-file-name newname)) (let* ((f-parsed (ange-ftp-ftp-name filename)) (t-parsed (ange-ftp-ftp-name newname))) (if (and (or f-parsed t-parsed) (or (not ok-if-already-exists) (numberp ok-if-already-exists))) (ange-ftp-barf-or-query-if-file-exists newname "rename to it" (numberp ok-if-already-exists))) (if f-parsed (if t-parsed (ange-ftp-rename-remote-to-remote filename newname f-parsed t-parsed) (ange-ftp-rename-remote-to-local filename newname)) (if t-parsed (ange-ftp-rename-local-to-remote filename newname) (ange-ftp-real-rename-file filename newname ok-if-already-exists))))) ;;;; ------------------------------------------------------------ ;;;; File name completion support. ;;;; ------------------------------------------------------------ ;; If the file entry SYM is a symlink, returns whether its file exists. ;; Note that `ange-ftp-this-dir' is used as a free variable. (defun ange-ftp-file-entry-active-p (sym) (let ((val (get sym 'val))) (or (not (stringp val)) (file-exists-p (ange-ftp-expand-symlink val ange-ftp-this-dir))))) ;; If the file entry is not a directory (nor a symlink pointing to a directory) ;; returns whether the file (or file pointed to by the symlink) is ignored ;; by completion-ignored-extensions. ;; Note that `ange-ftp-this-dir' and `ange-ftp-completion-ignored-pattern' ;; are used as free variables. (defun ange-ftp-file-entry-not-ignored-p (sym) (let ((val (get sym 'val)) (symname (symbol-name sym))) (if (stringp val) (let ((file (ange-ftp-expand-symlink val ange-ftp-this-dir))) (or (file-directory-p file) (and (file-exists-p file) (not (string-match ange-ftp-completion-ignored-pattern symname))))) (or val ; is a directory name (not (string-match ange-ftp-completion-ignored-pattern symname)))))) (defun ange-ftp-file-name-all-completions (file dir) (let ((ange-ftp-this-dir (expand-file-name dir))) (if (ange-ftp-ftp-name ange-ftp-this-dir) (progn (ange-ftp-barf-if-not-directory ange-ftp-this-dir) (setq ange-ftp-this-dir (ange-ftp-real-file-name-as-directory ange-ftp-this-dir)) (let* ((tbl (ange-ftp-get-files ange-ftp-this-dir)) (completions (all-completions file tbl (function ange-ftp-file-entry-active-p)))) ;; see whether each matching file is a directory or not... (mapcar (function (lambda (file) (let ((ent (ange-ftp-get-hash-entry file tbl))) (if (and ent (or (not (stringp ent)) (file-directory-p (ange-ftp-expand-symlink ent ange-ftp-this-dir)))) (concat file "/") file)))) completions))) (if (string-equal "/" ange-ftp-this-dir) (nconc (all-completions file (ange-ftp-generate-root-prefixes)) (ange-ftp-real-file-name-all-completions file ange-ftp-this-dir)) (ange-ftp-real-file-name-all-completions file ange-ftp-this-dir))))) (defun ange-ftp-file-name-completion (file dir) (let ((ange-ftp-this-dir (expand-file-name dir))) (if (ange-ftp-ftp-name ange-ftp-this-dir) (progn (ange-ftp-barf-if-not-directory ange-ftp-this-dir) (if (equal file "") "" (setq ange-ftp-this-dir (ange-ftp-real-file-name-as-directory ange-ftp-this-dir)) ;real? (let* ((tbl (ange-ftp-get-files ange-ftp-this-dir)) (ange-ftp-completion-ignored-pattern (mapconcat (function (lambda (s) (if (stringp s) (concat (regexp-quote s) "$") "/"))) ; / never in filename completion-ignored-extensions "\\|"))) (save-match-data (or (ange-ftp-file-name-completion-1 file tbl ange-ftp-this-dir (function ange-ftp-file-entry-not-ignored-p)) (ange-ftp-file-name-completion-1 file tbl ange-ftp-this-dir (function ange-ftp-file-entry-active-p))))))) (if (string-equal "/" ange-ftp-this-dir) (try-completion file (nconc (ange-ftp-generate-root-prefixes) (mapcar 'list (ange-ftp-real-file-name-all-completions file "/")))) (ange-ftp-real-file-name-completion file ange-ftp-this-dir))))) (defun ange-ftp-file-name-completion-1 (file tbl dir predicate) (let ((bestmatch (try-completion file tbl predicate))) (if bestmatch (if (eq bestmatch t) (if (file-directory-p (expand-file-name file dir)) (concat file "/") t) (if (and (eq (try-completion bestmatch tbl predicate) t) (file-directory-p (expand-file-name bestmatch dir))) (concat bestmatch "/") bestmatch))))) ;; Put these lines uncommmented in your .emacs if you want C-r to refresh ;; ange-ftp's cache whilst doing filename completion. ;; ;;(define-key minibuffer-local-completion-map "\C-r" 'ange-ftp-re-read-dir) ;;(define-key minibuffer-local-must-match-map "\C-r" 'ange-ftp-re-read-dir) ;; Force a re-read of the directory DIR. If DIR is omitted then it defaults ;; to the directory part of the contents of the current buffer. (defun ange-ftp-re-read-dir (&optional dir) (interactive) (if dir (setq dir (expand-file-name dir)) (setq dir (file-name-directory (expand-file-name (buffer-string))))) (if (ange-ftp-ftp-name dir) (progn (setq ange-ftp-ls-cache-file nil) (ange-ftp-del-hash-entry dir ange-ftp-files-hashtable) (ange-ftp-get-files dir t)))) (defun ange-ftp-make-directory (dir &optional parents) (interactive (list (expand-file-name (read-file-name "Make directory: ")))) (if parents (let ((parent (file-name-directory (directory-file-name dir)))) (or (file-exists-p parent) (ange-ftp-make-directory parent parents)))) (if (file-exists-p dir) (error "Cannot make directory %s: file already exists" dir) (let ((parsed (ange-ftp-ftp-name dir))) (if parsed (let* ((host (nth 0 parsed)) (user (nth 1 parsed)) ;; Some ftp's on unix machines (at least on Suns) ;; insist that mkdir take a filename, and not a ;; directory-name name as an arg. Argh!! This is a bug. ;; Non-unix machines will probably always insist ;; that mkdir takes a directory-name as an arg ;; (as the ftp man page says it should). (name (ange-ftp-quote-string (if (eq (ange-ftp-host-type host) 'unix) (ange-ftp-real-directory-file-name (nth 2 parsed)) (ange-ftp-real-file-name-as-directory (nth 2 parsed))))) (abbr (ange-ftp-abbreviate-filename dir)) (result (ange-ftp-send-cmd host user (list 'mkdir name) (format "Making directory %s" abbr)))) (or (car result) (ange-ftp-error host user (format "Could not make directory %s: %s" dir (cdr result)))) (ange-ftp-add-file-entry dir t)) (ange-ftp-real-make-directory dir))))) (defun ange-ftp-delete-directory (dir) (if (file-directory-p dir) (let ((parsed (ange-ftp-ftp-name dir))) (if parsed (let* ((host (nth 0 parsed)) (user (nth 1 parsed)) ;; Some ftp's on unix machines (at least on Suns) ;; insist that rmdir take a filename, and not a ;; directory-name name as an arg. Argh!! This is a bug. ;; Non-unix machines will probably always insist ;; that rmdir takes a directory-name as an arg ;; (as the ftp man page says it should). (name (ange-ftp-quote-string (if (eq (ange-ftp-host-type host) 'unix) (ange-ftp-real-directory-file-name (nth 2 parsed)) (ange-ftp-real-file-name-as-directory (nth 2 parsed))))) (abbr (ange-ftp-abbreviate-filename dir)) (result (ange-ftp-send-cmd host user (list 'rmdir name) (format "Removing directory %s" abbr)))) (or (car result) (ange-ftp-error host user (format "Could not remove directory %s: %s" dir (cdr result)))) (ange-ftp-delete-file-entry dir t)) (ange-ftp-real-delete-directory dir))) (error "Not a directory: %s" dir))) ;; Make a local copy of FILE and return its name. (defun ange-ftp-file-local-copy (file) (let* ((fn1 (expand-file-name file)) (pa1 (ange-ftp-ftp-name fn1))) (if pa1 (let ((tmp1 (ange-ftp-make-tmp-name (car pa1)))) (ange-ftp-copy-file-internal fn1 tmp1 t nil (format "Getting %s" fn1)) tmp1)))) (defun ange-ftp-load (file &optional noerror nomessage nosuffix) (if (ange-ftp-ftp-name file) (let ((tryfiles (if nosuffix (list file) (list (concat file ".elc") (concat file ".el") file))) copy) (while (and tryfiles (not copy)) (condition-case error (setq copy (ange-ftp-file-local-copy (car tryfiles))) (ftp-error nil))) (if copy (unwind-protect (funcall 'load copy noerror nomessage nosuffix) (delete-file copy)) (or noerror (signal 'file-error (list "Cannot open load file" file))))) (ange-ftp-real-load file noerror nomessage nosuffix))) ;; Calculate default-unhandled-directory for a given ange-ftp buffer. (defun ange-ftp-unhandled-file-name-directory (filename) (file-name-directory ange-ftp-tmp-name-template)) ;; Need the following functions for making filenames of compressed ;; files, because some OS's (unlike UNIX) do not allow a filename to ;; have two extensions. (defvar ange-ftp-make-compressed-filename-alist nil "Alist of host-type-specific functions to process file names for compression. Each element has the form (TYPE . FUNC). FUNC should take one argument, a file name, and return a list of the form (COMPRESSING NEWNAME). COMPRESSING should be t if the specified file should be compressed, and nil if it should be uncompressed (that is, if it is a compressed file). NEWNAME should be the name to give the new compressed or uncompressed file.") (defun ange-ftp-dired-compress-file (name) (let ((parsed (ange-ftp-ftp-name name)) conversion-func) (if (and parsed (setq conversion-func (cdr (assq (ange-ftp-host-type (car parsed)) ange-ftp-make-compressed-filename-alist)))) (let* ((decision (save-match-data (funcall conversion-func name))) (compressing (car decision)) (newfile (nth 1 decision))) (if compressing (ange-ftp-compress name newfile) (ange-ftp-uncompress name newfile))) (let (file-name-handler-alist) (dired-compress-file name))))) ;; Copy FILE to this machine, compress it, and copy out to NFILE. (defun ange-ftp-compress (file nfile) (let* ((parsed (ange-ftp-ftp-name file)) (tmp1 (ange-ftp-make-tmp-name (car parsed))) (tmp2 (ange-ftp-make-tmp-name (car parsed))) (abbr (ange-ftp-abbreviate-filename file)) (nabbr (ange-ftp-abbreviate-filename nfile)) (msg1 (format "Getting %s" abbr)) (msg2 (format "Putting %s" nabbr))) (unwind-protect (progn (ange-ftp-copy-file-internal file tmp1 t nil msg1) (and ange-ftp-process-verbose (ange-ftp-message "Compressing %s..." abbr)) (call-process-region (point) (point) shell-file-name nil t nil "-c" (format "compress -f -c < %s > %s" tmp1 tmp2)) (and ange-ftp-process-verbose (ange-ftp-message "Compressing %s...done" abbr)) (if (zerop (buffer-size)) (progn (let (ange-ftp-process-verbose) (delete-file file)) (ange-ftp-copy-file-internal tmp2 nfile t nil msg2)))) (ange-ftp-del-tmp-name tmp1) (ange-ftp-del-tmp-name tmp2)))) ;; Copy FILE to this machine, uncompress it, and copy out to NFILE. (defun ange-ftp-uncompress (file nfile) (let* ((parsed (ange-ftp-ftp-name file)) (tmp1 (ange-ftp-make-tmp-name (car parsed))) (tmp2 (ange-ftp-make-tmp-name (car parsed))) (abbr (ange-ftp-abbreviate-filename file)) (nabbr (ange-ftp-abbreviate-filename nfile)) (msg1 (format "Getting %s" abbr)) (msg2 (format "Putting %s" nabbr)) ;; ;; Cheap hack because of problems with binary file transfers from ;; ;; VMS hosts. ;; (gbinary (not (eq 'vms (ange-ftp-host-type (car parsed))))) ) (unwind-protect (progn (ange-ftp-copy-file-internal file tmp1 t nil msg1) (and ange-ftp-process-verbose (ange-ftp-message "Uncompressing %s..." abbr)) (call-process-region (point) (point) shell-file-name nil t nil "-c" (format "uncompress -c < %s > %s" tmp1 tmp2)) (and ange-ftp-process-verbose (ange-ftp-message "Uncompressing %s...done" abbr)) (if (zerop (buffer-size)) (progn (let (ange-ftp-process-verbose) (delete-file file)) (ange-ftp-copy-file-internal tmp2 nfile t nil msg2)))) (ange-ftp-del-tmp-name tmp1) (ange-ftp-del-tmp-name tmp2)))) (defun ange-ftp-find-backup-file-name (fn) ;; Either return the ordinary backup name, etc., ;; or return nil meaning don't make a backup. (if ange-ftp-make-backup-files (ange-ftp-real-find-backup-file-name fn))) ;;; Define the handler for special file names ;;; that causes ange-ftp to be invoked. ;;;###autoload (defun ange-ftp-hook-function (operation &rest args) (let ((fn (get operation 'ange-ftp))) (if fn (apply fn args) (ange-ftp-run-real-handler operation args)))) ;;; This regexp takes care of real ange-ftp file names (with a slash ;;; and colon). ;;; Don't allow the host name to end in a period--some systems use /.: ;;;###autoload (or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist) (setq file-name-handler-alist (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function) file-name-handler-alist))) ;;; This regexp recognizes and absolute filenames with only one component, ;;; for the sake of hostname completion. ;;;###autoload (or (assoc "^/[^/:]*\\'" file-name-handler-alist) (setq file-name-handler-alist (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function) file-name-handler-alist))) ;;; The above two forms are sufficient to cause this file to be loaded ;;; if the user ever uses a file name with a colon in it. ;;; This sets the mode (or (memq 'ange-ftp-set-buffer-mode find-file-hooks) (setq find-file-hooks (cons 'ange-ftp-set-buffer-mode find-file-hooks))) ;;; Now say where to find the handlers for particular operations. (put 'file-name-directory 'ange-ftp 'ange-ftp-file-name-directory) (put 'file-name-nondirectory 'ange-ftp 'ange-ftp-file-name-nondirectory) (put 'file-name-as-directory 'ange-ftp 'ange-ftp-file-name-as-directory) (put 'directory-file-name 'ange-ftp 'ange-ftp-directory-file-name) (put 'expand-file-name 'ange-ftp 'ange-ftp-expand-file-name) (put 'make-directory 'ange-ftp 'ange-ftp-make-directory) (put 'delete-directory 'ange-ftp 'ange-ftp-delete-directory) (put 'insert-file-contents 'ange-ftp 'ange-ftp-insert-file-contents) (put 'directory-files 'ange-ftp 'ange-ftp-directory-files) (put 'file-directory-p 'ange-ftp 'ange-ftp-file-directory-p) (put 'file-writable-p 'ange-ftp 'ange-ftp-file-writable-p) (put 'file-readable-p 'ange-ftp 'ange-ftp-file-readable-p) (put 'file-executable-p 'ange-ftp 'ange-ftp-file-executable-p) (put 'file-symlink-p 'ange-ftp 'ange-ftp-file-symlink-p) (put 'delete-file 'ange-ftp 'ange-ftp-delete-file) (put 'read-file-name-internal 'ange-ftp 'ange-ftp-read-file-name-internal) (put 'verify-visited-file-modtime 'ange-ftp 'ange-ftp-verify-visited-file-modtime) (put 'file-exists-p 'ange-ftp 'ange-ftp-file-exists-p) (put 'write-region 'ange-ftp 'ange-ftp-write-region) (put 'backup-buffer 'ange-ftp 'ange-ftp-backup-buffer) (put 'copy-file 'ange-ftp 'ange-ftp-copy-file) (put 'rename-file 'ange-ftp 'ange-ftp-rename-file) (put 'file-attributes 'ange-ftp 'ange-ftp-file-attributes) (put 'file-name-all-completions 'ange-ftp 'ange-ftp-file-name-all-completions) (put 'file-name-completion 'ange-ftp 'ange-ftp-file-name-completion) (put 'insert-directory 'ange-ftp 'ange-ftp-insert-directory) (put 'file-local-copy 'ange-ftp 'ange-ftp-file-local-copy) (put 'unhandled-file-name-directory 'ange-ftp 'ange-ftp-unhandled-file-name-directory) (put 'file-name-sans-versions 'ange-ftp 'ange-ftp-file-name-sans-versions) (put 'dired-uncache 'ange-ftp 'ange-ftp-dired-uncache) (put 'dired-compress-file 'ange-ftp 'ange-ftp-dired-compress-file) (put 'load 'ange-ftp 'ange-ftp-load) (put 'find-backup-file-name 'ange-ftp 'ange-ftp-find-backup-file-name) ;; Turn off truename processing to save time. ;; Treat each name as its own truename. (put 'file-truename 'ange-ftp 'identity) ;; Turn off RCS/SCCS processing to save time. ;; This returns nil for any file name as argument. (put 'vc-registered 'ange-ftp 'null) ;;; Define ways of getting at unmodified Emacs primitives, ;;; turning off our handler. (defun ange-ftp-run-real-handler (operation args) (let ((inhibit-file-name-handlers (cons 'ange-ftp-hook-function (cons 'ange-ftp-completion-hook-function (and (eq inhibit-file-name-operation operation) inhibit-file-name-handlers)))) (inhibit-file-name-operation operation)) (apply operation args))) (defun ange-ftp-real-file-name-directory (&rest args) (ange-ftp-run-real-handler 'file-name-directory args)) (defun ange-ftp-real-file-name-nondirectory (&rest args) (ange-ftp-run-real-handler 'file-name-nondirectory args)) (defun ange-ftp-real-file-name-as-directory (&rest args) (ange-ftp-run-real-handler 'file-name-as-directory args)) (defun ange-ftp-real-directory-file-name (&rest args) (ange-ftp-run-real-handler 'directory-file-name args)) (defun ange-ftp-real-expand-file-name (&rest args) (ange-ftp-run-real-handler 'expand-file-name args)) (defun ange-ftp-real-make-directory (&rest args) (ange-ftp-run-real-handler 'make-directory args)) (defun ange-ftp-real-delete-directory (&rest args) (ange-ftp-run-real-handler 'delete-directory args)) (defun ange-ftp-real-insert-file-contents (&rest args) (ange-ftp-run-real-handler 'insert-file-contents args)) (defun ange-ftp-real-directory-files (&rest args) (ange-ftp-run-real-handler 'directory-files args)) (defun ange-ftp-real-file-directory-p (&rest args) (ange-ftp-run-real-handler 'file-directory-p args)) (defun ange-ftp-real-file-writable-p (&rest args) (ange-ftp-run-real-handler 'file-writable-p args)) (defun ange-ftp-real-file-readable-p (&rest args) (ange-ftp-run-real-handler 'file-readable-p args)) (defun ange-ftp-real-file-executable-p (&rest args) (ange-ftp-run-real-handler 'file-executable-p args)) (defun ange-ftp-real-file-symlink-p (&rest args) (ange-ftp-run-real-handler 'file-symlink-p args)) (defun ange-ftp-real-delete-file (&rest args) (ange-ftp-run-real-handler 'delete-file args)) (defun ange-ftp-real-read-file-name-internal (&rest args) (ange-ftp-run-real-handler 'read-file-name-internal args)) (defun ange-ftp-real-verify-visited-file-modtime (&rest args) (ange-ftp-run-real-handler 'verify-visited-file-modtime args)) (defun ange-ftp-real-file-exists-p (&rest args) (ange-ftp-run-real-handler 'file-exists-p args)) (defun ange-ftp-real-write-region (&rest args) (ange-ftp-run-real-handler 'write-region args)) (defun ange-ftp-real-backup-buffer (&rest args) (ange-ftp-run-real-handler 'backup-buffer args)) (defun ange-ftp-real-copy-file (&rest args) (ange-ftp-run-real-handler 'copy-file args)) (defun ange-ftp-real-rename-file (&rest args) (ange-ftp-run-real-handler 'rename-file args)) (defun ange-ftp-real-file-attributes (&rest args) (ange-ftp-run-real-handler 'file-attributes args)) (defun ange-ftp-real-file-name-all-completions (&rest args) (ange-ftp-run-real-handler 'file-name-all-completions args)) (defun ange-ftp-real-file-name-completion (&rest args) (ange-ftp-run-real-handler 'file-name-completion args)) (defun ange-ftp-real-insert-directory (&rest args) (ange-ftp-run-real-handler 'insert-directory args)) (defun ange-ftp-real-file-name-sans-versions (&rest args) (ange-ftp-run-real-handler 'file-name-sans-versions args)) (defun ange-ftp-real-shell-command (&rest args) (ange-ftp-run-real-handler 'shell-command args)) (defun ange-ftp-real-load (&rest args) (ange-ftp-run-real-handler 'load args)) (defun ange-ftp-real-find-backup-file-name (&rest args) (ange-ftp-run-real-handler 'find-backup-file-name args)) ;; Here we support using dired on remote hosts. ;; I have turned off the support for using dired on foreign directory formats. ;; That involves too many unclean hooks. ;; It would be cleaner to support such operations by ;; converting the foreign directory format to something dired can understand; ;; something close to ls -l output. ;; The logical place to do this is in the functions ange-ftp-parse-...-listing. ;; Some of the old dired hooks would still be needed even if this is done. ;; I have preserved (and modernized) those hooks. ;; So the format conversion should be all that is needed. (defun ange-ftp-insert-directory (file switches &optional wildcard full) (let ((short (ange-ftp-abbreviate-filename file)) (parsed (ange-ftp-ftp-name (expand-file-name file)))) (if parsed (insert (if wildcard (let ((default-directory (file-name-directory file))) (ange-ftp-ls (file-name-nondirectory file) switches nil nil t)) (ange-ftp-ls file switches full))) (ange-ftp-real-insert-directory file switches wildcard full)))) (defun ange-ftp-dired-uncache (dir) (if (ange-ftp-ftp-name (expand-file-name dir)) (setq ange-ftp-ls-cache-file nil))) (defvar ange-ftp-sans-version-alist nil "Alist of mapping host type into function to remove file version numbers.") (defun ange-ftp-file-name-sans-versions (file keep-backup-version) (setq file (ange-ftp-abbreviate-filename file)) (let ((parsed (ange-ftp-ftp-name file)) host-type func) (if parsed (setq host-type (ange-ftp-host-type (car parsed)) func (cdr (assq (ange-ftp-host-type (car parsed)) ange-ftp-sans-version-alist)))) (if func (funcall func file keep-backup-version) (ange-ftp-real-file-name-sans-versions file keep-backup-version)))) ;;; This doesn't work yet; a new hook needs to be created. ;;; Maybe the new hook should be in call-process. (defun ange-ftp-shell-command (command) (let* ((parsed (ange-ftp-ftp-name default-directory)) (host (nth 0 parsed)) (user (nth 1 parsed)) (name (nth 2 parsed))) (if (not parsed) (ange-ftp-real-shell-command command) (if (> (length name) 0) ; else it's $HOME (setq command (concat "cd " name "; " command))) (setq command (format "%s %s \"%s\"" ; remsh -l USER does not work well ; on a hp-ux machine I tried remote-shell-program host command)) (ange-ftp-message "Remote command '%s' ..." command) ;; Cannot call ange-ftp-real-dired-run-shell-command here as it ;; would prepend "cd default-directory" --- which bombs because ;; default-directory is in ange-ftp syntax for remote file names. (ange-ftp-real-shell-command command)))) ;;; Thisis not hooked up yet. (defun ange-ftp-dired-call-process (program discard &rest arguments) ;; PROGRAM is always one of those below in the cond in dired.el. ;; The ARGUMENTS are (nearly) always files. (if (ange-ftp-ftp-name default-directory) ;; Can't use ange-ftp-dired-host-type here because the current ;; buffer is *dired-check-process output* (condition-case oops (cond ((equal "chmod" program) (ange-ftp-call-chmod arguments)) ;; ((equal "chgrp" program)) ;; ((equal dired-chown-program program)) (t (error "Unknown remote command: %s" program))) (ftp-error (insert (format "%s: %s, %s\n" (nth 1 oops) (nth 2 oops) (nth 3 oops)))) (error (insert (format "%s\n" (nth 1 oops))))) (apply 'call-process program nil (not discard) nil arguments))) ;;; This currently does not work; it is never called. (defun ange-ftp-call-chmod (args) (if (< (length args) 2) (error "ange-ftp-call-chmod: missing mode and/or filename: %s" args)) (let ((mode (car args))) (mapcar (function (lambda (file) (setq file (expand-file-name file)) (let ((parsed (ange-ftp-ftp-name file))) (if parsed (let* ((host (nth 0 parsed)) (user (nth 1 parsed)) (name (ange-ftp-quote-string (nth 2 parsed))) (abbr (ange-ftp-abbreviate-filename file)) (result (ange-ftp-send-cmd host user (list 'chmod mode name) (format "doing chmod %s" abbr)))) (or (car result) (ange-ftp-error host user (format "chmod: %s: \"%s\"" file (cdr result))))))))) (cdr args))) (setq ange-ftp-ls-cache-file nil)) ;stop confusing dired ;;; This is turned off because it has nothing properly to do ;;; with dired. It could be reasonable to adapt this to ;;; replace ange-ftp-copy-file. ;;;;; ------------------------------------------------------------ ;;;;; Noddy support for async copy-file within dired. ;;;;; ------------------------------------------------------------ ;;(defun ange-ftp-dired-copy-file (from to ok-flag &optional cont nowait) ;; "Documented as original." ;; (dired-handle-overwrite to) ;; (ange-ftp-copy-file-internal from to ok-flag dired-copy-preserve-time nil ;; cont nowait)) ;;(defun ange-ftp-dired-do-create-files (op-symbol file-creator operation arg ;; &optional marker-char op1 ;; how-to) ;; "Documented as original." ;; ;; we need to let ange-ftp-dired-create-files know that we indirectly ;; ;; called it rather than somebody else. ;; (let ((ange-ftp-dired-do-create-files t)) ; tell who caller is ;; (ange-ftp-real-dired-do-create-files op-symbol file-creator operation ;; arg marker-char op1 how-to))) ;;(defun ange-ftp-dired-create-files (file-creator operation fn-list name-constructor ;; &optional marker-char) ;; "Documented as original." ;; (if (and (boundp 'ange-ftp-dired-do-create-files) ;; ;; called from ange-ftp-dired-do-create-files? ;; ange-ftp-dired-do-create-files ;; ;; any files worth copying? ;; fn-list ;; ;; we only support async copy-file at the mo. ;; (eq file-creator 'dired-copy-file) ;; ;; it is only worth calling the alternative function for remote files ;; ;; as we tie ourself in recursive knots otherwise. ;; (or (ange-ftp-ftp-name (car fn-list)) ;; ;; we can only call the name constructor for dired-do-create-files ;; ;; since the one for regexps starts prompting here, there and ;; ;; everywhere. ;; (ange-ftp-ftp-name (funcall name-constructor (car fn-list))))) ;; ;; use the process-filter driven routine rather than the iterative one. ;; (ange-ftp-dcf-1 file-creator ;; operation ;; fn-list ;; name-constructor ;; (and (boundp 'target) target) ;dynamically bound ;; marker-char ;; (current-buffer) ;; nil ;overwrite-query ;; nil ;overwrite-backup-query ;; nil ;failures ;; nil ;skipped ;; 0 ;success-count ;; (length fn-list) ;total ;; ) ;; ;; normal case... use the interactive routine... much cheaper. ;; (ange-ftp-real-dired-create-files file-creator operation fn-list ;; name-constructor marker-char))) ;;(defun ange-ftp-dcf-1 (file-creator operation fn-list name-constructor ;; target marker-char buffer overwrite-query ;; overwrite-backup-query failures skipped ;; success-count total) ;; (let ((old-buf (current-buffer))) ;; (unwind-protect ;; (progn ;; (set-buffer buffer) ;; (if (null fn-list) ;; (ange-ftp-dcf-3 failures operation total skipped ;; success-count buffer) ;; (let* ((from (car fn-list)) ;; (to (funcall name-constructor from))) ;; (if (equal to from) ;; (progn ;; (setq to nil) ;; (dired-log "Cannot %s to same file: %s\n" ;; (downcase operation) from))) ;; (if (not to) ;; (ange-ftp-dcf-1 file-creator ;; operation ;; (cdr fn-list) ;; name-constructor ;; target ;; marker-char ;; buffer ;; overwrite-query ;; overwrite-backup-query ;; failures ;; (cons (dired-make-relative from) skipped) ;; success-count ;; total) ;; (let* ((overwrite (file-exists-p to)) ;; (overwrite-confirmed ; for dired-handle-overwrite ;; (and overwrite ;; (let ((help-form '(format "\ ;;Type SPC or `y' to overwrite file `%s', ;;DEL or `n' to skip to next, ;;ESC or `q' to not overwrite any of the remaining files, ;;`!' to overwrite all remaining files with no more questions." to))) ;; (dired-query 'overwrite-query ;; "Overwrite `%s'?" to)))) ;; ;; must determine if FROM is marked before file-creator ;; ;; gets a chance to delete it (in case of a move). ;; (actual-marker-char ;; (cond ((integerp marker-char) marker-char) ;; (marker-char (dired-file-marker from)) ; slow ;; (t nil)))) ;; (condition-case err ;; (funcall file-creator from to overwrite-confirmed ;; (list (function ange-ftp-dcf-2) ;; nil ;err ;; file-creator operation fn-list ;; name-constructor ;; target ;; marker-char actual-marker-char ;; buffer to from ;; overwrite ;; overwrite-confirmed ;; overwrite-query ;; overwrite-backup-query ;; failures skipped success-count ;; total) ;; t) ;; (file-error ; FILE-CREATOR aborted ;; (ange-ftp-dcf-2 nil ;result ;; nil ;line ;; err ;; file-creator operation fn-list ;; name-constructor ;; target ;; marker-char actual-marker-char ;; buffer to from ;; overwrite ;; overwrite-confirmed ;; overwrite-query ;; overwrite-backup-query ;; failures skipped success-count ;; total)))))))) ;; (set-buffer old-buf)))) ;;(defun ange-ftp-dcf-2 (result line err ;; file-creator operation fn-list ;; name-constructor ;; target ;; marker-char actual-marker-char ;; buffer to from ;; overwrite ;; overwrite-confirmed ;; overwrite-query ;; overwrite-backup-query ;; failures skipped success-count ;; total) ;; (let ((old-buf (current-buffer))) ;; (unwind-protect ;; (progn ;; (set-buffer buffer) ;; (if (or err (not result)) ;; (progn ;; (setq failures (cons (dired-make-relative from) failures)) ;; (dired-log "%s `%s' to `%s' failed:\n%s\n" ;; operation from to (or err line))) ;; (if overwrite ;; ;; If we get here, file-creator hasn't been aborted ;; ;; and the old entry (if any) has to be deleted ;; ;; before adding the new entry. ;; (dired-remove-file to)) ;; (setq success-count (1+ success-count)) ;; (message "%s: %d of %d" operation success-count total) ;; (dired-add-file to actual-marker-char)) ;; (ange-ftp-dcf-1 file-creator operation (cdr fn-list) ;; name-constructor ;; target ;; marker-char ;; buffer ;; overwrite-query ;; overwrite-backup-query ;; failures skipped success-count ;; total)) ;; (set-buffer old-buf)))) ;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count ;; buffer) ;; (let ((old-buf (current-buffer))) ;; (unwind-protect ;; (progn ;; (set-buffer buffer) ;; (cond ;; (failures ;; (dired-log-summary ;; (message "%s failed for %d of %d file%s %s" ;; operation (length failures) total ;; (dired-plural-s total) failures))) ;; (skipped ;; (dired-log-summary ;; (message "%s: %d of %d file%s skipped %s" ;; operation (length skipped) total ;; (dired-plural-s total) skipped))) ;; (t ;; (message "%s: %s file%s." ;; operation success-count (dired-plural-s success-count)))) ;; (dired-move-to-filename)) ;; (set-buffer old-buf)))) ;;;; ----------------------------------------------- ;;;; Unix Descriptive Listing (dl) Support ;;;; ----------------------------------------------- ;; This is turned off because nothing uses it currently ;; and because I don't understand what it's supposed to be for. --rms. ;;(defconst ange-ftp-dired-dl-re-dir ;; "^. [^ /]+/[ \n]" ;; "Regular expression to use to search for dl directories.") ;;(or (assq 'unix:dl ange-ftp-dired-re-dir-alist) ;; (setq ange-ftp-dired-re-dir-alist ;; (cons (cons 'unix:dl ange-ftp-dired-dl-re-dir) ;; ange-ftp-dired-re-dir-alist))) ;;(defun ange-ftp-dired-dl-move-to-filename (&optional raise-error eol) ;; "In dired, move to the first character of the filename on this line." ;; ;; This is the Unix dl version. ;; (or eol (setq eol (progn (end-of-line) (point)))) ;; (let (case-fold-search) ;; (beginning-of-line) ;; (if (looking-at ". [^ ]+ +\\([0-9]+\\|-\\|=\\) ") ;; (goto-char (+ (point) 2)) ;; (if raise-error ;; (error "No file on this line") ;; nil)))) ;;(or (assq 'unix:dl ange-ftp-dired-move-to-filename-alist) ;; (setq ange-ftp-dired-move-to-filename-alist ;; (cons '(unix:dl . ange-ftp-dired-dl-move-to-filename) ;; ange-ftp-dired-move-to-filename-alist))) ;;(defun ange-ftp-dired-dl-move-to-end-of-filename (&optional no-error eol) ;; ;; Assumes point is at beginning of filename. ;; ;; So, it should be called only after (dired-move-to-filename t). ;; ;; On failure, signals an error or returns nil. ;; ;; This is the Unix dl version. ;; (let ((opoint (point)) ;; case-fold-search hidden) ;; (or eol (setq eol (save-excursion (end-of-line) (point)))) ;; (setq hidden (and selective-display ;; (save-excursion ;; (search-forward "\r" eol t)))) ;; (if hidden ;; (if no-error ;; nil ;; (error ;; (substitute-command-keys ;; "File line is hidden, type \\[dired-hide-subdir] to unhide"))) ;; (skip-chars-forward "^ /" eol) ;; (if (eq opoint (point)) ;; (if no-error ;; nil ;; (error "No file on this line")) ;; (point))))) ;;(or (assq 'unix:dl ange-ftp-dired-move-to-end-of-filename-alist) ;; (setq ange-ftp-dired-move-to-end-of-filename-alist ;; (cons '(unix:dl . ange-ftp-dired-dl-move-to-end-of-filename) ;; ange-ftp-dired-move-to-end-of-filename-alist))) ;;;; ------------------------------------------------------------ ;;;; VOS support (VOS support is probably broken, ;;;; but I don't know anything about VOS.) ;;;; ------------------------------------------------------------ ; ;(defun ange-ftp-fix-name-for-vos (name &optional reverse) ; (setq name (copy-sequence name)) ; (let ((from (if reverse ?\> ?\/)) ; (to (if reverse ?\/ ?\>)) ; (i (1- (length name)))) ; (while (>= i 0) ; (if (= (aref name i) from) ; (aset name i to)) ; (setq i (1- i))) ; name)) ; ;(or (assq 'vos ange-ftp-fix-name-func-alist) ; (setq ange-ftp-fix-name-func-alist ; (cons '(vos . ange-ftp-fix-name-for-vos) ; ange-ftp-fix-name-func-alist))) ; ;(or (memq 'vos ange-ftp-dumb-host-types) ; (setq ange-ftp-dumb-host-types ; (cons 'vos ange-ftp-dumb-host-types))) ; ;(defun ange-ftp-fix-dir-name-for-vos (dir-name) ; (ange-ftp-fix-name-for-vos ; (concat dir-name ; (if (eq ?/ (aref dir-name (1- (length dir-name)))) ; "" "/") ; "*"))) ; ;(or (assq 'vos ange-ftp-fix-dir-name-func-alist) ; (setq ange-ftp-fix-dir-name-func-alist ; (cons '(vos . ange-ftp-fix-dir-name-for-vos) ; ange-ftp-fix-dir-name-func-alist))) ; ;(defvar ange-ftp-vos-host-regexp nil ; "If a host matches this regexp then it is assumed to be running VOS.") ; ;(defun ange-ftp-vos-host (host) ; (and ange-ftp-vos-host-regexp ; (save-match-data ; (string-match ange-ftp-vos-host-regexp host)))) ; ;(defun ange-ftp-parse-vos-listing () ; "Parse the current buffer which is assumed to be in VOS list -all ;format, and return a hashtable as the result." ; (let ((tbl (ange-ftp-make-hashtable)) ; (type-list ; '(("^Files: [0-9]+ +Blocks: [0-9]+\n+" nil 40) ; ("^Dirs: [0-9]+\n+" t 30))) ; type-regexp type-is-dir type-col file) ; (goto-char (point-min)) ; (save-match-data ; (while type-list ; (setq type-regexp (car (car type-list)) ; type-is-dir (nth 1 (car type-list)) ; type-col (nth 2 (car type-list)) ; type-list (cdr type-list)) ; (if (re-search-forward type-regexp nil t) ; (while (eq (char-after (point)) ? ) ; (move-to-column type-col) ; (setq file (buffer-substring (point) ; (progn ; (end-of-line 1) ; (point)))) ; (ange-ftp-put-hash-entry file type-is-dir tbl) ; (forward-line 1)))) ; (ange-ftp-put-hash-entry "." 'vosdir tbl) ; (ange-ftp-put-hash-entry ".." 'vosdir tbl)) ; tbl)) ; ;(or (assq 'vos ange-ftp-parse-list-func-alist) ; (setq ange-ftp-parse-list-func-alist ; (cons '(vos . ange-ftp-parse-vos-listing) ; ange-ftp-parse-list-func-alist))) ;;;; ------------------------------------------------------------ ;;;; VMS support. ;;;; ------------------------------------------------------------ ;; Convert NAME from UNIX-ish to VMS. If REVERSE given then convert from VMS ;; to UNIX-ish. (defun ange-ftp-fix-name-for-vms (name &optional reverse) (save-match-data (if reverse (if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name) (let (drive dir file) (if (match-beginning 1) (setq drive (substring name (match-beginning 1) (match-end 1)))) (if (match-beginning 2) (setq dir (substring name (match-beginning 2) (match-end 2)))) (if (match-beginning 3) (setq file (substring name (match-beginning 3) (match-end 3)))) (and dir (setq dir (apply (function concat) (mapcar (function (lambda (char) (if (= char ?.) (vector ?/) (vector char)))) (substring dir 1 -1))))) (concat (and drive (concat "/" drive "/")) dir (and dir "/") file)) (error "name %s didn't match" name)) (let (drive dir file tmp) (if (string-match "^/[^:]+:/" name) (setq drive (substring name 1 (1- (match-end 0))) name (substring name (match-end 0)))) (setq tmp (file-name-directory name)) (if tmp (setq dir (apply (function concat) (mapcar (function (lambda (char) (if (= char ?/) (vector ?.) (vector char)))) (substring tmp 0 -1))))) (setq file (file-name-nondirectory name)) (concat drive (and dir (concat "[" (if drive nil ".") dir "]")) file))))) ;; (ange-ftp-fix-name-for-vms "/PUB$:/ANONYMOUS/SDSCPUB/NEXT/Readme.txt;1") ;; (ange-ftp-fix-name-for-vms "/PUB$:[ANONYMOUS.SDSCPUB.NEXT]Readme.txt;1" t) (or (assq 'vms ange-ftp-fix-name-func-alist) (setq ange-ftp-fix-name-func-alist (cons '(vms . ange-ftp-fix-name-for-vms) ange-ftp-fix-name-func-alist))) (or (memq 'vms ange-ftp-dumb-host-types) (setq ange-ftp-dumb-host-types (cons 'vms ange-ftp-dumb-host-types))) ;; It is important that this function barf for directories for which we know ;; that we cannot possibly get a directory listing, such as "/" and "/DEV:/". ;; This is because it saves an unnecessary FTP error, or possibly the listing ;; might succeed, but give erroneous info. This last case is particularly ;; likely for OS's (like MTS) for which we need to use a wildcard in order ;; to list a directory. ;; Convert name from UNIX-ish to VMS ready for a DIRectory listing. (defun ange-ftp-fix-dir-name-for-vms (dir-name) ;; Should there be entries for .. -> [-] and . -> [] below. Don't ;; think so, because expand-filename should have already short-circuited ;; them. (cond ((string-equal dir-name "/") (error "Cannot get listing for fictitious \"/\" directory.")) ((string-match "^/[-A-Z0-9_$]+:/$" dir-name) (error "Cannot get listing for device.")) ((ange-ftp-fix-name-for-vms dir-name)))) (or (assq 'vms ange-ftp-fix-dir-name-func-alist) (setq ange-ftp-fix-dir-name-func-alist (cons '(vms . ange-ftp-fix-dir-name-for-vms) ange-ftp-fix-dir-name-func-alist))) (defvar ange-ftp-vms-host-regexp nil) ;; Return non-nil if HOST is running VMS. (defun ange-ftp-vms-host (host) (and ange-ftp-vms-host-regexp (save-match-data (string-match ange-ftp-vms-host-regexp host)))) ;; Because some VMS ftp servers convert filenames to lower case ;; we allow a-z in the filename regexp. I'm not too happy about this. (defconst ange-ftp-vms-filename-regexp (concat "\\(\\([_A-Za-z0-9$]?\\|[_A-Za-z0-9$][-_A-Za-z0-9$]*\\)\\." "[-_A-Za-z0-9$]*;+[0-9]*\\)") "Regular expression to match for a valid VMS file name in Dired buffer. Stupid freaking bug! Position of _ and $ shouldn't matter but they do. Having [A-Z0-9$_] bombs on filename _$$CHANGE_LOG$.TXT$ and $CHANGE_LOG$.TX Other orders of $ and _ seem to all work just fine.") ;; These parsing functions are as general as possible because the syntax ;; of ftp listings from VMS hosts is a bit erratic. What saves us is that ;; the VMS filename syntax is so rigid. If they bomb on a listing in the ;; standard VMS Multinet format, then this is a bug. If they bomb on a listing ;; from vms.weird.net, then too bad. ;; Extract the next filename from a VMS dired-like listing. (defun ange-ftp-parse-vms-filename () (if (re-search-forward ange-ftp-vms-filename-regexp nil t) (buffer-substring (match-beginning 0) (match-end 0)))) ;; Parse the current buffer which is assumed to be in MultiNet FTP dir ;; format, and return a hashtable as the result. (defun ange-ftp-parse-vms-listing () (let ((tbl (ange-ftp-make-hashtable)) file) (goto-char (point-min)) (save-match-data (while (setq file (ange-ftp-parse-vms-filename)) (if (string-match "\\.\\(DIR\\|dir\\);[0-9]+" file) ;; deal with directories (ange-ftp-put-hash-entry (substring file 0 (match-beginning 0)) t tbl) (ange-ftp-put-hash-entry file nil tbl) (if (string-match ";[0-9]+$" file) ; deal with extension ;; sans extension (ange-ftp-put-hash-entry (substring file 0 (match-beginning 0)) nil tbl))) (forward-line 1)) ;; Would like to look for a "Total" line, or a "Directory" line to ;; make sure that the listing isn't complete garbage before putting ;; in "." and "..", but we can't even count on all VAX's giving us ;; either of these. (ange-ftp-put-hash-entry "." t tbl) (ange-ftp-put-hash-entry ".." t tbl)) tbl)) (or (assq 'vms ange-ftp-parse-list-func-alist) (setq ange-ftp-parse-list-func-alist (cons '(vms . ange-ftp-parse-vms-listing) ange-ftp-parse-list-func-alist))) ;; This version only deletes file entries which have ;; explicit version numbers, because that is all VMS allows. ;; Can the following two functions be speeded up using file ;; completion functions? (defun ange-ftp-vms-delete-file-entry (name &optional dir-p) (if dir-p (ange-ftp-internal-delete-file-entry name t) (save-match-data (let ((file (ange-ftp-get-file-part name))) (if (string-match ";[0-9]+$" file) ;; In VMS you can't delete a file without an explicit ;; version number, or wild-card (e.g. FOO;*) ;; For now, we give up on wildcards. (let ((files (ange-ftp-get-hash-entry (file-name-directory name) ange-ftp-files-hashtable))) (if files (let* ((root (substring file 0 (match-beginning 0))) (regexp (concat "^" (regexp-quote root) ";[0-9]+$")) versions) (ange-ftp-del-hash-entry file files) ;; Now we need to check if there are any ;; versions left. If not, then delete the ;; root entry. (mapatoms '(lambda (sym) (and (string-match regexp (get sym 'key)) (setq versions t))) files) (or versions (ange-ftp-del-hash-entry root files)))))))))) (or (assq 'vms ange-ftp-delete-file-entry-alist) (setq ange-ftp-delete-file-entry-alist (cons '(vms . ange-ftp-vms-delete-file-entry) ange-ftp-delete-file-entry-alist))) (defun ange-ftp-vms-add-file-entry (name &optional dir-p) (if dir-p (ange-ftp-internal-add-file-entry name t) (let ((files (ange-ftp-get-hash-entry (file-name-directory name) ange-ftp-files-hashtable))) (if files (let ((file (ange-ftp-get-file-part name))) (save-match-data (if (string-match ";[0-9]+$" file) (ange-ftp-put-hash-entry (substring file 0 (match-beginning 0)) nil files) ;; Need to figure out what version of the file ;; is being added. (let ((regexp (concat "^" (regexp-quote file) ";\\([0-9]+\\)$")) (version 0)) (mapatoms '(lambda (sym) (let ((name (get sym 'key))) (and (string-match regexp name) (setq version (max version (string-to-int (substring name (match-beginning 1) (match-end 1)))))))) files) (setq version (1+ version)) (ange-ftp-put-hash-entry (concat file ";" (int-to-string version)) nil files)))) (ange-ftp-put-hash-entry file nil files)))))) (or (assq 'vms ange-ftp-add-file-entry-alist) (setq ange-ftp-add-file-entry-alist (cons '(vms . ange-ftp-vms-add-file-entry) ange-ftp-add-file-entry-alist))) (defun ange-ftp-add-vms-host (host) "Mark HOST as the name of a machine running VMS." (interactive (list (read-string "Host: " (let ((name (or (buffer-file-name) default-directory))) (and name (car (ange-ftp-ftp-name name))))))) (if (not (ange-ftp-vms-host host)) (setq ange-ftp-vms-host-regexp (concat "^" (regexp-quote host) "$" (and ange-ftp-vms-host-regexp "\\|") ange-ftp-vms-host-regexp) ange-ftp-host-cache nil))) (defun ange-ftp-vms-file-name-as-directory (name) (save-match-data (if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?$" name) (setq name (substring name 0 (match-beginning 0)))) (ange-ftp-real-file-name-as-directory name))) (or (assq 'vms ange-ftp-file-name-as-directory-alist) (setq ange-ftp-file-name-as-directory-alist (cons '(vms . ange-ftp-vms-file-name-as-directory) ange-ftp-file-name-as-directory-alist))) ;;; Tree dired support: ;; For this code I have borrowed liberally from Sebastian Kremer's ;; dired-vms.el ;;;; These regexps must be anchored to beginning of line. ;;;; Beware that the ftpd may put the device in front of the filename. ;;(defconst ange-ftp-dired-vms-re-exe "^. [^ \t.]+\\.\\(EXE\\|exe\\)[; ]" ;; "Regular expression to use to search for VMS executable files.") ;;(defconst ange-ftp-dired-vms-re-dir "^. [^ \t.]+\\.\\(DIR\\|dir\\)[; ]" ;; "Regular expression to use to search for VMS directories.") ;;(or (assq 'vms ange-ftp-dired-re-exe-alist) ;; (setq ange-ftp-dired-re-exe-alist ;; (cons (cons 'vms ange-ftp-dired-vms-re-exe) ;; ange-ftp-dired-re-exe-alist))) ;;(or (assq 'vms ange-ftp-dired-re-dir-alist) ;; (setq ange-ftp-dired-re-dir-alist ;; (cons (cons 'vms ange-ftp-dired-vms-re-dir) ;; ange-ftp-dired-re-dir-alist))) ;;(defun ange-ftp-dired-vms-insert-headerline (dir) ;; ;; VMS inserts a headerline. I would prefer the headerline ;; ;; to be in ange-ftp format. This version tries to ;; ;; be careful, because we can't count on a headerline ;; ;; over ftp, and we wouldn't want to delete anything ;; ;; important. ;; (save-excursion ;; (if (looking-at "^ wildcard ") ;; (forward-line 1)) ;; (if (looking-at "^[ \n\t]*[^\n]+\\][ \t]*\n") ;; (delete-region (point) (match-end 0)))) ;; (ange-ftp-real-dired-insert-headerline dir)) ;;(or (assq 'vms ange-ftp-dired-insert-headerline-alist) ;; (setq ange-ftp-dired-insert-headerline-alist ;; (cons '(vms . ange-ftp-dired-vms-insert-headerline) ;; ange-ftp-dired-insert-headerline-alist))) ;;(defun ange-ftp-dired-vms-move-to-filename (&optional raise-error eol) ;; "In dired, move to first char of filename on this line. ;;Returns position (point) or nil if no filename on this line." ;; ;; This is the VMS version. ;; (let (case-fold-search) ;; (or eol (setq eol (progn (end-of-line) (point)))) ;; (beginning-of-line) ;; (if (re-search-forward ange-ftp-vms-filename-regexp eol t) ;; (goto-char (match-beginning 1)) ;; (if raise-error ;; (error "No file on this line") ;; nil)))) ;;(or (assq 'vms ange-ftp-dired-move-to-filename-alist) ;; (setq ange-ftp-dired-move-to-filename-alist ;; (cons '(vms . ange-ftp-dired-vms-move-to-filename) ;; ange-ftp-dired-move-to-filename-alist))) ;;(defun ange-ftp-dired-vms-move-to-end-of-filename (&optional no-error eol) ;; ;; Assumes point is at beginning of filename. ;; ;; So, it should be called only after (dired-move-to-filename t). ;; ;; case-fold-search must be nil, at least for VMS. ;; ;; On failure, signals an error or returns nil. ;; ;; This is the VMS version. ;; (let (opoint hidden case-fold-search) ;; (setq opoint (point)) ;; (or eol (setq eol (save-excursion (end-of-line) (point)))) ;; (setq hidden (and selective-display ;; (save-excursion (search-forward "\r" eol t)))) ;; (if hidden ;; nil ;; (re-search-forward ange-ftp-vms-filename-regexp eol t)) ;; (or no-error ;; (not (eq opoint (point))) ;; (error ;; (if hidden ;; (substitute-command-keys ;; "File line is hidden, type \\[dired-hide-subdir] to unhide") ;; "No file on this line"))) ;; (if (eq opoint (point)) ;; nil ;; (point)))) ;;(or (assq 'vms ange-ftp-dired-move-to-end-of-filename-alist) ;; (setq ange-ftp-dired-move-to-end-of-filename-alist ;; (cons '(vms . ange-ftp-dired-vms-move-to-end-of-filename) ;; ange-ftp-dired-move-to-end-of-filename-alist))) ;;(defun ange-ftp-dired-vms-between-files () ;; (save-excursion ;; (beginning-of-line) ;; (or (equal (following-char) 10) ; newline ;; (equal (following-char) 9) ; tab ;; (progn (forward-char 2) ;; (or (looking-at "Total of") ;; (equal (following-char) 32)))))) ;;(or (assq 'vms ange-ftp-dired-between-files-alist) ;; (setq ange-ftp-dired-between-files-alist ;; (cons '(vms . ange-ftp-dired-vms-between-files) ;; ange-ftp-dired-between-files-alist))) ;; Beware! In VMS filenames must be of the form "FILE.TYPE". ;; Therefore, we cannot just append a ".Z" to filenames for ;; compressed files. Instead, we turn "FILE.TYPE" into ;; "FILE.TYPE-Z". Hope that this is a reasonable thing to do. (defun ange-ftp-vms-make-compressed-filename (name &optional reverse) (cond ((string-match "-Z;[0-9]+$" name) (list nil (substring name 0 (match-beginning 0)))) ((string-match ";[0-9]+$" name) (list nil (substring name 0 (match-beginning 0)))) ((string-match "-Z$" name) (list nil (substring name 0 -2))) (t (list t (if (string-match ";[0-9]+$" name) (concat (substring name 0 (match-beginning 0)) "-Z") (concat name "-Z")))))) (or (assq 'vms ange-ftp-make-compressed-filename-alist) (setq ange-ftp-make-compressed-filename-alist (cons '(vms . ange-ftp-vms-make-compressed-filename) ange-ftp-make-compressed-filename-alist))) ;;;; When the filename is too long, VMS will use two lines to list a file ;;;; (damn them!) This will confuse dired. To solve this, need to convince ;;;; Sebastian to use a function dired-go-to-end-of-file-line, instead of ;;;; (forward-line 1). This would require a number of changes to dired.el. ;;;; If dired gets confused, revert-buffer will fix it. ;;(defun ange-ftp-dired-vms-ls-trim () ;; (goto-char (point-min)) ;; (let ((case-fold-search nil)) ;; (re-search-forward ange-ftp-vms-filename-regexp)) ;; (beginning-of-line) ;; (delete-region (point-min) (point)) ;; (forward-line 1) ;; (delete-region (point) (point-max))) ;;(or (assq 'vms ange-ftp-dired-ls-trim-alist) ;; (setq ange-ftp-dired-ls-trim-alist ;; (cons '(vms . ange-ftp-dired-vms-ls-trim) ;; ange-ftp-dired-ls-trim-alist))) (defun ange-ftp-vms-sans-version (name &rest args) (save-match-data (if (string-match ";[0-9]+$" name) (substring name 0 (match-beginning 0)) name))) (or (assq 'vms ange-ftp-sans-version-alist) (setq ange-ftp-sans-version-alist (cons '(vms . ange-ftp-vms-sans-version) ange-ftp-sans-version-alist))) ;;(defvar ange-ftp-file-version-alist) ;;;;; The vms version of clean-directory has 2 more optional args ;;;;; than the usual dired version. This is so that it can be used by ;;;;; ange-ftp-dired-vms-flag-backup-files. ;;(defun ange-ftp-dired-vms-clean-directory (keep &optional marker msg) ;; "Flag numerical backups for deletion. ;;Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest. ;;Positive prefix arg KEEP overrides `dired-kept-versions'; ;;Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive. ;;To clear the flags on these files, you can use \\[dired-flag-backup-files] ;;with a prefix argument." ;;; (interactive "P") ; Never actually called interactively. ;; (setq keep (max 1 (if keep (prefix-numeric-value keep) dired-kept-versions))) ;; (let ((early-retention (if (< keep 0) (- keep) kept-old-versions)) ;; ;; late-retention must NEVER be allowed to be less than 1 in VMS! ;; ;; This could wipe ALL copies of the file. ;; (late-retention (max 1 (if (<= keep 0) dired-kept-versions keep))) ;; (action (or msg "Cleaning")) ;; (ange-ftp-trample-marker (or marker dired-del-marker)) ;; (ange-ftp-file-version-alist ())) ;; (message (concat action ;; " numerical backups (keeping %d late, %d old)...") ;; late-retention early-retention) ;; ;; Look at each file. ;; ;; If the file has numeric backup versions, ;; ;; put on ange-ftp-file-version-alist an element of the form ;; ;; (FILENAME . VERSION-NUMBER-LIST) ;; (dired-map-dired-file-lines (function ;; ange-ftp-dired-vms-collect-file-versions)) ;; ;; Sort each VERSION-NUMBER-LIST, ;; ;; and remove the versions not to be deleted. ;; (let ((fval ange-ftp-file-version-alist)) ;; (while fval ;; (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<))) ;; (v-count (length sorted-v-list))) ;; (if (> v-count (+ early-retention late-retention)) ;; (rplacd (nthcdr early-retention sorted-v-list) ;; (nthcdr (- v-count late-retention) ;; sorted-v-list))) ;; (rplacd (car fval) ;; (cdr sorted-v-list))) ;; (setq fval (cdr fval)))) ;; ;; Look at each file. If it is a numeric backup file, ;; ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion. ;; (dired-map-dired-file-lines ;; (function ;; ange-ftp-dired-vms-trample-file-versions mark)) ;; (message (concat action " numerical backups...done")))) ;;(or (assq 'vms ange-ftp-dired-clean-directory-alist) ;; (setq ange-ftp-dired-clean-directory-alist ;; (cons '(vms . ange-ftp-dired-vms-clean-directory) ;; ange-ftp-dired-clean-directory-alist))) ;;(defun ange-ftp-dired-vms-collect-file-versions (fn) ;; ;; "If it looks like file FN has versions, return a list of the versions. ;; ;;That is a list of strings which are file names. ;; ;;The caller may want to flag some of these files for deletion." ;;(let ((name (nth 2 (ange-ftp-ftp-name fn)))) ;; (if (string-match ";[0-9]+$" name) ;; (let* ((name (substring name 0 (match-beginning 0))) ;; (fn (ange-ftp-replace-name-component fn name))) ;; (if (not (assq fn ange-ftp-file-version-alist)) ;; (let* ((base-versions ;; (concat (file-name-nondirectory name) ";")) ;; (bv-length (length base-versions)) ;; (possibilities (file-name-all-completions ;; base-versions ;; (file-name-directory fn))) ;; (versions (mapcar ;; '(lambda (arg) ;; (if (and (string-match ;; "[0-9]+$" arg bv-length) ;; (= (match-beginning 0) bv-length)) ;; (string-to-int (substring arg bv-length)) ;; 0)) ;; possibilities))) ;; (if versions ;; (setq ;; ange-ftp-file-version-alist ;; (cons (cons fn versions) ;; ange-ftp-file-version-alist))))))))) ;;(defun ange-ftp-dired-vms-trample-file-versions (fn) ;; (let* ((start-vn (string-match ";[0-9]+$" fn)) ;; base-version-list) ;; (and start-vn ;; (setq base-version-list ; there was a base version to which ;; (assoc (substring fn 0 start-vn) ; this looks like a ;; ange-ftp-file-version-alist)) ; subversion ;; (not (memq (string-to-int (substring fn (1+ start-vn))) ;; base-version-list)) ; this one doesn't make the cut ;; (progn (beginning-of-line) ;; (delete-char 1) ;; (insert ange-ftp-trample-marker))))) ;;(defun ange-ftp-dired-vms-flag-backup-files (&optional unflag-p) ;; (let ((dired-kept-versions 1) ;; (kept-old-versions 0) ;; marker msg) ;; (if unflag-p ;; (setq marker ?\040 msg "Unflagging") ;; (setq marker dired-del-marker msg "Cleaning")) ;; (ange-ftp-dired-vms-clean-directory nil marker msg))) ;;(or (assq 'vms ange-ftp-dired-flag-backup-files-alist) ;; (setq ange-ftp-dired-flag-backup-files-alist ;; (cons '(vms . ange-ftp-dired-vms-flag-backup-files) ;; ange-ftp-dired-flag-backup-files-alist))) ;;(defun ange-ftp-dired-vms-backup-diff (&optional switches) ;; (let ((file (dired-get-filename 'no-dir)) ;; bak) ;; (if (and (string-match ";[0-9]+$" file) ;; ;; Find most recent previous version. ;; (let ((root (substring file 0 (match-beginning 0))) ;; (ver ;; (string-to-int (substring file (1+ (match-beginning 0))))) ;; found) ;; (setq ver (1- ver)) ;; (while (and (> ver 0) (not found)) ;; (setq bak (concat root ";" (int-to-string ver))) ;; (and (file-exists-p bak) (setq found t)) ;; (setq ver (1- ver))) ;; found)) ;; (if switches ;; (diff (expand-file-name bak) (expand-file-name file) switches) ;; (diff (expand-file-name bak) (expand-file-name file))) ;; (error "No previous version found for %s" file)))) ;;(or (assq 'vms ange-ftp-dired-backup-diff-alist) ;; (setq ange-ftp-dired-backup-diff-alist ;; (cons '(vms . ange-ftp-dired-vms-backup-diff) ;; ange-ftp-dired-backup-diff-alist))) ;;;; ------------------------------------------------------------ ;;;; MTS support ;;;; ------------------------------------------------------------ ;; Convert NAME from UNIX-ish to MTS. If REVERSE given then convert from ;; MTS to UNIX-ish. (defun ange-ftp-fix-name-for-mts (name &optional reverse) (save-match-data (if reverse (if (string-match "^\\([^:]+:\\)?\\(.*\\)$" name) (let (acct file) (if (match-beginning 1) (setq acct (substring name 0 (match-end 1)))) (if (match-beginning 2) (setq file (substring name (match-beginning 2) (match-end 2)))) (concat (and acct (concat "/" acct "/")) file)) (error "name %s didn't match" name)) (if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" name) (concat (substring name 1 (match-end 1)) (substring name (match-beginning 2) (match-end 2))) ;; Let's hope that mts will recognize it anyway. name)))) (or (assq 'mts ange-ftp-fix-name-func-alist) (setq ange-ftp-fix-name-func-alist (cons '(mts . ange-ftp-fix-name-for-mts) ange-ftp-fix-name-func-alist))) ;; Convert name from UNIX-ish to MTS ready for a DIRectory listing. ;; Remember that there are no directories in MTS. (defun ange-ftp-fix-dir-name-for-mts (dir-name) (if (string-equal dir-name "/") (error "Cannot get listing for fictitious \"/\" directory.") (let ((dir-name (ange-ftp-fix-name-for-mts dir-name))) (cond ((string-equal dir-name "") "?") ((string-match ":$" dir-name) (concat dir-name "?")) (dir-name))))) ; It's just a single file. (or (assq 'mts ange-ftp-fix-dir-name-func-alist) (setq ange-ftp-fix-dir-name-func-alist (cons '(mts . ange-ftp-fix-dir-name-for-mts) ange-ftp-fix-dir-name-func-alist))) (or (memq 'mts ange-ftp-dumb-host-types) (setq ange-ftp-dumb-host-types (cons 'mts ange-ftp-dumb-host-types))) (defvar ange-ftp-mts-host-regexp nil) ;; Return non-nil if HOST is running MTS. (defun ange-ftp-mts-host (host) (and ange-ftp-mts-host-regexp (save-match-data (string-match ange-ftp-mts-host-regexp host)))) ;; Parse the current buffer which is assumed to be in mts ftp dir format. (defun ange-ftp-parse-mts-listing () (let ((tbl (ange-ftp-make-hashtable))) (goto-char (point-min)) (save-match-data (while (re-search-forward ange-ftp-date-regexp nil t) (end-of-line) (skip-chars-backward " ") (let ((end (point))) (skip-chars-backward "-A-Z0-9_.!") (ange-ftp-put-hash-entry (buffer-substring (point) end) nil tbl)) (forward-line 1))) ;; Don't need to bother with .. (ange-ftp-put-hash-entry "." t tbl) tbl)) (or (assq 'mts ange-ftp-parse-list-func-alist) (setq ange-ftp-parse-list-func-alist (cons '(mts . ange-ftp-parse-mts-listing) ange-ftp-parse-list-func-alist))) (defun ange-ftp-add-mts-host (host) "Mark HOST as the name of a machine running MTS." (interactive (list (read-string "Host: " (let ((name (or (buffer-file-name) default-directory))) (and name (car (ange-ftp-ftp-name name))))))) (if (not (ange-ftp-mts-host host)) (setq ange-ftp-mts-host-regexp (concat "^" (regexp-quote host) "$" (and ange-ftp-mts-host-regexp "\\|") ange-ftp-mts-host-regexp) ange-ftp-host-cache nil))) ;;; Tree dired support: ;;;; There aren't too many systems left that use MTS. This dired support will ;;;; work for the implementation of ftp on mtsg.ubc.ca. I hope other mts systems ;;;; implement ftp in the same way. If not, it might be necessary to make the ;;;; following more flexible. ;;(defun ange-ftp-dired-mts-move-to-filename (&optional raise-error eol) ;; "In dired, move to first char of filename on this line. ;;Returns position (point) or nil if no filename on this line." ;; ;; This is the MTS version. ;; (or eol (setq eol (progn (end-of-line) (point)))) ;; (beginning-of-line) ;; (if (re-search-forward ;; ange-ftp-date-regexp eol t) ;; (progn ;; (skip-chars-forward " ") ; Eat blanks after date ;; (skip-chars-forward "0-9:" eol) ; Eat time or year ;; (skip-chars-forward " " eol) ; one space before filename ;; ;; When listing an account other than the users own account it appends ;; ;; ACCT: to the beginning of the filename. Skip over this. ;; (and (looking-at "[A-Z0-9_.]+:") ;; (goto-char (match-end 0))) ;; (point)) ;; (if raise-error ;; (error "No file on this line") ;; nil))) ;;(or (assq 'mts ange-ftp-dired-move-to-filename-alist) ;; (setq ange-ftp-dired-move-to-filename-alist ;; (cons '(mts . ange-ftp-dired-mts-move-to-filename) ;; ange-ftp-dired-move-to-filename-alist))) ;;(defun ange-ftp-dired-mts-move-to-end-of-filename (&optional no-error eol) ;; ;; Assumes point is at beginning of filename. ;; ;; So, it should be called only after (dired-move-to-filename t). ;; ;; On failure, signals an error or returns nil. ;; ;; This is the MTS version. ;; (let (opoint hidden case-fold-search) ;; (setq opoint (point) ;; eol (save-excursion (end-of-line) (point)) ;; hidden (and selective-display ;; (save-excursion (search-forward "\r" eol t)))) ;; (if hidden ;; nil ;; (skip-chars-forward "-A-Z0-9._!" eol)) ;; (or no-error ;; (not (eq opoint (point))) ;; (error ;; (if hidden ;; (substitute-command-keys ;; "File line is hidden, type \\[dired-hide-subdir] to unhide") ;; "No file on this line"))) ;; (if (eq opoint (point)) ;; nil ;; (point)))) ;;(or (assq 'mts ange-ftp-dired-move-to-end-of-filename-alist) ;; (setq ange-ftp-dired-move-to-end-of-filename-alist ;; (cons '(mts . ange-ftp-dired-mts-move-to-end-of-filename) ;; ange-ftp-dired-move-to-end-of-filename-alist))) ;;;; ------------------------------------------------------------ ;;;; CMS support ;;;; ------------------------------------------------------------ ;; Since CMS doesn't have any full file name syntax, we have to fudge ;; things with cd's. We actually send too many cd's, but it's dangerous ;; to try to remember the current minidisk, because if the connection ;; is closed and needs to be reopened, we will find ourselves back in ;; the default minidisk. This is fairly likely since CMS ftp servers ;; usually close the connection after 5 minutes of inactivity. ;; Have I got the filename character set right? (defun ange-ftp-fix-name-for-cms (name &optional reverse) (save-match-data (if reverse ;; Since we only convert output from a pwd in this direction, ;; we'll assume that it's a minidisk, and make it into a ;; directory file name. Note that the expand-dir-hashtable ;; stores directories without the trailing /. Is this ;; consistent? (concat "/" name) (if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" name) (let ((minidisk (substring name 1 (match-end 1)))) (if (match-beginning 2) (let ((file (substring name (match-beginning 2) (match-end 2))) (cmd (concat "cd " minidisk)) ;; Note that host and user are bound in the call ;; to ange-ftp-send-cmd (proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user))) ;; Must use ange-ftp-raw-send-cmd here to avoid ;; an infinite loop. (if (car (ange-ftp-raw-send-cmd proc cmd ange-ftp-this-msg)) file ;; failed... try ONCE more. (setq proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user)) (let ((result (ange-ftp-raw-send-cmd proc cmd ange-ftp-this-msg))) (if (car result) file ;; failed. give up. (ange-ftp-error ange-ftp-this-host ange-ftp-this-user (format "cd to minidisk %s failed: %s" minidisk (cdr result))))))) ;; return the minidisk minidisk)) (error "Invalid CMS filename"))))) (or (assq 'cms ange-ftp-fix-name-func-alist) (setq ange-ftp-fix-name-func-alist (cons '(cms . ange-ftp-fix-name-for-cms) ange-ftp-fix-name-func-alist))) (or (memq 'cms ange-ftp-dumb-host-types) (setq ange-ftp-dumb-host-types (cons 'cms ange-ftp-dumb-host-types))) ;; Convert name from UNIX-ish to CMS ready for a DIRectory listing. (defun ange-ftp-fix-dir-name-for-cms (dir-name) (cond ((string-equal "/" dir-name) (error "Cannot get listing for fictitious \"/\" directory.")) ((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-name) (let* ((minidisk (substring dir-name (match-beginning 1) (match-end 1))) ;; host and user are bound in the call to ange-ftp-send-cmd (proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user)) (cmd (concat "cd " minidisk)) (file (if (match-beginning 2) ;; it's a single file (substring dir-name (match-beginning 2) (match-end 2)) ;; use the wild-card "*"))) (if (car (ange-ftp-raw-send-cmd proc cmd)) file ;; try again... (setq proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user)) (let ((result (ange-ftp-raw-send-cmd proc cmd))) (if (car result) file ;; give up (ange-ftp-error ange-ftp-this-host ange-ftp-this-user (format "cd to minidisk %s failed: " minidisk (cdr result)))))))) (t (error "Invalid CMS file name")))) (or (assq 'cms ange-ftp-fix-dir-name-func-alist) (setq ange-ftp-fix-dir-name-func-alist (cons '(cms . ange-ftp-fix-dir-name-for-cms) ange-ftp-fix-dir-name-func-alist))) (defvar ange-ftp-cms-host-regexp nil "Regular expression to match hosts running the CMS operating system.") ;; Return non-nil if HOST is running CMS. (defun ange-ftp-cms-host (host) (and ange-ftp-cms-host-regexp (save-match-data (string-match ange-ftp-cms-host-regexp host)))) (defun ange-ftp-add-cms-host (host) "Mark HOST as the name of a CMS host." (interactive (list (read-string "Host: " (let ((name (or (buffer-file-name) default-directory))) (and name (car (ange-ftp-ftp-name name))))))) (if (not (ange-ftp-cms-host host)) (setq ange-ftp-cms-host-regexp (concat "^" (regexp-quote host) "$" (and ange-ftp-cms-host-regexp "\\|") ange-ftp-cms-host-regexp) ange-ftp-host-cache nil))) (defun ange-ftp-parse-cms-listing () ;; Parse the current buffer which is assumed to be a CMS directory listing. ;; If we succeed in getting a listing, then we will assume that the minidisk ;; exists. file is bound by the call to ange-ftp-ls. This doesn't work ;; because ange-ftp doesn't know that the root hashtable has only part of ;; the info. It will assume that if a minidisk isn't in it, then it doesn't ;; exist. It would be nice if completion worked for minidisks, as we ;; discover them. ; (let* ((dir-file (directory-file-name file)) ; (root (file-name-directory dir-file)) ; (minidisk (ange-ftp-get-file-part dir-file)) ; (root-tbl (ange-ftp-get-hash-entry root ange-ftp-files-hashtable))) ; (if root-tbl ; (ange-ftp-put-hash-entry minidisk t root-tbl) ; (setq root-tbl (ange-ftp-make-hashtable)) ; (ange-ftp-put-hash-entry minidisk t root-tbl) ; (ange-ftp-put-hash-entry "." t root-tbl) ; (ange-ftp-set-files root root-tbl))) ;; Now do the usual parsing (let ((tbl (ange-ftp-make-hashtable))) (goto-char (point-min)) (save-match-data (while (re-search-forward "^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t) (ange-ftp-put-hash-entry (concat (buffer-substring (match-beginning 1) (match-end 1)) "." (buffer-substring (match-beginning 2) (match-end 2))) nil tbl) (forward-line 1)) (ange-ftp-put-hash-entry "." t tbl)) tbl)) (or (assq 'cms ange-ftp-parse-list-func-alist) (setq ange-ftp-parse-list-func-alist (cons '(cms . ange-ftp-parse-cms-listing) ange-ftp-parse-list-func-alist))) ;;;;; Tree dired support: ;;(defconst ange-ftp-dired-cms-re-exe ;; "^. [-A-Z0-9$_]+ +EXEC " ;; "Regular expression to use to search for CMS executables.") ;;(or (assq 'cms ange-ftp-dired-re-exe-alist) ;; (setq ange-ftp-dired-re-exe-alist ;; (cons (cons 'cms ange-ftp-dired-cms-re-exe) ;; ange-ftp-dired-re-exe-alist))) ;;(defun ange-ftp-dired-cms-insert-headerline (dir) ;; ;; CMS has no total line, so we insert a blank line for ;; ;; aesthetics. ;; (insert "\n") ;; (forward-char -1) ;; (ange-ftp-real-dired-insert-headerline dir)) ;;(or (assq 'cms ange-ftp-dired-insert-headerline-alist) ;; (setq ange-ftp-dired-insert-headerline-alist ;; (cons '(cms . ange-ftp-dired-cms-insert-headerline) ;; ange-ftp-dired-insert-headerline-alist))) ;;(defun ange-ftp-dired-cms-move-to-filename (&optional raise-error eol) ;; "In dired, move to the first char of filename on this line." ;; ;; This is the CMS version. ;; (or eol (setq eol (progn (end-of-line) (point)))) ;; (let (case-fold-search) ;; (beginning-of-line) ;; (if (re-search-forward " [-A-Z0-9$_]+ +[-A-Z0-9$_]+ +[VF] +[0-9]+ " eol t) ;; (goto-char (1+ (match-beginning 0))) ;; (if raise-error ;; (error "No file on this line") ;; nil)))) ;;(or (assq 'cms ange-ftp-dired-move-to-filename-alist) ;; (setq ange-ftp-dired-move-to-filename-alist ;; (cons '(cms . ange-ftp-dired-cms-move-to-filename) ;; ange-ftp-dired-move-to-filename-alist))) ;;(defun ange-ftp-dired-cms-move-to-end-of-filename (&optional no-error eol) ;; ;; Assumes point is at beginning of filename. ;; ;; So, it should be called only after (dired-move-to-filename t). ;; ;; case-fold-search must be nil, at least for VMS. ;; ;; On failure, signals an error or returns nil. ;; ;; This is the CMS version. ;; (let ((opoint (point)) ;; case-fold-search hidden) ;; (or eol (setq eol (save-excursion (end-of-line) (point)))) ;; (setq hidden (and selective-display ;; (save-excursion ;; (search-forward "\r" eol t)))) ;; (if hidden ;; (if no-error ;; nil ;; (error ;; (substitute-command-keys ;; "File line is hidden, type \\[dired-hide-subdir] to unhide"))) ;; (skip-chars-forward "-A-Z0-9$_" eol) ;; (skip-chars-forward " " eol) ;; (skip-chars-forward "-A-Z0-9$_" eol) ;; (if (eq opoint (point)) ;; (if no-error ;; nil ;; (error "No file on this line")) ;; (point))))) ;;(or (assq 'cms ange-ftp-dired-move-to-end-of-filename-alist) ;; (setq ange-ftp-dired-move-to-end-of-filename-alist ;; (cons '(cms . ange-ftp-dired-cms-move-to-end-of-filename) ;; ange-ftp-dired-move-to-end-of-filename-alist))) (defun ange-ftp-cms-make-compressed-filename (name &optional reverse) (if (string-match "-Z$" name) (list nil (substring name 0 -2)) (list t (concat name "-Z")))) (or (assq 'cms ange-ftp-make-compressed-filename-alist) (setq ange-ftp-make-compressed-filename-alist (cons '(cms . ange-ftp-cms-make-compressed-filename) ange-ftp-make-compressed-filename-alist))) ;;(defun ange-ftp-dired-cms-get-filename (&optional localp no-error-if-not-filep) ;; (let ((name (ange-ftp-real-dired-get-filename localp no-error-if-not-filep))) ;; (and name ;; (if (string-match "^\\([^ ]+\\) +\\([^ ]+\\)$" name) ;; (concat (substring name 0 (match-end 1)) ;; "." ;; (substring name (match-beginning 2) (match-end 2))) ;; name)))) ;;(or (assq 'cms ange-ftp-dired-get-filename-alist) ;; (setq ange-ftp-dired-get-filename-alist ;; (cons '(cms . ange-ftp-dired-cms-get-filename) ;; ange-ftp-dired-get-filename-alist))) ;;;; ------------------------------------------------------------ ;;;; Finally provide package. ;;;; ------------------------------------------------------------ (provide 'ange-ftp) ;;; ange-ftp.el ends here emacs-19.30/lisp/appt.el100444 12120 1 47565 6035066303 13377 0ustar rmsdaemon;;; appt.el --- appointment notification functions. ;; Copyright (C) 1989, 1990, 1994 Free Software Foundation, Inc. ;; Author: Neil Mager ;; Maintainer: FSF ;; Keywords: calendar ;; 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: ;; ;; appt.el - visible and/or audible notification of ;; appointments from ~/diary file generated from ;; Edward M. Reingold's calendar.el. ;; ;; ;; Comments, corrections, and improvements should be sent to ;; Neil M. Mager ;; Net ;; Voice (617) 981-4803 ;;; ;;; Thanks to Edward M. Reingold for much help and many suggestions, ;;; And to many others for bug fixes and suggestions. ;;; ;;; ;;; This functions in this file will alert the user of a ;;; pending appointment based on their diary file. ;;; ;;; ;;; ******* It is necessary to invoke 'display-time' ******** ;;; ******* and 'diary' for this to work properly. ******** ;;; ;;; A message will be displayed in the mode line of the emacs buffer ;;; and (if the user desires) the terminal will beep and display a message ;;; from the diary in the mini-buffer, or the user may select to ;;; have a message displayed in a new buffer. ;;; ;;; The variable 'appt-message-warning-time' allows the ;;; user to specify how much notice they want before the appointment. The ;;; variable 'appt-issue-message' specifies whether the user wants ;;; to to be notified of a pending appointment. ;;; ;;; In order to use, the following should be in your .emacs file in addition to ;;; creating a diary file and invoking calendar: ;;; ;;; Set some options ;;; (setq view-diary-entries-initially t) ;;; (setq appt-issue-message t) ;;; ;;; The following three lines are required: ;;; (display-time) ;;; (add-hook 'diary-hook 'appt-make-list) ;;; ;;; ;;; This is an example of what can be in your diary file: ;;; Monday ;;; 9:30am Coffee break ;;; 12:00pm Lunch ;;; ;;; Based upon the above lines in your .emacs and diary files, ;;; the calendar and diary will be displayed when you enter ;;; emacs and your appointments list will automatically be created. ;;; You will then be reminded at 9:20am about your coffee break ;;; and at 11:50am to go to lunch. ;;; ;;; Use describe-function on appt-check for a description of other variables ;;; that can be used to personalize the notification system. ;;; ;;; In order to add or delete items from todays list, use appt-add ;;; and appt-delete. ;;; ;;; Additionally, the appointments list is recreated automatically ;;; at 12:01am for those who do not logout every day or are programming ;;; late. ;;; ;;; Brief internal description - Skip this if your not interested! ;;; ;;; The function appt-check is run from the 'loadst' process which is started ;;; by invoking (display-time). A temporary function below modifies ;;; display-time-filter ;;; (from original time.el) to include a hook which will invoke appt-check. ;;; This will not be necessary in the next version of gnuemacs. ;;; ;;; ;;; The function appt-make-list creates the appointments list which appt-check ;;; reads. This is all done automatically. ;;; It is invoked from the function list-diary-entries. ;;; ;;; You can change the way the appointment window is created/deleted by ;;; setting the variables ;;; ;;; appt-disp-window-function ;;; and ;;; appt-delete-window-function ;;; ;;; For instance, these variables can be set to functions that display ;;; appointments in pop-up frames, which are lowered or iconified after ;;; appt-display-interval seconds. ;;; ;;; Code: ;; Make sure calendar is loaded when we compile this. (require 'calendar) (provide 'appt) ;;;###autoload (defvar appt-issue-message t "*Non-nil means check for appointments in the diary buffer. To be detected, the diary entry must have the time as the first thing on a line.") ;;;###autoload (defvar appt-message-warning-time 12 "*Time in minutes before an appointment that the warning begins.") ;;;###autoload (defvar appt-audible t "*Non-nil means beep to indicate appointment.") ;;;###autoload (defvar appt-visible t "*Non-nil means display appointment message in echo area.") ;;;###autoload (defvar appt-display-mode-line t "*Non-nil means display minutes to appointment and time on the mode line.") ;;;###autoload (defvar appt-msg-window t "*Non-nil means display appointment message in another window.") ;;;###autoload (defvar appt-display-duration 10 "*The number of seconds an appointment message is displayed.") ;;;###autoload (defvar appt-display-diary t "*Non-nil means to display the next days diary on the screen. This will occur at midnight when the appointment list is updated.") (defvar appt-time-msg-list nil "The list of appointments for today. Use `appt-add' and `appt-delete' to add and delete appointments from list. The original list is generated from the today's `diary-entries-list'. The number before each time/message is the time in minutes from midnight.") (defconst max-time 1439 "11:59pm in minutes - number of minutes in a day minus 1.") (defvar appt-display-interval 3 "*Number of minutes to wait between checking the appointment list.") (defvar appt-buffer-name " *appt-buf*" "Name of the appointments buffer.") (defvar appt-disp-window-function 'appt-disp-window "Function called to display appointment window.") (defvar appt-delete-window-function 'appt-delete-window "Function called to remove appointment window and buffer.") (defun appt-check () "Check for an appointment and update the mode line. Note: the time must be the first thing in the line in the diary for a warning to be issued. The format of the time can be either 24 hour or am/pm. Example: 02/23/89 18:00 Dinner Thursday 11:45am Lunch meeting. The following variables control the action of the notification: appt-issue-message If T, the diary buffer is checked for appointments. appt-message-warning-time Variable used to determine if appointment message should be displayed. appt-audible Variable used to determine if appointment is audible. Default is t. appt-visible Variable used to determine if appointment message should be displayed in the mini-buffer. Default is t. appt-msg-window Variable used to determine if appointment message should temporarily appear in another window. Mutually exclusive to appt-visible. appt-display-duration The number of seconds an appointment message is displayed in another window. appt-display-interval The number of minutes to wait between checking the appointments list. appt-disp-window-function Function called to display appointment window. You can customize appt.el by setting this variable to a function different from the one provided with this package. appt-delete-window-function Function called to remove appointment window and buffer. You can customize appt.el by setting this variable to a function different from the one provided with this package. This function is run from the loadst process for display time. Therefore, you need to have `(display-time)' in your .emacs file." (if (or (= appt-display-interval 1) ;; This is true every appt-display-interval minutes. (= 0 (mod (/ (nth 1 (current-time)) 60) appt-display-interval))) (let ((min-to-app -1) (new-time "")) (save-excursion ;; Get the current time and convert it to minutes ;; from midnight. ie. 12:01am = 1, midnight = 0. (let* ((cur-hour(string-to-int (substring (current-time-string) 11 13))) (cur-min (string-to-int (substring (current-time-string) 14 16))) (cur-comp-time (+ (* cur-hour 60) cur-min))) ;; At the first check after 12:01am, we should update our ;; appointments to today's list. (if (and (>= cur-comp-time 1) (<= cur-comp-time appt-display-interval)) (if (and view-diary-entries-initially appt-display-diary) (diary) (let ((diary-display-hook 'appt-make-list)) (diary)))) ;; If there are entries in the list, and the ;; user wants a message issued ;; get the first time off of the list ;; and calculate the number of minutes until ;; the appointment. (if (and appt-issue-message appt-time-msg-list) (let ((appt-comp-time (car (car (car appt-time-msg-list))))) (setq min-to-app (- appt-comp-time cur-comp-time)) (while (and appt-time-msg-list (< appt-comp-time cur-comp-time)) (setq appt-time-msg-list (cdr appt-time-msg-list)) (if appt-time-msg-list (setq appt-comp-time (car (car (car appt-time-msg-list)))))) ;; If we have an appointment between midnight and ;; 'appt-message-warning-time' minutes after midnight, ;; we must begin to issue a message before midnight. ;; Midnight is considered 0 minutes and 11:59pm is ;; 1439 minutes. Therefore we must recalculate the minutes ;; to appointment variable. It is equal to the number of ;; minutes before midnight plus the number of ;; minutes after midnight our appointment is. (if (and (< appt-comp-time appt-message-warning-time) (> (+ cur-comp-time appt-message-warning-time) max-time)) (setq min-to-app (+ (- (1+ max-time) cur-comp-time)) appt-comp-time)) ;; issue warning if the appointment time is ;; within appt-message-warning time (if (and (<= min-to-app appt-message-warning-time) (>= min-to-app 0)) (progn (if appt-msg-window (progn (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" display-time-string) (setq new-time (substring display-time-string (match-beginning 0) (match-end 0))) (funcall appt-disp-window-function min-to-app new-time (car (cdr (car appt-time-msg-list)))) (run-at-time (format "%d sec" appt-display-duration) nil appt-delete-window-function)) ;;; else (if appt-visible (message "%s" (car (cdr (car appt-time-msg-list))))) (if appt-audible (beep 1))) (if appt-display-mode-line (progn (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" display-time-string) (setq new-time (substring display-time-string (match-beginning 0) (match-end 0))) (setq display-time-string (concat "App't in " min-to-app " min. " new-time " ")) (force-mode-line-update t) (sit-for 0))) (if (= min-to-app 0) (setq appt-time-msg-list (cdr appt-time-msg-list)))))))))))) ;; Display appointment message in a separate buffer. (defun appt-disp-window (min-to-app new-time appt-msg) (require 'electric) ;; Make sure we're not in the minibuffer ;; before splitting the window. (if (equal (selected-window) (minibuffer-window)) (if (other-window 1) (select-window (other-window 1)) (if window-system (select-frame (other-frame 1))))) (let* ((this-buffer (current-buffer)) (this-window (selected-window)) (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name)))) (appt-select-lowest-window) (if (cdr (assq 'unsplittable (frame-parameters))) ;; In an unsplittable frame, use something somewhere else. (display-buffer appt-disp-buf) ;; Otherwise, split the bottom window and use the lower part. (split-window) (pop-to-buffer appt-disp-buf)) (setq mode-line-format (concat "-------------------- Appointment in " min-to-app " minutes. " new-time " %-")) (insert-string appt-msg) (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t)) (set-buffer-modified-p nil) (raise-frame (selected-frame)) (select-window this-window) (if appt-audible (beep 1)))) (defun appt-delete-window () "Function called to undisplay appointment messages. Usually just deletes the appointment buffer." (let ((window (get-buffer-window appt-buffer-name t))) (and window (or (and (fboundp 'frame-root-window) (eq window (frame-root-window (window-frame window)))) (delete-window window)))) (kill-buffer appt-buffer-name) (if appt-audible (beep 1))) ;; Select the lowest window on the frame. (defun appt-select-lowest-window () (let* ((lowest-window (selected-window)) (bottom-edge (car (cdr (cdr (cdr (window-edges)))))) (last-window (previous-window)) (window-search t)) (while window-search (let* ((this-window (next-window)) (next-bottom-edge (car (cdr (cdr (cdr (window-edges this-window))))))) (if (< bottom-edge next-bottom-edge) (progn (setq bottom-edge next-bottom-edge) (setq lowest-window this-window))) (select-window this-window) (if (eq last-window this-window) (progn (select-window lowest-window) (setq window-search nil))))))) (defun appt-add (new-appt-time new-appt-msg) "Add an appointment for the day at TIME and issue MESSAGE. The time should be in either 24 hour format or am/pm format." (interactive "sTime (hh:mm[am/pm]): \nsMessage: ") (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time) nil (error "Unacceptable time-string")) (let* ((appt-time-string (concat new-appt-time " " new-appt-msg)) (appt-time (list (appt-convert-time new-appt-time))) (time-msg (cons appt-time (list appt-time-string)))) (setq appt-time-msg-list (append appt-time-msg-list (list time-msg))) (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)))) (defun appt-delete () "Delete an appointment from the list of appointments." (interactive) (let* ((tmp-msg-list appt-time-msg-list)) (while tmp-msg-list (let* ((element (car tmp-msg-list)) (prompt-string (concat "Delete " (prin1-to-string (car (cdr element))) " from list? ")) (test-input (y-or-n-p prompt-string))) (setq tmp-msg-list (cdr tmp-msg-list)) (if test-input (setq appt-time-msg-list (delq element appt-time-msg-list))))) (message ""))) ;; Create the appointments list from todays diary buffer. ;; The time must be at the beginning of a line for it to be ;; put in the appointments list. ;; 02/23/89 ;; 12:00pm lunch ;; Wednesday ;; 10:00am group meeting ;; We assume that the variables DATE and NUMBER ;; hold the arguments that list-diary-entries received. ;; They specify the range of dates that the diary is being processed for. ;;;###autoload (defun appt-make-list () ;; We have something to do if the range of dates that the diary is ;; considering includes the current date. (if (and (not (calendar-date-compare (list (calendar-current-date)) (list original-date))) (calendar-date-compare (list (calendar-current-date)) (list (calendar-gregorian-from-absolute (+ (calendar-absolute-from-gregorian original-date) number))))) (save-excursion ;; Clear the appointments list, then fill it in from the diary. (setq appt-time-msg-list nil) (if diary-entries-list ;; Cycle through the entry-list (diary-entries-list) ;; looking for entries beginning with a time. If ;; the entry begins with a time, add it to the ;; appt-time-msg-list. Then sort the list. (let ((entry-list diary-entries-list) (new-time-string "")) ;; Skip diary entries for dates before today. (while (and entry-list (calendar-date-compare (car entry-list) (list (calendar-current-date)))) (setq entry-list (cdr entry-list))) ;; Parse the entries for today. (while (and entry-list (calendar-date-equal (calendar-current-date) (car (car entry-list)))) (let ((time-string (substring (prin1-to-string (cdr (car entry-list))) 2 -2))) (while (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?.*" time-string) (let* ((appt-time-string (substring time-string (match-beginning 0) (match-end 0)))) (if (< (match-end 0) (length time-string)) (setq new-time-string (substring time-string (+ (match-end 0) 1) nil)) (setq new-time-string "")) (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" time-string) (let* ((appt-time (list (appt-convert-time (substring time-string (match-beginning 0) (match-end 0))))) (time-msg (cons appt-time (list appt-time-string)))) (setq time-string new-time-string) (setq appt-time-msg-list (append appt-time-msg-list (list time-msg))))))) (setq entry-list (cdr entry-list))))) (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)) ;; Get the current time and convert it to minutes ;; from midnight. ie. 12:01am = 1, midnight = 0, ;; so that the elements in the list ;; that are earlier than the present time can ;; be removed. (let* ((cur-hour(string-to-int (substring (current-time-string) 11 13))) (cur-min (string-to-int (substring (current-time-string) 14 16))) (cur-comp-time (+ (* cur-hour 60) cur-min)) (appt-comp-time (car (car (car appt-time-msg-list))))) (while (and appt-time-msg-list (< appt-comp-time cur-comp-time)) (setq appt-time-msg-list (cdr appt-time-msg-list)) (if appt-time-msg-list (setq appt-comp-time (car (car (car appt-time-msg-list)))))))))) ;;Simple sort to put the appointments list in order. ;;Scan the list for the smallest element left in the list. ;;Append the smallest element left into the new list, and remove ;;it from the original list. (defun appt-sort-list (appt-list) (let ((order-list nil)) (while appt-list (let* ((element (car appt-list)) (element-time (car (car element))) (tmp-list (cdr appt-list))) (while tmp-list (if (< element-time (car (car (car tmp-list)))) nil (setq element (car tmp-list)) (setq element-time (car (car element)))) (setq tmp-list (cdr tmp-list))) (setq order-list (append order-list (list element))) (setq appt-list (delq element appt-list)))) order-list)) (defun appt-convert-time (time2conv) "Convert hour:min[am/pm] format to minutes from midnight." (let ((conv-time 0) (hr 0) (min 0)) (string-match ":[0-9][0-9]" time2conv) (setq min (string-to-int (substring time2conv (+ (match-beginning 0) 1) (match-end 0)))) (string-match "[0-9]?[0-9]:" time2conv) (setq hr (string-to-int (substring time2conv (match-beginning 0) (match-end 0)))) ;; convert the time appointment time into 24 hour time (if (and (string-match "[p][m]" time2conv) (< hr 12)) (progn (string-match "[0-9]?[0-9]:" time2conv) (setq hr (+ 12 hr)))) ;; convert the actual time ;; into minutes for comparison ;; against the actual time. (setq conv-time (+ (* hr 60) min)) conv-time)) (add-hook 'display-time-hook 'appt-check) ;;; appt.el ends here emacs-19.30/lisp/apropos.el100444 12120 1 44651 6054257675 14126 0ustar rmsdaemon;;; apropos.el --- apropos commands for users and programmers. ;; Copyright (C) 1989, 1994, 1995 Free Software Foundation, Inc. ;; Author: Joe Wells ;; Rewritten: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 ;; Keywords: help ;; 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: ;; The ideas for this package were derived from the C code in ;; src/keymap.c and elsewhere. The functions in this file should ;; always be byte-compiled for speed. Someone should rewrite this in ;; C (as part of src/keymap.c) for speed. ;; The idea for super-apropos is based on the original implementation ;; by Lynn Slater . ;; History: ;; Fixed bug, current-local-map can return nil. ;; Change, doesn't calculate key-bindings unless needed. ;; Added super-apropos capability, changed print functions. ;;; Made fast-apropos and super-apropos share code. ;;; Sped up fast-apropos again. ;; Added apropos-do-all option. ;;; Added fast-command-apropos. ;; Changed doc strings to comments for helping functions. ;;; Made doc file buffer read-only, buried it. ;; Only call substitute-command-keys if do-all set. ;; Optionally use configurable faces to make the output more legible. ;; Differentiate between command, function and macro. ;; Apropos-command (ex command-apropos) does cmd and optionally user var. ;; Apropos shows all 3 aspects of symbols (fn, var and plist) ;; Apropos-documentation (ex super-apropos) now finds all it should. ;; New apropos-value snoops through all values and optionally plists. ;; Reading DOC file doesn't load nroff. ;; Added hypertext following of documentation, mouse-2 on variable gives value ;; from buffer in active window. ;;; Code: ;; I see a degradation of maybe 10-20% only. (defvar apropos-do-all nil "*Whether the apropos commands should do more. Slows them down more or less. Set this non-nil if you have a fast machine.") (defvar apropos-symbol-face (if window-system 'bold) "*Face for symbol name in apropos output or `nil'. This looks good, but slows down the commands several times.") (defvar apropos-keybinding-face (if window-system 'underline) "*Face for keybinding display in apropos output or `nil'. This looks good, but slows down the commands several times.") (defvar apropos-label-face (if window-system 'italic) "*Face for label (Command, Variable ...) in apropos output or `nil'. If this is `nil' no mouse highlighting occurs. This looks good, but slows down the commands several times. When this is a face name, as it is initially, it gets transformed to a text-property list for efficiency.") (defvar apropos-property-face (if window-system 'bold-italic) "*Face for property name in apropos output or `nil'. This looks good, but slows down the commands several times.") (defvar apropos-match-face (if window-system 'highlight) "*Face for matching part in apropos-documentation/value output or `nil'. This looks good, but slows down the commands several times.") (defvar apropos-local-map (let ((map (make-sparse-keymap))) (define-key map "\C-m" 'apropos-follow) (define-key map [mouse-2] 'apropos-mouse-follow) (define-key map [down-mouse-2] nil) map) "Local map active when displaying apropos output.") (defvar apropos-regexp nil "Regexp used in current apropos run.") (defvar apropos-files-scanned () "List of elc files already scanned in current run of `apropos-documentaion'.") (defvar apropos-accumulator () "Alist of symbols already found in current apropos run.") (defvar apropos-item () "Current item in or for apropos-accumulator.") ;; For auld lang syne: ;;;###autoload (fset 'command-apropos 'apropos-command) ;;;###autoload (defun apropos-command (apropos-regexp &optional do-all) "Shows commands (interactively callable functions) that match REGEXP. With optional prefix ARG or if `apropos-do-all' is non-nil, also show variables." (interactive (list (read-string (concat "Apropos command " (if (or current-prefix-arg apropos-do-all) "or variable ") "(regexp): ")) current-prefix-arg)) (let ((message (let ((standard-output (get-buffer-create "*Help*"))) (print-help-return-message 'identity)))) (or do-all (setq do-all apropos-do-all)) (setq apropos-accumulator (apropos-internal apropos-regexp (if do-all (lambda (symbol) (or (commandp symbol) (user-variable-p symbol))) 'commandp))) (if (apropos-print t (lambda (p) (let (doc symbol) (while p (setcar p (list (setq symbol (car p)) (if (commandp symbol) (if (setq doc (documentation symbol t)) (substring doc 0 (string-match "\n" doc)) "(not documented)")) (and do-all (user-variable-p symbol) (if (setq doc (documentation-property symbol 'variable-documentation t)) (substring doc 0 (string-match "\n" doc)))))) (setq p (cdr p))))) nil) (and message (message message))))) ;;;###autoload (defun apropos (apropos-regexp &optional do-all) "Show all bound symbols whose names match REGEXP. With optional prefix ARG or if `apropos-do-all' is non-nil, also show unbound symbols and key bindings, which is a little more time-consuming. Returns list of symbols and documentation found." (interactive "sApropos symbol (regexp): \nP") (setq apropos-accumulator (apropos-internal apropos-regexp (and (not do-all) (not apropos-do-all) (lambda (symbol) (or (fboundp symbol) (boundp symbol) (symbol-plist symbol)))))) (apropos-print (or do-all apropos-do-all) (lambda (p) (let (symbol doc) (while p (setcar p (list (setq symbol (car p)) (if (fboundp symbol) (if (setq doc (documentation symbol t)) (substring doc 0 (string-match "\n" doc)) "(not documented)")) (if (boundp symbol) (if (setq doc (documentation-property symbol 'variable-documentation t)) (substring doc 0 (string-match "\n" doc)) "(not documented)")) (if (setq doc (symbol-plist symbol)) (if (eq (setq doc (/ (length doc) 2)) 1) "1 property" (concat doc " properties"))))) (setq p (cdr p))))) nil)) ;;;###autoload (defun apropos-value (apropos-regexp &optional do-all) "Show all symbols whose value's printed image matches REGEXP. With optional prefix ARG or if `apropos-do-all' is non-nil, also looks at the function and at the names and values of properties. Returns list of symbols and values found." (interactive "sApropos value (regexp): \nP") (or do-all (setq do-all apropos-do-all)) (setq apropos-accumulator ()) (let (f v p) (mapatoms (lambda (symbol) (setq f nil v nil p nil) (or (memq symbol '(apropos-regexp do-all apropos-accumulator symbol f v p)) (setq v (apropos-value-internal 'boundp symbol 'symbol-value))) (if do-all (setq f (apropos-value-internal 'fboundp symbol 'symbol-function) p (apropos-format-plist symbol "\n " t))) (if (or f v p) (setq apropos-accumulator (cons (list symbol f v p) apropos-accumulator)))))) (apropos-print nil nil t)) ;;;###autoload (defun apropos-documentation (apropos-regexp &optional do-all) "Show symbols whose names or documentation contain matches for REGEXP. With optional prefix ARG or if `apropos-do-all' is non-nil, also use documentation that is not stored in the documentation file and show key bindings. Returns list of symbols and documentation found." (interactive "sApropos documentation (regexp): \nP") (or do-all (setq do-all apropos-do-all)) (setq apropos-accumulator () apropos-files-scanned ()) (let ((standard-input (get-buffer-create " apropos-temp")) f v) (unwind-protect (save-excursion (set-buffer standard-input) (apropos-documentation-check-doc-file) (if do-all (mapatoms (lambda (symbol) (setq f (apropos-safe-documentation symbol) v (get symbol 'variable-documentation) v (if (integerp v) nil v)) (or (string-match apropos-regexp (symbol-name symbol)) (setq f (apropos-documentation-internal f) v (apropos-documentation-internal v))) (if (or f v) (if (setq apropos-item (cdr (assq symbol apropos-accumulator))) (progn (if f (setcar apropos-item f)) (if v (setcar (cdr apropos-item) v))) (setq apropos-accumulator (cons (list symbol f v) apropos-accumulator))))))) (apropos-print do-all nil t)) (kill-buffer standard-input)))) (defun apropos-value-internal (predicate symbol function) (if (funcall predicate symbol) (progn (setq symbol (prin1-to-string (funcall function symbol))) (if (string-match apropos-regexp symbol) (progn (if apropos-match-face (put-text-property (match-beginning 0) (match-end 0) 'face apropos-match-face symbol)) symbol))))) (defun apropos-documentation-internal (doc) (if (consp doc) (apropos-documentation-check-elc-file (car doc)) (and doc (string-match apropos-regexp doc) (progn (if apropos-match-face (put-text-property (match-beginning 0) (match-end 0) 'face apropos-match-face (setq doc (copy-sequence doc)))) doc)))) (defun apropos-format-plist (pl sep &optional compare) (setq pl (symbol-plist pl)) (let (p p-out) (while pl (setq p (format "%s %S" (car pl) (nth 1 pl))) (if (or (not compare) (string-match apropos-regexp p)) (if apropos-property-face (put-text-property 0 (length (symbol-name (car pl))) 'face apropos-property-face p)) (setq p nil)) (if p (progn (and compare apropos-match-face (put-text-property (match-beginning 0) (match-end 0) 'face apropos-match-face p)) (setq p-out (concat p-out (if p-out sep) p)))) (setq pl (nthcdr 2 pl))) p-out)) ;; Finds all documentation related to APROPOS-REGEXP in internal-doc-file-name. (defun apropos-documentation-check-doc-file () (let (type symbol beg end) (insert-file-contents (concat doc-directory internal-doc-file-name)) (while (re-search-forward apropos-regexp nil t) (setq beg (match-beginning 0) end (point)) (search-backward "\C-_") (if (> (point) beg) () (or (setq type (if (eq ?F (char-after (1+ (point)))) 1 ;function documentation 2) ;variable documentation symbol (prog2 (forward-char 2) (read)) beg (- beg (point) 1) end (- end (point) 1) doc (buffer-substring (1+ (point)) (if (search-forward "\C-_" nil 'move) (1- (point)) (point))) apropos-item (assq symbol apropos-accumulator)) (setq apropos-item (list symbol nil nil) apropos-accumulator (cons apropos-item apropos-accumulator))) (and apropos-match-face (>= beg 0) (put-text-property beg end 'face apropos-match-face doc)) (setcar (nthcdr type apropos-item) doc))))) (defun apropos-documentation-check-elc-file (file) (if (member file apropos-files-scanned) nil (let (symbol doc beg end end1 this-is-a-variable) (setq apropos-files-scanned (cons file apropos-files-scanned)) (erase-buffer) (insert-file-contents file) (while (search-forward "\n#@" nil t) ;; Read the comment length, and advance over it. (setq end (read) beg (point) end (+ (point) end 1)) (if (re-search-forward apropos-regexp end t) (progn (goto-char end) (setq doc (buffer-substring (1+ beg) (- end 2)) end1 (- (match-end 0) beg 1) beg (- (match-beginning 0) beg 1) this-is-a-variable (looking-at "(defvar\\|(defconst") symbol (progn (skip-chars-forward "(a-z") (forward-char 1) (read)) symbol (if (consp symbol) (nth 1 symbol) symbol)) (if (if this-is-a-variable (get symbol 'variable-documentation) (and (fboundp symbol) (apropos-safe-documentation symbol))) (progn (or (setq apropos-item (assq symbol apropos-accumulator)) (setq apropos-item (list symbol nil nil) apropos-accumulator (cons apropos-item apropos-accumulator))) (if apropos-match-face (put-text-property beg end1 'face apropos-match-face doc)) (setcar (nthcdr (if this-is-a-variable 2 1) apropos-item) doc))))) (goto-char end))))) (defun apropos-safe-documentation (function) "Like documentation, except it avoids calling `get_doc_string'. Will return nil instead." (while (and function (symbolp function)) (setq function (if (fboundp function) (symbol-function function)))) (if (eq (car-safe function) 'macro) (setq function (cdr function))) (setq function (if (byte-code-function-p function) (if (> (length function) 4) (aref function 4)) (if (eq (car-safe function) 'autoload) (nth 2 function) (if (eq (car-safe function) 'lambda) (if (stringp (nth 2 function)) (nth 2 function) (if (stringp (nth 3 function)) (nth 3 function))))))) (if (integerp function) nil function)) (defun apropos-print (do-keys doc-fn spacing) "Output result of various apropos commands with `apropos-regexp'. APROPOS-ACCUMULATOR is a list. Optional DOC-FN is called for each element of apropos-accumulator and may modify it resulting in (symbol fn-doc var-doc [plist-doc]). Returns sorted list of symbols and documentation found." (if (null apropos-accumulator) (message "No apropos matches for `%s'" apropos-regexp) (if doc-fn (funcall doc-fn apropos-accumulator)) (setq apropos-accumulator (sort apropos-accumulator (lambda (a b) (string-lessp (car a) (car b))))) (and apropos-label-face (symbolp apropos-label-face) (setq apropos-label-face `(face ,apropos-label-face mouse-face highlight))) (with-output-to-temp-buffer "*Apropos*" (let ((p apropos-accumulator) (old-buffer (current-buffer)) symbol item point1 point2) (save-excursion (set-buffer standard-output) (if window-system (insert (substitute-command-keys "Click \\\\[apropos-mouse-follow] to get full documentation.\n"))) (insert (substitute-command-keys "In this buffer, type \\\\[apropos-follow] to get full documentation.\n\n")) (use-local-map apropos-local-map) (while (consp p) (or (not spacing) (bobp) (terpri)) (setq apropos-item (car p) symbol (car apropos-item) p (cdr p) point1 (point)) (princ symbol) ;print symbol name (setq point2 (point)) ;; don't calculate key-bindings unless needed (and do-keys (commandp symbol) (indent-to 30 1) (insert (if (setq item (save-excursion (set-buffer old-buffer) (where-is-internal symbol))) (mapconcat (if apropos-keybinding-face (lambda (key) (setq key (key-description key)) (put-text-property 0 (length key) 'face apropos-keybinding-face key) key) 'key-description) item ", ") "(not bound to any keys)"))) (terpri) ;; only now so we don't propagate text attributes all over (put-text-property point1 point2 'item (if (eval `(or ,@(cdr apropos-item))) (car apropos-item) apropos-item)) (if apropos-symbol-face (put-text-property point1 point2 'face apropos-symbol-face)) (apropos-print-doc 'describe-function 1 (if (commandp symbol) "Command" (if (apropos-macrop symbol) "Macro" "Function")) do-keys) (apropos-print-doc 'describe-variable 2 "Variable" do-keys) (apropos-print-doc 'apropos-describe-plist 3 "Plist" nil)))))) (prog1 apropos-accumulator (setq apropos-accumulator ()))) ; permit gc (defun apropos-macrop (symbol) "T if SYMBOL is a Lisp macro." (and (fboundp symbol) (consp (setq symbol (symbol-function symbol))) (or (eq (car symbol) 'macro) (if (eq (car symbol) 'autoload) (memq (nth 4 symbol) '(macro t)))))) (defun apropos-print-doc (action i str do-keys) (if (stringp (setq i (nth i apropos-item))) (progn (insert " ") (put-text-property (- (point) 2) (1- (point)) 'action action) (insert str ": ") (if apropos-label-face (add-text-properties (- (point) (length str) 2) (1- (point)) apropos-label-face)) (insert (if do-keys (substitute-command-keys i) i)) (or (bolp) (terpri))))) (defun apropos-mouse-follow (event) (interactive "e") (let ((other (if (eq (current-buffer) (get-buffer "*Help*")) () (current-buffer)))) (set-buffer (window-buffer (posn-window (event-start event)))) (goto-char (posn-point (event-start event))) ;; somehow when clicking with the point in another window, undoes badly (undo-boundary) (apropos-follow other))) (defun apropos-follow (&optional other) (interactive) (let ((point (point)) (item (or (and (not (eobp)) (get-text-property (point) 'item)) (and (not (bobp)) (get-text-property (1- (point)) 'item)))) action action-point) (if (null item) (error "There is nothing to follow here")) (if (consp item) (error "There is nothing to follow in `%s'" (car item))) (while (if (setq action-point (next-single-property-change (point) 'action)) (<= action-point point)) (goto-char (1+ action-point)) (setq action action-point)) (funcall (prog1 (get-text-property (or action action-point (point)) 'action) (if other (set-buffer other))) item))) (defun apropos-describe-plist (symbol) "Display a pretty listing of SYMBOL's plist." (with-output-to-temp-buffer "*Help*" (set-buffer standard-output) (princ "Symbol ") (prin1 symbol) (princ "'s plist is\n (") (if apropos-symbol-face (put-text-property 8 (- (point) 14) 'face apropos-symbol-face)) (insert (apropos-format-plist symbol "\n ")) (princ ")"))) ;;; apropos.el ends here emacs-19.30/lisp/arc-mode.el100444 12120 1 155100 6052010227 14114 0ustar rmsdaemon;;; arc-mode.el --- simple editing of archives ;;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Morten Welinder (terra@diku.dk) ;; Keywords: archives msdog editing major-mode ;; Favourite-brand-of-beer: None, I hate beer. ;;; 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: ;; ;; NAMING: "arc" is short for "archive" and does not refer specifically ;; to files whose name end in ".arc" ;; ;; This code does not decode any files internally, although it does ;; understand the directory level of the archives. For this reason, ;; you should expect this code to need more fiddling than tar-mode.el ;; (although it at present has fewer bugs :-) In particular, I have ;; not tested this under Ms-Dog myself. ;; ------------------------------------- ;; INTERACTION: arc-mode.el should play together with ;; ;; * ange-ftp.el: Remote archives (i.e., ones that ange-ftp has brought ;; to you) are handled by doing all updates on a local ;; copy. When you make changes to a remote file the ;; changes will first take effect when the archive buffer ;; is saved. You will be warned about this. ;; ;; * dos-fns.el: (Part of Emacs 19). You get automatic ^M^J <--> ^J ;; conversion. ;; ;; arc-mode.el does not work well with crypt++.el; for the archives as ;; such this could be fixed (but wouldn't be useful) by declaring such ;; archives to be "remote". For the members this is a general Emacs ;; problem that 19.29's file formats may fix. ;; ------------------------------------- ;; ARCHIVE TYPES: Currently only the archives below are handled, but the ;; structure for handling just about anything is in place. ;; ;; Arc Lzh Zip Zoo ;; -------------------------------- ;; View listing Intern Intern Intern Intern ;; Extract member Y Y Y Y ;; Save changed member Y Y Y Y ;; Add new member N N N N ;; Delete member Y Y Y Y ;; Rename member Y Y N N ;; Chmod - Y Y - ;; Chown - Y - - ;; Chgrp - Y - - ;; ;; Special thanks to Bill Brodie for very useful tips ;; on the first released version of this package. ;; ;; This code is partly based on tar-mode.el from Emacs. ;; ------------------------------------- ;; ARCHIVE STRUCTURES: ;; (This is mostly for myself.) ;; ;; ARC A series of (header,file). No interactions among members. ;; ;; LZH A series of (header,file). Headers are checksummed. No ;; interaction among members. ;; ;; ZIP A series of (lheader,fil) followed by a "central directory" ;; which is a series of (cheader) followed by an end-of- ;; central-dir record possibly followed by junk. The e-o-c-d ;; links to c-d. cheaders link to lheaders which are basically ;; cut-down versions of the cheaders. ;; ;; ZOO An archive header followed by a series of (header,file). ;; Each member header points to the next. The archive is ;; terminated by a bogus header with a zero next link. ;; ------------------------------------- ;; HOOKS: `foo' means one the the supported archive types. ;; ;; archive-mode-hook ;; archive-foo-mode-hook ;; archive-extract-hooks ;;; Code: ;; ------------------------------------------------------------------------- ;; Section: Configuration. (defvar archive-dos-members t "*If non-nil then recognize member files using ^M^J as line terminator.") (defvar archive-tmpdir (expand-file-name (make-temp-name (if (eq system-type 'ms-dos) "ar" "archive.tmp")) (or (getenv "TMPDIR") (getenv "TMP") "/tmp")) "*Directory for temporary files made by arc-mode.el") (defvar archive-remote-regexp "^/[^/:]*[^/:.]:" "*Regexp recognizing archive files names that are not local. A non-local file is one whose file name is not proper outside Emacs. A local copy of the archive will be used when updating.") (defvar archive-extract-hooks nil "*Hooks to run when an archive member has been extracted.") ;; ------------------------------ ;; Arc archive configuration ;; We always go via a local file since there seems to be no reliable way ;; to extract to stdout without junk getting added. (defvar archive-arc-extract '("arc" "x") "*Program and its options to run in order to extract an arc file member. Extraction should happen to the current directory. Archive and member name will be added.") (defvar archive-arc-expunge '("arc" "d") "*Program and its options to run in order to delete arc file members. Archive and member names will be added.") (defvar archive-arc-write-file-member '("arc" "u") "*Program and its options to run in order to update an arc file member. Archive and member name will be added.") ;; ------------------------------ ;; Lzh archive configuration (defvar archive-lzh-extract '("lha" "pq") "*Program and its options to run in order to extract an lzh file member. Extraction should happen to standard output. Archive and member name will be added.") (defvar archive-lzh-expunge '("lha" "d") "*Program and its options to run in order to delete lzh file members. Archive and member names will be added.") (defvar archive-lzh-write-file-member '("lha" "a") "*Program and its options to run in order to update an lzh file member. Archive and member name will be added.") ;; ------------------------------ ;; Zip archive configuration (defvar archive-zip-use-pkzip (memq system-type '(ms-dos windows-nt)) "*If non-nil then pkzip option are used instead of zip options. Only set to true for msdog systems!") (defvar archive-zip-extract (if archive-zip-use-pkzip '("pkunzip" "-e") '("unzip" "-qq" "-c")) "*Program and its options to run in order to extract a zip file member. Extraction should happen to standard output. Archive and member name will be added. If `archive-zip-use-pkzip' is non-nil then this program is expected to extract to a file junking the directory part of the name.") ;; For several reasons the latter behaviour is not desireable in general. ;; (1) It uses more disk space. (2) Error checking is worse or non- ;; existent. (3) It tends to do funny things with other systems' file ;; names. (defvar archive-zip-expunge (if archive-zip-use-pkzip '("pkzip" "-d") '("zip" "-d" "-q")) "*Program and its options to run in order to delete zip file members. Archive and member names will be added.") (defvar archive-zip-update (if archive-zip-use-pkzip '("pkzip" "-u") '("zip" "-q")) "*Program and its options to run in order to update a zip file member. Options should ensure that specified directory will be put into the zip file. Archive and member name will be added.") (defvar archive-zip-update-case (if archive-zip-use-pkzip archive-zip-update '("zip" "-q" "-k")) "*Program and its options to run in order to update a case fiddled zip member. Options should ensure that specified directory will be put into the zip file. Archive and member name will be added.") (defvar archive-zip-case-fiddle t "*If non-nil then zip file members are case fiddled. Case fiddling will only happen for members created by a system that uses caseless file names.") ;; ------------------------------ ;; Zoo archive configuration (defvar archive-zoo-extract '("zoo" "xpq") "*Program and its options to run in order to extract a zoo file member. Extraction should happen to standard output. Archive and member name will be added.") (defvar archive-zoo-expunge '("zoo" "DqPP") "*Program and its options to run in order to delete zoo file members. Archive and member names will be added.") (defvar archive-zoo-write-file-member '("zoo" "a") "*Program and its options to run in order to update a zoo file member. Archive and member name will be added.") ;; ------------------------------------------------------------------------- ;; Section: Variables (defvar archive-subtype nil "*Symbol describing archive type.") (defvar archive-file-list-start nil "*Position of first contents line.") (defvar archive-file-list-end nil "*Position just after last contents line.") (defvar archive-proper-file-start nil "*Position of real archive's start.") (defvar archive-read-only nil "*Non-nil if the archive is read-only on disk.") (defvar archive-remote nil "*Non-nil if the archive is outside file system.") (defvar archive-local-name nil "*Name of local copy of remote archive.") (defvar archive-mode-map nil "*Local keymap for archive mode listings.") (defvar archive-file-name-indent nil "*Column where file names start.") (defvar archive-alternate-display nil "*Non-nil when alternate information is shown.") (make-variable-buffer-local 'archive-alternate-display) (put 'archive-alternate-display 'permanent-local t) (defvar archive-superior-buffer nil "*In archive members, points to archive.") (put 'archive-superior-buffer 'permanent-local t) (defvar archive-subfile-mode nil "*Non-nil in archive member buffers.") (make-variable-buffer-local 'archive-subfile-mode) (put 'archive-subfile-mode 'permanent-local t) ;; buffer-file-type is a per-buffer variable in the msdog configuration (if (boundp 'buffer-file-type) nil (defvar buffer-file-type nil "*Nil for dos-style text file, non-nil otherwise.") (make-variable-buffer-local 'buffer-file-type) (put 'buffer-file-type 'permanent-local t) (setq-default buffer-file-type nil)) (defvar archive-subfile-dos nil "Negation of `buffer-file-type' which see.") (make-variable-buffer-local 'archive-subfile-dos) (put 'archive-subfile-dos 'permanent-local t) (defvar archive-files nil "Vector of file descriptors. Each descriptor is a vector of [ext-file-name int-file-name case-fiddled mode ...]") (make-variable-buffer-local 'archive-files) (defvar archive-lemacs (string-match "\\(Lucid\\|Xemacs\\)" emacs-version) "*Non-nil when running under under Lucid Emacs or Xemacs.") ;; ------------------------------------------------------------------------- ;; Section: Support functions. (defsubst archive-name (suffix) (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix))) (defun archive-l-e (str &optional len) "Convert little endian string/vector to integer. Alternatively, first argument may be a buffer position in the current buffer in which case a second argument, length, should be supplied." (if (stringp str) (setq len (length str)) (setq str (buffer-substring str (+ str len)))) (let ((result 0) (i 0)) (while (< i len) (setq i (1+ i) result (+ (ash result 8) (aref str (- len i))))) result)) (defun archive-int-to-mode (mode) "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------" (let ((str (make-string 10 ?-))) (or (zerop (logand 16384 mode)) (aset str 0 ?d)) (or (zerop (logand 8192 mode)) (aset str 0 ?c)) ; completeness (or (zerop (logand 256 mode)) (aset str 1 ?r)) (or (zerop (logand 128 mode)) (aset str 2 ?w)) (or (zerop (logand 64 mode)) (aset str 3 ?x)) (or (zerop (logand 32 mode)) (aset str 4 ?r)) (or (zerop (logand 16 mode)) (aset str 5 ?w)) (or (zerop (logand 8 mode)) (aset str 6 ?x)) (or (zerop (logand 4 mode)) (aset str 7 ?r)) (or (zerop (logand 2 mode)) (aset str 8 ?w)) (or (zerop (logand 1 mode)) (aset str 9 ?x)) (or (zerop (logand 1024 mode)) (aset str 3 (if (zerop (logand 64 mode)) ?S ?s))) (or (zerop (logand 2048 mode)) (aset str 6 (if (zerop (logand 8 mode)) ?S ?s))) str)) (defun archive-calc-mode (oldmode newmode &optional error) "From the integer OLDMODE and the string NEWMODE calculate a new file mode. NEWMODE may be an octal number including a leading zero in which case it will become the new mode.\n NEWMODE may also be a relative specification like \"og-rwx\" in which case OLDMODE will be modified accordingly just like chmod(2) would have done.\n If optional third argument ERROR is non-nil an error will be signaled if the mode is invalid. If ERROR is nil then nil will be returned." (cond ((string-match "^0[0-7]*$" newmode) (let ((result 0) (len (length newmode)) (i 1)) (while (< i len) (setq result (+ (lsh result 3) (aref newmode i) (- ?0)) i (1+ i))) (logior (logand oldmode 65024) result))) ((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode) (let ((who 0) (result oldmode) (op (aref newmode (match-beginning 2))) (bits 0) (i (match-beginning 3))) (while (< i (match-end 3)) (let ((rwx (aref newmode i))) (setq bits (logior bits (cond ((= rwx ?r) 292) ((= rwx ?w) 146) ((= rwx ?x) 73) ((= rwx ?s) 3072) ((= rwx ?t) 512))) i (1+ i)))) (while (< who (match-end 1)) (let* ((whoc (aref newmode who)) (whomask (cond ((= whoc ?a) 4095) ((= whoc ?u) 1472) ((= whoc ?g) 2104) ((= whoc ?o) 7)))) (if (= op ?=) (setq result (logand result (lognot whomask)))) (if (= op ?-) (setq result (logand result (lognot (logand whomask bits)))) (setq result (logior result (logand whomask bits))))) (setq who (1+ who))) result)) (t (if error (error "Invalid mode specification: %s" newmode))))) (defun archive-dosdate (date) "Stringify dos packed DATE record." (let ((year (+ 1980 (logand (ash date -9) 127))) (month (logand (ash date -5) 15)) (day (logand date 31))) (if (or (> month 12) (< month 1)) "" (format "%2d-%s-%d" day (aref ["Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] (1- month)) year)))) (defun archive-dostime (time) "Stringify dos packed TIME record." (let ((hour (logand (ash time -11) 31)) (minute (logand (ash time -5) 53)) (second (* 2 (logand time 31)))) ; 2 seconds resolution (format "%02d:%02d:%02d" hour minute second))) ;;(defun archive-unixdate (low high) ;; "Stringify unix (LOW HIGH) date." ;; (let ((str (current-time-string (cons high low)))) ;; (format "%s-%s-%s" ;; (substring str 8 9) ;; (substring str 4 7) ;; (substring str 20 24)))) ;;(defun archive-unixtime (low high) ;; "Stringify unix (LOW HIGH) time." ;; (let ((str (current-time-string (cons high low)))) ;; (substring str 11 19))) (defun archive-get-lineno () (if (>= (point) archive-file-list-start) (count-lines archive-file-list-start (save-excursion (beginning-of-line) (point))) 0)) (defun archive-get-descr (&optional noerror) "Return the descriptor vector for file at point. Does not signal an error if optional second argument NOERROR is non-nil." (let ((no (archive-get-lineno))) (if (and (>= (point) archive-file-list-start) (< no (length archive-files))) (let ((item (aref archive-files no))) (if (vectorp item) item (if (not noerror) (error "Entry is not a regular member of the archive")))) (if (not noerror) (error "Line does not describe a member of the archive"))))) ;; ------------------------------------------------------------------------- ;; Section: the mode definition ;;;###autoload (defun archive-mode (&optional force) "Major mode for viewing an archive file in a dired-like way. You can move around using the usual cursor motion commands. Letters no longer insert themselves. Type `e' to pull a file out of the archive and into its own buffer; or click mouse-2 on the file's line in the archive mode buffer. If you edit a sub-file of this archive (as with the `e' command) and save it, the contents of that buffer will be saved back into the archive. \\{archive-mode-map}" ;; This is not interactive because you shouldn't be turning this ;; mode on and off. You can corrupt things that way. (if (zerop (buffer-size)) ;; At present we cannot create archives from scratch (funcall default-major-mode) (if (and (not force) archive-files) nil (let* ((type (archive-find-type)) (typename (copy-sequence (symbol-name type)))) (aset typename 0 (upcase (aref typename 0))) (kill-all-local-variables) (make-local-variable 'archive-subtype) (setq archive-subtype type) ;; Buffer contains treated image of file before the file contents (make-local-variable 'revert-buffer-function) (setq revert-buffer-function 'archive-mode-revert) (auto-save-mode 0) (make-local-variable 'local-write-file-hooks) (add-hook 'local-write-file-hooks 'archive-write-file) ;; Real file contents is binary (make-local-variable 'require-final-newline) (setq require-final-newline nil) (make-local-variable 'enable-local-variables) (setq enable-local-variables nil) (setq buffer-file-type t) (make-local-variable 'archive-read-only) (setq archive-read-only (not (file-writable-p (buffer-file-name)))) ;; Should we use a local copy when accessing from outside Emacs? (make-local-variable 'archive-local-name) (make-local-variable 'archive-remote) (setq archive-remote (string-match archive-remote-regexp (buffer-file-name))) (setq major-mode 'archive-mode) (setq mode-name (concat typename "-Archive")) ;; Run archive-foo-mode-hook and archive-mode-hook (run-hooks (archive-name "mode-hook") 'archive-mode-hook) (use-local-map archive-mode-map)) (make-local-variable 'archive-proper-file-start) (make-local-variable 'archive-file-list-start) (make-local-variable 'archive-file-list-end) (make-local-variable 'archive-file-name-indent) (archive-summarize) (setq buffer-read-only t)))) ;; Archive mode is suitable only for specially formatted data. (put 'archive-mode 'mode-class 'special) ;; ------------------------------------------------------------------------- ;; Section: Key maps (if archive-mode-map nil (setq archive-mode-map (make-keymap)) (suppress-keymap archive-mode-map) (define-key archive-mode-map " " 'archive-next-line) (define-key archive-mode-map "a" 'archive-alternate-display) ;;(define-key archive-mode-map "c" 'archive-copy) (define-key archive-mode-map "d" 'archive-flag-deleted) (define-key archive-mode-map "\C-d" 'archive-flag-deleted) (define-key archive-mode-map "e" 'archive-extract) (define-key archive-mode-map "f" 'archive-extract) (define-key archive-mode-map "\C-m" 'archive-extract) (define-key archive-mode-map "g" 'revert-buffer) (define-key archive-mode-map "h" 'describe-mode) (define-key archive-mode-map "m" 'archive-mark) (define-key archive-mode-map "n" 'archive-next-line) (define-key archive-mode-map "\C-n" 'archive-next-line) (define-key archive-mode-map [down] 'archive-next-line) (define-key archive-mode-map "o" 'archive-extract-other-window) (define-key archive-mode-map "p" 'archive-previous-line) (define-key archive-mode-map "\C-p" 'archive-previous-line) (define-key archive-mode-map [up] 'archive-previous-line) (define-key archive-mode-map "r" 'archive-rename-entry) (define-key archive-mode-map "u" 'archive-unflag) (define-key archive-mode-map "\M-\C-?" 'archive-unmark-all-files) (define-key archive-mode-map "v" 'archive-view) (define-key archive-mode-map "x" 'archive-expunge) (define-key archive-mode-map "\177" 'archive-unflag-backwards) (define-key archive-mode-map "E" 'archive-extract-other-window) (define-key archive-mode-map "M" 'archive-chmod-entry) (define-key archive-mode-map "G" 'archive-chgrp-entry) (define-key archive-mode-map "O" 'archive-chown-entry) (if archive-lemacs (progn ;; Not a nice "solution" but it'll have to do (define-key archive-mode-map "\C-xu" 'archive-undo) (define-key archive-mode-map "\C-_" 'archive-undo)) (substitute-key-definition 'undo 'archive-undo archive-mode-map global-map)) (define-key archive-mode-map (if archive-lemacs 'button2 [mouse-2]) 'archive-mouse-extract) (if archive-lemacs () ; out of luck ;; Get rid of the Edit menu bar item to save space. (define-key archive-mode-map [menu-bar edit] 'undefined) (define-key archive-mode-map [menu-bar immediate] (cons "Immediate" (make-sparse-keymap "Immediate"))) (define-key archive-mode-map [menu-bar immediate alternate] '("Alternate Display" . archive-alternate-display)) (put 'archive-alternate-display 'menu-enable '(boundp (archive-name "alternate-display"))) (define-key archive-mode-map [menu-bar immediate view] '("View This File" . archive-view)) (define-key archive-mode-map [menu-bar immediate display] '("Display in Other Window" . archive-display-other-window)) (define-key archive-mode-map [menu-bar immediate find-file-other-window] '("Find in Other Window" . archive-extract-other-window)) (define-key archive-mode-map [menu-bar immediate find-file] '("Find This File" . archive-extract)) (define-key archive-mode-map [menu-bar mark] (cons "Mark" (make-sparse-keymap "Mark"))) (define-key archive-mode-map [menu-bar mark unmark-all] '("Unmark All" . archive-unmark-all-files)) (define-key archive-mode-map [menu-bar mark deletion] '("Flag" . archive-flag-deleted)) (define-key archive-mode-map [menu-bar mark unmark] '("Unflag" . archive-unflag)) (define-key archive-mode-map [menu-bar mark mark] '("Mark" . archive-mark)) (define-key archive-mode-map [menu-bar operate] (cons "Operate" (make-sparse-keymap "Operate"))) (define-key archive-mode-map [menu-bar operate chown] '("Change Owner..." . archive-chown-entry)) (put 'archive-chown-entry 'menu-enable '(fboundp (archive-name "chown-entry"))) (define-key archive-mode-map [menu-bar operate chgrp] '("Change Group..." . archive-chgrp-entry)) (put 'archive-chgrp-entry 'menu-enable '(fboundp (archive-name "chgrp-entry"))) (define-key archive-mode-map [menu-bar operate chmod] '("Change Mode..." . archive-chmod-entry)) (put 'archive-chmod-entry 'menu-enable '(fboundp (archive-name "chmod-entry"))) (define-key archive-mode-map [menu-bar operate rename] '("Rename to..." . archive-rename-entry)) (put 'archive-rename-entry 'menu-enable '(fboundp (archive-name "rename-entry"))) ;;(define-key archive-mode-map [menu-bar operate copy] ;; '("Copy to..." . archive-copy)) (define-key archive-mode-map [menu-bar operate expunge] '("Expunge Marked Files" . archive-expunge)) )) (let* ((item1 '(archive-subfile-mode " Archive")) (item2 '(archive-subfile-dos " Dos")) (items (if (memq system-type '(ms-dos windows-nt)) (list item1) ; msdog has its own indicator (list item1 item2)))) (or (member item1 minor-mode-alist) (setq minor-mode-alist (append items minor-mode-alist)))) ;; ------------------------------------------------------------------------- (defun archive-find-type () (widen) (goto-char (point-min)) ;; The funny [] here make it unlikely that the .elc file will be treated ;; as an archive by other software. (let (case-fold-search) (cond ((looking-at "[P]K\003\004") 'zip) ((looking-at "..-l[hz][0-9]-") 'lzh) ((looking-at "....................[\334]\247\304\375") 'zoo) ((and (looking-at "\C-z") ; signature too simple, IMHO (string-match "\\.[aA][rR][cC]$" (or buffer-file-name (buffer-name)))) 'arc) (t (error "Buffer format not recognized."))))) ;; ------------------------------------------------------------------------- (defun archive-summarize () "Parse the contents of the archive file in the current buffer. Place a dired-like listing on the front; then narrow to it, so that only that listing is visible (and the real data of the buffer is hidden)." (widen) (let (buffer-read-only) (message "Parsing archive file...") (buffer-disable-undo (current-buffer)) (setq archive-files (funcall (archive-name "summarize"))) (message "Parsing archive file...done.") (setq archive-proper-file-start (point-marker)) (narrow-to-region (point-min) (point)) (set-buffer-modified-p nil) (buffer-enable-undo)) (goto-char archive-file-list-start) (archive-next-line 0)) (defun archive-resummarize () "Recreate the contents listing of an archive." (let ((modified (buffer-modified-p)) (no (archive-get-lineno)) buffer-read-only) (widen) (delete-region (point-min) archive-proper-file-start) (archive-summarize) (set-buffer-modified-p modified) (goto-char archive-file-list-start) (archive-next-line no))) (defun archive-summarize-files (files) "Insert a desciption of a list of files annotated with proper mouse face" (setq archive-file-list-start (point-marker)) (setq archive-file-name-indent (if files (aref (car files) 1) 0)) ;; We don't want to do an insert for each element since that takes too ;; long when the archive -- which has to be moved in memory -- is large. (insert (apply (function concat) (mapcar (function (lambda (fil) ;; Using `concat' here copies the text also, so we can add ;; properties without problems. (let ((text (concat (aref fil 0) "\n"))) (if archive-lemacs () ; out of luck (put-text-property (aref fil 1) (aref fil 2) 'mouse-face 'highlight text)) text))) files))) (setq archive-file-list-end (point-marker))) (defun archive-alternate-display () "Toggle alternative display. To avoid very long lines some archive mode don't show all information. This function changes the set of information shown for each files." (interactive) (setq archive-alternate-display (not archive-alternate-display)) (archive-resummarize)) ;; ------------------------------------------------------------------------- ;; Section: Local archive copy handling (defun archive-maybe-copy (archive) (if archive-remote (let ((start (point-max))) (setq archive-local-name (expand-file-name (file-name-nondirectory archive) archive-tmpdir)) (make-directory archive-tmpdir t) (save-restriction (widen) (write-region start (point-max) archive-local-name nil 'nomessage)) archive-local-name) (if (buffer-modified-p) (save-buffer)) archive)) (defun archive-maybe-update (unchanged) (if archive-remote (let ((name archive-local-name) (modified (buffer-modified-p)) buffer-read-only) (if unchanged nil (erase-buffer) (insert-file-contents name) (archive-mode t)) (archive-delete-local name) (if (not unchanged) (message "Archive file must be saved for changes to take effect")) (set-buffer-modified-p (or modified (not unchanged)))))) (defun archive-delete-local (name) "Delete file NAME and its parents up to and including `archive-tmpdir'." (let ((again t) (top (directory-file-name (file-name-as-directory archive-tmpdir)))) (condition-case nil (delete-file name) (error nil)) (while again (setq name (directory-file-name (file-name-directory name))) (condition-case nil (delete-directory name) (error nil)) (if (string= name top) (setq again nil))))) ;; ------------------------------------------------------------------------- ;; Section: Member extraction (defun archive-mouse-extract (event) "Extract a file whose name you click on." (interactive "e") (mouse-set-point event) (switch-to-buffer (save-excursion (archive-extract) (current-buffer)))) (defun archive-extract (&optional other-window-p) "In archive mode, extract this entry of the archive into its own buffer." (interactive) (let* ((view-p (eq other-window-p 'view)) (descr (archive-get-descr)) (ename (aref descr 0)) (iname (aref descr 1)) (archive-buffer (current-buffer)) (arcdir default-directory) (archive (buffer-file-name)) (arcname (file-name-nondirectory archive)) (bufname (concat (file-name-nondirectory iname) " (" arcname ")")) (extractor (archive-name "extract")) (read-only-p (or archive-read-only view-p)) (buffer (get-buffer bufname)) (just-created nil)) (if buffer nil (setq archive (archive-maybe-copy archive)) (setq buffer (get-buffer-create bufname)) (setq just-created t) (save-excursion (set-buffer buffer) (setq buffer-file-name (expand-file-name (concat arcname ":" iname))) (setq buffer-file-truename (abbreviate-file-name buffer-file-name)) ;; Set the default-directory to the dir of the superior buffer. (setq default-directory arcdir) (make-local-variable 'archive-superior-buffer) (setq archive-superior-buffer archive-buffer) (make-local-variable 'local-write-file-hooks) (add-hook 'local-write-file-hooks 'archive-write-file-member) (setq archive-subfile-mode descr) (setq archive-subfile-dos nil buffer-file-type t) (if (fboundp extractor) (funcall extractor archive ename) (archive-*-extract archive ename (symbol-value extractor))) (if archive-dos-members (archive-check-dos)) (goto-char (point-min)) (rename-buffer bufname) (setq buffer-read-only read-only-p) (setq buffer-undo-list nil) (set-buffer-modified-p nil) (setq buffer-saved-size (buffer-size)) (normal-mode) ;; Just in case an archive occurs inside another archive. (if (eq major-mode 'archive-mode) (setq archive-remote t)) (run-hooks 'archive-extract-hooks)) (archive-maybe-update t)) (if view-p (progn (view-buffer buffer) (and just-created (setq view-exit-action 'kill-buffer))) (if (eq other-window-p 'display) (display-buffer buffer) (if other-window-p (switch-to-buffer-other-window buffer) (switch-to-buffer buffer)))))) (defun archive-*-extract (archive name command) (let* ((default-directory (file-name-as-directory archive-tmpdir)) (tmpfile (expand-file-name (file-name-nondirectory name) default-directory))) (make-directory (directory-file-name default-directory) t) (apply 'call-process (car command) nil nil nil (append (cdr command) (list archive name))) (insert-file-contents tmpfile) (archive-delete-local tmpfile))) (defun archive-extract-by-stdout (archive name command) (let ((binary-process-output t)) ; for Ms-Dos (apply 'call-process (car command) nil t nil (append (cdr command) (list archive name))))) (defun archive-extract-other-window () "In archive mode, find this member in another window." (interactive) (archive-extract t)) (defun archive-display-other-window () "In archive mode, display this member in another window." (interactive) (archive-extract 'display)) (defun archive-view () "In archive mode, view the member on this line." (interactive) (archive-extract 'view)) (defun archive-add-new-member (arcbuf name) "Add current buffer to the archive in ARCBUF naming it NAME." (interactive (list (get-buffer (read-buffer "Buffer containing archive: " ;; Find first archive buffer and suggest that (let ((bufs (buffer-list))) (while (and bufs (not (eq (save-excursion (set-buffer (car bufs)) major-mode) 'archive-mode))) (setq bufs (cdr bufs))) (if bufs (car bufs) (error "There are no archive buffers"))) t)) (read-string "File name in archive: " (if buffer-file-name (file-name-nondirectory buffer-file-name) "")))) (save-excursion (set-buffer arcbuf) (or (eq major-mode 'archive-mode) (error "Buffer is not an archive buffer")) (if archive-read-only (error "Archive is read-only"))) (if (eq arcbuf (current-buffer)) (error "An archive buffer cannot be added to itself")) (if (string= name "") (error "Archive members may not be given empty names")) (let ((func (save-excursion (set-buffer arcbuf) (archive-name "add-new-member"))) (membuf (current-buffer))) (if (fboundp func) (save-excursion (set-buffer arcbuf) (funcall func buffer-file-name membuf name)) (error "Adding a new member is not supported for this archive type")))) ;; ------------------------------------------------------------------------- ;; Section: IO stuff (defun archive-check-dos (&optional force) "*Possibly handle a buffer with ^M^J terminated lines." (save-restriction (widen) (save-excursion (goto-char (point-min)) (setq archive-subfile-dos (or force (not (search-forward-regexp "[^\r]\n" nil t)))) (setq buffer-file-type (not archive-subfile-dos)) (if archive-subfile-dos (let ((modified (buffer-modified-p))) (buffer-disable-undo (current-buffer)) (goto-char (point-min)) (while (search-forward "\r\n" nil t) (replace-match "\n")) (buffer-enable-undo) (set-buffer-modified-p modified)))))) (defun archive-write-file-member () (if archive-subfile-dos (save-restriction (widen) (save-excursion (goto-char (point-min)) ;; We don't want our ^M^J <--> ^J changes to show in the undo list (let ((undo-list buffer-undo-list)) (unwind-protect (progn (setq buffer-undo-list t) (while (search-forward "\n" nil t) (replace-match "\r\n")) (setq archive-subfile-dos nil) (setq buffer-file-type t) ;; OK, we're now have explicit ^M^Js -- save and re-unixfy (archive-write-file-member)) (progn (archive-check-dos t) (setq buffer-undo-list undo-list)))) t)) (save-excursion (save-restriction (message "Updating archive...") (widen) (let ((writer (save-excursion (set-buffer archive-superior-buffer) (archive-name "write-file-member"))) (archive (save-excursion (set-buffer archive-superior-buffer) (buffer-file-name)))) (if (fboundp writer) (funcall writer archive archive-subfile-mode) (archive-*-write-file-member archive archive-subfile-mode (symbol-value writer)))) (set-buffer-modified-p nil) (message "Updating archive...done") (set-buffer archive-superior-buffer) (revert-buffer) t)))) (defun archive-*-write-file-member (archive descr command) (let* ((ename (aref descr 0)) (tmpfile (expand-file-name ename archive-tmpdir)) (top (directory-file-name (file-name-as-directory archive-tmpdir))) (default-directory (file-name-as-directory top))) (unwind-protect (progn (make-directory (file-name-directory tmpfile) t) (write-region (point-min) (point-max) tmpfile nil 'nomessage) (if (aref descr 3) ;; Set the file modes, but make sure we can read it. (set-file-modes tmpfile (logior ?\400 (aref descr 3)))) (let ((exitcode (apply 'call-process (car command) nil nil nil (append (cdr command) (list archive ename))))) (if (equal exitcode 0) nil (error "Updating was unsuccessful (%S)" exitcode)))) (archive-delete-local tmpfile)))) (defun archive-write-file () (save-excursion (write-region archive-proper-file-start (point-max) buffer-file-name nil t) (set-buffer-modified-p nil) t)) ;; ------------------------------------------------------------------------- ;; Section: Marking and unmarking. (defun archive-flag-deleted (p &optional type) "In archive mode, mark this member to be deleted from the archive. With a prefix argument, mark that many files." (interactive "p") (or type (setq type ?D)) (beginning-of-line) (let ((sign (if (>= p 0) +1 -1)) (modified (buffer-modified-p)) buffer-read-only) (while (not (zerop p)) (if (archive-get-descr t) (progn (delete-char 1) (insert type))) (forward-line sign) (setq p (- p sign))) (set-buffer-modified-p modified)) (archive-next-line 0)) (defun archive-unflag (p) "In archive mode, un-mark this member if it is marked to be deleted. With a prefix argument, un-mark that many files forward." (interactive "p") (archive-flag-deleted p ? )) (defun archive-unflag-backwards (p) "In archive mode, un-mark this member if it is marked to be deleted. With a prefix argument, un-mark that many members backward." (interactive "p") (archive-flag-deleted (- p) ? )) (defun archive-unmark-all-files () "Remove all marks." (interactive) (let ((modified (buffer-modified-p)) buffer-read-only) (save-excursion (goto-char archive-file-list-start) (while (< (point) archive-file-list-end) (or (= (following-char) ? ) (progn (delete-char 1) (insert ? ))) (forward-line 1))) (set-buffer-modified-p modified))) (defun archive-mark (p) "In archive mode, mark this member for group operations. With a prefix argument, mark that many members. Use \\[archive-unmark-all-files] to remove all marks." (interactive "p") (archive-flag-deleted p ?*)) (defun archive-get-marked (mark &optional default) (let (files) (save-excursion (goto-char archive-file-list-start) (while (< (point) archive-file-list-end) (if (= (following-char) mark) (setq files (cons (archive-get-descr) files))) (forward-line 1))) (or (nreverse files) (and default (list (archive-get-descr)))))) ;; ------------------------------------------------------------------------- ;; Section: Operate (defun archive-next-line (p) (interactive "p") (forward-line p) (or (eobp) (forward-char archive-file-name-indent))) (defun archive-previous-line (p) (interactive "p") (archive-next-line (- p))) (defun archive-chmod-entry (new-mode) "Change the protection bits associated with all marked or this member. The new protection bits can either be specified as an octal number or as a relative change like \"g+rw\" as for chmod(2)" (interactive "sNew mode (octal or relative): ") (if archive-read-only (error "Archive is read-only")) (let ((func (archive-name "chmod-entry"))) (if (fboundp func) (progn (funcall func new-mode (archive-get-marked ?* t)) (archive-resummarize)) (error "Setting mode bits is not supported for this archive type")))) (defun archive-chown-entry (new-uid) "Change the owner of all marked or this member." (interactive "nNew uid: ") (if archive-read-only (error "Archive is read-only")) (let ((func (archive-name "chown-entry"))) (if (fboundp func) (progn (funcall func new-uid (archive-get-marked ?* t)) (archive-resummarize)) (error "Setting owner is not supported for this archive type")))) (defun archive-chgrp-entry (new-gid) "Change the group of all marked or this member." (interactive "nNew gid: ") (if archive-read-only (error "Archive is read-only")) (let ((func (archive-name "chgrp-entry"))) (if (fboundp func) (progn (funcall func new-gid (archive-get-marked ?* t)) (archive-resummarize)) (error "Setting group is not supported for this archive type")))) (defun archive-expunge () "Do the flagged deletions." (interactive) (let (files) (save-excursion (goto-char archive-file-list-start) (while (< (point) archive-file-list-end) (if (= (following-char) ?D) (setq files (cons (aref (archive-get-descr) 0) files))) (forward-line 1))) (setq files (nreverse files)) (and files (or (not archive-read-only) (error "Archive is read-only")) (or (yes-or-no-p (format "Really delete %d member%s? " (length files) (if (null (cdr files)) "" "s"))) (error "Operation aborted")) (let ((archive (archive-maybe-copy (buffer-file-name))) (expunger (archive-name "expunge"))) (if (fboundp expunger) (funcall expunger archive files) (archive-*-expunge archive files (symbol-value expunger))) (archive-maybe-update nil) (if archive-remote (archive-resummarize) (revert-buffer)))))) (defun archive-*-expunge (archive files command) (apply 'call-process (car command) nil nil nil (append (cdr command) (cons archive files)))) (defun archive-rename-entry (newname) "Change the name associated with this entry in the tar file." (interactive "sNew name: ") (if archive-read-only (error "Archive is read-only")) (if (string= newname "") (error "Archive members may not be given empty names")) (let ((func (archive-name "rename-entry")) (descr (archive-get-descr))) (if (fboundp func) (progn (funcall func (buffer-file-name) newname descr) (archive-resummarize)) (error "Renaming is not supported for this archive type")))) ;; Revert the buffer and recompute the dired-like listing. (defun archive-mode-revert (&optional no-autosave no-confirm) (let ((no (archive-get-lineno))) (setq archive-files nil) (let ((revert-buffer-function nil)) (revert-buffer t t)) (archive-mode) (goto-char archive-file-list-start) (archive-next-line no))) (defun archive-undo () "Undo in an archive buffer. This doesn't recover lost files, it just undoes changes in the buffer itself." (interactive) (let (buffer-read-only) (undo))) ;; ------------------------------------------------------------------------- ;; Section: Arc Archives (defun archive-arc-summarize () (let ((p 1) (totalsize 0) (maxlen 8) files visual) (while (and (< (+ p 29) (point-max)) (= (char-after p) ?\C-z) (> (char-after (1+ p)) 0)) (let* ((namefld (buffer-substring (+ p 2) (+ p 2 13))) (fnlen (or (string-match "\0" namefld) 13)) (efnname (substring namefld 0 fnlen)) (csize (archive-l-e (+ p 15) 4)) (moddate (archive-l-e (+ p 19) 2)) (modtime (archive-l-e (+ p 21) 2)) (ucsize (archive-l-e (+ p 25) 4)) (fiddle (string= efnname (upcase efnname))) (ifnname (if fiddle (downcase efnname) efnname)) (text (format " %8d %-11s %-8s %s" ucsize (archive-dosdate moddate) (archive-dostime modtime) ifnname))) (setq maxlen (max maxlen fnlen) totalsize (+ totalsize ucsize) visual (cons (vector text (- (length text) (length ifnname)) (length text)) visual) files (cons (vector efnname ifnname fiddle nil (1- p)) files) p (+ p 29 csize)))) (goto-char (point-min)) (let ((dash (concat "- -------- ----------- -------- " (make-string maxlen ?-) "\n"))) (insert "M Length Date Time File\n" dash) (archive-summarize-files (nreverse visual)) (insert dash (format " %8d %d file%s" totalsize (length files) (if (= 1 (length files)) "" "s")) "\n")) (apply 'vector (nreverse files)))) (defun archive-arc-rename-entry (archive newname descr) (if (string-match "[:\\\\/]" newname) (error "File names in arc files may not contain a path")) (if (> (length newname) 12) (error "File names in arc files are limited to 12 characters")) (let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0" (length newname)))) buffer-read-only) (save-restriction (save-excursion (widen) (goto-char (+ archive-proper-file-start (aref descr 4) 2)) (delete-char 13) (insert name))))) ;; ------------------------------------------------------------------------- ;; Section: Lzh Archives (defun archive-lzh-summarize () (let ((p 1) (totalsize 0) (maxlen 8) files visual) (while (progn (goto-char p) (looking-at "..-l[hz][0-9]-")) (let* ((hsize (char-after p)) (csize (archive-l-e (+ p 7) 4)) (ucsize (archive-l-e (+ p 11) 4)) (modtime (archive-l-e (+ p 15) 2)) (moddate (archive-l-e (+ p 17) 2)) (fnlen (char-after (+ p 21))) (efnname (buffer-substring (+ p 22) (+ p 22 fnlen))) (fiddle (string= efnname (upcase efnname))) (ifnname (if fiddle (downcase efnname) efnname)) (p2 (+ p 22 fnlen)) (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0)) (mode (if (= creator ?U) (archive-l-e (+ p2 8) 2) ?\666)) (modestr (if mode (archive-int-to-mode mode) "??????????")) (uid (if (= creator ?U) (archive-l-e (+ p2 10) 2))) (gid (if (= creator ?U) (archive-l-e (+ p2 12) 2))) (text (if archive-alternate-display (format " %8d %5S %5S %s" ucsize (or uid "?") (or gid "?") ifnname) (format " %10s %8d %-11s %-8s %s" modestr ucsize (archive-dosdate moddate) (archive-dostime modtime) ifnname)))) (setq maxlen (max maxlen fnlen) totalsize (+ totalsize ucsize) visual (cons (vector text (- (length text) (length ifnname)) (length text)) visual) files (cons (vector efnname ifnname fiddle mode (1- p)) files) p (+ p hsize 2 csize)))) (goto-char (point-min)) (let ((dash (concat (if archive-alternate-display "- -------- ----- ----- " "- ---------- -------- ----------- -------- ") (make-string maxlen ?-) "\n")) (header (if archive-alternate-display "M Length Uid Gid File\n" "M Filemode Length Date Time File\n")) (sumline (if archive-alternate-display " %8d %d file%s" " %8d %d file%s"))) (insert header dash) (archive-summarize-files (nreverse visual)) (insert dash (format sumline totalsize (length files) (if (= 1 (length files)) "" "s")) "\n")) (apply 'vector (nreverse files)))) (defconst archive-lzh-alternate-display t) (defun archive-lzh-extract (archive name) (archive-extract-by-stdout archive name archive-lzh-extract)) (defun archive-lzh-resum (p count) (let ((sum 0)) (while (> count 0) (setq count (1- count) sum (+ sum (char-after p)) p (1+ p))) (logand sum 255))) (defun archive-lzh-rename-entry (archive newname descr) (save-restriction (save-excursion (widen) (let* ((p (+ archive-proper-file-start (aref descr 4))) (oldhsize (char-after p)) (oldfnlen (char-after (+ p 21))) (newfnlen (length newname)) (newhsize (+ oldhsize newfnlen (- oldfnlen))) buffer-read-only) (if (> newhsize 255) (error "The file name is too long")) (goto-char (+ p 21)) (delete-char (1+ oldfnlen)) (insert newfnlen newname) (goto-char p) (delete-char 2) (insert newhsize (archive-lzh-resum p newhsize)))))) (defun archive-lzh-ogm (newval files errtxt ofs) (save-restriction (save-excursion (widen) (while files (let* ((fil (car files)) (p (+ archive-proper-file-start (aref fil 4))) (hsize (char-after p)) (fnlen (char-after (+ p 21))) (p2 (+ p 22 fnlen)) (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0)) buffer-read-only) (if (= creator ?U) (progn (or (numberp newval) (setq newval (funcall newval (archive-l-e (+ p2 ofs) 2)))) (goto-char (+ p2 ofs)) (delete-char 2) (insert (logand newval 255) (lsh newval -8)) (goto-char (1+ p)) (delete-char 1) (insert (archive-lzh-resum (1+ p) hsize))) (message "Member %s does not have %s field" (aref fil 1) errtxt))) (setq files (cdr files)))))) (defun archive-lzh-chown-entry (newuid files) (archive-lzh-ogm newuid files "an uid" 10)) (defun archive-lzh-chgrp-entry (newgid files) (archive-lzh-ogm newgid files "a gid" 12)) (defun archive-lzh-chmod-entry (newmode files) (archive-lzh-ogm ;; This should work even though newmode will be dynamically accessed. (function (lambda (old) (archive-calc-mode old newmode t))) files "a unix-style mode" 8)) ;; ------------------------------------------------------------------------- ;; Section: Zip Archives (defun archive-zip-summarize () (goto-char (- (point-max) (- 22 18))) (search-backward-regexp "[P]K\005\006") (let ((p (1+ (archive-l-e (+ (point) 16) 4))) (maxlen 8) (totalsize 0) files visual) (while (string= "PK\001\002" (buffer-substring p (+ p 4))) (let* ((creator (char-after (+ p 5))) (method (archive-l-e (+ p 10) 2)) (modtime (archive-l-e (+ p 12) 2)) (moddate (archive-l-e (+ p 14) 2)) (ucsize (archive-l-e (+ p 24) 4)) (fnlen (archive-l-e (+ p 28) 2)) (exlen (archive-l-e (+ p 30) 2)) (fclen (archive-l-e (+ p 32) 2)) (lheader (archive-l-e (+ p 42) 4)) (efnname (buffer-substring (+ p 46) (+ p 46 fnlen))) (isdir (and (= ucsize 0) (string= (file-name-nondirectory efnname) ""))) (mode (cond ((memq creator '(2 3)) ; Unix + VMS (archive-l-e (+ p 40) 2)) ((memq creator '(0 5 6 7 10 11)) ; Dos etc. (logior ?\444 (if isdir (logior 16384 ?\111) 0) (if (zerop (logand 1 (char-after (+ p 38)))) ?\222 0))) (t nil))) (modestr (if mode (archive-int-to-mode mode) "??????????")) (fiddle (and archive-zip-case-fiddle (not (not (memq creator '(0 2 4 5 9)))))) (ifnname (if fiddle (downcase efnname) efnname)) (text (format " %10s %8d %-11s %-8s %s" modestr ucsize (archive-dosdate moddate) (archive-dostime modtime) ifnname))) (setq maxlen (max maxlen fnlen) totalsize (+ totalsize ucsize) visual (cons (vector text (- (length text) (length ifnname)) (length text)) visual) files (cons (if isdir nil (vector efnname ifnname fiddle mode (list (1- p) lheader))) files) p (+ p 46 fnlen exlen fclen)))) (goto-char (point-min)) (let ((dash (concat "- ---------- -------- ----------- -------- " (make-string maxlen ?-) "\n"))) (insert "M Filemode Length Date Time File\n" dash) (archive-summarize-files (nreverse visual)) (insert dash (format " %8d %d file%s" totalsize (length files) (if (= 1 (length files)) "" "s")) "\n")) (apply 'vector (nreverse files)))) (defun archive-zip-extract (archive name) (if archive-zip-use-pkzip (archive-*-extract archive name archive-zip-extract) (archive-extract-by-stdout archive name archive-zip-extract))) (defun archive-zip-write-file-member (archive descr) (archive-*-write-file-member archive descr (if (aref descr 2) archive-zip-update-case archive-zip-update))) (defun archive-zip-chmod-entry (newmode files) (save-restriction (save-excursion (widen) (while files (let* ((fil (car files)) (p (+ archive-proper-file-start (car (aref fil 4)))) (creator (char-after (+ p 5))) (oldmode (aref fil 3)) (newval (archive-calc-mode oldmode newmode t)) buffer-read-only) (cond ((memq creator '(2 3)) ; Unix + VMS (goto-char (+ p 40)) (delete-char 2) (insert (logand newval 255) (lsh newval -8))) ((memq creator '(0 5 6 7 10 11)) ; Dos etc. (goto-char (+ p 38)) (insert (logior (logand (char-after (point)) 254) (logand (logxor 1 (lsh newval -7)) 1))) (delete-char 1)) (t (message "Don't know how to change mode for this member")))) (setq files (cdr files)))))) ;; ------------------------------------------------------------------------- ;; Section: Zoo Archives (defun archive-zoo-summarize () (let ((p (1+ (archive-l-e 25 4))) (maxlen 8) (totalsize 0) files visual) (while (and (string= "\334\247\304\375" (buffer-substring p (+ p 4))) (> (archive-l-e (+ p 6) 4) 0)) (let* ((next (1+ (archive-l-e (+ p 6) 4))) (moddate (archive-l-e (+ p 14) 2)) (modtime (archive-l-e (+ p 16) 2)) (ucsize (archive-l-e (+ p 20) 4)) (namefld (buffer-substring (+ p 38) (+ p 38 13))) (dirtype (char-after (+ p 4))) (lfnlen (if (= dirtype 2) (char-after (+ p 56)) 0)) (ldirlen (if (= dirtype 2) (char-after (+ p 57)) 0)) (fnlen (+ ldirlen (if (> lfnlen 0) (1- lfnlen) (or (string-match "\0" namefld) 13)))) (efnname (concat (if (> ldirlen 0) (concat (buffer-substring (+ p 58 lfnlen) (+ p 58 lfnlen ldirlen -1)) "/") "") (if (> lfnlen 0) (buffer-substring (+ p 58) (+ p 58 lfnlen -1)) (substring namefld 0 fnlen)))) (fiddle (and (= lfnlen 0) (string= efnname (upcase efnname)))) (ifnname (if fiddle (downcase efnname) efnname)) (text (format " %8d %-11s %-8s %s" ucsize (archive-dosdate moddate) (archive-dostime modtime) ifnname))) (setq maxlen (max maxlen fnlen) totalsize (+ totalsize ucsize) visual (cons (vector text (- (length text) (length ifnname)) (length text)) visual) files (cons (vector efnname ifnname fiddle nil (1- p)) files) p next))) (goto-char (point-min)) (let ((dash (concat "- -------- ----------- -------- " (make-string maxlen ?-) "\n"))) (insert "M Length Date Time File\n" dash) (archive-summarize-files (nreverse visual)) (insert dash (format " %8d %d file%s" totalsize (length files) (if (= 1 (length files)) "" "s")) "\n")) (apply 'vector (nreverse files)))) (defun archive-zoo-extract (archive name) (archive-extract-by-stdout archive name archive-zoo-extract)) ;; ------------------------------------------------------------------------- (provide 'archive-mode) ;; arc-mode.el ends here. emacs-19.30/lisp/array.el100444 12120 1 103105 6054174431 13553 0ustar rmsdaemon;;; array.el --- array editing commands for Gnu Emacs ;; Copyright (C) 1987 Free Software Foundation, Inc. ;; Author David M. Brown ;; Maintainer: FSF ;; Keywords: extensions ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 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: ;; Commands for editing a buffer interpreted as a rectangular array ;; or matrix of whitespace-separated strings. You specify the array ;; dimensions and some other parameters at startup time. ;; Written by dmb%morgoth@harvard.harvard.edu (address is old) ;; (David M. Brown at Goldberg-Zoino & Associates, Inc.) ;; Thanks to cph@kleph.ai.mit.edu for assistance ;; To do: ;; Smooth initialization process by grokking local variables list ;; at end of buffer or parsing buffer using whitespace as delimiters. ;; Make 'array-copy-column-right faster. ;;; Code: ;;; Internal information functions. (defun array-cursor-in-array-range () "Returns t if the cursor is in a valid array cell. Its ok to be on a row number line." (let ((columns-last-line (% max-column columns-per-line))) ;; Requires buffer-line and buffer-column to be current. (not (or ;; The cursor is too far to the right. (>= buffer-column line-length) ;; The cursor is below the last row. (>= buffer-line (* lines-per-row max-row)) ;; The cursor is on the last line of the row, the line is smaller ;; than the others, and the cursor is after the last array column ;; on the line. (and (zerop (% (1+ buffer-line) lines-per-row)) (not (zerop columns-last-line)) (>= buffer-column (* columns-last-line field-width))))))) (defun array-current-row () "Return the array row of the field in which the cursor is located." ;; Requires buffer-line and buffer-column to be current. (and (array-cursor-in-array-range) (1+ (floor buffer-line lines-per-row)))) (defun array-current-column () "Return the array column of the field in which the cursor is located." ;; Requires buffer-line and buffer-column to be current. (and (array-cursor-in-array-range) ;; It's not okay to be on a row number line. (not (and rows-numbered (zerop (% buffer-line lines-per-row)))) (+ ;; Array columns due to line differences. (* columns-per-line (if rows-numbered (1- (% buffer-line lines-per-row)) (% buffer-line lines-per-row))) ;; Array columns on the current line. (1+ (floor buffer-column field-width))))) (defun array-update-array-position (&optional a-row a-column) "Set `array-row' and `array-column' to their current values or to the optional arguments A-ROW and A-COLUMN." ;; Requires that buffer-line and buffer-column be current. (setq array-row (or a-row (array-current-row)) array-column (or a-column (array-current-column)))) (defun array-update-buffer-position () "Set buffer-line and buffer-column to their current values." (setq buffer-line (current-line) buffer-column (current-column))) ;;; Information commands. (defun array-what-position () "Display the row and column in which the cursor is positioned." (interactive) (let ((buffer-line (current-line)) (buffer-column (current-column))) (message (format "Array row: %s Array column: %s" (prin1-to-string (array-current-row)) (prin1-to-string (array-current-column)))))) (defun array-display-local-variables () "Display the current state of the local variables in the minibuffer." (interactive) (let ((buf (buffer-name (current-buffer)))) (with-output-to-temp-buffer "*Local Variables*" (buffer-disable-undo standard-output) (terpri) (princ (format " Buffer: %s\n\n" buf)) (princ (format " max-row: %s\n" (prin1-to-string max-row))) (princ (format " max-column: %s\n" (prin1-to-string max-column))) (princ (format " columns-per-line: %s\n" (prin1-to-string columns-per-line))) (princ (format " field-width: %s\n" (prin1-to-string field-width))) (princ (format " rows-numbered: %s\n" (prin1-to-string rows-numbered))) (princ (format " lines-per-row: %s\n" (prin1-to-string lines-per-row))) (princ (format " line-length: %s\n" (prin1-to-string line-length)))))) ;;; Internal movement functions. (defun array-beginning-of-field (&optional go-there) "Return the column of the beginning of the current field. Optional argument GO-THERE, if non-nil, means go there too." ;; Requires that buffer-column be current. (let ((goal-column (- buffer-column (% buffer-column field-width)))) (if go-there (move-to-column-untabify goal-column) goal-column))) (defun array-end-of-field (&optional go-there) "Return the column of the end of the current array field. If optional argument GO-THERE is non-nil, go there too." ;; Requires that buffer-column be current. (let ((goal-column (+ (- buffer-column (% buffer-column field-width)) field-width))) (if go-there (move-to-column-untabify goal-column) goal-column))) (defun array-move-to-cell (a-row a-column) "Move to array row A-ROW and array column A-COLUMN. Leave point at the beginning of the field and return the new buffer column." (let ((goal-line (+ (* lines-per-row (1- a-row)) (if rows-numbered 1 0) (floor (1- a-column) columns-per-line))) (goal-column (* field-width (% (1- a-column) columns-per-line)))) (goto-char (point-min)) (forward-line goal-line) (move-to-column-untabify goal-column))) (defun array-move-to-row (a-row) "Move to array row A-ROW preserving the current array column. Leave point at the beginning of the field and return the new array row." ;; Requires that buffer-line and buffer-column be current. (let ((goal-line (+ (* lines-per-row (1- a-row)) (% buffer-line lines-per-row))) (goal-column (- buffer-column (% buffer-column field-width)))) (forward-line (- goal-line buffer-line)) (move-to-column-untabify goal-column) a-row)) (defun array-move-to-column (a-column) "Move to array column A-COLUMN preserving the current array row. Leave point at the beginning of the field and return the new array column." ;; Requires that buffer-line and buffer-column be current. (let ((goal-line (+ (- buffer-line (% buffer-line lines-per-row)) (if rows-numbered 1 0) (floor (1- a-column) columns-per-line))) (goal-column (* field-width (% (1- a-column) columns-per-line)))) (forward-line (- goal-line buffer-line)) (move-to-column-untabify goal-column) a-column)) (defun array-move-one-row (sign) "Move one array row in direction SIGN (1 or -1). Leave point at the beginning of the field and return the new array row. If requested to move beyond the array bounds, signal an error." ;; Requires that buffer-line and buffer-column be current. (let ((goal-column (array-beginning-of-field)) (array-row (or (array-current-row) (error "Cursor is not in a valid array cell.")))) (cond ((and (= array-row max-row) (= sign 1)) (error "End of array.")) ((and (= array-row 1) (= sign -1)) (error "Beginning of array.")) (t (progn (forward-line (* sign lines-per-row)) (move-to-column-untabify goal-column) (+ array-row sign)))))) (defun array-move-one-column (sign) "Move one array column in direction SIGN (1 or -1). Leave point at the beginning of the field and return the new array column. If requested to move beyond the array bounds, signal an error." ;; Requires that buffer-line and buffer-column be current. (let ((array-column (or (array-current-column) (error "Cursor is not in a valid array cell.")))) (cond ((and (= array-column max-column) (= sign 1)) (error "End of array.")) ((and (= array-column 1) (= sign -1)) (error "Beginning of array.")) (t (cond ;; Going backward from first column on the line. ((and (= sign -1) (= 1 (% array-column columns-per-line))) (forward-line -1) (move-to-column-untabify (* field-width (1- columns-per-line)))) ;; Going forward from last column on the line. ((and (= sign 1) (zerop (% array-column columns-per-line))) (forward-line 1)) ;; Somewhere in the middle of the line. (t (move-to-column-untabify (+ (array-beginning-of-field) (* field-width sign))))) (+ array-column sign))))) (defun array-normalize-cursor () "Move the cursor to the first non-whitespace character in the field and, if necessary, scroll horizontally to keep the cursor in view." ;; Assumes point is at the beginning of the field. (let ((buffer-column (current-column))) (skip-chars-forward " \t" (1- (save-excursion (array-end-of-field t) (point)))) (array-maybe-scroll-horizontally))) (defun array-maybe-scroll-horizontally () "If necessary, scroll horizontally to keep the cursor in view." ;; This is only called from array-normalize-cursor so ;; buffer-column will always be current. (let ((w-hscroll (window-hscroll)) (w-width (window-width))) (cond ((and (>= buffer-column w-hscroll) (<= buffer-column (+ w-hscroll w-width))) ;; It's already visible. Do nothing. nil) ((> buffer-column (+ w-hscroll w-width)) ;; It's to the right. Scroll left. (scroll-left (- (- buffer-column w-hscroll) (/ w-width 2)))) (t ;; It's to the left. Scroll right. (scroll-right (+ (- w-hscroll buffer-column) (/ w-width 2))))))) ;;; Movement commands. (defun array-next-row (&optional arg) "Move down one array row, staying in the current array column. If optional ARG is given, move down ARG array rows." (interactive "p") (let ((buffer-line (current-line)) (buffer-column (current-column))) (if (= (abs arg) 1) (array-move-one-row arg) (array-move-to-row (limit-index (+ (or (array-current-row) (error "Cursor is not in an array cell.")) arg) max-row)))) (array-normalize-cursor)) (defun array-previous-row (&optional arg) "Move up one array row, staying in the current array column. If optional ARG is given, move up ARG array rows." (interactive "p") (array-next-row (- arg))) (defun array-forward-column (&optional arg) "Move forward one field, staying in the current array row. If optional ARG is given, move forward ARG array columns. If necessary, keep the cursor in the window by scrolling right or left." (interactive "p") (let ((buffer-line (current-line)) (buffer-column (current-column))) (if (= (abs arg) 1) (array-move-one-column arg) (array-move-to-column (limit-index (+ (or (array-current-column) (error "Cursor is not in an array cell.")) arg) max-column)))) (array-normalize-cursor)) (defun array-backward-column (&optional arg) "Move backward one field, staying in the current array row. If optional ARG is given, move backward ARG array columns. If necessary, keep the cursor in the window by scrolling right or left." (interactive "p") (array-forward-column (- arg))) (defun array-goto-cell (a-row a-column) "Go to array row A-ROW and array column A-COLUMN." (interactive "nArray row: \nnArray column: ") (array-move-to-cell (limit-index a-row max-row) (limit-index a-column max-column)) (array-normalize-cursor)) ;;; Internal copying functions. (defun array-field-string () "Return the field string at the current cursor location." ;; Requires that buffer-column be current. (buffer-substring (save-excursion (array-beginning-of-field t) (point)) (save-excursion (array-end-of-field t) (point)))) (defun array-copy-once-vertically (sign) "Copy the current field into one array row in direction SIGN (1 or -1). Leave point at the beginning of the field and return the new array row. If requested to move beyond the array bounds, signal an error." ;; Requires that buffer-line, buffer-column, and copy-string be current. (let ((a-row (array-move-one-row sign))) (let ((inhibit-quit t)) (delete-region (point) (save-excursion (array-end-of-field t) (point))) (insert copy-string)) (move-to-column buffer-column) a-row)) (defun array-copy-once-horizontally (sign) "Copy the current field into one array column in direction SIGN (1 or -1). Leave point at the beginning of the field and return the new array column. If requested to move beyond the array bounds, signal an error." ;; Requires that buffer-line, buffer-column, and copy-string be current. (let ((a-column (array-move-one-column sign))) (array-update-buffer-position) (let ((inhibit-quit t)) (delete-region (point) (save-excursion (array-end-of-field t) (point))) (insert copy-string)) (move-to-column buffer-column) a-column)) (defun array-copy-to-row (a-row) "Copy the current field vertically into every cell up to and including A-ROW. Leave point at the beginning of the field." ;; Requires that buffer-line, buffer-column, array-row, and ;; copy-string be current. (let* ((num (- a-row array-row)) (count (abs num)) (sign (if (zerop count) () (/ num count)))) (while (> count 0) (array-move-one-row sign) (array-update-buffer-position) (let ((inhibit-quit t)) (delete-region (point) (save-excursion (array-end-of-field t) (point))) (insert copy-string)) (move-to-column buffer-column) (setq count (1- count))))) (defun array-copy-to-column (a-column) "Copy the current field horizontally into every cell up to and including A-COLUMN. Leave point at the beginning of the field." ;; Requires that buffer-line, buffer-column, array-column, and ;; copy-string be current. (let* ((num (- a-column array-column)) (count (abs num)) (sign (if (zerop count) () (/ num count)))) (while (> count 0) (array-move-one-column sign) (array-update-buffer-position) (let ((inhibit-quit t)) (delete-region (point) (save-excursion (array-end-of-field t) (point))) (insert copy-string)) (move-to-column buffer-column) (setq count (1- count))))) (defun array-copy-to-cell (a-row a-column) "Copy the current field into the cell at A-ROW, A-COLUMN. Leave point at the beginning of the field." ;; Requires that copy-string be current. (array-move-to-cell a-row a-column) (array-update-buffer-position) (delete-region (point) (save-excursion (array-end-of-field t) (point))) (insert copy-string) (move-to-column buffer-column)) ;;; Commands for copying. (defun array-copy-down (&optional arg) "Copy the current field one array row down. If optional ARG is given, copy down through ARG array rows." (interactive "p") (let* ((buffer-line (current-line)) (buffer-column (current-column)) (array-row (or (array-current-row) (error "Cursor is not in a valid array cell."))) (copy-string (array-field-string))) (if (= (abs arg) 1) (array-copy-once-vertically arg) (array-copy-to-row (limit-index (+ array-row arg) max-row)))) (array-normalize-cursor)) (defun array-copy-up (&optional arg) "Copy the current field one array row up. If optional ARG is given, copy up through ARG array rows." (interactive "p") (array-copy-down (- arg))) (defun array-copy-forward (&optional arg) "Copy the current field one array column to the right. If optional ARG is given, copy through ARG array columns to the right." (interactive "p") (let* ((buffer-line (current-line)) (buffer-column (current-column)) (array-column (or (array-current-column) (error "Cursor is not in a valid array cell."))) (copy-string (array-field-string))) (if (= (abs arg) 1) (array-copy-once-horizontally arg) (array-copy-to-column (limit-index (+ array-column arg) max-column)))) (array-normalize-cursor)) (defun array-copy-backward (&optional arg) "Copy the current field one array column to the left. If optional ARG is given, copy through ARG array columns to the left." (interactive "p") (array-copy-forward (- arg))) (defun array-copy-column-forward (&optional arg) "Copy the entire current column in to the column to the right. If optional ARG is given, copy through ARG array columns to the right." (interactive "p") (array-update-buffer-position) (array-update-array-position) (if (not array-column) (error "Cursor is not in a valid array cell.")) (message "Working...") (let ((this-row 0)) (while (< this-row max-row) (setq this-row (1+ this-row)) (array-move-to-cell this-row array-column) (array-update-buffer-position) (let ((copy-string (array-field-string))) (if (= (abs arg) 1) (array-copy-once-horizontally arg) (array-copy-to-column (limit-index (+ array-column arg) max-column)))))) (message "Working...done") (array-move-to-row array-row) (array-normalize-cursor)) (defun array-copy-column-backward (&optional arg) "Copy the entire current column one column to the left. If optional ARG is given, copy through ARG columns to the left." (interactive "p") (array-copy-column-forward (- arg))) (defun array-copy-row-down (&optional arg) "Copy the entire current row one row down. If optional ARG is given, copy through ARG rows down." (interactive "p") (array-update-buffer-position) (array-update-array-position) (if (not array-row) (error "Cursor is not in a valid array cell.")) (cond ((and (= array-row 1) (= arg -1)) (error "Beginning of array.")) ((and (= array-row max-row) (= arg 1)) (error "End of array.")) (t (let* ((copy-string (buffer-substring (save-excursion (array-move-to-cell array-row 1) (point)) (save-excursion (array-move-to-cell array-row max-column) (forward-line 1) (point)))) (this-row array-row) (goal-row (limit-index (+ this-row arg) max-row)) (num (- goal-row this-row)) (count (abs num)) (sign (if (not (zerop count)) (/ num count)))) (while (> count 0) (setq this-row (+ this-row sign)) (array-move-to-cell this-row 1) (let ((inhibit-quit t)) (delete-region (point) (save-excursion (array-move-to-cell this-row max-column) (forward-line 1) (point))) (insert copy-string)) (setq count (1- count))) (array-move-to-cell goal-row (or array-column 1))))) (array-normalize-cursor)) (defun array-copy-row-up (&optional arg) "Copy the entire current array row into the row above. If optional ARG is given, copy through ARG rows up." (interactive "p") (array-copy-row-down (- arg))) (defun array-fill-rectangle () "Copy the field at mark into every cell between mark and point." (interactive) ;; Bind arguments. (array-update-buffer-position) (let ((p-row (or (array-current-row) (error "Cursor is not in a valid array cell."))) (p-column (or (array-current-column) (error "Cursor is not in a valid array cell."))) (m-row (save-excursion (exchange-point-and-mark) (array-update-buffer-position) (or (array-current-row) (error "Mark is not in a valid array cell.")))) (m-column (save-excursion (exchange-point-and-mark) (array-update-buffer-position) (or (array-current-column) (error "Mark is not in a valid array cell."))))) (message "Working...") (let ((top-row (min m-row p-row)) (bottom-row (max m-row p-row)) (left-column (min m-column p-column)) (right-column (max m-column p-column))) ;; Do the first row. (let ((copy-string (save-excursion (array-move-to-cell m-row m-column) (array-update-buffer-position) (array-field-string)))) (array-copy-to-cell top-row left-column) (array-update-array-position top-row left-column) (array-update-buffer-position) (array-copy-to-column right-column)) ;; Do the rest of the rows. (array-move-to-cell top-row left-column) (let ((copy-string (buffer-substring (point) (save-excursion (array-move-to-cell top-row right-column) (setq buffer-column (current-column)) (array-end-of-field t) (point)))) (this-row top-row)) (while (/= this-row bottom-row) (setq this-row (1+ this-row)) (array-move-to-cell this-row left-column) (let ((inhibit-quit t)) (delete-region (point) (save-excursion (array-move-to-cell this-row right-column) (setq buffer-column (current-column)) (array-end-of-field t) (point))) (insert copy-string))))) (message "Working...done") (array-goto-cell p-row p-column))) ;;; Reconfiguration of the array. (defun array-make-template () "Create the template of an array." (interactive) ;; If there is a conflict between field-width and init-string, resolve it. (let ((check t) (len)) (while check (setq init-field (read-input "Initial field value: ")) (setq len (length init-field)) (if (/= len field-width) (if (y-or-n-p (format "Change field width to %d? " len)) (progn (setq field-width len) (setq check nil))) (setq check nil)))) (goto-char (point-min)) (message "Working...") (let ((this-row 1)) ;; Loop through the rows. (while (<= this-row max-row) (if rows-numbered (insert (format "%d:\n" this-row))) (let ((this-column 1)) ;; Loop through the columns. (while (<= this-column max-column) (insert init-field) (if (and (zerop (% this-column columns-per-line)) (/= this-column max-column)) (newline)) (setq this-column (1+ this-column)))) (setq this-row (1+ this-row)) (newline))) (message "Working...done") (array-goto-cell 1 1)) (defun array-reconfigure-rows (new-columns-per-line new-rows-numbered) "Reconfigure the state of `rows-numbered' and `columns-per-line'. NEW-COLUMNS-PER-LINE is the desired value of `columns-per-line' and NEW-ROWS-NUMBERED (a character, either ?y or ?n) is the desired value of rows-numbered." (interactive "nColumns per line: \ncRows numbered? (y or n) ") ;; Check on new-columns-per-line (let ((check t)) (while check (if (and (>= new-columns-per-line 1) (<= new-columns-per-line max-column)) (setq check nil) (setq new-columns-per-line (string-to-int (read-input (format "Columns per line (1 - %d): " max-column))))))) ;; Check on new-rows-numbered. It has to be done this way ;; because interactive does not have y-or-n-p. (cond ((eq new-rows-numbered ?y) (setq new-rows-numbered t)) ((eq new-rows-numbered ?n) (setq new-rows-numbered nil)) (t (setq new-rows-numbered (y-or-n-p "Rows numbered? ")))) (message "Working...") (array-update-buffer-position) (let* ((main-buffer (buffer-name (current-buffer))) (temp-buffer (make-temp-name "Array")) (temp-max-row max-row) (temp-max-column max-column) (old-rows-numbered rows-numbered) (old-columns-per-line columns-per-line) (old-lines-per-row lines-per-row) (old-field-width field-width) (old-line-length line-length) (this-row 1)) (array-update-array-position) ;; Do the cutting in a temporary buffer. (copy-to-buffer temp-buffer (point-min) (point-max)) (set-buffer temp-buffer) (goto-char (point-min)) (while (<= this-row temp-max-row) ;; Deal with row number. (cond ((or (and old-rows-numbered new-rows-numbered) (and (not old-rows-numbered) (not new-rows-numbered))) ;; Nothing is changed. ()) ((and old-rows-numbered (not new-rows-numbered)) ;; Delete the row number. (kill-line 1)) (t ;; Add the row number. (insert-string (format "%d:\n" this-row)))) ;; Deal with the array columns in this row. (cond ((= old-columns-per-line new-columns-per-line) ;; Nothing is changed. Go to the next row. (forward-line (- old-lines-per-row (if old-rows-numbered 1 0)))) (t ;; First expand the row. Then cut it up into new pieces. (let ((newlines-to-be-removed (floor (1- temp-max-column) old-columns-per-line)) (newlines-removed 0) (newlines-to-be-added (floor (1- temp-max-column) new-columns-per-line)) (newlines-added 0)) (while (< newlines-removed newlines-to-be-removed) (move-to-column-untabify (* (1+ newlines-removed) old-line-length)) (kill-line 1) (setq newlines-removed (1+ newlines-removed))) (beginning-of-line) (while (< newlines-added newlines-to-be-added) (move-to-column-untabify (* old-field-width new-columns-per-line)) (newline) (setq newlines-added (1+ newlines-added))) (forward-line 1)))) (setq this-row (1+ this-row))) (let ((inhibit-quit t)) (set-buffer main-buffer) (erase-buffer) (insert-buffer temp-buffer) ;; Update local variables. (setq columns-per-line new-columns-per-line) (setq rows-numbered new-rows-numbered) (setq line-length (* old-field-width new-columns-per-line)) (setq lines-per-row (+ (floor (1- temp-max-column) new-columns-per-line) (if new-rows-numbered 2 1))) (array-goto-cell (or array-row 1) (or array-column 1))) (kill-buffer temp-buffer)) (message "Working...done")) (defun array-expand-rows () "Expand the rows so each fits on one line and remove row numbers." (interactive) (array-reconfigure-rows max-column ?n)) ;;; Utilities. (defun limit-index (index limit) (cond ((< index 1) 1) ((> index limit) limit) (t index))) (defun xor (pred1 pred2) "Returns the logical exclusive or of predicates PRED1 and PRED2." (and (or pred1 pred2) (not (and pred1 pred2)))) (defun current-line () "Return the current buffer line at point. The first line is 0." (save-excursion (beginning-of-line) (count-lines (point-min) (point)))) (defun move-to-column-untabify (column) "Move to COLUMN on the current line, untabifying if necessary. Return COLUMN." (or (and (= column (move-to-column column)) column) ;; There is a tab in the way. (if respect-tabs (error "There is a TAB character in the way.") (progn (untabify-backward) (move-to-column column))))) (defun untabify-backward () "Untabify the preceding tab." (save-excursion (let ((start (point))) (backward-char 1) (untabify (point) start)))) ;;; Array mode. (defvar array-mode-map nil "Keymap used in array mode.") (if array-mode-map () (setq array-mode-map (make-keymap)) ;; Bind keys. (define-key array-mode-map "\M-ad" 'array-display-local-variables) (define-key array-mode-map "\M-am" 'array-make-template) (define-key array-mode-map "\M-ae" 'array-expand-rows) (define-key array-mode-map "\M-ar" 'array-reconfigure-rows) (define-key array-mode-map "\M-a=" 'array-what-position) (define-key array-mode-map "\M-ag" 'array-goto-cell) (define-key array-mode-map "\M-af" 'array-fill-rectangle) (define-key array-mode-map "\C-n" 'array-next-row) (define-key array-mode-map "\C-p" 'array-previous-row) (define-key array-mode-map "\C-f" 'array-forward-column) (define-key array-mode-map "\C-b" 'array-backward-column) (define-key array-mode-map "\M-n" 'array-copy-down) (define-key array-mode-map "\M-p" 'array-copy-up) (define-key array-mode-map "\M-f" 'array-copy-forward) (define-key array-mode-map "\M-b" 'array-copy-backward) (define-key array-mode-map "\M-\C-n" 'array-copy-row-down) (define-key array-mode-map "\M-\C-p" 'array-copy-row-up) (define-key array-mode-map "\M-\C-f" 'array-copy-column-forward) (define-key array-mode-map "\M-\C-b" 'array-copy-column-backward)) (put 'array-mode 'mode-class 'special) (defun array-mode () "Major mode for editing arrays. Array mode is a specialized mode for editing arrays. An array is considered to be a two-dimensional set of strings. The strings are NOT recognized as integers or real numbers. The array MUST reside at the top of the buffer. TABs are not respected, and may be converted into spaces at any time. Setting the variable 'respect-tabs to non-nil will prevent TAB conversion, but will cause many functions to give errors if they encounter one. Upon entering array mode, you will be prompted for the values of several variables. Others will be calculated based on the values you supply. These variables are all local the the buffer. Other buffer in array mode may have different values assigned to the variables. The variables are: Variables you assign: max-row: The number of rows in the array. max-column: The number of columns in the array. columns-per-line: The number of columns in the array per line of buffer. field-width: The width of each field, in characters. rows-numbered: A logical variable describing whether to ignore row numbers in the buffer. Variables which are calculated: line-length: The number of characters in a buffer line. lines-per-row: The number of buffer lines used to display each row. The following commands are available (an asterisk indicates it may take a numeric prefix argument): * \\\\[array-forward-column] Move forward one column. * \\[array-backward-column] Move backward one column. * \\[array-next-row] Move down one row. * \\[array-previous-row] Move up one row. * \\[array-copy-forward] Copy the current field into the column to the right. * \\[array-copy-backward] Copy the current field into the column to the left. * \\[array-copy-down] Copy the current field into the row below. * \\[array-copy-up] Copy the current field into the row above. * \\[array-copy-column-forward] Copy the current column into the column to the right. * \\[array-copy-column-backward] Copy the current column into the column to the left. * \\[array-copy-row-down] Copy the current row into the row below. * \\[array-copy-row-up] Copy the current row into the row above. \\[array-fill-rectangle] Copy the field at mark into every cell with row and column between that of point and mark. \\[array-what-position] Display the current array row and column. \\[array-goto-cell] Go to a particular array cell. \\[array-make-template] Make a template for a new array. \\[array-reconfigure-rows] Reconfigure the array. \\[array-expand-rows] Expand the array (remove row numbers and newlines inside rows) \\[array-display-local-variables] Display the current values of local variables. Entering array mode calls the function `array-mode-hook'." (interactive) ;; Number of rows in the array. (make-local-variable 'max-row) ;; Number of columns in the array. (make-local-variable 'max-column) ;; Number of array columns per line. (make-local-variable 'columns-per-line) ;; Width of a field in the array. (make-local-variable 'field-width) ;; Are rows numbered in the buffer? (make-local-variable 'rows-numbered) ;; Length of a line in the array. (make-local-variable 'line-length) ;; Number of lines per array row. (make-local-variable 'lines-per-row) ;; Current line number of point in the buffer. (make-local-variable 'buffer-line) ;; Current column number of point in the buffer. (make-local-variable 'buffer-column) ;; Current array row location of point. (make-local-variable 'array-row) ;; Current array column location of point. (make-local-variable 'array-column) ;; Current field string being copied. (make-local-variable 'copy-string) ;; Should TAB conversion be prevented? (make-local-variable 'respect-tabs) (setq respect-tabs nil) (array-init-local-variables) (setq major-mode 'array-mode) (setq mode-name "Array") (force-mode-line-update) (make-variable-buffer-local 'truncate-lines) (setq truncate-lines t) (setq overwrite-mode 'overwrite-mode-textual) (use-local-map array-mode-map) (run-hooks 'array-mode-hook)) ;;; Initialization functions. These are not interactive. (defun array-init-local-variables () "Initialize the variables associated with the array in this buffer." (array-init-max-row) (array-init-max-column) (array-init-columns-per-line) (array-init-field-width) (array-init-rows-numbered) (array-init-line-length) (array-init-lines-per-row) (message "")) (defun array-init-max-row (&optional arg) "Initialize the value of max-row." (setq max-row (or arg (string-to-int (read-input "Number of array rows: "))))) (defun array-init-max-column (&optional arg) "Initialize the value of max-column." (setq max-column (or arg (string-to-int (read-input "Number of array columns: "))))) (defun array-init-columns-per-line (&optional arg) "Initialize the value of columns-per-line." (setq columns-per-line (or arg (string-to-int (read-input "Array columns per line: "))))) (defun array-init-field-width (&optional arg) "Initialize the value of field-width." (setq field-width (or arg (string-to-int (read-input "Field width: "))))) (defun array-init-rows-numbered (&optional arg) "Initialize the value of rows-numbered." (setq rows-numbered (or arg (y-or-n-p "Rows numbered? ")))) (defun array-init-line-length (&optional arg) "Initialize the value of line-length." (setq line-length (or arg (* field-width columns-per-line)))) (defun array-init-lines-per-row (&optional arg) "Initialize the value of lines-per-row." (setq lines-per-row (or arg (+ (floor (1- max-column) columns-per-line) (if rows-numbered 2 1))))) ;;; array.el ends here emacs-19.30/lisp/asm-mode.el100444 12120 1 17031 5734360167 14130 0ustar rmsdaemon;;; asm-mode.el --- mode for editing assembler code ;; Copyright (C) 1991 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Maintainer: FSF ;; Keywords: tools, languages ;; 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 mode was written by Eric S. Raymond , ;; inspired by an earlier asm-mode by Martin Neitzel. ;; This minor mode is based on text mode. It defines a private abbrev table ;; that can be used to save abbrevs for assembler mnemonics. It binds just ;; five keys: ;; ;; TAB tab to next tab stop ;; : outdent preceding label, tab to tab stop ;; comment char place or move comment ;; asm-comment-char specifies which character this is; ;; you can use a different character in different ;; Asm mode buffers. ;; C-j, C-m newline and tab to tab stop ;; ;; Code is indented to the first tab stop level. ;; This mode runs two hooks: ;; 1) An asm-mode-set-comment-hook before the part of the initialization ;; depending on asm-comment-char, and ;; 2) an asm-mode-hook at the end of initialization. ;;; Code: (defvar asm-comment-char ?; "*The comment-start character assumed by Asm mode.") (defvar asm-mode-syntax-table nil "Syntax table used while in Asm mode.") (defvar asm-mode-abbrev-table nil "Abbrev table used while in Asm mode.") (define-abbrev-table 'asm-mode-abbrev-table ()) (defvar asm-mode-map nil "Keymap for Asm mode.") (if asm-mode-map nil (setq asm-mode-map (make-sparse-keymap)) ;; Note that the comment character isn't set up until asm-mode is called. (define-key asm-mode-map ":" 'asm-colon) (define-key asm-mode-map "\C-i" 'tab-to-tab-stop) (define-key asm-mode-map "\C-j" 'asm-newline) (define-key asm-mode-map "\C-m" 'asm-newline) ) (defconst asm-font-lock-keywords '(("^\\(\\(\\sw\\|\\s_\\)+\\)\\>:?[ \t]*\\(\\sw+\\)?" (1 font-lock-function-name-face) (3 font-lock-keyword-face nil t)) ("^\\s +\\(\\(\\sw\\|\\s_\\)+\\)" 1 font-lock-keyword-face)) "Additional expressions to highlight in Assembler mode.") (defvar asm-code-level-empty-comment-pattern nil) (defvar asm-flush-left-empty-comment-pattern nil) (defvar asm-inline-empty-comment-pattern nil) ;;;###autoload (defun asm-mode () "Major mode for editing typical assembler code. Features a private abbrev table and the following bindings: \\[asm-colon]\toutdent a preceding label, tab to next tab stop. \\[tab-to-tab-stop]\ttab to next tab stop. \\[asm-newline]\tnewline, then tab to next tab stop. \\[asm-comment]\tsmart placement of assembler comments. The character used for making comments is set by the variable `asm-comment-char' (which defaults to `?;'). Alternatively, you may set this variable in `asm-mode-set-comment-hook', which is called near the beginning of mode initialization. Turning on Asm mode runs the hook `asm-mode-hook' at the end of initialization. Special commands: \\{asm-mode-map} " (interactive) (kill-all-local-variables) (setq mode-name "Assembler") (setq major-mode 'asm-mode) (setq local-abbrev-table asm-mode-abbrev-table) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(asm-font-lock-keywords)) (make-local-variable 'asm-mode-syntax-table) (setq asm-mode-syntax-table (make-syntax-table)) (set-syntax-table asm-mode-syntax-table) (run-hooks 'asm-mode-set-comment-hook) ;; Make our own local child of asm-mode-map ;; so we can define our own comment character. (use-local-map (nconc (make-sparse-keymap) asm-mode-map)) (local-set-key (vector asm-comment-char) 'asm-comment) (modify-syntax-entry asm-comment-char "<" asm-mode-syntax-table) (modify-syntax-entry ?\n ">" asm-mode-syntax-table) (let ((cs (regexp-quote (char-to-string asm-comment-char)))) (make-local-variable 'comment-start) (setq comment-start (concat cs " ")) (make-local-variable 'comment-start-skip) (setq comment-start-skip (concat cs "+[ \t]*")) (setq asm-inline-empty-comment-pattern (concat "^.+" cs "+ *$")) (setq asm-code-level-empty-comment-pattern (concat "^[\t ]+" cs cs " *$")) (setq asm-flush-left-empty-comment-pattern (concat "^" cs cs cs " *$")) ) (make-local-variable 'comment-end) (setq comment-end "") (make-local-variable 'comment-column) (setq comment-column 32) (setq fill-prefix "\t") (run-hooks 'asm-mode-hook)) (defun asm-colon () "Insert a colon; if it follows a label, delete the label's indentation." (interactive) (save-excursion (beginning-of-line) (if (looking-at "[ \t]+\\(\\sw\\|\\s_\\)+$") (delete-horizontal-space))) (insert ":") (tab-to-tab-stop) ) (defun asm-newline () "Insert LFD + fill-prefix, to bring us back to code-indent level." (interactive) (if (eolp) (delete-horizontal-space)) (insert "\n") (tab-to-tab-stop) ) (defun asm-line-matches (pattern &optional withcomment) (save-excursion (beginning-of-line) (looking-at pattern))) (defun asm-pop-comment-level () ;; Delete an empty comment ending current line. Then set up for a new one, ;; on the current line if it was all comment, otherwise above it (end-of-line) (delete-horizontal-space) (while (= (preceding-char) asm-comment-char) (delete-backward-char 1)) (delete-horizontal-space) (if (bolp) nil (beginning-of-line) (open-line 1)) ) (defun asm-comment () "Convert an empty comment to a `larger' kind, or start a new one. These are the known comment classes: 1 -- comment to the right of the code (at the comment-column) 2 -- comment on its own line, indented like code 3 -- comment on its own line, beginning at the left-most column. Suggested usage: while writing your code, trigger asm-comment repeatedly until you are satisfied with the kind of comment." (interactive) (cond ;; Blank line? Then start comment at code indent level. ((asm-line-matches "^[ \t]*$") (delete-horizontal-space) (tab-to-tab-stop) (insert asm-comment-char comment-start)) ;; Nonblank line with no comment chars in it? ;; Then start a comment at the current comment column ((asm-line-matches (format "^[^%c\n]+$" asm-comment-char)) (indent-for-comment)) ;; Flush-left comment present? Just insert character. ((asm-line-matches asm-flush-left-empty-comment-pattern) (insert asm-comment-char)) ;; Empty code-level comment already present? ;; Then start flush-left comment, on line above if this one is nonempty. ((asm-line-matches asm-code-level-empty-comment-pattern) (asm-pop-comment-level) (insert asm-comment-char asm-comment-char comment-start)) ;; Empty comment ends line? ;; Then make code-level comment, on line above if this one is nonempty. ((asm-line-matches asm-inline-empty-comment-pattern) (asm-pop-comment-level) (tab-to-tab-stop) (insert asm-comment-char comment-start)) ;; If all else fails, insert character (t (insert asm-comment-char)) ) (end-of-line)) ;;; asm-mode.el ends here emacs-19.30/lisp/assoc.el100444 13437 1 11544 5421163035 13661 0ustar jimbdaemon;;; assoc.el --- insert/delete/sort functions on association lists ;; Author: Barry A. Warsaw ;; Keywords: extensions ;; This software is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY. No author or distributor accepts ;; responsibility to anyone for the consequences of using it or for ;; whether it serves any particular purpose or works at all, unless he ;; says so in writing. ;; This software was written as part of the supercite author's ;; official duty as an employee of the United States Government and is ;; thus in the public domain. You are free to use that particular ;; software as you wish, but WITHOUT ANY WARRANTY WHATSOEVER. It ;; would be nice, though if when you use any of this code, you give ;; due credit to the author. ;;; Commentary: ;; Association list utilities providing insertion, deletion, sorting ;; fetching off key-value pairs in association lists. ;;; 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 head is one matching KEY. Returns the sorted list and doesn't affect the order of any other key-value pair. Side effect sets alist to new sorted list." (set alist-symbol (sort (copy-alist (eval alist-symbol)) (function (lambda (a b) (equal (car a) key)))))) (defun aelement (key value) "Makes a list of a cons cell containing car of KEY and cdr of VALUE. The returned list is suitable as an element of an alist." (list (cons key value))) (defun aheadsym (alist) "Return the key symbol at the head of ALIST." (car (car alist))) (defun anot-head-p (alist key) "Find out if a specified key-value pair is not at the head of an alist. The alist to check is specified by ALIST and the key-value pair is the one matching the supplied KEY. Returns nil if ALIST is nil, or if key-value pair is at the head of the alist. Returns t if key-value pair is not at the head of alist. ALIST is not altered." (not (equal (aheadsym alist) key))) (defun aput (alist-symbol key &optional value) "Inserts a key-value pair into an alist. The alist is referenced by ALIST-SYMBOL. The key-value pair is made from KEY and optionally, VALUE. Returns the altered alist or nil if ALIST is nil. If the key-value pair referenced by KEY can be found in the alist, and VALUE is supplied non-nil, then the value of KEY will be set to VALUE. If VALUE is not supplied, or is nil, the key-value pair will not be modified, but will be moved to the head of the alist. If the key-value pair cannot be found in the alist, it will be inserted into the head of the alist (with value nil if VALUE is nil or not supplied)." (let ((elem (aelement key value)) alist) (asort alist-symbol key) (setq alist (eval alist-symbol)) (cond ((null alist) (set alist-symbol elem)) ((anot-head-p alist key) (set alist-symbol (nconc elem alist))) (value (setcar alist (car elem))) (t alist)))) (defun adelete (alist-symbol key) "Delete a key-value pair from the alist. Alist is referenced by ALIST-SYMBOL and the key-value pair to remove is pair matching KEY. Returns the altered alist." (asort alist-symbol key) (let ((alist (eval alist-symbol))) (cond ((null alist) nil) ((anot-head-p alist key) alist) (t (set alist-symbol (cdr alist)))))) (defun aget (alist key &optional keynil-p) "Returns the value in ALIST that is associated with KEY. Optional KEYNIL-P describes what to do if the value associated with KEY is nil. If KEYNIL-P is not supplied or is nil, and the value is nil, then KEY is returned. If KEYNIL-P is non-nil, then nil would be returned. If no key-value pair matching KEY could be found in ALIST, or ALIST is nil then nil is returned. ALIST is not altered." (let ((copy (copy-alist alist))) (cond ((null alist) nil) ((progn (asort 'copy key) (anot-head-p copy key)) nil) ((cdr (car copy))) (keynil-p nil) ((car (car copy))) (t nil)))) (defun amake (alist-symbol keylist &optional valuelist) "Make an association list. The association list is attached to the alist referenced by ALIST-SYMBOL. Each element in the KEYLIST becomes a key and is associated with the value in VALUELIST with the same index. If VALUELIST is not supplied or is nil, then each key in KEYLIST is associated with nil. KEYLIST and VALUELIST should have the same number of elements, but this isn't enforced. If VALUELIST is smaller than KEYLIST, remaining keys are associated with nil. If VALUELIST is larger than KEYLIST, extra values are ignored. Returns the created alist." (let ((keycar (car keylist)) (keycdr (cdr keylist)) (valcar (car valuelist)) (valcdr (cdr valuelist))) (cond ((null keycdr) (aput alist-symbol keycar valcar)) (t (amake alist-symbol keycdr valcdr) (aput alist-symbol keycar valcar)))) (eval alist-symbol)) (provide 'assoc) ;;; assoc.el ends here emacs-19.30/lisp/auto-show.el100444 12120 1 7543 6045200727 14332 0ustar rmsdaemon;;; auto-show.el --- perform automatic horizontal scrolling as point moves ;;; This file is in the public domain. ;;; Keywords: scroll display minor-mode ;;; Author: Pete Ware ;;; Maintainer: FSF ;;; Commentary: ;;; This file provides functions that ;;; automatically scroll the window horizontally when the point moves ;;; off the left or right side of the window. ;;; Once this library is loaded, automatic horizontal scrolling ;;; occurs whenever long lines are being truncated. ;;; To request truncation of long lines, set the variable ;;; Setting the variable `truncate-lines' to non-nil. ;;; You can do this for all buffers as follows: ;;; ;;; (set-default 'truncate-lines t) ;;; Here is how to do it for C mode only: ;;; ;;; (set-default 'truncate-lines nil) ; this is the original value ;;; (defun my-c-mode-hook () ;;; "Run when C-mode starts up. Changes ..." ;;; ... set various personal preferences ... ;;; (setq truncate-lines t)) ;;; (add-hook 'c-mode-hook 'my-c-mode-hook) ;;; ;;; ;;; As a finer level of control, you can still have truncated lines but ;;; without the automatic horizontal scrolling by setting the buffer ;;; local variable `auto-show-mode' to nil. The default value is t. ;;; The command `auto-show-mode' toggles the value of the variable ;;; `auto-show-mode'. ;;; Code: (defvar auto-show-mode t "*Non-nil enables automatic horizontal scrolling, when lines are truncated. The default value is t. To change the default, do this: (set-default 'auto-show-mode nil) See also command `auto-show-mode'. This variable has no effect when lines are not being truncated.") (make-variable-buffer-local 'auto-show-mode) (defvar auto-show-shift-amount 8 "*Extra columns to scroll. for automatic horizontal scrolling.") (defvar auto-show-show-left-margin-threshold 50 "*Threshold column for automatic horizontal scrolling to the right. If point is before this column, we try to scroll to make the left margin visible. Setting this to 0 disables this feature.") (defun auto-show-truncationp () "True if line truncation is enabled for the selected window." (or truncate-lines (and truncate-partial-width-windows (< (window-width) (frame-width))))) ;;;###autoload (defun auto-show-mode (arg) "Turn automatic horizontal scroll mode on or off. With arg, turn auto scrolling on if arg is positive, off otherwise." (interactive "P") (setq auto-show-mode (if (null arg) (not auto-show-mode) (> (prefix-numeric-value arg) 0)))) (defun auto-show-make-point-visible (&optional ignore-arg) "Scroll horizontally to make point visible, if that is enabled. This function only does something if `auto-show-mode' is non-nil and longlines are being truncated in the selected window. See also the command `auto-show-toggle'." (interactive) (if (and auto-show-mode (auto-show-truncationp) (equal (window-buffer) (current-buffer))) (let* ((col (current-column)) ;column on line point is at (scroll (window-hscroll)) ;how far window is scrolled (w-width (- (window-width) (if (> scroll 0) 2 1))) ;how wide window is on the screen (right-col (+ scroll w-width))) (if (and (< col auto-show-show-left-margin-threshold) (< col (window-width)) (> scroll 0)) (scroll-right scroll) (if (< col scroll) ;to the left of the screen (scroll-right (+ (- scroll col) auto-show-shift-amount)) (if (or (> col right-col) ;to the right of the screen (and (= col right-col) (not (eolp)))) (scroll-left (+ auto-show-shift-amount (- col (+ scroll w-width)))) ) ) ) ) ) ) ;; Do auto-scrolling after commands. (add-hook 'post-command-hook 'auto-show-make-point-visible) ;; Do auto-scrolling in comint buffers after process output also. (add-hook 'comint-output-filter-functions 'auto-show-make-point-visible t) (provide 'auto-show) ;; auto-show.el ends here emacs-19.30/lisp/autoinsert.el100444 75424 1 21610 5777304700 15021 0ustar kwzhdaemon;;; autoinsert.el --- automatic mode-dependent insertion of text into new files ;; Copyright (C) 1985, 1986, 1987, 1994, 1995 Free Software Foundation, Inc. ;; Author: Charlie Martin ;; Adapted-By: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 ;; 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: ;; The following defines an association list for text to be ;; automatically inserted when a new file is created, and a function ;; which automatically inserts these files; the idea is to insert ;; default text much as the mode is automatically set using ;; auto-mode-alist. ;; ;; To use: ;; (add-hook 'find-file-hooks 'auto-insert) ;; setq auto-insert-directory to an appropriate slash-terminated value ;; ;; Author: Charlie Martin ;; Department of Computer Science and ;; National Biomedical Simulation Resource ;; Box 3709 ;; Duke University Medical Center ;; Durham, NC 27710 ;; (crm@cs.duke.edu,mcnc!duke!crm) ;;; Code: (defvar auto-insert 'not-modified "*Controls automatic insertion into newly found empty files: nil do nothing t insert if possible other insert if possible, but mark as unmodified. Insertion is possible when something appropriate is found in `auto-insert-alist'. When the insertion is marked as unmodified, you can save it with \\[write-file] RET. This variable is used when `auto-insert' is called as a function, e.g. when you do (add-hook 'find-file-hooks 'auto-insert). With \\[auto-insert], this is always treated as if it were `t'.") (defvar auto-insert-query 'function "*If non-`nil', ask user before auto-inserting. When this is `function', only ask when called non-interactively.") (defvar auto-insert-prompt "Perform %s auto-insertion? " "*Prompt to use when querying whether to auto-insert. If this contains a %s, that will be replaced by the matching rule.") (defvar auto-insert-alist '((("\\.\\([Hh]\\|hh\\|hpp\\)\\'" . "C / C++ header") (upcase (concat (file-name-nondirectory (substring buffer-file-name 0 (match-beginning 0))) "_" (substring buffer-file-name (1+ (match-beginning 0))))) "#ifndef " str \n "#define " str "\n\n" _ "\n\n#endif") (("\\.\\([Cc]\\|cc\\|cpp\\)\\'" . "C / C++ program") nil "#include \"" ;; nop without latest cc-mode (and (fboundp 'c-companion-file) ;(file-readable-p (c-companion-file 'name)) (file-name-nondirectory (c-companion-file 'name))) & ?\" | -10) ("[Mm]akefile\\'" . "makefile.inc") ("\\.html\\'" nil "\n" "\n" "" _ "\n" "\n" "\n\n" "\n" "") (plain-tex-mode . "tex-insert.tex") (bibtex-mode . "tex-insert.tex") (latex-mode ;; should try to offer completing read for these "options, RET: " "\\documentstyle[" str & ?\] | -1 ?{ (read-string "class: ") "}\n" ("package, %s: " "\\usepackage[" (read-string "options, RET: ") & ?\] | -1 ?{ str "}\n") _ "\n\\begin{document}\n" _ "\n\\end{document}") (("/bin/.*[^/]\\'" . "Shell-Script mode magic number") lambda () (if (eq major-mode default-major-mode) (sh-mode))) (ada-mode . ada-header) (("\\.el\\'" . "Emacs Lisp header") "Short description: " ";;; " (file-name-nondirectory (buffer-file-name)) " --- " str " ;; Copyright (C) " (substring (current-time-string) -4) " by " (getenv "ORGANIZATION") | "Free Software Foundation, Inc." " ;; Author: " (user-full-name) '(if (search-backward "&" (save-excursion (beginning-of-line 1) (point)) t) (replace-match (capitalize (user-login-name)) t t)) '(end-of-line 1) " <" (user-login-name) ?@ (system-name) "> ;; Keywords: " '(require 'finder) ;;'(setq v1 (apply 'vector (mapcar 'car finder-known-keywords))) '(setq v1 (mapcar (lambda (x) (list (symbol-name (car x)))) finder-known-keywords) v2 (mapconcat (lambda (x) (format "%10.0s: %s" (car x) (cdr x))) finder-known-keywords "\n")) ((let ((minibuffer-help-form v2)) (completing-read "Keyword, C-h: " v1 nil t)) str ", ") & -2 " ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; " _ " ;;; Code: ;;; " (file-name-nondirectory (buffer-file-name)) " ends here")) "A list specifying text to insert by default into a new file. Elements look like (CONDITION . ACTION) or ((CONDITION . DESCRIPTION) . ACTION). CONDITION maybe a regexp that must match the new file's name, or it may be a symbol that must match the major mode for this element to apply. Only the first matching element is effective. Optional DESCRIPTION is a string for filling `auto-insert-prompt'. ACTION may be a skeleton to insert (see `skeleton-insert'), an absolute file-name or one relative to `auto-insert-directory' or a function to call. ACTION may also be a vector containing several successive single actions as described above, e.g. [\"header.insert\" date-and-author-update].") ;; Establish a default value for auto-insert-directory (defvar auto-insert-directory "~/insert/" "*Directory from which auto-inserted files are taken.") ;;;###autoload (defun auto-insert () "Insert default contents into a new file if `auto-insert' is non-nil. Matches the visited file name against the elements of `auto-insert-alist'." (interactive) (and (not buffer-read-only) (or (eq this-command 'auto-insert) (and auto-insert (bobp) (eobp))) (let ((alist auto-insert-alist) case-fold-search cond desc action) (goto-char 1) ;; find first matching alist entry (while alist (if (atom (setq cond (car (car alist)))) (setq desc cond) (setq desc (cdr cond) cond (car cond))) (if (if (symbolp cond) (eq cond major-mode) (string-match cond buffer-file-name)) (setq action (cdr (car alist)) alist nil) (setq alist (cdr alist)))) ;; Now, if we found something, do it (and action (if (stringp action) (file-readable-p (concat auto-insert-directory action)) t) (if auto-insert-query (or (if (eq auto-insert-query 'function) (eq this-command 'auto-insert)) (y-or-n-p (format auto-insert-prompt desc))) t) (mapcar (lambda (action) (if (stringp action) (if (file-readable-p (setq action (concat auto-insert-directory action))) (insert-file-contents action)) (save-window-excursion ;; make buffer visible before skeleton or function ;; which might ask the user for something (switch-to-buffer (current-buffer)) (if (and (consp action) (not (eq (car action) 'lambda))) (skeleton-insert action) (funcall action))))) (if (vectorp action) action (vector action)))) (and (buffer-modified-p) (not (eq this-command 'auto-insert)) (set-buffer-modified-p (eq auto-insert t)))))) ;;;###autoload (defun define-auto-insert (key action &optional after) "Associate CONDITION with (additional) ACTION in `auto-insert-alist'. Optional AFTER means to insert action after all existing actions for CONDITION, or if CONDITION had no actions, after all other CONDITIONs." (let ((elt (assoc key auto-insert-alist))) (if elt (setcdr elt (if (vectorp (cdr elt)) (vconcat (if after (cdr elt)) (if (vectorp action) action (vector action)) (if after () (cdr elt))) (if after (vector (cdr elt) action) (vector action (cdr elt))))) (if after (nconc auto-insert-alist (list (cons key action))) (setq auto-insert-alist (cons (cons key action) auto-insert-alist)))))) ;;; autoinsert.el ends here emacs-19.30/lisp/autoload.el100444 75424 1 35233 5777303263 14445 0ustar kwzhdaemon;;; autoload.el --- maintain autoloads in loaddefs.el. ;;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. ;;; ;; Author: Roland McGrath ;; Keywords: maint ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2, or (at your option) ;;; any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; A copy of the GNU General Public License can be obtained from this ;;; program's author (send electronic mail to roland@ai.mit.edu) or from ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA ;;; 02139, USA. ;;; ;;; Commentary: ;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to ;; date. It interprets magic cookies of the form ";;;###autoload" in ;; lisp source files in various useful ways. To learn more, read the ;; source; if you're going to use this, you'd better be able to. ;;; Code: (defun make-autoload (form file) "Turn FORM, a defun or defmacro, into an autoload for source file FILE. Returns nil if FORM is not a defun, define-skeleton or defmacro." (let ((car (car-safe form))) (if (memq car '(defun define-skeleton defmacro)) (let ((macrop (eq car 'defmacro)) name doc) (setq form (cdr form) name (car form) ;; Ignore the arguments. form (cdr (if (eq car 'define-skeleton) form (cdr form))) doc (car form)) (if (stringp doc) (setq form (cdr form)) (setq doc nil)) (list 'autoload (list 'quote name) file doc (or (eq car 'define-skeleton) (eq (car-safe (car form)) 'interactive)) (if macrop (list 'quote 'macro) nil))) nil))) (put 'define-skeleton 'doc-string-elt 3) (defconst generate-autoload-cookie ";;;###autoload" "Magic comment indicating the following form should be autoloaded. Used by \\[update-file-autoloads]. This string should be meaningless to Lisp (e.g., a comment). This string is used: ;;;###autoload \(defun function-to-be-autoloaded () ...) If this string appears alone on a line, the following form will be read and an autoload made for it. If there is further text on the line, that text will be copied verbatim to `generated-autoload-file'.") (defconst generate-autoload-section-header "\f\n;;;### " "String inserted before the form identifying the section of autoloads for a file.") (defconst generate-autoload-section-trailer "\n;;;***\n" "String which indicates the end of the section of autoloads for a file.") ;;; Forms which have doc-strings which should be printed specially. ;;; A doc-string-elt property of ELT says that (nth ELT FORM) is ;;; the doc-string in FORM. ;;; ;;; There used to be the following note here: ;;; ;;; Note: defconst and defvar should NOT be marked in this way. ;;; ;;; We don't want to produce defconsts and defvars that ;;; ;;; make-docfile can grok, because then it would grok them twice, ;;; ;;; once in foo.el (where they are given with ;;;###autoload) and ;;; ;;; once in loaddefs.el. ;;; ;;; Counter-note: Yes, they should be marked in this way. ;;; make-docfile only processes those files that are loaded into the ;;; dumped Emacs, and those files should never have anything ;;; autoloaded here. The above-feared problem only occurs with files ;;; which have autoloaded entries *and* are processed by make-docfile; ;;; there should be no such files. (put 'autoload 'doc-string-elt 3) (put 'defun 'doc-string-elt 3) (put 'defvar 'doc-string-elt 3) (put 'defconst 'doc-string-elt 3) (put 'defmacro 'doc-string-elt 3) (defun autoload-trim-file-name (file) ;; Returns a relative pathname of FILE ;; starting from the directory that loaddefs.el is in. ;; That is normally a directory in load-path, ;; which means Emacs will be able to find FILE when it looks. ;; Any extra directory names here would prevent finding the file. (setq file (expand-file-name file)) (file-relative-name file (file-name-directory generated-autoload-file))) (defun generate-file-autoloads (file) "Insert at point a loaddefs autoload section for FILE. autoloads are generated for defuns and defmacros in FILE marked by `generate-autoload-cookie' (which see). If FILE is being visited in a buffer, the contents of the buffer are used." (interactive "fGenerate autoloads for file: ") (let ((outbuf (current-buffer)) (autoloads-done '()) (load-name (let ((name (file-name-nondirectory file))) (if (string-match "\\.elc?$" name) (substring name 0 (match-beginning 0)) name))) (print-length nil) (print-readably t) ; This does something in Lucid Emacs. (float-output-format nil) (done-any nil) (visited (get-file-buffer file)) output-end) ;; If the autoload section we create here uses an absolute ;; pathname for FILE in its header, and then Emacs is installed ;; under a different path on another system, ;; `update-autoloads-here' won't be able to find the files to be ;; autoloaded. So, if FILE is in the same directory or a ;; subdirectory of the current buffer's directory, we'll make it ;; 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) (save-excursion (unwind-protect (progn (set-buffer (find-file-noselect file)) (save-excursion (save-restriction (widen) (goto-char (point-min)) (while (not (eobp)) (skip-chars-forward " \t\n\f") (cond ((looking-at (regexp-quote generate-autoload-cookie)) (search-forward generate-autoload-cookie) (skip-chars-forward " \t") (setq done-any t) (if (eolp) ;; Read the next form and make an autoload. (let* ((form (prog1 (read (current-buffer)) (or (bolp) (forward-line 1)))) (autoload (make-autoload form load-name)) (doc-string-elt (get (car-safe form) 'doc-string-elt))) (if autoload (setq autoloads-done (cons (nth 1 form) autoloads-done)) (setq autoload form)) (if (and doc-string-elt (stringp (nth doc-string-elt autoload))) ;; We need to hack the printing because the ;; doc-string must be printed specially for ;; make-docfile (sigh). (let* ((p (nthcdr (1- doc-string-elt) autoload)) (elt (cdr p))) (setcdr p nil) (princ "\n(" outbuf) (let ((print-escape-newlines t)) (mapcar (function (lambda (elt) (prin1 elt outbuf) (princ " " outbuf))) autoload)) (princ "\"\\\n" outbuf) (let ((begin (save-excursion (set-buffer outbuf) (point)))) (princ (substring (prin1-to-string (car elt)) 1) outbuf) ;; Insert a backslash before each ( that ;; appears at the beginning of a line in ;; the doc string. (save-excursion (set-buffer outbuf) (save-excursion (while (search-backward "\n(" begin t) (forward-char 1) (insert "\\")))) (if (null (cdr elt)) (princ ")" outbuf) (princ " " outbuf) (princ (substring (prin1-to-string (cdr elt)) 1) outbuf)) (terpri outbuf))) (let ((print-escape-newlines t)) (print autoload outbuf)))) ;; Copy the rest of the line to the output. (let ((begin (point))) (forward-line 1) (princ (buffer-substring begin (point)) outbuf)))) ((looking-at ";") ;; Don't read the comment. (forward-line 1)) (t (forward-sexp 1) (forward-line 1))))))) (or visited ;; We created this buffer, so we should kill it. (kill-buffer (current-buffer))) (set-buffer outbuf) (setq output-end (point-marker)))) (if done-any (progn (insert generate-autoload-section-header) (prin1 (list 'autoloads autoloads-done load-name (autoload-trim-file-name file) (nth 5 (file-attributes file))) outbuf) (terpri outbuf) (insert ";;; Generated autoloads from " (autoload-trim-file-name file) "\n") ;; Warn if we put a line in loaddefs.el ;; that is long enough to cause trouble. (while (< (point) output-end) (let ((beg (point))) (end-of-line) (if (> (- (point) beg) 900) (progn (message "A line is too long--over 900 characters") (sleep-for 2) (goto-char output-end)))) (forward-line 1)) (goto-char output-end) (insert generate-autoload-section-trailer))) (message "Generating autoloads for %s...done" file))) (defconst generated-autoload-file "loaddefs.el" "*File \\[update-file-autoloads] puts autoloads into. A .el file can set this in its local variables section to make its autoloads go somewhere else.") ;;;###autoload (defun update-file-autoloads (file) "Update the autoloads for FILE in `generated-autoload-file' \(which FILE might bind in its local variables)." (interactive "fUpdate autoloads for file: ") (let ((load-name (let ((name (file-name-nondirectory file))) (if (string-match "\\.elc?$" name) (substring name 0 (match-beginning 0)) name))) (found nil) (existing-buffer (get-file-buffer file))) (save-excursion ;; We want to get a value for generated-autoload-file from ;; the local variables section if it's there. (set-buffer (find-file-noselect file)) (set-buffer (find-file-noselect generated-autoload-file)) (save-excursion (save-restriction (widen) (goto-char (point-min)) ;; Look for the section for LOAD-NAME. (while (and (not found) (search-forward generate-autoload-section-header nil t)) (let ((form (condition-case () (read (current-buffer)) (end-of-file nil)))) (cond ((string= (nth 2 form) load-name) ;; We found the section for this file. ;; Check if it is up to date. (let ((begin (match-beginning 0)) (last-time (nth 4 form)) (file-time (nth 5 (file-attributes file)))) (if (and (or (null existing-buffer) (not (buffer-modified-p existing-buffer))) (listp last-time) (= (length last-time) 2) (or (> (car last-time) (car file-time)) (and (= (car last-time) (car file-time)) (>= (nth 1 last-time) (nth 1 file-time))))) (progn (message "Autoload section for %s is up to date." file) (setq found 'up-to-date)) (search-forward generate-autoload-section-trailer) (delete-region begin (point)) (setq found t)))) ((string< load-name (nth 2 form)) ;; We've come to a section alphabetically later than ;; LOAD-NAME. We assume the file is in order and so ;; there must be no section for LOAD-NAME. We will ;; insert one before the section here. (goto-char (match-beginning 0)) (setq found 'new))))) (or (eq found 'up-to-date) (and (eq found 'new) ;; Check that FILE has any cookies before generating a ;; new section for it. (save-excursion (set-buffer (find-file-noselect file)) (save-excursion (widen) (goto-char (point-min)) (if (search-forward (concat "\n" generate-autoload-cookie) nil t) nil (if (interactive-p) (message file " has no autoloads")) t)))) (generate-file-autoloads file)))) (if (interactive-p) (save-buffer)) (if (and (null existing-buffer) (setq existing-buffer (get-file-buffer file))) (kill-buffer existing-buffer))))) ;;;###autoload (defun update-autoloads-here () "\ Update sections of the current buffer generated by \\[update-file-autoloads]." (interactive) (let ((generated-autoload-file (buffer-file-name))) (save-excursion (goto-char (point-min)) (while (search-forward generate-autoload-section-header nil t) (let* ((form (condition-case () (read (current-buffer)) (end-of-file nil))) (file (nth 3 form))) (if (and (stringp file) (or (get-file-buffer file) (file-exists-p file))) () (setq file (if (y-or-n-p (format "Can't find library `%s'; remove its autoloads? " (nth 2 form) file)) t (condition-case () (read-file-name (format "Find `%s' load file: " (nth 2 form)) nil nil t) (quit nil))))) (if file (let ((begin (match-beginning 0))) (search-forward generate-autoload-section-trailer) (delete-region begin (point)))) (if (stringp file) (generate-file-autoloads file))))))) ;;;###autoload (defun update-directory-autoloads (dir) "Run \\[update-file-autoloads] on each .el file in DIR." (interactive "DUpdate autoloads for directory: ") (let ((enable-local-eval nil)) (mapcar 'update-file-autoloads (directory-files dir t "^[^=].*\\.el$"))) (if (interactive-p) (save-excursion (set-buffer (find-file-noselect generated-autoload-file)) (save-buffer)))) ;;;###autoload (defun batch-update-autoloads () "Update the autoloads for the files or directories on the command line. Runs \\[update-file-autoloads] on files and \\[update-directory-autoloads] on directories. Must be used only with -batch, and kills Emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke `emacs -batch -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) (enable-local-eval nil)) ;Don't query in batch mode. (message "Updating autoloads in %s..." generated-autoload-file) (let ((frob (function (lambda (file) (condition-case lossage (update-file-autoloads file) (error (princ ">>Error processing ") (princ file) (princ ": ") (if (fboundp 'display-error) (display-error lossage nil) (prin1 lossage)) (princ "\n") (setq lost t))))))) (while args (if (file-directory-p (expand-file-name (car args))) (let ((rest (directory-files (car args) t "\\.el$"))) (while rest (funcall frob (car rest)) (setq rest (cdr rest)))) (funcall frob (car args))) (setq args (cdr args)))) (save-some-buffers t) (message "Done") (kill-emacs (if lost 1 0)))) (provide 'autoload) ;;; autoload.el ends here emacs-19.30/lisp/avoid.el100444 12120 1 33315 6045200774 13524 0ustar rmsdaemon;;; avoid.el --- make mouse pointer stay out of the way of editing ;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: Boris Goldowsky ;; Keywords: mouse ;; 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: ;;; ;;; For those who are annoyed by the mouse pointer obscuring text, ;;; this mode moves the mouse pointer - either just a little out of ;;; the way, or all the way to the corner of the frame. ;;; To use, load or evaluate this file and type M-x mouse-avoidance-mode . ;;; To set up permanently, put the following in your .emacs: ;;; ;;; (if window-system (mouse-avoidance-mode 'animate)) ;;; ;;; The 'animate can be 'jump or 'banish or 'exile or 'protean if you prefer. ;;; See the documentation for function `mouse-avoidance-mode' for ;;; details of the different modes. ;;; ;;; For added silliness, make the animatee animate... ;;; put something similar to the following into your .emacs: ;;; ;;; (if window-system ;;; (mouse-avoidance-set-pointer-shape ;;; (eval (nth (random 4) ;;; '(x-pointer-man x-pointer-spider ;;; x-pointer-gobbler x-pointer-gumby))))) ;;; ;;; For completely random pointer shape, replace the setq above with: ;;; (setq x-pointer-shape (mouse-avoidance-random-shape)) ;;; ;;; Bugs / Warnings / To-Do: ;;; ;;; - Using this code does slow emacs down. "banish" mode shouldn't ;;; be too bad, and on my workstation even "animate" is reasonable. ;;; ;;; - It ought to find out where any overlapping frames are and avoid them, ;;; rather than always raising the frame. ;;; Credits: ;;; This code was helped by all those who contributed suggestions, ;;; fixes, and additions ;;; Joe Harrington (and his advisor), for the original inspiration. ;;; Ken Manheimer, for dreaming up the Protean mode. ;;; Richard Stallman, for the awful cat-and-mouse pun, among other things. ;;; Mike Williams, Denis Howe, Bill Benedetto, Chris Moore, Don Morris, ;;; Simon Marshall, and M.S. Ashton, for their feedback. ;;; ;;; Code: (provide 'avoid) (defvar mouse-avoidance-mode nil "Value is t or a symbol if the mouse pointer should avoid the cursor. See function `mouse-avoidance-mode' for possible values. Changing this variable is NOT the recommended way to change modes; use that function instead.") (defvar mouse-avoidance-nudge-dist 15 "*Average distance that mouse will be moved when approached by cursor. Only applies in mouse-avoidance-mode `jump' and its derivatives. For best results make this larger than `mouse-avoidance-threshold'.") (defvar mouse-avoidance-nudge-var 10 "*Variability of `mouse-avoidance-nudge-dist' (which see).") (defvar mouse-avoidance-animation-delay .01 "Delay between animation steps, in seconds.") (defvar mouse-avoidance-threshold 5 "*Mouse-pointer's flight distance. If the cursor gets closer than this, the mouse pointer will move away. Only applies in mouse-avoidance-modes `animate' and `jump'.") ;; Internal variables (defvar mouse-avoidance-state nil) (defvar mouse-avoidance-pointer-shapes nil) (defvar mouse-avoidance-n-pointer-shapes 0) ;;; Functions: (defsubst mouse-avoidance-set-pointer-shape (shape) "Set the shape of the mouse pointer to SHAPE." (setq x-pointer-shape shape) (set-mouse-color nil)) (defun mouse-avoidance-point-position () "Return the position of point as (FRAME X . Y). Analogous to mouse-position." (let* ((w (selected-window)) (edges (window-edges w)) (list (compute-motion (max (window-start w) (point-min)) ; start pos ;; window-start can be < point-min if the ;; latter has changed since the last redisplay '(0 . 0) ; start XY (point) ; stop pos (cons (window-width) (window-height)); stop XY: none (1- (window-width)) ; width (cons (window-hscroll w) 0) ; 0 may not be right? (selected-window)))) ;; compute-motion returns (pos HPOS VPOS prevhpos contin) ;; we want: (frame hpos . vpos) (cons (selected-frame) (cons (+ (car edges) (car (cdr list))) (+ (car (cdr edges)) (car (cdr (cdr list)))))))) ;(defun mouse-avoidance-point-position-test () ; (interactive) ; (message (format "point=%s mouse=%s" ; (cdr (mouse-avoidance-point-position)) ; (cdr (mouse-position))))) (defun mouse-avoidance-set-mouse-position (pos) ;; Carefully set mouse position to given position (X . Y) ;; Ideally, should check if X,Y is in the current frame, and if not, ;; leave the mouse where it was. However, this is currently ;; difficult to do, so we just raise the frame to avoid frame switches. ;; Returns t if it moved the mouse. (let ((f (selected-frame))) (raise-frame f) (set-mouse-position f (car pos) (cdr pos)) t)) (defun mouse-avoidance-too-close-p (mouse) ;; Return t if mouse pointer and point cursor are too close. ;; Acceptable distance is defined by mouse-avoidance-threshold. (let ((point (mouse-avoidance-point-position))) (and (eq (car mouse) (car point)) (car (cdr mouse)) (< (abs (- (car (cdr mouse)) (car (cdr point)))) mouse-avoidance-threshold) (< (abs (- (cdr (cdr mouse)) (cdr (cdr point)))) mouse-avoidance-threshold)))) (defun mouse-avoidance-banish-destination () "The position to which mouse-avoidance-mode `banish' moves the mouse. You can redefine this if you want the mouse banished to a different corner." (cons (1- (frame-width)) 0)) (defun mouse-avoidance-banish-mouse () ;; Put the mouse pointer in the upper-right corner of the current frame. (mouse-avoidance-set-mouse-position (mouse-avoidance-banish-destination))) (defsubst mouse-avoidance-delta (cur delta dist var min max) ;; Decide how far to move in either dimension. ;; Args are the CURRENT location, the desired DELTA for ;; warp-conservation, the DISTANCE we like to move, the VARIABILITY ;; in distance allowed, and the MIN and MAX possible window positions. ;; Returns something as close to DELTA as possible withing the constraints. (let ((L1 (max (- min cur) (+ (- dist) (- var)))) (R1 (+ (- dist) var )) (L2 (+ dist (- var))) (R2 (min (- max cur) (+ dist var)))) (if (< R1 (- min cur)) (setq L1 nil R1 nil)) (if (> L2 (- max cur)) (setq L2 nil R2 nil)) (cond ((and L1 (< delta L1)) L1) ((and R1 (< delta R1)) delta) ((and R1 (< delta 0)) R1) ((and L2 (< delta L2)) L2) ((and R2 (< delta R2)) delta) (R2) ((or R1 L2)) (t 0)))) (defun mouse-avoidance-nudge-mouse () ;; Push the mouse a little way away, possibly animating the move ;; For these modes, state keeps track of the total offset that we've ;; accumulated, and tries to keep it close to zero. (let* ((cur (mouse-position)) (cur-frame (car cur)) (cur-pos (cdr cur)) (deltax (mouse-avoidance-delta (car cur-pos) (- (random mouse-avoidance-nudge-var) (car mouse-avoidance-state)) mouse-avoidance-nudge-dist mouse-avoidance-nudge-var 0 (frame-width))) (deltay (mouse-avoidance-delta (cdr cur-pos) (- (random mouse-avoidance-nudge-var) (cdr mouse-avoidance-state)) mouse-avoidance-nudge-dist mouse-avoidance-nudge-var 0 (frame-height)))) (setq mouse-avoidance-state (cons (+ (car mouse-avoidance-state) deltax) (+ (cdr mouse-avoidance-state) deltay))) (if (or (eq mouse-avoidance-mode 'animate) (eq mouse-avoidance-mode 'proteus)) (let ((i 0.0)) (while (<= i 1) (mouse-avoidance-set-mouse-position (cons (+ (car cur-pos) (round (* i deltax))) (+ (cdr cur-pos) (round (* i deltay))))) (setq i (+ i (max .1 (/ 1.0 mouse-avoidance-nudge-dist)))) (if (eq mouse-avoidance-mode 'proteus) (mouse-avoidance-set-pointer-shape (mouse-avoidance-random-shape))) (sit-for mouse-avoidance-animation-delay))) (mouse-avoidance-set-mouse-position (cons (+ (car (cdr cur)) deltax) (+ (cdr (cdr cur)) deltay)))))) (defun mouse-avoidance-random-shape () "Return a random cursor shape. This assumes that any variable whose name begins with x-pointer- and has an integer value is a valid cursor shape. You might want to redefine this function to suit your own tastes." (if (null mouse-avoidance-pointer-shapes) (progn (setq mouse-avoidance-pointer-shapes (mapcar '(lambda (x) (symbol-value (intern x))) (all-completions "x-pointer-" obarray '(lambda (x) (and (boundp x) (integerp (symbol-value x))))))) (setq mouse-avoidance-n-pointer-shapes (length mouse-avoidance-pointer-shapes)))) (nth (random mouse-avoidance-n-pointer-shapes) mouse-avoidance-pointer-shapes)) (defun mouse-avoidance-banish-hook () (if (and (not executing-kbd-macro) ; don't check inside macro (mouse-avoidance-kbd-command (this-command-keys))) (mouse-avoidance-banish-mouse))) (defun mouse-avoidance-exile-hook () ;; For exile mode, the state is nil when the mouse is in its normal ;; position, and set to the old mouse-position when the mouse is in exile. (if (and (not executing-kbd-macro) (mouse-avoidance-kbd-command (this-command-keys))) (let ((mp (mouse-position))) (cond ((and (not mouse-avoidance-state) (mouse-avoidance-too-close-p mp)) (setq mouse-avoidance-state mp) (mouse-avoidance-banish-mouse)) ((and mouse-avoidance-state (not (mouse-avoidance-too-close-p mouse-avoidance-state))) (if (and (eq (car mp) (selected-frame)) (equal (cdr mp) (mouse-avoidance-banish-destination))) (mouse-avoidance-set-mouse-position ;; move back only if user has not moved mouse (cdr mouse-avoidance-state))) ;; but clear state anyway, to be ready for another move (setq mouse-avoidance-state nil)))))) (defun mouse-avoidance-fancy-hook () ;; Used for the "fancy" modes, ie jump et al. (if (and (not executing-kbd-macro) ; don't check inside macro (mouse-avoidance-kbd-command (this-command-keys)) (mouse-avoidance-too-close-p (mouse-position))) (let ((old-pos (mouse-position))) (mouse-avoidance-nudge-mouse) (if (not (eq (selected-frame) (car old-pos))) ;; This should never happen. (apply 'set-mouse-position old-pos))))) (defun mouse-avoidance-kbd-command (key) "Return t if the KEYSEQENCE is composed of keyboard events only. Return nil if there are any lists in the key sequence." (cond ((null key) nil) ; Null event seems to be ; returned occasionally. ((not (vectorp key)) t) ; Strings are keyboard events. ((catch 'done (let ((i 0) (l (length key))) (while (< i l) (if (listp (aref key i)) (throw 'done nil)) (setq i (1+ i)))) t)))) ;;;###autoload (defun mouse-avoidance-mode (&optional mode) "Set cursor avoidance mode to MODE. MODE should be one of the symbols `banish', `exile', `jump', `animate', `cat-and-mouse', `proteus', or `none'. If MODE is nil, toggle mouse avoidance between `none` and `banish' modes. Positive numbers and symbols other than the above are treated as equivalent to `banish'; negative numbers and `-' are equivalent to `none'. Effects of the different modes: * banish: Move the mouse to the upper-right corner on any keypress. * exile: Move the mouse to the corner only if the cursor gets too close, and allow it to return once the cursor is out of the way. * jump: If the cursor gets too close to the mouse, displace the mouse a random distance & direction. * animate: As `jump', but shows steps along the way for illusion of motion. * cat-and-mouse: Same as `animate'. * proteus: As `animate', but changes the shape of the mouse pointer too. Whenever the mouse is moved, the frame is also raised. \(see `mouse-avoidance-threshold' for definition of \"too close\", and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for definition of \"random distance\".)" (interactive (list (intern (completing-read "Select cursor avoidance technique (SPACE for list): " '(("banish") ("exile") ("jump") ("animate") ("cat-and-mouse") ("proteus") ("none")) nil t)))) (if (eq mode 'cat-and-mouse) (setq mode 'animate)) (remove-hook 'post-command-idle-hook 'mouse-avoidance-banish-hook) (remove-hook 'post-command-idle-hook 'mouse-avoidance-exile-hook) (remove-hook 'post-command-idle-hook 'mouse-avoidance-fancy-hook) (cond ((eq mode 'none) (setq mouse-avoidance-mode nil)) ((or (eq mode 'jump) (eq mode 'animate) (eq mode 'proteus)) (add-hook 'post-command-idle-hook 'mouse-avoidance-fancy-hook) (setq mouse-avoidance-mode mode mouse-avoidance-state (cons 0 0))) ((eq mode 'exile) (add-hook 'post-command-idle-hook 'mouse-avoidance-exile-hook) (setq mouse-avoidance-mode mode mouse-avoidance-state nil)) ((or (eq mode 'banish) (eq mode t) (and (null mode) (null mouse-avoidance-mode)) (and mode (> (prefix-numeric-value mode) 0))) (add-hook 'post-command-idle-hook 'mouse-avoidance-banish-hook) (setq mouse-avoidance-mode 'banish)) (t (setq mouse-avoidance-mode nil))) (force-mode-line-update)) (or (assq 'mouse-avoidance-mode minor-mode-alist) (setq minor-mode-alist (cons '(mouse-avoidance-mode " Avoid") minor-mode-alist))) ;;; End of avoid.el emacs-19.30/lisp/awk-mode.el100444 12120 1 7055 6050703475 14112 0ustar rmsdaemon;;; awk-mode.el --- AWK code editing commands for Emacs ;; Copyright (C) 1988, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: unix, languages ;; 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: ;; Sets up C-mode with support for awk-style #-comments and a lightly ;; hacked syntax table. ;;; Code: (defvar awk-mode-syntax-table nil "Syntax table in use in Awk-mode buffers.") (if awk-mode-syntax-table () (setq awk-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?\\ "\\" awk-mode-syntax-table) (modify-syntax-entry ?\n "> " awk-mode-syntax-table) (modify-syntax-entry ?\f "> " awk-mode-syntax-table) (modify-syntax-entry ?\# "< " awk-mode-syntax-table) (modify-syntax-entry ?/ "." awk-mode-syntax-table) (modify-syntax-entry ?* "." awk-mode-syntax-table) (modify-syntax-entry ?+ "." awk-mode-syntax-table) (modify-syntax-entry ?- "." awk-mode-syntax-table) (modify-syntax-entry ?= "." awk-mode-syntax-table) (modify-syntax-entry ?% "." awk-mode-syntax-table) (modify-syntax-entry ?< "." awk-mode-syntax-table) (modify-syntax-entry ?> "." awk-mode-syntax-table) (modify-syntax-entry ?& "." awk-mode-syntax-table) (modify-syntax-entry ?| "." awk-mode-syntax-table) (modify-syntax-entry ?\' "\"" awk-mode-syntax-table)) (defvar awk-mode-abbrev-table nil "Abbrev table in use in Awk-mode buffers.") (define-abbrev-table 'awk-mode-abbrev-table ()) ;;;###autoload (defun awk-mode () "Major mode for editing AWK code. This is much like C mode except for the syntax of comments. It uses the same keymap as C mode and has the same variables for customizing indentation. It has its own abbrev table and its own syntax table. Turning on AWK mode calls the value of the variable `awk-mode-hook' with no args, if that value is non-nil." (interactive) (kill-all-local-variables) (require 'cc-mode) (use-local-map c-mode-map) (setq major-mode 'awk-mode) (setq mode-name "AWK") (setq local-abbrev-table awk-mode-abbrev-table) (set-syntax-table awk-mode-syntax-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) (make-local-variable 'indent-line-function) (setq indent-line-function 'c-indent-line) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'comment-start) (setq comment-start "# ") (make-local-variable 'comment-end) (setq comment-end "") (make-local-variable 'comment-column) (setq comment-column 32) (make-local-variable 'comment-start-skip) (setq comment-start-skip "#+ *") (make-local-variable 'comment-indent-function) (setq comment-indent-function 'c-comment-indent) (run-hooks 'awk-mode-hook)) ;;; awk-mode.el ends here emacs-19.30/lisp/backquote.el100444 12120 1 15657 6045201120 14373 0ustar rmsdaemon;;; backquote.el -- implement the ` Lisp construct ;;; Copyright (C) 1990, 1992, 1994 Free Software Foundation, Inc. ;; Author: Rick Sladkey ;; Maintainer: FSF ;; Keywords: extensions, internal ;; 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 backquote will generate calls to the backquote-list* form. ;; Both a function version and a macro version are included. ;; The macro version is used by default because it is faster ;; and needs no run-time support. It should really be a subr. ;;; Code: (provide 'backquote) ;; function and macro versions of backquote-list* (defun backquote-list*-function (first &rest list) "Like `list' but the last argument is the tail of the new list. For example (backquote-list* 'a 'b 'c) => (a b . c)" (if list (let* ((rest list) (newlist (cons first nil)) (last newlist)) (while (cdr rest) (setcdr last (cons (car rest) nil)) (setq last (cdr last) rest (cdr rest))) (setcdr last (car rest)) newlist) first)) (defmacro backquote-list*-macro (first &rest list) "Like `list' but the last argument is the tail of the new list. For example (backquote-list* 'a 'b 'c) => (a b . c)" (setq list (reverse (cons first list)) first (car list) list (cdr list)) (if list (let* ((second (car list)) (rest (cdr list)) (newlist (list 'cons second first))) (while rest (setq newlist (list 'cons (car rest) newlist) rest (cdr rest))) newlist) first)) (defalias 'backquote-list* (symbol-function 'backquote-list*-macro)) ;; A few advertised variables that control which symbols are used ;; to represent the backquote, unquote, and splice operations. (defvar backquote-backquote-symbol '\` "*Symbol used to represent a backquote or nested backquote (e.g. `).") (defvar backquote-unquote-symbol ', "*Symbol used to represent an unquote (e.g. `,') inside a backquote.") (defvar backquote-splice-symbol ',@ "*Symbol used to represent a splice (e.g. `,@') inside a backquote.") ;;;###autoload (defmacro backquote (arg) "Argument STRUCTURE describes a template to build. The whole structure acts as if it were quoted except for certain places where expressions are evaluated and inserted or spliced in. For example: b => (ba bb bc) ; assume b has this value `(a b c) => (a b c) ; backquote acts like quote `(a ,b c) => (a (ba bb bc) c) ; insert the value of b `(a ,@b c) => (a ba bb bc c) ; splice in the value of b Vectors work just like lists. Nested backquotes are permitted." (cdr (backquote-process arg))) ;; GNU Emacs has no reader macros ;;;###autoload (defalias '\` (symbol-function 'backquote)) ;; backquote-process returns a dotted-pair of a tag (0, 1, or 2) and ;; the backquote-processed structure. 0 => the structure is ;; constant, 1 => to be unquoted, 2 => to be spliced in. ;; The top-level backquote macro just discards the tag. (defun backquote-process (s) (cond ((vectorp s) (let ((n (backquote-process (append s ())))) (if (= (car n) 0) (cons 0 s) (cons 1 (cond ((eq (nth 1 n) 'list) (cons 'vector (nthcdr 2 n))) ((eq (nth 1 n) 'append) (cons 'vconcat (nthcdr 2 n))) (t (list 'apply '(function vector) (cdr n)))))))) ((atom s) (cons 0 (if (or (null s) (eq s t) (not (symbolp s))) s (list 'quote s)))) ((eq (car s) backquote-unquote-symbol) (cons 1 (nth 1 s))) ((eq (car s) backquote-splice-symbol) (cons 2 (nth 1 s))) ((eq (car s) backquote-backquote-symbol) (backquote-process (cdr (backquote-process (nth 1 s))))) (t (let ((rest s) item firstlist list lists expression) ;; Scan this list-level, setting LISTS to a list of forms, ;; each of which produces a list of elements ;; that should go in this level. ;; The order of LISTS is backwards. ;; If there are non-splicing elements (constant or variable) ;; at the beginning, put them in FIRSTLIST, ;; as a list of tagged values (TAG . FORM). ;; If there are any at the end, they go in LIST, likewise. (while (consp rest) ;; Turn . (, foo) into (,@ foo). (if (eq (car rest) backquote-unquote-symbol) (setq rest (list (list backquote-splice-symbol (nth 1 rest))))) (setq item (backquote-process (car rest))) (cond ((= (car item) 2) ;; Put the nonspliced items before the first spliced item ;; into FIRSTLIST. (if (null lists) (setq firstlist list list nil)) ;; Otherwise, put any preceding nonspliced items into LISTS. (if list (setq lists (cons (backquote-listify list '(0 . nil)) lists))) (setq lists (cons (cdr item) lists)) (setq list nil)) (t (setq list (cons item list)))) (setq rest (cdr rest))) ;; Handle nonsplicing final elements, and the tail of the list ;; (which remains in REST). (if (or rest list) (setq lists (cons (backquote-listify list (backquote-process rest)) lists))) ;; Turn LISTS into a form that produces the combined list. (setq expression (if (or (cdr lists) (eq (car-safe (car lists)) backquote-splice-symbol)) (cons 'append (nreverse lists)) (car lists))) ;; Tack on any initial elements. (if firstlist (setq expression (backquote-listify firstlist (cons 1 expression)))) (if (eq (car-safe expression) 'quote) (cons 0 (list 'quote s)) (cons 1 expression)))))) ;; backquote-listify takes (tag . structure) pairs from backquote-process ;; and decides between append, list, backquote-list*, and cons depending ;; on which tags are in the list. (defun backquote-listify (list old-tail) (let ((heads nil) (tail (cdr old-tail)) (list-tail list) (item nil)) (if (= (car old-tail) 0) (setq tail (eval tail) old-tail nil)) (while (consp list-tail) (setq item (car list-tail)) (setq list-tail (cdr list-tail)) (if (or heads old-tail (/= (car item) 0)) (setq heads (cons (cdr item) heads)) (setq tail (cons (eval (cdr item)) tail)))) (cond (tail (if (null old-tail) (setq tail (list 'quote tail))) (if heads (let ((use-list* (or (cdr heads) (and (consp (car heads)) (eq (car (car heads)) backquote-splice-symbol))))) (cons (if use-list* 'backquote-list* 'cons) (append heads (list tail)))) tail)) (t (cons 'list heads))))) ;; backquote.el ends here emacs-19.30/lisp/bib-mode.el100444 74777 1 16204 5353347773 14134 0ustar esrdaemon;;; bib-mode.el --- bib-mode, major mode for editing bib files. ;; Copyright (C) 1989 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: bib ;; 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: ;; GNU Emacs code to help maintain databases compatible with (troff) ;; refer and lookbib. The file bib-file should be set to your ;; bibliography file. Keys are automagically inserted as you type, ;; and appropriate keys are presented for various kinds of entries. ;;; Code: (defvar bib-file "~/my-bibliography.bib" "Default name of file used by `addbib'.") (defvar unread-bib-file "~/to-be-read.bib" "Default name of file used by `unread-bib' in Bib mode.") (defvar bib-mode-map (copy-keymap text-mode-map)) (define-key bib-mode-map "\C-M" 'return-key-bib) (define-key bib-mode-map "\C-c\C-u" 'unread-bib) (define-key bib-mode-map "\C-c\C-@" 'mark-bib) (define-key bib-mode-map "\e`" 'abbrev-mode) (defvar bib-mode-abbrev-table nil "Abbrev table used in Bib mode") (defun addbib () "Set up editor to add to troff bibliography file specified by global variable `bib-file'. See description of `bib-mode'." (interactive) (find-file bib-file) (goto-char (point-max)) (bib-mode) ) (defun bib-mode () "Mode for editing `lookbib' style bibliographies. Hit RETURN to get next % field key. If you want to ignore this field, just hit RETURN again. Use `text-mode' to turn this feature off. journal papers: A* T D J V N P K W X articles in books & proceedings: A* T D B E* I C P K W X tech reports: A* T D R I C K W X books: A* T D I C K W X Fields: A uthor T itle D ate J ournal V olume N umber P age K eywords B in book or proceedings E ditor C ity & state I nstitution, school, or publisher R eport number or 'phd thesis' or 'masters thesis' or 'draft' or 'unnumbered' or 'unpublished' W here can be found locally (login name, or ailib, etc.) X comments (not used in indexing) \\[unread-bib] appends current entry to a different file (for example, a file of papers to be read in the future), given by the value of the variable `unread-bib-file'. \\[mark-bib] marks current or previous entry. Abbreviations are saved in `bib-mode-abbrev-table'. Hook can be stored in `bib-mode-hook'. Field keys given by variable `bib-assoc'. Commands: \\{bib-mode-map} " (interactive) (text-mode) (use-local-map bib-mode-map) (setq mode-name "Bib") (setq major-mode 'bib-mode) (define-abbrev-table 'bib-mode-abbrev-table ()) (setq local-abbrev-table bib-mode-abbrev-table) (abbrev-mode 1) (run-hooks 'bib-mode-hook) ) (defconst bib-assoc '( (" *$" . "%A ") ("%A ." . "%A ") ("%A $" . "%T ") ("%T " . "%D ") ("%D " . "%J ") ("%J ." . "%V ") ("%V " . "%N ") ("%N " . "%P ") ("%P " . "%K ") ("%K " . "%W ") ("%W " . "%X ") ("%X " . "") ("%J $" . "%B ") ("%B ." . "%E ") ("%E ." . "%E ") ("%E $" . "%I ") ("%I " . "%C ") ("%C " . "%P ") ("%B $" . "%R ") ("%R " . "%I ") ) "Describes bibliographic database format. A line beginning with the car of an entry is followed by one beginning with the cdr. ") (defun bib-find-key (slots) (cond ((null slots) (if (bobp) "" (progn (previous-line 1) (bib-find-key bib-assoc)))) ((looking-at (car (car slots))) (cdr (car slots))) (t (bib-find-key (cdr slots))) )) (defvar bib-auto-capitalize t "*True to automatically capitalize appropriate fields in Bib mode.") (defconst bib-capitalized-fields "%[AETCBIJR]") (defun return-key-bib () "Magic when user hits return, used by `bib-mode'." (interactive) (if (eolp) (let (empty new-key beg-current end-current) (beginning-of-line) (setq empty (looking-at "%. $")) (if (not empty) (progn (end-of-line) (newline) (forward-line -1) )) (end-of-line) (setq end-current (point)) (beginning-of-line) (setq beg-current (point)) (setq new-key (bib-find-key bib-assoc)) (if (and (not empty) bib-auto-capitalize (looking-at bib-capitalized-fields)) (save-excursion (capitalize-title-region (+ (point) 3) end-current))) (goto-char beg-current) (if empty (kill-line nil) (forward-line 1) ) (insert-string new-key)) (newline))) (defun mark-bib () "Set mark at beginning of current or previous bib entry, point at end." (interactive) (beginning-of-line nil) (if (looking-at "^ *$") (re-search-backward "[^ \n]" nil 2)) (re-search-backward "^ *$" nil 2) (re-search-forward "^%") (beginning-of-line nil) (push-mark (point)) (re-search-forward "^ *$" nil 2) (next-line 1) (beginning-of-line nil)) (defun unread-bib () "Append current or previous entry to file of unread papers named by variable `unread-bib-file'." (interactive) (mark-bib) (if (get-file-buffer unread-bib-file) (append-to-buffer (get-file-buffer unread-bib-file) (mark) (point)) (append-to-file (mark) (point) unread-bib-file))) (defvar capitalize-title-stop-words (concat "the\\|and\\|of\\|is\\|a\\|an\\|of\\|for\\|in\\|to\\|in\\|on\\|at\\|" "by\\|with\\|that\\|its") "Words not to be capitialized in a title (unless they're the first word in the title).") (defvar capitalize-title-stop-regexp (concat "\\(" capitalize-title-stop-words "\\)\\(\\b\\|'\\)")) (defun capitalize-title-region (begin end) "Like `capitalize-region', but don't capitalize stop words, except the first." (interactive "r") (let ((case-fold-search nil) (orig-syntax-table (syntax-table))) (unwind-protect (save-restriction (set-syntax-table text-mode-syntax-table) (narrow-to-region begin end) (goto-char (point-min)) (if (looking-at "[A-Z][a-z]*[A-Z]") (forward-word 1) (capitalize-word 1)) (while (re-search-forward "\\<" nil t) (if (looking-at "[A-Z][a-z]*[A-Z]") (forward-word 1) (if (let ((case-fold-search t)) (looking-at capitalize-title-stop-regexp)) (downcase-word 1) (capitalize-word 1))) )) (set-syntax-table orig-syntax-table)))) (defun capitalize-title (s) "Like `capitalize', but don't capitalize stop words, except the first." (save-excursion (set-buffer (get-buffer-create "$$$Scratch$$$")) (erase-buffer) (insert s) (capitalize-title-region (point-min) (point-max)) (buffer-string))) (provide 'bib-mode) ;;; bib-mode.el ends here emacs-19.30/lisp/bibtex.el100444 12120 1 256736 6010540055 13724 0ustar rmsdaemon;;; bibtex.el --- BibTeX mode for GNU Emacs ;; Copyright (C) 1992, 1994, 1995 Free Software Foundation, Inc. ;; Author: Stefan Schoef ;; Bengt Martensson ;; Mark Shapiro ;; Mike Newton ;; Aaron Larson ;; Maintainer: Stefan Schoef ;; Keywords: BibTeX, LaTeX, TeX ;; 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: ;; Major mode for editing and validating BibTeX files. ;; Usage: ;; See documentation for function bibtex-mode (or type "\M-x describe-mode" ;; when you are in bibtex-mode). ;; Todo: ;; Distribute texinfo file. ;; Known Bugs: ;; 1. using regular expressions to match the entire BibTeX entry dies ;; on long entries (e.g. those containing abstracts) since ;; the length of regular expression matches is fairly limited. ;; 2. Calling bibtex-find-text in a string entry results in the ;; error message "Can't find enclosing Bibtex field" instead of ;; moving to the empty string. [reported by gernot@cs.unsw.oz.au] ;; (current keeper: schoef@informatik.uni-oldenburg.de ;; previous: alarson@src.honeywell.com) ;;; Code: ;; User Options: (defvar bibtex-field-left-delimiter "{" "*Set this to { or \" according to your personal preferences. This variable is buffer local.") (make-variable-buffer-local 'bibtex-field-left-delimiter) (defvar bibtex-field-right-delimiter "}" "*Set this to } or \" according to your personal preferences. This variable is buffer local.") (make-variable-buffer-local 'bibtex-field-right-delimiter) (defvar bibtex-include-OPTcrossref '("InProceedings" "InCollection") "*All entries listed here will have an OPTcrossref field.") (defvar bibtex-include-OPTkey t "*If non-nil, all entries will have an OPTkey field.") (defvar bibtex-include-OPTannote t "*If non-nil, all entries will have an OPTannote field.") (defvar bibtex-mode-user-optional-fields nil "*List of optional fields the user wants to have always present. Entries should be lists of strings with two elements (first element = name of the field, second element = comment to appear in the echo area).") (defvar bibtex-clean-entry-zap-empty-opts t "*If non-nil, bibtex-clean-entry will delete all empty optional fields.") (defvar bibtex-sort-ignore-string-entries t "*If true, BibTeX @STRING entries are not sort-significant. That means they are ignored when determining ordering of the buffer (e.g. sorting, locating alphabetical position for new entries, etc.).") (defvar bibtex-maintain-sorted-entries nil "*If true, bibtex-mode maintains all BibTeX entries in sorted order. Setting this variable to nil will strip off some comfort (e.g. TAB completion for reference keys) from bibtex-mode.") (defvar bibtex-entry-field-alist '( ("Article" . (((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the article (will be converted to lowercase)") ("journal" "Name of the journal (use string, remove braces)") ("year" "Year of publication")) (("volume" "Volume of the journal") ("number" "Number of the journal") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the journal") ("note" "Remarks to be put at the end of the \\bibitem"))) ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the article (will be converted to lowercase)")) (("journal" "Name of the journal (use string, remove braces)") ("year" "Year of publication") ("volume" "Volume of the journal") ("number" "Number of the journal") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the journal") ("note" "Remarks to be put at the end of the \\bibitem"))))) ("Book" . (((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the book") ("publisher" "Publishing company") ("year" "Year of publication")) (("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the book in the series") ("number" "Number of the book in a small series (overwritten by volume)") ("series" "Series in which the book appeared") ("address" "Address of the publisher") ("edition" "Edition of the book as a capitalized English word") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem"))))) ("Booklet" . (((("title" "Title of the booklet (will be converted to lowercase)")) (("author" "Author1 [and Author2 ...] [and others]") ("howpublished" "The way in which the booklet was published") ("address" "Address of the publisher") ("year" "Year of publication") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem"))))) ("InBook" . (((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the book") ("chapter" "Chapter in the book") ("publisher" "Publishing company") ("year" "Year of publication")) (("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the book in the series") ("number" "Number of the book in a small series (overwritten by volume)") ("series" "Series in which the book appeared") ("address" "Address of the publisher") ("edition" "Edition of the book as a capitalized English word") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the book") ("type" "Word to use instead of \"chapter\"") ("note" "Remarks to be put at the end of the \\bibitem"))) ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the book") ("chapter" "Chapter in the book")) (("publisher" "Publishing company") ("year" "Year of publication") ("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the book in the series") ("number" "Number of the book in a small series (overwritten by volume)") ("series" "Series in which the book appeared") ("address" "Address of the publisher") ("edition" "Edition of the book as a capitalized English word") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the book") ("type" "Word to use instead of \"chapter\"") ("note" "Remarks to be put at the end of the \\bibitem"))))) ("InCollection" . (((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the article in book (will be converted to lowercase)") ("booktitle" "Name of the book") ("publisher" "Publishing company") ("year" "Year of publication")) (("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the book in the series") ("number" "Number of the book in a small series (overwritten by volume)") ("series" "Series in which the book appeared") ("chapter" "Chapter in the book") ("type" "Word to use instead of \"chapter\"") ("address" "Address of the publisher") ("edition" "Edition of the book as a capitalized English word") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the book") ("note" "Remarks to be put at the end of the \\bibitem"))) ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the article in book (will be converted to lowercase)") ("booktitle" "Name of the book")) (("publisher" "Publishing company") ("year" "Year of publication") ("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the book in the series") ("number" "Number of the book in a small series (overwritten by volume)") ("series" "Series in which the book appeared") ("chapter" "Chapter in the book") ("type" "Word to use instead of \"chapter\"") ("address" "Address of the publisher") ("edition" "Edition of the book as a capitalized English word") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the book") ("note" "Remarks to be put at the end of the \\bibitem"))))) ("InProceedings" . (((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the article in proceedings (will be converted to lowercase)") ("booktitle" "Name of the conference proceedings") ("year" "Year of publication")) (("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the conference proceedings in the series") ("number" "Number of the conference proceedings in a small series (overwritten by volume)") ("series" "Series in which the conference proceedings appeared") ("organization" "Sponsoring organization of the conference") ("publisher" "Publishing company, its location") ("address" "Location of the Proceedings") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the conference proceedings") ("note" "Remarks to be put at the end of the \\bibitem"))) ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the article in proceedings (will be converted to lowercase)") ("booktitle" "Name of the conference proceedings")) (("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the conference proceedings in the series") ("number" "Number of the conference proceedings in a small series (overwritten by volume)") ("series" "Series in which the conference proceedings appeared") ("year" "Year of publication") ("organization" "Sponsoring organization of the conference") ("publisher" "Publishing company, its location") ("address" "Location of the Proceedings") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the conference proceedings") ("note" "Remarks to be put at the end of the \\bibitem"))))) ("Manual" . (((("title" "Title of the manual")) (("author" "Author1 [and Author2 ...] [and others]") ("organization" "Publishing organization of the manual") ("address" "Address of the organization") ("edition" "Edition of the manual as a capitalized English word") ("year" "Year of publication") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem"))))) ("MastersThesis" . (((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the master\'s thesis (will be converted to lowercase)") ("school" "School where the master\'s thesis was written") ("year" "Year of publication")) (("address" "Address of the school (if not part of field \"school\") or country") ("type" "Type of the master\'s thesis") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem"))))) ("Misc" . ((() (("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the reference (will be converted to lowercase)") ("howpublished" "The way in which the reference was published") ("year" "Year of publication") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem"))))) ("PhdThesis" . (((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the PhD. thesis") ("school" "School where the PhD. thesis was written") ("year" "Year of publication")) (("address" "Address of the school (if not part of field \"school\") or country") ("type" "Type of the PhD. thesis") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem"))))) ("Proceedings" . (((("title" "Title of the conference proceedings") ("year" "Year of publication")) (("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the conference proceedings in the series") ("number" "Number of the conference proceedings in a small series (overwritten by volume)") ("series" "Series in which the conference proceedings appeared") ("publisher" "Publishing company, its location") ("organization" "Sponsoring organization of the conference") ("address" "Location of the Proceedings") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem"))))) ("TechReport" . (((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the technical report (will be converted to lowercase)") ("institution" "Sponsoring institution of the report") ("year" "Year of publication")) (("type" "Type of the report (if other than \"technical report\")") ("number" "Number of the technical report") ("address" "Address of the institution (if not part of field \"institution\") or country") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem"))))) ("Unpublished" . (((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the unpublished reference (will be converted to lowercase)") ("note" "Remarks to be put at the end of the \\bibitem")) (("year" "Year of publication") ("month" "Month of the publication as a string (remove braces)"))))) ) "Defines reference types and their associated fields. List of (entry-name (required optional) (crossref-required crossref-optional)) triples. If the third element is nil, the first pair is always to be used. If not, the second pair is to be used in the case of presence of a crossref field and the third in the case of absence. Required , optional, crossref-required and crossref-optional are lists. Each element of these lists is a list of strings with two elements (first element = name of the field, second element = comment to appear in the echo area).") (defvar bibtex-predefined-strings '( ("jan") ("feb") ("mar") ("apr") ("may") ("jun") ("jul") ("aug") ("sep") ("oct") ("nov") ("dec") ("acmcs") ("acta") ("cacm") ("ibmjrd") ("ibmsj") ("ieeese") ("ieeetc") ("ieeetcad") ("ipl") ("jacm") ("jcss") ("scp") ("sicomp") ("tcs") ("tocs") ("tods") ("tog") ("toms") ("toois") ("toplas") ) "Alist of string definitions. Should contain the strings defined in the BibTeX style files. Each element is a list with just one element: the string.") (defvar bibtex-string-files nil "*List of BibTeX files containing string definitions. Those files must be specified using pathnames relative to the directories specified in $BIBINPUTS. This variable is only evaluated when bibtex-mode is entered (i. e. when loading the BibTeX file).") (defvar bibtex-help-message t "*If not nil print help messages in the echo area on entering a new field.") (defvar bibtex-autokey-names 1 "*Number of names to use for the automatically generated reference key. If this is set to anything but a number, all names are used. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-name-change-strings '(("\\\\\\\"a" "ae") ("\\\\\\\"o" "oe") ("\\\\\\\"u" "ue") ("\\\\\\\"s" "ss") ("\\\\\\\"A" "Ae") ("\\\\\\\"O" "Oe") ("\\\\\\\"U" "Ue") ("{" "") ("}" "")) "Alist of (old-regexp new-string) pairs. Any part of name matching a old-regexp is replaced by new-string. Case of the old-regexp is significant. All regexps are tried in the order in which they appear in the list, so be sure to avoid recursion here. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-name-length 'infty "*Number of characters from name to incorporate into key. If this is set to anything but a number, all characters are used. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-name-separator "" "*String that comes between any two names in the key. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-year-length 2 "*Number of rightmost digits from the year field yo incorporate into key. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-titlewords 5 "*Number of title words to use for the automatically generated reference key. If this is set to anything but a number, all title words are used. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-title-terminators '("\\." "!" "\\?" ":" ";" "---") "*Regexp list defining the termination of the main part of the title. Case of the regexps is ignored. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-titlewords-stretch 2 "*Number of words that can additionally be used from the title. These words are used only, if a sentence from the title can be ended then. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-titleword-first-ignore '("a" "an" "on" "the" "eine?" "der" "die" "das") "*Determines words that may begin a title but are not to be used in the key. Each item of the list is a regexp. If the first word of the title matchs a regexp from that list, it is not included in the title, even if it is capitalized. Regexps in the list must be entered using lowercase letters.") (defvar bibtex-autokey-titleword-abbrevs nil "*Determines exceptions to the usual abbreviation mechanism. A list of (old-regexp new-string) pairs. Use all lowercase letters for old-regexp. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-titleword-change-strings '(("\\\\\\\"a" "ae") ("\\\\\\\"o" "oe") ("\\\\\\\"u" "ue") ("\\\\\\\"s" "ss") ("\\\\\\\"A" "Ae") ("\\\\\\\"O" "Oe") ("\\\\\\\"U" "Ue") ("{" "") ("}" "")) "Alist of (old-regexp new-string) pairs. Any part of title word matching a old-regexp is replaced by new-string. Case of the old-regexp is significant. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-titleword-length 5 "*Number of characters from title words to incorporate into key. If this is set to anything but a number, all characters are used. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-titleword-separator "_" "*String to be put between the title words. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-name-year-separator "" "*String to be put between name part and year part of key. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-year-title-separator ":_" "*String to be put between name part and year part of key. See the documentation of function bibtex-generate-autokey for further detail.") (defvar bibtex-autokey-edit-before-use t "*If non-nil, user is allowed to edit the generated key before it is used.") ;; Syntax Table, Keybindings and BibTeX Entry List (defvar bibtex-mode-syntax-table (let ((st (make-syntax-table))) ;; [alarson:19920214.1004CST] make double quote a string quote (modify-syntax-entry ?\" "\"" st) (modify-syntax-entry ?$ "$$ " st) (modify-syntax-entry ?% "< " st) (modify-syntax-entry ?' "w " st) (modify-syntax-entry ?@ "w " st) (modify-syntax-entry ?\\ "\\" st) (modify-syntax-entry ?\f "> " st) (modify-syntax-entry ?\n "> " st) (modify-syntax-entry ?~ " " st) st)) (defvar bibtex-mode-map (let ((km (make-sparse-keymap))) (define-key km "\t" 'bibtex-find-text) (define-key km "\n" 'bibtex-next-field) (define-key km "\M-\t" 'bibtex-complete-string) (define-key km "\C-c\"" 'bibtex-remove-double-quotes-or-braces) (define-key km "\C-c{" 'bibtex-remove-double-quotes-or-braces) (define-key km "\C-c}" 'bibtex-remove-double-quotes-or-braces) (define-key km "\C-c\C-c" 'bibtex-clean-entry) (define-key km "\C-c?" 'bibtex-print-help-message) (define-key km "\C-c\C-p" 'bibtex-pop-previous) (define-key km "\C-c\C-n" 'bibtex-pop-next) (define-key km "\C-c\C-k" 'bibtex-kill-optional-field) (define-key km "\C-c\C-d" 'bibtex-empty-field) (define-key km "\C-c$" 'bibtex-ispell-entry) (define-key km "\M-\C-a" 'bibtex-beginning-of-entry) (define-key km "\M-\C-e" 'bibtex-end-of-entry) (define-key km "\C-c\C-b" 'bibtex-entry) (define-key km "\C-c\C-q" 'bibtex-hide-entry-bodies) (define-key km "\C-c\C-a" 'show-all) (define-key km "\C-c\C-rn" 'bibtex-narrow-to-entry) (define-key km "\C-c\C-rw" 'widen) (define-key km "\C-c\C-o" 'bibtex-remove-OPT) (define-key km "\C-c\C-e\C-i" 'bibtex-InProceedings) (define-key km "\C-c\C-ei" 'bibtex-InCollection) (define-key km "\C-c\C-eI" 'bibtex-InBook) (define-key km "\C-c\C-e\C-a" 'bibtex-Article) (define-key km "\C-c\C-e\C-b" 'bibtex-InBook) (define-key km "\C-c\C-eb" 'bibtex-Book) (define-key km "\C-c\C-eB" 'bibtex-Booklet) (define-key km "\C-c\C-e\C-c" 'bibtex-InCollection) (define-key km "\C-c\C-e\C-m" 'bibtex-Manual) (define-key km "\C-c\C-em" 'bibtex-MastersThesis) (define-key km "\C-c\C-eM" 'bibtex-Misc) (define-key km "\C-c\C-e\C-p" 'bibtex-InProceedings) (define-key km "\C-c\C-ep" 'bibtex-Proceedings) (define-key km "\C-c\C-eP" 'bibtex-PhdThesis) (define-key km "\C-c\C-e\M-p" 'bibtex-preamble) (define-key km "\C-c\C-e\C-s" 'bibtex-string) (define-key km "\C-c\C-e\C-t" 'bibtex-TechReport) (define-key km "\C-c\C-e\C-u" 'bibtex-Unpublished) km)) (define-key bibtex-mode-map [menu-bar move/edit] (cons "BibTeX-Edit" (make-sparse-keymap "BibTeX-Edit"))) (define-key bibtex-mode-map [menu-bar move/edit bibtex-print-help-message] '("Help about Current Field" . bibtex-print-help-message)) (define-key bibtex-mode-map [menu-bar move/edit bibtex-complete-string] '("String Complete" . bibtex-complete-string)) (define-key bibtex-mode-map [menu-bar move/edit bibtex-next-field] '("Next Field" . bibtex-next-field)) (define-key bibtex-mode-map [menu-bar move/edit bibtex-find-text] '("End of Field" . bibtex-find-text)) (define-key bibtex-mode-map [menu-bar move/edit bibtex-pop-previous] '("Snatch from Similar Preceding Field" . bibtex-pop-previous)) (define-key bibtex-mode-map [menu-bar move/edit bibtex-pop-next] '("Snatch from Similar Following Field" . bibtex-pop-next)) (define-key bibtex-mode-map [menu-bar move/edit bibtex-remove-OPT] '("Remove OPT" . bibtex-remove-OPT)) (define-key bibtex-mode-map [menu-bar move/edit bibtex-remove-double-quotes-or-braces] '("Remove Quotes or Braces" . bibtex-remove-double-quotes-or-braces)) (define-key bibtex-mode-map [menu-bar move/edit bibtex-clean-entry] '("Clean Up Entry" . bibtex-clean-entry)) (define-key bibtex-mode-map [menu-bar move/edit bibtex-sort-entries] '("Sort Entries" . bibtex-sort-entries)) (define-key bibtex-mode-map [menu-bar move/edit bibtex-validate-buffer] '("Validate Entries" . bibtex-validate-buffer)) (define-key bibtex-mode-map [menu-bar entry-types] (cons "Entry-Types" (make-sparse-keymap "Entry-Types"))) (define-key bibtex-mode-map [menu-bar entry-types bibtex-preamble] '("Preamble" . bibtex-preamble)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-string] '("String" . bibtex-string)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-Misc] '("Miscellaneous" . bibtex-Misc)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-Unpublished] '("Unpublished" . bibtex-Unpublished)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-Manual] '("Technical Manual" . bibtex-Manual)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-TechReport] '("Technical Report" . bibtex-TechReport)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-MastersThesis] '("Master's Thesis" . bibtex-MastersThesis)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-PhdThesis] '("PhD. Thesis" . bibtex-PhdThesis)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-Booklet] '("Booklet (Bound, but no Publisher/Institution)" . bibtex-Booklet)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-Book] '("Book" . bibtex-Book)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-Proceedings] '("Conference Proceedings" . bibtex-Proceedings)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-InBook] '("Chapter or Pages in a Book" . bibtex-InBook)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-InCollection] '("Article in a Collection" . bibtex-InCollection)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-InProceedings] '("Article in Conference Proceedings" . bibtex-InProceedings)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-Article] '("Article in Journal" . bibtex-Article)) ;; Internal Variables (defvar bibtex-pop-previous-search-point nil) ;; Next point where bibtex-pop-previous starts looking for a similar ;; entry. (defvar bibtex-pop-next-search-point nil) ;; Next point where bibtex-pop-next starts looking for a similar entry. (defvar bibtex-completion-candidates nil) ;; Candidates for bibtex-complete-string. Initialized from ;; bibtex-predefined-strings and bibtex-string-files. This variable is ;; buffer-local. (make-variable-buffer-local 'bibtex-completion-candidates) ;; Functions to Parse the BibTeX Entries (defun bibtex-cfield (name text) ;; Create a regexp for a BibTeX field of name NAME and text TEXT. (concat ",[ \t\n]*\\(" name "\\)[ \t\n]*=[ \t\n]*\\(" text "\\)")) (defconst bibtex-name-in-cfield 1) ;; The regexp subexpression number of the name part in bibtex-cfield. (defconst bibtex-text-in-cfield 2) ;; The regexp subexpression number of the text part in bibtex-cfield. (defconst bibtex-field-name "[A-Za-z][]A-Za-z0-9.:;?!`'()/*@_+=-]*") ;; Regexp defining the name part of a BibTeX field. (defconst bibtex-field-const "[0-9A-Za-z][A-Za-z0-9:_+-]*" "Format of a bibtex field constant.") (defconst bibtex-field-string (concat "\\(" "{\\(\\({\\(\\({[^}]*}\\)\\|\\([^{}]\\)\\)*}\\)\\|\\([^{}]\\)\\)*}" ;; maximal twice nested {} "\\)\\|\\(" "\"[^\"]*[^\\\\]\"\\|\"\"\\)")) ;; Match either a string or an empty string. (defconst bibtex-field-string-or-const (concat bibtex-field-const "\\|" bibtex-field-string)) ;; Match either bibtex-field-string or bibtex-field-const. (defconst bibtex-field-text (concat "\\(" bibtex-field-string-or-const "\\)" "\\([ \t\n]+#[ \t\n]+\\(" bibtex-field-string-or-const "\\)\\)*\\|" "{[^{}]*[^\\\\]}")) ;; Regexp defining the text part of a BibTeX field: either a string, ;; or an empty string, or a constant followed by one or more # / ;; constant pairs. Also matches simple {...} patterns. (defconst bibtex-field (bibtex-cfield bibtex-field-name bibtex-field-text)) ;; Regexp defining the format of a BibTeX field. (defconst bibtex-name-in-field bibtex-name-in-cfield) ;; The regexp subexpression number of the name part in BibTeX-field. (defconst bibtex-text-in-field bibtex-text-in-cfield) ;; The regexp subexpression number of the text part in BibTeX-field. (defconst bibtex-reference-type "@[A-Za-z]+") ;; Regexp defining the type part of a BibTeX reference entry. (defconst bibtex-reference-head (concat "^\\( \\|\t\\)*\\(" bibtex-reference-type "\\)[ \t]*[({]\\(" bibtex-field-name "\\)")) ;; Regexp defining format of the header line of a BibTeX reference ;; entry. (defconst bibtex-type-in-head 2) ;; The regexp subexpression number of the type part in ;; bibtex-reference-head. (defconst bibtex-key-in-head 3) ;; The regexp subexpression number of the key part in ;; bibtex-reference-head. (defconst bibtex-reference (concat bibtex-reference-head "\\([ \t\n]*" bibtex-field "\\)*" "[ \t\n]*[})]")) ;; Regexp defining the format of a BibTeX reference entry. (defconst bibtex-type-in-reference bibtex-type-in-head) ;; The regexp subexpression number of the type part in ;; bibtex-reference. (defconst bibtex-key-in-reference bibtex-key-in-head) ;; The regexp subexpression number of the key part in ;; bibtex-reference. (defconst bibtex-string (concat "^[ \t]*@[sS][tT][rR][iI][nN][gG][ \t\n]*[({][ \t\n]*\\(" bibtex-field-name "\\)[ \t\n]*=[ \t\n]*\\(" bibtex-field-text "\\)[ \t\n]*[})]")) ;; Regexp defining the format of a BibTeX string entry. (defconst bibtex-name-in-string 1) ;; The regexp subexpression of the name part in bibtex-string. (defconst bibtex-text-in-string 2) ;; The regexp subexpression of the text part in bibtex-string. (defconst bibtex-name-alignment 2) ;; Alignment for the name part in BibTeX fields. Chosen on aesthetic ;; grounds only. (defconst bibtex-text-alignment (length " organization = ")) ;; Alignment for the text part in BibTeX fields. Equal to the space ;; needed for the longest name part. ;; Helper Functions (defun assoc-ignore-case (string alist) ;; Return non-nil if STRING is `equal' to the car of an element of ;; LIST. Comparison is done with case ignored. The value is actually ;; the element of LIST whose car is `equal' to STRING. (or (assoc string alist) (while (and alist (not (string-equal (downcase string) (downcase (car (car alist)))))) (setq alist (cdr alist))) (car alist))) (defun member-of-regexp (string list) ;; Return non-nil if STRING is exactly matched by an element of ;; LIST. This function is influenced by the actual value of ;; `case-fold-search'. The value is actually the tail of LIST whose ;; car matches STRING. (while (and list (not (string-match (concat "^" (car list) "$") string))) (setq list (cdr list))) list) (defun assoc-of-regexp (string alist) ;; Return non-nil if STRING is exactly matched by the car of an ;; element of LIST. This function is influenced by the actual value ;; of `case-fold-search'. The value is actually the element of LIST ;; whose car matches STRING. (while (and alist (not (string-match (concat "^" (car (car alist)) "$") string))) (setq alist (cdr alist))) (car alist)) (defun skip-whitespace-and-comments () (let ((md (match-data))) (unwind-protect (while (cond ((looking-at "\\s>+\\|\\s +") ;; was whitespace ;; NOTE: also checked end-comment. In latex and ;; lisp modes, newline is an end comment, but it ;; should also be a whitespace char. (goto-char (match-end 0))) ;; If looking at beginning of comment, skip to end. ((looking-at "\\s<") (re-search-forward "\\s>")))) (store-match-data md)))) (defun map-bibtex-entries (fun) ;; Call FUN for each BibTeX entry starting with the current. Do this ;; to the end of the file. FUN is called with one argument, the key ;; of the entry, and with point inside the entry. If ;; bibtex-sort-ignore-string-entries is true, FUN will not be called ;; for @string entries. (bibtex-beginning-of-entry) (while (re-search-forward "^@[^{]*{[ \t]*\\([^, ]*\\)" nil t) (if (and bibtex-sort-ignore-string-entries (string-equal "@string{" (downcase (buffer-substring-no-properties (match-beginning 0) (match-beginning 1))))) nil (funcall fun (buffer-substring-no-properties (match-beginning 1) (match-end 1)))))) (defun bibtex-flash-head () ;; Flash at BibTeX reference head before point, if exists. (let ((flash)) (cond ((re-search-backward bibtex-reference-head (point-min) t) (goto-char (match-beginning bibtex-type-in-head)) (setq flash (match-end bibtex-key-in-reference))) (t (end-of-line) (skip-chars-backward " \t") (setq flash (point)) (beginning-of-line) (skip-chars-forward " \t"))) (if (pos-visible-in-window-p (point)) (sit-for 1) (message "From: %s" (buffer-substring (point) flash))))) (defun bibtex-move-outside-of-entry () ;; Make sure we are outside of a BibTeX entry. (cond ((or (= (point) (point-max)) (= (point) (point-min)) (looking-at "[ \n]*@") ) t) (t (backward-paragraph) (forward-paragraph))) (re-search-forward "[ \t\n]*" (point-max) t)) (defun beginning-of-first-bibtex-entry () ;; Go to the beginning of the first BibTeX entry in buffer. (goto-char (point-min)) (cond ((re-search-forward "^@" nil 'move) (beginning-of-line)) ((and (bobp) (eobp)) nil) (t (message "Warning: No BibTeX entries found!")))) (defun bibtex-inside-field () ;; Try to avoid point being at end of a BibTeX field. (end-of-line) (skip-chars-backward " \t") ;MON - maybe delete these chars? (cond ((= (preceding-char) ?,) (forward-char -2))) ; -1 --> -2 sct@dcs.edinburgh.ac.uk (cond ((= (preceding-char) (aref bibtex-field-right-delimiter 0)) (forward-char -1)))) ;MON - only go back if quote (defun bibtex-enclosing-field () ;; Search for BibTeX field enclosing point. Point moves to end of ;; field; also, use match-beginning and match-end to parse the field. ;; sct@dcs.edinburgh.ac.uk (let ((old-point (point))) (condition-case errname (bibtex-enclosing-regexp bibtex-field) (search-failed (goto-char old-point) (error "Can't find enclosing BibTeX field."))))) (defun bibtex-enclosing-reference () ;; Search for BibTeX reference enclosing point. Point moves to begin ;; of reference. (match-end 0) denotes end of reference. ;; Hacked up for speed. Parsing isn't guaranteed any more. ;; schoef@informatik.uni-oldenburg.de ;; sct@dcs.edinburgh.ac.uk (let ((old-point (point))) (if (not (re-search-backward "^@[A-Za-z]+[ \t\n]*[{(][^, \t\n]*[ \t\n]*," (point-min) t)) (progn (error "Can't find enclosing BibTeX reference.") (goto-char old-point))) (let ((pnt (point))) (if (not (re-search-forward "^[)}]$" (point-max) t)) (progn (error "Can't find enclosing BibTeX reference.") (goto-char old-point)) (goto-char pnt))))) (defun bibtex-enclosing-regexp (regexp) ;; Search for REGEXP enclosing point. Point moves to end of ;; REGEXP. See also match-beginning and match-end. If an enclosing ;; REGEXP is not found, signals search-failed; point is left in an ;; undefined location. ;; Doesn't something like this exist already? ; compute reasonable limits for the loop (let* ((initial (point)) (right (if (re-search-forward regexp (point-max) t) (match-end 0) (point-max))) (left (progn (goto-char initial) (if (re-search-backward regexp (point-min) t) (match-beginning 0) (point-min))))) ; within the prescribed limits, loop until a match is found (goto-char left) (re-search-forward regexp right nil 1) (if (> (match-beginning 0) initial) (signal 'search-failed (list regexp))) (while (<= (match-end 0) initial) (re-search-forward regexp right nil 1) (if (> (match-beginning 0) initial) (signal 'search-failed (list regexp)))) )) (defun bibtex-autokey-change (string change-list) ;; Returns a string where some regexps are changed according to ;; change-list. Every item of change-list is an (old-regexp ;; new-string) pair. (let ((return-string string) case-fold-search (index 0) (len (length change-list)) change-item) (while (< index len) (setq change-item (elt change-list index)) (while (string-match (car change-item) return-string) (setq return-string (concat (substring return-string 0 (match-beginning 0)) (elt change-item 1) (substring return-string (match-end 0))))) (setq index (1+ index))) return-string)) (defun bibtex-autokey-abbrev (string len) ;; Returns an abbreviation of string with at least len ;; characters. String is aborted only after a consonant or at the ;; word end. If len is not a number, string is returned unchanged. (let* ((string-length (length string)) (len (if (numberp len) (min len string-length) len)) (return-string (if (numberp len) (substring string 0 len))) (index len) (vowels '(?a ?e ?i ?o ?u ?A ?E ?I ?O ?U))) (if (numberp len) (progn (while (and (< index string-length) (member (elt return-string (1- (length return-string))) vowels)) (setq return-string (concat return-string (substring string index (1+ index))) index (1+ index))) return-string) string))) (defun bibtex-generate-autokey () "Generates automatically a key from the author/editor and the title field. The generation algorithm works as follows: 1. If there is a non-empty author (preferred) or editor field, use it for the name part of the key. 2. Change any substring found in `bibtex-autokey-name-change-strings' to the corresponding new one (see documentation of this variable for further detail). 3. For every of the first `bibtex-autokey-names' names in the \"name\" field, determine the last name. 4. From every last name, take at least `bibtex-autokey-name-length' characters (abort only after a consonant or at a word end). 5. Build the name part of the key by concatenating all abbreviated last names with the string `bibtex-autokey-name-separator' between any two. 6. Build the year part of the key by truncating the contents of the \"year\" field to the rightmost `bibtex-autokey-year-length' digits (useful values are 2 and 4). 7. For the title part of the key change the contents of the \"title\" field of the reference according to `bibtex-autokey-titleword-change-strings' to the corresponding new one (see documentation of this variable for further detail). 8. Abbreviate the result to the string up to (but not including) the first occurence of a regexp matched by the items of `bibtex-autokey-title-terminators' and delete the first word if it appears in `bibtex-autokey-titleword-first-ignore'. Build the title part of the key by using at least the first `bibtex-autokey-titlewords' capitalized words from this abbreviated title. If the abbreviated title ends after maximal `bibtex-autokey-titlewords' + `bibtex-autokey-titlewords-stretch' capitalized words, all capitalized words from the abbreviated title are used. 9. For every used title word that appears in `bibtex-autokey-titleword-abbrevs' use the corresponding abbreviation (see documentation of this variable for further detail). 10. From every title word not generated by an abbreviation, take at least `bibtex-autokey-titleword-length' characters (abort only after a consonant or at a word end). 11. Build the title part of the key by concatenating all abbreviated title words with the string `bibtex-autokey-titleword-separator' between any two. 12. At least, to get the key, concatenate the name part, the year part and the title part with `bibtex-autokey-name-year-separator' between the name and the year if both are non-empty and `bibtex-autokey-year-title-separator' between the year and the title if both are non-empty." (let* ((pnt (point)) (min (progn (bibtex-beginning-of-entry) (point))) (max (progn (bibtex-end-of-entry) (point))) (namefield (progn (goto-char min) (if (or (search-forward-regexp "^[ \t]*author[ \t]*=" max t) (search-forward-regexp "^[ \t]*editor[ \t]*=" max t)) (let* (bibtex-help-message (start (progn (bibtex-find-text t) (point))) (end (progn (bibtex-find-text nil) (point)))) (bibtex-autokey-change (buffer-substring-no-properties start end) bibtex-autokey-name-change-strings)) ""))) (namelist (mapcar (function (lambda (fullname) (bibtex-autokey-abbrev (if (string-match "," fullname) (substring fullname 0 (match-beginning 0)) (progn (if (string-match " [^ ]*$" fullname) (substring fullname (1+ (match-beginning 0))) fullname))) bibtex-autokey-name-length))) ;; Gather all names into a list (let (names (counter 0)) (while (and (not (equal namefield "")) (or (not (numberp bibtex-autokey-names)) (< counter bibtex-autokey-names))) (if (string-match " and " namefield) (progn (setq names (append names (list (downcase (substring namefield 0 (match-beginning 0))))) namefield (substring namefield (match-end 0)))) (setq names (append names (list (downcase namefield))) namefield "")) (setq counter (1+ counter))) names))) (namepart (mapconcat (function (lambda (name) name)) namelist bibtex-autokey-name-separator)) (yearfield (progn (goto-char min) (if (search-forward-regexp "^[ \t]*year[ \t]*=[ \t]*\\([0-9]*\\)" max t) (buffer-substring-no-properties (match-beginning 1) (match-end 1)) ""))) (yearpart (if (equal yearfield "") "" (substring yearfield (- (length yearfield) bibtex-autokey-year-length)))) (titlestring (let ((case-fold-search t) (titlefield (progn (goto-char min) (if (search-forward-regexp "^[ \t]*title[ \t]*=" max t) (let* (bibtex-help-message (start (progn (bibtex-find-text t) (point))) (end (progn (bibtex-find-text nil) (point)))) (bibtex-autokey-change (buffer-substring-no-properties start end) bibtex-autokey-titleword-change-strings)) ""))) case-fold-search (index 0) (numberofitems (length bibtex-autokey-title-terminators))) (while (< index numberofitems) (if (string-match (elt bibtex-autokey-title-terminators index) titlefield) (setq titlefield (substring titlefield 0 (match-beginning 0)))) (setq index (1+ index))) titlefield)) (titlelist (mapcar (function (lambda (titleword) (let ((abbrev (assoc-of-regexp titleword bibtex-autokey-titleword-abbrevs))) (if abbrev (elt abbrev 1) (bibtex-autokey-abbrev titleword bibtex-autokey-titleword-length))))) ;; Gather all titlewords into a list (let (titlewords titlewords-extra case-fold-search (counter 0) (first t)) (while (and (not (equal titlestring "")) (or (not (numberp bibtex-autokey-titlewords)) (< counter (+ bibtex-autokey-titlewords bibtex-autokey-titlewords-stretch)))) (if (string-match "\\b[A-Z][A-Za-z0-9]*" titlestring) (let* ((end-match (match-end 0)) (titleword (downcase (substring titlestring (match-beginning 0) end-match)))) (if (or (not (numberp bibtex-autokey-titlewords)) (< counter bibtex-autokey-titlewords)) (if (and first (member-of-regexp titleword bibtex-autokey-titleword-first-ignore)) (setq counter -1) (setq titlewords (append titlewords (list titleword)))) (setq titlewords-extra (append titlewords-extra (list titleword)))) (setq titlestring (substring titlestring end-match))) (setq titlestring "")) (setq first nil counter (1+ counter))) (if (string-match "\\b[A-Z][^ ]*\\b" titlestring) titlewords (append titlewords titlewords-extra))))) (titlepart (mapconcat (function (lambda (name) name)) titlelist bibtex-autokey-titleword-separator)) (autokey (concat namepart (if (not (or (equal namepart "") (equal yearpart ""))) bibtex-autokey-name-year-separator) yearpart (if (not (or (and (equal namepart "") (equal yearpart "")) (equal titlepart ""))) bibtex-autokey-year-title-separator) titlepart))) (goto-char pnt) autokey)) ;; Interactive Functions: ;;;###autoload (defun bibtex-mode () "Major mode for editing BibTeX files. \\{bibtex-mode-map} A command such as \\[bibtex-Book] will outline the fields for a BibTeX book entry. The optional fields start with the string OPT, and thus ignored by BibTeX. The OPT string may be removed from a field with \\[bibtex-remove-OPT]. \\[bibtex-kill-optional-field] kills the current optional field entirely. \\[bibtex-remove-double-quotes-or-braces] removes the double-quotes or braces around the text of the current field. \\[bibtex-empty-field] replaces the text of the current field with the default \"\" or {}. The command \\[bibtex-clean-entry] cleans the current entry, i.e. (i) removes double-quotes or braces from entirely numerical fields, (ii) removes OPT from all non-empty optional fields, (iii) removes all empty optional fields, and (iv) checks that no non-optional fields are empty. Use \\[bibtex-find-text] to position the cursor at the end of the current field. Use \\[bibtex-next-field] to move to end of the next field. The following may be of interest as well: Functions: bibtex-entry bibtex-print-help-message bibtex-beginning-of-entry bibtex-end-of-entry bibtex-ispell-abstract bibtex-narrow-to-entry bibtex-hide-entry-bodies bibtex-sort-entries bibtex-validate-buffer bibtex-pop-previous bibtex-pop-next bibtex-complete-string Variables: bibtex-field-left-delimiter bibtex-field-right-delimiter bibtex-include-OPTcrossref bibtex-include-OPTkey bibtex-include-OPTannote bibtex-mode-user-optional-fields bibtex-clean-entry-zap-empty-opts bibtex-sort-ignore-string-entries bibtex-maintain-sorted-entries bibtex-entry-field-alist bibtex-predefined-strings bibtex-string-files --------------------------------------------------------- Entry to this mode calls the value of bibtex-mode-hook if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map bibtex-mode-map) (setq major-mode 'bibtex-mode) (setq mode-name "BibTeX") (set-syntax-table bibtex-mode-syntax-table) (setq bibtex-completion-candidates bibtex-predefined-strings) (mapcar (function (lambda (filename) ;; collect pathnames (let* ((bib (getenv "BIBINPUTS")) (path (if bib bib ".")) (dirs (mapcar (function (lambda (dirname) ;; strips off trailing slashes (let ((len (length dirname))) (if (equal (elt dirname (1- len)) "/") (substring dirname 0 (1- (1- len))) dirname)))) (let (actdirs) (while (string-match ":" path) (setq actdirs (append actdirs (list (substring path 0 (1- (match-end 0))))) path (substring path (match-end 0)))) (append actdirs (list path))))) (filename (if (string-match "\.bib$" filename) filename (concat filename ".bib"))) fullfilename (item 0) (size (length dirs))) ;; test filenames (while (and (< item size) (not (file-readable-p (setq fullfilename (concat (elt dirs item) "/" filename))))) (setq item (1+ item))) (if (< item size) ;; file was found (let ((curbuf (current-buffer)) (bufname (make-temp-name "")) (compl bibtex-completion-candidates)) (create-file-buffer bufname) (set-buffer bufname) (insert-file-contents fullfilename) (goto-char (point-min)) (while (search-forward-regexp bibtex-string nil t) (setq compl (append compl (list (list (buffer-substring-no-properties (match-beginning bibtex-name-in-string) (match-end bibtex-name-in-string))))))) (kill-buffer bufname) (set-buffer curbuf) (setq bibtex-completion-candidates compl)) (error "File %s not in $BIBINPUTS paths" filename))))) bibtex-string-files) (make-local-variable 'paragraph-start) (setq paragraph-start "[ \f\n\t]*$") (make-local-variable 'comment-start) (setq comment-start "%") (auto-fill-mode 1) ; nice alignments (setq left-margin (+ bibtex-text-alignment 1)) (run-hooks 'bibtex-mode-hook)) (defun bibtex-entry (entry-type &optional required optional) (interactive (let* ((completion-ignore-case t) (e-t (completing-read "Entry Type: " bibtex-entry-field-alist nil t))) (list e-t))) (if (and (null required) (null optional)) (let* ((e (assoc-ignore-case entry-type bibtex-entry-field-alist)) (r-n-o (elt e 1)) (c-ref (elt e 2))) (if (null e) (error "Bibtex entry type %s not defined!" entry-type)) (if (and (member entry-type bibtex-include-OPTcrossref) c-ref) (setq required (elt c-ref 0) optional (elt c-ref 1)) (setq required (elt r-n-o 0) optional (elt r-n-o 1))))) (let* (labels label (case-fold-search t) (key (if bibtex-maintain-sorted-entries (progn (save-excursion (goto-char (point-min)) (while (re-search-forward "\\(^@[a-z]+[ \t\n]*[{(][ \t\n]*\\([^ ,\t\n]+\\)[ \t\n]*,\\)\\|\\(^[ \t\n]*crossref[ \t\n]*=[ \t\n]*[{\"]\\([^ ,\t\n]*\\)[}\"],$\\)" nil t) (if (match-beginning 2) (setq label (buffer-substring-no-properties (match-beginning 2) (match-end 2))) (setq label (buffer-substring-no-properties (match-beginning 4) (match-end 4)))) (if (not (assoc label labels)) (setq labels (cons (list label) labels))))) (completing-read (format "%s key: " entry-type) labels))))) (if key (bibtex-find-entry-location key)) (bibtex-move-outside-of-entry) (insert "@" entry-type "{") (if key (insert key)) (save-excursion (mapcar 'bibtex-make-field required) (if (member entry-type bibtex-include-OPTcrossref) (bibtex-make-optional-field '("crossref"))) (if bibtex-include-OPTkey (bibtex-make-optional-field '("key"))) (mapcar 'bibtex-make-optional-field optional) (mapcar 'bibtex-make-optional-field bibtex-mode-user-optional-fields) (if bibtex-include-OPTannote (bibtex-make-optional-field '("annote"))) (insert "\n}\n\n")) (if key (bibtex-next-field t)) (run-hooks 'bibtex-add-entry-hook))) (defun bibtex-print-help-message () "Prints helpful information about current field in current BibTeX entry." (interactive) (let* ((pnt (point)) (field-name (progn (beginning-of-line) (condition-case errname (bibtex-enclosing-regexp bibtex-field) (search-failed (goto-char pnt) (error "Not on BibTeX field"))) (re-search-backward "^[ \t]*\\([A-Za-z]+\\)[ \t\n]*=" nil t) (let ((mb (match-beginning 1)) (me (match-end 1))) (buffer-substring-no-properties (if (looking-at "^[ \t]*OPT") (+ 3 mb) mb) me)))) (reference-type (progn (re-search-backward "^@\\([A-Za-z]+\\)[ \t\n]*[{(][^, \t\n]*[ \t\n]*," nil t) (buffer-substring-no-properties (match-beginning 1) (match-end 1)))) (entry-list (assoc-ignore-case reference-type bibtex-entry-field-alist)) (c-r-list (elt entry-list 2)) (req-opt-list (if (and (member reference-type bibtex-include-OPTcrossref) c-r-list) c-r-list (elt entry-list 1))) (list-of-entries (append (elt req-opt-list 0) (elt req-opt-list 1) bibtex-mode-user-optional-fields (if (member reference-type bibtex-include-OPTcrossref) '(("crossref" "Label of the crossreferenced entry"))) (if bibtex-include-OPTannote '(("annote" "Personal annotation (ignored)"))) (if bibtex-include-OPTkey '(("key" "Key used for label creation if author and editor fields are missing")))))) (goto-char pnt) (if (assoc field-name list-of-entries) (message (elt (assoc field-name list-of-entries) 1)) (message "NO COMMENT AVAILABLE")))) (defun bibtex-make-field (e-t) "Makes a field named E-T in current BibTeX entry." (interactive "sBibTeX entry type: ") (let ((name (if (consp e-t) (elt e-t 0) e-t))) (bibtex-find-text nil) (forward-char 1) (insert ",\n") (indent-to-column bibtex-name-alignment) (insert name " = ") (indent-to-column bibtex-text-alignment) (insert bibtex-field-left-delimiter bibtex-field-right-delimiter))) (defun bibtex-make-optional-field (e-t) "Makes an optional field named E-T in current BibTeX entry." (interactive "sOptional BibTeX entry type: ") (if (consp e-t) (setq e-t (cons (concat "OPT" (car e-t)) (cdr e-t))) (setq e-t (concat "OPT" e-t))) (bibtex-make-field e-t)) (defun bibtex-beginning-of-entry () "Move to beginning of BibTeX entry. If inside an entry, move to the beginning of it, otherwise move to the beginning of the previous entry." (interactive) (if (looking-at "^@") (forward-char)) (re-search-backward "^@" nil 'move)) (defun bibtex-end-of-entry () "Move to end of BibTeX entry. If inside an entry, move to the end of it, otherwise move to the end of the previous entry." (interactive) (bibtex-beginning-of-entry) (let ((parse-sexp-ignore-comments t)) (forward-sexp 2) ;; skip entry type and body )) (defun bibtex-ispell-entry () "Spell whole BibTeX entry." (interactive) (ispell-region (progn (bibtex-beginning-of-entry) (point)) (progn (bibtex-end-of-entry) (point)))) (defun bibtex-ispell-abstract () "Spell abstract of BibTeX entry." (interactive) (let ((pnt (bibtex-end-of-entry))) (bibtex-beginning-of-entry) (if (null (re-search-forward "^[ \t]*[OPT]*abstract[ \t]*=" pnt)) (error "No abstract in entry."))) (ispell-region (point) (save-excursion (forward-sexp) (point)))) (defun bibtex-narrow-to-entry () "Narrow buffer to current BibTeX entry." (interactive) (save-excursion (narrow-to-region (progn (bibtex-beginning-of-entry) (point)) (progn (bibtex-end-of-entry) (point))))) (defun bibtex-hide-entry-bodies (&optional arg) "Hide all lines between first and last BibTeX entries not beginning with @. With argument, show all text." (interactive "P") (save-excursion (beginning-of-first-bibtex-entry) ;; subst-char-in-region modifies the buffer, despite what the ;; documentation says... (let ((modifiedp (buffer-modified-p)) (buffer-read-only nil)) (if arg (subst-char-in-region (point) (point-max) ?\r ?\n t) (while (save-excursion (re-search-forward "\n[^@]" (point-max) t)) ;; (save-excursion (replace-regexp "\n\\([^@]\\)" "\r\\1")) (save-excursion (while (re-search-forward "\n\\([^@]\\)" nil t) (replace-match "\r\\1" nil nil))))) (setq selective-display (not arg)) (set-buffer-modified-p modifiedp)))) (defun bibtex-sort-entries () "Sort BibTeX entries alphabetically by key. Text before the first BibTeX entry, and following the last is not affected. If bibtex-sort-ignore-string-entries is true, @string entries will be ignored. Bugs: 1. Text between the closing brace ending one BibTeX entry, and the @ starting the next, is considered part of the PRECEDING entry. Perhaps it should be part of the following entry." (interactive) (save-restriction (beginning-of-first-bibtex-entry) (narrow-to-region (point) (save-excursion (goto-char (point-max)) (bibtex-end-of-entry) (point))) (sort-subr nil ;; NEXTREC function 'forward-line ;; ENDREC function (function (lambda () (and (re-search-forward "}\\s-*\n[\n \t]*@" nil 'move) (forward-char -2)))) ;; STARTKEY function (if bibtex-sort-ignore-string-entries (function (lambda () (while (and (re-search-forward "^\\s-*\\([@a-zA-Z]*\\)\\s-*{\\s-*") (string-equal "@string" (downcase (buffer-substring-no-properties (match-beginning 1) (match-end 1)))))) nil)) (function (lambda () (re-search-forward "{\\s-*")))) ;; ENDKEY function (function (lambda () (search-forward ",")))))) (defun bibtex-find-entry-location (entry-name &optional ignore-errors) "Looking for place to put the BibTeX entry named ENTRY-NAME. Searches from beginning of buffer. Buffer is assumed to be in sorted order, without duplicates (see \\[bibtex-sort-entries]), if it is not, an error will be signalled. However, if optional argument IGNORE-ERRORS is non-nil, no error messages about duplicate entries or sort order violences are signalled, but the error handling is assumed to be made in the calling function. Nil is returned, if any error occured during search for location of the new entry, and t in all other cases. If an error occured, point is not moved." (interactive "sBibtex entry key: ") (let ((noerr t) (previous nil) (pnt (point)) point) (beginning-of-first-bibtex-entry) (or (catch 'done (map-bibtex-entries (function (lambda (current) (cond ((string-equal entry-name current) (setq noerr nil) (bibtex-beginning-of-entry) (if ignore-errors (throw 'done t) (error "Entry duplicates existing!"))) ((or (null previous) (string< previous current)) (setq previous current point (point)) (if (string< entry-name current) (progn (bibtex-beginning-of-entry) ;; Many schemes append strings to ;; existing entries to resolve them, ;; so initial substring matches may ;; indicate a duplicate entry. (let ((idx (string-match (regexp-quote entry-name) current))) (if (and (integerp idx) (zerop idx) ;; (not ignore-errors) (not (equal entry-name ""))) (progn (message "Warning: Entry %s may be a duplicate of %s!" entry-name current) (ding t)))) (throw 'done t)))) ((string-equal previous current) (setq noerr nil) (if ignore-errors (throw 'done t) (error "Duplicate here with previous!"))) (t (setq noerr nil) (if ignore-errors (throw 'done t) (error "Entries out of order here!")))))))) (goto-char (point-max))) (if (not noerr) (goto-char pnt)) noerr)) (defun bibtex-validate-buffer () "Validate if the current BibTeX buffer is syntactically correct. Any garbage (e.g. comments) before the first \"@\" is not tested (so you can put comments here)." (interactive) (let ((pnt (point)) (max (point-max))) (goto-char (point-min)) (while (< (re-search-forward "@\\|\\'") max) (forward-char -1) (let ((p (point))) (if (looking-at "@string") (forward-char) (if (not (and (re-search-forward bibtex-reference nil t) (equal p (match-beginning 0)))) (progn (goto-char p) (error "Bad entry begins here")))))) (bibtex-find-entry-location (make-string 10 255)) ;; find duplicates (goto-char pnt) (message "BibTeX buffer is syntactically correct"))) (defun bibtex-next-field (arg) "Finds end of text of next BibTeX field; with arg, to its beginning." (interactive "P") (bibtex-inside-field) (let ((start (point))) (condition-case () (progn (bibtex-enclosing-field) (goto-char (match-end 0)) (forward-char 2)) (error (goto-char start) (end-of-line) (forward-char 1)))) (bibtex-find-text arg)) (defun bibtex-find-text (arg) "Go to end of text of current field; with arg, go to beginning." (interactive "P") (bibtex-inside-field) (bibtex-enclosing-field) (if arg (progn (goto-char (match-beginning bibtex-text-in-field)) (if (looking-at "[{\"]") (forward-char 1))) (goto-char (match-end bibtex-text-in-field)) (if (or (= (preceding-char) ?}) (= (preceding-char) ?\")) (forward-char -1))) (if bibtex-help-message (bibtex-print-help-message))) (defun bibtex-remove-OPT () "Removes the 'OPT' starting optional arguments and goes to end of text." (interactive) (bibtex-inside-field) (bibtex-enclosing-field) (save-excursion (goto-char (match-beginning bibtex-name-in-field)) (if (looking-at "OPT") ;; sct@dcs.edinburgh.ac.uk (progn (delete-char (length "OPT")) (search-forward "=") (delete-horizontal-space) (indent-to-column bibtex-text-alignment)))) (bibtex-inside-field)) (defun bibtex-remove-double-quotes-or-braces () "Removes \"\" or {} around string." (interactive) (save-excursion (bibtex-inside-field) (bibtex-enclosing-field) (let ((start (match-beginning bibtex-text-in-field)) (stop (match-end bibtex-text-in-field))) (goto-char stop) (forward-char -1) (if (looking-at "[}\"]") (delete-char 1)) (goto-char start) (if (looking-at "[{\"]") (delete-char 1))))) (defun bibtex-kill-optional-field () "Kill the entire enclosing optional BibTeX field." (interactive) (bibtex-inside-field) (bibtex-enclosing-field) (goto-char (match-beginning bibtex-name-in-field)) (let ((the-end (match-end 0)) (the-beginning (match-beginning 0))) (if (looking-at "OPT") (progn (goto-char the-end) (skip-chars-forward " \t\n,") (kill-region the-beginning the-end)) (error "Mandatory fields can't be killed")))) (defun bibtex-empty-field () "Delete the text part of the current field, replace with empty text." (interactive) (bibtex-inside-field) (bibtex-enclosing-field) (goto-char (match-beginning bibtex-text-in-field)) (kill-region (point) (match-end bibtex-text-in-field)) (insert (concat bibtex-field-left-delimiter bibtex-field-right-delimiter)) (bibtex-find-text t)) (defun bibtex-pop-previous (arg) "Replace text of current field with the text of similar field in previous entry. With arg, go up ARG entries. Repeated, goes up so many times. May be intermixed with \\[bibtex-pop-next] (bibtex-pop-next)." (interactive "p") (bibtex-inside-field) (save-excursion ; parse current field (bibtex-enclosing-field) (let ((start-old-text (match-beginning bibtex-text-in-field)) (stop-old-text (match-end bibtex-text-in-field)) (start-name (match-beginning bibtex-name-in-field)) (stop-name (match-end bibtex-name-in-field)) (new-text)) (goto-char start-name) ; construct regexp for previous field with same name as this one (let ((matching-entry (bibtex-cfield (buffer-substring-no-properties (if (looking-at "OPT") (+ (point) (length "OPT")) (point)) stop-name) bibtex-field-text))) ; if executed several times in a row, start each search where the ; last one finished (cond ((or (eq last-command 'bibtex-pop-previous) (eq last-command 'bibtex-pop-next)) t ) (t (bibtex-enclosing-reference) (setq bibtex-pop-previous-search-point (point)) (setq bibtex-pop-next-search-point (match-end 0)))) (goto-char bibtex-pop-previous-search-point) ; Now search for arg'th previous similar field (cond ((re-search-backward matching-entry (point-min) t arg) (setq new-text (buffer-substring-no-properties (match-beginning bibtex-text-in-cfield) (match-end bibtex-text-in-cfield))) ;; change delimiters, if any changes needed (cond ((and (equal bibtex-field-left-delimiter "{") (eq (aref new-text 0) ?\") (eq (aref new-text (1- (length new-text))) ?\")) (aset new-text 0 ?\{) (aset new-text (1- (length new-text)) ?\})) ((and (equal bibtex-field-left-delimiter "\"") (eq (aref new-text 0) ?\{) (eq (aref new-text (1- (length new-text))) ?\})) (aset new-text 0 ?\") (aset new-text (1- (length new-text)) ?\")) ((or (not (eq (aref new-text 0) (aref bibtex-field-left-delimiter 0))) (not (eq (aref new-text (1- (length new-text))) (aref bibtex-field-right-delimiter 0)))) (setq new-text (concat bibtex-field-left-delimiter new-text bibtex-field-right-delimiter)))) ; Found a matching field. Remember boundaries. (setq bibtex-pop-next-search-point (match-end 0)) (setq bibtex-pop-previous-search-point (match-beginning 0)) (bibtex-flash-head) ; Go back to where we started, delete old text, and pop new. (goto-char stop-old-text) (delete-region start-old-text stop-old-text) (insert new-text)) (t ; search failed (error "No previous matching BibTeX field.")))))) (setq this-command 'bibtex-pop-previous)) (defun bibtex-pop-next (arg) "Replace text of current field with the text of similar field in next entry. With arg, go up ARG entries. Repeated, goes up so many times. May be intermixed with \\[bibtex-pop-previous] (bibtex-pop-previous)." (interactive "p") (bibtex-inside-field) (save-excursion ; parse current field (bibtex-enclosing-field) (let ((start-old-text (match-beginning bibtex-text-in-field)) (stop-old-text (match-end bibtex-text-in-field)) (start-name (match-beginning bibtex-name-in-field)) (stop-name (match-end bibtex-name-in-field)) (new-text)) (goto-char start-name) ; construct regexp for next field with same name as this one, ; ignoring possible OPT's (let ((matching-entry (bibtex-cfield (buffer-substring-no-properties (if (looking-at "OPT") (+ (point) (length "OPT")) (point)) stop-name) bibtex-field-text))) ; if executed several times in a row, start each search where the ; last one finished (cond ((or (eq last-command 'bibtex-pop-next) (eq last-command 'bibtex-pop-previous)) t ) (t (bibtex-enclosing-reference) (setq bibtex-pop-previous-search-point (point)) (setq bibtex-pop-next-search-point (match-end 0)))) (goto-char bibtex-pop-next-search-point) ; Now search for arg'th next similar field (cond ((re-search-forward matching-entry (point-max) t arg) (setq new-text (buffer-substring-no-properties (match-beginning bibtex-text-in-cfield) (match-end bibtex-text-in-cfield))) ;; change delimiters, if any changes needed (cond ((and (equal bibtex-field-left-delimiter "{") (eq (aref new-text 0) ?\") (eq (aref new-text (1- (length new-text))) ?\")) (aset new-text 0 ?\{) (aset new-text (1- (length new-text)) ?\})) ((and (equal bibtex-field-left-delimiter "\"") (eq (aref new-text 0) ?\{) (eq (aref new-text (1- (length new-text))) ?\})) (aset new-text 0 ?\") (aset new-text (1- (length new-text)) ?\")) ((or (not (eq (aref new-text 0) (aref bibtex-field-left-delimiter 0))) (not (eq (aref new-text (1- (length new-text))) (aref bibtex-field-right-delimiter 0)))) (setq new-text (concat bibtex-field-left-delimiter new-text bibtex-field-right-delimiter)))) ; Found a matching field. Remember boundaries. (setq bibtex-pop-next-search-point (match-end 0)) (setq bibtex-pop-previous-search-point (match-beginning 0)) (bibtex-flash-head) ; Go back to where we started, delete old text, and pop new. (goto-char stop-old-text) (delete-region start-old-text stop-old-text) (insert new-text)) (t ; search failed (error "No next matching BibTeX field.")))))) (setq this-command 'bibtex-pop-next)) (defun bibtex-clean-entry (&optional arg) "Finish editing the current BibTeX entry and clean it up. For all optional fields of current BibTeX entry: if empty, kill the whole field; otherwise, remove the \"OPT\" string in the name; if text numerical, remove double-quotes. For all mandatory fields: if empty, signal error. If label of entry is empty or a prefix argument was given, calculate a new entry label." (interactive "P") (bibtex-beginning-of-entry) (let ((start (point)) crossref-there) (save-restriction (narrow-to-region start (save-excursion (bibtex-end-of-entry) (point))) (while (and (re-search-forward bibtex-field (point-max) t 1) (not crossref-there)) ;; determine if reference has crossref entry (let ((begin-name (match-beginning bibtex-name-in-field)) (begin-text (match-beginning bibtex-text-in-field))) (goto-char begin-name) (if (looking-at "\\(OPTcrossref\\)\\|\\(crossref\\)") (progn (goto-char begin-text) (if (not (looking-at (concat bibtex-field-left-delimiter bibtex-field-right-delimiter))) (setq crossref-there t)))))) (bibtex-enclosing-reference) (re-search-forward bibtex-reference-type) (let ((begin-type (1+ (match-beginning 0))) (end-type (match-end 0))) (goto-char start) (while (re-search-forward bibtex-field (point-max) t 1) (let ((begin-field (match-beginning 0)) (end-field (match-end 0)) (begin-name (match-beginning bibtex-name-in-field)) (end-name (match-end bibtex-name-in-field)) (begin-text (match-beginning bibtex-text-in-field)) (end-text (match-end bibtex-text-in-field)) ) (goto-char begin-name) (cond ((and (looking-at "OPT") bibtex-clean-entry-zap-empty-opts) (goto-char begin-text) (if (looking-at (concat bibtex-field-left-delimiter bibtex-field-right-delimiter)) ;; empty: delete whole field if really optional ;; (missing crossref handled) or complain (if (and (not crossref-there) (assoc (downcase (buffer-substring-no-properties (+ (length "OPT") begin-name) end-name)) (car (car (cdr (assoc-ignore-case (buffer-substring-no-properties begin-type end-type) bibtex-entry-field-alist)))))) ;; field is not really optional (progn (goto-char begin-name) (delete-char (length "OPT")) ;; make field non-OPT (search-forward "=") (delete-horizontal-space) (indent-to-column bibtex-text-alignment) (forward-char) ;; and loop to go through next test (error "Mandatory field ``%s'' is empty" (buffer-substring-no-properties begin-name end-name))) ;; field is optional (delete-region begin-field end-field)) ;; otherwise: not empty, delete "OPT" (goto-char begin-name) (delete-char (length "OPT")) (progn ;; fixup alignment. [alarson:19920309.2047CST] (search-forward "=") (delete-horizontal-space) (indent-to-column bibtex-text-alignment)) (goto-char begin-field) ; and loop to go through next test )) (t (goto-char begin-text) (cond ((looking-at (concat bibtex-field-left-delimiter "[0-9]+" bibtex-field-right-delimiter)) ;; if numerical, (goto-char end-text) (delete-char -1) ; delete enclosing double-quotes (goto-char begin-text) (delete-char 1) (goto-char end-field) ; go to end for next search (forward-char -2) ; to compensate for the 2 quotes deleted ) ((looking-at (concat bibtex-field-left-delimiter bibtex-field-right-delimiter)) ;; if empty quotes, complain (forward-char 1) (if (not (or (equal (buffer-substring-no-properties begin-name (+ begin-name 3)) "OPT") (equal (buffer-substring-no-properties begin-name (+ begin-name 3)) "opt"))) (error "Mandatory field ``%s'' is empty" (buffer-substring-no-properties begin-name end-name)))) (t (goto-char end-field))))))))) (goto-char start) (bibtex-end-of-entry) ;; sct@dcs.edinburgh.ac.uk (save-excursion (forward-line -1) (end-of-line) (if (eq (preceding-char) ?,) (backward-delete-char 1)))) (let* ((eob (progn (bibtex-end-of-entry) (point))) (key (progn (bibtex-beginning-of-entry) (if (search-forward-regexp bibtex-reference-head eob t) (buffer-substring-no-properties (match-beginning bibtex-key-in-head) (match-end bibtex-key-in-head)))))) (if (or arg (not key)) (progn (let ((autokey (if bibtex-autokey-edit-before-use (read-from-minibuffer "Key to use: " (bibtex-generate-autokey)) (bibtex-generate-autokey)))) (bibtex-beginning-of-entry) (search-forward-regexp "^@[A-Za-z]+[ \t]*[({]\\([^,]*\\)") (delete-region (match-beginning 1) (match-end 1)) (insert autokey) (let ((start (progn (bibtex-beginning-of-entry) (point))) (end (progn (bibtex-end-of-entry) (search-forward-regexp "^@" nil 'move) (beginning-of-line) (point))) last-command) (kill-region start end) (let ((success (bibtex-find-entry-location autokey t))) (yank) (setq kill-ring (cdr kill-ring)) (if success (bibtex-beginning-of-entry) (goto-char start)) (search-forward-regexp bibtex-reference-head) (if (not success) (error "BibTeX buffer was or has become invalid (call `bibtex-validate-buffer')"))))))))) (defun bibtex-complete-string () "Complete word fragment before point to longest prefix of a defined string. If point is not after the part of a word, all strings are listed." (interactive "*") (let* ((end (point)) (beg (save-excursion (re-search-backward "[ \t{\"]") (forward-char 1) (point))) (part-of-word (buffer-substring-no-properties beg end)) (string-list (copy-sequence bibtex-completion-candidates)) (case-fold-search t) (completion (save-excursion (progn (while (re-search-backward "@string[ \t\n]*{" (point-min) t) (goto-char (match-end 0)) (let ((pnt (point)) (strt (match-beginning 0))) (re-search-forward "[ \t\n]*=" (point-max) t) (goto-char (match-beginning 0)) (setq string-list (cons (list (buffer-substring-no-properties pnt (point))) string-list)) (goto-char strt))) (setq string-list (sort string-list (lambda(x y) (string-lessp (car x) (car y))))) (try-completion part-of-word string-list))))) (cond ((eq completion t) (bibtex-remove-double-quotes-or-braces)) ((null completion) (error "Can't find completion for \"%s\"" part-of-word)) ((not (string= part-of-word completion)) (delete-region beg end) (insert completion) (if (assoc completion string-list) (bibtex-remove-double-quotes-or-braces))) (t (message "Making completion list...") (let ((list (all-completions part-of-word string-list))) (with-output-to-temp-buffer "*Completions*" (display-completion-list list))) (message "Making completion list...done"))))) (defun bibtex-Article () (interactive) (bibtex-entry "Article")) (defun bibtex-Book () (interactive) (bibtex-entry "Book")) (defun bibtex-Booklet () (interactive) (bibtex-entry "Booklet")) (defun bibtex-InBook () (interactive) (bibtex-entry "InBook")) (defun bibtex-InCollection () (interactive) (bibtex-entry "InCollection")) (defun bibtex-InProceedings () (interactive) (bibtex-entry "InProceedings")) (defun bibtex-Manual () (interactive) (bibtex-entry "Manual")) (defun bibtex-MastersThesis () (interactive) (bibtex-entry "MastersThesis")) (defun bibtex-Misc () (interactive) (bibtex-entry "Misc")) (defun bibtex-PhdThesis () (interactive) (bibtex-entry "PhdThesis")) (defun bibtex-Proceedings () (interactive) (bibtex-entry "Proceedings")) (defun bibtex-TechReport () (interactive) (bibtex-entry "TechReport")) (defun bibtex-Unpublished () (interactive) (bibtex-entry "Unpublished")) (defun bibtex-string () (interactive) (bibtex-move-outside-of-entry) (insert (concat "@string{ = " bibtex-field-left-delimiter bibtex-field-right-delimiter "}\n")) (forward-line -1) (forward-char 8)) (defun bibtex-preamble () (interactive) (bibtex-move-outside-of-entry) (insert "@Preamble{}\n") (forward-line -1) (forward-char 10)) ;; Make BibTeX a Feature (provide 'bibtex) ;;; bibtex.el ends here emacs-19.30/lisp/blackbox.el100444 13437 1 34310 5427043443 14340 0ustar jimbdaemon;;; blackbox.el --- blackbox game in Emacs Lisp ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. ;; Author: F. Thomas May ;; Adapted-By: ESR ;; Keywords: games ;; 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: ; by F. Thomas May ; doc comment by Root Boy Jim , 27 Apr 89 ; interface improvements by ESR, Dec 5 1991. ; The object of the game is to find four hidden balls by shooting rays ; into the black box. There are four possibilities: 1) the ray will ; pass thru the box undisturbed, 2) it will hit a ball and be absorbed, ; 3) it will be deflected and exit the box, or 4) be deflected immediately, ; not even being allowed entry into the box. ; ; The strange part is the method of deflection. It seems that rays will ; not pass next to a ball, and change direction at right angles to avoid it. ; ; R 3 ; 1 - - - - - - - - 1 ; - - - - - - - - ; - O - - - - - - 3 ; 2 - - - - O - O - ; 4 - - - - - - - - ; 5 - - - - - - - - 5 ; - - - - - - - - R ; H - - - - - - - O ; 2 H 4 H ; ; Rays which enter and exit are numbered. You can see that rays 1 & 5 pass ; thru the box undisturbed. Ray 2 is deflected by the northwesternmost ; ball. Likewise rays 3 and 4. Rays which hit balls and are absorbed are ; marked with H. The bottom of the left and the right of the bottom hit ; the southeastern ball directly. Rays may also hit balls after being ; reflected. Consider the H on the bottom next to the 4. It bounces off ; the NW-ern most ball and hits the central ball. A ray shot from above ; the right side 5 would hit the SE-ern most ball. The R beneath the 5 ; is because the ball is returned instantly. It is not allowed into ; the box if it would reflect immediately. The R on the top is a more ; leisurely return. Both central balls would tend to deflect it east ; or west, but it cannot go either way, so it just retreats. ; ; At the end of the game, if you've placed guesses for as many balls as ; there are in the box, the true board position will be revealed. Each ; `x' is an incorrect guess of yours; `o' is the true location of a ball. ;;; Code: (defvar blackbox-mode-map nil "") (if blackbox-mode-map () (setq blackbox-mode-map (make-keymap)) (suppress-keymap blackbox-mode-map t) (define-key blackbox-mode-map "\C-f" 'bb-right) (define-key blackbox-mode-map [right] 'bb-right) (define-key blackbox-mode-map "\C-b" 'bb-left) (define-key blackbox-mode-map [left] 'bb-left) (define-key blackbox-mode-map "\C-p" 'bb-up) (define-key blackbox-mode-map [up] 'bb-up) (define-key blackbox-mode-map "\C-n" 'bb-down) (define-key blackbox-mode-map [down] 'bb-down) (define-key blackbox-mode-map "\C-e" 'bb-eol) (define-key blackbox-mode-map "\C-a" 'bb-bol) (define-key blackbox-mode-map " " 'bb-romp) (define-key blackbox-mode-map [insert] 'bb-romp) (define-key blackbox-mode-map "\C-m" 'bb-done) (define-key blackbox-mode-map [kp-enter] 'bb-done)) ;; Blackbox mode is suitable only for specially formatted data. (put 'blackbox-mode 'mode-class 'special) (defun blackbox-mode () "Major mode for playing blackbox. To learn how to play blackbox, see the documentation for function `blackbox'. The usual mnemonic keys move the cursor around the box. \\\\[bb-bol] and \\[bb-eol] move to the beginning and end of line, respectively. \\[bb-romp] -- send in a ray from point, or toggle a ball at point \\[bb-done] -- end game and get score " (interactive) (kill-all-local-variables) (use-local-map blackbox-mode-map) (setq truncate-lines t) (setq major-mode 'blackbox-mode) (setq mode-name "Blackbox")) ;;;###autoload (defun blackbox (num) "Play blackbox. Optional prefix argument is the number of balls; the default is 4. What is blackbox? Blackbox is a game of hide and seek played on an 8 by 8 grid (the Blackbox). Your opponent (Emacs, in this case) has hidden several balls (usually 4) within this box. By shooting rays into the box and observing where they emerge it is possible to deduce the positions of the hidden balls. The fewer rays you use to find the balls, the lower your score. Overview of play: \\\ To play blackbox, type \\[blackbox]. An optional prefix argument specifies the number of balls to be hidden in the box; the default is four. The cursor can be moved around the box with the standard cursor movement keys. To shoot a ray, move the cursor to the edge of the box and press SPC. The result will be determined and the playfield updated. You may place or remove balls in the box by moving the cursor into the box and pressing \\[bb-romp]. When you think the configuration of balls you have placed is correct, press \\[bb-done]. You will be informed whether you are correct or not, and be given your score. Your score is the number of letters and numbers around the outside of the box plus five for each incorrectly placed ball. If you placed any balls incorrectly, they will be indicated with `x', and their actual positions indicated with `o'. Details: There are three possible outcomes for each ray you send into the box: Detour: the ray is deflected and emerges somewhere other than where you sent it in. On the playfield, detours are denoted by matching pairs of numbers -- one where the ray went in, and the other where it came out. Reflection: the ray is reflected and emerges in the same place it was sent in. On the playfield, reflections are denoted by the letter `R'. Hit: the ray strikes a ball directly and is absorbed. It does not emerge from the box. On the playfield, hits are denoted by the letter `H'. The rules for how balls deflect rays are simple and are best shown by example. As a ray approaches a ball it is deflected ninety degrees. Rays can be deflected multiple times. In the diagrams below, the dashes represent empty box locations and the letter `O' represents a ball. The entrance and exit points of each ray are marked with numbers as described under \"Detour\" above. Note that the entrance and exit points are always interchangeable. `*' denotes the path taken by the ray. Note carefully the relative positions of the ball and the ninety degree deflection it causes. 1 - * - - - - - - - - - - - - - - - - - - - - - - - * - - - - - - - - - - - - - - - - - - - - - - 1 * * - - - - - - - - - - - - - - - O - - - - O - - - O - - - - - - - O - - - - - - - * * * * - - - - - - - - - - - - - * * * * * 2 3 * * * - - * - - - - - - - - - - - - - * - - - - - - - O - * - - - - - - - - - - - - - * - - - - - - - - * * - - - - - - - - - - - - - * - - - - - - - - * - O - 2 3 As mentioned above, a reflection occurs when a ray emerges from the same point it was sent in. This can happen in several ways: - - - - - - - - - - - - - - - - - - - - - - - - - - - - O - - - - - O - O - - - - - - - - - - - R * * * * - - - - - - - * - - - - O - - - - - - - - - - - O - - - - - - * - - - - R - - - - - - - - - - - - - - - - - - - * - - - - - - - - - - - - - - - - - - - - - - - * - - - - - - - - - - - - - - - - - - - - R * * * * - - - - - - - - - - - - - - - - - - - - - - - - O - - - - - - - - - - - In the first example, the ray is deflected downwards by the upper ball, then left by the lower ball, and finally retraces its path to its point of origin. The second example is similar. The third example is a bit anomalous but can be rationalized by realizing the ray never gets a chance to get into the box. Alternatively, the ray can be thought of as being deflected downwards and immediately emerging from the box. A hit occurs when a ray runs straight into a ball: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - O - - - - - - - - - - - - - - - O - - - H * * * * - - - - - - - - - - - - H * * * * O - - - - - - * - - - - - - - - - - - - - - - - O - - - - - - O - - - - H * * * O - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Be sure to compare the second example of a hit with the first example of a reflection." (interactive "P") (switch-to-buffer "*Blackbox*") (blackbox-mode) (setq buffer-read-only t) (buffer-disable-undo (current-buffer)) (setq bb-board (bb-init-board (or num 4))) (setq bb-balls-placed nil) (setq bb-x -1) (setq bb-y -1) (setq bb-score 0) (setq bb-detour-count 0) (bb-insert-board) (bb-goto (cons bb-x bb-y))) (defun bb-init-board (num-balls) (random t) (let (board pos) (while (>= (setq num-balls (1- num-balls)) 0) (while (progn (setq pos (cons (random 8) (random 8))) (bb-member pos board))) (setq board (cons pos board))) board)) (defun bb-insert-board () (let (i (buffer-read-only nil)) (erase-buffer) (insert " \n") (setq i 8) (while (>= (setq i (1- i)) 0) (insert " - - - - - - - - \n")) (insert " \n") (insert (format "\nThere are %d balls in the box" (length bb-board))) )) (defun bb-right () (interactive) (if (= bb-x 8) () (forward-char 2) (setq bb-x (1+ bb-x)))) (defun bb-left () (interactive) (if (= bb-x -1) () (backward-char 2) (setq bb-x (1- bb-x)))) (defun bb-up () (interactive) (if (= bb-y -1) () (previous-line 1) (setq bb-y (1- bb-y)))) (defun bb-down () (interactive) (if (= bb-y 8) () (next-line 1) (setq bb-y (1+ bb-y)))) (defun bb-eol () (interactive) (setq bb-x 8) (bb-goto (cons bb-x bb-y))) (defun bb-bol () (interactive) (setq bb-x -1) (bb-goto (cons bb-x bb-y))) (defun bb-romp () (interactive) (cond ((and (or (= bb-x -1) (= bb-x 8)) (or (= bb-y -1) (= bb-y 8)))) ((bb-outside-box bb-x bb-y) (bb-trace-ray bb-x bb-y)) (t (bb-place-ball bb-x bb-y)))) (defun bb-place-ball (x y) (let ((coord (cons x y))) (cond ((bb-member coord bb-balls-placed) (setq bb-balls-placed (bb-delete coord bb-balls-placed)) (bb-update-board "-")) (t (setq bb-balls-placed (cons coord bb-balls-placed)) (bb-update-board "O"))))) (defun bb-trace-ray (x y) (let ((result (bb-trace-ray-2 t x (cond ((= x -1) 1) ((= x 8) -1) (t 0)) y (cond ((= y -1) 1) ((= y 8) -1) (t 0))))) (cond ((eq result 'hit) (bb-update-board "H") (setq bb-score (1+ bb-score))) ((equal result (cons x y)) (bb-update-board "R") (setq bb-score (1+ bb-score))) (t (setq bb-detour-count (1+ bb-detour-count)) (bb-update-board (format "%d" bb-detour-count)) (save-excursion (bb-goto result) (bb-update-board (format "%d" bb-detour-count))) (setq bb-score (+ bb-score 2)))))) (defun bb-trace-ray-2 (first x dx y dy) (cond ((and (not first) (bb-outside-box x y)) (cons x y)) ((bb-member (cons (+ x dx) (+ y dy)) bb-board) 'hit) ((bb-member (cons (+ x dx dy) (+ y dy dx)) bb-board) (bb-trace-ray-2 nil x (- dy) y (- dx))) ((bb-member (cons (+ x dx (- dy)) (+ y dy (- dx))) bb-board) (bb-trace-ray-2 nil x dy y dx)) (t (bb-trace-ray-2 nil (+ x dx) dx (+ y dy) dy)))) (defun bb-done () "Finish the game and report score." (interactive) (let (bogus-balls) (cond ((not (= (length bb-balls-placed) (length bb-board))) (message "There %s %d hidden ball%s; you have placed %d." (if (= (length bb-board) 1) "is" "are") (length bb-board) (if (= (length bb-board) 1) "" "s") (length bb-balls-placed))) (t (setq bogus-balls (bb-show-bogus-balls bb-balls-placed bb-board)) (if (= bogus-balls 0) (message "Right! Your score is %d." bb-score) (message "Oops! You missed %d ball%s. Your score is %d." bogus-balls (if (= bogus-balls 1) "" "s") (+ bb-score (* 5 bogus-balls)))) (bb-goto '(-1 . -1)))))) (defun bb-show-bogus-balls (balls-placed board) (bb-show-bogus-balls-2 balls-placed board "x") (bb-show-bogus-balls-2 board balls-placed "o")) (defun bb-show-bogus-balls-2 (list-1 list-2 c) (cond ((null list-1) 0) ((bb-member (car list-1) list-2) (bb-show-bogus-balls-2 (cdr list-1) list-2 c)) (t (bb-goto (car list-1)) (bb-update-board c) (1+ (bb-show-bogus-balls-2 (cdr list-1) list-2 c))))) (defun bb-outside-box (x y) (or (= x -1) (= x 8) (= y -1) (= y 8))) (defun bb-goto (pos) (goto-char (+ (* (car pos) 2) (* (cdr pos) 22) 26))) (defun bb-update-board (c) (let ((buffer-read-only nil)) (backward-char (1- (length c))) (delete-char (length c)) (insert c) (backward-char 1))) (defun bb-member (elt list) "Returns non-nil if ELT is an element of LIST." (eval (cons 'or (mapcar (function (lambda (x) (equal x elt))) list)))) (defun bb-delete (item list) "Deletes ITEM from LIST and returns a copy." (cond ((equal item (car list)) (cdr list)) (t (cons (car list) (bb-delete item (cdr list)))))) ;;; blackbox.el ends here emacs-19.30/lisp/bookmark.el100444 75424 1 227404 6014715122 14447 0ustar kwzhdaemon;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later. ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation ;; Author: Karl Fogel ;; Maintainer: Karl Fogel ;; Created: July, 1993 ;; Author's Update Number: 2.6.13 ;; Keywords: bookmarks, placeholders, annotations ;;; Summary: ;; This package is for setting "bookmarks" in files. A bookmark ;; associates a string with a location in a certain file. Thus, you ;; can navigate your way to that location by providing the string. ;; See the "User Variables" section for customizations. ;;; Copyright info: ;; 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. ;; Thanks to David Bremner for thinking of and ;; then implementing the bookmark-current-bookmark idea. He even ;; sent *patches*, bless his soul... ;; Thanks to Gregory M. Saunders for ;; fixing and improving bookmark-time-to-save-p. ;; Thanks go to Andrew V. Klein for the code that ;; sorts the alist before presenting it to the user (in bookmark-bmenu-list ;; and the menu-bar). ;; And much thanks to David Hughes for many small ;; suggestions and the code to implement them (like ;; bookmark-bmenu-check-position, and some of the Lucid compatibility ;; stuff). ;; Kudos (whatever they are) go to Jim Blandy ;; for his eminently sensible suggestion to separate bookmark-jump ;; into bookmark-jump and bookmark-jump-noselect, which made many ;; other things cleaner as well. ;; Thanks to Roland McGrath for encouragement and help with defining ;; autoloads on the menu-bar. ;; Jonathan Stigelman gave patches for default ;; values in bookmark-jump and bookmark-set. Everybody please keep ;; all the keystrokes they save thereby and send them to him at the ;; end of each year :-) (No, seriously, thanks Jonathan!) ;; Buckets of gratitude to John Grabowski for ;; thinking up the annotations feature and implementing it so well. ;; Based on info-bookmark.el, by Karl Fogel and Ken Olstad ;; . ;; Thanks to Mikio Nakajima for many bugs ;; reported and fixed. ;; Enough with the credits already, get on to the good stuff: ;; FAVORITE CHINESE RESTAURANT: ;; Boy, that's a tough one. Probably Hong Min, or maybe Emperor's ;; Choice (both in Chicago's Chinatown). Well, both. How about you? (require 'pp) ;;;; Code: ;;; Misc comments: ;; ;; If variable bookmark-use-annotations is non-nil, an annotation is ;; queried for when setting a bookmark. ;; ;; The bookmark list is sorted lexically by default, but you can turn ;; this off by setting bookmark-sort-flag to nil. If it is nil, then ;; the list will be presented in the order it is recorded ;; (chronologically), which is actually fairly useful as well. ;;; User Variables (defvar bookmark-use-annotations nil "*If non-nil, saving a bookmark will query for an annotation in a buffer.") (defvar bookmark-save-flag t "*Controls when Emacs saves bookmarks to a file. --> Nil means never save bookmarks, except when `bookmark-save' is explicitly called \(\\[bookmark-save]\). --> t means save bookmarks when Emacs is killed. --> Otherise, it should be a number that is the frequency with which the bookmark list is saved \(i.e.: the number of times which Emacs' bookmark list may be modified before it is automatically saved.\). If it is a number, Emacs will also automatically save bookmarks when it is killed. Therefore, the way to get it to save every time you make or delete a bookmark is to set this variable to 1 \(or 0, which produces the same behavior.\) To specify the file in which to save them, modify the variable bookmark-default-file, which is `~/.emacs.bmk' by default.") (defconst bookmark-old-default-file "~/.emacs-bkmrks" "*The .emacs.bmk file used to be called this.") ;; defvarred to avoid a compilation warning: (defvar bookmark-file nil "Old name for `bookmark-default-file'.") (defvar bookmark-default-file (if bookmark-file ;; In case user set `bookmark-file' in her .emacs: bookmark-file (if (eq system-type 'ms-dos) "~/emacs.bmk" ; Cannot have initial dot [Yuck!] "~/.emacs.bmk")) "*File in which to save bookmarks by default.") (defvar bookmark-version-control 'nospecial "*Whether or not to make numbered backups of the bookmark file. It can have four values: t, nil, `never', and `nospecial'. The first three have the same meaning that they do for the variable `version-control', and the final value `nospecial' means just use the value of `version-control'.") (defvar bookmark-completion-ignore-case t "*Non-nil means bookmark functions ignore case in completion.") (defvar bookmark-sort-flag t "*Non-nil means that bookmarks will be displayed sorted by bookmark name. Otherwise they will be displayed in LIFO order (that is, most recently set ones come first, oldest ones come last).") (defvar bookmark-automatically-show-annotations t "*Nil means don't show annotations when jumping to a bookmark.") (defvar bookmark-bmenu-file-column 30 "*Column at which to display filenames in a buffer listing bookmarks. You can toggle whether files are shown with \\\\[bookmark-bmenu-toggle-filenames].") (defvar bookmark-bmenu-toggle-filenames t "*Non-nil means show filenames when listing bookmarks. This may result in truncated bookmark names. To disable this, put the following in your .emacs: \(setq bookmark-bmenu-toggle-filenames nil\)") (defvar bookmark-menu-length 70 "*Maximum length of a bookmark name displayed on a popup menu.") ;;; No user-serviceable parts beyond this point. ;; Added for lucid emacs compatibility, db (or (fboundp 'defalias) (fset 'defalias 'fset)) ;; suggested for lucid compatibility by david hughes: (or (fboundp 'frame-height) (defalias 'frame-height 'screen-height)) ;;; Keymap stuff: ;; some people have C-x r set to rmail or whatever. We don't want to ;; assume that C-x r is a prefix map just because it's distributed ;; that way... ;; These are the distribution keybindings suggested by RMS, everything ;; else will be done with M-x or the menubar: ;;;###autoload (if (symbolp (key-binding "\C-xr")) nil (progn (define-key ctl-x-map "rb" 'bookmark-jump) (define-key ctl-x-map "rm" 'bookmark-set) (define-key ctl-x-map "rl" 'bookmark-bmenu-list))) ;; define the map, so it can be bound by those who desire to do so: ;;;###autoload (defvar bookmark-map nil "Keymap containing bindings to bookmark functions. It is not bound to any key by default: to bind it so that you have a bookmark prefix, just use `global-set-key' and bind a key of your choice to `bookmark-map'. All interactive bookmark functions have a binding in this keymap.") ;;;###autoload (define-prefix-command 'bookmark-map) ;; Read the help on all of these functions for details... ;;;###autoload (define-key bookmark-map "x" 'bookmark-set) ;;;###autoload (define-key bookmark-map "m" 'bookmark-set) ; "m" for "mark" ;;;###autoload (define-key bookmark-map "j" 'bookmark-jump) ;;;###autoload (define-key bookmark-map "g" 'bookmark-jump) ; "g" for "go" ;;;###autoload (define-key bookmark-map "i" 'bookmark-insert) ;;;###autoload (define-key bookmark-map "e" 'edit-bookmarks) ;;;###autoload (define-key bookmark-map "f" 'bookmark-insert-location) ; "f" for "find" ;;;###autoload (define-key bookmark-map "r" 'bookmark-rename) ;;;###autoload (define-key bookmark-map "d" 'bookmark-delete) ;;;###autoload (define-key bookmark-map "l" 'bookmark-load) ;;;###autoload (define-key bookmark-map "w" 'bookmark-write) ;;;###autoload (define-key bookmark-map "s" 'bookmark-save) ;;; The annotation maps. (defvar bookmark-read-annotation-mode-map (copy-keymap text-mode-map) "Keymap for composing an annotation for a bookmark.") (define-key bookmark-read-annotation-mode-map "\C-c\C-c" 'bookmark-send-annotation) ;;; Core variables and data structures: (defvar bookmark-alist () "Association list of bookmarks and their records. You probably don't want to change the value of this alist yourself; instead, let the various bookmark functions do it for you. The format of the alist is \(BOOKMARK1 BOOKMARK2 ...\) where each BOOKMARK is of the form \(NAME \(filename . FILE\) \(front-context-string . FRONT-STR\) \(rear-context-string . REAR-STR\) \(position . POS\) \(info-node . POS\) \(annotation . ANNOTATION\)\) So the cdr of each bookmark is an alist too. `info-node' is optional, by the way.") (defvar bookmarks-already-loaded nil) ;; just add the hook to make sure that people don't lose bookmarks ;; when they kill Emacs, unless they don't want to save them. ;;;###autoload (add-hook 'kill-emacs-hook (function (lambda () (and (featurep 'bookmark) bookmark-alist (bookmark-time-to-save-p t) (bookmark-save))))) ;; more stuff added by db. (defvar bookmark-current-bookmark nil "Name of bookmark most recently used in the current file. It is buffer local, used to make moving a bookmark forward through a file easier.") (make-variable-buffer-local 'bookmark-current-bookmark) (defvar bookmark-alist-modification-count 0 "Number of modifications to bookmark list since it was last saved.") (defvar bookmark-search-size 16 "Length of the context strings recorded on either side of a bookmark.") (defvar bookmark-current-point 0) (defvar bookmark-yank-point 0) (defvar bookmark-current-buffer nil) ;; Helper functions. ;; Only functions on this page and the next one (file formats) need to ;; know anything about the format of bookmark-alist entries. ;; Everyone else should go through them. (defun bookmark-name-from-full-record (full-record) "Return name of FULL-RECORD \(an alist element instead of a string\)." (car full-record)) (defun bookmark-all-names () "Return a list of all current bookmark names." (bookmark-maybe-load-default-file) (mapcar (lambda (full-record) (bookmark-name-from-full-record full-record)) bookmark-alist)) (defun bookmark-get-bookmark (bookmark) "Return the full entry for BOOKMARK in bookmark-alist." (assoc bookmark bookmark-alist)) (defun bookmark-get-bookmark-record (bookmark) "Return the guts of the entry for BOOKMARK in bookmark-alist. That is, all information but the name." (car (cdr (bookmark-get-bookmark bookmark)))) (defun bookmark-set-name (bookmark newname) "Set BOOKMARK's name to NEWNAME." (setcar (bookmark-get-bookmark bookmark) newname)) (defun bookmark-get-annotation (bookmark) "Return the annotation of BOOKMARK, or nil if none." (cdr (assq 'annotation (bookmark-get-bookmark-record bookmark)))) (defun bookmark-set-annotation (bookmark ann) "Set the annotation of BOOKMARK to ANN." (let ((cell (assq 'annotation (bookmark-get-bookmark-record bookmark)))) (if cell (setcdr cell ann) (nconc (bookmark-get-bookmark-record bookmark) (list (cons 'annotation ann)))))) (defun bookmark-get-filename (bookmark) "Return the full filename of BOOKMARK." (cdr (assq 'filename (bookmark-get-bookmark-record bookmark)))) (defun bookmark-set-filename (bookmark filename) "Set the full filename of BOOKMARK to FILENAME." (let ((cell (assq 'filename (bookmark-get-bookmark-record bookmark)))) (if cell (setcdr cell filename) (nconc (bookmark-get-bookmark-record bookmark) (list (cons 'filename filename)))))) (defun bookmark-get-position (bookmark) "Return the position \(i.e.: point\) of BOOKMARK." (cdr (assq 'position (bookmark-get-bookmark-record bookmark)))) (defun bookmark-set-position (bookmark position) "Set the position \(i.e.: point\) of BOOKMARK to POSITION." (let ((cell (assq 'position (bookmark-get-bookmark-record bookmark)))) (if cell (setcdr cell position) (nconc (bookmark-get-bookmark-record bookmark) (list (cons 'position position)))))) (defun bookmark-get-front-context-string (bookmark) "Return the front-context-string of BOOKMARK." (cdr (assq 'front-context-string (bookmark-get-bookmark-record bookmark)))) (defun bookmark-set-front-context-string (bookmark string) "Set the front-context-string of BOOKMARK to STRING." (let ((cell (assq 'front-context-string (bookmark-get-bookmark-record bookmark)))) (if cell (setcdr cell string) (nconc (bookmark-get-bookmark-record bookmark) (list (cons 'front-context-string string)))))) (defun bookmark-get-rear-context-string (bookmark) "Return the rear-context-string of BOOKMARK." (cdr (assq 'rear-context-string (bookmark-get-bookmark-record bookmark)))) (defun bookmark-set-rear-context-string (bookmark string) "Set the rear-context-string of BOOKMARK to STRING." (let ((cell (assq 'rear-context-string (bookmark-get-bookmark-record bookmark)))) (if cell (setcdr cell string) (nconc (bookmark-get-bookmark-record bookmark) (list (cons 'rear-context-string string)))))) (defun bookmark-get-info-node (bookmark) "Get the info node associated with BOOKMARK." (cdr (assq 'info-node (bookmark-get-bookmark-record bookmark)))) (defun bookmark-set-info-node (bookmark node) "Set the Info node of BOOKMARK to NODE." (let ((cell (assq 'info-node (bookmark-get-bookmark-record bookmark)))) (if cell (setcdr cell node) (nconc (bookmark-get-bookmark-record bookmark) (list (cons 'info-node node)))))) (defvar bookmark-history nil "The history list for bookmark functions.") (defun bookmark-completing-read (prompt &optional default) "Prompting with PROMPT, read a bookmark name in completion. PROMPT will get a \": \" stuck on the end no matter what, so you probably don't want to include one yourself. Optional second arg DEFAULT is a string to return if the user enters the empty string." (bookmark-maybe-load-default-file) ; paranoia (let* ((completion-ignore-case bookmark-completion-ignore-case) (default default) (prompt (if default (concat prompt (format " (%s): " default)) (concat prompt ": "))) (str (completing-read prompt bookmark-alist nil 0 nil 'bookmark-history))) (if (string-equal "" str) (list default) (list str)))) (defmacro bookmark-maybe-historicize-string (string) "Put STRING into the bookmark prompt history, if caller non-interactive. We need this because sometimes bookmark functions are invoked from menus, so `completing-read' never gets a chance to set `bookmark-history'." (` (or (interactive-p) (setq bookmark-history (cons (, string) bookmark-history))))) (defun bookmark-make (name &optional annotation overwrite) "Make a bookmark named NAME. Optional second arg ANNOTATION gives it an annotation. Optional third arg OVERWRITE means replace any existing bookmarks with this name." (bookmark-maybe-load-default-file) (let ((stripped-name (copy-sequence name))) (set-text-properties 0 (length stripped-name) nil stripped-name) (if (and (bookmark-get-bookmark stripped-name) (not overwrite)) ;; already existing boookmark under that name and ;; no prefix arg means just overwrite old bookmark (setcdr (bookmark-get-bookmark stripped-name) (list (bookmark-make-cell annotation))) ;; otherwise just cons it onto the front (either the bookmark ;; doesn't exist already, or there is no prefix arg. In either ;; case, we want the new bookmark consed onto the alist...) (setq bookmark-alist (cons (list stripped-name (bookmark-make-cell annotation)) bookmark-alist))) ;; Added by db (setq bookmark-current-bookmark stripped-name) (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) (if (bookmark-time-to-save-p) (bookmark-save)))) (defun bookmark-make-cell (annotation) "Return the record part of a new bookmark, given ANNOTATION. Must be at the correct position in the buffer in which the bookmark is being set. This will change soon." (` ((filename . (, (bookmark-buffer-file-name))) (front-context-string . (, (if (>= (- (point-max) (point)) bookmark-search-size) (buffer-substring-no-properties (point) (+ (point) bookmark-search-size)) nil))) (rear-context-string . (, (if (>= (- (point) (point-min)) bookmark-search-size) (buffer-substring-no-properties (point) (- (point) bookmark-search-size)) nil))) (position . (, (point))) (annotation . (, annotation))))) ;;; File format stuff ;; The OLD format of the bookmark-alist was: ;; ;; ((bookmark-name (filename ;; string-in-front ;; string-behind ;; point)) ;; ...) ;; ;; The NEW format of the bookmark-alist is: ;; ;; ((bookmark-name ((filename . FILENAME) ;; (front-context-string . string-in-front) ;; (rear-context-string . string-behind) ;; (position . POINT) ;; (annotation . annotation) ;; (whatever . VALUE) ;; ... ;; )) ;; ...) ;; ;; ;; I switched to using an internal as well as external alist because I ;; felt that would be a more flexible framework in which to add ;; features. It means that the order in which values appear doesn't ;; matter, and it means that arbitrary values can be added without ;; risk of interfering with existing ones. ;; ;; BOOKMARK-NAME is the string the user gives the bookmark and ;; accesses it by from then on. ;; ;; FILENAME is the location of the file in which the bookmark is set. ;; ;; STRING-IN-FRONT is a string of `bookmark-search-size' chars of ;; context in front of the point at which the bookmark is set. ;; ;; STRING-BEHIND is the same thing, but after the point. ;; ;; The context strings exist so that modifications to a file don't ;; necessarily cause a bookmark's position to be invalidated. ;; bookmark-jump will search for STRING-BEHIND and STRING-IN-FRONT in ;; case the file has changed since the bookmark was set. It will ;; attempt to place the user before the changes, if there were any. ;; annotation is the annotation for the bookmark; it may not exist ;; (for backward compatibility), be nil (no annotation), or be a ;; string. ;; ;; ANNOTATION is an annotation for the bookmark. (defconst bookmark-file-format-version 1 "The current version of the format used by bookmark files. You should never need to change this.") (defconst bookmark-end-of-version-stamp-marker "-*- End Of Bookmark File Format Version Stamp -*-\n" "This string marks the end of the version stamp in a bookmark file.") (defun bookmark-alist-from-buffer () "Return a bookmark-alist (in any format) from the current buffer. The buffer must of course contain bookmark format information. Does not care from where in the buffer it is called, and does not affect point." (save-excursion (goto-char (point-min)) (if (search-forward bookmark-end-of-version-stamp-marker nil t) (read (current-buffer)) ;; Else we're dealing with format version 0 (if (search-forward "(" nil t) (progn (forward-char -1) (read (current-buffer))) ;; Else no hope of getting information here. (error "Not bookmark format."))))) (defun bookmark-upgrade-version-0-alist (old-list) "Upgrade a version 0 alist OLD-LIST to the current version." (mapcar (lambda (bookmark) (let* ((name (car bookmark)) (record (car (cdr bookmark))) (filename (nth 0 record)) (front-str (nth 1 record)) (rear-str (nth 2 record)) (position (nth 3 record)) (ann (nth 4 record))) (list name (` ((filename . (, filename)) (front-context-string . (, (or front-str ""))) (rear-context-string . (, (or rear-str ""))) (position . (, position)) (annotation . (, ann))))))) old-list)) (defun bookmark-upgrade-file-format-from-0 () "Upgrade a bookmark file of format 0 (the original format) to format 1. This expects to be called from point-min in a bookmark file." (message "Upgrading bookmark format from 0 to %d..." bookmark-file-format-version) (let* ((old-list (bookmark-alist-from-buffer)) (new-list (bookmark-upgrade-version-0-alist old-list))) (delete-region (point-min) (point-max)) (bookmark-insert-file-format-version-stamp) (pp new-list (current-buffer)) (save-buffer)) (goto-char (point-min)) (message "Upgrading bookmark format from 0 to %d... done." bookmark-file-format-version) ) (defun bookmark-grok-file-format-version () "Return an integer which is the file-format version of this bookmark file. This expects to be called from point-min in a bookmark file." (if (looking-at "^;;;;") (save-excursion (save-match-data (re-search-forward "[0-9]") (forward-char -1) (read (current-buffer)))) ;; Else this is format version 0, the original one, which didn't ;; even have version stamps. 0)) (defun bookmark-maybe-upgrade-file-format () "Check the file-format version of this bookmark file. If the version is not up-to-date, upgrade it automatically. This expects to be called from point-min in a bookmark file." (let ((version (bookmark-grok-file-format-version))) (cond ((= version bookmark-file-format-version) ) ; home free -- version is current ((= version 0) (bookmark-upgrade-file-format-from-0)) (t (error "Bookmark file format version strangeness."))))) (defun bookmark-insert-file-format-version-stamp () "Insert text indicating current version of bookmark file-format." (insert (format ";;;; Emacs Bookmark Format Version %d ;;;;\n" bookmark-file-format-version)) (insert ";;; This format is meant to be slightly human-readable;\n" ";;; nevertheless, you probably don't want to edit it.\n" ";;; " bookmark-end-of-version-stamp-marker)) ;;; end file-format stuff ;;; Core code: ;;;###autoload (defun bookmark-set (&optional name parg) "Set a bookmark named NAME inside a file. If name is nil, then the user will be prompted. With prefix arg, will not overwrite a bookmark that has the same name as NAME if such a bookmark already exists, but instead will \"push\" the new bookmark onto the bookmark alist. Thus the most recently set bookmark with name NAME would be the one in effect at any given time, but the others are still there, should you decide to delete the most recent one. To yank words from the text of the buffer and use them as part of the bookmark name, type C-w while setting a bookmark. Successive C-w's yank successive words. Typing C-u inserts the name of the last bookmark used in the buffer \(as an aid in using a single bookmark name to track your progress through a large file\). If no bookmark was used, then C-u inserts the name of the file being visited. Use \\[bookmark-delete] to remove bookmarks \(you give it a name, and it removes only the first instance of a bookmark with that name from the list of bookmarks.\)" (interactive (list nil current-prefix-arg)) (or (bookmark-buffer-file-name) (error "Buffer not visiting a file or directory.")) (bookmark-maybe-load-default-file) (setq bookmark-current-point (point)) (setq bookmark-yank-point (point)) (setq bookmark-current-buffer (current-buffer)) (let* ((default (or bookmark-current-bookmark (bookmark-buffer-name))) (str (or name (read-from-minibuffer (format "Set bookmark (%s): " default) nil (let ((now-map (copy-keymap minibuffer-local-map))) (progn (define-key now-map "\C-w" 'bookmark-yank-word) (define-key now-map "\C-u" 'bookmark-insert-current-bookmark)) now-map)))) (annotation nil)) (and (string-equal str "") (setq str default)) ;; Ask for an annotation buffer for this bookmark (if bookmark-use-annotations (bookmark-read-annotation parg str) (progn (bookmark-make str annotation parg) ;; In Info, there's a little more information to record: (if (eq major-mode 'Info-mode) (bookmark-set-info-node str Info-current-node)) (setq bookmark-current-bookmark str) (bookmark-bmenu-surreptitiously-rebuild-list) (goto-char bookmark-current-point))))) (defun bookmark-kill-line (&optional newline-too) "Kill from point to end of line. If optional arg NEWLINE-TOO is non-nil, delete the newline too. Does not affect the kill-ring." (let ((eol (save-excursion (end-of-line) (point)))) (delete-region (point) eol) (if (and newline-too (looking-at "\n")) (delete-char 1)))) ;; Defvars to avoid compilation warnings: (defvar bookmark-annotation-paragraph nil) (defvar bookmark-annotation-name nil) (defvar bookmark-annotation-buffer nil) (defvar bookmark-annotation-file nil) (defvar bookmark-annotation-point nil) (defun bookmark-send-annotation () "After remove lines beginning with '#', use the contents of this buffer as the annotation for a bookmark, and store it in the bookmark list with the bookmark (and file, and point) specified in buffer local variables." (interactive) (if (not (eq major-mode 'bookmark-read-annotation-mode)) (error "Not in bookmark-read-annotation-mode.")) (goto-char (point-min)) (while (< (point) (point-max)) (if (looking-at "^#") (bookmark-kill-line t) (forward-line 1))) (let ((annotation (buffer-substring (point-min) (point-max))) (parg bookmark-annotation-paragraph) (bookmark bookmark-annotation-name) (pt bookmark-annotation-point) (buf bookmark-annotation-buffer)) ;; for bookmark-make-cell to work, we need to be ;; in the relevant buffer, at the relevant point. ;; Actually, bookmark-make-cell should probably be re-written, ;; to avoid this need. Should I handle the error if a buffer is ;; killed between "C-x r m" and a "C-c C-c" in the annotation buffer? (save-excursion (pop-to-buffer buf) (goto-char pt) (bookmark-make bookmark annotation parg) (setq bookmark-current-bookmark bookmark)) (bookmark-bmenu-surreptitiously-rebuild-list) (goto-char bookmark-current-point)) (kill-buffer (current-buffer))) (defun bookmark-default-annotation-text (bookmark) (concat "# Type the annotation for bookmark '" bookmark "' here.\n" "# All lines which start with a '#' will be deleted.\n" "# Type C-c C-c when done.\n#\n" "# Author: " (user-full-name) " <" (user-login-name) "@" (system-name) ">\n" "# Date: " (current-time-string) "\n")) (defvar bookmark-read-annotation-text-func 'bookmark-default-annotation-text "A variable containing a function which returns the text to insert into an annotation compisition buffer. It takes the name of the bookmark, as a string, as an arg.") (defun bookmark-read-annotation-mode (buf point parg bookmark) "Mode for composing annotations for a bookmark. Wants BUF POINT PARG and BOOKMARK. When you have finished composing, type \\[bookmark-send-annotation] to send the annotation. \\{bookmark-read-annotation-mode-map} " (interactive) (kill-all-local-variables) (make-local-variable 'bookmark-annotation-paragraph) (make-local-variable 'bookmark-annotation-name) (make-local-variable 'bookmark-annotation-buffer) (make-local-variable 'bookmark-annotation-file) (make-local-variable 'bookmark-annotation-point) (setq bookmark-annotation-paragraph parg) (setq bookmark-annotation-name bookmark) (setq bookmark-annotation-buffer buf) (setq bookmark-annotation-file (buffer-file-name buf)) (setq bookmark-annotation-point point) (use-local-map bookmark-read-annotation-mode-map) (setq major-mode 'bookmark-read-annotation-mode) (insert (funcall bookmark-read-annotation-text-func bookmark)) (run-hooks 'text-mode-hook)) (defun bookmark-read-annotation (parg bookmark) "Pop up a buffer for entering a bookmark annotation. Text surrounding the bookmark is PARG; the bookmark name is BOOKMARK." (let ((buf (current-buffer)) (point (point))) (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*")) (bookmark-read-annotation-mode buf point parg bookmark))) (defvar bookmark-edit-annotation-mode-map (copy-keymap text-mode-map) "Keymap for editing an annotation of a bookmark.") (define-key bookmark-edit-annotation-mode-map "\C-c\C-c" 'bookmark-send-edited-annotation) (defun bookmark-edit-annotation-mode (bookmark) "Mode for editing the annotation of bookmark BOOKMARK. When you have finished composing, type \\[bookmark-send-annotation]. \\{bookmark-edit-annotation-mode-map} " (interactive) (kill-all-local-variables) (make-local-variable 'bookmark-annotation-name) (setq bookmark-annotation-name bookmark) (use-local-map bookmark-edit-annotation-mode-map) (setq major-mode 'bookmark-edit-annotation-mode) (insert (funcall bookmark-read-annotation-text-func bookmark)) (let ((annotation (bookmark-get-annotation bookmark))) (if (and (not (eq annotation nil)) (not (string-equal annotation ""))) (insert annotation))) (run-hooks 'text-mode-hook)) (defun bookmark-send-edited-annotation () "After remove lines beginning with '#', use the contents of this buffer as the new annotation for a bookmark." (interactive) (if (not (eq major-mode 'bookmark-edit-annotation-mode)) (error "Not in bookmark-edit-annotation-mode.")) (goto-char (point-min)) (while (< (point) (point-max)) (if (looking-at "^#") (bookmark-kill-line t) (forward-line 1))) (let ((annotation (buffer-substring (point-min) (point-max))) (bookmark bookmark-annotation-name)) (bookmark-set-annotation bookmark annotation) (bookmark-bmenu-surreptitiously-rebuild-list) (goto-char bookmark-current-point)) (kill-buffer (current-buffer))) (defun bookmark-edit-annotation (bookmark) "Pop up a buffer for editing bookmark BOOKMARK's annotation." (let ((buf (current-buffer)) (point (point))) (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*")) (bookmark-edit-annotation-mode bookmark))) (defun bookmark-insert-current-bookmark () "Insert this buffer's value of bookmark-current-bookmark, default to file name if it's nil." (interactive) (let ((str (save-excursion (set-buffer bookmark-current-buffer) bookmark-current-bookmark))) (if str (insert str) (bookmark-insert-buffer-name)))) (defun bookmark-insert-buffer-name () "Insert the name (sans path) of the current file into the bookmark name that is being set." (interactive) (let ((str (save-excursion (set-buffer bookmark-current-buffer) (bookmark-buffer-name)))) (insert str))) (defun bookmark-buffer-name () "Return the name of the current buffer's file, non-directory. In Info, return the current node." (cond ;; Are we in Info? ((string-equal mode-name "Info") Info-current-node) ;; Or are we a file? (buffer-file-name (file-name-nondirectory buffer-file-name)) ;; Or are we a directory? ((and (boundp 'dired-directory) dired-directory) (let* ((dirname (if (stringp dired-directory) dired-directory (car dired-directory))) (idx (1- (length dirname)))) ;; Strip the trailing slash. (if (= ?/ (aref dirname idx)) (file-name-nondirectory (substring dirname 0 idx)) ;; Else return the current-buffer (buffer-name (current-buffer))))) ;; If all else fails, use the buffer's name. (t (buffer-name (current-buffer))))) (defun bookmark-yank-word () (interactive) ;; get the next word from the buffer and append it to the name of ;; the bookmark currently being set. (let ((string (save-excursion (set-buffer bookmark-current-buffer) (goto-char bookmark-yank-point) (buffer-substring-no-properties (point) (save-excursion (forward-word 1) (setq bookmark-yank-point (point))))))) (insert string))) (defun bookmark-buffer-file-name () "Return the current buffer's file in a way useful for bookmarks. For example, if this is a Info buffer, return the Info file's name." (if (eq major-mode 'Info-mode) Info-current-file (or buffer-file-name (if (and (boundp 'dired-directory) dired-directory) (if (stringp dired-directory) dired-directory (car dired-directory)))))) (defun bookmark-maybe-load-default-file () (and (not bookmarks-already-loaded) (null bookmark-alist) (prog2 (and ;; Possibly the old bookmark file, "~/.emacs-bkmrks", needs ;; to be renamed. (file-exists-p (expand-file-name bookmark-old-default-file)) (not (file-exists-p (expand-file-name bookmark-default-file))) (rename-file (expand-file-name bookmark-old-default-file) (expand-file-name bookmark-default-file))) ;; return t so the `and' will continue... t) (file-readable-p (expand-file-name bookmark-default-file)) (progn (bookmark-load bookmark-default-file t t) (setq bookmarks-already-loaded t)))) (defun bookmark-maybe-sort-alist () ;;Return the bookmark-alist for display. If the bookmark-sort-flag ;;is non-nil, then return a sorted copy of the alist. (if bookmark-sort-flag (setq bookmark-alist (sort (copy-alist bookmark-alist) (function (lambda (x y) (string-lessp (car x) (car y)))))))) ;;;###autoload (defun bookmark-jump (bookmark) "Jump to bookmark BOOKMARK (a point in some file). You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this. If the file pointed to by BOOKMARK no longer exists, you will be asked if you wish to give the bookmark a new location, and bookmark-jump will then jump to the new location, as well as recording it in place of the old one in the permanent bookmark record." (interactive (bookmark-completing-read "Jump to bookmark" bookmark-current-bookmark)) (bookmark-maybe-historicize-string bookmark) (let ((cell (bookmark-jump-noselect bookmark))) (and cell (switch-to-buffer (car cell)) (goto-char (cdr cell)) (if bookmark-automatically-show-annotations ;; if there is an annotation for this bookmark, ;; show it in a buffer. (bookmark-show-annotation bookmark))))) (defun bookmark-jump-noselect (str) ;; a leetle helper for bookmark-jump :-) ;; returns (BUFFER . POINT) (bookmark-maybe-load-default-file) (let* ((file (expand-file-name (bookmark-get-filename str))) (forward-str (bookmark-get-front-context-string str)) (behind-str (bookmark-get-rear-context-string str)) (place (bookmark-get-position str)) (info-node (bookmark-get-info-node str)) (orig-file file) ) (if (or (file-exists-p file) ;; else try some common compression extensions ;; and Emacs better handle it right! ;; Sigh: I think it may *not* be handled at the moment. What ;; to do about this? (setq file (or (let ((altname (concat file ".Z"))) (and (file-exists-p altname) altname)) (let ((altname (concat file ".gz"))) (and (file-exists-p altname) altname)) (let ((altname (concat file ".z"))) (and (file-exists-p altname) altname))))) (save-excursion (if info-node ;; Info nodes must be visited with care. (progn (require 'info) (Info-find-node file info-node)) ;; Else no Info. Can do an ordinary find-file: (set-buffer (find-file-noselect file)) (goto-char place)) ;; Go searching forward first. Then, if forward-str exists and ;; was found in the file, we can search backward for behind-str. ;; Rationale is that if text was inserted between the two in the ;; file, it's better to be put before it so you can read it, ;; rather than after and remain perhaps unaware of the changes. (if forward-str (if (search-forward forward-str (point-max) t) (backward-char (length forward-str)))) (if behind-str (if (search-backward behind-str (point-min) t) (forward-char (length behind-str)))) ;; added by db (setq bookmark-current-bookmark str) (cons (current-buffer) (point))) (progn (ding) (if (y-or-n-p (concat (file-name-nondirectory orig-file) " nonexistent. Relocate \"" str "\"? ")) (progn (bookmark-relocate str) ;; gasp! It's a recursive function call in Emacs Lisp! (bookmark-jump-noselect str)) (message "Bookmark not relocated; consider removing it \(%s\)." str) nil))))) ;;;###autoload (defun bookmark-relocate (bookmark) "Relocate BOOKMARK -- prompts for a filename, and makes an already existing bookmark point to that file, instead of the one it used to point at. Useful when a file has been renamed after a bookmark was set in it." (interactive (bookmark-completing-read "Bookmark to relocate")) (bookmark-maybe-historicize-string bookmark) (bookmark-maybe-load-default-file) (let* ((bmrk-filename (bookmark-get-filename bookmark)) (newloc (expand-file-name (read-file-name (format "Relocate %s to: " bookmark) (file-name-directory bmrk-filename))))) (bookmark-set-filename bookmark newloc))) ;;;###autoload (defun bookmark-insert-location (bookmark &optional no-history) "Insert the name of the file associated with BOOKMARK. Optional second arg NO-HISTORY means don't record this in the minibuffer history list `bookmark-history'." (interactive (bookmark-completing-read "Insert bookmark location")) (or no-history (bookmark-maybe-historicize-string bookmark)) (insert (bookmark-location bookmark))) (defun bookmark-location (bookmark) "Return the name of the file associated with BOOKMARK." (bookmark-maybe-load-default-file) (bookmark-get-filename bookmark)) ;;;###autoload (defun bookmark-rename (old &optional new) "Change the name of OLD bookmark to NEW name. If called from keyboard, prompts for OLD and NEW. If called from menubar, OLD is selected from a menu, and prompts for NEW. If called from Lisp, prompts for NEW if only OLD was passed as an argument. If called with two strings, then no prompting is done. You must pass at least OLD when calling from Lisp. While you are entering the new name, consecutive C-w's insert consectutive words from the text of the buffer into the new bookmark name." (interactive (bookmark-completing-read "Old bookmark name")) (bookmark-maybe-historicize-string old) (bookmark-maybe-load-default-file) (progn (setq bookmark-current-point (point)) (setq bookmark-yank-point (point)) (setq bookmark-current-buffer (current-buffer)) (let ((newname (or new ; use second arg, if non-nil (read-from-minibuffer "New name: " nil (let ((now-map (copy-keymap minibuffer-local-map))) (define-key now-map "\C-w" 'bookmark-yank-word) now-map) nil 'bookmark-history)))) (progn (bookmark-set-name old newname) (setq bookmark-current-bookmark newname) (bookmark-bmenu-surreptitiously-rebuild-list) (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) (if (bookmark-time-to-save-p) (bookmark-save)))))) ;;;###autoload (defun bookmark-insert (bookmark) "Insert the text of the file pointed to by bookmark BOOKMARK. You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this." (interactive (bookmark-completing-read "Insert bookmark contents")) (bookmark-maybe-historicize-string bookmark) (bookmark-maybe-load-default-file) (let ((orig-point (point)) (str-to-insert (save-excursion (set-buffer (car (bookmark-jump-noselect bookmark))) (buffer-substring (point-min) (point-max))))) (insert str-to-insert) (push-mark) (goto-char orig-point))) ;;;###autoload (defun bookmark-delete (bookmark &optional batch) "Delete BOOKMARK from the bookmark list. Removes only the first instance of a bookmark with that name. If there are one or more other bookmarks with the same name, they will not be deleted. Defaults to the \"current\" bookmark \(that is, the one most recently used in this file, if any\). Optional second arg BATCH means don't update the bookmark list buffer, probably because we were called from there." (interactive (bookmark-completing-read "Delete bookmark" bookmark-current-bookmark)) (bookmark-maybe-historicize-string bookmark) (bookmark-maybe-load-default-file) (let ((will-go (bookmark-get-bookmark bookmark))) (setq bookmark-alist (delq will-go bookmark-alist)) ;; Added by db, nil bookmark-current-bookmark if the last ;; occurence has been deleted (or (bookmark-get-bookmark bookmark-current-bookmark) (setq bookmark-current-bookmark nil))) ;; Don't rebuild the list (if batch nil (bookmark-bmenu-surreptitiously-rebuild-list) (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) (if (bookmark-time-to-save-p) (bookmark-save)))) (defun bookmark-time-to-save-p (&optional last-time) ;; By Gregory M. Saunders ;; finds out whether it's time to save bookmarks to a file, by ;; examining the value of variable bookmark-save-flag, and maybe ;; bookmark-alist-modification-count. Returns t if they should be ;; saved, nil otherwise. if last-time is non-nil, then this is ;; being called when emacs is killed. (cond (last-time (and (> bookmark-alist-modification-count 0) bookmark-save-flag)) ((numberp bookmark-save-flag) (>= bookmark-alist-modification-count bookmark-save-flag)) (t nil))) ;;;###autoload (defun bookmark-write () "Write bookmarks to a file \(for which the user will be prompted interactively\). Don't use this in Lisp programs; use bookmark-save instead." (interactive) (bookmark-maybe-load-default-file) (bookmark-save t)) ;;;###autoload (defun bookmark-save (&optional parg file) "Save currently defined bookmarks. Saves by default in the file defined by the variable `bookmark-default-file'. With a prefix arg, save it in file FILE \(second argument\). If you are calling this from Lisp, the two arguments are PREFIX-ARG and FILE, and if you just want it to write to the default file, then pass no arguments. Or pass in nil and FILE, and it will save in FILE instead. If you pass in one argument, and it is non-nil, then the user will be interactively queried for a file to save in. When you want to load in the bookmarks from a file, use \`bookmark-load\', \\[bookmark-load]. That function will prompt you for a file, defaulting to the file defined by variable `bookmark-default-file'." (interactive "P") (bookmark-maybe-load-default-file) (cond ((and (null parg) (null file)) ;;whether interactive or not, write to default file (bookmark-write-file bookmark-default-file)) ((and (null parg) file) ;;whether interactive or not, write to given file (bookmark-write-file file)) ((and parg (not file)) ;;have been called interactively w/ prefix arg (let ((file (read-file-name "File to save bookmarks in: "))) (bookmark-write-file file))) (t ; someone called us with prefix-arg *and* a file, so just write to file (bookmark-write-file file))) ;; signal that we have synced the bookmark file by setting this to ;; 0. If there was an error at any point before, it will not get ;; set, which is what we want. (setq bookmark-alist-modification-count 0)) (defun bookmark-write-file (file) (save-excursion (save-window-excursion (if (>= baud-rate 9600) (message (format "Saving bookmarks to file %s..." file))) (set-buffer (let ((enable-local-variables nil)) (find-file-noselect file))) (goto-char (point-min)) (delete-region (point-min) (point-max)) (bookmark-insert-file-format-version-stamp) (pp bookmark-alist (current-buffer)) (let ((version-control (cond ((null bookmark-version-control) nil) ((eq 'never bookmark-version-control) 'never) ((eq 'nospecial bookmark-version-control) version-control) (t t)))) (write-file file) (kill-buffer (current-buffer)) (if (>= baud-rate 9600) (message (format "Saving bookmarks to file %s... done." file))) )))) ;;;###autoload (defun bookmark-load (file &optional revert no-msg) "Load bookmarks from FILE (which must be in bookmark format). Appends loaded bookmarks to the front of the list of bookmarks. If optional second argument REVERT is non-nil, existing bookmarks are destroyed. Optional third arg NO-MSG means don't display any messages while loading. If you load a file that doesn't contain a proper bookmark alist, you will corrupt Emacs's bookmark list. Generally, you should only load in files that were created with the bookmark functions in the first place. Your own personal bookmark file, `~/.emacs.bmk', is maintained automatically by Emacs; you shouldn't need to load it explicitly." (interactive (list (read-file-name (format "Load bookmarks from: (%s) " bookmark-default-file) ;;Default might not be used often, ;;but there's no better default, and ;;I guess it's better than none at all. "~/" bookmark-default-file 'confirm))) (setq file (expand-file-name file)) (if (file-readable-p file) (save-excursion (save-window-excursion (if (and (null no-msg) (>= baud-rate 9600)) (message (format "Loading bookmarks from %s..." file))) (set-buffer (let ((enable-local-variables nil)) (find-file-noselect file))) (goto-char (point-min)) (bookmark-maybe-upgrade-file-format) (let ((blist (bookmark-alist-from-buffer))) (if (listp blist) (progn (if (not revert) (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) (setq bookmark-alist-modification-count 0)) (setq bookmark-alist (append blist (if (not revert) bookmark-alist))) (bookmark-bmenu-surreptitiously-rebuild-list)) (error (format "Invalid bookmark list in %s." file)))) (kill-buffer (current-buffer))) (if (and (null no-msg) (>= baud-rate 9600)) (message (format "Loading bookmarks from %s... done" file)))) (error (format "Cannot read bookmark file %s." file)))) ;;; Code supporting the dired-like bookmark menu. Prefix is ;;; "bookmark-bmenu" for "buffer-menu": (defvar bookmark-bmenu-bookmark-column nil) (defvar bookmark-bmenu-hidden-bookmarks ()) (defvar bookmark-bmenu-mode-map nil) (if bookmark-bmenu-mode-map nil (setq bookmark-bmenu-mode-map (make-keymap)) (suppress-keymap bookmark-bmenu-mode-map t) (define-key bookmark-bmenu-mode-map "q" 'bookmark-bmenu-quit) (define-key bookmark-bmenu-mode-map "v" 'bookmark-bmenu-select) (define-key bookmark-bmenu-mode-map "w" 'bookmark-bmenu-locate) (define-key bookmark-bmenu-mode-map "2" 'bookmark-bmenu-2-window) (define-key bookmark-bmenu-mode-map "1" 'bookmark-bmenu-1-window) (define-key bookmark-bmenu-mode-map "j" 'bookmark-bmenu-this-window) (define-key bookmark-bmenu-mode-map "f" 'bookmark-bmenu-this-window) (define-key bookmark-bmenu-mode-map "o" 'bookmark-bmenu-other-window) (define-key bookmark-bmenu-mode-map "\C-o" 'bookmark-bmenu-switch-other-window) (define-key bookmark-bmenu-mode-map "s" 'bookmark-bmenu-save) (define-key bookmark-bmenu-mode-map "k" 'bookmark-bmenu-delete) (define-key bookmark-bmenu-mode-map "\C-d" 'bookmark-bmenu-delete-backwards) (define-key bookmark-bmenu-mode-map "x" 'bookmark-bmenu-execute-deletions) (define-key bookmark-bmenu-mode-map "\C-k" 'bookmark-bmenu-delete) (define-key bookmark-bmenu-mode-map "d" 'bookmark-bmenu-delete) (define-key bookmark-bmenu-mode-map " " 'next-line) (define-key bookmark-bmenu-mode-map "n" 'next-line) (define-key bookmark-bmenu-mode-map "p" 'previous-line) (define-key bookmark-bmenu-mode-map "\177" 'bookmark-bmenu-backup-unmark) (define-key bookmark-bmenu-mode-map "?" 'describe-mode) (define-key bookmark-bmenu-mode-map "u" 'bookmark-bmenu-unmark) (define-key bookmark-bmenu-mode-map "m" 'bookmark-bmenu-mark) (define-key bookmark-bmenu-mode-map "l" 'bookmark-bmenu-load) (define-key bookmark-bmenu-mode-map "r" 'bookmark-bmenu-rename) (define-key bookmark-bmenu-mode-map "t" 'bookmark-bmenu-toggle-filenames) (define-key bookmark-bmenu-mode-map "a" 'bookmark-bmenu-show-annotation) (define-key bookmark-bmenu-mode-map "A" 'bookmark-bmenu-show-all-annotations) (define-key bookmark-bmenu-mode-map "e" 'bookmark-bmenu-edit-annotation)) ;; Bookmark Buffer Menu mode is suitable only for specially formatted ;; data. (put 'bookmark-bmenu-mode 'mode-class 'special) ;; todo: need to display whether or not bookmark exists as a buffer in ;; flag column. ;; Format: ;; FLAGS BOOKMARK [ LOCATION ] (defun bookmark-bmenu-surreptitiously-rebuild-list () "Rebuild the Bookmark List if it exists. Don't affect the buffer ring order." (if (get-buffer "*Bookmark List*") (save-excursion (save-window-excursion (bookmark-bmenu-list))))) ;;;###autoload (defun bookmark-bmenu-list () "Display a list of existing bookmarks. The list is displayed in a buffer named `*Bookmark List*'. The leftmost column displays a D if the bookmark is flagged for deletion, or > if it is flagged for displaying." (interactive) (bookmark-maybe-load-default-file) (if (interactive-p) (switch-to-buffer (get-buffer-create "*Bookmark List*")) (set-buffer (get-buffer-create "*Bookmark List*"))) (let ((buffer-read-only nil)) (delete-region (point-max) (point-min)) (goto-char (point-min)) ;sure are playing it safe... (insert "% Bookmark\n- --------\n") (bookmark-maybe-sort-alist) (mapcar (lambda (full-record) ;; if a bookmark has an annotation, preceed it with a "*" ;; in the list of bookmarks. (let ((annotation (bookmark-get-annotation (bookmark-name-from-full-record full-record)))) (if (and (not (eq annotation nil)) (not (string-equal annotation ""))) (insert " *") (insert " ")) (insert (concat (bookmark-name-from-full-record full-record) "\n")))) bookmark-alist)) (goto-char (point-min)) (forward-line 2) (bookmark-bmenu-mode) (if bookmark-bmenu-toggle-filenames (bookmark-bmenu-toggle-filenames t))) ;;;###autoload (defalias 'list-bookmarks 'bookmark-bmenu-list) ;;;###autoload (defalias 'edit-bookmarks 'bookmark-bmenu-list) (defun bookmark-bmenu-mode () "Major mode for editing a list of bookmarks. Each line describes one of the bookmarks in Emacs. Letters do not insert themselves; instead, they are commands. Bookmark names preceeded by a \"*\" have annotations. \\ \\[bookmark-bmenu-mark] -- mark bookmark to be displayed. \\[bookmark-bmenu-select] -- select bookmark of line point is on. Also show bookmarks marked using m in other windows. \\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names). \\[bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark. \\[bookmark-bmenu-1-window] -- select this bookmark in full-frame window. \\[bookmark-bmenu-2-window] -- select this bookmark in one window, together with bookmark selected before this one in another window. \\[bookmark-bmenu-this-window] -- select this bookmark in place of the bookmark menu buffer. \\[bookmark-bmenu-other-window] -- select this bookmark in another window, so the bookmark menu bookmark remains visible in its window. \\[bookmark-bmenu-switch-other-window] -- switch the other window to this bookmark. \\[bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\). \\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down. \\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up. \\[bookmark-bmenu-execute-deletions] -- delete marked bookmarks. \\[bookmark-bmenu-save] -- save the current bookmark list in the default file. With a prefix arg, prompts for a file to save in. \\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.) \\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line. With prefix argument, also move up one line. \\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks. \\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark in another buffer. \\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer. \\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark." (kill-all-local-variables) (use-local-map bookmark-bmenu-mode-map) (setq truncate-lines t) (setq buffer-read-only t) (setq major-mode 'bookmark-bmenu-mode) (setq mode-name "Bookmark Menu") (run-hooks 'bookmark-bmenu-mode-hook)) (defun bookmark-bmenu-toggle-filenames (&optional show) "Toggle whether filenames are shown in the bookmark list. Optional argument SHOW means show them unconditionally." (interactive) (cond (show (setq bookmark-bmenu-toggle-filenames nil) (bookmark-bmenu-show-filenames) (setq bookmark-bmenu-toggle-filenames t)) (bookmark-bmenu-toggle-filenames (bookmark-bmenu-hide-filenames) (setq bookmark-bmenu-toggle-filenames nil)) (t (bookmark-bmenu-show-filenames) (setq bookmark-bmenu-toggle-filenames t)))) (defun bookmark-bmenu-show-filenames (&optional force) (if (and (not force) bookmark-bmenu-toggle-filenames) nil ;already shown, so do nothing (save-excursion (save-window-excursion (goto-char (point-min)) (forward-line 2) (setq bookmark-bmenu-hidden-bookmarks ()) (let ((buffer-read-only nil)) (while (< (point) (point-max)) (let ((bmrk (bookmark-bmenu-bookmark))) (setq bookmark-bmenu-hidden-bookmarks (cons bmrk bookmark-bmenu-hidden-bookmarks)) (move-to-column bookmark-bmenu-file-column t) (delete-region (point) (progn (end-of-line) (point))) (insert " ") ;; Pass the NO-HISTORY arg: (bookmark-insert-location bmrk t) (forward-line 1)))))))) (defun bookmark-bmenu-hide-filenames (&optional force) (if (and (not force) bookmark-bmenu-toggle-filenames) ;; nothing to hide if above is nil (save-excursion (save-window-excursion (goto-char (point-min)) (forward-line 2) (setq bookmark-bmenu-hidden-bookmarks (nreverse bookmark-bmenu-hidden-bookmarks)) (save-excursion (goto-char (point-min)) (search-forward "Bookmark") (backward-word 1) (setq bookmark-bmenu-bookmark-column (current-column))) (save-excursion (let ((buffer-read-only nil)) (while bookmark-bmenu-hidden-bookmarks (move-to-column bookmark-bmenu-bookmark-column t) (bookmark-kill-line) (insert (car bookmark-bmenu-hidden-bookmarks)) (setq bookmark-bmenu-hidden-bookmarks (cdr bookmark-bmenu-hidden-bookmarks)) (forward-line 1)))))))) ;; if you look at this next function from far away, it resembles a ;; gun. But only with this comment above... (defun bookmark-bmenu-check-position () ;; Returns t if on a line with a bookmark. ;; Otherwise, repositions and returns t. ;; written by David Hughes ;; Mucho thanks, David! -karl (cond ((< (count-lines (point-min) (point)) 2) (goto-char (point-min)) (forward-line 2) t) ((and (bolp) (eobp)) (beginning-of-line 0) t) (t t))) (defun bookmark-bmenu-bookmark () ;; return a string which is bookmark of this line. (if (bookmark-bmenu-check-position) (save-excursion (save-window-excursion (goto-char (point-min)) (search-forward "Bookmark") (backward-word 1) (setq bookmark-bmenu-bookmark-column (current-column))))) (if bookmark-bmenu-toggle-filenames (bookmark-bmenu-hide-filenames)) (save-excursion (save-window-excursion (beginning-of-line) (forward-char bookmark-bmenu-bookmark-column) (prog1 (buffer-substring (point) (progn (end-of-line) (point))) ;; well, this is certainly crystal-clear: (if bookmark-bmenu-toggle-filenames (bookmark-bmenu-toggle-filenames t)))))) (defun bookmark-show-annotation (bookmark) "Display the annotation for bookmark named BOOKMARK in a buffer, if an annotation exists." (let ((annotation (bookmark-get-annotation bookmark))) (if (and (not (eq annotation nil)) (not (string-equal annotation ""))) (progn (save-excursion (let ((old-buf (current-buffer))) (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t) (delete-region (point-min) (point-max)) ; (insert (concat "Annotation for bookmark '" bookmark "':\n\n")) (insert annotation) (goto-char (point-min)) (pop-to-buffer old-buf))))))) (defun bookmark-show-all-annotations () "Display the annotations for all bookmarks in a buffer." (let ((old-buf (current-buffer))) (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t) (delete-region (point-min) (point-max)) (mapcar (lambda (full-record) (let* ((name (bookmark-name-from-full-record full-record)) (ann (bookmark-get-annotation name))) (insert (concat name ":\n")) (if (and (not (eq ann nil)) (not (string-equal ann ""))) ;; insert the annotation, indented by 4 spaces. (progn (save-excursion (insert ann)) (while (< (point) (point-max)) (beginning-of-line) ; paranoia (insert " ") (forward-line) (end-of-line)))))) bookmark-alist) (goto-char (point-min)) (pop-to-buffer old-buf))) (defun bookmark-bmenu-mark () "Mark bookmark on this line to be displayed by \\\\[bookmark-bmenu-select] command." (interactive) (beginning-of-line) (if (bookmark-bmenu-check-position) (let ((buffer-read-only nil)) (delete-char 1) (insert ?>) (forward-line 1)))) (defun bookmark-bmenu-select () "Select this line's bookmark; also display bookmarks marked with `>'. You can mark bookmarks with the \\\\[bookmark-bmenu-mark] command." (interactive) (if (bookmark-bmenu-check-position) (let ((bmrk (bookmark-bmenu-bookmark)) (menu (current-buffer)) (others ()) tem) (goto-char (point-min)) (while (re-search-forward "^>" nil t) (setq tem (bookmark-bmenu-bookmark)) (let ((buffer-read-only nil)) (delete-char -1) (insert ?\ )) (or (string-equal tem bmrk) (member tem others) (setq others (cons tem others)))) (setq others (nreverse others) tem (/ (1- (frame-height)) (1+ (length others)))) (delete-other-windows) (bookmark-jump bmrk) (bury-buffer menu) (if others (while others (split-window nil tem) (other-window 1) (bookmark-jump (car others)) (setq others (cdr others))) (other-window 1))))) (defun bookmark-bmenu-save (parg) "Save the current list into a bookmark file. With a prefix arg, prompts for a file to save them in." (interactive "P") (save-excursion (save-window-excursion (bookmark-save parg)))) (defun bookmark-bmenu-load () "Load the bookmark file and rebuild the bookmark menu-buffer." (interactive) (if (bookmark-bmenu-check-position) (save-excursion (save-window-excursion ;; This will call `bookmark-bmenu-list' (call-interactively 'bookmark-load))))) (defun bookmark-bmenu-1-window () "Select this line's bookmark, alone, in full frame." (interactive) (if (bookmark-bmenu-check-position) (progn (bookmark-jump (bookmark-bmenu-bookmark)) (bury-buffer (other-buffer)) (delete-other-windows)))) (defun bookmark-bmenu-2-window () "Select this line's bookmark, with previous buffer in second window." (interactive) (if (bookmark-bmenu-check-position) (let ((bmrk (bookmark-bmenu-bookmark)) (menu (current-buffer)) (pop-up-windows t)) (delete-other-windows) (switch-to-buffer (other-buffer)) (let* ((pair (bookmark-jump-noselect bmrk)) (buff (car pair)) (pos (cdr pair))) (pop-to-buffer buff) (goto-char pos)) (bury-buffer menu)))) (defun bookmark-bmenu-this-window () "Select this line's bookmark in this window." (interactive) (if (bookmark-bmenu-check-position) (bookmark-jump (bookmark-bmenu-bookmark)))) (defun bookmark-bmenu-other-window () "Select this line's bookmark in other window, leaving bookmark menu visible." (interactive) (let ((bookmark (bookmark-bmenu-bookmark))) (if (bookmark-bmenu-check-position) (let* ((pair (bookmark-jump-noselect bookmark)) (buff (car pair)) (pos (cdr pair))) (switch-to-buffer-other-window buff) (goto-char pos) (set-window-point (get-buffer-window buff) pos) (bookmark-show-annotation bookmark))))) (defun bookmark-bmenu-switch-other-window () "Make the other window select this line's bookmark. The current window remains selected." (interactive) (let ((bookmark (bookmark-bmenu-bookmark))) (if (bookmark-bmenu-check-position) (let* ((pair (bookmark-jump-noselect bookmark)) (buff (car pair)) (pos (cdr pair))) (display-buffer buff) (let ((o-buffer (current-buffer))) ;; save-excursion won't do (set-buffer buff) (goto-char pos) (set-window-point (get-buffer-window buff) pos) (set-buffer o-buffer)) (bookmark-show-annotation bookmark))))) (defun bookmark-bmenu-show-annotation () "Show the annotation for the current bookmark in another window." (interactive) (let ((bookmark (bookmark-bmenu-bookmark))) (if (bookmark-bmenu-check-position) (bookmark-show-annotation bookmark)))) (defun bookmark-bmenu-show-all-annotations () "Show the annotation for all bookmarks in another window." (interactive) (bookmark-show-all-annotations)) (defun bookmark-bmenu-edit-annotation () "Edit the annotation for the current bookmark in another window." (interactive) (let ((bookmark (bookmark-bmenu-bookmark))) (if (bookmark-bmenu-check-position) (bookmark-edit-annotation bookmark)))) (defun bookmark-bmenu-quit () "Quit the bookmark menu." (interactive) (let ((buffer (current-buffer))) (switch-to-buffer (other-buffer)) (bury-buffer buffer))) (defun bookmark-bmenu-unmark (&optional backup) "Cancel all requested operations on bookmark on this line and move down. Optional BACKUP means move up." (interactive "P") (beginning-of-line) (if (bookmark-bmenu-check-position) (progn (let ((buffer-read-only nil)) (delete-char 1) ;; any flags to reset according to circumstances? How about a ;; flag indicating whether this bookmark is being visited? ;; well, we don't have this now, so maybe later. (insert " ")) (forward-line (if backup -1 1))))) (defun bookmark-bmenu-backup-unmark () "Move up and cancel all requested operations on bookmark on line above." (interactive) (forward-line -1) (if (bookmark-bmenu-check-position) (progn (bookmark-bmenu-unmark) (forward-line -1)))) (defun bookmark-bmenu-delete () "Mark bookmark on this line to be deleted by \\\\[bookmark-bmenu-execute-deletions] command." (interactive) (beginning-of-line) (if (bookmark-bmenu-check-position) (let ((buffer-read-only nil)) (delete-char 1) (insert ?D) (forward-line 1)))) (defun bookmark-bmenu-delete-backwards () "Mark bookmark on this line to be deleted by \\\\[bookmark-bmenu-execute-deletions] command and then move up one line" (interactive) (bookmark-bmenu-delete) (forward-line -2) (if (bookmark-bmenu-check-position) (forward-line 1))) (defun bookmark-bmenu-execute-deletions () "Delete bookmarks marked with \\\\[Buffer-menu-delete] commands." (interactive) (let ((hide-em bookmark-bmenu-toggle-filenames) (o-point (point)) (o-str (save-excursion (beginning-of-line) (if (looking-at "^D") nil (buffer-substring (point) (progn (end-of-line) (point)))))) (o-col (current-column))) (if hide-em (bookmark-bmenu-hide-filenames)) (setq bookmark-bmenu-toggle-filenames nil) (goto-char (point-min)) (forward-line 1) (while (re-search-forward "^D" (point-max) t) (bookmark-delete (bookmark-bmenu-bookmark) t)) ; pass BATCH arg (bookmark-bmenu-list) (setq bookmark-bmenu-toggle-filenames hide-em) (if bookmark-bmenu-toggle-filenames (bookmark-bmenu-toggle-filenames t)) (if o-str (progn (goto-char (point-min)) (search-forward o-str) (beginning-of-line) (forward-char o-col)) (goto-char o-point)) (beginning-of-line) (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) (if (bookmark-time-to-save-p) (bookmark-save)))) (defun bookmark-bmenu-rename () "Rename bookmark on current line. Prompts for a new name." (interactive) (if (bookmark-bmenu-check-position) (let ((bmrk (bookmark-bmenu-bookmark)) (thispoint (point))) (bookmark-rename bmrk) (bookmark-bmenu-list) (goto-char thispoint)))) (defun bookmark-bmenu-locate () "Display location of this bookmark. Displays in the minibuffer." (interactive) (if (bookmark-bmenu-check-position) (let ((bmrk (bookmark-bmenu-bookmark))) (message (bookmark-location bmrk))))) ;;; Menu bar stuff. Prefix is "bookmark-menu". (defun bookmark-menu-build-paned-menu (name entries) "Build a multi-paned menu named NAME from the strings in ENTRIES. That is, ENTRIES is a list of strings which appear as the choices in the menu. The number of panes depends on the number of entries. The visible entries are truncated to `bookmark-menu-length', but the strings returned are not." (let* ((f-height (/ (frame-height) 2)) (pane-list (let (temp-pane-list (iter 0)) (while entries (let (lst (count 0)) (while (and (< count f-height) entries) (let ((str (car entries))) (setq lst (cons (cons (if (> (length str) bookmark-menu-length) (substring str 0 bookmark-menu-length) str) str) lst)) (setq entries (cdr entries)) (setq count (1+ count)))) (setq iter (1+ iter)) (setq temp-pane-list (cons (cons (format "-*- %s (%d) -*-" name iter) (nreverse lst)) temp-pane-list)))) (nreverse temp-pane-list)))) ;; Return the menu: (cons (concat "-*- " name " -*-") pane-list))) (defun bookmark-menu-popup-paned-menu (event name entries) "Pop up multi-paned menu at EVENT, return string chosen from ENTRIES. That is, ENTRIES is a list of strings which appear as the choices in the menu. The number of panes depends on the number of entries." (interactive "e") (x-popup-menu event (bookmark-menu-build-paned-menu name entries))) (defun bookmark-menu-popup-paned-bookmark-menu (event name) "Pop up menu of bookmarks, return chosen bookmark. Pop up at EVENT, menu's name is NAME. The number of panes depends on the number of bookmarks." (bookmark-menu-popup-paned-menu event name (bookmark-all-names))) (defun bookmark-popup-menu-and-apply-function (func-sym menu-label event) ;; help function for making menus that need to apply a bookmark ;; function to a string. (let* ((choice (bookmark-menu-popup-paned-bookmark-menu event menu-label))) (if choice (apply func-sym (list choice))))) ;;;###autoload (defun bookmark-menu-insert (event) "Insert the text of the file pointed to by bookmark BOOKMARK. You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this. Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp \(the one without the \"-menu-\" in its name\)." (interactive "e") (bookmark-popup-menu-and-apply-function 'bookmark-insert "Insert Bookmark Contents" event)) ;;;###autoload (defun bookmark-menu-jump (event) "Jump to bookmark BOOKMARK (a point in some file). You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this. Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp \(the one without the \"-menu-\" in its name\)." (interactive "e") (bookmark-popup-menu-and-apply-function 'bookmark-jump "Jump to Bookmark" event)) ;;;###autoload (defun bookmark-menu-locate (event) "Insert the name of the file associated with BOOKMARK. \(This is not the same as the contents of that file\). Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp \(the one without the \"-menu-\" in its name\)." (interactive "e") (bookmark-popup-menu-and-apply-function 'bookmark-insert-location "Insert Bookmark Location" event)) ;;;###autoload (defun bookmark-menu-rename (event) "Change the name of OLD-BOOKMARK to NEWNAME. If called from keyboard, prompts for OLD-BOOKMARK and NEWNAME. If called from menubar, OLD-BOOKMARK is selected from a menu, and prompts for NEWNAME. If called from Lisp, prompts for NEWNAME if only OLD-BOOKMARK was passed as an argument. If called with two strings, then no prompting is done. You must pass at least OLD-BOOKMARK when calling from Lisp. While you are entering the new name, consecutive C-w's insert consectutive words from the text of the buffer into the new bookmark name. Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp \(the one without the \"-menu-\" in its name\)." (interactive "e") (bookmark-popup-menu-and-apply-function 'bookmark-rename "Rename Bookmark" event)) ;;;###autoload (defun bookmark-menu-delete (event) "Delete the bookmark named NAME from the bookmark list. Removes only the first instance of a bookmark with that name. If there are one or more other bookmarks with the same name, they will not be deleted. Defaults to the \"current\" bookmark \(that is, the one most recently used in this file, if any\). Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp \(the one without the \"-menu-\" in its name\)." (interactive "e") (bookmark-popup-menu-and-apply-function 'bookmark-delete "Delete Bookmark" event)) ;; Thanks to Roland McGrath for fixing menubar.el so that the ;; following works, and for explaining what to do to make it work. ;; We MUST autoload EACH form used to set up this variable's value, so ;; that the whole job is done in loaddefs.el. ;;;###autoload (defvar menu-bar-bookmark-map (make-sparse-keymap "Bookmark functions")) ;;;###autoload (defalias 'menu-bar-bookmark-map (symbol-value 'menu-bar-bookmark-map)) ;;;###autoload (define-key menu-bar-bookmark-map [load] '("Load a Bookmark File" . bookmark-load)) ;;;###autoload (define-key menu-bar-bookmark-map [write] '("Write \(to another file\)" . bookmark-write)) ;;;###autoload (define-key menu-bar-bookmark-map [save] '("Save \(in default file\)" . bookmark-save)) ;;;###autoload (define-key menu-bar-bookmark-map [edit] '("Edit Bookmark List" . bookmark-bmenu-list)) ;;;###autoload (define-key menu-bar-bookmark-map [delete] '("Delete Bookmark" . bookmark-menu-delete)) ;;;###autoload (define-key menu-bar-bookmark-map [rename] '("Rename Bookmark" . bookmark-menu-rename)) ;;;###autoload (define-key menu-bar-bookmark-map [locate] '("Insert Location" . bookmark-menu-locate)) ;;;###autoload (define-key menu-bar-bookmark-map [insert] '("Insert Contents" . bookmark-menu-insert)) ;;;###autoload (define-key menu-bar-bookmark-map [set] '("Set Bookmark" . bookmark-set)) ;;;###autoload (define-key menu-bar-bookmark-map [jump] '("Jump to Bookmark" . bookmark-menu-jump)) ;;;; end bookmark menu stuff ;;;; ;;; Load Hook (defvar bookmark-load-hook nil "Hook to run at the end of loading bookmark.") (run-hooks 'bookmark-load-hook) (provide 'bookmark) ;;; bookmark.el ends here emacs-19.30/lisp/blessmail.el100444 12120 1 4672 5564405000 14353 0ustar rmsdaemon;;; blessmail.el --- Decide whether movemail needs special privileges. ;;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal ;; 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 is loaded into a bare Emacs to create the blessmail script, ;; which (on systems that need it) is used during installation ;; to give appropriate permissions to movemail. ;; ;; It has to be done from lisp in order to be sure of getting the ;; correct value of rmail-spool-directory. ;;; Code: ;; These are no longer needed because we run this in emacs instead of temacs. ;; (message "Using load-path %s" load-path) ;; (load "paths.el") ;; It is not safe to load site-init.el here, because it might have things in it ;; that won't load properly unless all the rest of Emacs is loaded. (let ((dirname (directory-file-name rmail-spool-directory)) linkname attr modes) ;; Check for symbolic link (while (setq linkname (file-symlink-p dirname)) (setq dirname (if (file-name-absolute-p linkname) linkname (concat (file-name-directory dirname) linkname)))) (insert "#!/bin/sh\n") (setq attr (file-attributes dirname)) (if (not (eq t (car attr))) (insert (format "echo %s is not a directory\n" rmail-spool-directory)) (setq modes (nth 8 attr)) (cond ((= ?w (aref modes 8)) ;; Nothing needs to be done. ) ((= ?w (aref modes 5)) (insert "chgrp " (number-to-string (nth 3 attr)) " $* && chmod g+s $*\n")) ((= ?w (aref modes 2)) (insert "chown " (number-to-string (nth 2 attr)) " $* && chmod u+s $*\n")) (t (insert "chown root $* && chmod u+s $*\n")))) (insert "echo mail directory = " dirname "\n")) (write-region (point-min) (point-max) "blessmail") (kill-emacs) ;;; blessmail.el ends here emacs-19.30/lisp/browse-url.el100444 22556 1 55421 6040075534 14673 0ustar erikdaemon;;; browse-url.el --- ask a WWW browser to load a URL ;; Copyright 1995 Free Software Foundation, Inc. ;; Author: Denis Howe ;; Maintainer: Denis Howe ;; Created: 03 Apr 1995 ;; Keywords: hypertext ;; X-Home page: http://wombat.doc.ic.ac.uk/ ;; 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: ;; The latest version of this package should be available from ;; . ;; This package provides functions which read a URL (Uniform Resource ;; Locator) from the minibuffer, defaulting to the URL around point, ;; and ask a World-Wide Web browser to load it. It can also load the ;; URL associated with the current buffer. Different browsers use ;; different methods of remote control so there is one function for ;; each supported browser. If the chosen browser is not running, it ;; is started. Currently there is support for: ;; Function Browser Earliest version ;; browse-url-netscape Netscape 1.1b1 ;; browse-url-mosaic XMosaic <= 2.4 ;; browse-url-cci XMosaic 2.5 ;; browse-url-w3 w3 0 ;; browse-url-iximosaic IXI Mosaic ? ;; Note that versions of Netscape before 1.1b1 did not have remote ;; control. ;; and . ;; Netscape can cache Web pages so it may be necessary to tell it to ;; reload the current page if it has changed (eg. if you have edited ;; it). There is currently no perfect automatic solution to this. ;; Netscape allows you to specify the id of the window you want to ;; control but which window DO you want to control and how do you ;; discover its id? ;; If using XMosaic before version 2.5, check the definition of ;; browse-url-usr1-signal below. ;; ;; XMosaic version 2.5 introduced Common Client Interface allowing you ;; to control mosaic through Unix sockets. ;; ;; William M. Perry's excellent "w3" WWW browser for ;; Emacs ;; has a function w3-follow-url-at-point, but that ;; doesn't let you edit the URL like browse-url. ;; I recommend Nelson Minar 's excellent ;; html-helper-mode.el for editing HTML and thank Nelson for ;; his many useful comments on this code. ;; ;; This package generalises function html-previewer-process in Marc ;; Andreessen 's html-mode (LCD ;; modes/html-mode.el.Z) and provides better versions of the URL ;; functions in Michelangelo Grigni 's ffap.el ;; (find-file-at-point) . The huge ;; hyperbole package also contains similar functions. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Help! ;; Can you write and test some code for the Macintrash and Windoze ;; Netscape remote control APIs? (See the URL above). ;; Do any other browsers have remote control? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Installation ;; Put the following in your ~/.emacs file: ;; ;; (autoload 'browse-url-at-point "browse-url" ;; "Ask a WWW browser to load the URL at or before point." t) ;; (autoload 'browse-url-at-mouse "browse-url" ;; "Ask a WWW browser to load a URL clicked with the mouse." t) ;; (autoload 'browse-url-of-buffer "browse-url" ;; "Ask a WWW browser to display BUFFER." t) ;; (autoload 'browse-url-of-file "browse-url" ;; "Ask a WWW browser to display FILE." t) ;; (autoload 'browse-url-of-dired-file "browse-url" ;; "In Dired, ask a WWW browser to display the file named on this line." t) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Usage ;; To display the URL at or before point: ;; M-x browse-url-at-point RET ;; To display a URL by shift-clicking on it, put this in your ~/.emacs ;; file: ;; (global-set-key [S-mouse-1] 'browse-url-at-mouse) ;; To display the current buffer in a web browser: ;; M-x browse-url-of-buffer RET ;; In Dired, to display the file named on the current line: ;; M-x browse-url-of-dired-file RET ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Customisation (~/.emacs) ;; To see what variables are available for customization, type `M-x ;; set-variable browse-url TAB'. ;; To bind the browse-url commands to keys with the `C-c u' prefix: ;; (global-set-key "\C-cu." 'browse-url-at-point) ;; (global-set-key "\C-cub" 'browse-url-of-buffer) ;; (global-set-key "\C-cuf" 'browse-url-of-file) ;; (add-hook 'dired-mode-hook ;; (lambda () ;; (local-set-key "\C-cuf" 'browse-url-of-dired-file)))) ;; (if (boundp 'browse-url-browser-function) ;; (global-set-key "\C-cuu" browse-url-browser-function) ;; (eval-after-load ;; "browse-url" ;; '(global-set-key "\C-cuu" browse-url-browser-function))) ;; To use the Emacs w3 browser when not running under X11: ;; (if (not (eq window-system 'x)) ;; (setq browse-url-browser-function 'browse-url-w3)) ;; To always save modified buffers before displaying the file in a browser: ;; (setq browse-url-save-file t) ;; To get round the Netscape caching problem, you could try either of ;; the following (but not both). EITHER write-file in ;; html-helper-mode makes Netscape reload document: ;; ;; (autoload 'browse-url-netscape-reload "browse-url" ;; "Ask a WWW browser to redisplay the current file." t) ;; (add-hook 'html-helper-mode-hook ;; (function (lambda () ;; (add-hook 'local-write-file-hooks ;; (function (lambda () ;; (let ((local-write-file-hooks)) ;; (save-buffer)) ;; (browse-url-netscape-reload) ;; t)) ; => file written by hook ;; t)))) ; append to l-w-f-hooks ;; ;; [Does this work for html-mode too?] ;; ;; OR browse-url-of-file ask Netscape to load and then reload the ;; file: ;; ;; (add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload) ;; You may also want to customise browse-url-netscape-arguments, eg. ;; ;; (setq browse-url-netscape-arguments '("-install")) ;; ;; or similarly for the other browsers. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Change Log: ;; 0.00 03 Apr 1995 Denis Howe ;; Created. ;; 0.01 04 Apr 1995 ;; All names start with "browse-url-". Added provide. ;; 0.02 05 Apr 1995 ;; Save file at start of browse-url-of-file. ;; Use start-process instead of start-process-shell-command. ;; 0.03 06 Apr 1995 ;; Add browse-url-netscape-reload, browse-url-netscape-command. ;; browse-url-of-file save file option. ;; 0.04 08 Apr 1995 ;; b-u-file-url separate function. Change b-u-filename-alist ;; default. ;; 0.05 09 Apr 1995 ;; Added b-u-of-file-hook. ;; 0.06 11 Apr 1995 ;; Improved .emacs suggestions and documentation. ;; 0.07 13 Apr 1995 ;; Added browse-url-interactive-arg optional prompt. ;; 0.08 18 Apr 1995 ;; Exclude final "." from browse-url-regexp. ;; 0.09 21 Apr 1995 ;; Added mouse-set-point to browse-url-interactive-arg. ;; 0.10 24 Apr 1995 ;; Added Mosaic signal sending variations. ;; Thanks Brian K Servis . ;; Don't use xprop for Netscape. ;; 0.11 25 Apr 1995 ;; Fix reading of ~/.mosaicpid. Thanks Dag.H.Wanvik@kvatro.no. ;; 0.12 27 Apr 1995 ;; Interactive prefix arg => URL *after* point. ;; Thanks Michelangelo Grigni . ;; Added IXI Mosaic support. ;; Thanks David Karr . ;; 0.13 28 Apr 1995 ;; Exclude final [,;] from browse-url-regexp. ;; 0.14 02 May 1995 ;; Provide browser argument variables. ;; 0.15 07 May 1995 ;; More Netscape options. Thanks Peter Arius ;; . ;; 0.16 17 May 1995 ;; Added browse-url-at-mouse. ;; Thanks Wayne Mesard ;; 0.17 27 Jun 1995 ;; Renamed browse-url-at-point to browse-url-url-at-point. ;; Added browse-url-at-point. ;; Thanks Jonathan Cano . ;; 0.18 16 Aug 1995 ;; Fixed call to browse-url-url-at-point in browse-url-at-point. ;; Thanks Eric Ding . ;; 0.19 24 Aug 1995 ;; Improved documentation. ;; Thanks Kevin Rodgers . ;; 0.20 31 Aug 1995 ;; browse-url-of-buffer to handle file-less buffers. ;; browse-url-of-dired-file browses current file in dired. ;; Thanks Kevin Rodgers . ;; 0.21 09 Sep 1995 ;; XMosaic CCI functions. ;; Thanks Marc Furrer . ;; 0.22 13 Sep 1995 ;; Fixed new-window documentation and added to browse-url-cci. ;; Thanks Dilip Sequeira . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Code: (defvar browse-url-regexp "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+" "A regular expression probably matching a URL.") (defvar browse-url-browser-function 'browse-url-netscape "*Function to display the current buffer in a WWW browser. Used by the `browse-url-at-point', `browse-url-at-mouse', and `browse-url-of-file' commands.") (defvar browse-url-netscape-arguments nil "*A list of strings to pass to Netscape as arguments.") (defvar browse-url-new-window-p nil "*If non-nil, always open a new browser window. Passing an interactive argument to \\[browse-url-netscape] or \\[browse-url-cci] reverses the effect of this variable. Requires Netscape version 1.1N or later or XMosaic version 2.5 or later.") (defvar browse-url-mosaic-arguments nil "*A list of strings to pass to Mosaic as arguments.") (defvar browse-url-filename-alist '(("^/+" . "file:/")) "An alist of (REGEXP . STRING) pairs. Any substring of a filename matching one of the REGEXPs is replaced by the corresponding STRING. All pairs are applied in the order given. Used by the `browse-url-of-file' command.") (defvar browse-url-save-file nil "If non-nil, save the buffer before displaying its file. Used by the `browse-url-of-file' command.") (defvar browse-url-of-file-hook nil "A hook to be run with run-hook after `browse-url-of-file' has asked a browser to load a file. Set this to `browse-url-netscape-reload' to force Netscape to load the file rather than displaying a cached copy.") (defvar browse-url-usr1-signal (if (and (boundp 'emacs-major-version) (or (> emacs-major-version 19) (>= emacs-minor-version 29))) 'sigusr1 30) ; Check /usr/include/signal.h. "The argument to `signal-process' for sending SIGUSR1 to XMosaic. Emacs 19.29 accepts 'sigusr1, earlier versions require an integer which is 30 on SunOS and 16 on HP-UX and Solaris.") (defvar browse-url-CCI-port 3003 "Port to access XMosaic via CCI. This can be any number between 1024 and 65535 but must correspond to the value set in the browser.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; URL input ;; thingatpt.el doesn't work for complex regexps. (defun browse-url-url-at-point () "Return the URL around or before point. Then search backwards for the start of a URL. If no URL found, return the empty string." (if (or (looking-at browse-url-regexp) ; Already at start (let ((eol (save-excursion (end-of-line) (point)))) ;; Search forwards for the next URL or end of line in case ;; we're in the middle of one. (and (re-search-forward browse-url-regexp eol 'lim) (goto-char (match-beginning 0))) ;; Now back to where we started or earlier. (re-search-backward browse-url-regexp nil t))) (buffer-substring (match-beginning 0) (match-end 0)) "")) ; No match ;; Todo: restrict to around or immediately before point. Expand bare ;; hostname to URL. (defun browse-url-interactive-arg (&optional prompt) "Read a URL from the minibuffer, optionally prompting with PROMPT. Default to the URL at or before point. If bound to a mouse button, set point to the position clicked. Return the result as a list for use in `interactive'." (let ((event (elt (this-command-keys) 0))) (and (listp event) (mouse-set-point event))) (list (read-string (or prompt "URL: ") (browse-url-url-at-point)))) (defun browse-url-at-point () "Ask a WWW browser to load the URL at or before point. The URL is loaded according to the value of `browse-url-browser-function'." (interactive) (funcall browse-url-browser-function (browse-url-url-at-point))) (defun browse-url-at-mouse (event) "Ask a WWW browser to load a URL clicked with the mouse. The URL is the one around or before the position of the mouse click but point is not changed. The URL is loaded according to the value of `browse-url-browser-function'." (interactive "e") (save-excursion (let ((posn (event-start event))) (set-buffer (window-buffer (posn-window posn))) (goto-char (posn-point posn)) (let ((url (browse-url-url-at-point))) (if (string-equal url "") (error "No URL found")) (funcall browse-url-browser-function url))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Browse current buffer (defun browse-url-of-file (&optional file) "Ask a WWW browser to display FILE. Display the current buffer's file if FILE is nil or if called interactively. Turn the filename into a URL by performing replacements given in variable `browse-url-filename-alist'. Pass the URL to a browser using variable `browse-url-browser-function' then run `browse-url-of-file-hook'." (interactive) (setq file (or file (buffer-file-name) (error "Current buffer has no file"))) (let ((buf (get-file-buffer file))) (if buf (save-excursion (set-buffer buf) (cond ((not (buffer-modified-p))) (browse-url-save-file (save-buffer)) (t (message "%s modified since last save" file)))))) (funcall browse-url-browser-function (browse-url-file-url file)) (run-hooks 'browse-url-of-file-hook)) (defun browse-url-file-url (file) "Return the URL corresponding to FILE. Uses variable `browse-url-filename-alist' to map filenames to URLs." (let ((maps browse-url-filename-alist)) (while maps (let* ((map (car maps)) (from-re (car map)) (to-string (cdr map))) (setq maps (cdr maps)) (if (string-match from-re file) (setq file (concat (substring file 0 (match-beginning 0)) to-string (substring file (match-end 0)))))))) file) (defvar browse-url-temp-file-name nil) (make-variable-buffer-local 'browse-url-temp-file-name) (defvar browse-url-temp-file-list '()) (defun browse-url-of-buffer (&optional buffer) "Ask a WWW browser to display BUFFER. Display the current buffer if BUFFER is nil." (interactive) (save-excursion (set-buffer (or buffer (current-buffer))) (let ((file-name (or buffer-file-name (and (boundp 'dired-directory) dired-directory)))) (if (null file-name) (progn (if (null browse-url-temp-file-name) (progn (setq browse-url-temp-file-name (make-temp-name (expand-file-name (buffer-name) (or (getenv "TMPDIR") "/tmp")))) (setq browse-url-temp-file-list (cons browse-url-temp-file-name browse-url-temp-file-list)))) (write-region (point-min) (point-max) browse-url-temp-file-name nil 'no-message))) (browse-url-of-file (or file-name browse-url-temp-file-name))))) (defun browse-url-delete-temp-file (&optional temp-file-name) ;; Delete browse-url-temp-file-name from the file system and from ;; browse-url-temp-file-list. If optional arg TEMP-FILE-NAME is ;; non-nil, delete it instead, but only from the file system -- ;; browse-url-temp-file-list is not affected. (let ((file-name (or temp-file-name browse-url-temp-file-name))) (if (and file-name (file-exists-p file-name)) (progn (delete-file file-name) (if (null temp-file-name) (setq browse-url-temp-file-list (delete browse-url-temp-file-name browse-url-temp-file-list))))))) (defun browse-url-delete-temp-file-list () ;; Delete all elements of browse-url-temp-file-list. (while browse-url-temp-file-list (browse-url-delete-temp-file (car browse-url-temp-file-list)) (setq browse-url-temp-file-list (cdr browse-url-temp-file-list)))) (add-hook 'kill-buffer-hook 'browse-url-delete-temp-file) (add-hook 'kill-emacs-hook 'browse-url-delete-temp-file-list) (defun browse-url-of-dired-file () "In Dired, ask a WWW browser to display the file named on this line." (interactive) (browse-url-of-file (dired-get-filename))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Browser-specific functions (defun browse-url-netscape (url &optional new-window) "Ask the Netscape WWW browser to load URL. Default to the URL around or before point. The strings in variable `browse-url-netscape-arguments' are also passed to Netscape. When called interactively, if variable `browse-url-new-window-p' is non-nil, load the document in a new Netscape window, otherwise use a random existing one. A non-nil interactive prefix argument reverses the effect of browse-url-new-window-p. When called non-interactively, optional second argument NEW-WINDOW is used instead of browse-url-new-window-p." (interactive (append (browse-url-interactive-arg "Netscape URL: ") (list (not (eq (null browse-url-new-window-p) (null current-prefix-arg)))))) (or (zerop (apply 'call-process "netscape" nil nil nil (append browse-url-netscape-arguments (if new-window '("-noraise")) (list "-remote" (concat "openURL(" url (if new-window ",new-window") ")"))))) (progn ; Netscape not running - start it (message "Starting Netscape...") (apply 'start-process "netscape" nil "netscape" (append browse-url-netscape-arguments (list url)))))) (defun browse-url-netscape-reload () "Ask Netscape to reload its current document." (interactive) (browse-url-netscape-command "reload")) (defun browse-url-netscape-command (command) "Send a remote control command to Netscape." (apply 'start-process "netscape" nil "netscape" (append browse-url-netscape-arguments (list "-remote" command)))) (defun browse-url-mosaic (url) "Ask the XMosaic WWW browser to load URL. Default to the URL around or before point." (interactive (browse-url-interactive-arg "Mosaic URL: ")) (let ((pidfile (expand-file-name "~/.mosaicpid")) pid pidbuf) (if (file-readable-p pidfile) (save-excursion (find-file pidfile) (goto-char (point-min)) (setq pid (read (current-buffer))) (kill-buffer nil))) (if (and pid (zerop (signal-process pid 0))) ; Mosaic running (save-excursion (find-file (format "/tmp/Mosaic.%d" pid)) (erase-buffer) (insert "goto\n" url "\n") (save-buffer) (kill-buffer nil) ;; Send signal SIGUSR to Mosaic (message "Signalling Mosaic...") (signal-process pid browse-url-usr1-signal) ;; Or you could try: ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid)) ) ;; Mosaic not running - start it (message "Starting Mosaic...") (apply 'start-process "xmosaic" nil "xmosaic" (append browse-url-mosaic-arguments (list url)))))) (defun browse-url-cci (url &optional new-window) "Ask the XMosaic WWW browser to load URL. Default to the URL around or before point. This function only works for XMosaic version 2.5 or later. You must select `CCI' from XMosaic's File menu, set the CCI Port Address to the value of variable `browse-url-CCI-port', and enable `Accept requests'. When called interactively, if variable `browse-url-new-window-p' is non-nil, load the document in a new browser window, otherwise use a random existing one. A non-nil interactive prefix argument reverses the effect of browse-url-new-window-p. When called non-interactively, optional second argument NEW-WINDOW is used instead of browse-url-new-window-p." (interactive (append (browse-url-interactive-arg "Mosaic URL: ") (list (not (eq (null browse-url-new-window-p) (null current-prefix-arg)))))) (open-network-stream "browse-url" " *browse-url*" "localhost" browse-url-CCI-port) ;; Todo: start browser if fails (process-send-string "browse-url" (concat "get url (" url ") output " (if new-window "new" "current") "\r\n")) (process-send-string "browse-url" "disconnect\r\n") (delete-process "browse-url")) (defun browse-url-iximosaic (url) "Ask the IXIMosaic WWW browser to load URL. Default to the URL around or before point." (interactive (browse-url-interactive-arg "IXI Mosaic URL: ")) (start-process "tellw3b" nil "tellw3b" "-service WWW_BROWSER ixi_showurl " url)) (defun browse-url-w3 (url) "Ask the w3 WWW browser to load URL. Default to the URL around or before point." (interactive (browse-url-interactive-arg "W3 URL: ")) (w3-fetch url)) (provide 'browse-url) ;;; browse-url.el ends here emacs-19.30/lisp/buff-menu.el100444 12120 1 46647 6032612332 14313 0ustar rmsdaemon;;; buff-menu.el --- buffer menu main function and support functions. ;; Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc. ;; Maintainer: FSF ;; 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: ;; Edit, delete, or change attributes of all currently active Emacs ;; buffers from a list summarizing their state. A good way to browse ;; any special or scratch buffers you have loaded, since you can't find ;; them by filename. The single entry point is `Buffer-menu-mode', ;; normally bound to C-x C-b. ;;; Change Log: ;; Merged by esr with recent mods to Emacs 19 buff-menu, 23 Mar 1993 ;; ;; Modified by Bob Weiner, Motorola, Inc., 4/14/89 ;; ;; Added optional backup argument to 'Buffer-menu-unmark' to make it undelete ;; current entry and then move to previous one. ;; ;; Based on FSF code dating back to 1985. ;;; Code: ;;;Trying to preserve the old window configuration works well in ;;;simple scenarios, when you enter the buffer menu, use it, and exit it. ;;;But it does strange things when you switch back to the buffer list buffer ;;;with C-x b, later on, when the window configuration is different. ;;;The choice seems to be, either restore the window configuration ;;;in all cases, or in no cases. ;;;I decided it was better not to restore the window config at all. -- rms. ;;;But since then, I changed buffer-menu to use the selected window, ;;;so q now once again goes back to the previous window configuration. ;;;(defvar Buffer-menu-window-config nil ;;; "Window configuration saved from entry to `buffer-menu'.") ; Put buffer *Buffer List* into proper mode right away ; so that from now on even list-buffers is enough to get a buffer menu. (defvar Buffer-menu-buffer-column nil) (defvar Buffer-menu-mode-map nil "") (if Buffer-menu-mode-map () (setq Buffer-menu-mode-map (make-keymap)) (suppress-keymap Buffer-menu-mode-map t) (define-key Buffer-menu-mode-map "q" 'Buffer-menu-quit) (define-key Buffer-menu-mode-map "v" 'Buffer-menu-select) (define-key Buffer-menu-mode-map "2" 'Buffer-menu-2-window) (define-key Buffer-menu-mode-map "1" 'Buffer-menu-1-window) (define-key Buffer-menu-mode-map "f" 'Buffer-menu-this-window) (define-key Buffer-menu-mode-map "\C-m" 'Buffer-menu-this-window) (define-key Buffer-menu-mode-map "o" 'Buffer-menu-other-window) (define-key Buffer-menu-mode-map "\C-o" 'Buffer-menu-switch-other-window) (define-key Buffer-menu-mode-map "s" 'Buffer-menu-save) (define-key Buffer-menu-mode-map "d" 'Buffer-menu-delete) (define-key Buffer-menu-mode-map "k" 'Buffer-menu-delete) (define-key Buffer-menu-mode-map "\C-d" 'Buffer-menu-delete-backwards) (define-key Buffer-menu-mode-map "\C-k" 'Buffer-menu-delete) (define-key Buffer-menu-mode-map "x" 'Buffer-menu-execute) (define-key Buffer-menu-mode-map " " 'next-line) (define-key Buffer-menu-mode-map "n" 'next-line) (define-key Buffer-menu-mode-map "p" 'previous-line) (define-key Buffer-menu-mode-map "\177" 'Buffer-menu-backup-unmark) (define-key Buffer-menu-mode-map "~" 'Buffer-menu-not-modified) (define-key Buffer-menu-mode-map "?" 'describe-mode) (define-key Buffer-menu-mode-map "u" 'Buffer-menu-unmark) (define-key Buffer-menu-mode-map "m" 'Buffer-menu-mark) (define-key Buffer-menu-mode-map "t" 'Buffer-menu-visit-tags-table) (define-key Buffer-menu-mode-map "%" 'Buffer-menu-toggle-read-only) (define-key Buffer-menu-mode-map "g" 'revert-buffer) (define-key Buffer-menu-mode-map [mouse-2] 'Buffer-menu-mouse-select) ) ;; Buffer Menu mode is suitable only for specially formatted data. (put 'Buffer-menu-mode 'mode-class 'special) (defun Buffer-menu-mode () "Major mode for editing a list of buffers. Each line describes one of the buffers in Emacs. Letters do not insert themselves; instead, they are commands. \\ \\[Buffer-menu-mouse-select] -- select buffer you click on, in place of the buffer menu. \\[Buffer-menu-this-window] -- select current line's buffer in place of the buffer menu. \\[Buffer-menu-other-window] -- select that buffer in another window, so the buffer menu buffer remains visible in its window. \\[Buffer-menu-switch-other-window] -- make another window display that buffer. \\[Buffer-menu-mark] -- mark current line's buffer to be displayed. \\[Buffer-menu-select] -- select current line's buffer. Also show buffers marked with m, in other windows. \\[Buffer-menu-1-window] -- select that buffer in full-frame window. \\[Buffer-menu-2-window] -- select that buffer in one window, together with buffer selected before this one in another window. \\[Buffer-menu-visit-tags-table] -- visit-tags-table this buffer. \\[Buffer-menu-not-modified] -- clear modified-flag on that buffer. \\[Buffer-menu-save] -- mark that buffer to be saved, and move down. \\[Buffer-menu-delete] -- mark that buffer to be deleted, and move down. \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted, and move up. \\[Buffer-menu-execute] -- delete or save marked buffers. \\[Buffer-menu-unmark] -- remove all kinds of marks from current line. With prefix argument, also move up one line. \\[Buffer-menu-backup-unmark] -- back up a line and remove marks. \\[Buffer-menu-toggle-read-only] -- toggle read-only status of buffer on this line." (kill-all-local-variables) (use-local-map Buffer-menu-mode-map) (setq major-mode 'Buffer-menu-mode) (setq mode-name "Buffer Menu") (make-local-variable 'revert-buffer-function) (setq revert-buffer-function 'Buffer-menu-revert-function) (setq truncate-lines t) (setq buffer-read-only t) (run-hooks 'buffer-menu-mode-hook)) (defun Buffer-menu-revert-function (ignore1 ignore2) (list-buffers)) (defun Buffer-menu-buffer (error-if-non-existent-p) "Return buffer described by this line of buffer menu." (let* ((where (save-excursion (beginning-of-line) (+ (point) Buffer-menu-buffer-column))) (name (and (not (eobp)) (get-text-property where 'buffer-name)))) (if name (or (get-buffer name) (if error-if-non-existent-p (error "No buffer named `%s'" name) nil)) (if error-if-non-existent-p (error "No buffer on this line") nil)))) (defun buffer-menu (&optional arg) "Make a menu of buffers so you can save, delete or select them. With argument, show only buffers that are visiting files. Type ? after invocation to get help on commands available. Type q immediately to make the buffer menu go away." (interactive "P") ;;; (setq Buffer-menu-window-config (current-window-configuration)) (switch-to-buffer (list-buffers-noselect arg)) (message "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help.")) (defun buffer-menu-other-window (&optional arg) "Display a list of buffers in another window. With the buffer list buffer, you can save, delete or select the buffers. With argument, show only buffers that are visiting files. Type ? after invocation to get help on commands available. Type q immediately to make the buffer menu go away." (interactive "P") ;;; (setq Buffer-menu-window-config (current-window-configuration)) (switch-to-buffer-other-window (list-buffers-noselect arg)) (message "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help.")) (defun Buffer-menu-quit () "Quit the buffer menu." (interactive) (let ((buffer (current-buffer))) ;; Switch away from the buffer menu and bury it. (switch-to-buffer (other-buffer)) (bury-buffer buffer))) (defun Buffer-menu-mark () "Mark buffer on this line for being displayed by \\\\[Buffer-menu-select] command." (interactive) (beginning-of-line) (if (looking-at " [-M]") (ding) (let ((buffer-read-only nil)) (delete-char 1) (insert ?>) (forward-line 1)))) (defun Buffer-menu-unmark (&optional backup) "Cancel all requested operations on buffer on this line and move down. Optional ARG means move up." (interactive "P") (beginning-of-line) (if (looking-at " [-M]") (ding) (let* ((buf (Buffer-menu-buffer t)) (mod (buffer-modified-p buf)) (readonly (save-excursion (set-buffer buf) buffer-read-only)) (buffer-read-only nil)) (delete-char 3) (insert (if readonly (if mod " *%" " %") (if mod " * " " "))))) (forward-line (if backup -1 1))) (defun Buffer-menu-backup-unmark () "Move up and cancel all requested operations on buffer on line above." (interactive) (forward-line -1) (Buffer-menu-unmark) (forward-line -1)) (defun Buffer-menu-delete (&optional arg) "Mark buffer on this line to be deleted by \\\\[Buffer-menu-execute] command. Prefix arg is how many buffers to delete. Negative arg means delete backwards." (interactive "p") (beginning-of-line) (if (looking-at " [-M]") ;header lines (ding) (let ((buffer-read-only nil)) (if (or (null arg) (= arg 0)) (setq arg 1)) (while (> arg 0) (delete-char 1) (insert ?D) (forward-line 1) (setq arg (1- arg))) (while (< arg 0) (delete-char 1) (insert ?D) (forward-line -1) (setq arg (1+ arg)))))) (defun Buffer-menu-delete-backwards (&optional arg) "Mark buffer on this line to be deleted by \\\\[Buffer-menu-execute] command and then move up one line. Prefix arg means move that many lines." (interactive "p") (Buffer-menu-delete (- (or arg 1))) (while (looking-at " [-M]") (forward-line 1))) (defun Buffer-menu-save () "Mark buffer on this line to be saved by \\\\[Buffer-menu-execute] command." (interactive) (beginning-of-line) (if (looking-at " [-M]") ;header lines (ding) (let ((buffer-read-only nil)) (forward-char 1) (delete-char 1) (insert ?S) (forward-line 1)))) (defun Buffer-menu-not-modified (&optional arg) "Mark buffer on this line as unmodified (no changes to save)." (interactive "P") (save-excursion (set-buffer (Buffer-menu-buffer t)) (set-buffer-modified-p arg)) (save-excursion (beginning-of-line) (forward-char 1) (if (= (char-after (point)) (if arg ? ?*)) (let ((buffer-read-only nil)) (delete-char 1) (insert (if arg ?* ? )))))) (defun Buffer-menu-execute () "Save and/or delete buffers marked with \\\\[Buffer-menu-save] or \\\\[Buffer-menu-delete] commands." (interactive) (save-excursion (goto-char (point-min)) (forward-line 1) (while (re-search-forward "^.S" nil t) (let ((modp nil)) (save-excursion (set-buffer (Buffer-menu-buffer t)) (save-buffer) (setq modp (buffer-modified-p))) (let ((buffer-read-only nil)) (delete-char -1) (insert (if modp ?* ? )))))) (save-excursion (goto-char (point-min)) (forward-line 1) (let ((buff-menu-buffer (current-buffer)) (buffer-read-only nil)) (while (search-forward "\nD" nil t) (forward-char -1) (let ((buf (Buffer-menu-buffer nil))) (or (eq buf nil) (eq buf buff-menu-buffer) (save-excursion (kill-buffer buf)))) (if (Buffer-menu-buffer nil) (progn (delete-char 1) (insert ? )) (delete-region (point) (progn (forward-line 1) (point))) (forward-char -1)))))) (defun Buffer-menu-select () "Select this line's buffer; also display buffers marked with `>'. You can mark buffers with the \\\\[Buffer-menu-mark] command. This command deletes and replaces all the previously existing windows in the selected frame." (interactive) (let ((buff (Buffer-menu-buffer t)) (menu (current-buffer)) (others ()) tem) (goto-char (point-min)) (while (search-forward "\n>" nil t) (setq tem (Buffer-menu-buffer t)) (let ((buffer-read-only nil)) (delete-char -1) (insert ?\ )) (or (eq tem buff) (memq tem others) (setq others (cons tem others)))) (setq others (nreverse others) tem (/ (1- (frame-height)) (1+ (length others)))) (delete-other-windows) (switch-to-buffer buff) (or (eq menu buff) (bury-buffer menu)) (if (equal (length others) 0) (progn ;;; ;; Restore previous window configuration before displaying ;;; ;; selected buffers. ;;; (if Buffer-menu-window-config ;;; (progn ;;; (set-window-configuration Buffer-menu-window-config) ;;; (setq Buffer-menu-window-config nil))) (switch-to-buffer buff)) (while others (split-window nil tem) (other-window 1) (switch-to-buffer (car others)) (setq others (cdr others))) (other-window 1) ;back to the beginning! ))) (defun Buffer-menu-visit-tags-table () "Visit the tags table in the buffer on this line. See `visit-tags-table'." (interactive) (let ((file (buffer-file-name (Buffer-menu-buffer t)))) (if file (visit-tags-table file) (error "Specified buffer has no file")))) (defun Buffer-menu-1-window () "Select this line's buffer, alone, in full frame." (interactive) (switch-to-buffer (Buffer-menu-buffer t)) (bury-buffer (other-buffer)) (delete-other-windows)) (defun Buffer-menu-mouse-select (event) "Select the buffer whose line you click on." (interactive "e") (let (buffer) (save-excursion (set-buffer (window-buffer (posn-window (event-end event)))) (save-excursion (goto-char (posn-point (event-end event))) (setq buffer (Buffer-menu-buffer t)))) (select-window (posn-window (event-end event))) (if (and (window-dedicated-p (selected-window)) (eq (selected-window) (frame-root-window))) (switch-to-buffer-other-frame buffer) (switch-to-buffer buffer)))) (defun Buffer-menu-this-window () "Select this line's buffer in this window." (interactive) (switch-to-buffer (Buffer-menu-buffer t))) (defun Buffer-menu-other-window () "Select this line's buffer in other window, leaving buffer menu visible." (interactive) (switch-to-buffer-other-window (Buffer-menu-buffer t))) (defun Buffer-menu-switch-other-window () "Make the other window select this line's buffer. The current window remains selected." (interactive) (display-buffer (Buffer-menu-buffer t))) (defun Buffer-menu-2-window () "Select this line's buffer, with previous buffer in second window." (interactive) (let ((buff (Buffer-menu-buffer t)) (menu (current-buffer)) (pop-up-windows t)) (delete-other-windows) (switch-to-buffer (other-buffer)) (pop-to-buffer buff) (bury-buffer menu))) (defun Buffer-menu-toggle-read-only () "Toggle read-only status of buffer on this line, perhaps via version control." (interactive) (let (char) (save-excursion (set-buffer (Buffer-menu-buffer t)) (vc-toggle-read-only) (setq char (if buffer-read-only ?% ? ))) (save-excursion (beginning-of-line) (forward-char 2) (if (/= (following-char) char) (let (buffer-read-only) (delete-char 1) (insert char)))))) (define-key ctl-x-map "\C-b" 'list-buffers) (defun list-buffers (&optional files-only) "Display a list of names of existing buffers. The list is displayed in a buffer named `*Buffer List*'. Note that buffers with names starting with spaces are omitted. Non-null optional arg FILES-ONLY means mention only file buffers. The M column contains a * for buffers that are modified. The R column contains a % for buffers that are read-only." (interactive "P") (display-buffer (list-buffers-noselect files-only))) (defun list-buffers-noselect (&optional files-only) "Create and return a buffer with a list of names of existing buffers. The buffer is named `*Buffer List*'. Note that buffers with names starting with spaces are omitted. Non-null optional arg FILES-ONLY means mention only file buffers. The M column contains a * for buffers that are modified. The R column contains a % for buffers that are read-only." (let ((old-buffer (current-buffer)) (standard-output standard-output) desired-point) (save-excursion (set-buffer (get-buffer-create "*Buffer List*")) (setq buffer-read-only nil) (erase-buffer) (setq standard-output (current-buffer)) (princ "\ MR Buffer Size Mode File -- ------ ---- ---- ---- ") ;; Record the column where buffer names start. (setq Buffer-menu-buffer-column 4) (let ((bl (buffer-list))) (while bl (let* ((buffer (car bl)) (name (buffer-name buffer)) (file (buffer-file-name buffer)) this-buffer-line-start this-buffer-read-only this-buffer-size this-buffer-mode-name this-buffer-directory) (save-excursion (set-buffer buffer) (setq this-buffer-read-only buffer-read-only) (setq this-buffer-size (buffer-size)) (setq this-buffer-mode-name (if (eq buffer standard-output) "Buffer Menu" mode-name)) (or file ;; No visited file. Check local value of ;; list-buffers-directory. (if (and (boundp 'list-buffers-directory) list-buffers-directory) (setq this-buffer-directory list-buffers-directory)))) (cond ;; Don't mention internal buffers. ((string= (substring name 0 1) " ")) ;; Maybe don't mention buffers without files. ((and files-only (not file))) ;; Otherwise output info. (t (setq this-buffer-line-start (point)) ;; Identify current buffer. (if (eq buffer old-buffer) (progn (setq desired-point (point)) (princ ".")) (princ " ")) ;; Identify modified buffers. (princ (if (buffer-modified-p buffer) "*" " ")) ;; Handle readonly status. The output buffer is special ;; cased to appear readonly; it is actually made so at a later ;; date. (princ (if (or (eq buffer standard-output) this-buffer-read-only) "% " " ")) (princ name) ;; Put the buffer name into a text property ;; so we don't have to extract it from the text. ;; This way we avoid problems with unusual buffer names. (setq this-buffer-line-start (+ this-buffer-line-start Buffer-menu-buffer-column)) (let ((name-end (point))) (indent-to 17 2) (put-text-property this-buffer-line-start name-end 'buffer-name name) (put-text-property this-buffer-line-start name-end 'mouse-face 'highlight)) (let (size mode (excess (- (current-column) 17))) (setq size (format "%8d" this-buffer-size)) ;; Ack -- if looking at the *Buffer List* buffer, ;; always use "Buffer Menu" mode. Otherwise the ;; first time the buffer is created, the mode will be wrong. (setq mode this-buffer-mode-name) (while (and (> excess 0) (= (aref size 0) ?\ )) (setq size (substring size 1)) (setq excess (1- excess))) (princ size) (indent-to 27 1) (princ mode)) (indent-to 40 1) (or file (setq file this-buffer-directory)) (if file (princ file)) (princ "\n")))) (setq bl (cdr bl)))) (Buffer-menu-mode) ;; DESIRED-POINT doesn't have to be set; it is not when the ;; current buffer is not displayed for some reason. (and desired-point (goto-char desired-point)) (current-buffer)))) ;;; buff-menu.el ends here emacs-19.30/lisp/byte-opt.el100444 22556 1 206663 6030360247 14360 0ustar erikdaemon;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler. ;;; Copyright (c) 1991, 1994 Free Software Foundation, Inc. ;; Author: Jamie Zawinski ;; Hallvard Furuseth ;; Keywords: internal ;; 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: ;;; ======================================================================== ;;; "No matter how hard you try, you can't make a racehorse out of a pig. ;;; You can, however, make a faster pig." ;;; ;;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code ;;; makes it be a VW Bug with fuel injection and a turbocharger... You're ;;; still not going to make it go faster than 70 mph, but it might be easier ;;; to get it there. ;;; ;;; TO DO: ;;; ;;; (apply '(lambda (x &rest y) ...) 1 (foo)) ;;; ;;; maintain a list of functions known not to access any global variables ;;; (actually, give them a 'dynamically-safe property) and then ;;; (let ( v1 v2 ... vM vN ) <...dynamically-safe...> ) ==> ;;; (let ( v1 v2 ... vM ) vN <...dynamically-safe...> ) ;;; by recursing on this, we might be able to eliminate the entire let. ;;; However certain variables should never have their bindings optimized ;;; away, because they affect everything. ;;; (put 'debug-on-error 'binding-is-magic t) ;;; (put 'debug-on-abort 'binding-is-magic t) ;;; (put 'debug-on-next-call 'binding-is-magic t) ;;; (put 'mocklisp-arguments 'binding-is-magic t) ;;; (put 'inhibit-quit 'binding-is-magic t) ;;; (put 'quit-flag 'binding-is-magic t) ;;; (put 't 'binding-is-magic t) ;;; (put 'nil 'binding-is-magic t) ;;; possibly also ;;; (put 'gc-cons-threshold 'binding-is-magic t) ;;; (put 'track-mouse 'binding-is-magic t) ;;; others? ;;; ;;; Simple defsubsts often produce forms like ;;; (let ((v1 (f1)) (v2 (f2)) ...) ;;; (FN v1 v2 ...)) ;;; It would be nice if we could optimize this to ;;; (FN (f1) (f2) ...) ;;; but we can't unless FN is dynamically-safe (it might be dynamically ;;; referring to the bindings that the lambda arglist established.) ;;; One of the uncountable lossages introduced by dynamic scope... ;;; ;;; Maybe there should be a control-structure that says "turn on ;;; fast-and-loose type-assumptive optimizations here." Then when ;;; we see a form like (car foo) we can from then on assume that ;;; the variable foo is of type cons, and optimize based on that. ;;; But, this won't win much because of (you guessed it) dynamic ;;; scope. Anything down the stack could change the value. ;;; (Another reason it doesn't work is that it is perfectly valid ;;; to call car with a null argument.) A better approach might ;;; be to allow type-specification of the form ;;; (put 'foo 'arg-types '(float (list integer) dynamic)) ;;; (put 'foo 'result-type 'bool) ;;; It should be possible to have these types checked to a certain ;;; degree. ;;; ;;; collapse common subexpressions ;;; ;;; It would be nice if redundant sequences could be factored out as well, ;;; when they are known to have no side-effects: ;;; (list (+ a b c) (+ a b c)) --> a b add c add dup list-2 ;;; but beware of traps like ;;; (cons (list x y) (list x y)) ;;; ;;; Tail-recursion elimination is not really possible in Emacs Lisp. ;;; Tail-recursion elimination is almost always impossible when all variables ;;; have dynamic scope, but given that the "return" byteop requires the ;;; binding stack to be empty (rather than emptying it itself), there can be ;;; no truly tail-recursive Emacs Lisp functions that take any arguments or ;;; make any bindings. ;;; ;;; Here is an example of an Emacs Lisp function which could safely be ;;; byte-compiled tail-recursively: ;;; ;;; (defun tail-map (fn list) ;;; (cond (list ;;; (funcall fn (car list)) ;;; (tail-map fn (cdr list))))) ;;; ;;; However, if there was even a single let-binding around the COND, ;;; it could not be byte-compiled, because there would be an "unbind" ;;; byte-op between the final "call" and "return." Adding a ;;; Bunbind_all byteop would fix this. ;;; ;;; (defun foo (x y z) ... (foo a b c)) ;;; ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return) ;;; ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return) ;;; ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return) ;;; ;;; this also can be considered tail recursion: ;;; ;;; ... (const foo) (varref a) (call 1) (goto X) ... X: (return) ;;; could generalize this by doing the optimization ;;; (goto X) ... X: (return) --> (return) ;;; ;;; But this doesn't solve all of the problems: although by doing tail- ;;; recursion elimination in this way, the call-stack does not grow, the ;;; binding-stack would grow with each recursive step, and would eventually ;;; overflow. I don't believe there is any way around this without lexical ;;; scope. ;;; ;;; Wouldn't it be nice if Emacs Lisp had lexical scope. ;;; ;;; Idea: the form (lexical-scope) in a file means that the file may be ;;; compiled lexically. This proclamation is file-local. Then, within ;;; that file, "let" would establish lexical bindings, and "let-dynamic" ;;; would do things the old way. (Or we could use CL "declare" forms.) ;;; We'd have to notice defvars and defconsts, since those variables should ;;; always be dynamic, and attempting to do a lexical binding of them ;;; should simply do a dynamic binding instead. ;;; But! We need to know about variables that were not necessarily defvarred ;;; in the file being compiled (doing a boundp check isn't good enough.) ;;; Fdefvar() would have to be modified to add something to the plist. ;;; ;;; A major disadvantage of this scheme is that the interpreter and compiler ;;; would have different semantics for files compiled with (dynamic-scope). ;;; Since this would be a file-local optimization, there would be no way to ;;; modify the interpreter to obey this (unless the loader was hacked ;;; in some grody way, but that's a really bad idea.) ;; Other things to consider: ;;;;; Associative math should recognize subcalls to identical function: ;;;(disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2)))) ;;;;; This should generate the same as (1+ x) and (1- x) ;;;(disassemble (lambda (x) (cons (+ x 1) (- x 1)))) ;;;;; An awful lot of functions always return a non-nil value. If they're ;;;;; error free also they may act as true-constants. ;;;(disassemble (lambda (x) (and (point) (foo)))) ;;;;; When ;;;;; - all but one arguments to a function are constant ;;;;; - the non-constant argument is an if-expression (cond-expression?) ;;;;; then the outer function can be distributed. If the guarding ;;;;; condition is side-effect-free [assignment-free] then the other ;;;;; arguments may be any expressions. Since, however, the code size ;;;;; can increase this way they should be "simple". Compare: ;;;(disassemble (lambda (x) (eq (if (point) 'a 'b) 'c))) ;;;(disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c)))) ;;;;; (car (cons A B)) -> (progn B A) ;;;(disassemble (lambda (x) (car (cons (foo) 42)))) ;;;;; (cdr (cons A B)) -> (progn A B) ;;;(disassemble (lambda (x) (cdr (cons 42 (foo))))) ;;;;; (car (list A B ...)) -> (progn B ... A) ;;;(disassemble (lambda (x) (car (list (foo) 42 (bar))))) ;;;;; (cdr (list A B ...)) -> (progn A (list B ...)) ;;;(disassemble (lambda (x) (cdr (list 42 (foo) (bar))))) ;;; Code: (defun byte-compile-log-lap-1 (format &rest args) (if (aref byte-code-vector 0) (error "The old version of the disassembler is loaded. Reload new-bytecomp as well.")) (byte-compile-log-1 (apply 'format format (let (c a) (mapcar '(lambda (arg) (if (not (consp arg)) (if (and (symbolp arg) (string-match "^byte-" (symbol-name arg))) (intern (substring (symbol-name arg) 5)) arg) (if (integerp (setq c (car arg))) (error "non-symbolic byte-op %s" c)) (if (eq c 'TAG) (setq c arg) (setq a (cond ((memq c byte-goto-ops) (car (cdr (cdr arg)))) ((memq c byte-constref-ops) (car (cdr arg))) (t (cdr arg)))) (setq c (symbol-name c)) (if (string-match "^byte-." c) (setq c (intern (substring c 5))))) (if (eq c 'constant) (setq c 'const)) (if (and (eq (cdr arg) 0) (not (memq c '(unbind call const)))) c (format "(%s %s)" c a)))) args))))) (defmacro byte-compile-log-lap (format-string &rest args) (list 'and '(memq byte-optimize-log '(t byte)) (cons 'byte-compile-log-lap-1 (cons format-string args)))) ;;; byte-compile optimizers to support inlining (put 'inline 'byte-optimizer 'byte-optimize-inline-handler) (defun byte-optimize-inline-handler (form) "byte-optimize-handler for the `inline' special-form." (cons 'progn (mapcar '(lambda (sexp) (let ((fn (car-safe sexp))) (if (and (symbolp fn) (or (cdr (assq fn byte-compile-function-environment)) (and (fboundp fn) (not (or (cdr (assq fn byte-compile-macro-environment)) (and (consp (setq fn (symbol-function fn))) (eq (car fn) 'macro)) (subrp fn)))))) (byte-compile-inline-expand sexp) sexp))) (cdr form)))) ;; Splice the given lap code into the current instruction stream. ;; If it has any labels in it, you're responsible for making sure there ;; are no collisions, and that byte-compile-tag-number is reasonable ;; after this is spliced in. The provided list is destroyed. (defun byte-inline-lapcode (lap) (setq byte-compile-output (nconc (nreverse lap) byte-compile-output))) (defun byte-compile-inline-expand (form) (let* ((name (car form)) (fn (or (cdr (assq name byte-compile-function-environment)) (and (fboundp name) (symbol-function name))))) (if (null fn) (progn (byte-compile-warn "attempt to inline %s before it was defined" name) form) ;; else (if (and (consp fn) (eq (car fn) 'autoload)) (load (nth 1 fn))) (if (and (consp fn) (eq (car fn) 'autoload)) (error "file \"%s\" didn't define \"%s\"" (nth 1 fn) name)) (if (symbolp fn) (byte-compile-inline-expand (cons fn (cdr form))) (if (byte-code-function-p fn) (progn (fetch-bytecode fn) (cons (list 'lambda (aref fn 0) (list 'byte-code (aref fn 1) (aref fn 2) (aref fn 3))) (cdr form))) (if (not (eq (car fn) 'lambda)) (error "%s is not a lambda" name)) (cons fn (cdr form))))))) ;;; ((lambda ...) ...) ;;; (defun byte-compile-unfold-lambda (form &optional name) (or name (setq name "anonymous lambda")) (let ((lambda (car form)) (values (cdr form))) (if (byte-code-function-p lambda) (setq lambda (list 'lambda (aref lambda 0) (list 'byte-code (aref lambda 1) (aref lambda 2) (aref lambda 3))))) (let ((arglist (nth 1 lambda)) (body (cdr (cdr lambda))) optionalp restp bindings) (if (and (stringp (car body)) (cdr body)) (setq body (cdr body))) (if (and (consp (car body)) (eq 'interactive (car (car body)))) (setq body (cdr body))) (while arglist (cond ((eq (car arglist) '&optional) ;; ok, I'll let this slide because funcall_lambda() does... ;; (if optionalp (error "multiple &optional keywords in %s" name)) (if restp (error "&optional found after &rest in %s" name)) (if (null (cdr arglist)) (error "nothing after &optional in %s" name)) (setq optionalp t)) ((eq (car arglist) '&rest) ;; ...but it is by no stretch of the imagination a reasonable ;; thing that funcall_lambda() allows (&rest x y) and ;; (&rest x &optional y) in arglists. (if (null (cdr arglist)) (error "nothing after &rest in %s" name)) (if (cdr (cdr arglist)) (error "multiple vars after &rest in %s" name)) (setq restp t)) (restp (setq bindings (cons (list (car arglist) (and values (cons 'list values))) bindings) values nil)) ((and (not optionalp) (null values)) (byte-compile-warn "attempt to open-code %s with too few arguments" name) (setq arglist nil values 'too-few)) (t (setq bindings (cons (list (car arglist) (car values)) bindings) values (cdr values)))) (setq arglist (cdr arglist))) (if values (progn (or (eq values 'too-few) (byte-compile-warn "attempt to open-code %s with too many arguments" name)) form) (let ((newform (if bindings (cons 'let (cons (nreverse bindings) body)) (cons 'progn body)))) (byte-compile-log " %s\t==>\t%s" form newform) newform))))) ;;; implementing source-level optimizers (defun byte-optimize-form-code-walker (form for-effect) ;; ;; For normal function calls, We can just mapcar the optimizer the cdr. But ;; we need to have special knowledge of the syntax of the special forms ;; like let and defun (that's why they're special forms :-). (Actually, ;; the important aspect is that they are subrs that don't evaluate all of ;; their args.) ;; (let ((fn (car-safe form)) tmp) (cond ((not (consp form)) (if (not (and for-effect (or byte-compile-delete-errors (not (symbolp form)) (eq form t)))) form)) ((eq fn 'quote) (if (cdr (cdr form)) (byte-compile-warn "malformed quote form: %s" (prin1-to-string form))) ;; map (quote nil) to nil to simplify optimizer logic. ;; map quoted constants to nil if for-effect (just because). (and (nth 1 form) (not for-effect) form)) ((or (byte-code-function-p fn) (eq 'lambda (car-safe fn))) (byte-compile-unfold-lambda form)) ((memq fn '(let let*)) ;; recursively enter the optimizer for the bindings and body ;; of a let or let*. This for depth-firstness: forms that ;; are more deeply nested are optimized first. (cons fn (cons (mapcar '(lambda (binding) (if (symbolp binding) binding (if (cdr (cdr binding)) (byte-compile-warn "malformed let binding: %s" (prin1-to-string binding))) (list (car binding) (byte-optimize-form (nth 1 binding) nil)))) (nth 1 form)) (byte-optimize-body (cdr (cdr form)) for-effect)))) ((eq fn 'cond) (cons fn (mapcar '(lambda (clause) (if (consp clause) (cons (byte-optimize-form (car clause) nil) (byte-optimize-body (cdr clause) for-effect)) (byte-compile-warn "malformed cond form: %s" (prin1-to-string clause)) clause)) (cdr form)))) ((eq fn 'progn) ;; as an extra added bonus, this simplifies (progn ) --> (if (cdr (cdr form)) (progn (setq tmp (byte-optimize-body (cdr form) for-effect)) (if (cdr tmp) (cons 'progn tmp) (car tmp))) (byte-optimize-form (nth 1 form) for-effect))) ((eq fn 'prog1) (if (cdr (cdr form)) (cons 'prog1 (cons (byte-optimize-form (nth 1 form) for-effect) (byte-optimize-body (cdr (cdr form)) t))) (byte-optimize-form (nth 1 form) for-effect))) ((eq fn 'prog2) (cons 'prog2 (cons (byte-optimize-form (nth 1 form) t) (cons (byte-optimize-form (nth 2 form) for-effect) (byte-optimize-body (cdr (cdr (cdr form))) t))))) ((memq fn '(save-excursion save-restriction)) ;; those subrs which have an implicit progn; it's not quite good ;; enough to treat these like normal function calls. ;; This can turn (save-excursion ...) into (save-excursion) which ;; will be optimized away in the lap-optimize pass. (cons fn (byte-optimize-body (cdr form) for-effect))) ((eq fn 'with-output-to-temp-buffer) ;; this is just like the above, except for the first argument. (cons fn (cons (byte-optimize-form (nth 1 form) nil) (byte-optimize-body (cdr (cdr form)) for-effect)))) ((eq fn 'if) (cons fn (cons (byte-optimize-form (nth 1 form) nil) (cons (byte-optimize-form (nth 2 form) for-effect) (byte-optimize-body (nthcdr 3 form) for-effect))))) ((memq fn '(and or)) ; remember, and/or are control structures. ;; take forms off the back until we can't any more. ;; In the future it could conceivably be a problem that the ;; subexpressions of these forms are optimized in the reverse ;; order, but it's ok for now. (if for-effect (let ((backwards (reverse (cdr form)))) (while (and backwards (null (setcar backwards (byte-optimize-form (car backwards) for-effect)))) (setq backwards (cdr backwards))) (if (and (cdr form) (null backwards)) (byte-compile-log " all subforms of %s called for effect; deleted" form)) (and backwards (cons fn (nreverse backwards)))) (cons fn (mapcar 'byte-optimize-form (cdr form))))) ((eq fn 'interactive) (byte-compile-warn "misplaced interactive spec: %s" (prin1-to-string form)) nil) ((memq fn '(defun defmacro function condition-case save-window-excursion)) ;; These forms are compiled as constants or by breaking out ;; all the subexpressions and compiling them separately. form) ((eq fn 'unwind-protect) ;; the "protected" part of an unwind-protect is compiled (and thus ;; optimized) as a top-level form, so don't do it here. But the ;; non-protected part has the same for-effect status as the ;; unwind-protect itself. (The protected part is always for effect, ;; but that isn't handled properly yet.) (cons fn (cons (byte-optimize-form (nth 1 form) for-effect) (cdr (cdr form))))) ((eq fn 'catch) ;; the body of a catch is compiled (and thus optimized) as a ;; top-level form, so don't do it here. The tag is never ;; for-effect. The body should have the same for-effect status ;; as the catch form itself, but that isn't handled properly yet. (cons fn (cons (byte-optimize-form (nth 1 form) nil) (cdr (cdr form))))) ;; If optimization is on, this is the only place that macros are ;; expanded. If optimization is off, then macroexpansion happens ;; in byte-compile-form. Otherwise, the macros are already expanded ;; by the time that is reached. ((not (eq form (setq form (macroexpand form byte-compile-macro-environment)))) (byte-optimize-form form for-effect)) ((not (symbolp fn)) (or (eq 'mocklisp (car-safe fn)) ; ha! (byte-compile-warn "%s is a malformed function" (prin1-to-string fn))) form) ((and for-effect (setq tmp (get fn 'side-effect-free)) (or byte-compile-delete-errors (eq tmp 'error-free) (progn (byte-compile-warn "%s called for effect" (prin1-to-string form)) nil))) (byte-compile-log " %s called for effect; deleted" fn) ;; appending a nil here might not be necessary, but it can't hurt. (byte-optimize-form (cons 'progn (append (cdr form) '(nil))) t)) (t ;; Otherwise, no args can be considered to be for-effect, ;; even if the called function is for-effect, because we ;; don't know anything about that function. (cons fn (mapcar 'byte-optimize-form (cdr form))))))) (defun byte-optimize-form (form &optional for-effect) "The source-level pass of the optimizer." ;; ;; First, optimize all sub-forms of this one. (setq form (byte-optimize-form-code-walker form for-effect)) ;; ;; after optimizing all subforms, optimize this form until it doesn't ;; optimize any further. This means that some forms will be passed through ;; the optimizer many times, but that's necessary to make the for-effect ;; processing do as much as possible. ;; (let (opt new) (if (and (consp form) (symbolp (car form)) (or (and for-effect ;; we don't have any of these yet, but we might. (setq opt (get (car form) 'byte-for-effect-optimizer))) (setq opt (get (car form) 'byte-optimizer))) (not (eq form (setq new (funcall opt form))))) (progn ;; (if (equal form new) (error "bogus optimizer -- %s" opt)) (byte-compile-log " %s\t==>\t%s" form new) (setq new (byte-optimize-form new for-effect)) new) form))) (defun byte-optimize-body (forms all-for-effect) ;; optimize the cdr of a progn or implicit progn; all forms is a list of ;; forms, all but the last of which are optimized with the assumption that ;; they are being called for effect. the last is for-effect as well if ;; all-for-effect is true. returns a new list of forms. (let ((rest forms) (result nil) fe new) (while rest (setq fe (or all-for-effect (cdr rest))) (setq new (and (car rest) (byte-optimize-form (car rest) fe))) (if (or new (not fe)) (setq result (cons new result))) (setq rest (cdr rest))) (nreverse result))) ;;; some source-level optimizers ;;; ;;; when writing optimizers, be VERY careful that the optimizer returns ;;; something not EQ to its argument if and ONLY if it has made a change. ;;; This implies that you cannot simply destructively modify the list; ;;; you must return something not EQ to it if you make an optimization. ;;; ;;; It is now safe to optimize code such that it introduces new bindings. ;; I'd like this to be a defsubst, but let's not be self-referential... (defmacro byte-compile-trueconstp (form) ;; Returns non-nil if FORM is a non-nil constant. (` (cond ((consp (, form)) (eq (car (, form)) 'quote)) ((not (symbolp (, form)))) ((eq (, form) t))))) ;; If the function is being called with constant numeric args, ;; evaluate as much as possible at compile-time. This optimizer ;; assumes that the function is associative, like + or *. (defun byte-optimize-associative-math (form) (let ((args nil) (constants nil) (rest (cdr form))) (while rest (if (numberp (car rest)) (setq constants (cons (car rest) constants)) (setq args (cons (car rest) args))) (setq rest (cdr rest))) (if (cdr constants) (if args (list (car form) (apply (car form) constants) (if (cdr args) (cons (car form) (nreverse args)) (car args))) (apply (car form) constants)) form))) ;; If the function is being called with constant numeric args, ;; evaluate as much as possible at compile-time. This optimizer ;; assumes that the function satisfies ;; (op x1 x2 ... xn) == (op ...(op (op x1 x2) x3) ...xn) ;; like - and /. (defun byte-optimize-nonassociative-math (form) (if (or (not (numberp (car (cdr form)))) (not (numberp (car (cdr (cdr form)))))) form (let ((constant (car (cdr form))) (rest (cdr (cdr form)))) (while (numberp (car rest)) (setq constant (funcall (car form) constant (car rest)) rest (cdr rest))) (if rest (cons (car form) (cons constant rest)) constant)))) ;;(defun byte-optimize-associative-two-args-math (form) ;; (setq form (byte-optimize-associative-math form)) ;; (if (consp form) ;; (byte-optimize-two-args-left form) ;; form)) ;;(defun byte-optimize-nonassociative-two-args-math (form) ;; (setq form (byte-optimize-nonassociative-math form)) ;; (if (consp form) ;; (byte-optimize-two-args-right form) ;; form)) (defun byte-optimize-approx-equal (x y) (< (* (abs (- x y)) 100) (abs (+ x y)))) ;; Collect all the constants from FORM, after the STARTth arg, ;; and apply FUN to them to make one argument at the end. ;; For functions that can handle floats, that optimization ;; can be incorrect because reordering can cause an overflow ;; that would otherwise be avoided by encountering an arg that is a float. ;; We avoid this problem by (1) not moving float constants and ;; (2) not moving anything if it would cause an overflow. (defun byte-optimize-delay-constants-math (form start fun) ;; Merge all FORM's constants from number START, call FUN on them ;; and put the result at the end. (let ((rest (nthcdr (1- start) form)) (orig form) ;; t means we must check for overflow. (overflow (memq fun '(+ *)))) (while (cdr (setq rest (cdr rest))) (if (integerp (car rest)) (let (constants) (setq form (copy-sequence form) rest (nthcdr (1- start) form)) (while (setq rest (cdr rest)) (cond ((integerp (car rest)) (setq constants (cons (car rest) constants)) (setcar rest nil)))) ;; If necessary, check now for overflow ;; that might be caused by reordering. (if (and overflow ;; We have overflow if the result of doing the arithmetic ;; on floats is not even close to the result ;; of doing it on integers. (not (byte-optimize-approx-equal (apply fun (mapcar 'float constants)) (float (apply fun constants))))) (setq form orig) (setq form (nconc (delq nil form) (list (apply fun (nreverse constants))))))))) form)) (defun byte-optimize-plus (form) (setq form (byte-optimize-delay-constants-math form 1 '+)) (if (memq 0 form) (setq form (delq 0 (copy-sequence form)))) ;;(setq form (byte-optimize-associative-two-args-math form)) (cond ((null (cdr form)) (condition-case () (eval form) (error form))) ;;; It is not safe to delete the function entirely ;;; (actually, it would be safe if we know the sole arg ;;; is not a marker). ;; ((null (cdr (cdr form))) (nth 1 form)) (t form))) (defun byte-optimize-minus (form) ;; Put constants at the end, except the last constant. (setq form (byte-optimize-delay-constants-math form 2 '+)) ;; Now only first and last element can be a number. (let ((last (car (reverse (nthcdr 3 form))))) (cond ((eq 0 last) ;; (- x y ... 0) --> (- x y ...) (setq form (copy-sequence form)) (setcdr (cdr (cdr form)) (delq 0 (nthcdr 3 form)))) ;; If form is (- CONST foo... CONST), merge first and last. ((and (numberp (nth 1 form)) (numberp last)) (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form)) (delq last (copy-sequence (nthcdr 3 form)))))))) ;;; It is not safe to delete the function entirely ;;; (actually, it would be safe if we know the sole arg ;;; is not a marker). ;;; (if (eq (nth 2 form) 0) ;;; (nth 1 form) ; (- x 0) --> x (byte-optimize-predicate (if (and (null (cdr (cdr (cdr form)))) (eq (nth 1 form) 0)) ; (- 0 x) --> (- x) (cons (car form) (cdr (cdr form))) form)) ;;; ) ) (defun byte-optimize-multiply (form) (setq form (byte-optimize-delay-constants-math form 1 '*)) ;; If there is a constant in FORM, it is now the last element. (cond ((null (cdr form)) 1) ;;; It is not safe to delete the function entirely ;;; (actually, it would be safe if we know the sole arg ;;; is not a marker or if it appears in other arithmetic). ;;; ((null (cdr (cdr form))) (nth 1 form)) ((let ((last (car (reverse form)))) (cond ((eq 0 last) (cons 'progn (cdr form))) ((eq 1 last) (delq 1 (copy-sequence form))) ((eq -1 last) (list '- (delq -1 (copy-sequence form)))) ((and (eq 2 last) (memq t (mapcar 'symbolp (cdr form)))) (prog1 (setq form (delq 2 (copy-sequence form))) (while (not (symbolp (car (setq form (cdr form)))))) (setcar form (list '+ (car form) (car form))))) (form)))))) (defsubst byte-compile-butlast (form) (nreverse (cdr (reverse form)))) (defun byte-optimize-divide (form) (setq form (byte-optimize-delay-constants-math form 2 '*)) (let ((last (car (reverse (cdr (cdr form)))))) (if (numberp last) (cond ((= (length form) 3) (if (and (numberp (nth 1 form)) (not (zerop last)) (condition-case nil (/ (nth 1 form) last) (error nil))) (setq form (list 'progn (/ (nth 1 form) last))))) ((= last 1) (setq form (byte-compile-butlast form))) ((numberp (nth 1 form)) (setq form (cons (car form) (cons (/ (nth 1 form) last) (byte-compile-butlast (cdr (cdr form))))) last nil)))) (cond ;;; ((null (cdr (cdr form))) ;;; (nth 1 form)) ((eq (nth 1 form) 0) (append '(progn) (cdr (cdr form)) '(0))) ((eq last -1) (list '- (if (nthcdr 3 form) (byte-compile-butlast form) (nth 1 form)))) (form)))) (defun byte-optimize-logmumble (form) (setq form (byte-optimize-delay-constants-math form 1 (car form))) (byte-optimize-predicate (cond ((memq 0 form) (setq form (if (eq (car form) 'logand) (cons 'progn (cdr form)) (delq 0 (copy-sequence form))))) ((and (eq (car-safe form) 'logior) (memq -1 form)) (cons 'progn (cdr form))) (form)))) (defun byte-optimize-binary-predicate (form) (if (byte-compile-constp (nth 1 form)) (if (byte-compile-constp (nth 2 form)) (condition-case () (list 'quote (eval form)) (error form)) ;; This can enable some lapcode optimizations. (list (car form) (nth 2 form) (nth 1 form))) form)) (defun byte-optimize-predicate (form) (let ((ok t) (rest (cdr form))) (while (and rest ok) (setq ok (byte-compile-constp (car rest)) rest (cdr rest))) (if ok (condition-case () (list 'quote (eval form)) (error form)) form))) (defun byte-optimize-identity (form) (if (and (cdr form) (null (cdr (cdr form)))) (nth 1 form) (byte-compile-warn "identity called with %d arg%s, but requires 1" (length (cdr form)) (if (= 1 (length (cdr form))) "" "s")) form)) (put 'identity 'byte-optimizer 'byte-optimize-identity) (put '+ 'byte-optimizer 'byte-optimize-plus) (put '* 'byte-optimizer 'byte-optimize-multiply) (put '- 'byte-optimizer 'byte-optimize-minus) (put '/ 'byte-optimizer 'byte-optimize-divide) (put 'max 'byte-optimizer 'byte-optimize-associative-math) (put 'min 'byte-optimizer 'byte-optimize-associative-math) (put '= 'byte-optimizer 'byte-optimize-binary-predicate) (put 'eq 'byte-optimizer 'byte-optimize-binary-predicate) (put 'eql 'byte-optimizer 'byte-optimize-binary-predicate) (put 'equal 'byte-optimizer 'byte-optimize-binary-predicate) (put 'string= 'byte-optimizer 'byte-optimize-binary-predicate) (put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate) (put '< 'byte-optimizer 'byte-optimize-predicate) (put '> 'byte-optimizer 'byte-optimize-predicate) (put '<= 'byte-optimizer 'byte-optimize-predicate) (put '>= 'byte-optimizer 'byte-optimize-predicate) (put '1+ 'byte-optimizer 'byte-optimize-predicate) (put '1- 'byte-optimizer 'byte-optimize-predicate) (put 'not 'byte-optimizer 'byte-optimize-predicate) (put 'null 'byte-optimizer 'byte-optimize-predicate) (put 'memq 'byte-optimizer 'byte-optimize-predicate) (put 'consp 'byte-optimizer 'byte-optimize-predicate) (put 'listp 'byte-optimizer 'byte-optimize-predicate) (put 'symbolp 'byte-optimizer 'byte-optimize-predicate) (put 'stringp 'byte-optimizer 'byte-optimize-predicate) (put 'string< 'byte-optimizer 'byte-optimize-predicate) (put 'string-lessp 'byte-optimizer 'byte-optimize-predicate) (put 'logand 'byte-optimizer 'byte-optimize-logmumble) (put 'logior 'byte-optimizer 'byte-optimize-logmumble) (put 'logxor 'byte-optimizer 'byte-optimize-logmumble) (put 'lognot 'byte-optimizer 'byte-optimize-predicate) (put 'car 'byte-optimizer 'byte-optimize-predicate) (put 'cdr 'byte-optimizer 'byte-optimize-predicate) (put 'car-safe 'byte-optimizer 'byte-optimize-predicate) (put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate) ;; I'm not convinced that this is necessary. Doesn't the optimizer loop ;; take care of this? - Jamie ;; I think this may some times be necessary to reduce ie (quote 5) to 5, ;; so arithmetic optimizers recognize the numeric constant. - Hallvard (put 'quote 'byte-optimizer 'byte-optimize-quote) (defun byte-optimize-quote (form) (if (or (consp (nth 1 form)) (and (symbolp (nth 1 form)) (not (memq (nth 1 form) '(nil t))))) form (nth 1 form))) (defun byte-optimize-zerop (form) (cond ((numberp (nth 1 form)) (eval form)) (byte-compile-delete-errors (list '= (nth 1 form) 0)) (form))) (put 'zerop 'byte-optimizer 'byte-optimize-zerop) (defun byte-optimize-and (form) ;; Simplify if less than 2 args. ;; if there is a literal nil in the args to `and', throw it and following ;; forms away, and surround the `and' with (progn ... nil). (cond ((null (cdr form))) ((memq nil form) (list 'progn (byte-optimize-and (prog1 (setq form (copy-sequence form)) (while (nth 1 form) (setq form (cdr form))) (setcdr form nil))) nil)) ((null (cdr (cdr form))) (nth 1 form)) ((byte-optimize-predicate form)))) (defun byte-optimize-or (form) ;; Throw away nil's, and simplify if less than 2 args. ;; If there is a literal non-nil constant in the args to `or', throw away all ;; following forms. (if (memq nil form) (setq form (delq nil (copy-sequence form)))) (let ((rest form)) (while (cdr (setq rest (cdr rest))) (if (byte-compile-trueconstp (car rest)) (setq form (copy-sequence form) rest (setcdr (memq (car rest) form) nil)))) (if (cdr (cdr form)) (byte-optimize-predicate form) (nth 1 form)))) (defun byte-optimize-cond (form) ;; if any clauses have a literal nil as their test, throw them away. ;; if any clause has a literal non-nil constant as its test, throw ;; away all following clauses. (let (rest) ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ...) (while (setq rest (assq nil (cdr form))) (setq form (delq rest (copy-sequence form)))) (if (memq nil (cdr form)) (setq form (delq nil (copy-sequence form)))) (setq rest form) (while (setq rest (cdr rest)) (cond ((byte-compile-trueconstp (car-safe (car rest))) (cond ((eq rest (cdr form)) (setq form (if (cdr (car rest)) (if (cdr (cdr (car rest))) (cons 'progn (cdr (car rest))) (nth 1 (car rest))) (car (car rest))))) ((cdr rest) (setq form (copy-sequence form)) (setcdr (memq (car rest) form) nil))) (setq rest nil))))) ;; ;; Turn (cond (( )) ... ) into (or (cond ... )) (if (eq 'cond (car-safe form)) (let ((clauses (cdr form))) (if (and (consp (car clauses)) (null (cdr (car clauses)))) (list 'or (car (car clauses)) (byte-optimize-cond (cons (car form) (cdr (cdr form))))) form)) form)) (defun byte-optimize-if (form) ;; (if ) ==> ;; (if ) ==> (progn ) ;; (if nil ) ==> (if (not ) (progn )) ;; (if nil) ==> (if ) (let ((clause (nth 1 form))) (cond ((byte-compile-trueconstp clause) (nth 2 form)) ((null clause) (if (nthcdr 4 form) (cons 'progn (nthcdr 3 form)) (nth 3 form))) ((nth 2 form) (if (equal '(nil) (nthcdr 3 form)) (list 'if clause (nth 2 form)) form)) ((or (nth 3 form) (nthcdr 4 form)) (list 'if ;; Don't make a double negative; ;; instead, take away the one that is there. (if (and (consp clause) (memq (car clause) '(not null)) (= (length clause) 2)) ; (not xxxx) or (not (xxxx)) (nth 1 clause) (list 'not clause)) (if (nthcdr 4 form) (cons 'progn (nthcdr 3 form)) (nth 3 form)))) (t (list 'progn clause nil))))) (defun byte-optimize-while (form) (if (nth 1 form) form)) (put 'and 'byte-optimizer 'byte-optimize-and) (put 'or 'byte-optimizer 'byte-optimize-or) (put 'cond 'byte-optimizer 'byte-optimize-cond) (put 'if 'byte-optimizer 'byte-optimize-if) (put 'while 'byte-optimizer 'byte-optimize-while) ;; byte-compile-negation-optimizer lives in bytecomp.el (put '/= 'byte-optimizer 'byte-compile-negation-optimizer) (put 'atom 'byte-optimizer 'byte-compile-negation-optimizer) (put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer) (defun byte-optimize-funcall (form) ;; (funcall '(lambda ...) ...) ==> ((lambda ...) ...) ;; (funcall 'foo ...) ==> (foo ...) (let ((fn (nth 1 form))) (if (memq (car-safe fn) '(quote function)) (cons (nth 1 fn) (cdr (cdr form))) form))) (defun byte-optimize-apply (form) ;; If the last arg is a literal constant, turn this into a funcall. ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...). (let ((fn (nth 1 form)) (last (nth (1- (length form)) form))) ; I think this really is fastest (or (if (or (null last) (eq (car-safe last) 'quote)) (if (listp (nth 1 last)) (let ((butlast (nreverse (cdr (reverse (cdr (cdr form))))))) (nconc (list 'funcall fn) butlast (mapcar '(lambda (x) (list 'quote x)) (nth 1 last)))) (byte-compile-warn "last arg to apply can't be a literal atom: %s" (prin1-to-string last)) nil)) form))) (put 'funcall 'byte-optimizer 'byte-optimize-funcall) (put 'apply 'byte-optimizer 'byte-optimize-apply) (put 'let 'byte-optimizer 'byte-optimize-letX) (put 'let* 'byte-optimizer 'byte-optimize-letX) (defun byte-optimize-letX (form) (cond ((null (nth 1 form)) ;; No bindings (cons 'progn (cdr (cdr form)))) ((or (nth 2 form) (nthcdr 3 form)) form) ;; The body is nil ((eq (car form) 'let) (append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form))) '(nil))) (t (let ((binds (reverse (nth 1 form)))) (list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil))))) (put 'nth 'byte-optimizer 'byte-optimize-nth) (defun byte-optimize-nth (form) (if (and (= (safe-length form) 3) (memq (nth 1 form) '(0 1))) (list 'car (if (zerop (nth 1 form)) (nth 2 form) (list 'cdr (nth 2 form)))) (byte-optimize-predicate form))) (put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr) (defun byte-optimize-nthcdr (form) (if (and (= (safe-length form) 3) (not (memq (nth 1 form) '(0 1 2)))) (byte-optimize-predicate form) (let ((count (nth 1 form))) (setq form (nth 2 form)) (while (>= (setq count (1- count)) 0) (setq form (list 'cdr form))) form))) ;;; enumerating those functions which need not be called if the returned ;;; value is not used. That is, something like ;;; (progn (list (something-with-side-effects) (yow)) ;;; (foo)) ;;; may safely be turned into ;;; (progn (progn (something-with-side-effects) (yow)) ;;; (foo)) ;;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo. ;;; I wonder if I missed any :-\) (let ((side-effect-free-fns '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan assoc assq boundp buffer-file-name buffer-local-variables buffer-modified-p buffer-substring capitalize car-less-than-car car cdr ceiling concat coordinates-in-window-p copy-marker cos count-lines default-boundp default-value documentation downcase elt exp expt fboundp featurep file-directory-p file-exists-p file-locked-p file-name-absolute-p file-newer-than-file-p file-readable-p file-symlink-p file-writable-p float floor format get get-buffer get-buffer-window getenv get-file-buffer int-to-string length log log10 logand logb logior lognot logxor lsh marker-buffer max member memq min mod next-window nth nthcdr number-to-string parse-colon-path previous-window radians-to-degrees rassq regexp-quote reverse round sin sqrt string< string= string-equal string-lessp string-to-char string-to-int string-to-number substring symbol-plist tan upcase user-variable-p vconcat window-buffer window-dedicated-p window-edges window-height window-hscroll window-minibuffer-p window-width zerop)) (side-effect-and-error-free-fns '(arrayp atom bobp bolp buffer-end buffer-list buffer-size buffer-string bufferp car-safe case-table-p cdr-safe char-or-string-p commandp cons consp current-buffer dot dot-marker eobp eolp eq eql equal eventp floatp framep get-largest-window get-lru-window identity ignore integerp integer-or-marker-p interactive-p invocation-directory invocation-name keymapp list listp make-marker mark mark-marker markerp memory-limit minibuffer-window mouse-movement-p natnump nlistp not null number-or-marker-p numberp one-window-p overlayp point point-marker point-min point-max processp selected-window sequencep stringp subrp symbolp syntax-table-p user-full-name user-login-name user-original-login-name user-real-login-name user-real-uid user-uid vector vectorp window-configuration-p window-live-p windowp))) (while side-effect-free-fns (put (car side-effect-free-fns) 'side-effect-free t) (setq side-effect-free-fns (cdr side-effect-free-fns))) (while side-effect-and-error-free-fns (put (car side-effect-and-error-free-fns) 'side-effect-free 'error-free) (setq side-effect-and-error-free-fns (cdr side-effect-and-error-free-fns))) nil) (defun byte-compile-splice-in-already-compiled-code (form) ;; form is (byte-code "..." [...] n) (if (not (memq byte-optimize '(t lap))) (byte-compile-normal-call form) (byte-inline-lapcode (byte-decompile-bytecode-1 (nth 1 form) (nth 2 form) t)) (setq byte-compile-maxdepth (max (+ byte-compile-depth (nth 3 form)) byte-compile-maxdepth)) (setq byte-compile-depth (1+ byte-compile-depth)))) (put 'byte-code 'byte-compile 'byte-compile-splice-in-already-compiled-code) (defconst byte-constref-ops '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind)) ;;; This function extracts the bitfields from variable-length opcodes. ;;; Originally defined in disass.el (which no longer uses it.) (defun disassemble-offset () "Don't call this!" ;; fetch and return the offset for the current opcode. ;; return NIL if this opcode has no offset ;; OP, PTR and BYTES are used and set dynamically (defvar op) (defvar ptr) (defvar bytes) (cond ((< op byte-nth) (let ((tem (logand op 7))) (setq op (logand op 248)) (cond ((eq tem 6) (setq ptr (1+ ptr)) ;offset in next byte (aref bytes ptr)) ((eq tem 7) (setq ptr (1+ ptr)) ;offset in next 2 bytes (+ (aref bytes ptr) (progn (setq ptr (1+ ptr)) (lsh (aref bytes ptr) 8)))) (t tem)))) ;offset was in opcode ((>= op byte-constant) (prog1 (- op byte-constant) ;offset in opcode (setq op byte-constant))) ((and (>= op byte-constant2) (<= op byte-goto-if-not-nil-else-pop)) (setq ptr (1+ ptr)) ;offset in next 2 bytes (+ (aref bytes ptr) (progn (setq ptr (1+ ptr)) (lsh (aref bytes ptr) 8)))) ((and (>= op byte-listN) (<= op byte-insertN)) (setq ptr (1+ ptr)) ;offset in next byte (aref bytes ptr)))) ;;; This de-compiler is used for inline expansion of compiled functions, ;;; and by the disassembler. ;;; ;;; This list contains numbers, which are pc values, ;;; before each instruction. (defun byte-decompile-bytecode (bytes constvec) "Turns BYTECODE into lapcode, referring to CONSTVEC." (let ((byte-compile-constants nil) (byte-compile-variables nil) (byte-compile-tag-number 0)) (byte-decompile-bytecode-1 bytes constvec))) ;; As byte-decompile-bytecode, but updates ;; byte-compile-{constants, variables, tag-number}. ;; If MAKE-SPLICEABLE is true, then `return' opcodes are replaced ;; with `goto's destined for the end of the code. ;; That is for use by the compiler. ;; If MAKE-SPLICEABLE is nil, we are being called for the disassembler. ;; In that case, we put a pc value into the list ;; before each insn (or its label). (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable) (let ((length (length bytes)) (ptr 0) optr tag tags op offset lap tmp endtag (retcount 0)) (while (not (= ptr length)) (or make-spliceable (setq lap (cons ptr lap))) (setq op (aref bytes ptr) optr ptr offset (disassemble-offset)) ; this does dynamic-scope magic (setq op (aref byte-code-vector op)) (cond ((memq op byte-goto-ops) ;; it's a pc (setq offset (cdr (or (assq offset tags) (car (setq tags (cons (cons offset (byte-compile-make-tag)) tags))))))) ((cond ((eq op 'byte-constant2) (setq op 'byte-constant) t) ((memq op byte-constref-ops))) (setq tmp (aref constvec offset) offset (if (eq op 'byte-constant) (byte-compile-get-constant tmp) (or (assq tmp byte-compile-variables) (car (setq byte-compile-variables (cons (list tmp) byte-compile-variables))))))) ((and make-spliceable (eq op 'byte-return)) (if (= ptr (1- length)) (setq op nil) (setq offset (or endtag (setq endtag (byte-compile-make-tag))) op 'byte-goto)))) ;; lap = ( [ (pc . (op . arg)) ]* ) (setq lap (cons (cons optr (cons op (or offset 0))) lap)) (setq ptr (1+ ptr))) ;; take off the dummy nil op that we replaced a trailing "return" with. (let ((rest lap)) (while rest (cond ((numberp (car rest))) ((setq tmp (assq (car (car rest)) tags)) ;; this addr is jumped to (setcdr rest (cons (cons nil (cdr tmp)) (cdr rest))) (setq tags (delq tmp tags)) (setq rest (cdr rest)))) (setq rest (cdr rest)))) (if tags (error "optimizer error: missed tags %s" tags)) (if (null (car (cdr (car lap)))) (setq lap (cdr lap))) (if endtag (setq lap (cons (cons nil endtag) lap))) ;; remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* ) (mapcar (function (lambda (elt) (if (numberp elt) elt (cdr elt)))) (nreverse lap)))) ;;; peephole optimizer (defconst byte-tagref-ops (cons 'TAG byte-goto-ops)) (defconst byte-conditional-ops '(byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop byte-goto-if-not-nil-else-pop)) (defconst byte-after-unbind-ops '(byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp byte-eq byte-equal byte-not byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4 byte-interactive-p) ;; How about other side-effect-free-ops? Is it safe to move an ;; error invocation (such as from nth) out of an unwind-protect? "Byte-codes that can be moved past an unbind.") (defconst byte-compile-side-effect-and-error-free-ops '(byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max byte-point-min byte-following-char byte-preceding-char byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp byte-current-buffer byte-interactive-p)) (defconst byte-compile-side-effect-free-ops (nconc '(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1 byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax byte-buffer-substring byte-string= byte-string< byte-nthcdr byte-elt byte-member byte-assq byte-quo byte-rem) byte-compile-side-effect-and-error-free-ops)) ;;; This piece of shit is because of the way DEFVAR_BOOL() variables work. ;;; Consider the code ;;; ;;; (defun foo (flag) ;;; (let ((old-pop-ups pop-up-windows) ;;; (pop-up-windows flag)) ;;; (cond ((not (eq pop-up-windows old-pop-ups)) ;;; (setq old-pop-ups pop-up-windows) ;;; ...)))) ;;; ;;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is ;;; something else. But if we optimize ;;; ;;; varref flag ;;; varbind pop-up-windows ;;; varref pop-up-windows ;;; not ;;; to ;;; varref flag ;;; dup ;;; varbind pop-up-windows ;;; not ;;; ;;; we break the program, because it will appear that pop-up-windows and ;;; old-pop-ups are not EQ when really they are. So we have to know what ;;; the BOOL variables are, and not perform this optimization on them. ;;; (defconst byte-boolean-vars '(abbrev-all-caps abbrevs-changed byte-metering-on cannot-suspend completion-auto-help completion-ignore-case cursor-in-echo-area debug-on-next-call debug-on-quit delete-exited-processes enable-recursive-minibuffers highlight-nonselected-windows indent-tabs-mode inhibit-local-menu-bar-menus insert-default-directory inverse-video load-force-doc-strings load-in-progress menu-prompting minibuffer-auto-raise mode-line-inverse-video multiple-frames no-redraw-on-reenter noninteractive parse-sexp-ignore-comments pop-up-frames pop-up-windows print-escape-newlines system-uses-terminfo truncate-partial-width-windows visible-bell vms-stmlf-recfm words-include-escapes) "DEFVAR_BOOL variables. Giving these any non-nil value sets them to t. If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer may generate incorrect code.") (defun byte-optimize-lapcode (lap &optional for-effect) "Simple peephole optimizer. LAP is both modified and returned." (let (lap0 off0 lap1 off1 lap2 off2 (keep-going 'first-time) (add-depth 0) rest tmp tmp2 tmp3 (side-effect-free (if byte-compile-delete-errors byte-compile-side-effect-free-ops byte-compile-side-effect-and-error-free-ops))) (while keep-going (or (eq keep-going 'first-time) (byte-compile-log-lap " ---- next pass")) (setq rest lap keep-going nil) (while rest (setq lap0 (car rest) lap1 (nth 1 rest) lap2 (nth 2 rest)) ;; You may notice that sequences like "dup varset discard" are ;; optimized but sequences like "dup varset TAG1: discard" are not. ;; You may be tempted to change this; resist that temptation. (cond ;; ;; pop --> ;; ...including: ;; const-X pop --> ;; varref-X pop --> ;; dup pop --> ;; ((and (eq 'byte-discard (car lap1)) (memq (car lap0) side-effect-free)) (setq keep-going t) (setq tmp (aref byte-stack+-info (symbol-value (car lap0)))) (setq rest (cdr rest)) (cond ((= tmp 1) (byte-compile-log-lap " %s discard\t-->\t" lap0) (setq lap (delq lap0 (delq lap1 lap)))) ((= tmp 0) (byte-compile-log-lap " %s discard\t-->\t discard" lap0) (setq lap (delq lap0 lap))) ((= tmp -1) (byte-compile-log-lap " %s discard\t-->\tdiscard discard" lap0) (setcar lap0 'byte-discard) (setcdr lap0 0)) ((error "Optimizer error: too much on the stack")))) ;; ;; goto*-X X: --> X: ;; ((and (memq (car lap0) byte-goto-ops) (eq (cdr lap0) lap1)) (cond ((eq (car lap0) 'byte-goto) (setq lap (delq lap0 lap)) (setq tmp "")) ((memq (car lap0) byte-goto-always-pop-ops) (setcar lap0 (setq tmp 'byte-discard)) (setcdr lap0 0)) ((error "Depth conflict at tag %d" (nth 2 lap0)))) (and (memq byte-optimize-log '(t byte)) (byte-compile-log " (goto %s) %s:\t-->\t%s %s:" (nth 1 lap1) (nth 1 lap1) tmp (nth 1 lap1))) (setq keep-going t)) ;; ;; varset-X varref-X --> dup varset-X ;; varbind-X varref-X --> dup varbind-X ;; const/dup varset-X varref-X --> const/dup varset-X const/dup ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup ;; The latter two can enable other optimizations. ;; ((and (eq 'byte-varref (car lap2)) (eq (cdr lap1) (cdr lap2)) (memq (car lap1) '(byte-varset byte-varbind))) (if (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars)) (not (eq (car lap0) 'byte-constant))) nil (setq keep-going t) (if (memq (car lap0) '(byte-constant byte-dup)) (progn (setq tmp (if (or (not tmp) (memq (car (cdr lap0)) '(nil t))) (cdr lap0) (byte-compile-get-constant t))) (byte-compile-log-lap " %s %s %s\t-->\t%s %s %s" lap0 lap1 lap2 lap0 lap1 (cons (car lap0) tmp)) (setcar lap2 (car lap0)) (setcdr lap2 tmp)) (byte-compile-log-lap " %s %s\t-->\tdup %s" lap1 lap2 lap1) (setcar lap2 (car lap1)) (setcar lap1 'byte-dup) (setcdr lap1 0) ;; The stack depth gets locally increased, so we will ;; increase maxdepth in case depth = maxdepth here. ;; This can cause the third argument to byte-code to ;; be larger than necessary. (setq add-depth 1)))) ;; ;; dup varset-X discard --> varset-X ;; dup varbind-X discard --> varbind-X ;; (the varbind variant can emerge from other optimizations) ;; ((and (eq 'byte-dup (car lap0)) (eq 'byte-discard (car lap2)) (memq (car lap1) '(byte-varset byte-varbind))) (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1) (setq keep-going t rest (cdr rest)) (setq lap (delq lap0 (delq lap2 lap)))) ;; ;; not goto-X-if-nil --> goto-X-if-non-nil ;; not goto-X-if-non-nil --> goto-X-if-nil ;; ;; it is wrong to do the same thing for the -else-pop variants. ;; ((and (eq 'byte-not (car lap0)) (or (eq 'byte-goto-if-nil (car lap1)) (eq 'byte-goto-if-not-nil (car lap1)))) (byte-compile-log-lap " not %s\t-->\t%s" lap1 (cons (if (eq (car lap1) 'byte-goto-if-nil) 'byte-goto-if-not-nil 'byte-goto-if-nil) (cdr lap1))) (setcar lap1 (if (eq (car lap1) 'byte-goto-if-nil) 'byte-goto-if-not-nil 'byte-goto-if-nil)) (setq lap (delq lap0 lap)) (setq keep-going t)) ;; ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X: ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X: ;; ;; it is wrong to do the same thing for the -else-pop variants. ;; ((and (or (eq 'byte-goto-if-nil (car lap0)) (eq 'byte-goto-if-not-nil (car lap0))) ; gotoX (eq 'byte-goto (car lap1)) ; gotoY (eq (cdr lap0) lap2)) ; TAG X (let ((inverse (if (eq 'byte-goto-if-nil (car lap0)) 'byte-goto-if-not-nil 'byte-goto-if-nil))) (byte-compile-log-lap " %s %s %s:\t-->\t%s %s:" lap0 lap1 lap2 (cons inverse (cdr lap1)) lap2) (setq lap (delq lap0 lap)) (setcar lap1 inverse) (setq keep-going t))) ;; ;; const goto-if-* --> whatever ;; ((and (eq 'byte-constant (car lap0)) (memq (car lap1) byte-conditional-ops)) (cond ((if (or (eq (car lap1) 'byte-goto-if-nil) (eq (car lap1) 'byte-goto-if-nil-else-pop)) (car (cdr lap0)) (not (car (cdr lap0)))) (byte-compile-log-lap " %s %s\t-->\t" lap0 lap1) (setq rest (cdr rest) lap (delq lap0 (delq lap1 lap)))) (t (if (memq (car lap1) byte-goto-always-pop-ops) (progn (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 (cons 'byte-goto (cdr lap1))) (setq lap (delq lap0 lap))) (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 (cons 'byte-goto (cdr lap1)))) (setcar lap1 'byte-goto))) (setq keep-going t)) ;; ;; varref-X varref-X --> varref-X dup ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup ;; We don't optimize the const-X variations on this here, ;; because that would inhibit some goto optimizations; we ;; optimize the const-X case after all other optimizations. ;; ((and (eq 'byte-varref (car lap0)) (progn (setq tmp (cdr rest)) (while (eq (car (car tmp)) 'byte-dup) (setq tmp (cdr tmp))) t) (eq (cdr lap0) (cdr (car tmp))) (eq 'byte-varref (car (car tmp)))) (if (memq byte-optimize-log '(t byte)) (let ((str "")) (setq tmp2 (cdr rest)) (while (not (eq tmp tmp2)) (setq tmp2 (cdr tmp2) str (concat str " dup"))) (byte-compile-log-lap " %s%s %s\t-->\t%s%s dup" lap0 str lap0 lap0 str))) (setq keep-going t) (setcar (car tmp) 'byte-dup) (setcdr (car tmp) 0) (setq rest tmp)) ;; ;; TAG1: TAG2: --> TAG1: ;; (and other references to TAG2 are replaced with TAG1) ;; ((and (eq (car lap0) 'TAG) (eq (car lap1) 'TAG)) (and (memq byte-optimize-log '(t byte)) (byte-compile-log " adjacent tags %d and %d merged" (nth 1 lap1) (nth 1 lap0))) (setq tmp3 lap) (while (setq tmp2 (rassq lap0 tmp3)) (setcdr tmp2 lap1) (setq tmp3 (cdr (memq tmp2 tmp3)))) (setq lap (delq lap0 lap) keep-going t)) ;; ;; unused-TAG: --> ;; ((and (eq 'TAG (car lap0)) (not (rassq lap0 lap))) (and (memq byte-optimize-log '(t byte)) (byte-compile-log " unused tag %d removed" (nth 1 lap0))) (setq lap (delq lap0 lap) keep-going t)) ;; ;; goto ... --> goto ;; return ... --> return ;; ((and (memq (car lap0) '(byte-goto byte-return)) (not (memq (car lap1) '(TAG nil)))) (setq tmp rest) (let ((i 0) (opt-p (memq byte-optimize-log '(t lap))) str deleted) (while (and (setq tmp (cdr tmp)) (not (eq 'TAG (car (car tmp))))) (if opt-p (setq deleted (cons (car tmp) deleted) str (concat str " %s") i (1+ i)))) (if opt-p (let ((tagstr (if (eq 'TAG (car (car tmp))) (format "%d:" (car (cdr (car tmp)))) (or (car tmp) "")))) (if (< i 6) (apply 'byte-compile-log-lap-1 (concat " %s" str " %s\t-->\t%s %s") lap0 (nconc (nreverse deleted) (list tagstr lap0 tagstr))) (byte-compile-log-lap " %s <%d unreachable op%s> %s\t-->\t%s %s" lap0 i (if (= i 1) "" "s") tagstr lap0 tagstr)))) (rplacd rest tmp)) (setq keep-going t)) ;; ;; unbind --> unbind ;; (this may enable other optimizations.) ;; ((and (eq 'byte-unbind (car lap1)) (memq (car lap0) byte-after-unbind-ops)) (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0) (setcar rest lap1) (setcar (cdr rest) lap0) (setq keep-going t)) ;; ;; varbind-X unbind-N --> discard unbind-(N-1) ;; save-excursion unbind-N --> unbind-(N-1) ;; save-restriction unbind-N --> unbind-(N-1) ;; ((and (eq 'byte-unbind (car lap1)) (memq (car lap0) '(byte-varbind byte-save-excursion byte-save-restriction)) (< 0 (cdr lap1))) (if (zerop (setcdr lap1 (1- (cdr lap1)))) (delq lap1 rest)) (if (eq (car lap0) 'byte-varbind) (setcar rest (cons 'byte-discard 0)) (setq lap (delq lap0 lap))) (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 (cons (car lap1) (1+ (cdr lap1))) (if (eq (car lap0) 'byte-varbind) (car rest) (car (cdr rest))) (if (and (/= 0 (cdr lap1)) (eq (car lap0) 'byte-varbind)) (car (cdr rest)) "")) (setq keep-going t)) ;; ;; goto*-X ... X: goto-Y --> goto*-Y ;; goto-X ... X: return --> return ;; ((and (memq (car lap0) byte-goto-ops) (memq (car (setq tmp (nth 1 (memq (cdr lap0) lap)))) '(byte-goto byte-return))) (cond ((and (not (eq tmp lap0)) (or (eq (car lap0) 'byte-goto) (eq (car tmp) 'byte-goto))) (byte-compile-log-lap " %s [%s]\t-->\t%s" (car lap0) tmp tmp) (if (eq (car tmp) 'byte-return) (setcar lap0 'byte-return)) (setcdr lap0 (cdr tmp)) (setq keep-going t)))) ;; ;; goto-*-else-pop X ... X: goto-if-* --> whatever ;; goto-*-else-pop X ... X: discard --> whatever ;; ((and (memq (car lap0) '(byte-goto-if-nil-else-pop byte-goto-if-not-nil-else-pop)) (memq (car (car (setq tmp (cdr (memq (cdr lap0) lap))))) (eval-when-compile (cons 'byte-discard byte-conditional-ops))) (not (eq lap0 (car tmp)))) (setq tmp2 (car tmp)) (setq tmp3 (assq (car lap0) '((byte-goto-if-nil-else-pop byte-goto-if-nil) (byte-goto-if-not-nil-else-pop byte-goto-if-not-nil)))) (if (memq (car tmp2) tmp3) (progn (setcar lap0 (car tmp2)) (setcdr lap0 (cdr tmp2)) (byte-compile-log-lap " %s-else-pop [%s]\t-->\t%s" (car lap0) tmp2 lap0)) ;; Get rid of the -else-pop's and jump one step further. (or (eq 'TAG (car (nth 1 tmp))) (setcdr tmp (cons (byte-compile-make-tag) (cdr tmp)))) (byte-compile-log-lap " %s [%s]\t-->\t%s " (car lap0) tmp2 (nth 1 tmp3)) (setcar lap0 (nth 1 tmp3)) (setcdr lap0 (nth 1 tmp))) (setq keep-going t)) ;; ;; const goto-X ... X: goto-if-* --> whatever ;; const goto-X ... X: discard --> whatever ;; ((and (eq (car lap0) 'byte-constant) (eq (car lap1) 'byte-goto) (memq (car (car (setq tmp (cdr (memq (cdr lap1) lap))))) (eval-when-compile (cons 'byte-discard byte-conditional-ops))) (not (eq lap1 (car tmp)))) (setq tmp2 (car tmp)) (cond ((memq (car tmp2) (if (null (car (cdr lap0))) '(byte-goto-if-nil byte-goto-if-nil-else-pop) '(byte-goto-if-not-nil byte-goto-if-not-nil-else-pop))) (byte-compile-log-lap " %s goto [%s]\t-->\t%s %s" lap0 tmp2 lap0 tmp2) (setcar lap1 (car tmp2)) (setcdr lap1 (cdr tmp2)) ;; Let next step fix the (const,goto-if*) sequence. (setq rest (cons nil rest))) (t ;; Jump one step further (byte-compile-log-lap " %s goto [%s]\t-->\t goto " lap0 tmp2) (or (eq 'TAG (car (nth 1 tmp))) (setcdr tmp (cons (byte-compile-make-tag) (cdr tmp)))) (setcdr lap1 (car (cdr tmp))) (setq lap (delq lap0 lap)))) (setq keep-going t)) ;; ;; X: varref-Y ... varset-Y goto-X --> ;; X: varref-Y Z: ... dup varset-Y goto-Z ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.) ;; (This is so usual for while loops that it is worth handling). ;; ((and (eq (car lap1) 'byte-varset) (eq (car lap2) 'byte-goto) (not (memq (cdr lap2) rest)) ;Backwards jump (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap))))) 'byte-varref) (eq (cdr (car tmp)) (cdr lap1)) (not (memq (car (cdr lap1)) byte-boolean-vars))) ;;(byte-compile-log-lap " Pulled %s to end of loop" (car tmp)) (let ((newtag (byte-compile-make-tag))) (byte-compile-log-lap " %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s" (nth 1 (cdr lap2)) (car tmp) lap1 lap2 (nth 1 (cdr lap2)) (car tmp) (nth 1 newtag) 'byte-dup lap1 (cons 'byte-goto newtag) ) (setcdr rest (cons (cons 'byte-dup 0) (cdr rest))) (setcdr tmp (cons (setcdr lap2 newtag) (cdr tmp)))) (setq add-depth 1) (setq keep-going t)) ;; ;; goto-X Y: ... X: goto-if*-Y --> goto-if-not-*-X+1 Y: ;; (This can pull the loop test to the end of the loop) ;; ((and (eq (car lap0) 'byte-goto) (eq (car lap1) 'TAG) (eq lap1 (cdr (car (setq tmp (cdr (memq (cdr lap0) lap)))))) (memq (car (car tmp)) '(byte-goto byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop))) ;; (byte-compile-log-lap " %s %s, %s %s --> moved conditional" ;; lap0 lap1 (cdr lap0) (car tmp)) (let ((newtag (byte-compile-make-tag))) (byte-compile-log-lap "%s %s: ... %s: %s\t-->\t%s ... %s:" lap0 (nth 1 lap1) (nth 1 (cdr lap0)) (car tmp) (cons (cdr (assq (car (car tmp)) '((byte-goto-if-nil . byte-goto-if-not-nil) (byte-goto-if-not-nil . byte-goto-if-nil) (byte-goto-if-nil-else-pop . byte-goto-if-not-nil-else-pop) (byte-goto-if-not-nil-else-pop . byte-goto-if-nil-else-pop)))) newtag) (nth 1 newtag) ) (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp))) (if (eq (car (car tmp)) 'byte-goto-if-nil-else-pop) ;; We can handle this case but not the -if-not-nil case, ;; because we won't know which non-nil constant to push. (setcdr rest (cons (cons 'byte-constant (byte-compile-get-constant nil)) (cdr rest)))) (setcar lap0 (nth 1 (memq (car (car tmp)) '(byte-goto-if-nil-else-pop byte-goto-if-not-nil byte-goto-if-nil byte-goto-if-not-nil byte-goto byte-goto)))) ) (setq keep-going t)) ) (setq rest (cdr rest))) ) ;; Cleanup stage: ;; Rebuild byte-compile-constants / byte-compile-variables. ;; Simple optimizations that would inhibit other optimizations if they ;; were done in the optimizing loop, and optimizations which there is no ;; need to do more than once. (setq byte-compile-constants nil byte-compile-variables nil) (setq rest lap) (while rest (setq lap0 (car rest) lap1 (nth 1 rest)) (if (memq (car lap0) byte-constref-ops) (if (eq (cdr lap0) 'byte-constant) (or (memq (cdr lap0) byte-compile-variables) (setq byte-compile-variables (cons (cdr lap0) byte-compile-variables))) (or (memq (cdr lap0) byte-compile-constants) (setq byte-compile-constants (cons (cdr lap0) byte-compile-constants))))) (cond (;; ;; const-C varset-X const-C --> const-C dup varset-X ;; const-C varbind-X const-C --> const-C dup varbind-X ;; (and (eq (car lap0) 'byte-constant) (eq (car (nth 2 rest)) 'byte-constant) (eq (cdr lap0) (car (nth 2 rest))) (memq (car lap1) '(byte-varbind byte-varset))) (byte-compile-log-lap " %s %s %s\t-->\t%s dup %s" lap0 lap1 lap0 lap0 lap1) (setcar (cdr (cdr rest)) (cons (car lap1) (cdr lap1))) (setcar (cdr rest) (cons 'byte-dup 0)) (setq add-depth 1)) ;; ;; const-X [dup/const-X ...] --> const-X [dup ...] dup ;; varref-X [dup/varref-X ...] --> varref-X [dup ...] dup ;; ((memq (car lap0) '(byte-constant byte-varref)) (setq tmp rest tmp2 nil) (while (progn (while (eq 'byte-dup (car (car (setq tmp (cdr tmp)))))) (and (eq (cdr lap0) (cdr (car tmp))) (eq (car lap0) (car (car tmp))))) (setcar tmp (cons 'byte-dup 0)) (setq tmp2 t)) (if tmp2 (byte-compile-log-lap " %s [dup/%s]...\t-->\t%s dup..." lap0 lap0 lap0))) ;; ;; unbind-N unbind-M --> unbind-(N+M) ;; ((and (eq 'byte-unbind (car lap0)) (eq 'byte-unbind (car lap1))) (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 (cons 'byte-unbind (+ (cdr lap0) (cdr lap1)))) (setq keep-going t) (setq lap (delq lap0 lap)) (setcdr lap1 (+ (cdr lap1) (cdr lap0)))) ) (setq rest (cdr rest))) (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth))) lap) (provide 'byte-optimize) ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when this file compiles ;; itself, compile some of its most used recursive functions (at load time). ;; (eval-when-compile (or (byte-code-function-p (symbol-function 'byte-optimize-form)) (assq 'byte-code (symbol-function 'byte-optimize-form)) (let ((byte-optimize nil) (byte-compile-warnings nil)) (mapcar '(lambda (x) (or noninteractive (message "compiling %s..." x)) (byte-compile x) (or noninteractive (message "compiling %s...done" x))) '(byte-optimize-form byte-optimize-body byte-optimize-predicate byte-optimize-binary-predicate ;; Inserted some more than necessary, to speed it up. byte-optimize-form-code-walker byte-optimize-lapcode)))) nil) ;;; byte-opt.el ends here emacs-19.30/lisp/byte-run.el100444 12120 1 14000 5676057225 14167 0ustar rmsdaemon;;; byte-run.el --- byte-compiler support for inlining ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Jamie Zawinski ;; Hallvard Furuseth ;; Keywords: internal ;; 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: ;;; interface to selectively inlining functions. ;;; This only happens when source-code optimization is turned on. ;;; Code: ;; Redefined in byte-optimize.el. ;; This is not documented--it's not clear that we should promote it. (fset 'inline 'progn) (put 'inline 'lisp-indent-hook 0) ;;; Interface to inline functions. ;; (defmacro proclaim-inline (&rest fns) ;; "Cause the named functions to be open-coded when called from compiled code. ;; They will only be compiled open-coded when byte-compile-optimize is true." ;; (cons 'eval-and-compile ;; (mapcar '(lambda (x) ;; (or (memq (get x 'byte-optimizer) ;; '(nil byte-compile-inline-expand)) ;; (error ;; "%s already has a byte-optimizer, can't make it inline" ;; x)) ;; (list 'put (list 'quote x) ;; ''byte-optimizer ''byte-compile-inline-expand)) ;; fns))) ;; (defmacro proclaim-notinline (&rest fns) ;; "Cause the named functions to no longer be open-coded." ;; (cons 'eval-and-compile ;; (mapcar '(lambda (x) ;; (if (eq (get x 'byte-optimizer) 'byte-compile-inline-expand) ;; (put x 'byte-optimizer nil)) ;; (list 'if (list 'eq (list 'get (list 'quote x) ''byte-optimizer) ;; ''byte-compile-inline-expand) ;; (list 'put x ''byte-optimizer nil))) ;; fns))) ;; This has a special byte-hunk-handler in bytecomp.el. (defmacro defsubst (name arglist &rest body) "Define an inline function. The syntax is just like that of `defun'." (or (memq (get name 'byte-optimizer) '(nil byte-compile-inline-expand)) (error "`%s' is a primitive" name)) (list 'prog1 (cons 'defun (cons name (cons arglist body))) (list 'eval-and-compile (list 'put (list 'quote name) ''byte-optimizer ''byte-compile-inline-expand)))) (defun make-obsolete (fn new) "Make the byte-compiler warn that FUNCTION is obsolete. The warning will say that NEW should be used instead. If NEW is a string, that is the `use instead' message." (interactive "aMake function obsolete: \nxObsoletion replacement: ") (let ((handler (get fn 'byte-compile))) (if (eq 'byte-compile-obsolete handler) (setcar (get fn 'byte-obsolete-info) new) (put fn 'byte-obsolete-info (cons new handler)) (put fn 'byte-compile 'byte-compile-obsolete))) fn) (defun make-obsolete-variable (var new) "Make the byte-compiler warn that VARIABLE is obsolete, and NEW should be used instead. If NEW is a string, then that is the `use instead' message." (interactive (list (let ((str (completing-read "Make variable obsolete: " obarray 'boundp t))) (if (equal str "") (error "")) (intern str)) (car (read-from-string (read-string "Obsoletion replacement: "))))) (put var 'byte-obsolete-variable new) var) (put 'dont-compile 'lisp-indent-hook 0) (defmacro dont-compile (&rest body) "Like `progn', but the body always runs interpreted (not compiled). If you think you need this, you're probably making a mistake somewhere." (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body))))) ;;; interface to evaluating things at compile time and/or load time ;;; these macro must come after any uses of them in this file, as their ;;; definition in the file overrides the magic definitions on the ;;; byte-compile-macro-environment. (put 'eval-when-compile 'lisp-indent-hook 0) (defmacro eval-when-compile (&rest body) "Like `progn', but evaluates the body at compile time. The result of the body appears to the compiler as a quoted constant." ;; Not necessary because we have it in b-c-initial-macro-environment ;; (list 'quote (eval (cons 'progn body))) (cons 'progn body)) (put 'eval-and-compile 'lisp-indent-hook 0) (defmacro eval-and-compile (&rest body) "Like `progn', but evaluates the body at compile time and at load time." ;; Remember, it's magic. (cons 'progn body)) ;;; I nuked this because it's not a good idea for users to think of using it. ;;; These options are a matter of installation preference, and have nothing to ;;; with particular source files; it's a mistake to suggest to users ;;; they should associate these with particular source files. ;;; There is hardly any reason to change these parameters, anyway. ;;; --rms. ;; (put 'byte-compiler-options 'lisp-indent-hook 0) ;; (defmacro byte-compiler-options (&rest args) ;; "Set some compilation-parameters for this file. This will affect only the ;; file in which it appears; this does nothing when evaluated, and when loaded ;; from a .el file. ;; ;; Each argument to this macro must be a list of a key and a value. ;; ;; Keys: Values: Corresponding variable: ;; ;; verbose t, nil byte-compile-verbose ;; optimize t, nil, source, byte byte-compile-optimize ;; warnings list of warnings byte-compile-warnings ;; Legal elements: (callargs redefine free-vars unresolved) ;; file-format emacs18, emacs19 byte-compile-compatibility ;; ;; For example, this might appear at the top of a source file: ;; ;; (byte-compiler-options ;; (optimize t) ;; (warnings (- free-vars)) ; Don't warn about free variables ;; (file-format emacs19))" ;; nil) ;;; byte-run.el ends here emacs-19.30/lisp/bytecomp.el100444 12120 1 372321 6050704351 14263 0ustar rmsdaemon;;; bytecomp.el --- compilation of Lisp code into byte code. ;;; Copyright (C) 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc. ;; Author: Jamie Zawinski ;; Hallvard Furuseth ;; Keywords: internal ;; Subsequently modified by RMS. ;;; This version incorporates changes up to version 2.10 of the ;;; Zawinski-Furuseth compiler. (defconst byte-compile-version "FSF 2.10") ;; 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: ;; The Emacs Lisp byte compiler. This crunches lisp source into a sort ;; of p-code which takes up less space and can be interpreted faster. ;; The user entry points are byte-compile-file and byte-recompile-directory. ;;; Code: ;;; ======================================================================== ;;; Entry points: ;;; byte-recompile-directory, byte-compile-file, ;;; batch-byte-compile, batch-byte-recompile-directory, ;;; byte-compile, compile-defun, ;;; display-call-tree ;;; (byte-compile-buffer and byte-compile-and-load-file were turned off ;;; because they are not terribly useful and get in the way of completion.) ;;; This version of the byte compiler has the following improvements: ;;; + optimization of compiled code: ;;; - removal of unreachable code; ;;; - removal of calls to side-effectless functions whose return-value ;;; is unused; ;;; - compile-time evaluation of safe constant forms, such as (consp nil) ;;; and (ash 1 6); ;;; - open-coding of literal lambdas; ;;; - peephole optimization of emitted code; ;;; - trivial functions are left uncompiled for speed. ;;; + support for inline functions; ;;; + compile-time evaluation of arbitrary expressions; ;;; + compile-time warning messages for: ;;; - functions being redefined with incompatible arglists; ;;; - functions being redefined as macros, or vice-versa; ;;; - functions or macros defined multiple times in the same file; ;;; - functions being called with the incorrect number of arguments; ;;; - functions being called which are not defined globally, in the ;;; file, or as autoloads; ;;; - assignment and reference of undeclared free variables; ;;; - various syntax errors; ;;; + correct compilation of nested defuns, defmacros, defvars and defsubsts; ;;; + correct compilation of top-level uses of macros; ;;; + the ability to generate a histogram of functions called. ;;; User customization variables: ;;; ;;; byte-compile-verbose Whether to report the function currently being ;;; compiled in the minibuffer; ;;; byte-optimize Whether to do optimizations; this may be ;;; t, nil, 'source, or 'byte; ;;; byte-optimize-log Whether to report (in excruciating detail) ;;; exactly which optimizations have been made. ;;; This may be t, nil, 'source, or 'byte; ;;; byte-compile-error-on-warn Whether to stop compilation when a warning is ;;; produced; ;;; byte-compile-delete-errors Whether the optimizer may delete calls or ;;; variable references that are side-effect-free ;;; except that they may return an error. ;;; byte-compile-generate-call-tree Whether to generate a histogram of ;;; function calls. This can be useful for ;;; finding unused functions, as well as simple ;;; performance metering. ;;; byte-compile-warnings List of warnings to issue, or t. May contain ;;; 'free-vars (references to variables not in the ;;; current lexical scope) ;;; 'unresolved (calls to unknown functions) ;;; 'callargs (lambda calls with args that don't ;;; match the lambda's definition) ;;; 'redefine (function cell redefined from ;;; a macro to a lambda or vice versa, ;;; or redefined to take other args) ;;; 'obsolete (obsolete variables and functions) ;;; byte-compile-compatibility Whether the compiler should ;;; generate .elc files which can be loaded into ;;; generic emacs 18. ;;; emacs-lisp-file-regexp Regexp for the extension of source-files; ;;; see also the function byte-compile-dest-file. ;;; New Features: ;;; ;;; o The form `defsubst' is just like `defun', except that the function ;;; generated will be open-coded in compiled code which uses it. This ;;; means that no function call will be generated, it will simply be ;;; spliced in. Lisp functions calls are very slow, so this can be a ;;; big win. ;;; ;;; You can generally accomplish the same thing with `defmacro', but in ;;; that case, the defined procedure can't be used as an argument to ;;; mapcar, etc. ;;; ;;; o You can also open-code one particular call to a function without ;;; open-coding all calls. Use the 'inline' form to do this, like so: ;;; ;;; (inline (foo 1 2 3)) ;; `foo' will be open-coded ;;; or... ;;; (inline ;; `foo' and `baz' will be ;;; (foo 1 2 3 (bar 5)) ;; open-coded, but `bar' will not. ;;; (baz 0)) ;;; ;;; o It is possible to open-code a function in the same file it is defined ;;; in without having to load that file before compiling it. the ;;; byte-compiler has been modified to remember function definitions in ;;; the compilation environment in the same way that it remembers macro ;;; definitions. ;;; ;;; o Forms like ((lambda ...) ...) are open-coded. ;;; ;;; o The form `eval-when-compile' is like progn, except that the body ;;; is evaluated at compile-time. When it appears at top-level, this ;;; is analogous to the Common Lisp idiom (eval-when (compile) ...). ;;; When it does not appear at top-level, it is similar to the ;;; Common Lisp #. reader macro (but not in interpreted code). ;;; ;;; o The form `eval-and-compile' is similar to eval-when-compile, but ;;; the whole form is evalled both at compile-time and at run-time. ;;; ;;; o The command compile-defun is analogous to eval-defun. ;;; ;;; o If you run byte-compile-file on a filename which is visited in a ;;; buffer, and that buffer is modified, you are asked whether you want ;;; to save the buffer before compiling. ;;; ;;; o byte-compiled files now start with the string `;ELC'. ;;; Some versions of `file' can be customized to recognize that. (require 'backquote) (or (fboundp 'defsubst) ;; This really ought to be loaded already! (load-library "byte-run")) ;;; The feature of compiling in a specific target Emacs version ;;; has been turned off because compile time options are a bad idea. (defmacro byte-compile-single-version () nil) (defmacro byte-compile-version-cond (cond) cond) ;;; The crud you see scattered through this file of the form ;;; (or (and (boundp 'epoch::version) epoch::version) ;;; (string-lessp emacs-version "19")) ;;; is because the Epoch folks couldn't be bothered to follow the ;;; normal emacs version numbering convention. ;; (if (byte-compile-version-cond ;; (or (and (boundp 'epoch::version) epoch::version) ;; (string-lessp emacs-version "19"))) ;; (progn ;; ;; emacs-18 compatibility. ;; (defvar baud-rate (baud-rate)) ;Define baud-rate if it's undefined ;; ;; (if (byte-compile-single-version) ;; (defmacro byte-code-function-p (x) "Emacs 18 doesn't have these." nil) ;; (defun byte-code-function-p (x) "Emacs 18 doesn't have these." nil)) ;; ;; (or (and (fboundp 'member) ;; ;; avoid using someone else's possibly bogus definition of this. ;; (subrp (symbol-function 'member))) ;; (defun member (elt list) ;; "like memq, but uses equal instead of eq. In v19, this is a subr." ;; (while (and list (not (equal elt (car list)))) ;; (setq list (cdr list))) ;; list)))) (defvar emacs-lisp-file-regexp (if (eq system-type 'vax-vms) "\\.EL\\(;[0-9]+\\)?$" "\\.el$") "*Regexp which matches Emacs Lisp source files. You may want to redefine `byte-compile-dest-file' if you change this.") ;; This enables file name handlers such as jka-compr ;; to remove parts of the file name that should not be copied ;; through to the output file name. (defun byte-compiler-base-file-name (filename) (let ((handler (find-file-name-handler filename 'byte-compiler-base-file-name))) (if handler (funcall handler 'byte-compiler-base-file-name filename) filename))) (or (fboundp 'byte-compile-dest-file) ;; The user may want to redefine this along with emacs-lisp-file-regexp, ;; so only define it if it is undefined. (defun byte-compile-dest-file (filename) "Convert an Emacs Lisp source file name to a compiled file name." (setq filename (byte-compiler-base-file-name filename)) (setq filename (file-name-sans-versions filename)) (cond ((eq system-type 'vax-vms) (concat (substring filename 0 (string-match ";" filename)) "c")) ((string-match emacs-lisp-file-regexp filename) (concat (substring filename 0 (match-beginning 0)) ".elc")) (t (concat filename ".elc"))))) ;; This can be the 'byte-compile property of any symbol. (autoload 'byte-compile-inline-expand "byte-opt") ;; This is the entrypoint to the lapcode optimizer pass1. (autoload 'byte-optimize-form "byte-opt") ;; This is the entrypoint to the lapcode optimizer pass2. (autoload 'byte-optimize-lapcode "byte-opt") (autoload 'byte-compile-unfold-lambda "byte-opt") ;; This is the entry point to the decompiler, which is used by the ;; disassembler. The disassembler just requires 'byte-compile, but ;; that doesn't define this function, so this seems to be a reasonable ;; thing to do. (autoload 'byte-decompile-bytecode "byte-opt") (defvar byte-compile-verbose (and (not noninteractive) (> baud-rate search-slow-speed)) "*Non-nil means print messages describing progress of byte-compiler.") (defvar byte-compile-compatibility nil "*Non-nil means generate output that can run in Emacs 18.") ;; (defvar byte-compile-generate-emacs19-bytecodes ;; (not (or (and (boundp 'epoch::version) epoch::version) ;; (string-lessp emacs-version "19"))) ;; "*If this is true, then the byte-compiler will generate bytecode which ;; makes use of byte-ops which are present only in Emacs 19. Code generated ;; this way can never be run in Emacs 18, and may even cause it to crash.") (defvar byte-optimize t "*Enables optimization in the byte compiler. nil means don't do any optimization. t means do all optimizations. `source' means do source-level optimizations only. `byte' means do code-level optimizations only.") (defvar byte-compile-delete-errors t "*If non-nil, the optimizer may delete forms that may signal an error. This includes variable references and calls to functions such as `car'.") (defvar byte-compile-dynamic nil "*If non-nil, compile function bodies so they load lazily. They are hidden comments in the compiled file, and brought into core when the function is called. To enable this option, make it a file-local variable in the source file you want it to apply to. For example, add -*-byte-compile-dynamic: t;-*- on the first line. When this option is true, if you load the compiled file and then move it, the functions you loaded will not be able to run.") (defvar byte-compile-dynamic-docstrings t "*If non-nil, compile doc strings for lazy access. We bury the doc strings of functions and variables inside comments in the file, and bring them into core only when they are actually needed. When this option is true, if you load the compiled file and then move it, you won't be able to find the documentation of anything in that file. To disable this option for a certain file, make it a file-local variable in the source file. For example, add this to the first line: -*-byte-compile-dynamic-docstrings:nil;-*- You can also set the variable globally. This option is enabled by default because it reduces Emacs memory usage.") (defvar byte-optimize-log nil "*If true, the byte-compiler will log its optimizations into *Compile-Log*. If this is 'source, then only source-level optimizations will be logged. If it is 'byte, then only byte-level optimizations will be logged.") (defvar byte-compile-error-on-warn nil "*If true, the byte-compiler reports warnings with `error'.") (defconst byte-compile-warning-types '(redefine callargs free-vars unresolved obsolete)) (defvar byte-compile-warnings t "*List of warnings that the byte-compiler should issue (t for all). Elements of the list may be be: free-vars references to variables not in the current lexical scope. unresolved calls to unknown functions. callargs lambda calls with args that don't match the definition. redefine function cell redefined from a macro to a lambda or vice versa, or redefined to take a different number of arguments. obsolete obsolete variables and functions. See also the macro `byte-compiler-options'.") (defvar byte-compile-generate-call-tree nil "*Non-nil means collect call-graph information when compiling. This records functions were called and from where. If the value is t, compilation displays the call graph when it finishes. If the value is neither t nor nil, compilation asks you whether to display the graph. The call tree only lists functions called, not macros used. Those functions which the byte-code interpreter knows about directly (eq, cons, etc.) are not reported. The call tree also lists those functions which are not known to be called \(that is, to which no calls have been compiled). Functions which can be invoked interactively are excluded from this list.") (defconst byte-compile-call-tree nil "Alist of functions and their call tree. Each element looks like \(FUNCTION CALLERS CALLS\) where CALLERS is a list of functions that call FUNCTION, and CALLS is a list of functions for which calls were generated while compiling FUNCTION.") (defvar byte-compile-call-tree-sort 'name "*If non-nil, sort the call tree. The values `name', `callers', `calls', `calls+callers' specify different fields to sort on.") ;; (defvar byte-compile-overwrite-file t ;; "If nil, old .elc files are deleted before the new is saved, and .elc ;; files will have the same modes as the corresponding .el file. Otherwise, ;; existing .elc files will simply be overwritten, and the existing modes ;; will not be changed. If this variable is nil, then an .elc file which ;; is a symbolic link will be turned into a normal file, instead of the file ;; which the link points to being overwritten.") (defvar byte-compile-constants nil "list of all constants encountered during compilation of this form") (defvar byte-compile-variables nil "list of all variables encountered during compilation of this form") (defvar byte-compile-bound-variables nil "list of variables bound in the context of the current form; this list lives partly on the stack.") (defvar byte-compile-free-references) (defvar byte-compile-free-assignments) (defvar byte-compiler-error-flag) (defconst byte-compile-initial-macro-environment '( ;; (byte-compiler-options . (lambda (&rest forms) ;; (apply 'byte-compiler-options-handler forms))) (eval-when-compile . (lambda (&rest body) (list 'quote (eval (byte-compile-top-level (cons 'progn body)))))) (eval-and-compile . (lambda (&rest body) (eval (cons 'progn body)) (cons 'progn body)))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") (defvar byte-compile-macro-environment byte-compile-initial-macro-environment "Alist of macros defined in the file being compiled. Each element looks like (MACRONAME . DEFINITION). It is \(MACRONAME . nil) when a macro is redefined as a function.") (defvar byte-compile-function-environment nil "Alist of functions defined in the file being compiled. This is so we can inline them when necessary. Each element looks like (FUNCTIONNAME . DEFINITION). It is \(FUNCTIONNAME . nil) when a function is redefined as a macro.") (defvar byte-compile-unresolved-functions nil "Alist of undefined functions to which calls have been compiled (used for warnings when the function is later defined with incorrect args).") (defvar byte-compile-tag-number 0) (defvar byte-compile-output nil "Alist describing contents to put in byte code string. Each element is (INDEX . VALUE)") (defvar byte-compile-depth 0 "Current depth of execution stack.") (defvar byte-compile-maxdepth 0 "Maximum depth of execution stack.") ;;; The byte codes; this information is duplicated in bytecomp.c (defconst byte-code-vector nil "An array containing byte-code names indexed by byte-code values.") (defconst byte-stack+-info nil "An array with the stack adjustment for each byte-code.") (defmacro byte-defop (opcode stack-adjust opname &optional docstring) ;; This is a speed-hack for building the byte-code-vector at compile-time. ;; We fill in the vector at macroexpand-time, and then after the last call ;; to byte-defop, we write the vector out as a constant instead of writing ;; out a bunch of calls to aset. ;; Actually, we don't fill in the vector itself, because that could make ;; it problematic to compile big changes to this compiler; we store the ;; values on its plist, and remove them later in -extrude. (let ((v1 (or (get 'byte-code-vector 'tmp-compile-time-value) (put 'byte-code-vector 'tmp-compile-time-value (make-vector 256 nil)))) (v2 (or (get 'byte-stack+-info 'tmp-compile-time-value) (put 'byte-stack+-info 'tmp-compile-time-value (make-vector 256 nil))))) (aset v1 opcode opname) (aset v2 opcode stack-adjust)) (if docstring (list 'defconst opname opcode (concat "Byte code opcode " docstring ".")) (list 'defconst opname opcode))) (defmacro byte-extrude-byte-code-vectors () (prog1 (list 'setq 'byte-code-vector (get 'byte-code-vector 'tmp-compile-time-value) 'byte-stack+-info (get 'byte-stack+-info 'tmp-compile-time-value)) ;; emacs-18 has no REMPROP. (put 'byte-code-vector 'tmp-compile-time-value nil) (put 'byte-stack+-info 'tmp-compile-time-value nil))) ;; unused: 0-7 ;; These opcodes are special in that they pack their argument into the ;; opcode word. ;; (byte-defop 8 1 byte-varref "for variable reference") (byte-defop 16 -1 byte-varset "for setting a variable") (byte-defop 24 -1 byte-varbind "for binding a variable") (byte-defop 32 0 byte-call "for calling a function") (byte-defop 40 0 byte-unbind "for unbinding special bindings") ;; codes 8-47 are consumed by the preceding opcodes ;; unused: 48-55 (byte-defop 56 -1 byte-nth) (byte-defop 57 0 byte-symbolp) (byte-defop 58 0 byte-consp) (byte-defop 59 0 byte-stringp) (byte-defop 60 0 byte-listp) (byte-defop 61 -1 byte-eq) (byte-defop 62 -1 byte-memq) (byte-defop 63 0 byte-not) (byte-defop 64 0 byte-car) (byte-defop 65 0 byte-cdr) (byte-defop 66 -1 byte-cons) (byte-defop 67 0 byte-list1) (byte-defop 68 -1 byte-list2) (byte-defop 69 -2 byte-list3) (byte-defop 70 -3 byte-list4) (byte-defop 71 0 byte-length) (byte-defop 72 -1 byte-aref) (byte-defop 73 -2 byte-aset) (byte-defop 74 0 byte-symbol-value) (byte-defop 75 0 byte-symbol-function) ; this was commented out (byte-defop 76 -1 byte-set) (byte-defop 77 -1 byte-fset) ; this was commented out (byte-defop 78 -1 byte-get) (byte-defop 79 -2 byte-substring) (byte-defop 80 -1 byte-concat2) (byte-defop 81 -2 byte-concat3) (byte-defop 82 -3 byte-concat4) (byte-defop 83 0 byte-sub1) (byte-defop 84 0 byte-add1) (byte-defop 85 -1 byte-eqlsign) (byte-defop 86 -1 byte-gtr) (byte-defop 87 -1 byte-lss) (byte-defop 88 -1 byte-leq) (byte-defop 89 -1 byte-geq) (byte-defop 90 -1 byte-diff) (byte-defop 91 0 byte-negate) (byte-defop 92 -1 byte-plus) (byte-defop 93 -1 byte-max) (byte-defop 94 -1 byte-min) (byte-defop 95 -1 byte-mult) ; v19 only (byte-defop 96 1 byte-point) (byte-defop 97 1 byte-mark-OBSOLETE) ; no longer generated as of v18 (byte-defop 98 0 byte-goto-char) (byte-defop 99 0 byte-insert) (byte-defop 100 1 byte-point-max) (byte-defop 101 1 byte-point-min) (byte-defop 102 0 byte-char-after) (byte-defop 103 1 byte-following-char) (byte-defop 104 1 byte-preceding-char) (byte-defop 105 1 byte-current-column) (byte-defop 106 0 byte-indent-to) (byte-defop 107 0 byte-scan-buffer-OBSOLETE) ; no longer generated as of v18 (byte-defop 108 1 byte-eolp) (byte-defop 109 1 byte-eobp) (byte-defop 110 1 byte-bolp) (byte-defop 111 1 byte-bobp) (byte-defop 112 1 byte-current-buffer) (byte-defop 113 0 byte-set-buffer) (byte-defop 114 1 byte-read-char-OBSOLETE) (byte-defop 115 0 byte-set-mark-OBSOLETE) (byte-defop 116 1 byte-interactive-p) ;; These ops are new to v19 (byte-defop 117 0 byte-forward-char) (byte-defop 118 0 byte-forward-word) (byte-defop 119 -1 byte-skip-chars-forward) (byte-defop 120 -1 byte-skip-chars-backward) (byte-defop 121 0 byte-forward-line) (byte-defop 122 0 byte-char-syntax) (byte-defop 123 -1 byte-buffer-substring) (byte-defop 124 -1 byte-delete-region) (byte-defop 125 -1 byte-narrow-to-region) (byte-defop 126 1 byte-widen) (byte-defop 127 0 byte-end-of-line) ;; unused: 128 ;; These store their argument in the next two bytes (byte-defop 129 1 byte-constant2 "for reference to a constant with vector index >= byte-constant-limit") (byte-defop 130 0 byte-goto "for unconditional jump") (byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil") (byte-defop 132 -1 byte-goto-if-not-nil "to pop value and jump if it's not nil") (byte-defop 133 -1 byte-goto-if-nil-else-pop "to examine top-of-stack, jump and don't pop it if it's nil, otherwise pop it") (byte-defop 134 -1 byte-goto-if-not-nil-else-pop "to examine top-of-stack, jump and don't pop it if it's non nil, otherwise pop it") (byte-defop 135 -1 byte-return "to pop a value and return it from `byte-code'") (byte-defop 136 -1 byte-discard "to discard one value from stack") (byte-defop 137 1 byte-dup "to duplicate the top of the stack") (byte-defop 138 0 byte-save-excursion "to make a binding to record the buffer, point and mark") (byte-defop 139 0 byte-save-window-excursion "to make a binding to record entire window configuration") (byte-defop 140 0 byte-save-restriction "to make a binding to record the current buffer clipping restrictions") (byte-defop 141 -1 byte-catch "for catch. Takes, on stack, the tag and an expression for the body") (byte-defop 142 -1 byte-unwind-protect "for unwind-protect. Takes, on stack, an expression for the unwind-action") ;; For condition-case. Takes, on stack, the variable to bind, ;; an expression for the body, and a list of clauses. (byte-defop 143 -2 byte-condition-case) ;; For entry to with-output-to-temp-buffer. ;; Takes, on stack, the buffer name. ;; Binds standard-output and does some other things. ;; Returns with temp buffer on the stack in place of buffer name. (byte-defop 144 0 byte-temp-output-buffer-setup) ;; For exit from with-output-to-temp-buffer. ;; Expects the temp buffer on the stack underneath value to return. ;; Pops them both, then pushes the value back on. ;; Unbinds standard-output and makes the temp buffer visible. (byte-defop 145 -1 byte-temp-output-buffer-show) ;; these ops are new to v19 ;; To unbind back to the beginning of this frame. ;; Not used yet, but will be needed for tail-recursion elimination. (byte-defop 146 0 byte-unbind-all) ;; these ops are new to v19 (byte-defop 147 -2 byte-set-marker) (byte-defop 148 0 byte-match-beginning) (byte-defop 149 0 byte-match-end) (byte-defop 150 0 byte-upcase) (byte-defop 151 0 byte-downcase) (byte-defop 152 -1 byte-string=) (byte-defop 153 -1 byte-string<) (byte-defop 154 -1 byte-equal) (byte-defop 155 -1 byte-nthcdr) (byte-defop 156 -1 byte-elt) (byte-defop 157 -1 byte-member) (byte-defop 158 -1 byte-assq) (byte-defop 159 0 byte-nreverse) (byte-defop 160 -1 byte-setcar) (byte-defop 161 -1 byte-setcdr) (byte-defop 162 0 byte-car-safe) (byte-defop 163 0 byte-cdr-safe) (byte-defop 164 -1 byte-nconc) (byte-defop 165 -1 byte-quo) (byte-defop 166 -1 byte-rem) (byte-defop 167 0 byte-numberp) (byte-defop 168 0 byte-integerp) ;; unused: 169-174 (byte-defop 175 nil byte-listN) (byte-defop 176 nil byte-concatN) (byte-defop 177 nil byte-insertN) ;; unused: 178-191 (byte-defop 192 1 byte-constant "for reference to a constant") ;; codes 193-255 are consumed by byte-constant. (defconst byte-constant-limit 64 "Exclusive maximum index usable in the `byte-constant' opcode.") (defconst byte-goto-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop byte-goto-if-not-nil-else-pop) "List of byte-codes whose offset is a pc.") (defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil)) (byte-extrude-byte-code-vectors) ;;; lapcode generator ;;; ;;; the byte-compiler now does source -> lapcode -> bytecode instead of ;;; source -> bytecode, because it's a lot easier to make optimizations ;;; on lapcode than on bytecode. ;;; ;;; Elements of the lapcode list are of the form ( . ) ;;; where instruction is a symbol naming a byte-code instruction, ;;; and parameter is an argument to that instruction, if any. ;;; ;;; The instruction can be the pseudo-op TAG, which means that this position ;;; in the instruction stream is a target of a goto. (car PARAMETER) will be ;;; the PC for this location, and the whole instruction "(TAG pc)" will be the ;;; parameter for some goto op. ;;; ;;; If the operation is varbind, varref, varset or push-constant, then the ;;; parameter is (variable/constant . index_in_constant_vector). ;;; ;;; First, the source code is macroexpanded and optimized in various ways. ;;; Then the resultant code is compiled into lapcode. Another set of ;;; optimizations are then run over the lapcode. Then the variables and ;;; constants referenced by the lapcode are collected and placed in the ;;; constants-vector. (This happens now so that variables referenced by dead ;;; code don't consume space.) And finally, the lapcode is transformed into ;;; compacted byte-code. ;;; ;;; A distinction is made between variables and constants because the variable- ;;; referencing instructions are more sensitive to the variables being near the ;;; front of the constants-vector than the constant-referencing instructions. ;;; Also, this lets us notice references to free variables. (defun byte-compile-lapcode (lap) "Turns lapcode into bytecode. The lapcode is destroyed." ;; Lapcode modifications: changes the ID of a tag to be the tag's PC. (let ((pc 0) ; Program counter op off ; Operation & offset (bytes '()) ; Put the output bytes here (patchlist nil) ; List of tags and goto's to patch rest rel tmp) (while lap (setq op (car (car lap)) off (cdr (car lap))) (cond ((not (symbolp op)) (error "Non-symbolic opcode `%s'" op)) ((eq op 'TAG) (setcar off pc) (setq patchlist (cons off patchlist))) ((memq op byte-goto-ops) (setq pc (+ pc 3)) (setq bytes (cons (cons pc (cdr off)) (cons nil (cons (symbol-value op) bytes)))) (setq patchlist (cons bytes patchlist))) (t (setq bytes (cond ((cond ((consp off) ;; Variable or constant reference (setq off (cdr off)) (eq op 'byte-constant))) (cond ((< off byte-constant-limit) (setq pc (1+ pc)) (cons (+ byte-constant off) bytes)) (t (setq pc (+ 3 pc)) (cons (lsh off -8) (cons (logand off 255) (cons byte-constant2 bytes)))))) ((<= byte-listN (symbol-value op)) (setq pc (+ 2 pc)) (cons off (cons (symbol-value op) bytes))) ((< off 6) (setq pc (1+ pc)) (cons (+ (symbol-value op) off) bytes)) ((< off 256) (setq pc (+ 2 pc)) (cons off (cons (+ (symbol-value op) 6) bytes))) (t (setq pc (+ 3 pc)) (cons (lsh off -8) (cons (logand off 255) (cons (+ (symbol-value op) 7) bytes)))))))) (setq lap (cdr lap))) ;;(if (not (= pc (length bytes))) ;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes))) ;; Patch PC into jumps (let (bytes) (while patchlist (setq bytes (car patchlist)) (cond ((atom (car bytes))) ; Tag (t ; Absolute jump (setq pc (car (cdr (car bytes)))) ; Pick PC from tag (setcar (cdr bytes) (logand pc 255)) (setcar bytes (lsh pc -8)))) (setq patchlist (cdr patchlist)))) (concat (nreverse bytes)))) ;;; byte compiler messages (defvar byte-compile-current-form nil) (defvar byte-compile-current-file nil) (defvar byte-compile-dest-file nil) (defmacro byte-compile-log (format-string &rest args) (list 'and 'byte-optimize '(memq byte-optimize-log '(t source)) (list 'let '((print-escape-newlines t) (print-level 4) (print-length 4)) (list 'byte-compile-log-1 (cons 'format (cons format-string (mapcar '(lambda (x) (if (symbolp x) (list 'prin1-to-string x) x)) args))))))) (defconst byte-compile-last-warned-form nil) ;; Log a message STRING in *Compile-Log*. ;; Also log the current function and file if not already done. (defun byte-compile-log-1 (string &optional fill) (cond (noninteractive (if (or byte-compile-current-file (and byte-compile-last-warned-form (not (eq byte-compile-current-form byte-compile-last-warned-form)))) (message (format "While compiling %s%s:" (or byte-compile-current-form "toplevel forms") (if byte-compile-current-file (if (stringp byte-compile-current-file) (concat " in file " byte-compile-current-file) (concat " in buffer " (buffer-name byte-compile-current-file))) "")))) (message " %s" string)) (t (save-excursion (set-buffer (get-buffer-create "*Compile-Log*")) (goto-char (point-max)) (cond ((or byte-compile-current-file (and byte-compile-last-warned-form (not (eq byte-compile-current-form byte-compile-last-warned-form)))) (if byte-compile-current-file (insert "\n\^L\n" (current-time-string) "\n")) (insert "While compiling " (if byte-compile-current-form (format "%s" byte-compile-current-form) "toplevel forms")) (if byte-compile-current-file (if (stringp byte-compile-current-file) (insert " in file " byte-compile-current-file) (insert " in buffer " (buffer-name byte-compile-current-file)))) (insert ":\n"))) (insert " " string "\n") (if (and fill (not (string-match "\n" string))) (let ((fill-prefix " ") (fill-column 78)) (fill-paragraph nil))) ))) (setq byte-compile-current-file nil byte-compile-last-warned-form byte-compile-current-form)) ;; Log the start of a file in *Compile-Log*, and mark it as done. ;; But do nothing in batch mode. (defun byte-compile-log-file () (and byte-compile-current-file (not noninteractive) (save-excursion (set-buffer (get-buffer-create "*Compile-Log*")) (goto-char (point-max)) (insert "\n\^L\nCompiling " (if (stringp byte-compile-current-file) (concat "file " byte-compile-current-file) (concat "buffer " (buffer-name byte-compile-current-file))) " at " (current-time-string) "\n") (setq byte-compile-current-file nil)))) (defun byte-compile-warn (format &rest args) (setq format (apply 'format format args)) (if byte-compile-error-on-warn (error "%s" format) ; byte-compile-file catches and logs it (byte-compile-log-1 (concat "** " format) t) ;;; It is useless to flash warnings too fast to be read. ;;; Besides, they will all be shown at the end. ;;; (or noninteractive ; already written on stdout. ;;; (message "Warning: %s" format)) )) ;;; This function should be used to report errors that have halted ;;; compilation of the current file. (defun byte-compile-report-error (error-info) (setq byte-compiler-error-flag t) (byte-compile-log-1 (concat "!! " (format (if (cdr error-info) "%s (%s)" "%s") (get (car error-info) 'error-message) (prin1-to-string (cdr error-info)))))) ;;; Used by make-obsolete. (defun byte-compile-obsolete (form) (let ((new (get (car form) 'byte-obsolete-info))) (if (memq 'obsolete byte-compile-warnings) (byte-compile-warn "%s is an obsolete function; %s" (car form) (if (stringp (car new)) (car new) (format "use %s instead." (car new))))) (funcall (or (cdr new) 'byte-compile-normal-call) form))) ;; Compiler options ;; (defvar byte-compiler-valid-options ;; '((optimize byte-optimize (t nil source byte) val) ;; (file-format byte-compile-compatibility (emacs18 emacs19) ;; (eq val 'emacs18)) ;; ;; (new-bytecodes byte-compile-generate-emacs19-bytecodes (t nil) val) ;; (delete-errors byte-compile-delete-errors (t nil) val) ;; (verbose byte-compile-verbose (t nil) val) ;; (warnings byte-compile-warnings ((callargs redefine free-vars unresolved)) ;; val))) ;; Inhibit v18/v19 selectors if the version is hardcoded. ;; #### This should print a warning if the user tries to change something ;; than can't be changed because the running compiler doesn't support it. ;; (cond ;; ((byte-compile-single-version) ;; (setcar (cdr (cdr (assq 'new-bytecodes byte-compiler-valid-options))) ;; (list (byte-compile-version-cond ;; byte-compile-generate-emacs19-bytecodes))) ;; (setcar (cdr (cdr (assq 'file-format byte-compiler-valid-options))) ;; (if (byte-compile-version-cond byte-compile-compatibility) ;; '(emacs18) '(emacs19))))) ;; (defun byte-compiler-options-handler (&rest args) ;; (let (key val desc choices) ;; (while args ;; (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args)))) ;; (error "Malformed byte-compiler option `%s'" (car args))) ;; (setq key (car (car args)) ;; val (car (cdr (car args))) ;; desc (assq key byte-compiler-valid-options)) ;; (or desc ;; (error "Unknown byte-compiler option `%s'" key)) ;; (setq choices (nth 2 desc)) ;; (if (consp (car choices)) ;; (let (this ;; (handler 'cons) ;; (ret (and (memq (car val) '(+ -)) ;; (copy-sequence (if (eq t (symbol-value (nth 1 desc))) ;; choices ;; (symbol-value (nth 1 desc))))))) ;; (setq choices (car choices)) ;; (while val ;; (setq this (car val)) ;; (cond ((memq this choices) ;; (setq ret (funcall handler this ret))) ;; ((eq this '+) (setq handler 'cons)) ;; ((eq this '-) (setq handler 'delq)) ;; ((error "`%s' only accepts %s" key choices))) ;; (setq val (cdr val))) ;; (set (nth 1 desc) ret)) ;; (or (memq val choices) ;; (error "`%s' must be one of `%s'" key choices)) ;; (set (nth 1 desc) (eval (nth 3 desc)))) ;; (setq args (cdr args))) ;; nil)) ;;; sanity-checking arglists (defun byte-compile-fdefinition (name macro-p) (let* ((list (if macro-p byte-compile-macro-environment byte-compile-function-environment)) (env (cdr (assq name list)))) (or env (let ((fn name)) (while (and (symbolp fn) (fboundp fn) (or (symbolp (symbol-function fn)) (consp (symbol-function fn)) (and (not macro-p) (byte-code-function-p (symbol-function fn))))) (setq fn (symbol-function fn))) (if (and (not macro-p) (byte-code-function-p fn)) fn (and (consp fn) (if (eq 'macro (car fn)) (cdr fn) (if macro-p nil (if (eq 'autoload (car fn)) nil fn))))))))) (defun byte-compile-arglist-signature (arglist) (let ((args 0) opts restp) (while arglist (cond ((eq (car arglist) '&optional) (or opts (setq opts 0))) ((eq (car arglist) '&rest) (if (cdr arglist) (setq restp t arglist nil))) (t (if opts (setq opts (1+ opts)) (setq args (1+ args))))) (setq arglist (cdr arglist))) (cons args (if restp nil (if opts (+ args opts) args))))) (defun byte-compile-arglist-signatures-congruent-p (old new) (not (or (> (car new) (car old)) ; requires more args now (and (null (cdr old)) ; tooks rest-args, doesn't any more (cdr new)) (and (cdr new) (cdr old) ; can't take as many args now (< (cdr new) (cdr old))) ))) (defun byte-compile-arglist-signature-string (signature) (cond ((null (cdr signature)) (format "%d+" (car signature))) ((= (car signature) (cdr signature)) (format "%d" (car signature))) (t (format "%d-%d" (car signature) (cdr signature))))) ;; Warn if the form is calling a function with the wrong number of arguments. (defun byte-compile-callargs-warn (form) (let* ((def (or (byte-compile-fdefinition (car form) nil) (byte-compile-fdefinition (car form) t))) (sig (and def (byte-compile-arglist-signature (if (eq 'lambda (car-safe def)) (nth 1 def) (if (byte-code-function-p def) (aref def 0) '(&rest def)))))) (ncall (length (cdr form)))) (if sig (if (or (< ncall (car sig)) (and (cdr sig) (> ncall (cdr sig)))) (byte-compile-warn "%s called with %d argument%s, but %s %s" (car form) ncall (if (= 1 ncall) "" "s") (if (< ncall (car sig)) "requires" "accepts only") (byte-compile-arglist-signature-string sig))) (or (fboundp (car form)) ; might be a subr or autoload. (eq (car form) byte-compile-current-form) ; ## this doesn't work with recursion. ;; It's a currently-undefined function. Remember number of args in call. (let ((cons (assq (car form) byte-compile-unresolved-functions)) (n (length (cdr form)))) (if cons (or (memq n (cdr cons)) (setcdr cons (cons n (cdr cons)))) (setq byte-compile-unresolved-functions (cons (list (car form) n) byte-compile-unresolved-functions)))))))) ;; Warn if the function or macro is being redefined with a different ;; number of arguments. (defun byte-compile-arglist-warn (form macrop) (let ((old (byte-compile-fdefinition (nth 1 form) macrop))) (if old (let ((sig1 (byte-compile-arglist-signature (if (eq 'lambda (car-safe old)) (nth 1 old) (if (byte-code-function-p old) (aref old 0) '(&rest def))))) (sig2 (byte-compile-arglist-signature (nth 2 form)))) (or (byte-compile-arglist-signatures-congruent-p sig1 sig2) (byte-compile-warn "%s %s used to take %s %s, now takes %s" (if (eq (car form) 'defun) "function" "macro") (nth 1 form) (byte-compile-arglist-signature-string sig1) (if (equal sig1 '(1 . 1)) "argument" "arguments") (byte-compile-arglist-signature-string sig2)))) ;; This is the first definition. See if previous calls are compatible. (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions)) nums sig min max) (if calls (progn (setq sig (byte-compile-arglist-signature (nth 2 form)) nums (sort (copy-sequence (cdr calls)) (function <)) min (car nums) max (car (nreverse nums))) (if (or (< min (car sig)) (and (cdr sig) (> max (cdr sig)))) (byte-compile-warn "%s being defined to take %s%s, but was previously called with %s" (nth 1 form) (byte-compile-arglist-signature-string sig) (if (equal sig '(1 . 1)) " arg" " args") (byte-compile-arglist-signature-string (cons min max)))) (setq byte-compile-unresolved-functions (delq calls byte-compile-unresolved-functions))))) ))) ;; If we have compiled any calls to functions which are not known to be ;; defined, issue a warning enumerating them. ;; `unresolved' in the list `byte-compile-warnings' disables this. (defun byte-compile-warn-about-unresolved-functions () (if (memq 'unresolved byte-compile-warnings) (let ((byte-compile-current-form "the end of the data")) (if (cdr byte-compile-unresolved-functions) (let* ((str "The following functions are not known to be defined: ") (L (length str)) (rest (reverse byte-compile-unresolved-functions)) s) (while rest (setq s (symbol-name (car (car rest))) L (+ L (length s) 2) rest (cdr rest)) (if (< L (1- fill-column)) (setq str (concat str " " s (and rest ","))) (setq str (concat str "\n " s (and rest ",")) L (+ (length s) 4)))) (byte-compile-warn "%s" str)) (if byte-compile-unresolved-functions (byte-compile-warn "the function %s is not known to be defined." (car (car byte-compile-unresolved-functions))))))) nil) (defmacro byte-compile-constp (form) ;; Returns non-nil if FORM is a constant. (` (cond ((consp (, form)) (eq (car (, form)) 'quote)) ((not (symbolp (, form)))) ((memq (, form) '(nil t)))))) (defmacro byte-compile-close-variables (&rest body) (cons 'let (cons '(;; ;; Close over these variables to encapsulate the ;; compilation state ;; (byte-compile-macro-environment ;; Copy it because the compiler may patch into the ;; macroenvironment. (copy-alist byte-compile-initial-macro-environment)) (byte-compile-function-environment nil) (byte-compile-bound-variables nil) (byte-compile-free-references nil) (byte-compile-free-assignments nil) ;; ;; Close over these variables so that `byte-compiler-options' ;; can change them on a per-file basis. ;; (byte-compile-verbose byte-compile-verbose) (byte-optimize byte-optimize) (byte-compile-compatibility byte-compile-compatibility) (byte-compile-dynamic byte-compile-dynamic) (byte-compile-dynamic-docstrings byte-compile-dynamic-docstrings) ;; (byte-compile-generate-emacs19-bytecodes ;; byte-compile-generate-emacs19-bytecodes) (byte-compile-warnings (if (eq byte-compile-warnings t) byte-compile-warning-types byte-compile-warnings)) ) body))) (defvar byte-compile-warnings-point-max nil) (defmacro displaying-byte-compile-warnings (&rest body) (list 'let '((byte-compile-warnings-point-max byte-compile-warnings-point-max)) ;; Log the file name. '(byte-compile-log-file) ;; Record how much is logged now. ;; We will display the log buffer if anything more is logged ;; before the end of BODY. '(or byte-compile-warnings-point-max (save-excursion (set-buffer (get-buffer-create "*Compile-Log*")) (setq byte-compile-warnings-point-max (point-max)))) (list 'unwind-protect (list 'condition-case 'error-info (cons 'progn body) '(error (byte-compile-report-error error-info))) '(save-excursion ;; If there were compilation warnings, display them. (set-buffer "*Compile-Log*") (if (= byte-compile-warnings-point-max (point-max)) nil (select-window (prog1 (selected-window) (select-window (display-buffer (current-buffer))) (goto-char byte-compile-warnings-point-max) (recenter 1)))))))) ;;;###autoload (defun byte-force-recompile (directory) "Recompile every `.el' file in DIRECTORY that already has a `.elc' file. Files in subdirectories of DIRECTORY are processed also." (interactive "DByte force recompile (directory): ") (byte-recompile-directory directory nil t)) ;;;###autoload (defun byte-recompile-directory (directory &optional arg force) "Recompile every `.el' file in DIRECTORY that needs recompilation. This is if a `.elc' file exists but is older than the `.el' file. Files in subdirectories of DIRECTORY are processed also. If the `.elc' file does not exist, normally the `.el' file is *not* compiled. But a prefix argument (optional second arg) means ask user, for each such `.el' file, whether to compile it. Prefix argument 0 means don't ask and compile the file anyway. A nonzero prefix argument also means ask about each subdirectory. If the third argument FORCE is non-nil, recompile every `.el' file that already has a `.elc' file." (interactive "DByte recompile directory: \nP") (if arg (setq arg (prefix-numeric-value arg))) (if noninteractive nil (save-some-buffers) (force-mode-line-update)) (let ((directories (list (expand-file-name directory))) (file-count 0) (dir-count 0) last-dir) (displaying-byte-compile-warnings (while directories (setq directory (car directories)) (or noninteractive (message "Checking %s..." directory)) (let ((files (directory-files directory)) source dest) (while files (setq source (expand-file-name (car files) directory)) (if (and (not (member (car files) '("." ".." "RCS" "CVS"))) (file-directory-p source) (not (file-symlink-p source))) ;; This file is a subdirectory. Handle them differently. (if (or (null arg) (eq 0 arg) (y-or-n-p (concat "Check " source "? "))) (setq directories (nconc directories (list source)))) ;; It is an ordinary file. Decide whether to compile it. (if (and (string-match emacs-lisp-file-regexp source) (not (auto-save-file-name-p source)) (setq dest (byte-compile-dest-file source)) (if (file-exists-p dest) ;; File was already compiled. (or force (file-newer-than-file-p source dest)) ;; No compiled file exists yet. (and arg (or (eq 0 arg) (y-or-n-p (concat "Compile " source "? ")))))) (progn (if (and noninteractive (not byte-compile-verbose)) (message "Compiling %s..." source)) (byte-compile-file source) (or noninteractive (message "Checking %s..." directory)) (setq file-count (1+ file-count)) (if (not (eq last-dir directory)) (setq last-dir directory dir-count (1+ dir-count))) ))) (setq files (cdr files)))) (setq directories (cdr directories)))) (message "Done (Total of %d file%s compiled%s)" file-count (if (= file-count 1) "" "s") (if (> dir-count 1) (format " in %d directories" dir-count) "")))) ;;;###autoload (defun byte-compile-file (filename &optional load) "Compile a file of Lisp code named FILENAME into a file of byte code. The output file's name is made by appending `c' to the end of FILENAME. With prefix arg (noninteractively: 2nd arg), load the file after compiling." ;; (interactive "fByte compile file: \nP") (interactive (let ((file buffer-file-name) (file-name nil) (file-dir nil)) (and file (eq (cdr (assq 'major-mode (buffer-local-variables))) 'emacs-lisp-mode) (setq file-name (file-name-nondirectory file) file-dir (file-name-directory file))) (list (read-file-name (if current-prefix-arg "Byte compile and load file: " "Byte compile file: ") file-dir file-name nil) current-prefix-arg))) ;; Expand now so we get the current buffer's defaults (setq filename (expand-file-name filename)) ;; If we're compiling a file that's in a buffer and is modified, offer ;; to save it first. (or noninteractive (let ((b (get-file-buffer (expand-file-name filename)))) (if (and b (buffer-modified-p b) (y-or-n-p (format "save buffer %s first? " (buffer-name b)))) (save-excursion (set-buffer b) (save-buffer))))) (if byte-compile-verbose (message "Compiling %s..." filename)) (let ((byte-compile-current-file filename) target-file input-buffer output-buffer byte-compile-dest-file) (setq target-file (byte-compile-dest-file filename)) (setq byte-compile-dest-file target-file) (save-excursion (setq input-buffer (get-buffer-create " *Compiler Input*")) (set-buffer input-buffer) (erase-buffer) (insert-file-contents filename) ;; Run hooks including the uncompression hook. ;; If they change the file name, then change it for the output also. (let ((buffer-file-name filename) (default-major-mode 'emacs-lisp-mode) (enable-local-eval nil)) (normal-mode) (setq filename buffer-file-name))) (setq byte-compiler-error-flag nil) ;; It is important that input-buffer not be current at this call, ;; so that the value of point set in input-buffer ;; within byte-compile-from-buffer lingers in that buffer. (setq output-buffer (byte-compile-from-buffer input-buffer filename)) (if byte-compiler-error-flag nil (if byte-compile-verbose (message "Compiling %s...done" filename)) (kill-buffer input-buffer) (save-excursion (set-buffer output-buffer) (goto-char (point-max)) (insert "\n") ; aaah, unix. (let ((vms-stmlf-recfm t)) (if (file-writable-p target-file) (let ((kanji-flag nil)) ; for nemacs, from Nakagawa Takayuki (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt)) (setq buffer-file-type t)) (write-region 1 (point-max) target-file)) ;; This is just to give a better error message than ;; write-region (signal 'file-error (list "Opening output file" (if (file-exists-p target-file) "cannot overwrite file" "directory not writable or nonexistent") target-file)))) (kill-buffer (current-buffer))) (if (and byte-compile-generate-call-tree (or (eq t byte-compile-generate-call-tree) (y-or-n-p (format "Report call tree for %s? " filename)))) (save-excursion (display-call-tree filename))) (if load (load target-file)) t))) ;;(defun byte-compile-and-load-file (&optional filename) ;; "Compile a file of Lisp code named FILENAME into a file of byte code, ;;and then load it. The output file's name is made by appending \"c\" to ;;the end of FILENAME." ;; (interactive) ;; (if filename ; I don't get it, (interactive-p) doesn't always work ;; (byte-compile-file filename t) ;; (let ((current-prefix-arg '(4))) ;; (call-interactively 'byte-compile-file)))) ;;(defun byte-compile-buffer (&optional buffer) ;; "Byte-compile and evaluate contents of BUFFER (default: the current buffer)." ;; (interactive "bByte compile buffer: ") ;; (setq buffer (if buffer (get-buffer buffer) (current-buffer))) ;; (message "Compiling %s..." (buffer-name buffer)) ;; (let* ((filename (or (buffer-file-name buffer) ;; (concat "#"))) ;; (byte-compile-current-file buffer)) ;; (byte-compile-from-buffer buffer nil)) ;; (message "Compiling %s...done" (buffer-name buffer)) ;; t) ;;; compiling a single function ;;;###autoload (defun compile-defun (&optional arg) "Compile and evaluate the current top-level form. Print the result in the minibuffer. With argument, insert value in current buffer after the form." (interactive "P") (save-excursion (end-of-defun) (beginning-of-defun) (let* ((byte-compile-current-file nil) (byte-compile-last-warned-form 'nothing) (value (eval (displaying-byte-compile-warnings (byte-compile-sexp (read (current-buffer))))))) (cond (arg (message "Compiling from buffer... done.") (prin1 value (current-buffer)) (insert "\n")) ((message "%s" (prin1-to-string value))))))) (defun byte-compile-from-buffer (inbuffer &optional filename) ;; Filename is used for the loading-into-Emacs-18 error message. (let (outbuffer ;; Prevent truncation of flonums and lists as we read and print them (float-output-format nil) (case-fold-search nil) (print-length nil) (print-level nil) ;; Simulate entry to byte-compile-top-level (byte-compile-constants nil) (byte-compile-variables nil) (byte-compile-tag-number 0) (byte-compile-depth 0) (byte-compile-maxdepth 0) (byte-compile-output nil) ;; #### This is bound in b-c-close-variables. ;; (byte-compile-warnings (if (eq byte-compile-warnings t) ;; byte-compile-warning-types ;; byte-compile-warnings)) ) (byte-compile-close-variables (save-excursion (setq outbuffer (set-buffer (get-buffer-create " *Compiler Output*"))) (erase-buffer) ;; (emacs-lisp-mode) (setq case-fold-search nil) (and filename (byte-compile-insert-header filename inbuffer outbuffer)) ;; This is a kludge. Some operating systems (OS/2, DOS) need to ;; write files containing binary information specially. ;; Under most circumstances, such files will be in binary ;; overwrite mode, so those OS's use that flag to guess how ;; they should write their data. Advise them that .elc files ;; need to be written carefully. (setq overwrite-mode 'overwrite-mode-binary)) (displaying-byte-compile-warnings (save-excursion (set-buffer inbuffer) (goto-char 1) ;; Compile the forms from the input buffer. (while (progn (while (progn (skip-chars-forward " \t\n\^l") (looking-at ";")) (forward-line 1)) (not (eobp))) (byte-compile-file-form (read inbuffer))) ;; Compile pending forms at end of file. (byte-compile-flush-pending) (byte-compile-warn-about-unresolved-functions) ;; SHould we always do this? When calling multiple files, it ;; would be useful to delay this warning until all have ;; been compiled. (setq byte-compile-unresolved-functions nil)))) outbuffer)) (defun byte-compile-insert-header (filename inbuffer outbuffer) (set-buffer inbuffer) (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) (set-buffer outbuffer) (goto-char 1) ;; ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After that is ;; the file-format version number (18 or 19) as a byte, followed by some ;; nulls. The primary motivation for doing this is to get some binary ;; characters up in the first line of the file so that `diff' will simply ;; say "Binary files differ" instead of actually doing a diff of two .elc ;; files. An extra benefit is that you can add this to /etc/magic: ;; ;; 0 string ;ELC GNU Emacs Lisp compiled file, ;; >4 byte x version %d ;; (insert ";ELC" (if (byte-compile-version-cond byte-compile-compatibility) 18 19) "\000\000\000\n" ) (insert ";;; compiled by " (or (and (boundp 'user-mail-address) user-mail-address) (concat (user-login-name) "@" (system-name))) " on " (current-time-string) "\n;;; from file " filename "\n") (insert ";;; emacs version " emacs-version ".\n") (insert ";;; bytecomp version " byte-compile-version "\n;;; " (cond ((eq byte-optimize 'source) "source-level optimization only") ((eq byte-optimize 'byte) "byte-level optimization only") (byte-optimize "optimization is on") (t "optimization is off")) (if (byte-compile-version-cond byte-compile-compatibility) "; compiled with Emacs 18 compatibility.\n" ".\n")) (if (not (byte-compile-version-cond byte-compile-compatibility)) (insert ";;; this file uses opcodes which do not exist in Emacs 18.\n" ;; Have to check if emacs-version is bound so that this works ;; in files loaded early in loadup.el. "\n(if (and (boundp 'emacs-version)\n" "\t (or (and (boundp 'epoch::version) epoch::version)\n" (if dynamic-docstrings "\t (string-lessp emacs-version \"19.29\")))\n" "\t (string-lessp emacs-version \"19\")))\n") " (error \"`" ;; prin1-to-string is used to quote backslashes. (substring (prin1-to-string (file-name-nondirectory filename)) 1 -1) (if dynamic-docstrings "' was compiled for Emacs 19.29 or later\"))\n\n" "' was compiled for Emacs 19\"))\n\n")) (insert "(or (boundp 'current-load-list) (setq current-load-list nil))\n" "\n") ))) (defun byte-compile-output-file-form (form) ;; writes the given form to the output buffer, being careful of docstrings ;; in defun, defmacro, defvar, defconst and autoload because make-docfile is ;; so amazingly stupid. ;; defalias calls are output directly by byte-compile-file-form-defmumble; ;; it does not pay to first build the defalias in defmumble and then parse ;; it here. (if (and (memq (car-safe form) '(defun defmacro defvar defconst autoload)) (stringp (nth 3 form))) (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil (eq (car form) 'autoload)) (let ((print-escape-newlines t) (print-length nil) (print-level nil) (print-readably t) ; print #[] for bytecode, 'x for (quote x) (print-gensym nil)) ; this is too dangerous for now (princ "\n" outbuffer) (prin1 form outbuffer) nil))) (defun byte-compile-output-docform (preface name info form specindex quoted) "Print a form with a doc string. INFO is (prefix doc-index postfix). If PREFACE and NAME are non-nil, print them too, before INFO and the FORM but after the doc string itself. If SPECINDEX is non-nil, it is the index in FORM of the function bytecode string. In that case, we output that argument and the following argument (the constants vector) together, for lazy loading. QUOTED says that we have to put a quote before the list that represents a doc string reference. `autoload' needs that." ;; We need to examine byte-compile-dynamic-docstrings ;; in the input buffer (now current), not in the output buffer. (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) (set-buffer (prog1 (current-buffer) (set-buffer outbuffer) (let (position) ;; Insert the doc string, and make it a comment with #@LENGTH. (and (>= (nth 1 info) 0) dynamic-docstrings (progn ;; Make the doc string start at beginning of line ;; for make-docfile's sake. (insert "\n") (setq position (byte-compile-output-as-comment (nth (nth 1 info) form) nil)) ;; If the doc string starts with * (a user variable), ;; negate POSITION. (if (and (stringp (nth (nth 1 info) form)) (> (length (nth (nth 1 info) form)) 0) (eq (aref (nth (nth 1 info) form) 0) ?*)) (setq position (- position))))) (if preface (progn (insert preface) (prin1 name outbuffer))) (insert (car info)) (let ((print-escape-newlines t) (print-readably t) ; print #[] for bytecode, 'x for (quote x) (print-gensym nil) ; this is too dangerous for now (index 0)) (prin1 (car form) outbuffer) (while (setq form (cdr form)) (setq index (1+ index)) (insert " ") (cond ((and (numberp specindex) (= index specindex)) (let ((position (byte-compile-output-as-comment (cons (car form) (nth 1 form)) t))) (princ (format "(#$ . %d) nil" position) outbuffer) (setq form (cdr form)) (setq index (1+ index)))) ((= index (nth 1 info)) (if position (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") position) outbuffer) (let ((print-escape-newlines nil)) (goto-char (prog1 (1+ (point)) (prin1 (car form) outbuffer))) (insert "\\\n") (goto-char (point-max))))) (t (prin1 (car form) outbuffer))))) (insert (nth 2 info)))))) nil) (defun byte-compile-keep-pending (form &optional handler) (if (memq byte-optimize '(t source)) (setq form (byte-optimize-form form t))) (if handler (let ((for-effect t)) ;; To avoid consing up monstrously large forms at load time, we split ;; the output regularly. (and (memq (car-safe form) '(fset defalias)) (nthcdr 300 byte-compile-output) (byte-compile-flush-pending)) (funcall handler form) (if for-effect (byte-compile-discard))) (byte-compile-form form t)) nil) (defun byte-compile-flush-pending () (if byte-compile-output (let ((form (byte-compile-out-toplevel t 'file))) (cond ((eq (car-safe form) 'progn) (mapcar 'byte-compile-output-file-form (cdr form))) (form (byte-compile-output-file-form form))) (setq byte-compile-constants nil byte-compile-variables nil byte-compile-depth 0 byte-compile-maxdepth 0 byte-compile-output nil)))) (defun byte-compile-file-form (form) (let ((byte-compile-current-form nil) ; close over this for warnings. handler) (cond ((not (consp form)) (byte-compile-keep-pending form)) ((and (symbolp (car form)) (setq handler (get (car form) 'byte-hunk-handler))) (cond ((setq form (funcall handler form)) (byte-compile-flush-pending) (byte-compile-output-file-form form)))) ((eq form (setq form (macroexpand form byte-compile-macro-environment))) (byte-compile-keep-pending form)) (t (byte-compile-file-form form))))) ;; Functions and variables with doc strings must be output separately, ;; so make-docfile can recognise them. Most other things can be output ;; as byte-code. (put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst) (defun byte-compile-file-form-defsubst (form) (cond ((assq (nth 1 form) byte-compile-unresolved-functions) (setq byte-compile-current-form (nth 1 form)) (byte-compile-warn "defsubst %s was used before it was defined" (nth 1 form)))) (byte-compile-file-form (macroexpand form byte-compile-macro-environment)) ;; Return nil so the form is not output twice. nil) (put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload) (defun byte-compile-file-form-autoload (form) (and (let ((form form)) (while (if (setq form (cdr form)) (byte-compile-constp (car form)))) (null form)) ;Constants only (eval (nth 5 form)) ;Macro (eval form)) ;Define the autoload. (if (stringp (nth 3 form)) form ;; No doc string, so we can compile this as a normal form. (byte-compile-keep-pending form 'byte-compile-normal-call))) (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar) (defun byte-compile-file-form-defvar (form) (if (null (nth 3 form)) ;; Since there is no doc string, we can compile this as a normal form, ;; and not do a file-boundary. (byte-compile-keep-pending form) (if (memq 'free-vars byte-compile-warnings) (setq byte-compile-bound-variables (cons (nth 1 form) byte-compile-bound-variables))) (cond ((consp (nth 2 form)) (setq form (copy-sequence form)) (setcar (cdr (cdr form)) (byte-compile-top-level (nth 2 form) nil 'file)))) form)) (put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary) (defun byte-compile-file-form-eval-boundary (form) (eval form) (byte-compile-keep-pending form 'byte-compile-normal-call)) (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) (put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn) (put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn) (defun byte-compile-file-form-progn (form) (mapcar 'byte-compile-file-form (cdr form)) ;; Return nil so the forms are not output twice. nil) ;; This handler is not necessary, but it makes the output from dont-compile ;; and similar macros cleaner. (put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval) (defun byte-compile-file-form-eval (form) (if (eq (car-safe (nth 1 form)) 'quote) (nth 1 (nth 1 form)) (byte-compile-keep-pending form))) (put 'defun 'byte-hunk-handler 'byte-compile-file-form-defun) (defun byte-compile-file-form-defun (form) (byte-compile-file-form-defmumble form nil)) (put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro) (defun byte-compile-file-form-defmacro (form) (byte-compile-file-form-defmumble form t)) (defun byte-compile-file-form-defmumble (form macrop) (let* ((name (car (cdr form))) (this-kind (if macrop 'byte-compile-macro-environment 'byte-compile-function-environment)) (that-kind (if macrop 'byte-compile-function-environment 'byte-compile-macro-environment)) (this-one (assq name (symbol-value this-kind))) (that-one (assq name (symbol-value that-kind))) (byte-compile-free-references nil) (byte-compile-free-assignments nil)) ;; When a function or macro is defined, add it to the call tree so that ;; we can tell when functions are not used. (if byte-compile-generate-call-tree (or (assq name byte-compile-call-tree) (setq byte-compile-call-tree (cons (list name nil nil) byte-compile-call-tree)))) (setq byte-compile-current-form name) ; for warnings (if (memq 'redefine byte-compile-warnings) (byte-compile-arglist-warn form macrop)) (if byte-compile-verbose (message "Compiling %s... (%s)" (or filename "") (nth 1 form))) (cond (that-one (if (and (memq 'redefine byte-compile-warnings) ;; don't warn when compiling the stubs in byte-run... (not (assq (nth 1 form) byte-compile-initial-macro-environment))) (byte-compile-warn "%s defined multiple times, as both function and macro" (nth 1 form))) (setcdr that-one nil)) (this-one (if (and (memq 'redefine byte-compile-warnings) ;; hack: don't warn when compiling the magic internal ;; byte-compiler macros in byte-run.el... (not (assq (nth 1 form) byte-compile-initial-macro-environment))) (byte-compile-warn "%s %s defined multiple times in this file" (if macrop "macro" "function") (nth 1 form)))) ((and (fboundp name) (eq (car-safe (symbol-function name)) (if macrop 'lambda 'macro))) (if (memq 'redefine byte-compile-warnings) (byte-compile-warn "%s %s being redefined as a %s" (if macrop "function" "macro") (nth 1 form) (if macrop "macro" "function"))) ;; shadow existing definition (set this-kind (cons (cons name nil) (symbol-value this-kind)))) ) (let ((body (nthcdr 3 form))) (if (and (stringp (car body)) (symbolp (car-safe (cdr-safe body))) (car-safe (cdr-safe body)) (stringp (car-safe (cdr-safe (cdr-safe body))))) (byte-compile-warn "Probable `\"' without `\\' in doc string of %s" (nth 1 form)))) (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form)))) (code (byte-compile-byte-code-maker new-one))) (if this-one (setcdr this-one new-one) (set this-kind (cons (cons name new-one) (symbol-value this-kind)))) (if (and (stringp (nth 3 form)) (eq 'quote (car-safe code)) (eq 'lambda (car-safe (nth 1 code)))) (cons (car form) (cons name (cdr (nth 1 code)))) (byte-compile-flush-pending) (if (not (stringp (nth 3 form))) ;; No doc string. Provide -1 as the "doc string index" ;; so that no element will be treated as a doc string. (byte-compile-output-docform (if (byte-compile-version-cond byte-compile-compatibility) "\n(fset '" "\n(defalias '") name (cond ((atom code) (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))) ((eq (car code) 'quote) (setq code new-one) (if macrop '(" '(macro " -1 ")") '(" '(" -1 ")"))) ((if macrop '(" (cons 'macro (" -1 "))") '(" (" -1 ")")))) (append code nil) (and (atom code) byte-compile-dynamic 1) nil) ;; Output the form by hand, that's much simpler than having ;; b-c-output-file-form analyze the defalias. (byte-compile-output-docform (if (byte-compile-version-cond byte-compile-compatibility) "\n(fset '" "\n(defalias '") name (cond ((atom code) (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))) ((eq (car code) 'quote) (setq code new-one) (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")"))) ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")")))) (append code nil) (and (atom code) byte-compile-dynamic 1) nil)) (princ ")" outbuffer) nil)))) ;; Print Lisp object EXP in the output file, inside a comment, ;; and return the file position it will have. ;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting. (defun byte-compile-output-as-comment (exp quoted) (let ((position (point))) (set-buffer (prog1 (current-buffer) (set-buffer outbuffer) ;; Insert EXP, and make it a comment with #@LENGTH. (insert " ") (if quoted (prin1 exp outbuffer) (princ exp outbuffer)) (goto-char position) ;; Quote certain special characters as needed. ;; get_doc_string in doc.c does the unquoting. (while (search-forward "\^A" nil t) (replace-match "\^A\^A" t t)) (goto-char position) (while (search-forward "\000" nil t) (replace-match "\^A0" t t)) (goto-char position) (while (search-forward "\037" nil t) (replace-match "\^A_" t t)) (goto-char (point-max)) (insert "\037") (goto-char position) (insert "#@" (format "%d" (- (point-max) position))) ;; Save the file position of the object. ;; Note we should add 1 to skip the space ;; that we inserted before the actual doc string, ;; and subtract 1 to convert from an 1-origin Emacs position ;; to a file position; they cancel. (setq position (point)) (goto-char (point-max)))) position)) ;;;###autoload (defun byte-compile (form) "If FORM is a symbol, byte-compile its function definition. If FORM is a lambda or a macro, byte-compile it as a function." (displaying-byte-compile-warnings (byte-compile-close-variables (let* ((fun (if (symbolp form) (and (fboundp form) (symbol-function form)) form)) (macro (eq (car-safe fun) 'macro))) (if macro (setq fun (cdr fun))) (cond ((eq (car-safe fun) 'lambda) (setq fun (if macro (cons 'macro (byte-compile-lambda fun)) (byte-compile-lambda fun))) (if (symbolp form) (defalias form fun) fun))))))) (defun byte-compile-sexp (sexp) "Compile and return SEXP." (displaying-byte-compile-warnings (byte-compile-close-variables (byte-compile-top-level sexp)))) ;; Given a function made by byte-compile-lambda, make a form which produces it. (defun byte-compile-byte-code-maker (fun) (cond ((byte-compile-version-cond byte-compile-compatibility) ;; Return (quote (lambda ...)). (list 'quote (byte-compile-byte-code-unmake fun))) ;; ## atom is faster than compiled-func-p. ((atom fun) ; compiled function. ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda ;; would have produced a lambda. fun) ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial ;; function, or this is Emacs 18, or generate-emacs19-bytecodes is off. ((let (tmp) (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun)))) (null (cdr (memq tmp fun)))) ;; Generate a make-byte-code call. (let* ((interactive (assq 'interactive (cdr (cdr fun))))) (nconc (list 'make-byte-code (list 'quote (nth 1 fun)) ;arglist (nth 1 tmp) ;bytes (nth 2 tmp) ;consts (nth 3 tmp)) ;depth (cond ((stringp (nth 2 fun)) (list (nth 2 fun))) ;doc (interactive (list nil))) (cond (interactive (list (if (or (null (nth 1 interactive)) (stringp (nth 1 interactive))) (nth 1 interactive) ;; Interactive spec is a list or a variable ;; (if it is correct). (list 'quote (nth 1 interactive)))))))) ;; a non-compiled function (probably trivial) (list 'quote fun)))))) ;; Turn a function into an ordinary lambda. Needed for v18 files. (defun byte-compile-byte-code-unmake (function) (if (consp function) function;;It already is a lambda. (setq function (append function nil)) ; turn it into a list (nconc (list 'lambda (nth 0 function)) (and (nth 4 function) (list (nth 4 function))) (if (nthcdr 5 function) (list (cons 'interactive (if (nth 5 function) (nthcdr 5 function))))) (list (list 'byte-code (nth 1 function) (nth 2 function) (nth 3 function)))))) ;; Byte-compile a lambda-expression and return a valid function. ;; The value is usually a compiled function but may be the original ;; lambda-expression. (defun byte-compile-lambda (fun) (let* ((arglist (nth 1 fun)) (byte-compile-bound-variables (nconc (and (memq 'free-vars byte-compile-warnings) (delq '&rest (delq '&optional (copy-sequence arglist)))) byte-compile-bound-variables)) (body (cdr (cdr fun))) (doc (if (stringp (car body)) (prog1 (car body) (setq body (cdr body))))) (int (assq 'interactive body))) (cond (int ;; Skip (interactive) if it is in front (the most usual location). (if (eq int (car body)) (setq body (cdr body))) (cond ((consp (cdr int)) (if (cdr (cdr int)) (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string int))) ;; If the interactive spec is a call to `list', ;; don't compile it, because `call-interactively' ;; looks at the args of `list'. (let ((form (nth 1 int))) (while (or (eq (car-safe form) 'let) (eq (car-safe form) 'let*) (eq (car-safe form) 'save-excursion)) (while (consp (cdr form)) (setq form (cdr form))) (setq form (car form))) (or (eq (car-safe form) 'list) (setq int (list 'interactive (byte-compile-top-level (nth 1 int))))))) ((cdr int) (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string int)))))) (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda))) (if (and (eq 'byte-code (car-safe compiled)) (not (byte-compile-version-cond byte-compile-compatibility))) (apply 'make-byte-code (append (list arglist) ;; byte-string, constants-vector, stack depth (cdr compiled) ;; optionally, the doc string. (if (or doc int) (list doc)) ;; optionally, the interactive spec. (if int (list (nth 1 int))))) (setq compiled (nconc (if int (list int)) (cond ((eq (car-safe compiled) 'progn) (cdr compiled)) (compiled (list compiled))))) (nconc (list 'lambda arglist) (if (or doc (stringp (car compiled))) (cons doc (cond (compiled) (body (list nil)))) compiled)))))) (defun byte-compile-constants-vector () ;; Builds the constants-vector from the current variables and constants. ;; This modifies the constants from (const . nil) to (const . offset). ;; To keep the byte-codes to look up the vector as short as possible: ;; First 6 elements are vars, as there are one-byte varref codes for those. ;; Next up to byte-constant-limit are constants, still with one-byte codes. ;; Next variables again, to get 2-byte codes for variable lookup. ;; The rest of the constants and variables need 3-byte byte-codes. (let* ((i -1) (rest (nreverse byte-compile-variables)) ; nreverse because the first (other (nreverse byte-compile-constants)) ; vars often are used most. ret tmp (limits '(5 ; Use the 1-byte varref codes, 63 ; 1-constlim ; 1-byte byte-constant codes, 255 ; 2-byte varref codes, 65535)) ; 3-byte codes for the rest. limit) (while (or rest other) (setq limit (car limits)) (while (and rest (not (eq i limit))) (if (setq tmp (assq (car (car rest)) ret)) (setcdr (car rest) (cdr tmp)) (setcdr (car rest) (setq i (1+ i))) (setq ret (cons (car rest) ret))) (setq rest (cdr rest))) (setq limits (cdr limits) rest (prog1 other (setq other rest)))) (apply 'vector (nreverse (mapcar 'car ret))))) ;; Given an expression FORM, compile it and return an equivalent byte-code ;; expression (a call to the function byte-code). (defun byte-compile-top-level (form &optional for-effect output-type) ;; OUTPUT-TYPE advises about how form is expected to be used: ;; 'eval or nil -> a single form, ;; 'progn or t -> a list of forms, ;; 'lambda -> body of a lambda, ;; 'file -> used at file-level. (let ((byte-compile-constants nil) (byte-compile-variables nil) (byte-compile-tag-number 0) (byte-compile-depth 0) (byte-compile-maxdepth 0) (byte-compile-output nil)) (if (memq byte-optimize '(t source)) (setq form (byte-optimize-form form for-effect))) (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form)))) (setq form (nth 1 form))) (if (and (eq 'byte-code (car-safe form)) (not (memq byte-optimize '(t byte))) (stringp (nth 1 form)) (vectorp (nth 2 form)) (natnump (nth 3 form))) form (byte-compile-form form for-effect) (byte-compile-out-toplevel for-effect output-type)))) (defun byte-compile-out-toplevel (&optional for-effect output-type) (if for-effect ;; The stack is empty. Push a value to be returned from (byte-code ..). (if (eq (car (car byte-compile-output)) 'byte-discard) (setq byte-compile-output (cdr byte-compile-output)) (byte-compile-push-constant ;; Push any constant - preferably one which already is used, and ;; a number or symbol - ie not some big sequence. The return value ;; isn't returned, but it would be a shame if some textually large ;; constant was not optimized away because we chose to return it. (and (not (assq nil byte-compile-constants)) ; Nil is often there. (let ((tmp (reverse byte-compile-constants))) (while (and tmp (not (or (symbolp (car (car tmp))) (numberp (car (car tmp)))))) (setq tmp (cdr tmp))) (car (car tmp))))))) (byte-compile-out 'byte-return 0) (setq byte-compile-output (nreverse byte-compile-output)) (if (memq byte-optimize '(t byte)) (setq byte-compile-output (byte-optimize-lapcode byte-compile-output for-effect))) ;; Decompile trivial functions: ;; only constants and variables, or a single funcall except in lambdas. ;; Except for Lisp_Compiled objects, forms like (foo "hi") ;; are still quicker than (byte-code "..." [foo "hi"] 2). ;; Note that even (quote foo) must be parsed just as any subr by the ;; interpreter, so quote should be compiled into byte-code in some contexts. ;; What to leave uncompiled: ;; lambda -> never. we used to leave it uncompiled if the body was ;; a single atom, but that causes confusion if the docstring ;; uses the (file . pos) syntax. Besides, now that we have ;; the Lisp_Compiled type, the compiled form is faster. ;; eval -> atom, quote or (function atom atom atom) ;; progn -> as <> or (progn <> atom) ;; file -> as progn, but takes both quotes and atoms, and longer forms. (let (rest (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. tmp body) (cond ;; #### This should be split out into byte-compile-nontrivial-function-p. ((or (eq output-type 'lambda) (nthcdr (if (eq output-type 'file) 50 8) byte-compile-output) (assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit. (not (setq tmp (assq 'byte-return byte-compile-output))) (progn (setq rest (nreverse (cdr (memq tmp (reverse byte-compile-output))))) (while (cond ((memq (car (car rest)) '(byte-varref byte-constant)) (setq tmp (car (cdr (car rest)))) (if (if (eq (car (car rest)) 'byte-constant) (or (consp tmp) (and (symbolp tmp) (not (memq tmp '(nil t)))))) (if maycall (setq body (cons (list 'quote tmp) body))) (setq body (cons tmp body)))) ((and maycall ;; Allow a funcall if at most one atom follows it. (null (nthcdr 3 rest)) (setq tmp (get (car (car rest)) 'byte-opcode-invert)) (or (null (cdr rest)) (and (memq output-type '(file progn t)) (cdr (cdr rest)) (eq (car (nth 1 rest)) 'byte-discard) (progn (setq rest (cdr rest)) t)))) (setq maycall nil) ; Only allow one real function call. (setq body (nreverse body)) (setq body (list (if (and (eq tmp 'funcall) (eq (car-safe (car body)) 'quote)) (cons (nth 1 (car body)) (cdr body)) (cons tmp body)))) (or (eq output-type 'file) (not (delq nil (mapcar 'consp (cdr (car body)))))))) (setq rest (cdr rest))) rest)) (let ((byte-compile-vector (byte-compile-constants-vector))) (list 'byte-code (byte-compile-lapcode byte-compile-output) byte-compile-vector byte-compile-maxdepth))) ;; it's a trivial function ((cdr body) (cons 'progn (nreverse body))) ((car body))))) ;; Given BODY, compile it and return a new body. (defun byte-compile-top-level-body (body &optional for-effect) (setq body (byte-compile-top-level (cons 'progn body) for-effect t)) (cond ((eq (car-safe body) 'progn) (cdr body)) (body (list body)))) ;; This is the recursive entry point for compiling each subform of an ;; expression. ;; If for-effect is non-nil, byte-compile-form will output a byte-discard ;; before terminating (ie no value will be left on the stack). ;; A byte-compile handler may, when for-effect is non-nil, choose output code ;; which does not leave a value on the stack, and then set for-effect to nil ;; (to prevent byte-compile-form from outputting the byte-discard). ;; If a handler wants to call another handler, it should do so via ;; byte-compile-form, or take extreme care to handle for-effect correctly. ;; (Use byte-compile-form-do-effect to reset the for-effect flag too.) ;; (defun byte-compile-form (form &optional for-effect) (setq form (macroexpand form byte-compile-macro-environment)) (cond ((not (consp form)) (cond ((or (not (symbolp form)) (memq form '(nil t))) (byte-compile-constant form)) ((and for-effect byte-compile-delete-errors) (setq for-effect nil)) (t (byte-compile-variable-ref 'byte-varref form)))) ((symbolp (car form)) (let* ((fn (car form)) (handler (get fn 'byte-compile))) (if (memq fn '(t nil)) (byte-compile-warn "%s called as a function" fn)) (if (and handler (or (not (byte-compile-version-cond byte-compile-compatibility)) (not (get (get fn 'byte-opcode) 'emacs19-opcode)))) (funcall handler form) (if (memq 'callargs byte-compile-warnings) (byte-compile-callargs-warn form)) (byte-compile-normal-call form)))) ((and (or (byte-code-function-p (car form)) (eq (car-safe (car form)) 'lambda)) ;; if the form comes out the same way it went in, that's ;; because it was malformed, and we couldn't unfold it. (not (eq form (setq form (byte-compile-unfold-lambda form))))) (byte-compile-form form for-effect) (setq for-effect nil)) ((byte-compile-normal-call form))) (if for-effect (byte-compile-discard))) (defun byte-compile-normal-call (form) (if byte-compile-generate-call-tree (byte-compile-annotate-call-tree form)) (byte-compile-push-constant (car form)) (mapcar 'byte-compile-form (cdr form)) ; wasteful, but faster. (byte-compile-out 'byte-call (length (cdr form)))) (defun byte-compile-variable-ref (base-op var) (if (or (not (symbolp var)) (memq var '(nil t))) (byte-compile-warn (if (eq base-op 'byte-varbind) "Attempt to let-bind %s %s" "Variable reference to %s %s") (if (symbolp var) "constant" "nonvariable") (prin1-to-string var)) (if (and (get var 'byte-obsolete-variable) (memq 'obsolete byte-compile-warnings)) (let ((ob (get var 'byte-obsolete-variable))) (byte-compile-warn "%s is an obsolete variable; %s" var (if (stringp ob) ob (format "use %s instead." ob))))) (if (memq 'free-vars byte-compile-warnings) (if (eq base-op 'byte-varbind) (setq byte-compile-bound-variables (cons var byte-compile-bound-variables)) (or (boundp var) (memq var byte-compile-bound-variables) (if (eq base-op 'byte-varset) (or (memq var byte-compile-free-assignments) (progn (byte-compile-warn "assignment to free variable %s" var) (setq byte-compile-free-assignments (cons var byte-compile-free-assignments)))) (or (memq var byte-compile-free-references) (progn (byte-compile-warn "reference to free variable %s" var) (setq byte-compile-free-references (cons var byte-compile-free-references))))))))) (let ((tmp (assq var byte-compile-variables))) (or tmp (setq tmp (list var) byte-compile-variables (cons tmp byte-compile-variables))) (byte-compile-out base-op tmp))) (defmacro byte-compile-get-constant (const) (` (or (if (stringp (, const)) (assoc (, const) byte-compile-constants) (assq (, const) byte-compile-constants)) (car (setq byte-compile-constants (cons (list (, const)) byte-compile-constants)))))) ;; Use this when the value of a form is a constant. This obeys for-effect. (defun byte-compile-constant (const) (if for-effect (setq for-effect nil) (byte-compile-out 'byte-constant (byte-compile-get-constant const)))) ;; Use this for a constant that is not the value of its containing form. ;; This ignores for-effect. (defun byte-compile-push-constant (const) (let ((for-effect nil)) (inline (byte-compile-constant const)))) ;; Compile those primitive ordinary functions ;; which have special byte codes just for speed. (defmacro byte-defop-compiler (function &optional compile-handler) ;; add a compiler-form for FUNCTION. ;; If function is a symbol, then the variable "byte-SYMBOL" must name ;; the opcode to be used. If function is a list, the first element ;; is the function and the second element is the bytecode-symbol. ;; COMPILE-HANDLER is the function to use to compile this byte-op, or ;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2. ;; If it is nil, then the handler is "byte-compile-SYMBOL." (let (opcode) (if (symbolp function) (setq opcode (intern (concat "byte-" (symbol-name function)))) (setq opcode (car (cdr function)) function (car function))) (let ((fnform (list 'put (list 'quote function) ''byte-compile (list 'quote (or (cdr (assq compile-handler '((0 . byte-compile-no-args) (1 . byte-compile-one-arg) (2 . byte-compile-two-args) (3 . byte-compile-three-args) (0-1 . byte-compile-zero-or-one-arg) (1-2 . byte-compile-one-or-two-args) (2-3 . byte-compile-two-or-three-args) ))) compile-handler (intern (concat "byte-compile-" (symbol-name function)))))))) (if opcode (list 'progn fnform (list 'put (list 'quote function) ''byte-opcode (list 'quote opcode)) (list 'put (list 'quote opcode) ''byte-opcode-invert (list 'quote function))) fnform)))) (defmacro byte-defop-compiler19 (function &optional compile-handler) ;; Just like byte-defop-compiler, but defines an opcode that will only ;; be used when byte-compile-compatibility is false. (if (and (byte-compile-single-version) byte-compile-compatibility) ;; #### instead of doing nothing, this should do some remprops, ;; #### to protect against the case where a single-version compiler ;; #### is loaded into a world that has contained a multi-version one. nil (list 'progn (list 'put (list 'quote (or (car (cdr-safe function)) (intern (concat "byte-" (symbol-name (or (car-safe function) function)))))) ''emacs19-opcode t) (list 'byte-defop-compiler function compile-handler)))) (defmacro byte-defop-compiler-1 (function &optional compile-handler) (list 'byte-defop-compiler (list function nil) compile-handler)) (put 'byte-call 'byte-opcode-invert 'funcall) (put 'byte-list1 'byte-opcode-invert 'list) (put 'byte-list2 'byte-opcode-invert 'list) (put 'byte-list3 'byte-opcode-invert 'list) (put 'byte-list4 'byte-opcode-invert 'list) (put 'byte-listN 'byte-opcode-invert 'list) (put 'byte-concat2 'byte-opcode-invert 'concat) (put 'byte-concat3 'byte-opcode-invert 'concat) (put 'byte-concat4 'byte-opcode-invert 'concat) (put 'byte-concatN 'byte-opcode-invert 'concat) (put 'byte-insertN 'byte-opcode-invert 'insert) (byte-defop-compiler (dot byte-point) 0) (byte-defop-compiler (dot-max byte-point-max) 0) (byte-defop-compiler (dot-min byte-point-min) 0) (byte-defop-compiler point 0) ;;(byte-defop-compiler mark 0) ;; obsolete (byte-defop-compiler point-max 0) (byte-defop-compiler point-min 0) (byte-defop-compiler following-char 0) (byte-defop-compiler preceding-char 0) (byte-defop-compiler current-column 0) (byte-defop-compiler eolp 0) (byte-defop-compiler eobp 0) (byte-defop-compiler bolp 0) (byte-defop-compiler bobp 0) (byte-defop-compiler current-buffer 0) ;;(byte-defop-compiler read-char 0) ;; obsolete (byte-defop-compiler interactive-p 0) (byte-defop-compiler19 widen 0) (byte-defop-compiler19 end-of-line 0-1) (byte-defop-compiler19 forward-char 0-1) (byte-defop-compiler19 forward-line 0-1) (byte-defop-compiler symbolp 1) (byte-defop-compiler consp 1) (byte-defop-compiler stringp 1) (byte-defop-compiler listp 1) (byte-defop-compiler not 1) (byte-defop-compiler (null byte-not) 1) (byte-defop-compiler car 1) (byte-defop-compiler cdr 1) (byte-defop-compiler length 1) (byte-defop-compiler symbol-value 1) (byte-defop-compiler symbol-function 1) (byte-defop-compiler (1+ byte-add1) 1) (byte-defop-compiler (1- byte-sub1) 1) (byte-defop-compiler goto-char 1) (byte-defop-compiler char-after 1) (byte-defop-compiler set-buffer 1) ;;(byte-defop-compiler set-mark 1) ;; obsolete (byte-defop-compiler19 forward-word 1) (byte-defop-compiler19 char-syntax 1) (byte-defop-compiler19 nreverse 1) (byte-defop-compiler19 car-safe 1) (byte-defop-compiler19 cdr-safe 1) (byte-defop-compiler19 numberp 1) (byte-defop-compiler19 integerp 1) (byte-defop-compiler19 skip-chars-forward 1-2) (byte-defop-compiler19 skip-chars-backward 1-2) (byte-defop-compiler (eql byte-eq) 2) (byte-defop-compiler eq 2) (byte-defop-compiler memq 2) (byte-defop-compiler cons 2) (byte-defop-compiler aref 2) (byte-defop-compiler set 2) (byte-defop-compiler (= byte-eqlsign) 2) (byte-defop-compiler (< byte-lss) 2) (byte-defop-compiler (> byte-gtr) 2) (byte-defop-compiler (<= byte-leq) 2) (byte-defop-compiler (>= byte-geq) 2) (byte-defop-compiler get 2) (byte-defop-compiler nth 2) (byte-defop-compiler substring 2-3) (byte-defop-compiler19 (move-marker byte-set-marker) 2-3) (byte-defop-compiler19 set-marker 2-3) (byte-defop-compiler19 match-beginning 1) (byte-defop-compiler19 match-end 1) (byte-defop-compiler19 upcase 1) (byte-defop-compiler19 downcase 1) (byte-defop-compiler19 string= 2) (byte-defop-compiler19 string< 2) (byte-defop-compiler19 (string-equal byte-string=) 2) (byte-defop-compiler19 (string-lessp byte-string<) 2) (byte-defop-compiler19 equal 2) (byte-defop-compiler19 nthcdr 2) (byte-defop-compiler19 elt 2) (byte-defop-compiler19 member 2) (byte-defop-compiler19 assq 2) (byte-defop-compiler19 (rplaca byte-setcar) 2) (byte-defop-compiler19 (rplacd byte-setcdr) 2) (byte-defop-compiler19 setcar 2) (byte-defop-compiler19 setcdr 2) (byte-defop-compiler19 buffer-substring 2) (byte-defop-compiler19 delete-region 2) (byte-defop-compiler19 narrow-to-region 2) (byte-defop-compiler19 (% byte-rem) 2) (byte-defop-compiler aset 3) (byte-defop-compiler max byte-compile-associative) (byte-defop-compiler min byte-compile-associative) (byte-defop-compiler (+ byte-plus) byte-compile-associative) (byte-defop-compiler19 (* byte-mult) byte-compile-associative) ;;####(byte-defop-compiler19 move-to-column 1) (byte-defop-compiler-1 interactive byte-compile-noop) (defun byte-compile-subr-wrong-args (form n) (byte-compile-warn "%s called with %d arg%s, but requires %s" (car form) (length (cdr form)) (if (= 1 (length (cdr form))) "" "s") n) ;; get run-time wrong-number-of-args error. (byte-compile-normal-call form)) (defun byte-compile-no-args (form) (if (not (= (length form) 1)) (byte-compile-subr-wrong-args form "none") (byte-compile-out (get (car form) 'byte-opcode) 0))) (defun byte-compile-one-arg (form) (if (not (= (length form) 2)) (byte-compile-subr-wrong-args form 1) (byte-compile-form (car (cdr form))) ;; Push the argument (byte-compile-out (get (car form) 'byte-opcode) 0))) (defun byte-compile-two-args (form) (if (not (= (length form) 3)) (byte-compile-subr-wrong-args form 2) (byte-compile-form (car (cdr form))) ;; Push the arguments (byte-compile-form (nth 2 form)) (byte-compile-out (get (car form) 'byte-opcode) 0))) (defun byte-compile-three-args (form) (if (not (= (length form) 4)) (byte-compile-subr-wrong-args form 3) (byte-compile-form (car (cdr form))) ;; Push the arguments (byte-compile-form (nth 2 form)) (byte-compile-form (nth 3 form)) (byte-compile-out (get (car form) 'byte-opcode) 0))) (defun byte-compile-zero-or-one-arg (form) (let ((len (length form))) (cond ((= len 1) (byte-compile-one-arg (append form '(nil)))) ((= len 2) (byte-compile-one-arg form)) (t (byte-compile-subr-wrong-args form "0-1"))))) (defun byte-compile-one-or-two-args (form) (let ((len (length form))) (cond ((= len 2) (byte-compile-two-args (append form '(nil)))) ((= len 3) (byte-compile-two-args form)) (t (byte-compile-subr-wrong-args form "1-2"))))) (defun byte-compile-two-or-three-args (form) (let ((len (length form))) (cond ((= len 3) (byte-compile-three-args (append form '(nil)))) ((= len 4) (byte-compile-three-args form)) (t (byte-compile-subr-wrong-args form "2-3"))))) (defun byte-compile-noop (form) (byte-compile-constant nil)) (defun byte-compile-discard () (byte-compile-out 'byte-discard 0)) ;; Compile a function that accepts one or more args and is right-associative. ;; We do it by left-associativity so that the operations ;; are done in the same order as in interpreted code. (defun byte-compile-associative (form) (if (cdr form) (let ((opcode (get (car form) 'byte-opcode)) (args (copy-sequence (cdr form)))) (byte-compile-form (car args)) (setq args (cdr args)) (while args (byte-compile-form (car args)) (byte-compile-out opcode 0) (setq args (cdr args)))) (byte-compile-constant (eval form)))) ;; more complicated compiler macros (byte-defop-compiler list) (byte-defop-compiler concat) (byte-defop-compiler fset) (byte-defop-compiler (indent-to-column byte-indent-to) byte-compile-indent-to) (byte-defop-compiler indent-to) (byte-defop-compiler insert) (byte-defop-compiler-1 function byte-compile-function-form) (byte-defop-compiler-1 - byte-compile-minus) (byte-defop-compiler19 (/ byte-quo) byte-compile-quo) (byte-defop-compiler19 nconc) (byte-defop-compiler-1 beginning-of-line) (defun byte-compile-list (form) (let ((count (length (cdr form)))) (cond ((= count 0) (byte-compile-constant nil)) ((< count 5) (mapcar 'byte-compile-form (cdr form)) (byte-compile-out (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- count)) 0)) ((and (< count 256) (not (byte-compile-version-cond byte-compile-compatibility))) (mapcar 'byte-compile-form (cdr form)) (byte-compile-out 'byte-listN count)) (t (byte-compile-normal-call form))))) (defun byte-compile-concat (form) (let ((count (length (cdr form)))) (cond ((and (< 1 count) (< count 5)) (mapcar 'byte-compile-form (cdr form)) (byte-compile-out (aref [byte-concat2 byte-concat3 byte-concat4] (- count 2)) 0)) ;; Concat of one arg is not a no-op if arg is not a string. ((= count 0) (byte-compile-form "")) ((and (< count 256) (not (byte-compile-version-cond byte-compile-compatibility))) (mapcar 'byte-compile-form (cdr form)) (byte-compile-out 'byte-concatN count)) ((byte-compile-normal-call form))))) (defun byte-compile-minus (form) (if (null (setq form (cdr form))) (byte-compile-constant 0) (byte-compile-form (car form)) (if (cdr form) (while (setq form (cdr form)) (byte-compile-form (car form)) (byte-compile-out 'byte-diff 0)) (byte-compile-out 'byte-negate 0)))) (defun byte-compile-quo (form) (let ((len (length form))) (cond ((<= len 2) (byte-compile-subr-wrong-args form "2 or more")) (t (byte-compile-form (car (setq form (cdr form)))) (while (setq form (cdr form)) (byte-compile-form (car form)) (byte-compile-out 'byte-quo 0)))))) (defun byte-compile-nconc (form) (let ((len (length form))) (cond ((= len 1) (byte-compile-constant nil)) ((= len 2) ;; nconc of one arg is a noop, even if that arg isn't a list. (byte-compile-form (nth 1 form))) (t (byte-compile-form (car (setq form (cdr form)))) (while (setq form (cdr form)) (byte-compile-form (car form)) (byte-compile-out 'byte-nconc 0)))))) (defun byte-compile-fset (form) ;; warn about forms like (fset 'foo '(lambda () ...)) ;; (where the lambda expression is non-trivial...) (let ((fn (nth 2 form)) body) (if (and (eq (car-safe fn) 'quote) (eq (car-safe (setq fn (nth 1 fn))) 'lambda)) (progn (setq body (cdr (cdr fn))) (if (stringp (car body)) (setq body (cdr body))) (if (eq 'interactive (car-safe (car body))) (setq body (cdr body))) (if (and (consp (car body)) (not (eq 'byte-code (car (car body))))) (byte-compile-warn "A quoted lambda form is the second argument of fset. This is probably not what you want, as that lambda cannot be compiled. Consider using the syntax (function (lambda (...) ...)) instead."))))) (byte-compile-two-args form)) (defun byte-compile-funarg (form) ;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..) ;; for cases where it's guaranteed that first arg will be used as a lambda. (byte-compile-normal-call (let ((fn (nth 1 form))) (if (and (eq (car-safe fn) 'quote) (eq (car-safe (nth 1 fn)) 'lambda)) (cons (car form) (cons (cons 'function (cdr fn)) (cdr (cdr form)))) form)))) ;; (function foo) must compile like 'foo, not like (symbol-function 'foo). ;; Otherwise it will be incompatible with the interpreter, ;; and (funcall (function foo)) will lose with autoloads. (defun byte-compile-function-form (form) (byte-compile-constant (cond ((symbolp (nth 1 form)) (nth 1 form)) ;; If we're not allowed to use #[] syntax, then output a form like ;; '(lambda (..) (byte-code ..)) instead of a call to make-byte-code. ;; In this situation, calling make-byte-code at run-time will usually ;; be less efficient than processing a call to byte-code. ((byte-compile-version-cond byte-compile-compatibility) (byte-compile-byte-code-unmake (byte-compile-lambda (nth 1 form)))) ((byte-compile-lambda (nth 1 form)))))) (defun byte-compile-indent-to (form) (let ((len (length form))) (cond ((= len 2) (byte-compile-form (car (cdr form))) (byte-compile-out 'byte-indent-to 0)) ((= len 3) ;; no opcode for 2-arg case. (byte-compile-normal-call form)) (t (byte-compile-subr-wrong-args form "1-2"))))) (defun byte-compile-insert (form) (cond ((null (cdr form)) (byte-compile-constant nil)) ((and (not (byte-compile-version-cond byte-compile-compatibility)) (<= (length form) 256)) (mapcar 'byte-compile-form (cdr form)) (if (cdr (cdr form)) (byte-compile-out 'byte-insertN (length (cdr form))) (byte-compile-out 'byte-insert 0))) ((memq t (mapcar 'consp (cdr (cdr form)))) (byte-compile-normal-call form)) ;; We can split it; there is no function call after inserting 1st arg. (t (while (setq form (cdr form)) (byte-compile-form (car form)) (byte-compile-out 'byte-insert 0) (if (cdr form) (byte-compile-discard)))))) (defun byte-compile-beginning-of-line (form) (if (not (byte-compile-constp (nth 1 form))) (byte-compile-normal-call form) (byte-compile-form (list 'forward-line (if (integerp (setq form (or (eval (nth 1 form)) 1))) (1- form) (byte-compile-warn "Non-numeric arg to beginning-of-line: %s" form) (list '1- (list 'quote form)))) t) (byte-compile-constant nil))) (byte-defop-compiler-1 setq) (byte-defop-compiler-1 setq-default) (byte-defop-compiler-1 quote) (byte-defop-compiler-1 quote-form) (defun byte-compile-setq (form) (let ((args (cdr form))) (if args (while args (byte-compile-form (car (cdr args))) (or for-effect (cdr (cdr args)) (byte-compile-out 'byte-dup 0)) (byte-compile-variable-ref 'byte-varset (car args)) (setq args (cdr (cdr args)))) ;; (setq), with no arguments. (byte-compile-form nil for-effect)) (setq for-effect nil))) (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) (byte-compile-constant (car (cdr form)))) (defun byte-compile-quote-form (form) (byte-compile-constant (byte-compile-top-level (nth 1 form)))) ;;; control structures (defun byte-compile-body (body &optional for-effect) (while (cdr body) (byte-compile-form (car body) t) (setq body (cdr body))) (byte-compile-form (car body) for-effect)) (defsubst byte-compile-body-do-effect (body) (byte-compile-body body for-effect) (setq for-effect nil)) (defsubst byte-compile-form-do-effect (form) (byte-compile-form form for-effect) (setq for-effect nil)) (byte-defop-compiler-1 inline byte-compile-progn) (byte-defop-compiler-1 progn) (byte-defop-compiler-1 prog1) (byte-defop-compiler-1 prog2) (byte-defop-compiler-1 if) (byte-defop-compiler-1 cond) (byte-defop-compiler-1 and) (byte-defop-compiler-1 or) (byte-defop-compiler-1 while) (byte-defop-compiler-1 funcall) (byte-defop-compiler-1 apply byte-compile-funarg) (byte-defop-compiler-1 mapcar byte-compile-funarg) (byte-defop-compiler-1 mapatoms byte-compile-funarg) (byte-defop-compiler-1 mapconcat byte-compile-funarg) (byte-defop-compiler-1 let) (byte-defop-compiler-1 let*) (defun byte-compile-progn (form) (byte-compile-body-do-effect (cdr form))) (defun byte-compile-prog1 (form) (byte-compile-form-do-effect (car (cdr form))) (byte-compile-body (cdr (cdr form)) t)) (defun byte-compile-prog2 (form) (byte-compile-form (nth 1 form) t) (byte-compile-form-do-effect (nth 2 form)) (byte-compile-body (cdr (cdr (cdr form))) t)) (defmacro byte-compile-goto-if (cond discard tag) (` (byte-compile-goto (if (, cond) (if (, discard) 'byte-goto-if-not-nil 'byte-goto-if-not-nil-else-pop) (if (, discard) 'byte-goto-if-nil 'byte-goto-if-nil-else-pop)) (, tag)))) (defun byte-compile-if (form) (byte-compile-form (car (cdr form))) (if (null (nthcdr 3 form)) ;; No else-forms (let ((donetag (byte-compile-make-tag))) (byte-compile-goto-if nil for-effect donetag) (byte-compile-form (nth 2 form) for-effect) (byte-compile-out-tag donetag)) (let ((donetag (byte-compile-make-tag)) (elsetag (byte-compile-make-tag))) (byte-compile-goto 'byte-goto-if-nil elsetag) (byte-compile-form (nth 2 form) for-effect) (byte-compile-goto 'byte-goto donetag) (byte-compile-out-tag elsetag) (byte-compile-body (cdr (cdr (cdr form))) for-effect) (byte-compile-out-tag donetag))) (setq for-effect nil)) (defun byte-compile-cond (clauses) (let ((donetag (byte-compile-make-tag)) nexttag clause) (while (setq clauses (cdr clauses)) (setq clause (car clauses)) (cond ((or (eq (car clause) t) (and (eq (car-safe (car clause)) 'quote) (car-safe (cdr-safe (car clause))))) ;; Unconditional clause (setq clause (cons t clause) clauses nil)) ((cdr clauses) (byte-compile-form (car clause)) (if (null (cdr clause)) ;; First clause is a singleton. (byte-compile-goto-if t for-effect donetag) (setq nexttag (byte-compile-make-tag)) (byte-compile-goto 'byte-goto-if-nil nexttag) (byte-compile-body (cdr clause) for-effect) (byte-compile-goto 'byte-goto donetag) (byte-compile-out-tag nexttag))))) ;; Last clause (and (cdr clause) (not (eq (car clause) t)) (progn (byte-compile-form (car clause)) (byte-compile-goto-if nil for-effect donetag) (setq clause (cdr clause)))) (byte-compile-body-do-effect clause) (byte-compile-out-tag donetag))) (defun byte-compile-and (form) (let ((failtag (byte-compile-make-tag)) (args (cdr form))) (if (null args) (byte-compile-form-do-effect t) (while (cdr args) (byte-compile-form (car args)) (byte-compile-goto-if nil for-effect failtag) (setq args (cdr args))) (byte-compile-form-do-effect (car args)) (byte-compile-out-tag failtag)))) (defun byte-compile-or (form) (let ((wintag (byte-compile-make-tag)) (args (cdr form))) (if (null args) (byte-compile-form-do-effect nil) (while (cdr args) (byte-compile-form (car args)) (byte-compile-goto-if t for-effect wintag) (setq args (cdr args))) (byte-compile-form-do-effect (car args)) (byte-compile-out-tag wintag)))) (defun byte-compile-while (form) (let ((endtag (byte-compile-make-tag)) (looptag (byte-compile-make-tag))) (byte-compile-out-tag looptag) (byte-compile-form (car (cdr form))) (byte-compile-goto-if nil for-effect endtag) (byte-compile-body (cdr (cdr form)) t) (byte-compile-goto 'byte-goto looptag) (byte-compile-out-tag endtag) (setq for-effect nil))) (defun byte-compile-funcall (form) (mapcar 'byte-compile-form (cdr form)) (byte-compile-out 'byte-call (length (cdr (cdr form))))) (defun byte-compile-let (form) ;; First compute the binding values in the old scope. (let ((varlist (car (cdr form)))) (while varlist (if (consp (car varlist)) (byte-compile-form (car (cdr (car varlist)))) (byte-compile-push-constant nil)) (setq varlist (cdr varlist)))) (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope (varlist (reverse (car (cdr form))))) (while varlist (byte-compile-variable-ref 'byte-varbind (if (consp (car varlist)) (car (car varlist)) (car varlist))) (setq varlist (cdr varlist))) (byte-compile-body-do-effect (cdr (cdr form))) (byte-compile-out 'byte-unbind (length (car (cdr form)))))) (defun byte-compile-let* (form) (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope (varlist (copy-sequence (car (cdr form))))) (while varlist (if (atom (car varlist)) (byte-compile-push-constant nil) (byte-compile-form (car (cdr (car varlist)))) (setcar varlist (car (car varlist)))) (byte-compile-variable-ref 'byte-varbind (car varlist)) (setq varlist (cdr varlist))) (byte-compile-body-do-effect (cdr (cdr form))) (byte-compile-out 'byte-unbind (length (car (cdr form)))))) (byte-defop-compiler-1 /= byte-compile-negated) (byte-defop-compiler-1 atom byte-compile-negated) (byte-defop-compiler-1 nlistp byte-compile-negated) (put '/= 'byte-compile-negated-op '=) (put 'atom 'byte-compile-negated-op 'consp) (put 'nlistp 'byte-compile-negated-op 'listp) (defun byte-compile-negated (form) (byte-compile-form-do-effect (byte-compile-negation-optimizer form))) ;; Even when optimization is off, /= is optimized to (not (= ...)). (defun byte-compile-negation-optimizer (form) ;; an optimizer for forms where is less efficient than (not ) (list 'not (cons (or (get (car form) 'byte-compile-negated-op) (error "Compiler error: `%s' has no `byte-compile-negated-op' property" (car form))) (cdr form)))) ;;; other tricky macro-like special-forms (byte-defop-compiler-1 catch) (byte-defop-compiler-1 unwind-protect) (byte-defop-compiler-1 condition-case) (byte-defop-compiler-1 save-excursion) (byte-defop-compiler-1 save-restriction) (byte-defop-compiler-1 save-window-excursion) (byte-defop-compiler-1 with-output-to-temp-buffer) (byte-defop-compiler-1 track-mouse) (defun byte-compile-catch (form) (byte-compile-form (car (cdr form))) (byte-compile-push-constant (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect)) (byte-compile-out 'byte-catch 0)) (defun byte-compile-unwind-protect (form) (byte-compile-push-constant (byte-compile-top-level-body (cdr (cdr form)) t)) (byte-compile-out 'byte-unwind-protect 0) (byte-compile-form-do-effect (car (cdr form))) (byte-compile-out 'byte-unbind 1)) (defun byte-compile-track-mouse (form) (byte-compile-form (list 'funcall (list 'quote (list 'lambda nil (cons 'track-mouse (byte-compile-top-level-body (cdr form)))))))) (defun byte-compile-condition-case (form) (let* ((var (nth 1 form)) (byte-compile-bound-variables (if var (cons var byte-compile-bound-variables) byte-compile-bound-variables))) (or (symbolp var) (byte-compile-warn "%s is not a variable-name or nil (in condition-case)" var)) (byte-compile-push-constant var) (byte-compile-push-constant (byte-compile-top-level (nth 2 form) for-effect)) (let ((clauses (cdr (cdr (cdr form)))) compiled-clauses) (while clauses (let* ((clause (car clauses)) (condition (car clause))) (cond ((not (or (symbolp condition) (and (listp condition) (let ((syms condition) (ok t)) (while syms (if (not (symbolp (car syms))) (setq ok nil)) (setq syms (cdr syms))) ok)))) (byte-compile-warn "%s is not a condition name or list of such (in condition-case)" (prin1-to-string condition))) ;; ((not (or (eq condition 't) ;; (and (stringp (get condition 'error-message)) ;; (consp (get condition 'error-conditions))))) ;; (byte-compile-warn ;; "%s is not a known condition name (in condition-case)" ;; condition)) ) (setq compiled-clauses (cons (cons condition (byte-compile-top-level-body (cdr clause) for-effect)) compiled-clauses))) (setq clauses (cdr clauses))) (byte-compile-push-constant (nreverse compiled-clauses))) (byte-compile-out 'byte-condition-case 0))) (defun byte-compile-save-excursion (form) (byte-compile-out 'byte-save-excursion 0) (byte-compile-body-do-effect (cdr form)) (byte-compile-out 'byte-unbind 1)) (defun byte-compile-save-restriction (form) (byte-compile-out 'byte-save-restriction 0) (byte-compile-body-do-effect (cdr form)) (byte-compile-out 'byte-unbind 1)) (defun byte-compile-save-window-excursion (form) (byte-compile-push-constant (byte-compile-top-level-body (cdr form) for-effect)) (byte-compile-out 'byte-save-window-excursion 0)) (defun byte-compile-with-output-to-temp-buffer (form) (byte-compile-form (car (cdr form))) (byte-compile-out 'byte-temp-output-buffer-setup 0) (byte-compile-body (cdr (cdr form))) (byte-compile-out 'byte-temp-output-buffer-show 0)) ;;; top-level forms elsewhere (byte-defop-compiler-1 defun) (byte-defop-compiler-1 defmacro) (byte-defop-compiler-1 defvar) (byte-defop-compiler-1 defconst byte-compile-defvar) (byte-defop-compiler-1 autoload) (byte-defop-compiler-1 lambda byte-compile-lambda-form) (byte-defop-compiler-1 defalias) (defun byte-compile-defun (form) ;; This is not used for file-level defuns with doc strings. (byte-compile-two-args ; Use this to avoid byte-compile-fset's warning. (list 'fset (list 'quote (nth 1 form)) (byte-compile-byte-code-maker (byte-compile-lambda (cons 'lambda (cdr (cdr form))))))) (byte-compile-discard) (byte-compile-constant (nth 1 form))) (defun byte-compile-defmacro (form) ;; This is not used for file-level defmacros with doc strings. (byte-compile-body-do-effect (list (list 'fset (list 'quote (nth 1 form)) (let ((code (byte-compile-byte-code-maker (byte-compile-lambda (cons 'lambda (cdr (cdr form))))))) (if (eq (car-safe code) 'make-byte-code) (list 'cons ''macro code) (list 'quote (cons 'macro (eval code)))))) (list 'quote (nth 1 form))))) (defun byte-compile-defvar (form) ;; This is not used for file-level defvar/consts with doc strings. (let ((var (nth 1 form)) (value (nth 2 form)) (string (nth 3 form))) (if (memq 'free-vars byte-compile-warnings) (setq byte-compile-bound-variables (cons var byte-compile-bound-variables))) (byte-compile-body-do-effect (list (if (cdr (cdr form)) (if (eq (car form) 'defconst) (list 'setq var value) (list 'or (list 'boundp (list 'quote var)) (list 'setq var value)))) ;; Put the defined variable in this library's load-history entry ;; just as a real defvar would. (list 'setq 'current-load-list (list 'cons (list 'quote var) 'current-load-list)) (if string (list 'put (list 'quote var) ''variable-documentation string)) (list 'quote var))))) (defun byte-compile-autoload (form) (and (byte-compile-constp (nth 1 form)) (byte-compile-constp (nth 5 form)) (eval (nth 5 form)) ; macro-p (not (fboundp (eval (nth 1 form)))) (byte-compile-warn "The compiler ignores `autoload' except at top level. You should probably put the autoload of the macro `%s' at top-level." (eval (nth 1 form)))) (byte-compile-normal-call form)) ;; Lambda's in valid places are handled as special cases by various code. ;; The ones that remain are errors. (defun byte-compile-lambda-form (form) (error "`lambda' used as function name is invalid")) ;; Compile normally, but deal with warnings for the function being defined. (defun byte-compile-defalias (form) (if (and (consp (cdr form)) (consp (nth 1 form)) (eq (car (nth 1 form)) 'quote) (consp (cdr (nth 1 form))) (symbolp (nth 1 (nth 1 form))) (consp (nthcdr 2 form)) (consp (nth 2 form)) (eq (car (nth 2 form)) 'quote) (consp (cdr (nth 2 form))) (symbolp (nth 1 (nth 2 form)))) (progn (byte-compile-defalias-warn (nth 1 (nth 1 form)) (nth 1 (nth 2 form))) (setq byte-compile-function-environment (cons (cons (nth 1 (nth 1 form)) (nth 1 (nth 2 form))) byte-compile-function-environment)))) (byte-compile-normal-call form)) ;; Turn off warnings about prior calls to the function being defalias'd. ;; This could be smarter and compare those calls with ;; the function it is being aliased to. (defun byte-compile-defalias-warn (new alias) (let ((calls (assq new byte-compile-unresolved-functions))) (if calls (setq byte-compile-unresolved-functions (delq calls byte-compile-unresolved-functions))))) ;;; tags ;; Note: Most operations will strip off the 'TAG, but it speeds up ;; optimization to have the 'TAG as a part of the tag. ;; Tags will be (TAG . (tag-number . stack-depth)). (defun byte-compile-make-tag () (list 'TAG (setq byte-compile-tag-number (1+ byte-compile-tag-number)))) (defun byte-compile-out-tag (tag) (setq byte-compile-output (cons tag byte-compile-output)) (if (cdr (cdr tag)) (progn ;; ## remove this someday (and byte-compile-depth (not (= (cdr (cdr tag)) byte-compile-depth)) (error "Compiler bug: depth conflict at tag %d" (car (cdr tag)))) (setq byte-compile-depth (cdr (cdr tag)))) (setcdr (cdr tag) byte-compile-depth))) (defun byte-compile-goto (opcode tag) (setq byte-compile-output (cons (cons opcode tag) byte-compile-output)) (setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops) (1- byte-compile-depth) byte-compile-depth)) (setq byte-compile-depth (and (not (eq opcode 'byte-goto)) (1- byte-compile-depth)))) (defun byte-compile-out (opcode offset) (setq byte-compile-output (cons (cons opcode offset) byte-compile-output)) (cond ((eq opcode 'byte-call) (setq byte-compile-depth (- byte-compile-depth offset))) ((eq opcode 'byte-return) ;; This is actually an unnecessary case, because there should be ;; no more opcodes behind byte-return. (setq byte-compile-depth nil)) (t (setq byte-compile-depth (+ byte-compile-depth (or (aref byte-stack+-info (symbol-value opcode)) (- (1- offset)))) byte-compile-maxdepth (max byte-compile-depth byte-compile-maxdepth)))) ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow")) ) ;;; call tree stuff (defun byte-compile-annotate-call-tree (form) (let (entry) ;; annotate the current call (if (setq entry (assq (car form) byte-compile-call-tree)) (or (memq byte-compile-current-form (nth 1 entry)) ;callers (setcar (cdr entry) (cons byte-compile-current-form (nth 1 entry)))) (setq byte-compile-call-tree (cons (list (car form) (list byte-compile-current-form) nil) byte-compile-call-tree))) ;; annotate the current function (if (setq entry (assq byte-compile-current-form byte-compile-call-tree)) (or (memq (car form) (nth 2 entry)) ;called (setcar (cdr (cdr entry)) (cons (car form) (nth 2 entry)))) (setq byte-compile-call-tree (cons (list byte-compile-current-form nil (list (car form))) byte-compile-call-tree))) )) ;; Renamed from byte-compile-report-call-tree ;; to avoid interfering with completion of byte-compile-file. ;;;###autoload (defun display-call-tree (&optional filename) "Display a call graph of a specified file. This lists which functions have been called, what functions called them, and what functions they call. The list includes all functions whose definitions have been compiled in this Emacs session, as well as all functions called by those functions. The call graph does not include macros, inline functions, or primitives that the byte-code interpreter knows about directly \(eq, cons, etc.\). The call tree also lists those functions which are not known to be called \(that is, to which no calls have been compiled\), and which cannot be invoked interactively." (interactive) (message "Generating call tree...") (with-output-to-temp-buffer "*Call-Tree*" (set-buffer "*Call-Tree*") (erase-buffer) (message "Generating call tree... (sorting on %s)" byte-compile-call-tree-sort) (insert "Call tree for " (cond ((null byte-compile-current-file) (or filename "???")) ((stringp byte-compile-current-file) byte-compile-current-file) (t (buffer-name byte-compile-current-file))) " sorted on " (prin1-to-string byte-compile-call-tree-sort) ":\n\n") (if byte-compile-call-tree-sort (setq byte-compile-call-tree (sort byte-compile-call-tree (cond ((eq byte-compile-call-tree-sort 'callers) (function (lambda (x y) (< (length (nth 1 x)) (length (nth 1 y)))))) ((eq byte-compile-call-tree-sort 'calls) (function (lambda (x y) (< (length (nth 2 x)) (length (nth 2 y)))))) ((eq byte-compile-call-tree-sort 'calls+callers) (function (lambda (x y) (< (+ (length (nth 1 x)) (length (nth 2 x))) (+ (length (nth 1 y)) (length (nth 2 y))))))) ((eq byte-compile-call-tree-sort 'name) (function (lambda (x y) (string< (car x) (car y))))) (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" byte-compile-call-tree-sort)))))) (message "Generating call tree...") (let ((rest byte-compile-call-tree) (b (current-buffer)) f p callers calls) (while rest (prin1 (car (car rest)) b) (setq callers (nth 1 (car rest)) calls (nth 2 (car rest))) (insert "\t" (cond ((not (fboundp (setq f (car (car rest))))) (if (null f) " ";; shouldn't insert nil then, actually -sk " ")) ((subrp (setq f (symbol-function f))) " ") ((symbolp f) (format " ==> %s" f)) ((byte-code-function-p f) "") ((not (consp f)) "") ((eq 'macro (car f)) (if (or (byte-code-function-p (cdr f)) (assq 'byte-code (cdr (cdr (cdr f))))) " " " ")) ((assq 'byte-code (cdr (cdr f))) "") ((eq 'lambda (car f)) "") (t "???")) (format " (%d callers + %d calls = %d)" ;; Does the optimizer eliminate common subexpressions?-sk (length callers) (length calls) (+ (length callers) (length calls))) "\n") (if callers (progn (insert " called by:\n") (setq p (point)) (insert " " (if (car callers) (mapconcat 'symbol-name callers ", ") "")) (let ((fill-prefix " ")) (fill-region-as-paragraph p (point))))) (if calls (progn (insert " calls:\n") (setq p (point)) (insert " " (mapconcat 'symbol-name calls ", ")) (let ((fill-prefix " ")) (fill-region-as-paragraph p (point))))) (insert "\n") (setq rest (cdr rest))) (message "Generating call tree...(finding uncalled functions...)") (setq rest byte-compile-call-tree) (let ((uncalled nil)) (while rest (or (nth 1 (car rest)) (null (setq f (car (car rest)))) (byte-compile-fdefinition f t) (commandp (byte-compile-fdefinition f nil)) (setq uncalled (cons f uncalled))) (setq rest (cdr rest))) (if uncalled (let ((fill-prefix " ")) (insert "Noninteractive functions not known to be called:\n ") (setq p (point)) (insert (mapconcat 'symbol-name (nreverse uncalled) ", ")) (fill-region-as-paragraph p (point))))) ) (message "Generating call tree...done.") )) ;;; by crl@newton.purdue.edu ;;; Only works noninteractively. ;;;###autoload (defun batch-byte-compile () "Run `byte-compile-file' on the files remaining on the command line. Use this from the command line, with `-batch'; it won't work in an interactive Emacs. Each file is processed even if an error occurred previously. For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" ;; command-line-args-left is what is left of the command line (from startup.el) (defvar command-line-args-left) ;Avoid 'free variable' warning (if (not noninteractive) (error "`batch-byte-compile' is to be used only with -batch")) (let ((error nil)) (while command-line-args-left (if (file-directory-p (expand-file-name (car command-line-args-left))) (let ((files (directory-files (car command-line-args-left))) source dest) (while files (if (and (string-match emacs-lisp-file-regexp (car files)) (not (auto-save-file-name-p (car files))) (setq source (expand-file-name (car files) (car command-line-args-left))) (setq dest (byte-compile-dest-file source)) (file-exists-p dest) (file-newer-than-file-p source dest)) (if (null (batch-byte-compile-file source)) (setq error t))) (setq files (cdr files)))) (if (null (batch-byte-compile-file (car command-line-args-left))) (setq error t))) (setq command-line-args-left (cdr command-line-args-left))) (message "Done") (kill-emacs (if error 1 0)))) (defun batch-byte-compile-file (file) (condition-case err (progn (byte-compile-file file) t) (error (message (if (cdr err) ">>Error occurred processing %s: %s (%s)" ">>Error occurred processing %s: %s") file (get (car err) 'error-message) (prin1-to-string (cdr err))) nil))) ;;;###autoload (defun batch-byte-recompile-directory () "Runs `byte-recompile-directory' on the dirs remaining on the command line. Must be used only with `-batch', and kills Emacs on completion. For example, invoke `emacs -batch -f batch-byte-recompile-directory .'." ;; command-line-args-left is what is left of the command line (startup.el) (defvar command-line-args-left) ;Avoid 'free variable' warning (if (not noninteractive) (error "batch-byte-recompile-directory is to be used only with -batch")) (or command-line-args-left (setq command-line-args-left '("."))) (while command-line-args-left (byte-recompile-directory (car command-line-args-left)) (setq command-line-args-left (cdr command-line-args-left))) (kill-emacs 0)) (make-obsolete 'dot 'point) (make-obsolete 'dot-max 'point-max) (make-obsolete 'dot-min 'point-min) (make-obsolete 'dot-marker 'point-marker) (make-obsolete 'buffer-flush-undo 'buffer-disable-undo) (make-obsolete 'baud-rate "use the baud-rate variable instead") (make-obsolete 'compiled-function-p 'byte-code-function-p) (make-obsolete-variable 'auto-fill-hook 'auto-fill-function) (make-obsolete-variable 'blink-paren-hook 'blink-paren-function) (make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function) (make-obsolete-variable 'temp-buffer-show-hook 'temp-buffer-show-function) (make-obsolete-variable 'inhibit-local-variables "use enable-local-variables (with the reversed sense).") (make-obsolete-variable 'unread-command-char "use unread-command-events instead. That variable is a list of events to reread, so it now uses nil to mean `no event', instead of -1.") (make-obsolete-variable 'unread-command-event "use unread-command-events; which is a list of events rather than a single event.") (make-obsolete-variable 'suspend-hooks 'suspend-hook) (make-obsolete-variable 'comment-indent-hook 'comment-indent-function) (make-obsolete-variable 'meta-flag "Use the set-input-mode function instead.") (make-obsolete-variable 'executing-macro 'executing-kbd-macro) (make-obsolete-variable 'before-change-function "use before-change-functions; which is a list of functions rather than a single function.") (make-obsolete-variable 'after-change-function "use after-change-functions; which is a list of functions rather than a single function.") (make-obsolete-variable 'font-lock-doc-string-face 'font-lock-string-face) (provide 'byte-compile) (provide 'bytecomp) ;;; report metering (see the hacks in bytecode.c) (defun byte-compile-report-ops () (defvar byte-code-meter) (with-output-to-temp-buffer "*Meter*" (set-buffer "*Meter*") (let ((i 0) n op off) (while (< i 256) (setq n (aref (aref byte-code-meter 0) i) off nil) (if t ;(not (zerop n)) (progn (setq op i) (setq off nil) (cond ((< op byte-nth) (setq off (logand op 7)) (setq op (logand op 248))) ((>= op byte-constant) (setq off (- op byte-constant) op byte-constant))) (setq op (aref byte-code-vector op)) (insert (format "%-4d" i)) (insert (symbol-name op)) (if off (insert " [" (int-to-string off) "]")) (indent-to 40) (insert (int-to-string n) "\n"))) (setq i (1+ i)))))) ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when bytecomp compiles ;; itself, compile some of its most used recursive functions (at load time). ;; (eval-when-compile (or (byte-code-function-p (symbol-function 'byte-compile-form)) (assq 'byte-code (symbol-function 'byte-compile-form)) (let ((byte-optimize nil) ; do it fast (byte-compile-warnings nil)) (mapcar '(lambda (x) (or noninteractive (message "compiling %s..." x)) (byte-compile x) (or noninteractive (message "compiling %s...done" x))) '(byte-compile-normal-call byte-compile-form byte-compile-body ;; Inserted some more than necessary, to speed it up. byte-compile-top-level byte-compile-out-toplevel byte-compile-constant byte-compile-variable-ref)))) nil) ;;; bytecomp.el ends here emacs-19.30/lisp/bytecpat.el100444 12120 1 1243 6045200427 14203 0ustar rmsdaemon;;; bytecpat.el --- do recompilation for Emacs patch files. ;;; This function is used by the patch files to update Emacs releases. (defun batch-byte-recompile-emacs () "Recompile the Emacs `lisp' directory. This is used after installing the patches for a new version." (let ((load-path (list (expand-file-name "lisp")))) (byte-recompile-directory "lisp"))) (defun batch-byte-compile-emacs () "Compile new files installed in the Emacs `lisp' directory. This is used after installing the patches for a new version. It uses the command line arguments to specify the files to compile." (let ((load-path (list (expand-file-name "lisp")))) (batch-byte-compile))) emacs-19.30/lisp/c-mode.el100444 75424 1 166257 6006020611 14007 0ustar kwzhdaemon;;; c-mode.el --- C code editing commands for Emacs ;; Copyright (C) 1985, 86, 87, 92, 94, 95 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: c ;; 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: ;; A smart editing mode for C code. It knows a lot about C syntax and tries ;; to position the cursor according to C layout conventions. You can ;; change the details of the layout style with option variables. Load it ;; and do M-x describe-mode for details. ;;; Code: (defvar c-mode-abbrev-table nil "Abbrev table in use in C mode.") (define-abbrev-table 'c-mode-abbrev-table ()) (defvar c-mode-map (make-sparse-keymap) "Keymap used in C mode.") (define-key c-mode-map "{" 'electric-c-brace) (define-key c-mode-map "}" 'electric-c-brace) (define-key c-mode-map ";" 'electric-c-semi) (define-key c-mode-map "#" 'electric-c-sharp-sign) (define-key c-mode-map ":" 'electric-c-terminator) (define-key c-mode-map "\e\C-h" 'mark-c-function) (define-key c-mode-map "\e\C-q" 'indent-c-exp) (define-key c-mode-map "\ea" 'c-beginning-of-statement) (define-key c-mode-map "\ee" 'c-end-of-statement) (define-key c-mode-map "\C-c\C-n" 'c-forward-conditional) (define-key c-mode-map "\C-c\C-p" 'c-backward-conditional) (define-key c-mode-map "\C-c\C-u" 'c-up-conditional) (define-key c-mode-map "\177" 'backward-delete-char-untabify) (define-key c-mode-map "\t" 'c-indent-command) (define-key c-mode-map [menu-bar] (make-sparse-keymap)) ;; "C-mode" is not strictly the right punctuation--it should be "C ;; mode"--but that would look like two menu items. "C-mode" is the ;; best alternative I can think of. (define-key c-mode-map [menu-bar c] (cons "C-mode" (make-sparse-keymap "C-mode"))) (define-key c-mode-map [menu-bar c comment-region] '("Comment Out Region" . comment-region)) (define-key c-mode-map [menu-bar c c-macro-expand] '("Macro Expand Region" . c-macro-expand)) (define-key c-mode-map [menu-bar c c-backslash-region] '("Backslashify" . c-backslash-region)) (define-key c-mode-map [menu-bar c indent-exp] '("Indent Expression" . indent-c-exp)) (define-key c-mode-map [menu-bar c indent-line] '("Indent Line" . c-indent-command)) (define-key c-mode-map [menu-bar c fill] '("Fill Comment Paragraph" . c-fill-paragraph)) (define-key c-mode-map [menu-bar c cpp-highlight-buffer] '("Highlight Conditionals" . cpp-highlight-buffer)) (define-key c-mode-map [menu-bar c up] '("Up Conditional" . c-up-conditional)) (define-key c-mode-map [menu-bar c backward] '("Backward Conditional" . c-backward-conditional)) (define-key c-mode-map [menu-bar c forward] '("Forward Conditional" . c-forward-conditional)) (define-key c-mode-map [menu-bar c backward-stmt] '("Backward Statement" . c-beginning-of-statement)) (define-key c-mode-map [menu-bar c forward-stmt] '("Forward Statement" . c-end-of-statement)) (put 'comment-region 'menu-enable 'mark-active) (put 'c-macro-expand 'menu-enable 'mark-active) (put 'c-backslash-region 'menu-enable 'mark-active) (autoload 'c-macro-expand "cmacexp" "Display the result of expanding all C macros occurring in the region. The expansion is entirely correct because it uses the C preprocessor." t) (defvar c-mode-syntax-table nil "Syntax table in use in C-mode buffers.") (if c-mode-syntax-table () (setq c-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?\\ "\\" c-mode-syntax-table) (modify-syntax-entry ?/ ". 14" c-mode-syntax-table) (modify-syntax-entry ?* ". 23" c-mode-syntax-table) (modify-syntax-entry ?+ "." c-mode-syntax-table) (modify-syntax-entry ?- "." c-mode-syntax-table) (modify-syntax-entry ?= "." c-mode-syntax-table) (modify-syntax-entry ?% "." c-mode-syntax-table) (modify-syntax-entry ?< "." c-mode-syntax-table) (modify-syntax-entry ?> "." c-mode-syntax-table) (modify-syntax-entry ?& "." c-mode-syntax-table) (modify-syntax-entry ?| "." c-mode-syntax-table) (modify-syntax-entry ?\' "\"" c-mode-syntax-table)) (defconst c-indent-level 2 "*Indentation of C statements with respect to containing block.") (defconst c-brace-imaginary-offset 0 "*Imagined indentation of a C open brace that actually follows a statement.") (defconst c-brace-offset 0 "*Extra indentation for braces, compared with other text in same context.") (defconst c-argdecl-indent 5 "*Indentation level of declarations of C function arguments.") (defconst c-label-offset -2 "*Offset of C label lines and case statements relative to usual indentation.") (defconst c-continued-statement-offset 2 "*Extra indent for lines not starting new statements.") (defconst c-continued-brace-offset 0 "*Extra indent for substatements that start with open-braces. This is in addition to `c-continued-statement-offset'.") (defconst c-style-alist '(("GNU" (c-indent-level . 2) (c-argdecl-indent . 5) (c-brace-offset . 0) (c-continued-brace-offset . 0) (c-label-offset . -2) (c-continued-statement-offset . 2)) ("K&R" (c-indent-level . 5) (c-argdecl-indent . 0) (c-brace-offset . 0) (c-continued-brace-offset . -5) (c-label-offset . -5) (c-continued-statement-offset . 5)) ("BSD" (c-indent-level . 4) (c-argdecl-indent . 4) (c-brace-offset . 0) (c-continued-brace-offset . -4) (c-label-offset . -4) (c-continued-statement-offset . 4)) ("C++" (c-indent-level . 4) (c-argdecl-indent . 0) (c-brace-offset . 0) (c-continued-brace-offset . -4) (c-label-offset . -4) (c-continued-statement-offset . 4) (c-auto-newline . t)) ("Whitesmith" (c-indent-level . 4) (c-argdecl-indent . 4) (c-brace-offset . 0) (c-continued-brace-offset . 0) (c-label-offset . -4) (c-continued-statement-offset . 4)))) (defconst c-auto-newline nil "*Non-nil means automatically newline before and after braces, and after colons and semicolons, inserted in C code. If you do not want a leading newline before braces then use: (define-key c-mode-map \"{\" 'electric-c-semi)") (defconst c-tab-always-indent t "*Non-nil means TAB in C mode should always reindent the current line, regardless of where in the line point is when the TAB command is used.") ;;; Regular expression used internally to recognize labels in switch ;;; statements. (defconst c-switch-label-regexp "case[ \t'/(]\\|default[ \t]*:") ;; This is actually the expression for C++ mode, but it's used for C too. (defvar c-imenu-generic-expression (` ((nil (, (concat "^" ; beginning of line is required "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? "\\(" ; last type spec including */& "[a-zA-Z0-9_:]+" "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either pointer/ref sign or whitespace "\\)?" ; if there is a last type spec "\\(" ; name; take that into the imenu entry "[a-zA-Z0-9_:~]+" ; member function, ctor or dtor... ; (may not contain * because then ; "a::operator char*" would become "char*"!) "\\|" "\\([a-zA-Z0-9_:~]*::\\)?operator" "[^a-zA-Z1-9_][^(]*" ; ...or operator " \\)" "[ \t]*([^)]*)[ \t\n]*[^ ;]" ; require something other than a ; after ; the (...) to avoid prototypes. Can't ; catch cases with () inside the parentheses ; surrounding the parameters ; (like "int foo(int a=bar()) {...}" )) 6) ("Class" (, (concat "^" ; beginning of line is required "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" "class[ \t]+" "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get "[ \t]*[:{]" )) 2) ;; Example of generic expression for finding prototypes, structs, unions, enums. ;; Uncomment if you want to find these too. It will be a bit slower gathering ;; the indexes. ; ("Prototypes" ; (, ; (concat ; "^" ; beginning of line is required ; "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" ; "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no ; "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? ; "\\(" ; last type spec including */& ; "[a-zA-Z0-9_:]+" ; "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either pointer/ref sign or whitespace ; "\\)?" ; if there is a last type spec ; "\\(" ; name; take that into the imenu entry ; "[a-zA-Z0-9_:~]+" ; member function, ctor or dtor... ; ; (may not contain * because then ; ; "a::operator char*" would become "char*"!) ; "\\|" ; "\\([a-zA-Z0-9_:~]*::\\)?operator" ; "[^a-zA-Z1-9_][^(]*" ; ...or operator ; " \\)" ; "[ \t]*([^)]*)[ \t\n]*;" ; require ';' after ; ; the (...) Can't ; ; catch cases with () inside the parentheses ; ; surrounding the parameters ; ; (like "int foo(int a=bar());" ; )) 6) ; ("Struct" ; (, (concat ; "^" ; beginning of line is required ; "\\(static[ \t]+\\)?" ; there may be static or const. ; "\\(const[ \t]+\\)?" ; "struct[ \t]+" ; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get ; "[ \t]*[{]" ; )) 3) ; ("Enum" ; (, (concat ; "^" ; beginning of line is required ; "\\(static[ \t]+\\)?" ; there may be static or const. ; "\\(const[ \t]+\\)?" ; "enum[ \t]+" ; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get ; "[ \t]*[{]" ; )) 3) ; ("Union" ; (, (concat ; "^" ; beginning of line is required ; "\\(static[ \t]+\\)?" ; there may be static or const. ; "\\(const[ \t]+\\)?" ; "union[ \t]+" ; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get ; "[ \t]*[{]" ; )) 3) )) "Imenu generic expression for C mode. See `imenu-generic-expression'.") (defun c-mode () "Major mode for editing C code. Expression and list commands understand all C brackets. Tab indents for C code. Comments are delimited with /* ... */. Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \\{c-mode-map} Variables controlling indentation style: c-tab-always-indent Non-nil means TAB in C mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. c-auto-newline Non-nil means automatically newline before and after braces, and after colons and semicolons, inserted in C code. c-indent-level Indentation of C statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. c-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. c-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to c-continued-statement-offset. c-brace-offset Extra indentation for line if it starts with an open brace. c-brace-imaginary-offset An open brace following other text is treated as if it were this far to the right of the start of its line. c-argdecl-indent Indentation level of declarations of C function arguments. c-label-offset Extra indentation for line that is a label, or case or default. Settings for K&R and BSD indentation styles are c-indent-level 5 8 c-continued-statement-offset 5 8 c-brace-offset -5 -8 c-argdecl-indent 0 8 c-label-offset -5 -8 Turning on C mode calls the value of the variable c-mode-hook with no args, if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map c-mode-map) (setq major-mode 'c-mode) (setq mode-name "C") (setq local-abbrev-table c-mode-abbrev-table) (set-syntax-table c-mode-syntax-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) (make-local-variable 'fill-paragraph-function) (setq fill-paragraph-function 'c-fill-paragraph) (make-local-variable 'indent-line-function) (setq indent-line-function 'c-indent-line) (make-local-variable 'indent-region-function) (setq indent-region-function 'c-indent-region) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'outline-regexp) (setq outline-regexp "[^#\n\^M]") (make-local-variable 'outline-level) (setq outline-level 'c-outline-level) (make-local-variable 'comment-start) (setq comment-start "/* ") (make-local-variable 'comment-end) (setq comment-end " */") (make-local-variable 'comment-column) (setq comment-column 32) (make-local-variable 'comment-start-skip) (setq comment-start-skip "/\\*+ *") (make-local-variable 'comment-indent-function) (setq comment-indent-function 'c-comment-indent) (make-local-variable 'comment-multi-line) (setq comment-multi-line t) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression c-imenu-generic-expression) (run-hooks 'c-mode-hook)) (defun c-outline-level () (save-excursion (skip-chars-forward "\t ") (current-column))) ;; This is used by indent-for-comment ;; to decide how much to indent a comment in C code ;; based on its context. (defun c-comment-indent () (if (looking-at "^/\\*") 0 ;Existing comment at bol stays there. (let ((opoint (point))) (save-excursion (beginning-of-line) (cond ((looking-at "[ \t]*}[ \t]*\\($\\|/\\*\\)") ;; A comment following a solitary close-brace ;; should have only one space. (search-forward "}") (1+ (current-column))) ((or (looking-at "^#[ \t]*endif[ \t]*") (looking-at "^#[ \t]*else[ \t]*")) 7) ;2 spaces after #endif ((progn (goto-char opoint) (skip-chars-backward " \t") (and (= comment-column 0) (bolp))) ;; If comment-column is 0, and nothing but space ;; before the comment, align it at 0 rather than 1. 0) (t (max (1+ (current-column)) ;Else indent at comment column comment-column))))))) ; except leave at least one space. (defun c-fill-paragraph (&optional arg) "Like \\[fill-paragraph] but handle C comments. If any of the current line is a comment or within a comment, fill the comment or the paragraph of it that point is in, preserving the comment indentation or line-starting decorations." (interactive "P") (let* (comment-start-place (first-line ;; Check for obvious entry to comment. (save-excursion (beginning-of-line) (skip-chars-forward " \t\n") (and (looking-at comment-start-skip) (setq comment-start-place (point)))))) (if (and (eq major-mode 'c++-mode) (save-excursion (beginning-of-line) (looking-at ".*//"))) (let (fill-prefix (paragraph-start ;; Lines containing just a comment start or just an end ;; should not be filled into paragraphs they are next to. (concat paragraph-start "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$")) (paragraph-separate (concat paragraph-separate "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$"))) (save-excursion (beginning-of-line) ;; Move up to first line of this comment. (while (and (not (bobp)) (looking-at "[ \t]*//")) (forward-line -1)) (if (not (looking-at ".*//")) (forward-line 1)) ;; Find the comment start in this line. (re-search-forward "[ \t]*//[ \t]*") ;; Set the fill-prefix to be what all lines except the first ;; should start with. (let ((endcol (current-column))) (skip-chars-backward " \t") (setq fill-prefix (concat (make-string (- (current-column) 2) ?\ ) "//" (make-string (- endcol (current-column)) ?\ )))) (save-restriction ;; Narrow down to just the lines of this comment. (narrow-to-region (point) (save-excursion (forward-line 1) (while (looking-at "[ \t]*//") (forward-line 1)) (point))) (insert fill-prefix) (fill-paragraph arg) (delete-region (point-min) (+ (point-min) (length fill-prefix)))))) (if (or first-line ;; t if we enter a comment between start of function and this line. (eq (calculate-c-indent) t) ;; t if this line contains a comment starter. (setq first-line (save-excursion (beginning-of-line) (prog1 (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t) (setq comment-start-place (point)))))) ;; Inside a comment: fill one comment paragraph. (let ((fill-prefix ;; The prefix for each line of this paragraph ;; is the appropriate part of the start of this line, ;; up to the column at which text should be indented. (save-excursion (beginning-of-line) (if (looking-at "[ \t]*/\\*.*\\*/") (progn (re-search-forward comment-start-skip) (make-string (current-column) ?\ )) (if first-line (forward-line 1)) (let ((line-width (progn (end-of-line) (current-column)))) (beginning-of-line) (prog1 (buffer-substring (point) ;; How shall we decide where the end of the ;; fill-prefix is? ;; calculate-c-indent-within-comment bases its value ;; on the indentation of previous lines; if they're ;; indented specially, it could return a column ;; that's well into the current line's text. So ;; we'll take at most that many space, tab, or * ;; characters, and use that as our fill prefix. (let ((max-prefix-end (progn (move-to-column (calculate-c-indent-within-comment t) t) (point)))) (beginning-of-line) (skip-chars-forward " \t*" max-prefix-end) ;; Don't include part of comment terminator ;; in the fill-prefix. (and (eq (following-char) ?/) (eq (preceding-char) ?*) (backward-char 1)) (point))) ;; If the comment is only one line followed by a blank ;; line, calling move-to-column above may have added ;; some spaces and tabs to the end of the line; the ;; fill-paragraph function will then delete it and the ;; newline following it, so we'll lose a blank line ;; when we shouldn't. So delete anything ;; move-to-column added to the end of the line. We ;; record the line width instead of the position of the ;; old line end because move-to-column might break a ;; tab into spaces, and the new characters introduced ;; there shouldn't be deleted. ;; If you can see a better way to do this, please make ;; the change. This seems very messy to me. (delete-region (progn (move-to-column line-width) (point)) (progn (end-of-line) (point)))))))) (paragraph-start ;; Lines containing just a comment start or just an end ;; should not be filled into paragraphs they are next to. (concat paragraph-start "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$")) (paragraph-separate (concat paragraph-separate "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$")) (chars-to-delete 0)) (save-restriction ;; Don't fill the comment together with the code following it. ;; So temporarily exclude everything before the comment start, ;; and everything after the line where the comment ends. ;; If comment-start-place is non-nil, the comment starter is there. ;; Otherwise, point is inside the comment. (narrow-to-region (save-excursion (if comment-start-place (goto-char comment-start-place) (search-backward "/*")) ;; Protect text before the comment start ;; by excluding it. Add spaces to bring back ;; proper indentation of that point. (let ((column (current-column))) (prog1 (point) (setq chars-to-delete column) (insert-char ?\ column)))) (save-excursion (if comment-start-place (goto-char (+ comment-start-place 2))) (search-forward "*/" nil 'move) (forward-line 1) (point))) (save-excursion (goto-char (point-max)) (forward-line -1) ;; And comment terminator was on a separate line before, ;; keep it that way. ;; This also avoids another problem: ;; if the fill-prefix ends in a *, it could eat up ;; the * of the comment terminator. (if (looking-at "[ \t]*\\*/") (narrow-to-region (point-min) (point)))) (fill-paragraph arg) (save-excursion ;; Delete the chars we inserted to avoid clobbering ;; the stuff before the comment start. (goto-char (point-min)) (if (> chars-to-delete 0) (delete-region (point) (+ (point) chars-to-delete))) ;; Find the comment ender (should be on last line of buffer, ;; given the narrowing) and don't leave it on its own line. ;; Do this with a fill command, so as to preserve sentence ;; boundaries. (goto-char (point-max)) (forward-line -1) (search-forward "*/" nil 'move) (beginning-of-line) (if (looking-at "[ \t]*\\*/") (let ((fill-column (+ fill-column 9999))) (forward-line -1) (fill-region-as-paragraph (point) (point-max))))))) ;; Outside of comments: do ordinary filling. (fill-paragraph arg))) t)) (defun electric-c-brace (arg) "Insert character and correct line's indentation." (interactive "P") (let (insertpos) (if (and (not arg) (eolp) (or (save-excursion (skip-chars-backward " \t") (bolp)) (if c-auto-newline (progn (c-indent-line) (newline) t) nil))) (progn (insert last-command-char) (c-indent-line) (if c-auto-newline (progn (newline) ;; (newline) may have done auto-fill (setq insertpos (- (point) 2)) (c-indent-line))) (save-excursion (if insertpos (goto-char (1+ insertpos))) (delete-char -1)))) (if insertpos (save-excursion (goto-char insertpos) (self-insert-command (prefix-numeric-value arg))) (self-insert-command (prefix-numeric-value arg))))) (defun electric-c-sharp-sign (arg) "Insert character and correct line's indentation." (interactive "P") (if (save-excursion (skip-chars-backward " \t") (bolp)) (let ((c-auto-newline nil)) (electric-c-terminator arg)) (self-insert-command (prefix-numeric-value arg)))) (defun electric-c-semi (arg) "Insert character and correct line's indentation." (interactive "P") (if c-auto-newline (electric-c-terminator arg) (self-insert-command (prefix-numeric-value arg)))) (defun electric-c-terminator (arg) "Insert character and correct line's indentation." (interactive "P") (let (insertpos (end (point))) (if (and (not arg) (eolp) (not (save-excursion (beginning-of-line) (skip-chars-forward " \t") (or (= (following-char) ?#) ;; Colon is special only after a label, or case .... ;; So quickly rule out most other uses of colon ;; and do no indentation for them. (and (eq last-command-char ?:) (not (looking-at c-switch-label-regexp)) (save-excursion (skip-chars-forward "a-zA-Z0-9_$") (skip-chars-forward " \t") (< (point) end))) (progn (beginning-of-defun) (let ((pps (parse-partial-sexp (point) end))) (or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))))) (progn (insert last-command-char) (c-indent-line) (and c-auto-newline (not (c-inside-parens-p)) (progn (newline) ;; (newline) may have done auto-fill (setq insertpos (- (point) 2)) (c-indent-line))) (save-excursion (if insertpos (goto-char (1+ insertpos))) (delete-char -1)))) (if insertpos (save-excursion (goto-char insertpos) (self-insert-command (prefix-numeric-value arg))) (self-insert-command (prefix-numeric-value arg))))) (defun c-inside-parens-p () (condition-case () (save-excursion (save-restriction (narrow-to-region (point) (progn (beginning-of-defun) (point))) (goto-char (point-max)) (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\())) (error nil))) (defun c-indent-command (&optional whole-exp) "Indent current line as C code, or in some cases insert a tab character. If `c-tab-always-indent' is non-nil (the default), always indent current line. Otherwise, indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. A numeric argument, regardless of its value, means indent rigidly all the lines of the expression starting after point so that this line becomes properly indented. The relative indentation among the lines of the expression are preserved." (interactive "P") (if whole-exp ;; If arg, always indent this line as C ;; and shift remaining lines of expression the same amount. (let ((shift-amt (c-indent-line)) beg end) (save-excursion (if c-tab-always-indent (beginning-of-line)) ;; Find beginning of following line. (save-excursion (forward-line 1) (setq beg (point))) ;; Find first beginning-of-sexp for sexp extending past this line. (while (< (point) beg) (forward-sexp 1) (setq end (point)) (skip-chars-forward " \t\n"))) (if (> end beg) (indent-code-rigidly beg end shift-amt "#"))) (if (and (not c-tab-always-indent) (save-excursion (skip-chars-backward " \t") (not (bolp)))) (insert-tab) (c-indent-line)))) (defun c-indent-line () "Indent current line as C code. Return the amount the indentation changed by." (let ((indent (calculate-c-indent nil)) beg shift-amt (case-fold-search nil) (pos (- (point-max) (point)))) (beginning-of-line) (setq beg (point)) (cond ((eq indent nil) (setq indent (current-indentation))) ((eq indent t) (setq indent (calculate-c-indent-within-comment))) ((looking-at "[ \t]*#") (setq indent 0)) (t (skip-chars-forward " \t") (if (listp indent) (setq indent (car indent))) (cond ((or (looking-at c-switch-label-regexp) (and (looking-at "[A-Za-z]") (save-excursion (forward-sexp 1) (looking-at ":")))) (setq indent (max 1 (+ indent c-label-offset)))) ((and (looking-at "else\\b") (not (looking-at "else\\s_"))) (setq indent (save-excursion (c-backward-to-start-of-if) (current-indentation)))) ((and (looking-at "}[ \t]*else\\b") (not (looking-at "}[ \t]*else\\s_"))) (setq indent (save-excursion (forward-char) (backward-sexp) (c-backward-to-start-of-if) (current-indentation)))) ((and (looking-at "while\\b") (not (looking-at "while\\s_")) (save-excursion (c-backward-to-start-of-do))) ;; This is a `while' that ends a do-while. (setq indent (save-excursion (c-backward-to-start-of-do) (current-indentation)))) ((= (following-char) ?}) (setq indent (- indent c-indent-level))) ((= (following-char) ?{) (setq indent (+ indent c-brace-offset)))))) (skip-chars-forward " \t") (setq shift-amt (- indent (current-column))) (if (zerop shift-amt) (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) (delete-region beg (point)) (indent-to indent) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos)))) shift-amt)) (defun calculate-c-indent (&optional parse-start) "Return appropriate indentation for current line as C code. In usual case returns an integer: the column to indent to. Returns nil if line starts inside a string, t if in a comment." (save-excursion (beginning-of-line) (let ((indent-point (point)) (case-fold-search nil) state containing-sexp) (if parse-start (goto-char parse-start) (beginning-of-defun)) (while (< (point) indent-point) (setq parse-start (point)) (setq state (parse-partial-sexp (point) indent-point 0)) (setq containing-sexp (car (cdr state)))) (cond ((or (nth 3 state) (nth 4 state)) ;; return nil or t if should not change this line (nth 4 state)) ((null containing-sexp) ;; Line is at top level. May be data or function definition, ;; or may be function argument declaration. ;; Indent like the previous top level line ;; unless that ends in a closeparen without semicolon, ;; in which case this line is the first argument decl. (goto-char indent-point) (skip-chars-forward " \t") (if (= (following-char) ?{) 0 ; Unless it starts a function body (c-backward-to-noncomment (or parse-start (point-min))) ;; Look at previous line that's at column 0 ;; to determine whether we are in top-level decls ;; or function's arg decls. Set basic-indent accordingly. (let ((basic-indent (save-excursion (re-search-backward "^[^ \^L\t\n#]" nil 'move) (let (comment lim) ;; Recognize the DEFUN macro in Emacs. (if (save-excursion ;; Move down to the (putative) argnames line. (while (and (not (eobp)) (not (looking-at " *[({}#/]"))) (forward-line 1)) ;; Go back to the DEFUN, if it is one. (condition-case nil (backward-sexp 1) (error)) (beginning-of-line) (looking-at "DEFUN\\b")) c-argdecl-indent (if (and (looking-at "\\sw\\|\\s_") ;; This is careful to stop at the first ;; paren if we have ;; int foo Proto ((int, int)); (looking-at "[^\"\n=(]*(") (progn (goto-char (1- (match-end 0))) ;; Skip any number of paren-groups. ;; Consider typedef int (*fcn) (int); (while (= (following-char) ?\() (setq lim (point)) (condition-case nil (forward-sexp 1) (error)) (skip-chars-forward " \t\f")) ;; Have we reached something ;; that shows this isn't a function ;; definition? (and (< (point) indent-point) (not (memq (following-char) '(?\, ?\;))))) ;; Make sure the "function decl" we found ;; is not inside a comment. (progn ;; Move back to the `(' starting arglist (goto-char lim) (beginning-of-line) (while (and (not comment) (search-forward "/*" lim t)) (setq comment (not (search-forward "*/" lim t)))) (not comment))) c-argdecl-indent 0)))))) basic-indent))) ;; ;; Now add a little if this is a continuation line. ;; (+ basic-indent (if (or (bobp) ;; (memq (preceding-char) '(?\) ?\; ?\})) ;; ;; Line with zero indentation ;; ;; is probably the return-type ;; ;; of a function definition, ;; ;; so following line is function name. ;; (= (current-indentation) 0)) ;; 0 c-continued-statement-offset)) ((/= (char-after containing-sexp) ?{) ;; line is expression, not statement: ;; indent to just after the surrounding open. (goto-char (1+ containing-sexp)) (current-column)) (t ;; Statement level. Is it a continuation or a new statement? ;; Find previous non-comment character. (goto-char indent-point) (c-backward-to-noncomment containing-sexp) ;; Back up over label lines, since they don't ;; affect whether our line is a continuation. (while (or (eq (preceding-char) ?\,) (and (eq (preceding-char) ?:) (or (eq (char-after (- (point) 2)) ?\') (memq (char-syntax (char-after (- (point) 2))) '(?w ?_))))) (if (eq (preceding-char) ?\,) (progn (forward-char -1) (c-backward-to-start-of-continued-exp containing-sexp))) (beginning-of-line) (c-backward-to-noncomment containing-sexp)) ;; Check for a preprocessor statement or its continuation lines. ;; Move back to end of previous non-preprocessor line, ;; or possibly beginning of buffer. (let ((found (point)) stop) (while (not stop) (beginning-of-line) (cond ((bobp) (setq found (point) stop t)) ((save-excursion (forward-char -1) (= (preceding-char) ?\\)) (forward-char -1)) ;; This line is not preceded by a backslash. ;; So either it starts a preprocessor command ;; or any following continuation lines ;; should not be skipped. ((= (following-char) ?#) (forward-char -1) (setq found (point))) (t (setq stop t)))) (goto-char found)) ;; Now we get the answer. (if (and (not (memq (preceding-char) '(0 ?\, ?\; ?\} ?\{))) ;; But don't treat a line with a close-brace ;; as a continuation. It is probably the ;; end of an enum type declaration. (save-excursion (goto-char indent-point) (skip-chars-forward " \t") (not (= (following-char) ?})))) ;; This line is continuation of preceding line's statement; ;; indent c-continued-statement-offset more than the ;; previous line of the statement. (progn (c-backward-to-start-of-continued-exp containing-sexp) (+ c-continued-statement-offset (current-column) (if (save-excursion (goto-char indent-point) (skip-chars-forward " \t") (eq (following-char) ?{)) c-continued-brace-offset 0))) ;; This line starts a new statement. ;; Position following last unclosed open. (goto-char containing-sexp) ;; Is line first statement after an open-brace? (or ;; If no, find that first statement and indent like it. (save-excursion (forward-char 1) (let ((colon-line-end 0)) (while (progn (skip-chars-forward " \t\n") (looking-at "#\\|/\\*\\|case[ \t\n'/(].*:\\|[a-zA-Z0-9_$]*:")) ;; Skip over comments and labels following openbrace. (cond ((= (following-char) ?\#) (forward-line 1)) ((= (following-char) ?\/) (forward-char 2) (search-forward "*/" nil 'move)) ;; case or label: (t (save-excursion (end-of-line) (setq colon-line-end (point))) (search-forward ":")))) ;; The first following code counts ;; if it is before the line we want to indent. (and (< (point) indent-point) (- (if (> colon-line-end (point)) (- (current-indentation) c-label-offset) (current-column)) ;; If prev stmt starts with open-brace, that ;; open brace was offset by c-brace-offset. ;; Compensate to get the column where ;; an ordinary statement would start. (if (= (following-char) ?\{) c-brace-offset 0))))) ;; If no previous statement, ;; indent it relative to line brace is on. (calculate-c-indent-after-brace)))))))) (defun calculate-c-indent-after-brace () "Return the proper C indent for the first line after an open-brace. This function is called with point before the brace." ;; For open brace in column zero, don't let statement ;; start there too. If c-indent-level is zero, ;; use c-brace-offset + c-continued-statement-offset instead. ;; For open-braces not the first thing in a line, ;; add in c-brace-imaginary-offset. (+ (if (and (bolp) (zerop c-indent-level)) (+ c-brace-offset c-continued-statement-offset) c-indent-level) ;; Move back over whitespace before the openbrace. ;; If openbrace is not first nonwhite thing on the line, ;; add the c-brace-imaginary-offset. (progn (skip-chars-backward " \t") (if (bolp) 0 c-brace-imaginary-offset)) ;; If the openbrace is preceded by a parenthesized exp, ;; move to the beginning of that; ;; possibly a different line (progn (if (eq (preceding-char) ?\)) (forward-sexp -1)) ;; Get initial indentation of the line we are on. (current-indentation)))) (defun calculate-c-indent-within-comment (&optional after-star) "Return the indentation amount for line inside a block comment. Optional arg AFTER-STAR means, if lines in the comment have a leading star, return the indentation of the text that would follow this star." (let (end star-start) (save-excursion (beginning-of-line) (skip-chars-forward " \t") (setq star-start (= (following-char) ?\*)) (skip-chars-backward " \t\n") (setq end (point)) (beginning-of-line) (skip-chars-forward " \t") (if after-star (and (looking-at "\\*") (re-search-forward "\\*[ \t]*"))) (and (re-search-forward "/\\*[ \t]*" end t) star-start (not after-star) (goto-char (1+ (match-beginning 0)))) (if (and (looking-at "[ \t]*$") (= (preceding-char) ?\*)) (1+ (current-column)) (current-column))))) (defun c-backward-to-noncomment (lim) (let (opoint stop) (while (not stop) (skip-chars-backward " \t\n\f" lim) (setq opoint (point)) (if (and (>= (point) (+ 2 lim)) (save-excursion (forward-char -2) (looking-at "\\*/"))) (search-backward "/*" lim 'move) (setq stop (or (<= (point) lim) (save-excursion (beginning-of-line) (skip-chars-forward " \t") (not (looking-at "#"))))) (or stop (beginning-of-line)))))) (defun c-backward-to-start-of-continued-exp (lim) (if (memq (preceding-char) '(?\) ?\")) (forward-sexp -1)) (beginning-of-line) (if (<= (point) lim) (goto-char (1+ lim))) (skip-chars-forward " \t")) (defun c-backward-to-start-of-if (&optional limit) "Move to the start of the last \"unbalanced\" `if'." (or limit (setq limit (save-excursion (beginning-of-defun) (point)))) (let ((if-level 1) (case-fold-search nil)) (while (and (not (bobp)) (not (zerop if-level))) (backward-sexp 1) (cond ((and (looking-at "else\\b") (not (looking-at "else\\s_"))) (setq if-level (1+ if-level))) ((and (looking-at "if\\b") (not (looking-at "if\\s_"))) (setq if-level (1- if-level))) ((< (point) limit) (setq if-level 0) (goto-char limit)))))) (defun c-backward-to-start-of-do (&optional limit) "If point follows a `do' statement, move to beginning of it and return t. Otherwise return nil and don't move point." (or limit (setq limit (save-excursion (beginning-of-defun) (point)))) (let ((first t) (startpos (point)) (done nil)) (while (not done) (let ((next-start (point))) (condition-case nil ;; Move back one token or one brace or paren group. (backward-sexp 1) ;; If we find an open-brace, we lose. (error (setq done 'fail))) (if done nil ;; If we reached a `do', we win. (if (looking-at "do\\b") (setq done 'succeed) ;; Otherwise, if we skipped a semicolon, we lose. ;; (Exception: we can skip one semicolon before getting ;; to a the last token of the statement, unless that token ;; is a close brace.) (if (save-excursion (forward-sexp 1) (or (and (not first) (= (preceding-char) ?})) (search-forward ";" next-start t (if (and first (/= (preceding-char) ?})) 2 1)))) (setq done 'fail) (setq first nil) ;; If we go too far back in the buffer, we lose. (if (< (point) limit) (setq done 'fail))))))) (if (eq done 'succeed) t (goto-char startpos) nil))) (defun c-beginning-of-statement (count) "Go to the beginning of the innermost C statement. With prefix arg, go back N - 1 statements. If already at the beginning of a statement then go to the beginning of the preceding one. If within a string or comment, or next to a comment (only whitespace between), move by sentences instead of statements." (interactive "p") (let ((here (point)) state) (save-excursion (beginning-of-defun) (setq state (parse-partial-sexp (point) here nil nil))) (if (or (nth 3 state) (nth 4 state) (looking-at (concat "[ \t]*" comment-start-skip)) (save-excursion (skip-chars-backward " \t") (goto-char (- (point) 2)) (looking-at "\\*/"))) (forward-sentence (- count)) (while (> count 0) (c-beginning-of-statement-1) (setq count (1- count))) (while (< count 0) (c-end-of-statement-1) (setq count (1+ count)))))) (defun c-end-of-statement (count) "Go to the end of the innermost C statement. With prefix arg, go forward N - 1 statements. Move forward to end of the next statement if already at end. If within a string or comment, move by sentences instead of statements." (interactive "p") (c-beginning-of-statement (- count))) (defun c-beginning-of-statement-1 () (let ((last-begin (point)) (first t)) (condition-case () (progn (while (and (not (bobp)) (progn (backward-sexp 1) (or first (not (re-search-forward "[;{}]" last-begin t))))) (setq last-begin (point) first nil)) (goto-char last-begin)) (error (if first (backward-up-list 1) (goto-char last-begin)))))) (defun c-end-of-statement-1 () (condition-case () (progn (while (and (not (eobp)) (let ((beg (point))) (forward-sexp 1) (let ((end (point))) (save-excursion (goto-char beg) (not (re-search-forward "[;{}]" end t))))))) (re-search-backward "[;}]") (forward-char 1)) (error (let ((beg (point))) (backward-up-list -1) (let ((end (point))) (goto-char beg) (search-forward ";" end 'move)))))) (defun mark-c-function () "Put mark at end of C function, point at beginning." (interactive) (push-mark (point)) (end-of-defun) (push-mark (point) nil t) (beginning-of-defun) (backward-paragraph)) ;; Idea of ENDPOS is, indent each line, stopping when ;; ENDPOS is encountered. But it's too much of a pain to make that work. (defun indent-c-exp (&optional endpos) "Indent each line of the C grouping following point." (interactive) (let* ((indent-stack (list nil)) (opoint (point)) ;; May be altered below. (contain-stack (list (if endpos (let (funbeg) ;; Find previous fcn-start. (save-excursion (forward-char 1) (beginning-of-defun) (setq funbeg (point))) (setq opoint funbeg) ;; Try to find containing open, ;; but don't scan past that fcn-start. (save-restriction (narrow-to-region funbeg (point)) (condition-case nil (save-excursion (backward-up-list 1) (point)) ;; We gave up: must be between fcns. ;; Set opoint to beg of prev fcn ;; since otherwise calculate-c-indent ;; will get wrong answers. (error (setq opoint funbeg) (point))))) (point)))) (case-fold-search nil) restart outer-loop-done inner-loop-done state ostate this-indent last-sexp at-else at-brace at-while last-depth this-point (next-depth 0)) ;; If the braces don't match, get an error right away. (save-excursion (forward-sexp 1)) ;; Realign the comment on the first line, even though we don't reindent it. (save-excursion (let ((beg (point))) (and (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t) ;; Make sure this isn't a comment alone on a line ;; (which should be indented like code instead). (save-excursion (goto-char (match-beginning 0)) (skip-chars-backward " \t") (not (bolp))) ;; Make sure the comment starter we found ;; is not actually in a string or quoted. (let ((new-state (parse-partial-sexp beg (point) nil nil state))) (and (not (nth 3 new-state)) (not (nth 5 new-state)))) (progn (indent-for-comment) (beginning-of-line))))) (save-excursion (setq outer-loop-done nil) (while (and (not (eobp)) (if endpos (< (point) endpos) (not outer-loop-done))) (setq last-depth next-depth) ;; Compute how depth changes over this line ;; plus enough other lines to get to one that ;; does not end inside a comment or string. ;; Meanwhile, do appropriate indentation on comment lines. (setq inner-loop-done nil) (while (and (not inner-loop-done) (not (and (eobp) (setq outer-loop-done t)))) (setq ostate state) (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) nil nil state)) (setq next-depth (car state)) (if (and (car (cdr (cdr state))) (>= (car (cdr (cdr state))) 0)) (setq last-sexp (car (cdr (cdr state))))) ;; If this line started within a comment, indent it as such. (if (or (nth 4 ostate) (nth 7 ostate)) (c-indent-line)) ;; If it ends outside of comments or strings, exit the inner loop. ;; Otherwise move on to next line. (if (or (nth 3 state) (nth 4 state) (nth 7 state)) (forward-line 1) (setq inner-loop-done t))) (and endpos (while (< next-depth 0) (setq indent-stack (append indent-stack (list nil))) (setq contain-stack (append contain-stack (list nil))) (setq next-depth (1+ next-depth)) (setq last-depth (1+ last-depth)) (setcar (nthcdr 6 state) (1+ (nth 6 state))))) (setq outer-loop-done (and (not endpos) (<= next-depth 0))) (if outer-loop-done nil ;; If this line had ..))) (((.. in it, pop out of the levels ;; that ended anywhere in this line, even if the final depth ;; doesn't indicate that they ended. (while (> last-depth (nth 6 state)) (setq indent-stack (cdr indent-stack) contain-stack (cdr contain-stack) last-depth (1- last-depth))) (if (/= last-depth next-depth) (setq last-sexp nil)) ;; Add levels for any parens that were started in this line. (while (< last-depth next-depth) (setq indent-stack (cons nil indent-stack) contain-stack (cons nil contain-stack) last-depth (1+ last-depth))) (if (null (car contain-stack)) (setcar contain-stack (or (car (cdr state)) (save-excursion (forward-sexp -1) (point))))) (forward-line 1) (skip-chars-forward " \t") ;; Don't really reindent if the line is just whitespace, ;; or if it is past the endpos. ;; (The exit test in the outer while ;; does not exit until we have passed the first line ;; past the region.) (if (or (eolp) (and endpos (>= (point) endpos))) nil ;; Is this line in a new nesting level? ;; In other words, is this the first line that ;; starts in the new level? (if (and (car indent-stack) (>= (car indent-stack) 0)) nil ;; Yes. ;; Compute the standard indent for this level. (let (val) (if (= (char-after (car contain-stack)) ?{) (save-excursion (goto-char (car contain-stack)) (setq val (calculate-c-indent-after-brace))) (setq val (calculate-c-indent (if (car indent-stack) (- (car indent-stack)) opoint)))) ;; t means we are in a block comment and should ;; calculate accordingly. (if (eq val t) (setq val (calculate-c-indent-within-comment))) (setcar indent-stack val))) ;; Adjust indent of this individual line ;; based on its predecessor. ;; Handle continuation lines, if, else, while, and so on. (if (/= (char-after (car contain-stack)) ?{) (setq this-indent (car indent-stack)) ;; Line is at statement level. ;; Is it a new statement? Is it an else? ;; Find last non-comment character before this line (save-excursion (setq this-point (point)) (setq at-else (and (looking-at "else\\b") (not (looking-at "else\\s_")))) (setq at-brace (= (following-char) ?{)) (setq at-while (and (looking-at "while\\b") (not (looking-at "while\\s_")))) (if (= (following-char) ?}) (setq this-indent (car indent-stack)) (c-backward-to-noncomment opoint) (if (not (memq (preceding-char) '(0 ?\, ?\; ?} ?: ?{))) ;; Preceding line did not end in comma or semi; ;; indent this line c-continued-statement-offset ;; more than previous. (progn (c-backward-to-start-of-continued-exp (car contain-stack)) (setq this-indent (+ c-continued-statement-offset (current-column) (if at-brace c-continued-brace-offset 0)))) ;; Preceding line ended in comma or semi; ;; use the standard indent for this level. (cond (at-else (progn (c-backward-to-start-of-if opoint) (setq this-indent (current-indentation)))) ((and at-while (c-backward-to-start-of-do opoint)) (setq this-indent (current-indentation))) ((eq (preceding-char) ?\,) (goto-char this-point) (setq this-indent (calculate-c-indent))) (t (setq this-indent (car indent-stack)))))))) ;; Adjust line indentation according to its contents (if (or (looking-at c-switch-label-regexp) (and (looking-at "[A-Za-z]") (save-excursion (forward-sexp 1) (looking-at ":")))) (setq this-indent (max 1 (+ this-indent c-label-offset)))) (if (= (following-char) ?}) (setq this-indent (- this-indent c-indent-level))) (if (= (following-char) ?{) ;; Don't move an open-brace in column 0. ;; This is good when constructs such as ;; `extern "C" {' surround a function definition ;; that should be indented as usual. ;; It is also good for nested functions. ;; It is bad when an open-brace is indented at column 0 ;; and you want to fix that, but we can't win 'em all. (if (zerop (current-column)) (setq this-indent 0) (setq this-indent (+ this-indent c-brace-offset)))) ;; Don't leave indentation in empty lines. (if (eolp) (setq this-indent 0)) ;; Put chosen indentation into effect. (or (= (current-column) this-indent) (= (following-char) ?\#) (progn (delete-region (point) (progn (beginning-of-line) (point))) (indent-to this-indent))) ;; Indent any comment following the text. (or (looking-at comment-start-skip) (save-excursion (let ((beg (point))) (and (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t) ;; Make sure the comment starter we found ;; is not actually in a string or quoted. (let ((new-state (parse-partial-sexp beg (point) nil nil state))) (and (not (nth 3 new-state)) (not (nth 5 new-state)))) (indent-for-comment))))))))))) ;; Look at all comment-start strings in the current line after point. ;; Return t if one of them starts a real comment. ;; This is not used yet, because indent-for-comment ;; isn't smart enough to handle the cases this can find. (defun indent-c-find-real-comment () (let (win) (while (and (not win) (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t)) ;; Make sure the comment start is not quoted. (let ((state-1 (parse-partial-sexp (save-excursion (beginning-of-line) (point)) (point) nil nil state))) (setq win (and (null (nth 3 state-1)) (null (nth 5 state-1)))))) win)) ;; Indent every line whose first char is between START and END inclusive. (defun c-indent-region (start end) (save-excursion (goto-char start) ;; Advance to first nonblank line. (skip-chars-forward " \t\n") (beginning-of-line) (let ((endmark (copy-marker end)) (c-tab-always-indent t)) (while (and (bolp) (not (eobp)) (< (point) endmark)) ;; Indent one line as with TAB. (let ((shift-amt (c-indent-line)) nextline sexpbeg sexpend) (if (save-excursion (beginning-of-line) (looking-at "[ \t]*#")) (forward-line 1) (save-excursion ;; Find beginning of following line. (save-excursion (forward-line 1) (setq nextline (point))) ;; Find first beginning-of-sexp for sexp extending past this line. (beginning-of-line) (while (< (point) nextline) (condition-case nil (progn (forward-sexp 1) (setq sexpend (point-marker))) (error (setq sexpend nil) (goto-char nextline))) (skip-chars-forward " \t\n")) (if sexpend (progn ;; Make sure the sexp we found really starts on the ;; current line and extends past it. (goto-char sexpend) (backward-sexp 1) (setq sexpbeg (point))))) ;; If that sexp ends within the region, ;; indent it all at once, fast. (if (and sexpend (> sexpend nextline) (<= sexpend endmark) (< sexpbeg nextline)) (progn (indent-c-exp) (goto-char sexpend))) ;; Move to following line and try again. (and sexpend (set-marker sexpend nil)) (forward-line 1)))) (set-marker endmark nil)))) (defun set-c-style (style &optional global) "Set C-mode variables to use one of several different indentation styles. The arguments are a string representing the desired style and a flag which, if non-nil, means to set the style globally. \(Interactively, the flag comes from the prefix argument.) Available styles are GNU, K&R, BSD and Whitesmith." (interactive (list (let ((completion-ignore-case t)) (completing-read "Use which C indentation style? " c-style-alist nil t)) current-prefix-arg)) (let ((vars (cdr (assoc style c-style-alist)))) (or vars (error "Invalid C indentation style `%s'" style)) (while vars (or global (make-local-variable (car (car vars)))) (set (car (car vars)) (cdr (car vars))) (setq vars (cdr vars))))) ;;; This page handles insertion and removal of backslashes for C macros. (defvar c-backslash-column 48 "*Minimum column for end-of-line backslashes of macro definitions.") (defun c-backslash-region (from to delete-flag) "Insert, align, or delete end-of-line backslashes on the lines in the region. With no argument, inserts backslashes and aligns existing backslashes. With an argument, deletes the backslashes. This function does not modify the last line of the region if the region ends right at the start of the following line; it does not modify blank lines at the start of the region. So you can put the region around an entire macro definition and conveniently use this command." (interactive "r\nP") (save-excursion (goto-char from) (let ((column c-backslash-column) (endmark (make-marker))) (move-marker endmark to) ;; Compute the smallest column number past the ends of all the lines. (if (not delete-flag) (while (< (point) to) (end-of-line) (if (= (preceding-char) ?\\) (progn (forward-char -1) (skip-chars-backward " \t"))) (setq column (max column (1+ (current-column)))) (forward-line 1))) ;; Adjust upward to a tab column, if that doesn't push past the margin. (if (> (% column tab-width) 0) (let ((adjusted (* (/ (+ column tab-width -1) tab-width) tab-width))) (if (< adjusted (window-width)) (setq column adjusted)))) ;; Don't modify blank lines at start of region. (goto-char from) (while (and (< (point) endmark) (eolp)) (forward-line 1)) ;; Add or remove backslashes on all the lines. (while (and (< (point) endmark) ;; Don't backslashify the last line ;; if the region ends right at the start of the next line. (save-excursion (forward-line 1) (< (point) endmark))) (if (not delete-flag) (c-append-backslash column) (c-delete-backslash)) (forward-line 1)) (move-marker endmark nil)))) (defun c-append-backslash (column) (end-of-line) ;; Note that "\\\\" is needed to get one backslash. (if (= (preceding-char) ?\\) (progn (forward-char -1) (delete-horizontal-space) (indent-to column)) (indent-to column) (insert "\\"))) (defun c-delete-backslash () (end-of-line) (or (bolp) (progn (forward-char -1) (if (looking-at "\\\\") (delete-region (1+ (point)) (progn (skip-chars-backward " \t") (point))))))) (defun c-up-conditional (count) "Move back to the containing preprocessor conditional, leaving mark behind. A prefix argument acts as a repeat count. With a negative argument, move forward to the end of the containing preprocessor conditional. When going backwards, `#elif' is treated like `#else' followed by `#if'. When going forwards, `#elif' is ignored." (interactive "p") (c-forward-conditional (- count) t)) (defun c-backward-conditional (count &optional up-flag) "Move back across a preprocessor conditional, leaving mark behind. A prefix argument acts as a repeat count. With a negative argument, move forward across a preprocessor conditional." (interactive "p") (c-forward-conditional (- count) up-flag)) (defun c-forward-conditional (count &optional up-flag) "Move forward across a preprocessor conditional, leaving mark behind. A prefix argument acts as a repeat count. With a negative argument, move backward across a preprocessor conditional." (interactive "p") (let* ((forward (> count 0)) (increment (if forward -1 1)) (search-function (if forward 're-search-forward 're-search-backward)) (opoint (point)) (new)) (save-excursion (while (/= count 0) (let ((depth (if up-flag 0 -1)) found) (save-excursion ;; Find the "next" significant line in the proper direction. (while (and (not found) ;; Rather than searching for a # sign that comes ;; at the beginning of a line aside from whitespace, ;; search first for a string starting with # sign. ;; Then verify what precedes it. ;; This is faster on account of the fastmap feature of ;; the regexp matcher. (funcall search-function "#[ \t]*\\(if\\|elif\\|endif\\)" nil t)) (beginning-of-line) ;; Now verify it is really a preproc line. (if (looking-at "^[ \t]*#[ \t]*\\(if\\|elif\\|endif\\)") (let ((prev depth)) ;; Update depth according to what we found. (beginning-of-line) (cond ((looking-at "[ \t]*#[ \t]*endif") (setq depth (+ depth increment))) ((looking-at "[ \t]*#[ \t]*elif") (if (and forward (= depth 0)) (setq found (point)))) (t (setq depth (- depth increment)))) ;; If we are trying to move across, and we find ;; an end before we find a beginning, get an error. (if (and (< prev 0) (< depth prev)) (error (if forward "No following conditional at this level" "No previous conditional at this level"))) ;; When searching forward, start from next line ;; so that we don't find the same line again. (if forward (forward-line 1)) ;; If this line exits a level of conditional, exit inner loop. (if (< depth 0) (setq found (point)))) ;; If the line is not really a conditional, skip past it. (if forward (end-of-line))))) (or found (error "No containing preprocessor conditional")) (goto-char (setq new found))) (setq count (+ count increment)))) (push-mark) (goto-char new))) ;;; c-mode.el ends here emacs-19.30/lisp/cal-chinese.el100444 22346 1 51411 6053144413 15603 0ustar reingolddaemon;;; cal-chinese.el --- calendar functions for the Chinese calendar. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: Chinese calendar, calendar, holidays, diary ;; 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 collection of functions implements the features of calendar.el, ;; diary.el, and holidays.el that deal with the Chinese calendar. The rules ;; used for the Chinese calendar are those of Baolin Liu (see L. E. Doggett's ;; article "Calendars" in the Explanatory Supplement to the Astronomical ;; Almanac, second edition, 1992) for the calendar as revised at the beginning ;; of the Qing dynasty in 1644. The nature of the astronomical calculations ;; is such that precise calculations cannot be made without great expense in ;; time, so that the calendars produced may not agree perfectly with published ;; tables--but no two pairs of published tables agree perfectly either! Liu's ;; rules produce a calendar for 2033 which is not accepted by all authorities. ;; The date of Chinese New Year is correct from 1644-2051. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (require 'lunar) (defvar chinese-calendar-celestial-stem ["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"]) (defvar chinese-calendar-terrestrial-branch ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"]) (defvar chinese-calendar-time-zone '(if (< year 1928) (+ 465 (/ 40.0 60.0)) 480) "*Number of minutes difference between local standard time for Chinese calendar and Coordinated Universal (Greenwich) Time. Default is for Beijing. This is an expression in `year' since it changed at 1928-01-01 00:00:00 from UT+7:45:40 to UT+8.") (defvar chinese-calendar-location-name "Beijing" "*Name of location used for calculation of Chinese calendar.") (defvar chinese-calendar-daylight-time-offset 0 ; The correct value is as follows, but the Chinese calendrical ; authorities do NOT use DST in determining astronomical events: ; 60 "*Number of minutes difference between daylight savings and standard time for Chinese calendar. Default is for no daylight savings time.") (defvar chinese-calendar-standard-time-zone-name '(if (< year 1928) "PMT" "CST") "*Abbreviated name of standard time zone used for Chinese calendar.") (defvar chinese-calendar-daylight-time-zone-name "CDT" "*Abbreviated name of daylight-savings time zone used for Chinese calendar.") (defvar chinese-calendar-daylight-savings-starts nil ; The correct value is as follows, but the Chinese calendrical ; authorities do NOT use DST in determining astronomical events: ; '(cond ((< 1986 year) (calendar-nth-named-day 1 0 4 year 10)) ; ((= 1986 year) '(5 4 1986)) ; (t nil)) "*Sexp giving the date on which daylight savings time starts for Chinese calendar. Default is for no daylight savings time. See documentation of `calendar-daylight-savings-starts'.") (defvar chinese-calendar-daylight-savings-ends nil ; The correct value is as follows, but the Chinese calendrical ; authorities do NOT use DST in determining astronomical events: ; '(if (<= 1986 year) (calendar-nth-named-day 1 0 9 year 11)) "*Sexp giving the date on which daylight savings time ends for Chinese calendar. Default is for no daylight savings time. See documentation of `calendar-daylight-savings-ends'.") (defvar chinese-calendar-daylight-savings-starts-time 0 "*Number of minutes after midnight that daylight savings time starts for Chinese calendar. Default is for no daylight savings time.") (defvar chinese-calendar-daylight-savings-ends-time 0 "*Number of minutes after midnight that daylight savings time ends for Chinese calendar. Default is for no daylight savings time.") (defun chinese-zodiac-sign-on-or-after (d) "Absolute date of first new Zodiac sign on or after absolute date d. The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees." (let* ((year (extract-calendar-year (calendar-gregorian-from-absolute d))) (calendar-time-zone (eval chinese-calendar-time-zone)) (calendar-daylight-time-offset chinese-calendar-daylight-time-offset) (calendar-standard-time-zone-name chinese-calendar-standard-time-zone-name) (calendar-daylight-time-zone-name chinese-calendar-daylight-time-zone-name) (calendar-calendar-daylight-savings-starts chinese-calendar-daylight-savings-starts) (calendar-daylight-savings-ends chinese-calendar-daylight-savings-ends) (calendar-daylight-savings-starts-time chinese-calendar-daylight-savings-starts-time) (calendar-daylight-savings-ends-time chinese-calendar-daylight-savings-ends-time)) (floor (calendar-absolute-from-astro (solar-date-next-longitude (calendar-astro-from-absolute d) 30))))) (defun chinese-new-moon-on-or-after (d) "Absolute date of first new moon on or after absolute date d." (let* ((year (extract-calendar-year (calendar-gregorian-from-absolute d))) (calendar-time-zone (eval chinese-calendar-time-zone)) (calendar-daylight-time-offset chinese-calendar-daylight-time-offset) (calendar-standard-time-zone-name chinese-calendar-standard-time-zone-name) (calendar-daylight-time-zone-name chinese-calendar-daylight-time-zone-name) (calendar-calendar-daylight-savings-starts chinese-calendar-daylight-savings-starts) (calendar-daylight-savings-ends chinese-calendar-daylight-savings-ends) (calendar-daylight-savings-starts-time chinese-calendar-daylight-savings-starts-time) (calendar-daylight-savings-ends-time chinese-calendar-daylight-savings-ends-time)) (floor (calendar-absolute-from-astro (lunar-new-moon-on-or-after (calendar-astro-from-absolute d)))))) (defvar chinese-year-cache '((1989 (12 726110) (1 726139) (2 726169) (3 726198) (4 726227) (5 726257) (6 726286) (7 726316) (8 726345) (9 726375) (10 726404) (11 726434)) (1990 (12 726464) (1 726494) (2 726523) (3 726553) (4 726582) (5 726611) (5.5 726641) (6 726670) (7 726699) (8 726729) (9 726758) (10 726788) (11 726818)) (1991 (12 726848) (1 726878) (2 726907) (3 726937) (4 726966) (5 726995) (6 727025) (7 727054) (8 727083) (9 727113) (10 727142) (11 727172)) (1992 (12 727202) (1 727232) (2 727261) (3 727291) (4 727321) (5 727350) (6 727379) (7 727409) (8 727438) (9 727467) (10 727497) (11 727526)) (1993 (12 727556) (1 727586) (2 727615) (3 727645) (3.5 727675) (4 727704) (5 727734) (6 727763) (7 727793) (8 727822) (9 727851) (10 727881) (11 727910)) (1994 (12 727940) (1 727969) (2 727999) (3 728029) (4 728059) (5 728088) (6 728118) (7 728147) (8 728177) (9 728206) (10 728235) (11 728265)) (1995 (12 728294) (1 728324) (2 728353) (3 728383) (4 728413) (5 728442) (6 728472) (7 728501) (8 728531) (8.5 728561) (9 728590) (10 728619) (11 728649)) (1996 (12 728678) (1 728708) (2 728737) (3 728767) (4 728796) (5 728826) (6 728856) (7 728885) (8 728915) (9 728944) (10 728974) (11 729004)) (1997 (12 729033) (1 729062) (2 729092) (3 729121) (4 729151) (5 729180) (6 729210) (7 729239) (8 729269) (9 729299) (10 729328) (11 729358)) (1998 (12 729388) (1 729417) (2 729447) (3 729476) (4 729505) (5 729535) (5.5 729564) (6 729593) (7 729623) (8 729653) (9 729682) (10 729712) (11 729742)) (1999 (12 729771) (1 729801) (2 729831) (3 729860) (4 729889) (5 729919) (6 729948) (7 729977) (8 730007) (9 730036) (10 730066) (11 730096)) (2000 (12 730126) (1 730155) (2 730185) (3 730215) (4 730244) (5 730273) (6 730303) (7 730332) (8 730361) (9 730391) (10 730420) (11 730450))) "An assoc list of Chinese year structures as determined by `chinese-year'. Values are computed as needed, but to save time, the initial value consists of the precomputed years 1989-2000. The code works just as well with this set to nil initially (which is how the value for 1989-2000 was computed).") (defun chinese-year (y) "The structure of the Chinese year for Gregorian year Y. The result is a list of pairs (i d), where month i begins on absolute date d, of the Chinese months from the Chinese month following the solstice in Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y. The list is cached for further use." (let ((list (cdr (assoc y chinese-year-cache)))) (if (not list) (progn (setq list (compute-chinese-year y)) (setq chinese-year-cache (append chinese-year-cache (list (cons y list)))))) list)) (defun number-chinese-months (list start) "Assign month numbers to the lunar months in LIST, starting with START. Numbers are assigned sequentially, START, START+1, ..., 11, with half numbers used for leap months. First month of list will never be a leap month, nor will the last." (if list (if (zerop (- 12 start (length list))) ;; List is too short for a leap month (cons (list start (car list)) (number-chinese-months (cdr list) (1+ start))) (cons ;; First month (list start (car list)) ;; Remaining months (if (and (cdr (cdr list));; at least two more months... (<= (car (cdr (cdr list))) (chinese-zodiac-sign-on-or-after (car (cdr list))))) ;; Next month is a leap month (cons (list (+ start 0.5) (car (cdr list))) (number-chinese-months (cdr (cdr list)) (1+ start))) ;; Next month is not a leap month (number-chinese-months (cdr list) (1+ start))))))) (defun chinese-month-list (start end) "List of starting dates of Chinese months from START to END." (if (<= start end) (let ((new-moon (chinese-new-moon-on-or-after start))) (if (<= new-moon end) (cons new-moon (chinese-month-list (1+ new-moon) end)))))) (defun compute-chinese-year (y) "Compute the structure of the Chinese year for Gregorian year Y. The result is a list of pairs (i d), where month i begins on absolute date d, of the Chinese months from the Chinese month following the solstice in Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y." (let* ((next-solstice (chinese-zodiac-sign-on-or-after (calendar-absolute-from-gregorian (list 12 15 y)))) (list (chinese-month-list (1+ (chinese-zodiac-sign-on-or-after (calendar-absolute-from-gregorian (list 12 15 (1- y))))) next-solstice)) (next-sign (chinese-zodiac-sign-on-or-after (car list)))) (if (= (length list) 12) ;; No room for a leap month, just number them 12, 1, 2, ..., 11 (cons (list 12 (car list)) (number-chinese-months (cdr list) 1)) ;; Now we can assign numbers to the list for y ;; The first month or two are special (if (or (> (car list) next-sign) (>= next-sign (car (cdr list)))) ;; First month on list is a leap month, second is not (append (list (list 11.5 (car list)) (list 12 (car (cdr list)))) (number-chinese-months (cdr (cdr list)) 1)) ;; First month on list is not a leap month (append (list (list 12 (car list))) (if (>= (chinese-zodiac-sign-on-or-after (car (cdr list))) (car (cdr (cdr list)))) ;; Second month on list is a leap month (cons (list 12.5 (car (cdr list))) (number-chinese-months (cdr (cdr list)) 1)) ;; Second month on list is not a leap month (number-chinese-months (cdr list) 1))))))) (defun calendar-absolute-from-chinese (date) "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. The Gregorian date Sunday, December 31, 1 BC is imaginary." (let* ((cycle (car date)) (year (car (cdr date))) (month (car (cdr (cdr date)))) (day (car (cdr (cdr (cdr date))))) (g-year (+ (* (1- cycle) 60);; years in prior cycles (1- year) ;; prior years this cycle -2636))) ;; years before absolute date 0 (+ (1- day);; prior days this month (car (cdr ;; absolute date of start of this month (assoc month (append (memq (assoc 1 (chinese-year g-year)) (chinese-year g-year)) (chinese-year (1+ g-year))))))))) (defun calendar-chinese-from-absolute (date) "Compute Chinese date (cycle year month day) corresponding to absolute DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (let* ((g-year (extract-calendar-year (calendar-gregorian-from-absolute date))) (c-year (+ g-year 2695)) (list (append (chinese-year (1- g-year)) (chinese-year g-year) (chinese-year (1+ g-year))))) (while (<= (car (cdr (car (cdr list)))) date) ;; the first month on the list is in Chinese year c-year ;; date is on or after start of second month on list... (if (= 1 (car (car (cdr list)))) ;; second month on list is a new Chinese year (setq c-year (1+ c-year))) ;; ...so first month on list is of no interest (setq list (cdr list))) (list (/ (1- c-year) 60) (calendar-mod c-year 60) (car (car list)) (1+ (- date (car (cdr (car list)))))))) (defun holiday-chinese-new-year () "Date of Chinese New Year." (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y 1) (if (< m 5) (let ((chinese-new-year (calendar-gregorian-from-absolute (car (cdr (assoc 1 (chinese-year y))))))) (if (calendar-date-is-visible-p chinese-new-year) (list (list chinese-new-year (format "Chinese New Year (%s)" (calendar-chinese-sexagisimal-name (+ y 57)))))))))) (defun calendar-chinese-date-string (&optional date) "String of Chinese date of Gregorian DATE. Defaults to today's date if DATE is not given." (let* ((a-date (calendar-absolute-from-gregorian (or date (calendar-current-date)))) (c-date (calendar-chinese-from-absolute a-date)) (cycle (car c-date)) (year (car (cdr c-date))) (month (car (cdr (cdr c-date)))) (day (car (cdr (cdr (cdr c-date))))) (this-month (calendar-absolute-from-chinese (list cycle year month 1))) (next-month (calendar-absolute-from-chinese (list (if (= year 60) (1+ cycle) cycle) (if (= (floor month) 12) (1+ year) year) (calendar-mod (1+ (floor month)) 12) 1))) (m-cycle (% (+ (* year 5) (floor month)) 60))) (format "Cycle %s, year %s (%s), %smonth %s%s, day %s (%s)" cycle year (calendar-chinese-sexagisimal-name year) (if (not (integerp month)) "second " (if (< 30 (- next-month this-month)) "first " "")) (floor month) (if (integerp month) (format " (%s)" (calendar-chinese-sexagisimal-name (+ (* 5 year) month 44))) "") day (calendar-chinese-sexagisimal-name (+ a-date 15))))) (defun calendar-chinese-sexagisimal-name (n) "The N-th name of the Chinese sexagisimal cycle. N congruent to 1 gives the first name, N congruent to 2 gives the second name, ..., N congruent to 60 gives the sixtieth name." (format "%s-%s" (aref chinese-calendar-celestial-stem (% (1- n) 10)) (aref chinese-calendar-terrestrial-branch (% (1- n) 12)))) (defun calendar-print-chinese-date () "Show the Chinese date equivalents of date." (interactive) (message "Computing Chinese date...") (message "Chinese date: %s" (calendar-chinese-date-string (calendar-cursor-to-date t)))) (defun calendar-goto-chinese-date (date &optional noecho) "Move cursor to Chinese date DATE. Echo Chinese date unless NOECHO is t." (interactive (let* ((c (calendar-chinese-from-absolute (calendar-absolute-from-gregorian (calendar-current-date)))) (cycle (calendar-read "Chinese calendar cycle number (>44): " '(lambda (x) (> x 44)) (int-to-string (car c)))) (year (calendar-read "Year in Chinese cycle (1..60): " '(lambda (x) (and (<= 1 x) (<= x 60))) (int-to-string (car (cdr c))))) (month-list (make-chinese-month-assoc-list (chinese-months cycle year))) (month (cdr (assoc (completing-read "Chinese calendar month: " month-list nil t) month-list))) (last (if (= month (car (cdr (cdr (calendar-chinese-from-absolute (+ 29 (calendar-absolute-from-chinese (list cycle year month 1)))))))) 30 29)) (day (calendar-read (format "Chinese calendar day (1-%d): " last) '(lambda (x) (and (<= 1 x) (<= x last)))))) (list (list cycle year month day)))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-absolute-from-chinese date))) (or noecho (calendar-print-chinese-date))) (defun chinese-months (c y) "A list of the months in cycle C, year Y of the Chinese calendar." (let* ((l (memq 1 (append (mapcar '(lambda (x) (car x)) (chinese-year (extract-calendar-year (calendar-gregorian-from-absolute (calendar-absolute-from-chinese (list c y 1 1)))))) (mapcar '(lambda (x) (if (> (car x) 11) (car x))) (chinese-year (extract-calendar-year (calendar-gregorian-from-absolute (calendar-absolute-from-chinese (list (if (= y 60) (1+ c) c) (if (= y 60) 1 y) 1 1)))))))))) l)) (defun make-chinese-month-assoc-list (l) "Make list of months L into an assoc list." (if (and l (car l)) (if (and (cdr l) (car (cdr l))) (if (= (car l) (floor (car (cdr l)))) (append (list (cons (format "%s (first)" (car l)) (car l)) (cons (format "%s (second)" (car l)) (car (cdr l)))) (make-chinese-month-assoc-list (cdr (cdr l)))) (append (list (cons (int-to-string (car l)) (car l))) (make-chinese-month-assoc-list (cdr l)))) (list (cons (int-to-string (car l)) (car l)))))) (defun diary-chinese-date () "Chinese calendar equivalent of date diary entry." (format "Chinese date: %s" (calendar-chinese-date-string date))) (provide 'cal-chinese) ;;; cal-chinese ends here emacs-19.30/lisp/cal-coptic.el100444 22346 1 22675 6053144502 15457 0ustar reingolddaemon;;; cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: Coptic calendar, Ethiopic calendar, calendar, diary ;; 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 collection of functions implements the features of calendar.el and ;; diary.el that deal with the Coptic and Ethiopic calendars. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (require 'cal-julian) (defvar coptic-calendar-month-name-array ["Tot" "Babe" "Hatur" "Kihak" "Tube" "Amshir" "Baramhat" "Barmuda" "Bashnas" "Bauna" "Abib" "Misra" "Nisi"]) (defvar coptic-calendar-epoch (calendar-absolute-from-julian '(8 29 284)) "Absolute date of start of Coptic calendar = August 29, 284 A.D. (Julian).") (defconst coptic-name "Coptic") (defun coptic-calendar-leap-year-p (year) "True if YEAR is a leap year on the Coptic calendar." (zerop (mod (1+ year) 4))) (defun coptic-calendar-last-day-of-month (month year) "Return last day of MONTH, YEAR on the Coptic calendar. The 13th month is not really a month, but the 5 (6 in leap years) day period of Nisi (Kebus) at the end of the year." (if (< month 13) 30 (if (coptic-calendar-leap-year-p year) 6 5))) (defun calendar-absolute-from-coptic (date) "Compute absolute date from Coptic date DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (let ((month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date))) (+ (1- coptic-calendar-epoch);; Days before start of calendar (* 365 (1- year)) ;; Days in prior years (/ year 4) ;; Leap days in prior years (* 30 (1- month)) ;; Days in prior months this year day))) ;; Days so far this month (defun calendar-coptic-from-absolute (date) "Compute the Coptic equivalent for absolute date DATE. The result is a list of the form (MONTH DAY YEAR). The absolute date is the number of days elapsed since the imaginary Gregorian date Sunday, December 31, 1 BC." (if (< date coptic-calendar-epoch) (list 0 0 0);; pre-Coptic date (let* ((approx (/ (- date coptic-calendar-epoch) 366)) ;; Approximation from below. (year ;; Search forward from the approximation. (+ approx (calendar-sum y approx (>= date (calendar-absolute-from-coptic (list 1 1 (1+ y)))) 1))) (month ;; Search forward from Tot. (1+ (calendar-sum m 1 (> date (calendar-absolute-from-coptic (list m (coptic-calendar-last-day-of-month m year) year))) 1))) (day ;; Calculate the day by subtraction. (- date (1- (calendar-absolute-from-coptic (list month 1 year)))))) (list month day year)))) (defun calendar-coptic-date-string (&optional date) "String of Coptic date of Gregorian DATE. Returns the empty string if DATE is pre-Coptic calendar. Defaults to today's date if DATE is not given." (let* ((coptic-date (calendar-coptic-from-absolute (calendar-absolute-from-gregorian (or date (calendar-current-date))))) (y (extract-calendar-year coptic-date)) (m (extract-calendar-month coptic-date))) (if (< y 1) "" (let ((monthname (aref coptic-calendar-month-name-array (1- m))) (day (int-to-string (extract-calendar-day coptic-date))) (dayname nil) (month (int-to-string m)) (year (int-to-string y))) (mapconcat 'eval calendar-date-display-form ""))))) (defun calendar-print-coptic-date () "Show the Coptic calendar equivalent of the selected date." (interactive) (let ((f (calendar-coptic-date-string (calendar-cursor-to-date t)))) (if (string-equal f "") (message "Date is pre-%s calendar" coptic-name) (message f)))) (defun calendar-goto-coptic-date (date &optional noecho) "Move cursor to Coptic date DATE. Echo Coptic date unless NOECHO is t." (interactive (coptic-prompt-for-date)) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-absolute-from-coptic date))) (or noecho (calendar-print-coptic-date))) (defun coptic-prompt-for-date () "Ask for a Coptic date." (let* ((today (calendar-current-date)) (year (calendar-read (format "%s calendar year (>0): " coptic-name) '(lambda (x) (> x 0)) (int-to-string (extract-calendar-year (calendar-coptic-from-absolute (calendar-absolute-from-gregorian today)))))) (completion-ignore-case t) (month (cdr (assoc (capitalize (completing-read (format "%s calendar month name: " coptic-name) (mapcar 'list (append coptic-calendar-month-name-array nil)) nil t)) (calendar-make-alist coptic-calendar-month-name-array 1 'capitalize)))) (last (coptic-calendar-last-day-of-month month year)) (day (calendar-read (format "%s calendar day (1-%d): " coptic-name last) '(lambda (x) (and (< 0 x) (<= x last)))))) (list (list month day year)))) (defun diary-coptic-date () "Coptic calendar equivalent of date diary entry." (let ((f (calendar-coptic-date-string (calendar-cursor-to-date t)))) (if (string-equal f "") (format "Date is pre-%s calendar" coptic-name) f))) (defconst ethiopic-calendar-month-name-array ["Maskarram" "Tekemt" "Hadar" "Tahsas" "Tarr" "Yekatit" "Magawit" "Miaziah" "Genbot" "Sanni" "Hamle" "Nas'hi" "Pagnem"]) (defconst ethiopic-calendar-epoch -2006079 "Absolute date of start of Ethiopic calendar = August 29, 5493 B.C.E. (Julian).") (defconst ethiopic-name "Ethiopic") (defun calendar-absolute-from-ethiopic (date) "Compute absolute date from Ethiopic date DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (let ((coptic-calendar-epoch ethiopic-calendar-epoch)) (calendar-absolute-from-coptic date))) (defun calendar-ethiopic-from-absolute (date) "Compute the Ethiopic equivalent for absolute date DATE. The result is a list of the form (MONTH DAY YEAR). The absolute date is the number of days elapsed since the imaginary Gregorian date Sunday, December 31, 1 BC." (let ((coptic-calendar-epoch ethiopic-calendar-epoch)) (calendar-coptic-from-absolute date))) (defun calendar-ethiopic-date-string (&optional date) "String of Ethiopic date of Gregorian DATE. Returns the empty string if DATE is pre-Ethiopic calendar. Defaults to today's date if DATE is not given." (let ((coptic-calendar-epoch ethiopic-calendar-epoch) (coptic-name ethiopic-name) (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) (calendar-coptic-date-string date))) (defun calendar-print-ethiopic-date () "Show the Ethiopic calendar equivalent of the selected date." (interactive) (let ((coptic-calendar-epoch ethiopic-calendar-epoch) (coptic-name ethiopic-name) (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) (call-interactively 'calendar-print-coptic-date))) (defun calendar-goto-ethiopic-date (date &optional noecho) "Move cursor to Ethiopic date DATE. Echo Ethiopic date unless NOECHO is t." (interactive (let ((coptic-calendar-epoch ethiopic-calendar-epoch) (coptic-name ethiopic-name) (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) (coptic-prompt-for-date))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-absolute-from-ethiopic date))) (or noecho (calendar-print-ethiopic-date))) (defun diary-ethiopic-date () "Ethiopic calendar equivalent of date diary entry." (let ((coptic-calendar-epoch ethiopic-calendar-epoch) (coptic-name ethiopic-name) (coptic-calendar-month-name-array ethiopic-calendar-month-name-array)) (diary-coptic-date))) (provide 'cal-coptic) ;;; cal-coptic.el ends here emacs-19.30/lisp/cal-dst.el100444 22346 1 40565 6030152041 14756 0ustar reingolddaemon;;; cal-dst.el --- calendar functions for daylight savings rules. ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Paul Eggert ;; Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: daylight savings time, calendar, diary, holidays ;; 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 collection of functions implements the features of calendar.el and ;; holiday.el that deal with daylight savings time. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (require 'calendar) (defvar calendar-current-time-zone-cache nil "Cache for result of calendar-current-time-zone.") (defvar calendar-system-time-basis (calendar-absolute-from-gregorian '(1 1 1970)) "Absolute date of starting date of system clock.") (defun calendar-absolute-from-time (x utc-diff) "Absolute local date of time X; local time is UTC-DIFF seconds from UTC. X is (HIGH . LOW) or (HIGH LOW . IGNORED) where HIGH and LOW are the high and low 16 bits, respectively, of the number of seconds since 1970-01-01 00:00:00 UTC, ignoring leap seconds. Returns the pair (ABS-DATE . SECONDS) where SECONDS after local midnight on absolute date ABS-DATE is the equivalent moment to X." (let* ((h (car x)) (xtail (cdr x)) (l (+ utc-diff (if (numberp xtail) xtail (car xtail)))) (u (+ (* 512 (mod h 675)) (floor l 128)))) ;; Overflow is a terrible thing! (cons (+ calendar-system-time-basis ;; floor((2^16 h +l) / (60*60*24)) (* 512 (floor h 675)) (floor u 675)) ;; (2^16 h +l) mod (60*60*24) (+ (* (mod u 675) 128) (mod l 128))))) (defun calendar-time-from-absolute (abs-date s) "Time of absolute date ABS-DATE, S seconds after midnight. Returns the pair (HIGH . LOW) where HIGH and LOW are the high and low 16 bits, respectively, of the number of seconds 1970-01-01 00:00:00 UTC, ignoring leap seconds, that is the equivalent moment to S seconds after midnight UTC on absolute date ABS-DATE." (let* ((a (- abs-date calendar-system-time-basis)) (u (+ (* 163 (mod a 512)) (floor s 128)))) ;; Overflow is a terrible thing! (cons ;; floor((60*60*24*a + s) / 2^16) (+ a (* 163 (floor a 512)) (floor u 512)) ;; (60*60*24*a + s) mod 2^16 (+ (* 128 (mod u 512)) (mod s 128))))) (defun calendar-next-time-zone-transition (time) "Return the time of the next time zone transition after TIME. Both TIME and the result are acceptable arguments to current-time-zone. Return nil if no such transition can be found." (let* ((base 65536);; 2^16 = base of current-time output (quarter-multiple 120);; approx = (seconds per quarter year) / base (time-zone (current-time-zone time)) (time-utc-diff (car time-zone)) hi hi-zone (hi-utc-diff time-utc-diff) (quarters '(2 1 3))) ;; Heuristic: probe the time zone offset in the next three calendar ;; quarters, looking for a time zone offset different from TIME. (while (and quarters (eq time-utc-diff hi-utc-diff)) (setq hi (cons (+ (car time) (* (car quarters) quarter-multiple)) 0)) (setq hi-zone (current-time-zone hi)) (setq hi-utc-diff (car hi-zone)) (setq quarters (cdr quarters))) (and time-utc-diff hi-utc-diff (not (eq time-utc-diff hi-utc-diff)) ;; Now HI is after the next time zone transition. ;; Set LO to TIME, and then binary search to increase LO and decrease HI ;; until LO is just before and HI is just after the time zone transition. (let* ((tail (cdr time)) (lo (cons (car time) (if (numberp tail) tail (car tail)))) probe) (while ;; Set PROBE to halfway between LO and HI, rounding down. ;; If PROBE equals LO, we are done. (let* ((lsum (+ (cdr lo) (cdr hi))) (hsum (+ (car lo) (car hi) (/ lsum base))) (hsumodd (logand 1 hsum))) (setq probe (cons (/ (- hsum hsumodd) 2) (/ (+ (* hsumodd base) (% lsum base)) 2))) (not (equal lo probe))) ;; Set either LO or HI to PROBE, depending on probe results. (if (eq (car (current-time-zone probe)) hi-utc-diff) (setq hi probe) (setq lo probe))) hi)))) (defun calendar-time-zone-daylight-rules (abs-date utc-diff) "Return daylight transition rule for ABS-DATE, UTC-DIFF sec offset from UTC. ABS-DIFF must specify a day that contains a daylight savings transition. The result has the proper form for calendar-daylight-savings-starts'." (let* ((date (calendar-gregorian-from-absolute abs-date)) (weekday (% abs-date 7)) (m (extract-calendar-month date)) (d (extract-calendar-day date)) (y (extract-calendar-year date)) (last (calendar-last-day-of-month m y)) (candidate-rules (append ;; Day D of month M. (list (list 'list m d 'year)) ;; The first WEEKDAY of month M. (if (< d 8) (list (list 'calendar-nth-named-day 1 weekday m 'year))) ;; The last WEEKDAY of month M. (if (> d (- last 7)) (list (list 'calendar-nth-named-day -1 weekday m 'year))) ;; The first WEEKDAY after day J of month M, for D-6 < J <= D. (let (l) (calendar-for-loop j from (max 2 (- d 6)) to (min d (- last 8)) do (setq l (cons (list 'calendar-nth-named-day 1 weekday m 'year j) l))) l))) (prevday-sec (- -1 utc-diff)) ;; last sec of previous local day (year (1+ y))) ;; Scan through the next few years until only one rule remains. (while (let ((rules candidate-rules) new-rules) (while (let* ((rule (car rules)) (date ;; The following is much faster than ;; (calendar-absolute-from-gregorian (eval rule)). (cond ((eq (car rule) 'calendar-nth-named-day) (eval (cons 'calendar-nth-named-absday (cdr rule)))) ((eq (car rule) 'calendar-gregorian-from-absolute) (eval (car (cdr rule)))) (t (let ((g (eval rule))) (calendar-absolute-from-gregorian g)))))) (or (equal (current-time-zone (calendar-time-from-absolute date prevday-sec)) (current-time-zone (calendar-time-from-absolute (1+ date) prevday-sec))) (setq new-rules (cons rule new-rules))) (setq rules (cdr rules)))) ;; If no rules remain, just use the first candidate rule; ;; it's wrong in general, but it's right for at least one year. (setq candidate-rules (if new-rules (nreverse new-rules) (list (car candidate-rules)))) (setq year (1+ year)) (cdr candidate-rules))) (car candidate-rules))) (defun calendar-current-time-zone () "Return UTC difference, dst offset, names and rules for current time zone. Returns (UTC-DIFF DST-OFFSET STD-ZONE DST-ZONE DST-STARTS DST-ENDS DST-STARTS-TIME DST-ENDS-TIME), based on a heuristic probing of what the system knows: UTC-DIFF is an integer specifying the number of minutes difference between standard time in the current time zone and Coordinated Universal Time (Greenwich Mean Time). A negative value means west of Greenwich. DST-OFFSET is an integer giving the daylight savings time offset in minutes. STD-ZONE is a string giving the name of the time zone when no seasonal time adjustment is in effect. DST-ZONE is a string giving the name of the time zone when there is a seasonal time adjustment in effect. DST-STARTS and DST-ENDS are sexps in the variable `year' giving the daylight savings time start and end rules, in the form expected by `calendar-daylight-savings-starts'. DST-STARTS-TIME and DST-ENDS-TIME are integers giving the number of minutes after midnight that daylight savings time starts and ends. If the local area does not use a seasonal time adjustment, STD-ZONE and DST-ZONE are equal, and all the DST-* integer variables are 0. Some operating systems cannot provide all this information to Emacs; in this case, `calendar-current-time-zone' returns a list containing nil for the data it can't find." (or calendar-current-time-zone-cache (setq calendar-current-time-zone-cache (let* ((t0 (current-time)) (t0-zone (current-time-zone t0)) (t0-utc-diff (car t0-zone)) (t0-name (car (cdr t0-zone)))) (if (not t0-utc-diff) ;; Little or no time zone information is available. (list nil nil t0-name t0-name nil nil nil nil) (let* ((t1 (calendar-next-time-zone-transition t0)) (t2 (and t1 (calendar-next-time-zone-transition t1)))) (if (not t2) ;; This locale does not have daylight savings time. (list (/ t0-utc-diff 60) 0 t0-name t0-name nil nil 0 0) ;; Use heuristics to find daylight savings parameters. (let* ((t1-zone (current-time-zone t1)) (t1-utc-diff (car t1-zone)) (t1-name (car (cdr t1-zone))) (t1-date-sec (calendar-absolute-from-time t1 t0-utc-diff)) (t2-date-sec (calendar-absolute-from-time t2 t1-utc-diff)) (t1-rules (calendar-time-zone-daylight-rules (car t1-date-sec) t0-utc-diff)) (t2-rules (calendar-time-zone-daylight-rules (car t2-date-sec) t1-utc-diff)) (t1-time (/ (cdr t1-date-sec) 60)) (t2-time (/ (cdr t2-date-sec) 60))) (cons (/ (min t0-utc-diff t1-utc-diff) 60) (cons (/ (abs (- t0-utc-diff t1-utc-diff)) 60) (if (< t0-utc-diff t1-utc-diff) (list t0-name t1-name t1-rules t2-rules t1-time t2-time) (list t1-name t0-name t2-rules t1-rules t2-time t1-time) ))))))))))) ;;; The following eight defvars relating to daylight savings time should NOT be ;;; marked to go into loaddefs.el where they would be evaluated when Emacs is ;;; dumped. These variables' appropriate values depend on the conditions under ;;; which the code is INVOKED; so it's inappropriate to initialize them when ;;; Emacs is dumped---they should be initialized when calendar.el is loaded. ;;; They default to US Eastern time if time zone info is not available. (calendar-current-time-zone) (defvar calendar-time-zone (or (car calendar-current-time-zone-cache) -300) "*Number of minutes difference between local standard time at `calendar-location-name' and Coordinated Universal (Greenwich) Time. For example, -300 for New York City, -480 for Los Angeles.") (defvar calendar-daylight-time-offset (or (car (cdr calendar-current-time-zone-cache)) 60) "*Number of minutes difference between daylight savings and standard time. If the locale never uses daylight savings time, set this to 0.") (defvar calendar-standard-time-zone-name (or (car (nthcdr 2 calendar-current-time-zone-cache)) "EST") "*Abbreviated name of standard time zone at `calendar-location-name'. For example, \"EST\" in New York City, \"PST\" for Los Angeles.") (defvar calendar-daylight-time-zone-name (or (car (nthcdr 3 calendar-current-time-zone-cache)) "EDT") "*Abbreviated name of daylight-savings time zone at `calendar-location-name'. For example, \"EDT\" in New York City, \"PDT\" for Los Angeles.") ;;;###autoload (put 'calendar-daylight-savings-starts 'risky-local-variable t) (defvar calendar-daylight-savings-starts (or (car (nthcdr 4 calendar-current-time-zone-cache)) (and (not (zerop calendar-daylight-time-offset)) '(calendar-nth-named-day 1 0 4 year))) "*Sexp giving the date on which daylight savings time starts. This is an expression in the variable `year' whose value gives the Gregorian date in the form (month day year) on which daylight savings time starts. It is used to determine the starting date of daylight savings time for the holiday list and for correcting times of day in the solar and lunar calculations. For example, if daylight savings time is mandated to start on October 1, you would set `calendar-daylight-savings-starts' to '(10 1 year) If it starts on the first Sunday in April, you would set it to '(calendar-nth-named-day 1 0 4 year) If the locale never uses daylight savings time, set this to nil.") ;;;###autoload (put 'calendar-daylight-savings-ends 'risky-local-variable t) (defvar calendar-daylight-savings-ends (or (car (nthcdr 5 calendar-current-time-zone-cache)) (and (not (zerop calendar-daylight-time-offset)) '(calendar-nth-named-day -1 0 10 year))) "*Sexp giving the date on which daylight savings time ends. This is an expression in the variable `year' whose value gives the Gregorian date in the form (month day year) on which daylight savings time ends. It is used to determine the starting date of daylight savings time for the holiday list and for correcting times of day in the solar and lunar calculations. For example, if daylight savings time ends on the last Sunday in October: '(calendar-nth-named-day -1 0 10 year) If the locale never uses daylight savings time, set this to nil.") (defvar calendar-daylight-savings-starts-time (or (car (nthcdr 6 calendar-current-time-zone-cache)) 120) "*Number of minutes after midnight that daylight savings time starts.") (defvar calendar-daylight-savings-ends-time (or (car (nthcdr 7 calendar-current-time-zone-cache)) calendar-daylight-savings-starts-time) "*Number of minutes after midnight that daylight savings time ends.") (defun dst-in-effect (date) "True if on absolute DATE daylight savings time is in effect. Fractional part of DATE is time of day." (let* ((year (extract-calendar-year (calendar-gregorian-from-absolute (floor date)))) (dst-starts (and (eval calendar-daylight-savings-starts) (+ (calendar-absolute-from-gregorian (eval calendar-daylight-savings-starts)) (/ calendar-daylight-savings-starts-time 60.0 24.0)))) (dst-ends (and (eval calendar-daylight-savings-ends) (+ (calendar-absolute-from-gregorian (eval calendar-daylight-savings-ends)) (/ (- calendar-daylight-savings-ends-time calendar-daylight-time-offset) 60.0 24.0))))) (and (and dst-starts dst-ends (or (and (< dst-starts dst-ends);; northern hemi. (<= dst-starts date) (< date dst-ends)) (and (< dst-ends dst-starts);; southern hemi. (<= dst-starts date) (< date dst-ends)) (and dst-starts (not dst-ends) (<= dst-starts date)) (and dst-ends (not dst-starts) (< date dst-ends))))))) (defun dst-adjust-time (date time &optional style) "Adjust, to account for dst on DATE, decimal fraction standard TIME. Returns a list (date adj-time zone) where `date' and `adj-time' are the values adjusted for `zone'; here `date' is a list (month day year), `adj-time' is a decimal fraction time, and `zone' is a string. Optional parameter STYLE forces the result time to be standard time when its value is 'standard and daylight savings time (if available) when its value is 'daylight. Conversion to daylight savings time is done according to `calendar-daylight-savings-starts', `calendar-daylight-savings-ends', `calendar-daylight-savings-starts-time', `calendar-daylight-savings-ends-time', and `calendar-daylight-savings-offset'." (let* ((rounded-abs-date (+ (calendar-absolute-from-gregorian date) (/ (round (* 60 time)) 60.0 24.0))) (dst (dst-in-effect rounded-abs-date)) (time-zone (if dst calendar-daylight-time-zone-name calendar-standard-time-zone-name)) (time (+ rounded-abs-date (if dst (/ calendar-daylight-time-offset 24.0 60.0) 0)))) (list (calendar-gregorian-from-absolute (truncate time)) (* 24.0 (- time (truncate time))) time-zone))) (provide 'cal-dst) ;;; cal-dst.el ends here emacs-19.30/lisp/cal-french.el100444 22346 1 23037 6030151545 15434 0ustar reingolddaemon;;; cal-french.el --- calendar functions for the French Revolutionary calendar. ;; Copyright (C) 1988, 1989, 1992, 1994, 1995 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: French Revolutionary calendar, calendar, diary ;; 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 collection of functions implements the features of calendar.el and ;; diary.el that deal with the French Revolutionary calendar. ;; Technical details of the French Revolutionary calendar can be found in ;; ``Calendrical Calculations, Part II: Three Historical Calendars'' ;; by E. M. Reingold, N. Dershowitz, and S. M. Clamen, ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993), ;; pages 383-404. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (require 'calendar) (defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792)) "Absolute date of start of French Revolutionary calendar = September 22, 1792.") (defconst french-calendar-month-name-array ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"]) (defconst french-calendar-day-name-array ["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi" "Octidi" "Nonidi" "Decadi"]) (defconst french-calendar-special-days-array ["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Re'compense" "de la Re'volution"]) (defun french-calendar-leap-year-p (year) "True if YEAR is a leap year on the French Revolutionary calendar. For Gregorian years 1793 to 1805, the years of actual operation of the calendar, uses historical practice based on equinoxes is followed (years 3, 7, and 11 were leap years; 15 and 20 would have been leap years). For later years uses the proposed rule of Romme (never adopted)--leap years fall every four years except century years not divisible 400 and century years that are multiples of 4000." (or (memq year '(3 7 11));; Actual practice--based on equinoxes (memq year '(15 20)) ;; Anticipated practice--based on equinoxes (and (> year 20) ;; Romme's proposal--never adopted (zerop (% year 4)) (not (memq (% year 400) '(100 200 300))) (not (zerop (% year 4000)))))) (defun french-calendar-last-day-of-month (month year) "Return last day of MONTH, YEAR on the French Revolutionary calendar. The 13th month is not really a month, but the 5 (6 in leap years) day period of `sansculottides' at the end of the year." (if (< month 13) 30 (if (french-calendar-leap-year-p year) 6 5))) (defun calendar-absolute-from-french (date) "Compute absolute date from French Revolutionary date DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (let ((month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date))) (+ (* 365 (1- year));; Days in prior years ;; Leap days in prior years (if (< year 20) (/ year 4);; Actual and anticipated practice (years 3, 7, 11, 15) ;; Romme's proposed rule (using the Principle of Inclusion/Exclusion) (+ (/ (1- year) 4);; Luckily, there were 4 leap years before year 20 (- (/ (1- year) 100)) (/ (1- year) 400) (- (/ (1- year) 4000)))) (* 30 (1- month));; Days in prior months this year day;; Days so far this month (1- french-calendar-epoch))));; Days before start of calendar (defun calendar-french-from-absolute (date) "Compute the French Revolutionary equivalent for absolute date DATE. The result is a list of the form (MONTH DAY YEAR). The absolute date is the number of days elapsed since the \(imaginary) Gregorian date Sunday, December 31, 1 BC." (if (< date french-calendar-epoch) (list 0 0 0);; pre-French Revolutionary date (let* ((approx ;; Approximation from below. (/ (- date french-calendar-epoch) 366)) (year ;; Search forward from the approximation. (+ approx (calendar-sum y approx (>= date (calendar-absolute-from-french (list 1 1 (1+ y)))) 1))) (month ;; Search forward from Vendemiaire. (1+ (calendar-sum m 1 (> date (calendar-absolute-from-french (list m (french-calendar-last-day-of-month m year) year))) 1))) (day ;; Calculate the day by subtraction. (- date (1- (calendar-absolute-from-french (list month 1 year)))))) (list month day year)))) (defun calendar-french-date-string (&optional date) "String of French Revolutionary date of Gregorian DATE. Returns the empty string if DATE is pre-French Revolutionary. Defaults to today's date if DATE is not given." (let* ((french-date (calendar-french-from-absolute (calendar-absolute-from-gregorian (or date (calendar-current-date))))) (y (extract-calendar-year french-date)) (m (extract-calendar-month french-date)) (d (extract-calendar-day french-date))) (cond ((< y 1) "") ((= m 13) (format "Jour %s de l'Anne'e %d de la Re'volution" (aref french-calendar-special-days-array (1- d)) y)) (t (format "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution" (make-string (1+ (/ (1- d) 10)) ?I) (aref french-calendar-day-name-array (% (1- d) 10)) (aref french-calendar-month-name-array (1- m)) y))))) (defun calendar-print-french-date () "Show the French Revolutionary calendar equivalent of the selected date." (interactive) (let ((f (calendar-french-date-string (calendar-cursor-to-date t)))) (if (string-equal f "") (message "Date is pre-French Revolution") (message f)))) (defun calendar-goto-french-date (date &optional noecho) "Move cursor to French Revolutionary date DATE. Echo French Revolutionary date unless NOECHO is t." (interactive (let* ((year (calendar-read "Anne'e de la Re'volution (>0): " '(lambda (x) (> x 0)) (int-to-string (extract-calendar-year (calendar-french-from-absolute (calendar-absolute-from-gregorian (calendar-current-date))))))) (month-list (mapcar 'list (append french-calendar-month-name-array (if (french-calendar-leap-year-p year) (mapcar '(lambda (x) (concat "Jour " x)) french-calendar-special-days-array) (reverse (cdr;; we don't want rev. day in a non-leap yr. (reverse (mapcar '(lambda (x) (concat "Jour " x)) french-calendar-special-days-array)))))))) (completion-ignore-case t) (month (cdr (assoc (capitalize (completing-read "Mois ou Sansculottide: " month-list nil t)) (calendar-make-alist month-list 1 '(lambda (x) (capitalize (car x))))))) (decade (if (> month 12) 1 (calendar-read "De'cade (1-3): " '(lambda (x) (memq x '(1 2 3)))))) (day (if (> month 12) (- month 12) (calendar-read "Jour (1-10): " '(lambda (x) (and (<= 1 x) (<= x 10)))))) (month (if (> month 12) 13 month)) (day (+ day (* 10 (1- decade))))) (list (list month day year)))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-absolute-from-french date))) (or noecho (calendar-print-french-date))) (defun diary-french-date () "French calendar equivalent of date diary entry." (let ((f (calendar-french-date-string (calendar-cursor-to-date t)))) (if (string-equal f "") "Date is pre-French Revolution" f))) (provide 'cal-french) ;;; cal-french.el ends here emacs-19.30/lisp/cal-hebrew.el100444 22346 1 155034 6030153237 15466 0ustar reingolddaemon;;; cal-hebrew.el --- calendar functions for the Hebrew calendar. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Nachum Dershowitz ;; Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: Hebrew calendar, calendar, diary ;; 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 collection of functions implements the features of calendar.el and ;; diary.el that deal with the Hebrew calendar. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (require 'calendar) (defun calendar-hebrew-from-absolute (date) "Compute the Hebrew date (month day year) corresponding to absolute DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (let* ((greg-date (calendar-gregorian-from-absolute date)) (month (aref [9 10 11 12 1 2 3 4 7 7 7 8] (1- (extract-calendar-month greg-date)))) (day) (year (+ 3760 (extract-calendar-year greg-date)))) (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year)))) (setq year (1+ year))) (let ((length (hebrew-calendar-last-month-of-year year))) (while (> date (calendar-absolute-from-hebrew (list month (hebrew-calendar-last-day-of-month month year) year))) (setq month (1+ (% month length))))) (setq day (1+ (- date (calendar-absolute-from-hebrew (list month 1 year))))) (list month day year))) (defun hebrew-calendar-leap-year-p (year) "t if YEAR is a Hebrew calendar leap year." (< (% (1+ (* 7 year)) 19) 7)) (defun hebrew-calendar-last-month-of-year (year) "The last month of the Hebrew calendar YEAR." (if (hebrew-calendar-leap-year-p year) 13 12)) (defun hebrew-calendar-last-day-of-month (month year) "The last day of MONTH in YEAR." (if (or (memq month (list 2 4 6 10 13)) (and (= month 12) (not (hebrew-calendar-leap-year-p year))) (and (= month 8) (not (hebrew-calendar-long-heshvan-p year))) (and (= month 9) (hebrew-calendar-short-kislev-p year))) 29 30)) (defun hebrew-calendar-elapsed-days (year) "Days from Sun. prior to start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR." (let* ((months-elapsed (+ (* 235 (/ (1- year) 19));; Months in complete cycles so far. (* 12 (% (1- year) 19)) ;; Regular months in this cycle (/ (1+ (* 7 (% (1- year) 19))) 19)));; Leap months this cycle (parts-elapsed (+ 204 (* 793 (% months-elapsed 1080)))) (hours-elapsed (+ 5 (* 12 months-elapsed) (* 793 (/ months-elapsed 1080)) (/ parts-elapsed 1080))) (parts ;; Conjunction parts (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080))) (day ;; Conjunction day (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24))) (alternative-day (if (or (>= parts 19440) ;; If the new moon is at or after midday, (and (= (% day 7) 2);; ...or is on a Tuesday... (>= parts 9924) ;; at 9 hours, 204 parts or later... (not (hebrew-calendar-leap-year-p year)));; of a ;; common year, (and (= (% day 7) 1);; ...or is on a Monday... (>= parts 16789) ;; at 15 hours, 589 parts or later... (hebrew-calendar-leap-year-p (1- year))));; at the end ;; of a leap year ;; Then postpone Rosh HaShanah one day (1+ day) ;; Else day))) (if ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday (memq (% alternative-day 7) (list 0 3 5)) ;; Then postpone it one (more) day and return (1+ alternative-day) ;; Else return alternative-day))) (defun hebrew-calendar-days-in-year (year) "Number of days in Hebrew YEAR." (- (hebrew-calendar-elapsed-days (1+ year)) (hebrew-calendar-elapsed-days year))) (defun hebrew-calendar-long-heshvan-p (year) "t if Heshvan is long in Hebrew YEAR." (= (% (hebrew-calendar-days-in-year year) 10) 5)) (defun hebrew-calendar-short-kislev-p (year) "t if Kislev is short in Hebrew YEAR." (= (% (hebrew-calendar-days-in-year year) 10) 3)) (defun calendar-absolute-from-hebrew (date) "Absolute date of Hebrew DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (let* ((month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date))) (+ day ;; Days so far this month. (if (< month 7);; before Tishri ;; Then add days in prior months this year before and after Nisan (+ (calendar-sum m 7 (<= m (hebrew-calendar-last-month-of-year year)) (hebrew-calendar-last-day-of-month m year)) (calendar-sum m 1 (< m month) (hebrew-calendar-last-day-of-month m year))) ;; Else add days in prior months this year (calendar-sum m 7 (< m month) (hebrew-calendar-last-day-of-month m year))) (hebrew-calendar-elapsed-days year);; Days in prior years. -1373429))) ;; Days elapsed before absolute date 1. (defvar calendar-hebrew-month-name-array-common-year ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"]) (defvar calendar-hebrew-month-name-array-leap-year ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"]) (defun calendar-hebrew-date-string (&optional date) "String of Hebrew date before sunset of Gregorian DATE. Defaults to today's date if DATE is not given. Driven by the variable `calendar-date-display-form'." (let* ((hebrew-date (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (or date (calendar-current-date))))) (calendar-month-name-array (if (hebrew-calendar-leap-year-p (extract-calendar-year hebrew-date)) calendar-hebrew-month-name-array-leap-year calendar-hebrew-month-name-array-common-year))) (calendar-date-string hebrew-date nil t))) (defun calendar-print-hebrew-date () "Show the Hebrew calendar equivalent of the date under the cursor." (interactive) (message "Hebrew date (until sunset): %s" (calendar-hebrew-date-string (calendar-cursor-to-date t)))) (defun hebrew-calendar-yahrzeit (death-date year) "Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR." (let* ((death-day (extract-calendar-day death-date)) (death-month (extract-calendar-month death-date)) (death-year (extract-calendar-year death-date))) (cond ;; If it's Heshvan 30 it depends on the first anniversary; if ;; that was not Heshvan 30, use the day before Kislev 1. ((and (= death-month 8) (= death-day 30) (not (hebrew-calendar-long-heshvan-p (1+ death-year)))) (1- (calendar-absolute-from-hebrew (list 9 1 year)))) ;; If it's Kislev 30 it depends on the first anniversary; if ;; that was not Kislev 30, use the day before Teveth 1. ((and (= death-month 9) (= death-day 30) (hebrew-calendar-short-kislev-p (1+ death-year))) (1- (calendar-absolute-from-hebrew (list 10 1 year)))) ;; If it's Adar II, use the same day in last month of ;; year (Adar or Adar II). ((= death-month 13) (calendar-absolute-from-hebrew (list (hebrew-calendar-last-month-of-year year) death-day year))) ;; If it's the 30th in Adar I and year is not a leap year ;; (so Adar has only 29 days), use the last day in Shevat. ((and (= death-day 30) (= death-month 12) (not (hebrew-calendar-leap-year-p year))) (calendar-absolute-from-hebrew (list 11 30 year))) ;; In all other cases, use the normal anniversary of the date of death. (t (calendar-absolute-from-hebrew (list death-month death-day year)))))) (defun calendar-goto-hebrew-date (date &optional noecho) "Move cursor to Hebrew DATE; echo Hebrew date unless NOECHO is t." (interactive (let* ((today (calendar-current-date)) (year (calendar-read "Hebrew calendar year (>3760): " '(lambda (x) (> x 3760)) (int-to-string (extract-calendar-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian today)))))) (month-array (if (hebrew-calendar-leap-year-p year) calendar-hebrew-month-name-array-leap-year calendar-hebrew-month-name-array-common-year)) (completion-ignore-case t) (month (cdr (assoc (capitalize (completing-read "Hebrew calendar month name: " (mapcar 'list (append month-array nil)) (if (= year 3761) '(lambda (x) (let ((m (cdr (assoc (car x) (calendar-make-alist month-array))))) (< 0 (calendar-absolute-from-hebrew (list m (hebrew-calendar-last-day-of-month m year) year)))))) t)) (calendar-make-alist month-array 1 'capitalize)))) (last (hebrew-calendar-last-day-of-month month year)) (first (if (and (= year 3761) (= month 10)) 18 1)) (day (calendar-read (format "Hebrew calendar day (%d-%d): " first last) '(lambda (x) (and (<= first x) (<= x last)))))) (list (list month day year)))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-absolute-from-hebrew date))) (or noecho (calendar-print-hebrew-date))) (defun holiday-hebrew (month day string) "Holiday on MONTH, DAY (Hebrew) called STRING. If MONTH, DAY (Hebrew) is visible, the value returned is corresponding Gregorian date in the form of the list (((month day year) STRING)). Returns nil if it is not visible in the current calendar window." (if (memq displayed-month;; This test is only to speed things up a bit; (list ;; it works fine without the test too. (if (< 11 month) (- month 11) (+ month 1)) (if (< 10 month) (- month 10) (+ month 2)) (if (< 9 month) (- month 9) (+ month 3)) (if (< 8 month) (- month 8) (+ month 4)) (if (< 7 month) (- month 7) (+ month 5)))) (let ((m1 displayed-month) (y1 displayed-year) (m2 displayed-month) (y2 displayed-year) (year)) (increment-calendar-month m1 y1 -1) (increment-calendar-month m2 y2 1) (let* ((start-date (calendar-absolute-from-gregorian (list m1 1 y1))) (end-date (calendar-absolute-from-gregorian (list m2 (calendar-last-day-of-month m2 y2) y2))) (hebrew-start (calendar-hebrew-from-absolute start-date)) (hebrew-end (calendar-hebrew-from-absolute end-date)) (hebrew-y1 (extract-calendar-year hebrew-start)) (hebrew-y2 (extract-calendar-year hebrew-end))) (setq year (if (< 6 month) hebrew-y2 hebrew-y1)) (let ((date (calendar-gregorian-from-absolute (calendar-absolute-from-hebrew (list month day year))))) (if (calendar-date-is-visible-p date) (list (list date string)))))))) (defun holiday-rosh-hashanah-etc () "List of dates related to Rosh Hashanah, as visible in calendar window." (if (or (< displayed-month 8) (> displayed-month 11)) nil;; None of the dates is visible (let* ((abs-r-h (calendar-absolute-from-hebrew (list 7 1 (+ displayed-year 3761)))) (mandatory (list (list (calendar-gregorian-from-absolute abs-r-h) (format "Rosh HaShanah %d" (+ 3761 displayed-year))) (list (calendar-gregorian-from-absolute (+ abs-r-h 9)) "Yom Kippur") (list (calendar-gregorian-from-absolute (+ abs-r-h 14)) "Sukkot") (list (calendar-gregorian-from-absolute (+ abs-r-h 21)) "Shemini Atzeret") (list (calendar-gregorian-from-absolute (+ abs-r-h 22)) "Simchat Torah"))) (optional (list (list (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 6 (- abs-r-h 4))) "Selichot (night)") (list (calendar-gregorian-from-absolute (1- abs-r-h)) "Erev Rosh HaShannah") (list (calendar-gregorian-from-absolute (1+ abs-r-h)) "Rosh HaShanah (second day)") (list (calendar-gregorian-from-absolute (if (= (% abs-r-h 7) 4) (+ abs-r-h 3) (+ abs-r-h 2))) "Tzom Gedaliah") (list (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 6 (+ 7 abs-r-h))) "Shabbat Shuvah") (list (calendar-gregorian-from-absolute (+ abs-r-h 8)) "Erev Yom Kippur") (list (calendar-gregorian-from-absolute (+ abs-r-h 13)) "Erev Sukkot") (list (calendar-gregorian-from-absolute (+ abs-r-h 15)) "Sukkot (second day)") (list (calendar-gregorian-from-absolute (+ abs-r-h 16)) "Hol Hamoed Sukkot (first day)") (list (calendar-gregorian-from-absolute (+ abs-r-h 17)) "Hol Hamoed Sukkot (second day)") (list (calendar-gregorian-from-absolute (+ abs-r-h 18)) "Hol Hamoed Sukkot (third day)") (list (calendar-gregorian-from-absolute (+ abs-r-h 19)) "Hol Hamoed Sukkot (fourth day)") (list (calendar-gregorian-from-absolute (+ abs-r-h 20)) "Hoshannah Rabbah"))) (output-list (filter-visible-calendar-holidays mandatory))) (if all-hebrew-calendar-holidays (setq output-list (append (filter-visible-calendar-holidays optional) output-list))) output-list))) (defun holiday-hanukkah () "List of dates related to Hanukkah, as visible in calendar window." (if (memq displayed-month;; This test is only to speed things up a bit; '(10 11 12 1 2));; it works fine without the test too. (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y 1) (let* ((h-y (extract-calendar-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y))))) (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y)))) (filter-visible-calendar-holidays (list (list (calendar-gregorian-from-absolute (1- abs-h)) "Erev Hanukkah") (list (calendar-gregorian-from-absolute abs-h) "Hanukkah (first day)") (list (calendar-gregorian-from-absolute (1+ abs-h)) "Hanukkah (second day)") (list (calendar-gregorian-from-absolute (+ abs-h 2)) "Hanukkah (third day)") (list (calendar-gregorian-from-absolute (+ abs-h 3)) "Hanukkah (fourth day)") (list (calendar-gregorian-from-absolute (+ abs-h 4)) "Hanukkah (fifth day)") (list (calendar-gregorian-from-absolute (+ abs-h 5)) "Hanukkah (sixth day)") (list (calendar-gregorian-from-absolute (+ abs-h 6)) "Hanukkah (seventh day)") (list (calendar-gregorian-from-absolute (+ abs-h 7)) "Hanukkah (eighth day)"))))))) (defun holiday-passover-etc () "List of dates related to Passover, as visible in calendar window." (if (< 7 displayed-month) nil;; None of the dates is visible (let* ((abs-p (calendar-absolute-from-hebrew (list 1 15 (+ displayed-year 3760)))) (mandatory (list (list (calendar-gregorian-from-absolute abs-p) "Passover") (list (calendar-gregorian-from-absolute (+ abs-p 50)) "Shavuot"))) (optional (list (list (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 6 (- abs-p 43))) "Shabbat Shekalim") (list (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 6 (- abs-p 30))) "Shabbat Zachor") (list (calendar-gregorian-from-absolute (if (= (% abs-p 7) 2) (- abs-p 33) (- abs-p 31))) "Fast of Esther") (list (calendar-gregorian-from-absolute (- abs-p 31)) "Erev Purim") (list (calendar-gregorian-from-absolute (- abs-p 30)) "Purim") (list (calendar-gregorian-from-absolute (if (zerop (% abs-p 7)) (- abs-p 28) (- abs-p 29))) "Shushan Purim") (list (calendar-gregorian-from-absolute (- (calendar-dayname-on-or-before 6 (- abs-p 14)) 7)) "Shabbat Parah") (list (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 6 (- abs-p 14))) "Shabbat HaHodesh") (list (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 6 (1- abs-p))) "Shabbat HaGadol") (list (calendar-gregorian-from-absolute (1- abs-p)) "Erev Passover") (list (calendar-gregorian-from-absolute (1+ abs-p)) "Passover (second day)") (list (calendar-gregorian-from-absolute (+ abs-p 2)) "Hol Hamoed Passover (first day)") (list (calendar-gregorian-from-absolute (+ abs-p 3)) "Hol Hamoed Passover (second day)") (list (calendar-gregorian-from-absolute (+ abs-p 4)) "Hol Hamoed Passover (third day)") (list (calendar-gregorian-from-absolute (+ abs-p 5)) "Hol Hamoed Passover (fourth day)") (list (calendar-gregorian-from-absolute (+ abs-p 6)) "Passover (seventh day)") (list (calendar-gregorian-from-absolute (+ abs-p 7)) "Passover (eighth day)") (list (calendar-gregorian-from-absolute (+ abs-p 12)) "Yom HaShoah") (list (calendar-gregorian-from-absolute (if (zerop (% abs-p 7)) (+ abs-p 18) (if (= (% abs-p 7) 6) (+ abs-p 19) (+ abs-p 20)))) "Yom HaAtzma'ut") (list (calendar-gregorian-from-absolute (+ abs-p 33)) "Lag BaOmer") (list (calendar-gregorian-from-absolute (+ abs-p 43)) "Yom Yerushalim") (list (calendar-gregorian-from-absolute (+ abs-p 49)) "Erev Shavuot") (list (calendar-gregorian-from-absolute (+ abs-p 51)) "Shavuot (second day)"))) (output-list (filter-visible-calendar-holidays mandatory))) (if all-hebrew-calendar-holidays (setq output-list (append (filter-visible-calendar-holidays optional) output-list))) output-list))) (defun holiday-tisha-b-av-etc () "List of dates around Tisha B'Av, as visible in calendar window." (if (or (< displayed-month 5) (> displayed-month 9)) nil;; None of the dates is visible (let* ((abs-t-a (calendar-absolute-from-hebrew (list 5 9 (+ displayed-year 3760))))) (filter-visible-calendar-holidays (list (list (calendar-gregorian-from-absolute (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21))) "Tzom Tammuz") (list (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 6 abs-t-a)) "Shabbat Hazon") (list (calendar-gregorian-from-absolute (if (= (% abs-t-a 7) 6) (1+ abs-t-a) abs-t-a)) "Tisha B'Av") (list (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 6 (+ abs-t-a 7))) "Shabbat Nahamu")))))) (defun list-hebrew-diary-entries () "Add any Hebrew date entries from the diary file to `diary-entries-list'. Hebrew date diary entries must be prefaced by `hebrew-diary-entry-symbol' \(normally an `H'). The same diary date forms govern the style of the Hebrew calendar entries, except that the Hebrew month names must be spelled in full. The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a common Hebrew year. If a Hebrew date diary entry begins with a `diary-nonmarking-symbol', the entry will appear in the diary listing, but will not be marked in the calendar. This function is provided for use with the `nongregorian-diary-listing-hook'." (if (< 0 number) (let ((buffer-read-only nil) (diary-modified (buffer-modified-p)) (gdate original-date) (mark (regexp-quote diary-nonmarking-symbol))) (calendar-for-loop i from 1 to number do (let* ((d diary-date-forms) (hdate (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian gdate))) (month (extract-calendar-month hdate)) (day (extract-calendar-day hdate)) (year (extract-calendar-year hdate))) (while d (let* ((date-form (if (equal (car (car d)) 'backup) (cdr (car d)) (car d))) (backup (equal (car (car d)) 'backup)) (dayname (concat (calendar-day-name gdate) "\\|" (substring (calendar-day-name gdate) 0 3) ".?")) (calendar-month-name-array calendar-hebrew-month-name-array-leap-year) (monthname (concat "\\*\\|" (calendar-month-name month))) (month (concat "\\*\\|0*" (int-to-string month))) (day (concat "\\*\\|0*" (int-to-string day))) (year (concat "\\*\\|0*" (int-to-string year) (if abbreviated-calendar-year (concat "\\|" (int-to-string (% year 100))) ""))) (regexp (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" (regexp-quote hebrew-diary-entry-symbol) "\\(" (mapconcat 'eval date-form "\\)\\(") "\\)")) (case-fold-search t)) (goto-char (point-min)) (while (re-search-forward regexp nil t) (if backup (re-search-backward "\\<" nil t)) (if (and (or (char-equal (preceding-char) ?\^M) (char-equal (preceding-char) ?\n)) (not (looking-at " \\|\^I"))) ;; Diary entry that consists only of date. (backward-char 1) ;; Found a nonempty diary entry--make it visible and ;; add it to the list. (let ((entry-start (point)) (date-start)) (re-search-backward "\^M\\|\n\\|\\`") (setq date-start (point)) (re-search-forward "\^M\\|\n" nil t 2) (while (looking-at " \\|\^I") (re-search-forward "\^M\\|\n" nil t)) (backward-char 1) (subst-char-in-region date-start (point) ?\^M ?\n t) (add-to-diary-list gdate (buffer-substring entry-start (point))))))) (setq d (cdr d)))) (setq gdate (calendar-gregorian-from-absolute (1+ (calendar-absolute-from-gregorian gdate))))) (set-buffer-modified-p diary-modified)) (goto-char (point-min)))) (defun mark-hebrew-diary-entries () "Mark days in the calendar window that have Hebrew date diary entries. Each entry in diary-file (or included files) visible in the calendar window is marked. Hebrew date entries are prefaced by a hebrew-diary-entry-symbol \(normally an `H'). The same diary-date-forms govern the style of the Hebrew calendar entries, except that the Hebrew month names must be spelled in full. The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a common Hebrew year. Hebrew date diary entries that begin with a diary-nonmarking symbol will not be marked in the calendar. This function is provided for use as part of the nongregorian-diary-marking-hook." (let ((d diary-date-forms)) (while d (let* ((date-form (if (equal (car (car d)) 'backup) (cdr (car d)) (car d)));; ignore 'backup directive (dayname (diary-name-pattern calendar-day-name-array)) (monthname (concat (diary-name-pattern calendar-hebrew-month-name-array-leap-year t) "\\|\\*")) (month "[0-9]+\\|\\*") (day "[0-9]+\\|\\*") (year "[0-9]+\\|\\*") (l (length date-form)) (d-name-pos (- l (length (memq 'dayname date-form)))) (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) (m-name-pos (- l (length (memq 'monthname date-form)))) (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) (d-pos (- l (length (memq 'day date-form)))) (d-pos (if (/= l d-pos) (+ 2 d-pos))) (m-pos (- l (length (memq 'month date-form)))) (m-pos (if (/= l m-pos) (+ 2 m-pos))) (y-pos (- l (length (memq 'year date-form)))) (y-pos (if (/= l y-pos) (+ 2 y-pos))) (regexp (concat "\\(\\`\\|\^M\\|\n\\)" (regexp-quote hebrew-diary-entry-symbol) "\\(" (mapconcat 'eval date-form "\\)\\(") "\\)")) (case-fold-search t)) (goto-char (point-min)) (while (re-search-forward regexp nil t) (let* ((dd-name (if d-name-pos (buffer-substring (match-beginning d-name-pos) (match-end d-name-pos)))) (mm-name (if m-name-pos (buffer-substring (match-beginning m-name-pos) (match-end m-name-pos)))) (mm (string-to-int (if m-pos (buffer-substring (match-beginning m-pos) (match-end m-pos)) ""))) (dd (string-to-int (if d-pos (buffer-substring (match-beginning d-pos) (match-end d-pos)) ""))) (y-str (if y-pos (buffer-substring (match-beginning y-pos) (match-end y-pos)))) (yy (if (not y-str) 0 (if (and (= (length y-str) 2) abbreviated-calendar-year) (let* ((current-y (extract-calendar-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (calendar-current-date))))) (y (+ (string-to-int y-str) (* 100 (/ current-y 100))))) (if (> (- y current-y) 50) (- y 100) (if (> (- current-y y) 50) (+ y 100) y))) (string-to-int y-str))))) (if dd-name (mark-calendar-days-named (cdr (assoc (capitalize (substring dd-name 0 3)) (calendar-make-alist calendar-day-name-array 0 '(lambda (x) (substring x 0 3)))))) (if mm-name (if (string-equal mm-name "*") (setq mm 0) (setq mm (cdr (assoc (capitalize mm-name) (calendar-make-alist calendar-hebrew-month-name-array-leap-year)))))) (mark-hebrew-calendar-date-pattern mm dd yy))))) (setq d (cdr d))))) (defun mark-hebrew-calendar-date-pattern (month day year) "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR. A value of 0 in any position is a wildcard." (save-excursion (set-buffer calendar-buffer) (if (and (/= 0 month) (/= 0 day)) (if (/= 0 year) ;; Fully specified Hebrew date. (let ((date (calendar-gregorian-from-absolute (calendar-absolute-from-hebrew (list month day year))))) (if (calendar-date-is-visible-p date) (mark-visible-calendar-date date))) ;; Month and day in any year--this taken from the holiday stuff. (if (memq displayed-month;; This test is only to speed things up a (list ;; bit; it works fine without the test too. (if (< 11 month) (- month 11) (+ month 1)) (if (< 10 month) (- month 10) (+ month 2)) (if (< 9 month) (- month 9) (+ month 3)) (if (< 8 month) (- month 8) (+ month 4)) (if (< 7 month) (- month 7) (+ month 5)))) (let ((m1 displayed-month) (y1 displayed-year) (m2 displayed-month) (y2 displayed-year) (year)) (increment-calendar-month m1 y1 -1) (increment-calendar-month m2 y2 1) (let* ((start-date (calendar-absolute-from-gregorian (list m1 1 y1))) (end-date (calendar-absolute-from-gregorian (list m2 (calendar-last-day-of-month m2 y2) y2))) (hebrew-start (calendar-hebrew-from-absolute start-date)) (hebrew-end (calendar-hebrew-from-absolute end-date)) (hebrew-y1 (extract-calendar-year hebrew-start)) (hebrew-y2 (extract-calendar-year hebrew-end))) (setq year (if (< 6 month) hebrew-y2 hebrew-y1)) (let ((date (calendar-gregorian-from-absolute (calendar-absolute-from-hebrew (list month day year))))) (if (calendar-date-is-visible-p date) (mark-visible-calendar-date date))))))) ;; Not one of the simple cases--check all visible dates for match. ;; Actually, the following code takes care of ALL of the cases, but ;; it's much too slow to be used for the simple (common) cases. (let ((m displayed-month) (y displayed-year) (first-date) (last-date)) (increment-calendar-month m y -1) (setq first-date (calendar-absolute-from-gregorian (list m 1 y))) (increment-calendar-month m y 2) (setq last-date (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y))) (calendar-for-loop date from first-date to last-date do (let* ((h-date (calendar-hebrew-from-absolute date)) (h-month (extract-calendar-month h-date)) (h-day (extract-calendar-day h-date)) (h-year (extract-calendar-year h-date))) (and (or (zerop month) (= month h-month)) (or (zerop day) (= day h-day)) (or (zerop year) (= year h-year)) (mark-visible-calendar-date (calendar-gregorian-from-absolute date))))))))) (defun insert-hebrew-diary-entry (arg) "Insert a diary entry. For the Hebrew date corresponding to the date indicated by point. Prefix arg will make the entry nonmarking." (interactive "P") (let* ((calendar-month-name-array calendar-hebrew-month-name-array-leap-year)) (make-diary-entry (concat hebrew-diary-entry-symbol (calendar-date-string (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (calendar-cursor-to-date t))) nil t)) arg))) (defun insert-monthly-hebrew-diary-entry (arg) "Insert a monthly diary entry. For the day of the Hebrew month corresponding to the date indicated by point. Prefix arg will make the entry nonmarking." (interactive "P") (let* ((calendar-date-display-form (if european-calendar-style '(day " * ") '("* " day ))) (calendar-month-name-array calendar-hebrew-month-name-array-leap-year)) (make-diary-entry (concat hebrew-diary-entry-symbol (calendar-date-string (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) arg))) (defun insert-yearly-hebrew-diary-entry (arg) "Insert an annual diary entry. For the day of the Hebrew year corresponding to the date indicated by point. Prefix arg will make the entry nonmarking." (interactive "P") (let* ((calendar-date-display-form (if european-calendar-style '(day " " monthname) '(monthname " " day))) (calendar-month-name-array calendar-hebrew-month-name-array-leap-year)) (make-diary-entry (concat hebrew-diary-entry-symbol (calendar-date-string (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) arg))) ;;;###autoload (defun list-yahrzeit-dates (death-date start-year end-year) "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." (interactive (let* ((death-date (if (equal (current-buffer) (get-buffer calendar-buffer)) (calendar-cursor-to-date) (let* ((today (calendar-current-date)) (year (calendar-read "Year of death (>0): " '(lambda (x) (> x 0)) (int-to-string (extract-calendar-year today)))) (month-array calendar-month-name-array) (completion-ignore-case t) (month (cdr (assoc (capitalize (completing-read "Month of death (name): " (mapcar 'list (append month-array nil)) nil t)) (calendar-make-alist month-array 1 'capitalize)))) (last (calendar-last-day-of-month month year)) (day (calendar-read (format "Day of death (1-%d): " last) '(lambda (x) (and (< 0 x) (<= x last)))))) (list month day year)))) (death-year (extract-calendar-year death-date)) (start-year (calendar-read (format "Starting year of Yahrzeit table (>%d): " death-year) '(lambda (x) (> x death-year)) (int-to-string (1+ death-year)))) (end-year (calendar-read (format "Ending year of Yahrzeit table (>=%d): " start-year) '(lambda (x) (>= x start-year))))) (list death-date start-year end-year))) (message "Computing yahrzeits...") (let* ((yahrzeit-buffer "*Yahrzeits*") (h-date (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian death-date))) (h-month (extract-calendar-month h-date)) (h-day (extract-calendar-day h-date)) (h-year (extract-calendar-year h-date))) (set-buffer (get-buffer-create yahrzeit-buffer)) (setq buffer-read-only nil) (calendar-set-mode-line (format "Yahrzeit dates for %s = %s" (calendar-date-string death-date) (let ((calendar-month-name-array (if (hebrew-calendar-leap-year-p h-year) calendar-hebrew-month-name-array-leap-year calendar-hebrew-month-name-array-common-year))) (calendar-date-string h-date nil t)))) (erase-buffer) (goto-char (point-min)) (calendar-for-loop i from start-year to end-year do (insert (calendar-date-string (calendar-gregorian-from-absolute (hebrew-calendar-yahrzeit h-date (extract-calendar-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (list 1 1 i))))))) "\n")) (goto-char (point-min)) (set-buffer-modified-p nil) (setq buffer-read-only t) (display-buffer yahrzeit-buffer) (message "Computing yahrzeits...done"))) (defun diary-hebrew-date () "Hebrew calendar equivalent of date diary entry." (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date))) (defun diary-omer () "Omer count diary entry. Entry applies if date is within 50 days after Passover." (let* ((passover (calendar-absolute-from-hebrew (list 1 15 (+ (extract-calendar-year date) 3760)))) (omer (- (calendar-absolute-from-gregorian date) passover)) (week (/ omer 7)) (day (% omer 7))) (if (and (> omer 0) (< omer 50)) (format "Day %d%s of the omer (until sunset)" omer (if (zerop week) "" (format ", that is, %d week%s%s" week (if (= week 1) "" "s") (if (zerop day) "" (format " and %d day%s" day (if (= day 1) "" "s"))))))))) (defun diary-yahrzeit (death-month death-day death-year) "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before. Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary entry is assumed to be the name of the person. Date of death is on the *civil* calendar; although the date of death is specified by the civil calendar, the proper Hebrew calendar yahrzeit is determined. If `european-calendar-style' is t, the order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR." (let* ((h-date (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (if european-calendar-style (list death-day death-month death-year) (list death-month death-day death-year))))) (h-month (extract-calendar-month h-date)) (h-day (extract-calendar-day h-date)) (h-year (extract-calendar-year h-date)) (d (calendar-absolute-from-gregorian date)) (yr (extract-calendar-year (calendar-hebrew-from-absolute d))) (diff (- yr h-year)) (y (hebrew-calendar-yahrzeit h-date yr))) (if (and (> diff 0) (or (= y d) (= y (1+ d)))) (format "Yahrzeit of %s%s: %d%s anniversary" entry (if (= y d) "" " (evening)") diff (cond ((= (% diff 10) 1) "st") ((= (% diff 10) 2) "nd") ((= (% diff 10) 3) "rd") (t "th")))))) (defun diary-rosh-hodesh () "Rosh Hodesh diary entry. Entry applies if date is Rosh Hodesh, the day before, or the Saturday before." (let* ((d (calendar-absolute-from-gregorian date)) (h-date (calendar-hebrew-from-absolute d)) (h-month (extract-calendar-month h-date)) (h-day (extract-calendar-day h-date)) (h-year (extract-calendar-year h-date)) (leap-year (hebrew-calendar-leap-year-p h-year)) (last-day (hebrew-calendar-last-day-of-month h-month h-year)) (h-month-names (if leap-year calendar-hebrew-month-name-array-leap-year calendar-hebrew-month-name-array-common-year)) (this-month (aref h-month-names (1- h-month))) (h-yesterday (extract-calendar-day (calendar-hebrew-from-absolute (1- d))))) (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7))) (format "Rosh Hodesh %s" (if (= h-day 30) (format "%s (first day)" ;; next month must be in the same year since this ;; month can't be the last month of the year since ;; it has 30 days (aref h-month-names h-month)) (if (= h-yesterday 30) (format "%s (second day)" this-month) this-month))) (if (= (% d 7) 6);; Saturday--check for Shabbat Mevarhim (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day)) (format "Mevarhim Rosh Hodesh %s (%s)" (aref h-month-names (if (= h-month (hebrew-calendar-last-month-of-year h-year)) 0 h-month)) (aref calendar-day-name-array (- 29 h-day)))) ((and (< h-day 30) (> h-day 22) (= 30 last-day)) (format "Mevarhim Rosh Hodesh %s (%s-%s)" (aref h-month-names h-month) (if (= h-day 29) "tomorrow" (aref calendar-day-name-array (- 29 h-day))) (aref calendar-day-name-array (% (- 30 h-day) 7))))) (if (and (= h-day 29) (/= h-month 6)) (format "Erev Rosh Hodesh %s" (aref h-month-names (if (= h-month (hebrew-calendar-last-month-of-year h-year)) 0 h-month)))))))) (defun diary-parasha () "Parasha diary entry--entry applies if date is a Saturday." (let ((d (calendar-absolute-from-gregorian date))) (if (= (% d 7) 6);; Saturday (let* ((h-year (extract-calendar-year (calendar-hebrew-from-absolute d))) (rosh-hashannah (calendar-absolute-from-hebrew (list 7 1 h-year))) (passover (calendar-absolute-from-hebrew (list 1 15 h-year))) (rosh-hashannah-day (aref calendar-day-name-array (% rosh-hashannah 7))) (passover-day (aref calendar-day-name-array (% passover 7))) (long-h (hebrew-calendar-long-heshvan-p h-year)) (short-k (hebrew-calendar-short-kislev-p h-year)) (type (cond ((and long-h (not short-k)) "complete") ((and (not long-h) short-k) "incomplete") (t "regular"))) (year-format (symbol-value (intern (format "hebrew-calendar-year-%s-%s-%s";; keviah rosh-hashannah-day type passover-day)))) (first-saturday;; of Hebrew year (calendar-dayname-on-or-before 6 (+ 6 rosh-hashannah))) (saturday;; which Saturday of the Hebrew year (/ (- d first-saturday) 7)) (parasha (aref year-format saturday))) (if parasha (format "Parashat %s" (if (listp parasha);; Israel differs from diaspora (if (car parasha) (format "%s (diaspora), %s (Israel)" (hebrew-calendar-parasha-name (car parasha)) (hebrew-calendar-parasha-name (cdr parasha))) (format "%s (Israel)" (hebrew-calendar-parasha-name (cdr parasha)))) (hebrew-calendar-parasha-name parasha)))))))) (defvar hebrew-calendar-parashiot-names ["Bereshith" "Noah" "Lech L'cha" "Vayera" "Hayei Sarah" "Toledoth" "Vayetze" "Vayishlah" "Vayeshev" "Mikketz" "Vayiggash" "Vayhi" "Shemoth" "Vaera" "Bo" "Beshallah" "Yithro" "Mishpatim" "Terumah" "Tetzavveh" "Ki Tissa" "Vayakhel" "Pekudei" "Vayikra" "Tzav" "Shemini" "Tazria" "Metzora" "Aharei Moth" "Kedoshim" "Emor" "Behar" "Behukkotai" "Bemidbar" "Naso" "Behaalot'cha" "Shelah L'cha" "Korah" "Hukkath" "Balak" "Pinhas" "Mattoth" "Masei" "Devarim" "Vaethanan" "Ekev" "Reeh" "Shofetim" "Ki Tetze" "Ki Tavo" "Nitzavim" "Vayelech" "Haazinu"] "The names of the parashiot in the Torah.") ;; The seven ordinary year types (keviot) (defconst hebrew-calendar-year-Saturday-incomplete-Sunday [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48 49 50] "The structure of the parashiot. Hebrew year starts on Saturday, is `incomplete' (Heshvan and Kislev each have 29 days), and has Passover start on Sunday.") (defconst hebrew-calendar-year-Saturday-complete-Tuesday [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each have 30 days), and has Passover start on Tuesday.") (defconst hebrew-calendar-year-Monday-incomplete-Tuesday [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each have 29 days), and has Passover start on Tuesday.") (defconst hebrew-calendar-year-Monday-complete-Thursday [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have 30 days), and has Passover start on Thursday.") (defconst hebrew-calendar-year-Tuesday-regular-Thursday [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and Kislev has 30 days), and has Passover start on Thursday.") (defconst hebrew-calendar-year-Thursday-regular-Saturday [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] 23 24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30) (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48 49 50] "The structure of the parashiot. Hebrew year that starts on Thursday, is `regular' (Heshvan has 29 days and Kislev has 30 days), and has Passover start on Saturday.") (defconst hebrew-calendar-year-Thursday-complete-Sunday [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48 49 50] "The structure of the parashiot. Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev each have 30 days), and has Passover start on Sunday.") ;; The seven leap year types (keviot) (defconst hebrew-calendar-year-Saturday-incomplete-Tuesday [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 nil 28 29 30 31 32 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Saturday, is `incomplete' (Heshvan and Kislev each have 29 days), and has Passover start on Tuesday.") (defconst hebrew-calendar-year-Saturday-complete-Thursday [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each have 30 days), and has Passover start on Thursday.") (defconst hebrew-calendar-year-Monday-incomplete-Thursday [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each have 29 days), and has Passover start on Thursday.") (defconst hebrew-calendar-year-Monday-complete-Saturday [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32) (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39) (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50] "The structure of the parashiot. Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have 30 days), and has Passover start on Saturday.") (defconst hebrew-calendar-year-Tuesday-regular-Saturday [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32) (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39) (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50] "The structure of the parashiot. Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and Kislev has 30 days), and has Passover start on Saturday.") (defconst hebrew-calendar-year-Thursday-incomplete-Sunday [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50] "The structure of the parashiot. Hebrew year that starts on Thursday, is `incomplete' (Heshvan and Kislev both have 29 days), and has Passover start on Sunday.") (defconst hebrew-calendar-year-Thursday-complete-Tuesday [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both have 30 days), and has Passover start on Tuesday.") (defun hebrew-calendar-parasha-name (p) "Name(s) corresponding to parasha P." (if (arrayp p);; combined parasha (format "%s/%s" (aref hebrew-calendar-parashiot-names (aref p 0)) (aref hebrew-calendar-parashiot-names (aref p 1))) (aref hebrew-calendar-parashiot-names p))) (provide 'cal-hebrew) ;;; cal-hebrew.el ends here emacs-19.30/lisp/cal-islamic.el100444 22346 1 53113 6030153320 15577 0ustar reingolddaemon;;; cal-islamic.el --- calendar functions for the Islamic calendar. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: Islamic calendar, calendar, diary ;; 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 collection of functions implements the features of calendar.el and ;; diary.el that deal with the Islamic calendar. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (require 'cal-julian) (defvar calendar-islamic-month-name-array ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II" "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"]) (defvar calendar-islamic-epoch (calendar-absolute-from-julian '(7 16 622)) "Absolute date of start of Islamic calendar = August 29, 284 A.D. (Julian).") (defun islamic-calendar-leap-year-p (year) "Returns t if YEAR is a leap year on the Islamic calendar." (memq (% year 30) (list 2 5 7 10 13 16 18 21 24 26 29))) (defun islamic-calendar-last-day-of-month (month year) "The last day in MONTH during YEAR on the Islamic calendar." (cond ((memq month (list 1 3 5 7 9 11)) 30) ((memq month (list 2 4 6 8 10)) 29) (t (if (islamic-calendar-leap-year-p year) 30 29)))) (defun islamic-calendar-day-number (date) "Return the day number within the year of the Islamic date DATE." (let* ((month (extract-calendar-month date)) (day (extract-calendar-day date))) (+ (* 30 (/ month 2)) (* 29 (/ (1- month) 2)) day))) (defun calendar-absolute-from-islamic (date) "Absolute date of Islamic DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (let* ((month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date)) (y (% year 30)) (leap-years-in-cycle (cond ((< y 3) 0) ((< y 6) 1) ((< y 8) 2) ((< y 11) 3) ((< y 14) 4) ((< y 17) 5) ((< y 19) 6) ((< y 22) 7) ((< y 25) 8) ((< y 27) 9) (t 10)))) (+ (islamic-calendar-day-number date);; days so far this year (* (1- year) 354) ;; days in all non-leap years (* 11 (/ year 30)) ;; leap days in complete cycles leap-years-in-cycle ;; leap days this cycle (1- calendar-islamic-epoch)))) ;; days before start of calendar (defun calendar-islamic-from-absolute (date) "Compute the Islamic date (month day year) corresponding to absolute DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (if (< date calendar-islamic-epoch) (list 0 0 0);; pre-Islamic date (let* ((approx (/ (- date calendar-islamic-epoch) 355));; Approximation from below. (year ;; Search forward from the approximation. (+ approx (calendar-sum y approx (>= date (calendar-absolute-from-islamic (list 1 1 (1+ y)))) 1))) (month ;; Search forward from Muharram. (1+ (calendar-sum m 1 (> date (calendar-absolute-from-islamic (list m (islamic-calendar-last-day-of-month m year) year))) 1))) (day ;; Calculate the day by subtraction. (- date (1- (calendar-absolute-from-islamic (list month 1 year)))))) (list month day year)))) (defun calendar-islamic-date-string (&optional date) "String of Islamic date before sunset of Gregorian DATE. Returns the empty string if DATE is pre-Islamic. Defaults to today's date if DATE is not given. Driven by the variable `calendar-date-display-form'." (let ((calendar-month-name-array calendar-islamic-month-name-array) (islamic-date (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (or date (calendar-current-date)))))) (if (< (extract-calendar-year islamic-date) 1) "" (calendar-date-string islamic-date nil t)))) (defun calendar-print-islamic-date () "Show the Islamic calendar equivalent of the date under the cursor." (interactive) (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t)))) (if (string-equal i "") (message "Date is pre-Islamic") (message "Islamic date (until sunset): %s" i)))) (defun calendar-goto-islamic-date (date &optional noecho) "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is t." (interactive (let* ((today (calendar-current-date)) (year (calendar-read "Islamic calendar year (>0): " '(lambda (x) (> x 0)) (int-to-string (extract-calendar-year (calendar-islamic-from-absolute (calendar-absolute-from-gregorian today)))))) (month-array calendar-islamic-month-name-array) (completion-ignore-case t) (month (cdr (assoc (capitalize (completing-read "Islamic calendar month name: " (mapcar 'list (append month-array nil)) nil t)) (calendar-make-alist month-array 1 'capitalize)))) (last (islamic-calendar-last-day-of-month month year)) (day (calendar-read (format "Islamic calendar day (1-%d): " last) '(lambda (x) (and (< 0 x) (<= x last)))))) (list (list month day year)))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-absolute-from-islamic date))) (or noecho (calendar-print-islamic-date))) (defun diary-islamic-date () "Islamic calendar equivalent of date diary entry." (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t)))) (if (string-equal i "") "Date is pre-Islamic" (format "Islamic date (until sunset): %s" i)))) (defun holiday-islamic (month day string) "Holiday on MONTH, DAY (Islamic) called STRING. If MONTH, DAY (Islamic) is visible, the value returned is corresponding Gregorian date in the form of the list (((month day year) STRING)). Returns nil if it is not visible in the current calendar window." (let* ((islamic-date (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (list displayed-month 15 displayed-year)))) (m (extract-calendar-month islamic-date)) (y (extract-calendar-year islamic-date)) (date)) (if (< m 1) nil;; Islamic calendar doesn't apply. (increment-calendar-month m y (- 10 month)) (if (> m 7);; Islamic date might be visible (let ((date (calendar-gregorian-from-absolute (calendar-absolute-from-islamic (list month day y))))) (if (calendar-date-is-visible-p date) (list (list date string)))))))) (defun list-islamic-diary-entries () "Add any Islamic date entries from the diary file to `diary-entries-list'. Islamic date diary entries must be prefaced by an `islamic-diary-entry-symbol' \(normally an `I'). The same diary date forms govern the style of the Islamic calendar entries, except that the Islamic month names must be spelled in full. The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being Dhu al-Hijjah. If an Islamic date diary entry begins with a `diary-nonmarking-symbol', the entry will appear in the diary listing, but will not be marked in the calendar. This function is provided for use with the `nongregorian-diary-listing-hook'." (if (< 0 number) (let ((buffer-read-only nil) (diary-modified (buffer-modified-p)) (gdate original-date) (mark (regexp-quote diary-nonmarking-symbol))) (calendar-for-loop i from 1 to number do (let* ((d diary-date-forms) (idate (calendar-islamic-from-absolute (calendar-absolute-from-gregorian gdate))) (month (extract-calendar-month idate)) (day (extract-calendar-day idate)) (year (extract-calendar-year idate))) (while d (let* ((date-form (if (equal (car (car d)) 'backup) (cdr (car d)) (car d))) (backup (equal (car (car d)) 'backup)) (dayname (concat (calendar-day-name gdate) "\\|" (substring (calendar-day-name gdate) 0 3) ".?")) (calendar-month-name-array calendar-islamic-month-name-array) (monthname (concat "\\*\\|" (calendar-month-name month))) (month (concat "\\*\\|0*" (int-to-string month))) (day (concat "\\*\\|0*" (int-to-string day))) (year (concat "\\*\\|0*" (int-to-string year) (if abbreviated-calendar-year (concat "\\|" (int-to-string (% year 100))) ""))) (regexp (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" (regexp-quote islamic-diary-entry-symbol) "\\(" (mapconcat 'eval date-form "\\)\\(") "\\)")) (case-fold-search t)) (goto-char (point-min)) (while (re-search-forward regexp nil t) (if backup (re-search-backward "\\<" nil t)) (if (and (or (char-equal (preceding-char) ?\^M) (char-equal (preceding-char) ?\n)) (not (looking-at " \\|\^I"))) ;; Diary entry that consists only of date. (backward-char 1) ;; Found a nonempty diary entry--make it visible and ;; add it to the list. (let ((entry-start (point)) (date-start)) (re-search-backward "\^M\\|\n\\|\\`") (setq date-start (point)) (re-search-forward "\^M\\|\n" nil t 2) (while (looking-at " \\|\^I") (re-search-forward "\^M\\|\n" nil t)) (backward-char 1) (subst-char-in-region date-start (point) ?\^M ?\n t) (add-to-diary-list gdate (buffer-substring entry-start (point))))))) (setq d (cdr d)))) (setq gdate (calendar-gregorian-from-absolute (1+ (calendar-absolute-from-gregorian gdate))))) (set-buffer-modified-p diary-modified)) (goto-char (point-min)))) (defun mark-islamic-diary-entries () "Mark days in the calendar window that have Islamic date diary entries. Each entry in diary-file (or included files) visible in the calendar window is marked. Islamic date entries are prefaced by a islamic-diary-entry-symbol \(normally an `I'). The same diary-date-forms govern the style of the Islamic calendar entries, except that the Islamic month names must be spelled in full. The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being Dhu al-Hijjah. Islamic date diary entries that begin with a diary-nonmarking-symbol will not be marked in the calendar. This function is provided for use as part of the nongregorian-diary-marking-hook." (let ((d diary-date-forms)) (while d (let* ((date-form (if (equal (car (car d)) 'backup) (cdr (car d)) (car d)));; ignore 'backup directive (dayname (diary-name-pattern calendar-day-name-array)) (monthname (concat (diary-name-pattern calendar-islamic-month-name-array t) "\\|\\*")) (month "[0-9]+\\|\\*") (day "[0-9]+\\|\\*") (year "[0-9]+\\|\\*") (l (length date-form)) (d-name-pos (- l (length (memq 'dayname date-form)))) (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) (m-name-pos (- l (length (memq 'monthname date-form)))) (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) (d-pos (- l (length (memq 'day date-form)))) (d-pos (if (/= l d-pos) (+ 2 d-pos))) (m-pos (- l (length (memq 'month date-form)))) (m-pos (if (/= l m-pos) (+ 2 m-pos))) (y-pos (- l (length (memq 'year date-form)))) (y-pos (if (/= l y-pos) (+ 2 y-pos))) (regexp (concat "\\(\\`\\|\^M\\|\n\\)" (regexp-quote islamic-diary-entry-symbol) "\\(" (mapconcat 'eval date-form "\\)\\(") "\\)")) (case-fold-search t)) (goto-char (point-min)) (while (re-search-forward regexp nil t) (let* ((dd-name (if d-name-pos (buffer-substring (match-beginning d-name-pos) (match-end d-name-pos)))) (mm-name (if m-name-pos (buffer-substring (match-beginning m-name-pos) (match-end m-name-pos)))) (mm (string-to-int (if m-pos (buffer-substring (match-beginning m-pos) (match-end m-pos)) ""))) (dd (string-to-int (if d-pos (buffer-substring (match-beginning d-pos) (match-end d-pos)) ""))) (y-str (if y-pos (buffer-substring (match-beginning y-pos) (match-end y-pos)))) (yy (if (not y-str) 0 (if (and (= (length y-str) 2) abbreviated-calendar-year) (let* ((current-y (extract-calendar-year (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (calendar-current-date))))) (y (+ (string-to-int y-str) (* 100 (/ current-y 100))))) (if (> (- y current-y) 50) (- y 100) (if (> (- current-y y) 50) (+ y 100) y))) (string-to-int y-str))))) (if dd-name (mark-calendar-days-named (cdr (assoc (capitalize (substring dd-name 0 3)) (calendar-make-alist calendar-day-name-array 0 '(lambda (x) (substring x 0 3)))))) (if mm-name (if (string-equal mm-name "*") (setq mm 0) (setq mm (cdr (assoc (capitalize mm-name) (calendar-make-alist calendar-islamic-month-name-array)))))) (mark-islamic-calendar-date-pattern mm dd yy))))) (setq d (cdr d))))) (defun mark-islamic-calendar-date-pattern (month day year) "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR. A value of 0 in any position is a wildcard." (save-excursion (set-buffer calendar-buffer) (if (and (/= 0 month) (/= 0 day)) (if (/= 0 year) ;; Fully specified Islamic date. (let ((date (calendar-gregorian-from-absolute (calendar-absolute-from-islamic (list month day year))))) (if (calendar-date-is-visible-p date) (mark-visible-calendar-date date))) ;; Month and day in any year--this taken from the holiday stuff. (let* ((islamic-date (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (list displayed-month 15 displayed-year)))) (m (extract-calendar-month islamic-date)) (y (extract-calendar-year islamic-date)) (date)) (if (< m 1) nil;; Islamic calendar doesn't apply. (increment-calendar-month m y (- 10 month)) (if (> m 7);; Islamic date might be visible (let ((date (calendar-gregorian-from-absolute (calendar-absolute-from-islamic (list month day y))))) (if (calendar-date-is-visible-p date) (mark-visible-calendar-date date))))))) ;; Not one of the simple cases--check all visible dates for match. ;; Actually, the following code takes care of ALL of the cases, but ;; it's much too slow to be used for the simple (common) cases. (let ((m displayed-month) (y displayed-year) (first-date) (last-date)) (increment-calendar-month m y -1) (setq first-date (calendar-absolute-from-gregorian (list m 1 y))) (increment-calendar-month m y 2) (setq last-date (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y))) (calendar-for-loop date from first-date to last-date do (let* ((i-date (calendar-islamic-from-absolute date)) (i-month (extract-calendar-month i-date)) (i-day (extract-calendar-day i-date)) (i-year (extract-calendar-year i-date))) (and (or (zerop month) (= month i-month)) (or (zerop day) (= day i-day)) (or (zerop year) (= year i-year)) (mark-visible-calendar-date (calendar-gregorian-from-absolute date))))))))) (defun insert-islamic-diary-entry (arg) "Insert a diary entry. For the Islamic date corresponding to the date indicated by point. Prefix arg will make the entry nonmarking." (interactive "P") (let* ((calendar-month-name-array calendar-islamic-month-name-array)) (make-diary-entry (concat islamic-diary-entry-symbol (calendar-date-string (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (calendar-cursor-to-date t))) nil t)) arg))) (defun insert-monthly-islamic-diary-entry (arg) "Insert a monthly diary entry. For the day of the Islamic month corresponding to the date indicated by point. Prefix arg will make the entry nonmarking." (interactive "P") (let* ((calendar-date-display-form (if european-calendar-style '(day " * ") '("* " day ))) (calendar-month-name-array calendar-islamic-month-name-array)) (make-diary-entry (concat islamic-diary-entry-symbol (calendar-date-string (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) arg))) (defun insert-yearly-islamic-diary-entry (arg) "Insert an annual diary entry. For the day of the Islamic year corresponding to the date indicated by point. Prefix arg will make the entry nonmarking." (interactive "P") (let* ((calendar-date-display-form (if european-calendar-style '(day " " monthname) '(monthname " " day))) (calendar-month-name-array calendar-islamic-month-name-array)) (make-diary-entry (concat islamic-diary-entry-symbol (calendar-date-string (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) arg))) (provide 'cal-islamic) ;;; cal-islamic.el ends here emacs-19.30/lisp/cal-iso.el100444 22346 1 12227 6030153360 14755 0ustar reingolddaemon;;; cal-iso.el --- calendar functions for the ISO calendar. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: ISO calendar, calendar, diary ;; 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 collection of functions implements the features of calendar.el and ;; diary.el that deal with the ISO calendar. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (require 'calendar) (defun calendar-absolute-from-iso (date) "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. The `ISO year' corresponds approximately to the Gregorian year, but weeks start on Monday and end on Sunday. The first week of the ISO year is the first such week in which at least 4 days are in a year. The ISO commercial DATE has the form (week day year) in which week is in the range 1..52 and day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 = Sunday). The Gregorian date Sunday, December 31, 1 BC is imaginary." (let* ((week (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date))) (+ (calendar-dayname-on-or-before 1 (+ 3 (calendar-absolute-from-gregorian (list 1 1 year)))) (* 7 (1- week)) (if (= day 0) 6 (1- day))))) (defun calendar-iso-from-absolute (date) "Compute the `ISO commercial date' corresponding to the absolute DATE. The ISO year corresponds approximately to the Gregorian year, but weeks start on Monday and end on Sunday. The first week of the ISO year is the first such week in which at least 4 days are in a year. The ISO commercial date has the form (week day year) in which week is in the range 1..52 and day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 = Sunday). The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (let* ((approx (extract-calendar-year (calendar-gregorian-from-absolute (- date 3)))) (year (+ approx (calendar-sum y approx (>= date (calendar-absolute-from-iso (list 1 1 (1+ y)))) 1)))) (list (1+ (/ (- date (calendar-absolute-from-iso (list 1 1 year))) 7)) (% date 7) year))) (defun calendar-iso-date-string (&optional date) "String of ISO date of Gregorian DATE. Defaults to today's date if DATE is not given." (let* ((d (calendar-absolute-from-gregorian (or date (calendar-current-date)))) (day (% d 7)) (iso-date (calendar-iso-from-absolute d))) (format "Day %s of week %d of %d" (if (zerop day) 7 day) (extract-calendar-month iso-date) (extract-calendar-year iso-date)))) (defun calendar-print-iso-date () "Show equivalent ISO date for the date under the cursor." (interactive) (message "ISO date: %s" (calendar-iso-date-string (calendar-cursor-to-date t)))) (defun calendar-goto-iso-date (date &optional noecho) "Move cursor to ISO DATE; echo ISO date unless NOECHO is t." (interactive (let* ((today (calendar-current-date)) (year (calendar-read "ISO calendar year (>0): " '(lambda (x) (> x 0)) (int-to-string (extract-calendar-year today)))) (no-weeks (extract-calendar-month (calendar-iso-from-absolute (1- (calendar-dayname-on-or-before 1 (calendar-absolute-from-gregorian (list 1 4 (1+ year)))))))) (week (calendar-read (format "ISO calendar week (1-%d): " no-weeks) '(lambda (x) (and (> x 0) (<= x no-weeks))))) (day (calendar-read "ISO day (1-7): " '(lambda (x) (and (<= 1 x) (<= x 7)))))) (list (list week day year)))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-absolute-from-iso date))) (or noecho (calendar-print-iso-date))) (defun diary-iso-date () "ISO calendar equivalent of date diary entry." (format "ISO date: %s" (calendar-iso-date-string date))) (provide 'cal-iso) ;;; cal-iso.el ends here emacs-19.30/lisp/cal-julian.el100444 22346 1 20246 6030153413 15444 0ustar reingolddaemon;;; cal-julian.el --- calendar functions for the Julian calendar. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: Julian calendar, Julian day number, calendar, diary ;; 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 collection of functions implements the features of calendar.el and ;; diary.el that deal with the Julian calendar. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (require 'calendar) (defun calendar-julian-from-absolute (date) "Compute the Julian (month day year) corresponding to the absolute DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (let* ((approx (/ (+ date 2) 366));; Approximation from below. (year ;; Search forward from the approximation. (+ approx (calendar-sum y approx (>= date (calendar-absolute-from-julian (list 1 1 (1+ y)))) 1))) (month ;; Search forward from January. (1+ (calendar-sum m 1 (> date (calendar-absolute-from-julian (list m (if (and (= m 2) (= (% year 4) 0)) 29 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- m))) year))) 1))) (day ;; Calculate the day by subtraction. (- date (1- (calendar-absolute-from-julian (list month 1 year)))))) (list month day year))) (defun calendar-absolute-from-julian (date) "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. The Gregorian date Sunday, December 31, 1 BC is imaginary." (let ((month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date))) (+ (calendar-day-number date) (if (and (= (% year 100) 0) (/= (% year 400) 0) (> month 2)) 1 0);; Correct for Julian but not Gregorian leap year. (* 365 (1- year)) (/ (1- year) 4) -2))) (defun calendar-julian-date-string (&optional date) "String of Julian date of Gregorian DATE. Defaults to today's date if DATE is not given. Driven by the variable `calendar-date-display-form'." (calendar-date-string (calendar-julian-from-absolute (calendar-absolute-from-gregorian (or date (calendar-current-date)))) nil t)) (defun calendar-print-julian-date () "Show the Julian calendar equivalent of the date under the cursor." (interactive) (message "Julian date: %s" (calendar-julian-date-string (calendar-cursor-to-date t)))) (defun calendar-goto-julian-date (date &optional noecho) "Move cursor to Julian DATE; echo Julian date unless NOECHO is t." (interactive (let* ((today (calendar-current-date)) (year (calendar-read "Julian calendar year (>0): " '(lambda (x) (> x 0)) (int-to-string (extract-calendar-year (calendar-julian-from-absolute (calendar-absolute-from-gregorian today)))))) (month-array calendar-month-name-array) (completion-ignore-case t) (month (cdr (assoc (capitalize (completing-read "Julian calendar month name: " (mapcar 'list (append month-array nil)) nil t)) (calendar-make-alist month-array 1 'capitalize)))) (last (if (and (zerop (% year 4)) (= month 2)) 29 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month)))) (day (calendar-read (format "Julian calendar day (%d-%d): " (if (and (= year 1) (= month 1)) 3 1) last) '(lambda (x) (and (< (if (and (= year 1) (= month 1)) 2 0) x) (<= x last)))))) (list (list month day year)))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-absolute-from-julian date))) (or noecho (calendar-print-julian-date))) (defun holiday-julian (month day string) "Holiday on MONTH, DAY (Julian) called STRING. If MONTH, DAY (Julian) is visible, the value returned is corresponding Gregorian date in the form of the list (((month day year) STRING)). Returns nil if it is not visible in the current calendar window." (let ((m1 displayed-month) (y1 displayed-year) (m2 displayed-month) (y2 displayed-year) (year)) (increment-calendar-month m1 y1 -1) (increment-calendar-month m2 y2 1) (let* ((start-date (calendar-absolute-from-gregorian (list m1 1 y1))) (end-date (calendar-absolute-from-gregorian (list m2 (calendar-last-day-of-month m2 y2) y2))) (julian-start (calendar-julian-from-absolute start-date)) (julian-end (calendar-julian-from-absolute end-date)) (julian-y1 (extract-calendar-year julian-start)) (julian-y2 (extract-calendar-year julian-end))) (setq year (if (< 10 month) julian-y1 julian-y2)) (let ((date (calendar-gregorian-from-absolute (calendar-absolute-from-julian (list month day year))))) (if (calendar-date-is-visible-p date) (list (list date string))))))) (defun diary-julian-date () "Julian calendar equivalent of date diary entry." (format "Julian date: %s" (calendar-julian-date-string date))) (defun calendar-absolute-from-astro (d) "Absolute date of astronical (Julian) day number D." (- d 1721424.5)) (defun calendar-astro-from-absolute (d) "Astronomical (Julian) day number of absolute date D." (+ d 1721424.5)) (defun calendar-astro-date-string (&optional date) "String of astronomical (Julian) day number after noon UTC of Gregorian DATE. Defaults to today's date if DATE is not given." (int-to-string (ceiling (calendar-astro-from-absolute (calendar-absolute-from-gregorian (or date (calendar-current-date))))))) (defun calendar-print-astro-day-number () "Show astronomical (Julian) day number after noon UTC on date shown by cursor." (interactive) (message "Astronomical (Julian) day number (after noon UTC): %s" (calendar-astro-date-string (calendar-cursor-to-date t)))) (defun calendar-goto-astro-day-number (daynumber &optional noecho) "Move cursor to astronomical (Julian) DAYNUMBER. Echo astronomical (Julian) day number unless NOECHO is t." (interactive (list (calendar-read "Astronomical (Julian) day number (>1721425): " '(lambda (x) (> x 1721425))))) (calendar-goto-date (calendar-gregorian-from-absolute (floor (calendar-absolute-from-astro daynumber)))) (or noecho (calendar-print-astro-day-number))) (defun diary-astro-day-number () "Astronomical (Julian) day number diary entry." (format "Astronomical (Julian) day number %s" (calendar-astro-date-string date))) (provide 'cal-julian) ;;; cal-julian.el ends here emacs-19.30/lisp/cal-mayan.el100444 22346 1 36267 6030151471 15303 0ustar reingolddaemon;;; cal-mayan.el --- calendar functions for the Mayan calendars. ;; Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc. ;; Author: Stewart M. Clamen ;; Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: Mayan calendar, Maya, calendar, diary ;; 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 collection of functions implements the features of calendar.el and ;; diary.el that deal with the Mayan calendar. It was written jointly by ;; Stewart M. Clamen School of Computer Science ;; clamen@cs.cmu.edu Carnegie Mellon University ;; 5000 Forbes Avenue ;; Pittsburgh, PA 15213 ;; and ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;; Comments, improvements, and bug reports should be sent to Reingold. ;; Technical details of the Mayan calendrical calculations can be found in ;; ``Calendrical Calculations, Part II: Three Historical Calendars'' ;; by E. M. Reingold, N. Dershowitz, and S. M. Clamen, ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993), ;; pages 383-404. ;;; Code: (require 'calendar) (defconst calendar-mayan-days-before-absolute-zero 1137140 "Number of days of the Mayan calendar epoch before absolute day 0. According to the Goodman-Martinez-Thompson correlation. This correlation is not universally accepted, as it still a subject of astro-archeological research. Using 1232041 will give you Spinden's correlation; using 1142840 will give you Hochleitner's correlation.") (defconst calendar-mayan-haab-at-epoch '(8 . 18) "Mayan haab date at the epoch.") (defconst calendar-mayan-haab-month-name-array ["Pop" "Uo" "Zip" "Zotz" "Tzec" "Xul" "Yaxkin" "Mol" "Chen" "Yax" "Zac" "Ceh" "Mac" "Kankin" "Muan" "Pax" "Kayab" "Cumku"]) (defconst calendar-mayan-tzolkin-at-epoch '(4 . 20) "Mayan tzolkin date at the epoch.") (defconst calendar-mayan-tzolkin-names-array ["Imix" "Ik" "Akbal" "Kan" "Chicchan" "Cimi" "Manik" "Lamat" "Muluc" "Oc" "Chuen" "Eb" "Ben" "Ix" "Men" "Cib" "Caban" "Etznab" "Cauac" "Ahau"]) (defun calendar-mayan-long-count-from-absolute (date) "Compute the Mayan long count corresponding to the absolute DATE." (let ((long-count (+ date calendar-mayan-days-before-absolute-zero))) (let* ((baktun (/ long-count 144000)) (remainder (% long-count 144000)) (katun (/ remainder 7200)) (remainder (% remainder 7200)) (tun (/ remainder 360)) (remainder (% remainder 360)) (uinal (/ remainder 20)) (kin (% remainder 20))) (list baktun katun tun uinal kin)))) (defun calendar-mayan-long-count-to-string (mayan-long-count) "Convert MAYAN-LONG-COUNT into traditional written form." (apply 'format (cons "%s.%s.%s.%s.%s" mayan-long-count))) (defun calendar-string-to-mayan-long-count (str) "Given STR, a string of format \"%d.%d.%d.%d.%d\", return list of nums." (let ((rlc nil) (c (length str)) (cc 0)) (condition-case condition (progn (while (< cc c) (let* ((start (string-match "[0-9]+" str cc)) (end (match-end 0)) datum) (setq datum (read (substring str start end))) (setq rlc (cons datum rlc)) (setq cc end))) (if (not (= (length rlc) 5)) (signal 'invalid-read-syntax nil))) (invalid-read-syntax nil)) (reverse rlc))) (defun calendar-mayan-haab-from-absolute (date) "Convert absolute DATE into a Mayan haab date (a pair)." (let* ((long-count (+ date calendar-mayan-days-before-absolute-zero)) (day-of-haab (% (+ long-count (car calendar-mayan-haab-at-epoch) (* 20 (1- (cdr calendar-mayan-haab-at-epoch)))) 365)) (day (% day-of-haab 20)) (month (1+ (/ day-of-haab 20)))) (cons day month))) (defun calendar-mayan-haab-difference (date1 date2) "Number of days from Mayan haab DATE1 to next occurrence of haab date DATE2." (mod (+ (* 20 (- (cdr date2) (cdr date1))) (- (car date2) (car date1))) 365)) (defun calendar-mayan-haab-on-or-before (haab-date date) "Absolute date of latest HAAB-DATE on or before absolute DATE." (- date (% (- date (calendar-mayan-haab-difference (calendar-mayan-haab-from-absolute 0) haab-date)) 365))) (defun calendar-next-haab-date (haab-date &optional noecho) "Move cursor to next instance of Mayan HAAB-DATE. Echo Mayan date if NOECHO is t." (interactive (list (calendar-read-mayan-haab-date))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-mayan-haab-on-or-before haab-date (+ 365 (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) (or noecho (calendar-print-mayan-date))) (defun calendar-previous-haab-date (haab-date &optional noecho) "Move cursor to previous instance of Mayan HAAB-DATE. Echo Mayan date if NOECHO is t." (interactive (list (calendar-read-mayan-haab-date))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-mayan-haab-on-or-before haab-date (1- (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) (or noecho (calendar-print-mayan-date))) (defun calendar-mayan-haab-to-string (haab) "Convert Mayan haab date (a pair) into its traditional written form." (let ((month (cdr haab)) (day (car haab))) ;; 19th month consists of 5 special days (if (= month 19) (format "%d Uayeb" day) (format "%d %s" day (aref calendar-mayan-haab-month-name-array (1- month)))))) (defun calendar-mayan-tzolkin-from-absolute (date) "Convert absolute DATE into a Mayan tzolkin date (a pair)." (let* ((long-count (+ date calendar-mayan-days-before-absolute-zero)) (day (calendar-mod (+ long-count (car calendar-mayan-tzolkin-at-epoch)) 13)) (name (calendar-mod (+ long-count (cdr calendar-mayan-tzolkin-at-epoch)) 20))) (cons day name))) (defun calendar-mayan-tzolkin-difference (date1 date2) "Number of days from Mayan tzolkin DATE1 to next occurrence of tzolkin DATE2." (let ((number-difference (- (car date2) (car date1))) (name-difference (- (cdr date2) (cdr date1)))) (mod (+ number-difference (* 13 (mod (* 3 (- number-difference name-difference)) 20))) 260))) (defun calendar-mayan-tzolkin-on-or-before (tzolkin-date date) "Absolute date of latest TZOLKIN-DATE on or before absolute DATE." (- date (% (- date (calendar-mayan-tzolkin-difference (calendar-mayan-tzolkin-from-absolute 0) tzolkin-date)) 260))) (defun calendar-next-tzolkin-date (tzolkin-date &optional noecho) "Move cursor to next instance of Mayan TZOLKIN-DATE. Echo Mayan date if NOECHO is t." (interactive (list (calendar-read-mayan-tzolkin-date))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-mayan-tzolkin-on-or-before tzolkin-date (+ 260 (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) (or noecho (calendar-print-mayan-date))) (defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho) "Move cursor to previous instance of Mayan TZOLKIN-DATE. Echo Mayan date if NOECHO is t." (interactive (list (calendar-read-mayan-tzolkin-date))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-mayan-tzolkin-on-or-before tzolkin-date (1- (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) (or noecho (calendar-print-mayan-date))) (defun calendar-mayan-tzolkin-to-string (tzolkin) "Convert Mayan tzolkin date (a pair) into its traditional written form." (format "%d %s" (car tzolkin) (aref calendar-mayan-tzolkin-names-array (1- (cdr tzolkin))))) (defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date) "Absolute date that is Mayan TZOLKIN-DATE and HAAB-DATE. Latest such date on or before DATE. Returns nil if such a tzolkin-haab combination is impossible." (let* ((haab-difference (calendar-mayan-haab-difference (calendar-mayan-haab-from-absolute 0) haab-date)) (tzolkin-difference (calendar-mayan-tzolkin-difference (calendar-mayan-tzolkin-from-absolute 0) tzolkin-date)) (difference (- tzolkin-difference haab-difference))) (if (= (% difference 5) 0) (- date (mod (- date (+ haab-difference (* 365 difference))) 18980)) nil))) (defun calendar-read-mayan-haab-date () "Prompt for a Mayan haab date" (let* ((completion-ignore-case t) (haab-day (calendar-read "Haab kin (0-19): " '(lambda (x) (and (>= x 0) (< x 20))))) (haab-month-list (append calendar-mayan-haab-month-name-array (and (< haab-day 5) '("Uayeb")))) (haab-month (cdr (assoc (capitalize (completing-read "Haab uinal: " (mapcar 'list haab-month-list) nil t)) (calendar-make-alist haab-month-list 1 'capitalize))))) (cons haab-day haab-month))) (defun calendar-read-mayan-tzolkin-date () "Prompt for a Mayan tzolkin date" (let* ((completion-ignore-case t) (tzolkin-count (calendar-read "Tzolkin kin (1-13): " '(lambda (x) (and (> x 0) (< x 14))))) (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil)) (tzolkin-name (cdr (assoc (capitalize (completing-read "Tzolkin uinal: " (mapcar 'list tzolkin-name-list) nil t)) (calendar-make-alist tzolkin-name-list 1 'capitalize))))) (cons tzolkin-count tzolkin-name))) (defun calendar-next-calendar-round-date (tzolkin-date haab-date &optional noecho) "Move cursor to next instance of Mayan HAAB-DATE TZOKLIN-DATE combination. Echo Mayan date if NOECHO is t." (interactive (list (calendar-read-mayan-tzolkin-date) (calendar-read-mayan-haab-date))) (let ((date (calendar-mayan-tzolkin-haab-on-or-before tzolkin-date haab-date (+ 18980 (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) (if (not date) (error "%s, %s does not exist in the Mayan calendar round" (calendar-mayan-tzolkin-to-string tzolkin-date) (calendar-mayan-haab-to-string haab-date)) (calendar-goto-date (calendar-gregorian-from-absolute date)) (or noecho (calendar-print-mayan-date))))) (defun calendar-previous-calendar-round-date (tzolkin-date haab-date &optional noecho) "Move to previous instance of Mayan TZOKLIN-DATE HAAB-DATE combination. Echo Mayan date if NOECHO is t." (interactive (list (calendar-read-mayan-tzolkin-date) (calendar-read-mayan-haab-date))) (let ((date (calendar-mayan-tzolkin-haab-on-or-before tzolkin-date haab-date (1- (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) (if (not date) (error "%s, %s does not exist in the Mayan calendar round" (calendar-mayan-tzolkin-to-string tzolkin-date) (calendar-mayan-haab-to-string haab-date)) (calendar-goto-date (calendar-gregorian-from-absolute date)) (or noecho (calendar-print-mayan-date))))) (defun calendar-absolute-from-mayan-long-count (c) "Compute the absolute date corresponding to the Mayan Long Count C. Long count is a list (baktun katun tun uinal kin)" (+ (* (nth 0 c) 144000) ; baktun (* (nth 1 c) 7200) ; katun (* (nth 2 c) 360) ; tun (* (nth 3 c) 20) ; uinal (nth 4 c) ; kin (days) (- ; days before absolute date 0 calendar-mayan-days-before-absolute-zero))) (defun calendar-mayan-date-string (&optional date) "String of Mayan date of Gregorian DATE. Defaults to today's date if DATE is not given." (let* ((d (calendar-absolute-from-gregorian (or date (calendar-current-date)))) (tzolkin (calendar-mayan-tzolkin-from-absolute d)) (haab (calendar-mayan-haab-from-absolute d)) (long-count (calendar-mayan-long-count-from-absolute d))) (format "Long count = %s; tzolkin = %s; haab = %s" (calendar-mayan-long-count-to-string long-count) (calendar-mayan-tzolkin-to-string tzolkin) (calendar-mayan-haab-to-string haab)))) (defun calendar-print-mayan-date () "Show the Mayan long count, tzolkin, and haab equivalents of date." (interactive) (message "Mayan date: %s" (calendar-mayan-date-string (calendar-cursor-to-date t)))) (defun calendar-goto-mayan-long-count-date (date &optional noecho) "Move cursor to Mayan long count DATE. Echo Mayan date unless NOECHO is t." (interactive (let (lc) (while (not lc) (let ((datum (calendar-string-to-mayan-long-count (read-string "Mayan long count (baktun.katun.tun.uinal.kin): " (calendar-mayan-long-count-to-string (calendar-mayan-long-count-from-absolute (calendar-absolute-from-gregorian (calendar-current-date)))))))) (if (calendar-mayan-long-count-common-era datum) (setq lc datum)))) (list lc))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-absolute-from-mayan-long-count date))) (or noecho (calendar-print-mayan-date))) (defun calendar-mayan-long-count-common-era (lc) "T if long count represents date in the Common Era." (let ((base (calendar-mayan-long-count-from-absolute 1))) (while (and (not (null base)) (= (car lc) (car base))) (setq lc (cdr lc) base (cdr base))) (or (null lc) (> (car lc) (car base))))) (defun diary-mayan-date () "Show the Mayan long count, haab, and tzolkin dates as a diary entry." (format "Mayan date: %s" (calendar-mayan-date-string date))) (provide 'cal-mayan) ;;; cal-mayan.el ends here emacs-19.30/lisp/cal-menu.el100444 22346 1 51767 6043205550 15146 0ustar reingolddaemon;;; cal-menu.el --- calendar functions for menu bar and popup menu support ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Lara Rios ;; Keywords: calendar ;; Human-Keywords: calendar, popup menus, menu bar ;; 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 collection of functions implements menu bar and popup menu support for ;; calendar.el. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (define-key calendar-mode-map [menu-bar edit] 'undefined) (define-key calendar-mode-map [down-mouse-2] 'calendar-mouse-2-date-menu) (define-key calendar-mode-map [mouse-2] 'ignore) (defvar calendar-mouse-3-map (make-sparse-keymap "Calendar")) (define-key calendar-mode-map [down-mouse-3] calendar-mouse-3-map) (define-key calendar-mode-map [C-down-mouse-3] calendar-mouse-3-map) (define-key calendar-mode-map [menu-bar moon] (cons "Moon" (make-sparse-keymap "Moon"))) (define-key calendar-mode-map [menu-bar moon moon] '("Lunar Phases" . calendar-phases-of-moon)) (define-key calendar-mode-map [menu-bar diary] (cons "Diary" (make-sparse-keymap "Diary"))) (define-key calendar-mode-map [menu-bar diary heb] '("Insert Hebrew" . calendar-mouse-insert-hebrew-diary-entry)) (define-key calendar-mode-map [menu-bar diary isl] '("Insert Islamic" . calendar-mouse-insert-islamic-diary-entry)) (define-key calendar-mode-map [menu-bar diary cyc] '("Insert Cyclic" . insert-cyclic-diary-entry)) (define-key calendar-mode-map [menu-bar diary blk] '("Insert Block" . insert-block-diary-entry)) (define-key calendar-mode-map [menu-bar diary ann] '("Insert Anniversary" . insert-anniversary-diary-entry)) (define-key calendar-mode-map [menu-bar diary yr] '("Insert Yearly" . insert-yearly-diary-entry)) (define-key calendar-mode-map [menu-bar diary mon] '("Insert Monthly" . insert-monthly-diary-entry)) (define-key calendar-mode-map [menu-bar diary wk] '("Insert Weekly" . insert-weekly-diary-entry)) (define-key calendar-mode-map [menu-bar diary ent] '("Insert Daily". insert-diary-entry)) (define-key calendar-mode-map [menu-bar diary all] '("Show All" . show-all-diary-entries)) (define-key calendar-mode-map [menu-bar diary mark] '("Mark All" . mark-diary-entries)) (define-key calendar-mode-map [menu-bar diary view] '("Cursor Date" . view-diary-entries)) (define-key calendar-mode-map [menu-bar diary view] '("Other File" . view-other-diary-entries)) (define-key calendar-mode-map [menu-bar holidays] (cons "Holidays" (make-sparse-keymap "Holidays"))) (define-key calendar-mode-map [menu-bar holidays unmark] '("Unmark" . calendar-unmark)) (define-key calendar-mode-map [menu-bar holidays mark] '("Mark" . mark-calendar-holidays)) (define-key calendar-mode-map [menu-bar holidays 3-mon] '("3 Months" . list-calendar-holidays)) (define-key calendar-mode-map [menu-bar holidays 1-day] '("One Day" . calendar-cursor-holidays)) (define-key calendar-mode-map [menu-bar goto] (cons "Goto" (make-sparse-keymap "Goto"))) (define-key calendar-mode-map [menu-bar goto french] '("French Date" . calendar-goto-french-date)) (define-key calendar-mode-map [menu-bar goto mayan] (cons "Mayan Date" (make-sparse-keymap "Mayan"))) (define-key calendar-mode-map [menu-bar goto ethiopic] '("Ethiopic Date" . calendar-goto-ethiopic-date)) (define-key calendar-mode-map [menu-bar goto coptic] '("Coptic Date" . calendar-goto-coptic-date)) (define-key calendar-mode-map [menu-bar goto chinese] '("Chinese Date" . calendar-goto-chinese-date)) (define-key calendar-mode-map [menu-bar goto julian] '("Julian Date" . calendar-goto-julian-date)) (define-key calendar-mode-map [menu-bar goto islamic] '("Islamic Date" . calendar-goto-islamic-date)) (define-key calendar-mode-map [menu-bar goto hebrew] '("Hebrew Date" . calendar-goto-hebrew-date)) (define-key calendar-mode-map [menu-bar goto astro] '("Astronomical Date" . calendar-goto-astro-day-number)) (define-key calendar-mode-map [menu-bar goto iso] '("ISO Date" . calendar-goto-iso-date)) (define-key calendar-mode-map [menu-bar goto gregorian] '("Other Date" . calendar-goto-date)) (define-key calendar-mode-map [menu-bar goto end-of-year] '("End of Year" . calendar-end-of-year)) (define-key calendar-mode-map [menu-bar goto beginning-of-year] '("Beginning of Year" . calendar-beginning-of-year)) (define-key calendar-mode-map [menu-bar goto end-of-month] '("End of Month" . calendar-end-of-month)) (define-key calendar-mode-map [menu-bar goto beginning-of-month] '("Beginning of Month" . calendar-beginning-of-month)) (define-key calendar-mode-map [menu-bar goto end-of-week] '("End of Week" . calendar-end-of-week)) (define-key calendar-mode-map [menu-bar goto beginning-of-week] '("Beginning of Week" . calendar-beginning-of-week)) (define-key calendar-mode-map [menu-bar goto today] '("Today" . calendar-goto-today)) (define-key calendar-mode-map [menu-bar goto mayan prev-rnd] '("Previous Round" . calendar-previous-calendar-round-date)) (define-key calendar-mode-map [menu-bar goto mayan nxt-rnd] '("Next Round" . calendar-next-calendar-round-date)) (define-key calendar-mode-map [menu-bar goto mayan prev-haab] '("Previous Haab" . calendar-previous-haab-date)) (define-key calendar-mode-map [menu-bar goto mayan next-haab] '("Next Haab" . calendar-next-haab-date)) (define-key calendar-mode-map [menu-bar goto mayan prev-tzol] '("Previous Tzolkin" . calendar-previous-tzolkin-date)) (define-key calendar-mode-map [menu-bar goto mayan next-tzol] '("Next Tzolkin" . calendar-next-tzolkin-date)) (define-key calendar-mode-map [menu-bar scroll] (cons "Scroll" (make-sparse-keymap "Scroll"))) (define-key calendar-mode-map [menu-bar scroll bk-12] '("Backward 1 Year" . "4\ev")) (define-key calendar-mode-map [menu-bar scroll bk-3] '("Backward 3 Months" . scroll-calendar-right-three-months)) (define-key calendar-mode-map [menu-bar scroll bk-1] '("Backward 1 Month" . scroll-calendar-right)) (define-key calendar-mode-map [menu-bar scroll fwd-12] '("Forward 1 Year" . "4\C-v")) (define-key calendar-mode-map [menu-bar scroll fwd-3] '("Forward 3 Months" . scroll-calendar-left-three-months)) (define-key calendar-mode-map [menu-bar scroll fwd-1] '("Forward 1 Month" . scroll-calendar-left)) (put 'calendar-forward-day 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-backward-day 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-forward-week 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-backward-week 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-forward-month 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-backward-month 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-forward-year 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-backward-year 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-beginning-of-year 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-end-of-year 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-beginning-of-month 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-end-of-month 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-end-of-week 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-beginning-of-week 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-mouse-print-dates 'menu-enable '(calendar-event-to-date)) (put 'calendar-sunrise-sunset 'menu-enable '(calendar-event-to-date)) (put 'calendar-cursor-holidays 'menu-enable '(calendar-cursor-to-date)) (put 'view-diary-entries 'menu-enable '(calendar-cursor-to-date)) (put 'view-other-diary-entries 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-mouse-insert-hebrew-diary-entry 'menu-enable '(calendar-cursor-to-date)) (put 'calendar-mouse-insert-islamic-diary-entry 'menu-enable '(calendar-cursor-to-date)) (put 'insert-cyclic-diary-entry 'menu-enable '(calendar-cursor-to-date)) (put 'insert-block-diary-entry 'menu-enable '(calendar-cursor-to-date)) (put 'insert-anniversary-diary-entry 'menu-enable '(calendar-cursor-to-date)) (put 'insert-yearly-diary-entry 'menu-enable '(calendar-cursor-to-date)) (put 'insert-monthly-diary-entry 'menu-enable '(calendar-cursor-to-date)) (put 'insert-weekly-diary-entry 'menu-enable '(calendar-cursor-to-date)) (put 'cal-tex-cursor-day 'menu-enable '(calendar-cursor-to-date)) (put 'cal-tex-cursor-week 'menu-enable '(calendar-cursor-to-date)) (put 'cal-tex-cursor-week2 'menu-enable '(calendar-cursor-to-date)) (put 'cal-tex-cursor-week3 'menu-enable '(calendar-cursor-to-date)) (put 'cal-tex-cursor-week4 'menu-enable '(calendar-cursor-to-date)) (put 'cal-tex-cursor-week5 'menu-enable '(calendar-cursor-to-date)) (put 'cal-tex-cursor-week6 'menu-enable '(calendar-cursor-to-date)) (put 'cal-tex-cursor-month 'menu-enable '(calendar-cursor-to-date)) (put 'cal-tex-cursor-month-landscape 'menu-enable '(calendar-cursor-to-date)) (put 'cal-tex-cursor-year 'menu-enable '(calendar-cursor-to-date)) (put 'cal-tex-cursor-filofax-year 'menu-enable '(calendar-cursor-to-date)) (put 'cal-tex-cursor-year-landscape 'menu-enable '(calendar-cursor-to-date)) (defun calendar-event-to-date (&optional error) "Date of last event. If event is not on a specific date, signals an error if optional parameter ERROR is t, otherwise just returns nil." (save-excursion (goto-char (posn-point (event-start last-input-event))) (calendar-cursor-to-date error))) (defun calendar-mouse-insert-hebrew-diary-entry (event) "Pop up menu to insert a Hebrew-date diary entry." (interactive "e") (let ((hebrew-selection (x-popup-menu event (list "Hebrew insert menu" (list (calendar-hebrew-date-string (calendar-cursor-to-date)) '("One time" . insert-hebrew-diary-entry) '("Monthly" . insert-monthly-hebrew-diary-entry) '("Yearly" . insert-yearly-hebrew-diary-entry)))))) (and hebrew-selection (call-interactively hebrew-selection)))) (defun calendar-mouse-insert-islamic-diary-entry (event) "Pop up menu to insert an Islamic-date diary entry." (interactive "e") (let ((islamic-selection (x-popup-menu event (list "Islamic insert menu" (list (calendar-islamic-date-string (calendar-cursor-to-date)) '("One time" . insert-islamic-diary-entry) '("Monthly" . insert-monthly-islamic-diary-entry) '("Yearly" . insert-yearly-islamic-diary-entry)))))) (and islamic-selection (call-interactively islamic-selection)))) (defun calendar-mouse-sunrise/sunset () "Show sunrise/sunset times for mouse-selected date." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (calendar-sunrise-sunset))) (defun calendar-mouse-holidays () "Show holidays for mouse-selected date." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (calendar-cursor-holidays))) (defun calendar-mouse-view-diary-entries () "View diary entries on mouse-selected date." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (view-diary-entries 1))) (defun calendar-mouse-view-other-diary-entries () "View diary entries from alternative file on mouse-selected date." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (call-interactively 'view-other-diary-entries))) (defun calendar-mouse-insert-diary-entry () "Insert diary entry for mouse-selected date." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (insert-diary-entry nil))) (defun calendar-mouse-set-mark () "Mark the date under the cursor." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (calendar-set-mark nil))) (defun cal-tex-mouse-day () "Make a buffer with LaTeX commands for the day mouse is on." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (cal-tex-cursor-day nil))) (defun cal-tex-mouse-week () "One page calendar for week indicated by cursor. Holidays are included if `cal-tex-holidays' is t." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (cal-tex-cursor-week nil))) (defun cal-tex-mouse-week2 () "Make a buffer with LaTeX commands for the week cursor is on. The printed output will be on two pages." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (cal-tex-cursor-week2 nil))) (defun cal-tex-mouse-week3 () "One page calendar for week indicated by cursor. Holidays are included if `cal-tex-holidays' is t." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (cal-tex-cursor-week3 nil))) (defun cal-tex-mouse-week4 () "One page calendar for week indicated by cursor." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (cal-tex-cursor-week4 nil))) (defun cal-tex-mouse-week5 () "One page Filofax calendar for week indicated by cursor." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (cal-tex-cursor-week5 nil))) (defun cal-tex-mouse-week6 () "Two page Filofax calendar for week indicated by cursor." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (cal-tex-cursor-week6 nil))) (defun cal-tex-mouse-month () "Make a buffer with LaTeX commands for the month cursor is on. Calendar is condensed onto one page." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (cal-tex-cursor-month nil))) (defun cal-tex-mouse-month-landscape () "Make a buffer with LaTeX commands for the month cursor is on. The output is in landscape format, one month to a page." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (cal-tex-cursor-month-landscape nil))) (defun cal-tex-mouse-year () "Make a buffer with LaTeX commands for the year cursor is on." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (cal-tex-cursor-year nil))) (defun cal-tex-mouse-filofax-year () "Make a buffer with LaTeX commands for Filofax calendar of year cursor is on." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (cal-tex-cursor-filofax-year nil))) (defun cal-tex-mouse-year-landscape () "Make a buffer with LaTeX commands for the year cursor is on." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (cal-tex-cursor-year-landscape nil))) (defun calendar-mouse-print-dates () "Pop up menu of equivalent dates to mouse selected date." (interactive) (let ((date (calendar-event-to-date)) (selection (x-popup-menu event (list "Date Menu" (append (list (concat (calendar-date-string date) " (Gregorian)") (list (calendar-day-of-year-string date)) (list (format "ISO date: %s" (calendar-iso-date-string date))) (list (format "Julian date: %s" (calendar-julian-date-string date))) (list (format "Astronomical (Julian) day number (after noon UTC): %s" (calendar-astro-date-string date))) (list (format "Hebrew date (before sunset): %s" (calendar-hebrew-date-string date)))) (let ((i (calendar-islamic-date-string date))) (if (not (string-equal i "")) (list (list (format "Islamic date (before sunset): %s" i))))) (list (list (format "Chinese date: %s" (calendar-chinese-date-string date)))) ; (list '("Chinese date (select to echo Chinese date)" ; . calendar-mouse-chinese-date)) (let ((c (calendar-coptic-date-string date))) (if (not (string-equal c "")) (list (list (format "Coptic date: %s" c))))) (let ((e (calendar-ethiopic-date-string date))) (if (not (string-equal e "")) (list (list (format "Ethiopic date: %s" e))))) (let ((f (calendar-french-date-string date))) (if (not (string-equal f "")) (list (list (format "French Revolutionary date: %s" f))))) (list (list (format "Mayan date: %s" (calendar-mayan-date-string date))))))))) (and selection (call-interactively selection)))) (defun calendar-mouse-chinese-date () "Show Chinese equivalent for mouse-selected date." (interactive) (save-excursion (calendar-goto-date (calendar-event-to-date)) (calendar-print-chinese-date))) (defun calendar-mouse-2-date-menu (event) "Pop up menu for Mouse-2 for selected date in the calendar window." (interactive "e") (let* ((date (calendar-event-to-date t)) (selection (x-popup-menu event (list "Menu" (list (calendar-date-string date t nil) '("Holidays" . calendar-mouse-holidays) '("Mark date" . calendar-mouse-set-mark) '("Sunrise/sunset" . calendar-mouse-sunrise/sunset) '("Other calendars" . calendar-mouse-print-dates) '("Prepare LaTeX buffer" . calendar-mouse-cal-tex-menu) '("Diary entries" . calendar-mouse-view-diary-entries) '("Insert diary entry" . calendar-mouse-insert-diary-entry) '("Other diary file entries" . calendar-mouse-view-other-diary-entries) ))))) (and selection (call-interactively selection)))) (defun calendar-mouse-cal-tex-menu (event) "Pop up submenu for Mouse-2 for cal-tex commands for selected date in the calendar window." (interactive "e") (let* ((selection (x-popup-menu event (list "Menu" (list (calendar-date-string date t nil) '("Daily (1 page)" . cal-tex-mouse-day) '("Weekly (1 page)" . cal-tex-mouse-week) '("Weekly (2 pages)" . cal-tex-mouse-week2) '("Weekly (other style; 1 page)" . cal-tex-mouse-week3) '("Weekly (yet another style; 1 page)" . cal-tex-mouse-week4) '("Monthly" . cal-tex-mouse-month) '("Monthly (landscape)" . cal-tex-mouse-month-landscape) '("Yearly" . cal-tex-mouse-year) '("Yearly (landscape)" . cal-tex-mouse-year-landscape) '("Filofax styles" . cal-tex-mouse-filofax) ))))) (and selection (call-interactively selection)))) (defun cal-tex-mouse-filofax (event) "Pop up sub-submenu for Mouse-2 for Filofax cal-tex commands for selected date." (interactive "e") (let* ((selection (x-popup-menu event (list "Menu" (list (calendar-date-string date t nil) '("Filofax Weekly (1 page)" . cal-tex-mouse-week5) '("Filofax Weekly (2 pages)" . cal-tex-mouse-week6) '("Filofax Yearly" . cal-tex-mouse-filofax-year) ))))) (and selection (call-interactively selection)))) (define-key calendar-mouse-3-map [exit-calendar] '("Exit calendar" . exit-calendar)) (define-key calendar-mouse-3-map [show-diary] '("Show diary" . show-all-diary-entries)) (define-key calendar-mouse-3-map [lunar-phases] '("Lunar phases" . calendar-phases-of-moon)) (define-key calendar-mouse-3-map [unmark] '("Unmark" . calendar-unmark)) (define-key calendar-mouse-3-map [mark-holidays] '("Mark holidays" . mark-calendar-holidays)) (define-key calendar-mouse-3-map [list-holidays] '("List holidays" . list-calendar-holidays)) (define-key calendar-mouse-3-map [mark-diary-entries] '("Mark diary entries" . mark-diary-entries)) (define-key calendar-mouse-3-map [scroll-backward] '("Scroll backward" . scroll-calendar-right-three-months)) (define-key calendar-mouse-3-map [scroll-forward] '("Scroll forward" . scroll-calendar-left-three-months)) (run-hooks 'cal-menu-load-hook) (provide 'cal-menu) ;;; cal-menu.el ends here emacs-19.30/lisp/cal-move.el100444 22346 1 27272 6030154006 15135 0ustar reingolddaemon;;; cal-move.el --- calendar functions for movement in the calendar ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: calendar ;; 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 collection of functions implements movement in the calendar for ;; calendar.el. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (defun calendar-goto-today () "Reposition the calendar window so the current date is visible." (interactive) (let ((today (calendar-current-date)));; The date might have changed. (if (not (calendar-date-is-visible-p today)) (generate-calendar-window) (update-calendar-mode-line) (calendar-cursor-to-visible-date today)))) (defun calendar-forward-month (arg) "Move the cursor forward ARG months. Movement is backward if ARG is negative." (interactive "p") (calendar-cursor-to-nearest-date) (let* ((cursor-date (calendar-cursor-to-date t)) (month (extract-calendar-month cursor-date)) (day (extract-calendar-day cursor-date)) (year (extract-calendar-year cursor-date))) (increment-calendar-month month year arg) (let ((last (calendar-last-day-of-month month year))) (if (< last day) (setq day last))) ;; Put the new month on the screen, if needed, and go to the new date. (let ((new-cursor-date (list month day year))) (if (not (calendar-date-is-visible-p new-cursor-date)) (calendar-other-month month year)) (calendar-cursor-to-visible-date new-cursor-date)))) (defun calendar-forward-year (arg) "Move the cursor forward by ARG years. Movement is backward if ARG is negative." (interactive "p") (calendar-forward-month (* 12 arg))) (defun calendar-backward-month (arg) "Move the cursor backward by ARG months. Movement is forward if ARG is negative." (interactive "p") (calendar-forward-month (- arg))) (defun calendar-backward-year (arg) "Move the cursor backward ARG years. Movement is forward is ARG is negative." (interactive "p") (calendar-forward-month (* -12 arg))) (defun scroll-calendar-left (arg) "Scroll the displayed calendar left by ARG months. If ARG is negative the calendar is scrolled right. Maintains the relative position of the cursor with respect to the calendar as well as possible." (interactive "p") (calendar-cursor-to-nearest-date) (let ((old-date (calendar-cursor-to-date)) (today (calendar-current-date))) (if (/= arg 0) (progn (increment-calendar-month displayed-month displayed-year arg) (generate-calendar-window displayed-month displayed-year) (calendar-cursor-to-visible-date (cond ((calendar-date-is-visible-p old-date) old-date) ((calendar-date-is-visible-p today) today) (t (list displayed-month 1 displayed-year)))))))) (defun scroll-calendar-right (arg) "Scroll the displayed calendar window right by ARG months. If ARG is negative the calendar is scrolled left. Maintains the relative position of the cursor with respect to the calendar as well as possible." (interactive "p") (scroll-calendar-left (- arg))) (defun scroll-calendar-left-three-months (arg) "Scroll the displayed calendar window left by 3*ARG months. If ARG is negative the calendar is scrolled right. Maintains the relative position of the cursor with respect to the calendar as well as possible." (interactive "p") (scroll-calendar-left (* 3 arg))) (defun scroll-calendar-right-three-months (arg) "Scroll the displayed calendar window right by 3*ARG months. If ARG is negative the calendar is scrolled left. Maintains the relative position of the cursor with respect to the calendar as well as possible." (interactive "p") (scroll-calendar-left (* -3 arg))) (defun calendar-cursor-to-nearest-date () "Move the cursor to the closest date. The position of the cursor is unchanged if it is already on a date. Returns the list (month day year) giving the cursor position." (let ((date (calendar-cursor-to-date)) (column (current-column))) (if date date (if (> 3 (count-lines (point-min) (point))) (progn (goto-line 3) (move-to-column column))) (if (not (looking-at "[0-9]")) (if (and (not (looking-at " *$")) (or (< column 25) (and (> column 27) (< column 50)) (and (> column 52) (< column 75)))) (progn (re-search-forward "[0-9]" nil t) (backward-char 1)) (re-search-backward "[0-9]" nil t))) (calendar-cursor-to-date)))) (defun calendar-forward-day (arg) "Move the cursor forward ARG days. Moves backward if ARG is negative." (interactive "p") (if (/= 0 arg) (let* ((cursor-date (calendar-cursor-to-date)) (cursor-date (if cursor-date cursor-date (if (> arg 0) (setq arg (1- arg))) (calendar-cursor-to-nearest-date))) (new-cursor-date (calendar-gregorian-from-absolute (+ (calendar-absolute-from-gregorian cursor-date) arg))) (new-display-month (extract-calendar-month new-cursor-date)) (new-display-year (extract-calendar-year new-cursor-date))) ;; Put the new month on the screen, if needed, and go to the new date. (if (not (calendar-date-is-visible-p new-cursor-date)) (calendar-other-month new-display-month new-display-year)) (calendar-cursor-to-visible-date new-cursor-date)))) (defun calendar-backward-day (arg) "Move the cursor back ARG days. Moves forward if ARG is negative." (interactive "p") (calendar-forward-day (- arg))) (defun calendar-forward-week (arg) "Move the cursor forward ARG weeks. Moves backward if ARG is negative." (interactive "p") (calendar-forward-day (* arg 7))) (defun calendar-backward-week (arg) "Move the cursor back ARG weeks. Moves forward if ARG is negative." (interactive "p") (calendar-forward-day (* arg -7))) (defun calendar-beginning-of-week (arg) "Move the cursor back ARG calendar-week-start-day's." (interactive "p") (calendar-cursor-to-nearest-date) (let ((day (calendar-day-of-week (calendar-cursor-to-date)))) (calendar-backward-day (if (= day calendar-week-start-day) (* 7 arg) (+ (mod (- day calendar-week-start-day) 7) (* 7 (1- arg))))))) (defun calendar-end-of-week (arg) "Move the cursor forward ARG calendar-week-start-day+6's." (interactive "p") (calendar-cursor-to-nearest-date) (let ((day (calendar-day-of-week (calendar-cursor-to-date)))) (calendar-forward-day (if (= day (mod (1- calendar-week-start-day) 7)) (* 7 arg) (+ (- 6 (mod (- day calendar-week-start-day) 7)) (* 7 (1- arg))))))) (defun calendar-beginning-of-month (arg) "Move the cursor backward ARG month beginnings." (interactive "p") (calendar-cursor-to-nearest-date) (let* ((date (calendar-cursor-to-date)) (month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date))) (if (= day 1) (calendar-backward-month arg) (calendar-cursor-to-visible-date (list month 1 year)) (calendar-backward-month (1- arg))))) (defun calendar-end-of-month (arg) "Move the cursor forward ARG month ends." (interactive "p") (calendar-cursor-to-nearest-date) (let* ((date (calendar-cursor-to-date)) (month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date)) (last-day (calendar-last-day-of-month month year))) (if (/= day last-day) (progn (calendar-cursor-to-visible-date (list month last-day year)) (setq arg (1- arg)))) (increment-calendar-month month year arg) (let ((last-day (list month (calendar-last-day-of-month month year) year))) (if (not (calendar-date-is-visible-p last-day)) (calendar-other-month month year) (calendar-cursor-to-visible-date last-day))))) (defun calendar-beginning-of-year (arg) "Move the cursor backward ARG year beginnings." (interactive "p") (calendar-cursor-to-nearest-date) (let* ((date (calendar-cursor-to-date)) (month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date)) (jan-first (list 1 1 year))) (if (and (= day 1) (= 1 month)) (calendar-backward-month (* 12 arg)) (if (and (= arg 1) (calendar-date-is-visible-p jan-first)) (calendar-cursor-to-visible-date jan-first) (calendar-other-month 1 (- year (1- arg))))))) (defun calendar-end-of-year (arg) "Move the cursor forward ARG year beginnings." (interactive "p") (calendar-cursor-to-nearest-date) (let* ((date (calendar-cursor-to-date)) (month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date)) (dec-31 (list 12 31 year))) (if (and (= day 31) (= 12 month)) (calendar-forward-month (* 12 arg)) (if (and (= arg 1) (calendar-date-is-visible-p dec-31)) (calendar-cursor-to-visible-date dec-31) (calendar-other-month 12 (- year (1- arg))) (calendar-cursor-to-visible-date (list 12 31 displayed-year)))))) (defun calendar-cursor-to-visible-date (date) "Move the cursor to DATE that is on the screen." (let* ((month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date)) (first-of-month-weekday (calendar-day-of-week (list month 1 year)))) (goto-line (+ 3 (/ (+ day -1 (mod (- (calendar-day-of-week (list month 1 year)) calendar-week-start-day) 7)) 7))) (move-to-column (+ 6 (* 25 (1+ (calendar-interval displayed-month displayed-year month year))) (* 3 (mod (- (calendar-day-of-week date) calendar-week-start-day) 7)))))) (defun calendar-goto-date (date) "Move cursor to DATE." (interactive (list (calendar-read-date))) (let ((month (extract-calendar-month date)) (year (extract-calendar-year date))) (if (not (calendar-date-is-visible-p date)) (calendar-other-month (if (and (= month 1) (= year 1)) 2 month) year))) (calendar-cursor-to-visible-date date)) (provide 'cal-move) ;;; cal-move.el ends here emacs-19.30/lisp/cal-tex.el100444 12120 1 166217 6055525507 14014 0ustar rmsdaemon;;; cal-tex.el --- calendar functions for printing calendars with LaTeX. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Steve Fisk ;; Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: Calendar, LaTeX ;; 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 collection of functions implements the creation of LaTeX calendars ;; based on the user's holiday choices and diary file. ;;; TO DO ;;; ;;; (*) Add holidays and diary entries to daily calendar. ;;; ;;; (*) Add diary entries to weekly calendar functions. ;;; ;;; (*) Make calendar styles for A4 paper. ;;; ;;; (*) Make daily and monthly styles Filofax paper. ;;; ;;; (*) Improve the LaTeX command that produces the boxes in the monthly ;;; calendar to eliminate slight gap--what causes it?! ;;; Code: (require 'calendar) (autoload 'list-diary-entries "diary-lib" nil t) (autoload 'calendar-holiday-list "holidays" nil t) (autoload 'calendar-iso-from-absolute "cal-iso" nil t) ;;; ;;; Customizable variables ;;; (defvar cal-tex-which-days '(0 1 2 3 4 5 6) "*The days of the week that are displayed on the portrait monthly calendar. Sunday is 0, Monday is 1, and so on. The default is to print from Sunday to Saturday. For example, use (setq cal-tex-which-days '(1 3 5)) to only print Monday, Wednesday, Friday.") (defvar cal-tex-holidays t "*If t (default), then the holidays are also printed. If finding the holidays is too slow, set this to nil.") (defvar cal-tex-diary nil "*If t, the diary entries are printed in the calendar.") (defvar cal-tex-daily-string '(let* ((year (extract-calendar-year date)) (day (calendar-day-number date)) (days-remaining (- (calendar-day-number (list 12 31 year)) day))) (format "%d/%d" day days-remaining)) "*An expression in the variable `date' whose value is placed on date. The string resulting from evaluating this expression is placed at the bottom center of `date' on the monthly calendar, next to the date in the weekly calendars, and in the top center of daily calendars. Default is ordinal day number of the year and the number of days remaining. As an example of what you do, setting this to '(progn (require 'cal-hebrew) (calendar-hebrew-date-string date)) will put the Hebrew date at the bottom of each day.") (defvar cal-tex-buffer "calendar.tex" "*The name for the tex-ed calendar.") (defvar cal-tex-24 nil "*If t, use a 24 hour clock in the daily calendar.") (defvar cal-tex-daily-start 8 "*The first hour of the daily calendar page.") (defvar cal-tex-daily-end 20 "*The last hour of the daily calendar page.") ;;; ;;; Definitions for LaTeX code ;;; (defvar cal-tex-day-prefix "\\caldate{%s}{%s}" "The initial LaTeX code for a day. The holidays, diary entries, bottom string, and the text follow.") (defvar cal-tex-day-name-format "\\myday{%s}%%" "The format for LaTeX code for a day name. The names are taken from calendar-day-name-array.") (defvar cal-tex-cal-one-month "\\def\\calmonth#1#2% {\\begin{center}% \\Huge\\bf\\uppercase{#1} #2 \\\\[1cm]% \\end{center}}% \\vspace*{-1.5cm}% % " "LaTeX code for the month header") (defvar cal-tex-cal-multi-month "\\def\\calmonth#1#2#3#4% {\\begin{center}% \\Huge\\bf #1 #2---#3 #4\\\\[1cm]% \\end{center}}% \\vspace*{-1.5cm}% % " "LaTeX code for the month header") (defvar cal-tex-myday "\\renewcommand{\\myday}[1]% {\\makebox[\\cellwidth]{\\hfill\\large\\bf#1\\hfill}} % " "LaTeX code for a day heading") (defvar cal-tex-caldate "\\fboxsep=0pt \\long\\def\\caldate#1#2#3#4#5#6{% \\fbox{\\hbox to\\cellwidth{% \\vbox to\\cellheight{% \\hbox to\\cellwidth{% {\\hspace*{1mm}\\Large \\bf \\strut #2}\\hspace{.05\\cellwidth}% \\raisebox{\\holidaymult\\cellheight}% {\\parbox[t]{.75\\cellwidth}{\\tiny \\raggedright #4}}} \\hbox to\\cellwidth{% \\hspace*{1mm}\\parbox{.95\\cellwidth}{\\tiny \\raggedright #3}} \\hspace*{1mm}% \\hbox to\\cellwidth{#6}% \\vfill% \\hbox to\\cellwidth{\\hfill \\tiny #5 \\hfill}% \\vskip 1.4pt}% \\hskip -0.4pt}}} " "LaTeX code to insert one box with date info in calendar. This definition is the heart of the calendar!") (defun cal-tex-list-holidays (d1 d2) "Generate a list of all holidays from absolute date D1 to D2." (let* ((result nil) (start (calendar-gregorian-from-absolute d1)) (start-month (extract-calendar-month start)) (start-year (extract-calendar-year start))) (increment-calendar-month start-month start-year 1) (let* ((end (calendar-gregorian-from-absolute d2)) (end-month (extract-calendar-month end)) (end-year (extract-calendar-year end))) (if (= (extract-calendar-day end) 1) (increment-calendar-month end-month end-year -1)) (let* ((s (calendar-absolute-from-gregorian (list start-month 1 start-year))) (e (calendar-absolute-from-gregorian (list end-month 1 end-year))) (d s) (never t) (displayed-month start-month) (displayed-year start-year)) (while (or never (<= d e)) (setq result (append result (calendar-holiday-list))) (setq never nil) (increment-calendar-month displayed-month displayed-year 3) (setq d (calendar-absolute-from-gregorian (list displayed-month 1 displayed-year)))))) (let ((in-range) (p result)) (while p (and (car (car p)) (let ((a (calendar-absolute-from-gregorian (car (car p))))) (and (<= d1 a) (<= a d2))) (setq in-range (append (list (car p)) in-range))) (setq p (cdr p))) in-range))) (defun cal-tex-list-diary-entries (d1 d2) "Generate a list of all diary-entries from absolute date D1 to D2." (let ((diary-display-hook nil)) (list-diary-entries (calendar-gregorian-from-absolute d1) (1+ (- d2 d1))))) (defun cal-tex-preamble (&optional args) "Insert the LaTeX preamble. Preamble Includes initial definitions for various LaTeX commands. Optional ARGS are included." (set-buffer (get-buffer-create cal-tex-buffer)) (erase-buffer) (insert "\\documentstyle") (if args (insert "[" args "]")) (insert "{article}\n" "\\hbadness 20000 \\vbadness 20000 \\marginparwidth 0pt \\oddsidemargin -2cm \\evensidemargin -2cm \\marginparsep 0pt \\topmargin 0pt \\textwidth 7.5in \\textheight 9.5in \\newlength{\\cellwidth} \\newlength{\\cellheight} \\newlength{\\boxwidth} \\newlength{\\boxheight} \\newlength{\\cellsize} \\newcommand{\\myday}[1]{} \\newcommand{\\caldate}[6]{} \\newcommand{\\nocaldate}[6]{} \\newcommand{\\calsmall}[6]{} % ")) ;;; ;;; Yearly calendars ;;; (defun cal-tex-cursor-year (&optional arg) "Make a buffer with LaTeX commands for the year cursor is on. Optional prefix argument specifies number of years." (interactive "P") (cal-tex-year (extract-calendar-year (calendar-cursor-to-date t)) (if arg arg 1))) (defun cal-tex-cursor-year-landscape (&optional arg) "Make a buffer with LaTeX commands for the year cursor is on. Optional prefix argument specifies number of years." (interactive "P") (cal-tex-year (extract-calendar-year (calendar-cursor-to-date t)) (if arg arg 1) t)) (defun cal-tex-year (year n &optional landscape) "Make a one page yearly calendar of YEAR; do this for N years. There are four rows of three months each, unless optional LANDSCAPE is t, in which case the calendar isprinted in landscape mode with three rows of four months each." (cal-tex-insert-preamble 1 landscape "12pt") (if landscape (cal-tex-vspace "-.6cm") (cal-tex-vspace "-3.1cm")) (calendar-for-loop j from 1 to n do (insert "\\vfill%\n") (cal-tex-b-center) (cal-tex-Huge (number-to-string year)) (cal-tex-e-center) (cal-tex-vspace "1cm") (cal-tex-b-center) (cal-tex-b-parbox "l" (if landscape "5.9in" "4.3in")) (insert "\n") (cal-tex-noindent) (cal-tex-nl) (calendar-for-loop i from 1 to 12 do (insert (cal-tex-mini-calendar i year "month" "1.1in" "1in")) (insert "\\month") (cal-tex-hspace "0.5in") (if (zerop (mod i (if landscape 4 3))) (cal-tex-nl "0.5in"))) (cal-tex-e-parbox) (cal-tex-e-center) (insert "\\vfill%\n") (setq year (1+ year)) (if (/= j n) (cal-tex-newpage) (cal-tex-end-document)) (run-hooks 'cal-tex-year-hook)) (run-hooks 'cal-tex-hook)) (defun cal-tex-cursor-filofax-year (&optional arg) "Make a Filofax one page yearly calendar of year indicated by cursor. Optional parameter specifies number of years." (interactive "P") (let* ((n (if arg arg 1)) (year (extract-calendar-year (calendar-cursor-to-date t)))) (cal-tex-preamble "twoside") (cal-tex-cmd "\\textwidth 3.25in") (cal-tex-cmd "\\textheight 6.5in") (cal-tex-cmd "\\oddsidemargin 1.6in") (cal-tex-cmd "\\evensidemargin 1.55in") (cal-tex-cmd "\\topmargin 0pt") (cal-tex-cmd "\\headheight -0.875in") (cal-tex-cmd "\\pagestyle{empty}") (cal-tex-b-document) (calendar-for-loop j from 1 to n do (insert (format "\\hfil {\\Large \\bf %s} \\hfil\\\\\n" year)) (cal-tex-b-center) (cal-tex-b-parbox "l" "\\textwidth") (insert "\n") (cal-tex-noindent) (cal-tex-nl) (calendar-for-loop i from 1 to 12 do (insert (cal-tex-mini-calendar i year (calendar-month-name i) "1.05in" ".8in" "tiny"))) (insert "\\noindent\\fbox{\\January}\\fbox{\\February}\\fbox{\\March}\\\\ \\noindent\\fbox{\\April}\\fbox{\\May}\\fbox{\\June}\\\\ \\noindent\\fbox{\\July}\\fbox{\\August}\\fbox{\\September}\\\\ \\noindent\\fbox{\\October}\\fbox{\\November}\\fbox{\\December} ") (cal-tex-e-parbox) (cal-tex-e-center) (setq year (1+ year)) (if (/= j n) (cal-tex-newpage) (cal-tex-end-document)) (run-hooks 'cal-tex-year-hook)) (run-hooks 'cal-tex-hook))) ;;; ;;; Monthly calendars ;;; (defun cal-tex-cursor-month-landscape (&optional arg) "Make a buffer with LaTeX commands for the month cursor is on. Optional prefix argument specifies number of months to be produced. The output is in landscape format, one month to a page." (interactive "P") (let* ((n (if arg arg 1)) (date (calendar-cursor-to-date t)) (month (extract-calendar-month date)) (year (extract-calendar-year date)) (end-month month) (end-year year) (cal-tex-which-days '(0 1 2 3 4 5 6))) (increment-calendar-month end-month end-year (1- n)) (let ((diary-list (if cal-tex-diary (cal-tex-list-diary-entries (calendar-absolute-from-gregorian (list month 1 year)) (calendar-absolute-from-gregorian (list end-month (calendar-last-day-of-month end-month end-year) end-year))))) (holidays (if cal-tex-holidays (cal-tex-list-holidays (calendar-absolute-from-gregorian (list month 1 year)) (calendar-absolute-from-gregorian (list end-month (calendar-last-day-of-month end-month end-year) end-year))))) (other-month) (other-year) (small-months-at-start)) (cal-tex-insert-preamble (cal-tex-number-weeks month year 1) t "12pt") (cal-tex-cmd cal-tex-cal-one-month) (calendar-for-loop i from 1 to n do (setq other-month month) (setq other-year year) (increment-calendar-month other-month other-year -1) (insert (cal-tex-mini-calendar other-month other-year "lastmonth" "\\cellwidth" "\\cellheight")) (increment-calendar-month other-month other-year 2) (insert (cal-tex-mini-calendar other-month other-year "nextmonth" "\\cellwidth" "\\cellheight")) (cal-tex-insert-month-header 1 month year month year) (cal-tex-insert-day-names) (cal-tex-nl ".2cm") (setq small-months-at-start (< 1 (mod (- (calendar-day-of-week (list month 1 year)) calendar-week-start-day) 7))) (if small-months-at-start (insert "\\lastmonth\\nextmonth\\hspace*{-2\\cellwidth}")) (cal-tex-insert-blank-days month year cal-tex-day-prefix) (cal-tex-insert-days month year diary-list holidays cal-tex-day-prefix) (cal-tex-insert-blank-days-at-end month year cal-tex-day-prefix) (if (and (not small-months-at-start) (< 1 (mod (- (1- calendar-week-start-day) (calendar-day-of-week (list month (calendar-last-day-of-month month year) year))) 7))) (insert "\\vspace*{-\\cellwidth}\\hspace*{-2\\cellwidth}" "\\lastmonth\\nextmonth")) (if (/= i n) (progn (run-hooks 'cal-tex-month-hook) (cal-tex-newpage) (increment-calendar-month month year 1) (cal-tex-vspace "-2cm") (cal-tex-insert-preamble (cal-tex-number-weeks month year 1) t "12pt" t)))) (cal-tex-end-document) (run-hooks 'cal-tex-hook)))) (defun cal-tex-cursor-month (arg) "Make a buffer with LaTeX commands for the month cursor is on. Optional prefix argument specifies number of months to be produced. Calendar is condensed onto one page." (interactive "P") (let* ((date (calendar-cursor-to-date t)) (month (extract-calendar-month date)) (year (extract-calendar-year date)) (end-month month) (end-year year) (n (if arg arg 1))) (increment-calendar-month end-month end-year (1- n)) (let ((diary-list (if cal-tex-diary (cal-tex-list-diary-entries (calendar-absolute-from-gregorian (list month 1 year)) (calendar-absolute-from-gregorian (list end-month (calendar-last-day-of-month end-month end-year) end-year))))) (holidays (if cal-tex-holidays (cal-tex-list-holidays (calendar-absolute-from-gregorian (list month 1 year)) (calendar-absolute-from-gregorian (list end-month (calendar-last-day-of-month end-month end-year) end-year))))) (other-month) (other-year)) (cal-tex-insert-preamble (cal-tex-number-weeks month year n) nil"12pt") (if (> n 1) (cal-tex-cmd cal-tex-cal-multi-month) (cal-tex-cmd cal-tex-cal-one-month)) (cal-tex-insert-month-header n month year end-month end-year) (cal-tex-insert-day-names) (cal-tex-nl ".2cm") (cal-tex-insert-blank-days month year cal-tex-day-prefix) (calendar-for-loop i from 1 to n do (setq other-month month) (setq other-year year) (cal-tex-insert-days month year diary-list holidays cal-tex-day-prefix) (increment-calendar-month month year 1)) (cal-tex-insert-blank-days-at-end end-month end-year cal-tex-day-prefix) (cal-tex-end-document))) (run-hooks 'cal-tex-hook)) (defun cal-tex-insert-days (month year diary-list holidays day-format) "Insert LaTeX commands for a range of days in monthly calendars. LaTeX commands are inserted for the days of the MONTH in YEAR. Diary entries on DIARY-LIST are included. Holidays on HOLIDAYS are included. Each day is formatted using format DAY-FORMAT." (let* ((blank-days;; at start of month (mod (- (calendar-day-of-week (list month 1 year)) calendar-week-start-day) 7)) (date) (last (calendar-last-day-of-month month year))) (calendar-for-loop i from 1 to last do (setq date (list month i year)) (if (memq (calendar-day-of-week date) cal-tex-which-days) (progn (insert (format day-format (calendar-month-name month) i)) (cal-tex-arg (cal-tex-latexify-list diary-list date)) (cal-tex-arg (cal-tex-latexify-list holidays date)) (cal-tex-arg (eval cal-tex-daily-string)) (cal-tex-arg) (cal-tex-comment))) (if (and (zerop (mod (+ i blank-days) 7)) (/= i last)) (progn (cal-tex-hfill) (cal-tex-nl)))))) (defun cal-tex-insert-day-names () "Insert the names of the days at top of a monthly calendar." (calendar-for-loop i from 0 to 6 do (if (memq i cal-tex-which-days) (insert (format cal-tex-day-name-format (aref calendar-day-name-array (mod (+ calendar-week-start-day i) 7))))) (cal-tex-comment))) (defun cal-tex-insert-month-header (n month year end-month end-year) "Create a title for a calendar. A title is inserted for a calendar with N months starting with MONTH YEAR and ending with END-MONTH END-YEAR." (let ( (month-name (calendar-month-name month)) (end-month-name (calendar-month-name end-month))) (if (= 1 n) (insert (format "\\calmonth{%s}{%s}\n\\vspace*{-0.5cm}" month-name year) ) (insert (format "\\calmonth{%s}{%s}{%s}{%s}\n\\vspace*{-0.5cm}" month-name year end-month-name end-year)))) (cal-tex-comment)) (defun cal-tex-insert-blank-days (month year day-format) "Insert code for initial days not in calendar. Insert LaTeX code for the blank days at the beginning of the MONTH in YEAR. The entry is formatted using DAY-FORMAT. If the entire week is blank, no days are inserted." (if (cal-tex-first-blank-p month year) (let* ((blank-days;; at start of month (mod (- (calendar-day-of-week (list month 1 year)) calendar-week-start-day) 7))) (calendar-for-loop i from 0 to (1- blank-days) do (if (memq i cal-tex-which-days) (insert (format day-format " " " ") "{}{}{}{}%\n")))))) (defun cal-tex-insert-blank-days-at-end (month year day-format) "Insert code for final days not in calendar. Insert LaTeX code for the blank days at the end of the MONTH in YEAR. The entry is formatted using DAY-FORMAT." (if (cal-tex-last-blank-p month year) (let* ((last-day (calendar-last-day-of-month month year)) (blank-days;; at end of month (mod (- (calendar-day-of-week (list month last-day year)) calendar-week-start-day) 7))) (calendar-for-loop i from (1+ blank-days) to 6 do (if (memq i cal-tex-which-days) (insert (format day-format "" "") "{}{}{}{}%\n")))))) (defun cal-tex-first-blank-p (month year) "Determine if any days of the first week will be printed. Return t if there will there be any days of the first week printed in the calendar starting in MONTH YEAR." (let ((any-days nil) (the-saturday)) ;the day of week of 1st Saturday (calendar-for-loop i from 1 to 7 do (if (= 6 (calendar-day-of-week (list month i year))) (setq the-saturday i))) (calendar-for-loop i from 1 to the-saturday do (if (memq (calendar-day-of-week (list month i year)) cal-tex-which-days) (setq any-days t))) any-days)) (defun cal-tex-last-blank-p (month year) "Determine if any days of the last week will be printed. Return t if there will there be any days of the last week printed in the calendar starting in MONTH YEAR." (let ((any-days nil) (last-day (calendar-last-day-of-month month year)) (the-sunday)) ;the day of week of last Sunday (calendar-for-loop i from (- last-day 6) to last-day do (if (= 0 (calendar-day-of-week (list month i year))) (setq the-sunday i))) (calendar-for-loop i from the-sunday to last-day do (if (memq (calendar-day-of-week (list month i year)) cal-tex-which-days) (setq any-days t))) any-days)) (defun cal-tex-number-weeks (month year n) "Determine the number of weeks in a range of dates. Compute the number of weeks in the calendar starting with MONTH and YEAR, and lasting N months, including only the days in WHICH-DAYS. As it stands, this is only an upper bound." (let ((d (list month 1 year))) (increment-calendar-month month year (1- n)) (/ (- (calendar-dayname-on-or-before calendar-week-start-day (+ 7 (calendar-absolute-from-gregorian (list month (calendar-last-day-of-month month year) year)))) (calendar-dayname-on-or-before calendar-week-start-day (calendar-absolute-from-gregorian d))) 7))) ;;; ;;; Weekly calendars ;;; (defun cal-tex-cursor-week (&optional arg) "Make a buffer with LaTeX commands for a two-page one-week calendar. It applies to the week that point is in. Optional prefix argument specifies number of weeks. Holidays are included if `cal-tex-holidays' is t." (interactive "P") (let* ((n (if arg arg 1)) (date (calendar-gregorian-from-absolute (calendar-dayname-on-or-before calendar-week-start-day (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) (month (extract-calendar-month date)) (year (extract-calendar-year date)) (holidays (if cal-tex-holidays (cal-tex-list-holidays (calendar-absolute-from-gregorian date) (+ (* 7 n) (calendar-absolute-from-gregorian date)))))) (cal-tex-preamble "11pt") (cal-tex-cmd "\\textwidth 6.5in") (cal-tex-cmd "\\textheight 10.5in") (cal-tex-cmd "\\oddsidemargin 0in") (cal-tex-cmd "\\evensidemargin 0in") (insert cal-tex-LaTeX-hourbox) (cal-tex-b-document) (cal-tex-cmd "\\pagestyle{empty}") (calendar-for-loop i from 1 to n do (cal-tex-vspace "-1.5in") (cal-tex-b-center) (cal-tex-Huge-bf (format "\\uppercase{%s}" (calendar-month-name month))) (cal-tex-hspace "2em") (cal-tex-Huge-bf (number-to-string year)) (cal-tex-nl ".5cm") (cal-tex-e-center) (cal-tex-hspace "-.2in") (cal-tex-b-parbox "l" "7in") (calendar-for-loop j from 1 to 7 do (cal-tex-week-hours date holidays "3.1") (setq date (cal-tex-incr-date date))) (cal-tex-e-parbox) (setq month (extract-calendar-month date)) (setq year (extract-calendar-year date)) (if (/= i n) (progn (run-hooks 'cal-tex-week-hook) (cal-tex-newpage)))) (cal-tex-end-document) (run-hooks 'cal-tex-hook))) (defun cal-tex-cursor-week2 (&optional arg) "Make a buffer with LaTeX commands for a two-page one-week calendar. It applies to the week that point is in. Optional prefix argument specifies number of weeks. Holidays are included if `cal-tex-holidays' is t." (interactive "P") (let* ((n (if arg arg 1)) (date (calendar-gregorian-from-absolute (calendar-dayname-on-or-before calendar-week-start-day (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) (month (extract-calendar-month date)) (year (extract-calendar-year date)) (d date) (holidays (if cal-tex-holidays (cal-tex-list-holidays (calendar-absolute-from-gregorian date) (+ (* 7 n) (calendar-absolute-from-gregorian date)))))) (cal-tex-preamble "12pt") (cal-tex-cmd "\\textwidth 6.5in") (cal-tex-cmd "\\textheight 10.5in") (cal-tex-cmd "\\oddsidemargin 0in") (cal-tex-cmd "\\evensidemargin 0in") (insert cal-tex-LaTeX-hourbox) (cal-tex-b-document) (cal-tex-cmd "\\pagestyle{empty}") (calendar-for-loop i from 1 to n do (cal-tex-vspace "-1.5in") (cal-tex-b-center) (cal-tex-Huge-bf (format "\\uppercase{%s}" (calendar-month-name month))) (cal-tex-hspace "2em") (cal-tex-Huge-bf (number-to-string year)) (cal-tex-nl ".5cm") (cal-tex-e-center) (cal-tex-hspace "-.2in") (cal-tex-b-parbox "l" "\\textwidth") (calendar-for-loop j from 1 to 3 do (cal-tex-week-hours date holidays "5") (setq date (cal-tex-incr-date date))) (cal-tex-e-parbox) (cal-tex-nl) (insert (cal-tex-mini-calendar (extract-calendar-month (cal-tex-previous-month date)) (extract-calendar-year (cal-tex-previous-month date)) "lastmonth" "1.1in" "1in")) (insert (cal-tex-mini-calendar (extract-calendar-month date) (extract-calendar-year date) "thismonth" "1.1in" "1in")) (insert (cal-tex-mini-calendar (extract-calendar-month (cal-tex-next-month date)) (extract-calendar-year (cal-tex-next-month date)) "nextmonth" "1.1in" "1in")) (insert "\\hbox to \\textwidth{") (cal-tex-hfill) (insert "\\lastmonth") (cal-tex-hfill) (insert "\\thismonth") (cal-tex-hfill) (insert "\\nextmonth") (cal-tex-hfill) (insert "}") (cal-tex-nl) (cal-tex-b-parbox "l" "\\textwidth") (calendar-for-loop j from 4 to 7 do (cal-tex-week-hours date holidays "5") (setq date (cal-tex-incr-date date))) (cal-tex-e-parbox) (setq month (extract-calendar-month date)) (setq year (extract-calendar-year date)) (if (/= i n) (progn (run-hooks 'cal-tex-week-hook) (cal-tex-newpage)))) (cal-tex-end-document) (run-hooks 'cal-tex-hook))) (defun cal-tex-cursor-week-iso (&optional arg) "Make a buffer with LaTeX commands for a one page ISO-style weekly calendar. Optional prefix argument specifies number of weeks. Diary entries are included if `cal-tex-diary' is t. Holidays are included if `cal-tex-holidays' is t." (interactive "P") (let* ((n (if arg arg 1)) (date (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 1 (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) (month (extract-calendar-month date)) (year (extract-calendar-year date)) (day (extract-calendar-day date)) (holidays (if cal-tex-holidays (cal-tex-list-holidays (calendar-absolute-from-gregorian date) (+ (* 7 n) (calendar-absolute-from-gregorian date))))) (diary-list (if cal-tex-diary (cal-tex-list-diary-entries (calendar-absolute-from-gregorian (list month 1 year)) (+ (* 7 n) (calendar-absolute-from-gregorian date)))))) (cal-tex-preamble "11pt") (cal-tex-cmd "\\textwidth 6.5in") (cal-tex-cmd "\\textheight 10.5in") (cal-tex-cmd "\\oddsidemargin 0in") (cal-tex-cmd "\\evensidemargin 0in") (cal-tex-b-document) (cal-tex-cmd "\\pagestyle{empty}") (calendar-for-loop i from 1 to n do (cal-tex-vspace "-1.5in") (cal-tex-b-center) (cal-tex-Huge-bf (let* ((d (calendar-iso-from-absolute (calendar-absolute-from-gregorian date)))) (format "Week %d of %d" (extract-calendar-month d) (extract-calendar-year d)))) (cal-tex-nl ".5cm") (cal-tex-e-center) (cal-tex-b-parbox "l" "\\textwidth") (calendar-for-loop j from 1 to 7 do (cal-tex-b-parbox "t" "\\textwidth") (cal-tex-b-parbox "t" "\\textwidth") (cal-tex-rule "0pt" "\\textwidth" ".2mm") (cal-tex-nl) (cal-tex-b-parbox "t" "\\textwidth") (cal-tex-large-bf (calendar-day-name date)) (insert ", ") (cal-tex-large-bf (calendar-month-name month)) (insert " ") (cal-tex-large-bf (number-to-string day)) (if (not (string= "" (cal-tex-latexify-list holidays date))) (progn (insert ": ") (cal-tex-large-bf (cal-tex-latexify-list holidays date "; ")))) (cal-tex-hfill) (insert " " (eval cal-tex-daily-string)) (cal-tex-e-parbox) (cal-tex-nl) (cal-tex-noindent) (cal-tex-b-parbox "t" "\\textwidth") (if (not (string= "" (cal-tex-latexify-list diary-list date))) (progn (insert "\\vbox to 0pt{") (cal-tex-large-bf (cal-tex-latexify-list diary-list date)) (insert "}"))) (cal-tex-e-parbox) (cal-tex-nl) (setq date (cal-tex-incr-date date)) (setq month (extract-calendar-month date)) (setq day (extract-calendar-day date)) (cal-tex-e-parbox) (cal-tex-e-parbox "2cm") (cal-tex-nl) (setq month (extract-calendar-month date)) (setq year (extract-calendar-year date))) (cal-tex-e-parbox)% (if (/= i n) (progn (run-hooks 'cal-tex-week-hook) (cal-tex-newpage)))) (cal-tex-end-document) (run-hooks 'cal-tex-hook))) (defvar cal-tex-LaTeX-hourbox "\\newcommand{\\hourbox}[2]% {\\makebox[2em]{\\rule{0cm}{#2ex}#1}\\rule{3in}{.15mm}}\n" "One hour and a line on the right.") (defun cal-tex-week-hours (date holidays height) "Insert hourly entries for DATE with HOLIDAYS, with line height HEIGHT." (let ((month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date)) (afternoon)) (cal-tex-comment "begin cal-tex-week-hours") (cal-tex-cmd "\\ \\\\[-.2cm]") (cal-tex-cmd "\\noindent") (cal-tex-b-parbox "l" "6.8in") (cal-tex-large-bf (calendar-day-name date)) (insert ", ") (cal-tex-large-bf (calendar-month-name month)) (insert " ") (cal-tex-large-bf (number-to-string day)) (if (not (string= "" (cal-tex-latexify-list holidays date))) (progn (insert ": ") (cal-tex-large-bf (cal-tex-latexify-list holidays date "; ")))) (cal-tex-hfill) (insert " " (eval cal-tex-daily-string)) (cal-tex-e-parbox) (cal-tex-nl "-.3cm") (cal-tex-rule "0pt" "6.8in" ".2mm") (cal-tex-nl "-.1cm") (calendar-for-loop i from 8 to 12 do (if cal-tex-24 (setq afternoon (+ i 5)) (setq afternoon (- i 7))) (cal-tex-cmd "\\hourbox" (number-to-string i)) (cal-tex-arg height) (cal-tex-hspace ".4cm") (cal-tex-cmd "\\hourbox" (number-to-string afternoon)) (cal-tex-arg height) (cal-tex-nl)))) (defun cal-tex-cursor-week-monday (&optional arg) "Make a buffer with LaTeX commands for a two-page one-week calendar. It applies to the week that point is in, and starts on Monday. Optional prefix argument specifies number of weeks. Holidays are included if `cal-tex-holidays' is t." (interactive "P") (let* ((n (if arg arg 1)) (date (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 0 (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))))) (cal-tex-preamble "11pt") (cal-tex-cmd "\\textwidth 6.5in") (cal-tex-cmd "\\textheight 10.5in") (cal-tex-cmd "\\oddsidemargin 0in") (cal-tex-cmd "\\evensidemargin 0in") (cal-tex-b-document) (calendar-for-loop i from 1 to n do (cal-tex-vspace "-1cm") (insert "\\noindent ") (cal-tex-weekly4-box (cal-tex-incr-date date) nil) (cal-tex-weekly4-box (cal-tex-incr-date date 4) nil) (cal-tex-nl ".2cm") (cal-tex-weekly4-box (cal-tex-incr-date date 2) nil) (cal-tex-weekly4-box (cal-tex-incr-date date 5) nil) (cal-tex-nl ".2cm") (cal-tex-weekly4-box (cal-tex-incr-date date 3) nil) (cal-tex-weekly4-box (cal-tex-incr-date date 6) t) (if (/= i n) (progn (run-hooks 'cal-tex-week-hook) (setq date (cal-tex-incr-date date 7)) (cal-tex-newpage)))) (cal-tex-end-document) (run-hooks 'cal-tex-hook))) (defun cal-tex-weekly4-box (date weekend) "Make one box for DATE, different if WEEKEND." (let* ( (day (extract-calendar-day date)) (month (extract-calendar-month date)) (year (extract-calendar-year date)) (dayname (calendar-day-name date)) (date1 (cal-tex-incr-date date)) (day1 (extract-calendar-day date1)) (month1 (extract-calendar-month date1)) (year1 (extract-calendar-year date1)) (dayname1 (calendar-day-name date1)) ) (cal-tex-b-framebox "8cm" "l") (cal-tex-b-parbox "b" "7.5cm") (insert (format "{\\Large\\bf %s,} %s/%s/%s\\\\\n" dayname month day year)) (cal-tex-rule "0pt" "7.5cm" ".5mm") (cal-tex-nl) (if (not weekend) (progn (calendar-for-loop i from 8 to 12 do (insert (format "{\\large\\sf %d}\\\\\n" i))) (calendar-for-loop i from 1 to 5 do (insert (format "{\\large\\sf %d}\\\\\n" i))))) (cal-tex-nl ".5cm") (if weekend (progn (cal-tex-vspace "1cm") (insert "\\ \\vfill") (insert (format "{\\Large\\bf %s,} %s/%s/%s\\\\\n" dayname1 month1 day1 year1)) (cal-tex-rule "0pt" "7.5cm" ".5mm") (cal-tex-nl "1.5cm") (cal-tex-vspace "1cm"))) (cal-tex-e-parbox) (cal-tex-e-framebox) (cal-tex-hspace "1cm"))) (defun cal-tex-cursor-filofax-2week (&optional arg) "Two-weeks-at-a-glance Filofax style calendar for week indicated by cursor. Optional prefix argument specifies number of weeks. Diary entries are included if `cal-tex-diary' is t. Holidays are included if `cal-tex-holidays' is t." (interactive "P") (let* ((n (if arg arg 1)) (date (calendar-gregorian-from-absolute (calendar-dayname-on-or-before calendar-week-start-day (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) (month (extract-calendar-month date)) (year (extract-calendar-year date)) (day (extract-calendar-day date)) (holidays (if cal-tex-holidays (cal-tex-list-holidays (calendar-absolute-from-gregorian date) (+ (* 7 n) (calendar-absolute-from-gregorian date))))) (diary-list (if cal-tex-diary (cal-tex-list-diary-entries (calendar-absolute-from-gregorian (list month 1 year)) (+ (* 7 n) (calendar-absolute-from-gregorian date)))))) (cal-tex-preamble "twoside") (cal-tex-cmd "\\textwidth 3.25in") (cal-tex-cmd "\\textheight 6.5in") (cal-tex-cmd "\\oddsidemargin 1.75in") (cal-tex-cmd "\\evensidemargin 1.5in") (cal-tex-cmd "\\topmargin 0pt") (cal-tex-cmd "\\headheight -0.875in") (cal-tex-cmd "\\headsep 0.125in") (cal-tex-cmd "\\footskip .125in") (insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]} \\long\\def\\rightday#1#2#3#4#5{% \\rule{\\textwidth}{0.3pt}\\\\% \\hbox to \\textwidth{% \\vbox to 0.7in{% \\vspace*{2pt}% \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}% \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}% \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\} \\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]} \\long\\def\\leftday#1#2#3#4#5{% \\rule{\\textwidth}{0.3pt}\\\\% \\hbox to \\textwidth{% \\vbox to 0.7in{% \\vspace*{2pt}% \\hbox to \\textwidth{\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}% \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize \\em #4}}% \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\} ") (cal-tex-b-document) (cal-tex-cmd "\\pagestyle{empty}") (calendar-for-loop i from 1 to n do (if (= (mod i 2) 1) (insert "\\righthead") (insert "\\lefthead")) (cal-tex-arg (let ((d (cal-tex-incr-date date 6))) (if (= (extract-calendar-month date) (extract-calendar-month d)) (format "%s %s" (calendar-month-name (extract-calendar-month date)) (extract-calendar-year date)) (if (= (extract-calendar-year date) (extract-calendar-year d)) (format "%s---%s %s" (calendar-month-name (extract-calendar-month date)) (calendar-month-name (extract-calendar-month d)) (extract-calendar-year date)) (format "%s %s---%s %s" (calendar-month-name (extract-calendar-month date)) (extract-calendar-year date) (calendar-month-name (extract-calendar-month d)) (extract-calendar-year d)))))) (insert "%\n") (calendar-for-loop j from 1 to 7 do (if (= (mod i 2) 1) (insert "\\rightday") (insert "\\leftday")) (cal-tex-arg (calendar-day-name date)) (cal-tex-arg (int-to-string (extract-calendar-day date))) (cal-tex-arg (cal-tex-latexify-list diary-list date)) (cal-tex-arg (cal-tex-latexify-list holidays date)) (cal-tex-arg (eval cal-tex-daily-string)) (insert "%\n") (setq date (cal-tex-incr-date date))) (if (/= i n) (progn (run-hooks 'cal-tex-week-hook) (cal-tex-newpage)))) (cal-tex-end-document) (run-hooks 'cal-tex-hook))) (defun cal-tex-cursor-filofax-week (&optional arg) "One-week-at-a-glance Filofax style calendar for week indicated by cursor. Optional prefix argument specifies number of weeks. Weeks start on Monday. Diary entries are included if `cal-tex-diary' is t. Holidays are included if `cal-tex-holidays' is t." (interactive "P") (let* ((n (if arg arg 1)) (date (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 1 (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) (month (extract-calendar-month date)) (year (extract-calendar-year date)) (day (extract-calendar-day date)) (holidays (if cal-tex-holidays (cal-tex-list-holidays (calendar-absolute-from-gregorian date) (+ (* 7 n) (calendar-absolute-from-gregorian date))))) (diary-list (if cal-tex-diary (cal-tex-list-diary-entries (calendar-absolute-from-gregorian (list month 1 year)) (+ (* 7 n) (calendar-absolute-from-gregorian date)))))) (cal-tex-preamble "twoside") (cal-tex-cmd "\\textwidth 3.25in") (cal-tex-cmd "\\textheight 6.5in") (cal-tex-cmd "\\oddsidemargin 1.75in") (cal-tex-cmd "\\evensidemargin 1.5in") (cal-tex-cmd "\\topmargin 0pt") (cal-tex-cmd "\\headheight -0.875in") (cal-tex-cmd "\\headsep 0.125in") (cal-tex-cmd "\\footskip .125in") (insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]} \\long\\def\\rightday#1#2#3#4#5{% \\rule{\\textwidth}{0.3pt}\\\\% \\hbox to \\textwidth{% \\vbox to 1.85in{% \\vspace*{2pt}% \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}% \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}% \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\} \\long\\def\\weekend#1#2#3#4#5{% \\rule{\\textwidth}{0.3pt}\\\\% \\hbox to \\textwidth{% \\vbox to .8in{% \\vspace*{2pt}% \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}% \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}% \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\} \\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]} \\long\\def\\leftday#1#2#3#4#5{% \\rule{\\textwidth}{0.3pt}\\\\% \\hbox to \\textwidth{% \\vbox to 1.85in{% \\vspace*{2pt}% \\hbox to \\textwidth{\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}% \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize \\em #4}}% \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\} ") (cal-tex-b-document) (cal-tex-cmd "\\pagestyle{empty}\\ ") (cal-tex-newpage) (calendar-for-loop i from 1 to n do (insert "\\lefthead") (cal-tex-arg (let ((d (cal-tex-incr-date date 2))) (if (= (extract-calendar-month date) (extract-calendar-month d)) (format "%s %s" (calendar-month-name (extract-calendar-month date)) (extract-calendar-year date)) (if (= (extract-calendar-year date) (extract-calendar-year d)) (format "%s---%s %s" (calendar-month-name (extract-calendar-month date)) (calendar-month-name (extract-calendar-month d)) (extract-calendar-year date)) (format "%s %s---%s %s" (calendar-month-name (extract-calendar-month date)) (extract-calendar-year date) (calendar-month-name (extract-calendar-month d)) (extract-calendar-year d)))))) (insert "%\n") (calendar-for-loop j from 1 to 3 do (insert "\\leftday") (cal-tex-arg (calendar-day-name date)) (cal-tex-arg (int-to-string (extract-calendar-day date))) (cal-tex-arg (cal-tex-latexify-list diary-list date)) (cal-tex-arg (cal-tex-latexify-list holidays date)) (cal-tex-arg (eval cal-tex-daily-string)) (insert "%\n") (setq date (cal-tex-incr-date date))) (insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n") (cal-tex-newpage) (insert "\\righthead") (cal-tex-arg (let ((d (cal-tex-incr-date date 3))) (if (= (extract-calendar-month date) (extract-calendar-month d)) (format "%s %s" (calendar-month-name (extract-calendar-month date)) (extract-calendar-year date)) (if (= (extract-calendar-year date) (extract-calendar-year d)) (format "%s---%s %s" (calendar-month-name (extract-calendar-month date)) (calendar-month-name (extract-calendar-month d)) (extract-calendar-year date)) (format "%s %s---%s %s" (calendar-month-name (extract-calendar-month date)) (extract-calendar-year date) (calendar-month-name (extract-calendar-month d)) (extract-calendar-year d)))))) (insert "%\n") (calendar-for-loop j from 1 to 2 do (insert "\\rightday") (cal-tex-arg (calendar-day-name date)) (cal-tex-arg (int-to-string (extract-calendar-day date))) (cal-tex-arg (cal-tex-latexify-list diary-list date)) (cal-tex-arg (cal-tex-latexify-list holidays date)) (cal-tex-arg (eval cal-tex-daily-string)) (insert "%\n") (setq date (cal-tex-incr-date date))) (calendar-for-loop j from 1 to 2 do (insert "\\weekend") (cal-tex-arg (calendar-day-name date)) (cal-tex-arg (int-to-string (extract-calendar-day date))) (cal-tex-arg (cal-tex-latexify-list diary-list date)) (cal-tex-arg (cal-tex-latexify-list holidays date)) (cal-tex-arg (eval cal-tex-daily-string)) (insert "%\n") (setq date (cal-tex-incr-date date))) (if (/= i n) (progn (run-hooks 'cal-tex-week-hook) (cal-tex-newpage)))) (cal-tex-end-document) (run-hooks 'cal-tex-hook))) ;;; ;;; Daily calendars ;;; (defun cal-tex-cursor-day (&optional arg) "Make a buffer with LaTeX commands for the day cursor is on. Optional prefix argument specifies number of days." (interactive "P") (let ((n (if arg arg 1)) (date (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))) (cal-tex-preamble "12pt") (cal-tex-cmd "\\textwidth 6.5in") (cal-tex-cmd "\\textheight 10.5in") (cal-tex-b-document) (cal-tex-cmd "\\pagestyle{empty}") (calendar-for-loop i from 1 to n do (cal-tex-vspace "-1.7in") (cal-tex-daily-page (calendar-gregorian-from-absolute date)) (setq date (1+ date)) (if (/= i n) (progn (cal-tex-newpage) (run-hooks 'cal-tex-daily-hook)))) (cal-tex-end-document) (run-hooks 'cal-tex-hook))) (defun cal-tex-daily-page (date) "Make a calendar page for Gregorian DATE on 8.5 by 11 paper." (let* ((hour) (month-name (calendar-month-name (extract-calendar-month date)))) (cal-tex-banner "cal-tex-daily-page") (cal-tex-b-makebox "4cm" "l") (cal-tex-b-parbox "b" "3.8cm") (cal-tex-rule "0mm" "0mm" "2cm") (cal-tex-Huge (number-to-string (extract-calendar-day date))) (cal-tex-nl ".5cm") (cal-tex-bf month-name ) (cal-tex-e-parbox) (cal-tex-hspace "1cm") (cal-tex-scriptsize (eval cal-tex-daily-string)) (cal-tex-hspace "3.5cm") (cal-tex-e-makebox) (cal-tex-hfill) (cal-tex-b-makebox "4cm" "r") (cal-tex-bf (calendar-day-name date)) (cal-tex-e-makebox) (cal-tex-nl) (cal-tex-hspace ".4cm") (cal-tex-rule "0mm" "16.1cm" "1mm") (cal-tex-nl ".1cm") (calendar-for-loop i from cal-tex-daily-start to cal-tex-daily-end do (cal-tex-cmd "\\noindent") (setq hour (if cal-tex-24 i (mod i 12))) (if (= 0 hour) (setq hour 12)) (cal-tex-b-makebox "1cm" "c") (cal-tex-arg (number-to-string hour)) (cal-tex-e-makebox) (cal-tex-rule "0mm" "15.5cm" ".2mm") (cal-tex-nl ".2cm") (cal-tex-b-makebox "1cm" "c") (cal-tex-arg "$\\diamond$" ) (cal-tex-e-makebox) (cal-tex-rule "0mm" "15.5cm" ".2mm") (cal-tex-nl ".2cm")) (cal-tex-hfill) (insert (cal-tex-mini-calendar (extract-calendar-month (cal-tex-previous-month date)) (extract-calendar-year (cal-tex-previous-month date)) "lastmonth" "1.1in" "1in")) (insert (cal-tex-mini-calendar (extract-calendar-month date) (extract-calendar-year date) "thismonth" "1.1in" "1in")) (insert (cal-tex-mini-calendar (extract-calendar-month (cal-tex-next-month date)) (extract-calendar-year (cal-tex-next-month date)) "nextmonth" "1.1in" "1in")) (insert "\\hbox to \\textwidth{") (cal-tex-hfill) (insert "\\lastmonth") (cal-tex-hfill) (insert "\\thismonth") (cal-tex-hfill) (insert "\\nextmonth") (cal-tex-hfill) (insert "}") (cal-tex-banner "end of cal-tex-daily-page"))) ;;; ;;; Mini calendars ;;; (defun cal-tex-mini-calendar (month year name width height &optional size) "Produce mini-calendar for MONTH, YEAR in macro NAME with WIDTH and HEIGHT. Optional SIZE gives the point size; scriptsize is the default," (let* ((blank-days;; at start of month (mod (- (calendar-day-of-week (list month 1 year)) calendar-week-start-day) 7)) (last (calendar-last-day-of-month month year)) (str (concat "\\def\\" name "{\\hbox to" width "{%\n" "\\vbox to" height "{%\n" "\\vfil \\hbox to" width "{%\n" "\\hfil\\" (if size size "scriptsize") "\\begin{tabular}" "{@{\\hspace{1mm}}r@{\\hspace{1mm}}r@{\\hspace{1mm}}r@{\\hspace{1mm}}" "r@{\\hspace{1mm}}r@{\\hspace{1mm}}r@{\\hspace{1mm}}r@{\\hspace{1mm}}}%\n" "\\multicolumn{7}{c}{" (calendar-month-name month) " " (int-to-string year) "}\\\\[0.5mm]\n"))) (calendar-for-loop i from 0 to 6 do (setq str (concat str (substring (aref calendar-day-name-array (mod (+ calendar-week-start-day i) 7)) 0 2) (if (/= i 6) " & " "\\\\[0.5mm]\n")))) (calendar-for-loop i from 1 to blank-days do (setq str (concat str " & "))) (calendar-for-loop i from 1 to last do (setq str (concat str (int-to-string i))) (setq str (concat str (if (zerop (mod (+ i blank-days) 7)) (if (/= i last) "\\\\[0.5mm]\n" "") " & ")))) (setq str (concat str "\n\\end{tabular}\\hfil}\\vfil}}}%\n")) str)) ;;; ;;; Various calendar functions ;;; (defun cal-tex-incr-date (date &optional n) "The date of the day following DATE. If optional N is given, the date of N days after DATE." (calendar-gregorian-from-absolute (+ (if n n 1) (calendar-absolute-from-gregorian date)))) (defun cal-tex-latexify-list (date-list date &optional separator) "Return string with concatenated, LaTeXified entries in DATE_LIST for DATE. Use double backslash as a separator unless optional SEPARATOR is given." (mapconcat '(lambda (x) (cal-tex-LaTeXify-string x)) (let ((result) (p date-list)) (while p (and (car (car p)) (calendar-date-equal date (car (car p))) (setq result (append (cdr (car p)) result))) (setq p (cdr p))) result) (if separator separator "\\\\"))) (defun cal-tex-previous-month (date) "Return the date of the first day in the month previous to DATE." (let* ((month (extract-calendar-month date)) (year (extract-calendar-year date))) (increment-calendar-month month year -1) (list month 1 year))) (defun cal-tex-next-month (date) "Return the date of the first day in the month following DATE." (let* ((month (extract-calendar-month date)) (year (extract-calendar-year date))) (increment-calendar-month month year 1) (list month 1 year))) ;;; ;;; LaTeX Code ;;; (defun cal-tex-end-document () "Finish the LaTeX document. Insert the trailer to LaTeX document, pop to LaTeX buffer, add informative header, and run HOOK." (cal-tex-e-document) (latex-mode) (pop-to-buffer cal-tex-buffer) (goto-char (point-min)) (cal-tex-comment " This buffer was produced by cal-tex.el.") (cal-tex-comment " To print a calendar, type") (cal-tex-comment " M-x tex-buffer RET") (cal-tex-comment " M-x tex-print RET") (goto-char (point-min))) (defun cal-tex-insert-preamble (weeks landscape size &optional append) "Initialize the output buffer. Select the output buffer, and insert the preamble for a calendar of WEEKS weeks. Insert code for landscape mode if LANDSCAPE is true. Use pointsize SIZE. Optional argument APPEND, if t, means add to end of without erasing current contents." (let ((width "18cm") (height "24cm")) (if landscape (progn (setq width "24cm") (setq height "18cm"))) (if (not append) (progn (cal-tex-preamble size) (if (not landscape) (progn (cal-tex-cmd "\\oddsidemargin -1.75cm") (cal-tex-cmd "\\def\\holidaymult{.06}")) (cal-tex-cmd "\\special{landscape}") (cal-tex-cmd "\\textwidth 9.5in") (cal-tex-cmd "\\textheight 7in") (cal-tex-comment) (cal-tex-cmd "\\def\\holidaymult{.08}")) (cal-tex-cmd cal-tex-caldate) (cal-tex-cmd cal-tex-myday) (cal-tex-b-document) (cal-tex-cmd "\\pagestyle{empty}"))) (cal-tex-cmd "\\setlength{\\cellwidth}" width) (insert (format "\\setlength{\\cellwidth}{%f\\cellwidth}\n" (/ 1.1 (length cal-tex-which-days)))) (cal-tex-cmd "\\setlength{\\cellheight}" height) (insert (format "\\setlength{\\cellheight}{%f\\cellheight}\n" (/ 1.0 weeks))) (cal-tex-cmd "\\ \\par") (cal-tex-vspace "-3cm"))) (defvar cal-tex-LaTeX-subst-list '(("\"". "``") ("\"". "''");; Quote changes meaning when list is reversed. ("@" . "\\verb|@|") ("&" . "\\&") ("%" . "\\%") ("$" . "\\$") ("#" . "\\#") ("_" . "\\_") ("{" . "\\{") ("}" . "\\}") ("<" . "$<$") (">" . "$>$") ("\n" . "\\ \\\\")) ;\\ needed for e.g \begin{center}\n AA\end{center} "List of symbols and their replacements.") (defun cal-tex-LaTeXify-string (string) "Protect special characters in STRING from LaTeX." (if (not string) "" (let ((head "") (tail string) (list cal-tex-LaTeX-subst-list)) (while (not (string-equal tail "")) (let* ((ch (substring tail 0 1)) (pair (assoc ch list))) (if (and pair (string-equal ch "\"")) (setq list (reverse list)));; Quote changes meaning each time. (setq tail (substring tail 1)) (setq head (concat head (if pair (cdr pair) ch))))) head))) (defun cal-tex-hfill () "Insert hfill." (insert "\\hfill")) (defun cal-tex-newpage () "Insert newpage." (insert "\\newpage%\n")) (defun cal-tex-noindent () "Insert noindent." (insert "\\noindent")) (defun cal-tex-vspace (space) "Insert vspace command to move SPACE vertically." (insert "\\vspace*{" space "}") (cal-tex-comment)) (defun cal-tex-hspace (space) "Insert hspace command to move SPACE horizontally." (insert "\\hspace*{" space "}") (cal-tex-comment)) (defun cal-tex-comment (&optional comment) "Insert % at end of line, include COMMENT if present, and move to next line." (insert "% ") (if comment (insert comment)) (insert "\n")) (defun cal-tex-banner (comment) "Insert the COMMENT separated by blank lines." (cal-tex-comment) (cal-tex-comment) (cal-tex-comment (concat "\t\t\t" comment)) (cal-tex-comment)) (defun cal-tex-nl (&optional skip comment) "End a line with \\. If SKIP, then add that much spacing. Add COMMENT if present" (insert "\\\\") (if skip (insert "[" skip "]")) (cal-tex-comment comment)) (defun cal-tex-arg (&optional text) "Insert optional TEXT surrounded by braces." (insert "{") (if text (insert text)) (insert "}")) (defun cal-tex-cmd (cmd &optional arg) "Insert LaTeX CMD, with optional ARG, and end with %" (insert cmd) (cal-tex-arg arg) (cal-tex-comment)) ;;; ;;; Environments ;;; (defun cal-tex-b-document () "Insert beginning of document." (cal-tex-cmd "\\begin{document}")) (defun cal-tex-e-document () "Insert end of document." (cal-tex-cmd "\\end{document}")) (defun cal-tex-b-center () "Insert beginning of centered block." (cal-tex-cmd "\\begin{center}")) (defun cal-tex-e-center () "Insert end of centered block." (cal-tex-comment) (cal-tex-cmd "\\end{center}")) ;;; ;;; Boxes ;;; (defun cal-tex-b-parbox (position width) "Insert parbox with parameters POSITION and WIDTH." (insert "\\parbox[" position "]{" width "}{") (cal-tex-comment)) (defun cal-tex-e-parbox (&optional height) "Insert end of parbox. Force it to be a given HEIGHT." (cal-tex-comment) (if height (cal-tex-rule "0mm" "0mm" height)) (insert "}") (cal-tex-comment "end parbox")) (defun cal-tex-b-framebox ( width position ) "Insert framebox with parameters WIDTH and POSITION (clr)." (insert "\\framebox[" width "][" position "]{" ) (cal-tex-comment)) (defun cal-tex-e-framebox () "Insert end of framebox." (cal-tex-comment) (insert "}") (cal-tex-comment "end framebox")) (defun cal-tex-b-makebox ( width position ) "Insert makebox with parameters WIDTH and POSITION (clr)." (insert "\\makebox[" width "][" position "]{" ) (cal-tex-comment)) (defun cal-tex-e-makebox () "Insert end of makebox." (cal-tex-comment) (insert "}") (cal-tex-comment "end makebox")) (defun cal-tex-rule (lower width height) "Insert a rule with parameters LOWER WIDTH HEIGHT." (insert "\\rule[" lower "]{" width "}{" height "}")) ;;; ;;; Fonts ;;; (defun cal-tex-em (string) "Insert STRING in bf font." (insert "{\\em " string "}")) (defun cal-tex-bf (string) "Insert STRING in bf font." (insert "{\\bf " string "}")) (defun cal-tex-scriptsize (string) "Insert STRING in scriptsize font." (insert "{\\scriptsize " string "}")) (defun cal-tex-huge (string) "Insert STRING in huge size." (insert "{\\huge " string "}")) (defun cal-tex-Huge (string) "Insert STRING in Huge size." (insert "{\\Huge " string "}")) (defun cal-tex-Huge-bf (string) "Insert STRING in Huge bf size." (insert "{\\Huge\\bf " string "}")) (defun cal-tex-large (string) "Insert STRING in large size." (insert "{\\large " string "}")) (defun cal-tex-large-bf (string) "Insert STRING in large bf size." (insert "{\\large\\bf " string "}")) (provide 'cal-tex) ;;; cal-tex.el ends here emacs-19.30/lisp/cal-x.el100444 12120 1 13511 6050552163 13420 0ustar rmsdaemon;;; cal-x.el --- calendar windows in dedicated frames in x-windows ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: calendar, dedicated frames, x-windows ;; 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 collection of functions implements dedicated frames in x-windows for ;; calendar.el. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (require 'calendar) (defvar calendar-frame nil "Frame in which to display the calendar.") (defvar diary-frame nil "Frame in which to display the diary.") (defvar diary-frame-parameters '((name . "Diary") (height . 10) (width . 80) (unsplittable . t) (font . "6x13") (auto-lower . t) (auto-raise . t) (minibuffer . nil)) "Parameters of the diary frame, if the diary is in its own frame. Location and color should be set in .Xdefaults.") (defvar calendar-frame-parameters '((name . "Calendar") (minibuffer . nil) (height . 10) (width . 80) (auto-raise . t) (auto-lower . t) (font . "6x13") (unsplittable . t) (vertical-scroll-bars . nil)) "Parameters of the calendar frame, if the calendar is in a separate frame. Location and color should be set in .Xdefaults.") (defvar calendar-and-diary-frame-parameters '((name . "Calendar") (height . 28) (width . 80) (minibuffer . nil) (font . "6x13") (auto-raise . t) (auto-lower . t)) "Parameters of the frame that displays both the calendar and the diary. Location and color should be set in .Xdefaults.") (defvar calendar-after-frame-setup-hooks nil "Hooks to be run just after setting up a calendar frame. Can be used to change frame parameters, such as font, color, location, etc.") (defun calendar-one-frame-setup (&optional arg) "Start calendar and display it in a dedicated frame together with the diary." (if (not window-system) (calendar-basic-setup arg) (if (frame-live-p calendar-frame) (delete-frame calendar-frame)) (if (frame-live-p diary-frame) (delete-frame diary-frame)) (let ((special-display-buffer-names nil) (view-diary-entries-initially t)) (save-window-excursion (save-excursion (setq calendar-frame (make-frame calendar-and-diary-frame-parameters)) (run-hooks 'calendar-after-frame-setup-hooks) (select-frame calendar-frame) (if (eq 'icon (cdr (assoc 'visibility (frame-parameters calendar-frame)))) (iconify-or-deiconify-frame)) (calendar-basic-setup arg) (set-window-dedicated-p (selected-window) 'calendar) (set-window-dedicated-p (display-buffer (if (not (memq 'fancy-diary-display diary-display-hook)) (get-file-buffer diary-file) (if (not (bufferp (get-buffer fancy-diary-buffer))) (make-fancy-diary-buffer)) fancy-diary-buffer)) 'diary)))))) (defun calendar-two-frame-setup (&optional arg) "Start calendar and diary in separate, dedicated frames." (if (not window-system) (calendar-basic-setup arg) (if (frame-live-p calendar-frame) (delete-frame calendar-frame)) (if (frame-live-p diary-frame) (delete-frame diary-frame)) (let ((pop-up-windows nil) (view-diary-entries-initially nil) (special-display-buffer-names nil)) (save-window-excursion (save-excursion (calendar-basic-setup arg)) (setq calendar-frame (make-frame calendar-frame-parameters)) (run-hooks 'calendar-after-frame-setup-hooks) (select-frame calendar-frame) (if (eq 'icon (cdr (assoc 'visibility (frame-parameters calendar-frame)))) (iconify-or-deiconify-frame)) (display-buffer calendar-buffer) (set-window-dedicated-p (selected-window) 'calendar) (setq diary-frame (make-frame diary-frame-parameters)) (run-hooks 'calendar-after-frame-setup-hooks) (select-frame diary-frame) (if (eq 'icon (cdr (assoc 'visibility (frame-parameters diary-frame)))) (iconify-or-deiconify-frame)) (save-excursion (diary)) (set-window-dedicated-p (display-buffer (if (not (memq 'fancy-diary-display diary-display-hook)) (get-file-buffer diary-file) (if (not (bufferp (get-buffer fancy-diary-buffer))) (make-fancy-diary-buffer)) fancy-diary-buffer)) 'diary))))) (setq special-display-buffer-names (append special-display-buffer-names (list "*Yahrzeits*" lunar-phases-buffer holiday-buffer fancy-diary-buffer (get-file-buffer diary-file) calendar-buffer))) (run-hooks 'cal-x-load-hook) (provide 'cal-x) ;;; cal-x.el ends here emacs-19.30/lisp/calendar.el100444 12120 1 266562 6055525455 14236 0ustar rmsdaemon;;; calendar.el --- Calendar functions. -*-byte-compile-dynamic: t;-*- ;;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995 Free Software ;;; Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: calendar, Gregorian calendar, diary, holidays ;; 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 collection of functions implements a calendar window. It generates a ;; calendar for the current month, together with the previous and coming ;; months, or for any other three-month period. The calendar can be scrolled ;; forward and backward in the window to show months in the past or future; ;; the cursor can move forward and backward by days, weeks, or months, making ;; it possible, for instance, to jump to the date a specified number of days, ;; weeks, or months from the date under the cursor. The user can display a ;; list of holidays and other notable days for the period shown; the notable ;; days can be marked on the calendar, if desired. The user can also specify ;; that dates having corresponding diary entries (in a file that the user ;; specifies) be marked; the diary entries for any date can be viewed in a ;; separate window. The diary and the notable days can be viewed ;; independently of the calendar. Dates can be translated from the (usual) ;; Gregorian calendar to the day of the year/days remaining in year, to the ;; ISO commercial calendar, to the Julian (old style) calendar, to the Hebrew ;; calendar, to the Islamic calendar, to the French Revolutionary calendar, to ;; the Mayan calendar, to the Chinese calendar, to the Coptic calendar, to the ;; Ethiopic calendar, and to the astronomical (Julian) day number. When ;; floating point is available, times of sunrise/sunset can be displayed, as ;; can the phases of the moon. Appointment notification for diary entries is ;; available. Calendar printing via LaTeX is available. ;; The following files are part of the calendar/diary code: ;; appt.el Appointment notification ;; cal-chinese.el Chinese calendar ;; cal-coptic.el Coptic/Ethiopic calendars ;; cal-dst.el Daylight savings time rules ;; cal-hebrew.el Hebrew calendar ;; cal-islamic.el Islamic calendar ;; cal-iso.el ISO calendar ;; cal-julian.el Julian/astronomical calendars ;; cal-mayan.el Mayan calendars ;; cal-menu.el Menu support ;; cal-move.el Movement in the calendar ;; cal-tex.el Calendars in LaTeX ;; cal-x.el X-windows dedicated frame functions ;; diary.el Diary functions ;; holidays.el Holiday functions ;; lunar.el Phases of the moon ;; solar.el Sunrise/sunset, equinoxes/solstices ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;; Technical details of all the calendrical calculations can be found in ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, ;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990), ;; pages 899-928. ``Calendrical Calculations, Part II: Three Historical ;; Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. Clamen, ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993), ;; pages 383-404. ;; Hard copies of these two papers can be obtained by sending email to ;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and ;; the message BODY containing your mailing address (snail). ;;; Code: (defun calendar-version () (interactive) (message "Version 6, October 12, 1995")) ;;;###autoload (defvar calendar-week-start-day 0 "*The day of the week on which a week in the calendar begins. 0 means Sunday (default), 1 means Monday, and so on.") ;;;###autoload (defvar calendar-offset 0 "*The offset of the principal month from the center of the calendar window. 0 means the principal month is in the center (default), -1 means on the left, +1 means on the right. Larger (or smaller) values push the principal month off the screen.") ;;;###autoload (defvar view-diary-entries-initially nil "*Non-nil means display current date's diary entries on entry. The diary is displayed in another window when the calendar is first displayed, if the current date is visible. The number of days of diary entries displayed is governed by the variable `number-of-diary-entries'.") ;;;###autoload (defvar number-of-diary-entries 1 "*Specifies how many days of diary entries are to be displayed initially. This variable affects the diary display when the command M-x diary is used, or if the value of the variable `view-diary-entries-initially' is t. For example, if the default value 1 is used, then only the current day's diary entries will be displayed. If the value 2 is used, then both the current day's and the next day's entries will be displayed. The value can also be a vector such as [0 2 2 2 2 4 1]; this value says to display no diary entries on Sunday, the display the entries for the current date and the day after on Monday through Thursday, display Friday through Monday's entries on Friday, and display only Saturday's entries on Saturday. This variable does not affect the diary display with the `d' command from the calendar; in that case, the prefix argument controls the number of days of diary entries displayed.") ;;;###autoload (defvar mark-diary-entries-in-calendar nil "*Non-nil means mark dates with diary entries, in the calendar window. The marking symbol is specified by the variable `diary-entry-marker'.") (defvar diary-entry-marker (if (not window-system) "+" (require 'faces) (add-to-list 'facemenu-unlisted-faces 'diary-face) (make-face 'diary-face) (cond ((face-differs-from-default-p 'diary-face)) ((x-display-color-p) (set-face-foreground 'diary-face "red")) (t (copy-face 'bold 'diary-face))) 'diary-face) "*Used to mark dates that have diary entries. Can be either a single-character string or a face.") (defvar calendar-today-marker (if (not window-system) "=" (require 'faces) (add-to-list 'facemenu-unlisted-faces 'calendar-today-face) (make-face 'calendar-today-face) (if (not (face-differs-from-default-p 'calendar-today-face)) (set-face-underline-p 'calendar-today-face t)) 'calendar-today-face) "*Used to mark today's date. Can be either a single-character string or a face.") (defvar calendar-holiday-marker (if (not window-system) "*" (require 'faces) (add-to-list 'facemenu-unlisted-faces 'holiday-face) (make-face 'holiday-face) (cond ((face-differs-from-default-p 'holiday-face)) ((x-display-color-p) (set-face-background 'holiday-face "pink")) (t (set-face-background 'holiday-face "black") (set-face-foreground 'holiday-face "white"))) 'holiday-face) "*Used to mark notable dates in the calendar. Can be either a single-character string or a face.") ;;;###autoload (defvar view-calendar-holidays-initially nil "*Non-nil means display holidays for current three month period on entry. The holidays are displayed in another window when the calendar is first displayed.") ;;;###autoload (defvar mark-holidays-in-calendar nil "*Non-nil means mark dates of holidays in the calendar window. The marking symbol is specified by the variable `calendar-holiday-marker'.") ;;;###autoload (defvar all-hebrew-calendar-holidays nil "*If nil, show only major holidays from the Hebrew calendar. This means only those Jewish holidays that appear on secular calendars. If t, show all the holidays that would appear in a complete Hebrew calendar.") ;;;###autoload (defvar all-christian-calendar-holidays nil "*If nil, show only major holidays from the Christian calendar. This means only those Christian holidays that appear on secular calendars. If t, show all the holidays that would appear in a complete Christian calendar.") ;;;###autoload (defvar all-islamic-calendar-holidays nil "*If nil, show only major holidays from the Islamic calendar. This means only those Islamic holidays that appear on secular calendars. If t, show all the holidays that would appear in a complete Islamic calendar.") ;;;###autoload (defvar calendar-load-hook nil "*List of functions to be called after the calendar is first loaded. This is the place to add key bindings to `calendar-mode-map'.") ;;;###autoload (defvar initial-calendar-window-hook nil "*List of functions to be called when the calendar window is first opened. The functions invoked are called after the calendar window is opened, but once opened is never called again. Leaving the calendar with the `q' command and reentering it will cause these functions to be called again.") ;;;###autoload (defvar today-visible-calendar-hook nil "*List of functions called whenever the current date is visible. This can be used, for example, to replace today's date with asterisks; a function `calendar-star-date' is included for this purpose: (setq today-visible-calendar-hook 'calendar-star-date) It can also be used to mark the current date with `calendar-today-marker'; a function is also provided for this: (setq today-visible-calendar-hook 'calendar-mark-today) The corresponding variable `today-invisible-calendar-hook' is the list of functions called when the calendar function was called when the current date is not visible in the window. Other than the use of the provided functions, the changing of any characters in the calendar buffer by the hooks may cause the failure of the functions that move by days and weeks.") ;;;###autoload (defvar today-invisible-calendar-hook nil "*List of functions called whenever the current date is not visible. The corresponding variable `today-visible-calendar-hook' is the list of functions called when the calendar function was called when the current date is visible in the window. Other than the use of the provided functions, the changing of any characters in the calendar buffer by the hooks may cause the failure of the functions that move by days and weeks.") ;;;###autoload (defvar diary-file "~/diary" "*Name of the file in which one's personal diary of dates is kept. The file's entries are lines in any of the forms MONTH/DAY MONTH/DAY/YEAR MONTHNAME DAY MONTHNAME DAY, YEAR DAYNAME at the beginning of the line; the remainder of the line is the diary entry string for that date. MONTH and DAY are one or two digit numbers, YEAR is a number and may be written in full or abbreviated to the final two digits. If the date does not contain a year, it is generic and applies to any year. DAYNAME entries apply to any date on which is on that day of the week. MONTHNAME and DAYNAME can be spelled in full, abbreviated to three characters (with or without a period), capitalized or not. Any of DAY, MONTH, or MONTHNAME, YEAR can be `*' which matches any day, month, or year, respectively. The European style (in which the day precedes the month) can be used instead, if you execute `european-calendar' when in the calendar, or set `european-calendar-style' to t in your .emacs file. The European forms are DAY/MONTH DAY/MONTH/YEAR DAY MONTHNAME DAY MONTHNAME YEAR DAYNAME To revert to the default American style from the European style, execute `american-calendar' in the calendar. A diary entry can be preceded by the character `diary-nonmarking-symbol' (ordinarily `&') to make that entry nonmarking--that is, it will not be marked on dates in the calendar window but will appear in a diary window. Multiline diary entries are made by indenting lines after the first with either a TAB or one or more spaces. Lines not in one the above formats are ignored. Here are some sample diary entries (in the default American style): 12/22/1988 Twentieth wedding anniversary!! &1/1. Happy New Year! 10/22 Ruth's birthday. 21: Payday Tuesday--weekly meeting with grad students at 10am Supowit, Shen, Bitner, and Kapoor to attend. 1/13/89 Friday the thirteenth!! &thu 4pm squash game with Lloyd. mar 16 Dad's birthday April 15, 1989 Income tax due. &* 15 time cards due. If the first line of a diary entry consists only of the date or day name with no trailing blanks or punctuation, then that line is not displayed in the diary window; only the continuation lines is shown. For example, the single diary entry 02/11/1989 Bill Blattner visits Princeton today 2pm Cognitive Studies Committee meeting 2:30-5:30 Lizzie at Lawrenceville for `Group Initiative' 4:00pm Jamie Tappenden 7:30pm Dinner at George and Ed's for Alan Ryan 7:30-10:00pm dance at Stewart Country Day School will appear in the diary window without the date line at the beginning. This facility allows the diary window to look neater, but can cause confusion if used with more than one day's entries displayed. Diary entries can be based on Lisp sexps. For example, the diary entry %%(diary-block 11 1 1990 11 10 1990) Vacation causes the diary entry \"Vacation\" to appear from November 1 through November 10, 1990. Other functions available are `diary-float', `diary-anniversary', `diary-cyclic', `diary-day-of-year', `diary-iso-date', `diary-french-date', `diary-hebrew-date', `diary-islamic-date', `diary-mayan-date', `diary-chinese-date', `diary-coptic-date', `diary-ethiopic-date', `diary-yahrzeit', `diary-sunrise-sunset', `diary-phases-of-moon', `diary-parasha', `diary-omer', `diary-rosh-hodesh', and `diary-sabbath-candles'. See the documentation for the function `list-sexp-diary-entries' for more details. Diary entries based on the Hebrew and/or the Islamic calendar are also possible, but because these are somewhat slow, they are ignored unless you set the `nongregorian-diary-listing-hook' and the `nongregorian-diary-marking-hook' appropriately. See the documentation for these functions for details. Diary files can contain directives to include the contents of other files; for details, see the documentation for the variable `list-diary-entries-hook'.") ;;;###autoload (defvar diary-nonmarking-symbol "&" "*Symbol indicating that a diary entry is not to be marked in the calendar.") ;;;###autoload (defvar hebrew-diary-entry-symbol "H" "*Symbol indicating a diary entry according to the Hebrew calendar.") ;;;###autoload (defvar islamic-diary-entry-symbol "I" "*Symbol indicating a diary entry according to the Islamic calendar.") ;;;###autoload (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'.") ;;;###autoload (defvar sexp-diary-entry-symbol "%%" "*The string used to indicate a sexp diary entry in diary-file. See the documentation for the function `list-sexp-diary-entries'.") ;;;###autoload (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.") ;;;###autoload (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 DAY/MONTH/YEAR DAY MONTHNAME DAY MONTHNAME YEAR DAYNAME Names can be capitalized or not, written in full, or abbreviated to three characters with or without a period.") ;;;###autoload (defvar american-date-diary-pattern '((month "/" day "[^/0-9]") (month "/" day "/" year "[^0-9]") (monthname " *" day "[^,0-9]") (monthname " *" day ", *" year "[^0-9]") (dayname "\\W")) "*List of pseudo-patterns describing the American patterns of date used. See the documentation of `diary-date-forms' for an explanation.") ;;;###autoload (defvar european-date-diary-pattern '((day "/" month "[^/0-9]") (day "/" month "/" year "[^0-9]") (backup day " *" monthname "\\W+\\<[^*0-9]") (day " *" monthname " *" year "[^0-9]") (dayname "\\W")) "*List of pseudo-patterns describing the European patterns of date used. See the documentation of `diary-date-forms' for an explanation.") (defvar diary-date-forms (if european-calendar-style european-date-diary-pattern american-date-diary-pattern) "*List of pseudo-patterns describing the forms of date used in the diary. The patterns on the list must be MUTUALLY EXCLUSIVE and must should not match any portion of the diary entry itself, just the date component. A pseudo-pattern is a list of regular expressions and the keywords `month', `day', `year', `monthname', and `dayname'. The keyword `monthname' will match the name of the month, capitalized or not, or its three-letter abbreviation, followed by a period or not; it will also match `*'. Similarly, `dayname' will match the name of the day, capitalized or not, or its three-letter abbreviation, followed by a period or not. The keywords `month', `day', and `year' will match those numerical values, preceded by arbitrarily many zeros; they will also match `*'. The matching of the diary entries with the date forms is done with the standard syntax table from Fundamental mode, but with the `*' changed so that it is a word constituent. If, to be mutually exclusive, a pseudo-pattern must match a portion of the diary entry itself, the first element of the pattern MUST be `backup'. This directive causes the date recognizer to back up to the beginning of the current word of the diary entry, so in no case can the pattern match more than a portion of the first word of the diary entry.") ;;;###autoload (defvar european-calendar-display-form '((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-form for an explanation.") ;;;###autoload (defvar american-calendar-display-form '((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-form' 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) while a typical American form would be '(month \"/\" day \"/\" (substring year -2)) and '((format \"%9s, %9s %2s, %4s\" dayname monthname day year)) would give the usual American style in fixed-length fields. See the documentation of the function `calendar-date-string'.") (defun european-calendar () "Set the interpretation and display of dates to the European style." (interactive) (setq european-calendar-style t) (setq calendar-date-display-form european-calendar-display-form) (setq diary-date-forms european-date-diary-pattern) (update-calendar-mode-line)) (defun american-calendar () "Set the interpretation and display of dates to the American style." (interactive) (setq european-calendar-style nil) (setq calendar-date-display-form american-calendar-display-form) (setq diary-date-forms american-date-diary-pattern) (update-calendar-mode-line)) ;;;###autoload (defvar print-diary-entries-hook '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.") ;;;###autoload (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 this hook. This function enables you to use shared diary files together with your own. The files included are specified in the diary file by lines of the form #include \"filename\" This is recursive; that is, #include directives in files thus included are obeyed. You can change the \"#include\" to some other string by changing the variable `diary-include-string'. When you use `include-other-diary-files' as part of the list-diary-entries-hook, you will probably also want to use the function `mark-included-diary-files' as part of `mark-diary-entries-hook'. For example, you could use (setq list-diary-entries-hook '(include-other-diary-files sort-diary-entries)) (setq diary-display-hook 'fancy-diary-display) in your `.emacs' file to cause the fancy diary buffer to be displayed with diary entries from various included files, each day's entries sorted into lexicographic order.") ;;;###autoload (defvar diary-hook nil "*List of functions called after the display of the diary. Can be used for appointment notification.") ;;;###autoload (defvar diary-display-hook nil "*List of functions that handle the display of the diary. If nil (the default), `simple-diary-display' is used. Use `ignore' for no diary display. Ordinarily, this just displays the diary buffer (with holidays indicated in the mode line), if there are any relevant entries. At the time these functions are called, the variable `diary-entries-list' is a list, in order by date, of all relevant diary entries in the form of ((MONTH DAY YEAR) STRING), where string is the diary entry for the given date. This can be used, for example, a different buffer for display (perhaps combined with holidays), or produce hard copy output. A function `fancy-diary-display' is provided as an alternative choice for this hook; this function prepares a special noneditable diary buffer with the relevant diary entries that has neat day-by-day arrangement with headings. The fancy diary buffer will show the holidays unless the variable `holidays-in-diary-buffer' is set to nil. Ordinarily, the fancy diary buffer will not show days for which there are no diary entries, even if that day is a holiday; if you want such days to be shown in the fancy diary buffer, set the variable `diary-list-include-blanks' to t.") ;;;###autoload (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.") ;;;###autoload (defvar mark-diary-entries-hook nil "*List of functions called after marking diary entries in the calendar. A function `mark-included-diary-files' is also provided for use as the mark-diary-entries-hook; it enables you to use shared diary files together with your own. The files included are specified in the diary file by lines of the form #include \"filename\" This is recursive; that is, #include directives in files thus included are obeyed. You can change the \"#include\" to some other string by changing the variable `diary-include-string'. When you use `mark-included-diary-files' as part of the mark-diary-entries-hook, you will probably also want to use the function `include-other-diary-files' as part of `list-diary-entries-hook'.") ;;;###autoload (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.") ;;;###autoload (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.") ;;;###autoload (defvar holidays-in-diary-buffer t "*Non-nil means include holidays in the diary display. The holidays appear 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 makes the diary display faster.") (defvar calendar-mark-ring nil) ;;;###autoload (put 'general-holidays 'risky-local-variable t) ;;;###autoload (defvar general-holidays '((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.") ;;;###autoload (put 'oriental-holidays 'risky-local-variable t) ;;;###autoload (defvar oriental-holidays '((if (fboundp 'atan) (holiday-chinese-new-year))) "*Oriental holidays. See the documentation for `calendar-holidays' for details.") ;;;###autoload (put 'local-holidays 'risky-local-variable t) ;;;###autoload (defvar local-holidays nil "*Local holidays. See the documentation for `calendar-holidays' for details.") ;;;###autoload (put 'other-holidays 'risky-local-variable t) ;;;###autoload (defvar other-holidays nil "*User defined holidays. See the documentation for `calendar-holidays' for details.") ;;;###autoload (put 'hebrew-holidays-1 'risky-local-variable t) ;;;###autoload (defvar hebrew-holidays-1 '((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)")))) ;;;###autoload (put 'hebrew-holidays-2 'risky-local-variable t) ;;;###autoload (defvar hebrew-holidays-2 '((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")))) ;;;###autoload (put 'hebrew-holidays-3 'risky-local-variable t) ;;;###autoload (defvar hebrew-holidays-3 '((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")))) ;;;###autoload (put 'hebrew-holidays-4 'risky-local-variable t) ;;;###autoload (defvar hebrew-holidays-4 '((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)))) ;;;###autoload (put 'hebrew-holidays 'risky-local-variable t) ;;;###autoload (defvar hebrew-holidays (append hebrew-holidays-1 hebrew-holidays-2 hebrew-holidays-3 hebrew-holidays-4) "*Jewish holidays. See the documentation for `calendar-holidays' for details.") ;;;###autoload (put 'christian-holidays 'risky-local-variable t) ;;;###autoload (defvar christian-holidays '((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.") ;;;###autoload (put 'islamic-holidays 'risky-local-variable t) ;;;###autoload (defvar islamic-holidays '((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.") ;;;###autoload (put 'solar-holidays 'risky-local-variable t) ;;;###autoload (defvar solar-holidays '((if (fboundp 'atan) (solar-equinoxes-solstices)) (if (progn (require 'cal-dst) t) (funcall 'holiday-sexp calendar-daylight-savings-starts '(format "Daylight Savings Time Begins %s" (if (fboundp 'atan) (solar-time-string (/ calendar-daylight-savings-starts-time (float 60)) calendar-standard-time-zone-name) "")))) (funcall 'holiday-sexp calendar-daylight-savings-ends '(format "Daylight Savings Time Ends %s" (if (fboundp 'atan) (solar-time-string (/ calendar-daylight-savings-ends-time (float 60)) calendar-daylight-time-zone-name) "")))) "*Sun-related holidays. See the documentation for `calendar-holidays' for details.") ;;;###autoload (put 'calendar-holidays 'risky-local-variable t) (defvar calendar-holidays (append general-holidays local-holidays other-holidays christian-holidays hebrew-holidays islamic-holidays oriental-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', `oriental-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. Entries on the list are expressions that return (possibly empty) lists of items of the form ((month day year) string) of a holiday in the in the three-month period centered around `displayed-month' of `displayed-year'. Several basic functions are provided for this purpose: (holiday-fixed MONTH DAY STRING) is a fixed date on the Gregorian calendar (holiday-float MONTH DAYNAME K STRING &optional day) is the Kth DAYNAME in MONTH on the Gregorian calendar (0 for Sunday, etc.); K<0 means count back from the end of the month. An optional parameter DAY means the Kth DAYNAME after/before MONTH DAY. (holiday-hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar (holiday-julian MONTH DAY STRING) a fixed date on the Julian calendar (holiday-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. STRING is an expression in the variable `date'. For example, to add Bastille Day, celebrated in France on July 14, add (holiday-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 (holiday-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 (holiday-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 (holiday-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 (holiday-julian 4 2 \"Jefferson's Birthday\") To include a holiday conditionally, use the sexp form or a conditional. 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 (holiday-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)) (holiday-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 `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\") ... ).") (defconst calendar-buffer "*Calendar*" "Name of the buffer used for the calendar.") (defconst holiday-buffer "*Holidays*" "Name of the buffer used for the displaying the holidays.") (defconst fancy-diary-buffer "*Fancy Diary Entries*" "Name of the buffer used for the optional fancy display of the diary.") (defconst lunar-phases-buffer "*Phases of Moon*" "Name of the buffer used for the lunar phases.") (defmacro increment-calendar-month (mon yr n) "Move the variables MON and YR to the month and year by N months. Forward if N is positive or backward if N is negative." (` (let (( macro-y (+ (* (, yr) 12) (, mon) -1 (, n) ))) (setq (, mon) (1+ (% macro-y 12) )) (setq (, yr) (/ macro-y 12))))) (defmacro calendar-for-loop (var from init to final do &rest body) "Execute a for loop." (` (let (( (, var) (1- (, init)) )) (while (>= (, final) (setq (, var) (1+ (, var)))) (,@ body))))) (defmacro calendar-sum (index initial condition expression) "For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION." (` (let (( (, index) (, initial)) (sum 0)) (while (, condition) (setq sum (+ sum (, expression) )) (setq (, index) (1+ (, index)))) sum))) ;; The following are in-line for speed; they can be called thousands of times ;; when looking up holidays or processing the diary. Here, for example, are ;; the numbers of calls to calendar/diary/holiday functions in preparing the ;; fancy diary display, for a moderately complex diary file, with functions ;; used instead of macros. There were a total of 10000 such calls: ;; ;; 1934 extract-calendar-month ;; 1852 extract-calendar-year ;; 1819 extract-calendar-day ;; 845 calendar-leap-year-p ;; 837 calendar-day-number ;; 775 calendar-absolute-from-gregorian ;; 346 calendar-last-day-of-month ;; 286 hebrew-calendar-last-day-of-month ;; 188 hebrew-calendar-leap-year-p ;; 180 hebrew-calendar-elapsed-days ;; 163 hebrew-calendar-last-month-of-year ;; 66 calendar-date-compare ;; 65 hebrew-calendar-days-in-year ;; 60 calendar-absolute-from-julian ;; 50 calendar-absolute-from-hebrew ;; 43 calendar-date-equal ;; 38 calendar-gregorian-from-absolute ;; . ;; . ;; . ;; ;; The use of these seven macros eliminates the overhead of 92% of the function ;; calls; it's faster this way. (defsubst extract-calendar-month (date) "Extract the month part of DATE which has the form (month day year)." (car date)) (defsubst extract-calendar-day (date) "Extract the day part of DATE which has the form (month day year)." (car (cdr date))) (defsubst extract-calendar-year (date) "Extract the year part of DATE which has the form (month day year)." (car (cdr (cdr date)))) (defsubst calendar-leap-year-p (year) "Returns t if YEAR is a Gregorian leap year." (and (zerop (% year 4)) (or (not (zerop (% year 100))) (zerop (% year 400))))) ;; The foregoing is a bit faster, but not as clear as the following: ;; ;;(defsubst calendar-leap-year-p (year) ;; "Returns t if YEAR is a Gregorian leap year." ;; (or ;; (and (= (% year 4) 0) ;; (/= (% year 100) 0)) ;; (= (% year 400) 0))) (defsubst calendar-last-day-of-month (month year) "The last day in MONTH during YEAR." (if (and (= month 2) (calendar-leap-year-p year)) 29 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month)))) ;; An explanation of the calculation can be found in PascAlgorithms by ;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988. (defsubst calendar-day-number (date) "Return the day number within the year of the date DATE. For example, (calendar-day-number '(1 1 1987)) returns the value 1, while (calendar-day-number '(12 31 1980)) returns 366." (let* ((month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date)) (day-of-year (+ day (* 31 (1- month))))) (if (> month 2) (progn (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10))) (if (calendar-leap-year-p year) (setq day-of-year (1+ day-of-year))))) day-of-year)) (defsubst calendar-absolute-from-gregorian (date) "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. The Gregorian date Sunday, December 31, 1 BC is imaginary." (let ((prior-years (1- (extract-calendar-year date)))) (+ (calendar-day-number date);; Days this year (* 365 prior-years);; + Days in prior years (/ prior-years 4);; + Julian leap years (- (/ prior-years 100));; - century years (/ prior-years 400))));; + Gregorian leap years (autoload 'calendar-goto-today "cal-move" "Reposition the calendar window so the current date is visible." t) (autoload 'calendar-forward-month "cal-move" "Move the cursor forward ARG months." t) (autoload 'calendar-forward-year "cal-move" "Move the cursor forward by ARG years." t) (autoload 'calendar-backward-month "cal-move" "Move the cursor backward by ARG months." t) (autoload 'calendar-backward-year "cal-move" "Move the cursor backward ARG years." t) (autoload 'scroll-calendar-left "cal-move" "Scroll the displayed calendar left by ARG months." t) (autoload 'scroll-calendar-right "cal-move" "Scroll the displayed calendar window right by ARG months." t) (autoload 'scroll-calendar-left-three-months "cal-move" "Scroll the displayed calendar window left by 3*ARG months." t) (autoload 'scroll-calendar-right-three-months "cal-move" "Scroll the displayed calendar window right by 3*ARG months." t) (autoload 'calendar-cursor-to-nearest-date "cal-move" "Move the cursor to the closest date." t) (autoload 'calendar-forward-day "cal-move" "Move the cursor forward ARG days." t) (autoload 'calendar-backward-day "cal-move" "Move the cursor back ARG days." t) (autoload 'calendar-forward-week "cal-move" "Move the cursor forward ARG weeks." t) (autoload 'calendar-backward-week "cal-move" "Move the cursor back ARG weeks." t) (autoload 'calendar-beginning-of-week "cal-move" "Move the cursor back ARG calendar-week-start-day's." t) (autoload 'calendar-end-of-week "cal-move" "Move the cursor forward ARG calendar-week-start-day+6's." t) (autoload 'calendar-beginning-of-month "cal-move" "Move the cursor backward ARG month beginnings." t) (autoload 'calendar-end-of-month "cal-move" "Move the cursor forward ARG month ends." t) (autoload 'calendar-beginning-of-year "cal-move" "Move the cursor backward ARG year beginnings." t) (autoload 'calendar-end-of-year "cal-move" "Move the cursor forward ARG year beginnings." t) (autoload 'calendar-cursor-to-visible-date "cal-move" "Move the cursor to DATE that is on the screen." t) (autoload 'calendar-goto-date "cal-move" "Move cursor to DATE." t) (autoload 'calendar-one-frame-setup "cal-x" "Start calendar and display it in a dedicated frame together with the diary.") (autoload 'calendar-two-frame-setup "cal-x" "Start calendar and diary in separate, dedicated frames.") ;;;###autoload (defvar calendar-setup nil "The frame set up of the calendar. The choices are `one-frame' (calendar and diary together in one separate, dediciated frame) or `two-frames' (calendar and diary in separate, dedicated frames); with any other value the current frame is used.") ;;;###autoload (defun calendar (&optional arg) "Choose between the one frame, two frame, or basic calendar displays. The original function `calendar' has been renamed `calendar-basic-setup'." (interactive "P") (cond ((equal calendar-setup 'one-frame) (calendar-one-frame-setup arg)) ((equal calendar-setup 'two-frames) (calendar-two-frame-setup arg)) (t (calendar-basic-setup arg)))) (defun calendar-basic-setup (&optional arg) "Display a three-month calendar in another window. The three months appear side by side, with the current month in the middle surrounded by the previous and next months. The cursor is put on today's date. If called with an optional prefix argument, prompts for month and year. This function is suitable for execution in a .emacs file; appropriate setting of the variable `view-diary-entries-initially' will cause the diary entries for the current date to be displayed in another window. The value of the variable `number-of-diary-entries' controls the number of days of diary entries displayed upon initial display of the calendar. An optional prefix argument ARG causes the calendar displayed to be ARG months in the future if ARG is positive or in the past if ARG is negative; in this case the cursor goes on the first day of the month. Once in the calendar window, future or past months can be moved into view. Arbitrary months can be displayed, or the calendar can be scrolled forward or backward. The cursor can be moved forward or backward by one day, one week, one month, or one year. All of these commands take prefix arguments which, when negative, cause movement in the opposite direction. For convenience, the digit keys and the minus sign are automatically prefixes. The window is replotted as necessary to display the desired date. Diary entries can be marked on the calendar or displayed in another window. Use M-x describe-mode for details of the key bindings in the calendar window. The Gregorian calendar is assumed. After loading the calendar, the hooks given by the variable `calendar-load-hook' are run. This is the place to add key bindings to the calendar-mode-map. After preparing the calendar window initially, the hooks given by the variable `initial-calendar-window-hook' are run. The hooks given by the variable `today-visible-calendar-hook' are run everytime the calendar window gets scrolled, if the current date is visible in the window. If it is not visible, the hooks given by the variable `today-invisible-calendar-hook' are run. Thus, for example, setting `today-visible-calendar-hook' to 'calendar-star-date will cause today's date to be replaced by asterisks to highlight it whenever it is in the window." (interactive "P") (set-buffer (get-buffer-create calendar-buffer)) (calendar-mode) (let* ((pop-up-windows t) (split-height-threshold 1000) (date (if arg (calendar-read-date t) (calendar-current-date))) (month (extract-calendar-month date)) (year (extract-calendar-year date))) (pop-to-buffer calendar-buffer) (increment-calendar-month month year (- calendar-offset)) (generate-calendar-window month year) (if (and view-diary-entries-initially (calendar-date-is-visible-p date)) (view-diary-entries (if (vectorp number-of-diary-entries) (aref number-of-diary-entries (calendar-day-of-week date)) number-of-diary-entries)))) (let* ((diary-buffer (get-file-buffer diary-file)) (diary-window (if diary-buffer (get-buffer-window diary-buffer))) (split-height-threshold (if diary-window 2 1000))) (if view-calendar-holidays-initially (list-calendar-holidays))) (run-hooks 'initial-calendar-window-hook)) (autoload 'view-diary-entries "diary-lib" "Prepare and display a buffer with diary entries. Searches your diary file for entries that match ARG days starting with the date indicated by the cursor position in the displayed three-month calendar." t) (autoload 'calendar-sunrise-sunset "solar" "Local time of sunrise and sunset for date under cursor." t) (autoload 'calendar-phases-of-moon "lunar" "Create a buffer of the phases of the moon for the current calendar window." t) (autoload 'calendar-print-french-date "cal-french" "Show the French Revolutionary calendar equivalent of the date under the cursor." t) (autoload 'calendar-goto-french-date "cal-french" "Move cursor to French Revolutionary date." t) (autoload 'calendar-french-date-string "cal-french" "String of French Revolutionary date of Gregorian date." t) (autoload 'calendar-mayan-date-string "cal-mayan" "String of Mayan date of Gregorian date." t) (autoload 'calendar-print-mayan-date "cal-mayan" "Show the Mayan long count, Tzolkin, and Haab equivalents of the date under the cursor." t) (autoload 'calendar-goto-mayan-long-count-date "cal-mayan" "Move cursor to Mayan long count date." t) (autoload 'calendar-next-haab-date "cal-mayan" "Move cursor to next instance of Mayan Haab date." t) (autoload 'calendar-previous-haab-date "cal-mayan" "Move cursor to previous instance of Mayan Haab date." t) (autoload 'calendar-next-tzolkin-date "cal-mayan" "Move cursor to next instance of Mayan Tzolkin date." t) (autoload 'calendar-previous-tzolkin-date "cal-mayan" "Move cursor to previous instance of Mayan Tzolkin date." t) (autoload 'calendar-next-calendar-round-date "cal-mayan" "Move cursor to next instance of Mayan Haab/Tzoklin combination." t) (autoload 'calendar-previous-calendar-round-date "cal-mayan" "Move cursor to previous instance of Mayan Haab/Tzoklin combination." t) (autoload 'calendar-goto-chinese-date "cal-chinese" "Move cursor to Chinese date date." t) (autoload 'calendar-print-chinese-date "cal-chinese" "Show the Chinese date equivalents of date." t) (autoload 'calendar-chinese-date-string "cal-chinese" "String of Chinese date of Gregorian date." t) (autoload 'calendar-julian-from-absolute "cal-julian" "Compute the Julian (month day year) corresponding to the absolute DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC.") (autoload 'calendar-goto-julian-date "cal-julian" "Move cursor to Julian DATE; echo Julian date unless NOECHO is t." t) (autoload 'calendar-julian-date-string "cal-julian" "String of Julian date of Gregorian DATE. Defaults to today's date if DATE is not given. Driven by the variable `calendar-date-display-form'." t) (autoload 'calendar-goto-iso-date "cal-iso" "Move cursor to ISO date." t) (autoload 'calendar-print-iso-date "cal-iso" "Show the ISO date equivalents of date." t) (autoload 'calendar-iso-date-string "cal-iso" "String of ISO date of Gregorian date." t) (autoload 'calendar-print-islamic-date "cal-islamic" "Show the Islamic date equivalents of date." t) (autoload 'calendar-islamic-date-string "cal-islamic" "String of Islamic date of Gregorian date." t) (autoload 'calendar-goto-hebrew-date "cal-hebrew" "Move cursor to Hebrew date date." t) (autoload 'calendar-print-hebrew-date "cal-hebrew" "Show the Hebrew date equivalents of date." t) (autoload 'calendar-hebrew-date-string "cal-hebrew" "String of Hebrew date of Gregorian date." t) (autoload 'calendar-goto-coptic-date "cal-coptic" "Move cursor to Coptic date date." t) (autoload 'calendar-print-coptic-date "cal-coptic" "Show the Coptic date equivalents of date." t) (autoload 'calendar-coptic-date-string "cal-coptic" "String of Coptic date of Gregorian date." t) (autoload 'calendar-goto-ethiopic-date "cal-coptic" "Move cursor to Ethiopic date date." t) (autoload 'calendar-print-ethiopic-date "cal-coptic" "Show the Ethiopic date equivalents of date." t) (autoload 'calendar-ethiopic-date-string "cal-coptic" "String of Ethiopic date of Gregorian date." t) (autoload 'show-all-diary-entries "diary-lib" "Show all of the diary entries in the diary file. This function gets rid of the selective display of the diary file so that all entries, not just some, are visible. If there is no diary buffer, one is created." t) (autoload 'mark-diary-entries "diary-lib" "Mark days in the calendar window that have diary entries. Each entry in diary file visible in the calendar window is marked." t) (autoload 'make-diary-entry "diary-lib" "Insert a diary entry STRING which may be NONMARKING in FILE." t) (autoload 'insert-diary-entry "diary-lib" "Insert a diary entry for the date indicated by point." t) (autoload 'insert-weekly-diary-entry "diary-lib" "Insert a weekly diary entry for the day of the week indicated by point." t) (autoload 'insert-monthly-diary-entry "diary-lib" "Insert a monthly diary entry for the day of the month indicated by point." t) (autoload 'insert-yearly-diary-entry "diary-lib" "Insert an annual diary entry for the day of the year indicated by point." t) (autoload 'insert-anniversary-diary-entry "diary-lib" "Insert an anniversary diary entry for the date indicated by point." t) (autoload 'insert-block-diary-entry "diary-lib" "Insert a block diary entry for the dates indicated by point and mark." t) (autoload 'insert-cyclic-diary-entry "diary-lib" "Insert a cyclic diary entry starting at the date indicated by point." t) (autoload 'insert-hebrew-diary-entry "cal-hebrew" "Insert a diary entry for the Hebrew date corresponding to the date indicated by point." t) (autoload 'insert-monthly-hebrew-diary-entry "cal-hebrew" "Insert a monthly diary entry for the day of the Hebrew month corresponding to the date indicated by point." t) (autoload 'insert-yearly-hebrew-diary-entry "cal-hebrew" "Insert an annual diary entry for the day of the Hebrew year corresponding to the date indicated by point." t) (autoload 'insert-islamic-diary-entry "cal-islamic" "Insert a diary entry for the Islamic date corresponding to the date indicated by point." t) (autoload 'insert-monthly-islamic-diary-entry "cal-islamic" "Insert a monthly diary entry for the day of the Islamic month corresponding to the date indicated by point." t) (autoload 'insert-yearly-islamic-diary-entry "cal-islamic" "Insert an annual diary entry for the day of the Islamic year corresponding to the date indicated by point." t) (autoload 'list-calendar-holidays "holidays" "Create a buffer containing the holidays for the current calendar window. The holidays are those in the list `calendar-notable-days'. Returns t if any holidays are found, nil if not." t) (autoload 'cal-tex-cursor-month "cal-tex" "Make a buffer with LaTeX commands for the month cursor is on. Optional prefix argument specifies number of months to be produced. Calendar is condensed onto one page.") (autoload 'cal-tex-cursor-month-landscape "cal-tex" "Make a buffer with LaTeX commands for the month cursor is on. Optional prefix argument specifies number of months to be produced.") (autoload 'cal-tex-cursor-day "cal-tex" "Make a buffer with LaTeX commands for the day cursor is on.") (autoload 'cal-tex-cursor-week "cal-tex" "Make a buffer with LaTeX commands for a two-page one-week calendar. It applies to the week that point is in. Optional prefix argument specifies number of weeks. Holidays are included if `cal-tex-holidays' is t.") (autoload 'cal-tex-cursor-week2 "cal-tex" "Make a buffer with LaTeX commands for a two-page one-week calendar. It applies to the week that point is in. Optional prefix argument specifies number of weeks. Holidays are included if `cal-tex-holidays' is t.") (autoload 'cal-tex-cursor-week-iso "cal-tex" "Make a buffer with LaTeX commands for a one page ISO-style weekly calendar. Optional prefix argument specifies number of weeks. Diary entries are included if `cal-tex-diary' is t. Holidays are included if `cal-tex-holidays' is t.") (autoload 'cal-tex-cursor-week-monday "cal-tex" "Make a buffer with LaTeX commands for a two-page one-week calendar. It applies to the week that point is in, and starts on Monday. Optional prefix argument specifies number of weeks. Holidays are included if `cal-tex-holidays' is t.") (autoload 'cal-tex-cursor-filofax-2week "cal-tex" "Two-weeks-at-a-glance Filofax style calendar for week indicated by cursor. Optional prefix argument specifies number of weeks. Diary entries are included if cal-tex-diary is t. Holidays are included if `cal-tex-holidays' is t.") (autoload 'cal-tex-cursor-filofax-week "cal-tex" "One-week-at-a-glance Filofax style calendar for week indicated by cursor. Optional prefix argument specifies number of weeks. Weeks start on Monday. Diary entries are included if cal-tex-diary is t. Holidays are included if `cal-tex-holidays' is t.") (autoload 'cal-tex-cursor-year "cal-tex" "Make a buffer with LaTeX commands for a year's calendar. Optional prefix argument specifies numeber of years.") (autoload 'cal-tex-cursor-year-landscape "cal-tex" "Make a buffer with LaTeX commands for a year's calendar (landscape). Optional prefix argument specifies number of years.") (autoload 'cal-tex-cursor-filofax-year "cal-tex" "Make a buffer with LaTeX commands for a year's calendar (Filofax). Optional prefix argument specifies number of years.") (autoload 'mark-calendar-holidays "holidays" "Mark notable days in the calendar window." t) (autoload 'calendar-cursor-holidays "holidays" "Find holidays for the date specified by the cursor in the calendar window." t) (defun generate-calendar-window (&optional mon yr) "Generate the calendar window for the current date. Or, for optional MON, YR." (let* ((buffer-read-only nil) (today (calendar-current-date)) (month (extract-calendar-month today)) (day (extract-calendar-day today)) (year (extract-calendar-year today)) (today-visible (or (not mon) (let ((offset (calendar-interval mon yr month year))) (and (<= offset 1) (>= offset -1))))) (day-in-week (calendar-day-of-week today))) (update-calendar-mode-line) (if mon (generate-calendar mon yr) (generate-calendar month year)) (calendar-cursor-to-visible-date (if today-visible today (list displayed-month 1 displayed-year))) (set-buffer-modified-p nil) (or (one-window-p t) (/= (frame-width) (window-width)) (shrink-window (- (window-height) 9))) (sit-for 0) (and mark-holidays-in-calendar (mark-calendar-holidays) (sit-for 0)) (unwind-protect (if mark-diary-entries-in-calendar (mark-diary-entries)) (if today-visible (run-hooks 'today-visible-calendar-hook) (run-hooks 'today-invisible-calendar-hook))))) (defun generate-calendar (month year) "Generate a three-month Gregorian calendar centered around MONTH, YEAR." (if (< (+ month (* 12 (1- year))) 2) (error "Months before February, 1 AD are not available.")) (setq displayed-month month) (setq displayed-year year) (erase-buffer) (increment-calendar-month month year -1) (calendar-for-loop i from 0 to 2 do (generate-calendar-month month year (+ 5 (* 25 i))) (increment-calendar-month month year 1))) (defun generate-calendar-month (month year indent) "Produce a calendar for MONTH, YEAR on the Gregorian calendar. The calendar is inserted in the buffer starting at the line on which point is currently located, but indented INDENT spaces. The indentation is done from the first character on the line and does not disturb the first INDENT characters on the line." (let* ((blank-days;; at start of month (mod (- (calendar-day-of-week (list month 1 year)) calendar-week-start-day) 7)) (last (calendar-last-day-of-month month year))) (goto-char (point-min)) (calendar-insert-indented (calendar-string-spread (list (format "%s %d" (calendar-month-name month) year)) ? 20) indent t) (calendar-insert-indented "" indent);; Go to proper spot (calendar-for-loop i from 0 to 6 do (insert (substring (aref calendar-day-name-array (mod (+ calendar-week-start-day i) 7)) 0 2)) (insert " ")) (calendar-insert-indented "" 0 t);; Force onto following line (calendar-insert-indented "" indent);; Go to proper spot ;; Add blank days before the first of the month (calendar-for-loop i from 1 to blank-days do (insert " ")) ;; Put in the days of the month (calendar-for-loop i from 1 to last do (insert (format "%2d " i)) (put-text-property (- (point) 3) (1- (point)) 'mouse-face 'highlight) (and (zerop (mod (+ i blank-days) 7)) (/= i last) (calendar-insert-indented "" 0 t) ;; Force onto following line (calendar-insert-indented "" indent)))));; Go to proper spot (defun calendar-insert-indented (string indent &optional newline) "Insert STRING at column INDENT. If the optional parameter NEWLINE is t, leave point at start of next line, inserting a newline if there was no next line; otherwise, leave point after the inserted text. Value is always t." ;; Try to move to that column. (move-to-column indent) ;; If line is too short, indent out to that column. (if (< (current-column) indent) (indent-to indent)) (insert string) ;; Advance to next line, if requested. (if newline (progn (end-of-line) (if (eobp) (newline) (forward-line 1)))) t) (defun redraw-calendar () "Redraw the calendar display." (interactive) (let ((cursor-date (calendar-cursor-to-date))) (generate-calendar-window displayed-month displayed-year) (calendar-cursor-to-visible-date cursor-date))) (defvar calendar-debug-sexp nil "*Turn debugging on when evaluating a sexp in the diary or holiday list.") (defvar calendar-mode-map nil) (if calendar-mode-map nil (setq calendar-mode-map (make-sparse-keymap)) (if window-system (require 'cal-menu)) (calendar-for-loop i from 0 to 9 do (define-key calendar-mode-map (int-to-string i) 'digit-argument)) (let ((l (list 'narrow-to-region 'mark-word 'mark-sexp 'mark-paragraph 'mark-defun 'mark-whole-buffer 'mark-page 'downcase-region 'upcase-region 'kill-region 'copy-region-as-kill 'capitalize-region 'write-region))) (while l (substitute-key-definition (car l) 'calendar-not-implemented calendar-mode-map global-map) (setq l (cdr l)))) (define-key calendar-mode-map "-" 'negative-argument) (define-key calendar-mode-map "\C-x>" 'scroll-calendar-right) (define-key calendar-mode-map [prior] 'scroll-calendar-right-three-months) (define-key calendar-mode-map "\ev" 'scroll-calendar-right-three-months) (define-key calendar-mode-map "\C-x<" 'scroll-calendar-left) (define-key calendar-mode-map [next] 'scroll-calendar-left-three-months) (define-key calendar-mode-map "\C-v" 'scroll-calendar-left-three-months) (define-key calendar-mode-map "\C-b" 'calendar-backward-day) (define-key calendar-mode-map "\C-p" 'calendar-backward-week) (define-key calendar-mode-map "\e{" 'calendar-backward-month) (define-key calendar-mode-map "\C-x[" 'calendar-backward-year) (define-key calendar-mode-map "\C-f" 'calendar-forward-day) (define-key calendar-mode-map "\C-n" 'calendar-forward-week) (define-key calendar-mode-map [left] 'calendar-backward-day) (define-key calendar-mode-map [up] 'calendar-backward-week) (define-key calendar-mode-map [right] 'calendar-forward-day) (define-key calendar-mode-map [down] 'calendar-forward-week) (define-key calendar-mode-map "\e}" 'calendar-forward-month) (define-key calendar-mode-map "\C-x]" 'calendar-forward-year) (define-key calendar-mode-map "\C-a" 'calendar-beginning-of-week) (define-key calendar-mode-map "\C-e" 'calendar-end-of-week) (define-key calendar-mode-map "\ea" 'calendar-beginning-of-month) (define-key calendar-mode-map "\ee" 'calendar-end-of-month) (define-key calendar-mode-map "\e<" 'calendar-beginning-of-year) (define-key calendar-mode-map "\e>" 'calendar-end-of-year) (define-key calendar-mode-map "\C-@" 'calendar-set-mark) ;; Many people are used to typing C-SPC and getting C-@. (define-key calendar-mode-map [?\C-\ ] 'calendar-set-mark) (define-key calendar-mode-map "\C-x\C-x" 'calendar-exchange-point-and-mark) (define-key calendar-mode-map "\e=" 'calendar-count-days-region) (define-key calendar-mode-map "gd" 'calendar-goto-date) (define-key calendar-mode-map "gj" 'calendar-goto-julian-date) (define-key calendar-mode-map "ga" 'calendar-goto-astro-day-number) (define-key calendar-mode-map "gh" 'calendar-goto-hebrew-date) (define-key calendar-mode-map "gi" 'calendar-goto-islamic-date) (define-key calendar-mode-map "gC" 'calendar-goto-chinese-date) (define-key calendar-mode-map "gk" 'calendar-goto-coptic-date) (define-key calendar-mode-map "ge" 'calendar-goto-ethiopic-date) (define-key calendar-mode-map "gc" 'calendar-goto-iso-date) (define-key calendar-mode-map "gf" 'calendar-goto-french-date) (define-key calendar-mode-map "gml" 'calendar-goto-mayan-long-count-date) (define-key calendar-mode-map "gmpc" 'calendar-previous-calendar-round-date) (define-key calendar-mode-map "gmnc" 'calendar-next-calendar-round-date) (define-key calendar-mode-map "gmph" 'calendar-previous-haab-date) (define-key calendar-mode-map "gmnh" 'calendar-next-haab-date) (define-key calendar-mode-map "gmpt" 'calendar-previous-tzolkin-date) (define-key calendar-mode-map "gmnt" 'calendar-next-tzolkin-date) (define-key calendar-mode-map "S" 'calendar-sunrise-sunset) (define-key calendar-mode-map "M" 'calendar-phases-of-moon) (define-key calendar-mode-map " " 'scroll-other-window) (define-key calendar-mode-map "\C-c\C-l" 'redraw-calendar) (define-key calendar-mode-map "." 'calendar-goto-today) (define-key calendar-mode-map "o" 'calendar-other-month) (define-key calendar-mode-map "q" 'exit-calendar) (define-key calendar-mode-map "a" 'list-calendar-holidays) (define-key calendar-mode-map "h" 'calendar-cursor-holidays) (define-key calendar-mode-map "x" 'mark-calendar-holidays) (define-key calendar-mode-map "u" 'calendar-unmark) (define-key calendar-mode-map "m" 'mark-diary-entries) (define-key calendar-mode-map "d" 'view-diary-entries) (define-key calendar-mode-map "D" 'view-other-diary-entries) (define-key calendar-mode-map "s" 'show-all-diary-entries) (define-key calendar-mode-map "pd" 'calendar-print-day-of-year) (define-key calendar-mode-map "pC" 'calendar-print-chinese-date) (define-key calendar-mode-map "pk" 'calendar-print-coptic-date) (define-key calendar-mode-map "pe" 'calendar-print-ethiopic-date) (define-key calendar-mode-map "pc" 'calendar-print-iso-date) (define-key calendar-mode-map "pj" 'calendar-print-julian-date) (define-key calendar-mode-map "pa" 'calendar-print-astro-day-number) (define-key calendar-mode-map "ph" 'calendar-print-hebrew-date) (define-key calendar-mode-map "pi" 'calendar-print-islamic-date) (define-key calendar-mode-map "pf" 'calendar-print-french-date) (define-key calendar-mode-map "pm" 'calendar-print-mayan-date) (define-key calendar-mode-map "id" 'insert-diary-entry) (define-key calendar-mode-map "iw" 'insert-weekly-diary-entry) (define-key calendar-mode-map "im" 'insert-monthly-diary-entry) (define-key calendar-mode-map "iy" 'insert-yearly-diary-entry) (define-key calendar-mode-map "ia" 'insert-anniversary-diary-entry) (define-key calendar-mode-map "ib" 'insert-block-diary-entry) (define-key calendar-mode-map "ic" 'insert-cyclic-diary-entry) (define-key calendar-mode-map "ihd" 'insert-hebrew-diary-entry) (define-key calendar-mode-map "ihm" 'insert-monthly-hebrew-diary-entry) (define-key calendar-mode-map "ihy" 'insert-yearly-hebrew-diary-entry) (define-key calendar-mode-map "iid" 'insert-islamic-diary-entry) (define-key calendar-mode-map "iim" 'insert-monthly-islamic-diary-entry) (define-key calendar-mode-map "iiy" 'insert-yearly-islamic-diary-entry) (define-key calendar-mode-map "?" 'calendar-goto-info-node) (define-key calendar-mode-map "tm" 'cal-tex-cursor-month) (define-key calendar-mode-map "tM" 'cal-tex-cursor-month-landscape) (define-key calendar-mode-map "td" 'cal-tex-cursor-day) (define-key calendar-mode-map "tw1" 'cal-tex-cursor-week) (define-key calendar-mode-map "tw2" 'cal-tex-cursor-week2) (define-key calendar-mode-map "tw3" 'cal-tex-cursor-week-iso) (define-key calendar-mode-map "tw4" 'cal-tex-cursor-week-monday) (define-key calendar-mode-map "tfw" 'cal-tex-cursor-filofax-2week) (define-key calendar-mode-map "tfW" 'cal-tex-cursor-filofax-week) (define-key calendar-mode-map "tfy" 'cal-tex-cursor-filofax-year) (define-key calendar-mode-map "ty" 'cal-tex-cursor-year) (define-key calendar-mode-map "tY" 'cal-tex-cursor-year-landscape)) (defun describe-calendar-mode () "Create a help buffer with a brief description of the calendar-mode." (interactive) (with-output-to-temp-buffer "*Help*" (princ (format "Calendar Mode:\nFor a complete description, type %s\n%s\n" (substitute-command-keys "\\\\[describe-mode] from within the calendar") (substitute-command-keys "\\{calendar-mode-map}"))) (save-excursion (set-buffer standard-output) (help-mode)) (print-help-return-message))) ;; Calendar mode is suitable only for specially formatted data. (put 'calendar-mode 'mode-class 'special) (defvar calendar-mode-line-format (list (substitute-command-keys "\\\\[scroll-calendar-left]") "Calendar" (substitute-command-keys "\\\\[calendar-goto-info-node] info/\\[calendar-other-month] other/\\[calendar-goto-today] today") '(calendar-date-string (calendar-current-date) t) (substitute-command-keys "\\\\[scroll-calendar-right]")) "The mode line of the calendar buffer.") (defun calendar-goto-info-node () "Go to the info node for the calendar." (interactive) (require 'info) (let ((where (save-window-excursion (Info-find-emacs-command-nodes 'calendar)))) (if (not where) (error "Couldn't find documentation for the calendar.") (let (same-window-buffer-names) (info)) (Info-find-node (car (car where)) (car (cdr (car where))))))) (defun calendar-mode () "A major mode for the calendar window. For a complete description, type \ \\\\[calendar-goto-info-node] from within the calendar. \\\\{calendar-mode-map}" (kill-all-local-variables) (setq major-mode 'calendar-mode) (setq mode-name "Calendar") (use-local-map calendar-mode-map) (setq buffer-read-only t) (setq indent-tabs-mode nil) (update-calendar-mode-line) (make-local-variable 'calendar-mark-ring) (make-local-variable 'displayed-month);; Month in middle of window. (make-local-variable 'displayed-year));; Year in middle of window. (defun calendar-string-spread (strings char length) "Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH. The effect is like mapconcat but the separating pieces are as balanced as possible. Each item of STRINGS is evaluated before concatenation so it can actually be an expression that evaluates to a string. If LENGTH is too short, the STRINGS are just concatenated and the result truncated." ;; The algorithm is based on equation (3.25) on page 85 of Concrete ;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik, ;; Addison-Wesley, Reading, MA, 1989 (let* ((strings (mapcar 'eval (if (< (length strings) 2) (append (list "") strings (list "")) strings))) (n (- length (length (apply 'concat strings)))) (m (1- (length strings))) (s (car strings)) (strings (cdr strings)) (i 0)) (while strings (setq s (concat s (make-string (max 0 (/ (+ n i) m)) char) (car strings))) (setq i (1+ i)) (setq strings (cdr strings))) (substring s 0 length))) (defun update-calendar-mode-line () "Update the calendar mode line with the current date and date style." (if (bufferp (get-buffer calendar-buffer)) (save-excursion (set-buffer calendar-buffer) (setq mode-line-format (calendar-string-spread calendar-mode-line-format ? (frame-width)))))) (defun calendar-window-list () "List of all calendar-related windows." (let ((calendar-buffers (calendar-buffer-list)) list) (walk-windows '(lambda (w) (if (memq (window-buffer w) calendar-buffers) (setq list (cons w list)))) nil t) list)) (defun calendar-buffer-list () "List of all calendar-related buffers." (let* ((diary-buffer (get-file-buffer diary-file)) (buffers (list "*Yahrzeits*" lunar-phases-buffer holiday-buffer fancy-diary-buffer diary-buffer calendar-buffer)) (buffer-list nil) b) (while buffers (setq b (car buffers)) (setq b (cond ((stringp b) (get-buffer b)) ((bufferp b) b) (t nil))) (if b (setq buffer-list (cons b buffer-list))) (setq buffers (cdr buffers))) buffer-list)) (defun exit-calendar () "Get out of the calendar window and hide it and related buffers." (interactive) (let* ((diary-buffer (get-file-buffer diary-file))) (if (and diary-buffer (buffer-modified-p diary-buffer) (not (yes-or-no-p "Diary modified; do you really want to exit the calendar? "))) (error) ;; Need to do this multiple times because one time can replace some ;; calendar-related buffers with other calendar-related buffers (mapcar (lambda (x) (mapcar 'calendar-hide-window (calendar-window-list))) (calendar-window-list))))) (defun calendar-hide-window (window) "Hide WINDOW if it is calendar-related." (let ((buffer (if (window-live-p window) (window-buffer window)))) (if (memq buffer (calendar-buffer-list)) (cond ((and window-system (eq 'icon (cdr (assoc 'visibility (frame-parameters (window-frame window)))))) nil) ((and window-system (window-dedicated-p window)) (iconify-frame (window-frame window))) ((not (and (select-window window) (one-window-p window))) (delete-window window)) (t (set-buffer buffer) (bury-buffer)))))) (defun calendar-current-date () "Returns the current date in a list (month day year)." (let ((s (current-time-string))) (list (length (member (substring s 4 7) '("Dec" "Nov" "Oct" "Sep" "Aug" "Jul" "Jun" "May" "Apr" "Mar" "Feb" "Jan"))) (string-to-number (substring s 8 10)) (string-to-number (substring s 20 24))))) (defun calendar-cursor-to-date (&optional error) "Returns a list (month day year) of current cursor position. If cursor is not on a specific date, signals an error if optional parameter ERROR is t, otherwise just returns nil." (let* ((segment (/ (current-column) 25)) (month (% (+ displayed-month segment -1) 12)) (month (if (= 0 month) 12 month)) (year (cond ((and (= 12 month) (= segment 0)) (1- displayed-year)) ((and (= 1 month) (= segment 2)) (1+ displayed-year)) (t displayed-year)))) (if (and (looking-at "[ 0-9]?[0-9][^0-9]") (< 2 (count-lines (point-min) (point)))) (save-excursion (if (not (looking-at " ")) (re-search-backward "[^0-9]")) (list month (string-to-int (buffer-substring (1+ (point)) (+ 4 (point)))) year)) (if (looking-at "\\*") (save-excursion (re-search-backward "[^*]") (if (looking-at ".\\*\\*") (list month calendar-starred-day year) (if error (error "Not on a date!")))) (if error (error "Not on a date!")))))) ;; The following version of calendar-gregorian-from-absolute is preferred for ;; reasons of clarity, BUT it's much slower than the version that follows it. ;;(defun calendar-gregorian-from-absolute (date) ;; "Compute the list (month day year) corresponding to the absolute DATE. ;;The absolute date is the number of days elapsed since the (imaginary) ;;Gregorian date Sunday, December 31, 1 BC." ;; (let* ((approx (/ date 366));; Approximation from below. ;; (year ;; Search forward from the approximation. ;; (+ approx ;; (calendar-sum y approx ;; (>= date (calendar-absolute-from-gregorian (list 1 1 (1+ y)))) ;; 1))) ;; (month ;; Search forward from January. ;; (1+ (calendar-sum m 1 ;; (> date ;; (calendar-absolute-from-gregorian ;; (list m (calendar-last-day-of-month m year) year))) ;; 1))) ;; (day ;; Calculate the day by subtraction. ;; (- date ;; (1- (calendar-absolute-from-gregorian (list month 1 year)))))) ;; (list month day year))) (defun calendar-gregorian-from-absolute (date) "Compute the list (month day year) corresponding to the absolute DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." ;; See the footnote on page 384 of ``Calendrical Calculations, Part II: ;; Three Historical Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. ;; Clamen, Software--Practice and Experience, Volume 23, Number 4 ;; (April, 1993), pages 383-404 for an explanation. (let* ((d0 (1- date)) (n400 (/ d0 146097)) (d1 (% d0 146097)) (n100 (/ d1 36524)) (d2 (% d1 36524)) (n4 (/ d2 1461)) (d3 (% d2 1461)) (n1 (/ d3 365)) (day (1+ (% d3 365))) (year (+ (* 400 n400) (* 100 n100) (* n4 4) n1))) (if (or (= n100 4) (= n1 4)) (list 12 31 year) (let ((year (1+ year)) (month 1)) (while (let ((mdays (calendar-last-day-of-month month year))) (and (< mdays day) (setq day (- day mdays)))) (setq month (1+ month))) (list month day year))))) (defun calendar-other-month (month year) "Display a three-month calendar centered around MONTH and YEAR." (interactive (calendar-read-date 'noday)) (if (and (= month displayed-month) (= year displayed-year)) nil (let ((old-date (calendar-cursor-to-date)) (today (calendar-current-date))) (generate-calendar-window month year) (calendar-cursor-to-visible-date (cond ((calendar-date-is-visible-p old-date) old-date) ((calendar-date-is-visible-p today) today) (t (list month 1 year))))))) (defun calendar-set-mark (arg) "Mark the date under the cursor, or jump to marked date. With no prefix argument, push current date onto marked date ring. With argument, jump to mark, pop it, and put point at end of ring." (interactive "P") (let ((date (calendar-cursor-to-date t))) (if (null arg) (progn (setq calendar-mark-ring (cons date calendar-mark-ring)) ;; Since the top of the mark ring is the marked date in the ;; calendar, the mark ring in the calendar is one longer than ;; in other buffers to get the same effect. (if (> (length calendar-mark-ring) (1+ mark-ring-max)) (setcdr (nthcdr mark-ring-max calendar-mark-ring) nil)) (message "Mark set")) (if (null calendar-mark-ring) (error "No mark set in this buffer") (calendar-goto-date (car calendar-mark-ring)) (setq calendar-mark-ring (cdr (nconc calendar-mark-ring (list date)))))))) (defun calendar-exchange-point-and-mark () "Exchange the current cursor position with the marked date." (interactive) (let ((mark (car calendar-mark-ring)) (date (calendar-cursor-to-date t))) (if (null mark) (error "No mark set in this buffer") (setq calendar-mark-ring (cons date (cdr calendar-mark-ring))) (calendar-goto-date mark)))) (defun calendar-count-days-region () "Count the number of days (inclusive) between point and the mark." (interactive) (let* ((days (- (calendar-absolute-from-gregorian (calendar-cursor-to-date t)) (calendar-absolute-from-gregorian (or (car calendar-mark-ring) (error "No mark set in this buffer"))))) (days (1+ (if (> days 0) days (- days))))) (message "Region has %d day%s (inclusive)" days (if (> days 1) "s" "")))) (defun calendar-not-implemented () "Not implemented." (interactive) (error "%s not available in the calendar" (global-key-binding (this-command-keys)))) (defun calendar-read (prompt acceptable &optional initial-contents) "Return an object read from the minibuffer. Prompt with the string PROMPT and use the function ACCEPTABLE to decide if entered item is acceptable. If non-nil, optional third arg INITIAL-CONTENTS is a string to insert in the minibuffer before reading." (let ((value (read-minibuffer prompt initial-contents))) (while (not (funcall acceptable value)) (setq value (read-minibuffer prompt initial-contents))) value)) (defun calendar-read-date (&optional noday) "Prompt for Gregorian date. Returns a list (month day year). If optional NODAY is t, does not ask for day, but just returns (month nil year); if NODAY is any other non-nil value the value returned is (month year) " (let* ((year (calendar-read "Year (>0): " '(lambda (x) (> x 0)) (int-to-string (extract-calendar-year (calendar-current-date))))) (month-array calendar-month-name-array) (completion-ignore-case t) (month (cdr (assoc (capitalize (completing-read "Month name: " (mapcar 'list (append month-array nil)) nil t)) (calendar-make-alist month-array 1 'capitalize)))) (last (calendar-last-day-of-month month year))) (if noday (if (eq noday t) (list month nil year) (list month year)) (list month (calendar-read (format "Day (1-%d): " last) '(lambda (x) (and (< 0 x) (<= x last)))) year)))) (defun calendar-interval (mon1 yr1 mon2 yr2) "The number of months difference between MON1, YR1 and MON2, YR2." (+ (* 12 (- yr2 yr1)) (- mon2 mon1))) (defun calendar-day-name (date) "Returns a string with the name of the day of the week of DATE." (aref calendar-day-name-array (calendar-day-of-week date))) (defvar calendar-day-name-array ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]) (defvar calendar-month-name-array ["January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December"]) (defun calendar-make-alist (sequence &optional start-index filter) "Make an assoc list corresponding to SEQUENCE. Start at index 1, unless optional START-INDEX is provided. If FILTER is provided, apply it to each item in the list." (let ((index (if start-index (1- start-index) 0))) (mapcar '(lambda (x) (setq index (1+ index)) (cons (if filter (funcall filter x) x) index)) (append sequence nil)))) (defun calendar-month-name (month) "The name of MONTH." (aref calendar-month-name-array (1- month))) (defun calendar-day-of-week (date) "Returns the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc." (% (calendar-absolute-from-gregorian date) 7)) (defun calendar-unmark () "Delete all diary/holiday marks/highlighting from the calendar." (interactive) (setq mark-holidays-in-calendar nil) (setq mark-diary-entries-in-calendar nil) (redraw-calendar)) (defun calendar-date-is-visible-p (date) "Returns t if DATE is legal and is visible in the calendar window." (let ((gap (calendar-interval displayed-month displayed-year (extract-calendar-month date) (extract-calendar-year date)))) (and (calendar-date-is-legal-p date) (> 2 gap) (< -2 gap)))) (defun calendar-date-is-legal-p (date) "Returns t if DATE is a legal date." (let ((month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date))) (and (<= 1 month) (<= month 12) (<= 1 day) (<= day (calendar-last-day-of-month month year)) (<= 1 year)))) (defun calendar-date-equal (date1 date2) "Returns t if the DATE1 and DATE2 are the same." (and (= (extract-calendar-month date1) (extract-calendar-month date2)) (= (extract-calendar-day date1) (extract-calendar-day date2)) (= (extract-calendar-year date1) (extract-calendar-year date2)))) (defun mark-visible-calendar-date (date &optional mark) "Mark DATE in the calendar window with MARK. MARK is either a single-character string or a face. MARK defaults to diary-entry-marker." (if (calendar-date-is-legal-p date) (save-excursion (set-buffer calendar-buffer) (calendar-cursor-to-visible-date date) (let ((mark (or mark diary-entry-marker))) (if (stringp mark) (let ((buffer-read-only nil)) (forward-char 1) (delete-char 1) (insert mark) (forward-char -2)) (overlay-put (make-overlay (1- (point)) (1+ (point))) 'face mark)))))) (defun calendar-star-date () "Replace the date under the cursor in the calendar window with asterisks. This function can be used with the today-visible-calendar-hook run after the calendar window has been prepared." (let ((buffer-read-only nil)) (make-variable-buffer-local 'calendar-starred-day) (forward-char 1) (setq calendar-starred-day (string-to-int (buffer-substring (point) (- (point) 2)))) (delete-char -2) (insert "**") (backward-char 1) (set-buffer-modified-p nil))) (defun calendar-mark-today () "Mark the date under the cursor in the calendar window. The date is marked with calendar-today-marker. This function can be used with the today-visible-calendar-hook run after the calendar window has been prepared." (mark-visible-calendar-date (calendar-cursor-to-date) calendar-today-marker)) (defun calendar-date-compare (date1 date2) "Returns t if DATE1 is before DATE2, nil otherwise. The actual dates are in the car of DATE1 and DATE2." (< (calendar-absolute-from-gregorian (car date1)) (calendar-absolute-from-gregorian (car date2)))) (defun calendar-date-string (date &optional abbreviate nodayname) "A string form of DATE, driven by the variable `calendar-date-display-form'. An optional parameter ABBREVIATE, when t, causes the month and day names to be abbreviated to three characters. An optional parameter NODAYNAME, when t, omits the name of the day of the week." (let* ((dayname (if nodayname nil (if abbreviate (substring (calendar-day-name date) 0 3) (calendar-day-name date)))) (month (extract-calendar-month date)) (monthname (if abbreviate (substring (calendar-month-name month) 0 3) (calendar-month-name month))) (day (int-to-string (extract-calendar-day date))) (month (int-to-string month)) (year (int-to-string (extract-calendar-year date)))) (mapconcat 'eval calendar-date-display-form ""))) (defun calendar-dayname-on-or-before (dayname date) "Returns the absolute date of the DAYNAME on or before absolute DATE. DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on. Note: Applying this function to d+6 gives us the DAYNAME on or after an absolute day d. Similarly, applying it to d+3 gives the DAYNAME nearest to absolute date d, applying it to d-1 gives the DAYNAME previous to absolute date d, and applying it to d+7 gives the DAYNAME following absolute date d." (- date (% (- date dayname) 7))) (defun calendar-nth-named-absday (n dayname month year &optional day) "The absolute date of Nth DAYNAME in MONTH, YEAR before/after optional DAY. A DAYNAME of 0 means Sunday, 1 means Monday, and so on. If N<0, return the Nth DAYNAME before MONTH DAY, YEAR (inclusive). If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive). If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise." (if (> n 0) (+ (* 7 (1- n)) (calendar-dayname-on-or-before dayname (+ 6 (calendar-absolute-from-gregorian (list month (or day 1) year))))) (+ (* 7 (1+ n)) (calendar-dayname-on-or-before dayname (calendar-absolute-from-gregorian (list month (or day (calendar-last-day-of-month month year)) year)))))) (defun calendar-nth-named-day (n dayname month year &optional day) "The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY. A DAYNAME of 0 means Sunday, 1 means Monday, and so on. If N<0, return the Nth DAYNAME before MONTH DAY, YEAR (inclusive). If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive). If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise." (calendar-gregorian-from-absolute (calendar-nth-named-absday n dayname month year day))) (defun calendar-day-of-year-string (&optional date) "String of day number of year of Gregorian DATE. Defaults to today's date if DATE is not given." (let* ((d (or date (calendar-current-date))) (year (extract-calendar-year d)) (day (calendar-day-number d)) (days-remaining (- (calendar-day-number (list 12 31 year)) day))) (format "Day %d of %d; %d day%s remaining in the year" day year days-remaining (if (= days-remaining 1) "" "s")))) (defun calendar-print-day-of-year () "Show day number in year/days remaining in year for date under the cursor." (interactive) (message (calendar-day-of-year-string (calendar-cursor-to-date t)))) (defun calendar-set-mode-line (str) "Set mode line to STR, centered, surrounded by dashes." (setq mode-line-format (calendar-string-spread (list str) ?- (frame-width)))) (defun calendar-mod (m n) "Non-negative remainder of M/N with N instead of 0." (1+ (mod (1- m) n))) (run-hooks 'calendar-load-hook) (provide 'calendar) ;;; calendar.el ends here emacs-19.30/lisp/case-table.el100444 12120 1 10303 6051205013 14376 0ustar rmsdaemon;;; case-table.el --- code to extend the character set and support case tables. ;; Copyright (C) 1988, 1994 Free Software Foundation, Inc. ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n ;; 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: ;; Written by: ;; TN/ETX/TX/UMG Howard Gayle UUCP : seismo!enea!erix!howard ;; Telefonaktiebolaget L M Ericsson Phone: +46 8 719 55 65 ;; Ericsson Telecom Telex: 14910 ERIC S ;; S-126 25 Stockholm FAX : +46 8 719 64 82 ;; Sweden ;;; Code: ;;;###autoload (defun describe-buffer-case-table () "Describe the case table of the current buffer." (interactive) (let ((description (make-char-table 'case-table))) (map-char-table (function (lambda (key value) (set-char-table-range description key (cond ((null key) "case-invariant") ((/= key (downcase key)) (concat "uppercase, matches " (char-to-string (downcase key)))) ((/= key (upcase key)) (concat "lowercase, matches " (char-to-string (upcase key)))) (t "case-invariant"))))) (current-case-table)) (save-excursion (with-output-to-temp-buffer "*Help*" (set-buffer standard-output) (describe-vector description) (help-mode))))) ;;;###autoload (defun copy-case-table (case-table) (let ((copy (copy-sequence case-table))) ;; Clear out the extra slots so that they will be ;; recomputed from the main (downcase) table. (set-char-table-extra-slot copy 0 nil) (set-char-table-extra-slot copy 1 nil) (set-char-table-extra-slot copy 2 nil) copy)) ;;;###autoload (defun set-case-syntax-delims (l r table) "Make characters L and R a matching pair of non-case-converting delimiters. This sets the entries for L and R in TABLE, which is a string that will be used as the downcase part of a case table. It also modifies `standard-syntax-table' to indicate left and right delimiters." (aset table l l) (aset table r r) ;; Clear out the extra slots so that they will be ;; recomputed from the main (downcase) table. (set-char-table-extra-slot table 0 nil) (set-char-table-extra-slot table 1 nil) (set-char-table-extra-slot table 2 nil) (modify-syntax-entry l (concat "(" (char-to-string r) " ") (standard-syntax-table)) (modify-syntax-entry r (concat ")" (char-to-string l) " ") (standard-syntax-table))) ;;;###autoload (defun set-case-syntax-pair (uc lc table) "Make characters UC and LC a pair of inter-case-converting letters. This sets the entries for characters UC and LC in TABLE, which is a string that will be used as the downcase part of a case table. It also modifies `standard-syntax-table' to give them the syntax of word constituents." (aset table uc lc) (aset table lc lc) (set-char-table-extra-slot table 0 nil) (set-char-table-extra-slot table 1 nil) (set-char-table-extra-slot table 2 nil) (modify-syntax-entry lc "w " (standard-syntax-table)) (modify-syntax-entry uc "w " (standard-syntax-table))) ;;;###autoload (defun set-case-syntax (c syntax table) "Make characters C case-invariant with syntax SYNTAX. This sets the entries for character C in TABLE, which is a string that will be used as the downcase part of a case table. It also modifies `standard-syntax-table'. SYNTAX should be \" \", \"w\", \".\" or \"_\"." (aset table c c) (set-char-table-extra-slot table 0 nil) (set-char-table-extra-slot table 1 nil) (set-char-table-extra-slot table 2 nil) (modify-syntax-entry c syntax (standard-syntax-table))) (provide 'case-table) ;;; case-table.el ends here emacs-19.30/lisp/cc-compat.el100666 12120 1 12116 6021471646 14274 0ustar rmsdaemon;;; cc-compat.el --- cc-mode compatibility with c-mode.el confusion ;; Copyright (C) 1985, 87, 92, 93, 94, 95 Free Software Foundation, Inc. ;; Author: 1994-1995 Barry A. Warsaw ;; Maintainer: cc-mode-help@merlin.cnri.reston.va.us ;; Created: August 1994, split from cc-mode.el ;; Barry Warsaw Version: 1.5 ;; Keywords: c languages oop ;; 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: ;; ;; Boring old c-mode.el (BOCM) is confusion and brain melt. cc-mode.el ;; is clarity of thought and purity of chi. If you are still unwilling ;; to accept enlightenment, this might help, or it may prolong your ;; agony. ;; ;; To use, add the following to your c-mode-hook: ;; ;; (require 'cc-compat) ;; (c-set-style "BOCM") ;;; Code: ;; In case c-mode.el isn't loaded (defvar c-indent-level 2 "*Indentation of C statements with respect to containing block.") (defvar c-brace-imaginary-offset 0 "*Imagined indentation of a C open brace that actually follows a statement.") (defvar c-brace-offset 0 "*Extra indentation for braces, compared with other text in same context.") (defvar c-argdecl-indent 5 "*Indentation level of declarations of C function arguments.") (defvar c-label-offset -2 "*Offset of C label lines and case statements relative to usual indentation.") (defvar c-continued-statement-offset 2 "*Extra indent for lines not starting new statements.") (defvar c-continued-brace-offset 0 "*Extra indent for substatements that start with open-braces. This is in addition to c-continued-statement-offset.") ;; these offsets are taken by brute force testing c-mode.el, since ;; there's no logic to what it does. (let* ((offsets '(c-offsets-alist . ((defun-block-intro . cc-block-intro-offset) (statement-block-intro . cc-block-intro-offset) (defun-open . 0) (class-open . 0) (inline-open . c-brace-offset) (block-open . c-brace-offset) (block-close . cc-block-close-offset) (brace-list-open . c-brace-offset) (substatement-open . cc-substatement-open-offset) (substatement . c-continued-statement-offset) (knr-argdecl-intro . c-argdecl-indent) (case-label . c-label-offset) (access-label . c-label-offset) (label . c-label-offset) )))) (c-add-style "BOCM" offsets)) (defun cc-block-intro-offset (langelem) ;; taken directly from calculate-c-indent confusion (save-excursion (c-backward-syntactic-ws) (if (= (preceding-char) ?{) (forward-char -1) (goto-char (cdr langelem))) (let* ((curcol (save-excursion (goto-char (cdr langelem)) (current-column))) (bocm-lossage ;; If no previous statement, indent it relative to line ;; brace is on. For open brace in column zero, don't let ;; statement start there too. If c-indent-level is zero, ;; use c-brace-offset + c-continued-statement-offset ;; instead. For open-braces not the first thing in a line, ;; add in c-brace-imaginary-offset. (+ (if (and (bolp) (zerop c-indent-level)) (+ c-brace-offset c-continued-statement-offset) c-indent-level) ;; Move back over whitespace before the openbrace. If ;; openbrace is not first nonwhite thing on the line, ;; add the c-brace-imaginary-offset. (progn (skip-chars-backward " \t") (if (bolp) 0 c-brace-imaginary-offset)) ;; If the openbrace is preceded by a parenthesized exp, ;; move to the beginning of that; possibly a different ;; line (progn (if (eq (preceding-char) ?\)) (forward-sexp -1)) ;; Get initial indentation of the line we are on. (current-indentation))))) (- bocm-lossage curcol)))) (defun cc-block-close-offset (langelem) (save-excursion (let* ((here (point)) bracep (curcol (progn (goto-char (cdr langelem)) (current-column))) (bocm-lossage (progn (goto-char (cdr langelem)) (if (= (following-char) ?{) (setq bracep t) (goto-char here) (beginning-of-line) (backward-up-list 1) (forward-char 1) (c-forward-syntactic-ws)) (current-column)))) (- bocm-lossage curcol (if bracep 0 c-indent-level))))) (defun cc-substatement-open-offset (langelem) (+ c-continued-statement-offset c-continued-brace-offset)) (provide 'cc-compat) ;;; cc-compat.el ends here emacs-19.30/lisp/cc-mode.el100444 12120 1 524056 6055504406 13760 0ustar rmsdaemon;;; cc-mode.el --- major mode for editing C, C++, and Objective-C code ;; Copyright (C) 1985, 87, 92, 93, 94, 95 Free Software Foundation, Inc. ;; Authors: 1992-1995 Barry A. Warsaw ;; 1987 Dave Detlefs and Stewart Clamen ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@merlin.cnri.reston.va.us ;; Created: a long, long, time ago. adapted from the original c-mode.el ;; Barry Warsaw Version: 4.249 ;; Keywords: c languages oop ;; NOTE: Read the commentary below for the right way to submit bug reports! ;; 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 file may contain modifications made by the FSF for inclusion ;;; in the Emacs release. It may not be identical to the version ;;; written by Barry Warsaw, so bugs are not necessarily his fault. ;;; However, these changes are usually small, so we still do recommend ;;; reporting bugs to him with C-c C-b. Even when they are not his fault, ;;; he may fix them for the FSF's sake. ;; This package provides modes in GNU Emacs for editing C, C++, and ;; Objective-C code. It is intended to be a replacement for c-mode.el ;; (a.k.a. BOCM -- Boring Old C-Mode), and c++-mode.el (a.k.a ;; cplus-md.el and cplus-md1.el), both of which are ancestors of this ;; file. A number of important improvements have been made, briefly: ;; complete K&R C, ANSI C, `ARM' C++, and Objective-C support with ;; consistent indentation across all modes, more intuitive indentation ;; controlling variables, compatibility across all known Emacsen, nice ;; new features, and tons of bug fixes. This package is called ;; "cc-mode" to distinguish it from its ancestors, but there really is ;; no top-level cc-mode. Usage and programming details are contained ;; in an accompanying texinfo manual. ;; To submit bug reports, type "C-c C-b". Please include a code sample ;; and exact recipe so I can reproduce your problem. If you have ;; other questions contact me at the following address: ;; cc-mode-help@merlin.cnri.reston.va.us. Please don't send bug ;; reports to my personal account, I may not get it for a long time. ;; YOU CAN IGNORE ALL BYTE-COMPILER WARNINGS. They are the result of ;; the multi-Emacsen support. Emacs 19, XEmacs 19 (formerly ;; Lucid), and Emacs 18 all do things differently and there's no ;; way to shut the byte-compiler up at the necessary granularity. Let ;; me say this again: YOU CAN IGNORE ALL BYTE-COMPILER WARNINGS (you'd ;; be surprised at how many people don't follow this advice :-). ;; If your Emacs is dumped with c-mode.el and/or c++-mode.el, you will ;; need to add the following to your .emacs file before any other ;; reference to c-mode or c++-mode: ;; ;; (fmakunbound 'c-mode) ;; (makunbound 'c-mode-map) ;; (fmakunbound 'c++-mode) ;; (makunbound 'c++-mode-map) ;; (makunbound 'c-style-alist) ;; There are three major mode entry points provided by this package, ;; one for editing C++ code, one for editing C code (both K&R and ;; ANSI), and one for editing Objective-C code. To use cc-mode, add ;; the following to your .emacs file. This assumes you will use .cc ;; or .C extensions for your C++ source, .c for your C code, and .m ;; for your Objective-C code: ;; ;; (autoload 'c++-mode "cc-mode" "C++ Editing Mode" t) ;; (autoload 'c-mode "cc-mode" "C Editing Mode" t) ;; (autoload 'objc-mode "cc-mode" "Objective-C Editing Mode" t) ;; (setq auto-mode-alist ;; (append '(("\\.C$" . c++-mode) ;; ("\\.cc$" . c++-mode) ;; ("\\.c$" . c-mode) ;; ("\\.h$" . c-mode) ;; ("\\.m$" . objc-mode) ;; ) auto-mode-alist)) ;; Several Majordomo mailing lists exist for those of you who are ;; interested in beta testing new versions: cc-mode-announce for ;; announcements of new beta versions only, and cc-mode-victims for ;; more technical discussions of the mode. For more information, send ;; the word `help' in a message to one of the following addresses: ;; ;; cc-mode-victims-request@merlin.cnri.reston.va.us ;; cc-mode-announce-request@merlin.cnri.reston.va.us ;; Many, many thanks go out to all the folks on the beta test list. ;; Without their patience, testing, insight, code contributions, and ;; encouragement cc-mode.el would be a far inferior package. ;; Anonymous ftp URL: ;; ;; ftp://ftp.python.org/pub/emacs/cc-mode.tar.gz ;;; Code: ;; user definable variables ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv (defvar c-inhibit-startup-warnings-p nil "*If non-nil, inhibits start up compatibility warnings.") (defvar c-strict-syntax-p nil "*If non-nil, all syntactic symbols must be found in `c-offsets-alist'. If the syntactic symbol for a particular line does not match a symbol in the offsets alist, an error is generated, otherwise no error is reported and the syntactic symbol is ignored.") (defvar c-echo-syntactic-information-p nil "*If non-nil, syntactic info is echoed when the line is indented.") (defvar c-basic-offset 4 "*Amount of basic offset used by + and - symbols in `c-offsets-alist'.") (defvar c-offsets-alist '((string . -1000) (c . c-lineup-C-comments) (defun-open . 0) (defun-close . 0) (defun-block-intro . +) (class-open . 0) (class-close . 0) (inline-open . +) (inline-close . 0) (ansi-funcdecl-cont . -) (knr-argdecl-intro . +) (knr-argdecl . 0) (topmost-intro . 0) (topmost-intro-cont . 0) (member-init-intro . +) (member-init-cont . 0) (inher-intro . +) (inher-cont . c-lineup-multi-inher) (block-open . 0) (block-close . 0) (brace-list-open . 0) (brace-list-close . 0) (brace-list-intro . +) (brace-list-entry . 0) (statement . 0) ;; some people might prefer ;;(statement . c-lineup-runin-statements) (statement-cont . +) ;; some people might prefer ;;(statement-cont . c-lineup-math) (statement-block-intro . +) (statement-case-intro . +) (statement-case-open . 0) (substatement . +) (substatement-open . +) (case-label . 0) (access-label . -) (label . 2) (do-while-closure . 0) (else-clause . 0) (comment-intro . c-lineup-comment) (arglist-intro . +) (arglist-cont . 0) (arglist-cont-nonempty . c-lineup-arglist) (arglist-close . +) (stream-op . c-lineup-streamop) (inclass . +) (cpp-macro . -1000) (friend . 0) (objc-method-intro . -1000) (objc-method-args-cont . c-lineup-ObjC-method-args) (objc-method-call-cont . c-lineup-ObjC-method-call) ) "*Association list of syntactic element symbols and indentation offsets. As described below, each cons cell in this list has the form: (SYNTACTIC-SYMBOL . OFFSET) When a line is indented, cc-mode first determines the syntactic context of the line by generating a list of symbols called syntactic elements. This list can contain more than one syntactic element and the global variable `c-syntactic-context' contains the context list for the line being indented. Each element in this list is actually a cons cell of the syntactic symbol and a buffer position. This buffer position is called the relative indent point for the line. Some syntactic symbols may not have a relative indent point associated with them. After the syntactic context list for a line is generated, cc-mode calculates the absolute indentation for the line by looking at each syntactic element in the list. First, it compares the syntactic element against the SYNTACTIC-SYMBOL's in `c-offsets-alist'. When it finds a match, it adds the OFFSET to the column of the relative indent point. The sum of this calculation for each element in the syntactic list is the absolute offset for line being indented. If the syntactic element does not match any in the `c-offsets-alist', an error is generated if `c-strict-syntax-p' is non-nil, otherwise the element is ignored. Actually, OFFSET can be an integer, a function, a variable, or one of the following symbols: `+', `-', `++', `--', `*', or `/'. These latter designate positive or negative multiples of `c-basic-offset', respectively: *1, *-1, *2, *-2, *0.5, and *-0.5. If OFFSET is a function, it is called with a single argument containing the cons of the syntactic element symbol and the relative indent point. The function should return an integer offset. Here is the current list of valid syntactic element symbols: string -- inside multi-line string c -- inside a multi-line C style block comment defun-open -- brace that opens a function definition defun-close -- brace that closes a function definition defun-block-intro -- the first line in a top-level defun class-open -- brace that opens a class definition class-close -- brace that closes a class definition inline-open -- brace that opens an in-class inline method inline-close -- brace that closes an in-class inline method ansi-funcdecl-cont -- the nether region between an ANSI function declaration and the defun opening brace knr-argdecl-intro -- first line of a K&R C argument declaration knr-argdecl -- subsequent lines in a K&R C argument declaration topmost-intro -- the first line in a topmost construct definition topmost-intro-cont -- topmost definition continuation lines member-init-intro -- first line in a member initialization list member-init-cont -- subsequent member initialization list lines inher-intro -- first line of a multiple inheritance list inher-cont -- subsequent multiple inheritance lines block-open -- statement block open brace block-close -- statement block close brace brace-list-open -- open brace of an enum or static array list brace-list-close -- close brace of an enum or static array list brace-list-intro -- first line in an enum or static array list brace-list-entry -- subsequent lines in an enum or static array list statement -- a C/C++/ObjC statement statement-cont -- a continuation of a C/C++/ObjC statement statement-block-intro -- the first line in a new statement block statement-case-intro -- the first line in a case `block' statement-case-open -- the first line in a case block starting with brace substatement -- the first line after an if/while/for/do/else substatement-open -- the brace that opens a substatement block case-label -- a case or default label access-label -- C++ private/protected/public access label label -- any non-special C/C++/ObjC label do-while-closure -- the `while' that ends a do/while construct else-clause -- the `else' of an if/else construct comment-intro -- a line containing only a comment introduction arglist-intro -- the first line in an argument list arglist-cont -- subsequent argument list lines when no arguments follow on the same line as the the arglist opening paren arglist-cont-nonempty -- subsequent argument list lines when at least one argument follows on the same line as the arglist opening paren arglist-close -- the solo close paren of an argument list stream-op -- lines continuing a stream operator construct inclass -- the construct is nested inside a class definition cpp-macro -- the start of a cpp macro friend -- a C++ friend declaration objc-method-intro -- the first line of an Objective-C method definition objc-method-args-cont -- lines continuing an Objective-C method definition objc-method-call-cont -- lines continuing an Objective-C method call ") (defvar c-tab-always-indent t "*Controls the operation of the TAB key. If t, hitting TAB always just indents the current line. If nil, hitting TAB indents the current line if point is at the left margin or in the line's indentation, otherwise it insert a real tab character. If other than nil or t, then tab is inserted only within literals -- defined as comments and strings -- and inside preprocessor directives, but line is always reindented. Note that indentation of lines containing only comments is also controlled by the `c-comment-only-line-offset' variable.") (defvar c-comment-only-line-offset 0 "*Extra offset for line which contains only the start of a comment. Can contain an integer or a cons cell of the form: (NON-ANCHORED-OFFSET . ANCHORED-OFFSET) Where NON-ANCHORED-OFFSET is the amount of offset given to non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is the amount of offset to give column-zero anchored comment-only lines. Just an integer as value is equivalent to ( . -1000).") (defvar c-indent-comments-syntactically-p nil "*Specifies how comment-only lines should be indented. When this variable is non-nil, comment-only lines are indented according to syntactic analysis via `c-offsets-alist', even when \\[indent-for-comment] is used.") (defvar c-block-comments-indent-p nil "*Specifies how to re-indent C style block comments. Examples of the supported styles of C block comment indentation are shown below. When this variable is nil, block comments are indented as shown in styles 1 through 4. If this variable is non-nil, block comments are indented as shown in style 5. Note that cc-mode does not automatically insert any stars or block comment delimiters. You must type these in manually. This variable only controls how the lines within the block comment are indented when you hit ``\\[c-indent-command]''. style 1: style 2 (GNU): style 3: style 4: style 5: /* /* Blah /* /* /* blah blah. */ * blah ** blah blah blah * blah ** blah blah */ */ */ */") (defvar c-cleanup-list '(scope-operator) "*List of various C/C++/ObjC constructs to \"clean up\". These clean ups only take place when the auto-newline feature is turned on, as evidenced by the `/a' or `/ah' appearing next to the mode name. Valid symbols are: brace-else-brace -- cleans up `} else {' constructs by placing entire construct on a single line. This clean up only takes place when there is nothing but white space between the braces and the `else'. Clean up occurs when the open-brace after the `else' is typed. empty-defun-braces -- cleans up empty defun braces by placing the braces on the same line. Clean up occurs when the defun closing brace is typed. defun-close-semi -- cleans up the terminating semi-colon on defuns by placing the semi-colon on the same line as the closing brace. Clean up occurs when the semi-colon is typed. list-close-comma -- cleans up commas following braces in array and aggregate initializers. Clean up occurs when the comma is typed. scope-operator -- cleans up double colons which may designate a C++ scope operator split across multiple lines. Note that certain C++ constructs can generate ambiguous situations. This clean up only takes place when there is nothing but whitespace between colons. Clean up occurs when the second colon is typed.") (defvar c-hanging-braces-alist '((brace-list-open) (substatement-open after) (block-close . c-snug-do-while)) "*Controls the insertion of newlines before and after braces. This variable contains an association list with elements of the following form: (SYNTACTIC-SYMBOL . ACTION). When a brace (either opening or closing) is inserted, the syntactic context it defines is looked up in this list, and if found, the associated ACTION is used to determine where newlines are inserted. If the context is not found, the default is to insert a newline both before and after the brace. SYNTACTIC-SYMBOL can be any of: defun-open, defun-close, class-open, class-close, inline-open, inline-close, block-open, block-close, substatement-open, statement-case-open, brace-list-open, brace-list-close, brace-list-intro, or brace-list-entry. See `c-offsets-alist' for details. ACTION can be either a function symbol or a list containing any combination of the symbols `before' or `after'. If the list is empty, no newlines are inserted either before or after the brace. When ACTION is a function symbol, the function is called with a two arguments: the syntactic symbol for the brace and the buffer position at which the brace was inserted. The function must return a list as described in the preceding paragraph. Note that during the call to the function, the variable `c-syntactic-context' is set to the entire syntactic context for the brace line.") (defvar c-hanging-colons-alist nil "*Controls the insertion of newlines before and after certain colons. This variable contains an association list with elements of the following form: (SYNTACTIC-SYMBOL . ACTION). See the variable `c-hanging-braces-alist' for the semantics of this variable. Note however that making ACTION a function symbol is currently not supported for this variable.") (defvar c-hanging-semi&comma-criteria '(c-semi&comma-inside-parenlist) "*List of functions that decide whether to insert a newline or not. The functions in this list are called, in order, whenever the auto-newline minor mode is activated (as evidenced by a `/a' or `/ah' string in the mode line), and a semicolon or comma is typed (see `c-electric-semi&comma'). Each function in this list is called with no arguments, and should return one of the following values: nil -- no determination made, continue checking 'stop -- do not insert a newline, and stop checking (anything else) -- insert a newline, and stop checking If every function in the list is called with no determination made, then no newline is inserted.") (defvar c-hanging-comment-ender-p t "*If nil, `c-fill-paragraph' leaves C block comment enders on their own line. Default value is t, which inhibits leaving block comment ending string `*/' on a line by itself. This is BOCM's sole behavior.") (defvar c-backslash-column 48 "*Column to insert backslashes when macroizing a region.") (defvar c-special-indent-hook nil "*Hook for user defined special indentation adjustments. This hook gets called after a line is indented by the mode.") (defvar c-delete-function 'backward-delete-char-untabify "*Function called by `c-electric-delete' when deleting characters.") (defvar c-electric-pound-behavior nil "*List of behaviors for electric pound insertion. Only currently supported behavior is `alignleft'.") (defvar c-recognize-knr-p t "*If non-nil, `c-mode' and `objc-mode' will recognize K&R constructs. This variable is needed because of ambiguities in C syntax that make fast recognition of K&R constructs problematic, and slow. If you are coding with ANSI prototypes, set this variable to nil to speed up recognition of certain constructs. By setting this variable to nil, I have seen an increase of 20 times under some circumstance.") (defvar c-progress-interval 5 "*Interval used to update progress status during long re-indentation. If a number, percentage complete gets updated after each interval of that many seconds. Set to nil to inhibit updating. This is only useful for Emacs 19.") (defvar c-style-alist '(("GNU" (c-basic-offset . 2) (c-comment-only-line-offset . (0 . 0)) (c-offsets-alist . ((statement-block-intro . +) (knr-argdecl-intro . 5) (substatement-open . +) (label . 0) (statement-case-open . +) (statement-cont . +) (arglist-intro . c-lineup-arglist-intro-after-paren) (arglist-close . c-lineup-arglist) )) ) ("K&R" (c-basic-offset . 5) (c-comment-only-line-offset . 0) (c-offsets-alist . ((statement-block-intro . +) (knr-argdecl-intro . 0) (substatement-open . 0) (label . 0) (statement-cont . +) )) ) ("BSD" (c-basic-offset . 4) (c-comment-only-line-offset . 0) (c-offsets-alist . ((statement-block-intro . +) (knr-argdecl-intro . +) (substatement-open . 0) (label . 0) (statement-cont . +) )) ) ("Stroustrup" (c-basic-offset . 4) (c-comment-only-line-offset . 0) (c-offsets-alist . ((statement-block-intro . +) (substatement-open . 0) (label . 0) (statement-cont . +) )) ) ("Whitesmith" (c-basic-offset . 4) (c-comment-only-line-offset . 0) (c-offsets-alist . ((statement-block-intro . +) (knr-argdecl-intro . +) (substatement-open . 0) (label . 0) (statement-cont . +) )) ) ("Ellemtel" (c-basic-offset . 3) (c-comment-only-line-offset . 0) (c-hanging-braces-alist . ((substatement-open before after))) (c-offsets-alist . ((topmost-intro . 0) (topmost-intro-cont . 0) (substatement . 3) (substatement-open . 0) (statement-case-intro . 0) (case-label . +) (access-label . -3) (inclass . 6) (inline-open . 0) )) )) "Styles of Indentation. Elements of this alist are of the form: (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) where STYLE-STRING is a short descriptive string used to select a style, VARIABLE is any cc-mode variable, and VALUE is the intended value for that variable when using the selected style. There is one special case when VARIABLE is `c-offsets-alist'. In this case, the VALUE is a list containing elements of the form: (SYNTACTIC-SYMBOL . VALUE) as described in `c-offsets-alist'. These are passed directly to `c-set-offset' so there is no need to set every syntactic symbol in your style, only those that are different from the default. Note that all styles inherit from the \"CC-MODE\" style, which is computed at the time the mode is loaded.") (defvar c-file-style nil "*Variable interface for setting style via File Local Variables. In a file's Local Variable section, you can set this variable to a string suitable for `c-set-style'. When the file is visited, cc-mode will set the style of the file to this value automatically. Note that file style settings are applied before file offset settings as designated in the variable `c-file-offsets'.") (defvar c-file-offsets nil "*Variable interface for setting offsets via File Local Variables. In a file's Local Variable section, you can set this variable to an association list similiar to the values allowed in `c-offsets-alist'. When the file is visited, cc-mode will institute these offset settings automatically. Note that file offset settings are applied after file style settings as designated in the variable `c-file-style'.") (defvar c-mode-hook nil "*Hook called by `c-mode'.") (defvar c++-mode-hook nil "*Hook called by `c++-mode'.") (defvar objc-mode-hook nil "*Hook called by `objc-mode'.") (defvar c-mode-common-hook nil "*Hook called by `c-mode', `c++-mode', and 'objc-mode' during common init.") (defvar c-mode-menu '(["Comment Out Region" comment-region (mark)] ["Macro Expand Region" c-macro-expand (mark)] ["Backslashify" c-backslash-region (mark)] ["Indent Expression" c-indent-exp (memq (following-char) '(?\( ?\[ ?\{))] ["Indent Line" c-indent-command t] ["Fill Comment Paragraph" c-fill-paragraph t] ["Up Conditional" c-up-conditional t] ["Backward Conditional" c-backward-conditional t] ["Forward Conditional" c-forward-conditional t] ["Backward Statement" c-beginning-of-statement t] ["Forward Statement" c-end-of-statement t] ) "XEmacs 19 (formerly Lucid) menu for C/C++/ObjC modes.") ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; NO USER DEFINABLE VARIABLES BEYOND THIS POINT ;; Shut the byte-compiler up. Requires Emacs 19 or JWZ's improved ;; byte-compiler. Otherwise, comment this line out and ignore ;; any warnings. ;;(byte-compiler-options (warnings nil)) ;; figure out what features this Emacs has (defconst c-emacs-features (let ((major (and (boundp 'emacs-major-version) emacs-major-version)) (minor (and (boundp 'emacs-minor-version) emacs-minor-version)) flavor comments) ;; figure out version numbers if not already discovered (and (or (not major) (not minor)) (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version) (setq major (string-to-int (substring emacs-version (match-beginning 1) (match-end 1))) minor (string-to-int (substring emacs-version (match-beginning 2) (match-end 2))))) (if (not (and major minor)) (error "Cannot figure out the major and minor version numbers.")) ;; calculate the major version (cond ((= major 18) (setq major 'v18)) ;Emacs 18 ((= major 4) (setq major 'v18)) ;Epoch 4 ((= major 19) (setq major 'v19 ;Emacs 19 flavor (if (or (string-match "Lucid" emacs-version) (string-match "XEmacs" emacs-version)) 'XEmacs 'FSF))) ;; I don't know (t (error "Cannot recognize major version number: %s" major))) ;; All XEmacs 19's (formerly Lucid) use 8-bit modify-syntax-entry ;; flags, as do all patched (obsolete) Emacs 19, Emacs 18, ;; Epoch 4's. Only vanilla Emacs 19 uses 1-bit flag. Lets be ;; as smart as we can about figuring this out. (if (eq major 'v19) (let ((table (copy-syntax-table))) (modify-syntax-entry ?a ". 12345678" table) (if (and (vectorp table) (= (logand (lsh (aref table ?a) -16) 255) 255)) (setq comments '8-bit) (setq comments '1-bit))) (setq comments 'no-dual-comments)) ;; lets do some minimal sanity checking. (if (and (or ;; Lemacs before 19.6 had bugs (and (eq major 'v19) (eq flavor 'XEmacs) (< minor 6)) ;; Emacs 19 before 19.21 has known bugs (and (eq major 'v19) (eq flavor 'FSF) (< minor 21))) (not c-inhibit-startup-warnings-p)) (with-output-to-temp-buffer "*cc-mode warnings*" (print (format "The version of Emacs that you are running, %s, has known bugs in its syntax.c parsing routines which will affect the performance of cc-mode. You should strongly consider upgrading to the latest available version. cc-mode may continue to work, after a fashion, but strange indentation errors could be encountered." emacs-version)))) ;; Emacs 18, with no patch is not too good (if (and (eq major 'v18) (eq comments 'no-dual-comments) (not c-inhibit-startup-warnings-p)) (with-output-to-temp-buffer "*cc-mode warnings*" (print (format "The version of Emacs 18 you are running, %s, has known deficiencies in its ability to handle dual C++ comments, i.e. C++ line style comments and C block style comments. This will not be much of a problem for you if you are only editing C code, but if you are doing much C++ editing, you should strongly consider upgrading to one of the latest Emacs 19's. In Emacs 18, you may also experience performance degradations. Emacs 19 has some new built-in routines which will speed things up for you. Because of these inherent problems, cc-mode is no longer being actively maintained for Emacs 18, however, until you can upgrade to Emacs 19, you may want to look at cc-mode-18.el in the cc-mode distribution. THIS FILE IS COMPLETELY UNSUPPORTED! If you use it, you are on your own, although patch contributions will be folded into the main release." emacs-version)))) ;; Emacs 18 with the syntax patches are no longer supported (if (and (eq major 'v18) (not (eq comments 'no-dual-comments)) (not c-inhibit-startup-warnings-p)) (with-output-to-temp-buffer "*cc-mode warnings*" (print (format "You are running a syntax patched Emacs 18 variant. While this should work for you, you may want to consider upgrading to Emacs 19. The syntax patches are no longer supported either for syntax.c or cc-mode.")))) (list major comments)) "A list of features extant in the Emacs you are using. There are many flavors of Emacs out there, each with different features supporting those needed by cc-mode. Here's the current supported list, along with the values for this variable: Vanilla Emacs 18/Epoch 4: (v18 no-dual-comments) Emacs 18/Epoch 4 (patch2): (v18 8-bit) XEmacs (formerly Lucid) 19: (v19 8-bit) Emacs 19: (v19 1-bit).") (defvar c++-mode-abbrev-table nil "Abbrev table in use in c++-mode buffers.") (define-abbrev-table 'c++-mode-abbrev-table ()) (defvar c-mode-abbrev-table nil "Abbrev table in use in c-mode buffers.") (define-abbrev-table 'c-mode-abbrev-table ()) (defvar objc-mode-abbrev-table nil "Abbrev table in use in objc-mode buffers.") (define-abbrev-table 'objc-mode-abbrev-table ()) (defun c-mode-fsf-menu (name map) ;; Add menu to a keymap. FSF menus suck. Don't add them for ;; XEmacs. This feature test will fail on other than Emacs 19. (condition-case nil (progn (define-key map [menu-bar] (make-sparse-keymap)) (define-key map [menu-bar c] (cons name (make-sparse-keymap name))) (define-key map [menu-bar c comment-region] '("Comment Out Region" . comment-region)) (define-key map [menu-bar c c-macro-expand] '("Macro Expand Region" . c-macro-expand)) (define-key map [menu-bar c c-backslash-region] '("Backslashify" . c-backslash-region)) (define-key map [menu-bar c indent-exp] '("Indent Expression" . c-indent-exp)) (define-key map [menu-bar c indent-line] '("Indent Line" . c-indent-command)) (define-key map [menu-bar c fill] '("Fill Comment Paragraph" . c-fill-paragraph)) (define-key map [menu-bar c up] '("Up Conditional" . c-up-conditional)) (define-key map [menu-bar c backward] '("Backward Conditional" . c-backward-conditional)) (define-key map [menu-bar c forward] '("Forward Conditional" . c-forward-conditional)) (define-key map [menu-bar c backward-stmt] '("Backward Statement" . c-beginning-of-statement)) (define-key map [menu-bar c forward-stmt] '("Forward Statement" . c-end-of-statement)) ;; RMS: mouse-3 should not select this menu. mouse-3's global ;; definition is useful in C mode and we should not interfere ;; with that. The menu is mainly for beginners, and for them, ;; the menubar requires less memory than a special click. t) (error nil))) (defvar c-mode-map () "Keymap used in c-mode buffers.") (if c-mode-map () ;; TBD: should we even worry about naming this keymap. My vote: no, ;; because Emacs and XEmacs (formerly Lucid) do it differently. (setq c-mode-map (make-sparse-keymap)) ;; put standard keybindings into MAP ;; the following mappings correspond more or less directly to BOCM (define-key c-mode-map "{" 'c-electric-brace) (define-key c-mode-map "}" 'c-electric-brace) (define-key c-mode-map ";" 'c-electric-semi&comma) (define-key c-mode-map "#" 'c-electric-pound) (define-key c-mode-map ":" 'c-electric-colon) ;; Lemacs 19.9 defines these two, the second of which is commented out ;; (define-key c-mode-map "\e{" 'c-insert-braces) ;; Commented out electric square brackets because nobody likes them. ;; (define-key c-mode-map "[" 'c-insert-brackets) (define-key c-mode-map "\e\C-h" 'c-mark-function) (define-key c-mode-map "\e\C-q" 'c-indent-exp) (define-key c-mode-map "\ea" 'c-beginning-of-statement) (define-key c-mode-map "\ee" 'c-end-of-statement) ;; I'd rather use an adaptive fill program instead of this. (define-key c-mode-map "\eq" 'c-fill-paragraph) (define-key c-mode-map "\C-c\C-n" 'c-forward-conditional) (define-key c-mode-map "\C-c\C-p" 'c-backward-conditional) (define-key c-mode-map "\C-c\C-u" 'c-up-conditional) (define-key c-mode-map "\t" 'c-indent-command) (define-key c-mode-map "\177" 'c-electric-delete) ;; these are new keybindings, with no counterpart to BOCM (define-key c-mode-map "," 'c-electric-semi&comma) (define-key c-mode-map "/" 'c-electric-slash) (define-key c-mode-map "*" 'c-electric-star) (define-key c-mode-map "\C-c\C-q" 'c-indent-defun) (define-key c-mode-map "\C-c\C-\\" 'c-backslash-region) ;; TBD: where if anywhere, to put c-backward|forward-into-nomenclature (define-key c-mode-map "\C-c\C-a" 'c-toggle-auto-state) (define-key c-mode-map "\C-c\C-b" 'c-submit-bug-report) (define-key c-mode-map "\C-c\C-c" 'comment-region) (define-key c-mode-map "\C-c\C-d" 'c-toggle-hungry-state) (define-key c-mode-map "\C-c\C-e" 'c-macro-expand) (define-key c-mode-map "\C-c\C-o" 'c-set-offset) (define-key c-mode-map "\C-c\C-s" 'c-show-syntactic-information) (define-key c-mode-map "\C-c\C-t" 'c-toggle-auto-hungry-state) ;; conflicts with OOBR ;;(define-key c-mode-map "\C-c\C-v" 'c-version) ;; Emacs 19 defines menus in the mode map. This call will return ;; t on Emacs 19, otherwise no-op and return nil. (if (and (not (c-mode-fsf-menu "C" c-mode-map)) ;; in XEmacs (formerly Lucid) 19, we want the menu to popup ;; when the 3rd button is hit. In 19.10 and beyond this is ;; done automatically if we put the menu on mode-popup-menu ;; variable, see c-common-init. RMS decided that this ;; feature should not be included in Emacs. (boundp 'current-menubar) (not (boundp 'mode-popup-menu))) (define-key c-mode-map 'button3 'c-popup-menu))) (defvar c++-mode-map () "Keymap used in c++-mode buffers.") (if c++-mode-map () ;; In Emacs 19, it makes more sense to inherit c-mode-map (if (memq 'v19 c-emacs-features) ;; XEmacs (formerly Lucid) and Emacs 19 do this differently (if (not (fboundp 'set-keymap-parent)) (setq c++-mode-map (cons 'keymap c-mode-map)) (setq c++-mode-map (make-sparse-keymap)) (set-keymap-parent c++-mode-map c-mode-map)) ;; Do it the hard way for Emacs 18 -- given by JWZ (setq c++-mode-map (nconc (make-sparse-keymap) c-mode-map))) ;; add bindings which are only useful for C++ (define-key c++-mode-map "\C-c:" 'c-scope-operator) ;; Emacs 19 defines menus in the mode map. This call will return ;; t on Emacs 19, otherwise no-op and return nil. (c-mode-fsf-menu "C++" c++-mode-map)) (defvar objc-mode-map () "Keymap used in objc-mode buffers.") (if objc-mode-map () ;; In Emacs 19, it makes more sense to inherit c-mode-map (if (memq 'v19 c-emacs-features) ;; XEmacs (formerly Lucid) and Emacs 19 do this differently (if (not (fboundp 'set-keymap-parent)) (setq objc-mode-map (cons 'keymap c-mode-map)) (setq objc-mode-map (make-sparse-keymap)) (set-keymap-parent objc-mode-map c-mode-map)) ;; Do it the hard way for Emacs 18 -- given by JWZ (setq objc-mode-map (nconc (make-sparse-keymap) c-mode-map))) ;; add bindings which are only useful for Objective-C ;; ;; no additional bindings ;; ;; Emacs 19 defines menus in the mode map. This call will return ;; t on Emacs 19, otherwise no-op and return nil. (c-mode-fsf-menu "ObjC" objc-mode-map)) (defun c-populate-syntax-table (table) ;; Populate the syntax TABLE ;; DO NOT TRY TO SET _ (UNDERSCORE) TO WORD CLASS! (modify-syntax-entry ?_ "_" table) (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?+ "." table) (modify-syntax-entry ?- "." table) (modify-syntax-entry ?= "." table) (modify-syntax-entry ?% "." table) (modify-syntax-entry ?< "." table) (modify-syntax-entry ?> "." table) (modify-syntax-entry ?& "." table) (modify-syntax-entry ?| "." table) (modify-syntax-entry ?\' "\"" table)) (defun c-setup-dual-comments (table) ;; Set up TABLE to handle block and line style comments (cond ((memq '8-bit c-emacs-features) ;; XEmacs (formerly Lucid) has the best implementation (modify-syntax-entry ?/ ". 1456" table) (modify-syntax-entry ?* ". 23" table) (modify-syntax-entry ?\n "> b" table) ;; Give CR the same syntax as newline, for selective-display (modify-syntax-entry ?\^m "> b" table)) ((memq '1-bit c-emacs-features) ;; Emacs 19 does things differently, but we can work with it (modify-syntax-entry ?/ ". 124b" table) (modify-syntax-entry ?* ". 23" table) (modify-syntax-entry ?\n "> b" table) ;; Give CR the same syntax as newline, for selective-display (modify-syntax-entry ?\^m "> b" table)) )) (defvar c-mode-syntax-table nil "Syntax table used in c-mode buffers.") (if c-mode-syntax-table () (setq c-mode-syntax-table (make-syntax-table)) (c-populate-syntax-table c-mode-syntax-table) ;; add extra comment syntax (modify-syntax-entry ?/ ". 14" c-mode-syntax-table) (modify-syntax-entry ?* ". 23" c-mode-syntax-table)) (defvar c++-mode-syntax-table nil "Syntax table used in c++-mode buffers.") (if c++-mode-syntax-table () (setq c++-mode-syntax-table (make-syntax-table)) (c-populate-syntax-table c++-mode-syntax-table) ;; add extra comment syntax (c-setup-dual-comments c++-mode-syntax-table) ;; TBD: does it make sense for colon to be symbol class in C++? ;; I'm not so sure, since c-label-key is busted on lines like: ;; Foo::bar( i ); ;; maybe c-label-key should be fixed instead of commenting this out, ;; but it also bothers me that this only seems appropriate for C++ ;; and not C. ;;(modify-syntax-entry ?: "_" c++-mode-syntax-table) ) (defvar objc-mode-syntax-table nil "Syntax table used in objc-mode buffers.") (if objc-mode-syntax-table () (setq objc-mode-syntax-table (make-syntax-table)) (c-populate-syntax-table objc-mode-syntax-table) ;; add extra comment syntax (c-setup-dual-comments objc-mode-syntax-table) ;; everyone gets these (modify-syntax-entry ?@ "_" objc-mode-syntax-table) ) (defvar c-hungry-delete-key nil "Internal state of hungry delete key feature.") (defvar c-auto-newline nil "Internal state of auto newline feature.") (defvar c-auto-hungry-string nil "Internal auto-newline/hungry-delete designation string for mode line.") (defvar c-syntactic-context nil "Variable containing syntactic analysis list during indentation.") (defvar c-comment-start-regexp nil "Buffer local variable describing how comment are introduced.") (defvar c-conditional-key nil "Buffer local language-specific conditional keyword regexp.") (defvar c-access-key nil "Buffer local language-specific access key regexp.") (defvar c-class-key nil "Buffer local language-specific class key regexp.") (defconst c-protection-key "\\<\\(public\\|protected\\|private\\)\\>" "Regexp describing protection keywords.") (defconst c-symbol-key "\\(\\w\\|\\s_\\)+" "Regexp describing a C/C++/ObjC symbol. We cannot use just `word' syntax class since `_' cannot be in word class. Putting underscore in word class breaks forward word movement behavior that users are familiar with.") (defconst c-baseclass-key (concat ":?[ \t]*\\(virtual[ \t]+\\)?\\(" c-protection-key "[ \t]+\\)" c-symbol-key) "Regexp describing C++ base classes in a derived class definition.") ;; minor mode variables (make-variable-buffer-local 'c-auto-newline) (make-variable-buffer-local 'c-hungry-delete-key) (make-variable-buffer-local 'c-auto-hungry-string) ;; language differences (make-variable-buffer-local 'c-comment-start-regexp) (make-variable-buffer-local 'c-conditional-key) (make-variable-buffer-local 'c-access-key) (make-variable-buffer-local 'c-class-key) (make-variable-buffer-local 'c-baseclass-key) (make-variable-buffer-local 'c-recognize-knr-p) ;; style variables are made buffer local at tail end of this file. ;; cmacexp is lame because it uses no preprocessor symbols. ;; It isn't very extensible either -- hardcodes /lib/cpp. ;; [I add it here only because c-mode has it -- BAW] (autoload 'c-macro-expand "cmacexp" "Display the result of expanding all C macros occurring in the region. The expansion is entirely correct because it uses the C preprocessor." t) ;; constant regular expressions for looking at various constructs (defconst c-C++-class-key "\\(class\\|struct\\|union\\)" "Regexp describing a C++ class declaration, including templates.") (defconst c-C-class-key "\\(struct\\|union\\)" "Regexp describing a C struct declaration.") (defconst c-inher-key (concat "\\(\\\\s +\\)?" c-C++-class-key "[ \t]+" c-symbol-key "\\([ \t]*:[ \t]*\\)?\\s *[^;]") "Regexp describing a class inheritance declaration.") (defconst c-switch-label-key "\\(\\(case[( \t]+\\S .*\\)\\|default[ \t]*\\):" "Regexp describing a switch's case or default label") (defconst c-C++-access-key (concat c-protection-key ":") "Regexp describing C++ access specification keywords.") (defconst c-label-key (concat c-symbol-key ":\\([^:]\\|$\\)") "Regexp describing any label.") (defconst c-C-conditional-key "\\b\\(for\\|if\\|do\\|else\\|while\\|switch\\)\\b[^_]" "Regexp describing a conditional control.") (defconst c-C++-conditional-key "\\b\\(for\\|if\\|do\\|else\\|while\\|switch\\|try\\|catch\\)\\b[^_]" "Regexp describing a conditional control for C++.") (defconst c-C++-friend-key "friend[ \t]+\\|template[ \t]*<.+>[ \t]*friend[ \t]+" "Regexp describing friend declarations in C++ classes.") (defconst c-C++-comment-start-regexp "//\\|/\\*" "Dual comment value for `c-comment-start-regexp'.") (defconst c-C-comment-start-regexp "/\\*" "Single comment style value for `c-comment-start-regexp'.") (defconst c-ObjC-method-key (concat "^\\s *[+-]\\s *" "\\(([^)]*)\\)?" ; return type ;; \\s- in objc syntax table does not include \n ;; since it is considered the end of //-comments. "[ \t\n]*" c-symbol-key) "Regexp describing an Objective-C method intro.") (defconst c-ObjC-access-key (concat "@" c-protection-key) "Regexp describing access specification keywords for Objective-C.") (defconst c-ObjC-class-key (concat "@\\(interface\\|implementation\\)\\s +" c-symbol-key ;name of the class "\\(\\s *:\\s *" c-symbol-key "\\)?" ;maybe followed by the superclass "\\(\\s *<[^>]+>\\)?" ;and maybe the adopted protocols list ) "Regexp describing a class or protocol declaration for Objective-C.") ;; KLUDGE ALERT. We default these variables to their `C' values so ;; that non-cc-mode-ized modes that depend on c-mode will still work ;; out of the box. The most glaring example is awk-mode. There ought ;; to be a better way. (setq-default c-conditional-key c-C-conditional-key c-class-key c-C-class-key c-comment-start-regexp c-C-comment-start-regexp) ;; main entry points for the modes (defconst c-list-of-mode-names nil) ;;;###autoload (defun c++-mode () "Major mode for editing C++ code. To submit a problem report, enter `\\[c-submit-bug-report]' from a c++-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the problem, including a reproducable test case and send the message. To see what version of cc-mode you are running, enter `\\[c-version]'. The hook variable `c++-mode-hook' is run with no args, if that variable is bound and has a non-nil value. Also the common hook c-mode-common-hook is run first, by this defun, `c-mode', and `objc-mode'. Key bindings: \\{c++-mode-map}" (interactive) (kill-all-local-variables) (set-syntax-table c++-mode-syntax-table) (setq major-mode 'c++-mode mode-name "C++" local-abbrev-table c++-mode-abbrev-table) (use-local-map c++-mode-map) (c-common-init) (setq comment-start "// " comment-end "" comment-multi-line nil c-conditional-key c-C++-conditional-key c-comment-start-regexp c-C++-comment-start-regexp c-class-key c-C++-class-key c-access-key c-C++-access-key) (run-hooks 'c-mode-common-hook) (run-hooks 'c++-mode-hook)) (setq c-list-of-mode-names (cons "C++" c-list-of-mode-names)) ;;;###autoload (defun c-mode () "Major mode for editing K&R and ANSI C code. To submit a problem report, enter `\\[c-submit-bug-report]' from a c-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the problem, including a reproducable test case and send the message. To see what version of cc-mode you are running, enter `\\[c-version]'. The hook variable `c-mode-hook' is run with no args, if that value is bound and has a non-nil value. Also the common hook c-mode-common-hook is run first, by this defun, `c++-mode', and `objc-mode'. Key bindings: \\{c-mode-map}" (interactive) (kill-all-local-variables) (set-syntax-table c-mode-syntax-table) (setq major-mode 'c-mode mode-name "C" local-abbrev-table c-mode-abbrev-table) (use-local-map c-mode-map) (c-common-init) (setq comment-start "/* " comment-end " */" comment-multi-line t c-conditional-key c-C-conditional-key c-class-key c-C-class-key c-baseclass-key nil c-comment-start-regexp c-C-comment-start-regexp) (run-hooks 'c-mode-common-hook) (run-hooks 'c-mode-hook)) (setq c-list-of-mode-names (cons "C" c-list-of-mode-names)) ;;;###autoload (defun objc-mode () "Major mode for editing Objective C code. To submit a problem report, enter `\\[c-submit-bug-report]' from an objc-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the problem, including a reproducable test case and send the message. To see what version of cc-mode you are running, enter `\\[c-version]'. The hook variable `objc-mode-hook' is run with no args, if that value is bound and has a non-nil value. Also the common hook c-mode-common-hook is run first, by this defun, `c-mode', and `c++-mode'. Key bindings: \\{objc-mode-map}" (interactive) (kill-all-local-variables) (set-syntax-table objc-mode-syntax-table) (setq major-mode 'objc-mode mode-name "ObjC" local-abbrev-table objc-mode-abbrev-table) (use-local-map objc-mode-map) (c-common-init) (setq comment-start "// " comment-end "" comment-multi-line nil c-conditional-key c-C-conditional-key c-comment-start-regexp c-C++-comment-start-regexp c-class-key c-ObjC-class-key c-baseclass-key nil c-access-key c-ObjC-access-key) (run-hooks 'c-mode-common-hook) (run-hooks 'objc-mode-hook)) (setq c-list-of-mode-names (cons "ObjC" c-list-of-mode-names)) (defun c-common-init () ;; Common initializations for c++-mode and c-mode. ;; make local variables (make-local-variable 'paragraph-start) (make-local-variable 'paragraph-separate) (make-local-variable 'paragraph-ignore-fill-prefix) (make-local-variable 'require-final-newline) (make-local-variable 'parse-sexp-ignore-comments) (make-local-variable 'indent-line-function) (make-local-variable 'indent-region-function) (make-local-variable 'comment-start) (make-local-variable 'comment-end) (make-local-variable 'comment-column) (make-local-variable 'comment-start-skip) (make-local-variable 'outline-regexp) (make-local-variable 'outline-level) (make-local-variable 'adaptive-fill-regexp) ;; now set their values (setq paragraph-start (concat page-delimiter "\\|$") paragraph-separate paragraph-start paragraph-ignore-fill-prefix t require-final-newline t parse-sexp-ignore-comments t indent-line-function 'c-indent-line indent-region-function 'c-indent-region outline-regexp "[^#\n\^M]" outline-level 'c-outline-level comment-column 32 comment-start-skip "/\\*+ *\\|// *" adaptive-fill-regexp nil) ;; we have to do something special for c-offsets-alist so that the ;; buffer local value has its own alist structure. (setq c-offsets-alist (copy-alist c-offsets-alist)) ;; setup the comment indent variable in a Emacs version portable way ;; ignore any byte compiler warnings you might get here (if (boundp 'comment-indent-function) (progn (make-local-variable 'comment-indent-function) (setq comment-indent-function 'c-comment-indent)) (make-local-variable 'comment-indent-hook) (setq comment-indent-hook 'c-comment-indent)) ;; put C menu into menubar and on popup menu for XEmacs (formerly ;; Lucid) 19. I think this happens automatically for Emacs 19. (if (and (boundp 'current-menubar) current-menubar (not (assoc mode-name current-menubar))) ;; its possible that this buffer has changed modes from one of ;; the other cc-mode modes. In that case, only the menubar ;; title of the menu changes. (let ((modes (copy-sequence c-list-of-mode-names)) changed-p) (setq modes (delete major-mode modes)) (while modes (if (not (assoc (car modes) current-menubar)) (setq modes (cdr modes)) (relabel-menu-item (list (car modes)) mode-name) (setq modes nil changed-p t))) (if (not changed-p) (progn (set-buffer-menubar (copy-sequence current-menubar)) (add-menu nil mode-name c-mode-menu))))) (if (boundp 'mode-popup-menu) (setq mode-popup-menu (cons (concat mode-name " Mode Commands") c-mode-menu))) ;; put auto-hungry designators onto minor-mode-alist, but only once (or (assq 'c-auto-hungry-string minor-mode-alist) (setq minor-mode-alist (cons '(c-auto-hungry-string c-auto-hungry-string) minor-mode-alist)))) (defun c-postprocess-file-styles () "Function that post processes relevent file local variables. Currently, this function simply applies any style and offset settings found in the file's Local Variable list. It first applies any style setting found in `c-file-style', then it applies any offset settings it finds in `c-file-offsets'." ;; apply file styles and offsets (and c-file-style (c-set-style c-file-style)) (and c-file-offsets (mapcar (function (lambda (langentry) (let ((langelem (car langentry)) (offset (cdr langentry))) (c-set-offset langelem offset) ))) c-file-offsets))) ;; Add the posprocessing function to hack-local-variables-hook. As of ;; 28-Aug-1995, XEmacs 19.12 and Emacs 19.29 support this. (and (fboundp 'add-hook) (add-hook 'hack-local-variables-hook 'c-postprocess-file-styles)) (defun c-enable-//-in-c-mode () "Enables // as a comment delimiter in `c-mode'. ANSI C currently does *not* allow this, although many C compilers support optional C++ style comments. To use, call this function from your `.emacs' file before you visit any C files. The changes are global and affect all future `c-mode' buffers." (c-setup-dual-comments c-mode-syntax-table) (setq-default c-C-comment-start-regexp c-C++-comment-start-regexp)) ;; macros must be defined before first use (defmacro c-point (position) ;; Returns the value of point at certain commonly referenced POSITIONs. ;; POSITION can be one of the following symbols: ;; ;; bol -- beginning of line ;; eol -- end of line ;; bod -- beginning of defun ;; boi -- back to indentation ;; ionl -- indentation of next line ;; iopl -- indentation of previous line ;; bonl -- beginning of next line ;; bopl -- beginning of previous line ;; ;; This function does not modify point or mark. (or (and (eq 'quote (car-safe position)) (null (cdr (cdr position)))) (error "bad buffer position requested: %s" position)) (setq position (nth 1 position)) (` (let ((here (point))) (,@ (cond ((eq position 'bol) '((beginning-of-line))) ((eq position 'eol) '((end-of-line))) ((eq position 'bod) '((beginning-of-defun) ;; if defun-prompt-regexp is non-nil, b-o-d won't leave ;; us at the open brace. (and (boundp 'defun-prompt-regexp) defun-prompt-regexp (looking-at defun-prompt-regexp) (goto-char (match-end 0))) )) ((eq position 'boi) '((back-to-indentation))) ((eq position 'bonl) '((forward-line 1))) ((eq position 'bopl) '((forward-line -1))) ((eq position 'iopl) '((forward-line -1) (back-to-indentation))) ((eq position 'ionl) '((forward-line 1) (back-to-indentation))) (t (error "unknown buffer position requested: %s" position)) )) (prog1 (point) (goto-char here)) ;; workaround for an Emacs18 bug -- blech! Well, at least it ;; doesn't hurt for v19 (,@ nil) ))) (defmacro c-auto-newline () ;; if auto-newline feature is turned on, insert a newline character ;; and return t, otherwise return nil. (` (and c-auto-newline (not (c-in-literal)) (not (newline))))) (defmacro c-safe (&rest body) ;; safely execute BODY, return nil if an error occurred (` (condition-case nil (progn (,@ body)) (error nil)))) (defun c-insert-special-chars (arg) ;; simply call self-insert-command in Emacs 19 (self-insert-command (prefix-numeric-value arg))) (defun c-intersect-lists (list alist) ;; return the element of ALIST that matches the first element found ;; in LIST. Uses assq. (let (match) (while (and list (not (setq match (assq (car list) alist)))) (setq list (cdr list))) match)) (defun c-lookup-lists (list alist1 alist2) ;; first, find the first entry from LIST that is present in ALIST1, ;; then find the entry in ALIST2 for that entry. (assq (car (c-intersect-lists list alist1)) alist2)) ;; This is used by indent-for-comment to decide how much to indent a ;; comment in C code based on its context. (defun c-comment-indent () (if (looking-at (concat "^\\(" c-comment-start-regexp "\\)")) 0 ;Existing comment at bol stays there. (let ((opoint (point)) placeholder) (save-excursion (beginning-of-line) (cond ;; CASE 1: A comment following a solitary close-brace should ;; have only one space. ((looking-at (concat "[ \t]*}[ \t]*\\($\\|" c-comment-start-regexp "\\)")) (search-forward "}") (1+ (current-column))) ;; CASE 2: 2 spaces after #endif ((or (looking-at "^#[ \t]*endif[ \t]*") (looking-at "^#[ \t]*else[ \t]*")) 7) ;; CASE 3: when comment-column is nil, calculate the offset ;; according to c-offsets-alist. E.g. identical to hitting ;; TAB. ((and c-indent-comments-syntactically-p (save-excursion (skip-chars-forward " \t") (or (looking-at comment-start) (eolp)))) (let ((syntax (c-guess-basic-syntax))) ;; BOGOSITY ALERT: if we're looking at the eol, its ;; because indent-for-comment hasn't put the comment-start ;; in the buffer yet. this will screw up the syntactic ;; analysis so we kludge in the necessary info. Another ;; kludge is that if we're at the bol, then we really want ;; to ignore any anchoring as specified by ;; c-comment-only-line-offset since it doesn't apply here. (if (save-excursion (beginning-of-line) (skip-chars-forward " \t") (eolp)) (c-add-syntax 'comment-intro)) (let ((c-comment-only-line-offset (if (consp c-comment-only-line-offset) c-comment-only-line-offset (cons c-comment-only-line-offset c-comment-only-line-offset)))) (apply '+ (mapcar 'c-get-offset syntax))))) ;; CASE 4: use comment-column if previous line is a ;; comment-only line indented to the left of comment-column ((save-excursion (beginning-of-line) (and (not (bobp)) (forward-line -1)) (skip-chars-forward " \t") (prog1 (looking-at c-comment-start-regexp) (setq placeholder (point)))) (goto-char placeholder) (if (< (current-column) comment-column) comment-column (current-column))) ;; CASE 5: If comment-column is 0, and nothing but space ;; before the comment, align it at 0 rather than 1. ((progn (goto-char opoint) (skip-chars-backward " \t") (and (= comment-column 0) (bolp))) 0) ;; CASE 6: indent at comment column except leave at least one ;; space. (t (max (1+ (current-column)) comment-column)) ))))) ;; used by outline-minor-mode (defun c-outline-level () (save-excursion (skip-chars-forward "\t ") (current-column))) ;; active regions, and auto-newline/hungry delete key (defun c-keep-region-active () ;; do whatever is necessary to keep the region active in Xemacs ;; (formerly Lucid). ignore byte-compiler warnings you might see (and (boundp 'zmacs-region-stays) (setq zmacs-region-stays t))) (defun c-update-modeline () ;; set the c-auto-hungry-string for the correct designation on the modeline (setq c-auto-hungry-string (if c-auto-newline (if c-hungry-delete-key "/ah" "/a") (if c-hungry-delete-key "/h" nil))) ;; updates the modeline for all Emacsen (if (memq 'v19 c-emacs-features) (force-mode-line-update) (set-buffer-modified-p (buffer-modified-p)))) (defun c-calculate-state (arg prevstate) ;; Calculate the new state of PREVSTATE, t or nil, based on arg. If ;; arg is nil or zero, toggle the state. If arg is negative, turn ;; the state off, and if arg is positive, turn the state on (if (or (not arg) (zerop (setq arg (prefix-numeric-value arg)))) (not prevstate) (> arg 0))) (defun c-toggle-auto-state (arg) "Toggle auto-newline feature. Optional numeric ARG, if supplied turns on auto-newline when positive, turns it off when negative, and just toggles it when zero. When the auto-newline feature is enabled (as evidenced by the `/a' or `/ah' on the modeline after the mode name) newlines are automatically inserted after special characters such as brace, comma, semi-colon, and colon." (interactive "P") (setq c-auto-newline (c-calculate-state arg c-auto-newline)) (c-update-modeline) (c-keep-region-active)) (defun c-toggle-hungry-state (arg) "Toggle hungry-delete-key feature. Optional numeric ARG, if supplied turns on hungry-delete when positive, turns it off when negative, and just toggles it when zero. When the hungry-delete-key feature is enabled (as evidenced by the `/h' or `/ah' on the modeline after the mode name) the delete key gobbles all preceding whitespace in one fell swoop." (interactive "P") (setq c-hungry-delete-key (c-calculate-state arg c-hungry-delete-key)) (c-update-modeline) (c-keep-region-active)) (defun c-toggle-auto-hungry-state (arg) "Toggle auto-newline and hungry-delete-key features. Optional numeric ARG, if supplied turns on auto-newline and hungry-delete when positive, turns them off when negative, and just toggles them when zero. See `c-toggle-auto-state' and `c-toggle-hungry-state' for details." (interactive "P") (setq c-auto-newline (c-calculate-state arg c-auto-newline)) (setq c-hungry-delete-key (c-calculate-state arg c-hungry-delete-key)) (c-update-modeline) (c-keep-region-active)) ;; COMMANDS (defun c-electric-delete (arg) "Deletes preceding character or whitespace. If `c-hungry-delete-key' is non-nil, as evidenced by the \"/h\" or \"/ah\" string on the mode line, then all preceding whitespace is consumed. If however an ARG is supplied, or `c-hungry-delete-key' is nil, or point is inside a literal then the function in the variable `c-delete-function' is called." (interactive "P") (if (or (not c-hungry-delete-key) arg (c-in-literal)) (funcall c-delete-function (prefix-numeric-value arg)) (let ((here (point))) (skip-chars-backward " \t\n") (if (/= (point) here) (delete-region (point) here) (funcall c-delete-function 1) )))) (defun c-electric-pound (arg) "Electric pound (`#') insertion. Inserts a `#' character specially depending on the variable `c-electric-pound-behavior'. If a numeric ARG is supplied, or if point is inside a literal, nothing special happens." (interactive "P") (if (or (c-in-literal) arg (not (memq 'alignleft c-electric-pound-behavior))) ;; do nothing special (self-insert-command (prefix-numeric-value arg)) ;; place the pound character at the left edge (let ((pos (- (point-max) (point))) (bolp (bolp))) (beginning-of-line) (delete-horizontal-space) (insert-char last-command-char 1) (and (not bolp) (goto-char (- (point-max) pos))) ))) (defun c-electric-brace (arg) "Insert a brace. If the auto-newline feature is turned on, as evidenced by the \"/a\" or \"/ah\" string on the mode line, newlines are inserted before and after braces based on the value of `c-hanging-braces-alist'. Also, the line is re-indented unless a numeric ARG is supplied, there are non-whitespace characters present on the line after the brace, or the brace is inserted inside a literal." (interactive "P") (let* ((c-state-cache (c-parse-state)) (safepos (c-safe-position (point) c-state-cache)) (literal (c-in-literal safepos))) ;; if we're in a literal, or we're not at the end of the line, or ;; a numeric arg is provided, or auto-newlining is turned off, ;; then just insert the character. (if (or literal arg ; (not c-auto-newline) (not (looking-at "[ \t]*$"))) (c-insert-special-chars arg) (let* ((syms '(class-open class-close defun-open defun-close inline-open inline-close brace-list-open brace-list-close brace-list-intro brace-list-entry block-open block-close substatement-open statement-case-open)) ;; we want to inhibit blinking the paren since this will ;; be most disruptive. we'll blink it ourselves later on (old-blink-paren (if (boundp 'blink-paren-function) blink-paren-function blink-paren-hook)) blink-paren-function ; emacs19 blink-paren-hook ; emacs18 (insertion-point (point)) delete-temp-newline (preserve-p (= 32 (char-syntax (preceding-char)))) ;; shut this up too (c-echo-syntactic-information-p nil) (syntax (progn ;; only insert a newline if there is ;; non-whitespace behind us (if (save-excursion (skip-chars-backward " \t") (not (bolp))) (progn (newline) (setq delete-temp-newline t))) (self-insert-command (prefix-numeric-value arg)) ;; state cache doesn't change (c-guess-basic-syntax))) (newlines (and c-auto-newline (or (c-lookup-lists syms syntax c-hanging-braces-alist) '(ignore before after))))) ;; If syntax is a function symbol, then call it using the ;; defined semantics. (if (and (not (consp (cdr newlines))) (fboundp (cdr newlines))) (let ((c-syntactic-context syntax)) (setq newlines (funcall (cdr newlines) (car newlines) insertion-point)))) ;; does a newline go before the open brace? (if (memq 'before newlines) ;; we leave the newline we've put in there before, ;; but we need to re-indent the line above (let ((pos (- (point-max) (point))) (here (point)) (c-state-cache c-state-cache)) (forward-line -1) ;; we may need to update the cache. this should still be ;; faster than recalculating the state in many cases (save-excursion (save-restriction (narrow-to-region here (point)) (if (and (c-safe (progn (backward-up-list -1) t)) (memq (preceding-char) '(?\) ?})) (progn (widen) (c-safe (progn (forward-sexp -1) t)))) (setq c-state-cache (c-hack-state (point) 'open c-state-cache)) (if (and (car c-state-cache) (not (consp (car c-state-cache))) (<= (point) (car c-state-cache))) (setq c-state-cache (cdr c-state-cache)) )))) (let ((here (point)) (shift (c-indent-line))) (setq c-state-cache (c-adjust-state (c-point 'bol) here (- shift) c-state-cache))) (goto-char (- (point-max) pos)) ;; if the buffer has changed due to the indentation, we ;; need to recalculate syntax for the current line, but ;; we won't need to update the state cache. (if (/= (point) here) (setq syntax (c-guess-basic-syntax)))) ;; must remove the newline we just stuck in (if we really did it) (and delete-temp-newline (save-excursion ;; if there is whitespace before point, then preserve ;; at least one space. (delete-indentation) (just-one-space) (if (not preserve-p) (delete-char -1)))) ;; since we're hanging the brace, we need to recalculate ;; syntax. Update the state to accurately reflect the ;; beginning of the line. We punt if we cross any open or ;; closed parens because its just too hard to modify the ;; known state. This limitation will be fixed in v5. (save-excursion (let ((bol (c-point 'bol))) (if (zerop (car (parse-partial-sexp bol (1- (point))))) (setq c-state-cache (c-whack-state bol c-state-cache) syntax (c-guess-basic-syntax)) ;; gotta punt. this requires some horrible kludgery (beginning-of-line) (makunbound 'c-state-cache) (setq c-state-cache (c-parse-state) syntax nil)))) ) ;; now adjust the line's indentation. don't update the state ;; cache since c-guess-basic-syntax isn't called when the ;; syntax is passed to c-indent-line (let ((here (point)) (shift (c-indent-line syntax))) (setq c-state-cache (c-adjust-state (c-point 'bol) here (- shift) c-state-cache))) ;; Do all appropriate clean ups (let ((here (point)) (pos (- (point-max) (point))) mbeg mend) ;; clean up empty defun braces (if (and c-auto-newline (memq 'empty-defun-braces c-cleanup-list) (= last-command-char ?\}) (c-intersect-lists '(defun-close class-close inline-close) syntax) (progn (forward-char -1) (skip-chars-backward " \t\n") (= (preceding-char) ?\{)) ;; make sure matching open brace isn't in a comment (not (c-in-literal))) (delete-region (point) (1- here))) ;; clean up brace-else-brace (if (and c-auto-newline (memq 'brace-else-brace c-cleanup-list) (= last-command-char ?\{) (re-search-backward "}[ \t\n]*else[ \t\n]*{" nil t) (progn (setq mbeg (match-beginning 0) mend (match-end 0)) (= mend here)) (not (c-in-literal))) (progn (delete-region mbeg mend) (insert "} else {"))) (goto-char (- (point-max) pos)) ) ;; does a newline go after the brace? (if (memq 'after newlines) (progn (newline) ;; update on c-state-cache (let* ((bufpos (- (point) 2)) (which (if (= (char-after bufpos) ?{) 'open 'close)) (c-state-cache (c-hack-state bufpos which c-state-cache))) (c-indent-line)))) ;; blink the paren (and (= last-command-char ?\}) old-blink-paren (save-excursion (c-backward-syntactic-ws safepos) (if (boundp 'blink-paren-function) (funcall old-blink-paren) (run-hooks old-blink-paren)))) )))) (defun c-electric-slash (arg) "Insert a slash character. If slash is second of a double-slash C++ style comment introducing construct, and we are on a comment-only-line, indent line as comment. If numeric ARG is supplied or point is inside a literal, indentation is inhibited." (interactive "P") (let ((indentp (and (memq major-mode '(c++-mode objc-mode)) (not arg) (= (preceding-char) ?/) (= last-command-char ?/) (not (c-in-literal)))) ;; shut this up (c-echo-syntactic-information-p nil)) (self-insert-command (prefix-numeric-value arg)) (if indentp (c-indent-line)))) (defun c-electric-star (arg) "Insert a star character. If the star is the second character of a C style comment introducing construct, and we are on a comment-only-line, indent line as comment. If numeric ARG is supplied or point is inside a literal, indentation is inhibited." (interactive "P") (self-insert-command (prefix-numeric-value arg)) ;; if we are in a literal, or if arg is given do not re-indent the ;; current line, unless this star introduces a comment-only line. (if (and (not arg) (memq (c-in-literal) '(c)) (= (preceding-char) ?*) (save-excursion (forward-char -1) (skip-chars-backward "*") (if (= (preceding-char) ?/) (forward-char -1)) (skip-chars-backward " \t") (bolp))) ;; shut this up (let (c-echo-syntactic-information-p) (c-indent-line)) )) (defun c-electric-semi&comma (arg) "Insert a comma or semicolon. When the auto-newline feature is turned on, as evidenced by the \"/a\" or \"/ah\" string on the mode line, a newline might be inserted. See the variable `c-hanging-semi&comma-criteria' for how newline insertion is determined. When semicolon is inserted, the line is re-indented unless a numeric arg is supplied, point is inside a literal, or there are non-whitespace characters on the line following the semicolon." (interactive "P") (let* ((lim (c-most-enclosing-brace (c-parse-state))) (literal (c-in-literal lim)) (here (point)) ;; shut this up (c-echo-syntactic-information-p nil)) (if (or literal arg (not (looking-at "[ \t]*$"))) (c-insert-special-chars arg) ;; do some special stuff with the character (self-insert-command (prefix-numeric-value arg)) ;; do all cleanups, reindentations, and newline insertions, but ;; only if c-auto-newline is turned on (if (not c-auto-newline) nil ;; clean ups (let ((pos (- (point-max) (point)))) (if (and (or (and (= last-command-char ?,) (memq 'list-close-comma c-cleanup-list)) (and (= last-command-char ?\;) (memq 'defun-close-semi c-cleanup-list))) (progn (forward-char -1) (skip-chars-backward " \t\n") (= (preceding-char) ?})) ;; make sure matching open brace isn't in a comment (not (c-in-literal lim))) (delete-region (point) here)) (goto-char (- (point-max) pos))) ;; re-indent line (c-indent-line) ;; check to see if a newline should be added (let ((criteria c-hanging-semi&comma-criteria) answer add-newline-p) (while criteria (setq answer (funcall (car criteria))) ;; only nil value means continue checking (if (not answer) (setq criteria (cdr criteria)) (setq criteria nil) ;; only 'stop specifically says do not add a newline (setq add-newline-p (not (eq answer 'stop))) )) (if add-newline-p (progn (newline) (c-indent-line))) ))))) (defun c-semi&comma-inside-parenlist () "Determine if a newline should be added after a semicolon. If a comma was inserted, no determination is made. If a semicolon was inserted inside a parenthesis list, no newline is added otherwise a newline is added. In either case, checking is stopped. This supports exactly the old newline insertion behavior." ;; newline only after semicolon, but only if that semicolon is not ;; inside a parenthesis list (e.g. a for loop statement) (if (/= last-command-char ?\;) nil ; continue checking (if (condition-case nil (save-excursion (up-list -1) (/= (following-char) ?\()) (error t)) t 'stop))) (defun c-electric-colon (arg) "Insert a colon. If the auto-newline feature is turned on, as evidenced by the \"/a\" or \"/ah\" string on the mode line, newlines are inserted before and after colons based on the value of `c-hanging-colons-alist'. Also, the line is re-indented unless a numeric ARG is supplied, there are non-whitespace characters present on the line after the colon, or the colon is inserted inside a literal. This function cleans up double colon scope operators based on the value of `c-cleanup-list'." (interactive "P") (let* ((bod (c-point 'bod)) (literal (c-in-literal bod)) syntax newlines ;; shut this up (c-echo-syntactic-information-p nil)) (if (or literal arg (not (looking-at "[ \t]*$"))) (c-insert-special-chars arg) ;; insert the colon, then do any specified cleanups (self-insert-command (prefix-numeric-value arg)) (let ((pos (- (point-max) (point))) (here (point))) (if (and c-auto-newline (memq 'scope-operator c-cleanup-list) (= (preceding-char) ?:) (progn (forward-char -1) (skip-chars-backward " \t\n") (= (preceding-char) ?:)) (not (c-in-literal)) (not (= (char-after (- (point) 2)) ?:))) (delete-region (point) (1- here))) (goto-char (- (point-max) pos))) ;; lets do some special stuff with the colon character (setq syntax (c-guess-basic-syntax) ;; some language elements can only be determined by ;; checking the following line. Lets first look for ones ;; that can be found when looking on the line with the ;; colon newlines (and c-auto-newline (or (c-lookup-lists '(case-label label access-label) syntax c-hanging-colons-alist) (c-lookup-lists '(member-init-intro inher-intro) (prog2 (insert "\n") (c-guess-basic-syntax) (delete-char -1)) c-hanging-colons-alist)))) ;; indent the current line (c-indent-line syntax) ;; does a newline go before the colon? Watch out for already ;; non-hung colons. However, we don't unhang them because that ;; would be a cleanup (and anti-social). (if (and (memq 'before newlines) (save-excursion (skip-chars-backward ": \t") (not (bolp)))) (let ((pos (- (point-max) (point)))) (forward-char -1) (newline) (c-indent-line) (goto-char (- (point-max) pos)))) ;; does a newline go after the colon? (if (memq 'after (cdr-safe newlines)) (progn (newline) (c-indent-line))) ))) ;; set up electric character functions to work with pending-del, ;; (a.k.a. delsel) mode. All symbols get the t value except ;; c-electric-delete which gets 'supercede. (mapcar (function (lambda (sym) (put sym 'delete-selection t) ; for delsel (Emacs) (put sym 'pending-delete t))) ; for pending-del (XEmacs) '(c-electric-pound c-electric-brace c-electric-slash c-electric-star c-electric-semi&comma c-electric-colon)) (put 'c-electric-delete 'delete-selection 'supersede) ; delsel (put 'c-electric-delete 'pending-delete 'supersede) ; pending-del (defun c-read-offset (langelem) ;; read new offset value for LANGELEM from minibuffer. return a ;; legal value only (let* ((oldoff (cdr-safe (assq langelem c-offsets-alist))) (defstr (format "(default %s): " oldoff)) (errmsg (concat "Offset must be int, func, var, " "or in [+,-,++,--,*,/] " defstr)) (prompt (concat "Offset " defstr)) offset input interned) (while (not offset) (setq input (read-string prompt) offset (cond ((string-equal "" input) oldoff) ; default ((string-equal "+" input) '+) ((string-equal "-" input) '-) ((string-equal "++" input) '++) ((string-equal "--" input) '--) ((string-equal "*" input) '*) ((string-equal "/" input) '/) ((string-match "^-?[0-9]+$" input) (string-to-int input)) ((fboundp (setq interned (intern input))) interned) ((boundp interned) interned) ;; error, but don't signal one, keep trying ;; to read an input value (t (ding) (setq prompt errmsg) nil)))) offset)) (defun c-set-offset (symbol offset &optional add-p) "Change the value of a syntactic element symbol in `c-offsets-alist'. SYMBOL is the syntactic element symbol to change and OFFSET is the new offset for that syntactic element. Optional ADD says to add SYMBOL to `c-offsets-alist' if it doesn't already appear there." (interactive (let* ((langelem (intern (completing-read (concat "Syntactic symbol to change" (if current-prefix-arg " or add" "") ": ") (mapcar (function (lambda (langelem) (cons (format "%s" (car langelem)) nil))) c-offsets-alist) nil (not current-prefix-arg) ;; initial contents tries to be the last element ;; on the syntactic analysis list for the current ;; line (let* ((syntax (c-guess-basic-syntax)) (len (length syntax)) (ic (format "%s" (car (nth (1- len) syntax))))) (if (memq 'v19 c-emacs-features) (cons ic 0) ic)) ))) (offset (c-read-offset langelem))) (list langelem offset current-prefix-arg))) ;; sanity check offset (or (eq offset '+) (eq offset '-) (eq offset '++) (eq offset '--) (eq offset '*) (eq offset '/) (integerp offset) (fboundp offset) (boundp offset) (error "Offset must be int, func, var, or in [+,-,++,--,*,/]: %s" offset)) (let ((entry (assq symbol c-offsets-alist))) (if entry (setcdr entry offset) (if add-p (setq c-offsets-alist (cons (cons symbol offset) c-offsets-alist)) (error "%s is not a valid syntactic symbol." symbol)))) (c-keep-region-active)) (defun c-set-style-1 (stylevars) ;; given a style's variable alist, institute the style (mapcar (function (lambda (conscell) (let ((attr (car conscell)) (val (cdr conscell))) ;; KLUDGE ALERT: special case for c-offsets-alist (if (not (eq attr 'c-offsets-alist)) (set attr val) (mapcar (function (lambda (langentry) (let ((langelem (car langentry)) (offset (cdr langentry))) (c-set-offset langelem offset) ))) val)) ))) stylevars)) (defun c-set-style (stylename) "Set cc-mode variables to use one of several different indentation styles. STYLENAME is a string representing the desired style from the list of styles described in the variable `c-style-alist'. See that variable for details of setting up styles." (interactive (list (let ((completion-ignore-case t) (prompt (format "Which %s indentation style? " mode-name))) (completing-read prompt c-style-alist nil t)))) (let ((vars (cdr (assoc stylename c-style-alist))) (default (cdr (assoc "CC-MODE" c-style-alist)))) (or vars (error "Invalid indentation style `%s'" stylename)) (or default (error "No \"CC-MODE\" style found!")) ;; first reset the style to CC-MODE to give every style a common ;; base. Then institute the new style. (c-set-style-1 default) (if (not (string= stylename "CC-MODE")) (c-set-style-1 vars))) (c-keep-region-active)) (defun c-add-style (style descrip &optional set-p) "Adds a style to `c-style-alist', or updates an existing one. STYLE is a string identifying the style to add or update. DESCRIP is an association list describing the style and must be of the form: ((VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) See the variable `c-style-alist' for the semantics of VARIABLE and VALUE. This function also sets the current style to STYLE using `c-set-style' if the optional SET-P flag is non-nil." (interactive (let ((stylename (completing-read "Style to add: " c-style-alist)) (description (eval-minibuffer "Style description: "))) (list stylename description (y-or-n-p "Set the style too? ")))) (let ((s (assoc style c-style-alist))) (if s (setcdr s (copy-alist descrip)) ; replace (setq c-style-alist (cons (cons style descrip) c-style-alist)))) (and set-p (c-set-style style))) (defun c-fill-paragraph (&optional arg) "Like \\[fill-paragraph] but handles C and C++ style comments. If any of the current line is a comment or within a comment, fill the comment or the paragraph of it that point is in, preserving the comment indentation or line-starting decorations. Optional prefix ARG means justify paragraph as well." (interactive "P") (let* (comment-start-place (first-line ;; Check for obvious entry to comment. (save-excursion (beginning-of-line) (skip-chars-forward " \t\n") (and (looking-at comment-start-skip) (setq comment-start-place (point)))))) (if (and (memq major-mode '(c++-mode objc-mode)) (save-excursion (beginning-of-line) (looking-at ".*//"))) (let (fill-prefix (paragraph-start ;; Lines containing just a comment start or just an end ;; should not be filled into paragraphs they are next to. (concat paragraph-start "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$")) (paragraph-separate (concat paragraph-separate "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$"))) (save-excursion (beginning-of-line) ;; Move up to first line of this comment. (while (and (not (bobp)) (looking-at "[ \t]*//")) (forward-line -1)) (if (not (looking-at ".*//")) (forward-line 1)) ;; Find the comment start in this line. (re-search-forward "[ \t]*//[ \t]*") ;; Set the fill-prefix to be what all lines except the first ;; should start with. (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0))) (save-restriction ;; Narrow down to just the lines of this comment. (narrow-to-region (c-point 'bol) (save-excursion (forward-line 1) (while (looking-at fill-prefix) (forward-line 1)) (point))) (fill-paragraph arg) ))) ;; else C style comments (if (or first-line ;; t if we enter a comment between start of function and ;; this line. (eq (c-in-literal) 'c) ;; t if this line contains a comment starter. (setq first-line (save-excursion (beginning-of-line) (prog1 (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t) (setq comment-start-place (point)))))) ;; Inside a comment: fill one comment paragraph. (let ((fill-prefix ;; The prefix for each line of this paragraph ;; is the appropriate part of the start of this line, ;; up to the column at which text should be indented. (save-excursion (beginning-of-line) (if (looking-at "[ \t]*/\\*.*\\*/") (progn (re-search-forward comment-start-skip) (make-string (current-column) ?\ )) (if first-line (forward-line 1)) (let ((line-width (progn (end-of-line) (current-column)))) (beginning-of-line) (prog1 (buffer-substring (point) ;; How shall we decide where the end of the ;; fill-prefix is? (progn (beginning-of-line) (skip-chars-forward " \t*" (c-point 'eol)) (point))) ;; If the comment is only one line followed ;; by a blank line, calling move-to-column ;; above may have added some spaces and tabs ;; to the end of the line; the fill-paragraph ;; function will then delete it and the ;; newline following it, so we'll lose a ;; blank line when we shouldn't. So delete ;; anything move-to-column added to the end ;; of the line. We record the line width ;; instead of the position of the old line ;; end because move-to-column might break a ;; tab into spaces, and the new characters ;; introduced there shouldn't be deleted. ;; If you can see a better way to do this, ;; please make the change. This seems very ;; messy to me. (delete-region (progn (move-to-column line-width) (point)) (progn (end-of-line) (point)))))))) (paragraph-start ;; Lines containing just a comment start or just an end ;; should not be filled into paragraphs they are next to. (concat paragraph-start "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$")) (paragraph-separate (concat paragraph-separate "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$")) (chars-to-delete 0)) (save-restriction ;; Don't fill the comment together with the code ;; following it. So temporarily exclude everything ;; before the comment start, and everything after the ;; line where the comment ends. If comment-start-place ;; is non-nil, the comment starter is there. Otherwise, ;; point is inside the comment. (narrow-to-region (save-excursion (if comment-start-place (goto-char comment-start-place) (search-backward "/*")) ;; Protect text before the comment ;; start by excluding it. Add ;; spaces to bring back proper ;; indentation of that point. (let ((column (current-column))) (prog1 (point) (setq chars-to-delete column) (insert-char ?\ column)))) (save-excursion (if comment-start-place (goto-char (+ comment-start-place 2))) (search-forward "*/" nil 'move) (forward-line 1) (point))) (fill-paragraph arg) (save-excursion ;; Delete the chars we inserted to avoid clobbering ;; the stuff before the comment start. (goto-char (point-min)) (if (> chars-to-delete 0) (delete-region (point) (+ (point) chars-to-delete))) ;; Find the comment ender (should be on last line of ;; buffer, given the narrowing) and don't leave it on ;; its own line, unless that's the style that's desired. (goto-char (point-max)) (forward-line -1) (search-forward "*/" nil 'move) (beginning-of-line) (if (and c-hanging-comment-ender-p (looking-at "[ \t]*\\*/")) ;(delete-indentation))))) (let ((fill-column (+ fill-column 9999))) (forward-line -1) (fill-region-as-paragraph (point) (point-max))))))) ;; Outside of comments: do ordinary filling. (fill-paragraph arg))))) ;; better movement routines for ThisStyleOfVariablesCommonInCPlusPlus ;; originally contributed by Terry_Glanfield.Southern@rxuk.xerox.com (defun c-forward-into-nomenclature (&optional arg) "Move forward to end of a nomenclature section or word. With arg, to it arg times." (interactive "p") (let ((case-fold-search nil)) (if (> arg 0) (re-search-forward "\\W*\\([A-Z]*[a-z0-9]*\\)" (point-max) t arg) (while (and (< arg 0) (re-search-backward "\\(\\(\\W\\|[a-z0-9]\\)[A-Z]+\\|\\W\\w+\\)" (point-min) 0)) (forward-char 1) (setq arg (1+ arg))))) (c-keep-region-active)) (defun c-backward-into-nomenclature (&optional arg) "Move backward to beginning of a nomenclature section or word. With optional ARG, move that many times. If ARG is negative, move forward." (interactive "p") (c-forward-into-nomenclature (- arg)) (c-keep-region-active)) (defun c-scope-operator () "Insert a double colon scope operator at point. No indentation or other \"electric\" behavior is performed." (interactive) (insert "::")) (defun c-beginning-of-statement (&optional count lim sentence-flag) "Go to the beginning of the innermost C statement. With prefix arg, go back N - 1 statements. If already at the beginning of a statement then go to the beginning of the preceding one. If within a string or comment, or next to a comment (only whitespace between), move by sentences instead of statements. When called from a program, this function takes 2 optional args: the repetition count, a buffer position limit which is the farthest back to search, and a flag saying whether to do sentence motion when in a comment." (interactive (list (prefix-numeric-value current-prefix-arg) nil t)) (let ((here (point)) (count (or count 1)) (lim (or lim (c-point 'bod))) state) (save-excursion (goto-char lim) (setq state (parse-partial-sexp (point) here nil nil))) (if (and sentence-flag (or (nth 3 state) (nth 4 state) (looking-at (concat "[ \t]*" comment-start-skip)) (save-excursion (skip-chars-backward " \t") (goto-char (- (point) 2)) (looking-at "\\*/")))) (forward-sentence (- count)) (while (> count 0) (c-beginning-of-statement-1 lim) (setq count (1- count))) (while (< count 0) (c-end-of-statement-1) (setq count (1+ count)))) ;; its possible we've been left up-buf of lim (goto-char (max (point) lim)) ) (c-keep-region-active)) (defun c-end-of-statement (&optional count lim sentence-flag) "Go to the end of the innermost C statement. With prefix arg, go forward N - 1 statements. Move forward to end of the next statement if already at end. If within a string or comment, move by sentences instead of statements. When called from a program, this function takes 2 optional args: the repetition count, a buffer position limit which is the farthest back to search, and a flag saying whether to do sentence motion when in a comment." (interactive (list (prefix-numeric-value current-prefix-arg) nil t)) (c-beginning-of-statement (- (or count 1)) lim sentence-flag) (c-keep-region-active)) (defun c-beginning-of-statement-1 (&optional lim) ;; move to the start of the current statement, or the previous ;; statement if already at the beginning of one. (let ((firstp t) (substmt-p t) donep c-in-literal-cache ;; KLUDGE ALERT: maybe-labelp is used to pass information ;; between c-crosses-statement-barrier-p and ;; c-beginning-of-statement-1. A better way should be ;; implemented. maybe-labelp (last-begin (point))) (while (not donep) ;; stop at beginning of buffer (if (bobp) (setq donep t) ;; go backwards one balanced expression, but be careful of ;; unbalanced paren being reached (if (not (c-safe (progn (backward-sexp 1) t))) (progn (if firstp (backward-up-list 1) (goto-char last-begin)) ;; skip over any unary operators, or other special ;; characters appearing at front of identifier (save-excursion (c-backward-syntactic-ws lim) (skip-chars-backward "-+!*&:.~ \t\n") (if (= (preceding-char) ?\() (setq last-begin (point)))) (goto-char last-begin) (setq last-begin (point) donep t))) (setq maybe-labelp nil) ;; see if we're in a literal. if not, then this bufpos may be ;; a candidate for stopping (cond ;; CASE 0: did we hit the error condition above? (donep) ;; CASE 1: are we in a literal? ((eq (c-in-literal lim) 'pound) (beginning-of-line)) ;; CASE 2: some other kind of literal? ((c-in-literal lim)) ;; CASE 3: are we looking at a conditional keyword? ((or (looking-at c-conditional-key) (and (= (following-char) ?\() (save-excursion (forward-sexp 1) (c-forward-syntactic-ws) (/= (following-char) ?\;)) (let ((here (point)) (foundp (progn (c-backward-syntactic-ws lim) (forward-word -1) (and lim (<= lim (point)) (not (c-in-literal lim)) ;;; (looking-at c-conditional-key) ;; backward-up-list could be slow ;; but I don't see any other way. (save-excursion (if (c-safe (progn (backward-up-list 1) t)) (/= (following-char) ?\() t)) )))) ;; did we find a conditional? (if (not foundp) (goto-char here)) foundp))) ;; are we in the middle of an else-if clause? (if (save-excursion (and (not substmt-p) (c-safe (progn (forward-sexp -1) t)) (looking-at "\\[ \t\n]+\\") (not (c-in-literal lim)))) (progn (forward-sexp -1) (c-backward-to-start-of-if lim))) ;; are we sitting at an else clause, that we are not a ;; substatement of? (if (and (not substmt-p) (looking-at "\\[^_]")) (c-backward-to-start-of-if lim)) ;; are we sitting at the while of a do-while? (if (and (looking-at "\\[^_]") (c-backward-to-start-of-do lim)) (setq substmt-p nil)) (setq last-begin (point) donep substmt-p)) ;; CASE 4: are we looking at a label? ((looking-at c-label-key)) ;; CASE 5: is this the first time we're checking? (firstp (setq firstp nil substmt-p (not (c-crosses-statement-barrier-p (point) last-begin)) last-begin (point))) ;; CASE 6: have we crossed a statement barrier? ((c-crosses-statement-barrier-p (point) last-begin) (setq donep t)) ;; CASE 7: ignore labels ((and maybe-labelp (or (and c-access-key (looking-at c-access-key)) ;; with switch labels, we have to go back further ;; to try to pick up the case or default ;; keyword. Potential bogosity alert: we assume ;; `case' or `default' is first thing on line (let ((here (point))) (beginning-of-line) (c-forward-syntactic-ws) (if (looking-at c-switch-label-key) t (goto-char here) nil)) (looking-at c-label-key)))) ;; CASE 8: ObjC method def ((and (eq major-mode 'objc-mode) (setq last-begin (c-in-objc-method-def-p))) (setq donep t)) ;; CASE 9: nothing special (t (setq last-begin (point))) ))) (goto-char last-begin) ;; we always do want to skip over non-whitespace modifier ;; characters that didn't get skipped above (skip-chars-backward "-+!*&:.~" (c-point 'boi)))) (defun c-end-of-statement-1 () (condition-case () (progn (while (and (not (eobp)) (let ((beg (point))) (forward-sexp 1) (let ((end (point))) (save-excursion (goto-char beg) (not (re-search-forward "[;{}]" end t))))))) (re-search-backward "[;}]") (forward-char 1)) (error (let ((beg (point))) (backward-up-list -1) (let ((end (point))) (goto-char beg) (search-forward ";" end 'move)))))) (defun c-crosses-statement-barrier-p (from to) ;; Does buffer positions FROM to TO cross a C statement boundary? (let ((here (point)) (lim from) crossedp) (condition-case () (progn (goto-char from) (while (and (not crossedp) (< (point) to)) (skip-chars-forward "^;{}:" to) (if (not (c-in-literal lim)) (progn (if (memq (following-char) '(?\; ?{ ?})) (setq crossedp t) (if (= (following-char) ?:) (setq maybe-labelp t)) (forward-char 1)) (setq lim (point))) (forward-char 1)))) (error (setq crossedp nil))) (goto-char here) crossedp)) (defun c-up-conditional (count) "Move back to the containing preprocessor conditional, leaving mark behind. A prefix argument acts as a repeat count. With a negative argument, move forward to the end of the containing preprocessor conditional. When going backwards, `#elif' is treated like `#else' followed by `#if'. When going forwards, `#elif' is ignored." (interactive "p") (c-forward-conditional (- count) t) (c-keep-region-active)) (defun c-backward-conditional (count &optional up-flag) "Move back across a preprocessor conditional, leaving mark behind. A prefix argument acts as a repeat count. With a negative argument, move forward across a preprocessor conditional." (interactive "p") (c-forward-conditional (- count) up-flag) (c-keep-region-active)) (defun c-forward-conditional (count &optional up-flag) "Move forward across a preprocessor conditional, leaving mark behind. A prefix argument acts as a repeat count. With a negative argument, move backward across a preprocessor conditional." (interactive "p") (let* ((forward (> count 0)) (increment (if forward -1 1)) (search-function (if forward 're-search-forward 're-search-backward)) (new)) (save-excursion (while (/= count 0) (let ((depth (if up-flag 0 -1)) found) (save-excursion ;; Find the "next" significant line in the proper direction. (while (and (not found) ;; Rather than searching for a # sign that ;; comes at the beginning of a line aside from ;; whitespace, search first for a string ;; starting with # sign. Then verify what ;; precedes it. This is faster on account of ;; the fastmap feature of the regexp matcher. (funcall search-function "#[ \t]*\\(if\\|elif\\|endif\\)" nil t)) (beginning-of-line) ;; Now verify it is really a preproc line. (if (looking-at "^[ \t]*#[ \t]*\\(if\\|elif\\|endif\\)") (let ((prev depth)) ;; Update depth according to what we found. (beginning-of-line) (cond ((looking-at "[ \t]*#[ \t]*endif") (setq depth (+ depth increment))) ((looking-at "[ \t]*#[ \t]*elif") (if (and forward (= depth 0)) (setq found (point)))) (t (setq depth (- depth increment)))) ;; If we are trying to move across, and we find an ;; end before we find a beginning, get an error. (if (and (< prev 0) (< depth prev)) (error (if forward "No following conditional at this level" "No previous conditional at this level"))) ;; When searching forward, start from next line so ;; that we don't find the same line again. (if forward (forward-line 1)) ;; If this line exits a level of conditional, exit ;; inner loop. (if (< depth 0) (setq found (point)))) ;; else (if forward (forward-line 1)) ))) (or found (error "No containing preprocessor conditional")) (goto-char (setq new found))) (setq count (+ count increment)))) (push-mark) (goto-char new)) (c-keep-region-active)) ;; commands to indent lines, regions, defuns, and expressions (defun c-indent-command (&optional whole-exp) "Indent current line as C++ code, or in some cases insert a tab character. If `c-tab-always-indent' is t, always just indent the current line. If nil, indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. If other than nil or t, then tab is inserted only within literals (comments and strings) and inside preprocessor directives, but line is always reindented. A numeric argument, regardless of its value, means indent rigidly all the lines of the expression starting after point so that this line becomes properly indented. The relative indentation among the lines of the expression are preserved." (interactive "P") (let ((bod (c-point 'bod))) (if whole-exp ;; If arg, always indent this line as C ;; and shift remaining lines of expression the same amount. (let ((shift-amt (c-indent-line)) beg end) (save-excursion (if (eq c-tab-always-indent t) (beginning-of-line)) (setq beg (point)) (forward-sexp 1) (setq end (point)) (goto-char beg) (forward-line 1) (setq beg (point))) (if (> end beg) (indent-code-rigidly beg end (- shift-amt) "#"))) ;; No arg supplied, use c-tab-always-indent to determine ;; behavior (cond ;; CASE 1: indent when at column zero or in lines indentation, ;; otherwise insert a tab ((not c-tab-always-indent) (if (save-excursion (skip-chars-backward " \t") (not (bolp))) (insert-tab) (c-indent-line))) ;; CASE 2: just indent the line ((eq c-tab-always-indent t) (c-indent-line)) ;; CASE 3: if in a literal, insert a tab, but always indent the ;; line (t (if (c-in-literal bod) (insert-tab)) (c-indent-line) ))))) (defun c-indent-exp (&optional shutup-p) "Indent each line in balanced expression following point. Optional SHUTUP-P if non-nil, inhibits message printing and error checking." (interactive "P") (let ((here (point)) end progress-p) (unwind-protect (let ((c-echo-syntactic-information-p nil) ;keep quiet for speed (start (progn ;; try to be smarter about finding the range of ;; lines to indent. skip all following ;; whitespace. failing that, try to find any ;; opening brace on the current line (skip-chars-forward " \t\n") (if (memq (following-char) '(?\( ?\[ ?\{)) (point) (let ((state (parse-partial-sexp (point) (c-point 'eol)))) (and (nth 1 state) (goto-char (nth 1 state)) (memq (following-char) '(?\( ?\[ ?\{)) (point))))))) ;; find balanced expression end (setq end (and (c-safe (progn (forward-sexp 1) t)) (point-marker))) ;; sanity check (and (not start) (not shutup-p) (error "Cannot find start of balanced expression to indent.")) (and (not end) (not shutup-p) (error "Cannot find end of balanced expression to indent.")) (c-progress-init start end 'c-indent-exp) (setq progress-p t) (goto-char start) (beginning-of-line) (while (< (point) end) (if (not (looking-at "[ \t]*$")) (c-indent-line)) (c-progress-update) (forward-line 1))) ;; make sure marker is deleted (and end (set-marker end nil)) (and progress-p (c-progress-fini 'c-indent-exp)) (goto-char here)))) (defun c-indent-defun () "Re-indents the current top-level function def, struct or class declaration." (interactive) (let ((here (point-marker)) (c-echo-syntactic-information-p nil) (brace (c-least-enclosing-brace (c-parse-state)))) (if brace (goto-char brace) (beginning-of-defun)) ;; if we're sitting at b-o-b, it might be becase there was no ;; least enclosing brace and we were sitting on the defun's open ;; brace. (if (and (bobp) (not (= (following-char) ?\{))) (goto-char here)) ;; if defun-prompt-regexp is non-nil, b-o-d might not leave us at ;; the open brace. I consider this an Emacs bug. (and (boundp 'defun-prompt-regexp) defun-prompt-regexp (looking-at defun-prompt-regexp) (goto-char (match-end 0))) ;; catch all errors in c-indent-exp so we can 1. give more ;; meaningful error message, and 2. restore point (unwind-protect (c-indent-exp) (goto-char here) (set-marker here nil)))) (defun c-indent-region (start end) ;; Indent every line whose first char is between START and END inclusive. (save-excursion (goto-char start) ;; Advance to first nonblank line. (skip-chars-forward " \t\n") (beginning-of-line) (let (endmark) (unwind-protect (let ((c-tab-always-indent t) ;; shut up any echo msgs on indiv lines (c-echo-syntactic-information-p nil)) (c-progress-init start end 'c-indent-region) (setq endmark (copy-marker end)) (while (and (bolp) (not (eobp)) (< (point) endmark)) ;; update progress (c-progress-update) ;; Indent one line as with TAB. (let (nextline sexpend sexpbeg) ;; skip blank lines (skip-chars-forward " \t\n") (beginning-of-line) ;; indent the current line (c-indent-line) (if (save-excursion (beginning-of-line) (looking-at "[ \t]*#")) (forward-line 1) (save-excursion ;; Find beginning of following line. (setq nextline (c-point 'bonl)) ;; Find first beginning-of-sexp for sexp extending past ;; this line. (beginning-of-line) (while (< (point) nextline) (condition-case nil (progn (forward-sexp 1) (setq sexpend (point))) (error (setq sexpend nil) (goto-char nextline))) (c-forward-syntactic-ws)) (if sexpend (progn ;; make sure the sexp we found really starts on the ;; current line and extends past it (goto-char sexpend) (setq sexpend (point-marker)) (c-safe (backward-sexp 1)) (setq sexpbeg (point))))) ;; check to see if the next line starts a ;; comment-only line (save-excursion (forward-line 1) (skip-chars-forward " \t") (if (looking-at c-comment-start-regexp) (setq sexpbeg (c-point 'bol)))) ;; If that sexp ends within the region, indent it all at ;; once, fast. (condition-case nil (if (and sexpend (> sexpend nextline) (<= sexpend endmark)) (progn (goto-char sexpbeg) (c-indent-exp 'shutup) (c-progress-update) (goto-char sexpend))) (error (goto-char sexpbeg) (c-indent-line))) ;; Move to following line and try again. (and sexpend (markerp sexpend) (set-marker sexpend nil)) (forward-line 1))))) (set-marker endmark nil) (c-progress-fini 'c-indent-region) )))) (defun c-mark-function () "Put mark at end of a C, C++, or Objective-C defun, point at beginning." (interactive) (let ((here (point)) ;; there should be a c-point position for 'eod (eod (save-excursion (end-of-defun) (point))) (state (c-parse-state)) brace) (while state (setq brace (car state)) (if (consp brace) (goto-char (cdr brace)) (goto-char brace)) (setq state (cdr state))) (if (= (following-char) ?{) (progn (forward-line -1) (while (not (or (bobp) (looking-at "[ \t]*$"))) (forward-line -1))) (forward-line 1) (skip-chars-forward " \t\n")) (push-mark here) (push-mark eod nil t))) ;; for progress reporting (defvar c-progress-info nil) (defun c-progress-init (start end context) ;; start the progress update messages. if this emacs doesn't have a ;; built-in timer, just be dumb about it (if (not (fboundp 'current-time)) (message "indenting region... (this may take a while)") ;; if progress has already been initialized, do nothing. otherwise ;; initialize the counter with a vector of: ;; [start end lastsec context] (if c-progress-info () (setq c-progress-info (vector start (save-excursion (goto-char end) (point-marker)) (nth 1 (current-time)) context)) (message "indenting region...")))) (defun c-progress-update () ;; update progress (if (not (and c-progress-info c-progress-interval)) nil (let ((now (nth 1 (current-time))) (start (aref c-progress-info 0)) (end (aref c-progress-info 1)) (lastsecs (aref c-progress-info 2))) ;; should we update? currently, update happens every 2 seconds, ;; what's the right value? (if (< c-progress-interval (- now lastsecs)) (progn (message "indenting region... (%d%% complete)" (/ (* 100 (- (point) start)) (- end start))) (aset c-progress-info 2 now))) ))) (defun c-progress-fini (context) ;; finished (if (or (eq context (aref c-progress-info 3)) (eq context t)) (progn (set-marker (aref c-progress-info 1) nil) (setq c-progress-info nil) (message "indenting region... done.")))) ;; Skipping of "syntactic whitespace" for Emacs 19. Syntactic ;; whitespace is defined as lexical whitespace, C and C++ style ;; comments, and preprocessor directives. Search no farther back or ;; forward than optional LIM. If LIM is omitted, `beginning-of-defun' ;; is used for backward skipping, point-max is used for forward ;; skipping. Note that Emacs 18 support has been moved to cc-mode-18.el. (defun c-forward-syntactic-ws (&optional lim) ;; Forward skip of syntactic whitespace for Emacs 19. (save-restriction (let* ((lim (or lim (point-max))) (here lim) (hugenum (point-max))) (narrow-to-region lim (point)) (while (/= here (point)) (setq here (point)) (forward-comment hugenum) ;; skip preprocessor directives (if (and (= (following-char) ?#) (= (c-point 'boi) (point))) (end-of-line) ))))) (defun c-backward-syntactic-ws (&optional lim) ;; Backward skip over syntactic whitespace for Emacs 19. (save-restriction (let* ((lim (or lim (c-point 'bod))) (here lim) (hugenum (- (point-max)))) (if (< lim (point)) (progn (narrow-to-region lim (point)) (while (/= here (point)) (setq here (point)) (forward-comment hugenum) (if (eq (c-in-literal lim) 'pound) (beginning-of-line)) ))) ))) ;; Return `c' if in a C-style comment, `c++' if in a C++ style ;; comment, `string' if in a string literal, `pound' if on a ;; preprocessor line, or nil if not in a comment at all. Optional LIM ;; is used as the backward limit of the search. If omitted, or nil, ;; `beginning-of-defun' is used." ;; This is for all v19 Emacsen supporting either 1-bit or 8-bit syntax (defun c-in-literal (&optional lim) ;; Determine if point is in a C++ literal. we cache the last point ;; calculated if the cache is enabled (if (and (boundp 'c-in-literal-cache) c-in-literal-cache (= (point) (aref c-in-literal-cache 0))) (aref c-in-literal-cache 1) (let ((rtn (save-excursion (let* ((lim (or lim (c-point 'bod))) (here (point)) (state (parse-partial-sexp lim (point)))) (cond ((nth 3 state) 'string) ((nth 4 state) (if (nth 7 state) 'c++ 'c)) ((progn (goto-char here) (beginning-of-line) (looking-at "[ \t]*#")) 'pound) (t nil)))))) ;; cache this result if the cache is enabled (and (boundp 'c-in-literal-cache) (setq c-in-literal-cache (vector (point) rtn))) rtn))) ;; utilities for moving and querying around syntactic elements (defun c-parse-state () ;; Finds and records all open parens between some important point ;; earlier in the file and point. ;; ;; if there's a state cache, return it (if (boundp 'c-state-cache) c-state-cache (let* (at-bob (pos (save-excursion ;; go back 2 bods, but ignore any bogus positions ;; returned by beginning-of-defun (i.e. open paren ;; in column zero) (let ((cnt 2)) (while (not (or at-bob (zerop cnt))) (beginning-of-defun) (if (= (following-char) ?\{) (setq cnt (1- cnt))) (if (bobp) (setq at-bob t)))) (point))) (here (save-excursion ;;(skip-chars-forward " \t}") (point))) (last-bod pos) (last-pos pos) placeholder state sexp-end) ;; cache last bod position (while (catch 'backup-bod (setq state nil) (while (and pos (< pos here)) (setq last-pos pos) (if (and (setq pos (c-safe (scan-lists pos 1 -1))) (<= pos here)) (progn (setq sexp-end (c-safe (scan-sexps (1- pos) 1))) (if (and sexp-end (<= sexp-end here)) ;; we want to record both the start and end ;; of this sexp, but we only want to record ;; the last-most of any of them before here (progn (if (= (char-after (1- pos)) ?\{) (setq state (cons (cons (1- pos) sexp-end) (if (consp (car state)) (cdr state) state)))) (setq pos sexp-end)) ;; we're contained in this sexp so put pos on ;; front of list (setq state (cons (1- pos) state)))) ;; something bad happened. check to see if we ;; crossed an unbalanced close brace. if so, we ;; didn't really find the right `important bufpos' ;; so lets back up and try again (if (and (not pos) (not at-bob) (setq placeholder (c-safe (scan-lists last-pos 1 1))) ;;(char-after (1- placeholder)) (<= placeholder here) (= (char-after (1- placeholder)) ?\})) (while t (setq last-bod (c-safe (scan-lists last-bod -1 1))) (if (not last-bod) (error "unbalanced close brace at position %d" (1- placeholder)) (setq at-bob (= last-bod (point-min)) pos last-bod) (if (= (char-after last-bod) ?\{) (throw 'backup-bod t))) )) ;end-if )) ;end-while nil)) state))) (defun c-whack-state (bufpos state) ;; whack off any state information that appears on STATE which lies ;; after the bounds of BUFPOS. (let (newstate car) (while state (setq car (car state) state (cdr state)) (if (consp car) ;; just check the car, because in a balanced brace ;; expression, it must be impossible for the corresponding ;; close brace to be before point, but the open brace to be ;; after. (if (<= bufpos (car car)) nil ; whack it off ;; its possible that the open brace is before bufpos, but ;; the close brace is after. In that case, convert this ;; to a non-cons element. (if (<= bufpos (cdr car)) (setq newstate (append newstate (list (car car)))) ;; we know that both the open and close braces are ;; before bufpos, so we also know that everything else ;; on state is before bufpos, so we can glom up the ;; whole thing and exit. (setq newstate (append newstate (list car) state) state nil))) (if (<= bufpos car) nil ; whack it off ;; it's before bufpos, so everything else should too (setq newstate (append newstate (list car) state) state nil)))) newstate)) (defun c-hack-state (bufpos which state) ;; Using BUFPOS buffer position, and WHICH (must be 'open or ;; 'close), hack the c-parse-state STATE and return the results. (if (eq which 'open) (let ((car (car state))) (if (or (null car) (consp car) (/= bufpos car)) (cons bufpos state) state)) (if (not (eq which 'close)) (error "c-hack-state, bad argument: %s" which)) ;; 'close brace (let ((car (car state)) (cdr (cdr state))) (if (consp car) (setq car (car cdr) cdr (cdr cdr))) ;; TBD: is this test relevent??? (if (consp car) state ;on error, don't change ;; watch out for balanced expr already on cdr of list (cons (cons car bufpos) (if (consp (car cdr)) (cdr cdr) cdr)) )))) (defun c-adjust-state (from to shift state) ;; Adjust all points in state that lie in the region FROM..TO by ;; SHIFT amount (as would be returned by c-indent-line). (mapcar (function (lambda (e) (if (consp e) (let ((car (car e)) (cdr (cdr e))) (if (and (<= from car) (< car to)) (setcar e (+ shift car))) (if (and (<= from cdr) (< cdr to)) (setcdr e (+ shift cdr)))) (if (and (<= from e) (< e to)) (setq e (+ shift e)))) e)) state)) (defun c-beginning-of-inheritance-list (&optional lim) ;; Go to the first non-whitespace after the colon that starts a ;; multiple inheritance introduction. Optional LIM is the farthest ;; back we should search. (let ((lim (or lim (c-point 'bod))) (placeholder (progn (back-to-indentation) (point)))) (c-backward-syntactic-ws lim) (while (and (> (point) lim) (memq (preceding-char) '(?, ?:)) (progn (beginning-of-line) (setq placeholder (point)) (skip-chars-forward " \t") (not (looking-at c-class-key)) )) (c-backward-syntactic-ws lim)) (goto-char placeholder) (skip-chars-forward "^:" (c-point 'eol)))) (defun c-beginning-of-macro (&optional lim) ;; Go to the beginning of the macro. Right now we don't support ;; multi-line macros too well (back-to-indentation)) (defun c-in-objc-method-def-p () ;; Return nil if we aren't in a method definition, otherwise the ;; position of the initial [+-]. (save-excursion (beginning-of-line) (if (looking-at c-ObjC-method-key) (point) nil))) (defun c-just-after-func-arglist-p (&optional containing) ;; Return t if we are between a function's argument list closing ;; paren and its opening brace. Note that the list close brace ;; could be followed by a "const" specifier or a member init hanging ;; colon. Optional CONTAINING is position of containing s-exp open ;; brace. If not supplied, point is used as search start. (save-excursion (c-backward-syntactic-ws) (let ((checkpoint (or containing (point)))) (goto-char checkpoint) ;; could be looking at const specifier (if (and (= (preceding-char) ?t) (forward-word -1) (looking-at "\\")) (c-backward-syntactic-ws) ;; otherwise, we could be looking at a hanging member init ;; colon (goto-char checkpoint) (if (and (= (preceding-char) ?:) (progn (forward-char -1) (c-backward-syntactic-ws) (looking-at "[ \t\n]*:\\([^:]+\\|$\\)"))) nil (goto-char checkpoint)) ) (and (= (preceding-char) ?\)) ;; check if we are looking at a method def (or (not (eq major-mode 'objc-mode)) (progn (forward-sexp -1) (forward-char -1) (c-backward-syntactic-ws) (not (or (= (preceding-char) ?-) (= (preceding-char) ?+) ;; or a class category (progn (forward-sexp -2) (looking-at c-class-key)) ))))) ))) ;; defuns to look backwards for things (defun c-backward-to-start-of-do (&optional lim) ;; Move to the start of the last "unbalanced" do expression. ;; Optional LIM is the farthest back to search. If none is found, ;; nil is returned and point is left unchanged, otherwise t is returned. (let ((do-level 1) (case-fold-search nil) (lim (or lim (c-point 'bod))) (here (point)) foundp) (while (not (zerop do-level)) ;; we protect this call because trying to execute this when the ;; while is not associated with a do will throw an error (condition-case nil (progn (backward-sexp 1) (cond ((memq (c-in-literal lim) '(c c++))) ((looking-at "while\\b[^_]") (setq do-level (1+ do-level))) ((looking-at "do\\b[^_]") (if (zerop (setq do-level (1- do-level))) (setq foundp t))) ((< (point) lim) (setq do-level 0) (goto-char lim)))) (error (goto-char lim) (setq do-level 0)))) (if (not foundp) (goto-char here)) foundp)) (defun c-backward-to-start-of-if (&optional lim) ;; Move to the start of the last "unbalanced" if and return t. If ;; none is found, and we are looking at an if clause, nil is ;; returned. If none is found and we are looking at an else clause, ;; an error is thrown. (let ((if-level 1) (here (c-point 'bol)) (case-fold-search nil) (lim (or lim (c-point 'bod))) (at-if (looking-at "if\\b[^_]"))) (catch 'orphan-if (while (and (not (bobp)) (not (zerop if-level))) (c-backward-syntactic-ws) (condition-case nil (backward-sexp 1) (error (if at-if (throw 'orphan-if nil) (error "No matching `if' found for `else' on line %d." (1+ (count-lines 1 here)))))) (cond ((looking-at "else\\b[^_]") (setq if-level (1+ if-level))) ((looking-at "if\\b[^_]") ;; check for else if... skip over (let ((here (point))) (c-safe (forward-sexp -1)) (if (looking-at "\\[ \t]+\\") nil (setq if-level (1- if-level)) (goto-char here)))) ((< (point) lim) (setq if-level 0) (goto-char lim)) )) t))) (defun c-skip-conditional () ;; skip forward over conditional at point, including any predicate ;; statements in parentheses. No error checking is performed. (forward-sexp ;; else if() (if (looking-at "\\[ \t]+\\") 3 ;; do and else aren't followed by parens (if (looking-at "\\<\\(do\\|else\\)\\>") 1 2)))) (defun c-skip-case-statement-forward (state &optional lim) ;; skip forward over case/default bodies, with optional maximal ;; limit. if no next case body is found, nil is returned and point ;; is not moved (let ((lim (or lim (point-max))) (here (point)) donep foundp bufpos (safepos (point)) (balanced (car state))) ;; search until we've passed the limit, or we've found our match (while (and (< (point) lim) (not donep)) (setq safepos (point)) ;; see if we can find a case statement, not in a literal (if (and (re-search-forward c-switch-label-key lim 'move) (setq bufpos (match-beginning 0)) (not (c-in-literal safepos)) (/= bufpos here)) ;; if we crossed into a balanced sexp, we know the case is ;; not part of our switch statement, so just bound over the ;; sexp and keep looking. (if (and (consp balanced) (> bufpos (car balanced)) (< bufpos (cdr balanced))) (goto-char (cdr balanced)) (goto-char bufpos) (setq donep t foundp t)))) (if (not foundp) (goto-char here)) foundp)) (defun c-search-uplist-for-classkey (brace-state) ;; search for the containing class, returning a 2 element vector if ;; found. aref 0 contains the bufpos of the class key, and aref 1 ;; contains the bufpos of the open brace. (if (null brace-state) ;; no brace-state means we cannot be inside a class nil (let ((carcache (car brace-state)) search-start search-end) (if (consp carcache) ;; a cons cell in the first element means that there is some ;; balanced sexp before the current bufpos. this we can ;; ignore. the nth 1 and nth 2 elements define for us the ;; search boundaries (setq search-start (nth 2 brace-state) search-end (nth 1 brace-state)) ;; if the car was not a cons cell then nth 0 and nth 1 define ;; for us the search boundaries (setq search-start (nth 1 brace-state) search-end (nth 0 brace-state))) ;; search-end cannot be a cons cell (and (consp search-end) (error "consp search-end: %s" search-end)) ;; if search-end is nil, or if the search-end character isn't an ;; open brace, we are definitely not in a class (if (or (not search-end) (< search-end (point-min)) (/= (char-after search-end) ?{)) nil ;; now, we need to look more closely at search-start. if ;; search-start is nil, then our start boundary is really ;; point-min. (if (not search-start) (setq search-start (point-min)) ;; if search-start is a cons cell, then we can start ;; searching from the end of the balanced sexp just ahead of ;; us (if (consp search-start) (setq search-start (cdr search-start)))) ;; now we can do a quick regexp search from search-start to ;; search-end and see if we can find a class key. watch for ;; class like strings in literals (save-excursion (save-restriction (goto-char search-start) (let (foundp class match-end) (while (and (not foundp) (progn (c-forward-syntactic-ws) (> search-end (point))) (re-search-forward c-class-key search-end t)) (setq class (match-beginning 0) match-end (match-end 0)) (if (c-in-literal search-start) nil ; its in a comment or string, ignore (goto-char class) (skip-chars-forward " \t\n") (setq foundp (vector (c-point 'boi) search-end)) (cond ;; check for embedded keywords ((let ((char (char-after (1- class)))) (and char (memq (char-syntax char) '(?w ?_)))) (goto-char match-end) (setq foundp nil)) ;; make sure we're really looking at the start of a ;; class definition, and not a forward decl, return ;; arg, template arg list, or an ObjC method. ((and (eq major-mode 'objc-mode) (re-search-forward c-ObjC-method-key search-end t)) (setq foundp nil)) ;; Its impossible to define a regexp for this, and ;; nearly so to do it programmatically. ;; ;; ; picks up forward decls ;; = picks up init lists ;; ) picks up return types ;; > picks up templates, but remember that we can ;; inherit from templates! ((let ((skipchars "^;=)")) ;; try to see if we found the `class' keyword ;; inside a template arg list (save-excursion (skip-chars-backward "^<>" search-start) (if (= (preceding-char) ?<) (setq skipchars (concat skipchars ">")))) (skip-chars-forward skipchars search-end) (/= (point) search-end)) (setq foundp nil)) ))) foundp)) ))))) (defun c-inside-bracelist-p (containing-sexp brace-state) ;; return the buffer position of the beginning of the brace list ;; statement if we're inside a brace list, otherwise return nil. ;; CONTAINING-SEXP is the buffer pos of the innermost containing ;; paren. BRACE-STATE is the remainder of the state of enclosing braces ;; ;; N.B.: This algorithm can potentially get confused by cpp macros ;; places in inconvenient locations. Its a trade-off we make for ;; speed. (or ;; this will pick up enum lists (condition-case () (save-excursion (goto-char containing-sexp) (forward-sexp -1) (if (or (looking-at "enum[\t\n ]+") (progn (forward-sexp -1) (looking-at "enum[\t\n ]+"))) (point))) (error nil)) ;; this will pick up array/aggregate init lists, even if they are nested. (save-excursion (let (bufpos failedp) (while (and (not bufpos) containing-sexp) (if (consp containing-sexp) (setq containing-sexp (car brace-state) brace-state (cdr brace-state)) ;; see if significant character just before brace is an equal (goto-char containing-sexp) (setq failedp nil) (condition-case () (progn (forward-sexp -1) (forward-sexp 1) (c-forward-syntactic-ws containing-sexp)) (error (setq failedp t))) (if (or failedp (/= (following-char) ?=)) ;; lets see if we're nested. find the most nested ;; containing brace (setq containing-sexp (car brace-state) brace-state (cdr brace-state)) ;; we've hit the beginning of the aggregate list (c-beginning-of-statement-1 (c-most-enclosing-brace brace-state)) (setq bufpos (point))) )) bufpos)) )) ;; defuns for calculating the syntactic state and indenting a single ;; line of C/C++/ObjC code (defmacro c-add-syntax (symbol &optional relpos) ;; a simple macro to append the syntax in symbol to the syntax list. ;; try to increase performance by using this macro (` (setq syntax (cons (cons (, symbol) (, relpos)) syntax)))) (defun c-most-enclosing-brace (state) ;; return the bufpos of the most enclosing brace that hasn't been ;; narrowed out by any enclosing class, or nil if none was found (let (enclosingp) (while (and state (not enclosingp)) (setq enclosingp (car state) state (cdr state)) (if (consp enclosingp) (setq enclosingp nil) (if (> (point-min) enclosingp) (setq enclosingp nil)) (setq state nil))) enclosingp)) (defun c-least-enclosing-brace (state) ;; return the bufpos of the least (highest) enclosing brace that ;; hasn't been narrowed out by any enclosing class, or nil if none ;; was found. (c-most-enclosing-brace (nreverse state))) (defun c-safe-position (bufpos state) ;; return the closest known safe position higher up than point (let ((safepos nil)) (while state (setq safepos (if (consp (car state)) (cdr (car state)) (car state))) (if (< safepos bufpos) (setq state nil) (setq state (cdr state)))) safepos)) (defun c-narrow-out-enclosing-class (state lim) ;; narrow the buffer so that the enclosing class is hidden (let (inclass-p) (and state (setq inclass-p (c-search-uplist-for-classkey state)) (narrow-to-region (progn (goto-char (1+ (aref inclass-p 1))) (skip-chars-forward " \t\n" lim) ;; if point is now left of the class opening brace, we're ;; hosed, so try a different tact (if (<= (point) (aref inclass-p 1)) (progn (goto-char (1+ (aref inclass-p 1))) (c-forward-syntactic-ws lim))) (point)) ;; end point is the end of the current line (progn (goto-char lim) (c-point 'eol)))) ;; return the class vector inclass-p)) (defun c-guess-basic-syntax () ;; guess the syntactic description of the current line of C++ code. (save-excursion (save-restriction (beginning-of-line) (let* ((indent-point (point)) (case-fold-search nil) (fullstate (c-parse-state)) (state fullstate) (in-method-intro-p (and (eq major-mode 'objc-mode) (looking-at c-ObjC-method-key))) literal containing-sexp char-before-ip char-after-ip lim syntax placeholder c-in-literal-cache inswitch-p ;; narrow out any enclosing class (inclass-p (c-narrow-out-enclosing-class state indent-point)) ) ;; get the buffer position of the most nested opening brace, ;; if there is one, and it hasn't been narrowed out (save-excursion (goto-char indent-point) (skip-chars-forward " \t}") (skip-chars-backward " \t") (while (and state (not in-method-intro-p) (not containing-sexp)) (setq containing-sexp (car state) state (cdr state)) (if (consp containing-sexp) ;; if cdr == point, then containing sexp is the brace ;; that opens the sexp we close (if (= (cdr containing-sexp) (point)) (setq containing-sexp (car containing-sexp)) ;; otherwise, ignore this element (setq containing-sexp nil)) ;; ignore the bufpos if its been narrowed out by the ;; containing class (if (<= containing-sexp (point-min)) (setq containing-sexp nil))))) ;; set the limit on the farthest back we need to search (setq lim (or containing-sexp (if (consp (car fullstate)) (cdr (car fullstate)) nil) (point-min))) ;; cache char before and after indent point, and move point to ;; the most likely position to perform the majority of tests (goto-char indent-point) (skip-chars-forward " \t") (setq char-after-ip (following-char)) (c-backward-syntactic-ws lim) (setq char-before-ip (preceding-char)) (goto-char indent-point) (skip-chars-forward " \t") ;; are we in a literal? (setq literal (c-in-literal lim)) ;; now figure out syntactic qualities of the current line (cond ;; CASE 1: in a string. ((memq literal '(string)) (c-add-syntax 'string (c-point 'bopl))) ;; CASE 2: in a C or C++ style comment. ((memq literal '(c c++)) ;; we need to catch multi-paragraph C comments (while (and (zerop (forward-line -1)) (looking-at "^[ \t]*$"))) (c-add-syntax literal (c-point 'bol))) ;; CASE 3: in a cpp preprocessor ((eq literal 'pound) (c-beginning-of-macro lim) (c-add-syntax 'cpp-macro (c-point 'boi))) ;; CASE 4: in an objective-c method intro (in-method-intro-p (c-add-syntax 'objc-method-intro (c-point 'boi))) ;; CASE 5: Line is at top level. ((null containing-sexp) (cond ;; CASE 5A: we are looking at a defun, class, or ;; inline-inclass method opening brace ((= char-after-ip ?{) (cond ;; CASE 5A.1: we are looking at a class opening brace ((save-excursion (goto-char indent-point) (skip-chars-forward " \t{") ;; TBD: watch out! there could be a bogus ;; c-state-cache in place when we get here. we have ;; to go through much chicanery to ignore the cache. ;; But of course, there may not be! BLECH! BOGUS! (let ((decl (if (boundp 'c-state-cache) (let ((old-cache c-state-cache)) (prog2 (makunbound 'c-state-cache) (c-search-uplist-for-classkey (c-parse-state)) (setq c-state-cache old-cache))) (c-search-uplist-for-classkey (c-parse-state)) ))) (and decl (setq placeholder (aref decl 0))) )) (c-add-syntax 'class-open placeholder)) ;; CASE 5A.2: brace list open ((save-excursion (c-beginning-of-statement-1 lim) ;; c-b-o-s could have left us at point-min (and (bobp) (c-forward-syntactic-ws indent-point)) (setq placeholder (point)) (and (or (looking-at "enum[ \t\n]+") (= char-before-ip ?=)) (save-excursion (skip-chars-forward "^;" indent-point) (/= (following-char) ?\;)))) (c-add-syntax 'brace-list-open placeholder)) ;; CASE 5A.3: inline defun open (inclass-p (c-add-syntax 'inline-open (aref inclass-p 0))) ;; CASE 5A.4: ordinary defun open (t (goto-char placeholder) (c-add-syntax 'defun-open (c-point 'bol)) ))) ;; CASE 5B: first K&R arg decl or member init ((c-just-after-func-arglist-p) (cond ;; CASE 5B.1: a member init ((or (= char-before-ip ?:) (= char-after-ip ?:)) ;; this line should be indented relative to the beginning ;; of indentation for the topmost-intro line that contains ;; the prototype's open paren ;; TBD: is the following redundant? (if (= char-before-ip ?:) (forward-char -1)) (c-backward-syntactic-ws lim) ;; TBD: is the preceding redundant? (if (= (preceding-char) ?:) (progn (forward-char -1) (c-backward-syntactic-ws lim))) (if (= (preceding-char) ?\)) (backward-sexp 1)) (c-add-syntax 'member-init-intro (c-point 'boi)) ;; we don't need to add any class offset since this ;; should be relative to the ctor's indentation ) ;; CASE 5B.2: K&R arg decl intro (c-recognize-knr-p (c-add-syntax 'knr-argdecl-intro (c-point 'boi)) (and inclass-p (c-add-syntax 'inclass (aref inclass-p 0)))) ;; CASE 5B.3: nether region after a C++ func decl (t (c-add-syntax 'ansi-funcdecl-cont (c-point 'boi)) (and inclass-p (c-add-syntax 'inclass (aref inclass-p 0)))) )) ;; CASE 5C: inheritance line. could be first inheritance ;; line, or continuation of a multiple inheritance ((or (and c-baseclass-key (looking-at c-baseclass-key)) (and (or (= char-before-ip ?:) (= char-after-ip ?:)) (save-excursion (c-backward-syntactic-ws lim) (if (= char-before-ip ?:) (progn (forward-char -1) (c-backward-syntactic-ws lim))) (back-to-indentation) (looking-at c-class-key)))) (cond ;; CASE 5C.1: non-hanging colon on an inher intro ((= char-after-ip ?:) (c-backward-syntactic-ws lim) (c-add-syntax 'inher-intro (c-point 'boi)) ;; don't add inclass symbol since relative point already ;; contains any class offset ) ;; CASE 5C.2: hanging colon on an inher intro ((= char-before-ip ?:) (c-add-syntax 'inher-intro (c-point 'boi)) (and inclass-p (c-add-syntax 'inclass (aref inclass-p 0)))) ;; CASE 5C.3: a continued inheritance line (t (c-beginning-of-inheritance-list lim) (c-add-syntax 'inher-cont (point)) ;; don't add inclass symbol since relative point already ;; contains any class offset ))) ;; CASE 5D: this could be a top-level compound statement or a ;; member init list continuation ((= char-before-ip ?,) (goto-char indent-point) (c-backward-syntactic-ws lim) (while (and (< lim (point)) (= (preceding-char) ?,)) ;; this will catch member inits with multiple ;; line arglists (forward-char -1) (c-backward-syntactic-ws (c-point 'bol)) (if (= (preceding-char) ?\)) (backward-sexp 1)) ;; now continue checking (beginning-of-line) (c-backward-syntactic-ws lim)) (cond ;; CASE 5D.1: hanging member init colon, but watch out ;; for bogus matches on access specifiers inside classes. ((and (= (preceding-char) ?:) (save-excursion (forward-word -1) (not (looking-at c-access-key)))) (goto-char indent-point) (c-backward-syntactic-ws lim) (c-safe (backward-sexp 1)) (c-add-syntax 'member-init-cont (c-point 'boi)) ;; we do not need to add class offset since relative ;; point is the member init above us ) ;; CASE 5D.2: non-hanging member init colon ((progn (c-forward-syntactic-ws indent-point) (= (following-char) ?:)) (skip-chars-forward " \t:") (c-add-syntax 'member-init-cont (point))) ;; CASE 5D.3: perhaps a multiple inheritance line? ((looking-at c-inher-key) (c-add-syntax 'inher-cont (c-point 'boi))) ;; CASE 5D.4: perhaps a template list continuation? ((save-excursion (skip-chars-backward "^<" lim) ;; not sure if this is the right test, but it should ;; be fast and mostly accurate. (and (= (preceding-char) ?<) (not (c-in-literal lim)))) ;; we can probably indent it just like and arglist-cont (c-add-syntax 'arglist-cont (point))) ;; CASE 5D.5: perhaps a top-level statement-cont (t (c-beginning-of-statement-1 lim) ;; skip over any access-specifiers (and inclass-p c-access-key (while (looking-at c-access-key) (forward-line 1))) ;; skip over comments, whitespace (c-forward-syntactic-ws indent-point) (c-add-syntax 'statement-cont (c-point 'boi))) )) ;; CASE 5E: we are looking at a access specifier ((and inclass-p c-access-key (looking-at c-access-key)) (c-add-syntax 'access-label (c-point 'bonl)) (c-add-syntax 'inclass (aref inclass-p 0))) ;; CASE 5F: we are looking at the brace which closes the ;; enclosing nested class decl ((and inclass-p (= char-after-ip ?}) (save-excursion (save-restriction (widen) (forward-char 1) (and (condition-case nil (progn (backward-sexp 1) t) (error nil)) (= (point) (aref inclass-p 1)) )))) (save-restriction (widen) (goto-char (aref inclass-p 0)) (c-add-syntax 'class-close (c-point 'boi)))) ;; CASE 5G: we could be looking at subsequent knr-argdecls ((and c-recognize-knr-p (save-excursion (c-backward-syntactic-ws lim) (while (memq (preceding-char) '(?\; ?,)) (beginning-of-line) (setq placeholder (point)) (c-backward-syntactic-ws lim)) (and (= (preceding-char) ?\)) (or (not (eq major-mode 'objc-mode)) (progn (forward-sexp -1) (forward-char -1) (c-backward-syntactic-ws) (not (or (= (preceding-char) ?-) (= (preceding-char) ?+) ;; or a class category (progn (forward-sexp -2) (looking-at c-class-key)) ))))) ) (save-excursion (c-beginning-of-statement-1) (not (looking-at "typedef[ \t\n]+")))) (goto-char placeholder) (c-add-syntax 'knr-argdecl (c-point 'boi))) ;; CASE 5H: we are at the topmost level, make sure we skip ;; back past any access specifiers ((progn (c-backward-syntactic-ws lim) (while (and inclass-p c-access-key (not (bobp)) (save-excursion (c-safe (progn (backward-sexp 1) t)) (looking-at c-access-key))) (backward-sexp 1) (c-backward-syntactic-ws lim)) (or (bobp) (memq (preceding-char) '(?\; ?\})))) ;; real beginning-of-line could be narrowed out due to ;; enclosure in a class block (save-restriction (widen) (c-add-syntax 'topmost-intro (c-point 'bol)) (if inclass-p (progn (goto-char (aref inclass-p 1)) (c-add-syntax 'inclass (c-point 'boi)))))) ;; CASE 5I: we are at a method definition continuation line ((and (eq major-mode 'objc-mode) (progn (c-beginning-of-statement-1 lim) (beginning-of-line) (looking-at c-ObjC-method-key))) (c-add-syntax 'objc-method-args-cont (point))) ;; CASE 5J: we are at a topmost continuation line (t (c-beginning-of-statement-1 lim) (c-forward-syntactic-ws) (c-add-syntax 'topmost-intro-cont (c-point 'boi))) )) ; end CASE 5 ;; CASE 6: line is an expression, not a statement. Most ;; likely we are either in a function prototype or a function ;; call argument list ((/= (char-after containing-sexp) ?{) (c-backward-syntactic-ws containing-sexp) (cond ;; CASE 6A: we are looking at the arglist closing paren or ;; at an Objective-C method call closing bracket. ((and (/= char-before-ip ?,) (memq char-after-ip '(?\) ?\]))) (if (and (eq major-mode 'objc-mode) (progn (goto-char (1- containing-sexp)) (c-backward-syntactic-ws lim) (not (looking-at c-symbol-key)))) (c-add-syntax 'statement-cont containing-sexp) (goto-char containing-sexp) (c-add-syntax 'arglist-close (c-point 'boi)))) ;; CASE 6B: we are looking at the first argument in an empty ;; argument list. Use arglist-close if we're actually ;; looking at a close paren or bracket. ((memq char-before-ip '(?\( ?\[)) (goto-char containing-sexp) (c-add-syntax 'arglist-intro (c-point 'boi))) ;; CASE 6C: we are inside a conditional test clause. treat ;; these things as statements ((save-excursion (goto-char containing-sexp) (and (c-safe (progn (forward-sexp -1) t)) (looking-at "\\"))) (goto-char (1+ containing-sexp)) (c-forward-syntactic-ws indent-point) (c-beginning-of-statement-1 containing-sexp) (if (= char-before-ip ?\;) (c-add-syntax 'statement (point)) (c-add-syntax 'statement-cont (point)) )) ;; CASE 6D: maybe a continued method call. This is the case ;; when we are inside a [] bracketed exp, and what precede ;; the opening bracket is not an identifier. ((and (eq major-mode 'objc-mode) (= (char-after containing-sexp) ?\[) (save-excursion (goto-char (1- containing-sexp)) (c-backward-syntactic-ws (c-point 'bod)) (if (not (looking-at c-symbol-key)) (c-add-syntax 'objc-method-call-cont containing-sexp)) ))) ;; CASE 6E: we are looking at an arglist continuation line, ;; but the preceding argument is on the same line as the ;; opening paren. This case includes multi-line ;; mathematical paren groupings, but we could be on a ;; for-list continuation line ((and (save-excursion (goto-char (1+ containing-sexp)) (skip-chars-forward " \t") (not (eolp))) (save-excursion (c-beginning-of-statement-1 lim) (skip-chars-backward " \t([") (<= (point) containing-sexp))) (goto-char containing-sexp) (c-add-syntax 'arglist-cont-nonempty (c-point 'boi))) ;; CASE 6F: we are looking at just a normal arglist ;; continuation line (t (c-beginning-of-statement-1 containing-sexp) (forward-char 1) (c-forward-syntactic-ws indent-point) (c-add-syntax 'arglist-cont (c-point 'boi))) )) ;; CASE 7: func-local multi-inheritance line ((and c-baseclass-key (save-excursion (goto-char indent-point) (skip-chars-forward " \t") (looking-at c-baseclass-key))) (goto-char indent-point) (skip-chars-forward " \t") (cond ;; CASE 7A: non-hanging colon on an inher intro ((= char-after-ip ?:) (c-backward-syntactic-ws lim) (c-add-syntax 'inher-intro (c-point 'boi))) ;; CASE 7B: hanging colon on an inher intro ((= char-before-ip ?:) (c-add-syntax 'inher-intro (c-point 'boi))) ;; CASE 7C: a continued inheritance line (t (c-beginning-of-inheritance-list lim) (c-add-syntax 'inher-cont (point)) ))) ;; CASE 8: we are inside a brace-list ((setq placeholder (c-inside-bracelist-p containing-sexp state)) (cond ;; CASE 8A: brace-list-close brace ((and (= char-after-ip ?}) (c-safe (progn (forward-char 1) (backward-sexp 1) t)) (= (point) containing-sexp)) (c-add-syntax 'brace-list-close (c-point 'boi))) ;; CASE 8B: we're looking at the first line in a brace-list ((save-excursion (goto-char indent-point) (c-backward-syntactic-ws containing-sexp) (= (point) (1+ containing-sexp))) (goto-char containing-sexp) ;;(if (= char-after-ip ?{) ;;(c-add-syntax 'brace-list-open (c-point 'boi)) (c-add-syntax 'brace-list-intro (c-point 'boi)) ) ;;)) ; end CASE 8B ;; CASE 8C: this is just a later brace-list-entry (t (goto-char (1+ containing-sexp)) (c-forward-syntactic-ws indent-point) (if (= char-after-ip ?{) (c-add-syntax 'brace-list-open (point)) (c-add-syntax 'brace-list-entry (point)) )) ; end CASE 8C )) ; end CASE 8 ;; CASE 9: A continued statement ((and (not (memq char-before-ip '(?\; ?} ?:))) (> (point) (save-excursion (c-beginning-of-statement-1 containing-sexp) (setq placeholder (point)))) (/= placeholder containing-sexp)) (goto-char indent-point) (skip-chars-forward " \t") (let ((after-cond-placeholder (save-excursion (goto-char placeholder) (if (looking-at c-conditional-key) (progn (c-safe (c-skip-conditional)) (c-forward-syntactic-ws) (if (memq (following-char) '(?\;)) (progn (forward-char 1) (c-forward-syntactic-ws))) (point)) nil)))) (cond ;; CASE 9A: substatement ((and after-cond-placeholder (>= after-cond-placeholder indent-point)) (goto-char placeholder) (if (= char-after-ip ?{) (c-add-syntax 'substatement-open (c-point 'boi)) (c-add-syntax 'substatement (c-point 'boi)))) ;; CASE 9B: open braces for class or brace-lists ((= char-after-ip ?{) (cond ;; CASE 9B.1: class-open ((save-excursion (goto-char indent-point) (skip-chars-forward " \t{") (let ((decl (c-search-uplist-for-classkey (c-parse-state)))) (and decl (setq placeholder (aref decl 0))) )) (c-add-syntax 'class-open placeholder)) ;; CASE 9B.2: brace-list-open ((or (save-excursion (goto-char placeholder) (looking-at "\\")) (= char-before-ip ?=)) (c-add-syntax 'brace-list-open placeholder)) ;; CASE 9B.3: catch-all for unknown construct. (t ;; Even though this isn't right, it's the best I'm ;; going to do for now. Exceptions probably fall ;; through to here, but aren't supported yet. Also, ;; after the next release, I may call a recognition ;; hook like so: (run-hooks 'c-recognize-hook), but I ;; dunno. (goto-char placeholder) (c-add-syntax 'statement-cont (c-point 'boi)) (c-add-syntax 'block-open)) )) ;; CASE 9C: iostream insertion or extraction operator ((looking-at "<<\\|>>") (goto-char placeholder) (and after-cond-placeholder (goto-char after-cond-placeholder)) (while (and (re-search-forward "<<\\|>>" indent-point 'move) (c-in-literal placeholder))) ;; if we ended up at indent-point, then the first ;; streamop is on a separate line. Indent the line like ;; a statement-cont instead (if (/= (point) indent-point) (c-add-syntax 'stream-op (c-point 'boi)) (c-backward-syntactic-ws lim) (c-add-syntax 'statement-cont (c-point 'boi)))) ;; CASE 9D: continued statement. find the accurate ;; beginning of statement or substatement (t (c-beginning-of-statement-1 after-cond-placeholder) ;; KLUDGE ALERT! c-beginning-of-statement-1 can leave ;; us before the lim we're passing in. It should be ;; fixed, but I'm worried about side-effects at this ;; late date. Fix for v5. (goto-char (or (and after-cond-placeholder (max after-cond-placeholder (point))) (point))) (c-add-syntax 'statement-cont (point))) ))) ;; CASE 10: an else clause? ((looking-at "\\[^_]") (c-backward-to-start-of-if containing-sexp) (c-add-syntax 'else-clause (c-point 'boi))) ;; CASE 11: Statement. But what kind? Lets see if its a ;; while closure of a do/while construct ((progn (goto-char indent-point) (skip-chars-forward " \t") (and (looking-at "while\\b[^_]") (save-excursion (c-backward-to-start-of-do containing-sexp) (setq placeholder (point)) (looking-at "do\\b[^_]")) )) (c-add-syntax 'do-while-closure placeholder)) ;; CASE 12: A case or default label ((looking-at c-switch-label-key) (goto-char containing-sexp) ;; check for hanging braces (if (/= (point) (c-point 'boi)) (forward-sexp -1)) (c-add-syntax 'case-label (c-point 'boi))) ;; CASE 13: any other label ((looking-at c-label-key) (goto-char containing-sexp) (c-add-syntax 'label (c-point 'boi))) ;; CASE 14: block close brace, possibly closing the defun or ;; the class ((= char-after-ip ?}) (let* ((lim (c-safe-position containing-sexp fullstate)) (relpos (save-excursion (goto-char containing-sexp) (if (/= (point) (c-point 'boi)) (c-beginning-of-statement-1 lim)) (c-point 'boi)))) (cond ;; CASE 14A: does this close an inline? ((progn (goto-char containing-sexp) (c-search-uplist-for-classkey state)) (c-add-syntax 'inline-close relpos)) ;; CASE 14B: if there an enclosing brace that hasn't ;; been narrowed out by a class, then this is a ;; block-close ((c-most-enclosing-brace state) (c-add-syntax 'block-close relpos)) ;; CASE 14C: find out whether we're closing a top-level ;; class or a defun (t (save-restriction (narrow-to-region (point-min) indent-point) (let ((decl (c-search-uplist-for-classkey (c-parse-state)))) (if decl (c-add-syntax 'class-close (aref decl 0)) (c-add-syntax 'defun-close relpos))))) ))) ;; CASE 15: statement catchall (t ;; we know its a statement, but we need to find out if it is ;; the first statement in a block (goto-char containing-sexp) (forward-char 1) (c-forward-syntactic-ws indent-point) ;; now skip forward past any case/default clauses we might find. (while (or (c-skip-case-statement-forward fullstate indent-point) (and (looking-at c-switch-label-key) (not inswitch-p))) (setq inswitch-p t)) ;; we want to ignore non-case labels when skipping forward (while (and (looking-at c-label-key) (goto-char (match-end 0))) (c-forward-syntactic-ws indent-point)) (cond ;; CASE 15A: we are inside a case/default clause inside a ;; switch statement. find out if we are at the statement ;; just after the case/default label. ((and inswitch-p (progn (goto-char indent-point) (c-backward-syntactic-ws containing-sexp) (back-to-indentation) (setq placeholder (point)) (looking-at c-switch-label-key))) (goto-char indent-point) (skip-chars-forward " \t") (if (= (following-char) ?{) (c-add-syntax 'statement-case-open placeholder) (c-add-syntax 'statement-case-intro placeholder))) ;; CASE 15B: continued statement ((= char-before-ip ?,) (c-add-syntax 'statement-cont (c-point 'boi))) ;; CASE 15C: a question/colon construct? But make sure ;; what came before was not a label, and what comes after ;; is not a globally scoped function call! ((or (and (memq char-before-ip '(?: ??)) (save-excursion (goto-char indent-point) (c-backward-syntactic-ws lim) (back-to-indentation) (not (looking-at c-label-key)))) (and (memq char-after-ip '(?: ??)) (save-excursion (goto-char indent-point) (skip-chars-forward " \t") ;; watch out for scope operator (not (looking-at "::"))))) (c-add-syntax 'statement-cont (c-point 'boi))) ;; CASE 15D: any old statement ((< (point) indent-point) (let ((safepos (c-most-enclosing-brace fullstate))) (goto-char indent-point) (c-beginning-of-statement-1 safepos) (c-add-syntax 'statement (c-point 'boi)) (if (= char-after-ip ?{) (c-add-syntax 'block-open)))) ;; CASE 15E: first statement in an inline, or first ;; statement in a top-level defun. we can tell this is it ;; if there are no enclosing braces that haven't been ;; narrowed out by a class (i.e. don't use bod here!) ((save-excursion (save-restriction (widen) (goto-char containing-sexp) (c-narrow-out-enclosing-class state containing-sexp) (not (c-most-enclosing-brace state)))) (goto-char containing-sexp) ;; if not at boi, then defun-opening braces are hung on ;; right side, so we need a different relpos (if (/= (point) (c-point 'boi)) (progn (c-backward-syntactic-ws) (c-safe (forward-sexp (if (= (preceding-char) ?\)) -1 -2))) )) (c-add-syntax 'defun-block-intro (c-point 'boi))) ;; CASE 15F: first statement in a block (t (goto-char containing-sexp) (if (/= (point) (c-point 'boi)) (c-beginning-of-statement-1 (if (= (point) lim) (c-safe-position (point) state) lim))) (c-add-syntax 'statement-block-intro (c-point 'boi)) (if (= char-after-ip ?{) (c-add-syntax 'block-open))) )) ) ;; now we need to look at any modifiers (goto-char indent-point) (skip-chars-forward " \t") ;; are we looking at a comment only line? (if (looking-at c-comment-start-regexp) (c-add-syntax 'comment-intro)) ;; we might want to give additional offset to friends (in C++). (if (and (eq major-mode 'c++-mode) (looking-at c-C++-friend-key)) (c-add-syntax 'friend)) ;; return the syntax syntax)))) ;; indent via syntactic language elements (defun c-get-offset (langelem) ;; Get offset from LANGELEM which is a cons cell of the form: ;; (SYMBOL . RELPOS). The symbol is matched against ;; c-offsets-alist and the offset found there is either returned, ;; or added to the indentation at RELPOS. If RELPOS is nil, then ;; the offset is simply returned. (let* ((symbol (car langelem)) (relpos (cdr langelem)) (match (assq symbol c-offsets-alist)) (offset (cdr-safe match))) ;; offset can be a number, a function, a variable, or one of the ;; symbols + or - (cond ((not match) (if c-strict-syntax-p (error "don't know how to indent a %s" symbol) (setq offset 0 relpos 0))) ((eq offset '+) (setq offset c-basic-offset)) ((eq offset '-) (setq offset (- c-basic-offset))) ((eq offset '++) (setq offset (* 2 c-basic-offset))) ((eq offset '--) (setq offset (* 2 (- c-basic-offset)))) ((eq offset '*) (setq offset (/ c-basic-offset 2))) ((eq offset '/) (setq offset (/ (- c-basic-offset) 2))) ((and (not (numberp offset)) (fboundp offset)) (setq offset (funcall offset langelem))) ((not (numberp offset)) (setq offset (eval offset))) ) (+ (if (and relpos (< relpos (c-point 'bol))) (save-excursion (goto-char relpos) (current-column)) 0) offset))) (defun c-indent-line (&optional syntax) ;; indent the current line as C/C++/ObjC code. Optional SYNTAX is the ;; syntactic information for the current line. Returns the amount of ;; indentation change (let* ((c-syntactic-context (or syntax (c-guess-basic-syntax))) (pos (- (point-max) (point))) (indent (apply '+ (mapcar 'c-get-offset c-syntactic-context))) (shift-amt (- (current-indentation) indent))) (and c-echo-syntactic-information-p (message "syntax: %s, indent= %d" c-syntactic-context indent)) (if (zerop shift-amt) nil (delete-region (c-point 'bol) (c-point 'boi)) (beginning-of-line) (indent-to indent)) (if (< (point) (c-point 'boi)) (back-to-indentation) ;; If initial point was within line's indentation, position after ;; the indentation. Else stay at same point in text. (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) ) (run-hooks 'c-special-indent-hook) shift-amt)) (defun c-show-syntactic-information () "Show syntactic information for current line." (interactive) (message "syntactic analysis: %s" (c-guess-basic-syntax)) (c-keep-region-active)) ;; Standard indentation line-ups (defun c-lineup-arglist (langelem) ;; lineup the current arglist line with the arglist appearing just ;; after the containing paren which starts the arglist. (save-excursion (let* ((containing-sexp (save-excursion ;; arglist-cont-nonempty gives relpos == ;; to boi of containing-sexp paren. This ;; is good when offset is +, but bad ;; when it is c-lineup-arglist, so we ;; have to special case a kludge here. (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty)) (progn (beginning-of-line) (backward-up-list 1) (skip-chars-forward " \t" (c-point 'eol))) (goto-char (cdr langelem))) (point))) (cs-curcol (save-excursion (goto-char (cdr langelem)) (current-column)))) (if (save-excursion (beginning-of-line) (looking-at "[ \t]*)")) (progn (goto-char (match-end 0)) (forward-sexp -1) (forward-char 1) (c-forward-syntactic-ws) (- (current-column) cs-curcol)) (goto-char containing-sexp) (or (eolp) (not (memq (following-char) '(?{ ?\( ))) (let ((eol (c-point 'eol)) (here (progn (forward-char 1) (skip-chars-forward " \t") (point)))) (c-forward-syntactic-ws) (if (< (point) eol) (goto-char here)))) (- (current-column) cs-curcol) )))) (defun c-lineup-arglist-intro-after-paren (langelem) ;; lineup an arglist-intro line to just after the open paren (save-excursion (let ((cs-curcol (save-excursion (goto-char (cdr langelem)) (current-column))) (ce-curcol (save-excursion (beginning-of-line) (backward-up-list 1) (skip-chars-forward " \t" (c-point 'eol)) (current-column)))) (- ce-curcol cs-curcol -1)))) (defun c-lineup-streamop (langelem) ;; lineup stream operators (save-excursion (let* ((relpos (cdr langelem)) (curcol (progn (goto-char relpos) (current-column)))) (re-search-forward "<<\\|>>" (c-point 'eol) 'move) (goto-char (match-beginning 0)) (- (current-column) curcol)))) (defun c-lineup-multi-inher (langelem) ;; line up multiple inheritance lines (save-excursion (let (cs-curcol (eol (c-point 'eol)) (here (point))) (goto-char (cdr langelem)) (setq cs-curcol (current-column)) (skip-chars-forward "^:" eol) (skip-chars-forward " \t:" eol) (if (or (eolp) (looking-at c-comment-start-regexp)) (c-forward-syntactic-ws here)) (- (current-column) cs-curcol) ))) (defun c-lineup-C-comments (langelem) ;; line up C block comment continuation lines (save-excursion (let ((stars (progn (beginning-of-line) (skip-chars-forward " \t") (if (looking-at "\\*\\*?") (- (match-end 0) (match-beginning 0)) 0))) (cs-curcol (progn (goto-char (cdr langelem)) (current-column)))) (back-to-indentation) (if (re-search-forward "/\\*[ \t]*" (c-point 'eol) t) (goto-char (+ (match-beginning 0) (cond (c-block-comments-indent-p 0) ((= stars 1) 1) ((= stars 2) 0) (t (- (match-end 0) (match-beginning 0))))))) (- (current-column) cs-curcol)))) (defun c-lineup-comment (langelem) ;; support old behavior for comment indentation. we look at ;; c-comment-only-line-offset to decide how to indent comment ;; only-lines (save-excursion (back-to-indentation) ;; indent as specified by c-comment-only-line-offset (if (not (bolp)) (or (car-safe c-comment-only-line-offset) c-comment-only-line-offset) (or (cdr-safe c-comment-only-line-offset) (car-safe c-comment-only-line-offset) -1000 ;jam it against the left side )))) (defun c-lineup-runin-statements (langelem) ;; line up statements in coding standards which place the first ;; statement on the same line as the block opening brace. (if (= (char-after (cdr langelem)) ?{) (save-excursion (let ((curcol (progn (goto-char (cdr langelem)) (current-column)))) (forward-char 1) (skip-chars-forward " \t") (- (current-column) curcol))) 0)) (defun c-lineup-math (langelem) ;; line up math statement-cont after the equals (save-excursion (let* ((relpos (cdr langelem)) (equalp (save-excursion (goto-char (c-point 'boi)) (skip-chars-forward "^=" (c-point 'eol)) (and (= (following-char) ?=) (- (point) (c-point 'boi))))) (curcol (progn (goto-char relpos) (current-column))) donep) (while (and (not donep) (< (point) (c-point 'eol))) (skip-chars-forward "^=" (c-point 'eol)) (if (c-in-literal (cdr langelem)) (forward-char 1) (setq donep t))) (if (/= (following-char) ?=) ;; there's no equal sign on the line c-basic-offset ;; calculate indentation column after equals and ws, unless ;; our line contains an equals sign (if (not equalp) (progn (forward-char 1) (skip-chars-forward " \t") (setq equalp 0))) (- (current-column) equalp curcol)) ))) (defun c-lineup-ObjC-method-call (langelem) ;; Line up methods args as elisp-mode does with function args: go to ;; the position right after the message receiver, and if you are at ;; (eolp) indent the current line by a constant offset from the ;; opening bracket; otherwise we are looking at the first character ;; of the first method call argument, so lineup the current line ;; with it. (save-excursion (let* ((extra (save-excursion (back-to-indentation) (c-backward-syntactic-ws (cdr langelem)) (if (= (preceding-char) ?:) (- c-basic-offset) 0))) (open-bracket-pos (cdr langelem)) (open-bracket-col (progn (goto-char open-bracket-pos) (current-column))) (target-col (progn (forward-char) (forward-sexp) (skip-chars-forward " \t") (if (eolp) (+ open-bracket-col c-basic-offset) (current-column)))) ) (- target-col open-bracket-col extra)))) (defun c-lineup-ObjC-method-args (langelem) ;; Line up the colons that separate args. This is done trying to ;; align colons vertically. (save-excursion (let* ((here (c-point 'boi)) (curcol (progn (goto-char here) (current-column))) (eol (c-point 'eol)) (relpos (cdr langelem)) (first-col-column (progn (goto-char relpos) (skip-chars-forward "^:" eol) (and (= (following-char) ?:) (current-column))))) (if (not first-col-column) c-basic-offset (goto-char here) (skip-chars-forward "^:" eol) (if (= (following-char) ?:) (+ curcol (- first-col-column (current-column))) c-basic-offset))))) (defun c-lineup-ObjC-method-args-2 (langelem) ;; Line up the colons that separate args. This is done trying to ;; align the colon on the current line with the previous one. (save-excursion (let* ((here (c-point 'boi)) (curcol (progn (goto-char here) (current-column))) (eol (c-point 'eol)) (relpos (cdr langelem)) (prev-col-column (progn (skip-chars-backward "^:" relpos) (and (= (preceding-char) ?:) (- (current-column) 1))))) (if (not prev-col-column) c-basic-offset (goto-char here) (skip-chars-forward "^:" eol) (if (= (following-char) ?:) (+ curcol (- prev-col-column (current-column))) c-basic-offset))))) (defun c-snug-do-while (syntax pos) "Dynamically calculate brace hanginess for do-while statements. Using this function, `while' clauses that end a `do-while' block will remain on the same line as the brace that closes that block. See `c-hanging-braces-alist' for how to utilize this function as an ACTION associated with `block-close' syntax." (save-excursion (let (langelem) (if (and (eq syntax 'block-close) (setq langelem (assq 'block-close c-syntactic-context)) (progn (goto-char (cdr langelem)) (if (= (following-char) ?{) (c-safe (forward-sexp -1))) (looking-at "\\[^_]"))) '(before) '(before after))))) ;;; This page handles insertion and removal of backslashes for C macros. (defun c-backslash-region (from to delete-flag) "Insert, align, or delete end-of-line backslashes on the lines in the region. With no argument, inserts backslashes and aligns existing backslashes. With an argument, deletes the backslashes. This function does not modify the last line of the region if the region ends right at the start of the following line; it does not modify blank lines at the start of the region. So you can put the region around an entire macro definition and conveniently use this command." (interactive "r\nP") (save-excursion (goto-char from) (let ((column c-backslash-column) (endmark (make-marker))) (move-marker endmark to) ;; Compute the smallest column number past the ends of all the lines. (if (not delete-flag) (while (< (point) to) (end-of-line) (if (= (preceding-char) ?\\) (progn (forward-char -1) (skip-chars-backward " \t"))) (setq column (max column (1+ (current-column)))) (forward-line 1))) ;; Adjust upward to a tab column, if that doesn't push past the margin. (if (> (% column tab-width) 0) (let ((adjusted (* (/ (+ column tab-width -1) tab-width) tab-width))) (if (< adjusted (window-width)) (setq column adjusted)))) ;; Don't modify blank lines at start of region. (goto-char from) (while (and (< (point) endmark) (eolp)) (forward-line 1)) ;; Add or remove backslashes on all the lines. (while (and (< (point) endmark) ;; Don't backslashify the last line ;; if the region ends right at the start of the next line. (save-excursion (forward-line 1) (< (point) endmark))) (if (not delete-flag) (c-append-backslash column) (c-delete-backslash)) (forward-line 1)) (move-marker endmark nil)))) (defun c-append-backslash (column) (end-of-line) ;; Note that "\\\\" is needed to get one backslash. (if (= (preceding-char) ?\\) (progn (forward-char -1) (delete-horizontal-space) (indent-to column)) (indent-to column) (insert "\\"))) (defun c-delete-backslash () (end-of-line) (forward-char -1) (if (looking-at "\\\\") (delete-region (1+ (point)) (progn (skip-chars-backward " \t") (point))))) ;; defuns for submitting bug reports (defconst c-version (concat "4.249" " as included in " emacs-version)) (defconst c-mode-help-address "cc-mode-help@merlin.cnri.reston.va.us, bug-gnu-emacs@prep.ai.mit.edu" "Address for CC mode bug reports.") (defun c-version () "Echo the current version of cc-mode in the minibuffer." (interactive) (message "Using cc-mode version %s" c-version) (c-keep-region-active)) ;; get reporter-submit-bug-report when byte-compiling (eval-when-compile (require 'reporter)) (defun c-submit-bug-report () "Submit via mail a bug report on cc-mode." (interactive) ;; load in reporter (let ((reporter-prompt-for-summary-p t) (reporter-dont-compact-list '(c-offsets-alist))) (and (if (y-or-n-p "Do you want to submit a report on cc-mode? ") t (message "") nil) (require 'reporter) (reporter-submit-bug-report c-mode-help-address (concat "cc-mode " c-version " (" (cond ((eq major-mode 'c++-mode) "C++") ((eq major-mode 'c-mode) "C") ((eq major-mode 'objc-mode) "ObjC")) ")") (let ((vars (list ;; report only the vars that affect indentation 'c-basic-offset 'c-offsets-alist 'c-block-comments-indent-p 'c-cleanup-list 'c-comment-only-line-offset 'c-backslash-column 'c-delete-function 'c-electric-pound-behavior 'c-hanging-braces-alist 'c-hanging-colons-alist 'c-hanging-comment-ender-p 'c-tab-always-indent 'c-recognize-knr-p 'defun-prompt-regexp 'tab-width ))) (if (not (boundp 'defun-prompt-regexp)) (delq 'defun-prompt-regexp vars) vars)) (function (lambda () (insert (if c-special-indent-hook (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" "c-special-indent-hook is set to '" (format "%s" c-special-indent-hook) ".\nPerhaps this is your problem?\n" "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") "\n") (format "c-emacs-features: %s\n" c-emacs-features) ))) nil "Dear Barry," )))) ;; menus for XEmacs (formerly Lucid) (defun c-popup-menu (e) "Pops up the C/C++/ObjC menu." (interactive "@e") (popup-menu (cons (concat mode-name " Mode Commands") c-mode-menu)) (c-keep-region-active)) (defun c-copy-tree (tree) ;; Line XEmacs 19.12's copy-tree (if (consp tree) (cons (c-copy-tree (car tree)) (c-copy-tree (cdr tree))) (if (vectorp tree) (let* ((new (copy-sequence tree)) (i (1- (length new)))) (while (>= i 0) (aset new i (c-copy-tree (aref new i))) (setq i (1- i))) new) tree))) (defun c-mapcar-defun (var) (let ((val (symbol-value var))) (cons var (if (atom val) val ;; XEmacs 19.12 and Emacs 19 + lucid.el have this (if (fboundp 'copy-tree) (copy-tree val) ;; Emacs 19 and Emacs 18 (c-copy-tree val) ))) )) ;; dynamically append the default value of most variables. This is ;; crucial because future c-set-style calls will always reset the ;; variables first to the "CC-MODE" style before instituting the new ;; style. Only do this once! (or (assoc "CC-MODE" c-style-alist) (progn (c-add-style "CC-MODE" (mapcar 'c-mapcar-defun '(c-backslash-column c-basic-offset c-block-comments-indent-p c-cleanup-list c-comment-only-line-offset c-echo-syntactic-information-p c-electric-pound-behavior c-hanging-braces-alist c-hanging-colons-alist c-hanging-comment-ender-p c-offsets-alist c-recognize-knr-p c-strict-syntax-p c-tab-always-indent c-inhibit-startup-warnings-p )))) ;; the default style is now GNU. This can be overridden in ;; c-mode-common-hook or {c,c++,objc}-mode-hook. (c-set-style "GNU")) ;; style variables (make-variable-buffer-local 'c-offsets-alist) (make-variable-buffer-local 'c-basic-offset) (make-variable-buffer-local 'c-file-style) (make-variable-buffer-local 'c-file-offsets) (make-variable-buffer-local 'c-comment-only-line-offset) (make-variable-buffer-local 'c-block-comments-indent-p) (make-variable-buffer-local 'c-cleanup-list) (make-variable-buffer-local 'c-hanging-braces-alist) (make-variable-buffer-local 'c-hanging-colons-alist) (make-variable-buffer-local 'c-hanging-comment-ender-p) (make-variable-buffer-local 'c-backslash-column) ;; fsets for compatibility with BOCM (fset 'electric-c-brace 'c-electric-brace) (fset 'electric-c-semi 'c-electric-semi&comma) (fset 'electric-c-sharp-sign 'c-electric-pound) ;; there is no cc-mode equivalent for electric-c-terminator (fset 'mark-c-function 'c-mark-function) (fset 'indent-c-exp 'c-indent-exp) (fset 'set-c-style 'c-set-style) ;; lemacs 19.9 + font-lock + cc-mode - c++-mode lossage (fset 'c++-beginning-of-defun 'beginning-of-defun) (fset 'c++-end-of-defun 'end-of-defun) ;; set up bc warnings for obsolete variables, but for now lets not ;; worry about obsolete functions. maybe later some will be important ;; to flag (and (memq 'v19 c-emacs-features) (let* ((na "Nothing appropriate.") (vars (list (cons 'c++-c-mode-syntax-table 'c-mode-syntaxt-table) (cons 'c++-tab-always-indent 'c-tab-always-indent) (cons 'c++-always-arglist-indent-p na) (cons 'c++-block-close-brace-offset 'c-offsets-alist) (cons 'c++-paren-as-block-close-p na) (cons 'c++-continued-member-init-offset 'c-offsets-alist) (cons 'c++-member-init-indent 'c-offsets-alist) (cons 'c++-friend-offset na) (cons 'c++-access-specifier-offset 'c-offsets-alist) (cons 'c++-empty-arglist-indent 'c-offsets-alist) (cons 'c++-comment-only-line-offset 'c-comment-only-line-offset) (cons 'c++-C-block-comments-indent-p 'c-block-comments-indent-p) (cons 'c++-cleanup-list 'c-cleanup-list) (cons 'c++-hanging-braces 'c-hanging-braces-alist) (cons 'c++-hanging-member-init-colon 'c-hanging-colons-alist) (cons 'c++-auto-hungry-initial-state "Use `c-auto-newline' and `c-hungry-delete-key' instead.") (cons 'c++-auto-hungry-toggle na) (cons 'c++-relative-offset-p na) (cons 'c++-special-indent-hook 'c-special-indent-hook) (cons 'c++-delete-function 'c-delete-function) (cons 'c++-electric-pound-behavior 'c-electric-pound-behavior) (cons 'c++-hungry-delete-key 'c-hungry-delete-key) (cons 'c++-auto-newline 'c-auto-newline) (cons 'c++-match-header-strongly na) (cons 'c++-defun-header-strong-struct-equivs na) (cons 'c++-version 'c-version) (cons 'c++-mode-help-address 'c-mode-help-address) (cons 'c-indent-level 'c-basic-offset) (cons 'c-brace-imaginary-offset na) (cons 'c-brace-offset 'c-offsets-alist) (cons 'c-argdecl-indent 'c-offsets-alist) (cons 'c-label-offset 'c-offsets-alist) (cons 'c-continued-statement-offset 'c-offsets-alist) (cons 'c-continued-brace-offset 'c-offsets-alist) (cons 'c-default-macroize-column 'c-backslash-column) (cons 'c++-default-macroize-column 'c-backslash-column) ))) (mapcar (function (lambda (elt) (make-obsolete-variable (car elt) (cdr elt)))) vars))) (provide 'cc-mode) ;;; cc-mode.el ends here emacs-19.30/lisp/cdl.el100444 12120 1 3077 6045201212 13132 0ustar rmsdaemon;;; cdl.el --- Common Data Language (CDL) utility functions for Gnu Emacs ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: ATAE@spva.physics.imperial.ac.uk (Ata Etemadi) ;; Keywords: data ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (defun cdl-get-file (filename) "Run file through ncdump and insert result into buffer after point." (interactive "fCDF file: ") (message "ncdump in progress...") (let ((start (point))) (call-process "ncdump" nil t nil (expand-file-name filename)) (goto-char start)) (message "ncdump in progress...done")) (defun cdl-put-region (filename start end) "Run region through ncgen and write results into a file." (interactive "FNew CDF file: \nr") (message "ncgen in progress...") (call-process-region start end "ncgen" nil nil nil "-o" (expand-file-name filename)) (message "ncgen in progress...done")) ;;; cdl.el ends here. emacs-19.30/lisp/chistory.el100444 75424 1 14776 5651546013 14503 0ustar kwzhdaemon;;; chistory.el --- list command history ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF ;; 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 really has nothing to do with list-command-history per se, but ;; its a nice alternative to C-x ESC ESC (repeat-complex-command) and ;; functions as a lister if given no pattern. It's not important ;; enough to warrant a file of its own. ;;; Code: ;;;###autoload (defun repeat-matching-complex-command (&optional pattern) "Edit and re-evaluate complex command with name matching PATTERN. Matching occurrences are displayed, most recent first, until you select a form for evaluation. If PATTERN is empty (or nil), every form in the command history is offered. The form is placed in the minibuffer for editing and the result is evaluated." (interactive "sRedo Command (regexp): ") (if pattern (if (string-match "[^ \t]" pattern) (setq pattern (substring pattern (match-beginning 0))) (setq pattern nil))) (let ((history command-history) (temp) (what)) (while (and history (not what)) (setq temp (car history)) (if (and (or (not pattern) (string-match pattern (symbol-name (car temp)))) (y-or-n-p (format "Redo %S? " temp))) (setq what (car history)) (setq history (cdr history)))) (if (not what) (error "Command history exhausted") ;; Try to remove any useless command history element for this command. (if (eq (car (car command-history)) 'repeat-matching-complex-command) (setq command-history (cdr command-history))) (edit-and-eval-command "Redo: " what)))) (defvar default-command-history-filter-garbage '(command-history-mode list-command-history electric-command-history) "*A list of symbols to be ignored by `default-command-history-filter'. It that function is given a list whose car is an element of this list, then it will return non-nil (indicating the list should be discarded from the history). Initially, all commands related to the command history are discarded.") (defvar list-command-history-filter 'default-command-history-filter "Predicate to test which commands should be excluded from the history listing. If non-nil, should be the name of a function of one argument. It is passed each element of the command history when \\[list-command-history] is called. If the filter returns non-nil for some element, that element is excluded from the history listing. The default filter removes commands associated with the command-history.") (defun default-command-history-filter (frob) "Filter commands matching `default-command-history-filter-garbage' list from the command history." (or (not (consp frob)) (memq (car frob) default-command-history-filter-garbage))) (defvar list-command-history-max 32 "*If non-nil, maximum length of the listing produced by `list-command-history'.") ;;;###autoload (defun list-command-history () "List history of commands typed to minibuffer. The number of commands listed is controlled by `list-command-history-max'. Calls value of `list-command-history-filter' (if non-nil) on each history element to judge if that element should be excluded from the list. The buffer is left in Command History mode." (interactive) (with-output-to-temp-buffer "*Command History*" (let ((history command-history) (buffer-read-only nil) (count (or list-command-history-max -1))) (while (and (/= count 0) history) (if (and (boundp 'list-command-history-filter) list-command-history-filter (funcall list-command-history-filter (car history))) nil (setq count (1- count)) (prin1 (car history)) (terpri)) (setq history (cdr history)))) (save-excursion (set-buffer "*Command History*") (goto-char (point-min)) (if (eobp) (error "No command history") (Command-history-setup))))) (defun Command-history-setup (&optional majormode modename keymap) (set-buffer "*Command History*") (use-local-map (or keymap command-history-map)) (lisp-mode-variables nil) (set-syntax-table emacs-lisp-mode-syntax-table) (setq buffer-read-only t) (use-local-map (or keymap command-history-map)) (setq major-mode (or majormode 'command-history-mode)) (setq mode-name (or modename "Command History"))) (defvar command-history-hook nil "If non-nil, its value is called on entry to `command-history-mode'.") (defvar command-history-map nil) (if command-history-map nil (setq command-history-map (nconc (make-sparse-keymap) shared-lisp-mode-map)) (suppress-keymap command-history-map) (define-key command-history-map "x" 'command-history-repeat) (define-key command-history-map "\n" 'next-line) (define-key command-history-map "\r" 'next-line) (define-key command-history-map "\177" 'previous-line)) (defun command-history-repeat () "Repeat the command shown on the current line. The buffer for that command is the previous current buffer." (interactive) (save-excursion (eval (prog1 (save-excursion (beginning-of-line) (read (current-buffer))) (set-buffer (car (cdr (buffer-list)))))))) ;;;###autoload (defun command-history-mode () "Major mode for examining commands from `command-history'. The number of commands listed is controlled by `list-command-history-max'. The command history is filtered by `list-command-history-filter' if non-nil. Use \\\\[command-history-repeat] to repeat the command on the current line. Otherwise much like Emacs-Lisp Mode except that there is no self-insertion and digits provide prefix arguments. Tab does not indent. \\{command-history-map} Calls the value of `command-history-hook' if that is non-nil. The Command History listing is recomputed each time this mode is invoked." (interactive) (list-command-history) (pop-to-buffer "*Command History*") (run-hooks 'command-history-hook)) (provide 'chistory) ;;; chistory.el ends here emacs-19.30/lisp/cl-compat.el100444 12120 1 13722 6045201277 14300 0ustar rmsdaemon;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility) ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Dave Gillespie ;; Version: 2.02 ;; Keywords: extensions ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 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: ;; These are extensions to Emacs Lisp that provide a degree of ;; Common Lisp compatibility, beyond what is already built-in ;; in Emacs Lisp. ;; ;; This package was written by Dave Gillespie; it is a complete ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. ;; ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. ;; ;; Bug reports, comments, and suggestions are welcome! ;; This file contains emulations of internal routines of the older ;; CL package which users may have called directly from their code. ;; Use (require 'cl-compat) to get these routines. ;; See cl.el for Change Log. ;;; Code: ;; Require at load-time, but not when compiling cl-compat. (or (featurep 'cl) (require 'cl)) ;;; Keyword routines not supported by new package. (defmacro defkeyword (x &optional doc) (list* 'defconst x (list 'quote x) (and doc (list doc)))) (defun keywordp (sym) (and (symbolp sym) (eq (aref (symbol-name sym) 0) ?\:) (set sym sym))) (defun keyword-of (sym) (or (keywordp sym) (keywordp (intern (format ":%s" sym))))) ;;; Multiple values. Note that the new package uses a different ;;; convention for multiple values. The following definitions ;;; emulate the old convention; all function names have been changed ;;; by capitalizing the first letter: Values, Multiple-value-*, ;;; to avoid conflict with the new-style definitions in cl-macs. (put 'Multiple-value-bind 'lisp-indent-function 2) (put 'Multiple-value-setq 'lisp-indent-function 2) (put 'Multiple-value-call 'lisp-indent-function 1) (put 'Multiple-value-prog1 'lisp-indent-function 1) (defvar *mvalues-values* nil) (defun Values (&rest val-forms) (setq *mvalues-values* val-forms) (car val-forms)) (defun Values-list (val-forms) (apply 'values val-forms)) (defmacro Multiple-value-list (form) (list 'let* (list '(*mvalues-values* nil) (list '*mvalues-temp* form)) '(or (and (eq *mvalues-temp* (car *mvalues-values*)) *mvalues-values*) (list *mvalues-temp*)))) (defmacro Multiple-value-call (function &rest args) (list 'apply function (cons 'append (mapcar (function (lambda (x) (list 'Multiple-value-list x))) args)))) (defmacro Multiple-value-bind (vars form &rest body) (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body)) (defmacro Multiple-value-setq (vars form) (list 'multiple-value-setq vars (list 'Multiple-value-list form))) (defmacro Multiple-value-prog1 (form &rest body) (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body))) ;;; Routines for parsing keyword arguments. (defun build-klist (arglist keys &optional allow-others) (let ((res (Multiple-value-call 'mapcar* 'cons (unzip-lists arglist)))) (or allow-others (let ((bad (set-difference (mapcar 'car res) keys))) (if bad (error "Bad keywords: %s not in %s" bad keys)))) res)) (defun extract-from-klist (klist key &optional def) (let ((res (assq key klist))) (if res (cdr res) def))) (defun keyword-argument-supplied-p (klist key) (assq key klist)) (defun elt-satisfies-test-p (item elt klist) (let ((test-not (cdr (assq ':test-not klist))) (test (cdr (assq ':test klist))) (key (cdr (assq ':key klist)))) (if key (setq elt (funcall key elt))) (if test-not (not (funcall test-not item elt)) (funcall (or test 'eql) item elt)))) ;;; Rounding functions with old-style multiple value returns. (defun cl-floor (a &optional b) (Values-list (floor* a b))) (defun cl-ceiling (a &optional b) (Values-list (ceiling* a b))) (defun cl-round (a &optional b) (Values-list (round* a b))) (defun cl-truncate (a &optional b) (Values-list (truncate* a b))) (defun safe-idiv (a b) (let* ((q (/ (abs a) (abs b))) (s (* (signum a) (signum b)))) (Values q (- a (* s q b)) s))) ;; Internal routines. (defun pair-with-newsyms (oldforms) (let ((newsyms (mapcar (function (lambda (x) (gensym))) oldforms))) (Values (mapcar* 'list newsyms oldforms) newsyms))) (defun zip-lists (evens odds) (mapcan 'list evens odds)) (defun unzip-lists (list) (let ((e nil) (o nil)) (while list (setq e (cons (car list) e) o (cons (cadr list) o) list (cddr list))) (Values (nreverse e) (nreverse o)))) (defun reassemble-argslists (list) (let ((n (apply 'min (mapcar 'length list))) (res nil)) (while (>= (setq n (1- n)) 0) (setq res (cons (mapcar (function (lambda (x) (elt x n))) list) res))) res)) (defun duplicate-symbols-p (list) (let ((res nil)) (while list (if (memq (car list) (cdr list)) (setq res (cons (car list) res))) (setq list (cdr list))) res)) ;;; Setf internals. (defun setnth (n list x) (setcar (nthcdr n list) x)) (defun setnthcdr (n list x) (setcdr (nthcdr (1- n) list) x)) (defun setelt (seq n x) (if (consp seq) (setcar (nthcdr n seq) x) (aset seq n x))) ;;; Functions omitted: case-clausify, check-do-stepforms, check-do-endforms, ;;; extract-do-inits, extract-do[*]-steps, select-stepping-forms, ;;; elt-satisfies-if[-not]-p, with-keyword-args, mv-bind-clausify, ;;; all names with embedded `$'. (provide 'cl-compat) ;;; cl-compat.el ends here emacs-19.30/lisp/cl-extra.el100444 12120 1 100320 6045201332 14137 0ustar rmsdaemon;;; cl-extra.el --- Common Lisp extensions for GNU Emacs Lisp (part two) ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Dave Gillespie ;; Version: 2.02 ;; Keywords: extensions ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 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: ;; These are extensions to Emacs Lisp that provide a degree of ;; Common Lisp compatibility, beyond what is already built-in ;; in Emacs Lisp. ;; ;; This package was written by Dave Gillespie; it is a complete ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. ;; ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. ;; ;; Bug reports, comments, and suggestions are welcome! ;; This file contains portions of the Common Lisp extensions ;; package which are autoloaded since they are relatively obscure. ;; See cl.el for Change Log. ;;; Code: (or (memq 'cl-19 features) (error "Tried to load `cl-extra' before `cl'!")) ;;; We define these here so that this file can compile without having ;;; loaded the cl.el file already. (defmacro cl-push (x place) (list 'setq place (list 'cons x place))) (defmacro cl-pop (place) (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) (defvar cl-emacs-type) ;;; Type coercion. (defun coerce (x type) "Coerce OBJECT to type TYPE. TYPE is a Common Lisp type specifier." (cond ((eq type 'list) (if (listp x) x (append x nil))) ((eq type 'vector) (if (vectorp x) x (vconcat x))) ((eq type 'string) (if (stringp x) x (concat x))) ((eq type 'array) (if (arrayp x) x (vconcat x))) ((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0)) ((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type)) ((eq type 'float) (float x)) ((typep x type) x) (t (error "Can't coerce %s to type %s" x type)))) ;;; Predicates. (defun equalp (x y) "T if two Lisp objects have similar structures and contents. This is like `equal', except that it accepts numerically equal numbers of different types (float vs. integer), and also compares strings case-insensitively." (cond ((eq x y) t) ((stringp x) (and (stringp y) (= (length x) (length y)) (or (equal x y) (equal (downcase x) (downcase y))))) ; lazy but simple! ((numberp x) (and (numberp y) (= x y))) ((consp x) (while (and (consp x) (consp y) (equalp (cl-pop x) (cl-pop y)))) (and (not (consp x)) (equalp x y))) ((vectorp x) (and (vectorp y) (= (length x) (length y)) (let ((i (length x))) (while (and (>= (setq i (1- i)) 0) (equalp (aref x i) (aref y i)))) (< i 0)))) (t (equal x y)))) ;;; Control structures. (defun cl-mapcar-many (cl-func cl-seqs) (if (cdr (cdr cl-seqs)) (let* ((cl-res nil) (cl-n (apply 'min (mapcar 'length cl-seqs))) (cl-i 0) (cl-args (copy-sequence cl-seqs)) cl-p1 cl-p2) (setq cl-seqs (copy-sequence cl-seqs)) (while (< cl-i cl-n) (setq cl-p1 cl-seqs cl-p2 cl-args) (while cl-p1 (setcar cl-p2 (if (consp (car cl-p1)) (prog1 (car (car cl-p1)) (setcar cl-p1 (cdr (car cl-p1)))) (aref (car cl-p1) cl-i))) (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))) (cl-push (apply cl-func cl-args) cl-res) (setq cl-i (1+ cl-i))) (nreverse cl-res)) (let ((cl-res nil) (cl-x (car cl-seqs)) (cl-y (nth 1 cl-seqs))) (let ((cl-n (min (length cl-x) (length cl-y))) (cl-i -1)) (while (< (setq cl-i (1+ cl-i)) cl-n) (cl-push (funcall cl-func (if (consp cl-x) (cl-pop cl-x) (aref cl-x cl-i)) (if (consp cl-y) (cl-pop cl-y) (aref cl-y cl-i))) cl-res))) (nreverse cl-res)))) (defun map (cl-type cl-func cl-seq &rest cl-rest) "Map a function across one or more sequences, returning a sequence. TYPE is the sequence type to return, FUNC is the function, and SEQS are the argument sequences." (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest))) (and cl-type (coerce cl-res cl-type)))) (defun maplist (cl-func cl-list &rest cl-rest) "Map FUNC to each sublist of LIST or LISTS. Like `mapcar', except applies to lists and their cdr's rather than to the elements themselves." (if cl-rest (let ((cl-res nil) (cl-args (cons cl-list (copy-sequence cl-rest))) cl-p) (while (not (memq nil cl-args)) (cl-push (apply cl-func cl-args) cl-res) (setq cl-p cl-args) (while cl-p (setcar cl-p (cdr (cl-pop cl-p)) ))) (nreverse cl-res)) (let ((cl-res nil)) (while cl-list (cl-push (funcall cl-func cl-list) cl-res) (setq cl-list (cdr cl-list))) (nreverse cl-res)))) (defun mapc (cl-func cl-seq &rest cl-rest) "Like `mapcar', but does not accumulate values returned by the function." (if cl-rest (apply 'map nil cl-func cl-seq cl-rest) (mapcar cl-func cl-seq)) cl-seq) (defun mapl (cl-func cl-list &rest cl-rest) "Like `maplist', but does not accumulate values returned by the function." (if cl-rest (apply 'maplist cl-func cl-list cl-rest) (let ((cl-p cl-list)) (while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p))))) cl-list) (defun mapcan (cl-func cl-seq &rest cl-rest) "Like `mapcar', but nconc's together the values returned by the function." (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest))) (defun mapcon (cl-func cl-list &rest cl-rest) "Like `maplist', but nconc's together the values returned by the function." (apply 'nconc (apply 'maplist cl-func cl-list cl-rest))) (defun some (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is true of any element of SEQ or SEQs. If so, return the true (non-nil) value returned by PREDICATE." (if (or cl-rest (nlistp cl-seq)) (catch 'cl-some (apply 'map nil (function (lambda (&rest cl-x) (let ((cl-res (apply cl-pred cl-x))) (if cl-res (throw 'cl-some cl-res))))) cl-seq cl-rest) nil) (let ((cl-x nil)) (while (and cl-seq (not (setq cl-x (funcall cl-pred (cl-pop cl-seq)))))) cl-x))) (defun every (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is true of every element of SEQ or SEQs." (if (or cl-rest (nlistp cl-seq)) (catch 'cl-every (apply 'map nil (function (lambda (&rest cl-x) (or (apply cl-pred cl-x) (throw 'cl-every nil)))) cl-seq cl-rest) t) (while (and cl-seq (funcall cl-pred (car cl-seq))) (setq cl-seq (cdr cl-seq))) (null cl-seq))) (defun notany (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is false of every element of SEQ or SEQs." (not (apply 'some cl-pred cl-seq cl-rest))) (defun notevery (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is false of some element of SEQ or SEQs." (not (apply 'every cl-pred cl-seq cl-rest))) ;;; Support for `loop'. (defun cl-map-keymap (cl-func cl-map) (while (symbolp cl-map) (setq cl-map (symbol-function cl-map))) (if (eq cl-emacs-type 'lucid) (funcall 'map-keymap cl-func cl-map) (if (listp cl-map) (let ((cl-p cl-map)) (while (consp (setq cl-p (cdr cl-p))) (cond ((consp (car cl-p)) (funcall cl-func (car (car cl-p)) (cdr (car cl-p)))) ((vectorp (car cl-p)) (cl-map-keymap cl-func (car cl-p))) ((eq (car cl-p) 'keymap) (setq cl-p nil))))) (let ((cl-i -1)) (while (< (setq cl-i (1+ cl-i)) (length cl-map)) (if (aref cl-map cl-i) (funcall cl-func cl-i (aref cl-map cl-i)))))))) (defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base) (or cl-base (setq cl-base (copy-sequence (if (eq cl-emacs-type 18) "0" [0])))) (cl-map-keymap (function (lambda (cl-key cl-bind) (aset cl-base (1- (length cl-base)) cl-key) (if (keymapp cl-bind) (cl-map-keymap-recursively cl-func-rec cl-bind (funcall (if (eq cl-emacs-type 18) 'concat 'vconcat) cl-base (list 0))) (funcall cl-func-rec cl-base cl-bind)))) cl-map)) (defun cl-map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end) (or cl-what (setq cl-what (current-buffer))) (if (bufferp cl-what) (let (cl-mark cl-mark2 (cl-next t) cl-next2) (save-excursion (set-buffer cl-what) (setq cl-mark (copy-marker (or cl-start (point-min)))) (setq cl-mark2 (and cl-end (copy-marker cl-end)))) (while (and cl-next (or (not cl-mark2) (< cl-mark cl-mark2))) (setq cl-next (and (fboundp 'next-property-change) (if cl-prop (next-single-property-change cl-mark cl-prop cl-what) (next-property-change cl-mark cl-what))) cl-next2 (or cl-next (save-excursion (set-buffer cl-what) (point-max)))) (funcall cl-func (prog1 (marker-position cl-mark) (set-marker cl-mark cl-next2)) (if cl-mark2 (min cl-next2 cl-mark2) cl-next2))) (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))) (or cl-start (setq cl-start 0)) (or cl-end (setq cl-end (length cl-what))) (while (< cl-start cl-end) (let ((cl-next (or (and (fboundp 'next-property-change) (if cl-prop (next-single-property-change cl-start cl-prop cl-what) (next-property-change cl-start cl-what))) cl-end))) (funcall cl-func cl-start (min cl-next cl-end)) (setq cl-start cl-next))))) (defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg) (or cl-buffer (setq cl-buffer (current-buffer))) (if (fboundp 'overlay-lists) ;; This is the preferred algorithm, though overlay-lists is undocumented. (let (cl-ovl) (save-excursion (set-buffer cl-buffer) (setq cl-ovl (overlay-lists)) (if cl-start (setq cl-start (copy-marker cl-start))) (if cl-end (setq cl-end (copy-marker cl-end)))) (setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl))) (while (and cl-ovl (or (not (overlay-start (car cl-ovl))) (and cl-end (>= (overlay-start (car cl-ovl)) cl-end)) (and cl-start (<= (overlay-end (car cl-ovl)) cl-start)) (not (funcall cl-func (car cl-ovl) cl-arg)))) (setq cl-ovl (cdr cl-ovl))) (if cl-start (set-marker cl-start nil)) (if cl-end (set-marker cl-end nil))) ;; This alternate algorithm fails to find zero-length overlays. (let ((cl-mark (save-excursion (set-buffer cl-buffer) (copy-marker (or cl-start (point-min))))) (cl-mark2 (and cl-end (save-excursion (set-buffer cl-buffer) (copy-marker cl-end)))) cl-pos cl-ovl) (while (save-excursion (and (setq cl-pos (marker-position cl-mark)) (< cl-pos (or cl-mark2 (point-max))) (progn (set-buffer cl-buffer) (setq cl-ovl (overlays-at cl-pos)) (set-marker cl-mark (next-overlay-change cl-pos))))) (while (and cl-ovl (or (/= (overlay-start (car cl-ovl)) cl-pos) (not (and (funcall cl-func (car cl-ovl) cl-arg) (set-marker cl-mark nil))))) (setq cl-ovl (cdr cl-ovl)))) (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))))) ;;; Support for `setf'. (defun cl-set-frame-visible-p (frame val) (cond ((null val) (make-frame-invisible frame)) ((eq val 'icon) (iconify-frame frame)) (t (make-frame-visible frame))) val) ;;; Support for `progv'. (defvar cl-progv-save) (defun cl-progv-before (syms values) (while syms (cl-push (if (boundp (car syms)) (cons (car syms) (symbol-value (car syms))) (car syms)) cl-progv-save) (if values (set (cl-pop syms) (cl-pop values)) (makunbound (cl-pop syms))))) (defun cl-progv-after () (while cl-progv-save (if (consp (car cl-progv-save)) (set (car (car cl-progv-save)) (cdr (car cl-progv-save))) (makunbound (car cl-progv-save))) (cl-pop cl-progv-save))) ;;; Numbers. (defun gcd (&rest args) "Return the greatest common divisor of the arguments." (let ((a (abs (or (cl-pop args) 0)))) (while args (let ((b (abs (cl-pop args)))) (while (> b 0) (setq b (% a (setq a b)))))) a)) (defun lcm (&rest args) "Return the least common multiple of the arguments." (if (memq 0 args) 0 (let ((a (abs (or (cl-pop args) 1)))) (while args (let ((b (abs (cl-pop args)))) (setq a (* (/ a (gcd a b)) b)))) a))) (defun isqrt (a) "Return the integer square root of the argument." (if (and (integerp a) (> a 0)) (let ((g (cond ((>= a 1000000) 10000) ((>= a 10000) 1000) ((>= a 100) 100) (t 10))) g2) (while (< (setq g2 (/ (+ g (/ a g)) 2)) g) (setq g g2)) g) (if (eq a 0) 0 (signal 'arith-error nil)))) (defun cl-expt (x y) "Return X raised to the power of Y. Works only for integer arguments." (if (<= y 0) (if (= y 0) 1 (if (memq x '(-1 1)) x 0)) (* (if (= (% y 2) 0) 1 x) (cl-expt (* x x) (/ y 2))))) (or (and (fboundp 'expt) (subrp (symbol-function 'expt))) (defalias 'expt 'cl-expt)) (defun floor* (x &optional y) "Return a list of the floor of X and the fractional part of X. With two arguments, return floor and remainder of their quotient." (let ((q (floor x y))) (list q (- x (if y (* y q) q))))) (defun ceiling* (x &optional y) "Return a list of the ceiling of X and the fractional part of X. With two arguments, return ceiling and remainder of their quotient." (let ((res (floor* x y))) (if (= (car (cdr res)) 0) res (list (1+ (car res)) (- (car (cdr res)) (or y 1)))))) (defun truncate* (x &optional y) "Return a list of the integer part of X and the fractional part of X. With two arguments, return truncation and remainder of their quotient." (if (eq (>= x 0) (or (null y) (>= y 0))) (floor* x y) (ceiling* x y))) (defun round* (x &optional y) "Return a list of X rounded to the nearest integer and the remainder. With two arguments, return rounding and remainder of their quotient." (if y (if (and (integerp x) (integerp y)) (let* ((hy (/ y 2)) (res (floor* (+ x hy) y))) (if (and (= (car (cdr res)) 0) (= (+ hy hy) y) (/= (% (car res) 2) 0)) (list (1- (car res)) hy) (list (car res) (- (car (cdr res)) hy)))) (let ((q (round (/ x y)))) (list q (- x (* q y))))) (if (integerp x) (list x 0) (let ((q (round x))) (list q (- x q)))))) (defun mod* (x y) "The remainder of X divided by Y, with the same sign as Y." (nth 1 (floor* x y))) (defun rem* (x y) "The remainder of X divided by Y, with the same sign as X." (nth 1 (truncate* x y))) (defun signum (a) "Return 1 if A is positive, -1 if negative, 0 if zero." (cond ((> a 0) 1) ((< a 0) -1) (t 0))) ;; Random numbers. (defvar *random-state*) (defun random* (lim &optional state) "Return a random nonnegative number less than LIM, an integer or float. Optional second arg STATE is a random-state object." (or state (setq state *random-state*)) ;; Inspired by "ran3" from Numerical Recipes. Additive congruential method. (let ((vec (aref state 3))) (if (integerp vec) (let ((i 0) (j (- 1357335 (% (abs vec) 1357333))) (k 1) ii) (aset state 3 (setq vec (make-vector 55 nil))) (aset vec 0 j) (while (> (setq i (% (+ i 21) 55)) 0) (aset vec i (setq j (prog1 k (setq k (- j k)))))) (while (< (setq i (1+ i)) 200) (random* 2 state)))) (let* ((i (aset state 1 (% (1+ (aref state 1)) 55))) (j (aset state 2 (% (1+ (aref state 2)) 55))) (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j)))))) (if (integerp lim) (if (<= lim 512) (% n lim) (if (> lim 8388607) (setq n (+ (lsh n 9) (random* 512 state)))) (let ((mask 1023)) (while (< mask (1- lim)) (setq mask (1+ (+ mask mask)))) (if (< (setq n (logand n mask)) lim) n (random* lim state)))) (* (/ n '8388608e0) lim))))) (defun make-random-state (&optional state) "Return a copy of random-state STATE, or of `*random-state*' if omitted. If STATE is t, return a new state object seeded from the time of day." (cond ((null state) (make-random-state *random-state*)) ((vectorp state) (cl-copy-tree state t)) ((integerp state) (vector 'cl-random-state-tag -1 30 state)) (t (make-random-state (cl-random-time))))) (defun random-state-p (object) "Return t if OBJECT is a random-state object." (and (vectorp object) (= (length object) 4) (eq (aref object 0) 'cl-random-state-tag))) ;; Implementation limits. (defun cl-finite-do (func a b) (condition-case err (let ((res (funcall func a b))) ; check for IEEE infinity (and (numberp res) (/= res (/ res 2)) res)) (arith-error nil))) (defvar most-positive-float) (defvar most-negative-float) (defvar least-positive-float) (defvar least-negative-float) (defvar least-positive-normalized-float) (defvar least-negative-normalized-float) (defvar float-epsilon) (defvar float-negative-epsilon) (defun cl-float-limits () (or most-positive-float (not (numberp '2e1)) (let ((x '2e0) y z) ;; Find maximum exponent (first two loops are optimizations) (while (cl-finite-do '* x x) (setq x (* x x))) (while (cl-finite-do '* x (/ x 2)) (setq x (* x (/ x 2)))) (while (cl-finite-do '+ x x) (setq x (+ x x))) (setq z x y (/ x 2)) ;; Now fill in 1's in the mantissa. (while (and (cl-finite-do '+ x y) (/= (+ x y) x)) (setq x (+ x y) y (/ y 2))) (setq most-positive-float x most-negative-float (- x)) ;; Divide down until mantissa starts rounding. (setq x (/ x z) y (/ 16 z) x (* x y)) (while (condition-case err (and (= x (* (/ x 2) 2)) (> (/ y 2) 0)) (arith-error nil)) (setq x (/ x 2) y (/ y 2))) (setq least-positive-normalized-float y least-negative-normalized-float (- y)) ;; Divide down until value underflows to zero. (setq x (/ 1 z) y x) (while (condition-case err (> (/ x 2) 0) (arith-error nil)) (setq x (/ x 2))) (setq least-positive-float x least-negative-float (- x)) (setq x '1e0) (while (/= (+ '1e0 x) '1e0) (setq x (/ x 2))) (setq float-epsilon (* x 2)) (setq x '1e0) (while (/= (- '1e0 x) '1e0) (setq x (/ x 2))) (setq float-negative-epsilon (* x 2)))) nil) ;;; Sequence functions. (defun subseq (seq start &optional end) "Return the subsequence of SEQ from START to END. If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end." (if (stringp seq) (substring seq start end) (let (len) (and end (< end 0) (setq end (+ end (setq len (length seq))))) (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) (cond ((listp seq) (if (> start 0) (setq seq (nthcdr start seq))) (if end (let ((res nil)) (while (>= (setq end (1- end)) start) (cl-push (cl-pop seq) res)) (nreverse res)) (copy-sequence seq))) (t (or end (setq end (or len (length seq)))) (let ((res (make-vector (max (- end start) 0) nil)) (i 0)) (while (< start end) (aset res i (aref seq start)) (setq i (1+ i) start (1+ start))) res)))))) (defun concatenate (type &rest seqs) "Concatenate, into a sequence of type TYPE, the argument SEQUENCES." (cond ((eq type 'vector) (apply 'vconcat seqs)) ((eq type 'string) (apply 'concat seqs)) ((eq type 'list) (apply 'append (append seqs '(nil)))) (t (error "Not a sequence type name: %s" type)))) ;;; List functions. (defun revappend (x y) "Equivalent to (append (reverse X) Y)." (nconc (reverse x) y)) (defun nreconc (x y) "Equivalent to (nconc (nreverse X) Y)." (nconc (nreverse x) y)) (defun list-length (x) "Return the length of a list. Return nil if list is circular." (let ((n 0) (fast x) (slow x)) (while (and (cdr fast) (not (and (eq fast slow) (> n 0)))) (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow))) (if fast (if (cdr fast) nil (1+ n)) n))) (defun tailp (sublist list) "Return true if SUBLIST is a tail of LIST." (while (and (consp list) (not (eq sublist list))) (setq list (cdr list))) (if (numberp sublist) (equal sublist list) (eq sublist list))) (defun cl-copy-tree (tree &optional vecp) "Make a copy of TREE. If TREE is a cons cell, this recursively copies both its car and its cdr. Constrast to copy-sequence, which copies only along the cdrs. With second argument VECP, this copies vectors as well as conses." (if (consp tree) (let ((p (setq tree (copy-list tree)))) (while (consp p) (if (or (consp (car p)) (and vecp (vectorp (car p)))) (setcar p (cl-copy-tree (car p) vecp))) (or (listp (cdr p)) (setcdr p (cl-copy-tree (cdr p) vecp))) (cl-pop p))) (if (and vecp (vectorp tree)) (let ((i (length (setq tree (copy-sequence tree))))) (while (>= (setq i (1- i)) 0) (aset tree i (cl-copy-tree (aref tree i) vecp)))))) tree) (or (and (fboundp 'copy-tree) (subrp (symbol-function 'copy-tree))) (defalias 'copy-tree 'cl-copy-tree)) ;;; Property lists. (defun get* (sym tag &optional def) ; See compiler macro in cl-macs.el "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none." (or (get sym tag) (and def (let ((plist (symbol-plist sym))) (while (and plist (not (eq (car plist) tag))) (setq plist (cdr (cdr plist)))) (if plist (car (cdr plist)) def))))) (defun getf (plist tag &optional def) "Search PROPLIST for property PROPNAME; return its value or DEFAULT. PROPLIST is a list of the sort returned by `symbol-plist'." (setplist '--cl-getf-symbol-- plist) (or (get '--cl-getf-symbol-- tag) (and def (get* '--cl-getf-symbol-- tag def)))) (defun cl-set-getf (plist tag val) (let ((p plist)) (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p)))) (if p (progn (setcar (cdr p) val) plist) (list* tag val plist)))) (defun cl-do-remf (plist tag) (let ((p (cdr plist))) (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) (defun cl-remprop (sym tag) "Remove from SYMBOL's plist the property PROP and its value." (let ((plist (symbol-plist sym))) (if (and plist (eq tag (car plist))) (progn (setplist sym (cdr (cdr plist))) t) (cl-do-remf plist tag)))) (or (and (fboundp 'remprop) (subrp (symbol-function 'remprop))) (defalias 'remprop 'cl-remprop)) ;;; Hash tables. (defun make-hash-table (&rest cl-keys) "Make an empty Common Lisp-style hash-table. If :test is `eq', this can use Lucid Emacs built-in hash-tables. In non-Lucid Emacs, or with non-`eq' test, this internally uses a-lists. Keywords supported: :test :size The Common Lisp keywords :rehash-size and :rehash-threshold are ignored." (let ((cl-test (or (car (cdr (memq ':test cl-keys))) 'eql)) (cl-size (or (car (cdr (memq ':size cl-keys))) 20))) (if (and (eq cl-test 'eq) (fboundp 'make-hashtable)) (funcall 'make-hashtable cl-size) (list 'cl-hash-table-tag cl-test (if (> cl-size 1) (make-vector cl-size 0) (let ((sym (make-symbol "--hashsym--"))) (set sym nil) sym)) 0)))) (defvar cl-lucid-hash-tag (if (and (fboundp 'make-hashtable) (vectorp (make-hashtable 1))) (aref (make-hashtable 1) 0) (make-symbol "--cl-hash-tag--"))) (defun hash-table-p (x) "Return t if OBJECT is a hash table." (or (eq (car-safe x) 'cl-hash-table-tag) (and (vectorp x) (= (length x) 4) (eq (aref x 0) cl-lucid-hash-tag)) (and (fboundp 'hashtablep) (funcall 'hashtablep x)))) (defun cl-not-hash-table (x &optional y &rest z) (signal 'wrong-type-argument (list 'hash-table-p (or y x)))) (defun cl-hash-lookup (key table) (or (eq (car-safe table) 'cl-hash-table-tag) (cl-not-hash-table table)) (let* ((array (nth 2 table)) (test (car (cdr table))) (str key) sym) (if (symbolp array) (setq str nil sym (symbol-value array)) (while (or (consp str) (and (vectorp str) (> (length str) 0))) (setq str (elt str 0))) (cond ((stringp str) (if (eq test 'equalp) (setq str (downcase str)))) ((symbolp str) (setq str (symbol-name str))) ((and (numberp str) (> str -8000000) (< str 8000000)) (or (integerp str) (setq str (truncate str))) (setq str (aref ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15"] (logand str 15)))) (t (setq str "*"))) (setq sym (symbol-value (intern-soft str array)))) (list (and sym (cond ((or (eq test 'eq) (and (eq test 'eql) (not (numberp key)))) (assq key sym)) ((memq test '(eql equal)) (assoc key sym)) (t (assoc* key sym ':test test)))) sym str))) (defvar cl-builtin-gethash (if (and (fboundp 'gethash) (subrp (symbol-function 'gethash))) (symbol-function 'gethash) 'cl-not-hash-table)) (defvar cl-builtin-remhash (if (and (fboundp 'remhash) (subrp (symbol-function 'remhash))) (symbol-function 'remhash) 'cl-not-hash-table)) (defvar cl-builtin-clrhash (if (and (fboundp 'clrhash) (subrp (symbol-function 'clrhash))) (symbol-function 'clrhash) 'cl-not-hash-table)) (defvar cl-builtin-maphash (if (and (fboundp 'maphash) (subrp (symbol-function 'maphash))) (symbol-function 'maphash) 'cl-not-hash-table)) (defun cl-gethash (key table &optional def) "Look up KEY in HASH-TABLE; return corresponding value, or DEFAULT." (if (consp table) (let ((found (cl-hash-lookup key table))) (if (car found) (cdr (car found)) def)) (funcall cl-builtin-gethash key table def))) (defalias 'gethash 'cl-gethash) (defun cl-puthash (key val table) (if (consp table) (let ((found (cl-hash-lookup key table))) (if (car found) (setcdr (car found) val) (if (nth 2 found) (progn (if (> (nth 3 table) (* (length (nth 2 table)) 3)) (let ((new-table (make-vector (nth 3 table) 0))) (mapatoms (function (lambda (sym) (set (intern (symbol-name sym) new-table) (symbol-value sym)))) (nth 2 table)) (setcar (cdr (cdr table)) new-table))) (set (intern (nth 2 found) (nth 2 table)) (cons (cons key val) (nth 1 found)))) (set (nth 2 table) (cons (cons key val) (nth 1 found)))) (setcar (cdr (cdr (cdr table))) (1+ (nth 3 table))))) (funcall 'puthash key val table)) val) (defun cl-remhash (key table) "Remove KEY from HASH-TABLE." (if (consp table) (let ((found (cl-hash-lookup key table))) (and (car found) (let ((del (delq (car found) (nth 1 found)))) (setcar (cdr (cdr (cdr table))) (1- (nth 3 table))) (if (nth 2 found) (set (intern (nth 2 found) (nth 2 table)) del) (set (nth 2 table) del)) t))) (prog1 (not (eq (funcall cl-builtin-gethash key table '--cl--) '--cl--)) (funcall cl-builtin-remhash key table)))) (defalias 'remhash 'cl-remhash) (defun cl-clrhash (table) "Clear HASH-TABLE." (if (consp table) (progn (or (hash-table-p table) (cl-not-hash-table table)) (if (symbolp (nth 2 table)) (set (nth 2 table) nil) (setcar (cdr (cdr table)) (make-vector (length (nth 2 table)) 0))) (setcar (cdr (cdr (cdr table))) 0)) (funcall cl-builtin-clrhash table)) nil) (defalias 'clrhash 'cl-clrhash) (defun cl-maphash (cl-func cl-table) "Call FUNCTION on keys and values from HASH-TABLE." (or (hash-table-p cl-table) (cl-not-hash-table cl-table)) (if (consp cl-table) (mapatoms (function (lambda (cl-x) (setq cl-x (symbol-value cl-x)) (while cl-x (funcall cl-func (car (car cl-x)) (cdr (car cl-x))) (setq cl-x (cdr cl-x))))) (if (symbolp (nth 2 cl-table)) (vector (nth 2 cl-table)) (nth 2 cl-table))) (funcall cl-builtin-maphash cl-func cl-table))) (defalias 'maphash 'cl-maphash) (defun hash-table-count (table) "Return the number of entries in HASH-TABLE." (or (hash-table-p table) (cl-not-hash-table table)) (if (consp table) (nth 3 table) (funcall 'hashtable-fullness table))) ;;; Some debugging aids. (defun cl-prettyprint (form) "Insert a pretty-printed rendition of a Lisp FORM in current buffer." (let ((pt (point)) last) (insert "\n" (prin1-to-string form) "\n") (setq last (point)) (goto-char (1+ pt)) (while (search-forward "(quote " last t) (delete-backward-char 7) (insert "'") (forward-sexp) (delete-char 1)) (goto-char (1+ pt)) (cl-do-prettyprint))) (defun cl-do-prettyprint () (skip-chars-forward " ") (if (looking-at "(") (let ((skip (or (looking-at "((") (looking-at "(prog") (looking-at "(unwind-protect ") (looking-at "(function (") (looking-at "(cl-block-wrapper "))) (two (or (looking-at "(defun ") (looking-at "(defmacro "))) (let (or (looking-at "(let\\*? ") (looking-at "(while "))) (set (looking-at "(p?set[qf] "))) (if (or skip let (progn (forward-sexp) (and (>= (current-column) 78) (progn (backward-sexp) t)))) (let ((nl t)) (forward-char 1) (cl-do-prettyprint) (or skip (looking-at ")") (cl-do-prettyprint)) (or (not two) (looking-at ")") (cl-do-prettyprint)) (while (not (looking-at ")")) (if set (setq nl (not nl))) (if nl (insert "\n")) (lisp-indent-line) (cl-do-prettyprint)) (forward-char 1)))) (forward-sexp))) (defvar cl-macroexpand-cmacs nil) (defvar cl-closure-vars nil) (defun cl-macroexpand-all (form &optional env) "Expand all macro calls through a Lisp FORM. This also does some trivial optimizations to make the form prettier." (while (or (not (eq form (setq form (macroexpand form env)))) (and cl-macroexpand-cmacs (not (eq form (setq form (compiler-macroexpand form))))))) (cond ((not (consp form)) form) ((memq (car form) '(let let*)) (if (null (nth 1 form)) (cl-macroexpand-all (cons 'progn (cddr form)) env) (let ((letf nil) (res nil) (lets (cadr form))) (while lets (cl-push (if (consp (car lets)) (let ((exp (cl-macroexpand-all (caar lets) env))) (or (symbolp exp) (setq letf t)) (cons exp (cl-macroexpand-body (cdar lets) env))) (let ((exp (cl-macroexpand-all (car lets) env))) (if (symbolp exp) exp (setq letf t) (list exp nil)))) res) (setq lets (cdr lets))) (list* (if letf (if (eq (car form) 'let) 'letf 'letf*) (car form)) (nreverse res) (cl-macroexpand-body (cddr form) env))))) ((eq (car form) 'cond) (cons (car form) (mapcar (function (lambda (x) (cl-macroexpand-body x env))) (cdr form)))) ((eq (car form) 'condition-case) (list* (car form) (nth 1 form) (cl-macroexpand-all (nth 2 form) env) (mapcar (function (lambda (x) (cons (car x) (cl-macroexpand-body (cdr x) env)))) (cdddr form)))) ((memq (car form) '(quote function)) (if (eq (car-safe (nth 1 form)) 'lambda) (let ((body (cl-macroexpand-body (cddadr form) env))) (if (and cl-closure-vars (eq (car form) 'function) (cl-expr-contains-any body cl-closure-vars)) (let* ((new (mapcar 'gensym cl-closure-vars)) (sub (pairlis cl-closure-vars new)) (decls nil)) (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive)) (cl-push (list 'quote (cl-pop body)) decls)) (put (car (last cl-closure-vars)) 'used t) (append (list 'list '(quote lambda) '(quote (&rest --cl-rest--))) (sublis sub (nreverse decls)) (list (list* 'list '(quote apply) (list 'list '(quote quote) (list 'function (list* 'lambda (append new (cadadr form)) (sublis sub body)))) (nconc (mapcar (function (lambda (x) (list 'list '(quote quote) x))) cl-closure-vars) '((quote --cl-rest--))))))) (list (car form) (list* 'lambda (cadadr form) body)))) form)) ((memq (car form) '(defun defmacro)) (list* (car form) (nth 1 form) (cl-macroexpand-body (cddr form) env))) ((and (eq (car form) 'progn) (not (cddr form))) (cl-macroexpand-all (nth 1 form) env)) ((eq (car form) 'setq) (let* ((args (cl-macroexpand-body (cdr form) env)) (p args)) (while (and p (symbolp (car p))) (setq p (cddr p))) (if p (cl-macroexpand-all (cons 'setf args)) (cons 'setq args)))) (t (cons (car form) (cl-macroexpand-body (cdr form) env))))) (defun cl-macroexpand-body (body &optional env) (mapcar (function (lambda (x) (cl-macroexpand-all x env))) body)) (defun cl-prettyexpand (form &optional full) (message "Expanding...") (let ((cl-macroexpand-cmacs full) (cl-compiling-file full) (byte-compile-macro-environment nil)) (setq form (cl-macroexpand-all form (and (not full) '((block) (eval-when))))) (message "Formatting...") (prog1 (cl-prettyprint form) (message "")))) (run-hooks 'cl-extra-load-hook) ;;; cl-extra.el ends here emacs-19.30/lisp/cl-indent.el100444 13437 1 46061 5405341124 14427 0ustar jimbdaemon;;; cl-indent.el --- enhanced lisp-indent mode ;; Copyright (C) 1987 Free Software Foundation, Inc. ;; Author: Richard Mlynark ;; Created: July 1987 ;; Maintainer: FSF ;; Keywords: lisp, tools ;; 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 package supplies a single entry point, common-lisp-indent-function, ;; which performs indentation in the preferred style for Common Lisp code. ;; To enable it: ;; ;; (setq lisp-indent-function 'common-lisp-indent-function) ;;>> TODO ;; :foo ;; bar ;; :baz ;; zap ;; &key (like &body)?? ;; &rest 1 in lambda-lists doesn't work ;; -- really want (foo bar ;; baz) ;; not (foo bar ;; baz) ;; Need something better than &rest for such cases ;;; Code: (defvar lisp-indent-maximum-backtracking 3 "*Maximum depth to backtrack out from a sublist for structured indentation. If this variable is 0, no backtracking will occur and forms such as flet may not be correctly indented.") (defvar lisp-tag-indentation 1 "*Indentation of tags relative to containing list. This variable is used by the function `lisp-indent-tagbody'.") (defvar lisp-tag-body-indentation 3 "*Indentation of non-tagged lines relative to containing list. This variable is used by the function `lisp-indent-tagbody' to indent normal lines (lines without tags). The indentation is relative to the indentation of the parenthesis enclosing the special form. If the value is t, the body of tags will be indented as a block at the same indentation as the first s-expression following the tag. In this case, any forms before the first tag are indented by `lisp-body-indent'.") ;;;###autoload (defun common-lisp-indent-function (indent-point state) (let ((normal-indent (current-column))) ;; Walk up list levels until we see something ;; which does special things with subforms. (let ((depth 0) ;; Path describes the position of point in terms of ;; list-structure with respect to containing lists. ;; `foo' has a path of (0 4 1) in `((a b c (d foo) f) g)' (path ()) ;; set non-nil when somebody works out the indentation to use calculated (last-point indent-point) ;; the position of the open-paren of the innermost containing list (containing-form-start (elt state 1)) ;; the column of the above sexp-column) ;; Move to start of innermost containing list (goto-char containing-form-start) (setq sexp-column (current-column)) ;; Look over successively less-deep containing forms (while (and (not calculated) (< depth lisp-indent-maximum-backtracking)) (let ((containing-sexp (point))) (forward-char 1) (parse-partial-sexp (point) indent-point 1 t) ;; Move to the car of the relevant containing form (let (tem function method) (if (not (looking-at "\\sw\\|\\s_")) ;; This form doesn't seem to start with a symbol (setq function nil method nil) (setq tem (point)) (forward-sexp 1) (setq function (downcase (buffer-substring tem (point)))) (goto-char tem) (setq tem (intern-soft function) method (get tem 'common-lisp-indent-function)) (cond ((and (null method) (string-match ":[^:]+" function)) ;; The pleblisp package feature (setq function (substring function (1+ (match-beginning 0))) method (get (intern-soft function) 'common-lisp-indent-function))) ((and (null method)) ;; backwards compatibility (setq method (get tem 'lisp-indent-function))))) (let ((n 0)) ;; How far into the containing form is the current form? (if (< (point) indent-point) (while (condition-case () (progn (forward-sexp 1) (if (>= (point) indent-point) nil (parse-partial-sexp (point) indent-point 1 t) (setq n (1+ n)) t)) (error nil)))) (setq path (cons n path))) ;; backwards compatibility. (cond ((null function)) ((null method) (if (null (cdr path)) ;; (package prefix was stripped off above) (setq method (cond ((string-match "\\`def" function) '(4 (&whole 4 &rest 1) &body)) ((string-match "\\`\\(with\\|do\\)-" function) '(4 &body)))))) ;; backwards compatibility. Bletch. ((eq method 'defun) (setq method '(4 (&whole 4 &rest 1) &body)))) (cond ((and (memq (char-after (1- containing-sexp)) '(?\' ?\`)) (not (eql (char-after (- containing-sexp 2)) ?\#))) ;; No indentation for "'(...)" elements (setq calculated (1+ sexp-column))) ((or (eql (char-after (1- containing-sexp)) ?\,) (and (eql (char-after (1- containing-sexp)) ?\@) (eql (char-after (- containing-sexp 2)) ?\,))) ;; ",(...)" or ",@(...)" (setq calculated normal-indent)) ((eql (char-after (1- containing-sexp)) ?\#) ;; "#(...)" (setq calculated (1+ sexp-column))) ((null method)) ((integerp method) ;; convenient top-level hack. ;; (also compatible with lisp-indent-function) ;; The number specifies how many `distinguished' ;; forms there are before the body starts ;; Equivalent to (4 4 ... &body) (setq calculated (cond ((cdr path) normal-indent) ((<= (car path) method) ;; `distinguished' form (list (+ sexp-column 4) containing-form-start)) ((= (car path) (1+ method)) ;; first body form. (+ sexp-column lisp-body-indent)) (t ;; other body form normal-indent)))) ((symbolp method) (setq calculated (funcall method path state indent-point sexp-column normal-indent))) (t (setq calculated (lisp-indent-259 method path state indent-point sexp-column normal-indent))))) (goto-char containing-sexp) (setq last-point containing-sexp) (if (not calculated) (condition-case () (progn (backward-up-list 1) (setq depth (1+ depth))) (error (setq depth lisp-indent-maximum-backtracking)))))) calculated))) (defun lisp-indent-report-bad-format (m) (error "%s has a badly-formed %s property: %s" ;; Love those free variable references!! function 'common-lisp-indent-function m)) ;; Blame the crufty control structure on dynamic scoping ;; -- not on me! (defun lisp-indent-259 (method path state indent-point sexp-column normal-indent) (catch 'exit (let ((p path) (containing-form-start (elt state 1)) n tem tail) ;; Isn't tail-recursion wonderful? (while p ;; This while loop is for destructuring. ;; p is set to (cdr p) each iteration. (if (not (consp method)) (lisp-indent-report-bad-format method)) (setq n (1- (car p)) p (cdr p) tail nil) (while n ;; This while loop is for advancing along a method ;; until the relevant (possibly &rest/&body) pattern ;; is reached. ;; n is set to (1- n) and method to (cdr method) ;; each iteration. (setq tem (car method)) (or (eq tem 'nil) ;default indentation ; (eq tem '&lambda) ;abbrev for (&whole 4 (&rest 1)) (and (eq tem '&body) (null (cdr method))) (and (eq tem '&rest) (consp (cdr method)) (null (cdr (cdr method)))) (integerp tem) ;explicit indentation specified (and (consp tem) ;destructuring (eq (car tem) '&whole) (or (symbolp (car (cdr tem))) (integerp (car (cdr tem))))) (and (symbolp tem) ;a function to call to do the work. (null (cdr method))) (lisp-indent-report-bad-format method)) (cond ((and tail (not (consp tem))) ;; indent tail of &rest in same way as first elt of rest (throw 'exit normal-indent)) ((eq tem '&body) ;; &body means (&rest ) (throw 'exit (if (and (= n 0) ;first body form (null p)) ;not in subforms (+ sexp-column lisp-body-indent) normal-indent))) ((eq tem '&rest) ;; this pattern holds for all remaining forms (setq tail (> n 0) n 0 method (cdr method))) ((> n 0) ;; try next element of pattern (setq n (1- n) method (cdr method)) (if (< n 0) ;; Too few elements in pattern. (throw 'exit normal-indent))) ((eq tem 'nil) (throw 'exit (list normal-indent containing-form-start))) ; ((eq tem '&lambda) ; ;; abbrev for (&whole 4 &rest 1) ; (throw 'exit ; (cond ((null p) ; (list (+ sexp-column 4) containing-form-start)) ; ((null (cdr p)) ; (+ sexp-column 1)) ; (t normal-indent)))) ((integerp tem) (throw 'exit (if (null p) ;not in subforms (list (+ sexp-column tem) containing-form-start) normal-indent))) ((symbolp tem) ;a function to call (throw 'exit (funcall tem path state indent-point sexp-column normal-indent))) (t ;; must be a destructing frob (if (not (null p)) ;; descend (setq method (cdr (cdr tem)) n nil) (setq tem (car (cdr tem))) (throw 'exit (cond (tail normal-indent) ((eq tem 'nil) (list normal-indent containing-form-start)) ((integerp tem) (list (+ sexp-column tem) containing-form-start)) (t (funcall tem path state indent-point sexp-column normal-indent)))))))))))) (defun lisp-indent-tagbody (path state indent-point sexp-column normal-indent) (if (not (null (cdr path))) normal-indent (save-excursion (goto-char indent-point) (beginning-of-line) (skip-chars-forward " \t") (list (cond ((looking-at "\\sw\\|\\s_") ;; a tagbody tag (+ sexp-column lisp-tag-indentation)) ((integerp lisp-tag-body-indentation) (+ sexp-column lisp-tag-body-indentation)) ((eq lisp-tag-body-indentation 't) (condition-case () (progn (backward-sexp 1) (current-column)) (error (1+ sexp-column)))) (t (+ sexp-column lisp-body-indent))) ; (cond ((integerp lisp-tag-body-indentation) ; (+ sexp-column lisp-tag-body-indentation)) ; ((eq lisp-tag-body-indentation 't) ; normal-indent) ; (t ; (+ sexp-column lisp-body-indent))) (elt state 1) )))) (defun lisp-indent-do (path state indent-point sexp-column normal-indent) (if (>= (car path) 3) (let ((lisp-tag-body-indentation lisp-body-indent)) (funcall (function lisp-indent-tagbody) path state indent-point sexp-column normal-indent)) (funcall (function lisp-indent-259) '((&whole nil &rest ;; the following causes weird indentation ;;(&whole 1 1 2 nil) ) (&whole nil &rest 1)) path state indent-point sexp-column normal-indent))) (defun lisp-indent-function-lambda-hack (path state indent-point sexp-column normal-indent) ;; indent (function (lambda () )) kludgily. (if (or (cdr path) ; wtf? (> (car path) 3)) ;; line up under previous body form normal-indent ;; line up under function rather than under lambda in order to ;; conserve horizontal space. (Which is what #' is for.) (condition-case () (save-excursion (backward-up-list 2) (forward-char 1) (if (looking-at "\\(lisp:+\\)?function\\(\\Sw\\|\\S_\\)") (+ lisp-body-indent -1 (current-column)) (+ sexp-column lisp-body-indent))) (error (+ sexp-column lisp-body-indent))))) (let ((l '((block 1) (catch 1) (case (4 &rest (&whole 2 &rest 1))) (ccase . case) (ecase . case) (typecase . case) (etypecase . case) (ctypecase . case) (catch 1) (cond (&rest (&whole 2 &rest 1))) (block 1) (defvar (4 2 2)) (defconstant . defvar) (defparameter . defvar) (define-modify-macro (4 &body)) (define-setf-method (4 (&whole 4 &rest 1) &body)) (defsetf (4 (&whole 4 &rest 1) 4 &body)) (defun (4 (&whole 4 &rest 1) &body)) (defmacro . defun) (deftype . defun) (defstruct ((&whole 4 &rest (&whole 2 &rest 1)) &rest (&whole 2 &rest 1))) (destructuring-bind ((&whole 6 &rest 1) 4 &body)) (do lisp-indent-do) (do* . do) (dolist ((&whole 4 2 1) &body)) (dotimes . dolist) (eval-when 1) (flet ((&whole 4 &rest (&whole 1 (&whole 4 &rest 1) &body)) &body)) (labels . flet) (macrolet . flet) ;; `else-body' style (if (nil nil &body)) ;; single-else style (then and else equally indented) (if (&rest nil)) ;(lambda ((&whole 4 &rest 1) &body)) (lambda ((&whole 4 &rest 1) &rest lisp-indent-function-lambda-hack)) (let ((&whole 4 &rest (&whole 1 1 2)) &body)) (let* . let) (compiler-let . let) ;barf (locally 1) ;(loop ...) (multiple-value-bind ((&whole 6 &rest 1) 4 &body)) (multiple-value-call (4 &body)) (multiple-value-list 1) (multiple-value-prog1 1) (multiple-value-setq (4 2)) ;; Combines the worst features of BLOCK, LET and TAGBODY (prog ((&whole 4 &rest 1) &rest lisp-indent-tagbody)) (prog* . prog) (prog1 1) (prog2 2) (progn 0) (progv (4 4 &body)) (return 0) (return-from (nil &body)) (tagbody lisp-indent-tagbody) (throw 1) (unless 1) (unwind-protect (5 &body)) (when 1)))) (while l (put (car (car l)) 'common-lisp-indent-function (if (symbolp (cdr (car l))) (get (cdr (car l)) 'common-lisp-indent-function) (car (cdr (car l))))) (setq l (cdr l)))) ;(defun foo (x) ; (tagbody ; foo ; (bar) ; baz ; (when (losing) ; (with-big-loser ; (yow) ; ((lambda () ; foo) ; big))) ; (flet ((foo (bar baz zap) ; (zip)) ; (zot () ; quux)) ; (do () ; ((lose) ; (foo 1)) ; (quux) ; foo ; (lose)) ; (cond ((x) ; (win 1 2 ; (foo))) ; (t ; (lose ; 3)))))) ;(put 'while 'common-lisp-indent-function 1) ;(put 'defwrapper'common-lisp-indent-function ...) ;(put 'def 'common-lisp-indent-function ...) ;(put 'defflavor 'common-lisp-indent-function ...) ;(put 'defsubst 'common-lisp-indent-function ...) ;(put 'with-restart 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body))) ;(put 'restart-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (* 1))))) ;(put 'define-condition 'common-lisp-indent-function '((1 6) (2 6 ((* 1))) (3 4 ((* 1))) (4 &body))) ;(put 'with-condition-handler 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body))) ;(put 'condition-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (1 3) (2 &body))))) ;;; cl-indent.el ends here emacs-19.30/lisp/cl-macs.el100444 12120 1 305245 6045201367 13764 0ustar rmsdaemon;;; cl-macs.el --- Common Lisp extensions for GNU Emacs Lisp (part four) ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Dave Gillespie ;; Version: 2.02 ;; Keywords: extensions ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 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: ;; These are extensions to Emacs Lisp that provide a degree of ;; Common Lisp compatibility, beyond what is already built-in ;; in Emacs Lisp. ;; ;; This package was written by Dave Gillespie; it is a complete ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. ;; ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. ;; ;; Bug reports, comments, and suggestions are welcome! ;; This file contains the portions of the Common Lisp extensions ;; package which should be autoloaded, but need only be present ;; if the compiler or interpreter is used---this file is not ;; necessary for executing compiled code. ;; See cl.el for Change Log. ;;; Code: (or (memq 'cl-19 features) (error "Tried to load `cl-macs' before `cl'!")) ;;; We define these here so that this file can compile without having ;;; loaded the cl.el file already. (defmacro cl-push (x place) (list 'setq place (list 'cons x place))) (defmacro cl-pop (place) (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) (defmacro cl-pop2 (place) (list 'prog1 (list 'car (list 'cdr place)) (list 'setq place (list 'cdr (list 'cdr place))))) (put 'cl-push 'edebug-form-spec 'edebug-sexps) (put 'cl-pop 'edebug-form-spec 'edebug-sexps) (put 'cl-pop2 'edebug-form-spec 'edebug-sexps) (defvar cl-emacs-type) (defvar cl-optimize-safety) (defvar cl-optimize-speed) ;;; This kludge allows macros which use cl-transform-function-property ;;; to be called at compile-time. (require (progn (or (fboundp 'defalias) (fset 'defalias 'fset)) (or (fboundp 'cl-transform-function-property) (defalias 'cl-transform-function-property (function (lambda (n p f) (list 'put (list 'quote n) (list 'quote p) (list 'function (cons 'lambda f))))))) (car (or features (setq features (list 'cl-kludge)))))) ;;; Initialization. (defvar cl-old-bc-file-form nil) ;; Patch broken Emacs 18 compiler (re top-level macros). ;; Emacs 19 compiler doesn't need this patch. ;; Also, undo broken definition of `eql' that uses same bytecode as `eq'. (defun cl-compile-time-init () (setq cl-old-bc-file-form (symbol-function 'byte-compile-file-form)) (or (fboundp 'byte-compile-flush-pending) ; Emacs 19 compiler? (defalias 'byte-compile-file-form (function (lambda (form) (setq form (macroexpand form byte-compile-macro-environment)) (if (eq (car-safe form) 'progn) (cons 'progn (mapcar 'byte-compile-file-form (cdr form))) (funcall cl-old-bc-file-form form)))))) (put 'eql 'byte-compile 'cl-byte-compile-compiler-macro) (run-hooks 'cl-hack-bytecomp-hook)) ;;; Symbols. (defvar *gensym-counter*) (defun gensym (&optional arg) "Generate a new uninterned symbol. The name is made by appending a number to PREFIX, default \"G\"." (let ((prefix (if (stringp arg) arg "G")) (num (if (integerp arg) arg (prog1 *gensym-counter* (setq *gensym-counter* (1+ *gensym-counter*)))))) (make-symbol (format "%s%d" prefix num)))) (defun gentemp (&optional arg) "Generate a new interned symbol with a unique name. The name is made by appending a number to PREFIX, default \"G\"." (let ((prefix (if (stringp arg) arg "G")) name) (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*))) (setq *gensym-counter* (1+ *gensym-counter*))) (intern name))) ;;; Program structure. (defmacro defun* (name args &rest body) "(defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. Like normal `defun', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...)." (let* ((res (cl-transform-lambda (cons args body) name)) (form (list* 'defun name (cdr res)))) (if (car res) (list 'progn (car res) form) form))) (defmacro defmacro* (name args &rest body) "(defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro. Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...)." (let* ((res (cl-transform-lambda (cons args body) name)) (form (list* 'defmacro name (cdr res)))) (if (car res) (list 'progn (car res) form) form))) (defmacro function* (func) "(function* SYMBOL-OR-LAMBDA): introduce a function. Like normal `function', except that if argument is a lambda form, its ARGLIST allows full Common Lisp conventions." (if (eq (car-safe func) 'lambda) (let* ((res (cl-transform-lambda (cdr func) 'cl-none)) (form (list 'function (cons 'lambda (cdr res))))) (if (car res) (list 'progn (car res) form) form)) (list 'function func))) (defun cl-transform-function-property (func prop form) (let ((res (cl-transform-lambda form func))) (append '(progn) (cdr (cdr (car res))) (list (list 'put (list 'quote func) (list 'quote prop) (list 'function (cons 'lambda (cdr res)))))))) (defconst lambda-list-keywords '(&optional &rest &key &allow-other-keys &aux &whole &body &environment)) (defvar cl-macro-environment nil) (defvar bind-block) (defvar bind-defs) (defvar bind-enquote) (defvar bind-inits) (defvar bind-lets) (defvar bind-forms) (defun cl-transform-lambda (form bind-block) (let* ((args (car form)) (body (cdr form)) (bind-defs nil) (bind-enquote nil) (bind-inits nil) (bind-lets nil) (bind-forms nil) (header nil) (simple-args nil)) (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive)) (cl-push (cl-pop body) header)) (setq args (if (listp args) (copy-list args) (list '&rest args))) (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) (if (setq bind-defs (cadr (memq '&cl-defs args))) (setq args (delq '&cl-defs (delq bind-defs args)) bind-defs (cadr bind-defs))) (if (setq bind-enquote (memq '&cl-quote args)) (setq args (delq '&cl-quote args))) (if (memq '&whole args) (error "&whole not currently implemented")) (let* ((p (memq '&environment args)) (v (cadr p))) (if p (setq args (nconc (delq (car p) (delq v args)) (list '&aux (list v 'cl-macro-environment)))))) (while (and args (symbolp (car args)) (not (memq (car args) '(nil &rest &body &key &aux))) (not (and (eq (car args) '&optional) (or bind-defs (consp (cadr args)))))) (cl-push (cl-pop args) simple-args)) (or (eq bind-block 'cl-none) (setq body (list (list* 'block bind-block body)))) (if (null args) (list* nil (nreverse simple-args) (nconc (nreverse header) body)) (if (memq '&optional simple-args) (cl-push '&optional args)) (cl-do-arglist args nil (- (length simple-args) (if (memq '&optional simple-args) 1 0))) (setq bind-lets (nreverse bind-lets)) (list* (and bind-inits (list* 'eval-when '(compile load eval) (nreverse bind-inits))) (nconc (nreverse simple-args) (list '&rest (car (cl-pop bind-lets)))) (nconc (nreverse header) (list (nconc (list 'let* bind-lets) (nreverse bind-forms) body))))))) (defun cl-do-arglist (args expr &optional num) ; uses bind-* (if (nlistp args) (if (or (memq args lambda-list-keywords) (not (symbolp args))) (error "Invalid argument name: %s" args) (cl-push (list args expr) bind-lets)) (setq args (copy-list args)) (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) (let ((p (memq '&body args))) (if p (setcar p '&rest))) (if (memq '&environment args) (error "&environment used incorrectly")) (let ((save-args args) (restarg (memq '&rest args)) (safety (if (cl-compiling-file) cl-optimize-safety 3)) (keys nil) (laterarg nil) (exactarg nil) minarg) (or num (setq num 0)) (if (listp (cadr restarg)) (setq restarg (gensym "--rest--")) (setq restarg (cadr restarg))) (cl-push (list restarg expr) bind-lets) (if (eq (car args) '&whole) (cl-push (list (cl-pop2 args) restarg) bind-lets)) (let ((p args)) (setq minarg restarg) (while (and p (not (memq (car p) lambda-list-keywords))) (or (eq p args) (setq minarg (list 'cdr minarg))) (setq p (cdr p))) (if (memq (car p) '(nil &aux)) (setq minarg (list '= (list 'length restarg) (length (ldiff args p))) exactarg (not (eq args p))))) (while (and args (not (memq (car args) lambda-list-keywords))) (let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car) restarg))) (cl-do-arglist (cl-pop args) (if (or laterarg (= safety 0)) poparg (list 'if minarg poparg (list 'signal '(quote wrong-number-of-arguments) (list 'list (and (not (eq bind-block 'cl-none)) (list 'quote bind-block)) (list 'length restarg))))))) (setq num (1+ num) laterarg t)) (while (and (eq (car args) '&optional) (cl-pop args)) (while (and args (not (memq (car args) lambda-list-keywords))) (let ((arg (cl-pop args))) (or (consp arg) (setq arg (list arg))) (if (cddr arg) (cl-do-arglist (nth 2 arg) (list 'and restarg t))) (let ((def (if (cdr arg) (nth 1 arg) (or (car bind-defs) (nth 1 (assq (car arg) bind-defs))))) (poparg (list 'pop restarg))) (and def bind-enquote (setq def (list 'quote def))) (cl-do-arglist (car arg) (if def (list 'if restarg poparg def) poparg)) (setq num (1+ num)))))) (if (eq (car args) '&rest) (let ((arg (cl-pop2 args))) (if (consp arg) (cl-do-arglist arg restarg))) (or (eq (car args) '&key) (= safety 0) exactarg (cl-push (list 'if restarg (list 'signal '(quote wrong-number-of-arguments) (list 'list (and (not (eq bind-block 'cl-none)) (list 'quote bind-block)) (list '+ num (list 'length restarg))))) bind-forms))) (while (and (eq (car args) '&key) (cl-pop args)) (while (and args (not (memq (car args) lambda-list-keywords))) (let ((arg (cl-pop args))) (or (consp arg) (setq arg (list arg))) (let* ((karg (if (consp (car arg)) (caar arg) (intern (format ":%s" (car arg))))) (varg (if (consp (car arg)) (cadar arg) (car arg))) (def (if (cdr arg) (cadr arg) (or (car bind-defs) (cadr (assq varg bind-defs))))) (look (list 'memq (list 'quote karg) restarg))) (and def bind-enquote (setq def (list 'quote def))) (if (cddr arg) (let* ((temp (or (nth 2 arg) (gensym))) (val (list 'car (list 'cdr temp)))) (cl-do-arglist temp look) (cl-do-arglist varg (list 'if temp (list 'prog1 val (list 'setq temp t)) def))) (cl-do-arglist varg (list 'car (list 'cdr (if (null def) look (list 'or look (if (eq (cl-const-expr-p def) t) (list 'quote (list nil (cl-const-expr-val def))) (list 'list nil def)))))))) (cl-push karg keys) (if (= (aref (symbol-name karg) 0) ?:) (progn (set karg karg) (cl-push (list 'setq karg (list 'quote karg)) bind-inits))))))) (setq keys (nreverse keys)) (or (and (eq (car args) '&allow-other-keys) (cl-pop args)) (null keys) (= safety 0) (let* ((var (gensym "--keys--")) (allow '(:allow-other-keys)) (check (list 'while var (list 'cond (list (list 'memq (list 'car var) (list 'quote (append keys allow))) (list 'setq var (list 'cdr (list 'cdr var)))) (list (list 'car (list 'cdr (list 'memq (cons 'quote allow) restarg))) (list 'setq var nil)) (list t (list 'error (format "Keyword argument %%s not one of %s" keys) (list 'car var))))))) (cl-push (list 'let (list (list var restarg)) check) bind-forms))) (while (and (eq (car args) '&aux) (cl-pop args)) (while (and args (not (memq (car args) lambda-list-keywords))) (if (consp (car args)) (if (and bind-enquote (cadar args)) (cl-do-arglist (caar args) (list 'quote (cadr (cl-pop args)))) (cl-do-arglist (caar args) (cadr (cl-pop args)))) (cl-do-arglist (cl-pop args) nil)))) (if args (error "Malformed argument list %s" save-args))))) (defun cl-arglist-args (args) (if (nlistp args) (list args) (let ((res nil) (kind nil) arg) (while (consp args) (setq arg (cl-pop args)) (if (memq arg lambda-list-keywords) (setq kind arg) (if (eq arg '&cl-defs) (cl-pop args) (and (consp arg) kind (setq arg (car arg))) (and (consp arg) (cdr arg) (eq kind '&key) (setq arg (cadr arg))) (setq res (nconc res (cl-arglist-args arg)))))) (nconc res (and args (list args)))))) (defmacro destructuring-bind (args expr &rest body) (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil) (bind-defs nil) (bind-block 'cl-none)) (cl-do-arglist (or args '(&aux)) expr) (append '(progn) bind-inits (list (nconc (list 'let* (nreverse bind-lets)) (nreverse bind-forms) body))))) ;;; The `eval-when' form. (defvar cl-not-toplevel nil) (defmacro eval-when (when &rest body) "(eval-when (WHEN...) BODY...): control when BODY is evaluated. If `compile' is in WHEN, BODY is evaluated when compiled at top-level. If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level." (if (and (fboundp 'cl-compiling-file) (cl-compiling-file) (not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge (let ((comp (or (memq 'compile when) (memq ':compile-toplevel when))) (cl-not-toplevel t)) (if (or (memq 'load when) (memq ':load-toplevel when)) (if comp (cons 'progn (mapcar 'cl-compile-time-too body)) (list* 'if nil nil body)) (progn (if comp (eval (cons 'progn body))) nil))) (and (or (memq 'eval when) (memq ':execute when)) (cons 'progn body)))) (defun cl-compile-time-too (form) (or (and (symbolp (car-safe form)) (get (car-safe form) 'byte-hunk-handler)) (setq form (macroexpand form (cons '(eval-when) byte-compile-macro-environment)))) (cond ((eq (car-safe form) 'progn) (cons 'progn (mapcar 'cl-compile-time-too (cdr form)))) ((eq (car-safe form) 'eval-when) (let ((when (nth 1 form))) (if (or (memq 'eval when) (memq ':execute when)) (list* 'eval-when (cons 'compile when) (cddr form)) form))) (t (eval form) form))) (or (and (fboundp 'eval-when-compile) (not (eq (car-safe (symbol-function 'eval-when-compile)) 'autoload))) (eval '(defmacro eval-when-compile (&rest body) "Like `progn', but evaluates the body at compile time. The result of the body appears to the compiler as a quoted constant." (list 'quote (eval (cons 'progn body)))))) (defmacro load-time-value (form &optional read-only) "Like `progn', but evaluates the body at load time. The result of the body appears to the compiler as a quoted constant." (if (cl-compiling-file) (let* ((temp (gentemp "--cl-load-time--")) (set (list 'set (list 'quote temp) form))) (if (and (fboundp 'byte-compile-file-form-defmumble) (boundp 'this-kind) (boundp 'that-one)) (fset 'byte-compile-file-form (list 'lambda '(form) (list 'fset '(quote byte-compile-file-form) (list 'quote (symbol-function 'byte-compile-file-form))) (list 'byte-compile-file-form (list 'quote set)) '(byte-compile-file-form form))) (print set (symbol-value 'outbuffer))) (list 'symbol-value (list 'quote temp))) (list 'quote (eval form)))) ;;; Conditional control structures. (defmacro case (expr &rest clauses) "(case EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared against each key in each KEYLIST; the corresponding BODY is evaluated. If no clause succeeds, case returns nil. A single atom may be used in place of a KEYLIST of one atom. A KEYLIST of `t' or `otherwise' is allowed only in the final clause, and matches if no other keys match. Key values are compared by `eql'." (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym))) (head-list nil) (body (cons 'cond (mapcar (function (lambda (c) (cons (cond ((memq (car c) '(t otherwise)) t) ((eq (car c) 'ecase-error-flag) (list 'error "ecase failed: %s, %s" temp (list 'quote (reverse head-list)))) ((listp (car c)) (setq head-list (append (car c) head-list)) (list 'member* temp (list 'quote (car c)))) (t (if (memq (car c) head-list) (error "Duplicate key in case: %s" (car c))) (cl-push (car c) head-list) (list 'eql temp (list 'quote (car c))))) (or (cdr c) '(nil))))) clauses)))) (if (eq temp expr) body (list 'let (list (list temp expr)) body)))) (defmacro ecase (expr &rest clauses) "(ecase EXPR CLAUSES...): like `case', but error if no case fits. `otherwise'-clauses are not allowed." (list* 'case expr (append clauses '((ecase-error-flag))))) (defmacro typecase (expr &rest clauses) "(typecase EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, typecase returns nil. A TYPE of `t' or `otherwise' is allowed only in the final clause, and matches if no other keys match." (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym))) (type-list nil) (body (cons 'cond (mapcar (function (lambda (c) (cons (cond ((eq (car c) 'otherwise) t) ((eq (car c) 'ecase-error-flag) (list 'error "etypecase failed: %s, %s" temp (list 'quote (reverse type-list)))) (t (cl-push (car c) type-list) (cl-make-type-test temp (car c)))) (or (cdr c) '(nil))))) clauses)))) (if (eq temp expr) body (list 'let (list (list temp expr)) body)))) (defmacro etypecase (expr &rest clauses) "(etypecase EXPR CLAUSES...): like `typecase', but error if no case fits. `otherwise'-clauses are not allowed." (list* 'typecase expr (append clauses '((ecase-error-flag))))) ;;; Blocks and exits. (defmacro block (name &rest body) "(block NAME BODY...): define a lexically-scoped block named NAME. NAME may be any symbol. Code inside the BODY forms can call `return-from' to jump prematurely out of the block. This differs from `catch' and `throw' in two respects: First, the NAME is an unevaluated symbol rather than a quoted symbol or other form; and second, NAME is lexically rather than dynamically scoped: Only references to it within BODY will work. These references may appear inside macro expansions, but not inside functions called from BODY." (if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body) (list 'cl-block-wrapper (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name))) body)))) (defvar cl-active-block-names nil) (put 'cl-block-wrapper 'byte-compile 'cl-byte-compile-block) (defun cl-byte-compile-block (cl-form) (if (fboundp 'byte-compile-form-do-effect) ; Check for optimizing compiler (progn (let* ((cl-entry (cons (nth 1 (nth 1 (nth 1 cl-form))) nil)) (cl-active-block-names (cons cl-entry cl-active-block-names)) (cl-body (byte-compile-top-level (cons 'progn (cddr (nth 1 cl-form)))))) (if (cdr cl-entry) (byte-compile-form (list 'catch (nth 1 (nth 1 cl-form)) cl-body)) (byte-compile-form cl-body)))) (byte-compile-form (nth 1 cl-form)))) (put 'cl-block-throw 'byte-compile 'cl-byte-compile-throw) (defun cl-byte-compile-throw (cl-form) (let ((cl-found (assq (nth 1 (nth 1 cl-form)) cl-active-block-names))) (if cl-found (setcdr cl-found t))) (byte-compile-normal-call (cons 'throw (cdr cl-form)))) (defmacro return (&optional res) "(return [RESULT]): return from the block named nil. This is equivalent to `(return-from nil RESULT)'." (list 'return-from nil res)) (defmacro return-from (name &optional res) "(return-from NAME [RESULT]): return from the block named NAME. This jump out to the innermost enclosing `(block NAME ...)' form, returning RESULT from that form (or nil if RESULT is omitted). This is compatible with Common Lisp, but note that `defun' and `defmacro' do not create implicit blocks as they do in Common Lisp." (let ((name2 (intern (format "--cl-block-%s--" name)))) (list 'cl-block-throw (list 'quote name2) res))) ;;; The "loop" macro. (defvar args) (defvar loop-accum-var) (defvar loop-accum-vars) (defvar loop-bindings) (defvar loop-body) (defvar loop-destr-temps) (defvar loop-finally) (defvar loop-finish-flag) (defvar loop-first-flag) (defvar loop-initially) (defvar loop-map-form) (defvar loop-name) (defvar loop-result) (defvar loop-result-explicit) (defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs) (defmacro loop (&rest args) "(loop CLAUSE...): The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND, always COND, never COND, thereis COND, collect EXPR into VAR, append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR, count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR, if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR, finally return EXPR, named NAME." (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list args)))))) (list 'block nil (list* 'while t args)) (let ((loop-name nil) (loop-bindings nil) (loop-body nil) (loop-steps nil) (loop-result nil) (loop-result-explicit nil) (loop-result-var nil) (loop-finish-flag nil) (loop-accum-var nil) (loop-accum-vars nil) (loop-initially nil) (loop-finally nil) (loop-map-form nil) (loop-first-flag nil) (loop-destr-temps nil) (loop-symbol-macs nil)) (setq args (append args '(cl-end-loop))) (while (not (eq (car args) 'cl-end-loop)) (cl-parse-loop-clause)) (if loop-finish-flag (cl-push (list (list loop-finish-flag t)) loop-bindings)) (if loop-first-flag (progn (cl-push (list (list loop-first-flag t)) loop-bindings) (cl-push (list 'setq loop-first-flag nil) loop-steps))) (let* ((epilogue (nconc (nreverse loop-finally) (list (or loop-result-explicit loop-result)))) (ands (cl-loop-build-ands (nreverse loop-body))) (while-body (nconc (cadr ands) (nreverse loop-steps))) (body (append (nreverse loop-initially) (list (if loop-map-form (list 'block '--cl-finish-- (subst (if (eq (car ands) t) while-body (cons (list 'or (car ands) '(return-from --cl-finish-- nil)) while-body)) '--cl-map loop-map-form)) (list* 'while (car ands) while-body))) (if loop-finish-flag (if (equal epilogue '(nil)) (list loop-result-var) (list (list 'if loop-finish-flag (cons 'progn epilogue) loop-result-var))) epilogue)))) (if loop-result-var (cl-push (list loop-result-var) loop-bindings)) (while loop-bindings (if (cdar loop-bindings) (setq body (list (cl-loop-let (cl-pop loop-bindings) body t))) (let ((lets nil)) (while (and loop-bindings (not (cdar loop-bindings))) (cl-push (car (cl-pop loop-bindings)) lets)) (setq body (list (cl-loop-let lets body nil)))))) (if loop-symbol-macs (setq body (list (list* 'symbol-macrolet loop-symbol-macs body)))) (list* 'block loop-name body))))) (defun cl-parse-loop-clause () ; uses args, loop-* (let ((word (cl-pop args)) (hash-types '(hash-key hash-keys hash-value hash-values)) (key-types '(key-code key-codes key-seq key-seqs key-binding key-bindings))) (cond ((null args) (error "Malformed `loop' macro")) ((eq word 'named) (setq loop-name (cl-pop args))) ((eq word 'initially) (if (memq (car args) '(do doing)) (cl-pop args)) (or (consp (car args)) (error "Syntax error on `initially' clause")) (while (consp (car args)) (cl-push (cl-pop args) loop-initially))) ((eq word 'finally) (if (eq (car args) 'return) (setq loop-result-explicit (or (cl-pop2 args) '(quote nil))) (if (memq (car args) '(do doing)) (cl-pop args)) (or (consp (car args)) (error "Syntax error on `finally' clause")) (if (and (eq (caar args) 'return) (null loop-name)) (setq loop-result-explicit (or (nth 1 (cl-pop args)) '(quote nil))) (while (consp (car args)) (cl-push (cl-pop args) loop-finally))))) ((memq word '(for as)) (let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil) (ands nil)) (while (let ((var (or (cl-pop args) (gensym)))) (setq word (cl-pop args)) (if (eq word 'being) (setq word (cl-pop args))) (if (memq word '(the each)) (setq word (cl-pop args))) (if (memq word '(buffer buffers)) (setq word 'in args (cons '(buffer-list) args))) (cond ((memq word '(from downfrom upfrom to downto upto above below by)) (cl-push word args) (if (memq (car args) '(downto above)) (error "Must specify `from' value for downward loop")) (let* ((down (or (eq (car args) 'downfrom) (memq (caddr args) '(downto above)))) (excl (or (memq (car args) '(above below)) (memq (caddr args) '(above below)))) (start (and (memq (car args) '(from upfrom downfrom)) (cl-pop2 args))) (end (and (memq (car args) '(to upto downto above below)) (cl-pop2 args))) (step (and (eq (car args) 'by) (cl-pop2 args))) (end-var (and (not (cl-const-expr-p end)) (gensym))) (step-var (and (not (cl-const-expr-p step)) (gensym)))) (and step (numberp step) (<= step 0) (error "Loop `by' value is not positive: %s" step)) (cl-push (list var (or start 0)) loop-for-bindings) (if end-var (cl-push (list end-var end) loop-for-bindings)) (if step-var (cl-push (list step-var step) loop-for-bindings)) (if end (cl-push (list (if down (if excl '> '>=) (if excl '< '<=)) var (or end-var end)) loop-body)) (cl-push (list var (list (if down '- '+) var (or step-var step 1))) loop-for-steps))) ((memq word '(in in-ref on)) (let* ((on (eq word 'on)) (temp (if (and on (symbolp var)) var (gensym)))) (cl-push (list temp (cl-pop args)) loop-for-bindings) (cl-push (list 'consp temp) loop-body) (if (eq word 'in-ref) (cl-push (list var (list 'car temp)) loop-symbol-macs) (or (eq temp var) (progn (cl-push (list var nil) loop-for-bindings) (cl-push (list var (if on temp (list 'car temp))) loop-for-sets)))) (cl-push (list temp (if (eq (car args) 'by) (let ((step (cl-pop2 args))) (if (and (memq (car-safe step) '(quote function function*)) (symbolp (nth 1 step))) (list (nth 1 step) temp) (list 'funcall step temp))) (list 'cdr temp))) loop-for-steps))) ((eq word '=) (let* ((start (cl-pop args)) (then (if (eq (car args) 'then) (cl-pop2 args) start))) (cl-push (list var nil) loop-for-bindings) (if (or ands (eq (car args) 'and)) (progn (cl-push (list var (list 'if (or loop-first-flag (setq loop-first-flag (gensym))) start var)) loop-for-sets) (cl-push (list var then) loop-for-steps)) (cl-push (list var (if (eq start then) start (list 'if (or loop-first-flag (setq loop-first-flag (gensym))) start then))) loop-for-sets)))) ((memq word '(across across-ref)) (let ((temp-vec (gensym)) (temp-idx (gensym))) (cl-push (list temp-vec (cl-pop args)) loop-for-bindings) (cl-push (list temp-idx -1) loop-for-bindings) (cl-push (list '< (list 'setq temp-idx (list '1+ temp-idx)) (list 'length temp-vec)) loop-body) (if (eq word 'across-ref) (cl-push (list var (list 'aref temp-vec temp-idx)) loop-symbol-macs) (cl-push (list var nil) loop-for-bindings) (cl-push (list var (list 'aref temp-vec temp-idx)) loop-for-sets)))) ((memq word '(element elements)) (let ((ref (or (memq (car args) '(in-ref of-ref)) (and (not (memq (car args) '(in of))) (error "Expected `of'")))) (seq (cl-pop2 args)) (temp-seq (gensym)) (temp-idx (if (eq (car args) 'using) (if (and (= (length (cadr args)) 2) (eq (caadr args) 'index)) (cadr (cl-pop2 args)) (error "Bad `using' clause")) (gensym)))) (cl-push (list temp-seq seq) loop-for-bindings) (cl-push (list temp-idx 0) loop-for-bindings) (if ref (let ((temp-len (gensym))) (cl-push (list temp-len (list 'length temp-seq)) loop-for-bindings) (cl-push (list var (list 'elt temp-seq temp-idx)) loop-symbol-macs) (cl-push (list '< temp-idx temp-len) loop-body)) (cl-push (list var nil) loop-for-bindings) (cl-push (list 'and temp-seq (list 'or (list 'consp temp-seq) (list '< temp-idx (list 'length temp-seq)))) loop-body) (cl-push (list var (list 'if (list 'consp temp-seq) (list 'pop temp-seq) (list 'aref temp-seq temp-idx))) loop-for-sets)) (cl-push (list temp-idx (list '1+ temp-idx)) loop-for-steps))) ((memq word hash-types) (or (memq (car args) '(in of)) (error "Expected `of'")) (let* ((table (cl-pop2 args)) (other (if (eq (car args) 'using) (if (and (= (length (cadr args)) 2) (memq (caadr args) hash-types) (not (eq (caadr args) word))) (cadr (cl-pop2 args)) (error "Bad `using' clause")) (gensym)))) (if (memq word '(hash-value hash-values)) (setq var (prog1 other (setq other var)))) (setq loop-map-form (list 'maphash (list 'function (list* 'lambda (list var other) '--cl-map)) table)))) ((memq word '(symbol present-symbol external-symbol symbols present-symbols external-symbols)) (let ((ob (and (memq (car args) '(in of)) (cl-pop2 args)))) (setq loop-map-form (list 'mapatoms (list 'function (list* 'lambda (list var) '--cl-map)) ob)))) ((memq word '(overlay overlays extent extents)) (let ((buf nil) (from nil) (to nil)) (while (memq (car args) '(in of from to)) (cond ((eq (car args) 'from) (setq from (cl-pop2 args))) ((eq (car args) 'to) (setq to (cl-pop2 args))) (t (setq buf (cl-pop2 args))))) (setq loop-map-form (list 'cl-map-extents (list 'function (list 'lambda (list var (gensym)) '(progn . --cl-map) nil)) buf from to)))) ((memq word '(interval intervals)) (let ((buf nil) (prop nil) (from nil) (to nil) (var1 (gensym)) (var2 (gensym))) (while (memq (car args) '(in of property from to)) (cond ((eq (car args) 'from) (setq from (cl-pop2 args))) ((eq (car args) 'to) (setq to (cl-pop2 args))) ((eq (car args) 'property) (setq prop (cl-pop2 args))) (t (setq buf (cl-pop2 args))))) (if (and (consp var) (symbolp (car var)) (symbolp (cdr var))) (setq var1 (car var) var2 (cdr var)) (cl-push (list var (list 'cons var1 var2)) loop-for-sets)) (setq loop-map-form (list 'cl-map-intervals (list 'function (list 'lambda (list var1 var2) '(progn . --cl-map))) buf prop from to)))) ((memq word key-types) (or (memq (car args) '(in of)) (error "Expected `of'")) (let ((map (cl-pop2 args)) (other (if (eq (car args) 'using) (if (and (= (length (cadr args)) 2) (memq (caadr args) key-types) (not (eq (caadr args) word))) (cadr (cl-pop2 args)) (error "Bad `using' clause")) (gensym)))) (if (memq word '(key-binding key-bindings)) (setq var (prog1 other (setq other var)))) (setq loop-map-form (list (if (memq word '(key-seq key-seqs)) 'cl-map-keymap-recursively 'cl-map-keymap) (list 'function (list* 'lambda (list var other) '--cl-map)) map)))) ((memq word '(frame frames screen screens)) (let ((temp (gensym))) (cl-push (list var (if (eq cl-emacs-type 'lucid) '(selected-screen) '(selected-frame))) loop-for-bindings) (cl-push (list temp nil) loop-for-bindings) (cl-push (list 'prog1 (list 'not (list 'eq var temp)) (list 'or temp (list 'setq temp var))) loop-body) (cl-push (list var (list (if (eq cl-emacs-type 'lucid) 'next-screen 'next-frame) var)) loop-for-steps))) ((memq word '(window windows)) (let ((scr (and (memq (car args) '(in of)) (cl-pop2 args))) (temp (gensym))) (cl-push (list var (if scr (list (if (eq cl-emacs-type 'lucid) 'screen-selected-window 'frame-selected-window) scr) '(selected-window))) loop-for-bindings) (cl-push (list temp nil) loop-for-bindings) (cl-push (list 'prog1 (list 'not (list 'eq var temp)) (list 'or temp (list 'setq temp var))) loop-body) (cl-push (list var (list 'next-window var)) loop-for-steps))) (t (let ((handler (and (symbolp word) (get word 'cl-loop-for-handler)))) (if handler (funcall handler var) (error "Expected a `for' preposition, found %s" word))))) (eq (car args) 'and)) (setq ands t) (cl-pop args)) (if (and ands loop-for-bindings) (cl-push (nreverse loop-for-bindings) loop-bindings) (setq loop-bindings (nconc (mapcar 'list loop-for-bindings) loop-bindings))) (if loop-for-sets (cl-push (list 'progn (cl-loop-let (nreverse loop-for-sets) 'setq ands) t) loop-body)) (if loop-for-steps (cl-push (cons (if ands 'psetq 'setq) (apply 'append (nreverse loop-for-steps))) loop-steps)))) ((eq word 'repeat) (let ((temp (gensym))) (cl-push (list (list temp (cl-pop args))) loop-bindings) (cl-push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body))) ((eq word 'collect) (let ((what (cl-pop args)) (var (cl-loop-handle-accum nil 'nreverse))) (if (eq var loop-accum-var) (cl-push (list 'progn (list 'push what var) t) loop-body) (cl-push (list 'progn (list 'setq var (list 'nconc var (list 'list what))) t) loop-body)))) ((memq word '(nconc nconcing append appending)) (let ((what (cl-pop args)) (var (cl-loop-handle-accum nil 'nreverse))) (cl-push (list 'progn (list 'setq var (if (eq var loop-accum-var) (list 'nconc (list (if (memq word '(nconc nconcing)) 'nreverse 'reverse) what) var) (list (if (memq word '(nconc nconcing)) 'nconc 'append) var what))) t) loop-body))) ((memq word '(concat concating)) (let ((what (cl-pop args)) (var (cl-loop-handle-accum ""))) (cl-push (list 'progn (list 'callf 'concat var what) t) loop-body))) ((memq word '(vconcat vconcating)) (let ((what (cl-pop args)) (var (cl-loop-handle-accum []))) (cl-push (list 'progn (list 'callf 'vconcat var what) t) loop-body))) ((memq word '(sum summing)) (let ((what (cl-pop args)) (var (cl-loop-handle-accum 0))) (cl-push (list 'progn (list 'incf var what) t) loop-body))) ((memq word '(count counting)) (let ((what (cl-pop args)) (var (cl-loop-handle-accum 0))) (cl-push (list 'progn (list 'if what (list 'incf var)) t) loop-body))) ((memq word '(minimize minimizing maximize maximizing)) (let* ((what (cl-pop args)) (temp (if (cl-simple-expr-p what) what (gensym))) (var (cl-loop-handle-accum nil)) (func (intern (substring (symbol-name word) 0 3))) (set (list 'setq var (list 'if var (list func var temp) temp)))) (cl-push (list 'progn (if (eq temp what) set (list 'let (list (list temp what)) set)) t) loop-body))) ((eq word 'with) (let ((bindings nil)) (while (progn (cl-push (list (cl-pop args) (and (eq (car args) '=) (cl-pop2 args))) bindings) (eq (car args) 'and)) (cl-pop args)) (cl-push (nreverse bindings) loop-bindings))) ((eq word 'while) (cl-push (cl-pop args) loop-body)) ((eq word 'until) (cl-push (list 'not (cl-pop args)) loop-body)) ((eq word 'always) (or loop-finish-flag (setq loop-finish-flag (gensym))) (cl-push (list 'setq loop-finish-flag (cl-pop args)) loop-body) (setq loop-result t)) ((eq word 'never) (or loop-finish-flag (setq loop-finish-flag (gensym))) (cl-push (list 'setq loop-finish-flag (list 'not (cl-pop args))) loop-body) (setq loop-result t)) ((eq word 'thereis) (or loop-finish-flag (setq loop-finish-flag (gensym))) (or loop-result-var (setq loop-result-var (gensym))) (cl-push (list 'setq loop-finish-flag (list 'not (list 'setq loop-result-var (cl-pop args)))) loop-body)) ((memq word '(if when unless)) (let* ((cond (cl-pop args)) (then (let ((loop-body nil)) (cl-parse-loop-clause) (cl-loop-build-ands (nreverse loop-body)))) (else (let ((loop-body nil)) (if (eq (car args) 'else) (progn (cl-pop args) (cl-parse-loop-clause))) (cl-loop-build-ands (nreverse loop-body)))) (simple (and (eq (car then) t) (eq (car else) t)))) (if (eq (car args) 'end) (cl-pop args)) (if (eq word 'unless) (setq then (prog1 else (setq else then)))) (let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then)) (if simple (nth 1 else) (list (nth 2 else)))))) (if (cl-expr-contains form 'it) (let ((temp (gensym))) (cl-push (list temp) loop-bindings) (setq form (list* 'if (list 'setq temp cond) (subst temp 'it form)))) (setq form (list* 'if cond form))) (cl-push (if simple (list 'progn form t) form) loop-body)))) ((memq word '(do doing)) (let ((body nil)) (or (consp (car args)) (error "Syntax error on `do' clause")) (while (consp (car args)) (cl-push (cl-pop args) body)) (cl-push (cons 'progn (nreverse (cons t body))) loop-body))) ((eq word 'return) (or loop-finish-flag (setq loop-finish-flag (gensym))) (or loop-result-var (setq loop-result-var (gensym))) (cl-push (list 'setq loop-result-var (cl-pop args) loop-finish-flag nil) loop-body)) (t (let ((handler (and (symbolp word) (get word 'cl-loop-handler)))) (or handler (error "Expected a loop keyword, found %s" word)) (funcall handler)))) (if (eq (car args) 'and) (progn (cl-pop args) (cl-parse-loop-clause))))) (defun cl-loop-let (specs body par) ; uses loop-* (let ((p specs) (temps nil) (new nil)) (while (and p (or (symbolp (car-safe (car p))) (null (cadar p)))) (setq p (cdr p))) (and par p (progn (setq par nil p specs) (while p (or (cl-const-expr-p (cadar p)) (let ((temp (gensym))) (cl-push (list temp (cadar p)) temps) (setcar (cdar p) temp))) (setq p (cdr p))))) (while specs (if (and (consp (car specs)) (listp (caar specs))) (let* ((spec (caar specs)) (nspecs nil) (expr (cadr (cl-pop specs))) (temp (cdr (or (assq spec loop-destr-temps) (car (cl-push (cons spec (or (last spec 0) (gensym))) loop-destr-temps)))))) (cl-push (list temp expr) new) (while (consp spec) (cl-push (list (cl-pop spec) (and expr (list (if spec 'pop 'car) temp))) nspecs)) (setq specs (nconc (nreverse nspecs) specs))) (cl-push (cl-pop specs) new))) (if (eq body 'setq) (let ((set (cons (if par 'psetq 'setq) (apply 'nconc (nreverse new))))) (if temps (list 'let* (nreverse temps) set) set)) (list* (if par 'let 'let*) (nconc (nreverse temps) (nreverse new)) body)))) (defun cl-loop-handle-accum (def &optional func) ; uses args, loop-* (if (eq (car args) 'into) (let ((var (cl-pop2 args))) (or (memq var loop-accum-vars) (progn (cl-push (list (list var def)) loop-bindings) (cl-push var loop-accum-vars))) var) (or loop-accum-var (progn (cl-push (list (list (setq loop-accum-var (gensym)) def)) loop-bindings) (setq loop-result (if func (list func loop-accum-var) loop-accum-var)) loop-accum-var)))) (defun cl-loop-build-ands (clauses) (let ((ands nil) (body nil)) (while clauses (if (and (eq (car-safe (car clauses)) 'progn) (eq (car (last (car clauses))) t)) (if (cdr clauses) (setq clauses (cons (nconc (butlast (car clauses)) (if (eq (car-safe (cadr clauses)) 'progn) (cdadr clauses) (list (cadr clauses)))) (cddr clauses))) (setq body (cdr (butlast (cl-pop clauses))))) (cl-push (cl-pop clauses) ands))) (setq ands (or (nreverse ands) (list t))) (list (if (cdr ands) (cons 'and ands) (car ands)) body (let ((full (if body (append ands (list (cons 'progn (append body '(t))))) ands))) (if (cdr full) (cons 'and full) (car full)))))) ;;; Other iteration control structures. (defmacro do (steps endtest &rest body) "The Common Lisp `do' loop. Format is: (do ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (cl-expand-do-loop steps endtest body nil)) (defmacro do* (steps endtest &rest body) "The Common Lisp `do*' loop. Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (cl-expand-do-loop steps endtest body t)) (defun cl-expand-do-loop (steps endtest body star) (list 'block nil (list* (if star 'let* 'let) (mapcar (function (lambda (c) (if (consp c) (list (car c) (nth 1 c)) c))) steps) (list* 'while (list 'not (car endtest)) (append body (let ((sets (mapcar (function (lambda (c) (and (consp c) (cdr (cdr c)) (list (car c) (nth 2 c))))) steps))) (setq sets (delq nil sets)) (and sets (list (cons (if (or star (not (cdr sets))) 'setq 'psetq) (apply 'append sets))))))) (or (cdr endtest) '(nil))))) (defmacro dolist (spec &rest body) "(dolist (VAR LIST [RESULT]) BODY...): loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. Then evaluate RESULT to get return value, default nil." (let ((temp (gensym "--dolist-temp--"))) (list 'block nil (list* 'let (list (list temp (nth 1 spec)) (car spec)) (list* 'while temp (list 'setq (car spec) (list 'car temp)) (append body (list (list 'setq temp (list 'cdr temp))))) (if (cdr (cdr spec)) (cons (list 'setq (car spec) nil) (cdr (cdr spec))) '(nil)))))) (defmacro dotimes (spec &rest body) "(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times. Evaluate BODY with VAR bound to successive integers from 0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get return value, default nil." (let ((temp (gensym "--dotimes-temp--"))) (list 'block nil (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0)) (list* 'while (list '< (car spec) temp) (append body (list (list 'incf (car spec))))) (or (cdr (cdr spec)) '(nil)))))) (defmacro do-symbols (spec &rest body) "(dosymbols (VAR [OBARRAY [RESULT]]) BODY...): loop over all symbols. Evaluate BODY with VAR bound to each interned symbol, or to each symbol from OBARRAY." ;; Apparently this doesn't have an implicit block. (list 'block nil (list 'let (list (car spec)) (list* 'mapatoms (list 'function (list* 'lambda (list (car spec)) body)) (and (cadr spec) (list (cadr spec)))) (caddr spec)))) (defmacro do-all-symbols (spec &rest body) (list* 'do-symbols (list (car spec) nil (cadr spec)) body)) ;;; Assignments. (defmacro psetq (&rest args) "(psetq SYM VAL SYM VAL ...): set SYMs to the values VALs in parallel. This is like `setq', except that all VAL forms are evaluated (in order) before assigning any symbols SYM to the corresponding values." (cons 'psetf args)) ;;; Binding control structures. (defmacro progv (symbols values &rest body) "(progv SYMBOLS VALUES BODY...): bind SYMBOLS to VALUES dynamically in BODY. The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. Each SYMBOL in the first list is bound to the corresponding VALUE in the second list (or made unbound if VALUES is shorter than SYMBOLS); then the BODY forms are executed and their result is returned. This is much like a `let' form, except that the list of symbols can be computed at run-time." (list 'let '((cl-progv-save nil)) (list 'unwind-protect (list* 'progn (list 'cl-progv-before symbols values) body) '(cl-progv-after)))) ;;; This should really have some way to shadow 'byte-compile properties, etc. (defmacro flet (bindings &rest body) "(flet ((FUNC ARGLIST BODY...) ...) FORM...): make temporary function defns. This is an analogue of `let' that operates on the function cell of FUNC rather than its value cell. The FORMs are evaluated with the specified function definitions in place, then the definitions are undone (the FUNCs go back to their previous definitions, or lack thereof)." (list* 'letf* (mapcar (function (lambda (x) (let ((func (list 'function* (list 'lambda (cadr x) (list* 'block (car x) (cddr x)))))) (if (and (cl-compiling-file) (boundp 'byte-compile-function-environment)) (cl-push (cons (car x) (eval func)) byte-compile-function-environment)) (list (list 'symbol-function (list 'quote (car x))) func)))) bindings) body)) (defmacro labels (&rest args) (cons 'flet args)) ;; The following ought to have a better definition for use with newer ;; byte compilers. (defmacro macrolet (bindings &rest body) "(macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns. This is like `flet', but for macros instead of functions." (if (cdr bindings) (list 'macrolet (list (car bindings)) (list* 'macrolet (cdr bindings) body)) (if (null bindings) (cons 'progn body) (let* ((name (caar bindings)) (res (cl-transform-lambda (cdar bindings) name))) (eval (car res)) (cl-macroexpand-all (cons 'progn body) (cons (list* name 'lambda (cdr res)) cl-macro-environment)))))) (defmacro symbol-macrolet (bindings &rest body) "(symbol-macrolet ((NAME EXPANSION) ...) FORM...): make symbol macro defns. Within the body FORMs, references to the variable NAME will be replaced by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)." (if (cdr bindings) (list 'symbol-macrolet (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body)) (if (null bindings) (cons 'progn body) (cl-macroexpand-all (cons 'progn body) (cons (list (symbol-name (caar bindings)) (cadar bindings)) cl-macro-environment))))) (defvar cl-closure-vars nil) (defmacro lexical-let (bindings &rest body) "(lexical-let BINDINGS BODY...): like `let', but lexically scoped. The main visible difference is that lambdas inside BODY will create lexical closures as in Common Lisp." (let* ((cl-closure-vars cl-closure-vars) (vars (mapcar (function (lambda (x) (or (consp x) (setq x (list x))) (cl-push (gensym (format "--%s--" (car x))) cl-closure-vars) (list (car x) (cadr x) (car cl-closure-vars)))) bindings)) (ebody (cl-macroexpand-all (cons 'progn body) (nconc (mapcar (function (lambda (x) (list (symbol-name (car x)) (list 'symbol-value (caddr x)) t))) vars) (list '(defun . cl-defun-expander)) cl-macro-environment)))) (if (not (get (car (last cl-closure-vars)) 'used)) (list 'let (mapcar (function (lambda (x) (list (caddr x) (cadr x)))) vars) (sublis (mapcar (function (lambda (x) (cons (caddr x) (list 'quote (caddr x))))) vars) ebody)) (list 'let (mapcar (function (lambda (x) (list (caddr x) (list 'make-symbol (format "--%s--" (car x)))))) vars) (apply 'append '(setf) (mapcar (function (lambda (x) (list (list 'symbol-value (caddr x)) (cadr x)))) vars)) ebody)))) (defmacro lexical-let* (bindings &rest body) "(lexical-let* BINDINGS BODY...): like `let*', but lexically scoped. The main visible difference is that lambdas inside BODY will create lexical closures as in Common Lisp." (if (null bindings) (cons 'progn body) (setq bindings (reverse bindings)) (while bindings (setq body (list (list* 'lexical-let (list (cl-pop bindings)) body)))) (car body))) (defun cl-defun-expander (func &rest rest) (list 'progn (list 'defalias (list 'quote func) (list 'function (cons 'lambda rest))) (list 'quote func))) ;;; Multiple values. (defmacro multiple-value-bind (vars form &rest body) "(multiple-value-bind (SYM SYM...) FORM BODY): collect multiple return values. FORM must return a list; the BODY is then executed with the first N elements of this list bound (`let'-style) to each of the symbols SYM in turn. This is analogous to the Common Lisp `multiple-value-bind' macro, using lists to simulate true multiple return values. For compatibility, (values A B C) is a synonym for (list A B C)." (let ((temp (gensym)) (n -1)) (list* 'let* (cons (list temp form) (mapcar (function (lambda (v) (list v (list 'nth (setq n (1+ n)) temp)))) vars)) body))) (defmacro multiple-value-setq (vars form) "(multiple-value-setq (SYM SYM...) FORM): collect multiple return values. FORM must return a list; the first N elements of this list are stored in each of the symbols SYM in turn. This is analogous to the Common Lisp `multiple-value-setq' macro, using lists to simulate true multiple return values. For compatibility, (values A B C) is a synonym for (list A B C)." (cond ((null vars) (list 'progn form nil)) ((null (cdr vars)) (list 'setq (car vars) (list 'car form))) (t (let* ((temp (gensym)) (n 0)) (list 'let (list (list temp form)) (list 'prog1 (list 'setq (cl-pop vars) (list 'car temp)) (cons 'setq (apply 'nconc (mapcar (function (lambda (v) (list v (list 'nth (setq n (1+ n)) temp)))) vars))))))))) ;;; Declarations. (defmacro locally (&rest body) (cons 'progn body)) (defmacro the (type form) form) (defvar cl-proclaim-history t) ; for future compilers (defvar cl-declare-stack t) ; for future compilers (defun cl-do-proclaim (spec hist) (and hist (listp cl-proclaim-history) (cl-push spec cl-proclaim-history)) (cond ((eq (car-safe spec) 'special) (if (boundp 'byte-compile-bound-variables) (setq byte-compile-bound-variables (append (cdr spec) byte-compile-bound-variables)))) ((eq (car-safe spec) 'inline) (while (setq spec (cdr spec)) (or (memq (get (car spec) 'byte-optimizer) '(nil byte-compile-inline-expand)) (error "%s already has a byte-optimizer, can't make it inline" (car spec))) (put (car spec) 'byte-optimizer 'byte-compile-inline-expand))) ((eq (car-safe spec) 'notinline) (while (setq spec (cdr spec)) (if (eq (get (car spec) 'byte-optimizer) 'byte-compile-inline-expand) (put (car spec) 'byte-optimizer nil)))) ((eq (car-safe spec) 'optimize) (let ((speed (assq (nth 1 (assq 'speed (cdr spec))) '((0 nil) (1 t) (2 t) (3 t)))) (safety (assq (nth 1 (assq 'safety (cdr spec))) '((0 t) (1 t) (2 t) (3 nil))))) (if speed (setq cl-optimize-speed (car speed) byte-optimize (nth 1 speed))) (if safety (setq cl-optimize-safety (car safety) byte-compile-delete-errors (nth 1 safety))))) ((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings)) (if (eq byte-compile-warnings t) (setq byte-compile-warnings byte-compile-warning-types)) (while (setq spec (cdr spec)) (if (consp (car spec)) (if (eq (cadar spec) 0) (setq byte-compile-warnings (delq (caar spec) byte-compile-warnings)) (setq byte-compile-warnings (adjoin (caar spec) byte-compile-warnings))))))) nil) ;;; Process any proclamations made before cl-macs was loaded. (defvar cl-proclaims-deferred) (let ((p (reverse cl-proclaims-deferred))) (while p (cl-do-proclaim (cl-pop p) t)) (setq cl-proclaims-deferred nil)) (defmacro declare (&rest specs) (if (cl-compiling-file) (while specs (if (listp cl-declare-stack) (cl-push (car specs) cl-declare-stack)) (cl-do-proclaim (cl-pop specs) nil))) nil) ;;; Generalized variables. (defmacro define-setf-method (func args &rest body) "(define-setf-method NAME ARGLIST BODY...): define a `setf' method. This method shows how to handle `setf's to places of the form (NAME ARGS...). The argument forms ARGS are bound according to ARGLIST, as if NAME were going to be expanded as a macro, then the BODY forms are executed and must return a list of five elements: a temporary-variables list, a value-forms list, a store-variables list (of length one), a store-form, and an access- form. See `defsetf' for a simpler way to define most setf-methods." (append '(eval-when (compile load eval)) (if (stringp (car body)) (list (list 'put (list 'quote func) '(quote setf-documentation) (cl-pop body)))) (list (cl-transform-function-property func 'setf-method (cons args body))))) (defmacro defsetf (func arg1 &rest args) "(defsetf NAME FUNC): define a `setf' method. This macro is an easy-to-use substitute for `define-setf-method' that works well for simple place forms. In the simple `defsetf' form, `setf's of the form (setf (NAME ARGS...) VAL) are transformed to function or macro calls of the form (FUNC ARGS... VAL). Example: (defsetf aref aset). Alternate form: (defsetf NAME ARGLIST (STORE) BODY...). Here, the above `setf' call is expanded by binding the argument forms ARGS according to ARGLIST, binding the value form VAL to STORE, then executing BODY, which must return a Lisp form that does the necessary `setf' operation. Actually, ARGLIST and STORE may be bound to temporary variables which are introduced automatically to preserve proper execution order of the arguments. Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))." (if (listp arg1) (let* ((largs nil) (largsr nil) (temps nil) (tempsr nil) (restarg nil) (rest-temps nil) (store-var (car (prog1 (car args) (setq args (cdr args))))) (store-temp (intern (format "--%s--temp--" store-var))) (lets1 nil) (lets2 nil) (docstr nil) (p arg1)) (if (stringp (car args)) (setq docstr (prog1 (car args) (setq args (cdr args))))) (while (and p (not (eq (car p) '&aux))) (if (eq (car p) '&rest) (setq p (cdr p) restarg (car p)) (or (memq (car p) '(&optional &key &allow-other-keys)) (setq largs (cons (if (consp (car p)) (car (car p)) (car p)) largs) temps (cons (intern (format "--%s--temp--" (car largs))) temps)))) (setq p (cdr p))) (setq largs (nreverse largs) temps (nreverse temps)) (if restarg (setq largsr (append largs (list restarg)) rest-temps (intern (format "--%s--temp--" restarg)) tempsr (append temps (list rest-temps))) (setq largsr largs tempsr temps)) (let ((p1 largs) (p2 temps)) (while p1 (setq lets1 (cons (list (car p2) (list 'gensym (format "--%s--" (car p1)))) lets1) lets2 (cons (list (car p1) (car p2)) lets2) p1 (cdr p1) p2 (cdr p2)))) (if restarg (setq lets2 (cons (list restarg rest-temps) lets2))) (append (list 'define-setf-method func arg1) (and docstr (list docstr)) (list (list 'let* (nreverse (cons (list store-temp (list 'gensym (format "--%s--" store-var))) (if restarg (append (list (list rest-temps (list 'mapcar '(quote gensym) restarg))) lets1) lets1))) (list 'list ; 'values (cons (if restarg 'list* 'list) tempsr) (cons (if restarg 'list* 'list) largsr) (list 'list store-temp) (cons 'let* (cons (nreverse (cons (list store-var store-temp) lets2)) args)) (cons (if restarg 'list* 'list) (cons (list 'quote func) tempsr))))))) (list 'defsetf func '(&rest args) '(store) (let ((call (list 'cons (list 'quote arg1) '(append args (list store))))) (if (car args) (list 'list '(quote progn) call 'store) call))))) ;;; Some standard place types from Common Lisp. (defsetf aref aset) (defsetf car setcar) (defsetf cdr setcdr) (defsetf elt (seq n) (store) (list 'if (list 'listp seq) (list 'setcar (list 'nthcdr n seq) store) (list 'aset seq n store))) (defsetf get put) (defsetf get* (x y &optional d) (store) (list 'put x y store)) (defsetf gethash (x h &optional d) (store) (list 'cl-puthash x store h)) (defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store)) (defsetf subseq (seq start &optional end) (new) (list 'progn (list 'replace seq new ':start1 start ':end1 end) new)) (defsetf symbol-function fset) (defsetf symbol-plist setplist) (defsetf symbol-value set) ;;; Various car/cdr aliases. Note that `cadr' is handled specially. (defsetf first setcar) (defsetf second (x) (store) (list 'setcar (list 'cdr x) store)) (defsetf third (x) (store) (list 'setcar (list 'cddr x) store)) (defsetf fourth (x) (store) (list 'setcar (list 'cdddr x) store)) (defsetf fifth (x) (store) (list 'setcar (list 'nthcdr 4 x) store)) (defsetf sixth (x) (store) (list 'setcar (list 'nthcdr 5 x) store)) (defsetf seventh (x) (store) (list 'setcar (list 'nthcdr 6 x) store)) (defsetf eighth (x) (store) (list 'setcar (list 'nthcdr 7 x) store)) (defsetf ninth (x) (store) (list 'setcar (list 'nthcdr 8 x) store)) (defsetf tenth (x) (store) (list 'setcar (list 'nthcdr 9 x) store)) (defsetf rest setcdr) ;;; Some more Emacs-related place types. (defsetf buffer-file-name set-visited-file-name t) (defsetf buffer-modified-p set-buffer-modified-p t) (defsetf buffer-name rename-buffer t) (defsetf buffer-string () (store) (list 'progn '(erase-buffer) (list 'insert store))) (defsetf buffer-substring cl-set-buffer-substring) (defsetf current-buffer set-buffer) (defsetf current-case-table set-case-table) (defsetf current-column move-to-column t) (defsetf current-global-map use-global-map t) (defsetf current-input-mode () (store) (list 'progn (list 'apply 'set-input-mode store) store)) (defsetf current-local-map use-local-map t) (defsetf current-window-configuration set-window-configuration t) (defsetf default-file-modes set-default-file-modes t) (defsetf default-value set-default) (defsetf documentation-property put) (defsetf extent-data set-extent-data) (defsetf extent-face set-extent-face) (defsetf extent-priority set-extent-priority) (defsetf extent-end-position (ext) (store) (list 'progn (list 'set-extent-endpoints (list 'extent-start-position ext) store) store)) (defsetf extent-start-position (ext) (store) (list 'progn (list 'set-extent-endpoints store (list 'extent-end-position ext)) store)) (defsetf face-background (f &optional s) (x) (list 'set-face-background f x s)) (defsetf face-background-pixmap (f &optional s) (x) (list 'set-face-background-pixmap f x s)) (defsetf face-font (f &optional s) (x) (list 'set-face-font f x s)) (defsetf face-foreground (f &optional s) (x) (list 'set-face-foreground f x s)) (defsetf face-underline-p (f &optional s) (x) (list 'set-face-underline-p f x s)) (defsetf file-modes set-file-modes t) (defsetf frame-height set-screen-height t) (defsetf frame-parameters modify-frame-parameters t) (defsetf frame-visible-p cl-set-frame-visible-p) (defsetf frame-width set-screen-width t) (defsetf getenv setenv t) (defsetf get-register set-register) (defsetf global-key-binding global-set-key) (defsetf keymap-parent set-keymap-parent) (defsetf local-key-binding local-set-key) (defsetf mark set-mark t) (defsetf mark-marker set-mark t) (defsetf marker-position set-marker t) (defsetf match-data store-match-data t) (defsetf mouse-position (scr) (store) (list 'set-mouse-position scr (list 'car store) (list 'cadr store) (list 'cddr store))) (defsetf overlay-get overlay-put) (defsetf overlay-start (ov) (store) (list 'progn (list 'move-overlay ov store (list 'overlay-end ov)) store)) (defsetf overlay-end (ov) (store) (list 'progn (list 'move-overlay ov (list 'overlay-start ov) store) store)) (defsetf point goto-char) (defsetf point-marker goto-char t) (defsetf point-max () (store) (list 'progn (list 'narrow-to-region '(point-min) store) store)) (defsetf point-min () (store) (list 'progn (list 'narrow-to-region store '(point-max)) store)) (defsetf process-buffer set-process-buffer) (defsetf process-filter set-process-filter) (defsetf process-sentinel set-process-sentinel) (defsetf read-mouse-position (scr) (store) (list 'set-mouse-position scr (list 'car store) (list 'cdr store))) (defsetf screen-height set-screen-height t) (defsetf screen-width set-screen-width t) (defsetf selected-window select-window) (defsetf selected-screen select-screen) (defsetf selected-frame select-frame) (defsetf standard-case-table set-standard-case-table) (defsetf syntax-table set-syntax-table) (defsetf visited-file-modtime set-visited-file-modtime t) (defsetf window-buffer set-window-buffer t) (defsetf window-display-table set-window-display-table t) (defsetf window-dedicated-p set-window-dedicated-p t) (defsetf window-height () (store) (list 'progn (list 'enlarge-window (list '- store '(window-height))) store)) (defsetf window-hscroll set-window-hscroll) (defsetf window-point set-window-point) (defsetf window-start set-window-start) (defsetf window-width () (store) (list 'progn (list 'enlarge-window (list '- store '(window-width)) t) store)) (defsetf x-get-cutbuffer x-store-cutbuffer t) (defsetf x-get-cut-buffer x-store-cut-buffer t) ; groan. (defsetf x-get-secondary-selection x-own-secondary-selection t) (defsetf x-get-selection x-own-selection t) ;;; More complex setf-methods. ;;; These should take &environment arguments, but since full arglists aren't ;;; available while compiling cl-macs, we fake it by referring to the global ;;; variable cl-macro-environment directly. (define-setf-method apply (func arg1 &rest rest) (or (and (memq (car-safe func) '(quote function function*)) (symbolp (car-safe (cdr-safe func)))) (error "First arg to apply in setf is not (function SYM): %s" func)) (let* ((form (cons (nth 1 func) (cons arg1 rest))) (method (get-setf-method form cl-macro-environment))) (list (car method) (nth 1 method) (nth 2 method) (cl-setf-make-apply (nth 3 method) (cadr func) (car method)) (cl-setf-make-apply (nth 4 method) (cadr func) (car method))))) (defun cl-setf-make-apply (form func temps) (if (eq (car form) 'progn) (list* 'progn (cl-setf-make-apply (cadr form) func temps) (cddr form)) (or (equal (last form) (last temps)) (error "%s is not suitable for use with setf-of-apply" func)) (list* 'apply (list 'quote (car form)) (cdr form)))) (define-setf-method nthcdr (n place) (let ((method (get-setf-method place cl-macro-environment)) (n-temp (gensym "--nthcdr-n--")) (store-temp (gensym "--nthcdr-store--"))) (list (cons n-temp (car method)) (cons n (nth 1 method)) (list store-temp) (list 'let (list (list (car (nth 2 method)) (list 'cl-set-nthcdr n-temp (nth 4 method) store-temp))) (nth 3 method) store-temp) (list 'nthcdr n-temp (nth 4 method))))) (define-setf-method getf (place tag &optional def) (let ((method (get-setf-method place cl-macro-environment)) (tag-temp (gensym "--getf-tag--")) (def-temp (gensym "--getf-def--")) (store-temp (gensym "--getf-store--"))) (list (append (car method) (list tag-temp def-temp)) (append (nth 1 method) (list tag def)) (list store-temp) (list 'let (list (list (car (nth 2 method)) (list 'cl-set-getf (nth 4 method) tag-temp store-temp))) (nth 3 method) store-temp) (list 'getf (nth 4 method) tag-temp def-temp)))) (define-setf-method substring (place from &optional to) (let ((method (get-setf-method place cl-macro-environment)) (from-temp (gensym "--substring-from--")) (to-temp (gensym "--substring-to--")) (store-temp (gensym "--substring-store--"))) (list (append (car method) (list from-temp to-temp)) (append (nth 1 method) (list from to)) (list store-temp) (list 'let (list (list (car (nth 2 method)) (list 'cl-set-substring (nth 4 method) from-temp to-temp store-temp))) (nth 3 method) store-temp) (list 'substring (nth 4 method) from-temp to-temp)))) ;;; Getting and optimizing setf-methods. (defun get-setf-method (place &optional env) "Return a list of five values describing the setf-method for PLACE. PLACE may be any Lisp form which can appear as the PLACE argument to a macro like `setf' or `incf'." (if (symbolp place) (let ((temp (gensym "--setf--"))) (list nil nil (list temp) (list 'setq place temp) place)) (or (and (symbolp (car place)) (let* ((func (car place)) (name (symbol-name func)) (method (get func 'setf-method)) (case-fold-search nil)) (or (and method (let ((cl-macro-environment env)) (setq method (apply method (cdr place)))) (if (and (consp method) (= (length method) 5)) method (error "Setf-method for %s returns malformed method" func))) (and (save-match-data (string-match "\\`c[ad][ad][ad]?[ad]?r\\'" name)) (get-setf-method (compiler-macroexpand place))) (and (eq func 'edebug-after) (get-setf-method (nth (1- (length place)) place) env))))) (if (eq place (setq place (macroexpand place env))) (if (and (symbolp (car place)) (fboundp (car place)) (symbolp (symbol-function (car place)))) (get-setf-method (cons (symbol-function (car place)) (cdr place)) env) (error "No setf-method known for %s" (car place))) (get-setf-method place env))))) (defun cl-setf-do-modify (place opt-expr) (let* ((method (get-setf-method place cl-macro-environment)) (temps (car method)) (values (nth 1 method)) (lets nil) (subs nil) (optimize (and (not (eq opt-expr 'no-opt)) (or (and (not (eq opt-expr 'unsafe)) (cl-safe-expr-p opt-expr)) (cl-setf-simple-store-p (car (nth 2 method)) (nth 3 method))))) (simple (and optimize (consp place) (cl-simple-exprs-p (cdr place))))) (while values (if (or simple (cl-const-expr-p (car values))) (cl-push (cons (cl-pop temps) (cl-pop values)) subs) (cl-push (list (cl-pop temps) (cl-pop values)) lets))) (list (nreverse lets) (cons (car (nth 2 method)) (sublis subs (nth 3 method))) (sublis subs (nth 4 method))))) (defun cl-setf-do-store (spec val) (let ((sym (car spec)) (form (cdr spec))) (if (or (cl-const-expr-p val) (and (cl-simple-expr-p val) (eq (cl-expr-contains form sym) 1)) (cl-setf-simple-store-p sym form)) (subst val sym form) (list 'let (list (list sym val)) form)))) (defun cl-setf-simple-store-p (sym form) (and (consp form) (eq (cl-expr-contains form sym) 1) (eq (nth (1- (length form)) form) sym) (symbolp (car form)) (fboundp (car form)) (not (eq (car-safe (symbol-function (car form))) 'macro)))) ;;; The standard modify macros. (defmacro setf (&rest args) "(setf PLACE VAL PLACE VAL ...): set each PLACE to the value of its VAL. This is a generalized version of `setq'; the PLACEs may be symbolic references such as (car x) or (aref x i), as well as plain symbols. For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y). The return value is the last VAL in the list." (if (cdr (cdr args)) (let ((sets nil)) (while args (cl-push (list 'setf (cl-pop args) (cl-pop args)) sets)) (cons 'progn (nreverse sets))) (if (symbolp (car args)) (and args (cons 'setq args)) (let* ((method (cl-setf-do-modify (car args) (nth 1 args))) (store (cl-setf-do-store (nth 1 method) (nth 1 args)))) (if (car method) (list 'let* (car method) store) store))))) (defmacro psetf (&rest args) "(psetf PLACE VAL PLACE VAL ...): set PLACEs to the values VALs in parallel. This is like `setf', except that all VAL forms are evaluated (in order) before assigning any PLACEs to the corresponding values." (let ((p args) (simple t) (vars nil)) (while p (if (or (not (symbolp (car p))) (cl-expr-depends-p (nth 1 p) vars)) (setq simple nil)) (if (memq (car p) vars) (error "Destination duplicated in psetf: %s" (car p))) (cl-push (cl-pop p) vars) (or p (error "Odd number of arguments to psetf")) (cl-pop p)) (if simple (list 'progn (cons 'setf args) nil) (setq args (reverse args)) (let ((expr (list 'setf (cadr args) (car args)))) (while (setq args (cddr args)) (setq expr (list 'setf (cadr args) (list 'prog1 (car args) expr)))) (list 'progn expr nil))))) (defun cl-do-pop (place) (if (cl-simple-expr-p place) (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place))) (let* ((method (cl-setf-do-modify place t)) (temp (gensym "--pop--"))) (list 'let* (append (car method) (list (list temp (nth 2 method)))) (list 'prog1 (list 'car temp) (cl-setf-do-store (nth 1 method) (list 'cdr temp))))))) (defmacro remf (place tag) "(remf PLACE TAG): remove TAG from property list PLACE. PLACE may be a symbol, or any generalized variable allowed by `setf'. The form returns true if TAG was found and removed, nil otherwise." (let* ((method (cl-setf-do-modify place t)) (tag-temp (and (not (cl-const-expr-p tag)) (gensym "--remf-tag--"))) (val-temp (and (not (cl-simple-expr-p place)) (gensym "--remf-place--"))) (ttag (or tag-temp tag)) (tval (or val-temp (nth 2 method)))) (list 'let* (append (car method) (and val-temp (list (list val-temp (nth 2 method)))) (and tag-temp (list (list tag-temp tag)))) (list 'if (list 'eq ttag (list 'car tval)) (list 'progn (cl-setf-do-store (nth 1 method) (list 'cddr tval)) t) (list 'cl-do-remf tval ttag))))) (defmacro shiftf (place &rest args) "(shiftf PLACE PLACE... VAL): shift left among PLACEs. Example: (shiftf A B C) sets A to B, B to C, and returns the old A. Each PLACE may be a symbol, or any generalized variable allowed by `setf'." (if (not (memq nil (mapcar 'symbolp (butlast (cons place args))))) (list* 'prog1 place (let ((sets nil)) (while args (cl-push (list 'setq place (car args)) sets) (setq place (cl-pop args))) (nreverse sets))) (let* ((places (reverse (cons place args))) (form (cl-pop places))) (while places (let ((method (cl-setf-do-modify (cl-pop places) 'unsafe))) (setq form (list 'let* (car method) (list 'prog1 (nth 2 method) (cl-setf-do-store (nth 1 method) form)))))) form))) (defmacro rotatef (&rest args) "(rotatef PLACE...): rotate left among PLACEs. Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. Each PLACE may be a symbol, or any generalized variable allowed by `setf'." (if (not (memq nil (mapcar 'symbolp args))) (and (cdr args) (let ((sets nil) (first (car args))) (while (cdr args) (setq sets (nconc sets (list (cl-pop args) (car args))))) (nconc (list 'psetf) sets (list (car args) first)))) (let* ((places (reverse args)) (temp (gensym "--rotatef--")) (form temp)) (while (cdr places) (let ((method (cl-setf-do-modify (cl-pop places) 'unsafe))) (setq form (list 'let* (car method) (list 'prog1 (nth 2 method) (cl-setf-do-store (nth 1 method) form)))))) (let ((method (cl-setf-do-modify (car places) 'unsafe))) (list 'let* (append (car method) (list (list temp (nth 2 method)))) (cl-setf-do-store (nth 1 method) form) nil))))) (defmacro letf (bindings &rest body) "(letf ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. This is the analogue of `let', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding VALUE, then the BODY forms are executed. On exit, either normally or because of a `throw' or error, the PLACEs are set back to their original values. Note that this macro is *not* available in Common Lisp. As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', the PLACE is not modified before executing BODY." (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings))) (list* 'let bindings body) (let ((lets nil) (sets nil) (unsets nil) (rev (reverse bindings))) (while rev (let* ((place (if (symbolp (caar rev)) (list 'symbol-value (list 'quote (caar rev))) (caar rev))) (value (cadar rev)) (method (cl-setf-do-modify place 'no-opt)) (save (gensym "--letf-save--")) (bound (and (memq (car place) '(symbol-value symbol-function)) (gensym "--letf-bound--"))) (temp (and (not (cl-const-expr-p value)) (cdr bindings) (gensym "--letf-val--")))) (setq lets (nconc (car method) (if bound (list (list bound (list (if (eq (car place) 'symbol-value) 'boundp 'fboundp) (nth 1 (nth 2 method)))) (list save (list 'and bound (nth 2 method)))) (list (list save (nth 2 method)))) (and temp (list (list temp value))) lets) body (list (list 'unwind-protect (cons 'progn (if (cdr (car rev)) (cons (cl-setf-do-store (nth 1 method) (or temp value)) body) body)) (if bound (list 'if bound (cl-setf-do-store (nth 1 method) save) (list (if (eq (car place) 'symbol-value) 'makunbound 'fmakunbound) (nth 1 (nth 2 method)))) (cl-setf-do-store (nth 1 method) save)))) rev (cdr rev)))) (list* 'let* lets body)))) (defmacro letf* (bindings &rest body) "(letf* ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. This is the analogue of `let*', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding VALUE, then the BODY forms are executed. On exit, either normally or because of a `throw' or error, the PLACEs are set back to their original values. Note that this macro is *not* available in Common Lisp. As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', the PLACE is not modified before executing BODY." (if (null bindings) (cons 'progn body) (setq bindings (reverse bindings)) (while bindings (setq body (list (list* 'letf (list (cl-pop bindings)) body)))) (car body))) (defmacro callf (func place &rest args) "(callf FUNC PLACE ARGS...): set PLACE to (FUNC PLACE ARGS...). FUNC should be an unquoted function name. PLACE may be a symbol, or any generalized variable allowed by `setf'." (let* ((method (cl-setf-do-modify place (cons 'list args))) (rargs (cons (nth 2 method) args))) (list 'let* (car method) (cl-setf-do-store (nth 1 method) (if (symbolp func) (cons func rargs) (list* 'funcall (list 'function func) rargs)))))) (defmacro callf2 (func arg1 place &rest args) "(callf2 FUNC ARG1 PLACE ARGS...): set PLACE to (FUNC ARG1 PLACE ARGS...). Like `callf', but PLACE is the second argument of FUNC, not the first." (if (and (cl-safe-expr-p arg1) (cl-simple-expr-p place) (symbolp func)) (list 'setf place (list* func arg1 place args)) (let* ((method (cl-setf-do-modify place (cons 'list args))) (temp (and (not (cl-const-expr-p arg1)) (gensym "--arg1--"))) (rargs (list* (or temp arg1) (nth 2 method) args))) (list 'let* (append (and temp (list (list temp arg1))) (car method)) (cl-setf-do-store (nth 1 method) (if (symbolp func) (cons func rargs) (list* 'funcall (list 'function func) rargs))))))) (defmacro define-modify-macro (name arglist func &optional doc) "(define-modify-macro NAME ARGLIST FUNC): define a `setf'-like modify macro. If NAME is called, it combines its PLACE argument with the other arguments from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" (if (memq '&key arglist) (error "&key not allowed in define-modify-macro")) (let ((place (gensym "--place--"))) (list 'defmacro* name (cons place arglist) doc (list* (if (memq '&rest arglist) 'list* 'list) '(quote callf) (list 'quote func) place (cl-arglist-args arglist))))) ;;; Structures. (defmacro defstruct (struct &rest descs) "(defstruct (NAME OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type. This macro defines a new Lisp data type called NAME, which contains data stored in SLOTs. This defines a `make-NAME' constructor, a `copy-NAME' copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors." (let* ((name (if (consp struct) (car struct) struct)) (opts (cdr-safe struct)) (slots nil) (defaults nil) (conc-name (concat (symbol-name name) "-")) (constructor (intern (format "make-%s" name))) (constrs nil) (copier (intern (format "copy-%s" name))) (predicate (intern (format "%s-p" name))) (print-func nil) (print-auto nil) (safety (if (cl-compiling-file) cl-optimize-safety 3)) (include nil) (tag (intern (format "cl-struct-%s" name))) (tag-symbol (intern (format "cl-struct-%s-tags" name))) (include-descs nil) (include-tag-symbol nil) (side-eff nil) (type nil) (named nil) (forms nil) pred-form pred-check) (if (stringp (car descs)) (cl-push (list 'put (list 'quote name) '(quote structure-documentation) (cl-pop descs)) forms)) (setq descs (cons '(cl-tag-slot) (mapcar (function (lambda (x) (if (consp x) x (list x)))) descs))) (while opts (let ((opt (if (consp (car opts)) (caar opts) (car opts))) (args (cdr-safe (cl-pop opts)))) (cond ((eq opt ':conc-name) (if args (setq conc-name (if (car args) (symbol-name (car args)) "")))) ((eq opt ':constructor) (if (cdr args) (cl-push args constrs) (if args (setq constructor (car args))))) ((eq opt ':copier) (if args (setq copier (car args)))) ((eq opt ':predicate) (if args (setq predicate (car args)))) ((eq opt ':include) (setq include (car args) include-descs (mapcar (function (lambda (x) (if (consp x) x (list x)))) (cdr args)) include-tag-symbol (intern (format "cl-struct-%s-tags" include)))) ((eq opt ':print-function) (setq print-func (car args))) ((eq opt ':type) (setq type (car args))) ((eq opt ':named) (setq named t)) ((eq opt ':initial-offset) (setq descs (nconc (make-list (car args) '(cl-skip-slot)) descs))) (t (error "Slot option %s unrecognized" opt))))) (if print-func (setq print-func (list 'progn (list 'funcall (list 'function print-func) 'cl-x 'cl-s 'cl-n) t)) (or type (and include (not (get include 'cl-struct-print))) (setq print-auto t print-func (and (or (not (or include type)) (null print-func)) (list 'progn (list 'princ (format "#S(%s" name) 'cl-s)))))) (if include (let ((inc-type (get include 'cl-struct-type)) (old-descs (get include 'cl-struct-slots))) (or inc-type (error "%s is not a struct name" include)) (and type (not (eq (car inc-type) type)) (error ":type disagrees with :include for %s" name)) (while include-descs (setcar (memq (or (assq (caar include-descs) old-descs) (error "No slot %s in included struct %s" (caar include-descs) include)) old-descs) (cl-pop include-descs))) (setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs)) type (car inc-type) named (assq 'cl-tag-slot descs)) (if (cadr inc-type) (setq tag name named t)) (cl-push (list 'pushnew (list 'quote tag) include-tag-symbol) forms)) (if type (progn (or (memq type '(vector list)) (error "Illegal :type specifier: %s" type)) (if named (setq tag name))) (setq type 'vector named 'true))) (or named (setq descs (delq (assq 'cl-tag-slot descs) descs))) (cl-push (list 'defvar tag-symbol) forms) (setq pred-form (and named (let ((pos (- (length descs) (length (memq (assq 'cl-tag-slot descs) descs))))) (if (eq type 'vector) (list 'and '(vectorp cl-x) (list '>= '(length cl-x) (length descs)) (list 'memq (list 'aref 'cl-x pos) tag-symbol)) (if (= pos 0) (list 'memq '(car-safe cl-x) tag-symbol) (list 'and '(consp cl-x) (list 'memq (list 'nth pos 'cl-x) tag-symbol)))))) pred-check (and pred-form (> safety 0) (if (and (eq (caadr pred-form) 'vectorp) (= safety 1)) (cons 'and (cdddr pred-form)) pred-form))) (let ((pos 0) (descp descs)) (while descp (let* ((desc (cl-pop descp)) (slot (car desc))) (if (memq slot '(cl-tag-slot cl-skip-slot)) (progn (cl-push nil slots) (cl-push (and (eq slot 'cl-tag-slot) (list 'quote tag)) defaults)) (if (assq slot descp) (error "Duplicate slots named %s in %s" slot name)) (let ((accessor (intern (format "%s%s" conc-name slot)))) (cl-push slot slots) (cl-push (nth 1 desc) defaults) (cl-push (list* 'defsubst* accessor '(cl-x) (append (and pred-check (list (list 'or pred-check (list 'error (format "%s accessing a non-%s" accessor name) 'cl-x)))) (list (if (eq type 'vector) (list 'aref 'cl-x pos) (if (= pos 0) '(car cl-x) (list 'nth pos 'cl-x)))))) forms) (cl-push (cons accessor t) side-eff) (cl-push (list 'define-setf-method accessor '(cl-x) (if (cadr (memq ':read-only (cddr desc))) (list 'error (format "%s is a read-only slot" accessor)) (list 'cl-struct-setf-expander 'cl-x (list 'quote name) (list 'quote accessor) (and pred-check (list 'quote pred-check)) pos))) forms) (if print-auto (nconc print-func (list (list 'princ (format " %s" slot) 'cl-s) (list 'prin1 (list accessor 'cl-x) 'cl-s))))))) (setq pos (1+ pos)))) (setq slots (nreverse slots) defaults (nreverse defaults)) (and predicate pred-form (progn (cl-push (list 'defsubst* predicate '(cl-x) (if (eq (car pred-form) 'and) (append pred-form '(t)) (list 'and pred-form t))) forms) (cl-push (cons predicate 'error-free) side-eff))) (and copier (progn (cl-push (list 'defun copier '(x) '(copy-sequence x)) forms) (cl-push (cons copier t) side-eff))) (if constructor (cl-push (list constructor (cons '&key (delq nil (copy-sequence slots)))) constrs)) (while constrs (let* ((name (caar constrs)) (args (cadr (cl-pop constrs))) (anames (cl-arglist-args args)) (make (mapcar* (function (lambda (s d) (if (memq s anames) s d))) slots defaults))) (cl-push (list 'defsubst* name (list* '&cl-defs (list 'quote (cons nil descs)) args) (cons type make)) forms) (if (cl-safe-expr-p (cons 'progn (mapcar 'second descs))) (cl-push (cons name t) side-eff)))) (if print-auto (nconc print-func (list '(princ ")" cl-s) t))) (if print-func (cl-push (list 'push (list 'function (list 'lambda '(cl-x cl-s cl-n) (list 'and pred-form print-func))) 'custom-print-functions) forms)) (cl-push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms) (cl-push (list* 'eval-when '(compile load eval) (list 'put (list 'quote name) '(quote cl-struct-slots) (list 'quote descs)) (list 'put (list 'quote name) '(quote cl-struct-type) (list 'quote (list type (eq named t)))) (list 'put (list 'quote name) '(quote cl-struct-print) print-auto) (mapcar (function (lambda (x) (list 'put (list 'quote (car x)) '(quote side-effect-free) (list 'quote (cdr x))))) side-eff)) forms) (cons 'progn (nreverse (cons (list 'quote name) forms))))) (defun cl-struct-setf-expander (x name accessor pred-form pos) (let* ((temp (gensym "--x--")) (store (gensym "--store--"))) (list (list temp) (list x) (list store) (append '(progn) (and pred-form (list (list 'or (subst temp 'cl-x pred-form) (list 'error (format "%s storing a non-%s" accessor name) temp)))) (list (if (eq (car (get name 'cl-struct-type)) 'vector) (list 'aset temp pos store) (list 'setcar (if (<= pos 5) (let ((xx temp)) (while (>= (setq pos (1- pos)) 0) (setq xx (list 'cdr xx))) xx) (list 'nthcdr pos temp)) store)))) (list accessor temp)))) ;;; Types and assertions. (defmacro deftype (name args &rest body) "(deftype NAME ARGLIST BODY...): define NAME as a new data type. The type name can then be used in `typecase', `check-type', etc." (list 'eval-when '(compile load eval) (cl-transform-function-property name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) args) body)))) (defun cl-make-type-test (val type) (if (memq type '(character string-char)) (setq type '(integer 0 255))) (if (symbolp type) (cond ((get type 'cl-deftype-handler) (cl-make-type-test val (funcall (get type 'cl-deftype-handler)))) ((memq type '(nil t)) type) ((eq type 'null) (list 'null val)) ((eq type 'float) (list 'floatp-safe val)) ((eq type 'real) (list 'numberp val)) ((eq type 'fixnum) (list 'integerp val)) (t (let* ((name (symbol-name type)) (namep (intern (concat name "p")))) (if (fboundp namep) (list namep val) (list (intern (concat name "-p")) val))))) (cond ((get (car type) 'cl-deftype-handler) (cl-make-type-test val (apply (get (car type) 'cl-deftype-handler) (cdr type)))) ((memq (car-safe type) '(integer float real number)) (delq t (list 'and (cl-make-type-test val (car type)) (if (memq (cadr type) '(* nil)) t (if (consp (cadr type)) (list '> val (caadr type)) (list '>= val (cadr type)))) (if (memq (caddr type) '(* nil)) t (if (consp (caddr type)) (list '< val (caaddr type)) (list '<= val (caddr type))))))) ((memq (car-safe type) '(and or not)) (cons (car type) (mapcar (function (lambda (x) (cl-make-type-test val x))) (cdr type)))) ((memq (car-safe type) '(member member*)) (list 'and (list 'member* val (list 'quote (cdr type))) t)) ((eq (car-safe type) 'satisfies) (list (cadr type) val)) (t (error "Bad type spec: %s" type))))) (defun typep (val type) ; See compiler macro below. "Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier." (eval (cl-make-type-test 'val type))) (defmacro check-type (form type &optional string) "Verify that FORM is of type TYPE; signal an error if not. STRING is an optional description of the desired type." (and (or (not (cl-compiling-file)) (< cl-optimize-speed 3) (= cl-optimize-safety 3)) (let* ((temp (if (cl-simple-expr-p form 3) form (gensym))) (body (list 'or (cl-make-type-test temp type) (list 'signal '(quote wrong-type-argument) (list 'list (or string (list 'quote type)) temp (list 'quote form)))))) (if (eq temp form) (list 'progn body nil) (list 'let (list (list temp form)) body nil))))) (defmacro assert (form &optional show-args string &rest args) "Verify that FORM returns non-nil; signal an error if not. Second arg SHOW-ARGS means to include arguments of FORM in message. Other args STRING and ARGS... are arguments to be passed to `error'. They are not evaluated unless the assertion fails. If STRING is omitted, a default message listing FORM itself is used." (and (or (not (cl-compiling-file)) (< cl-optimize-speed 3) (= cl-optimize-safety 3)) (let ((sargs (and show-args (delq nil (mapcar (function (lambda (x) (and (not (cl-const-expr-p x)) x))) (cdr form)))))) (list 'progn (list 'or form (if string (list* 'error string (append sargs args)) (list 'signal '(quote cl-assertion-failed) (list* 'list (list 'quote form) sargs)))) nil)))) (defmacro ignore-errors (&rest body) "Execute FORMS; if an error occurs, return nil. Otherwise, return result of last FORM." (let ((err (gensym))) (list 'condition-case err (cons 'progn body) '(error nil)))) ;;; Some predicates for analyzing Lisp forms. These are used by various ;;; macro expanders to optimize the results in certain common cases. (defconst cl-simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max car-safe cdr-safe progn prog1 prog2)) (defconst cl-safe-funcs '(* / % length memq list vector vectorp < > <= >= = error)) ;;; Check if no side effects, and executes quickly. (defun cl-simple-expr-p (x &optional size) (or size (setq size 10)) (if (and (consp x) (not (memq (car x) '(quote function function*)))) (and (symbolp (car x)) (or (memq (car x) cl-simple-funcs) (get (car x) 'side-effect-free)) (progn (setq size (1- size)) (while (and (setq x (cdr x)) (setq size (cl-simple-expr-p (car x) size)))) (and (null x) (>= size 0) size))) (and (> size 0) (1- size)))) (defun cl-simple-exprs-p (xs) (while (and xs (cl-simple-expr-p (car xs))) (setq xs (cdr xs))) (not xs)) ;;; Check if no side effects. (defun cl-safe-expr-p (x) (or (not (and (consp x) (not (memq (car x) '(quote function function*))))) (and (symbolp (car x)) (or (memq (car x) cl-simple-funcs) (memq (car x) cl-safe-funcs) (get (car x) 'side-effect-free)) (progn (while (and (setq x (cdr x)) (cl-safe-expr-p (car x)))) (null x))))) ;;; Check if constant (i.e., no side effects or dependencies). (defun cl-const-expr-p (x) (cond ((consp x) (or (eq (car x) 'quote) (and (memq (car x) '(function function*)) (or (symbolp (nth 1 x)) (and (eq (car-safe (nth 1 x)) 'lambda) 'func))))) ((symbolp x) (and (memq x '(nil t)) t)) (t t))) (defun cl-const-exprs-p (xs) (while (and xs (cl-const-expr-p (car xs))) (setq xs (cdr xs))) (not xs)) (defun cl-const-expr-val (x) (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x))) (defun cl-expr-access-order (x v) (if (cl-const-expr-p x) v (if (consp x) (progn (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v))) v) (if (eq x (car v)) (cdr v) '(t))))) ;;; Count number of times X refers to Y. Return NIL for 0 times. (defun cl-expr-contains (x y) (cond ((equal y x) 1) ((and (consp x) (not (memq (car-safe x) '(quote function function*)))) (let ((sum 0)) (while x (setq sum (+ sum (or (cl-expr-contains (cl-pop x) y) 0)))) (and (> sum 0) sum))) (t nil))) (defun cl-expr-contains-any (x y) (while (and y (not (cl-expr-contains x (car y)))) (cl-pop y)) y) ;;; Check whether X may depend on any of the symbols in Y. (defun cl-expr-depends-p (x y) (and (not (cl-const-expr-p x)) (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y)))) ;;; Compiler macros. (defmacro define-compiler-macro (func args &rest body) "(define-compiler-macro FUNC ARGLIST BODY...): Define a compiler-only macro. This is like `defmacro', but macro expansion occurs only if the call to FUNC is compiled (i.e., not interpreted). Compiler macros should be used for optimizing the way calls to FUNC are compiled; the form returned by BODY should do the same thing as a call to the normal function called FUNC, though possibly more efficiently. Note that, like regular macros, compiler macros are expanded repeatedly until no further expansions are possible. Unlike regular macros, BODY can decide to \"punt\" and leave the original function call alone by declaring an initial `&whole foo' parameter and then returning foo." (let ((p (if (listp args) args (list '&rest args))) (res nil)) (while (consp p) (cl-push (cl-pop p) res)) (setq args (nreverse res)) (setcdr res (and p (list '&rest p)))) (list 'eval-when '(compile load eval) (cl-transform-function-property func 'cl-compiler-macro (cons (if (memq '&whole args) (delq '&whole args) (cons '--cl-whole-arg-- args)) body)) (list 'or (list 'get (list 'quote func) '(quote byte-compile)) (list 'put (list 'quote func) '(quote byte-compile) '(quote cl-byte-compile-compiler-macro))))) (defun compiler-macroexpand (form) (while (let ((func (car-safe form)) (handler nil)) (while (and (symbolp func) (not (setq handler (get func 'cl-compiler-macro))) (fboundp func) (or (not (eq (car-safe (symbol-function func)) 'autoload)) (load (nth 1 (symbol-function func))))) (setq func (symbol-function func))) (and handler (not (eq form (setq form (apply handler form (cdr form)))))))) form) (defun cl-byte-compile-compiler-macro (form) (if (eq form (setq form (compiler-macroexpand form))) (byte-compile-normal-call form) (byte-compile-form form))) (defmacro defsubst* (name args &rest body) "(defsubst* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. Like `defun', except the function is automatically declared `inline', ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...)." (let* ((argns (cl-arglist-args args)) (p argns) (pbody (cons 'progn body)) (unsafe (not (cl-safe-expr-p pbody)))) (while (and p (eq (cl-expr-contains args (car p)) 1)) (cl-pop p)) (list 'progn (if p nil ; give up if defaults refer to earlier args (list 'define-compiler-macro name (list* '&whole 'cl-whole '&cl-quote args) (list* 'cl-defsubst-expand (list 'quote argns) (list 'quote (list* 'block name body)) (not (or unsafe (cl-expr-access-order pbody argns))) (and (memq '&key args) 'cl-whole) unsafe argns))) (list* 'defun* name args body)))) (defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs) (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole (if (cl-simple-exprs-p argvs) (setq simple t)) (let ((lets (delq nil (mapcar* (function (lambda (argn argv) (if (or simple (cl-const-expr-p argv)) (progn (setq body (subst argv argn body)) (and unsafe (list argn argv))) (list argn argv)))) argns argvs)))) (if lets (list 'let lets body) body)))) ;;; Compile-time optimizations for some functions defined in this package. ;;; Note that cl.el arranges to force cl-macs to be loaded at compile-time, ;;; mainly to make sure these macros will be present. (put 'eql 'byte-compile nil) (define-compiler-macro eql (&whole form a b) (cond ((eq (cl-const-expr-p a) t) (let ((val (cl-const-expr-val a))) (if (and (numberp val) (not (integerp val))) (list 'equal a b) (list 'eq a b)))) ((eq (cl-const-expr-p b) t) (let ((val (cl-const-expr-val b))) (if (and (numberp val) (not (integerp val))) (list 'equal a b) (list 'eq a b)))) ((cl-simple-expr-p a 5) (list 'if (list 'numberp a) (list 'equal a b) (list 'eq a b))) ((and (cl-safe-expr-p a) (cl-simple-expr-p b 5)) (list 'if (list 'numberp b) (list 'equal a b) (list 'eq a b))) (t form))) (define-compiler-macro member* (&whole form a list &rest keys) (let ((test (and (= (length keys) 2) (eq (car keys) ':test) (cl-const-expr-val (nth 1 keys))))) (cond ((eq test 'eq) (list 'memq a list)) ((eq test 'equal) (list 'member a list)) ((or (null keys) (eq test 'eql)) (if (eq (cl-const-expr-p a) t) (list (if (floatp-safe (cl-const-expr-val a)) 'member 'memq) a list) (if (eq (cl-const-expr-p list) t) (let ((p (cl-const-expr-val list)) (mb nil) (mq nil)) (if (not (cdr p)) (and p (list 'eql a (list 'quote (car p)))) (while p (if (floatp-safe (car p)) (setq mb t) (or (integerp (car p)) (symbolp (car p)) (setq mq t))) (setq p (cdr p))) (if (not mb) (list 'memq a list) (if (not mq) (list 'member a list) form)))) form))) (t form)))) (define-compiler-macro assoc* (&whole form a list &rest keys) (let ((test (and (= (length keys) 2) (eq (car keys) ':test) (cl-const-expr-val (nth 1 keys))))) (cond ((eq test 'eq) (list 'assq a list)) ((eq test 'equal) (list 'assoc a list)) ((and (eq (cl-const-expr-p a) t) (or (null keys) (eq test 'eql))) (if (floatp-safe (cl-const-expr-val a)) (list 'assoc a list) (list 'assq a list))) (t form)))) (define-compiler-macro adjoin (&whole form a list &rest keys) (if (and (cl-simple-expr-p a) (cl-simple-expr-p list) (not (memq ':key keys))) (list 'if (list* 'member* a list keys) list (list 'cons a list)) form)) (define-compiler-macro list* (arg &rest others) (let* ((args (reverse (cons arg others))) (form (car args))) (while (setq args (cdr args)) (setq form (list 'cons (car args) form))) form)) (define-compiler-macro get* (sym prop &optional def) (if def (list 'getf (list 'symbol-plist sym) prop def) (list 'get sym prop))) (define-compiler-macro typep (&whole form val type) (if (cl-const-expr-p type) (let ((res (cl-make-type-test val (cl-const-expr-val type)))) (if (or (memq (cl-expr-contains res val) '(nil 1)) (cl-simple-expr-p val)) res (let ((temp (gensym))) (list 'let (list (list temp val)) (subst temp val res))))) form)) (mapcar (function (lambda (y) (put (car y) 'side-effect-free t) (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro) (put (car y) 'cl-compiler-macro (list 'lambda '(w x) (if (symbolp (cadr y)) (list 'list (list 'quote (cadr y)) (list 'list (list 'quote (caddr y)) 'x)) (cons 'list (cdr y))))))) '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x) (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x) (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x) (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0) (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr) (caaar car caar) (caadr car cadr) (cadar car cdar) (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr) (cddar cdr cdar) (cdddr cdr cddr) (caaaar car caaar) (caaadr car caadr) (caadar car cadar) (caaddr car caddr) (cadaar car cdaar) (cadadr car cdadr) (caddar car cddar) (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr) (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar) (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr) )) ;;; Things that are inline. (proclaim '(inline floatp-safe acons map concatenate notany notevery cl-set-elt revappend nreconc gethash)) ;;; Things that are side-effect-free. (mapcar (function (lambda (x) (put x 'side-effect-free t))) '(oddp evenp abs expt signum last butlast ldiff pairlis gcd lcm isqrt floor* ceiling* truncate* round* mod* rem* subseq list-length get* getf gethash hash-table-count)) ;;; Things that are side-effect-and-error-free. (mapcar (function (lambda (x) (put x 'side-effect-free 'error-free))) '(eql floatp-safe list* subst acons equalp random-state-p copy-tree sublis hash-table-p)) (run-hooks 'cl-macs-load-hook) ;;; cl-macs.el ends here emacs-19.30/lisp/cl-seq.el100444 12120 1 111334 6045201447 13622 0ustar rmsdaemon;;; cl-seq.el --- Common Lisp extensions for GNU Emacs Lisp (part three) ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Dave Gillespie ;; Version: 2.02 ;; Keywords: extensions ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 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: ;; These are extensions to Emacs Lisp that provide a degree of ;; Common Lisp compatibility, beyond what is already built-in ;; in Emacs Lisp. ;; ;; This package was written by Dave Gillespie; it is a complete ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. ;; ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. ;; ;; Bug reports, comments, and suggestions are welcome! ;; This file contains the Common Lisp sequence and list functions ;; which take keyword arguments. ;; See cl.el for Change Log. ;;; Code: (or (memq 'cl-19 features) (error "Tried to load `cl-seq' before `cl'!")) ;;; We define these here so that this file can compile without having ;;; loaded the cl.el file already. (defmacro cl-push (x place) (list 'setq place (list 'cons x place))) (defmacro cl-pop (place) (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) ;;; Keyword parsing. This is special-cased here so that we can compile ;;; this file independent from cl-macs. (defmacro cl-parsing-keywords (kwords other-keys &rest body) (cons 'let* (cons (mapcar (function (lambda (x) (let* ((var (if (consp x) (car x) x)) (mem (list 'car (list 'cdr (list 'memq (list 'quote var) 'cl-keys))))) (if (eq var ':test-not) (setq mem (list 'and mem (list 'setq 'cl-test mem) t))) (if (eq var ':if-not) (setq mem (list 'and mem (list 'setq 'cl-if mem) t))) (list (intern (format "cl-%s" (substring (symbol-name var) 1))) (if (consp x) (list 'or mem (car (cdr x))) mem))))) kwords) (append (and (not (eq other-keys t)) (list (list 'let '((cl-keys-temp cl-keys)) (list 'while 'cl-keys-temp (list 'or (list 'memq '(car cl-keys-temp) (list 'quote (mapcar (function (lambda (x) (if (consp x) (car x) x))) (append kwords other-keys)))) '(car (cdr (memq (quote :allow-other-keys) cl-keys))) '(error "Bad keyword argument %s" (car cl-keys-temp))) '(setq cl-keys-temp (cdr (cdr cl-keys-temp))))))) body)))) (put 'cl-parsing-keywords 'lisp-indent-function 2) (put 'cl-parsing-keywords 'edebug-form-spec '(sexp sexp &rest form)) (defmacro cl-check-key (x) (list 'if 'cl-key (list 'funcall 'cl-key x) x)) (defmacro cl-check-test-nokey (item x) (list 'cond (list 'cl-test (list 'eq (list 'not (list 'funcall 'cl-test item x)) 'cl-test-not)) (list 'cl-if (list 'eq (list 'not (list 'funcall 'cl-if x)) 'cl-if-not)) (list 't (list 'if (list 'numberp item) (list 'equal item x) (list 'eq item x))))) (defmacro cl-check-test (item x) (list 'cl-check-test-nokey item (list 'cl-check-key x))) (defmacro cl-check-match (x y) (setq x (list 'cl-check-key x) y (list 'cl-check-key y)) (list 'if 'cl-test (list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not) (list 'if (list 'numberp x) (list 'equal x y) (list 'eq x y)))) (put 'cl-check-key 'edebug-form-spec 'edebug-forms) (put 'cl-check-test 'edebug-form-spec 'edebug-forms) (put 'cl-check-test-nokey 'edebug-form-spec 'edebug-forms) (put 'cl-check-match 'edebug-form-spec 'edebug-forms) (defvar cl-test) (defvar cl-test-not) (defvar cl-if) (defvar cl-if-not) (defvar cl-key) (defun reduce (cl-func cl-seq &rest cl-keys) "Reduce two-argument FUNCTION across SEQUENCE. Keywords supported: :start :end :from-end :initial-value :key" (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) () (or (listp cl-seq) (setq cl-seq (append cl-seq nil))) (setq cl-seq (subseq cl-seq cl-start cl-end)) (if cl-from-end (setq cl-seq (nreverse cl-seq))) (let ((cl-accum (cond ((memq ':initial-value cl-keys) cl-initial-value) (cl-seq (cl-check-key (cl-pop cl-seq))) (t (funcall cl-func))))) (if cl-from-end (while cl-seq (setq cl-accum (funcall cl-func (cl-check-key (cl-pop cl-seq)) cl-accum))) (while cl-seq (setq cl-accum (funcall cl-func cl-accum (cl-check-key (cl-pop cl-seq)))))) cl-accum))) (defun fill (seq item &rest cl-keys) "Fill the elements of SEQ with ITEM. Keywords supported: :start :end" (cl-parsing-keywords ((:start 0) :end) () (if (listp seq) (let ((p (nthcdr cl-start seq)) (n (if cl-end (- cl-end cl-start) 8000000))) (while (and p (>= (setq n (1- n)) 0)) (setcar p item) (setq p (cdr p)))) (or cl-end (setq cl-end (length seq))) (if (and (= cl-start 0) (= cl-end (length seq))) (fillarray seq item) (while (< cl-start cl-end) (aset seq cl-start item) (setq cl-start (1+ cl-start))))) seq)) (defun replace (cl-seq1 cl-seq2 &rest cl-keys) "Replace the elements of SEQ1 with the elements of SEQ2. SEQ1 is destructively modified, then returned. Keywords supported: :start1 :end1 :start2 :end2" (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) () (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1)) (or (= cl-start1 cl-start2) (let* ((cl-len (length cl-seq1)) (cl-n (min (- (or cl-end1 cl-len) cl-start1) (- (or cl-end2 cl-len) cl-start2)))) (while (>= (setq cl-n (1- cl-n)) 0) (cl-set-elt cl-seq1 (+ cl-start1 cl-n) (elt cl-seq2 (+ cl-start2 cl-n)))))) (if (listp cl-seq1) (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000))) (if (listp cl-seq2) (let ((cl-p2 (nthcdr cl-start2 cl-seq2)) (cl-n (min cl-n1 (if cl-end2 (- cl-end2 cl-start2) 4000000)))) (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0)) (setcar cl-p1 (car cl-p2)) (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))) (setq cl-end2 (min (or cl-end2 (length cl-seq2)) (+ cl-start2 cl-n1))) (while (and cl-p1 (< cl-start2 cl-end2)) (setcar cl-p1 (aref cl-seq2 cl-start2)) (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2))))) (setq cl-end1 (min (or cl-end1 (length cl-seq1)) (+ cl-start1 (- (or cl-end2 (length cl-seq2)) cl-start2)))) (if (listp cl-seq2) (let ((cl-p2 (nthcdr cl-start2 cl-seq2))) (while (< cl-start1 cl-end1) (aset cl-seq1 cl-start1 (car cl-p2)) (setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1)))) (while (< cl-start1 cl-end1) (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2)) (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1)))))) cl-seq1)) (defun remove* (cl-item cl-seq &rest cl-keys) "Remove all occurrences of ITEM in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :test :test-not :key :count :start :end :from-end" (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end (:start 0) :end) () (if (<= (or cl-count (setq cl-count 8000000)) 0) cl-seq (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000))) (let ((cl-i (cl-position cl-item cl-seq cl-start cl-end cl-from-end))) (if cl-i (let ((cl-res (apply 'delete* cl-item (append cl-seq nil) (append (if cl-from-end (list ':end (1+ cl-i)) (list ':start cl-i)) cl-keys)))) (if (listp cl-seq) cl-res (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))) cl-seq)) (setq cl-end (- (or cl-end 8000000) cl-start)) (if (= cl-start 0) (while (and cl-seq (> cl-end 0) (cl-check-test cl-item (car cl-seq)) (setq cl-end (1- cl-end) cl-seq (cdr cl-seq)) (> (setq cl-count (1- cl-count)) 0)))) (if (and (> cl-count 0) (> cl-end 0)) (let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq) (setq cl-end (1- cl-end)) (cdr cl-seq)))) (while (and cl-p (> cl-end 0) (not (cl-check-test cl-item (car cl-p)))) (setq cl-p (cdr cl-p) cl-end (1- cl-end))) (if (and cl-p (> cl-end 0)) (nconc (ldiff cl-seq cl-p) (if (= cl-count 1) (cdr cl-p) (and (cdr cl-p) (apply 'delete* cl-item (copy-sequence (cdr cl-p)) ':start 0 ':end (1- cl-end) ':count (1- cl-count) cl-keys)))) cl-seq)) cl-seq))))) (defun remove-if (cl-pred cl-list &rest cl-keys) "Remove all items satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :key :count :start :end :from-end" (apply 'remove* nil cl-list ':if cl-pred cl-keys)) (defun remove-if-not (cl-pred cl-list &rest cl-keys) "Remove all items not satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :key :count :start :end :from-end" (apply 'remove* nil cl-list ':if-not cl-pred cl-keys)) (defun delete* (cl-item cl-seq &rest cl-keys) "Remove all occurrences of ITEM in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :test :test-not :key :count :start :end :from-end" (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end (:start 0) :end) () (if (<= (or cl-count (setq cl-count 8000000)) 0) cl-seq (if (listp cl-seq) (if (and cl-from-end (< cl-count 4000000)) (let (cl-i) (while (and (>= (setq cl-count (1- cl-count)) 0) (setq cl-i (cl-position cl-item cl-seq cl-start cl-end cl-from-end))) (if (= cl-i 0) (setq cl-seq (cdr cl-seq)) (let ((cl-tail (nthcdr (1- cl-i) cl-seq))) (setcdr cl-tail (cdr (cdr cl-tail))))) (setq cl-end cl-i)) cl-seq) (setq cl-end (- (or cl-end 8000000) cl-start)) (if (= cl-start 0) (progn (while (and cl-seq (> cl-end 0) (cl-check-test cl-item (car cl-seq)) (setq cl-end (1- cl-end) cl-seq (cdr cl-seq)) (> (setq cl-count (1- cl-count)) 0))) (setq cl-end (1- cl-end))) (setq cl-start (1- cl-start))) (if (and (> cl-count 0) (> cl-end 0)) (let ((cl-p (nthcdr cl-start cl-seq))) (while (and (cdr cl-p) (> cl-end 0)) (if (cl-check-test cl-item (car (cdr cl-p))) (progn (setcdr cl-p (cdr (cdr cl-p))) (if (= (setq cl-count (1- cl-count)) 0) (setq cl-end 1))) (setq cl-p (cdr cl-p))) (setq cl-end (1- cl-end))))) cl-seq) (apply 'remove* cl-item cl-seq cl-keys))))) (defun delete-if (cl-pred cl-list &rest cl-keys) "Remove all items satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :key :count :start :end :from-end" (apply 'delete* nil cl-list ':if cl-pred cl-keys)) (defun delete-if-not (cl-pred cl-list &rest cl-keys) "Remove all items not satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :key :count :start :end :from-end" (apply 'delete* nil cl-list ':if-not cl-pred cl-keys)) (or (and (fboundp 'delete) (subrp (symbol-function 'delete))) (defalias 'delete (function (lambda (x y) (delete* x y ':test 'equal))))) (defun remove (x y) (remove* x y ':test 'equal)) (defun remq (x y) (if (memq x y) (delq x (copy-list y)) y)) (defun remove-duplicates (cl-seq &rest cl-keys) "Return a copy of SEQ with all duplicate elements removed. Keywords supported: :test :test-not :key :start :end :from-end" (cl-delete-duplicates cl-seq cl-keys t)) (defun delete-duplicates (cl-seq &rest cl-keys) "Remove all duplicate elements from SEQ (destructively). Keywords supported: :test :test-not :key :start :end :from-end" (cl-delete-duplicates cl-seq cl-keys nil)) (defun cl-delete-duplicates (cl-seq cl-keys cl-copy) (if (listp cl-seq) (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if) () (if cl-from-end (let ((cl-p (nthcdr cl-start cl-seq)) cl-i) (setq cl-end (- (or cl-end (length cl-seq)) cl-start)) (while (> cl-end 1) (setq cl-i 0) (while (setq cl-i (cl-position (cl-check-key (car cl-p)) (cdr cl-p) cl-i (1- cl-end))) (if cl-copy (setq cl-seq (copy-sequence cl-seq) cl-p (nthcdr cl-start cl-seq) cl-copy nil)) (let ((cl-tail (nthcdr cl-i cl-p))) (setcdr cl-tail (cdr (cdr cl-tail)))) (setq cl-end (1- cl-end))) (setq cl-p (cdr cl-p) cl-end (1- cl-end) cl-start (1+ cl-start))) cl-seq) (setq cl-end (- (or cl-end (length cl-seq)) cl-start)) (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1) (cl-position (cl-check-key (car cl-seq)) (cdr cl-seq) 0 (1- cl-end))) (setq cl-seq (cdr cl-seq) cl-end (1- cl-end))) (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq) (setq cl-end (1- cl-end) cl-start 1) cl-seq))) (while (and (cdr (cdr cl-p)) (> cl-end 1)) (if (cl-position (cl-check-key (car (cdr cl-p))) (cdr (cdr cl-p)) 0 (1- cl-end)) (progn (if cl-copy (setq cl-seq (copy-sequence cl-seq) cl-p (nthcdr (1- cl-start) cl-seq) cl-copy nil)) (setcdr cl-p (cdr (cdr cl-p)))) (setq cl-p (cdr cl-p))) (setq cl-end (1- cl-end) cl-start (1+ cl-start))) cl-seq))) (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil))) (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))) (defun substitute (cl-new cl-old cl-seq &rest cl-keys) "Substitute NEW for OLD in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :test :test-not :key :count :start :end :from-end" (cl-parsing-keywords (:test :test-not :key :if :if-not :count (:start 0) :end :from-end) () (if (or (eq cl-old cl-new) (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0)) cl-seq (let ((cl-i (cl-position cl-old cl-seq cl-start cl-end))) (if (not cl-i) cl-seq (setq cl-seq (copy-sequence cl-seq)) (or cl-from-end (progn (cl-set-elt cl-seq cl-i cl-new) (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) (apply 'nsubstitute cl-new cl-old cl-seq ':count cl-count ':start cl-i cl-keys)))))) (defun substitute-if (cl-new cl-pred cl-list &rest cl-keys) "Substitute NEW for all items satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :key :count :start :end :from-end" (apply 'substitute cl-new nil cl-list ':if cl-pred cl-keys)) (defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys) "Substitute NEW for all items not satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :key :count :start :end :from-end" (apply 'substitute cl-new nil cl-list ':if-not cl-pred cl-keys)) (defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys) "Substitute NEW for OLD in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :test :test-not :key :count :start :end :from-end" (cl-parsing-keywords (:test :test-not :key :if :if-not :count (:start 0) :end :from-end) () (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0) (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000))) (let ((cl-p (nthcdr cl-start cl-seq))) (setq cl-end (- (or cl-end 8000000) cl-start)) (while (and cl-p (> cl-end 0) (> cl-count 0)) (if (cl-check-test cl-old (car cl-p)) (progn (setcar cl-p cl-new) (setq cl-count (1- cl-count)))) (setq cl-p (cdr cl-p) cl-end (1- cl-end)))) (or cl-end (setq cl-end (length cl-seq))) (if cl-from-end (while (and (< cl-start cl-end) (> cl-count 0)) (setq cl-end (1- cl-end)) (if (cl-check-test cl-old (elt cl-seq cl-end)) (progn (cl-set-elt cl-seq cl-end cl-new) (setq cl-count (1- cl-count))))) (while (and (< cl-start cl-end) (> cl-count 0)) (if (cl-check-test cl-old (aref cl-seq cl-start)) (progn (aset cl-seq cl-start cl-new) (setq cl-count (1- cl-count)))) (setq cl-start (1+ cl-start)))))) cl-seq)) (defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys) "Substitute NEW for all items satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :key :count :start :end :from-end" (apply 'nsubstitute cl-new nil cl-list ':if cl-pred cl-keys)) (defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys) "Substitute NEW for all items not satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :key :count :start :end :from-end" (apply 'nsubstitute cl-new nil cl-list ':if-not cl-pred cl-keys)) (defun find (cl-item cl-seq &rest cl-keys) "Find the first occurrence of ITEM in LIST. Return the matching ITEM, or nil if not found. Keywords supported: :test :test-not :key :start :end :from-end" (let ((cl-pos (apply 'position cl-item cl-seq cl-keys))) (and cl-pos (elt cl-seq cl-pos)))) (defun find-if (cl-pred cl-list &rest cl-keys) "Find the first item satisfying PREDICATE in LIST. Return the matching ITEM, or nil if not found. Keywords supported: :key :start :end :from-end" (apply 'find nil cl-list ':if cl-pred cl-keys)) (defun find-if-not (cl-pred cl-list &rest cl-keys) "Find the first item not satisfying PREDICATE in LIST. Return the matching ITEM, or nil if not found. Keywords supported: :key :start :end :from-end" (apply 'find nil cl-list ':if-not cl-pred cl-keys)) (defun position (cl-item cl-seq &rest cl-keys) "Find the first occurrence of ITEM in LIST. Return the index of the matching item, or nil if not found. Keywords supported: :test :test-not :key :start :end :from-end" (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end :from-end) () (cl-position cl-item cl-seq cl-start cl-end cl-from-end))) (defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end) (if (listp cl-seq) (let ((cl-p (nthcdr cl-start cl-seq))) (or cl-end (setq cl-end 8000000)) (let ((cl-res nil)) (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end)) (if (cl-check-test cl-item (car cl-p)) (setq cl-res cl-start)) (setq cl-p (cdr cl-p) cl-start (1+ cl-start))) cl-res)) (or cl-end (setq cl-end (length cl-seq))) (if cl-from-end (progn (while (and (>= (setq cl-end (1- cl-end)) cl-start) (not (cl-check-test cl-item (aref cl-seq cl-end))))) (and (>= cl-end cl-start) cl-end)) (while (and (< cl-start cl-end) (not (cl-check-test cl-item (aref cl-seq cl-start)))) (setq cl-start (1+ cl-start))) (and (< cl-start cl-end) cl-start)))) (defun position-if (cl-pred cl-list &rest cl-keys) "Find the first item satisfying PREDICATE in LIST. Return the index of the matching item, or nil if not found. Keywords supported: :key :start :end :from-end" (apply 'position nil cl-list ':if cl-pred cl-keys)) (defun position-if-not (cl-pred cl-list &rest cl-keys) "Find the first item not satisfying PREDICATE in LIST. Return the index of the matching item, or nil if not found. Keywords supported: :key :start :end :from-end" (apply 'position nil cl-list ':if-not cl-pred cl-keys)) (defun count (cl-item cl-seq &rest cl-keys) "Count the number of occurrences of ITEM in LIST. Keywords supported: :test :test-not :key :start :end" (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) () (let ((cl-count 0) cl-x) (or cl-end (setq cl-end (length cl-seq))) (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) (while (< cl-start cl-end) (setq cl-x (if (consp cl-seq) (cl-pop cl-seq) (aref cl-seq cl-start))) (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count))) (setq cl-start (1+ cl-start))) cl-count))) (defun count-if (cl-pred cl-list &rest cl-keys) "Count the number of items satisfying PREDICATE in LIST. Keywords supported: :key :start :end" (apply 'count nil cl-list ':if cl-pred cl-keys)) (defun count-if-not (cl-pred cl-list &rest cl-keys) "Count the number of items not satisfying PREDICATE in LIST. Keywords supported: :key :start :end" (apply 'count nil cl-list ':if-not cl-pred cl-keys)) (defun mismatch (cl-seq1 cl-seq2 &rest cl-keys) "Compare SEQ1 with SEQ2, return index of first mismatching element. Return nil if the sequences match. If one sequence is a prefix of the other, the return value indicates the end of the shorted sequence. Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" (cl-parsing-keywords (:test :test-not :key :from-end (:start1 0) :end1 (:start2 0) :end2) () (or cl-end1 (setq cl-end1 (length cl-seq1))) (or cl-end2 (setq cl-end2 (length cl-seq2))) (if cl-from-end (progn (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) (cl-check-match (elt cl-seq1 (1- cl-end1)) (elt cl-seq2 (1- cl-end2)))) (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2))) (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) (1- cl-end1))) (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1))) (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2)))) (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) (cl-check-match (if cl-p1 (car cl-p1) (aref cl-seq1 cl-start1)) (if cl-p2 (car cl-p2) (aref cl-seq2 cl-start2)))) (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2))) (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) cl-start1))))) (defun search (cl-seq1 cl-seq2 &rest cl-keys) "Search for SEQ1 as a subsequence of SEQ2. Return the index of the leftmost element of the first match found; return nil if there are no matches. Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" (cl-parsing-keywords (:test :test-not :key :from-end (:start1 0) :end1 (:start2 0) :end2) () (or cl-end1 (setq cl-end1 (length cl-seq1))) (or cl-end2 (setq cl-end2 (length cl-seq2))) (if (>= cl-start1 cl-end1) (if cl-from-end cl-end2 cl-start2) (let* ((cl-len (- cl-end1 cl-start1)) (cl-first (cl-check-key (elt cl-seq1 cl-start1))) (cl-if nil) cl-pos) (setq cl-end2 (- cl-end2 (1- cl-len))) (while (and (< cl-start2 cl-end2) (setq cl-pos (cl-position cl-first cl-seq2 cl-start2 cl-end2 cl-from-end)) (apply 'mismatch cl-seq1 cl-seq2 ':start1 (1+ cl-start1) ':end1 cl-end1 ':start2 (1+ cl-pos) ':end2 (+ cl-pos cl-len) ':from-end nil cl-keys)) (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos)))) (and (< cl-start2 cl-end2) cl-pos))))) (defun sort* (cl-seq cl-pred &rest cl-keys) "Sort the argument SEQUENCE according to PREDICATE. This is a destructive function; it reuses the storage of SEQUENCE if possible. Keywords supported: :key" (if (nlistp cl-seq) (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys)) (cl-parsing-keywords (:key) () (if (memq cl-key '(nil identity)) (sort cl-seq cl-pred) (sort cl-seq (function (lambda (cl-x cl-y) (funcall cl-pred (funcall cl-key cl-x) (funcall cl-key cl-y))))))))) (defun stable-sort (cl-seq cl-pred &rest cl-keys) "Sort the argument SEQUENCE stably according to PREDICATE. This is a destructive function; it reuses the storage of SEQUENCE if possible. Keywords supported: :key" (apply 'sort* cl-seq cl-pred cl-keys)) (defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys) "Destructively merge the two sequences to produce a new sequence. TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument sequences, and PRED is a `less-than' predicate on the elements. Keywords supported: :key" (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil))) (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil))) (cl-parsing-keywords (:key) () (let ((cl-res nil)) (while (and cl-seq1 cl-seq2) (if (funcall cl-pred (cl-check-key (car cl-seq2)) (cl-check-key (car cl-seq1))) (cl-push (cl-pop cl-seq2) cl-res) (cl-push (cl-pop cl-seq1) cl-res))) (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type)))) ;;; See compiler macro in cl-macs.el (defun member* (cl-item cl-list &rest cl-keys) "Find the first occurrence of ITEM in LIST. Return the sublist of LIST whose car is ITEM. Keywords supported: :test :test-not :key" (if cl-keys (cl-parsing-keywords (:test :test-not :key :if :if-not) () (while (and cl-list (not (cl-check-test cl-item (car cl-list)))) (setq cl-list (cdr cl-list))) cl-list) (if (and (numberp cl-item) (not (integerp cl-item))) (member cl-item cl-list) (memq cl-item cl-list)))) (defun member-if (cl-pred cl-list &rest cl-keys) "Find the first item satisfying PREDICATE in LIST. Return the sublist of LIST whose car matches. Keywords supported: :key" (apply 'member* nil cl-list ':if cl-pred cl-keys)) (defun member-if-not (cl-pred cl-list &rest cl-keys) "Find the first item not satisfying PREDICATE in LIST. Return the sublist of LIST whose car matches. Keywords supported: :key" (apply 'member* nil cl-list ':if-not cl-pred cl-keys)) (defun cl-adjoin (cl-item cl-list &rest cl-keys) (if (cl-parsing-keywords (:key) t (apply 'member* (cl-check-key cl-item) cl-list cl-keys)) cl-list (cons cl-item cl-list))) ;;; See compiler macro in cl-macs.el (defun assoc* (cl-item cl-alist &rest cl-keys) "Find the first item whose car matches ITEM in LIST. Keywords supported: :test :test-not :key" (if cl-keys (cl-parsing-keywords (:test :test-not :key :if :if-not) () (while (and cl-alist (or (not (consp (car cl-alist))) (not (cl-check-test cl-item (car (car cl-alist)))))) (setq cl-alist (cdr cl-alist))) (and cl-alist (car cl-alist))) (if (and (numberp cl-item) (not (integerp cl-item))) (assoc cl-item cl-alist) (assq cl-item cl-alist)))) (defun assoc-if (cl-pred cl-list &rest cl-keys) "Find the first item whose car satisfies PREDICATE in LIST. Keywords supported: :key" (apply 'assoc* nil cl-list ':if cl-pred cl-keys)) (defun assoc-if-not (cl-pred cl-list &rest cl-keys) "Find the first item whose car does not satisfy PREDICATE in LIST. Keywords supported: :key" (apply 'assoc* nil cl-list ':if-not cl-pred cl-keys)) (defun rassoc* (cl-item cl-alist &rest cl-keys) "Find the first item whose cdr matches ITEM in LIST. Keywords supported: :test :test-not :key" (if (or cl-keys (numberp cl-item)) (cl-parsing-keywords (:test :test-not :key :if :if-not) () (while (and cl-alist (or (not (consp (car cl-alist))) (not (cl-check-test cl-item (cdr (car cl-alist)))))) (setq cl-alist (cdr cl-alist))) (and cl-alist (car cl-alist))) (rassq cl-item cl-alist))) (defun rassoc-if (cl-pred cl-list &rest cl-keys) "Find the first item whose cdr satisfies PREDICATE in LIST. Keywords supported: :key" (apply 'rassoc* nil cl-list ':if cl-pred cl-keys)) (defun rassoc-if-not (cl-pred cl-list &rest cl-keys) "Find the first item whose cdr does not satisfy PREDICATE in LIST. Keywords supported: :key" (apply 'rassoc* nil cl-list ':if-not cl-pred cl-keys)) (defun union (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-union operation. The result list contains all items that appear in either LIST1 or LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. Keywords supported: :test :test-not :key" (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) ((equal cl-list1 cl-list2) cl-list1) (t (or (>= (length cl-list1) (length cl-list2)) (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) (while cl-list2 (if (or cl-keys (numberp (car cl-list2))) (setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys)) (or (memq (car cl-list2) cl-list1) (cl-push (car cl-list2) cl-list1))) (cl-pop cl-list2)) cl-list1))) (defun nunion (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-union operation. The result list contains all items that appear in either LIST1 or LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. Keywords supported: :test :test-not :key" (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) (t (apply 'union cl-list1 cl-list2 cl-keys)))) (defun intersection (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-intersection operation. The result list contains all items that appear in both LIST1 and LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. Keywords supported: :test :test-not :key" (and cl-list1 cl-list2 (if (equal cl-list1 cl-list2) cl-list1 (cl-parsing-keywords (:key) (:test :test-not) (let ((cl-res nil)) (or (>= (length cl-list1) (length cl-list2)) (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) (while cl-list2 (if (if (or cl-keys (numberp (car cl-list2))) (apply 'member* (cl-check-key (car cl-list2)) cl-list1 cl-keys) (memq (car cl-list2) cl-list1)) (cl-push (car cl-list2) cl-res)) (cl-pop cl-list2)) cl-res))))) (defun nintersection (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-intersection operation. The result list contains all items that appear in both LIST1 and LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. Keywords supported: :test :test-not :key" (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys))) (defun set-difference (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-difference operation. The result list contains all items that appear in LIST1 but not LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. Keywords supported: :test :test-not :key" (if (or (null cl-list1) (null cl-list2)) cl-list1 (cl-parsing-keywords (:key) (:test :test-not) (let ((cl-res nil)) (while cl-list1 (or (if (or cl-keys (numberp (car cl-list1))) (apply 'member* (cl-check-key (car cl-list1)) cl-list2 cl-keys) (memq (car cl-list1) cl-list2)) (cl-push (car cl-list1) cl-res)) (cl-pop cl-list1)) cl-res)))) (defun nset-difference (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-difference operation. The result list contains all items that appear in LIST1 but not LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. Keywords supported: :test :test-not :key" (if (or (null cl-list1) (null cl-list2)) cl-list1 (apply 'set-difference cl-list1 cl-list2 cl-keys))) (defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-exclusive-or operation. The result list contains all items that appear in exactly one of LIST1, LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. Keywords supported: :test :test-not :key" (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) ((equal cl-list1 cl-list2) nil) (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys) (apply 'set-difference cl-list2 cl-list1 cl-keys))))) (defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-exclusive-or operation. The result list contains all items that appear in exactly one of LIST1, LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. Keywords supported: :test :test-not :key" (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) ((equal cl-list1 cl-list2) nil) (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys) (apply 'nset-difference cl-list2 cl-list1 cl-keys))))) (defun subsetp (cl-list1 cl-list2 &rest cl-keys) "True if LIST1 is a subset of LIST2. I.e., if every element of LIST1 also appears in LIST2. Keywords supported: :test :test-not :key" (cond ((null cl-list1) t) ((null cl-list2) nil) ((equal cl-list1 cl-list2) t) (t (cl-parsing-keywords (:key) (:test :test-not) (while (and cl-list1 (apply 'member* (cl-check-key (car cl-list1)) cl-list2 cl-keys)) (cl-pop cl-list1)) (null cl-list1))))) (defun subst-if (cl-new cl-pred cl-tree &rest cl-keys) "Substitute NEW for elements matching PREDICATE in TREE (non-destructively). Return a copy of TREE with all matching elements replaced by NEW. Keywords supported: :key" (apply 'sublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys)) (defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys) "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). Return a copy of TREE with all non-matching elements replaced by NEW. Keywords supported: :key" (apply 'sublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys)) (defun nsubst (cl-new cl-old cl-tree &rest cl-keys) "Substitute NEW for OLD everywhere in TREE (destructively). Any element of TREE which is `eql' to OLD is changed to NEW (via a call to `setcar'). Keywords supported: :test :test-not :key" (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys)) (defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys) "Substitute NEW for elements matching PREDICATE in TREE (destructively). Any element of TREE which matches is changed to NEW (via a call to `setcar'). Keywords supported: :key" (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys)) (defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys) "Substitute NEW for elements not matching PREDICATE in TREE (destructively). Any element of TREE which matches is changed to NEW (via a call to `setcar'). Keywords supported: :key" (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys)) (defun sublis (cl-alist cl-tree &rest cl-keys) "Perform substitutions indicated by ALIST in TREE (non-destructively). Return a copy of TREE with all matching elements replaced. Keywords supported: :test :test-not :key" (cl-parsing-keywords (:test :test-not :key :if :if-not) () (cl-sublis-rec cl-tree))) (defvar cl-alist) (defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if* (let ((cl-temp (cl-check-key cl-tree)) (cl-p cl-alist)) (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) (setq cl-p (cdr cl-p))) (if cl-p (cdr (car cl-p)) (if (consp cl-tree) (let ((cl-a (cl-sublis-rec (car cl-tree))) (cl-d (cl-sublis-rec (cdr cl-tree)))) (if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree))) cl-tree (cons cl-a cl-d))) cl-tree)))) (defun nsublis (cl-alist cl-tree &rest cl-keys) "Perform substitutions indicated by ALIST in TREE (destructively). Any matching element of TREE is changed via a call to `setcar'. Keywords supported: :test :test-not :key" (cl-parsing-keywords (:test :test-not :key :if :if-not) () (let ((cl-hold (list cl-tree))) (cl-nsublis-rec cl-hold) (car cl-hold)))) (defun cl-nsublis-rec (cl-tree) ; uses cl-alist/temp/p/key/test*/if* (while (consp cl-tree) (let ((cl-temp (cl-check-key (car cl-tree))) (cl-p cl-alist)) (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) (setq cl-p (cdr cl-p))) (if cl-p (setcar cl-tree (cdr (car cl-p))) (if (consp (car cl-tree)) (cl-nsublis-rec (car cl-tree)))) (setq cl-temp (cl-check-key (cdr cl-tree)) cl-p cl-alist) (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) (setq cl-p (cdr cl-p))) (if cl-p (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil)) (setq cl-tree (cdr cl-tree)))))) (defun tree-equal (cl-x cl-y &rest cl-keys) "T if trees X and Y have `eql' leaves. Atoms are compared by `eql'; cons cells are compared recursively. Keywords supported: :test :test-not :key" (cl-parsing-keywords (:test :test-not :key) () (cl-tree-equal-rec cl-x cl-y))) (defun cl-tree-equal-rec (cl-x cl-y) (while (and (consp cl-x) (consp cl-y) (cl-tree-equal-rec (car cl-x) (car cl-y))) (setq cl-x (cdr cl-x) cl-y (cdr cl-y))) (and (not (consp cl-x)) (not (consp cl-y)) (cl-check-match cl-x cl-y))) (run-hooks 'cl-seq-load-hook) ;;; cl-seq.el ends here emacs-19.30/lisp/cl-specs.el100444 12120 1 33575 6045201255 14136 0ustar rmsdaemon;;; cl-specs.el --- Edebug specs for cl.el ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Daniel LaLiberte ;; Keywords: lisp, tools, maint ;; LCD Archive Entry: ;; cl-specs.el|Daniel LaLiberte|liberte@cs.uiuc.edu ;; |Edebug specs for cl.el ;; |$Date: 1995/10/30 16:51:55 $|1.1| ;; 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: ;; These specs are to be used with edebug.el version 3.3 or later and ;; cl.el version 2.03 or later, by Dave Gillespie . ;; This file need not be byte-compiled, but it shouldnt hurt. (provide 'cl-specs) ;; Do the above provide before the following require. ;; Otherwise if you load this before edebug if cl is already loaded ;; an infinite loading loop would occur. (require 'edebug) ;; Blocks (def-edebug-spec block (symbolp body)) (def-edebug-spec return (&optional form)) (def-edebug-spec return-from (symbolp &optional form)) ;; Loops (def-edebug-spec when t) (def-edebug-spec unless t) (def-edebug-spec case (form &rest (sexp body))) (def-edebug-spec ecase case) (def-edebug-spec do ((&rest &or symbolp (symbolp &optional form form)) (form body) cl-declarations body)) (def-edebug-spec do* do) (def-edebug-spec dolist ((symbolp form &optional form) cl-declarations body)) (def-edebug-spec dotimes dolist) (def-edebug-spec do-symbols ((symbolp &optional form form) cl-declarations body)) (def-edebug-spec do-all-symbols ((symbolp &optional form) cl-declarations body)) ;; Multiple values (def-edebug-spec multiple-value-list (form)) (def-edebug-spec multiple-value-call (function-form body)) (def-edebug-spec multiple-value-bind ((&rest symbolp) form cl-declarations body)) (def-edebug-spec multiple-value-setq ((&rest symbolp) form)) (def-edebug-spec multiple-value-prog1 (form body)) ;; Bindings (def-edebug-spec lexical-let let) (def-edebug-spec lexical-let* let) (def-edebug-spec psetq setq) (def-edebug-spec progv (form form body)) (def-edebug-spec flet ((&rest (defun*)) cl-declarations body)) (def-edebug-spec labels flet) (def-edebug-spec macrolet ((&rest (&define name (&rest arg) cl-declarations-or-string def-body)) cl-declarations body)) (def-edebug-spec symbol-macrolet ((&rest (symbol sexp)) cl-declarations body)) (def-edebug-spec destructuring-bind (&define cl-macro-list form cl-declarations def-body)) ;; Setf (def-edebug-spec setf (&rest [place form])) ;; sexp is not specific enough (def-edebug-spec psetf setf) (def-edebug-spec letf ;; *not* available in Common Lisp ((&rest (gate place &optional form)) body)) (def-edebug-spec letf* letf) (def-edebug-spec defsetf (&define name [&or [symbolp &optional stringp] [cl-lambda-list (symbolp)]] cl-declarations-or-string def-body)) (def-edebug-spec define-setf-method (&define name cl-lambda-list cl-declarations-or-string def-body)) (def-edebug-spec define-modify-macro (&define name cl-lambda-list ;; should exclude &key symbolp &optional stringp)) (def-edebug-spec callf (function* place &rest form)) (def-edebug-spec callf2 (function* form place &rest form)) ;; Other operations on places (def-edebug-spec remf (place form)) (def-edebug-spec incf (place &optional form)) (def-edebug-spec decf incf) (def-edebug-spec push (form place)) (def-edebug-spec pushnew (form place &rest &or [[&or ":test" ":test-not" ":key"] function-form] [edebug-keywordp form])) (def-edebug-spec pop (place)) (def-edebug-spec shiftf (&rest place)) ;; really [&rest place] form (def-edebug-spec rotatef (&rest place)) ;; Functions with function args. These are only useful if the ;; function arg is quoted with ' instead of function. (def-edebug-spec some (function-form form &rest form)) (def-edebug-spec every some) (def-edebug-spec notany some) (def-edebug-spec notevery some) ;; Mapping (def-edebug-spec map (form function-form form &rest form)) (def-edebug-spec maplist (function-form form &rest form)) (def-edebug-spec mapc maplist) (def-edebug-spec mapl maplist) (def-edebug-spec mapcan maplist) (def-edebug-spec mapcon maplist) ;; Sequences (def-edebug-spec reduce (function-form form &rest form)) ;; Types and assertions (def-edebug-spec cl-type-spec (sexp)) ;; not worth the trouble to specify, yet. (def-edebug-spec deftype defmacro*) (def-edebug-spec check-type (place cl-type-spec &optional stringp)) ;; (def-edebug-spec assert (form &optional form stringp &rest form)) (def-edebug-spec assert (form &rest form)) (def-edebug-spec typecase (form &rest ([&or cl-type-spec "otherwise"] body))) (def-edebug-spec etypecase typecase) (def-edebug-spec ignore-errors t) ;; Time of Evaluation (def-edebug-spec eval-when ((&rest &or "compile" "load" "eval") body)) (def-edebug-spec load-time-value (form &optional &or "t" "nil")) ;; Declarations (def-edebug-spec cl-decl-spec ((symbolp &rest sexp))) (def-edebug-spec cl-declarations (&rest ("declare" &rest cl-decl-spec))) (def-edebug-spec cl-declarations-or-string (&or stringp cl-declarations)) (def-edebug-spec declaim (&rest cl-decl-spec)) (def-edebug-spec declare (&rest cl-decl-spec)) ;; probably not needed. (def-edebug-spec locally (cl-declarations &rest form)) (def-edebug-spec the (cl-type-spec form)) ;;====================================================== ;; Lambda things (def-edebug-spec cl-lambda-list (([&rest arg] [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]] [&optional ["&rest" arg]] [&optional ["&key" [cl-&key-arg &rest cl-&key-arg] &optional "&allow-other-keywords"]] [&optional ["&aux" &rest &or (symbolp &optional def-form) symbolp]] ))) (def-edebug-spec cl-&optional-arg (&or (arg &optional def-form arg) arg)) (def-edebug-spec cl-&key-arg (&or ([&or (symbolp arg) arg] &optional def-form arg) arg)) ;; The lambda list for macros is different from that of normal lambdas. ;; Note that &environment is only allowed as first or last items in the ;; top level list. (def-edebug-spec cl-macro-list (([&optional "&environment" arg] [&rest cl-macro-arg] [&optional ["&optional" &rest &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] [&optional [[&or "&rest" "&body"] cl-macro-arg]] [&optional ["&key" [&rest [&or ([&or (symbolp cl-macro-arg) arg] &optional def-form cl-macro-arg) arg]] &optional "&allow-other-keywords"]] [&optional ["&aux" &rest &or (symbolp &optional def-form) symbolp]] [&optional "&environment" arg] ))) (def-edebug-spec cl-macro-arg (&or arg cl-macro-list1)) (def-edebug-spec cl-macro-list1 (([&optional "&whole" arg] ;; only allowed at lower levels [&rest cl-macro-arg] [&optional ["&optional" &rest &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] [&optional [[&or "&rest" "&body"] cl-macro-arg]] [&optional ["&key" [&rest [&or ([&or (symbolp cl-macro-arg) arg] &optional def-form cl-macro-arg) arg]] &optional "&allow-other-keywords"]] [&optional ["&aux" &rest &or (symbolp &optional def-form) symbolp]] . [&or arg nil]))) (def-edebug-spec defun* ;; Same as defun but use cl-lambda-list. (&define [&or name ("setf" :name setf name)] cl-lambda-list cl-declarations-or-string [&optional ("interactive" interactive)] def-body)) (def-edebug-spec defsubst* defun*) (def-edebug-spec defmacro* (&define name cl-macro-list cl-declarations-or-string def-body)) (def-edebug-spec define-compiler-macro defmacro*) (def-edebug-spec function* (&or symbolp cl-lambda-expr)) (def-edebug-spec cl-lambda-expr (&define ("lambda" cl-lambda-list ;;cl-declarations-or-string ;;[&optional ("interactive" interactive)] def-body))) ;; Redefine function-form to also match function* (def-edebug-spec function-form ;; form at the end could also handle "function", ;; but recognize it specially to avoid wrapping function forms. (&or ([&or "quote" "function"] &or symbolp lambda-expr) ("function*" cl-lambda-expr) form)) ;;====================================================== ;; Structures ;; (def-edebug-spec defstruct (&rest sexp)) would be sufficient, but... ;; defstruct may contain forms that are evaluated when a structure is created. (def-edebug-spec defstruct (&define ; makes top-level form not be wrapped [&or symbolp (gate symbolp &rest (&or [":conc-name" &or stringp "nil"] [":constructor" symbolp &optional cl-lambda-list] [":copier" symbolp] [":predicate" symbolp] [":include" symbolp &rest sexp];; not finished ;; The following are not supported. ;; [":print-function" ...] ;; [":type" ...] ;; [":initial-offset" ...] ))] [&optional stringp] ;; All the above is for the following def-form. &rest &or symbolp (symbolp def-form &optional ":read-only" sexp))) ;;====================================================== ;; Loop ;; The loop macro is very complex, and a full spec is found below. ;; The following spec only minimally specifies that ;; parenthesized forms are executable, but single variables used as ;; expressions will be missed. You may want to use this if the full ;; spec causes problems for you. (def-edebug-spec loop (&rest &or symbolp form)) ;; Below is a complete spec for loop, in several parts that correspond ;; to the syntax given in CLtL2. The specs do more than specify where ;; the forms are; it also specifies, as much as Edebug allows, all the ;; syntactically legal loop clauses. The disadvantage of this ;; completeness is rigidity, but the "for ... being" clause allows ;; arbitrary extensions of the form: [symbolp &rest &or symbolp form]. (def-edebug-spec loop ([&optional ["named" symbolp]] [&rest &or ["repeat" form] loop-for-as loop-with loop-initial-final] [&rest loop-clause] )) (def-edebug-spec loop-with ("with" loop-var loop-type-spec [&optional ["=" form]] &rest ["and" loop-var loop-type-spec [&optional ["=" form]]])) (def-edebug-spec loop-for-as ([&or "for" "as"] loop-for-as-subclause &rest ["and" loop-for-as-subclause])) (def-edebug-spec loop-for-as-subclause (loop-var loop-type-spec &or [[&or "in" "on" "in-ref" "across-ref"] form &optional ["by" function-form]] ["=" form &optional ["then" form]] ["across" form] ["being" [&or "the" "each"] &or [[&or "element" "elements"] [&or "of" "in" "of-ref"] form &optional "using" ["index" symbolp]];; is this right? [[&or "hash-key" "hash-keys" "hash-value" "hash-values"] [&or "of" "in"] hash-table-p &optional ["using" ([&or "hash-value" "hash-values" "hash-key" "hash-keys"] sexp)]] [[&or "symbol" "present-symbol" "external-symbol" "symbols" "present-symbols" "external-symbols"] [&or "in" "of"] package-p] ;; Extensions for Emacs Lisp, including Lucid Emacs. [[&or "frame" "frames" "screen" "screens" "buffer" "buffers"]] [[&or "window" "windows"] [&or "of" "in"] form] [[&or "overlay" "overlays" "extent" "extents"] [&or "of" "in"] form &optional [[&or "from" "to"] form]] [[&or "interval" "intervals"] [&or "in" "of"] form &optional [[&or "from" "to"] form] ["property" form]] [[&or "key-code" "key-codes" "key-seq" "key-seqs" "key-binding" "key-bindings"] [&or "in" "of"] form &optional ["using" ([&or "key-code" "key-codes" "key-seq" "key-seqs" "key-binding" "key-bindings"] sexp)]] ;; For arbitrary extensions, recognize anything else. [symbolp &rest &or symbolp form] ] ;; arithmetic - must be last since all parts are optional. [[&optional [[&or "from" "downfrom" "upfrom"] form]] [&optional [[&or "to" "downto" "upto" "below" "above"] form]] [&optional ["by" form]] ])) (def-edebug-spec loop-initial-final (&or ["initially" ;; [&optional &or "do" "doing"] ;; CLtL2 doesnt allow this. &rest loop-non-atomic-expr] ["finally" &or [[&optional &or "do" "doing"] &rest loop-non-atomic-expr] ["return" form]])) (def-edebug-spec loop-and-clause (loop-clause &rest ["and" loop-clause])) (def-edebug-spec loop-clause (&or [[&or "while" "until" "always" "never" "thereis"] form] [[&or "collect" "collecting" "append" "appending" "nconc" "nconcing" "concat" "vconcat"] form [&optional ["into" loop-var]]] [[&or "count" "counting" "sum" "summing" "maximize" "maximizing" "minimize" "minimizing"] form [&optional ["into" loop-var]] loop-type-spec] [[&or "if" "when" "unless"] form loop-and-clause [&optional ["else" loop-and-clause]] [&optional "end"]] [[&or "do" "doing"] &rest loop-non-atomic-expr] ["return" form] loop-initial-final )) (def-edebug-spec loop-non-atomic-expr ([¬ atom] form)) (def-edebug-spec loop-var ;; The symbolp must be last alternative to recognize e.g. (a b . c) ;; loop-var => ;; (loop-var . [&or nil loop-var]) ;; (symbolp . [&or nil loop-var]) ;; (symbolp . loop-var) ;; (symbolp . (symbolp . [&or nil loop-var])) ;; (symbolp . (symbolp . loop-var)) ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp) (&or (loop-var . [&or nil loop-var]) [gate symbolp])) (def-edebug-spec loop-type-spec (&optional ["of-type" loop-d-type-spec])) (def-edebug-spec loop-d-type-spec (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec)) emacs-19.30/lisp/cl.el100444 12120 1 63126 6045201477 13024 0ustar rmsdaemon;;; cl.el --- Common Lisp extensions for GNU Emacs Lisp ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Dave Gillespie ;; Version: 2.02 ;; Keywords: extensions ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 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: ;; These are extensions to Emacs Lisp that provide a degree of ;; Common Lisp compatibility, beyond what is already built-in ;; in Emacs Lisp. ;; ;; This package was written by Dave Gillespie; it is a complete ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. ;; ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. ;; ;; Bug reports, comments, and suggestions are welcome! ;; This file contains the portions of the Common Lisp extensions ;; package which should always be present. ;;; Future notes: ;; Once Emacs 19 becomes standard, many things in this package which are ;; messy for reasons of compatibility can be greatly simplified. For now, ;; I prefer to maintain one unified version. ;;; Change Log: ;; Version 2.02 (30 Jul 93): ;; * Added "cl-compat.el" file, extra compatibility with old package. ;; * Added `lexical-let' and `lexical-let*'. ;; * Added `define-modify-macro', `callf', and `callf2'. ;; * Added `ignore-errors'. ;; * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero. ;; * Merged `*gentemp-counter*' into `*gensym-counter*'. ;; * Extended `subseq' to allow negative START and END like `substring'. ;; * Added `in-ref', `across-ref', `elements of-ref' loop clauses. ;; * Added `concat', `vconcat' loop clauses. ;; * Cleaned up a number of compiler warnings. ;; Version 2.01 (7 Jul 93): ;; * Added support for FSF version of Emacs 19. ;; * Added `add-hook' for Emacs 18 users. ;; * Added `defsubst*' and `symbol-macrolet'. ;; * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'. ;; * Added `map', `concatenate', `reduce', `merge'. ;; * Added `revappend', `nreconc', `tailp', `tree-equal'. ;; * Added `assert', `check-type', `typecase', `typep', and `deftype'. ;; * Added destructuring and `&environment' support to `defmacro*'. ;; * Added destructuring to `loop', and added the following clauses: ;; `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'. ;; * Renamed `delete' to `delete*' and `remove' to `remove*'. ;; * Completed support for all keywords in `remove*', `substitute', etc. ;; * Added `most-positive-float' and company. ;; * Fixed hash tables to work with latest Lucid Emacs. ;; * `proclaim' forms are no longer compile-time-evaluating; use `declaim'. ;; * Syntax for `warn' declarations has changed. ;; * Improved implementation of `random*'. ;; * Moved most sequence functions to a new file, cl-seq.el. ;; * Moved `eval-when' into cl-macs.el. ;; * Moved `pushnew' and `adjoin' to cl.el for most common cases. ;; * Moved `provide' forms down to ends of files. ;; * Changed expansion of `pop' to something that compiles to better code. ;; * Changed so that no patch is required for Emacs 19 byte compiler. ;; * Made more things dependent on `optimize' declarations. ;; * Added a partial implementation of struct print functions. ;; * Miscellaneous minor changes. ;; Version 2.00: ;; * First public release of this package. ;;; Code: (defvar cl-emacs-type (cond ((or (and (fboundp 'epoch::version) (symbol-value 'epoch::version)) (string-lessp emacs-version "19")) 18) ((string-match "Lucid" emacs-version) 'lucid) (t 19))) (or (fboundp 'defalias) (fset 'defalias 'fset)) (defvar cl-optimize-speed 1) (defvar cl-optimize-safety 1) ;;; Keywords used in this package. (defconst :test ':test) (defconst :test-not ':test-not) (defconst :key ':key) (defconst :start ':start) (defconst :start1 ':start1) (defconst :start2 ':start2) (defconst :end ':end) (defconst :end1 ':end1) (defconst :end2 ':end2) (defconst :count ':count) (defconst :initial-value ':initial-value) (defconst :size ':size) (defconst :from-end ':from-end) (defconst :rehash-size ':rehash-size) (defconst :rehash-threshold ':rehash-threshold) (defconst :allow-other-keys ':allow-other-keys) (defvar custom-print-functions nil "This is a list of functions that format user objects for printing. Each function is called in turn with three arguments: the object, the stream, and the print level (currently ignored). If it is able to print the object it returns true; otherwise it returns nil and the printer proceeds to the next function on the list. This variable is not used at present, but it is defined in hopes that a future Emacs interpreter will be able to use it.") ;;; Predicates. (defun eql (a b) ; See compiler macro in cl-macs.el "T if the two args are the same Lisp object. Floating-point numbers of equal value are `eql', but they may not be `eq'." (if (numberp a) (equal a b) (eq a b))) ;;; Generalized variables. These macros are defined here so that they ;;; can safely be used in .emacs files. (defmacro incf (place &optional x) "(incf PLACE [X]): increment PLACE by X (1 by default). PLACE may be a symbol, or any generalized variable allowed by `setf'. The return value is the incremented value of PLACE." (if (symbolp place) (list 'setq place (if x (list '+ place x) (list '1+ place))) (list 'callf '+ place (or x 1)))) (defmacro decf (place &optional x) "(decf PLACE [X]): decrement PLACE by X (1 by default). PLACE may be a symbol, or any generalized variable allowed by `setf'. The return value is the decremented value of PLACE." (if (symbolp place) (list 'setq place (if x (list '- place x) (list '1- place))) (list 'callf '- place (or x 1)))) (defmacro pop (place) "(pop PLACE): remove and return the head of the list stored in PLACE. Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more careful about evaluating each argument only once and in the right order. PLACE may be a symbol, or any generalized variable allowed by `setf'." (if (symbolp place) (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))) (cl-do-pop place))) (defmacro push (x place) "(push X PLACE): insert X at the head of the list stored in PLACE. Analogous to (setf PLACE (cons X PLACE)), though more careful about evaluating each argument only once and in the right order. PLACE may be a symbol, or any generalized variable allowed by `setf'." (if (symbolp place) (list 'setq place (list 'cons x place)) (list 'callf2 'cons x place))) (defmacro pushnew (x place &rest keys) "(pushnew X PLACE): insert X at the head of the list if not already there. Like (push X PLACE), except that the list is unmodified if X is `eql' to an element already on the list. Keywords supported: :test :test-not :key" (if (symbolp place) (list 'setq place (list* 'adjoin x place keys)) (list* 'callf2 'adjoin x place keys))) (defun cl-set-elt (seq n val) (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) (defun cl-set-nthcdr (n list x) (if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list)) (defun cl-set-buffer-substring (start end val) (save-excursion (delete-region start end) (goto-char start) (insert val) val)) (defun cl-set-substring (str start end val) (if end (if (< end 0) (incf end (length str))) (setq end (length str))) (if (< start 0) (incf start str)) (concat (and (> start 0) (substring str 0 start)) val (and (< end (length str)) (substring str end)))) ;;; Control structures. ;;; These macros are so simple and so often-used that it's better to have ;;; them all the time than to load them from cl-macs.el. (defmacro when (cond &rest body) "(when COND BODY...): if COND yields non-nil, do BODY, else return nil." (list 'if cond (cons 'progn body))) (defmacro unless (cond &rest body) "(unless COND BODY...): if COND yields nil, do BODY, else return nil." (cons 'if (cons cond (cons nil body)))) (defun cl-map-extents (&rest cl-args) (if (fboundp 'next-overlay-at) (apply 'cl-map-overlays cl-args) (if (fboundp 'map-extents) (apply 'map-extents cl-args)))) ;;; Blocks and exits. (defalias 'cl-block-wrapper 'identity) (defalias 'cl-block-throw 'throw) ;;; Multiple values. True multiple values are not supported, or even ;;; simulated. Instead, multiple-value-bind and friends simply expect ;;; the target form to return the values as a list. (defalias 'values 'list) (defalias 'values-list 'identity) (defalias 'multiple-value-list 'identity) (defalias 'multiple-value-call 'apply) ; only works for one arg (defalias 'nth-value 'nth) ;;; Macros. (defvar cl-macro-environment nil) (defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand) (defalias 'macroexpand 'cl-macroexpand))) (defun cl-macroexpand (cl-macro &optional cl-env) "Return result of expanding macros at top level of FORM. If FORM is not a macro call, it is returned unchanged. Otherwise, the macro is expanded and the expansion is considered in place of FORM. When a non-macro-call results, it is returned. The second optional arg ENVIRONMENT species an environment of macro definitions to shadow the loaded ones for use in file byte-compilation." (let ((cl-macro-environment cl-env)) (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env)) (and (symbolp cl-macro) (cdr (assq (symbol-name cl-macro) cl-env)))) (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env)))) cl-macro)) ;;; Declarations. (defvar cl-compiling-file nil) (defun cl-compiling-file () (or cl-compiling-file (and (boundp 'outbuffer) (bufferp (symbol-value 'outbuffer)) (equal (buffer-name (symbol-value 'outbuffer)) " *Compiler Output*")))) (defvar cl-proclaims-deferred nil) (defun proclaim (spec) (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t) (push spec cl-proclaims-deferred)) nil) (defmacro declaim (&rest specs) (let ((body (mapcar (function (lambda (x) (list 'proclaim (list 'quote x)))) specs))) (if (cl-compiling-file) (list* 'eval-when '(compile load eval) body) (cons 'progn body)))) ; avoid loading cl-macs.el for eval-when ;;; Symbols. (defun cl-random-time () (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i)))) v)) (defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100)) ;;; Numbers. (defun floatp-safe (x) "T if OBJECT is a floating point number. On Emacs versions that lack floating-point support, this function always returns nil." (and (numberp x) (not (integerp x)))) (defun plusp (x) "T if NUMBER is positive." (> x 0)) (defun minusp (x) "T if NUMBER is negative." (< x 0)) (defun oddp (x) "T if INTEGER is odd." (eq (logand x 1) 1)) (defun evenp (x) "T if INTEGER is even." (eq (logand x 1) 0)) (defun cl-abs (x) "Return the absolute value of ARG." (if (>= x 0) x (- x))) (or (fboundp 'abs) (defalias 'abs 'cl-abs)) ; This is built-in to Emacs 19 (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time))) ;;; We use `eval' in case VALBITS differs from compile-time to load-time. (defconst most-positive-fixnum (eval '(lsh -1 -1))) (defconst most-negative-fixnum (eval '(- -1 (lsh -1 -1)))) ;;; The following are actually set by cl-float-limits. (defconst most-positive-float nil) (defconst most-negative-float nil) (defconst least-positive-float nil) (defconst least-negative-float nil) (defconst least-positive-normalized-float nil) (defconst least-negative-normalized-float nil) (defconst float-epsilon nil) (defconst float-negative-epsilon nil) ;;; Sequence functions. (defalias 'copy-seq 'copy-sequence) (defun mapcar* (cl-func cl-x &rest cl-rest) "Apply FUNCTION to each element of SEQ, and make a list of the results. If there are several SEQs, FUNCTION is called with that many arguments, and mapping stops as soon as the shortest list runs out. With just one SEQ, this is like `mapcar'. With several, it is like the Common Lisp `mapcar' function extended to arbitrary sequence types." (if cl-rest (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest))) (cl-mapcar-many cl-func (cons cl-x cl-rest)) (let ((cl-res nil) (cl-y (car cl-rest))) (while (and cl-x cl-y) (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res)) (nreverse cl-res))) (mapcar cl-func cl-x))) ;;; List functions. (defalias 'first 'car) (defalias 'rest 'cdr) (defalias 'endp 'null) (defun second (x) "Return the second element of the list LIST." (car (cdr x))) (defun third (x) "Return the third element of the list LIST." (car (cdr (cdr x)))) (defun fourth (x) "Return the fourth element of the list LIST." (nth 3 x)) (defun fifth (x) "Return the fifth element of the list LIST." (nth 4 x)) (defun sixth (x) "Return the sixth element of the list LIST." (nth 5 x)) (defun seventh (x) "Return the seventh element of the list LIST." (nth 6 x)) (defun eighth (x) "Return the eighth element of the list LIST." (nth 7 x)) (defun ninth (x) "Return the ninth element of the list LIST." (nth 8 x)) (defun tenth (x) "Return the tenth element of the list LIST." (nth 9 x)) (defun caar (x) "Return the `car' of the `car' of X." (car (car x))) (defun cadr (x) "Return the `car' of the `cdr' of X." (car (cdr x))) (defun cdar (x) "Return the `cdr' of the `car' of X." (cdr (car x))) (defun cddr (x) "Return the `cdr' of the `cdr' of X." (cdr (cdr x))) (defun caaar (x) "Return the `car' of the `car' of the `car' of X." (car (car (car x)))) (defun caadr (x) "Return the `car' of the `car' of the `cdr' of X." (car (car (cdr x)))) (defun cadar (x) "Return the `car' of the `cdr' of the `car' of X." (car (cdr (car x)))) (defun caddr (x) "Return the `car' of the `cdr' of the `cdr' of X." (car (cdr (cdr x)))) (defun cdaar (x) "Return the `cdr' of the `car' of the `car' of X." (cdr (car (car x)))) (defun cdadr (x) "Return the `cdr' of the `car' of the `cdr' of X." (cdr (car (cdr x)))) (defun cddar (x) "Return the `cdr' of the `cdr' of the `car' of X." (cdr (cdr (car x)))) (defun cdddr (x) "Return the `cdr' of the `cdr' of the `cdr' of X." (cdr (cdr (cdr x)))) (defun caaaar (x) "Return the `car' of the `car' of the `car' of the `car' of X." (car (car (car (car x))))) (defun caaadr (x) "Return the `car' of the `car' of the `car' of the `cdr' of X." (car (car (car (cdr x))))) (defun caadar (x) "Return the `car' of the `car' of the `cdr' of the `car' of X." (car (car (cdr (car x))))) (defun caaddr (x) "Return the `car' of the `car' of the `cdr' of the `cdr' of X." (car (car (cdr (cdr x))))) (defun cadaar (x) "Return the `car' of the `cdr' of the `car' of the `car' of X." (car (cdr (car (car x))))) (defun cadadr (x) "Return the `car' of the `cdr' of the `car' of the `cdr' of X." (car (cdr (car (cdr x))))) (defun caddar (x) "Return the `car' of the `cdr' of the `cdr' of the `car' of X." (car (cdr (cdr (car x))))) (defun cadddr (x) "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." (car (cdr (cdr (cdr x))))) (defun cdaaar (x) "Return the `cdr' of the `car' of the `car' of the `car' of X." (cdr (car (car (car x))))) (defun cdaadr (x) "Return the `cdr' of the `car' of the `car' of the `cdr' of X." (cdr (car (car (cdr x))))) (defun cdadar (x) "Return the `cdr' of the `car' of the `cdr' of the `car' of X." (cdr (car (cdr (car x))))) (defun cdaddr (x) "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." (cdr (car (cdr (cdr x))))) (defun cddaar (x) "Return the `cdr' of the `cdr' of the `car' of the `car' of X." (cdr (cdr (car (car x))))) (defun cddadr (x) "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." (cdr (cdr (car (cdr x))))) (defun cdddar (x) "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." (cdr (cdr (cdr (car x))))) (defun cddddr (x) "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." (cdr (cdr (cdr (cdr x))))) (defun last (x &optional n) "Returns the last link in the list LIST. With optional argument N, returns Nth-to-last link (default 1)." (if n (let ((m 0) (p x)) (while (consp p) (incf m) (pop p)) (if (<= n 0) p (if (< n m) (nthcdr (- m n) x) x))) (while (consp (cdr x)) (pop x)) x)) (defun butlast (x &optional n) "Returns a copy of LIST with the last N elements removed." (if (and n (<= n 0)) x (nbutlast (copy-sequence x) n))) (defun nbutlast (x &optional n) "Modifies LIST to remove the last N elements." (let ((m (length x))) (or n (setq n 1)) (and (< n m) (progn (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)) x)))) (defun list* (arg &rest rest) ; See compiler macro in cl-macs.el "Return a new list with specified args as elements, cons'd to last arg. Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to `(cons A (cons B (cons C D)))'." (cond ((not rest) arg) ((not (cdr rest)) (cons arg (car rest))) (t (let* ((n (length rest)) (copy (copy-sequence rest)) (last (nthcdr (- n 2) copy))) (setcdr last (car (cdr last))) (cons arg copy))))) (defun ldiff (list sublist) "Return a copy of LIST with the tail SUBLIST removed." (let ((res nil)) (while (and (consp list) (not (eq list sublist))) (push (pop list) res)) (nreverse res))) (defun copy-list (list) "Return a copy of a list, which may be a dotted list. The elements of the list are not copied, just the list structure itself." (if (consp list) (let ((res nil)) (while (consp list) (push (pop list) res)) (prog1 (nreverse res) (setcdr res list))) (car list))) (defun cl-maclisp-member (item list) (while (and list (not (equal item (car list)))) (setq list (cdr list))) list) ;;; Define an Emacs 19-compatible `member' for the benefit of Emacs 18 users. (or (and (fboundp 'member) (subrp (symbol-function 'member))) (defalias 'member 'cl-maclisp-member)) (defalias 'cl-member 'memq) ; for compatibility with old CL package (defalias 'cl-floor 'floor*) (defalias 'cl-ceiling 'ceiling*) (defalias 'cl-truncate 'truncate*) (defalias 'cl-round 'round*) (defalias 'cl-mod 'mod*) (defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs "Return ITEM consed onto the front of LIST only if it's not already there. Otherwise, return LIST unmodified. Keywords supported: :test :test-not :key" (cond ((or (equal cl-keys '(:test eq)) (and (null cl-keys) (not (numberp cl-item)))) (if (memq cl-item cl-list) cl-list (cons cl-item cl-list))) ((or (equal cl-keys '(:test equal)) (null cl-keys)) (if (member cl-item cl-list) cl-list (cons cl-item cl-list))) (t (apply 'cl-adjoin cl-item cl-list cl-keys)))) (defun subst (cl-new cl-old cl-tree &rest cl-keys) "Substitute NEW for OLD everywhere in TREE (non-destructively). Return a copy of TREE with all elements `eql' to OLD replaced by NEW. Keywords supported: :test :test-not :key" (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old)))) (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys) (cl-do-subst cl-new cl-old cl-tree))) (defun cl-do-subst (cl-new cl-old cl-tree) (cond ((eq cl-tree cl-old) cl-new) ((consp cl-tree) (let ((a (cl-do-subst cl-new cl-old (car cl-tree))) (d (cl-do-subst cl-new cl-old (cdr cl-tree)))) (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree))) cl-tree (cons a d)))) (t cl-tree))) (defun acons (a b c) (cons (cons a b) c)) (defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c)) ;;; Miscellaneous. (put 'cl-assertion-failed 'error-conditions '(error)) (put 'cl-assertion-failed 'error-message "Assertion failed") ;;; This is defined in Emacs 19; define it here for Emacs 18 users. (defun cl-add-hook (hook func &optional append) "Add to hook variable HOOK the function FUNC. FUNC is not added if it already appears on the list stored in HOOK." (let ((old (and (boundp hook) (symbol-value hook)))) (and (listp old) (not (eq (car old) 'lambda)) (setq old (list old))) (and (not (member func old)) (set hook (if append (nconc old (list func)) (cons func old)))))) (or (fboundp 'add-hook) (defalias 'add-hook 'cl-add-hook)) ;;; Autoload the other portions of the package. (mapcar (function (lambda (set) (mapcar (function (lambda (func) (autoload func (car set) nil nil (nth 1 set)))) (cddr set)))) '(("cl-extra" nil coerce equalp cl-map-keymap maplist mapc mapl mapcan mapcon cl-map-keymap cl-map-keymap-recursively cl-map-intervals cl-map-overlays cl-set-frame-visible-p cl-float-limits gcd lcm isqrt expt floor* ceiling* truncate* round* mod* rem* signum random* make-random-state random-state-p subseq concatenate cl-mapcar-many map some every notany notevery revappend nreconc list-length tailp copy-tree get* getf cl-set-getf cl-do-remf remprop make-hash-table cl-hash-lookup gethash cl-puthash remhash clrhash maphash hash-table-p hash-table-count cl-progv-before cl-prettyexpand cl-macroexpand-all) ("cl-seq" nil reduce fill replace remq remove remove* remove-if remove-if-not delete delete* delete-if delete-if-not remove-duplicates delete-duplicates substitute substitute-if substitute-if-not nsubstitute nsubstitute-if nsubstitute-if-not find find-if find-if-not position position-if position-if-not count count-if count-if-not mismatch search sort* stable-sort merge member* member-if member-if-not cl-adjoin assoc* assoc-if assoc-if-not rassoc* rassoc rassoc-if rassoc-if-not union nunion intersection nintersection set-difference nset-difference set-exclusive-or nset-exclusive-or subsetp subst-if subst-if-not nsubst nsubst-if nsubst-if-not sublis nsublis tree-equal) ("cl-macs" nil gensym gentemp typep cl-do-pop get-setf-method cl-struct-setf-expander compiler-macroexpand cl-compile-time-init) ("cl-macs" t defun* defmacro* function* destructuring-bind eval-when eval-when-compile load-time-value case ecase typecase etypecase block return return-from loop do do* dolist dotimes do-symbols do-all-symbols psetq progv flet labels macrolet symbol-macrolet lexical-let lexical-let* multiple-value-bind multiple-value-setq locally the declare define-setf-method defsetf define-modify-macro setf psetf remf shiftf rotatef letf letf* callf callf2 defstruct check-type assert ignore-errors define-compiler-macro))) ;;; Define data for indentation and edebug. (mapcar (function (lambda (entry) (mapcar (function (lambda (func) (put func 'lisp-indent-function (nth 1 entry)) (put func 'lisp-indent-hook (nth 1 entry)) (or (get func 'edebug-form-spec) (put func 'edebug-form-spec (nth 2 entry))))) (car entry)))) '(((defun* defmacro*) 2) ((function*) nil (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form))) ((eval-when) 1 (sexp &rest form)) ((when unless) 1 (&rest form)) ((declare) nil (&rest sexp)) ((the) 1 (sexp &rest form)) ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form))) ((block return-from) 1 (sexp &rest form)) ((return) nil (&optional form)) ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form)) (form &rest form) &rest form)) ((dolist dotimes) 1 ((symbolp form &rest form) &rest form)) ((do-symbols) 1 ((symbolp form &optional form form) &rest form)) ((do-all-symbols) 1 ((symbolp form &optional form) &rest form)) ((psetq setf psetf) nil edebug-setq-form) ((progv) 2 (&rest form)) ((flet labels macrolet) 1 ((&rest (sexp sexp &rest form)) &rest form)) ((symbol-macrolet lexical-let lexical-let*) 1 ((&rest &or symbolp (symbolp form)) &rest form)) ((multiple-value-bind) 2 ((&rest symbolp) &rest form)) ((multiple-value-setq) 1 ((&rest symbolp) &rest form)) ((incf decf remf pop push pushnew shiftf rotatef) nil (&rest form)) ((letf letf*) 1 ((&rest (&rest form)) &rest form)) ((callf destructuring-bind) 2 (sexp form &rest form)) ((callf2) 3 (sexp form form &rest form)) ((loop) nil (&rest &or symbolp form)) ((ignore-errors) 0 (&rest form)))) ;;; This goes here so that cl-macs can find it if it loads right now. (provide 'cl-19) ; usage: (require 'cl-19 "cl") ;;; Things to do after byte-compiler is loaded. ;;; As a side effect, we cause cl-macs to be loaded when compiling, so ;;; that the compiler-macros defined there will be present. (defvar cl-hacked-flag nil) (defun cl-hack-byte-compiler () (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form)) (progn (cl-compile-time-init) ; in cl-macs.el (setq cl-hacked-flag t)))) ;;; Try it now in case the compiler has already been loaded. (cl-hack-byte-compiler) ;;; Also make a hook in case compiler is loaded after this file. ;;; The compiler doesn't call any hooks when it loads or runs, but ;;; we can take advantage of the fact that emacs-lisp-mode will be ;;; called when the compiler reads in the file to be compiled. ;;; BUG: If the first compilation is `byte-compile' rather than ;;; `byte-compile-file', we lose. Oh, well. (add-hook 'emacs-lisp-mode-hook 'cl-hack-byte-compiler) ;;; The following ensures that packages which expect the old-style cl.el ;;; will be happy with this one. (provide 'cl) (provide 'mini-cl) ; for Epoch (run-hooks 'cl-load-hook) ;;; cl.el ends here emacs-19.30/lisp/cmacexp.el100444 12120 1 30724 6043576441 14050 0ustar rmsdaemon;;; cmacexp.el --- expand C macros in a region ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc. ;; Author: Francesco Potorti` ;; Version: $Id: cmacexp.el,v 1.20 1995/10/26 03:14:40 rms Exp $ ;; Adapted-By: ESR ;; Keywords: c ;; 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. ;; USAGE ============================================================= ;; In C mode C-C C-e is bound to c-macro-expand. The result of the ;; expansion is put in a separate buffer. A user option allows the ;; window displaying the buffer to be optimally sized. ;; ;; When called with a C-u prefix, c-macro-expand replaces the selected ;; region with the expansion. Both the preprocessor name and the ;; initial flag can be set by the user. If c-macro-prompt-flag is set ;; to a non-nil value the user is offered to change the options to the ;; preprocessor each time c-macro-expand is invoked. Preprocessor ;; arguments default to the last ones entered. If c-macro-prompt-flag ;; is nil, one must use M-x set-variable to set a different value for ;; c-macro-cppflags. ;; A c-macro-expansion function is provided for non-interactive use. ;; INSTALLATION ====================================================== ;; Put the following in your ~/.emacs file. ;; If you want the *Macroexpansion* window to be not higher than ;; necessary: ;;(setq c-macro-shrink-window-flag t) ;; ;; If you use a preprocessor other than /lib/cpp (be careful to set a ;; -C option or equivalent in order to make the preprocessor not to ;; strip the comments): ;;(setq c-macro-preprocessor "gpp -C") ;; ;; If you often use a particular set of flags: ;;(setq c-macro-cppflags "-I /usr/include/local -DDEBUG" ;; ;; If you want the "Preprocessor arguments: " prompt: ;;(setq c-macro-prompt-flag t) ;; BUG REPORTS ======================================================= ;; Please report bugs, suggestions, complaints and so on to ;; pot@cnuce.cnr.it (Francesco Potorti`). ;; IMPROVEMENTS OVER emacs 18.xx cmacexp.el ========================== ;; - A lot of user and programmer visible changes. See above. ;; - #line directives are inserted, so __LINE__ and __FILE__ are ;; correctly expanded. Works even with START inside a string, a ;; comment or a region #ifdef'd away by cpp. cpp is invoked with -C, ;; making comments visible in the expansion. ;; - All work is done in core memory, no need for temporary files. ;; ACKNOWLEDGEMENTS ================================================== ;; A lot of thanks to Don Maszle who did a great work of testing, bug ;; reporting and suggestion of new features. This work has been ;; partially inspired by Don Maszle and Jonathan Segal's. ;; BUGS ============================================================== ;; If the start point of the region is inside a macro definition the ;; macro expansion is often inaccurate. (require 'cc-mode) (provide 'cmacexp) (defvar c-macro-shrink-window-flag nil "*Non-nil means shrink the *Macroexpansion* window to fit its contents.") (defvar c-macro-prompt-flag nil "*Non-nil makes `c-macro-expand' prompt for preprocessor arguments.") (defvar c-macro-preprocessor "/lib/cpp -C" "The preprocessor used by the cmacexp package. If you change this, be sure to preserve the `-C' (don't strip comments) option, or to set an equivalent one.") (defvar c-macro-cppflags "" "*Preprocessor flags used by `c-macro-expand'.") (defconst c-macro-buffer-name "*Macroexpansion*") (defun c-macro-expand (start end subst) "Expand C macros in the region, using the C preprocessor. Normally display output in temp buffer, but prefix arg means replace the region with it. `c-macro-preprocessor' specifies the preprocessor to use. Prompt for arguments to the preprocessor \(e.g. `-DDEBUG -I ./include') if the user option `c-macro-prompt-flag' is non-nil. Noninteractive args are START, END, SUBST. For use inside Lisp programs, see also `c-macro-expansion'." (interactive "r\nP") (let ((inbuf (current-buffer)) (displaybuf (if subst (get-buffer c-macro-buffer-name) (get-buffer-create c-macro-buffer-name))) (expansion "")) ;; Build the command string. (if c-macro-prompt-flag (setq c-macro-cppflags (read-string "Preprocessor arguments: " c-macro-cppflags))) ;; Decide where to display output. (if (and subst (and buffer-read-only (not inhibit-read-only)) (not (eq inbuf displaybuf))) (progn (message "Buffer is read only: displaying expansion in alternate window") (sit-for 2) (setq subst nil) (or displaybuf (setq displaybuf (get-buffer-create c-macro-buffer-name))))) ;; Expand the macro and output it. (setq expansion (c-macro-expansion start end (concat c-macro-preprocessor " " c-macro-cppflags) t)) (if subst (let ((exchange (= (point) start))) (delete-region start end) (insert expansion) (if exchange (exchange-point-and-mark))) (set-buffer displaybuf) (setq buffer-read-only nil) (buffer-disable-undo displaybuf) (erase-buffer) (insert expansion) (set-buffer-modified-p nil) (if (string= "" expansion) (message "Null expansion") (c-macro-display-buffer)) (setq buffer-read-only t) (setq buffer-auto-save-file-name nil) (bury-buffer displaybuf)))) ;; Display the current buffer in a window which is either just large ;; enough to contain the entire buffer, or half the size of the ;; screen, whichever is smaller. Do not select the new ;; window. ;; ;; Several factors influence window resizing so that the window is ;; sized optimally if it is created anew, and so that it is messed ;; with minimally if it has been created by the user. If the window ;; chosen for display exists already but contains something else, the ;; window is not re-sized. If the window already contains the current ;; buffer, it is never shrunk, but possibly expanded. Finally, if the ;; variable c-macro-shrink-window-flag is nil the window size is *never* ;; changed. (defun c-macro-display-buffer () (goto-char (point-min)) (c-mode) (let ((oldwinheight (window-height)) (alreadythere ;the window was already there (get-buffer-window (current-buffer))) (popped nil)) ;the window popped changing the layout (or alreadythere (progn (display-buffer (current-buffer) t) (setq popped (/= oldwinheight (window-height))))) (if (and c-macro-shrink-window-flag ;user wants fancy shrinking :\) (or alreadythere popped)) ;; Enlarge up to half screen, or shrink properly. (let ((oldwin (selected-window)) (minheight 0) (maxheight 0)) (save-excursion (select-window (get-buffer-window (current-buffer))) (setq minheight (if alreadythere (window-height) window-min-height)) (setq maxheight (/ (screen-height) 2)) (enlarge-window (- (min maxheight (max minheight (+ 2 (vertical-motion (point-max))))) (window-height))) (goto-char (point-min)) (select-window oldwin)))))) (defun c-macro-expansion (start end cppcommand &optional display) "Run a preprocessor on region and return the output as a string. Expand the region between START and END in the current buffer using the shell command CPPCOMMAND (e.g. \"/lib/cpp -C -DDEBUG\"). Be sure to use a -C (don't strip comments) or equivalent option. Optional arg DISPLAY non-nil means show messages in the echo area." ;; Copy the current buffer's contents to a temporary hidden buffer. ;; Delete from END to end of buffer. Insert a preprocessor #line ;; directive at START and after each #endif following START that are ;; not inside a comment or a string. Put all the strings thus ;; inserted (without the "line" substring) in a list named linelist. ;; If START is inside a comment, prepend "*/" and append "/*" to the ;; #line directive. If inside a string, prepend and append "\"". ;; Preprocess the buffer contents, then look for all the lines stored ;; in linelist starting from end of buffer. The last line so found is ;; where START was, so return the substring from point to end of ;; buffer. (let ((inbuf (current-buffer)) (outbuf (get-buffer-create " *C Macro Expansion*")) (filename (if (and buffer-file-name (string-match (regexp-quote default-directory) buffer-file-name)) (substring buffer-file-name (match-end 0)) (buffer-name))) (mymsg (format "Invoking %s%s%s on region..." c-macro-preprocessor (if (string= "" c-macro-cppflags) "" " ") c-macro-cppflags)) (uniquestring "???!!!???!!! start of c-macro expansion ???!!!???!!!") (startlinenum 0) (linenum 0) (startstat ()) (startmarker "") (exit-status 0) (tempname (make-temp-name "/tmp/"))) (unwind-protect (save-excursion (save-restriction (widen) (set-buffer outbuf) (setq buffer-read-only nil) (erase-buffer) (set-syntax-table c-mode-syntax-table) (insert-buffer-substring inbuf 1 end)) ;; We have copied inbuf to outbuf. Point is at end of ;; outbuf. Insert a space at the end, so cpp can correctly ;; parse a token ending at END. (insert " ") ;; Save sexp status and line number at START. (setq startstat (parse-partial-sexp 1 start)) (setq startlinenum (+ (count-lines 1 (point)) (if (bolp) 1 0))) ;; Now we insert the #line directives after all #endif or ;; #else following START going backward, so the lines we ;; insert don't change the line numbers. ;(switch-to-buffer outbuf) (debug) ;debugging instructions (goto-char (point-max)) (while (re-search-backward "\n#\\(endif\\|else\\)\\>" start 'move) (if (equal (nthcdr 3 (parse-partial-sexp start (point) nil nil startstat)) '(nil nil nil 0 nil)) ;neither in string nor in ;comment nor after quote (progn (goto-char (match-end 0)) (setq linenum (+ startlinenum (count-lines start (point)))) (insert (format "\n#line %d \"%s\"\n" linenum filename)) (goto-char (match-beginning 0))))) ;; Now we are at START. Insert the first #line directive. ;; This must work even inside a string or comment, or after a ;; quote. (let* ((startinstring (nth 3 startstat)) (startincomment (nth 4 startstat)) (startafterquote (nth 5 startstat)) (startinbcomment (nth 7 startstat))) (insert (if startafterquote " " "") (cond (startinstring (char-to-string startinstring)) (startincomment "*/") ("")) (setq startmarker (concat "\n" uniquestring (cond (startinstring (char-to-string startinstring)) (startincomment "/*") (startinbcomment "//")) (if startafterquote "\\"))) (format "\n#line %d \"%s\"\n" startlinenum filename))) ;; Call the preprocessor. (if display (message mymsg)) (setq exit-status (call-process-region 1 (point-max) "sh" t t nil "-c" (concat cppcommand " 2>" tempname))) (if display (message (concat mymsg "done"))) (if (= (buffer-size) 0) ;; Empty output is normal after a fatal error. (insert "\nPreprocessor produced no output\n") ;; Find and delete the mark of the start of the expansion. ;; Look for `# nn "file.c"' lines and delete them. (goto-char (point-min)) (search-forward startmarker) (delete-region 1 (point))) (while (re-search-forward (concat "^# [0-9]+ \"" (regexp-quote filename) "\"") nil t) (beginning-of-line) (let ((beg (point))) (forward-line 1) (delete-region beg (point)))) ;; If CPP got errors, show them at the beginning. (or (eq exit-status 0) (progn (goto-char (point-min)) (insert (format "Preprocessor terminated with status %s\n" exit-status)) (insert-file-contents tempname) (insert "\n"))) (delete-file tempname) ;; Compute the return value, keeping in account the space ;; inserted at the end of the buffer. (buffer-substring 1 (max 1 (- (point-max) 1)))) ;; Cleanup. (kill-buffer outbuf)))) ;;; cmacexp.el ends here emacs-19.30/lisp/cmuscheme.el100444 12120 1 40757 6014401433 14372 0ustar rmsdaemon;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el. ;; Copyright (C) 1988, 1994 Free Software Foundation, Inc. ;; Author: Olin Shivers ;; Maintainer: FSF ;; Keywords: processes, lisp ;; 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 is a customisation of comint-mode (see comint.el) ;;; ;;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces ;;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al.. ;;; 8/88 ;;; ;;; Please send me bug reports, bug fixes, and extensions, so that I can ;;; merge them into the master source. ;;; ;;; The changelog is at the end of this file. ;;; ;;; NOTE: MIT Cscheme, when invoked with the -emacs flag, has a special user ;;; interface that communicates process state back to the superior emacs by ;;; outputting special control sequences. The gnumacs package, xscheme.el, has ;;; lots and lots of special purpose code to read these control sequences, and ;;; so is very tightly integrated with the cscheme process. The cscheme ;;; interrupt handler and debugger read single character commands in cbreak ;;; mode; when this happens, xscheme.el switches to special keymaps that bind ;;; the single letter command keys to emacs functions that directly send the ;;; character to the scheme process. Cmuscheme mode does *not* provide this ;;; functionality. If you are a cscheme user, you may prefer to use the ;;; xscheme.el/cscheme -emacs interaction. ;;; ;;; Here's a summary of the pros and cons, as I see them. ;;; xscheme: Tightly integrated with inferior cscheme process! A few commands ;;; not in cmuscheme. But. Integration is a bit of a hack. Input ;;; history only keeps the immediately prior input. Bizarre ;;; keybindings. ;;; ;;; cmuscheme: Not tightly integrated with inferior cscheme process. But. ;;; Carefully integrated functionality with the entire suite of ;;; comint-derived CMU process modes. Keybindings reminiscent of ;;; Zwei and Hemlock. Good input history. A few commands not in ;;; xscheme. ;;; ;;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme ;;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very* ;;; Cscheme-specific; you must use cmuscheme.el. Interested parties are ;;; invited to port xscheme functionality on top of comint mode... ;;; Code: (require 'scheme) (require 'comint) ;;; INFERIOR SCHEME MODE STUFF ;;;============================================================================ (defvar inferior-scheme-mode-hook nil "*Hook for customising inferior-scheme mode.") (defvar inferior-scheme-mode-map nil) (cond ((not inferior-scheme-mode-map) (setq inferior-scheme-mode-map (copy-keymap comint-mode-map)) (define-key inferior-scheme-mode-map "\M-\C-x" ;gnu convention 'scheme-send-definition) (define-key inferior-scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp) (define-key inferior-scheme-mode-map "\C-c\C-l" 'scheme-load-file) (define-key inferior-scheme-mode-map "\C-c\C-k" 'scheme-compile-file) (scheme-mode-commands inferior-scheme-mode-map))) ;; Install the process communication commands in the scheme-mode keymap. (define-key scheme-mode-map "\M-\C-x" 'scheme-send-definition);gnu convention (define-key scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp);gnu convention (define-key scheme-mode-map "\C-c\C-e" 'scheme-send-definition) (define-key scheme-mode-map "\C-c\M-e" 'scheme-send-definition-and-go) (define-key scheme-mode-map "\C-c\C-r" 'scheme-send-region) (define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go) (define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition) (define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go) (define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme) (define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file) (define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile" (defvar scheme-buffer) (defun inferior-scheme-mode () "Major mode for interacting with an inferior Scheme process. The following commands are available: \\{inferior-scheme-mode-map} A Scheme process can be fired up with M-x run-scheme. Customisation: Entry to this mode runs the hooks on comint-mode-hook and inferior-scheme-mode-hook (in that order). You can send text to the inferior Scheme process from other buffers containing Scheme source. switch-to-scheme switches the current buffer to the Scheme process buffer. scheme-send-definition sends the current definition to the Scheme process. scheme-compile-definition compiles the current definition. scheme-send-region sends the current region to the Scheme process. scheme-compile-region compiles the current region. scheme-send-definition-and-go, scheme-compile-definition-and-go, scheme-send-region-and-go, and scheme-compile-region-and-go switch to the Scheme process buffer after sending their text. For information on running multiple processes in multiple buffers, see documentation for variable scheme-buffer. Commands: Return after the end of the process' output sends the text from the end of process to point. Return before the end of the process' output copies the sexp ending at point to the end of the process' output, and sends it. Delete converts tabs to spaces as it moves back. Tab indents for Scheme; with argument, shifts rest of expression rigidly with the current line. C-M-q does Tab on each line starting within following expression. Paragraphs are separated only by blank lines. Semicolons start comments. If you accidentally suspend your process, use \\[comint-continue-subjob] to continue it." (interactive) (comint-mode) ;; Customise in inferior-scheme-mode-hook (setq comint-prompt-regexp "^[^>\n]*>+ *") ; OK for cscheme, oaklisp, T,... (scheme-mode-variables) (setq major-mode 'inferior-scheme-mode) (setq mode-name "Inferior Scheme") (setq mode-line-process '(":%s")) (use-local-map inferior-scheme-mode-map) (setq comint-input-filter (function scheme-input-filter)) (setq comint-get-old-input (function scheme-get-old-input)) (run-hooks 'inferior-scheme-mode-hook)) (defvar inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'" "*Input matching this regexp are not saved on the history list. Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters.") (defun scheme-input-filter (str) "Don't save anything matching inferior-scheme-filter-regexp" (not (string-match inferior-scheme-filter-regexp str))) (defun scheme-get-old-input () "Snarf the sexp ending at point" (save-excursion (let ((end (point))) (backward-sexp) (buffer-substring (point) end)))) (defun scheme-args-to-list (string) (let ((where (string-match "[ \t]" string))) (cond ((null where) (list string)) ((not (= where 0)) (cons (substring string 0 where) (scheme-args-to-list (substring string (+ 1 where) (length string))))) (t (let ((pos (string-match "[^ \t]" string))) (if (null pos) nil (scheme-args-to-list (substring string pos (length string))))))))) (defvar scheme-program-name "scheme" "*Program invoked by the run-scheme command") ;;;###autoload (defun run-scheme (cmd) "Run an inferior Scheme process, input and output via buffer *scheme*. If there is a process already running in `*scheme*', switch to that buffer. With argument, allows you to edit the command line (default is value of `scheme-program-name'). Runs the hooks `inferior-scheme-mode-hook' \(after the `comint-mode-hook' is run). \(Type \\[describe-mode] in the process buffer for a list of commands.)" (interactive (list (if current-prefix-arg (read-string "Run Scheme: " scheme-program-name) scheme-program-name))) (if (not (comint-check-proc "*scheme*")) (let ((cmdlist (scheme-args-to-list cmd))) (set-buffer (apply 'make-comint "scheme" (car cmdlist) nil (cdr cmdlist))) (inferior-scheme-mode))) (setq scheme-program-name cmd) (setq scheme-buffer "*scheme*") (pop-to-buffer "*scheme*")) ;;;###autoload (add-hook 'same-window-buffer-names "*scheme*") (defun scheme-send-region (start end) "Send the current region to the inferior Scheme process." (interactive "r") (comint-send-region (scheme-proc) start end) (comint-send-string (scheme-proc) "\n")) (defun scheme-send-definition () "Send the current definition to the inferior Scheme process." (interactive) (save-excursion (end-of-defun) (let ((end (point))) (beginning-of-defun) (scheme-send-region (point) end)))) (defun scheme-send-last-sexp () "Send the previous sexp to the inferior Scheme process." (interactive) (scheme-send-region (save-excursion (backward-sexp) (point)) (point))) (defvar scheme-compile-exp-command "(compile '%s)" "*Template for issuing commands to compile arbitrary Scheme expressions.") (defun scheme-compile-region (start end) "Compile the current region in the inferior Scheme process. \(A BEGIN is wrapped around the region: (BEGIN ))" (interactive "r") (comint-send-string (scheme-proc) (format scheme-compile-exp-command (format "(begin %s)" (buffer-substring start end)))) (comint-send-string (scheme-proc) "\n")) (defun scheme-compile-definition () "Compile the current definition in the inferior Scheme process." (interactive) (save-excursion (end-of-defun) (let ((end (point))) (beginning-of-defun) (scheme-compile-region (point) end)))) (defun switch-to-scheme (eob-p) "Switch to the scheme process buffer. With argument, positions cursor at end of buffer." (interactive "P") (if (get-buffer scheme-buffer) (pop-to-buffer scheme-buffer) (error "No current process buffer. See variable scheme-buffer.")) (cond (eob-p (push-mark) (goto-char (point-max))))) (defun scheme-send-region-and-go (start end) "Send the current region to the inferior Scheme process. Then switch to the process buffer." (interactive "r") (scheme-send-region start end) (switch-to-scheme t)) (defun scheme-send-definition-and-go () "Send the current definition to the inferior Scheme. Then switch to the process buffer." (interactive) (scheme-send-definition) (switch-to-scheme t)) (defun scheme-compile-definition-and-go () "Compile the current definition in the inferior Scheme. Then switch to the process buffer." (interactive) (scheme-compile-definition) (switch-to-scheme t)) (defun scheme-compile-region-and-go (start end) "Compile the current region in the inferior Scheme. Then switch to the process buffer." (interactive "r") (scheme-compile-region start end) (switch-to-scheme t)) (defvar scheme-source-modes '(scheme-mode) "*Used to determine if a buffer contains Scheme source code. If it's loaded into a buffer that is in one of these major modes, it's considered a scheme source file by scheme-load-file and scheme-compile-file. Used by these commands to determine defaults.") (defvar scheme-prev-l/c-dir/file nil "Caches the last (directory . file) pair. Caches the last pair used in the last scheme-load-file or scheme-compile-file command. Used for determining the default in the next one.") (defun scheme-load-file (file-name) "Load a Scheme file into the inferior Scheme process." (interactive (comint-get-source "Load Scheme file: " scheme-prev-l/c-dir/file scheme-source-modes t)) ; T because LOAD ; needs an exact name (comint-check-source file-name) ; Check to see if buffer needs saved. (setq scheme-prev-l/c-dir/file (cons (file-name-directory file-name) (file-name-nondirectory file-name))) (comint-send-string (scheme-proc) (concat "(load \"" file-name "\"\)\n"))) (defun scheme-compile-file (file-name) "Compile a Scheme file in the inferior Scheme process." (interactive (comint-get-source "Compile Scheme file: " scheme-prev-l/c-dir/file scheme-source-modes nil)) ; NIL because COMPILE doesn't ; need an exact name. (comint-check-source file-name) ; Check to see if buffer needs saved. (setq scheme-prev-l/c-dir/file (cons (file-name-directory file-name) (file-name-nondirectory file-name))) (comint-send-string (scheme-proc) (concat "(compile-file \"" file-name "\"\)\n"))) (defvar scheme-buffer nil "*The current scheme process buffer. MULTIPLE PROCESS SUPPORT =========================================================================== Cmuscheme.el supports, in a fairly simple fashion, running multiple Scheme processes. To run multiple Scheme processes, you start the first up with \\[run-scheme]. It will be in a buffer named *scheme*. Rename this buffer with \\[rename-buffer]. You may now start up a new process with another \\[run-scheme]. It will be in a new buffer, named *scheme*. You can switch between the different process buffers with \\[switch-to-buffer]. Commands that send text from source buffers to Scheme processes -- like scheme-send-definition or scheme-compile-region -- have to choose a process to send to, when you have more than one Scheme process around. This is determined by the global variable scheme-buffer. Suppose you have three inferior Schemes running: Buffer Process foo scheme bar scheme<2> *scheme* scheme<3> If you do a \\[scheme-send-definition-and-go] command on some Scheme source code, what process do you send it to? - If you're in a process buffer (foo, bar, or *scheme*), you send it to that process. - If you're in some other buffer (e.g., a source file), you send it to the process attached to buffer scheme-buffer. This process selection is performed by function scheme-proc. Whenever \\[run-scheme] fires up a new process, it resets scheme-buffer to be the new process's buffer. If you only run one process, this will do the right thing. If you run multiple processes, you can change scheme-buffer to another process buffer with \\[set-variable]. More sophisticated approaches are, of course, possible. If you find yourself needing to switch back and forth between multiple processes frequently, you may wish to consider ilisp.el, a larger, more sophisticated package for running inferior Lisp and Scheme processes. The approach taken here is for a minimal, simple implementation. Feel free to extend it.") (defun scheme-proc () "Returns the current scheme process. See variable scheme-buffer." (let ((proc (get-buffer-process (if (eq major-mode 'inferior-scheme-mode) (current-buffer) scheme-buffer)))) (or proc (error "No current process. See variable scheme-buffer")))) ;;; Do the user's customisation... (defvar cmuscheme-load-hook nil "This hook is run when cmuscheme is loaded in. This is a good place to put keybindings.") (run-hooks 'cmuscheme-load-hook) ;;; CHANGE LOG ;;; =========================================================================== ;;; 8/88 Olin ;;; Created. ;;; ;;; 2/15/89 Olin ;;; Removed -emacs flag from process invocation. It's only useful for ;;; cscheme, and makes cscheme assume it's running under xscheme.el, ;;; which messes things up royally. A bug. ;;; ;;; 5/22/90 Olin ;;; - Upgraded to use comint-send-string and comint-send-region. ;;; - run-scheme now offers to let you edit the command line if ;;; you invoke it with a prefix-arg. M-x scheme is redundant, and ;;; has been removed. ;;; - Explicit references to process "scheme" have been replaced with ;;; (scheme-proc). This allows better handling of multiple process bufs. ;;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention. ;;; - Have not added process query facility a la cmulisp.el's lisp-show-arglist ;;; and friends, but interested hackers might find a useful application ;;; of this facility. ;;; ;;; 3/12/90 Olin ;;; - scheme-load-file and scheme-compile-file no longer switch-to-scheme. ;;; Tale suggested this. (provide 'cmuscheme) ;;; cmuscheme.el ends here emacs-19.30/lisp/comint.el100444 12120 1 264675 6041774163 13756 0ustar rmsdaemon;;; comint.el --- general command interpreter in a window stuff ;; Copyright (C) 1988, 90, 92, 93, 94, 95 Free Software Foundation, Inc. ;; Author: Olin Shivers ;; Adapted-by: Simon Marshall ;; Keywords: processes ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Please send me bug reports, bug fixes, and extensions, so that I can ;;; merge them into the master source. ;;; - Olin Shivers (shivers@cs.cmu.edu) ;;; - Simon Marshall (simon@gnu.ai.mit.edu) ;;; This file defines a general command-interpreter-in-a-buffer package ;;; (comint mode). The idea is that you can build specific process-in-a-buffer ;;; modes on top of comint mode -- e.g., lisp, shell, scheme, T, soar, .... ;;; This way, all these specific packages share a common base functionality, ;;; and a common set of bindings, which makes them easier to use (and ;;; saves code, implementation time, etc., etc.). ;;; Several packages are already defined using comint mode: ;;; - shell.el defines a shell-in-a-buffer mode. ;;; - cmulisp.el defines a simple lisp-in-a-buffer mode. ;;; ;;; - The file cmuscheme.el defines a scheme-in-a-buffer mode. ;;; - The file tea.el tunes scheme and inferior-scheme modes for T. ;;; - The file soar.el tunes lisp and inferior-lisp modes for Soar. ;;; - cmutex.el defines tex and latex modes that invoke tex, latex, bibtex, ;;; previewers, and printers from within emacs. ;;; - background.el allows csh-like job control inside emacs. ;;; It is pretty easy to make new derived modes for other processes. ;;; For documentation on the functionality provided by comint mode, and ;;; the hooks available for customising it, see the comments below. ;;; For further information on the standard derived modes (shell, ;;; inferior-lisp, inferior-scheme, ...), see the relevant source files. ;;; For hints on converting existing process modes (e.g., tex-mode, ;;; background, dbx, gdb, kermit, prolog, telnet) to use comint-mode ;;; instead of shell-mode, see the notes at the end of this file. ;;; Brief Command Documentation: ;;;============================================================================ ;;; Comint Mode Commands: (common to all derived modes, like shell & cmulisp ;;; mode) ;;; ;;; m-p comint-previous-input Cycle backwards in input history ;;; m-n comint-next-input Cycle forwards ;;; m-r comint-previous-matching-input Previous input matching a regexp ;;; m-s comint-next-matching-input Next input that matches ;;; m-c-l comint-show-output Show last batch of process output ;;; return comint-send-input ;;; c-d comint-delchar-or-maybe-eof Delete char unless at end of buff ;;; c-c c-a comint-bol Beginning of line; skip prompt ;;; c-c c-u comint-kill-input ^u ;;; c-c c-w backward-kill-word ^w ;;; c-c c-c comint-interrupt-subjob ^c ;;; c-c c-z comint-stop-subjob ^z ;;; c-c c-\ comint-quit-subjob ^\ ;;; c-c c-o comint-kill-output Delete last batch of process output ;;; c-c c-r comint-show-output Show last batch of process output ;;; c-c c-l comint-dynamic-list-input-ring List input history ;;; ;;; Not bound by default in comint-mode (some are in shell mode) ;;; comint-run Run a program under comint-mode ;;; send-invisible Read a line w/o echo, and send to proc ;;; comint-dynamic-complete-filename Complete filename at point. ;;; comint-dynamic-complete-variable Complete variable name at point. ;;; comint-dynamic-list-filename-completions List completions in help buffer. ;;; comint-replace-by-expanded-filename Expand and complete filename at point; ;;; replace with expanded/completed name. ;;; comint-replace-by-expanded-history Expand history at point; ;;; replace with expanded name. ;;; comint-magic-space Expand history and add (a) space(s). ;;; comint-kill-subjob No mercy. ;;; comint-show-maximum-output Show as much output as possible. ;;; comint-continue-subjob Send CONT signal to buffer's process ;;; group. Useful if you accidentally ;;; suspend your process (with C-c C-z). ;;; comint-mode-hook is the comint mode hook. Basically for your keybindings. ;;; Code: (require 'ring) ;;; Buffer Local Variables: ;;;============================================================================ ;;; Comint mode buffer local variables: ;;; comint-prompt-regexp - string comint-bol uses to match prompt ;;; comint-delimiter-argument-list - list For delimiters and arguments ;;; comint-last-input-start - marker Handy if inferior always echoes ;;; comint-last-input-end - marker For comint-kill-output command ;;; comint-input-ring-size - integer For the input history ;;; comint-input-ring - ring mechanism ;;; comint-input-ring-index - number ... ;;; comint-input-autoexpand - symbol ... ;;; comint-input-ignoredups - boolean ... ;;; comint-last-input-match - string ... ;;; comint-dynamic-complete-functions - hook For the completion mechanism ;;; comint-completion-fignore - list ... ;;; comint-file-name-quote-list - list ... ;;; comint-get-old-input - function Hooks for specific ;;; comint-input-filter-functions - hook process-in-a-buffer ;;; comint-output-filter-functions - hook function modes. ;;; comint-input-filter - function ... ;;; comint-input-sender - function ... ;;; comint-eol-on-send - boolean ... ;;; comint-process-echoes - boolean ... ;;; comint-scroll-to-bottom-on-input - symbol For scroll behavior ;;; comint-scroll-to-bottom-on-output - symbol ... ;;; comint-scroll-show-maximum-output - boolean... ;;; ;;; Comint mode non-buffer local variables: ;;; comint-completion-addsuffix - boolean/cons For file name completion ;;; comint-completion-autolist - boolean behavior ;;; comint-completion-recexact - boolean ... (defvar comint-prompt-regexp "^" "Regexp to recognise prompts in the inferior process. Defaults to \"^\", the null string at BOL. Good choices: Canonical Lisp: \"^[^> \\n]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp) Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\" franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\" kcl: \"^>+ *\" shell: \"^[^#$%>\\n]*[#$%>] *\" T: \"^>+ *\" This is a good thing to set in mode hooks.") (defvar comint-delimiter-argument-list () "List of characters to recognise as separate arguments in input. Strings comprising a character in this list will separate the arguments surrounding them, and also be regarded as arguments in their own right (unlike whitespace). See `comint-arguments'. Defaults to the empty list. For shells, a good value is (?\\| ?& ?< ?> ?\\( ?\\) ?;). This is a good thing to set in mode hooks.") (defvar comint-input-autoexpand nil "*If non-nil, expand input command history references on completion. This mirrors the optional behavior of tcsh (its autoexpand and histlit). If the value is `input', then the expansion is seen on input. If the value is `history', then the expansion is only when inserting into the buffer's input ring. See also `comint-magic-space' and `comint-dynamic-complete'. This variable is buffer-local.") (defvar comint-input-ignoredups nil "*If non-nil, don't add input matching the last on the input ring. This mirrors the optional behavior of bash. This variable is buffer-local.") (defvar comint-input-ring-file-name nil "*If non-nil, name of the file to read/write input history. See also `comint-read-input-ring' and `comint-write-input-ring'. This variable is buffer-local, and is a good thing to set in mode hooks.") (defvar comint-scroll-to-bottom-on-input nil "*Controls whether input to interpreter causes window to scroll. If nil, then do not scroll. If t or `all', scroll all windows showing buffer. If `this', scroll only the selected window. The default is nil. See `comint-preinput-scroll-to-bottom'. This variable is buffer-local.") (defvar comint-scroll-to-bottom-on-output nil "*Controls whether interpreter output causes window to scroll. If nil, then do not scroll. If t or `all', scroll all windows showing buffer. If `this', scroll only the selected window. If `others', scroll only those that are not the selected window. The default is nil. See variable `comint-scroll-show-maximum-output' and function `comint-postoutput-scroll-to-bottom'. This variable is buffer-local.") (defvar comint-scroll-show-maximum-output nil "*Controls how interpreter output causes window to scroll. If non-nil, then show the maximum output when the window is scrolled. See variable `comint-scroll-to-bottom-on-output' and function `comint-postoutput-scroll-to-bottom'. This variable is buffer-local.") (defvar comint-buffer-maximum-size 1024 "*The maximum size in lines for comint buffers. Comint buffers are truncated from the top to be no greater than this number, if the function `comint-truncate-buffer' is on `comint-output-filter-functions'.") (defvar comint-input-ring-size 32 "Size of input history ring.") (defvar comint-process-echoes nil "*If non-nil, assume that the subprocess echoes any input. If so, delete one copy of the input so that only one copy eventually appears in the buffer. This variable is buffer-local.") (defvar comint-password-prompt-regexp "\\(\\([Oo]ld \\|[Nn]ew \\|^\\)[Pp]assword\\|pass phrase\\):\\s *\\'" "*Regexp matching prompts for passwords in the inferior process. This is used by `comint-watch-for-password-prompt'.") ;;; Here are the per-interpreter hooks. (defvar comint-get-old-input (function comint-get-old-input-default) "Function that returns old text in comint mode. This function is called when return is typed while the point is in old text. It returns the text to be submitted as process input. The default is `comint-get-old-input-default', which grabs the current line, and strips off leading text matching `comint-prompt-regexp'.") (defvar comint-dynamic-complete-functions '(comint-replace-by-expanded-history comint-dynamic-complete-filename) "List of functions called to perform completion. Functions should return non-nil if completion was performed. See also `comint-dynamic-complete'. This is a good thing to set in mode hooks.") (defvar comint-input-filter (function (lambda (str) (not (string-match "\\`\\s *\\'" str)))) "Predicate for filtering additions to input history. Takes one argument, the input. If non-nil, the input may be saved on the input history list. Default is to save anything that isn't all whitespace.") (defvar comint-input-filter-functions '() "Functions to call before input is sent to the process. These functions get one argument, a string containing the text to send. This variable is buffer-local.") (defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom) "Functions to call after output is inserted into the buffer. One possible function is `comint-postoutput-scroll-to-bottom'. These functions get one argument, a string containing the text just inserted. This variable is buffer-local.") (defvar comint-input-sender (function comint-simple-send) "Function to actually send to PROCESS the STRING submitted by user. Usually this is just `comint-simple-send', but if your mode needs to massage the input string, put a different function here. `comint-simple-send' just sends the string plus a newline. This is called from the user command `comint-send-input'.") (defvar comint-eol-on-send t "*Non-nil means go to the end of the line before sending input. See `comint-send-input'.") (defvar comint-mode-hook '() "Called upon entry into comint-mode This is run before the process is cranked up.") (defvar comint-exec-hook '() "Called each time a process is exec'd by `comint-exec'. This is called after the process is cranked up. It is useful for things that must be done each time a process is executed in a comint mode buffer (e.g., `(process-kill-without-query)'). In contrast, the `comint-mode-hook' is only executed once when the buffer is created.") (defvar comint-mode-map nil) (defvar comint-ptyp t "Non-nil if communications via pty; false if by pipe. Buffer local. This is to work around a bug in Emacs process signalling.") (defvar comint-input-ring nil) (defvar comint-last-input-start) (defvar comint-last-input-end) (defvar comint-last-output-start) (defvar comint-input-ring-index nil "Index of last matched history element.") (defvar comint-matching-input-from-input-string "" "Input previously used to match input history.") (put 'comint-replace-by-expanded-history 'menu-enable 'comint-input-autoexpand) (put 'comint-input-ring 'permanent-local t) (put 'comint-input-ring-index 'permanent-local t) (put 'comint-input-autoexpand 'permanent-local t) (put 'comint-input-filter-functions 'permanent-local t) (put 'comint-output-filter-functions 'permanent-local t) (put 'comint-scroll-to-bottom-on-input 'permanent-local t) (put 'comint-scroll-to-bottom-on-output 'permanent-local t) (put 'comint-scroll-show-maximum-output 'permanent-local t) (put 'comint-ptyp 'permanent-local t) (defun comint-mode () "Major mode for interacting with an inferior interpreter. Interpreter name is same as buffer name, sans the asterisks. Return at end of buffer sends line as input. Return not at end copies rest of line to end and sends it. Setting variable `comint-eol-on-send' means jump to the end of the line before submitting new input. This mode is customised to create major modes such as Inferior Lisp mode, Shell mode, etc. This can be done by setting the hooks `comint-input-filter-functions', `comint-input-filter', `comint-input-sender' and `comint-get-old-input' to appropriate functions, and the variable `comint-prompt-regexp' to the appropriate regular expression. An input history is maintained of size `comint-input-ring-size', and can be accessed with the commands \\[comint-next-input], \\[comint-previous-input], and \\[comint-dynamic-list-input-ring]. Input ring history expansion can be achieved with the commands \\[comint-replace-by-expanded-history] or \\[comint-magic-space]. Input ring expansion is controlled by the variable `comint-input-autoexpand', and addition is controlled by the variable `comint-input-ignoredups'. Commands with no default key bindings include `send-invisible', `comint-dynamic-complete', `comint-dynamic-list-filename-completions', and `comint-magic-space'. Input to, and output from, the subprocess can cause the window to scroll to the end of the buffer. See variables `comint-output-filter-functions', `comint-scroll-to-bottom-on-input', and `comint-scroll-to-bottom-on-output'. If you accidentally suspend your process, use \\[comint-continue-subjob] to continue it. \\{comint-mode-map} Entry to this mode runs the hooks on `comint-mode-hook'." (interactive) ;; Do not remove this. All major modes must do this. (kill-all-local-variables) (setq major-mode 'comint-mode) (setq mode-name "Comint") (setq mode-line-process '(":%s")) (use-local-map comint-mode-map) (make-local-variable 'comint-last-input-start) (setq comint-last-input-start (make-marker)) (set-marker comint-last-input-start (point-min)) (make-local-variable 'comint-last-input-end) (setq comint-last-input-end (make-marker)) (set-marker comint-last-input-end (point-min)) (make-local-variable 'comint-last-output-start) (setq comint-last-output-start (make-marker)) (make-local-variable 'comint-prompt-regexp) ; Don't set; default (make-local-variable 'comint-input-ring-size) ; ...to global val. (make-local-variable 'comint-input-ring) (make-local-variable 'comint-input-ring-file-name) (or (and (boundp 'comint-input-ring) comint-input-ring) (setq comint-input-ring (make-ring comint-input-ring-size))) (make-local-variable 'comint-input-ring-index) (or (and (boundp 'comint-input-ring-index) comint-input-ring-index) (setq comint-input-ring-index nil)) (make-local-variable 'comint-matching-input-from-input-string) (make-local-variable 'comint-input-autoexpand) (make-local-variable 'comint-input-ignoredups) (make-local-variable 'comint-delimiter-argument-list) (make-local-hook 'comint-dynamic-complete-functions) (make-local-variable 'comint-completion-fignore) (make-local-variable 'comint-get-old-input) (make-local-hook 'comint-input-filter-functions) (make-local-variable 'comint-input-filter) (make-local-variable 'comint-input-sender) (make-local-variable 'comint-eol-on-send) (make-local-variable 'comint-scroll-to-bottom-on-input) (make-local-variable 'comint-scroll-to-bottom-on-output) (make-local-variable 'comint-scroll-show-maximum-output) (make-local-variable 'pre-command-hook) (add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom) (make-local-hook 'comint-output-filter-functions) (make-local-variable 'comint-ptyp) (make-local-variable 'comint-exec-hook) (make-local-variable 'comint-process-echoes) (make-local-variable 'comint-file-name-quote-list) (run-hooks 'comint-mode-hook)) (if comint-mode-map nil ;; Keys: (setq comint-mode-map (make-sparse-keymap)) (define-key comint-mode-map "\ep" 'comint-previous-input) (define-key comint-mode-map "\en" 'comint-next-input) (define-key comint-mode-map [C-up] 'comint-previous-input) (define-key comint-mode-map [C-down] 'comint-next-input) (define-key comint-mode-map "\er" 'comint-previous-matching-input) (define-key comint-mode-map "\es" 'comint-next-matching-input) (define-key comint-mode-map [?\A-\M-r] 'comint-previous-matching-input-from-input) (define-key comint-mode-map [?\A-\M-s] 'comint-next-matching-input-from-input) (define-key comint-mode-map "\e\C-l" 'comint-show-output) (define-key comint-mode-map "\C-m" 'comint-send-input) (define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof) (define-key comint-mode-map "\C-c\C-a" 'comint-bol) (define-key comint-mode-map "\C-c\C-u" 'comint-kill-input) (define-key comint-mode-map "\C-c\C-w" 'backward-kill-word) (define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob) (define-key comint-mode-map "\C-c\C-z" 'comint-stop-subjob) (define-key comint-mode-map "\C-c\C-\\" 'comint-quit-subjob) (define-key comint-mode-map "\C-c\C-m" 'comint-copy-old-input) (define-key comint-mode-map "\C-c\C-o" 'comint-kill-output) (define-key comint-mode-map "\C-c\C-r" 'comint-show-output) (define-key comint-mode-map "\C-c\C-e" 'comint-show-maximum-output) (define-key comint-mode-map "\C-c\C-l" 'comint-dynamic-list-input-ring) (define-key comint-mode-map "\C-c\C-n" 'comint-next-prompt) (define-key comint-mode-map "\C-c\C-p" 'comint-previous-prompt) (define-key comint-mode-map "\C-c\C-d" 'comint-send-eof) ;; Menu bars: ;; completion: (define-key comint-mode-map [menu-bar completion] (cons "Complete" (make-sparse-keymap "Complete"))) (define-key comint-mode-map [menu-bar completion complete-expand] '("Expand File Name" . comint-replace-by-expanded-filename)) (define-key comint-mode-map [menu-bar completion complete-listing] '("File Completion Listing" . comint-dynamic-list-filename-completions)) (define-key comint-mode-map [menu-bar completion complete-file] '("Complete File Name" . comint-dynamic-complete-filename)) (define-key comint-mode-map [menu-bar completion complete] '("Complete Before Point" . comint-dynamic-complete)) ;; Input history: (define-key comint-mode-map [menu-bar inout] (cons "In/Out" (make-sparse-keymap "In/Out"))) (define-key comint-mode-map [menu-bar inout kill-output] '("Kill Current Output Group" . comint-kill-output)) (define-key comint-mode-map [menu-bar inout next-prompt] '("Forward Output Group" . comint-next-prompt)) (define-key comint-mode-map [menu-bar inout previous-prompt] '("Backward Output Group" . comint-previous-prompt)) (define-key comint-mode-map [menu-bar inout show-maximum-output] '("Show Maximum Output" . comint-show-maximum-output)) (define-key comint-mode-map [menu-bar inout show-output] '("Show Current Output Group" . comint-show-output)) (define-key comint-mode-map [menu-bar inout kill-input] '("Kill Current Input" . comint-kill-input)) (define-key comint-mode-map [menu-bar inout copy-input] '("Copy Old Input" . comint-copy-old-input)) (define-key comint-mode-map [menu-bar inout forward-matching-history] '("Forward Matching Input..." . comint-forward-matching-input)) (define-key comint-mode-map [menu-bar inout backward-matching-history] '("Backward Matching Input..." . comint-backward-matching-input)) (define-key comint-mode-map [menu-bar inout next-matching-history] '("Next Matching Input..." . comint-next-matching-input)) (define-key comint-mode-map [menu-bar inout previous-matching-history] '("Previous Matching Input..." . comint-previous-matching-input)) (define-key comint-mode-map [menu-bar inout next-matching-history-from-input] '("Next Matching Current Input" . comint-next-matching-input-from-input)) (define-key comint-mode-map [menu-bar inout previous-matching-history-from-input] '("Previous Matching Current Input" . comint-previous-matching-input-from-input)) (define-key comint-mode-map [menu-bar inout next-history] '("Next Input" . comint-next-input)) (define-key comint-mode-map [menu-bar inout previous-history] '("Previous Input" . comint-previous-input)) (define-key comint-mode-map [menu-bar inout list-history] '("List Input History" . comint-dynamic-list-input-ring)) (define-key comint-mode-map [menu-bar inout expand-history] '("Expand History Before Point" . comint-replace-by-expanded-history)) ;; Signals (define-key comint-mode-map [menu-bar signals] (cons "Signals" (make-sparse-keymap "Signals"))) (define-key comint-mode-map [menu-bar signals eof] '("EOF" . comint-send-eof)) (define-key comint-mode-map [menu-bar signals kill] '("KILL" . comint-kill-subjob)) (define-key comint-mode-map [menu-bar signals quit] '("QUIT" . comint-quit-subjob)) (define-key comint-mode-map [menu-bar signals cont] '("CONT" . comint-continue-subjob)) (define-key comint-mode-map [menu-bar signals stop] '("STOP" . comint-stop-subjob)) (define-key comint-mode-map [menu-bar signals break] '("BREAK" . comint-interrupt-subjob)) ;; Put them in the menu bar: (setq menu-bar-final-items (append '(completion inout signals) menu-bar-final-items)) ) (defun comint-check-proc (buffer) "Return t if there is a living process associated w/buffer BUFFER. Living means the status is `open', `run', or `stop'. BUFFER can be either a buffer or the name of one." (let ((proc (get-buffer-process buffer))) (and proc (memq (process-status proc) '(open run stop))))) ;;; Note that this guy, unlike shell.el's make-shell, barfs if you pass it () ;;; for the second argument (program). ;;;###autoload (defun make-comint (name program &optional startfile &rest switches) "Make a comint process NAME in a buffer, running PROGRAM. The name of the buffer is made by surrounding NAME with `*'s. PROGRAM should be either a string denoting an executable program to create via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP connection to be opened via `open-network-stream'. If there is already a running process in that buffer, it is not restarted. Optional third arg STARTFILE is the name of a file to send the contents of to the process. If PROGRAM is a string, any more args are arguments to PROGRAM." (or (fboundp 'start-process) (error "Multi-processing is not supported for this system")) (let ((buffer (get-buffer-create (concat "*" name "*")))) ;; If no process, or nuked process, crank up a new one and put buffer in ;; comint mode. Otherwise, leave buffer and existing process alone. (cond ((not (comint-check-proc buffer)) (save-excursion (set-buffer buffer) (comint-mode)) ; Install local vars, mode, keymap, ... (comint-exec buffer name program startfile switches))) buffer)) ;;;###autoload (defun comint-run (program) "Run PROGRAM in a comint buffer and switch to it. The buffer name is made by surrounding the file name of PROGRAM with `*'s. The file name is used to make a symbol name, such as `comint-sh-hook', and any hooks on this symbol are run in the buffer. See `make-comint' and `comint-exec'." (interactive "sRun program: ") (let ((name (file-name-nondirectory program))) (switch-to-buffer (make-comint name program)) (run-hooks (intern-soft (concat "comint-" name "-hook"))))) (defun comint-exec (buffer name command startfile switches) "Start up a process in buffer BUFFER for comint modes. Blasts any old process running in the buffer. Doesn't set the buffer mode. You can use this to cheaply run a series of processes in the same comint buffer. The hook `comint-exec-hook' is run after each exec." (save-excursion (set-buffer buffer) (let ((proc (get-buffer-process buffer))) ; Blast any old process. (if proc (delete-process proc))) ;; Crank up a new process (let ((proc (if (consp command) (open-network-stream name buffer (car command) (cdr command)) (comint-exec-1 name buffer command switches)))) (set-process-filter proc 'comint-output-filter) (make-local-variable 'comint-ptyp) (setq comint-ptyp process-connection-type) ; T if pty, NIL if pipe. ;; Jump to the end, and set the process mark. (goto-char (point-max)) (set-marker (process-mark proc) (point)) ;; Feed it the startfile. (cond (startfile ;;This is guaranteed to wait long enough ;;but has bad results if the comint does not prompt at all ;; (while (= size (buffer-size)) ;; (sleep-for 1)) ;;I hope 1 second is enough! (sleep-for 1) (goto-char (point-max)) (insert-file-contents startfile) (setq startfile (buffer-substring (point) (point-max))) (delete-region (point) (point-max)) (comint-send-string proc startfile))) (run-hooks 'comint-exec-hook) buffer))) ;;; This auxiliary function cranks up the process for comint-exec in ;;; the appropriate environment. (defun comint-exec-1 (name buffer command switches) (let ((process-environment (nconc ;; If using termcap, we specify `emacs' as the terminal type ;; because that lets us specify a width. ;; If using terminfo, we specify `unknown' because that is ;; a defined terminal type. `emacs' is not a defined terminal type ;; and there is no way for us to define it here. ;; Some programs that use terminfo get very confused ;; if TERM is not a valid terminal type. (if (and (boundp 'system-uses-terminfo) system-uses-terminfo) (list "TERM=unknown" (format "COLUMNS=%d" (frame-width))) (list "TERM=emacs" (format "TERMCAP=emacs:co#%d:tc=unknown:" (frame-width)))) (if (getenv "EMACS") nil (list "EMACS=t")) process-environment)) (default-directory (if (file-directory-p default-directory) default-directory "/"))) (apply 'start-process name buffer command switches))) ;;; Input history processing in a buffer ;;; =========================================================================== ;;; Useful input history functions, courtesy of the Ergo group. ;;; Eleven commands: ;;; comint-dynamic-list-input-ring List history in help buffer. ;;; comint-previous-input Previous input... ;;; comint-previous-matching-input ...matching a string. ;;; comint-previous-matching-input-from-input ... matching the current input. ;;; comint-next-input Next input... ;;; comint-next-matching-input ...matching a string. ;;; comint-next-matching-input-from-input ... matching the current input. ;;; comint-backward-matching-input Backwards input... ;;; comint-forward-matching-input ...matching a string. ;;; comint-replace-by-expanded-history Expand history at point; ;;; replace with expanded history. ;;; comint-magic-space Expand history and insert space. ;;; ;;; Three functions: ;;; comint-read-input-ring Read into comint-input-ring... ;;; comint-write-input-ring Write to comint-input-ring-file-name. ;;; comint-replace-by-expanded-history-before-point Workhorse function. (defun comint-read-input-ring (&optional silent) "Sets the buffer's `comint-input-ring' from a history file. The name of the file is given by the variable `comint-input-ring-file-name'. The history ring is of size `comint-input-ring-size', regardless of file size. If `comint-input-ring-file-name' is nil this function does nothing. If the optional argument SILENT is non-nil, we say nothing about a failure to read the history file. This function is useful for major mode commands and mode hooks. The structure of the history file should be one input command per line, with the most recent command last. See also `comint-input-ignoredups' and `comint-write-input-ring'." (cond ((or (null comint-input-ring-file-name) (equal comint-input-ring-file-name "")) nil) ((not (file-readable-p comint-input-ring-file-name)) (or silent (message "Cannot read history file %s" comint-input-ring-file-name))) (t (let ((history-buf (get-buffer-create " *temp*")) (file comint-input-ring-file-name) (count 0) (ring (make-ring comint-input-ring-size))) (unwind-protect (save-excursion (set-buffer history-buf) (widen) (erase-buffer) (insert-file-contents file) ;; Save restriction in case file is already visited... ;; Watch for those date stamps in history files! (goto-char (point-max)) (while (and (< count comint-input-ring-size) (re-search-backward "^[ \t]*\\([^#\n].*\\)[ \t]*$" nil t)) (let ((history (buffer-substring (match-beginning 1) (match-end 1)))) (if (or (null comint-input-ignoredups) (ring-empty-p ring) (not (string-equal (ring-ref ring 0) history))) (ring-insert-at-beginning ring history))) (setq count (1+ count)))) (kill-buffer history-buf)) (setq comint-input-ring ring comint-input-ring-index nil))))) (defun comint-write-input-ring () "Writes the buffer's `comint-input-ring' to a history file. The name of the file is given by the variable `comint-input-ring-file-name'. The original contents of the file are lost if `comint-input-ring' is not empty. If `comint-input-ring-file-name' is nil this function does nothing. Useful within process sentinels. See also `comint-read-input-ring'." (cond ((or (null comint-input-ring-file-name) (equal comint-input-ring-file-name "") (null comint-input-ring) (ring-empty-p comint-input-ring)) nil) ((not (file-writable-p comint-input-ring-file-name)) (message "Cannot write history file %s" comint-input-ring-file-name)) (t (let* ((history-buf (get-buffer-create " *Temp Input History*")) (ring comint-input-ring) (file comint-input-ring-file-name) (index (ring-length ring))) ;; Write it all out into a buffer first. Much faster, but messier, ;; than writing it one line at a time. (save-excursion (set-buffer history-buf) (erase-buffer) (while (> index 0) (setq index (1- index)) (insert (ring-ref ring index) ?\n)) (write-region (buffer-string) nil file nil 'no-message) (kill-buffer nil)))))) (defun comint-dynamic-list-input-ring () "List in help buffer the buffer's input history." (interactive) (if (or (not (ring-p comint-input-ring)) (ring-empty-p comint-input-ring)) (message "No history") (let ((history nil) (history-buffer " *Input History*") (index (1- (ring-length comint-input-ring))) (conf (current-window-configuration))) ;; We have to build up a list ourselves from the ring vector. (while (>= index 0) (setq history (cons (ring-ref comint-input-ring index) history) index (1- index))) ;; Change "completion" to "history reference" ;; to make the display accurate. (with-output-to-temp-buffer history-buffer (display-completion-list history) (set-buffer history-buffer) (forward-line 3) (while (search-backward "completion" nil 'move) (replace-match "history reference"))) (sit-for 0) (message "Hit space to flush") (let ((ch (read-event))) (if (eq ch ?\ ) (set-window-configuration conf) (setq unread-command-events (list ch))))))) (defun comint-regexp-arg (prompt) ;; Return list of regexp and prefix arg using PROMPT. (let* ((minibuffer-history-sexp-flag nil) ;; Don't clobber this. (last-command last-command) (regexp (read-from-minibuffer prompt nil nil nil 'minibuffer-history-search-history))) (list (if (string-equal regexp "") (setcar minibuffer-history-search-history (nth 1 minibuffer-history-search-history)) regexp) (prefix-numeric-value current-prefix-arg)))) (defun comint-search-arg (arg) ;; First make sure there is a ring and that we are after the process mark (cond ((not (comint-after-pmark-p)) (error "Not at command line")) ((or (null comint-input-ring) (ring-empty-p comint-input-ring)) (error "Empty input ring")) ((zerop arg) ;; arg of zero resets search from beginning, and uses arg of 1 (setq comint-input-ring-index nil) 1) (t arg))) (defun comint-search-start (arg) ;; Index to start a directional search, starting at comint-input-ring-index (if comint-input-ring-index ;; If a search is running, offset by 1 in direction of arg (mod (+ comint-input-ring-index (if (> arg 0) 1 -1)) (ring-length comint-input-ring)) ;; For a new search, start from beginning or end, as appropriate (if (>= arg 0) 0 ; First elt for forward search (1- (ring-length comint-input-ring))))) ; Last elt for backward search (defun comint-previous-input-string (arg) "Return the string ARG places along the input ring. Moves relative to `comint-input-ring-index'." (ring-ref comint-input-ring (if comint-input-ring-index (mod (+ arg comint-input-ring-index) (ring-length comint-input-ring)) arg))) (defun comint-previous-input (arg) "Cycle backwards through input history." (interactive "*p") (comint-previous-matching-input "." arg)) (defun comint-next-input (arg) "Cycle forwards through input history." (interactive "*p") (comint-previous-input (- arg))) (defun comint-previous-matching-input-string (regexp arg) "Return the string matching REGEXP ARG places along the input ring. Moves relative to `comint-input-ring-index'." (let* ((pos (comint-previous-matching-input-string-position regexp arg))) (if pos (ring-ref comint-input-ring pos)))) (defun comint-previous-matching-input-string-position (regexp arg &optional start) "Return the index matching REGEXP ARG places along the input ring. Moves relative to START, or `comint-input-ring-index'." (if (or (not (ring-p comint-input-ring)) (ring-empty-p comint-input-ring)) (error "No history")) (let* ((len (ring-length comint-input-ring)) (motion (if (> arg 0) 1 -1)) (n (mod (- (or start (comint-search-start arg)) motion) len)) (tried-each-ring-item nil) (prev nil)) ;; Do the whole search as many times as the argument says. (while (and (/= arg 0) (not tried-each-ring-item)) ;; Step once. (setq prev n n (mod (+ n motion) len)) ;; If we haven't reached a match, step some more. (while (and (< n len) (not tried-each-ring-item) (not (string-match regexp (ring-ref comint-input-ring n)))) (setq n (mod (+ n motion) len) ;; If we have gone all the way around in this search. tried-each-ring-item (= n prev))) (setq arg (if (> arg 0) (1- arg) (1+ arg)))) ;; Now that we know which ring element to use, if we found it, return that. (if (string-match regexp (ring-ref comint-input-ring n)) n))) (defun comint-previous-matching-input (regexp arg) "Search backwards through input history for match for REGEXP. \(Previous history elements are earlier commands.) With prefix argument N, search for Nth previous match. If N is negative, find the next or Nth next match." (interactive (comint-regexp-arg "Previous input matching (regexp): ")) (setq arg (comint-search-arg arg)) (let ((pos (comint-previous-matching-input-string-position regexp arg))) ;; Has a match been found? (if (null pos) (error "Not found") (setq comint-input-ring-index pos) (message "History item: %d" (1+ pos)) (delete-region ;; Can't use kill-region as it sets this-command (process-mark (get-buffer-process (current-buffer))) (point)) (insert (ring-ref comint-input-ring pos))))) (defun comint-next-matching-input (regexp arg) "Search forwards through input history for match for REGEXP. \(Later history elements are more recent commands.) With prefix argument N, search for Nth following match. If N is negative, find the previous or Nth previous match." (interactive (comint-regexp-arg "Next input matching (regexp): ")) (comint-previous-matching-input regexp (- arg))) (defun comint-previous-matching-input-from-input (arg) "Search backwards through input history for match for current input. \(Previous history elements are earlier commands.) With prefix argument N, search for Nth previous match. If N is negative, search forwards for the -Nth following match." (interactive "p") (if (not (memq last-command '(comint-previous-matching-input-from-input comint-next-matching-input-from-input))) ;; Starting a new search (setq comint-matching-input-from-input-string (buffer-substring (process-mark (get-buffer-process (current-buffer))) (point)) comint-input-ring-index nil)) (comint-previous-matching-input (concat "^" (regexp-quote comint-matching-input-from-input-string)) arg)) (defun comint-next-matching-input-from-input (arg) "Search forwards through input history for match for current input. \(Following history elements are more recent commands.) With prefix argument N, search for Nth following match. If N is negative, search backwards for the -Nth previous match." (interactive "p") (comint-previous-matching-input-from-input (- arg))) (defun comint-replace-by-expanded-history (&optional silent) "Expand input command history references before point. Expansion is dependent on the value of `comint-input-autoexpand'. This function depends on the buffer's idea of the input history, which may not match the command interpreter's idea, assuming it has one. Assumes history syntax is like typical Un*x shells'. However, since emacs cannot know the interpreter's idea of input line numbers, assuming it has one, it cannot expand absolute input line number references. If the optional argument SILENT is non-nil, never complain even if history reference seems erroneous. See `comint-magic-space' and `comint-replace-by-expanded-history-before-point'. Returns t if successful." (interactive) (if (and comint-input-autoexpand (string-match "[!^]" (funcall comint-get-old-input)) (save-excursion (beginning-of-line) (looking-at comint-prompt-regexp))) ;; Looks like there might be history references in the command. (let ((previous-modified-tick (buffer-modified-tick))) (message "Expanding history references...") (comint-replace-by-expanded-history-before-point silent) (/= previous-modified-tick (buffer-modified-tick))))) (defun comint-replace-by-expanded-history-before-point (silent) "Expand directory stack reference before point. See `comint-replace-by-expanded-history'. Returns t if successful." (save-excursion (let ((toend (- (save-excursion (end-of-line nil) (point)) (point))) (start (progn (comint-bol nil) (point)))) (while (progn (skip-chars-forward "^!^" (save-excursion (end-of-line nil) (- (point) toend))) (< (point) (save-excursion (end-of-line nil) (- (point) toend)))) ;; This seems a bit complex. We look for references such as !!, !-num, ;; !foo, !?foo, !{bar}, !?{bar}, ^oh, ^my^, ^god^it, ^never^ends^. ;; If that wasn't enough, the plings can be suffixed with argument ;; range specifiers. ;; Argument ranges are complex too, so we hive off the input line, ;; referenced with plings, with the range string to `comint-args'. (setq comint-input-ring-index nil) (cond ((or (= (preceding-char) ?\\) (comint-within-quotes start (point))) ;; The history is quoted, or we're in quotes. (goto-char (1+ (point)))) ((looking-at "![0-9]+\\($\\|[^-]\\)") ;; We cannot know the interpreter's idea of input line numbers. (goto-char (match-end 0)) (message "Absolute reference cannot be expanded")) ((looking-at "!-\\([0-9]+\\)\\(:?[0-9^$*-]+\\)?") ;; Just a number of args from `number' lines backward. (let ((number (1- (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))))) (if (<= number (ring-length comint-input-ring)) (progn (replace-match (comint-args (comint-previous-input-string number) (match-beginning 2) (match-end 2)) t t) (setq comint-input-ring-index number) (message "History item: %d" (1+ number))) (goto-char (match-end 0)) (message "Relative reference exceeds input history size")))) ((or (looking-at "!!?:?\\([0-9^$*-]+\\)") (looking-at "!!")) ;; Just a number of args from the previous input line. (replace-match (comint-args (comint-previous-input-string 0) (match-beginning 1) (match-end 1)) t t) (message "History item: previous")) ((looking-at "!\\??\\({\\(.+\\)}\\|\\(\\sw+\\)\\)\\(:?[0-9^$*-]+\\)?") ;; Most recent input starting with or containing (possibly ;; protected) string, maybe just a number of args. Phew. (let* ((mb1 (match-beginning 1)) (me1 (match-end 1)) (mb2 (match-beginning 2)) (me2 (match-end 2)) (exp (buffer-substring (or mb2 mb1) (or me2 me1))) (pref (if (save-match-data (looking-at "!\\?")) "" "^")) (pos (save-match-data (comint-previous-matching-input-string-position (concat pref (regexp-quote exp)) 1)))) (if (null pos) (progn (goto-char (match-end 0)) (or silent (progn (message "Not found") (ding)))) (setq comint-input-ring-index pos) (replace-match (comint-args (ring-ref comint-input-ring pos) (match-beginning 4) (match-end 4)) t t) (message "History item: %d" (1+ pos))))) ((looking-at "\\^\\([^^]+\\)\\^?\\([^^]*\\)\\^?") ;; Quick substitution on the previous input line. (let ((old (buffer-substring (match-beginning 1) (match-end 1))) (new (buffer-substring (match-beginning 2) (match-end 2))) (pos nil)) (replace-match (comint-previous-input-string 0) t t) (setq pos (point)) (goto-char (match-beginning 0)) (if (not (search-forward old pos t)) (or silent (error "Not found")) (replace-match new t t) (message "History item: substituted")))) (t (goto-char (match-end 0)))))))) (defun comint-magic-space (arg) "Expand input history references before point and insert ARG spaces. A useful command to bind to SPC. See `comint-replace-by-expanded-history'." (interactive "p") (comint-replace-by-expanded-history) (self-insert-command arg)) (defun comint-within-quotes (beg end) "Return t if the number of quotes between BEG and END is odd. Quotes are single and double." (let ((countsq (comint-how-many-region "\\(^\\|[^\\\\]\\)\'" beg end)) (countdq (comint-how-many-region "\\(^\\|[^\\\\]\\)\"" beg end))) (or (= (mod countsq 2) 1) (= (mod countdq 2) 1)))) (defun comint-how-many-region (regexp beg end) "Return number of matches for REGEXP from BEG to END." (let ((count 0)) (save-excursion (save-match-data (goto-char beg) (while (re-search-forward regexp end t) (setq count (1+ count))))) count)) (defun comint-args (string begin end) ;; From STRING, return the args depending on the range specified in the text ;; from BEGIN to END. If BEGIN is nil, assume all args. Ignore leading `:'. ;; Range can be x-y, x-, -y, where x/y can be [0-9], *, ^, $. (save-match-data (if (null begin) (comint-arguments string 0 nil) (let* ((range (buffer-substring (if (eq (char-after begin) ?:) (1+ begin) begin) end)) (nth (cond ((string-match "^[*^]" range) 1) ((string-match "^-" range) 0) ((string-equal range "$") nil) (t (string-to-number range)))) (mth (cond ((string-match "[-*$]$" range) nil) ((string-match "-" range) (string-to-number (substring range (match-end 0)))) (t nth)))) (comint-arguments string nth mth))))) ;; Return a list of arguments from ARG. Break it up at the ;; delimiters in comint-delimiter-argument-list. Returned list is backwards. (defun comint-delim-arg (arg) (if (null comint-delimiter-argument-list) (list arg) (let ((args nil) (pos 0) (len (length arg))) (while (< pos len) (let ((char (aref arg pos)) (start pos)) (if (memq char comint-delimiter-argument-list) (while (and (< pos len) (eq (aref arg pos) char)) (setq pos (1+ pos))) (while (and (< pos len) (not (memq (aref arg pos) comint-delimiter-argument-list))) (setq pos (1+ pos)))) (setq args (cons (substring arg start pos) args)))) args))) (defun comint-arguments (string nth mth) "Return from STRING the NTH to MTH arguments. NTH and/or MTH can be nil, which means the last argument. Returned arguments are separated by single spaces. We assume whitespace separates arguments, except within quotes. Also, a run of one or more of a single character in `comint-delimiter-argument-list' is a separate argument. Argument 0 is the command name." (let ((argpart "[^ \n\t\"'`]+\\|\\(\"[^\"]*\"\\|'[^']*'\\|`[^`]*`\\)") (args ()) (pos 0) (count 0) beg str value quotes) ;; Build a list of all the args until we have as many as we want. (while (and (or (null mth) (<= count mth)) (string-match argpart string pos)) (if (and beg (= pos (match-beginning 0))) ;; It's contiguous, part of the same arg. (setq pos (match-end 0) quotes (or quotes (match-beginning 1))) ;; It's a new separate arg. (if beg ;; Put the previous arg, if there was one, onto ARGS. (setq str (substring string beg pos) args (if quotes (cons str args) (nconc (comint-delim-arg str) args)) count (1+ count))) (setq quotes (match-beginning 1)) (setq beg (match-beginning 0)) (setq pos (match-end 0)))) (if beg (setq str (substring string beg pos) args (if quotes (cons str args) (nconc (comint-delim-arg str) args)) count (1+ count))) (let ((n (or nth (1- count))) (m (if mth (1- (- count mth)) 0))) (mapconcat (function (lambda (a) a)) (nthcdr n (nreverse (nthcdr m args))) " ")))) ;;; ;;; Input processing stuff ;;; (defun comint-send-input () "Send input to process. After the process output mark, sends all text from the process mark to point as input to the process. Before the process output mark, calls value of variable `comint-get-old-input' to retrieve old input, copies it to the process mark, and sends it. If variable `comint-process-echoes' is nil, a terminal newline is also inserted into the buffer and sent to the process \(if it is non-nil, all text from the process mark to point is deleted, since it is assumed the remote process will re-echo it). Any history reference may be expanded depending on the value of the variable `comint-input-autoexpand'. The list of function names contained in the value of `comint-input-filter-functions' is called on the input before sending it. The input is entered into the input history ring, if the value of variable `comint-input-filter' returns non-nil when called on the input. If variable `comint-eol-on-send' is non-nil, then point is moved to the end of line before sending the input. The values of `comint-get-old-input', `comint-input-filter-functions', and `comint-input-filter' are chosen according to the command interpreter running in the buffer. E.g., If the interpreter is the csh, comint-get-old-input is the default: take the current line, discard any initial string matching regexp comint-prompt-regexp. comint-input-filter-functions monitors input for \"cd\", \"pushd\", and \"popd\" commands. When it sees one, it cd's the buffer. comint-input-filter is the default: returns t if the input isn't all white space. If the comint is Lucid Common Lisp, comint-get-old-input snarfs the sexp ending at point. comint-input-filter-functions does nothing. comint-input-filter returns nil if the input matches input-filter-regexp, which matches (1) all whitespace (2) :a, :c, etc. Similarly for Soar, Scheme, etc." (interactive) ;; Note that the input string does not include its terminal newline. (let ((proc (get-buffer-process (current-buffer)))) (if (not proc) (error "Current buffer has no process") (let* ((pmark (process-mark proc)) (intxt (if (>= (point) (marker-position pmark)) (progn (if comint-eol-on-send (end-of-line)) (buffer-substring pmark (point))) (let ((copy (funcall comint-get-old-input))) (goto-char pmark) (insert copy) copy))) (input (if (not (eq comint-input-autoexpand 'input)) ;; Just whatever's already there intxt ;; Expand and leave it visible in buffer (comint-replace-by-expanded-history t) (buffer-substring pmark (point)))) (history (if (not (eq comint-input-autoexpand 'history)) input ;; This is messy 'cos ultimately the original ;; functions used do insertion, rather than return ;; strings. We have to expand, then insert back. (comint-replace-by-expanded-history t) (let ((copy (buffer-substring pmark (point)))) (delete-region pmark (point)) (insert input) copy)))) (if comint-process-echoes (delete-region pmark (point)) (insert ?\n)) (if (and (funcall comint-input-filter history) (or (null comint-input-ignoredups) (not (ring-p comint-input-ring)) (ring-empty-p comint-input-ring) (not (string-equal (ring-ref comint-input-ring 0) history)))) (ring-insert comint-input-ring history)) (run-hook-with-args 'comint-input-filter-functions (concat input "\n")) (setq comint-input-ring-index nil) ;; Update the markers before we send the input ;; in case we get output amidst sending the input. (set-marker comint-last-input-start pmark) (set-marker comint-last-input-end (point)) (set-marker (process-mark proc) (point)) (funcall comint-input-sender proc input) (comint-output-filter proc ""))))) ;; The purpose of using this filter for comint processes ;; is to keep comint-last-input-end from moving forward ;; when output is inserted. (defun comint-output-filter (process string) ;; First check for killed buffer (let ((oprocbuf (process-buffer process))) (if (and oprocbuf (buffer-name oprocbuf)) (let ((obuf (current-buffer)) (opoint nil) (obeg nil) (oend nil)) (set-buffer oprocbuf) (setq opoint (point)) (setq obeg (point-min)) (setq oend (point-max)) (let ((buffer-read-only nil) (nchars (length string)) (ostart nil)) (widen) (goto-char (process-mark process)) (setq ostart (point)) (if (<= (point) opoint) (setq opoint (+ opoint nchars))) ;; Insert after old_begv, but before old_zv. (if (< (point) obeg) (setq obeg (+ obeg nchars))) (if (<= (point) oend) (setq oend (+ oend nchars))) (insert-before-markers string) ;; Don't insert initial prompt outside the top of the window. (if (= (window-start (selected-window)) (point)) (set-window-start (selected-window) (- (point) (length string)))) (if (and comint-last-input-end (marker-buffer comint-last-input-end) (= (point) comint-last-input-end)) (set-marker comint-last-input-end (- comint-last-input-end nchars))) (set-marker comint-last-output-start ostart) (set-marker (process-mark process) (point)) (force-mode-line-update)) (narrow-to-region obeg oend) (goto-char opoint) (run-hook-with-args 'comint-output-filter-functions string) (set-buffer obuf))))) (defun comint-preinput-scroll-to-bottom () "Go to the end of buffer in all windows showing it. Movement occurs if point in the selected window is not after the process mark, and `this-command' is an insertion command. Insertion commands recognised are `self-insert-command', `comint-magic-space', `yank', and `hilit-yank'. Depends on the value of `comint-scroll-to-bottom-on-input'. This function should be a pre-command hook." (if (and comint-scroll-to-bottom-on-input (memq this-command '(self-insert-command comint-magic-space yank hilit-yank))) (let* ((selected (selected-window)) (current (current-buffer)) (process (get-buffer-process current)) (scroll comint-scroll-to-bottom-on-input)) (if (and process (< (point) (process-mark process))) (if (eq scroll 'this) (goto-char (point-max)) (walk-windows (function (lambda (window) (if (and (eq (window-buffer window) current) (or (eq scroll t) (eq scroll 'all))) (progn (select-window window) (goto-char (point-max)) (select-window selected))))) nil t)))))) (defun comint-postoutput-scroll-to-bottom (string) "Go to the end of buffer in all windows showing it. Does not scroll if the current line is the last line in the buffer. Depends on the value of `comint-scroll-to-bottom-on-output' and `comint-scroll-show-maximum-output'. This function should be in the list `comint-output-filter-functions'." (let* ((selected (selected-window)) (current (current-buffer)) (process (get-buffer-process current)) (scroll comint-scroll-to-bottom-on-output)) (unwind-protect (if process (walk-windows (function (lambda (window) (if (eq (window-buffer window) current) (progn (select-window window) (if (and (< (point) (process-mark process)) (or (eq scroll t) (eq scroll 'all) ;; Maybe user wants point to jump to the end. (and (eq scroll 'this) (eq selected window)) (and (eq scroll 'others) (not (eq selected window))) ;; If point was at the end, keep it at the end. (>= (point) (- (process-mark process) (length string))))) (goto-char (process-mark process))) ;; Optionally scroll so that the text ;; ends at the bottom of the window. (if (and comint-scroll-show-maximum-output (>= (point) (process-mark process))) (save-excursion (goto-char (point-max)) (recenter -1))) (select-window selected))))) nil t)) (set-buffer current)))) (defun comint-truncate-buffer (&optional string) "Truncate the buffer to `comint-buffer-maximum-size'. This function could be on `comint-output-filter-functions' or bound to a key." (interactive) (save-excursion (goto-char (point-max)) (forward-line (- comint-buffer-maximum-size)) (beginning-of-line) (delete-region (point-min) (point)))) (defun comint-strip-ctrl-m (&optional string) "Strip trailing `^M' characters from the current output group. This function could be on `comint-output-filter-functions' or bound to a key." (interactive) (let ((pmark (process-mark (get-buffer-process (current-buffer))))) (save-excursion (goto-char (if (interactive-p) comint-last-input-end comint-last-output-start)) (while (re-search-forward "\r+$" pmark t) (replace-match "" t t))))) (defalias 'shell-strip-ctrl-m 'comint-strip-ctrl-m) (defun comint-show-maximum-output () "Put the end of the buffer at the bottom of the window." (interactive) (goto-char (point-max)) (recenter -1)) (defun comint-get-old-input-default () "Default for `comint-get-old-input'. Take the current line, and discard any initial text matching `comint-prompt-regexp'." (save-excursion (beginning-of-line) (comint-skip-prompt) (let ((beg (point))) (end-of-line) (buffer-substring beg (point))))) (defun comint-copy-old-input () "Insert after prompt old input at point as new input to be edited. Calls `comint-get-old-input' to get old input." (interactive) (let ((input (funcall comint-get-old-input)) (process (get-buffer-process (current-buffer)))) (if (not process) (error "Current buffer has no process") (goto-char (process-mark process)) (insert input)))) (defun comint-skip-prompt () "Skip past the text matching regexp `comint-prompt-regexp'. If this takes us past the end of the current line, don't skip at all." (let ((eol (save-excursion (end-of-line) (point)))) (if (and (looking-at comint-prompt-regexp) (<= (match-end 0) eol)) (goto-char (match-end 0))))) (defun comint-after-pmark-p () "Return t if point is after the process output marker." (let ((pmark (process-mark (get-buffer-process (current-buffer))))) (<= (marker-position pmark) (point)))) (defun comint-simple-send (proc string) "Default function for sending to PROC input STRING. This just sends STRING plus a newline. To override this, set the hook `comint-input-sender'." (comint-send-string proc string) (comint-send-string proc "\n")) (defun comint-bol (arg) "Goes to the beginning of line, then skips past the prompt, if any. If prefix argument is given (\\[universal-argument]) the prompt is not skipped. The prompt skip is done by skipping text matching the regular expression `comint-prompt-regexp', a buffer local variable." (interactive "P") (beginning-of-line) (if (null arg) (comint-skip-prompt))) ;;; These three functions are for entering text you don't want echoed or ;;; saved -- typically passwords to ftp, telnet, or somesuch. ;;; Just enter m-x send-invisible and type in your line, or add ;;; `comint-watch-for-password-prompt' to `comint-output-filter-functions'. (defun comint-read-noecho (prompt &optional stars) "Read a single line of text from user without echoing, and return it. Prompt with argument PROMPT, a string. Optional argument STARS causes input to be echoed with '*' characters on the prompt line. Input ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. C-g aborts (if `inhibit-quit' is set because e.g. this function was called from a process filter and C-g is pressed, this function returns nil rather than a string). Note that the keystrokes comprising the text can still be recovered \(temporarily) with \\[view-lossage]. This may be a security bug for some applications." (let ((ans "") (c 0) (echo-keystrokes 0) (cursor-in-echo-area t) (message-log-max nil) (done nil)) (while (not done) (if stars (message "%s%s" prompt (make-string (length ans) ?*)) (message "%s" prompt)) ;; Use this instead of `read-char' to avoid "Non-character input-event". (setq c (read-char-exclusive)) (cond ((= c ?\C-g) ;; This function may get called from a process filter, where ;; inhibit-quit is set. In later versions of emacs read-char ;; may clear quit-flag itself and return C-g. That would make ;; it impossible to quit this loop in a simple way, so ;; re-enable it here (for backward-compatibility the check for ;; quit-flag below would still be necessary, so this seems ;; like the simplest way to do things). (setq quit-flag t done t)) ((or (= c ?\r) (= c ?\n) (= c ?\e)) (setq done t)) ((= c ?\C-u) (setq ans "")) ((and (/= c ?\b) (/= c ?\177)) (setq ans (concat ans (char-to-string c)))) ((> (length ans) 0) (setq ans (substring ans 0 -1))))) (if quit-flag ;; Emulate a true quit, except that we have to return a value. (prog1 (setq quit-flag nil) (message "Quit") (beep t)) (message "") ans))) (defun send-invisible (str) "Read a string without echoing. Then send it to the process running in the current buffer. A new-line is additionally sent. String is not saved on comint input history list. Security bug: your string can still be temporarily recovered with \\[view-lossage]." (interactive "P") ; Defeat snooping via C-x esc (let ((proc (get-buffer-process (current-buffer)))) (if (not proc) (error "Current buffer has no process") (comint-send-string proc (if (stringp str) str (comint-read-noecho "Non-echoed text: " t))) (comint-send-string proc "\n")))) (defun comint-watch-for-password-prompt (string) "Prompt in the minibuffer for password and send without echoing. This function uses `send-invisible' to read and send a password to the buffer's process if STRING contains a password prompt defined by `comint-password-prompt-regexp'. This function could be in the list `comint-output-filter-functions'." (if (string-match comint-password-prompt-regexp string) (send-invisible nil))) ;;; Low-level process communication (defalias 'comint-send-string 'process-send-string) (defalias 'comint-send-region 'process-send-region) ;;; Random input hackage (defun comint-kill-output () "Kill all output from interpreter since last input. Does not delete the prompt." (interactive) (let ((proc (get-buffer-process (current-buffer))) (replacement nil)) (save-excursion (let ((pmark (progn (goto-char (process-mark proc)) (beginning-of-line nil) (point-marker)))) (delete-region comint-last-input-end pmark) (goto-char (process-mark proc)) (setq replacement (concat "*** output flushed ***\n" (buffer-substring pmark (point)))) (delete-region pmark (point)))) ;; Output message and put back prompt (comint-output-filter proc replacement))) (defun comint-show-output () "Display start of this batch of interpreter output at top of window. Sets mark to the value of point when this command is run." (interactive) (push-mark) (let ((pos (point))) (goto-char (or (marker-position comint-last-input-end) (point-max))) (beginning-of-line 0) (set-window-start (selected-window) (point)) (comint-skip-prompt))) (defun comint-interrupt-subjob () "Interrupt the current subjob." (interactive) (interrupt-process nil comint-ptyp)) (defun comint-kill-subjob () "Send kill signal to the current subjob." (interactive) (kill-process nil comint-ptyp)) (defun comint-quit-subjob () "Send quit signal to the current subjob." (interactive) (quit-process nil comint-ptyp)) (defun comint-stop-subjob () "Stop the current subjob. WARNING: if there is no current subjob, you can end up suspending the top-level process running in the buffer. If you accidentally do this, use \\[comint-continue-subjob] to resume the process. (This is not a problem with most shells, since they ignore this signal.)" (interactive) (stop-process nil comint-ptyp)) (defun comint-continue-subjob () "Send CONT signal to process buffer's process group. Useful if you accidentally suspend the top-level process." (interactive) (continue-process nil comint-ptyp)) (defun comint-kill-input () "Kill all text from last stuff output by interpreter to point." (interactive) (let ((pmark (process-mark (get-buffer-process (current-buffer))))) (if (> (point) (marker-position pmark)) (kill-region pmark (point))))) (defun comint-delchar-or-maybe-eof (arg) "Delete ARG characters forward, or (if at eob) send an EOF to subprocess." (interactive "p") (if (eobp) (process-send-eof) (delete-char arg))) (defun comint-send-eof () "Send an EOF to the current buffer's process." (interactive) (process-send-eof)) (defun comint-backward-matching-input (regexp arg) "Search backward through buffer for match for REGEXP. Matches are searched for on lines that match `comint-prompt-regexp'. With prefix argument N, search for Nth previous match. If N is negative, find the next or Nth next match." (interactive (comint-regexp-arg "Backward input matching (regexp): ")) (let* ((re (concat comint-prompt-regexp ".*" regexp)) (pos (save-excursion (end-of-line (if (> arg 0) 0 1)) (if (re-search-backward re nil t arg) (point))))) (if (null pos) (progn (message "Not found") (ding)) (goto-char pos) (comint-bol nil)))) (defun comint-forward-matching-input (regexp arg) "Search forward through buffer for match for REGEXP. Matches are searched for on lines that match `comint-prompt-regexp'. With prefix argument N, search for Nth following match. If N is negative, find the previous or Nth previous match." (interactive (comint-regexp-arg "Forward input matching (regexp): ")) (comint-backward-matching-input regexp (- arg))) (defun comint-next-prompt (n) "Move to end of Nth next prompt in the buffer. See `comint-prompt-regexp'." (interactive "p") (let ((paragraph-start comint-prompt-regexp)) (end-of-line (if (> n 0) 1 0)) (forward-paragraph n) (comint-skip-prompt))) (defun comint-previous-prompt (n) "Move to end of Nth previous prompt in the buffer. See `comint-prompt-regexp'." (interactive "p") (comint-next-prompt (- n))) ;;; Support for source-file processing commands. ;;;============================================================================ ;;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have ;;; commands that process files of source text (e.g. loading or compiling ;;; files). So the corresponding process-in-a-buffer modes have commands ;;; for doing this (e.g., lisp-load-file). The functions below are useful ;;; for defining these commands. ;;; ;;; Alas, these guys don't do exactly the right thing for Lisp, Scheme ;;; and Soar, in that they don't know anything about file extensions. ;;; So the compile/load interface gets the wrong default occasionally. ;;; The load-file/compile-file default mechanism could be smarter -- it ;;; doesn't know about the relationship between filename extensions and ;;; whether the file is source or executable. If you compile foo.lisp ;;; with compile-file, then the next load-file should use foo.bin for ;;; the default, not foo.lisp. This is tricky to do right, particularly ;;; because the extension for executable files varies so much (.o, .bin, ;;; .lbin, .mo, .vo, .ao, ...). ;;; COMINT-SOURCE-DEFAULT -- determines defaults for source-file processing ;;; commands. ;;; ;;; COMINT-CHECK-SOURCE -- if FNAME is in a modified buffer, asks you if you ;;; want to save the buffer before issuing any process requests to the command ;;; interpreter. ;;; ;;; COMINT-GET-SOURCE -- used by the source-file processing commands to prompt ;;; for the file to process. ;;; (COMINT-SOURCE-DEFAULT previous-dir/file source-modes) ;;;============================================================================ ;;; This function computes the defaults for the load-file and compile-file ;;; commands for tea, soar, cmulisp, and cmuscheme modes. ;;; ;;; - PREVIOUS-DIR/FILE is a pair (directory . filename) from the last ;;; source-file processing command. NIL if there hasn't been one yet. ;;; - SOURCE-MODES is a list used to determine what buffers contain source ;;; files: if the major mode of the buffer is in SOURCE-MODES, it's source. ;;; Typically, (lisp-mode) or (scheme-mode). ;;; ;;; If the command is given while the cursor is inside a string, *and* ;;; the string is an existing filename, *and* the filename is not a directory, ;;; then the string is taken as default. This allows you to just position ;;; your cursor over a string that's a filename and have it taken as default. ;;; ;;; If the command is given in a file buffer whose major mode is in ;;; SOURCE-MODES, then the the filename is the default file, and the ;;; file's directory is the default directory. ;;; ;;; If the buffer isn't a source file buffer (e.g., it's the process buffer), ;;; then the default directory & file are what was used in the last source-file ;;; processing command (i.e., PREVIOUS-DIR/FILE). If this is the first time ;;; the command has been run (PREVIOUS-DIR/FILE is nil), the default directory ;;; is the cwd, with no default file. (\"no default file\" = nil) ;;; ;;; SOURCE-REGEXP is typically going to be something like (tea-mode) ;;; for T programs, (lisp-mode) for Lisp programs, (soar-mode lisp-mode) ;;; for Soar programs, etc. ;;; ;;; The function returns a pair: (default-directory . default-file). (defun comint-source-default (previous-dir/file source-modes) (cond ((and buffer-file-name (memq major-mode source-modes)) (cons (file-name-directory buffer-file-name) (file-name-nondirectory buffer-file-name))) (previous-dir/file) (t (cons default-directory nil)))) ;;; (COMINT-CHECK-SOURCE fname) ;;;============================================================================ ;;; Prior to loading or compiling (or otherwise processing) a file (in the CMU ;;; process-in-a-buffer modes), this function can be called on the filename. ;;; If the file is loaded into a buffer, and the buffer is modified, the user ;;; is queried to see if he wants to save the buffer before proceeding with ;;; the load or compile. (defun comint-check-source (fname) (let ((buff (get-file-buffer fname))) (if (and buff (buffer-modified-p buff) (y-or-n-p (format "Save buffer %s first? " (buffer-name buff)))) ;; save BUFF. (let ((old-buffer (current-buffer))) (set-buffer buff) (save-buffer) (set-buffer old-buffer))))) ;;; (COMINT-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p) ;;;============================================================================ ;;; COMINT-GET-SOURCE is used to prompt for filenames in command-interpreter ;;; commands that process source files (like loading or compiling a file). ;;; It prompts for the filename, provides a default, if there is one, ;;; and returns the result filename. ;;; ;;; See COMINT-SOURCE-DEFAULT for more on determining defaults. ;;; ;;; PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair ;;; from the last source processing command. SOURCE-MODES is a list of major ;;; modes used to determine what file buffers contain source files. (These ;;; two arguments are used for determining defaults). If MUSTMATCH-P is true, ;;; then the filename reader will only accept a file that exists. ;;; ;;; A typical use: ;;; (interactive (comint-get-source "Compile file: " prev-lisp-dir/file ;;; '(lisp-mode) t)) ;;; This is pretty stupid about strings. It decides we're in a string ;;; if there's a quote on both sides of point on the current line. (defun comint-extract-string () "Return string around POINT that starts the current line, or nil." (save-excursion (let* ((point (point)) (bol (progn (beginning-of-line) (point))) (eol (progn (end-of-line) (point))) (start (progn (goto-char point) (and (search-backward "\"" bol t) (1+ (point))))) (end (progn (goto-char point) (and (search-forward "\"" eol t) (1- (point)))))) (and start end (buffer-substring start end))))) (defun comint-get-source (prompt prev-dir/file source-modes mustmatch-p) (let* ((def (comint-source-default prev-dir/file source-modes)) (stringfile (comint-extract-string)) (sfile-p (and stringfile (condition-case () (file-exists-p stringfile) (error nil)) (not (file-directory-p stringfile)))) (defdir (if sfile-p (file-name-directory stringfile) (car def))) (deffile (if sfile-p (file-name-nondirectory stringfile) (cdr def))) (ans (read-file-name (if deffile (format "%s(default %s) " prompt deffile) prompt) defdir (concat defdir deffile) mustmatch-p))) (list (expand-file-name (substitute-in-file-name ans))))) ;;; I am somewhat divided on this string-default feature. It seems ;;; to violate the principle-of-least-astonishment, in that it makes ;;; the default harder to predict, so you actually have to look and see ;;; what the default really is before choosing it. This can trip you up. ;;; On the other hand, it can be useful, I guess. I would appreciate feedback ;;; on this. ;;; -Olin ;;; Simple process query facility. ;;; =========================================================================== ;;; This function is for commands that want to send a query to the process ;;; and show the response to the user. For example, a command to get the ;;; arglist for a Common Lisp function might send a "(arglist 'foo)" query ;;; to an inferior Common Lisp process. ;;; ;;; This simple facility just sends strings to the inferior process and pops ;;; up a window for the process buffer so you can see what the process ;;; responds with. We don't do anything fancy like try to intercept what the ;;; process responds with and put it in a pop-up window or on the message ;;; line. We just display the buffer. Low tech. Simple. Works good. ;;; Send to the inferior process PROC the string STR. Pop-up but do not select ;;; a window for the inferior process so that its response can be seen. (defun comint-proc-query (proc str) (let* ((proc-buf (process-buffer proc)) (proc-mark (process-mark proc))) (display-buffer proc-buf) (set-buffer proc-buf) ; but it's not the selected *window* (let ((proc-win (get-buffer-window proc-buf)) (proc-pt (marker-position proc-mark))) (comint-send-string proc str) ; send the query (accept-process-output proc) ; wait for some output ;; Try to position the proc window so you can see the answer. ;; This is bogus code. If you delete the (sit-for 0), it breaks. ;; I don't know why. Wizards invited to improve it. (if (not (pos-visible-in-window-p proc-pt proc-win)) (let ((opoint (window-point proc-win))) (set-window-point proc-win proc-mark) (sit-for 0) (if (not (pos-visible-in-window-p opoint proc-win)) (push-mark opoint) (set-window-point proc-win opoint))))))) ;;; Filename/command/history completion in a buffer ;;; =========================================================================== ;;; Useful completion functions, courtesy of the Ergo group. ;;; Six commands: ;;; comint-dynamic-complete Complete or expand command, filename, ;;; history at point. ;;; comint-dynamic-complete-filename Complete filename at point. ;;; comint-dynamic-list-filename-completions List completions in help buffer. ;;; comint-replace-by-expanded-filename Expand and complete filename at point; ;;; replace with expanded/completed name. ;;; comint-dynamic-simple-complete Complete stub given candidates. ;;; These are not installed in the comint-mode keymap. But they are ;;; available for people who want them. Shell-mode installs them: ;;; (define-key shell-mode-map "\t" 'comint-dynamic-complete) ;;; (define-key shell-mode-map "\M-?" ;;; 'comint-dynamic-list-filename-completions))) ;;; ;;; Commands like this are fine things to put in load hooks if you ;;; want them present in specific modes. (defvar comint-completion-autolist nil "*If non-nil, automatically list possiblities on partial completion. This mirrors the optional behavior of tcsh.") (defvar comint-completion-addsuffix t "*If non-nil, add a `/' to completed directories, ` ' to file names. If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact completion. This mirrors the optional behavior of tcsh.") (defvar comint-completion-recexact nil "*If non-nil, use shortest completion if characters cannot be added. This mirrors the optional behavior of tcsh. A non-nil value is useful if `comint-completion-autolist' is non-nil too.") (defvar comint-completion-fignore nil "*List of suffixes to be disregarded during file completion. This mirrors the optional behavior of bash and tcsh. Note that this applies to `comint-dynamic-complete-filename' only.") (defvar comint-file-name-prefix "" "Prefix prepended to absolute file names taken from process input. This is used by comint's and shell's completion functions, and by shell's directory tracking functions.") (defvar comint-file-name-quote-list nil "List of characters to quote with `\' when in a file name. This is a good thing to set in mode hooks.") (defun comint-directory (directory) ;; Return expanded DIRECTORY, with `comint-file-name-prefix' if absolute. (expand-file-name (if (file-name-absolute-p directory) (concat comint-file-name-prefix directory) directory))) (defun comint-word (word-chars) "Return the word of WORD-CHARS at point, or nil if non is found. Word constituents are considered to be those in WORD-CHARS, which is like the inside of a \"[...]\" (see `skip-chars-forward')." (save-excursion (let ((non-word-chars (concat "[^\\\\" word-chars "]")) (here (point))) (while (and (re-search-backward non-word-chars nil 'move) ;(memq (char-after (point)) shell-file-name-quote-list) (eq (preceding-char) ?\\)) (backward-char 1)) ;; Don't go forward over a word-char (this can happen if we're at bob). (if (or (not (bobp)) (looking-at non-word-chars)) (forward-char 1)) ;; Set match-data to match the entire string. (if (< (point) here) (progn (store-match-data (list (point) here)) (match-string 0)))))) (defun comint-match-partial-filename () "Return the filename at point, or nil if non is found. Environment variables are substituted. See `comint-word'." (let ((filename (comint-word "~/A-Za-z0-9+@:_.$#%,={}-"))) (and filename (substitute-in-file-name (comint-unquote-filename filename))))) (defun comint-quote-filename (filename) "Return FILENAME with magic characters quoted. Magic characters are those in `comint-file-name-quote-list'." (if (null comint-file-name-quote-list) filename (let ((regexp (format "\\(^\\|[^\\]\\)\\([%s]\\)" (mapconcat 'char-to-string comint-file-name-quote-list "")))) (save-match-data (while (string-match regexp filename) (setq filename (replace-match "\\1\\\\\\2" nil nil filename))) filename)))) (defun comint-unquote-filename (filename) "Return FILENAME with quoted characters unquoted." (if (null comint-file-name-quote-list) filename (save-match-data (while (string-match "\\\\\\(.\\)" filename) (setq filename (replace-match "\\1" nil nil filename))) filename))) (defun comint-dynamic-complete () "Dynamically perform completion at point. Calls the functions in `comint-dynamic-complete-functions' to perform completion until a function returns non-nil, at which point completion is assumed to have occurred." (interactive) (run-hook-with-args-until-success 'comint-dynamic-complete-functions)) (defun comint-dynamic-complete-filename () "Dynamically complete the filename at point. Completes if after a filename. See `comint-match-partial-filename' and `comint-dynamic-complete-as-filename'. This function is similar to `comint-replace-by-expanded-filename', except that it won't change parts of the filename already entered in the buffer; it just adds completion characters to the end of the filename. A completions listing may be shown in a help buffer if completion is ambiguous. Completion is dependent on the value of `comint-completion-addsuffix', `comint-completion-recexact' and `comint-completion-fignore', and the timing of completions listing is dependent on the value of `comint-completion-autolist'. Returns t if successful." (interactive) (if (comint-match-partial-filename) (prog2 (or (window-minibuffer-p (selected-window)) (message "Completing file name...")) (comint-dynamic-complete-as-filename)))) (defun comint-dynamic-complete-as-filename () "Dynamically complete at point as a filename. See `comint-dynamic-complete-filename'. Returns t if successful." (let* ((completion-ignore-case nil) (completion-ignored-extensions comint-completion-fignore) (file-name-handler-alist nil) (minibuffer-p (window-minibuffer-p (selected-window))) (success t) (dirsuffix (cond ((not comint-completion-addsuffix) "") ((not (consp comint-completion-addsuffix)) "/") (t (car comint-completion-addsuffix)))) (filesuffix (cond ((not comint-completion-addsuffix) "") ((not (consp comint-completion-addsuffix)) " ") (t (cdr comint-completion-addsuffix)))) (filename (or (comint-match-partial-filename) "")) (pathdir (file-name-directory filename)) (pathnondir (file-name-nondirectory filename)) (directory (if pathdir (comint-directory pathdir) default-directory)) (completion (file-name-completion pathnondir directory))) (cond ((null completion) (message "No completions of %s" filename) (setq success nil)) ((eq completion t) ; Means already completed "file". (insert filesuffix) (or minibuffer-p (message "Sole completion"))) ((string-equal completion "") ; Means completion on "directory/". (comint-dynamic-list-filename-completions)) (t ; Completion string returned. (let ((file (concat (file-name-as-directory directory) completion))) (insert (comint-quote-filename (substring (directory-file-name completion) (length pathnondir)))) (cond ((symbolp (file-name-completion completion directory)) ;; We inserted a unique completion. (insert (if (file-directory-p file) dirsuffix filesuffix)) (or minibuffer-p (message "Completed"))) ((and comint-completion-recexact comint-completion-addsuffix (string-equal pathnondir completion) (file-exists-p file)) ;; It's not unique, but user wants shortest match. (insert (if (file-directory-p file) dirsuffix filesuffix)) (or minibuffer-p (message "Completed shortest"))) ((or comint-completion-autolist (string-equal pathnondir completion)) ;; It's not unique, list possible completions. (comint-dynamic-list-filename-completions)) (t (or minibuffer-p (message "Partially completed"))))))) success)) (defun comint-replace-by-expanded-filename () "Dynamically expand and complete the filename at point. Replace the filename with an expanded, canonicalised and completed replacement. \"Expanded\" means environment variables (e.g., $HOME) and `~'s are replaced with the corresponding directories. \"Canonicalised\" means `..' and `.' are removed, and the filename is made absolute instead of relative. For expansion see `expand-file-name' and `substitute-in-file-name'. For completion see `comint-dynamic-complete-filename'." (interactive) (replace-match (expand-file-name (comint-match-partial-filename)) t t) (comint-dynamic-complete-filename)) (defun comint-dynamic-simple-complete (stub candidates) "Dynamically complete STUB from CANDIDATES list. This function inserts completion characters at point by completing STUB from the strings in CANDIDATES. A completions listing may be shown in a help buffer if completion is ambiguous. Returns nil if no completion was inserted. Returns `sole' if completed with the only completion match. Returns `shortest' if completed with the shortest of the completion matches. Returns `partial' if completed as far as possible with the completion matches. Returns `listed' if a completion listing was shown. See also `comint-dynamic-complete-filename'." (let* ((completion-ignore-case nil) (suffix (cond ((not comint-completion-addsuffix) "") ((not (consp comint-completion-addsuffix)) " ") (t (cdr comint-completion-addsuffix)))) (candidates (mapcar (function (lambda (x) (list x))) candidates)) (completions (all-completions stub candidates))) (cond ((null completions) (message "No completions of %s" stub) nil) ((= 1 (length completions)) ; Gotcha! (let ((completion (car completions))) (if (string-equal completion stub) (message "Sole completion") (insert (substring completion (length stub))) (message "Completed")) (insert suffix) 'sole)) (t ; There's no unique completion. (let ((completion (try-completion stub candidates))) ;; Insert the longest substring. (insert (substring completion (length stub))) (cond ((and comint-completion-recexact comint-completion-addsuffix (string-equal stub completion) (member completion completions)) ;; It's not unique, but user wants shortest match. (insert suffix) (message "Completed shortest") 'shortest) ((or comint-completion-autolist (string-equal stub completion)) ;; It's not unique, list possible completions. (comint-dynamic-list-completions completions) 'listed) (t (message "Partially completed") 'partial))))))) (defun comint-dynamic-list-filename-completions () "List in help buffer possible completions of the filename at point." (interactive) (let* ((completion-ignore-case nil) (file-name-handler-alist nil) (filename (or (comint-match-partial-filename) "")) (pathdir (file-name-directory filename)) (pathnondir (file-name-nondirectory filename)) (directory (if pathdir (comint-directory pathdir) default-directory)) (completions (file-name-all-completions pathnondir directory))) (if (not completions) (message "No completions of %s" filename) (comint-dynamic-list-completions (mapcar 'comint-quote-filename completions))))) (defun comint-dynamic-list-completions (completions) "List in help buffer sorted COMPLETIONS. Typing SPC flushes the help buffer." (let ((conf (current-window-configuration))) (with-output-to-temp-buffer "*Completions*" (display-completion-list (sort completions 'string-lessp))) (message "Hit space to flush") (let (key first) (if (save-excursion (set-buffer (get-buffer "*Completions*")) (setq key (read-key-sequence nil) first (aref key 0)) (and (consp first) (consp (event-start first)) (eq (window-buffer (posn-window (event-start first))) (get-buffer "*Completions*")) (eq (key-binding key) 'mouse-choose-completion))) ;; If the user does mouse-choose-completion with the mouse, ;; execute the command, then delete the completion window. (progn (mouse-choose-completion first) (set-window-configuration conf)) (if (eq first ?\ ) (set-window-configuration conf) (setq unread-command-events (listify-key-sequence key))))))) ;;; Converting process modes to use comint mode ;;; =========================================================================== ;;; The code in the Emacs 19 distribution has all been modified to use comint ;;; where needed. However, there are `third-party' packages out there that ;;; still use the old shell mode. Here's a guide to conversion. ;;; ;;; Renaming variables ;;; Most of the work is renaming variables and functions. These are the common ;;; ones: ;;; Local variables: ;;; last-input-start comint-last-input-start ;;; last-input-end comint-last-input-end ;;; shell-prompt-pattern comint-prompt-regexp ;;; shell-set-directory-error-hook ;;; Miscellaneous: ;;; shell-set-directory ;;; shell-mode-map comint-mode-map ;;; Commands: ;;; shell-send-input comint-send-input ;;; shell-send-eof comint-delchar-or-maybe-eof ;;; kill-shell-input comint-kill-input ;;; interrupt-shell-subjob comint-interrupt-subjob ;;; stop-shell-subjob comint-stop-subjob ;;; quit-shell-subjob comint-quit-subjob ;;; kill-shell-subjob comint-kill-subjob ;;; kill-output-from-shell comint-kill-output ;;; show-output-from-shell comint-show-output ;;; copy-last-shell-input Use comint-previous-input/comint-next-input ;;; ;;; SHELL-SET-DIRECTORY is gone, its functionality taken over by ;;; SHELL-DIRECTORY-TRACKER, the shell mode's comint-input-filter-functions. ;;; Comint mode does not provide functionality equivalent to ;;; shell-set-directory-error-hook; it is gone. ;;; ;;; comint-last-input-start is provided for modes which want to munge ;;; the buffer after input is sent, perhaps because the inferior ;;; insists on echoing the input. The LAST-INPUT-START variable in ;;; the old shell package was used to implement a history mechanism, ;;; but you should think twice before using comint-last-input-start ;;; for this; the input history ring often does the job better. ;;; ;;; If you are implementing some process-in-a-buffer mode, called foo-mode, do ;;; *not* create the comint-mode local variables in your foo-mode function. ;;; This is not modular. Instead, call comint-mode, and let *it* create the ;;; necessary comint-specific local variables. Then create the ;;; foo-mode-specific local variables in foo-mode. Set the buffer's keymap to ;;; be foo-mode-map, and its mode to be foo-mode. Set the comint-mode hooks ;;; (comint-{prompt-regexp, input-filter, input-filter-functions, ;;; get-old-input) that need to be different from the defaults. Call ;;; foo-mode-hook, and you're done. Don't run the comint-mode hook yourself; ;;; comint-mode will take care of it. The following example, from shell.el, ;;; is typical: ;;; ;;; (defvar shell-mode-map '()) ;;; (cond ((not shell-mode-map) ;;; (setq shell-mode-map (copy-keymap comint-mode-map)) ;;; (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command) ;;; (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command) ;;; (define-key shell-mode-map "\t" 'comint-dynamic-complete) ;;; (define-key shell-mode-map "\M-?" ;;; 'comint-dynamic-list-filename-completions))) ;;; ;;; (defun shell-mode () ;;; (interactive) ;;; (comint-mode) ;;; (setq comint-prompt-regexp shell-prompt-pattern) ;;; (setq major-mode 'shell-mode) ;;; (setq mode-name "Shell") ;;; (use-local-map shell-mode-map) ;;; (make-local-variable 'shell-directory-stack) ;;; (setq shell-directory-stack nil) ;;; (add-hook 'comint-input-filter-functions 'shell-directory-tracker) ;;; (run-hooks 'shell-mode-hook)) ;;; ;;; ;;; Note that make-comint is different from make-shell in that it ;;; doesn't have a default program argument. If you give make-shell ;;; a program name of NIL, it cleverly chooses one of explicit-shell-name, ;;; $ESHELL, $SHELL, or /bin/sh. If you give make-comint a program argument ;;; of NIL, it barfs. Adjust your code accordingly... ;;; ;;; Completion for comint-mode users ;;; ;;; For modes that use comint-mode, comint-dynamic-complete-functions is the ;;; hook to add completion functions to. Functions on this list should return ;;; non-nil if completion occurs (i.e., further completion should not occur). ;;; You could use comint-dynamic-simple-complete to do the bulk of the ;;; completion job. (provide 'comint) ;;; comint.el ends here emacs-19.30/lisp/compare-w.el100444 12120 1 13517 5663742656 14335 0ustar rmsdaemon;;; compare-w.el --- compare text between windows for Emacs. ;; Copyright (C) 1986, 1989, 1993 Free Software Foundation, Inc. ;; Maintainer: FSF ;; 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 package provides one entry point, compare-windows. It compares ;; text starting from point in two adjacent windows, advancing point ;; until it finds a difference. Option variables permit you to ignore ;; whitespace differences, or case differences, or both. ;;; Code: (defvar compare-windows-whitespace "[ \t\n]+" "*Regexp that defines whitespace sequences for \\[compare-windows]. Changes in whitespace are optionally ignored. The value of `compare-windows-whitespace' may instead be a function; this function is called in each buffer, with point at the current scanning point. The function's job is to categorize any whitespace around (including before) point; it should also advance past any whitespace. The function is passed one argument, the point where `compare-windows' was originally called; it should not consider any text before that point. If the function returns the same value for both buffers, then the whitespace is considered to match, and is skipped.") (defvar compare-ignore-case nil "*Non-nil means \\[compare-windows] ignores case differences.") ;;;###autoload (defun compare-windows (ignore-whitespace) "Compare text in current window with text in next window. Compares the text starting at point in each window, moving over text in each one as far as they match. This command pushes the mark in each window at the prior location of point in that window. If both windows display the same buffer, the mark is pushed twice in that buffer: first in the other window, then in the selected window. A prefix arg means ignore changes in whitespace. The variable `compare-windows-whitespace' controls how whitespace is skipped. If `compare-ignore-case' is non-nil, changes in case are also ignored." (interactive "P") (let* (p1 p2 maxp1 maxp2 b1 b2 w2 success size (opoint1 (point)) opoint2 (skip-whitespace (if ignore-whitespace compare-windows-whitespace))) (setq p1 (point) b1 (current-buffer)) (setq w2 (next-window (selected-window))) (if (eq w2 (selected-window)) (error "No other window")) (setq p2 (window-point w2) b2 (window-buffer w2)) (setq opoint2 p2) (setq maxp1 (point-max)) (save-excursion (set-buffer b2) (push-mark p2 t) (setq maxp2 (point-max))) (push-mark) (setq success t) (while success (setq success nil) ;; if interrupted, show how far we've gotten (goto-char p1) (set-window-point w2 p2) ;; If both buffers have whitespace next to point, ;; optionally skip over it. (and skip-whitespace (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)) (if (or (stringp skip-whitespace) (and result1 result2 (eq result1 result2))) (setq p1 p1a p2 p2a))))) ;; Try advancing comparing 1000 chars at a time. ;; When that fails, go 500 chars at a time, and so on. (let ((size 1000) success-1 (case-fold-search compare-ignore-case)) (while (> size 0) (setq success-1 t) ;; Try comparing SIZE chars at a time, repeatedly, till that fails. (while success-1 (setq size (min size (- maxp1 p1) (- maxp2 p2))) (setq success-1 (and (> size 0) (= 0 (compare-buffer-substrings b2 p2 (+ size p2) b1 p1 (+ size p1))))) (if success-1 (setq p1 (+ p1 size) p2 (+ p2 size) success t))) ;; If SIZE chars don't match, try fewer. (setq size (/ size 2))))) (goto-char p1) (set-window-point w2 p2) (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. ;; If there is whitespace before point, but none after, ;; then return t, but don't advance point. (defun compare-windows-skip-whitespace (start) (let ((end (point)) (beg (point)) (opoint (point))) (while (or (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))) (and (/= (point) start) ;; Consider at least the char before point, ;; unless it is also before START. (= (point) opoint))) ;; keep going back until whitespace ;; doesn't extend to or past end (forward-char -1)) (setq beg (point)) (goto-char end) (or (/= beg opoint) (/= end opoint)))) (provide 'compare-w) ;;; compare-w.el ends here emacs-19.30/lisp/compile.el100444 12120 1 163017 6052010562 14065 0ustar rmsdaemon;;; compile.el --- run compiler as inferior of Emacs, parse error messages. ;; Copyright (C) 1985, 86, 87, 93, 94, 1995 Free Software Foundation, Inc. ;; Author: Roland McGrath ;; Maintainer: FSF ;; Keywords: tools, processes ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; This package provides the compile and grep facilities documented in ;; the Emacs user's manual. ;;; Code: ;;;###autoload (defvar compilation-mode-hook nil "*List of hook functions run by `compilation-mode' (see `run-hooks').") ;;;###autoload (defvar compilation-window-height nil "*Number of lines in a compilation window. If nil, use Emacs default.") (defvar compilation-error-list nil "List of error message descriptors for visiting erring functions. Each error descriptor is a cons (or nil). Its car is a marker pointing to an error message. If its cdr is a marker, it points to the text of the line the message is about. If its cdr is a cons, it is a list \(\(DIRECTORY . FILE\) LINE [COLUMN]\). Or its cdr may be nil if that error is not interesting. The value may be t instead of a list; this means that the buffer of error messages should be reparsed the next time the list of errors is wanted. Some other commands (like `diff') use this list to control the error message tracking facilites; if you change its structure, you should make sure you also change those packages. Perhaps it is better not to change it at all.") (defvar compilation-old-error-list nil "Value of `compilation-error-list' after errors were parsed.") (defvar compilation-parse-errors-function 'compilation-parse-errors "Function to call to parse error messages from a compilation. It takes args LIMIT-SEARCH and FIND-AT-LEAST. If LIMIT-SEARCH is non-nil, don't bother parsing past that location. If FIND-AT-LEAST is non-nil, don't bother parsing after finding that many new errors. It should read in the source files which have errors and set `compilation-error-list' to a list with an element for each error message found. See that variable for more info.") ;;;###autoload (defvar compilation-buffer-name-function nil "Function to compute the name of a compilation buffer. The function receives one argument, the name of the major mode of the compilation buffer. It should return a string. nil means compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.") ;;;###autoload (defvar compilation-finish-function nil "*Function to call when a compilation process finishes. It is called with two arguments: the compilation buffer, and a string describing how the process finished.") (defvar compilation-last-buffer nil "The most recent compilation buffer. A buffer becomes most recent when its compilation is started or when it is used with \\[next-error] or \\[compile-goto-error].") (defvar compilation-in-progress nil "List of compilation processes now running.") (or (assq 'compilation-in-progress minor-mode-alist) (setq minor-mode-alist (cons '(compilation-in-progress " Compiling") minor-mode-alist))) (defvar compilation-parsing-end nil "Position of end of buffer when last error messages were parsed.") (defvar compilation-error-message "No more errors" "Message to print when no more matches are found.") (defvar compilation-num-errors-found) (defvar compilation-error-regexp-alist '( ;; NOTE! See also grep-regexp-alist, below. ;; 4.3BSD grep, cc, lint pass 1: ;; /usr/src/foo/foo.c(8): warning: w may be used before set ;; or GNU utilities: ;; foo.c:8: error message ;; or HP-UX 7.0 fc: ;; foo.f :16 some horrible error message ;; or GNU utilities with column (GNAT 1.82): ;; foo.adb:2:1: Unit name does not match file name ;; ;; We'll insist that the number be followed by a colon or closing ;; paren, because otherwise this matches just about anything ;; containing a number with spaces around it. ("\n\ \\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\ :\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 2 5) ;; Borland C++: ;; Error ping.c 15: Unable to open include file 'sys/types.h' ;; Warning ping.c 68: Call to function 'func' with no prototype ("\n\\(Error\\|Warning\\) \\([^:( \t\n]+\\)\ \\([0-9]+\\)\\([) \t]\\|:[^0-9\n]\\)" 2 3) ;; 4.3BSD lint pass 2 ;; strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8) ("[ \t:]\\([^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$" 1 2) ;; 4.3BSD lint pass 3 ;; bloofle defined( /users/wolfgang/foo.c(4) ), but never used ;; This used to be ;; ("[ \t(]+\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2) ;; which is regexp Impressionism - it matches almost anything! ("([ \t]*\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\))" 1 2) ;; Ultrix 3.0 f77: ;; fort: Severe: addstf.f, line 82: Missing operator or delimiter symbol ;; Some SGI cc version: ;; cfe: Warning 835: foo.c, line 2: something ("\n\\(cfe\\|fort\\): [^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3) ;; Error on line 3 of t.f: Execution error unclassifiable statement ;; Unknown who does this: ;; Line 45 of "foo.c": bloofel undefined ;; Absoft FORTRAN 77 Compiler 3.1.3 ;; error on line 19 of fplot.f: spelling error? ;; warning on line 17 of fplot.f: data type is undefined for variable d ("\\(\n\\|on \\)[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\ of[ \t]+\"?\\([^\":\n]+\\)\"?:" 3 2) ;; Apollo cc, 4.3BSD fc: ;; "foo.f", line 3: Error: syntax error near end of statement ;; IBM RS6000: ;; "vvouch.c", line 19.5: 1506-046 (S) Syntax error. ;; Unknown compiler: ;; File "foobar.ml", lines 5-8, characters 20-155: blah blah ;; Microtec mcc68k: ;; "foo.c", line 32 pos 1; (E) syntax error; unexpected symbol: "lossage" ;; GNAT (as of July 94): ;; "foo.adb", line 2(11): warning: file name does not match ... ("\"\\([^,\" \n\t]+\\)\", lines? \\([0-9]+\\)[:., (-]" 1 2) ;; MIPS RISC CC - the one distributed with Ultrix: ;; ccom: Error: foo.c, line 2: syntax error ;; DEC AXP OSF/1 cc ;; /usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah ("rror: \\([^,\" \n\t]+\\)[,:] \\(line \\)?\\([0-9]+\\):" 1 3) ;; IBM AIX PS/2 C version 1.1: ;; ****** Error number 140 in line 8 of file errors.c ****** ("in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1) ;; IBM AIX lint is too painful to do right this way. File name ;; prefixes entire sections rather than being on each line. ;; Lucid Compiler, lcc 3.x ;; E, file.cc(35,52) Illegal operation on pointers ("\n[EW], \\([^(\n]*\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 1 2 3) ;; GNU messages with program name and optional column number. ("\n[^0-9 \n\t:]+:[ \t]*\\([^ \n\t:]+\\):\ \\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4) ;; Cray C compiler error messages ("\n\\(cc\\| cft\\)-[0-9]+ c\\(c\\|f77\\): ERROR \\([^,\n]+, \\)* File = \\([^,\n]+\\), Line = \\([0-9]+\\)" 4 5) ;; IBM C/C++ Tools 2.01: ;; foo.c(2:0) : informational EDC0804: Function foo is not referenced. ;; foo.c(3:8) : warning EDC0833: Implicit return statement encountered. ;; foo.c(5:5) : error EDC0350: Syntax error. ("\n\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) : " 1 2 3) ;; Sun ada (VADS, Solaris): ;; /home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: "," inserted ("\n\\([^, ]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3) ) "Alist that specifies how to match errors in compiler output. Each elt has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX FILE-FORMAT...]) If REGEXP matches, the FILE-IDX'th subexpression gives the file name, and the LINE-IDX'th subexpression gives the line number. If COLUMN-IDX is given, the COLUMN-IDX'th subexpression gives the column number on that line. If any FILE-FORMAT is given, each is a format string to produce a file name to try; %s in the string is replaced by the text matching the FILE-IDX'th subexpression.") (defvar compilation-read-command t "If not nil, M-x compile reads the compilation command to use. Otherwise, M-x compile just uses the value of `compile-command'.") (defvar compilation-ask-about-save t "If not nil, M-x compile asks which buffers to save before compiling. Otherwise, it saves all modified buffers without asking.") (defvar grep-regexp-alist '(("^\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2)) "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") (defvar grep-command "grep -n " "Last grep command used in \\[grep]; default for next grep.") ;;;###autoload (defvar compilation-search-path '(nil) "*List of directories to search for source files named in error messages. Elements should be directory names, not file names of directories. nil as an element means to try the default directory.") (defvar compile-command "make -k " "Last shell command used to do a compilation; default for next compilation. Sometimes it is useful for files to supply local values for this variable. You might also use mode hooks to specify it in certain modes, like this: (setq c-mode-hook '(lambda () (or (file-exists-p \"makefile\") (file-exists-p \"Makefile\") (progn (make-local-variable 'compile-command) (setq compile-command (concat \"make -k \" buffer-file-name))))))") (defvar compilation-enter-directory-regexp ": Entering directory `\\(.*\\)'$" "Regular expression matching lines that indicate a new current directory. This must contain one \\(, \\) pair around the directory name. The default value matches lines printed by the `-w' option of GNU Make.") (defvar compilation-leave-directory-regexp ": Leaving directory `\\(.*\\)'$" "Regular expression matching lines that indicate restoring current directory. This may contain one \\(, \\) pair around the name of the directory being moved from. If it does not, the last directory entered \(by a line matching `compilation-enter-directory-regexp'\) is assumed. The default value matches lines printed by the `-w' option of GNU Make.") (defvar compilation-directory-stack nil "Stack of previous directories for `compilation-leave-directory-regexp'. The head element is the directory the compilation was started in.") (defvar compilation-exit-message-function nil "\ If non-nil, called when a compilation process dies to return a status message. This should be a function a two arguments as passed to a process sentinel \(see `set-process-sentinel\); it returns a cons (MESSAGE . MODELINE) of the strings to write into the compilation buffer, and to put in its mode line.") ;; History of compile commands. (defvar compile-history nil) ;; History of grep commands. (defvar grep-history nil) (defvar compilation-mode-font-lock-keywords ;; This regexp needs a bit of rewriting. What is the third grouping for? '(("^\\([^ \n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$" 1 font-lock-function-name-face)) ;;; ("^\\([^\n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$" 0 font-lock-keyword-face keep) "Additional expressions to highlight in Compilation mode.") ;;;###autoload (defun compile (command) "Compile the program including the current buffer. Default: run `make'. Runs COMMAND, a shell command, in a separate process asynchronously with output going to the buffer `*compilation*'. You can then use the command \\[next-error] to find the next error message and move to the source code that caused it. Interactively, prompts for the command if `compilation-read-command' is non-nil; otherwise uses `compile-command'. With prefix arg, always prompts. To run more than one compilation at once, start one and rename the \`*compilation*' buffer to some other name with \\[rename-buffer]. Then start the next one. The name used for the buffer is actually whatever is returned by the function in `compilation-buffer-name-function', so you can set that to a function that generates a unique name." (interactive (if (or compilation-read-command current-prefix-arg) (list (read-from-minibuffer "Compile command: " compile-command nil nil '(compile-history . 1))) (list compile-command))) (setq compile-command command) (save-some-buffers (not compilation-ask-about-save) nil) (compile-internal compile-command "No more errors")) ;;; run compile with the default command line (defun recompile () "Re-compile the program including the current buffer." (interactive) (save-some-buffers (not compilation-ask-about-save) nil) (compile-internal compile-command "No more errors")) ;; The system null device. (Should reference NULL_DEVICE from C.) (defvar grep-null-device "/dev/null" "The system null device.") ;;;###autoload (defun grep (command-args) "Run grep, with user-specified args, and collect output in a buffer. While grep runs asynchronously, you can use the \\[next-error] command to find the text that grep hits refer to. This command uses a special history list for its arguments, so you can easily repeat a grep command." (interactive (list (read-from-minibuffer "Run grep (like this): " grep-command nil nil 'grep-history))) (let ((buf (compile-internal (concat command-args " " grep-null-device) "No more grep hits" "grep" ;; Give it a simpler regexp to match. nil grep-regexp-alist))) (save-excursion (set-buffer buf) (set (make-local-variable 'compilation-exit-message-function) (lambda (proc msg) (let ((code (process-exit-status proc))) (if (eq (process-status proc) 'exit) (cond ((zerop code) '("finished (matches found)\n" . "matched")) ((= code 1) '("finished with no matches found\n" . "no match")) (t (cons msg code))) (cons msg code)))))))) (defun compile-internal (command error-message &optional name-of-mode parser regexp-alist name-function) "Run compilation command COMMAND (low level interface). ERROR-MESSAGE is a string to print if the user asks to see another error and there are no more errors. Third argument NAME-OF-MODE is the name to display as the major mode in the compilation buffer. Fourth arg PARSER is the error parser function (nil means the default). Fifth arg REGEXP-ALIST is the error message regexp alist to use (nil means the default). Sixth arg NAME-FUNCTION is a function called to name the buffer (nil means the default). The defaults for these variables are the global values of \`compilation-parse-errors-function', `compilation-error-regexp-alist', and \`compilation-buffer-name-function', respectively. Returns the compilation buffer created." (let (outbuf) (save-excursion (or name-of-mode (setq name-of-mode "Compilation")) (setq outbuf (get-buffer-create (funcall (or name-function compilation-buffer-name-function (function (lambda (mode) (concat "*" (downcase mode) "*")))) name-of-mode))) (set-buffer outbuf) (let ((comp-proc (get-buffer-process (current-buffer)))) (if comp-proc (if (or (not (eq (process-status comp-proc) 'run)) (yes-or-no-p (format "A %s process is running; kill it? " name-of-mode))) (condition-case () (progn (interrupt-process comp-proc) (sit-for 1) (delete-process comp-proc)) (error nil)) (error "Cannot have two processes in `%s' at once" (buffer-name)) ))) ;; In case the compilation buffer is current, make sure we get the global ;; values of compilation-error-regexp-alist, etc. (kill-all-local-variables)) (let ((regexp-alist (or regexp-alist compilation-error-regexp-alist)) (parser (or parser compilation-parse-errors-function)) (thisdir default-directory) outwin) (save-excursion ;; Clear out the compilation buffer and make it writable. ;; Change its default-directory to the directory where the compilation ;; will happen, and insert a `cd' command to indicate this. (set-buffer outbuf) (setq buffer-read-only nil) (buffer-disable-undo (current-buffer)) (erase-buffer) (buffer-enable-undo (current-buffer)) (setq default-directory thisdir) (insert "cd " thisdir "\n" command "\n") (set-buffer-modified-p nil)) ;; If we're already in the compilation buffer, go to the end ;; of the buffer, so point will track the compilation output. (if (eq outbuf (current-buffer)) (goto-char (point-max))) ;; Pop up the compilation buffer. (setq outwin (display-buffer outbuf)) (save-excursion (set-buffer outbuf) (compilation-mode) ;; (setq buffer-read-only t) ;;; Non-ergonomic. (set (make-local-variable 'compilation-parse-errors-function) parser) (set (make-local-variable 'compilation-error-message) error-message) (set (make-local-variable 'compilation-error-regexp-alist) regexp-alist) (setq default-directory thisdir compilation-directory-stack (list default-directory)) (set-window-start outwin (point-min)) (setq mode-name name-of-mode) (or (eq outwin (selected-window)) (set-window-point outwin (point-min))) (compilation-set-window-height outwin) ;; Start the compilation. (if (fboundp 'start-process) (let* ((process-environment (cons "EMACS=t" process-environment)) (proc (start-process-shell-command (downcase mode-name) outbuf command))) (set-process-sentinel proc 'compilation-sentinel) (set-process-filter proc 'compilation-filter) (set-marker (process-mark proc) (point) outbuf) (setq compilation-in-progress (cons proc compilation-in-progress))) ;; No asynchronous processes available (message (format "Executing `%s'..." command)) (sit-for 0) ;; Force redisplay (let ((status (call-process shell-file-name nil outbuf nil "-c" command)))) (message (format "Executing `%s'...done" command))))) ;; Make it so the next C-x ` will use this buffer. (setq compilation-last-buffer outbuf))) ;; Set the height of WINDOW according to compilation-window-height. (defun compilation-set-window-height (window) (and compilation-window-height (= (window-width window) (frame-width (window-frame window))) ;; If window is alone in its frame, aside from a minibuffer, ;; don't change its height. (not (eq window (frame-root-window (window-frame window)))) ;; This save-excursion prevents us from changing the current buffer, ;; which might not be the same as the selected window's buffer. (save-excursion (let ((w (selected-window))) (unwind-protect (progn (select-window window) (enlarge-window (- compilation-window-height (window-height)))) (select-window w)))))) (defvar compilation-minor-mode-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'compile-mouse-goto-error) (define-key map "\C-c\C-c" 'compile-goto-error) (define-key map "\C-m" 'compile-goto-error) (define-key map "\C-c\C-k" 'kill-compilation) (define-key map "\M-n" 'compilation-next-error) (define-key map "\M-p" 'compilation-previous-error) (define-key map "\M-{" 'compilation-previous-file) (define-key map "\M-}" 'compilation-next-file) map) "Keymap for `compilation-minor-mode'.") (defvar compilation-mode-map (let ((map (cons 'keymap compilation-minor-mode-map))) (define-key map " " 'scroll-up) (define-key map "\^?" 'scroll-down) ;; Set up the menu-bar (define-key map [menu-bar compilation-menu] (cons "Compile" (make-sparse-keymap "Compile"))) (define-key map [menu-bar compilation-menu compilation-mode-kill-compilation] '("Stop Compilation" . kill-compilation)) (define-key map [menu-bar compilation-menu compilation-mode-separator2] '("----" . nil)) (define-key map [menu-bar compilation-menu compilation-mode-first-error] '("First Error" . first-error)) (define-key map [menu-bar compilation-menu compilation-mode-previous-error] '("Previous Error" . previous-error)) (define-key map [menu-bar compilation-menu compilation-mode-next-error] '("Next Error" . next-error)) (define-key map [menu-bar compilation-menu compilation-separator2] '("----" . nil)) (define-key map [menu-bar compilation-menu compilation-mode-grep] '("Grep" . grep)) (define-key map [menu-bar compilation-menu compilation-mode-recompile] '("Recompile" . recompile)) (define-key map [menu-bar compilation-menu compilation-mode-compile] '("Compile" . compile)) map) "Keymap for compilation log buffers. `compilation-minor-mode-map' is a cdr of this.") (defun compilation-mode () "Major mode for compilation log buffers. \\To visit the source for a line-numbered error, move point to the error message line and type \\[compile-goto-error]. To kill the compilation, type \\[kill-compilation]. Runs `compilation-mode-hook' with `run-hooks' (which see)." (interactive) (kill-all-local-variables) (use-local-map compilation-mode-map) (setq major-mode 'compilation-mode mode-name "Compilation") (compilation-setup) (set (make-local-variable 'font-lock-defaults) '(compilation-mode-font-lock-keywords t)) (run-hooks 'compilation-mode-hook)) ;; Prepare the buffer for the compilation parsing commands to work. (defun compilation-setup () ;; Make the buffer's mode line show process state. (setq mode-line-process '(":%s")) (set (make-local-variable 'compilation-error-list) nil) (set (make-local-variable 'compilation-old-error-list) nil) (set (make-local-variable 'compilation-parsing-end) 1) (set (make-local-variable 'compilation-directory-stack) nil) (setq compilation-last-buffer (current-buffer))) (defvar compilation-minor-mode nil "Non-nil when in compilation-minor-mode. In this minor mode, all the error-parsing commands of the Compilation major mode are available.") (make-variable-buffer-local 'compilation-minor-mode) (or (assq 'compilation-minor-mode minor-mode-alist) (setq minor-mode-alist (cons '(compilation-minor-mode " Compilation") minor-mode-alist))) (or (assq 'compilation-minor-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'compilation-minor-mode compilation-minor-mode-map) minor-mode-map-alist))) ;;;###autoload (defun compilation-minor-mode (&optional arg) "Toggle compilation minor mode. With arg, turn compilation mode on if and only if arg is positive. See `compilation-mode'." (interactive "P") (if (setq compilation-minor-mode (if (null arg) (null compilation-minor-mode) (> (prefix-numeric-value arg) 0))) (compilation-setup))) ;; Called when compilation process changes state. (defun compilation-sentinel (proc msg) "Sentinel for compilation buffers." (let ((buffer (process-buffer proc))) (if (memq (process-status proc) '(signal exit)) (progn (if (null (buffer-name buffer)) ;; buffer killed (set-process-buffer proc nil) (let ((obuf (current-buffer)) omax opoint) ;; save-excursion isn't the right thing if ;; process-buffer is current-buffer (unwind-protect (progn ;; Write something in the compilation buffer ;; and hack its mode line. (set-buffer buffer) (let ((buffer-read-only nil) (status (if compilation-exit-message-function (funcall compilation-exit-message-function proc msg) (cons msg (process-exit-status proc))))) (setq omax (point-max) opoint (point)) (goto-char omax) ;; Record where we put the message, so we can ignore it ;; later on. (insert ?\n mode-name " " (car status)) (forward-char -1) (insert " at " (substring (current-time-string) 0 19)) (forward-char 1) (setq mode-line-process (format ":%s [%s]" (process-status proc) (cdr status))) ;; Since the buffer and mode line will show that the ;; process is dead, we can delete it now. Otherwise it ;; will stay around until M-x list-processes. (delete-process proc) ;; Force mode line redisplay soon. (force-mode-line-update)) (if (and opoint (< opoint omax)) (goto-char opoint)) (if compilation-finish-function (funcall compilation-finish-function buffer msg))) (set-buffer obuf)))) (setq compilation-in-progress (delq proc compilation-in-progress)) )))) (defun compilation-filter (proc string) "Process filter for compilation buffers. Just inserts the text, but uses `insert-before-markers'." (if (buffer-name (process-buffer proc)) (save-excursion (set-buffer (process-buffer proc)) (let ((buffer-read-only nil)) (save-excursion (goto-char (process-mark proc)) (insert-before-markers string) (set-marker (process-mark proc) (point))))))) ;; Return the cdr of compilation-old-error-list for the error containing point. (defun compile-error-at-point () (compile-reinitialize-errors nil (point)) (let ((errors compilation-old-error-list)) (while (and errors (> (point) (car (car errors)))) (setq errors (cdr errors))) errors)) (defsubst compilation-buffer-p (buffer) (save-excursion (set-buffer buffer) (or compilation-minor-mode (eq major-mode 'compilation-mode)))) (defun compilation-next-error (n) "Move point to the next error in the compilation buffer. Does NOT find the source line like \\[next-error]." (interactive "p") (or (compilation-buffer-p (current-buffer)) (error "Not in a compilation buffer.")) (setq compilation-last-buffer (current-buffer)) (let ((errors (compile-error-at-point))) ;; Move to the error after the one containing point. (goto-char (car (if (< n 0) (let ((i 0) (e compilation-old-error-list)) ;; See how many cdrs away ERRORS is from the start. (while (not (eq e errors)) (setq i (1+ i) e (cdr e))) (if (> (- n) i) (error "Moved back past first error") (nth (+ i n) compilation-old-error-list))) (let ((compilation-error-list (cdr errors))) (compile-reinitialize-errors nil nil n) (if compilation-error-list (nth (1- n) compilation-error-list) (error "Moved past last error")))))))) (defun compilation-previous-error (n) "Move point to the previous error in the compilation buffer. Does NOT find the source line like \\[next-error]." (interactive "p") (compilation-next-error (- n))) ;; Given an elt of `compilation-error-list', return an object representing ;; the referenced file which is equal to (but not necessarily eq to) what ;; this function would return for another error in the same file. (defsubst compilation-error-filedata (data) (setq data (cdr data)) (if (markerp data) (marker-buffer data) (car data))) ;; Return a string describing a value from compilation-error-filedata. ;; This value is not necessarily useful as a file name, but should be ;; indicative to the user of what file's errors are being referred to. (defsubst compilation-error-filedata-file-name (filedata) (if (bufferp filedata) (buffer-file-name filedata) (car filedata))) (defun compilation-next-file (n) "Move point to the next error for a different file than the current one." (interactive "p") (or (compilation-buffer-p (current-buffer)) (error "Not in a compilation buffer.")) (setq compilation-last-buffer (current-buffer)) (let ((reversed (< n 0)) errors filedata) (if (not reversed) (setq errors (or (compile-error-at-point) (error "Moved past last error"))) ;; Get a reversed list of the errors up through the one containing point. (compile-reinitialize-errors nil (point)) (setq errors (reverse compilation-old-error-list) n (- n)) ;; Ignore errors after point. (car ERRORS) will be the error ;; containing point, (cadr ERRORS) the one before it. (while (and errors (< (point) (car (car errors)))) (setq errors (cdr errors)))) (while (> n 0) (setq filedata (compilation-error-filedata (car errors))) ;; Skip past the following errors for this file. (while (equal filedata (compilation-error-filedata (car (or errors (if reversed (error "%s the first erring file" (compilation-error-filedata-file-name filedata)) (let ((compilation-error-list nil)) ;; Parse some more. (compile-reinitialize-errors nil nil 2) (setq errors compilation-error-list))) (error "%s is the last erring file" (compilation-error-filedata-file-name filedata)))))) (setq errors (cdr errors))) (setq n (1- n))) ;; Move to the following error. (goto-char (car (car (or errors (if reversed (error "This is the first erring file") (let ((compilation-error-list nil)) ;; Parse the last one. (compile-reinitialize-errors nil nil 1) compilation-error-list)))))))) (defun compilation-previous-file (n) "Move point to the previous error for a different file than the current one." (interactive "p") (compilation-next-file (- n))) (defun kill-compilation () "Kill the process made by the \\[compile] command." (interactive) (let ((buffer (compilation-find-buffer))) (if (get-buffer-process buffer) (interrupt-process (get-buffer-process buffer)) (error "The compilation process is not running.")))) ;; Parse any new errors in the compilation buffer, ;; or reparse from the beginning if the user has asked for that. (defun compile-reinitialize-errors (reparse &optional limit-search find-at-least) (save-excursion (set-buffer compilation-last-buffer) ;; If we are out of errors, or if user says "reparse", ;; discard the info we have, to force reparsing. (if (or (eq compilation-error-list t) reparse) (compilation-forget-errors)) (if (and compilation-error-list (or (not limit-search) (> compilation-parsing-end limit-search)) (or (not find-at-least) (>= (length compilation-error-list) find-at-least))) ;; Since compilation-error-list is non-nil, it points to a specific ;; error the user wanted. So don't move it around. nil ;; This was here for a long time (before my rewrite); why? --roland ;;(switch-to-buffer compilation-last-buffer) (set-buffer-modified-p nil) (if (< compilation-parsing-end (point-max)) ;; compilation-error-list might be non-nil if we have a non-nil ;; LIMIT-SEARCH or FIND-AT-LEAST arg. In that case its value ;; records the current position in the error list, and we must ;; preserve that after reparsing. (let ((error-list-pos compilation-error-list)) (funcall compilation-parse-errors-function limit-search (and find-at-least ;; We only need enough new parsed errors to reach ;; FIND-AT-LEAST errors past the current ;; position. (- find-at-least (length compilation-error-list)))) ;; Remember the entire list for compilation-forget-errors. If ;; this is an incremental parse, append to previous list. If ;; we are parsing anew, compilation-forget-errors cleared ;; compilation-old-error-list above. (setq compilation-old-error-list (nconc compilation-old-error-list compilation-error-list)) (if error-list-pos ;; We started in the middle of an existing list of parsed ;; errors before parsing more; restore that position. (setq compilation-error-list error-list-pos)) ))))) (defun compile-mouse-goto-error (event) (interactive "e") (save-excursion (set-buffer (window-buffer (posn-window (event-end event)))) (goto-char (posn-point (event-end event))) (or (compilation-buffer-p (current-buffer)) (error "Not in a compilation buffer.")) (setq compilation-last-buffer (current-buffer)) (compile-reinitialize-errors nil (point)) ;; Move to bol; the marker for the error on this line will point there. (beginning-of-line) ;; Move compilation-error-list to the elt of compilation-old-error-list ;; we want. (setq compilation-error-list compilation-old-error-list) (while (and compilation-error-list (> (point) (car (car compilation-error-list)))) (setq compilation-error-list (cdr compilation-error-list))) (or compilation-error-list (error "No error to go to"))) (select-window (posn-window (event-end event))) ;; Move to another window, so that next-error's window changes ;; result in the desired setup. (or (one-window-p) (progn (other-window -1) ;; other-window changed the selected buffer, ;; but we didn't want to do that. (set-buffer compilation-last-buffer))) (push-mark) (next-error 1)) (defun compile-goto-error (&optional argp) "Visit the source for the error message point is on. Use this command in a compilation log buffer. Sets the mark at point there. \\[universal-argument] as a prefix arg means to reparse the buffer's error messages first; other kinds of prefix arguments are ignored." (interactive "P") (or (compilation-buffer-p (current-buffer)) (error "Not in a compilation buffer.")) (setq compilation-last-buffer (current-buffer)) (compile-reinitialize-errors (consp argp) (point)) ;; Move to bol; the marker for the error on this line will point there. (beginning-of-line) ;; Move compilation-error-list to the elt of compilation-old-error-list ;; we want. (setq compilation-error-list compilation-old-error-list) (while (and compilation-error-list (> (point) (car (car compilation-error-list)))) (setq compilation-error-list (cdr compilation-error-list))) ;; Move to another window, so that next-error's window changes ;; result in the desired setup. (or (one-window-p) (progn (other-window -1) ;; other-window changed the selected buffer, ;; but we didn't want to do that. (set-buffer compilation-last-buffer))) (push-mark) (next-error 1)) ;; Return a compilation buffer. ;; If the current buffer is a compilation buffer, return it. ;; If compilation-last-buffer is set to a live buffer, use that. ;; Otherwise, look for a compilation buffer and signal an error ;; if there are none. (defun compilation-find-buffer (&optional other-buffer) (if (and (not other-buffer) (compilation-buffer-p (current-buffer))) ;; The current buffer is a compilation buffer. (current-buffer) (if (and compilation-last-buffer (buffer-name compilation-last-buffer) (or (not other-buffer) (not (eq compilation-last-buffer (current-buffer))))) compilation-last-buffer (let ((buffers (buffer-list))) (while (and buffers (or (not (compilation-buffer-p (car buffers))) (and other-buffer (eq (car buffers) (current-buffer))))) (setq buffers (cdr buffers))) (if buffers (car buffers) (or (and other-buffer (compilation-buffer-p (current-buffer)) ;; The current buffer is a compilation buffer. (progn (if other-buffer (message "This is the only compilation buffer.")) (current-buffer))) (error "No compilation started!"))))))) ;;;###autoload (defun next-error (&optional argp) "Visit next compilation error message and corresponding source code. This operates on the output from the \\[compile] command. If all preparsed error messages have been processed, the error message buffer is checked for new ones. A prefix arg specifies how many error messages to move; negative means move back to previous error messages. Just C-u as a prefix means reparse the error message buffer and start at the first error. \\[next-error] normally applies to the most recent compilation started, but as long as you are in the middle of parsing errors from one compilation output buffer, you stay with that compilation output buffer. Use \\[next-error] in a compilation output buffer to switch to processing errors from that compilation. See variables `compilation-parse-errors-function' and \`compilation-error-regexp-alist' for customization ideas." (interactive "P") (setq compilation-last-buffer (compilation-find-buffer)) (compilation-goto-locus (compilation-next-error-locus ;; We want to pass a number here only if ;; we got a numeric prefix arg, not just C-u. (and (not (consp argp)) (prefix-numeric-value argp)) (consp argp)))) ;;;###autoload (define-key ctl-x-map "`" 'next-error) (defun previous-error () "Visit previous compilation error message and corresponding source code. This operates on the output from the \\[compile] command." (interactive) (next-error -1)) (defun first-error () "Reparse the error message buffer and start at the first error Visit corresponding source code. This operates on the output from the \\[compile] command." (interactive) (next-error '(4))) (defun compilation-next-error-locus (&optional move reparse silent) "Visit next compilation error and return locus in corresponding source code. This operates on the output from the \\[compile] command. If all preparsed error messages have been processed, the error message buffer is checked for new ones. Returns a cons (ERROR . SOURCE) of two markers: ERROR is a marker at the location of the error message in the compilation buffer, and SOURCE is a marker at the location in the source code indicated by the error message. Optional first arg MOVE says how many error messages to move forwards (or backwards, if negative); default is 1. Optional second arg REPARSE, if non-nil, says to reparse the error message buffer and reset to the first error (plus MOVE - 1). If optional third argument SILENT is non-nil, return nil instead of raising an error if there are no more errors. The current buffer should be the desired compilation output buffer." (or move (setq move 1)) (compile-reinitialize-errors reparse nil (and (not reparse) (if (< move 1) 0 (1- move)))) (let (next-errors next-error) (catch 'no-next-error (save-excursion (set-buffer compilation-last-buffer) ;; compilation-error-list points to the "current" error. (setq next-errors (if (> move 0) (nthcdr (1- move) compilation-error-list) ;; Zero or negative arg; we need to move back in the list. (let ((n (1- move)) (i 0) (e compilation-old-error-list)) ;; See how many cdrs away the current error is from the start. (while (not (eq e compilation-error-list)) (setq i (1+ i) e (cdr e))) (if (> (- n) i) (error "Moved back past first error") (nthcdr (+ i n) compilation-old-error-list)))) next-error (car next-errors)) (while (if (null next-error) (progn (and move (/= move 1) (error (if (> move 0) "Moved past last error") "Moved back past first error")) ;; Forget existing error messages if compilation has finished. (if (not (and (get-buffer-process (current-buffer)) (eq (process-status (get-buffer-process (current-buffer))) 'run))) (compilation-forget-errors)) (if silent (throw 'no-next-error nil) (error (concat compilation-error-message (and (get-buffer-process (current-buffer)) (eq (process-status (get-buffer-process (current-buffer))) 'run) " yet"))))) (setq compilation-error-list (cdr next-errors)) (if (null (cdr next-error)) ;; This error is boring. Go to the next. t (or (markerp (cdr next-error)) ;; This error has a filename/lineno pair. ;; Find the file and turn it into a marker. (let* ((fileinfo (car (cdr next-error))) (buffer (apply 'compilation-find-file (car next-error) fileinfo))) (if (null buffer) ;; We can't find this error's file. ;; Remove all errors in the same file. (progn (setq next-errors compilation-old-error-list) (while next-errors (and (consp (cdr (car next-errors))) (equal (car (cdr (car next-errors))) fileinfo) (progn (set-marker (car (car next-errors)) nil) (setcdr (car next-errors) nil))) (setq next-errors (cdr next-errors))) ;; Look for the next error. t) ;; We found the file. Get a marker for this error. ;; compilation-old-error-list is a buffer-local ;; variable, so we must be careful to extract its value ;; before switching to the source file buffer. (let ((errors compilation-old-error-list) (last-line (nth 1 (cdr next-error))) (column (nth 2 (cdr next-error)))) (set-buffer buffer) (save-excursion (save-restriction (widen) (goto-line last-line) (if (and column (> column 0)) ;; Columns in error msgs are 1-origin. (move-to-column (1- column)) (beginning-of-line)) (setcdr next-error (point-marker)) ;; Make all the other error messages referring ;; to the same file have markers into the buffer. (while errors (and (consp (cdr (car errors))) (equal (car (cdr (car errors))) fileinfo) (let* ((this (nth 1 (cdr (car errors)))) (column (nth 2 (cdr (car errors)))) (lines (- this last-line))) (if (eq selective-display t) ;; When selective-display is t, ;; each C-m is a line boundary, ;; as well as each newline. (if (< lines 0) (re-search-backward "[\n\C-m]" nil 'end (- lines)) (re-search-forward "[\n\C-m]" nil 'end lines)) (forward-line lines)) (if (and column (> column 1)) (move-to-column (1- column)) (beginning-of-line)) (setq last-line this) (setcdr (car errors) (point-marker)))) (setq errors (cdr errors))))))))) ;; If we didn't get a marker for this error, or this ;; marker's buffer was killed, go on to the next one. (or (not (markerp (cdr next-error))) (not (marker-buffer (cdr next-error)))))) (setq next-errors compilation-error-list next-error (car next-errors))))) ;; Skip over multiple error messages for the same source location, ;; so the next C-x ` won't go to an error in the same place. (while (and compilation-error-list (equal (cdr (car compilation-error-list)) (cdr next-error))) (setq compilation-error-list (cdr compilation-error-list))) ;; We now have a marker for the position of the error source code. ;; NEXT-ERROR is a cons (ERROR . SOURCE) of two markers. next-error)) (defun compilation-goto-locus (next-error) "Jump to an error locus returned by `compilation-next-error-locus'. Takes one argument, a cons (ERROR . SOURCE) of two markers. Selects a window with point at SOURCE, with another window displaying ERROR." (if (and (window-dedicated-p (selected-window)) (eq (selected-window) (frame-root-window))) (switch-to-buffer-other-frame (marker-buffer (cdr next-error))) (switch-to-buffer (marker-buffer (cdr next-error)))) (goto-char (cdr next-error)) ;; If narrowing got in the way of ;; going to the right place, widen. (or (= (point) (marker-position (cdr next-error))) (progn (widen) (goto-char (cdr next-error)))) ;; Show compilation buffer in other window, scrolled to this error. (let* ((pop-up-windows t) ;; Use an existing window if it is in a visible frame. (w (or (get-buffer-window (marker-buffer (car next-error)) 'visible) ;; Pop up a window. (display-buffer (marker-buffer (car next-error)))))) (set-window-point w (car next-error)) (set-window-start w (car next-error)) (compilation-set-window-height w))) ;; Find a buffer for file FILENAME. ;; Search the directories in compilation-search-path. ;; A nil in compilation-search-path means to try the ;; current directory, which is passed in DIR. ;; If FILENAME is not found at all, ask the user where to find it. ;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user. (defun compilation-find-file (marker filename dir &rest formats) (or formats (setq formats '("%s"))) (let ((dirs compilation-search-path) buffer thisdir fmts name) (if (file-name-absolute-p filename) ;; The file name is absolute. Use its explicit directory as ;; the first in the search path, and strip it from FILENAME. (setq filename (abbreviate-file-name (expand-file-name filename)) dirs (cons (file-name-directory filename) dirs) filename (file-name-nondirectory filename))) ;; Now search the path. (while (and dirs (null buffer)) (setq thisdir (or (car dirs) dir) fmts formats) ;; For each directory, try each format string. (while (and fmts (null buffer)) (setq name (expand-file-name (format (car fmts) filename) thisdir) buffer (and (file-exists-p name) (find-file-noselect name)) fmts (cdr fmts))) (setq dirs (cdr dirs))) (or buffer ;; The file doesn't exist. ;; Ask the user where to find it. ;; If he hits C-g, then the next time he does ;; next-error, he'll skip past it. (let* ((pop-up-windows t) (w (display-buffer (marker-buffer marker)))) (set-window-point w marker) (set-window-start w marker) (let ((name (expand-file-name (read-file-name (format "Find this error in: (default %s) " filename) dir filename t)))) (if (file-directory-p name) (setq name (expand-file-name filename name))) (and (file-exists-p name) (find-file-noselect name))))))) ;; Set compilation-error-list to nil, and unchain the markers that point to the ;; error messages and their text, so that they no longer slow down gap motion. ;; This would happen anyway at the next garbage collection, but it is better to ;; do it right away. (defun compilation-forget-errors () (while compilation-old-error-list (let ((next-error (car compilation-old-error-list))) (set-marker (car next-error) nil) (if (markerp (cdr next-error)) (set-marker (cdr next-error) nil))) (setq compilation-old-error-list (cdr compilation-old-error-list))) (setq compilation-error-list nil compilation-directory-stack nil compilation-parsing-end 1)) (defun count-regexp-groupings (regexp) "Return the number of \\( ... \\) groupings in REGEXP (a string)." (let ((groupings 0) (len (length regexp)) (i 0) c) (while (< i len) (setq c (aref regexp i) i (1+ i)) (cond ((= c ?\[) ;; Find the end of this [...]. (while (and (< i len) (not (= (aref regexp i) ?\]))) (setq i (1+ i)))) ((= c ?\\) (if (< i len) (progn (setq c (aref regexp i) i (1+ i)) (if (= c ?\)) ;; We found the end of a grouping, ;; so bump our counter. (setq groupings (1+ groupings)))))))) groupings)) (defun compilation-parse-errors (limit-search find-at-least) "Parse the current buffer as grep, cc or lint error messages. See variable `compilation-parse-errors-function' for the interface it uses." (setq compilation-error-list nil) (message "Parsing error messages...") (let (text-buffer orig orig-expanded parent-expanded regexp enter-group leave-group error-group alist subexpr error-regexp-groups (found-desired nil) (compilation-num-errors-found 0)) ;; Don't reparse messages already seen at last parse. (goto-char compilation-parsing-end) ;; Don't parse the first two lines as error messages. ;; 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. (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|" "\\(" compilation-leave-directory-regexp "\\)\\|" "\\(" (mapconcat (function (lambda (elt) (concat "\\(" (car elt) "\\)"))) compilation-error-regexp-alist "\\|") "\\)")) ;; Find out how many \(...\) groupings are in each of the regexps, and set ;; *-GROUP to the grouping containing each constituent regexp (whose ;; subgroups will come immediately thereafter) of the big regexp we have ;; just constructed. (setq enter-group 1 leave-group (+ enter-group (count-regexp-groupings compilation-enter-directory-regexp) 1) error-group (+ leave-group (count-regexp-groupings compilation-leave-directory-regexp) 1)) ;; Compile an alist (IDX FILE LINE [COL]), where IDX is the number of ;; the subexpression for an entire error-regexp, and FILE and LINE (and ;; possibly COL) are the numbers for the subexpressions giving the file ;; name and line number (and possibly column number). (setq alist (or compilation-error-regexp-alist (error "compilation-error-regexp-alist is empty!")) subexpr (1+ error-group)) (while alist (setq error-regexp-groups (cons (list subexpr (+ subexpr (nth 1 (car alist))) (+ subexpr (nth 2 (car alist))) (and (nth 3 (car alist)) (+ subexpr (nth 3 (car alist))))) error-regexp-groups)) (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist))))) (setq alist (cdr alist))) ;; Set up now the expanded, abbreviated directory variables ;; that compile-abbreviate-directory will need, so we can ;; compute them just once here. (setq orig (abbreviate-file-name default-directory) orig-expanded (abbreviate-file-name (file-truename default-directory)) parent-expanded (abbreviate-file-name (expand-file-name "../" orig-expanded))) (while (and (not found-desired) ;; We don't just pass LIMIT-SEARCH to re-search-forward ;; because we want to find matches containing LIMIT-SEARCH ;; but which extend past it. (re-search-forward regexp nil t)) ;; Figure out which constituent regexp matched. (cond ((match-beginning enter-group) ;; The match was the enter-directory regexp. (let ((dir (file-name-as-directory (expand-file-name (buffer-substring (match-beginning (+ enter-group 1)) (match-end (+ enter-group 1))))))) ;; The directory name in the "entering" message ;; is a truename. Try to convert it to a form ;; like what the user typed in. (setq dir (compile-abbreviate-directory dir orig orig-expanded parent-expanded)) (setq compilation-directory-stack (cons dir compilation-directory-stack)) (and (file-directory-p dir) (setq default-directory dir))) (and limit-search (>= (point) limit-search) ;; The user wanted a specific error, and we're past it. ;; We do this check here (and in the leave-group case) ;; rather than at the end of the loop because if the last ;; thing seen is an error message, we must carefully ;; discard the last error when it is the first in a new ;; file (see below in the error-group case). (setq found-desired t))) ((match-beginning leave-group) ;; The match was the leave-directory regexp. (let ((beg (match-beginning (+ leave-group 1))) (stack compilation-directory-stack)) (if beg (let ((dir (file-name-as-directory (expand-file-name (buffer-substring beg (match-end (+ leave-group 1))))))) ;; The directory name in the "leaving" message ;; is a truename. Try to convert it to a form ;; like what the user typed in. (setq dir (compile-abbreviate-directory dir orig orig-expanded parent-expanded)) (while (and stack (not (string-equal (car stack) dir))) (setq stack (cdr stack))))) (setq compilation-directory-stack (cdr stack)) (setq stack (car compilation-directory-stack)) (if stack (setq default-directory stack)) ) (and limit-search (>= (point) limit-search) ;; The user wanted a specific error, and we're past it. ;; We do this check here (and in the enter-group case) ;; rather than at the end of the loop because if the last ;; thing seen is an error message, we must carefully ;; discard the last error when it is the first in a new ;; file (see below in the error-group case). (setq found-desired t))) ((match-beginning error-group) ;; The match was the composite error regexp. ;; Find out which individual regexp matched. (setq alist error-regexp-groups) (while (and alist (null (match-beginning (car (car alist))))) (setq alist (cdr alist))) (if alist (setq alist (car alist)) (error "compilation-parse-errors: impossible regexp match!")) ;; Extract the file name and line number from the error message. (let ((beginning-of-match (match-beginning 0)) ;looking-at nukes (filename (buffer-substring (match-beginning (nth 1 alist)) (match-end (nth 1 alist)))) (linenum (string-to-int (buffer-substring (match-beginning (nth 2 alist)) (match-end (nth 2 alist))))) (column (and (nth 3 alist) (match-beginning (nth 3 alist)) (string-to-int (buffer-substring (match-beginning (nth 3 alist)) (match-end (nth 3 alist))))))) ;; Check for a comint-file-name-prefix and prepend it if ;; appropriate. (This is very useful for ;; compilation-minor-mode in an rlogin-mode buffer.) (and (boundp 'comint-file-name-prefix) ;; If the file name is relative, default-directory will ;; already contain the comint-file-name-prefix (done by ;; compile-abbreviate-directory). (file-name-absolute-p filename) (setq filename (concat comint-file-name-prefix filename))) (setq filename (cons filename (cons default-directory (nthcdr 4 alist)))) ;; Locate the erring file and line. ;; Cons a new elt onto compilation-error-list, ;; giving a marker for the current compilation buffer ;; location, and the file and line number of the error. (save-excursion ;; Save as the start of the error the beginning of the ;; line containing the match unless the match starts at a ;; newline, in which case the beginning of the next line. (goto-char beginning-of-match) (forward-line (if (eolp) 1 0)) (let ((this (cons (point-marker) (list filename linenum column)))) ;; Don't add the same source line more than once. (if (equal (cdr this) (cdr (car compilation-error-list))) nil (setq compilation-error-list (cons this compilation-error-list)) (setq compilation-num-errors-found (1+ compilation-num-errors-found))))) (and (or (and find-at-least (> compilation-num-errors-found find-at-least)) (and limit-search (>= (point) limit-search))) ;; We have found as many new errors as the user wants, ;; or past the buffer position he indicated. We ;; continue to parse until we have seen all the ;; consecutive errors in the same file, so the error ;; positions will be recorded as markers in this buffer ;; that might change. (cdr compilation-error-list) ; Must check at least two. (not (equal (car (cdr (nth 0 compilation-error-list))) (car (cdr (nth 1 compilation-error-list))))) (progn ;; Discard the error just parsed, so that the next ;; parsing run can get it and the following errors in ;; the same file all at once. If we didn't do this, we ;; would have the same problem we are trying to avoid ;; with the test above, just delayed until the next run! (setq compilation-error-list (cdr compilation-error-list)) (goto-char beginning-of-match) (setq found-desired t))) ) ) (t (error "compilation-parse-errors: known groups didn't match!"))) (message "Parsing error messages...%d (%.0f%% of buffer)" compilation-num-errors-found ;; Use floating-point because (* 100 (point)) frequently ;; exceeds the range of Emacs Lisp integers. (/ (* 100.0 (point)) (point-max))) (and limit-search (>= (point) limit-search) ;; The user wanted a specific error, and we're past it. (setq found-desired t))) (setq compilation-parsing-end (if found-desired (point) ;; We have searched the whole buffer. (point-max)))) (setq compilation-error-list (nreverse compilation-error-list)) (message "Parsing error messages...done")) ;; If directory DIR is a subdir of ORIG or of ORIG's parent, ;; return a relative name for it starting from ORIG or its parent. ;; ORIG-EXPANDED is an expanded version of ORIG. ;; PARENT-EXPANDED is an expanded version of ORIG's parent. ;; Those two args could be computed here, but we run faster by ;; having the caller compute them just once. (defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded) ;; Apply canonical abbreviations to DIR first thing. ;; Those abbreviations are already done in the other arguments passed. (setq dir (abbreviate-file-name dir)) ;; Check for a comint-file-name-prefix and prepend it if appropriate. ;; (This is very useful for compilation-minor-mode in an rlogin-mode ;; buffer.) (if (boundp 'comint-file-name-prefix) (setq dir (concat comint-file-name-prefix dir))) (if (and (> (length dir) (length orig-expanded)) (string= orig-expanded (substring dir 0 (length orig-expanded)))) (setq dir (concat orig (substring dir (length orig-expanded))))) (if (and (> (length dir) (length parent-expanded)) (string= parent-expanded (substring dir 0 (length parent-expanded)))) (setq dir (concat (file-name-directory (directory-file-name orig)) (substring dir (length parent-expanded))))) dir) (provide 'compile) ;;; compile.el ends here emacs-19.30/lisp/complete.el100444 12120 1 71144 6045201542 14226 0ustar rmsdaemon;;; complete.el -- partial completion mechanism plus other goodies ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. ;; Author: Dave Gillespie ;; Keywords: abbrev ;; Version: 2.02 ;; Special thanks to Hallvard Furuseth for his many ideas and contributions. ;; 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: ;; Extended completion for the Emacs minibuffer. ;; ;; The basic idea is that the command name or other completable text is ;; divided into words and each word is completed separately, so that ;; "M-x p-b" expands to "M-x print-buffer". If the entry is ambiguous ;; each word is completed as much as possible and then the cursor is ;; left at the first position where typing another letter will resolve ;; the ambiguity. ;; ;; Word separators for this purpose are hyphen, space, and period. ;; These would most likely occur in command names, Info menu items, ;; and file names, respectively. But all word separators are treated ;; alike at all times. ;; ;; This completion package replaces the old-style completer's key ;; bindings for TAB, SPC, RET, and `?'. The old completer is still ;; available on the Meta versions of those keys. If you set ;; PC-meta-flag to nil, the old completion keys will be left alone ;; and the partial completer will use the Meta versions of the keys. ;; Usage: Load this file. Now, during completable minibuffer entry, ;; ;; TAB means to do a partial completion; ;; SPC means to do a partial complete-word; ;; RET means to do a partial complete-and-exit; ;; ? means to do a partial completion-help. ;; ;; If you set PC-meta-flag to nil, then TAB, SPC, RET, and ? perform ;; original Emacs completions, and M-TAB etc. do partial completion. ;; To do this, put the command, ;; ;; (setq PC-meta-flag nil) ;; ;; in your .emacs file. To load partial completion automatically, put ;; ;; (load "complete") ;; ;; in your .emacs file, too. Things will be faster if you byte-compile ;; this file when you install it. ;; ;; As an extra feature, in cases where RET would not normally ;; complete (such as `C-x b'), the M-RET key will always do a partial ;; complete-and-exit. Thus `C-x b f.c RET' will select or create a ;; buffer called "f.c", but `C-x b f.c M-RET' will select the existing ;; buffer whose name matches that pattern (perhaps "filing.c"). ;; (PC-meta-flag does not affect this behavior; M-RET used to be ;; undefined in this situation.) ;; ;; The regular M-TAB (lisp-complete-symbol) command also supports ;; partial completion in this package. ;; This package also contains a wildcard feature for C-x C-f (find-file). ;; For example, `C-x C-f *.c RET' loads all .c files at once, exactly ;; as if you had typed C-x C-f separately for each file. Completion ;; is supported in connection with wildcards. Currently only the `*' ;; wildcard character works. ;; File name completion does not do partial completion of directories ;; on the path, e.g., "/u/b/f" will not complete to "/usr/bin/foo", ;; but you can put *'s in the path to accomplish this: "/u*/b*/f". ;; Stars are required for performance reasons. ;; In addition, this package includes a feature for accessing include ;; files. For example, `C-x C-f RET' reads the file ;; /usr/include/sys/time.h. The variable PC-include-file-path is a ;; list of directories in which to search for include files. Completion ;; is supported in include file names. ;;; Code: (defvar PC-meta-flag t "*If nil, TAB does normal Emacs completion and M-TAB does Partial Completion. If t, TAB does Partial Completion and M-TAB does normal completion.") (defvar PC-word-delimiters "-_. " "*A string of characters which are to be treated as word delimiters by the Partial Completion system. Some arcane rules: If `]' is in this string it must come first. If `^' is in this string it must NOT come first. If `-' is in this string, it must come first or right after `]'. In other words, if S is this string, then `[S]' must be a legal Emacs regular expression \(not containing character ranges like `a-z').") (defvar PC-first-char 'x "*If t, first character of a string to be completed is always taken literally. If nil, word delimiters are handled even if they appear as first character. This controls whether \".e\" matches \".e*\" (t) or \"*.e*\" (nil). If neither nil nor t, first char is literal only for filename completion.") (defvar PC-include-file-path '("/usr/include") "*List of directories in which to look for include files. If this is nil, uses the colon-separated path in $INCPATH instead.") (defvar PC-disable-wildcards nil "Set this to non-nil to disable wildcard support in \\[find-file].") (defvar PC-disable-includes nil "Set this to non-nil to disable include-file support in \\[find-file].") (defvar PC-default-bindings t "Set this to nil to suppress the default partial completion key bindings.") (if PC-default-bindings (progn (define-key minibuffer-local-completion-map "\t" 'PC-complete) (define-key minibuffer-local-completion-map " " 'PC-complete-word) (define-key minibuffer-local-completion-map "?" 'PC-completion-help) (define-key minibuffer-local-completion-map "\e\t" 'PC-complete) (define-key minibuffer-local-completion-map "\e " 'PC-complete-word) (define-key minibuffer-local-completion-map "\e\r" 'PC-force-complete-and-exit) (define-key minibuffer-local-completion-map "\e\n" 'PC-force-complete-and-exit) (define-key minibuffer-local-completion-map "\e?" 'PC-completion-help) (define-key minibuffer-local-must-match-map "\t" 'PC-complete) (define-key minibuffer-local-must-match-map " " 'PC-complete-word) (define-key minibuffer-local-must-match-map "\r" 'PC-complete-and-exit) (define-key minibuffer-local-must-match-map "\n" 'PC-complete-and-exit) (define-key minibuffer-local-must-match-map "?" 'PC-completion-help) (define-key minibuffer-local-must-match-map "\e\t" 'PC-complete) (define-key minibuffer-local-must-match-map "\e " 'PC-complete-word) (define-key minibuffer-local-must-match-map "\e\r" 'PC-complete-and-exit) (define-key minibuffer-local-must-match-map "\e\n" 'PC-complete-and-exit) (define-key minibuffer-local-must-match-map "\e?" 'PC-completion-help) (define-key global-map "\e\t" 'PC-lisp-complete-symbol) )) (defun PC-complete () "Like minibuffer-complete, but allows \"b--di\"-style abbreviations. For example, \"M-x b--di\" would match `byte-recompile-directory', or any name which consists of three or more words, the first beginning with \"b\" and the third beginning with \"di\". The pattern \"b--d\" is ambiguous for `byte-recompile-directory' and `beginning-of-defun', so this would produce a list of completions just like when normal Emacs completions are ambiguous. Word-delimiters for the purposes of Partial Completion are \"-\", \"_\", \".\", and SPC." (interactive) (if (PC-was-meta-key) (minibuffer-complete) (PC-do-completion nil))) (defun PC-complete-word () "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. See `PC-complete' for details. This can be bound to other keys, like `-' and `.', if you wish." (interactive) (if (eq (PC-was-meta-key) PC-meta-flag) (if (eq last-command-char ? ) (minibuffer-complete-word) (self-insert-command 1)) (self-insert-command 1) (if (eobp) (PC-do-completion 'word)))) (defun PC-complete-space () "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. See `PC-complete' for details. This is suitable for binding to other keys which should act just like SPC." (interactive) (if (eq (PC-was-meta-key) PC-meta-flag) (minibuffer-complete-word) (insert " ") (if (eobp) (PC-do-completion 'word)))) (defun PC-complete-and-exit () "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. See `PC-complete' for details." (interactive) (if (eq (PC-was-meta-key) PC-meta-flag) (minibuffer-complete-and-exit) (PC-do-complete-and-exit))) (defun PC-force-complete-and-exit () "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. See `PC-complete' for details." (interactive) (let ((minibuffer-completion-confirm nil)) (PC-do-complete-and-exit))) (defun PC-do-complete-and-exit () (if (= (buffer-size) 0) ; Duplicate the "bug" that Info-menu relies on... (exit-minibuffer) (let ((flag (PC-do-completion 'exit))) (and flag (if (or (eq flag 'complete) (not minibuffer-completion-confirm)) (exit-minibuffer) (PC-temp-minibuffer-message " [Confirm]")))))) (defun PC-completion-help () "Like `minibuffer-completion-help', but allows \"b--di\"-style abbreviations. See `PC-complete' for details." (interactive) (if (eq (PC-was-meta-key) PC-meta-flag) (minibuffer-completion-help) (PC-do-completion 'help))) (defun PC-was-meta-key () (or (/= (length (this-command-keys)) 1) (let ((key (aref (this-command-keys) 0))) (if (integerp key) (>= key 128) (not (null (memq 'meta (event-modifiers key)))))))) (defvar PC-ignored-extensions 'empty-cache) (defvar PC-delims 'empty-cache) (defvar PC-ignored-regexp nil) (defvar PC-word-failed-flag nil) (defvar PC-delim-regex nil) (defvar PC-ndelims-regex nil) (defvar PC-delims-list nil) (defun PC-do-completion (&optional mode beg end) (or beg (setq beg (point-min))) (or end (setq end (point-max))) (let* ((table minibuffer-completion-table) (pred minibuffer-completion-predicate) (filename (memq table '(read-file-name-internal read-directory-name-internal))) (dirname nil) dirlength (str (buffer-substring beg end)) (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str))) (ambig nil) basestr regex p offset (poss nil) helpposs (case-fold-search completion-ignore-case)) ;; Check if buffer contents can already be considered complete (if (and (eq mode 'exit) (PC-is-complete-p str table pred)) 'complete ;; Record how many characters at the beginning are not included ;; in completion. (setq dirlength (if filename (length (file-name-directory str)) 0)) ;; Do substitutions in directory names (and filename (not (equal str (setq p (substitute-in-file-name str)))) (progn (delete-region beg end) (insert p) (setq str p end (+ beg (length str))))) ;; Prepare various delimiter strings (or (equal PC-word-delimiters PC-delims) (setq PC-delims PC-word-delimiters PC-delim-regex (concat "[" PC-delims "]") PC-ndelims-regex (concat "[^" PC-delims "]*") PC-delims-list (append PC-delims nil))) ;; Look for wildcard expansions in directory name (and filename (string-match "\\*.*/" str) (let ((pat str) files) (setq p (1+ (string-match "/[^/]*\\'" pat))) (while (setq p (string-match PC-delim-regex pat p)) (setq pat (concat (substring pat 0 p) "*" (substring pat p)) p (+ p 2))) (setq files (PC-expand-many-files (concat pat "*"))) (if files (let ((dir (file-name-directory (car files))) (p files)) (while (and (setq p (cdr p)) (equal dir (file-name-directory (car p))))) (if p (setq filename nil table nil pred nil ambig t) (delete-region beg end) (setq str (concat dir (file-name-nondirectory str))) (insert str) (setq end (+ beg (length str))))) (setq filename nil table nil pred nil)))) ;; Strip directory name if appropriate (if filename (if incname (setq basestr (substring str incname) dirname (substring str 0 incname)) (setq basestr (file-name-nondirectory str) dirname (file-name-directory str))) (setq basestr str)) ;; Convert search pattern to a standard regular expression (setq regex (regexp-quote basestr) offset (if (and (> (length regex) 0) (not (eq (aref basestr 0) ?\*)) (or (eq PC-first-char t) (and PC-first-char filename))) 1 0) p offset) (while (setq p (string-match PC-delim-regex regex p)) (if (eq (aref regex p) ? ) (setq regex (concat (substring regex 0 p) PC-ndelims-regex PC-delim-regex (substring regex (1+ p))) p (+ p (length PC-ndelims-regex) (length PC-delim-regex))) (let ((bump (if (memq (aref regex p) '(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\)) -1 0))) (setq regex (concat (substring regex 0 (+ p bump)) PC-ndelims-regex (substring regex (+ p bump))) p (+ p (length PC-ndelims-regex) 1))))) (setq p 0) (if filename (while (setq p (string-match "\\\\\\*" regex p)) (setq regex (concat (substring regex 0 p) "[^/]*" (substring regex (+ p 2)))))) ;;(setq the-regex regex) (setq regex (concat "\\`" regex)) ;; Find an initial list of possible completions (if (not (setq p (string-match (concat PC-delim-regex (if filename "\\|\\*" "")) str (+ (length dirname) offset)))) ;; Minibuffer contains no hyphens -- simple case! (setq poss (all-completions str table pred)) ;; Use all-completions to do an initial cull. This is a big win, ;; since all-completions is written in C! (let ((compl (all-completions (substring str 0 p) table pred))) (setq p compl) (while p (and (string-match regex (car p)) (setq poss (cons (car p) poss))) (setq p (cdr p))))) ;; Now we have a list of possible completions (cond ;; No valid completions found ((null poss) (if (and (eq mode 'word) (not PC-word-failed-flag)) (let ((PC-word-failed-flag t)) (delete-backward-char 1) (PC-do-completion 'word)) (beep) (PC-temp-minibuffer-message (if ambig " [Ambiguous dir name]" (if (eq mode 'help) " [No completions]" " [No match]"))) nil)) ;; More than one valid completion found ((or (cdr (setq helpposs poss)) (memq mode '(help word))) ;; Handle completion-ignored-extensions (and filename (not (eq mode 'help)) (let ((p2 poss)) ;; Build a regular expression representing the extensions list (or (equal completion-ignored-extensions PC-ignored-extensions) (setq PC-ignored-regexp (concat "\\(" (mapconcat 'regexp-quote (setq PC-ignored-extensions completion-ignored-extensions) "\\|") "\\)\\'"))) ;; Check if there are any without an ignored extension (setq p nil) (while p2 (or (string-match PC-ignored-regexp (car p2)) (setq p (cons (car p2) p))) (setq p2 (cdr p2))) ;; If there are "good" names, use them (and p (setq poss p)))) ;; Is the actual string one of the possible completions? (setq p (and (not (eq mode 'help)) poss)) (while (and p (not (equal (car p) basestr))) (setq p (cdr p))) (and p (null mode) (PC-temp-minibuffer-message " [Complete, but not unique]")) (if (and p (not (and (null mode) (eq this-command last-command)))) t ;; If ambiguous, try for a partial completion (let ((improved nil) prefix (pt nil) (skip "\\`")) ;; Check if next few letters are the same in all cases (if (and (not (eq mode 'help)) (setq prefix (try-completion "" (mapcar 'list poss)))) (let ((first t) i) (if (eq mode 'word) (setq prefix (PC-chop-word prefix basestr))) (goto-char (+ beg (length dirname))) (while (and (progn (setq i 0) (while (< i (length prefix)) (if (and (< (point) end) (eq (aref prefix i) (following-char))) (forward-char 1) (if (and (< (point) end) (or (and (looking-at " ") (memq (aref prefix i) PC-delims-list)) (eq (downcase (aref prefix i)) (downcase (following-char))))) (progn (delete-char 1) (setq end (1- end))) (and filename (looking-at "\\*") (progn (delete-char 1) (setq end (1- end)))) (setq improved t)) ;; Use format to discard text properties. (insert (format "%s" (substring prefix i (1+ i)))) (setq end (1+ end))) (setq i (1+ i))) (or pt (equal (point) beg) (setq pt (point))) (looking-at PC-delim-regex)) (setq skip (concat skip (regexp-quote prefix) PC-ndelims-regex) prefix (try-completion "" (mapcar (function (lambda (x) (list (and (string-match skip x) (substring x (match-end 0)))))) poss))) (or (> i 0) (> (length prefix) 0)) (or (not (eq mode 'word)) (and first (> (length prefix) 0) (setq first nil prefix (substring prefix 0 1)))))) (goto-char (if (eq mode 'word) end (or pt beg))))) (if (and (eq mode 'word) (not PC-word-failed-flag)) (if improved ;; We changed it... would it be complete without the space? (if (PC-is-complete-p (buffer-substring 1 (1- end)) table pred) (delete-region (1- end) end))) (if improved ;; We changed it... enough to be complete? (and (eq mode 'exit) (PC-is-complete-p (buffer-string) table pred)) ;; If totally ambiguous, display a list of completions (if (or completion-auto-help (eq mode 'help)) (with-output-to-temp-buffer "*Completions*" (display-completion-list (sort helpposs 'string-lessp)) (save-excursion (set-buffer standard-output) ;; Record which part of the buffer we are completing ;; so that choosing a completion from the list ;; knows how much old text to replace. (setq completion-base-size dirlength))) (PC-temp-minibuffer-message " [Next char not unique]")) nil))))) ;; Only one possible completion (t (if (equal basestr (car poss)) (if (null mode) (PC-temp-minibuffer-message " [Sole completion]")) (delete-region beg end) (insert (format "%s" (if filename (substitute-in-file-name (concat dirname (car poss))) (car poss))))) t))))) (defun PC-is-complete-p (str table pred) (let ((res (if (listp table) (assoc str table) (if (vectorp table) (or (equal str "nil") ; heh, heh, heh (intern-soft str table)) (funcall table str pred 'lambda))))) (and res (or (not pred) (and (not (listp table)) (not (vectorp table))) (funcall pred res)) res))) (defun PC-chop-word (new old) (let ((i -1) (j -1)) (while (and (setq i (string-match PC-delim-regex old (1+ i))) (setq j (string-match PC-delim-regex new (1+ j))))) (if (and j (or (not PC-word-failed-flag) (setq j (string-match PC-delim-regex new (1+ j))))) (substring new 0 (1+ j)) new))) (defvar PC-not-minibuffer nil) (defun PC-temp-minibuffer-message (m) "A Lisp version of `temp_minibuffer_message' from minibuf.c." (if PC-not-minibuffer (progn (message m) (sit-for 2) (message "")) (if (fboundp 'temp-minibuffer-message) (temp-minibuffer-message m) (let ((savemax (point-max))) (save-excursion (goto-char (point-max)) (insert m)) (let ((inhibit-quit t)) (sit-for 2) (delete-region savemax (point-max)) (if quit-flag (setq quit-flag nil unread-command-char 7))))))) (defun PC-lisp-complete-symbol () "Perform completion on Lisp symbol preceding point. That symbol is compared against the symbols that exist and any additional characters determined by what is there are inserted. If the symbol starts just after an open-parenthesis, only symbols with function definitions are considered. Otherwise, all symbols with function definitions, values or properties are considered." (interactive) (let* ((end (point)) (buffer-syntax (syntax-table)) (beg (unwind-protect (save-excursion (if lisp-mode-syntax-table (set-syntax-table lisp-mode-syntax-table)) (backward-sexp 1) (while (= (char-syntax (following-char)) ?\') (forward-char 1)) (point)) (set-syntax-table buffer-syntax))) (minibuffer-completion-table obarray) (minibuffer-completion-predicate (if (eq (char-after (1- beg)) ?\() 'fboundp (function (lambda (sym) (or (boundp sym) (fboundp sym) (symbol-plist sym)))))) (PC-not-minibuffer t)) (PC-do-completion nil beg end))) ;;; Wildcards in `C-x C-f' command. This is independent from the main ;;; completion code, except for `PC-expand-many-files' which is called ;;; when "*"'s are found in the path during filename completion. (The ;;; above completion code always understands "*"'s, except in file paths, ;;; without relying on the following code.) (defvar PC-many-files-list nil) (defun PC-try-load-many-files () (if (string-match "\\*" buffer-file-name) (let* ((pat buffer-file-name) (files (PC-expand-many-files pat)) (first (car files)) (next files)) (kill-buffer (current-buffer)) (or files (error "No matching files")) (save-window-excursion (while (setq next (cdr next)) (let ((buf (find-file-noselect (car next)))) (switch-to-buffer buf)))) ;; This modifies the "buf" variable inside find-file-noselect. (setq buf (get-file-buffer first)) (if buf nil ; should do verify-visited-file-modtime stuff. (setq filename first) (setq buf (create-file-buffer filename)) (set-buffer buf) (erase-buffer) (insert-file-contents filename t)) (if (cdr files) (setq PC-many-files-list (mapconcat (if (string-match "\\*.*/" pat) 'identity 'file-name-nondirectory) (cdr files) ", ") find-file-hooks (cons 'PC-after-load-many-files find-file-hooks))) ;; This modifies the "error" variable inside find-file-noselect. (setq error nil) t) nil)) (defun PC-after-load-many-files () (setq find-file-hooks (delq 'PC-after-load-many-files find-file-hooks)) (message "Also loaded %s." PC-many-files-list)) (defun PC-expand-many-files (name) (save-excursion (set-buffer (generate-new-buffer " *Glob Output*")) (erase-buffer) (shell-command (concat "echo " name) t) (goto-char (point-min)) (if (looking-at ".*No match") nil (insert "(\"") (while (search-forward " " nil t) (delete-backward-char 1) (insert "\" \"")) (goto-char (point-max)) (delete-backward-char 1) (insert "\")") (goto-char (point-min)) (let ((files (read (current-buffer)))) (kill-buffer (current-buffer)) files)))) (or PC-disable-wildcards (memq 'PC-try-load-many-files find-file-not-found-hooks) (setq find-file-not-found-hooks (cons 'PC-try-load-many-files find-file-not-found-hooks))) ;;; Facilities for loading C header files. This is independent from the ;;; main completion code. See also the variable `PC-include-file-path' ;;; at top of this file. (defun PC-look-for-include-file () (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name)) (let ((name (substring (buffer-file-name) (match-beginning 1) (match-end 1))) (punc (aref (buffer-file-name) (match-beginning 0))) (path nil) new-buf) (kill-buffer (current-buffer)) (if (equal name "") (save-excursion (set-buffer (car (buffer-list))) (save-excursion (beginning-of-line) (if (looking-at "[ \t]*#[ \t]*include[ \t]+[<\"]\\(.+\\)[>\"][ \t]*[\n/]") (setq name (buffer-substring (match-beginning 1) (match-end 1)) punc (char-after (1- (match-beginning 1)))) ;; Suggested by Frank Siebenlist: (if (or (looking-at "[ \t]*([ \t]*load[ \t]+\"\\([^\"]+\\)\"") (looking-at "[ \t]*([ \t]*load-library[ \t]+\"\\([^\"]+\\)\"") (looking-at "[ \t]*([ \t]*require[ \t]+'\\([^\t )]+\\)[\t )]")) (progn (setq name (buffer-substring (match-beginning 1) (match-end 1)) punc ?\< path load-path) (if (string-match "\\.elc$" name) (setq name (substring name 0 -1)) (or (string-match "\\.el$" name) (setq name (concat name ".el"))))) (error "Not on an #include line")))))) (or (string-match "\\.[a-zA-Z0-9]+$" name) (setq name (concat name ".h"))) (if (eq punc ?\<) (let ((path (or path (PC-include-file-path)))) (while (and path (not (file-exists-p (concat (file-name-as-directory (car path)) name)))) (setq path (cdr path))) (if path (setq name (concat (file-name-as-directory (car path)) name)) (error "No such include file: <%s>" name))) (let ((dir (save-excursion (set-buffer (car (buffer-list))) default-directory))) (if (file-exists-p (concat dir name)) (setq name (concat dir name)) (error "No such include file: \"%s\"" name)))) (setq new-buf (get-file-buffer name)) (if new-buf ;; no need to verify last-modified time for this! (set-buffer new-buf) (setq new-buf (create-file-buffer name)) (set-buffer new-buf) (erase-buffer) (insert-file-contents name t)) (setq filename name error nil buf new-buf) t) nil)) (defun PC-include-file-path () (or PC-include-file-path (let ((env (getenv "INCPATH")) (path nil) pos) (or env (error "No include file path specified")) (while (setq pos (string-match ":[^:]+$" env)) (setq path (cons (substring env (1+ pos)) path) env (substring env 0 pos))) path))) ;;; This is adapted from lib-complete.el, by Mike Williams. (defun PC-include-file-all-completions (file search-path &optional full) "Return all completions for FILE in any directory on SEARCH-PATH. If optional third argument FULL is non-nil, returned pathnames should be absolute rather than relative to some directory on the SEARCH-PATH." (setq search-path (mapcar '(lambda (dir) (if dir (file-name-as-directory dir) default-directory)) search-path)) (if (file-name-absolute-p file) ;; It's an absolute file name, so don't need search-path (progn (setq file (expand-file-name file)) (file-name-all-completions (file-name-nondirectory file) (file-name-directory file))) (let ((subdir (file-name-directory file)) (ndfile (file-name-nondirectory file)) file-lists) ;; Append subdirectory part to each element of search-path (if subdir (setq search-path (mapcar '(lambda (dir) (concat dir subdir)) search-path) file )) ;; Make list of completions in each directory on search-path (while search-path (let* ((dir (car search-path)) (subdir (if full dir subdir))) (if (file-directory-p dir) (progn (setq file-lists (cons (mapcar '(lambda (file) (concat subdir file)) (file-name-all-completions ndfile (car search-path))) file-lists)))) (setq search-path (cdr search-path)))) ;; Compress out duplicates while building complete list (slloooow!) (let ((sorted (sort (apply 'nconc file-lists) '(lambda (x y) (not (string-lessp x y))))) compressed) (while sorted (if (equal (car sorted) (car compressed)) nil (setq compressed (cons (car sorted) compressed))) (setq sorted (cdr sorted))) compressed)))) (defvar PC-old-read-file-name-internal nil) (defun PC-read-include-file-name-internal (string dir action) (if (string-match "<\\([^\"<>]*\\)>?$" string) (let* ((name (substring string (match-beginning 1) (match-end 1))) (str2 (substring string (match-beginning 0))) (completion-table (mapcar (function (lambda (x) (list (format "<%s>" x)))) (PC-include-file-all-completions name (PC-include-file-path))))) (cond ((not completion-table) nil) ((eq action nil) (try-completion str2 completion-table nil)) ((eq action t) (all-completions str2 completion-table nil)) ((eq action 'lambda) (eq (try-completion str2 completion-table nil) t)))) (funcall PC-old-read-file-name-internal string dir action))) (or PC-disable-includes (memq 'PC-look-for-include-file find-file-not-found-hooks) (setq find-file-not-found-hooks (cons 'PC-look-for-include-file find-file-not-found-hooks))) (or PC-disable-includes PC-old-read-file-name-internal (progn (setq PC-old-read-file-name-internal (symbol-function 'read-file-name-internal)) (fset 'read-file-name-internal 'PC-read-include-file-name-internal))) (provide 'complete) ;;; End. emacs-19.30/lisp/completion.el100444 12120 1 273553 6055006576 14632 0ustar rmsdaemon;;; completion.el --- dynamic word-completion code ;; Copyright (C) 1990, 1993, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: abbrev ;; Author: Jim Salem of Thinking Machines Inc. ;; (ideas suggested by Brewster Kahle) ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; ;;; What to put in .emacs ;;;----------------------- ;;; (load "completion") ;;; (initialize-completions) ;;;--------------------------------------------------------------------------- ;;; Documentation [Slightly out of date] ;;;--------------------------------------------------------------------------- ;;; (also check the documentation string of the functions) ;;; ;;; Introduction ;;;--------------- ;;; ;;; After you type a few characters, pressing the "complete" key inserts ;;; the rest of the word you are likely to type. ;;; ;;; This watches all the words that you type and remembers them. When ;;; typing a new word, pressing "complete" (meta-return) "completes" the ;;; word by inserting the most recently used word that begins with the ;;; same characters. If you press meta-return repeatedly, it cycles ;;; through all the words it knows about. ;;; ;;; If you like the completion then just continue typing, it is as if you ;;; entered the text by hand. If you want the inserted extra characters ;;; to go away, type control-w or delete. More options are described below. ;;; ;;; The guesses are made in the order of the most recently "used". Typing ;;; in a word and then typing a separator character (such as a space) "uses" ;;; the word. So does moving a cursor over the word. If no words are found, ;;; it uses an extended version of the dabbrev style completion. ;;; ;;; You automatically save the completions you use to a file between ;;; sessions. ;;; ;;; Completion enables programmers to enter longer, more descriptive ;;; variable names while typing fewer keystrokes than they normally would. ;;; ;;; ;;; Full documentation ;;;--------------------- ;;; ;;; A "word" is any string containing characters with either word or symbol ;;; syntax. [E.G. Any alphanumeric string with hyphens, underscores, etc.] ;;; Unless you change the constants, you must type at least three characters ;;; for the word to be recognized. Only words longer than 6 characters are ;;; saved. ;;; ;;; When you load this file, completion will be on. I suggest you use the ;;; compiled version (because it is noticeably faster). ;;; ;;; M-X completion-mode toggles whether or not new words are added to the ;;; database by changing the value of enable-completion. ;;; ;;; SAVING/LOADING COMPLETIONS ;;; Completions are automatically saved from one session to another ;;; (unless save-completions-flag or enable-completion is nil). ;;; Loading this file (or calling initialize-completions) causes EMACS ;;; to load a completions database for a saved completions file ;;; (default: ~/.completions). When you exit, EMACS saves a copy of the ;;; completions that you ;;; often use. When you next start, EMACS loads in the saved completion file. ;;; ;;; The number of completions saved depends loosely on ;;; *saved-completions-decay-factor*. Completions that have never been ;;; inserted via "complete" are not saved. You are encouraged to experiment ;;; with different functions (see compute-completion-min-num-uses). ;;; ;;; Some completions are permanent and are always saved out. These ;;; completions have their num-uses slot set to T. Use ;;; add-permanent-completion to do this ;;; ;;; Completions are saved only if enable-completion is T. The number of old ;;; versions kept of the saved completions file is controlled by ;;; completions-file-versions-kept. ;;; ;;; COMPLETE KEY OPTIONS ;;; The complete function takes a numeric arguments. ;;; control-u :: leave the point at the beginning of the completion rather ;;; than the middle. ;;; a number :: rotate through the possible completions by that amount ;;; `-' :: same as -1 (insert previous completion) ;;; ;;; HOW THE DATABASE IS MAINTAINED ;;; ;;; ;;; UPDATING THE DATABASE MANUALLY ;;; m-x kill-completion ;;; kills the completion at point. ;;; m-x add-completion ;;; m-x add-permanent-completion ;;; ;;; UPDATING THE DATABASE FROM A SOURCE CODE FILE ;;; m-x add-completions-from-buffer ;;; Parses all the definition names from a C or LISP mode buffer and ;;; adds them to the completion database. ;;; ;;; m-x add-completions-from-lisp-file ;;; Parses all the definition names from a C or Lisp mode file and ;;; adds them to the completion database. ;;; ;;; UPDATING THE DATABASE FROM A TAGS TABLE ;;; m-x add-completions-from-tags-table ;;; Adds completions from the current tags-table-buffer. ;;; ;;; HOW A COMPLETION IS FOUND ;;; ;;; ;;; STRING CASING ;;; Completion is string case independent if case-fold-search has its ;;; normal default of T. Also when the completion is inserted the case of the ;;; entry is coerced appropriately. ;;; [E.G. APP --> APPROPRIATELY app --> appropriately ;;; App --> Appropriately] ;;; ;;; INITIALIZATION ;;; The form `(initialize-completions)' initializes the completion system by ;;; trying to load in the user's completions. After the first cal, further ;;; calls have no effect so one should be careful not to put the form in a ;;; site's standard site-init file. ;;; ;;;--------------------------------------------------------------------------- ;;; ;;; ;;;--------------------------------------------------------------------------- ;;; Functions you might like to call ;;;--------------------------------------------------------------------------- ;;; ;;; add-completion string &optional num-uses ;;; Adds a new string to the database ;;; ;;; add-permanent-completion string ;;; Adds a new string to the database with num-uses = T ;;; ;;; kill-completion string ;;; Kills the completion from the database. ;;; ;;; clear-all-completions ;;; Clears the database ;;; ;;; list-all-completions ;;; Returns a list of all completions. ;;; ;;; ;;; next-completion string &optional index ;;; Returns a completion entry that starts with string. ;;; ;;; find-exact-completion string ;;; Returns a completion entry that exactly matches string. ;;; ;;; complete ;;; Inserts a completion at point ;;; ;;; initialize-completions ;;; Loads the completions file and sets up so that exiting emacs will ;;; save them. ;;; ;;; save-completions-to-file &optional filename ;;; load-completions-from-file &optional filename ;;; ;;;----------------------------------------------- ;;; Other functions ;;;----------------------------------------------- ;;; ;;; get-completion-list string ;;; ;;; These things are for manipulating the structure ;;; make-completion string num-uses ;;; completion-num-uses completion ;;; completion-string completion ;;; set-completion-num-uses completion num-uses ;;; set-completion-string completion string ;;; ;;; ;;;----------------------------------------------- ;;; To Do :: (anybody ?) ;;;----------------------------------------------- ;;; ;;; Implement Lookup and keyboard interface in C ;;; Add package prefix smarts (for Common Lisp) ;;; Add autoprompting of possible completions after every keystroke (fast ;;; terminals only !) ;;; Add doc. to texinfo ;;; ;;; ;;;----------------------------------------------- ;;; Change Log: ;;;----------------------------------------------- ;;; Sometime in '84 Brewster implemented a somewhat buggy version for ;;; Symbolics LISPMs. ;;; Jan. '85 Jim became enamored of the idea and implemented a faster, ;;; more robust version. ;;; With input from many users at TMC, (rose, craig, and gls come to mind), ;;; the current style of interface was developed. ;;; 9/87, Jim and Brewster took terminals home. Yuck. After ;;; complaining for a while Brewester implemented a subset of the current ;;; LISPM version for GNU Emacs. ;;; 8/88 After complaining for a while (and with sufficient ;;; promised rewards), Jim reimplemented a version of GNU completion ;;; superior to that of the LISPM version. ;;; ;;;----------------------------------------------- ;;; Acknowledgements ;;;----------------------------------------------- ;;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com), ;;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu, ;;; ;;;----------------------------------------------- ;;; Change Log ;;;----------------------------------------------- ;;; From version 9 to 10 ;;; - Allowance for non-integral *completion-version* nos. ;;; - Fix cmpl-apply-as-top-level for keyboard macros ;;; - Fix broken completion merging (in save-completions-to-file) ;;; - More misc. fixes for version 19.0 of emacs ;;; ;;; From Version 8 to 9 ;;; - Ported to version 19.0 of emacs (backcompatible with version 18) ;;; - Added add-completions-from-tags-table (with thanks to eero@media-lab) ;;; ;;; From Version 7 to 8 ;;; - Misc. changes to comments ;;; - new completion key bindings: c-x o, M->, M-<, c-a, c-e ;;; - cdabbrev now checks all the visible window buffers and the "other buffer" ;;; - `%' is now a symbol character rather than a separator (except in C mode) ;;; ;;; From Version 6 to 7 ;;; - Fixed bug with saving out .completion file the first time ;;; ;;; From Version 5 to 6 ;;; - removed statistics recording ;;; - reworked advise to handle autoloads ;;; - Fixed fortran mode support ;;; - Added new cursor motion triggers ;;; ;;; From Version 4 to 5 ;;; - doesn't bother saving if nothing has changed ;;; - auto-save if haven't used for a 1/2 hour ;;; - save period extended to two weeks ;;; - minor fix to capitalization code ;;; - added *completion-auto-save-period* to variables recorded. ;;; - added reenter protection to cmpl-record-statistics-filter ;;; - added backup protection to save-completions-to-file (prevents ;;; problems with disk full errors) ;;; Code: ;;;--------------------------------------------------------------------------- ;;; User changeable parameters ;;;--------------------------------------------------------------------------- (defvar enable-completion t "*Non-nil means enable recording and saving of completions. If nil, no new words added to the database or saved to the init file.") (defvar save-completions-flag t "*Non-nil means save most-used completions when exiting Emacs. See also `saved-completions-retention-time'.") (defvar save-completions-file-name "~/.completions" "*The filename to save completions to.") (defvar save-completions-retention-time 336 "*Discard a completion if unused for this many hours. \(1 day = 24, 1 week = 168). If this is 0, non-permanent completions will not be saved unless these are used. Default is two weeks.") (defvar completion-on-separator-character nil "*Non-nil means separator characters mark previous word as used. This means the word will be saved as a completion.") (defvar completions-file-versions-kept kept-new-versions "*Number of versions to keep for the saved completions file.") (defvar completion-prompt-speed-threshold 4800 "*Minimum output speed at which to display next potential completion.") (defvar completion-cdabbrev-prompt-flag nil "*If non-nil, the next completion prompt does a cdabbrev search. This can be time consuming.") (defvar completion-search-distance 15000 "*How far to search in the buffer when looking for completions. In number of characters. If nil, search the whole buffer.") (defvar completions-merging-modes '(lisp c) "*List of modes {`c' or `lisp'} for automatic completions merging. Definitions from visited files which have these modes are automatically added to the completion database.") ;;;(defvar *record-cmpl-statistics-p* nil ;;; "*If non-nil, record completion statistics.") ;;;(defvar *completion-auto-save-period* 1800 ;;; "*The period in seconds to wait for emacs to be idle before autosaving ;;;the completions. Default is a 1/2 hour.") (defconst completion-min-length nil ;; defined below in eval-when "*The minimum length of a stored completion. DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") (defconst completion-max-length nil ;; defined below in eval-when "*The maximum length of a stored completion. DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") (defconst completion-prefix-min-length nil ;; defined below in eval-when "The minimum length of a completion search string. DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") (defmacro eval-when-compile-load-eval (&rest body) ;; eval everything before expanding (mapcar 'eval body) (cons 'progn body)) (eval-when-compile (defvar completion-gensym-counter 0) (defun completion-gensym (&optional arg) "Generate a new uninterned symbol. The name is made by appending a number to PREFIX, default \"G\"." (let ((prefix (if (stringp arg) arg "G")) (num (if (integerp arg) arg (prog1 completion-gensym-counter (setq completion-gensym-counter (1+ completion-gensym-counter)))))) (make-symbol (format "%s%d" prefix num))))) (defmacro completion-dolist (spec &rest body) "(completion-dolist (VAR LIST [RESULT]) BODY...): loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. Then evaluate RESULT to get return value, default nil." (let ((temp (completion-gensym "--dolist-temp--"))) (append (list 'let (list (list temp (nth 1 spec)) (car spec)) (append (list 'while temp (list 'setq (car spec) (list 'car temp))) body (list (list 'setq temp (list 'cdr temp))))) (if (cdr (cdr spec)) (cons (list 'setq (car spec) nil) (cdr (cdr spec))) '(nil))))) (defun completion-eval-when () (eval-when-compile-load-eval ;; These vars. are defined at both compile and load time. (setq completion-min-length 6) (setq completion-max-length 200) (setq completion-prefix-min-length 3))) (completion-eval-when) ;;;--------------------------------------------------------------------------- ;;; Internal Variables ;;;--------------------------------------------------------------------------- (defvar cmpl-initialized-p nil "Set to t when the completion system is initialized. Indicates that the old completion file has been read in.") (defvar cmpl-completions-accepted-p nil "Set to t as soon as the first completion has been accepted. Used to decide whether to save completions.") (defvar cmpl-preceding-syntax) (defvar completion-string) ;;;--------------------------------------------------------------------------- ;;; Low level tools ;;;--------------------------------------------------------------------------- ;;;----------------------------------------------- ;;; Misc. ;;;----------------------------------------------- (defun minibuffer-window-selected-p () "True iff the current window is the minibuffer." (window-minibuffer-p (selected-window))) ;; This used to be `(eval form)'. Eval FORM at run time now. (defmacro cmpl-read-time-eval (form) form) ;;;----------------------------------------------- ;;; String case coercion ;;;----------------------------------------------- (defun cmpl-string-case-type (string) "Returns :capitalized, :up, :down, :mixed, or :neither." (let ((case-fold-search nil)) (cond ((string-match "[a-z]" string) (cond ((string-match "[A-Z]" string) (cond ((and (> (length string) 1) (null (string-match "[A-Z]" string 1))) ':capitalized) (t ':mixed))) (t ':down))) (t (cond ((string-match "[A-Z]" string) ':up) (t ':neither)))) )) ;;; Tests - ;;; (cmpl-string-case-type "123ABCDEF456") --> :up ;;; (cmpl-string-case-type "123abcdef456") --> :down ;;; (cmpl-string-case-type "123aBcDeF456") --> :mixed ;;; (cmpl-string-case-type "123456") --> :neither ;;; (cmpl-string-case-type "Abcde123") --> :capitalized (defun cmpl-coerce-string-case (string case-type) (cond ((eq case-type ':down) (downcase string)) ((eq case-type ':up) (upcase string)) ((eq case-type ':capitalized) (setq string (downcase string)) (aset string 0 (logand ?\337 (aref string 0))) string) (t string) )) (defun cmpl-merge-string-cases (string-to-coerce given-string) (let ((string-case-type (cmpl-string-case-type string-to-coerce)) ) (cond ((memq string-case-type '(:down :up :capitalized)) ;; Found string is in a standard case. Coerce to a type based on ;; the given string (cmpl-coerce-string-case string-to-coerce (cmpl-string-case-type given-string)) ) (t ;; If the found string is in some unusual case, just insert it ;; as is string-to-coerce) ))) ;;; Tests - ;;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456 ;;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456 ;;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456 ;;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456 (defun cmpl-hours-since-origin () (let ((time (current-time))) (truncate (+ (* (/ (car time) 3600.0) (lsh 1 16)) (/ (nth 2 time) 3600.0))))) ;;;--------------------------------------------------------------------------- ;;; "Symbol" parsing functions ;;;--------------------------------------------------------------------------- ;;; The functions symbol-before-point, symbol-under-point, etc. quickly return ;;; an appropriate symbol string. The strategy is to temporarily change ;;; the syntax table to enable fast symbol searching. There are three classes ;;; of syntax in these "symbol" syntax tables :: ;;; ;;; syntax (?_) - "symbol" chars (e.g. alphanumerics) ;;; syntax (?w) - symbol chars to ignore at end of words (e.g. period). ;;; syntax (? ) - everything else ;;; ;;; Thus by judicious use of scan-sexps and forward-word, we can get ;;; the word we want relatively fast and without consing. ;;; ;;; Why do we need a separate category for "symbol chars to ignore at ends" ? ;;; For example, in LISP we want starting :'s trimmed ;;; so keyword argument specifiers also define the keyword completion. And, ;;; for example, in C we want `.' appearing in a structure ref. to ;;; be kept intact in order to store the whole structure ref.; however, if ;;; it appears at the end of a symbol it should be discarded because it is ;;; probably used as a period. ;;; Here is the default completion syntax :: ;;; Symbol chars :: A-Z a-z 0-9 @ / \ * + ~ $ < > % ;;; Symbol chars to ignore at ends :: _ : . - ;;; Separator chars. :: ! ^ & ( ) = ` | { } [ ] ; " ' # ;;; , ? ;;; Mode specific differences and notes :: ;;; LISP diffs -> ;;; Symbol chars :: ! & ? = ^ ;;; ;;; C diffs -> ;;; Separator chars :: + * / : % ;;; A note on the hyphen (`-'). Perhaps the hyphen should also be a separator ;;; char., however, we wanted to have completion symbols include pointer ;;; references. For example, "foo->bar" is a symbol as far as completion is ;;; concerned. ;;; ;;; FORTRAN diffs -> ;;; Separator chars :: + - * / : ;;; ;;; Pathname diffs -> ;;; Symbol chars :: . ;;; Of course there is no pathname "mode" and in fact we have not implemented ;;; this table. However, if there was such a mode, this is what it would look ;;; like. ;;;----------------------------------------------- ;;; Table definitions ;;;----------------------------------------------- (defun cmpl-make-standard-completion-syntax-table () (let ((table (make-syntax-table)) ;; default syntax is whitespace i) ;; alpha chars (setq i 0) (while (< i 26) (modify-syntax-entry (+ ?a i) "_" table) (modify-syntax-entry (+ ?A i) "_" table) (setq i (1+ i))) ;; digit chars. (setq i 0) (while (< i 10) (modify-syntax-entry (+ ?0 i) "_" table) (setq i (1+ i))) ;; Other ones (let ((symbol-chars '(?@ ?/ ?\\ ?* ?+ ?~ ?$ ?< ?> ?%)) (symbol-chars-ignore '(?_ ?- ?: ?.)) ) (completion-dolist (char symbol-chars) (modify-syntax-entry char "_" table)) (completion-dolist (char symbol-chars-ignore) (modify-syntax-entry char "w" table) ) ) table)) (defconst cmpl-standard-syntax-table (cmpl-make-standard-completion-syntax-table)) (defun cmpl-make-lisp-completion-syntax-table () (let ((table (copy-syntax-table cmpl-standard-syntax-table)) (symbol-chars '(?! ?& ?? ?= ?^)) ) (completion-dolist (char symbol-chars) (modify-syntax-entry char "_" table)) table)) (defun cmpl-make-c-completion-syntax-table () (let ((table (copy-syntax-table cmpl-standard-syntax-table)) (separator-chars '(?+ ?* ?/ ?: ?%)) ) (completion-dolist (char separator-chars) (modify-syntax-entry char " " table)) table)) (defun cmpl-make-fortran-completion-syntax-table () (let ((table (copy-syntax-table cmpl-standard-syntax-table)) (separator-chars '(?+ ?- ?* ?/ ?:)) ) (completion-dolist (char separator-chars) (modify-syntax-entry char " " table)) table)) (defconst cmpl-lisp-syntax-table (cmpl-make-lisp-completion-syntax-table)) (defconst cmpl-c-syntax-table (cmpl-make-c-completion-syntax-table)) (defconst cmpl-fortran-syntax-table (cmpl-make-fortran-completion-syntax-table)) (defvar cmpl-syntax-table cmpl-standard-syntax-table "This variable holds the current completion syntax table.") (make-variable-buffer-local 'cmpl-syntax-table) ;;;----------------------------------------------- ;;; Installing the appropriate mode tables ;;;----------------------------------------------- (add-hook 'lisp-mode-hook '(lambda () (setq cmpl-syntax-table cmpl-lisp-syntax-table))) (add-hook 'c-mode-hook '(lambda () (setq cmpl-syntax-table cmpl-c-syntax-table))) (add-hook 'fortran-mode-hook '(lambda () (setq cmpl-syntax-table cmpl-fortran-syntax-table) (completion-setup-fortran-mode))) ;;;----------------------------------------------- ;;; Symbol functions ;;;----------------------------------------------- (defvar cmpl-symbol-start nil "Holds first character of symbol, after any completion symbol function.") (defvar cmpl-symbol-end nil "Holds last character of symbol, after any completion symbol function.") ;;; These are temp. vars. we use to avoid using let. ;;; Why ? Small speed improvement. (defvar cmpl-saved-syntax nil) (defvar cmpl-saved-point nil) (defun symbol-under-point () "Returns the symbol that the point is currently on. But only if it is longer than `completion-min-length'." (setq cmpl-saved-syntax (syntax-table)) (set-syntax-table cmpl-syntax-table) (cond ;; Cursor is on following-char and after preceding-char ((memq (char-syntax (following-char)) '(?w ?_)) (setq cmpl-saved-point (point) cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1) cmpl-symbol-end (scan-sexps cmpl-saved-point 1)) ;; remove chars to ignore at the start (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) (goto-char cmpl-symbol-start) (forward-word 1) (setq cmpl-symbol-start (point)) (goto-char cmpl-saved-point) )) ;; remove chars to ignore at the end (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w) (goto-char cmpl-symbol-end) (forward-word -1) (setq cmpl-symbol-end (point)) (goto-char cmpl-saved-point) )) ;; restore state (set-syntax-table cmpl-saved-syntax) ;; Return completion if the length is reasonable (if (and (<= (cmpl-read-time-eval completion-min-length) (- cmpl-symbol-end cmpl-symbol-start)) (<= (- cmpl-symbol-end cmpl-symbol-start) (cmpl-read-time-eval completion-max-length))) (buffer-substring cmpl-symbol-start cmpl-symbol-end)) ) (t ;; restore table if no symbol (set-syntax-table cmpl-saved-syntax) nil) )) ;;; tests for symbol-under-point ;;; `^' indicates cursor pos. where value is returned ;;; simple-word-test ;;; ^^^^^^^^^^^^^^^^ --> simple-word-test ;;; _harder_word_test_ ;;; ^^^^^^^^^^^^^^^^^^ --> harder_word_test ;;; .___.______. ;;; --> nil ;;; /foo/bar/quux.hello ;;; ^^^^^^^^^^^^^^^^^^^ --> /foo/bar/quux.hello ;;; (defun symbol-before-point () "Returns a string of the symbol immediately before point. Returns nil if there isn't one longer than `completion-min-length'." ;; This is called when a word separator is typed so it must be FAST ! (setq cmpl-saved-syntax (syntax-table)) (set-syntax-table cmpl-syntax-table) ;; Cursor is on following-char and after preceding-char (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_) ;; No chars. to ignore at end (setq cmpl-symbol-end (point) cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1) ) ;; remove chars to ignore at the start (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) (goto-char cmpl-symbol-start) (forward-word 1) (setq cmpl-symbol-start (point)) (goto-char cmpl-symbol-end) )) ;; restore state (set-syntax-table cmpl-saved-syntax) ;; return value if long enough (if (>= cmpl-symbol-end (+ cmpl-symbol-start (cmpl-read-time-eval completion-min-length))) (buffer-substring cmpl-symbol-start cmpl-symbol-end)) ) ((= cmpl-preceding-syntax ?w) ;; chars to ignore at end (setq cmpl-saved-point (point) cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1)) ;; take off chars. from end (forward-word -1) (setq cmpl-symbol-end (point)) ;; remove chars to ignore at the start (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) (goto-char cmpl-symbol-start) (forward-word 1) (setq cmpl-symbol-start (point)) )) ;; restore state (goto-char cmpl-saved-point) (set-syntax-table cmpl-saved-syntax) ;; Return completion if the length is reasonable (if (and (<= (cmpl-read-time-eval completion-min-length) (- cmpl-symbol-end cmpl-symbol-start)) (<= (- cmpl-symbol-end cmpl-symbol-start) (cmpl-read-time-eval completion-max-length))) (buffer-substring cmpl-symbol-start cmpl-symbol-end)) ) (t ;; restore table if no symbol (set-syntax-table cmpl-saved-syntax) nil) )) ;;; tests for symbol-before-point ;;; `^' indicates cursor pos. where value is returned ;;; simple-word-test ;;; ^ --> nil ;;; ^ --> nil ;;; ^ --> simple-w ;;; ^ --> simple-word-test ;;; _harder_word_test_ ;;; ^ --> harder_word_test ;;; ^ --> harder_word_test ;;; ^ --> harder ;;; .___.... ;;; --> nil (defun symbol-under-or-before-point () ;;; This could be made slightly faster but it is better to avoid ;;; copying all the code. ;;; However, it is only used by the completion string prompter. ;;; If it comes into common use, it could be rewritten. (setq cmpl-saved-syntax (syntax-table)) (set-syntax-table cmpl-syntax-table) (cond ((memq (char-syntax (following-char)) '(?w ?_)) (set-syntax-table cmpl-saved-syntax) (symbol-under-point)) (t (set-syntax-table cmpl-saved-syntax) (symbol-before-point)) )) (defun symbol-before-point-for-complete () ;; "Returns a string of the symbol immediately before point ;; or nil if there isn't one. Like symbol-before-point but doesn't trim the ;; end chars." ;; Cursor is on following-char and after preceding-char (setq cmpl-saved-syntax (syntax-table)) (set-syntax-table cmpl-syntax-table) (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char))) '(?_ ?w)) (setq cmpl-symbol-end (point) cmpl-symbol-start (scan-sexps (1+ cmpl-symbol-end) -1) ) ;; remove chars to ignore at the start (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) (goto-char cmpl-symbol-start) (forward-word 1) (setq cmpl-symbol-start (point)) (goto-char cmpl-symbol-end) )) ;; restore state (set-syntax-table cmpl-saved-syntax) ;; Return completion if the length is reasonable (if (and (<= (cmpl-read-time-eval completion-prefix-min-length) (- cmpl-symbol-end cmpl-symbol-start)) (<= (- cmpl-symbol-end cmpl-symbol-start) (cmpl-read-time-eval completion-max-length))) (buffer-substring cmpl-symbol-start cmpl-symbol-end)) ) (t ;; restore table if no symbol (set-syntax-table cmpl-saved-syntax) nil) )) ;;; tests for symbol-before-point-for-complete ;;; `^' indicates cursor pos. where value is returned ;;; simple-word-test ;;; ^ --> nil ;;; ^ --> nil ;;; ^ --> simple-w ;;; ^ --> simple-word-test ;;; _harder_word_test_ ;;; ^ --> harder_word_test ;;; ^ --> harder_word_test_ ;;; ^ --> harder_ ;;; .___.... ;;; --> nil ;;;--------------------------------------------------------------------------- ;;; Statistics Recording ;;;--------------------------------------------------------------------------- ;;; Note that the guts of this has been turned off. The guts ;;; are in completion-stats.el. ;;;----------------------------------------------- ;;; Conditionalizing code on *record-cmpl-statistics-p* ;;;----------------------------------------------- ;;; All statistics code outside this block should use this (defmacro cmpl-statistics-block (&rest body)) ;;; "Only executes body if we are recording statistics." ;;; (list 'cond ;;; (list* '*record-cmpl-statistics-p* body) ;;; )) ;;;----------------------------------------------- ;;; Completion Sources ;;;----------------------------------------------- ;; ID numbers (defconst cmpl-source-unknown 0) (defconst cmpl-source-init-file 1) (defconst cmpl-source-file-parsing 2) (defconst cmpl-source-separator 3) (defconst cmpl-source-cursor-moves 4) (defconst cmpl-source-interactive 5) (defconst cmpl-source-cdabbrev 6) (defconst num-cmpl-sources 7) (defvar current-completion-source cmpl-source-unknown) ;;;--------------------------------------------------------------------------- ;;; Completion Method #2: dabbrev-expand style ;;;--------------------------------------------------------------------------- ;;; ;;; This method is used if there are no useful stored completions. It is ;;; based on dabbrev-expand with these differences : ;;; 1) Faster (we don't use regexps) ;;; 2) case coercion handled correctly ;;; This is called cdabbrev to differentiate it. ;;; We simply search backwards through the file looking for words which ;;; start with the same letters we are trying to complete. ;;; (defvar cdabbrev-completions-tried nil) ;;; "A list of all the cdabbrev completions since the last reset.") (defvar cdabbrev-current-point 0) ;;; "The current point position the cdabbrev search is at.") (defvar cdabbrev-current-window nil) ;;; "The current window we are looking for cdabbrevs in. T if looking in ;;; (other-buffer), NIL if no more cdabbrevs.") (defvar cdabbrev-wrapped-p nil) ;;; "T if the cdabbrev search has wrapped around the file.") (defvar cdabbrev-abbrev-string "") (defvar cdabbrev-start-point 0) (defvar cdabbrev-stop-point) ;;; Test strings for cdabbrev ;;; cdat-upcase ;;same namestring ;;; CDAT-UPCASE ;;ok ;;; cdat2 ;;too short ;;; cdat-1-2-3-4 ;;ok ;;; a-cdat-1 ;;doesn't start correctly ;;; cdat-simple ;;ok (defun reset-cdabbrev (abbrev-string &optional initial-completions-tried) "Resets the cdabbrev search to search for abbrev-string. INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore during the search." (setq cdabbrev-abbrev-string abbrev-string cdabbrev-completions-tried (cons (downcase abbrev-string) initial-completions-tried) ) (reset-cdabbrev-window t) ) (defun set-cdabbrev-buffer () ;; cdabbrev-current-window must not be NIL (set-buffer (if (eq cdabbrev-current-window t) (other-buffer) (window-buffer cdabbrev-current-window))) ) (defun reset-cdabbrev-window (&optional initializep) "Resets the cdabbrev search to search for abbrev-string." ;; Set the window (cond (initializep (setq cdabbrev-current-window (selected-window)) ) ((eq cdabbrev-current-window t) ;; Everything has failed (setq cdabbrev-current-window nil)) (cdabbrev-current-window (setq cdabbrev-current-window (next-window cdabbrev-current-window)) (if (eq cdabbrev-current-window (selected-window)) ;; No more windows, try other buffer. (setq cdabbrev-current-window t))) ) (if cdabbrev-current-window (save-excursion (set-cdabbrev-buffer) (setq cdabbrev-current-point (point) cdabbrev-start-point cdabbrev-current-point cdabbrev-stop-point (if completion-search-distance (max (point-min) (- cdabbrev-start-point completion-search-distance)) (point-min)) cdabbrev-wrapped-p nil) ))) (defun next-cdabbrev () "Return the next possible cdabbrev expansion or nil if there isn't one. `reset-cdabbrev' must've been called already. This is sensitive to `case-fold-search'." ;; note that case-fold-search affects the behavior of this function ;; Bug: won't pick up an expansion that starts at the top of buffer (if cdabbrev-current-window (let (saved-point saved-syntax (expansion nil) downcase-expansion tried-list syntax saved-point-2) (save-excursion (unwind-protect (progn ;; Switch to current completion buffer (set-cdabbrev-buffer) ;; Save current buffer state (setq saved-point (point) saved-syntax (syntax-table)) ;; Restore completion state (set-syntax-table cmpl-syntax-table) (goto-char cdabbrev-current-point) ;; Loop looking for completions (while ;; This code returns t if it should loop again (cond (;; search for the string (search-backward cdabbrev-abbrev-string cdabbrev-stop-point t) ;; return nil if the completion is valid (not (and ;; does it start with a separator char ? (or (= (setq syntax (char-syntax (preceding-char))) ? ) (and (= syntax ?w) ;; symbol char to ignore at end. Are we at end ? (progn (setq saved-point-2 (point)) (forward-word -1) (prog1 (= (char-syntax (preceding-char)) ? ) (goto-char saved-point-2) )))) ;; is the symbol long enough ? (setq expansion (symbol-under-point)) ;; have we not tried this one before (progn ;; See if we've already used it (setq tried-list cdabbrev-completions-tried downcase-expansion (downcase expansion)) (while (and tried-list (not (string-equal downcase-expansion (car tried-list)))) ;; Already tried, don't choose this one (setq tried-list (cdr tried-list)) ) ;; at this point tried-list will be nil if this ;; expansion has not yet been tried (if tried-list (setq expansion nil) t) )))) ;; search failed (cdabbrev-wrapped-p ;; If already wrapped, then we've failed completely nil) (t ;; need to wrap (goto-char (setq cdabbrev-current-point (if completion-search-distance (min (point-max) (+ cdabbrev-start-point completion-search-distance)) (point-max)))) (setq cdabbrev-wrapped-p t)) )) ;; end of while loop (cond (expansion ;; successful (setq cdabbrev-completions-tried (cons downcase-expansion cdabbrev-completions-tried) cdabbrev-current-point (point)))) ) (set-syntax-table saved-syntax) (goto-char saved-point) )) ;; If no expansion, go to next window (cond (expansion) (t (reset-cdabbrev-window) (next-cdabbrev)))))) ;;; The following must be eval'd in the minibuffer :: ;;; (reset-cdabbrev "cdat") ;;; (next-cdabbrev) --> "cdat-simple" ;;; (next-cdabbrev) --> "cdat-1-2-3-4" ;;; (next-cdabbrev) --> "CDAT-UPCASE" ;;; (next-cdabbrev) --> "cdat-wrapping" ;;; (next-cdabbrev) --> "cdat_start_sym" ;;; (next-cdabbrev) --> nil ;;; (next-cdabbrev) --> nil ;;; (next-cdabbrev) --> nil ;;; _cdat_start_sym ;;; cdat-wrapping ;;;--------------------------------------------------------------------------- ;;; Completion Database ;;;--------------------------------------------------------------------------- ;;; We use two storage modes for the two search types :: ;;; 1) Prefix {cmpl-prefix-obarray} for looking up possible completions ;;; Used by search-completion-next ;;; the value of the symbol is nil or a cons of head and tail pointers ;;; 2) Interning {cmpl-obarray} to see if it's in the database ;;; Used by find-exact-completion, completion-in-database-p ;;; The value of the symbol is the completion entry ;;; bad things may happen if this length is changed due to the way ;;; GNU implements obarrays (defconst cmpl-obarray-length 511) (defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0) "An obarray used to store the downcased completion prefixes. Each symbol is bound to a list of completion entries.") (defvar cmpl-obarray (make-vector cmpl-obarray-length 0) "An obarray used to store the downcased completions. Each symbol is bound to a single completion entry.") ;;;----------------------------------------------- ;;; Completion Entry Structure Definition ;;;----------------------------------------------- ;;; A completion entry is a LIST of string, prefix-symbol num-uses, and ;;; last-use-time (the time the completion was last used) ;;; last-use-time is T if the string should be kept permanently ;;; num-uses is incremented everytime the completion is used. ;;; We chose lists because (car foo) is faster than (aref foo 0) and the ;;; creation time is about the same. ;;; READER MACROS (defmacro completion-string (completion-entry) (list 'car completion-entry)) (defmacro completion-num-uses (completion-entry) ;; "The number of times it has used. Used to decide whether to save ;; it." (list 'car (list 'cdr completion-entry))) (defmacro completion-last-use-time (completion-entry) ;; "The time it was last used. In hours since origin. Used to decide ;; whether to save it. T if one should always save it." (list 'nth 2 completion-entry)) (defmacro completion-source (completion-entry) (list 'nth 3 completion-entry)) ;;; WRITER MACROS (defmacro set-completion-string (completion-entry string) (list 'setcar completion-entry string)) (defmacro set-completion-num-uses (completion-entry num-uses) (list 'setcar (list 'cdr completion-entry) num-uses)) (defmacro set-completion-last-use-time (completion-entry last-use-time) (list 'setcar (list 'cdr (list 'cdr completion-entry)) last-use-time)) ;;; CONSTRUCTOR (defun make-completion (string) "Returns a list of a completion entry." (list (list string 0 nil current-completion-source))) ;; Obsolete ;;(defmacro cmpl-prefix-entry-symbol (completion-entry) ;; (list 'car (list 'cdr completion-entry))) ;;;----------------------------------------------- ;;; Prefix symbol entry definition ;;;----------------------------------------------- ;;; A cons of (head . tail) ;;; READER Macros (defmacro cmpl-prefix-entry-head (prefix-entry) (list 'car prefix-entry)) (defmacro cmpl-prefix-entry-tail (prefix-entry) (list 'cdr prefix-entry)) ;;; WRITER Macros (defmacro set-cmpl-prefix-entry-head (prefix-entry new-head) (list 'setcar prefix-entry new-head)) (defmacro set-cmpl-prefix-entry-tail (prefix-entry new-tail) (list 'setcdr prefix-entry new-tail)) ;;; Constructor (defun make-cmpl-prefix-entry (completion-entry-list) "Makes a new prefix entry containing only completion-entry." (cons completion-entry-list completion-entry-list)) ;;;----------------------------------------------- ;;; Completion Database - Utilities ;;;----------------------------------------------- (defun clear-all-completions () "Initializes the completion storage. All existing completions are lost." (interactive) (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)) (setq cmpl-obarray (make-vector cmpl-obarray-length 0)) (cmpl-statistics-block (record-clear-all-completions)) ) (defvar completions-list-return-value) (defun list-all-completions () "Returns a list of all the known completion entries." (let ((completions-list-return-value nil)) (mapatoms 'list-all-completions-1 cmpl-prefix-obarray) completions-list-return-value)) (defun list-all-completions-1 (prefix-symbol) (if (boundp prefix-symbol) (setq completions-list-return-value (append (cmpl-prefix-entry-head (symbol-value prefix-symbol)) completions-list-return-value)))) (defun list-all-completions-by-hash-bucket () "Return list of lists of known completion entries, organized by hash bucket." (let ((completions-list-return-value nil)) (mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray) completions-list-return-value)) (defun list-all-completions-by-hash-bucket-1 (prefix-symbol) (if (boundp prefix-symbol) (setq completions-list-return-value (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol)) completions-list-return-value)))) ;;;----------------------------------------------- ;;; Updating the database ;;;----------------------------------------------- ;;; ;;; These are the internal functions used to update the datebase ;;; ;;; (defvar completion-to-accept nil) ;;"Set to a string that is pending its acceptance." ;; this checked by the top level reading functions (defvar cmpl-db-downcase-string nil) ;; "Setup by find-exact-completion, etc. The given string, downcased." (defvar cmpl-db-symbol nil) ;; "The interned symbol corresponding to cmpl-db-downcase-string. ;; Set up by cmpl-db-symbol." (defvar cmpl-db-prefix-symbol nil) ;; "The interned prefix symbol corresponding to cmpl-db-downcase-string." (defvar cmpl-db-entry nil) (defvar cmpl-db-debug-p nil "Set to T if you want to debug the database.") ;;; READS (defun find-exact-completion (string) "Returns the completion entry for string or nil. Sets up `cmpl-db-downcase-string' and `cmpl-db-symbol'." (and (boundp (setq cmpl-db-symbol (intern (setq cmpl-db-downcase-string (downcase string)) cmpl-obarray))) (symbol-value cmpl-db-symbol) )) (defun find-cmpl-prefix-entry (prefix-string) "Returns the prefix entry for string. Sets `cmpl-db-prefix-symbol'. Prefix-string must be exactly `completion-prefix-min-length' long and downcased. Sets up `cmpl-db-prefix-symbol'." (and (boundp (setq cmpl-db-prefix-symbol (intern prefix-string cmpl-prefix-obarray))) (symbol-value cmpl-db-prefix-symbol))) (defvar inside-locate-completion-entry nil) ;; used to trap lossage in silent error correction (defun locate-completion-entry (completion-entry prefix-entry) "Locates the completion entry. Returns a pointer to the element before the completion entry or nil if the completion entry is at the head. Must be called after `find-exact-completion'." (let ((prefix-list (cmpl-prefix-entry-head prefix-entry)) next-prefix-list ) (cond ((not (eq (car prefix-list) completion-entry)) ;; not already at head (while (and prefix-list (not (eq completion-entry (car (setq next-prefix-list (cdr prefix-list))) ))) (setq prefix-list next-prefix-list)) (cond (;; found prefix-list) ;; Didn't find it. Database is messed up. (cmpl-db-debug-p ;; not found, error if debug mode (error "Completion entry exists but not on prefix list - %s" completion-string)) (inside-locate-completion-entry ;; recursive error: really scrod (locate-completion-db-error)) (t ;; Patch out (set cmpl-db-symbol nil) ;; Retry (locate-completion-entry-retry completion-entry) )))))) (defun locate-completion-entry-retry (old-entry) (let ((inside-locate-completion-entry t)) (add-completion (completion-string old-entry) (completion-num-uses old-entry) (completion-last-use-time old-entry)) (let* ((cmpl-entry (find-exact-completion (completion-string old-entry))) (pref-entry (if cmpl-entry (find-cmpl-prefix-entry (substring cmpl-db-downcase-string 0 completion-prefix-min-length)))) ) (if (and cmpl-entry pref-entry) ;; try again (locate-completion-entry cmpl-entry pref-entry) ;; still losing (locate-completion-db-error)) ))) (defun locate-completion-db-error () ;; recursive error: really scrod (error "Completion database corrupted. Try M-x clear-all-completions. Send bug report.") ) ;;; WRITES (defun add-completion-to-tail-if-new (string) "If STRING is not in the database add it to appropriate prefix list. STRING is added to the end of the appropriate prefix list with num-uses = 0. The database is unchanged if it is there. STRING must be longer than `completion-prefix-min-length'. This must be very fast. Returns the completion entry." (or (find-exact-completion string) ;; not there (let (;; create an entry (entry (make-completion string)) ;; setup the prefix (prefix-entry (find-cmpl-prefix-entry (substring cmpl-db-downcase-string 0 (cmpl-read-time-eval completion-prefix-min-length)))) ) ;; The next two forms should happen as a unit (atomically) but ;; no fatal errors should result if that is not the case. (cond (prefix-entry ;; These two should be atomic, but nothing fatal will happen ;; if they're not. (setcdr (cmpl-prefix-entry-tail prefix-entry) entry) (set-cmpl-prefix-entry-tail prefix-entry entry)) (t (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry)) )) ;; statistics (cmpl-statistics-block (note-added-completion)) ;; set symbol (set cmpl-db-symbol (car entry)) ))) (defun add-completion-to-head (completion-string) "If COMPLETION-STRING is not in the database, add it to prefix list. We add COMPLETION-STRING to the head of the appropriate prefix list, or it to the head of the list. COMPLETION-STRING must be longer than `completion-prefix-min-length'. Updates the saved string with the supplied string. This must be very fast. Returns the completion entry." ;; Handle pending acceptance (if completion-to-accept (accept-completion)) ;; test if already in database (if (setq cmpl-db-entry (find-exact-completion completion-string)) ;; found (let* ((prefix-entry (find-cmpl-prefix-entry (substring cmpl-db-downcase-string 0 (cmpl-read-time-eval completion-prefix-min-length)))) (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) (cmpl-ptr (cdr splice-ptr)) ) ;; update entry (set-completion-string cmpl-db-entry completion-string) ;; move to head (if necessary) (cond (splice-ptr ;; These should all execute atomically but it is not fatal if ;; they don't. ;; splice it out (or (setcdr splice-ptr (cdr cmpl-ptr)) ;; fix up tail if necessary (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)) ;; splice in at head (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry)) (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr) )) cmpl-db-entry) ;; not there (let (;; create an entry (entry (make-completion completion-string)) ;; setup the prefix (prefix-entry (find-cmpl-prefix-entry (substring cmpl-db-downcase-string 0 (cmpl-read-time-eval completion-prefix-min-length)))) ) (cond (prefix-entry ;; Splice in at head (setcdr entry (cmpl-prefix-entry-head prefix-entry)) (set-cmpl-prefix-entry-head prefix-entry entry)) (t ;; Start new prefix entry (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry)) )) ;; statistics (cmpl-statistics-block (note-added-completion)) ;; Add it to the symbol (set cmpl-db-symbol (car entry)) ))) (defun delete-completion (completion-string) "Deletes the completion from the database. String must be longer than `completion-prefix-min-length'." ;; Handle pending acceptance (if completion-to-accept (accept-completion)) (if (setq cmpl-db-entry (find-exact-completion completion-string)) ;; found (let* ((prefix-entry (find-cmpl-prefix-entry (substring cmpl-db-downcase-string 0 (cmpl-read-time-eval completion-prefix-min-length)))) (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) ) ;; delete symbol reference (set cmpl-db-symbol nil) ;; remove from prefix list (cond (splice-ptr ;; not at head (or (setcdr splice-ptr (cdr (cdr splice-ptr))) ;; fix up tail if necessary (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)) ) (t ;; at head (or (set-cmpl-prefix-entry-head prefix-entry (cdr (cmpl-prefix-entry-head prefix-entry))) ;; List is now empty (set cmpl-db-prefix-symbol nil)) )) (cmpl-statistics-block (note-completion-deleted)) ) (error "Unknown completion `%s'" completion-string) )) ;;; Tests -- ;;; - Add and Find - ;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) ;;; (find-exact-completion "banana") --> ("banana" 0 nil 0) ;;; (find-exact-completion "bana") --> nil ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) ;;; (add-completion-to-head "banish") --> ("banish" 0 nil 0) ;;; (find-exact-completion "banish") --> ("banish" 0 nil 0) ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) ;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) ;;; ;;; - Deleting - ;;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) ;;; (delete-completion "banner") ;;; (find-exact-completion "banner") --> nil ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) ;;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) ;;; (delete-completion "banana") ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...)) ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) ;;; (delete-completion "banner") ;;; (delete-completion "banish") ;;; (find-cmpl-prefix-entry "ban") --> nil ;;; (delete-completion "banner") --> error ;;; ;;; - Tail - ;;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0) ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) ;;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) ;;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0) ;;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...)) ;;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...)) ;;; ;;;--------------------------------------------------------------------------- ;;; Database Update :: Interface level routines ;;;--------------------------------------------------------------------------- ;;; ;;; These lie on top of the database ref. functions but below the standard ;;; user interface level (defun interactive-completion-string-reader (prompt) (let* ((default (symbol-under-or-before-point)) (new-prompt (if default (format "%s: (default: %s) " prompt default) (format "%s: " prompt)) ) (read (completing-read new-prompt cmpl-obarray)) ) (if (zerop (length read)) (setq read (or default ""))) (list read) )) (defun check-completion-length (string) (if (< (length string) completion-min-length) (error "The string `%s' is too short to be saved as a completion" string) (list string))) (defun add-completion (string &optional num-uses last-use-time) "Add STRING to completion list, or move it to head of list. The completion is altered appropriately if num-uses and/or last-use-time is specified." (interactive (interactive-completion-string-reader "Completion to add")) (check-completion-length string) (let* ((current-completion-source (if (interactive-p) cmpl-source-interactive current-completion-source)) (entry (add-completion-to-head string))) (if num-uses (set-completion-num-uses entry num-uses)) (if last-use-time (set-completion-last-use-time entry last-use-time)) )) (defun add-permanent-completion (string) "Add STRING if it isn't already listed, and mark it permanent." (interactive (interactive-completion-string-reader "Completion to add permanently")) (let ((current-completion-source (if (interactive-p) cmpl-source-interactive current-completion-source)) ) (add-completion string nil t) )) (defun kill-completion (string) (interactive (interactive-completion-string-reader "Completion to kill")) (check-completion-length string) (delete-completion string) ) (defun accept-completion () "Accepts the pending completion in `completion-to-accept'. This bumps num-uses. Called by `add-completion-to-head' and `completion-search-reset'." (let ((string completion-to-accept) ;; if this is added afresh here, then it must be a cdabbrev (current-completion-source cmpl-source-cdabbrev) entry ) (setq completion-to-accept nil) (setq entry (add-completion-to-head string)) (set-completion-num-uses entry (1+ (completion-num-uses entry))) (setq cmpl-completions-accepted-p t) )) (defun use-completion-under-point () "Add the completion symbol underneath the point into the completion buffer." (let ((string (and enable-completion (symbol-under-point))) (current-completion-source cmpl-source-cursor-moves)) (if string (add-completion-to-head string)))) (defun use-completion-before-point () "Add the completion symbol before point into the completion buffer." (let ((string (and enable-completion (symbol-before-point))) (current-completion-source cmpl-source-cursor-moves)) (if string (add-completion-to-head string)))) (defun use-completion-under-or-before-point () "Add the completion symbol before point into the completion buffer." (let ((string (and enable-completion (symbol-under-or-before-point))) (current-completion-source cmpl-source-cursor-moves)) (if string (add-completion-to-head string)))) (defun use-completion-before-separator () "Add the completion symbol before point into the completion buffer. Completions added this way will automatically be saved if `completion-on-separator-character' is non-nil." (let ((string (and enable-completion (symbol-before-point))) (current-completion-source cmpl-source-separator) entry) (cmpl-statistics-block (note-separator-character string) ) (cond (string (setq entry (add-completion-to-head string)) (if (and completion-on-separator-character (zerop (completion-num-uses entry))) (progn (set-completion-num-uses entry 1) (setq cmpl-completions-accepted-p t))))) )) ;;; Tests -- ;;; - Add and Find - ;;; (add-completion "banana" 5 10) ;;; (find-exact-completion "banana") --> ("banana" 5 10 0) ;;; (add-completion "banana" 6) ;;; (find-exact-completion "banana") --> ("banana" 6 10 0) ;;; (add-completion "banish") ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) ;;; ;;; - Accepting - ;;; (setq completion-to-accept "banana") ;;; (accept-completion) ;;; (find-exact-completion "banana") --> ("banana" 7 10) ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) ;;; (setq completion-to-accept "banish") ;;; (add-completion "banner") ;;; (car (find-cmpl-prefix-entry "ban")) ;;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...)) ;;; ;;; - Deleting - ;;; (kill-completion "banish") ;;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...)) ;;;--------------------------------------------------------------------------- ;;; Searching the database ;;;--------------------------------------------------------------------------- ;;; Functions outside this block must call completion-search-reset followed ;;; by calls to completion-search-next or completion-search-peek ;;; ;;; Status variables ;; Commented out to improve loading speed (defvar cmpl-test-string "") ;; "The current string used by completion-search-next." (defvar cmpl-test-regexp "") ;; "The current regexp used by completion-search-next. ;; (derived from cmpl-test-string)" (defvar cmpl-last-index 0) ;; "The last index that completion-search-next was called with." (defvar cmpl-cdabbrev-reset-p nil) ;; "Set to t when cdabbrevs have been reset." (defvar cmpl-next-possibilities nil) ;; "A pointer to the element BEFORE the next set of possible completions. ;; cadr of this is the cmpl-next-possibility" (defvar cmpl-starting-possibilities nil) ;; "The initial list of starting possibilities." (defvar cmpl-next-possibility nil) ;; "The cached next possibility." (defvar cmpl-tried-list nil) ;; "A downcased list of all the completions we have tried." (defun completion-search-reset (string) "Set up the for completion searching for STRING. STRING must be longer than `completion-prefix-min-length'." (if completion-to-accept (accept-completion)) (setq cmpl-starting-possibilities (cmpl-prefix-entry-head (find-cmpl-prefix-entry (downcase (substring string 0 completion-prefix-min-length)))) cmpl-test-string string cmpl-test-regexp (concat (regexp-quote string) ".")) (completion-search-reset-1) ) (defun completion-search-reset-1 () (setq cmpl-next-possibilities cmpl-starting-possibilities cmpl-next-possibility nil cmpl-cdabbrev-reset-p nil cmpl-last-index -1 cmpl-tried-list nil )) (defun completion-search-next (index) "Return the next completion entry. If INDEX is out of sequence, reset and start from the top. If there are no more entries, try cdabbrev and returns only a string." (cond ((= index (setq cmpl-last-index (1+ cmpl-last-index))) (completion-search-peek t)) ((< index 0) (completion-search-reset-1) (setq cmpl-last-index index) ;; reverse the possibilities list (setq cmpl-next-possibilities (reverse cmpl-starting-possibilities)) ;; do a "normal" search (while (and (completion-search-peek nil) (< (setq index (1+ index)) 0)) (setq cmpl-next-possibility nil) ) (cond ((not cmpl-next-possibilities)) ;; If no more possibilities, leave it that way ((= -1 cmpl-last-index) ;; next completion is at index 0. reset next-possibility list ;; to start at beginning (setq cmpl-next-possibilities cmpl-starting-possibilities)) (t ;; otherwise point to one before current (setq cmpl-next-possibilities (nthcdr (- (length cmpl-starting-possibilities) (length cmpl-next-possibilities)) cmpl-starting-possibilities)) ))) (t ;; non-negative index, reset and search ;;(prin1 'reset) (completion-search-reset-1) (setq cmpl-last-index index) (while (and (completion-search-peek t) (not (< (setq index (1- index)) 0))) (setq cmpl-next-possibility nil) )) ) (prog1 cmpl-next-possibility (setq cmpl-next-possibility nil) )) (defun completion-search-peek (use-cdabbrev) "Returns the next completion entry without actually moving the pointers. Calling this again or calling `completion-search-next' results in the same string being returned. Depends on `case-fold-search'. If there are no more entries, try cdabbrev and then return only a string." (cond ;; return the cached value if we have it (cmpl-next-possibility) ((and cmpl-next-possibilities ;; still a few possibilities left (progn (while (and (not (eq 0 (string-match cmpl-test-regexp (completion-string (car cmpl-next-possibilities))))) (setq cmpl-next-possibilities (cdr cmpl-next-possibilities)) )) cmpl-next-possibilities )) ;; successful match (setq cmpl-next-possibility (car cmpl-next-possibilities) cmpl-tried-list (cons (downcase (completion-string cmpl-next-possibility)) cmpl-tried-list) cmpl-next-possibilities (cdr cmpl-next-possibilities) ) cmpl-next-possibility) (use-cdabbrev ;; unsuccessful, use cdabbrev (cond ((not cmpl-cdabbrev-reset-p) (reset-cdabbrev cmpl-test-string cmpl-tried-list) (setq cmpl-cdabbrev-reset-p t) )) (setq cmpl-next-possibility (next-cdabbrev)) ) ;; Completely unsuccessful, return nil )) ;;; Tests -- ;;; - Add and Find - ;;; (add-completion "banana") ;;; (completion-search-reset "ban") ;;; (completion-search-next 0) --> "banana" ;;; ;;; - Discrimination - ;;; (add-completion "cumberland") ;;; (add-completion "cumberbund") ;;; cumbering ;;; (completion-search-reset "cumb") ;;; (completion-search-peek t) --> "cumberbund" ;;; (completion-search-next 0) --> "cumberbund" ;;; (completion-search-peek t) --> "cumberland" ;;; (completion-search-next 1) --> "cumberland" ;;; (completion-search-peek nil) --> nil ;;; (completion-search-next 2) --> "cumbering" {cdabbrev} ;;; (completion-search-next 3) --> nil or "cumming"{depends on context} ;;; (completion-search-next 1) --> "cumberland" ;;; (completion-search-peek t) --> "cumbering" {cdabbrev} ;;; ;;; - Accepting - ;;; (completion-search-next 1) --> "cumberland" ;;; (setq completion-to-accept "cumberland") ;;; (completion-search-reset "foo") ;;; (completion-search-reset "cum") ;;; (completion-search-next 0) --> "cumberland" ;;; ;;; - Deleting - ;;; (kill-completion "cumberland") ;;; cummings ;;; (completion-search-reset "cum") ;;; (completion-search-next 0) --> "cumberbund" ;;; (completion-search-next 1) --> "cummings" ;;; ;;; - Ignoring Capitalization - ;;; (completion-search-reset "CuMb") ;;; (completion-search-next 0) --> "cumberbund" ;;;----------------------------------------------- ;;; COMPLETE ;;;----------------------------------------------- (defun completion-mode () "Toggles whether or not to add new words to the completion database." (interactive) (setq enable-completion (not enable-completion)) (message "Completion mode is now %s." (if enable-completion "ON" "OFF")) ) (defvar cmpl-current-index 0) (defvar cmpl-original-string nil) (defvar cmpl-last-insert-location -1) (defvar cmpl-leave-point-at-start nil) (defun complete (&optional arg) "Fill out a completion of the word before point. Point is left at end. Consecutive calls rotate through all possibilities. Prefix args :: control-u :: leave the point at the beginning of the completion rather than at the end. a number :: rotate through the possible completions by that amount `-' :: same as -1 (insert previous completion) {See the comments at the top of `completion.el' for more info.}" (interactive "*p") ;;; Set up variables (cond ((eq last-command this-command) ;; Undo last one (delete-region cmpl-last-insert-location (point)) ;; get next completion (setq cmpl-current-index (+ cmpl-current-index (or arg 1))) ) (t (if (not cmpl-initialized-p) (initialize-completions)) ;; make sure everything's loaded (cond ((consp current-prefix-arg) ;; control-u (setq arg 0) (setq cmpl-leave-point-at-start t) ) (t (setq cmpl-leave-point-at-start nil) )) ;; get string (setq cmpl-original-string (symbol-before-point-for-complete)) (cond ((not cmpl-original-string) (setq this-command 'failed-complete) (error "To complete, point must be after a symbol at least %d character long" completion-prefix-min-length))) ;; get index (setq cmpl-current-index (if current-prefix-arg arg 0)) ;; statistics (cmpl-statistics-block (note-complete-entered-afresh cmpl-original-string)) ;; reset database (completion-search-reset cmpl-original-string) ;; erase what we've got (delete-region cmpl-symbol-start cmpl-symbol-end) )) ;; point is at the point to insert the new symbol ;; Get the next completion (let* ((print-status-p (and (>= baud-rate completion-prompt-speed-threshold) (not (minibuffer-window-selected-p)))) (insert-point (point)) (entry (completion-search-next cmpl-current-index)) string ) ;; entry is either a completion entry or a string (if cdabbrev) ;; If found, insert (cond (entry ;; Setup for proper case (setq string (if (stringp entry) entry (completion-string entry))) (setq string (cmpl-merge-string-cases string cmpl-original-string)) ;; insert (insert string) ;; accept it (setq completion-to-accept string) ;; fixup and cache point (cond (cmpl-leave-point-at-start (setq cmpl-last-insert-location (point)) (goto-char insert-point)) (t;; point at end, (setq cmpl-last-insert-location insert-point)) ) ;; statistics (cmpl-statistics-block (note-complete-inserted entry cmpl-current-index)) ;; Done ! cmpl-stat-complete-successful ;;display the next completion (cond ((and print-status-p ;; This updates the display and only prints if there ;; is no typeahead (sit-for 0) (setq entry (completion-search-peek completion-cdabbrev-prompt-flag))) (setq string (if (stringp entry) entry (completion-string entry))) (setq string (cmpl-merge-string-cases string cmpl-original-string)) (message "Next completion: %s" string) )) ) (t;; none found, insert old (insert cmpl-original-string) ;; Don't accept completions (setq completion-to-accept nil) ;; print message ;; This used to call cmpl19-sit-for, an undefined function. ;; I hope that sit-for does the right thing; I don't know -- rms. (if (and print-status-p (sit-for 0)) (message "No %scompletions." (if (eq this-command last-command) "more " ""))) ;; statistics (cmpl-statistics-block (record-complete-failed cmpl-current-index)) ;; Pretend that we were never here (setq this-command 'failed-complete) )))) ;;;----------------------------------------------- ;;; "Complete" Key Keybindings ;;;----------------------------------------------- (global-set-key "\M-\r" 'complete) (global-set-key [?\C-\r] 'complete) (define-key function-key-map [C-return] [?\C-\r]) ;;; Tests - ;;; (add-completion "cumberland") ;;; (add-completion "cumberbund") ;;; cum ;;; Cumber ;;; cumbering ;;; cumb ;;;--------------------------------------------------------------------------- ;;; Parsing definitions from files into the database ;;;--------------------------------------------------------------------------- ;;;----------------------------------------------- ;;; Top Level functions :: ;;;----------------------------------------------- ;;; User interface (defun add-completions-from-file (file) "Parse possible completions from a file and add them to data base." (interactive "fFile: ") (setq file (expand-file-name file)) (let* ((buffer (get-file-buffer file)) (buffer-already-there-p buffer) ) (if (not buffer-already-there-p) (let ((completions-merging-modes nil)) (setq buffer (find-file-noselect file)))) (unwind-protect (save-excursion (set-buffer buffer) (add-completions-from-buffer) ) (if (not buffer-already-there-p) (kill-buffer buffer))))) (defun add-completions-from-buffer () (interactive) (let ((current-completion-source cmpl-source-file-parsing) (start-num (cmpl-statistics-block (aref completion-add-count-vector cmpl-source-file-parsing))) mode ) (cond ((memq major-mode '(emacs-lisp-mode lisp-mode)) (add-completions-from-lisp-buffer) (setq mode 'lisp) ) ((memq major-mode '(c-mode)) (add-completions-from-c-buffer) (setq mode 'c) ) (t (error "Cannot parse completions in %s buffers" major-mode) )) (cmpl-statistics-block (record-cmpl-parse-file mode (point-max) (- (aref completion-add-count-vector cmpl-source-file-parsing) start-num))) )) ;;; Find file hook (defun cmpl-find-file-hook () (cond (enable-completion (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode)) (memq 'lisp completions-merging-modes) ) (add-completions-from-buffer)) ((and (memq major-mode '(c-mode)) (memq 'c completions-merging-modes) ) (add-completions-from-buffer) ))) )) (add-hook 'find-file-hooks 'cmpl-find-file-hook) ;;;----------------------------------------------- ;;; Tags Table Completions ;;;----------------------------------------------- (defun add-completions-from-tags-table () ;; Inspired by eero@media-lab.media.mit.edu "Add completions from the current tags table." (interactive) (visit-tags-table-buffer) ;this will prompt if no tags-table (save-excursion (goto-char (point-min)) (let (string) (condition-case e (while t (search-forward "\177") (backward-char 3) (and (setq string (symbol-under-point)) (add-completion-to-tail-if-new string)) (forward-char 3) ) (search-failed) )))) ;;;----------------------------------------------- ;;; Lisp File completion parsing ;;;----------------------------------------------- ;;; This merely looks for phrases beginning with (def.... or ;;; (package:def ... and takes the next word. ;;; ;;; We tried using forward-lines and explicit searches but the regexp technique ;;; was faster. (About 100K characters per second) ;;; (defconst *lisp-def-regexp* "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*" "A regexp that searches for lisp definition form." ) ;;; Tests - ;;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8 ;;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9 ;;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10 ;;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9 ;;; Parses all the definition names from a Lisp mode buffer and adds them to ;;; the completion database. (defun add-completions-from-lisp-buffer () ;;; Benchmarks ;;; Sun-3/280 - 1500 to 3000 lines of lisp code per second (let (string) (save-excursion (goto-char (point-min)) (condition-case e (while t (re-search-forward *lisp-def-regexp*) (and (setq string (symbol-under-point)) (add-completion-to-tail-if-new string)) ) (search-failed) )))) ;;;----------------------------------------------- ;;; C file completion parsing ;;;----------------------------------------------- ;;; C : ;;; Looks for #define or [] [] {,} ;;; or structure, array or pointer defs. ;;; It gets most of the definition names. ;;; ;;; As you might suspect by now, we use some symbol table hackery ;;; ;;; Symbol separator chars (have whitespace syntax) --> , ; * = ( ;;; Opening char --> [ { ;;; Closing char --> ] } ;;; opening and closing must be skipped over ;;; Whitespace chars (have symbol syntax) ;;; Everything else has word syntax (defun cmpl-make-c-def-completion-syntax-table () (let ((table (make-syntax-table)) (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r)) ;; unfortunately the ?( causes the parens to appear unbalanced (separator-chars '(?, ?* ?= ?\( ?\; )) i) ;; default syntax is whitespace (setq i 0) (while (< i 256) (modify-syntax-entry i "w" table) (setq i (1+ i))) (completion-dolist (char whitespace-chars) (modify-syntax-entry char "_" table)) (completion-dolist (char separator-chars) (modify-syntax-entry char " " table)) (modify-syntax-entry ?\[ "(]" table) (modify-syntax-entry ?\{ "(}" table) (modify-syntax-entry ?\] ")[" table) (modify-syntax-entry ?\} "){" table) table)) (defconst cmpl-c-def-syntax-table (cmpl-make-c-def-completion-syntax-table)) ;;; Regexps (defconst *c-def-regexp* ;; This stops on lines with possible definitions "\n[_a-zA-Z#]" ;; This stops after the symbol to add. ;;"\n\\(#define\\s +.\\|\\(\\(\\w\\|\\s_\\)+\\b\\s *\\)+[(;,[*{=]\\)" ;; This stops before the symbol to add. {Test cases in parens. below} ;;"\n\\(\\(\\w\\|\\s_\\)+\\s *(\\|\\(\\(#define\\|auto\\|extern\\|register\\|static\\|int\\|long\\|short\\|unsigned\\|char\\|void\\|float\\|double\\|enum\\|struct\\|union\\|typedef\\)\\s +\\)+\\)" ;; this simple version picks up too much extraneous stuff ;; "\n\\(\\w\\|\\s_\\|#\\)\\B" "A regexp that searches for a definition form." ) ; ;(defconst *c-cont-regexp* ; "\\(\\w\\|\\s_\\)+\\b\\s *\\({\\|\\(\\[[0-9\t ]*\\]\\s *\\)*,\\(*\\|\\s \\)*\\b\\)" ; "This regexp should be used in a looking-at to parse for lists of variables.") ; ;(defconst *c-struct-regexp* ; "\\(*\\|\\s \\)*\\b" ; "This regexp should be used to test whether a symbol follows a structure definition.") ;(defun test-c-def-regexp (regexp string) ; (and (eq 0 (string-match regexp string)) (match-end 0)) ; ) ;;; Tests - ;;; (test-c-def-regexp *c-def-regexp* "\n#define foo") -> 10 (9) ;;; (test-c-def-regexp *c-def-regexp* "\nfoo (x, y) {") -> 6 (6) ;;; (test-c-def-regexp *c-def-regexp* "\nint foo (x, y)") -> 10 (5) ;;; (test-c-def-regexp *c-def-regexp* "\n int foo (x, y)") -> nil ;;; (test-c-def-regexp *c-cont-regexp* "oo, bar") -> 4 ;;; (test-c-def-regexp *c-cont-regexp* "oo, *bar") -> 5 ;;; (test-c-def-regexp *c-cont-regexp* "a [5][6], bar") -> 10 ;;; (test-c-def-regexp *c-cont-regexp* "oo(x,y)") -> nil ;;; (test-c-def-regexp *c-cont-regexp* "a [6] ,\t bar") -> 9 ;;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14 ;;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil ;;; Parses all the definition names from a C mode buffer and adds them to the ;;; completion database. (defun add-completions-from-c-buffer () ;; Benchmark -- ;; Sun 3/280-- 1250 lines/sec. (let (string next-point char (saved-syntax (syntax-table)) ) (save-excursion (goto-char (point-min)) (catch 'finish-add-completions (unwind-protect (while t ;; we loop here only when scan-sexps fails ;; (i.e. unbalance exps.) (set-syntax-table cmpl-c-def-syntax-table) (condition-case e (while t (re-search-forward *c-def-regexp*) (cond ((= (preceding-char) ?#) ;; preprocessor macro, see if it's one we handle (setq string (buffer-substring (point) (+ (point) 6))) (cond ((or (string-equal string "define") (string-equal string "ifdef ") ) ;; skip forward over definition symbol ;; and add it to database (and (forward-word 2) (setq string (symbol-before-point)) ;;(push string foo) (add-completion-to-tail-if-new string) )))) (t ;; C definition (setq next-point (point)) (while (and next-point ;; scan to next separator char. (setq next-point (scan-sexps next-point 1)) ) ;; position the point on the word we want to add (goto-char next-point) (while (= (setq char (following-char)) ?*) ;; handle pointer ref ;; move to next separator char. (goto-char (setq next-point (scan-sexps (point) 1))) ) (forward-word -1) ;; add to database (if (setq string (symbol-under-point)) ;; (push string foo) (add-completion-to-tail-if-new string) ;; Local TMC hack (useful for parsing paris.h) (if (and (looking-at "_AP") ;; "ansi prototype" (progn (forward-word -1) (setq string (symbol-under-point)) )) (add-completion-to-tail-if-new string) ) ) ;; go to next (goto-char next-point) ;; (push (format "%c" (following-char)) foo) (if (= (char-syntax char) ?\() ;; if on an opening delimiter, go to end (while (= (char-syntax char) ?\() (setq next-point (scan-sexps next-point 1) char (char-after next-point)) ) (or (= char ?,) ;; Current char is an end char. (setq next-point nil) )) )))) (search-failed ;;done (throw 'finish-add-completions t) ) (error ;; Check for failure in scan-sexps (if (or (string-equal (nth 1 e) "Containing expression ends prematurely") (string-equal (nth 1 e) "Unbalanced parentheses")) ;; unbalanced paren., keep going ;;(ding) (forward-line 1) (message "Error parsing C buffer for completions--please send bug report") (throw 'finish-add-completions t) )) )) (set-syntax-table saved-syntax) ))))) ;;;--------------------------------------------------------------------------- ;;; Init files ;;;--------------------------------------------------------------------------- ;;; The version of save-completions-to-file called at kill-emacs time. (defun kill-emacs-save-completions () (if (and save-completions-flag enable-completion cmpl-initialized-p) (cond ((not cmpl-completions-accepted-p) (message "Completions database has not changed - not writing.")) (t (save-completions-to-file))))) ;; There is no point bothering to change this again ;; unless the package changes so much that it matters ;; for people that have saved completions. (defconst completion-version "11") (defconst saved-cmpl-file-header ";;; Completion Initialization file. ;;; Version = %s ;;; Format is ( . ) ;;; is the completion ;;; is the time the completion was last used ;;; If it is t, the completion will never be pruned from the file. ;;; Otherwise it is in hours since origin. \n") (defun completion-backup-filename (filename) (concat filename ".BAK")) (defun save-completions-to-file (&optional filename) "Save completions in init file FILENAME. If file name is not specified, use `save-completions-file-name'." (interactive) (setq filename (expand-file-name (or filename save-completions-file-name))) (if (file-writable-p filename) (progn (if (not cmpl-initialized-p) (initialize-completions));; make sure everything's loaded (message "Saving completions to file %s" filename) (let* ((delete-old-versions t) (kept-old-versions 0) (kept-new-versions completions-file-versions-kept) last-use-time (current-time (cmpl-hours-since-origin)) (total-in-db 0) (total-perm 0) (total-saved 0) (backup-filename (completion-backup-filename filename)) ) (save-excursion (get-buffer-create " *completion-save-buffer*") (set-buffer " *completion-save-buffer*") (setq buffer-file-name filename) (if (not (verify-visited-file-modtime (current-buffer))) (progn ;; file has changed on disk. Bring us up-to-date (message "Completion file has changed. Merging. . .") (load-completions-from-file filename t) (message "Merging finished. Saving completions to file %s" filename))) ;; prepare the buffer to be modified (clear-visited-file-modtime) (erase-buffer) ;; (/ 1 0) (insert (format saved-cmpl-file-header completion-version)) (completion-dolist (completion (list-all-completions)) (setq total-in-db (1+ total-in-db)) (setq last-use-time (completion-last-use-time completion)) ;; Update num uses and maybe write completion to a file (cond ((or;; Write to file if ;; permanent (and (eq last-use-time t) (setq total-perm (1+ total-perm))) ;; or if (if (> (completion-num-uses completion) 0) ;; it's been used (setq last-use-time current-time) ;; or it was saved before and (and last-use-time ;; save-completions-retention-time is nil (or (not save-completions-retention-time) ;; or time since last use is < ...retention-time* (< (- current-time last-use-time) save-completions-retention-time)) ))) ;; write to file (setq total-saved (1+ total-saved)) (insert (prin1-to-string (cons (completion-string completion) last-use-time)) "\n") ))) ;; write the buffer (condition-case e (let ((file-exists-p (file-exists-p filename))) (if file-exists-p (progn ;; If file exists . . . ;; Save a backup(so GNU doesn't screw us when we're out of disk) ;; (GNU leaves a 0 length file if it gets a disk full error!) ;; If backup doesn't exit, Rename current to backup ;; {If backup exists the primary file is probably messed up} (or (file-exists-p backup-filename) (rename-file filename backup-filename)) ;; Copy the backup back to the current name ;; (so versioning works) (copy-file backup-filename filename t))) ;; Save it (save-buffer) (if file-exists-p ;; If successful, remove backup (delete-file backup-filename))) (error (set-buffer-modified-p nil) (message "Couldn't save completion file `%s'" filename) )) ;; Reset accepted-p flag (setq cmpl-completions-accepted-p nil) ) (cmpl-statistics-block (record-save-completions total-in-db total-perm total-saved)) )))) ;;;(defun autosave-completions () ;;; (if (and save-completions-flag enable-completion cmpl-initialized-p ;;; *completion-auto-save-period* ;;; (> cmpl-emacs-idle-time *completion-auto-save-period*) ;;; cmpl-completions-accepted-p) ;;; (save-completions-to-file))) ;;;(add-hook 'cmpl-emacs-idle-time-hooks 'autosave-completions) (defun load-completions-from-file (&optional filename no-message-p) "Loads a completion init file FILENAME. If file is not specified, then use `save-completions-file-name'." (interactive) (setq filename (expand-file-name (or filename save-completions-file-name))) (let* ((backup-filename (completion-backup-filename filename)) (backup-readable-p (file-readable-p backup-filename)) ) (if backup-readable-p (setq filename backup-filename)) (if (file-readable-p filename) (progn (if (not no-message-p) (message "Loading completions from %sfile %s . . ." (if backup-readable-p "backup " "") filename)) (save-excursion (get-buffer-create " *completion-save-buffer*") (set-buffer " *completion-save-buffer*") (setq buffer-file-name filename) ;; prepare the buffer to be modified (clear-visited-file-modtime) (erase-buffer) (let ((insert-okay-p nil) (buffer (current-buffer)) (current-time (cmpl-hours-since-origin)) string num-uses entry last-use-time cmpl-entry cmpl-last-use-time (current-completion-source cmpl-source-init-file) (start-num (cmpl-statistics-block (aref completion-add-count-vector cmpl-source-file-parsing))) (total-in-file 0) (total-perm 0) ) ;; insert the file into a buffer (condition-case e (progn (insert-file-contents filename t) (setq insert-okay-p t)) (file-error (message "File error trying to load completion file %s." filename))) ;; parse it (if insert-okay-p (progn (goto-char (point-min)) (condition-case e (while t (setq entry (read buffer)) (setq total-in-file (1+ total-in-file)) (cond ((and (consp entry) (stringp (setq string (car entry))) (cond ((eq (setq last-use-time (cdr entry)) 'T) ;; handle case sensitivity (setq total-perm (1+ total-perm)) (setq last-use-time t)) ((eq last-use-time t) (setq total-perm (1+ total-perm))) ((integerp last-use-time)) )) ;; Valid entry ;; add it in (setq cmpl-last-use-time (completion-last-use-time (setq cmpl-entry (add-completion-to-tail-if-new string)) )) (if (or (eq last-use-time t) (and (> last-use-time 1000);;backcompatibility (not (eq cmpl-last-use-time t)) (or (not cmpl-last-use-time) ;; more recent (> last-use-time cmpl-last-use-time)) )) ;; update last-use-time (set-completion-last-use-time cmpl-entry last-use-time) )) (t ;; Bad format (message "Error: invalid saved completion - %s" (prin1-to-string entry)) ;; try to get back in sync (search-forward "\n(") ))) (search-failed (message "End of file while reading completions.") ) (end-of-file (if (= (point) (point-max)) (if (not no-message-p) (message "Loading completions from file %s . . . Done." filename)) (message "End of file while reading completions.") )) ))) (cmpl-statistics-block (record-load-completions total-in-file total-perm (- (aref completion-add-count-vector cmpl-source-init-file) start-num))) )))))) (defun initialize-completions () "Load the default completions file. Also sets up so that exiting emacs will automatically save the file." (interactive) (cond ((not cmpl-initialized-p) (load-completions-from-file) )) (setq cmpl-initialized-p t) ) ;;;----------------------------------------------- ;;; Kill EMACS patch ;;;----------------------------------------------- (add-hook 'kill-emacs-hook '(lambda () (kill-emacs-save-completions) (cmpl-statistics-block (record-cmpl-kill-emacs)))) ;;;----------------------------------------------- ;;; Kill region patch ;;;----------------------------------------------- (defun completion-kill-region (&optional beg end) "Kill between point and mark. The text is deleted but saved in the kill ring. The command \\[yank] can retrieve it from there. /(If you want to kill and then yank immediately, use \\[copy-region-as-kill].) This is the primitive for programs to kill text (as opposed to deleting it). Supply two arguments, character numbers indicating the stretch of text to be killed. Any command that calls this function is a \"kill command\". If the previous command was also a kill command, the text killed this time appends to the text killed last time to make one entry in the kill ring. Patched to remove the most recent completion." (interactive "r") (cond ((eq last-command 'complete) (delete-region (point) cmpl-last-insert-location) (insert cmpl-original-string) (setq completion-to-accept nil) (cmpl-statistics-block (record-complete-failed))) (t (kill-region beg end)))) (global-set-key "\C-w" 'completion-kill-region) ;;;----------------------------------------------- ;;; Patches to self-insert-command. ;;;----------------------------------------------- ;;; Need 2 versions: generic separator chars. and space (to get auto fill ;;; to work) ;;; All common separators (eg. space "(" ")" """) characters go through a ;;; function to add new words to the list of words to complete from: ;;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg). ;;; If the character before this was an alpha-numeric then this adds the ;;; symbol before point to the completion list (using ADD-COMPLETION). (defun completion-separator-self-insert-command (arg) (interactive "p") (use-completion-before-separator) (self-insert-command arg) ) (defun completion-separator-self-insert-autofilling (arg) (interactive "p") (use-completion-before-separator) (self-insert-command arg) (and auto-fill-function (funcall auto-fill-function)) ) ;;;----------------------------------------------- ;;; Wrapping Macro ;;;----------------------------------------------- ;;; Note that because of the way byte compiling works, none of ;;; the functions defined with this macro get byte compiled. (defmacro def-completion-wrapper (function-name type &optional new-name) "Add a call to update the completion database before function execution. TYPE is the type of the wrapper to be added. Can be :before or :under." (cond ((eq type ':separator) (list 'put (list 'quote function-name) ''completion-function ''use-completion-before-separator)) ((eq type ':before) (list 'put (list 'quote function-name) ''completion-function ''use-completion-before-point)) ((eq type ':backward-under) (list 'put (list 'quote function-name) ''completion-function ''use-completion-backward-under)) ((eq type ':backward) (list 'put (list 'quote function-name) ''completion-function ''use-completion-backward)) ((eq type ':under) (list 'put (list 'quote function-name) ''completion-function ''use-completion-under-point)) ((eq type ':under-or-before) (list 'put (list 'quote function-name) ''completion-function ''use-completion-under-or-before-point)) ((eq type ':minibuffer-separator) (list 'put (list 'quote function-name) ''completion-function ''use-completion-minibuffer-separator)))) (defun use-completion-minibuffer-separator () (let ((cmpl-syntax-table cmpl-standard-syntax-table)) (use-completion-before-separator))) (defun use-completion-backward-under () (use-completion-under-point) (if (eq last-command 'complete) ;; probably a failed completion if you have to back up (cmpl-statistics-block (record-complete-failed)))) (defun use-completion-backward () (if (eq last-command 'complete) ;; probably a failed completion if you have to back up (cmpl-statistics-block (record-complete-failed)))) (defun completion-before-command () (funcall (or (and (symbolp this-command) (get this-command 'completion-function)) 'use-completion-under-or-before-point))) (add-hook 'pre-command-hook 'completion-before-command) ;;;--------------------------------------------------------------------------- ;;; Patches to standard keymaps insert completions ;;;--------------------------------------------------------------------------- ;;;----------------------------------------------- ;;; Separators ;;;----------------------------------------------- ;;; We've used the completion syntax table given as a guide. ;;; ;;; Global separator chars. ;;; We left out because there are too many special cases for it. Also, ;;; in normal coding it's rarely typed after a word. (global-set-key " " 'completion-separator-self-insert-autofilling) (global-set-key "!" 'completion-separator-self-insert-command) (global-set-key "%" 'completion-separator-self-insert-command) (global-set-key "^" 'completion-separator-self-insert-command) (global-set-key "&" 'completion-separator-self-insert-command) (global-set-key "(" 'completion-separator-self-insert-command) (global-set-key ")" 'completion-separator-self-insert-command) (global-set-key "=" 'completion-separator-self-insert-command) (global-set-key "`" 'completion-separator-self-insert-command) (global-set-key "|" 'completion-separator-self-insert-command) (global-set-key "{" 'completion-separator-self-insert-command) (global-set-key "}" 'completion-separator-self-insert-command) (global-set-key "[" 'completion-separator-self-insert-command) (global-set-key "]" 'completion-separator-self-insert-command) (global-set-key ";" 'completion-separator-self-insert-command) (global-set-key "\"" 'completion-separator-self-insert-command) (global-set-key "'" 'completion-separator-self-insert-command) (global-set-key "#" 'completion-separator-self-insert-command) (global-set-key "," 'completion-separator-self-insert-command) (global-set-key "?" 'completion-separator-self-insert-command) ;;; We include period and colon even though they are symbol chars because : ;;; - in text we want to pick up the last word in a sentence. ;;; - in C pointer refs. we want to pick up the first symbol ;;; - it won't make a difference for lisp mode (package names are short) (global-set-key "." 'completion-separator-self-insert-command) (global-set-key ":" 'completion-separator-self-insert-command) ;;; Lisp Mode diffs (define-key lisp-mode-map "!" 'self-insert-command) (define-key lisp-mode-map "&" 'self-insert-command) (define-key lisp-mode-map "%" 'self-insert-command) (define-key lisp-mode-map "?" 'self-insert-command) (define-key lisp-mode-map "=" 'self-insert-command) (define-key lisp-mode-map "^" 'self-insert-command) ;;; C mode diffs. (defun completion-c-mode-hook () (def-completion-wrapper electric-c-semi :separator) (define-key c-mode-map "+" 'completion-separator-self-insert-command) (define-key c-mode-map "*" 'completion-separator-self-insert-command) (define-key c-mode-map "/" 'completion-separator-self-insert-command)) ;; Do this either now or whenever C mode is loaded. (if (featurep 'cc-mode) (completion-c-mode-hook) (add-hook 'c-mode-hook 'completion-c-mode-hook)) ;;; FORTRAN mode diffs. (these are defined when fortran is called) (defun completion-setup-fortran-mode () (define-key fortran-mode-map "+" 'completion-separator-self-insert-command) (define-key fortran-mode-map "-" 'completion-separator-self-insert-command) (define-key fortran-mode-map "*" 'completion-separator-self-insert-command) (define-key fortran-mode-map "/" 'completion-separator-self-insert-command) ) ;;;----------------------------------------------- ;;; End of line chars. ;;;----------------------------------------------- (def-completion-wrapper newline :separator) (def-completion-wrapper newline-and-indent :separator) (def-completion-wrapper comint-send-input :separator) (def-completion-wrapper exit-minibuffer :minibuffer-separator) (def-completion-wrapper eval-print-last-sexp :separator) (def-completion-wrapper eval-last-sexp :separator) ;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer) ;;;----------------------------------------------- ;;; Cursor movement ;;;----------------------------------------------- (def-completion-wrapper next-line :under-or-before) (def-completion-wrapper previous-line :under-or-before) (def-completion-wrapper beginning-of-buffer :under-or-before) (def-completion-wrapper end-of-buffer :under-or-before) (def-completion-wrapper beginning-of-line :under-or-before) (def-completion-wrapper end-of-line :under-or-before) (def-completion-wrapper forward-char :under-or-before) (def-completion-wrapper forward-word :under-or-before) (def-completion-wrapper forward-sexp :under-or-before) (def-completion-wrapper backward-char :backward-under) (def-completion-wrapper backward-word :backward-under) (def-completion-wrapper backward-sexp :backward-under) (def-completion-wrapper delete-backward-char :backward) (def-completion-wrapper delete-backward-char-untabify :backward) ;;; Tests -- ;;; foobarbiz ;;; foobar ;;; fooquux ;;; fooper (cmpl-statistics-block (record-completion-file-loaded)) ;;; completion.el ends here emacs-19.30/lisp/cookie1.el100444 12241 1 13561 5446403414 14437 0ustar rolanddaemon;;; cookie1.el --- retrieve random phrases from fortune cookie files ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Maintainer: FSF ;; Keywords: games ;; Created: Mon Mar 22 17:06:26 1993 ;; 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: ;; Support for random cookie fetches from phrase files, used for such ;; critical applications as emulating Zippy the Pinhead and confounding ;; the NSA Trunk Trawler. ;; ;; The two entry points are `cookie' and `cookie-insert'. The helper ;; function `shuffle-vector' may be of interest to programmers. ;; ;; The code expects phrase files to be in one of two formats: ;; ;; * ITS-style LINS format (strings terminated by ASCII 0 characters, ;; leading whitespace ignored). ;; ;; * UNIX fortune file format (quotes terminated by %% on a line by itself). ;; ;; Everything up to the first delimiter is treated as a comment. Other ;; formats could be supported by adding alternates to the regexp ;; `cookie-delimiter'. ;; ;; This code derives from Steve Strassman's 1987 spook.el package, but ;; has been generalized so that it supports multiple simultaneous ;; cookie databases and fortune files. It is intended to be called ;; from other packages such as yow.el and spook.el. ;; ;; TO DO: teach cookie-snarf to auto-detect ITS PINS or UNIX fortune(6) ;; format and do the right thing. ;;; Code: ; Randomize the seed in the random number generator. (random t) (defconst cookie-delimiter "\n%%\n\\|\0" "Delimiter used to separate cookie file entries.") (defvar cookie-cache (make-vector 511 0) "Cache of cookie files that have already been snarfed.") ;;;###autoload (defun cookie (phrase-file startmsg endmsg) "Return a random phrase from PHRASE-FILE. When the phrase file is read in, display STARTMSG at beginning of load, ENDMSG at end." (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) (shuffle-vector cookie-vector) (aref cookie-vector 1))) ;;;###autoload (defun cookie-insert (phrase-file &optional count startmsg endmsg) "Insert random phrases from PHRASE-FILE; COUNT of them. When the phrase file is read in, display STARTMSG at beginning of load, ENDMSG at end." (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) (shuffle-vector cookie-vector) (let ((start (point))) (insert ?\n) (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector) (insert ?\n) (fill-region-as-paragraph start (point) nil)))) (defun cookie1 (arg cookie-vec) "Inserts a cookie phrase ARG times." (cond ((zerop arg) t) (t (insert (aref cookie-vec arg)) (insert " ") (cookie1 (1- arg) cookie-vec)))) ;;;###autoload (defun cookie-snarf (phrase-file startmsg endmsg) "Reads in the PHRASE-FILE, returns it as a vector of strings. Emit 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 read-cookie (prompt phrase-file startmsg endmsg &optional require-match) "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE. STARTMSG and ENDMSG are passed along to `cookie-snarf'. Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie." ;; Make sure the cookies are in the cache. (or (intern-soft phrase-file cookie-cache) (cookie-snarf phrase-file startmsg endmsg)) (completing-read prompt (let ((sym (intern phrase-file cookie-cache))) ;; We cache the alist form of the cookie in a property. (or (get sym 'completion-alist) (let* ((alist nil) (vec (cookie-snarf phrase-file startmsg endmsg)) (i (length vec))) (while (> (setq i (1- i)) 0) (setq alist (cons (list (aref vec i)) alist))) (put sym 'completion-alist alist)))) nil require-match nil nil)) ; Thanks to Ian G Batten ; [of the University of Birmingham Computer Science Department] ; for the iterative version of this shuffle. ; ;;;###autoload (defun shuffle-vector (vector) "Randomly permute the elements of VECTOR (all permutations equally likely)" (let ((i 0) j temp (len (length vector))) (while (< i len) (setq j (+ i (random (- len i)))) (setq temp (aref vector i)) (aset vector i (aref vector j)) (aset vector j temp) (setq i (1+ i)))) vector) (provide 'cookie1) ;;; cookie1.el ends here emacs-19.30/lisp/copyright.el100444 12241 1 12247 6001002223 15072 0ustar rolanddaemon;;; copyright.el --- update the copyright notice in current buffer ;; Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 ;; Keywords: maint, tools ;; 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: ;; Allows updating the copyright year and above mentioned GPL version manually ;; or when saving a file. Do (add-hook 'write-file-hooks 'copyright-update). ;;; Code: (defvar copyright-limit 2000 "*Don't try to update copyright beyond this position unless interactive. `nil' means to search whole buffer.") (defvar copyright-regexp "[Cc]opyright\\s *:?\\s *(C)\\s *\\([1-9][-0-9, ']*[0-9]+\\) " "*What your copyright notice looks like. Must contain \\( \\) construct matching the years.") (defvar copyright-query 'function "*If non-`nil', ask user before changing copyright. When this is `function', only ask when called non-interactively.") (defconst copyright-current-year (substring (current-time-string) -4) "String representing the current year.") ;; when modifiying this, also modify the comment generated by autoinsert.el (defconst copyright-current-gpl-version "2" "String representing the current version of the GPL or `nil'.") (defvar copyright-update t) ;;;###autoload (defun copyright-update (&optional arg) "Update the copyright notice at the beginning of the buffer to indicate the current year. If optional prefix ARG is given replace the years in the notice rather than adding the current year after them. If necessary and `copyright-current-gpl-version' is set, the copying permissions following the copyright, if any, are updated as well." (interactive "*P") (if copyright-update (save-excursion (save-restriction (widen) (goto-char (point-min)) (if (re-search-forward copyright-regexp copyright-limit t) (if (string= (buffer-substring (- (match-end 1) 2) (match-end 1)) (substring copyright-current-year -2)) () (backward-char 1) (if (or (not copyright-query) (and (eq copyright-query 'function) (eq this-command 'copyright-update)) (y-or-n-p (if arg (concat "Replace copyright year(s) by " copyright-current-year "? ") (concat "Add " copyright-current-year " to copyright? ")))) (if arg (progn (delete-region (match-beginning 1) (match-end 1)) (insert copyright-current-year)) (setq arg (save-excursion (skip-chars-backward "0-9"))) (if (and (eq (% (- (string-to-number copyright-current-year) (string-to-number (buffer-substring (+ (point) arg) (point)))) 100) 1) (or (eq (char-after (+ (point) arg -1)) ?-) (eq (char-after (+ (point) arg -2)) ?-))) (delete-char arg) (insert ", ") (if (eq (char-after (+ (point) arg -3)) ?') (insert ?'))) (insert (substring copyright-current-year arg)))))) (goto-char (point-min)) (and copyright-current-gpl-version ;; match the GPL version comment in .el files, including the ;; bilingual Esperanto one in two-column, and in texinfo.tex (re-search-forward "\\(the Free Software Foundation; either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via \\)version \\([0-9]+\\), or (at" copyright-limit t) (not (string= (buffer-substring (match-beginning 3) (match-end 3)) copyright-current-gpl-version)) (or (not copyright-query) (and (eq copyright-query 'function) (eq this-command 'copyright-update)) (y-or-n-p (concat "Replace GPL version by " copyright-current-gpl-version "? "))) (progn (if (match-end 2) ;; Esperanto bilingual comment in two-column.el (progn (delete-region (match-beginning 2) (match-end 2)) (goto-char (match-beginning 2)) (insert copyright-current-gpl-version))) (delete-region (match-beginning 3) (match-end 3)) (goto-char (match-beginning 3)) (insert copyright-current-gpl-version)))) (set (make-local-variable 'copyright-update) nil))) ;; If a write-file-hook returns non-nil, the file is presumed to be written. nil) ;;;###autoload (define-skeleton copyright "Insert a copyright by $ORGANIZATION notice at cursor." "Company: " comment-start "Copyright (C) " copyright-current-year " by " (or (getenv "ORGANIZATION") str) '(if (> (point) copyright-limit) (message "Copyright extends beyond `copyright-limit' and won't be updated automatically.")) comment-end) ;; copyright.el ends here emacs-19.30/lisp/cplus-md.el100444 12120 1 115354 6052434153 14170 0ustar rmsdaemon;;; cplus-md.el --- C++ code editing commands for Emacs ;;; Copyright (C) 1985, 1992, 1994, 1995 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. ;; Keywords: c languages oop ;; 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. ;; Maintainer: Dave Detlefs ;; Keywords: c ;;; Commentary: ;; 1987 Dave Detlefs ;; and Stewart Clamen . ;; Done by fairly faithful modification of: ;;; Change Log: ;; Feb, 1990 (Dave Detlefs, dld@cs.cmu.edu) ;; Fixed electric-c++-terminator to handle double colons, at the ;; request of John Hagerman. ;; ;; Jan, 1990 (Doug Lea, dl@oswego.edu) ;; Replaced c++-comment-region and c++-uncomment-region with ;; versions from Igor Metz that avoid potential infinite loops. ;; ;; Oct, 1989 (Dave Detlefs, dld@cs.cmu.edu) ;; Added contribution from Igor Metz : ;; functions c++-comment-region and c++-uncomment-region and ;; corresponding key-binding. ;; Also fixed bug in indentation of second line after an empty ;; arglist with empty-arglist non-null. ;; ;; Sept, 1989 (Glen Ditchfield, gjditchfield@violet.uwaterloo.ca): ;; Textual changes to more closely imitate Emacs 18.55's c-mode. ;; Fixed handling of "default:", where ":" was the last character in the ;; buffer. Fixed indentation of comments starting in column 0, and when ;; previous line contained more than one comment start string. Fixed ;; handling of "friend". ;; ;; Aug 7, 1989; John Hagerman (hagerman@ece.cmu.edu): ;; Changed calculate-c++-indent to handle member initializations ;; more flexibly. Two new variables are used to control behavior: ;; c++-member-init-indent and c++-continued-member-init-offset. ;; Note the assumption that member initializations and argument ;; declarations are not mixed in one function definition. ;; ;; June 1989 (Dave Detlefs, dld@cs.cmu.edu) ;; Fixed calculate-c++-indent to handle continued lines ending in ;; {'s. (I wasn't following C-mode closely enough, or C-mode ;; changed.) Made ' a quote character, at the behest of someone ;; whose mail I apparently deleted (if they send me mail I'll credit ;; them here in a future revision.) ;; Dan Weinreb (dlw@odi.com) pointed out that 'c++-mode successively ;; bound c++-indent-exp and c++-indent-defun to ESC-^q. ESC-^q is ;; now bound to c++-indent-exp, while, c++-indent-defun is invoked ;; with ESC-^x. ;; February 1989 (Dave Detlefs, dld@cs.cmu.edu) ;; Fixed some errors in c++-indent-defun, as pointed out by Sam ;; Haradhvala (odi!sam@talcott.harvard.edu). ;; October 1988 (Dave Detlefs, dld@cs.cmu.edu) ;; It turns out I had only *thought* I had made ;; beginning(end)-of-defun work. It should work better now -- you ;; can either attempt to match defun headers "strongly," using a ;; very complicated regexp, or "weakly," using a simple one. This ;; is settable by a variable; the default is the cheaper weak ;; method. (Stewart Clamen was intimately involved in this, too.) ;; ;; I made "'" *not* be a string delimiter, because that was causing ;; comments containing contractions to ("// don't") to mess up paren ;; balancing. ;; ;; I also incorporated another slight indentation fix from Glen ;; Ditchfield. ;; ;; We hope this is will make into version 19 of gnu-emacs. ;; ;; September 1988: incorporated changes from Fred Calm at Schlumberger. ;; Also, made beginning(end)-of-defun, indent-defun work. ;; ;; August 1987: incorporated changes done by Glen Ditchfield of Waterloo. ;;; Code: (defvar c++-mode-abbrev-table nil "Abbrev table used in C++ mode.") (define-abbrev-table 'c++-mode-abbrev-table ()) (defvar c++-mode-map () "Keymap used in C++ mode.") (if c++-mode-map () (setq c++-mode-map (make-sparse-keymap)) (define-key c++-mode-map "\C-j" 'reindent-then-newline-and-indent) (define-key c++-mode-map "{" 'electric-c++-brace) (define-key c++-mode-map "}" 'electric-c++-brace) (define-key c++-mode-map ";" 'electric-c++-semi) (define-key c++-mode-map "\e\C-h" 'mark-c-function) (define-key c++-mode-map "\e\C-q" 'indent-c++-exp) (define-key c++-mode-map "\177" 'backward-delete-char-untabify) (define-key c++-mode-map "\t" 'c++-indent-command) ;; (define-key c++-mode-map "\C-c\C-i" 'c++-insert-header) (define-key c++-mode-map "\C-c\C-\\" 'c-backslash-region)) ;; (define-key c++-mode-map "\e\C-a" 'c++-beginning-of-defun) ;; (define-key c++-mode-map "\e\C-e" 'c++-end-of-defun) ;; (define-key c++-mode-map "\e\C-x" 'c++-indent-defun)) (defvar c++-mode-syntax-table nil "Syntax table used in C++ mode.") (if c++-mode-syntax-table () (setq c++-mode-syntax-table (copy-syntax-table c-mode-syntax-table)) (modify-syntax-entry ?* ". 23b" c++-mode-syntax-table) (modify-syntax-entry ?/ ". 124" c++-mode-syntax-table) (modify-syntax-entry ?\n ">" c++-mode-syntax-table) (modify-syntax-entry ?\^m ">" c++-mode-syntax-table)) (defvar c++-continued-member-init-offset nil "*Extra indent for continuation lines of member inits; nil means to align with previous initializations rather than with the colon on the first line.") (defvar c++-member-init-indent 0 "*Indentation level of member initializations in function declarations.") (defvar c++-friend-offset -4 "*Offset of C++ friend declarations relative to member declarations.") (defvar c++-electric-colon t "*If t, colon is an electric terminator.") (defvar c++-empty-arglist-indent nil "*Indicates how far to indent an line following an empty argument list. Nil indicates to just after the paren.") (defvar c++-imenu-generic-expression (` ((nil (, (concat "^" ; beginning of line is required "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? "\\(" ; last type spec including */& "[a-zA-Z0-9_:]+" "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either pointer/ref sign or whitespace "\\)?" ; if there is a last type spec "\\(" ; name; take that into the imenu entry "[a-zA-Z0-9_:~]+" ; member function, ctor or dtor... ; (may not contain * because then ; "a::operator char*" would become "char*"!) "\\|" "\\([a-zA-Z0-9_:~]*::\\)?operator" "[^a-zA-Z1-9_][^(]*" ; ...or operator " \\)" "[ \t]*([^)]*)[ \t\n]*[^ ;]" ; require something other than a ; after ; the (...) to avoid prototypes. Can't ; catch cases with () inside the parentheses ; surrounding the parameters ; (like "int foo(int a=bar()) {...}" )) 6) ("Class" (, (concat "^" ; beginning of line is required "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" "class[ \t]+" "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get "[ \t]*[:{]" )) 2) ;; Example of generic expression for finding prototypes, structs, unions, enums. ;; Uncomment if you want to find these too. It will be a bit slower gathering ;; the indexes. ; ("Prototypes" ; (, ; (concat ; "^" ; beginning of line is required ; "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" ; "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no ; "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? ; "\\(" ; last type spec including */& ; "[a-zA-Z0-9_:]+" ; "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either pointer/ref sign or whitespace ; "\\)?" ; if there is a last type spec ; "\\(" ; name; take that into the imenu entry ; "[a-zA-Z0-9_:~]+" ; member function, ctor or dtor... ; ; (may not contain * because then ; ; "a::operator char*" would become "char*"!) ; "\\|" ; "\\([a-zA-Z0-9_:~]*::\\)?operator" ; "[^a-zA-Z1-9_][^(]*" ; ...or operator ; " \\)" ; "[ \t]*([^)]*)[ \t\n]*;" ; require ';' after ; ; the (...) Can't ; ; catch cases with () inside the parentheses ; ; surrounding the parameters ; ; (like "int foo(int a=bar());" ; )) 6) ; ("Struct" ; (, (concat ; "^" ; beginning of line is required ; "\\(static[ \t]+\\)?" ; there may be static or const. ; "\\(const[ \t]+\\)?" ; "struct[ \t]+" ; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get ; "[ \t]*[{]" ; )) 3) ; ("Enum" ; (, (concat ; "^" ; beginning of line is required ; "\\(static[ \t]+\\)?" ; there may be static or const. ; "\\(const[ \t]+\\)?" ; "enum[ \t]+" ; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get ; "[ \t]*[{]" ; )) 3) ; ("Union" ; (, (concat ; "^" ; beginning of line is required ; "\\(static[ \t]+\\)?" ; there may be static or const. ; "\\(const[ \t]+\\)?" ; "union[ \t]+" ; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get ; "[ \t]*[{]" ; )) 3) )) "Imenu generic expression for C++ mode. See `imenu-generic-expression'.") (defun c++-mode () "Major mode for editing C++ code. Very much like editing C code. Expression and list commands understand all C++ brackets. Tab at left margin indents for C++ code Comments are delimited with /* ... */ {or with // ... } Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \\{c++-mode-map} Variables controlling indentation style: c-tab-always-indent Non-nil means TAB in C mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. Default is t. c-auto-newline Non-nil means automatically newline before and after braces, and after colons and semicolons, inserted in C code. c-indent-level Indentation of C statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. c-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. c-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to c-continued-statement-offset. c-brace-offset Extra indentation for line if it starts with an open brace. c-brace-imaginary-offset An open brace following other text is treated as if it were this far to the right of the start of its line. c-argdecl-indent Indentation level of declarations of C function arguments. c-label-offset Extra indentation for line that is a label, or case or ``default:'', or ``public:'' or ``private:'', or ``protected:''. c++-electric-colon If non-nil at invocation of c++-mode (t is the default) colon electricly indents. c++-empty-arglist-indent If non-nil, a function declaration or invocation which ends a line with a left paren is indented this many extra spaces, instead of flush with the left paren. c++-friend-offset Offset of C++ friend declarations relative to member declarations. c++-member-init-indent Indentation level of member initializations in function declarations, if they are on a separate line beginning with a colon. c++-continued-member-init-offset Extra indentation for continuation lines of member initializations; NIL means to align with previous initializations rather than with the colon. Settings for K&R, BSD, and Stroustrup indentation styles are c-indent-level 5 8 4 c-continued-statement-offset 5 8 4 c-continued-brace-offset 0 c-brace-offset -5 -8 0 c-brace-imaginary-offset 0 c-argdecl-indent 0 8 4 c-label-offset -5 -8 -4 c++-empty-arglist-indent 4 c++-friend-offset 0 Turning on C++ mode calls the value of the variable `c++-mode-hook' with no args if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map c++-mode-map) (set-syntax-table c++-mode-syntax-table) (setq major-mode 'c++-mode mode-name "C++" comment-column 32 local-abbrev-table c++-mode-abbrev-table) (set (make-local-variable 'indent-line-function) 'c++-indent-line) (set (make-local-variable 'comment-start) "// ") (set (make-local-variable 'comment-end) "") (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|// *") (set (make-local-variable 'comment-indent-function) 'c++-comment-indent) (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) (set (make-local-variable 'paragraph-separate) paragraph-start) (set (make-local-variable 'paragraph-ignore-fill-prefix) t) (set (make-local-variable 'require-final-newline) t) (set (make-local-variable 'parse-sexp-ignore-comments) t) (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression c++-imenu-generic-expression) (run-hooks 'c++-mode-hook) (if c++-electric-colon (define-key c++-mode-map ":" 'electric-c++-terminator))) ;; This is used by indent-for-comment ;; to decide how much to indent a comment in C++ code ;; based on its context. (defun c++-comment-indent () (if (looking-at "^\\(/\\*\\|//\\)") 0 ; Existing comment at bol stays there. (save-excursion (skip-chars-backward " \t") (max ;; leave at least one space on non-empty lines. (if (zerop (current-column)) 0 (1+ (current-column))) (let ((cur-pt (point))) (beginning-of-line 0) ;; If previous line had a comment, use it's indent (if (re-search-forward comment-start-skip cur-pt t) (progn (goto-char (match-beginning 0)) (current-column)) comment-column)))))) ; otherwise indent at comment column. (defun electric-c++-brace (arg) "Insert character and correct line's indentation." (interactive "P") (let (insertpos) (if (and (not arg) (eolp) (or (save-excursion (skip-chars-backward " \t") (bolp)) (if c-auto-newline (progn (c++-indent-line) (newline) t)))) (progn (insert last-command-char) (c++-indent-line) (if c-auto-newline (progn (newline) ;; (newline) may have done auto-fill (setq insertpos (- (point) 2)) (c++-indent-line))) (save-excursion (if insertpos (goto-char (1+ insertpos))) (delete-char -1)))) (if insertpos (save-excursion (goto-char insertpos) (self-insert-command (prefix-numeric-value arg))) (self-insert-command (prefix-numeric-value arg))))) (defun electric-c++-semi (arg) "Insert character and correct line's indentation." (interactive "P") (if c-auto-newline (electric-c++-terminator arg) (self-insert-command (prefix-numeric-value arg)))) (defun electric-c++-terminator (arg) "Insert character and correct line's indentation." (interactive "P") (let (insertpos (end (point))) (if (and (not arg) (eolp) (not (save-excursion (beginning-of-line) (skip-chars-forward " \t") (or (= (following-char) ?#) ;; Colon is special only after a label, or ;; case, or another colon. ;; So quickly rule out most other uses of colon ;; and do no indentation for them. (and (eq last-command-char ?:) (or (not (or (looking-at "case[ \t]") (save-excursion (forward-word 1) (skip-chars-forward " \t") (>= (point) end)))) ;; Do re-indent double colons (save-excursion (end-of-line 1) (looking-at ":")))) (progn (beginning-of-defun) (let ((pps (parse-partial-sexp (point) end))) (or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))))) (progn (insert last-command-char) (c++-indent-line) (and c-auto-newline (not (c-inside-parens-p)) (progn ;; the new marker object, used to be just an integer (setq insertpos (make-marker)) ;; changed setq to set-marker (set-marker insertpos (1- (point))) ;; do this before the newline, since in auto fill can break (newline) (c-indent-line))) (save-excursion (if insertpos (goto-char (1+ insertpos))) (delete-char -1)))) (if insertpos (save-excursion (goto-char insertpos) (self-insert-command (prefix-numeric-value arg))) (self-insert-command (prefix-numeric-value arg))))) (defun c++-indent-command (&optional whole-exp) "Indent current line as C++ code, or in some cases insert a tab character. If `c-tab-always-indent' is non-nil (the default), always indent current line. Otherwise, indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. A numeric argument, regardless of its value, means indent rigidly all means indent rigidly all the lines of the expression starting after point so that this line becomes properly indented. The relative indentation among the lines of the expression are preserved." (interactive "P") (if whole-exp ;; If arg, always indent this line as C ;; and shift remaining lines of expression the same amount. (let ((shift-amt (c++-indent-line)) beg end) (save-excursion (if c-tab-always-indent (beginning-of-line)) (setq beg (point)) (forward-sexp 1) (setq end (point)) (goto-char beg) (forward-line 1) (setq beg (point))) (if (> end beg) (indent-code-rigidly beg end shift-amt "#"))) (if (and (not c-tab-always-indent) (save-excursion (skip-chars-backward " \t") (not (bolp)))) (insert-tab) (c++-indent-line)))) (defun c++-indent-line () "Indent current line as C++ code. Return the amount the indentation changed by." (let ((indent (calculate-c++-indent nil)) beg shift-amt (case-fold-search nil) (pos (- (point-max) (point)))) (beginning-of-line) (setq beg (point)) (cond ((eq indent nil) (setq indent (current-indentation))) ((eq indent t) (setq indent (calculate-c-indent-within-comment))) ((looking-at "[ \t]*#") (setq indent 0)) (t (skip-chars-forward " \t") (if (listp indent) (setq indent (car indent))) (cond ((looking-at "\\(default\\|public\\|private\\|protected\\):") (setq indent (+ indent c-label-offset))) ((or (looking-at "case\\b") (and (looking-at "[A-Za-z]") (save-excursion (forward-sexp 1) (looking-at ":[^:]")))) (setq indent (max 1 (+ indent c-label-offset)))) ((and (looking-at "else\\b") (not (looking-at "else\\s_"))) (setq indent (save-excursion (c-backward-to-start-of-if) (current-indentation)))) ((looking-at "friend\[ \t]") (setq indent (+ indent c++-friend-offset))) ((= (following-char) ?}) (setq indent (- indent c-indent-level))) ((= (following-char) ?{) (setq indent (+ indent c-brace-offset)))))) (skip-chars-forward " \t") (setq shift-amt (- indent (current-column))) (if (zerop shift-amt) (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) (delete-region beg (point)) (indent-to indent) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos)))) shift-amt)) (defun calculate-c++-indent (&optional parse-start) "Return appropriate indentation for current line as C++ code. In usual case returns an integer: the column to indent to. Returns nil if line starts inside a string, t if in a comment." (save-excursion (beginning-of-line) (let ((indent-point (point)) (case-fold-search nil) state containing-sexp) (if parse-start (goto-char parse-start) (beginning-of-defun)) (while (< (point) indent-point) (setq parse-start (point)) (setq state (parse-partial-sexp (point) indent-point 0)) (setq containing-sexp (car (cdr state)))) (cond ((or (nth 3 state) (nth 4 state)) ;; return nil or t if should not change this line (nth 4 state)) ((null containing-sexp) ;; Line is at top level. May be data or function definition, or ;; may be function argument declaration or member initialization. ;; Indent like the previous top level line unless ;; (1) the previous line ends in a closeparen without semicolon, ;; in which case this line is the first argument declaration or ;; member initialization, or ;; (2) the previous line begins with a colon, ;; in which case this is the second line of member inits. ;; It is assumed that arg decls and member inits are not mixed. (goto-char indent-point) (skip-chars-forward " \t") (if (= (following-char) ?{) 0 ; Unless it starts a function body (c++-backward-to-noncomment (or parse-start (point-min))) (if (= (preceding-char) ?\)) (progn ; first arg decl or member init (goto-char indent-point) (skip-chars-forward " \t") (if (= (following-char) ?:) c++-member-init-indent c-argdecl-indent)) (if (= (preceding-char) ?\;) (backward-char 1)) (if (= (preceding-char) ?}) 0 (if (= (preceding-char) ?\)) (forward-list -1)) (beginning-of-line) ; continued arg decls or member inits (skip-chars-forward " \t") (if (= (following-char) ?:) (if c++-continued-member-init-offset (+ (current-indentation) c++-continued-member-init-offset) (progn (forward-char 1) (skip-chars-forward " \t") (current-column))) (current-indentation))) ))) ((/= (char-after containing-sexp) ?{) ;; line is expression, not statement: ;; indent to just after the surrounding open -- unless ;; empty arg list, in which case we do what ;; c++-empty-arglist-indent says to do. (if (and c++-empty-arglist-indent (or (null (nth 2 state)) ;; indicates empty arg ;; list. ;; Use a heuristic: if the first ;; non-whitespace following left paren on ;; same line is not a comment, ;; is not an empty arglist. (save-excursion (goto-char (1+ containing-sexp)) (not (looking-at "\\( \\|\t\\)*[^/\n]"))))) (progn (goto-char containing-sexp) (beginning-of-line) (skip-chars-forward " \t") (goto-char (min (+ (point) c++-empty-arglist-indent) (1+ containing-sexp))) (current-column)) ;; In C-mode, we would always indent to one after the ;; left paren. Here, though, we may have an ;; empty-arglist, so we'll indent to the min of that ;; and the beginning of the first argument. (goto-char (1+ containing-sexp)) (current-column))) (t ;; Statement. Find previous non-comment character. (goto-char indent-point) (c++-backward-to-noncomment containing-sexp) (if (and (not (memq (preceding-char) '(0 ?\, ?\; ?\} ?\{))) ;; But don't treat a line with a close-brace ;; as a continuation. It is probably the ;; end of an enum type declaration. (save-excursion (goto-char indent-point) (skip-chars-forward " \t") (not (= (following-char) ?})))) ;; This line is continuation of preceding line's statement; ;; indent c-continued-statement-offset more than the ;; previous line of the statement. (progn (c-backward-to-start-of-continued-exp containing-sexp) (+ c-continued-statement-offset (current-column) (if (save-excursion (goto-char indent-point) (skip-chars-forward " \t") (eq (following-char) ?{)) c-continued-brace-offset 0))) ;; This line starts a new statement. ;; Position following last unclosed open. (goto-char containing-sexp) ;; Is line first statement after an open-brace? (or ;; If no, find that first statement and indent like it. (save-excursion (forward-char 1) (let ((colon-line-end 0)) (while (progn (skip-chars-forward " \t\n") (looking-at (concat "#\\|/\\*\\|//" "\\|case[ \t]" "\\|[a-zA-Z0-9_$]*:[^:]" "\\|friend[ \t]"))) ;; Skip over comments and labels following openbrace. (cond ((= (following-char) ?\#) (forward-line 1)) ((looking-at "/\\*") (search-forward "*/" nil 'move)) ((looking-at "//\\|friend[ \t]") (forward-line 1)) (t (save-excursion (end-of-line) (setq colon-line-end (point))) (search-forward ":")))) ;; The first following code counts ;; if it is before the line we want to indent. (and (< (point) indent-point) (- (if (> colon-line-end (point)) (- (current-indentation) c-label-offset) (current-column)) ;; If prev stmt starts with open-brace, that ;; open brace was offset by c-brace-offset. ;; Compensate to get the column where ;; an ordinary statement would start. (if (= (following-char) ?\{) c-brace-offset 0))))) ;; If no previous statement, ;; indent it relative to line brace is on. ;; For open brace in column zero, don't let statement ;; start there too. If c-indent-offset is zero, ;; use c-brace-offset + c-continued-statement-offset instead. ;; For open-braces not the first thing in a line, ;; add in c-brace-imaginary-offset. (+ (if (and (bolp) (zerop c-indent-level)) (+ c-brace-offset c-continued-statement-offset) c-indent-level) ;; Move back over whitespace before the openbrace. ;; If openbrace is not first nonwhite thing on the line, ;; add the c-brace-imaginary-offset. (progn (skip-chars-backward " \t") (if (bolp) 0 c-brace-imaginary-offset)) ;; If the openbrace is preceded by a parenthesized exp, ;; move to the beginning of that; ;; possibly a different line (progn (if (eq (preceding-char) ?\)) (forward-sexp -1)) ;; Get initial indentation of the line we are on. (current-indentation)))))))))) (defun c++-backward-to-noncomment (lim) (let (opoint stop) (while (not stop) (skip-chars-backward " \t\n\r\f" lim) (setq opoint (point)) (cond ((and (>= (point) (+ 2 lim)) (save-excursion (forward-char -2) (looking-at "\\*/"))) (search-backward "/*" lim 'move)) ((and (search-backward "//" (max (c++-point-bol) lim) 'move) (not (c++-within-string-p (point) opoint)))) ;; No comment to be found. ;; If there's a # command on this line, ;; move back to it. (t (beginning-of-line) (skip-chars-forward " \t") ;; But don't get fooled if we are already before the #. (if (and (looking-at "#") (< (point) opoint)) (setq stop (<= (point) lim)) (setq stop t) (goto-char opoint))))))) (defun indent-c++-exp () "Indent each line of the C++ grouping following point." (interactive) (let ((indent-stack (list nil)) (contain-stack (list (point))) (case-fold-search nil) restart outer-loop-done inner-loop-done state ostate this-indent last-sexp last-depth at-else at-brace (opoint (point)) (next-depth 0)) (save-excursion (forward-sexp 1)) (save-excursion (setq outer-loop-done nil) (while (and (not (eobp)) (not outer-loop-done)) (setq last-depth next-depth) ;; Compute how depth changes over this line ;; plus enough other lines to get to one that ;; does not end inside a comment or string. ;; Meanwhile, do appropriate indentation on comment lines. (setq inner-loop-done nil) (while (and (not inner-loop-done) (not (and (eobp) (setq outer-loop-done t)))) (setq ostate state) (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) nil nil state)) (setq next-depth (car state)) (if (and (car (cdr (cdr state))) (>= (car (cdr (cdr state))) 0)) (setq last-sexp (car (cdr (cdr state))))) (if (or (nth 4 ostate)) (c++-indent-line)) (if (or (nth 3 state)) (forward-line 1) (setq inner-loop-done t))) (if (<= next-depth 0) (setq outer-loop-done t)) (if outer-loop-done nil ;; If this line had ..))) (((.. in it, pop out of the levels ;; that ended anywhere in this line, even if the final depth ;; doesn't indicate that they ended. (while (> last-depth (nth 6 state)) (setq indent-stack (cdr indent-stack) contain-stack (cdr contain-stack) last-depth (1- last-depth))) (if (/= last-depth next-depth) (setq last-sexp nil)) ;; Add levels for any parens that were started in this line. (while (< last-depth next-depth) (setq indent-stack (cons nil indent-stack) contain-stack (cons nil contain-stack) last-depth (1+ last-depth))) (if (null (car contain-stack)) (setcar contain-stack (or (car (cdr state)) (save-excursion (forward-sexp -1) (point))))) (forward-line 1) (skip-chars-forward " \t") (if (eolp) nil (if (and (car indent-stack) (>= (car indent-stack) 0)) ;; Line is on an existing nesting level. ;; Lines inside parens are handled specially. nil ;; Just started a new nesting level. ;; Compute the standard indent for this level. (let (val) (if (= (char-after (car contain-stack)) ?{) (save-excursion (goto-char (car contain-stack)) (setq val (+ c-indent-level (current-column)))) (setq val (calculate-c++-indent (if (car indent-stack) (- (car indent-stack)))))) (setcar indent-stack val))) ;; Adjust line indentation according to its predecessor. (if (/= (char-after (car contain-stack)) ?\{) (setq this-indent (car indent-stack)) ;; Line is at statement level. ;; Is it a new statement? Is it an else? ;; Find last non-comment character before this line (save-excursion (setq at-else (looking-at "else\\W")) (setq at-brace (= (following-char) ?\{)) (c++-backward-to-noncomment opoint) (if (not (memq (preceding-char) '(nil ?\, ?\; ?\} ?: ?\{))) ;; Preceding line did not end in comma or semi; ;; indent this line c-continued-statement-offset ;; more than previous. (progn (c-backward-to-start-of-continued-exp (car contain-stack)) (setq this-indent (+ c-continued-statement-offset (current-column) (if at-brace c-continued-brace-offset 0)))) ;; Preceding line ended in comma or semi; ;; use the standard indent for this level. (if at-else (progn (c-backward-to-start-of-if opoint) (setq this-indent (current-indentation))) (setq this-indent (car indent-stack)))))) ;; Adjust line indentation according to its contents (if (looking-at "\\(public\\|private\\|protected\\):") (setq this-indent (- this-indent c-indent-level)) (if (or (looking-at "case[ \t]") (and (looking-at "[A-Za-z]") (save-excursion (forward-sexp 1) (looking-at ":[^:]")))) (setq this-indent (max 1 (+ this-indent c-label-offset))))) (if (looking-at "friend[ \t]") (setq this-indent (+ this-indent c++-friend-offset))) (if (= (following-char) ?\}) (setq this-indent (- this-indent c-indent-level))) (if (= (following-char) ?\{) (setq this-indent (+ this-indent c-brace-offset))) ;; Put chosen indentation into effect. (or (= (current-column) this-indent) (= (following-char) ?\#) (progn (delete-region (point) (progn (beginning-of-line) (point))) (indent-to this-indent))) ;; Indent any comment following the text. (or (looking-at comment-start-skip) (if (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t) (progn (indent-for-comment) (beginning-of-line)))))))))) (defun fill-c++-comment () "Fill a comment contained in consecutive lines containing point. The fill lines remain a comment." (interactive) (save-excursion (let ((save fill-prefix)) (beginning-of-line 1) (save-excursion (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t) (goto-char (match-end 0)) (set-fill-prefix)) (while (looking-at fill-prefix) (previous-line 1)) (next-line 1) (insert-string "\n") (fill-paragraph nil) (delete-char -1) (setq fill-prefix save)))) (defun c++-point-bol () "Returns the value of the point at the beginning of the current line." (save-excursion (beginning-of-line) (point))) ;; (defun c++-insert-header () ;; "Insert header denoting C++ code at top of buffer." ;; (interactive) ;; (save-excursion ;; (goto-char (point-min)) ;; (insert "// " ;; "This may look like C code, but it is really " ;; "-*- C++ -*-" ;; "\n\n"))) (defun c++-within-string-p (point1 point2) "Returns true if number of double quotes between two points is odd." (let ((s (buffer-substring point1 point2))) (not (zerop (% (c++-count-char-in-string ?\" s) 2))))) (defun c++-count-char-in-string (c s) (let ((count 0) (pos 0)) (while (< pos (length s)) (setq count (+ count (if (\= (aref s pos) c) 1 0))) (setq pos (1+ pos))) count)) ;; rms: This page is creeping featurism, and not worth having. ;;; Below are two regular expressions that attempt to match defuns ;;; "strongly" and "weakly." The strong one almost reconstructs the ;;; grammar of C++; the weak one just figures anything id or curly on ;;; the left begins a defun. The constant "c++-match-header-strongly" ;;; determines which to use; the default is the weak one. ;; (defvar c++-match-header-strongly nil ;; "*If nil, use `c++-defun-header-weak' to identify beginning of definitions. ;; If non-nil, use `c++-defun-header-strong'.") ;; ;; (defvar c++-defun-header-strong-struct-equivs "\\(class\\|struct\\|enum\\)" ;; "Regexp to match names of structure declaration blocks in C++.") ;; ;; (defconst c++-defun-header-strong ;; (let* ;; (; valid identifiers ;; ;; There's a real weirdness here -- if I switch the below ;; (id "\\(\\w\\|_\\)+") ;; ;; to be ;; ;; (id "\\(_\\|\\w\\)+") ;; ;; things no longer work right. Try it and see! ;; ;; ; overloadable operators ;; (op-sym1 ;; "[-+*/%^&|~!=<>]\\|[-+*/%^&|<>=!]=\\|<<=?\\|>>=?") ;; (op-sym2 ;; "&&\\|||\\|\\+\\+\\|--\\|()\\|\\[\\]") ;; (op-sym (concat "\\(" op-sym1 "\\|" op-sym2 "\\)")) ;; ; whitespace ;; (middle "[^\\*]*\\(\\*+[^/\\*][^\\*]*\\)*") ;; (c-comment (concat "/\\*" middle "\\*+/")) ;; (wh (concat "\\(\\s \\|\n\\|//.*$\\|" c-comment "\\)")) ;; (wh-opt (concat wh "*")) ;; (wh-nec (concat wh "+")) ;; (oper (concat "\\(" "operator" "\\(" ;; wh-opt op-sym "\\|" wh-nec id "\\)" "\\)")) ;; (dcl-list "([^():]*)") ;; (func-name (concat "\\(" oper "\\|" id "::" id "\\|" id "\\)")) ;; (inits ;; (concat "\\(:" ;; "\\(" wh-opt id "(.*\\()" wh-opt "," "\\)\\)*" ;; wh-opt id "(.*)" wh-opt "{" ;; "\\|" wh-opt "{\\)")) ;; (type-name (concat ;; "\\(" c++-defun-header-strong-struct-equivs wh-nec "\\)?" ;; id)) ;; (type (concat "\\(const" wh-nec "\\)?" ;; "\\(" type-name "\\|" type-name wh-opt "\\*+" "\\|" ;; type-name wh-opt "&" "\\)")) ;; (modifier "\\(inline\\|virtual\\|overload\\|auto\\|static\\)") ;; (modifiers (concat "\\(" modifier wh-nec "\\)*")) ;; (func-header ;; ;; type arg-dcl ;; (concat modifiers type wh-nec func-name wh-opt dcl-list wh-opt inits)) ;; (inherit (concat "\\(:" wh-opt "\\(public\\|private\\)?" ;; wh-nec id "\\)")) ;; (cs-header (concat ;; c++-defun-header-strong-struct-equivs ;; wh-nec id wh-opt inherit "?" wh-opt "{"))) ;; (concat "^\\(" func-header "\\|" cs-header "\\)")) ;; "Strongly-defined regexp to match beginning of structure or function def.") ;; ;; ;; ;; This part has to do with recognizing defuns. ;; ;; ;; The weak convention we will use is that a defun begins any time ;; ;; there is a left curly brace, or some identifier on the left margin, ;; ;; followed by a left curly somewhere on the line. (This will also ;; ;; incorrectly match some continued strings, but this is after all ;; ;; just a weak heuristic.) Suggestions for improvement (short of the ;; ;; strong scheme shown above) are welcomed. ;; ;; (defconst c++-defun-header-weak "^{\\|^[_a-zA-Z].*{" ;; "Weakly-defined regexp to match beginning of structure or function def.") ;; ;; (defun c++-beginning-of-defun (arg) ;; (interactive "p") ;; (let ((c++-defun-header (if c++-match-header-strongly ;; c++-defun-header-strong ;; c++-defun-header-weak))) ;; (cond ((or (= arg 0) (and (> arg 0) (bobp))) nil) ;; ((and (not (looking-at c++-defun-header)) ;; (let ((curr-pos (point)) ;; (open-pos (if (search-forward "{" nil 'move) ;; (point))) ;; (beg-pos ;; (if (re-search-backward c++-defun-header nil 'move) ;; (match-beginning 0)))) ;; (if (and open-pos beg-pos ;; (< beg-pos curr-pos) ;; (> open-pos curr-pos)) ;; (progn ;; (goto-char beg-pos) ;; (if (= arg 1) t nil));; Are we done? ;; (goto-char curr-pos) ;; nil)))) ;; (t ;; (if (and (looking-at c++-defun-header) (not (bobp))) ;; (forward-char (if (< arg 0) 1 -1))) ;; (and (re-search-backward c++-defun-header nil 'move (or arg 1)) ;; (goto-char (match-beginning 0))))))) ;; ;; ;; (defun c++-end-of-defun (arg) ;; (interactive "p") ;; (let ((c++-defun-header (if c++-match-header-strongly ;; c++-defun-header-strong ;; c++-defun-header-weak))) ;; (if (and (eobp) (> arg 0)) ;; nil ;; (if (and (> arg 0) (looking-at c++-defun-header)) (forward-char 1)) ;; (let ((pos (point))) ;; (c++-beginning-of-defun ;; (if (< arg 0) ;; (- (- arg (if (eobp) 0 1))) ;; arg)) ;; (if (and (< arg 0) (bobp)) ;; t ;; (if (re-search-forward c++-defun-header nil 'move) ;; (progn (forward-char -1) ;; (forward-sexp) ;; (beginning-of-line 2))) ;; (if (and (= pos (point)) ;; (re-search-forward c++-defun-header nil 'move)) ;; (c++-end-of-defun 1)))) ;; t))) ;; ;; (defun c++-indent-defun () ;; "Indents the current function definition, struct or class declaration." ;; (interactive) ;; (let ((restore (point))) ;; (c++-end-of-defun 1) ;; (beginning-of-line 1) ;; (let ((end (point))) ;; (c++-beginning-of-defun 1) ;; (while (<= (point) end) ;; (c++-indent-line) ;; (next-line 1) ;; (beginning-of-line 1))) ;; (goto-char restore))) ;;; cplus-md.el ends here emacs-19.30/lisp/cpp.el100444 12120 1 64017 5745127522 13214 0ustar rmsdaemon;;; cpp.el --- Highlight or hide text according to cpp conditionals. ;; Copyright (C) 1994, 1995 Free Software Foundation ;; Author: Per Abrahamsen ;; Keywords: c, faces, tools ;; 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: ;; Parse a text for C preprocessor conditionals, and highlight or hide ;; the text inside the conditionals as you wish. ;; This package is inspired by Jim Coplien's delta editor for SCCS. ;;; Todo: ;; Should parse "#if" and "#elif" expressions and merge the faces ;; somehow. ;; Somehow it is sometimes possible to make changes near a read only ;; area which you can't undo. Their are other strange effects in that ;; area. ;; The Edit buffer should -- optionally -- appear in its own frame. ;; Conditionals seem to be rear-sticky. They shouldn't be. ;; Restore window configurations when exiting CPP Edit buffer. ;;; Code: ;;; Customization: (defvar cpp-known-face 'invisible "*Face used for known cpp symbols.") (defvar cpp-unknown-face 'highlight "*Face used for unknown cpp cymbols.") (defvar cpp-face-type 'light "*Indicate what background face type you prefer. Can be either light or dark for color screens, mono for monochrome screens, and none if you don't use a window system.") (defvar cpp-known-writable t "*Non-nil means you are allowed to modify the known conditionals.") (defvar cpp-unknown-writable t "*Non-nil means you are allowed to modify the unknown conditionals.") (defvar cpp-edit-list nil "Alist of cpp macros and information about how they should be displayed. Each entry is a list with the following elements: 0. The name of the macro (a string). 1. Face used for text that is `ifdef' the macro. 2. Face used for text that is `ifndef' the macro. 3. `t', `nil', or `both' depending on what text may be edited.") (defvar cpp-overlay-list nil) ;; List of cpp overlays active in the current buffer. (make-variable-buffer-local 'cpp-overlay-list) (defvar cpp-callback-data) (defvar cpp-state-stack) (defconst cpp-face-type-list '(("light color background" . light) ("dark color background" . dark) ("monochrome" . mono) ("tty" . none)) "Alist of strings and names of the defined face collections.") (defconst cpp-writable-list ;; Names used for the writable property. '(("writable" . t) ("read-only" . nil))) (defvar cpp-button-event nil) ;; This will be t in the callback for `cpp-make-button'. (defvar cpp-edit-buffer nil) ;; Real buffer whose cpp display information we are editing. (make-variable-buffer-local 'cpp-edit-buffer) (defconst cpp-branch-list ;; Alist of branches. '(("false" . nil) ("true" . t) ("both" . both))) (defvar cpp-face-default-list nil "List of faces you can choose from for cpp conditionals.") (defvar cpp-face-light-name-list '("light gray" "light blue" "light cyan" "light yellow" "light pink" "pale green" "beige" "orange" "magenta" "violet" "medium purple" "turquoise") "Background colours useful with dark foreground colors.") (defvar cpp-face-dark-name-list '("dim gray" "blue" "cyan" "yellow" "red" "dark green" "brown" "dark orange" "dark khaki" "dark violet" "purple" "dark turquoise") "Background colours useful with light foreground colors.") (defvar cpp-face-light-list nil "Alist of names and faces to be used for light backgrounds.") (defvar cpp-face-dark-list nil "Alist of names and faces to be used for dark backgrounds.") (defvar cpp-face-mono-list '(("bold" . 'bold) ("bold-italic" . 'bold-italic) ("italic" . 'italic) ("underline" . 'underline)) "Alist of names and faces to be used for monocrome screens.") (defvar cpp-face-none-list '(("default" . default) ("invisible" . invisible)) "Alist of names and faces available even if you don't use a window system.") (defvar cpp-face-all-list (append cpp-face-light-list cpp-face-dark-list cpp-face-mono-list cpp-face-none-list) "All faces used for highligting text inside cpp conditionals.") ;;; Parse Buffer: (defvar cpp-parse-symbols nil "List of cpp macros used in the local buffer.") (make-variable-buffer-local 'cpp-parse-symbols) (defconst cpp-parse-regexp ;; Regexp matching all tokens needed to find conditionals. (concat "'\\|\"\\|/\\*\\|//\\|" "\\(^[ \t]*#[ \t]*\\(ifdef\\|ifndef\\|if\\|" "elif\\|else\\|endif\\)\\b\\)")) ;;;###autoload (defun cpp-highlight-buffer (arg) "Highlight C code according to preprocessor conditionals. This command pops up a buffer which you should edit to specify what kind of highlighting to use, and the criteria for highlighting. A prefix arg suppresses display of that buffer." (interactive "P") (setq cpp-parse-symbols nil) (cpp-parse-reset) (if (null cpp-edit-list) (cpp-edit-load)) (let (cpp-state-stack) (save-excursion (goto-char (point-min)) (cpp-progress-message "Parsing...") (while (re-search-forward cpp-parse-regexp nil t) (cpp-progress-message "Parsing...%d%%" (/ (* 100 (- (point) (point-min))) (buffer-size))) (let ((match (buffer-substring (match-beginning 0) (match-end 0)))) (cond ((or (string-equal match "'") (string-equal match "\"")) (goto-char (match-beginning 0)) (condition-case nil (forward-sexp) (error (cpp-parse-error "Unterminated string or character")))) ((string-equal match "/*") (or (search-forward "*/" nil t) (error "Unterminated comment"))) ((string-equal match "//") (skip-chars-forward "^\n\r")) (t (end-of-line 1) (let ((from (match-beginning 1)) (to (1+ (point))) (type (buffer-substring (match-beginning 2) (match-end 2))) (expr (buffer-substring (match-end 1) (point)))) (cond ((string-equal type "ifdef") (cpp-parse-open t expr from to)) ((string-equal type "ifndef") (cpp-parse-open nil expr from to)) ((string-equal type "if") (cpp-parse-open t expr from to)) ((string-equal type "elif") (let (cpp-known-face cpp-unknown-face) (cpp-parse-close from to)) (cpp-parse-open t expr from to)) ((string-equal type "else") (or cpp-state-stack (cpp-parse-error "Top level #else")) (let ((entry (list (not (nth 0 (car cpp-state-stack))) (nth 1 (car cpp-state-stack)) from to))) (cpp-parse-close from to) (setq cpp-state-stack (cons entry cpp-state-stack)))) ((string-equal type "endif") (cpp-parse-close from to)) (t (cpp-parse-error "Parser error")))))))) (message "Parsing...done")) (if cpp-state-stack (save-excursion (goto-char (nth 3 (car cpp-state-stack))) (cpp-parse-error "Unclosed conditional")))) (or arg (null cpp-parse-symbols) (cpp-parse-edit))) (defun cpp-parse-open (branch expr begin end) "Push information about conditional-beginning onto `cpp-state-stack'." ;; Discard comments within this line. (while (string-match "\\b[ \t]*/\\*.*\\*/[ \t]*\\b" expr) (setq expr (concat (substring expr 0 (match-beginning 0)) (substring expr (match-end 0))))) ;; If a comment starts on this line and continues past, discard it. (if (string-match "\\b[ \t]*/\\*" expr) (setq expr (substring expr 0 (match-beginning 0)))) ;; Delete any C++ comment from the line. (if (string-match "\\b[ \t]*\\(//.*\\)?$" expr) (setq expr (substring expr 0 (match-beginning 0)))) (while (string-match "[ \t]+" expr) (setq expr (concat (substring expr 0 (match-beginning 0)) (substring expr (match-end 0))))) (setq cpp-state-stack (cons (list branch expr begin end) cpp-state-stack)) (or (member expr cpp-parse-symbols) (setq cpp-parse-symbols (cons expr cpp-parse-symbols))) (if (assoc expr cpp-edit-list) (cpp-make-known-overlay begin end) (cpp-make-unknown-overlay begin end))) (defun cpp-parse-close (from to) ;; Pop top of cpp-state-stack and create overlay. (let ((entry (assoc (nth 1 (car cpp-state-stack)) cpp-edit-list)) (branch (nth 0 (car cpp-state-stack))) (begin (nth 2 (car cpp-state-stack))) (end (nth 3 (car cpp-state-stack)))) (setq cpp-state-stack (cdr cpp-state-stack)) (if entry (let ((face (nth (if branch 1 2) entry)) (read-only (eq (not branch) (nth 3 entry))) (priority (length cpp-state-stack)) (overlay (make-overlay end from))) (cpp-make-known-overlay from to) (setq cpp-overlay-list (cons overlay cpp-overlay-list)) (if priority (overlay-put overlay 'priority priority)) (cond ((eq face 'invisible) (cpp-make-overlay-hidden overlay)) ((eq face 'default)) (t (overlay-put overlay 'face face))) (if read-only (cpp-make-overlay-read-only overlay) (cpp-make-overlay-sticky overlay))) (cpp-make-unknown-overlay from to)))) (defun cpp-parse-error (error) ;; Error message issued by the cpp parser. (error (concat error " at line %d") (count-lines (point-min) (point)))) (defun cpp-parse-reset () "Reset display of cpp conditionals to normal." (interactive) (while cpp-overlay-list (delete-overlay (car cpp-overlay-list)) (setq cpp-overlay-list (cdr cpp-overlay-list)))) ;;;###autoload (defun cpp-parse-edit () "Edit display information for cpp conditionals." (interactive) (or cpp-parse-symbols (cpp-highlight-buffer t)) (let ((buffer (current-buffer))) (pop-to-buffer "*CPP Edit*") (cpp-edit-mode) (setq cpp-edit-buffer buffer) (cpp-edit-reset))) ;;; Overlays: (defun cpp-make-known-overlay (start end) ;; Create an overlay for a known cpp command from START to END. (let ((overlay (make-overlay start end))) (if (eq cpp-known-face 'invisible) (cpp-make-overlay-hidden overlay) (or (eq cpp-known-face 'default) (overlay-put overlay 'face cpp-known-face)) (if cpp-known-writable () (overlay-put overlay 'modification-hooks '(cpp-signal-read-only)) (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only)))) (setq cpp-overlay-list (cons overlay cpp-overlay-list)))) (defun cpp-make-unknown-overlay (start end) ;; Create an overlay for an unknown cpp command from START to END. (let ((overlay (make-overlay start end))) (cond ((eq cpp-unknown-face 'invisible) (cpp-make-overlay-hidden overlay)) ((eq cpp-unknown-face 'default)) (t (overlay-put overlay 'face cpp-unknown-face))) (if cpp-unknown-writable () (overlay-put overlay 'modification-hooks '(cpp-signal-read-only)) (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only))) (setq cpp-overlay-list (cons overlay cpp-overlay-list)))) (defun cpp-make-overlay-hidden (overlay) ;; Make overlay hidden and intangible. (overlay-put overlay 'invisible t) (overlay-put overlay 'intangible t) ;; Unfortunately `intangible' is not implemented for overlays yet, ;; so we make is read-only instead. (overlay-put overlay 'modification-hooks '(cpp-signal-read-only)) (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only))) (defun cpp-make-overlay-read-only (overlay) ;; Make overlay read only. (overlay-put overlay 'modification-hooks '(cpp-signal-read-only)) (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only)) (overlay-put overlay 'insert-behind-hooks '(cpp-signal-read-only))) (defun cpp-make-overlay-sticky (overlay) ;; Make OVERLAY grow when you insert text at either end. (overlay-put overlay 'insert-in-front-hooks '(cpp-grow-overlay)) (overlay-put overlay 'insert-behind-hooks '(cpp-grow-overlay))) (defun cpp-signal-read-only (overlay after start end &optional len) ;; Only allow deleting the whole overlay. ;; Trying to change a read-only overlay. (if (and (not after) (or (< (overlay-start overlay) start) (> (overlay-end overlay) end))) (error "This text is read only"))) (defun cpp-grow-overlay (overlay after start end &optional len) ;; Make OVERLAY grow to contain range START to END. (if after (move-overlay overlay (min start (overlay-start overlay)) (max end (overlay-end overlay))))) ;;; Edit Buffer: (defvar cpp-edit-map nil) ;; Keymap for `cpp-edit-mode'. (if cpp-edit-map () (setq cpp-edit-map (make-keymap)) (suppress-keymap cpp-edit-map) (define-key cpp-edit-map [ down-mouse-2 ] 'cpp-push-button) (define-key cpp-edit-map [ mouse-2 ] 'ignore) (define-key cpp-edit-map " " 'scroll-up) (define-key cpp-edit-map "\C-?" 'scroll-down) (define-key cpp-edit-map [ delete ] 'scroll-down) (define-key cpp-edit-map "\C-c\C-c" 'cpp-edit-apply) (define-key cpp-edit-map "a" 'cpp-edit-apply) (define-key cpp-edit-map "A" 'cpp-edit-apply) (define-key cpp-edit-map "r" 'cpp-edit-reset) (define-key cpp-edit-map "R" 'cpp-edit-reset) (define-key cpp-edit-map "s" 'cpp-edit-save) (define-key cpp-edit-map "S" 'cpp-edit-save) (define-key cpp-edit-map "l" 'cpp-edit-load) (define-key cpp-edit-map "L" 'cpp-edit-load) (define-key cpp-edit-map "h" 'cpp-edit-home) (define-key cpp-edit-map "H" 'cpp-edit-home) (define-key cpp-edit-map "b" 'cpp-edit-background) (define-key cpp-edit-map "B" 'cpp-edit-background) (define-key cpp-edit-map "k" 'cpp-edit-known) (define-key cpp-edit-map "K" 'cpp-edit-known) (define-key cpp-edit-map "u" 'cpp-edit-unknown) (define-key cpp-edit-map "u" 'cpp-edit-unknown) (define-key cpp-edit-map "t" 'cpp-edit-true) (define-key cpp-edit-map "T" 'cpp-edit-true) (define-key cpp-edit-map "f" 'cpp-edit-false) (define-key cpp-edit-map "F" 'cpp-edit-false) (define-key cpp-edit-map "w" 'cpp-edit-write) (define-key cpp-edit-map "W" 'cpp-edit-write) (define-key cpp-edit-map "X" 'cpp-edit-toggle-known) (define-key cpp-edit-map "x" 'cpp-edit-toggle-known) (define-key cpp-edit-map "Y" 'cpp-edit-toggle-unknown) (define-key cpp-edit-map "y" 'cpp-edit-toggle-unknown) (define-key cpp-edit-map "q" 'bury-buffer) (define-key cpp-edit-map "Q" 'bury-buffer)) (defvar cpp-edit-symbols nil) ;; Symbols defined in the edit buffer. (make-variable-buffer-local 'cpp-edit-symbols) (defun cpp-edit-mode () "Major mode for editing the criteria for highlighting cpp conditionals. Click on objects to change them. You can also use the keyboard accelerators indicated like this: [K]ey." (kill-all-local-variables) (buffer-disable-undo) (auto-save-mode -1) (setq buffer-read-only t) (setq major-mode 'cpp-edit-mode) (setq mode-name "CPP Edit") (use-local-map cpp-edit-map)) (defun cpp-edit-apply () "Apply edited display information to original buffer." (interactive) (cpp-edit-home) (cpp-highlight-buffer t)) (defun cpp-edit-reset () "Reset display information from original buffer." (interactive) (let ((buffer (current-buffer)) (buffer-read-only nil) (start (window-start)) (pos (point)) symbols) (set-buffer cpp-edit-buffer) (setq symbols cpp-parse-symbols) (set-buffer buffer) (setq cpp-edit-symbols symbols) (erase-buffer) (insert "CPP Display Information for `") (cpp-make-button (buffer-name cpp-edit-buffer) 'cpp-edit-home) (insert "\n\nClick mouse-2 on item you want to change or use\n" "or switch to this buffer and type the keyboard equivalents.\n" "Keyboard equivalents are indicated with brackets like [T]his.\n\n") (cpp-make-button "[H]ome (display the C file)" 'cpp-edit-home) (insert " ") (cpp-make-button "[A]pply new settings" 'cpp-edit-apply) (insert "\n") (cpp-make-button "[S]ave settings" 'cpp-edit-save) (insert " ") (cpp-make-button "[L]oad settings" 'cpp-edit-load) (insert "\n\n") (insert "[B]ackground: ") (cpp-make-button (car (rassq cpp-face-type cpp-face-type-list)) 'cpp-edit-background) (insert "\n[K]nown conditionals: ") (cpp-make-button (cpp-face-name cpp-known-face) 'cpp-edit-known nil t) (insert " [X] ") (cpp-make-button (car (rassq cpp-known-writable cpp-writable-list)) 'cpp-edit-toggle-known) (insert "\n[U]nknown conditionals: ") (cpp-make-button (cpp-face-name cpp-unknown-face) 'cpp-edit-unknown nil t) (insert " [Y] ") (cpp-make-button (car (rassq cpp-unknown-writable cpp-writable-list)) 'cpp-edit-toggle-unknown) (insert (format "\n\n\n%39s: %14s %14s %7s\n\n" "Expression" "[T]rue Face" "[F]alse Face" "[W]rite")) (while symbols (let* ((symbol (car symbols)) (entry (assoc symbol cpp-edit-list)) (true (nth 1 entry)) (false (nth 2 entry)) (write (if entry (nth 3 entry) 'both))) (setq symbols (cdr symbols)) (if (and entry ; Make default entries unknown. (or (null true) (eq true 'default)) (or (null false) (eq false 'default)) (eq write 'both)) (setq cpp-edit-list (delq entry cpp-edit-list) entry nil)) (if (> (length symbol) 39) (insert (substring symbol 0 39) ": ") (insert (format "%39s: " symbol))) (cpp-make-button (cpp-face-name true) 'cpp-edit-true symbol t 14) (insert " ") (cpp-make-button (cpp-face-name false) 'cpp-edit-false symbol t 14) (insert " ") (cpp-make-button (car (rassq write cpp-branch-list)) 'cpp-edit-write symbol nil 6) (insert "\n"))) (insert "\n\n") (set-window-start nil start) (goto-char pos))) (defun cpp-edit-load () "Load cpp configuration." (interactive) (cond ((file-readable-p ".cpp.el") (load-file ".cpp.el")) ((file-readable-p "~/.cpp.el") (load-file ".cpp.el"))) (if (eq major-mode 'cpp-edit-mode) (cpp-edit-reset))) (defun cpp-edit-save () "Load cpp configuration." (interactive) (require 'pp) (save-excursion (set-buffer cpp-edit-buffer) (let ((buffer (find-file-noselect ".cpp.el"))) (set-buffer buffer) (erase-buffer) (pp (list 'setq 'cpp-known-face (list 'quote cpp-known-face)) buffer) (pp (list 'setq 'cpp-unknown-face (list 'quote cpp-unknown-face)) buffer) (pp (list 'setq 'cpp-face-type (list 'quote cpp-face-type)) buffer) (pp (list 'setq 'cpp-known-writable (list 'quote cpp-known-writable)) buffer) (pp (list 'setq 'cpp-unknown-writable (list 'quote cpp-unknown-writable)) buffer) (pp (list 'setq 'cpp-edit-list (list 'quote cpp-edit-list)) buffer) (write-file ".cpp.el")))) (defun cpp-edit-home () "Switch back to original buffer." (interactive) (if cpp-button-event (read-event)) (pop-to-buffer cpp-edit-buffer)) (defun cpp-edit-background () "Change default face collection." (interactive) (call-interactively 'cpp-choose-default-face) (cpp-edit-reset)) (defun cpp-edit-known () "Select default for known conditionals." (interactive) (setq cpp-known-face (cpp-choose-face "Known face" cpp-known-face)) (cpp-edit-reset)) (defun cpp-edit-unknown () "Select default for unknown conditionals." (interactive) (setq cpp-unknown-face (cpp-choose-face "Unknown face" cpp-unknown-face)) (cpp-edit-reset)) (defun cpp-edit-toggle-known (arg) "Toggle writable status for known conditionals. With optional argument ARG, make them writable iff ARG is positive." (interactive "@P") (if (or (and (null arg) cpp-known-writable) (<= (prefix-numeric-value arg) 0)) (setq cpp-known-writable nil) (setq cpp-known-writable t)) (cpp-edit-reset)) (defun cpp-edit-toggle-unknown (arg) "Toggle writable status for unknown conditionals. With optional argument ARG, make them writable iff ARG is positive." (interactive "@P") (if (or (and (null arg) cpp-unknown-writable) (<= (prefix-numeric-value arg) 0)) (setq cpp-unknown-writable nil) (setq cpp-unknown-writable t)) (cpp-edit-reset)) (defun cpp-edit-true (symbol face) "Select SYMBOL's true FACE used for highlighting taken conditionals." (interactive (let ((symbol (cpp-choose-symbol))) (list symbol (cpp-choose-face "True face" (nth 1 (assoc symbol cpp-edit-list)))))) (setcar (nthcdr 1 (cpp-edit-list-entry-get-or-create symbol)) face) (cpp-edit-reset)) (defun cpp-edit-false (symbol face) "Select SYMBOL's false FACE used for highlighting untaken conditionals." (interactive (let ((symbol (cpp-choose-symbol))) (list symbol (cpp-choose-face "False face" (nth 2 (assoc symbol cpp-edit-list)))))) (setcar (nthcdr 2 (cpp-edit-list-entry-get-or-create symbol)) face) (cpp-edit-reset)) (defun cpp-edit-write (symbol branch) "Set which branches of SYMBOL should be writable to BRANCH. BRANCH should be either nil (false branch), t (true branch) or 'both." (interactive (list (cpp-choose-symbol) (cpp-choose-branch))) (setcar (nthcdr 3 (cpp-edit-list-entry-get-or-create symbol)) branch) (cpp-edit-reset)) (defun cpp-edit-list-entry-get-or-create (symbol) ;; Return the entry for SYMBOL in `cpp-edit-list'. ;; If it does not exist, create it. (let ((entry (assoc symbol cpp-edit-list))) (or entry (setq entry (list symbol nil nil 'both nil) cpp-edit-list (cons entry cpp-edit-list))) entry)) ;;; Prompts: (defun cpp-choose-symbol () ;; Choose a symbol if called from keyboard, otherwise use the one clicked on. (if cpp-button-event cpp-callback-data (completing-read "Symbol: " (mapcar 'list cpp-edit-symbols) nil t))) (defun cpp-choose-branch () ;; Choose a branch, either nil, t, or both. (if cpp-button-event (x-popup-menu cpp-button-event (list "Branch" (cons "Branch" cpp-branch-list))) (cdr (assoc (completing-read "Branch: " cpp-branch-list nil t) cpp-branch-list)))) (defun cpp-choose-face (prompt default) ;; Choose a face from cpp-face-defalt-list. ;; PROMPT is what to say to the user. ;; DEFAULT is the default face. (or (if cpp-button-event (x-popup-menu cpp-button-event (list prompt (cons prompt cpp-face-default-list))) (let ((name (car (rassq default cpp-face-default-list)))) (cdr (assoc (completing-read (if name (concat prompt " (default " name "): ") (concat prompt ": ")) cpp-face-default-list nil t) cpp-face-all-list)))) default)) (defun cpp-choose-default-face (type) ;; Choose default face list for screen of TYPE. ;; Type must be one of the types defined in `cpp-face-type-list'. (interactive (list (if cpp-button-event (x-popup-menu cpp-button-event (list "Screen type" (cons "Screen type" cpp-face-type-list))) (cdr (assoc (completing-read "Screen type: " cpp-face-type-list nil t) cpp-face-type-list))))) (cond ((null type)) ((eq type 'light) (if cpp-face-light-list () (setq cpp-face-light-list (mapcar 'cpp-create-bg-face cpp-face-light-name-list)) (setq cpp-face-all-list (append cpp-face-all-list cpp-face-light-list))) (setq cpp-face-type 'light) (setq cpp-face-default-list (append cpp-face-light-list cpp-face-none-list))) ((eq type 'dark) (if cpp-face-dark-list () (setq cpp-face-dark-list (mapcar 'cpp-create-bg-face cpp-face-dark-name-list)) (setq cpp-face-all-list (append cpp-face-all-list cpp-face-dark-list))) (setq cpp-face-type 'dark) (setq cpp-face-default-list (append cpp-face-dark-list cpp-face-none-list))) ((eq type 'mono) (setq cpp-face-type 'mono) (setq cpp-face-default-list (append cpp-face-mono-list cpp-face-none-list))) (t (setq cpp-face-type 'none) (setq cpp-face-default-list cpp-face-none-list)))) ;;; Buttons: (defun cpp-make-button (name callback &optional data face padding) ;; Create a button at point. ;; NAME is the name of the button. ;; CALLBACK is the function to call when the button is pushed. ;; DATA will be made available to CALLBACK ;;in the free variable cpp-callback-data. ;; FACE means that NAME is the name of a face in `cpp-face-all-list'. ;; PADDING means NAME will be right justified at that length. (let ((name (format "%s" name)) from to) (cond ((null padding) (setq from (point)) (insert name)) ((> (length name) padding) (setq from (point)) (insert (substring name 0 padding))) (t (insert (make-string (- padding (length name)) ? )) (setq from (point)) (insert name))) (setq to (point)) (setq face (if face (let ((check (cdr (assoc name cpp-face-all-list)))) (if (memq check '(default invisible)) 'bold check)) 'bold)) (add-text-properties from to (append (list 'face face) '(mouse-face highlight) (list 'cpp-callback callback) (if data (list 'cpp-data data)))))) (defun cpp-push-button (event) ;; Pushed a CPP button. (interactive "@e") (set-buffer (window-buffer (posn-window (event-start event)))) (let ((pos (posn-point (event-start event)))) (let ((cpp-callback-data (get-text-property pos 'cpp-data)) (fun (get-text-property pos 'cpp-callback)) (cpp-button-event event)) (cond (fun (call-interactively (get-text-property pos 'cpp-callback))) ((lookup-key global-map [ down-mouse-2]) (call-interactively (lookup-key global-map [ down-mouse-2]))))))) ;;; Faces: (defun cpp-create-bg-face (color) ;; Create entry for face with background COLOR. (let ((name (intern (concat "cpp " color)))) (make-face name) (set-face-background name color) (cons color name))) (cpp-choose-default-face (if window-system cpp-face-type 'none)) (defun cpp-face-name (face) ;; Return the name of FACE from `cpp-face-all-list'. (let ((entry (rassq (if face face 'default) cpp-face-all-list))) (if entry (car entry) (format "<%s>" face)))) ;;; Utilities: (defvar cpp-progress-time 0) ;; Last time we issued a progress message. (defun cpp-progress-message (&rest args) ;; Report progress at most once a second. Take same ARGS as `message'. (let ((time (nth 1 (current-time)))) (if (= time cpp-progress-time) () (setq cpp-progress-time time) (apply 'message args)))) (provide 'cpp) ;;; cpp.el ends here emacs-19.30/lisp/cust-print.el100444 12120 1 63422 5731740063 14535 0ustar rmsdaemon;;; cust-print.el --- handles print-level and print-circle. ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Daniel LaLiberte ;; Adapted-By: ESR ;; Keywords: extensions ;; LCD Archive Entry: ;; cust-print|Daniel LaLiberte|liberte@cs.uiuc.edu ;; |Handle print-level, print-circle and more. ;; |$Date: 1995/03/16 04:36:01 $|$Revision: 2.1.1.2 $| ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; =============================== ;;; $Header: /home/fsf/rms/e19/lisp/RCS/cust-print.el,v 2.1.1.2 1995/03/16 04:36:01 rms Exp $ ;;; $Log: cust-print.el,v $ ;;; Revision 2.1.1.2 1995/03/16 04:36:01 rms ;;; Comment change. ;;; ;;; Revision 2.1.1.1 1994/04/09 22:24:43 liberte ;;; Branch for FSF mods. ;;; ;;; Revision 2.1 1994/04/09 22:19:10 liberte ;;; Jumping up to new revision. ;;; Simplify definition of defalias for Emacs 18. ;;; ;;; Revision 2.1 1994/04/09 22:19:10 liberte ;;; Jumping up to new revision. ;;; Simplify definition of defalias for Emacs 18. ;;; ;;; Revision 1.14 1994/04/05 21:05:09 liberte ;;; Change install- and uninstall- to -install and -uninstall. ;;; ;;; Revision 1.13 1994/03/24 20:26:05 liberte ;;; Change "internal" to "original" throughout. ;;; (add-custom-printer, delete-custom-printer) replace customizers. ;;; (with-custom-print) new ;;; (custom-prin1-to-string) Made it more robust. ;;; ;;; Revision 1.4 1994/03/23 20:34:29 liberte ;;; * Change "emacs" to "original" - I just can't decide. ;;; ;;; Revision 1.3 1994/02/21 21:25:36 liberte ;;; * Make custom-prin1-to-string more robust when errors occur. ;;; * Change "internal" to "emacs". ;;; ;;; Revision 1.2 1993/11/22 22:36:36 liberte ;;; * Simplified and generalized printer customization. ;;; custom-printers is an alist of (PREDICATE . PRINTER) pairs ;;; for any data types. The PRINTER function should print to ;;; `standard-output' add-custom-printer and delete-custom-printer ;;; change custom-printers. ;;; ;;; * Installation function now called install-custom-print. The ;;; old name is still around for now. ;;; ;;; * New macro with-custom-print (added earlier) - executes like ;;; progn but with custom-print activated temporarily. ;;; ;;; * Cleaned up comments for replacements of standardard printers. ;;; ;;; * Changed custom-prin1-to-string to use a temporary buffer. ;;; ;;; * Option custom-print-vectors (added earlier) - controls whether ;;; vectors should be printed according to print-length and ;;; print-length. Emacs doesnt do this, but cust-print would ;;; otherwise do it only if custom printing is required. ;;; ;;; * Uninterned symbols are treated as non-read-equivalent. ;;; ;;; Commentary: ;; This package provides a general print handler for prin1 and princ ;; that supports print-level and print-circle, and by the way, ;; print-length since the standard routines are being replaced. Also, ;; to print custom types constructed from lists and vectors, use ;; custom-print-list and custom-print-vector. See the documentation ;; strings of these variables for more details. ;; If the results of your expressions contain circular references to ;; other parts of the same structure, the standard Emacs print ;; subroutines may fail to print with an untrappable error, ;; "Apparently circular structure being printed". If you only use cdr ;; circular lists (where cdrs of lists point back; what is the right ;; term here?), you can limit the length of printing with ;; print-length. But car circular lists and circular vectors generate ;; the above mentioned error in Emacs version 18. Version ;; 19 supports print-level, but it is often useful to get a better ;; print representation of circular and shared structures; the print-circle ;; option may be used to print more concise representations. ;; There are three main ways to use this package. First, you may ;; replace prin1, princ, and some subroutines that use them by calling ;; install-custom-print so that any use of these functions in ;; Lisp code will be affected; you can later reset with ;; uninstall-custom-print. Second, you may temporarily install ;; these functions with the macro with-custom-print. Third, you ;; could call the custom routines directly, thus only affecting the ;; printing that requires them. ;; Note that subroutines which call print subroutines directly will ;; not use the custom print functions. In particular, the evaluation ;; functions like eval-region call the print subroutines directly. ;; Therefore, if you evaluate (aref circ-list 0), where circ-list is a ;; circular list rather than an array, aref calls error directly which ;; will jump to the top level instead of printing the circular list. ;; Uninterned symbols are recognized when print-circle is non-nil, ;; but they are not printed specially here. Use the cl-packages package ;; to print according to print-gensym. ;; Obviously the right way to implement this custom-print facility is ;; in C or with hooks into the standard printer. Please volunteer ;; since I don't have the time or need. More CL-like printing ;; capabilities could be added in the future. ;; Implementation design: we want to use the same list and vector ;; processing algorithm for all versions of prin1 and princ, since how ;; the processing is done depends on print-length, print-level, and ;; print-circle. For circle printing, a preprocessing step is ;; required before the final printing. Thanks to Jamie Zawinski ;; for motivation and algorithms. ;;; Code: ;;========================================================= ;; If using cl-packages: '(defpackage "cust-print" (:nicknames "CP" "custom-print") (:use "el") (:export print-level print-circle custom-print-install custom-print-uninstall custom-print-installed-p with-custom-print custom-prin1 custom-princ custom-prin1-to-string custom-print custom-format custom-message custom-error custom-printers add-custom-printer )) '(in-package cust-print) (require 'backquote) ;; Emacs 18 doesnt have defalias. ;; Provide def for byte compiler. (eval-and-compile (or (fboundp 'defalias) (fset 'defalias 'fset))) ;; Variables: ;;========================================================= ;;(defvar print-length nil ;; "*Controls how many elements of a list, at each level, are printed. ;;This is defined by emacs.") (defvar print-level nil "*Controls how many levels deep a nested data object will print. If nil, printing proceeds recursively and may lead to max-lisp-eval-depth being exceeded or an error may occur: `Apparently circular structure being printed.' Also see `print-length' and `print-circle'. If non-nil, components at levels equal to or greater than `print-level' are printed simply as `#'. The object to be printed is at level 0, and if the object is a list or vector, its top-level components are at level 1.") (defvar print-circle nil "*Controls the printing of recursive structures. If nil, printing proceeds recursively and may lead to `max-lisp-eval-depth' being exceeded or an error may occur: \"Apparently circular structure being printed.\" Also see `print-length' and `print-level'. If non-nil, shared substructures anywhere in the structure are printed with `#N=' before the first occurrence (in the order of the print representation) and `#N#' in place of each subsequent occurrence, where N is a positive decimal integer. There is no way to read this representation in standard Emacs, but if you need to do so, try the cl-read.el package.") (defvar custom-print-vectors nil "*Non-nil if printing of vectors should obey print-level and print-length. For Emacs 18, setting print-level, or adding custom print list or vector handling will make this happen anyway. Emacs 19 obeys print-level, but not for vectors.") ;; Custom printers ;;========================================================== (defconst custom-printers nil ;; e.g. '((symbolp . pkg::print-symbol)) "An alist for custom printing of any type. Pairs are of the form (PREDICATE . PRINTER). If PREDICATE is true for an object, then PRINTER is called with the object. PRINTER should print to `standard-output' using cust-print-original-princ if the standard printer is sufficient, or cust-print-prin for complex things. The PRINTER should return the object being printed. Don't modify this variable directly. Use `add-custom-printer' and `delete-custom-printer'") ;; Should cust-print-original-princ and cust-print-prin be exported symbols? ;; Or should the standard printers functions be replaced by ;; CP ones in Emacs Lisp so that CP internal functions need not be called? (defun add-custom-printer (pred printer) "Add a pair of PREDICATE and PRINTER to `custom-printers'. Any pair that has the same PREDICATE is first removed." (setq custom-printers (cons (cons pred printer) (delq (assq pred custom-printers) custom-printers))) ;; Rather than updating here, we could wait until cust-print-top-level is called. (cust-print-update-custom-printers)) (defun delete-custom-printer (pred) "Delete the custom printer associated with PREDICATE." (setq custom-printers (delq (assq pred custom-printers) custom-printers)) (cust-print-update-custom-printers)) (defun cust-print-use-custom-printer (object) ;; Default function returns nil. nil) (defun cust-print-update-custom-printers () ;; Modify the definition of cust-print-use-custom-printer (defalias 'cust-print-use-custom-printer ;; We dont really want to require the byte-compiler. ;; (byte-compile (` (lambda (object) (cond (,@ (mapcar (function (lambda (pair) (` (((, (car pair)) object) ((, (cdr pair)) object))))) custom-printers)) ;; Otherwise return nil. (t nil) ))) ;; ) )) ;; Saving and restoring emacs printing routines. ;;==================================================== (defun cust-print-set-function-cell (symbol-pair) (defalias (car symbol-pair) (symbol-function (car (cdr symbol-pair))))) (defun cust-print-original-princ (object &optional stream)) ; dummy def ;; Save emacs routines. (if (not (fboundp 'cust-print-original-prin1)) (mapcar 'cust-print-set-function-cell '((cust-print-original-prin1 prin1) (cust-print-original-princ princ) (cust-print-original-print print) (cust-print-original-prin1-to-string prin1-to-string) (cust-print-original-format format) (cust-print-original-message message) (cust-print-original-error error)))) (defun custom-print-install () "Replace print functions with general, customizable, Lisp versions. The emacs subroutines are saved away, and you can reinstall them by running `custom-print-uninstall'." (interactive) (mapcar 'cust-print-set-function-cell '((prin1 custom-prin1) (princ custom-princ) (print custom-print) (prin1-to-string custom-prin1-to-string) (format custom-format) (message custom-message) (error custom-error) )) t) (defun custom-print-uninstall () "Reset print functions to their emacs subroutines." (interactive) (mapcar 'cust-print-set-function-cell '((prin1 cust-print-original-prin1) (princ cust-print-original-princ) (print cust-print-original-print) (prin1-to-string cust-print-original-prin1-to-string) (format cust-print-original-format) (message cust-print-original-message) (error cust-print-original-error) )) t) (defalias 'custom-print-funcs-installed-p 'custom-print-installed-p) (defun custom-print-installed-p () "Return t if custom-print is currently installed, nil otherwise." (eq (symbol-function 'custom-prin1) (symbol-function 'prin1))) (put 'with-custom-print-funcs 'edebug-form-spec '(body)) (put 'with-custom-print 'edebug-form-spec '(body)) (defalias 'with-custom-print-funcs 'with-custom-print) (defmacro with-custom-print (&rest body) "Temporarily install the custom print package while executing BODY." (` (unwind-protect (progn (custom-print-install) (,@ body)) (custom-print-uninstall)))) ;; Lisp replacements for prin1 and princ, and for some subrs that use them ;;=============================================================== ;; - so far only the printing and formatting subrs. (defun custom-prin1 (object &optional stream) "Output the printed representation of OBJECT, any Lisp object. Quoting characters are printed when needed to make output that `read' can handle, whenever this is possible. Output stream is STREAM, or value of `standard-output' (which see). This is the custom-print replacement for the standard `prin1'. It uses the appropriate printer depending on the values of `print-level' and `print-circle' (which see)." (cust-print-top-level object stream 'cust-print-original-prin1)) (defun custom-princ (object &optional stream) "Output the printed representation of OBJECT, any Lisp object. No quoting characters are used; no delimiters are printed around the contents of strings. Output stream is STREAM, or value of `standard-output' (which see). This is the custom-print replacement for the standard `princ'." (cust-print-top-level object stream 'cust-print-original-princ)) (defun custom-prin1-to-string (object) "Return a string containing the printed representation of OBJECT, any Lisp object. Quoting characters are used when needed to make output that `read' can handle, whenever this is possible. This is the custom-print replacement for the standard `prin1-to-string'." (let ((buf (get-buffer-create " *custom-print-temp*"))) ;; We must erase the buffer before printing in case an error ;; occured during the last prin1-to-string and we are in debugger. (save-excursion (set-buffer buf) (erase-buffer)) ;; We must be in the current-buffer when the print occurs. (custom-prin1 object buf) (save-excursion (set-buffer buf) (buffer-string) ;; We could erase the buffer again, but why bother? ))) (defun custom-print (object &optional stream) "Output the printed representation of OBJECT, with newlines around it. Quoting characters are printed when needed to make output that `read' can handle, whenever this is possible. Output stream is STREAM, or value of `standard-output' (which see). This is the custom-print replacement for the standard `print'." (cust-print-original-princ "\n" stream) (custom-prin1 object stream) (cust-print-original-princ "\n" stream)) (defun custom-format (fmt &rest args) "Format a string out of a control-string and arguments. The first argument is a control string. It, and subsequent arguments substituted into it, become the value, which is a string. It may contain %s or %d or %c to substitute successive following arguments. %s means print an argument as a string, %d means print as number in decimal, %c means print a number as a single character. The argument used by %s must be a string or a symbol; the argument used by %d, %b, %o, %x or %c must be a number. This is the custom-print replacement for the standard `format'. It calls the emacs `format' after first making strings for list, vector, or symbol args. The format specification for such args should be `%s' in any case, so a string argument will also work. The string is generated with `custom-prin1-to-string', which quotes quotable characters." (apply 'cust-print-original-format fmt (mapcar (function (lambda (arg) (if (or (listp arg) (vectorp arg) (symbolp arg)) (custom-prin1-to-string arg) arg))) args))) (defun custom-message (fmt &rest args) "Print a one-line message at the bottom of the screen. The first argument is a control string. It may contain %s or %d or %c to print successive following arguments. %s means print an argument as a string, %d means print as number in decimal, %c means print a number as a single character. The argument used by %s must be a string or a symbol; the argument used by %d or %c must be a number. This is the custom-print replacement for the standard `message'. See `custom-format' for the details." ;; It doesn't work to princ the result of custom-format as in: ;; (cust-print-original-princ (apply 'custom-format fmt args)) ;; because the echo area requires special handling ;; to avoid duplicating the output. ;; cust-print-original-message does it right. (apply 'cust-print-original-message fmt (mapcar (function (lambda (arg) (if (or (listp arg) (vectorp arg) (symbolp arg)) (custom-prin1-to-string arg) arg))) args))) (defun custom-error (fmt &rest args) "Signal an error, making error message by passing all args to `format'. This is the custom-print replacement for the standard `error'. See `custom-format' for the details." (signal 'error (list (apply 'custom-format fmt args)))) ;; Support for custom prin1 and princ ;;========================================= ;; Defs to quiet byte-compiler. (defvar circle-table) (defvar cust-print-current-level) (defun cust-print-original-printer (object)) ; One of the standard printers. (defun cust-print-low-level-prin (object)) ; Used internally. (defun cust-print-prin (object)) ; Call this to print recursively. (defun cust-print-top-level (object stream emacs-printer) ;; Set up for printing. (let ((standard-output (or stream standard-output)) ;; circle-table will be non-nil if anything is circular. (circle-table (and print-circle (cust-print-preprocess-circle-tree object))) (cust-print-current-level (or print-level -1))) (defalias 'cust-print-original-printer emacs-printer) (defalias 'cust-print-low-level-prin (cond ((or custom-printers circle-table print-level ; comment out for version 19 ;; Emacs doesn't use print-level or print-length ;; for vectors, but custom-print can. (if custom-print-vectors (or print-level print-length))) 'cust-print-print-object) (t 'cust-print-original-printer))) (defalias 'cust-print-prin (if circle-table 'cust-print-print-circular 'cust-print-low-level-prin)) (cust-print-prin object) object)) (defun cust-print-print-object (object) ;; Test object type and print accordingly. ;; Could be called as either cust-print-low-level-prin or cust-print-prin. (cond ((null object) (cust-print-original-printer object)) ((cust-print-use-custom-printer object) object) ((consp object) (cust-print-list object)) ((vectorp object) (cust-print-vector object)) ;; All other types, just print. (t (cust-print-original-printer object)))) (defun cust-print-print-circular (object) ;; Printer for `prin1' and `princ' that handles circular structures. ;; If OBJECT appears multiply, and has not yet been printed, ;; prefix with label; if it has been printed, use `#N#' instead. ;; Otherwise, print normally. (let ((tag (assq object circle-table))) (if tag (let ((id (cdr tag))) (if (> id 0) (progn ;; Already printed, so just print id. (cust-print-original-princ "#") (cust-print-original-princ id) (cust-print-original-princ "#")) ;; Not printed yet, so label with id and print object. (setcdr tag (- id)) ; mark it as printed (cust-print-original-princ "#") (cust-print-original-princ (- id)) (cust-print-original-princ "=") (cust-print-low-level-prin object) )) ;; Not repeated in structure. (cust-print-low-level-prin object)))) ;;================================================ ;; List and vector processing for print functions. (defun cust-print-list (list) ;; Print a list using print-length, print-level, and print-circle. (if (= cust-print-current-level 0) (cust-print-original-princ "#") (let ((cust-print-current-level (1- cust-print-current-level))) (cust-print-original-princ "(") (let ((length (or print-length 0))) ;; Print the first element always (even if length = 0). (cust-print-prin (car list)) (setq list (cdr list)) (if list (cust-print-original-princ " ")) (setq length (1- length)) ;; Print the rest of the elements. (while (and list (/= 0 length)) (if (and (listp list) (not (assq list circle-table))) (progn (cust-print-prin (car list)) (setq list (cdr list))) ;; cdr is not a list, or it is in circle-table. (cust-print-original-princ ". ") (cust-print-prin list) (setq list nil)) (setq length (1- length)) (if list (cust-print-original-princ " "))) (if (and list (= length 0)) (cust-print-original-princ "...")) (cust-print-original-princ ")")))) list) (defun cust-print-vector (vector) ;; Print a vector according to print-length, print-level, and print-circle. (if (= cust-print-current-level 0) (cust-print-original-princ "#") (let ((cust-print-current-level (1- cust-print-current-level)) (i 0) (len (length vector))) (cust-print-original-princ "[") (if print-length (setq len (min print-length len))) ;; Print the elements (while (< i len) (cust-print-prin (aref vector i)) (setq i (1+ i)) (if (< i (length vector)) (cust-print-original-princ " "))) (if (< i (length vector)) (cust-print-original-princ "...")) (cust-print-original-princ "]") )) vector) ;; Circular structure preprocessing ;;================================== (defun cust-print-preprocess-circle-tree (object) ;; Fill up the table. (let (;; Table of tags for each object in an object to be printed. ;; A tag is of the form: ;; ( ) ;; The id-number is generated after the entire table has been computed. ;; During walk through, the real circle-table lives in the cdr so we ;; can use setcdr to add new elements instead of having to setq the ;; variable sometimes (poor man's locf). (circle-table (list nil))) (cust-print-walk-circle-tree object) ;; Reverse table so it is in the order that the objects will be printed. ;; This pass could be avoided if we always added to the end of the ;; table with setcdr in walk-circle-tree. (setcdr circle-table (nreverse (cdr circle-table))) ;; Walk through the table, assigning id-numbers to those ;; objects which will be printed using #N= syntax. Delete those ;; objects which will be printed only once (to speed up assq later). (let ((rest circle-table) (id -1)) (while (cdr rest) (let ((tag (car (cdr rest)))) (cond ((cdr tag) (setcdr tag id) (setq id (1- id)) (setq rest (cdr rest))) ;; Else delete this object. (t (setcdr rest (cdr (cdr rest)))))) )) ;; Drop the car. (cdr circle-table) )) (defun cust-print-walk-circle-tree (object) (let (read-equivalent-p tag) (while object (setq read-equivalent-p (or (numberp object) (and (symbolp object) ;; Check if it is uninterned. (eq object (intern-soft (symbol-name object))))) tag (and (not read-equivalent-p) (assq object (cdr circle-table)))) (cond (tag ;; Seen this object already, so note that. (setcdr tag t)) ((not read-equivalent-p) ;; Add a tag for this object. (setcdr circle-table (cons (list object) (cdr circle-table))))) (setq object (cond (tag ;; No need to descend since we have already. nil) ((consp object) ;; Walk the car of the list recursively. (cust-print-walk-circle-tree (car object)) ;; But walk the cdr with the above while loop ;; to avoid problems with max-lisp-eval-depth. ;; And it should be faster than recursion. (cdr object)) ((vectorp object) ;; Walk the vector. (let ((i (length object)) (j 0)) (while (< j i) (cust-print-walk-circle-tree (aref object j)) (setq j (1+ j)))))))))) ;; Example. ;;======================================= '(progn (progn ;; Create some circular structures. (setq circ-sym (let ((x (make-symbol "FOO"))) (list x x))) (setq circ-list (list 'a 'b (vector 1 2 3 4) 'd 'e 'f)) (setcar (nthcdr 3 circ-list) circ-list) (aset (nth 2 circ-list) 2 circ-list) (setq dotted-circ-list (list 'a 'b 'c)) (setcdr (cdr (cdr dotted-circ-list)) dotted-circ-list) (setq circ-vector (vector 1 2 3 4 (list 'a 'b 'c 'd) 6 7)) (aset circ-vector 5 (make-symbol "-gensym-")) (setcar (cdr (aref circ-vector 4)) (aref circ-vector 5)) nil) (install-custom-print) ;; (setq print-circle t) (let ((print-circle t)) (or (equal (prin1-to-string circ-list) "#1=(a b [1 2 #1# 4] #1# e f)") (error "circular object with array printing"))) (let ((print-circle t)) (or (equal (prin1-to-string dotted-circ-list) "#1=(a b c . #1#)") (error "circular object with array printing"))) (let* ((print-circle t) (x (list 'p 'q)) (y (list (list 'a 'b) x 'foo x))) (setcdr (cdr (cdr (cdr y))) (cdr y)) (or (equal (prin1-to-string y) "((a b) . #1=(#2=(p q) foo #2# . #1#))" ) (error "circular list example from CL manual"))) (let ((print-circle nil)) ;; cl-packages.el is required to print uninterned symbols like #:FOO. ;; (require 'cl-packages) (or (equal (prin1-to-string circ-sym) "(#:FOO #:FOO)") (error "uninterned symbols in list"))) (let ((print-circle t)) (or (equal (prin1-to-string circ-sym) "(#1=FOO #1#)") (error "circular uninterned symbols in list"))) (uninstall-custom-print) ) (provide 'cust-print) ;;; cust-print.el ends here emacs-19.30/lisp/custom.el100444 23053 1 242163 6046561237 14304 0ustar larsidaemon;;; custom.el --- User friendly customization support. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: help ;; Version: 0.5 ;;; Commentary: ;; ;; WARNING: This package is still under construction and not all of ;; the features below are implemented. ;; ;; This package provides a framework for adding user friendly ;; customization support to Emacs. Having to do customization by ;; editing a text file in some arcane syntax is user hostile in the ;; extreme, and to most users emacs lisp definitely count as arcane. ;; ;; The intension is that authors of emacs lisp packages declare the ;; variables intended for user customization with `custom-declare'. ;; Custom can then automatically generate a customization buffer with ;; `custom-buffer-create' where the user can edit the package ;; variables in a simple and intuitive way, as well as a menu with ;; `custom-menu-create' where he can set the more commonly used ;; variables interactively. ;; ;; It is also possible to use custom for modifying the properties of ;; other objects than the package itself, by specifying extra optional ;; arguments to `custom-buffer-create'. ;; ;; Custom is inspired by OPEN LOOK property windows. ;;; Todo: ;; ;; - Toggle documentation in three states `none', `one-line', `full'. ;; - Function to generate an XEmacs menu from a CUSTOM. ;; - Write TeXinfo documentation. ;; - Make it possible to hide sections by clicking at the level. ;; - Declare AUC TeX variables. ;; - Declare (ding) Gnus variables. ;; - Declare Emacs variables. ;; - Implement remaining types. ;; - XEmacs port. ;; - Allow `URL', `info', and internal hypertext buttons. ;; - Support meta-variables and goal directed customization. ;; - Make it easy to declare custom types independently. ;; - Make it possible to declare default value and type for a single ;; variable, storing the data in a symbol property. ;; - Syntactic sugar for CUSTOM declarations. ;; - Use W3 for variable documenation. ;;; Code: ;;; Compatibility: (or (fboundp 'buffer-substring-no-properties) ;; Introduced in Emacs 19.29. (defun buffer-substring-no-properties (beg end) "Return the text from BEG to END, without text properties, as a string." (let ((string (buffer-substring beg end))) (set-text-properties 0 (length string) nil string) string))) (or (fboundp 'add-to-list) ;; Introduced in Emacs 19.29. (defun add-to-list (list-var element) "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. If you want to use `add-to-list' on a variable that is not defined until a certain package is loaded, you should put the call to `add-to-list' into a hook function that will be run only after loading the package. `eval-after-load' provides one way to do this. In some cases other hooks, such as major mode hooks, can do the job." (or (member element (symbol-value list-var)) (set list-var (cons element (symbol-value list-var)))))) (or (fboundp 'plist-get) ;; Introduced in Emacs 19.29. (defun plist-get (plist prop) "Extract a value from a property list. PLIST is a property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value corresponding to the given PROP, or nil if PROP is not one of the properties on the list." (let (result) (while plist (if (eq (car plist) prop) (setq result (car (cdr plist)) plist nil) (set plist (cdr (cdr plist))))) result))) (or (fboundp 'plist-put) ;; Introduced in Emacs 19.29. (defun plist-put (plist prop val) "Change value in PLIST of PROP to VAL. PLIST is a property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object. If PROP is already a property on the list, its value is set to VAL, otherwise the new PROP VAL pair is added. The new plist is returned; use `(setq x (plist-put x prop val))' to be sure to use the new value. The PLIST is modified by side effects." (if (null plist) (list prop val) (let ((current plist)) (while current (cond ((eq (car current) prop) (setcar (cdr current) val) (setq current nil)) ((null (cdr (cdr current))) (setcdr (cdr current) (list prop val)) (setq current nil)) (t (setq current (cdr (cdr current))))))) plist))) (or (fboundp 'match-string) ;; Introduced in Emacs 19.29. (defun match-string (num &optional string) "Return string of text matched by last search. NUM specifies which parenthesized expression in the last regexp. Value is nil if NUMth pair didn't match, or there were less than NUM pairs. Zero means the entire text matched by the whole regexp or whole string. STRING should be given if the last search was by `string-match' on STRING." (if (match-beginning num) (if string (substring string (match-beginning num) (match-end num)) (buffer-substring (match-beginning num) (match-end num)))))) (or (fboundp 'facep) ;; Introduced in Emacs 19.29. (defun facep (x) "Return t if X is a face name or an internal face vector." (and (or (and (fboundp 'internal-facep) (internal-facep x)) (and (symbolp x) (assq x (and (boundp 'global-face-data) global-face-data)))) t))) ;; XEmacs and Emacs 19.29 facep does different things. (if (fboundp 'find-face) (fset 'custom-facep 'find-face) (fset 'custom-facep 'facep)) (if (custom-facep 'underline) () ;; No underline face in XEmacs 19.12. (and (fboundp 'make-face) (funcall (intern "make-face") 'underline)) ;; Must avoid calling set-face-underline-p directly, because it ;; is a defsubst in emacs19, and will make the .elc files non ;; portable! (or (and (fboundp 'face-differs-from-default-p) (face-differs-from-default-p 'underline)) (and (fboundp 'set-face-underline-p) (funcall 'set-face-underline-p 'underline t)))) (or (fboundp 'set-text-properties) ;; Missing in XEmacs 19.12. (defun set-text-properties (start end props &optional buffer) (if (or (null buffer) (bufferp buffer)) (if props (while props (put-text-property start end (car props) (nth 1 props) buffer) (setq props (nthcdr 2 props))) (remove-text-properties start end ()))))) (or (fboundp 'event-closest-point) ;; Missing in Emacs 19.29. (defun event-point (event) "Return the character position of the given mouse-motion, button-press, or button-release event. If the event did not occur over a window, or did not occur over text, then this returns nil. Otherwise, it returns an index into the buffer visible in the event's window." (posn-point (event-start event)))) (eval-when-compile (defvar x-colors nil) (defvar custom-button-face nil) (defvar custom-field-uninitialized-face nil) (defvar custom-field-invalid-face nil) (defvar custom-field-modified-face nil) (defvar custom-field-face nil) (defvar custom-mouse-face nil) (defvar custom-field-active-face nil)) (or (and (fboundp 'modify-face) (not (featurep 'face-lock))) ;; Introduced in Emacs 19.29. Incompatible definition also introduced ;; by face-lock.el version 3.00 and above for Emacs 19.28 and below. ;; face-lock does not call modify-face, so we can safely redefine it. (defun modify-face (face foreground background stipple bold-p italic-p underline-p) "Change the display attributes for face FACE. FOREGROUND and BACKGROUND should be color strings or nil. STIPPLE should be a stipple pattern name or nil. BOLD-P, ITALIC-P, and UNDERLINE-P specify whether the face should be set bold, in italic, and underlined, respectively. (Yes if non-nil.) If called interactively, prompts for a face and face attributes." (interactive (let* ((completion-ignore-case t) (face (symbol-name (read-face-name "Modify face: "))) (colors (mapcar 'list x-colors)) (stipples (mapcar 'list (apply 'nconc (mapcar 'directory-files x-bitmap-file-path)))) (foreground (modify-face-read-string face (face-foreground (intern face)) "foreground" colors)) (background (modify-face-read-string face (face-background (intern face)) "background" colors)) (stipple (modify-face-read-string face (face-stipple (intern face)) "stipple" stipples)) (bold-p (y-or-n-p (concat "Set face " face " bold "))) (italic-p (y-or-n-p (concat "Set face " face " italic "))) (underline-p (y-or-n-p (concat "Set face " face " underline ")))) (message "Face %s: %s" face (mapconcat 'identity (delq nil (list (and foreground (concat (downcase foreground) " foreground")) (and background (concat (downcase background) " background")) (and stipple (concat (downcase stipple) " stipple")) (and bold-p "bold") (and italic-p "italic") (and underline-p "underline"))) ", ")) (list (intern face) foreground background stipple bold-p italic-p underline-p))) (condition-case nil (set-face-foreground face foreground) (error nil)) (condition-case nil (set-face-background face background) (error nil)) (condition-case nil (set-face-stipple face stipple) (error nil)) (if (string-match "XEmacs" emacs-version) (progn (funcall (if bold-p 'make-face-bold 'make-face-unbold) face) (funcall (if italic-p 'make-face-italic 'make-face-unitalic) face)) (funcall (if bold-p 'make-face-bold 'make-face-unbold) face nil t) (funcall (if italic-p 'make-face-italic 'make-face-unitalic) face nil t)) (set-face-underline-p face underline-p) (and (interactive-p) (redraw-display)))) ;; We can't easily check for a working intangible. (defconst intangible (if (and (boundp 'emacs-minor-version) (or (> emacs-major-version 19) (and (> emacs-major-version 18) (> emacs-minor-version 28)))) (setq intangible 'intangible) (setq intangible 'intangible-if-it-had-been-working)) "The symbol making text intangible") (defconst rear-nonsticky (if (string-match "XEmacs" emacs-version) 'end-open 'rear-nonsticky) "The symbol making text proeprties non-sticky in the rear end.") (defconst front-sticky (if (string-match "XEmacs" emacs-version) 'front-closed 'front-sticky) "The symbol making text properties sticky in the front.") (defconst mouse-face (if (string-match "XEmacs" emacs-version) 'highlight 'mouse-face) "Symbol used for highlighting text under mouse.") ;; Put it in the Help menu, if possible. (if (string-match "XEmacs" emacs-version) ;; XEmacs (disabled because it doesn't work) (and current-menubar (add-menu-item '("Help") "Customize..." 'customize nil)) ;; Emacs 19.28 and earlier (global-set-key [ menu-bar help customize ] '("Customize..." . customize)) ;; Emacs 19.29 and later (global-set-key [ menu-bar help-menu customize ] '("Customize..." . customize))) ;; XEmacs popup-menu stolen from w3.el. (defun custom-x-really-popup-menu (pos title menudesc) "My hacked up function to do a blocking popup menu..." (let ((echo-keystrokes 0) event menu) (while menudesc (setq menu (cons (vector (car (car menudesc)) (list (car (car menudesc))) t) menu) menudesc (cdr menudesc))) (setq menu (cons title menu)) (popup-menu menu) (catch 'popup-done (while t (setq event (next-command-event event)) (cond ((and (misc-user-event-p event) (stringp (car-safe (event-object event)))) (throw 'popup-done (event-object event))) ((and (misc-user-event-p event) (or (eq (event-object event) 'abort) (eq (event-object event) 'menu-no-selection-hook))) nil) ((not (popup-menu-up-p)) (throw 'popup-done nil)) ((button-release-event-p event);; don't beep twice nil) (t (beep) (message "please make a choice from the menu."))))))) ;;; Categories: ;; ;; XEmacs use inheritable extents for the same purpose as Emacs uses ;; the category text property. (if (string-match "XEmacs" emacs-version) (progn ;; XEmacs categories. (defun custom-category-create (name) (set name (make-extent nil nil)) "Create a text property category named NAME.") (defun custom-category-put (name property value) "In CATEGORY set PROPERTY to VALUE." (set-extent-property (symbol-value name) property value)) (defun custom-category-get (name property) "In CATEGORY get PROPERTY." (extent-property (symbol-value name) property)) (defun custom-category-set (from to category) "Make text between FROM and TWO have category CATEGORY." (let ((extent (make-extent from to))) (set-extent-parent extent (symbol-value category))))) ;; Emacs categories. (defun custom-category-create (name) "Create a text property category named NAME." (set name name)) (defun custom-category-put (name property value) "In CATEGORY set PROPERTY to VALUE." (put name property value)) (defun custom-category-get (name property) "In CATEGORY get PROPERTY." (get name property)) (defun custom-category-set (from to category) "Make text between FROM and TWO have category CATEGORY." (put-text-property from to 'category category))) ;;; External Data: ;; ;; The following functions and variables defines the interface for ;; connecting a CUSTOM with an external entity, by default an emacs ;; lisp variable. (defvar custom-external 'default-value "Function returning the external value of NAME.") (defvar custom-external-set 'set-default "Function setting the external value of NAME to VALUE.") (defun custom-external (name) "Get the external value associated with NAME." (funcall custom-external name)) (defun custom-external-set (name value) "Set the external value associated with NAME to VALUE." (funcall custom-external-set name value)) (defvar custom-name-fields nil "Alist of custom names and their associated editing field.") (make-variable-buffer-local 'custom-name-fields) (defun custom-name-enter (name field) "Associate NAME with FIELD." (if (null name) () (custom-assert 'field) (setq custom-name-fields (cons (cons name field) custom-name-fields)))) (defun custom-name-field (name) "The editing field associated with NAME." (cdr (assq name custom-name-fields))) (defun custom-name-value (name) "The value currently displayed for NAME in the customization buffer." (let* ((field (custom-name-field name)) (custom (custom-field-custom field))) (custom-field-parse field) (funcall (custom-property custom 'export) custom (car (custom-field-extract custom field))))) (defvar custom-save 'custom-save "Function that will save current customization buffer.") ;;; Custom Functions: ;; ;; The following functions are part of the public interface to the ;; CUSTOM datastructure. Each CUSTOM describes a group of variables, ;; a single variable, or a component of a structured variable. The ;; CUSTOM instances are part of two hiearachies, the first is the ;; `part-of' hierarchy in which each CUSTOM is a component of another ;; CUSTOM, except for the top level CUSTOM which is contained in ;; `custom-data'. The second hiearachy is a `is-a' type hierarchy ;; where each CUSTOM is a leaf in the hierarchy defined by the `type' ;; property and `custom-type-properties'. (defvar custom-file "~/.custom.el" "Name of file with customization information.") (defconst custom-data '((tag . "Emacs") (doc . "The extensible self-documenting text editor.") (type . group) (data "\n" ((header . nil) (compact . t) (type . group) (doc . "\ Press [Save] to save any changes permanently after you are done editing. You can load customization information from other files by editing the `File' field and pressing the [Load] button. When you press [Save] the customization information of all files you have loaded, plus any changes you might have made manually, will be stored in the file specified by the `File' field.") (data ((tag . "Load") (type . button) (query . custom-load)) ((tag . "Save") (type . button) (query . custom-save)) ((name . custom-file) (default . "~/.custom.el") (doc . "Name of file with customization information.\n") (tag . "File") (type . file)))))) "The global customization information. A custom association list.") (defun custom-declare (path custom) "Declare variables for customization. PATH is a list of tags leading to the place in the customization hierarchy the new entry should be added. CUSTOM is the entry to add." (custom-initialize custom) (let ((current (custom-travel-path custom-data path))) (or (member custom (custom-data current)) (nconc (custom-data current) (list custom))))) (put 'custom-declare 'lisp-indent-hook 1) (defconst custom-type-properties '((repeat (type . default) ;; See `custom-match'. (import . custom-repeat-import) (eval . custom-repeat-eval) (quote . custom-repeat-quote) (accept . custom-repeat-accept) (extract . custom-repeat-extract) (validate . custom-repeat-validate) (insert . custom-repeat-insert) (match . custom-repeat-match) (query . custom-repeat-query) (prefix . "") (del-tag . "[DEL]") (add-tag . "[INS]")) (pair (type . group) ;; A cons-cell. (accept . custom-pair-accept) (eval . custom-pair-eval) (import . custom-pair-import) (quote . custom-pair-quote) (valid . (lambda (c d) (consp d))) (extract . custom-pair-extract)) (list (type . group) ;; A lisp list. (quote . custom-list-quote) (valid . (lambda (c d) (listp d))) (extract . custom-list-extract)) (group (type . default) ;; See `custom-match'. (face-tag . nil) (eval . custom-group-eval) (import . custom-group-import) (initialize . custom-group-initialize) (apply . custom-group-apply) (reset . custom-group-reset) (factory-reset . custom-group-factory-reset) (extract . nil) (validate . custom-group-validate) (query . custom-toggle-hide) (accept . custom-group-accept) (insert . custom-group-insert) (find . custom-group-find)) (toggle (type . choice) ;; Booleans. (data ((type . const) (tag . "On ") (default . t)) ((type . const) (tag . "Off") (default . nil)))) (choice (type . default) ;; See `custom-match'. (query . custom-choice-query) (accept . custom-choice-accept) (extract . custom-choice-extract) (validate . custom-choice-validate) (insert . custom-choice-insert) (none (tag . "Unknown") (default . __uninitialized__) (type . const))) (const (type . default) ;; A `const' only matches a single lisp value. (extract . (lambda (c f) (list (custom-default c)))) (validate . (lambda (c f) nil)) (valid . custom-const-valid) (update . custom-const-update) (insert . custom-const-insert)) (face-doc (type . doc) ;; A variable containing a face. (doc . "\ You can customize the look of Emacs by deciding which faces should be used when. If you push one of the face buttons below, you will be given a choice between a number of standard faces. The name of the selected face is shown right after the face button, and it is displayed its own face so you can see how it looks. If you know of another standard face not listed and want to use it, you can select `Other' and write the name in the editing field. If none of the standard faces suits you, you can select `Customize' to create your own face. This will make six fields appear under the face button. The `Fg' and `Bg' fields are the foreground and background colors for the face, respectively. You should type the name of the color in the field. You can use any X11 color name. A list of X11 color names may be available in the file `/usr/lib/X11/rgb.txt' on your system. The special color name `default' means that the face will not change the color of the text. The `Stipple' field is weird, so just ignore it. The three remaining fields are toggles, which will make the text `bold', `italic', or `underline' respectively. For some fonts `bold' or `italic' will not make any visible change.")) (face (type . choice) (eval . custom-face-eval) (import . custom-face-import) (data ((tag . "None") (default . nil) (type . const)) ((tag . "Default") (default . default) (face . custom-const-face) (type . const)) ((tag . "Bold") (default . bold) (face . custom-const-face) (type . const)) ((tag . "Bold-italic") (default . bold-italic) (face . custom-const-face) (type . const)) ((tag . "Italic") (default . italic) (face . custom-const-face) (type . const)) ((tag . "Underline") (default . underline) (face . custom-const-face) (type . const)) ((tag . "Highlight") (default . highlight) (face . custom-const-face) (type . const)) ((tag . "Modeline") (default . modeline) (face . custom-const-face) (type . const)) ((tag . "Region") (default . region) (face . custom-const-face) (type . const)) ((tag . "Secondary Selection") (default . secondary-selection) (face . custom-const-face) (type . const)) ((tag . "Customized") (compact . t) (face-tag . custom-face-hack) (eval . custom-face-eval) (data ((hidden . t) (tag . "") (doc . "\ Select the properties you want this face to have.") (default . custom-face-lookup) (type . const)) "\n" ((tag . "Fg") (hidden . t) (default . "default") (width . 20) (type . string)) ((tag . "Bg") (default . "default") (width . 20) (type . string)) ((tag . "Stipple") (default . "default") (width . 20) (type . string)) "\n" ((tag . "Bold") (default . nil) (type . toggle)) " " ((tag . "Italic") (default . nil) (type . toggle)) " " ((tag . "Underline") (hidden . t) (default . nil) (type . toggle))) (default . (custom-face-lookup "default" "default" "default" nil nil nil)) (type . list)) ((prompt . "Other") (face . custom-field-value) (default . __uninitialized__) (type . symbol)))) (file (type . string) ;; A string containing a file or directory name. (directory . nil) (default-file . nil) (query . custom-file-query)) (sexp (type . default) ;; Any lisp expression. (width . 40) (default . (__uninitialized__ . "Uninitialized")) (read . custom-sexp-read) (write . custom-sexp-write)) (symbol (type . sexp) ;; A lisp symbol. (width . 40) (valid . (lambda (c d) (symbolp d)))) (integer (type . sexp) ;; A lisp integer. (width . 10) (valid . (lambda (c d) (integerp d)))) (string (type . default) ;; A lisp string. (width . 40) (valid . (lambda (c d) (stringp d))) (read . custom-string-read) (write . custom-string-write)) (button (type . default) ;; Push me. (accept . ignore) (extract . nil) (validate . ignore) (insert . custom-button-insert)) (doc (type . default) ;; A documentation only entry with no value. (header . nil) (reset . ignore) (extract . nil) (validate . ignore) (insert . custom-documentation-insert)) (default (width . 20) (valid . (lambda (c v) t)) (insert . custom-default-insert) (update . custom-default-update) (query . custom-default-query) (tag . nil) (prompt . nil) (doc . nil) (header . t) (padding . ? ) (quote . custom-default-quote) (eval . (lambda (c v) nil)) (export . custom-default-export) (import . (lambda (c v) (list v))) (synchronize . ignore) (initialize . custom-default-initialize) (extract . custom-default-extract) (validate . custom-default-validate) (apply . custom-default-apply) (reset . custom-default-reset) (factory-reset . custom-default-factory-reset) (accept . custom-default-accept) (match . custom-default-match) (name . nil) (compact . nil) (hidden . nil) (face . custom-default-face) (data . nil) (calculate . nil) (default . __uninitialized__))) "Alist of default properties for type symbols. The format is `((SYMBOL (PROPERTY . VALUE)... )... )'.") (defconst custom-local-type-properties nil "Local type properties. Entries in this list take precedence over `custom-type-properties'.") (make-variable-buffer-local 'custom-local-type-properties) (defconst custom-nil '__uninitialized__ "Special value representing an uninitialized field.") (defconst custom-invalid '__invalid__ "Special value representing an invalid field.") (defun custom-property (custom property) "Extract from CUSTOM property PROPERTY." (let ((entry (assq property custom))) (while (null entry) ;; Look in superclass. (let ((type (custom-type custom))) (setq custom (cdr (or (assq type custom-local-type-properties) (assq type custom-type-properties))) entry (assq property custom)) (custom-assert 'custom))) (cdr entry))) (defun custom-super (custom property) "Extract from CUSTOM property PROPERTY. Start with CUSTOM's superclass." (let ((entry nil)) (while (null entry) ;; Look in superclass. (let ((type (custom-type custom))) (setq custom (cdr (or (assq type custom-local-type-properties) (assq type custom-type-properties))) entry (assq property custom)) (custom-assert 'custom))) (cdr entry))) (defun custom-property-set (custom property value) "Set CUSTOM PROPERY to VALUE by side effect. CUSTOM must have at least one property already." (let ((entry (assq property custom))) (if entry (setcdr entry value) (setcdr custom (cons (cons property value) (cdr custom)))))) (defun custom-type (custom) "Extract `type' from CUSTOM." (cdr (assq 'type custom))) (defun custom-name (custom) "Extract `name' from CUSTOM." (custom-property custom 'name)) (defun custom-tag (custom) "Extract `tag' from CUSTOM." (custom-property custom 'tag)) (defun custom-face-tag (custom) "Extract `face-tag' from CUSTOM." (custom-property custom 'face-tag)) (defun custom-prompt (custom) "Extract `prompt' from CUSTOM. If none exist, default to `tag' or, failing that, `type'." (or (custom-property custom 'prompt) (custom-property custom 'tag) (capitalize (symbol-name (custom-type custom))))) (defun custom-default (custom) "Extract `default' from CUSTOM." (let ((value (custom-property custom 'calculate))) (if value (eval value) (custom-property custom 'default)))) (defun custom-data (custom) "Extract the `data' from CUSTOM." (custom-property custom 'data)) (defun custom-documentation (custom) "Extract `doc' from CUSTOM." (custom-property custom 'doc)) (defun custom-width (custom) "Extract `width' from CUSTOM." (custom-property custom 'width)) (defun custom-compact (custom) "Extract `compact' from CUSTOM." (custom-property custom 'compact)) (defun custom-padding (custom) "Extract `padding' from CUSTOM." (custom-property custom 'padding)) (defun custom-valid (custom value) "Non-nil if CUSTOM may validly be set to VALUE." (and (not (and (listp value) (eq custom-invalid (car value)))) (funcall (custom-property custom 'valid) custom value))) (defun custom-import (custom value) "Import CUSTOM VALUE from external variable. This function change VALUE into a form that makes it easier to edit internally. What the internal form is exactly depends on CUSTOM. The internal form is returned." (if (eq custom-nil value) (list custom-nil) (funcall (custom-property custom 'import) custom value))) (defun custom-eval (custom value) "Return non-nil if CUSTOM's VALUE needs to be evaluated." (funcall (custom-property custom 'eval) custom value)) (defun custom-quote (custom value) "Quote CUSTOM's VALUE if necessary." (funcall (custom-property custom 'quote) custom value)) (defun custom-write (custom value) "Convert CUSTOM VALUE to a string." (cond ((eq value custom-nil) "") ((and (listp value) (eq (car value) custom-invalid)) (cdr value)) (t (funcall (custom-property custom 'write) custom value)))) (defun custom-read (custom string) "Convert CUSTOM field content STRING into lisp." (condition-case nil (funcall (custom-property custom 'read) custom string) (error (cons custom-invalid string)))) (defun custom-match (custom values) "Match CUSTOM with a list of VALUES. Return a cons-cell where the car is the sublist of VALUES matching CUSTOM, and the cdr is the remaining VALUES. A CUSTOM is actually a regular expression over the alphabet of lisp types. Most CUSTOM types are just doing a literal match, e.g. the `symbol' type matches any lisp symbol. The exceptions are: group: which corresponds to a `(' and `)' group in a regular expression. choice: which corresponds to a group of `|' in a regular expression. repeat: which corresponds to a `*' in a regular expression. optional: which corresponds to a `?', and isn't implemented yet." (if (memq values (list custom-nil nil)) ;; Nothing matches the uninitialized or empty list. (cons custom-nil nil) (funcall (custom-property custom 'match) custom values))) (defun custom-initialize (custom) "Initialize `doc' and `default' attributes of CUSTOM." (funcall (custom-property custom 'initialize) custom)) (defun custom-find (custom tag) "Find child in CUSTOM with `tag' TAG." (funcall (custom-property custom 'find) custom tag)) (defun custom-travel-path (custom path) "Find decedent of CUSTOM by looking through PATH." (if (null path) custom (custom-travel-path (custom-find custom (car path)) (cdr path)))) (defun custom-field-extract (custom field) "Extract CUSTOM's value in FIELD." (if (stringp custom) nil (funcall (custom-property (custom-field-custom field) 'extract) custom field))) (defun custom-field-validate (custom field) "Validate CUSTOM's value in FIELD. Return nil if valid, otherwise return a cons-cell where the car is the position of the error, and the cdr is a text describing the error." (if (stringp custom) nil (funcall (custom-property custom 'validate) custom field))) ;;; Field Functions: ;; ;; This section defines the public functions for manipulating the ;; FIELD datatype. The FIELD instance hold information about a ;; specific editing field in the customization buffer. ;; ;; Each FIELD can be seen as an instanciation of a CUSTOM. (defvar custom-field-last nil) ;; Last field containing point. (make-variable-buffer-local 'custom-field-last) (defvar custom-modified-list nil) ;; List of modified fields. (make-variable-buffer-local 'custom-modified-list) (defun custom-field-create (custom value) "Create a field structure of type CUSTOM containing VALUE. A field structure is an array [ CUSTOM VALUE ORIGINAL START END ], where CUSTOM defines the type of the field, VALUE is the current value of the field, ORIGINAL is the original value when created, and START and END are markers to the start and end of the field." (vector custom value custom-nil nil nil)) (defun custom-field-custom (field) "Return the `custom' attribute of FIELD." (aref field 0)) (defun custom-field-value (field) "Return the `value' attribute of FIELD." (aref field 1)) (defun custom-field-original (field) "Return the `original' attribute of FIELD." (aref field 2)) (defun custom-field-start (field) "Return the `start' attribute of FIELD." (aref field 3)) (defun custom-field-end (field) "Return the `end' attribute of FIELD." (aref field 4)) (defun custom-field-value-set (field value) "Set the `value' attribute of FIELD to VALUE." (aset field 1 value)) (defun custom-field-original-set (field original) "Set the `original' attribute of FIELD to ORIGINAL." (aset field 2 original)) (defun custom-field-move (field start end) "Set the `start'and `end' attributes of FIELD to START and END." (set-marker (or (aref field 3) (aset field 3 (make-marker))) start) (set-marker (or (aref field 4) (aset field 4 (make-marker))) end)) (defun custom-field-query (field) "Query user for content of current field." (funcall (custom-property (custom-field-custom field) 'query) field)) (defun custom-field-accept (field value &optional original) "Store a new value into field FIELD, taking it from VALUE. If optional ORIGINAL is non-nil, concider VALUE for the original value." (let ((inhibit-point-motion-hooks t)) (funcall (custom-property (custom-field-custom field) 'accept) field value original))) (defun custom-field-face (field) "The face used for highlighting FIELD." (let ((custom (custom-field-custom field))) (if (stringp custom) nil (let ((face (funcall (custom-property custom 'face) field))) (if (custom-facep face) face nil))))) (defun custom-field-update (field) "Update the screen appearance of FIELD to correspond with the field's value." (let ((custom (custom-field-custom field))) (if (stringp custom) nil (funcall (custom-property custom 'update) field)))) ;;; Types: ;; ;; The following functions defines type specific actions. (defun custom-repeat-eval (custom value) "Non-nil if CUSTOM's VALUE needs to be evaluated." (if (eq value custom-nil) nil (let ((child (custom-data custom)) (found nil)) (mapcar (lambda (v) (if (custom-eval child v) (setq found t))) value)))) (defun custom-repeat-quote (custom value) "A list of CUSTOM's VALUEs quoted." (let ((child (custom-data custom))) (apply 'append (mapcar (lambda (v) (custom-quote child v)) value)))) (defun custom-repeat-import (custom value) "Modify CUSTOM's VALUE to match internal expectations." (let ((child (custom-data custom))) (apply 'append (mapcar (lambda (v) (custom-import child v)) value)))) (defun custom-repeat-accept (field value &optional original) "Store a new value into field FIELD, taking it from VALUE." (let ((values (copy-sequence (custom-field-value field))) (all (custom-field-value field)) (start (custom-field-start field)) current new) (if original (custom-field-original-set field value)) (while (consp value) (setq new (car value) value (cdr value)) (if values ;; Change existing field. (setq current (car values) values (cdr values)) ;; Insert new field if series has grown. (goto-char start) (setq current (custom-repeat-insert-entry field)) (setq all (custom-insert-before all nil current)) (custom-field-value-set field all)) (custom-field-accept current new original)) (while (consp values) ;; Delete old field if series has scrunk. (setq current (car values) values (cdr values)) (let ((pos (custom-field-start current)) data) (while (not data) (setq pos (previous-single-property-change pos 'custom-data)) (custom-assert 'pos) (setq data (get-text-property pos 'custom-data)) (or (and (arrayp data) (> (length data) 1) (eq current (aref data 1))) (setq data nil))) (custom-repeat-delete data))))) (defun custom-repeat-insert (custom level) "Insert field for CUSTOM at nesting LEVEL in customization buffer." (let* ((field (custom-field-create custom nil)) (add-tag (custom-property custom 'add-tag)) (start (make-marker)) (data (vector field nil start nil))) (custom-text-insert "\n") (let ((pos (point))) (custom-text-insert (custom-property custom 'prefix)) (custom-tag-insert add-tag 'custom-repeat-add data) (set-marker start pos)) (custom-field-move field start (point)) (custom-documentation-insert custom) field)) (defun custom-repeat-insert-entry (repeat) "Insert entry at point in the REPEAT field." (let* ((inhibit-point-motion-hooks t) (inhibit-read-only t) (before-change-functions nil) (after-change-functions nil) (custom (custom-field-custom repeat)) (add-tag (custom-property custom 'add-tag)) (del-tag (custom-property custom 'del-tag)) (start (make-marker)) (end (make-marker)) (data (vector repeat nil start end)) field) (insert-before-markers "\n") (backward-char 1) (set-marker start (point)) (custom-text-insert " ") (aset data 1 (setq field (custom-insert (custom-data custom) nil))) (custom-text-insert " ") (set-marker end (point)) (goto-char start) (custom-text-insert (custom-property custom 'prefix)) (custom-tag-insert add-tag 'custom-repeat-add data) (custom-text-insert " ") (custom-tag-insert del-tag 'custom-repeat-delete data) (forward-char 1) field)) (defun custom-repeat-add (data) "Add list entry." (let ((parent (aref data 0)) (field (aref data 1)) (at (aref data 2)) new) (goto-char at) (setq new (custom-repeat-insert-entry parent)) (custom-field-value-set parent (custom-insert-before (custom-field-value parent) field new)))) (defun custom-repeat-delete (data) "Delete list entry." (let ((inhibit-point-motion-hooks t) (inhibit-read-only t) (before-change-functions nil) (after-change-functions nil) (parent (aref data 0)) (field (aref data 1))) (delete-region (aref data 2) (1+ (aref data 3))) (custom-field-untouch (aref data 1)) (custom-field-value-set parent (delq field (custom-field-value parent))))) (defun custom-repeat-match (custom values) "Match CUSTOM with VALUES." (let* ((child (custom-data custom)) (match (custom-match child values)) matches) (while (not (eq (car match) custom-nil)) (setq matches (cons (car match) matches) values (cdr match) match (custom-match child values))) (cons (nreverse matches) values))) (defun custom-repeat-extract (custom field) "Extract list of childrens values." (let ((values (custom-field-value field)) (data (custom-data custom)) result) (if (eq values custom-nil) () (while values (setq result (append result (custom-field-extract data (car values))) values (cdr values)))) result)) (defun custom-repeat-validate (custom field) "Validate children." (let ((values (custom-field-value field)) (data (custom-data custom)) result) (if (eq values custom-nil) (setq result (cons (custom-field-start field) "Uninitialized list"))) (while (and values (not result)) (setq result (custom-field-validate data (car values)) values (cdr values))) result)) (defun custom-pair-accept (field value &optional original) "Store a new value into field FIELD, taking it from VALUE." (custom-group-accept field (list (car value) (cdr value)) original)) (defun custom-pair-eval (custom value) "Non-nil if CUSTOM's VALUE needs to be evaluated." (custom-group-eval custom (list (car value) (cdr value)))) (defun custom-pair-import (custom value) "Modify CUSTOM's VALUE to match internal expectations." (let ((result (car (custom-group-import custom (list (car value) (cdr value)))))) (custom-assert '(eq (length result) 2)) (list (cons (nth 0 result) (nth 1 result))))) (defun custom-pair-quote (custom value) "Quote CUSTOM's VALUE if necessary." (if (custom-eval custom value) (let ((v (car (custom-group-quote custom (list (car value) (cdr value)))))) (list (list 'cons (nth 0 v) (nth 1 v)))) (custom-default-quote custom value))) (defun custom-pair-extract (custom field) "Extract cons of childrens values." (let ((values (custom-field-value field)) (data (custom-data custom)) result) (custom-assert '(eq (length values) (length data))) (while values (setq result (append result (custom-field-extract (car data) (car values))) data (cdr data) values (cdr values))) (custom-assert '(null data)) (list (cons (nth 0 result) (nth 1 result))))) (defun custom-list-quote (custom value) "Quote CUSTOM's VALUE if necessary." (if (custom-eval custom value) (let ((v (car (custom-group-quote custom value)))) (list (cons 'list v))) (custom-default-quote custom value))) (defun custom-list-extract (custom field) "Extract list of childrens values." (let ((values (custom-field-value field)) (data (custom-data custom)) result) (custom-assert '(eq (length values) (length data))) (while values (setq result (append result (custom-field-extract (car data) (car values))) data (cdr data) values (cdr values))) (custom-assert '(null data)) (list result))) (defun custom-group-validate (custom field) "Validate children." (let ((values (custom-field-value field)) (data (custom-data custom)) result) (if (eq values custom-nil) (setq result (cons (custom-field-start field) "Uninitialized list")) (custom-assert '(eq (length values) (length data)))) (while (and values (not result)) (setq result (custom-field-validate (car data) (car values)) data (cdr data) values (cdr values))) result)) (defun custom-group-eval (custom value) "Non-nil if CUSTOM's VALUE needs to be evaluated." (let ((found nil)) (mapcar (lambda (c) (or (stringp c) (let ((match (custom-match c value))) (if (custom-eval c (car match)) (setq found t)) (setq value (cdr match))))) (custom-data custom)) found)) (defun custom-group-quote (custom value) "A list of CUSTOM's VALUE members, quoted." (list (apply 'append (mapcar (lambda (c) (if (stringp c) () (let ((match (custom-match c value))) (prog1 (custom-quote c (car match)) (setq value (cdr match)))))) (custom-data custom))))) (defun custom-group-import (custom value) "Modify CUSTOM's VALUE to match internal expectations." (list (apply 'append (mapcar (lambda (c) (if (stringp c) () (let ((match (custom-match c value))) (prog1 (custom-import c (car match)) (setq value (cdr match)))))) (custom-data custom))))) (defun custom-group-initialize (custom) "Initialize `doc' and `default' entries in CUSTOM." (if (custom-name custom) (custom-default-initialize custom) (mapcar 'custom-initialize (custom-data custom)))) (defun custom-group-apply (field) "Reset `value' in FIELD to `original'." (let ((custom (custom-field-custom field)) (values (custom-field-value field))) (if (custom-name custom) (custom-default-apply field) (mapcar 'custom-field-apply values)))) (defun custom-group-reset (field) "Reset `value' in FIELD to `original'." (let ((custom (custom-field-custom field)) (values (custom-field-value field))) (if (custom-name custom) (custom-default-reset field) (mapcar 'custom-field-reset values)))) (defun custom-group-factory-reset (field) "Reset `value' in FIELD to `default'." (let ((custom (custom-field-custom field)) (values (custom-field-value field))) (if (custom-name custom) (custom-default-factory-reset field) (mapcar 'custom-field-factory-reset values)))) (defun custom-group-find (custom tag) "Find child in CUSTOM with `tag' TAG." (let ((data (custom-data custom)) (result nil)) (while (not result) (custom-assert 'data) (if (equal (custom-tag (car data)) tag) (setq result (car data)) (setq data (cdr data)))))) (defun custom-group-accept (field value &optional original) "Store a new value into field FIELD, taking it from VALUE." (let* ((values (custom-field-value field)) (custom (custom-field-custom field)) (from (custom-field-start field)) (face-tag (custom-face-tag custom)) current) (if face-tag (put-text-property from (+ from (length (custom-tag custom))) 'face (funcall face-tag field value))) (if original (custom-field-original-set field value)) (while values (setq current (car values) values (cdr values)) (if current (let* ((custom (custom-field-custom current)) (match (custom-match custom value))) (setq value (cdr match)) (custom-field-accept current (car match) original)))))) (defun custom-group-insert (custom level) "Insert field for CUSTOM at nesting LEVEL in customization buffer." (let* ((field (custom-field-create custom nil)) fields hidden (from (point)) (compact (custom-compact custom)) (tag (custom-tag custom)) (face-tag (custom-face-tag custom))) (cond (face-tag (custom-text-insert tag)) (tag (custom-tag-insert tag field))) (or compact (custom-documentation-insert custom)) (or compact (custom-text-insert "\n")) (let ((data (custom-data custom))) (while data (setq fields (cons (custom-insert (car data) (if level (1+ level))) fields)) (setq hidden (or (stringp (car data)) (custom-property (car data) 'hidden))) (setq data (cdr data)) (if data (custom-text-insert (cond (hidden "") (compact " ") (t "\n")))))) (if compact (custom-documentation-insert custom)) (custom-field-value-set field (nreverse fields)) (custom-field-move field from (point)) field)) (defun custom-choice-insert (custom level) "Insert field for CUSTOM at nesting LEVEL in customization buffer." (let* ((field (custom-field-create custom nil)) (from (point))) (custom-text-insert "lars er en nisse") (custom-field-move field from (point)) (custom-documentation-insert custom) (custom-field-reset field) field)) (defun custom-choice-accept (field value &optional original) "Store a new value into field FIELD, taking it from VALUE." (let ((custom (custom-field-custom field)) (start (custom-field-start field)) (end (custom-field-end field)) (inhibit-read-only t) (before-change-functions nil) (after-change-functions nil) from) (cond (original (setq custom-modified-list (delq field custom-modified-list)) (custom-field-original-set field value)) ((equal value (custom-field-original field)) (setq custom-modified-list (delq field custom-modified-list))) (t (add-to-list 'custom-modified-list field))) (custom-field-untouch (custom-field-value field)) (delete-region start end) (goto-char start) (setq from (point)) (insert-before-markers " ") (backward-char 1) (custom-category-set (point) (1+ (point)) 'custom-hidden-properties) (custom-tag-insert (custom-tag custom) field) (custom-text-insert ": ") (let ((data (custom-data custom)) found begin) (while (and data (not found)) (if (not (custom-valid (car data) value)) (setq data (cdr data)) (setq found (custom-insert (car data) nil)) (setq data nil))) (if found () (setq begin (point) found (custom-insert (custom-property custom 'none) nil)) (add-text-properties begin (point) (list rear-nonsticky t 'face custom-field-uninitialized-face))) (or original (custom-field-original-set found (custom-field-original field))) (custom-field-accept found value original) (custom-field-value-set field found) (custom-field-move field from end)))) (defun custom-choice-extract (custom field) "Extract childs value." (let ((value (custom-field-value field))) (custom-field-extract (custom-field-custom value) value))) (defun custom-choice-validate (custom field) "Validate childs value." (let ((value (custom-field-value field)) (custom (custom-field-custom field))) (if (or (eq value custom-nil) (eq (custom-field-custom value) (custom-property custom 'none))) (cons (custom-field-start field) "Make a choice") (custom-field-validate (custom-field-custom value) value)))) (defun custom-choice-query (field) "Choose a child." (let* ((custom (custom-field-custom field)) (old (custom-field-custom (custom-field-value field))) (default (custom-prompt old)) (tag (custom-prompt custom)) (data (custom-data custom)) current alist) (if (eq (length data) 2) (custom-field-accept field (custom-default (if (eq (nth 0 data) old) (nth 1 data) (nth 0 data)))) (while data (setq current (car data) data (cdr data)) (setq alist (cons (cons (custom-prompt current) current) alist))) (let ((answer (cond ((and (fboundp 'button-press-event-p) (fboundp 'popup-menu) (button-press-event-p last-input-event)) (cdr (assoc (car (custom-x-really-popup-menu last-input-event tag (reverse alist))) alist))) ((listp last-input-event) (x-popup-menu last-input-event (list tag (cons "" (reverse alist))))) (t (let ((choice (completing-read (concat tag " (default " default "): ") alist nil t))) (if (or (null choice) (string-equal choice "")) (setq choice default)) (cdr (assoc choice alist))))))) (if answer (custom-field-accept field (custom-default answer))))))) (defun custom-file-query (field) "Prompt for a file name" (let* ((value (custom-field-value field)) (custom (custom-field-custom field)) (valid (custom-valid custom value)) (directory (custom-property custom 'directory)) (default (and (not valid) (custom-property custom 'default-file))) (tag (custom-tag custom)) (prompt (if default (concat tag " (" default "): ") (concat tag ": ")))) (custom-field-accept field (if (custom-valid custom value) (read-file-name prompt (if (file-name-absolute-p value) "" directory) default nil value) (read-file-name prompt directory default))))) (defun custom-face-eval (custom value) "Return non-nil if CUSTOM's VALUE needs to be evaluated." (not (symbolp value))) (defun custom-face-import (custom value) "Modify CUSTOM's VALUE to match internal expectations." (let ((name (symbol-name value))) (list (if (string-match "\ custom-face-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)" name) (list 'custom-face-lookup (match-string 1 name) (match-string 2 name) (match-string 3 name) (intern (match-string 4 name)) (intern (match-string 5 name)) (intern (match-string 6 name))) value)))) (defun custom-face-lookup (fg bg stipple bold italic underline) "Lookup or create a face with specified attributes. FG BG STIPPLE BOLD ITALIC UNDERLINE" (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S" (or fg "default") (or bg "default") (or stipple "default") bold italic underline)))) (if (and (custom-facep name) (fboundp 'make-face)) () (make-face name) (modify-face name (if (string-equal fg "default") nil fg) (if (string-equal bg "default") nil bg) (if (string-equal stipple "default") nil stipple) bold italic underline)) name)) (defun custom-face-hack (field value) "Face that should be used for highlighting FIELD containing VALUE." (let* ((custom (custom-field-custom field)) (face (eval (funcall (custom-property custom 'export) custom value)))) (if (custom-facep face) face nil))) (defun custom-const-insert (custom level) "Insert field for CUSTOM at nesting LEVEL in customization buffer." (let* ((field (custom-field-create custom custom-nil)) (face (custom-field-face field)) (from (point))) (custom-text-insert (custom-tag custom)) (add-text-properties from (point) (list 'face face rear-nonsticky t)) (custom-documentation-insert custom) (custom-field-move field from (point)) field)) (defun custom-const-update (field) "Update face of FIELD." (let ((from (custom-field-start field)) (custom (custom-field-custom field))) (put-text-property from (+ from (length (custom-tag custom))) 'face (custom-field-face field)))) (defun custom-const-valid (custom value) "Non-nil if CUSTOM can validly have the value VALUE." (equal (custom-default custom) value)) (defun custom-const-face (field) "Face used for a FIELD." (custom-default (custom-field-custom field))) (defun custom-sexp-read (custom string) "Read from CUSTOM an STRING." (save-match-data (save-excursion (set-buffer (get-buffer-create " *Custom Scratch*")) (erase-buffer) (insert string) (goto-char (point-min)) (prog1 (read (current-buffer)) (or (looking-at (concat (regexp-quote (char-to-string (custom-padding custom))) "*\\'")) (error "Junk at end of expression")))))) (autoload 'pp-to-string "pp") (defun custom-sexp-write (custom sexp) "Write CUSTOM SEXP as string." (let ((string (prin1-to-string sexp))) (if (<= (length string) (custom-width custom)) string (setq string (pp-to-string sexp)) (string-match "[ \t\n]*\\'" string) (concat "\n" (substring string 0 (match-beginning 0)))))) (defun custom-string-read (custom string) "Read string by ignoring trailing padding characters." (let ((last (length string)) (padding (custom-padding custom))) (while (and (> last 0) (eq (aref string (1- last)) padding)) (setq last (1- last))) (substring string 0 last))) (defun custom-string-write (custom string) "Write raw string." string) (defun custom-button-insert (custom level) "Insert field for CUSTOM at nesting LEVEL in customization buffer." (custom-tag-insert (concat "[" (custom-tag custom) "]") (custom-property custom 'query)) (custom-documentation-insert custom) nil) (defun custom-default-export (custom value) ;; Convert CUSTOM's VALUE to external representation. ;; See `custom-import'. (if (custom-eval custom value) (eval (car (custom-quote custom value))) value)) (defun custom-default-quote (custom value) "Quote CUSTOM's VALUE if necessary." (list (if (and (not (custom-eval custom value)) (or (and (symbolp value) value (not (eq t value))) (and (listp value) value (not (memq (car value) '(quote function lambda)))))) (list 'quote value) value))) (defun custom-default-initialize (custom) "Initialize `doc' and `default' entries in CUSTOM." (let ((name (custom-name custom))) (if (null name) () (let ((default (custom-default custom)) (doc (custom-documentation custom)) (vdoc (documentation-property name 'variable-documentation t))) (if doc (or vdoc (put name 'variable-documentation doc)) (if vdoc (custom-property-set custom 'doc vdoc))) (if (eq default custom-nil) (if (boundp name) (custom-property-set custom 'default (symbol-value name))) (or (boundp name) (set name default))))))) (defun custom-default-insert (custom level) "Insert field for CUSTOM at nesting LEVEL in customization buffer." (let ((field (custom-field-create custom custom-nil)) (tag (custom-tag custom))) (if (null tag) () (custom-tag-insert tag field) (custom-text-insert ": ")) (custom-field-insert field) (custom-documentation-insert custom) field)) (defun custom-default-accept (field value &optional original) "Store a new value into field FIELD, taking it from VALUE." (if original (custom-field-original-set field value)) (custom-field-value-set field value) (custom-field-update field)) (defun custom-default-apply (field) "Apply any changes in FIELD since the last apply." (let* ((custom (custom-field-custom field)) (name (custom-name custom))) (if (null name) (error "This field cannot be applied alone")) (custom-external-set name (custom-name-value name)) (custom-field-reset field))) (defun custom-default-reset (field) "Reset content of editing FIELD to `original'." (custom-field-accept field (custom-field-original field) t)) (defun custom-default-factory-reset (field) "Reset content of editing FIELD to `default'." (let* ((custom (custom-field-custom field)) (default (car (custom-import custom (custom-default custom))))) (or (eq default custom-nil) (custom-field-accept field default nil)))) (defun custom-default-query (field) "Prompt for a FIELD" (let* ((custom (custom-field-custom field)) (value (custom-field-value field)) (initial (custom-write custom value)) (prompt (concat (custom-prompt custom) ": "))) (custom-field-accept field (custom-read custom (if (custom-valid custom value) (read-string prompt (cons initial 1)) (read-string prompt)))))) (defun custom-default-match (custom values) "Match CUSTOM with VALUES." values) (defun custom-default-extract (custom field) "Extract CUSTOM's content in FIELD." (list (custom-field-value field))) (defun custom-default-validate (custom field) "Validate FIELD." (let ((value (custom-field-value field)) (start (custom-field-start field))) (cond ((eq value custom-nil) (cons start "Uninitialized field")) ((and (consp value) (eq (car value) custom-invalid)) (cons start "Unparseable field content")) ((custom-valid custom value) nil) (t (cons start "Wrong type of field content"))))) (defun custom-default-face (field) "Face used for a FIELD." (let ((value (custom-field-value field))) (cond ((eq value custom-nil) custom-field-uninitialized-face) ((not (custom-valid (custom-field-custom field) value)) custom-field-invalid-face) ((not (equal (custom-field-original field) value)) custom-field-modified-face) (t custom-field-face)))) (defun custom-default-update (field) "Update the content of FIELD." (let ((inhibit-point-motion-hooks t) (before-change-functions nil) (after-change-functions nil) (start (custom-field-start field)) (end (custom-field-end field)) (pos (point))) ;; Keep track of how many modified fields we have. (cond ((equal (custom-field-value field) (custom-field-original field)) (setq custom-modified-list (delq field custom-modified-list))) ((memq field custom-modified-list)) (t (setq custom-modified-list (cons field custom-modified-list)))) ;; Update the field. (goto-char end) (insert-before-markers " ") (delete-region start (1- end)) (goto-char start) (custom-field-insert field) (goto-char end) (delete-char 1) (goto-char pos) (and (<= start pos) (<= pos end) (custom-field-enter field)))) ;;; Create Buffer: ;; ;; Public functions to create a customization buffer and to insert ;; various forms of text, fields, and buttons in it. (defun customize () "Customize GNU Emacs. Create a *Customize* buffer with editable customization information about GNU Emacs." (interactive) (custom-buffer-create "*Customize*") (custom-reset-all)) (defun custom-buffer-create (name &optional custom types set get save) "Create a customization buffer named NAME. If the optional argument CUSTOM is non-nil, use that as the custom declaration. If the optional argument TYPES is non-nil, use that as the local types. If the optional argument SET is non-nil, use that to set external data. If the optional argument GET is non-nil, use that to get external data. If the optional argument SAVE is non-nil, use that for saving changes." (switch-to-buffer name) (buffer-disable-undo (current-buffer)) (custom-mode) (setq custom-local-type-properties types) (if (null custom) () (make-local-variable 'custom-data) (setq custom-data custom)) (if (null set) () (make-local-variable 'custom-external-set) (setq custom-external-set set)) (if (null get) () (make-local-variable 'custom-external) (setq custom-external get)) (if (null save) () (make-local-variable 'custom-save) (setq custom-save save)) (let ((inhibit-point-motion-hooks t) (before-change-functions nil) (after-change-functions nil)) (erase-buffer) (insert "\n") (goto-char (point-min)) (custom-text-insert "This is a customization buffer.\n") (custom-help-insert "\n") (custom-help-button 'custom-forward-field) (custom-help-button 'custom-backward-field) (custom-help-button 'custom-enter-value) (custom-help-button 'custom-field-factory-reset) (custom-help-button 'custom-field-reset) (custom-help-button 'custom-field-apply) (custom-help-button 'custom-save-and-exit) (custom-help-button 'custom-toggle-documentation) (custom-help-insert "\nClick mouse-2 on any button to activate it.\n") (custom-text-insert "\n") (custom-insert custom-data 0) (goto-char (point-min)))) (defun custom-insert (custom level) "Insert custom declaration CUSTOM in current buffer at level LEVEL." (if (stringp custom) (progn (custom-text-insert custom) nil) (and level (null (custom-property custom 'header)) (setq level nil)) (and level (> level 0) (custom-text-insert (concat "\n" (make-string level ?*) " "))) (let ((field (funcall (custom-property custom 'insert) custom level))) (custom-name-enter (custom-name custom) field) field))) (defun custom-text-insert (text) "Insert TEXT in current buffer." (insert text)) (defun custom-tag-insert (tag field &optional data) "Insert TAG for FIELD in current buffer." (let ((from (point))) (insert tag) (custom-category-set from (point) 'custom-button-properties) (put-text-property from (point) 'custom-tag field) (if data (add-text-properties from (point) (list 'custom-data data))))) (defun custom-documentation-insert (custom &rest ignore) "Insert documentation from CUSTOM in current buffer." (let ((doc (custom-documentation custom))) (if (null doc) () (custom-help-insert "\n" doc)))) (defun custom-help-insert (&rest args) "Insert ARGS as documentation text." (let ((from (point))) (apply 'insert args) (custom-category-set from (point) 'custom-documentation-properties))) (defun custom-help-button (command) "Describe how to execute COMMAND." (let ((from (point))) (insert "`" (key-description (where-is-internal command nil t)) "'") (set-text-properties from (point) (list 'face custom-button-face mouse-face custom-mouse-face 'custom-jump t ;Make TAB jump over it. 'custom-tag command)) (custom-category-set from (point) 'custom-documentation-properties)) (custom-help-insert ": " (custom-first-line (documentation command)) "\n")) ;;; Mode: ;; ;; The Customization major mode and interactive commands. (defvar custom-mode-map nil "Keymap for Custum Mode.") (if custom-mode-map nil (setq custom-mode-map (make-sparse-keymap)) (define-key custom-mode-map (if (string-match "XEmacs" emacs-version) [button2] [mouse-2]) 'custom-push-button) (define-key custom-mode-map "\t" 'custom-forward-field) (define-key custom-mode-map "\M-\t" 'custom-backward-field) (define-key custom-mode-map "\r" 'custom-enter-value) (define-key custom-mode-map "\C-k" 'custom-kill-line) (define-key custom-mode-map "\C-c\C-r" 'custom-field-reset) (define-key custom-mode-map "\C-c\M-\C-r" 'custom-reset-all) (define-key custom-mode-map "\C-c\C-z" 'custom-field-factory-reset) (define-key custom-mode-map "\C-c\M-\C-z" 'custom-factory-reset-all) (define-key custom-mode-map "\C-c\C-a" 'custom-field-apply) (define-key custom-mode-map "\C-c\M-\C-a" 'custom-apply-all) (define-key custom-mode-map "\C-c\C-c" 'custom-save-and-exit) (define-key custom-mode-map "\C-c\C-d" 'custom-toggle-documentation)) ;; C-c keymap ideas: C-a field-beginning, C-e field-end, C-f ;; forward-field, C-b backward-field, C-n next-field, C-p ;; previous-field, ? describe-field. (defun custom-mode () "Major mode for doing customizations. \\{custom-mode-map}" (kill-all-local-variables) (setq major-mode 'custom-mode mode-name "Custom") (use-local-map custom-mode-map) (make-local-variable 'before-change-functions) (setq before-change-functions '(custom-before-change)) (make-local-variable 'after-change-functions) (setq after-change-functions '(custom-after-change)) (if (not (fboundp 'make-local-hook)) ;; Emacs 19.28 and earlier. (add-hook 'post-command-hook (lambda () (if (eq major-mode 'custom-mode) (custom-post-command)))) ;; Emacs 19.29. (make-local-hook 'post-command-hook) (add-hook 'post-command-hook 'custom-post-command nil t))) (defun custom-forward-field (arg) "Move point to the next field or button. With optional ARG, move across that many fields." (interactive "p") (while (> arg 0) (let ((next (if (get-text-property (point) 'custom-tag) (next-single-property-change (point) 'custom-tag) (point)))) (setq next (or (next-single-property-change next 'custom-tag) (next-single-property-change (point-min) 'custom-tag))) (if next (goto-char next) (error "No customization fields in this buffer."))) (or (get-text-property (point) 'custom-jump) (setq arg (1- arg)))) (while (< arg 0) (let ((previous (if (get-text-property (1- (point)) 'custom-tag) (previous-single-property-change (point) 'custom-tag) (point)))) (setq previous (or (previous-single-property-change previous 'custom-tag) (previous-single-property-change (point-max) 'custom-tag))) (if previous (goto-char previous) (error "No customization fields in this buffer."))) (or (get-text-property (1- (point)) 'custom-jump) (setq arg (1+ arg))))) (defun custom-backward-field (arg) "Move point to the previous field or button. With optional ARG, move across that many fields." (interactive "p") (custom-forward-field (- arg))) (defun custom-toggle-documentation (&optional arg) "Toggle display of documentation text. If the optional argument is non-nil, show text iff the argument is positive." (interactive "P") (let ((hide (or (and (null arg) (null (custom-category-get 'custom-documentation-properties 'invisible))) (<= (prefix-numeric-value arg) 0)))) (custom-category-put 'custom-documentation-properties 'invisible hide) (custom-category-put 'custom-documentation-properties intangible hide)) (redraw-display)) (defun custom-enter-value (field data) "Enter value for current customization field or push button." (interactive (list (get-text-property (point) 'custom-tag) (get-text-property (point) 'custom-data))) (cond (data (funcall field data)) ((eq field 'custom-enter-value) (error "Don't be silly")) ((and (symbolp field) (fboundp field)) (call-interactively field)) (field (custom-field-query field)) (t (message "Nothing to enter here")))) (defun custom-kill-line () "Kill to end of field or end of line, whichever is first." (interactive) (let ((field (get-text-property (point) 'custom-field)) (newline (save-excursion (search-forward "\n"))) (next (next-single-property-change (point) 'custom-field))) (if (and field (> newline next)) (kill-region (point) next) (call-interactively 'kill-line)))) (defun custom-push-button (event) "Activate button below mouse pointer." (interactive "@e") (let* ((pos (event-point event)) (field (get-text-property pos 'custom-field)) (tag (get-text-property pos 'custom-tag)) (data (get-text-property pos 'custom-data))) (cond (data (funcall tag data)) ((and (symbolp tag) (fboundp tag)) (call-interactively tag)) (field (call-interactively (lookup-key global-map (this-command-keys)))) (tag (custom-enter-value tag data)) (t (error "Nothing to click on here."))))) (defun custom-reset-all () "Undo any changes since the last apply in all fields." (interactive (and custom-modified-list (not (y-or-n-p "Discard all changes? ")) (error "Reset aborted"))) (let ((all custom-name-fields) current field) (while all (setq current (car all) field (cdr current) all (cdr all)) (custom-field-reset field)))) (defun custom-field-reset (field) "Undo any changes in FIELD since the last apply." (interactive (list (or (get-text-property (point) 'custom-field) (get-text-property (point) 'custom-tag)))) (if (arrayp field) (let* ((custom (custom-field-custom field)) (name (custom-name custom))) (save-excursion (if name (custom-field-original-set field (car (custom-import custom (custom-external name))))) (if (not (custom-valid custom (custom-field-original field))) (error "This field cannot be reset alone") (funcall (custom-property custom 'reset) field) (funcall (custom-property custom 'synchronize) field)))))) (defun custom-factory-reset-all () "Reset all field to their default values." (interactive (and custom-modified-list (not (y-or-n-p "Discard all changes? ")) (error "Reset aborted"))) (let ((all custom-name-fields) field) (while all (setq field (cdr (car all)) all (cdr all)) (custom-field-factory-reset field)))) (defun custom-field-factory-reset (field) "Reset FIELD to its default value." (interactive (list (or (get-text-property (point) 'custom-field) (get-text-property (point) 'custom-tag)))) (if (arrayp field) (save-excursion (funcall (custom-property (custom-field-custom field) 'factory-reset) field)))) (defun custom-apply-all () "Apply any changes since the last reset in all fields." (interactive (if custom-modified-list nil (error "No changes to apply."))) (custom-field-parse custom-field-last) (let ((all custom-name-fields) field) (while all (setq field (cdr (car all)) all (cdr all)) (let ((error (custom-field-validate (custom-field-custom field) field))) (if (null error) () (goto-char (car error)) (error (cdr error)))))) (let ((all custom-name-fields) field) (while all (setq field (cdr (car all)) all (cdr all)) (custom-field-apply field)))) (defun custom-field-apply (field) "Apply any changes in FIELD since the last apply." (interactive (list (or (get-text-property (point) 'custom-field) (get-text-property (point) 'custom-tag)))) (custom-field-parse custom-field-last) (if (arrayp field) (let* ((custom (custom-field-custom field)) (error (custom-field-validate custom field))) (if error (error (cdr error))) (funcall (custom-property custom 'apply) field)))) (defun custom-toggle-hide (&rest ignore) "Hide or show entry." (interactive) (error "This button is not yet implemented")) (defun custom-save-and-exit () "Save and exit customization buffer." (interactive "@") (save-excursion (funcall custom-save)) (kill-buffer (current-buffer))) (defun custom-save () "Save customization information." (interactive) (custom-apply-all) (let ((new custom-name-fields)) (set-buffer (find-file-noselect custom-file)) (goto-char (point-min)) (save-excursion (let ((old (condition-case nil (read (current-buffer)) (end-of-file (append '(setq custom-dummy 'custom-dummy) ()))))) (or (eq (car old) 'setq) (error "Invalid customization file: %s" custom-file)) (while new (let* ((field (cdr (car new))) (custom (custom-field-custom field)) (value (custom-field-original field)) (default (car (custom-import custom (custom-default custom)))) (name (car (car new)))) (setq new (cdr new)) (custom-assert '(eq name (custom-name custom))) (if (equal default value) (setcdr old (custom-plist-delq name (cdr old))) (setcdr old (plist-put (cdr old) name (car (custom-quote custom value))))))) (erase-buffer) (insert ";; " custom-file "\ --- Automatically generated customization information. ;; ;; Feel free to edit by hand, but the entire content should consist of ;; a single setq. Any other lisp expressions will confuse the ;; automatic configuration engine. \(setq ") (setq old (cdr old)) (while old (prin1 (car old) (current-buffer)) (setq old (cdr old)) (insert " ") (pp (car old) (current-buffer)) (setq old (cdr old)) (if old (insert "\n "))) (insert ")\n") (save-buffer) (kill-buffer (current-buffer)))))) (defun custom-load () "Save customization information." (interactive (and custom-modified-list (not (equal (list (custom-name-field 'custom-file)) custom-modified-list)) (not (y-or-n-p "Discard all changes? ")) (error "Load aborted"))) (load-file (custom-name-value 'custom-file)) (custom-reset-all)) ;;; Field Editing: ;; ;; Various internal functions for implementing the direct editing of ;; fields in the customization buffer. (defun custom-field-untouch (field) ;; Remove FIELD and its children from `custom-modified-list'. (setq custom-modified-list (delq field custom-modified-list)) (if (arrayp field) (let ((value (custom-field-value field))) (cond ((null (custom-data (custom-field-custom field)))) ((arrayp value) (custom-field-untouch value)) ((listp value) (mapcar 'custom-field-untouch value)))))) (defun custom-field-insert (field) ;; Insert editing FIELD in current buffer. (let ((from (point)) (custom (custom-field-custom field)) (value (custom-field-value field))) (insert (custom-write custom value)) (insert-char (custom-padding custom) (- (custom-width custom) (- (point) from))) (custom-field-move field from (point)) (set-text-properties from (point) (list 'custom-field field 'custom-tag field 'face (custom-field-face field) front-sticky t)))) (defun custom-field-read (field) ;; Read the screen content of FIELD. (custom-read (custom-field-custom field) (buffer-substring-no-properties (custom-field-start field) (custom-field-end field)))) ;; Fields are shown in a special `active' face when point is inside ;; it. You activate the field by moving point inside (entering) it ;; and deactivate the field by moving point outside (leaving) it. (defun custom-field-leave (field) ;; Deactivate FIELD. (let ((before-change-functions nil) (after-change-functions nil)) (put-text-property (custom-field-start field) (custom-field-end field) 'face (custom-field-face field)))) (defun custom-field-enter (field) ;; Activate FIELD. (let* ((start (custom-field-start field)) (end (custom-field-end field)) (custom (custom-field-custom field)) (padding (custom-padding custom)) (before-change-functions nil) (after-change-functions nil)) (or (eq this-command 'self-insert-command) (let ((pos end)) (while (and (< start pos) (eq (char-after (1- pos)) padding)) (setq pos (1- pos))) (if (< pos (point)) (goto-char pos)))) (put-text-property start end 'face custom-field-active-face))) (defun custom-field-resize (field) ;; Resize FIELD after change. (let* ((custom (custom-field-custom field)) (begin (custom-field-start field)) (end (custom-field-end field)) (pos (point)) (padding (custom-padding custom)) (width (custom-width custom)) (size (- end begin))) (cond ((< size width) (goto-char end) (if (fboundp 'insert-before-markers-and-inherit) ;; Emacs 19. (insert-before-markers-and-inherit (make-string (- width size) padding)) ;; XEmacs: BUG: Doesn't work! (insert-before-markers (make-string (- width size) padding))) (goto-char pos)) ((> size width) (let ((start (if (and (< (+ begin width) pos) (<= pos end)) pos (+ begin width)))) (goto-char end) (while (and (< start (point)) (= (preceding-char) padding)) (backward-delete-char 1)) (goto-char pos)))))) (defvar custom-field-changed nil) ;; List of fields changed on the screen but whose VALUE attribute has ;; not yet been updated to reflect the new screen content. (make-variable-buffer-local 'custom-field-changed) (defun custom-field-parse (field) ;; Parse FIELD content iff changed. (if (memq field custom-field-changed) (progn (setq custom-field-changed (delq field custom-field-changed)) (custom-field-value-set field (custom-field-read field)) (custom-field-update field)))) (defun custom-post-command () ;; Keep track of their active field. (custom-assert '(eq major-mode 'custom-mode)) (let ((field (custom-field-property (point)))) (if (eq field custom-field-last) (if (memq field custom-field-changed) (custom-field-resize field)) (custom-field-parse custom-field-last) (if custom-field-last (custom-field-leave custom-field-last)) (if field (custom-field-enter field)) (setq custom-field-last field)) (set-buffer-modified-p (or custom-modified-list custom-field-changed)))) (defvar custom-field-was nil) ;; The custom data before the change. (make-variable-buffer-local 'custom-field-was) (defun custom-before-change (begin end) ;; Check that we the modification is allowed. (if (not (eq major-mode 'custom-mode)) (message "Aargh! Why is custom-before-change called here?") (let ((from (custom-field-property begin)) (to (custom-field-property end))) (cond ((or (null from) (null to)) (error "You can only modify the fields")) ((not (eq from to)) (error "Changes must be limited to a single field.")) (t (setq custom-field-was from)))))) (defun custom-after-change (begin end length) ;; Keep track of field content. (if (not (eq major-mode 'custom-mode)) (message "Aargh! Why is custom-after-change called here?") (let ((field custom-field-was)) (custom-assert '(prog1 field (setq custom-field-was nil))) ;; Prevent mixing fields properties. (put-text-property begin end 'custom-field field) ;; Update the field after modification. (if (eq (custom-field-property begin) field) (let ((field-end (custom-field-end field))) (if (> end field-end) (set-marker field-end end)) (add-to-list 'custom-field-changed field)) ;; We deleted the entire field, reinsert it. (custom-assert '(eq begin end)) (save-excursion (goto-char begin) (custom-field-value-set field (custom-read (custom-field-custom field) "")) (custom-field-insert field)))))) (defun custom-field-property (pos) ;; The `custom-field' text property valid for POS. (or (get-text-property pos 'custom-field) (and (not (eq pos (point-min))) (get-text-property (1- pos) 'custom-field)))) ;;; Generic Utilities: ;; ;; Some utility functions that are not really specific to custom. (defun custom-assert (expr) "Assert that EXPR evaluates to non-nil at this point" (or (eval expr) (error "Assertion failed: %S" expr))) (defun custom-first-line (string) "Return the part of STRING before the first newline." (let ((pos 0) (len (length string))) (while (and (< pos len) (not (eq (aref string pos) ?\n))) (setq pos (1+ pos))) (if (eq pos len) string (substring string 0 pos)))) (defun custom-insert-before (list old new) "In LIST insert before OLD a NEW element." (cond ((null list) (list new)) ((null old) (nconc list (list new))) ((eq old (car list)) (cons new list)) (t (let ((list list)) (while (not (eq old (car (cdr list)))) (setq list (cdr list)) (custom-assert '(cdr list))) (setcdr list (cons new (cdr list)))) list))) (defun custom-strip-padding (string padding) "Remove padding from STRING." (let ((regexp (concat (regexp-quote (char-to-string padding)) "+"))) (while (string-match regexp string) (setq string (concat (substring string 0 (match-beginning 0)) (substring string (match-end 0)))))) string) (defun custom-plist-memq (prop plist) "Return non-nil if PROP is a property of PLIST. Comparison done with EQ." (let (result) (while plist (if (eq (car plist) prop) (setq result plist plist nil) (setq plist (cdr (cdr plist))))) result)) (defun custom-plist-delq (prop plist) "Delete property PROP from property list PLIST." (while (eq (car plist) prop) (setq plist (cdr (cdr plist)))) (let ((list plist) (next (cdr (cdr plist)))) (while next (if (eq (car next) prop) (progn (setq next (cdr (cdr next))) (setcdr (cdr list) next)) (setq list next next (cdr (cdr next)))))) plist) ;;; Meta Customization: (custom-declare '() '((tag . "Meta Customization") (doc . "Customization of the customization support.") (type . group) (data ((type . face-doc)) ((tag . "Button Face") (default . bold) (doc . "Face used for tags in customization buffers.") (name . custom-button-face) (synchronize . (lambda (f) (custom-category-put 'custom-button-properties 'face custom-button-face))) (type . face)) ((tag . "Mouse Face") (default . highlight) (doc . "\ Face used when mouse is above a button in customization buffers.") (name . custom-mouse-face) (synchronize . (lambda (f) (custom-category-put 'custom-button-properties mouse-face custom-mouse-face))) (type . face)) ((tag . "Field Face") (default . italic) (doc . "Face used for customization fields.") (name . custom-field-face) (type . face)) ((tag . "Uninitialized Face") (default . modeline) (doc . "Face used for uninitialized customization fields.") (name . custom-field-uninitialized-face) (type . face)) ((tag . "Invalid Face") (default . highlight) (doc . "\ Face used for customization fields containing invalid data.") (name . custom-field-invalid-face) (type . face)) ((tag . "Modified Face") (default . bold-italic) (doc . "Face used for modified customization fields.") (name . custom-field-modified-face) (type . face)) ((tag . "Active Face") (default . underline) (doc . "\ Face used for customization fields while they are being edited.") (name . custom-field-active-face) (type . face))))) ;; custom.el uses two categories. (custom-category-create 'custom-documentation-properties) (custom-category-put 'custom-documentation-properties rear-nonsticky t) (custom-category-create 'custom-button-properties) (custom-category-put 'custom-button-properties 'face custom-button-face) (custom-category-put 'custom-button-properties mouse-face custom-mouse-face) (custom-category-put 'custom-button-properties rear-nonsticky t) (custom-category-create 'custom-hidden-properties) (custom-category-put 'custom-hidden-properties 'invisible (not (string-match "XEmacs" emacs-version))) (custom-category-put 'custom-hidden-properties intangible t) (if (file-readable-p custom-file) (load-file custom-file)) (provide 'custom) ;;; custom.el ends here emacs-19.30/lisp/dabbrev.el100444 12120 1 77315 6051031572 14032 0ustar rmsdaemon;;; dabbrev.el --- dynamic abbreviation package ;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc. ;; Author: Don Morrison ;; Maintainer: Lars Lindberg ;; Created: 16 Mars 1992 ;; Lindberg's last update version: 5.7 ;; Keywords: abbrev expand completion ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; The purpose with this package is to let you write just a few ;; characters of words you've written earlier to be able to expand ;; them. ;; ;; To expand a word, just put the point right after the word and press ;; M-/ (dabbrev-expand) or M-C-/ (dabbrev-completion). ;; ;; Check out the customizable variables below to learn about all the ;; features of this package. ;;; Hints and tips for major modes writers: ;; Recommended values C/Lisp etc text ;; dabbrev-case-fold-search nil t ;; dabbrev-case-replace nil t ;; ;; Set the variables you want special for your mode like this: ;; (set (make-local-variable 'dabbrev-case-replace) nil) ;; Then you don't interfer with other modes. ;; ;; If your mode handles buffers that refers to other buffers ;; (i.e. compilation-mode, gud-mode), then try to set ;; `dabbrev-select-buffers-function' or `dabbrev-friend-buffer-function' ;; to a function that point out those buffers. ;; Same goes for major-modes that are connected to other modes. There ;; are for instance a number of mail-modes. One for reading, one for ;; creating a new mail etc. Maybe those should be connected. ;; Example for GNUS (when we write a reply, we want dabbrev to look in ;; the article for expansion): ;; (set (make-local-variable 'dabbrev-friend-buffer-function) ;; (lambda (buffer) ;; (save-excursion ;; (set-buffer buffer) ;; (memq major-mode '(news-reply-mode gnus-article-mode))))) ;; Known bugs and limitations. ;; - Possible to do several levels of `dabbrev-completion' in the ;; minibuffer. ;; - dabbrev-completion doesn't handle resetting the globals variables ;; right. It resets them after finding the abbrev. ;; Future enhancements ;; - Check the tags-files? Like tags-complete? ;; - Add the possibility of searching both forward and backward to ;; the nearest expansion. ;; - Check the kill-ring when everything else fails. (Maybe something ;; for hippie-expand?). [Bng] ;;; These people gave suggestions: ;; [hymie] Hyman Rosen ;; [burgett] Steve Burgett ;; [jules] Julian Gosnell ;; [kifer] Michael Kifer ;; [ake] Ake Stenhoff ;; [alon] Alon Albert ;; [tromey] Tom Tromey ;; [Rolf] Rolf Schreiber ;; [Petri] Petri Raitio ;; [ejb] Jay Berkenbilt ;; [hawley] Bob Hawley ;; ... and to all the people who have participated in the beta tests. ;;; Code: ;;;---------------------------------------------------------------- ;;;---------------------------------------------------------------- ;;; Customization variables ;;;---------------------------------------------------------------- ;;;---------------------------------------------------------------- (defvar dabbrev-backward-only nil "*If non-nil, `dabbrev-expand' only looks backwards.") (defvar dabbrev-limit nil "*Limits region searched by `dabbrev-expand' to this many chars away.") (defvar dabbrev-abbrev-skip-leading-regexp nil "*Regexp for skipping leading characters of an abbreviation. Example: Set this to \"\\\\$\" for programming languages in which variable names may appear with or without a leading `$'. (For example, in Makefiles.) Set this to nil if no characters should be skipped.") ;; I recommend that you set this to nil. (defvar dabbrev-case-fold-search 'case-fold-search "*Non-nil if dabbrev searches should ignore case. A value of nil means case is significant. The value of this variable is an expression; it is evaluated and the resulting value determines the decision. For example: setting this to `case-fold-search' means evaluate that variable to see whether its value is nil.") (defvar dabbrev-upcase-means-case-search nil "*The significance of an uppercase character in an abbreviation. nil means case fold search, non-nil means case sensitive search. This variable has an effect only when the value of `dabbrev-case-fold-search' evaluates to t.") ;; I recommend that you set this to nil. (defvar dabbrev-case-replace 'case-replace "*Non-nil means dabbrev should preserve case when expanding the abbreviation. More precisely, it preserves the case pattern of the abbreviation as you typed it--as opposed to the case pattern of the expansion that is copied. The value of this variable is an expression; it is evaluated and the resulting value determines the decision. For example, setting this to `case-replace' means evaluate that variable to see if its value is t or nil. This variable has an effect only when the value of `dabbrev-case-fold-search' evaluates to t.") (defvar dabbrev-abbrev-char-regexp nil "*Regexp to recognize a character in an abbreviation or expansion. This regexp will be surrounded with \\\\( ... \\\\) when actually used. Set this variable to \"\\\\sw\" if you want ordinary words or \"\\\\sw\\\\|\\\\s_\" if you want symbols (including characters whose syntax is \"symbol\" as well as those whose syntax is \"word\". The value nil has a special meaning: the abbreviation is from point to previous word-start, but the search is for symbols. For instance, if you are programming in Lisp, `yes-or-no-p' is a symbol, while `yes', `or', `no' and `p' are considered words. If this variable is nil, then expanding `yes-or-no-' looks for a symbol starting with or containing `no-'. If you set this variable to \"\\\\sw\\\\|\\\\s_\", that expansion looks for a symbol starting with `yes-or-no-'. Finally, if you set this variable to \"\\\\sw\", then expanding `yes-or-no-' signals an error because `-' is not part of a word; but expanding `yes-or-no' looks for a word starting with `no'. The recommended value is \"\\\\sw\\\\|\\\\s_\".") (defvar dabbrev-check-all-buffers t "*Non-nil means dabbrev package should search *all* buffers. Dabbrev always searches the current buffer first. Then, if `dabbrev-check-other-buffers' says so, it searches the buffers designated by `dabbrev-select-buffers-function'. Then, if `dabbrev-check-all-buffers' is non-nil, dabbrev searches all the other buffers.") (defvar dabbrev-check-other-buffers t "*Should \\[dabbrev-expand] look in other buffers?\ nil: Don't look in other buffers. t: Also look for expansions in the buffers pointed out by `dabbrev-select-buffers-function'. Anything else: When we can't find any more expansions in the current buffer, then ask the user whether to look in other buffers too. The default value is t.") ;; I guess setting this to a function that selects all C- or C++- ;; mode buffers would be a good choice for a debugging buffer, ;; when debugging C- or C++-code. (defvar dabbrev-select-buffers-function 'dabbrev--select-buffers "A function that selects buffers that should be searched by dabbrev. The function should take no arguments and return a list of buffers to search for expansions. Have a look at `dabbrev--select-buffers' for an example. A mode setting this variable should make it buffer local.") (defvar dabbrev-friend-buffer-function 'dabbrev--same-major-mode-p "*A function to decide whether dabbrev should search OTHER-BUFFER. The function should take one argument, OTHER-BUFFER, and return non-nil if that buffer should be searched. Have a look at `dabbrev--same-major-mode-p' for an example. The value of `dabbrev-friend-buffer-function' has an effect only if the value of `dabbrev-select-buffers-function' uses it. The function `dabbrev--select-buffers' is one function you can use here. A mode setting this variable should make it buffer local.") (defvar dabbrev-search-these-buffers-only nil "If non-nil, a list of buffers which dabbrev should search. If this variable is non-nil, dabbrev will only look in these buffers. It will not even look in the current buffer if it is not a member of this list.") ;;;---------------------------------------------------------------- ;;;---------------------------------------------------------------- ;;; Internal variables ;;;---------------------------------------------------------------- ;;;---------------------------------------------------------------- ;; Last obarray of completions in `dabbrev-completion' (defvar dabbrev--last-obarray nil) ;; Table of expansions seen so far (defvar dabbrev--last-table nil) ;; Last string we tried to expand. (defvar dabbrev--last-abbreviation nil) ;; Location last abbreviation began (defvar dabbrev--last-abbrev-location nil) ;; Direction of last dabbrevs search (defvar dabbrev--last-direction 0) ;; Last expansion of an abbreviation. (defvar dabbrev--last-expansion nil) ;; Location the last expansion was found. (defvar dabbrev--last-expansion-location nil) ;; The list of remaining buffers with the same mode as current buffer. (defvar dabbrev--friend-buffer-list nil) ;; The buffer we looked in last. (defvar dabbrev--last-buffer nil) ;; The buffer we found the expansion last time. (defvar dabbrev--last-buffer-found nil) ;; The buffer we last did a completion in. (defvar dabbrev--last-completion-buffer nil) ;; Same as dabbrev-check-other-buffers, but is set for every expand. (defvar dabbrev--check-other-buffers dabbrev-check-other-buffers) ;; The regexp for recognizing a character in an abbreviation. (defvar dabbrev--abbrev-char-regexp nil) ;;;---------------------------------------------------------------- ;;;---------------------------------------------------------------- ;;; Macros ;;;---------------------------------------------------------------- ;;;---------------------------------------------------------------- ;;; Get the buffer that mini-buffer was activated from (defsubst dabbrev--minibuffer-origin () (car (cdr (buffer-list)))) ;; Make a list of some of the elements of LIST. ;; Check each element of LIST, storing it temporarily in the ;; variable ELEMENT, and include it in the result ;; if CONDITION evaluates non-nil. (defmacro dabbrev-filter-elements (element list condition) (` (let (dabbrev-result dabbrev-tail (, element)) (setq dabbrev-tail (, list)) (while dabbrev-tail (setq (, element) (car dabbrev-tail)) (if (, condition) (setq dabbrev-result (cons (, element) dabbrev-result))) (setq dabbrev-tail (cdr dabbrev-tail))) (nreverse dabbrev-result)))) ;;;---------------------------------------------------------------- ;;;---------------------------------------------------------------- ;;; Exported functions ;;;---------------------------------------------------------------- ;;;---------------------------------------------------------------- ;;;###autoload (define-key esc-map "/" 'dabbrev-expand) ;;;??? Do we want this? ;;;###autoload (define-key esc-map [?\C-/] 'dabbrev-completion) ;;;###autoload (defun dabbrev-completion (&optional arg) "Completion on current word. Like \\[dabbrev-expand] but finds all expansions in the current buffer and presents suggestions for completion. With a prefix argument, it searches all buffers accepted by the function pointed out by `dabbrev-friend-buffer-function' to find the completions. If the prefix argument is 16 (which comes from C-u C-u), then it searches *all* buffers. With no prefix argument, it reuses an old completion list if there is a suitable one already." (interactive "*P") (dabbrev--reset-global-variables) (let* ((dabbrev-check-other-buffers (and arg t)) (dabbrev-check-all-buffers (and arg (= (prefix-numeric-value arg) 16))) (abbrev (dabbrev--abbrev-at-point)) (ignore-case-p (and (eval dabbrev-case-fold-search) (or (not dabbrev-upcase-means-case-search) (string= abbrev (downcase abbrev))))) (my-obarray dabbrev--last-obarray) init) (save-excursion (if (and (null arg) my-obarray (or (eq dabbrev--last-completion-buffer (current-buffer)) (and (window-minibuffer-p (selected-window)) (eq dabbrev--last-completion-buffer (dabbrev--minibuffer-origin)))) dabbrev--last-abbreviation (>= (length abbrev) (length dabbrev--last-abbreviation)) (string= dabbrev--last-abbreviation (substring abbrev 0 (length dabbrev--last-abbreviation))) (setq init (try-completion abbrev my-obarray))) ;; We can reuse the existing completion list. nil ;;-------------------------------- ;; New abbreviation to expand. ;;-------------------------------- (setq dabbrev--last-abbreviation abbrev) ;; Find all expansion (let ((completion-list (dabbrev--find-all-expansions abbrev ignore-case-p))) ;; Make an obarray with all expansions (setq my-obarray (make-vector (length completion-list) 0)) (or (> (length my-obarray) 0) (error "No dynamic expansion for \"%s\" found%s" abbrev (if dabbrev--check-other-buffers "" " in this-buffer"))) (cond ((or (not ignore-case-p) (not dabbrev-case-replace)) (mapcar (function (lambda (string) (intern string my-obarray))) completion-list)) ((string= abbrev (upcase abbrev)) (mapcar (function (lambda (string) (intern (upcase string) my-obarray))) completion-list)) ((string= (substring abbrev 0 1) (upcase (substring abbrev 0 1))) (mapcar (function (lambda (string) (intern (capitalize string) my-obarray))) completion-list)) (t (mapcar (function (lambda (string) (intern (downcase string) my-obarray))) completion-list))) (setq dabbrev--last-obarray my-obarray) (setq dabbrev--last-completion-buffer (current-buffer)) ;; Find the longest common string. (setq init (try-completion abbrev my-obarray))))) ;;-------------------------------- ;; Let the user choose between the expansions ;;-------------------------------- (or (stringp init) (setq init abbrev)) (cond ;; * Replace string fragment with matched common substring completion. ((and (not (string-equal init "")) (not (string-equal (downcase init) (downcase abbrev)))) (if (> (length (all-completions init my-obarray)) 1) (message "Repeat `%s' to see all completions" (key-description (this-command-keys))) (message "The only possible completion")) (dabbrev--substitute-expansion nil abbrev init)) (t ;; * String is a common substring completion already. Make list. (message "Making completion list...") (with-output-to-temp-buffer " *Completions*" (display-completion-list (all-completions init my-obarray))) (message "Making completion list...done"))) (and (window-minibuffer-p (selected-window)) (message nil)))) ;;;###autoload (defun dabbrev-expand (arg) "Expand previous word \"dynamically\". Expands to the most recent, preceding word for which this is a prefix. If no suitable preceding word is found, words following point are considered. If still no suitable word is found, then look in the buffers accepted by the function pointed out by variable `dabbrev-friend-buffer-function'. A positive prefix argument, N, says to take the Nth backward *distinct* possibility. A negative argument says search forward. If the cursor has not moved from the end of the previous expansion and no argument is given, replace the previously-made expansion with the next possible expansion not yet tried. The variable `dabbrev-backward-only' may be used to limit the direction of search to backward if set non-nil. See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]." (interactive "*P") (let (abbrev expansion old direction (orig-point (point))) ;; abbrev -- the abbrev to expand ;; expansion -- the expansion found (eventually) or nil until then ;; old -- the text currently in the buffer ;; (the abbrev, or the previously-made expansion) (save-excursion (if (and (null arg) (markerp dabbrev--last-abbrev-location) (marker-position dabbrev--last-abbrev-location) (or (eq last-command this-command) (and (window-minibuffer-p (selected-window)) (= dabbrev--last-abbrev-location (point))))) ;; Find a different expansion for the same abbrev as last time. (progn (setq abbrev dabbrev--last-abbreviation) (setq old dabbrev--last-expansion) (setq direction dabbrev--last-direction)) ;; If the user inserts a space after expanding ;; and then asks to expand again, always fetch the next word. (if (and (eq (preceding-char) ?\ ) (markerp dabbrev--last-abbrev-location) (marker-position dabbrev--last-abbrev-location) (= (point) (1+ dabbrev--last-abbrev-location))) (progn ;; The "abbrev" to expand is just the space. (setq abbrev " ") (save-excursion (if dabbrev--last-buffer (set-buffer dabbrev--last-buffer)) ;; Find the end of the last "expansion" word. (if (or (eq dabbrev--last-direction 1) (and (eq dabbrev--last-direction 0) (< dabbrev--last-expansion-location (point)))) (setq dabbrev--last-expansion-location (+ dabbrev--last-expansion-location (length dabbrev--last-expansion)))) (goto-char dabbrev--last-expansion-location) ;; Take the following word, with intermediate separators, ;; as our expansion this time. (re-search-forward (concat "\\(\\(" dabbrev--abbrev-char-regexp "\\)+\\)")) (setq expansion (buffer-substring dabbrev--last-expansion-location (point))) ;; Record the end of this expansion, in case we repeat this. (setq dabbrev--last-expansion-location (point))) ;; Indicate that dabbrev--last-expansion-location is ;; at the end of the expansion. (setq dabbrev--last-direction -1)) ;; We have a different abbrev to expand. (dabbrev--reset-global-variables) (setq direction (if (null arg) (if dabbrev-backward-only 1 0) (prefix-numeric-value arg))) (setq abbrev (dabbrev--abbrev-at-point)) (setq old nil))) ;;-------------------------------- ;; Find the expansion ;;-------------------------------- (or expansion (setq expansion (dabbrev--find-expansion abbrev direction (and (eval dabbrev-case-fold-search) (or (not dabbrev-upcase-means-case-search) (string= abbrev (downcase abbrev)))))))) (cond ((not expansion) (dabbrev--reset-global-variables) (if old (save-excursion (setq buffer-undo-list (cons orig-point buffer-undo-list)) ;; Put back the original abbrev with its original case pattern. (search-backward old) (insert abbrev) (delete-region (point) (+ (point) (length old))))) (error "No%s dynamic expansion for `%s' found" (if old " further" "") abbrev)) (t (if (not (eq dabbrev--last-buffer dabbrev--last-buffer-found)) (progn (message "Expansion found in '%s'" (buffer-name dabbrev--last-buffer)) (setq dabbrev--last-buffer-found dabbrev--last-buffer)) (message nil)) (if (and (or (eq (current-buffer) dabbrev--last-buffer) (null dabbrev--last-buffer)) (numberp dabbrev--last-expansion-location) (and (> dabbrev--last-expansion-location (point)))) (setq dabbrev--last-expansion-location (copy-marker dabbrev--last-expansion-location))) ;; Success: stick it in and return. (setq buffer-undo-list (cons orig-point buffer-undo-list)) (dabbrev--substitute-expansion old abbrev expansion) ;; Save state for re-expand. (setq dabbrev--last-expansion expansion) (setq dabbrev--last-abbreviation abbrev) (setq dabbrev--last-abbrev-location (point-marker)))))) ;;;---------------------------------------------------------------- ;;;---------------------------------------------------------------- ;;; Local functions ;;;---------------------------------------------------------------- ;;;---------------------------------------------------------------- ;;; Checks if OTHER-BUFFER has the same major mode as current buffer. (defun dabbrev--same-major-mode-p (other-buffer) (eq major-mode (save-excursion (set-buffer other-buffer) major-mode))) ;;; Back over all abbrev type characters and then moves forward over ;;; all skip characters. (defun dabbrev--goto-start-of-abbrev () ;; Move backwards over abbrev chars (save-match-data (if (not (bobp)) (progn (forward-char -1) (while (and (looking-at dabbrev--abbrev-char-regexp) (not (bobp))) (forward-char -1)) (or (looking-at dabbrev--abbrev-char-regexp) (forward-char 1)))) (and dabbrev-abbrev-skip-leading-regexp (while (looking-at dabbrev-abbrev-skip-leading-regexp) (forward-char 1))))) ;;; Extract the symbol at point to serve as abbreviation. (defun dabbrev--abbrev-at-point () ;; Check for error (if (bobp) (error "No possible abbreviation preceding point")) ;; Return abbrev at point (save-excursion ;; Record the end of the abbreviation. (setq dabbrev--last-abbrev-location (point)) ;; If we aren't right after an abbreviation, ;; move point back to just after one. ;; This is so the user can get successive words ;; by typing the punctuation followed by M-/. (save-match-data (if (save-excursion (forward-char -1) (not (looking-at (concat "\\(" (or dabbrev-abbrev-char-regexp "\\sw\\|\\s_") "\\)+")))) (if (re-search-backward (or dabbrev-abbrev-char-regexp "\\sw\\|\\s_") nil t) (forward-char 1) (error "No possible abbreviation preceding point")))) ;; Now find the beginning of that one. (dabbrev--goto-start-of-abbrev) (buffer-substring dabbrev--last-abbrev-location (point)))) ;;; Initializes all global variables (defun dabbrev--reset-global-variables () ;; dabbrev--last-obarray and dabbrev--last-completion-buffer ;; must not be reset here. (setq dabbrev--last-table nil dabbrev--last-abbreviation nil dabbrev--last-abbrev-location nil dabbrev--last-direction nil dabbrev--last-expansion nil dabbrev--last-expansion-location nil dabbrev--friend-buffer-list nil dabbrev--last-buffer nil dabbrev--last-buffer-found nil dabbrev--abbrev-char-regexp (or dabbrev-abbrev-char-regexp "\\sw\\|\\s_") dabbrev--check-other-buffers dabbrev-check-other-buffers)) ;;; Find all buffers that are considered "friends" according to the ;;; function pointed out by dabbrev-friend-buffer-function. (defun dabbrev--select-buffers () (save-excursion (and (window-minibuffer-p (selected-window)) (set-buffer (dabbrev--minibuffer-origin))) (let ((orig-buffer (current-buffer))) (dabbrev-filter-elements buffer (buffer-list) (and (not (eq orig-buffer buffer)) (boundp 'dabbrev-friend-buffer-function) (funcall dabbrev-friend-buffer-function buffer)))))) ;;; Search for ABBREV, N times, normally looking forward, ;;; but looking in reverse instead if REVERSE is non-nil. (defun dabbrev--try-find (abbrev reverse n ignore-case) (save-excursion (save-restriction (widen) (let ((expansion nil)) (and dabbrev--last-expansion-location (goto-char dabbrev--last-expansion-location)) (let ((case-fold-search ignore-case) (count n)) (while (and (> count 0) (setq expansion (dabbrev--search abbrev reverse ignore-case))) (setq count (1- count)))) (and expansion (setq dabbrev--last-expansion-location (point))) expansion)))) ;;; Find all expansions of ABBREV (defun dabbrev--find-all-expansions (abbrev ignore-case) (let ((all-expansions nil) expansion) (save-excursion (goto-char (point-min)) (while (setq expansion (dabbrev--find-expansion abbrev -1 ignore-case)) (setq all-expansions (cons expansion all-expansions)))) all-expansions)) (defun dabbrev--scanning-message () (message "Scanning `%s'" (buffer-name (current-buffer)))) ;;; Find one occasion of ABBREV. ;;; DIRECTION > 0 means look that many times backwards. ;;; DIRECTION < 0 means look that many times forward. ;;; DIRECTION = 0 means try both backward and forward. ;;; IGNORE-CASE non-nil means ignore case when searching. (defun dabbrev--find-expansion (abbrev direction ignore-case) (let (expansion) (save-excursion (cond (dabbrev--last-buffer (set-buffer dabbrev--last-buffer) (dabbrev--scanning-message)) ((and (not dabbrev-search-these-buffers-only) (window-minibuffer-p (selected-window))) (set-buffer (dabbrev--minibuffer-origin)) ;; In the minibuffer-origin buffer we will only search from ;; the top and down. (goto-char (point-min)) (setq direction -1) (dabbrev--scanning-message))) (cond ;; ------------------------------------------ ;; Look backwards ;; ------------------------------------------ ((and (not dabbrev-search-these-buffers-only) (>= direction 0) (setq dabbrev--last-direction (min 1 direction)) (setq expansion (dabbrev--try-find abbrev t (max 1 direction) ignore-case))) expansion) ;; ------------------------------------------ ;; Look forward ;; ------------------------------------------ ((and (or (not dabbrev-search-these-buffers-only) dabbrev--last-buffer) (<= direction 0) (setq dabbrev--last-direction -1) (setq expansion (dabbrev--try-find abbrev nil (max 1 (- direction)) ignore-case))) expansion) ;; ------------------------------------------ ;; Look in other buffers. ;; Start at (point-min) and look forward. ;; ------------------------------------------ (t (setq dabbrev--last-direction -1) ;; Make sure that we should check other buffers (or dabbrev--friend-buffer-list dabbrev--last-buffer (setq dabbrev--friend-buffer-list (mapcar (function get-buffer) dabbrev-search-these-buffers-only)) (not dabbrev--check-other-buffers) (not (or (eq dabbrev--check-other-buffers t) (progn (setq dabbrev--check-other-buffers (y-or-n-p "Scan other buffers also? "))))) (let* (friend-buffer-list non-friend-buffer-list) (setq dabbrev--friend-buffer-list (funcall dabbrev-select-buffers-function)) (if dabbrev-check-all-buffers (setq non-friend-buffer-list (nreverse (dabbrev-filter-elements buffer (buffer-list) (not (memq buffer dabbrev--friend-buffer-list)))) dabbrev--friend-buffer-list (append dabbrev--friend-buffer-list non-friend-buffer-list))))) ;; Move buffers that are visible on the screen ;; to the front of the list. (if dabbrev--friend-buffer-list (let ((w (next-window (selected-window)))) (while (not (eq w (selected-window))) (setq dabbrev--friend-buffer-list (cons (window-buffer w) (delq (window-buffer w) dabbrev--friend-buffer-list))) (setq w (next-window w))))) ;; Walk through the buffers (while (and (not expansion) dabbrev--friend-buffer-list) (setq dabbrev--last-buffer (car dabbrev--friend-buffer-list)) (setq dabbrev--friend-buffer-list (cdr dabbrev--friend-buffer-list)) (set-buffer dabbrev--last-buffer) (dabbrev--scanning-message) (setq dabbrev--last-expansion-location (point-min)) (setq expansion (dabbrev--try-find abbrev nil 1 ignore-case))) expansion))))) (defun dabbrev--safe-replace-match (string &optional fixedcase literal) (if (eq major-mode 'picture-mode) (picture-replace-match string fixedcase literal) (replace-match string fixedcase literal))) ;;;---------------------------------------------------------------- ;;; Substitute the current string in buffer with the expansion ;;; OLD is nil or the last expansion substring. ;;; ABBREV is the abbreviation we are working with. ;;; EXPANSION is the expansion substring. (defun dabbrev--substitute-expansion (old abbrev expansion) ;;(undo-boundary) (let ((use-case-replace (and (eval dabbrev-case-fold-search) (or (not dabbrev-upcase-means-case-search) (string= abbrev (downcase abbrev))) (eval dabbrev-case-replace)))) (and nil use-case-replace (setq old (concat abbrev (or old ""))) (setq expansion (concat abbrev expansion))) (if old (save-excursion (search-backward old)) ;;(store-match-data (list (point-marker) (point-marker))) (search-backward abbrev)) ;; Make case of replacement conform to case of abbreviation ;; provided (1) that kind of thing is enabled in this buffer ;; and (2) the replacement itself is all lower case. (dabbrev--safe-replace-match expansion (not use-case-replace) t))) ;;;---------------------------------------------------------------- ;;; Search function used by dabbrevs library. ;;; ABBREV is string to find as prefix of word. Second arg, REVERSE, ;;; is t for reverse search, nil for forward. Variable dabbrev-limit ;;; controls the maximum search region size. Third argment IGNORE-CASE ;;; non-nil means treat case as insignificant while looking for a match ;;; and when comparing with previous matches. Also if that's non-nil ;;; and the match is found at the beginning of a sentence and is in ;;; lower case except for the initial then it is converted to all lower ;;; case for return. ;;; Table of expansions already seen is examined in buffer ;;; `dabbrev--last-table' so that only distinct possibilities are found ;;; by dabbrev-re-expand. ;;; Value is the expansion, or nil if not found. (defun dabbrev--search (abbrev reverse ignore-case) (save-match-data (let ((pattern1 (concat (regexp-quote abbrev) "\\(" dabbrev--abbrev-char-regexp "\\)")) (pattern2 (concat (regexp-quote abbrev) "\\(\\(" dabbrev--abbrev-char-regexp "\\)+\\)")) (found-string nil)) ;; Limited search. (save-restriction (and dabbrev-limit (narrow-to-region dabbrev--last-expansion-location (+ (point) (if reverse (- dabbrev-limit) dabbrev-limit)))) ;;-------------------------------- ;; Look for a distinct expansion, using dabbrev--last-table. ;;-------------------------------- (while (and (not found-string) (if reverse (re-search-backward pattern1 nil t) (re-search-forward pattern1 nil t))) (goto-char (match-beginning 0)) ;; In case we matched in the middle of a word, ;; back up to start of word and verify we still match. (dabbrev--goto-start-of-abbrev) (if (not (looking-at pattern1)) nil ;; We have a truly valid match. Find the end. (re-search-forward pattern2) (setq found-string (buffer-substring (match-beginning 1) (match-end 1))) (and ignore-case (setq found-string (downcase found-string))) ;; Ignore this match if it's already in the table. (if (dabbrev-filter-elements table-string dabbrev--last-table (string= found-string table-string)) (setq found-string nil))) ;; Prepare to continue searching. (if reverse (goto-char (match-beginning 0)) (goto-char (match-end 0)))) ;; If we found something, use it. (if found-string ;; Put it into `dabbrev--last-table' ;; and return it (either downcased, or as is). (let ((result (buffer-substring (match-beginning 0) (match-end 0)))) (setq dabbrev--last-table (cons found-string dabbrev--last-table)) (if (and ignore-case (eval dabbrev-case-replace)) (downcase result) result))))))) (provide 'dabbrev) ;; dabbrev.el ends here emacs-19.30/lisp/debug.el100444 12120 1 44304 5733206726 13516 0ustar rmsdaemon;;; debug.el --- debuggers and related commands for Emacs ;; Copyright (C) 1985, 1986, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: lisp, tools, maint ;; 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 is a major mode documented in the Emacs manual. ;;; Code: (defvar debug-function-list nil "List of functions currently set for debug on entry.") (defvar debugger-step-after-exit nil "Non-nil means \"single-step\" after the debugger exits.") (defvar debugger-value nil "This is the value for the debugger to return, when it returns.") (defvar debugger-old-buffer nil "This is the buffer that was current when the debugger was entered.") (defvar debugger-outer-match-data) (defvar debugger-outer-load-read-function) (defvar debugger-outer-overriding-local-map) (defvar debugger-outer-track-mouse) (defvar debugger-outer-last-command) (defvar debugger-outer-this-command) (defvar debugger-outer-unread-command-char) (defvar debugger-outer-unread-command-events) (defvar debugger-outer-last-input-event) (defvar debugger-outer-last-command-event) (defvar debugger-outer-last-nonmenu-event) (defvar debugger-outer-last-event-frame) (defvar debugger-outer-standard-input) (defvar debugger-outer-standard-output) (defvar debugger-outer-cursor-in-echo-area) ;;;###autoload (setq debugger 'debug) ;;;###autoload (defun debug (&rest debugger-args) "Enter debugger. To return, type \\`\\[debugger-continue]'. Arguments are mainly for use when this is called from the internals of the evaluator. You may call with no args, or you may pass nil as the first arg and any other args you like. In that case, the list of args after the first will be printed into the backtrace buffer." (interactive) (message "Entering debugger...") (let (debugger-value (debug-on-error nil) (debug-on-quit nil) (debugger-buffer (let ((default-major-mode 'fundamental-mode)) (get-buffer-create "*Backtrace*"))) (debugger-old-buffer (current-buffer)) (debugger-step-after-exit nil) ;; Don't keep reading from an executing kbd macro! (executing-macro nil) ;; Save the outer values of these vars for the `e' command ;; before we replace the values. (debugger-outer-match-data (match-data)) (debugger-outer-load-read-function load-read-function) (debugger-outer-overriding-local-map overriding-local-map) (debugger-outer-track-mouse track-mouse) (debugger-outer-last-command last-command) (debugger-outer-this-command this-command) (debugger-outer-unread-command-char unread-command-char) (debugger-outer-unread-command-events unread-command-events) (debugger-outer-last-input-event last-input-event) (debugger-outer-last-command-event last-command-event) (debugger-outer-last-nonmenu-event last-nonmenu-event) (debugger-outer-last-event-frame last-event-frame) (debugger-outer-standard-input standard-input) (debugger-outer-standard-output standard-output) (debugger-outer-cursor-in-echo-area cursor-in-echo-area)) ;; Don't let these magic variables affect the debugger itself. (let ((last-command nil) this-command track-mouse (unread-command-char -1) unread-command-events last-input-event last-command-event last-nonmenu-event last-event-frame overriding-local-map load-read-function (standard-input t) (standard-output t) (cursor-in-echo-area nil)) (unwind-protect (save-excursion (save-window-excursion (pop-to-buffer debugger-buffer) (erase-buffer) (let ((standard-output (current-buffer)) (print-escape-newlines t) (print-length 50)) (backtrace)) (goto-char (point-min)) (debugger-mode) (delete-region (point) (progn (search-forward "\n debug(") (forward-line 1) (point))) (debugger-reenable) ;; lambda is for debug-on-call when a function call is next. ;; debug is for debug-on-entry function called. (cond ((memq (car debugger-args) '(lambda debug)) (insert "Entering:\n") (if (eq (car debugger-args) 'debug) (progn ;; Skip the frames for backtrace-debug, byte-code, ;; and debug. (backtrace-debug 3 t) (delete-char 1) (insert ?*) (beginning-of-line)))) ;; Exiting a function. ((eq (car debugger-args) 'exit) (insert "Return value: ") (setq debugger-value (nth 1 debugger-args)) (prin1 debugger-value (current-buffer)) (insert ?\n) (delete-char 1) (insert ? ) (beginning-of-line)) ;; Debugger entered for an error. ((eq (car debugger-args) 'error) (insert "Signalling: ") (prin1 (nth 1 debugger-args) (current-buffer)) (insert ?\n)) ;; debug-on-call, when the next thing is an eval. ((eq (car debugger-args) t) (insert "Beginning evaluation of function call form:\n")) ;; User calls debug directly. (t (prin1 (if (eq (car debugger-args) 'nil) (cdr debugger-args) debugger-args) (current-buffer)) (insert ?\n))) (message "") (let ((inhibit-trace t) (standard-output nil) (buffer-read-only t)) (message "") (recursive-edit)))) ;; Kill or at least neuter the backtrace buffer, so that users ;; don't try to execute debugger commands in an invalid context. (if (get-buffer-window debugger-buffer 'visible) ;; Still visible despite the save-window-excursion? Maybe it ;; it's in a pop-up frame. It would be annoying to delete and ;; recreate it every time the debugger stops, so instead we'll ;; erase it but leave it visible. (save-excursion (set-buffer debugger-buffer) (erase-buffer) (fundamental-mode)) (kill-buffer debugger-buffer)) (store-match-data debugger-outer-match-data))) ;; Put into effect the modified values of these variables ;; in case the user set them with the `e' command. (setq load-read-function debugger-outer-load-read-function) (setq overriding-local-map debugger-outer-overriding-local-map) (setq track-mouse debugger-outer-track-mouse) (setq last-command debugger-outer-last-command) (setq this-command debugger-outer-this-command) (setq unread-command-char debugger-outer-unread-command-char) (setq unread-command-events debugger-outer-unread-command-events) (setq last-input-event debugger-outer-last-input-event) (setq last-command-event debugger-outer-last-command-event) (setq last-nonmenu-event debugger-outer-last-nonmenu-event) (setq last-event-frame debugger-outer-last-event-frame) (setq standard-input debugger-outer-standard-input) (setq standard-output debugger-outer-standard-output) (setq cursor-in-echo-area debugger-outer-cursor-in-echo-area) (setq debug-on-next-call debugger-step-after-exit) debugger-value)) (defun debugger-step-through () "Proceed, stepping through subexpressions of this expression. Enter another debugger on next entry to eval, apply or funcall." (interactive) (setq debugger-step-after-exit t) (message "Proceeding, will debug on next eval or call.") (exit-recursive-edit)) (defun debugger-continue () "Continue, evaluating this expression without stopping." (interactive) (message "Continuing.") (exit-recursive-edit)) (defun debugger-return-value (val) "Continue, specifying value to return. This is only useful when the value returned from the debugger will be used, such as in a debug on exit from a frame." (interactive "XReturn value (evaluated): ") (setq debugger-value val) (princ "Returning " t) (prin1 debugger-value) (exit-recursive-edit)) (defun debugger-jump () "Continue to exit from this frame, with all debug-on-entry suspended." (interactive) ;; Compensate for the two extra stack frames for debugger-jump. (let ((debugger-frame-offset (+ debugger-frame-offset 2))) (debugger-frame)) ;; Turn off all debug-on-entry functions ;; but leave them in the list. (let ((list debug-function-list)) (while list (fset (car list) (debug-on-entry-1 (car list) (symbol-function (car list)) nil)) (setq list (cdr list)))) (message "Continuing through this frame") (exit-recursive-edit)) (defun debugger-reenable () "Turn all debug-on-entry functions back on." (let ((list debug-function-list)) (while list (or (consp (symbol-function (car list))) (debug-convert-byte-code (car list))) (fset (car list) (debug-on-entry-1 (car list) (symbol-function (car list)) t)) (setq list (cdr list))))) (defun debugger-frame-number () "Return number of frames in backtrace before the one point points at." (save-excursion (beginning-of-line) (let ((opoint (point)) (count 0)) (goto-char (point-min)) (if (or (equal (buffer-substring (point) (+ (point) 6)) "Signal") (equal (buffer-substring (point) (+ (point) 6)) "Return")) (progn (search-forward ":") (forward-sexp 1))) (forward-line 1) (while (progn (forward-char 2) (if (= (following-char) ?\() (forward-sexp 1) (forward-sexp 2)) (forward-line 1) (<= (point) opoint)) (setq count (1+ count))) count))) ;; Chosen empirically to account for all the frames ;; that will exist when debugger-frame is called ;; within the first one that appears in the backtrace buffer. ;; Assumes debugger-frame is called from a key; ;; will be wrong if it is called with Meta-x. (defconst debugger-frame-offset 8 "") (defun debugger-frame () "Request entry to debugger when this frame exits. Applies to the frame whose line point is on in the backtrace." (interactive) (beginning-of-line) (let ((level (debugger-frame-number))) (backtrace-debug (+ level debugger-frame-offset) t)) (if (= (following-char) ? ) (let ((buffer-read-only nil)) (delete-char 1) (insert ?*))) (beginning-of-line)) (defun debugger-frame-clear () "Do not enter to debugger when this frame exits. Applies to the frame whose line point is on in the backtrace." (interactive) (beginning-of-line) (let ((level (debugger-frame-number))) (backtrace-debug (+ level debugger-frame-offset) nil)) (if (= (following-char) ?*) (let ((buffer-read-only nil)) (delete-char 1) (insert ? ))) (beginning-of-line)) (defun debugger-eval-expression (exp) "Eval an expression, in an environment like that outside the debugger." (interactive (list (read-from-minibuffer "Eval: " nil read-expression-map t 'read-expression-history))) (save-excursion (if (null (buffer-name debugger-old-buffer)) ;; old buffer deleted (setq debugger-old-buffer (current-buffer))) (set-buffer debugger-old-buffer) (let ((track-mouse debugger-outer-track-mouse) (last-command debugger-outer-last-command) (this-command debugger-outer-this-command) (unread-command-char debugger-outer-unread-command-char) (unread-command-events debugger-outer-unread-command-events) (last-input-event debugger-outer-last-input-event) (last-command-event debugger-outer-last-command-event) (last-nonmenu-event debugger-outer-last-nonmenu-event) (last-event-frame debugger-outer-last-event-frame) (standard-input debugger-outer-standard-input) (standard-output debugger-outer-standard-output) (cursor-in-echo-area debugger-outer-cursor-in-echo-area) (overriding-local-map debugger-outer-overriding-local-map) (load-read-function debugger-outer-load-read-function)) (store-match-data debugger-outer-match-data) (prog1 (eval-expression exp) (setq debugger-outer-match-data (match-data)) (setq debugger-outer-load-read-function load-read-function) (setq debugger-outer-overriding-local-map overriding-local-map) (setq debugger-outer-track-mouse track-mouse) (setq debugger-outer-last-command last-command) (setq debugger-outer-this-command this-command) (setq debugger-outer-unread-command-char unread-command-char) (setq debugger-outer-unread-command-events unread-command-events) (setq debugger-outer-last-input-event last-input-event) (setq debugger-outer-last-command-event last-command-event) (setq debugger-outer-last-nonmenu-event last-nonmenu-event) (setq debugger-outer-last-event-frame last-event-frame) (setq debugger-outer-standard-input standard-input) (setq debugger-outer-standard-output standard-output) (setq debugger-outer-cursor-in-echo-area cursor-in-echo-area))))) (defvar debugger-mode-map nil) (if debugger-mode-map nil (let ((loop ? )) (setq debugger-mode-map (make-keymap)) (suppress-keymap debugger-mode-map) (define-key debugger-mode-map "-" 'negative-argument) (define-key debugger-mode-map "b" 'debugger-frame) (define-key debugger-mode-map "c" 'debugger-continue) (define-key debugger-mode-map "j" 'debugger-jump) (define-key debugger-mode-map "r" 'debugger-return-value) (define-key debugger-mode-map "u" 'debugger-frame-clear) (define-key debugger-mode-map "d" 'debugger-step-through) (define-key debugger-mode-map "l" 'debugger-list-functions) (define-key debugger-mode-map "h" 'describe-mode) (define-key debugger-mode-map "q" 'top-level) (define-key debugger-mode-map "e" 'debugger-eval-expression) (define-key debugger-mode-map " " 'next-line))) (put 'debugger-mode 'mode-class 'special) (defun debugger-mode () "Mode for backtrace buffers, selected in debugger. \\ A line starts with `*' if exiting that frame will call the debugger. Type \\[debugger-frame] or \\[debugger-frame-clear] to set or remove the `*'. When in debugger due to frame being exited, use the \\[debugger-return-value] command to override the value being returned from that frame. Use \\[debug-on-entry] and \\[cancel-debug-on-entry] to control which functions will enter the debugger when called. Complete list of commands: \\{debugger-mode-map}" (kill-all-local-variables) (setq major-mode 'debugger-mode) (setq mode-name "Debugger") (setq truncate-lines t) (set-syntax-table emacs-lisp-mode-syntax-table) (use-local-map debugger-mode-map)) ;;;###autoload (defun debug-on-entry (function) "Request FUNCTION to invoke debugger each time it is called. If you tell the debugger to continue, FUNCTION's execution proceeds. This works by modifying the definition of FUNCTION, which must be written in Lisp, not predefined. Use \\[cancel-debug-on-entry] to cancel the effect of this command. Redefining FUNCTION also cancels it." (interactive "aDebug on entry (to function): ") (debugger-reenable) (if (subrp (symbol-function function)) (error "Function %s is a primitive" function)) (or (consp (symbol-function function)) (debug-convert-byte-code function)) (or (consp (symbol-function function)) (error "Definition of %s is not a list" function)) (fset function (debug-on-entry-1 function (symbol-function function) t)) (or (memq function debug-function-list) (setq debug-function-list (cons function debug-function-list))) function) ;;;###autoload (defun cancel-debug-on-entry (&optional function) "Undo effect of \\[debug-on-entry] on FUNCTION. If argument is nil or an empty string, cancel for all functions." (interactive (list (let ((name (completing-read "Cancel debug on entry (to function): " ;; Make an "alist" of the functions ;; that now have debug on entry. (mapcar 'list (mapcar 'symbol-name debug-function-list)) nil t nil))) (if name (intern name))))) (debugger-reenable) (if (and function (not (string= function ""))) (progn (fset function (debug-on-entry-1 function (symbol-function function) nil)) (setq debug-function-list (delq function debug-function-list)) function) (message "Cancelling debug-on-entry for all functions") (mapcar 'cancel-debug-on-entry debug-function-list))) (defun debug-convert-byte-code (function) (let ((defn (symbol-function function))) (if (not (consp defn)) ;; Assume a compiled code object. (let* ((contents (append defn nil)) (body (list (list 'byte-code (nth 1 contents) (nth 2 contents) (nth 3 contents))))) (if (nthcdr 5 contents) (setq body (cons (list 'interactive (nth 5 contents)) body))) (if (nth 4 contents) ;; Use `documentation' here, to get the actual string, ;; in case the compiled function has a reference ;; to the .elc file. (setq body (cons (documentation function) body))) (fset function (cons 'lambda (cons (car contents) body))))))) (defun debug-on-entry-1 (function defn flag) (if (subrp defn) (error "%s is a built-in function" function) (if (eq (car defn) 'macro) (debug-on-entry-1 function (cdr defn) flag) (or (eq (car defn) 'lambda) (error "%s not user-defined Lisp function" function)) (let (tail prec) (if (stringp (car (nthcdr 2 defn))) (setq tail (nthcdr 3 defn) prec (list (car defn) (car (cdr defn)) (car (cdr (cdr defn))))) (setq tail (nthcdr 2 defn) prec (list (car defn) (car (cdr defn))))) (if (eq flag (equal (car tail) '(debug 'debug))) defn (if flag (nconc prec (cons '(debug 'debug) tail)) (nconc prec (cdr tail)))))))) (defun debugger-list-functions () "Display a list of all the functions now set to debug on entry." (interactive) (with-output-to-temp-buffer "*Help*" (if (null debug-function-list) (princ "No debug-on-entry functions now\n") (princ "Functions set to debug on entry:\n\n") (let ((list debug-function-list)) (while list (prin1 (car list)) (terpri) (setq list (cdr list)))) (princ "Note: if you have redefined a function, then it may no longer\n") (princ "be set to debug on entry, even if it is in the list.")) (save-excursion (set-buffer standard-output) (help-mode)))) ;;; debug.el ends here emacs-19.30/lisp/COPYING100666 12120 1 43070 6055530746 13146 0ustar rmsdaemon GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. 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. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. emacs-19.30/lisp/delsel.el100444 12120 24 10203 6025372060 12516 0ustar rms;;; delsel.el --- delete selection if you insert ;;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Matthieu Devin ;; Created: 14 Jul 92 ;; Last change 18-Feb-93, devin. ;;; 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 file makes the active region be pending delete, meaning that ;;; text inserted while the region is active will replace the region contents. ;;; This is a popular behavior of personal computers text editors. ;;; Code: (defvar delete-selection-mode t "*Non-nil means Delete Selection mode is enabled. In Delete Selection mode, when a region is highlighted, insertion commands first delete the region and then insert.") (defun delete-active-region (&optional killp) (if killp (kill-region (point) (mark)) (delete-region (point) (mark))) (setq mark-active nil) (run-hooks 'deactivate-mark-hook) t) (defun delete-selection-pre-hook () (if (and delete-selection-mode (not buffer-read-only) transient-mark-mode mark-active) (let ((type (and (symbolp this-command) (get this-command 'delete-selection)))) (cond ((eq type 'kill) (delete-active-region t)) ((eq type 'yank) ;; Before a yank command, ;; make sure we don't yank the same region ;; that we are going to delete. ;; That would make yank a no-op. (if (string= (buffer-substring (point) (mark)) (car kill-ring)) (current-kill 1)) (delete-active-region nil)) ((eq type 'supersede) (if (delete-active-region nil) (setq this-command '(lambda () (interactive))))) (type (delete-active-region nil)))))) (add-hook 'pre-command-hook 'delete-selection-pre-hook) (put 'self-insert-command 'delete-selection t) (put 'self-insert-iso 'delete-selection t) (put 'yank 'delete-selection 'yank) (put 'clipboard-yank 'delete-selection 'yank) (put 'insert-register 'delete-selection t) (put 'delete-backward-char 'delete-selection 'supersede) (put 'backward-delete-char-untabify 'delete-selection 'supersede) (put 'delete-char 'delete-selection 'supersede) (put 'newline-and-indent 'delete-selection 't) (put 'newline 'delete-selection t) (put 'open-line 'delete-selection t) ;;;###autoload (defalias 'pending-delete-mode 'delete-selection-mode) ;;;###autoload (defun delete-selection-mode (arg) "Toggle Delete Selection mode. When ON, typed text replaces the selection if the selection is active. When OFF, typed text is just inserted at point." (interactive "P") (setq delete-selection-mode (if (null arg) (not delete-selection-mode) (> (prefix-numeric-value arg) 0))) (force-mode-line-update)) ;; This is very useful for cancelling a selection in the minibuffer without ;; aborting the minibuffer. (defun minibuffer-keyboard-quit () "Abort recursive edit. In Delete Selection mode mode, if the mark is active, just deactivate it; then it takes a second C-g to abort the minibuffer." (interactive) (if (and delete-selection-mode transient-mark-mode mark-active) (setq deactivate-mark t) (abort-recursive-edit))) (define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit) (define-key minibuffer-local-ns-map "\C-g" 'minibuffer-keyboard-quit) (define-key minibuffer-local-completion-map "\C-g" 'minibuffer-keyboard-quit) (define-key minibuffer-local-must-match-map "\C-g" 'minibuffer-keyboard-quit) (define-key minibuffer-local-isearch-map "\C-g" 'minibuffer-keyboard-quit) (provide 'delsel) ;;; delsel.el ends here emacs-19.30/lisp/derived.el100444 12120 1 33035 6042352137 14041 0ustar rmsdaemon;;; derived.el -- allow inheritance of major modes. ;;; (formerly mode-clone.el) ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: David Megginson (dmeggins@aix1.uottawa.ca) ;; Maintainer: FSF ;; 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: ;; GNU Emacs is already, in a sense, object oriented -- each object ;; (buffer) belongs to a class (major mode), and that class defines ;; the relationship between messages (input events) and methods ;; (commands) by means of a keymap. ;; ;; The only thing missing is a good scheme of inheritance. It is ;; possible to simulate a single level of inheritance with generous ;; use of hooks and a bit of work -- sgml-mode, for example, also runs ;; the hooks for text-mode, and keymaps can inherit from other keymaps ;; -- but generally, each major mode ends up reinventing the wheel. ;; Ideally, someone should redesign all of Emacs's major modes to ;; follow a more conventional object-oriented system: when defining a ;; new major mode, the user should need only to name the existing mode ;; it is most similar to, then list the (few) differences. ;; ;; In the mean time, this package offers most of the advantages of ;; full inheritance with the existing major modes. The macro ;; `define-derived-mode' allows the user to make a variant of an existing ;; major mode, with its own keymap. The new mode will inherit the key ;; bindings of its parent, and will, in fact, run its parent first ;; every time it is called. For example, the commands ;; ;; (define-derived-mode hypertext-mode text-mode "Hypertext" ;; "Major mode for hypertext.\n\n\\{hypertext-mode-map}" ;; (setq case-fold-search nil)) ;; ;; (define-key hypertext-mode-map [down-mouse-3] 'do-hyper-link) ;; ;; will create a function `hypertext-mode' with its own (sparse) ;; keymap `hypertext-mode-map.' The command M-x hypertext-mode will ;; perform the following actions: ;; ;; - run the command (text-mode) to get its default setup ;; - replace the current keymap with 'hypertext-mode-map,' which will ;; inherit from 'text-mode-map'. ;; - replace the current syntax table with ;; 'hypertext-mode-syntax-table', which will borrow its defaults ;; from the current text-mode-syntax-table. ;; - replace the current abbrev table with ;; 'hypertext-mode-abbrev-table', which will borrow its defaults ;; from the current text-mode-abbrev table ;; - change the mode line to read "Hypertext" ;; - assign the value 'hypertext-mode' to the 'major-mode' variable ;; - run the body of commands provided in the macro -- in this case, ;; set the local variable `case-fold-search' to nil. ;; - **run the command (hypertext-mode-setup), which is empty by ;; default, but may be redefined by the user to contain special ;; commands (ie. setting local variables like 'outline-regexp') ;; **NOTE: do not use this option -- it will soon be obsolete. ;; - run anything assigned to 'hypertext-mode-hooks' (obsolete, but ;; supported for the sake of compatibility). ;; ;; The advantages of this system are threefold. First, text mode is ;; untouched -- if you had added the new keystroke to `text-mode-map,' ;; possibly using hooks, you would have added it to all text buffers ;; -- here, it appears only in hypertext buffers, where it makes ;; sense. Second, it is possible to build even further, and make ;; a derived mode from a derived mode. The commands ;; ;; (define-derived-mode html-mode hypertext-mode "HTML") ;; [various key definitions] ;; ;; will add a new major mode for HTML with very little fuss. ;; ;; Note also the function `derived-mode-class,' which returns the non-derived ;; major mode which a derived mode is based on (ie. NOT necessarily the ;; immediate parent). ;; ;; (derived-mode-class 'text-mode) ==> text-mode ;; (derived-mode-class 'hypertext-mode) ==> text-mode ;; (derived-mode-class 'html-mode) ==> text-mode ;;; Code: ;; PUBLIC: define a new major mode which inherits from an existing one. ;;;###autoload (defmacro define-derived-mode (child parent name &optional docstring &rest body) "Create a new mode as a variant of an existing mode. The arguments to this command are as follow: CHILD: the name of the command for the derived mode. PARENT: the name of the command for the parent mode (ie. text-mode). NAME: a string which will appear in the status line (ie. \"Hypertext\") DOCSTRING: an optional documentation string--if you do not supply one, the function will attempt to invent something useful. BODY: forms to execute just before running the hooks for the new mode. Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode: (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\") You could then make new key bindings for `LaTeX-thesis-mode-map' without changing regular LaTeX mode. In this example, BODY is empty, and DOCSTRING is generated by default. On a more complicated level, the following command uses sgml-mode as the parent, and then sets the variable `case-fold-search' to nil: (define-derived-mode article-mode sgml-mode \"Article\" \"Major mode for editing technical articles.\" (setq case-fold-search nil)) Note that if the documentation string had been left out, it would have been generated automatically, with a reference to the keymap." ; Some trickiness, since what ; appears to be the docstring ; may really be the first ; element of the body. (if (and docstring (not (stringp docstring))) (progn (setq body (cons docstring body)) (setq docstring nil))) (setq docstring (or docstring (derived-mode-make-docstring parent child))) (` (progn (derived-mode-init-mode-variables (quote (, child))) (defun (, child) () (, docstring) (interactive) ; Run the parent. ((, parent)) ; Identify special modes. (if (get (quote (, parent)) 'special) (put (quote (, child)) 'special t)) ; Identify the child mode. (setq major-mode (quote (, child))) (setq mode-name (, name)) ; Set up maps and tables. (derived-mode-set-keymap (quote (, child))) (derived-mode-set-syntax-table (quote (, child))) (derived-mode-set-abbrev-table (quote (, child))) ; Splice in the body (if any). (,@ body) ;;; ; Run the setup function, if ;;; ; any -- this will soon be ;;; ; obsolete. ;;; (derived-mode-run-setup-function (quote (, child))) ; Run the hooks, if any. (derived-mode-run-hooks (quote (, child))))))) ;; PUBLIC: find the ultimate class of a derived mode. (defun derived-mode-class (mode) "Find the class of a major mode. A mode's class is the first ancestor which is NOT a derived mode. Use the `derived-mode-parent' property of the symbol to trace backwards." (while (get mode 'derived-mode-parent) (setq mode (get mode 'derived-mode-parent))) mode) ;; Inline functions to construct various names from a mode name. (defsubst derived-mode-setup-function-name (mode) "Construct a setup-function name based on a mode name." (intern (concat (symbol-name mode) "-setup"))) (defsubst derived-mode-hooks-name (mode) "Construct a hooks name based on a mode name." (intern (concat (symbol-name mode) "-hooks"))) (defsubst derived-mode-map-name (mode) "Construct a map name based on a mode name." (intern (concat (symbol-name mode) "-map"))) (defsubst derived-mode-syntax-table-name (mode) "Construct a syntax-table name based on a mode name." (intern (concat (symbol-name mode) "-syntax-table"))) (defsubst derived-mode-abbrev-table-name (mode) "Construct an abbrev-table name based on a mode name." (intern (concat (symbol-name mode) "-abbrev-table"))) ;; Utility functions for defining a derived mode. ;;;###autoload (defun derived-mode-init-mode-variables (mode) "Initialise variables for a new mode. Right now, if they don't already exist, set up a blank keymap, an empty syntax table, and an empty abbrev table -- these will be merged the first time the mode is used." (if (boundp (derived-mode-map-name mode)) t (eval (` (defvar (, (derived-mode-map-name mode)) (make-sparse-keymap) (, (format "Keymap for %s." mode))))) (put (derived-mode-map-name mode) 'derived-mode-unmerged t)) (if (boundp (derived-mode-syntax-table-name mode)) t (eval (` (defvar (, (derived-mode-syntax-table-name mode)) ;; Make a syntax table which doesn't specify anything ;; for any char. Valid data will be merged in by ;; derived-mode-merge-syntax-tables. (make-char-table 'syntax-table nil) (, (format "Syntax table for %s." mode))))) (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t)) (if (boundp (derived-mode-abbrev-table-name mode)) t (eval (` (defvar (, (derived-mode-abbrev-table-name mode)) (progn (define-abbrev-table (derived-mode-abbrev-table-name mode) nil) (make-abbrev-table)) (, (format "Abbrev table for %s." mode))))))) (defun derived-mode-make-docstring (parent child) "Construct a docstring for a new mode if none is provided." (format "This major mode is a variant of `%s', created by `define-derived-mode'. It inherits all of the parent's attributes, but has its own keymap, abbrev table and syntax table: `%s-map' and `%s-syntax-table' which more-or-less shadow `%s-map' and `%s-syntax-table' \\{%s-map}" parent child child parent parent child)) ;; Utility functions for running a derived mode. (defun derived-mode-set-keymap (mode) "Set the keymap of the new mode, maybe merging with the parent." (let* ((map-name (derived-mode-map-name mode)) (new-map (eval map-name)) (old-map (current-local-map))) (and old-map (get map-name 'derived-mode-unmerged) (derived-mode-merge-keymaps old-map new-map)) (put map-name 'derived-mode-unmerged nil) (use-local-map new-map))) (defun derived-mode-set-syntax-table (mode) "Set the syntax table of the new mode, maybe merging with the parent." (let* ((table-name (derived-mode-syntax-table-name mode)) (old-table (syntax-table)) (new-table (eval table-name))) (if (get table-name 'derived-mode-unmerged) (derived-mode-merge-syntax-tables old-table new-table)) (put table-name 'derived-mode-unmerged nil) (set-syntax-table new-table))) (defun derived-mode-set-abbrev-table (mode) "Set the abbrev table if it exists. Always merge its parent into it, since the merge is non-destructive." (let* ((table-name (derived-mode-abbrev-table-name mode)) (old-table local-abbrev-table) (new-table (eval table-name))) (derived-mode-merge-abbrev-tables old-table new-table) (setq local-abbrev-table new-table))) ;;;(defun derived-mode-run-setup-function (mode) ;;; "Run the setup function if it exists." ;;; (let ((fname (derived-mode-setup-function-name mode))) ;;; (if (fboundp fname) ;;; (funcall fname)))) (defun derived-mode-run-hooks (mode) "Run the hooks if they exist." (let ((hooks-name (derived-mode-hooks-name mode))) (if (boundp hooks-name) (run-hooks hooks-name)))) ;; Functions to merge maps and tables. (defun derived-mode-merge-keymaps (old new) "Merge an old keymap into a new one. The old keymap is set to be the last cdr of the new one, so that there will be automatic inheritance." (let ((tail new)) ;; Scan the NEW map for prefix keys. (while (consp tail) (and (consp (car tail)) (let* ((key (vector (car (car tail)))) (subnew (lookup-key new key)) (subold (lookup-key old key))) ;; If KEY is a prefix key in both OLD and NEW, merge them. (and (keymapp subnew) (keymapp subold) (derived-mode-merge-keymaps subold subnew)))) (and (vectorp (car tail)) ;; Search a vector of ASCII char bindings for prefix keys. (let ((i (1- (length (car tail))))) (while (>= i 0) (let* ((key (vector i)) (subnew (lookup-key new key)) (subold (lookup-key old key))) ;; If KEY is a prefix key in both OLD and NEW, merge them. (and (keymapp subnew) (keymapp subold) (derived-mode-merge-keymaps subold subnew))) (setq i (1- i))))) (setq tail (cdr tail)))) (setcdr (nthcdr (1- (length new)) new) old)) (defun derived-mode-merge-syntax-tables (old new) "Merge an old syntax table into a new one. Where the new table already has an entry, nothing is copied from the old one." (map-char-table (function (lambda (key value) (or (char-table-range new key) (set-char-table-range new key value)))) old)) ;; Merge an old abbrev table into a new one. ;; This function requires internal knowledge of how abbrev tables work, ;; presuming that they are obarrays with the abbrev as the symbol, the expansion ;; as the value of the symbol, and the hook as the function definition. (defun derived-mode-merge-abbrev-tables (old new) (if old (mapatoms (function (lambda (symbol) (or (intern-soft (symbol-name symbol) new) (define-abbrev new (symbol-name symbol) (symbol-value symbol) (symbol-function symbol))))) old))) (provide 'derived) ;;; derived.el ends here emacs-19.30/lisp/desktop.el100444 12120 1 47036 6034641673 14105 0ustar rmsdaemon;;; desktop.el --- save partial status of Emacs when killed ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Morten Welinder ;; Keywords: customization ;; Favourite-brand-of-beer: None, I hate beer. ;; 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: ;; Save the Desktop, i.e., ;; - some global variables ;; - the list of buffers with associated files. For each buffer also ;; - the major mode ;; - the default directory ;; - the point ;; - the mark & mark-active ;; - buffer-read-only ;; - some local variables ;; To use this, first put these three lines in the bottom of your .emacs ;; file (the later the better): ;; ;; (load "desktop") ;; (desktop-load-default) ;; (desktop-read) ;; ;; Between the second and the third line you may wish to add something that ;; updates the variables `desktop-globals-to-save' and/or ;; `desktop-locals-to-save'. If for instance you want to save the local ;; variable `foobar' for every buffer in which it is local, you could add ;; the line ;; ;; (setq desktop-locals-to-save (cons 'foobar desktop-locals-to-save)) ;; ;; To avoid saving excessive amounts of data you may also wish to add ;; something like the following ;; ;; (add-hook 'kill-emacs-hook ;; '(lambda () ;; (desktop-truncate search-ring 3) ;; (desktop-truncate regexp-search-ring 3))) ;; ;; which will make sure that no more than three search items are saved. You ;; must place this line *after* the (load "desktop") line. See also the ;; variable desktop-save-hook. ;; Start Emacs in the root directory of your "project". The desktop saver ;; is inactive by default. You activate it by M-x desktop-save RET. When ;; you exit the next time the above data will be saved. This ensures that ;; all the files you were editing will be reloaded the next time you start ;; Emacs from the same directory and that points will be set where you ;; left them. If you save a desktop file in your home directory it will ;; act as a default desktop when you start Emacs from a directory that ;; doesn't have its own. I never do this, but you may want to. ;; By the way: don't use desktop.el to customize Emacs -- the file .emacs ;; in your home directory is used for that. Saving global default values ;; for buffers is an example of misuse. ;; PLEASE NOTE: The kill ring can be saved as specified by the variable ;; `desktop-globals-to-save' (by default it isn't). This may result in saving ;; things you did not mean to keep. Use M-x desktop-clear RET. ;; Thanks to hetrick@phys.uva.nl (Jim Hetrick) for useful ideas. ;; avk@rtsg.mot.com (Andrew V. Klein) for a dired tip. ;; chris@tecc.co.uk (Chris Boucher) for a mark tip. ;; f89-kam@nada.kth.se (Klas Mellbourn) for a mh-e tip. ;; kifer@sbkifer.cs.sunysb.edu (M. Kifer) for a bug hunt. ;; treese@lcs.mit.edu (Win Treese) for ange-ftp tips. ;; --------------------------------------------------------------------------- ;; TODO: ;; ;; Save window configuration. ;; Recognize more minor modes. ;; Save mark rings. ;; Start-up with buffer-menu??? ;;; Code: ;; Make the compilation more silent (eval-when-compile ;; We use functions from these modules ;; We can't (require 'mh-e) since that wants to load something. (mapcar 'require '(info dired reporter))) ;; ---------------------------------------------------------------------------- ;; USER OPTIONS -- settings you might want to play with. ;; ---------------------------------------------------------------------------- (defconst desktop-basefilename (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt)) "emacs.dsk" ; Ms-Dos does not support multiple dots in file name ".emacs.desktop") "File for Emacs desktop, not including the directory name.") (defvar desktop-missing-file-warning t "*If non-nil then desktop warns when a file no longer exists. Otherwise it simply ignores that file.") (defvar desktop-globals-to-save (list 'desktop-missing-file-warning ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer ;; 'kill-ring 'tags-file-name 'tags-table-list 'search-ring 'regexp-search-ring 'register-alist ;; 'desktop-globals-to-save ; Itself! ) "List of global variables to save when killing Emacs. An element may be variable name (a symbol) or a cons cell of the form (VAR . MAX-SIZE), which means to truncate VAR's value to at most MAX-SIZE elements \(if the value is a list) before saving the value.") (defvar desktop-locals-to-save (list 'desktop-locals-to-save ; Itself! Think it over. 'truncate-lines 'case-fold-search 'case-replace 'fill-column 'overwrite-mode 'change-log-default-name 'line-number-mode ) "List of local variables to save for each buffer. The variables are saved only when they really are local.") (make-variable-buffer-local 'desktop-locals-to-save) ;; We skip .log files because they are normally temporary. ;; (ftp) files because they require passwords and whatsnot. ;; TAGS files to save time (tags-file-name is saved instead). (defvar desktop-buffers-not-to-save "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$" "Regexp identifying buffers that are to be excluded from saving.") ;; Skip ange-ftp files (defvar desktop-files-not-to-save "^/[^/:]*:" "Regexp identifying files whose buffers are to be excluded from saving.") (defvar desktop-buffer-handlers '(desktop-buffer-dired desktop-buffer-rmail desktop-buffer-mh desktop-buffer-info desktop-buffer-file) "*List of functions to call in order to create a buffer. The functions are called without explicit parameters but may access the the major mode as `mam', the file name as `fn', the buffer name as `bn', the default directory as `dd'. If some function returns non-nil no further functions are called. If the function returns t then the buffer is considered created.") (defvar desktop-create-buffer-form "(desktop-create-buffer 205" "Opening of form for creation of new buffers.") (defvar desktop-save-hook nil "Hook run before saving the desktop to allow you to cut history lists and the like shorter.") ;; ---------------------------------------------------------------------------- (defvar desktop-dirname nil "The directory in which the current desktop file resides.") (defconst desktop-header ";; -------------------------------------------------------------------------- ;; Desktop File for Emacs ;; -------------------------------------------------------------------------- " "*Header to place in Desktop file.") (defvar desktop-delay-hook nil "Hooks run after all buffers are loaded; intended for internal use.") ;; ---------------------------------------------------------------------------- (defun desktop-truncate (l n) "Truncate LIST to at most N elements destructively." (let ((here (nthcdr (1- n) l))) (if (consp here) (setcdr here nil)))) ;; ---------------------------------------------------------------------------- (defun desktop-clear () "Empty the Desktop." (interactive) (setq kill-ring nil kill-ring-yank-pointer nil search-ring nil search-ring-yank-pointer nil regexp-search-ring nil regexp-search-ring-yank-pointer nil) (mapcar (function kill-buffer) (buffer-list)) (delete-other-windows)) ;; ---------------------------------------------------------------------------- (add-hook 'kill-emacs-hook 'desktop-kill) (defun desktop-kill () (if desktop-dirname (condition-case err (desktop-save desktop-dirname) (file-error (if (yes-or-no-p "Error while saving the desktop. Quit anyway? ") nil (signal (car err) (cdr err))))))) ;; ---------------------------------------------------------------------------- (defun desktop-internal-v2s (val) "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE. TXT is a string that when read and evaluated yields value. QUOTE may be `may' (value may be quoted), `must' (values must be quoted), or nil (value may not be quoted)." (cond ((or (numberp val) (null val) (eq t val)) (cons 'may (prin1-to-string val))) ((stringp val) (let ((copy (copy-sequence val))) (set-text-properties 0 (length copy) nil copy) ;; Get rid of text properties because we cannot read them (cons 'may (prin1-to-string copy)))) ((symbolp val) (cons 'must (prin1-to-string val))) ((vectorp val) (let* ((special nil) (pass1 (mapcar (lambda (el) (let ((res (desktop-internal-v2s el))) (if (null (car res)) (setq special t)) res)) val))) (if special (cons nil (concat "(vector " (mapconcat (lambda (el) (if (eq (car el) 'must) (concat "'" (cdr el)) (cdr el))) pass1 " ") ")")) (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]"))))) ((consp val) (let ((p val) newlist anynil) (while (consp p) (let ((q.txt (desktop-internal-v2s (car p)))) (or anynil (setq anynil (null (car q.txt)))) (setq newlist (cons q.txt newlist))) (setq p (cdr p))) (if p (let ((last (desktop-internal-v2s p)) (el (car newlist))) (setcar newlist (if (or anynil (setq anynil (null (car last)))) (cons nil (concat "(cons " (if (eq (car el) 'must) "'" "") (cdr el) " " (if (eq (car last) 'must) "'" "") (cdr last) ")")) (cons 'must (concat (cdr el) " . " (cdr last))))))) (setq newlist (nreverse newlist)) (if anynil (cons nil (concat "(list " (mapconcat (lambda (el) (if (eq (car el) 'must) (concat "'" (cdr el)) (cdr el))) newlist " ") ")")) (cons 'must (concat "(" (mapconcat 'cdr newlist " ") ")"))))) ((subrp val) (cons nil (concat "(symbol-function '" (substring (prin1-to-string val) 7 -1) ")"))) ((markerp val) (let ((pos (prin1-to-string (marker-position val))) (buf (prin1-to-string (buffer-name (marker-buffer val))))) (cons nil (concat "(let ((mk (make-marker)))" " (add-hook 'desktop-delay-hook" " (list 'lambda '() (list 'set-marker mk " pos " (get-buffer " buf ")))) mk)")))) (t ; save as text (cons 'may "\"Unprintable entity\"")))) (defun desktop-value-to-string (val) "Convert VALUE to a string that when read evaluates to the same value. Not all types of values are supported." (let* ((print-escape-newlines t) (float-output-format nil) (quote.txt (desktop-internal-v2s val)) (quote (car quote.txt)) (txt (cdr quote.txt))) (if (eq quote 'must) (concat "'" txt) txt))) ;; ---------------------------------------------------------------------------- (defun desktop-outvar (varspec) "Output a setq statement for variable VAR to the desktop file. The argument VARSPEC may be the variable name VAR (a symbol), or a cons cell of the form (VAR . MAX-SIZE), which means to truncate VAR's value to at most MAX-SIZE elements \(if the value is a list) before saving the value." (let (var size) (if (consp varspec) (setq var (car varspec) size (cdr varspec)) (setq var varspec)) (if (boundp var) (progn (if (and (integerp size) (> size 0) (listp (eval var))) (desktop-truncate (eval var) size)) (insert "(setq " (symbol-name var) " " (desktop-value-to-string (symbol-value var)) ")\n"))))) ;; ---------------------------------------------------------------------------- (defun desktop-save-buffer-p (filename bufname mode &rest dummy) "Return t if the desktop should record a particular buffer for next startup. FILENAME is the visited file name, BUFNAME is the buffer name, and MODE is the major mode." (let ((case-fold-search nil)) (or (and filename (not (string-match desktop-buffers-not-to-save bufname)) (not (string-match desktop-files-not-to-save filename))) (and (eq mode 'dired-mode) (save-excursion (set-buffer (get-buffer bufname)) (not (string-match desktop-files-not-to-save default-directory)))) (and (null filename) (memq mode '(Info-mode rmail-mode)))))) ;; ---------------------------------------------------------------------------- (defun desktop-save (dirname) "Save the Desktop file. Parameter DIRNAME specifies where to save desktop." (interactive "DDirectory to save desktop file in: ") (run-hooks 'desktop-save-hook) (save-excursion (let ((filename (expand-file-name (concat dirname desktop-basefilename))) (info (nreverse (mapcar (function (lambda (b) (set-buffer b) (list (buffer-file-name) (buffer-name) major-mode (list ; list explaining minor modes (not (null auto-fill-function))) (point) (list (mark t) mark-active) buffer-read-only (cond ((eq major-mode 'Info-mode) (list Info-current-file Info-current-node)) ((eq major-mode 'dired-mode) (cons (expand-file-name dired-directory) (cdr (nreverse (mapcar (function car) dired-subdir-alist)))))) (let ((locals desktop-locals-to-save) (loclist (buffer-local-variables)) (ll)) (while locals (let ((here (assq (car locals) loclist))) (if here (setq ll (cons here ll)) (if (member (car locals) loclist) (setq ll (cons (car locals) ll))))) (setq locals (cdr locals))) ll) ))) (buffer-list)))) (buf (get-buffer-create "*desktop*"))) (set-buffer buf) (erase-buffer) (insert desktop-header ";; Created " (current-time-string) "\n" ";; Emacs version " emacs-version "\n\n" ";; Global section:\n") (mapcar (function desktop-outvar) desktop-globals-to-save) (if (memq 'kill-ring desktop-globals-to-save) (insert "(setq kill-ring-yank-pointer (nthcdr " (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer))) " kill-ring))\n")) (insert "\n;; Buffer section:\n") (mapcar (function (lambda (l) (if (apply 'desktop-save-buffer-p l) (progn (insert desktop-create-buffer-form) (mapcar (function (lambda (e) (insert "\n " (desktop-value-to-string e)))) l) (insert ")\n\n"))))) info) (setq default-directory dirname) (if (file-exists-p filename) (delete-file filename)) (write-region (point-min) (point-max) filename nil 'nomessage))) (setq desktop-dirname dirname)) ;; ---------------------------------------------------------------------------- (defun desktop-remove () "Delete the Desktop file and inactivate the desktop system." (interactive) (if desktop-dirname (let ((filename (concat desktop-dirname desktop-basefilename))) (setq desktop-dirname nil) (if (file-exists-p filename) (delete-file filename))))) ;; ---------------------------------------------------------------------------- (defun desktop-read () "Read the Desktop file and the files it specifies." (interactive) (let ((filename)) (if (file-exists-p (concat "./" desktop-basefilename)) (setq desktop-dirname (expand-file-name "./")) (if (file-exists-p (concat "~/" desktop-basefilename)) (setq desktop-dirname (expand-file-name "~/")) (setq desktop-dirname nil))) (if desktop-dirname (progn (load (concat desktop-dirname desktop-basefilename) t t t) (run-hooks 'desktop-delay-hook) (message "Desktop loaded.")) (desktop-clear)))) ;; ---------------------------------------------------------------------------- (defun desktop-load-default () "Load the `default' start-up library manually. Also inhibit further loading of it. Call this from your `.emacs' file to provide correct modes for autoloaded files." (if (not inhibit-default-init) ; safety check (progn (load "default" t t) (setq inhibit-default-init t)))) ;; ---------------------------------------------------------------------------- ;; Note: the following functions use the dynamic variable binding in Lisp. ;; (defun desktop-buffer-info () "Load an info file." (if (eq 'Info-mode mam) (progn (require 'info) (Info-find-node (nth 0 misc) (nth 1 misc)) t))) ;; ---------------------------------------------------------------------------- (defun desktop-buffer-rmail () "Load an RMAIL file." (if (eq 'rmail-mode mam) (condition-case error (progn (rmail-input fn) t) (file-locked (kill-buffer (current-buffer)) 'ignored)))) ;; ---------------------------------------------------------------------------- (defun desktop-buffer-mh () "Load a folder in the mh system." (if (eq 'mh-folder-mode mam) (progn (require 'mh-e) (mh-find-path) (mh-visit-folder bn) t))) ;; ---------------------------------------------------------------------------- (defun desktop-buffer-dired () "Load a directory using dired." (if (eq 'dired-mode mam) (if (file-directory-p (file-name-directory (car misc))) (progn (dired (car misc)) (mapcar 'dired-insert-subdir (cdr misc)) t) (message "Directory %s no longer exists." (car misc)) (sit-for 1) 'ignored))) ;; ---------------------------------------------------------------------------- (defun desktop-buffer-file () "Load a file." (if fn (if (or (file-exists-p fn) (and desktop-missing-file-warning (y-or-n-p (format "File \"%s\" no longer exists. Re-create? " fn)))) (progn (find-file fn) t) 'ignored))) ;; ---------------------------------------------------------------------------- ;; Create a buffer, load its file, set is mode, ...; called from Desktop file ;; only. (defun desktop-create-buffer (ver fn bn mam mim pt mk ro misc &optional locals) (let ((hlist desktop-buffer-handlers) (result) (handler)) (while (and (not result) hlist) (setq handler (car hlist)) (setq result (funcall handler)) (setq hlist (cdr hlist))) (if (eq result t) (progn (if (not (equal (buffer-name) bn)) (rename-buffer bn)) (auto-fill-mode (if (nth 0 mim) 1 0)) (goto-char pt) (if (consp mk) (progn (set-mark (car mk)) (setq mark-active (car (cdr mk)))) (set-mark mk)) ;; Never override file system if the file really is read-only marked. (if ro (setq buffer-read-only ro)) (while locals (let ((this (car locals))) (if (consp this) ;; an entry of this form `(symbol . value)' (progn (make-local-variable (car this)) (set (car this) (cdr this))) ;; an entry of the form `symbol' (make-local-variable this) (makunbound this))) (setq locals (cdr locals))) )))) ;; Backward compatibility -- update parameters to 205 standards. (defun desktop-buffer (fn bn mam mim pt mk ro tl fc cfs cr misc) (desktop-create-buffer 205 fn bn mam (cdr mim) pt mk ro misc (list (cons 'truncate-lines tl) (cons 'fill-column fc) (cons 'case-fold-search cfs) (cons 'case-replace cr) (cons 'overwrite-mode (car mim))))) ;; ---------------------------------------------------------------------------- (provide 'desktop) ;; desktop.el ends here. emacs-19.30/lisp/diary-lib.el100444 12120 1 167011 6055525357 14327 0ustar rmsdaemon;;; diary-lib.el --- diary functions. ;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995 Free Software Foundation, ;; Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; 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 collection of functions implements the diary features as described ;; in calendar.el. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (require 'calendar) ;;;###autoload (defun diary (&optional arg) "Generate the diary window for ARG days starting with the current date. If no argument is provided, the number of days of diary entries is governed by the variable `number-of-diary-entries'. This function is suitable for execution in a `.emacs' file." (interactive "P") (let ((d-file (substitute-in-file-name diary-file)) (date (calendar-current-date))) (if (and d-file (file-exists-p d-file)) (if (file-readable-p d-file) (list-diary-entries date (cond (arg (prefix-numeric-value arg)) ((vectorp number-of-diary-entries) (aref number-of-diary-entries (calendar-day-of-week date))) (t number-of-diary-entries))) (error "Your diary file is not readable!")) (error "You don't have a diary file!")))) (defun view-diary-entries (arg) "Prepare and display a buffer with diary entries. Searches the file named in `diary-file' for entries that match ARG days starting with the date indicated by the cursor position in the displayed three-month calendar." (interactive "p") (let ((d-file (substitute-in-file-name diary-file))) (if (and d-file (file-exists-p d-file)) (if (file-readable-p d-file) (list-diary-entries (calendar-cursor-to-date t) arg) (error "Diary file is not readable!")) (error "You don't have a diary file!")))) (defun view-other-diary-entries (arg diary-file) "Prepare and display buffer of diary entries from an alternative diary file. Prompts for a file name and searches that file for entries that match ARG days starting with the date indicated by the cursor position in the displayed three-month calendar." (interactive (list (cond ((null current-prefix-arg) 1) ((listp current-prefix-arg) (car current-prefix-arg)) (t current-prefix-arg)) (setq diary-file (read-file-name "Enter diary file name: " default-directory nil t)))) (view-diary-entries arg)) (autoload 'check-calendar-holidays "holidays" "Check the list of holidays for any that occur on DATE. The value returned is a list of strings of relevant holiday descriptions. The holidays are those in the list `calendar-holidays'." t) (autoload 'calendar-holiday-list "holidays" "Form the list of holidays that occur on dates in the calendar window. The holidays are those in the list `calendar-holidays'." t) (autoload 'diary-french-date "cal-french" "French calendar equivalent of date diary entry." t) (autoload 'diary-mayan-date "cal-mayan" "Mayan calendar equivalent of date diary entry." t) (autoload 'diary-julian-date "cal-julian" "Julian calendar equivalent of date diary entry." t) (autoload 'diary-astro-day-number "cal-julian" "Astronomical (Julian) day number diary entry." t) (autoload 'diary-chinese-date "cal-chinese" "Chinese calendar equivalent of date diary entry." t) (autoload 'diary-islamic-date "cal-islamic" "Islamic calendar equivalent of date diary entry." t) (autoload 'list-islamic-diary-entries "cal-islamic" "Add any Islamic date entries from the diary file to `diary-entries-list'." t) (autoload 'mark-islamic-diary-entries "cal-islamic" "Mark days in the calendar window that have Islamic date diary entries." t) (autoload 'mark-islamic-calendar-date-pattern "cal-islamic" "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR." t) (autoload 'diary-hebrew-date "cal-hebrew" "Hebrew calendar equivalent of date diary entry." t) (autoload 'diary-omer "cal-hebrew" "Omer count diary entry." t) (autoload 'diary-yahrzeit "cal-hebrew" "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before." t) (autoload 'diary-parasha "cal-hebrew" "Parasha diary entry--entry applies if date is a Saturday." t) (autoload 'diary-rosh-hodesh "cal-hebrew" "Rosh Hodesh diary entry." t) (autoload 'list-hebrew-diary-entries "cal-hebrew" "Add any Hebrew date entries from the diary file to `diary-entries-list'." t) (autoload 'mark-hebrew-diary-entries "cal-hebrew" "Mark days in the calendar window that have Hebrew date diary entries." t) (autoload 'mark-hebrew-calendar-date-pattern "cal-hebrew" "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR." t) (autoload 'diary-coptic-date "cal-coptic" "Coptic calendar equivalent of date diary entry." t) (autoload 'diary-ethiopic-date "cal-coptic" "Ethiopic calendar equivalent of date diary entry." t) (autoload 'diary-phases-of-moon "lunar" "Moon phases diary entry." t) (autoload 'diary-sunrise-sunset "solar" "Local time of sunrise and sunset as a diary entry." t) (autoload 'diary-sabbath-candles "solar" "Local time of candle lighting diary entry--applies if date is a Friday. No diary entry if there is no sunset on that date." t) (defvar diary-syntax-table (copy-syntax-table (standard-syntax-table)) "The syntax table used when parsing dates in the diary file. It is the standard syntax table used in Fundamental mode, but with the syntax of `*' changed to be a word constituent.") (modify-syntax-entry ?* "w" diary-syntax-table) (defun list-diary-entries (date number) "Create and display a buffer containing the relevant lines in diary-file. The arguments are DATE and NUMBER; the entries selected are those for NUMBER days starting with date DATE. The other entries are hidden using selective display. Returns a list of all relevant diary entries found, if any, in order by date. The list entries have the form ((month day year) string). If the variable `diary-list-include-blanks' is t, this list includes a dummy diary entry \(consisting of the empty string) for a date with no diary entries. After the list is prepared, the hooks `nongregorian-diary-listing-hook', `list-diary-entries-hook', `diary-display-hook', and `diary-hook' are run. These hooks have the following distinct roles: `nongregorian-diary-listing-hook' can cull dates from the diary and each included file. Usually used for Hebrew or Islamic diary entries in files. Applied to *each* file. `list-diary-entries-hook' adds or manipulates diary entries from external sources. Used, for example, to include diary entries from other files or to sort the diary entries. Invoked *once* only, before the display hook is run. `diary-display-hook' does the actual display of information. If this is nil, simple-diary-display will be used. Use add-hook to set this to fancy-diary-display, if desired. If you want no diary display, use add-hook to set this to ignore. `diary-hook' is run last. This can be used for an appointment notification function." (if (< 0 number) (let* ((original-date date);; save for possible use in the hooks (old-diary-syntax-table) (diary-entries-list) (date-string (calendar-date-string date)) (d-file (substitute-in-file-name diary-file))) (message "Preparing diary...") (save-excursion (let ((diary-buffer (get-file-buffer d-file))) (set-buffer (if diary-buffer diary-buffer (find-file-noselect d-file t)))) (setq selective-display t) (setq selective-display-ellipses nil) (setq old-diary-syntax-table (syntax-table)) (set-syntax-table diary-syntax-table) (unwind-protect (let ((buffer-read-only nil) (diary-modified (buffer-modified-p)) (mark (regexp-quote diary-nonmarking-symbol))) (goto-char (1- (point-max))) (if (not (looking-at "\^M\\|\n")) (progn (forward-char 1) (insert-string "\^M"))) (goto-char (point-min)) (if (not (looking-at "\^M\\|\n")) (insert-string "\^M")) (subst-char-in-region (point-min) (point-max) ?\n ?\^M t) (calendar-for-loop i from 1 to number do (let ((d diary-date-forms) (month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date)) (entry-found (list-sexp-diary-entries date))) (while d (let* ((date-form (if (equal (car (car d)) 'backup) (cdr (car d)) (car d))) (backup (equal (car (car d)) 'backup)) (dayname (concat (calendar-day-name date) "\\|" (substring (calendar-day-name date) 0 3) ".?")) (monthname (concat "\\*\\|" (calendar-month-name month) "\\|" (substring (calendar-month-name month) 0 3) ".?")) (month (concat "\\*\\|0*" (int-to-string month))) (day (concat "\\*\\|0*" (int-to-string day))) (year (concat "\\*\\|0*" (int-to-string year) (if abbreviated-calendar-year (concat "\\|" (int-to-string (% year 100))) ""))) (regexp (concat "\\(\\`\\|\^M\\|\n\\)" mark "?\\(" (mapconcat 'eval date-form "\\)\\(") "\\)")) (case-fold-search t)) (goto-char (point-min)) (while (re-search-forward regexp nil t) (if backup (re-search-backward "\\<" nil t)) (if (and (or (char-equal (preceding-char) ?\^M) (char-equal (preceding-char) ?\n)) (not (looking-at " \\|\^I"))) ;; Diary entry that consists only of date. (backward-char 1) ;; Found a nonempty diary entry--make it visible and ;; add it to the list. (setq entry-found t) (let ((entry-start (point)) (date-start)) (re-search-backward "\^M\\|\n\\|\\`") (setq date-start (point)) (re-search-forward "\^M\\|\n" nil t 2) (while (looking-at " \\|\^I") (re-search-forward "\^M\\|\n" nil t)) (backward-char 1) (subst-char-in-region date-start (point) ?\^M ?\n t) (add-to-diary-list date (buffer-substring entry-start (point))))))) (setq d (cdr d))) (or entry-found (not diary-list-include-blanks) (setq diary-entries-list (append diary-entries-list (list (list date ""))))) (setq date (calendar-gregorian-from-absolute (1+ (calendar-absolute-from-gregorian date)))) (setq entry-found nil))) (set-buffer-modified-p diary-modified)) (set-syntax-table old-diary-syntax-table)) (goto-char (point-min)) (run-hooks 'nongregorian-diary-listing-hook 'list-diary-entries-hook) (if diary-display-hook (run-hooks 'diary-display-hook) (simple-diary-display)) (run-hooks 'diary-hook) diary-entries-list)))) (defun include-other-diary-files () "Include the diary entries from other diary files with those of diary-file. This function is suitable for use in `list-diary-entries-hook'; it enables you to use shared diary files together with your own. The files included are specified in the diaryfile by lines of this form: #include \"filename\" This is recursive; that is, #include directives in diary files thus included are obeyed. You can change the `#include' to some other string by changing the variable `diary-include-string'." (goto-char (point-min)) (while (re-search-forward (concat "\\(\\`\\|\^M\\|\n\\)" (regexp-quote diary-include-string) " \"\\([^\"]*\\)\"") nil t) (let ((diary-file (substitute-in-file-name (buffer-substring (match-beginning 2) (match-end 2)))) (diary-list-include-blanks nil) (list-diary-entries-hook 'include-other-diary-files) (diary-display-hook 'ignore) (diary-hook nil)) (if (file-exists-p diary-file) (if (file-readable-p diary-file) (unwind-protect (setq diary-entries-list (append diary-entries-list (list-diary-entries original-date number))) (kill-buffer (get-file-buffer diary-file))) (beep) (message "Can't read included diary file %s" diary-file) (sleep-for 2)) (beep) (message "Can't find included diary file %s" diary-file) (sleep-for 2)))) (goto-char (point-min))) (defun simple-diary-display () "Display the diary buffer if there are any relevant entries or holidays." (let* ((holiday-list (if holidays-in-diary-buffer (check-calendar-holidays original-date))) (msg (format "No diary entries for %s %s" (concat date-string (if holiday-list ":" "")) (mapconcat 'identity holiday-list "; ")))) (if (or (not diary-entries-list) (and (not (cdr diary-entries-list)) (string-equal (car (cdr (car diary-entries-list))) ""))) (if (<= (length msg) (frame-width)) (message msg) (set-buffer (get-buffer-create holiday-buffer)) (setq buffer-read-only nil) (calendar-set-mode-line date-string) (erase-buffer) (insert (mapconcat 'identity holiday-list "\n")) (goto-char (point-min)) (set-buffer-modified-p nil) (setq buffer-read-only t) (display-buffer holiday-buffer) (message "No diary entries for %s" date-string)) (calendar-set-mode-line (concat "Diary for " date-string (if holiday-list ": " "") (mapconcat 'identity holiday-list "; "))) (display-buffer (get-file-buffer d-file)) (message "Preparing diary...done")))) (defun fancy-diary-display () "Prepare a diary buffer with relevant entries in a fancy, noneditable form. This function is provided for optional use as the `diary-display-hook'." (save-excursion;; Turn off selective-display in the diary file's buffer. (set-buffer (get-file-buffer (substitute-in-file-name diary-file))) (let ((diary-modified (buffer-modified-p))) (subst-char-in-region (point-min) (point-max) ?\^M ?\n t) (setq selective-display nil) (kill-local-variable 'mode-line-format) (set-buffer-modified-p diary-modified))) (if (or (not diary-entries-list) (and (not (cdr diary-entries-list)) (string-equal (car (cdr (car diary-entries-list))) ""))) (let* ((holiday-list (if holidays-in-diary-buffer (check-calendar-holidays original-date))) (msg (format "No diary entries for %s %s" (concat date-string (if holiday-list ":" "")) (mapconcat 'identity holiday-list "; ")))) (if (<= (length msg) (frame-width)) (message msg) (set-buffer (get-buffer-create holiday-buffer)) (setq buffer-read-only nil) (calendar-set-mode-line date-string) (erase-buffer) (insert (mapconcat 'identity holiday-list "\n")) (goto-char (point-min)) (set-buffer-modified-p nil) (setq buffer-read-only t) (display-buffer holiday-buffer) (message "No diary entries for %s" date-string))) (save-excursion;; Prepare the fancy diary buffer. (set-buffer (make-fancy-diary-buffer)) (setq buffer-read-only nil) (let ((entry-list diary-entries-list) (holiday-list) (holiday-list-last-month 1) (holiday-list-last-year 1) (date (list 0 0 0))) (while entry-list (if (not (calendar-date-equal date (car (car entry-list)))) (progn (setq date (car (car entry-list))) (and holidays-in-diary-buffer (calendar-date-compare (list (list holiday-list-last-month (calendar-last-day-of-month holiday-list-last-month holiday-list-last-year) holiday-list-last-year)) (list date)) ;; We need to get the holidays for the next 3 months. (setq holiday-list-last-month (extract-calendar-month date)) (setq holiday-list-last-year (extract-calendar-year date)) (increment-calendar-month holiday-list-last-month holiday-list-last-year 1) (setq holiday-list (let ((displayed-month holiday-list-last-month) (displayed-year holiday-list-last-year)) (calendar-holiday-list))) (increment-calendar-month holiday-list-last-month holiday-list-last-year 1)) (let* ((date-string (calendar-date-string date)) (date-holiday-list (let ((h holiday-list) (d)) ;; Make a list of all holidays for date. (while h (if (calendar-date-equal date (car (car h))) (setq d (append d (cdr (car h))))) (setq h (cdr h))) d))) (insert (if (= (point) (point-min)) "" ?\n) date-string) (if date-holiday-list (insert ": ")) (let ((l (current-column))) (insert (mapconcat 'identity date-holiday-list (concat "\n" (make-string l ? ))))) (let ((l (current-column))) (insert ?\n (make-string l ?=) ?\n))))) (if (< 0 (length (car (cdr (car entry-list))))) (insert (car (cdr (car entry-list))) ?\n)) (setq entry-list (cdr entry-list)))) (set-buffer-modified-p nil) (goto-char (point-min)) (setq buffer-read-only t) (display-buffer fancy-diary-buffer) (message "Preparing diary...done")))) (defun make-fancy-diary-buffer () "Create and return the initial fancy diary buffer." (save-excursion (set-buffer (get-buffer-create fancy-diary-buffer)) (setq buffer-read-only nil) (make-local-variable 'mode-line-format) (calendar-set-mode-line "Diary Entries") (erase-buffer) (set-buffer-modified-p nil) (setq buffer-read-only t) (get-buffer fancy-diary-buffer))) (defun print-diary-entries () "Print a hard copy of the diary display. If the simple diary display is being used, prepare a temp buffer with the visible lines of the diary buffer, add a heading line composed from the mode line, print the temp buffer, and destroy it. If the fancy diary display is being used, just print the buffer. The hooks given by the variable `print-diary-entries-hook' are called to do the actual printing." (interactive) (if (bufferp (get-buffer fancy-diary-buffer)) (save-excursion (set-buffer (get-buffer fancy-diary-buffer)) (run-hooks 'print-diary-entries-hook)) (let ((diary-buffer (get-file-buffer (substitute-in-file-name diary-file)))) (if diary-buffer (let ((temp-buffer (get-buffer-create "*Printable Diary Entries*")) (heading)) (save-excursion (set-buffer diary-buffer) (setq heading (if (not (stringp mode-line-format)) "All Diary Entries" (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format) (substring mode-line-format (match-beginning 1) (match-end 1)))) (copy-to-buffer temp-buffer (point-min) (point-max)) (set-buffer temp-buffer) (while (re-search-forward "\^M.*$" nil t) (replace-match "")) (goto-char (point-min)) (insert heading "\n" (make-string (length heading) ?=) "\n") (run-hooks 'print-diary-entries-hook) (kill-buffer temp-buffer))) (error "You don't have a diary buffer!"))))) (defun show-all-diary-entries () "Show all of the diary entries in the diary file. This function gets rid of the selective display of the diary file so that all entries, not just some, are visible. If there is no diary buffer, one is created." (interactive) (let ((d-file (substitute-in-file-name diary-file))) (if (and d-file (file-exists-p d-file)) (if (file-readable-p d-file) (save-excursion (let ((diary-buffer (get-file-buffer d-file))) (set-buffer (if diary-buffer diary-buffer (find-file-noselect d-file t))) (let ((buffer-read-only nil) (diary-modified (buffer-modified-p))) (subst-char-in-region (point-min) (point-max) ?\^M ?\n t) (setq selective-display nil) (make-local-variable 'mode-line-format) (setq mode-line-format default-mode-line-format) (display-buffer (current-buffer)) (set-buffer-modified-p diary-modified)))) (error "Your diary file is not readable!")) (error "You don't have a diary file!")))) (defun diary-name-pattern (string-array &optional fullname) "Convert an STRING-ARRAY, an array of strings to a pattern. The pattern will match any of the strings, either entirely or abbreviated to three characters. An abbreviated form will match with or without a period; If the optional FULLNAME is t, abbreviations will not match, just the full name." (let ((pattern "")) (calendar-for-loop i from 0 to (1- (length string-array)) do (setq pattern (concat pattern (if (string-equal pattern "") "" "\\|") (aref string-array i) (if fullname "" (concat "\\|" (substring (aref string-array i) 0 3) ".?"))))) pattern)) (defvar marking-diary-entries nil "True during the marking of diary entries, nil otherwise.") (defvar marking-diary-entry nil "True during the marking of diary entries, if current entry is marking.") (defun mark-diary-entries () "Mark days in the calendar window that have diary entries. Each entry in the diary file visible in the calendar window is marked. After the entries are marked, the hooks `nongregorian-diary-marking-hook' and `mark-diary-entries-hook' are run." (interactive) (setq mark-diary-entries-in-calendar t) (let ((d-file (substitute-in-file-name diary-file)) (marking-diary-entries t)) (if (and d-file (file-exists-p d-file)) (if (file-readable-p d-file) (save-excursion (message "Marking diary entries...") (set-buffer (find-file-noselect d-file t)) (let ((d diary-date-forms) (old-diary-syntax-table)) (setq old-diary-syntax-table (syntax-table)) (set-syntax-table diary-syntax-table) (while d (let* ((date-form (if (equal (car (car d)) 'backup) (cdr (car d)) (car d)));; ignore 'backup directive (dayname (diary-name-pattern calendar-day-name-array)) (monthname (concat (diary-name-pattern calendar-month-name-array) "\\|\\*")) (month "[0-9]+\\|\\*") (day "[0-9]+\\|\\*") (year "[0-9]+\\|\\*") (l (length date-form)) (d-name-pos (- l (length (memq 'dayname date-form)))) (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) (m-name-pos (- l (length (memq 'monthname date-form)))) (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) (d-pos (- l (length (memq 'day date-form)))) (d-pos (if (/= l d-pos) (+ 2 d-pos))) (m-pos (- l (length (memq 'month date-form)))) (m-pos (if (/= l m-pos) (+ 2 m-pos))) (y-pos (- l (length (memq 'year date-form)))) (y-pos (if (/= l y-pos) (+ 2 y-pos))) (regexp (concat "\\(\\`\\|\^M\\|\n\\)\\(" (mapconcat 'eval date-form "\\)\\(") "\\)")) (case-fold-search t)) (goto-char (point-min)) (while (re-search-forward regexp nil t) (let* ((dd-name (if d-name-pos (buffer-substring (match-beginning d-name-pos) (match-end d-name-pos)))) (mm-name (if m-name-pos (buffer-substring (match-beginning m-name-pos) (match-end m-name-pos)))) (mm (string-to-int (if m-pos (buffer-substring (match-beginning m-pos) (match-end m-pos)) ""))) (dd (string-to-int (if d-pos (buffer-substring (match-beginning d-pos) (match-end d-pos)) ""))) (y-str (if y-pos (buffer-substring (match-beginning y-pos) (match-end y-pos)))) (yy (if (not y-str) 0 (if (and (= (length y-str) 2) abbreviated-calendar-year) (let* ((current-y (extract-calendar-year (calendar-current-date))) (y (+ (string-to-int y-str) (* 100 (/ current-y 100))))) (if (> (- y current-y) 50) (- y 100) (if (> (- current-y y) 50) (+ y 100) y))) (string-to-int y-str))))) (if dd-name (mark-calendar-days-named (cdr (assoc (capitalize (substring dd-name 0 3)) (calendar-make-alist calendar-day-name-array 0 '(lambda (x) (substring x 0 3)))))) (if mm-name (if (string-equal mm-name "*") (setq mm 0) (setq mm (cdr (assoc (capitalize (substring mm-name 0 3)) (calendar-make-alist calendar-month-name-array 1 '(lambda (x) (substring x 0 3))) ))))) (mark-calendar-date-pattern mm dd yy)))) (setq d (cdr d)))) (mark-sexp-diary-entries) (run-hooks 'nongregorian-diary-marking-hook 'mark-diary-entries-hook) (set-syntax-table old-diary-syntax-table) (message "Marking diary entries...done"))) (error "Your diary file is not readable!")) (error "You don't have a diary file!")))) (defun mark-sexp-diary-entries () "Mark days in the calendar window that have sexp diary entries. Each entry in the diary file (or included files) visible in the calendar window is marked. See the documentation for the function `list-sexp-diary-entries'." (let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol)) (s-entry (concat "\\(\\`\\|\^M\\|\n\\)\\(" (regexp-quote sexp-mark) "(\\)\\|\\(" (regexp-quote diary-nonmarking-symbol) (regexp-quote sexp-mark) "(diary-remind\\)")) (m) (y) (first-date) (last-date)) (save-excursion (set-buffer calendar-buffer) (setq m displayed-month) (setq y displayed-year)) (increment-calendar-month m y -1) (setq first-date (calendar-absolute-from-gregorian (list m 1 y))) (increment-calendar-month m y 2) (setq last-date (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y))) (goto-char (point-min)) (while (re-search-forward s-entry nil t) (if (char-equal (preceding-char) ?\() (setq marking-diary-entry t) (setq marking-diary-entry nil)) (re-search-backward "(") (let ((sexp-start (point)) (sexp) (entry) (entry-start) (line-start)) (forward-sexp) (setq sexp (buffer-substring sexp-start (point))) (save-excursion (re-search-backward "\^M\\|\n\\|\\`") (setq line-start (point))) (forward-char 1) (if (and (or (char-equal (preceding-char) ?\^M) (char-equal (preceding-char) ?\n)) (not (looking-at " \\|\^I"))) (progn;; Diary entry consists only of the sexp (backward-char 1) (setq entry "")) (setq entry-start (point)) (re-search-forward "\^M\\|\n" nil t) (while (looking-at " \\|\^I") (re-search-forward "\^M\\|\n" nil t)) (backward-char 1) (setq entry (buffer-substring entry-start (point))) (while (string-match "[\^M]" entry) (aset entry (match-beginning 0) ?\n ))) (calendar-for-loop date from first-date to last-date do (if (diary-sexp-entry sexp entry (calendar-gregorian-from-absolute date)) (mark-visible-calendar-date (calendar-gregorian-from-absolute date)))))))) (defun mark-included-diary-files () "Mark the diary entries from other diary files with those of the diary file. This function is suitable for use as the `mark-diary-entries-hook'; it enables you to use shared diary files together with your own. The files included are specified in the diary-file by lines of this form: #include \"filename\" This is recursive; that is, #include directives in diary files thus included are obeyed. You can change the `#include' to some other string by changing the variable `diary-include-string'." (goto-char (point-min)) (while (re-search-forward (concat "\\(\\`\\|\^M\\|\n\\)" (regexp-quote diary-include-string) " \"\\([^\"]*\\)\"") nil t) (let ((diary-file (substitute-in-file-name (buffer-substring (match-beginning 2) (match-end 2)))) (mark-diary-entries-hook 'mark-included-diary-files)) (if (file-exists-p diary-file) (if (file-readable-p diary-file) (progn (mark-diary-entries) (kill-buffer (get-file-buffer diary-file))) (beep) (message "Can't read included diary file %s" diary-file) (sleep-for 2)) (beep) (message "Can't find included diary file %s" diary-file) (sleep-for 2)))) (goto-char (point-min))) (defun mark-calendar-days-named (dayname) "Mark all dates in the calendar window that are day DAYNAME of the week. 0 means all Sundays, 1 means all Mondays, and so on." (save-excursion (set-buffer calendar-buffer) (let ((prev-month displayed-month) (prev-year displayed-year) (succ-month displayed-month) (succ-year displayed-year) (last-day) (day)) (increment-calendar-month succ-month succ-year 1) (increment-calendar-month prev-month prev-year -1) (setq day (calendar-absolute-from-gregorian (calendar-nth-named-day 1 dayname prev-month prev-year))) (setq last-day (calendar-absolute-from-gregorian (calendar-nth-named-day -1 dayname succ-month succ-year))) (while (<= day last-day) (mark-visible-calendar-date (calendar-gregorian-from-absolute day)) (setq day (+ day 7)))))) (defun mark-calendar-date-pattern (month day year) "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. A value of 0 in any position is a wildcard." (save-excursion (set-buffer calendar-buffer) (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y -1) (calendar-for-loop i from 0 to 2 do (mark-calendar-month m y month day year) (increment-calendar-month m y 1))))) (defun mark-calendar-month (month year p-month p-day p-year) "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. A value of 0 in any position of the pattern is a wildcard." (if (or (and (= month p-month) (or (= p-year 0) (= year p-year))) (and (= p-month 0) (or (= p-year 0) (= year p-year)))) (if (= p-day 0) (calendar-for-loop i from 1 to (calendar-last-day-of-month month year) do (mark-visible-calendar-date (list month i year))) (mark-visible-calendar-date (list month p-day year))))) (defun sort-diary-entries () "Sort the list of diary entries by time of day." (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) (defun diary-entry-compare (e1 e2) "Returns t if E1 is earlier than E2." (or (calendar-date-compare e1 e2) (and (calendar-date-equal (car e1) (car e2)) (< (diary-entry-time (car (cdr e1))) (diary-entry-time (car (cdr e2))))))) (defun diary-entry-time (s) "Time at the beginning of the string S in a military-style integer. For example, returns 1325 for 1:25pm. Returns -9999 if no time is recognized. The recognized forms are XXXX or X:XX or XX:XX (military time), XXam or XXpm, and XX:XXam or XX:XXpm." (cond ((string-match;; Military time "^[ \t]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s) (+ (* 100 (string-to-int (substring s (match-beginning 1) (match-end 1)))) (string-to-int (substring s (match-beginning 2) (match-end 2))))) ((string-match;; Hour only XXam or XXpm "^[ \t]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) (+ (* 100 (% (string-to-int (substring s (match-beginning 1) (match-end 1))) 12)) (if (string-equal "a" (substring s (match-beginning 2) (match-end 2))) 0 1200))) ((string-match;; Hour and minute XX:XXam or XX:XXpm "^[ \t]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) (+ (* 100 (% (string-to-int (substring s (match-beginning 1) (match-end 1))) 12)) (string-to-int (substring s (match-beginning 2) (match-end 2))) (if (string-equal "a" (substring s (match-beginning 3) (match-end 3))) 0 1200))) (t -9999)));; Unrecognizable (defun list-sexp-diary-entries (date) "Add sexp entries for DATE from the diary file to `diary-entries-list'. Also, Make them visible in the diary file. Returns t if any entries were found. Sexp diary entries must be prefaced by a `sexp-diary-entry-symbol' (normally `%%'). The form of a sexp diary entry is %%(SEXP) ENTRY Both ENTRY and DATE are globally available when the SEXP is evaluated. If the SEXP yields the value nil, the diary entry does not apply. If it yields a non-nil value, ENTRY will be taken to apply to DATE; if the non-nil value is a string, that string will be the diary entry in the fancy diary display. For example, the following diary entry will apply to the 21st of the month if it is a weekday and the Friday before if the 21st is on a weekend: &%%(let ((dayname (calendar-day-of-week date)) (day (extract-calendar-day date))) (or (and (= day 21) (memq dayname '(1 2 3 4 5))) (and (memq day '(19 20)) (= dayname 5))) ) UIUC pay checks deposited A number of built-in functions are available for this type of diary entry: %%(diary-date MONTH DAY YEAR) text Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil, and DAY, MONTH, YEAR if `european-calendar-style' is t. DAY, MONTH, and YEAR can be lists of integers, the constant t, or an integer. The constant t means all values. %%(diary-float MONTH DAYNAME N) text Entry will appear on the Nth DAYNAME of MONTH. (DAYNAME=0 means Sunday, 1 means Monday, and so on; if N is negative it counts backward from the end of the month. MONTH can be a list of months, a single month, or t to specify all months. %%(diary-block M1 D1 Y1 M2 D2 Y2) text Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2, inclusive. (If `european-calendar-style' is t, the order of the parameters should be changed to D1, M1, Y1, D2, M2, Y2.) %%(diary-anniversary MONTH DAY YEAR) text Entry will appear on anniversary dates of MONTH DAY, YEAR. (If `european-calendar-style' is t, the order of the parameters should be changed to DAY, MONTH, YEAR.) Text can contain %d or %d%s; %d will be replaced by the number of years since the MONTH DAY, YEAR and %s will be replaced by the ordinal ending of that number (that is, `st', `nd', `rd' or `th', as appropriate. The anniversary of February 29 is considered to be March 1 in a non-leap year. %%(diary-cyclic N MONTH DAY YEAR) text Entry will appear every N days, starting MONTH DAY, YEAR. (If `european-calendar-style' is t, the order of the parameters should be changed to N, DAY, MONTH, YEAR.) Text can contain %d or %d%s; %d will be replaced by the number of repetitions since the MONTH DAY, YEAR and %s will be replaced by the ordinal ending of that number (that is, `st', `nd', `rd' or `th', as appropriate. %%(diary-remind SEXP DAYS &optional MARKING) text Entry is a reminder for diary sexp SEXP. DAYS is either a single number or a list of numbers indicating the number(s) of days before the event that the warning(s) should occur. If the current date is (one of) DAYS before the event indicated by EXPR, then a suitable message (as specified by `diary-remind-message') appears. In addition to the reminders beforehand, the diary entry also appears on the date itself. If optional MARKING is non-nil then the *reminders* are marked on the calendar. Marking of reminders is independent of whether the entry *itself* is a marking or nonmarking one. %%(diary-day-of-year) Diary entries giving the day of the year and the number of days remaining in the year will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-iso-date) Diary entries giving the corresponding ISO commercial date will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-french-date) Diary entries giving the corresponding French Revolutionary date will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-islamic-date) Diary entries giving the corresponding Islamic date will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-hebrew-date) Diary entries giving the corresponding Hebrew date will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-astro-day-number) Diary entries giving the corresponding astronomical (Julian) day number will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-julian-date) Diary entries giving the corresponding Julian date will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-sunrise-sunset) Diary entries giving the local times of sunrise and sunset will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. Floating point required. %%(diary-phases-of-moon) Diary entries giving the times of the phases of the moon will be when appropriate. Note that since there is no text, it makes sense only if the fancy diary display is used. Floating point required. %%(diary-yahrzeit MONTH DAY YEAR) text Text is assumed to be the name of the person; the date is the date of death on the *civil* calendar. The diary entry will appear on the proper Hebrew-date anniversary and on the day before. (If `european-calendar-style' is t, the order of the parameters should be changed to DAY, MONTH, YEAR.) %%(diary-rosh-hodesh) Diary entries will be made on the dates of Rosh Hodesh on the Hebrew calendar. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-parasha) Diary entries giving the weekly parasha will be made on every Saturday. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-omer) Diary entries giving the omer count will be made every day from Passover to Shavuoth. Note that since there is no text, it makes sense only if the fancy diary display is used. Marking these entries is *extremely* time consuming, so these entries are best if they are nonmarking." (let* ((mark (regexp-quote diary-nonmarking-symbol)) (sexp-mark (regexp-quote sexp-diary-entry-symbol)) (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "(")) (entry-found)) (goto-char (point-min)) (while (re-search-forward s-entry nil t) (backward-char 1) (let ((sexp-start (point)) (sexp) (entry) (entry-start) (line-start)) (forward-sexp) (setq sexp (buffer-substring sexp-start (point))) (save-excursion (re-search-backward "\^M\\|\n\\|\\`") (setq line-start (point))) (forward-char 1) (if (and (or (char-equal (preceding-char) ?\^M) (char-equal (preceding-char) ?\n)) (not (looking-at " \\|\^I"))) (progn;; Diary entry consists only of the sexp (backward-char 1) (setq entry "")) (setq entry-start (point)) (re-search-forward "\^M\\|\n" nil t) (while (looking-at " \\|\^I") (re-search-forward "\^M\\|\n" nil t)) (backward-char 1) (setq entry (buffer-substring entry-start (point))) (while (string-match "[\^M]" entry) (aset entry (match-beginning 0) ?\n ))) (let ((diary-entry (diary-sexp-entry sexp entry date))) (if diary-entry (subst-char-in-region line-start (point) ?\^M ?\n t)) (add-to-diary-list date diary-entry) (setq entry-found (or entry-found diary-entry))))) entry-found)) (defun diary-sexp-entry (sexp entry date) "Process a SEXP diary ENTRY for DATE." (let ((result (if calendar-debug-sexp (let ((stack-trace-on-error t)) (eval (car (read-from-string sexp)))) (condition-case nil (eval (car (read-from-string sexp))) (error (beep) (message "Bad sexp at line %d in %s: %s" (save-excursion (save-restriction (narrow-to-region 1 (point)) (goto-char (point-min)) (let ((lines 1)) (while (re-search-forward "\n\\|\^M" nil t) (setq lines (1+ lines))) lines))) diary-file sexp) (sleep-for 2)))))) (if (stringp result) result (if result entry nil)))) (defun diary-date (month day year) "Specific date(s) diary entry. Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil, and DAY, MONTH, YEAR if `european-calendar-style' is t. DAY, MONTH, and YEAR can be lists of integers, the constant t, or an integer. The constant t means all values." (let* ((dd (if european-calendar-style month day)) (mm (if european-calendar-style day month)) (m (extract-calendar-month date)) (y (extract-calendar-year date)) (d (extract-calendar-day date))) (if (and (or (and (listp dd) (memq d dd)) (equal d dd) (eq dd t)) (or (and (listp mm) (memq m mm)) (equal m mm) (eq mm t)) (or (and (listp year) (memq y year)) (equal y year) (eq year t))) entry))) (defun diary-block (m1 d1 y1 m2 d2 y2) "Block diary entry. Entry applies if date is between two dates. Order of the parameters is M1, D1, Y1, M2, D2, Y2 `european-calendar-style' is nil, and D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t." (let ((date1 (calendar-absolute-from-gregorian (if european-calendar-style (list d1 m1 y1) (list m1 d1 y1)))) (date2 (calendar-absolute-from-gregorian (if european-calendar-style (list d2 m2 y2) (list m2 d2 y2)))) (d (calendar-absolute-from-gregorian date))) (if (and (<= date1 d) (<= d date2)) entry))) (defun diary-float (month dayname n) "Floating diary entry--entry applies if date is the nth dayname of month. Parameters are MONTH, DAYNAME, N. MONTH can be a list of months, the constant t, or an integer. The constant t means all months. If N is negative, count backward from the end of the month." (let ((m (extract-calendar-month date)) (y (extract-calendar-year date))) (if (and (or (and (listp month) (memq m month)) (equal m month) (eq month t)) (calendar-date-equal date (calendar-nth-named-day n dayname m y))) entry))) (defun diary-anniversary (month day year) "Anniversary diary entry. Entry applies if date is the anniversary of MONTH, DAY, YEAR if `european-calendar-style' is nil, and DAY, MONTH, YEAR if `european-calendar-style' is t. Diary entry can contain `%d' or `%d%s'; the %d will be replaced by the number of years since the MONTH DAY, YEAR and the %s will be replaced by the ordinal ending of that number (that is, `st', `nd', `rd' or `th', as appropriate. The anniversary of February 29 is considered to be March 1 in non-leap years." (let* ((d (if european-calendar-style month day)) (m (if european-calendar-style day month)) (y (extract-calendar-year date)) (diff (- y year))) (if (and (= m 2) (= d 29) (not (calendar-leap-year-p y))) (setq m 3 d 1)) (if (and (> diff 0) (calendar-date-equal (list m d y) date)) (format entry diff (diary-ordinal-suffix diff))))) (defun diary-cyclic (n month day year) "Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR. If `european-calendar-style' is t, parameters are N, DAY, MONTH, YEAR. ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of years since the MONTH DAY, YEAR and the %s will be replaced by the ordinal ending of that number (that is, `st', `nd', `rd' or `th', as appropriate." (let* ((d (if european-calendar-style month day)) (m (if european-calendar-style day month)) (diff (- (calendar-absolute-from-gregorian date) (calendar-absolute-from-gregorian (list m d year)))) (cycle (/ diff n))) (if (and (>= diff 0) (zerop (% diff n))) (format entry cycle (diary-ordinal-suffix cycle))))) (defun diary-ordinal-suffix (n) "Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)" (if (or (memq (% n 100) '(11 12 13)) (< 3 (% n 10))) "th" (aref ["th" "st" "nd" "rd"] (% n 10)))) (defun diary-day-of-year () "Day of year and number of days remaining in the year of date diary entry." (calendar-day-of-year-string date)) (defvar diary-remind-message '("Reminder: Only " (if (= 0 (% days 7)) (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks")) (concat (int-to-string days) (if (= 1 days) " day" " days"))) " until " diary-entry) "*Pseudo-pattern giving form of reminder messages in the fancy diary display. Used by the function `diary-remind', a pseudo-pattern is a list of expressions that can involve the keywords `days' (a number), `date' (a list of month, day, year), and `diary-entry' (a string).") (defun diary-remind (sexp days &optional marking) "Provide a reminder of a diary entry. SEXP is a diary-sexp. DAYS is either a single number or a list of numbers indicating the number(s) of days before the event that the warning(s) should occur on. If the current date is (one of) DAYS before the event indicated by SEXP, then a suitable message (as specified by `diary-remind-message' is returned. In addition to the reminders beforehand, the diary entry also appears on the date itself. If optional parameter MARKING is non-nil then the reminders are marked on the calendar. Marking of reminders is independent of whether the entry itself is a marking or nonmarking one." (let ((diary-entry)) (if (or (not marking-diary-entries) marking) (cond ((integerp days) (let ((date (calendar-gregorian-from-absolute (+ (calendar-absolute-from-gregorian date) days)))) (if (setq diary-entry (eval sexp)) (setq diary-entry (mapconcat 'eval diary-remind-message ""))))) ((and (listp days) days) (setq diary-entry (diary-remind sexp (car days) marking)) (if (not diary-entry) (setq diary-entry (diary-remind sexp (cdr days) marking)))))) (or diary-entry (and (or (not marking-diary-entries) marking-diary-entry) (eval sexp))))) (defun add-to-diary-list (date string) "Add the entry (DATE STRING) to `diary-entries-list'. Do nothing if DATE or STRING is nil." (and date string (setq diary-entries-list (append diary-entries-list (list (list date string)))))) (defun make-diary-entry (string &optional nonmarking file) "Insert a diary entry STRING which may be NONMARKING in FILE. If omitted, NONMARKING defaults to nil and FILE defaults to diary-file." (find-file-other-window (substitute-in-file-name (if file file diary-file))) (goto-char (point-max)) (insert (if (bolp) "" "\n") (if nonmarking diary-nonmarking-symbol "") string " ")) (defun insert-diary-entry (arg) "Insert a diary entry for the date indicated by point. Prefix arg will make the entry nonmarking." (interactive "P") (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t t) arg)) (defun insert-weekly-diary-entry (arg) "Insert a weekly diary entry for the day of the week indicated by point. Prefix arg will make the entry nonmarking." (interactive "P") (make-diary-entry (calendar-day-name (calendar-cursor-to-date t)) arg)) (defun insert-monthly-diary-entry (arg) "Insert a monthly diary entry for the day of the month indicated by point. Prefix arg will make the entry nonmarking." (interactive "P") (let* ((calendar-date-display-form (if european-calendar-style '(day " * ") '("* " day)))) (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t) arg))) (defun insert-yearly-diary-entry (arg) "Insert an annual diary entry for the day of the year indicated by point. Prefix arg will make the entry nonmarking." (interactive "P") (let* ((calendar-date-display-form (if european-calendar-style '(day " " monthname) '(monthname " " day)))) (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t) arg))) (defun insert-anniversary-diary-entry (arg) "Insert an anniversary diary entry for the date given by point. Prefix arg will make the entry nonmarking." (interactive "P") (let* ((calendar-date-display-form (if european-calendar-style '(day " " month " " year) '(month " " day " " year)))) (make-diary-entry (format "%s(diary-anniversary %s)" sexp-diary-entry-symbol (calendar-date-string (calendar-cursor-to-date t) nil t)) arg))) (defun insert-block-diary-entry (arg) "Insert a block diary entry for the days between the point and marked date. Prefix arg will make the entry nonmarking." (interactive "P") (let* ((calendar-date-display-form (if european-calendar-style '(day " " month " " year) '(month " " day " " year))) (cursor (calendar-cursor-to-date t)) (mark (or (car calendar-mark-ring) (error "No mark set in this buffer"))) (start) (end)) (if (< (calendar-absolute-from-gregorian mark) (calendar-absolute-from-gregorian cursor)) (setq start mark end cursor) (setq start cursor end mark)) (make-diary-entry (format "%s(diary-block %s %s)" sexp-diary-entry-symbol (calendar-date-string start nil t) (calendar-date-string end nil t)) arg))) (defun insert-cyclic-diary-entry (arg) "Insert a cyclic diary entry starting at the date given by point. Prefix arg will make the entry nonmarking." (interactive "P") (let* ((calendar-date-display-form (if european-calendar-style '(day " " month " " year) '(month " " day " " year)))) (make-diary-entry (format "%s(diary-cyclic %d %s)" sexp-diary-entry-symbol (calendar-read "Repeat every how many days: " '(lambda (x) (> x 0))) (calendar-date-string (calendar-cursor-to-date t) nil t)) arg))) (provide 'diary-lib) ;;; diary-lib.el ends here emacs-19.30/lisp/diff.el100444 12120 1 23555 5653300207 13333 0ustar rmsdaemon;;; diff.el --- Run `diff' in compilation-mode. ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc. ;; Keywords: unix, tools ;; 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 package helps you explore differences between files, using the ;; UNIX command diff(1). The commands are `diff' and `diff-backup'. ;; You can specify options with `diff-switches'. ;;; Code: (require 'compile) ;;; This is duplicated in vc.el. (defvar diff-switches "-c" "*A string or list of strings specifying switches to be be passed to diff.") (defvar diff-command "diff" "*The command to use to run diff.") (defvar diff-regexp-alist '( ;; -u format: @@ -OLDSTART,OLDEND +NEWSTART,NEWEND @@ ("^@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@$" 1 2) ;; -c format: *** OLDSTART,OLDEND **** ("^\\*\\*\\* \\([0-9]+\\),[0-9]+ \\*\\*\\*\\*$" 1 nil) ;; --- NEWSTART,NEWEND ---- ("^--- \\([0-9]+\\),[0-9]+ ----$" nil 1) ;; plain diff format: OLDSTART[,OLDEND]{a,d,c}NEWSTART[,NEWEND] ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]\\([0-9]+\\)\\(,[0-9]+\\)?$" 1 3) ;; -e (ed) format: OLDSTART[,OLDEND]{a,d,c} ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]$" 1) ;; -f format: {a,d,c}OLDSTART[ OLDEND] ;; -n format: {a,d,c}OLDSTART LINES-CHANGED ("^[adc]\\([0-9]+\\)\\( [0-9]+\\)?$" 1) ) "Alist (REGEXP OLD-IDX NEW-IDX) of regular expressions to match difference sections in \\[diff] output. If REGEXP matches, the OLD-IDX'th subexpression gives the line number in the old file, and NEW-IDX'th subexpression gives the line number in the new file. If OLD-IDX or NEW-IDX is nil, REGEXP matches only half a section.") (defvar diff-old-file nil "This is the old file name in the comparison in this buffer.") (defvar diff-new-file nil "This is the new file name in the comparison in this buffer.") (defvar diff-old-temp-file nil "This is the name of a temp file to be deleted after diff finishes.") (defvar diff-new-temp-file nil "This is the name of a temp file to be deleted after diff finishes.") ;; See compilation-parse-errors-function (compile.el). (defun diff-parse-differences (limit-search find-at-least) (setq compilation-error-list nil) (message "Parsing differences...") ;; Don't reparse diffs already seen at last parse. (if compilation-parsing-end (goto-char compilation-parsing-end)) ;; Construct in REGEXP a regexp composed of all those in dired-regexp-alist. (let ((regexp (mapconcat (lambda (elt) (concat "\\(" (car elt) "\\)")) diff-regexp-alist "\\|")) ;; (GROUP-IDX OLD-IDX NEW-IDX) (groups (let ((subexpr 1)) (mapcar (lambda (elt) (prog1 (cons subexpr (mapcar (lambda (n) (and n (+ subexpr n))) (cdr elt))) (setq subexpr (+ subexpr 1 (count-regexp-groupings (car elt)))))) diff-regexp-alist))) (new-error (function (lambda (file subexpr) (setq compilation-error-list (cons (cons (save-excursion ;; Report location of message ;; at beginning of line. (goto-char (match-beginning subexpr)) (beginning-of-line) (point-marker)) ;; Report location of corresponding text. (let ((line (string-to-int (buffer-substring (match-beginning subexpr) (match-end subexpr))))) (save-excursion (save-match-data (set-buffer (find-file-noselect file))) (save-excursion (goto-line line) (point-marker))))) compilation-error-list))))) (found-desired nil) (num-loci-found 0) g) (while (and (not found-desired) ;; We don't just pass LIMIT-SEARCH to re-search-forward ;; because we want to find matches containing LIMIT-SEARCH ;; but which extend past it. (re-search-forward regexp nil t)) ;; Find which individual regexp matched. (setq g groups) (while (and g (null (match-beginning (car (car g))))) (setq g (cdr g))) (setq g (car g)) (if (nth 1 g) ;OLD-IDX (funcall new-error diff-old-file (nth 1 g))) (if (nth 2 g) ;NEW-IDX (funcall new-error diff-new-file (nth 2 g))) (setq num-loci-found (1+ num-loci-found)) (if (or (and find-at-least (>= num-loci-found find-at-least)) (and limit-search (>= (point) limit-search))) ;; We have found as many new loci as the user wants, ;; or the user wanted a specific diff, and we're past it. (setq found-desired t))) (if found-desired (setq compilation-parsing-end (point)) ;; Set to point-max, not point, so we don't perpetually ;; parse the last bit of text when it isn't a diff header. (setq compilation-parsing-end (point-max))) (message "Parsing differences...done")) (setq compilation-error-list (nreverse compilation-error-list))) ;;;###autoload (defun diff (old new &optional switches) "Find and display the differences between OLD and NEW files. Interactively the current buffer's file name is the default for NEW and a backup file for NEW is the default for OLD. With prefix arg, prompt for diff switches." (interactive (nconc (let (oldf newf) (nreverse (list (setq newf (buffer-file-name) newf (if (and newf (file-exists-p newf)) (read-file-name (concat "Diff new file: (" (file-name-nondirectory newf) ") ") nil newf t) (read-file-name "Diff new file: " nil nil t))) (setq oldf (file-newest-backup newf) oldf (if (and oldf (file-exists-p oldf)) (read-file-name (concat "Diff original file: (" (file-name-nondirectory oldf) ") ") (file-name-directory oldf) oldf t) (read-file-name "Diff original file: " (file-name-directory newf) nil t)))))) (if current-prefix-arg (list (read-string "Diff switches: " (if (stringp diff-switches) diff-switches (mapconcat 'identity diff-switches " ")))) nil))) (setq new (expand-file-name new) old (expand-file-name old)) (let ((old-alt (file-local-copy old)) (new-alt (file-local-copy new)) buf) (unwind-protect (let ((command (mapconcat 'identity (append (list diff-command) ;; Use explicitly specified switches (if switches (if (consp switches) switches (list switches)) ;; If not specified, use default. (if (consp diff-switches) diff-switches (list diff-switches))) (if (or old-alt new-alt) (list "-L" old "-L" new)) (list (shell-quote-argument (or old-alt old))) (list (shell-quote-argument (or new-alt new)))) " "))) (setq buf (compile-internal command "No more differences" "Diff" 'diff-parse-differences)) (pop-to-buffer buf) (set (make-local-variable 'diff-old-file) old) (set (make-local-variable 'diff-new-file) new) (set (make-local-variable 'diff-old-temp-file) old-alt) (set (make-local-variable 'diff-new-temp-file) new-alt) (set (make-local-variable 'compilation-finish-function) (function (lambda (buff msg) (if diff-old-temp-file (delete-file diff-old-temp-file)) (if diff-new-temp-file (delete-file diff-new-temp-file))))) buf)))) ;;;###autoload (defun diff-backup (file &optional switches) "Diff this file with its backup file or vice versa. Uses the latest backup, if there are several numerical backups. If this file is a backup, diff it with its original. The backup file is the first file given to `diff'." (interactive (list (read-file-name "Diff (file with backup): ") (if current-prefix-arg (read-string "Diff switches: " (if (stringp diff-switches) diff-switches (mapconcat 'identity diff-switches " "))) nil))) (let (bak ori) (if (backup-file-name-p file) (setq bak file ori (file-name-sans-versions file)) (setq bak (or (diff-latest-backup-file file) (error "No backup found for %s" file)) ori file)) (diff bak ori switches))) (defun diff-latest-backup-file (fn) ; actually belongs into files.el "Return the latest existing backup of FILE, or nil." (let ((handler (find-file-name-handler fn 'diff-latest-backup-file))) (if handler (funcall handler 'diff-latest-backup-file fn) ;; First try simple backup, then the highest numbered of the ;; numbered backups. ;; Ignore the value of version-control because we look for existing ;; backups, which maybe were made earlier or by another user with ;; a different value of version-control. (setq fn (file-chase-links (expand-file-name fn))) (or (let ((bak (make-backup-file-name fn))) (if (file-exists-p bak) bak)) ;; We use BACKUPNAME to cope with backups stored in a different dir. (let* ((backupname (car (find-backup-file-name fn))) (dir (file-name-directory backupname)) (base-versions (concat (file-name-sans-versions (file-name-nondirectory backupname)) ".~")) (bv-length (length base-versions))) (concat dir (car (sort (file-name-all-completions base-versions dir) ;; bv-length is a fluid var for backup-extract-version: (function (lambda (fn1 fn2) (> (backup-extract-version fn1) (backup-extract-version fn2)))))))))))) (provide 'diff) ;;; diff.el ends here emacs-19.30/lisp/dired-aux.el100444 12120 1 213362 6020637057 14327 0ustar rmsdaemon;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*- ;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc. ;; Author: Sebastian Kremer . ;; 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: ;; The parts of dired mode not normally used. This is a space-saving hack ;; to avoid having to load a large mode when all that's wanted are a few ;; functions. ;; Rewritten in 1990/1991 to add tree features, file marking and ;; sorting by Sebastian Kremer . ;; Finished up by rms in 1992. ;;; Code: ;; We need macros in dired.el to compile properly. (eval-when-compile (require 'dired)) ;;; 15K ;;;###begin dired-cmd.el ;; Diffing and compressing ;;;###autoload (defun dired-diff (file &optional switches) "Compare file at point with file FILE using `diff'. FILE defaults to the file at the mark. The prompted-for file is the first file given to `diff'. With prefix arg, prompt for second argument SWITCHES, which is options for `diff'." (interactive (let ((default (if (mark t) (save-excursion (goto-char (mark t)) (dired-get-filename t t))))) (require 'diff) (list (read-file-name (format "Diff %s with: %s" (dired-get-filename t) (if default (concat "(default " default ") ") "")) (dired-current-directory) default t) (if current-prefix-arg (read-string "Options for diff: " (if (stringp diff-switches) diff-switches (mapconcat 'identity diff-switches " "))))))) (diff file (dired-get-filename t) switches)) ;;;###autoload (defun dired-backup-diff (&optional switches) "Diff this file with its backup file or vice versa. Uses the latest backup, if there are several numerical backups. If this file is a backup, diff it with its original. The backup file is the first file given to `diff'. With prefix arg, prompt for argument SWITCHES which is options for `diff'." (interactive (if current-prefix-arg (list (read-string "Options for diff: " (if (stringp diff-switches) diff-switches (mapconcat 'identity diff-switches " ")))) nil)) (diff-backup (dired-get-filename) switches)) (defun dired-do-chxxx (attribute-name program op-symbol arg) ;; Change file attributes (mode, group, owner) of marked files and ;; refresh their file lines. ;; ATTRIBUTE-NAME is a string describing the attribute to the user. ;; PROGRAM is the program used to change the attribute. ;; OP-SYMBOL is the type of operation (for use in dired-mark-pop-up). ;; ARG describes which files to use, as in dired-get-marked-files. (let* ((files (dired-get-marked-files t arg)) (new-attribute (dired-mark-read-string (concat "Change " attribute-name " of %s to: ") nil op-symbol arg files)) (operation (concat program " " new-attribute)) failures) (setq failures (dired-bunch-files 10000 (function dired-check-process) (list operation program new-attribute) files)) (dired-do-redisplay arg);; moves point if ARG is an integer (if failures (dired-log-summary (format "%s: error" operation) nil)))) ;;;###autoload (defun dired-do-chmod (&optional arg) "Change the mode of the marked (or next ARG) files. This calls chmod, thus symbolic modes like `g+w' are allowed." (interactive "P") (dired-do-chxxx "Mode" dired-chmod-program 'chmod arg)) ;;;###autoload (defun dired-do-chgrp (&optional arg) "Change the group of the marked (or next ARG) files." (interactive "P") (if (memq system-type '(ms-dos windows-nt)) (error "chgrp not supported on this system.")) (dired-do-chxxx "Group" "chgrp" 'chgrp arg)) ;;;###autoload (defun dired-do-chown (&optional arg) "Change the owner of the marked (or next ARG) files." (interactive "P") (if (memq system-type '(ms-dos windows-nt)) (error "chown not supported on this system.")) (dired-do-chxxx "Owner" dired-chown-program 'chown arg)) ;; Process all the files in FILES in batches of a convenient size, ;; by means of (FUNCALL FUNCTION ARGS... SOME-FILES...). ;; Batches are chosen to need less than MAX chars for the file names, ;; allowing 3 extra characters of separator per file name. (defun dired-bunch-files (max function args files) (let (pending (pending-length 0) failures) ;; Accumulate files as long as they fit in MAX chars, ;; then process the ones accumulated so far. (while files (let* ((thisfile (car files)) (thislength (+ (length thisfile) 3)) (rest (cdr files))) ;; If we have at least 1 pending file ;; and this file won't fit in the length limit, process now. (if (and pending (> (+ thislength pending-length) max)) (setq failures (nconc (apply function (append args pending)) failures) pending nil pending-length 0)) ;; Do (setq pending (cons thisfile pending)) ;; but reuse the cons that was in `files'. (setcdr files pending) (setq pending files) (setq pending-length (+ thislength pending-length)) (setq files rest))) (nconc (apply function (append args pending)) failures))) ;;;###autoload (defun dired-do-print (&optional arg) "Print the marked (or next ARG) files. Uses the shell command coming from variables `lpr-command' and `lpr-switches' as default." (interactive "P") (let* ((file-list (dired-get-marked-files t arg)) (command (dired-mark-read-string "Print %s with: " (mapconcat 'identity (cons lpr-command (if (stringp lpr-switches) (list lpr-switches) lpr-switches)) " ") 'print arg file-list))) (dired-run-shell-command (dired-shell-stuff-it command file-list nil)))) ;; Read arguments for a marked-files command that wants a string ;; that is not a file name, ;; perhaps popping up the list of marked files. ;; ARG is the prefix arg and indicates whether the files came from ;; marks (ARG=nil) or a repeat factor (integerp ARG). ;; If the current file was used, the list has but one element and ARG ;; does not matter. (It is non-nil, non-integer in that case, namely '(4)). (defun dired-mark-read-string (prompt initial op-symbol arg files) ;; PROMPT for a string, with INITIAL input. ;; Other args are used to give user feedback and pop-up: ;; OP-SYMBOL of command, prefix ARG, marked FILES. (dired-mark-pop-up nil op-symbol files (function read-string) (format prompt (dired-mark-prompt arg files)) initial)) ;;; Cleaning a directory: flagging some backups for deletion. (defvar dired-file-version-alist) (defun dired-clean-directory (keep) "Flag numerical backups for deletion. Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest. Positive prefix arg KEEP overrides `dired-kept-versions'; Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive. To clear the flags on these files, you can use \\[dired-flag-backup-files] with a prefix argument." (interactive "P") (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions)) (let ((early-retention (if (< keep 0) (- keep) kept-old-versions)) (late-retention (if (<= keep 0) dired-kept-versions keep)) (dired-file-version-alist ())) (message "Cleaning numerical backups (keeping %d late, %d old)..." late-retention early-retention) ;; Look at each file. ;; If the file has numeric backup versions, ;; put on dired-file-version-alist an element of the form ;; (FILENAME . VERSION-NUMBER-LIST) (dired-map-dired-file-lines (function dired-collect-file-versions)) ;; Sort each VERSION-NUMBER-LIST, ;; and remove the versions not to be deleted. (let ((fval dired-file-version-alist)) (while fval (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<))) (v-count (length sorted-v-list))) (if (> v-count (+ early-retention late-retention)) (rplacd (nthcdr early-retention sorted-v-list) (nthcdr (- v-count late-retention) sorted-v-list))) (rplacd (car fval) (cdr sorted-v-list))) (setq fval (cdr fval)))) ;; Look at each file. If it is a numeric backup file, ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion. (dired-map-dired-file-lines (function dired-trample-file-versions)) (message "Cleaning numerical backups...done"))) ;;; Subroutines of dired-clean-directory. (defun dired-map-dired-file-lines (fun) ;; Perform FUN with point at the end of each non-directory line. ;; FUN takes one argument, the filename (complete pathname). (save-excursion (let (file buffer-read-only) (goto-char (point-min)) (while (not (eobp)) (save-excursion (and (not (looking-at dired-re-dir)) (not (eolp)) (setq file (dired-get-filename nil t)) ; nil on non-file (progn (end-of-line) (funcall fun file)))) (forward-line 1))))) (defun dired-collect-file-versions (fn) (let ((fn (file-name-sans-versions fn))) ;; Only do work if this file is not already in the alist. (if (assoc fn dired-file-version-alist) nil ;; If it looks like file FN has versions, return a list of the versions. ;;That is a list of strings which are file names. ;;The caller may want to flag some of these files for deletion. (let* ((base-versions (concat (file-name-nondirectory fn) ".~")) (bv-length (length base-versions)) (possibilities (file-name-all-completions base-versions (file-name-directory fn))) (versions (mapcar 'backup-extract-version possibilities))) (if versions (setq dired-file-version-alist (cons (cons fn versions) dired-file-version-alist))))))) (defun dired-trample-file-versions (fn) (let* ((start-vn (string-match "\\.~[0-9]+~$" fn)) base-version-list) (and start-vn (setq base-version-list ; there was a base version to which (assoc (substring fn 0 start-vn) ; this looks like a dired-file-version-alist)) ; subversion (not (memq (string-to-int (substring fn (+ 2 start-vn))) base-version-list)) ; this one doesn't make the cut (progn (beginning-of-line) (delete-char 1) (insert dired-del-marker))))) ;;; Shell commands ;;>>> install (move this function into simple.el) (defun dired-shell-quote (filename) "Quote a file name for inferior shell (see variable `shell-file-name')." ;; Quote everything except POSIX filename characters. ;; This should be safe enough even for really weird shells. (let ((result "") (start 0) end) (while (string-match "[^-0-9a-zA-Z_./]" filename start) (setq end (match-beginning 0) result (concat result (substring filename start end) "\\" (substring filename end (1+ end))) start (1+ end))) (concat result (substring filename start)))) (defun dired-read-shell-command (prompt arg files) ;; "Read a dired shell command prompting with PROMPT (using read-string). ;;ARG is the prefix arg and may be used to indicate in the prompt which ;; files are affected. ;;This is an extra function so that you can redefine it, e.g., to use gmhist." (dired-mark-pop-up nil 'shell files (function read-string) (format prompt (dired-mark-prompt arg files)) nil 'shell-command-history)) ;; The in-background argument is only needed in Emacs 18 where ;; shell-command doesn't understand an appended ampersand `&'. ;;;###autoload (defun dired-do-shell-command (command &optional arg) "Run a shell command COMMAND on the marked files. If no files are marked or a specific numeric prefix arg is given, the next ARG files are used. Just \\[universal-argument] means the current file. The prompt mentions the file(s) or the marker, as appropriate. If there is output, it goes to a separate buffer. Normally the command is run on each file individually. However, if there is a `*' in the command then it is run just once with the entire file list substituted there. No automatic redisplay of dired buffers is attempted, as there's no telling what files the command may have changed. Type \\[dired-do-redisplay] to redisplay the marked files. The shell command has the top level directory as working directory, so output files usually are created there instead of in a subdir." ;;Functions dired-run-shell-command and dired-shell-stuff-it do the ;;actual work and can be redefined for customization. (interactive (list ;; Want to give feedback whether this file or marked files are used: (dired-read-shell-command (concat "! on " "%s: ") current-prefix-arg (dired-get-marked-files t current-prefix-arg)) current-prefix-arg)) (let* ((on-each (not (string-match "\\*" command))) (file-list (dired-get-marked-files t arg))) (if on-each (dired-bunch-files (- 10000 (length command)) (function (lambda (&rest files) (dired-run-shell-command (dired-shell-stuff-it command files t arg)))) nil file-list) ;; execute the shell command (dired-run-shell-command (dired-shell-stuff-it command file-list nil arg))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" "Prepended to marked files in dired shell commands.") (defvar dired-mark-postfix "" "Appended to marked files in dired shell commands.") (defvar dired-mark-separator " " "Separates marked files in dired shell commands.") (defun dired-shell-stuff-it (command file-list on-each &optional raw-arg) ;; "Make up a shell command line from COMMAND and FILE-LIST. ;; If ON-EACH is t, COMMAND should be applied to each file, else ;; simply concat all files and apply COMMAND to this. ;; FILE-LIST's elements will be quoted for the shell." ;; Might be redefined for smarter things and could then use RAW-ARG ;; (coming from interactive P and currently ignored) to decide what to do. ;; Smart would be a way to access basename or extension of file names. ;; See dired-trns.el for an approach to this. ;; Bug: There is no way to quote a * ;; On the other hand, you can never accidentally get a * into your cmd. (let ((stuff-it (if (string-match "\\*" command) (function (lambda (x) (dired-replace-in-string "\\*" x command))) (function (lambda (x) (concat command " " x)))))) (if on-each (mapconcat stuff-it (mapcar 'dired-shell-quote file-list) ";") (let ((fns (mapconcat 'dired-shell-quote file-list dired-mark-separator))) (if (> (length file-list) 1) (setq fns (concat dired-mark-prefix fns dired-mark-postfix))) (funcall stuff-it fns))))) ;; This is an extra function so that it can be redefined by ange-ftp. (defun dired-run-shell-command (command) (shell-command command) ;; Return nil for sake of nconc in dired-bunch-files. nil) ;; In Emacs 19 this will return program's exit status. ;; This is a separate function so that ange-ftp can redefine it. (defun dired-call-process (program discard &rest arguments) ; "Run PROGRAM with output to current buffer unless DISCARD is t. ;Remaining arguments are strings passed as command arguments to PROGRAM." (apply 'call-process program nil (not discard) nil arguments)) (defun dired-check-process (msg program &rest arguments) ; "Display MSG while running PROGRAM, and check for output. ;Remaining arguments are strings passed as command arguments to PROGRAM. ; On error, insert output ; in a log buffer and return the offending ARGUMENTS or PROGRAM. ; Caller can cons up a list of failed args. ;Else returns nil for success." (let (err-buffer err (dir default-directory)) (message "%s..." msg) (save-excursion ;; Get a clean buffer for error output: (setq err-buffer (get-buffer-create " *dired-check-process output*")) (set-buffer err-buffer) (erase-buffer) (setq default-directory dir ; caller's default-directory err (/= 0 (apply (function dired-call-process) program nil arguments))) (if err (progn (dired-log (concat program " " (prin1-to-string arguments) "\n")) (dired-log err-buffer) (or arguments program t)) (kill-buffer err-buffer) (message "%s...done" msg) nil)))) ;; Commands that delete or redisplay part of the dired buffer. (defun dired-kill-line (&optional arg) (interactive "P") (setq arg (prefix-numeric-value arg)) (let (buffer-read-only file) (while (/= 0 arg) (setq file (dired-get-filename nil t)) (if (not file) (error "Can only kill file lines.") (save-excursion (and file (dired-goto-subdir file) (dired-kill-subdir))) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point))) (if (> arg 0) (setq arg (1- arg)) (setq arg (1+ arg)) (forward-line -1)))) (dired-move-to-filename))) ;;;###autoload (defun dired-do-kill-lines (&optional arg fmt) "Kill all marked lines (not the files). With a prefix argument, kill that many lines starting with the current line. \(A negative argument kills lines before the current line.) To kill an entire subdirectory, go to its directory header line and use this command with a prefix argument (the value does not matter)." ;; Returns count of killed lines. FMT="" suppresses message. (interactive "P") (if arg (if (dired-get-subdir) (dired-kill-subdir) (dired-kill-line arg)) (save-excursion (goto-char (point-min)) (let (buffer-read-only (count 0)) (if (not arg) ; kill marked lines (let ((regexp (dired-marker-regexp))) (while (and (not (eobp)) (re-search-forward regexp nil t)) (setq count (1+ count)) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point))))) ;; else kill unmarked lines (while (not (eobp)) (if (or (dired-between-files) (not (looking-at "^ "))) (forward-line 1) (setq count (1+ count)) (delete-region (point) (save-excursion (forward-line 1) (point)))))) (or (equal "" fmt) (message (or fmt "Killed %d line%s.") count (dired-plural-s count))) count)))) ;;;###end dired-cmd.el ;;; 30K ;;;###begin dired-cp.el (defun dired-compress () ;; Compress or uncompress the current file. ;; Return nil for success, offending filename else. (let* (buffer-read-only (from-file (dired-get-filename)) (new-file (dired-compress-file from-file))) (if new-file (let ((start (point))) ;; Remove any preexisting entry for the name NEW-FILE. (condition-case nil (dired-remove-entry new-file) (error nil)) (goto-char start) ;; Now replace the current line with an entry for NEW-FILE. (dired-update-file-line new-file) nil) (dired-log (concat "Failed to compress" from-file)) from-file))) ;;;###autoload (defun dired-compress-file (file) ;; Compress or uncompress FILE. ;; Return the name of the compressed or uncompressed file. ;; Return nil if no change in files. (let ((handler (find-file-name-handler file 'dired-compress-file))) (cond (handler (funcall handler 'dired-compress-file file)) ((file-symlink-p file) nil) ((let (case-fold-search) (string-match "\\.Z$" file)) (if (not (dired-check-process (concat "Uncompressing " file) "uncompress" file)) (substring file 0 -2))) ((let (case-fold-search) (string-match "\\.gz$" file)) (if (not (dired-check-process (concat "Uncompressing " file) "gunzip" file)) (substring file 0 -3))) ;; For .z, try gunzip. It might be an old gzip file, ;; or it might be from compact? pack? (which?) but gunzip handles ;; both. ((let (case-fold-search) (string-match "\\.z$" file)) (if (not (dired-check-process (concat "Uncompressing " file) "gunzip" file)) (substring file 0 -2))) (t ;;; Try gzip; if we don't have that, use compress. (condition-case nil (if (not (dired-check-process (concat "Compressing " file) "gzip" "-f" file)) (cond ((file-exists-p (concat file ".gz")) (concat file ".gz")) (t (concat file ".z")))) (file-error (if (not (dired-check-process (concat "Compressing " file) "compress" "-f" file)) (concat file ".Z")))))))) (defun dired-mark-confirm (op-symbol arg) ;; Request confirmation from the user that the operation described ;; by OP-SYMBOL is to be performed on the marked files. ;; Confirmation consists in a y-or-n question with a file list ;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'. ;; The files used are determined by ARG (as in dired-get-marked-files). (or (memq op-symbol dired-no-confirm) (let ((files (dired-get-marked-files t arg)) (string (if (eq op-symbol 'compress) "Compress or uncompress" (capitalize (symbol-name op-symbol))))) (dired-mark-pop-up nil op-symbol files (function y-or-n-p) (concat string " " (dired-mark-prompt arg files) "? "))))) (defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress) ; "Map FUN over marked files (with second ARG like in dired-map-over-marks) ; and display failures. ; FUN takes zero args. It returns non-nil (the offending object, e.g. ; the short form of the filename) for a failure and probably logs a ; detailed error explanation using function `dired-log'. ; OP-SYMBOL is a symbol describing the operation performed (e.g. ; `compress'). It is used with `dired-mark-pop-up' to prompt the user ; (e.g. with `Compress * [2 files]? ') and to display errors (e.g. ; `Failed to compress 1 of 2 files - type W to see why ("foo")') ; SHOW-PROGRESS if non-nil means redisplay dired after each file." (if (dired-mark-confirm op-symbol arg) (let* ((total-list;; all of FUN's return values (dired-map-over-marks (funcall fun) arg show-progress)) (total (length total-list)) (failures (delq nil total-list)) (count (length failures)) (string (if (eq op-symbol 'compress) "Compress or uncompress" (capitalize (symbol-name op-symbol))))) (if (not failures) (message "%s: %d file%s." string total (dired-plural-s total)) ;; end this bunch of errors: (dired-log-summary (format "Failed to %s %d of %d file%s" (downcase string) count total (dired-plural-s total)) failures))))) (defvar dired-query-alist '((?\y . y) (?\040 . y) ; `y' or SPC means accept once (?n . n) (?\177 . n) ; `n' or DEL skips once (?! . yes) ; `!' accepts rest (?q. no) (?\e . no) ; `q' or ESC skips rest ;; None of these keys quit - use C-g for that. )) (defun dired-query (qs-var qs-prompt &rest qs-args) ;; Query user and return nil or t. ;; Store answer in symbol VAR (which must initially be bound to nil). ;; Format PROMPT with ARGS. ;; Binding variable help-form will help the user who types the help key. (let* ((char (symbol-value qs-var)) (action (cdr (assoc char dired-query-alist)))) (cond ((eq 'yes action) t) ; accept, and don't ask again ((eq 'no action) nil) ; skip, and don't ask again (t;; no lasting effects from last time we asked - ask now (let ((qprompt (concat qs-prompt (if help-form (format " [Type yn!q or %s] " (key-description (char-to-string help-char))) " [Type y, n, q or !] "))) result elt) ;; Actually it looks nicer without cursor-in-echo-area - you can ;; look at the dired buffer instead of at the prompt to decide. (apply 'message qprompt qs-args) (setq char (set qs-var (read-char))) (while (not (setq elt (assoc char dired-query-alist))) (message "Invalid char - type %c for help." help-char) (ding) (sit-for 1) (apply 'message qprompt qs-args) (setq char (set qs-var (read-char)))) (memq (cdr elt) '(t y yes))))))) ;;;###autoload (defun dired-do-compress (&optional arg) "Compress or uncompress marked (or next ARG) files." (interactive "P") (dired-map-over-marks-check (function dired-compress) arg 'compress t)) ;; Commands for Emacs Lisp files - load and byte compile (defun dired-byte-compile () ;; Return nil for success, offending file name else. (let* ((filename (dired-get-filename)) elc-file buffer-read-only failure) (condition-case err (save-excursion (byte-compile-file filename)) (error (setq failure err))) (setq elc-file (byte-compile-dest-file filename)) (or (file-exists-p elc-file) (setq failure t)) (if failure (progn (dired-log "Byte compile error for %s:\n%s\n" filename failure) (dired-make-relative filename)) (dired-remove-file elc-file) (forward-line) ; insert .elc after its .el file (dired-add-file elc-file) nil))) ;;;###autoload (defun dired-do-byte-compile (&optional arg) "Byte compile marked (or next ARG) Emacs Lisp files." (interactive "P") (dired-map-over-marks-check (function dired-byte-compile) arg 'byte-compile t)) (defun dired-load () ;; Return nil for success, offending file name else. (let ((file (dired-get-filename)) failure) (condition-case err (load file nil nil t) (error (setq failure err))) (if (not failure) nil (dired-log "Load error for %s:\n%s\n" file failure) (dired-make-relative file)))) ;;;###autoload (defun dired-do-load (&optional arg) "Load the marked (or next ARG) Emacs Lisp files." (interactive "P") (dired-map-over-marks-check (function dired-load) arg 'load t)) ;;;###autoload (defun dired-do-redisplay (&optional arg test-for-subdir) "Redisplay all marked (or next ARG) files. If on a subdir line, redisplay that subdirectory. In that case, a prefix arg lets you edit the `ls' switches used for the new listing." ;; Moves point if the next ARG files are redisplayed. (interactive "P\np") (if (and test-for-subdir (dired-get-subdir)) (dired-insert-subdir (dired-get-subdir) (if arg (read-string "Switches for listing: " dired-actual-switches))) (message "Redisplaying...") ;; message much faster than making dired-map-over-marks show progress (dired-uncache (if (consp dired-directory) (car dired-directory) dired-directory)) (dired-map-over-marks (let ((fname (dired-get-filename))) (message "Redisplaying... %s" fname) (dired-update-file-line fname)) arg) (dired-move-to-filename) (message "Redisplaying...done"))) (defun dired-update-file-line (file) ;; Delete the current line, and insert an entry for FILE. ;; If FILE is nil, then just delete the current line. ;; Keeps any marks that may be present in column one (doing this ;; here is faster than with dired-add-entry's optional arg). ;; Does not update other dired buffers. Use dired-relist-entry for that. (beginning-of-line) (let ((char (following-char)) (opoint (point)) (buffer-read-only)) (delete-region (point) (progn (forward-line 1) (point))) (if file (progn (dired-add-entry file) ;; Replace space by old marker without moving point. ;; Faster than goto+insdel inside a save-excursion? (subst-char-in-region opoint (1+ opoint) ?\040 char)))) (dired-move-to-filename)) (defun dired-fun-in-all-buffers (directory fun &rest args) ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS. ;; Return list of buffers where FUN succeeded (i.e., returned non-nil). (let ((buf-list (dired-buffers-for-dir (expand-file-name directory))) (obuf (current-buffer)) buf success-list) (while buf-list (setq buf (car buf-list) buf-list (cdr buf-list)) (unwind-protect (progn (set-buffer buf) (if (apply fun args) (setq success-list (cons (buffer-name buf) success-list)))) (set-buffer obuf))) success-list)) ;;;###autoload (defun dired-add-file (filename &optional marker-char) (dired-fun-in-all-buffers (file-name-directory filename) (function dired-add-entry) filename marker-char)) (defun dired-add-entry (filename &optional marker-char) ;; Add a new entry for FILENAME, optionally marking it ;; with MARKER-CHAR (a character, else dired-marker-char is used). ;; Note that this adds the entry `out of order' if files sorted by ;; time, etc. ;; At least this version inserts in the right subdirectory (if present). ;; And it skips "." or ".." (see `dired-trivial-filenames'). ;; Hidden subdirs are exposed if a file is added there. (setq filename (directory-file-name filename)) ;; Entry is always for files, even if they happen to also be directories (let ((opoint (point)) (cur-dir (dired-current-directory)) (orig-file-name filename) (directory (file-name-directory filename)) reason) (setq filename (file-name-nondirectory filename) reason (catch 'not-found (if (string= directory cur-dir) (progn (skip-chars-forward "^\r\n") (if (eq (following-char) ?\r) (dired-unhide-subdir)) ;; We are already where we should be, except when ;; point is before the subdir line or its total line. (let ((p (dired-after-subdir-garbage cur-dir))) (if (< (point) p) (goto-char p)))) ;; else try to find correct place to insert (if (dired-goto-subdir directory) (progn;; unhide if necessary (if (looking-at "\r");; point is at end of subdir line (dired-unhide-subdir)) ;; found - skip subdir and `total' line ;; and uninteresting files like . and .. ;; This better not moves into the next subdir! (dired-goto-next-nontrivial-file)) ;; not found (throw 'not-found "Subdir not found"))) (let (buffer-read-only opoint) (beginning-of-line) (setq opoint (point)) (dired-add-entry-do-indentation marker-char) ;; don't expand `.'. Show just the file name within directory. (let ((default-directory directory)) (insert-directory filename (concat dired-actual-switches "d"))) ;; Compensate for a bug in ange-ftp. ;; It inserts the file's absolute name, rather than ;; the relative one. That may be hard to fix since it ;; is probably controlled by something in ftp. (goto-char opoint) (let ((inserted-name (dired-get-filename 'no-dir))) (if (file-name-directory inserted-name) (progn (end-of-line) (delete-char (- (length inserted-name))) (insert filename) (forward-char 1)) (forward-line 1))) ;; Give each line a text property recording info about it. (dired-insert-set-properties opoint (point)) (forward-line -1) (if dired-after-readin-hook;; the subdir-alist is not affected... (save-excursion;; ...so we can run it right now: (save-restriction (beginning-of-line) (narrow-to-region (point) (save-excursion (forward-line 1) (point))) (run-hooks 'dired-after-readin-hook)))) (dired-move-to-filename)) ;; return nil if all went well nil)) (if reason ; don't move away on failure (goto-char opoint)) (not reason))) ; return t on success, nil else ;; This is a separate function for the sake of nested dired format. (defun dired-add-entry-do-indentation (marker-char) ;; two spaces or a marker plus a space: (insert (if marker-char (if (integerp marker-char) marker-char dired-marker-char) ?\040) ?\040)) (defun dired-after-subdir-garbage (dir) ;; Return pos of first file line of DIR, skipping header and total ;; or wildcard lines. ;; Important: never moves into the next subdir. ;; DIR is assumed to be unhidden. ;; Will probably be redefined for VMS etc. (save-excursion (or (dired-goto-subdir dir) (error "This cannot happen")) (forward-line 1) (while (and (not (eolp)) ; don't cross subdir boundary (not (dired-move-to-filename))) (forward-line 1)) (point))) ;;;###autoload (defun dired-remove-file (file) (dired-fun-in-all-buffers (file-name-directory file) (function dired-remove-entry) file)) (defun dired-remove-entry (file) (save-excursion (and (dired-goto-file file) (let (buffer-read-only) (delete-region (progn (beginning-of-line) (point)) (save-excursion (forward-line 1) (point))))))) ;;;###autoload (defun dired-relist-file (file) (dired-fun-in-all-buffers (file-name-directory file) (function dired-relist-entry) file)) (defun dired-relist-entry (file) ;; Relist the line for FILE, or just add it if it did not exist. ;; FILE must be an absolute pathname. (let (buffer-read-only marker) ;; If cursor is already on FILE's line delete-region will cause ;; save-excursion to fail because of floating makers, ;; moving point to beginning of line. Sigh. (save-excursion (and (dired-goto-file file) (delete-region (progn (beginning-of-line) (setq marker (following-char)) (point)) (save-excursion (forward-line 1) (point)))) (setq file (directory-file-name file)) (dired-add-entry file (if (eq ?\040 marker) nil marker))))) ;;; Copy, move/rename, making hard and symbolic links (defvar dired-backup-overwrite nil "*Non-nil if Dired should ask about making backups before overwriting files. Special value `always' suppresses confirmation.") (defvar dired-overwrite-confirmed) (defun dired-handle-overwrite (to) ;; Save old version of a to be overwritten file TO. ;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars ;; from dired-create-files. (if (and dired-backup-overwrite dired-overwrite-confirmed (or (eq 'always dired-backup-overwrite) (dired-query 'overwrite-backup-query (format "Make backup for existing file `%s'? " to)))) (let ((backup (car (find-backup-file-name to)))) (rename-file to backup 0) ; confirm overwrite of old backup (dired-relist-entry backup)))) ;;;###autoload (defun dired-copy-file (from to ok-flag) (dired-handle-overwrite to) (copy-file from to ok-flag dired-copy-preserve-time)) ;;;###autoload (defun dired-rename-file (from to ok-flag) (dired-handle-overwrite to) (rename-file from to ok-flag) ; error is caught in -create-files ;; Silently rename the visited file of any buffer visiting this file. (and (get-file-buffer from) (save-excursion (set-buffer (get-file-buffer from)) (let ((modflag (buffer-modified-p))) (set-visited-file-name to) (set-buffer-modified-p modflag)))) (dired-remove-file from) ;; See if it's an inserted subdir, and rename that, too. (dired-rename-subdir from to)) (defun dired-rename-subdir (from-dir to-dir) (setq from-dir (file-name-as-directory from-dir) to-dir (file-name-as-directory to-dir)) (dired-fun-in-all-buffers from-dir (function dired-rename-subdir-1) from-dir to-dir) ;; Update visited file name of all affected buffers (let ((expanded-from-dir (expand-file-name from-dir)) (blist (buffer-list))) (while blist (save-excursion (set-buffer (car blist)) (if (and buffer-file-name (dired-in-this-tree buffer-file-name expanded-from-dir)) (let ((modflag (buffer-modified-p)) (to-file (dired-replace-in-string (concat "^" (regexp-quote from-dir)) to-dir buffer-file-name))) (set-visited-file-name to-file) (set-buffer-modified-p modflag)))) (setq blist (cdr blist))))) (defun dired-rename-subdir-1 (dir to) ;; Rename DIR to TO in headerlines and dired-subdir-alist, if DIR or ;; one of its subdirectories is expanded in this buffer. (let ((expanded-dir (expand-file-name dir)) (alist dired-subdir-alist) (elt nil)) (while alist (setq elt (car alist) alist (cdr alist)) (if (dired-in-this-tree (car elt) expanded-dir) ;; ELT's subdir is affected by the rename (dired-rename-subdir-2 elt dir to))) (if (equal dir default-directory) ;; if top level directory was renamed, lots of things have to be ;; updated: (progn (dired-unadvertise dir) ; we no longer dired DIR... (setq default-directory to dired-directory (expand-file-name;; this is correct ;; with and without wildcards (file-name-nondirectory dired-directory) to)) (let ((new-name (file-name-nondirectory (directory-file-name dired-directory)))) ;; try to rename buffer, but just leave old name if new ;; name would already exist (don't try appending "<%d>") (or (get-buffer new-name) (rename-buffer new-name))) ;; ... we dired TO now: (dired-advertise))))) (defun dired-rename-subdir-2 (elt dir to) ;; Update the headerline and dired-subdir-alist element of directory ;; described by alist-element ELT to reflect the moving of DIR to TO. ;; Thus, ELT describes either DIR itself or a subdir of DIR. (save-excursion (let ((regexp (regexp-quote (directory-file-name dir))) (newtext (directory-file-name to)) buffer-read-only) (goto-char (dired-get-subdir-min elt)) ;; Update subdir headerline in buffer (if (not (looking-at dired-subdir-regexp)) (error "%s not found where expected - dired-subdir-alist broken?" dir) (goto-char (match-beginning 1)) (if (re-search-forward regexp (match-end 1) t) (replace-match newtext t t) (error "Expected to find `%s' in headerline of %s" dir (car elt)))) ;; Update buffer-local dired-subdir-alist (setcar elt (dired-normalize-subdir (dired-replace-in-string regexp newtext (car elt))))))) ;; The basic function for half a dozen variations on cp/mv/ln/ln -s. (defun dired-create-files (file-creator operation fn-list name-constructor &optional marker-char) ;; Create a new file for each from a list of existing files. The user ;; is queried, dired buffers are updated, and at the end a success or ;; failure message is displayed ;; FILE-CREATOR must accept three args: oldfile newfile ok-if-already-exists ;; It is called for each file and must create newfile, the entry of ;; which will be added. The user will be queried if the file already ;; exists. If oldfile is removed by FILE-CREATOR (i.e, it is a ;; rename), it is FILE-CREATOR's responsibility to update dired ;; buffers. FILE-CREATOR must abort by signalling a file-error if it ;; could not create newfile. The error is caught and logged. ;; OPERATION (a capitalized string, e.g. `Copy') describes the ;; operation performed. It is used for error logging. ;; FN-LIST is the list of files to copy (full absolute pathnames). ;; NAME-CONSTRUCTOR returns a newfile for every oldfile, or nil to ;; skip. If it skips files for other reasons than a direct user ;; query, it is supposed to tell why (using dired-log). ;; Optional MARKER-CHAR is a character with which to mark every ;; newfile's entry, or t to use the current marker character if the ;; oldfile was marked. (let (failures skipped (success-count 0) (total (length fn-list))) (let (to overwrite-query overwrite-backup-query) ; for dired-handle-overwrite (mapcar (function (lambda (from) (setq to (funcall name-constructor from)) (if (equal to from) (progn (setq to nil) (dired-log "Cannot %s to same file: %s\n" (downcase operation) from))) (if (not to) (setq skipped (cons (dired-make-relative from) skipped)) (let* ((overwrite (file-exists-p to)) (dired-overwrite-confirmed ; for dired-handle-overwrite (and overwrite (let ((help-form '(format "\ Type SPC or `y' to overwrite file `%s', DEL or `n' to skip to next, ESC or `q' to not overwrite any of the remaining files, `!' to overwrite all remaining files with no more questions." to))) (dired-query 'overwrite-query "Overwrite `%s'?" to)))) ;; must determine if FROM is marked before file-creator ;; gets a chance to delete it (in case of a move). (actual-marker-char (cond ((integerp marker-char) marker-char) (marker-char (dired-file-marker from)) ; slow (t nil)))) (condition-case err (progn (funcall file-creator from to dired-overwrite-confirmed) (if overwrite ;; If we get here, file-creator hasn't been aborted ;; and the old entry (if any) has to be deleted ;; before adding the new entry. (dired-remove-file to)) (setq success-count (1+ success-count)) (message "%s: %d of %d" operation success-count total) (dired-add-file to actual-marker-char)) (file-error ; FILE-CREATOR aborted (progn (setq failures (cons (dired-make-relative from) failures)) (dired-log "%s `%s' to `%s' failed:\n%s\n" operation from to err)))))))) fn-list)) (cond (failures (dired-log-summary (format "%s failed for %d of %d file%s" operation (length failures) total (dired-plural-s total)) failures)) (skipped (dired-log-summary (format "%s: %d of %d file%s skipped" operation (length skipped) total (dired-plural-s total)) skipped)) (t (message "%s: %s file%s" operation success-count (dired-plural-s success-count))))) (dired-move-to-filename)) (defun dired-do-create-files (op-symbol file-creator operation arg &optional marker-char op1 how-to) ;; Create a new file for each marked file. ;; Prompts user for target, which is a directory in which to create ;; the new files. Target may be a plain file if only one marked ;; file exists. ;; OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up' ;; will determine whether pop-ups are appropriate for this OP-SYMBOL. ;; FILE-CREATOR and OPERATION as in dired-create-files. ;; ARG as in dired-get-marked-files. ;; Optional arg OP1 is an alternate form for OPERATION if there is ;; only one file. ;; Optional arg MARKER-CHAR as in dired-create-files. ;; Optional arg HOW-TO determines how to treat target: ;; If HOW-TO is not given (or nil), and target is a directory, the ;; file(s) are created inside the target directory. If target ;; is not a directory, there must be exactly one marked file, ;; else error. ;; If HOW-TO is t, then target is not modified. There must be ;; exactly one marked file, else error. ;; Else HOW-TO is assumed to be a function of one argument, target, ;; that looks at target and returns a value for the into-dir ;; variable. The function dired-into-dir-with-symlinks is provided ;; for the case (common when creating symlinks) that symbolic ;; links to directories are not to be considered as directories ;; (as file-directory-p would if HOW-TO had been nil). (or op1 (setq op1 operation)) (let* ((fn-list (dired-get-marked-files nil arg)) (fn-count (length fn-list)) (target (expand-file-name (dired-mark-read-file-name (concat (if (= 1 fn-count) op1 operation) " %s to: ") (dired-dwim-target-directory) op-symbol arg (mapcar (function dired-make-relative) fn-list)))) (into-dir (cond ((null how-to) (file-directory-p target)) ((eq how-to t) nil) (t (funcall how-to target))))) (if (and (> fn-count 1) (not into-dir)) (error "Marked %s: target must be a directory: %s" operation target)) ;; rename-file bombs when moving directories unless we do this: (or into-dir (setq target (directory-file-name target))) (dired-create-files file-creator operation fn-list (if into-dir ; target is a directory ;; This function uses fluid vars into-dir and target when called ;; inside dired-create-files: (function (lambda (from) (expand-file-name (file-name-nondirectory from) target))) (function (lambda (from) target))) marker-char))) ;; Read arguments for a marked-files command that wants a file name, ;; perhaps popping up the list of marked files. ;; ARG is the prefix arg and indicates whether the files came from ;; marks (ARG=nil) or a repeat factor (integerp ARG). ;; If the current file was used, the list has but one element and ARG ;; does not matter. (It is non-nil, non-integer in that case, namely '(4)). (defun dired-mark-read-file-name (prompt dir op-symbol arg files) (dired-mark-pop-up nil op-symbol files (function read-file-name) (format prompt (dired-mark-prompt arg files)) dir)) (defun dired-dwim-target-directory () ;; Try to guess which target directory the user may want. ;; If there is a dired buffer displayed in the next window, use ;; its current subdir, else use current subdir of this dired buffer. (let ((this-dir (and (eq major-mode 'dired-mode) (dired-current-directory)))) ;; non-dired buffer may want to profit from this function, e.g. vm-uudecode (if dired-dwim-target (let* ((other-buf (window-buffer (next-window))) (other-dir (save-excursion (set-buffer other-buf) (and (eq major-mode 'dired-mode) (dired-current-directory))))) (or other-dir this-dir)) this-dir))) ;;;###autoload (defun dired-create-directory (directory) "Create a directory called DIRECTORY." (interactive (list (read-file-name "Create directory: " (dired-current-directory)))) (let ((expanded (directory-file-name (expand-file-name directory)))) (make-directory expanded) (dired-add-file expanded) (dired-move-to-filename))) (defun dired-into-dir-with-symlinks (target) (and (file-directory-p target) (not (file-symlink-p target)))) ;; This may not always be what you want, especially if target is your ;; home directory and it happens to be a symbolic link, as is often the ;; case with NFS and automounters. Or if you want to make symlinks ;; into directories that themselves are only symlinks, also quite ;; common. ;; So we don't use this function as value for HOW-TO in ;; dired-do-symlink, which has the minor disadvantage of ;; making links *into* a symlinked-dir, when you really wanted to ;; *overwrite* that symlink. In that (rare, I guess) case, you'll ;; just have to remove that symlink by hand before making your marked ;; symlinks. ;;;###autoload (defun dired-do-copy (&optional arg) "Copy all marked (or next ARG) files, or copy the current file. This normally preserves the last-modified date when copying. When operating on just the current file, you specify the new name. When operating on multiple or marked files, you specify a directory, and new copies of these files are made in that directory with the same names that the files currently have." (interactive "P") (dired-do-create-files 'copy (function dired-copy-file) (if dired-copy-preserve-time "Copy [-p]" "Copy") arg dired-keep-marker-copy)) ;;;###autoload (defun dired-do-symlink (&optional arg) "Make symbolic links to current file or all marked (or next ARG) files. When operating on just the current file, you specify the new name. When operating on multiple or marked files, you specify a directory and new symbolic links are made in that directory with the same names that the files currently have." (interactive "P") (dired-do-create-files 'symlink (function make-symbolic-link) "Symlink" arg dired-keep-marker-symlink)) ;;;###autoload (defun dired-do-hardlink (&optional arg) "Add names (hard links) current file or all marked (or next ARG) files. When operating on just the current file, you specify the new name. When operating on multiple or marked files, you specify a directory and new hard links are made in that directory with the same names that the files currently have." (interactive "P") (dired-do-create-files 'hardlink (function add-name-to-file) "Hardlink" arg dired-keep-marker-hardlink)) ;;;###autoload (defun dired-do-rename (&optional arg) "Rename current file or all marked (or next ARG) files. When renaming just the current file, you specify the new name. When renaming multiple or marked files, you specify a directory." (interactive "P") (dired-do-create-files 'move (function dired-rename-file) "Move" arg dired-keep-marker-rename "Rename")) ;;;###end dired-cp.el ;;; 5K ;;;###begin dired-re.el (defun dired-do-create-files-regexp (file-creator operation arg regexp newname &optional whole-path marker-char) ;; Create a new file for each marked file using regexps. ;; FILE-CREATOR and OPERATION as in dired-create-files. ;; ARG as in dired-get-marked-files. ;; Matches each marked file against REGEXP and constructs the new ;; filename from NEWNAME (like in function replace-match). ;; Optional arg WHOLE-PATH means match/replace the whole pathname ;; instead of only the non-directory part of the file. ;; Optional arg MARKER-CHAR as in dired-create-files. (let* ((fn-list (dired-get-marked-files nil arg)) (fn-count (length fn-list)) (operation-prompt (concat operation " `%s' to `%s'?")) (rename-regexp-help-form (format "\ Type SPC or `y' to %s one match, DEL or `n' to skip to next, `!' to %s all remaining matches with no more questions." (downcase operation) (downcase operation))) (regexp-name-constructor ;; Function to construct new filename using REGEXP and NEWNAME: (if whole-path ; easy (but rare) case (function (lambda (from) (let ((to (dired-string-replace-match regexp from newname)) ;; must bind help-form directly around call to ;; dired-query (help-form rename-regexp-help-form)) (if to (and (dired-query 'rename-regexp-query operation-prompt from to) to) (dired-log "%s: %s did not match regexp %s\n" operation from regexp))))) ;; not whole-path, replace non-directory part only (function (lambda (from) (let* ((new (dired-string-replace-match regexp (file-name-nondirectory from) newname)) (to (and new ; nil means there was no match (expand-file-name new (file-name-directory from)))) (help-form rename-regexp-help-form)) (if to (and (dired-query 'rename-regexp-query operation-prompt (dired-make-relative from) (dired-make-relative to)) to) (dired-log "%s: %s did not match regexp %s\n" operation (file-name-nondirectory from) regexp))))))) rename-regexp-query) (dired-create-files file-creator operation fn-list regexp-name-constructor marker-char))) (defun dired-mark-read-regexp (operation) ;; Prompt user about performing OPERATION. ;; Read and return list of: regexp newname arg whole-path. (let* ((whole-path (equal 0 (prefix-numeric-value current-prefix-arg))) (arg (if whole-path nil current-prefix-arg)) (regexp (dired-read-regexp (concat (if whole-path "Path " "") operation " from (regexp): "))) (newname (read-string (concat (if whole-path "Path " "") operation " " regexp " to: ")))) (list regexp newname arg whole-path))) ;;;###autoload (defun dired-do-rename-regexp (regexp newname &optional arg whole-path) "Rename marked files containing REGEXP to NEWNAME. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. NEWNAME may contain \\=\\ or \\& as in `query-replace-regexp'. REGEXP defaults to the last regexp used. With a zero prefix arg, renaming by regexp affects the complete pathname - usually only the non-directory part of file names is used and changed." (interactive (dired-mark-read-regexp "Rename")) (dired-do-create-files-regexp (function dired-rename-file) "Rename" arg regexp newname whole-path dired-keep-marker-rename)) ;;;###autoload (defun dired-do-copy-regexp (regexp newname &optional arg whole-path) "Copy all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info." (interactive (dired-mark-read-regexp "Copy")) (dired-do-create-files-regexp (function dired-copy-file) (if dired-copy-preserve-time "Copy [-p]" "Copy") arg regexp newname whole-path dired-keep-marker-copy)) ;;;###autoload (defun dired-do-hardlink-regexp (regexp newname &optional arg whole-path) "Hardlink all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info." (interactive (dired-mark-read-regexp "HardLink")) (dired-do-create-files-regexp (function add-name-to-file) "HardLink" arg regexp newname whole-path dired-keep-marker-hardlink)) ;;;###autoload (defun dired-do-symlink-regexp (regexp newname &optional arg whole-path) "Symlink all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info." (interactive (dired-mark-read-regexp "SymLink")) (dired-do-create-files-regexp (function make-symbolic-link) "SymLink" arg regexp newname whole-path dired-keep-marker-symlink)) (defun dired-create-files-non-directory (file-creator basename-constructor operation arg) ;; Perform FILE-CREATOR on the non-directory part of marked files ;; using function BASENAME-CONSTRUCTOR, with query for each file. ;; OPERATION like in dired-create-files, ARG as in dired-get-marked-files. (let (rename-non-directory-query) (dired-create-files file-creator operation (dired-get-marked-files nil arg) (function (lambda (from) (let ((to (concat (file-name-directory from) (funcall basename-constructor (file-name-nondirectory from))))) (and (let ((help-form (format "\ Type SPC or `y' to %s one file, DEL or `n' to skip to next, `!' to %s all remaining matches with no more questions." (downcase operation) (downcase operation)))) (dired-query 'rename-non-directory-query (concat operation " `%s' to `%s'") (dired-make-relative from) (dired-make-relative to))) to)))) dired-keep-marker-rename))) (defun dired-rename-non-directory (basename-constructor operation arg) (dired-create-files-non-directory (function dired-rename-file) basename-constructor operation arg)) ;;;###autoload (defun dired-upcase (&optional arg) "Rename all marked (or next ARG) files to upper case." (interactive "P") (dired-rename-non-directory (function upcase) "Rename upcase" arg)) ;;;###autoload (defun dired-downcase (&optional arg) "Rename all marked (or next ARG) files to lower case." (interactive "P") (dired-rename-non-directory (function downcase) "Rename downcase" arg)) ;;;###end dired-re.el ;;; 13K ;;;###begin dired-ins.el ;;;###autoload (defun dired-maybe-insert-subdir (dirname &optional switches no-error-if-not-dir-p) "Insert this subdirectory into the same dired buffer. If it is already present, just move to it (type \\[dired-do-redisplay] to refresh), else inserts it at its natural place (as `ls -lR' would have done). With a prefix arg, you may edit the ls switches used for this listing. You can add `R' to the switches to expand the whole tree starting at this subdirectory. This function takes some pains to conform to `ls -lR' output." (interactive (list (dired-get-filename) (if current-prefix-arg (read-string "Switches for listing: " dired-actual-switches)))) (let ((opoint (point))) ;; We don't need a marker for opoint as the subdir is always ;; inserted *after* opoint. (setq dirname (file-name-as-directory dirname)) (or (and (not switches) (dired-goto-subdir dirname)) (dired-insert-subdir dirname switches no-error-if-not-dir-p)) ;; Push mark so that it's easy to find back. Do this after the ;; insert message so that the user sees the `Mark set' message. (push-mark opoint))) (defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p) "Insert this subdirectory into the same dired buffer. If it is already present, overwrites previous entry, else inserts it at its natural place (as `ls -lR' would have done). With a prefix arg, you may edit the `ls' switches used for this listing. You can add `R' to the switches to expand the whole tree starting at this subdirectory. This function takes some pains to conform to `ls -lR' output." ;; NO-ERROR-IF-NOT-DIR-P needed for special filesystems like ;; Prospero where dired-ls does the right thing, but ;; file-directory-p has not been redefined. (interactive (list (dired-get-filename) (if current-prefix-arg (read-string "Switches for listing: " dired-actual-switches)))) (setq dirname (file-name-as-directory (expand-file-name dirname))) (dired-insert-subdir-validate dirname switches) (or no-error-if-not-dir-p (file-directory-p dirname) (error "Attempt to insert a non-directory: %s" dirname)) (let ((elt (assoc dirname dired-subdir-alist)) switches-have-R mark-alist case-fold-search buffer-read-only) ;; case-fold-search is nil now, so we can test for capital `R': (if (setq switches-have-R (and switches (string-match "R" switches))) ;; avoid duplicated subdirs (setq mark-alist (dired-kill-tree dirname t))) (if elt ;; If subdir is already present, remove it and remember its marks (setq mark-alist (nconc (dired-insert-subdir-del elt) mark-alist)) (dired-insert-subdir-newpos dirname)) ; else compute new position (dired-insert-subdir-doupdate dirname elt (dired-insert-subdir-doinsert dirname switches)) (if switches-have-R (dired-build-subdir-alist)) (dired-initial-position dirname) (save-excursion (dired-mark-remembered mark-alist)))) ;; This is a separate function for dired-vms. (defun dired-insert-subdir-validate (dirname &optional switches) ;; Check that it is valid to insert DIRNAME with SWITCHES. ;; Signal an error if invalid (e.g. user typed `i' on `..'). (or (dired-in-this-tree dirname (expand-file-name default-directory)) (error "%s: not in this directory tree" dirname)) (if switches (let (case-fold-search) (mapcar (function (lambda (x) (or (eq (null (string-match x switches)) (null (string-match x dired-actual-switches))) (error "Can't have dirs with and without -%s switches together" x)))) ;; all switches that make a difference to dired-get-filename: '("F" "b"))))) (defun dired-alist-add (dir new-marker) ;; Add new DIR at NEW-MARKER. Sort alist. (dired-alist-add-1 dir new-marker) (dired-alist-sort)) (defun dired-alist-sort () ;; Keep the alist sorted on buffer position. (setq dired-subdir-alist (sort dired-subdir-alist (function (lambda (elt1 elt2) (> (dired-get-subdir-min elt1) (dired-get-subdir-min elt2))))))) (defun dired-kill-tree (dirname &optional remember-marks) ;;"Kill all proper subdirs of DIRNAME, excluding DIRNAME itself. ;; With optional arg REMEMBER-MARKS, return an alist of marked files." (interactive "DKill tree below directory: ") (setq dirname (expand-file-name dirname)) (let ((s-alist dired-subdir-alist) dir m-alist) (while s-alist (setq dir (car (car s-alist)) s-alist (cdr s-alist)) (if (and (not (string-equal dir dirname)) (dired-in-this-tree dir dirname) (dired-goto-subdir dir)) (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist)))) m-alist)) (defun dired-insert-subdir-newpos (new-dir) ;; Find pos for new subdir, according to tree order. ;;(goto-char (point-max)) (let ((alist dired-subdir-alist) elt dir pos new-pos) (while alist (setq elt (car alist) alist (cdr alist) dir (car elt) pos (dired-get-subdir-min elt)) (if (dired-tree-lessp dir new-dir) ;; Insert NEW-DIR after DIR (setq new-pos (dired-get-subdir-max elt) alist nil))) (goto-char new-pos)) ;; want a separating newline between subdirs (or (eobp) (forward-line -1)) (insert "\n") (point)) (defun dired-insert-subdir-del (element) ;; Erase an already present subdir (given by ELEMENT) from buffer. ;; Move to that buffer position. Return a mark-alist. (let ((begin-marker (dired-get-subdir-min element))) (goto-char begin-marker) ;; Are at beginning of subdir (and inside it!). Now determine its end: (goto-char (dired-subdir-max)) (or (eobp);; want a separating newline _between_ subdirs: (forward-char -1)) (prog1 (dired-remember-marks begin-marker (point)) (delete-region begin-marker (point))))) (defun dired-insert-subdir-doinsert (dirname switches) ;; Insert ls output after point and put point on the correct ;; position for the subdir alist. ;; Return the boundary of the inserted text (as list of BEG and END). (let ((begin (point)) end) (message "Reading directory %s..." dirname) (let ((dired-actual-switches (or switches (dired-replace-in-string "R" "" dired-actual-switches)))) (if (equal dirname (car (car (reverse dired-subdir-alist)))) ;; top level directory may contain wildcards: (dired-readin-insert dired-directory) (let ((opoint (point))) (insert-directory dirname dired-actual-switches nil t) (dired-insert-set-properties opoint (point))))) (message "Reading directory %s...done" dirname) (setq end (point-marker)) (indent-rigidly begin end 2) ;; call dired-insert-headerline afterwards, as under VMS dired-ls ;; does insert the headerline itself and the insert function just ;; moves point. ;; Need a marker for END as this inserts text. (goto-char begin) (dired-insert-headerline dirname) ;; point is now like in dired-build-subdir-alist (prog1 (list begin (marker-position end)) (set-marker end nil)))) (defun dired-insert-subdir-doupdate (dirname elt beg-end) ;; Point is at the correct subdir alist position for ELT, ;; BEG-END is the subdir-region (as list of begin and end). (if elt ; subdir was already present ;; update its position (should actually be unchanged) (set-marker (dired-get-subdir-min elt) (point-marker)) (dired-alist-add dirname (point-marker))) ;; The hook may depend on the subdir-alist containing the just ;; inserted subdir, so run it after dired-alist-add: (if dired-after-readin-hook (save-excursion (let ((begin (nth 0 beg-end)) (end (nth 1 beg-end))) (goto-char begin) (save-restriction (narrow-to-region begin end) ;; hook may add or delete lines, but the subdir boundary ;; marker floats (run-hooks 'dired-after-readin-hook)))))) (defun dired-tree-lessp (dir1 dir2) ;; Lexicographic order on pathname components, like `ls -lR': ;; DIR1 < DIR2 iff DIR1 comes *before* DIR2 in an `ls -lR' listing, ;; i.e., iff DIR1 is a (grand)parent dir of DIR2, ;; or DIR1 and DIR2 are in the same parentdir and their last ;; components are string-lessp. ;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp. ;; string-lessp could arguably be replaced by file-newer-than-file-p ;; if dired-actual-switches contained `t'. (setq dir1 (file-name-as-directory dir1) dir2 (file-name-as-directory dir2)) (let ((components-1 (dired-split "/" dir1)) (components-2 (dired-split "/" dir2))) (while (and components-1 components-2 (equal (car components-1) (car components-2))) (setq components-1 (cdr components-1) components-2 (cdr components-2))) (let ((c1 (car components-1)) (c2 (car components-2))) (cond ((and c1 c2) (string-lessp c1 c2)) ((and (null c1) (null c2)) nil) ; they are equal, not lessp ((null c1) ; c2 is a subdir of c1: c1c2 nil) (t (error "This can't happen")))))) ;; There should be a builtin split function - inverse to mapconcat. (defun dired-split (pat str &optional limit) "Splitting on regexp PAT, turn string STR into a list of substrings. Optional third arg LIMIT (>= 1) is a limit to the length of the resulting list. Thus, if SEP is a regexp that only matches itself, (mapconcat 'identity (dired-split SEP STRING) SEP) is always equal to STRING." (let* ((start (string-match pat str)) (result (list (substring str 0 start))) (count 1) (end (if start (match-end 0)))) (if end ; else nothing left (while (and (or (not (integerp limit)) (< count limit)) (string-match pat str end)) (setq start (match-beginning 0) count (1+ count) result (cons (substring str end start) result) end (match-end 0) start end) )) (if (and (or (not (integerp limit)) (< count limit)) end) ; else nothing left (setq result (cons (substring str end) result))) (nreverse result))) ;;; moving by subdirectories ;;;###autoload (defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip) "Go to previous subdirectory, regardless of level. When called interactively and not on a subdir line, go to this subdir's line." ;;(interactive "p") (interactive (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) ;; if on subdir start already, don't stay there! (if (dired-get-subdir) 1 0)))) (dired-next-subdir (- arg) no-error-if-not-found no-skip)) (defun dired-subdir-min () (save-excursion (if (not (dired-prev-subdir 0 t t)) (error "Not in a subdir!") (point)))) ;;;###autoload (defun dired-goto-subdir (dir) "Go to end of header line of DIR in this dired buffer. Return value of point on success, otherwise return nil. The next char is either \\n, or \\r if DIR is hidden." (interactive (prog1 ; let push-mark display its message (list (expand-file-name (completing-read "Goto in situ directory: " ; prompt dired-subdir-alist ; table nil ; predicate t ; require-match (dired-current-directory)))) (push-mark))) (setq dir (file-name-as-directory dir)) (let ((elt (assoc dir dired-subdir-alist))) (and elt (goto-char (dired-get-subdir-min elt)) ;; dired-subdir-hidden-p and dired-add-entry depend on point being ;; at either \r or \n after this function succeeds. (progn (skip-chars-forward "^\r\n") (point))))) ;;;###autoload (defun dired-mark-subdir-files () "Mark all files except `.' and `..'." (interactive) (let ((p-min (dired-subdir-min))) (dired-mark-files-in-region p-min (dired-subdir-max)))) ;;;###autoload (defun dired-kill-subdir (&optional remember-marks) "Remove all lines of current subdirectory. Lower levels are unaffected." ;; With optional REMEMBER-MARKS, return a mark-alist. (interactive) (let ((beg (dired-subdir-min)) (end (dired-subdir-max)) buffer-read-only cur-dir) (setq cur-dir (dired-current-directory)) (if (equal cur-dir default-directory) (error "Attempt to kill top level directory")) (prog1 (if remember-marks (dired-remember-marks beg end)) (delete-region beg end) (if (eobp) ; don't leave final blank line (delete-char -1)) (dired-unsubdir cur-dir)))) (defun dired-unsubdir (dir) ;; Remove DIR from the alist (setq dired-subdir-alist (delq (assoc dir dired-subdir-alist) dired-subdir-alist))) ;;;###autoload (defun dired-tree-up (arg) "Go up ARG levels in the dired tree." (interactive "p") (let ((dir (dired-current-directory))) (while (>= arg 1) (setq arg (1- arg) dir (file-name-directory (directory-file-name dir)))) ;;(setq dir (expand-file-name dir)) (or (dired-goto-subdir dir) (error "Cannot go up to %s - not in this tree." dir)))) ;;;###autoload (defun dired-tree-down () "Go down in the dired tree." (interactive) (let ((dir (dired-current-directory)) ; has slash pos case-fold-search) ; filenames are case sensitive (let ((rest (reverse dired-subdir-alist)) elt) (while rest (setq elt (car rest) rest (cdr rest)) (if (dired-in-this-tree (directory-file-name (car elt)) dir) (setq rest nil pos (dired-goto-subdir (car elt)))))) (if pos (goto-char pos) (error "At the bottom")))) ;;; hiding (defun dired-unhide-subdir () (let (buffer-read-only) (subst-char-in-region (dired-subdir-min) (dired-subdir-max) ?\r ?\n))) (defun dired-hide-check () (or selective-display (error "selective-display must be t for subdir hiding to work!"))) (defun dired-subdir-hidden-p (dir) (and selective-display (save-excursion (dired-goto-subdir dir) (looking-at "\r")))) ;;;###autoload (defun dired-hide-subdir (arg) "Hide or unhide the current subdirectory and move to next directory. Optional prefix arg is a repeat factor. Use \\[dired-hide-all] to (un)hide all directories." (interactive "p") (dired-hide-check) (while (>= (setq arg (1- arg)) 0) (let* ((cur-dir (dired-current-directory)) (hidden-p (dired-subdir-hidden-p cur-dir)) (elt (assoc cur-dir dired-subdir-alist)) (end-pos (1- (dired-get-subdir-max elt))) buffer-read-only) ;; keep header line visible, hide rest (goto-char (dired-get-subdir-min elt)) (skip-chars-forward "^\n\r") (if hidden-p (subst-char-in-region (point) end-pos ?\r ?\n) (subst-char-in-region (point) end-pos ?\n ?\r))) (dired-next-subdir 1 t))) ;;;###autoload (defun dired-hide-all (arg) "Hide all subdirectories, leaving only their header lines. If there is already something hidden, make everything visible again. Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." (interactive "P") (dired-hide-check) (let (buffer-read-only) (if (save-excursion (goto-char (point-min)) (search-forward "\r" nil t)) ;; unhide - bombs on \r in filenames (subst-char-in-region (point-min) (point-max) ?\r ?\n) ;; hide (let ((pos (point-max)) ; pos of end of last directory (alist dired-subdir-alist)) (while alist ; while there are dirs before pos (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir (save-excursion (goto-char pos) ; current dir ;; we're somewhere on current dir's line (forward-line -1) (point)) ?\n ?\r) (setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current dir (setq alist (cdr alist))))))) ;;;###end dired-ins.el ;; Functions for searching in tags style among marked files. ;;;###autoload (defun dired-do-search (regexp) "Search through all marked files for a match for REGEXP. Stops when a match is found. To continue searching for next match, use command \\[tags-loop-continue]." (interactive "sSearch marked files (regexp): ") (tags-search regexp '(dired-get-marked-files))) ;;;###autoload (defun dired-do-query-replace (from to &optional delimited) "Do `query-replace-regexp' of FROM with TO, on all marked files. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit] or ESC), you can resume the query replace with the command \\[tags-loop-continue]." (interactive "sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP") (tags-query-replace from to delimited '(dired-get-marked-files))) (provide 'dired-aux) ;;; dired-aux.el ends here emacs-19.30/lisp/dired-x.el100444 22556 1 177761 6025413146 14160 0ustar erikdaemon;;; dired-x.el --- Sebastian Kremer's Extra DIRED hacked up for GNU Emacs19 ;; Author: Sebastian Kremer ;; Lawrence R. Dodd ;; Maintainer: Lawrence R. Dodd ;; Version: 2.37+ ;; Date: 1994/08/18 19:27:42 ;; Keywords: dired extensions ;; Copyright (C) 1993, 1994 Free Software Foundation ;; 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 is Sebastian Kremer's excellent dired-x.el (Dired Extra), version ;;; 1.191, hacked up for GNU Emacs 19. Redundant or conflicting material ;;; has been removed or renamed in order to work properly with dired of ;;; GNU Emacs 19. All suggestions or comments are most welcomed. ;;; ;;; Please, PLEASE, *PLEASE* see the info pages. ;;; ;;; BUGS: Type M-x dired-x-submit-report and a report will be generated. ;;; INSTALLATION: In your ~/.emacs, ;;; ;;; (add-hook 'dired-load-hook ;;; (function (lambda () ;;; (load "dired-x") ;;; ;; Set global variables here. For example: ;;; ;; (setq dired-guess-shell-gnutar "gtar") ;;; ))) ;;; (add-hook 'dired-mode-hook ;;; (function (lambda () ;;; ;; Set buffer-local variables here. For example: ;;; ;; (setq dired-omit-files-p t) ;;; ))) ;;; ;;; At load time dired-x.el will install itself, redefine some functions, and ;;; bind some dired keys. *Please* see the info pages for more details. ;;; CAUTION: If you are using a version of GNU Emacs earlier than 19.20 than ;;; you may have to edit dired.el. The copy of dired.el in GNU Emacs versions ;;; earlier than 19.20 incorrectly had the call to run-hooks *before* the call ;;; to provide. In such a case, it is possible that byte-compiling and/or ;;; loading dired can cause an infinite loop. To prevent this, make sure the ;;; line of code ;;; ;;; (run-hooks 'dired-load-hook) ;;; ;;; is the *last* executable line in the file dired.el. That is, make sure it ;;; comes *after* the line ;;; ;;; (provide 'dired) ;;; ;;; *Please* see the info pages for more details. ;;; User defined variables: ;;; ;;; dired-bind-vm ;;; dired-vm-read-only-folders ;;; dired-bind-jump ;;; dired-bind-info ;;; dired-bind-man ;;; dired-x-hands-off-my-keys ;;; dired-find-subdir ;;; dired-enable-local-variables ;;; dired-local-variables-file ;;; dired-guess-shell-gnutar ;;; dired-guess-shell-gzip-quiet ;;; dired-guess-shell-znew-switches ;;; dired-guess-shell-alist-user ;;; dired-clean-up-buffers-too ;;; dired-omit-files-p ;;; dired-omit-files ;;; dired-omit-extensions ;;; ;;; To find out more about these variables, load this file, put your cursor at ;;; the end of any of the variable names, and hit C-h v [RET]. *Please* see ;;; the info pages for more details. ;;; When loaded this code redefines the following functions of GNU Emacs ;;; ;;; Function Found in this file of GNU Emacs ;;; -------- ------------------------------- ;;; dired-clean-up-after-deletion ../lisp/dired.el ;;; dired-find-buffer-nocreate ../lisp/dired.el ;;; dired-initial-position ../lisp/dired.el ;;; ;;; dired-add-entry ../lisp/dired-aux.el ;;; dired-read-shell-command ../lisp/dired-aux.el ;;; ;;; One drawback is that dired-x.el will load dired-aux.el as soon as dired is ;;; loaded. Thus, the advantage of separating out non-essential dired stuff ;;; into dired-aux.el and only loading when necessary will be lost. Please ;;; note also that some of the comments in dired.el and dired-aux.el are ;;; Kremer's that referred to the old dired-x.el. This now should be referring ;;; to this program. (This is also a good reason to call this dired-x.el ;;; instead of dired-x19.el.) ;;;; Code: ;;; LOAD. ;;; This is a no-op if dired-x is being loaded via `dired-load-hook'. It is ;;; here in case the user has autoloaded dired-x via the dired-jump key binding ;;; (instead of autoloading to dired as is suggested in the info-pages). (require 'dired) ;;; We will redefine some functions and also need some macros so we need to ;;; load dired stuff of GNU Emacs. (require 'dired-aux) ;;;; User-defined variables. (defvar dired-bind-vm nil "*t says \"V\" in dired-mode will `dired-vm', otherwise \"V\" is `dired-rmail'. Also, RMAIL files contain -*- rmail -*- at the top so \"f\", `dired-advertised-find-file', will run rmail.") (defvar dired-bind-jump t "*t says bind `dired-jump' to C-x C-j, otherwise do not.") (defvar dired-bind-man t "*t says bind `dired-man' to \"N\" in dired-mode, otherwise do not.") (defvar dired-bind-info t "*t says bind `dired-info' to \"I\" in dired-mode, otherwise do not.") (defvar dired-vm-read-only-folders nil "*If t, \\[dired-vm] will visit all folders read-only. If neither nil nor t, e.g. the symbol `if-file-read-only', only files not writable by you are visited read-only. Read-only folders only work in VM 5, not in VM 4.") (defvar dired-omit-files-p nil "*If non-nil, \"uninteresting\" files are not listed (buffer-local). Use \\[dired-omit-toggle] to toggle its value. Uninteresting files are those whose filenames match regexp `dired-omit-files', plus those ending with extensions in `dired-omit-extensions'.") (make-variable-buffer-local 'dired-omit-files-p) (defvar dired-omit-files "^#\\|^\\.$\\|^\\.\\.$" "*Filenames matching this regexp will not be displayed. This only has effect when `dired-omit-files-p' is t. See interactive function `dired-omit-toggle' \(\\[dired-omit-toggle]\) and variable `dired-omit-extensions'. The default is to omit `.', `..', and auto-save files.") (defvar dired-find-subdir nil ; t is pretty near to DWIM... "*If non-nil, Dired always finds a directory in a buffer of its own. If nil, Dired finds the directory as a subdirectory in some other buffer if it is present as one. If there are several Dired buffers for a directory, the most recently used is chosen. Dired avoids switching to the current buffer, so that if you have a normal and a wildcard buffer for the same directory, C-x d RET will toggle between those two.") (defvar dired-enable-local-variables t "*Control use of local-variables lists in dired. The value can be t, nil or something else. A value of t means local-variables lists are obeyed; nil means they are ignored; anything else means query. This temporarily overrides the value of `enable-local-variables' when listing a directory. See also `dired-local-variables-file'.") (defvar dired-guess-shell-gnutar nil "*If non-nil, name of GNU tar executable (e.g., \"tar\" or \"gtar\") and `z' switch will be used for compressed or gzip'ed tar files. If no GNU tar, set to nil: a pipe using `zcat' or `gunzip -c' will be used.") (defvar dired-guess-shell-gzip-quiet t "*non-nil says pass -q to gzip overriding verbose GZIP environment.") (defvar dired-guess-shell-znew-switches nil "*If non-nil, then string of switches passed to `znew', example: \"-K\"") (defvar dired-clean-up-buffers-too t "*t says offer to kill buffers visiting files and dirs deleted in dired.") ;;;; KEY BINDINGS. (define-key dired-mode-map "\M-o" 'dired-omit-toggle) (define-key dired-mode-map "\M-(" 'dired-mark-sexp) (define-key dired-mode-map "\M-!" 'dired-smart-shell-command) (define-key dired-mode-map "T" 'dired-do-toggle) (define-key dired-mode-map "w" 'dired-copy-filename-as-kill) (define-key dired-mode-map "\M-g" 'dired-goto-file) (define-key dired-mode-map "\M-G" 'dired-goto-subdir) (define-key dired-mode-map "F" 'dired-do-find-marked-files) (define-key dired-mode-map "Y" 'dired-do-relsymlink) (define-key dired-mode-map "%Y" 'dired-do-relsymlink-regexp) (define-key dired-mode-map "V" 'dired-do-run-mail) (if dired-bind-man (define-key dired-mode-map "N" 'dired-man)) (if dired-bind-info (define-key dired-mode-map "I" 'dired-info)) ;;; GLOBAL BINDING. (if dired-bind-jump (progn (define-key global-map "\C-x\C-j" 'dired-jump) (define-key global-map "\C-x4\C-j" 'dired-jump-other-window))) ;;;; Install into appropriate hooks. (add-hook 'dired-mode-hook 'dired-extra-startup) (add-hook 'dired-after-readin-hook 'dired-omit-expunge) (defun dired-extra-startup () "Automatically put on dired-mode-hook to get extra dired features: \\ \\[dired-do-run-mail]\t-- run mail on folder (see `dired-bind-vm') \\[dired-info]\t-- run info on file \\[dired-man]\t-- run man on file \\[dired-do-find-marked-files]\t-- visit all marked files simultaneously \\[dired-omit-toggle]\t-- toggle omitting of files \\[dired-do-toggle]\t-- toggle marks \\[dired-mark-sexp]\t-- mark by lisp expression \\[dired-copy-filename-as-kill]\t-- copy the file or subdir names into the kill ring. \t You can feed it to other commands using \\[yank]. For more features, see variables dired-bind-vm dired-bind-jump dired-bind-info dired-bind-man dired-vm-read-only-folders dired-omit-files-p dired-omit-files dired-omit-extensions dired-find-subdir dired-enable-local-variables dired-local-variables-file dired-guess-shell-gnutar dired-guess-shell-gzip-quiet dired-guess-shell-znew-switches dired-guess-shell-alist-user dired-clean-up-buffers-too See also functions dired-flag-extension dired-virtual dired-jump dired-man dired-vm dired-rmail dired-info dired-do-find-marked-files " (interactive) ;; These must be done in each new dired buffer. (dired-hack-local-variables) (dired-omit-startup)) ;;;; BUFFER CLEANING. ;;; REDEFINE. (defun dired-clean-up-after-deletion (fn) ;; Clean up after a deleted file or directory FN. ;; Remove expanded subdir of deleted dir, if any. (save-excursion (and (cdr dired-subdir-alist) (dired-goto-subdir fn) (dired-kill-subdir))) ;; Offer to kill buffer of deleted file FN. (if dired-clean-up-buffers-too (progn (let ((buf (get-file-buffer fn))) (and buf (funcall (function y-or-n-p) (format "Kill buffer of %s, too? " (file-name-nondirectory fn))) (save-excursion ; you never know where kill-buffer leaves you (kill-buffer buf)))) (let ((buf-list (dired-buffers-for-dir (expand-file-name fn))) (buf nil)) (and buf-list (y-or-n-p (format "Kill dired buffer%s of %s, too? " (dired-plural-s (length buf-list)) (file-name-nondirectory fn))) (while buf-list (save-excursion (kill-buffer (car buf-list))) (setq buf-list (cdr buf-list))))))) ;; Anything else? ) ;;;; EXTENSION MARKING FUNCTIONS. ;;; Mark files with some extension. (defun dired-mark-extension (extension &optional marker-char) "Mark all files with a certain extension for use in later commands. A `.' is not automatically prepended to the string entered." ;; EXTENSION may also be a list of extensions instead of a single one. ;; Optional MARKER-CHAR is marker to use. (interactive "sMarking extension: \nP") (or (listp extension) (setq extension (list extension))) (dired-mark-files-regexp (concat ".";; don't match names with nothing but an extension "\\(" (mapconcat 'regexp-quote extension "\\|") "\\)$") marker-char)) (defun dired-flag-extension (extension) "In dired, flag all files with a certain extension for deletion. A `.' is *not* automatically prepended to the string entered." (interactive "sFlagging extension: ") (dired-mark-extension extension dired-del-marker)) ;;; Define some unpopular file extensions. Used for cleaning and omitting. (defvar dired-patch-unclean-extensions '(".rej" ".orig") "List of extensions of dispensable files created by the `patch' program.") (defvar dired-tex-unclean-extensions '(".toc" ".log" ".aux");; these are already in completion-ignored-extensions "List of extensions of dispensable files created by TeX.") (defvar dired-latex-unclean-extensions '(".idx" ".lof" ".lot" ".glo") "List of extensions of dispensable files created by LaTeX.") (defvar dired-bibtex-unclean-extensions '(".blg" ".bbl") "List of extensions of dispensable files created by BibTeX.") (defvar dired-texinfo-unclean-extensions '(".cp" ".cps" ".fn" ".fns" ".ky" ".kys" ".pg" ".pgs" ".tp" ".tps" ".vr" ".vrs") "List of extensions of dispensable files created by texinfo.") (defun dired-clean-patch () "Flag dispensable files created by patch for deletion. See variable `dired-patch-unclean-extensions'." (interactive) (dired-flag-extension dired-patch-unclean-extensions)) (defun dired-clean-tex () "Flag dispensable files created by [La]TeX etc. for deletion. See variables `dired-texinfo-unclean-extensions', `dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions' and `dired-texinfo-unclean-extensions'." (interactive) (dired-flag-extension (append dired-texinfo-unclean-extensions dired-latex-unclean-extensions dired-bibtex-unclean-extensions dired-tex-unclean-extensions))) (defun dired-very-clean-tex () "Flag dispensable files created by [La]TeX *and* \".dvi\" for deletion. See variables `dired-texinfo-unclean-extensions', `dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions' and `dired-texinfo-unclean-extensions'." (interactive) (dired-flag-extension (append dired-texinfo-unclean-extensions dired-latex-unclean-extensions dired-bibtex-unclean-extensions dired-tex-unclean-extensions (list ".dvi")))) ;;;; JUMP. ;;;###autoload (defun dired-jump (&optional other-window) "Jump to dired buffer corresponding to current buffer. If in a file, dired the current directory and move to file's line. If in dired already, pop up a level and goto old directory's line. In case the proper dired file line cannot be found, refresh the dired buffer and try again." (interactive "P") (let* ((file buffer-file-name) (dir (if file (file-name-directory file) default-directory))) (if (eq major-mode 'dired-mode) (progn (setq dir (dired-current-directory)) (dired-up-directory other-window) (or (dired-goto-file dir) ;; refresh and try again (progn (dired-insert-subdir (file-name-directory dir)) (dired-goto-file dir)))) (if other-window (dired-other-window dir) (dired dir)) (if file (or (dired-goto-file file) ;; Toggle omitting, if necessary, and try again. (progn (dired-omit-toggle t) (dired-goto-file file)) ;; refresh and try again (progn (dired-insert-subdir (file-name-directory file)) (dired-goto-file file))))))) (defun dired-jump-other-window () "Like \\[dired-jump] (dired-jump) but in other window." (interactive) (dired-jump t)) ;;;; TOGGLE. ;;; Toggle marked files with unmarked files. (defun dired-do-toggle () "Toggle marks. That is, currently marked files become unmarked and vice versa. Files marked with other flags (such as `D') are not affected. `.' and `..' are never toggled. As always, hidden subdirs are not affected." (interactive) (save-excursion (goto-char (point-min)) (let (buffer-read-only) (while (not (eobp)) (or (dired-between-files) (looking-at dired-re-dot) ;; use subst instead of insdel because it does not move ;; the gap and thus should be faster and because ;; other characters are left alone automatically (apply 'subst-char-in-region (point) (1+ (point)) (if (eq ?\040 (following-char)) ; SPC (list ?\040 dired-marker-char) (list dired-marker-char ?\040)))) (forward-line 1))))) ;;;; COPY NAMES OF MARKED FILES INTO KILL-RING. (defun dired-copy-filename-as-kill (&optional arg) "Copy names of marked (or next ARG) files into the kill ring. The names are separated by a space. With a zero prefix arg, use the complete pathname of each marked file. With \\[universal-argument], use the relative pathname of each marked file. If on a subdir headerline, use subdirname instead; prefix arg is ignored in this case. You can then feed the file name(s) to other commands with \\[yank]." (interactive "P") (let ((string (or (dired-get-subdir) (mapconcat (function identity) (if arg (cond ((zerop (prefix-numeric-value arg)) (dired-get-marked-files)) ((integerp arg) (dired-get-marked-files 'no-dir arg)) (t ; else a raw arg (dired-get-marked-files t))) (dired-get-marked-files 'no-dir)) " ")))) (kill-new string) (message "%s" string))) ;;;; OMITTING. ;;; Enhanced omitting of lines from directory listings. ;;; Marked files are never omitted. ;; should probably get rid of this and always use 'no-dir. ;; sk 28-Aug-1991 09:37 (defvar dired-omit-localp 'no-dir "The LOCALP argument dired-omit-expunge passes to dired-get-filename. If it is 'no-dir, omitting is much faster, but you can only match against the basename of the file. Set it to nil if you need to match the whole pathname.") ;; \017=^O for Omit - other packages can chose other control characters. (defvar dired-omit-marker-char ?\017 "Temporary marker used by by dired-omit. Should never be used as marker by the user or other packages.") (defun dired-omit-startup () (or (assq 'dired-omit-files-p minor-mode-alist) (setq minor-mode-alist (append '((dired-omit-files-p " Omit")) minor-mode-alist)))) (defun dired-omit-toggle (&optional flag) "Toggle omitting files matching `dired-omit-files' and `dired-omit-extensions'. With an arg, and if omitting was off, don't toggle and just mark the files but don't actually omit them. With an arg, and if omitting was on, turn it off but don't refresh the buffer." (interactive "P") (if flag (if dired-omit-files-p (setq dired-omit-files-p (not dired-omit-files-p)) (dired-mark-unmarked-files (dired-omit-regexp) nil nil dired-omit-localp)) ;; no FLAG (setq dired-omit-files-p (not dired-omit-files-p)) (if (not dired-omit-files-p) (revert-buffer) ;; this will mention how many were omitted: (dired-omit-expunge)))) (defvar dired-omit-extensions (append completion-ignored-extensions dired-latex-unclean-extensions dired-bibtex-unclean-extensions dired-texinfo-unclean-extensions) "If non-nil, a list of extensions \(strings\) to omit from Dired listings. Defaults to elements of `completion-ignored-extensions', `dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions', and `dired-texinfo-unclean-extensions'. See interactive function `dired-omit-toggle' \(\\[dired-omit-toggle]\) and variables `dired-omit-files-p' and `dired-omit-files'.") (defun dired-omit-expunge (&optional regexp) "Erases all unmarked files matching REGEXP. Does nothing if global variable `dired-omit-files-p' is nil. If REGEXP is nil or not specified, uses `dired-omit-files', and also omits filenames ending in `dired-omit-extensions'. If REGEXP is the empty string, this function is a no-op. This functions works by temporarily binding `dired-marker-char' to `dired-omit-marker-char' and calling `dired-do-kill-lines'." (interactive "sOmit files (regexp): ") (if dired-omit-files-p (let ((omit-re (or regexp (dired-omit-regexp))) (old-modified-p (buffer-modified-p)) count) (or (string= omit-re "") (let ((dired-marker-char dired-omit-marker-char)) (message "Omitting...") (if (dired-mark-unmarked-files omit-re nil nil dired-omit-localp) (progn (setq count (dired-do-kill-lines nil "Omitted %d line%s.")) (force-mode-line-update)) (message "(Nothing to omit)")))) ;; Try to preserve modified state of buffer. So `%*' doesn't appear ;; in mode-line of omitted buffers. (set-buffer-modified-p (and old-modified-p (save-excursion (goto-char (point-min)) (re-search-forward dired-re-mark nil t)))) count))) (defun dired-omit-regexp () (concat (if dired-omit-files (concat "\\(" dired-omit-files "\\)") "") (if (and dired-omit-files dired-omit-extensions) "\\|" "") (if dired-omit-extensions (concat ".";; a non-extension part should exist "\\(" (mapconcat 'regexp-quote dired-omit-extensions "\\|") "\\)$") ""))) ;; Returns t if any work was done, nil otherwise. (defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp) "Marks unmarked files matching REGEXP, displaying MSG. REGEXP is matched against the complete pathname. Does not re-mark files which already have a mark. With prefix argument, unflag all those files. Second optional argument LOCALP is as in `dired-get-filename'." (interactive "P") (let ((dired-marker-char (if unflag-p ?\ dired-marker-char))) (dired-mark-if (and ;; not already marked (looking-at " ") ;; uninteresting (let ((fn (dired-get-filename localp t))) (and fn (string-match regexp fn)))) msg))) ;;; REDEFINE. (defun dired-omit-new-add-entry (filename &optional marker-char) ;; This redefines dired-aux.el's dired-add-entry to avoid calling ls for ;; files that are going to be omitted anyway. (if dired-omit-files-p ;; perhaps return t without calling ls (let ((omit-re (dired-omit-regexp))) (if (or (string= omit-re "") (not (string-match omit-re (cond ((eq 'no-dir dired-omit-localp) filename) ((eq t dired-omit-localp) (dired-make-relative filename)) (t (dired-make-absolute filename (file-name-directory filename))))))) ;; if it didn't match, go ahead and add the entry (dired-omit-old-add-entry filename marker-char) ;; dired-add-entry returns t for success, perhaps we should ;; return file-exists-p t)) ;; omitting is not turned on at all (dired-omit-old-add-entry filename marker-char))) ;;; REDEFINE. ;;; Redefine dired-aux.el's version of `dired-add-entry' ;;; Save old defun if not already done: (or (fboundp 'dired-omit-old-add-entry) (fset 'dired-omit-old-add-entry (symbol-function 'dired-add-entry))) ;; Redefine it. (fset 'dired-add-entry 'dired-omit-new-add-entry) ;;;; VIRTUAL DIRED MODE. ;;; For browsing `ls -lR' listings in a dired-like fashion. (fset 'virtual-dired 'dired-virtual) (defun dired-virtual (dirname &optional switches) "Put this buffer into Virtual Dired mode. In Virtual Dired mode, all commands that do not actually consult the filesystem will work. This is useful if you want to peruse and move around in an ls -lR output file, for example one you got from an ftp server. With ange-ftp, you can even dired a directory containing an ls-lR file, visit that file and turn on virtual dired mode. But don't try to save this file, as dired-virtual indents the listing and thus changes the buffer. If you have save a Dired buffer in a file you can use \\[dired-virtual] to resume it in a later session. Type \\\\[revert-buffer] in the Virtual Dired buffer and answer `y' to convert the virtual to a real dired buffer again. You don't have to do this, though: you can relist single subdirs using \\[dired-do-redisplay]. " ;; DIRNAME is the top level directory of the buffer. It will become ;; its `default-directory'. If nil, the old value of ;; default-directory is used. ;; Optional SWITCHES are the ls switches to use. ;; Shell wildcards will be used if there already is a `wildcard' ;; line in the buffer (thus it is a saved Dired buffer), but there ;; is no other way to get wildcards. Insert a `wildcard' line by ;; hand if you want them. (interactive (list (read-string "Virtual Dired directory: " (dired-virtual-guess-dir)))) (goto-char (point-min)) (or (looking-at " ") ;; if not already indented, do it now: (indent-region (point-min) (point-max) 2)) (or dirname (setq dirname default-directory)) (setq dirname (expand-file-name (file-name-as-directory dirname))) (setq default-directory dirname) ; contains no wildcards (let ((wildcard (save-excursion (goto-char (point-min)) (forward-line 1) (and (looking-at "^ wildcard ") (buffer-substring (match-end 0) (progn (end-of-line) (point))))))) (if wildcard (setq dirname (expand-file-name wildcard default-directory)))) ;; If raw ls listing (not a saved old dired buffer), give it a ;; decent subdir headerline: (goto-char (point-min)) (or (looking-at dired-subdir-regexp) (dired-insert-headerline default-directory)) (dired-mode dirname (or switches dired-listing-switches)) (setq mode-name "Virtual Dired" revert-buffer-function 'dired-virtual-revert) (set (make-local-variable 'dired-subdir-alist) nil) (dired-build-subdir-alist) (goto-char (point-min)) (dired-initial-position dirname)) (defun dired-virtual-guess-dir () ;; Guess and return appropriate working directory of this buffer, ;; assumed to be in Dired or ls -lR format. ;; The guess is based upon buffer contents. ;; If nothing could be guessed, returns nil. (let ((regexp "^\\( \\)?\\([^ \n\r]*\\)\\(:\\)[\n\r]") (subexpr 2)) (goto-char (point-min)) (cond ((looking-at regexp) ;; If a saved dired buffer, look to which dir and ;; perhaps wildcard it belongs: (let ((dir (buffer-substring (match-beginning subexpr) (match-end subexpr)))) (file-name-as-directory dir))) ;; Else no match for headerline found. It's a raw ls listing. ;; In raw ls listings the directory does not have a headerline ;; try parent of first subdir, if any ((re-search-forward regexp nil t) (file-name-directory (directory-file-name (file-name-as-directory (buffer-substring (match-beginning subexpr) (match-end subexpr)))))) (t ; if all else fails nil)))) (defun dired-virtual-revert (&optional arg noconfirm) (if (not (y-or-n-p "Cannot revert a Virtual Dired buffer - switch to Real Dired mode? ")) (error "Cannot revert a Virtual Dired buffer.") (setq mode-name "Dired" revert-buffer-function 'dired-revert) (revert-buffer))) ;; A zero-arg version of dired-virtual. ;; You need my modified version of set-auto-mode for the ;; `buffer-contents-mode-alist'. ;; Or you use infer-mode.el and infer-mode-alist, same syntax. (defun dired-virtual-mode () "Put current buffer into virtual dired mode (see `dired-virtual'). Useful on `buffer-contents-mode-alist' (which see) with the regexp \"^ \\(/[^ /]+\\)/?+:$\" to put saved dired buffers automatically into virtual dired mode. Also useful for `auto-mode-alist' (which see) like this: \(setq auto-mode-alist (cons '(\"[^/]\\.dired\\'\" . dired-virtual-mode) auto-mode-alist)\)" (interactive) (dired-virtual (dired-virtual-guess-dir))) ;;;; SMART SHELL. ;;; An Emacs buffer can have but one working directory, stored in the ;;; buffer-local variable `default-directory'. A Dired buffer may have ;;; several subdirectories inserted, but still has but one working directory: ;;; that of the top level Dired directory in that buffer. For some commands ;;; it is appropriate that they use the current Dired directory instead of ;;; `default-directory', e.g., `find-file' and `compile'. This is a general ;;; mechanism is provided for special handling of the working directory in ;;; special major modes. ;; It's easier to add to this alist than redefine function ;; default-directory while keeping the old information. (defconst default-directory-alist '((dired-mode . (if (fboundp 'dired-current-directory) (dired-current-directory) default-directory))) "Alist of major modes and their opinion on default-directory, as a lisp expression to evaluate. A resulting value of nil is ignored in favor of default-directory.") (defun default-directory () "Usage like variable `default-directory', but knows about the special cases in variable `default-directory-alist' (which see)." (or (eval (cdr (assq major-mode default-directory-alist))) default-directory)) (defun dired-smart-shell-command (cmd &optional insert) "Like function `shell-command', but in the current Tree Dired directory." (interactive "sShell command: \nP") (let ((default-directory (default-directory))) (shell-command cmd insert))) ;;;; LOCAL VARIABLES FOR DIRED BUFFERS. ;;; Brief Description: ;;; ;;; * `dired-extra-startup' is part of the `dired-mode-hook'. ;;; ;;; * `dired-extra-startup' calls `dired-hack-local-variables' ;;; ;;; * `dired-hack-local-variables' checks the value of ;;; `dired-local-variables-file' ;;; ;;; * Check if `dired-local-variables-file' is a non-nil string and is a ;;; filename found in the directory of the Dired Buffer being created. ;;; ;;; * If `dired-local-variables-file' satisfies the above, then temporarily ;;; include it in the Dired Buffer at the bottom. ;;; ;;; * Set `enable-local-variables' temporarily to the user variable ;;; `dired-enable-local-variables' and run `hack-local-variables' on the ;;; Dired Buffer. (defvar dired-local-variables-file ".dired" "Filename, as string, containing local dired buffer variables to be hacked. If this file found in current directory, then it will be inserted into dired buffer and `hack-local-variables' will be run. See Emacs Info pages for more information on local variables. See also `dired-enable-local-variables'.") (defun dired-hack-local-variables () "Evaluate local variables in `dired-local-variables-file' for dired buffer." (if (and dired-local-variables-file (stringp dired-local-variables-file) (file-exists-p dired-local-variables-file)) (let ((opoint (point-max)) buffer-read-only ;; In case user has `enable-local-variables' set to nil we ;; override it locally with dired's variable. (enable-local-variables dired-enable-local-variables)) ;; Insert 'em. (save-excursion (goto-char opoint) (insert "\^L\n") (insert-file-contents dired-local-variables-file)) ;; Hack 'em. (let ((buffer-file-name dired-local-variables-file)) (hack-local-variables)) ;; Make sure that the modeline shows the proper information. (dired-sort-set-modeline) ;; Delete this stuff: `eobp' is used to find last subdir by dired.el. (delete-region opoint (point-max))))) (defun dired-omit-here-always () "Creates `dired-local-variables-file' for omitting and reverts directory. Sets dired-omit-file-p to t in a local variables file that is readable by dired." (interactive) (if (file-exists-p dired-local-variables-file) (message "File `./%s' already exists." dired-local-variables-file) ;; Create `dired-local-variables-file'. (save-excursion (set-buffer (get-buffer-create " *dot-dired*")) (erase-buffer) (insert "Local Variables:\ndired-omit-files-p: t\nEnd:\n") (write-file dired-local-variables-file) (kill-buffer (current-buffer))) ;; Run extra-hooks and revert directory. (dired-extra-startup) (dired-revert))) ;;;; GUESS SHELL COMMAND. ;;; Brief Description: ;;; ;;; `dired-do-shell-command' is bound to `!' by dired.el. ;;; ;;; * Redefine `dired-do-shell-command' so it calls ;;; `dired-guess-shell-command'. ;;; ;;; * `dired-guess-shell-command' calls `dired-guess-default' with list of ;;; marked files. ;;; ;;; * Parse `dired-guess-shell-alist-user' and ;;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP ;;; that matches the first file in the file list. ;;; ;;; * If the REGEXP matches all the entries of the file list then evaluate ;;; COMMAND, which is either a string or a Lisp expression returning a ;;; string. COMMAND may be a list of commands. ;;; ;;; * Return this command to `dired-guess-shell-command' which prompts user ;;; with it. The list of commands are temporaily put into the history list. ;;; If a command is used successfully then it is stored permanently in ;;; `dired-shell-command-history'. ;;; Guess what shell command to apply to a file. (defvar dired-shell-command-history nil "History list for commands that read dired-shell commands.") ;;; Default list of shell commands. ;;; NOTE: Use `gunzip -c' instead of `zcat' on `.gz' files. Some do not ;;; install GNU zip's version of zcat. (defvar dired-guess-shell-alist-default (list (list "\\.tar$" '(if dired-guess-shell-gnutar (concat dired-guess-shell-gnutar " xvf") "tar xvf")) ;; REGEXPS for compressed archives must come before the .Z rule to ;; be recognized: (list "\\.tar\\.Z$" ;; Untar it. '(if dired-guess-shell-gnutar (concat dired-guess-shell-gnutar " zxvf") (concat "zcat * | tar xvf -")) ;; Optional conversion to gzip format. '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") " " dired-guess-shell-znew-switches)) ;; gzip'ed archives (list "\\.tar\\.g?z$" '(if dired-guess-shell-gnutar (concat dired-guess-shell-gnutar " zxvf") (concat "gunzip -qc * | tar xvf -")) ;; Optional decompression. '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q" ""))) '("\\.shar.Z$" "zcat * | unshar") '("\\.shar.g?z$" "gunzip -qc * | unshar") '("\\.ps$" "ghostview" "xv" "lpr") (list "\\.ps.g?z$" "gunzip -qc * | ghostview -" ;; Optional decompression. '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) (list "\\.ps.Z$" "zcat * | ghostview -" ;; Optional conversion to gzip format. '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") " " dired-guess-shell-znew-switches)) '("\\.patch$" "cat * | patch") '("\\.patch.g?z$" "gunzip -qc * | patch") (list "\\.patch.Z$" "zcat * | patch" ;; Optional conversion to gzip format. '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") " " dired-guess-shell-znew-switches)) '("\\.dvi$" "xdvi" "dvips") ; preview and printing '("\\.au$" "play") ; play Sun audiofiles '("\\.mpg$" "mpeg_play") '("\\.uu$" "uudecode") ; for uudecoded files '("\\.hqx$" "mcvert") '("\\.sh$" "sh") ; execute shell scripts '("\\.xbm$" "bitmap") ; view X11 bitmaps '("\\.gp$" "gnuplot") '("\\.p[bgpn]m$" "xv") '("\\.gif$" "xv") ; view gif pictures '("\\.tif$" "xv") '("\\.jpg$" "xv") '("\\.fig$" "xfig") ; edit fig pictures '("\\.out$" "xgraph") ; for plotting purposes. '("\\.tex$" "latex" "tex") '("\\.texi\\(nfo\\)?$" "makeinfo" "texi2dvi") ;; Some other popular archivers. '("\\.zoo$" "zoo x//") '("\\.zip$" "unzip") '("\\.lzh$" "lharc x") '("\\.arc$" "arc x") '("\\.shar$" "unshar") ;; Compression. (list "\\.g?z$" '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) (list "\\.Z$" "uncompress" ;; Optional conversion to gzip format. '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") " " dired-guess-shell-znew-switches)) ) "Default alist used for shell command guessing. See `dired-guess-shell-alist-user'") (defvar dired-guess-shell-alist-user nil "User-defined alist of rules for suggested commands. These rules take precedence over the predefined rules in the variable `dired-guess-shell-alist-default' (to which they are prepended). Each element of this list looks like \(REGEXP COMMAND...\) where each COMMAND can either be a string or a lisp expression that evaluates to a string. If several COMMANDs are given, the first one will be the default and the rest will be added temporarily to the history and can be retrieved with \\[previous-history-element] (M-p) . You can set this variable in your ~/.emacs. For example, to add rules for `.foo' and `.bar' files, write \(setq dired-guess-shell-alist-user (list (list \"\\\\.foo$\" \"FOO-COMMAND\");; fixed rule ;; possibly more rules ... (list \"\\\\.bar$\";; rule with condition test '(if condition \"BAR-COMMAND-1\" \"BAR-COMMAND-2\")))\) ") (defun dired-guess-default (files) ;; Guess a shell commands for FILES. Return command or list of commands. ;; See `dired-guess-shell-alist-user'. (let* ((case-fold-search nil) ; case-sensitive matching ;; Prepend the user's alist to the default alist. (alist (append dired-guess-shell-alist-user dired-guess-shell-alist-default)) (file (car files)) (flist (cdr files)) elt regexp cmds) ;; Find the first match in the alist for first file in FILES. (while alist (setq elt (car alist) regexp (car elt) alist (cdr alist)) (if (string-match regexp file) (setq cmds (cdr elt) alist nil))) ;; If more than one file, see if all of FILES match regular expression. (while (and flist (string-match regexp (car flist))) (setq flist (cdr flist))) ;; If flist is still non-nil, then do not guess since this means that not ;; all the files in FILES were matched by the regexp. (setq cmds (and (not flist) cmds)) ;; Return commands or nil if flist is still non-nil. ;; Evaluate the commands in order that any logical testing will be done. (cond ((not (cdr cmds)) (eval (car cmds))) ; single command (t (mapcar (function eval) cmds))))) (defun dired-guess-shell-command (prompt files) ;; Ask user with PROMPT for a shell command, guessing a default from FILES. (let ((default (dired-guess-default files)) default-list old-history val (failed t)) (if (null default) ;; Nothing to guess (read-from-minibuffer prompt nil nil nil 'dired-shell-command-history) ;; Save current history list (setq old-history dired-shell-command-history) (if (listp default) ;; More than one guess (setq default-list default default (car default) prompt (concat prompt (format "{%d guesses} " (length default-list)))) ;; Just one guess (setq default-list (list default))) ;; Push all guesses onto history so that they can be retrieved with M-p ;; and put the first guess in the prompt but not in the initial value. (setq dired-shell-command-history (append default-list dired-shell-command-history) prompt (concat prompt (format "[%s] " default))) ;; The unwind-protect returns VAL, and we too. (unwind-protect ;; BODYFORM (progn (setq val (read-from-minibuffer prompt nil nil nil 'dired-shell-command-history) failed nil) ;; If we got a return, then use default. (if (equal val "") (setq val default)) val) ;; UNWINDFORMS ;; Undo pushing onto the history list so that an aborted ;; command doesn't get the default in the next command. (setq dired-shell-command-history old-history) (if (not failed) (or (equal val (car-safe dired-shell-command-history)) (setq dired-shell-command-history (cons val dired-shell-command-history)))))))) ;;; REDEFINE. ;;; Redefine dired-aux.el's version: (defun dired-read-shell-command (prompt arg files) ;; "Read a dired shell command prompting with PROMPT (using read-string). ;;ARG is the prefix arg and may be used to indicate in the prompt which ;; files are affected. ;;This is an extra function so that you can redefine it, e.g., to use gmhist." (dired-mark-pop-up nil 'shell files 'dired-guess-shell-command (format prompt (dired-mark-prompt arg files)) ; PROMPT files)) ; FILES ;;;; RELATIVE SYMBOLIC LINKS. (defvar dired-keep-marker-relsymlink ?S "See variable `dired-keep-marker-move'.") (defun dired-make-relative-symlink (file1 file2 &optional ok-if-already-exists) "Three arguments: FILE1 FILE2 &optional OK-IF-ALREADY-EXISTS Make a symbolic link (pointing to FILE1) in FILE2. The link is relative (if possible), for example \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\" results in \"../../tex/bin/foo\" \"/vol/local/bin/foo\" " (interactive "FRelSymLink: \nFRelSymLink %s: \np") (let (name1 name2 len1 len2 (index 0) sub) (setq file1 (expand-file-name file1) file2 (expand-file-name file2) len1 (length file1) len2 (length file2)) ;; Find common initial pathname components: (let (next) (while (and (setq next (string-match "/" file1 index)) (setq next (1+ next)) (< next (min len1 len2)) ;; For the comparison, both substrings must end in ;; `/', so NEXT is *one plus* the result of the ;; string-match. ;; E.g., consider the case of linking "/tmp/a/abc" ;; to "/tmp/abc" erronously giving "/tmp/a" instead ;; of "/tmp/" as common initial component (string-equal (substring file1 0 next) (substring file2 0 next))) (setq index next)) (setq name2 file2 sub (substring file1 0 index) name1 (substring file1 index))) (if (string-equal sub "/") ;; No common initial pathname found (setq name1 file1) ;; Else they have a common parent directory (let ((tem (substring file2 index)) (start 0) (count 0)) ;; Count number of slashes we must compensate for ... (while (setq start (string-match "/" tem start)) (setq count (1+ count) start (1+ start))) ;; ... and prepend a "../" for each slash found: (while (> count 0) (setq count (1- count) name1 (concat "../" name1))))) (make-symbolic-link (directory-file-name name1) ; must not link to foo/ ; (trailing slash!) name2 ok-if-already-exists))) (defun dired-do-relsymlink (&optional arg) "Relative symlink all marked (or next ARG) files into a directory, or make a relative symbolic link to the current file. This creates relative symbolic links like foo -> ../bar/foo not absolute ones like foo -> /ugly/path/that/may/change/any/day/bar/foo" (interactive "P") (dired-do-create-files 'relsymlink (function dired-make-relative-symlink) "RelSymLink" arg dired-keep-marker-relsymlink)) (defun dired-do-relsymlink-regexp (regexp newname &optional whole-path) "RelSymlink all marked files containing REGEXP to NEWNAME. See functions `dired-do-rename-regexp' and `dired-do-relsymlink' for more info." (interactive (dired-mark-read-regexp "RelSymLink")) (dired-do-create-files-regexp (function dired-make-relative-symlink) "RelSymLink" nil regexp newname whole-path dired-keep-marker-relsymlink)) ;;;; VISIT ALL MARKED FILES SIMULTANEOUSLY. ;;; Brief Description: ;;; ;;; `dired-do-find-marked-files' is bound to `F' by dired-x.el. ;;; ;;; * Use `dired-get-marked-files' to collect the marked files in the current ;;; Dired Buffer into a list of filenames `FILE-LIST'. ;;; ;;; * Pass FILE-LIST to `dired-simultaneous-find-file' all with ;;; `dired-do-find-marked-files''s prefix argument NOSELECT. ;;; ;;; * `dired-simultaneous-find-file' runs through FILE-LIST decrementing the ;;; list each time. ;;; ;;; * If NOSELECT is non-nil then just run `find-file-noselect' on each ;;; element of FILE-LIST. ;;; ;;; * If NOSELECT is nil then calculate the `size' of the window for each file ;;; by dividing the `window-height' by length of FILE-LIST. Thus, `size' is ;;; cognizant of the window-configuration. ;;; ;;; * If `size' is too small abort, otherwise run `find-file' on each element ;;; of FILE-LIST giving each a window of height `size'. (defun dired-do-find-marked-files (&optional noselect) "Find all marked files displaying all of them simultaneously. With optional NOSELECT just find files but do not select them. The current window is split across all files marked, as evenly as possible. Remaining lines go to bottom-most window. The number of files that can be displayed this way is restricted by the height of the current window and `window-min-height'. To keep dired buffer displayed, type \\[split-window-vertically] first. To display just marked files, type \\[delete-other-windows] first." (interactive "P") (dired-simultaneous-find-file (dired-get-marked-files) noselect)) (defun dired-simultaneous-find-file (file-list noselect) ;; Visit all files in FILE-LIST and display them simultaneously. The ;; current window is split across all files in FILE-LIST, as evenly as ;; possible. Remaining lines go to the bottom-most window. The number of ;; files that can be displayed this way is restricted by the height of the ;; current window and the variable `window-min-height'. With non-nil ;; NOSELECT the files are merely found but not selected. ;; We don't make this function interactive because it is usually too clumsy ;; to specify FILE-LIST interactively unless via dired. (let (size) (if noselect ;; Do not select the buffer. (find-file-noselect (car file-list)) ;; We will have to select the buffer. Calculate and check window size. (setq size (/ (window-height) (length file-list))) (or (<= window-min-height size) (error "Too many files to visit simultaneously. Try C-u prefix.")) (find-file (car file-list))) ;; Decrement. (setq file-list (cdr file-list)) (while file-list (if noselect ;; Do not select the buffer. (find-file-noselect (car file-list)) ;; Vertically split off a window of desired size. Upper window will ;; have SIZE lines. Select lower (larger) window. We split it again. (select-window (split-window nil size)) (find-file (car file-list))) ;; Decrement. (setq file-list (cdr file-list))))) ;;;; MISCELLANEOUS COMMANDS. ;;; Run man on files. (defun dired-man () "Run man on this file. Display old buffer if buffer name matches filename. Uses ../lisp/man.el of \\[manual-entry] fame." (interactive) (require 'man) (let ((file (dired-get-filename)) (manual-program "nroff -man -h")) (Man-getpage-in-background file))) ;;; Run Info on files. (defun dired-info () "Run info on this file." (interactive) (info (dired-get-filename))) ;;; Run mail on mail folders. ;;; (and (not (fboundp 'vm-visit-folder)) ;;; (defun vm-visit-folder (file &optional arg) ;;; nil)) (defun dired-vm (&optional read-only) "Run VM on this file. With prefix arg, visit folder read-only (this requires at least VM 5). See also variable `dired-vm-read-only-folders'." (interactive "P") (let ((dir (dired-current-directory)) (fil (dired-get-filename))) ;; take care to supply 2nd arg only if requested - may still run VM 4! (cond (read-only (vm-visit-folder fil t)) ((eq t dired-vm-read-only-folders) (vm-visit-folder fil t)) ((null dired-vm-read-only-folders) (vm-visit-folder fil)) (t (vm-visit-folder fil (not (file-writable-p fil))))) ;; so that pressing `v' inside VM does prompt within current directory: (set (make-local-variable 'vm-folder-directory) dir))) (defun dired-rmail () "Run RMAIL on this file." (interactive) (rmail (dired-get-filename))) (defun dired-do-run-mail () "If `dired-bind-vm' is t, then function `dired-vm', otherwise `dired-rmail'." (interactive) (if dired-bind-vm ;; Read mail folder using vm. (dired-vm) ;; Read mail folder using rmail. (dired-rmail))) ;;;; MISCELLANEOUS INTERNAL FUNCTIONS. (or (fboundp 'dired-old-find-buffer-nocreate) (fset 'dired-old-find-buffer-nocreate (symbol-function 'dired-find-buffer-nocreate))) ;;; REDEFINE. ;;; Redefines dired.el's version of `dired-find-buffer-nocreate' (defun dired-find-buffer-nocreate (dirname &optional mode) (if (and dired-find-subdir ;; don't try to find a wildcard as a subdirectory (string-equal dirname (file-name-directory dirname))) (let* ((cur-buf (current-buffer)) (buffers (nreverse (dired-buffers-for-dir (expand-file-name dirname)))) (cur-buf-matches (and (memq cur-buf buffers) ;; wildcards must match, too: (equal dired-directory dirname)))) ;; We don't want to switch to the same buffer--- (setq buffers (delq cur-buf buffers));;need setq with delq (or (car (sort buffers (function dired-buffer-more-recently-used-p))) ;; ---unless it's the only possibility: (and cur-buf-matches cur-buf))) (dired-old-find-buffer-nocreate dirname mode))) ;; This should be a builtin (defun dired-buffer-more-recently-used-p (buffer1 buffer2) "Return t if BUFFER1 is more recently used than BUFFER2." (if (equal buffer1 buffer2) nil (let ((more-recent nil) (list (buffer-list))) (while (and list (not (setq more-recent (equal buffer1 (car list)))) (not (equal buffer2 (car list)))) (setq list (cdr list))) more-recent))) ;;; Same thing as `dired-buffers-for-dir' of dired.el? - lrd 11/23/93 ;;; (defun dired-buffers-for-dir-exact (dir) ;;; ;; Return a list of buffers that dired DIR (a directory or wildcard) ;;; ;; at top level, or as subdirectory. ;;; ;; Top level matches must match the wildcard part too, if any. ;;; ;; The list is in reverse order of buffer creation, most recent last. ;;; ;; As a side effect, killed dired buffers for DIR are removed from ;;; ;; dired-buffers. ;;; (let ((alist dired-buffers) result elt) ;;; (while alist ;;; (setq elt (car alist) ;;; alist (cdr alist)) ;;; (let ((buf (cdr elt))) ;;; (if (buffer-name buf) ;;; ;; Top level must match exactly against dired-directory in ;;; ;; case one of them is a wildcard. ;;; (if (or (equal dir (save-excursion (set-buffer buf) ;;; dired-directory)) ;;; (assoc dir (save-excursion (set-buffer buf) ;;; dired-subdir-alist))) ;;; (setq result (cons buf result))) ;;; ;; else buffer is killed - clean up: ;;; (setq dired-buffers (delq elt dired-buffers))))) ;;; result)) ;;; REDEFINE. ;;; Redefines dired.el's version of `dired-initial-position' (defun dired-initial-position (dirname) (end-of-line) (if dired-find-subdir (dired-goto-subdir dirname)) ; new (if dired-trivial-filenames (dired-goto-next-nontrivial-file))) ;; Does anyone use this? - lrd 6/29/93. (defun dired-mark-sexp (predicate &optional unflag-p) "Mark files for which PREDICATE returns non-nil. With a prefix arg, unflag those files instead. PREDICATE is a lisp expression that can refer to the following symbols: inode [integer] the inode of the file (only for ls -i output) s [integer] the size of the file for ls -s output (ususally in blocks or, with -k, in KByte) mode [string] file permission bits, e.g. \"-rw-r--r--\" nlink [integer] number of links to file uid [string] owner gid [string] group (If the gid is not displayed by ls, this will still be set (to the same as uid)) size [integer] file size in bytes time [string] the time that ls displays, e.g. \"Feb 12 14:17\" name [string] the name of the file sym [string] if file is a symbolic link, the linked-to name, else \"\" For example, use (equal 0 size) to mark all zero length files." ;; Using sym="" instead of nil avoids the trap of ;; (string-match "foo" sym) into which a user would soon fall. ;; Give `equal' instead of `=' in the example, as this works on ;; integers and strings. (interactive "xMark if (lisp expr): \nP") (message "%s" predicate) (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)) inode s mode nlink uid gid size time name sym) (dired-mark-if (save-excursion (and ;; Sets vars ;; inode s mode nlink uid gid size time name sym ;; according to current file line. Returns t for success, nil if ;; there is no file line. Upon success, all variables are set, either ;; to nil or the appropriate value, so they need not be initialized. ;; Moves point within the current line. (if (dired-move-to-filename) (let (pos (mode-len 10) ; length of mode string ;; like in dired.el, but with subexpressions \1=inode, \2=s: (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?")) (beginning-of-line) (forward-char 2) (if (looking-at dired-re-inode-size) (progn (goto-char (match-end 0)) (setq inode (string-to-int (buffer-substring (match-beginning 1) (match-end 1))) s (string-to-int (buffer-substring (match-beginning 2) (match-end 2))))) (setq inode nil s nil)) (setq mode (buffer-substring (point) (+ mode-len (point)))) (forward-char mode-len) (setq nlink (read (current-buffer))) (setq uid (buffer-substring (point) (progn (forward-word 1) (point)))) (re-search-forward "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)") (goto-char (match-beginning 1)) (forward-char -1) (setq size (string-to-int (buffer-substring (save-excursion (backward-word 1) (setq pos (point))) (point)))) (goto-char pos) (backward-word 1) ;; if no gid is displayed, gid will be set to uid ;; but user will then not reference it anyway in PREDICATE. (setq gid (buffer-substring (save-excursion (forward-word 1) (point)) (point)) time (buffer-substring (match-beginning 1) (1- (dired-move-to-filename))) name (buffer-substring (point) (or (dired-move-to-end-of-filename t) (point))) sym (progn (if (looking-at " -> ") (buffer-substring (progn (forward-char 4) (point)) (progn (end-of-line) (point))) ""))) t) nil) (eval predicate))) (format "'%s file" predicate)))) ;;;; FIND FILE AT POINT. (defvar dired-x-hands-off-my-keys t "*t means don't bind `dired-x-find-file' over `find-file' on keyboard. Similarly for `dired-x-find-file-other-window' over `find-file-other-window'. If you change this variable after dired-x.el is loaded then do \\[dired-x-bind-find-file].") ;;; Bind `dired-x-find-file{-other-window}' over wherever ;;; `find-file{-other-window}' is bound? (defun dired-x-bind-find-file () "Bind `dired-x-find-file' in place of `find-file' \(or reverse\). Similarly for `dired-x-find-file-other-window' and `find-file-other-window'. Binding direction based on `dired-x-hands-off-my-keys'. This function part of `after-init-hook'." (interactive) (if (interactive-p) (setq dired-x-hands-off-my-keys (not (y-or-n-p "Bind dired-x-find-file over find-file? ")))) (cond ((not dired-x-hands-off-my-keys) (substitute-key-definition 'find-file 'dired-x-find-file (current-global-map)) (substitute-key-definition 'find-file-other-window 'dired-x-find-file-other-window (current-global-map))) (t (substitute-key-definition 'dired-x-find-file 'find-file (current-global-map)) (substitute-key-definition 'dired-x-find-file-other-window 'find-file-other-window (current-global-map)))) ;; Clear mini-buffer. (message nil)) ;;; Now call it so binding is correct and put on `after-init-hook' in case ;;; user changes binding. (dired-x-bind-find-file) (add-hook 'after-init-hook 'dired-x-bind-find-file) (defun dired-x-find-file (filename) "Edit file FILENAME. May create a new window, or reuse an existing one. See the function `display-buffer'. Identical to `find-file' except when called interactively, with a prefix arg \(e.g., \\[universal-argument]\), in which case it guesses filename near point. Useful for editing file mentioned in buffer you are viewing, or to test if that file exists. Use minibuffer after snatching filename." (interactive (list (read-filename-at-point "Find file: "))) (find-file (expand-file-name filename))) (defun dired-x-find-file-other-window (filename) "Edit file FILENAME, in another window. May create a new window, or reuse an existing one. See the function `display-buffer'. Identical to `find-file-other-window' except when called interactively, with a prefix arg \(e.g., \\[universal-argument]\), in which case it guesses filename near point. Useful for editing file mentioned in buffer you are viewing, or to test if that file exists. Use minibuffer after snatching filename." (interactive (list (read-filename-at-point "Find file: "))) (find-file-other-window (expand-file-name filename))) ;;; Internal functions. (defun dired-filename-at-point () ;; Get the filename closest to point, but do not change position. Has a ;; preference for looking backward when not directly on a symbol. Not ;; perfect - point must be in middle of or end of filename. (let ((filename-chars ".a-zA-Z0-9---_/:$+") (bol (save-excursion (beginning-of-line) (point))) (eol (save-excursion (end-of-line) (point))) start end filename) (save-excursion ;; First see if just past a filename. (if (not (eobp)) (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens (progn (skip-chars-backward " \n\t\r({[]})") (if (not (bobp)) (backward-char 1))))) (if (string-match (concat "[" filename-chars "]") (char-to-string (following-char))) (progn (skip-chars-backward filename-chars) (setq start (point)) (if (string-match "[/~]" (char-to-string (preceding-char))) (setq start (1- start))) (skip-chars-forward filename-chars)) (error "No file found around point!")) ;; Return string. (expand-file-name (buffer-substring start (point)))))) (defun read-filename-at-point (prompt) ;;; Returns filename prompting with PROMPT with completion. If ;;; `current-prefix-arg' is non-nil, uses name at point as guess. (if current-prefix-arg (let ((guess (dired-filename-at-point))) (read-file-name prompt (file-name-directory guess) guess nil (file-name-nondirectory guess))) (read-file-name prompt default-directory))) ;;;; BUG REPORTS ;;; This section is provided for reports. It uses Barry A. Warsaw's ;;; reporter.el which is bundled with GNU Emacs v19. (defconst dired-x-version "2.37" "Revision number of dired-x.el -- dired extra for GNU Emacs v19. Type \\[dired-x-submit-report] to send a bug report. Available via anonymous ftp in /roebling.poly.edu:/pub/packages/dired-x.tar.gz") (defconst dired-x-help-address "dodd@roebling.poly.edu" "Address(es) accepting submission of reports on dired-x.el.") (defconst dired-x-maintainer "Larry" "First name(s) of people accepting submission of reports on dired-x.el.") (defconst dired-x-file "dired-x.el" "Name of file containing emacs lisp code.") (defconst dired-x-variable-list (list 'dired-bind-vm 'dired-vm-read-only-folders 'dired-bind-jump 'dired-bind-info 'dired-bind-man 'dired-find-subdir 'dired-enable-local-variables 'dired-local-variables-file 'dired-guess-shell-gnutar 'dired-guess-shell-gzip-quiet 'dired-guess-shell-znew-switches 'dired-guess-shell-alist-user 'dired-clean-up-buffers-too 'dired-omit-files-p 'dired-omit-files 'dired-omit-extensions ) "List of variables to be appended to reports sent by `dired-x-submit-report.'") (defun dired-x-submit-report () "Submit via reporter.el a bug report on program. Send report on `dired-x-file' version `dired-x-version,' to `dired-x-maintainer' at address `dired-x-help-address' listing variables `dired-x-variable-list' in the message." (interactive) ;; In case we can't find reporter... (condition-case err (progn ;; Get it if we can. (require 'reporter) (reporter-submit-bug-report dired-x-help-address ; address (concat dired-x-file " (" dired-x-version ")") ; pkgname dired-x-variable-list ; varlist nil nil ; pre-/post-hooks (concat dired-x-maintainer ","))) ; salutation ;; ...fail gracefully. (error (beep) (message "Sorry, reporter.el not found.")))) ;; As Barry Warsaw would say: "This might be useful..." (provide 'dired-x) ;;; dired-x.el ends here emacs-19.30/lisp/dired.el100444 22556 1 267533 6025412136 13706 0ustar erikdaemon;;; dired.el --- directory-browsing commands ;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. ;; Author: Sebastian Kremer ;; Maintainer: FSF ;; 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 is a major mode for directory browsing and editing. It is ;; documented in the Emacs manual. ;; Rewritten in 1990/1991 to add tree features, file marking and ;; sorting by Sebastian Kremer . ;; Finished up by rms in 1992. ;;; Code: ;;; Customizable variables ;;;###autoload (defvar dired-listing-switches "-al" "*Switches passed to `ls' for dired. MUST contain the `l' option. May contain all other options that don't contradict `-l'; may contain even `F', `b', `i' and `s'. See also the variable `dired-ls-F-marks-symlinks' concerning the `F' switch.") ; Don't use absolute paths as /bin should be in any PATH and people ; may prefer /usr/local/gnu/bin or whatever. However, chown is ; usually not in PATH. ;;;###autoload (defvar dired-chown-program (if (memq system-type '(hpux dgux usg-unix-v irix linux)) "chown" "/etc/chown") "Name of chown command (usually `chown' or `/etc/chown').") (defvar dired-chmod-program (if (eq system-type 'windows-nt) "chmode" "chmod") "Name of chmod command (usually `chmod' or `chmode').") ;;;###autoload (defvar dired-ls-F-marks-symlinks nil "*Informs dired about how `ls -lF' marks symbolic links. Set this to t if `insert-directory-program' with `-lF' marks the symbolic link itself with a trailing @ (usually the case under Ultrix). Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to nil (the default), if it gives `bar@ -> foo', set it to t. Dired checks if there is really a @ appended. Thus, if you have a marking `ls' program on one host and a non-marking on another host, and don't care about symbolic links which really end in a @, you can always set this variable to t.") ;;;###autoload (defvar dired-trivial-filenames "^\\.\\.?$\\|^#" "*Regexp of files to skip when finding first file of a directory. A value of nil means move to the subdir line. A value of t means move to first file.") ;;;###autoload (defvar dired-keep-marker-rename t ;; Use t as default so that moved files "take their markers with them". "*Controls marking of renamed files. If t, files keep their previous marks when they are renamed. If a character, renamed files (whether previously marked or not) are afterward marked with that character.") ;;;###autoload (defvar dired-keep-marker-copy ?C "*Controls marking of copied files. If t, copied files are marked if and as the corresponding original files were. If a character, copied files are unconditionally marked with that character.") ;;;###autoload (defvar dired-keep-marker-hardlink ?H "*Controls marking of newly made hard links. If t, they are marked if and as the files linked to were marked. If a character, new links are unconditionally marked with that character.") ;;;###autoload (defvar dired-keep-marker-symlink ?Y "*Controls marking of newly made symbolic links. If t, they are marked if and as the files linked to were marked. If a character, new links are unconditionally marked with that character.") ;;;###autoload (defvar dired-dwim-target nil "*If non-nil, dired tries to guess a default target directory. This means: if there is a dired buffer displayed in the next window, use its current subdir, instead of the current subdir of this dired buffer. The target is used in the prompt for file copy, rename etc.") ;;;###autoload (defvar dired-copy-preserve-time t "*If non-nil, Dired preserves the last-modified time in a file copy. \(This works on only some systems.)") (defvar dired-font-lock-keywords '(;; Put directory headers in italics. ("^ \\(/.+\\)" 1 font-lock-type-face) ;; Put symlinks in bold italics. ("\\([^ ]+\\) -> [^ ]+$" . font-lock-function-name-face) ;; Put marks in bold. ("^[^ ]" . font-lock-reference-face) ;; Put files that are subdirectories in bold. ("^..d.* \\([^ ]+\\)$" 1 font-lock-keyword-face)) "Additional expressions to highlight in Dired mode.") ;;; Hook variables (defvar dired-load-hook nil "Run after loading dired. You can customize key bindings or load extensions with this.") (defvar dired-mode-hook nil "Run at the very end of dired-mode.") (defvar dired-before-readin-hook nil "This hook is run before a dired buffer is read in (created or reverted).") (defvar dired-after-readin-hook nil "Hook run after each time a file or directory is read by Dired. After each listing of a file or directory, this hook is run with the buffer narrowed to the listing.") ;; Note this can't simply be run inside function `dired-ls' as the hook ;; functions probably depend on the dired-subdir-alist to be OK. ;;; Internal variables (defvar dired-marker-char ?* ; the answer is 42 ;; so that you can write things like ;; (let ((dired-marker-char ?X)) ;; ;; great code using X markers ... ;; ) ;; For example, commands operating on two sets of files, A and B. ;; Or marking files with digits 0-9. This could implicate ;; concentric sets or an order for the marked files. ;; The code depends on dynamic scoping on the marker char. "In Dired, the current mark character. This is what the `do' commands look for and what the `mark' commands store.") (defvar dired-del-marker ?D "Character used to flag files for deletion.") (defvar dired-shrink-to-fit t ;; I see no reason ever to make this nil -- rms. ;; (> baud-rate search-slow-speed) "Non-nil means Dired shrinks the display buffer to fit the marked files.") (defvar dired-flagging-regexp nil);; Last regexp used to flag files. (defvar dired-file-version-alist) (defvar dired-directory nil "The directory name or shell wildcard that was used as argument to `ls'. Local to each dired buffer. May be a list, in which case the car is the directory name and the cdr is the actual files to list.") (defvar dired-actual-switches nil "The value of `dired-listing-switches' used to make this buffer's text.") (defvar dired-re-inode-size "[0-9 \t]*" "Regexp for optional initial inode and file size as made by `ls -i -s'.") ;; These regexps must be tested at beginning-of-line, but are also ;; used to search for next matches, so neither omitting "^" nor ;; replacing "^" by "\n" (to make it slightly faster) will work. (defvar dired-re-mark "^[^ \n]") ;; "Regexp matching a marked line. ;; Important: the match ends just after the marker." (defvar dired-re-maybe-mark "^. ") (defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d")) (defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l")) (defvar dired-re-exe;; match ls permission string of an executable file (mapconcat (function (lambda (x) (concat dired-re-maybe-mark dired-re-inode-size x))) '("-[-r][-w][xs][-r][-w].[-r][-w]." "-[-r][-w].[-r][-w][xs][-r][-w]." "-[-r][-w].[-r][-w].[-r][-w][xst]") "\\|")) (defvar dired-re-perms "[-bcdlps][-r][-w].[-r][-w].[-r][-w].") (defvar dired-re-dot "^.* \\.\\.?$") ;; The subdirectory names in this list are expanded. (defvar dired-subdir-alist nil "Association list of subdirectories and their buffer positions. Each subdirectory has an element: (DIRNAME . STARTMARKER). The order of elements is the reverse of the order in the buffer. In simple cases, this list contains one element.") (defvar dired-subdir-regexp "^. \\([^\n\r]+\\)\\(:\\)[\n\r]" "Regexp matching a maybe hidden subdirectory line in `ls -lR' output. Subexpression 1 is the subdirectory proper, no trailing colon. The match starts at the beginning of the line and ends after the end of the line (\\n or \\r). Subexpression 2 must end right before the \\n or \\r.") ;;; Macros must be defined before they are used, for the byte compiler. ;; Mark all files for which CONDITION evals to non-nil. ;; CONDITION is evaluated on each line, with point at beginning of line. ;; MSG is a noun phrase for the type of files being marked. ;; It should end with a noun that can be pluralized by adding `s'. ;; Return value is the number of files marked, or nil if none were marked. (defmacro dired-mark-if (predicate msg) (` (let (buffer-read-only count) (save-excursion (setq count 0) (if (, msg) (message "Marking %ss..." (, msg))) (goto-char (point-min)) (while (not (eobp)) (if (, predicate) (progn (delete-char 1) (insert dired-marker-char) (setq count (1+ count)))) (forward-line 1)) (if (, msg) (message "%s %s%s %s%s." count (, msg) (dired-plural-s count) (if (eq dired-marker-char ?\040) "un" "") (if (eq dired-marker-char dired-del-marker) "flagged" "marked")))) (and (> count 0) count)))) (defmacro dired-map-over-marks (body arg &optional show-progress) ;; "Macro: Perform BODY with point somewhere on each marked line ;;and return a list of BODY's results. ;;If no marked file could be found, execute BODY on the current line. ;; If ARG is an integer, use the next ARG (or previous -ARG, if ARG<0) ;; files instead of the marked files. ;; In that case point is dragged along. This is so that commands on ;; the next ARG (instead of the marked) files can be chained easily. ;; If ARG is otherwise non-nil, use current file instead. ;;If optional third arg SHOW-PROGRESS evaluates to non-nil, ;; redisplay the dired buffer after each file is processed. ;;No guarantee is made about the position on the marked line. ;; BODY must ensure this itself if it depends on this. ;;Search starts at the beginning of the buffer, thus the car of the list ;; corresponds to the line nearest to the buffer's bottom. This ;; is also true for (positive and negative) integer values of ARG. ;;BODY should not be too long as it is expanded four times." ;; ;;Warning: BODY must not add new lines before point - this may cause an ;;endless loop. ;;This warning should not apply any longer, sk 2-Sep-1991 14:10. (` (prog1 (let (buffer-read-only case-fold-search found results) (if (, arg) (if (integerp (, arg)) (progn;; no save-excursion, want to move point. (dired-repeat-over-lines (, arg) (function (lambda () (if (, show-progress) (sit-for 0)) (setq results (cons (, body) results))))) (if (< (, arg) 0) (nreverse results) results)) ;; non-nil, non-integer ARG means use current file: (list (, body))) (let ((regexp (dired-marker-regexp)) next-position) (save-excursion (goto-char (point-min)) ;; remember position of next marked file before BODY ;; can insert lines before the just found file, ;; confusing us by finding the same marked file again ;; and again and... (setq next-position (and (re-search-forward regexp nil t) (point-marker)) found (not (null next-position))) (while next-position (goto-char next-position) (if (, show-progress) (sit-for 0)) (setq results (cons (, body) results)) ;; move after last match (goto-char next-position) (forward-line 1) (set-marker next-position nil) (setq next-position (and (re-search-forward regexp nil t) (point-marker))))) (if found results (list (, body)))))) ;; save-excursion loses, again (dired-move-to-filename)))) (defun dired-get-marked-files (&optional localp arg) "Return the marked files' names as list of strings. The list is in the same order as the buffer, that is, the car is the first marked file. Values returned are normally absolute pathnames. Optional arg LOCALP as in `dired-get-filename'. Optional second argument ARG forces to use other files. If ARG is an integer, use the next ARG files. If ARG is otherwise non-nil, use current file. Usually ARG comes from the current prefix arg." (save-excursion (nreverse (dired-map-over-marks (dired-get-filename localp) arg)))) ;; Function dired-ls is redefinable for VMS, ange-ftp, Prospero or ;; other special applications. ;; The dired command (defun dired-read-dir-and-switches (str) ;; For use in interactive. (reverse (list (if current-prefix-arg (read-string "Dired listing switches: " dired-listing-switches)) (read-file-name (format "Dired %s(directory): " str) nil default-directory nil)))) ;;;###autoload (define-key ctl-x-map "d" 'dired) ;;;###autoload (defun dired (dirname &optional switches) "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it. Optional second argument SWITCHES specifies the `ls' options used. \(Interactively, use a prefix argument to be able to specify SWITCHES.) Dired displays a list of files in DIRNAME (which may also have shell wildcards appended to select certain files). If DIRNAME is a cons, its first element is taken as the directory name and the resr as an explicit list of files to make directory entries for. \\\ You can move around in it with the usual commands. You can flag files for deletion with \\[dired-flag-file-deletion] and then delete them by typing \\[dired-do-flagged-delete]. Type \\[describe-mode] after entering dired for more info. If DIRNAME is already in a dired buffer, that buffer is used without refresh." ;; Cannot use (interactive "D") because of wildcards. (interactive (dired-read-dir-and-switches "")) (switch-to-buffer (dired-noselect dirname switches))) ;;;###autoload (define-key ctl-x-4-map "d" 'dired-other-window) ;;;###autoload (defun dired-other-window (dirname &optional switches) "\"Edit\" directory DIRNAME. Like `dired' but selects in another window." (interactive (dired-read-dir-and-switches "in other window ")) (switch-to-buffer-other-window (dired-noselect dirname switches))) ;;;###autoload (define-key ctl-x-5-map "d" 'dired-other-frame) ;;;###autoload (defun dired-other-frame (dirname &optional switches) "\"Edit\" directory DIRNAME. Like `dired' but makes a new frame." (interactive (dired-read-dir-and-switches "in other frame ")) (switch-to-buffer-other-frame (dired-noselect dirname switches))) ;;;###autoload (defun dired-noselect (dir-or-list &optional switches) "Like `dired' but returns the dired buffer as value, does not select it." (or dir-or-list (setq dir-or-list default-directory)) ;; This loses the distinction between "/foo/*/" and "/foo/*" that ;; some shells make: (let (dirname) (if (consp dir-or-list) (setq dirname (car dir-or-list)) (setq dirname dir-or-list)) (setq dirname (abbreviate-file-name (expand-file-name (directory-file-name dirname)))) (if (file-directory-p dirname) (setq dirname (file-name-as-directory dirname))) (if (consp dir-or-list) (setq dir-or-list (cons dirname (cdr dir-or-list))) (setq dir-or-list dirname)) (dired-internal-noselect dir-or-list switches))) ;; Separate function from dired-noselect for the sake of dired-vms.el. (defun dired-internal-noselect (dir-or-list &optional switches mode) ;; If there is an existing dired buffer for DIRNAME, just leave ;; buffer as it is (don't even call dired-revert). ;; This saves time especially for deep trees or with ange-ftp. ;; The user can type `g'easily, and it is more consistent with find-file. ;; But if SWITCHES are given they are probably different from the ;; buffer's old value, so call dired-sort-other, which does ;; revert the buffer. ;; A pity we can't possibly do "Directory has changed - refresh? " ;; like find-file does. ;; Optional argument MODE is passed to dired-find-buffer-nocreate, ;; see there. (let* ((dirname (if (consp dir-or-list) (car dir-or-list) dir-or-list)) ;; The following line used to use dir-or-list. ;; That never found an existing buffer, in the case ;; where it is a list. (buffer (dired-find-buffer-nocreate dirname mode)) ;; note that buffer already is in dired-mode, if found (new-buffer-p (not buffer)) (old-buf (current-buffer))) (or buffer (let ((default-major-mode 'fundamental-mode)) ;; We don't want default-major-mode to run hooks and set auto-fill ;; or whatever, now that dired-mode does not ;; kill-all-local-variables any longer. (setq buffer (create-file-buffer (directory-file-name dirname))))) (set-buffer buffer) (if (not new-buffer-p) ; existing buffer ... (cond (switches ; ... but new switches ;; file list may have changed (if (consp dir-or-list) (setq dired-directory dir-or-list)) ;; this calls dired-revert (dired-sort-other switches)) ;; If directory has changed on disk, offer to revert. ((if (let ((attributes (file-attributes dirname)) (modtime (visited-file-modtime))) (or (eq modtime 0) (not (eq (car attributes) t)) (and (= (car (nth 5 attributes)) (car modtime)) (= (nth 1 (nth 5 attributes)) (cdr modtime))))) nil (message (substitute-command-keys "Directory has changed on disk; type \\[revert-buffer] to update Dired"))))) ;; Else a new buffer (setq default-directory (if (file-directory-p dirname) dirname (file-name-directory dirname))) (or switches (setq switches dired-listing-switches)) (dired-mode dirname switches) (if mode (funcall mode)) ;; default-directory and dired-actual-switches are set now ;; (buffer-local), so we can call dired-readin: (let ((failed t)) (unwind-protect (progn (dired-readin dir-or-list buffer) (setq failed nil)) ;; dired-readin can fail if parent directories are inaccessible. ;; Don't leave an empty buffer around in that case. (if failed (kill-buffer buffer)))) ;; No need to narrow since the whole buffer contains just ;; dired-readin's output, nothing else. The hook can ;; successfully use dired functions (e.g. dired-get-filename) ;; as the subdir-alist has been built in dired-readin. (run-hooks 'dired-after-readin-hook) (goto-char (point-min)) (dired-initial-position dirname)) (set-buffer old-buf) buffer)) (defun dired-find-buffer-nocreate (dirname &optional mode) ;; This differs from dired-buffers-for-dir in that it does not consider ;; subdirs of default-directory and searches for the first match only. ;; Also, the major mode must be MODE. (let (found (blist dired-buffers)) ; was (buffer-list) (or mode (setq mode 'dired-mode)) (while blist (if (null (buffer-name (cdr (car blist)))) (setq blist (cdr blist)) (save-excursion (set-buffer (cdr (car blist))) (if (and (eq major-mode mode) (if (consp dired-directory) (equal (car dired-directory) dirname) (equal dired-directory dirname))) (setq found (cdr (car blist)) blist nil) (setq blist (cdr blist)))))) found)) ;; Read in a new dired buffer ;; dired-readin differs from dired-insert-subdir in that it accepts ;; wildcards, erases the buffer, and builds the subdir-alist anew ;; (including making it buffer-local and clearing it first). (defun dired-readin (dir-or-list buffer) ;; default-directory and dired-actual-switches must be buffer-local ;; and initialized by now. ;; Thus we can test (equal default-directory dirname) instead of ;; (file-directory-p dirname) and save a filesystem transaction. ;; Also, we can run this hook which may want to modify the switches ;; based on default-directory, e.g. with ange-ftp to a SysV host ;; where ls won't understand -Al switches. (let (dirname) (if (consp dir-or-list) (setq dirname (car dir-or-list)) (setq dirname dir-or-list)) (setq dirname (expand-file-name dirname)) (if (consp dir-or-list) (setq dir-or-list (cons dirname (cdr dir-or-list)))) (run-hooks 'dired-before-readin-hook) (save-excursion (message "Reading directory %s..." dirname) (set-buffer buffer) (let (buffer-read-only (failed t)) (widen) (erase-buffer) (dired-readin-insert dir-or-list) (indent-rigidly (point-min) (point-max) 2) ;; We need this to make the root dir have a header line as all ;; other subdirs have: (goto-char (point-min)) (dired-insert-headerline default-directory) ;; can't run dired-after-readin-hook here, it may depend on the subdir ;; alist to be OK. ) (message "Reading directory %s...done" dirname) ;; Must first make alist buffer local and set it to nil because ;; dired-build-subdir-alist will call dired-clear-alist first (set (make-local-variable 'dired-subdir-alist) nil) (dired-build-subdir-alist) (let ((attributes (file-attributes dirname))) (if (eq (car attributes) t) (set-visited-file-modtime (nth 5 attributes)))) (set-buffer-modified-p nil)))) ;; Subroutines of dired-readin (defun dired-readin-insert (dir-or-list) ;; Just insert listing for the passed-in directory or ;; directory-and-file list, assuming a clean buffer. (let (dirname) (if (consp dir-or-list) (setq dirname (car dir-or-list)) (setq dirname dir-or-list)) ;; Expand before comparing in case one or both have been abbreviated. (if (and (equal (expand-file-name default-directory) (expand-file-name dirname)) (not (consp dir-or-list))) ;; If we are reading a whole single directory... (dired-insert-directory dir-or-list dired-actual-switches nil t) (if (not (file-readable-p (directory-file-name (file-name-directory dirname)))) (error "Directory %s inaccessible or nonexistent" dirname) ;; Else assume it contains wildcards, ;; unless it is an explicit list of files. (dired-insert-directory dir-or-list dired-actual-switches (not (listp dir-or-list))) (save-excursion ;; insert wildcard instead of total line: (goto-char (point-min)) (insert "wildcard " (file-name-nondirectory dirname) "\n")))))) (defun dired-insert-directory (dir-or-list switches &optional wildcard full-p) ;; Do the right thing whether dir-or-list is atomic or not. If it is, ;; inset all files listed in the cdr (the car is the passed-in directory ;; list). (let ((opoint (point)) end) (if (consp dir-or-list) ;; In this case, use the file names in the cdr ;; exactly as originally given to dired-noselect. (mapcar (function (lambda (x) (insert-directory x switches wildcard full-p))) (cdr dir-or-list)) ;; Expand the file name here because it may have been abbreviated ;; in dired-noselect. (insert-directory (expand-file-name dir-or-list) switches wildcard full-p)) ;; Quote certain characters, unless ls quoted them for us. (if (not (string-match "b" dired-actual-switches)) (save-excursion (setq end (point-marker)) (goto-char opoint) (while (search-forward "\\" end t) (replace-match "\\\\" nil t)) (goto-char opoint) (while (search-forward "\^m" end t) (replace-match "\\015" nil t)) (set-marker end nil))) (dired-insert-set-properties opoint (point))) (setq dired-directory dir-or-list)) ;; Make the file names highlight when the mouse is on them. (defun dired-insert-set-properties (beg end) (save-excursion (goto-char beg) (while (< (point) end) (condition-case nil (if (dired-move-to-filename) (put-text-property (point) (save-excursion (dired-move-to-end-of-filename) (point)) 'mouse-face 'highlight)) (error nil)) (forward-line 1)))) (defun dired-insert-headerline (dir);; also used by dired-insert-subdir ;; Insert DIR's headerline with no trailing slash, exactly like ls ;; would, and put cursor where dired-build-subdir-alist puts subdir ;; boundaries. (save-excursion (insert " " (directory-file-name dir) ":\n"))) ;; Reverting a dired buffer (defun dired-revert (&optional arg noconfirm) ;; Reread the dired buffer. Must also be called after ;; dired-actual-switches have changed. ;; Should not fail even on completely garbaged buffers. ;; Preserves old cursor, marks/flags, hidden-p. (widen) ; just in case user narrowed (let ((opoint (point)) (ofile (dired-get-filename nil t)) (mark-alist nil) ; save marked files (hidden-subdirs (dired-remember-hidden)) (old-subdir-alist (cdr (reverse dired-subdir-alist))) ; except pwd (case-fold-search nil) ; we check for upper case ls flags buffer-read-only) (goto-char (point-min)) (setq mark-alist;; only after dired-remember-hidden since this unhides: (dired-remember-marks (point-min) (point-max))) ;; treat top level dir extra (it may contain wildcards) (dired-uncache (if (consp dired-directory) (car dired-directory) dired-directory)) (dired-readin dired-directory (current-buffer)) (let ((dired-after-readin-hook nil)) ;; don't run that hook for each subdir... (dired-insert-old-subdirs old-subdir-alist)) (dired-mark-remembered mark-alist) ; mark files that were marked ;; ... run the hook for the whole buffer, and only after markers ;; have been reinserted (else omitting in dired-x would omit marked files) (run-hooks 'dired-after-readin-hook) ; no need to narrow (or (and ofile (dired-goto-file ofile)) ; move cursor to where it (goto-char opoint)) ; was before (dired-move-to-filename) (save-excursion ; hide subdirs that were hidden (mapcar (function (lambda (dir) (if (dired-goto-subdir dir) (dired-hide-subdir 1)))) hidden-subdirs))) ;; outside of the let scope ;;; Might as well not override the user if the user changed this. ;;; (setq buffer-read-only t) ) ;; Subroutines of dired-revert ;; Some of these are also used when inserting subdirs. (defun dired-remember-marks (beg end) ;; Return alist of files and their marks, from BEG to END. (if selective-display ; must unhide to make this work. (let (buffer-read-only) (subst-char-in-region beg end ?\r ?\n))) (let (fil chr alist) (save-excursion (goto-char beg) (while (re-search-forward dired-re-mark end t) (if (setq fil (dired-get-filename nil t)) (setq chr (preceding-char) alist (cons (cons fil chr) alist))))) alist)) ;; Mark all files remembered in ALIST. ;; Each element of ALIST looks like (FILE . MARKERCHAR). (defun dired-mark-remembered (alist) (let (elt fil chr) (while alist (setq elt (car alist) alist (cdr alist) fil (car elt) chr (cdr elt)) (if (dired-goto-file fil) (save-excursion (beginning-of-line) (delete-char 1) (insert chr)))))) ;; Return a list of names of subdirs currently hidden. (defun dired-remember-hidden () (let ((l dired-subdir-alist) dir pos result) (while l (setq dir (car (car l)) pos (cdr (car l)) l (cdr l)) (goto-char pos) (skip-chars-forward "^\r\n") (if (eq (following-char) ?\r) (setq result (cons dir result)))) result)) ;; Try to insert all subdirs that were displayed before, ;; according to the former subdir alist OLD-SUBDIR-ALIST. (defun dired-insert-old-subdirs (old-subdir-alist) (or (string-match "R" dired-actual-switches) (let (elt dir) (while old-subdir-alist (setq elt (car old-subdir-alist) old-subdir-alist (cdr old-subdir-alist) dir (car elt)) (condition-case () (progn (dired-uncache dir) (dired-insert-subdir dir)) (error nil)))))) ;; Remove directory DIR from any directory cache. (defun dired-uncache (dir) (let ((handler (find-file-name-handler dir 'dired-uncache))) (if handler (funcall handler 'dired-uncache dir)))) ;; dired mode key bindings and initialization (defvar dired-mode-map nil "Local keymap for dired-mode buffers.") (if dired-mode-map nil ;; This looks ugly when substitute-command-keys uses C-d instead d: ;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion) (let ((map (make-keymap))) (suppress-keymap map) (define-key map [mouse-2] 'dired-mouse-find-file-other-window) ;; Commands to mark or flag certain categories of files (define-key map "#" 'dired-flag-auto-save-files) (define-key map "*" 'dired-mark-executables) (define-key map "." 'dired-clean-directory) (define-key map "/" 'dired-mark-directories) (define-key map "@" 'dired-mark-symlinks) (define-key map "~" 'dired-flag-backup-files) ;; Upper case keys (except !) for operating on the marked files (define-key map "A" 'dired-do-search) (define-key map "C" 'dired-do-copy) (define-key map "B" 'dired-do-byte-compile) (define-key map "D" 'dired-do-delete) (define-key map "G" 'dired-do-chgrp) (define-key map "H" 'dired-do-hardlink) (define-key map "L" 'dired-do-load) (define-key map "M" 'dired-do-chmod) (define-key map "O" 'dired-do-chown) (define-key map "P" 'dired-do-print) (define-key map "Q" 'dired-do-query-replace) (define-key map "R" 'dired-do-rename) (define-key map "S" 'dired-do-symlink) (define-key map "X" 'dired-do-shell-command) (define-key map "Z" 'dired-do-compress) (define-key map "!" 'dired-do-shell-command) ;; Comparison commands (define-key map "=" 'dired-diff) (define-key map "\M-=" 'dired-backup-diff) ;; Tree Dired commands (define-key map "\M-\C-?" 'dired-unmark-all-files) (define-key map "\M-\C-d" 'dired-tree-down) (define-key map "\M-\C-u" 'dired-tree-up) (define-key map "\M-\C-n" 'dired-next-subdir) (define-key map "\M-\C-p" 'dired-prev-subdir) ;; move to marked files (define-key map "\M-{" 'dired-prev-marked-file) (define-key map "\M-}" 'dired-next-marked-file) ;; Make all regexp commands share a `%' prefix: ;; We used to get to the submap via a symbol dired-regexp-prefix, ;; but that seems to serve little purpose, and copy-keymap ;; does a better job without it. (define-key map "%" nil) (define-key map "%u" 'dired-upcase) (define-key map "%l" 'dired-downcase) (define-key map "%d" 'dired-flag-files-regexp) (define-key map "%m" 'dired-mark-files-regexp) (define-key map "%r" 'dired-do-rename-regexp) (define-key map "%C" 'dired-do-copy-regexp) (define-key map "%H" 'dired-do-hardlink-regexp) (define-key map "%R" 'dired-do-rename-regexp) (define-key map "%S" 'dired-do-symlink-regexp) ;; Lower keys for commands not operating on all the marked files (define-key map "c" 'dired-change-marks) (define-key map "d" 'dired-flag-file-deletion) (define-key map "e" 'dired-find-file) (define-key map "f" 'dired-find-file) (define-key map "\C-m" 'dired-advertised-find-file) (define-key map "g" 'revert-buffer) (define-key map "h" 'describe-mode) (define-key map "i" 'dired-maybe-insert-subdir) (define-key map "k" 'dired-do-kill-lines) (define-key map "l" 'dired-do-redisplay) (define-key map "m" 'dired-mark) (define-key map "n" 'dired-next-line) (define-key map "o" 'dired-find-file-other-window) (define-key map "\C-o" 'dired-display-file) (define-key map "p" 'dired-previous-line) (define-key map "q" 'dired-quit) (define-key map "s" 'dired-sort-toggle-or-edit) (define-key map "u" 'dired-unmark) (define-key map "v" 'dired-view-file) (define-key map "x" 'dired-do-flagged-delete) (define-key map "+" 'dired-create-directory) ;; moving (define-key map "<" 'dired-prev-dirline) (define-key map ">" 'dired-next-dirline) (define-key map "^" 'dired-up-directory) (define-key map " " 'dired-next-line) (define-key map "\C-n" 'dired-next-line) (define-key map "\C-p" 'dired-previous-line) (define-key map [down] 'dired-next-line) (define-key map [up] 'dired-previous-line) ;; hiding (define-key map "$" 'dired-hide-subdir) (define-key map "\M-$" 'dired-hide-all) ;; misc (define-key map "?" 'dired-summary) (define-key map "\177" 'dired-unmark-backward) (define-key map "\C-_" 'dired-undo) (define-key map "\C-xu" 'dired-undo) ;; Make menu bar items. ;; Get rid of the Edit menu bar item to save space. (define-key map [menu-bar edit] 'undefined) (define-key map [menu-bar subdir] (cons "Subdir" (make-sparse-keymap "Subdir"))) (define-key map [menu-bar subdir hide-all] '("Hide All" . dired-hide-all)) (define-key map [menu-bar subdir hide-subdir] '("Hide Subdir" . dired-hide-subdir)) (define-key map [menu-bar subdir tree-down] '("Tree Down" . dired-tree-down)) (define-key map [menu-bar subdir tree-up] '("Tree Up" . dired-tree-up)) (define-key map [menu-bar subdir up] '("Up Directory" . dired-up-directory)) (define-key map [menu-bar subdir prev-subdir] '("Prev Subdir" . dired-prev-subdir)) (define-key map [menu-bar subdir next-subdir] '("Next Subdir" . dired-next-subdir)) (define-key map [menu-bar subdir prev-dirline] '("Prev Dirline" . dired-prev-dirline)) (define-key map [menu-bar subdir next-dirline] '("Next Dirline" . dired-next-dirline)) (define-key map [menu-bar subdir insert] '("Insert This Subdir" . dired-maybe-insert-subdir)) (define-key map [menu-bar immediate] (cons "Immediate" (make-sparse-keymap "Immediate"))) (define-key map [menu-bar immediate backup-diff] '("Compare with Backup" . dired-backup-diff)) (define-key map [menu-bar immediate diff] '("Diff" . dired-diff)) (define-key map [menu-bar immediate view] '("View This File" . dired-view-file)) (define-key map [menu-bar immediate display] '("Display in Other Window" . dired-display-file)) (define-key map [menu-bar immediate find-file-other-window] '("Find in Other Window" . dired-find-file-other-window)) (define-key map [menu-bar immediate find-file] '("Find This File" . dired-find-file)) (define-key map [menu-bar immediate create-directory] '("Create Directory..." . dired-create-directory)) (define-key map [menu-bar regexp] (cons "Regexp" (make-sparse-keymap "Regexp"))) (define-key map [menu-bar regexp downcase] '("Downcase" . dired-downcase)) (define-key map [menu-bar regexp upcase] '("Upcase" . dired-upcase)) (define-key map [menu-bar regexp hardlink] '("Hardlink..." . dired-do-hardlink-regexp)) (define-key map [menu-bar regexp symlink] '("Symlink..." . dired-do-symlink-regexp)) (define-key map [menu-bar regexp rename] '("Rename..." . dired-do-rename-regexp)) (define-key map [menu-bar regexp copy] '("Copy..." . dired-do-copy-regexp)) (define-key map [menu-bar regexp flag] '("Flag..." . dired-flag-files-regexp)) (define-key map [menu-bar regexp mark] '("Mark..." . dired-mark-files-regexp)) (define-key map [menu-bar mark] (cons "Mark" (make-sparse-keymap "Mark"))) (define-key map [menu-bar mark prev] '("Previous Marked" . dired-prev-marked-file)) (define-key map [menu-bar mark next] '("Next Marked" . dired-next-marked-file)) (define-key map [menu-bar mark marks] '("Change Marks..." . dired-change-marks)) (define-key map [menu-bar mark unmark-all] '("Unmark All" . dired-unmark-all-files-no-query)) (define-key map [menu-bar mark symlinks] '("Mark Symlinks" . dired-mark-symlinks)) (define-key map [menu-bar mark directories] '("Mark Directories" . dired-mark-directories)) (define-key map [menu-bar mark directory] '("Mark Old Backups" . dired-clean-directory)) (define-key map [menu-bar mark executables] '("Mark Executables" . dired-mark-executables)) (define-key map [menu-bar mark backup-files] '("Flag Backup Files" . dired-flag-backup-files)) (define-key map [menu-bar mark auto-save-files] '("Flag Auto-save Files" . dired-flag-auto-save-files)) (define-key map [menu-bar mark deletion] '("Flag" . dired-flag-file-deletion)) (define-key map [menu-bar mark unmark] '("Unmark" . dired-unmark)) (define-key map [menu-bar mark mark] '("Mark" . dired-mark)) (define-key map [menu-bar operate] (cons "Operate" (make-sparse-keymap "Operate"))) (define-key map [menu-bar operate query-replace] '("Query Replace in Files..." . dired-do-query-replace)) (define-key map [menu-bar operate search] '("Search Files..." . dired-do-search)) (define-key map [menu-bar operate chown] '("Change Owner..." . dired-do-chown)) (define-key map [menu-bar operate chgrp] '("Change Group..." . dired-do-chgrp)) (define-key map [menu-bar operate chmod] '("Change Mode..." . dired-do-chmod)) (define-key map [menu-bar operate load] '("Load" . dired-do-load)) (define-key map [menu-bar operate compile] '("Byte-compile" . dired-do-byte-compile)) (define-key map [menu-bar operate compress] '("Compress" . dired-do-compress)) (define-key map [menu-bar operate print] '("Print" . dired-do-print)) (define-key map [menu-bar operate hardlink] '("Hardlink to..." . dired-do-hardlink)) (define-key map [menu-bar operate symlink] '("Symlink to..." . dired-do-symlink)) (define-key map [menu-bar operate command] '("Shell Command..." . dired-do-shell-command)) (define-key map [menu-bar operate delete] '("Delete" . dired-do-delete)) (define-key map [menu-bar operate rename] '("Rename to..." . dired-do-rename)) (define-key map [menu-bar operate copy] '("Copy to..." . dired-do-copy)) (setq dired-mode-map map))) ;; Dired mode is suitable only for specially formatted data. (put 'dired-mode 'mode-class 'special) (defun dired-mode (&optional dirname switches) "\ Mode for \"editing\" directory listings. In dired, you are \"editing\" a list of the files in a directory and \(optionally) its subdirectories, in the format of `ls -lR'. Each directory is a page: use \\[backward-page] and \\[forward-page] to move pagewise. \"Editing\" means that you can run shell commands on files, visit, compress, load or byte-compile them, change their file attributes and insert subdirectories into the same buffer. You can \"mark\" files for later commands or \"flag\" them for deletion, either file by file or all files matching certain criteria. You can move using the usual cursor motion commands.\\ Letters no longer insert themselves. Digits are prefix arguments. Instead, type \\[dired-flag-file-deletion] to flag a file for Deletion. Type \\[dired-mark] to Mark a file or subdirectory for later commands. Most commands operate on the marked files and use the current file if no files are marked. Use a numeric prefix argument to operate on the next ARG (or previous -ARG if ARG<0) files, or just `1' to operate on the current file only. Prefix arguments override marks. Mark-using commands display a list of failures afterwards. Type \\[dired-summary] to see why something went wrong. Type \\[dired-unmark] to Unmark a file or all files of a subdirectory. Type \\[dired-unmark-backward] to back up one line and unflag. Type \\[dired-do-flagged-delete] to eXecute the deletions requested. Type \\[dired-advertised-find-file] to Find the current line's file (or dired it in another buffer, if it is a directory). Type \\[dired-find-file-other-window] to find file or dired directory in Other window. Type \\[dired-maybe-insert-subdir] to Insert a subdirectory in this buffer. Type \\[dired-do-rename] to Rename a file or move the marked files to another directory. Type \\[dired-do-copy] to Copy files. Type \\[dired-sort-toggle-or-edit] to toggle sorting by name/date or change the `ls' switches. Type \\[revert-buffer] to read all currently expanded directories again. This retains all marks and hides subdirs again that were hidden before. SPC and DEL can be used to move down and up by lines. If dired ever gets confused, you can either type \\[revert-buffer] \ to read the directories again, type \\[dired-do-redisplay] \ to relist a single or the marked files or a subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer again for the directory tree. Customization variables (rename this buffer and type \\[describe-variable] on each line for more info): dired-listing-switches dired-trivial-filenames dired-shrink-to-fit dired-marker-char dired-del-marker dired-keep-marker-rename dired-keep-marker-copy dired-keep-marker-hardlink dired-keep-marker-symlink Hooks (use \\[describe-variable] to see their documentation): dired-before-readin-hook dired-after-readin-hook dired-mode-hook dired-load-hook Keybindings: \\{dired-mode-map}" ;; Not to be called interactively (e.g. dired-directory will be set ;; to default-directory, which is wrong with wildcards). (kill-all-local-variables) (use-local-map dired-mode-map) (dired-advertise) ; default-directory is already set (setq major-mode 'dired-mode mode-name "Dired" ;; case-fold-search nil buffer-read-only t selective-display t ; for subdirectory hiding mode-line-buffer-identification '("Dired: %17b")) (set (make-local-variable 'revert-buffer-function) (function dired-revert)) (set (make-local-variable 'page-delimiter) "\n\n") (set (make-local-variable 'dired-directory) (or dirname default-directory)) ;; list-buffers uses this to display the dir being edited in this buffer. (set (make-local-variable 'list-buffers-directory) (expand-file-name dired-directory)) (set (make-local-variable 'dired-actual-switches) (or switches dired-listing-switches)) (set (make-local-variable 'font-lock-defaults) '(dired-font-lock-keywords t)) (dired-sort-other dired-actual-switches t) (run-hooks 'dired-mode-hook)) ;; Idiosyncratic dired commands that don't deal with marks. (defun dired-quit () "Bury the current dired buffer." (interactive) (bury-buffer)) (defun dired-summary () "Summarize basic Dired commands and show recent Dired errors." (interactive) (dired-why) ;>> this should check the key-bindings and use substitute-command-keys if non-standard (message "d-elete, u-ndelete, x-punge, f-ind, o-ther window, R-ename, C-opy, h-elp")) (defun dired-undo () "Undo in a dired buffer. This doesn't recover lost files, it just undoes changes in the buffer itself. You can use it to recover marks, killed lines or subdirs. In the latter case, you have to do \\[dired-build-subdir-alist] to parse the buffer again." (interactive) (let (buffer-read-only) (undo))) (defun dired-next-line (arg) "Move down lines then position at filename. Optional prefix ARG says how many lines to move; default is one line." (interactive "p") (next-line arg) (dired-move-to-filename)) (defun dired-previous-line (arg) "Move up lines then position at filename. Optional prefix ARG says how many lines to move; default is one line." (interactive "p") (previous-line arg) (dired-move-to-filename)) (defun dired-next-dirline (arg &optional opoint) "Goto ARG'th next directory file line." (interactive "p") (or opoint (setq opoint (point))) (if (if (> arg 0) (re-search-forward dired-re-dir nil t arg) (beginning-of-line) (re-search-backward dired-re-dir nil t (- arg))) (dired-move-to-filename) ; user may type `i' or `f' (goto-char opoint) (error "No more subdirectories"))) (defun dired-prev-dirline (arg) "Goto ARG'th previous directory file line." (interactive "p") (dired-next-dirline (- arg))) (defun dired-up-directory (&optional other-window) "Run dired on parent directory of current directory. Find the parent directory either in this buffer or another buffer. Creates a buffer if necessary." (interactive "P") (let* ((dir (dired-current-directory)) (up (file-name-directory (directory-file-name dir)))) (or (dired-goto-file (directory-file-name dir)) ;; Only try dired-goto-subdir if buffer has more than one dir. (and (cdr dired-subdir-alist) (dired-goto-subdir up)) (progn (if other-window (dired-other-window up) (dired up)) (dired-goto-file dir))))) ;; Force `f' rather than `e' in the mode doc: (defalias 'dired-advertised-find-file 'dired-find-file) (defun dired-find-file () "In dired, visit the file or directory named on this line." (interactive) (find-file (file-name-sans-versions (dired-get-filename) t))) (defun dired-mouse-find-file-other-window (event) "In dired, visit the file or directory name you click on." (interactive "e") (let (file) (save-excursion (set-buffer (window-buffer (posn-window (event-end event)))) (save-excursion (goto-char (posn-point (event-end event))) (setq file (dired-get-filename)))) (select-window (posn-window (event-end event))) (find-file-other-window (file-name-sans-versions file t)))) (defun dired-view-file () "In dired, examine a file in view mode, returning to dired when done. When file is a directory, show it in this buffer if it is inserted; otherwise, display it in another buffer." (interactive) (if (file-directory-p (dired-get-filename)) (or (and (cdr dired-subdir-alist) (dired-goto-subdir (dired-get-filename))) (dired (dired-get-filename))) (view-file (dired-get-filename)))) (defun dired-find-file-other-window () "In dired, visit this file or directory in another window." (interactive) (find-file-other-window (file-name-sans-versions (dired-get-filename) t))) (defun dired-display-file () "In dired, display this file or directory in another window." (interactive) (let ((file (file-name-sans-versions (dired-get-filename) t))) (display-buffer (find-file-noselect file)))) ;;; Functions for extracting and manipulating file names in dired buffers. (defun dired-get-filename (&optional localp no-error-if-not-filep) "In dired, return name of file mentioned on this line. Value returned normally includes the directory name. Optional arg LOCALP with value `no-dir' means don't include directory name in result. A value of t means construct name relative to `default-directory', which still may contain slashes if in a subdirectory. Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename on this line, otherwise an error occurs." (let (case-fold-search file p1 p2) (save-excursion (if (setq p1 (dired-move-to-filename (not no-error-if-not-filep))) (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep)))) ;; nil if no file on this line, but no-error-if-not-filep is t: (if (setq file (and p1 p2 (buffer-substring p1 p2))) (progn ;; Get rid of the mouse-face property that file names have. (set-text-properties 0 (length file) nil file) ;; Unquote names quoted by ls or by dired-insert-directory. ;; Using read to unquote is much faster than substituting ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop. (setq file (read (concat "\"" ;; some ls -b don't escape quotes, argh! ;; This is not needed for GNU ls, though. (or (dired-string-replace-match "\\([^\\]\\)\"" file "\\1\\\\\"") file) "\""))))) (if (eq localp 'no-dir) file (and file (concat (dired-current-directory localp) file))))) (defun dired-string-replace-match (regexp string newtext &optional literal global) "Replace first match of REGEXP in STRING with NEWTEXT. If it does not match, nil is returned instead of the new string. Optional arg LITERAL means to take NEWTEXT literally. Optional arg GLOBAL means to replace all matches." (if global (let ((start 0)) (while (string-match regexp string start) (let ((from-end (- (length string) (match-end 0)))) (setq string (replace-match newtext t literal string)) (setq start (- (length string) from-end)))) string) (if (not (string-match regexp string 0)) nil (replace-match newtext t literal string)))) (defun dired-make-absolute (file &optional dir) ;;"Convert FILE (a pathname relative to DIR) to an absolute pathname." ;; We can't always use expand-file-name as this would get rid of `.' ;; or expand in / instead default-directory if DIR=="". ;; This should be good enough for ange-ftp, but might easily be ;; redefined (for VMS?). ;; It should be reasonably fast, though, as it is called in ;; dired-get-filename. (concat (or dir default-directory) file)) (defun dired-make-relative (file &optional dir no-error) ;;"Convert FILE (an absolute pathname) to a pathname relative to DIR. ;; Else error (unless NO-ERROR is non-nil, then FILE is returned unchanged) ;;DIR defaults to default-directory." ;; DIR must be file-name-as-directory, as with all directory args in ;; Emacs Lisp code. (or dir (setq dir default-directory)) ;; This case comes into play if default-directory is set to ;; use ~. (if (and (> (length dir) 0) (= (aref dir 0) ?~)) (setq dir (expand-file-name dir))) (if (string-match (concat "^" (regexp-quote dir)) file) (substring file (match-end 0)) (if no-error file (error "%s: not in directory tree growing at %s" file dir)))) ;;; Functions for finding the file name in a dired buffer line. (defvar dired-move-to-filename-regexp "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+ [ 0-9][0-9][:0-9][0-9][ 0-9] " "Regular expression to match a month abbreviation followed by a number.") ;; Move to first char of filename on this line. ;; Returns position (point) or nil if no filename on this line." (defun dired-move-to-filename (&optional raise-error eol) ;; This is the UNIX version. (or eol (setq eol (progn (end-of-line) (point)))) (beginning-of-line) (if (re-search-forward dired-move-to-filename-regexp eol t) (goto-char (match-end 0)) (if raise-error (error "No file on this line")))) (defun dired-move-to-end-of-filename (&optional no-error) ;; Assumes point is at beginning of filename, ;; thus the rwx bit re-search-backward below will succeed in *this* ;; line if at all. So, it should be called only after ;; (dired-move-to-filename t). ;; On failure, signals an error (with non-nil NO-ERROR just returns nil). ;; This is the UNIX version. (let (opoint file-type executable symlink hidden case-fold-search used-F eol) ;; case-fold-search is nil now, so we can test for capital F: (setq used-F (string-match "F" dired-actual-switches) opoint (point) eol (save-excursion (end-of-line) (point)) hidden (and selective-display (save-excursion (search-forward "\r" eol t)))) (if hidden nil (save-excursion;; Find out what kind of file this is: ;; Restrict perm bits to be non-blank, ;; otherwise this matches one char to early (looking backward): ;; "l---------" (some systems make symlinks that way) ;; "----------" (plain file with zero perms) (if (re-search-backward "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)" nil t) (setq file-type (char-after (match-beginning 1)) symlink (eq file-type ?l) ;; Only with -F we need to know whether it's an executable executable (and used-F (string-match "[xst]";; execute bit set anywhere? (concat (buffer-substring (match-beginning 2) (match-end 2)) (buffer-substring (match-beginning 3) (match-end 3)) (buffer-substring (match-beginning 4) (match-end 4)))))) (or no-error (error "No file on this line")))) ;; Move point to end of name: (if symlink (if (search-forward " ->" eol t) (progn (forward-char -3) (and used-F dired-ls-F-marks-symlinks (eq (preceding-char) ?@);; did ls really mark the link? (forward-char -1)))) (goto-char eol);; else not a symbolic link ;; ls -lF marks dirs, sockets and executables with exactly one ;; trailing character. (Executable bits on symlinks ain't mean ;; a thing, even to ls, but we know it's not a symlink.) (and used-F (or (memq file-type '(?d ?s)) executable) (forward-char -1)))) (or no-error (not (eq opoint (point))) (error (if hidden (substitute-command-keys "File line is hidden, type \\[dired-hide-subdir] to unhide") "No file on this line"))) (if (eq opoint (point)) nil (point)))) ;; Keeping Dired buffers in sync with the filesystem and with each other (defvar dired-buffers nil ;; Enlarged by dired-advertise ;; Queried by function dired-buffers-for-dir. When this detects a ;; killed buffer, it is removed from this list. "Alist of expanded directories and their associated dired buffers.") (defun dired-buffers-for-dir (dir) ;; Return a list of buffers that dired DIR (top level or in-situ subdir). ;; The list is in reverse order of buffer creation, most recent last. ;; As a side effect, killed dired buffers for DIR are removed from ;; dired-buffers. (setq dir (file-name-as-directory dir)) (let ((alist dired-buffers) result elt buf) (while alist (setq elt (car alist) buf (cdr elt)) (if (buffer-name buf) (if (dired-in-this-tree dir (car elt)) (if (assoc dir (save-excursion (set-buffer buf) dired-subdir-alist)) (setq result (cons buf result)))) ;; else buffer is killed - clean up: (setq dired-buffers (delq elt dired-buffers))) (setq alist (cdr alist))) result)) (defun dired-advertise () ;;"Advertise in variable `dired-buffers' that we dired `default-directory'." ;; With wildcards we actually advertise too much. (let ((expanded-default (expand-file-name default-directory))) (if (memq (current-buffer) (dired-buffers-for-dir expanded-default)) t ; we have already advertised ourselves (setq dired-buffers (cons (cons expanded-default (current-buffer)) dired-buffers))))) (defun dired-unadvertise (dir) ;; Remove DIR from the buffer alist in variable dired-buffers. ;; This has the effect of removing any buffer whose main directory is DIR. ;; It does not affect buffers in which DIR is a subdir. ;; Removing is also done as a side-effect in dired-buffer-for-dir. (setq dired-buffers (delq (assoc (expand-file-name dir) dired-buffers) dired-buffers))) ;; Tree Dired ;;; utility functions (defun dired-in-this-tree (file dir) ;;"Is FILE part of the directory tree starting at DIR?" (let (case-fold-search) (string-match (concat "^" (regexp-quote dir)) file))) (defun dired-normalize-subdir (dir) ;; Prepend default-directory to DIR if relative path name. ;; dired-get-filename must be able to make a valid filename from a ;; file and its directory DIR. (file-name-as-directory (if (file-name-absolute-p dir) dir (expand-file-name dir default-directory)))) (defun dired-get-subdir () ;;"Return the subdir name on this line, or nil if not on a headerline." ;; Look up in the alist whether this is a headerline. (save-excursion (let ((cur-dir (dired-current-directory))) (beginning-of-line) ; alist stores b-o-l positions (and (zerop (- (point) (dired-get-subdir-min (assoc cur-dir dired-subdir-alist)))) cur-dir)))) ;(defun dired-get-subdir-min (elt) ; (cdr elt)) ;; can't use macro, must be redefinable for other alist format in dired-nstd. (defalias 'dired-get-subdir-min 'cdr) (defun dired-get-subdir-max (elt) (save-excursion (goto-char (dired-get-subdir-min elt)) (dired-subdir-max))) (defun dired-clear-alist () (while dired-subdir-alist (set-marker (dired-get-subdir-min (car dired-subdir-alist)) nil) (setq dired-subdir-alist (cdr dired-subdir-alist)))) (defun dired-subdir-index (dir) ;; Return an index into alist for use with nth ;; for the sake of subdir moving commands. (let (found (index 0) (alist dired-subdir-alist)) (while alist (if (string= dir (car (car alist))) (setq alist nil found t) (setq alist (cdr alist) index (1+ index)))) (if found index nil))) (defun dired-next-subdir (arg &optional no-error-if-not-found no-skip) "Go to next subdirectory, regardless of level." ;; Use 0 arg to go to this directory's header line. ;; NO-SKIP prevents moving to end of header line, returning whatever ;; position was found in dired-subdir-alist. (interactive "p") (let ((this-dir (dired-current-directory)) pos index) ;; nth with negative arg does not return nil but the first element (setq index (- (dired-subdir-index this-dir) arg)) (setq pos (if (>= index 0) (dired-get-subdir-min (nth index dired-subdir-alist)))) (if pos (progn (goto-char pos) (or no-skip (skip-chars-forward "^\n\r")) (point)) (if no-error-if-not-found nil ; return nil if not found (error "%s directory" (if (> arg 0) "Last" "First")))))) (defun dired-build-subdir-alist () "Build `dired-subdir-alist' by parsing the buffer. Returns the new value of the alist." (interactive) (dired-clear-alist) (save-excursion (let ((count 0) (buffer-read-only nil) new-dir-name) (goto-char (point-min)) (setq dired-subdir-alist nil) (while (and (re-search-forward dired-subdir-regexp nil t) ;; Avoid taking a file name ending in a colon ;; as a subdir name. (not (save-excursion (goto-char (match-beginning 0)) (beginning-of-line) (forward-char 2) (save-match-data (looking-at dired-re-perms))))) (save-excursion (goto-char (match-beginning 1)) (setq new-dir-name (expand-file-name (buffer-substring (point) (match-end 1)))) (delete-region (point) (match-end 1)) (insert new-dir-name)) (setq count (1+ count)) (dired-alist-add-1 new-dir-name ;; Place a sub directory boundary between lines. (save-excursion (goto-char (match-beginning 0)) (beginning-of-line) (point-marker)))) (if (> count 1) (message "Buffer includes %d directories" count)) ;; We don't need to sort it because it is in buffer order per ;; constructionem. Return new alist: dired-subdir-alist))) (defun dired-alist-add-1 (dir new-marker) ;; Add new DIR at NEW-MARKER. Don't sort. (setq dired-subdir-alist (cons (cons (dired-normalize-subdir dir) new-marker) dired-subdir-alist))) (defun dired-goto-next-nontrivial-file () ;; Position point on first nontrivial file after point. (dired-goto-next-file);; so there is a file to compare with (if (stringp dired-trivial-filenames) (while (and (not (eobp)) (string-match dired-trivial-filenames (file-name-nondirectory (or (dired-get-filename nil t) "")))) (forward-line 1) (dired-move-to-filename)))) (defun dired-goto-next-file () (let ((max (1- (dired-subdir-max)))) (while (and (not (dired-move-to-filename)) (< (point) max)) (forward-line 1)))) (defun dired-goto-file (file) "Go to file line of FILE in this dired buffer." ;; Return value of point on success, else nil. ;; FILE must be an absolute pathname. ;; Loses if FILE contains control chars like "\007" for which ls ;; either inserts "?" or "\\007" into the buffer, so we won't find ;; it in the buffer. (interactive (prog1 ; let push-mark display its message (list (expand-file-name (read-file-name "Goto file: " (dired-current-directory)))) (push-mark))) (setq file (directory-file-name file)) ; does no harm if no directory (let (found case-fold-search dir) (setq dir (or (file-name-directory file) (error "Need absolute pathname for %s" file))) (save-excursion ;; The hair here is to get the result of dired-goto-subdir ;; without really calling it if we don't have any subdirs. (if (if (string= dir (expand-file-name default-directory)) (goto-char (point-min)) (and (cdr dired-subdir-alist) (dired-goto-subdir dir))) (let ((base (file-name-nondirectory file)) (boundary (dired-subdir-max))) (while (and (not found) ;; filenames are preceded by SPC, this makes ;; the search faster (e.g. for the filename "-"!). (search-forward (concat " " base) boundary 'move)) ;; Match could have BASE just as initial substring or ;; or in permission bits or date or ;; not be a proper filename at all: (if (equal base (dired-get-filename 'no-dir t)) ;; Must move to filename since an (actually ;; correct) match could have been elsewhere on the ;; ;; line (e.g. "-" would match somewhere in the ;; permission bits). (setq found (dired-move-to-filename)) ;; If this isn't the right line, move forward to avoid ;; trying this line again. (forward-line 1)))))) (and found ;; return value of point (i.e., FOUND): (goto-char found)))) (defun dired-initial-position (dirname) ;; Where point should go in a new listing of DIRNAME. ;; Point assumed at beginning of new subdir line. ;; You may redefine this function as you wish, e.g. like in dired-x.el. (end-of-line) (if dired-trivial-filenames (dired-goto-next-nontrivial-file))) ;; These are hooks which make tree dired work. ;; They are in this file because other parts of dired need to call them. ;; But they don't call the rest of tree dired unless there are subdirs loaded. ;; This function is called for each retrieved filename. ;; It could stand to be faster, though it's mostly function call ;; overhead. Avoiding the function call seems to save about 10% in ;; dired-get-filename. Make it a defsubst? (defun dired-current-directory (&optional localp) "Return the name of the subdirectory to which this line belongs. This returns a string with trailing slash, like `default-directory'. Optional argument means return a file name relative to `default-directory'." (let ((here (point)) (alist (or dired-subdir-alist ;; probably because called in a non-dired buffer (error "No subdir-alist in %s" (current-buffer)))) elt dir) (while alist (setq elt (car alist) dir (car elt) ;; use `<=' (not `<') as subdir line is part of subdir alist (if (<= (dired-get-subdir-min elt) here) nil ; found (cdr alist)))) (if localp (dired-make-relative dir default-directory) dir))) ;; Subdirs start at the beginning of their header lines and end just ;; before the beginning of the next header line (or end of buffer). (defun dired-subdir-max () (save-excursion (if (or (null (cdr dired-subdir-alist)) (not (dired-next-subdir 1 t t))) (point-max) (point)))) ;; Deleting files (defun dired-do-flagged-delete (&optional nomessage) "In dired, delete the files flagged for deletion. If NOMESSAGE is non-nil, we don't display any message if there are no flagged files." (interactive) (let* ((dired-marker-char dired-del-marker) (regexp (dired-marker-regexp)) case-fold-search) (if (save-excursion (goto-char (point-min)) (re-search-forward regexp nil t)) (dired-internal-do-deletions ;; this can't move point since ARG is nil (dired-map-over-marks (cons (dired-get-filename) (point)) nil) nil) (or nomessage (message "(No deletions requested)"))))) (defun dired-do-delete (&optional arg) "Delete all marked (or next ARG) files." ;; This is more consistent with the file marking feature than ;; dired-do-flagged-delete. (interactive "P") (dired-internal-do-deletions ;; this may move point if ARG is an integer (dired-map-over-marks (cons (dired-get-filename) (point)) arg) arg)) (defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p? (defun dired-internal-do-deletions (l arg) ;; L is an alist of files to delete, with their buffer positions. ;; ARG is the prefix arg. ;; Filenames are absolute (VMS needs this for logical search paths). ;; (car L) *must* be the *last* (bottommost) file in the dired buffer. ;; That way as changes are made in the buffer they do not shift the ;; lines still to be changed, so the (point) values in L stay valid. ;; Also, for subdirs in natural order, a subdir's files are deleted ;; before the subdir itself - the other way around would not work. (let ((files (mapcar (function car) l)) (count (length l)) (succ 0)) ;; canonicalize file list for pop up (setq files (nreverse (mapcar (function dired-make-relative) files))) (if (dired-mark-pop-up " *Deletions*" 'delete files dired-deletion-confirmer (format "Delete %s " (dired-mark-prompt arg files))) (save-excursion (let (failures);; files better be in reverse order for this loop! (while l (goto-char (cdr (car l))) (let (buffer-read-only) (condition-case err (let ((fn (car (car l)))) ;; This test is equivalent to ;; (and (file-directory-p fn) (not (file-symlink-p fn))) ;; but more efficient (if (eq t (car (file-attributes fn))) (delete-directory fn) (delete-file fn)) ;; if we get here, removing worked (setq succ (1+ succ)) (message "%s of %s deletions" succ count) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point))) (dired-clean-up-after-deletion fn)) (error;; catch errors from failed deletions (dired-log "%s\n" err) (setq failures (cons (car (car l)) failures))))) (setq l (cdr l))) (if (not failures) (message "%d deletion%s done" count (dired-plural-s count)) (dired-log-summary (format "%d of %d deletion%s failed" (length failures) count (dired-plural-s count)) failures)))) (message "(No deletions performed)"))) (dired-move-to-filename)) ;; This is a separate function for the sake of dired-x.el. (defun dired-clean-up-after-deletion (fn) ;; Clean up after a deleted file or directory FN. (save-excursion (and (cdr dired-subdir-alist) (dired-goto-subdir fn) (dired-kill-subdir)))) ;; Confirmation (defun dired-marker-regexp () (concat "^" (regexp-quote (char-to-string dired-marker-char)))) (defun dired-plural-s (count) (if (= 1 count) "" "s")) (defun dired-mark-prompt (arg files) ;; Return a string for use in a prompt, either the current file ;; name, or the marker and a count of marked files. (let ((count (length files))) (if (= count 1) (car files) ;; more than 1 file: (if (integerp arg) ;; abs(arg) = count ;; Perhaps this is nicer, but it also takes more screen space: ;;(format "[%s %d files]" (if (> arg 0) "next" "previous") ;; count) (format "[next %d files]" arg) (format "%c [%d files]" dired-marker-char count))))) (defun dired-pop-to-buffer (buf) ;; Pop up buffer BUF. ;; If dired-shrink-to-fit is t, make its window fit its contents. (if (not dired-shrink-to-fit) (pop-to-buffer (get-buffer-create buf)) ;; let window shrink to fit: (let ((window (selected-window)) target-lines w2) (cond ;; if split-window-threshold is enabled, use the largest window ((and (> (window-height (setq w2 (get-largest-window))) split-height-threshold) (= (frame-width) (window-width w2))) (setq window w2)) ;; if the least-recently-used window is big enough, use it ((and (> (window-height (setq w2 (get-lru-window))) (* 2 window-min-height)) (= (frame-width) (window-width w2))) (setq window w2))) (save-excursion (set-buffer buf) (goto-char (point-max)) (skip-chars-backward "\n\r\t ") (setq target-lines (count-lines (point-min) (point))) ;; Don't forget to count the last line. (if (not (bolp)) (setq target-lines (1+ target-lines)))) (if (<= (window-height window) (* 2 window-min-height)) ;; At this point, every window on the frame is too small to split. (setq w2 (display-buffer buf)) (setq w2 (split-window window (max window-min-height (- (window-height window) (1+ (max window-min-height target-lines))))))) (set-window-buffer w2 buf) (if (< (1- (window-height w2)) target-lines) (progn (select-window w2) (enlarge-window (- target-lines (1- (window-height w2)))))) (set-window-start w2 1) ))) (defvar dired-no-confirm nil ;; "If non-nil, list of symbols for commands dired should not confirm. ;;It can be a sublist of ;; ;; '(byte-compile chgrp chmod chown compress copy delete hardlink load ;; move print shell symlink uncompress)" ) (defun dired-mark-pop-up (bufname op-symbol files function &rest args) ;;"Args BUFNAME OP-SYMBOL FILES FUNCTION &rest ARGS. ;;Return FUNCTION's result on ARGS after popping up a window (in a buffer ;;named BUFNAME, nil gives \" *Marked Files*\") showing the marked ;;files. Uses function `dired-pop-to-buffer' to do that. ;; FUNCTION should not manipulate files. ;; It should only read input (an argument or confirmation). ;;The window is not shown if there is just one file or ;; OP-SYMBOL is a member of the list in `dired-no-confirm'. ;;FILES is the list of marked files." (or bufname (setq bufname " *Marked Files*")) (if (or (memq op-symbol dired-no-confirm) (= (length files) 1)) (apply function args) (save-excursion (set-buffer (get-buffer-create bufname)) (erase-buffer) (dired-format-columns-of-files files) (remove-text-properties (point-min) (point-max) '(mouse-face))) (save-window-excursion (dired-pop-to-buffer bufname) (apply function args)))) (defun dired-format-columns-of-files (files) ;; Files should be in forward order for this loop. ;; i.e., (car files) = first file in buffer. ;; Returns the number of lines used. (let* ((maxlen (+ 2 (apply 'max (mapcar 'length files)))) (width (- (window-width (selected-window)) 2)) (columns (max 1 (/ width maxlen))) (nfiles (length files)) (rows (+ (/ nfiles columns) (if (zerop (% nfiles columns)) 0 1))) (i 0) (j 0)) (setq files (nconc (copy-sequence files) ; fill up with empty fns (make-list (- (* columns rows) nfiles) ""))) (setcdr (nthcdr (1- (length files)) files) files) ; make circular (while (< j rows) (while (< i columns) (indent-to (* i maxlen)) (insert (car files)) (setq files (nthcdr rows files) i (1+ i))) (insert "\n") (setq i 0 j (1+ j) files (cdr files))) rows)) ;; Commands to mark or flag file(s) at or near current line. (defun dired-repeat-over-lines (arg function) ;; This version skips non-file lines. (let ((pos (make-marker))) (beginning-of-line) (while (and (> arg 0) (not (eobp))) (setq arg (1- arg)) (beginning-of-line) (while (and (not (eobp)) (dired-between-files)) (forward-line 1)) (save-excursion (forward-line 1) (move-marker pos (1+ (point)))) (save-excursion (funcall function)) ;; Advance to the next line--actually, to the line that *was* next. ;; (If FUNCTION inserted some new lines in between, skip them.) (goto-char pos)) (while (and (< arg 0) (not (bobp))) (setq arg (1+ arg)) (forward-line -1) (while (and (not (bobp)) (dired-between-files)) (forward-line -1)) (beginning-of-line) (save-excursion (funcall function))) (move-marker pos nil) (dired-move-to-filename))) (defun dired-between-files () ;; Point must be at beginning of line ;; Should be equivalent to (save-excursion (not (dired-move-to-filename))) ;; but is about 1.5..2.0 times as fast. (Actually that's not worth it) (or (looking-at "^$\\|^. *$\\|^. total\\|^. wildcard") (and (looking-at dired-subdir-regexp) (save-excursion (not (dired-move-to-filename)))))) (defun dired-next-marked-file (arg &optional wrap opoint) "Move to the next marked file, wrapping around the end of the buffer." (interactive "p\np") (or opoint (setq opoint (point)));; return to where interactively started (if (if (> arg 0) (re-search-forward dired-re-mark nil t arg) (beginning-of-line) (re-search-backward dired-re-mark nil t (- arg))) (dired-move-to-filename) (if (null wrap) (progn (goto-char opoint) (error "No next marked file")) (message "(Wraparound for next marked file)") (goto-char (if (> arg 0) (point-min) (point-max))) (dired-next-marked-file arg nil opoint)))) (defun dired-prev-marked-file (arg &optional wrap) "Move to the previous marked file, wrapping around the end of the buffer." (interactive "p\np") (dired-next-marked-file (- arg) wrap)) (defun dired-file-marker (file) ;; Return FILE's marker, or nil if unmarked. (save-excursion (and (dired-goto-file file) (progn (beginning-of-line) (if (not (equal ?\040 (following-char))) (following-char)))))) (defun dired-mark-files-in-region (start end) (let (buffer-read-only) (if (> start end) (error "start > end")) (goto-char start) ; assumed at beginning of line (while (< (point) end) ;; Skip subdir line and following garbage like the `total' line: (while (and (< (point) end) (dired-between-files)) (forward-line 1)) (if (and (not (looking-at dired-re-dot)) (dired-get-filename nil t)) (progn (delete-char 1) (insert dired-marker-char))) (forward-line 1)))) (defun dired-mark (arg) "Mark the current (or next ARG) files. If on a subdir headerline, mark all its files except `.' and `..'. Use \\[dired-unmark-all-files] to remove all marks and \\[dired-unmark] on a subdir to remove the marks in this subdir." (interactive "P") (if (dired-get-subdir) (save-excursion (dired-mark-subdir-files)) (let (buffer-read-only) (dired-repeat-over-lines (prefix-numeric-value arg) (function (lambda () (delete-char 1) (insert dired-marker-char))))))) (defun dired-unmark (arg) "Unmark the current (or next ARG) files. If looking at a subdir, unmark all its files except `.' and `..'." (interactive "P") (let ((dired-marker-char ?\040)) (dired-mark arg))) (defun dired-flag-file-deletion (arg) "In dired, flag the current line's file for deletion. With prefix arg, repeat over several lines. If on a subdir headerline, mark all its files except `.' and `..'." (interactive "P") (let ((dired-marker-char dired-del-marker)) (dired-mark arg))) (defun dired-unmark-backward (arg) "In dired, move up lines and remove deletion flag there. Optional prefix ARG says how many lines to unflag; default is one line." (interactive "p") (dired-unmark (- arg))) ;;; Commands to mark or flag files based on their characteristics or names. (defvar dired-regexp-history nil "History list of regular expressions used in Dired commands.") (defun dired-read-regexp (prompt) (read-from-minibuffer prompt nil nil nil 'dired-regexp-history)) (defun dired-mark-files-regexp (regexp &optional marker-char) "Mark all files matching REGEXP for use in later commands. A prefix argument means to unmark them instead. `.' and `..' are never marked. REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for object files--just `.o' will mark more than you might think." (interactive (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark") " files (regexp): ")) (if current-prefix-arg ?\040))) (let ((dired-marker-char (or marker-char dired-marker-char))) (dired-mark-if (and (not (looking-at dired-re-dot)) (not (eolp)) ; empty line (let ((fn (dired-get-filename nil t))) (and fn (string-match regexp (file-name-nondirectory fn))))) "matching file"))) (defun dired-flag-files-regexp (regexp) "In dired, flag all files containing the specified REGEXP for deletion. The match is against the non-directory part of the filename. Use `^' and `$' to anchor matches. Exclude subdirs by hiding them. `.' and `..' are never flagged." (interactive (list (dired-read-regexp "Flag for deletion (regexp): "))) (dired-mark-files-regexp regexp dired-del-marker)) (defun dired-mark-symlinks (unflag-p) "Mark all symbolic links. With prefix argument, unflag all those files." (interactive "P") (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) (dired-mark-if (looking-at dired-re-sym) "symbolic link"))) (defun dired-mark-directories (unflag-p) "Mark all directory file lines except `.' and `..'. With prefix argument, unflag all those files." (interactive "P") (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) (dired-mark-if (and (looking-at dired-re-dir) (not (looking-at dired-re-dot))) "directory file"))) (defun dired-mark-executables (unflag-p) "Mark all executable files. With prefix argument, unflag all those files." (interactive "P") (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) (dired-mark-if (looking-at dired-re-exe) "executable file"))) ;; dired-x.el has a dired-mark-sexp interactive command: mark ;; files for which PREDICATE returns non-nil. (defun dired-flag-auto-save-files (&optional unflag-p) "Flag for deletion files whose names suggest they are auto save files. A prefix argument says to unflag those files instead." (interactive "P") (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker))) (dired-mark-if ;; It is less than general to check for # here, ;; but it's the only way this runs fast enough. (and (save-excursion (end-of-line) (or (eq (preceding-char) ?#) ;; Handle executables in case of -F option. ;; We need not worry about the other kinds ;; of markings that -F makes, since they won't ;; appear on real auto-save files. (if (eq (preceding-char) ?*) (progn (forward-char -1) (eq (preceding-char) ?#))))) (not (looking-at dired-re-dir)) (let ((fn (dired-get-filename t t))) (if fn (auto-save-file-name-p (file-name-nondirectory fn))))) "auto save file"))) (defun dired-flag-backup-files (&optional unflag-p) "Flag all backup files (names ending with `~') for deletion. With prefix argument, unflag these files." (interactive "P") (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker))) (dired-mark-if ;; It is less than general to check for ~ here, ;; but it's the only way this runs fast enough. (and (save-excursion (end-of-line) (or (eq (preceding-char) ?~) ;; Handle executables in case of -F option. ;; We need not worry about the other kinds ;; of markings that -F makes, since they won't ;; appear on real backup files. (if (eq (preceding-char) ?*) (progn (forward-char -1) (eq (preceding-char) ?~))))) (not (looking-at dired-re-dir)) (let ((fn (dired-get-filename t t))) (if fn (backup-file-name-p fn)))) "backup file"))) (defun dired-change-marks (&optional old new) "Change all OLD marks to NEW marks. OLD and NEW are both characters used to mark files." (interactive (let* ((cursor-in-echo-area t) (old (progn (message "Change (old mark): ") (read-char))) (new (progn (message "Change %c marks to (new mark): " old) (read-char)))) (list old new))) (if (or (eq old ?\r) (eq new ?\r)) (ding) (let ((string (format "\n%c" old)) (buffer-read-only)) (save-excursion (goto-char (point-min)) (while (search-forward string nil t) (if (if (= old ?\ ) (save-match-data (dired-get-filename 'no-dir t)) t) (subst-char-in-region (match-beginning 0) (match-end 0) old new))))))) (defun dired-unmark-all-files-no-query () "Remove all marks from all files in the Dired buffer." (interactive) (dired-unmark-all-files ?\r)) (defun dired-unmark-all-files (mark &optional arg) "Remove a specific mark (or any mark) from every file. After this command, type the mark character to remove, or type RET to remove all marks. With prefix arg, query for each marked file. Type \\[help-command] at that time for help." (interactive "cRemove marks (RET means all): \nP") (save-excursion (let* ((count 0) buffer-read-only case-fold-search query (string (format "\n%c" mark)) (help-form "\ Type SPC or `y' to unmark one file, DEL or `n' to skip to next, `!' to unmark all remaining files with no more questions.")) (goto-char (point-min)) (while (if (eq mark ?\r) (re-search-forward dired-re-mark nil t) (search-forward string nil t)) (if (or (not arg) (dired-query 'query "Unmark file `%s'? " (dired-get-filename t))) (progn (subst-char-in-region (1- (point)) (point) (preceding-char) ?\ ) (setq count (1+ count))))) (message (if (= count 1) "1 mark removed" "%d marks removed") count)))) ;; Logging failures operating on files, and showing the results. (defvar dired-log-buffer "*Dired log*") (defun dired-why () "Pop up a buffer with error log output from Dired. A group of errors from a single command ends with a formfeed. Thus, use \\[backward-page] to find the beginning of a group of errors." (interactive) (if (get-buffer dired-log-buffer) (let ((owindow (selected-window)) (window (display-buffer (get-buffer dired-log-buffer)))) (unwind-protect (progn (select-window window) (goto-char (point-max)) (recenter -1)) (select-window owindow))))) (defun dired-log (log &rest args) ;; Log a message or the contents of a buffer. ;; If LOG is a string and there are more args, it is formatted with ;; those ARGS. Usually the LOG string ends with a \n. ;; End each bunch of errors with (dired-log t): this inserts ;; current time and buffer, and a \f (formfeed). (let ((obuf (current-buffer))) (unwind-protect ; want to move point (progn (set-buffer (get-buffer-create dired-log-buffer)) (goto-char (point-max)) (let (buffer-read-only) (cond ((stringp log) (insert (if args (apply (function format) log args) log))) ((bufferp log) (insert-buffer log)) ((eq t log) (insert "\n\t" (current-time-string) "\tBuffer `" (buffer-name obuf) "'\n\f\n"))))) (set-buffer obuf)))) (defun dired-log-summary (string failures) (message (if failures "%s--type ? for details (%s)" "%s--type ? for details") string failures) ;; Log a summary describing a bunch of errors. (dired-log (concat "\n" string)) (dired-log t)) ;;; Sorting ;; Most ls can only sort by name or by date (with -t), nothing else. ;; GNU ls sorts on size with -S, on extension with -X, and unsorted with -U. ;; So anything that does not contain these is sort "by name". (defvar dired-ls-sorting-switches "SXU" "String of `ls' switches (single letters) except `t' that influence sorting.") (defvar dired-sort-by-date-regexp (concat "^-[^" dired-ls-sorting-switches "]*t[^" dired-ls-sorting-switches "]*$") "Regexp recognized by dired to set `by date' mode.") (defvar dired-sort-by-name-regexp (concat "^-[^t" dired-ls-sorting-switches "]+$") "Regexp recognized by dired to set `by name' mode.") (defun dired-sort-set-modeline () ;; Set modeline display according to dired-actual-switches. ;; Modeline display of "by name" or "by date" guarantees the user a ;; match with the corresponding regexps. Non-matching switches are ;; shown literally. (setq mode-name (let (case-fold-search) (cond ((string-match dired-sort-by-name-regexp dired-actual-switches) "Dired by name") ((string-match dired-sort-by-date-regexp dired-actual-switches) "Dired by date") (t (concat "Dired " dired-actual-switches))))) (force-mode-line-update)) (defun dired-sort-toggle-or-edit (&optional arg) "Toggle between sort by date/name and refresh the dired buffer. With a prefix argument you can edit the current listing switches instead." (interactive "P") (if arg (dired-sort-other (read-string "ls switches (must contain -l): " dired-actual-switches)) (dired-sort-toggle))) (defun dired-sort-toggle () ;; Toggle between sort by date/name. Reverts the buffer. (setq dired-actual-switches (let (case-fold-search) (concat "-l" (dired-replace-in-string (concat "[-lt" dired-ls-sorting-switches "]") "" dired-actual-switches) (if (string-match (concat "[t" dired-ls-sorting-switches "]") dired-actual-switches) "" "t")))) (dired-sort-set-modeline) (revert-buffer)) (defun dired-replace-in-string (regexp newtext string) ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result. ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. (let ((result "") (start 0) mb me) (while (string-match regexp string start) (setq mb (match-beginning 0) me (match-end 0) result (concat result (substring string start mb) newtext) start me)) (concat result (substring string start)))) (defun dired-sort-other (switches &optional no-revert) ;; Specify new ls SWITCHES for current dired buffer. Values matching ;; `dired-sort-by-date-regexp' or `dired-sort-by-name-regexp' set the ;; minor mode accordingly, others appear literally in the mode line. ;; With optional second arg NO-REVERT, don't refresh the listing afterwards. (setq dired-actual-switches switches) (if (eq major-mode 'dired-mode) (dired-sort-set-modeline)) (or no-revert (revert-buffer))) ;; To make this file smaller, the less common commands ;; go in a separate file. But autoload them here ;; to make the separation invisible. (autoload 'dired-diff "dired-aux" "Compare file at point with file FILE using `diff'. FILE defaults to the file at the mark. The prompted-for file is the first file given to `diff'." t) (autoload 'dired-backup-diff "dired-aux" "Diff this file with its backup file or vice versa. Uses the latest backup, if there are several numerical backups. If this file is a backup, diff it with its original. The backup file is the first file given to `diff'." t) (autoload 'dired-clean-directory "dired-aux" "Flag numerical backups for deletion. Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest. Positive prefix arg KEEP overrides `dired-kept-versions'; Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive. To clear the flags on these files, you can use \\[dired-flag-backup-files] with a prefix argument." t) (autoload 'dired-do-chmod "dired-aux" "Change the mode of the marked (or next ARG) files. This calls chmod, thus symbolic modes like `g+w' are allowed." t) (autoload 'dired-do-chgrp "dired-aux" "Change the group of the marked (or next ARG) files." t) (autoload 'dired-do-chown "dired-aux" "Change the owner of the marked (or next ARG) files." t) (autoload 'dired-do-print "dired-aux" "Print the marked (or next ARG) files. Uses the shell command coming from variables `lpr-command' and `lpr-switches' as default." t) (autoload 'dired-do-shell-command "dired-aux" "Run a shell command COMMAND on the marked files. If no files are marked or a specific numeric prefix arg is given, the next ARG files are used. Just \\[universal-argument] means the current file. The prompt mentions the file(s) or the marker, as appropriate. If there is output, it goes to a separate buffer. Normally the command is run on each file individually. However, if there is a `*' in the command then it is run just once with the entire file list substituted there. No automatic redisplay of dired buffers is attempted, as there's no telling what files the command may have changed. Type \\[dired-do-redisplay] to redisplay the marked files. The shell command has the top level directory as working directory, so output files usually are created there instead of in a subdir." t) (autoload 'dired-do-kill-lines "dired-aux" "Kill all marked lines (not the files). With a prefix arg, kill all lines not marked or flagged." t) (autoload 'dired-do-compress "dired-aux" "Compress or uncompress marked (or next ARG) files." t) (autoload 'dired-do-byte-compile "dired-aux" "Byte compile marked (or next ARG) Emacs Lisp files." t) (autoload 'dired-do-load "dired-aux" "Load the marked (or next ARG) Emacs Lisp files." t) (autoload 'dired-do-redisplay "dired-aux" "Redisplay all marked (or next ARG) files. If on a subdir line, redisplay that subdirectory. In that case, a prefix arg lets you edit the `ls' switches used for the new listing." t) (autoload 'dired-string-replace-match "dired-aux" "Replace first match of REGEXP in STRING with NEWTEXT. If it does not match, nil is returned instead of the new string. Optional arg LITERAL means to take NEWTEXT literally. Optional arg GLOBAL means to replace all matches." t) (autoload 'dired-create-directory "dired-aux" "Create a directory called DIRECTORY." t) (autoload 'dired-do-copy "dired-aux" "Copy all marked (or next ARG) files, or copy the current file. Thus, a zero prefix argument copies nothing. But it toggles the variable `dired-copy-preserve-time' (which see)." t) (autoload 'dired-do-symlink "dired-aux" "Make symbolic links to current file or all marked (or next ARG) files. When operating on just the current file, you specify the new name. When operating on multiple or marked files, you specify a directory and new symbolic links are made in that directory with the same names that the files currently have." t) (autoload 'dired-do-hardlink "dired-aux" "Add names (hard links) current file or all marked (or next ARG) files. When operating on just the current file, you specify the new name. When operating on multiple or marked files, you specify a directory and new hard links are made in that directory with the same names that the files currently have." t) (autoload 'dired-do-rename "dired-aux" "Rename current file or all marked (or next ARG) files. When renaming just the current file, you specify the new name. When renaming multiple or marked files, you specify a directory." t) (autoload 'dired-do-rename-regexp "dired-aux" "Rename marked files containing REGEXP to NEWNAME. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. NEWNAME may contain \\=\\ or \\& as in `query-replace-regexp'. REGEXP defaults to the last regexp used. With a zero prefix arg, renaming by regexp affects the complete pathname - usually only the non-directory part of file names is used and changed." t) (autoload 'dired-do-copy-regexp "dired-aux" "Copy all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info." t) (autoload 'dired-do-hardlink-regexp "dired-aux" "Hardlink all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info." t) (autoload 'dired-do-symlink-regexp "dired-aux" "Symlink all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info." t) (autoload 'dired-upcase "dired-aux" "Rename all marked (or next ARG) files to upper case." t) (autoload 'dired-downcase "dired-aux" "Rename all marked (or next ARG) files to lower case." t) (autoload 'dired-maybe-insert-subdir "dired-aux" "Insert this subdirectory into the same dired buffer. If it is already present, just move to it (type \\[dired-do-redisplay] to refresh), else inserts it at its natural place (as `ls -lR' would have done). With a prefix arg, you may edit the ls switches used for this listing. You can add `R' to the switches to expand the whole tree starting at this subdirectory. This function takes some pains to conform to `ls -lR' output." t) (autoload 'dired-next-subdir "dired-aux" "Go to next subdirectory, regardless of level." t) (autoload 'dired-prev-subdir "dired-aux" "Go to previous subdirectory, regardless of level. When called interactively and not on a subdir line, go to this subdir's line." t) (autoload 'dired-goto-subdir "dired-aux" "Go to end of header line of DIR in this dired buffer. Return value of point on success, otherwise return nil. The next char is either \\n, or \\r if DIR is hidden." t) (autoload 'dired-mark-subdir-files "dired-aux" "Mark all files except `.' and `..'." t) (autoload 'dired-kill-subdir "dired-aux" "Remove all lines of current subdirectory. Lower levels are unaffected." t) (autoload 'dired-tree-up "dired-aux" "Go up ARG levels in the dired tree." t) (autoload 'dired-tree-down "dired-aux" "Go down in the dired tree." t) (autoload 'dired-hide-subdir "dired-aux" "Hide or unhide the current subdirectory and move to next directory. Optional prefix arg is a repeat factor. Use \\[dired-hide-all] to (un)hide all directories." t) (autoload 'dired-hide-all "dired-aux" "Hide all subdirectories, leaving only their header lines. If there is already something hidden, make everything visible again. Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." t) (if (eq system-type 'vax-vms) (load "dired-vms")) (provide 'dired) (run-hooks 'dired-load-hook) ; for your customizations ;;; dired.el ends here emacs-19.30/lisp/disass.el100444 12120 1 21301 6045222620 13672 0ustar rmsdaemon;;; disass.el --- disassembler for compiled Emacs Lisp code ;;; Copyright (C) 1986, 1991 Free Software Foundation, Inc. ;; Author: Doug Cutting ;; Jamie Zawinski ;; Maintainer: Jamie Zawinski ;; Keywords: internal ;; 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: ;; The single entry point, `disassemble', disassembles a code object generated ;; by the Emacs Lisp byte-compiler. This doesn't invert the compilation ;; operation, not by a long shot, but it's useful for debugging. ;; ;; Original version by Doug Cutting (doug@csli.stanford.edu) ;; Substantially modified by Jamie Zawinski for ;; the new lapcode-based byte compiler. ;;; Code: ;;; The variable byte-code-vector is defined by the new bytecomp.el. ;;; The function byte-decompile-lapcode is defined in byte-opt.el. ;;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt. (require 'byte-compile "bytecomp") (defvar disassemble-column-1-indent 8 "*") (defvar disassemble-column-2-indent 10 "*") (defvar disassemble-recursive-indent 3 "*") ;;;###autoload (defun disassemble (object &optional buffer indent interactive-p) "Print disassembled code for OBJECT in (optional) BUFFER. OBJECT can be a symbol defined as a function, or a function itself \(a lambda expression or a compiled-function object). If OBJECT is not already compiled, we compile it, but do not redefine OBJECT if it is a symbol." (interactive (list (intern (completing-read "Disassemble function: " obarray 'fboundp t)) nil 0 t)) (if (eq (car-safe object) 'byte-code) (setq object (list 'lambda () object))) (or indent (setq indent 0)) ;Default indent to zero (save-excursion (if (or interactive-p (null buffer)) (with-output-to-temp-buffer "*Disassemble*" (set-buffer "*Disassemble*") (disassemble-internal object indent (not interactive-p))) (set-buffer buffer) (disassemble-internal object indent nil))) nil) (defun disassemble-internal (obj indent interactive-p) (let ((macro 'nil) (name 'nil) (doc 'nil) args) (while (symbolp obj) (setq name obj obj (symbol-function obj))) (if (subrp obj) (error "Can't disassemble #" name)) (if (and (listp obj) (eq (car obj) 'autoload)) (progn (load (nth 1 obj)) (setq obj (symbol-function name)))) (if (eq (car-safe obj) 'macro) ;handle macros (setq macro t obj (cdr obj))) (if (and (listp obj) (eq (car obj) 'byte-code)) (setq obj (list 'lambda nil obj))) (if (and (listp obj) (not (eq (car obj) 'lambda))) (error "not a function")) (if (consp obj) (if (assq 'byte-code obj) nil (if interactive-p (message (if name "Compiling %s's definition..." "Compiling definition...") name)) (setq obj (byte-compile obj)) (if interactive-p (message "Done compiling. Disassembling...")))) (cond ((consp obj) (setq obj (cdr obj)) ;throw lambda away (setq args (car obj)) ;save arg list (setq obj (cdr obj))) (t (setq args (aref obj 0)))) (if (zerop indent) ; not a nested function (progn (indent-to indent) (insert (format "byte code%s%s%s:\n" (if (or macro name) " for" "") (if macro " macro" "") (if name (format " %s" name) ""))))) (let ((doc (if (consp obj) (and (stringp (car obj)) (car obj)) ;; Use documentation to get lazy-loaded doc string (documentation obj t)))) (if (and doc (stringp doc)) (progn (and (consp obj) (setq obj (cdr obj))) (indent-to indent) (princ " doc: " (current-buffer)) (if (string-match "\n" doc) (setq doc (concat (substring doc 0 (match-beginning 0)) " ..."))) (insert doc "\n")))) (indent-to indent) (insert " args: ") (prin1 args (current-buffer)) (insert "\n") (let ((interactive (cond ((consp obj) (assq 'interactive obj)) ((> (length obj) 5) (list 'interactive (aref obj 5)))))) (if interactive (progn (setq interactive (nth 1 interactive)) (if (eq (car-safe (car-safe obj)) 'interactive) (setq obj (cdr obj))) (indent-to indent) (insert " interactive: ") (if (eq (car-safe interactive) 'byte-code) (progn (insert "\n") (disassemble-1 interactive (+ indent disassemble-recursive-indent))) (let ((print-escape-newlines t)) (prin1 interactive (current-buffer)))) (insert "\n")))) (cond ((and (consp obj) (assq 'byte-code obj)) (disassemble-1 (assq 'byte-code obj) indent)) ((byte-code-function-p obj) (disassemble-1 obj indent)) (t (insert "Uncompiled body: ") (let ((print-escape-newlines t)) (prin1 (if (cdr obj) (cons 'progn obj) (car obj)) (current-buffer)))))) (if interactive-p (message ""))) (defun disassemble-1 (obj indent) "Prints the byte-code call OBJ in the current buffer. OBJ should be a call to BYTE-CODE generated by the byte compiler." (let (bytes constvec) (if (consp obj) (setq bytes (car (cdr obj)) ;the byte code constvec (car (cdr (cdr obj)))) ;constant vector ;; If it is lazy-loaded, load it now (fetch-bytecode obj) (setq bytes (aref obj 1) constvec (aref obj 2))) (let ((lap (byte-decompile-bytecode bytes constvec)) op arg opname pc-value) (let ((tagno 0) tmp (lap lap)) (while (setq tmp (assq 'TAG lap)) (setcar (cdr tmp) (setq tagno (1+ tagno))) (setq lap (cdr (memq tmp lap))))) (while lap ;; Take off the pc value of the next thing ;; and put it in pc-value. (setq pc-value nil) (if (numberp (car lap)) (setq pc-value (car lap) lap (cdr lap))) ;; Fetch the next op and its arg. (setq op (car (car lap)) arg (cdr (car lap))) (setq lap (cdr lap)) (indent-to indent) (if (eq 'TAG op) (progn ;; We have a label. Display it, but first its pc value. (if pc-value (insert (format "%d:" pc-value))) (insert (int-to-string (car arg)))) ;; We have an instruction. Display its pc value first. (if pc-value (insert (format "%d" pc-value))) (indent-to (+ indent disassemble-column-1-indent)) (if (and op (string-match "^byte-" (setq opname (symbol-name op)))) (setq opname (substring opname 5)) (setq opname "")) (if (eq op 'byte-constant2) (insert " #### shouldn't have seen constant2 here!\n ")) (insert opname) (indent-to (+ indent disassemble-column-1-indent disassemble-column-2-indent -1)) (insert " ") (cond ((memq op byte-goto-ops) (insert (int-to-string (nth 1 arg)))) ((memq op '(byte-call byte-unbind byte-listN byte-concatN byte-insertN)) (insert (int-to-string arg))) ((memq op '(byte-varref byte-varset byte-varbind)) (prin1 (car arg) (current-buffer))) ((memq op '(byte-constant byte-constant2)) ;; it's a constant (setq arg (car arg)) ;; but if the value of the constant is compiled code, then ;; recursively disassemble it. (cond ((or (byte-code-function-p arg) (and (eq (car-safe arg) 'lambda) (assq 'byte-code arg)) (and (eq (car-safe arg) 'macro) (or (byte-code-function-p (cdr arg)) (and (eq (car-safe (cdr arg)) 'lambda) (assq 'byte-code (cdr arg)))))) (cond ((byte-code-function-p arg) (insert "\n")) ((eq (car-safe arg) 'lambda) (insert "")) (t (insert "\n"))) (disassemble-internal arg (+ indent disassemble-recursive-indent 1) nil)) ((eq (car-safe arg) 'byte-code) (insert "\n") (disassemble-1 ;recurse on byte-code object arg (+ indent disassemble-recursive-indent))) ((eq (car-safe (car-safe arg)) 'byte-code) (insert "(...)\n") (mapcar ;recurse on list of byte-code objects '(lambda (obj) (disassemble-1 obj (+ indent disassemble-recursive-indent))) arg)) (t ;; really just a constant (let ((print-escape-newlines t)) (prin1 arg (current-buffer)))))) ) (insert "\n"))))) nil) ;;; disass.el ends here emacs-19.30/lisp/disp-table.el100444 12120 1 15307 6036627160 14451 0ustar rmsdaemon;;; disp-table.el --- functions for dealing with char tables. ;; Copyright (C) 1987, 1994, 1995 Free Software Foundation, Inc. ;; Author: Erik Naggum ;; Based on a previous version by Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (put 'display-table 'char-table-extra-slots 6) ;;;###autoload (defun make-display-table () "Return a new, empty display table." (make-char-table 'display-table nil)) (or standard-display-table (setq standard-display-table (make-display-table))) ;;; Display-table slot names. The property value says which slot. (put 'truncation 'display-table-slot 0) (put 'wrap 'display-table-slot 1) (put 'escape 'display-table-slot 2) (put 'control 'display-table-slot 3) (put 'selective-display 'display-table-slot 4) (put 'vertical-border 'display-table-slot 5) ;;;###autoload (defun display-table-slot (display-table slot) "Return the value of the extra slot in DISPLAY-TABLE named SLOT. SLOT may be a number from 0 to 5 inclusive, or a slot name (symbol)." (let ((slot-number (if (numberp slot) slot (or (get slot 'display-table-slot) (error "Invalid display-table slot name: %s" slot))))) (char-table-extra-slot display-table slot-number))) ;;;###autoload (defun set-display-table-slot (display-table slot value) "Set the value of the extra slot in DISPLAY-TABLE named SLOT to VALUE. SLOT may be a number from 0 to 5 inclusive, or a name (symbol). See `display-table-slot-name-alist' for the names and numbers." (let ((slot-number (if (numberp slot) slot (or (get slot 'display-table-slot) (error "Invalid display-table slot name: %s" slot))))) (set-char-table-extra-slot display-table slot-number value))) ;;;###autoload (defun describe-display-table (dt) "Describe the display table DT in a help buffer." (with-output-to-temp-buffer "*Help*" (princ "\nTruncation glyph: ") (prin1 (display-table-slot dt 'truncation)) (princ "\nWrap glyph: ") (prin1 (display-table-slot dt 'wrap)) (princ "\nEscape glyph: ") (prin1 (display-table-slot dt 'escape)) (princ "\nCtrl glyph: ") (prin1 (display-table-slot dt 'control)) (princ "\nSelective display glyph sequence: ") (prin1 (display-table-slot dt 'selective-display)) (princ "\nVertical window border glyph: ") (prin1 (display-table-slot dt 'vertical-border)) (princ "\nCharacter display glyph sequences:\n") (save-excursion (set-buffer standard-output) (let ((vector (make-vector 256 nil)) (i 0)) (while (< i 256) (aset vector i (aref dt i)) (setq i (1+ i))) (describe-vector vector)) (help-mode)) (print-help-return-message))) ;;;###autoload (defun describe-current-display-table () "Describe the display table in use in the selected window and buffer." (interactive) (let ((disptab (or (window-display-table (selected-window)) buffer-display-table standard-display-table))) (if disptab (describe-display-table disptab) (message "No display table")))) ;;;###autoload (defun standard-display-8bit (l h) "Display characters in the range L to H literally." (while (<= l h) (if (and (>= l ?\ ) (< l 127)) (aset standard-display-table l nil) (aset standard-display-table l (vector l))) (setq l (1+ l)))) ;;;###autoload (defun standard-display-default (l h) "Display characters in the range L to H using the default notation." (while (<= l h) (if (and (>= l ?\ ) (< l 127)) (aset standard-display-table l nil) (aset standard-display-table l nil)) (setq l (1+ l)))) ;; This function does NOT take terminal-dependent escape sequences. ;; For that, you need to go through create-glyph. Use one of the ;; other functions below, or roll your own. ;;;###autoload (defun standard-display-ascii (c s) "Display character C using printable string S." (aset standard-display-table c (vconcat s))) ;;;###autoload (defun standard-display-g1 (c sc) "Display character C as character SC in the g1 character set. This function assumes that your terminal uses the SO/SI characters; it is meaningless for an X frame." (if window-system (error "Cannot use string glyphs in a windowing system")) (aset standard-display-table c (vector (create-glyph (concat "\016" (char-to-string sc) "\017"))))) ;;;###autoload (defun standard-display-graphic (c gc) "Display character C as character GC in graphics character set. This function assumes VT100-compatible escapes; it is meaningless for an X frame." (if window-system (error "Cannot use string glyphs in a windowing system")) (aset standard-display-table c (vector (create-glyph (concat "\e(0" (char-to-string gc) "\e(B"))))) ;;;###autoload (defun standard-display-underline (c uc) "Display character C as character UC plus underlining." (if window-system (require 'faces)) (aset standard-display-table c (vector (if window-system (logior uc (lsh (face-id (internal-find-face 'underline)) 8)) (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m")))))) ;; Allocate a glyph code to display by sending STRING to the terminal. ;;;###autoload (defun create-glyph (string) (if (= (length glyph-table) 65536) (error "No free glyph codes remain")) ;; Don't use slots that correspond to ASCII characters. (if (= (length glyph-table) 32) (setq glyph-table (vconcat glyph-table (make-vector 224 nil)))) (setq glyph-table (vconcat glyph-table (list string))) (1- (length glyph-table))) ;;;###autoload (defun standard-display-european (arg) "Toggle display of European characters encoded with ISO 8859. When enabled, characters in the range of 160 to 255 display not as octal escapes, but as accented characters. With prefix argument, enable European character display iff arg is positive." (interactive "P") (if (or (<= (prefix-numeric-value arg) 0) (and (null arg) (char-table-p standard-display-table) (equal (aref standard-display-table 160) [160]))) (standard-display-default 160 255) (standard-display-8bit 160 255))) (provide 'disp-table) ;;; disp-table.el ends here emacs-19.30/lisp/dissociate.el100444 12120 1 6272 5615230374 14534 0ustar rmsdaemon;;; dissociate.el --- scramble text amusingly for Emacs. ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: games ;; 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: ;; The single entry point, `dissociated-press', applies a travesty ;; generator to the current buffer. The results can be quite amusing. ;;; Code: ;;;###autoload (defun dissociated-press (&optional arg) "Dissociate the text of the current buffer. Output goes in buffer named *Dissociation*, which is redisplayed each time text is added to it. Every so often the user must say whether to continue. If ARG is positive, require ARG chars of continuity. If ARG is negative, require -ARG words of continuity. Default is 2." (interactive "P") (setq arg (if arg (prefix-numeric-value arg) 2)) (let* ((inbuf (current-buffer)) (outbuf (get-buffer-create "*Dissociation*")) (move-function (if (> arg 0) 'forward-char 'forward-word)) (move-amount (if (> arg 0) arg (- arg))) (search-function (if (> arg 0) 'search-forward 'word-search-forward)) (last-query-point 0)) (if (= (point-max) (point-min)) (error "The buffer contains no text to start from")) (switch-to-buffer outbuf) (erase-buffer) (while (save-excursion (goto-char last-query-point) (vertical-motion (- (window-height) 4)) (or (= (point) (point-max)) (and (progn (goto-char (point-max)) (y-or-n-p "Continue dissociation? ")) (progn (message "") (recenter 1) (setq last-query-point (point-max)) t)))) (let (start end) (save-excursion (set-buffer inbuf) (setq start (point)) (if (eq move-function 'forward-char) (progn (setq end (+ start (+ move-amount (random 16)))) (if (> end (point-max)) (setq end (+ 1 move-amount (random 16)))) (goto-char end)) (funcall move-function (+ move-amount (random 16)))) (setq end (point))) (let ((opoint (point))) (insert-buffer-substring inbuf start end) (save-excursion (goto-char opoint) (end-of-line) (and (> (current-column) fill-column) (do-auto-fill))))) (save-excursion (set-buffer inbuf) (if (eobp) (goto-char (point-min)) (let ((overlap (buffer-substring (prog1 (point) (funcall move-function (- move-amount))) (point)))) (goto-char (1+ (random (1- (point-max))))) (or (funcall search-function overlap nil t) (let ((opoint (point))) (goto-char 1) (funcall search-function overlap opoint t)))))) (sit-for 0)))) ;;; dissociate.el ends here emacs-19.30/lisp/docref.el100444 12120 1 23561 6045201615 13661 0ustar rmsdaemon;;; docref.el --- Simple cross references for Elisp documentation strings ;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Author: Vadim Geshel ;; Created: 12 Jul 1994 ;; Keywords: docs, help, lisp ;; original name was cross-ref.el. ;; 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 package allows you to use a simple form of cross references in ;; your Emacs Lisp documentation strings. Cross-references look like ;; \\(type@[label@]data), where type defines a method for retrieving ;; reference informatin, data is used by a method routine as an argument, ;; and label "represents" the reference in text. If label is absent, data ;; is used instead. ;; ;; Special reference labeled `back', when present, can be used to return ;; to the previous contents of help buffer. ;; ;; Cross-referencing currently is intended for use in doc strings only ;; and works only in temporary buffers (created by `with-output-to-temp-buffer'). ;; List of temp buffers in which cross-referencing is to be active is specified ;; by variable DOCREF-BUFFERS-LIST, which contains only "*Help*" by default. ;; ;; Documentation strings for this package's functions and variables can serve ;; as examples of usage. ;; ;;; Customization: ;; ;; See source. The main customization variable is `docref-methods-alist'. ;; It consists of (type . function) pairs, where type is a string which ;; corresponds to type in cross-references and function is called with ;; one argument - reference `data' - when a reference is activated. ;; ;;; Installation: ;; ;; Place this file somewhere in your load-path, byte-compiled it, and add ;; (require 'cross-ref) ;; to your .emacs. ;;; Code: ;; User customizable variables (defvar docref-highlight-p t "*If non-nil, \\(f@docref-subst) highlights cross-references. Under window system it highlights them with face defined by \\(v@docref-highlight-face), on character terminal highlighted references look like cross-references in info mode.") (defvar docref-highlight-face 'highlight "*Face used to highlight cross-references (used by \\(f@docref-subst))") (defvar docref-methods-alist '(("f" . docref-describe-function) ; reference to a function documentation ("v" . docref-describe-variable) ; reference to a variable documentation ("F" . docref-read-file) ; reference to a file contents ("s" . docref-use-string) ; reference to a string ("V" . docref-use-variable-value) ; reference to variable value ("0" . beep)) ; just highlighted text "Alist which maps cross-reference ``types'' to retrieval functions. The car of each element is a string that serves as `type' in cross-references. \(See \\(f@docref-subst)). The cdr is a function of one argument, to be called to find this reference.") (defvar docref-back-label "\nback" "Label to use by \\(f@docref-subst) for the go-back reference.") (defvar docref-back-reference nil "If non-nil, this is a go-back reference to add to the current buffer. The value specifies how to go back. It should be suitable for use as the second argument to \\(f@docref-insert-label). \\(f@docref-subst) uses this to set up the go-back reference.") (defvar docref-last-active-buffer) ;;;###autoload (defun docref-setup () "Process docref cross-references in the current buffer. See also \\(f@docref-subst)." (interactive) (docref-subst (current-buffer)) (docref-mode)) (defvar docref-mode-map nil) (or docref-mode-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'docref-follow-mouse) (define-key map "\C-c\C-b" 'docref-go-back) (define-key map "\C-c\C-c" 'docref-follow) (setq docref-mode-map map))) (defun docref-mode () "Major mode for help buffers that contain cross references. To follow a reference, move to it and type \\[docref-follow], or use \\[docref-follow-mouse]. The command \\[docref-go-back] can used to go back to where you came from." (interactive) (kill-all-local-variables) (setq major-mode 'docref-mode) (setq mode-name "Docref") (use-local-map docref-mode-map) (run-hooks 'docref-mode)) (defun docref-subst (buf) "Parse documentation cross-references in buffer BUF. Find cross-reference information in a buffer and highlight them with face defined by \\(v@docref-highlight-face). Cross-reference has the following format: \\ (TYPE[@LABEL]@DATA), where TYPE defines method used to retrive xref data (like reading from file or calling \\(f@describe-function)), DATA is an argument to this method \(like file name or function name), and LABEL is displayed in text using \\(v@docref-highlight-face). The special reference `back' can be used to return back. The variable \\(v@docref-back-label) specifies the label to use for that. See \\(v@docref-methods-alist) for currently defined methods." (interactive "b") (save-excursion (set-buffer buf) (goto-char (point-min)) ;; The docref-seen property indicates that we have processed this ;; buffer's contents already, so don't do it again. (if (not (get-text-property (point-min) 'docref-seen)) (let ((old-modified (buffer-modified-p))) (while (re-search-forward "[\\](\\([^\)\@]+\\)\\(@[^\)\@]+\\)?@\\([^\)]*\\))" nil t) (let* ((start (match-beginning 0)) (type (buffer-substring (match-beginning 1) (match-end 1))) (data (buffer-substring (match-beginning 3) (match-end 3))) (label (if (match-beginning 2) (buffer-substring (+ (match-beginning 2) 1) (match-end 2)) data))) (replace-match "" t) (docref-insert-label label (cons type data)))) ;; Make a back-reference in this buffer, if desired. ;; (This is true if called from docref-follow.) (if docref-back-reference (progn (goto-char (point-max)) (put-text-property (point-min) (1+ (point-min)) 'docref-back-position (point)) (docref-insert-label docref-back-label docref-back-reference))) (put-text-property (point-min) (1+ (point-min)) 'docref-seen t) (set-buffer-modified-p old-modified))))) (defun docref-insert-label (string ref) (let ((label (concat string)) (pos (point))) ;; decorate the label (let ((leading-space-end (save-match-data (if (string-match "^\\([ \t\n]+\\)" label) (match-end 1) 0))) (trailing-space-start (save-match-data (if (string-match "\\([ \t\n]+\\)$" label) (match-beginning 1) (length label))))) (if docref-highlight-p (if (not window-system) (setq label (concat (substring label 0 leading-space-end) "(*note " (substring label leading-space-end trailing-space-start) ")" (substring label trailing-space-start))) ;; window-system (put-text-property leading-space-end trailing-space-start 'face docref-highlight-face label))) (put-text-property 0 (length label) 'docref ref label) (insert label)))) (defun docref-follow-mouse (click) "Follow the cross-reference that you click on." (interactive "e") (save-excursion (let* ((start (event-start click)) (window (car start)) (pos (car (cdr start))) (docref-last-active-buffer (current-buffer))) (set-buffer (window-buffer window)) (docref-follow pos)))) (defun docref-go-back () "Go back to the previous contents of help buffer." (interactive) (let ((pos (get-text-property (point-min) 'docref-back-position))) (if pos (docref-follow pos) (error "No go-back reference")))) (defun docref-follow (&optional pos) "Follow cross-reference at point. For the cross-reference format, see \\(f@docref-subst). The special reference named `back' can be used to return back" (interactive) (or pos (setq pos (point))) (let ((docref-data (get-text-property pos 'docref))) (if docref-data ;; There is a reference at point. Follow it. (let* ((type (car docref-data)) (name (cdr docref-data)) (method (assoc type docref-methods-alist)) (cur-contents (buffer-string)) (opoint (point)) (docref-back-reference (cons "s" cur-contents)) success) (if (null method) (error "Unknown cross-reference type: %s" type)) (unwind-protect (save-excursion (funcall (cdr method) name) (setq success t)) (or success (progn ;; (cdr method) got an error. ;; Put back the text that we had. (erase-buffer) (insert cur-contents) (goto-char opoint))) (set-buffer-modified-p nil)))))) ;; Builtin methods for accessing a reference. (defun docref-describe-function (data) (save-excursion (if (boundp 'docref-last-active-buffer) (set-buffer docref-last-active-buffer)) (describe-function (intern data)))) (defun docref-describe-variable (data) (save-excursion (if (boundp 'docref-last-active-buffer) (set-buffer docref-last-active-buffer)) (describe-variable (intern data)))) (defun docref-read-file (data) (with-output-to-temp-buffer (buffer-name) (erase-buffer) (insert-file-contents (expand-file-name data)))) (defun docref-use-string (data) (with-output-to-temp-buffer (buffer-name) (erase-buffer) (insert data))) (defun docref-use-variable-value (data) (let ((sym (intern data))) (with-output-to-temp-buffer (buffer-name) (erase-buffer) (princ (symbol-value sym))))) (provide 'docref) ;;; docref.el ends here emacs-19.30/lisp/doctor.el100444 75424 13 144045 5561560356 13706 0ustar kwzhuser;;; doctor.el --- psychological help for frustrated users. ;; Copyright (C) 1985, 1987, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: games ;; 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: ;; The single entry point `doctor', simulates a Rogerian analyst using ;; phrase-production techniques similar to the classic ELIZA demonstration ;; of pseudo-AI. ;;; Code: (defun doctor-cadr (x) (car (cdr x))) (defun doctor-caddr (x) (car (cdr (cdr x)))) (defun doctor-cddr (x) (cdr (cdr x))) (defun // (x) x) (defmacro $ (what) "quoted arg form of doctor-$" (list 'doctor-$ (list 'quote what))) (defun doctor-$ (what) "Return the car of a list, rotating the list each time" (let* ((vv (symbol-value what)) (first (car vv)) (ww (append (cdr vv) (list first)))) (set what ww) first)) (defvar doctor-mode-map nil) (if doctor-mode-map nil (setq doctor-mode-map (make-sparse-keymap)) (define-key doctor-mode-map "\n" 'doctor-read-print) (define-key doctor-mode-map "\r" 'doctor-ret-or-read)) (defun doctor-mode () "Major mode for running the Doctor (Eliza) program. Like Text mode with Auto Fill mode except that RET when point is after a newline, or LFD at any time, reads the sentence before point, and prints the Doctor's answer." (interactive) (text-mode) (make-doctor-variables) (use-local-map doctor-mode-map) (setq major-mode 'doctor-mode) (setq mode-name "Doctor") (turn-on-auto-fill) (doctor-type '(i am the psychotherapist \. ($ please) ($ describe) your ($ problems) \. each time you are finished talking, type \R\E\T twice \.)) (insert "\n")) (defun make-doctor-variables () (make-local-variable 'monosyllables) (setq monosyllables " Your attitude at the end of the session was wholly unacceptable. Please try to come back next time with a willingness to speak more freely. If you continue to refuse to talk openly, there is little I can do to help! ") (make-local-variable 'typos) (setq typos (mapcar (function (lambda (x) (put (car x) 'doctor-correction (doctor-cadr x)) (put (doctor-cadr x) 'doctor-expansion (doctor-caddr x)) (car x))) '((theyll they\'ll (they will)) (theyre they\'re (they are)) (hes he\'s (he is)) (he7s he\'s (he is)) (im i\'m (you are)) (i7m i\'m (you are)) (isa is\ a (is a)) (thier their (their)) (dont don\'t (do not)) (don7t don\'t (do not)) (you7re you\'re (i am)) (you7ve you\'ve (i have)) (you7ll you\'ll (i will))))) (make-local-variable 'found) (setq found nil) (make-local-variable 'owner) (setq owner nil) (make-local-variable 'history) (setq history nil) (make-local-variable '*debug*) (setq *debug* nil) (make-local-variable 'inter) (setq inter '((well\,) (hmmm \.\.\.\ so\,) (so) (\.\.\.and) (then))) (make-local-variable 'continue) (setq continue '((continue) (proceed) (go on) (keep going) )) (make-local-variable 'relation) (setq relation '((your relationship with) (something you remember about) (your feelings toward) (some experiences you have had with) (how you feel about))) (make-local-variable 'fears) (setq fears '( (($ whysay) you are ($ afraidof) (// feared) \?) (you seem terrified by (// feared) \.) (when did you first feel ($ afraidof) (// feared) \?) )) (make-local-variable 'sure) (setq sure '((sure)(positive)(certain)(absolutely sure))) (make-local-variable 'afraidof) (setq afraidof '( (afraid of) (frightened by) (scared of) )) (make-local-variable 'areyou) (setq areyou '( (are you)(have you been)(have you been) )) (make-local-variable 'isrelated) (setq isrelated '( (has something to do with)(is related to) (could be the reason for) (is caused by)(is because of))) (make-local-variable 'arerelated) (setq arerelated '((have something to do with)(are related to) (could have caused)(could be the reason for) (are caused by) (are because of))) (make-local-variable 'moods) (setq moods '( (($ areyou)(// found) often \?) (what causes you to be (// found) \?) (($ whysay) you are (// found) \?) )) (make-local-variable 'maybe) (setq maybe '((maybe) (perhaps) (possibly))) (make-local-variable 'whatwhen) (setq whatwhen '((what happened when) (what would happen if))) (make-local-variable 'hello) (setq hello '((how do you do \?) (hello \.) (howdy!) (hello \.) (hi \.) (hi there \.))) (make-local-variable 'drnk) (setq drnk '((do you drink a lot of (// found) \?) (do you get drunk often \?) (($ describe) your drinking habits \.) )) (make-local-variable 'drugs) (setq drugs '( (do you use (// found) often \?)(($ areyou) addicted to (// found) \?)(do you realize that drugs can be very harmful \?)(($ maybe) you should try to quit using (// found) \.))) (make-local-variable 'whywant) (setq whywant '( (($ whysay) (// subj) might ($ want) (// obj) \?) (how does it feel to want \?) (why should (// subj) get (// obj) \?) (when did (// subj) first ($ want) (// obj) \?) (($ areyou) obsessed with (// obj) \?) (why should i give (// obj) to (// subj) \?) (have you ever gotten (// obj) \?) )) (make-local-variable 'canyou) (setq canyou '((of course i can \.) (why should i \?) (what makes you think i would even want to \?) (i am the doctor\, i can do anything i damn please \.) (not really\, it\'s not up to me \.) (depends\, how important is it \?) (i could\, but i don\'t think it would be a wise thing to do \.) (can you \?) (maybe i can\, maybe i can\'t \.\.\.) (i don\'t think i should do that \.))) (make-local-variable 'want) (setq want '( (want) (desire) (wish) (want) (hope) )) (make-local-variable 'shortlst) (setq shortlst '((can you elaborate on that \?) (($ please) continue \.) (go on\, don\'t be afraid \.) (i need a little more detail please \.) (you\'re being a bit brief\, ($ please) go into detail \.) (can you be more explicit \?) (and \?) (($ please) go into more detail \?) (you aren\'t being very talkative today\!) (is that all there is to it \?) (why must you respond so briefly \?))) (make-local-variable 'famlst) (setq famlst '((tell me ($ something) about (// owner) family \.) (you seem to dwell on (// owner) family \.) (($ areyou) hung up on (// owner) family \?))) (make-local-variable 'huhlst) (setq huhlst '((($ whysay)(// sent) \?) (is it because of ($ things) that you say (// sent) \?) )) (make-local-variable 'longhuhlst) (setq longhuhlst '((($ whysay) that \?) (i don\'t understand \.) (($ thlst)) (($ areyou) ($ afraidof) that \?))) (make-local-variable 'feelings-about) (setq feelings-about '((feelings about) (aprehensions toward) (thoughts on) (emotions toward))) (make-local-variable 'random-adjective) (setq random-adjective '((vivid) (emotionally stimulating) (exciting) (boring) (interesting) (recent) (random) ;How can we omit this? (unusual) (shocking) (embarrassing))) (make-local-variable 'whysay) (setq whysay '((why do you say) (what makes you believe) (are you sure that) (do you really think) (what makes you think) )) (make-local-variable 'isee) (setq isee '((i see \.\.\.) (yes\,) (i understand \.) (oh \.) )) (make-local-variable 'please) (setq please '((please\,) (i would appreciate it if you would) (perhaps you could) (please\,) (would you please) (why don\'t you) (could you))) (make-local-variable 'bye) (setq bye '((my secretary will send you a bill \.) (bye bye \.) (see ya \.) (ok\, talk to you some other time \.) (talk to you later \.) (ok\, have fun \.) (ciao \.))) (make-local-variable 'something) (setq something '((something) (more) (how you feel))) (make-local-variable 'things) (setq things '(;(your interests in computers) ;; let's make this less computer oriented ;(the machines you use) (your plans) ;(your use of computers) (your life) ;(other machines you use) (the people you hang around with) ;(computers you like) (problems at school) (any hobbies you have) ;(other computers you use) (your sex life) (hangups you have) (your inhibitions) (some problems in your childhood) ;(knowledge of computers) (some problems at home))) (make-local-variable 'describe) (setq describe '((describe) (tell me about) (talk about) (discuss) (tell me more about) (elaborate on))) (make-local-variable 'ibelieve) (setq ibelieve '((i believe) (i think) (i have a feeling) (it seems to me that) (it looks like))) (make-local-variable 'problems) (setq problems '( (problems) (inhibitions) (hangups) (difficulties) (anxieties) (frustrations) )) (make-local-variable 'bother) (setq bother '((does it bother you that) (are you annoyed that) (did you ever regret) (are you sorry) (are you satisfied with the fact that))) (make-local-variable 'machlst) (setq machlst '((you have your mind on (// found) \, it seems \.) (you think too much about (// found) \.) (you should try taking your mind off of (// found)\.) (are you a computer hacker \?))) (make-local-variable 'qlist) (setq qlist '((what do you think \?) (i\'ll ask the questions\, if you don\'t mind!) (i could ask the same thing myself \.) (($ please) allow me to do the questioning \.) (i have asked myself that question many times \.) (($ please) try to answer that question yourself \.))) (make-local-variable 'elist) (setq elist '((($ please) try to calm yourself \.) (you seem very excited \. relax \. ($ please) ($ describe) ($ things) \.) (you\'re being very emotional \. calm down \.))) (make-local-variable 'foullst) (setq foullst '((($ please) watch your tongue!) (($ please) avoid such unwholesome thoughts \.) (($ please) get your mind out of the gutter \.) (such lewdness is not appreciated \.))) (make-local-variable 'deathlst) (setq deathlst '((this is not a healthy way of thinking \.) (($ bother) you\, too\, may die someday \?) (i am worried by your obsession with this topic!) (did you watch a lot of crime and violence on television as a child \?)) ) (make-local-variable 'sexlst) (setq sexlst '((($ areyou) ($ afraidof) sex \?) (($ describe)($ something) about your sexual history \.) (($ please)($ describe) your sex life \.\.\.) (($ describe) your ($ feelings-about) your sexual partner \.) (($ describe) your most ($ random-adjective) sexual experience \.) (($ areyou) satisfied with (// lover) \.\.\. \?))) (make-local-variable 'neglst) (setq neglst '((why not \?) (($ bother) i ask that \?) (why not \?) (why not \?) (how come \?) (($ bother) i ask that \?))) (make-local-variable 'beclst) (setq beclst '( (is it because (// sent) that you came to me \?) (($ bother)(// sent) \?) (when did you first know that (// sent) \?) (is the fact that (// sent) the real reason \?) (does the fact that (// sent) explain anything else \?) (($ areyou)($ sure)(// sent) \? ) )) (make-local-variable 'shortbeclst) (setq shortbeclst '( (($ bother) i ask you that \?) (that\'s not much of an answer!) (($ inter) why won\'t you talk about it \?) (speak up!) (($ areyou) ($ afraidof) talking about it \?) (don\'t be ($ afraidof) elaborating \.) (($ please) go into more detail \.))) (make-local-variable 'thlst) (setq thlst '( (($ maybe)($ things)($ arerelated) this \.) (is it because of ($ things) that you are going through all this \?) (how do you reconcile ($ things) \? ) (($ maybe) this ($ isrelated)($ things) \?) )) (make-local-variable 'remlst) (setq remlst '( (earlier you said ($ history) \?) (you mentioned that ($ history) \?) (($ whysay)($ history) \? ) )) (make-local-variable 'toklst) (setq toklst '((is this how you relax \?) (how long have you been smoking grass \?) (($ areyou) ($ afraidof) of being drawn to using harder stuff \?))) (make-local-variable 'states) (setq states '((do you get (// found) often \?) (do you enjoy being (// found) \?) (what makes you (// found) \?) (how often ($ areyou)(// found) \?) (when were you last (// found) \?))) (make-local-variable 'replist) (setq replist '((i . (you)) (my . (your)) (me . (you)) (you . (me)) (your . (my)) (mine . (yours)) (yours . (mine)) (our . (your)) (ours . (yours)) (we . (you)) (dunno . (do not know)) ;; (yes . ()) (no\, . ()) (yes\, . ()) (ya . (i)) (aint . (am not)) (wanna . (want to)) (gimme . (give me)) (gotta . (have to)) (gonna . (going to)) (never . (not ever)) (doesn\'t . (does not)) (don\'t . (do not)) (aren\'t . (are not)) (isn\'t . (is not)) (won\'t . (will not)) (can\'t . (cannot)) (haven\'t . (have not)) (i\'m . (you are)) (ourselves . (yourselves)) (myself . (yourself)) (yourself . (myself)) (you\'re . (i am)) (you\'ve . (i have)) (i\'ve . (you have)) (i\'ll . (you will)) (you\'ll . (i shall)) (i\'d . (you would)) (you\'d . (i would)) (here . (there)) (please . ()) (eh\, . ()) (eh . ()) (oh\, . ()) (oh . ()) (shouldn\'t . (should not)) (wouldn\'t . (would not)) (won\'t . (will not)) (hasn\'t . (has not)))) (make-local-variable 'stallmanlst) (setq stallmanlst '( (($ describe) your ($ feelings-about) him \.) (($ areyou) a friend of Stallman \?) (($ bother) Stallman is ($ random-adjective) \?) (($ ibelieve) you are ($ afraidof) him \.))) (make-local-variable 'schoollst) (setq schoollst '( (($ describe) your (// found) \.) (($ bother) your grades could ($ improve) \?) (($ areyou) ($ afraidof) (// found) \?) (($ maybe) this ($ isrelated) to your attitude \.) (($ areyou) absent often \?) (($ maybe) you should study ($ something) \.))) (make-local-variable 'improve) (setq improve '((improve) (be better) (be improved) (be higher))) (make-local-variable 'elizalst) (setq elizalst '( (($ areyou) ($ sure) \?) (($ ibelieve) you have ($ problems) with (// found) \.) (($ whysay) (// sent) \?))) (make-local-variable 'sportslst) (setq sportslst '( (tell me ($ something) about (// found) \.) (($ describe) ($ relation) (// found) \.) (do you find (// found) ($ random-adjective) \?))) (make-local-variable 'mathlst) (setq mathlst '( (($ describe) ($ something) about math \.) (($ maybe) your ($ problems) ($ arerelated) (// found) \.) (i do\'nt know much (// found) \, but ($ continue) anyway \.))) (make-local-variable 'zippylst) (setq zippylst '( (($ areyou) Zippy \?) (($ ibelieve) you have some serious ($ problems) \.) (($ bother) you are a pinhead \?))) (make-local-variable 'chatlst) (setq chatlst '( (($ maybe) we could chat \.) (($ please) ($ describe) ($ something) about chat mode \.) (($ bother) our discussion is so ($ random-adjective) \?))) (make-local-variable 'abuselst) (setq abuselst '( (($ please) try to be less abusive \.) (($ describe) why you call me (// found) \.) (i\'ve had enough of you!))) (make-local-variable 'abusewords) (setq abusewords '(boring bozo clown clumsy cretin dumb dummy fool foolish gnerd gnurd idiot jerk lose loser louse lousy luse luser moron nerd nurd oaf oafish reek stink stupid tool toolish twit)) (make-local-variable 'howareyoulst) (setq howareyoulst '((how are you) (hows it going) (hows it going eh) (how\'s it going) (how\'s it going eh) (how goes it) (whats up) (whats new) (what\'s up) (what\'s new) (howre you) (how\'re you) (how\'s everything) (how is everything) (how do you do) (how\'s it hanging) (que pasa) (how are you doing) (what do you say))) (make-local-variable 'whereoutp) (setq whereoutp '( huh remem rthing ) ) (make-local-variable 'subj) (setq subj nil) (make-local-variable 'verb) (setq verb nil) (make-local-variable 'obj) (setq obj nil) (make-local-variable 'feared) (setq feared nil) (make-local-variable 'observation-list) (setq observation-list nil) (make-local-variable 'repetitive-shortness) (setq repetitive-shortness '(0 . 0)) (make-local-variable '**mad**) (setq **mad** nil) (make-local-variable 'rms-flag) (setq rms-flag nil) (make-local-variable 'eliza-flag) (setq eliza-flag nil) (make-local-variable 'zippy-flag) (setq zippy-flag nil) (make-local-variable 'lover) (setq lover '(your partner)) (make-local-variable 'bak) (setq bak nil) (make-local-variable 'lincount) (setq lincount 0) (make-local-variable '*print-upcase*) (setq *print-upcase* nil) (make-local-variable '*print-space*) (setq *print-space* nil) (make-local-variable 'howdyflag) (setq howdyflag nil) (make-local-variable 'object) (setq object nil)) ;; Define equivalence classes of words that get treated alike. (defun doctor-meaning (x) (get x 'doctor-meaning)) (defmacro doctor-put-meaning (symb val) "Store the base meaning of a word on the property list." (list 'put (list 'quote symb) ''doctor-meaning val)) (doctor-put-meaning howdy 'howdy) (doctor-put-meaning hi 'howdy) (doctor-put-meaning greetings 'howdy) (doctor-put-meaning hello 'howdy) (doctor-put-meaning tops20 'mach) (doctor-put-meaning tops-20 'mach) (doctor-put-meaning tops 'mach) (doctor-put-meaning pdp11 'mach) (doctor-put-meaning computer 'mach) (doctor-put-meaning unix 'mach) (doctor-put-meaning machine 'mach) (doctor-put-meaning computers 'mach) (doctor-put-meaning machines 'mach) (doctor-put-meaning pdp11s 'mach) (doctor-put-meaning foo 'mach) (doctor-put-meaning foobar 'mach) (doctor-put-meaning multics 'mach) (doctor-put-meaning macsyma 'mach) (doctor-put-meaning teletype 'mach) (doctor-put-meaning la36 'mach) (doctor-put-meaning vt52 'mach) (doctor-put-meaning zork 'mach) (doctor-put-meaning trek 'mach) (doctor-put-meaning startrek 'mach) (doctor-put-meaning advent 'mach) (doctor-put-meaning pdp 'mach) (doctor-put-meaning dec 'mach) (doctor-put-meaning commodore 'mach) (doctor-put-meaning vic 'mach) (doctor-put-meaning bbs 'mach) (doctor-put-meaning modem 'mach) (doctor-put-meaning baud 'mach) (doctor-put-meaning macintosh 'mach) (doctor-put-meaning vax 'mach) (doctor-put-meaning vms 'mach) (doctor-put-meaning ibm 'mach) (doctor-put-meaning pc 'mach) (doctor-put-meaning bitching 'foul) (doctor-put-meaning shit 'foul) (doctor-put-meaning bastard 'foul) (doctor-put-meaning damn 'foul) (doctor-put-meaning damned 'foul) (doctor-put-meaning hell 'foul) (doctor-put-meaning suck 'foul) (doctor-put-meaning sucking 'foul) (doctor-put-meaning sux 'foul) (doctor-put-meaning ass 'foul) (doctor-put-meaning whore 'foul) (doctor-put-meaning bitch 'foul) (doctor-put-meaning asshole 'foul) (doctor-put-meaning shrink 'foul) (doctor-put-meaning pot 'toke) (doctor-put-meaning grass 'toke) (doctor-put-meaning weed 'toke) (doctor-put-meaning marijuana 'toke) (doctor-put-meaning acapulco 'toke) (doctor-put-meaning columbian 'toke) (doctor-put-meaning tokin 'toke) (doctor-put-meaning joint 'toke) (doctor-put-meaning toke 'toke) (doctor-put-meaning toking 'toke) (doctor-put-meaning tokin\' 'toke) (doctor-put-meaning toked 'toke) (doctor-put-meaning roach 'toke) (doctor-put-meaning pills 'drug) (doctor-put-meaning dope 'drug) (doctor-put-meaning acid 'drug) (doctor-put-meaning lsd 'drug) (doctor-put-meaning speed 'drug) (doctor-put-meaning heroin 'drug) (doctor-put-meaning hash 'drug) (doctor-put-meaning cocaine 'drug) (doctor-put-meaning uppers 'drug) (doctor-put-meaning downers 'drug) (doctor-put-meaning loves 'loves) (doctor-put-meaning love 'love) (doctor-put-meaning loved 'love) (doctor-put-meaning hates 'hates) (doctor-put-meaning dislikes 'hates) (doctor-put-meaning hate 'hate) (doctor-put-meaning hated 'hate) (doctor-put-meaning dislike 'hate) (doctor-put-meaning stoned 'state) (doctor-put-meaning drunk 'state) (doctor-put-meaning drunken 'state) (doctor-put-meaning high 'state) (doctor-put-meaning horny 'state) (doctor-put-meaning blasted 'state) (doctor-put-meaning happy 'state) (doctor-put-meaning paranoid 'state) (doctor-put-meaning wish 'desire) (doctor-put-meaning wishes 'desire) (doctor-put-meaning want 'desire) (doctor-put-meaning desire 'desire) (doctor-put-meaning like 'desire) (doctor-put-meaning hope 'desire) (doctor-put-meaning hopes 'desire) (doctor-put-meaning desires 'desire) (doctor-put-meaning wants 'desire) (doctor-put-meaning desires 'desire) (doctor-put-meaning likes 'desire) (doctor-put-meaning needs 'desire) (doctor-put-meaning need 'desire) (doctor-put-meaning frustrated 'mood) (doctor-put-meaning depressed 'mood) (doctor-put-meaning annoyed 'mood) (doctor-put-meaning upset 'mood) (doctor-put-meaning unhappy 'mood) (doctor-put-meaning excited 'mood) (doctor-put-meaning worried 'mood) (doctor-put-meaning lonely 'mood) (doctor-put-meaning angry 'mood) (doctor-put-meaning mad 'mood) (doctor-put-meaning pissed 'mood) (doctor-put-meaning jealous 'mood) (doctor-put-meaning afraid 'fear) (doctor-put-meaning terrified 'fear) (doctor-put-meaning fear 'fear) (doctor-put-meaning scared 'fear) (doctor-put-meaning frightened 'fear) (doctor-put-meaning virginity 'sexnoun) (doctor-put-meaning virgins 'sexnoun) (doctor-put-meaning virgin 'sexnoun) (doctor-put-meaning cock 'sexnoun) (doctor-put-meaning cocks 'sexnoun) (doctor-put-meaning dick 'sexnoun) (doctor-put-meaning dicks 'sexnoun) (doctor-put-meaning cunt 'sexnoun) (doctor-put-meaning cunts 'sexnoun) (doctor-put-meaning prostitute 'sexnoun) (doctor-put-meaning condom 'sexnoun) (doctor-put-meaning sex 'sexnoun) (doctor-put-meaning rapes 'sexnoun) (doctor-put-meaning wife 'family) (doctor-put-meaning family 'family) (doctor-put-meaning brothers 'family) (doctor-put-meaning sisters 'family) (doctor-put-meaning parent 'family) (doctor-put-meaning parents 'family) (doctor-put-meaning brother 'family) (doctor-put-meaning sister 'family) (doctor-put-meaning father 'family) (doctor-put-meaning mother 'family) (doctor-put-meaning husband 'family) (doctor-put-meaning siblings 'family) (doctor-put-meaning grandmother 'family) (doctor-put-meaning grandfather 'family) (doctor-put-meaning maternal 'family) (doctor-put-meaning paternal 'family) (doctor-put-meaning stab 'death) (doctor-put-meaning murder 'death) (doctor-put-meaning murders 'death) (doctor-put-meaning suicide 'death) (doctor-put-meaning suicides 'death) (doctor-put-meaning kill 'death) (doctor-put-meaning kills 'death) (doctor-put-meaning die 'death) (doctor-put-meaning dies 'death) (doctor-put-meaning died 'death) (doctor-put-meaning dead 'death) (doctor-put-meaning death 'death) (doctor-put-meaning deaths 'death) (doctor-put-meaning pain 'symptoms) (doctor-put-meaning ache 'symptoms) (doctor-put-meaning fever 'symptoms) (doctor-put-meaning sore 'symptoms) (doctor-put-meaning aching 'symptoms) (doctor-put-meaning stomachache 'symptoms) (doctor-put-meaning headache 'symptoms) (doctor-put-meaning hurts 'symptoms) (doctor-put-meaning disease 'symptoms) (doctor-put-meaning virus 'symptoms) (doctor-put-meaning vomit 'symptoms) (doctor-put-meaning vomiting 'symptoms) (doctor-put-meaning barf 'symptoms) (doctor-put-meaning toothache 'symptoms) (doctor-put-meaning hurt 'symptoms) (doctor-put-meaning rum 'alcohol) (doctor-put-meaning gin 'alcohol) (doctor-put-meaning vodka 'alcohol) (doctor-put-meaning alcohol 'alcohol) (doctor-put-meaning bourbon 'alcohol) (doctor-put-meaning beer 'alcohol) (doctor-put-meaning wine 'alcohol) (doctor-put-meaning whiskey 'alcohol) (doctor-put-meaning scotch 'alcohol) (doctor-put-meaning fuck 'sexverb) (doctor-put-meaning fucked 'sexverb) (doctor-put-meaning screw 'sexverb) (doctor-put-meaning screwing 'sexverb) (doctor-put-meaning fucking 'sexverb) (doctor-put-meaning rape 'sexverb) (doctor-put-meaning raped 'sexverb) (doctor-put-meaning kiss 'sexverb) (doctor-put-meaning kissing 'sexverb) (doctor-put-meaning kisses 'sexverb) (doctor-put-meaning screws 'sexverb) (doctor-put-meaning fucks 'sexverb) (doctor-put-meaning because 'conj) (doctor-put-meaning but 'conj) (doctor-put-meaning however 'conj) (doctor-put-meaning besides 'conj) (doctor-put-meaning anyway 'conj) (doctor-put-meaning that 'conj) (doctor-put-meaning except 'conj) (doctor-put-meaning why 'conj) (doctor-put-meaning how 'conj) (doctor-put-meaning until 'when) (doctor-put-meaning when 'when) (doctor-put-meaning whenever 'when) (doctor-put-meaning while 'when) (doctor-put-meaning since 'when) (doctor-put-meaning rms 'rms) (doctor-put-meaning stallman 'rms) (doctor-put-meaning school 'school) (doctor-put-meaning schools 'school) (doctor-put-meaning skool 'school) (doctor-put-meaning grade 'school) (doctor-put-meaning grades 'school) (doctor-put-meaning teacher 'school) (doctor-put-meaning teachers 'school) (doctor-put-meaning classes 'school) (doctor-put-meaning professor 'school) (doctor-put-meaning prof 'school) (doctor-put-meaning profs 'school) (doctor-put-meaning professors 'school) (doctor-put-meaning mit 'school) (doctor-put-meaning emacs 'eliza) (doctor-put-meaning eliza 'eliza) (doctor-put-meaning liza 'eliza) (doctor-put-meaning elisa 'eliza) (doctor-put-meaning weizenbaum 'eliza) (doctor-put-meaning doktor 'eliza) (doctor-put-meaning athletics 'sports) (doctor-put-meaning baseball 'sports) (doctor-put-meaning basketball 'sports) (doctor-put-meaning football 'sports) (doctor-put-meaning frisbee 'sports) (doctor-put-meaning gym 'sports) (doctor-put-meaning gymnastics 'sports) (doctor-put-meaning hockey 'sports) (doctor-put-meaning lacrosse 'sports) (doctor-put-meaning soccer 'sports) (doctor-put-meaning softball 'sports) (doctor-put-meaning sports 'sports) (doctor-put-meaning swimming 'sports) (doctor-put-meaning swim 'sports) (doctor-put-meaning tennis 'sports) (doctor-put-meaning volleyball 'sports) (doctor-put-meaning math 'math) (doctor-put-meaning mathematics 'math) (doctor-put-meaning mathematical 'math) (doctor-put-meaning theorem 'math) (doctor-put-meaning axiom 'math) (doctor-put-meaning lemma 'math) (doctor-put-meaning algebra 'math) (doctor-put-meaning algebraic 'math) (doctor-put-meaning trig 'math) (doctor-put-meaning trigonometry 'math) (doctor-put-meaning trigonometric 'math) (doctor-put-meaning geometry 'math) (doctor-put-meaning geometric 'math) (doctor-put-meaning calculus 'math) (doctor-put-meaning arithmetic 'math) (doctor-put-meaning zippy 'zippy) (doctor-put-meaning zippy 'zippy) (doctor-put-meaning pinhead 'zippy) (doctor-put-meaning chat 'chat) ;;;###autoload (defun doctor () "Switch to *doctor* buffer and start giving psychotherapy." (interactive) (switch-to-buffer "*doctor*") (doctor-mode)) (defun doctor-ret-or-read (arg) "Insert a newline if preceding character is not a newline. Otherwise call the Doctor to parse preceding sentence." (interactive "*p") (if (= (preceding-char) ?\n) (doctor-read-print) (newline arg))) (defun doctor-read-print nil "top level loop" (interactive) (let ((sent (doctor-readin))) (insert "\n") (setq lincount (1+ lincount)) (doctor-doc sent) (insert "\n") (setq bak sent))) (defun doctor-readin nil "Read a sentence. Return it as a list of words." (let (sentence) (backward-sentence 1) (while (not (eobp)) (setq sentence (append sentence (list (doctor-read-token))))) sentence)) (defun doctor-read-token () "read one word from buffer" (prog1 (intern (downcase (buffer-substring (point) (progn (forward-word 1) (point))))) (re-search-forward "\\Sw*"))) ;; Main processing function for sentences that have been read. (defun doctor-doc (sent) (cond ((equal sent '(foo)) (doctor-type '(bar! ($ please)($ continue)))) ((member sent howareyoulst) (doctor-type '(i\'m ok \. ($ describe) yourself \.))) ((or (member sent '((good bye) (see you later) (i quit) (so long) (go away) (get lost))) (memq (car sent) '(bye halt break quit done exit goodbye bye\, stop pause goodbye\, stop pause))) (doctor-type ($ bye))) ((and (eq (car sent) 'you) (memq (doctor-cadr sent) abusewords)) (setq found (doctor-cadr sent)) (doctor-type ($ abuselst))) ((eq (car sent) 'whatmeans) (doctor-def (doctor-cadr sent))) ((equal sent '(parse)) (doctor-type (list 'subj '= subj ", " 'verb '= verb "\n" 'object 'phrase '= obj "," 'noun 'form '= object "\n" 'current 'keyword 'is found ", " 'most 'recent 'possessive 'is owner "\n" 'sentence 'used 'was "..." '(// bak)))) ;; ((eq (car sent) 'forget) ;; (set (doctor-cadr sent) nil) ;; (doctor-type '(($ isee)($ please) ;; ($ continue)\.))) (t (if (doctor-defq sent) (doctor-define sent found)) (if (> (length sent) 12)(doctor-shorten sent)) (setq sent (doctor-correct-spelling (doctor-replace sent replist))) (cond ((and (not (memq 'me sent))(not (memq 'i sent)) (memq 'am sent)) (setq sent (doctor-replace sent '((am . (are))))))) (cond ((equal (car sent) 'yow) (doctor-zippy)) ((< (length sent) 2) (cond ((eq (doctor-meaning (car sent)) 'howdy) (doctor-howdy)) (t (doctor-short)))) (t (if (memq 'am sent) (setq sent (doctor-replace sent '((me . (i)))))) (setq sent (doctor-fixup sent)) (if (and (eq (car sent) 'do) (eq (doctor-cadr sent) 'not)) (cond ((zerop (random 3)) (doctor-type '(are you ($ afraidof) that \?))) ((zerop (random 2)) (doctor-type '(don\'t tell me what to do \. i am the psychiatrist here!)) (doctor-rthing)) (t (doctor-type '(($ whysay) that i shouldn\'t (doctor-cddr sent) \?)))) (doctor-go (doctor-wherego sent)))))))) ;; Things done to process sentences once read. (defun doctor-correct-spelling (sent) "Correct the spelling and expand each word in sentence." (if sent (apply 'append (mapcar '(lambda (word) (if (memq word typos) (get (get word 'doctor-correction) 'doctor-expansion) (list word))) sent)))) (defun doctor-shorten (sent) "Make a sentence manageably short using a few hacks." (let (foo retval (temp '(because but however besides anyway until while that except why how))) (while temp (setq foo (memq (car temp) sent)) (if (and foo (> (length foo) 3)) (setq sent foo sent (doctor-fixup sent) temp nil retval t) (setq temp (cdr temp)))) retval)) (defun doctor-define (sent found) (doctor-svo sent found 1 nil) (and (doctor-nounp subj) (not (doctor-pronounp subj)) subj (doctor-meaning object) (put subj 'doctor-meaning (doctor-meaning object)) t)) (defun doctor-defq (sent) "Set global var FOUND to first keyword found in sentence SENT." (setq found nil) (let ((temp '(means applies mean refers refer related similar defined associated linked like same))) (while temp (if (memq (car temp) sent) (setq found (car temp) temp nil) (setq temp (cdr temp))))) found) (defun doctor-def (x) (progn (doctor-type (list 'the 'word x 'means (doctor-meaning x) 'to 'me)) nil)) (defun doctor-forget () "Delete the last element of the history list." (setq history (reverse (cdr (reverse history))))) (defun doctor-query (x) "Prompt for a line of input from the minibuffer until a noun or verb is seen. Put dialogue in buffer." (let (a (prompt (concat (doctor-make-string x) " what \? ")) retval) (while (not retval) (while (not a) (insert ?\n prompt (read-string prompt) ?\n) (setq a (doctor-readin))) (while (and a (not retval)) (cond ((doctor-nounp (car a)) (setq retval (car a))) ((doctor-verbp (car a)) (setq retval (doctor-build (doctor-build x " ") (car a)))) ((setq a (cdr a)))))) retval)) (defun doctor-subjsearch (sent key type) "Search for the subject of a sentence SENT, looking for the noun closest to and preceding KEY by at least TYPE words. Set global variable subj to the subject noun, and return the portion of the sentence following it." (let ((i (- (length sent) (length (memq key sent)) type))) (while (and (> i -1) (not (doctor-nounp (nth i sent)))) (setq i (1- i))) (cond ((> i -1) (setq subj (nth i sent)) (nthcdr (1+ i) sent)) (t (setq subj 'you) nil)))) (defun doctor-nounp (x) "Returns t if the symbol argument is a noun." (or (doctor-pronounp x) (not (or (doctor-verbp x) (equal x 'not) (doctor-prepp x) (doctor-modifierp x) )) )) (defun doctor-pronounp (x) "Returns t if the symbol argument is a pronoun." (memq x '( i me mine myself we us ours ourselves ourself you yours yourself yourselves he him himself she hers herself it that those this these things thing they them themselves theirs anybody everybody somebody anyone everyone someone anything something everything))) (mapcar (function (lambda (x) (put x 'doctor-sentence-type 'verb))) '(abort aborted aborts ask asked asks am applied applies apply are associate associated ate be became become becomes becoming been being believe believed believes bit bite bites bore bored bores boring bought buy buys buying call called calling calls came can caught catch come contract contracted contracts control controlled controls could croak croaks croaked cut cuts dare dared define defines dial dialed dials did die died dies dislike disliked dislikes do does drank drink drinks drinking drive drives driving drove dying eat eating eats expand expanded expands expect expected expects expel expels expelled explain explained explains fart farts feel feels felt fight fights find finds finding forget forgets forgot fought found fuck fucked fucking fucks gave get gets getting give gives go goes going gone got gotten had harm harms has hate hated hates have having hear heard hears hearing help helped helping helps hit hits hope hoped hopes hurt hurts implies imply is join joined joins jump jumped jumps keep keeping keeps kept kill killed killing kills kiss kissed kisses kissing knew know knows laid lay lays let lets lie lied lies like liked likes liking listen listens login look looked looking looks lose losing lost love loved loves loving luse lusing lust lusts made make makes making may mean means meant might move moved moves moving must need needed needs order ordered orders ought paid pay pays pick picked picking picks placed placing prefer prefers put puts ran rape raped rapes read reading reads recall receive received receives refer refered referred refers relate related relates remember remembered remembers romp romped romps run running runs said sang sat saw say says screw screwed screwing screws scrod see sees seem seemed seems seen sell selling sells send sendind sends sent shall shoot shot should sing sings sit sits sitting sold studied study take takes taking talk talked talking talks tell tells telling think thinks thought told took tooled touch touched touches touching transfer transferred transfers transmit transmits transmitted type types types typing walk walked walking walks want wanted wants was watch watched watching went were will wish would work worked works write writes writing wrote use used uses using)) (defun doctor-verbp (x) (if (symbolp x) (eq (get x 'doctor-sentence-type) 'verb))) (defun doctor-plural (x) "Form the plural of the word argument." (let ((foo (doctor-make-string x))) (cond ((string-equal (substring foo -1) "s") (cond ((string-equal (substring foo -2 -1) "s") (intern (concat foo "es"))) (t x))) ((string-equal (substring foo -1) "y") (intern (concat (substring foo 0 -1) "ies"))) (t (intern (concat foo "s")))))) (defun doctor-setprep (sent key) (let ((val) (foo (memq key sent))) (cond ((doctor-prepp (doctor-cadr foo)) (setq val (doctor-getnoun (doctor-cddr foo))) (cond (val val) (t 'something))) ((doctor-articlep (doctor-cadr foo)) (setq val (doctor-getnoun (doctor-cddr foo))) (cond (val (doctor-build (doctor-build (doctor-cadr foo) " ") val)) (t 'something))) (t 'something)))) (defun doctor-getnoun (x) (cond ((null x)(setq object 'something)) ((atom x)(setq object x)) ((eq (length x) 1) (setq object (cond ((doctor-nounp (setq object (car x))) object) (t (doctor-query object))))) ((eq (car x) 'to) (doctor-build 'to\ (doctor-getnoun (cdr x)))) ((doctor-prepp (car x)) (doctor-getnoun (cdr x))) ((not (doctor-nounp (car x))) (doctor-build (doctor-build (cdr (assq (car x) (append '((a . this) (some . this) (one . that)) (list (cons (car x) (car x)))))) " ") (doctor-getnoun (cdr x)))) (t (setq object (car x))) )) (defun doctor-modifierp (x) (or (doctor-adjectivep x) (doctor-adverbp x) (doctor-othermodifierp x))) (defun doctor-adjectivep (x) (or (numberp x) (doctor-nmbrp x) (doctor-articlep x) (doctor-colorp x) (doctor-sizep x) (doctor-possessivepronounp x))) (defun doctor-adverbp (xx) (let ((xxstr (doctor-make-string xx))) (and (>= (length xxstr) 2) (string-equal (substring (doctor-make-string xx) -2) "ly")))) (defun doctor-articlep (x) (memq x '(the a an))) (defun doctor-nmbrp (x) (memq x '(one two three four five six seven eight nine ten eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen twenty thirty forty fifty sixty seventy eighty ninety hundred thousand million billion half quarter first second third fourth fifth sixth seventh eighth ninth tenth))) (defun doctor-colorp (x) (memq x '(beige black blue brown crimson gray grey green orange pink purple red tan tawny violet white yellow))) (defun doctor-sizep (x) (memq x '(big large tall fat wide thick small petite short thin skinny))) (defun doctor-possessivepronounp (x) (memq x '(my your his her our their))) (defun doctor-othermodifierp (x) (memq x '(all also always amusing any anyway associated awesome bad beautiful best better but certain clear ever every fantastic fun funny good great gross growdy however if ignorant less linked losing lusing many more much never nice obnoxious often poor pretty real related rich similar some stupid super superb terrible terrific too total tubular ugly very))) (defun doctor-prepp (x) (memq x '(about above after around as at before beneath behind beside between by for from in inside into like near next of on onto over same through thru to toward towards under underneath with without))) (defun doctor-remember (thing) (cond ((null history) (setq history (list thing))) (t (setq history (append history (list thing)))))) (defun doctor-type (x) (setq x (doctor-fix-2 x)) (doctor-txtype (doctor-assm x))) (defun doctor-fixup (sent) (setq sent (append (cdr (assq (car sent) (append '((me i) (him he) (her she) (them they) (okay) (well) (sigh) (hmm) (hmmm) (hmmmm) (hmmmmm) (gee) (sure) (great) (oh) (fine) (ok) (no)) (list (list (car sent) (car sent)))))) (cdr sent))) (doctor-fix-2 sent)) (defun doctor-fix-2 (sent) (let ((foo sent)) (while foo (if (and (eq (car foo) 'me) (doctor-verbp (doctor-cadr foo))) (rplaca foo 'i) (cond ((eq (car foo) 'you) (cond ((memq (doctor-cadr foo) '(am be been is)) (rplaca (cdr foo) 'are)) ((memq (doctor-cadr foo) '(has)) (rplaca (cdr foo) 'have)) ((memq (doctor-cadr foo) '(was)) (rplaca (cdr foo) 'were)))) ((equal (car foo) 'i) (cond ((memq (doctor-cadr foo) '(are is be been)) (rplaca (cdr foo) 'am)) ((memq (doctor-cadr foo) '(were)) (rplaca (cdr foo) 'was)) ((memq (doctor-cadr foo) '(has)) (rplaca (cdr foo) 'have)))) ((and (doctor-verbp (car foo)) (eq (doctor-cadr foo) 'i) (not (doctor-verbp (car (doctor-cddr foo))))) (rplaca (cdr foo) 'me)) ((and (eq (car foo) 'a) (doctor-vowelp (string-to-char (doctor-make-string (doctor-cadr foo))))) (rplaca foo 'an)) ((and (eq (car foo) 'an) (not (doctor-vowelp (string-to-char (doctor-make-string (doctor-cadr foo)))))) (rplaca foo 'a))) (setq foo (cdr foo)))) sent)) (defun doctor-vowelp (x) (memq x '(?a ?e ?i ?o ?u))) (defun doctor-replace (sent rlist) "Replace any element of SENT that is the car of a replacement element pair in RLIST." (apply 'append (mapcar (function (lambda (x) (cdr (or (assq x rlist) ; either find a replacement (list x x))))) ; or fake an identity mapping sent))) (defun doctor-wherego (sent) (cond ((null sent)($ whereoutp)) ((null (doctor-meaning (car sent))) (doctor-wherego (cond ((zerop (random 2)) (reverse (cdr sent))) (t (cdr sent))))) (t (setq found (car sent)) (doctor-meaning (car sent))))) (defun doctor-svo (sent key type mem) "Find subject, verb and object in sentence SENT with focus on word KEY. TYPE is number of words preceding KEY to start looking for subject. MEM is t if results are to be put on Doctor's memory stack. Return in the global variables SUBJ, VERB and OBJECT." (let ((foo (doctor-subjsearch sent key type))) (or foo (setq foo sent mem nil)) (while (and (null (doctor-verbp (car foo))) (cdr foo)) (setq foo (cdr foo))) (setq verb (car foo)) (setq obj (doctor-getnoun (cdr foo))) (cond ((eq object 'i)(setq object 'me)) ((eq subj 'me)(setq subj 'i))) (cond (mem (doctor-remember (list subj verb obj)))))) (defun doctor-possess (sent key) "Set possessive in SENT for keyword KEY. Hack on previous word, setting global variable OWNER to correct result." (let* ((i (- (length sent) (length (memq key sent)) 1)) (prev (if (< i 0) 'your (nth i sent)))) (setq owner (if (or (doctor-possessivepronounp prev) (string-equal "s" (substring (doctor-make-string prev) -1))) prev 'your)))) ;; Output of replies. (defun doctor-txtype (ans) "Output to buffer a list of symbols or strings as a sentence." (setq *print-upcase* t *print-space* nil) (mapcar 'doctor-type-symbol ans) (insert "\n")) (defun doctor-type-symbol (word) "Output a symbol to the buffer with some fancy case and spacing hacks." (setq word (doctor-make-string word)) (if (string-equal word "i") (setq word "I")) (if *print-upcase* (progn (setq word (capitalize word)) (if *print-space* (insert " ")))) (cond ((or (string-match "^[.,;:?! ]" word) (not *print-space*)) (insert word)) (t (insert ?\ word))) (and auto-fill-function (> (current-column) fill-column) (apply auto-fill-function nil)) (setq *print-upcase* (string-match "[.?!]$" word) *print-space* t)) (defun doctor-build (str1 str2) "Make a symbol out of the concatenation of the two non-list arguments." (cond ((null str1) str2) ((null str2) str1) ((and (atom str1) (atom str2)) (intern (concat (doctor-make-string str1) (doctor-make-string str2)))) (t nil))) (defun doctor-make-string (obj) (cond ((stringp obj) obj) ((symbolp obj) (symbol-name obj)) ((numberp obj) (int-to-string obj)) (t ""))) (defun doctor-concat (x y) "Like append, but force atomic arguments to be lists." (append (if (and x (atom x)) (list x) x) (if (and y (atom y)) (list y) y))) (defun doctor-assm (proto) (cond ((null proto) nil) ((atom proto) (list proto)) ((atom (car proto)) (cons (car proto) (doctor-assm (cdr proto)))) (t (doctor-concat (doctor-assm (eval (car proto))) (doctor-assm (cdr proto)))))) ;; Functions that handle specific words or meanings when found. (defun doctor-go (destination) "Call a `doctor-*' function." (funcall (intern (concat "doctor-" (doctor-make-string destination))))) (defun doctor-desire1 () (doctor-go ($ whereoutp))) (defun doctor-huh () (cond ((< (length sent) 9) (doctor-type ($ huhlst))) (t (doctor-type ($ longhuhlst))))) (defun doctor-rthing () (doctor-type ($ thlst))) (defun doctor-remem () (cond ((null history)(doctor-huh)) ((doctor-type ($ remlst))))) (defun doctor-howdy () (cond ((not howdyflag) (doctor-type '(($ hello) what brings you to see me \?)) (setq howdyflag t)) (t (doctor-type '(($ ibelieve) we\'ve introduced ourselves already \.)) (doctor-type '(($ please) ($ describe) ($ things) \.))))) (defun doctor-when () (cond ((< (length (memq found sent)) 3)(doctor-short)) (t (setq sent (cdr (memq found sent))) (setq sent (doctor-fixup sent)) (doctor-type '(($ whatwhen)(// sent) \?))))) (defun doctor-conj () (cond ((< (length (memq found sent)) 4)(doctor-short)) (t (setq sent (cdr (memq found sent))) (setq sent (doctor-fixup sent)) (cond ((eq (car sent) 'of) (doctor-type '(are you ($ sure) that is the real reason \?)) (setq things (cons (cdr sent) things))) (t (doctor-remember sent) (doctor-type ($ beclst))))))) (defun doctor-short () (cond ((= (car repetitive-shortness) (1- lincount)) (rplacd repetitive-shortness (1+ (cdr repetitive-shortness)))) (t (rplacd repetitive-shortness 1))) (rplaca repetitive-shortness lincount) (cond ((> (cdr repetitive-shortness) 6) (cond ((not **mad**) (doctor-type '(($ areyou) just trying to see what kind of things i have in my vocabulary \? please try to carry on a reasonable conversation!)) (setq **mad** t)) (t (doctor-type '(i give up \. you need a lesson in creative writing \.\.\.)) ;;(push monosyllables observation-list) ))) (t (cond ((equal sent (doctor-assm '(yes))) (doctor-type '(($ isee) ($ inter) ($ whysay) this is so \?))) ((equal sent (doctor-assm '(because))) (doctor-type ($ shortbeclst))) ((equal sent (doctor-assm '(no))) (doctor-type ($ neglst))) (t (doctor-type ($ shortlst))))))) (defun doctor-alcohol () (doctor-type ($ drnk))) (defun doctor-desire () (let ((foo (memq found sent))) (cond ((< (length foo) 2) (doctor-go (doctor-build (doctor-meaning found) 1))) ((memq (doctor-cadr foo) '(a an)) (rplacd foo (append '(to have) (cdr foo))) (doctor-svo sent found 1 nil) (doctor-remember (list subj 'would 'like obj)) (doctor-type ($ whywant))) ((not (eq (doctor-cadr foo) 'to)) (doctor-go (doctor-build (doctor-meaning found) 1))) (t (doctor-svo sent found 1 nil) (doctor-remember (list subj 'would 'like obj)) (doctor-type ($ whywant)))))) (defun doctor-drug () (doctor-type ($ drugs)) (doctor-remember (list 'you 'used found))) (defun doctor-toke () (doctor-type ($ toklst))) (defun doctor-state () (doctor-type ($ states))(doctor-remember (list 'you 'were found))) (defun doctor-mood () (doctor-type ($ moods))(doctor-remember (list 'you 'felt found))) (defun doctor-fear () (setq feared (doctor-setprep sent found)) (doctor-type ($ fears)) (doctor-remember (list 'you 'were 'afraid 'of feared))) (defun doctor-hate () (doctor-svo sent found 1 t) (cond ((memq 'not sent) (doctor-forget) (doctor-huh)) ((equal subj 'you) (doctor-type '(why do you (// verb)(// obj) \?))) (t (doctor-type '(($ whysay)(list subj verb obj)))))) (defun doctor-symptoms () (doctor-type '(($ maybe) you should consult a doctor of medicine\, i am a psychiatrist \.))) (defun doctor-hates () (doctor-svo sent found 1 t) (doctor-hates1)) (defun doctor-hates1 () (doctor-type '(($ whysay)(list subj verb obj)))) (defun doctor-loves () (doctor-svo sent found 1 t) (doctor-qloves)) (defun doctor-qloves () (doctor-type '(($ bother)(list subj verb obj) \?))) (defun doctor-love () (doctor-svo sent found 1 t) (cond ((memq 'not sent) (doctor-forget) (doctor-huh)) ((memq 'to sent) (doctor-hates1)) (t (cond ((equal object 'something) (setq object '(this person you love)))) (cond ((equal subj 'you) (setq lover obj) (cond ((equal lover '(this person you love)) (setq lover '(your partner)) (doctor-forget) (doctor-type '(with whom are you in love \?))) ((doctor-type '(($ please) ($ describe) ($ relation) (// lover) \.))))) ((equal subj 'i) (doctor-txtype '(we were discussing you!))) (t (doctor-forget) (setq obj 'someone) (setq verb (doctor-build verb 's)) (doctor-qloves)))))) (defun doctor-mach () (setq found (doctor-plural found)) (doctor-type ($ machlst))) (defun doctor-sexnoun () (doctor-sexverb)) (defun doctor-sexverb () (if (or (memq 'me sent)(memq 'myself sent)(memq 'i sent)) (doctor-foul) (doctor-type ($ sexlst)))) (defun doctor-death () (doctor-type ($ deathlst))) (defun doctor-foul () (doctor-type ($ foullst))) (defun doctor-family () (doctor-possess sent found) (doctor-type ($ famlst))) ;; I did not add this -- rms. ;; But he might have removed it. I put it back. --roland (defun doctor-rms () (cond (rms-flag (doctor-type ($ stallmanlst))) (t (setq rms-flag t) (doctor-type '(do you know Stallman \?))))) (defun doctor-school nil (doctor-type ($ schoollst))) (defun doctor-eliza () (cond (eliza-flag (doctor-type ($ elizalst))) (t (setq eliza-flag t) (doctor-type '((// found) \? hah ! ($ please) ($ continue) \.))))) (defun doctor-sports () (doctor-type ($ sportslst))) (defun doctor-math () (doctor-type ($ mathlst))) (defun doctor-zippy () (cond (zippy-flag (doctor-type ($ zippylst))) (t (setq zippy-flag t) (doctor-type '(yow! are we interactive yet \?))))) (defun doctor-chat () (doctor-type ($ chatlst))) (defun doctor-strangelove () (interactive) (insert "Mein fuhrer!!\n") (doctor-read-print)) ;;; doctor.el ends here emacs-19.30/lisp/dos-fns.el100444 12120 1 11623 6050710575 13772 0ustar rmsdaemon;;; dos-fns.el --- MS-Dos specific functions. ;; Copyright (C) 1991, 1993 Free Software Foundation, Inc. ;; Maintainer: Morten Welinder (terra@diku.dk) ;; Keywords: internal ;; 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: ;; Part of this code is taken from (or derived from) demacs. ;;; Code: ;;; Add %t: into the mode line format just after the open-paren. (let ((tail (member " %[(" mode-line-format))) (setcdr tail (cons (purecopy "%t:") (cdr tail)))) ;; Use ";" instead of ":" as a path separator (from files.el). (setq path-separator ";") ;; Set the null device (for compile.el). (setq grep-null-device "NUL") ;; Set the grep regexp to match entries with drive letters. (setq grep-regexp-alist '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3))) (defvar file-name-buffer-file-type-alist '( ("[:/].*config.sys$" . nil) ; config.sys text ("\\.elc$" . t) ; emacs stuff ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t) ; MS-Dos stuff ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t) ; Packers ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t) ; Unix stuff ("\\.tp[ulpw]$" . t) ; Borland Pascal stuff ("[:/]tags$" . t) ; Emacs TAGS file ) "*Alist for distinguishing text files from binary files. Each element has the form (REGEXP . TYPE), where REGEXP is matched against the file name, and TYPE is nil for text, t for binary.") (defun find-buffer-file-type (filename) (let ((alist file-name-buffer-file-type-alist) (found nil) (code nil)) (let ((case-fold-search t)) (setq filename (file-name-sans-versions filename)) (while (and (not found) alist) (if (string-match (car (car alist)) filename) (setq code (cdr (car alist)) found t)) (setq alist (cdr alist)))) (if found (cond((memq code '(nil t)) code) ((and (symbolp code) (fboundp code)) (funcall code filename))) default-buffer-file-type))) (defun find-file-binary (filename) "Visit file FILENAME and treat it as binary." (interactive "FFind file binary: ") (let ((file-name-buffer-file-type-alist '(("" . t)))) (find-file filename))) (defun find-file-text (filename) "Visit file FILENAME and treat it as a text file." (interactive "FFind file text: ") (let ((file-name-buffer-file-type-alist '(("" . nil)))) (find-file filename))) (defun find-file-not-found-set-buffer-file-type () (save-excursion (set-buffer (current-buffer)) (setq buffer-file-type (find-buffer-file-type (buffer-file-name)))) nil) ;;; To set the default file type on new files. (add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type) (defvar msdos-shells '("command.com" "4dos.com" "ndos.com") "*List of shells that use `/c' instead of `-c' and a backslashed command.") (defconst register-name-alist '((ax . 0) (bx . 1) (cx . 2) (dx . 3) (si . 4) (di . 5) (cflag . 6) (flags . 7) (al . (0 . 0)) (bl . (1 . 0)) (cl . (2 . 0)) (dl . (3 . 0)) (ah . (0 . 1)) (bh . (1 . 1)) (ch . (2 . 1)) (dh . (3 . 1)))) (defun make-register () (make-vector 8 0)) (defun register-value (regs name) (let ((where (cdr (assoc name register-name-alist)))) (cond ((consp where) (let ((tem (aref regs (car where)))) (if (zerop (cdr where)) (% tem 256) (/ tem 256)))) ((numberp where) (aref regs where)) (t nil)))) (defun set-register-value (regs name value) (and (numberp value) (>= value 0) (let ((where (cdr (assoc name register-name-alist)))) (cond ((consp where) (let ((tem (aref regs (car where))) (value (logand value 255))) (aset regs (car where) (if (zerop (cdr where)) (logior (logand tem 65280) value) (logior (logand tem 255) (lsh value 8)))))) ((numberp where) (aset regs where (logand value 65535)))))) regs) (defsubst intdos (regs) (int86 33 regs)) ;; Extra stub to functions in src/frame.c ;; Emacs aborts during dump if the following don't have a doc string. (defun window-frame (window) "Return the frame that WINDOW resides on." (selected-frame)) (defun raise-frame (frame) "Raise FRAME to the top of the desktop." nil) (defun select-frame (frame &optional no-enter) "Select FRAME for input events." (selected-frame)) emacs-19.30/lisp/double.el100444 12120 1 14363 6045201653 13673 0ustar rmsdaemon;;; double.el --- Support for keyboard remapping with double clicking ;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Keywords: i18n ;; 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 mode is intended for use with languages that adds a small ;; number of extra letters not available on the keyboard. ;; ;; Examples includes Scandinavian and German with an US keyboard. ;; ;; The idea is that certain keys are overloaded. When you press it ;; once it will insert one string, and when you press it twice the ;; string will be replaced by another. This can be used for mapping ;; keys on a US keyboard to generate characters according to the local ;; keyboard convention when pressed once, and according to US keyboard ;; convetion when pressed twice. ;; ;; To use this mode, you must define the variable `double-map' and ;; then enable double mode with `M-x double-mode'. Read the ;; documentation for both of them. ;; ;; The default mapping is for getting Danish/Norwegian keyboard layout ;; using ISO Latin 1 on a US keyboard. ;; ;; Imprtant node: While I would like to hear comments, bug reports, ;; suggestions, please do @strong{not} expect me to put other mappings ;; that the default into this file. There are billions and billions ;; of such mappings, and just supporting the most common would ;; increase the size of this nice small file manyfold. ;;; ChangeLog: ;; * 1994-06-21 Per Abrahamsen ;; Added `double-prefix-only'. ;; * 1994-02-28 Per Abrahamsen ;; Use 127 instead of 'delete to delete a character. ;; * 1994-02-03 Per Abrahamsen ;; Created. ;;; Code: (defvar double-map '((?\; "\346" ";") (?\' "\370" "'") (?\[ "\345" "[") (?\: "\306" ":") (?\" "\330" "\"") (?\{ "\305" "{")) "Alist of key translations activated by double mode. Each entry is a list with three elements: 1. The key activating the translation. 2. The string to be inserted when the key is pressed once. 3. The string to be inserted when the key is pressed twice.") (defvar double-prefix-only t "*Non-nil means that Double mode mapping only works for prefix keys. That is, for any key `X' in `double-map', `X' alone will be mapped but not `C-u X' or `ESC X' since the X is not the prefix key.") ;;; Read Event (defvar double-last-event nil) ;; The last key that generated a double key event. (defun double-read-event (prompt) ;; Read an event (if isearch-mode (isearch-update)) (if prompt (prog2 (message "%s%c" prompt double-last-event) (read-event) (message "")) (read-event))) (global-set-key [ignore] '(lambda () (interactive))) (or (boundp 'isearch-mode-map) (load-library "isearch")) (define-key isearch-mode-map [ignore] (function (lambda () (interactive) (isearch-update)))) (defun double-translate-key (prompt) ;; Translate input events using double map. (let ((key last-input-char)) (cond (unread-command-events ;; Artificial event, ignore it. (vector key)) ((and double-prefix-only (> (length (this-command-keys)) 1)) ;; This is not a prefix key, ignore it. (vector key)) ((eq key 'magic-start) ;; End of generated event. See if he will repeat it... (let ((new (double-read-event prompt)) (entry (assoc double-last-event double-map))) (if (eq new double-last-event) (progn (setq unread-command-events (append (make-list (1- (length (nth 1 entry))) 127) (nth 2 entry) '(magic-end))) (vector 127)) (setq unread-command-events (list new)) [ignore]))) ((eq key 'magic-end) ;; End of double event. Ignore. [ignore]) (t ;; New key. (let ((exp (nth 1 (assoc key double-map)))) (setq double-last-event key) (setq unread-command-events (append (substring exp 1) '(magic-start))) (vector (aref exp 0))))))) ;;; Key Translation Map (defvar default-key-translation-map (or key-translation-map (make-sparse-keymap)) "Key translation you want to have effect, regardless of Double mode. This defaults to the value of `key-translation-map' when double was first loaded.") (make-variable-buffer-local 'key-translation-map) (defun double-setup () ;; Setup key-translation-map as indicated by `double-map'. (setq key-translation-map (copy-keymap default-key-translation-map)) (mapcar (function (lambda (entry) (define-key key-translation-map (vector (nth 0 entry)) 'double-translate-key))) (append double-map '((magic-start) (magic-end))))) ;;; Mode (defvar double-mode nil) ;; Indicator for the double mode. (make-variable-buffer-local 'double-mode) (or (assq 'double-mode minor-mode-alist) (setq minor-mode-alist (cons '(double-mode " Double") minor-mode-alist))) ;; This feature seemed useless and it confused describe-mode, ;; so I deleted it. ;;;(defvar double-mode-name "Double") ;;;;; Name of current double mode. ;;; (make-variable-buffer-local 'double-mode-name) ;;;###autoload (defun double-mode (arg) "Toggle Double mode. With prefix arg, turn Double mode on iff arg is positive. When Double mode is on, some keys will insert different strings when pressed twice. See variable `double-map' for details." (interactive "P") (if (or (and (null arg) double-mode) (<= (prefix-numeric-value arg) 0)) ;; Turn it off (if double-mode (progn (let ((double-map)) (double-setup)) (setq double-mode nil) (force-mode-line-update))) ;;Turn it on (if double-mode () (double-setup) (setq double-mode t) (force-mode-line-update)))) (provide 'double) ;;; double.el ends here emacs-19.30/lisp/dunnet.el100444 12120 24 334723 6026044366 12611 0ustar rms;;; 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 (if (not dun-inbus) (progn (dun-mprincl"You fall into a hole in the ground.") (setq dun-current-room vermont-station) (dun-describe-room vermont-station)) (progn (dun-mprincl "The bus falls down a hole in the ground and explodes.") (dun-die "burning"))))) (if (> dun-current-room endgame-computer-room) (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)) (cond ((null objnum) (dun-mprincl "I don't know that name.")) ((and (not (eq 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.")) ((and (eq objnum obj-special) (not (member obj-tree (nth dun-current-room dun-room-silents)))) (dun-mprincl "There is nothing here to climb.")) ((and (not (eq objnum obj-tree)) (not (eq objnum obj-special))) (dun-mprincl "You can't climb that.")) (t (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 (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) (palm . -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 (random 18))) (dun-replace dun-room-objects tloc (append (nth tloc dun-room-objects) (list 18))) (setq tcomb (+ 100 (random 899))) (setq dun-combination (prin1-to-string tcomb)) ;;;; ;;;; 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-questions") (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)) emacs-19.30/lisp/easymenu.el100444 75424 12 16011 5757267654 14351 0ustar kwzhstaff;;; easymenu.el --- support the easymenu interface for defining a menu. ;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Keywords: emulations ;; Author: rms ;; 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. ;;; This is compatible with easymenu.el by Per Abrahamsen ;;; but it is much simpler as it doesn't try to support other Emacs versions. ;;; The code was mostly derived from lmenu.el. ;;; Code: ;;;###autoload (defmacro easy-menu-define (symbol maps doc menu) "Define a menu bar submenu in maps MAPS, according to MENU. The menu keymap is stored in symbol SYMBOL, both as its value and as its function definition. DOC is used as the doc string for SYMBOL. The first element of MENU must be a string. It is the menu bar item name. The rest of the elements are menu items. A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE] NAME is a string--the menu item name. CALLBACK is a command to run when the item is chosen, or a list to evaluate when the item is chosen. ENABLE is an expression; the item is enabled for selection whenever this expression's value is non-nil. Alternatively, a menu item may have the form: [ NAME CALLBACK [ KEYWORD ARG ] ... ] Where KEYWORD is one of the symbol defined below. :keys KEYS KEYS is a string; a complex keyboard equivalent to this menu item. This is normally not needed because keyboard equivalents are usually computed automatically. :active ENABLE ENABLE is an expression; the item is enabled for selection whenever this expression's value is non-nil. :suffix NAME NAME is a string; the name of an argument to CALLBACK. :style STYLE is a symbol describing the type of menu item. The following are defined: toggle: A checkbox. Currently just prepend the name with the string \"Toggle \". radio: A radio button. nil: An ordinary menu item. :selected SELECTED SELECTED is an expression; the checkbox or radio button is selected whenever this expression's value is non-nil. Currently just disable radio buttons, no effect on checkboxes. A menu item can be a string. Then that string appears in the menu as unselectable text. A string consisting solely of hyphens is displayed as a solid horizontal line. A menu item can be a list. It is treated as a submenu. The first element should be the submenu name. That's used as the menu item in the top-level menu. The cdr of the submenu list is a list of menu items, as above." (` (progn (defvar (, symbol) nil (, doc)) (easy-menu-do-define (quote (, symbol)) (, maps) (, doc) (, menu))))) ;;;###autoload (defun easy-menu-do-define (symbol maps doc menu) ;; We can't do anything that might differ between Emacs dialects in ;; `easy-menu-define' in order to make byte compiled files ;; compatible. Therefore everything interesting is done in this ;; function. (set symbol (easy-menu-create-keymaps (car menu) (cdr menu))) (fset symbol (` (lambda (event) (, doc) (interactive "@e") (easy-popup-menu event (, symbol))))) (mapcar (function (lambda (map) (define-key map (vector 'menu-bar (intern (car menu))) (cons (car menu) (symbol-value symbol))))) (if (keymapp maps) (list maps) maps))) (defvar easy-menu-item-count 0) ;; Return a menu keymap corresponding to a Lucid-style menu list ;; MENU-ITEMS, and with name MENU-NAME. ;;;###autoload (defun easy-menu-create-keymaps (menu-name menu-items) (let ((menu (make-sparse-keymap menu-name))) ;; Process items in reverse order, ;; since the define-key loop reverses them again. (setq menu-items (reverse menu-items)) (while menu-items (let* ((item (car menu-items)) (callback (if (vectorp item) (aref item 1))) command enabler name) (cond ((stringp item) (setq command nil) (setq name (if (string-match "^-+$" item) "" item))) ((consp item) (setq command (easy-menu-create-keymaps (car item) (cdr item))) (setq name (car item))) ((vectorp item) (setq command (make-symbol (format "menu-function-%d" easy-menu-item-count))) (setq easy-menu-item-count (1+ easy-menu-item-count)) (setq name (aref item 0)) (let ((keyword (aref item 2))) (if (and (symbolp keyword) (= ?: (aref (symbol-name keyword) 0))) (let ((count 2) style selected active keys arg) (while (> (length item) count) (setq keyword (aref item count)) (setq arg (aref item (1+ count))) (setq count (+ 2 count)) (cond ((eq keyword ':keys) (setq keys arg)) ((eq keyword ':active) (setq active arg)) ((eq keyword ':suffix) (setq name (concat name " " arg))) ((eq keyword ':style) (setq style arg)) ((eq keyword ':selected) (setq selected arg)))) (if keys (setq name (concat name " (" keys ")"))) (if (eq style 'toggle) ;; Simulate checkboxes. (setq name (concat "Toggle " name))) (if active (put command 'menu-enable active) (and (eq style 'radio) selected ;; Simulate radio buttons with menu-enable. (put command 'menu-enable (list 'not selected))))) (put command 'menu-enable keyword))) (if (keymapp callback) (setq name (concat name " ..."))) (if (symbolp callback) (fset command callback) (fset command (list 'lambda () '(interactive) callback))))) (if (null command) ;; Handle inactive strings specially--allow any number ;; of identical ones. (setcdr menu (cons (list nil name) (cdr menu))) (if name (define-key menu (vector (intern name)) (cons name command))))) (setq menu-items (cdr menu-items))) menu)) (defun easy-menu-change (path name items) "Change menu found at PATH as item NAME to contain ITEMS. PATH is a list of strings for locating the menu containing NAME in the menu bar. ITEMS is a list of menu items, as in `easy-menu-define'. These items entirely replace the previous items in that map. Call this from `activate-menubar-hook' to implement dynamic menus." (let ((map (key-binding (apply 'vector 'menu-bar (mapcar 'intern (append path (list name))))))) (if (keymapp map) (setcdr map (cdr (easy-menu-create-keymaps name items))) (error "Malformed menu in `easy-menu-change'")))) (defun easy-menu-remove (menu)) (defun easy-menu-add (menu &optional map)) (provide 'easymenu) ;;; easymenu.el ends here emacs-19.30/lisp/ebuff-menu.el100444 75424 1 24026 6002546765 14662 0ustar kwzhdaemon;;; ebuff-menu.el --- electric-buffer-list mode ;; Copyright (C) 1985, 1986, 1994 Free Software Foundation, Inc. ;; Author: Richard Mlynarik ;; 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: ;; Who says one can't have typeout windows in GNU Emacs? The entry ;; point, `electric-buffer-list' works like ^r select buffer from the ;; ITS Emacs lunar or tmacs libraries. ;;; Code: (require 'electric) ;; this depends on the format of list-buffers (from src/buffer.c) and ;; on stuff in lisp/buff-menu.el (defvar electric-buffer-menu-mode-map nil) ;;;###autoload (defun electric-buffer-list (arg) "Pops up a buffer describing the set of Emacs buffers. Vaguely like ITS lunar select buffer; combining typeoutoid buffer listing with menuoid buffer selection. If the very next character typed is a space then the buffer list window disappears. Otherwise, one may move around in the buffer list window, marking buffers to be selected, saved or deleted. To exit and select a new buffer, type a space when the cursor is on the appropriate line of the buffer-list window. Other commands are much like those of buffer-menu-mode. Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil. \\{electric-buffer-menu-mode-map}" (interactive "P") (let (select buffer) (save-window-excursion (save-window-excursion (list-buffers arg)) (setq buffer (window-buffer (Electric-pop-up-window "*Buffer List*"))) (unwind-protect (progn (set-buffer buffer) (Electric-buffer-menu-mode) (setq select (catch 'electric-buffer-menu-select (message "<<< Press Return to bury the buffer list >>>") (if (eq (setq unread-command-events (list (read-event))) ?\ ) (progn (setq unread-command-events nil) (throw 'electric-buffer-menu-select nil))) (let ((start-point (point)) (first (progn (goto-char (point-min)) (forward-line 2) (point))) (last (progn (goto-char (point-max)) (forward-line -1) (point))) (goal-column 0)) ;; Use start-point if it is meaningful. (goto-char (if (or (< start-point first) (> start-point last)) first start-point)) (Electric-command-loop 'electric-buffer-menu-select nil t 'electric-buffer-menu-looper (cons first last)))))) (set-buffer buffer) (Buffer-menu-mode) (bury-buffer buffer) (message ""))) (if select (progn (set-buffer buffer) (let ((opoint (point-marker))) (Buffer-menu-execute) (goto-char (point-min)) (if (prog1 (search-forward "\n>" nil t) (goto-char opoint) (set-marker opoint nil)) (Buffer-menu-select) (switch-to-buffer (Buffer-menu-buffer t)))))))) (defun electric-buffer-menu-looper (state condition) (cond ((and condition (not (memq (car condition) '(buffer-read-only end-of-buffer beginning-of-buffer)))) (signal (car condition) (cdr condition))) ((< (point) (car state)) (goto-char (point-min)) (forward-line 2)) ((> (point) (cdr state)) (goto-char (point-max)) (forward-line -1) (if (pos-visible-in-window-p (point-max)) (recenter -1))))) (put 'Electric-buffer-menu-mode 'mode-class 'special) (defun Electric-buffer-menu-mode () "Major mode for editing a list of buffers. Each line describes one of the buffers in Emacs. Letters do not insert themselves; instead, they are commands. \\ \\[keyboard-quit] or \\[Electric-buffer-menu-quit] -- exit buffer menu, returning to previous window and buffer configuration. If the very first character typed is a space, it also has this effect. \\[Electric-buffer-menu-select] -- select buffer of line point is on. Also show buffers marked with m in other windows, deletes buffers marked with \"D\", and saves those marked with \"S\". \\[Buffer-menu-mark] -- mark buffer to be displayed. \\[Buffer-menu-not-modified] -- clear modified-flag on that buffer. \\[Buffer-menu-save] -- mark that buffer to be saved. \\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted. \\[Buffer-menu-unmark] -- remove all kinds of marks from current line. \\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done. \\[Buffer-menu-backup-unmark] -- back up a line and remove marks. \\{electric-buffer-menu-mode-map} Entry to this mode via command electric-buffer-list calls the value of electric-buffer-menu-mode-hook if it is non-nil." (kill-all-local-variables) (use-local-map electric-buffer-menu-mode-map) (setq mode-name "Electric Buffer Menu") (setq mode-line-buffer-identification "Electric Buffer List") (make-local-variable 'Helper-return-blurb) (setq Helper-return-blurb "return to buffer editing") (setq truncate-lines t) (setq buffer-read-only t) (setq major-mode 'Electric-buffer-menu-mode) (goto-char (point-min)) (if (search-forward "\n." nil t) (forward-char -1)) (run-hooks 'electric-buffer-menu-mode-hook)) ;; generally the same as Buffer-menu-mode-map ;; (except we don't indirect to global-map) (put 'Electric-buffer-menu-undefined 'suppress-keymap t) (if electric-buffer-menu-mode-map nil (let ((map (make-keymap)) (submap (make-keymap))) (fillarray (car (cdr map)) 'Electric-buffer-menu-undefined) (define-key map "\e" submap) (fillarray (car (cdr submap)) 'Electric-buffer-menu-undefined) (define-key map "\C-z" 'suspend-emacs) (define-key map "v" 'Electric-buffer-menu-mode-view-buffer) (define-key map (char-to-string help-char) 'Helper-help) (define-key map "?" 'Helper-describe-bindings) (define-key map "\C-c" nil) (define-key map "\C-c\C-c" 'Electric-buffer-menu-quit) (define-key map "\C-]" 'Electric-buffer-menu-quit) (define-key map "q" 'Electric-buffer-menu-quit) (define-key map " " 'Electric-buffer-menu-select) (define-key map "\C-m" 'Electric-buffer-menu-select) (define-key map "\C-l" 'recenter) (define-key map "s" 'Buffer-menu-save) (define-key map "d" 'Buffer-menu-delete) (define-key map "k" 'Buffer-menu-delete) (define-key map "\C-d" 'Buffer-menu-delete-backwards) ;(define-key map "\C-k" 'Buffer-menu-delete) (define-key map "\177" 'Buffer-menu-backup-unmark) (define-key map "~" 'Buffer-menu-not-modified) (define-key map "u" 'Buffer-menu-unmark) (let ((i ?0)) (while (<= i ?9) (define-key map (char-to-string i) 'digit-argument) (define-key map (concat "\e" (char-to-string i)) 'digit-argument) (setq i (1+ i)))) (define-key map "-" 'negative-argument) (define-key map "\e-" 'negative-argument) (define-key map "m" 'Buffer-menu-mark) (define-key map "\C-u" 'universal-argument) (define-key map "\C-p" 'previous-line) (define-key map "\C-n" 'next-line) (define-key map "p" 'previous-line) (define-key map "n" 'next-line) (define-key map "\C-v" 'scroll-up) (define-key map "\ev" 'scroll-down) (define-key map ">" 'scroll-right) (define-key map "<" 'scroll-left) (define-key map "\e\C-v" 'scroll-other-window) (define-key map "\e>" 'end-of-buffer) (define-key map "\e<" 'beginning-of-buffer) (define-key map "\e\e" nil) (define-key map "\e\e\e" 'Electric-buffer-menu-quit) (define-key map [escape escape escape] 'Electric-buffer-menu-quit) (define-key map [mouse-2] 'Electric-buffer-menu-mouse-select) (setq electric-buffer-menu-mode-map map))) (defun Electric-buffer-menu-exit () (interactive) (setq unread-command-events (listify-key-sequence (this-command-keys))) ;; for robustness (condition-case () (throw 'electric-buffer-menu-select nil) (error (Buffer-menu-mode) (other-buffer)))) (defun Electric-buffer-menu-select () "Leave Electric Buffer Menu, selecting buffers and executing changes. Saves buffers marked \"S\". Deletes buffers marked \"K\". Selects buffer at point and displays buffers marked \">\" in other windows." (interactive) (throw 'electric-buffer-menu-select (point))) (defun Electric-buffer-menu-mouse-select (event) (interactive "e") (select-window (posn-window (event-end event))) (set-buffer (window-buffer (selected-window))) (goto-char (posn-point (event-end event))) (throw 'electric-buffer-menu-select (point))) (defun Electric-buffer-menu-quit () "Leave Electric Buffer Menu, restoring previous window configuration. Does not execute select, save, or delete commands." (interactive) (throw 'electric-buffer-menu-select nil)) (defun Electric-buffer-menu-undefined () (interactive) (ding) (message (if (and (eq (key-binding "\C-c\C-c") 'Electric-buffer-menu-quit) (eq (key-binding " ") 'Electric-buffer-menu-select) (eq (key-binding (char-to-string help-char)) 'Helper-help) (eq (key-binding "?") 'Helper-describe-bindings)) (substitute-command-keys "Type C-c C-c to exit, Space to select, \\[Helper-help] for help, ? for commands") (substitute-command-keys "\ Type \\[Electric-buffer-menu-quit] to exit, \ \\[Electric-buffer-menu-select] to select, \ \\[Helper-help] for help, \\[Helper-describe-bindings] for commands."))) (sit-for 4)) (defun Electric-buffer-menu-mode-view-buffer () "View buffer on current line in Electric Buffer Menu. Returns to Electric Buffer Menu when done." (interactive) (let ((bufnam (Buffer-menu-buffer nil))) (if bufnam (view-buffer bufnam) (ding) (message "Buffer %s does not exist!" bufnam) (sit-for 4)))) ;;; ebuff-menu.el ends here emacs-19.30/lisp/echistory.el100444 75424 13 14416 5562572330 14377 0ustar kwzhuser;;; echistory.el --- Electric Command History Mode ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (require 'electric) ; command loop (require 'chistory) ; history lister ;;;###autoload (defun Electric-command-history-redo-expression (&optional noconfirm) "Edit current history line in minibuffer and execute result. With prefix arg NOCONFIRM, execute current line as-is without editing." (interactive "P") (let (todo) (save-excursion (set-buffer "*Command History*") (beginning-of-line) (setq todo (read (current-buffer))) (if (boundp 'electric-history-in-progress) (if todo (throw 'electric-history-quit (list noconfirm todo))))))) (defvar electric-history-map ()) (if electric-history-map () (setq electric-history-map (make-sparse-keymap)) (define-key electric-history-map [t] 'Electric-history-undefined) (define-key electric-history-map "\e" (make-sparse-keymap)) (define-key electric-history-map [?\e t] 'Electric-history-undefined) (define-key electric-history-map "\C-u" 'universal-argument) (define-key electric-history-map " " 'Electric-command-history-redo-expression) (define-key electric-history-map "!" 'Electric-command-history-redo-expression) (define-key electric-history-map "\e\C-x" 'eval-sexp) (define-key electric-history-map "\e\C-d" 'down-list) (define-key electric-history-map "\e\C-u" 'backward-up-list) (define-key electric-history-map "\e\C-b" 'backward-sexp) (define-key electric-history-map "\e\C-f" 'forward-sexp) (define-key electric-history-map "\e\C-a" 'beginning-of-defun) (define-key electric-history-map "\e\C-e" 'end-of-defun) (define-key electric-history-map "\e\C-n" 'forward-list) (define-key electric-history-map "\e\C-p" 'backward-list) (define-key electric-history-map "q" 'Electric-history-quit) (define-key electric-history-map "\C-c" nil) (define-key electric-history-map "\C-c\C-c" 'Electric-history-quit) (define-key electric-history-map "\C-]" 'Electric-history-quit) (define-key electric-history-map "\C-z" 'suspend-emacs) (define-key electric-history-map (char-to-string help-char) 'Helper-help) (define-key electric-history-map "?" 'Helper-describe-bindings) (define-key electric-history-map "\e>" 'end-of-buffer) (define-key electric-history-map "\e<" 'beginning-of-buffer) (define-key electric-history-map "\n" 'next-line) (define-key electric-history-map "\r" 'next-line) (define-key electric-history-map "\177" 'previous-line) (define-key electric-history-map "\C-n" 'next-line) (define-key electric-history-map "\C-p" 'previous-line) (define-key electric-history-map "\ev" 'scroll-down) (define-key electric-history-map "\C-v" 'scroll-up) (define-key electric-history-map [home] 'beginning-of-buffer) (define-key electric-history-map [down] 'next-line) (define-key electric-history-map [up] 'previous-line) (define-key electric-history-map [prior] 'scroll-down) (define-key electric-history-map [next] 'scroll-up) (define-key electric-history-map "\C-l" 'recenter) (define-key electric-history-map "\e\C-v" 'scroll-other-window)) (defvar electric-command-history-hook nil "If non-nil, its value is called by `electric-command-history'.") (defun electric-command-history () "\\Major mode for examining and redoing commands from `command-history'. This pops up a window with the Command History listing. The number of command listed is controlled by `list-command-history-max'. The command history is filtered by `list-command-history-filter' if non-nil. Combines typeout Command History list window with menu like selection of an expression from the history for re-evaluation in the *original* buffer. The history displayed is filtered by `list-command-history-filter' if non-nil. Like Emacs-Lisp mode except that characters do not insert themselves and Tab and Linefeed do not indent. Instead these commands are provided: \\{electric-history-map} Calls the value of `electric-command-history-hook' if that is non-nil. The Command History listing is recomputed each time this mode is invoked." (interactive) (let ((electric-history-in-progress t) (old-buffer (current-buffer)) (todo)) (unwind-protect (setq todo (catch 'electric-history-quit (save-window-excursion (save-window-excursion (list-command-history) (set-buffer "*Command History*") (Command-history-setup 'electric-command-history "Electric History" electric-history-map)) (Electric-pop-up-window "*Command History*") (run-hooks 'electric-command-history-hook) (if (eobp) (progn (ding) (message "No command history.") (throw 'electric-history-quit nil)) (let ((Helper-return-blurb "return to History")) (Electric-command-loop 'electric-history-quit "->" t)))))) (set-buffer "*Command History*") (Command-history-setup) (bury-buffer (current-buffer))) (if (consp todo) (progn (set-buffer old-buffer) (if (car todo) (apply (car (car (cdr todo))) (cdr (car (cdr todo)))) (edit-and-eval-command "Redo: " (car (cdr todo)))))))) (defun Electric-history-undefined () (interactive) (ding) (message (substitute-command-keys "Type \\[Helper-help] for help, ? for commands, C-c C-c to quit, Space to execute")) (sit-for 4)) (defun Electric-history-quit () "Quit Electric Command History, restoring previous window configuration." (interactive) (if (boundp 'electric-history-in-progress) (progn (message "") (throw 'electric-history-quit nil)))) ;;; echistory.el ends here emacs-19.30/lisp/edebug.el100444 12120 1 463662 6040231134 13676 0ustar rmsdaemon;;; edebug.el --- a source-level debugger for Emacs Lisp ;; Copyright (C) 1988,'89,'90,'91,'92,'93,'94,'95 Free Software Foundation, Inc ;; Author: Daniel LaLiberte ;; Keywords: lisp, tools, maint ;; LCD Archive Entry: ;; edebug|Daniel LaLiberte|liberte@cs.uiuc.edu ;; |A source level debugger for Emacs Lisp. ;; |$Date: 1995/08/27 17:52:46 $|$Revision: 3.5.1.22 $|~/modes/edebug.el| ;; 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 minor mode allows programmers to step through Emacs Lisp ;;; source code while executing functions. You can also set ;;; breakpoints, trace (stopping at each expression), evaluate ;;; expressions as if outside Edebug, reevaluate and display a list of ;;; expressions, trap errors normally caught by debug, and display a ;;; debug style backtrace. ;;;; Installation ;;; ============= ;;; Put edebug.el in some directory in your load-path and ;;; byte-compile it. Also read the beginning of edebug-epoch.el, ;;; cl-specs.el, and edebug-cl-read.el if they apply to you. ;;; Unless you are using Emacs 19 which is already set up to use Edebug, ;;; put the following forms in your .emacs file. ;;; (define-key emacs-lisp-mode-map "\C-xx" 'edebug-eval-top-level-form) ;;; (autoload 'edebug-eval-top-level-form "edebug") ;;; If you wish to change the default edebug global command prefix, change: ;;; (setq edebug-global-prefix "\C-xX") ;;; Other options, are described in the manual. ;;; In previous versions of Edebug, users were directed to set ;;; `debugger' to `edebug-debug'. This is no longer necessary ;;; since Edebug automatically sets it whenever Edebug is active. ;;;; Minimal Instructions ;;; ===================== ;;; First evaluate a defun with C-xx, then run the function. Step ;;; through the code with SPC, mark breakpoints with b, go until a ;;; breakpoint is reached with g, and quit execution with q. Use the ;;; "?" command in edebug to describe other commands. See edebug.tex ;;; or the Emacs 19 Lisp Reference Manual for more instructions. ;;; Send me your enhancements, ideas, bugs, or fixes. ;;; For bugs, you can call edebug-submit-bug-report if you have reporter.el. ;;; There is an edebug mailing list if you want to keep up ;;; with the latest developments. Requests to: edebug-request@cs.uiuc.edu ;;; Daniel LaLiberte 217-398-4114 ;;; University of Illinois, Urbana-Champaign ;;; Department of Computer Science ;;; 1304 W Springfield ;;; Urbana, IL 61801 ;;; uiucdcs!liberte ;;; liberte@cs.uiuc.edu ;;; =============================== ;;; For the early revision history, see edebug-history. (defconst edebug-version (let ((raw-version "$Revision: 3.5.1.22 $")) (substring raw-version (string-match "[0-9.]*" raw-version) (match-end 0)))) (require 'backquote) ;; Emacs 18 doesnt have defalias. (eval-and-compile (or (fboundp 'defalias) (fset 'defalias 'fset))) ;;;; Bug reporting ;;; ============== (defconst edebug-maintainer-address "liberte@cs.uiuc.edu") (defun edebug-submit-bug-report () "Submit, via mail, a bug report on edebug." (interactive) (require 'reporter) (and (y-or-n-p "Do you really want to submit a report on edebug? ") (reporter-submit-bug-report edebug-maintainer-address (concat "edebug.el " edebug-version) (list 'edebug-setup-hook 'edebug-all-defs 'edebug-all-forms 'edebug-eval-macro-args 'edebug-stop-before-symbols 'edebug-save-windows 'edebug-save-displayed-buffer-points 'edebug-initial-mode 'edebug-trace 'edebug-test-coverage 'edebug-continue-kbd-macro 'edebug-print-length 'edebug-print-level 'edebug-print-circle )))) ;;;; Options ;;; =============================== (defvar edebug-setup-hook nil "*Functions to call before edebug is used. Each time it is set to a new value, Edebug will call those functions once and then `edebug-setup-hook' is reset to nil. You could use this to load up Edebug specifications associated with a package you are using but only when you also use Edebug.") (defvar edebug-all-defs nil "*If non-nil, evaluation of any defining forms will instrument for Edebug. This applies to `eval-defun', `eval-region', `eval-buffer', and `eval-current-buffer'. `eval-region' is also called by `eval-last-sexp', and `eval-print-last-sexp'. You can use the command `edebug-all-defs' to toggle the value of this variable. You may wish to make it local to each buffer with \(make-local-variable 'edebug-all-defs) in your `emacs-lisp-mode-hook'.") (defvar edebug-all-forms nil "*Non-nil evaluation of all forms will instrument for Edebug. This doesn't apply to loading or evaluations in the minibuffer. Use the command `edebug-all-forms' to toggle the value of this option.") (defvar edebug-eval-macro-args nil "*Non-nil means all macro call arguments may be evaluated. If this variable is nil, the default, Edebug will *not* wrap macro call arguments as if they will be evaluated. For each macro, a `edebug-form-spec' overrides this option. So to specify exceptions for macros that have some arguments evaluated and some not, you should specify an `edebug-form-spec'. This option is going away soon.") (defvar edebug-stop-before-symbols nil "*Non-nil causes Edebug to stop before symbols as well as after. In any case, a breakpoint or interrupt may stop before a symbol. This option is going away soon.") (defvar edebug-save-windows t "*If non-nil, Edebug saves and restores the window configuration. That takes some time, so if your program does not care what happens to the window configurations, it is better to set this variable to nil. If the value is a list, only the listed windows are saved and restored. `edebug-toggle-save-windows' may be used to change this variable.") (defvar edebug-save-displayed-buffer-points nil "*If non-nil, save and restore point in all displayed buffers. Saving and restoring point in other buffers is necessary if you are debugging code that changes the point of a buffer which is displayed in a non-selected window. If Edebug or the user then selects the window, the buffer's point will be changed to the window's point. Saving and restoring point in all buffers is expensive, since it requires selecting each window twice, so enable this only if you need it.") (defvar edebug-initial-mode 'step "*Initial execution mode for Edebug, if non-nil. If this variable is non-@code{nil}, it specifies the initial execution mode for Edebug when it is first activated. Possible values are step, next, go, Go-nonstop, trace, Trace-fast, continue, and Continue-fast.") (defvar edebug-trace nil "*Non-nil means display a trace of function entry and exit. Tracing output is displayed in a buffer named `*edebug-trace*', one function entry or exit per line, indented by the recursion level. You can customize by replacing functions `edebug-print-trace-before' and `edebug-print-trace-after'.") (defvar edebug-test-coverage nil "*If non-nil, Edebug tests coverage of all expressions debugged. This is done by comparing the result of each expression with the previous result. Coverage is considered OK if two different results are found. Use `edebug-display-freq-count' to display the frequency count and coverage information for a definition.") (defvar edebug-continue-kbd-macro nil "*If non-nil, continue defining or executing any keyboard macro. Use this with caution since it is not debugged.") (defvar edebug-print-length 50 "*Default value of `print-length' to use while printing results in Edebug.") (defvar edebug-print-level 50 "*Default value of `print-level' to use while printing results in Edebug.") (defvar edebug-print-circle t "*Default value of `print-circle' to use while printing results in Edebug.") (defvar edebug-unwrap-results nil "*Non-nil if Edebug should unwrap results of expressions. This is useful when debugging macros where the results of expressions are instrumented expressions. But don't do this when results might be circular or an infinite loop will result.") (defvar edebug-on-error t "*Value bound to `debug-on-error' while Edebug is active. If `debug-on-error' is non-nil, that value is still used. If the value is a list of signal names, Edebug will stop when any of these errors are signaled from Lisp code whether or not the signal is handled by a `condition-case'. This option is useful for debugging signals that *are* handled since they would otherwise be missed. After execution is resumed, the error is signaled again.") (defvar edebug-on-quit t "*Value bound to `debug-on-quit' while Edebug is active.") (defvar edebug-global-break-condition nil "*If non-nil, an expression to test for at every stop point. If the result is non-nil, then break. Errors are ignored.") ;;;; Form spec utilities. ;;; =============================== ;;;###autoload (defmacro def-edebug-spec (symbol spec) "Set the edebug-form-spec property of SYMBOL according to SPEC. Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol \(naming a function), or a list." (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec))))) (defmacro def-edebug-form-spec (symbol spec-form) "For compatibility with old version. Use `def-edebug-spec' instead." (message "Obsolete: use def-edebug-spec instead.") (def-edebug-spec symbol (eval spec-form))) (defun get-edebug-spec (symbol) ;; Get the spec of symbol resolving all indirection. (let ((edebug-form-spec (get symbol 'edebug-form-spec)) indirect) (while (and (symbolp edebug-form-spec) (setq indirect (get edebug-form-spec 'edebug-form-spec))) ;; (edebug-trace "indirection: %s" edebug-form-spec) (setq edebug-form-spec indirect)) edebug-form-spec )) ;;;; Utilities ;;; =============================== ;; Define edebug-gensym - from old cl.el (defvar edebug-gensym-index 0 "Integer used by `edebug-gensym' to produce new names.") (defun edebug-gensym (&optional prefix) "Generate a fresh uninterned symbol. There is an optional argument, PREFIX. PREFIX is the string that begins the new name. Most people take just the default, except when debugging needs suggest otherwise." (if (null prefix) (setq prefix "G")) (let ((newsymbol nil) (newname "")) (while (not newsymbol) (setq newname (concat prefix (int-to-string edebug-gensym-index))) (setq edebug-gensym-index (+ edebug-gensym-index 1)) (if (not (intern-soft newname)) (setq newsymbol (make-symbol newname)))) newsymbol)) ;; Only used by CL-like code. (defun edebug-keywordp (object) "Return t if OBJECT is a keyword. A keyword is a symbol that starts with `:'." (and (symbolp object) (= ?: (aref (symbol-name object) 0)))) (defun edebug-lambda-list-keywordp (object) "Return t if OBJECT is a lambda list keyword. A lambda list keyword is a symbol that starts with `&'." (and (symbolp object) (= ?& (aref (symbol-name object) 0)))) (defun edebug-last-sexp () ;; Return the last sexp before point in current buffer. ;; Assumes Emacs Lisp syntax is active. (car (read-from-string (buffer-substring (save-excursion (forward-sexp -1) (point)) (point))))) (defun edebug-window-list () "Return a list of windows, in order of `next-window'." ;; This doesnt work for epoch. (let* ((first-window (selected-window)) (window-list (list first-window)) (next (next-window first-window))) (while (not (eq next first-window)) (setq window-list (cons next window-list)) (setq next (next-window next))) (nreverse window-list))) (defun edebug-window-live-p (window) "Return non-nil if WINDOW is visible." (let* ((first-window (selected-window)) (next (next-window first-window t))) (while (not (or (eq next window) (eq next first-window))) (setq next (next-window next t))) (eq next window))) ;; Not used. '(defun edebug-two-window-p () "Return t if there are two windows." (and (not (one-window-p)) (eq (selected-window) (next-window (next-window (selected-window)))))) (defsubst edebug-lookup-function (object) (while (and (symbolp object) (fboundp object)) (setq object (symbol-function object))) object) (defun edebug-macrop (object) "Return the macro named by OBJECT, or nil if it is not a macro." (setq object (edebug-lookup-function object)) (if (and (listp object) (eq 'macro (car object)) (edebug-functionp (cdr object))) object)) (defun edebug-functionp (object) "Returns the function named by OBJECT, or nil if it is not a function." (setq object (edebug-lookup-function object)) (if (or (subrp object) (byte-code-function-p object) (and (listp object) (eq (car object) 'lambda) (listp (car (cdr object))))) object)) (defun edebug-sort-alist (alist function) ;; Return the ALIST sorted with comparison function FUNCTION. ;; This uses 'sort so the sorting is destructive. (sort alist (function (lambda (e1 e2) (funcall function (car e1) (car e2)))))) ;;(def-edebug-spec edebug-save-restriction t) ;; Not used. If it is used, def-edebug-spec must be defined before use. '(defmacro edebug-save-restriction (&rest body) "Evaluate BODY while saving the current buffers restriction. BODY may change buffer outside of current restriction, unlike save-restriction. BODY may change the current buffer, and the restriction will be restored to the original buffer, and the current buffer remains current. Return the result of the last expression in BODY." (` (let ((edebug:s-r-beg (point-min-marker)) (edebug:s-r-end (point-max-marker))) (unwind-protect (progn (,@ body)) (save-excursion (set-buffer (marker-buffer edebug:s-r-beg)) (narrow-to-region edebug:s-r-beg edebug:s-r-end)))))) ;;;; Display ;;; ============ (defconst edebug-trace-buffer "*edebug-trace*" "Name of the buffer to put trace info in.") (defun edebug-pop-to-buffer (buffer &optional window) ;; Like pop-to-buffer, but select window where BUFFER was last shown. ;; Select WINDOW if it provided and it still exists. Otherwise, ;; if buffer is currently shown in several windows, choose one. ;; Otherwise, find a new window, possibly splitting one. (setq window (if (and (windowp window) (edebug-window-live-p window) (eq (window-buffer window) buffer)) window (if (eq (window-buffer (selected-window)) buffer) (selected-window) (edebug-get-buffer-window buffer)))) (if window (select-window window) (if (one-window-p) (split-window)) ;; (message "next window: %s" (next-window)) (sit-for 1) (if (eq (get-buffer-window edebug-trace-buffer) (next-window)) ;; Dont select trace window nil (select-window (next-window)))) (set-window-buffer (selected-window) buffer) (set-window-hscroll (selected-window) 0);; should this be?? ;; Selecting the window does not set the buffer until command loop. ;;(set-buffer buffer) ) (defun edebug-get-displayed-buffer-points () ;; Return a list of buffer point pairs, for all displayed buffers. (save-excursion (let* ((first-window (selected-window)) (next (next-window first-window)) (buffer-point-list nil) buffer) (while (not (eq next first-window)) (set-buffer (setq buffer (window-buffer next))) (setq buffer-point-list (cons (cons buffer (point)) buffer-point-list)) (setq next (next-window next))) buffer-point-list))) (defun edebug-set-buffer-points (buffer-points) ;; Restore the buffer-points created by edebug-get-displayed-buffer-points. (let ((current-buffer (current-buffer))) (mapcar (function (lambda (buf-point) (if (buffer-name (car buf-point)) ; still exists (progn (set-buffer (car buf-point)) (goto-char (cdr buf-point)))))) buffer-points) (set-buffer current-buffer))) (defun edebug-current-windows (which-windows) ;; Get either a full window configuration or some window information. (if (listp which-windows) (mapcar (function (lambda (window) (if (edebug-window-live-p window) (list window (window-buffer window) (window-point window) (window-start window) (window-hscroll window))))) which-windows) (current-window-configuration))) (defun edebug-set-windows (window-info) ;; Set either a full window configuration or some window information. (if (listp window-info) (mapcar (function (lambda (one-window-info) (if one-window-info (apply (function (lambda (window buffer point start hscroll) (if (edebug-window-live-p window) (progn (set-window-buffer window buffer) (set-window-point window point) (set-window-start window start) (set-window-hscroll window hscroll))))) one-window-info)))) window-info) (set-window-configuration window-info))) (defalias 'edebug-get-buffer-window 'get-buffer-window) (defalias 'edebug-sit-for 'sit-for) (defalias 'edebug-input-pending-p 'input-pending-p) ;;;; Redefine read and eval functions ;;; ================================= ;;; read is redefined to maybe instrument forms. ;;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs. ;;; Use the Lisp version of eval-region. (require 'eval-reg "eval-reg") ;; Save the original read function (or (fboundp 'edebug-original-read) (defalias 'edebug-original-read (symbol-function 'read))) (defun edebug-read (&optional stream) "Read one Lisp expression as text from STREAM, return as Lisp object. If STREAM is nil, use the value of `standard-input' (which see). STREAM or the value of `standard-input' may be: a buffer (read from point and advance it) a marker (read from where it points and advance it) a function (call it with no arguments for each character, call it with a char as argument to push a char back) a string (takes text from string, starting at the beginning) t (read text line using minibuffer and use it). This version, from Edebug, maybe instruments the expression. But the STREAM must be the current buffer to do so. Whether it instuments is also dependent on the values of `edebug-all-defs' and `edebug-all-forms'." (or stream (setq stream standard-input)) (if (eq stream (current-buffer)) (edebug-read-and-maybe-wrap-form) (edebug-original-read stream))) (or (fboundp 'edebug-original-eval-defun) (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun))) (defun edebug-eval-defun (edebug-it) "Evaluate the top-level form containing point, or after point. This version, from Edebug, has the following differences: With a prefix argument instrument the code for Edebug. If `edebug-all-defs' is non-nil, then the code is instrumented *unless* there is a prefix argument. If instrumenting, it prints: `Edebug: FUNCTIONNAME'. Otherwise, it prints in the minibuffer." (interactive "P") (let ((edebugging (not (eq (not edebug-it) (not edebug-all-defs)))) (edebug-result)) (setq edebug-result (eval (let ((edebug-all-forms edebugging) (edebug-all-defs (eq edebug-all-defs (not edebug-it)))) (edebug-read-top-level-form)))) (if (not edebugging) (princ edebug-result) edebug-result))) ;;;###autoload (defalias 'edebug-defun 'edebug-eval-top-level-form) ;;;###autoload (defun edebug-eval-top-level-form () "Evaluate a top level form, such as a defun or defmacro. This is like `eval-defun', but the code is always instrumented for Edebug. Print its name in the minibuffer and leave point where it is, or if an error occurs, leave point after it with mark at the original point." (interactive) (eval ;; Bind edebug-all-forms only while reading, not while evaling ;; but this causes problems while edebugging edebug. (let ((edebug-all-forms t) (edebug-all-defs t)) (edebug-read-top-level-form)))) (defun edebug-read-top-level-form () (let ((starting-point (point))) (end-of-defun) (beginning-of-defun) (prog1 (edebug-read-and-maybe-wrap-form) ;; Recover point, but only if no error occurred. (goto-char starting-point)))) ;; Compatibility with old versions. (defalias 'edebug-all-defuns 'edebug-all-defs) (defun edebug-all-defs () "Toggle edebugging of all definitions." (interactive) (setq edebug-all-defs (not edebug-all-defs)) (message "Edebugging all definitions is %s." (if edebug-all-defs "on" "off"))) (defun edebug-all-forms () "Toggle edebugging of all forms." (interactive) (setq edebug-all-forms (not edebug-all-forms)) (message "Edebugging all forms is %s." (if edebug-all-forms "on" "off"))) (defun edebug-install-read-eval-functions () (interactive) ;; Don't install if already installed. (if (eq (symbol-function 'read) 'edebug-read) nil (elisp-eval-region-install) (defalias 'read 'edebug-read) (defalias 'eval-defun 'edebug-eval-defun))) (defun edebug-uninstall-read-eval-functions () (interactive) (elisp-eval-region-uninstall) (defalias 'read (symbol-function 'edebug-original-read)) (defalias 'eval-defun (symbol-function 'edebug-original-eval-defun))) ;;;; Edebug internal data ;;; =============================== ;;; The internal data that is needed for edebugging is kept in the ;;; buffer-local variable `edebug-form-data'. (make-variable-buffer-local 'edebug-form-data) (defconst edebug-form-data nil) ;; A list of entries associating symbols with buffer regions. ;; This is an automatic buffer local variable. Each entry looks like: ;; @code{(@var{symbol} @var{begin-marker} @var{end-marker}). The markers ;; are at the beginning and end of an entry level form and @var{symbol} is ;; a symbol that holds all edebug related information for the form on its ;; property list. ;; In the future, the symbol will be irrelevant and edebug data will ;; be stored in the definitions themselves rather than in the property ;; list of a symbol. (defun edebug-make-form-data-entry (symbol begin end) (list symbol begin end)) (defsubst edebug-form-data-name (entry) (car entry)) (defsubst edebug-form-data-begin (entry) (nth 1 entry)) (defsubst edebug-form-data-end (entry) (nth 2 entry)) (defsubst edebug-set-form-data-entry (entry name begin end) (setcar entry name);; in case name is changed (set-marker (nth 1 entry) begin) (set-marker (nth 2 entry) end)) (defun edebug-get-form-data-entry (pnt &optional end-point) ;; Find the edebug form data entry which is closest to PNT. ;; If END-POINT is supplied, match must be exact. ;; Return `nil' if none found. (let ((rest edebug-form-data) closest-entry (closest-dist 999999)) ;; need maxint here (while (and rest (< 0 closest-dist)) (let* ((entry (car rest)) (begin (edebug-form-data-begin entry)) (dist (- pnt begin))) (setq rest (cdr rest)) (if (and (<= 0 dist) (< dist closest-dist) (or (not end-point) (= end-point (edebug-form-data-end entry))) (<= pnt (edebug-form-data-end entry))) (setq closest-dist dist closest-entry entry)))) closest-entry)) ;; Also need to find all contained entries, ;; and find an entry given a symbol, which should be just assq. (defun edebug-form-data-symbol () ;; Return the edebug data symbol of the form where point is in. ;; If point is not inside a edebuggable form, cause error. (or (edebug-form-data-name (edebug-get-form-data-entry (point))) (error "Not inside instrumented form"))) (defun edebug-make-top-form-data-entry (new-entry) ;; Make NEW-ENTRY the first element in the `edebug-form-data' list. (edebug-clear-form-data-entry new-entry) (setq edebug-form-data (cons new-entry edebug-form-data))) (defun edebug-clear-form-data-entry (entry) ;; If non-nil, clear ENTRY out of the form data. ;; Maybe clear the markers and delete the symbol's edebug property? (if entry (progn ;; Instead of this, we could just find all contained forms. ;; (put (car entry) 'edebug nil) ; ;; (mapcar 'edebug-clear-form-data-entry ; dangerous ;; (get (car entry) 'edebug-dependents)) ;; (set-marker (nth 1 entry) nil) ;; (set-marker (nth 2 entry) nil) (setq edebug-form-data (delq entry edebug-form-data))))) ;;;; Parser utilities ;;; =============================== (defun edebug-syntax-error (&rest args) ;; Signal an invalid-read-syntax with ARGS. (signal 'invalid-read-syntax args)) (defconst edebug-read-syntax-table ;; Lookup table for significant characters indicating the class of the ;; token that follows. This is not a \"real\" syntax table. (let ((table (make-vector 256 'symbol)) (i 0)) (while (< i ?!) (aset table i 'space) (setq i (1+ i))) (aset table ?\( 'lparen) (aset table ?\) 'rparen) (aset table ?\' 'quote) (aset table ?\" 'string) (aset table ?\? 'char) (aset table ?\[ 'lbracket) (aset table ?\] 'rbracket) (aset table ?\. 'dot) (aset table ?\# 'hash) ;; We treat numbers as symbols, because of confusion with -, -1, and 1-. ;; We dont care about any other chars since they wont be seen. table)) (defun edebug-next-token-class () ;; Move to the next token and return its class. We only care about ;; lparen, rparen, dot, quote, string, char, vector, or symbol. (edebug-skip-whitespace) (aref edebug-read-syntax-table (following-char))) (defun edebug-skip-whitespace () ;; Leave point before the next token, skipping white space and comments. (skip-chars-forward " \t\r\n\f") (while (= (following-char) ?\;) ;; \r is counted as a comment terminator to support selective display. (skip-chars-forward "^\n\r") ; skip the comment (skip-chars-forward " \t\r\n\f"))) ;; Mostly obsolete reader; still used in one case. (defun edebug-read-sexp () ;; Read one sexp from the current buffer starting at point. ;; Leave point immediately after it. A sexp can be a list or atom. ;; An atom is a symbol (or number), character, string, or vector. ;; This works for reading anything legitimate, but it ;; is gummed up by parser inconsistencies (bugs?) (let ((class (edebug-next-token-class))) (cond ;; read goes one too far if a (possibly quoted) string or symbol ;; is immediately followed by non-whitespace. ((eq class 'symbol) (prog1 (edebug-original-read (current-buffer)) (if (not (eq (aref edebug-read-syntax-table (preceding-char)) 'symbol)) (forward-char -1)))) ((eq class 'string) (prog1 (edebug-original-read (current-buffer)) (if (/= (preceding-char) ?\") (forward-char -1)))) ((eq class 'quote) (forward-char 1) (list 'quote (edebug-read-sexp))) (t ; anything else, just read it. (edebug-original-read (current-buffer)))))) ;;;; Offsets for reader ;;; ============================== ;; Define a structure to represent offset positions of expressions. ;; Each offset structure looks like: (before . after) for constituents, ;; or for structures that have elements: (before . after) ;; where the are the offset structures for subexpressions ;; including the head of a list. (defconst edebug-offsets nil) ;; Stack of offset structures in reverse order of the nesting. ;; This is used to get back to previous levels. (defconst edebug-offsets-stack nil) (defconst edebug-current-offset nil) ; Top of the stack, for convenience. ;; We must store whether we just read a list with a dotted form that ;; is itself a list. This structure will be condensed, so the offsets ;; must also be condensed. (defconst edebug-read-dotted-list nil) (defsubst edebug-initialize-offsets () ;; Reinitialize offset recording. (setq edebug-current-offset nil)) (defun edebug-store-before-offset (point) ;; Add a new offset pair with POINT as the before offset. (let ((new-offset (list point))) (if edebug-current-offset (setcdr edebug-current-offset (cons new-offset (cdr edebug-current-offset))) ;; Otherwise, we are at the top level, so initialize. (setq edebug-offsets new-offset edebug-offsets-stack nil edebug-read-dotted-list nil)) ;; Cons the new offset to the front of the stack. (setq edebug-offsets-stack (cons new-offset edebug-offsets-stack) edebug-current-offset new-offset) )) (defun edebug-store-after-offset (point) ;; Finalize the current offset struct by reversing it and ;; store POINT as the after offset. (if (not edebug-read-dotted-list) ;; Just reverse the offsets of all subexpressions. (setcdr edebug-current-offset (nreverse (cdr edebug-current-offset))) ;; We just read a list after a dot, which will be abbreviated out. (setq edebug-read-dotted-list nil) ;; Drop the corresponding offset pair. ;; That is, nconc the reverse of the rest of the offsets ;; with the cdr of last offset. (setcdr edebug-current-offset (nconc (nreverse (cdr (cdr edebug-current-offset))) (cdr (car (cdr edebug-current-offset)))))) ;; Now append the point using nconc. (setq edebug-current-offset (nconc edebug-current-offset point)) ;; Pop the stack. (setq edebug-offsets-stack (cdr edebug-offsets-stack) edebug-current-offset (car edebug-offsets-stack))) (defun edebug-ignore-offset () ;; Ignore the last created offset pair. (setcdr edebug-current-offset (cdr (cdr edebug-current-offset)))) (def-edebug-spec edebug-storing-offsets (form body)) (put 'edebug-storing-offsets 'lisp-indent-hook 1) (defmacro edebug-storing-offsets (point &rest body) (` (unwind-protect (progn (edebug-store-before-offset (, point)) (,@ body)) (edebug-store-after-offset (point))))) ;;;; Reader for Emacs Lisp. ;;; ========================================== ;; Uses edebug-next-token-class (and edebug-skip-whitespace) above. (defconst edebug-read-alist '((symbol . edebug-read-symbol) (lparen . edebug-read-list) (string . edebug-read-string) (quote . edebug-read-quote) (lbracket . edebug-read-vector) (hash . edebug-read-function) )) (defun edebug-read-storing-offsets (stream) (let ((class (edebug-next-token-class)) func edebug-read-dotted-list) ; see edebug-store-after-offset (edebug-storing-offsets (point) (if (setq func (assq class edebug-read-alist)) (funcall (cdr func) stream) ;; anything else, just read it. (edebug-original-read stream)) ))) (defun edebug-read-symbol (stream) (prog1 (edebug-original-read stream) ;; loses for escaped chars (if (not (eq (aref edebug-read-syntax-table (preceding-char)) 'symbol)) (forward-char -1)))) (defun edebug-read-string (stream) (prog1 (edebug-original-read stream) (if (/= (preceding-char) ?\") (forward-char -1)))) (defun edebug-read-quote (stream) ;; Turn 'thing into (quote thing) (forward-char 1) (list (edebug-storing-offsets (point) 'quote) (edebug-read-storing-offsets stream))) (defun edebug-read-function (stream) ;; Turn #'thing into (function thing) (forward-char 1) (if (/= ?\' (following-char)) (edebug-syntax-error "Bad char")) (forward-char 1) (list (edebug-storing-offsets (point) (if (featurep 'cl) 'function* 'function)) (edebug-read-storing-offsets stream))) (defun edebug-read-list (stream) (forward-char 1) ; skip \( (prog1 (let ((elements)) (while (not (memq (edebug-next-token-class) '(rparen dot))) (setq elements (cons (edebug-read-storing-offsets stream) elements))) (setq elements (nreverse elements)) (if (eq 'dot (edebug-next-token-class)) (let (dotted-form) (forward-char 1) ; skip \. (setq dotted-form (edebug-read-storing-offsets stream)) elements (nconc elements dotted-form) (if (not (eq (edebug-next-token-class) 'rparen)) (edebug-syntax-error "Expected `)'")) (setq edebug-read-dotted-list (listp dotted-form)) )) elements) (forward-char 1) ; skip \) )) (defun edebug-read-vector (stream) (forward-char 1) ; skip \[ (prog1 (let ((elements)) (while (not (eq 'rbracket (edebug-next-token-class))) (setq elements (cons (edebug-read-storing-offsets stream) elements))) (apply 'vector (nreverse elements))) (forward-char 1) ; skip \] )) ;;;; Cursors for traversal of list and vector elements with offsets. ;;;==================================================================== (defvar edebug-dotted-spec nil) (defun edebug-new-cursor (expressions offsets) ;; Return a new cursor for EXPRESSIONS with OFFSETS. (if (vectorp expressions) (setq expressions (append expressions nil))) (cons expressions offsets)) (defsubst edebug-set-cursor (cursor expressions offsets) ;; Set the CURSOR's EXPRESSIONS and OFFSETS to the given. ;; Return the cursor. (setcar cursor expressions) (setcdr cursor offsets) cursor) '(defun edebug-copy-cursor (cursor) ;; Copy the cursor using the same object and offsets. (cons (car cursor) (cdr cursor))) (defsubst edebug-cursor-expressions (cursor) (car cursor)) (defsubst edebug-cursor-offsets (cursor) (cdr cursor)) (defsubst edebug-empty-cursor (cursor) ;; Return non-nil if CURSOR is empty - meaning no more elements. (null (car cursor))) (defsubst edebug-top-element (cursor) ;; Return the top element at the cursor. ;; Assumes not empty. (car (car cursor))) (defun edebug-top-element-required (cursor &rest error) ;; Check if a dotted form is required. (if edebug-dotted-spec (edebug-no-match cursor "Dot expected.")) ;; Check if there is at least one more argument. (if (edebug-empty-cursor cursor) (apply 'edebug-no-match cursor error)) ;; Return that top element. (edebug-top-element cursor)) (defsubst edebug-top-offset (cursor) ;; Return the top offset pair corresponding to the top element. (car (cdr cursor))) (defun edebug-move-cursor (cursor) ;; Advance and return the cursor to the next element and offset. ;; throw no-match if empty before moving. ;; This is a violation of the cursor encapsulation, but ;; there is plenty of that going on while matching. ;; The following test should always fail. (if (edebug-empty-cursor cursor) (edebug-no-match cursor "Not enough arguments.")) (setcar cursor (cdr (car cursor))) (setcdr cursor (cdr (cdr cursor))) cursor) (defun edebug-before-offset (cursor) ;; Return the before offset of the cursor. ;; If there is nothing left in the offsets, ;; return one less than the offset itself, ;; which is the after offset for a list. (let ((offset (edebug-cursor-offsets cursor))) (if (consp offset) (car (car offset)) (1- offset)))) (defun edebug-after-offset (cursor) ;; Return the after offset of the cursor object. (let ((offset (edebug-top-offset cursor))) (while (consp offset) (setq offset (cdr offset))) offset)) ;;;; The Parser ;;; =============================== ;;; The top level function for parsing forms is ;;; edebug-read-and-maybe-wrap-form; it calls all the rest. It checks the ;;; syntax a bit and leaves point at any error it finds, but otherwise ;;; should appear to work like eval-defun. ;;; The basic plan is to surround each expression with a call to ;;; the edebug debugger together with indexes into a table of positions of ;;; all expressions. Thus an expression "exp" becomes: ;;; (edebug-after (edebug-before 1) 2 exp) ;;; When this is evaluated, first point is moved to the beginning of ;;; exp at offset 1 of the current function. The expression is ;;; evaluated, which may cause more edebug calls, and then point is ;;; moved to offset 2 after the end of exp. ;;; The highest level expressions of the function are wrapped in a call to ;;; edebug-enter, which supplies the function name and the actual ;;; arguments to the function. See functions edebug-enter, edebug-before, ;;; and edebug-after for more details. ;; Dynamically bound vars, left unbound, but globally declared. ;; This is to quiet the byte compiler. ;; Window data of the highest definition being wrapped. ;; This data is shared by all embedded definitions. (defvar edebug-top-window-data) (defvar edebug-&optional) (defvar edebug-&rest) (defvar edebug-gate nil) ;; whether no-match forces an error. (defconst edebug-def-name nil) ; name of definition, used by interactive-form (defconst edebug-old-def-name nil) ; previous name of containing definition. (defconst edebug-error-point nil) (defconst edebug-best-error nil) (defun edebug-read-and-maybe-wrap-form () ;; Read a form and wrap it with edebug calls, if the conditions are right. ;; Here we just catch any no-match not caught below and signal an error. ;; Run the setup hook. (run-hooks 'edebug-setup-hook) (setq edebug-setup-hook nil) (let (result edebug-top-window-data edebug-def-name;; make sure it is locally nil ;; I dont like these here!! edebug-&optional edebug-&rest edebug-gate edebug-best-error edebug-error-point no-match ;; Do this once here instead of several times. (max-lisp-eval-depth (+ 800 max-lisp-eval-depth)) (max-specpdl-size (+ 2000 max-specpdl-size))) (setq no-match (catch 'no-match (setq result (edebug-read-and-maybe-wrap-form1)) nil)) (if no-match (apply 'edebug-syntax-error no-match)) result)) (defun edebug-read-and-maybe-wrap-form1 () (let (spec def-kind defining-form-p def-name ;; These offset things dont belong here, but to support recursive ;; calls to edebug-read, they need to be here. edebug-offsets edebug-offsets-stack edebug-current-offset ; reset to nil ) (save-excursion (if (and (eq 'lparen (edebug-next-token-class)) (eq 'symbol (progn (forward-char 1) (edebug-next-token-class)))) ;; Find out if this is a defining form from first symbol (setq def-kind (edebug-original-read (current-buffer)) spec (and (symbolp def-kind) (get-edebug-spec def-kind)) defining-form-p (and (listp spec) (eq '&define (car spec))) ;; This is incorrect in general!! But OK most of the time. def-name (if (and defining-form-p (eq 'name (car (cdr spec))) (eq 'symbol (edebug-next-token-class))) (edebug-original-read (current-buffer)))))) ;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms) (cond (defining-form-p (if (or edebug-all-defs edebug-all-forms) ;; If it is a defining form and we are edebugging defs, ;; then let edebug-list-form start it. (let ((cursor (edebug-new-cursor (list (edebug-read-storing-offsets (current-buffer))) (list edebug-offsets)))) (car (edebug-make-form-wrapper cursor (edebug-before-offset cursor) (1- (edebug-after-offset cursor)) (list (cons (symbol-name def-kind) (cdr spec)))))) ;; Not edebugging this form, so reset the symbol's edebug ;; property to be just a marker at the definition's source code. ;; This only works for defs with simple names. (put def-name 'edebug (point-marker)) ;; Also nil out dependent defs. '(mapcar (function (lambda (def) (put def-name 'edebug nil))) (get def-name 'edebug-dependents)) (edebug-read-sexp))) ;; If all forms are being edebugged, explicitly wrap it. (edebug-all-forms (let ((cursor (edebug-new-cursor (list (edebug-read-storing-offsets (current-buffer))) (list edebug-offsets)))) (edebug-make-form-wrapper cursor (edebug-before-offset cursor) (edebug-after-offset cursor) nil))) ;; Not a defining form, and not edebugging. (t (edebug-read-sexp))) )) (defvar edebug-def-args) ; args of defining form. (defvar edebug-def-interactive) ; is it an emacs interactive function? (defvar edebug-inside-func) ;; whether code is inside function context. ;; Currently def-form sets this to nil; def-body sets it to t. (defun edebug-interactive-p-name () ;; Return a unique symbol for the variable used to store the ;; status of interactive-p for this function. (intern (format "edebug-%s-interactive-p" edebug-def-name))) (defun edebug-wrap-def-body (forms) "Wrap the FORMS of a definition body." (if edebug-def-interactive (` (let (((, (edebug-interactive-p-name)) (interactive-p))) (, (edebug-make-enter-wrapper forms)))) (edebug-make-enter-wrapper forms))) (defun edebug-make-enter-wrapper (forms) ;; Generate the enter wrapper for some forms of a definition. ;; This is not to be used for the body of other forms, e.g. `while', ;; since it wraps the list of forms with a call to `edebug-enter'. ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. ;; Do this after parsing since that may find a name. (setq edebug-def-name (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon"))) (` (edebug-enter (quote (, edebug-def-name)) (, (if edebug-inside-func (` (list (,@ ;; Doesnt work with more than one def-body!! ;; But the list will just be reversed. (nreverse edebug-def-args)))) 'nil)) (function (lambda () (,@ forms))) ))) (defvar edebug-form-begin-marker) ; the mark for def being instrumented (defvar edebug-offset-index) ; the next available offset index. (defvar edebug-offset-list) ; the list of offset positions. (defun edebug-inc-offset (offset) ;; modifies edebug-offset-index and edebug-offset-list ;; accesses edebug-func-marc and buffer point (prog1 edebug-offset-index (setq edebug-offset-list (cons (- offset edebug-form-begin-marker) edebug-offset-list) edebug-offset-index (1+ edebug-offset-index)))) (defun edebug-make-before-and-after-form (before-index form after-index) ;; Return the edebug form for the current function at offset BEFORE-INDEX ;; given FORM. Looks like: ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM) ;; Also increment the offset index for subsequent use. ;; if (not edebug-stop-before-symbols) and form is a symbol, ;; then dont call edebug-before. (list 'edebug-after (list 'edebug-before before-index) after-index form)) (defun edebug-make-after-form (form after-index) ;; Like edebug-make-before-and-after-form, but only after. (list 'edebug-after 0 after-index form)) (defun edebug-unwrap (sexp) "Return the unwrapped SEXP or return it as is if it is not wrapped. The SEXP might be the result of wrapping a body, which is a list of expressions; a `progn' form will be returned enclosing these forms." (if (consp sexp) (cond ((eq 'edebug-after (car sexp)) (nth 3 sexp)) ((eq 'edebug-enter (car sexp)) (let ((forms (nthcdr 2 (nth 1 (nth 3 sexp))))) (if (> (length forms) 1) (cons 'progn forms) ;; could return (values forms) instead. (car forms)))) (t sexp);; otherwise it is not wrapped, so just return it. ) sexp)) (defun edebug-unwrap* (sexp) "Return the sexp recursively unwrapped." (let ((new-sexp (edebug-unwrap sexp))) (while (not (eq sexp new-sexp)) (setq sexp new-sexp new-sexp (edebug-unwrap sexp))) (if (consp new-sexp) (mapcar 'edebug-unwrap* new-sexp) new-sexp))) (defun edebug-defining-form (cursor form-begin form-end speclist) ;; Process the defining form, starting outside the form. ;; The speclist is a generated list spec that looks like: ;; (("def-symbol" defining-form-spec-sans-&define)) ;; Skip the first offset. (edebug-set-cursor cursor (edebug-cursor-expressions cursor) (cdr (edebug-cursor-offsets cursor))) (edebug-make-form-wrapper cursor form-begin (1- form-end) speclist)) (defun edebug-make-form-wrapper (cursor form-begin form-end &optional speclist) ;; Wrap a form, usually a defining form, but any evaluated one. ;; If speclist is non-nil, this is being called by edebug-defining-form. ;; Otherwise it is being called from edebug-read-and-maybe-wrap-form1. ;; This is a hack, but I havent figured out a simpler way yet. (let* ((form-data-entry (edebug-get-form-data-entry form-begin form-end)) ;; Set this marker before parsing. (edebug-form-begin-marker (if form-data-entry (edebug-form-data-begin form-data-entry) ;; Buffer must be current-buffer for this to work: (set-marker (make-marker) form-begin)))) (let (edebug-offset-list (edebug-offset-index 0) result ;; For definitions. ;; (edebug-containing-def-name edebug-def-name) ;; Get name from form-data, if any. (edebug-old-def-name (edebug-form-data-name form-data-entry)) edebug-def-name edebug-def-args edebug-def-interactive edebug-inside-func;; whether wrapped code executes inside a function. ) (setq result (if speclist (edebug-match cursor speclist) ;; else wrap as an enter-form. (edebug-make-enter-wrapper (list (edebug-form cursor))))) ;; Set the name here if it was not set by edebug-make-enter-wrapper. (setq edebug-def-name (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon"))) ;; Add this def as a dependent of containing def. Buggy. '(if (and edebug-containing-def-name (not (get edebug-containing-def-name 'edebug-dependents))) (put edebug-containing-def-name 'edebug-dependents (cons edebug-def-name (get edebug-containing-def-name 'edebug-dependents)))) ;; Create a form-data-entry or modify existing entry's markers. ;; In the latter case, pointers to the entry remain eq. (if (not form-data-entry) (setq form-data-entry (edebug-make-form-data-entry edebug-def-name edebug-form-begin-marker ;; Buffer must be current-buffer. (set-marker (make-marker) form-end) )) (edebug-set-form-data-entry form-data-entry edebug-def-name ;; in case name is changed form-begin form-end)) ;; (message "defining: %s" edebug-def-name) (sit-for 2) (edebug-make-top-form-data-entry form-data-entry) (message "Edebug: %s" edebug-def-name) ;;(debug edebug-def-name) ;; Destructively reverse edebug-offset-list and make vector from it. (setq edebug-offset-list (vconcat (nreverse edebug-offset-list))) ;; Side effects on the property list of edebug-def-name. (edebug-clear-frequency-count edebug-def-name) (edebug-clear-coverage edebug-def-name) ;; Set up the initial window data. (if (not edebug-top-window-data) ;; if not already set, do it now. (let ((window ;; Find the best window for this buffer. (or (get-buffer-window (current-buffer)) (selected-window)))) (setq edebug-top-window-data (cons window (window-start window))))) ;; Store the edebug data in symbol's property list. (put edebug-def-name 'edebug ;; A struct or vector would be better here!! (list edebug-form-begin-marker nil ; clear breakpoints edebug-offset-list edebug-top-window-data )) result ))) (defun edebug-clear-frequency-count (name) ;; Create initial frequency count vector. ;; For each stop point, the counter is incremented each time it is visited. (put name 'edebug-freq-count (make-vector (length edebug-offset-list) 0))) (defun edebug-clear-coverage (name) ;; Create initial coverage vector. ;; Only need one per expression, but it is simpler to use stop points. (put name 'edebug-coverage (make-vector (length edebug-offset-list) 'unknown))) (defun edebug-form (cursor) ;; Return the instrumented form for the following form. ;; Add the point offsets to the edebug-offset-list for the form. (let* ((form (edebug-top-element-required cursor "Expected form")) (offset (edebug-top-offset cursor))) (prog1 (cond ((consp form) ;; The first offset for a list form is for the list form itself. (if (eq 'quote (car form)) form (let* ((head (car form)) (spec (and (symbolp head) (get-edebug-spec head))) (new-cursor (edebug-new-cursor form offset))) ;; Find out if this is a defining form from first symbol. ;; An indirect spec would not work here, yet. (if (and (consp spec) (eq '&define (car spec))) (edebug-defining-form new-cursor (car offset);; before the form (edebug-after-offset cursor) (cons (symbol-name head) (cdr spec))) ;; Wrap a regular form. (edebug-make-before-and-after-form (edebug-inc-offset (car offset)) (edebug-list-form new-cursor) ;; After processing the list form, the new-cursor is left ;; with the offset after the form. (edebug-inc-offset (edebug-cursor-offsets new-cursor)))) ))) ((symbolp form) (cond ;; Check for constant symbols that dont get wrapped. ((or (memq form '(t nil)) (and (fboundp 'edebug-keywordp) (edebug-keywordp form))) form) ;; This option may go away. (edebug-stop-before-symbols (edebug-make-before-and-after-form (edebug-inc-offset (car offset)) form (edebug-inc-offset (cdr offset)) )) (t ;; just a variable (edebug-make-after-form form (edebug-inc-offset (cdr offset)))))) ;; Anything else is self-evaluating. (t form)) (edebug-move-cursor cursor)))) (defsubst edebug-forms (cursor) (edebug-match cursor '(&rest form))) (defsubst edebug-sexps (cursor) (edebug-match cursor '(&rest sexp))) (defsubst edebug-list-form-args (head cursor) ;; Process the arguments of a list form given that head of form is a symbol. ;; Helper for edebug-list-form (let ((spec (get-edebug-spec head))) (cond (spec (cond ((consp spec) ;; It is a speclist. (let (edebug-best-error edebug-error-point);; This may not be needed. (edebug-match-sublist cursor spec))) ((eq t spec) (edebug-forms cursor)) ((eq 0 spec) (edebug-sexps cursor)) ((symbolp spec) (funcall spec cursor));; Not used by edebug, ; but leave it in for compatibility. )) ;; No edebug-form-spec provided. ((edebug-macrop head) (if edebug-eval-macro-args (edebug-forms cursor) (edebug-sexps cursor))) (t ;; Otherwise it is a function call. (edebug-forms cursor))))) (defun edebug-list-form (cursor) ;; Return an instrumented form built from the list form. ;; The after offset will be left in the cursor after processing the form. (let ((head (edebug-top-element-required cursor "Expected elements")) ;; Prevent backtracking whenever instrumenting. (edebug-gate t) ;; A list form is never optional because it matches anything. (edebug-&optional nil) (edebug-&rest nil)) ;; Skip the first offset. (edebug-set-cursor cursor (edebug-cursor-expressions cursor) (cdr (edebug-cursor-offsets cursor))) (cond ((null head) nil) ; () is legal. ((symbolp head) (cond ((null head) (edebug-syntax-error "nil head")) ((eq head 'interactive-p) ;; Special case: replace (interactive-p) with variable (setq edebug-def-interactive 'check-it) (edebug-move-cursor cursor) (edebug-interactive-p-name)) (t (cons head (edebug-list-form-args head (edebug-move-cursor cursor)))))) ((consp head) (if (and (listp head) (eq (car head) ',)) (edebug-match cursor '(("," def-form) body)) ;; Process anonymous function and args. ;; This assumes no anonymous macros. (edebug-match-specs cursor '(lambda-expr body) 'edebug-match-specs))) (t (edebug-syntax-error "Head of list form must be a symbol or lambda expression."))) )) ;;;; Matching of specs. ;;; =================== (defvar edebug-after-dotted-spec nil) (defvar edebug-matching-depth 0) ;; initial value (defconst edebug-max-depth 150) ;; maximum number of matching recursions. ;;;; Failure to match ;;; ================== ;; This throws to no-match, if there are higher alternatives. ;; Otherwise it signals an error. The place of the error is found ;; with the two before- and after-offset functions. (defun edebug-no-match (cursor &rest edebug-args) ;; Throw a no-match, or signal an error immediately if gate is active. ;; Remember this point in case we need to report this error. (setq edebug-error-point (or edebug-error-point (edebug-before-offset cursor)) edebug-best-error (or edebug-best-error edebug-args)) (if (and edebug-gate (not edebug-&optional)) (progn (if edebug-error-point (goto-char edebug-error-point)) (apply 'edebug-syntax-error edebug-args)) (funcall 'throw 'no-match edebug-args))) (defun edebug-match (cursor specs) ;; Top level spec matching function. ;; Used also at each lower level of specs. (let (edebug-&optional edebug-&rest edebug-best-error edebug-error-point (edebug-gate edebug-gate) ;; locally bound to limit effect ) (edebug-match-specs cursor specs 'edebug-match-specs))) (defun edebug-match-one-spec (cursor spec) ;; Match one spec, which is not a keyword &-spec. (cond ((symbolp spec) (edebug-match-symbol cursor spec)) ((vectorp spec) (edebug-match cursor (append spec nil))) ((stringp spec) (edebug-match-string cursor spec)) ((listp spec) (edebug-match-list cursor spec)) )) (defun edebug-match-specs (cursor specs remainder-handler) ;; Append results of matching the list of specs. ;; The first spec is handled and the remainder-handler handles the rest. (let ((edebug-matching-depth (if (> edebug-matching-depth edebug-max-depth) (error "too deep - perhaps infinite loop in spec?") (1+ edebug-matching-depth)))) (cond ((null specs) nil) ;; Is the spec dotted? ((atom specs) (let ((edebug-dotted-spec t));; Containing spec list was dotted. (edebug-match-specs cursor (list specs) remainder-handler))) ;; Is the form dotted? ((not (listp (edebug-cursor-expressions cursor)));; allow nil (if (not edebug-dotted-spec) (edebug-no-match cursor "Dotted spec required.")) ;; Cancel dotted spec and dotted form. (let ((edebug-dotted-spec) (this-form (edebug-cursor-expressions cursor)) (this-offset (edebug-cursor-offsets cursor))) ;; Wrap the form in a list, (by changing the cursor??)... (edebug-set-cursor cursor (list this-form) this-offset) ;; and process normally, then unwrap the result. (car (edebug-match-specs cursor specs remainder-handler)))) (t;; Process normally. (let* ((spec (car specs)) (rest) (first-char (and (symbolp spec) (aref (symbol-name spec) 0)))) ;;(message "spec = %s first char = %s" spec first-char) (sit-for 1) (nconc (cond ((eq ?& first-char);; "&" symbols take all following specs. (funcall (get-edebug-spec spec) cursor (cdr specs))) ((eq ?: first-char);; ":" symbols take one following spec. (setq rest (cdr (cdr specs))) (funcall (get-edebug-spec spec) cursor (car (cdr specs)))) (t;; Any other normal spec. (setq rest (cdr specs)) (edebug-match-one-spec cursor spec))) (funcall remainder-handler cursor rest remainder-handler))))))) ;; Define specs for all the symbol specs with functions used to process them. ;; Perhaps we shouldnt be doing this with edebug-form-specs since the ;; user may want to define macros or functions with the same names. ;; We could use an internal obarray for these primitive specs. (mapcar (function (lambda (pair) (put (car pair) 'edebug-form-spec (cdr pair)))) '((&optional . edebug-match-&optional) (&rest . edebug-match-&rest) (&or . edebug-match-&or) (form . edebug-match-form) (sexp . edebug-match-sexp) (body . edebug-match-body) (&define . edebug-match-&define) (name . edebug-match-name) (:name . edebug-match-colon-name) (arg . edebug-match-arg) (def-body . edebug-match-def-body) (def-form . edebug-match-def-form) ;; Less frequently used: ;; (function . edebug-match-function) (lambda-expr . edebug-match-lambda-expr) (¬ . edebug-match-¬) (&key . edebug-match-&key) (place . edebug-match-place) (gate . edebug-match-gate) ;; (nil . edebug-match-nil) not this one - special case it. )) (defun edebug-match-symbol (cursor symbol) ;; Match a symbol spec. (let* ((spec (get-edebug-spec symbol))) (cond (spec (if (consp spec) ;; It is an indirect spec. (edebug-match cursor spec) ;; Otherwise it should be the symbol name of a function. ;; There could be a bug here - maybe need to do edebug-match bindings. (funcall spec cursor))) ((null symbol) ;; special case this. (edebug-match-nil cursor)) ((fboundp symbol) ; is it a predicate? (let ((sexp (edebug-top-element-required cursor "Expected" symbol))) ;; Special case for edebug-`. (if (and (listp sexp) (eq (car sexp) ',)) (edebug-match cursor '(("," def-form))) (if (not (funcall symbol sexp)) (edebug-no-match cursor symbol "failed")) (edebug-move-cursor cursor) (list sexp)))) (t (error "%s is not a form-spec or function" symbol)) ))) (defun edebug-match-sexp (cursor) (list (prog1 (edebug-top-element-required cursor "Expected sexp") (edebug-move-cursor cursor)))) (defun edebug-match-form (cursor) (list (edebug-form cursor))) (defalias 'edebug-match-place 'edebug-match-form) ;; Currently identical to edebug-match-form. ;; This is for common lisp setf-style place arguments. (defsubst edebug-match-body (cursor) (edebug-forms cursor)) (defun edebug-match-&optional (cursor specs) ;; Keep matching until one spec fails. (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper)) (defun edebug-&optional-wrapper (cursor specs remainder-handler) (let (result (edebug-&optional specs) (edebug-gate nil) (this-form (edebug-cursor-expressions cursor)) (this-offset (edebug-cursor-offsets cursor))) (if (null (catch 'no-match (setq result (edebug-match-specs cursor specs remainder-handler)) ;; Returning nil means no no-match was thrown. nil)) result ;; no-match, but don't fail; just reset cursor and return nil. (edebug-set-cursor cursor this-form this-offset) nil))) (defun edebug-&rest-wrapper (cursor specs remainder-handler) (if (null specs) (setq specs edebug-&rest)) ;; Reuse the &optional handler with this as the remainder handler. (edebug-&optional-wrapper cursor specs remainder-handler)) (defun edebug-match-&rest (cursor specs) ;; Repeatedly use specs until failure. (let ((edebug-&rest specs) ;; remember these edebug-best-error edebug-error-point) (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper))) (defun edebug-match-&or (cursor specs) ;; Keep matching until one spec succeeds, and return its results. ;; If none match, fail. ;; This needs to be optimized since most specs spend time here. (let ((original-specs specs) (this-form (edebug-cursor-expressions cursor)) (this-offset (edebug-cursor-offsets cursor))) (catch 'matched (while specs (catch 'no-match (throw 'matched (let (edebug-gate ;; only while matching each spec edebug-best-error edebug-error-point) ;; Doesnt support e.g. &or symbolp &rest form (edebug-match-one-spec cursor (car specs))))) ;; Match failed, so reset and try again. (setq specs (cdr specs)) ;; Reset the cursor for the next match. (edebug-set-cursor cursor this-form this-offset)) ;; All failed. (apply 'edebug-no-match cursor "Expected one of" original-specs)) )) (defun edebug-match-¬ (cursor specs) ;; If any specs match, then fail (if (null (catch 'no-match (let ((edebug-gate nil)) (save-excursion (edebug-match-&or cursor specs))) nil)) ;; This means something matched, so it is a no match. (edebug-no-match cursor "Unexpected")) ;; This means nothing matched, so it is OK. nil) ;; So, return nothing (def-edebug-spec &key edebug-match-&key) (defun edebug-match-&key (cursor specs) ;; Following specs must look like ( ) ... ;; where is the name of a keyword, and spec is its spec. ;; This really doesnt save much over the expanded form and takes time. (edebug-match-&rest cursor (cons '&or (mapcar (function (lambda (pair) (vector (format ":%s" (car pair)) (car (cdr pair))))) specs)))) (defun edebug-match-gate (cursor) ;; Simply set the gate to prevent backtracking at this level. (setq edebug-gate t) nil) (defun edebug-match-list (cursor specs) ;; The spec is a list, but what kind of list, and what context? (if edebug-dotted-spec ;; After dotted spec but form did not contain dot, ;; so match list spec elements as if spliced in. (prog1 (let ((edebug-dotted-spec)) (edebug-match-specs cursor specs 'edebug-match-specs)) ;; If it matched, really clear the dotted-spec flag. (setq edebug-dotted-spec nil)) (let ((spec (car specs)) (form (edebug-top-element-required cursor "Expected" specs))) (cond ((eq 'quote spec) (let ((spec (car (cdr specs)))) (cond ((symbolp spec) ;; Special case: spec quotes a symbol to match. ;; Change in future. Use "..." instead. (if (not (eq spec form)) (edebug-no-match cursor "Expected" spec)) (edebug-move-cursor cursor) (setq edebug-gate t) form) (t (error "Bad spec: %s" specs))))) ((listp form) (prog1 (list (edebug-match-sublist ;; First offset is for the list form itself. ;; Treat nil as empty list. (edebug-new-cursor form (cdr (edebug-top-offset cursor))) specs)) (edebug-move-cursor cursor))) ((and (eq 'vector spec) (vectorp form)) ;; Special case: match a vector with the specs. (let ((result (edebug-match-sublist (edebug-new-cursor form (cdr (edebug-top-offset cursor))) (cdr specs)))) (edebug-move-cursor cursor) (list (apply 'vector result)))) (t (edebug-no-match cursor "Expected" specs))) ))) (defun edebug-match-sublist (cursor specs) ;; Match a sublist of specs. (let (edebug-&optional ;;edebug-best-error ;;edebug-error-point ) (prog1 ;; match with edebug-match-specs so edebug-best-error is not bound. (edebug-match-specs cursor specs 'edebug-match-specs) (if (not (edebug-empty-cursor cursor)) (if edebug-best-error (apply 'edebug-no-match cursor edebug-best-error) ;; A failed &rest or &optional spec may leave some args. (edebug-no-match cursor "Failed matching" specs) ))))) (defun edebug-match-string (cursor spec) (let ((sexp (edebug-top-element-required cursor "Expected" spec))) (if (not (eq (intern spec) sexp)) (edebug-no-match cursor "Expected" spec) ;; Since it matched, failure means immediate error, unless &optional. (setq edebug-gate t) (edebug-move-cursor cursor) (list sexp) ))) (defun edebug-match-nil (cursor) ;; There must be nothing left to match a nil. (if (not (edebug-empty-cursor cursor)) (edebug-no-match cursor "Unmatched argument(s)") nil)) (defun edebug-match-function (cursor) (error "Use function-form instead of function in edebug spec")) (defun edebug-match-&define (cursor specs) ;; Match a defining form. ;; Normally, &define is interpretted specially other places. ;; This should only be called inside of a spec list to match the remainder ;; of the current list. e.g. ("lambda" &define args def-body) (edebug-make-form-wrapper cursor (edebug-before-offset cursor) ;; Find the last offset in the list. (let ((offsets (edebug-cursor-offsets cursor))) (while (consp offsets) (setq offsets (cdr offsets))) offsets) specs)) (defun edebug-match-lambda-expr (cursor) ;; The expression must be a function. ;; This will match any list form that begins with a symbol ;; that has an edebug-form-spec beginning with &define. In ;; practice, only lambda expressions should be used. ;; I could add a &lambda specification to avoid confusion. (let* ((sexp (edebug-top-element-required cursor "Expected lambda expression")) (offset (edebug-top-offset cursor)) (head (and (consp sexp) (car sexp))) (spec (and (symbolp head) (get-edebug-spec head))) (edebug-inside-func nil)) ;; Find out if this is a defining form from first symbol. (if (and (consp spec) (eq '&define (car spec))) (prog1 (list (edebug-defining-form (edebug-new-cursor sexp offset) (car offset);; before the sexp (edebug-after-offset cursor) (cons (symbol-name head) (cdr spec)))) (edebug-move-cursor cursor)) (edebug-no-match cursor "Expected lambda expression") ))) (defun edebug-match-name (cursor) ;; Set the edebug-def-name bound in edebug-defining-form. (let ((name (edebug-top-element-required cursor "Expected name"))) ;; Maybe strings and numbers could be used. (if (not (symbolp name)) (edebug-no-match cursor "Symbol expected for name of definition")) (setq edebug-def-name (if edebug-def-name ;; Construct a new name by appending to previous name. (intern (format "%s@%s" edebug-def-name name)) name)) (edebug-move-cursor cursor) (list name))) (defun edebug-match-colon-name (cursor spec) ;; Set the edebug-def-name to the spec. (setq edebug-def-name (if edebug-def-name ;; Construct a new name by appending to previous name. (intern (format "%s@%s" edebug-def-name spec)) spec)) nil) (defun edebug-match-arg (cursor) ;; set the def-args bound in edebug-defining-form (let ((edebug-arg (edebug-top-element-required cursor "Expected arg"))) (if (or (not (symbolp edebug-arg)) (edebug-lambda-list-keywordp edebug-arg)) (edebug-no-match cursor "Bad argument:" edebug-arg)) (edebug-move-cursor cursor) (setq edebug-def-args (cons edebug-arg edebug-def-args)) (list edebug-arg))) (defun edebug-match-def-form (cursor) ;; Like form but the form is wrapped in edebug-enter form. ;; The form is assumed to be executing outside of the function context. ;; This is a hack for now, since a def-form might execute inside as well. ;; Not to be used otherwise. (let ((edebug-inside-func nil)) (list (edebug-make-enter-wrapper (list (edebug-form cursor)))))) (defun edebug-match-def-body (cursor) ;; Like body but body is wrapped in edebug-enter form. ;; The body is assumed to be executing inside of the function context. ;; Not to be used otherwise. (let ((edebug-inside-func t)) (list (edebug-wrap-def-body (edebug-forms cursor))))) ;;;; Edebug Form Specs ;;; ========================================================== ;;; See cl-specs.el for common lisp specs. ;;;;* Spec for def-edebug-spec ;;; Out of date. (defun edebug-spec-p (object) "Return non-nil if OBJECT is a symbol with an edebug-form-spec property." (and (symbolp object) (get object 'edebug-form-spec))) (def-edebug-spec def-edebug-spec ;; Top level is different from lower levels. (&define :name edebug-spec name &or "nil" edebug-spec-p "t" "0" (&rest edebug-spec))) (def-edebug-spec edebug-spec-list ;; A list must have something in it, or it is nil, a symbolp ((edebug-spec . [&or nil edebug-spec]))) (def-edebug-spec edebug-spec (&or (vector &rest edebug-spec) ; matches a vector ("vector" &rest edebug-spec) ; matches a vector spec ("quote" symbolp) edebug-spec-list stringp [edebug-lambda-list-keywordp &rest edebug-spec] ;; [edebug-keywordp gate edebug-spec] ;; need edebug-keywordp for this. edebug-spec-p ;; Including all the special ones e.g. form. symbolp;; a predicate )) ;;;;* Emacs special forms and some functions. ;; quote expects only one argument, although it allows any number. (def-edebug-spec quote sexp) ;; The standard defining forms. (def-edebug-spec defconst defvar) (def-edebug-spec defvar (symbolp &optional form stringp)) (def-edebug-spec defun (&define name lambda-list [&optional stringp] [&optional ("interactive" interactive)] def-body)) (def-edebug-spec defmacro (&define name lambda-list def-body)) (def-edebug-spec arglist lambda-list) ;; denegrated - use lambda-list. (def-edebug-spec lambda-list (([&rest arg] [&optional ["&optional" arg &rest arg]] &optional ["&rest" arg] ))) (def-edebug-spec interactive (&optional &or stringp def-form)) ;; A function-form is for an argument that may be a function or a form. ;; This specially recognizes anonymous functions quoted with quote. (def-edebug-spec function-form ;; form at the end could also handle "function", ;; but recognize it specially to avoid wrapping function forms. (&or ([&or "quote" "function"] &or symbolp lambda-expr) form)) ;; function expects a symbol or a lambda or macro expression ;; A macro is allowed by Emacs. (def-edebug-spec function (&or symbolp lambda-expr)) ;; lambda is a macro in emacs 19. (def-edebug-spec lambda (&define lambda-list [&optional stringp] [&optional ("interactive" interactive)] def-body)) ;; A macro expression is a lambda expression with "macro" prepended. (def-edebug-spec macro (&define "lambda" lambda-list def-body)) ;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro]))) ;; Standard functions that take function-forms arguments. (def-edebug-spec mapcar (function-form form)) (def-edebug-spec mapconcat (function-form form form)) (def-edebug-spec mapatoms (function-form &optional form)) (def-edebug-spec apply (function-form &rest form)) (def-edebug-spec funcall (function-form &rest form)) (def-edebug-spec let ((&rest &or (symbolp &optional form) symbolp) body)) (def-edebug-spec let* let) (def-edebug-spec setq (&rest symbolp form)) (def-edebug-spec setq-default setq) (def-edebug-spec cond (&rest (&rest form))) (def-edebug-spec condition-case (symbolp form &rest (symbolp body))) (def-edebug-spec \` (backquote-form)) ;; Supports quotes inside backquotes, ;; but only at the top level inside unquotes. (def-edebug-spec backquote-form (&or ([&or "," ",@"] &or ("quote" backquote-form) form) (backquote-form &rest backquote-form) ;; If you use dotted forms in backquotes, replace the previous line ;; with the following. This takes quite a bit more stack space, however. ;; (backquote-form . [&or nil backquote-form]) (vector &rest backquote-form) sexp)) ;; Special version of backquote that instruments backquoted forms ;; destined to be evaluated, usually as the result of a ;; macroexpansion. Backquoted code can only have unquotes (, and ,@) ;; in places where list forms are allowed, and predicates. If the ;; backquote is used in a macro, unquoted code that come from ;; arguments must be instrumented, if at all, with def-form not def-body. ;; We could assume that all forms (not nested in other forms) ;; in arguments of macros should be def-forms, whether or not the macros ;; are defined with edebug-` but this would be expensive. ;; ,@ might have some problems. (defalias 'edebug-\` '\`) ;; same macro as regular backquote. (def-edebug-spec edebug-\` (def-form)) ;; Assume immediate quote in unquotes mean backquote at next higher level. (def-edebug-spec , (&or ("quote" edebug-`) def-form)) (def-edebug-spec ,@ (&define ;; so (,@ form) is never wrapped. &or ("quote" edebug-`) def-form)) ;; New byte compiler. (def-edebug-spec defsubst defun) (def-edebug-spec dont-compile t) (def-edebug-spec eval-when-compile t) (def-edebug-spec eval-and-compile t) ;; Anything else? ;;==================== ;; Some miscellaneous specs for macros in public packages. ;; Send me yours. ;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu) (def-edebug-spec ad-dolist ((symbolp form &optional form) body)) (def-edebug-spec defadvice (&define name ;; thing being advised. (name ;; class is [&or "before" "around" "after" ;; "activation" "deactivation"] name ;; name of advice &rest sexp ;; optional position and flags ) [&optional stringp] [&optional ("interactive" interactive)] def-body)) ;;;; The debugger itself ;;; =============================== (defvar edebug-active nil) ;; Non-nil when edebug is active ;;; add minor-mode-alist entry (or (assq 'edebug-active minor-mode-alist) (setq minor-mode-alist (cons (list 'edebug-active " *Debugging*") minor-mode-alist))) (defvar edebug-stack nil) ;; Stack of active functions evaluated via edebug. ;; Should be nil at the top level. (defvar edebug-stack-depth -1) ;; Index of last edebug-stack item. (defvar edebug-offset-indices nil) ;; Stack of offset indices of visited edebug sexps. ;; Should be nil at the top level. ;; Each function adds one cons. Top is modified with setcar. (defvar edebug-entered nil ;; Non-nil if edebug has already been entered at this recursive edit level. ;; This should stay nil at the top level. ) ;; Should these be options? (defconst edebug-debugger 'edebug ;; Name of function to use for debugging when error or quit occurs. ;; Set this to 'debug if you want to debug edebug. ) ;; Dynamically bound variables, declared globally but left unbound. (defvar edebug-function) ; the function being executed. change name!! (defvar edebug-args) ; the arguments of the function (defvar edebug-data) ; the edebug data for the function (defvar edebug-value) ; the result of the expression (defvar edebug-after-index) (defvar edebug-def-mark) ; the mark for the definition (defvar edebug-freq-count) ; the count of expression visits. (defvar edebug-coverage) ; the coverage results of each expression of function. (defvar edebug-buffer) ; which buffer the function is in. (defvar edebug-result) ; the result of the function call returned by body (defvar edebug-outside-executing-macro) (defvar edebug-outside-defining-kbd-macro) (defvar edebug-execution-mode 'step) ; Current edebug mode set by user. (defvar edebug-next-execution-mode nil) ; Use once instead of initial mode. (defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside (defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside (defvar edebug-outside-pre-command-hook) (defvar edebug-outside-post-command-hook) (defvar edebug-outside-post-command-idle-hook) ;; Emacs 19 (defvar pre-command-hook nil) (defvar post-command-hook nil) (defvar post-command-idle-hook nil) (defvar cl-lexical-debug) ;; Defined in cl.el ;;; Handling signals ;;; ================= (if (not (fboundp 'edebug-original-signal)) (defalias 'edebug-original-signal (symbol-function 'signal))) ;; We should use advise for this!! (defun edebug-signal (edebug-signal-name edebug-signal-data) "Signal an error. Args are SIGNAL-NAME, and associated DATA. A signal name is a symbol with an `error-conditions' property that is a list of condition names. A handler for any of those names will get to handle this signal. The symbol `error' should always be one of them. DATA should be a list. Its elements are printed as part of the error message. If the signal is handled, DATA is made available to the handler. See `condition-case'. This is the Edebug replacement for the standard `signal'. It should only be active while Edebug is. It checks `debug-on-error' to see whether it should call the debugger. When execution is resumed, the error is signaled again." (if (and (listp debug-on-error) (memq edebug-signal-name debug-on-error)) (edebug 'error (cons edebug-signal-name edebug-signal-data))) ;; If we reach here without another non-local exit, then send signal again. ;; i.e. the signal is not continuable, yet. (edebug-original-signal edebug-signal-name edebug-signal-data)) ;;; Entering Edebug ;;; ================== (defun edebug-enter (edebug-function edebug-args edebug-body) ;; Entering FUNC. The arguments are ARGS, and the body is BODY. ;; Setup edebug variables and evaluate BODY. This function is called ;; when a function evaluated with edebug-eval-top-level-form is entered. ;; Return the result of BODY. ;; Is this the first time we are entering edebug since ;; lower-level recursive-edit command? ;; More precisely, this tests whether Edebug is currently active. (if (not edebug-entered) (let ((edebug-entered t) ;; Binding max-lisp-eval-depth here is OK, ;; but not inside an unwind-protect. ;; Doing it here also keeps it from growing too large. (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much?? (max-specpdl-size (+ 200 max-specpdl-size)) (debugger edebug-debugger) ; only while edebug is active. (edebug-outside-debug-on-error debug-on-error) (edebug-outside-debug-on-quit debug-on-quit) ;; Binding these may not be the right thing to do. ;; We want to allow the global values to be changed. (debug-on-error (or debug-on-error edebug-on-error)) (debug-on-quit edebug-on-quit) ;; Lexical bindings must be uncompiled for this to work. (cl-lexical-debug t) ;; Save the outside value of executing macro. (here??) (edebug-outside-executing-macro executing-macro) (edebug-outside-pre-command-hook pre-command-hook) (edebug-outside-post-command-hook post-command-hook) (edebug-outside-post-command-idle-hook post-command-idle-hook)) (unwind-protect (let (;; Don't keep reading from an executing kbd macro ;; within edebug unless edebug-continue-kbd-macro is ;; non-nil. Again, local binding may not be best. (executing-macro (if edebug-continue-kbd-macro executing-macro)) ;; Disable command hooks. This is essential when ;; a hook function is instrumented - to avoid infinite loop. ;; This may be more than we need, however. (pre-command-hook nil) (post-command-hook nil) (post-command-idle-hook nil)) (setq edebug-execution-mode (or edebug-next-execution-mode edebug-initial-mode edebug-execution-mode) edebug-next-execution-mode nil) ;; Bind signal to edebug-signal only while Edebug is active. (fset 'signal 'edebug-signal) (unwind-protect (edebug-enter edebug-function edebug-args edebug-body) (fset 'signal (symbol-function 'edebug-original-signal)))) ;; Reset global variables in case outside value was changed. (setq executing-macro edebug-outside-executing-macro pre-command-hook edebug-outside-pre-command-hook post-command-hook edebug-outside-post-command-hook post-command-idle-hook edebug-outside-post-command-idle-hook ))) (let* ((edebug-data (get edebug-function 'edebug)) (edebug-def-mark (car edebug-data)) ; mark at def start (edebug-freq-count (get edebug-function 'edebug-freq-count)) (edebug-coverage (get edebug-function 'edebug-coverage)) (edebug-buffer (marker-buffer edebug-def-mark)) (edebug-stack (cons edebug-function edebug-stack)) (edebug-offset-indices (cons 0 edebug-offset-indices)) ) (if (get edebug-function 'edebug-on-entry) (progn (setq edebug-execution-mode 'step) (if (eq (get edebug-function 'edebug-on-entry) 'temp) (put edebug-function 'edebug-on-entry nil)))) (if edebug-trace (edebug-enter-trace edebug-body) (funcall edebug-body)) ))) (defun edebug-enter-trace (edebug-body) (let ((edebug-stack-depth (1+ edebug-stack-depth)) edebug-result) (edebug-print-trace-before (format "%s args: %s" edebug-function edebug-args)) (prog1 (setq edebug-result (funcall edebug-body)) (edebug-print-trace-after (format "%s result: %s" edebug-function edebug-result))))) (def-edebug-spec edebug-tracing (form body)) (defmacro edebug-tracing (msg &rest body) "Print MSG in *edebug-trace* before and after evaluating BODY. The result of BODY is also printed." (` (let ((edebug-stack-depth (1+ edebug-stack-depth)) edebug-result) (edebug-print-trace-before (, msg)) (prog1 (setq edebug-result (progn (,@ body))) (edebug-print-trace-after (format "%s result: %s" (, msg) edebug-result)))))) (defun edebug-print-trace-before (msg) "Function called to print trace info before expression evaluation. MSG is printed after `::::{ '." (edebug-trace-display edebug-trace-buffer "%s{ %s" (make-string edebug-stack-depth ?\:) msg)) (defun edebug-print-trace-after (msg) "Function called to print trace info after expression evaluation. MSG is printed after `::::} '." (edebug-trace-display edebug-trace-buffer "%s} %s" (make-string edebug-stack-depth ?\:) msg)) (defun edebug-slow-before (edebug-before-index) ;; Debug current function given BEFORE position. ;; Called from functions compiled with edebug-eval-top-level-form. ;; Return the before index. (setcar edebug-offset-indices edebug-before-index) ;; Increment frequency count (aset edebug-freq-count edebug-before-index (1+ (aref edebug-freq-count edebug-before-index))) (if (or (not (memq edebug-execution-mode '(Go-nonstop next))) (edebug-input-pending-p)) (edebug-debugger edebug-before-index 'before nil)) edebug-before-index) (defun edebug-fast-before (edebug-before-index) ;; Do nothing. ) (defun edebug-slow-after (edebug-before-index edebug-after-index edebug-value) ;; Debug current function given AFTER position and VALUE. ;; Called from functions compiled with edebug-eval-top-level-form. ;; Return VALUE. (setcar edebug-offset-indices edebug-after-index) ;; Increment frequency count (aset edebug-freq-count edebug-after-index (1+ (aref edebug-freq-count edebug-after-index))) (if edebug-test-coverage (edebug-update-coverage)) (if (and (eq edebug-execution-mode 'Go-nonstop) (not (edebug-input-pending-p))) ;; Just return result. edebug-value (edebug-debugger edebug-after-index 'after edebug-value) )) (defun edebug-fast-after (edebug-before-index edebug-after-index edebug-value) ;; Do nothing but return the value. edebug-value) (defun edebug-run-slow () (defalias 'edebug-before 'edebug-slow-before) (defalias 'edebug-after 'edebug-slow-after)) ;; This is not used, yet. (defun edebug-run-fast () (defalias 'edebug-before 'edebug-fast-before) (defalias 'edebug-after 'edebug-fast-after)) (edebug-run-slow) (defun edebug-update-coverage () (let ((old-result (aref edebug-coverage edebug-after-index))) (cond ((eq 'ok-coverage old-result)) ((eq 'unknown old-result) (aset edebug-coverage edebug-after-index edebug-value)) ;; Test if a different result. ((not (eq edebug-value old-result)) (aset edebug-coverage edebug-after-index 'ok-coverage))))) ;; Dynamically declared unbound variables. (defvar edebug-arg-mode) ; the mode, either before, after, or error (defvar edebug-breakpoints) (defvar edebug-break-data) ; break data for current function. (defvar edebug-break) ; whether a break occurred. (defvar edebug-global-break) ; whether a global break occurred. (defvar edebug-break-condition) ; whether the breakpoint is conditional. (defvar edebug-break-result nil) (defvar edebug-global-break-result nil) (defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-value) ;; Check breakpoints and pending input. ;; If edebug display should be updated, call edebug-display. ;; Return edebug-value. (let* (;; This needs to be here since breakpoints may be changed. (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints (edebug-break-data (assq edebug-offset-index edebug-breakpoints)) (edebug-break-condition (car (cdr edebug-break-data))) (edebug-global-break (if edebug-global-break-condition (condition-case nil (setq edebug-global-break-result (eval edebug-global-break-condition)) (error nil)))) (edebug-break)) ;;; (edebug-trace "exp: %s" edebug-value) ;; Test whether we should break. (setq edebug-break (or edebug-global-break (and edebug-break-data (or (not edebug-break-condition) (setq edebug-break-result (eval edebug-break-condition)))))) (if (and edebug-break (nth 2 edebug-break-data)) ; is it temporary? ;; Delete the breakpoint. (setcdr edebug-data (cons (delq edebug-break-data edebug-breakpoints) (cdr (cdr edebug-data))))) ;; Display if mode is not go, continue, or Continue-fast ;; or break, or input is pending, (if (or (not (memq edebug-execution-mode '(go continue Continue-fast))) edebug-break (edebug-input-pending-p)) (edebug-display)) ; <--------------- display edebug-value )) ;; window-start now stored with each function. ;;(defvar edebug-window-start nil) ;; Remember where each buffers' window starts between edebug calls. ;; This is to avoid spurious recentering. ;; Does this still need to be buffer-local?? ;;(setq-default edebug-window-start nil) ;;(make-variable-buffer-local 'edebug-window-start) ;; Dynamically declared unbound vars (defvar edebug-point) ; the point in edebug buffer (defvar edebug-outside-buffer) ; the current-buffer outside of edebug (defvar edebug-outside-point) ; the point outside of edebug (defvar edebug-outside-mark) ; the mark outside of edebug (defvar edebug-window-data) ; window and window-start for current function (defvar edebug-outside-windows) ; outside window configuration (defvar edebug-eval-buffer) ; for the evaluation list. (defvar edebug-outside-o-a-p) ; outside overlay-arrow-position (defvar edebug-outside-o-a-s) ; outside overlay-arrow-string (defvar edebug-outside-c-i-e-a) ; outside cursor-in-echo-area (defvar edebug-eval-list nil) ;; List of expressions to evaluate. (defvar edebug-previous-result nil) ;; Last result returned. ;; Emacs 19 adds an arg to mark and mark-marker. (defalias 'edebug-mark 'mark) (defalias 'edebug-mark-marker 'mark-marker) (defun edebug-display () ;; Setup windows for edebug, determine mode, maybe enter recursive-edit. ;; Uses local variables of edebug-enter, edebug-before, edebug-after ;; and edebug-debugger. (let ((edebug-active t) ; for minor mode alist edebug-stop ; should we enter recursive-edit (edebug-point (+ edebug-def-mark (aref (nth 2 edebug-data) edebug-offset-index))) edebug-buffer-outside-point ; current point in edebug-buffer ;; window displaying edebug-buffer (edebug-window-data (nth 3 edebug-data)) (edebug-outside-window (selected-window)) (edebug-outside-buffer (current-buffer)) (edebug-outside-point (point)) (edebug-outside-mark (edebug-mark)) edebug-outside-windows ; window or screen configuration edebug-buffer-points edebug-eval-buffer ; declared here so we can kill it below (edebug-eval-result-list (and edebug-eval-list (edebug-eval-result-list))) edebug-trace-window edebug-trace-window-start (edebug-outside-o-a-p overlay-arrow-position) (edebug-outside-o-a-s overlay-arrow-string) (edebug-outside-c-i-e-a cursor-in-echo-area)) (unwind-protect (let ((overlay-arrow-position overlay-arrow-position) (overlay-arrow-string overlay-arrow-string) (cursor-in-echo-area nil) ;; any others?? ) (if (not (buffer-name edebug-buffer)) (let ((debug-on-error nil)) (error "Buffer defining %s not found" edebug-function))) (if (eq 'after edebug-arg-mode) ;; Compute result string now before windows are modified. (edebug-compute-previous-result edebug-value)) (if edebug-save-windows ;; Save windows now before we modify them. (setq edebug-outside-windows (edebug-current-windows edebug-save-windows))) (if edebug-save-displayed-buffer-points (setq edebug-buffer-points (edebug-get-displayed-buffer-points))) ;; First move the edebug buffer point to edebug-point ;; so that window start doesnt get changed when we display it. ;; I dont know if this is going to help. ;;(set-buffer edebug-buffer) ;;(goto-char edebug-point) ;; If edebug-buffer is not currently displayed, ;; first find a window for it. (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)) (setcar edebug-window-data (selected-window)) ;; Now display eval list, if any. ;; This is done after the pop to edebug-buffer ;; so that buffer-window correspondence is correct after quitting. (edebug-eval-display edebug-eval-result-list) ;; The evaluation list better not have deleted edebug-window-data. (select-window (car edebug-window-data)) (set-buffer edebug-buffer) (setq edebug-buffer-outside-point (point)) (goto-char edebug-point) (if (eq 'before edebug-arg-mode) ;; Check whether positions are up-to-date. ;; This assumes point is never before symbol. (if (not (memq (following-char) '(?\( ?\# ?\` ))) (let ((debug-on-error nil)) (error "Source has changed - reevaluate definition of %s" edebug-function) ))) (setcdr edebug-window-data (edebug-adjust-window (cdr edebug-window-data))) ;; Test if there is input, not including keyboard macros. (if (edebug-input-pending-p) (progn (setq edebug-execution-mode 'step edebug-stop t) (edebug-stop) ;; (discard-input) ; is this unfriendly?? )) ;; Now display arrow based on mode. (edebug-overlay-arrow) (cond ((eq 'error edebug-arg-mode) ;; Display error message (setq edebug-execution-mode 'step) (edebug-overlay-arrow) (beep) (if (eq 'quit (car edebug-value)) (message "Quit") (edebug-report-error edebug-value))) (edebug-break (cond (edebug-global-break (message "Global Break: %s => %s" edebug-global-break-condition edebug-global-break-result)) (edebug-break-condition (message "Break: %s => %s" edebug-break-condition edebug-break-result)) ((not (eq edebug-execution-mode 'Continue-fast)) (message "Break")) (t))) (t (message ""))) (if (eq 'after edebug-arg-mode) (progn ;; Display result of previous evaluation. (if (and edebug-break (not (eq edebug-execution-mode 'Continue-fast))) (sit-for 1)) ; Show break message. (edebug-previous-result))) (cond (edebug-break (cond ((eq edebug-execution-mode 'continue) (edebug-sit-for 1)) ((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0)) (t (setq edebug-stop t)))) ;; not edebug-break ((eq edebug-execution-mode 'trace) (edebug-sit-for 1)) ; Force update and pause. ((eq edebug-execution-mode 'Trace-fast) (edebug-sit-for 0)) ; Force update and continue. ) (unwind-protect (if (or edebug-stop (memq edebug-execution-mode '(step next)) (eq edebug-arg-mode 'error)) (progn ;; (setq edebug-execution-mode 'step) ;; (edebug-overlay-arrow) ; this doesnt always show up. (edebug-recursive-edit))) ; <---------- Recursive edit ;; Reset the edebug-window-data to whatever it is now. (let ((window (if (eq (window-buffer) edebug-buffer) (selected-window) (edebug-get-buffer-window edebug-buffer)))) ;; Remember window-start for edebug-buffer, if still displayed. (if window (progn (setcar edebug-window-data window) (setcdr edebug-window-data (window-start window))))) ;; Save trace window point before restoring outside windows. ;; Could generalize this for other buffers. (setq edebug-trace-window (get-buffer-window edebug-trace-buffer)) (if edebug-trace-window (setq edebug-trace-window-start (and edebug-trace-window (window-start edebug-trace-window)))) ;; Restore windows before continuing. (if edebug-save-windows (progn (edebug-set-windows edebug-outside-windows) ;; Restore displayed buffer points. ;; Needed even if restoring windows because ;; window-points are not restored. (should they be??) (if edebug-save-displayed-buffer-points (edebug-set-buffer-points edebug-buffer-points)) ;; Unrestore trace window's window-point. (if edebug-trace-window (set-window-start edebug-trace-window edebug-trace-window-start)) ;; Unrestore edebug-buffer's window-start, if displayed. (let ((window (car edebug-window-data))) (if (and window (edebug-window-live-p window) (eq (window-buffer) edebug-buffer)) (progn (set-window-start window (cdr edebug-window-data) 'no-force) ;; Unrestore edebug-buffer's window-point. ;; Needed in addition to setting the buffer point ;; - otherwise quitting doesnt leave point as is. ;; But this causes point to not be restored at times. ;; Also, it may not be a visible window. ;; (set-window-point window edebug-point) ))) ;; Unrestore edebug-buffer's point. Rerestored below. ;; (goto-char edebug-point) ;; in edebug-buffer ) ;; Since we may be in a save-excursion, in case of quit, ;; reselect the outside window only. ;; Only needed if we are not recovering windows?? (if (edebug-window-live-p edebug-outside-window) (select-window edebug-outside-window)) ) ; if edebug-save-windows ;; Restore current buffer always, in case application needs it. (set-buffer edebug-outside-buffer) ;; Restore point, and mark. ;; Needed even if restoring windows because ;; that doesnt restore point and mark in the current buffer. ;; But dont restore point if edebug-buffer is current buffer. (if (not (eq edebug-buffer edebug-outside-buffer)) (goto-char edebug-outside-point)) (if (marker-buffer (edebug-mark-marker)) ;; Does zmacs-regions need to be nil while doing set-marker? (set-marker (edebug-mark-marker) edebug-outside-mark)) ) ; unwind-protect ;; None of the following is done if quit or signal occurs. ;; Restore edebug-buffer's outside point. ;; (edebug-trace "restore edebug-buffer point: %s" ;; edebug-buffer-outside-point) (let ((current-buffer (current-buffer))) (set-buffer edebug-buffer) (goto-char edebug-buffer-outside-point) (set-buffer current-buffer)) ;; ... nothing more. ) ;; Reset global variables to outside values in case they were changed. (setq overlay-arrow-position edebug-outside-o-a-p overlay-arrow-string edebug-outside-o-a-s cursor-in-echo-area edebug-outside-c-i-e-a) ))) (defvar edebug-number-of-recursions 0) ;; Number of recursive edits started by edebug. ;; Should be 0 at the top level. (defvar edebug-recursion-depth 0) ;; Value of recursion-depth when edebug was called. ;; Dynamically declared unbound vars (defvar edebug-outside-match-data) ; match data outside of edebug (defvar edebug-backtrace-buffer) ; each recursive edit gets its own (defvar edebug-inside-windows) (defvar edebug-interactive-p) (defvar edebug-outside-map) (defvar edebug-outside-standard-output) (defvar edebug-outside-standard-input) (defvar edebug-outside-last-command-char) (defvar edebug-outside-last-command) (defvar edebug-outside-this-command) (defvar edebug-outside-last-input-char) ;; Note: here we have defvars for variables that are ;; built-in in certain versions. ;; Each defvar makes a difference ;; in versions where the variable is *not* built-in. ;; Emacs 18 (defvar edebug-outside-unread-command-char) ;; Lucid Emacs (defvar edebug-outside-unread-command-event) ;; like unread-command-events (defvar unread-command-event nil) ;; Emacs 19. (defvar edebug-outside-last-command-event) (defvar edebug-outside-unread-command-events) (defvar edebug-outside-last-input-event) (defvar edebug-outside-last-event-frame) (defvar edebug-outside-last-nonmenu-event) (defvar edebug-outside-track-mouse) ;; Disable byte compiler warnings about unread-command-char and -event ;; (maybe works with byte-compile-version 2.22 at least) (defvar edebug-unread-command-char-warning) (defvar edebug-unread-command-event-warning) (eval-when-compile (setq edebug-unread-command-char-warning (get 'unread-command-char 'byte-obsolete-variable)) (put 'unread-command-char 'byte-obsolete-variable nil) (setq edebug-unread-command-event-warning (get 'unread-command-event 'byte-obsolete-variable)) (put 'unread-command-event 'byte-obsolete-variable nil)) (defun edebug-recursive-edit () ;; Start up a recursive edit inside of edebug. ;; The current buffer is the edebug-buffer, which is put into edebug-mode. ;; Assume that none of the variables below are buffer-local. (let ((edebug-buffer-read-only buffer-read-only) ;; match-data must be done in the outside buffer (edebug-outside-match-data (save-excursion ; might be unnecessary now?? (set-buffer edebug-outside-buffer) ; in case match buffer different (match-data))) ;;(edebug-number-of-recursions (1+ edebug-number-of-recursions)) (edebug-recursion-depth (recursion-depth)) edebug-entered ; bind locally to nil (edebug-interactive-p nil) ; again non-interactive edebug-backtrace-buffer ; each recursive edit gets its own ;; The window configuration may be saved and restored ;; during a recursive-edit edebug-inside-windows (edebug-outside-map (current-local-map)) (edebug-outside-standard-output standard-output) (edebug-outside-standard-input standard-input) (edebug-outside-defining-kbd-macro defining-kbd-macro) (edebug-outside-last-command-char last-command-char) (edebug-outside-last-command last-command) (edebug-outside-this-command this-command) (edebug-outside-last-input-char last-input-char) (edebug-outside-unread-command-char unread-command-char) (edebug-outside-last-input-event last-input-event) (edebug-outside-last-command-event last-command-event) (edebug-outside-unread-command-event unread-command-event) (edebug-outside-unread-command-events unread-command-events) (edebug-outside-last-event-frame last-event-frame) (edebug-outside-last-nonmenu-event last-nonmenu-event) (edebug-outside-track-mouse track-mouse) ) (unwind-protect (let ( ;; Declare global values local but using the same global value. ;; We could set these to the values for previous edebug call. (last-command-char last-command-char) (last-command last-command) (this-command this-command) (last-input-char last-input-char) ;; Assume no edebug command sets unread-command-char. (unread-command-char -1) ;; More for Emacs 19 (last-input-event nil) (last-command-event nil) (unread-command-event nil);; lemacs (unread-command-events nil) (last-event-frame nil) (last-nonmenu-event nil) (track-mouse nil) ;; Bind again to outside values. (debug-on-error edebug-outside-debug-on-error) (debug-on-quit edebug-outside-debug-on-quit) ;; Don't keep defining a kbd macro. (defining-kbd-macro (if edebug-continue-kbd-macro defining-kbd-macro)) ;; others?? ) (if (fboundp 'zmacs-deactivate-region);; for lemacs (zmacs-deactivate-region)) (if (and (eq edebug-execution-mode 'go) (not (memq edebug-arg-mode '(after error)))) (message "Break")) (setq buffer-read-only t) (fset 'signal (symbol-function 'edebug-original-signal)) (edebug-mode) (unwind-protect (recursive-edit) ; <<<<<<<<<< Recursive edit ;; Do the following, even if quit occurs. (fset 'signal 'edebug-signal) (if edebug-backtrace-buffer (kill-buffer edebug-backtrace-buffer)) ;; Could be an option to keep eval display up. (if edebug-eval-buffer (kill-buffer edebug-eval-buffer)) ;; Remember selected-window after recursive-edit. ;; (setq edebug-inside-window (selected-window)) (store-match-data edebug-outside-match-data) ;; Recursive edit may have changed buffers, ;; so set it back before exiting let. (if (buffer-name edebug-buffer) ; if it still exists (progn (set-buffer edebug-buffer) (if (memq edebug-execution-mode '(go Go-nonstop)) (edebug-overlay-arrow)) (setq buffer-read-only edebug-buffer-read-only) (use-local-map edebug-outside-map) ) ;; gotta have a buffer to let its buffer local variables be set (get-buffer-create " bogus edebug buffer")) ));; inner let ;; Reset global vars to outside values, in case they have been changed. (setq last-command-char edebug-outside-last-command-char last-command-event edebug-outside-last-command-event last-command edebug-outside-last-command this-command edebug-outside-this-command unread-command-char edebug-outside-unread-command-char unread-command-event edebug-outside-unread-command-event unread-command-events edebug-outside-unread-command-events last-input-char edebug-outside-last-input-char last-input-event edebug-outside-last-input-event last-event-frame edebug-outside-last-event-frame last-nonmenu-event edebug-outside-last-nonmenu-event track-mouse edebug-outside-track-mouse standard-output edebug-outside-standard-output standard-input edebug-outside-standard-input defining-kbd-macro edebug-outside-defining-kbd-macro )) )) ;;; Display related functions ;;; =============================== (defun edebug-adjust-window (old-start) ;; If pos is not visible, adjust current window to fit following context. ;;; (message "window: %s old-start: %s window-start: %s pos: %s" ;;; (selected-window) old-start (window-start) (point)) (sit-for 5) (if (not (pos-visible-in-window-p)) (progn ;; First try old-start (if old-start (set-window-start (selected-window) old-start)) (if (not (pos-visible-in-window-p)) (progn ;; (message "resetting window start") (sit-for 2) (set-window-start (selected-window) (save-excursion (forward-line (if (< (point) (window-start)) -1 ; one line before if in back (- (/ (window-height) 2)) ; center the line moving forward )) (beginning-of-line) (point))))))) (window-start)) (defconst edebug-arrow-alist '((Continue-fast . "=") (Trace-fast . "-") (continue . ">") (trace . "->") (step . "=>") (next . "=>") (go . "<>") (Go-nonstop . "..") ; not used ) "Association list of arrows for each edebug mode.") (defun edebug-overlay-arrow () ;; Set up the overlay arrow at beginning-of-line in current buffer. ;; The arrow string is derived from edebug-arrow-alist and ;; edebug-execution-mode. (let ((pos (save-excursion (beginning-of-line) (point)))) (setq overlay-arrow-string (cdr (assq edebug-execution-mode edebug-arrow-alist))) (setq overlay-arrow-position (make-marker)) (set-marker overlay-arrow-position pos (current-buffer)))) (defun edebug-toggle-save-all-windows () "Toggle the saving and restoring of all windows. Also, each time you toggle it on, the inside and outside window configurations become the same as the current configuration." (interactive) (setq edebug-save-windows (not edebug-save-windows)) (if edebug-save-windows (setq edebug-inside-windows (setq edebug-outside-windows (edebug-current-windows edebug-save-windows)))) (message "Window saving is %s for all windows." (if edebug-save-windows "on" "off"))) (defmacro edebug-changing-windows (&rest body) (` (let ((window (selected-window))) (setq edebug-inside-windows (edebug-current-windows t)) (edebug-set-windows edebug-outside-windows) (,@ body) ;; Code to change edebug-save-windows (setq edebug-outside-windows (edebug-current-windows edebug-save-windows)) ;; Problem: what about outside windows that are deleted inside? (edebug-set-windows edebug-inside-windows)))) (defun edebug-toggle-save-selected-window () "Toggle the saving and restoring of the selected window. Also, each time you toggle it on, the inside and outside window configurations become the same as the current configuration." (interactive) (cond ((eq t edebug-save-windows) ;; Save all outside windows except the selected one. ;; Remove (selected-window) from outside-windows. (edebug-changing-windows (setq edebug-save-windows (delq window (edebug-window-list))))) ((memq (selected-window) edebug-save-windows) (setq edebug-outside-windows (delq (assq (selected-window) edebug-outside-windows) edebug-outside-windows)) (setq edebug-save-windows (delq (selected-window) edebug-save-windows))) (t ; Save a new window. (edebug-changing-windows (setq edebug-save-windows (cons window edebug-save-windows))))) (message "Window saving is %s for %s." (if (memq (selected-window) edebug-save-windows) "on" "off") (selected-window))) (defun edebug-toggle-save-windows (arg) "Toggle the saving and restoring of windows. With prefix, toggle for just the selected window. Otherwise, toggle for all windows." (interactive "P") (if arg (edebug-toggle-save-selected-window) (edebug-toggle-save-all-windows))) (defun edebug-where () "Show the debug windows and where we stopped in the program." (interactive) (if (not edebug-active) (error "Edebug is not active")) ;; Restore the window configuration to what it last was inside. ;; But it is not always set. - experiment ;;(if edebug-inside-windows ;; (edebug-set-windows edebug-inside-windows)) (edebug-pop-to-buffer edebug-buffer) (goto-char edebug-point)) (defun edebug-view-outside () "Change to the outside window configuration." (interactive) (if (not edebug-active) (error "Edebug is not active")) (setq edebug-inside-windows (edebug-current-windows edebug-save-windows)) (edebug-set-windows edebug-outside-windows) (goto-char edebug-outside-point) (message "Window configuration outside of Edebug. Return with %s" (substitute-command-keys "\\\\[edebug-where]"))) (defun edebug-bounce-point (arg) "Bounce the point in the outside current buffer. If prefix arg is supplied, sit for that many seconds before returning. The default is one second." (interactive "p") (if (not edebug-active) (error "Edebug is not active")) (save-excursion ;; If the buffer's currently displayed, avoid set-window-configuration. (save-window-excursion (edebug-pop-to-buffer edebug-outside-buffer) (goto-char edebug-outside-point) (message "Current buffer: %s Point: %s Mark: %s" (current-buffer) (point) (if (marker-buffer (edebug-mark-marker)) (marker-position (edebug-mark-marker)) "")) (edebug-sit-for arg) (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))))) ;; Joe Wells, here is a start at your idea of adding a buffer to the internal ;; display list. Still need to use this list in edebug-display. '(defvar edebug-display-buffer-list nil "List of buffers that edebug will display when it is active.") '(defun edebug-display-buffer (buffer) "Toggle display of a buffer inside of edebug." (interactive "bBuffer: ") (let ((already-displaying (memq buffer edebug-display-buffer-list))) (setq edebug-display-buffer-list (if already-displaying (delq buffer edebug-display-buffer-list) (cons buffer edebug-display-buffer-list))) (message "Displaying %s %s" buffer (if already-displaying "off" "on")))) ;;; Breakpoint related functions ;;; =============================== (defun edebug-find-stop-point () ;; Return (function . index) of the nearest edebug stop point. (let* ((edebug-def-name (edebug-form-data-symbol)) (edebug-data (let ((data (get edebug-def-name 'edebug))) (if (or (null data) (markerp data)) (error "%s is not instrumented for Edebug" edebug-def-name)) data)) ; we could do it automatically, if data is a marker. ;; pull out parts of edebug-data. (edebug-def-mark (car edebug-data)) ;; (edebug-breakpoints (car (cdr edebug-data))) (offset-vector (nth 2 edebug-data)) (offset (- (save-excursion (if (looking-at "[ \t]") ;; skip backwards until non-whitespace, or bol (skip-chars-backward " \t")) (point)) edebug-def-mark)) len i) ;; the offsets are in order so we can do a linear search (setq len (length offset-vector)) (setq i 0) (while (and (< i len) (> offset (aref offset-vector i))) (setq i (1+ i))) (if (and (< i len) (<= offset (aref offset-vector i))) ;; return the relevant info (cons edebug-def-name i) (message "Point is not on an expression in %s." edebug-def-name) ))) (defun edebug-next-breakpoint () "Move point to the next breakpoint, or first if none past point." (interactive) (let ((edebug-stop-point (edebug-find-stop-point))) (if edebug-stop-point (let* ((edebug-def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) (edebug-data (get edebug-def-name 'edebug)) ;; pull out parts of edebug-data (edebug-def-mark (car edebug-data)) (edebug-breakpoints (car (cdr edebug-data))) (offset-vector (nth 2 edebug-data)) breakpoint) (if (not edebug-breakpoints) (message "No breakpoints in this function.") (let ((breaks edebug-breakpoints)) (while (and breaks (<= (car (car breaks)) index)) (setq breaks (cdr breaks))) (setq breakpoint (if breaks (car breaks) ;; goto the first breakpoint (car edebug-breakpoints))) (goto-char (+ edebug-def-mark (aref offset-vector (car breakpoint)))) (message (concat (if (nth 2 breakpoint) "Temporary " "") (if (car (cdr breakpoint)) (format "Condition: %s" (edebug-safe-prin1-to-string (car (cdr breakpoint)))) ""))) )))))) (defun edebug-modify-breakpoint (flag &optional condition temporary) "Modify the breakpoint for the form at point or after it according to FLAG: set if t, clear if nil. Then move to that point. If CONDITION or TEMPORARY are non-nil, add those attributes to the breakpoint. " (let ((edebug-stop-point (edebug-find-stop-point))) (if edebug-stop-point (let* ((edebug-def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) (edebug-data (get edebug-def-name 'edebug)) ;; pull out parts of edebug-data (edebug-def-mark (car edebug-data)) (edebug-breakpoints (car (cdr edebug-data))) (offset-vector (nth 2 edebug-data)) present) ;; delete it either way (setq present (assq index edebug-breakpoints)) (setq edebug-breakpoints (delq present edebug-breakpoints)) (if flag (progn ;; add it to the list and resort (setq edebug-breakpoints (edebug-sort-alist (cons (list index condition temporary) edebug-breakpoints) '<)) (if condition (message "Breakpoint set in %s with condition: %s" edebug-def-name condition) (message "Breakpoint set in %s" edebug-def-name))) (if present (message "Breakpoint unset in %s" edebug-def-name) (message "No breakpoint here"))) (setcar (cdr edebug-data) edebug-breakpoints) (goto-char (+ edebug-def-mark (aref offset-vector index))) )))) (defun edebug-set-breakpoint (arg) "Set the breakpoint of nearest sexp. With prefix argument, make it a temporary breakpoint." (interactive "P") (edebug-modify-breakpoint t nil arg)) (defun edebug-unset-breakpoint () "Clear the breakpoint of nearest sexp." (interactive) (edebug-modify-breakpoint nil)) ;; For emacs 18, no read-expression-history (defun edebug-set-conditional-breakpoint (arg condition) "Set a conditional breakpoint at nearest sexp. The condition is evaluated in the outside context. With prefix argument, make it a temporary breakpoint." ;; (interactive "P\nxCondition: ") (interactive (list current-prefix-arg ;; Edit previous condition as follows, but it is cumbersome: (let ((edebug-stop-point (edebug-find-stop-point))) (if edebug-stop-point (let* ((edebug-def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) (edebug-data (get edebug-def-name 'edebug)) (edebug-breakpoints (car (cdr edebug-data))) (edebug-break-data (assq index edebug-breakpoints)) (edebug-break-condition (car (cdr edebug-break-data)))) (read-minibuffer (format "Condition in %s: " edebug-def-name) (if edebug-break-condition (format "%s" edebug-break-condition) (format "")))))))) (edebug-modify-breakpoint t condition arg)) (defun edebug-set-global-break-condition (expression) (interactive (list (read-minibuffer "Global Condition: " (format "%s" edebug-global-break-condition)))) (setq edebug-global-break-condition expression)) ;;; Mode switching functions ;;; =============================== (defun edebug-set-mode (mode shortmsg msg) ;; Set the edebug mode to MODE. ;; Display SHORTMSG, or MSG if not within edebug. (if (eq (1+ edebug-recursion-depth) (recursion-depth)) (progn (setq edebug-execution-mode mode) (message shortmsg) ;; Continue execution (exit-recursive-edit)) ;; This is not terribly useful!! (setq edebug-next-execution-mode mode) (message msg))) (defalias 'edebug-step-through-mode 'edebug-step-mode) (defun edebug-step-mode () "Proceed to next stop point." (interactive) (edebug-set-mode 'step "" "Edebug will stop at next stop point.")) (defun edebug-next-mode () "Proceed to next `after' stop point." (interactive) (edebug-set-mode 'next "" "Edebug will stop after next eval.")) (defun edebug-go-mode (arg) "Go, evaluating until break. With prefix ARG, set temporary break at current point and go." (interactive "P") (if arg (edebug-set-breakpoint t)) (edebug-set-mode 'go "Go..." "Edebug will go until break.")) (defun edebug-Go-nonstop-mode () "Go, evaluating without debugging." (interactive) (edebug-set-mode 'Go-nonstop "Go-Nonstop..." "Edebug will not stop at breaks.")) (defun edebug-trace-mode () "Begin trace mode." (interactive) (edebug-set-mode 'trace "Tracing..." "Edebug will trace with pause.")) (defun edebug-Trace-fast-mode () "Trace with no wait at each step." (interactive) (edebug-set-mode 'Trace-fast "Trace fast..." "Edebug will trace without pause.")) (defun edebug-continue-mode () "Begin continue mode." (interactive) (edebug-set-mode 'continue "Continue..." "Edebug will pause at breakpoints.")) (defun edebug-Continue-fast-mode () "Trace with no wait at each step." (interactive) (edebug-set-mode 'Continue-fast "Continue fast..." "Edebug will stop and go at breakpoints.")) ;; ------------------------------------------------------------ ;; The following use the mode changing commands and breakpoints. (defun edebug-goto-here () "Proceed to this stop point." (interactive) (edebug-go-mode t)) (defun edebug-stop () "Stop execution and do not continue. Useful for exiting from trace or continue loop." (interactive) (message "Stop")) '(defun edebug-forward () "Proceed to the exit of the next expression to be evaluated." (interactive) (edebug-set-mode 'forward "Forward" "Edebug will stop after exiting the next expression.")) (defun edebug-forward-sexp (arg) "Proceed from the current point to the end of the ARGth sexp ahead. If there are not ARG sexps ahead, then do edebug-step-out." (interactive "p") (condition-case nil (let ((parse-sexp-ignore-comments t)) ;; Call forward-sexp repeatedly until done or failure. (forward-sexp arg) (edebug-go-mode t)) (error (edebug-step-out) ))) (defun edebug-step-out () "Proceed from the current point to the end of the containing sexp. If there is no containing sexp that is not the top level defun, go to the end of the last sexp, or if that is the same point, then step." (interactive) (condition-case nil (let ((parse-sexp-ignore-comments t)) (up-list 1) (save-excursion ;; Is there still a containing expression? (up-list 1)) (edebug-go-mode t)) (error ;; At top level - 1, so first check if there are more sexps at this level. (let ((start-point (point))) ;; (up-list 1) (down-list -1) (if (= (point) start-point) (edebug-step-mode) ; No more at this level, so step. (edebug-go-mode t) ))))) (defun edebug-instrument-function (func) ;; Func should be a function symbol. ;; Return the function symbol, or nil if not instrumented. (let ((func-marker)) (setq func-marker (get func 'edebug)) (cond ((markerp func-marker) ;; It is uninstrumented, so instrument it. (save-excursion (set-buffer (marker-buffer func-marker)) (goto-char func-marker) (edebug-eval-top-level-form) func)) ((consp func-marker) (message "%s is already instrumented." func) func) (t ;; We could try harder, e.g. do a tags search. (error "Don't know where %s is defined" func) nil)))) (defun edebug-instrument-callee () "Instrument the definition of the function or macro about to be called. Do this when stopped before the form or it will be too late. One side effect of using this command is that the next time the function or macro is called, Edebug will be called there as well." (interactive) (if (not (looking-at "\(")) (error "You must be before a list form") (let ((func (save-excursion (down-list 1) (if (looking-at "\(") (edebug-form-data-name (edebug-get-form-data-entry (point))) (edebug-original-read (current-buffer)))))) (edebug-instrument-function func)))) (defun edebug-step-in () "Step into the definition of the function or macro about to be called. This first does `edebug-instrument-callee' to ensure that it is instrumented. Then it does `edebug-on-entry' and switches to `go' mode." (interactive) (let ((func (edebug-instrument-callee))) (if func (progn (edebug-on-entry func 'temp) (edebug-go-mode nil))))) (defun edebug-on-entry (function &optional flag) "Cause Edebug to stop when FUNCTION is called. With prefix argument, make this temporary so it is automatically cancelled the first time the function is entered." (interactive "aEdebug on entry to: \nP") ;; Could store this in the edebug data instead. (put function 'edebug-on-entry (if flag 'temp t))) (defun cancel-edebug-on-entry (function) (interactive "aEdebug on entry to: ") (put function 'edebug-on-entry nil)) (if (not (fboundp 'edebug-original-debug-on-entry)) (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry))) '(fset 'debug-on-entry 'edebug-debug-on-entry) ;; Should we do this? ;; Also need edebug-cancel-debug-on-entry '(defun edebug-debug-on-entry (function) "Request FUNCTION to invoke debugger each time it is called. If the user continues, FUNCTION's execution proceeds. Works by modifying the definition of FUNCTION, which must be written in Lisp, not predefined. Use `cancel-debug-on-entry' to cancel the effect of this command. Redefining FUNCTION also does that. This version is from Edebug. If the function is instrumented for Edebug, it calls `edebug-on-entry'" (interactive "aDebug on entry (to function): ") (let ((func-data (get function 'edebug))) (if (or (null func-data) (markerp func-data)) (edebug-original-debug-on-entry function) (edebug-on-entry function)))) (defun edebug-top-level-nonstop () "Set mode to Go-nonstop, and exit to top-level. This is useful for exiting even if unwind-protect code may be executed." (interactive) (setq edebug-execution-mode 'Go-nonstop) (top-level)) ;;(defun edebug-exit-out () ;; "Go until the current function exits." ;; (interactive) ;; (edebug-set-mode 'exiting "Exit...")) ;;; ----------------------------------------------------------------- ;;; The following initial mode setting definitions are not used yet. '(defconst edebug-initial-mode-alist '((edebug-Continue-fast . Continue-fast) (edebug-Trace-fast . Trace-fast) (edebug-continue . continue) (edebug-trace . trace) (edebug-go . go) (edebug-step-through . step) (edebug-Go-nonstop . Go-nonstop) ) "Association list between commands and the modes they set.") '(defun edebug-set-initial-mode () "Ask for the initial mode of the enclosing function. The mode is requested via the key that would be used to set the mode in edebug-mode." (interactive) (let* ((this-function (edebug-which-function)) (keymap (if (eq edebug-mode-map (current-local-map)) edebug-mode-map)) (old-mode (or (get this-function 'edebug-initial-mode) edebug-initial-mode)) (key (read-key-sequence (format "Change initial edebug mode for %s from %s (%s) to (enter key): " this-function old-mode (where-is-internal (car (rassq old-mode edebug-initial-mode-alist)) keymap 'firstonly )))) (mode (cdr (assq (key-binding key) edebug-initial-mode-alist))) ) (if (and mode (or (get this-function 'edebug-initial-mode) (not (eq mode edebug-initial-mode)))) (progn (put this-function 'edebug-initial-mode mode) (message "Initial mode for %s is now: %s" this-function mode)) (error "Key must map to one of the mode changing commands") ))) ;;; Evaluation of expressions ;;; =============================== (def-edebug-spec edebug-outside-excursion t) (defmacro edebug-outside-excursion (&rest body) "Evaluate an expression list in the outside context. Return the result of the last expression." (` (save-excursion ; of current-buffer (if edebug-save-windows (progn ;; After excursion, we will ;; restore to current window configuration. (setq edebug-inside-windows (edebug-current-windows edebug-save-windows)) ;; Restore outside windows. (edebug-set-windows edebug-outside-windows))) (set-buffer edebug-buffer) ; why? ;; (use-local-map edebug-outside-map) (store-match-data edebug-outside-match-data) ;; Restore outside context. (let (;; (edebug-inside-map (current-local-map)) ;; restore map?? (last-command-char edebug-outside-last-command-char) (last-command-event edebug-outside-last-command-event) (last-command edebug-outside-last-command) (this-command edebug-outside-this-command) (unread-command-char edebug-outside-unread-command-char) (unread-command-event edebug-outside-unread-command-event) (unread-command-events edebug-outside-unread-command-events) (last-input-char edebug-outside-last-input-char) (last-input-event edebug-outside-last-input-event) (last-event-frame edebug-outside-last-event-frame) (last-nonmenu-event edebug-outside-last-nonmenu-event) (track-mouse edebug-outside-track-mouse) (standard-output edebug-outside-standard-output) (standard-input edebug-outside-standard-input) (executing-macro edebug-outside-executing-macro) (defining-kbd-macro edebug-outside-defining-kbd-macro) (pre-command-hook edebug-outside-pre-command-hook) (post-command-hook edebug-outside-post-command-hook) (post-command-idle-hook edebug-outside-post-command-idle-hook) ;; See edebug-display (overlay-arrow-position edebug-outside-o-a-p) (overlay-arrow-string edebug-outside-o-a-s) (cursor-in-echo-area edebug-outside-c-i-e-a) ) (unwind-protect (save-excursion ; of edebug-buffer (set-buffer edebug-outside-buffer) (goto-char edebug-outside-point) (if (marker-buffer (edebug-mark-marker)) (set-marker (edebug-mark-marker) edebug-outside-mark)) (,@ body)) ;; Back to edebug-buffer. Restore rest of inside context. ;; (use-local-map edebug-inside-map) (if edebug-save-windows ;; Restore inside windows. (edebug-set-windows edebug-inside-windows)) ;; Save values that may have been changed. (setq edebug-outside-last-command-char last-command-char edebug-outside-last-command-event last-command-event edebug-outside-last-command last-command edebug-outside-this-command this-command edebug-outside-unread-command-char unread-command-char edebug-outside-unread-command-event unread-command-event edebug-outside-unread-command-events unread-command-events edebug-outside-last-input-char last-input-char edebug-outside-last-input-event last-input-event edebug-outside-last-event-frame last-event-frame edebug-outside-last-nonmenu-event last-nonmenu-event edebug-outside-track-mouse track-mouse edebug-outside-standard-output standard-output edebug-outside-standard-input standard-input edebug-outside-executing-macro executing-macro edebug-outside-defining-kbd-macro defining-kbd-macro edebug-outside-pre-command-hook pre-command-hook edebug-outside-post-command-hook post-command-hook edebug-outside-post-command-idle-hook post-command-idle-hook edebug-outside-o-a-p overlay-arrow-position edebug-outside-o-a-s overlay-arrow-string edebug-outside-c-i-e-a cursor-in-echo-area ))) ; let ))) (defvar cl-debug-env nil) ;; defined in cl; non-nil when lexical env used. (defun edebug-eval (edebug-expr) ;; Are there cl lexical variables active? (if cl-debug-env (eval (cl-macroexpand-all edebug-expr cl-debug-env)) (eval edebug-expr))) (defun edebug-safe-eval (edebug-expr) ;; Evaluate EXPR safely. ;; If there is an error, a string is returned describing the error. (condition-case edebug-err (edebug-eval edebug-expr) (error (edebug-format "%s: %s" ;; could (get (car edebug-err) 'error-message) (car (cdr edebug-err)))))) ;;;; Printing ;;; ========= ;; Replace printing functions. ;; obsolete names (defalias 'edebug-install-custom-print-funcs 'edebug-install-custom-print) (defalias 'edebug-reset-print-funcs 'edebug-uninstall-custom-print) (defalias 'edebug-uninstall-custom-print-funcs 'edebug-uninstall-custom-print) (defun edebug-install-custom-print () "Replace print functions used by Edebug with custom versions." ;; Modifying the custom print functions, or changing print-length, ;; print-level, print-circle, custom-print-list or custom-print-vector ;; have immediate effect. (interactive) (require 'cust-print) (defalias 'edebug-prin1 'custom-prin1) (defalias 'edebug-print 'custom-print) (defalias 'edebug-prin1-to-string 'custom-prin1-to-string) (defalias 'edebug-format 'custom-format) (defalias 'edebug-message 'custom-message) "Installed") (eval-and-compile (defun edebug-uninstall-custom-print () "Replace edebug custom print functions with internal versions." (interactive) (defalias 'edebug-prin1 'prin1) (defalias 'edebug-print 'print) (defalias 'edebug-prin1-to-string 'prin1-to-string) (defalias 'edebug-format 'format) (defalias 'edebug-message 'message) "Uninstalled") ;; Default print functions are the same as Emacs'. (edebug-uninstall-custom-print)) (defun edebug-report-error (edebug-value) ;; Print an error message like command level does. ;; This also prints the error name if it has no error-message. (message "%s: %s" (or (get (car edebug-value) 'error-message) (format "peculiar error (%s)" (car edebug-value))) (mapconcat (function (lambda (edebug-arg) ;; continuing after an error may ;; complain about edebug-arg. why?? (prin1-to-string edebug-arg))) (cdr edebug-value) ", "))) ;; Define here in case they are not already defined. (defvar print-level nil) (defvar print-circle nil) (defvar print-readably) ;; defined by lemacs ;; Alternatively, we could change the definition of ;; edebug-safe-prin1-to-string to only use these if defined. (defun edebug-safe-prin1-to-string (value) (let ((print-escape-newlines t) (print-length (or edebug-print-length print-length)) (print-level (or edebug-print-level print-level)) (print-circle (or edebug-print-circle print-circle)) (print-readably nil)) ;; lemacs uses this. (edebug-prin1-to-string value))) (defun edebug-compute-previous-result (edebug-previous-value) (setq edebug-previous-result (if (and (numberp edebug-previous-value) (< edebug-previous-value 256) (>= edebug-previous-value 0)) (format "Result: %s = %s" edebug-previous-value (single-key-description edebug-previous-value)) (if edebug-unwrap-results (setq edebug-previous-value (edebug-unwrap* edebug-previous-value))) (concat "Result: " (edebug-safe-prin1-to-string edebug-previous-value))))) (defun edebug-previous-result () "Print the previous result." (interactive) (message "%s" edebug-previous-result)) ;;;; Read, Eval and Print ;;; ===================== (defun edebug-eval-expression (edebug-expr) "Evaluate an expression in the outside environment. If interactive, prompt for the expression. Print result in minibuffer." (interactive "xEval: ") (princ (edebug-outside-excursion (setq values (cons (edebug-eval edebug-expr) values)) (edebug-safe-prin1-to-string (car values))))) (defun edebug-eval-last-sexp () "Evaluate sexp before point in the outside environment; print value in minibuffer." (interactive) (edebug-eval-expression (edebug-last-sexp))) (defun edebug-eval-print-last-sexp () "Evaluate sexp before point in the outside environment; print value into current buffer." (interactive) (let* ((edebug-form (edebug-last-sexp)) (edebug-result-string (edebug-outside-excursion (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form)))) (standard-output (current-buffer))) (princ "\n") ;; princ the string to get rid of quotes. (princ edebug-result-string) (princ "\n") )) ;;;; Edebug Minor Mode ;;; =============================== ;; Global GUD bindings for all emacs-lisp-mode buffers. (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode) (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode) (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode) (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where) (defvar edebug-mode-map nil) (if edebug-mode-map nil (progn (setq edebug-mode-map (copy-keymap emacs-lisp-mode-map)) ;; control (define-key edebug-mode-map " " 'edebug-step-mode) (define-key edebug-mode-map "n" 'edebug-next-mode) (define-key edebug-mode-map "g" 'edebug-go-mode) (define-key edebug-mode-map "G" 'edebug-Go-nonstop-mode) (define-key edebug-mode-map "t" 'edebug-trace-mode) (define-key edebug-mode-map "T" 'edebug-Trace-fast-mode) (define-key edebug-mode-map "c" 'edebug-continue-mode) (define-key edebug-mode-map "C" 'edebug-Continue-fast-mode) ;;(define-key edebug-mode-map "f" 'edebug-forward) not implemented (define-key edebug-mode-map "f" 'edebug-forward-sexp) (define-key edebug-mode-map "h" 'edebug-goto-here) (define-key edebug-mode-map "I" 'edebug-instrument-callee) (define-key edebug-mode-map "i" 'edebug-step-in) (define-key edebug-mode-map "o" 'edebug-step-out) ;; quitting and stopping (define-key edebug-mode-map "q" 'top-level) (define-key edebug-mode-map "Q" 'edebug-top-level-nonstop) (define-key edebug-mode-map "a" 'abort-recursive-edit) (define-key edebug-mode-map "S" 'edebug-stop) ;; breakpoints (define-key edebug-mode-map "b" 'edebug-set-breakpoint) (define-key edebug-mode-map "u" 'edebug-unset-breakpoint) (define-key edebug-mode-map "B" 'edebug-next-breakpoint) (define-key edebug-mode-map "x" 'edebug-set-conditional-breakpoint) (define-key edebug-mode-map "X" 'edebug-set-global-break-condition) ;; evaluation (define-key edebug-mode-map "r" 'edebug-previous-result) (define-key edebug-mode-map "e" 'edebug-eval-expression) (define-key edebug-mode-map "\C-x\C-e" 'edebug-eval-last-sexp) (define-key edebug-mode-map "E" 'edebug-visit-eval-list) ;; views (define-key edebug-mode-map "w" 'edebug-where) (define-key edebug-mode-map "v" 'edebug-view-outside) ;; maybe obsolete?? (define-key edebug-mode-map "p" 'edebug-bounce-point) (define-key edebug-mode-map "P" 'edebug-view-outside) ;; same as v (define-key edebug-mode-map "W" 'edebug-toggle-save-windows) ;; misc (define-key edebug-mode-map "?" 'edebug-help) (define-key edebug-mode-map "d" 'edebug-backtrace) (define-key edebug-mode-map "-" 'negative-argument) ;; statistics (define-key edebug-mode-map "=" 'edebug-temp-display-freq-count) ;; GUD bindings (define-key edebug-mode-map "\C-c\C-s" 'edebug-step-mode) (define-key edebug-mode-map "\C-c\C-n" 'edebug-next-mode) (define-key edebug-mode-map "\C-c\C-c" 'edebug-go-mode) (define-key edebug-mode-map "\C-x " 'edebug-set-breakpoint) (define-key edebug-mode-map "\C-c\C-d" 'edebug-unset-breakpoint) (define-key edebug-mode-map "\C-c\C-t" (function (lambda () (edebug-set-breakpoint t)))) (define-key edebug-mode-map "\C-c\C-l" 'edebug-where) )) ;; Autoloading these global bindings doesn't make sense because ;; they cannot be used anyway unless Edebug is already loaded and active. (defvar global-edebug-prefix "\^XX" "Prefix key for global edebug commands, available from any buffer.") (defvar global-edebug-map nil "Global map of edebug commands, available from any buffer.") (if global-edebug-map nil (setq global-edebug-map (make-sparse-keymap)) (global-unset-key global-edebug-prefix) (global-set-key global-edebug-prefix global-edebug-map) (define-key global-edebug-map " " 'edebug-step-mode) (define-key global-edebug-map "g" 'edebug-go-mode) (define-key global-edebug-map "G" 'edebug-Go-nonstop-mode) (define-key global-edebug-map "t" 'edebug-trace-mode) (define-key global-edebug-map "T" 'edebug-Trace-fast-mode) (define-key global-edebug-map "c" 'edebug-continue-mode) (define-key global-edebug-map "C" 'edebug-Continue-fast-mode) ;; breakpoints (define-key global-edebug-map "b" 'edebug-set-breakpoint) (define-key global-edebug-map "u" 'edebug-unset-breakpoint) (define-key global-edebug-map "x" 'edebug-set-conditional-breakpoint) (define-key global-edebug-map "X" 'edebug-set-global-break-condition) ;; views (define-key global-edebug-map "w" 'edebug-where) (define-key global-edebug-map "W" 'edebug-toggle-save-windows) ;; quitting (define-key global-edebug-map "q" 'top-level) (define-key global-edebug-map "Q" 'edebug-top-level-nonstop) (define-key global-edebug-map "a" 'abort-recursive-edit) ;; statistics (define-key global-edebug-map "=" 'edebug-display-freq-count) ) (defun edebug-help () (interactive) (describe-function 'edebug-mode)) (defun edebug-mode () "Mode for Emacs Lisp buffers while in Edebug. In addition to all Emacs Lisp commands (except those that modify the buffer) there are local and global key bindings to several Edebug specific commands. E.g. `edebug-step-mode' is bound to \\[edebug-step-mode] in the Edebug buffer and \\\\[edebug-step-mode] in any buffer. Also see bindings for the eval list buffer, *edebug*. The edebug buffer commands: \\{edebug-mode-map} Global commands prefixed by `global-edebug-prefix': \\{global-edebug-map} Options: edebug-setup-hook edebug-all-defs edebug-all-forms edebug-save-windows edebug-save-displayed-buffer-points edebug-initial-mode edebug-trace edebug-test-coverage edebug-continue-kbd-macro edebug-print-length edebug-print-level edebug-print-circle edebug-on-error edebug-on-quit edebug-on-signal edebug-unwrap-results edebug-global-break-condition " (use-local-map edebug-mode-map)) ;;;; edebug eval list mode ;;; =============================================== ;; A list of expressions and their evaluations is displayed in *edebug*. (defun edebug-eval-result-list () "Return a list of evaluations of edebug-eval-list" ;; Assumes in outside environment. ;; Don't do any edebug things now. (let ((edebug-execution-mode 'Go-nonstop) (edebug-trace nil)) (mapcar 'edebug-safe-eval edebug-eval-list))) (defun edebug-eval-display-list (edebug-eval-result-list) ;; Assumes edebug-eval-buffer exists. (let ((edebug-eval-list-temp edebug-eval-list) (standard-output edebug-eval-buffer) (edebug-comment-line (format ";%s\n" (make-string (- (window-width) 2) ?-)))) (set-buffer edebug-eval-buffer) (erase-buffer) (while edebug-eval-list-temp (prin1 (car edebug-eval-list-temp)) (terpri) (prin1 (car edebug-eval-result-list)) (terpri) (princ edebug-comment-line) (setq edebug-eval-list-temp (cdr edebug-eval-list-temp)) (setq edebug-eval-result-list (cdr edebug-eval-result-list))) (edebug-pop-to-buffer edebug-eval-buffer) )) (defun edebug-create-eval-buffer () (if (not (and edebug-eval-buffer (buffer-name edebug-eval-buffer))) (progn (set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*"))) (edebug-eval-mode)))) ;; Should generalize this to be callable outside of edebug ;; with calls in user functions, e.g. (edebug-eval-display) (defun edebug-eval-display (edebug-eval-result-list) "Display expressions and evaluations in EVAL-LIST. It modifies the context by popping up the eval display." (if edebug-eval-result-list (progn (edebug-create-eval-buffer) (edebug-eval-display-list edebug-eval-result-list) ))) (defun edebug-eval-redisplay () "Redisplay eval list in outside environment. May only be called from within edebug-recursive-edit." (edebug-create-eval-buffer) (edebug-outside-excursion (edebug-eval-display-list (edebug-eval-result-list)) )) (defun edebug-visit-eval-list () (interactive) (edebug-eval-redisplay) (edebug-pop-to-buffer edebug-eval-buffer)) (defun edebug-update-eval-list () "Replace the evaluation list with the sexps now in the eval buffer." (interactive) (let ((starting-point (point)) new-list) (goto-char (point-min)) ;; get the first expression (edebug-skip-whitespace) (if (not (eobp)) (progn (forward-sexp 1) (setq new-list (cons (edebug-last-sexp) new-list)))) (while (re-search-forward "^;" nil t) (forward-line 1) (skip-chars-forward " \t\n\r") (if (and (/= ?\; (following-char)) (not (eobp))) (progn (forward-sexp 1) (setq new-list (cons (edebug-last-sexp) new-list))))) (setq edebug-eval-list (nreverse new-list)) (edebug-eval-redisplay) (goto-char starting-point))) (defun edebug-delete-eval-item () "Delete the item under point and redisplay." ;; could add arg to do repeatedly (interactive) (if (re-search-backward "^;" nil 'nofail) (forward-line 1)) (delete-region (point) (progn (re-search-forward "^;" nil 'nofail) (beginning-of-line) (point))) (edebug-update-eval-list)) (defvar edebug-eval-mode-map nil "Keymap for edebug-eval-mode. Superset of lisp-interaction-mode.") (if edebug-eval-mode-map nil (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map)) (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where) (define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item) (define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list) (define-key edebug-eval-mode-map "\C-x\C-e" 'edebug-eval-last-sexp) (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp) ) (defun edebug-eval-mode () "Mode for evaluation list buffer while in Edebug. In addition to all Interactive Emacs Lisp commands there are local and global key bindings to several Edebug specific commands. E.g. `edebug-step-mode' is bound to \\[edebug-step-mode] in the Edebug buffer and \\\\[edebug-step-mode] in any buffer. Eval list buffer commands: \\{edebug-eval-mode-map} Global commands prefixed by global-edebug-prefix: \\{global-edebug-map} " (lisp-interaction-mode) (setq major-mode 'edebug-eval-mode) (setq mode-name "Edebug-Eval") (use-local-map edebug-eval-mode-map)) ;;;; Interface with standard debugger. ;;; ======================================== ;; (setq debugger 'edebug) ; to use the edebug debugger ;; (setq debugger 'debug) ; use the standard debugger ;; Note that debug and its utilities must be byte-compiled to work, ;; since they depend on the backtrace looking a certain way. But ;; edebug is not dependent on this, yet. (defun edebug (&optional edebug-arg-mode &rest debugger-args) "Replacement for debug. If we are running an edebugged function, show where we last were. Otherwise call debug normally." ;; (message "entered: %s depth: %s edebug-recursion-depth: %s" ;; edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1) (if (and edebug-entered ; anything active? (eq (recursion-depth) edebug-recursion-depth)) (let (;; Where were we before the error occurred? (edebug-offset-index (car edebug-offset-indices)) ;; Bind variables required by edebug-display (edebug-value (car debugger-args)) edebug-breakpoints edebug-break-data edebug-break-condition edebug-global-break (edebug-break (null edebug-arg-mode)) ;; if called explicitly ) (edebug-display) (if (eq edebug-arg-mode 'error) nil edebug-value)) ;; Otherwise call debug normally. ;; Still need to remove extraneous edebug calls from stack. (apply 'debug edebug-arg-mode debugger-args) )) (defun edebug-backtrace () "Display a non-working backtrace. Better than nothing..." (interactive) (if (or (not edebug-backtrace-buffer) (null (buffer-name edebug-backtrace-buffer))) (setq edebug-backtrace-buffer (generate-new-buffer "*Backtrace*")) ;; else, could just display edebug-backtrace-buffer ) (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer) (setq edebug-backtrace-buffer standard-output) (let ((print-escape-newlines t) (print-length 50) last-ok-point) (backtrace) ;; Clean up the backtrace. ;; Not quite right for current edebug scheme. (set-buffer edebug-backtrace-buffer) (setq truncate-lines t) (goto-char (point-min)) (setq last-ok-point (point)) (if t (progn ;; Delete interspersed edebug internals. (while (re-search-forward "^ \(?edebug" nil t) (beginning-of-line) (cond ((looking-at "^ \(edebug-after") ;; Previous lines may contain code, so just delete this line (setq last-ok-point (point)) (forward-line 1) (delete-region last-ok-point (point))) ((looking-at "^ edebug") (forward-line 1) (delete-region last-ok-point (point)) ))) ))))) ;;;; Trace display ;; =============================== (defun edebug-trace-display (buf-name fmt &rest args) "In buffer BUF-NAME, display FMT and ARGS at the end and make it visible. The buffer is created if it does not exist. You must include newlines in FMT to break lines, but one newline is appended." ;; e.g. ;; (edebug-trace-display "*trace-point*" ;; "saving: point = %s window-start = %s" ;; (point) (window-start)) (let* ((selected-window (selected-window)) (buffer (get-buffer-create buf-name)) buf-window) ;; (message "before pop-to-buffer") (sit-for 1) (edebug-pop-to-buffer buffer) (setq truncate-lines t) (setq buf-window (selected-window)) (goto-char (point-max)) (insert (apply 'edebug-format fmt args) "\n") ;; Make it visible. (vertical-motion (- 1 (window-height))) (set-window-start buf-window (point)) (goto-char (point-max)) ;; (set-window-point buf-window (point)) ;; (edebug-sit-for 0) (bury-buffer buffer) (select-window selected-window)) buf-name) (defun edebug-trace (fmt &rest args) "Convenience call to edebug-trace-display using edebug-trace-buffer" (apply 'edebug-trace-display edebug-trace-buffer fmt args)) ;;;; Frequency count and coverage ;;; ============================== (defun edebug-display-freq-count () "Display the frequency count data for each line of the current definition. The frequency counts are inserted as comment lines after each line, and you can undo all insertions with one `undo' command. The counts are inserted starting under the `(' before an expression or the `)' after an expression, or on the last char of a symbol. The counts are only displayed when they differ from previous counts on the same line. If coverage is being tested, whenever all known results of an expression are `eq', the char `=' will be appended after the count for that expression. Note that this is always the case for an expression only evaluated once. To clear the frequency count and coverage data for a definition, reinstrument it." (interactive) (let* ((function (edebug-form-data-symbol)) (counts (get function 'edebug-freq-count)) (coverages (get function 'edebug-coverage)) (data (get function 'edebug)) (def-mark (car data)) ; mark at def start (edebug-points (nth 2 data)) (i (1- (length edebug-points))) (last-index) (first-index) (start-of-line) (start-of-count-line) (last-count) ) (save-excursion ;; Traverse in reverse order so offsets are correct. (while (<= 0 i) ;; Start at last expression in line. (goto-char (+ def-mark (aref edebug-points i))) (beginning-of-line) (setq start-of-line (- (point) def-mark) last-index i) ;; Find all indexes on same line. (while (and (<= 0 (setq i (1- i))) (<= start-of-line (aref edebug-points i)))) ;; Insert all the indices for this line. (forward-line 1) (setq start-of-count-line (point) first-index i ; really last index for line above this one. last-count -1) ; cause first count to always appear. (insert ";#") ;; i == first-index still (while (<= (setq i (1+ i)) last-index) (let ((count (aref counts i)) (coverage (aref coverages i)) (col (save-excursion (goto-char (+ (aref edebug-points i) def-mark)) (- (current-column) (if (= ?\( (following-char)) 0 1))))) (insert (make-string (max 0 (- col (- (point) start-of-count-line))) ?\ ) (if (and (< 0 count) (not (memq coverage '(unknown ok-coverage)))) "=" "") (if (= count last-count) "" (int-to-string count)) " ") (setq last-count count))) (insert "\n") (setq i first-index))))) (defun edebug-temp-display-freq-count () "Temporarily display the frequency count data for the current definition. It is removed when you hit any char." ;; This seems not to work with Emacs 18.59. It undoes too far. (interactive) (let ((buffer-read-only nil)) (undo-boundary) (edebug-display-freq-count) (setq unread-command-char (read-char)) (undo))) ;;;; Menus ;;;========= (defun edebug-toggle (variable) (set variable (not (eval variable))) (message "%s: %s" variable (eval variable))) ;; We have to require easymenu (even for Emacs 18) just so ;; the easy-menu-define macro call is compiled correctly. (require 'easymenu) (defconst edebug-mode-menus '("Edebug" "----" ["Stop" edebug-stop t] ["Step" edebug-step-mode t] ["Next" edebug-next-mode t] ["Trace" edebug-trace-mode t] ["Trace Fast" edebug-Trace-fast-mode t] ["Continue" edebug-continue-mode t] ["Continue Fast" edebug-Continue-fast-mode t] ["Go" edebug-go-mode t] ["Go Nonstop" edebug-Go-nonstop-mode t] "----" ["Help" edebug-help t] ["Abort" abort-recursive-edit t] ["Quit to Top Level" top-level t] ["Quit Nonstop" edebug-top-level-nonstop t] "----" ("Jumps" ["Forward Sexp" edebug-forward-sexp t] ["Step In" edebug-step-in t] ["Step Out" edebug-step-out t] ["Goto Here" edebug-goto-here t]) ("Breaks" ["Set Breakpoint" edebug-set-breakpoint t] ["Unset Breakpoint" edebug-unset-breakpoint t] ["Set Conditional Breakpoint" edebug-set-conditional-breakpoint t] ["Set Global Break Condition" edebug-set-global-break-condition t] ["Show Next Breakpoint" edebug-next-breakpoint t]) ("Views" ["Where am I?" edebug-where t] ["Bounce to Current Point" edebug-bounce-point t] ["View Outside Windows" edebug-view-outside t] ["Previous Result" edebug-previous-result t] ["Show Backtrace" edebug-backtrace t] ["Display Freq Count" edebug-display-freq-count t]) ("Eval" ["Expression" edebug-eval-expression t] ["Last Sexp" edebug-eval-last-sexp t] ["Visit Eval List" edebug-visit-eval-list t]) ("Options" ["Edebug All Defs" edebug-all-defs t] ["Edebug All Forms" edebug-all-forms t] "----" ["Toggle Tracing" (edebug-toggle 'edebug-trace) t] ["Toggle Coverage Testing" (edebug-toggle 'edebug-test-coverage) t] ["Toggle Window Saving" edebug-toggle-save-windows t] ["Toggle Point Saving" (edebug-toggle 'edebug-save-displayed-buffer-points) t] )) "Lemacs style menus for Edebug.") ;;;; Emacs version specific code ;;;============================= ;;; The default for all above is Emacs 18, because it is easier to compile ;;; Emacs 18 code in Emacs 19 than vice versa. This default will ;;; change once most people are using Emacs 19 or derivatives. ;; Epoch specific code is in a separate file: edebug-epoch.el. ;; The byte-compiler will complain about changes in number of arguments ;; to functions like mark and read-from-minibuffer. These warnings ;; may be ignored because the right call should always be made. (defun edebug-emacs-19-specific () (defalias 'edebug-window-live-p 'window-live-p) ;; Mark takes an argument in Emacs 19. (defun edebug-mark () (mark t));; Does this work for lemacs too? ;; Use minibuffer-history when reading expressions. (defvar read-expression-history) ;; hush bytecomp (defvar read-expression-map) (defun edebug-set-conditional-breakpoint (arg condition) "Set a conditional breakpoint at nearest sexp. The condition is evaluated in the outside context. With prefix argument, make it a temporary breakpoint." ;; (interactive "P\nxCondition: ") (interactive (list current-prefix-arg ;; Read condition as follows; getting previous condition is cumbersome: (let ((edebug-stop-point (edebug-find-stop-point))) (if edebug-stop-point (let* ((edebug-def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) (edebug-data (get edebug-def-name 'edebug)) (edebug-breakpoints (car (cdr edebug-data))) (edebug-break-data (assq index edebug-breakpoints)) (edebug-break-condition (car (cdr edebug-break-data))) (edebug-expression-history ;; Prepend the current condition, if any. (if edebug-break-condition (cons edebug-break-condition read-expression-history) read-expression-history))) (prog1 (read-from-minibuffer "Condition: " nil read-expression-map t 'edebug-expression-history) (setq read-expression-history edebug-expression-history) )))))) (edebug-modify-breakpoint t condition arg)) (defun edebug-eval-expression (edebug-expr) "Evaluate an expression in the outside environment. If interactive, prompt for the expression. Print result in minibuffer." (interactive (list (read-from-minibuffer "Eval: " nil read-expression-map t 'read-expression-history))) (princ (edebug-outside-excursion (setq values (cons (edebug-eval edebug-expr) values)) (edebug-safe-prin1-to-string (car values))))) (easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus) (if window-system (x-popup-menu nil (lookup-key edebug-mode-map [menu-bar Edebug]))) ) (defun edebug-lemacs-specific () ;; We need to bind zmacs-regions to nil around all calls to `mark' and ;; `mark-marker' but don't bind it to nil before entering a recursive edit, ;; that is, don't interfere with the binding the user might see while ;; executing a command. (defvar zmacs-regions) (defun edebug-mark () (let ((zmacs-regions nil)) (mark))) (defun edebug-mark-marker () (let ((zmacs-regions nil));; for lemacs (mark-marker))) (defun edebug-mode-menu (event) (interactive "@event") (popup-menu edebug-mode-menus)) (define-key edebug-mode-map 'button3 'edebug-mode-menu) ) (defun edebug-emacs-version-specific () (cond ((string-match "Lucid" emacs-version);; Lucid Emacs (edebug-lemacs-specific)) ((and (boundp 'epoch::version) epoch::version) (require 'edebug-epoch)) ((not (string-match "^18" emacs-version)) (edebug-emacs-19-specific)))) (edebug-emacs-version-specific) ;;;; Byte-compiler ;;; ==================== ;; Extension for bytecomp to resolve undefined function references. ;; Requires new byte compiler. ;; Reenable byte compiler warnings about unread-command-char and -event. ;; Disabled before edebug-recursive-edit. (eval-when-compile (if edebug-unread-command-char-warning (put 'unread-command-char 'byte-obsolete-variable edebug-unread-command-char-warning)) (if edebug-unread-command-event-warning (put 'unread-command-event 'byte-obsolete-variable edebug-unread-command-event-warning))) (eval-when-compile ;; The body of eval-when-compile seems to get evaluated with eval-defun. ;; We only want to evaluate when actually byte compiling. ;; But it is OK to evaluate as long as byte-compiler has been loaded. (if (featurep 'byte-compile) (progn (defun byte-compile-resolve-functions (funcs) "Say it is OK for the named functions to be unresolved." (mapcar (function (lambda (func) (setq byte-compile-unresolved-functions (delq (assq func byte-compile-unresolved-functions) byte-compile-unresolved-functions)))) funcs) nil) '(defun byte-compile-resolve-free-references (vars) "Say it is OK for the named variables to be referenced." (mapcar (function (lambda (var) (setq byte-compile-free-references (delq var byte-compile-free-references)))) vars) nil) '(defun byte-compile-resolve-free-assignments (vars) "Say it is OK for the named variables to be assigned." (mapcar (function (lambda (var) (setq byte-compile-free-assignments (delq var byte-compile-free-assignments)))) vars) nil) (byte-compile-resolve-functions '(reporter-submit-bug-report edebug-gensym ;; also in cl.el ;; Interfaces to standard functions. edebug-original-eval-defun edebug-original-read edebug-get-buffer-window edebug-mark edebug-mark-marker edebug-input-pending-p edebug-sit-for edebug-prin1-to-string edebug-format edebug-original-signal ;; lemacs zmacs-deactivate-region popup-menu ;; CL cl-macroexpand-all ;; And believe it or not, the byte compiler doesnt know about: byte-compile-resolve-functions )) '(byte-compile-resolve-free-references '(read-expression-history read-expression-map)) '(byte-compile-resolve-free-assignments '(read-expression-history)) ))) ;;;; Autoloading of Edebug accessories ;;;=================================== (if (featurep 'cl) (add-hook 'edebug-setup-hook (function (lambda () (require 'cl-specs)))) ;; The following causes cl-specs to be loaded if you load cl.el. (add-hook 'cl-load-hook (function (lambda () (require 'cl-specs))))) ;;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu (if (featurep 'cl-read) (add-hook 'edebug-setup-hook (function (lambda () (require 'edebug-cl-read)))) ;; The following causes edebug-cl-read to be loaded when you load cl-read.el. (add-hook 'cl-read-load-hooks (function (lambda () (require 'edebug-cl-read))))) ;;;; Finalize Loading ;;;=================== ;;; Finally, hook edebug into the rest of Emacs. ;;; There are probably some other things that could go here. ;; Install edebug read and eval functions. (edebug-install-read-eval-functions) (provide 'edebug) ;;; edebug.el ends here emacs-19.30/lisp/ediff-diff.el100444 23123 1 122217 6037625000 14723 0ustar kiferdaemon;;; ediff-diff.el --- diff-related utilities ;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. (require 'ediff-init) (defvar ediff-shell (cond ((eq system-type 'emx) "cmd") ; OS/2 ((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VMS (t "sh")) ; UNIX "*The shell used to run diff and patch. If user's .profile or .cshrc files are set up correctly, any shell will do. However, some people set $prompt or other things incorrectly, which leads to undesirable output messages. These may cause Ediff to fail. In such a case, set ediff-shell to a shell that you are not using or, better, fix your shell's startup file.") (defvar ediff-diff-program "diff" "*Program to use for generating the differential of the two files.") (defvar ediff-diff-options "" "*Options to pass to `ediff-diff-program'. If diff\(1\) is used as `ediff-diff-program', then the most useful options are `-w', to ignore space, and `-i', to ignore case of letters. At present, the option `-c' is ignored, since Ediff doesn't understand this type of output.") (defvar ediff-custom-diff-program ediff-diff-program "*Program to use for generating custom diff output for saving it in a file. This output is not used by Ediff internally.") (defvar ediff-custom-diff-options "-c" "*Options to pass to `ediff-custom-diff-program'.") ;;; Support for diff3 (defvar ediff-match-diff3-line "^====\\(.?\\)$" "Pattern to match lines produced by diff3 that describe differences.") (defvar ediff-diff3-program "diff3" "*Program to be used for three-way comparison. Must produce output compatible with Unix's diff3 program.") (defvar ediff-diff3-options "" "*Options to pass to `ediff-diff3-program'.") (defvar ediff-diff3-ok-lines-regexp "^\\([1-3]:\\|====\\| \\|.*Warning *:\\|.*No newline\\|.*missing newline\\)" "*Regexp that matches normal output lines from `ediff-diff3-program'. Lines that do not match are assumed to be error messages.") ;; keeps the status of the current diff in 3-way jobs. ;; the status can be =diff(A), =diff(B), or =diff(A+B) (ediff-defvar-local ediff-diff-status "" "") ;; Support for patch (defvar ediff-patch-program "patch" "*Name of the program that applies patches.") (defvar ediff-patch-options "" "*Options to pass to ediff-patch-program.") ;; The buffer of the patch file. (defvar ediff-patch-buf nil) ;; The buffer where patch would display its diagnostics. (defvar ediff-patch-diagnostics nil) ;;; Fine differences (ediff-defvar-local ediff-auto-refine (if (ediff-window-display-p) 'on 'nix) "If `on', Ediff auto-highlights fine diffs for the current diff region. If `off', auto-highlighting is not used. If `nix', no fine diffs are shown at all, unless the user force-refines the region by hitting `*'. This variable can be set either in .emacs or toggled interactively. Use `setq-default' if setting it in .emacs") (ediff-defvar-local ediff-ignore-similar-regions nil "*If t, skip over difference regions that differ only in the white space and line breaks. This variable can be set either in .emacs or toggled interactively. Use `setq-default' if setting it in .emacs") (ediff-defvar-local ediff-auto-refine-limit 700 "Auto-refine only those regions that are smaller than this number of bytes.") ;;; General (defvar ediff-diff-ok-lines-regexp "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\|.*Warning *:\\|.*No newline\\|.*missing newline\\)" "Regexp that matches normal output lines from `ediff-diff-program'. This is mostly lifted from Emerge, except that Ediff also considers warnings and `Missing newline'-type messages to be normal output. Lines that do not match are assumed to be error messages.") (defvar ediff-match-diff-line (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)")) (concat "^" x "\\([acd]\\)" x "$")) "Pattern to match lines produced by diff that describe differences.") (ediff-defvar-local ediff-setup-diff-regions-function nil "value is a function symbol depending on the kind of job is to be done. For 2-way jobs and for ediff-merge, it should be `ediff-setup-diff-regions'. For jobs requiring diff3, it should be `ediff-setup-diff-regions3'. The function should take three mandatory arguments, file-A, file-B, and file-C. It may ignore file C for diff2 jobs. It should also take one optional arguments, diff-number to refine.") ;;; Functions ;; Generate the difference vector and overlays for the two files ;; With optional arg REG-TO-REFINE, refine this region. ;; File-C argument is not used here. It is there just because ;; ediff-setup-diff-regions is called via a funcall to ;; ediff-setup-diff-regions-function, which can also have the value ;; ediff-setup-diff-regions3, which takes 4 arguments. (defun ediff-setup-diff-regions (file-A file-B file-C) ;; Force all minibuffers to display ediff's messages. ;; When xemacs implements minibufferless frames, this won't be necessary (if ediff-xemacs-p (setq synchronize-minibuffers t)) (or (ediff-buffer-live-p ediff-diff-buffer) (setq ediff-diff-buffer (get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*")))) (message "Computing differences ...") (ediff-exec-process ediff-diff-program ediff-diff-buffer 'synchronize ediff-diff-options file-A file-B) (ediff-prepare-error-list ediff-diff-ok-lines-regexp ediff-diff-buffer) ;;(message "Computing differences ... done") (ediff-convert-diffs-to-overlays (ediff-extract-diffs ediff-diff-buffer ediff-word-mode ediff-narrow-bounds)) ) ;; If file-A/B/C is nil, do 2-way comparison with the non-nil buffers ;; This function works for diff3 and diff2 jobs (defun ediff-setup-fine-diff-regions (file-A file-B file-C reg-num) (or (ediff-buffer-live-p ediff-fine-diff-buffer) (setq ediff-fine-diff-buffer (get-buffer-create (ediff-unique-buffer-name "*ediff-fine-diff" "*")))) (let (diff3-job diff-program ok-regexp diff-list) (setq diff3-job ediff-3way-job diff-program (if diff3-job ediff-diff3-program ediff-diff-program) ok-regexp (if diff3-job ediff-diff3-ok-lines-regexp ediff-diff-ok-lines-regexp)) (ediff-message-if-verbose "Refining difference region %d ..." (1+ reg-num)) (ediff-exec-process diff-program ediff-fine-diff-buffer 'synchronize ;; The shuffle below is because we can compare 3-way ;; or in several 2-way fashions, like fA fC, fA fB, ;; or fB fC. (if file-A file-A file-B) (if file-B file-B file-A) (if diff3-job (if file-C file-C file-B)) ) ; exec process (ediff-prepare-error-list ok-regexp ediff-fine-diff-buffer) ;;(ediff-message-if-verbose ;; "Refining difference region %d ... done" (1+ reg-num)) (setq diff-list (if diff3-job (ediff-extract-diffs3 ediff-fine-diff-buffer '3way-comparison 'word-mode) (ediff-extract-diffs ediff-fine-diff-buffer 'word-mode))) ;; fixup diff-list (if diff3-job (cond ((not file-A) (mapcar (function (lambda (elt) (aset elt 0 nil) (aset elt 1 nil))) (cdr diff-list))) ((not file-B) (mapcar (function (lambda (elt) (aset elt 2 nil) (aset elt 3 nil))) (cdr diff-list))) ((not file-C) (mapcar (function (lambda (elt) (aset elt 4 nil) (aset elt 5 nil))) (cdr diff-list))) )) (ediff-convert-fine-diffs-to-overlays diff-list reg-num) )) (defun ediff-prepare-error-list (ok-regexp diff-buff) (or (ediff-buffer-live-p ediff-error-buffer) (setq ediff-error-buffer (get-buffer-create (ediff-unique-buffer-name "*ediff-errors" "*")))) (ediff-eval-in-buffer ediff-error-buffer (erase-buffer) (insert (ediff-eval-in-buffer diff-buff (buffer-string))) (goto-char (point-min)) (delete-matching-lines ok-regexp) (if (memq system-type '(vax-vms axp-vms)) (delete-matching-lines "^$"))) ;; If diff reports errors, show them then quit. (if (/= 0 (ediff-eval-in-buffer ediff-error-buffer (buffer-size))) (let ((ctl-buf ediff-control-buffer) (error-buf ediff-error-buffer)) (ediff-skip-unsuitable-frames) (switch-to-buffer error-buf) (ediff-kill-buffer-carefully ctl-buf) (error "Errors in diff output. Diff output is in %S" diff-buff)))) ;; BOUNDS specifies visibility bounds to use. ;; WORD-MODE tells whether we are in the word-mode or not. ;; If WORD-MODE, also construct vector of diffs using word numbers. ;; Else, use point values. ;; This function handles diff-2 jobs including the case of ;; merging buffers and files without ancestor. (defun ediff-extract-diffs (diff-buffer word-mode &optional bounds) (let ((A-buffer ediff-buffer-A) (B-buffer ediff-buffer-B) (C-buffer ediff-buffer-C) (a-prev 1) ; this is needed to set the first diff line correctly (b-prev 1) (c-prev 1) diff-list shift-A shift-B ) ;; diff list contains word numbers, unless changed later (setq diff-list (cons (if word-mode 'words 'points) diff-list)) ;; we don't use visibility bounds for buffer C when merging (if bounds (setq shift-A (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'A bounds)) shift-B (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'B bounds)))) ;; reset point in buffers A/B/C (ediff-eval-in-buffer A-buffer (goto-char (if shift-A shift-A (point-min)))) (ediff-eval-in-buffer B-buffer (goto-char (if shift-B shift-B (point-min)))) (if (ediff-buffer-live-p C-buffer) (ediff-eval-in-buffer C-buffer (goto-char (point-min)))) (ediff-eval-in-buffer diff-buffer (goto-char (point-min)) (while (re-search-forward ediff-match-diff-line nil t) (let* ((a-begin (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))) (a-end (let ((b (match-beginning 3)) (e (match-end 3))) (if b (string-to-int (buffer-substring b e)) a-begin))) (diff-type (buffer-substring (match-beginning 4) (match-end 4))) (b-begin (string-to-int (buffer-substring (match-beginning 5) (match-end 5)))) (b-end (let ((b (match-beginning 7)) (e (match-end 7))) (if b (string-to-int (buffer-substring b e)) b-begin))) a-begin-pt a-end-pt b-begin-pt b-end-pt c-begin c-end c-begin-pt c-end-pt) ;; fix the beginning and end numbers, because diff is somewhat ;; strange about how it numbers lines (if (string-equal diff-type "a") (setq b-end (1+ b-end) a-begin (1+ a-begin) a-end a-begin) (if (string-equal diff-type "d") (setq a-end (1+ a-end) b-begin (1+ b-begin) b-end b-begin) ;; (string-equal diff-type "c") (setq a-end (1+ a-end) b-end (1+ b-end)))) (if (eq ediff-default-variant 'default-B) (setq c-begin b-begin c-end b-end) (setq c-begin a-begin c-end a-end)) ;; compute main diff vector (if word-mode ;; make diff-list contain word numbers (setq diff-list (nconc diff-list (list (if (ediff-buffer-live-p C-buffer) (vector (- a-begin a-prev) (- a-end a-begin) (- b-begin b-prev) (- b-end b-begin) (- c-begin c-prev) (- c-end c-begin) nil nil ; dummy ancestor nil ; state of diff nil ; state of merge nil ; state of ancestor ) (vector (- a-begin a-prev) (- a-end a-begin) (- b-begin b-prev) (- b-end b-begin) nil nil ; dummy buf C nil nil ; dummy ancestor nil ; state of diff nil ; state of merge nil ; state of ancestor )) )) a-prev a-end b-prev b-end c-prev c-end) ;; else convert lines to points (ediff-eval-in-buffer A-buffer (forward-line (- a-begin a-prev)) (setq a-begin-pt (point)) (forward-line (- a-end a-begin)) (setq a-end-pt (point) a-prev a-end)) (ediff-eval-in-buffer B-buffer (forward-line (- b-begin b-prev)) (setq b-begin-pt (point)) (forward-line (- b-end b-begin)) (setq b-end-pt (point) b-prev b-end)) (if (ediff-buffer-live-p C-buffer) (ediff-eval-in-buffer C-buffer (forward-line (- c-begin c-prev)) (setq c-begin-pt (point)) (forward-line (- c-end c-begin)) (setq c-end-pt (point) c-prev c-end))) (setq diff-list (nconc diff-list (list (if (ediff-buffer-live-p C-buffer) (vector a-begin-pt a-end-pt b-begin-pt b-end-pt c-begin-pt c-end-pt nil nil ; dummy ancestor ;; state of diff ;; shows which buff is different from the other two (if (eq ediff-default-variant 'default-B) 'A 'B) ediff-default-variant ; state of merge nil ; state of ancestor ) (vector a-begin-pt a-end-pt b-begin-pt b-end-pt nil nil ; dummy buf C nil nil ; dummy ancestor nil nil ; dummy state of diff & merge nil ; dummy state of ancestor ))) ))) ))) ; end ediff-eval-in-buffer diff-list )) (defun ediff-convert-diffs-to-overlays (diff-list) (ediff-set-diff-overlays-in-one-buffer 'A diff-list) (ediff-set-diff-overlays-in-one-buffer 'B diff-list) (if ediff-3way-job (ediff-set-diff-overlays-in-one-buffer 'C diff-list)) (if ediff-merge-with-ancestor-job (ediff-set-diff-overlays-in-one-buffer 'Ancestor diff-list)) ;; set up vector showing the status of merge regions (if ediff-merge-job (setq ediff-state-of-merge (vconcat (mapcar (function (lambda (elt) (let ((state-of-merge (aref elt 9)) (state-of-ancestor (aref elt 10))) (vector (if state-of-merge (format "%S" state-of-merge)) state-of-ancestor)))) ;; the first elt designates type of list (cdr diff-list)) ))) (message "Processing difference regions ... done")) (defun ediff-set-diff-overlays-in-one-buffer (buf-type diff-list) (let* ((current-diff -1) (buff (ediff-get-buffer buf-type)) ;; ediff-extract-diffs puts the type of diff-list as the first elt ;; of this list. The type is either 'points or 'words (diff-list-type (car diff-list)) (shift (ediff-overlay-start (ediff-get-value-according-to-buffer-type buf-type ediff-narrow-bounds))) (limit (ediff-overlay-end (ediff-get-value-according-to-buffer-type buf-type ediff-narrow-bounds))) diff-overlay-list list-element total-diffs begin end pt-saved overlay state-of-diff) (setq diff-list (cdr diff-list)) ; discard diff list type (setq total-diffs (length diff-list)) ;; shift, if necessary (ediff-eval-in-buffer buff (setq pt-saved shift)) (while diff-list (setq current-diff (1+ current-diff) list-element (car diff-list) begin (aref list-element (cond ((eq buf-type 'A) 0) ((eq buf-type 'B) 2) ((eq buf-type 'C) 4) (t 6))) ; Ancestor end (aref list-element (cond ((eq buf-type 'A) 1) ((eq buf-type 'B) 3) ((eq buf-type 'C) 5) (t 7))) ; Ancestor state-of-diff (aref list-element 8) ) (cond ((and (not (eq buf-type state-of-diff)) (not (eq buf-type 'Ancestor)) (memq state-of-diff '(A B C))) (setq state-of-diff (car (delq buf-type (delq state-of-diff (list 'A 'B 'C))))) (setq state-of-diff (format "=diff(%S)" state-of-diff)) ) (t (setq state-of-diff nil))) ;; Put overlays at appropriate places in buffer ;; convert word numbers to points, if necessary (if (eq diff-list-type 'words) (progn (ediff-eval-in-buffer buff (goto-char pt-saved)) (setq begin (ediff-goto-word (1+ begin) buff) end (ediff-goto-word end buff 'end)) (if (> end limit) (setq end limit)) (if (> begin end) (setq begin end)) (setq pt-saved (ediff-eval-in-buffer buff (point))))) (setq overlay (ediff-make-bullet-proof-overlay begin end buff)) ;; Priorities of overlays should be equal in all ediff control ;; panel buffers. Otherwise it won't work due to Emacs ;; bug, as insert-in-front-hooks will be called ;; only on behalf of the buffer with higher priority. (ediff-overlay-put overlay 'priority ediff-shadow-overlay-priority) (ediff-overlay-put overlay 'ediff-diff-num current-diff) (ediff-overlay-put overlay 'insert-in-front-hooks '(ediff-insert-in-front)) (if (and (ediff-window-display-p) ediff-use-faces ediff-highlight-all-diffs) (ediff-set-overlay-face overlay (ediff-background-face buf-type current-diff))) (if (= 0 (mod current-diff 10)) (message "Buffer %S: Processing difference region %d of %d" buf-type current-diff total-diffs)) ;; record all overlays for this difference ;; the second elt, nil, is a place holder for the fine diff vector. ;; the third elt, nil, is a place holder for no-fine-diffs flag. (setq diff-overlay-list (nconc diff-overlay-list (list (vector overlay nil nil state-of-diff))) diff-list (cdr diff-list)) ) ; while (set (intern (format "ediff-difference-vector-%S" buf-type)) (vconcat diff-overlay-list)) )) ;; `n' is the diff region to work on. Default is ediff-current-difference. ;; if `flag' is 'noforce then make fine-diffs only if this region's fine ;; diffs have not been computed before. ;; if `flag' is 'skip then don't compute fine diffs for this region. (defun ediff-make-fine-diffs (&optional n flag) (or n (setq n ediff-current-difference)) (if (< ediff-number-of-differences 1) (error "No differences found")) (if ediff-word-mode (setq flag 'skip ediff-auto-refine 'nix)) (or (< n 0) (>= n ediff-number-of-differences) ;; n is within the range (let ((tmp-buffer (get-buffer-create ediff-tmp-buffer)) (file-A ediff-temp-file-A) (file-B ediff-temp-file-B) (file-C ediff-temp-file-C) (empty-A (ediff-empty-diff-region-p n 'A)) (empty-B (ediff-empty-diff-region-p n 'B)) (empty-C (ediff-empty-diff-region-p n 'C)) (whitespace-A (ediff-whitespace-diff-region-p n 'A)) (whitespace-B (ediff-whitespace-diff-region-p n 'B)) (whitespace-C (ediff-whitespace-diff-region-p n 'C)) cumulative-fine-diff-length) (cond ((and (eq flag 'noforce) (ediff-get-fine-diff-vector n 'A)) ;; don't compute fine diffs if diff vector exists (if (ediff-no-fine-diffs-p n) (ediff-message-if-verbose "Only white-space differences in region %d" (1+ n)))) ;; If one of the regions is empty (or 2 in 3way comparison) ;; then don't refine. ;; If the region happens to be entirely whitespace or empty then ;; mark as such. ((> (length (delq nil (list empty-A empty-B empty-C))) 1) (if (and (ediff-looks-like-combined-merge n) ediff-merge-job) (ediff-set-fine-overlays-in-one-buffer 'C nil n)) (if ediff-3way-comparison-job (ediff-message-if-verbose "Region %d is empty in all buffers but %S" (1+ n) (cond ((not empty-A) 'A) ((not empty-B) 'B) ((not empty-C) 'C))) (ediff-message-if-verbose "Region %d in buffer %S is empty" (1+ n) (cond (empty-A 'A) (empty-B 'B) (empty-C 'C))) ) ;; if all regions happen to be whitespace, indicate this (if (and whitespace-A whitespace-B whitespace-C) (ediff-mark-diff-as-space-only n t) (ediff-mark-diff-as-space-only n nil))) ;; don't compute fine diffs for this region ((eq flag 'skip) (or (ediff-get-fine-diff-vector n 'A) (memq ediff-auto-refine '(off nix)) (ediff-message-if-verbose "Region %d exceeds auto-refine limit. `%s' force-refines" (1+ n) (substitute-command-keys "\\[ediff-make-or-kill-fine-diffs]") ))) (t ;; recompute fine diffs (ediff-wordify (ediff-get-diff-posn 'A 'beg n) (ediff-get-diff-posn 'A 'end n) ediff-buffer-A tmp-buffer ediff-control-buffer) (setq file-A (ediff-make-temp-file tmp-buffer "fineDiffA" file-A)) (ediff-wordify (ediff-get-diff-posn 'B 'beg n) (ediff-get-diff-posn 'B 'end n) ediff-buffer-B tmp-buffer ediff-control-buffer) (setq file-B (ediff-make-temp-file tmp-buffer "fineDiffB" file-B)) (if ediff-3way-job (progn (ediff-wordify (ediff-get-diff-posn 'C 'beg n) (ediff-get-diff-posn 'C 'end n) ediff-buffer-C tmp-buffer ediff-control-buffer) (setq file-C (ediff-make-temp-file tmp-buffer "fineDiffC" file-C)))) ;; save temp file names. (setq ediff-temp-file-A file-A ediff-temp-file-B file-B ediff-temp-file-C file-C) ;; set the new vector of fine diffs, if none exists (cond ((and ediff-3way-job whitespace-A) (ediff-setup-fine-diff-regions nil file-B file-C n)) ((and ediff-3way-job whitespace-B) (ediff-setup-fine-diff-regions file-A nil file-C n)) ((and ediff-3way-job (or whitespace-C (and ediff-merge-job (ediff-looks-like-combined-merge n)))) (ediff-setup-fine-diff-regions file-A file-B nil n)) (t (ediff-setup-fine-diff-regions file-A file-B file-C n))) (setq cumulative-fine-diff-length (+ (length (ediff-get-fine-diff-vector n 'A)) (length (ediff-get-fine-diff-vector n 'B)) (if file-C (length (ediff-get-fine-diff-vector n 'C)) 0))) (cond ((or ;; all regions are white space (and whitespace-A whitespace-B whitespace-C) ;; none is white space and no fine diffs detected (and (not whitespace-A) (not whitespace-B) (not (and ediff-3way-job whitespace-C)) (eq cumulative-fine-diff-length 0))) (ediff-mark-diff-as-space-only n t) (ediff-message-if-verbose "Only white-space differences in region %d" (1+ n))) ((eq cumulative-fine-diff-length 0) (ediff-mark-diff-as-space-only n nil) (ediff-message-if-verbose "Only white-space differences in region %d %s" (1+ n) (cond (whitespace-A "in buffers B & C") (whitespace-B "in buffers A & C") (whitespace-C "in buffers A & B")))) (t (ediff-mark-diff-as-space-only n nil))) ) ) ; end cond (ediff-set-fine-diff-properties n) ))) ;; Interface to ediff-make-fine-diffs. Checks for auto-refine limit, etc. (defun ediff-install-fine-diff-if-necessary (n) (cond ((eq ediff-auto-refine 'on) (if (and (> ediff-auto-refine-limit (- (ediff-get-diff-posn 'A 'end n) (ediff-get-diff-posn 'A 'beg n))) (> ediff-auto-refine-limit (- (ediff-get-diff-posn 'B 'end n) (ediff-get-diff-posn 'B 'beg n)))) (ediff-make-fine-diffs n 'noforce) (ediff-make-fine-diffs n 'skip))) ;; highlight iff fine diffs already exist ((eq ediff-auto-refine 'off) (ediff-make-fine-diffs n 'skip)))) ;; if fine diff vector is not set for diff N, then do nothing (defun ediff-set-fine-diff-properties (n &optional default) (or (not (ediff-window-display-p)) (< n 0) (>= n ediff-number-of-differences) ;; in a window system, set faces and priorities of fine overlays (progn (ediff-set-fine-diff-properties-in-one-buffer 'A n default) (ediff-set-fine-diff-properties-in-one-buffer 'B n default) (if ediff-3way-job (ediff-set-fine-diff-properties-in-one-buffer 'C n default))))) (defun ediff-set-fine-diff-properties-in-one-buffer (buf-type n &optional default) (let ((fine-diff-vector (ediff-get-fine-diff-vector n buf-type)) (face (if default 'default (face-name (intern (format "ediff-fine-diff-face-%S" buf-type))))) (priority (if default 0 (1+ (or (ediff-overlay-get (symbol-value (intern (format "ediff-current-diff-overlay-%S" buf-type))) 'priority) 0))))) (mapcar (function (lambda (overl) (ediff-set-overlay-face overl face) (ediff-overlay-put overl 'priority priority))) fine-diff-vector))) ;; This assumes buffer C and that the region looks like a combination of ;; regions in buffer A and C. (defun ediff-set-fine-overlays-for-combined-merge (diff-list reg-num) (let (overlay1 overlay2 overlay3) (setq overlay1 (ediff-make-bullet-proof-overlay (nth 0 diff-list) (nth 1 diff-list) ediff-buffer-C) overlay2 (ediff-make-bullet-proof-overlay (nth 2 diff-list) (nth 3 diff-list) ediff-buffer-C) overlay3 (ediff-make-bullet-proof-overlay (nth 4 diff-list) (nth 5 diff-list) ediff-buffer-C)) (ediff-set-fine-diff-vector reg-num 'C (vector overlay1 overlay2 overlay3)) )) ;; Convert diff list to overlays for a given DIFF-REGION ;; in buffer of type BUF-TYPE (defun ediff-set-fine-overlays-in-one-buffer (buf-type diff-list region-num) (let* ((current-diff -1) (reg-start (ediff-get-diff-posn buf-type 'beg region-num)) (buff (ediff-get-buffer buf-type)) combined-merge-diff-list diff-overlay-list list-element begin end overlay) (ediff-clear-fine-differences-in-one-buffer region-num buf-type) (setq diff-list (cdr diff-list)) ; discard list type (words or points) (ediff-eval-in-buffer buff (goto-char reg-start)) ;; if it is a combined merge then set overlays in buff C specially (if (and ediff-merge-job (eq buf-type 'C) (setq combined-merge-diff-list (ediff-looks-like-combined-merge region-num))) (ediff-set-fine-overlays-for-combined-merge combined-merge-diff-list region-num) ;; regular fine diff (while diff-list (setq current-diff (1+ current-diff) list-element (car diff-list) begin (aref list-element (cond ((eq buf-type 'A) 0) ((eq buf-type 'B) 2) (t 4))) ; buf C end (aref list-element (cond ((eq buf-type 'A) 1) ((eq buf-type 'B) 3) (t 5)))) ; buf C (if (not (or begin end)) () ; skip this diff ;; Put overlays at appropriate places in buffers ;; convert lines to points, if necessary (setq begin (ediff-goto-word (1+ begin) buff) end (ediff-goto-word end buff 'end)) (setq overlay (ediff-make-bullet-proof-overlay begin end buff)) ;; record all overlays for this difference region (setq diff-overlay-list (nconc diff-overlay-list (list overlay)))) (setq diff-list (cdr diff-list)) ) ; while ;; convert the list of difference information into a vector ;; for fast access (ediff-set-fine-diff-vector region-num buf-type (vconcat diff-overlay-list)) ))) ;; Stolen from emerge.el (defun ediff-get-diff3-group (file) ;; This save-excursion allows ediff-get-diff3-group to be called for the ;; various groups of lines (1, 2, 3) in any order, and for the lines to ;; appear in any order. The reason this is necessary is that Gnu diff3 ;; can produce the groups in the order 1, 2, 3 or 1, 3, 2. (save-excursion (re-search-forward (concat "^" file ":\\([0-9]+\\)\\(,\\([0-9]+\\)\\)?\\([ac]\\)$")) (beginning-of-line 2) ;; treatment depends on whether it is an "a" group or a "c" group (if (string-equal (buffer-substring (match-beginning 4) (match-end 4)) "c") ;; it is a "c" group (if (match-beginning 2) ;; it has two numbers (list (string-to-int (buffer-substring (match-beginning 1) (match-end 1))) (1+ (string-to-int (buffer-substring (match-beginning 3) (match-end 3))))) ;; it has one number (let ((x (string-to-int (buffer-substring (match-beginning 1) (match-end 1))))) (list x (1+ x)))) ;; it is an "a" group (let ((x (1+ (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))))) (list x x))))) ;; If WORD-MODE, construct vector of diffs using word numbers. ;; Else, use point values. ;; WORD-MODE also tells if we are in the word-mode or not. ;; If THREE-WAY-COMP, then it is a 3-way comparison. Else, it is merging ;; with ancestor, in which case buffer-C contents is identical to buffer-A/B, ;; contents (unless buffer-A is narrowed) depending on ediff-default-variant's ;; value. ;; BOUNDS specifies visibility bounds to use. (defun ediff-extract-diffs3 (diff-buffer word-mode three-way-comp &optional bounds) (let ((A-buffer ediff-buffer-A) (B-buffer ediff-buffer-B) (C-buffer ediff-buffer-C) (anc-buffer ediff-ancestor-buffer) (a-prev 1) ; needed to set the first diff line correctly (b-prev 1) (c-prev 1) (anc-prev 1) diff-list shift-A shift-B shift-C ) ;; diff list contains word numbers or points, depending on word-mode (setq diff-list (cons (if word-mode 'words 'points) diff-list)) (if bounds (setq shift-A (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'A bounds)) shift-B (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'B bounds)) shift-C (if three-way-comp (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'C bounds))))) ;; reset point in buffers A, B, C (ediff-eval-in-buffer A-buffer (goto-char (if shift-A shift-A (point-min)))) (ediff-eval-in-buffer B-buffer (goto-char (if shift-B shift-B (point-min)))) (if three-way-comp (ediff-eval-in-buffer C-buffer (goto-char (if shift-C shift-C (point-min))))) (if (ediff-buffer-live-p anc-buffer) (ediff-eval-in-buffer anc-buffer (goto-char (point-min)))) (ediff-eval-in-buffer diff-buffer (goto-char (point-min)) (while (re-search-forward ediff-match-diff3-line nil t) ;; leave point after matched line (beginning-of-line 2) (let ((agreement (buffer-substring (match-beginning 1) (match-end 1)))) ;; if the A and B files are the same and not 3way-comparison, ;; ignore the difference (if (or three-way-comp (not (string-equal agreement "3"))) (let* ((a-begin (car (ediff-get-diff3-group "1"))) (a-end (nth 1 (ediff-get-diff3-group "1"))) (b-begin (car (ediff-get-diff3-group "2"))) (b-end (nth 1 (ediff-get-diff3-group "2"))) (c-or-anc-begin (car (ediff-get-diff3-group "3"))) (c-or-anc-end (nth 1 (ediff-get-diff3-group "3"))) (state-of-merge (cond ((string-equal agreement "1") 'prefer-A) ((string-equal agreement "2") 'prefer-B) (t ediff-default-variant))) (state-of-diff-merge (if (memq state-of-merge '(default-A prefer-A)) 'B 'A)) (state-of-diff-comparison (cond ((string-equal agreement "1") 'A) ((string-equal agreement "2") 'B) ((string-equal agreement "3") 'C))) state-of-ancestor c-begin c-end a-begin-pt a-end-pt b-begin-pt b-end-pt c-begin-pt c-end-pt anc-begin-pt anc-end-pt) (setq state-of-ancestor (= c-or-anc-begin c-or-anc-end)) (cond (three-way-comp (setq c-begin c-or-anc-begin c-end c-or-anc-end)) ((eq ediff-default-variant 'default-B) (setq c-begin b-begin c-end b-end)) (t (setq c-begin a-begin c-end a-end))) ;; compute main diff vector (if word-mode ;; make diff-list contain word numbers (setq diff-list (nconc diff-list (list (vector (- a-begin a-prev) (- a-end a-begin) (- b-begin b-prev) (- b-end b-begin) (- c-begin c-prev) (- c-end c-begin) nil nil ; dummy ancestor nil ; state of diff nil ; state of merge nil ; state of ancestor ))) a-prev a-end b-prev b-end c-prev c-end) ;; else convert lines to points (ediff-eval-in-buffer A-buffer (forward-line (- a-begin a-prev)) (setq a-begin-pt (point)) (forward-line (- a-end a-begin)) (setq a-end-pt (point) a-prev a-end)) (ediff-eval-in-buffer B-buffer (forward-line (- b-begin b-prev)) (setq b-begin-pt (point)) (forward-line (- b-end b-begin)) (setq b-end-pt (point) b-prev b-end)) (ediff-eval-in-buffer C-buffer (forward-line (- c-begin c-prev)) (setq c-begin-pt (point)) (forward-line (- c-end c-begin)) (setq c-end-pt (point) c-prev c-end)) (if (ediff-buffer-live-p anc-buffer) (ediff-eval-in-buffer anc-buffer (forward-line (- c-or-anc-begin anc-prev)) (setq anc-begin-pt (point)) (forward-line (- c-or-anc-end c-or-anc-begin)) (setq anc-end-pt (point) anc-prev c-or-anc-end))) (setq diff-list (nconc diff-list ;; if comparing with ancestor, then there also is a ;; state-of-difference marker (if three-way-comp (list (vector a-begin-pt a-end-pt b-begin-pt b-end-pt c-begin-pt c-end-pt nil nil ; ancestor begin/end state-of-diff-comparison nil ; state of merge nil ; state of ancestor )) (list (vector a-begin-pt a-end-pt b-begin-pt b-end-pt c-begin-pt c-end-pt anc-begin-pt anc-end-pt state-of-diff-merge state-of-merge state-of-ancestor ))) ))) )) ))) ; end ediff-eval-in-buffer diff-list )) ;; Generate the difference vector and overlays for three files ;; File-C is either the third file to compare (in case of 3-way comparison) ;; or it is the ancestor file. (defun ediff-setup-diff-regions3 (file-A file-B file-C) ;; force all minibuffers to display ediff's messages. ;; when xemacs implements minibufferless frames, this won't be necessary (if ediff-xemacs-p (setq synchronize-minibuffers t)) (or (ediff-buffer-live-p ediff-diff-buffer) (setq ediff-diff-buffer (get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*")))) (message "Computing differences ...") (ediff-exec-process ediff-diff3-program ediff-diff-buffer 'synchronize ediff-diff3-options file-A file-B file-C) (ediff-prepare-error-list ediff-diff3-ok-lines-regexp ediff-diff-buffer) ;;(message "Computing differences ... done") (ediff-convert-diffs-to-overlays (ediff-extract-diffs3 ediff-diff-buffer ediff-word-mode ediff-3way-comparison-job ediff-narrow-bounds) )) ;; Execute PROGRAM asynchronously, unless OS/2 or unless SYNCH is non-nil. ;; BUFFER must be a buffer object, and must be alive. ;; All arguments in ARGS must be strings. The first arg may be a blank string, ;; in which case we delete it from ARGS list. We also delete nil from args. (defun ediff-exec-process (program buffer synch &rest args) (let ((data (match-data))) (if (string-match "^[ \t]*$" (car args)) ; delete blank string (setq args (cdr args))) (setq args (delq nil args)) ; delete nil from arguments (setq args (ediff-split-string (mapconcat 'identity args " "))) (unwind-protect (let ((directory default-directory) proc) (save-excursion (set-buffer buffer) (erase-buffer) (setq default-directory directory) (if (or (eq system-type 'emx) synch) ;; In OS/2 do it synchronously, since OS/2 doesn't let us ;; delete files used by other processes. Thus, in ediff-buffers ;; and similar functions, we can't delete temp files because ;; they might be used by the asynch process that computes ;; custom diffs. So, we have to wait till custom diff ;; subprocess is done. (apply 'call-process program nil buffer nil args) ;; On other systems, do it asynchronously. (setq proc (get-buffer-process buffer)) (if proc (kill-process proc)) (setq proc (apply 'start-process "Custom Diff" buffer program args)) (setq mode-line-process '(":%s")) (set-process-sentinel proc 'ediff-process-sentinel) (set-process-filter proc 'ediff-process-filter) ))) (store-match-data data)))) ;; This is shell-command-filter from simple.el in FSF Emacs. ;; Copied here because XEmacs doesn't have it. (defun ediff-process-filter (proc string) ;; Do save-excursion by hand so that we can leave point numerically unchanged ;; despite an insertion immediately after it. (let* ((obuf (current-buffer)) (buffer (process-buffer proc)) opoint (window (get-buffer-window buffer)) (pos (window-start window))) (unwind-protect (progn (set-buffer buffer) (or (= (point) (point-max)) (setq opoint (point))) (goto-char (point-max)) (insert-before-markers string)) ;; insert-before-markers moved this marker: set it back. (set-window-start window pos) ;; Finish our save-excursion. (if opoint (goto-char opoint)) (set-buffer obuf)))) ;; like shell-command-sentinel but doesn't print an exit status message ;; we do this because diff always exits with status 1, if diffs are found ;; so shell-command-sentinel displays a confusing message to the user (defun ediff-process-sentinel (process signal) (if (and (memq (process-status process) '(exit signal)) (buffer-name (process-buffer process))) (progn (save-excursion (set-buffer (process-buffer process)) (setq mode-line-process nil)) (delete-process process)))) ;;; Word functions used to refine the current diff (defvar ediff-forward-word-function 'ediff-forward-word "*Function to call to move to the next word. Used for splitting difference regions into individual words.") (defvar ediff-whitespace " \n\t\f" "*Characters constituting white space. These characters are ignored when differing regions are split into words.") ;;(defvar ediff-word-1 "a-zA-Z---_`'.?!:" (defvar ediff-word-1 "a-zA-Z---_" "*Characters that constitute words of type 1. More precisely, [ediff-word-1] is a regexp that matches type 1 words. See `ediff-forward-word' for more details.") (defvar ediff-word-2 "0-9.," "*Characters that constitute words of type 2. More precisely, [ediff-word-2] is a regexp that matches type 2 words. See `ediff-forward-word' for more details.") (defvar ediff-word-3 "`'?!:;\"{}[]()" "*Characters that constitute words of type 3. More precisely, [ediff-word-3] is a regexp that matches type 3 words. See `ediff-forward-word' for more details.") (defvar ediff-word-4 (concat "^" ediff-word-1 ediff-word-2 ediff-word-3 ediff-whitespace) "*Characters that constitute words of type 4. More precisely, [ediff-word-4] is a regexp that matches type 4 words. See `ediff-forward-word' for more details.") ;; Split region along word boundaries. Each word will be on its own line. ;; Output to buffer out-buffer. (defun ediff-forward-word () "Move point one word forward. There are four types of words, each of which consists entirely of characters in `ediff-word-1', `ediff-word-2', `ediff-word-3', or `ediff-word-4'. Words are recognized by passing these in turn as the argument to `skip-chars-forward'." (or (> (skip-chars-forward ediff-word-1) 0) (> (skip-chars-forward ediff-word-2) 0) (> (skip-chars-forward ediff-word-3) 0) (> (skip-chars-forward ediff-word-4) 0) )) (defun ediff-wordify (beg end in-buffer out-buffer &optional control-buf) (let (sv-point string) (save-excursion (set-buffer in-buffer) (setq string (buffer-substring beg end)) (set-buffer out-buffer) (erase-buffer) (insert string) (goto-char (point-min)) (skip-chars-forward ediff-whitespace) (delete-region (point-min) (point)) (while (not (eobp)) ;; eval incontrol buf to let user create local versions for ;; different invocations (if control-buf (funcall (ediff-eval-in-buffer control-buf ediff-forward-word-function)) (funcall ediff-forward-word-function)) (setq sv-point (point)) (skip-chars-forward ediff-whitespace) (delete-region sv-point (point)) (insert "\n"))))) ;; copy string from BEG END from IN-BUF to OUT-BUF (defun ediff-copy-to-buffer (beg end in-buffer out-buffer) (let (string) (save-excursion (set-buffer in-buffer) (setq string (buffer-substring beg end)) (set-buffer out-buffer) (erase-buffer) (insert string) (goto-char (point-min))))) ;; goto word #n starting at current position in buffer `buf' ;; For ediff, a word is either a string of a-z,A-Z, incl `-' and `_'; ;; or a string of other non-blanks. A blank is a \n\t\f ;; If `flag' is non-nil, goto the end of the n-th word. (defun ediff-goto-word (n buf &optional flag) ;; remember val ediff-forward-word-function has in ctl buf (let ((fwd-word-fun ediff-forward-word-function)) (ediff-eval-in-buffer buf (skip-chars-forward ediff-whitespace) (while (> n 1) (funcall fwd-word-fun) (skip-chars-forward ediff-whitespace) (setq n (1- n))) (if (and flag (> n 0)) (funcall fwd-word-fun)) (point)))) (provide 'ediff-diff) ;; ediff-diff.el ends here emacs-19.30/lisp/ediff-hook.el100444 12120 1 26122 6054204233 14425 0ustar rmsdaemon;;; ediff-hook.el --- setup for Ediff's menus and autoloads ;;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; These must be placed in menu-bar.el in Emacs ;; ;; (define-key menu-bar-tools-menu [eregistry] ;; '("List Ediff Sessions" . ediff-show-registry)) ;; (define-key menu-bar-tools-menu [epatch] ;; '("Apply Patch" . menu-bar-epatch-menu)) ;; (define-key menu-bar-tools-menu [ediff-merge] ;; '("Merge" . menu-bar-ediff-merge-menu)) ;; (define-key menu-bar-tools-menu [ediff] ;; '("Compare" . menu-bar-ediff-menu)) (defun ediff-xemacs-init-menus () (if (featurep 'menubar) (progn (add-submenu '("Tools") ediff-menu "OO-Browser...") (add-submenu '("Tools") ediff-merge-menu "OO-Browser...") (add-submenu '("Tools") epatch-menu "OO-Browser...") (add-menu-button '("Tools") ["List Ediff Sessions" ediff-show-registry t] "OO-Browser...") (add-menu-button '("Tools") ["---" nil nil] "OO-Browser...") ))) ;; explicit string-match is needed: ediff-xemacs-p is not defined at build time (cond ((string-match "XEmacs" emacs-version) (defvar ediff-menu '("Compare" ["Two Files ..." ediff-files t] ["Two Buffers ..." ediff-buffers t] ["Three Files ..." ediff-files3 t] ["Three Buffers ..." ediff-buffers3 t] "---" ["Two Directories ..." ediff-directories t] ["Three Directories ..." ediff-directories3 t] "---" ["File with Revision ..." ediff-revision t] ["Directory Revisions ..." ediff-directory-revisions t] "---" ["Windows Word-by-word ..." ediff-windows-wordwise t] ["Windows Line-by-line ..." ediff-windows-linewise t] "---" ["Regions Word-by-word ..." ediff-regions-wordwise t] ["Regions Line-by-line ..." ediff-regions-linewise t])) (defvar ediff-merge-menu '("Merge" ["Files ..." ediff-merge-files t] ["Files with Ancestor ..." ediff-merge-files-with-ancestor t] ["Buffers ..." ediff-merge-buffers t] ["Buffers with Ancestor ..." ediff-merge-buffers-with-ancestor t] "---" ["Directories ..." ediff-merge-directories t] ["Directories with Ancestor ..." ediff-merge-directories-with-ancestor t] "---" ["Revisions ..." ediff-merge-revisions t] ["Revisions with Ancestor ..." ediff-merge-revisions-with-ancestor t] ["Directory Revisions ..." ediff-merge-directory-revisions t] ["Directory Revisions with Ancestor ..." ediff-merge-directory-revisions-with-ancestor t])) (defvar epatch-menu '("Apply Patch" ["To a file ..." ediff-patch-file t] ["To a buffer ..." ediff-patch-buffer t])) ;; put these menus before Object-Oriented-Browser in Tools menu (add-hook 'before-init-hook 'ediff-xemacs-init-menus) ;; this `if' is to be deleted before going into distribution (if (not purify-flag) (ediff-xemacs-init-menus)) ) ;; Emacs--only if menu-bar is loaded ((featurep 'menu-bar) ;; initialize menu bar keymaps (defvar menu-bar-epatch-menu (make-sparse-keymap "Apply Patch")) (fset 'menu-bar-epatch-menu (symbol-value 'menu-bar-epatch-menu)) (defvar menu-bar-ediff-merge-menu (make-sparse-keymap "Merge")) (fset 'menu-bar-ediff-merge-menu (symbol-value 'menu-bar-ediff-merge-menu)) (defvar menu-bar-ediff-menu (make-sparse-keymap "Compare")) (fset 'menu-bar-ediff-menu (symbol-value 'menu-bar-ediff-menu)) ;; define ediff-menu (define-key menu-bar-ediff-menu [window] '("This Window And Next Window" . compare-windows)) (define-key menu-bar-ediff-menu [ediff-dir-revision] '("Directory Revisions ..." . ediff-directory-revisions)) (define-key menu-bar-ediff-menu [ediff-revision] '("File with Revision ..." . ediff-revision)) (define-key menu-bar-ediff-menu [separator-ediff-directories] '("--")) (define-key menu-bar-ediff-menu [ediff-directories3] '("Three Directories ..." . ediff-directories3)) (define-key menu-bar-ediff-menu [ediff-directories] '("Two Directories ..." . ediff-directories)) (define-key menu-bar-ediff-menu [separator-ediff-files] '("--")) (define-key menu-bar-ediff-menu [ediff-buffers3] '("Three Buffers ..." . ediff-buffers3)) (define-key menu-bar-ediff-menu [ediff-files3] '("Three Files ..." . ediff-files3)) (define-key menu-bar-ediff-menu [ediff-buffers] '("Two Buffers ..." . ediff-buffers)) (define-key menu-bar-ediff-menu [ediff-files] '("Two Files ..." . ediff-files)) (define-key menu-bar-ediff-menu [separator-ediff-regions] '("--")) (define-key menu-bar-ediff-menu [ediff-regions-linewise] '("Regions Line-by-line ..." . ediff-regions-linewise)) (define-key menu-bar-ediff-menu [ediff-regions-wordwise] '("Regions Word-by-word ..." . ediff-regions-wordwise)) (define-key menu-bar-ediff-menu [separator-ediff-windows] '("--")) (define-key menu-bar-ediff-menu [ediff-windows-linewise] '("Windows Line-by-line ..." . ediff-windows-linewise)) (define-key menu-bar-ediff-menu [ediff-windows-wordwise] '("Windows Word-by-word ..." . ediff-windows-wordwise)) ;; define merge menu (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions-with-ancestor] '("Directory Revisions with Ancestor ..." . ediff-merge-directory-revisions-with-ancestor)) (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions] '("Directory Revisions ..." . ediff-merge-directory-revisions)) (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions-with-ancestor] '("Revisions with Ancestor ..." . ediff-merge-revisions-with-ancestor)) (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions] '("Revisions ..." . ediff-merge-revisions)) (define-key menu-bar-ediff-merge-menu [separator-ediff-merge] '("--")) (define-key menu-bar-ediff-merge-menu [ediff-merge-directories-with-ancestor] '("Directories with Ancestor ..." . ediff-merge-directories-with-ancestor)) (define-key menu-bar-ediff-merge-menu [ediff-merge-directories] '("Directories ..." . ediff-merge-directories)) (define-key menu-bar-ediff-merge-menu [separator-ediff-merge-dirs] '("--")) (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers-with-ancestor] '("Buffers with Ancestor ..." . ediff-merge-buffers-with-ancestor)) (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers] '("Buffers ..." . ediff-merge-buffers)) (define-key menu-bar-ediff-merge-menu [ediff-merge-files-with-ancestor] '("Files with Ancestor ..." . ediff-merge-files-with-ancestor)) (define-key menu-bar-ediff-merge-menu [ediff-merge-files] '("Files ..." . ediff-merge-files)) ;; define epatch menu (define-key menu-bar-epatch-menu [ediff-patch-buffer] '("To a Buffer ..." . ediff-patch-buffer)) (define-key menu-bar-epatch-menu [ediff-patch-file] '("To a File ..." . ediff-patch-file))) ) ; cond ;; arrange for autoloads (if purify-flag () ; if dumping, autoloads are set up in loaddefs.el ;; if the user decides to load this file, set up autoloads ;; compare files and buffers (autoload 'ediff "ediff" "Compare two files" t) (autoload 'ediff-files "ediff" "Compare two files" t) (autoload 'ediff-buffers "ediff" "Compare two bufers" t) (autoload 'ediff3 "ediff" "Compare three files" t) (autoload 'ediff-files3 "ediff" "Compare three files" t) (autoload 'ediff-buffers3 "ediff" "Compare three bufers" t) (autoload 'ediff-revision "ediff" "Compare versions of a file" t) ;; compare regions and windows (autoload 'ediff-windows-wordwise "ediff" "Compare two windows word-by-word" t) (autoload 'ediff-regions-wordwise "ediff" "Compare two regions word-by-word" t) (autoload 'ediff-windows-linewise "ediff" "Compare two windows line-by-line" t) (autoload 'ediff-regions-linewise "ediff" "Compare two regions line-by-line" t) ;; patch (autoload 'ediff-patch-file "ediff" "Patch a file" t) (autoload 'epatch "ediff" "Patch a file" t) (autoload 'ediff-patch-buffer "ediff" "Patch a buffer") (autoload 'epatch-buffer "ediff" "Patch a buffer" t) ;; merge (autoload 'ediff-merge "ediff" "Merge two files" t) (autoload 'ediff-merge-files "ediff" "Merge two files" t) (autoload 'ediff-merge-files-with-ancestor "ediff" "Merge two files using a third file as an ancestor" t) (autoload 'ediff-merge-buffers "ediff" "Merge two buffers" t) (autoload 'ediff-merge-buffers-with-ancestor "ediff" "Merge two buffers using a third buffer as an ancestor" t) (autoload 'ediff-merge-revisions "ediff" "Merge two versions of a file" t) (autoload 'ediff-merge-revisions-with-ancestor "ediff" "Merge two versions of a file" t) ;; compare directories (autoload 'edirs "ediff" "Compare files in two directories" t) (autoload 'ediff-directories "ediff" "Compare files in two directories" t) (autoload 'edirs3 "ediff" "Compare files in three directories" t) (autoload 'ediff-directories3 "ediff" "Compare files in three directories" t) (autoload 'edir-revisions "ediff" "Compare two versions of a file" t) (autoload 'ediff-directory-revisions "ediff" "Compare two versions of a file" t) ;; merge directories (autoload 'edirs-merge "ediff" "Merge files in two directories" t) (autoload 'ediff-merge-directories "ediff" "Merge files in two directories" t) (autoload 'edirs-merge-with-ancestor "ediff" "Merge files in two directories using files in a third dir as ancestors" t) (autoload 'ediff-merge-directories-with-ancestor "ediff" "Merge files in two directories using files in a third dir as ancestors" t) (autoload 'edir-merge-revisions "ediff" "Merge versions of files in a directory" t) (autoload 'ediff-merge-directory-revisions "ediff" "Merge versions of files in a directory" t) (autoload 'ediff-merge-directory-revisions-with-ancestor "ediff" "Merge versions of files in a directory using other versions as ancestors" t) (autoload 'edir-merge-revisions-with-ancestor "ediff" "Merge versions of files in a directory using other versions as ancestors" t) ;; misc (autoload 'ediff-show-registry "ediff-mult" "Display the registry of active Ediff sessions" t) (autoload 'ediff-version "ediff" "Show Ediff's version and last modification date" t) ) ; if purify-flag (provide 'ediff-hook) ;;; ediff-hook.el ends here emacs-19.30/lisp/ediff-init.el100444 75424 1 156631 6050716643 14674 0ustar kwzhdaemon;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff ;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;; Is it XEmacs? (defconst ediff-xemacs-p (string-match "XEmacs" emacs-version)) ;; Is it Emacs? (defconst ediff-emacs-p (not ediff-xemacs-p)) ;; Are we running as a window application or on a TTY? (defsubst ediff-device-type () (if ediff-emacs-p window-system (device-type (selected-device)))) ;; in XEmacs: device-type is tty on tty and stream in batch. (defsubst ediff-window-display-p () (and (ediff-device-type) (not (memq (ediff-device-type) '(tty stream))))) ;;; Macros (defmacro ediff-odd-p (arg) (` (eq (logand (, arg) 1) 1))) (defmacro ediff-buffer-live-p (buf) (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf)))))) (defmacro ediff-get-buffer (arg) (` (cond ((eq (, arg) 'A) ediff-buffer-A) ((eq (, arg) 'B) ediff-buffer-B) ((eq (, arg) 'C) ediff-buffer-C) ((eq (, arg) 'Ancestor) ediff-ancestor-buffer) ) )) (defmacro ediff-get-value-according-to-buffer-type (buf-type list) (` (cond ((eq (, buf-type) 'A) (nth 0 (, list))) ((eq (, buf-type) 'B) (nth 1 (, list))) ((eq (, buf-type) 'C) (nth 2 (, list)))))) (defmacro ediff-char-to-buftype (arg) (` (cond ((memq (, arg) '(?a ?A)) 'A) ((memq (, arg) '(?b ?B)) 'B) ((memq (, arg) '(?c ?C)) 'C) ) )) (defmacro ediff-get-difference (n buf-type) (` (aref (symbol-value (intern (format "ediff-difference-vector-%S" (, buf-type)))) (, n)))) ;; tell if it has been previously determined that the region has ;; no diffs other than the white space and newlines ;; The argument, N, is the diff region number used by Ediff to index the ;; diff vector. It is 1 less than the number seen by the user. ;; ;; A difference vector has the form: ;; [diff diff diff ...] ;; where each diff has the form: ;; [overlay fine-diff-vector no-fine-diffs-flag] ;; fine-diff-vector is a vector [fine-diff fine-diff fine-diff ...] (defmacro ediff-no-fine-diffs-p (n) (` (aref (ediff-get-difference (, n) 'A) 2))) (defmacro ediff-get-diff-overlay-from-diff-record (diff-rec) (` (aref (, diff-rec) 0))) (defmacro ediff-get-diff-overlay (n buf-type) (` (ediff-get-diff-overlay-from-diff-record (ediff-get-difference (, n) (, buf-type))))) (defmacro ediff-get-fine-diff-vector-from-diff-record (diff-rec) (` (aref (, diff-rec) 1))) (defmacro ediff-set-fine-diff-vector (n buf-type fine-vec) (` (aset (ediff-get-difference (, n) (, buf-type)) 1 (, fine-vec)))) (defmacro ediff-get-state-of-diff (n buf-type) (` (if (ediff-buffer-live-p ediff-buffer-C) (aref (ediff-get-difference (, n) (, buf-type)) 3)))) (defmacro ediff-set-state-of-diff (n buf-type val) (` (aset (ediff-get-difference (, n) (, buf-type)) 3 (, val)))) (defmacro ediff-get-state-of-merge (n) (` (if ediff-state-of-merge (aref (aref ediff-state-of-merge (, n)) 0)))) (defmacro ediff-get-state-of-ancestor (n) (` (if ediff-state-of-merge (aref (aref ediff-state-of-merge (, n)) 1)))) (defmacro ediff-set-state-of-merge (n val) (` (if ediff-state-of-merge (aset (aref ediff-state-of-merge (, n)) 0 (, val))))) ;; if flag is t, puts a mark on diff region saying that ;; the differences are in white space only. If flag is nil, ;; the region is marked as essential (i.e., differences are ;; not just in the white space and newlines.) (defmacro ediff-mark-diff-as-space-only (n flag) (` (aset (ediff-get-difference (, n) 'A) 2 (, flag)))) (defmacro ediff-get-fine-diff-vector (n buf-type) (` (ediff-get-fine-diff-vector-from-diff-record (ediff-get-difference (, n) (, buf-type))))) ;; Defines SYMBOL as an advertised local variable. ;; Performs a defvar, then executes `make-variable-buffer-local' on ;; the variable. Also sets the `permanent-local' property, ;; so that `kill-all-local-variables' (called by major-mode setting ;; commands) won't destroy Ediff control variables. ;; ;; Plagiarised from `emerge-defvar-local' for XEmacs. (defmacro ediff-defvar-local (var value doc) (` (progn (defvar (, var) (, value) (, doc)) (make-variable-buffer-local '(, var)) (put '(, var) 'permanent-local t)))) ;; Macro to switch to BUFFER, evaluate FORMS, returns to original buffer. ;; Differs from `save-excursion' in that it doesn't save the point and mark. ;; This is essentially `emerge-eval-in-buffer' with the test for live buffers." (defmacro ediff-eval-in-buffer (buffer &rest forms) (` (let ((StartBuffer (current-buffer))) (if (ediff-buffer-live-p (, buffer)) (unwind-protect (progn (set-buffer (, buffer)) (,@ forms)) (set-buffer StartBuffer)) (or (eq this-command 'ediff-quit) (error "You've killed an essential Ediff buffer---Please quit Ediff")) )))) (defsubst ediff-multiframe-setup-p () (and (ediff-window-display-p) ediff-multiframe)) (defmacro ediff-narrow-control-frame-p () (` (and (ediff-multiframe-setup-p) (equal ediff-help-message ediff-brief-message-string)))) (defmacro ediff-3way-comparison-job () (` (memq ediff-job-name '(ediff-files3 ediff-buffers3)))) (ediff-defvar-local ediff-3way-comparison-job nil "") (defmacro ediff-merge-job () (` (memq ediff-job-name '(ediff-merge-files ediff-merge-buffers ediff-merge-files-with-ancestor ediff-merge-buffers-with-ancestor ediff-merge-revisions ediff-merge-revisions-with-ancestor)))) (ediff-defvar-local ediff-merge-job nil "") (defmacro ediff-merge-with-ancestor-job () (` (memq ediff-job-name '(ediff-merge-files-with-ancestor ediff-merge-buffers-with-ancestor ediff-merge-revisions-with-ancestor)))) (ediff-defvar-local ediff-merge-with-ancestor-job nil "") (defmacro ediff-3way-job () (` (or ediff-3way-comparison-job ediff-merge-job))) (ediff-defvar-local ediff-3way-job nil "") ;; A diff3 job is like a 3way job, but ediff-merge doesn't require the use ;; of diff3. (defmacro ediff-diff3-job () (` (or ediff-3way-comparison-job ediff-merge-with-ancestor-job))) (ediff-defvar-local ediff-diff3-job nil "") (defmacro ediff-windows-job () (` (memq ediff-job-name '(ediff-windows-wordwise ediff-windows-linewise)))) (ediff-defvar-local ediff-windows-job nil "") (defmacro ediff-word-mode-job () (` (memq ediff-job-name '(ediff-windows-wordwise ediff-regions-wordwise)))) (ediff-defvar-local ediff-word-mode-job nil "") (defmacro ediff-narrow-job () (` (memq ediff-job-name '(ediff-windows-wordwise ediff-regions-wordwise ediff-windows-linewise ediff-regions-linewise)))) (ediff-defvar-local ediff-narrow-job nil "") ;; Note: ediff-merge-directory-revisions-with-ancestor is not treated as an ;; ancestor metajob, since it behaves differently. (defsubst ediff-ancestor-metajob (&optional metajob) (memq (or metajob ediff-metajob-name) '(ediff-merge-directories-with-ancestor ediff-merge-filegroups-with-ancestor))) (defsubst ediff-revision-metajob (&optional metajob) (memq (or metajob ediff-metajob-name) '(ediff-directory-revisions ediff-merge-directory-revisions ediff-merge-directory-revisions-with-ancestor))) ;; metajob involving only one directory (defsubst ediff-dir1-metajob (&optional metajob) (or (ediff-revision-metajob metajob) ;; add more here )) (defsubst ediff-collect-diffs-metajob (&optional metajob) (or (ediff-revision-metajob metajob) (memq ediff-metajob-name '(ediff-directories ;; add more here ediff-directory-revisions)))) (defsubst ediff-metajob3 (&optional metajob) (memq (or metajob ediff-metajob-name) '(ediff-merge-directories-with-ancestor ediff-merge-filegroups-with-ancestor ediff-directories3 ediff-filegroups3))) (defsubst ediff-comparison-metajob3 (&optional metajob) (memq (or metajob ediff-metajob-name) '(ediff-directories3 ediff-filegroups3))) (defsubst ediff-barf-if-not-control-buffer (&optional meta-buf) (or (eq (if meta-buf ediff-meta-buffer ediff-control-buffer) (current-buffer)) (error "%S: This command runs in Ediff Control Buffer only!" this-command))) ;; Hook variables (defvar ediff-before-setup-windows-hook nil "*Hooks to run before Ediff sets its window configuration. This can be used to save the previous window config, which can be restored on ediff-quit or ediff-suspend.") (defvar ediff-after-setup-windows-hook nil "*Hooks to run after Ediff sets its window configuration. This can be used to set up control window or icon in a desired place.") (defvar ediff-before-setup-control-frame-hook nil "*Hooks run before setting up the frame to display Ediff Control Panel. Can be used to change control frame parameters to position it where it is desirable.") (defvar ediff-after-setup-control-frame-hook nil "*Hooks run after setting up the frame to display Ediff Control Panel. Can be used to move the frame where it is desired.") (defvar ediff-startup-hook nil "*Hooks to run in the control buffer after Ediff has been set up.") (defvar ediff-select-hook nil "*Hooks to run after a difference has been selected.") (defvar ediff-unselect-hook nil "*Hooks to run after a difference has been unselected.") (defvar ediff-prepare-buffer-hook nil "*Hooks called after buffers A, B, and C are set up.") (defvar ediff-load-hook nil "*Hook run after Ediff is loaded. Can be used to change defaults.") (defvar ediff-mode-hook nil "*Hook run just after ediff-mode is set up in the control buffer. This is done before any windows or frames are created. One can use it to set local variables that determine how the display looks like.") (defvar ediff-keymap-setup-hook nil "*Hook run just after the default bindings in Ediff keymap are set up.") (defvar ediff-display-help-hook nil "*Hooks run after preparing the help message.") (defvar ediff-suspend-hook (list 'ediff-default-suspend-function) "*Hooks to run in the Ediff control buffer when Ediff is suspended.") (defvar ediff-quit-hook (list 'ediff-cleanup-mess) "*Hooks to run in the Ediff control buffer after finishing Ediff.") (defvar ediff-cleanup-hook nil "*Hooks to run on exiting Ediff but before killing the control buffer. This is a place to do various cleanups, such as deleting the variant buffers. Ediff provides a function, `ediff-janitor', as one such possible hook.") ;; Help messages (defconst ediff-long-help-message-head " Moving around | Toggling features | Manipulations =====================|===========================|=============================" "The head of the full help message.") (defconst ediff-long-help-message-tail "=====================|===========================|============================= R -show registry | | M -show session group D -diff output | E -browse Ediff manual| G -send bug report i -status info | ? -help off | z/q -suspend/quit ------------------------------------------------------------------------------- X,Y (x,y) on the left are meta-symbols for the keys A,B,C (a,b,c). X,Y on the right are meta-symbols for buffers A,B,C. A,B,C on the right denote the working buffers A,B,C, respectively." "The tail of the full-help message.") (defconst ediff-long-help-message-compare3 " p,DEL -previous diff | | -vert/horiz split | xy -copy buf X's region to Y n,SPC -next diff | h -hiliting | rx -restore buf X's old diff j -jump to diff | @ -auto-refinement | * -refine current region gx -goto X's point| | ! -update diff regions C-l -recenter | ## -ignore whitespace | v/V -scroll up/dn | #f/#h -focus/hide regions | wx -save buf X -scroll lt/rt | X -read-only in buf X | wd -save diff output | m -wide display | ~ -rotate buffers " "Help message usually used for 3-way comparison. Normally, not a user option. See `ediff-help-message' for details.") (defconst ediff-long-help-message-compare2 " p,DEL -previous diff | | -vert/horiz split |a/b -copy A/B's region to B/A n,SPC -next diff | h -hiliting | rx -restore buf X's old diff j -jump to diff | @ -auto-refinement | * -refine current region gx -goto X's point| | ! -update diff regions C-l -recenter | ## -ignore whitespace | v/V -scroll up/dn | #f/#h -focus/hide regions | wx -save buf X -scroll lt/rt | X -read-only in buf X | wd -save diff output | m -wide display | ~ -swap buffers " "Help message usually used for 2-way comparison. Normally, not a user option. See `ediff-help-message' for details.") (defconst ediff-long-help-message-narrow2 " p,DEL -previous diff | | -vert/horiz split |a/b -copy A/B's region to B/A n,SPC -next diff | h -hiliting | rx -restore buf X's old diff j -jump to diff | @ -auto-refinement | * -refine current region gx -goto X's point| % -narrow/widen buffs | ! -update diff regions C-l -recenter | ## -ignore whitespace | v/V -scroll up/dn | #f/#h -focus/hide regions | wx -save buf X -scroll lt/rt | X -read-only in buf X | wd -save diff output | m -wide display | ~ -swap buffers " "Help message when comparing windows or regions line-by-line. Normally, not a user option. See `ediff-help-message' for details.") (defconst ediff-long-help-message-word-mode " p,DEL -previous diff | | -vert/horiz split | xy -copy buf X's region to Y n,SPC -next diff | h -hiliting | rx -restore buf X's old diff j -jump to diff | | gx -goto X's point| % -narrow/widen buffs | ! -recompute diffs C-l -recenter | | v/V -scroll up/dn | #f/#h -focus/hide regions | wx -save buf X -scroll lt/rt | X -read-only in buf X | wd -save diff output | m -wide display | ~ -swap buffers " "Help message when comparing windows or regions word-by-word. Normally, not a user option. See `ediff-help-message' for details.") (defconst ediff-long-help-message-merge " p,DEL -previous diff | | -vert/horiz split | x -copy buf X's region to C n,SPC -next diff | h -hiliting | r -restore buf C's old diff j -jump to diff | @ -auto-refinement | * -refine current region gx -goto X's point| ## -ignore whitespace | ! -update diff regions C-l -recenter | #f/#h -focus/hide regions | + -combine diff regions v/V -scroll up/dn | X -read-only in buf X | wx -save buf X -scroll lt/rt | m -wide display | wd -save diff output / -ancestor buff | s -shrink window C | ~ -swap buffers | $ -show clashes only | & -merge w/new default " "Help message during merging. Normally, not a user option. See `ediff-help-message' for details.") ;; The actual long help message. (ediff-defvar-local ediff-long-help-message "" "Normally, not a user option. See `ediff-help-message' for details.") (defconst ediff-brief-message-string " ? - help " "Contents of the brief help message.") ;; The actual brief help message (ediff-defvar-local ediff-brief-help-message "" "Normally, not a user option. See `ediff-help-message' for details.") (ediff-defvar-local ediff-brief-help-message-function nil "The brief help message that the user can customize. If the user sets this to a parameter-less function, Ediff will use it to produce the brief help message. This function must return a string.") (ediff-defvar-local ediff-long-help-message-function nil "The long help message that the user can customize. See `ediff-brief-help-message-function' for more.") (defvar ediff-prefer-long-help-message nil "*If t, Ediff starts with a long help message. Short help msg otherwise.") ;; The actual help message. (ediff-defvar-local ediff-help-message "" "The actual help message. Normally, the user shouldn't touch this. However, if you want Ediff to start up with different help messages for different jobs, you can change the value of this variable and the variables `ediff-help-message-*' in `ediff-startup-hook'.") ;; Selective browsing (ediff-defvar-local ediff-skip-diff-region-function 'ediff-show-all-diffs "Function that determines the next/previous diff region to show. Should return t for regions to be ignored and nil otherwise. This function gets a region number as an argument. The region number is the one used internally by Ediff. It is 1 less than the number seen by the user.") (ediff-defvar-local ediff-hide-regexp-matches-function 'ediff-hide-regexp-matches "Function to use in determining which regions to hide. See the documentation string of `ediff-hide-regexp-matches' for details.") (ediff-defvar-local ediff-focus-on-regexp-matches-function 'ediff-focus-on-regexp-matches "Function to use in determining which regions to focus on. See the documentation string of `ediff-focus-on-regexp-matches' for details.") ;; Regexp that determines buf A regions to focus on when skipping to diff (ediff-defvar-local ediff-regexp-focus-A "" "") ;; Regexp that determines buf B regions to focus on when skipping to diff (ediff-defvar-local ediff-regexp-focus-B "" "") ;; Regexp that determines buf C regions to focus on when skipping to diff (ediff-defvar-local ediff-regexp-focus-C "" "") ;; connective that determines whether to focus regions that match both or ;; one of the regexps (ediff-defvar-local ediff-focus-regexp-connective 'and "") ;; Regexp that determines buf A regions to ignore when skipping to diff (ediff-defvar-local ediff-regexp-hide-A "" "") ;; Regexp that determines buf B regions to ignore when skipping to diff (ediff-defvar-local ediff-regexp-hide-B "" "") ;; Regexp that determines buf C regions to ignore when skipping to diff (ediff-defvar-local ediff-regexp-hide-C "" "") ;; connective that determines whether to hide regions that match both or ;; one of the regexps (ediff-defvar-local ediff-hide-regexp-connective 'and "") (defvar ediff-ange-ftp-ftp-name (if ediff-xemacs-p 'ange-ftp-ftp-path 'ange-ftp-ftp-name) "Function ange-ftp uses to find out if file is remote.") ;; Copying difference regions between buffers. (ediff-defvar-local ediff-killed-diffs-alist nil "A list of killed diffs. A diff is saved here if it is replaced by a diff from another buffer. This alist has the form: \((num (buff-object . diff) (buff-object . diff) (buff-object . diff)) ...), where some buffer-objects may be missing.") ;; Highlighting ;;(defvar ediff-before-flag-bol (if ediff-emacs-p "->>\n" (make-glyph "->>\n")) (defvar ediff-before-flag-bol (if ediff-xemacs-p (make-glyph "->>") "->>") "*Flag placed above the highlighted block of differences. Must end with newline.") ;;(defvar ediff-after-flag-eol (if ediff-emacs-p "<<-\n" (make-glyph "<<-")) (defvar ediff-after-flag-eol (if ediff-xemacs-p (make-glyph "<<-") "<<-") "*Flag placed below the highlighted block of differences. Must end with newline.") (defvar ediff-before-flag-mol (if ediff-xemacs-p (make-glyph "->>") "->>") "*Like ediff-before-flag, used when a difference starts in mid-line.") (defvar ediff-after-flag-mol (if ediff-xemacs-p (make-glyph "<<-") "<<-") "*Like ediff-after-flag, used when a difference starts in mid-line.") (ediff-defvar-local ediff-use-faces t "If t, differences are highlighted using faces on a window system. If nil, they are highlighted using ASCII flags, ediff-before-flag and ediff-after-flag. On a non-window system, differences are always highlighted using ASCII flags. This variable can be set either in .emacs or toggled interactively. Use `setq-default' if setting it in .emacs") ;; this indicates that diff regions are word-size, so fine diffs are ;; permanently nixed; used in ediff-windows-wordwise and ediff-regions-wordwise (ediff-defvar-local ediff-word-mode nil "") ;; Name of the job (ediff-files, ediff-windows, etc.) (ediff-defvar-local ediff-job-name nil "") ;; Narrowing and ediff-region/windows support ;; This is a list (overlay-A overlay-B overlay-C) ;; If set, Ediff compares only those parts of buffers A/B/C that lie within ;; the bounds of these overlays. (ediff-defvar-local ediff-narrow-bounds nil "") ;; List (overlay-A overlay-B overlay-C), where each overlay spans the ;; entire corresponding buffer. (ediff-defvar-local ediff-wide-bounds nil "") ;; Current visibility boundaries in buffers A, B, and C. ;; This is also a list of overlays. When the user toggles narrow/widen, ;; this list changes from ediff-wide-bounds to ediff-narrow-bounds. ;; and back. (ediff-defvar-local ediff-visible-bounds nil "") (ediff-defvar-local ediff-start-narrowed t "Non-nil means start narrowed, if doing ediff-windows-* or ediff-regions-*") (ediff-defvar-local ediff-quit-widened t "*Non-nil means: when finished, Ediff widens buffers A/B. Actually, Ediff restores the scope of visibility that existed at startup.") (defvar ediff-keep-variants t "*Nil means that non-modified variant buffers should be removed after some interrogation. Supplying a prefix agument to the quit command `q' temporarily reverses the meaning of this variable.") (ediff-defvar-local ediff-highlight-all-diffs t "If nil, only the selected differences are highlighted. This variable can be set either in .emacs or toggled interactively, using ediff-toggle-hilit. Use `setq-default' to set it.") ;; A var local to each control panel buffer. Indicates highlighting style ;; in effect for this buffer: `face', `ascii', nil -- temporarily ;; unhighlighted, `off' -- turned off \(on a dumb terminal only\). (ediff-defvar-local ediff-highlighting-style nil "") ;; Variables that control each Ediff session. They are local to the ;; control buffer. ;; Mode variables ;; The buffer in which the A variant is stored. (ediff-defvar-local ediff-buffer-A nil "") ;; The buffer in which the B variant is stored. (ediff-defvar-local ediff-buffer-B nil "") ;; The buffer in which the C variant is stored. (ediff-defvar-local ediff-buffer-C nil "") ;; Ancestor buffer (ediff-defvar-local ediff-ancestor-buffer nil "") ;; The control buffer of ediff. (ediff-defvar-local ediff-control-buffer nil "") ;; The suffix of the control buffer name. (ediff-defvar-local ediff-control-buffer-suffix nil "") ;; Same as ediff-control-buffer-suffix, but without <,>. ;; It's a number rather than string. (ediff-defvar-local ediff-control-buffer-number nil "") ;; The original values of ediff-protected-variables for buffer A (ediff-defvar-local ediff-buffer-values-orig-A nil "") ;; The original values of ediff-protected-variables for buffer B (ediff-defvar-local ediff-buffer-values-orig-B nil "") ;; The original values of ediff-protected-variables for buffer C (ediff-defvar-local ediff-buffer-values-orig-C nil "") ;; The original values of ediff-protected-variables for buffer Ancestor (ediff-defvar-local ediff-buffer-values-orig-Ancestor nil "") ;; Buffer-local variables to be saved then restored during Ediff sessions ;; Buffer-local variables to be saved then restored during Ediff sessions (defconst ediff-protected-variables '(buffer-read-only synchronize-minibuffers mode-line-format)) ;; Vector of differences between the variants. Each difference is ;; represented by a vector of two overlays plus a vector of fine diffs, ;; plus a no-fine-diffs flag. The first overlay spans the ;; difference region in the A buffer and the second overlays the diff in ;; the B buffer. If a difference section is empty, the corresponding ;; overlay's endpoints coincide. ;; ;; The precise form of a difference vector for one buffer is: ;; [diff diff diff ...] ;; where each diff has the form: ;; [diff-overlay fine-diff-vector no-fine-diffs-flag state-of-difference] ;; fine-diff-vector is a vector [fine-diff-overlay fine-diff-overlay ...] ;; no-fine-diffs-flag says if there are fine differences. ;; state-of-difference is A, B, C, or nil, indicating which buffer is ;; different from the other two (used only in 3-way jobs. (ediff-defvar-local ediff-difference-vector-A nil "") (ediff-defvar-local ediff-difference-vector-B nil "") (ediff-defvar-local ediff-difference-vector-C nil "") (ediff-defvar-local ediff-difference-vector-Ancestor nil "") ;; [ status status status ...] ;; Each status: [state-of-merge state-of-ancestor] ;; state-of-merge is default-A, default-B, prefer-A, or prefer-B. It ;; indicates the way a diff region was created in buffer C. ;; state-of-ancestor says if the corresponding region in ancestor buffer is ;; empty. (ediff-defvar-local ediff-state-of-merge nil "") ;; The difference that is currently selected. (ediff-defvar-local ediff-current-difference -1 "") ;; Number of differences found. (ediff-defvar-local ediff-number-of-differences nil "") ;; Buffer containing the output of diff, which is used by Ediff to step ;; through files. (ediff-defvar-local ediff-diff-buffer nil "") ;; Like ediff-diff-buffer, but contains context diff. It is not used by ;; Ediff, but it is saved in a file, if user requests so. (ediff-defvar-local ediff-custom-diff-buffer nil "") ;; Buffer used for diff-style fine differences between regions. (ediff-defvar-local ediff-fine-diff-buffer nil "") ;; Temporary buffer used for computing fine differences. (defconst ediff-tmp-buffer " *ediff-tmp*" "") ;; Buffer used for messages (defconst ediff-msg-buffer " *ediff-message*" "") ;; Buffer containing the output of diff when diff returns errors. (ediff-defvar-local ediff-error-buffer nil "") ;; Buffer to display debug info (ediff-defvar-local ediff-debug-buffer "*ediff-debug*" "") ;; List of ediff control panels associated with each buffer A/B/C/Ancestor. ;; Not used any more, but may be needed in the future. (ediff-defvar-local ediff-this-buffer-ediff-sessions nil "") ;; to be deleted in due time ;; List of difference overlays disturbed by working with the current diff. (defvar ediff-disturbed-overlays nil "") ;; Priority of non-selected overlays. (defvar ediff-shadow-overlay-priority 100 "") (defvar ediff-version-control-package 'vc "Version control package used. Currently, Ediff supports vc.el, rcs.el, and generic-sc.el. The standard Emacs interface to RCS, CVS, SCCS, etc., is vc.el. However, some people find the other two packages more convenient. Set this variable `rcs' or `generic-sc' if you are such a person.") (if ediff-xemacs-p (progn (fset 'ediff-read-event (symbol-function 'next-command-event)) (fset 'ediff-overlayp (symbol-function 'extentp)) (fset 'ediff-make-overlay (symbol-function 'make-extent)) (fset 'ediff-delete-overlay (symbol-function 'delete-extent)) (fset 'ediff-overlay-buffer (symbol-function 'extent-buffer)) (fset 'ediff-overlay-get (symbol-function 'extent-property))) (fset 'ediff-read-event (symbol-function 'read-event)) (fset 'ediff-overlayp (symbol-function 'overlayp)) (fset 'ediff-overlayp (symbol-function 'overlayp)) (fset 'ediff-make-overlay (symbol-function 'make-overlay)) (fset 'ediff-delete-overlay (symbol-function 'delete-overlay)) (fset 'ediff-overlay-buffer (symbol-function 'overlay-buffer)) (fset 'ediff-overlay-get (symbol-function 'overlay-get))) ;; Check the current version against the major and minor version numbers ;; using op: cur-vers op major.minor If emacs-major-version or ;; emacs-minor-version are not defined, we assume that the current version ;; is hopelessly outdated. We assume that emacs-major-version and ;; emacs-minor-version are defined. Otherwise, for Emacs/XEmacs 19, if the ;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value ;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be ;; incorrect. However, this gives correct result in our cases, since we are ;; testing for sufficiently high Emacs versions. (defun ediff-check-version (op major minor &optional type-of-emacs) (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version)) (and (cond ((eq type-of-emacs 'xemacs) ediff-xemacs-p) ((eq type-of-emacs 'emacs) ediff-emacs-p) (t t)) (cond ((eq op '=) (and (= emacs-minor-version minor) (= emacs-major-version major))) ((memq op '(> >= < <=)) (and (or (funcall op emacs-major-version major) (= emacs-major-version major)) (if (= emacs-major-version major) (funcall op emacs-minor-version minor) t))) (t (error "%S: Invalid op in ediff-check-version" op)))) (cond ((memq op '(= > >=)) nil) ((memq op '(< <=)) t)))) ;;;; warn if it is a wrong version of emacs ;;(if (or (ediff-check-version '< 19 29 'emacs) ;; (ediff-check-version '< 19 12 'xemacs)) ;; (progn ;; (with-output-to-temp-buffer ediff-msg-buffer ;; (switch-to-buffer ediff-msg-buffer) ;; (insert ;; (format " ;; ;;This version of Ediff requires ;; ;;\t Emacs 19.29 and higher ;;\t OR ;;\t XEmacs 19.12 and higher ;; ;;It is unlikely to work under Emacs version %s ;;that you are using... " emacs-version)) ;; (if noninteractive ;; () ;; (beep 1) ;; (beep 1) ;; (insert "\n\nType any key to continue...") ;; (ediff-read-event))) ;; (kill-buffer ediff-msg-buffer))) ;; A fix for NeXT Step ;; Should probably be eliminated in later versions. (if (and (ediff-window-display-p) (eq (ediff-device-type) 'ns)) (progn (fset 'x-display-color-p (symbol-function 'ns-display-color-p)) (fset 'x-color-defined-p (symbol-function 'ns-color-defined-p)) (fset 'x-display-pixel-height (symbol-function 'ns-display-pixel-height)) (fset 'x-display-pixel-width (symbol-function 'ns-display-pixel-width)) )) (defsubst ediff-color-display-p () (if ediff-emacs-p (x-display-color-p) (eq (device-class (selected-device)) 'color))) (if (ediff-window-display-p) (if ediff-xemacs-p (progn (fset 'ediff-display-pixel-width (symbol-function 'device-pixel-width)) (fset 'ediff-display-pixel-height (symbol-function 'device-pixel-height)) (fset 'ediff-valid-color-p (symbol-function 'valid-color-name-p)) (fset 'ediff-get-face (symbol-function 'get-face))) ;; Temporary fix for OS/2 port of Emacs ;; pm-win.el in PM-Emacs should be fixed. (fset 'ediff-display-pixel-width (symbol-function 'x-display-pixel-width)) (fset 'ediff-display-pixel-height (symbol-function 'x-display-pixel-height)) (if (eq (ediff-device-type) 'pm) (fset 'ediff-valid-color-p (function (lambda (color) (assoc color pm-color-alist)))) (fset 'ediff-valid-color-p (symbol-function 'x-color-defined-p))) (fset 'ediff-get-face (symbol-function 'internal-get-face)))) (defun ediff-make-current-diff-overlay (type) (if (ediff-window-display-p) (let ((overlay (intern (format "ediff-current-diff-overlay-%S" type))) (buffer (ediff-get-buffer type)) (face (face-name (symbol-value (intern (format "ediff-current-diff-face-%S" type)))))) (set overlay (ediff-make-bullet-proof-overlay (point-max) (point-max) buffer)) (ediff-set-overlay-face (symbol-value overlay) face) (ediff-overlay-put (symbol-value overlay) 'ediff ediff-control-buffer)) )) (defun ediff-set-overlay-face (extent face) (ediff-overlay-put extent 'face face) (ediff-overlay-put extent 'help-echo 'ediff-region-help-echo)) ;; This does nothing in Emacs, since overlays there have no help-echo property (defun ediff-region-help-echo (extent) (let ((is-current (ediff-overlay-get extent 'ediff)) (face (ediff-overlay-get extent 'face)) (diff-num (ediff-overlay-get extent 'ediff-diff-num)) face-help help-msg) ;; This happens only for refinement overlays (setq face-help (and face (get face 'ediff-help-echo))) (setq help-msg (cond ((and is-current diff-num) ; current diff region (format "Difference region %S -- current" (1+ diff-num))) (face-help) ; refinement of current diff region (diff-num ; non-current (format "Difference region %S -- non-current" (1+ diff-num))) (t ""))))) ; none (defun ediff-set-face (ground face color) "Set face foreground/background." (if (ediff-window-display-p) (if (ediff-valid-color-p color) (if (eq ground 'foreground) (set-face-foreground face color) (set-face-background face color)) (cond ((memq face '(ediff-current-diff-face-A ediff-current-diff-face-B ediff-current-diff-face-C ediff-current-diff-face-Ancestor)) (copy-face 'highlight face)) ((memq face '(ediff-fine-diff-face-A ediff-fine-diff-face-B ediff-fine-diff-face-C ediff-fine-diff-face-Ancestor)) (copy-face 'secondary-selection face) (set-face-underline-p face t)) ((memq face '(ediff-even-diff-face-A ediff-odd-diff-face-A ediff-even-diff-face-B ediff-odd-diff-face-B ediff-even-diff-face-C ediff-odd-diff-face-C ediff-even-diff-face-Ancestor ediff-odd-diff-face-Ancestor)) (copy-face 'secondary-selection face)))) )) (add-to-list 'facemenu-unlisted-faces 'ediff-current-diff-face-A) (defvar ediff-current-diff-face-A (if (ediff-window-display-p) (progn (make-face 'ediff-current-diff-face-A) (or (face-differs-from-default-p 'ediff-current-diff-face-A) (cond ((ediff-color-display-p) (ediff-set-face 'foreground 'ediff-current-diff-face-A "firebrick") (ediff-set-face 'background 'ediff-current-diff-face-A "pale green")) (t (if ediff-xemacs-p (copy-face 'modeline 'ediff-current-diff-face-A) (copy-face 'highlight 'ediff-current-diff-face-A)) ))) 'ediff-current-diff-face-A)) "Face for highlighting the selected difference in buffer A.") (add-to-list 'facemenu-unlisted-faces 'ediff-current-diff-face-B) (defvar ediff-current-diff-face-B (if (ediff-window-display-p) (progn (make-face 'ediff-current-diff-face-B) (or (face-differs-from-default-p 'ediff-current-diff-face-B) (cond ((ediff-color-display-p) (ediff-set-face 'foreground 'ediff-current-diff-face-B "DarkOrchid") (ediff-set-face 'background 'ediff-current-diff-face-B "Yellow")) (t (if ediff-xemacs-p (copy-face 'modeline 'ediff-current-diff-face-B) (copy-face 'highlight 'ediff-current-diff-face-B)) ))) 'ediff-current-diff-face-B)) "Face for highlighting the selected difference in buffer B.") (add-to-list 'facemenu-unlisted-faces 'ediff-current-diff-face-C) (defvar ediff-current-diff-face-C (if (ediff-window-display-p) (progn (make-face 'ediff-current-diff-face-C) (or (face-differs-from-default-p 'ediff-current-diff-face-C) (cond ((ediff-color-display-p) (ediff-set-face 'foreground 'ediff-current-diff-face-C "Navy") (ediff-set-face 'background 'ediff-current-diff-face-C "Pink")) (t (if ediff-xemacs-p (copy-face 'modeline 'ediff-current-diff-face-C) (copy-face 'highlight 'ediff-current-diff-face-C)) ))) 'ediff-current-diff-face-C)) "Face for highlighting the selected difference in buffer C.") (add-to-list 'facemenu-unlisted-faces 'ediff-current-diff-face-Ancestor) (defvar ediff-current-diff-face-Ancestor (if (ediff-window-display-p) (progn (make-face 'ediff-current-diff-face-Ancestor) (or (face-differs-from-default-p 'ediff-current-diff-face-Ancestor) (copy-face 'ediff-current-diff-face-C 'ediff-current-diff-face-Ancestor)))) "Face for highlighting the selected difference in the ancestor buffer.") (add-to-list 'facemenu-unlisted-faces 'ediff-fine-diff-face-A) (defvar ediff-fine-diff-face-A (if (ediff-window-display-p) (progn (make-face 'ediff-fine-diff-face-A) (or (face-differs-from-default-p 'ediff-fine-diff-face-A) (cond ((ediff-color-display-p) (ediff-set-face 'foreground 'ediff-fine-diff-face-A "Navy") (ediff-set-face 'background 'ediff-fine-diff-face-A "sky blue")) (t (set-face-underline-p 'ediff-fine-diff-face-A t)))) 'ediff-fine-diff-face-A)) "Face for highlighting the refinement of the selected diff in buffer A.") (add-to-list 'facemenu-unlisted-faces 'ediff-fine-diff-face-B) (defvar ediff-fine-diff-face-B (if (ediff-window-display-p) (progn (make-face 'ediff-fine-diff-face-B) (or (face-differs-from-default-p 'ediff-fine-diff-face-B) (cond ((ediff-color-display-p) (ediff-set-face 'foreground 'ediff-fine-diff-face-B "Black") (ediff-set-face 'background 'ediff-fine-diff-face-B "cyan")) (t (set-face-underline-p 'ediff-fine-diff-face-B t)))) 'ediff-fine-diff-face-B)) "Face for highlighting the refinement of the selected diff in buffer B.") (add-to-list 'facemenu-unlisted-faces 'ediff-fine-diff-face-C) (defvar ediff-fine-diff-face-C (if (ediff-window-display-p) (progn (make-face 'ediff-fine-diff-face-C) (or (face-differs-from-default-p 'ediff-fine-diff-face-C) (cond ((ediff-color-display-p) (ediff-set-face 'foreground 'ediff-fine-diff-face-C "black") (ediff-set-face 'background 'ediff-fine-diff-face-C "Turquoise")) (t (set-face-underline-p 'ediff-fine-diff-face-C t)))) 'ediff-fine-diff-face-C)) "Face for highlighting the refinement of the selected diff in buffer C.") (add-to-list 'facemenu-unlisted-faces 'ediff-fine-diff-face-Ancestor) (defvar ediff-fine-diff-face-Ancestor (if (ediff-window-display-p) (progn (make-face 'ediff-fine-diff-face-Ancestor) (or (face-differs-from-default-p 'ediff-fine-diff-face-Ancestor) (copy-face 'ediff-fine-diff-face-C 'ediff-fine-diff-face-Ancestor)))) "Face highlighting refinements of the selected diff in ancestor buffer. Presently, this is not used, as difference regions are not refined in the ancestor buffer.") (add-to-list 'facemenu-unlisted-faces 'ediff-even-diff-face-A) (defvar ediff-even-diff-face-A (if (ediff-window-display-p) (progn (make-face 'ediff-even-diff-face-A) (or (face-differs-from-default-p 'ediff-even-diff-face-A) (cond ((ediff-color-display-p) (ediff-set-face 'foreground 'ediff-even-diff-face-A "black") (ediff-set-face 'background 'ediff-even-diff-face-A "light grey")) (t (copy-face 'italic 'ediff-even-diff-face-A)))) 'ediff-even-diff-face-A)) "Face used to highlight even-numbered differences in buffer A.") (add-to-list 'facemenu-unlisted-faces 'ediff-even-diff-face-B) (defvar ediff-even-diff-face-B (if (ediff-window-display-p) (progn (make-face 'ediff-even-diff-face-B) (or (face-differs-from-default-p 'ediff-even-diff-face-B) (cond ((ediff-color-display-p) (ediff-set-face 'foreground 'ediff-even-diff-face-B "White") (ediff-set-face 'background 'ediff-even-diff-face-B "Gray")) (t (copy-face 'italic 'ediff-even-diff-face-B)))) 'ediff-even-diff-face-B)) "Face used to highlight even-numbered differences in buffer B.") (add-to-list 'facemenu-unlisted-faces 'ediff-even-diff-face-C) (defvar ediff-even-diff-face-C (if (ediff-window-display-p) (progn (make-face 'ediff-even-diff-face-C) (or (face-differs-from-default-p 'ediff-even-diff-face-C) (copy-face 'ediff-even-diff-face-A 'ediff-even-diff-face-C)) 'ediff-even-diff-face-C)) "Face used to highlight even-numbered differences in buffer C.") (add-to-list 'facemenu-unlisted-faces 'ediff-even-diff-face-Ancestor) (defvar ediff-even-diff-face-Ancestor (if (ediff-window-display-p) (progn (make-face 'ediff-even-diff-face-Ancestor) (or (face-differs-from-default-p 'ediff-even-diff-face-Ancestor) (copy-face 'ediff-even-diff-face-C 'ediff-even-diff-face-Ancestor)) 'ediff-even-diff-face-Ancestor)) "Face highlighting even-numbered differences in the ancestor buffer.") (add-to-list 'facemenu-unlisted-faces 'ediff-odd-diff-face-A) (defvar ediff-odd-diff-face-A (if (ediff-window-display-p) (progn (make-face 'ediff-odd-diff-face-A) (or (face-differs-from-default-p 'ediff-odd-diff-face-A) (cond ((ediff-color-display-p) (ediff-set-face 'foreground 'ediff-odd-diff-face-A "White") (ediff-set-face 'background 'ediff-odd-diff-face-A "Gray")) (t (copy-face 'italic 'ediff-odd-diff-face-A)))) 'ediff-odd-diff-face-A)) "Face used to highlight odd-numbered differences in buffer A.") (add-to-list 'facemenu-unlisted-faces 'ediff-odd-diff-face-B) (defvar ediff-odd-diff-face-B (if (ediff-window-display-p) (progn (make-face 'ediff-odd-diff-face-B) (or (face-differs-from-default-p 'ediff-odd-diff-face-B) (cond ((ediff-color-display-p) (ediff-set-face 'foreground 'ediff-odd-diff-face-B "Black") (ediff-set-face 'background 'ediff-odd-diff-face-B "light grey")) (t (copy-face 'italic 'ediff-odd-diff-face-B)))) 'ediff-odd-diff-face-B)) "Face used to highlight odd-numbered differences in buffer B.") (add-to-list 'facemenu-unlisted-faces 'ediff-odd-diff-face-C) (defvar ediff-odd-diff-face-C (if (ediff-window-display-p) (progn (make-face 'ediff-odd-diff-face-C) (or (face-differs-from-default-p 'ediff-odd-diff-face-C) (copy-face 'ediff-odd-diff-face-A 'ediff-odd-diff-face-C)) 'ediff-odd-diff-face-C)) "Face used to highlight odd-numbered differences in buffer C.") (add-to-list 'facemenu-unlisted-faces 'ediff-odd-diff-face-Ancestor ) (defvar ediff-odd-diff-face-Ancestor (if (ediff-window-display-p) (progn (make-face 'ediff-odd-diff-face-Ancestor) (or (face-differs-from-default-p 'ediff-odd-diff-face-Ancestor) (copy-face 'ediff-odd-diff-face-C 'ediff-odd-diff-face-Ancestor)) 'ediff-odd-diff-face-Ancestor)) "Face used to highlight even-numbered differences in the ancestor buffer.") ;; Help echo (put 'ediff-fine-diff-face-A 'ediff-help-echo "A `refinement' of the current difference region") (put 'ediff-fine-diff-face-B 'ediff-help-echo "A `refinement' of the current difference region") (put 'ediff-fine-diff-face-C 'ediff-help-echo "A `refinement' of the current difference region") (put 'ediff-fine-diff-face-Ancestor 'ediff-help-echo "A `refinement' of the current difference region") ;;; Overlays (ediff-defvar-local ediff-current-diff-overlay-A nil "Overlay for the current difference region in buffer A.") (ediff-defvar-local ediff-current-diff-overlay-B nil "Overlay for the current difference region in buffer B.") (ediff-defvar-local ediff-current-diff-overlay-C nil "Overlay for the current difference region in buffer C.") (ediff-defvar-local ediff-current-diff-overlay-Ancestor nil "Overlay for the current difference region in the ancestor buffer.") ;; Compute priority of ediff overlay. (defun ediff-highest-priority (start end buffer) (let ((pos (max 1 (1- start))) ovr-list) (if ediff-xemacs-p (1+ ediff-shadow-overlay-priority) (ediff-eval-in-buffer buffer (while (< pos (min (point-max) (1+ end))) (setq ovr-list (append (overlays-at pos) ovr-list)) (setq pos (next-overlay-change pos))) (1+ (apply '+ (mapcar (function (lambda (ovr) (if ovr (or (ediff-overlay-get ovr 'priority) 0) 0))) ovr-list) )) )))) (defvar ediff-toggle-read-only-function nil "*Specifies the function to be used to toggle read-only. If nil, Ediff tries to deduce the function from the binding of C-x C-q. Normally, this is the `toggle-read-only' function, but, if version control is used, it could be `vc-toggle-read-only' or `rcs-toggle-read-only'.") ;;; Misc ;; if nil, this silences some messages (defconst ediff-verbose-p t) (defvar ediff-no-emacs-help-in-control-buffer nil "*Non-nil means C-h should not invoke Emacs help in control buffer. Instead, C-h jumps to previous difference.") (defvar ediff-temp-file-prefix (let ((env (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP"))) d) (setq d (if (and env (> (length env) 0)) env (if (memq system-type '(vax-vms axp-vms)) "SYS$SCRATCH:" "/tmp"))) ;; The following is to make sure we get something to which we can ;; add directory levels on VMS. (setq d (file-name-as-directory (directory-file-name d))) ) "*Prefix to put on Ediff temporary file names. Do not start with `~/' or `~user-name/'.") (defvar ediff-temp-file-mode 384 ; u=rw only "*Mode for Ediff temporary files.") ;; Metacharacters that have to be protected from the shell when executing ;; a diff/diff3 command. (defvar ediff-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]" "Characters that must be quoted with \\ when used in a shell command line. More precisely, a regexp to match any one such character.") (ediff-defvar-local ediff-temp-file-A nil "Temporary file used for refining difference regions in buffer A.") (ediff-defvar-local ediff-temp-file-B nil "Temporary file used for refining difference regions in buffer B.") (ediff-defvar-local ediff-temp-file-C nil "Temporary file used for refining difference regions in buffer C.") ;;; In-line functions (defsubst ediff-file-remote-p (file-name) (if (fboundp ediff-ange-ftp-ftp-name) (funcall ediff-ange-ftp-ftp-name file-name))) ;;(defun ediff-frame-has-menubar () ;; (and (ediff-window-display-p) ;; (if ediff-xemacs-p ;; current-menubar ;; (let ((lines (cdr (assq 'menu-bar-lines ;; (frame-parameters (selected-frame)))))) ;; (or (eq lines t) (and (numberp lines) (< 0 lines)))) ;; ))) (defsubst ediff-frame-unsplittable-p (frame) (cdr (assq 'unsplittable (frame-parameters frame)))) (defsubst ediff-get-next-window (wind prev-wind) (or (window-live-p wind) (setq wind (if prev-wind (next-window wind) (selected-window))))) (defsubst ediff-kill-buffer-carefully (buf) "Kill buffer BUF if it exists." (if (ediff-buffer-live-p buf) (kill-buffer (get-buffer buf)))) (defsubst ediff-highlight-diff (n) "Put face on diff N. Invoked for X displays only." (ediff-highlight-diff-in-one-buffer n 'A) (ediff-highlight-diff-in-one-buffer n 'B) (ediff-highlight-diff-in-one-buffer n 'C) (ediff-highlight-diff-in-one-buffer n 'Ancestor) ) (defsubst ediff-unhighlight-diff () "Remove overlays from buffers A, B, and C." (ediff-unhighlight-diff-in-one-buffer 'A) (ediff-unhighlight-diff-in-one-buffer 'B) (ediff-unhighlight-diff-in-one-buffer 'C) (ediff-unhighlight-diff-in-one-buffer 'Ancestor) ) ;; delete highlighting overlays, restore faces to their original form (defsubst ediff-unhighlight-diffs-totally () (ediff-unhighlight-diffs-totally-in-one-buffer 'A) (ediff-unhighlight-diffs-totally-in-one-buffer 'B) (ediff-unhighlight-diffs-totally-in-one-buffer 'C) (ediff-unhighlight-diffs-totally-in-one-buffer 'Ancestor) ) (defsubst ediff-background-face (buf-type dif-num) ;; The value of dif-num is always 1- the one that user sees. ;; This is why even face is used when dif-num is odd. (intern (format (if (ediff-odd-p dif-num) "ediff-even-diff-face-%S" "ediff-odd-diff-face-%S") buf-type))) ;; arg is a record for a given diff in a difference vector ;; this record is itself a vector (defsubst ediff-clear-fine-diff-vector (diff-record) (if diff-record (mapcar 'ediff-delete-overlay (ediff-get-fine-diff-vector-from-diff-record diff-record)))) (defsubst ediff-clear-fine-differences-in-one-buffer (n buf-type) (ediff-clear-fine-diff-vector (ediff-get-difference n buf-type)) (ediff-set-fine-diff-vector n buf-type nil)) (defsubst ediff-clear-fine-differences (n) (ediff-clear-fine-differences-in-one-buffer n 'A) (ediff-clear-fine-differences-in-one-buffer n 'B) (if ediff-3way-job (ediff-clear-fine-differences-in-one-buffer n 'C))) (defsubst ediff-convert-fine-diffs-to-overlays (diff-list region-num) (ediff-set-fine-overlays-in-one-buffer 'A diff-list region-num) (ediff-set-fine-overlays-in-one-buffer 'B diff-list region-num) (if ediff-3way-job (ediff-set-fine-overlays-in-one-buffer 'C diff-list region-num) )) (defsubst ediff-mouse-event-p (event) (if ediff-xemacs-p (button-event-p event) (string-match "mouse" (format "%S" (event-basic-type event))) )) (defsubst ediff-key-press-event-p (event) (if ediff-xemacs-p (key-press-event-p event) (or (char-or-string-p event) (symbolp event)))) (defun ediff-event-point (event) (cond ((ediff-mouse-event-p event) (if ediff-xemacs-p (event-point event) (posn-point (event-start event)))) ((ediff-key-press-event-p event) (point)) (t (error)))) (defun ediff-event-buffer (event) (cond ((ediff-mouse-event-p event) (if ediff-xemacs-p (event-buffer event) (window-buffer (posn-window (event-start event))))) ((ediff-key-press-event-p event) (current-buffer)) (t (error)))) (defsubst ediff-frame-iconified-p (frame) (if (and (ediff-window-display-p) (frame-live-p frame)) (if ediff-xemacs-p (frame-iconified-p frame) (eq (frame-visible-p frame) 'icon)))) (defsubst ediff-window-visible-p (wind) ;; under TTY, window-live-p also means window is visible (and (window-live-p wind) (or (not (ediff-window-display-p)) (frame-visible-p (window-frame wind))))) (defsubst ediff-frame-char-width (frame) (if ediff-xemacs-p (/ (frame-pixel-width frame) (frame-width frame)) (frame-char-width frame))) (defun ediff-reset-mouse (&optional frame do-not-grab-mouse) (or frame (setq frame (selected-frame))) (if (ediff-window-display-p) (let ((frame-or-wind frame)) (if ediff-xemacs-p (setq frame-or-wind (frame-selected-window frame))) (or do-not-grab-mouse ;; don't set mouse if the user said to never do this (not ediff-grab-mouse) ;; Don't grab on quit, if the user doesn't want to. ;; If ediff-grab-mouse = t, then mouse won't be grabbed for ;; sessions that are not part of a group (this is done in ;; ediff-recenter). The condition below affects only terminating ;; sessions in session groups (in whhich case mouse is warped into ;; a meta buffer). (and (eq ediff-grab-mouse 'maybe) (memq this-command '(ediff-quit ediff-update-diffs))) (set-mouse-position frame-or-wind 1 0)) ))) (defsubst ediff-spy-after-mouse () (setq ediff-mouse-pixel-position (mouse-pixel-position))) ;; This is actually not easy to find out since emacs and xemacs behave ;; differently when mouse is not in any frame. Also, this is sensitive to ;; when the user grabbed mouse. ;; Not used for now. (defun ediff-user-grabbed-mouse () (if ediff-mouse-pixel-position (cond ((not (eq (car ediff-mouse-pixel-position) (car (mouse-pixel-position))))) ((and (car (cdr ediff-mouse-pixel-position)) (car (cdr (mouse-pixel-position))) (cdr (cdr ediff-mouse-pixel-position)) (cdr (cdr (mouse-pixel-position)))) (not (and (< (abs (- (car (cdr ediff-mouse-pixel-position)) (car (cdr (mouse-pixel-position))))) ediff-mouse-pixel-threshhold) (< (abs (- (cdr (cdr ediff-mouse-pixel-position)) (cdr (cdr (mouse-pixel-position))))) ediff-mouse-pixel-threshhold)))) (t nil)))) (defsubst ediff-frame-char-height (frame) (if ediff-xemacs-p (/ (frame-pixel-height frame) (frame-height frame)) (frame-char-height frame))) (defsubst ediff-empty-overlay-p (overl) (= (ediff-overlay-start overl) (ediff-overlay-end overl))) ;; t if diff region is empty. ;; In case of buffer C, t also if it is not a 3way ;; comparison job (merging jobs return t as well). (defun ediff-empty-diff-region-p (n buf-type) (if (eq buf-type 'C) (or (not ediff-3way-comparison-job) (= (ediff-get-diff-posn 'C 'beg n) (ediff-get-diff-posn 'C 'end n))) (= (ediff-get-diff-posn buf-type 'beg n) (ediff-get-diff-posn buf-type 'end n)))) ;; Test if diff region is white space only. ;; If 2-way job and buf-type = C, then returns t. (defun ediff-whitespace-diff-region-p (n buf-type) (or (and (eq buf-type 'C) (not ediff-3way-job)) (ediff-empty-diff-region-p n buf-type) (let ((beg (ediff-get-diff-posn buf-type 'beg n)) (end (ediff-get-diff-posn buf-type 'end n))) (ediff-eval-in-buffer (ediff-get-buffer buf-type) (save-excursion (goto-char beg) (skip-chars-forward ediff-whitespace) (>= (point) end)))))) ;; temporarily uses DIR to abbreviate file name ;; if DIR is nil, use default-directory (defsubst ediff-abbreviate-file-name (file &optional dir) (cond ((stringp dir) (let ((directory-abbrev-alist (list (cons dir "")))) (abbreviate-file-name file))) (ediff-emacs-p (abbreviate-file-name file)) (t ; XEmacs requires addl argument (abbreviate-file-name file t)))) ;; Takes a directory and returns the parent directory. ;; does nothing to `/'. If the ARG is a regular file, ;; strip the file AND the last dir. (defun ediff-strip-last-dir (dir) (if (not (stringp dir)) (setq dir default-directory)) (setq dir (expand-file-name dir)) (or (file-directory-p dir) (setq dir (file-name-directory dir))) (let* ((pos (1- (length dir))) (last-char (aref dir pos))) (if (and (> pos 0) (= last-char ?/)) (setq dir (substring dir 0 pos))) (ediff-abbreviate-file-name (file-name-directory dir)))) (defun ediff-truncate-string-left (str newlen) ;; leave space for ... on the left (let ((len (length str)) substr) (if (<= len newlen) str (setq newlen (max 0 (- newlen 3))) (setq substr (substring str (max 0 (- len 1 newlen)))) (concat "..." substr)))) (defun ediff-abbrev-jobname (jobname) (cond ((eq jobname 'ediff-directories) "Compare two directories") ((eq jobname 'ediff-files) "Compare two files") ((eq jobname 'ediff-buffers) "Compare two buffers") ((eq jobname 'ediff-directories3) "Compare three directories") ((eq jobname 'ediff-files3) "Compare three files") ((eq jobname 'ediff-buffers3) "Compare three buffers") ((eq jobname 'ediff-revision) "Compare file with a version") ((eq jobname 'ediff-directory-revisions) "Compare dir files with versions") ((eq jobname 'ediff-merge-directory-revisions) "Merge dir files with versions") ((eq jobname 'ediff-merge-directory-revisions-with-ancestor) "Merge dir versions via ancestors") (t (let* ((str (substring (symbol-name jobname) 6)) (len (length str)) (pos 0)) (while (< pos len) (if (= pos 0) (aset str pos (upcase (aref str pos)))) (if (= (aref str pos) ?-) (aset str pos ?\ )) (setq pos (1+ pos))) str)))) (defsubst ediff-get-region-contents (n buf-type ctrl-buf &optional start end) (ediff-eval-in-buffer (ediff-eval-in-buffer ctrl-buf (ediff-get-buffer buf-type)) (buffer-substring (or start (ediff-get-diff-posn buf-type 'beg n ctrl-buf)) (or end (ediff-get-diff-posn buf-type 'end n ctrl-buf))))) ;; If ediff modified mode line, strip the modification (defsubst ediff-strip-mode-line-format () (if (member (car mode-line-format) '(" A: " " B: " " C: " " Ancestor: ")) (setq mode-line-format (nth 2 mode-line-format)))) ;; Verify that we have a difference selected. (defsubst ediff-valid-difference-p (&optional n) (or n (setq n ediff-current-difference)) (and (>= n 0) (< n ediff-number-of-differences))) (defsubst ediff-show-all-diffs (n) "Don't skip difference regions." nil) (defsubst Xor (a b) (or (and a (not b)) (and (not a) b))) (defsubst ediff-message-if-verbose (string &rest args) (if ediff-verbose-p (apply 'message string args))) (provide 'ediff-init) ;;; ediff-init.el ends here emacs-19.30/lisp/ediff-merg.el100444 23123 1 23415 6037625015 14733 0ustar kiferdaemon;;; ediff-merg.el --- merging utilities ;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. (require 'ediff-init) (defvar ediff-default-variant 'default-A "*The variant to be used as a default for buffer C in merging. Valid values are the symbols `default-A', `default-B', and `combined'.") (defvar ediff-combination-pattern '("#ifdef NEW /* variant A */" "#else /* variant B */" "#endif /* NEW */") "*Pattern to be used for combining difference regions in buffers A and B. The value is (STRING1 STRING2 STRING3). The combined text will look like this: STRING1 diff region from variant A STRING2 diff region from variant B STRING3 ") (ediff-defvar-local ediff-show-clashes-only nil "*If t, show only those diff regions where both buffers disagree with the ancestor. This means that regions that have status prefer-A or prefer-B will be skiped over. Nil means show all regions.") (defsubst ediff-get-combined-region (n) (concat (nth 0 ediff-combination-pattern) "\n" (ediff-get-region-contents n 'A ediff-control-buffer) (nth 1 ediff-combination-pattern) "\n" (ediff-get-region-contents n 'B ediff-control-buffer) (nth 2 ediff-combination-pattern) "\n")) (defsubst ediff-make-combined-diff (regA regB) (concat (nth 0 ediff-combination-pattern) "\n" regA (nth 1 ediff-combination-pattern) "\n" regB (nth 2 ediff-combination-pattern) "\n")) (defsubst ediff-set-state-of-all-diffs-in-all-buffers (ctl-buf) (let ((n 0)) (while (< n ediff-number-of-differences) (ediff-set-state-of-diff-in-all-buffers n ctl-buf) (setq n (1+ n))))) (defun ediff-set-state-of-diff-in-all-buffers (n ctl-buf) (let ((regA (ediff-get-region-contents n 'A ctl-buf)) (regB (ediff-get-region-contents n 'B ctl-buf)) (regC (ediff-get-region-contents n 'C ctl-buf))) (cond ((and (string= regA regB) (string= regA regC)) (ediff-set-state-of-diff n 'A "=diff(B)") (ediff-set-state-of-diff n 'B "=diff(C)") (ediff-set-state-of-diff n 'C "=diff(A)")) ((string= regA regB) (ediff-set-state-of-diff n 'A "=diff(B)") (ediff-set-state-of-diff n 'B "=diff(A)") (ediff-set-state-of-diff n 'C nil)) ((string= regA regC) (ediff-set-state-of-diff n 'A "=diff(C)") (ediff-set-state-of-diff n 'C "=diff(A)") (ediff-set-state-of-diff n 'B nil)) ((string= regB regC) (ediff-set-state-of-diff n 'C "=diff(B)") (ediff-set-state-of-diff n 'B "=diff(C)") (ediff-set-state-of-diff n 'A nil)) ((string= regC (ediff-get-combined-region n)) (ediff-set-state-of-diff n 'A nil) (ediff-set-state-of-diff n 'B nil) (ediff-set-state-of-diff n 'C "=diff(A+B)")) (t (ediff-set-state-of-diff n 'A nil) (ediff-set-state-of-diff n 'B nil) (ediff-set-state-of-diff n 'C nil))) )) (defun ediff-set-merge-mode () ;; by Stig@hackvan.com (normal-mode t) (remove-hook 'local-write-file-hooks 'ediff-set-merge-mode)) ;; Go over all diffs starting with DIFF-NUM and copy regions into buffer C ;; according to the state of the difference. ;; Since ediff-copy-diff refuses to copy identical diff regions, there is ;; no need to optimize ediff-do-merge any further. ;; ;; If re-merging, change state of merge in all diffs starting with ;; DIFF-NUM, except those where the state is prefer-* or where it is ;; `default-*' or `combined' but the buf C region appears to be modified ;; since last set by default. (defun ediff-do-merge (diff-num &optional remerging) (if (< diff-num 0) (setq diff-num 0)) (let ((n diff-num) (default-state-of-merge (format "%S" ediff-default-variant)) do-not-copy state-of-merge) (while (< n ediff-number-of-differences) (if (= (mod n 10) 0) (message "%s buffers A & B into C ... region %d of %d" (if remerging "Re-merging" "Merging") n ediff-number-of-differences)) (setq state-of-merge (ediff-get-state-of-merge n)) (if remerging (let ((reg-A (ediff-get-region-contents n 'A ediff-control-buffer)) (reg-B (ediff-get-region-contents n 'B ediff-control-buffer)) (reg-C (ediff-get-region-contents n 'C ediff-control-buffer))) ;;; was edited since first set by default (if (or (and (string= state-of-merge "default-A") (not (string= reg-A reg-C))) ;; was edited since first set by default (and (string= state-of-merge "default-B") (not (string= reg-B reg-C))) ;; was edited since first set by default (and (string= state-of-merge "combined") (not (string= (ediff-make-combined-diff reg-A reg-B) reg-C))) ;; was prefered--ignore (string-match "prefer" state-of-merge)) (setq do-not-copy t)) ;; change state of merge for this diff, if necessary (if (and (string-match "\\(default\\|combined\\)" state-of-merge) (not do-not-copy)) (ediff-set-state-of-merge n (format "%S" ediff-default-variant))) )) ;; state-of-merge may have changed via ediff-set-state-of-merge, so ;; check it once again (setq state-of-merge (ediff-get-state-of-merge n)) (or do-not-copy (if (string= state-of-merge "combined") ;; use n+1 because ediff-combine-diffs works via user numbering ;; of diffs, which is 1+ to what ediff uses internally (ediff-combine-diffs (1+ n) 'batch) (ediff-copy-diff n (if (string-match "-A" state-of-merge) 'A 'B) 'C 'batch))) (setq n (1+ n))) (message "Merging buffers A & B into C ... Done") )) (defun ediff-re-merge () "Remerge unmodified diff regions using a new default. Start with the current region." (interactive) (let* ((default-variant-alist (list '("default-A") '("default-B") '("combined"))) (actual-alist (delete (list (symbol-name ediff-default-variant)) default-variant-alist))) (setq ediff-default-variant (intern (completing-read (format "Current merge default is `%S'. New default: " ediff-default-variant) actual-alist nil 'must-match))) (ediff-do-merge ediff-current-difference 'remerge) (ediff-recenter) )) (defun ediff-shrink-window-C (arg) "Shrink window C to just one line. With a prefix argument, returns window C to its normal size. Used only for merging jobs." (interactive "P") (if (not ediff-merge-job) (error "ediff-shrink-window-C can be used only for merging jobs")) (cond ((eq arg '-) (setq arg -1)) ((not (numberp arg)) (setq arg nil))) (cond ((null arg) (let ((ediff-merge-window-share (if (< (window-height ediff-window-C) 3) ediff-merge-window-share 0))) (setq ediff-window-config-saved "") ; force redisplay (ediff-recenter 'no-rehighlight))) ((and (< arg 0) (> (window-height ediff-window-C) 2)) (setq ediff-merge-window-share (* ediff-merge-window-share 0.9)) (setq ediff-window-config-saved "") ; force redisplay (ediff-recenter 'no-rehighlight)) ((and (> arg 0) (> (window-height ediff-window-A) 2)) (setq ediff-merge-window-share (* ediff-merge-window-share 1.1)) (setq ediff-window-config-saved "") ; force redisplay (ediff-recenter 'no-rehighlight)))) ;; N here is the user's region number. It is 1+ what Ediff uses internally. (defun ediff-combine-diffs (n &optional batch-invocation) "Combine Nth diff regions of buffers A and B and place the combination in C. Combining is done using the list in variable `ediff-combination-pattern'." (interactive "P") (setq n (if n (1- n) ediff-current-difference)) (let (regA regB reg-combined) (setq regA (ediff-get-region-contents n 'A ediff-control-buffer) regB (ediff-get-region-contents n 'B ediff-control-buffer)) (setq reg-combined (ediff-make-combined-diff regA regB)) (ediff-copy-diff n nil 'C batch-invocation reg-combined)) (or batch-invocation (ediff-recenter))) ;; Checks if the region in buff C looks like a combination of the regions ;; in buffers A and B. Returns a list (reg-a-beg reg-a-end reg-b-beg reg-b-end) ;; These refer to where the copies of region A and B start and end in buffer C (defun ediff-looks-like-combined-merge (region-num) (if ediff-merge-job (let ((combined (string-match (regexp-quote "(A+B)") (or (ediff-get-state-of-diff region-num 'C) ""))) (reg-beg (ediff-get-diff-posn 'C 'beg region-num)) (reg-end (ediff-get-diff-posn 'C 'end region-num)) (pat1 (nth 0 ediff-combination-pattern)) (pat2 (nth 1 ediff-combination-pattern)) (pat3 (nth 2 ediff-combination-pattern)) reg-a-beg reg-a-end reg-b-beg reg-b-end reg-c-beg reg-c-end) (if combined (ediff-eval-in-buffer ediff-buffer-C (goto-char reg-beg) (search-forward pat1 reg-end 'noerror) (setq reg-a-beg (match-beginning 0)) (setq reg-a-end (match-end 0)) (search-forward pat2 reg-end 'noerror) (setq reg-b-beg (match-beginning 0)) (setq reg-b-end (match-end 0)) (search-forward pat3 reg-end 'noerror) (setq reg-c-beg (match-beginning 0)) (setq reg-c-end (match-end 0)))) (if (and reg-a-beg reg-a-end reg-b-beg reg-b-end) (list reg-a-beg reg-a-end reg-b-beg reg-b-end reg-c-beg reg-c-end)) ))) (provide 'ediff-merg) ;; ediff-merg.el ends here emacs-19.30/lisp/ediff-mult.el100444 12120 1 144132 6055442736 14505 0ustar rmsdaemon;;; ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff ;;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Notes: ;; ;; Users are strongly encourage to add functionality to this file. ;; In particular, epatch needs to be enhanced to work with multi-file ;; patches. The present file contains all the infrastructure needed for that. ;; ;; Generally, to to implement a new multisession capability within Ediff, ;; you need to tell it ;; ;; 1. How to display the session group buffer. ;; This function must indicate which Ediff sessions are active (+) and ;; which are finished (-). ;; See ediff-redraw-directory-group-buffer for an example. ;; In all likelihood, ediff-redraw-directory-group-buffer can be used ;; directly or after a small modification. ;; 2. What action to take when the user clicks button 2 or types v,e, or ;; RET. See ediff-dir-action. ;; 3. Provide a list of pairs or triples of file names (or buffers, ;; depending on the particular Ediff operation you want to invoke) ;; in the following format: ;; ((obj1 obj2 [optional obj3]) (...) ...) ;; Actually, the format of this list is pretty much up to the ;; developer. The only thing is that it must be a list of lists. ;; Also, keep in mind that the function ediff-prepare-meta-buffer ;; (which see) prepends nil in fron of each list (i.e., the above list ;; will become ((nil obj1 obj2 ...) (nil ...) ...). ;; Ediff expects that your function (in 2 above) will arrange to ;; replace this prepended nil (via setcar) with the actual ediff ;; control buffer associated with an appropriate Ediff session. ;; This is arranged through internal startup hooks that can be passed ;; to any of Ediff major entries (such as ediff-files, epatch, etc.). ;; See how this is done in ediff-dir-action. ;; 4. Write a function that makes a call to ediff-prepare-meta-buffer ;; passing all this info. ;; You may be able to use ediff-directories-internal as a template. ;; 5. If you intend to add several related pieces of functionality, ;; you may want to keep the function in 4 as an internal version ;; and then write several top-level interactive functions that call it ;; with different parameters. ;; See how ediff-directories, ediff-merge-directories, and ;; ediff-merge-directories-with-ancestor all use ;; ediff-directories-internal. ;; ;; In case of multifile patching, the easiest thing is to first apply the patch ;; and then find out which files were patched (using the algorithm utilized by ;; Unix patch and by parsing the patch file). The procedure ediff-patch-file ;; works for single-file patches only. However, it can deal with remote and ;; compressed files. Check out ediff-patch-file for details. ;; ;; Another useful addition here could be session groups selected by patterns ;; (which are different in each directory). For instance, one may want to ;; compare files of the form abc{something}.c to files old{something}.d ;; which may be in the same or different directories. Or, one may want to ;; compare all files of the form {something} to files of the form {something}~. ;; ;; Implementing this requires writing an collating function, which should pair ;; up appropriate files. It will also require a generalization of the functions ;; that do the layout of the meta- and differences buffers and of ;; ediff-dir-action. (require 'ediff-init) ;; meta-buffer (ediff-defvar-local ediff-meta-buffer nil "") (ediff-defvar-local ediff-parent-meta-buffer nil "") ;; the registry buffer (defvar ediff-registry-buffer nil) (defconst ediff-meta-buffer-message "This is an Ediff Session Group Panel: %s Useful commands: button2, `v', RET over a session line: start that Ediff session `M' in any session invoked from here: bring back this buffer `R':\tdisplay the registry of active Ediff sessions `h':\tmark session for hiding; with prefix arg--unmark `x':\thide marked sessions; with prefix arg--unhide hidden sessions `m':\tmark session for non-hiding operation; with prefix arg--unmark SPC:\tnext session DEL:\tprevious session `E':\tbrowse Ediff on-line manual `q':\tquit this session group ") (ediff-defvar-local ediff-meta-buffer-map nil "The keymap for the meta buffer.") (defvar ediff-dir-diffs-buffer-map (make-sparse-keymap) "The keymap to be installed in the buffer showing differences between directories.") ;; Variable specifying the action to take when the use invokes ediff in the ;; meta buffer. This is usually ediff-registry-action or ediff-dir-action (ediff-defvar-local ediff-meta-action-function nil "") ;; Tells ediff-update-meta-buffer how to redraw it (ediff-defvar-local ediff-meta-redraw-function nil "") ;; Tells ediff-dir-action and similar procedures how to invoke Ediff for the ;; sessions in a given session group (ediff-defvar-local ediff-session-action-function nil "") (ediff-defvar-local ediff-metajob-name nil "") ;; buffer used to collect custom diffs from individual sessions in the group (ediff-defvar-local ediff-meta-diff-buffer nil "") ;; history var to use for filtering groups (defvar ediff-filtering-regexp-history nil "") ;; This has the form ((ctl-buf file1 file2) (stl-buf file1 file2) ...) ;; If ctl-buf is nil, the file-pare wasn't processed yet. If it is ;; killed-buffer object, the file pair has been processed. If it is a live ;; buffer, this means ediff is still working on the pair (ediff-defvar-local ediff-meta-list nil "") ;; the difference list between directories in a directory session group (ediff-defvar-local ediff-dir-difference-list nil "") (ediff-defvar-local ediff-dir-diffs-buffer nil "") ;; The registry of Ediff sessions. A list of control buffers. (defvar ediff-session-registry nil) (defvar ediff-registry-setup-hook nil "*Hooks run just after the registry control panel is set up.") (defvar ediff-session-group-setup-hook nil "*Hooks run just after a meta-buffer controlling a session group, such as ediff-directories, is run.") (defvar ediff-show-registry-hook nil "*Hooks run just after the registry buffer is shown.") (defvar ediff-show-session-group-hook nil "*Hooks run just after a session group buffer is shown.") ;;; API (defun ediff-get-group-buffer (meta-list) (nth 0 (car meta-list))) (defun ediff-get-group-regexp (meta-list) (nth 1 (car meta-list))) (defun ediff-get-group-objA (meta-list) (nth 2 (car meta-list))) (defun ediff-get-group-objB (meta-list) (nth 3 (car meta-list))) (defun ediff-get-group-objC (meta-list) (nth 4 (car meta-list))) (defun ediff-get-session-buffer (elt) (nth 0 elt)) (defun ediff-get-session-status (elt) (nth 1 elt)) (defun ediff-get-session-objA (elt) (nth 2 elt)) (defun ediff-get-session-objB (elt) (nth 3 elt)) (defun ediff-get-session-objC (elt) (nth 4 elt)) (defun ediff-set-session-status (session-info new-status) (setcar (cdr session-info) new-status)) ;; set up the keymap in the meta buffer (defun ediff-setup-meta-map() (setq ediff-meta-buffer-map (make-sparse-keymap)) (suppress-keymap ediff-meta-buffer-map) (define-key ediff-meta-buffer-map "q" 'ediff-quit-meta-buffer) (define-key ediff-meta-buffer-map "R" 'ediff-show-registry) (define-key ediff-meta-buffer-map "E" 'ediff-documentation) (define-key ediff-meta-buffer-map "v" ediff-meta-action-function) (define-key ediff-meta-buffer-map "\C-m" ediff-meta-action-function) (define-key ediff-meta-buffer-map " " 'ediff-next-meta-item) (define-key ediff-meta-buffer-map "\C-?" 'ediff-previous-meta-item) (define-key ediff-meta-buffer-map [delete] 'ediff-previous-meta-item) (define-key ediff-meta-buffer-map [backspace] 'ediff-previous-meta-item) (if ediff-no-emacs-help-in-control-buffer (define-key ediff-meta-buffer-map "\C-h" 'ediff-previous-meta-item)) (if ediff-emacs-p (define-key ediff-meta-buffer-map [mouse-2] ediff-meta-action-function) (define-key ediff-meta-buffer-map [button2] ediff-meta-action-function)) (use-local-map ediff-meta-buffer-map)) (defun ediff-meta-mode () "This mode controls all operations on Ediff session groups. It is entered through one of the following commands: `ediff-directories' `edirs' `ediff-directories3' `edirs3' `ediff-merge-directories' `edirs-merge' `ediff-merge-directories-with-ancestor' `edirs-merge-with-ancestor' `ediff-directory-revisions' `edir-revisions' `ediff-merge-directory-revisions' `edir-merge-revisions' `ediff-merge-directory-revisions-with-ancestor' `edir-merge-revisions-with-ancestor' Commands: \\{ediff-meta-buffer-map}" (kill-all-local-variables) (setq major-mode 'ediff-meta-mode) (setq mode-name "MetaEdiff")) ;; the keymap for the buffer showing directory differences (suppress-keymap ediff-dir-diffs-buffer-map) (define-key ediff-dir-diffs-buffer-map "q" 'ediff-bury-dir-diffs-buffer) (define-key ediff-dir-diffs-buffer-map " " 'next-line) (define-key ediff-dir-diffs-buffer-map "\C-?" 'previous-line) (define-key ediff-dir-diffs-buffer-map [delete] 'previous-line) (define-key ediff-dir-diffs-buffer-map [backspace] 'previous-line) (defun ediff-next-meta-item (count) "Move to the next item in Ediff registry or session group buffer. Moves in circular fashion. With numeric prefix arg, skip this many items." (interactive "p") (or count (setq count 1)) (while (< 0 count) (setq count (1- count)) (ediff-next-meta-item1))) ;; Move to the next meta item (defun ediff-next-meta-item1 () (let (pos) (setq pos (ediff-next-meta-overlay-start (point))) ;;; ;; skip deleted ;;; (while (memq (ediff-get-session-status ;;; (ediff-get-meta-info (current-buffer) pos 'noerror)) ;;; '(?H ?I)) ;;; (setq pos (ediff-next-meta-overlay-start pos))) (if pos (goto-char pos)) (if (eq ediff-metajob-name 'ediff-registry) (if (search-forward "*Ediff" nil t) (skip-chars-backward "a-zA-Z*")) (if (> (skip-chars-forward "-+?H* \t0-9") 0) (backward-char 1))))) (defun ediff-previous-meta-item (count) "Move to the previous item in Ediff registry or session group buffer. Moves in circular fashion. With numeric prefix arg, skip this many items." (interactive "p") (or count (setq count 1)) (while (< 0 count) (setq count (1- count)) (ediff-previous-meta-item1))) (defun ediff-previous-meta-item1 () (let (pos) (setq pos (ediff-previous-meta-overlay-start (point))) ;;; ;; skip deleted ;;; (while (ediff-get-session-status ;;; (ediff-get-meta-info (current-buffer) pos 'noerror)) ;;; (setq pos (ediff-previous-meta-overlay-start pos))) (if pos (goto-char pos)) (if (eq ediff-metajob-name 'ediff-registry) (if (search-forward "*Ediff" nil t) (skip-chars-backward "a-zA-Z*")) (if (> (skip-chars-forward "-+?H* \t0-9") 0) (backward-char 1))))) ;; DIR1, DIR2, DIR3 are directories. ;; REGEXP is a regexp used to filter ;; files in the directories. ;; If a file is a directory in dir1 but not dir2 (or vice versa), it is not ;; included in the intersection. However, a regular file that is a dir in dir3 ;; is included, since dir3 files are supposed to be ancestors for merging. ;; Returns a list of the form: ;; ((dir1 dir2 dir3) (f1 f2 f3) (f1 f2 f3) ...) ;; dir3, f3 can be nil if intersecting only 2 directories. ;; If COMPARISON-FUNC is given, use it. Otherwise, use string= ;; DIFF-VAR is contains the name of the variable in which to return the ;; difference list. The diff list is of the form: ;; ((dir1 dir2 dir3) (file . num) (file . num)...) ;; where num encodes the set of dirs where the file is found: ;; 2 - only dir1; 3 - only dir2; 5 - only dir3; 6 - dir1&2; 10 - dir1&3; etc. (defun ediff-intersect-directories (jobname diff-var regexp dir1 dir2 &optional dir3 comparison-func) (require 'cl) (setq comparison-func (or comparison-func 'string=)) (let (lis1 lis2 lis3 common auxdir1 auxdir2 auxdir3 difflist) (setq auxdir1 (file-name-as-directory dir1) lis1 (directory-files auxdir1 nil regexp) auxdir2 (file-name-as-directory dir2) lis2 (directory-files auxdir2 nil regexp)) (if (stringp dir3) (setq auxdir3 (file-name-as-directory dir3) lis3 (directory-files auxdir3 nil regexp))) (setq lis1 (delete "." lis1) lis1 (delete ".." lis1)) (setq common (intersection lis1 lis2 ':test comparison-func)) ;; get rid of files that are directories in dir1 but not dir2 (mapcar (function (lambda (elt) (if (Xor (file-directory-p (concat auxdir1 elt)) (file-directory-p (concat auxdir2 elt))) (setq common (delq elt common))))) common) ;; intersect with the third dir (if lis3 (setq common (intersection common lis3 ':test comparison-func))) (if (ediff-comparison-metajob3 jobname) (mapcar (function (lambda (elt) (if (Xor (file-directory-p (concat auxdir1 elt)) (file-directory-p (concat auxdir3 elt))) (setq common (delq elt common))))) common)) ;; trying to avoid side effects of sorting (setq common (sort (copy-list common) 'string-lessp)) ;; compute difference list (setq difflist (set-difference (union (union lis1 lis2 ':test comparison-func) lis3 ':test comparison-func) common ':test comparison-func) difflist (delete "." difflist) ;; copy-list needed because sort sorts it by side effects difflist (sort (copy-list (delete ".." difflist)) 'string-lessp)) (setq difflist (mapcar (function (lambda (elt) (cons elt 1))) difflist)) ;; check for files belonging to lis1/2/3 (mapcar (function (lambda (elt) (if (member (car elt) lis1) (setcdr elt (* (cdr elt) 2))) (if (member (car elt) lis2) (setcdr elt (* (cdr elt) 3))) (if (member (car elt) lis3) (setcdr elt (* (cdr elt) 5))) )) difflist) (setq difflist (cons (list regexp auxdir1 auxdir2 auxdir3) difflist)) (set diff-var difflist) ;; return result (cons (list regexp auxdir1 auxdir2 auxdir3) (mapcar (function (lambda (elt) (list (concat auxdir1 elt) (concat auxdir2 elt) (if lis3 (concat auxdir3 elt))))) common)) )) ;; find directory files that are under revision. ;; display subdirectories, too, since we may visit them recursively. (defun ediff-get-directory-files-under-revision (jobname regexp dir1) (require 'cl) (let (lis1 elt common auxdir1) (setq auxdir1 (file-name-as-directory dir1) lis1 (directory-files auxdir1 nil regexp)) (while lis1 (setq elt (car lis1) lis1 (cdr lis1)) ;; take files under revision control (cond ((file-directory-p (concat auxdir1 elt)) (setq common (cons elt common))) ((file-exists-p (concat auxdir1 elt ",v")) (setq common (cons elt common)))) ) ; while (setq common (delete "." common) common (delete ".." common)) ;; trying to avoid side effects of sorting (setq common (sort (copy-list common) 'string-lessp)) ;; return result (cons (list regexp auxdir1 nil nil) (mapcar (function (lambda (elt) (list (concat auxdir1 elt) nil nil))) common)) )) ;; If file groups selected by patterns will ever be implemented, this ;; comparison function might become useful. ;;;; uses external variables PAT1 PAT2 to compare str1/2 ;;;; patterns must be of the form ???*???? where ??? are strings of chars ;;;; containing no *. ;;(defun ediff-pattern= (str1 str2) ;; (let (pos11 pos12 pos21 pos22 len1 len2) ;; (setq pos11 0 ;; len (length epat1) ;; pos12 len) ;; (while (and (< pos11 len) (not (= (aref epat1 pos11) ?*))) ;; (setq pos11 (1+ pos11))) ;; (while (and (> pos12 0) (not (= (aref epat1 (1- pos12)) ?*))) ;; (setq pos12 (1- pos12))) ;; ;; (setq pos21 0 ;; len (length epat2) ;; pos22 len) ;; (while (and (< pos21 len) (not (= (aref epat2 pos21) ?*))) ;; (setq pos21 (1+ pos21))) ;; (while (and (> pos22 0) (not (= (aref epat2 (1- pos22)) ?*))) ;; (setq pos22 (1- pos22))) ;; ;; (if (and (> (length str1) pos12) (>= pos12 pos11) (> pos11 -1) ;; (> (length str2) pos22) (>= pos22 pos21) (> pos21 -1)) ;; (string= (substring str1 pos11 pos12) ;; (substring str2 pos21 pos22))) ;; )) ;; Prepare meta-buffer in accordance with the argument-function and ;; redraw-function. Must return the created meta-buffer. (defun ediff-prepare-meta-buffer (action-func meta-list meta-buffer-name redraw-function jobname &optional startup-hooks) (let* ((meta-buffer-name (ediff-unique-buffer-name meta-buffer-name "*")) (meta-buffer (get-buffer-create meta-buffer-name))) (ediff-eval-in-buffer meta-buffer ;; comes first (ediff-meta-mode) (setq ediff-meta-action-function action-func ediff-meta-redraw-function redraw-function ediff-metajob-name jobname ediff-meta-buffer meta-buffer) ;; comes after ediff-meta-action-function is set (ediff-setup-meta-map) (if (eq ediff-metajob-name 'ediff-registry) (progn (setq ediff-registry-buffer meta-buffer ediff-meta-list meta-list) ;; this func is used only from registry buffer, not from other ;; meta-buffs. (define-key ediff-meta-buffer-map "M" 'ediff-show-meta-buff-from-registry)) ;; initialize the meta list -- don't do this for registry we prepend ;; '(nil nil) nil to all elts of meta-list, except the first. The ;; first nil will later be replaced by the session buffer. The second ;; is reserved for session status. ;; (car ediff-meta-list) gets cons'ed with the session group buffer. (setq ediff-meta-list (cons (cons meta-buffer (car meta-list)) (mapcar (function (lambda (elt) (cons nil (cons nil elt)))) (cdr meta-list))))) (or (eq meta-buffer ediff-registry-buffer) (setq ediff-session-registry (cons meta-buffer ediff-session-registry))) ;; redraw-function uses ediff-meta-list (funcall redraw-function ediff-meta-list) ;; set read-only/non-modified (setq buffer-read-only t) (set-buffer-modified-p nil) (run-hooks 'startup-hooks) ;; arrange for showing directory contents differences ;; must be after run startup-hooks, since ediff-dir-difference-list is ;; set inside these hooks (if (eq action-func 'ediff-dir-action) (progn ;; put meta buffer in (car ediff-dir-difference-list) (setq ediff-dir-difference-list (cons (cons meta-buffer (car ediff-dir-difference-list)) (cdr ediff-dir-difference-list))) (or (ediff-dir1-metajob jobname) (ediff-draw-dir-diffs ediff-dir-difference-list)) (define-key ediff-meta-buffer-map "h" 'ediff-mark-for-hiding) (define-key ediff-meta-buffer-map "x" 'ediff-hide-marked-sessions) (define-key ediff-meta-buffer-map "m" 'ediff-mark-for-operation) (if (ediff-collect-diffs-metajob jobname) (define-key ediff-meta-buffer-map "P" 'ediff-collect-custom-diffs)) (define-key ediff-meta-buffer-map "u" 'ediff-up-meta-hierarchy) (define-key ediff-meta-buffer-map "D" 'ediff-show-dir-diffs))) (if (eq ediff-metajob-name 'ediff-registry) (run-hooks 'ediff-registry-setup-hook) (run-hooks 'ediff-session-group-setup-hook)) ) ; eval in meta-buffer meta-buffer)) ;; this is a setup function for ediff-directories ;; must return meta-buffer (defun ediff-redraw-directory-group-buffer (meta-list) ;; extract directories (let ((meta-buf (ediff-get-group-buffer meta-list)) (empty t) (sessionNum 0) regexp elt session-buf f1 f2 f3 pt point tmp-list buffer-read-only) (ediff-eval-in-buffer meta-buf (setq point (point)) (erase-buffer) (insert (format ediff-meta-buffer-message (ediff-abbrev-jobname ediff-metajob-name))) (setq regexp (ediff-get-group-regexp meta-list)) (if (ediff-collect-diffs-metajob) (insert " `P':\tcollect custom diffs of all marked sessions\n")) (insert " `u':\tshow parent session group `D':\tdisplay differences among the contents of directories\n\n") (if (and (stringp regexp) (> (length regexp) 0)) (insert (format "Filter-through regular expression: %s\n" regexp))) (insert "\n Size Name ----------------------------------------------------------------------- ") ;; discard info on directories and regexp (setq meta-list (cdr meta-list) tmp-list meta-list) (while (and tmp-list empty) (if (and (car tmp-list) (not (eq (ediff-get-session-status (car tmp-list)) ?I))) (setq empty nil)) (setq tmp-list (cdr tmp-list))) (if empty (insert " ****** ****** This session group has no members\n")) ;; now organize file names like this: ;; preferred format: ;; use-mark sizeA dateA sizeB dateB filename ;; I don't have time to mess up with calculating last modtimes ;; (XEmacs has no decode-time function), so ;; the actual format is: ;; use-mark Size filename ;; make sure directories are displayed with a trailing slash. ;; If one is a directory and another isn't, indicate this with a `?' (while meta-list (setq elt (car meta-list) meta-list (cdr meta-list) sessionNum (1+ sessionNum)) (if (eq (ediff-get-session-status elt) ?I) () (setq session-buf (ediff-get-session-buffer elt) f1 (ediff-get-session-objA elt) f2 (ediff-get-session-objB elt) f3 (ediff-get-session-objC elt)) (setq pt (point)) ;; insert markers (insert (cond ((null session-buf) " ") ; virgin session ((ediff-buffer-live-p session-buf) "+") ;active session (t "-"))) ; finished session (insert (cond ((ediff-get-session-status elt)) ; session has status, ;;; e.g., ?H, ?I (t " "))) ; normal session (insert " Session " (int-to-string sessionNum) ":\n") (ediff-meta-insert-file-info f1) (ediff-meta-insert-file-info f2) (ediff-meta-insert-file-info f3) (ediff-set-meta-overlay pt (point) elt))) (set-buffer-modified-p nil) (goto-char point) meta-buf))) ;; Check if this is a problematic session. ;; Return nil if not. Otherwise, return symbol representing the problem ;; At present, problematic sessions occur only in -with-ancestor comparisons ;; when the ancestor is a directory rather than a file. (defun ediff-problematic-session-p (session) (let ((f1 (ediff-get-session-objA session)) (f2 (ediff-get-session-objB session)) (f3 (ediff-get-session-objC session))) (cond ((and (stringp f1) (not (file-directory-p f1)) (stringp f2) (not (file-directory-p f2)) (stringp f3) (file-directory-p f3) (ediff-ancestor-metajob)) ;; more may be added later 'ancestor-is-dir) (t nil)))) (defun ediff-meta-insert-file-info (file) (if (stringp file) (insert (format " %10d %s\n" (nth 7 (file-attributes file)) ;; dir names in meta lists have no trailing `/' so insert it (cond ((file-directory-p file) (file-name-as-directory (ediff-abbreviate-file-name file))) (t (ediff-abbreviate-file-name file))))) )) (defun ediff-draw-dir-diffs (diff-list) (if (null diff-list) (error "Lost difference info on these directories")) (let* ((buf-name (ediff-unique-buffer-name "*Ediff File Group Differences" "*")) (regexp (ediff-get-group-regexp diff-list)) (dir1 (ediff-abbreviate-file-name (ediff-get-group-objA diff-list))) (dir2 (ediff-abbreviate-file-name (ediff-get-group-objB diff-list))) (dir3 (ediff-get-group-objC diff-list)) (dir3 (if (stringp dir3) (ediff-abbreviate-file-name dir3))) (meta-buf (ediff-get-group-buffer diff-list)) (underline (make-string 26 ?-)) file code buffer-read-only) ;; skip the directory part (setq diff-list (cdr diff-list)) (setq ediff-dir-diffs-buffer (get-buffer-create buf-name)) (ediff-eval-in-buffer ediff-dir-diffs-buffer (use-local-map ediff-dir-diffs-buffer-map) (erase-buffer) (setq ediff-meta-buffer meta-buf) (insert "\t\t*** Directory Differences ***\n") (insert " Useful commands: `q': hide this buffer SPC: next line DEL: previous line\n\n") (if (and (stringp regexp) (> (length regexp) 0)) (insert (format "Filter-through regular expression: %s\n" regexp))) (insert "\n") (insert (format "\n%-27s%-26s" (ediff-truncate-string-left (ediff-abbreviate-file-name (file-name-as-directory dir1)) 25) (ediff-truncate-string-left (ediff-abbreviate-file-name (file-name-as-directory dir2)) 25))) (if dir3 (insert (format " %-25s\n" (ediff-truncate-string-left (ediff-abbreviate-file-name (file-name-as-directory dir3)) 25))) (insert "\n")) (insert (format "%s%s" underline underline)) (if (stringp dir3) (insert (format "%s\n\n" underline)) (insert "\n\n")) (if (null diff-list) (insert "\n\t*** No differences ***\n")) (while diff-list (setq file (car (car diff-list)) code (cdr (car diff-list)) diff-list (cdr diff-list)) (if (= (mod code 2) 0) ; dir1 (insert (format "%-27s" (ediff-truncate-string-left (ediff-abbreviate-file-name (if (file-directory-p (concat dir1 file)) (file-name-as-directory file) file)) 24))) (insert (format "%-27s" "---"))) (if (= (mod code 3) 0) ; dir2 (insert (format "%-26s" (ediff-truncate-string-left (ediff-abbreviate-file-name (if (file-directory-p (concat dir2 file)) (file-name-as-directory file) file)) 24))) (insert (format "%-26s" "---"))) (if (stringp dir3) (if (= (mod code 5) 0) ; dir3 (insert (format " %-25s" (ediff-truncate-string-left (ediff-abbreviate-file-name (if (file-directory-p (concat dir3 file)) (file-name-as-directory file) file)) 24))) (insert (format " %-25s" "---")))) (insert "\n")) (setq buffer-read-only t) (set-buffer-modified-p nil)) ; eval in diff buffer )) (defun ediff-bury-dir-diffs-buffer () "Bury the directory difference buffer. Display the meta buffer instead." (interactive) (let ((buf ediff-meta-buffer) wind) (bury-buffer) (if (setq wind (ediff-get-visible-buffer-window buf)) (select-window wind) (set-window-buffer (selected-window) buf)))) ;; executes in dir session group buffer ;; show buffer differences (defun ediff-show-dir-diffs () "Display differences among the directories involved in session group." (interactive) (if (ediff-dir1-metajob) (error "This command is inapplicable in the present context")) (or (ediff-buffer-live-p ediff-dir-diffs-buffer) (ediff-draw-dir-diffs ediff-dir-difference-list)) (let ((buf ediff-dir-diffs-buffer)) (other-window 1) (set-window-buffer (selected-window) buf) (goto-char (point-min)))) (defun ediff-up-meta-hierarchy () "Go to the parent session group buffer." (interactive) (if (ediff-buffer-live-p ediff-parent-meta-buffer) (ediff-show-meta-buffer ediff-parent-meta-buffer) (error "This session group has no parent"))) ;; argument is ignored (defun ediff-redraw-registry-buffer (&optional ignore) (ediff-eval-in-buffer ediff-registry-buffer (let ((point (point)) elt bufAname bufBname bufCname cur-diff total-diffs pt job-name meta-list registry-list buffer-read-only) (erase-buffer) (insert "This is a registry of all active Ediff sessions. Useful commands: button2, `v', RET over a session record: switch to that session `M' over a session record: display the associated session group `R' in any Ediff session: display session registry SPC:\tnext session DEL:\tprevious session `E':\tbrowse Ediff on-line manual `q':\tbury registry \t\tActive Ediff Sessions: \t\t---------------------- ") ;; purge registry list from dead buffers (mapcar (function (lambda (elt) (if (not (ediff-buffer-live-p elt)) (setq ediff-session-registry (delq elt ediff-session-registry))))) ediff-session-registry) (if (null ediff-session-registry) (insert " ******* No active Ediff sessions *******\n")) (setq registry-list ediff-session-registry) (while registry-list (setq elt (car registry-list) registry-list (cdr registry-list)) (if (ediff-buffer-live-p elt) (if (ediff-eval-in-buffer elt (setq job-name ediff-metajob-name meta-list ediff-meta-list) (and ediff-metajob-name (not (eq ediff-metajob-name 'ediff-registry)))) (progn (setq pt (point)) (insert (format " *group*\t%s: %s\n" (buffer-name elt) (ediff-abbrev-jobname job-name))) (insert (format "\t\t %s %s %s\n" (ediff-abbreviate-file-name (ediff-get-group-objA meta-list)) (ediff-abbreviate-file-name (or (ediff-get-group-objB meta-list) "")) (ediff-abbreviate-file-name (or (ediff-get-group-objC meta-list) "")))) (ediff-set-meta-overlay pt (point) elt)) (progn (ediff-eval-in-buffer elt (setq bufAname (if (ediff-buffer-live-p ediff-buffer-A) (buffer-name ediff-buffer-A) "!!!killed buffer!!!") bufBname (if (ediff-buffer-live-p ediff-buffer-B) (buffer-name ediff-buffer-B) "!!!killed buffer!!!") bufCname (cond ((not (ediff-3way-job)) "") ((ediff-buffer-live-p ediff-buffer-C) (buffer-name ediff-buffer-C)) (t "!!!killed buffer!!!"))) (setq total-diffs (format "%-4d" ediff-number-of-differences) cur-diff (cond ((= ediff-current-difference -1) " _") ((= ediff-current-difference ediff-number-of-differences) " $") (t (format "%4d" (1+ ediff-current-difference)))) job-name ediff-job-name)) ;; back in the meta buf (setq pt (point)) (insert cur-diff "/" total-diffs "\t" (buffer-name elt) (format ": %s" (ediff-abbrev-jobname job-name))) (insert "\n\t\t " bufAname " " bufBname " " bufCname "\n") (ediff-set-meta-overlay pt (point) elt)))) ) ; while (set-buffer-modified-p nil) (goto-char point) ))) ;; sets overlay around a meta record with 'ediff-meta-info property PROP (defun ediff-set-meta-overlay (b e prop) (let (overl) (setq overl (ediff-make-overlay b e)) (if ediff-emacs-p (ediff-overlay-put overl 'mouse-face 'highlight) (ediff-overlay-put overl 'highlight t)) (ediff-overlay-put overl 'ediff-meta-info prop))) (defun ediff-mark-for-hiding (unmark) "Mark session for hiding. With prefix arg, unmark." (interactive "P") (let* ((pos (ediff-event-point last-command-event)) (meta-buf (ediff-event-buffer last-command-event)) ;; ediff-get-meta-info gives error if meta-buf or pos are invalid (info (ediff-get-meta-info meta-buf pos)) (session-buf (ediff-get-session-buffer info))) (if unmark (ediff-set-session-status info nil) (if (ediff-buffer-live-p session-buf) (error "Can't hide active session, %s" (buffer-name session-buf))) (ediff-set-session-status info ?H)) (ediff-update-meta-buffer meta-buf) )) (defun ediff-mark-for-operation (unmark) "Mark session for a group operation. With prefix arg, unmark." (interactive "P") (let* ((pos (ediff-event-point last-command-event)) (meta-buf (ediff-event-buffer last-command-event)) ;; ediff-get-meta-info gives error if meta-buf or pos are invalid (info (ediff-get-meta-info meta-buf pos))) (if unmark (ediff-set-session-status info nil) (ediff-set-session-status info ?*)) (ediff-update-meta-buffer meta-buf) )) (defun ediff-hide-marked-sessions (unhide) "Hide marked sessions. With prefix arg, unhide." (interactive "P") (let ((grp-buf (ediff-get-group-buffer ediff-meta-list)) (meta-list (cdr ediff-meta-list)) (from (if unhide ?I ?H)) (to (if unhide ?H ?I)) (numMarked 0) elt) (while meta-list (setq elt (car meta-list) meta-list (cdr meta-list)) (if (eq (ediff-get-session-status elt) from) (progn (setq numMarked (1+ numMarked)) (ediff-set-session-status elt to)))) (if (> numMarked 0) (ediff-update-meta-buffer grp-buf) (beep) (if unhide (message "Nothing to reveal...") (message "Nothing to hide..."))) )) ;; Apply OPERATION to marked sessions. Operation expects one argument of type ;; meta-list member (not the first one), i.e., a regular session description. ;; Returns number of marked sessions on which operation was performed (defun ediff-operate-on-marked-sessions (operation) (let ((grp-buf (ediff-get-group-buffer ediff-meta-list)) (meta-list (cdr ediff-meta-list)) (marksym ?*) (numMarked 0) (sessionNum 0) elt) (while meta-list (setq elt (car meta-list) meta-list (cdr meta-list) sessionNum (1+ sessionNum)) (if (eq (ediff-get-session-status elt) marksym) (save-excursion (setq numMarked (1+ numMarked)) (funcall operation elt sessionNum)))) (ediff-update-meta-buffer grp-buf) ; just in case numMarked )) (defun ediff-append-custom-diff (session sessionNum) (or (ediff-collect-diffs-metajob) (error "Sorry, I don't do this for everyone...")) (let ((session-buf (ediff-get-session-buffer session)) (meta-diff-buff ediff-meta-diff-buffer) (metajob ediff-metajob-name) tmp-buf custom-diff-buf) (if (ediff-buffer-live-p session-buf) (ediff-eval-in-buffer session-buf (if (eq ediff-control-buffer session-buf) ; individual session (setq custom-diff-buf ediff-custom-diff-buffer)))) (or (ediff-buffer-live-p meta-diff-buff) (error "Ediff: something wrong--no multiple diffs buffer")) (cond ((ediff-buffer-live-p custom-diff-buf) (save-excursion (set-buffer meta-diff-buff) (goto-char (point-max)) (insert-buffer custom-diff-buf) (insert "\n"))) ((eq metajob 'ediff-directories) ;; get diffs by calling shell command on ediff-custom-diff-program (save-excursion (set-buffer (setq tmp-buf (get-buffer-create ediff-tmp-buffer))) (erase-buffer) (shell-command (format "%s %s %s %s" ediff-custom-diff-program ediff-custom-diff-options (ediff-get-session-objA session) (ediff-get-session-objB session)) t)) (save-excursion (set-buffer meta-diff-buff) (goto-char (point-max)) (insert-buffer tmp-buf) (insert "\n"))) (t (error "Session %d is marked but inactive--can't make its diff" sessionNum))) )) (defun ediff-collect-custom-diffs () "Collect custom diffs of marked sessions in buffer `*Ediff Multifile Diffs*'. This operation is defined only for `ediff-directories' and `ediff-directory-revisions', since its intent is to produce multifile patches. For `ediff-directory-revisions', we insist that all marked sessions must be active." (interactive) (or (ediff-buffer-live-p ediff-meta-diff-buffer) (setq ediff-meta-diff-buffer (get-buffer-create (ediff-unique-buffer-name "*Ediff Multifile Diffs" "*")))) (ediff-eval-in-buffer ediff-meta-diff-buffer (erase-buffer)) (if (> (ediff-operate-on-marked-sessions 'ediff-append-custom-diff) 0) ;; did something (display-buffer ediff-meta-diff-buffer 'not-this-window) (beep) (message "No marked sessions found"))) ;; This function executes in meta buffer. It knows where event happened. (defun ediff-dir-action () "Execute appropriate action for the selected session." (interactive) (let* ((pos (ediff-event-point last-command-event)) (meta-buf (ediff-event-buffer last-command-event)) ;; ediff-get-meta-info gives error if meta-buf or pos are invalid (info (ediff-get-meta-info meta-buf pos)) session-buf file1 file2 file3 regexp) (setq session-buf (ediff-get-session-buffer info) file1 (ediff-get-session-objA info) file2 (ediff-get-session-objB info) file3 (ediff-get-session-objC info)) ;; make sure we don't start on hidden sessions ;; ?H means marked for hiding. ?I means invalid (hidden). (if (memq (ediff-get-session-status info) '(?H ?I)) (progn (beep) (if (y-or-n-p "This session is marked as hidden, unmark? ") (progn (ediff-set-session-status info nil) (ediff-update-meta-buffer meta-buf)) (error "Aborted")))) (ediff-eval-in-buffer meta-buf (goto-char pos) ; if the user clicked on session--move point there ;; First handle sessions involving directories (which are themselves ;; session groups) ;; After that handle individual sessions (cond ((and (file-directory-p file1) (stringp file2) (file-directory-p file2) (if (stringp file3) (file-directory-p file1) t)) ;; do ediff/ediff-merge on subdirectories (if (ediff-buffer-live-p session-buf) (ediff-show-meta-buffer session-buf) (setq regexp (read-string "Filter through regular expression: " nil 'ediff-filtering-regexp-history)) (ediff-directories-internal file1 file2 file3 regexp ediff-session-action-function ediff-metajob-name ;; make it update car info after startup (` (list (lambda () ;; child session group should know its parent (setq ediff-parent-meta-buffer (quote (, ediff-meta-buffer))) ;; and parent will know its child (setcar (quote (, info)) ediff-meta-buffer))))))) ;; Do ediff-revision on a subdirectory ((and (ediff-dir1-metajob) (file-directory-p file1)) (if (ediff-buffer-live-p session-buf) (ediff-show-meta-buffer session-buf) (setq regexp (read-string "Filter through regular expression: " nil 'ediff-filtering-regexp-history)) (ediff-directory-revisions-internal file1 regexp ediff-session-action-function ediff-metajob-name ;; make it update car info after startup (` (list (lambda () ;; child session group should know its parent (setq ediff-parent-meta-buffer (quote (, ediff-meta-buffer))) ;; and parent will know its child (setcar (quote (, info)) ediff-meta-buffer))))))) ;; From here on---only individual session handlers ;; handle an individual session with live control buffer ((ediff-buffer-live-p session-buf) (ediff-eval-in-buffer session-buf (setq ediff-mouse-pixel-position (mouse-pixel-position)) (ediff-recenter 'no-rehighlight))) ((ediff-problematic-session-p info) (beep) (if (y-or-n-p "This session's ancestor is a directory, merge without the ancestor? ") (ediff-merge-files file1 file2 ;; arrange startup hooks (` (list (lambda () (setq ediff-meta-buffer (, (current-buffer))) ;; see below for the explanation of what this does (setcar (quote (, info)) ediff-control-buffer))))) (error "Aborted"))) ((ediff-dir1-metajob) ; needs 1 file arg (funcall ediff-session-action-function file1 ;; arrange startup hooks (` (list (lambda () (setq ediff-meta-buffer (, (current-buffer))) ;; see below for explanation of what this does (setcar (quote (, info)) ediff-control-buffer)))))) ((not (ediff-metajob3)) ; need 2 file args (funcall ediff-session-action-function file1 file2 ;; arrange startup hooks (` (list (lambda () (setq ediff-meta-buffer (, (current-buffer))) ;; this makes ediff-startup pass the value of ;; ediff-control-buffer back to the meta ;; level, to the record in the meta list ;; containing the information about the ;; session associated with that ;; ediff-control-buffer (setcar (quote (, info)) ediff-control-buffer)))))) ((ediff-metajob3) ; need 3 file args (funcall ediff-session-action-function file1 file2 file3 ;; arrange startup hooks (` (list (lambda () (setq ediff-meta-buffer (, (current-buffer))) (setcar (quote (, info)) ediff-control-buffer)))))) ) ; cond ) ; eval in meta-buf )) (defun ediff-registry-action () "Switch to a selected session." (interactive) (let* ((pos (ediff-event-point last-command-event)) (buf (ediff-event-buffer last-command-event)) (ctl-buf (ediff-get-meta-info buf pos))) (if (ediff-buffer-live-p ctl-buf) ;; check if this is ediff-control-buffer or ediff-meta-buffer (if (ediff-eval-in-buffer ctl-buf (eq (key-binding "q") 'ediff-quit-meta-buffer)) ;; it's a meta-buffer -- last action should just display it (ediff-show-meta-buffer ctl-buf) ;; it's a session buffer -- invoke go back to session (ediff-eval-in-buffer ctl-buf (setq ediff-mouse-pixel-position (mouse-pixel-position)) (ediff-recenter 'no-rehighlight))) (beep) (message "You've selected a stale session --- try again") (ediff-update-registry)) (ediff-eval-in-buffer buf (goto-char pos)) )) (defun ediff-show-meta-buffer (&optional meta-buf) "Show the session group buffer." (interactive) (let (wind frame silent) (if meta-buf (setq silent t)) (setq meta-buf (or meta-buf ediff-meta-buffer)) (cond ((not (bufferp meta-buf)) (error "This Ediff session is not part of a session group")) ((not (ediff-buffer-live-p meta-buf)) (error "Can't find this session's group panel -- session itself is ok"))) (ediff-cleanup-meta-buffer meta-buf) (ediff-eval-in-buffer meta-buf (save-excursion (cond ((setq wind (ediff-get-visible-buffer-window meta-buf)) (or silent (message "Already showing the group panel for this session")) (set-window-buffer wind meta-buf) (select-window wind)) ((window-live-p (setq wind ediff-window-C)) ;in merge--merge buf (set-window-buffer ediff-window-C meta-buf) (select-window wind)) ((window-live-p (setq wind ediff-window-A)) (set-window-buffer ediff-window-A meta-buf) (select-window wind)) ((window-live-p (setq wind ediff-window-B)) (set-window-buffer ediff-window-B meta-buf) (select-window wind)) ((and (setq wind (ediff-get-visible-buffer-window ediff-registry-buffer)) (ediff-window-display-p)) (select-window wind) (other-window 1) (set-window-buffer (selected-window) meta-buf)) (t (ediff-skip-unsuitable-frames 'ok-unsplittable) (set-window-buffer (selected-window) meta-buf))) )) (if (ediff-window-display-p) (progn (setq frame (window-frame (ediff-get-visible-buffer-window meta-buf))) (raise-frame frame) (ediff-reset-mouse frame))) (run-hooks 'ediff-show-session-group-hook) )) (defun ediff-show-meta-buff-from-registry () "Display the session group buffer for a selected session group." (interactive) (let* ((pos (ediff-event-point last-command-event)) (meta-buf (ediff-event-buffer last-command-event)) (info (ediff-get-meta-info meta-buf pos)) (meta-or-session-buf info)) (ediff-eval-in-buffer meta-or-session-buf (ediff-show-meta-buffer)))) ;;;###autoload (defun ediff-show-registry () "Display Ediff's registry." (interactive) (ediff-update-registry) (if (not (ediff-buffer-live-p ediff-registry-buffer)) (error "No active Ediff sessions or corrupted session registry")) (let (wind frame) ;; for some reason, point moves in ediff-registry-buffer, so we preserve it ;; explicity (ediff-eval-in-buffer ediff-registry-buffer (save-excursion (cond ((setq wind (ediff-get-visible-buffer-window ediff-registry-buffer)) (message "Already showing the registry") (set-window-buffer wind ediff-registry-buffer) (select-window wind)) ((window-live-p ediff-window-C) (set-window-buffer ediff-window-C ediff-registry-buffer) (select-window ediff-window-C)) ((window-live-p ediff-window-A) (set-window-buffer ediff-window-A ediff-registry-buffer) (select-window ediff-window-A)) ((window-live-p ediff-window-B) (set-window-buffer ediff-window-B ediff-registry-buffer) (select-window ediff-window-B)) ((and (setq wind (ediff-get-visible-buffer-window ediff-meta-buffer)) (ediff-window-display-p)) (select-window wind) (other-window 1) (set-window-buffer (selected-window) ediff-registry-buffer)) (t (ediff-skip-unsuitable-frames 'ok-unsplittable) (set-window-buffer (selected-window) ediff-registry-buffer))) )) (if (ediff-window-display-p) (progn (setq frame (window-frame (ediff-get-visible-buffer-window ediff-registry-buffer))) (raise-frame frame) (ediff-reset-mouse frame))) (run-hooks 'ediff-show-registry-hook) )) ;;;###autoload (defalias 'eregistry 'ediff-show-registry) ;; If meta-buf doesn't exist, it is created. In that case, id doesn't have a ;; parent meta-buf ;; Check if META-BUF exists before calling this function (defun ediff-update-meta-buffer (meta-buf) (ediff-eval-in-buffer (current-buffer) (if (ediff-buffer-live-p meta-buf) (ediff-eval-in-buffer meta-buf (funcall ediff-meta-redraw-function ediff-meta-list)) ))) (defun ediff-update-registry () (ediff-eval-in-buffer (current-buffer) (if (ediff-buffer-live-p ediff-registry-buffer) (ediff-redraw-registry-buffer) (ediff-prepare-meta-buffer 'ediff-registry-action ediff-session-registry "*Ediff Registry" 'ediff-redraw-registry-buffer 'ediff-registry)) )) ;; if meta-buf exists, it is redrawn along with parent. Otherwise, nothing ;; happens (defun ediff-cleanup-meta-buffer (meta-buffer) (if (ediff-buffer-live-p meta-buffer) (ediff-eval-in-buffer meta-buffer (ediff-update-meta-buffer meta-buffer) (if (ediff-buffer-live-p ediff-parent-meta-buffer) (ediff-update-meta-buffer ediff-parent-meta-buffer))))) ;; t if no session in progress (defun ediff-safe-to-quit (meta-buffer) (if (ediff-buffer-live-p meta-buffer) (let ((lis ediff-meta-list) (cont t) buffer-read-only) (ediff-update-meta-buffer meta-buffer) (ediff-eval-in-buffer meta-buffer (setq lis (cdr lis)) ; discard the description part of meta-list (while (and cont lis) (if (ediff-buffer-live-p (ediff-get-group-buffer lis)) ; in progress (setq cont nil)) (setq lis (cdr lis))) cont)))) (defun ediff-quit-meta-buffer () "If no unprocessed sessions in the group, delete the meta buffer. If no session is in progress, ask to confirm before deleting meta buffer. Otherwise, bury the meta buffer. If this is a session registry buffer then just bury it." (interactive) (let* ((buf (current-buffer)) (dir-diffs-buffer ediff-dir-diffs-buffer) (meta-diff-buffer ediff-meta-diff-buffer) (parent-buf ediff-parent-meta-buffer) (dont-show-registry (eq buf ediff-registry-buffer))) (if dont-show-registry (bury-buffer) (ediff-cleanup-meta-buffer buf) (cond ((and (ediff-safe-to-quit buf) (y-or-n-p "Quit this session group? ")) (ediff-dispose-of-meta-buffer buf)) ((ediff-safe-to-quit buf) (bury-buffer)) (t (bury-buffer) (beep) (message "Group has active sessions, panel not deleted"))) (ediff-cleanup-meta-buffer parent-buf) (ediff-kill-buffer-carefully dir-diffs-buffer) (ediff-kill-buffer-carefully meta-diff-buffer) (if (ediff-buffer-live-p parent-buf) (progn (setq dont-show-registry t) (ediff-show-meta-buffer parent-buf))) ) (or dont-show-registry (ediff-show-registry)))) (defun ediff-dispose-of-meta-buffer (buf) (setq ediff-session-registry (delq buf ediff-session-registry)) (ediff-eval-in-buffer buf (if (ediff-buffer-live-p ediff-dir-diffs-buffer) (kill-buffer ediff-dir-diffs-buffer))) (kill-buffer buf)) ;; obtain information on a meta record where the user clicked or typed ;; BUF is the buffer where this happened and POINT is the position ;; If optional NOERROR arg is given, don't report error and return nil if no ;; meta info is found on line. (defun ediff-get-meta-info (buf point &optional noerror) (let (result olist tmp) (if (and point (ediff-buffer-live-p buf)) (ediff-eval-in-buffer buf (if ediff-xemacs-p (setq result (if (setq tmp (extent-at point buf 'ediff-meta-info)) (ediff-overlay-get tmp 'ediff-meta-info))) (setq olist (overlays-at point)) (setq olist (mapcar (function (lambda (elt) (overlay-get elt 'ediff-meta-info))) olist)) (while (and olist (null (car olist)) (overlay-get (car olist) 'invisible)) (setq olist (cdr olist))) (setq result (car olist))))) (if result result (if noerror nil (ediff-update-registry) (error "No session info in this line"))))) ;; return location of the next meta overlay after point (defun ediff-next-meta-overlay-start (point) (let (overl) (if ediff-xemacs-p (progn (setq overl (extent-at point (current-buffer) 'ediff-meta-info)) (if overl (setq overl (next-extent overl)) (setq overl (next-extent (current-buffer)))) (if overl (extent-start-position overl) (point-max))) (if (= point (point-max)) (setq point (point-min))) (setq overl (car (overlays-at point))) (if (and overl (overlay-get overl 'ediff-meta-info)) (overlay-end overl) (next-overlay-change point))))) (defun ediff-previous-meta-overlay-start (point) (let (overl) (if ediff-xemacs-p (progn (setq overl (extent-at point (current-buffer) 'ediff-meta-info)) (if overl (setq overl (previous-extent overl)) (setq overl (previous-extent (current-buffer)))) (if overl (extent-start-position overl) (point-max))) ;;(if (bobp) (setq point (point-max))) (setq overl (car (overlays-at point))) (setq point (if (and overl (overlay-get overl 'ediff-meta-info)) (previous-overlay-change (overlay-start overl)) (previous-overlay-change point))) (if (= point (point-min)) (point-max) point) ))) ;;; Local Variables: ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) ;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1) ;;; End: (provide 'ediff-mult) (require 'ediff-util) ;;; ediff-mult.el ends here emacs-19.30/lisp/ediff-util.el100444 12120 1 354441 6054175513 14502 0ustar rmsdaemon;;; ediff-util.el --- the core commands and utilities of ediff ;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (require 'ediff-init) (require 'ediff-mult) ;;; Functions (defun ediff-mode () "Ediff mode controls all operations in a single Ediff session. This mode is entered through one of the following commands: `ediff' `ediff-files' `ediff-buffers' `ediff3' `ediff-files3' `ediff-buffers3' `ediff-merge' `ediff-merge-files' `ediff-merge-files-with-ancestor' `ediff-merge-buffers' `ediff-merge-buffers-with-ancestor' `ediff-merge-revisions' `ediff-merge-revisions-with-ancestor' `ediff-windows-wordwise' `ediff-windows-linewise' `ediff-regions-wordwise' `ediff-regions-linewise' `epatch' `ediff-patch-file' `ediff-patch-buffer' `epatch-buffer' `ediff-revision' Commands: \\{ediff-mode-map}" (kill-all-local-variables) (setq major-mode 'ediff-mode) (setq mode-name "Ediff") (run-hooks 'ediff-mode-hook)) (require 'ediff-diff) (require 'ediff-merg) ;;; Build keymaps (ediff-defvar-local ediff-mode-map nil "Local keymap used in Ediff mode. This is local to each Ediff Control Panel, so they may vary from invocation to invocation.") ;; Set up the keymap in the control buffer (defun ediff-set-keys () "Set up Ediff keymap, if necessary." (if (null ediff-mode-map) (ediff-setup-keymap)) (use-local-map ediff-mode-map)) ;; Reload Ediff keymap. For debugging only. (defun ediff-reload-keymap () (interactive) (setq ediff-mode-map nil) (ediff-set-keys)) (defun ediff-setup-keymap () "Set up the keymap used in the control buffer of Ediff." (setq ediff-mode-map (make-sparse-keymap)) (suppress-keymap ediff-mode-map) (define-key ediff-mode-map "p" 'ediff-previous-difference) (define-key ediff-mode-map "\C-?" 'ediff-previous-difference) (define-key ediff-mode-map [backspace] 'ediff-previous-difference) (define-key ediff-mode-map [delete] 'ediff-previous-difference) (define-key ediff-mode-map "\C-h" (if ediff-no-emacs-help-in-control-buffer 'ediff-previous-difference nil)) (define-key ediff-mode-map "n" 'ediff-next-difference) (define-key ediff-mode-map " " 'ediff-next-difference) (define-key ediff-mode-map "j" 'ediff-jump-to-difference) (define-key ediff-mode-map "g" nil) (define-key ediff-mode-map "ga" 'ediff-jump-to-difference-at-point) (define-key ediff-mode-map "gb" 'ediff-jump-to-difference-at-point) (define-key ediff-mode-map "q" 'ediff-quit) (define-key ediff-mode-map "D" 'ediff-show-diff-output) (define-key ediff-mode-map "z" 'ediff-suspend) (define-key ediff-mode-map "\C-l" 'ediff-recenter) (define-key ediff-mode-map "|" 'ediff-toggle-split) (define-key ediff-mode-map "h" 'ediff-toggle-hilit) (or ediff-word-mode (define-key ediff-mode-map "@" 'ediff-toggle-autorefine)) (if ediff-narrow-job (define-key ediff-mode-map "%" 'ediff-toggle-narrow-region)) (define-key ediff-mode-map "~" 'ediff-swap-buffers) (define-key ediff-mode-map "v" 'ediff-scroll-vertically) (define-key ediff-mode-map "\C-v" 'ediff-scroll-vertically) (define-key ediff-mode-map "^" 'ediff-scroll-vertically) (define-key ediff-mode-map "\M-v" 'ediff-scroll-vertically) (define-key ediff-mode-map "V" 'ediff-scroll-vertically) (define-key ediff-mode-map "<" 'ediff-scroll-horizontally) (define-key ediff-mode-map ">" 'ediff-scroll-horizontally) (define-key ediff-mode-map "i" 'ediff-status-info) (define-key ediff-mode-map "E" 'ediff-documentation) (define-key ediff-mode-map "?" 'ediff-toggle-help) (define-key ediff-mode-map "!" 'ediff-update-diffs) (define-key ediff-mode-map "M" 'ediff-show-meta-buffer) (define-key ediff-mode-map "R" 'ediff-show-registry) (or ediff-word-mode (define-key ediff-mode-map "*" 'ediff-make-or-kill-fine-diffs)) (define-key ediff-mode-map "a" nil) (define-key ediff-mode-map "b" nil) (define-key ediff-mode-map "r" nil) (cond (ediff-merge-job ;; Will barf if no ancestor (define-key ediff-mode-map "/" 'ediff-show-ancestor) ;; In merging, we allow only A->C and B->C copying. (define-key ediff-mode-map "a" (function (lambda (arg) (interactive "P") (ediff-diff-to-diff arg "ac")))) (define-key ediff-mode-map "b" (function (lambda (arg) (interactive "P") (ediff-diff-to-diff arg "bc")))) (define-key ediff-mode-map "r" (function (lambda (arg) (interactive "P") (ediff-restore-diff arg ?c)))) (define-key ediff-mode-map "s" 'ediff-shrink-window-C) (define-key ediff-mode-map "+" 'ediff-combine-diffs) (define-key ediff-mode-map "$" 'ediff-toggle-show-clashes-only) (define-key ediff-mode-map "&" 'ediff-re-merge)) (ediff-3way-comparison-job (define-key ediff-mode-map "ab" 'ediff-diff-to-diff) (define-key ediff-mode-map "ba" 'ediff-diff-to-diff) (define-key ediff-mode-map "ac" 'ediff-diff-to-diff) (define-key ediff-mode-map "bc" 'ediff-diff-to-diff) (define-key ediff-mode-map "c" nil) (define-key ediff-mode-map "ca" 'ediff-diff-to-diff) (define-key ediff-mode-map "cb" 'ediff-diff-to-diff) (define-key ediff-mode-map "ra" 'ediff-restore-diff) (define-key ediff-mode-map "rb" 'ediff-restore-diff) (define-key ediff-mode-map "rc" 'ediff-restore-diff) (define-key ediff-mode-map "C" 'ediff-toggle-read-only)) (t ; 2-way comparison (define-key ediff-mode-map "a" (function (lambda (arg) (interactive "P") (ediff-diff-to-diff arg "ab")))) (define-key ediff-mode-map "b" (function (lambda (arg) (interactive "P") (ediff-diff-to-diff arg "ba")))) (define-key ediff-mode-map "ra" 'ediff-restore-diff) (define-key ediff-mode-map "rb" 'ediff-restore-diff)) ) ; cond (define-key ediff-mode-map "G" 'ediff-submit-report) (define-key ediff-mode-map "#" nil) (define-key ediff-mode-map "#h" 'ediff-toggle-regexp-match) (define-key ediff-mode-map "#f" 'ediff-toggle-regexp-match) (or ediff-word-mode (define-key ediff-mode-map "##" 'ediff-toggle-skip-similar)) (define-key ediff-mode-map "o" nil) (define-key ediff-mode-map "A" 'ediff-toggle-read-only) (define-key ediff-mode-map "B" 'ediff-toggle-read-only) (define-key ediff-mode-map "w" nil) (define-key ediff-mode-map "wa" 'ediff-save-buffer) (define-key ediff-mode-map "wb" 'ediff-save-buffer) (define-key ediff-mode-map "wd" 'ediff-save-buffer) (if ediff-3way-job (progn (define-key ediff-mode-map "wc" 'ediff-save-buffer) (define-key ediff-mode-map "gc" 'ediff-jump-to-difference-at-point) )) (define-key ediff-mode-map "m" 'ediff-toggle-wide-display) ;; Allow ediff-mode-map to be referenced indirectly (fset 'ediff-mode-map ediff-mode-map) (run-hooks 'ediff-keymap-setup-hook)) ;;; Setup functions (require 'ediff-wind) (or (boundp 'synchronize-minibuffers) (defvar synchronize-minibuffers nil)) ;; Common startup entry for all Ediff functions ;; It now returns control buffer so other functions can do post-processing (defun ediff-setup (buffer-A file-A buffer-B file-B buffer-C file-C startup-hooks setup-parameters) (setq file-A (expand-file-name file-A)) (setq file-B (expand-file-name file-B)) (if (stringp file-C) (setq file-C (expand-file-name file-C))) (let* ((control-buffer-name (ediff-unique-buffer-name "*Ediff Control Panel" "*")) (control-buffer (ediff-eval-in-buffer buffer-A (get-buffer-create control-buffer-name)))) (ediff-eval-in-buffer control-buffer (ediff-mode) ;; unwrap set up parameters passed as argument (while setup-parameters (set (car (car setup-parameters)) (cdr (car setup-parameters))) (setq setup-parameters (cdr setup-parameters))) ;; set variables classifying the current ediff job (setq ediff-3way-comparison-job (ediff-3way-comparison-job) ediff-merge-job (ediff-merge-job) ediff-merge-with-ancestor-job (ediff-merge-with-ancestor-job) ediff-3way-job (ediff-3way-job) ediff-diff3-job (ediff-diff3-job) ediff-narrow-job (ediff-narrow-job) ediff-windows-job (ediff-windows-job) ediff-word-mode-job (ediff-word-mode-job)) (make-local-variable 'ediff-prefer-long-help-message) (make-local-variable 'ediff-prefer-iconified-control-frame) (make-local-variable 'ediff-split-window-function) (make-local-variable 'ediff-default-variant) (make-local-variable 'ediff-merge-window-share) (make-local-variable 'ediff-window-setup-function) (make-local-variable 'ediff-keep-variants) ;; Don't delete variants in case of ediff-buffer-* jobs without asking. ;; This is because u may loose work---dangerous. (if (string-match "buffer" (symbol-name ediff-job-name)) (setq ediff-keep-variants t)) ;; XEmacs has local-pre-command-hook (if ediff-emacs-p (make-local-variable 'pre-command-hook)) (if ediff-emacs-p (add-hook 'pre-command-hook 'ediff-spy-after-mouse) (add-hook 'local-pre-command-hook 'ediff-spy-after-mouse)) (setq ediff-mouse-pixel-position (mouse-pixel-position)) ;; adjust for merge jobs (if ediff-merge-job (let ((buf ;; If default variant is `combined', the right stuff is ;; inserted by ediff-do-merge ;; Note: at some point, we tried to put ancestor buffer here ;; (which is currently buffer C. This didn't work right ;; because the merge buffer will contain lossage: diff regions ;; in the ancestor, which correspond to revisions that agree ;; in both buf A and B. (cond ((eq ediff-default-variant 'default-B) buffer-B) (t buffer-A)))) (setq ediff-split-window-function ediff-merge-split-window-function) ;; remember the ancestor buffer, if any (setq ediff-ancestor-buffer buffer-C) (setq buffer-C (get-buffer-create (ediff-unique-buffer-name "*ediff-merge" "*"))) (save-excursion (set-buffer buffer-C) (insert-buffer buf) (funcall (ediff-eval-in-buffer buf major-mode)) ;; after Stig@hackvan.com (add-hook 'local-write-file-hooks 'ediff-set-merge-mode) ))) (setq buffer-read-only nil ediff-buffer-A buffer-A ediff-buffer-B buffer-B ediff-buffer-C buffer-C ediff-control-buffer control-buffer) (setq ediff-control-buffer-suffix (if (string-match "<[0-9]*>" control-buffer-name) (substring control-buffer-name (match-beginning 0) (match-end 0)) "") ediff-control-buffer-number (max 0 (1- (string-to-number (substring ediff-control-buffer-suffix (or (string-match "[0-9]+" ediff-control-buffer-suffix) 0)))))) (setq ediff-error-buffer (get-buffer-create (ediff-unique-buffer-name "*ediff-errors" "*"))) (ediff-eval-in-buffer buffer-A (ediff-strip-mode-line-format)) (ediff-eval-in-buffer buffer-B (ediff-strip-mode-line-format)) (if ediff-3way-job (ediff-eval-in-buffer buffer-C (ediff-strip-mode-line-format))) (if (ediff-buffer-live-p ediff-ancestor-buffer) (ediff-eval-in-buffer ediff-ancestor-buffer (ediff-strip-mode-line-format))) (ediff-save-protected-variables) ; save variables to be restored on exit ;; ediff-setup-diff-regions-function must be set after setup ;; parameters are processed. (setq ediff-setup-diff-regions-function (if ediff-diff3-job 'ediff-setup-diff-regions3 'ediff-setup-diff-regions)) (setq ediff-wide-bounds (list (ediff-make-bullet-proof-overlay '(point-min) '(point-max) ediff-buffer-A) (ediff-make-bullet-proof-overlay '(point-min) '(point-max) ediff-buffer-B) (ediff-make-bullet-proof-overlay '(point-min) '(point-max) ediff-buffer-C))) ;; This has effect only on ediff-windows/regions ;; In all other cases, ediff-visible-region sets visibility bounds to ;; ediff-wide-bounds, and ediff-narrow-bounds are ignored. (if ediff-start-narrowed (setq ediff-visible-bounds ediff-narrow-bounds) (setq ediff-visible-bounds ediff-wide-bounds)) (ediff-set-keys) ; comes after parameter setup ;; set up ediff-narrow-bounds, if not set (or ediff-narrow-bounds (setq ediff-narrow-bounds ediff-wide-bounds)) ;; All these must be inside ediff-eval-in-buffer control-buffer, ;; since these vars are local to control-buffer ;; These won't run if there are errors in diff (ediff-eval-in-buffer ediff-buffer-A (ediff-nuke-selective-display) (run-hooks 'ediff-prepare-buffer-hook) (if (ediff-eval-in-buffer control-buffer ediff-merge-job) (setq buffer-read-only t)) ;; add control-buffer to the list of sessions--no longer used, but may ;; be used again in the future (or (memq control-buffer ediff-this-buffer-ediff-sessions) (setq ediff-this-buffer-ediff-sessions (cons control-buffer ediff-this-buffer-ediff-sessions))) ) (ediff-eval-in-buffer ediff-buffer-B (ediff-nuke-selective-display) (run-hooks 'ediff-prepare-buffer-hook) (if (ediff-eval-in-buffer control-buffer ediff-merge-job) (setq buffer-read-only t)) ;; add control-buffer to the list of sessions (or (memq control-buffer ediff-this-buffer-ediff-sessions) (setq ediff-this-buffer-ediff-sessions (cons control-buffer ediff-this-buffer-ediff-sessions))) ) (if ediff-3way-job (ediff-eval-in-buffer ediff-buffer-C (ediff-nuke-selective-display) (run-hooks 'ediff-prepare-buffer-hook) ;; add control-buffer to the list of sessions (or (memq control-buffer ediff-this-buffer-ediff-sessions) (setq ediff-this-buffer-ediff-sessions (cons control-buffer ediff-this-buffer-ediff-sessions))) )) (if (ediff-buffer-live-p ediff-ancestor-buffer) (ediff-eval-in-buffer ediff-ancestor-buffer (ediff-nuke-selective-display) (setq buffer-read-only t) (run-hooks 'ediff-prepare-buffer-hook) (or (memq control-buffer ediff-this-buffer-ediff-sessions) (setq ediff-this-buffer-ediff-sessions (cons control-buffer ediff-this-buffer-ediff-sessions))) )) ;; must come after setting up ediff-narrow-bounds AND after ;; nuking selective display (funcall ediff-setup-diff-regions-function file-A file-B file-C) (setq ediff-number-of-differences (length ediff-difference-vector-A)) (setq ediff-current-difference -1) (ediff-make-current-diff-overlay 'A) (ediff-make-current-diff-overlay 'B) (if ediff-3way-job (ediff-make-current-diff-overlay 'C)) (if ediff-merge-with-ancestor-job (ediff-make-current-diff-overlay 'Ancestor)) (ediff-setup-windows buffer-A buffer-B buffer-C control-buffer) (let ((shift-A (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'A ediff-narrow-bounds))) (shift-B (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'B ediff-narrow-bounds))) (shift-C (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'C ediff-narrow-bounds)))) ;; position point in buf A (save-excursion (select-window ediff-window-A) (goto-char shift-A)) ;; position point in buf B (save-excursion (select-window ediff-window-B) (goto-char shift-B)) (if ediff-3way-job (save-excursion (select-window ediff-window-C) (goto-char shift-C))) ) (select-window ediff-control-window) (ediff-visible-region) (run-hooks 'startup-hooks) (ediff-refresh-mode-lines) (setq buffer-read-only t) (setq ediff-session-registry (cons control-buffer ediff-session-registry)) (ediff-update-registry) (if (ediff-buffer-live-p ediff-meta-buffer) (ediff-update-meta-buffer ediff-meta-buffer)) (run-hooks 'ediff-startup-hook) ) ; eval in control-buffer control-buffer)) ;; This function assumes that we are in the window where control buffer is ;; to reside. (defun ediff-setup-control-buffer (ctl-buf) "Set up window for control buffer." (if (window-dedicated-p (selected-window)) (set-buffer ctl-buf) ; we are in control frame but just in case (switch-to-buffer ctl-buf)) (let ((window-min-height 2)) (erase-buffer) (ediff-set-help-message) (insert ediff-help-message) (shrink-window-if-larger-than-buffer) (or (ediff-multiframe-setup-p) (ediff-indent-help-message)) (set-buffer-modified-p nil) (ediff-refresh-mode-lines) (setq ediff-control-window (selected-window)) (setq ediff-window-config-saved (format "%S%S%S%S%S%S%S" ediff-control-window ediff-window-A ediff-window-B ediff-window-C ediff-split-window-function (ediff-multiframe-setup-p) ediff-wide-display-p)) (goto-char (point-min)) (skip-chars-forward ediff-whitespace))) ;; assuming we are in control window, calculate length of the first line in ;; help message (defun ediff-help-message-line-length () (save-excursion (goto-char (point-min)) (if ediff-prefer-long-help-message (next-line 1)) (end-of-line) (current-column))) (defun ediff-indent-help-message () (let* ((shift (/ (max 0 (- (window-width (selected-window)) (ediff-help-message-line-length))) 2)) (str (make-string shift ?\ ))) (save-excursion (goto-char (point-min)) (while (< (point) (point-max)) (insert str) (beginning-of-line) (forward-line 1))))) (defun ediff-set-help-message () (setq ediff-long-help-message (cond ((and ediff-long-help-message-function (or (symbolp ediff-long-help-message-function) (consp ediff-long-help-message-function))) (funcall ediff-long-help-message-function)) (ediff-word-mode (concat ediff-long-help-message-head ediff-long-help-message-word-mode ediff-long-help-message-tail)) (ediff-narrow-job (concat ediff-long-help-message-head ediff-long-help-message-narrow2 ediff-long-help-message-tail)) (ediff-merge-job (concat ediff-long-help-message-head ediff-long-help-message-merge ediff-long-help-message-tail)) (ediff-diff3-job (concat ediff-long-help-message-head ediff-long-help-message-compare3 ediff-long-help-message-tail)) (t (concat ediff-long-help-message-head ediff-long-help-message-compare2 ediff-long-help-message-tail)))) (setq ediff-brief-help-message (cond ((and ediff-brief-help-message-function (or (symbolp ediff-brief-help-message-function) (consp ediff-brief-help-message-function))) (funcall ediff-brief-help-message-function)) ((stringp ediff-brief-help-message-function) ediff-brief-help-message-function) ((ediff-multiframe-setup-p) ediff-brief-message-string) (t ; long brief msg, not multiframe --- put in the middle ediff-brief-message-string) )) (setq ediff-help-message (if ediff-prefer-long-help-message ediff-long-help-message ediff-brief-help-message)) (run-hooks 'ediff-display-help-hook)) ;;; Commands for working with Ediff (defun ediff-update-diffs () "Recompute difference regions in buffers A, B, and C. Buffers are not synchronized with their respective files, so changes done to these buffers are not saved at this point---the user can do this later, if necessary." (interactive) (ediff-barf-if-not-control-buffer) (if (and (ediff-buffer-live-p ediff-ancestor-buffer) (not (y-or-n-p "Recompute differences during merge, really? "))) (error "God forbid!")) (let ((point-A (ediff-eval-in-buffer ediff-buffer-A (point))) ;;(point-B (ediff-eval-in-buffer ediff-buffer-B (point))) (tmp-buffer (get-buffer-create ediff-tmp-buffer)) (buf-A-file-name (file-name-nondirectory (or (buffer-file-name ediff-buffer-A) (buffer-name ediff-buffer-A) ))) (buf-B-file-name (file-name-nondirectory (or (buffer-file-name ediff-buffer-B) (buffer-name ediff-buffer-B) ))) (buf-C-file-name (file-name-nondirectory (or (buffer-file-name ediff-buffer-C) ;; if (null ediff-buffer-C), there is ;; no danger, since we later check if ;; ediff-buffer-C is alive (buffer-name ediff-buffer-C) ))) (overl-A (ediff-get-value-according-to-buffer-type 'A ediff-narrow-bounds)) (overl-B (ediff-get-value-according-to-buffer-type 'B ediff-narrow-bounds)) (overl-C (ediff-get-value-according-to-buffer-type 'C ediff-narrow-bounds)) beg-A end-A beg-B end-B beg-C end-C file-A file-B file-C) (ediff-unselect-and-select-difference -1) (setq beg-A (ediff-overlay-start overl-A) beg-B (ediff-overlay-start overl-B) beg-C (ediff-overlay-start overl-C) end-A (ediff-overlay-end overl-A) end-B (ediff-overlay-end overl-B) end-C (ediff-overlay-end overl-C)) (if ediff-word-mode (progn (ediff-wordify beg-A end-A ediff-buffer-A tmp-buffer) (setq file-A (ediff-make-temp-file tmp-buffer "regA")) (ediff-wordify beg-B end-B ediff-buffer-B tmp-buffer) (setq file-B (ediff-make-temp-file tmp-buffer "regB")) (if ediff-3way-job (progn (ediff-wordify beg-C end-C ediff-buffer-C tmp-buffer) (setq file-C (ediff-make-temp-file tmp-buffer "regC")))) ) ;; not word-mode (setq file-A (ediff-make-temp-file ediff-buffer-A buf-A-file-name)) (setq file-B (ediff-make-temp-file ediff-buffer-B buf-B-file-name)) (if ediff-3way-job (setq file-C (ediff-make-temp-file ediff-buffer-C buf-C-file-name))) ) (ediff-clear-diff-vector 'ediff-difference-vector-A 'fine-diffs-also) (ediff-clear-diff-vector 'ediff-difference-vector-B 'fine-diffs-also) (ediff-clear-diff-vector 'ediff-difference-vector-C 'fine-diffs-also) (ediff-clear-diff-vector 'ediff-difference-vector-Ancestor 'fine-diffs-also) ;; let them garbage collect. we can't use the ancestor after recomputing ;; the diffs. (setq ediff-difference-vector-Ancestor nil ediff-ancestor-buffer nil ediff-state-of-merge nil) (setq ediff-killed-diffs-alist nil) ; invalidate saved killed diff regions ;; In case of merge job, fool it into thinking that it is just doing ;; comparison (let ((ediff-setup-diff-regions-function ediff-setup-diff-regions-function) (ediff-3way-comparison-job ediff-3way-comparison-job) (ediff-merge-job ediff-merge-job) (ediff-merge-with-ancestor-job ediff-merge-with-ancestor-job) (ediff-job-name ediff-job-name)) (if ediff-merge-job (setq ediff-setup-diff-regions-function 'ediff-setup-diff-regions3 ediff-3way-comparison-job t ediff-merge-job nil ediff-merge-with-ancestor-job nil ediff-job-name 'ediff-files3)) (funcall ediff-setup-diff-regions-function file-A file-B file-C)) (setq ediff-number-of-differences (length ediff-difference-vector-A)) (delete-file file-A) (delete-file file-B) (if file-C (delete-file file-C)) (if ediff-3way-job (ediff-set-state-of-all-diffs-in-all-buffers ediff-control-buffer)) (ediff-jump-to-difference (ediff-diff-at-point 'A point-A)) (message "") )) ;; Not bound to any key---to dangerous. A user can do it if necessary. (defun ediff-revert-buffers-then-recompute-diffs (noconfirm) "Revert buffers A, B and C. Then rerun Ediff on file A and file B." (interactive "P") (ediff-barf-if-not-control-buffer) (let ((bufA ediff-buffer-A) (bufB ediff-buffer-B) (bufC ediff-buffer-C) (ctl-buf ediff-control-buffer) (keep-variants ediff-keep-variants) (ancestor-buf ediff-ancestor-buffer) (ancestor-job ediff-merge-with-ancestor-job) (merge ediff-merge-job) (comparison ediff-3way-comparison-job)) (ediff-eval-in-buffer bufA (revert-buffer t noconfirm)) (ediff-eval-in-buffer bufB (revert-buffer t noconfirm)) ;; this should only be executed in a 3way comparison, not in merge (if comparison (ediff-eval-in-buffer bufC (revert-buffer t noconfirm))) (if merge (progn (set-buffer ctl-buf) ;; the argument says whether to reverse the meaning of ;; ediff-keep-variants, i.e., ediff-really-quit runs here with ;; variants kept. (ediff-really-quit (not keep-variants)) (kill-buffer bufC) (if ancestor-job (ediff-merge-buffers-with-ancestor bufA bufB ancestor-buf) (ediff-merge-buffers bufA bufB))) (ediff-update-diffs)))) ;; optional NO-REHIGHLIGHT says to not rehighlight buffers (defun ediff-recenter (&optional no-rehighlight) "Bring the highlighted region of all buffers being compared into view. Reestablish the default three-window display." (interactive) (ediff-barf-if-not-control-buffer) ;; force all minibuffer to display ediff's messages. ;; when xemacs implements minibufferless frames, this won't be necessary (if ediff-xemacs-p (setq synchronize-minibuffers t)) (setq ediff-disturbed-overlays nil) ; clear after use (let (buffer-read-only) (if (and (ediff-buffer-live-p ediff-buffer-A) (ediff-buffer-live-p ediff-buffer-B) (or (not ediff-3way-job) (ediff-buffer-live-p ediff-buffer-C))) (ediff-setup-windows ediff-buffer-A ediff-buffer-B ediff-buffer-C ediff-control-buffer) (or (eq this-command 'ediff-quit) (message "You've killed an essential Ediff buffer---Please quit Ediff" (beep 1))) )) ;; set visibility range appropriate to this invocation of Ediff. (ediff-visible-region) ;; raise (if (and (ediff-window-display-p) (symbolp this-command) (symbolp last-command) ;; Either one of the display-changing commands (or (memq this-command '(ediff-recenter ediff-dir-action ediff-registry-action ediff-patch-action ediff-toggle-wide-display ediff-toggle-multiframe)) ;; Or one of the movement cmds and prev cmd was an Ediff cmd ;; This avoids rasing frames unnecessarily. (and (memq this-command '(ediff-next-difference ediff-previous-difference ediff-jump-to-difference ediff-jump-to-difference-at-point)) (not (string-match "^ediff-" (symbol-name last-command))) ))) (progn (if (window-live-p ediff-window-A) (raise-frame (window-frame ediff-window-A))) (if (window-live-p ediff-window-B) (raise-frame (window-frame ediff-window-B))) (if (window-live-p ediff-window-C) (raise-frame (window-frame ediff-window-C))))) (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame) (not ediff-prefer-long-help-message) (not (ediff-frame-iconified-p ediff-control-frame))) (raise-frame ediff-control-frame)) ;; Redisplay whatever buffers are showing, if there is a selected difference (let ((control-frame ediff-control-frame) (control-buf ediff-control-buffer)) (if (and (ediff-buffer-live-p ediff-buffer-A) (ediff-buffer-live-p ediff-buffer-B) (or (not ediff-3way-job) (ediff-buffer-live-p ediff-buffer-C)) ) (progn (or no-rehighlight (ediff-select-difference ediff-current-difference)) (ediff-recenter-one-window 'A) (ediff-recenter-one-window 'B) (if ediff-3way-job (ediff-recenter-one-window 'C)) (ediff-eval-in-buffer control-buf (ediff-recenter-ancestor) ; it checks if ancestor is alive (if (and (ediff-multiframe-setup-p) (not ediff-prefer-long-help-message) (not (ediff-frame-iconified-p ediff-control-frame))) ;; never grab mouse on quit in this place (ediff-reset-mouse control-frame (eq this-command 'ediff-quit)))) )) (ediff-eval-in-buffer control-buf (ediff-refresh-mode-lines)) )) ;; this function returns to the window it was called from ;; (which was the control window) (defun ediff-recenter-one-window (buf-type) (if (ediff-valid-difference-p) ;; context must be saved before switching to windows A/B/C (let* ((ctl-wind (selected-window)) (shift (ediff-overlay-start (ediff-get-value-according-to-buffer-type buf-type ediff-narrow-bounds))) (job-name ediff-job-name) (control-buf ediff-control-buffer) (window-name (intern (format "ediff-window-%S" buf-type))) (window (if (window-live-p (symbol-value window-name)) (symbol-value window-name)))) (if (and window ediff-windows-job) (set-window-start window shift)) (if window (progn (select-window window) (ediff-deactivate-mark) (ediff-position-region (ediff-get-diff-posn buf-type 'beg nil control-buf) (ediff-get-diff-posn buf-type 'end nil control-buf) (ediff-get-diff-posn buf-type 'beg nil control-buf) job-name ))) (select-window ctl-wind) ))) (defun ediff-recenter-ancestor () ;; do half-hearted job by recentering the ancestor buffer, if it is alive and ;; visible. (if (and (ediff-buffer-live-p ediff-ancestor-buffer) (ediff-valid-difference-p)) (let ((window (ediff-get-visible-buffer-window ediff-ancestor-buffer)) (ctl-wind (selected-window)) (job-name ediff-job-name) (ctl-buf ediff-control-buffer)) (ediff-eval-in-buffer ediff-ancestor-buffer (goto-char (ediff-get-diff-posn 'Ancestor 'beg nil ctl-buf)) (if window (progn (select-window window) (ediff-position-region (ediff-get-diff-posn 'Ancestor 'beg nil ctl-buf) (ediff-get-diff-posn 'Ancestor 'end nil ctl-buf) (ediff-get-diff-posn 'Ancestor 'beg nil ctl-buf) job-name)))) (select-window ctl-wind) ))) ;; This will have to be refined for 3way jobs (defun ediff-toggle-split () "Toggle vertical/horizontal window split. Does nothing if file-A and file-B are in different frames." (interactive) (ediff-barf-if-not-control-buffer) (let* ((wind-A (if (window-live-p ediff-window-A) ediff-window-A)) (wind-B (if (window-live-p ediff-window-B) ediff-window-B)) (wind-C (if (window-live-p ediff-window-C) ediff-window-C)) (frame-A (if wind-A (window-frame wind-A))) (frame-B (if wind-B (window-frame wind-B))) (frame-C (if wind-C (window-frame wind-C)))) (if (or (eq frame-A frame-B) (not (frame-live-p frame-A)) (not (frame-live-p frame-B)) (if ediff-3way-comparison-job (or (not (frame-live-p frame-C)) (eq frame-A frame-C) (eq frame-B frame-C)))) (setq ediff-split-window-function (if (eq ediff-split-window-function 'split-window-vertically) 'split-window-horizontally 'split-window-vertically)) (message "Buffers being compared are in different frames")) (ediff-recenter 'no-rehighlight))) (defun ediff-toggle-hilit () "Switch between highlighting using ASCII flags and highlighting using faces. On a dumb terminal, switches between ASCII highlighting and no highlighting." (interactive) (ediff-barf-if-not-control-buffer) (if (not (ediff-window-display-p)) (if (eq ediff-highlighting-style 'ascii) (progn (message "ASCII highlighting flags removed") (ediff-unselect-and-select-difference ediff-current-difference 'unselect-only) (setq ediff-highlighting-style 'off)) (ediff-unselect-and-select-difference ediff-current-difference 'select-only)) (ediff-unselect-and-select-difference ediff-current-difference 'unselect-only) ;; cycle through highlighting (cond ((and ediff-use-faces ediff-highlight-all-diffs) (message "Unhighlighting unselected difference regions") (setq ediff-highlight-all-diffs nil)) (ediff-use-faces (message "Highlighting with ASCII flags") (setq ediff-use-faces nil)) (t (message "Re-highlighting all difference regions") (setq ediff-use-faces t ediff-highlight-all-diffs t))) (if (and ediff-use-faces ediff-highlight-all-diffs) (ediff-color-background-regions) (ediff-color-background-regions 'unhighlight)) (ediff-unselect-and-select-difference ediff-current-difference 'select-only)) ) (defun ediff-toggle-autorefine () "Toggle auto-refine mode." (interactive) (ediff-barf-if-not-control-buffer) (if ediff-word-mode (error "No fine differences in this mode")) (cond ((eq ediff-auto-refine 'nix) (setq ediff-auto-refine 'on) (ediff-make-fine-diffs ediff-current-difference 'noforce) (message "Auto-refining is ON")) ((eq ediff-auto-refine 'on) (message "Auto-refining is OFF") (setq ediff-auto-refine 'off)) (t ;; nix 'em (ediff-set-fine-diff-properties ediff-current-difference 'default) (message "Refinements are HIDDEN") (setq ediff-auto-refine 'nix)) )) (defun ediff-show-ancestor () "Show the ancestor buffer in a suitable window." (interactive) (ediff-recenter) (or (ediff-buffer-live-p ediff-ancestor-buffer) (if ediff-merge-with-ancestor-job (error "Lost connection to ancestor buffer...sorry") (error "Not merging with ancestor"))) (let (wind) (cond ((setq wind (ediff-get-visible-buffer-window ediff-ancestor-buffer)) (raise-frame (window-frame wind))) (t (set-window-buffer ediff-window-C ediff-ancestor-buffer))))) (defun ediff-make-or-kill-fine-diffs (arg) "Compute fine diffs. With negative prefix arg, kill fine diffs. In both cases, operates on the currrent difference region." (interactive "P") (ediff-barf-if-not-control-buffer) (cond ((eq arg '-) (ediff-clear-fine-differences ediff-current-difference)) ((and (numberp arg) (< arg 0)) (ediff-clear-fine-differences ediff-current-difference)) (t (ediff-make-fine-diffs)))) (defun ediff-toggle-help () "Toggle short/long help message." (interactive) (ediff-barf-if-not-control-buffer) (let (buffer-read-only) (erase-buffer) (setq ediff-prefer-long-help-message (not ediff-prefer-long-help-message)) (ediff-set-help-message)) ;; remember the icon status of the control frame when the user requested ;; full control message (if (and ediff-prefer-long-help-message (ediff-multiframe-setup-p)) (setq ediff-prefer-iconified-control-frame (ediff-frame-iconified-p ediff-control-frame))) (setq ediff-window-config-saved "") ; force redisplay (ediff-recenter 'no-rehighlight)) ;; If BUF, this is the buffer to toggle, not current buffer. (defun ediff-toggle-read-only (&optional buf) "Toggle read-only in current buffer. If buffer is under version control and locked, check it out first. If optional argument BUF is specified, toggle read-only in that buffer instead of the current buffer." (interactive) (ediff-barf-if-not-control-buffer) (let ((ctl-buf (if (null buf) (current-buffer)))) (or buf (ediff-recenter)) (or buf (setq buf (ediff-get-buffer (ediff-char-to-buftype last-command-char)))) (ediff-eval-in-buffer buf ; eval in buf A/B/C (let* ((file (buffer-file-name buf)) (file-writable (and file (file-exists-p file) (file-writable-p file))) (toggle-ro-cmd (cond (ediff-toggle-read-only-function) ((ediff-file-checked-out-p file) 'toggle-read-only) (file-writable 'toggle-read-only) (t (key-binding "\C-x\C-q"))))) ;; If the file is checked in, make sure we don't make buffer modifiable ;; without warning the user. The user can fool our checks by making the ;; buffer non-RO without checking the file out. We regard this as a ;; user problem. (if (and (ediff-file-checked-in-p file) ;; If ctl-buf is null, this means we called this ;; non-interactively, in which case don't ask questions ctl-buf) (cond ((not buffer-read-only) (setq toggle-ro-cmd 'toggle-read-only)) ((and (or (beep 1) t) ; always beep (y-or-n-p (format "File %s is under version control. Check it out? " (ediff-abbreviate-file-name file)))) ;; if we checked the file out, we should also change the ;; original state of buffer-read-only to nil. If we don't ;; do this, the mode line will show %%, since the file was ;; RO before ediff started, so the user will think the file ;; is checked in. (ediff-eval-in-buffer ctl-buf (ediff-change-saved-variable 'buffer-read-only nil (ediff-char-to-buftype last-command-char)))) (t (setq toggle-ro-cmd 'toggle-read-only) (beep 1) (beep 1) (message "Boy, this is risky! Better don't change this file...") (sit-for 3)))) ; let the user see the warning (if (and toggle-ro-cmd (string-match "toggle-read-only" (symbol-name toggle-ro-cmd))) (save-excursion (save-window-excursion (command-execute toggle-ro-cmd))) (error "Don't know how to toggle read-only in buffer %S" buf)) ;; Check if we made the current buffer updatable, but its file is RO. ;; Signal a warning in this case. (if (and file (not buffer-read-only) (eq this-command 'ediff-toggle-read-only) (file-exists-p file) (not (file-writable-p file))) (message "Warning: file %s is read-only" (ediff-abbreviate-file-name file) (beep 1))) )))) ;; This is a simple-minded check for whether a file is under version control ;; and is checked out. ;; If file,v exists but file doesn't, this file is considered to be not checked ;; in and not checked out for the purpose of patching (since patch won't be ;; able to read such a file anyway). ;; FILE is a string representing file name (defsubst ediff-file-checked-out-p (file) (and (stringp file) (file-exists-p file) (file-writable-p file) (file-exists-p (concat file ",v")))) (defsubst ediff-file-checked-in-p (file) (and (stringp file) (file-exists-p file) (not (file-writable-p file)) (file-exists-p (concat file ",v")))) (defun ediff-swap-buffers () "Rotate the display of buffers A, B, and C." (interactive) (ediff-barf-if-not-control-buffer) (if (and (window-live-p ediff-window-A) (window-live-p ediff-window-B)) (let ((buf ediff-buffer-A) (values ediff-buffer-values-orig-A) (diff-vec ediff-difference-vector-A) (hide-regexp ediff-regexp-hide-A) (focus-regexp ediff-regexp-focus-A) (wide-visibility-p (eq ediff-visible-bounds ediff-wide-bounds)) (overlay (if (ediff-window-display-p) ediff-current-diff-overlay-A))) (if ediff-3way-comparison-job (progn (set-window-buffer ediff-window-A ediff-buffer-C) (set-window-buffer ediff-window-B ediff-buffer-A) (set-window-buffer ediff-window-C ediff-buffer-B) ) (set-window-buffer ediff-window-A ediff-buffer-B) (set-window-buffer ediff-window-B ediff-buffer-A)) ;; swap diff buffers (if ediff-3way-comparison-job (setq ediff-buffer-A ediff-buffer-C ediff-buffer-C ediff-buffer-B ediff-buffer-B buf) (setq ediff-buffer-A ediff-buffer-B ediff-buffer-B buf)) ;; swap saved buffer characteristics (if ediff-3way-comparison-job (setq ediff-buffer-values-orig-A ediff-buffer-values-orig-C ediff-buffer-values-orig-C ediff-buffer-values-orig-B ediff-buffer-values-orig-B values) (setq ediff-buffer-values-orig-A ediff-buffer-values-orig-B ediff-buffer-values-orig-B values)) ;; swap diff vectors (if ediff-3way-comparison-job (setq ediff-difference-vector-A ediff-difference-vector-C ediff-difference-vector-C ediff-difference-vector-B ediff-difference-vector-B diff-vec) (setq ediff-difference-vector-A ediff-difference-vector-B ediff-difference-vector-B diff-vec)) ;; swap hide/focus regexp (if ediff-3way-comparison-job (setq ediff-regexp-hide-A ediff-regexp-hide-C ediff-regexp-hide-C ediff-regexp-hide-B ediff-regexp-hide-B hide-regexp ediff-regexp-focus-A ediff-regexp-focus-C ediff-regexp-focus-C ediff-regexp-focus-B ediff-regexp-focus-B focus-regexp) (setq ediff-regexp-hide-A ediff-regexp-hide-B ediff-regexp-hide-B hide-regexp ediff-regexp-focus-A ediff-regexp-focus-B ediff-regexp-focus-B focus-regexp)) ;; The following is needed for XEmacs, since there one can't move ;; overlay to another buffer. In Emacs, this swap is redundant. (if (ediff-window-display-p) (if ediff-3way-comparison-job (setq ediff-current-diff-overlay-A ediff-current-diff-overlay-C ediff-current-diff-overlay-C ediff-current-diff-overlay-B ediff-current-diff-overlay-B overlay) (setq ediff-current-diff-overlay-A ediff-current-diff-overlay-B ediff-current-diff-overlay-B overlay))) ;; swap wide bounds (setq ediff-wide-bounds (cond (ediff-3way-comparison-job (list (nth 2 ediff-wide-bounds) (nth 0 ediff-wide-bounds) (nth 1 ediff-wide-bounds))) (ediff-3way-job (list (nth 1 ediff-wide-bounds) (nth 0 ediff-wide-bounds) (nth 2 ediff-wide-bounds))) (t (list (nth 1 ediff-wide-bounds) (nth 0 ediff-wide-bounds))))) ;; swap narrow bounds (setq ediff-narrow-bounds (cond (ediff-3way-comparison-job (list (nth 2 ediff-narrow-bounds) (nth 0 ediff-narrow-bounds) (nth 1 ediff-narrow-bounds))) (ediff-3way-job (list (nth 1 ediff-narrow-bounds) (nth 0 ediff-narrow-bounds) (nth 2 ediff-narrow-bounds))) (t (list (nth 1 ediff-narrow-bounds) (nth 0 ediff-narrow-bounds))))) (if wide-visibility-p (setq ediff-visible-bounds ediff-wide-bounds) (setq ediff-visible-bounds ediff-narrow-bounds)) )) (if ediff-3way-job (ediff-set-state-of-all-diffs-in-all-buffers ediff-control-buffer)) (ediff-recenter 'no-rehighlight) ) (defun ediff-toggle-wide-display () "Toggle wide/regular display. This is especially useful when comparing buffers side-by-side." (interactive) (ediff-barf-if-not-control-buffer) (or (ediff-window-display-p) (error "%sEmacs is not running as a window application" (if ediff-emacs-p "" "X"))) (ediff-recenter 'no-rehighlight) ; make sure buffs are displayed in windows (let ((ctl-buf ediff-control-buffer)) (setq ediff-wide-display-p (not ediff-wide-display-p)) (if (not ediff-wide-display-p) (ediff-eval-in-buffer ctl-buf (modify-frame-parameters ediff-wide-display-frame ediff-wide-display-orig-parameters) ;;(sit-for (if ediff-xemacs-p 0.4 0)) ;; restore control buf, since ctl window may have been deleted ;; during resizing (set-buffer ctl-buf) (setq ediff-wide-display-orig-parameters nil ediff-window-B nil) ; force update of window config (ediff-recenter 'no-rehighlight)) (funcall ediff-make-wide-display-function) ;;(sit-for (if ediff-xemacs-p 0.4 0)) (ediff-eval-in-buffer ctl-buf (setq ediff-window-B nil) ; force update of window config (ediff-recenter 'no-rehighlight))))) (defun ediff-toggle-multiframe () "Switch from the multiframe display to single-frame display and back. This is primarily for debugging, but one can use it for fun, too." (interactive) (ediff-barf-if-not-control-buffer) (or (ediff-window-display-p) (error "%sEmacs is not running as a window application" (if ediff-emacs-p "" "X"))) (cond ((eq ediff-window-setup-function 'ediff-setup-windows-multiframe) (setq ediff-window-setup-function 'ediff-setup-windows-plain)) ((eq ediff-window-setup-function 'ediff-setup-windows-plain) (setq ediff-window-setup-function 'ediff-setup-windows-multiframe))) (setq ediff-window-B nil) (ediff-recenter 'no-rehighlight)) ;; Merging (defun ediff-toggle-show-clashes-only () "Toggle the mode where only the regions where both buffers differ with the ancestor are shown." (interactive) (ediff-barf-if-not-control-buffer) (if (not ediff-merge-with-ancestor-job) (error "This command makes sense only when merging with an ancestor")) (setq ediff-show-clashes-only (not ediff-show-clashes-only)) (if ediff-show-clashes-only (message "Focus on regions where both buffers differ from the ancestor") (message "Canceling focus on regions where changes clash"))) ;; Widening/narrowing (defun ediff-toggle-narrow-region () "Toggle narrowing in buffers A, B, and C. Used in ediff-windows/regions only." (interactive) (if (eq ediff-buffer-A ediff-buffer-B) (error "Buffers A and B are the same. Can't narrow to two different regions")) (if (eq ediff-visible-bounds ediff-wide-bounds) (setq ediff-visible-bounds ediff-narrow-bounds) (setq ediff-visible-bounds ediff-wide-bounds)) (ediff-recenter 'no-rehighlight)) ;; Narrow bufs A/B/C to ediff-visible-bounds. If this is currently set to ;; ediff-wide-bounds, then this actually widens. ;; This function does nothing if job-name is not ;; ediff-regions-wordwise/linewise or ediff-windows-wordwise/linewise. ;; Does nothing if buffer-A = buffer-B since we can't narrow ;; to two different regions in one buffer. (defun ediff-visible-region () (if (or (eq ediff-buffer-A ediff-buffer-B) (eq ediff-buffer-A ediff-buffer-C) (eq ediff-buffer-C ediff-buffer-B)) () ;; If ediff-*-regions/windows, ediff-visible-bounds is already set ;; Otherwise, always use full range. (if (not ediff-narrow-job) (setq ediff-visible-bounds ediff-wide-bounds)) (let ((overl-A (ediff-get-value-according-to-buffer-type 'A ediff-visible-bounds)) (overl-B (ediff-get-value-according-to-buffer-type 'B ediff-visible-bounds)) (overl-C (ediff-get-value-according-to-buffer-type 'C ediff-visible-bounds)) ) (ediff-eval-in-buffer ediff-buffer-A (narrow-to-region (ediff-overlay-start overl-A) (ediff-overlay-end overl-A))) (ediff-eval-in-buffer ediff-buffer-B (narrow-to-region (ediff-overlay-start overl-B) (ediff-overlay-end overl-B))) (if ediff-3way-job (ediff-eval-in-buffer ediff-buffer-C (narrow-to-region (ediff-overlay-start overl-C) (ediff-overlay-end overl-C)))) ))) ;; Window scrolling operations ;; Performs some operation on the two file windows (if they are showing). ;; Traps all errors on the operation in windows A/B/C. ;; Usually, errors come from scrolling off the ;; beginning or end of the buffer, and this gives error messages. (defun ediff-operate-on-windows (operation arg) ;; make sure windows aren't dead (if (not (and (window-live-p ediff-window-A) (window-live-p ediff-window-B))) (ediff-recenter 'no-rehighlight)) (if (not (and (ediff-buffer-live-p ediff-buffer-A) (ediff-buffer-live-p ediff-buffer-B) (or (not ediff-3way-job) ediff-buffer-C) )) (error "You've killed an essential Ediff buffer---Please quit Ediff")) (let* ((wind (selected-window)) (wind-A ediff-window-A) (wind-B ediff-window-B) (wind-C ediff-window-C) (coefA (ediff-get-region-size-coefficient 'A operation)) (coefB (ediff-get-region-size-coefficient 'B operation)) (three-way ediff-3way-job) (coefC (if three-way (ediff-get-region-size-coefficient 'C operation)))) (select-window wind-A) (condition-case nil (funcall operation (round (* coefA arg))) (error)) (select-window wind-B) (condition-case nil (funcall operation (round (* coefB arg))) (error)) (if three-way (progn (select-window wind-C) (condition-case nil (funcall operation (round (* coefC arg))) (error)))) (select-window wind))) (defun ediff-scroll-vertically (&optional arg) "Vertically scroll buffers A, B \(and C if appropriate\). With optional argument ARG, scroll ARG lines; otherwise scroll by nearly the height of window-A." (interactive "P") (ediff-barf-if-not-control-buffer) ;; make sure windows aren't dead (if (not (and (window-live-p ediff-window-A) (window-live-p ediff-window-B))) (ediff-recenter 'no-rehighlight)) (if (not (and (ediff-buffer-live-p ediff-buffer-A) (ediff-buffer-live-p ediff-buffer-B) (or (not ediff-3way-job) (ediff-buffer-live-p ediff-buffer-C)) )) (error "You've killed an essential Ediff buffer---Please quit Ediff")) (ediff-operate-on-windows (if (memq last-command-char '(?v ?\C-v)) 'scroll-up 'scroll-down) ;; calculate argument to scroll-up/down ;; if there is an explicit argument (if (and arg (not (equal arg '-))) ;; use it (prefix-numeric-value arg) ;; if not, see if we can determine a default amount (the window height) (let (default-amount) (setq default-amount (- (/ (min (window-height ediff-window-A) (window-height ediff-window-B) (if ediff-3way-job (window-height ediff-window-C) 500)) ; some large number 2) 1 next-screen-context-lines)) ;; window found (if arg ;; C-u as argument means half of default amount (/ default-amount 2) ;; no argument means default amount default-amount))))) (defun ediff-scroll-horizontally (&optional arg) "Horizontally scroll buffers A, B \(and C if appropriate\). If an argument is given, that is how many columns are scrolled, else nearly the width of the A/B/C windows." (interactive "P") (ediff-barf-if-not-control-buffer) ;; make sure windows aren't dead (if (not (and (window-live-p ediff-window-A) (window-live-p ediff-window-B))) (ediff-recenter 'no-rehighlight)) (if (not (and (ediff-buffer-live-p ediff-buffer-A) (ediff-buffer-live-p ediff-buffer-B) (or (not ediff-3way-job) (ediff-buffer-live-p ediff-buffer-C)) )) (error "You've killed an essential Ediff buffer---Please quit Ediff")) (ediff-operate-on-windows (if (= last-command-char ?<) 'scroll-left 'scroll-right) ;; calculate argument to scroll-left/right ;; if there is an explicit argument (if (and arg (not (equal arg '-))) ;; use it (prefix-numeric-value arg) ;; if not, see if we can determine a default amount ;; (half the window width) (if (null ediff-control-window) ;; no control window, use nil nil (let ((default-amount (- (/ (min (window-width ediff-window-A) (window-width ediff-window-B) (if ediff-3way-comparison-job (window-width ediff-window-C) 500) ; some large number ) 2) 3))) ;; window found (if arg ;; C-u as argument means half of default amount (/ default-amount 2) ;; no argument means default amount default-amount)))))) ;;BEG, END show the region to be positioned. ;;JOB-NAME holds ediff-job-name. Ediff-windows job positions regions ;;differently. (defun ediff-position-region (beg end pos job-name) (if (> end (point-max)) (setq end (point-max))) (if ediff-windows-job (if (pos-visible-in-window-p end) () ; do nothing, wind is already positioned ;; at this point, windows are positioned at the beginning of the ;; file regions (not diff-regions) being compared. (save-excursion (move-to-window-line (- (window-height) 2)) (let ((amount (+ 2 (count-lines (point) end)))) (scroll-up amount)))) (set-window-start (selected-window) beg) (if (pos-visible-in-window-p end) ;; Determine the number of lines that the region occupies (let ((lines 0) (prev-point 0)) (while ( and (> end (progn (move-to-window-line lines) (point))) ;; `end' may be beyond the window bottom, so check ;; that we are making progres (< prev-point (point))) (setq prev-point (point)) (setq lines (1+ lines))) ;; And position the beginning on the right line (goto-char beg) (recenter (/ (1+ (max (- (1- (window-height (selected-window))) lines) 1) ) 2)))) (goto-char pos) )) ;; get number of lines from window start to region end (defun ediff-get-lines-to-region-end (buf-type &optional n ctl-buf) (or n (setq n ediff-current-difference)) (or ctl-buf (setq ctl-buf ediff-control-buffer)) (ediff-eval-in-buffer ctl-buf (let* ((buf (ediff-get-buffer buf-type)) (wind (eval (intern (format "ediff-window-%S" buf-type)))) (beg (window-start wind)) (end (ediff-get-diff-posn buf-type 'end)) lines) (ediff-eval-in-buffer buf (if (< beg end) (setq lines (count-lines beg end)) (setq lines 0)) lines )))) ;; get number of lines from window end to region start (defun ediff-get-lines-to-region-start (buf-type &optional n ctl-buf) (or n (setq n ediff-current-difference)) (or ctl-buf (setq ctl-buf ediff-control-buffer)) (ediff-eval-in-buffer ctl-buf (let* ((buf (ediff-get-buffer buf-type)) (wind (eval (intern (format "ediff-window-%S" buf-type)))) (end (window-end wind)) (beg (ediff-get-diff-posn buf-type 'beg))) (ediff-eval-in-buffer buf (if (< beg end) (count-lines beg end) 0)) ))) (defun ediff-get-region-size-coefficient (buf-type op &optional n ctl-buf) (ediff-eval-in-buffer (or ctl-buf ediff-control-buffer) (let* ((func (cond ((eq op 'scroll-down) 'ediff-get-lines-to-region-start) ((eq op 'scroll-up) 'ediff-get-lines-to-region-end) (t '(lambda (a b c) 0)))) (max-lines (max (funcall func 'A n ctl-buf) (funcall func 'B n ctl-buf) (if (ediff-buffer-live-p ediff-buffer-C) (funcall func 'C n ctl-buf) 0)))) ;; this covers the horizontal coefficient as well: ;; if max-lines = 0 then coef = 1 (if (> max-lines 0) (/ (+ (funcall func buf-type n ctl-buf) 0.0) (+ max-lines 0.0)) 1) ))) (defun ediff-next-difference (&optional arg) "Advance to the next difference. With a prefix argument, go back that many differences." (interactive "P") (ediff-barf-if-not-control-buffer) (if (< ediff-current-difference ediff-number-of-differences) (let ((n (min ediff-number-of-differences (+ ediff-current-difference (if arg arg 1)))) regexp-skip) (or (>= n ediff-number-of-differences) (setq regexp-skip (funcall ediff-skip-diff-region-function n)) (ediff-install-fine-diff-if-necessary n)) (while (and (< n ediff-number-of-differences) (or ;; regexp skip regexp-skip ;; skip clashes, if necessary (and ediff-show-clashes-only (string-match "prefer" (or (ediff-get-state-of-merge n) ""))) ;; skip difference regions that differ in white space (and ediff-ignore-similar-regions (ediff-no-fine-diffs-p n)))) (setq n (1+ n)) (if (= 0 (mod n 20)) (message "Skipped over region %d and counting ..." n)) (or (>= n ediff-number-of-differences) (setq regexp-skip (funcall ediff-skip-diff-region-function n)) (ediff-install-fine-diff-if-necessary n)) ) (message "") (ediff-unselect-and-select-difference n) ) ; let (ediff-visible-region) (error "At end of the difference list"))) (defun ediff-previous-difference (&optional arg) "Go to the previous difference. With a prefix argument, go back that many differences." (interactive "P") (ediff-barf-if-not-control-buffer) (if (> ediff-current-difference -1) (let ((n (max -1 (- ediff-current-difference (if arg arg 1)))) regexp-skip) (or (< n 0) (setq regexp-skip (funcall ediff-skip-diff-region-function n)) (ediff-install-fine-diff-if-necessary n)) (while (and (> n -1) (or ;; regexp skip regexp-skip ;; skip clashes, if necessary (and ediff-show-clashes-only (string-match "prefer" (or (ediff-get-state-of-merge n) ""))) ;; skip difference regions that differ in white space (and ediff-ignore-similar-regions (ediff-no-fine-diffs-p n)))) (if (= 0 (mod (1+ n) 20)) (message "Skipped over region %d and counting ..." (1+ n))) (setq n (1- n)) (or (< n 0) (setq regexp-skip (funcall ediff-skip-diff-region-function n)) (ediff-install-fine-diff-if-necessary n)) ) (message "") (ediff-unselect-and-select-difference n) ) ; let (ediff-visible-region) (error "At beginning of the difference list"))) (defun ediff-jump-to-difference (difference-number) "Go to the difference specified as a prefix argument." (interactive "p") (ediff-barf-if-not-control-buffer) (setq difference-number (1- difference-number)) (if (and (>= difference-number -1) (< difference-number (1+ ediff-number-of-differences))) (ediff-unselect-and-select-difference difference-number) (error "Bad difference number, %d" difference-number))) (defun ediff-jump-to-difference-at-point () "Go to difference closest to the point in buffer A, B, or C. The type of buffer depends on last command character \(a, b, or c\) that invoked this command." (interactive) (ediff-barf-if-not-control-buffer) (let ((buf-type (ediff-char-to-buftype last-command-char))) (ediff-jump-to-difference (ediff-diff-at-point buf-type)))) ;; find region most related to the current point position (or POS, if given) (defun ediff-diff-at-point (buf-type &optional pos) (let ((buffer (ediff-get-buffer buf-type)) (ctl-buffer ediff-control-buffer) (max-dif-num (1- ediff-number-of-differences)) (diff-no -1) (prev-beg 0) (prev-end 0) (beg 0) (end 0)) (ediff-eval-in-buffer buffer (setq pos (or pos (point))) (while (and (or (< pos prev-beg) (> pos beg)) (< diff-no max-dif-num)) (setq diff-no (1+ diff-no)) (setq prev-beg beg prev-end end) (setq beg (ediff-get-diff-posn buf-type 'beg diff-no ctl-buffer) end (ediff-get-diff-posn buf-type 'end diff-no ctl-buffer)) ) (if (< (abs (- pos prev-end)) (abs (- pos beg))) diff-no (1+ diff-no)) ; jump-to-diff works with diff nums higher by 1 ))) ;;; Copying diffs. (defun ediff-diff-to-diff (arg &optional keys) "Copy buffer-X'th diff to buffer Y \(X,Y are A, B, or C\). If numerical prefix argument, copy this diff specified in the arg. Otherwise, copy the difference given by `ediff-current-difference'. This command assumes it is bound to a 2-character key sequence, `ab', `ba', `ac', etc., which is used to determine the types of buffers to be used for copying difference regions. The first character in the sequence specifies the source buffer and the second specifies the target. If the second optional argument, a 2-character string, is given, use it to determine the source and the target buffers instead of the command keys." (interactive "P") (ediff-barf-if-not-control-buffer) (or keys (setq keys (this-command-keys))) (if arg (ediff-jump-to-difference arg)) (let* ((key1 (aref keys 0)) (key2 (aref keys 1)) (char1 (if (and ediff-xemacs-p (eventp key1)) (event-key key1) key1)) (char2 (if (and ediff-xemacs-p (eventp key1)) (event-key key2) key2)) ediff-verbose-p) (ediff-copy-diff ediff-current-difference (ediff-char-to-buftype char1) (ediff-char-to-buftype char2)) ;; recenter with rehighlighting, but no messages (ediff-recenter))) ;; Copy diff N from FROM-BUF-TYPE \(given as A, B or C\) to TO-BUF-TYPE. ;; If optional DO-NOT-SAVE is non-nil, do not save the old value of the ;; target diff. This is used in merging, when constructing the merged ;; version. (defun ediff-copy-diff (n from-buf-type to-buf-type &optional batch-invocation reg-to-copy) (let* ((to-buf (ediff-get-buffer to-buf-type)) ;;(from-buf (if (not reg-to-copy) (ediff-get-buffer from-buf-type))) (ctrl-buf ediff-control-buffer) (saved-p t) (three-way ediff-3way-job) messg ediff-verbose-p reg-to-delete reg-to-delete-beg reg-to-delete-end) (setq reg-to-delete-beg (ediff-get-diff-posn to-buf-type 'beg n ctrl-buf)) (setq reg-to-delete-end (ediff-get-diff-posn to-buf-type 'end n ctrl-buf)) (if reg-to-copy (setq from-buf-type nil) (setq reg-to-copy (ediff-get-region-contents n from-buf-type ctrl-buf))) (setq reg-to-delete (ediff-get-region-contents n to-buf-type ctrl-buf reg-to-delete-beg reg-to-delete-end)) (setq ediff-disturbed-overlays nil) ; clear before use (if (string= reg-to-delete reg-to-copy) (setq saved-p nil) ; refuse to copy identical buffers ;; seems ok to copy (if (or batch-invocation (ediff-test-save-region n to-buf-type)) (condition-case conds (progn (ediff-eval-in-buffer to-buf ;; to prevent flags from interfering if buffer is writable (let ((inhibit-read-only (null buffer-read-only))) ;; these two insert a dummy char to overcome a bug in ;; XEmacs, which sometimes prevents 0-length extents ;; from sensing insertion at its end-points. ;; (need to check if 19.12 still has the bug) (if ediff-xemacs-p (progn (goto-char reg-to-delete-end) (insert-before-markers "@"))) (goto-char reg-to-delete-end) (insert-before-markers reg-to-copy) ;; delete the dummy char "@" (if ediff-xemacs-p (delete-char 1)) (if ediff-xemacs-p (if (> reg-to-delete-end reg-to-delete-beg) (kill-region reg-to-delete-beg reg-to-delete-end)) (if (> reg-to-delete-end reg-to-delete-beg) (kill-region reg-to-delete-beg reg-to-delete-end) (ediff-move-disturbed-overlays reg-to-delete-beg) )) )) (or batch-invocation (setq messg (ediff-save-diff-region n to-buf-type reg-to-delete)))) (error (message "ediff-copy-diff: %s %s" (car conds) (mapconcat 'prin1-to-string (cdr conds) " ")) (beep 1) (sit-for 2) ; let the user see the error msg (setq saved-p nil) ))) ) ;; adjust state of difference in case 3-way and diff was copied ok (if (and saved-p three-way) (ediff-set-state-of-diff-in-all-buffers n ctrl-buf)) (if batch-invocation (ediff-clear-fine-differences n) ;; If diff3 job, we should recompute fine diffs so we clear them ;; before reinserting flags (and thus before ediff-recenter). (if (and saved-p three-way) (ediff-clear-fine-differences n)) (ediff-refresh-mode-lines) ;; For diff2 jobs, don't recompute fine diffs, since we know there ;; aren't any. So we clear diffs after ediff-recenter. (if (and saved-p (not three-way)) (ediff-clear-fine-differences n)) ;; Make sure that the message about saving and how to restore is seen ;; by the user (message messg)) )) ;; Save Nth diff of buffer BUF-TYPE \(A, B, or C\). ;; That is to say, the Nth diff on the `ediff-killed-diffs-alist'. REG ;; is the region to save. It is redundant here, but is passed anyway, for ;; convenience. (defun ediff-save-diff-region (n buf-type reg) (let* ((n-th-diff-saved (assoc n ediff-killed-diffs-alist)) (buf (ediff-get-buffer buf-type)) (this-buf-n-th-diff-saved (assoc buf (cdr n-th-diff-saved)))) (if this-buf-n-th-diff-saved ;; either nothing saved for n-th diff and buffer or we OK'ed ;; overriding (setcdr this-buf-n-th-diff-saved reg) (if n-th-diff-saved ;; n-th diff saved, but for another buffer (nconc n-th-diff-saved (list (cons buf reg))) (setq ediff-killed-diffs-alist ;; create record for n-th diff (cons (list n (cons buf reg)) ediff-killed-diffs-alist)))) (message "Saving old diff region #%d of buffer %S. To recover, type `r%s'" (1+ n) buf-type (if ediff-merge-job "" (downcase (symbol-name buf-type)))) )) ;; Test if saving Nth difference region of buffer BUF-TYPE is possible. (defun ediff-test-save-region (n buf-type) (let* ((n-th-diff-saved (assoc n ediff-killed-diffs-alist)) (buf (ediff-get-buffer buf-type)) (this-buf-n-th-diff-saved (assoc buf (cdr n-th-diff-saved)))) (if this-buf-n-th-diff-saved (if (yes-or-no-p (format "You've previously copied diff region %d to buffer %S. Confirm " (1+ n) buf-type)) t (error "Quit")) t))) (defun ediff-pop-diff (n buf-type) "Pop last killed Nth diff region from buffer BUF-TYPE." (let* ((n-th-record (assoc n ediff-killed-diffs-alist)) (buf (ediff-get-buffer buf-type)) (saved-rec (assoc buf (cdr n-th-record))) (three-way ediff-3way-job) (ctl-buf ediff-control-buffer) ediff-verbose-p saved-diff reg-beg reg-end recovered) (if (cdr saved-rec) (setq saved-diff (cdr saved-rec)) (if (> ediff-number-of-differences 0) (error "Nothing saved for diff %d in buffer %S" (1+ n) buf-type) (error "No differences found"))) (setq reg-beg (ediff-get-diff-posn buf-type 'beg n ediff-control-buffer)) (setq reg-end (ediff-get-diff-posn buf-type 'end n ediff-control-buffer)) (setq ediff-disturbed-overlays nil) ; clear before use (condition-case conds (ediff-eval-in-buffer buf (let ((inhibit-read-only (null buffer-read-only))) ;; these two insert a dummy char to overcome a bug in XEmacs, ;; which sometimes prevents 0-length extents from sensing ;; insertion at its end-points. ;; (need to check if 19.12 still has the bug) (if ediff-xemacs-p (progn (goto-char reg-end) (insert-before-markers "@"))) (goto-char reg-end) (insert-before-markers saved-diff) ;; delete dummy char (if ediff-xemacs-p (delete-char 1)) (if ediff-xemacs-p (if (> reg-end reg-beg) (kill-region reg-beg reg-end)) (if (> reg-end reg-beg) (kill-region reg-beg reg-end) (ediff-move-disturbed-overlays reg-beg) )) (setq recovered t) )) (error (message "ediff-pop-diff: %s %s" (car conds) (mapconcat 'prin1-to-string (cdr conds) " ")) (beep 1))) ;; Clearing fine diffs is necessary for ;; ediff-unselect-and-select-difference to properly recompute them. We ;; can't rely on ediff-copy-diff to clear this vector, as the user might ;; have modified diff regions after copying and, thus, may have recomputed ;; fine diffs. (if recovered (ediff-clear-fine-differences n)) ;; adjust state of difference (if (and three-way recovered) (ediff-set-state-of-diff-in-all-buffers n ctl-buf)) (ediff-refresh-mode-lines) (if recovered (progn (setq n-th-record (delq saved-rec n-th-record)) (message "Diff region %d in buffer %S restored" (1+ n) buf-type) )) )) (defun ediff-restore-diff (arg &optional key) "Restore ARGth diff from `ediff-killed-diffs-alist'. ARG is a prefix argument. If ARG is nil, restore current-difference. If the second optional argument, a character, is given, use it to determine the target buffer instead of last-command-char" (interactive "P") (ediff-barf-if-not-control-buffer) (if arg (ediff-jump-to-difference arg)) (ediff-pop-diff ediff-current-difference (ediff-char-to-buftype (or key last-command-char))) ;; recenter with rehighlighting, but no messages (let (ediff-verbose-p) (ediff-recenter))) (defun ediff-toggle-regexp-match () "Toggle between focusing and hiding of difference regions that match a regular expression typed in by the user." (interactive) (ediff-barf-if-not-control-buffer) (let ((regexp-A "") (regexp-B "") (regexp-C "") msg-connective alt-msg-connective alt-connective) (cond ((or (and (eq ediff-skip-diff-region-function 'ediff-focus-on-regexp-matches-function) (eq last-command-char ?f)) (and (eq ediff-skip-diff-region-function ediff-hide-regexp-matches-function) (eq last-command-char ?h))) (message "Selective browsing by regexp turned off") (setq ediff-skip-diff-region-function 'ediff-show-all-diffs)) ((eq last-command-char ?h) (setq ediff-skip-diff-region-function ediff-hide-regexp-matches-function regexp-A (read-string (format "Ignore A-regions matching this regexp (default \"%s\"): " ediff-regexp-hide-A)) regexp-B (read-string (format "Ignore B-regions matching this regexp (default \"%s\"): " ediff-regexp-hide-B))) (if ediff-3way-comparison-job (setq regexp-C (read-string (format "Ignore C-regions matching this regexp (default \"%s\"): " ediff-regexp-hide-C)))) (if (eq ediff-hide-regexp-connective 'and) (setq msg-connective "BOTH" alt-msg-connective "ONE OF" alt-connective 'or) (setq msg-connective "ONE OF" alt-msg-connective "BOTH" alt-connective 'and)) (if (y-or-n-p (format "Ignore regions that match %s regexps, OK? " msg-connective alt-msg-connective)) (message "Will ignore regions that match %s regexps" msg-connective) (setq ediff-hide-regexp-connective alt-connective) (message "Will ignore regions that match %s regexps" alt-msg-connective)) (or (string= regexp-A "") (setq ediff-regexp-hide-A regexp-A)) (or (string= regexp-B "") (setq ediff-regexp-hide-B regexp-B)) (or (string= regexp-C "") (setq ediff-regexp-hide-C regexp-C))) ((eq last-command-char ?f) (setq ediff-skip-diff-region-function ediff-focus-on-regexp-matches-function regexp-A (read-string (format "Focus on A-regions matching this regexp (default \"%s\"): " ediff-regexp-focus-A)) regexp-B (read-string (format "Focus on B-regions matching this regexp (default \"%s\"): " ediff-regexp-focus-B))) (if ediff-3way-comparison-job (setq regexp-C (read-string (format "Focus on C-regions matching this regexp (default \"%s\"): " ediff-regexp-focus-C)))) (if (eq ediff-focus-regexp-connective 'and) (setq msg-connective "BOTH" alt-msg-connective "ONE OF" alt-connective 'or) (setq msg-connective "ONE OF" alt-msg-connective "BOTH" alt-connective 'and)) (if (y-or-n-p (format "Focus on regions that match %s regexps, OK? " msg-connective alt-msg-connective)) (message "Will focus on regions that match %s regexps" msg-connective) (setq ediff-focus-regexp-connective alt-connective) (message "Will focus on regions that match %s regexps" alt-msg-connective)) (or (string= regexp-A "") (setq ediff-regexp-focus-A regexp-A)) (or (string= regexp-B "") (setq ediff-regexp-focus-B regexp-B)) (or (string= regexp-C "") (setq ediff-regexp-focus-C regexp-C)))))) (defun ediff-toggle-skip-similar () (interactive) (ediff-barf-if-not-control-buffer) (if (not (eq ediff-auto-refine 'on)) (error "Can't skip over whitespace regions: first turn auto-refining on")) (setq ediff-ignore-similar-regions (not ediff-ignore-similar-regions)) (if ediff-ignore-similar-regions (message "Skipping regions that differ only in white space & line breaks") (message "Skipping over white-space differences turned off"))) (defun ediff-focus-on-regexp-matches (n) "Focus on diffs that match regexp `ediff-regexp-focus-A/B'. Regions to be ignored according to this function are those where buf A region doesn't match `ediff-regexp-focus-A' and buf B region doesn't match `ediff-regexp-focus-B'. This function returns nil if the region number N (specified as an argument) is not to be ignored and t if region N is to be ignored. N is a region number used by Ediff internally. It is 1 less the number seen by the user." (if (ediff-valid-difference-p n) (let* ((ctl-buf ediff-control-buffer) (regex-A ediff-regexp-focus-A) (regex-B ediff-regexp-focus-B) (regex-C ediff-regexp-focus-C) (reg-A-match (ediff-eval-in-buffer ediff-buffer-A (goto-char (ediff-get-diff-posn 'A 'beg n ctl-buf)) (re-search-forward regex-A (ediff-get-diff-posn 'A 'end n ctl-buf) t))) (reg-B-match (ediff-eval-in-buffer ediff-buffer-B (goto-char (ediff-get-diff-posn 'B 'beg n ctl-buf)) (re-search-forward regex-B (ediff-get-diff-posn 'B 'end n ctl-buf) t))) (reg-C-match (if ediff-3way-comparison-job (ediff-eval-in-buffer ediff-buffer-C (goto-char (ediff-get-diff-posn 'C 'beg n ctl-buf)) (re-search-forward regex-C (ediff-get-diff-posn 'C 'end n ctl-buf) t))))) (not (eval (if ediff-3way-comparison-job (list ediff-focus-regexp-connective reg-A-match reg-B-match reg-C-match) (list ediff-focus-regexp-connective reg-A-match reg-B-match)))) ))) (defun ediff-hide-regexp-matches (n) "Hide diffs that match regexp `ediff-regexp-hide-A/B/C'. Regions to be ignored are those where buf A region matches `ediff-regexp-hide-A' and buf B region matches `ediff-regexp-hide-B'. This function returns nil if the region number N (specified as an argument) is not to be ignored and t if region N is to be ignored. N is a region number used by Ediff internally. It is 1 less the number seen by the user." (if (ediff-valid-difference-p n) (let* ((ctl-buf ediff-control-buffer) (regex-A ediff-regexp-hide-A) (regex-B ediff-regexp-hide-B) (regex-C ediff-regexp-hide-C) (reg-A-match (ediff-eval-in-buffer ediff-buffer-A (goto-char (ediff-get-diff-posn 'A 'beg n ctl-buf)) (re-search-forward regex-A (ediff-get-diff-posn 'A 'end n ctl-buf) t))) (reg-B-match (ediff-eval-in-buffer ediff-buffer-B (goto-char (ediff-get-diff-posn 'B 'beg n ctl-buf)) (re-search-forward regex-B (ediff-get-diff-posn 'B 'end n ctl-buf) t))) (reg-C-match (if ediff-3way-comparison-job (ediff-eval-in-buffer ediff-buffer-C (goto-char (ediff-get-diff-posn 'C 'beg n ctl-buf)) (re-search-forward regex-C (ediff-get-diff-posn 'C 'end n ctl-buf) t))))) (eval (if ediff-3way-comparison-job (list ediff-hide-regexp-connective reg-A-match reg-B-match reg-C-match) (list ediff-hide-regexp-connective reg-A-match reg-B-match))) ))) ;;; Quitting, suspending, etc. (defun ediff-quit (reverse-default-keep-variants) "Finish an Ediff session and exit Ediff. Unselects the selected difference, if any, restores the read-only and modified flags of the compared file buffers, kills Ediff buffers for this session \(but not buffers A, B, C\). If `ediff-keep-variants' is nil, the user will be asked whether the buffers containing the variants should be removed \(if they haven't been modified\). If it is t, they will be preserved unconditionally. A prefix argument, temporarily reverses the meaning of this variable." (interactive "P") (ediff-barf-if-not-control-buffer) (if (prog1 (y-or-n-p (format "Quit this Ediff session%s? " (if (ediff-buffer-live-p ediff-meta-buffer) " & show containing session group" ""))) (message "")) (ediff-really-quit reverse-default-keep-variants))) ;; Perform the quit operations. (defun ediff-really-quit (reverse-default-keep-variants) (ediff-unhighlight-diffs-totally) (ediff-clear-diff-vector 'ediff-difference-vector-A 'fine-diffs-also) (ediff-clear-diff-vector 'ediff-difference-vector-B 'fine-diffs-also) (ediff-clear-diff-vector 'ediff-difference-vector-C 'fine-diffs-also) (ediff-clear-diff-vector 'ediff-difference-vector-Ancestor 'fine-diffs-also) (ediff-delete-temp-files) ;; Restore visibility range. This affects only ediff-*-regions/windows. ;; Since for other job names ediff-visible-region sets ;; ediff-visible-bounds to ediff-wide-bounds, the settings below are ;; ignored for such jobs. (if ediff-quit-widened (setq ediff-visible-bounds ediff-wide-bounds) (setq ediff-visible-bounds ediff-narrow-bounds)) ;; Apply selective display to narrow or widen (ediff-visible-region) (mapcar (function (lambda (overl) (if (ediff-overlayp overl) (ediff-delete-overlay overl)))) ediff-wide-bounds) (mapcar (function (lambda (overl) (if (ediff-overlayp overl) (ediff-delete-overlay overl)))) ediff-narrow-bounds) ;; restore buffer mode line id's in buffer-A/B/C (let ((control-buffer ediff-control-buffer) (meta-buffer ediff-meta-buffer)) (condition-case nil (ediff-eval-in-buffer ediff-buffer-A (setq ediff-this-buffer-ediff-sessions (delq control-buffer ediff-this-buffer-ediff-sessions)) (kill-local-variable 'mode-line-buffer-identification) (kill-local-variable 'mode-line-format) ) (error)) (condition-case nil (ediff-eval-in-buffer ediff-buffer-B (setq ediff-this-buffer-ediff-sessions (delq control-buffer ediff-this-buffer-ediff-sessions)) (kill-local-variable 'mode-line-buffer-identification) (kill-local-variable 'mode-line-format) ) (error)) (condition-case nil (ediff-eval-in-buffer ediff-buffer-C (setq ediff-this-buffer-ediff-sessions (delq control-buffer ediff-this-buffer-ediff-sessions)) (kill-local-variable 'mode-line-buffer-identification) (kill-local-variable 'mode-line-format) ) (error)) (condition-case nil (ediff-eval-in-buffer ediff-ancestor-buffer (setq ediff-this-buffer-ediff-sessions (delq control-buffer ediff-this-buffer-ediff-sessions)) (kill-local-variable 'mode-line-buffer-identification) (kill-local-variable 'mode-line-format) ) (error)) (setq ediff-session-registry (delq ediff-control-buffer ediff-session-registry)) (ediff-update-registry) ;; restore state of buffers to what it was before ediff (ediff-restore-protected-variables) ;; good place to kill buffers A/B/C (run-hooks 'ediff-cleanup-hook) (let ((ediff-keep-variants ediff-keep-variants)) (if reverse-default-keep-variants (setq ediff-keep-variants (not ediff-keep-variants))) (or ediff-keep-variants (ediff-janitor 'ask))) (run-hooks 'ediff-quit-hook) (ediff-cleanup-meta-buffer meta-buffer) (if (ediff-buffer-live-p meta-buffer) (ediff-show-meta-buffer meta-buffer)) )) (defun ediff-delete-temp-files () (if (stringp ediff-temp-file-A) (delete-file ediff-temp-file-A)) (if (stringp ediff-temp-file-B) (delete-file ediff-temp-file-B)) (if (stringp ediff-temp-file-C) (delete-file ediff-temp-file-C))) ;; Kill control buffer, other auxiliary Ediff buffers. ;; Leave one of the frames split between buffers A/B/C (defun ediff-cleanup-mess () (let ((buff-A ediff-buffer-A) (buff-B ediff-buffer-B) (buff-C ediff-buffer-C) (ctl-buf ediff-control-buffer) (ctl-frame ediff-control-frame) (three-way-job ediff-3way-job)) (ediff-kill-buffer-carefully ediff-diff-buffer) (ediff-kill-buffer-carefully ediff-custom-diff-buffer) (ediff-kill-buffer-carefully ediff-fine-diff-buffer) (ediff-kill-buffer-carefully ediff-tmp-buffer) (ediff-kill-buffer-carefully ediff-error-buffer) (ediff-kill-buffer-carefully ediff-patch-diagnostics) (ediff-kill-buffer-carefully ediff-msg-buffer) (ediff-kill-buffer-carefully ediff-debug-buffer) ;;(redraw-display) (if (and (ediff-window-display-p) (frame-live-p ctl-frame)) (delete-frame ctl-frame)) (ediff-kill-buffer-carefully ctl-buf) (delete-other-windows) ;; display only if not visible (condition-case nil (or (ediff-get-visible-buffer-window buff-B) (switch-to-buffer buff-B)) (error)) (condition-case nil (or (ediff-get-visible-buffer-window buff-A) (progn (if (ediff-get-visible-buffer-window buff-B) (split-window-vertically)) (switch-to-buffer buff-A))) (error)) (if three-way-job (condition-case nil (or (ediff-get-visible-buffer-window buff-C) (progn (if (or (ediff-get-visible-buffer-window buff-A) (ediff-get-visible-buffer-window buff-B)) (split-window-vertically)) (switch-to-buffer buff-C) (balance-windows))) (error))) (message "") )) (defun ediff-janitor (&optional ask) "Kill buffers A, B, and, possibly, C, if these buffers aren't modified. In merge jobs, buffer C is never deleted. However, the side effect of cleaning up may be that you cannot compare the same buffer in two separate Ediff sessions: quitting one of them will delete this buffer in another session as well." (or (not (ediff-buffer-live-p ediff-buffer-A)) (buffer-modified-p ediff-buffer-A) (and ask (not (y-or-n-p (format "Kill buffer A [%s]? " (buffer-name ediff-buffer-A))))) (ediff-kill-buffer-carefully ediff-buffer-A)) (or (not (ediff-buffer-live-p ediff-buffer-B)) (buffer-modified-p ediff-buffer-B) (and ask (not (y-or-n-p (format "Kill buffer B [%s]? " (buffer-name ediff-buffer-B))))) (ediff-kill-buffer-carefully ediff-buffer-B)) (if ediff-merge-job ; don't del buf C if merging--del ancestor buf instead (or (not (ediff-buffer-live-p ediff-ancestor-buffer)) (buffer-modified-p ediff-ancestor-buffer) (and ask (not (y-or-n-p (format "Kill the ancestor buffer [%s]? " (buffer-name ediff-ancestor-buffer))))) (ediff-kill-buffer-carefully ediff-ancestor-buffer)) (or (not (ediff-buffer-live-p ediff-buffer-C)) (buffer-modified-p ediff-buffer-C) (and ask (not (y-or-n-p (format "Kill buffer C [%s]? " (buffer-name ediff-buffer-C))))) (ediff-kill-buffer-carefully ediff-buffer-C)))) ;; The default way of suspending Ediff. ;; Buries Ediff buffers, kills all windows. (defun ediff-default-suspend-function () (let* ((buf-A ediff-buffer-A) (buf-B ediff-buffer-B) (buf-C ediff-buffer-C) (buf-A-wind (ediff-get-visible-buffer-window buf-A)) (buf-B-wind (ediff-get-visible-buffer-window buf-B)) (buf-C-wind (ediff-get-visible-buffer-window buf-C)) (buf-patch ediff-patch-buf) (buf-patch-diag ediff-patch-diagnostics) (buf-err ediff-error-buffer) (buf-diff ediff-diff-buffer) (buf-custom-diff ediff-custom-diff-buffer) (buf-fine-diff ediff-fine-diff-buffer)) ;; hide the control panel (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame)) (iconify-frame ediff-control-frame) (bury-buffer)) (if buf-err (bury-buffer buf-err)) (if buf-diff (bury-buffer buf-diff)) (if buf-custom-diff (bury-buffer buf-custom-diff)) (if buf-fine-diff (bury-buffer buf-fine-diff)) (if buf-patch (bury-buffer buf-patch)) (if buf-patch-diag (bury-buffer buf-patch-diag)) (if (window-live-p buf-A-wind) (progn (select-window buf-A-wind) (delete-other-windows) (bury-buffer)) (if (ediff-buffer-live-p buf-A) (bury-buffer buf-A))) (if (window-live-p buf-B-wind) (progn (select-window buf-B-wind) (delete-other-windows) (bury-buffer)) (if (ediff-buffer-live-p buf-B) (bury-buffer buf-B))) (if (window-live-p buf-C-wind) (progn (select-window buf-C-wind) (delete-other-windows) (bury-buffer)) (if (ediff-buffer-live-p buf-C) (bury-buffer buf-C))) )) (defun ediff-suspend () "Suspend Ediff. To resume, switch to the appropriate `Ediff Control Panel' buffer and then type \\[ediff-recenter]. Ediff will automatically set up an appropriate window config." (interactive) (ediff-barf-if-not-control-buffer) (run-hooks 'ediff-suspend-hook) (message "To resume, type M-x eregistry and select the desired Ediff session")) (defun ediff-status-info () "Show the names of the buffers or files being operated on by Ediff. Hit \\[ediff-recenter] to reset the windows afterward." (interactive) (ediff-barf-if-not-control-buffer) (save-excursion (ediff-skip-unsuitable-frames)) (with-output-to-temp-buffer " *ediff-info*" (princ (ediff-version)) (princ "\n\n") (ediff-eval-in-buffer ediff-buffer-A (if buffer-file-name (princ (format "File A = %S\n" buffer-file-name)) (princ (format "Buffer A = %S\n" (buffer-name))))) (ediff-eval-in-buffer ediff-buffer-B (if buffer-file-name (princ (format "File B = %S\n" buffer-file-name)) (princ (format "Buffer B = %S\n" (buffer-name))))) (if ediff-3way-job (ediff-eval-in-buffer ediff-buffer-C (if buffer-file-name (princ (format "File C = %S\n" buffer-file-name)) (princ (format "Buffer C = %S\n" (buffer-name)))))) (princ (format "Customized diff output %s\n" (if (ediff-buffer-live-p ediff-custom-diff-buffer) (concat "\tin buffer " (buffer-name ediff-custom-diff-buffer)) "is not available"))) (princ (format "Plain diff output %s\n" (if (ediff-buffer-live-p ediff-diff-buffer) (concat "\tin buffer " (buffer-name ediff-diff-buffer)) "is not available"))) (let* ((A-line (ediff-eval-in-buffer ediff-buffer-A (1+ (count-lines (point-min) (point))))) (B-line (ediff-eval-in-buffer ediff-buffer-B (1+ (count-lines (point-min) (point))))) C-line) (princ (format "\Buffer A's point is on line %d\n" A-line)) (princ (format "Buffer B's point is on line %d\n" B-line)) (if ediff-3way-job (progn (setq C-line (ediff-eval-in-buffer ediff-buffer-C (1+ (count-lines (point-min) (point))))) (princ (format "Buffer C's point is on line %d\n" C-line))))) (princ (format "\nCurrent difference number = %S\n" (cond ((< ediff-current-difference 0) 'start) ((>= ediff-current-difference ediff-number-of-differences) 'end) (t (1+ ediff-current-difference))))) (cond (ediff-ignore-similar-regions (princ "\nSkipping regions that differ only in white space & line breaks")) (t (princ "\nNot skipping regions that differ in white space & line breaks"))) (cond ((eq ediff-skip-diff-region-function 'ediff-show-all-diffs) (princ "\nSelective browsing by regexp is off.\n")) ((eq ediff-skip-diff-region-function ediff-hide-regexp-matches-function) (princ "\nIgnoring regions that match") (princ (format "\n\t regexp `%s' in buffer A %S\n\t regexp `%s' in buffer B\n" ediff-regexp-hide-A ediff-hide-regexp-connective ediff-regexp-hide-B))) ((eq ediff-skip-diff-region-function ediff-focus-on-regexp-matches-function) (princ "\nFocusing on regions that match") (princ (format "\n\t regexp `%s' in buffer A %S\n\t regexp `%s' in buffer B\n" ediff-regexp-focus-A ediff-focus-regexp-connective ediff-regexp-focus-B))) (t (princ "\nSelective browsing via a user-defined method.\n"))) (princ (format "\nBugs/suggestions: type `%s' while in Ediff Control Panel." (substitute-command-keys "\\[ediff-submit-report]"))) ) ; with output (if (frame-live-p ediff-control-frame) (ediff-reset-mouse ediff-control-frame)) (if (window-live-p ediff-control-window) (select-window ediff-control-window))) (defun ediff-documentation () "Jump to Ediff's Info file." (interactive) (let ((ctl-window ediff-control-window) (ctl-buf ediff-control-buffer)) (ediff-skip-unsuitable-frames) (condition-case nil (progn (pop-to-buffer (get-buffer-create "*info*")) (info "ediff.info") (message "Type `i' to search for a specific topic")) (error (beep 1) (with-output-to-temp-buffer " *ediff-info*" (princ (format " The Info file for Ediff does not seem to be installed. This file is part of the distribution of %sEmacs. Please contact your system administrator. " (if ediff-xemacs-p "X" "")))) (if (window-live-p ctl-window) (progn (select-window ctl-window) (set-window-buffer ctl-window ctl-buf))))))) ;;; Support routines ;; Select a difference by placing the ASCII flags around the appropriate ;; group of lines in the A, B buffers ;; This may have to be modified for buffer C, when it will be supported. (defun ediff-select-difference (n) (if (and (ediff-buffer-live-p ediff-buffer-A) (ediff-buffer-live-p ediff-buffer-B) (ediff-valid-difference-p n)) (progn (if (and (ediff-window-display-p) ediff-use-faces) (progn (ediff-highlight-diff n) (setq ediff-highlighting-style 'face)) (setq ediff-highlighting-style 'ascii) (ediff-place-flags-in-buffer 'A ediff-buffer-A ediff-control-buffer n) (ediff-place-flags-in-buffer 'B ediff-buffer-B ediff-control-buffer n) (if ediff-3way-job (ediff-place-flags-in-buffer 'C ediff-buffer-C ediff-control-buffer n)) (if (ediff-buffer-live-p ediff-ancestor-buffer) (ediff-place-flags-in-buffer 'Ancestor ediff-ancestor-buffer ediff-control-buffer n)) ) (ediff-install-fine-diff-if-necessary n) (run-hooks 'ediff-select-hook)))) ;; Unselect a difference by removing the ASCII flags in the buffers. ;; This may have to be modified for buffer C, when it will be supported. (defun ediff-unselect-difference (n) (if (ediff-valid-difference-p n) (progn (cond ((and (ediff-window-display-p) ediff-use-faces) (ediff-unhighlight-diff)) ((eq ediff-highlighting-style 'ascii) (ediff-remove-flags-from-buffer ediff-buffer-A (ediff-get-diff-overlay n 'A)) (ediff-remove-flags-from-buffer ediff-buffer-B (ediff-get-diff-overlay n 'B)) (if ediff-3way-job (ediff-remove-flags-from-buffer ediff-buffer-C (ediff-get-diff-overlay n 'C))) (if (ediff-buffer-live-p ediff-ancestor-buffer) (ediff-remove-flags-from-buffer ediff-ancestor-buffer (ediff-get-diff-overlay n 'Ancestor))) )) (setq ediff-highlighting-style nil) ;; unhighlight fine diffs (ediff-set-fine-diff-properties ediff-current-difference 'default) (run-hooks 'ediff-unselect-hook)))) ;; Unselects prev diff and selects a new one, if FLAG has value other than ;; 'select-only or 'unselect-only. If FLAG is 'select-only, the ;; next difference is selected, but the current selection is not ;; unselected. If FLAG is 'unselect-only then the current selection is ;; unselected, but the next one is not selected. If NO-RECENTER is non-nil, ;; don't recenter buffers after selecting/unselecting. (defun ediff-unselect-and-select-difference (n &optional flag no-recenter) (let ((ediff-current-difference n)) (or no-recenter (ediff-recenter 'no-rehighlight))) (let ((control-buf ediff-control-buffer)) (unwind-protect (progn (or (eq flag 'select-only) (ediff-unselect-difference ediff-current-difference)) (or (eq flag 'unselect-only) (ediff-select-difference n)) (setq ediff-current-difference n) ) ; end protected section (ediff-eval-in-buffer control-buf (ediff-refresh-mode-lines)) ))) (defun ediff-read-file-name (prompt default-dir default-file) ; This is a modified version of a similar function in `emerge.el'. ; PROMPT should not have trailing ': ', so that it can be modified ; according to context. ; If default-file is set, it should be used as the default value. ; If default-dir is non-nil, use it as the default directory. ; Otherwise, use the value of Emacs' variable `default-directory.' ;; hack default-dir if it is not set (setq default-dir (file-name-as-directory (ediff-abbreviate-file-name (expand-file-name (or default-dir (and default-file (file-name-directory default-file)) default-directory))))) ;; strip the directory from default-file (if default-file (setq default-file (file-name-nondirectory default-file))) (if (string= default-file "") (setq default-file nil)) (let (f) (setq f (expand-file-name (read-file-name (format "%s%s: " prompt (if default-file (concat " (default " default-file ")") "")) default-dir default-file t ; must match, no-confirm (if default-file (file-name-directory default-file)) ) default-dir )) ;; If user enters a directory name, expand the default file in that ;; directory. This allows the user to enter a directory name for the ;; B-file and diff against the default-file in that directory instead ;; of a DIRED listing! (if (and (file-directory-p f) default-file) (setq f (expand-file-name (file-name-nondirectory default-file) f))) f)) ;; If `prefix' is given, then it is used as a prefix for the temp file ;; name. Otherwise, `ediff_' is used. If `file' is given, use this ;; file and don't create a new one. ;; Also, save buffer from START to END in the file. ;; START defaults to (point-min), END to (point-max) (defun ediff-make-temp-file (buff &optional prefix given-file start end) (let ((f (or given-file (make-temp-name (concat ediff-temp-file-prefix (if prefix (concat prefix "_") "ediff_")))))) ;; create the file (ediff-eval-in-buffer buff (write-region (if start start (point-min)) (if end end (point-max)) f nil ; don't append---erase 'no-message) (set-file-modes f ediff-temp-file-mode) f))) ;; Quote metacharacters (using \) when executing diff in Unix, but not in ;; EMX OS/2 ;;(defun ediff-protect-metachars (str) ;; (or (memq system-type '(emx vax-vms axp-vms)) ;; (let ((limit 0)) ;; (while (string-match ediff-metachars str limit) ;; (setq str (concat (substring str 0 (match-beginning 0)) ;; "\\" ;; (substring str (match-beginning 0)))) ;; (setq limit (1+ (match-end 0)))))) ;; str) ;; Make sure the current buffer (for a file) has the same contents as the ;; file on disk, and attempt to remedy the situation if not. ;; Signal an error if we can't make them the same, or the user doesn't want ;; to do what is necessary to make them the same. ;; If file has file handlers (indicated by the optional arg), then we ;; offer to instead of saving. This is one difference with Emerge. ;; Another is that we always offer to revert obsolete files, whether they ;; are modified or not. (defun ediff-verify-file-buffer (&optional file-magic) ;; First check if the file has been modified since the buffer visited it. (if (verify-visited-file-modtime (current-buffer)) (if (buffer-modified-p) ;; If buffer is not obsolete and is modified, offer to save (if (yes-or-no-p (format "Buffer out of sync with visited file. %s file %s? " (if file-magic "Revert" "Save") buffer-file-name)) (if (not file-magic) (save-buffer) ;; for some reason, file-name-handlers append instead of ;; replacing, so we have to erase first. (erase-buffer) (revert-buffer t t)) (error "Buffer out of sync for file %s" buffer-file-name)) ;; If buffer is not obsolete and is not modified, do nothing nil) ;; If buffer is obsolete, offer to revert (if (yes-or-no-p (format "Buffer out of sync with visited file. Revert file %s? " buffer-file-name)) (progn (if file-magic (erase-buffer)) (revert-buffer t t)) (error "Buffer out of sync for file %s" buffer-file-name)))) ;; It would be nice to use these two functions as hooks instead of ;; ediff-insert-in-front and ediff-move-disturbed-overlays. ;; However, Emacs has a bug that causes BEG and END, below, to be ;; the same, i.e., the end of inserted text is not passed correctly. ;; Since the overlay doesn't move when these hooks run, ;; there is no way to correctly determine the new (desired) position of ;; the overlay end. ;; Either this bug is fixed, or (better) use sticky overlays when they will ;; be implemented in Emacs, like they are in XEmacs. ;;(defun ediff-capture-inserts-in-front (overl flag beg end &optional len) ;; (if (and flag (ediff-overlay-get overl 'ediff-diff-num)) ;; (ediff-move-overlay overl beg (ediff-overlay-end overl)) ;; )) ;; ;;(defun ediff-capture-inserts-behind (overl flag beg end &optional len) ;; (if (and flag (ediff-overlay-get overl 'ediff-diff-num)) ;; (ediff-move-overlay overl (ediff-overlay-start overl) (point)) ;; )) ;; to be deleted in due time ;; Capture overlays that had insertions in the front. ;; Called when overlay OVERL gets insertion in front. (defun ediff-insert-in-front (overl &optional flag beg end length) (if (ediff-overlay-get overl 'ediff-diff-num) (setq ediff-disturbed-overlays (cons overl ediff-disturbed-overlays)))) ;; to be deleted in due time ;; We can't move overlays directly in insert-in-front-hooks ;; because when diff is highlighted with ascii flags, they will disturb ;; overlays and so they will be included in them, which we don't want. (defun ediff-move-disturbed-overlays (posn) (mapcar (function (lambda (overl) (ediff-move-overlay overl posn (ediff-overlay-end overl)) )) ediff-disturbed-overlays) (setq ediff-disturbed-overlays nil)) (defun ediff-save-buffer (arg) "Safe way of saving buffers A, B, C, and the diff output. `wa' saves buffer A, `wb' saves buffer B, `wc' saves buffer C, and `wd' saves the diff output. With prefix argument, `wd' saves plain diff output. Without an argument, it saves customized diff argument, if available \(and plain output, if customized output was not generated\)." (interactive "P") (ediff-barf-if-not-control-buffer) (ediff-compute-custom-diffs-maybe) (ediff-eval-in-buffer (cond ((memq last-command-char '(?a ?b ?c)) (ediff-get-buffer (ediff-char-to-buftype last-command-char))) ((eq last-command-char ?d) (message "Saving diff output ...") (sit-for 1) ; let the user see the message (cond ((and arg (ediff-buffer-live-p ediff-diff-buffer)) ediff-diff-buffer) ((ediff-buffer-live-p ediff-custom-diff-buffer) ediff-custom-diff-buffer) ((ediff-buffer-live-p ediff-diff-buffer) ediff-diff-buffer) (t (error "Output from `diff' not found")))) ) (save-buffer))) (defun ediff-compute-custom-diffs-maybe () (or ediff-3way-job (let ((file-A (ediff-make-temp-file ediff-buffer-A)) (file-B (ediff-make-temp-file ediff-buffer-B))) (or (ediff-buffer-live-p ediff-custom-diff-buffer) (setq ediff-custom-diff-buffer (get-buffer-create (ediff-unique-buffer-name "*ediff-custom-diff" "*")))) (ediff-exec-process ediff-custom-diff-program ediff-custom-diff-buffer 'synchronize ediff-custom-diff-options file-A file-B)))) (defun ediff-show-diff-output (arg) (interactive "P") (ediff-barf-if-not-control-buffer) (ediff-compute-custom-diffs-maybe) (save-excursion (ediff-skip-unsuitable-frames ' ok-unsplittable)) (let ((buf (cond ((and arg (ediff-buffer-live-p ediff-diff-buffer)) ediff-diff-buffer) ((ediff-buffer-live-p ediff-custom-diff-buffer) ediff-custom-diff-buffer) ((ediff-buffer-live-p ediff-diff-buffer) ediff-diff-buffer) (t (beep) (message "Output from `diff' not found") nil)))) (if buf (progn (ediff-eval-in-buffer buf (goto-char (point-min))) (switch-to-buffer buf) (raise-frame (selected-frame))))) (if (frame-live-p ediff-control-frame) (ediff-reset-mouse ediff-control-frame)) (if (window-live-p ediff-control-window) (select-window ediff-control-window))) ;; will simplify it in due time, when emacs acquires before/after strings (defun ediff-remove-flags-from-buffer (buffer overlay) (ediff-eval-in-buffer buffer (let ((inhibit-read-only t)) (if ediff-xemacs-p (ediff-overlay-put overlay 'begin-glyph nil) ;; before-string is not yet implemented in emacs. ;; when it will be, I will be able to delete much of the rest of ;; this function (ediff-overlay-put overlay 'before-string nil)) (if ediff-xemacs-p (ediff-overlay-put overlay 'end-glyph nil) ;; after-string is not yet implemented in emacs. (ediff-overlay-put overlay 'after-string nil)) ))) ;; will simplify it in due time, when emacs acquires before/after strings (defun ediff-place-flags-in-buffer (buf-type buffer ctl-buffer diff) (ediff-eval-in-buffer buffer (ediff-place-flags-in-buffer1 buf-type ctl-buffer diff))) (defun ediff-place-flags-in-buffer1 (buf-type ctl-buffer diff-no) (let* ((curr-overl (ediff-eval-in-buffer ctl-buffer (ediff-get-diff-overlay diff-no buf-type))) (before (ediff-get-diff-posn buf-type 'beg diff-no ctl-buffer)) after beg-of-line flag) ;; insert flag before the difference (goto-char before) (setq beg-of-line (bolp)) (setq flag (ediff-eval-in-buffer ctl-buffer (if (eq ediff-highlighting-style 'ascii) (if beg-of-line ediff-before-flag-bol ediff-before-flag-mol)))) ;; insert the flag itself (if ediff-xemacs-p (ediff-overlay-put curr-overl 'begin-glyph flag) (ediff-overlay-put curr-overl 'before-string flag)) ;; insert the flag after the difference ;; `after' must be set here, after the before-flag was inserted (setq after (ediff-get-diff-posn buf-type 'end diff-no ctl-buffer)) (goto-char after) (setq beg-of-line (bolp)) (setq flag (ediff-eval-in-buffer ctl-buffer (if (eq ediff-highlighting-style 'ascii) (if beg-of-line ediff-after-flag-eol ediff-after-flag-mol)))) ;; insert the flag itself (if ediff-xemacs-p (ediff-overlay-put curr-overl 'end-glyph flag) (ediff-overlay-put curr-overl 'after-string flag)) )) (defun ediff-get-diff-posn (buf-type pos &optional n control-buf) "Returns positions of difference sectors in the BUF-TYPE buffer. BUF-TYPE should be a symbol--either `A' or `B'. POS is either `beg' or `end'--it specifies whether you want the position at the beginning of a difference or at the end. The optional argument N says which difference \(default: `ediff-current-difference'\). The optional argument CONTROL-BUF says which control buffer is in effect in case it is not the current buffer." (let (diff-overlay) (or control-buf (setq control-buf (current-buffer))) (ediff-eval-in-buffer control-buf (or n (setq n ediff-current-difference)) (if (or (< n 0) (>= n ediff-number-of-differences)) (if (> ediff-number-of-differences 0) (error "There is no diff %d. Valid diffs are 1 to %d" (1+ n) ediff-number-of-differences) (error "No differences found"))) (setq diff-overlay (ediff-get-diff-overlay n buf-type))) (if (not (ediff-buffer-live-p (ediff-overlay-buffer diff-overlay))) (error "You have killed an essential Ediff buffer---Please exit Ediff")) (if (eq pos 'beg) (ediff-overlay-start diff-overlay) (ediff-overlay-end diff-overlay)) )) (defun ediff-highlight-diff-in-one-buffer (n buf-type) (if (ediff-buffer-live-p (ediff-get-buffer buf-type)) (let* ((buff (ediff-get-buffer buf-type)) (last (ediff-eval-in-buffer buff (point-max))) (begin (ediff-get-diff-posn buf-type 'beg n)) (end (ediff-get-diff-posn buf-type 'end n)) (xtra (if (equal begin end) 1 0)) (end-hilit (min last (+ end xtra))) (current-diff-overlay (symbol-value (intern (format "ediff-current-diff-overlay-%S" buf-type)))) ) (if ediff-xemacs-p (ediff-move-overlay current-diff-overlay begin end-hilit) (ediff-move-overlay current-diff-overlay begin end-hilit buff)) ;; giving priority of 0 and then changing it may look funny, but ;; this overcomes an obscure Emacs bug. (ediff-overlay-put current-diff-overlay 'priority 0) (ediff-overlay-put current-diff-overlay 'priority (ediff-highest-priority begin end-hilit buff)) (ediff-overlay-put current-diff-overlay 'ediff-diff-num n) ;; unhighlight the background overlay for diff n so it won't ;; interfere with the current diff overlay (ediff-set-overlay-face (ediff-get-diff-overlay n buf-type) nil) ))) (defun ediff-unhighlight-diff-in-one-buffer (buf-type) (if (ediff-buffer-live-p (ediff-get-buffer buf-type)) (let ((current-diff-overlay (symbol-value (intern (format "ediff-current-diff-overlay-%S" buf-type)))) (overlay (ediff-get-diff-overlay ediff-current-difference buf-type)) ) (ediff-move-overlay current-diff-overlay 1 1) ;; rehighlight the overlay in the background of the ;; current difference region (ediff-set-overlay-face overlay (if (and (ediff-window-display-p) ediff-use-faces ediff-highlight-all-diffs) (ediff-background-face buf-type ediff-current-difference))) ))) (defun ediff-unhighlight-diffs-totally-in-one-buffer (buf-type) (ediff-unselect-and-select-difference -1) (if (and (ediff-window-display-p) ediff-use-faces) (let* ((inhibit-quit t) (current-diff-overlay-var (intern (format "ediff-current-diff-overlay-%S" buf-type))) (current-diff-overlay (symbol-value current-diff-overlay-var))) (ediff-color-background-regions 'unhighlight) (if (ediff-overlayp current-diff-overlay) (ediff-delete-overlay current-diff-overlay)) (set current-diff-overlay-var nil) ))) ;; null out difference overlays so they won't slow down future ;; editing operations ;; VEC is either a difference vector or a fine-diff vector (defun ediff-clear-diff-vector (vec-var &optional fine-diffs-also) (if (vectorp (symbol-value vec-var)) (mapcar (function (lambda (elt) (ediff-delete-overlay (ediff-get-diff-overlay-from-diff-record elt)) (if fine-diffs-also (ediff-clear-fine-diff-vector elt)) )) (symbol-value vec-var))) ;; allow them to be garbage collected (set vec-var nil)) (defun ediff-color-background-regions (&optional unhighlight) (ediff-color-background-regions-in-one-buffer 'A unhighlight) (ediff-color-background-regions-in-one-buffer 'B unhighlight) (ediff-color-background-regions-in-one-buffer 'C unhighlight) (ediff-color-background-regions-in-one-buffer 'Ancestor unhighlight)) (defun ediff-color-background-regions-in-one-buffer (buf-type unhighlight) (let ((diff-vector (eval (intern (format "ediff-difference-vector-%S" buf-type)))) overl diff-num) (mapcar (function (lambda (rec) (setq overl (ediff-get-diff-overlay-from-diff-record rec) diff-num (ediff-overlay-get overl 'ediff-diff-num)) (ediff-set-overlay-face overl (if (not unhighlight) (ediff-background-face buf-type diff-num)) ))) diff-vector))) ;;; Misc ;; These two functions are here to neutralize XEmacs unwillingless to ;; handle overlays whose buffers were deleted. (defun ediff-move-overlay (overlay beg end &optional buffer) "Calls `move-overlay' in Emacs and `set-extent-endpoints' in Lemacs. Checks if overlay's buffer exists before actually doing the move." (let ((buf (and overlay (ediff-overlay-buffer overlay)))) (if (ediff-buffer-live-p buf) (if ediff-xemacs-p (set-extent-endpoints overlay beg end) (move-overlay overlay beg end buffer)) ;; buffer's dead (if overlay (ediff-delete-overlay overlay))))) (defun ediff-overlay-put (overlay prop value) "Calls `overlay-put' or `set-extent-property' depending on Emacs version. Checks if overlay's buffer exists." (if (ediff-buffer-live-p (ediff-overlay-buffer overlay)) (if ediff-xemacs-p (set-extent-property overlay prop value) (overlay-put overlay prop value)) (ediff-delete-overlay overlay))) ;; In Emacs, this just makes overlay. In the future, when Emacs will start ;; supporting sticky overlays, this function will make a sticky overlay. ;; BEG and END are expressions telling where overlay starts. ;; If they are numbers or buffers, then all is well. Otherwise, they must ;; be expressions to be evaluated in buffer BUF in order to get the overlay ;; bounds. ;; If BUFF is not a live buffer, then return nil; otherwise, return the ;; newly created overlay. (defun ediff-make-bullet-proof-overlay (beg end buff) (if (ediff-buffer-live-p buff) (let (overl) (ediff-eval-in-buffer buff (or (number-or-marker-p beg) (setq beg (eval beg))) (or (number-or-marker-p end) (setq end (eval end))) (setq overl (ediff-make-overlay beg end buff)) (if ediff-xemacs-p (progn ;; take precautions against detached extents (ediff-overlay-put overl 'detachable nil) ;; chars inserted at both ends will be inside extent (ediff-overlay-put overl 'start-open nil) (ediff-overlay-put overl 'end-open nil)) (ediff-overlay-put overl 'evaporate nil) ; don't detach ;; doesn't work since emacs buggily doesn't call these functions ;; after the change ;;(ediff-overlay-put overl 'insert-in-front-hooks ;; '(ediff-capture-inserts-in-front)) ;;(ediff-overlay-put overl 'insert-behind-hooks ;; '(ediff-capture-inserts-behind)) ;; These two are not yet implemented in Emacs (ediff-overlay-put overl 'rear-sticky t) (ediff-overlay-put overl 'front-sticky t) ) (ediff-overlay-put overl 'ediff-diff-num 0) overl)))) (defsubst ediff-overlay-start (overl) (if (ediff-overlayp overl) (if ediff-emacs-p (overlay-start overl) (extent-start-position overl)))) (defsubst ediff-overlay-end (overl) (if (ediff-overlayp overl) (if ediff-emacs-p (overlay-end overl) (extent-end-position overl)))) ;; Like other-buffer, but prefers visible buffers and ignores temporary or ;; other insignificant buffers (those beginning with "^[ *]"). ;; Gets one arg--buffer name or a list of buffer names (it won't return ;; these buffers). (defun ediff-other-buffer (buff) (if (not (listp buff)) (setq buff (list buff))) (let* ((frame-buffers (buffer-list)) (significant-buffers (mapcar (function (lambda (x) (cond ((member (buffer-name x) buff) nil) ((not (ediff-get-visible-buffer-window x)) nil) ((string-match "^ " (buffer-name x)) nil) (t x)))) frame-buffers)) (buffers (delq nil significant-buffers)) less-significant-buffers) (cond (buffers (car buffers)) ;; try also buffers that are not displayed in windows ((setq less-significant-buffers (delq nil (mapcar (function (lambda (x) (cond ((member (buffer-name x) buff) nil) ((string-match "^[ *]" (buffer-name x)) nil) (t x)))) frame-buffers))) (car less-significant-buffers)) (t (other-buffer (current-buffer)))) )) ;; Construct a unique buffer name. ;; The first one tried is prefixsuffix, then prefix<2>suffix, ;; prefix<3>suffix, etc. (defun ediff-unique-buffer-name (prefix suffix) (if (null (get-buffer (concat prefix suffix))) (concat prefix suffix) (let ((n 2)) (while (get-buffer (format "%s<%d>%s" prefix n suffix)) (setq n (1+ n))) (format "%s<%d>%s" prefix n suffix)))) ;; splits at a white space, returns a list (defun ediff-split-string (string) (let ((start 0) (result '()) substr) (while (string-match "[ \t]+" string start) (let ((match (string-match "[ \t]+" string start))) (setq substr (substring string start match)) (if (> (length substr) 0) (setq result (cons substr result))) (setq start (match-end 0)))) (setq substr (substring string start nil)) (if (> (length substr) 0) (setq result (cons substr result))) (nreverse result))) (defun ediff-submit-report () "Submit bug report on Ediff." (interactive) (ediff-barf-if-not-control-buffer) (let ((reporter-prompt-for-summary-p t) (ctl-buf ediff-control-buffer) (ediff-device-type (ediff-device-type)) varlist salutation buffer-name) (setq varlist '(ediff-diff-program ediff-diff-options ediff-patch-program ediff-patch-options ediff-shell ediff-use-faces ediff-auto-refine ediff-highlighting-style ediff-buffer-A ediff-buffer-B ediff-control-buffer ediff-forward-word-function ediff-control-frame ediff-control-frame-parameters ediff-control-frame-position-function ediff-prefer-iconified-control-frame ediff-window-setup-function ediff-split-window-function ediff-job-name ediff-word-mode buffer-name ediff-device-type )) (setq salutation " Congratulations! You may have unearthed a bug in Ediff! Please make a concise and accurate summary of what happened and mail it to the address above. ----------------------------------------------------------- ") (ediff-skip-unsuitable-frames) (ediff-reset-mouse) (switch-to-buffer ediff-msg-buffer) (erase-buffer) (delete-other-windows) (insert " Please read this first: ---------------------- Some ``bugs'' may actually be no bugs at all. For instance, if you are reporting that certain difference regions are not matched as you think they should, this is most likely due to the way Unix diff program decides what constitutes a difference region. Ediff is an Emacs interface to diff, and it has nothing to do with those decisions---it only takes the output from diff and presents it in a way that is better suited for human browsing and manipulation. If Emacs happens to dump core, this is NOT an Ediff problem---it is an Emacs bug. Report this to Emacs maintainers. Another popular topic for reports is compilation messages. Because Ediff interfaces to several other packages and runs under Emacs and XEmacs, byte-compilation may produce output like this: While compiling toplevel forms in file ediff.el: ** reference to free variable pm-color-alist ........................ While compiling the end of the data: ** The following functions are not known to be defined: ediff-valid-color-p, ediff-set-face, ........................ These are NOT errors, but inevitable warnings, which ought to be ignored. Please do not report those and similar things. However, comments and suggestions are always welcome. Mail anyway? (y or n) ") (if (y-or-n-p "Mail anyway? ") (progn (if (ediff-buffer-live-p ctl-buf) (set-buffer ctl-buf)) (setq buffer-name (buffer-name)) (require 'reporter) (reporter-submit-bug-report "kifer@cs.sunysb.edu" (ediff-version) varlist nil 'delete-other-windows salutation)) (bury-buffer) (beep 1)(message "Bug report aborted") (if (ediff-buffer-live-p ctl-buf) (ediff-eval-in-buffer ctl-buf (ediff-recenter 'no-rehighlight)))) )) (defun ediff-deactivate-mark () (if ediff-xemacs-p (zmacs-deactivate-region) (deactivate-mark))) (cond ((fboundp 'nuke-selective-display) ;; XEmacs 19.12 has nuke-selective-display (fset 'ediff-nuke-selective-display 'nuke-selective-display)) (t (defun ediff-nuke-selective-display () (save-excursion (save-restriction (widen) (goto-char (point-min)) (let ((mod-p (buffer-modified-p)) buffer-read-only end) (and (eq t selective-display) (while (search-forward "\^M" nil t) (end-of-line) (setq end (point)) (beginning-of-line) (while (search-forward "\^M" end t) (delete-char -1) (insert "\^J")))) (set-buffer-modified-p mod-p) (setq selective-display nil))))) )) ;; The next two are modified versions from emerge.el. ;; VARS must be a list of symbols ;; ediff-save-variables returns an association list: ((var . val) ...) (defsubst ediff-save-variables (vars) (mapcar (function (lambda (v) (cons v (symbol-value v)))) vars)) ;; VARS is a list of variable symbols. (defun ediff-restore-variables (vars assoc-list) (while vars (set (car vars) (cdr (assoc (car vars) assoc-list))) (setq vars (cdr vars)))) (defun ediff-change-saved-variable (var value buf-type) (let* ((assoc-list (symbol-value (intern (concat "ediff-buffer-values-orig-" (symbol-name buf-type))))) (assoc-elt (assoc var assoc-list))) (if assoc-elt (setcdr assoc-elt value)))) ;; must execute in control buf (defun ediff-save-protected-variables () (setq ediff-buffer-values-orig-A (ediff-eval-in-buffer ediff-buffer-A (ediff-save-variables ediff-protected-variables))) (setq ediff-buffer-values-orig-B (ediff-eval-in-buffer ediff-buffer-B (ediff-save-variables ediff-protected-variables))) (if ediff-3way-comparison-job (setq ediff-buffer-values-orig-C (ediff-eval-in-buffer ediff-buffer-C (ediff-save-variables ediff-protected-variables)))) (if (ediff-buffer-live-p ediff-ancestor-buffer) (setq ediff-buffer-values-orig-Ancestor (ediff-eval-in-buffer ediff-ancestor-buffer (ediff-save-variables ediff-protected-variables))))) ;; must execute in control buf (defun ediff-restore-protected-variables () (let ((values-A ediff-buffer-values-orig-A) (values-B ediff-buffer-values-orig-B) (values-C ediff-buffer-values-orig-C) (values-Ancestor ediff-buffer-values-orig-Ancestor)) (ediff-eval-in-buffer ediff-buffer-A (ediff-restore-variables ediff-protected-variables values-A)) (ediff-eval-in-buffer ediff-buffer-B (ediff-restore-variables ediff-protected-variables values-B)) (if ediff-3way-comparison-job (ediff-eval-in-buffer ediff-buffer-C (ediff-restore-variables ediff-protected-variables values-C))) (if (ediff-buffer-live-p ediff-ancestor-buffer) (ediff-eval-in-buffer ediff-ancestor-buffer (ediff-restore-variables ediff-protected-variables values-Ancestor))) )) ;;; Debug (ediff-defvar-local ediff-command-begin-time '(0 0 0) "") ;; calculate time used by command (defun ediff-calc-command-time () (let ((end (current-time)) micro sec) (setq micro (if (>= (nth 2 end) (nth 2 ediff-command-begin-time)) (- (nth 2 end) (nth 2 ediff-command-begin-time)) (+ (nth 2 end) (- 1000000 (nth 2 ediff-command-begin-time))))) (setq sec (- (nth 1 end) (nth 1 ediff-command-begin-time))) (or (equal ediff-command-begin-time '(0 0 0)) (message "Elapsed time: %d second(s) + %d microsecond(s)" sec micro)))) (defsubst ediff-save-time () (setq ediff-command-begin-time (current-time))) (defun ediff-profile () "Toggle profiling Ediff commands." (interactive) (ediff-barf-if-not-control-buffer) (if ediff-emacs-p (make-local-variable 'post-command-hook)) (let ((pre-hook (if ediff-emacs-p 'pre-command-hook 'local-pre-command-hook)) (post-hook (if ediff-emacs-p 'post-command-hook 'local-post-command-hook))) (if (not (equal ediff-command-begin-time '(0 0 0))) (progn (remove-hook pre-hook 'ediff-save-time) (remove-hook post-hook 'ediff-calc-command-time) (setq ediff-command-begin-time '(0 0 0)) (message "Ediff profiling disabled")) (add-hook pre-hook 'ediff-save-time t) (add-hook post-hook 'ediff-calc-command-time) (message "Ediff profiling enabled")))) (defun ediff-print-diff-vector (diff-vector-var) (princ (format "\n*** %S ***\n" diff-vector-var)) (mapcar (function (lambda (overl-vec) (princ (format "Diff %d: \tOverlay: %S \t\tFine diffs: %s \t\tNo-fine-diff-flag: %S \t\tState-of-diff:\t %S \t\tState-of-merge:\t %S " (1+ (ediff-overlay-get (aref overl-vec 0) 'ediff-diff-num)) (aref overl-vec 0) ;; fine-diff-vector (if (= (length (aref overl-vec 1)) 0) "none\n" (mapconcat 'prin1-to-string (aref overl-vec 1) "\n\t\t\t ")) (aref overl-vec 2) ; no fine diff flag (aref overl-vec 3) ; state-of-diff (aref overl-vec 4) ; state-of-merge )))) (eval diff-vector-var))) (defun ediff-debug-info () (interactive) (ediff-barf-if-not-control-buffer) (with-output-to-temp-buffer ediff-debug-buffer (princ (format "\nCtl buffer: %S\n" ediff-control-buffer)) (ediff-print-diff-vector (intern "ediff-difference-vector-A")) (ediff-print-diff-vector (intern "ediff-difference-vector-B")) (ediff-print-diff-vector (intern "ediff-difference-vector-C")) (ediff-print-diff-vector (intern "ediff-difference-vector-Ancestor")) )) ;; don't report error if version control package wasn't found ;;(ediff-load-version-control 'silent) (run-hooks 'ediff-load-hook) ;;; Local Variables: ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) ;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1) ;;; End: (provide 'ediff-util) ;;; ediff-util.el ends here emacs-19.30/lisp/ediff-wind.el100444 23123 1 122303 6035076352 14760 0ustar kiferdaemon;;; ediff-wind.el --- window manipulation utilities ;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. (require 'ediff-init) (defvar ediff-window-setup-function (if (ediff-window-display-p) 'ediff-setup-windows-multiframe 'ediff-setup-windows-plain) "*Function called to set up windows. Ediff provides a choice of two functions: ediff-setup-windows-plain, for doing everything in one frame, and ediff-setup-windows-multiframe, which sets the control panel in a separate frame. Also, if the latter function detects that one of the buffers A/B is seen in some other frame, it will try to keep that buffer in that frame. If you don't like the two functions provided---write your own one. The basic guidelines: 1. It should leave the control buffer current and the control window selected. 2. It should set ediff-window-A, ediff-window-B, ediff-window-C, and ediff-control-window to contain window objects that display the corresponding buffers. 3. It should accept the following arguments: buffer-A, buffer-B, buffer-C, control-buffer Buffer C may not be used in jobs that compare only two buffers. If you plan to do something fancy, take a close look at how the two provided functions are written.") ;; indicates if we are in a multiframe setup (ediff-defvar-local ediff-multiframe nil "") ;; Share of the frame occupied by the merge window (buffer C) (ediff-defvar-local ediff-merge-window-share 0.45 "") ;; The control window. (ediff-defvar-local ediff-control-window nil "") ;; Official window for buffer A (ediff-defvar-local ediff-window-A nil "") ;; Official window for buffer B (ediff-defvar-local ediff-window-B nil "") ;; Official window for buffer C (ediff-defvar-local ediff-window-C nil "") ;; Ediff's window configuration. ;; Used to minimize the need to rearrange windows. (ediff-defvar-local ediff-window-config-saved "" "") (defvar ediff-split-window-function 'split-window-vertically "*The function used to split the main window between buffer-A and buffer-B. You can set it to a horizontal split instead of the default vertical split by setting this variable to `split-window-horizontally'. You can also have your own function to do fancy splits. This variable has no effect when buffer-A/B are shown in different frames. In this case, Ediff will use those frames to display these buffers.") (defvar ediff-merge-split-window-function 'split-window-horizontally "*The function used to split the main window between buffer-A and buffer-B. You can set it to a vertical split instead of the default horizontal split by setting this variable to `split-window-vertically'. You can also have your own function to do fancy splits. This variable has no effect when buffer-A/B/C are shown in different frames. In this case, Ediff will use those frames to display these buffers.") (defconst ediff-control-frame-parameters (if (ediff-window-display-p) (list '(name . "Ediff") ;;'(unsplittable . t) '(minibuffer . nil) '(user-position . t) ; Emacs only '(vertical-scroll-bars . nil) ; Emacs only '(scrollbar-width . 0) ; XEmacs only '(menu-bar-lines . 0) ; Emacs only '(visibility . nil) ; doesn't work for XEmacs yet ;; don't lower and auto-raise '(auto-lower . nil) '(auto-raise . t) ;; this blocks queries from window manager as to where to put ;; ediff's control frame. we put the frame outside the display, ;; so the initial frame won't jump all over the screen (cons 'top (if (fboundp 'ediff-display-pixel-height) (1+ (ediff-display-pixel-height)) 3000)) (cons 'left (if (fboundp 'ediff-display-pixel-width) (1+ (ediff-display-pixel-width)) 3000)) )) "Frame parameters for displaying Ediff Control Panel. Do not specify width and height here. These are computed automatically.") ;; position of the mouse; used to decide whether to warp the mouse into ctl ;; frame (ediff-defvar-local ediff-mouse-pixel-position nil "") ;; not used for now (defvar ediff-mouse-pixel-threshhold 30 "If the user moves mouse more than this many pixels, Ediff won't warp mouse into control window.") (defvar ediff-grab-mouse t "*If t, Ediff will always grab the mouse and put it in the control frame. If 'maybe, Ediff will do it sometimes, but not after operations that require relatively long time. If nil, the mouse will be entirely user's responsibility.") (defvar ediff-control-frame-position-function 'ediff-make-frame-position "Function to call to determine the desired location for the control panel. Expects three parameters: the control buffer, the desired width and height of the control frame. It returns an association list of the form \(\(top . \) \(left . \)\)") (defvar ediff-control-frame-upward-shift (if ediff-xemacs-p 42 14) "*The upward shift of control frame from the top of buffer A's frame. Measured in pixels. This is used by the default control frame positioning function, `ediff-make-frame-position'. This variable is provided for easy customization of the default.") (defvar ediff-narrow-control-frame-leftward-shift (if ediff-xemacs-p 7 3) "*The leftward shift of control frame from the right edge of buf A's frame. Measured in characters. This is used by the default control frame positioning function, `ediff-make-frame-position' to adjust the position of the control frame when it shows the short menu. This variable is provided for easy customization of the default.") (defvar ediff-wide-control-frame-rightward-shift 7 "*The rightward shift of control frame from the left edge of buf A's frame. Measured in characters. This is used by the default control frame positioning function, `ediff-make-frame-position' to adjust the position of the control frame when it shows the full menu. This variable is provided for easy customization of the default.") ;; Wide frame display ;; t means Ediff is using wide display (ediff-defvar-local ediff-wide-display-p nil "") ;; keeps frame config for toggling wide display (ediff-defvar-local ediff-wide-display-orig-parameters nil "Frame parameters to be restored when the user wants to toggle the wide display off.") (ediff-defvar-local ediff-wide-display-frame nil "Frame to be used for wide display.") (ediff-defvar-local ediff-make-wide-display-function 'ediff-make-wide-display "The value is a function that is called to create a wide display. The function is called without arguments. It should resize the frame in which buffers A, B, and C are to be displayed, and it should save the old frame parameters in `ediff-wide-display-orig-parameters'. The variable `ediff-wide-display-frame' should be set to contain the frame used for the wide display.") ;; Frame used for the control panel in a windowing system. (ediff-defvar-local ediff-control-frame nil "") (defvar ediff-prefer-iconified-control-frame nil "*If t, keep control panel iconified when help message is off. This has effect only on a windowing system. If t, hiting `?' to toggle control panel off iconifies it. This is only useful in Emacs and only for certain kinds of window managers, such as TWM and its derivatives, since the window manager must permit keyboard input to go into icons. XEmacs completely ignores keyboard input into icons, regardless of the window manager.") ;;; Functions (defun ediff-get-window-by-clicking (wind prev-wind wind-number) (let (event) (message "Select windows by clicking. Please click on Window %d " wind-number) (while (not (ediff-mouse-event-p (setq event (ediff-read-event)))) (if (sit-for 1) ; if sequence of events, wait till the final word (beep 1)) (message "Please click on Window %d " wind-number)) (ediff-read-event) ; discard event (setq wind (if ediff-xemacs-p (event-window event) (posn-window (event-start event)))) )) ;; Select the lowest window on the frame. (defun ediff-select-lowest-window () (if ediff-xemacs-p (select-window (frame-lowest-window)) (let* ((lowest-window (selected-window)) (bottom-edge (car (cdr (cdr (cdr (window-edges)))))) (last-window (save-excursion (other-window -1) (selected-window))) (window-search t)) (while window-search (let* ((this-window (next-window)) (next-bottom-edge (car (cdr (cdr (cdr (window-edges this-window))))))) (if (< bottom-edge next-bottom-edge) (progn (setq bottom-edge next-bottom-edge) (setq lowest-window this-window))) (select-window this-window) (if (eq last-window this-window) (progn (select-window lowest-window) (setq window-search nil)))))))) ;;; Common window setup routines ;; Set up the window configuration. If POS is given, set the points to ;; the beginnings of the buffers. ;; When 3way comparison is added, this will have to choose the appropriate ;; setup function based on ediff-job-name (defun ediff-setup-windows (buffer-A buffer-B buffer-C control-buffer) ;; Make sure we are not in the minibuffer window when we try to delete ;; all other windows. (run-hooks 'ediff-before-setup-windows-hook) (if (eq (selected-window) (minibuffer-window)) (other-window 1)) ;; in case user did a no-no on a tty (or (ediff-window-display-p) (setq ediff-window-setup-function 'ediff-setup-windows-plain)) (or (ediff-keep-window-config control-buffer) (funcall (ediff-eval-in-buffer control-buffer ediff-window-setup-function) buffer-A buffer-B buffer-C control-buffer)) (run-hooks 'ediff-after-setup-windows-hook)) ;; Just set up 3 windows. ;; Usually used without windowing systems ;; With windowing, we want to use dedicated frames. (defun ediff-setup-windows-plain (buffer-A buffer-B buffer-C control-buffer) (ediff-eval-in-buffer control-buffer (setq ediff-multiframe nil)) (if ediff-merge-job (ediff-setup-windows-plain-merge buffer-A buffer-B buffer-C control-buffer) (ediff-setup-windows-plain-compare buffer-A buffer-B buffer-C control-buffer))) (defun ediff-setup-windows-plain-merge (buf-A buf-B buf-C control-buffer) ;; skip dedicated and unsplittable frames (ediff-destroy-control-frame control-buffer) (let ((window-min-height 2) split-window-function merge-window-share merge-window-lines wind-A wind-B wind-C) (ediff-eval-in-buffer control-buffer (setq merge-window-share ediff-merge-window-share ;; this lets us have local versions of ediff-split-window-function split-window-function ediff-split-window-function)) (delete-other-windows) (split-window-vertically) (ediff-select-lowest-window) (ediff-setup-control-buffer control-buffer) ;; go to the upper window and split it betw A, B, and possibly C (other-window 1) (setq merge-window-lines (max 2 (round (* (window-height) merge-window-share)))) (switch-to-buffer buf-A) (setq wind-A (selected-window)) ;; XEmacs used to have a lot of trouble with display ;; It did't set things right unless we tell it to sit still ;; 19.12 seems ok. ;;(if ediff-xemacs-p (sit-for 0)) (split-window-vertically (max 2 (- (window-height) merge-window-lines))) (if (eq (selected-window) wind-A) (other-window 1)) (setq wind-C (selected-window)) (switch-to-buffer buf-C) (select-window wind-A) (funcall split-window-function) (if (eq (selected-window) wind-A) (other-window 1)) (switch-to-buffer buf-B) (setq wind-B (selected-window)) (ediff-eval-in-buffer control-buffer (setq ediff-window-A wind-A ediff-window-B wind-B ediff-window-C wind-C)) (ediff-select-lowest-window) (ediff-setup-control-buffer control-buffer) )) ;; This function handles all comparison jobs, including 3way jobs (defun ediff-setup-windows-plain-compare (buf-A buf-B buf-C control-buffer) ;; skip dedicated and unsplittable frames (ediff-destroy-control-frame control-buffer) (let ((window-min-height 2) split-window-function wind-width-or-height three-way-comparison wind-A-start wind-B-start wind-A wind-B wind-C) (ediff-eval-in-buffer control-buffer (setq wind-A-start (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'A ediff-narrow-bounds)) wind-B-start (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'B ediff-narrow-bounds)) ;; this lets us have local versions of ediff-split-window-function split-window-function ediff-split-window-function three-way-comparison ediff-3way-comparison-job)) (delete-other-windows) (split-window-vertically) (ediff-select-lowest-window) (ediff-setup-control-buffer control-buffer) ;; go to the upper window and split it betw A, B, and possibly C (other-window 1) (switch-to-buffer buf-A) (setq wind-A (selected-window)) (if three-way-comparison (setq wind-width-or-height (/ (if (eq split-window-function 'split-window-vertically) (window-height wind-A) (window-width wind-A)) 3))) ;; XEmacs used to have a lot of trouble with display ;; It did't set things right unless we told it to sit still ;; 19.12 seems ok. ;;(if ediff-xemacs-p (sit-for 0)) (funcall split-window-function wind-width-or-height) (if (eq (selected-window) wind-A) (other-window 1)) (switch-to-buffer buf-B) (setq wind-B (selected-window)) (if three-way-comparison (progn (funcall split-window-function) ; equally (if (eq (selected-window) wind-B) (other-window 1)) (switch-to-buffer buf-C) (setq wind-C (selected-window)))) (ediff-eval-in-buffer control-buffer (setq ediff-window-A wind-A ediff-window-B wind-B ediff-window-C wind-C)) ;; It is unlikely that we will want to implement 3way window comparison. ;; So, only buffers A and B are used here. (if ediff-windows-job (progn (set-window-start wind-A wind-A-start) (set-window-start wind-B wind-B-start))) (ediff-select-lowest-window) (ediff-setup-control-buffer control-buffer) )) ;; dispatch the appropriate window setup function (defun ediff-setup-windows-multiframe (buf-A buf-B buf-C control-buf) (ediff-eval-in-buffer control-buf (setq ediff-multiframe t)) (if ediff-merge-job (ediff-setup-windows-multiframe-merge buf-A buf-B buf-C control-buf) (ediff-setup-windows-multiframe-compare buf-A buf-B buf-C control-buf))) (defun ediff-setup-windows-multiframe-merge (buf-A buf-B buf-C control-buf) ;;; Algorithm: ;;; If A and B are in the same frame but C's frame is different--- use one ;;; frame for A and B and use a separate frame for C. ;;; If C's frame is non-existent, then: if the first suitable ;;; non-dedicated frame is different from A&B's, then use it for C. ;;; Otherwise, put A,B, and C in one frame. ;;; If buffers A, B, C are is separate frames, use them to display these ;;; buffers. ;; Skip dedicated or iconified frames. ;; Unsplittable frames are taken care of later. (ediff-skip-unsuitable-frames 'ok-unsplittable) (let* ((window-min-height 2) (wind-A (ediff-get-visible-buffer-window buf-A)) (wind-B (ediff-get-visible-buffer-window buf-B)) (wind-C (ediff-get-visible-buffer-window buf-C)) (frame-A (if wind-A (window-frame wind-A))) (frame-B (if wind-B (window-frame wind-B))) (frame-C (if wind-C (window-frame wind-C))) ;; on wide display, do things in one frame (force-one-frame (ediff-eval-in-buffer control-buf ediff-wide-display-p)) ;; this lets us have local versions of ediff-split-window-function (split-window-function (ediff-eval-in-buffer control-buf ediff-split-window-function)) (orig-wind (selected-window)) (orig-frame (selected-frame)) (use-same-frame (or force-one-frame (eq frame-A (or frame-C orig-frame)) (eq frame-B (or frame-C orig-frame)) (not (frame-live-p frame-A)) (not (frame-live-p frame-B)) (and (eq frame-A frame-B) (not (frame-live-p frame-C))) )) (use-same-frame-for-AB (and (not use-same-frame) (eq frame-A frame-B))) (merge-window-share (ediff-eval-in-buffer control-buf ediff-merge-window-share)) merge-window-lines designated-minibuffer-frame done-A done-B done-C) ;; buf-A on its own (if (and (window-live-p wind-A) (null use-same-frame) (null use-same-frame-for-AB)) (progn (select-window wind-A) (delete-other-windows) (switch-to-buffer buf-A) (setq wind-A (selected-window)) (setq done-A t))) ;; buf-B on its own (if (and (window-live-p wind-B) (null use-same-frame)) ; buf B on its own (progn (select-window wind-B) (delete-other-windows) (switch-to-buffer buf-B) (setq wind-B (selected-window)) (setq done-B t))) ;; buf-C on its own (if (and (window-live-p wind-C) (null use-same-frame)) ; buf C on its own (progn (select-window wind-C) (delete-other-windows) (switch-to-buffer buf-C) (setq wind-C (selected-window)) (setq done-C t))) (if use-same-frame-for-AB (progn (select-frame frame-A) (switch-to-buffer buf-A) (delete-other-windows) (setq wind-A (selected-window)) (funcall split-window-function) (if (eq (selected-window) wind-A) (other-window 1)) (switch-to-buffer buf-B) (setq wind-B (selected-window)) (setq done-A t done-B t))) (if use-same-frame (let ((curr-frame (selected-frame)) (window-min-height 2)) ;; avoid dedicated and non-splittable windows (ediff-skip-unsuitable-frames) (or (eq curr-frame (selected-frame)) (setq wind-A nil wind-B nil wind-C nil orig-wind (selected-window))) ;; set the right frame (cond (wind-A (select-window wind-A)) (wind-B (select-window wind-B)) (wind-C (select-window wind-C)) (t (select-window orig-wind))) (delete-other-windows) (setq merge-window-lines (max 2 (round (* (window-height) merge-window-share)))) (switch-to-buffer buf-A) (setq wind-A (selected-window)) ;; XEmacs used to have a lot of trouble with display ;; It did't set things right unless we told it to catch breath ;;(if ediff-xemacs-p (sit-for 0)) (split-window-vertically (max 2 (- (window-height) merge-window-lines))) (if (eq (selected-window) wind-A) (other-window 1)) (setq wind-C (selected-window)) (switch-to-buffer buf-C) (select-window wind-A) (funcall split-window-function) (if (eq (selected-window) wind-A) (other-window 1)) (switch-to-buffer buf-B) (setq wind-B (selected-window)) (setq done-A t done-B t done-C t) )) (or done-A ; Buf A to be set in its own frame (progn ; It was not set up yet as it wasn't visible (select-window orig-wind) (delete-other-windows) (switch-to-buffer buf-A) (setq wind-A (selected-window)) )) (or done-B ; Buf B to be set in its own frame (progn ; It was not set up yet as it wasn't visible (select-window orig-wind) (delete-other-windows) (switch-to-buffer buf-B) (setq wind-B (selected-window)) )) (or done-C ; Buf C to be set in its own frame. (progn ; It was not set up yet as it wasn't visible (select-window orig-wind) (delete-other-windows) (switch-to-buffer buf-C) (setq wind-C (selected-window)) )) (ediff-eval-in-buffer control-buf (setq ediff-window-A wind-A ediff-window-B wind-B ediff-window-C wind-C) (setq frame-A (window-frame ediff-window-A) designated-minibuffer-frame (window-frame (minibuffer-window frame-A)))) (ediff-setup-control-frame control-buf designated-minibuffer-frame) )) ;; Window setup for all comparison jobs, including 3way comparisons (defun ediff-setup-windows-multiframe-compare (buf-A buf-B buf-C control-buf) ;;; Algorithm: ;;; If a buffer is seen in a frame, use that frame for that buffer. ;;; If it is not seen, use the current frame. ;;; If both buffers are not seen, they share the current frame. If one ;;; of the buffers is not seen, it is placed in the current frame (where ;;; ediff started). If that frame is displaying the other buffer, it is ;;; shared between the two buffers. ;;; However, if we decide to put both buffers in one frame ;;; and the selected frame isn't splittable, we create a new frame and ;;; put both buffers there, event if one of this buffers is visible in ;;; another frame. ;; Skip dedicated or iconified frames. ;; Unsplittable frames are taken care of later. (ediff-skip-unsuitable-frames 'ok-unsplittable) (let* ((window-min-height 2) (wind-A (ediff-get-visible-buffer-window buf-A)) (wind-B (ediff-get-visible-buffer-window buf-B)) (wind-C (ediff-get-visible-buffer-window buf-C)) (frame-A (if wind-A (window-frame wind-A))) (frame-B (if wind-B (window-frame wind-B))) (frame-C (if wind-C (window-frame wind-C))) (ctl-frame-exists-p (ediff-eval-in-buffer control-buf (frame-live-p ediff-control-frame))) ;; on wide display, do things in one frame (force-one-frame (ediff-eval-in-buffer control-buf ediff-wide-display-p)) ;; this lets us have local versions of ediff-split-window-function (split-window-function (ediff-eval-in-buffer control-buf ediff-split-window-function)) (three-way-comparison (ediff-eval-in-buffer control-buf ediff-3way-comparison-job)) (orig-wind (selected-window)) (use-same-frame (or force-one-frame (eq frame-A frame-B) (if three-way-comparison (or (eq frame-A frame-C) (eq frame-B frame-C) (not (frame-live-p frame-A)) (not (frame-live-p frame-B)) (not (frame-live-p frame-C)))) (and (not (frame-live-p frame-B)) (or ctl-frame-exists-p (eq frame-A (selected-frame)))) (and (not (frame-live-p frame-A)) (or ctl-frame-exists-p (eq frame-B (selected-frame)))))) wind-A-start wind-B-start designated-minibuffer-frame done-A done-B done-C) (ediff-eval-in-buffer control-buf (setq wind-A-start (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'A ediff-narrow-bounds)) wind-B-start (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'B ediff-narrow-bounds)))) (if (and (window-live-p wind-A) (null use-same-frame)) ; buf-A on its own (progn (select-window wind-A) (delete-other-windows) (switch-to-buffer buf-A) (setq wind-A (selected-window)) (setq done-A t))) (if (and (window-live-p wind-B) (null use-same-frame)) ; buf B on its own (progn (select-window wind-B) (delete-other-windows) (switch-to-buffer buf-B) (setq wind-B (selected-window)) (setq done-B t))) (if (and (window-live-p wind-C) (null use-same-frame)) ; buf C on its own (progn (select-window wind-C) (delete-other-windows) (switch-to-buffer buf-C) (setq wind-C (selected-window)) (setq done-C t))) (if use-same-frame (let ((curr-frame (selected-frame)) ;; this affects 3way setups only wind-width-or-height) ;; avoid dedicated and non-splittable windows (ediff-skip-unsuitable-frames) (or (eq curr-frame (selected-frame)) (setq wind-A nil wind-B nil wind-C nil orig-wind (selected-window))) ;; set the right frame (cond (wind-A (select-window wind-A)) (wind-B (select-window wind-B)) (wind-C (select-window wind-C)) (t (select-window orig-wind))) (delete-other-windows) (switch-to-buffer buf-A) (setq wind-A (selected-window)) ;; XEmacs used to have a lot of trouble with display ;; It didn't set things right unless we told it to catch breath ;;(if ediff-xemacs-p (sit-for 0)) (if three-way-comparison (setq wind-width-or-height (/ (if (eq split-window-function 'split-window-vertically) (window-height wind-A) (window-width wind-A)) 3))) (funcall split-window-function wind-width-or-height) (if (eq (selected-window) wind-A) (other-window 1)) (switch-to-buffer buf-B) (setq wind-B (selected-window)) (if three-way-comparison (progn (funcall split-window-function) ; equally (if (memq (selected-window) (list wind-A wind-B)) (other-window 1)) (switch-to-buffer buf-C) (setq wind-C (selected-window)))) (setq done-A t done-B t done-C t) )) (or done-A ; Buf A to be set in its own frame (progn ; It was not set up yet as it wasn't visible (select-window orig-wind) (delete-other-windows) (switch-to-buffer buf-A) (setq wind-A (selected-window)) )) (or done-B ; Buf B to be set in its own frame (progn ; It was not set up yet as it wasn't visible (select-window orig-wind) (delete-other-windows) (switch-to-buffer buf-B) (setq wind-B (selected-window)) )) (if three-way-comparison (or done-C ; Buf C to be set in its own frame (progn ; It was not set up yet as it wasn't visible (select-window orig-wind) (delete-other-windows) (switch-to-buffer buf-C) (setq wind-C (selected-window)) ))) (ediff-eval-in-buffer control-buf (setq ediff-window-A wind-A ediff-window-B wind-B ediff-window-C wind-C) (setq frame-A (window-frame ediff-window-A) designated-minibuffer-frame (window-frame (minibuffer-window frame-A)))) ;; It is unlikely that we'll implement ediff-windows that would compare ;; 3 windows at once. So, we don't use buffer C here. (if ediff-windows-job (progn (set-window-start wind-A wind-A-start) (set-window-start wind-B wind-B-start))) (ediff-setup-control-frame control-buf designated-minibuffer-frame) )) ;; skip unsplittable and dedicated windows ;; create a new splittable frame if none is found (defun ediff-skip-unsuitable-frames (&optional ok-unsplittable) (if (ediff-window-display-p) (let (last-window) (while (and (not (eq (selected-window) last-window)) (or (window-dedicated-p (selected-window)) (ediff-frame-iconified-p (selected-frame)) (if ok-unsplittable nil (ediff-frame-unsplittable-p (selected-frame))))) ;; remember where started (or last-window (setq last-window (selected-window))) ;; try new window (other-window 1 t)) (if (eq (selected-window) last-window) ;; fed up, no appropriate frame (progn ;;(redraw-display) (select-frame (make-frame '((unsplittable))))))))) ;; Prepare or refresh control frame (defun ediff-setup-control-frame (ctl-buffer designated-minibuffer-frame) (let ((window-min-height 2) ctl-frame-iconified-p dont-iconify-ctl-frame deiconify-ctl-frame ctl-frame old-ctl-frame lines user-grabbed-mouse fheight fwidth adjusted-parameters) (ediff-eval-in-buffer ctl-buffer (if ediff-xemacs-p (set-buffer-menubar nil)) ;;(setq user-grabbed-mouse (ediff-user-grabbed-mouse)) (run-hooks 'ediff-before-setup-control-frame-hook)) (setq old-ctl-frame (ediff-eval-in-buffer ctl-buffer ediff-control-frame)) ;; Delete the old ctl frame and get a new ctl frame. ;; The old ctl frame is deleted to let emacs reset default minibuffer ;; frame or when the ctl frame needs to be moved. ;; The old frame isn't reused, since ediff-setup-control-frame is called ;; very rarely, so the overhead is minimal. (if (frame-live-p old-ctl-frame) (delete-frame old-ctl-frame)) ;;(redraw-display) ;; new ctl frame should be created while ctl-buff is current, so that ;; the local default-minibuffer-frame will be consulted and ;; that ediff-control-frame-parameters will have the right value. (ediff-eval-in-buffer ctl-buffer (let ((default-minibuffer-frame designated-minibuffer-frame)) (setq ctl-frame (make-frame ediff-control-frame-parameters) ediff-control-frame ctl-frame))) (setq ctl-frame-iconified-p (ediff-frame-iconified-p ctl-frame)) (select-frame ctl-frame) (if (window-dedicated-p (selected-window)) () (delete-other-windows) (switch-to-buffer ctl-buffer)) ;; must be before ediff-setup-control-buffer ;; just a precaution--we should be in ctl-buffer already (ediff-eval-in-buffer ctl-buffer (make-local-variable 'frame-title-format) (make-local-variable 'frame-icon-title-format) ; XEmacs (make-local-variable 'icon-title-format)) ; Emacs (ediff-setup-control-buffer ctl-buffer) (setq dont-iconify-ctl-frame (not (string= ediff-help-message ediff-brief-help-message))) (setq deiconify-ctl-frame (and (eq this-command 'ediff-toggle-help) dont-iconify-ctl-frame)) ;; 1 more line for the modeline (setq lines (if ediff-xemacs-p (+ 2 (count-lines (point-min) (point-max))) (1+ (count-lines (point-min) (point-max)))) fheight lines fwidth (+ (ediff-help-message-line-length) 2) adjusted-parameters (append (list '(visibility . t) (cons 'width fwidth) (cons 'height fheight)) (funcall ediff-control-frame-position-function ctl-buffer fwidth fheight))) (if ediff-prefer-long-help-message (setq adjusted-parameters (cons '(auto-raise . nil) adjusted-parameters))) ;; In XEmacs, buffer menubar needs to be killed before frame parameters ;; are changed. (if ediff-xemacs-p (progn (set-specifier top-toolbar-height (list ctl-frame 0)) (set-specifier bottom-toolbar-height (list ctl-frame 0)) (set-specifier left-toolbar-width (list ctl-frame 0)) (set-specifier right-toolbar-width (list ctl-frame 0)) ;; XEmacs needed a redisplay, as it had trouble setting ;; height correctly otherwise. ;;(sit-for 0) )) ;; Under OS/2 (emx) we have to call modify frame parameters twice, in ;; order to make sure that at least once we do it for non-iconified ;; frame. If appears that in the OS/2 port of Emacs, one can't modify ;; frame parameters of iconified frames. (if (eq system-type 'emx) (modify-frame-parameters ctl-frame adjusted-parameters)) (goto-char (point-min)) (modify-frame-parameters ctl-frame adjusted-parameters) ;; This works around a bug in 19.25 and earlier. There, if frame gets ;; iconified, the current buffer changes to that of the frame that ;; becomes exposed as a result of this iconification. ;; So, we make sure the current buffer doesn't change. (select-frame ctl-frame) (ediff-refresh-control-frame) (cond ((and ediff-prefer-iconified-control-frame (not ctl-frame-iconified-p) (not dont-iconify-ctl-frame)) (iconify-frame ctl-frame)) ((or deiconify-ctl-frame (not ctl-frame-iconified-p)) (raise-frame ctl-frame))) (if ediff-xemacs-p (set-window-buffer-dedicated (selected-window) ctl-buffer) (set-window-dedicated-p (selected-window) t)) ;; resynch so the cursor will move to control frame ;; per RMS suggestion (let ((count 7)) (sit-for .1) (while (and (not (frame-visible-p ctl-frame)) (> count 0)) (setq count (1- count)) (sit-for .3))) (or (ediff-frame-iconified-p ctl-frame) ;; don't warp the mouse, unless ediff-grab-mouse = t (ediff-reset-mouse ctl-frame (not (eq ediff-grab-mouse t)))) (if ediff-xemacs-p (ediff-eval-in-buffer ctl-buffer (make-local-variable 'select-frame-hook) (add-hook 'select-frame-hook 'ediff-xemacs-select-frame-hook) )) (ediff-eval-in-buffer ctl-buffer (run-hooks 'ediff-after-setup-control-frame-hook)) )) (defun ediff-destroy-control-frame (ctl-buffer) (ediff-eval-in-buffer ctl-buffer (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame)) (let ((ctl-frame ediff-control-frame)) (if ediff-xemacs-p (set-buffer-menubar default-menubar)) (setq ediff-control-frame nil) (delete-frame ctl-frame) ))) (ediff-skip-unsuitable-frames) ;;(ediff-reset-mouse nil) ) ;; finds a good place to clip control frame (defun ediff-make-frame-position (ctl-buffer ctl-frame-width ctl-frame-height) (ediff-eval-in-buffer ctl-buffer (let* ((frame-A (window-frame ediff-window-A)) (frame-A-parameters (frame-parameters frame-A)) (frame-A-top (eval (cdr (assoc 'top frame-A-parameters)))) (frame-A-left (eval (cdr (assoc 'left frame-A-parameters)))) (frame-A-width (frame-width frame-A)) (ctl-frame ediff-control-frame) horizontal-adjustment upward-adjustment ctl-frame-top ctl-frame-left) ;; Multiple control frames are clipped based on the value of ;; ediff-control-buffer-number. This is done in order not to obscure ;; other active control panels. (setq horizontal-adjustment (* 2 ediff-control-buffer-number) upward-adjustment (* -14 ediff-control-buffer-number)) (setq ctl-frame-top (- frame-A-top upward-adjustment ediff-control-frame-upward-shift) ctl-frame-left (+ frame-A-left (if ediff-prefer-long-help-message (* (ediff-frame-char-width ctl-frame) (+ ediff-wide-control-frame-rightward-shift horizontal-adjustment)) (- (* frame-A-width (ediff-frame-char-width frame-A)) (* (ediff-frame-char-width ctl-frame) (+ ctl-frame-width ediff-narrow-control-frame-leftward-shift horizontal-adjustment)))))) ;; keep ctl frame within the visible bounds (setq ctl-frame-top (max ctl-frame-top 1) ctl-frame-left (max ctl-frame-left 1)) (setq ctl-frame-top (min ctl-frame-top (- (ediff-display-pixel-height) (* 2 ctl-frame-height (ediff-frame-char-height ctl-frame)))) ctl-frame-left (min ctl-frame-left (- (ediff-display-pixel-width) (* ctl-frame-width (ediff-frame-char-width ctl-frame))))) (list (cons 'top ctl-frame-top) (cons 'left ctl-frame-left)) ))) (defun ediff-xemacs-select-frame-hook () (if (and (equal (selected-frame) ediff-control-frame) (not ediff-prefer-long-help-message)) (raise-frame ediff-control-frame))) (defun ediff-make-wide-display () "Construct an alist of parameters for the wide display. Saves the old frame parameters in `ediff-wide-display-orig-parameters'. The frame to be resized is kept in `ediff-wide-display-frame'. This function modifies only the left margin and the width of the display. It assumes that it is called from within the control buffer." (if (not (fboundp 'ediff-display-pixel-width)) (error "Can't determine display width.")) (let* ((frame-A (window-frame ediff-window-A)) (frame-A-params (frame-parameters frame-A)) (cw (ediff-frame-char-width frame-A)) (wd (- (/ (ediff-display-pixel-width) cw) 5))) (setq ediff-wide-display-orig-parameters (list (cons 'left (max 0 (eval (cdr (assoc 'left frame-A-params))))) (cons 'width (cdr (assoc 'width frame-A-params)))) ediff-wide-display-frame frame-A) (modify-frame-parameters frame-A (list (cons 'left cw) (cons 'width wd))))) ;; Revise the mode line to display which difference we have selected ;; Also resets modelines of buffers A/B, since they may be clobbered by ;; anothe invocations of Ediff. (defun ediff-refresh-mode-lines () (let (buf-A-state-diff buf-B-state-diff buf-C-state-diff buf-C-state-merge) (if (ediff-valid-difference-p) (setq buf-C-state-diff (ediff-get-state-of-diff ediff-current-difference 'C) buf-C-state-merge (ediff-get-state-of-merge ediff-current-difference) buf-A-state-diff (ediff-get-state-of-diff ediff-current-difference 'A) buf-B-state-diff (ediff-get-state-of-diff ediff-current-difference 'B) buf-A-state-diff (if buf-A-state-diff (format "[%s] " buf-A-state-diff) "") buf-B-state-diff (if buf-B-state-diff (format "[%s] " buf-B-state-diff) "") buf-C-state-diff (if (and (ediff-buffer-live-p ediff-buffer-C) (or buf-C-state-diff buf-C-state-merge)) (format "[%s%s%s] " (or buf-C-state-diff "") (if buf-C-state-merge (concat " " buf-C-state-merge) "") (if (ediff-get-state-of-ancestor ediff-current-difference) " AncestorEmpty" "") ) "")) (setq buf-A-state-diff "" buf-B-state-diff "" buf-C-state-diff "")) ;; control buffer format (setq mode-line-format (list (if (ediff-narrow-control-frame-p) " " "-- ") mode-line-buffer-identification " Howdy!")) ;; control buffer id (setq mode-line-buffer-identification (if (ediff-narrow-control-frame-p) (ediff-make-narrow-control-buffer-id 'skip-name) (ediff-make-wide-control-buffer-id))) ;; Force mode-line redisplay (force-mode-line-update) (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame)) (ediff-refresh-control-frame)) (ediff-eval-in-buffer ediff-buffer-A (setq ediff-diff-status buf-A-state-diff) (ediff-strip-mode-line-format) (setq mode-line-format (list " A: " 'ediff-diff-status mode-line-format)) (force-mode-line-update)) (ediff-eval-in-buffer ediff-buffer-B (setq ediff-diff-status buf-B-state-diff) (ediff-strip-mode-line-format) (setq mode-line-format (list " B: " 'ediff-diff-status mode-line-format)) (force-mode-line-update)) (if ediff-3way-job (ediff-eval-in-buffer ediff-buffer-C (setq ediff-diff-status buf-C-state-diff) (ediff-strip-mode-line-format) (setq mode-line-format (list " C: " 'ediff-diff-status mode-line-format)) (force-mode-line-update))) (if (ediff-buffer-live-p ediff-ancestor-buffer) (ediff-eval-in-buffer ediff-ancestor-buffer (ediff-strip-mode-line-format) ;; we keep the second dummy string in the mode line format of the ;; ancestor, since for other buffers Ediff prepends 2 strings and ;; ediff-strip-mode-line-format expects that. (setq mode-line-format (list " Ancestor: " (cond ((not (stringp buf-C-state-merge)) "") ((string-match "prefer-A" buf-C-state-merge) "[=diff(B)] ") ((string-match "prefer-B" buf-C-state-merge) "[=diff(A)] ") (t "")) mode-line-format)))) )) (defun ediff-refresh-control-frame () (setq frame-title-format (ediff-make-narrow-control-buffer-id) frame-icon-title-format (ediff-make-narrow-control-buffer-id) ; XEmacs icon-title-format (ediff-make-narrow-control-buffer-id)) ; Emacs ;; the emacs part will be modified once the 'name and 'title ;; frame parameters are separated (if ediff-emacs-p (modify-frame-parameters ediff-control-frame (list (cons 'name (ediff-make-narrow-control-buffer-id)))) ;; force an update of the frame title (modify-frame-parameters ediff-control-frame '(())))) (defun ediff-make-narrow-control-buffer-id (&optional skip-name) (concat (if skip-name " " (concat (cdr (assoc 'name ediff-control-frame-parameters)) ediff-control-buffer-suffix)) (cond ((< ediff-current-difference 0) (format " _/%d" ediff-number-of-differences)) ((>= ediff-current-difference ediff-number-of-differences) (format " $/%d" ediff-number-of-differences)) (t (format " %d/%d" (1+ ediff-current-difference) ediff-number-of-differences))))) (defun ediff-make-wide-control-buffer-id () (cond ((< ediff-current-difference 0) (list (format "%%b At start of %d diffs" ediff-number-of-differences))) ((>= ediff-current-difference ediff-number-of-differences) (list (format "%%b At end of %d diffs" ediff-number-of-differences))) (t (list (format "%%b diff %d of %d" (1+ ediff-current-difference) ediff-number-of-differences))))) ;; If buff is not live, return nil (defun ediff-get-visible-buffer-window (buff) (if (ediff-buffer-live-p buff) (if ediff-xemacs-p (get-buffer-window buff t) (get-buffer-window buff 'visible)))) ;;; Functions to decide when to redraw windows (defun ediff-keep-window-config (control-buf) (and (eq control-buf (current-buffer)) (/= (buffer-size) 0) (ediff-eval-in-buffer control-buf (let ((ctl-wind ediff-control-window) (A-wind ediff-window-A) (B-wind ediff-window-B) (C-wind ediff-window-C)) (and (ediff-window-visible-p A-wind) (ediff-window-visible-p B-wind) ;; if buffer C is defined then take it into account (or (not ediff-3way-job) (ediff-window-visible-p C-wind)) (eq (window-buffer A-wind) ediff-buffer-A) (eq (window-buffer B-wind) ediff-buffer-B) (or (not ediff-3way-job) (eq (window-buffer C-wind) ediff-buffer-C)) (string= ediff-window-config-saved (format "%S%S%S%S%S%S%S" ctl-wind A-wind B-wind C-wind ediff-split-window-function (ediff-multiframe-setup-p) ediff-wide-display-p))))))) (provide 'ediff-wind) ;;; ediff-wind.el ends here emacs-19.30/lisp/ediff.el100444 12120 1 147715 6054175424 13534 0ustar rmsdaemon;;; ediff.el --- a comprehensive visual interface to diff & patch ;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Created: February 2, 1994 ;; Keywords: comparing, merging, patching, version control. (defconst ediff-version "2.47" "The current version of Ediff") (defconst ediff-date "October 11, 1995" "Date of last update") ;; 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: ;; ---------- ;; Never read that diff output again! ;; Apply patch selectively, like a pro! ;; Merge with ease! ;; This package provides a convenient way of simultaneous browsing through ;; the differences between a pair (or a triple) of files or buffers. The ;; files being compared, file-A, file-B, and file-C (if applicable) are ;; shown in separate windows (side by side, one above the another, or in ;; separate frames), and the differences are highlighted as you step ;; through them. You can also copy difference regions from one buffer to ;; another (and recover old differences if you change your mind). ;; Ediff also supports merging operations on files and buffers, including ;; merging using ancestor versions. Both comparison and merging operations can ;; be performed on directories, i.e., by pairwise comparison of files in those ;; directories. ;; In addition, Ediff can apply a patch to a file and then let you step ;; though both files, the patched and the original one, simultaneously, ;; difference-by-difference. You can even apply a patch right out of a ;; mail buffer, i.e., patches received by mail don't even have to be saved. ;; Since Ediff lets you copy differences between buffers, you can, in ;; effect, apply patches selectively (i.e., you can copy a difference ;; region from file_orig to file, thereby undoing any particular patch that ;; you don't like). ;; Ediff is aware of version control, which lets the user compare ;; files with their older versions. Ediff can also work with remote and ;; compressed files. Details are given below. ;; Finally, Ediff supports directory-level comparison and merging operations. ;; See the on-line manual for details. ;; This package builds upon the ideas borrowed from emerge.el and several ;; Ediff's functions are adaptations from emerge.el. Much of the functionality ;; Ediff provides is also influenced by emerge.el. ;; The present version of Ediff supersedes Emerge. It provides a superior user ;; interface and has numerous major features not found in Emerge. In ;; particular, it can do patching, and 2-way and 3-way file comparison, ;; merging, and directory operations. ;;; Bugs: ;; ----- ;; 1. The undo command doesn't restore deleted regions well. That is, if ;; you delete all characters in a difference region and then invoke ;; `undo', the reinstated text will most likely be inserted outside of ;; what Ediff thinks is the current difference region. (This problem ;; doesn't seem to exist with XEmacs.) ;; ;; If at any point you feel that difference regions are no longer correct, ;; you can hit '!' to recompute the differences. ;; 2. On a monochrome display, the repertoire of faces with which to ;; highlight fine differences is limited. By default, Ediff is using ;; underlining. However, if the region is already underlied by some other ;; overlays, there is no simple way to temporarily remove that residual ;; underlining. This problem occurs when a buffer is highlighted with ;; hilit19.el or font-lock.el packages. If this residual highlighting gets ;; in the way, you can do the following. Both font-lock.el and hilit19.el ;; provide commands for unhighlighting buffers. You can either place these ;; commands in `ediff-prepare-buffer-hook' (which will unhighlight every ;; buffer used by Ediff) or you can execute them interactively, at any time ;; and on any buffer. ;; ;;; Acknowledgements: ;; Ediff was inspired by Dale R. Worley's emerge.el. ;; Ediff would not have been possible without the help and encouragement of ;; its many users. See Ediff on-line Info for the full list of those who ;; helped. Improved defaults in Ediff file-name reading commands. ;;; Code: (require 'ediff-init) (require 'ediff-mult) (defvar ediff-use-last-dir nil "*If t, Ediff uses previous directory as default when reading file name.") (defvar ediff-last-dir-A nil "Last directory used by an Ediff command for file-A.") (defvar ediff-last-dir-B nil "Last directory used by an Ediff command for file-B.") (defvar ediff-last-dir-C nil "Last directory used by an Ediff command for file-C.") (defvar ediff-last-dir-ancestor nil "Last directory used by an Ediff command for the ancestor file.") (defvar ediff-last-dir-patch nil "Last directory used by an Ediff command for file to patch.") ;;; Patching (defvar ediff-backup-extension (if (memq system-type '(vax-vms axp-vms emx ms-dos windows-nt windows-95)) "_orig" ".orig") "Default backup extension for the patch program.") ;;;###autoload (defun ediff-patch-file (source-filename &optional startup-hooks job-name) "Run Ediff by patching FILE-TP-PATCH." ;; This now returns the control buffer (interactive (list (ediff-read-file-name "File to patch" (if ediff-use-last-dir ediff-last-dir-patch default-directory) (ediff-get-default-file-name)))) (setq source-filename (expand-file-name source-filename)) (ediff-get-patch-buffer (if (eq job-name 'ediff-patch-buffer) (ediff-eval-in-buffer (get-file-buffer source-filename) default-directory) (file-name-directory source-filename))) (let* ((backup-extension ;; if the user specified a -b option, extract the backup ;; extension from there; else use ediff-backup-extension (substring ediff-patch-options (if (string-match "-b[ \t]+" ediff-patch-options) (match-end 0) 0) (if (string-match "-b[ \t]+[^ \t]+" ediff-patch-options) (match-end 0) 0))) (shell-file-name ediff-shell) ;; ediff-find-file may use a temp file to do the patch ;; so, we save source-filename and true-source-filename as a var ;; that initially is source-filename but may be changed to a temp ;; file for the purpose of patching. (true-source-filename source-filename) (target-filename source-filename) target-buf buf-to-patch file-name-magic-p ctl-buf) ;; if the user didn't specify a backup extension, use ;; ediff-backup-extension (if (string= backup-extension "") (setq backup-extension ediff-backup-extension)) ;; Make a temp file, if source-filename has a magic file handler (or if ;; it is handled via auto-mode-alist and similar magic). ;; Check if there is a buffer visiting source-filename and if they are in ;; synch; arrange for the deletion of temp file. (ediff-find-file 'true-source-filename 'buf-to-patch 'ediff-last-dir-patch 'startup-hooks) ;; Check if source file name has triggered black magic, such as file name ;; handlers or auto mode alist, and make a note of it. ;; true-source-filename should be either the original name or a ;; temporary file where we put the after-product of the file handler. (setq file-name-magic-p (not (equal (file-truename true-source-filename) (file-truename source-filename)))) ;; Checkout orig file, if necessary, so that the patched file could be ;; checked back in. (if (ediff-file-checked-in-p (buffer-file-name buf-to-patch)) (ediff-toggle-read-only buf-to-patch)) (ediff-eval-in-buffer ediff-patch-diagnostics (message "Applying patch ... ") ;;(sit-for 0) ;; always pass patch the -f option, so it won't ask any questions (shell-command-on-region (point-min) (point-max) (format "%s -f %s -b %s %s" ediff-patch-program ediff-patch-options backup-extension (expand-file-name true-source-filename)) t)) ;;(message "Applying patch ... done")(sit-for 0) (switch-to-buffer ediff-patch-diagnostics) (sit-for 0) ; synchronize - let the user see diagnostics (or (file-exists-p (concat true-source-filename backup-extension)) (error "Patch failed or didn't modify the original file")) ;; If black magic is involved, apply patch to a temp copy of the ;; file. Otherwise, apply patch to the orig copy. If patch is applied ;; to temp copy, we name the result old-name_patched for local files ;; and temp-copy_patched for remote files. The orig file name isn't ;; changed, and the temp copy of the original is later deleted. ;; Without magic, the original file is renamed (usually into ;; old-name_orig) and the result of patching will have the same name as ;; the original. (if (not file-name-magic-p) (ediff-eval-in-buffer buf-to-patch (set-visited-file-name (concat source-filename backup-extension)) (set-buffer-modified-p nil)) ;; Black magic in effect. ;; If orig file was remote, put the patched file in the temp directory. ;; If orig file is local, put the patched file in the directory of ;; the orig file. (setq target-filename (concat (if (ediff-file-remote-p (file-truename source-filename)) true-source-filename source-filename) "_patched")) (rename-file true-source-filename target-filename t) ;; arrange that the temp copy of orig will be deleted (rename-file (concat true-source-filename backup-extension) true-source-filename t)) ;; make orig buffer read-only (setq startup-hooks (cons 'ediff-set-read-only-in-buf-A startup-hooks)) ;; set up a buf for the patched file (setq target-buf (find-file-noselect target-filename)) (setq ctl-buf (ediff-buffers-internal buf-to-patch target-buf nil startup-hooks (or job-name 'ediff-patch-file))) (bury-buffer ediff-patch-diagnostics) (message "Patch diagnostics are available in buffer %s" (buffer-name ediff-patch-diagnostics)) ctl-buf)) (defun ediff-set-read-only-in-buf-A () "Used as a startup hook to set `_orig' patch file read-only." (ediff-eval-in-buffer ediff-buffer-A (toggle-read-only 1))) ;; Return a plausible default for ediff's first file: ;; In dired, return the file name under the point, unless it is a directory ;; If the buffer has a file name, return that file name. (defun ediff-get-default-file-name () (cond ((eq major-mode 'dired-mode) (let ((f (dired-get-filename nil 'no-error))) (if (and (stringp f) (not (file-directory-p f))) f))) ((buffer-file-name (current-buffer)) (file-name-nondirectory (buffer-file-name (current-buffer)))) )) ;;;###autoload (defalias 'epatch 'ediff-patch-file) ;;;###autoload (defalias 'epatch-buffer 'ediff-patch-buffer) ;;; Compare files/buffers ;;;###autoload (defun ediff-files (file-A file-B &optional startup-hooks) "Run Ediff on a pair of files, FILE-A and FILE-B." (interactive (let ((dir-A (if ediff-use-last-dir ediff-last-dir-A default-directory)) dir-B f) (list (setq f (ediff-read-file-name "File A to compare" dir-A (ediff-get-default-file-name))) (ediff-read-file-name "File B to compare" (setq dir-B (if ediff-use-last-dir ediff-last-dir-B (file-name-directory f))) (progn (setq file-name-history (cons (ediff-abbreviate-file-name (expand-file-name (file-name-nondirectory f) dir-B)) file-name-history)) f)) ))) (ediff-files-internal file-A (if (file-directory-p file-B) (expand-file-name (file-name-nondirectory file-A) file-B) file-B) nil ; file-C startup-hooks 'ediff-files)) ;;;###autoload (defun ediff-files3 (file-A file-B file-C &optional startup-hooks) "Run Ediff on three files, FILE-A, FILE-B, and FILE-C." (interactive (let ((dir-A (if ediff-use-last-dir ediff-last-dir-A default-directory)) dir-B dir-C f ff) (list (setq f (ediff-read-file-name "File A to compare" dir-A (ediff-get-default-file-name))) (setq ff (ediff-read-file-name "File B to compare" (setq dir-B (if ediff-use-last-dir ediff-last-dir-B (file-name-directory f))) (progn (setq file-name-history (cons (ediff-abbreviate-file-name (expand-file-name (file-name-nondirectory f) dir-B)) file-name-history)) f))) (ediff-read-file-name "File C to compare" (setq dir-C (if ediff-use-last-dir ediff-last-dir-C (file-name-directory ff))) (progn (setq file-name-history (cons (ediff-abbreviate-file-name (expand-file-name (file-name-nondirectory ff) dir-C)) file-name-history)) ff)) ))) (ediff-files-internal file-A (if (file-directory-p file-B) (expand-file-name (file-name-nondirectory file-A) file-B) file-B) (if (file-directory-p file-C) (expand-file-name (file-name-nondirectory file-A) file-C) file-C) startup-hooks 'ediff-files3)) ;;;###autoload (defalias 'ediff3 'ediff-files3) (defun ediff-find-file (file-var buffer-name &optional last-dir hooks-var) "Visit FILE and arrange its buffer to Ediff's liking. FILE is actually a variable symbol that must contain a true file name. BUFFER-NAME is a variable symbol, which will get the buffer object into which FILE is read. LAST-DIR is the directory variable symbol where FILE's directory name should be returned. HOOKS is a variable symbol that will be assigned the hook to be executed after `ediff-startup' is finished. `ediff-find-file' arranges that the temp files it might create will be deleted." (let* ((file (symbol-value file-var)) (file-magic (find-file-name-handler file 'find-file-noselect)) (temp-file-name-prefix (file-name-nondirectory file))) (cond ((not (file-readable-p file)) (error "File `%s' does not exist or is not readable" file)) ((file-directory-p file) (error "File `%s' is a directory" file))) ;; some of the command, below, require full file name (setq file (expand-file-name file)) ;; Record the directory of the file (if last-dir (set last-dir (expand-file-name (file-name-directory file)))) ;; Setup the buffer (set buffer-name (find-file-noselect file)) (ediff-eval-in-buffer (symbol-value buffer-name) (widen) ; Make sure the entire file is seen (cond (file-magic ;; file has handler, such as jka-compr-handler or ;; ange-ftp-hook-function--arrange for temp file (ediff-verify-file-buffer 'magic) (setq file (ediff-make-temp-file (current-buffer) temp-file-name-prefix)) (set hooks-var (cons (` (lambda () (delete-file (, file)))) (symbol-value hooks-var)))) ;; file processed via auto-mode-alist, a la uncompress.el ((not (equal (file-truename file) (file-truename (buffer-file-name)))) (setq file (ediff-make-temp-file (current-buffer) temp-file-name-prefix)) (set hooks-var (cons (` (lambda () (delete-file (, file)))) (symbol-value hooks-var)))) (t ;; plain file---just check that the file matches the buffer (ediff-verify-file-buffer)))) (set file-var file))) (defun ediff-files-internal (file-A file-B file-C startup-hooks job-name) (let (buf-A buf-B buf-C) (message "Reading file %s ... " file-A) ;;(sit-for 0) (ediff-find-file 'file-A 'buf-A 'ediff-last-dir-A 'startup-hooks) (message "Reading file %s ... " file-B) ;;(sit-for 0) (ediff-find-file 'file-B 'buf-B 'ediff-last-dir-B 'startup-hooks) (if (stringp file-C) (progn (message "Reading file %s ... " file-C) ;;(sit-for 0) (ediff-find-file 'file-C 'buf-C (if (eq job-name 'ediff-merge-files-with-ancestor) 'ediff-last-dir-ancestor 'ediff-last-dir-C) 'startup-hooks))) (ediff-setup buf-A file-A buf-B file-B buf-C file-C startup-hooks (list (cons 'ediff-job-name job-name))))) ;;;###autoload (defalias 'ediff 'ediff-files) ;;;###autoload (defun ediff-buffers (buffer-A buffer-B &optional startup-hooks job-name) "Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B." (interactive (let (bf) (list (setq bf (read-buffer "Buffer A to compare: " (ediff-other-buffer "") t)) (read-buffer "Buffer B to compare: " (progn ;; realign buffers so that two visible bufs will be ;; at the top (save-window-excursion (other-window 1)) (ediff-other-buffer bf)) t)))) (or job-name (setq job-name 'ediff-buffers)) (ediff-buffers-internal buffer-A buffer-B nil startup-hooks job-name)) ;;;###autoload (defun ediff-buffers3 (buffer-A buffer-B buffer-C &optional startup-hooks job-name) "Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C." (interactive (let (bf bff) (list (setq bf (read-buffer "Buffer A to compare: " (ediff-other-buffer "") t)) (setq bff (read-buffer "Buffer B to compare: " (progn ;; realign buffers so that two visible ;; bufs will be at the top (save-window-excursion (other-window 1)) (ediff-other-buffer bf)) t)) (read-buffer "Buffer C to compare: " (progn ;; realign buffers so that three visible ;; bufs will be at the top (save-window-excursion (other-window 1)) (ediff-other-buffer (list bf bff))) t) ))) (or job-name (setq job-name 'ediff-buffers3)) (ediff-buffers-internal buffer-A buffer-B buffer-C startup-hooks job-name)) (defun ediff-buffers-internal (buf-A buf-B buf-C startup-hooks job-name) (let* ((buf-A-file-name (buffer-file-name (get-buffer buf-A))) (buf-B-file-name (buffer-file-name (get-buffer buf-B))) (buf-C-is-alive (ediff-buffer-live-p buf-C)) (buf-C-file-name (if buf-C-is-alive (buffer-file-name (get-buffer buf-B)))) file-A file-B file-C) (if (not (ediff-buffer-live-p buf-A)) (error "Buffer %S doesn't exist" buf-A)) (if (not (ediff-buffer-live-p buf-B)) (error "Buffer %S doesn't exist" buf-B)) (let ((ediff-job-name job-name)) (if (and ediff-3way-comparison-job (not buf-C-is-alive)) (error "Buffer %S doesn't exist" buf-C))) (if (stringp buf-A-file-name) (setq buf-A-file-name (file-name-nondirectory buf-A-file-name))) (if (stringp buf-B-file-name) (setq buf-B-file-name (file-name-nondirectory buf-B-file-name))) (if (stringp buf-C-file-name) (setq buf-C-file-name (file-name-nondirectory buf-C-file-name))) (setq file-A (ediff-make-temp-file buf-A buf-A-file-name)) (setq file-B (ediff-make-temp-file buf-B buf-B-file-name)) (if buf-C-is-alive (setq file-C (ediff-make-temp-file buf-C buf-C-file-name))) (ediff-setup (get-buffer buf-A) file-A (get-buffer buf-B) file-B (if buf-C-is-alive (get-buffer buf-C)) file-C (cons (` (lambda () (delete-file (, file-A)) (delete-file (, file-B)) (if (stringp (, file-C)) (delete-file (, file-C))) )) startup-hooks) (list (cons 'ediff-job-name job-name)) ))) ;;; Directory and file group operations ;; Get appropriate default name for directory: ;; If ediff-use-last-dir, use ediff-last-dir-A. ;; In dired mode, use the directory that is under the point (if any); ;; otherwise, use default-directory (defun ediff-get-default-directory-name () (cond (ediff-use-last-dir ediff-last-dir-A) ((eq major-mode 'dired-mode) (let ((f (dired-get-filename nil 'noerror))) (if (and (stringp f) (file-directory-p f)) f default-directory))) (t default-directory))) ;;;###autoload (defun ediff-directories (dir1 dir2 regexp) "Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have the same name in both. The third argument, REGEXP, is a regular expression that further filters the file names." (interactive (let ((dir-A (ediff-get-default-directory-name)) f) (list (setq f (ediff-read-file-name "Directory A to compare" dir-A nil)) (ediff-read-file-name "Directory B to compare" (if ediff-use-last-dir ediff-last-dir-B (ediff-strip-last-dir f)) nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history) ))) (ediff-directories-internal dir1 dir2 nil regexp 'ediff-files 'ediff-directories )) ;;;###autoload (defalias 'edirs 'ediff-directories) ;;;###autoload (defun ediff-directory-revisions (dir1 regexp) "Run Ediff on a directory, DIR1, comparing its files with their revisions. The second argument, REGEXP, is a regular expression that filters the file names. Only the files that are under revision control are taken into account." (interactive (let ((dir-A (ediff-get-default-directory-name))) (list (ediff-read-file-name "Directory to compare with revision" dir-A nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history) ))) (ediff-directory-revisions-internal dir1 regexp 'ediff-revision 'ediff-directory-revisions )) ;;;###autoload (defalias 'edir-revisions 'ediff-directory-revisions) ;;;###autoload (defun ediff-directories3 (dir1 dir2 dir3 regexp) "Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that have the same name in all three. The last argument, REGEXP, is a regular expression that further filters the file names." (interactive (let ((dir-A (ediff-get-default-directory-name)) f) (list (setq f (ediff-read-file-name "Directory A to compare" dir-A nil)) (setq f (ediff-read-file-name "Directory B to compare" (if ediff-use-last-dir ediff-last-dir-B (ediff-strip-last-dir f)) nil)) (ediff-read-file-name "Directory C to compare" (if ediff-use-last-dir ediff-last-dir-C (ediff-strip-last-dir f)) nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history) ))) (ediff-directories-internal dir1 dir2 dir3 regexp 'ediff-files3 'ediff-directories3 )) ;;;###autoload (defalias 'edirs3 'ediff-directories3) ;;;###autoload (defun ediff-merge-directories (dir1 dir2 regexp) "Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have the same name in both. The third argument, REGEXP, is a regular expression that further filters the file names." (interactive (let ((dir-A (ediff-get-default-directory-name)) f) (list (setq f (ediff-read-file-name "Directory A to merge" dir-A nil)) (ediff-read-file-name "Directory B to merge" (if ediff-use-last-dir ediff-last-dir-B (ediff-strip-last-dir f)) nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history) ))) (ediff-directories-internal dir1 dir2 nil regexp 'ediff-merge-files 'ediff-merge-directories )) ;;;###autoload (defalias 'edirs-merge 'ediff-merge-directories) ;;;###autoload (defun ediff-merge-directories-with-ancestor (dir1 dir2 dir3 regexp) "Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have the same name in both. The third argument, REGEXP, is a regular expression that further filters the file names." (interactive (let ((dir-A (ediff-get-default-directory-name)) f) (list (setq f (ediff-read-file-name "Directory A to merge" dir-A nil)) (setq f (ediff-read-file-name "Directory B to merge" (if ediff-use-last-dir ediff-last-dir-B (ediff-strip-last-dir f)) nil)) (ediff-read-file-name "Ancestor directory: " (if ediff-use-last-dir ediff-last-dir-C (ediff-strip-last-dir f)) nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history) ))) (ediff-directories-internal dir1 dir2 dir3 regexp 'ediff-merge-files-with-ancestor 'ediff-merge-directories-with-ancestor )) ;;;###autoload (defun ediff-merge-directory-revisions (dir1 regexp) "Run Ediff on a directory, DIR1, merging its files with their revisions. The second argument, REGEXP, is a regular expression that filters the file names. Only the files that are under revision control are taken into account." (interactive (let ((dir-A (ediff-get-default-directory-name))) (list (ediff-read-file-name "Directory to merge with revisions" dir-A nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history) ))) (ediff-directory-revisions-internal dir1 regexp 'ediff-merge-revisions 'ediff-merge-directory-revisions )) ;;;###autoload (defalias 'edir-merge-revisions 'ediff-merge-directory-revisions) ;;;###autoload (defun ediff-merge-directory-revisions-with-ancestor (dir1 regexp) "Run Ediff on a directory, DIR1, merging its files with their revisions and ancestors. The second argument, REGEXP, is a regular expression that filters the file names. Only the files that are under revision control are taken into account." (interactive (let ((dir-A (ediff-get-default-directory-name))) (list (ediff-read-file-name "Directory to merge with revisions and ancestors" dir-A nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history) ))) (ediff-directory-revisions-internal dir1 regexp 'ediff-merge-revisions-with-ancestor 'ediff-merge-directory-revisions-with-ancestor )) ;;;###autoload (defalias 'edir-merge-revisions-with-ancestor 'ediff-merge-directory-revisions-with-ancestor) ;;;###autoload (defalias 'edirs-merge-with-ancestor 'ediff-merge-directories-with-ancestor) ;; Run ediff-action (ediff-files, ediff-merge, ediff-merge-with-ancestors) ;; on a pair of directories (three directories, in case of ancestor). ;; The third argument, REGEXP, is a regular expression that further filters the ;; file names. ;; JOBNAME is the symbol indicating the meta-job to be performed. (defun ediff-directories-internal (dir1 dir2 dir3 regexp action jobname &optional startup-hooks) ;; ediff-read-file-name is set to attach a previously entered file name if ;; the currently entered file is a directory. This code takes care of that. (setq dir1 (if (file-directory-p dir1) dir1 (file-name-directory dir1)) dir2 (if (file-directory-p dir2) dir2 (file-name-directory dir2))) (if (stringp dir3) (setq dir3 (if (file-directory-p dir3) dir3 (file-name-directory dir3)))) (cond ((string= dir1 dir2) (error "Directories A and B are the same: %s" dir1)) ((and (eq jobname 'ediff-directories3) (string= dir1 dir3)) (error "Directories A and C are the same: %s" dir1)) ((and (eq jobname 'ediff-directories3) (string= dir2 dir3)) (error "Directories B and C are the same: %s" dir1))) (let (diffs ; var where ediff-intersect-directories returns the diff list file-list meta-buf) (setq file-list (ediff-intersect-directories jobname 'diffs regexp dir1 dir2 dir3)) (setq startup-hooks ;; this sets various vars in the meta buffer inside ;; ediff-prepare-meta-buffer (cons (` (lambda () ;; tell what to do if the user clicks on a session record (setq ediff-session-action-function (quote (, action))) ;; set ediff-dir-difference-list (setq ediff-dir-difference-list (quote (, diffs))))) startup-hooks)) (setq meta-buf (ediff-prepare-meta-buffer 'ediff-dir-action file-list "*Ediff Session Group Panel" 'ediff-redraw-directory-group-buffer jobname startup-hooks)) (ediff-show-meta-buffer meta-buf) )) (defun ediff-directory-revisions-internal (dir1 regexp action jobname &optional startup-hooks) (setq dir1 (if (file-directory-p dir1) dir1 (file-name-directory dir1))) (let (file-list meta-buf) (setq file-list (ediff-get-directory-files-under-revision jobname regexp dir1)) (setq startup-hooks ;; this sets various vars in the meta buffer inside ;; ediff-prepare-meta-buffer (cons (` (lambda () ;; tell what to do if the user clicks on a session record (setq ediff-session-action-function (quote (, action))) )) startup-hooks)) (setq meta-buf (ediff-prepare-meta-buffer 'ediff-dir-action file-list "*Ediff Session Group Panel" 'ediff-redraw-directory-group-buffer jobname startup-hooks)) (ediff-show-meta-buffer meta-buf) )) ;;; Compare regions and windows ;;;###autoload (defun ediff-windows-wordwise (dumb-mode &optional wind-A wind-B startup-hooks) "Compare WIND-A and WIND-B, which are selected by clicking, wordwise. With prefix argument, DUMB-MODE, or on a non-windowing display, works as follows: If WIND-A is nil, use selected window. If WIND-B is nil, use window next to WIND-A." (interactive "P") (ediff-windows dumb-mode wind-A wind-B startup-hooks 'ediff-windows-wordwise 'word-mode)) ;;;###autoload (defun ediff-windows-linewise (dumb-mode &optional wind-A wind-B startup-hooks) "Compare WIND-A and WIND-B, which are selected by clicking, linewise. With prefix argument, DUMB-MODE, or on a non-windowing display, works as follows: If WIND-A is nil, use selected window. If WIND-B is nil, use window next to WIND-A." (interactive "P") (ediff-windows dumb-mode wind-A wind-B startup-hooks 'ediff-windows-linewise nil)) ;; Compare WIND-A and WIND-B, which are selected by clicking. ;; With prefix argument, DUMB-MODE, or on a non-windowing display, ;; works as follows: ;; If WIND-A is nil, use selected window. ;; If WIND-B is nil, use window next to WIND-A. (defun ediff-windows (dumb-mode wind-A wind-B startup-hooks job-name word-mode) (if (or dumb-mode (not (ediff-window-display-p))) (setq wind-A (ediff-get-next-window wind-A nil) wind-B (ediff-get-next-window wind-B wind-A)) (setq wind-A (ediff-get-window-by-clicking wind-A nil 1) wind-B (ediff-get-window-by-clicking wind-B wind-A 2))) (let ((buffer-A (window-buffer wind-A)) (buffer-B (window-buffer wind-B)) beg-A end-A beg-B end-B) (save-excursion (save-window-excursion (sit-for 0) ; synch before using window-start/end -- a precaution (select-window wind-A) (setq beg-A (window-start) end-A (window-end)) (select-window wind-B) (setq beg-B (window-start) end-B (window-end)))) (ediff-regions-internal buffer-A beg-A end-A buffer-B beg-B end-B startup-hooks job-name word-mode))) ;;;###autoload (defun ediff-regions-wordwise (buffer-A buffer-B &optional startup-hooks) "Run Ediff on a pair of regions in two different buffers. Regions \(i.e., point and mark\) are assumed to be set in advance. This function is effective only for relatively small regions, up to 200 lines. For large regions, use `ediff-regions-linewise'." (interactive (let (bf) (list (setq bf (read-buffer "Region's A buffer: " (ediff-other-buffer "") t)) (read-buffer "Region's B buffer: " (progn ;; realign buffers so that two visible bufs will be ;; at the top (save-window-excursion (other-window 1)) (ediff-other-buffer bf)) t)))) (if (not (ediff-buffer-live-p buffer-A)) (error "Buffer %S doesn't exist" buffer-A)) (if (not (ediff-buffer-live-p buffer-B)) (error "Buffer %S doesn't exist" buffer-B)) (let (reg-A-beg reg-A-end reg-B-beg reg-B-end) (save-excursion (set-buffer buffer-A) (setq reg-A-beg (region-beginning) reg-A-end (region-end)) (set-buffer buffer-B) (setq reg-B-beg (region-beginning) reg-B-end (region-end))) (ediff-regions-internal (get-buffer buffer-A) reg-A-beg reg-A-end (get-buffer buffer-B) reg-B-beg reg-B-end startup-hooks 'ediff-regions-wordwise 'word-mode))) ;;;###autoload (defun ediff-regions-linewise (buffer-A buffer-B &optional startup-hooks) "Run Ediff on a pair of regions in two different buffers. Regions \(i.e., point and mark\) are assumed to be set in advance. Each region is enlarged to contain full lines. This function is effective for large regions, over 100-200 lines. For small regions, use `ediff-regions-wordwise'." (interactive (let (bf) (list (setq bf (read-buffer "Region A's buffer: " (ediff-other-buffer "") t)) (read-buffer "Region B's buffer: " (progn ;; realign buffers so that two visible bufs will be ;; at the top (save-window-excursion (other-window 1)) (ediff-other-buffer bf)) t)))) (if (not (ediff-buffer-live-p buffer-A)) (error "Buffer %S doesn't exist" buffer-A)) (if (not (ediff-buffer-live-p buffer-B)) (error "Buffer %S doesn't exist" buffer-B)) (let (reg-A-beg reg-A-end reg-B-beg reg-B-end) (save-excursion (set-buffer buffer-A) (setq reg-A-beg (region-beginning) reg-A-end (region-end)) ;; enlarge the region to hold full lines (goto-char reg-A-beg) (beginning-of-line) (setq reg-A-beg (point)) (goto-char reg-A-end) (end-of-line) (or (eobp) (forward-char)) ; include the newline char (setq reg-A-end (point)) (set-buffer buffer-B) (setq reg-B-beg (region-beginning) reg-B-end (region-end)) ;; enlarge the region to hold full lines (goto-char reg-A-beg) (goto-char reg-B-beg) (beginning-of-line) (setq reg-B-beg (point)) (goto-char reg-B-end) (end-of-line) (or (eobp) (forward-char)) ; include the newline char (setq reg-B-end (point)) ) ; save excursion (ediff-regions-internal (get-buffer buffer-A) reg-A-beg reg-A-end (get-buffer buffer-B) reg-B-beg reg-B-end startup-hooks 'ediff-regions-linewise nil))) ; no word mode ;; compare region beg-A to end-A of buffer-A ;; to regions beg-B -- end-B in buffer-B. (defun ediff-regions-internal (buffer-A beg-A end-A buffer-B beg-B end-B startup-hooks job-name word-mode) (let ((tmp-buffer (get-buffer-create ediff-tmp-buffer)) overl-A overl-B file-A file-B) ;; in case beg/end-A/B aren't markers--make them into markers (ediff-eval-in-buffer buffer-A (setq beg-A (move-marker (make-marker) beg-A) end-A (move-marker (make-marker) end-A))) (ediff-eval-in-buffer buffer-B (setq beg-B (move-marker (make-marker) beg-B) end-B (move-marker (make-marker) end-B))) (if (and (eq buffer-A buffer-B) (or (and (< beg-A end-B) (<= beg-B beg-A)) ; b-B b-A e-B (and (< beg-B end-A) (<= end-A end-B)))) ; b-B e-A e-B (progn (with-output-to-temp-buffer ediff-msg-buffer (princ " You have requested to compare overlapping regions of the same buffer. In this case, Ediff's highlighting may be confusing---in the same window, you may see highlighted regions that belong to different regions. Continue anyway? (y/n) ")) (if (y-or-n-p "Continue anyway? ") () (error "%S aborted" job-name)))) ;; make file-A (if word-mode (ediff-wordify beg-A end-A buffer-A tmp-buffer) (ediff-copy-to-buffer beg-A end-A buffer-A tmp-buffer)) (setq file-A (ediff-make-temp-file tmp-buffer "regA")) ;; make file-B (if word-mode (ediff-wordify beg-B end-B buffer-B tmp-buffer) (ediff-copy-to-buffer beg-B end-B buffer-B tmp-buffer)) (setq file-B (ediff-make-temp-file tmp-buffer "regB")) (setq overl-A (ediff-make-bullet-proof-overlay beg-A end-A buffer-A)) (setq overl-B (ediff-make-bullet-proof-overlay beg-B end-B buffer-B)) (ediff-setup buffer-A file-A buffer-B file-B nil nil ; buffer & file C (cons (` (lambda () (delete-file (, file-A)) (delete-file (, file-B)))) startup-hooks) (list (cons 'ediff-word-mode word-mode) (cons 'ediff-narrow-bounds (list overl-A overl-B)) (cons 'ediff-job-name job-name)) ) )) ;;; Merge files and buffers ;;;###autoload (defalias 'ediff-merge 'ediff-merge-files) (defsubst ediff-merge-on-startup () (ediff-do-merge 0) (ediff-eval-in-buffer ediff-buffer-C (set-buffer-modified-p nil))) ;;;###autoload (defun ediff-merge-files (file-A file-B &optional startup-hooks) "Merge two files without ancestor." (interactive (let ((dir-A (if ediff-use-last-dir ediff-last-dir-A default-directory)) dir-B f) (list (setq f (ediff-read-file-name "File A to merge" dir-A (ediff-get-default-file-name))) (ediff-read-file-name "File B to merge" (setq dir-B (if ediff-use-last-dir ediff-last-dir-B (file-name-directory f))) (progn (setq file-name-history (cons (ediff-abbreviate-file-name (expand-file-name (file-name-nondirectory f) dir-B)) file-name-history)) f)) ))) (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks)) (ediff-files-internal file-A (if (file-directory-p file-B) (expand-file-name (file-name-nondirectory file-A) file-B) file-B) nil ; file-C startup-hooks 'ediff-merge-files)) ;;;###autoload (defun ediff-merge-files-with-ancestor (file-A file-B file-ancestor &optional startup-hooks) "Merge two files with ancestor." (interactive (let ((dir-A (if ediff-use-last-dir ediff-last-dir-A default-directory)) dir-B dir-ancestor f ff) (list (setq f (ediff-read-file-name "File A to merge" dir-A (ediff-get-default-file-name))) (setq ff (ediff-read-file-name "File B to merge" (setq dir-B (if ediff-use-last-dir ediff-last-dir-B (file-name-directory f))) (progn (setq file-name-history (cons (ediff-abbreviate-file-name (expand-file-name (file-name-nondirectory f) dir-B)) file-name-history)) f))) (ediff-read-file-name "Ancestor file" (setq dir-ancestor (if ediff-use-last-dir ediff-last-dir-ancestor (file-name-directory ff))) (progn (setq file-name-history (cons (ediff-abbreviate-file-name (expand-file-name (file-name-nondirectory ff) dir-ancestor)) file-name-history)) ff)) ))) (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks)) (ediff-files-internal file-A (if (file-directory-p file-B) (expand-file-name (file-name-nondirectory file-A) file-B) file-B) file-ancestor startup-hooks 'ediff-merge-files-with-ancestor)) ;;;###autoload (defalias 'ediff-merge-with-ancestor 'ediff-merge-files-with-ancestor) ;;;###autoload (defun ediff-merge-buffers (buffer-A buffer-B &optional startup-hooks job-name) "Merge buffers without ancestor." (interactive (let (bf) (list (setq bf (read-buffer "Buffer A to merge: " (ediff-other-buffer "") t)) (read-buffer "Buffer B to merge: " (progn ;; realign buffers so that two visible bufs will be ;; at the top (save-window-excursion (other-window 1)) (ediff-other-buffer bf)) t)))) (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks)) (or job-name (setq job-name 'ediff-merge-buffers)) (ediff-buffers-internal buffer-A buffer-B nil startup-hooks job-name)) ;;;###autoload (defun ediff-merge-buffers-with-ancestor (buffer-A buffer-B buffer-ancestor &optional startup-hooks job-name) "Merge buffers with ancestor." (interactive (let (bf bff) (list (setq bf (read-buffer "Buffer A to merge: " (ediff-other-buffer "") t)) (setq bff (read-buffer "Buffer B to merge: " (progn ;; realign buffers so that two visible ;; bufs will be at the top (save-window-excursion (other-window 1)) (ediff-other-buffer bf)) t)) (read-buffer "Ancestor buffer: " (progn ;; realign buffers so that three visible ;; bufs will be at the top (save-window-excursion (other-window 1)) (ediff-other-buffer (list bf bff))) t) ))) (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks)) (or job-name (setq job-name 'ediff-merge-buffers-with-ancestor)) (ediff-buffers-internal buffer-A buffer-B buffer-ancestor startup-hooks job-name)) ;;;###autoload (defun ediff-merge-revisions (&optional file startup-hooks) "Run Ediff by merging two revisions of a file. The file is the optional FILE argument or the file visited by the current buffer." (interactive) (ediff-load-version-control) (if (stringp file) (find-file file)) (let (rev1 rev2 buf1 buf2) (setq rev1 (read-string (format "Version 1 to merge (default: %s's latest version): " (if (stringp file) (file-name-nondirectory file) "current buffer"))) rev2 (read-string (format "Version 2 to merge (default: %s): " (if (stringp file) (file-name-nondirectory file) "current buffer")))) (cond ((eq ediff-version-control-package 'vc) (save-excursion (vc-version-other-window rev1) (setq buf1 (current-buffer))) (save-excursion (or (string= rev2 "") (vc-version-other-window rev2)) (setq buf2 (current-buffer))) (setq startup-hooks (cons (` (lambda () (delete-file (, (buffer-file-name buf1))) (or (, (string= rev2 "")) (delete-file (, (buffer-file-name buf2)))))) startup-hooks))) ((eq ediff-version-control-package 'rcs) (setq buf1 (rcs-ediff-view-revision rev1) buf2 (if (string= rev2 "") (current-buffer) (rcs-ediff-view-revision rev2)))) ((eq ediff-version-control-package 'generic-sc) (save-excursion (if (string= rev1 "") (setq rev1 (generic-sc-get-latest-rev))) (sc-visit-previous-revision rev1) (setq buf1 (current-buffer))) (save-excursion (or (string= rev2 "") (sc-visit-previous-revision rev2)) (setq buf2 (current-buffer)))) ) ; cond (ediff-merge-buffers buf1 buf2 startup-hooks 'ediff-merge-revisions))) ;;;###autoload (defun ediff-merge-revisions-with-ancestor (&optional file startup-hooks) "Run Ediff by merging two revisions of a file with a common ancestor. The file is the the optional FILE argument or the file visited by the current buffer." (interactive) (ediff-load-version-control) (if (stringp file) (find-file file)) (let (rev1 rev2 ancestor-rev buf1 buf2 ancestor-buf) (setq rev1 (read-string (format "Version 1 to merge (default: %s's latest version): " (if (stringp file) (file-name-nondirectory file) "current buffer"))) rev2 (read-string (format "Version 2 to merge (default: %s): " (if (stringp file) (file-name-nondirectory file) "current buffer"))) ancestor-rev (read-string (format "Ancestor version (default: %s): " (if (stringp file) (file-name-nondirectory file) "current buffer")))) (cond ((eq ediff-version-control-package 'vc) (save-excursion (vc-version-other-window rev1) (setq buf1 (current-buffer))) (save-excursion (or (string= rev2 "") (vc-version-other-window rev2)) (setq buf2 (current-buffer))) (save-excursion (or (string= ancestor-rev "") (vc-version-other-window ancestor-rev)) (setq ancestor-buf (current-buffer))) (setq startup-hooks (cons (` (lambda () (delete-file (, (buffer-file-name buf1))) (or (, (string= rev2 "")) (delete-file (, (buffer-file-name buf2)))) (or (, (string= ancestor-rev "")) (delete-file (, (buffer-file-name ancestor-buf)))))) startup-hooks))) ((eq ediff-version-control-package 'rcs) (setq buf1 (rcs-ediff-view-revision rev1) buf2 (if (string= rev2 "") (current-buffer) (rcs-ediff-view-revision rev2)) ancestor-buf (if (string= ancestor-rev "") (current-buffer) (rcs-ediff-view-revision ancestor-rev)))) ((eq ediff-version-control-package 'generic-sc) (save-excursion (if (string= rev1 "") (setq rev1 (generic-sc-get-latest-rev))) (sc-visit-previous-revision rev1) (setq buf1 (current-buffer))) (save-excursion (or (string= rev2 "") (sc-visit-previous-revision rev2)) (setq buf2 (current-buffer))) (save-excursion (or (string= ancestor-rev "") (sc-visit-previous-revision ancestor-rev)) (setq ancestor-buf (current-buffer)))) ) ; cond (ediff-merge-buffers-with-ancestor buf1 buf2 ancestor-buf startup-hooks 'ediff-merge-revisions-with-ancestor))) ;;; Apply patch ;;;###autoload (defun ediff-patch-buffer (buffer-name &optional startup-hooks) "Run Ediff by patching BUFFER-NAME." (interactive "bBuffer to patch: ") (let* ((buf-to-patch (get-buffer buffer-name)) (file-name-ok (if buf-to-patch (buffer-file-name buf-to-patch))) (buf-mod-status (buffer-modified-p buf-to-patch)) default-dir file-name ctl-buf) (if file-name-ok (setq file-name file-name-ok) (ediff-eval-in-buffer buffer-name (setq default-dir default-directory) (setq file-name (ediff-make-temp-file buffer-name)) (set-visited-file-name file-name) (setq buffer-auto-save-file-name nil) ; don't create auto-save file (rename-buffer buffer-name) ; don't confuse the user with new buf name (set-buffer-modified-p nil) (set-visited-file-modtime) ; sync buffer and temp file (setq default-directory default-dir) )) (setq ctl-buf (ediff-patch-file file-name startup-hooks 'ediff-patch-buffer)) (if file-name-ok () (ediff-eval-in-buffer ctl-buf (delete-file (buffer-file-name ediff-buffer-A)) (delete-file (buffer-file-name ediff-buffer-B)) (ediff-eval-in-buffer ediff-buffer-A (if default-dir (setq default-directory default-dir)) (set-visited-file-name nil) (rename-buffer buffer-name) (set-buffer-modified-p buf-mod-status)) (ediff-eval-in-buffer ediff-buffer-B (setq buffer-auto-save-file-name nil) ; don't create auto-save file (if default-dir (setq default-directory default-dir)) (set-visited-file-name nil) (rename-buffer (ediff-unique-buffer-name (concat buffer-name "_patched") "")) (set-buffer-modified-p t)))) )) (defun ediff-get-patch-buffer (dir) "Obtain patch buffer. If patch is already in a buffer---use it. Else, read patch file into a new buffer." (if (y-or-n-p "Is the patch file already in a buffer? ") (setq ediff-patch-buf (get-buffer (read-buffer "Patch buffer name: " nil t))) ;must match (setq ediff-patch-buf (find-file-noselect (read-file-name "Patch file name: " dir)))) (setq ediff-patch-diagnostics (get-buffer-create "*ediff patch diagnostics*")) (ediff-eval-in-buffer ediff-patch-diagnostics (insert-buffer ediff-patch-buf))) ;;; Versions Control functions ;;;###autoload (defun ediff-revision (&optional file startup-hooks) "Run Ediff by comparing versions of a file. The file is an optional FILE argument or the file visited by the current buffer. Use `vc.el' or `rcs.el' depending on `ediff-version-control-package'." ;; if buffer is non-nil, use that buffer instead of the current buffer (interactive "P") (if (stringp file) (find-file file)) (let (rev1 rev2) (setq rev1 (read-string (format "Version 1 to compare (default: %s's latest version): " (if (stringp file) (file-name-nondirectory file) "current buffer"))) rev2 (read-string (format "Version 2 to compare (default: %s): " (if (stringp file) (file-name-nondirectory file) "current buffer")))) (ediff-load-version-control) (funcall (intern (format "%S-ediff-internal" ediff-version-control-package)) rev1 rev2 startup-hooks) )) ;; Test if version control package is loaded and load if not ;; Is SILENT is non-nil, don't report error if package is not found. (defun ediff-load-version-control (&optional silent) (or (featurep ediff-version-control-package) (if (locate-library (symbol-name ediff-version-control-package)) (progn (message "") ; kill the message from `locate-library' (require ediff-version-control-package)) (or silent (error "Version control package %S.el not found. Use vc.el instead" ediff-version-control-package))))) (defun vc-ediff-internal (rev1 rev2 &optional startup-hooks) "Run Ediff on versions of the current buffer. If REV2 is \"\" then compare current buffer with REV1. If the current buffer is named `F', the version is named `F.~REV~'. If `F.~REV~' already exists, it is used instead of being re-created." (let (file1 file2 rev1buf rev2buf) (save-excursion (vc-version-other-window rev1) (setq rev1buf (current-buffer) file1 (buffer-file-name))) (save-excursion (or (string= rev2 "") ; use current buffer (vc-version-other-window rev2)) (setq rev2buf (current-buffer) file2 (buffer-file-name))) (setq startup-hooks (cons (` (lambda () (delete-file (, file1)) (or (, (string= rev2 "")) (delete-file (, file2))) )) startup-hooks)) (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision))) (defun rcs-ediff-view-revision (&optional rev) "View previous RCS revision of current file. With prefix argument, prompts for a revision name." (interactive (list (if current-prefix-arg (read-string "Revision: ")))) (let* ((filename (buffer-file-name (current-buffer))) (switches (append '("-p") (if rev (list (concat "-r" rev)) nil))) (buff (concat (file-name-nondirectory filename) ".~" rev "~"))) (message "Working ...") (setq filename (expand-file-name filename)) (with-output-to-temp-buffer buff (let ((output-buffer (ediff-rcs-get-output-buffer filename buff))) (delete-windows-on output-buffer) (save-excursion (set-buffer output-buffer) (apply 'call-process "co" nil t nil ;; -q: quiet (no diagnostics) (append switches rcs-default-co-switches (list "-q" filename))))) (message "") buff))) (defun ediff-rcs-get-output-buffer (file name) ;; Get a buffer for RCS output for FILE, make it writable and clean it up. ;; Optional NAME is name to use instead of `*RCS-output*'. ;; This is a modified version from rcs.el v1.1. I use it here to make ;; Ediff immune to changes in rcs.el (let* ((default-major-mode 'fundamental-mode) ; no frills! (buf (get-buffer-create name))) (save-excursion (set-buffer buf) (setq buffer-read-only nil default-directory (file-name-directory (expand-file-name file))) (erase-buffer)) buf)) (defun rcs-ediff-internal (rev1 rev2 &optional startup-hooks) "Run Ediff on versions of the current buffer. If REV2 is \"\" then use current buffer." (let ((rev2buf (if (string= rev2 "") (current-buffer) (rcs-ediff-view-revision rev2))) (rev1buf (rcs-ediff-view-revision rev1))) ;; rcs.el doesn't create temp version files, so we don't have to delete ;; anything in startup hooks to ediff-buffers (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision) )) (defun generic-sc-get-latest-rev () (cond ((eq sc-mode 'CCASE) (eval "main/LATEST")) (t (eval ""))) ) (defun generic-sc-ediff-internal (rev1 rev2 &optional startup-hooks) "Run Ediff on versions of the current buffer. If REV2 is \"\" then compare current buffer with REV1. If the current buffer is named `F', the version is named `F.~REV~'. If `F.~REV~' already exists, it is used instead of being re-created." (let (rev1buf rev2buf) (save-excursion (if (or (not rev1) (string= rev1 "")) (setq rev1 (generic-sc-get-latest-rev))) (sc-visit-previous-revision rev1) (setq rev1buf (current-buffer))) (save-excursion (or (string= rev2 "") ; use current buffer (sc-visit-previous-revision rev2)) (setq rev2buf (current-buffer))) (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision))) ;;;###autoload (defun ediff-version () "Return string describing the version of Ediff. When called interactively, displays the version." (interactive) (if (interactive-p) (message (ediff-version)) (format "Ediff %s of %s" ediff-version ediff-date))) (provide 'ediff) (require 'ediff-util) ;;; ediff.el ends here emacs-19.30/lisp/edmacro.el100444 12120 1 66230 6020130135 14020 0ustar rmsdaemon;;; edmacro.el --- keyboard macro editor ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: Dave Gillespie ;; Maintainer: Dave Gillespie ;; Version: 2.01 ;; Keywords: abbrev ;; 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: ;;; Usage: ;; ;; The `C-x C-k' (`edit-kbd-macro') command edits a keyboard macro ;; in a special buffer. It prompts you to type a key sequence, ;; which should be one of: ;; ;; * RET or `C-x e' (call-last-kbd-macro), to edit the most ;; recently defined keyboard macro. ;; ;; * `M-x' followed by a command name, to edit a named command ;; whose definition is a keyboard macro. ;; ;; * `C-h l' (view-lossage), to edit the 100 most recent keystrokes ;; and install them as the "current" macro. ;; ;; * any key sequence whose definition is a keyboard macro. ;; ;; This file includes a version of `insert-kbd-macro' that uses the ;; more readable format defined by these routines. ;; ;; Also, the `read-kbd-macro' command parses the region as ;; a keyboard macro, and installs it as the "current" macro. ;; This and `format-kbd-macro' can also be called directly as ;; Lisp functions. ;; Type `C-h m', or see the documentation for `edmacro-mode' below, ;; for information about the format of written keyboard macros. ;; `edit-kbd-macro' formats the macro with one command per line, ;; including the command names as comments on the right. If the ;; formatter gets confused about which keymap was used for the ;; characters, the command-name comments will be wrong but that ;; won't hurt anything. ;; With a prefix argument, `edit-kbd-macro' will format the ;; macro in a more concise way that omits the comments. ;; This package requires GNU Emacs 19 or later, and daveg's CL ;; package 2.02 or later. (CL 2.02 comes standard starting with ;; Emacs 19.18.) This package does not work with Emacs 18 or ;; Lucid Emacs. ;;; Code: (eval-when-compile (require 'cl)) ;;; The user-level commands for editing macros. ;;;###autoload (define-key ctl-x-map "\C-k" 'edit-kbd-macro) ;;;###autoload (defvar edmacro-eight-bits nil "*Non-nil if edit-kbd-macro should leave 8-bit characters intact. Default nil means to write characters above \\177 in octal notation.") (defvar edmacro-mode-map nil) (unless edmacro-mode-map (setq edmacro-mode-map (make-sparse-keymap)) (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit) (define-key edmacro-mode-map "\C-c\C-q" 'edmacro-insert-key)) ;;;###autoload (defun edit-kbd-macro (keys &optional prefix finish-hook store-hook) "Edit a keyboard macro. At the prompt, type any key sequence which is bound to a keyboard macro. Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit the last 100 keystrokes as a keyboard macro, or `M-x' to edit a macro by its command name. With a prefix argument, format the macro in a more concise way." (interactive "kKeyboard macro to edit (C-x e, M-x, C-h l, or keys): \nP") (when keys (let ((cmd (if (arrayp keys) (key-binding keys) keys)) (mac nil)) (cond (store-hook (setq mac keys) (setq cmd nil)) ((or (eq cmd 'call-last-kbd-macro) (member keys '("\r" [return]))) (or last-kbd-macro (y-or-n-p "No keyboard macro defined. Create one? ") (keyboard-quit)) (setq mac (or last-kbd-macro "")) (setq cmd 'last-kbd-macro)) ((eq cmd 'execute-extended-command) (setq cmd (read-command "Name of keyboard macro to edit: ")) (setq mac (symbol-function cmd))) ((eq cmd 'view-lossage) (setq mac (recent-keys)) (setq cmd 'last-kbd-macro)) ((null cmd) (error "Key sequence %s is not defined" (key-description keys))) ((symbolp cmd) (setq mac (symbol-function cmd))) (t (setq mac cmd) (setq cmd nil))) (unless (arrayp mac) (error "Key sequence %s is not a keyboard macro" (key-description keys))) (message "Formatting keyboard macro...") (let* ((oldbuf (current-buffer)) (mmac (edmacro-fix-menu-commands mac)) (fmt (edmacro-format-keys mmac 1)) (fmtv (edmacro-format-keys mmac (not prefix))) (buf (get-buffer-create "*Edit Macro*"))) (message "Formatting keyboard macro...done") (switch-to-buffer buf) (kill-all-local-variables) (use-local-map edmacro-mode-map) (setq buffer-read-only nil) (setq major-mode 'edmacro-mode) (setq mode-name "Edit Macro") (set (make-local-variable 'edmacro-original-buffer) oldbuf) (set (make-local-variable 'edmacro-finish-hook) finish-hook) (set (make-local-variable 'edmacro-store-hook) store-hook) (erase-buffer) (insert ";; Keyboard Macro Editor. Press C-c C-c to finish; " "press C-x k RET to cancel.\n") (insert ";; Original keys: " fmt "\n") (unless store-hook (insert "\nCommand: " (if cmd (symbol-name cmd) "none") "\n") (let ((keys (where-is-internal (or cmd mac) '(keymap)))) (if keys (while keys (insert "Key: " (edmacro-format-keys (pop keys) 1) "\n")) (insert "Key: none\n")))) (insert "\nMacro:\n\n") (save-excursion (insert fmtv "\n")) (recenter '(4)) (when (eq mac mmac) (set-buffer-modified-p nil)) (run-hooks 'edmacro-format-hook))))) ;;; The next two commands are provided for convenience and backward ;;; compatibility. ;;;###autoload (defun edit-last-kbd-macro (&optional prefix) "Edit the most recently defined keyboard macro." (interactive "P") (edit-kbd-macro 'call-last-kbd-macro prefix)) ;;;###autoload (defun edit-named-kbd-macro (&optional prefix) "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'." (interactive "P") (edit-kbd-macro 'execute-extended-command prefix)) ;;;###autoload (defun read-kbd-macro (start &optional end) "Read the region as a keyboard macro definition. The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\". See documentation for `edmacro-mode' for details. Leading/trailing \"C-x (\" and \"C-x )\" in the text are allowed and ignored. The resulting macro is installed as the \"current\" keyboard macro. In Lisp, may also be called with a single STRING argument in which case the result is returned rather than being installed as the current macro. The result will be a string if possible, otherwise an event vector. Second argument NEED-VECTOR means to return an event vector always." (interactive "r") (if (stringp start) (edmacro-parse-keys start end) (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end))))) ;;;###autoload (defun format-kbd-macro (&optional macro verbose) "Return the keyboard macro MACRO as a human-readable string. This string is suitable for passing to `read-kbd-macro'. Second argument VERBOSE means to put one command per line with comments. If VERBOSE is `1', put everything on one line. If VERBOSE is omitted or nil, use a compact 80-column format." (and macro (symbolp macro) (setq macro (symbol-function macro))) (edmacro-format-keys (or macro last-kbd-macro) verbose)) ;;; Commands for *Edit Macro* buffer. (defun edmacro-finish-edit () (interactive) (unless (eq major-mode 'edmacro-mode) (error "This command is valid only in buffers created by `edit-kbd-macro'")) (run-hooks 'edmacro-finish-hook) (let ((cmd nil) (keys nil) (no-keys nil) (top (point-min))) (goto-char top) (let ((case-fold-search nil)) (while (cond ((looking-at "[ \t]*\\($\\|;;\\|REM[ \t\n]\\)") t) ((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$") (when edmacro-store-hook (error "\"Command\" line not allowed in this context")) (let ((str (buffer-substring (match-beginning 1) (match-end 1)))) (unless (equal str "") (setq cmd (and (not (equal str "none")) (intern str))) (and (fboundp cmd) (not (arrayp (symbol-function cmd))) (not (y-or-n-p (format "Command %s is already defined; %s" cmd "proceed? "))) (keyboard-quit)))) t) ((looking-at "Key:\\(.*\\)$") (when edmacro-store-hook (error "\"Key\" line not allowed in this context")) (let ((key (edmacro-parse-keys (buffer-substring (match-beginning 1) (match-end 1))))) (unless (equal key "") (if (equal key "none") (setq no-keys t) (push key keys) (let ((b (key-binding key))) (and b (commandp b) (not (arrayp b)) (or (not (fboundp b)) (not (arrayp (symbol-function b)))) (not (y-or-n-p (format "Key %s is already defined; %s" (edmacro-format-keys key 1) "proceed? "))) (keyboard-quit)))))) t) ((looking-at "Macro:[ \t\n]*") (goto-char (match-end 0)) nil) ((eobp) nil) (t (error "Expected a `Macro:' line"))) (forward-line 1)) (setq top (point))) (let* ((buf (current-buffer)) (str (buffer-substring top (point-max))) (modp (buffer-modified-p)) (obuf edmacro-original-buffer) (store-hook edmacro-store-hook) (finish-hook edmacro-finish-hook)) (unless (or cmd keys store-hook (equal str "")) (error "No command name or keys specified")) (when modp (when (buffer-name obuf) (set-buffer obuf)) (message "Compiling keyboard macro...") (let ((mac (edmacro-parse-keys str))) (message "Compiling keyboard macro...done") (if store-hook (funcall store-hook mac) (when (eq cmd 'last-kbd-macro) (setq last-kbd-macro (and (> (length mac) 0) mac)) (setq cmd nil)) (when cmd (if (= (length mac) 0) (fmakunbound cmd) (fset cmd mac))) (if no-keys (when cmd (loop for key in (where-is-internal cmd '(keymap)) do (global-unset-key key))) (when keys (if (= (length mac) 0) (loop for key in keys do (global-unset-key key)) (loop for key in keys do (global-set-key key (or cmd mac))))))))) (kill-buffer buf) (when (buffer-name obuf) (switch-to-buffer obuf)) (when finish-hook (funcall finish-hook))))) (defun edmacro-insert-key (key) "Insert the written name of a key in the buffer." (interactive "kKey to insert: ") (if (bolp) (insert (edmacro-format-keys key t) "\n") (insert (edmacro-format-keys key) " "))) (defun edmacro-mode () "\\Keyboard Macro Editing mode. Press \\[edmacro-finish-edit] to save and exit. To abort the edit, just kill this buffer with \\[kill-buffer] RET. Press \\[edmacro-insert-key] to insert the name of any key by typing the key. The editing buffer contains a \"Command:\" line and any number of \"Key:\" lines at the top. These are followed by a \"Macro:\" line and the macro itself as spelled-out keystrokes: `C-x C-f foo RET'. The \"Command:\" line specifies the command name to which the macro is bound, or \"none\" for no command name. Write \"last-kbd-macro\" to refer to the current keyboard macro (as used by \\[call-last-kbd-macro]). The \"Key:\" lines specify key sequences to which the macro is bound, or \"none\" for no key bindings. You can edit these lines to change the places where the new macro is stored. Format of keyboard macros during editing: Text is divided into \"words\" separated by whitespace. Except for the words described below, the characters of each word go directly as characters of the macro. The whitespace that separates words is ignored. Whitespace in the macro must be written explicitly, as in \"foo SPC bar RET\". * The special words RET, SPC, TAB, DEL, LFD, ESC, and NUL represent special control characters. The words must be written in uppercase. * A word in angle brackets, e.g., , , or , represents a function key. (Note that in the standard configuration, the function key and the control key RET are synonymous.) You can use angle brackets on the words RET, SPC, etc., but they are not required there. * Keys can be written by their ASCII code, using a backslash followed by up to six octal digits. This is the only way to represent keys with codes above \\377. * One or more prefixes M- (meta), C- (control), S- (shift), A- (alt), H- (hyper), and s- (super) may precede a character or key notation. For function keys, the prefixes may go inside or outside of the brackets: C- = . The prefixes may be written in any order: M-C-x = C-M-x. Prefixes are not allowed on multi-key words, e.g., C-abc, except that the Meta prefix is allowed on a sequence of digits and optional minus sign: M--123 = M-- M-1 M-2 M-3. * The `^' notation for control characters also works: ^M = C-m. * Double angle brackets enclose command names: <> is shorthand for M-x next-line RET. * Finally, REM or ;; causes the rest of the line to be ignored as a comment. Any word may be prefixed by a multiplier in the form of a decimal number and `*': 3* = , and 10*foo = foofoofoofoofoofoofoofoofoofoo. Multiple text keys can normally be strung together to form a word, but you may need to add whitespace if the word would look like one of the above notations: `; ; ;' is a keyboard macro with three semicolons, but `;;;' is a comment. Likewise, `\\ 1 2 3' is four keys but `\\123' is a single key written in octal, and `< right >' is seven keys but `' is a single function key. When in doubt, use whitespace." (interactive) (error "This mode can be enabled only by `edit-kbd-macro'")) (put 'edmacro-mode 'mode-class 'special) ;;; Formatting a keyboard macro as human-readable text. (defun edmacro-format-keys (macro &optional verbose) (setq macro (edmacro-fix-menu-commands macro)) (let* ((maps (append (current-minor-mode-maps) (if (current-local-map) (list (current-local-map))) (list (current-global-map)))) (pkeys '(end-macro ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?- ?\C-u ?\M-- ?\M-0 ?\M-1 ?\M-2 ?\M-3 ?\M-4 ?\M-5 ?\M-6 ?\M-7 ?\M-8 ?\M-9)) (mdigs (nthcdr 13 pkeys)) (maxkey (if edmacro-eight-bits 255 127)) (case-fold-search nil) (res-words '("NUL" "TAB" "LFD" "RET" "ESC" "SPC" "DEL" "REM")) (rest-mac (vconcat macro [end-macro])) (res "") (len 0) (one-line (eq verbose 1))) (if one-line (setq verbose nil)) (when (stringp macro) (loop for i below (length macro) do (when (>= (aref rest-mac i) 128) (incf (aref rest-mac i) (- ?\M-\^@ 128))))) (while (not (eq (aref rest-mac 0) 'end-macro)) (let* ((prefix (or (and (integerp (aref rest-mac 0)) (memq (aref rest-mac 0) mdigs) (memq (key-binding (edmacro-subseq rest-mac 0 1)) '(digit-argument negative-argument)) (let ((i 1)) (while (memq (aref rest-mac i) (cdr mdigs)) (incf i)) (and (not (memq (aref rest-mac i) pkeys)) (prog1 (concat "M-" (edmacro-subseq rest-mac 0 i) " ") (callf edmacro-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) (while (eq (aref rest-mac i) ?\C-u) (incf i)) (and (not (memq (aref rest-mac i) pkeys)) (prog1 (loop repeat i concat "C-u ") (callf edmacro-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) (when (eq (aref rest-mac i) ?-) (incf i)) (while (memq (aref rest-mac i) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) (incf i)) (and (not (memq (aref rest-mac i) pkeys)) (prog1 (concat "C-u " (edmacro-subseq rest-mac 1 i) " ") (callf edmacro-subseq rest-mac i))))))) (bind-len (apply 'max 1 (loop for map in maps for b = (lookup-key map rest-mac) when b collect b))) (key (edmacro-subseq rest-mac 0 bind-len)) (fkey nil) tlen tkey (bind (or (loop for map in maps for b = (lookup-key map key) thereis (and (not (integerp b)) b)) (and (setq fkey (lookup-key function-key-map rest-mac)) (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen) fkey (lookup-key function-key-map tkey)) (loop for map in maps for b = (lookup-key map fkey) when (and (not (integerp b)) b) do (setq bind-len tlen key tkey) and return b finally do (setq fkey nil))))) (first (aref key 0)) (text (loop for i from bind-len below (length rest-mac) for ch = (aref rest-mac i) while (and (integerp ch) (> ch 32) (< ch maxkey) (/= ch 92) (eq (key-binding (char-to-string ch)) 'self-insert-command) (or (> i (- (length rest-mac) 2)) (not (eq ch (aref rest-mac (+ i 1)))) (not (eq ch (aref rest-mac (+ i 2)))))) finally return i)) desc) (if (stringp bind) (setq bind nil)) (cond ((and (eq bind 'self-insert-command) (not prefix) (> text 1) (integerp first) (> first 32) (<= first maxkey) (/= first 92) (progn (if (> text 30) (setq text 30)) (setq desc (concat (edmacro-subseq rest-mac 0 text))) (when (string-match "^[ACHMsS]-." desc) (setq text 2) (callf substring desc 0 2)) (not (string-match "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*." desc)))) (when (or (string-match "^\\^.$" desc) (member desc res-words)) (setq desc (mapconcat 'char-to-string desc " "))) (when verbose (setq bind (format "%s * %d" bind text))) (setq bind-len text)) ((and (eq bind 'execute-extended-command) (> text bind-len) (memq (aref rest-mac text) '(return 13)) (progn (setq desc (concat (edmacro-subseq rest-mac bind-len text))) (commandp (intern-soft desc)))) (if (commandp (intern-soft desc)) (setq bind desc)) (setq desc (format "<<%s>>" desc)) (setq bind-len (1+ text))) (t (setq desc (mapconcat (function (lambda (ch) (cond ((integerp ch) (concat (loop for pf across "ACHMsS" for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@ ?\M-\^@ ?\s-\^@ ?\S-\^@) when (/= (logand ch bit) 0) concat (format "%c-" pf)) (let ((ch2 (logand ch (1- (lsh 1 18))))) (cond ((<= ch2 32) (case ch2 (0 "NUL") (9 "TAB") (10 "LFD") (13 "RET") (27 "ESC") (32 "SPC") (t (format "C-%c" (+ (if (<= ch2 26) 96 64) ch2))))) ((= ch2 127) "DEL") ((<= ch2 maxkey) (char-to-string ch2)) (t (format "\\%o" ch2)))))) ((symbolp ch) (format "<%s>" ch)) (t (error "Unrecognized item in macro: %s" ch))))) (or fkey key) " ")))) (if prefix (setq desc (concat prefix desc))) (unless (string-match " " desc) (let ((times 1) (pos bind-len)) (while (not (edmacro-mismatch rest-mac rest-mac 0 bind-len pos (+ bind-len pos))) (incf times) (incf pos bind-len)) (when (> times 1) (setq desc (format "%d*%s" times desc)) (setq bind-len (* bind-len times))))) (setq rest-mac (edmacro-subseq rest-mac bind-len)) (if verbose (progn (unless (equal res "") (callf concat res "\n")) (callf concat res desc) (when (and bind (or (stringp bind) (symbolp bind))) (callf concat res (make-string (max (- 3 (/ (length desc) 8)) 1) 9) ";; " (if (stringp bind) bind (symbol-name bind)))) (setq len 0)) (if (and (> (+ len (length desc) 2) 72) (not one-line)) (progn (callf concat res "\n ") (setq len 1)) (unless (equal res "") (callf concat res " ") (incf len))) (callf concat res desc) (incf len (length desc))))) res)) (defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2) "Compare SEQ1 with SEQ2, return index of first mismatching element. Return nil if the sequences match. If one sequence is a prefix of the other, the return value indicates the end of the shorted sequence." (let (cl-test cl-test-not cl-key cl-from-end) (or cl-end1 (setq cl-end1 (length cl-seq1))) (or cl-end2 (setq cl-end2 (length cl-seq2))) (if cl-from-end (progn (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) (cl-check-match (elt cl-seq1 (1- cl-end1)) (elt cl-seq2 (1- cl-end2)))) (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2))) (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) (1- cl-end1))) (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1))) (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2)))) (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) (cl-check-match (if cl-p1 (car cl-p1) (aref cl-seq1 cl-start1)) (if cl-p2 (car cl-p2) (aref cl-seq2 cl-start2)))) (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2))) (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) cl-start1))))) (defun edmacro-subseq (seq start &optional end) "Return the subsequence of SEQ from START to END. If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end." (if (stringp seq) (substring seq start end) (let (len) (and end (< end 0) (setq end (+ end (setq len (length seq))))) (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) (cond ((listp seq) (if (> start 0) (setq seq (nthcdr start seq))) (if end (let ((res nil)) (while (>= (setq end (1- end)) start) (cl-push (cl-pop seq) res)) (nreverse res)) (copy-sequence seq))) (t (or end (setq end (or len (length seq)))) (let ((res (make-vector (max (- end start) 0) nil)) (i 0)) (while (< start end) (aset res i (aref seq start)) (setq i (1+ i) start (1+ start))) res)))))) (defun edmacro-fix-menu-commands (macro) (when (vectorp macro) (let ((i 0) ev) (while (< i (length macro)) (when (consp (setq ev (aref macro i))) (cond ((equal (cadadr ev) '(menu-bar)) (setq macro (vconcat (edmacro-subseq macro 0 i) (vector 'menu-bar (car ev)) (edmacro-subseq macro (1+ i)))) (incf i)) ;; It would be nice to do pop-up menus, too, but not enough ;; info is recorded in macros to make this possible. (t (error "Macros with mouse clicks are not %s" "supported by this command")))) (incf i)))) macro) ;;; Parsing a human-readable keyboard macro. (defun edmacro-parse-keys (string &optional need-vector) (let ((case-fold-search nil) (pos 0) (res [])) (while (and (< pos (length string)) (string-match "[^ \t\n\f]+" string pos)) (let ((word (substring string (match-beginning 0) (match-end 0))) (key nil) (times 1)) (setq pos (match-end 0)) (when (string-match "\\([0-9]+\\)\\*." word) (setq times (string-to-int (substring word 0 (match-end 1)))) (setq word (substring word (1+ (match-end 1))))) (cond ((string-match "^<<.+>>$" word) (setq key (vconcat (if (eq (key-binding [?\M-x]) 'execute-extended-command) [?\M-x] (or (car (where-is-internal 'execute-extended-command)) [?\M-x])) (substring word 2 -2) "\r"))) ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) (progn (setq word (concat (substring word (match-beginning 1) (match-end 1)) (substring word (match-beginning 3) (match-end 3)))) (not (string-match "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" word)))) (setq key (list (intern word)))) ((or (equal word "REM") (string-match "^;;" word)) (setq pos (string-match "$" string pos))) (t (let ((orig-word word) (prefix 0) (bits 0)) (while (string-match "^[ACHMsS]-." word) (incf bits (cdr (assq (aref word 0) '((?A . ?\A-\^@) (?C . ?\C-\^@) (?H . ?\H-\^@) (?M . ?\M-\^@) (?s . ?\s-\^@) (?S . ?\S-\^@))))) (incf prefix 2) (callf substring word 2)) (when (string-match "^\\^.$" word) (incf bits ?\C-\^@) (incf prefix) (callf substring word 1)) (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") ("LFD" . "\n") ("TAB" . "\t") ("ESC" . "\e") ("SPC" . " ") ("DEL" . "\177"))))) (when found (setq word (cdr found)))) (when (string-match "^\\\\[0-7]+$" word) (loop for ch across word for n = 0 then (+ (* n 8) ch -48) finally do (setq word (vector n)))) (cond ((= bits 0) (setq key word)) ((and (= bits ?\M-\^@) (stringp word) (string-match "^-?[0-9]+$" word)) (setq key (loop for x across word collect (+ x bits)))) ((/= (length word) 1) (error "%s must prefix a single character, not %s" (substring orig-word 0 prefix) word)) ((and (/= (logand bits ?\C-\^@) 0) (stringp word) (string-match "[@-_.a-z?]" word)) (setq key (list (+ bits (- ?\C-\^@) (if (equal word "?") 127 (logand (aref word 0) 31)))))) (t (setq key (list (+ bits (aref word 0))))))))) (when key (loop repeat times do (callf vconcat res key))))) (when (and (>= (length res) 4) (eq (aref res 0) ?\C-x) (eq (aref res 1) ?\() (eq (aref res (- (length res) 2)) ?\C-x) (eq (aref res (- (length res) 1)) ?\))) (setq res (edmacro-subseq res 2 -2))) (if (and (not need-vector) (loop for ch across res always (and (integerp ch) (let ((ch2 (logand ch (lognot ?\M-\^@)))) (and (>= ch2 0) (<= ch2 127)))))) (concat (loop for ch across res collect (if (= (logand ch ?\M-\^@) 0) ch (+ ch 128)))) res))) ;;; The following probably ought to go in macros.el: ;;;###autoload (defun insert-kbd-macro (macroname &optional keys) "Insert in buffer the definition of kbd macro NAME, as Lisp code. Optional second arg KEYS means also record the keys it is on \(this is the prefix argument, when calling interactively). This Lisp code will, when executed, define the kbd macro with the same definition it has now. If you say to record the keys, the Lisp code will also rebind those keys to the macro. Only global key bindings are recorded since executing this Lisp code always makes global bindings. To save a kbd macro, visit a file of Lisp code such as your `~/.emacs', use this command, and then save the file." (interactive "CInsert kbd macro (name): \nP") (let (definition) (if (string= (symbol-name macroname) "") (progn (setq definition (format-kbd-macro)) (insert "(setq last-kbd-macro")) (setq definition (format-kbd-macro macroname)) (insert (format "(defalias '%s" macroname))) (if (> (length definition) 50) (insert " (read-kbd-macro\n") (insert "\n (read-kbd-macro ")) (prin1 definition (current-buffer)) (insert "))\n") (if keys (let ((keys (where-is-internal macroname '(keymap)))) (while keys (insert (format "(global-set-key %S '%s)\n" (car keys) macroname)) (setq keys (cdr keys))))))) (provide 'edmacro) ;;; edmacro.el ends here emacs-19.30/lisp/edt-lk201.el100444 12120 1 4546 6045201741 14004 0ustar rmsdaemon;;; edt-lk201.el --- Enhanced EDT Keypad Mode Emulation for LK-201 Keyboards ;; Copyright (C) 1986, 1992, 1993, 1995 Free Software Foundation, Inc. ;; Author: Kevin Gallagher ;; Maintainer: Kevin Gallagher ;; Keywords: emulations ;; 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. ;;; Usage: ;; See edt-user.doc in the Emacs etc directory. ;; ==================================================================== ;;;; ;;;; KEY TRANSLATIONS ;;;; ;; Associate EDT keynames with Emacs terminal function vector names. ;; (Function key vector names for LK-201 are found in lisp/term/lk201.el.) ;; ;; F1 - F5 are not available on many DEC VT series terminals. ;; However, this is not always the case. So support for F1 - F5 is ;; provided here and in lisp/term/lk201.el. (defconst *EDT-keys* '(("KP0" . [kp-0]) ("KP1" . [kp-1]) ("KP2" . [kp-2]) ("KP3" . [kp-3]) ("KP4" . [kp-4]) ("KP5" . [kp-5]) ("KP6" . [kp-6]) ("KP7" . [kp-7]) ("KP8" . [kp-8]) ("KP9" . [kp-9]) ("KP," . [kp-separator]) ("KP-" . [kp-subtract]) ("KPP" . [kp-decimal]) ("KPE" . [kp-enter]) ("PF1" . [kp-f1]) ("PF2" . [kp-f2]) ("PF3" . [kp-f3]) ("PF4" . [kp-f4]) ("UP" . [up]) ("DOWN" . [down]) ("RIGHT" . [right]) ("LEFT" . [left]) ("FIND" . [find]) ("INSERT" . [insert]) ("REMOVE" . [delete]) ("SELECT" . [select]) ("PREVIOUS" . [prior]) ("NEXT" . [next]) ("F1" . [f1]) ("F2" . [f2]) ("F3" . [f3]) ("F4" . [f4]) ("F5" . [f5]) ("F6" . [f6]) ("F7" . [f7]) ("F8" . [f8]) ("F9" . [f9]) ("F10" . [f10]) ("F11" . [f11]) ("F12" . [f12]) ("F13" . [f13]) ("F14" . [f14]) ("HELP" . [help]) ("DO" . [menu]) ("F17" . [f17]) ("F18" . [f18]) ("F19" . [f19]) ("F20" . [f20]))) emacs-19.30/lisp/edt-mapper.el100444 12120 1 32602 6045202007 14445 0ustar rmsdaemon;;; edt-mapper.el --- Create an EDT LK-201 Map File for X-Windows Emacs ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Kevin Gallagher ;; Maintainer: Kevin Gallagher ;; Keywords: emulations ;; 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 emacs lisp program can be used to create an emacs lisp file ;; that defines the mapping of the user's keyboard under X-Windows to ;; the LK-201 keyboard function keys and keypad keys (around which ;; EDT has been designed). Please read the "Usage" AND "Known ;; Problems" sections before attempting to run this program. (The ;; design of this file, edt-mapper.el, was heavily influenced by ;; tpu-mapper.el.) ;;; Usage: ;; Simply load this file into the X-Windows version of emacs (version 19) ;; using the following command. ;; emacs -q -l edt-mapper.el ;; The "-q" option prevents loading of your .emacs file (commands therein ;; might confuse this program). ;; An instruction screen showing the typical LK-201 terminal functions keys ;; will be displayed, and you will be prompted to press the keys on your ;; keyboard which you want to emulate the corresponding LK-201 keys. ;; Finally, you will be prompted for the name of the file to store ;; the key definitions. If you chose the default, it will be found ;; and loaded automatically when the EDT emulation is started. If ;; you specify a different file name, you will need to set the ;; variable "edt-xkeys-file" before starting the EDT emulation. ;; Here's how you might go about doing that in your .emacs file. ;; (setq edt-xkeys-file (expand-file-name "~/.my-emacs-x-keys")) ;;; Known Problems: ;; Sometimes, edt-mapper will ignore a key you press, and just continue to ;; prompt for the same key. This can happen when your window manager sucks ;; up the key and doesn't pass it on to emacs, or it could be an emacs bug. ;; Either way, there's nothing that edt-mapper can do about it. You must ;; press RETURN, to skip the current key and continue. Later, you and/or ;; your local X guru can try to figure out why the key is being ignored. ;; ==================================================================== ;;; ;;; Make sure we're running X-windows and Emacs version 19 ;;; (cond ((not (and window-system (not (string-lessp emacs-version "19")))) (insert " Whoa! This isn't going to work... You must run edt-mapper.el under X-windows and Emacs version 19. Press any key to exit. ") (sit-for 600) (kill-emacs t))) ;;; ;;; Decide whether we're running GNU or Lucid emacs. ;;; (defconst edt-lucid-emacs19-p (string-match "Lucid" emacs-version) "Non-NIL if we are running Lucid Emacs version 19.") ;;; ;;; Key variables ;;; (defvar edt-key nil) (defvar edt-enter nil) (defvar edt-return nil) (defvar edt-key-seq nil) (defvar edt-enter-seq nil) (defvar edt-return-seq nil) ;;; ;;; Make sure the window is big enough to display the instructions ;;; (if edt-lucid-emacs19-p (set-screen-size nil 80 36) (set-frame-size (selected-frame) 80 36)) ;;; ;;; Create buffers - Directions and Keys ;;; (if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) (if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) ;;; ;;; Put header in the Keys buffer ;;; (set-buffer "Keys") (insert "\ ;; ;; Key definitions for the EDT emulation within GNU Emacs ;; (defconst *EDT-keys* '( ") ;;; ;;; Display directions ;;; (switch-to-buffer "Directions") (insert " EDT MAPPER You will be asked to press keys to create a custom mapping (under X-Windows) of your keypad keys and function keys so that they can emulate the LK-201 keypad and function keys or the subset of keys found on a VT-100 series terminal keyboard. (The LK-201 keyboard is the standard keyboard attached to VT-200 series terminals, and above.) Sometimes, edt-mapper will ignore a key you press, and just continue to prompt for the same key. This can happen when your window manager sucks up the key and doesn't pass it on to emacs, or it could be an emacs bug. Either way, there's nothing that edt-mapper can do about it. You must press RETURN, to skip the current key and continue. Later, you and/or your local X guru can try to figure out why the key is being ignored. Start by pressing the RETURN key, and continue by pressing the keys specified in the mini-buffer. If you want to entirely omit a key, because your keyboard does not have a corresponding key, for example, just press RETURN at the prompt. ") (delete-other-windows) ;;; ;;; Save for future reference ;;; (cond (edt-lucid-emacs19-p (setq edt-return-seq (read-key-sequence "Hit carriage-return to continue ")) (setq edt-return (concat "[" (format "%s" (event-key (aref edt-return-seq 0))) "]"))) (t (message "Hit carriage-return to continue ") (setq edt-return-seq (read-event)) (setq edt-return (concat "[" (format "%s" edt-return-seq) "]")))) ;;; ;;; Display Keypad Diagram and Begin Prompting for Keys ;;; (set-buffer "Directions") (delete-region (point-min) (point-max)) (insert " PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW. Here's a picture of the standard LK-201 keypad for reference: _______________________ _______________________________ | HELP | DO | | F17 | F18 | F19 | F20 | | | | | | | | | |_______|_______________| |_______|_______|_______|_______| _______________________ _______________________________ | FIND |INSERT |REMOVE | | PF1 | PF2 | PF3 | PF4 | | | | | | | | | | |_______|_______|_______| |_______|_______|_______|_______| |SELECT |PREVIOU| NEXT | | KP7 | KP8 | KP9 | KP- | | | | | | | | | | |_______|_______|_______| |_______|_______|_______|_______| | UP | | KP4 | KP5 | KP6 | KP, | | | | | | | | _______|_______|_______ |_______|_______|_______|_______| | LEFT | DOWN | RIGHT | | KP1 | KP2 | KP3 | | | | | | | | | | | |_______|_______|_______| |_______|_______|_______| KPE | | KP0 | KPP | | | | | | |_______________|_______|_______| ") ;;; ;;; Key mapping functions ;;; (defun edt-lucid-map-key (ident descrip func gold-func) (interactive) (setq edt-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) (setq edt-key (concat "[" (format "%s" (event-key (aref edt-key-seq 0))) "]")) (cond ((not (equal edt-key edt-return)) (set-buffer "Keys") (insert (format " (\"%s\" . %s)\n" ident edt-key)) (set-buffer "Directions")) ;; bogosity to get next prompt to come up, if the user hits ! ;; check periodically to see if this is still needed... (t (format "%s" edt-key))) edt-key) (defun edt-gnu-map-key (ident descrip) (interactive) (message "Press %s%s: " ident descrip) (setq edt-key-seq (read-event)) (setq edt-key (concat "[" (format "%s" edt-key-seq) "]")) (cond ((not (equal edt-key edt-return)) (set-buffer "Keys") (insert (format " (\"%s\" . %s)\n" ident edt-key)) (set-buffer "Directions")) ;; bogosity to get next prompt to come up, if the user hits ! ;; check periodically to see if this is still needed... (t (set-buffer "Keys") (insert (format " (\"%s\" . \"\" )\n" ident)) (set-buffer "Directions"))) edt-key) (fset 'edt-map-key (if edt-lucid-emacs19-p 'edt-lucid-map-key 'edt-gnu-map-key)) (set-buffer "Keys") (insert " ;; ;; Arrows ;; ") (set-buffer "Directions") (edt-map-key "UP" " - The Up Arrow Key") (edt-map-key "DOWN" " - The Down Arrow Key") (edt-map-key "LEFT" " - The Left Arrow Key") (edt-map-key "RIGHT" " - The Right Arrow Key") (set-buffer "Keys") (insert " ;; ;; PF keys ;; ") (set-buffer "Directions") (edt-map-key "PF1" " - The PF1 (GOLD) Key") (edt-map-key "PF2" " - The Keypad PF2 Key") (edt-map-key "PF3" " - The Keypad PF3 Key") (edt-map-key "PF4" " - The Keypad PF4 Key") (set-buffer "Keys") (insert " ;; ;; KP0-9 KP- KP, KPP and KPE ;; ") (set-buffer "Directions") (edt-map-key "KP0" " - The Keypad 0 Key") (edt-map-key "KP1" " - The Keypad 1 Key") (edt-map-key "KP2" " - The Keypad 2 Key") (edt-map-key "KP3" " - The Keypad 3 Key") (edt-map-key "KP4" " - The Keypad 4 Key") (edt-map-key "KP5" " - The Keypad 5 Key") (edt-map-key "KP6" " - The Keypad 6 Key") (edt-map-key "KP7" " - The Keypad 7 Key") (edt-map-key "KP8" " - The Keypad 8 Key") (edt-map-key "KP9" " - The Keypad 9 Key") (edt-map-key "KP-" " - The Keypad - Key") (edt-map-key "KP," " - The Keypad , Key") (edt-map-key "KPP" " - The Keypad . Key") (edt-map-key "KPE" " - The Keypad Enter Key") ;; Save the enter key (setq edt-enter edt-key) (setq edt-enter-seq edt-key-seq) (set-buffer "Keys") (insert " ;; ;; Editing keypad (FIND, INSERT, REMOVE) ;; (SELECT, PREVIOUS, NEXT) ;; ") (set-buffer "Directions") (edt-map-key "FIND" " - The Find key on the editing keypad") (edt-map-key "INSERT" " - The Insert key on the editing keypad") (edt-map-key "REMOVE" " - The Remove key on the editing keypad") (edt-map-key "SELECT" " - The Select key on the editing keypad") (edt-map-key "PREVIOUS" " - The Prev Scr key on the editing keypad") (edt-map-key "NEXT" " - The Next Scr key on the editing keypad") (set-buffer "Keys") (insert " ;; ;; F1-14 Help Do F17-F20 ;; ") (set-buffer "Directions") (edt-map-key "F1" " - F1 Function Key") (edt-map-key "F2" " - F2 Function Key") (edt-map-key "F3" " - F3 Function Key") (edt-map-key "F4" " - F4 Function Key") (edt-map-key "F5" " - F5 Function Key") (edt-map-key "F6" " - F6 Function Key") (edt-map-key "F7" " - F7 Function Key") (edt-map-key "F8" " - F8 Function Key") (edt-map-key "F9" " - F9 Function Key") (edt-map-key "F10" " - F10 Function Key") (edt-map-key "F11" " - F11 Function Key") (edt-map-key "F12" " - F12 Function Key") (edt-map-key "F13" " - F13 Function Key") (edt-map-key "F14" " - F14 Function Key") (edt-map-key "HELP" " - HELP Function Key") (edt-map-key "DO" " - DO Function Key") (edt-map-key "F17" " - F17 Function Key") (edt-map-key "F18" " - F18 Function Key") (edt-map-key "F19" " - F19 Function Key") (edt-map-key "F20" " - F20 Function Key") (set-buffer "Directions") (delete-region (point-min) (point-max)) (insert " ADDITIONAL FUNCTION KEYS Your keyboard may have additional function keys which do not correspond to any LK-201 keys. The EDT Emulation can be configured to recognize those keys, since you may wish to add your own key bindings to those keys. For example, suppose your keyboard has a keycap marked \"Line Del\" and you wish to add it to the list of keys which can be customized by the EDT Emulation. First, assign a unique single-word name to the key for use by the EDT Emulation, let's say \"linedel\", in this example. Then, at the \"EDT Key Name:\" prompt, enter \"linedel\", followed by a press of the RETURN key. Finally, when prompted, press the \"Line Del\" key. You now will be able to bind functions to \"linedel\" and \"Gold-linedel\" in edt-user.el in just the same way you can customize bindings of the standard LK-201 keys. When you have no additional function keys to specify, just press RETURN at the \"EDT Key Name:\" prompt. (If you change your mind AFTER you enter an EDT Key Name and before you press a key at the \"Press\" prompt, you may omit the key by simply pressing RETURN at the prompt.) ") (switch-to-buffer "Directions") ;;; ;;; Add support for extras keys ;;; (set-buffer "Keys") (insert "\ ;; ;; Extra Keys ;; ") (setq EDT-key-name "") (while (not (string-equal (setq EDT-key-name (read-string "EDT Key Name: ")) "")) (edt-map-key EDT-key-name "")) ; ; No more keys to add, so wrap up. ; (set-buffer "Keys") (insert "\ ) ) ") ;;; ;;; Save the key mapping program and blow this pop stand ;;; (let ((file (if edt-lucid-emacs19-p "~/.edt-lucid-keys" "~/.edt-gnu-keys"))) (set-visited-file-name (read-file-name (format "Save key mapping to file (default %s): " file) nil file))) (save-buffer) (message "That's it! Press any key to exit") (sit-for 600) (kill-emacs t) ;;; edt-mapper.el ends here emacs-19.30/lisp/edt-pc.el100444 12120 1 7145 6045202054 13551 0ustar rmsdaemon;;; edt-pc.el --- Enhanced EDT Keypad Mode Emulation for PC 101 Keyboards ;; Copyright (C) 1986, 1994, 1995 Free Software Foundation, Inc. ;; Author: Kevin Gallagher ;; Maintainer: Kevin Gallagher ;; Keywords: emulations ;; 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. ;;; Usage: ;; See edt-user.doc in the Emacs etc directory. ;; ==================================================================== ;;;; ;;;; KEY TRANSLATIONS ;;;; ;; Associate EDT keynames with Emacs terminal function vector names. ;; ;; To emulate the DEC LK-201 keypad keys on the PC 101 keyboard, ;; NumLock must be ON. ;; ;; The PC keypad keys are mapped to the corresponding DEC LK-201 ;; keypad keys according to the corresponding physical possition on ;; the keyboard. Thus, the physical position of the PC keypad key ;; determines its function, not the PC keycap name. ;; ;; There are two LK-201 keypad keys needing special handling: PF1 and ;; the keypad comma key. ;; ;; PF1: ;; Most PC software does not see a press of the NumLock key. A TSR ;; program distributed with MS-Kermit to support its VT-100 emulation ;; solves this problem. The TSR, called GOLD, causes a press of the ;; keypad NumLock key to look as if the PC F1 key were pressed. So ;; the PC F1 key is mapped here to behave as the PF1 (GOLD) key. ;; Then with GOLD loaded, the NumLock key will behave as the GOLD key. ;; ;; By the way, with GOLD loaded, you can still toggle numlock on/off. ;; GOLD binds this to Shift-NumLock. ;; ;; Keypad Comma: ;; There is no physical PC keypad key to correspond to the LK-201 ;; keypad comma key. So, the EDT Emulation is configured below to ;; ignore attempts to bind functions to the keypad comma key. ;; ;; Finally, F2 through F12 are also available for making key bindings ;; in the EDT Emulation on the PC. F1 is reserved for the GOLD key, ;; so don't attempt to bind anything to it. Also, F13, F14, HELP, DO, ;; and F17 through F20 do not exist on the PC, so the EDT emulation is ;; configured below to ignore attempts to bind functions to those keys. ;; (defconst *EDT-keys* '(("KP0" . [kp-0]) ("KP1" . [kp-1]) ("KP2" . [kp-2]) ("KP3" . [kp-3]) ("KP4" . [kp-4]) ("KP5" . [kp-5]) ("KP6" . [kp-6]) ("KP7" . [kp-7]) ("KP8" . [kp-8]) ("KP9" . [kp-9]) ("KP," . "" ) ("KP-" . [kp-add]) ("KPP" . [kp-decimal]) ("KPE" . [kp-enter]) ("PF1" . [f1]) ("PF2" . [kp-divide]) ("PF3" . [kp-multiply]) ("PF4" . [kp-subtract]) ("UP" . [up]) ("DOWN" . [down]) ("RIGHT" . [right]) ("LEFT" . [left]) ("FIND" . [insert]) ("INSERT" . [home]) ("REMOVE" . [prior]) ("SELECT" . [delete]) ("PREVIOUS" . [end]) ("NEXT" . [next]) ("F1" . "" ) ("F2" . [f2]) ("F3" . [f3]) ("F4" . [f4]) ("F5" . [f5]) ("F6" . [f6]) ("F7" . [f7]) ("F8" . [f8]) ("F9" . [f9]) ("F10" . [f10]) ("F11" . [f11]) ("F12" . [f12]) ("F13" . "" ) ("F14" . "" ) ("HELP" . "" ) ("DO" . "" ) ("F17" . "" ) ("F18" . "" ) ("F19" . "" ) ("F20" . "" ))) emacs-19.30/lisp/edt-vt100.el100444 12120 1 2741 6045202130 14011 0ustar rmsdaemon;;; edt-vt100.el --- Enhanced EDT Keypad Mode Emulation for VT Series Terminals ;; Copyright (C) 1986, 1992, 1993, 1995 Free Software Foundation, Inc. ;; Author: Kevin Gallagher ;; Maintainer: Kevin Gallagher ;; Keywords: emulations ;; 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. ;;; Usage: ;; See edt-user.doc in the Emacs etc directory. ;; ==================================================================== ;; Get keyboard function key mapping to EDT keys. (load "edt-lk201" nil t) ;; The following functions are called by the EDT screen width commands defined ;; in edt.el. (defun edt-set-term-width-80 () "Set terminal width to 80 columns." (vt100-wide-mode -1)) (defun edt-set-term-width-132 () "Set terminal width to 132 columns." (vt100-wide-mode 1)) emacs-19.30/lisp/edt.el100444 12120 1 203666 6045202166 13223 0ustar rmsdaemon;;; edt.el --- Enhanced EDT Keypad Mode Emulation for GNU Emacs 19 ;; Copyright (C) 1986, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Kevin Gallagher ;; Maintainer: Kevin Gallagher ;; Keywords: emulations ;; 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. ;;; Usage: ;; See edt-user.doc in the Emacs etc directory. ;; ==================================================================== ;;; Electric Help functions are used for keypad help displays. A few ;;; picture functions are used in rectangular cut and paste commands. (require 'ehelp) (require 'picture) ;;;; ;;;; VARIABLES and CONSTANTS ;;;; (defvar edt-last-deleted-lines "" "Last text deleted by an EDT emulation line delete command.") (defvar edt-last-deleted-words "" "Last text deleted by an EDT emulation word delete command.") (defvar edt-last-deleted-chars "" "Last text deleted by an EDT emulation character delete command.") (defvar edt-last-replaced-key-definition "" "Key definition replaced with edt-define-key or edt-learn command.") (defvar edt-direction-string "" "String indicating current direction of movement.") (defvar edt-select-mode nil "Non-nil means select mode is active.") (defvar edt-select-mode-text "" "Text displayed in mode line when select mode is active.") (defconst edt-select-mode-string " Select" "String to indicate select mode is active.") (defconst edt-forward-string " ADVANCE" "Direction string in mode line to indicate forward movement.") (defconst edt-backward-string " BACKUP" "Direction string in mode line to indicate backward movement.") (defvar edt-default-map-active nil "Non-nil indicates that default EDT emulation key bindings are active. Nil means user-defined custom bindings are active.") (defvar edt-user-map-configured nil "Non-nil indicates that user custom EDT key bindings are configured. This means that an edt-user.el file was found in the user's load-path.") (defvar edt-keep-current-page-delimiter nil "Non-nil leaves current value of page-delimiter unchanged. Nil causes the page-delimiter variable to be set to to \"\\f\" when edt-emulation-on is first invoked. Original value is restored when edt-emulation-off is called.") (defvar edt-use-EDT-control-key-bindings nil "Non-nil causes the control key bindings to be replaced with EDT bindings. Nil (the default) means EDT control key bindings are not used and the current control key bindings are retained for use in the EDT emulation.") (defvar edt-word-entities '(?\t) "*Specifies the list of EDT word entity characters.") ;;; ;;; Emacs version identifiers - currently referenced by ;;; ;;; o edt-emulation-on o edt-load-xkeys ;;; (defconst edt-emacs19-p (not (string-lessp emacs-version "19")) "Non-nil if we are running Lucid or GNU Emacs version 19.") (defconst edt-lucid-emacs19-p (and edt-emacs19-p (string-match "Lucid" emacs-version)) "Non-nil if we are running Lucid Emacs version 19.") (defconst edt-gnu-emacs19-p (and edt-emacs19-p (not edt-lucid-emacs19-p)) "Non-nil if we are running GNU Emacs version 19.") (defvar edt-xkeys-file nil "File mapping X function keys to LK-201 keyboard function and keypad keys.") ;;;; ;;;; EDT Emulation Commands ;;;; ;;; Almost all of EDT's keypad mode commands have equivalent ;;; counterparts in Emacs. Some behave the same way in Emacs as they ;;; do in EDT, but most do not. ;;; ;;; The following Emacs functions emulate, where practical, the exact ;;; behavior of the corresponding EDT keypad mode commands. In a few ;;; cases, the emulation is not exact, but it is close enough for most ;;; EDT die-hards. ;;; ;;; In a very few cases, we chose to use the superior Emacs way of ;;; handling things. For example, we do not emulate the EDT SUBS ;;; command. Instead, we chose to use the superior Emacs ;;; query-replace function. ;;; ;;; ;;; PAGE ;;; ;;; Emacs uses the regexp assigned to page-delimiter to determine what ;;; marks a page break. This is normally "^\f", which causes the ;;; edt-page command to ignore form feeds not located at the beginning ;;; of a line. To emulate the EDT PAGE command exactly, ;;; page-delimiter is set to "\f" when EDT emulation is turned on, and ;;; restored to its original value when EDT emulation is turned off. ;;; But this can be overridden if the EDT definition is not desired by ;;; placing ;;; ;;; (setq edt-keep-current-page-delimiter t) ;;; ;;; in your .emacs file. (defun edt-page-forward (num) "Move forward to just after next page delimiter. Accepts a positive prefix argument for the number of page delimiters to move." (interactive "p") (edt-check-prefix num) (if (eobp) (error "End of buffer") (progn (forward-page num) (if (eobp) (edt-line-to-bottom-of-window) (edt-line-to-top-of-window))))) (defun edt-page-backward (num) "Move backward to just after previous page delimiter. Accepts a positive prefix argument for the number of page delimiters to move." (interactive "p") (edt-check-prefix num) (if (bobp) (error "Beginning of buffer") (progn (backward-page num) (edt-line-to-top-of-window)))) (defun edt-page (num) "Move in current direction to next page delimiter. Accepts a positive prefix argument for the number of page delimiters to move." (interactive "p") (if (equal edt-direction-string edt-forward-string) (edt-page-forward num) (edt-page-backward num))) ;;; ;;; SECT ;;; ;;; EDT defaults a section size to be 16 lines of its one and only ;;; 24-line window. That's two-thirds of the window at a time. The ;;; EDT SECT commands moves the cursor, not the window. ;;; ;;; This emulation of EDT's SECT moves the cursor approximately two-thirds ;;; of the current window at a time. (defun edt-sect-forward (num) "Move cursor forward two-thirds of a window. Accepts a positive prefix argument for the number of sections to move." (interactive "p") (edt-check-prefix num) (edt-line-forward (* (* (/ (- (window-height) 1) 3) 2) num))) (defun edt-sect-backward (num) "Move cursor backward two-thirds of a window. Accepts a positive prefix argument for the number of sections to move." (interactive "p") (edt-check-prefix num) (edt-line-backward (* (* (/ (- (window-height) 1) 3) 2) num))) (defun edt-sect (num) "Move in current direction a full window. Accepts a positive prefix argument for the number windows to move." (interactive "p") (if (equal edt-direction-string edt-forward-string) (edt-sect-forward num) (edt-sect-backward num))) ;;; ;;; BEGINNING OF LINE ;;; ;;; EDT's beginning-of-line command is not affected by current ;;; direction, for some unknown reason. (defun edt-beginning-of-line (num) "Move backward to next beginning of line mark. Accepts a positive prefix argument for the number of BOL marks to move." (interactive "p") (edt-check-prefix num) (if (bolp) (forward-line (* -1 num)) (progn (setq num (1- num)) (forward-line (* -1 num))))) ;;; ;;; EOL (End of Line) ;;; (defun edt-end-of-line-forward (num) "Move forward to next end of line mark. Accepts a positive prefix argument for the number of EOL marks to move." (interactive "p") (edt-check-prefix num) (forward-char) (end-of-line num)) (defun edt-end-of-line-backward (num) "Move backward to next end of line mark. Accepts a positive prefix argument for the number of EOL marks to move." (interactive "p") (edt-check-prefix num) (end-of-line (1- num))) (defun edt-end-of-line (num) "Move in current direction to next end of line mark. Accepts a positive prefix argument for the number of EOL marks to move." (interactive "p") (if (equal edt-direction-string edt-forward-string) (edt-end-of-line-forward num) (edt-end-of-line-backward num))) ;;; ;;; WORD ;;; ;;; This one is a tad messy. To emulate EDT's behavior everywhere in ;;; the file (beginning of file, end of file, beginning of line, end ;;; of line, etc.) it takes a bit of special handling. ;;; ;;; The variable edt-word-entities contains a list of characters which ;;; are to be viewed as distinct words where ever they appear in the ;;; buffer. This emulates the EDT line mode command SET ENTITY WORD. (defun edt-one-word-forward () "Move forward to first character of next word." (interactive) (if (eobp) (error "End of buffer")) (if (eolp) (forward-char) (progn (if (memq (following-char) edt-word-entities) (forward-char) (while (and (not (eolp)) (not (eobp)) (not (eq ?\ (char-syntax (following-char)))) (not (memq (following-char) edt-word-entities))) (forward-char))) (while (and (not (eolp)) (not (eobp)) (eq ?\ (char-syntax (following-char))) (not (memq (following-char) edt-word-entities))) (forward-char))))) (defun edt-one-word-backward () "Move backward to first character of previous word." (interactive) (if (bobp) (error "Beginning of buffer")) (if (bolp) (backward-char) (progn (backward-char) (while (and (not (bolp)) (not (bobp)) (eq ?\ (char-syntax (following-char))) (not (memq (following-char) edt-word-entities))) (backward-char)) (if (not (memq (following-char) edt-word-entities)) (while (and (not (bolp)) (not (bobp)) (not (eq ?\ (char-syntax (preceding-char)))) (not (memq (preceding-char) edt-word-entities))) (backward-char)))))) (defun edt-word-forward (num) "Move forward to first character of next word. Accepts a positive prefix argument for the number of words to move." (interactive "p") (edt-check-prefix num) (while (> num 0) (edt-one-word-forward) (setq num (1- num)))) (defun edt-word-backward (num) "Move backward to first character of previous word. Accepts a positive prefix argument for the number of words to move." (interactive "p") (edt-check-prefix num) (while (> num 0) (edt-one-word-backward) (setq num (1- num)))) (defun edt-word (num) "Move in current direction to first character of next word. Accepts a positive prefix argument for the number of words to move." (interactive "p") (if (equal edt-direction-string edt-forward-string) (edt-word-forward num) (edt-word-backward num))) ;;; ;;; CHAR ;;; (defun edt-character (num) "Move in current direction to next character. Accepts a positive prefix argument for the number of characters to move." (interactive "p") (edt-check-prefix num) (if (equal edt-direction-string edt-forward-string) (forward-char num) (backward-char num))) ;;; ;;; LINE ;;; ;;; When direction is set to BACKUP, LINE behaves just like BEGINNING ;;; OF LINE in EDT. So edt-line-backward is not really needed as a ;;; separate function. (defun edt-line-backward (num) "Move backward to next beginning of line mark. Accepts a positive prefix argument for the number of BOL marks to move." (interactive "p") (edt-beginning-of-line num)) (defun edt-line-forward (num) "Move forward to next beginning of line mark. Accepts a positive prefix argument for the number of BOL marks to move." (interactive "p") (edt-check-prefix num) (forward-line num)) (defun edt-line (num) "Move in current direction to next beginning of line mark. Accepts a positive prefix argument for the number of BOL marks to move." (interactive "p") (if (equal edt-direction-string edt-forward-string) (edt-line-forward num) (edt-line-backward num))) ;;; ;;; TOP ;;; (defun edt-top () "Move cursor to the beginning of buffer." (interactive) (goto-char (point-min))) ;;; ;;; BOTTOM ;;; (defun edt-bottom () "Move cursor to the end of buffer." (interactive) (goto-char (point-max)) (edt-line-to-bottom-of-window)) ;;; ;;; FIND ;;; (defun edt-find-forward (&optional find) "Find first occurance of a string in forward direction and save it." (interactive) (if (not find) (set 'search-last-string (read-string "Search forward: "))) (if (search-forward search-last-string) (search-backward search-last-string))) (defun edt-find-backward (&optional find) "Find first occurance of a string in the backward direction and save it." (interactive) (if (not find) (set 'search-last-string (read-string "Search backward: "))) (search-backward search-last-string)) (defun edt-find () "Find first occurance of string in current direction and save it." (interactive) (set 'search-last-string (read-string "Search: ")) (if (equal edt-direction-string edt-forward-string) (edt-find-forward t) (edt-find-backward t))) ;;; ;;; FNDNXT ;;; (defun edt-find-next-forward () "Find next occurance of a string in forward direction." (interactive) (forward-char 1) (if (search-forward search-last-string nil t) (search-backward search-last-string) (progn (backward-char 1) (error "Search failed: \"%s\"." search-last-string)))) (defun edt-find-next-backward () "Find next occurance of a string in backward direction." (interactive) (if (eq (search-backward search-last-string nil t) nil) (progn (error "Search failed: \"%s\"." search-last-string)))) (defun edt-find-next () "Find next occurance of a string in current direction." (interactive) (if (equal edt-direction-string edt-forward-string) (edt-find-next-forward) (edt-find-next-backward))) ;;; ;;; APPEND ;;; (defun edt-append () "Append this kill region to last killed region." (interactive "*") (edt-check-selection) (append-next-kill) (kill-region (mark) (point)) (message "Selected text APPENDED to kill ring")) ;;; ;;; DEL L ;;; (defun edt-delete-line (num) "Delete from cursor up to and including the end of line mark. Accepts a positive prefix argument for the number of lines to delete." (interactive "*p") (edt-check-prefix num) (let ((beg (point))) (forward-line num) (if (not (eq (preceding-char) ?\n)) (insert "\n")) (setq edt-last-deleted-lines (buffer-substring beg (point))) (delete-region beg (point)))) ;;; ;;; DEL EOL ;;; (defun edt-delete-to-end-of-line (num) "Delete from cursor up to but excluding the end of line mark. Accepts a positive prefix argument for the number of lines to delete." (interactive "*p") (edt-check-prefix num) (let ((beg (point))) (forward-char 1) (end-of-line num) (setq edt-last-deleted-lines (buffer-substring beg (point))) (delete-region beg (point)))) ;;; ;;; SELECT ;;; (defun edt-select-mode (arg) "Turn EDT select mode off if ARG is nil; otherwise, turn EDT select mode on. In select mode, selected text is highlighted." (if arg (progn (make-local-variable 'edt-select-mode) (setq edt-select-mode 'edt-select-mode-text) (setq rect-start-point (window-point))) (progn (kill-local-variable 'edt-select-mode))) (force-mode-line-update)) (defun edt-select () "Set mark at cursor and start text selection." (interactive) (set-mark-command nil)) (defun edt-reset () "Cancel text selection." (interactive) (deactivate-mark)) ;;; ;;; CUT ;;; (defun edt-cut () "Deletes selected text but copies to kill ring." (interactive "*") (edt-check-selection) (kill-region (mark) (point)) (message "Selected text CUT to kill ring")) ;;; ;;; DELETE TO BEGINNING OF LINE ;;; (defun edt-delete-to-beginning-of-line (num) "Delete from cursor to beginning of line. Accepts a positive prefix argument for the number of lines to delete." (interactive "*p") (edt-check-prefix num) (let ((beg (point))) (edt-beginning-of-line num) (setq edt-last-deleted-lines (buffer-substring (point) beg)) (delete-region beg (point)))) ;;; ;;; DEL W ;;; (defun edt-delete-word (num) "Delete from cursor up to but excluding first character of next word. Accepts a positive prefix argument for the number of words to delete." (interactive "*p") (edt-check-prefix num) (let ((beg (point))) (edt-word-forward num) (setq edt-last-deleted-words (buffer-substring beg (point))) (delete-region beg (point)))) ;;; ;;; DELETE TO BEGINNING OF WORD ;;; (defun edt-delete-to-beginning-of-word (num) "Delete from cursor to beginning of word. Accepts a positive prefix argument for the number of words to delete." (interactive "*p") (edt-check-prefix num) (let ((beg (point))) (edt-word-backward num) (setq edt-last-deleted-words (buffer-substring (point) beg)) (delete-region beg (point)))) ;;; ;;; DEL C ;;; (defun edt-delete-character (num) "Delete character under cursor. Accepts a positive prefix argument for the number of characters to delete." (interactive "*p") (edt-check-prefix num) (setq edt-last-deleted-chars (buffer-substring (point) (min (point-max) (+ (point) num)))) (delete-region (point) (min (point-max) (+ (point) num)))) ;;; ;;; DELETE CHAR ;;; (defun edt-delete-previous-character (num) "Delete character in front of cursor. Accepts a positive prefix argument for the number of characters to delete." (interactive "*p") (edt-check-prefix num) (setq edt-last-deleted-chars (buffer-substring (max (point-min) (- (point) num)) (point))) (delete-region (max (point-min) (- (point) num)) (point))) ;;; ;;; UND L ;;; (defun edt-undelete-line () "Undelete previous deleted line(s)." (interactive "*") (point-to-register 1) (insert edt-last-deleted-lines) (register-to-point 1)) ;;; ;;; UND W ;;; (defun edt-undelete-word () "Undelete previous deleted word(s)." (interactive "*") (point-to-register 1) (insert edt-last-deleted-words) (register-to-point 1)) ;;; ;;; UND C ;;; (defun edt-undelete-character () "Undelete previous deleted character(s)." (interactive "*") (point-to-register 1) (insert edt-last-deleted-chars) (register-to-point 1)) ;;; ;;; REPLACE ;;; (defun edt-replace () "Replace marked section with last CUT (killed) text." (interactive "*") (exchange-point-and-mark) (let ((beg (point))) (exchange-point-and-mark) (delete-region beg (point))) (yank)) ;;; ;;; ADVANCE ;;; (defun edt-advance () "Set movement direction forward. Also, execute command specified if in Minibuffer." (interactive) (setq edt-direction-string edt-forward-string) (force-mode-line-update) (if (string-equal " *Minibuf" (substring (buffer-name) 0 (min (length (buffer-name)) 9))) (exit-minibuffer))) ;;; ;;; BACKUP ;;; (defun edt-backup () "Set movement direction backward. Also, execute command specified if in Minibuffer." (interactive) (setq edt-direction-string edt-backward-string) (force-mode-line-update) (if (string-equal " *Minibuf" (substring (buffer-name) 0 (min (length (buffer-name)) 9))) (exit-minibuffer))) ;;; ;;; CHNGCASE ;;; ;; This function is based upon Jeff Kowalski's case-flip function in his ;; tpu.el. (defun edt-change-case (num) "Change the case of specified characters. If text selection IS active, then characters between the cursor and mark are changed. If text selection is NOT active, there are two cases. First, if the current direction is ADVANCE, then the prefix number of character(s) under and following cursor are changed. Second, if the current direction is BACKUP, then the prefix number of character(s) before the cursor are changed. Accepts a positive prefix for the number of characters to change, but the prefix is ignored if text selection is active." (interactive "*p") (edt-check-prefix num) (if edt-select-mode (let ((end (max (mark) (point))) (point-save (point))) (goto-char (min (point) (mark))) (while (not (eq (point) end)) (funcall (if (<= ?a (following-char)) 'upcase-region 'downcase-region) (point) (1+ (point))) (forward-char 1)) (goto-char point-save)) (progn (if (string= edt-direction-string edt-backward-string) (backward-char num)) (while (> num 0) (funcall (if (<= ?a (following-char)) 'upcase-region 'downcase-region) (point) (1+ (point))) (forward-char 1) (setq num (1- num)))))) ;;; ;;; DEFINE KEY ;;; (defun edt-define-key () "Assign an interactively-callable function to a specified key sequence. The current key definition is saved in edt-last-replaced-key-definition. Use edt-restore-key to restore last replaced key definition." (interactive) (let (edt-function edt-key-definition-string) (setq edt-key-definition-string (read-key-sequence "Press the key to be defined: ")) (if (string-equal "\C-m" edt-key-definition-string) (message "Key not defined") (progn (setq edt-function (read-command "Enter command name: ")) (if (string-equal "" edt-function) (message "Key not defined") (progn (setq edt-last-replaced-key-definition (lookup-key (current-global-map) edt-key-definition-string)) (define-key (current-global-map) edt-key-definition-string edt-function))))))) ;;; ;;; FORM FEED INSERT ;;; (defun edt-form-feed-insert (num) "Insert form feed character at cursor position. Accepts a positive prefix argument for the number of form feeds to insert." (interactive "*p") (edt-check-prefix num) (while (> num 0) (insert ?\f) (setq num (1- num)))) ;;; ;;; TAB INSERT ;;; (defun edt-tab-insert (num) "Insert tab character at cursor position. Accepts a positive prefix argument for the number of tabs to insert." (interactive "*p") (edt-check-prefix num) (while (> num 0) (insert ?\t) (setq num (1- num)))) ;;; ;;; Check Prefix ;;; (defun edt-check-prefix (num) "Indicate error if prefix is not positive." (if (<= num 0) (error "Prefix must be positive"))) ;;; ;;; Check Selection ;;; (defun edt-check-selection () "Indicate error if EDT selection is not active." (if (not edt-select-mode) (error "Selection NOT active"))) ;;;; ;;;; ENHANCEMENTS AND ADDITIONS FOR EDT KEYPAD MODE ;;;; ;;; ;;; Several enhancements and additions to EDT keypad mode commands are ;;; provided here. Some of these have been motivated by similar ;;; TPU/EVE and EVE-Plus commands. Others are new. ;;; ;;; CHANGE DIRECTION ;;; (defun edt-change-direction () "Toggle movement direction." (interactive) (if (equal edt-direction-string edt-forward-string) (edt-backup) (edt-advance))) ;;; ;;; TOGGLE SELECT ;;; (defun edt-toggle-select () "Toggle to start (or cancel) text selection." (interactive) (if edt-select-mode (edt-reset) (edt-select))) ;;; ;;; SENTENCE ;;; (defun edt-sentence-forward (num) "Move forward to start of next sentence. Accepts a positive prefix argument for the number of sentences to move." (interactive "p") (edt-check-prefix num) (if (eobp) (progn (error "End of buffer")) (progn (forward-sentence num) (edt-one-word-forward)))) (defun edt-sentence-backward (num) "Move backward to next sentence beginning. Accepts a positive prefix argument for the number of sentences to move." (interactive "p") (edt-check-prefix num) (if (eobp) (progn (error "End of buffer")) (backward-sentence num))) (defun edt-sentence (num) "Move in current direction to next sentence. Accepts a positive prefix argument for the number of sentences to move." (interactive "p") (if (equal edt-direction-string edt-forward-string) (edt-sentence-forward num) (edt-sentence-backward num))) ;;; ;;; PARAGRAPH ;;; (defun edt-paragraph-forward (num) "Move forward to beginning of paragraph. Accepts a positive prefix argument for the number of paragraphs to move." (interactive "p") (edt-check-prefix num) (while (> num 0) (next-line 1) (forward-paragraph) (previous-line 1) (if (eolp) (next-line 1)) (setq num (1- num)))) (defun edt-paragraph-backward (num) "Move backward to beginning of paragraph. Accepts a positive prefix argument for the number of paragraphs to move." (interactive "p") (edt-check-prefix num) (while (> num 0) (backward-paragraph) (previous-line 1) (if (eolp) (next-line 1)) (setq num (1- num)))) (defun edt-paragraph (num) "Move in current direction to next paragraph. Accepts a positive prefix argument for the number of paragraph to move." (interactive "p") (if (equal edt-direction-string edt-forward-string) (edt-paragraph-forward num) (edt-paragraph-backward num))) ;;; ;;; RESTORE KEY ;;; (defun edt-restore-key () "Restore last replaced key definition. Definition is stored in edt-last-replaced-key-definition." (interactive) (if edt-last-replaced-key-definition (progn (let (edt-key-definition-string) (set 'edt-key-definition-string (read-key-sequence "Press the key to be restored: ")) (if (string-equal "\C-m" edt-key-definition-string) (message "Key not restored") (define-key (current-global-map) edt-key-definition-string edt-last-replaced-key-definition)))) (error "No replaced key definition to restore!"))) ;;; ;;; WINDOW TOP ;;; (defun edt-window-top () "Move the cursor to the top of the window." (interactive) (let ((start-column (current-column))) (move-to-window-line 0) (move-to-column start-column))) ;;; ;;; WINDOW BOTTOM ;;; (defun edt-window-bottom () "Move the cursor to the bottom of the window." (interactive) (let ((start-column (current-column))) (move-to-window-line (- (window-height) 2)) (move-to-column start-column))) ;;; ;;; SCROLL WINDOW LINE ;;; (defun edt-scroll-window-forward-line () "Move window forward one line leaving cursor at position in window." (interactive) (scroll-up 1)) (defun edt-scroll-window-backward-line () "Move window backward one line leaving cursor at position in window." (interactive) (scroll-down 1)) (defun edt-scroll-line () "Move window one line in current direction." (interactive) (if (equal edt-direction-string edt-forward-string) (edt-scroll-window-forward-line) (edt-scroll-window-backward-line))) ;;; ;;; SCROLL WINDOW ;;; ;;; Scroll a window (less one line) at a time. Leave cursor in center of ;;; window. (defun edt-scroll-window-forward (num) "Scroll forward one window in buffer, less one line. Accepts a positive prefix argument for the number of windows to move." (interactive "p") (edt-check-prefix num) (scroll-up (- (* (window-height) num) 2)) (edt-line-forward (/ (- (window-height) 1) 2))) (defun edt-scroll-window-backward (num) "Scroll backward one window in buffer, less one line. Accepts a positive prefix argument for the number of windows to move." (interactive "p") (edt-check-prefix num) (scroll-down (- (* (window-height) num) 2)) (edt-line-backward (/ (- (window-height) 1) 2))) (defun edt-scroll-window (num) "Scroll one window in buffer, less one line, in current direction. Accepts a positive prefix argument for the number windows to move." (interactive "p") (if (equal edt-direction-string edt-forward-string) (edt-scroll-window-forward num) (edt-scroll-window-backward num))) ;;; ;;; LINE TO BOTTOM OF WINDOW ;;; (defun edt-line-to-bottom-of-window () "Move the current line to the bottom of the window." (interactive) (recenter -1)) ;;; ;;; LINE TO TOP OF WINDOW ;;; (defun edt-line-to-top-of-window () "Move the current line to the top of the window." (interactive) (recenter 0)) ;;; ;;; LINE TO MIDDLE OF WINDOW ;;; (defun edt-line-to-middle-of-window () "Move window so line with cursor is in the middle of the window." (interactive) (recenter '(4))) ;;; ;;; GOTO PERCENTAGE ;;; (defun edt-goto-percentage (num) "Move to specified percentage in buffer from top of buffer." (interactive "NGoto-percentage: ") (if (or (> num 100) (< num 0)) (error "Percentage %d out of range 0 < percent < 100" num) (goto-char (/ (* (point-max) num) 100)))) ;;; ;;; FILL REGION ;;; (defun edt-fill-region () "Fill selected text." (interactive "*") (edt-check-selection) (fill-region (point) (mark))) ;;; ;;; INDENT OR FILL REGION ;;; (defun edt-indent-or-fill-region () "Fill region in text modes, indent region in programming language modes." (interactive "*") (if (string= paragraph-start "$\\|\f") (indent-region (point) (mark) nil) (fill-region (point) (mark)))) ;;; ;;; MARK SECTION WISELY ;;; (defun edt-mark-section-wisely () "Mark the section in a manner consistent with the major-mode. Uses mark-defun for emacs-lisp and lisp, mark-c-function for C, mark-fortran-subsystem for fortran, and mark-paragraph for other modes." (interactive) (if edt-select-mode (progn (edt-reset)) (progn (cond ((or (eq major-mode 'emacs-lisp-mode) (eq major-mode 'lisp-mode)) (mark-defun) (message "Lisp defun selected")) ((eq major-mode 'c-mode) (mark-c-function) (message "C function selected")) ((eq major-mode 'fortran-mode) (mark-fortran-subprogram) (message "Fortran subprogram selected")) (t (mark-paragraph) (message "Paragraph selected")))))) ;;; ;;; COPY ;;; (defun edt-copy () "Copy selected region to kill ring, but don't delete it!" (interactive) (edt-check-selection) (copy-region-as-kill (mark) (point)) (edt-reset) (message "Selected text COPIED to kill ring")) ;;; ;;; CUT or COPY ;;; (defun edt-cut-or-copy () "Cuts (or copies) selected text to kill ring. Cuts selected text if buffer-read-only is nil. Copies selected text if buffer-read-only is t." (interactive) (if buffer-read-only (edt-copy) (edt-cut))) ;;; ;;; DELETE ENTIRE LINE ;;; (defun edt-delete-entire-line () "Delete entire line regardless of cursor position in the line." (interactive "*") (beginning-of-line) (edt-delete-line 1)) ;;; ;;; DUPLICATE LINE ;;; (defun edt-duplicate-line (num) "Duplicate a line of text. Accepts a positive prefix argument for the number times to duplicate the line." (interactive "*p") (edt-check-prefix num) (let ((old-column (current-column)) (count num)) (edt-delete-entire-line) (edt-undelete-line) (while (> count 0) (edt-undelete-line) (setq count (1- count))) (edt-line-forward num) (move-to-column old-column))) ;;; ;;; DUPLICATE WORD ;;; (defun edt-duplicate-word() "Duplicate word (or rest of word) found directly above cursor, if any." (interactive "*") (let ((start (point)) (start-column (current-column))) (forward-line -1) (move-to-column start-column) (if (and (not (equal start (point))) (not (eolp))) (progn (if (and (equal ?\t (preceding-char)) (< start-column (current-column))) (backward-char)) (let ((beg (point))) (edt-one-word-forward) (setq edt-last-copied-word (buffer-substring beg (point)))) (forward-line) (move-to-column start-column) (insert edt-last-copied-word)) (progn (if (not (equal start (point))) (forward-line)) (move-to-column start-column) (error "Nothing to duplicate!"))))) ;;; ;;; KEY NOT ASSIGNED ;;; (defun edt-key-not-assigned () "Displays message that key has not been assigned to a function." (interactive) (error "Key not assigned")) ;;; ;;; TOGGLE CAPITALIZATION OF WORD ;;; (defun edt-toggle-capitalization-of-word () "Toggle the capitalization of the current word and move forward to next." (interactive "*") (edt-one-word-forward) (edt-one-word-backward) (edt-change-case 1) (edt-one-word-backward) (edt-one-word-forward)) ;;; ;;; ELIMINATE ALL TABS ;;; (defun edt-eliminate-all-tabs () "Convert all tabs to spaces in the entire buffer." (interactive "*") (untabify (point-min) (point-max)) (message "TABS converted to SPACES")) ;;; ;;; DISPLAY THE TIME ;;; (defun edt-display-the-time () "Display the current time." (interactive) (set 'time-string (current-time-string)) (message time-string)) ;;; ;;; LEARN ;;; (defun edt-learn () "Learn a sequence of key strokes to bind to a key." (interactive) (if (eq defining-kbd-macro t) (edt-remember) (start-kbd-macro nil))) ;;; ;;; REMEMBER ;;; (defun edt-remember () "Store the sequence of key strokes started by edt-learn to a key." (interactive) (if (eq defining-kbd-macro nil) (error "Nothing to remember!") (progn (end-kbd-macro nil) (let (edt-key-definition-string) (set 'edt-key-definition-string (read-key-sequence "Enter key for binding: ")) (if (string-equal "\C-m" edt-key-definition-string) (message "Key sequence not remembered") (progn (set 'edt-learn-macro-count (+ edt-learn-macro-count 1)) (setq edt-last-replaced-key-definition (lookup-key (current-global-map) edt-key-definition-string)) (define-key (current-global-map) edt-key-definition-string (name-last-kbd-macro (intern (concat "last-learned-sequence-" (int-to-string edt-learn-macro-count))))))))))) ;;; ;;; EXIT ;;; (defun edt-exit () "Save current buffer, ask to save other buffers, and then exit Emacs." (interactive) (save-buffer) (save-buffers-kill-emacs)) ;;; ;;; QUIT ;;; (defun edt-quit () "Quit Emacs without saving changes." (interactive) (kill-emacs)) ;;; ;;; SPLIT WINDOW ;;; (defun edt-split-window () "Split current window and place cursor in the new window." (interactive) (split-window) (other-window 1)) ;;; ;;; COPY RECTANGLE ;;; (defun edt-copy-rectangle () "Copy a rectangle of text between mark and cursor to register." (interactive) (edt-check-selection) (copy-rectangle-to-register 3 (region-beginning) (region-end) nil) (edt-reset) (message "Selected rectangle COPIED to register")) ;;; ;;; CUT RECTANGLE ;;; (defun edt-cut-rectangle-overstrike-mode () "Cut a rectangle of text between mark and cursor to register. Replace cut characters with spaces and moving cursor back to upper left corner." (interactive "*") (edt-check-selection) (setq edt-rect-start-point (region-beginning)) (picture-clear-rectangle-to-register (region-beginning) (region-end) 3) (set-window-point (get-buffer-window (window-buffer)) edt-rect-start-point) (message "Selected rectangle CUT to register")) (defun edt-cut-rectangle-insert-mode () "Cut a rectangle of text between mark and cursor to register. Move cursor back to upper left corner." (interactive "*") (edt-check-selection) (setq edt-rect-start-point (region-beginning)) (picture-clear-rectangle-to-register (region-beginning) (region-end) 3 t) (fixup-whitespace) (set-window-point (get-buffer-window (window-buffer)) edt-rect-start-point) (message "Selected rectangle CUT to register")) (defun edt-cut-rectangle () "Cut a rectangular region of text to register. If overwrite mode is active, cut text is replaced with whitespace." (interactive "*") (if overwrite-mode (edt-cut-rectangle-overstrike-mode) (edt-cut-rectangle-insert-mode))) ;;; ;;; PASTE RECTANGLE ;;; (defun edt-paste-rectangle-overstrike-mode () "Paste a rectangular region of text from register, replacing text at cursor." (interactive "*") (picture-yank-rectangle-from-register 3)) (defun edt-paste-rectangle-insert-mode () "Paste previously deleted rectangular region, inserting text at cursor." (interactive "*") (picture-yank-rectangle-from-register 3 t)) (defun edt-paste-rectangle () "Paste a rectangular region of text. If overwrite mode is active, existing text is replace with text from register." (interactive) (if overwrite-mode (edt-paste-rectangle-overstrike-mode) (edt-paste-rectangle-insert-mode))) ;;; ;;; DOWNCASE REGION ;;; (defun edt-lowercase () "Change specified characters to lower case. If text selection IS active, then characters between the cursor and mark are changed. If text selection is NOT active, there are two situations. If the current direction is ADVANCE, then the word under the cursor is changed to lower case and the cursor is moved to rest at the beginning of the next word. If the current direction is BACKUP, the word prior to the word under the cursor is changed to lower case and the cursor is left to rest at the beginning of that word." (interactive "*") (if edt-select-mode (progn (downcase-region (mark) (point))) (progn ;; Move to beginning of current word. (if (and (not (bobp)) (not (eobp)) (not (bolp)) (not (eolp)) (not (eq ?\ (char-syntax (preceding-char)))) (not (memq (preceding-char) edt-word-entities)) (not (memq (following-char) edt-word-entities))) (edt-one-word-backward)) (if (equal edt-direction-string edt-backward-string) (edt-one-word-backward)) (let ((beg (point))) (edt-one-word-forward) (downcase-region beg (point))) (if (equal edt-direction-string edt-backward-string) (edt-one-word-backward))))) ;;; ;;; UPCASE REGION ;;; (defun edt-uppercase () "Change specified characters to upper case. If text selection IS active, then characters between the cursor and mark are changed. If text selection is NOT active, there are two situations. If the current direction is ADVANCE, then the word under the cursor is changed to upper case and the cursor is moved to rest at the beginning of the next word. If the current direction is BACKUP, the word prior to the word under the cursor is changed to upper case and the cursor is left to rest at the beginning of that word." (interactive "*") (if edt-select-mode (progn (upcase-region (mark) (point))) (progn ;; Move to beginning of current word. (if (and (not (bobp)) (not (eobp)) (not (bolp)) (not (eolp)) (not (eq ?\ (char-syntax (preceding-char)))) (not (memq (preceding-char) edt-word-entities)) (not (memq (following-char) edt-word-entities))) (edt-one-word-backward)) (if (equal edt-direction-string edt-backward-string) (edt-one-word-backward)) (let ((beg (point))) (edt-one-word-forward) (upcase-region beg (point))) (if (equal edt-direction-string edt-backward-string) (edt-one-word-backward))))) ;;; ;;; INITIALIZATION COMMANDS. ;;; ;;; ;;; Emacs version 19 X-windows key definition support ;;; (defvar edt-last-answer nil "Most recent response to edt-y-or-n-p.") (defun edt-y-or-n-p (prompt &optional not-yes) "Prompt for a y or n answer with positive default. Optional second argument NOT-YES changes default to negative. Like emacs y-or-n-p, also accepts space as y and DEL as n." (message (format "%s[%s]" prompt (if not-yes "n" "y"))) (let ((doit t)) (while doit (setq doit nil) (let ((ans (read-char))) (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\ )) (setq edt-last-answer t)) ((or (= ans ?n) (= ans ?N) (= ans ?\C-?)) (setq edt-last-answer nil)) ((= ans ?\r) (setq edt-last-answer (not not-yes))) (t (setq doit t) (beep) (message (format "Please answer y or n. %s[%s]" prompt (if not-yes "n" "y")))))))) edt-last-answer) (defun edt-load-xkeys (file) "Load the EDT X-windows key definitions FILE. If FILE is nil, try to load a default file. The default file names are ~/.edt-lucid-keys for Lucid emacs, and ~/.edt-gnu-keys for GNU emacs." (interactive "fX key definition file: ") (cond (file (setq file (expand-file-name file))) (edt-xkeys-file (setq file (expand-file-name edt-xkeys-file))) (edt-gnu-emacs19-p (setq file (expand-file-name "~/.edt-gnu-keys"))) (edt-lucid-emacs19-p (setq file (expand-file-name "~/.edt-lucid-keys")))) (cond ((file-readable-p file) (load-file file)) (t (switch-to-buffer "*scratch*") (erase-buffer) (insert " Ack!! You're running the Enhanced EDT Emulation under X-windows without loading an EDT X key definition file. To create an EDT X key definition file, run the edt-mapper.el program. But ONLY run it from an Emacs loaded without any of your own customizations found in your .emacs file, etc. Some user customization confuse the edt-mapper function. To do this, you need to invoke Emacs as follows: emacs -q -l edt-mapper.el The file edt-mapper.el includes these same directions on how to use it! Perhaps it's laying around here someplace. \n ") (let ((file "edt-mapper.el") (found nil) (path nil) (search-list (append (list (expand-file-name ".")) load-path))) (while (and (not found) search-list) (setq path (concat (car search-list) (if (string-match "/$" (car search-list)) "" "/") file)) (if (and (file-exists-p path) (not (file-directory-p path))) (setq found t)) (setq search-list (cdr search-list))) (cond (found (insert (format "Ah yes, there it is, in \n\n %s \n\n" path)) (if (edt-y-or-n-p "Do you want to run it now? ") (load-file path) (error "EDT Emulation not configured."))) (t (insert "Nope, I can't seem to find it. :-(\n\n") (sit-for 20) (error "EDT Emulation not configured."))))))) ;;;###autoload (defun edt-emulation-on () "Turn on EDT Emulation." (interactive) ;; If using MS-DOS, need to load edt-pc.el (if (string-equal system-type "ms-dos") (setq edt-term "pc") (setq edt-term (getenv "TERM"))) ;; All DEC VT series terminals are supported by loading edt-vt100.el (if (string-equal "vt" (substring edt-term 0 (min (length edt-term) 2))) (setq edt-term "vt100")) ;; Load EDT terminal specific configuration file. (let ((term edt-term) hyphend) (while (and term (not (load (concat "edt-" term) t t))) ;; Strip off last hyphen and what follows, then try again (if (setq hyphend (string-match "[-_][^-_]+$" term)) (setq term (substring term 0 hyphend)) (setq term nil))) ;; Override terminal-specific file if running X Windows. X Windows support ;; is handled differently in edt-load-xkeys (if (eq window-system 'x) (edt-load-xkeys nil) (if (null term) (error "Unable to load EDT terminal specific file for %s" edt-term))) (setq edt-term term)) (setq edt-orig-transient-mark-mode transient-mark-mode) (add-hook 'activate-mark-hook (function (lambda () (edt-select-mode t)))) (add-hook 'deactivate-mark-hook (function (lambda () (edt-select-mode nil)))) (if (load "edt-user" t t) (edt-user-emulation-setup) (edt-default-emulation-setup))) (defun edt-emulation-off() "Select original global key bindings, disabling EDT Emulation." (interactive) (use-global-map global-map) (if (not edt-keep-current-page-delimiter) (setq page-delimiter edt-orig-page-delimiter)) (setq edt-direction-string "") (setq edt-select-mode-text nil) (edt-reset) (force-mode-line-update t) (setq transient-mark-mode edt-orig-transient-mark-mode) (message "Original key bindings restored; EDT Emulation disabled")) (defun edt-default-emulation-setup (&optional user-setup) "Setup emulation of DEC's EDT editor." ;; Setup default EDT global map by copying global map bindings. ;; This preserves ESC and C-x prefix bindings and other bindings we ;; wish to retain in EDT emulation mode keymaps. It also permits ;; customization of these bindings in the EDT global maps without ;; disturbing the original bindings in global-map. (fset 'edt-default-ESC-prefix (copy-keymap 'ESC-prefix)) (setq edt-default-global-map (copy-keymap (current-global-map))) (define-key edt-default-global-map "\e" 'edt-default-ESC-prefix) (define-prefix-command 'edt-default-gold-map) (edt-setup-default-bindings) ;; If terminal has additional function keys, the terminal-specific ;; initialization file can assign bindings to them via the optional ;; function edt-setup-extra-default-bindings. (if (fboundp 'edt-setup-extra-default-bindings) (edt-setup-extra-default-bindings)) ;; Variable needed by edt-learn. (setq edt-learn-macro-count 0) ;; Display EDT text selection active within the mode line (or (assq 'edt-select-mode minor-mode-alist) (setq minor-mode-alist (cons '(edt-select-mode edt-select-mode) minor-mode-alist))) ;; Display EDT direction of motion within the mode line (or (assq 'edt-direction-string minor-mode-alist) (setq minor-mode-alist (cons '(edt-direction-string edt-direction-string) minor-mode-alist))) (if user-setup (progn (setq edt-user-map-configured t) (fset 'edt-emulation-on (symbol-function 'edt-select-user-global-map))) (progn (fset 'edt-emulation-on (symbol-function 'edt-select-default-global-map)) (edt-select-default-global-map)))) (defun edt-user-emulation-setup () "Setup user custom emulation of DEC's EDT editor." ;; Initialize EDT default bindings. (edt-default-emulation-setup t) ;; Setup user EDT global map by copying default EDT global map bindings. (fset 'edt-user-ESC-prefix (copy-keymap 'edt-default-ESC-prefix)) (setq edt-user-global-map (copy-keymap edt-default-global-map)) (define-key edt-user-global-map "\e" 'edt-user-ESC-prefix) ;; If terminal has additional function keys, the user's initialization ;; file can assign bindings to them via the optional ;; function edt-setup-extra-default-bindings. (define-prefix-command 'edt-user-gold-map) (fset 'edt-user-gold-map (copy-keymap 'edt-default-gold-map)) (edt-setup-user-bindings) (edt-select-user-global-map)) (defun edt-select-default-global-map() "Select default EDT emulation key bindings." (interactive) (transient-mark-mode 1) (use-global-map edt-default-global-map) (if (not edt-keep-current-page-delimiter) (progn (setq edt-orig-page-delimiter page-delimiter) (setq page-delimiter "\f"))) (setq edt-default-map-active t) (edt-advance) (setq edt-select-mode-text 'edt-select-mode-string) (edt-reset) (message "Default EDT keymap active")) (defun edt-select-user-global-map() "Select user EDT emulation custom key bindings." (interactive) (if edt-user-map-configured (progn (transient-mark-mode 1) (use-global-map edt-user-global-map) (if (not edt-keep-current-page-delimiter) (progn (setq edt-orig-page-delimiter page-delimiter) (setq page-delimiter "\f"))) (setq edt-default-map-active nil) (edt-advance) (setq edt-select-mode-text 'edt-select-mode-string) (edt-reset) (message "User EDT custom keymap active")) (error "User EDT custom keymap NOT configured!"))) (defun edt-switch-global-maps () "Toggle between default EDT keymap and user EDT keymap." (interactive) (if edt-default-map-active (edt-select-user-global-map) (edt-select-default-global-map))) ;; There are three key binding functions needed: one for standard keys ;; (used to bind control keys, primarily), one for Gold sequences of ;; standard keys, and one for function keys. (defun edt-bind-gold-key (key gold-binding &optional default) "Binds commands to a gold key sequence in the EDT Emulator." (if default (define-key 'edt-default-gold-map key gold-binding) (define-key 'edt-user-gold-map key gold-binding))) (defun edt-bind-standard-key (key gold-binding &optional default) "Bind commands to a gold key sequence in the default EDT keymap." (if default (define-key edt-default-global-map key gold-binding) (define-key edt-user-global-map key gold-binding))) (defun edt-bind-function-key (function-key binding gold-binding &optional default) "Binds function keys in the EDT Emulator." (catch 'edt-key-not-supported (let ((key-vector (cdr (assoc function-key *EDT-keys*)))) (if (stringp key-vector) (throw 'edt-key-not-supported t)) (if (not (null key-vector)) (progn (if default (progn (define-key edt-default-global-map key-vector binding) (define-key 'edt-default-gold-map key-vector gold-binding)) (progn (define-key edt-user-global-map key-vector binding) (define-key 'edt-user-gold-map key-vector gold-binding)))) (error "%s is not a legal function key name" function-key))))) (defun edt-setup-default-bindings () "Assigns default EDT Emulation keyboard bindings." ;; Function Key Bindings: Regular and GOLD. ;; VT100/VT200/VT300 PF1 (GOLD), PF2, PF3, PF4 Keys (edt-bind-function-key "PF1" 'edt-default-gold-map 'edt-mark-section-wisely t) (edt-bind-function-key "PF2" 'edt-electric-keypad-help 'describe-function t) (edt-bind-function-key "PF3" 'edt-find-next 'edt-find t) (edt-bind-function-key "PF4" 'edt-delete-line 'edt-undelete-line t) ;; VT100/VT200/VT300 Arrow Keys (edt-bind-function-key "UP" 'previous-line 'edt-window-top t) (edt-bind-function-key "DOWN" 'next-line 'edt-window-bottom t) (edt-bind-function-key "LEFT" 'backward-char 'edt-sentence-backward t) (edt-bind-function-key "RIGHT" 'forward-char 'edt-sentence-forward t) ;; VT100/VT200/VT300 Keypad Keys (edt-bind-function-key "KP0" 'edt-line 'open-line t) (edt-bind-function-key "KP1" 'edt-word 'edt-change-case t) (edt-bind-function-key "KP2" 'edt-end-of-line 'edt-delete-to-end-of-line t) (edt-bind-function-key "KP3" 'edt-character 'quoted-insert t) (edt-bind-function-key "KP4" 'edt-advance 'edt-bottom t) (edt-bind-function-key "KP5" 'edt-backup 'edt-top t) (edt-bind-function-key "KP6" 'edt-cut 'yank t) (edt-bind-function-key "KP7" 'edt-page 'execute-extended-command t) (edt-bind-function-key "KP8" 'edt-sect 'edt-fill-region t) (edt-bind-function-key "KP9" 'edt-append 'edt-replace t) (edt-bind-function-key "KP-" 'edt-delete-word 'edt-undelete-word t) (edt-bind-function-key "KP," 'edt-delete-character 'edt-undelete-character t) (edt-bind-function-key "KPP" 'edt-select 'edt-reset t) (edt-bind-function-key "KPE" 'other-window 'query-replace t) ;; VT200/VT300 Function Keys ;; (F1 through F5, on the VT220, are not programmable, so we skip ;; making default bindings to those keys. (edt-bind-function-key "FIND" 'edt-find-next 'edt-find t) (edt-bind-function-key "INSERT" 'yank 'edt-key-not-assigned t) (edt-bind-function-key "REMOVE" 'edt-cut 'edt-copy t) (edt-bind-function-key "SELECT" 'edt-toggle-select 'edt-key-not-assigned t) (edt-bind-function-key "NEXT" 'edt-sect-forward 'edt-key-not-assigned t) (edt-bind-function-key "PREVIOUS" 'edt-sect-backward 'edt-key-not-assigned t) (edt-bind-function-key "F6" 'edt-key-not-assigned 'edt-key-not-assigned t) (edt-bind-function-key "F7" 'edt-copy-rectangle 'edt-key-not-assigned t) (edt-bind-function-key "F8" 'edt-cut-rectangle-overstrike-mode 'edt-paste-rectangle-overstrike-mode t) (edt-bind-function-key "F9" 'edt-cut-rectangle-insert-mode 'edt-paste-rectangle-insert-mode t) (edt-bind-function-key "F10" 'edt-cut-rectangle 'edt-paste-rectangle t) ;; Under X, the F11 key can be bound. If using a VT-200 or higher terminal, ;; the default emacs terminal support causes the VT F11 key to seem as if it ;; is an ESC key when in emacs. (edt-bind-function-key "F11" 'edt-key-not-assigned 'edt-key-not-assigned t) (edt-bind-function-key "F12" 'edt-beginning-of-line 'delete-other-windows t) ;BS (edt-bind-function-key "F13" 'edt-delete-to-beginning-of-word 'edt-key-not-assigned t) ;LF (edt-bind-function-key "F14" 'edt-key-not-assigned 'edt-key-not-assigned t) (edt-bind-function-key "HELP" 'edt-electric-keypad-help 'edt-key-not-assigned t) (edt-bind-function-key "DO" 'execute-extended-command 'edt-key-not-assigned t) (edt-bind-function-key "F17" 'edt-key-not-assigned 'edt-key-not-assigned t) (edt-bind-function-key "F18" 'edt-key-not-assigned 'edt-key-not-assigned t) (edt-bind-function-key "F19" 'edt-key-not-assigned 'edt-key-not-assigned t) (edt-bind-function-key "F20" 'edt-key-not-assigned 'edt-key-not-assigned t) ;; Control key bindings: Regular and GOLD ;; ;; Standard EDT control key bindings conflict with standard Emacs ;; control key bindings. Normally, the standard Emacs control key ;; bindings are left unchanged in the default EDT mode. However, if ;; the variable edt-use-EDT-control-key-bindings is set to true ;; before invoking edt-emulation-on for the first time, then the ;; standard EDT bindings (with some enhancements) as defined here are ;; used, instead. (if edt-use-EDT-control-key-bindings (progn (edt-bind-standard-key "\C-a" 'edt-key-not-assigned t) (edt-bind-standard-key "\C-b" 'edt-key-not-assigned t) ;; Leave binding of C-c as original prefix key. (edt-bind-standard-key "\C-d" 'edt-key-not-assigned t) (edt-bind-standard-key "\C-e" 'edt-key-not-assigned t) (edt-bind-standard-key "\C-f" 'edt-key-not-assigned t) ;; Leave binding of C-g to keyboard-quit ; (edt-bind-standard-key "\C-g" 'keyboard-quit t) ;; Standard EDT binding of C-h. To invoke Emacs help, use ;; GOLD-C-h instead. (edt-bind-standard-key "\C-h" 'edt-beginning-of-line t) (edt-bind-standard-key "\C-i" 'edt-tab-insert t) (edt-bind-standard-key "\C-j" 'edt-delete-to-beginning-of-word t) (edt-bind-standard-key "\C-k" 'edt-define-key t) (edt-bind-gold-key "\C-k" 'edt-restore-key t) (edt-bind-standard-key "\C-l" 'edt-form-feed-insert t) ;; Leave binding of C-m to newline. (edt-bind-standard-key "\C-n" 'edt-set-screen-width-80 t) (edt-bind-standard-key "\C-o" 'edt-key-not-assigned t) (edt-bind-standard-key "\C-p" 'edt-key-not-assigned t) (edt-bind-standard-key "\C-q" 'edt-key-not-assigned t) ;; Leave binding of C-r to isearch-backward. ;; Leave binding of C-s to isearch-forward. (edt-bind-standard-key "\C-t" 'edt-display-the-time t) (edt-bind-standard-key "\C-u" 'edt-delete-to-beginning-of-line t) (edt-bind-standard-key "\C-v" 'redraw-display t) (edt-bind-standard-key "\C-w" 'edt-set-screen-width-132 t) ;; Leave binding of C-x as original prefix key. (edt-bind-standard-key "\C-y" 'edt-key-not-assigned t) ; (edt-bind-standard-key "\C-z" 'suspend-emacs t) ) ) ;; GOLD bindings for a few Control keys. (edt-bind-gold-key "\C-g" 'keyboard-quit t); Just in case. (edt-bind-gold-key "\C-h" 'help-for-help t) (edt-bind-gold-key [f1] 'help-for-help t) (edt-bind-gold-key [help] 'help-for-help t) (edt-bind-gold-key "\C-\\" 'split-window-vertically t) ;; GOLD bindings for regular keys. (edt-bind-gold-key "a" 'edt-key-not-assigned t) (edt-bind-gold-key "A" 'edt-key-not-assigned t) (edt-bind-gold-key "b" 'buffer-menu t) (edt-bind-gold-key "B" 'buffer-menu t) (edt-bind-gold-key "c" 'compile t) (edt-bind-gold-key "C" 'compile t) (edt-bind-gold-key "d" 'delete-window t) (edt-bind-gold-key "D" 'delete-window t) (edt-bind-gold-key "e" 'edt-exit t) (edt-bind-gold-key "E" 'edt-exit t) (edt-bind-gold-key "f" 'find-file t) (edt-bind-gold-key "F" 'find-file t) (edt-bind-gold-key "g" 'find-file-other-window t) (edt-bind-gold-key "G" 'find-file-other-window t) (edt-bind-gold-key "h" 'edt-electric-keypad-help t) (edt-bind-gold-key "H" 'edt-electric-keypad-help t) (edt-bind-gold-key "i" 'insert-file t) (edt-bind-gold-key "I" 'insert-file t) (edt-bind-gold-key "j" 'edt-key-not-assigned t) (edt-bind-gold-key "J" 'edt-key-not-assigned t) (edt-bind-gold-key "k" 'edt-toggle-capitalization-of-word t) (edt-bind-gold-key "K" 'edt-toggle-capitalization-of-word t) (edt-bind-gold-key "l" 'edt-lowercase t) (edt-bind-gold-key "L" 'edt-lowercase t) (edt-bind-gold-key "m" 'save-some-buffers t) (edt-bind-gold-key "M" 'save-some-buffers t) (edt-bind-gold-key "n" 'next-error t) (edt-bind-gold-key "N" 'next-error t) (edt-bind-gold-key "o" 'switch-to-buffer-other-window t) (edt-bind-gold-key "O" 'switch-to-buffer-other-window t) (edt-bind-gold-key "p" 'edt-key-not-assigned t) (edt-bind-gold-key "P" 'edt-key-not-assigned t) (edt-bind-gold-key "q" 'edt-quit t) (edt-bind-gold-key "Q" 'edt-quit t) (edt-bind-gold-key "r" 'revert-buffer t) (edt-bind-gold-key "R" 'revert-buffer t) (edt-bind-gold-key "s" 'save-buffer t) (edt-bind-gold-key "S" 'save-buffer t) (edt-bind-gold-key "t" 'edt-key-not-assigned t) (edt-bind-gold-key "T" 'edt-key-not-assigned t) (edt-bind-gold-key "u" 'edt-uppercase t) (edt-bind-gold-key "U" 'edt-uppercase t) (edt-bind-gold-key "v" 'find-file-other-window t) (edt-bind-gold-key "V" 'find-file-other-window t) (edt-bind-gold-key "w" 'write-file t) (edt-bind-gold-key "W" 'write-file t) (edt-bind-gold-key "x" 'edt-key-not-assigned t) (edt-bind-gold-key "X" 'edt-key-not-assigned t) (edt-bind-gold-key "y" 'edt-emulation-off t) (edt-bind-gold-key "Y" 'edt-emulation-off t) (edt-bind-gold-key "z" 'edt-switch-global-maps t) (edt-bind-gold-key "Z" 'edt-switch-global-maps t) (edt-bind-gold-key "1" 'delete-other-windows t) (edt-bind-gold-key "!" 'edt-key-not-assigned t) (edt-bind-gold-key "2" 'edt-split-window t) (edt-bind-gold-key "@" 'edt-key-not-assigned t) (edt-bind-gold-key "3" 'edt-key-not-assigned t) (edt-bind-gold-key "#" 'edt-key-not-assigned t) (edt-bind-gold-key "4" 'edt-key-not-assigned t) (edt-bind-gold-key "$" 'edt-key-not-assigned t) (edt-bind-gold-key "5" 'edt-key-not-assigned t) (edt-bind-gold-key "%" 'edt-goto-percentage t) (edt-bind-gold-key "6" 'edt-key-not-assigned t) (edt-bind-gold-key "^" 'edt-key-not-assigned t) (edt-bind-gold-key "7" 'edt-key-not-assigned t) (edt-bind-gold-key "&" 'edt-key-not-assigned t) (edt-bind-gold-key "8" 'edt-key-not-assigned t) (edt-bind-gold-key "*" 'edt-key-not-assigned t) (edt-bind-gold-key "9" 'edt-key-not-assigned t) (edt-bind-gold-key "(" 'edt-key-not-assigned t) (edt-bind-gold-key "0" 'edt-key-not-assigned t) (edt-bind-gold-key ")" 'edt-key-not-assigned t) (edt-bind-gold-key " " 'undo t) (edt-bind-gold-key "," 'edt-key-not-assigned t) (edt-bind-gold-key "<" 'edt-key-not-assigned t) (edt-bind-gold-key "." 'edt-key-not-assigned t) (edt-bind-gold-key ">" 'edt-key-not-assigned t) (edt-bind-gold-key "/" 'edt-key-not-assigned t) (edt-bind-gold-key "?" 'edt-key-not-assigned t) (edt-bind-gold-key "\\" 'edt-key-not-assigned t) (edt-bind-gold-key "|" 'edt-key-not-assigned t) (edt-bind-gold-key ";" 'edt-key-not-assigned t) (edt-bind-gold-key ":" 'edt-key-not-assigned t) (edt-bind-gold-key "'" 'edt-key-not-assigned t) (edt-bind-gold-key "\"" 'edt-key-not-assigned t) (edt-bind-gold-key "-" 'edt-key-not-assigned t) (edt-bind-gold-key "_" 'edt-key-not-assigned t) (edt-bind-gold-key "=" 'goto-line t) (edt-bind-gold-key "+" 'edt-key-not-assigned t) (edt-bind-gold-key "[" 'edt-key-not-assigned t) (edt-bind-gold-key "{" 'edt-key-not-assigned t) (edt-bind-gold-key "]" 'edt-key-not-assigned t) (edt-bind-gold-key "}" 'edt-key-not-assigned t) (edt-bind-gold-key "`" 'what-line t) (edt-bind-gold-key "~" 'edt-key-not-assigned t) ) ;;; ;;; DEFAULT EDT KEYPAD HELP ;;; ;;; ;;; Upper case commands in the keypad diagram below indicate that the ;;; emulation should look and feel very much like EDT. Lower case ;;; commands are enhancements and/or additions to the EDT keypad ;;; commands or are native Emacs commands. ;;; (defun edt-keypad-help () " DEFAULT EDT Keypad Active F7: Copy Rectangle +----------+----------+----------+----------+ F8: Cut Rect Overstrike |Prev Line |Next Line |Bkwd Char |Frwd Char | G-F8: Paste Rect Overstrike | (UP) | (DOWN) | (LEFT) | (RIGHT) | F9: Cut Rect Insert |Window Top|Window Bot|Bkwd Sent |Frwd Sent | G-F9: Paste Rect Insert +----------+----------+----------+----------+ F10: Cut Rectangle G-F10: Paste Rectangle F11: ESC F12: Begining of Line +----------+----------+----------+----------+ G-F12: Delete Other Windows | GOLD | HELP | FNDNXT | DEL L | F13: Delete to Begin of Word | (PF1) | (PF2) | (PF3) | (PF4) | HELP: Keypad Help |Mark Wisel|Desc Funct| FIND | UND L | DO: Execute extended command +----------+----------+----------+----------+ | PAGE | SECT | APPEND | DEL W | C-g: Keyboard Quit | (7) | (8) | (9) | (-) | G-C-g: Keyboard Quit |Ex Ext Cmd|Fill Regio| REPLACE | UND W | C-h: Beginning of Line +----------+----------+----------+----------+ G-C-h: Emacs Help | ADVANCE | BACKUP | CUT | DEL C | C-i: Tab Insert | (4) | (5) | (6) | (,) | C-j: Delete to Begin of Word | BOTTOM | TOP | Yank | UND C | C-k: Define Key +----------+----------+----------+----------+ G-C-k: Restore Key | WORD | EOL | CHAR | Next | C-l: Form Feed Insert | (1) | (2) | (3) | Window | C-n: Set Screen Width 80 | CHNGCASE | DEL EOL |Quoted Ins| ! C-r: Isearch Backward +---------------------+----------+ (ENTER) | C-s: Isearch Forward | LINE | SELECT | ! C-t: Display the Time | (0) | (.) | Query | C-u: Delete to Begin of Line | Open Line | RESET | Replace | C-v: Redraw Display +---------------------+----------+----------+ C-w: Set Screen Width 132 C-z: Suspend Emacs +----------+----------+----------+ G-C-\\: Split Window | FNDNXT | Yank | CUT | | (FIND) | (INSERT) | (REMOVE) | G-b: Buffer Menu | FIND | | COPY | G-c: Compile +----------+----------+----------+ G-d: Delete Window |SELECT/RES|SECT BACKW|SECT FORWA| G-e: Exit | (SELECT) |(PREVIOUS)| (NEXT) | G-f: Find File | | | | G-g: Find File Other Window +----------+----------+----------+ G-h: Keypad Help G-i: Insert File G-k: Toggle Capitalization Word G-l: Downcase Region G-m: Save Some Buffers G-n: Next Error G-o: Switch to Next Window G-q: Quit G-r: Revert File G-s: Save Buffer G-u: Upcase Region G-v: Find File Other Window G-w: Write file G-y: EDT Emulation OFF G-z: Switch to User EDT Key Bindings G-1: Delete Other Windows G-2: Split Window G-%: Go to Percentage G- : Undo (GOLD Spacebar) G-=: Go to Line G-`: What line" (interactive) (describe-function 'edt-keypad-help)) (defun edt-electric-helpify (fun) (let ((name "*Help*")) (if (save-window-excursion (let* ((p (symbol-function 'print-help-return-message)) (b (get-buffer name)) (m (buffer-modified-p b))) (and b (not (get-buffer-window b)) (setq b nil)) (unwind-protect (progn (message "%s..." (capitalize (symbol-name fun))) (and b (save-excursion (set-buffer b) (set-buffer-modified-p t))) (fset 'print-help-return-message 'ignore) (call-interactively fun) (and (get-buffer name) (get-buffer-window (get-buffer name)) (or (not b) (not (eq b (get-buffer name))) (not (buffer-modified-p b))))) (fset 'print-help-return-message p) (and b (buffer-name b) (save-excursion (set-buffer b) (set-buffer-modified-p m)))))) (with-electric-help 'delete-other-windows name t)))) (defun edt-electric-keypad-help () "Display default EDT bindings." (interactive) (edt-electric-helpify 'edt-keypad-help)) (defun edt-electric-user-keypad-help () "Display user custom EDT bindings." (interactive) (edt-electric-helpify 'edt-user-keypad-help)) ;;; ;;; EDT emulation screen width commands. ;;; ;; Some terminals require modification of terminal attributes when changing the ;; number of columns displayed, hence the fboundp tests below. These functions ;; are defined in the corresponding terminal specific file, if needed. (defun edt-set-screen-width-80 () "Set screen width to 80 columns." (interactive) (if (fboundp 'edt-set-term-width-80) (edt-set-term-width-80)) (set-screen-width 80) (message "Screen width 80")) (defun edt-set-screen-width-132 () "Set screen width to 132 columns." (interactive) (if (fboundp 'edt-set-term-width-132) (edt-set-term-width-132)) (set-screen-width 132) (message "Screen width 132")) (provide 'edt) ;;; edt.el ends here emacs-19.30/lisp/ehelp.el100444 22556 1 34530 6046225442 13666 0ustar erikdaemon;;; ehelp.el --- bindings for electric-help mode ;; Copyright (C) 1986, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, extensions ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 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 package provides a pre-packaged `Electric Help Mode' for ;; browsing on-line help screens. There is one entry point, ;; `with-electric-help'; all you have to give it is a no-argument ;; function that generates the actual text of the help into the current ;; buffer. ;; To make this the default, you must do ;; (require 'ehelp) ;; (define-key global-map "\C-h" 'ehelp-command) ;; (define-key global-map [help] 'ehelp-command) ;; (define-key global-map [f1] 'ehelp-command) ;;; Code: (require 'electric) (defvar electric-help-map () "Keymap defining commands available in `electric-help-mode'.") (put 'electric-help-undefined 'suppress-keymap t) (if electric-help-map () (let ((map (make-keymap))) ;; allow all non-self-inserting keys - search, scroll, etc, but ;; let M-x and C-x exit ehelp mode and retain buffer: (suppress-keymap map) (define-key map "\C-u" 'electric-help-undefined) (define-key map [?\C-0] 'electric-help-undefined) (define-key map [?\C-1] 'electric-help-undefined) (define-key map [?\C-2] 'electric-help-undefined) (define-key map [?\C-3] 'electric-help-undefined) (define-key map [?\C-4] 'electric-help-undefined) (define-key map [?\C-5] 'electric-help-undefined) (define-key map [?\C-6] 'electric-help-undefined) (define-key map [?\C-7] 'electric-help-undefined) (define-key map [?\C-8] 'electric-help-undefined) (define-key map [?\C-9] 'electric-help-undefined) (define-key map (char-to-string help-char) 'electric-help-help) (define-key map "?" 'electric-help-help) (define-key map " " 'scroll-up) (define-key map "\^?" 'scroll-down) (define-key map "." 'beginning-of-buffer) (define-key map "<" 'beginning-of-buffer) (define-key map ">" 'end-of-buffer) ;(define-key map "\C-g" 'electric-help-exit) (define-key map "q" 'electric-help-exit) (define-key map "Q" 'electric-help-exit) ;;a better key than this? (define-key map "r" 'electric-help-retain) (define-key map "R" 'electric-help-retain) (define-key map "\ex" 'electric-help-execute-extended) (define-key map "\C-x" 'electric-help-ctrl-x-prefix) (setq electric-help-map map))) (defun electric-help-mode () "`with-electric-help' temporarily places its buffer in this mode. \(On exit from `with-electric-help', the buffer is put in `default-major-mode'.)" (setq buffer-read-only t) (setq mode-name "Help") (setq major-mode 'help) (setq mode-line-buffer-identification '(" Help: %b")) (use-local-map electric-help-map) (setq mouse-leave-buffer-hook '(electric-help-retain)) ;; this is done below in with-electric-help ;(run-hooks 'electric-help-mode-hook) ) ;;;###autoload (defun with-electric-help (thunk &optional buffer noerase minheight) "Pop up an \"electric\" help buffer. The arguments are THUNK &optional BUFFER NOERASE MINHEIGHT. THUNK is a function of no arguments which is called to initialize the contents of BUFFER. BUFFER defaults to `*Help*'. BUFFER will be erased before THUNK is called unless NOERASE is non-nil. THUNK will be called while BUFFER is current and with `standard-output' bound to the buffer specified by BUFFER. If THUNK returns nil, we display BUFFER starting at the top, and shrink the window to fit. If THUNK returns non-nil, we don't do those things. After THUNK has been called, this function \"electrically\" pops up a window in which BUFFER is displayed and allows the user to scroll through that buffer in electric-help-mode. The window's height will be at least MINHEIGHT if this value is non-nil. If THUNK returns nil, we display BUFFER starting at the top, and shrink the window to fit. If THUNK returns non-nil, we don't do those things. When the user exits (with `electric-help-exit', or otherwise) the help buffer's window disappears (i.e., we use `save-window-excursion') BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit." (setq buffer (get-buffer-create (or buffer "*Help*"))) (let ((one (one-window-p t)) (config (current-window-configuration)) (bury nil) (to-be-executed nil)) (unwind-protect (save-excursion (if one (goto-char (window-start (selected-window)))) (let ((pop-up-windows t)) (pop-to-buffer buffer)) (save-excursion (set-buffer buffer) (if (and minheight (< (window-height) minheight)) (enlarge-window (- minheight (window-height)))) (electric-help-mode) (or noerase (erase-buffer))) (let ((standard-output buffer)) (if (not (funcall thunk)) (progn (set-buffer buffer) (set-buffer-modified-p nil) (goto-char (point-min)) (if one (shrink-window-if-larger-than-buffer (selected-window)))))) (set-buffer buffer) (run-hooks 'electric-help-mode-hook) (if (eq (car-safe (electric-help-command-loop)) 'retain) (setq config (current-window-configuration)) (setq bury t))) (message "") (set-buffer buffer) (setq buffer-read-only nil) (condition-case () (funcall (or default-major-mode 'fundamental-mode)) (error nil)) (set-window-configuration config) (if bury (progn ;;>> Perhaps this shouldn't be done. ;; so that when we say "Press space to bury" we mean it (replace-buffer-in-windows buffer) ;; must do this outside of save-window-excursion (bury-buffer buffer))) (eval to-be-executed)))) (defun electric-help-command-loop () (catch 'exit (if (pos-visible-in-window-p (point-max)) (progn (message (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>")) (if (equal (setq unread-command-events (list (read-event))) '(?\ )) (progn (setq unread-command-events nil) (throw 'exit t))))) (let (up down both neither (standard (and (eq (key-binding " ") 'scroll-up) (eq (key-binding "\^?") 'scroll-down) (eq (key-binding "q") 'electric-help-exit) (eq (key-binding "r") 'electric-help-retain)))) (Electric-command-loop 'exit (function (lambda () (sit-for 0) ;necessary if last command was end-of-buffer or ;beginning-of-buffer - otherwise pos-visible-in-window-p ;will yield a wrong result. (let ((min (pos-visible-in-window-p (point-min))) (max (pos-visible-in-window-p (point-max)))) (cond (isearch-mode 'noprompt) ((and min max) (cond (standard "Press q to exit, r to retain ") (neither) (t (setq neither (substitute-command-keys "Press \\[electric-help-exit] to exit, \\[electric-help-retain] to retain "))))) (min (cond (standard "Press SPC to scroll, q to exit, r to retain ") (up) (t (setq up (substitute-command-keys "Press \\[scroll-up] to scroll, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain "))))) (max (cond (standard "Press DEL to scroll back, q to exit, r to retain ") (down) (t (setq down (substitute-command-keys "Press \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain "))))) (t (cond (standard "Press SPC to scroll, DEL to scroll back, q to exit, r to retain ") (both) (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain "))))))))) t)))) ;(defun electric-help-scroll-up (arg) ; ">>>Doc" ; (interactive "P") ; (if (and (null arg) (pos-visible-in-window-p (point-max))) ; (electric-help-exit) ; (scroll-up arg))) (defun electric-help-exit () ">>>Doc" (interactive) (throw 'exit t)) (defun electric-help-retain () "Exit `electric-help', retaining the current window/buffer configuration. \(The *Help* buffer will not be selected, but \\[switch-to-buffer-other-window] RET will select it.)" (interactive) ;; Make sure that we don't throw twice, even if two events cause ;; calling this function: (if mouse-leave-buffer-hook (progn (setq mouse-leave-buffer-hook nil) (throw 'exit '(retain))))) (defun electric-help-undefined () (interactive) (error "%s is undefined -- Press %s to exit" (mapconcat 'single-key-description (this-command-keys) " ") (if (eq (key-binding "q") 'electric-help-exit) "q" (substitute-command-keys "\\[electric-help-exit]")))) ;>>> this needs to be hairified (recursive help, anybody?) (defun electric-help-help () (interactive) (if (and (eq (key-binding "q") 'electric-help-exit) (eq (key-binding " ") 'scroll-up) (eq (key-binding "\^?") 'scroll-down) (eq (key-binding "r") 'electric-help-retain)) (message "SPC scrolls up, DEL scrolls down, q exits burying help buffer, r exits") (message "%s" (substitute-command-keys "\\[scroll-up] scrolls up, \\[scroll-down] scrolls down, \\[electric-help-exit] exits burying help buffer, \\[electric-help-retain] exits"))) (sit-for 2)) ;;;###autoload (defun electric-helpify (fun) (let ((name "*Help*")) (if (save-window-excursion ;; kludge-o-rama (let* ((p (symbol-function 'print-help-return-message)) (b (get-buffer name)) (m (buffer-modified-p b))) (and b (not (get-buffer-window b)) (setq b nil)) (unwind-protect (progn (message "%s..." (capitalize (symbol-name fun))) ;; with-output-to-temp-buffer marks the buffer as unmodified. ;; kludging excessively and relying on that as some sort ;; of indication leads to the following abomination... ;;>> This would be doable without such icky kludges if either ;;>> (a) there were a function to read the interactive ;;>> args for a command and return a list of those args. ;;>> (To which one would then just apply the command) ;;>> (The only problem with this is that interactive-p ;;>> would break, but that is such a misfeature in ;;>> any case that I don't care) ;;>> It is easy to do this for emacs-lisp functions; ;;>> the only problem is getting the interactive spec ;;>> for subrs ;;>> (b) there were a function which returned a ;;>> modification-tick for a buffer. One could tell ;;>> whether a buffer had changed by whether the ;;>> modification-tick were different. ;;>> (Presumably there would have to be a way to either ;;>> restore the tick to some previous value, or to ;;>> suspend updating of the tick in order to allow ;;>> things like momentary-string-display) (and b (save-excursion (set-buffer b) (set-buffer-modified-p t))) (fset 'print-help-return-message 'ignore) (call-interactively fun) (and (get-buffer name) (get-buffer-window (get-buffer name)) (or (not b) (not (eq b (get-buffer name))) (not (buffer-modified-p b))))) (fset 'print-help-return-message p) (and b (buffer-name b) (save-excursion (set-buffer b) (set-buffer-modified-p m)))))) (with-electric-help 'ignore name t)))) ;; This is to be bound to M-x in ehelp mode. Retains ehelp buffer and then ;; continues with execute-extended-command. (defun electric-help-execute-extended (prefixarg) (interactive "p") (setq to-be-executed '(execute-extended-command nil)) (electric-help-retain)) ;; This is to be buond to C-x in ehelp mode. Retains ehelp buffer and then ;; continues with ctrl-x prefix. (defun electric-help-ctrl-x-prefix (prefixarg) (interactive "p") (setq to-be-executed '(progn (message nil) (setq unread-command-char ?\C-x))) (electric-help-retain)) (defun electric-describe-key () (interactive) (electric-helpify 'describe-key)) (defun electric-describe-mode () (interactive) (electric-helpify 'describe-mode)) (defun electric-view-lossage () (interactive) (electric-helpify 'view-lossage)) ;(defun electric-help-for-help () ; "See help-for-help" ; (interactive) ; ) (defun electric-describe-function () (interactive) (electric-helpify 'describe-function)) (defun electric-describe-variable () (interactive) (electric-helpify 'describe-variable)) (defun electric-describe-bindings () (interactive) (electric-helpify 'describe-bindings)) (defun electric-describe-syntax () (interactive) (electric-helpify 'describe-syntax)) (defun electric-command-apropos () (interactive) (electric-helpify 'command-apropos)) ;(define-key help-map "a" 'electric-command-apropos) (defun electric-apropos () (interactive) (electric-helpify 'apropos)) ;;;; ehelp-map (defvar ehelp-map ()) (if ehelp-map nil (let ((map (copy-keymap help-map))) (substitute-key-definition 'apropos 'electric-apropos map) (substitute-key-definition 'command-apropos 'electric-command-apropos map) (substitute-key-definition 'describe-key 'electric-describe-key map) (substitute-key-definition 'describe-mode 'electric-describe-mode map) (substitute-key-definition 'view-lossage 'electric-view-lossage map) (substitute-key-definition 'describe-function 'electric-describe-function map) (substitute-key-definition 'describe-variable 'electric-describe-variable map) (substitute-key-definition 'describe-bindings 'electric-describe-bindings map) (substitute-key-definition 'describe-syntax 'electric-describe-syntax map) (setq ehelp-map map) (fset 'ehelp-command map))) (provide 'ehelp) ;;; ehelp.el ends here emacs-19.30/lisp/electric.el100444 12120 1 14433 6042271207 14210 0ustar rmsdaemon;;; electric.el --- window maker and Command loop for `electric' modes. ;; Copyright (C) 1985, 1986, 1995 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF ;; Keywords: extensions ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 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: ; zaaaaaaap ;;; Code: ;; This loop is the guts for non-standard modes which retain control ;; until some event occurs. It is a `do-forever', the only way out is ;; to throw. It assumes that you have set up the keymap, window, and ;; everything else: all it does is read commands and execute them - ;; providing error messages should one occur (if there is no loop ;; function - which see). The required argument is a tag which should ;; expect a value of nil if the user decides to punt. The second ;; argument is the prompt to be used: if nil, use "->", if 'noprompt, ;; don't use a prompt, if a string, use that string as prompt, and if ;; a function of no variable, it will be evaluated in every iteration ;; of the loop and its return value, which can be nil, 'noprompt or a ;; string, will be used as prompt. Given third argument non-nil, it ;; INHIBITS quitting unless the user types C-g at toplevel. This is ;; so user can do things like C-u C-g and not get thrown out. Fourth ;; argument, if non-nil, should be a function of two arguments which ;; is called after every command is executed. The fifth argument, if ;; provided, is the state variable for the function. If the ;; loop-function gets an error, the loop will abort WITHOUT throwing ;; (moral: use unwind-protect around call to this function for any ;; critical stuff). The second argument for the loop function is the ;; conditions for any error that occurred or nil if none. (defun Electric-command-loop (return-tag &optional prompt inhibit-quit loop-function loop-state) (let (cmd (err nil) (prompt-string prompt)) (while t (if (not (or (stringp prompt) (eq prompt nil) (eq prompt 'noprompt))) (setq prompt-string (funcall prompt))) (if (not (stringp prompt-string)) (if (eq prompt-string 'noprompt) (setq prompt-string nil) (setq prompt-string "->"))) (setq cmd (read-key-sequence prompt-string)) (setq last-command-char (aref cmd (1- (length cmd))) this-command (key-binding cmd) cmd this-command) (if (or (prog1 quit-flag (setq quit-flag nil)) (eq last-input-char ?\C-g)) (progn (setq unread-command-events nil prefix-arg nil) ;; If it wasn't cancelling a prefix character, then quit. (if (or (= (length (this-command-keys)) 1) (not inhibit-quit)) ; safety (progn (ding) (message "Quit") (throw return-tag nil)) (setq cmd nil)))) (setq current-prefix-arg prefix-arg) (if cmd (condition-case conditions (progn (command-execute cmd) (setq last-command this-command) (if (or (prog1 quit-flag (setq quit-flag nil)) (eq last-input-char ?\C-g)) (progn (setq unread-command-events nil) (if (not inhibit-quit) (progn (ding) (message "Quit") (throw return-tag nil)) (ding))))) (buffer-read-only (if loop-function (setq err conditions) (ding) (message "Buffer is read-only") (sit-for 2))) (beginning-of-buffer (if loop-function (setq err conditions) (ding) (message "Beginning of Buffer") (sit-for 2))) (end-of-buffer (if loop-function (setq err conditions) (ding) (message "End of Buffer") (sit-for 2))) (error (if loop-function (setq err conditions) (ding) (message "Error: %s" (if (eq (car conditions) 'error) (car (cdr conditions)) (prin1-to-string conditions))) (sit-for 2)))) (ding)) (if loop-function (funcall loop-function loop-state err)))) (ding) (throw return-tag nil)) ;; This function is like pop-to-buffer, sort of. ;; The algorithm is ;; If there is a window displaying buffer ;; Select it ;; Else if there is only one window ;; Split it, selecting the window on the bottom with height being ;; the lesser of max-height (if non-nil) and the number of lines in ;; the buffer to be displayed subject to window-min-height constraint. ;; Else ;; Switch to buffer in the current window. ;; ;; Then if max-height is nil, and not all of the lines in the buffer ;; are displayed, grab the whole frame. ;; ;; Returns selected window on buffer positioned at point-min. (defun Electric-pop-up-window (buffer &optional max-height) (let* ((win (or (get-buffer-window buffer) (selected-window))) (buf (get-buffer buffer)) (one-window (one-window-p t)) (pop-up-windows t) (target-height) (lines)) (if (not buf) (error "Buffer %s does not exist" buffer) (save-excursion (set-buffer buf) (setq lines (count-lines (point-min) (point-max))) (setq target-height (min (max (if max-height (min max-height (1+ lines)) (1+ lines)) window-min-height) (save-window-excursion (delete-other-windows) (1- (window-height (selected-window))))))) (cond ((and (eq (window-buffer win) buf)) (select-window win)) (one-window (goto-char (window-start win)) (pop-to-buffer buffer) (setq win (selected-window)) (enlarge-window (- target-height (window-height win)))) (t (switch-to-buffer buf))) (if (and (not max-height) (> target-height (window-height (selected-window)))) (progn (goto-char (window-start win)) (enlarge-window (- target-height (window-height win))))) (goto-char (point-min)) win))) (provide 'electric) ;;; electric.el ends here emacs-19.30/lisp/elp.el100444 12120 1 50644 5700377140 13205 0ustar rmsdaemon;;; elp.el --- Emacs Lisp Profiler ;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Author: 1994 Barry A. Warsaw ;; Maintainer: tools-help@anthem.nlm.nih.gov ;; Created: 26-Feb-1994 ;; Version: 2.23 ;; Last Modified: 1994/12/28 22:39:31 ;; Keywords: Emacs Lisp Profile Timing ;; 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: ;; ;; If you want to profile a bunch of functions, set elp-function-list ;; to the list of symbols, then do a M-x elp-instrument-list. This ;; hacks those functions so that profiling information is recorded ;; whenever they are called. To print out the current results, use ;; M-x elp-results. With elp-reset-after-results set to non-nil, ;; profiling information will be reset whenever the results are ;; displayed. You can also reset all profiling info at any time with ;; M-x elp-reset-all. ;; ;; You can also instrument all functions in a package, provided that ;; the package follows the GNU coding standard of a common textural ;; prefix. Use M-x elp-instrument-package for this. ;; ;; If you want to sort the results, set elp-sort-by-function to some ;; predicate function. The three most obvious choices are predefined: ;; elp-sort-by-call-count, elp-sort-by-average-time, and ;; elp-sort-by-total-time. Also, you can prune from the output, all ;; functions that have been called fewer than a given number of times ;; by setting elp-report-limit. ;; ;; Elp can instrument byte-compiled functions just as easily as ;; interpreted functions, but it cannot instrument macros. However, ;; when you redefine a function (e.g. with eval-defun), you'll need to ;; re-instrument it with M-x elp-instrument-function. This will also ;; reset profiling information for that function. Elp can handle ;; interactive functions (i.e. commands), but of course any time spent ;; idling for user prompts will show up in the timing results. ;; ;; You can also designate a `master' function. Profiling times will ;; be gathered for instrumented functions only during execution of ;; this master function. Thus, if you have some defuns like: ;; ;; (defun foo () (do-something-time-intensive)) ;; (defun bar () (foo)) ;; (defun baz () (bar) (foo)) ;; ;; and you want to find out the amount of time spent in bar and foo, ;; but only during execution of bar, make bar the master. The call of ;; foo from baz will not add to foo's total timing sums. Use M-x ;; elp-set-master and M-x elp-unset-master to utilize this feature. ;; Only one master function can be set at a time. ;; You can restore any function's original function definition with ;; elp-restore-function. The other instrument, restore, and reset ;; functions are provided for symmetry. ;; Note that there are plenty of factors that could make the times ;; reported unreliable, including the accuracy and granularity of your ;; system clock, and the overhead spent in lisp calculating and ;; recording the intervals. The latter I figure is pretty constant ;; so, while the times may not be entirely accurate, I think they'll ;; give you a good feel for the relative amount of work spent in the ;; various lisp routines you are profiling. Note further that times ;; are calculated using wall-clock time, so other system load will ;; affect accuracy too. ;; Here is a list of variable you can use to customize elp: ;; elp-function-list ;; elp-reset-after-results ;; elp-sort-by-function ;; elp-report-limit ;; ;; Here is a list of the interactive commands you can use: ;; elp-instrument-function ;; elp-restore-function ;; elp-instrument-list ;; elp-restore-list ;; elp-instrument-package ;; elp-restore-all ;; elp-reset-function ;; elp-reset-list ;; elp-reset-all ;; elp-set-master ;; elp-unset-master ;; elp-results ;; elp-submit-bug-report ;; Note that there are plenty of factors that could make the times ;; reported unreliable, including the accuracy and granularity of your ;; system clock, and the overhead spent in lisp calculating and ;; recording the intervals. I figure the latter is pretty constant, ;; so while the times may not be entirely accurate, I think they'll ;; give you a good feel for the relative amount of work spent in the ;; various lisp routines you are profiling. Note further that times ;; are calculated using wall-clock time, so other system load will ;; affect accuracy too. You cannot profile anything longer than ~18 ;; hours since I throw away the most significant 16 bits of seconds ;; returned by current-time: 2^16 == 65536 seconds == ~1092 minutes == ;; ~18 hours. I doubt you will ever want to profile stuff on the ;; order of 18 hours anyway. ;;; Background: ;; This program is based on the only two existing Emacs Lisp profilers ;; that I'm aware of, Boaz Ben-Zvi's profile.el, and Root Boy Jim's ;; profiler.el. Both were written for Emacs 18 and both were pretty ;; good first shots at profiling, but I found that they didn't provide ;; the functionality or interface that I wanted. So I wrote this. ;; I've tested elp in GNU Emacs 19 and in GNU XEmacs. There's no ;; point in even trying to make this work with Emacs 18. ;; Unlike previous profilers, elp uses Emacs 19's built-in function ;; current-time to return interval times. This obviates the need for ;; both an external C program and Emacs processes to communicate with ;; such a program, and thus simplifies the package as a whole. ;;; Code: ;; start user configuration variables ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv (defvar elp-function-list nil "*List of function to profile.") (defvar elp-reset-after-results t "*Non-nil means reset all profiling info after results are displayed. Results are displayed with the `elp-results' command.") (defvar elp-sort-by-function nil "*Non-nil specifies elp results sorting function. These functions are currently available: elp-sort-by-call-count -- sort by the highest call count elp-sort-by-total-time -- sort by the highest total time elp-sort-by-average-time -- sort by the highest average times You can write you're own sort function. It should adhere to the interface specified by the PRED argument for the `sort' defun. Each \"element of LIST\" is really a 4 element vector where element 0 is the call count, element 1 is the total time spent in the function, element 2 is the average time spent in the function, and element 3 is the symbol's name string.") (defvar elp-report-limit nil "*Prevents some functions from being displayed in the results buffer. If a number, no function that has been called fewer than that number of times will be displayed in the output buffer. If nil, all functions will be displayed.") ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; end user configuration variables (defconst elp-version "2.23" "ELP version number.") (defconst elp-help-address "tools-help@anthem.nlm.nih.gov" "Address accepting submissions of bug reports and questions.") (defvar elp-results-buffer "*ELP Profiling Results*" "Buffer name for outputting profiling results.") (defconst elp-timer-info-property 'elp-info "ELP information property name.") (defvar elp-all-instrumented-list nil "List of all functions currently being instrumented.") (defvar elp-record-p t "Controls whether functions should record times or not. This variable is set by the master function.") (defvar elp-master nil "Master function symbol.") ;;;###autoload (defun elp-instrument-function (funsym) "Instrument FUNSYM for profiling. FUNSYM must be a symbol of a defined function." (interactive "aFunction to instrument: ") ;; TBD what should we do if the function is already instrumented??? (let* ((funguts (symbol-function funsym)) (infovec (vector 0 0 funguts)) (newguts '(lambda (&rest args)))) ;; we cannot profile macros (and (eq (car-safe funguts) 'macro) (error "ELP cannot profile macro %s" funsym)) ;; put rest of newguts together (if (commandp funsym) (setq newguts (append newguts '((interactive))))) (setq newguts (append newguts (list (list 'elp-wrapper (list 'quote funsym) (list 'and '(interactive-p) (not (not (commandp funsym)))) 'args)))) ;; to record profiling times, we set the symbol's function ;; definition so that it runs the elp-wrapper function with the ;; function symbol as an argument. We place the old function ;; definition on the info vector. ;; ;; The info vector data structure is a 3 element vector. The 0th ;; element is the call-count, i.e. the total number of times this ;; function has been entered. This value is bumped up on entry to ;; the function so that non-local exists are still recorded. TBD: ;; I haven't tested non-local exits at all, so no guarantees. ;; ;; The 1st element is the total amount of time in usecs that have ;; been spent inside this function. This number is added to on ;; function exit. ;; ;; The 2nd element is the old function definition list. This gets ;; funcall'd in between start/end time retrievals. I believe that ;; this lets us profile even byte-compiled functions. ;; put the info vector on the property list (put funsym elp-timer-info-property infovec) ;; set the symbol's new profiling function definition to run ;; elp-wrapper (fset funsym newguts) ;; add this function to the instrumentation list (or (memq funsym elp-all-instrumented-list) (setq elp-all-instrumented-list (cons funsym elp-all-instrumented-list))) )) ;;;###autoload (defun elp-restore-function (funsym) "Restore an instrumented function to its original definition. Argument FUNSYM is the symbol of a defined function." (interactive "aFunction to restore: ") (let ((info (get funsym elp-timer-info-property))) ;; delete the function from the all instrumented list (setq elp-all-instrumented-list (delq funsym elp-all-instrumented-list)) ;; if the function was the master, reset the master (if (eq funsym elp-master) (setq elp-master nil elp-record-p t)) ;; zap the properties (put funsym elp-timer-info-property nil) ;; restore the original function definition, but if the function ;; wasn't instrumented do nothing. we do this after the above ;; because its possible the function got un-instrumented due to ;; circumstances beyond our control. Also, check to make sure ;; that the current function symbol points to elp-wrapper. If ;; not, then the user probably did an eval-defun while the ;; function was instrumented and we don't want to destroy the new ;; definition. (and info (assq 'elp-wrapper (symbol-function funsym)) (fset funsym (aref info 2))))) ;;;###autoload (defun elp-instrument-list (&optional list) "Instrument for profiling, all functions in `elp-function-list'. Use optional LIST if provided instead." (interactive "PList of functions to instrument: ") (let ((list (or list elp-function-list))) (mapcar 'elp-instrument-function list))) ;;;###autoload (defun elp-instrument-package (prefix) "Instrument for profiling, all functions which start with PREFIX. For example, to instrument all ELP functions, do the following: \\[elp-instrument-package] RET elp- RET" (interactive "sPrefix of package to instrument: ") (elp-instrument-list (mapcar 'intern (all-completions prefix obarray (function (lambda (sym) (and (fboundp sym) (not (eq (car-safe (symbol-function sym)) 'macro))))))))) (defun elp-restore-list (&optional list) "Restore the original definitions for all functions in `elp-function-list'. Use optional LIST if provided instead." (interactive "PList of functions to restore: ") (let ((list (or list elp-function-list))) (mapcar 'elp-restore-function list))) (defun elp-restore-all () "Restores the original definitions of all functions being profiled." (interactive) (elp-restore-list elp-all-instrumented-list)) (defun elp-reset-function (funsym) "Reset the profiling information for FUNSYM." (interactive "aFunction to reset: ") (let ((info (get funsym elp-timer-info-property))) (or info (error "%s is not instrumented for profiling." funsym)) (aset info 0 0) ;reset call counter (aset info 1 0.0) ;reset total time ;; don't muck with aref 2 as that is the old symbol definition )) (defun elp-reset-list (&optional list) "Reset the profiling information for all functions in `elp-function-list'. Use optional LIST if provided instead." (interactive "PList of functions to reset: ") (let ((list (or list elp-function-list))) (mapcar 'elp-reset-function list))) (defun elp-reset-all () "Reset the profiling information for all functions being profiled." (interactive) (elp-reset-list elp-all-instrumented-list)) (defun elp-set-master (funsym) "Set the master function for profiling." (interactive "aMaster function: ") ;; when there's a master function, recording is turned off by ;; default (setq elp-master funsym elp-record-p nil) ;; make sure master function is instrumented (or (memq funsym elp-all-instrumented-list) (elp-instrument-function funsym))) (defun elp-unset-master () "Unsets the master function." (interactive) ;; when there's no master function, recording is turned on by default. (setq elp-master nil elp-record-p t)) (defsubst elp-get-time () ;; get current time in seconds and microseconds. I throw away the ;; most significant 16 bits of seconds since I doubt we'll ever want ;; to profile lisp on the order of 18 hours. See notes at top of file. (let ((now (current-time))) (+ (float (nth 1 now)) (/ (float (nth 2 now)) 1000000.0)))) (defun elp-wrapper (funsym interactive-p args) "This function has been instrumented for profiling by the ELP. ELP is the Emacs Lisp Profiler. To restore the function to its original definition, use \\[elp-restore-function] or \\[elp-restore-all]." ;; turn on recording if this is the master function (if (and elp-master (eq funsym elp-master)) (setq elp-record-p t)) ;; get info vector and original function symbol (let* ((info (get funsym elp-timer-info-property)) (func (aref info 2)) result) (or func (error "%s is not instrumented for profiling." funsym)) (if (not elp-record-p) ;; when not recording, just call the original function symbol ;; and return the results. (setq result (if interactive-p (call-interactively func) (apply func args))) ;; we are recording times (let ((enter-time (elp-get-time))) ;; increment the call-counter (aset info 0 (1+ (aref info 0))) ;; now call the old symbol function, checking to see if it ;; should be called interactively. make sure we return the ;; correct value (setq result (if interactive-p (call-interactively func) (apply func args))) ;; calculate total time in function (aset info 1 (+ (aref info 1) (- (elp-get-time) enter-time))) )) ;; turn off recording if this is the master function (if (and elp-master (eq funsym elp-master)) (setq elp-record-p nil)) result)) ;; shut the byte-compiler up (defvar elp-field-len nil) (defvar elp-cc-len nil) (defvar elp-at-len nil) (defvar elp-et-len nil) (defun elp-sort-by-call-count (vec1 vec2) ;; sort by highest call count. See `sort'. (>= (aref vec1 0) (aref vec2 0))) (defun elp-sort-by-total-time (vec1 vec2) ;; sort by highest total time spent in function. See `sort'. (>= (aref vec1 1) (aref vec2 1))) (defun elp-sort-by-average-time (vec1 vec2) ;; sort by highest average time spent in function. See `sort'. (>= (aref vec1 2) (aref vec2 2))) (defsubst elp-pack-number (number width) ;; pack the NUMBER string into WIDTH characters, watching out for ;; very small or large numbers (if (<= (length number) width) number ;; check for very large or small numbers (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number) (concat (substring (substring number (match-beginning 1) (match-end 1)) 0 (- width (match-end 2) (- (match-beginning 2)) 3)) "..." (substring number (match-beginning 2) (match-end 2))) (concat (substring number 0 width))))) (defun elp-output-result (resultvec) ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or ;; more element vector where aref 0 is the call count, aref 1 is the ;; total time spent in the function, aref 2 is the average time ;; spent in the function, and aref 3 is the symbol's string ;; name. All other elements in the vector are ignored. (let* ((cc (aref resultvec 0)) (tt (aref resultvec 1)) (at (aref resultvec 2)) (symname (aref resultvec 3)) callcnt totaltime avetime) (setq callcnt (number-to-string cc) totaltime (number-to-string tt) avetime (number-to-string at)) ;; possibly prune the results (if (and elp-report-limit (numberp elp-report-limit) (< cc elp-report-limit)) nil (insert symname) (insert-char 32 (+ elp-field-len (- (length symname)) 2)) ;; print stuff out, formatting it nicely (insert callcnt) (insert-char 32 (+ elp-cc-len (- (length callcnt)) 2)) (let ((ttstr (elp-pack-number totaltime elp-et-len)) (atstr (elp-pack-number avetime elp-at-len))) (insert ttstr) (insert-char 32 (+ elp-et-len (- (length ttstr)) 2)) (insert atstr)) (insert "\n")))) ;;;###autoload (defun elp-results () "Display current profiling results. If `elp-reset-after-results' is non-nil, then current profiling information for all instrumented functions are reset after results are displayed." (interactive) (let ((curbuf (current-buffer)) (resultsbuf (get-buffer-create elp-results-buffer))) (set-buffer resultsbuf) (erase-buffer) (beginning-of-buffer) ;; get the length of the longest function name being profiled (let* ((longest 0) (title "Function Name") (titlelen (length title)) (elp-field-len titlelen) (cc-header "Call Count") (elp-cc-len (length cc-header)) (et-header "Elapsed Time") (elp-et-len (length et-header)) (at-header "Average Time") (elp-at-len (length at-header)) (resvec (mapcar (function (lambda (funsym) (let* ((info (get funsym elp-timer-info-property)) (symname (format "%s" funsym)) (cc (aref info 0)) (tt (aref info 1))) (if (not info) (insert "No profiling information found for: " symname) (setq longest (max longest (length symname))) (vector cc tt (if (zerop cc) 0.0 ;avoid arithmetic div-by-zero errors (/ (float tt) (float cc))) symname))))) elp-all-instrumented-list)) ) ; end let* (insert title) (if (> longest titlelen) (progn (insert-char 32 (- longest titlelen)) (setq elp-field-len longest))) (insert " " cc-header " " et-header " " at-header "\n") (insert-char ?= elp-field-len) (insert " ") (insert-char ?= elp-cc-len) (insert " ") (insert-char ?= elp-et-len) (insert " ") (insert-char ?= elp-at-len) (insert "\n") ;; if sorting is enabled, then sort the results list. in either ;; case, call elp-output-result to output the result in the ;; buffer (if elp-sort-by-function (setq resvec (sort resvec elp-sort-by-function))) (mapcar 'elp-output-result resvec)) ;; now pop up results buffer (set-buffer curbuf) (pop-to-buffer resultsbuf) ;; reset profiling info if desired (and elp-reset-after-results (elp-reset-all)))) (eval-when-compile (require 'reporter)) ;;;###autoload (defun elp-submit-bug-report () "Submit via mail, a bug report on elp." (interactive) (and (y-or-n-p "Do you want to submit a report on elp? ") (require 'reporter) (reporter-submit-bug-report elp-help-address (concat "elp " elp-version) '(elp-report-limit elp-reset-after-results elp-sort-by-function)))) (provide 'elp) ;; elp.el ends here emacs-19.30/lisp/emacs-lock.el100444 12120 1 4726 6045202256 14421 0ustar rmsdaemon;;; emacs-lock.el --- prevents you from exiting emacs if a buffer is locked ;; Copyright (C) 1994 Free Software Foundation, Inc ;; ;; Author: Tom Wurgler ;; Created: 12/8/94 ;; Version: 1.3 ;; Keywords: ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; ;; This code sets a buffer-local variable to t if toggle-emacs-lock is run, ;; then if the user attempts to exit emacs, the locked buffer name will be ;; displayed and the exit aborted. This is just a way of protecting ;; yourself from yourself. For example, if you have a shell running a big ;; program and exiting emacs would abort that program, you may want to lock ;; that buffer, then if you forget about it after a while, you won't ;; accidently exit emacs. To unlock the buffer, just goto the buffer and ;; run toggle-emacs-lock again. (defvar lock-emacs-from-exiting nil "Whether emacs is locked to prevent exiting. See `check-emacs-lock'.") (make-variable-buffer-local 'lock-emacs-from-exiting) (defun check-emacs-lock () "Check if variable `lock-emacs-from-exiting' is t for any buffer. If any t is found, signal error and display the locked buffer name." (let ((buffers (buffer-list))) (save-excursion (while buffers (set-buffer (car buffers)) (if lock-emacs-from-exiting (error "Emacs is locked from exit due to buffer: %s" (buffer-name)) (setq buffers (cdr buffers))))))) (defun toggle-emacs-lock () "Toggle `lock-emacs-from-exiting' between t and nil for the current buffer. See `check-emacs-lock'." (interactive) (if lock-emacs-from-exiting (setq lock-emacs-from-exiting nil) (setq lock-emacs-from-exiting t)) (if lock-emacs-from-exiting (message "Emacs is now locked from exiting.") (message "Emacs is now unlocked."))) (add-hook 'kill-emacs-hook 'check-emacs-lock) ;; emacs-lock.el ends here emacs-19.30/lisp/emacsbug.el100444 12120 1 7110 6041322337 14156 0ustar rmsdaemon;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list. ;; Copyright (C) 1985, 1994 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF ;; Keywords: maint ;; Not fully installed because it can work only on Internet hosts. ;; 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: ;; `M-x report-emacs-bug ' starts an email note to the Emacs maintainers ;; describing a problem. Here's how it's done... ;;; Code: ;; >> This should be an address which is accessible to your machine, ;; >> otherwise you can't use this file. It will only work on the ;; >> internet with this address. (require 'sendmail) (defvar bug-gnu-emacs "bug-gnu-emacs@prep.ai.mit.edu" "Address of site maintaining mailing list for GNU Emacs bugs.") (defvar report-emacs-bug-orig-text nil "The automatically-created initial text of bug report.") ;;;###autoload (defun report-emacs-bug (topic) "Report a bug in GNU Emacs. Prompts for bug subject. Leaves you in a mail buffer." (interactive "sBug Subject: ") (mail nil bug-gnu-emacs topic) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (insert "In " (emacs-version) "\n") (if (and system-configuration-options (not (equal system-configuration-options ""))) (insert "configured using `configure " system-configuration-options "'\n")) (insert "\n") ;; This is so the user has to type something ;; in order to send easily. (use-local-map (nconc (make-sparse-keymap) (current-local-map))) (define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info) (with-output-to-temp-buffer "*Bug Help*" (princ (substitute-command-keys "Type \\[mail-send-and-exit] to send the bug report.\n")) (terpri) (princ (substitute-command-keys "Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section about when and how to write a bug report, and what information to supply so that the bug can be fixed. Type SPC to scroll through this section and its subsections."))) ;; Make it less likely people will send empty messages. (make-local-variable 'mail-send-hook) (add-hook 'mail-send-hook 'report-emacs-bug-hook) (save-excursion (goto-char (point-max)) (skip-chars-backward " \t\n") (make-local-variable 'report-emacs-bug-orig-text) (setq report-emacs-bug-orig-text (buffer-substring (point-min) (point))))) (defun report-emacs-bug-info () "Go to the Info node on reporting Emacs bugs." (interactive) (info) (Info-directory) (Info-menu "emacs") (Info-goto-node "Bugs")) (defun report-emacs-bug-hook () (save-excursion (goto-char (point-max)) (skip-chars-backward " \t\n") (if (and (= (- (point) (point-min)) (length report-emacs-bug-orig-text)) (equal (buffer-substring (point-min) (point)) report-emacs-bug-orig-text)) (error "No text entered in bug report")))) (provide 'emacsbug) ;;; emacsbug.el ends here emacs-19.30/lisp/emerge.el100444 75424 12 355206 5747256663 14020 0ustar kwzhstaff;;; emerge.el --- merge diffs under Emacs control ;;; The author has placed this file in the public domain. ;; Author: Dale R. Worley ;; Version: 5fsf ;; Keywords: unix, tools ;; This software was created by Dale R. Worley and is ;; distributed free of charge. It is placed in the public domain and ;; permission is granted to anyone to use, duplicate, modify and redistribute ;; it provided that this notice is attached. ;; Dale R. Worley provides absolutely NO WARRANTY OF ANY KIND ;; with respect to this software. The entire risk as to the quality and ;; performance of this software is with the user. IN NO EVENT WILL DALE ;; R. WORLEY BE LIABLE TO ANYONE FOR ANY DAMAGES ARISING OUT THE ;; USE OF THIS SOFTWARE, INCLUDING, WITHOUT LIMITATION, DAMAGES RESULTING FROM ;; LOST DATA OR LOST PROFITS, OR FOR ANY SPECIAL, INCIDENTAL OR CONSEQUENTIAL ;; DAMAGES. ;;; Code: ;;;###autoload (defvar menu-bar-emerge-menu (make-sparse-keymap "Emerge")) ;;;###autoload (fset 'menu-bar-emerge-menu (symbol-value 'menu-bar-emerge-menu)) ;;;###autoload (define-key menu-bar-emerge-menu [emerge-merge-directories] '("Merge Directories ..." . emerge-merge-directories)) ;;;###autoload (define-key menu-bar-emerge-menu [emerge-revisions-with-ancestor] '("Revisions with Ancestor ..." . emerge-revisions-with-ancestor)) ;;;###autoload (define-key menu-bar-emerge-menu [emerge-revisions] '("Revisions ..." . emerge-revisions)) ;;;###autoload (define-key menu-bar-emerge-menu [emerge-files-with-ancestor] '("Files with Ancestor ..." . emerge-files-with-ancestor)) ;;;###autoload (define-key menu-bar-emerge-menu [emerge-files] '("Files ..." . emerge-files)) ;;;###autoload (define-key menu-bar-emerge-menu [emerge-buffers-with-ancestor] '("Buffers with Ancestor ..." . emerge-buffers-with-ancestor)) ;;;###autoload (define-key menu-bar-emerge-menu [emerge-buffers] '("Buffers ..." . emerge-buffers)) ;;; Macros (defmacro emerge-eval-in-buffer (buffer &rest forms) "Macro to switch to BUFFER, evaluate FORMS, returns to original buffer. Differs from `save-excursion' in that it doesn't save the point and mark." (` (let ((StartBuffer (current-buffer))) (unwind-protect (progn (set-buffer (, buffer)) (,@ forms)) (set-buffer StartBuffer))))) (defmacro emerge-defvar-local (var value doc) "Defines SYMBOL as an advertised variable. Performs a defvar, then executes `make-variable-buffer-local' on the variable. Also sets the `preserved' property, so that `kill-all-local-variables' (called by major-mode setting commands) won't destroy Emerge control variables." (` (progn (defvar (, var) (, value) (, doc)) (make-variable-buffer-local '(, var)) (put '(, var) 'preserved t)))) ;; Add entries to minor-mode-alist so that emerge modes show correctly (defvar emerge-minor-modes-list '((emerge-mode " Emerge") (emerge-fast-mode " F") (emerge-edit-mode " E") (emerge-auto-advance " A") (emerge-skip-prefers " S"))) (if (not (assq 'emerge-mode minor-mode-alist)) (setq minor-mode-alist (append emerge-minor-modes-list minor-mode-alist))) ;; We need to define this function so describe-mode can describe Emerge mode. (defun emerge-mode () "Emerge mode is used by the Emerge file-merging package. It is entered only through one of the functions: `emerge-files' `emerge-files-with-ancestor' `emerge-buffers' `emerge-buffers-with-ancestor' `emerge-files-command' `emerge-files-with-ancestor-command' `emerge-files-remote' `emerge-files-with-ancestor-remote' Commands: \\{emerge-basic-keymap} Commands must be prefixed by \\\\[emerge-basic-keymap] in `edit' mode, but can be invoked directly in `fast' mode.") (defvar emerge-version "5fsf" "The version of Emerge.") (defun emerge-version () "Return string describing the version of Emerge. When called interactively, displays the version." (interactive) (if (interactive-p) (message "Emerge version %s" (emerge-version)) emerge-version)) ;;; Emerge configuration variables ;; Commands that produce difference files ;; All that can be configured is the name of the programs to execute ;; (emerge-diff-program and emerge-diff3-program) and the options ;; to be provided (emerge-diff-options). The order in which the file names ;; are given is fixed. ;; The file names are always expanded (see expand-file-name) before being ;; passed to diff, thus they need not be invoked under a shell that ;; understands `~'. ;; The code which processes the diff/diff3 output depends on all the ;; finicky details of their output, including the somewhat strange ;; way they number lines of a file. (defvar emerge-diff-program "diff" "*Name of the program which compares two files.") (defvar emerge-diff3-program "diff3" "*Name of the program which compares three files. Its arguments are the ancestor file and the two variant files.") (defvar emerge-diff-options "" "*Options to pass to `emerge-diff-program' and `emerge-diff3-program'.") (defvar emerge-match-diff-line (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)")) (concat "^" x "\\([acd]\\)" x "$")) "*Pattern to match lines produced by diff that describe differences. This is as opposed to lines from the source files.") (defvar emerge-diff-ok-lines-regexp "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\)" "*Regexp that matches normal output lines from `emerge-diff-program'. Lines that do not match are assumed to be error messages.") (defvar emerge-diff3-ok-lines-regexp "^\\([1-3]:\\|====\\| \\)" "*Regexp that matches normal output lines from `emerge-diff3-program'. Lines that do not match are assumed to be error messages.") (defvar emerge-rcs-ci-program "ci" "*Name of the program that checks in RCS revisions.") (defvar emerge-rcs-co-program "co" "*Name of the program that checks out RCS revisions.") (defvar emerge-process-local-variables nil "*Non-nil if Emerge should process local-variables lists in merge buffers. \(You can explicitly request processing the local-variables by executing `(hack-local-variables)'.)") (defvar emerge-execute-line-deletions nil "*If non-nil: `emerge-execute-line' makes no output if an input was deleted. It concludes that an input version has been deleted when an ancestor entry is present, only one A or B entry is present, and an output entry is present. If nil: In such circumstances, the A or B file that is present will be copied to the designated output file.") (defvar emerge-before-flag "vvvvvvvvvvvvvvvvvvvv\n" "*Flag placed above the highlighted block of code. Must end with newline. Must be set before Emerge is loaded, or emerge-new-flags must be run after setting.") (defvar emerge-after-flag "^^^^^^^^^^^^^^^^^^^^\n" "*Flag placed below the highlighted block of code. Must end with newline. Must be set before Emerge is loaded, or emerge-new-flags must be run after setting.") ;; Hook variables (defvar emerge-startup-hook nil "*Hook to run in the merge buffer after the merge has been set up.") (defvar emerge-select-hook nil "*Hook to run after a difference has been selected. The variable `n' holds the (internal) number of the difference.") (defvar emerge-unselect-hook nil "*Hook to run after a difference has been unselected. The variable `n' holds the (internal) number of the difference.") ;; Variables to control the default directories of the arguments to ;; Emerge commands. (defvar emerge-default-last-directories nil "*If nil, default dir for filenames in emerge is `default-directory'. If non-nil, filenames complete in the directory of the last argument of the same type to an `emerge-files...' command.") (defvar emerge-last-dir-A nil "Last directory for the first file of an `emerge-files...' command.") (defvar emerge-last-dir-B nil "Last directory for the second file of an `emerge-files...' command.") (defvar emerge-last-dir-ancestor nil "Last directory for the ancestor file of an `emerge-files...' command.") (defvar emerge-last-dir-output nil "Last directory for the output file of an `emerge-files...' command.") (defvar emerge-last-revision-A nil "Last RCS revision used for first file of an `emerge-revisions...' command.") (defvar emerge-last-revision-B nil "Last RCS revision used for second file of an `emerge-revisions...' command.") (defvar emerge-last-revision-ancestor nil "Last RCS revision used for ancestor file of an `emerge-revisions...' command.") (defvar emerge-before-flag-length) (defvar emerge-before-flag-lines) (defvar emerge-before-flag-match) (defvar emerge-after-flag-length) (defvar emerge-after-flag-lines) (defvar emerge-after-flag-match) (defvar emerge-diff-buffer) (defvar emerge-diff-error-buffer) (defvar emerge-prefix-argument) (defvar emerge-file-out) (defvar emerge-exit-func) (defvar emerge-globalized-difference-list) (defvar emerge-globalized-number-of-differences) ;; The flags used to mark differences in the buffers. ;; These function definitions need to be up here, because they are used ;; during loading. (defun emerge-new-flags () "Function to be called after `emerge-{before,after}-flag'. This is called after these functions are changed to compute values that depend on the flags." (setq emerge-before-flag-length (length emerge-before-flag)) (setq emerge-before-flag-lines (emerge-count-matches-string emerge-before-flag "\n")) (setq emerge-before-flag-match (regexp-quote emerge-before-flag)) (setq emerge-after-flag-length (length emerge-after-flag)) (setq emerge-after-flag-lines (emerge-count-matches-string emerge-after-flag "\n")) (setq emerge-after-flag-match (regexp-quote emerge-after-flag))) (defun emerge-count-matches-string (string regexp) "Return the number of matches in STRING for REGEXP." (let ((i 0) (count 0)) (while (string-match regexp string i) (setq count (1+ count)) (setq i (match-end 0))) count)) ;; Calculate dependent variables (emerge-new-flags) (defvar emerge-min-visible-lines 3 "*Number of lines that we want to show above and below the flags when we are displaying a difference.") (defvar emerge-temp-file-prefix (let ((env (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP"))) d) (setq d (if (and env (> (length env) 0)) env "/tmp")) (if (= (aref d (1- (length d))) ?/) (setq d (substring d 0 -1))) (concat d "/emerge")) "*Prefix to put on Emerge temporary file names. Do not start with `~/' or `~user-name/'.") (defvar emerge-temp-file-mode 384 ; u=rw only "*Mode for Emerge temporary files.") (defvar emerge-combine-versions-template "#ifdef NEW\n%b#else /* NEW */\n%a#endif /* NEW */\n" "*Template for `emerge-combine-versions' to combine the two versions. The template is inserted as a string, with the following interpolations: %a the A version of the difference %b the B version of the difference %% the character `%' Don't forget to end the template with a newline. Note that this variable can be made local to a particular merge buffer by giving a prefix argument to `emerge-set-combine-versions-template'.") ;; Build keymaps (defvar emerge-basic-keymap nil "Keymap of Emerge commands. Directly available in `fast' mode; must be prefixed by \\\\[emerge-basic-keymap] in `edit' mode.") (defvar emerge-fast-keymap nil "Local keymap used in Emerge `fast' mode. Makes Emerge commands directly available.") (defvar emerge-options-menu (make-sparse-keymap "Options")) (defvar emerge-merge-menu (make-sparse-keymap "Merge")) (defvar emerge-move-menu (make-sparse-keymap "Move")) (defvar emerge-command-prefix "\C-c\C-c" "*Command prefix for Emerge commands in `edit' mode. Must be set before Emerge is loaded.") ;; This function sets up the fixed keymaps. It is executed when the first ;; Emerge is done to allow the user maximum time to set up the global keymap. (defun emerge-setup-fixed-keymaps () ;; Set up the basic keymap (setq emerge-basic-keymap (make-keymap)) (suppress-keymap emerge-basic-keymap) ; this sets 0..9 to digit-argument and ; - to negative-argument (define-key emerge-basic-keymap "p" 'emerge-previous-difference) (define-key emerge-basic-keymap "n" 'emerge-next-difference) (define-key emerge-basic-keymap "a" 'emerge-select-A) (define-key emerge-basic-keymap "b" 'emerge-select-B) (define-key emerge-basic-keymap "j" 'emerge-jump-to-difference) (define-key emerge-basic-keymap "." 'emerge-find-difference) (define-key emerge-basic-keymap "q" 'emerge-quit) (define-key emerge-basic-keymap "\C-]" 'emerge-abort) (define-key emerge-basic-keymap "f" 'emerge-fast-mode) (define-key emerge-basic-keymap "e" 'emerge-edit-mode) (define-key emerge-basic-keymap "s" nil) (define-key emerge-basic-keymap "sa" 'emerge-auto-advance) (define-key emerge-basic-keymap "ss" 'emerge-skip-prefers) (define-key emerge-basic-keymap "l" 'emerge-recenter) (define-key emerge-basic-keymap "d" nil) (define-key emerge-basic-keymap "da" 'emerge-default-A) (define-key emerge-basic-keymap "db" 'emerge-default-B) (define-key emerge-basic-keymap "c" nil) (define-key emerge-basic-keymap "ca" 'emerge-copy-as-kill-A) (define-key emerge-basic-keymap "cb" 'emerge-copy-as-kill-B) (define-key emerge-basic-keymap "i" nil) (define-key emerge-basic-keymap "ia" 'emerge-insert-A) (define-key emerge-basic-keymap "ib" 'emerge-insert-B) (define-key emerge-basic-keymap "m" 'emerge-mark-difference) (define-key emerge-basic-keymap "v" 'emerge-scroll-up) (define-key emerge-basic-keymap "^" 'emerge-scroll-down) (define-key emerge-basic-keymap "<" 'emerge-scroll-left) (define-key emerge-basic-keymap ">" 'emerge-scroll-right) (define-key emerge-basic-keymap "|" 'emerge-scroll-reset) (define-key emerge-basic-keymap "x" nil) (define-key emerge-basic-keymap "x1" 'emerge-one-line-window) (define-key emerge-basic-keymap "xc" 'emerge-combine-versions) (define-key emerge-basic-keymap "xC" 'emerge-combine-versions-register) (define-key emerge-basic-keymap "xf" 'emerge-file-names) (define-key emerge-basic-keymap "xj" 'emerge-join-differences) (define-key emerge-basic-keymap "xl" 'emerge-line-numbers) (define-key emerge-basic-keymap "xm" 'emerge-set-merge-mode) (define-key emerge-basic-keymap "xs" 'emerge-split-difference) (define-key emerge-basic-keymap "xt" 'emerge-trim-difference) (define-key emerge-basic-keymap "xx" 'emerge-set-combine-versions-template) ;; Allow emerge-basic-keymap to be referenced indirectly (fset 'emerge-basic-keymap emerge-basic-keymap) ;; Set up the fast mode keymap (setq emerge-fast-keymap (copy-keymap emerge-basic-keymap)) ;; Allow prefixed commands to work in fast mode (define-key emerge-fast-keymap emerge-command-prefix 'emerge-basic-keymap) ;; Allow emerge-fast-keymap to be referenced indirectly (fset 'emerge-fast-keymap emerge-fast-keymap) ;; Suppress write-file and save-buffer (substitute-key-definition 'write-file 'emerge-query-write-file emerge-fast-keymap (current-global-map)) (substitute-key-definition 'save-buffer 'emerge-query-save-buffer emerge-fast-keymap (current-global-map)) (define-key emerge-basic-keymap [menu-bar] (make-sparse-keymap)) (define-key emerge-fast-keymap [menu-bar options] (cons "Options" emerge-options-menu)) (define-key emerge-fast-keymap [menu-bar merge] (cons "Merge" emerge-merge-menu)) (define-key emerge-fast-keymap [menu-bar move] (cons "Move" emerge-move-menu)) (define-key emerge-move-menu [emerge-scroll-reset] '("Scroll Reset" . emerge-scroll-reset)) (define-key emerge-move-menu [emerge-scroll-right] '("Scroll Right" . emerge-scroll-right)) (define-key emerge-move-menu [emerge-scroll-left] '("Scroll Left" . emerge-scroll-left)) (define-key emerge-move-menu [emerge-scroll-down] '("Scroll Down" . emerge-scroll-down)) (define-key emerge-move-menu [emerge-scroll-up] '("Scroll Up" . emerge-scroll-up)) (define-key emerge-move-menu [emerge-recenter] '("Recenter" . emerge-recenter)) (define-key emerge-move-menu [emerge-mark-difference] '("Mark Difference" . emerge-mark-difference)) (define-key emerge-move-menu [emerge-jump-to-difference] '("Jump To Difference" . emerge-jump-to-difference)) (define-key emerge-move-menu [emerge-find-difference] '("Find Difference" . emerge-find-difference)) (define-key emerge-move-menu [emerge-previous-difference] '("Previous Difference" . emerge-previous-difference)) (define-key emerge-move-menu [emerge-next-difference] '("Next Difference" . emerge-next-difference)) (define-key emerge-options-menu [emerge-one-line-window] '("One Line Window" . emerge-one-line-window)) (define-key emerge-options-menu [emerge-set-merge-mode] '("Set Merge Mode" . emerge-set-merge-mode)) (define-key emerge-options-menu [emerge-set-combine-template] '("Set Combine Template..." . emerge-set-combine-template)) (define-key emerge-options-menu [emerge-default-B] '("Default B" . emerge-default-B)) (define-key emerge-options-menu [emerge-default-A] '("Default A" . emerge-default-A)) (define-key emerge-options-menu [emerge-skip-prefers] '("Skip Prefers" . emerge-skip-prefers)) (define-key emerge-options-menu [emerge-auto-advance] '("Auto Advance" . emerge-auto-advance)) (define-key emerge-options-menu [emerge-edit-mode] '("Edit Mode" . emerge-edit-mode)) (define-key emerge-options-menu [emerge-fast-mode] '("Fast Mode" . emerge-fast-mode)) (define-key emerge-merge-menu [emerge-abort] '("Abort" . emerge-abort)) (define-key emerge-merge-menu [emerge-quit] '("Quit" . emerge-quit)) (define-key emerge-merge-menu [emerge-split-difference] '("Split Difference" . emerge-split-difference)) (define-key emerge-merge-menu [emerge-join-differences] '("Join Differences" . emerge-join-differences)) (define-key emerge-merge-menu [emerge-trim-difference] '("Trim Difference" . emerge-trim-difference)) (define-key emerge-merge-menu [emerge-combine-versions] '("Combine Versions" . emerge-combine-versions)) (define-key emerge-merge-menu [emerge-copy-as-kill-B] '("Copy B as Kill" . emerge-copy-as-kill-B)) (define-key emerge-merge-menu [emerge-copy-as-kill-A] '("Copy A as Kill" . emerge-copy-as-kill-A)) (define-key emerge-merge-menu [emerge-insert-B] '("Insert B" . emerge-insert-B)) (define-key emerge-merge-menu [emerge-insert-A] '("Insert A" . emerge-insert-A)) (define-key emerge-merge-menu [emerge-select-B] '("Select B" . emerge-select-B)) (define-key emerge-merge-menu [emerge-select-A] '("Select A" . emerge-select-A))) ;; Variables which control each merge. They are local to the merge buffer. ;; Mode variables (emerge-defvar-local emerge-mode nil "Indicator for emerge-mode.") (emerge-defvar-local emerge-fast-mode nil "Indicator for emerge-mode fast submode.") (emerge-defvar-local emerge-edit-mode nil "Indicator for emerge-mode edit submode.") (emerge-defvar-local emerge-A-buffer nil "The buffer in which the A variant is stored.") (emerge-defvar-local emerge-B-buffer nil "The buffer in which the B variant is stored.") (emerge-defvar-local emerge-merge-buffer nil "The buffer in which the merged file is manipulated.") (emerge-defvar-local emerge-ancestor-buffer nil "The buffer in which the ancestor variant is stored, or nil if there is none.") (defconst emerge-saved-variables '((buffer-modified-p set-buffer-modified-p) buffer-read-only buffer-auto-save-file-name) "Variables and properties of a buffer which are saved, modified and restored during a merge.") (defconst emerge-merging-values '(nil t nil) "Values to be assigned to emerge-saved-variables during a merge.") (emerge-defvar-local emerge-A-buffer-values nil "Remembers emerge-saved-variables for emerge-A-buffer.") (emerge-defvar-local emerge-B-buffer-values nil "Remembers emerge-saved-variables for emerge-B-buffer.") (emerge-defvar-local emerge-difference-list nil "Vector of differences between the variants, and markers in the buffers to show where they are. Each difference is represented by a vector of seven elements. The first two are markers to the beginning and end of the difference section in the A buffer, the second two are markers for the B buffer, the third two are markers for the merge buffer, and the last element is the \"state\" of that difference in the merge buffer. A section of a buffer is described by two markers, one to the beginning of the first line of the section, and one to the beginning of the first line after the section. (If the section is empty, both markers point to the same point.) If the section is part of the selected difference, then the markers are moved into the flags, so the user can edit the section without disturbing the markers. The \"states\" are: A the merge buffer currently contains the A variant B the merge buffer currently contains the B variant default-A the merge buffer contains the A variant by default, but this difference hasn't been selected yet, so change-default commands can alter it default-B the merge buffer contains the B variant by default, but this difference hasn't been selected yet, so change-default commands can alter it prefer-A in a three-file merge, the A variant is the preferred choice prefer-B in a three-file merge, the B variant is the preferred choice") (emerge-defvar-local emerge-current-difference -1 "The difference that is currently selected.") (emerge-defvar-local emerge-number-of-differences nil "Number of differences found.") (emerge-defvar-local emerge-edit-keymap nil "The local keymap for the merge buffer, with the emerge commands defined in it. Used to save the local keymap during fast mode, when the local keymap is replaced by emerge-fast-keymap.") (emerge-defvar-local emerge-old-keymap nil "The original local keymap for the merge buffer.") (emerge-defvar-local emerge-auto-advance nil "*If non-nil, emerge-select-A and emerge-select-B automatically advance to the next difference.") (emerge-defvar-local emerge-skip-prefers nil "*If non-nil, differences for which there is a preference are automatically skipped.") (emerge-defvar-local emerge-quit-hook nil "Hooks to run in the merge buffer after the merge has been finished. `emerge-prefix-argument' will hold the prefix argument of the `emerge-quit' command. This is *not* a user option, since Emerge uses it for its own processing.") (emerge-defvar-local emerge-output-description nil "Describes output destination of emerge, for `emerge-file-names'.") ;;; Setup functions for two-file mode. (defun emerge-files-internal (file-A file-B &optional startup-hooks quit-hooks output-file) (if (not (file-readable-p file-A)) (error "File `%s' does not exist or is not readable" file-A)) (if (not (file-readable-p file-B)) (error "File `%s' does not exist or is not readable" file-B)) (let ((buffer-A (find-file-noselect file-A)) (buffer-B (find-file-noselect file-B))) ;; Record the directories of the files (setq emerge-last-dir-A (file-name-directory file-A)) (setq emerge-last-dir-B (file-name-directory file-B)) (if output-file (setq emerge-last-dir-output (file-name-directory output-file))) ;; Make sure the entire files are seen, and they reflect what is on disk (emerge-eval-in-buffer buffer-A (widen) (let ((temp (file-local-copy file-A))) (if temp (setq file-A temp startup-hooks (cons (` (lambda () (delete-file (, file-A)))) startup-hooks)) ;; Verify that the file matches the buffer (emerge-verify-file-buffer)))) (emerge-eval-in-buffer buffer-B (widen) (let ((temp (file-local-copy file-B))) (if temp (setq file-B temp startup-hooks (cons (` (lambda () (delete-file (, file-B)))) startup-hooks)) ;; Verify that the file matches the buffer (emerge-verify-file-buffer)))) (emerge-setup buffer-A file-A buffer-B file-B startup-hooks quit-hooks output-file))) ;; Start up Emerge on two files (defun emerge-setup (buffer-A file-A buffer-B file-B startup-hooks quit-hooks output-file) (setq file-A (expand-file-name file-A)) (setq file-B (expand-file-name file-B)) (setq output-file (and output-file (expand-file-name output-file))) (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*")) ;; create the merge buffer from buffer A, so it inherits buffer A's ;; default directory, etc. (merge-buffer (emerge-eval-in-buffer buffer-A (get-buffer-create merge-buffer-name)))) (emerge-eval-in-buffer merge-buffer (emerge-copy-modes buffer-A) (setq buffer-read-only nil) (auto-save-mode 1) (setq emerge-mode t) (setq emerge-A-buffer buffer-A) (setq emerge-B-buffer buffer-B) (setq emerge-ancestor-buffer nil) (setq emerge-merge-buffer merge-buffer) (setq emerge-output-description (if output-file (concat "Output to file: " output-file) (concat "Output to buffer: " (buffer-name merge-buffer)))) (insert-buffer emerge-A-buffer) (emerge-set-keys) (setq emerge-difference-list (emerge-make-diff-list file-A file-B)) (setq emerge-number-of-differences (length emerge-difference-list)) (setq emerge-current-difference -1) (setq emerge-quit-hook quit-hooks) (emerge-remember-buffer-characteristics) (emerge-handle-local-variables)) (emerge-setup-windows buffer-A buffer-B merge-buffer t) (emerge-eval-in-buffer merge-buffer (run-hooks 'startup-hooks 'emerge-startup-hook) (setq buffer-read-only t)))) ;; Generate the Emerge difference list between two files (defun emerge-make-diff-list (file-A file-B) (setq emerge-diff-buffer (get-buffer-create "*emerge-diff*")) (emerge-eval-in-buffer emerge-diff-buffer (erase-buffer) (shell-command (format "%s %s %s %s" emerge-diff-program emerge-diff-options (emerge-protect-metachars file-A) (emerge-protect-metachars file-B)) t)) (emerge-prepare-error-list emerge-diff-ok-lines-regexp) (emerge-convert-diffs-to-markers emerge-A-buffer emerge-B-buffer emerge-merge-buffer (emerge-extract-diffs emerge-diff-buffer))) (defun emerge-extract-diffs (diff-buffer) (let (list) (emerge-eval-in-buffer diff-buffer (goto-char (point-min)) (while (re-search-forward emerge-match-diff-line nil t) (let* ((a-begin (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))) (a-end (let ((b (match-beginning 3)) (e (match-end 3))) (if b (string-to-int (buffer-substring b e)) a-begin))) (diff-type (buffer-substring (match-beginning 4) (match-end 4))) (b-begin (string-to-int (buffer-substring (match-beginning 5) (match-end 5)))) (b-end (let ((b (match-beginning 7)) (e (match-end 7))) (if b (string-to-int (buffer-substring b e)) b-begin)))) ;; fix the beginning and end numbers, because diff is somewhat ;; strange about how it numbers lines (if (string-equal diff-type "a") (progn (setq b-end (1+ b-end)) (setq a-begin (1+ a-begin)) (setq a-end a-begin)) (if (string-equal diff-type "d") (progn (setq a-end (1+ a-end)) (setq b-begin (1+ b-begin)) (setq b-end b-begin)) ;; (string-equal diff-type "c") (progn (setq a-end (1+ a-end)) (setq b-end (1+ b-end))))) (setq list (cons (vector a-begin a-end b-begin b-end 'default-A) list))))) (nreverse list))) ;; Set up buffer of diff/diff3 error messages. (defun emerge-prepare-error-list (ok-regexp) (setq emerge-diff-error-buffer (get-buffer-create "*emerge-diff-errors*")) (emerge-eval-in-buffer emerge-diff-error-buffer (erase-buffer) (insert-buffer emerge-diff-buffer) (delete-matching-lines ok-regexp))) ;;; Top-level and setup functions for three-file mode. (defun emerge-files-with-ancestor-internal (file-A file-B file-ancestor &optional startup-hooks quit-hooks output-file) (if (not (file-readable-p file-A)) (error "File `%s' does not exist or is not readable" file-A)) (if (not (file-readable-p file-B)) (error "File `%s' does not exist or is not readable" file-B)) (if (not (file-readable-p file-ancestor)) (error "File `%s' does not exist or is not readable" file-ancestor)) (let ((buffer-A (find-file-noselect file-A)) (buffer-B (find-file-noselect file-B)) (buffer-ancestor (find-file-noselect file-ancestor))) ;; Record the directories of the files (setq emerge-last-dir-A (file-name-directory file-A)) (setq emerge-last-dir-B (file-name-directory file-B)) (setq emerge-last-dir-ancestor (file-name-directory file-ancestor)) (if output-file (setq emerge-last-dir-output (file-name-directory output-file))) ;; Make sure the entire files are seen, and they reflect what is on disk (emerge-eval-in-buffer buffer-A (widen) (let ((temp (file-local-copy file-A))) (if temp (setq file-A temp startup-hooks (cons (` (lambda () (delete-file (, file-A)))) startup-hooks)) ;; Verify that the file matches the buffer (emerge-verify-file-buffer)))) (emerge-eval-in-buffer buffer-B (widen) (let ((temp (file-local-copy file-B))) (if temp (setq file-B temp startup-hooks (cons (` (lambda () (delete-file (, file-B)))) startup-hooks)) ;; Verify that the file matches the buffer (emerge-verify-file-buffer)))) (emerge-eval-in-buffer buffer-ancestor (widen) (let ((temp (file-local-copy file-ancestor))) (if temp (setq file-ancestor temp startup-hooks (cons (` (lambda () (delete-file (, file-ancestor)))) startup-hooks)) ;; Verify that the file matches the buffer (emerge-verify-file-buffer)))) (emerge-setup-with-ancestor buffer-A file-A buffer-B file-B buffer-ancestor file-ancestor startup-hooks quit-hooks output-file))) ;; Start up Emerge on two files with an ancestor (defun emerge-setup-with-ancestor (buffer-A file-A buffer-B file-B buffer-ancestor file-ancestor &optional startup-hooks quit-hooks output-file) (setq file-A (expand-file-name file-A)) (setq file-B (expand-file-name file-B)) (setq file-ancestor (expand-file-name file-ancestor)) (setq output-file (and output-file (expand-file-name output-file))) (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*")) ;; create the merge buffer from buffer A, so it inherits buffer A's ;; default directory, etc. (merge-buffer (emerge-eval-in-buffer buffer-A (get-buffer-create merge-buffer-name)))) (emerge-eval-in-buffer merge-buffer (emerge-copy-modes buffer-A) (setq buffer-read-only nil) (auto-save-mode 1) (setq emerge-mode t) (setq emerge-A-buffer buffer-A) (setq emerge-B-buffer buffer-B) (setq emerge-ancestor-buffer buffer-ancestor) (setq emerge-merge-buffer merge-buffer) (setq emerge-output-description (if output-file (concat "Output to file: " output-file) (concat "Output to buffer: " (buffer-name merge-buffer)))) (insert-buffer emerge-A-buffer) (emerge-set-keys) (setq emerge-difference-list (emerge-make-diff3-list file-A file-B file-ancestor)) (setq emerge-number-of-differences (length emerge-difference-list)) (setq emerge-current-difference -1) (setq emerge-quit-hook quit-hooks) (emerge-remember-buffer-characteristics) (emerge-select-prefer-Bs) (emerge-handle-local-variables)) (emerge-setup-windows buffer-A buffer-B merge-buffer t) (emerge-eval-in-buffer merge-buffer (run-hooks 'startup-hooks 'emerge-startup-hook) (setq buffer-read-only t)))) ;; Generate the Emerge difference list between two files with an ancestor (defun emerge-make-diff3-list (file-A file-B file-ancestor) (setq emerge-diff-buffer (get-buffer-create "*emerge-diff*")) (emerge-eval-in-buffer emerge-diff-buffer (erase-buffer) (shell-command (format "%s %s %s %s %s" emerge-diff3-program emerge-diff-options (emerge-protect-metachars file-A) (emerge-protect-metachars file-ancestor) (emerge-protect-metachars file-B)) t)) (emerge-prepare-error-list emerge-diff3-ok-lines-regexp) (emerge-convert-diffs-to-markers emerge-A-buffer emerge-B-buffer emerge-merge-buffer (emerge-extract-diffs3 emerge-diff-buffer))) (defun emerge-extract-diffs3 (diff-buffer) (let (list) (emerge-eval-in-buffer diff-buffer (while (re-search-forward "^====\\(.?\\)$" nil t) ;; leave point after matched line (beginning-of-line 2) (let ((agreement (buffer-substring (match-beginning 1) (match-end 1)))) ;; if the A and B files are the same, ignore the difference (if (not (string-equal agreement "2")) (setq list (cons (let (group-1 group-3 pos) (setq pos (point)) (setq group-1 (emerge-get-diff3-group "1")) (goto-char pos) (setq group-3 (emerge-get-diff3-group "3")) (vector (car group-1) (car (cdr group-1)) (car group-3) (car (cdr group-3)) (cond ((string-equal agreement "1") 'prefer-A) ((string-equal agreement "3") 'prefer-B) (t 'default-A)))) list)))))) (nreverse list))) (defun emerge-get-diff3-group (file) ;; This save-excursion allows emerge-get-diff3-group to be called for the ;; various groups of lines (1, 2, 3) in any order, and for the lines to ;; appear in any order. The reason this is necessary is that Gnu diff3 ;; can produce the groups in the order 1, 2, 3 or 1, 3, 2. (save-excursion (re-search-forward (concat "^" file ":\\([0-9]+\\)\\(,\\([0-9]+\\)\\)?\\([ac]\\)$")) (beginning-of-line 2) ;; treatment depends on whether it is an "a" group or a "c" group (if (string-equal (buffer-substring (match-beginning 4) (match-end 4)) "c") ;; it is a "c" group (if (match-beginning 2) ;; it has two numbers (list (string-to-int (buffer-substring (match-beginning 1) (match-end 1))) (1+ (string-to-int (buffer-substring (match-beginning 3) (match-end 3))))) ;; it has one number (let ((x (string-to-int (buffer-substring (match-beginning 1) (match-end 1))))) (list x (1+ x)))) ;; it is an "a" group (let ((x (1+ (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))))) (list x x))))) ;;; Functions to start Emerge on files ;;;###autoload (defun emerge-files (arg file-A file-B file-out &optional startup-hooks quit-hooks) "Run Emerge on two files." (interactive (let (f) (list current-prefix-arg (setq f (emerge-read-file-name "File A to merge" emerge-last-dir-A nil nil t)) (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f t) (and current-prefix-arg (emerge-read-file-name "Output file" emerge-last-dir-output f f nil))))) (emerge-files-internal file-A file-B startup-hooks (if file-out (cons (` (lambda () (emerge-files-exit (, file-out)))) quit-hooks) quit-hooks) file-out)) ;;;###autoload (defun emerge-files-with-ancestor (arg file-A file-B file-ancestor file-out &optional startup-hooks quit-hooks) "Run Emerge on two files, giving another file as the ancestor." (interactive (let (f) (list current-prefix-arg (setq f (emerge-read-file-name "File A to merge" emerge-last-dir-A nil nil t)) (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f t) (emerge-read-file-name "Ancestor file" emerge-last-dir-ancestor nil f t) (and current-prefix-arg (emerge-read-file-name "Output file" emerge-last-dir-output f f nil))))) (emerge-files-with-ancestor-internal file-A file-B file-ancestor startup-hooks (if file-out (cons (` (lambda () (emerge-files-exit (, file-out)))) quit-hooks) quit-hooks) file-out)) ;; Write the merge buffer out in place of the file the A buffer is visiting. (defun emerge-files-exit (file-out) ;; if merge was successful was given, save to disk (if (not emerge-prefix-argument) (emerge-write-and-delete file-out))) ;;; Functions to start Emerge on buffers ;;;###autoload (defun emerge-buffers (buffer-A buffer-B &optional startup-hooks quit-hooks) "Run Emerge on two buffers." (interactive "bBuffer A to merge: \nbBuffer B to merge: ") (let ((emerge-file-A (emerge-make-temp-file "A")) (emerge-file-B (emerge-make-temp-file "B"))) (emerge-eval-in-buffer buffer-A (write-region (point-min) (point-max) emerge-file-A nil 'no-message)) (emerge-eval-in-buffer buffer-B (write-region (point-min) (point-max) emerge-file-B nil 'no-message)) (emerge-setup (get-buffer buffer-A) emerge-file-A (get-buffer buffer-B) emerge-file-B (cons (` (lambda () (delete-file (, emerge-file-A)) (delete-file (, emerge-file-B)))) startup-hooks) quit-hooks nil))) ;;;###autoload (defun emerge-buffers-with-ancestor (buffer-A buffer-B buffer-ancestor &optional startup-hooks quit-hooks) "Run Emerge on two buffers, giving another buffer as the ancestor." (interactive "bBuffer A to merge: \nbBuffer B to merge: \nbAncestor buffer: ") (let ((emerge-file-A (emerge-make-temp-file "A")) (emerge-file-B (emerge-make-temp-file "B")) (emerge-file-ancestor (emerge-make-temp-file "anc"))) (emerge-eval-in-buffer buffer-A (write-region (point-min) (point-max) emerge-file-A nil 'no-message)) (emerge-eval-in-buffer buffer-B (write-region (point-min) (point-max) emerge-file-B nil 'no-message)) (emerge-eval-in-buffer buffer-ancestor (write-region (point-min) (point-max) emerge-file-ancestor nil 'no-message)) (emerge-setup-with-ancestor (get-buffer buffer-A) emerge-file-A (get-buffer buffer-B) emerge-file-B (get-buffer buffer-ancestor) emerge-file-ancestor (cons (` (lambda () (delete-file (, emerge-file-A)) (delete-file (, emerge-file-B)) (delete-file (, emerge-file-ancestor)))) startup-hooks) quit-hooks nil))) ;;; Functions to start Emerge from the command line ;;;###autoload (defun emerge-files-command () (let ((file-a (nth 0 command-line-args-left)) (file-b (nth 1 command-line-args-left)) (file-out (nth 2 command-line-args-left))) (setq command-line-args-left (nthcdr 3 command-line-args-left)) (emerge-files-internal file-a file-b nil (list (` (lambda () (emerge-command-exit (, file-out)))))))) ;;;###autoload (defun emerge-files-with-ancestor-command () (let (file-a file-b file-anc file-out) ;; check for a -a flag, for filemerge compatibility (if (string= (car command-line-args-left) "-a") ;; arguments are "-a ancestor file-a file-b file-out" (progn (setq file-a (nth 2 command-line-args-left)) (setq file-b (nth 3 command-line-args-left)) (setq file-anc (nth 1 command-line-args-left)) (setq file-out (nth 4 command-line-args-left)) (setq command-line-args-left (nthcdr 5 command-line-args-left))) ;; arguments are "file-a file-b ancestor file-out" (setq file-a (nth 0 command-line-args-left)) (setq file-b (nth 1 command-line-args-left)) (setq file-anc (nth 2 command-line-args-left)) (setq file-out (nth 3 command-line-args-left)) (setq command-line-args-left (nthcdr 4 command-line-args-left))) (emerge-files-with-ancestor-internal file-a file-b file-anc nil (list (` (lambda () (emerge-command-exit (, file-out)))))))) (defun emerge-command-exit (file-out) (emerge-write-and-delete file-out) (kill-emacs (if emerge-prefix-argument 1 0))) ;;; Functions to start Emerge via remote request ;;;###autoload (defun emerge-files-remote (file-a file-b file-out) (setq emerge-file-out file-out) (emerge-files-internal file-a file-b nil (list (` (lambda () (emerge-remote-exit (, file-out) '(, emerge-exit-func))))) file-out) (throw 'client-wait nil)) ;;;###autoload (defun emerge-files-with-ancestor-remote (file-a file-b file-anc file-out) (setq emerge-file-out file-out) (emerge-files-with-ancestor-internal file-a file-b file-anc nil (list (` (lambda () (emerge-remote-exit (, file-out) '(, emerge-exit-func))))) file-out) (throw 'client-wait nil)) (defun emerge-remote-exit (file-out emerge-exit-func) (emerge-write-and-delete file-out) (kill-buffer emerge-merge-buffer) (funcall emerge-exit-func (if emerge-prefix-argument 1 0))) ;;; Functions to start Emerge on RCS versions ;;;###autoload (defun emerge-revisions (arg file revision-A revision-B &optional startup-hooks quit-hooks) "Emerge two RCS revisions of a file." (interactive (list current-prefix-arg (read-file-name "File to merge: " nil nil 'confirm) (read-string "Revision A to merge: " emerge-last-revision-A) (read-string "Revision B to merge: " emerge-last-revision-B))) (setq emerge-last-revision-A revision-A emerge-last-revision-B revision-B) (emerge-revisions-internal file revision-A revision-B startup-hooks (if arg (cons (` (lambda () (shell-command (, (format "%s %s" emerge-rcs-ci-program file))))) quit-hooks) quit-hooks))) ;;;###autoload (defun emerge-revisions-with-ancestor (arg file revision-A revision-B ancestor &optional startup-hooks quit-hooks) "Emerge two RCS revisions of a file, with another revision as ancestor." (interactive (list current-prefix-arg (read-file-name "File to merge: " nil nil 'confirm) (read-string "Revision A to merge: " emerge-last-revision-A) (read-string "Revision B to merge: " emerge-last-revision-B) (read-string "Ancestor: " emerge-last-revision-ancestor))) (setq emerge-last-revision-A revision-A emerge-last-revision-B revision-B emerge-last-revision-ancestor ancestor) (emerge-revision-with-ancestor-internal file revision-A revision-B ancestor startup-hooks (if arg (let ((cmd )) (cons (` (lambda () (shell-command (, (format "%s %s" emerge-rcs-ci-program file))))) quit-hooks)) quit-hooks))) (defun emerge-revisions-internal (file revision-A revision-B &optional startup-hooks quit-hooks output-file) (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A))) (buffer-B (get-buffer-create (format "%s,%s" file revision-B))) (emerge-file-A (emerge-make-temp-file "A")) (emerge-file-B (emerge-make-temp-file "B"))) ;; Get the revisions into buffers (emerge-eval-in-buffer buffer-A (erase-buffer) (shell-command (format "%s -q -p%s %s" emerge-rcs-co-program revision-A file) t) (write-region (point-min) (point-max) emerge-file-A nil 'no-message) (set-buffer-modified-p nil)) (emerge-eval-in-buffer buffer-B (erase-buffer) (shell-command (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file) t) (write-region (point-min) (point-max) emerge-file-B nil 'no-message) (set-buffer-modified-p nil)) ;; Do the merge (emerge-setup buffer-A emerge-file-A buffer-B emerge-file-B (cons (` (lambda () (delete-file (, emerge-file-A)) (delete-file (, emerge-file-B)))) startup-hooks) (cons (` (lambda () (emerge-files-exit (, file)))) quit-hooks) nil))) (defun emerge-revision-with-ancestor-internal (file revision-A revision-B ancestor &optional startup-hooks quit-hooks output-file) (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A))) (buffer-B (get-buffer-create (format "%s,%s" file revision-B))) (buffer-ancestor (get-buffer-create (format "%s,%s" file ancestor))) (emerge-file-A (emerge-make-temp-file "A")) (emerge-file-B (emerge-make-temp-file "B")) (emerge-ancestor (emerge-make-temp-file "ancestor"))) ;; Get the revisions into buffers (emerge-eval-in-buffer buffer-A (erase-buffer) (shell-command (format "%s -q -p%s %s" emerge-rcs-co-program revision-A file) t) (write-region (point-min) (point-max) emerge-file-A nil 'no-message) (set-buffer-modified-p nil)) (emerge-eval-in-buffer buffer-B (erase-buffer) (shell-command (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file) t) (write-region (point-min) (point-max) emerge-file-B nil 'no-message) (set-buffer-modified-p nil)) (emerge-eval-in-buffer buffer-ancestor (erase-buffer) (shell-command (format "%s -q -p%s %s" emerge-rcs-co-program ancestor file) t) (write-region (point-min) (point-max) emerge-ancestor nil 'no-message) (set-buffer-modified-p nil)) ;; Do the merge (emerge-setup-with-ancestor buffer-A emerge-file-A buffer-B emerge-file-B buffer-ancestor emerge-ancestor (cons (` (lambda () (delete-file (, emerge-file-A)) (delete-file (, emerge-file-B)) (delete-file (, emerge-ancestor)))) startup-hooks) (cons (` (lambda () (emerge-files-exit (, file)))) quit-hooks) output-file))) ;;; Function to start Emerge based on a line in a file (defun emerge-execute-line () "Run Emerge using files named in current text line. Looks in that line for whitespace-separated entries of these forms: a=file1 b=file2 ancestor=file3 output=file4 to specify the files to use in Emerge. In addition, if only one of `a=file' or `b=file' is present, and `output=file' is present: If `emerge-execute-line-deletions' is non-nil and `ancestor=file' is present, it is assumed that the file in question has been deleted, and it is not copied to the output file. Otherwise, the A or B file present is copied to the output file." (interactive) (let (file-A file-B file-ancestor file-out (case-fold-search t)) ;; Stop if at end of buffer (even though we might be in a line, if ;; the line does not end with newline) (if (eobp) (error "At end of buffer")) ;; Go to the beginning of the line (beginning-of-line) ;; Skip any initial whitespace (if (looking-at "[ \t]*") (goto-char (match-end 0))) ;; Process the entire line (while (not (eolp)) ;; Get the next entry (if (looking-at "\\([a-z]+\\)=\\([^ \t\n]+\\)[ \t]*") ;; Break apart the tab (before =) and the filename (after =) (let ((tag (downcase (buffer-substring (match-beginning 1) (match-end 1)))) (file (buffer-substring (match-beginning 2) (match-end 2)))) ;; Move point after the entry (goto-char (match-end 0)) ;; Store the filename in the right variable (cond ((string-equal tag "a") (if file-A (error "This line has two `A' entries")) (setq file-A file)) ((string-equal tag "b") (if file-B (error "This line has two `B' entries")) (setq file-B file)) ((or (string-equal tag "anc") (string-equal tag "ancestor")) (if file-ancestor (error "This line has two `ancestor' entries")) (setq file-ancestor file)) ((or (string-equal tag "out") (string-equal tag "output")) (if file-out (error "This line has two `output' entries")) (setq file-out file)) (t (error "Unrecognized entry")))) ;; If the match on the entry pattern failed (error "Unparsable entry"))) ;; Make sure that file-A and file-B are present (if (not (or (and file-A file-B) file-out)) (error "Must have both `A' and `B' entries")) (if (not (or file-A file-B)) (error "Must have `A' or `B' entry")) ;; Go to the beginning of the next line, so next execution will use ;; next line in buffer. (beginning-of-line 2) ;; Execute the correct command (cond ;; Merge of two files with ancestor ((and file-A file-B file-ancestor) (message "Merging %s and %s..." file-A file-B) (emerge-files-with-ancestor (not (not file-out)) file-A file-B file-ancestor file-out nil ;; When done, return to this buffer. (list (` (lambda () (switch-to-buffer (, (current-buffer))) (message "Merge done.")))))) ;; Merge of two files without ancestor ((and file-A file-B) (message "Merging %s and %s..." file-A file-B) (emerge-files (not (not file-out)) file-A file-B file-out nil ;; When done, return to this buffer. (list (` (lambda () (switch-to-buffer (, (current-buffer))) (message "Merge done.")))))) ;; There is an output file (or there would have been an error above), ;; but only one input file. ;; The file appears to have been deleted in one version; do nothing. ((and file-ancestor emerge-execute-line-deletions) (message "No action.")) ;; The file should be copied from the version that contains it (t (let ((input-file (or file-A file-B))) (message "Copying...") (copy-file input-file file-out) (message "%s copied to %s." input-file file-out)))))) ;;; Sample function for creating information for emerge-execute-line (defvar emerge-merge-directories-filename-regexp "[^.]" "Regexp describing files to be processed by `emerge-merge-directories'.") ;;;###autoload (defun emerge-merge-directories (a-dir b-dir ancestor-dir output-dir) (interactive (list (read-file-name "A directory: " nil nil 'confirm) (read-file-name "B directory: " nil nil 'confirm) (read-file-name "Ancestor directory (null for none): " nil nil 'confirm) (read-file-name "Output directory (null for none): " nil nil 'confirm))) ;; Check that we're not on a line (if (not (and (bolp) (eolp))) (error "There is text on this line")) ;; Turn null strings into nil to indicate directories not used. (if (and ancestor-dir (string-equal ancestor-dir "")) (setq ancestor-dir nil)) (if (and output-dir (string-equal output-dir "")) (setq output-dir nil)) ;; Canonicalize the directory names (setq a-dir (expand-file-name a-dir)) (if (not (string-equal (substring a-dir -1) "/")) (setq a-dir (concat a-dir "/"))) (setq b-dir (expand-file-name b-dir)) (if (not (string-equal (substring b-dir -1) "/")) (setq b-dir (concat b-dir "/"))) (if ancestor-dir (progn (setq ancestor-dir (expand-file-name ancestor-dir)) (if (not (string-equal (substring ancestor-dir -1) "/")) (setq ancestor-dir (concat ancestor-dir "/"))))) (if output-dir (progn (setq output-dir (expand-file-name output-dir)) (if (not (string-equal (substring output-dir -1) "/")) (setq output-dir (concat output-dir "/"))))) ;; Set the mark to where we start (push-mark) ;; Find out what files are in the directories. (let* ((a-dir-files (directory-files a-dir nil emerge-merge-directories-filename-regexp)) (b-dir-files (directory-files b-dir nil emerge-merge-directories-filename-regexp)) (ancestor-dir-files (and ancestor-dir (directory-files ancestor-dir nil emerge-merge-directories-filename-regexp))) (all-files (sort (nconc (copy-sequence a-dir-files) (copy-sequence b-dir-files) (copy-sequence ancestor-dir-files)) (function string-lessp)))) ;; Remove duplicates from all-files. (let ((p all-files)) (while p (if (and (cdr p) (string-equal (car p) (car (cdr p)))) (setcdr p (cdr (cdr p))) (setq p (cdr p))))) ;; Generate the control lines for the various files. (while all-files (let ((f (car all-files))) (setq all-files (cdr all-files)) (if (and a-dir-files (string-equal (car a-dir-files) f)) (progn (insert "A=" a-dir f "\t") (setq a-dir-files (cdr a-dir-files)))) (if (and b-dir-files (string-equal (car b-dir-files) f)) (progn (insert "B=" b-dir f "\t") (setq b-dir-files (cdr b-dir-files)))) (if (and ancestor-dir-files (string-equal (car ancestor-dir-files) f)) (progn (insert "ancestor=" ancestor-dir f "\t") (setq ancestor-dir-files (cdr ancestor-dir-files)))) (if output-dir (insert "output=" output-dir f "\t")) (backward-delete-char 1) (insert "\n"))))) ;;; Common setup routines ;; Set up the window configuration. If POS is given, set the points to ;; the beginnings of the buffers. (defun emerge-setup-windows (buffer-A buffer-B merge-buffer &optional pos) ;; Make sure we are not in the minibuffer window when we try to delete ;; all other windows. (if (eq (selected-window) (minibuffer-window)) (other-window 1)) (delete-other-windows) (switch-to-buffer merge-buffer) (emerge-refresh-mode-line) (split-window-vertically) (split-window-horizontally) (switch-to-buffer buffer-A) (if pos (goto-char (point-min))) (other-window 1) (switch-to-buffer buffer-B) (if pos (goto-char (point-min))) (other-window 1) (if pos (goto-char (point-min))) ;; If diff/diff3 reports errors, display them rather than the merge buffer. (if (/= 0 (emerge-eval-in-buffer emerge-diff-error-buffer (buffer-size))) (progn (ding) (message "Errors found in diff/diff3 output. Merge buffer is %s." (buffer-name emerge-merge-buffer)) (switch-to-buffer emerge-diff-error-buffer)))) ;; Set up the keymap in the merge buffer (defun emerge-set-keys () ;; Set up fixed keymaps if necessary (if (not emerge-basic-keymap) (emerge-setup-fixed-keymaps)) ;; Save the old local map (setq emerge-old-keymap (current-local-map)) ;; Construct the edit keymap (setq emerge-edit-keymap (if emerge-old-keymap (copy-keymap emerge-old-keymap) (make-sparse-keymap))) ;; Install the Emerge commands (emerge-force-define-key emerge-edit-keymap emerge-command-prefix 'emerge-basic-keymap) (define-key emerge-edit-keymap [menu-bar] (make-sparse-keymap)) ;; Create the additional menu bar items. (define-key emerge-edit-keymap [menu-bar options] (cons "Options" emerge-options-menu)) (define-key emerge-edit-keymap [menu-bar merge] (cons "Merge" emerge-merge-menu)) (define-key emerge-edit-keymap [menu-bar move] (cons "Move" emerge-move-menu)) ;; Suppress write-file and save-buffer (substitute-key-definition 'write-file 'emerge-query-write-file emerge-edit-keymap) (substitute-key-definition 'save-buffer 'emerge-query-save-buffer emerge-edit-keymap) (substitute-key-definition 'write-file 'emerge-query-write-file emerge-edit-keymap (current-global-map)) (substitute-key-definition 'save-buffer 'emerge-query-save-buffer emerge-edit-keymap (current-global-map)) (use-local-map emerge-fast-keymap) (setq emerge-edit-mode nil) (setq emerge-fast-mode t)) (defun emerge-remember-buffer-characteristics () "Record certain properties of the buffers being merged. Must be called in the merge buffer. Remembers read-only, modified, auto-save, and saves them in buffer local variables. Sets the buffers read-only and turns off `auto-save-mode'. These characteristics are restored by `emerge-restore-buffer-characteristics'." ;; force auto-save, because we will turn off auto-saving in buffers for the ;; duration (do-auto-save) ;; remember and alter buffer characteristics (setq emerge-A-buffer-values (emerge-eval-in-buffer emerge-A-buffer (prog1 (emerge-save-variables emerge-saved-variables) (emerge-restore-variables emerge-saved-variables emerge-merging-values)))) (setq emerge-B-buffer-values (emerge-eval-in-buffer emerge-B-buffer (prog1 (emerge-save-variables emerge-saved-variables) (emerge-restore-variables emerge-saved-variables emerge-merging-values))))) (defun emerge-restore-buffer-characteristics () "Restores characteristics saved by `emerge-remember-buffer-characteristics'." (let ((A-values emerge-A-buffer-values) (B-values emerge-B-buffer-values)) (emerge-eval-in-buffer emerge-A-buffer (emerge-restore-variables emerge-saved-variables A-values)) (emerge-eval-in-buffer emerge-B-buffer (emerge-restore-variables emerge-saved-variables B-values)))) ;; Move to line DESIRED-LINE assuming we are at line CURRENT-LINE. ;; Return DESIRED-LINE. (defun emerge-goto-line (desired-line current-line) (forward-line (- desired-line current-line)) desired-line) (defun emerge-convert-diffs-to-markers (A-buffer B-buffer merge-buffer lineno-list) (let* (marker-list (A-point-min (emerge-eval-in-buffer A-buffer (point-min))) (offset (1- A-point-min)) (B-point-min (emerge-eval-in-buffer B-buffer (point-min))) ;; Record current line number in each buffer ;; so we don't have to count from the beginning. (a-line 1) (b-line 1)) (emerge-eval-in-buffer A-buffer (goto-char (point-min))) (emerge-eval-in-buffer B-buffer (goto-char (point-min))) (while lineno-list (let* ((list-element (car lineno-list)) a-begin-marker a-end-marker b-begin-marker b-end-marker merge-begin-marker merge-end-marker (a-begin (aref list-element 0)) (a-end (aref list-element 1)) (b-begin (aref list-element 2)) (b-end (aref list-element 3)) (state (aref list-element 4))) ;; place markers at the appropriate places in the buffers (emerge-eval-in-buffer A-buffer (setq a-line (emerge-goto-line a-begin a-line)) (setq a-begin-marker (point-marker)) (setq a-line (emerge-goto-line a-end a-line)) (setq a-end-marker (point-marker))) (emerge-eval-in-buffer B-buffer (setq b-line (emerge-goto-line b-begin b-line)) (setq b-begin-marker (point-marker)) (setq b-line (emerge-goto-line b-end b-line)) (setq b-end-marker (point-marker))) (setq merge-begin-marker (set-marker (make-marker) (- (marker-position a-begin-marker) offset) merge-buffer)) (setq merge-end-marker (set-marker (make-marker) (- (marker-position a-end-marker) offset) merge-buffer)) ;; record all the markers for this difference (setq marker-list (cons (vector a-begin-marker a-end-marker b-begin-marker b-end-marker merge-begin-marker merge-end-marker state) marker-list))) (setq lineno-list (cdr lineno-list))) ;; convert the list of difference information into a vector for ;; fast access (setq emerge-difference-list (apply 'vector (nreverse marker-list))))) ;; If we have an ancestor, select all B variants that we prefer (defun emerge-select-prefer-Bs () (let ((n 0)) (while (< n emerge-number-of-differences) (if (eq (aref (aref emerge-difference-list n) 6) 'prefer-B) (progn (emerge-unselect-and-select-difference n t) (emerge-select-B) (aset (aref emerge-difference-list n) 6 'prefer-B))) (setq n (1+ n)))) (emerge-unselect-and-select-difference -1)) ;; Process the local-variables list at the end of the merged file, if ;; requested. (defun emerge-handle-local-variables () (if emerge-process-local-variables (condition-case err (hack-local-variables) (error (message "Local-variables error in merge buffer: %s" (prin1-to-string err)))))) ;;; Common exit routines (defun emerge-write-and-delete (file-out) ;; clear screen format (delete-other-windows) ;; delete A, B, and ancestor buffers, if they haven't been changed (if (not (buffer-modified-p emerge-A-buffer)) (kill-buffer emerge-A-buffer)) (if (not (buffer-modified-p emerge-B-buffer)) (kill-buffer emerge-B-buffer)) (if (and emerge-ancestor-buffer (not (buffer-modified-p emerge-ancestor-buffer))) (kill-buffer emerge-ancestor-buffer)) ;; Write merge buffer to file (and file-out (write-file file-out))) ;;; Commands (defun emerge-recenter (&optional arg) "Bring the highlighted region of all three merge buffers into view. This brings the buffers into view if they are in windows. With an argument, reestablish the default three-window display." (interactive "P") ;; If there is an argument, rebuild the window structure (if arg (emerge-setup-windows emerge-A-buffer emerge-B-buffer emerge-merge-buffer)) ;; Redisplay whatever buffers are showing, if there is a selected difference (if (and (>= emerge-current-difference 0) (< emerge-current-difference emerge-number-of-differences)) (let* ((merge-buffer emerge-merge-buffer) (buffer-A emerge-A-buffer) (buffer-B emerge-B-buffer) (window-A (get-buffer-window buffer-A 'visible)) (window-B (get-buffer-window buffer-B 'visible)) (merge-window (get-buffer-window merge-buffer)) (diff-vector (aref emerge-difference-list emerge-current-difference))) (if window-A (progn (select-window window-A) (emerge-position-region (- (aref diff-vector 0) (1- emerge-before-flag-length)) (+ (aref diff-vector 1) (1- emerge-after-flag-length)) (1+ (aref diff-vector 0))))) (if window-B (progn (select-window window-B) (emerge-position-region (- (aref diff-vector 2) (1- emerge-before-flag-length)) (+ (aref diff-vector 3) (1- emerge-after-flag-length)) (1+ (aref diff-vector 2))))) (if merge-window (progn (select-window merge-window) (emerge-position-region (- (aref diff-vector 4) (1- emerge-before-flag-length)) (+ (aref diff-vector 5) (1- emerge-after-flag-length)) (1+ (aref diff-vector 4)))))))) ;;; Window scrolling operations ;; These operations are designed to scroll all three windows the same amount, ;; so as to keep the text in them aligned. ;; Perform some operation on all three windows (if they are showing). ;; Catches all errors on the operation in the A and B windows, but not ;; in the merge window. Usually, errors come from scrolling off the ;; beginning or end of the buffer, and this gives a nice error message: ;; End of buffer is reported in the merge buffer, but if the scroll was ;; possible in the A or B windows, it is performed there before the error ;; is reported. (defun emerge-operate-on-windows (operation arg) (let* ((merge-buffer emerge-merge-buffer) (buffer-A emerge-A-buffer) (buffer-B emerge-B-buffer) (window-A (get-buffer-window buffer-A 'visible)) (window-B (get-buffer-window buffer-B 'visible)) (merge-window (get-buffer-window merge-buffer))) (if window-A (progn (select-window window-A) (condition-case nil (funcall operation arg) (error)))) (if window-B (progn (select-window window-B) (condition-case nil (funcall operation arg) (error)))) (if merge-window (progn (select-window merge-window) (funcall operation arg))))) (defun emerge-scroll-up (&optional arg) "Scroll up all three merge buffers, if they are in windows. With argument N, scroll N lines; otherwise scroll by nearly the height of the merge window. `C-u -' alone as argument scrolls half the height of the merge window." (interactive "P") (emerge-operate-on-windows 'scroll-up ;; calculate argument to scroll-up ;; if there is an explicit argument (if (and arg (not (equal arg '-))) ;; use it (prefix-numeric-value arg) ;; if not, see if we can determine a default amount (the window height) (let ((merge-window (get-buffer-window emerge-merge-buffer))) (if (null merge-window) ;; no window, use nil nil (let ((default-amount (- (window-height merge-window) 1 next-screen-context-lines))) ;; the window was found (if arg ;; C-u as argument means half of default amount (/ default-amount 2) ;; no argument means default amount default-amount))))))) (defun emerge-scroll-down (&optional arg) "Scroll down all three merge buffers, if they are in windows. With argument N, scroll N lines; otherwise scroll by nearly the height of the merge window. `C-u -' alone as argument scrolls half the height of the merge window." (interactive "P") (emerge-operate-on-windows 'scroll-down ;; calculate argument to scroll-down ;; if there is an explicit argument (if (and arg (not (equal arg '-))) ;; use it (prefix-numeric-value arg) ;; if not, see if we can determine a default amount (the window height) (let ((merge-window (get-buffer-window emerge-merge-buffer))) (if (null merge-window) ;; no window, use nil nil (let ((default-amount (- (window-height merge-window) 1 next-screen-context-lines))) ;; the window was found (if arg ;; C-u as argument means half of default amount (/ default-amount 2) ;; no argument means default amount default-amount))))))) (defun emerge-scroll-left (&optional arg) "Scroll left all three merge buffers, if they are in windows. If an argument is given, that is how many columns are scrolled, else nearly the width of the A and B windows. `C-u -' alone as argument scrolls half the width of the A and B windows." (interactive "P") (emerge-operate-on-windows 'scroll-left ;; calculate argument to scroll-left ;; if there is an explicit argument (if (and arg (not (equal arg '-))) ;; use it (prefix-numeric-value arg) ;; if not, see if we can determine a default amount ;; (half the window width) (let ((merge-window (get-buffer-window emerge-merge-buffer))) (if (null merge-window) ;; no window, use nil nil (let ((default-amount (- (/ (window-width merge-window) 2) 3))) ;; the window was found (if arg ;; C-u as argument means half of default amount (/ default-amount 2) ;; no argument means default amount default-amount))))))) (defun emerge-scroll-right (&optional arg) "Scroll right all three merge buffers, if they are in windows. If an argument is given, that is how many columns are scrolled, else nearly the width of the A and B windows. `C-u -' alone as argument scrolls half the width of the A and B windows." (interactive "P") (emerge-operate-on-windows 'scroll-right ;; calculate argument to scroll-right ;; if there is an explicit argument (if (and arg (not (equal arg '-))) ;; use it (prefix-numeric-value arg) ;; if not, see if we can determine a default amount ;; (half the window width) (let ((merge-window (get-buffer-window emerge-merge-buffer))) (if (null merge-window) ;; no window, use nil nil (let ((default-amount (- (/ (window-width merge-window) 2) 3))) ;; the window was found (if arg ;; C-u as argument means half of default amount (/ default-amount 2) ;; no argument means default amount default-amount))))))) (defun emerge-scroll-reset () "Reset horizontal scrolling in Emerge. This resets the horizontal scrolling of all three merge buffers to the left margin, if they are in windows." (interactive) (emerge-operate-on-windows (function (lambda (x) (set-window-hscroll (selected-window) 0))) nil)) ;; Attempt to show the region nicely. ;; If there are min-lines lines above and below the region, then don't do ;; anything. ;; If not, recenter the region to make it so. ;; If that isn't possible, remove context lines balancedly from top and botton ;; so the entire region shows. ;; If that isn't possible, show the top of the region. ;; BEG must be at the beginning of a line. (defun emerge-position-region (beg end pos) ;; First test whether the entire region is visible with ;; emerge-min-visible-lines above and below it (if (not (and (<= (progn (move-to-window-line emerge-min-visible-lines) (point)) beg) (<= end (progn (move-to-window-line (- (1+ emerge-min-visible-lines))) (point))))) ;; We failed that test, see if it fits at all ;; Meanwhile positioning it correctly in case it doesn't fit (progn (set-window-start (selected-window) beg) (if (pos-visible-in-window-p end) ;; Determine the number of lines that the region occupies (let ((lines 0)) (while (> end (progn (move-to-window-line lines) (point))) (setq lines (1+ lines))) ;; And position the beginning on the right line (goto-char beg) (recenter (/ (1+ (- (1- (window-height (selected-window))) lines)) 2)))))) (goto-char pos)) (defun emerge-next-difference () "Advance to the next difference." (interactive) (if (< emerge-current-difference emerge-number-of-differences) (let ((n (1+ emerge-current-difference))) (while (and emerge-skip-prefers (< n emerge-number-of-differences) (memq (aref (aref emerge-difference-list n) 6) '(prefer-A prefer-B))) (setq n (1+ n))) (let ((buffer-read-only nil)) (emerge-unselect-and-select-difference n))) (error "At end"))) (defun emerge-previous-difference () "Go to the previous difference." (interactive) (if (> emerge-current-difference -1) (let ((n (1- emerge-current-difference))) (while (and emerge-skip-prefers (> n -1) (memq (aref (aref emerge-difference-list n) 6) '(prefer-A prefer-B))) (setq n (1- n))) (let ((buffer-read-only nil)) (emerge-unselect-and-select-difference n))) (error "At beginning"))) (defun emerge-jump-to-difference (difference-number) "Go to the N-th difference." (interactive "p") (let ((buffer-read-only nil)) (setq difference-number (1- difference-number)) (if (and (>= difference-number -1) (< difference-number (1+ emerge-number-of-differences))) (emerge-unselect-and-select-difference difference-number) (error "Bad difference number")))) (defun emerge-abort () "Abort the Emerge session." (interactive) (emerge-quit t)) (defun emerge-quit (arg) "Finish the Emerge session and exit Emerge. Prefix argument means to abort rather than successfully finish. The difference depends on how the merge was started, but usually means to not write over one of the original files, or to signal to some process which invoked Emerge a failure code. Unselects the selected difference, if any, restores the read-only and modified flags of the merged file buffers, restores the local keymap of the merge buffer, and sets off various emerge flags. Using Emerge commands in this buffer after this will cause serious problems." (interactive "P") (if (prog1 (y-or-n-p (if (not arg) "Do you really want to successfully finish this merge? " "Do you really want to abort this merge? ")) (message "")) (emerge-really-quit arg))) ;; Perform the quit operations. (defun emerge-really-quit (arg) (setq buffer-read-only nil) (emerge-unselect-and-select-difference -1) (emerge-restore-buffer-characteristics) ;; null out the difference markers so they don't slow down future editing ;; operations (mapcar (function (lambda (d) (set-marker (aref d 0) nil) (set-marker (aref d 1) nil) (set-marker (aref d 2) nil) (set-marker (aref d 3) nil) (set-marker (aref d 4) nil) (set-marker (aref d 5) nil))) emerge-difference-list) ;; allow them to be garbage collected (setq emerge-difference-list nil) ;; restore the local map (use-local-map emerge-old-keymap) ;; turn off all the emerge modes (setq emerge-mode nil) (setq emerge-fast-mode nil) (setq emerge-edit-mode nil) (setq emerge-auto-advance nil) (setq emerge-skip-prefers nil) ;; restore mode line (kill-local-variable 'mode-line-buffer-identification) (let ((emerge-prefix-argument arg)) (run-hooks 'emerge-quit-hook))) (defun emerge-select-A (&optional force) "Select the A variant of this difference. Refuses to function if this difference has been edited, i.e., if it is neither the A nor the B variant. A prefix argument forces the variant to be selected even if the difference has been edited." (interactive "P") (let ((operate (function (lambda () (emerge-select-A-edit merge-begin merge-end A-begin A-end) (if emerge-auto-advance (emerge-next-difference))))) (operate-no-change (function (lambda () (if emerge-auto-advance (emerge-next-difference)))))) (emerge-select-version force operate-no-change operate operate))) ;; Actually select the A variant (defun emerge-select-A-edit (merge-begin merge-end A-begin A-end) (emerge-eval-in-buffer emerge-merge-buffer (delete-region merge-begin merge-end) (goto-char merge-begin) (insert-buffer-substring emerge-A-buffer A-begin A-end) (goto-char merge-begin) (aset diff-vector 6 'A) (emerge-refresh-mode-line))) (defun emerge-select-B (&optional force) "Select the B variant of this difference. Refuses to function if this difference has been edited, i.e., if it is neither the A nor the B variant. A prefix argument forces the variant to be selected even if the difference has been edited." (interactive "P") (let ((operate (function (lambda () (emerge-select-B-edit merge-begin merge-end B-begin B-end) (if emerge-auto-advance (emerge-next-difference))))) (operate-no-change (function (lambda () (if emerge-auto-advance (emerge-next-difference)))))) (emerge-select-version force operate operate-no-change operate))) ;; Actually select the B variant (defun emerge-select-B-edit (merge-begin merge-end B-begin B-end) (emerge-eval-in-buffer emerge-merge-buffer (delete-region merge-begin merge-end) (goto-char merge-begin) (insert-buffer-substring emerge-B-buffer B-begin B-end) (goto-char merge-begin) (aset diff-vector 6 'B) (emerge-refresh-mode-line))) (defun emerge-default-A () "Make the A variant the default from here down. This selects the A variant for all differences from here down in the buffer which are still defaulted, i.e., which the user has not selected and for which there is no preference." (interactive) (let ((buffer-read-only nil)) (let ((selected-difference emerge-current-difference) (n (max emerge-current-difference 0))) (while (< n emerge-number-of-differences) (let ((diff-vector (aref emerge-difference-list n))) (if (eq (aref diff-vector 6) 'default-B) (progn (emerge-unselect-and-select-difference n t) (emerge-select-A) (aset diff-vector 6 'default-A)))) (setq n (1+ n)) (if (zerop (% n 10)) (message "Setting default to A...%d" n))) (emerge-unselect-and-select-difference selected-difference))) (message "Default choice is now A")) (defun emerge-default-B () "Make the B variant the default from here down. This selects the B variant for all differences from here down in the buffer which are still defaulted, i.e., which the user has not selected and for which there is no preference." (interactive) (let ((buffer-read-only nil)) (let ((selected-difference emerge-current-difference) (n (max emerge-current-difference 0))) (while (< n emerge-number-of-differences) (let ((diff-vector (aref emerge-difference-list n))) (if (eq (aref diff-vector 6) 'default-A) (progn (emerge-unselect-and-select-difference n t) (emerge-select-B) (aset diff-vector 6 'default-B)))) (setq n (1+ n)) (if (zerop (% n 10)) (message "Setting default to B...%d" n))) (emerge-unselect-and-select-difference selected-difference))) (message "Default choice is now B")) (defun emerge-fast-mode () "Set fast mode, for Emerge. In this mode ordinary Emacs commands are disabled, and Emerge commands need not be prefixed with \\\\[emerge-basic-keymap]." (interactive) (setq buffer-read-only t) (use-local-map emerge-fast-keymap) (setq emerge-mode t) (setq emerge-fast-mode t) (setq emerge-edit-mode nil) (message "Fast mode set") (force-mode-line-update)) (defun emerge-edit-mode () "Set edit mode, for Emerge. In this mode ordinary Emacs commands are available, and Emerge commands must be prefixed with \\\\[emerge-basic-keymap]." (interactive) (setq buffer-read-only nil) (use-local-map emerge-edit-keymap) (setq emerge-mode t) (setq emerge-fast-mode nil) (setq emerge-edit-mode t) (message "Edit mode set") (force-mode-line-update)) (defun emerge-auto-advance (arg) "Toggle Auto-Advance mode, for Emerge. This mode causes `emerge-select-A' and `emerge-select-B' to automatically advance to the next difference. With a positive argument, turn on Auto-Advance mode. With a negative argument, turn off Auto-Advance mode." (interactive "P") (setq emerge-auto-advance (if (null arg) (not emerge-auto-advance) (> (prefix-numeric-value arg) 0))) (message (if emerge-auto-advance "Auto-advance set" "Auto-advance cleared")) (force-mode-line-update)) (defun emerge-skip-prefers (arg) "Toggle Skip-Prefers mode, for Emerge. This mode causes `emerge-next-difference' and `emerge-previous-difference' to automatically skip over differences for which there is a preference. With a positive argument, turn on Skip-Prefers mode. With a negative argument, turn off Skip-Prefers mode." (interactive "P") (setq emerge-skip-prefers (if (null arg) (not emerge-skip-prefers) (> (prefix-numeric-value arg) 0))) (message (if emerge-skip-prefers "Skip-prefers set" "Skip-prefers cleared")) (force-mode-line-update)) (defun emerge-copy-as-kill-A () "Put the A variant of this difference in the kill ring." (interactive) (emerge-validate-difference) (let* ((diff-vector (aref emerge-difference-list emerge-current-difference)) (A-begin (1+ (aref diff-vector 0))) (A-end (1- (aref diff-vector 1))) ;; so further kills don't append this-command) (save-excursion (set-buffer emerge-A-buffer) (copy-region-as-kill A-begin A-end)))) (defun emerge-copy-as-kill-B () "Put the B variant of this difference in the kill ring." (interactive) (emerge-validate-difference) (let* ((diff-vector (aref emerge-difference-list emerge-current-difference)) (B-begin (1+ (aref diff-vector 2))) (B-end (1- (aref diff-vector 3))) ;; so further kills don't append this-command) (save-excursion (set-buffer emerge-B-buffer) (copy-region-as-kill B-begin B-end)))) (defun emerge-insert-A (arg) "Insert the A variant of this difference at the point. Leaves point after text, mark before. With prefix argument, puts point before, mark after." (interactive "P") (emerge-validate-difference) (let* ((diff-vector (aref emerge-difference-list emerge-current-difference)) (A-begin (1+ (aref diff-vector 0))) (A-end (1- (aref diff-vector 1))) (opoint (point)) (buffer-read-only nil)) (insert-buffer-substring emerge-A-buffer A-begin A-end) (if (not arg) (set-mark opoint) (set-mark (point)) (goto-char opoint)))) (defun emerge-insert-B (arg) "Insert the B variant of this difference at the point. Leaves point after text, mark before. With prefix argument, puts point before, mark after." (interactive "P") (emerge-validate-difference) (let* ((diff-vector (aref emerge-difference-list emerge-current-difference)) (B-begin (1+ (aref diff-vector 2))) (B-end (1- (aref diff-vector 3))) (opoint (point)) (buffer-read-only nil)) (insert-buffer-substring emerge-B-buffer B-begin B-end) (if (not arg) (set-mark opoint) (set-mark (point)) (goto-char opoint)))) (defun emerge-mark-difference (arg) "Leaves the point before this difference and the mark after it. With prefix argument, puts mark before, point after." (interactive "P") (emerge-validate-difference) (let* ((diff-vector (aref emerge-difference-list emerge-current-difference)) (merge-begin (1+ (aref diff-vector 4))) (merge-end (1- (aref diff-vector 5)))) (if (not arg) (progn (goto-char merge-begin) (set-mark merge-end)) (goto-char merge-end) (set-mark merge-begin)))) (defun emerge-file-names () "Show the names of the buffers or files being operated on by Emerge. Use C-u l to reset the windows afterward." (interactive) (delete-other-windows) (let ((temp-buffer-show-function (function (lambda (buf) (split-window-vertically) (switch-to-buffer buf) (other-window 1))))) (with-output-to-temp-buffer "*Help*" (emerge-eval-in-buffer emerge-A-buffer (if buffer-file-name (progn (princ "File A is: ") (princ buffer-file-name)) (progn (princ "Buffer A is: ") (princ (buffer-name)))) (princ "\n")) (emerge-eval-in-buffer emerge-B-buffer (if buffer-file-name (progn (princ "File B is: ") (princ buffer-file-name)) (progn (princ "Buffer B is: ") (princ (buffer-name)))) (princ "\n")) (if emerge-ancestor-buffer (emerge-eval-in-buffer emerge-ancestor-buffer (if buffer-file-name (progn (princ "Ancestor file is: ") (princ buffer-file-name)) (progn (princ "Ancestor buffer is: ") (princ (buffer-name)))) (princ "\n"))) (princ emerge-output-description) (save-excursion (set-buffer standard-output) (help-mode))))) (defun emerge-join-differences (arg) "Join the selected difference with the following one. With a prefix argument, join with the preceding one." (interactive "P") (let ((n emerge-current-difference)) ;; adjust n to be first difference to join (if arg (setq n (1- n))) ;; n and n+1 are the differences to join ;; check that they are both differences (if (or (< n 0) (>= n (1- emerge-number-of-differences))) (error "Incorrect differences to join")) ;; remove the flags (emerge-unselect-difference emerge-current-difference) ;; decrement total number of differences (setq emerge-number-of-differences (1- emerge-number-of-differences)) ;; build new differences vector (let ((i 0) (new-differences (make-vector emerge-number-of-differences nil))) (while (< i emerge-number-of-differences) (aset new-differences i (cond ((< i n) (aref emerge-difference-list i)) ((> i n) (aref emerge-difference-list (1+ i))) (t (let ((prev (aref emerge-difference-list i)) (next (aref emerge-difference-list (1+ i)))) (vector (aref prev 0) (aref next 1) (aref prev 2) (aref next 3) (aref prev 4) (aref next 5) (let ((ps (aref prev 6)) (ns (aref next 6))) (cond ((eq ps ns) ps) ((and (or (eq ps 'B) (eq ps 'prefer-B)) (or (eq ns 'B) (eq ns 'prefer-B))) 'B) (t 'A)))))))) (setq i (1+ i))) (setq emerge-difference-list new-differences)) ;; set the current difference correctly (setq emerge-current-difference n) ;; fix the mode line (emerge-refresh-mode-line) ;; reinsert the flags (emerge-select-difference emerge-current-difference) (emerge-recenter))) (defun emerge-split-difference () "Split the current difference where the points are in the three windows." (interactive) (let ((n emerge-current-difference)) ;; check that this is a valid difference (emerge-validate-difference) ;; get the point values and old difference (let ((A-point (emerge-eval-in-buffer emerge-A-buffer (point-marker))) (B-point (emerge-eval-in-buffer emerge-B-buffer (point-marker))) (merge-point (point-marker)) (old-diff (aref emerge-difference-list n))) ;; check location of the points, give error if they aren't in the ;; differences (if (or (< A-point (aref old-diff 0)) (> A-point (aref old-diff 1))) (error "Point outside of difference in A buffer")) (if (or (< B-point (aref old-diff 2)) (> B-point (aref old-diff 3))) (error "Point outside of difference in B buffer")) (if (or (< merge-point (aref old-diff 4)) (> merge-point (aref old-diff 5))) (error "Point outside of difference in merge buffer")) ;; remove the flags (emerge-unselect-difference emerge-current-difference) ;; increment total number of differences (setq emerge-number-of-differences (1+ emerge-number-of-differences)) ;; build new differences vector (let ((i 0) (new-differences (make-vector emerge-number-of-differences nil))) (while (< i emerge-number-of-differences) (aset new-differences i (cond ((< i n) (aref emerge-difference-list i)) ((> i (1+ n)) (aref emerge-difference-list (1- i))) ((= i n) (vector (aref old-diff 0) A-point (aref old-diff 2) B-point (aref old-diff 4) merge-point (aref old-diff 6))) (t (vector (copy-marker A-point) (aref old-diff 1) (copy-marker B-point) (aref old-diff 3) (copy-marker merge-point) (aref old-diff 5) (aref old-diff 6))))) (setq i (1+ i))) (setq emerge-difference-list new-differences)) ;; set the current difference correctly (setq emerge-current-difference n) ;; fix the mode line (emerge-refresh-mode-line) ;; reinsert the flags (emerge-select-difference emerge-current-difference) (emerge-recenter)))) (defun emerge-trim-difference () "Trim lines off top and bottom of difference that are the same. If lines are the same in both the A and the B versions, strip them off. \(This can happen when the A and B versions have common lines that the ancestor version does not share.)" (interactive) ;; make sure we are in a real difference (emerge-validate-difference) ;; remove the flags (emerge-unselect-difference emerge-current-difference) (let* ((diff (aref emerge-difference-list emerge-current-difference)) (top-a (marker-position (aref diff 0))) (bottom-a (marker-position (aref diff 1))) (top-b (marker-position (aref diff 2))) (bottom-b (marker-position (aref diff 3))) (top-m (marker-position (aref diff 4))) (bottom-m (marker-position (aref diff 5))) size success sa sb sm) ;; move down the tops of the difference regions as much as possible ;; Try advancing comparing 1000 chars at a time. ;; When that fails, go 500 chars at a time, and so on. (setq size 1000) (while (> size 0) (setq success t) (while success (setq size (min size (- bottom-a top-a) (- bottom-b top-b) (- bottom-m top-m))) (setq sa (emerge-eval-in-buffer emerge-A-buffer (buffer-substring top-a (+ size top-a)))) (setq sb (emerge-eval-in-buffer emerge-B-buffer (buffer-substring top-b (+ size top-b)))) (setq sm (buffer-substring top-m (+ size top-m))) (setq success (and (> size 0) (equal sa sb) (equal sb sm))) (if success (setq top-a (+ top-a size) top-b (+ top-b size) top-m (+ top-m size)))) (setq size (/ size 2))) ;; move up the bottoms of the difference regions as much as possible ;; Try advancing comparing 1000 chars at a time. ;; When that fails, go 500 chars at a time, and so on. (setq size 1000) (while (> size 0) (setq success t) (while success (setq size (min size (- bottom-a top-a) (- bottom-b top-b) (- bottom-m top-m))) (setq sa (emerge-eval-in-buffer emerge-A-buffer (buffer-substring (- bottom-a size) bottom-a))) (setq sb (emerge-eval-in-buffer emerge-B-buffer (buffer-substring (- bottom-b size) bottom-b))) (setq sm (buffer-substring (- bottom-m size) bottom-m)) (setq success (and (> size 0) (equal sa sb) (equal sb sm))) (if success (setq bottom-a (- bottom-a size) bottom-b (- bottom-b size) bottom-m (- bottom-m size)))) (setq size (/ size 2))) ;; {top,bottom}-{a,b,m} are now set at the new beginnings and ends ;; of the difference regions. Move them to the beginning of lines, as ;; appropriate. (emerge-eval-in-buffer emerge-A-buffer (goto-char top-a) (beginning-of-line) (aset diff 0 (point-marker)) (goto-char bottom-a) (beginning-of-line 2) (aset diff 1 (point-marker))) (emerge-eval-in-buffer emerge-B-buffer (goto-char top-b) (beginning-of-line) (aset diff 2 (point-marker)) (goto-char bottom-b) (beginning-of-line 2) (aset diff 3 (point-marker))) (goto-char top-m) (beginning-of-line) (aset diff 4 (point-marker)) (goto-char bottom-m) (beginning-of-line 2) (aset diff 5 (point-marker)) ;; put the flags back in, recenter the display (emerge-select-difference emerge-current-difference) (emerge-recenter))) (defun emerge-find-difference (arg) "Find the difference containing the current position of the point. If there is no containing difference and the prefix argument is positive, it finds the nearest following difference. A negative prefix argument finds the nearest previous difference." (interactive "P") (cond ((eq (current-buffer) emerge-A-buffer) (emerge-find-difference-A arg)) ((eq (current-buffer) emerge-B-buffer) (emerge-find-difference-B arg)) (t (emerge-find-difference-merge arg)))) (defun emerge-find-difference-merge (arg) "Find the difference containing point, in the merge buffer. If there is no containing difference and the prefix argument is positive, it finds the nearest following difference. A negative prefix argument finds the nearest previous difference." (interactive "P") ;; search for the point in the merge buffer, using the markers ;; for the beginning and end of the differences in the merge buffer (emerge-find-difference1 arg (point) 4 5)) (defun emerge-find-difference-A (arg) "Find the difference containing point, in the A buffer. This command must be executed in the merge buffer. If there is no containing difference and the prefix argument is positive, it finds the nearest following difference. A negative prefix argument finds the nearest previous difference." (interactive "P") ;; search for the point in the A buffer, using the markers ;; for the beginning and end of the differences in the A buffer (emerge-find-difference1 arg (emerge-eval-in-buffer emerge-A-buffer (point)) 0 1)) (defun emerge-find-difference-B (arg) "Find the difference containing point, in the B buffer. This command must be executed in the merge buffer. If there is no containing difference and the prefix argument is positive, it finds the nearest following difference. A negative prefix argument finds the nearest previous difference." (interactive "P") ;; search for the point in the B buffer, using the markers ;; for the beginning and end of the differences in the B buffer (emerge-find-difference1 arg (emerge-eval-in-buffer emerge-B-buffer (point)) 2 3)) (defun emerge-find-difference1 (arg location begin end) (let* ((index ;; find first difference containing or after the current position (catch 'search (let ((n 0)) (while (< n emerge-number-of-differences) (let ((diff-vector (aref emerge-difference-list n))) (if (<= location (marker-position (aref diff-vector end))) (throw 'search n))) (setq n (1+ n)))) emerge-number-of-differences)) (contains ;; whether the found difference contains the current position (and (< index emerge-number-of-differences) (<= (marker-position (aref (aref emerge-difference-list index) begin)) location))) (arg-value ;; numeric value of prefix argument (prefix-numeric-value arg))) (emerge-unselect-and-select-difference (cond ;; if the point is in a difference, select it (contains index) ;; if the arg is nil and the point is not in a difference, error ((null arg) (error "No difference contains point")) ;; if the arg is positive, select the following difference ((> arg-value 0) (if (< index emerge-number-of-differences) index (error "No difference contains or follows point"))) ;; if the arg is negative, select the preceding difference (t (if (> index 0) (1- index) (error "No difference contains or precedes point"))))))) (defun emerge-line-numbers () "Display the current line numbers. This function displays the line numbers of the points in the A, B, and merge buffers." (interactive) (let* ((valid-diff (and (>= emerge-current-difference 0) (< emerge-current-difference emerge-number-of-differences))) (diff (and valid-diff (aref emerge-difference-list emerge-current-difference))) (merge-line (emerge-line-number-in-buf 4 5)) (A-line (emerge-eval-in-buffer emerge-A-buffer (emerge-line-number-in-buf 0 1))) (B-line (emerge-eval-in-buffer emerge-B-buffer (emerge-line-number-in-buf 2 3)))) (message "At lines: merge = %d, A = %d, B = %d" merge-line A-line B-line))) (defun emerge-line-number-in-buf (begin-marker end-marker) (let (temp) (setq temp (save-excursion (beginning-of-line) (1+ (count-lines 1 (point))))) (if valid-diff (progn (if (> (point) (aref diff begin-marker)) (setq temp (- temp emerge-before-flag-lines))) (if (> (point) (aref diff end-marker)) (setq temp (- temp emerge-after-flag-lines))))) temp)) (defun emerge-set-combine-template (string &optional localize) "Set `emerge-combine-versions-template' to STRING. This value controls how `emerge-combine-versions' combines the two versions. With prefix argument, `emerge-combine-versions-template' is made local to this merge buffer. Localization is permanent for any particular merge buffer." (interactive "s\nP") (if localize (make-local-variable 'emerge-combine-versions-template)) (setq emerge-combine-versions-template string) (message (if (assq 'emerge-combine-versions-template (buffer-local-variables)) "emerge-set-combine-versions-template set locally" "emerge-set-combine-versions-template set"))) (defun emerge-set-combine-versions-template (start end &optional localize) "Copy region into `emerge-combine-versions-template'. This controls how `emerge-combine-versions' will combine the two versions. With prefix argument, `emerge-combine-versions-template' is made local to this merge buffer. Localization is permanent for any particular merge buffer." (interactive "r\nP") (if localize (make-local-variable 'emerge-combine-versions-template)) (setq emerge-combine-versions-template (buffer-substring start end)) (message (if (assq 'emerge-combine-versions-template (buffer-local-variables)) "emerge-set-combine-versions-template set locally." "emerge-set-combine-versions-template set."))) (defun emerge-combine-versions (&optional force) "Combine versions using the template in `emerge-combine-versions-template'. Refuses to function if this difference has been edited, i.e., if it is neither the A nor the B variant. An argument forces the variant to be selected even if the difference has been edited." (interactive "P") (emerge-combine-versions-internal emerge-combine-versions-template force)) (defun emerge-combine-versions-register (char &optional force) "Combine the two versions using the template in register REG. See documentation of the variable `emerge-combine-versions-template' for how the template is interpreted. Refuses to function if this difference has been edited, i.e., if it is neither the A nor the B variant. An argument forces the variant to be selected even if the difference has been edited." (interactive "cRegister containing template: \nP") (let ((template (get-register char))) (if (not (stringp template)) (error "Register does not contain text")) (emerge-combine-versions-internal template force))) (defun emerge-combine-versions-internal (template force) (let ((operate (function (lambda () (emerge-combine-versions-edit merge-begin merge-end A-begin A-end B-begin B-end) (if emerge-auto-advance (emerge-next-difference)))))) (emerge-select-version force operate operate operate))) (defun emerge-combine-versions-edit (merge-begin merge-end A-begin A-end B-begin B-end) (emerge-eval-in-buffer emerge-merge-buffer (delete-region merge-begin merge-end) (goto-char merge-begin) (let ((i 0)) (while (< i (length template)) (let ((c (aref template i))) (if (= c ?%) (progn (setq i (1+ i)) (setq c (condition-case nil (aref template i) (error ?%))) (cond ((= c ?a) (insert-buffer-substring emerge-A-buffer A-begin A-end)) ((= c ?b) (insert-buffer-substring emerge-B-buffer B-begin B-end)) ((= c ?%) (insert ?%)) (t (insert c)))) (insert c))) (setq i (1+ i)))) (goto-char merge-begin) (aset diff-vector 6 'combined) (emerge-refresh-mode-line))) (defun emerge-set-merge-mode (mode) "Set the major mode in a merge buffer. Overrides any change that the mode might make to the mode line or local keymap. Leaves merge in fast mode." (interactive (list (intern (completing-read "New major mode for merge buffer: " obarray 'commandp t nil)))) (funcall mode) (emerge-refresh-mode-line) (if emerge-fast-mode (emerge-fast-mode) (emerge-edit-mode))) (defun emerge-one-line-window () (interactive) (let ((window-min-height 1)) (shrink-window (- (window-height) 2)))) ;;; Support routines ;; Select a difference by placing the visual flags around the appropriate ;; group of lines in the A, B, and merge buffers (defun emerge-select-difference (n) (let ((emerge-globalized-difference-list emerge-difference-list) (emerge-globalized-number-of-differences emerge-number-of-differences)) (emerge-place-flags-in-buffer emerge-A-buffer n 0 1) (emerge-place-flags-in-buffer emerge-B-buffer n 2 3) (emerge-place-flags-in-buffer nil n 4 5)) (run-hooks 'emerge-select-hook)) (defun emerge-place-flags-in-buffer (buffer difference before-index after-index) (if buffer (emerge-eval-in-buffer buffer (emerge-place-flags-in-buffer1 difference before-index after-index)) (emerge-place-flags-in-buffer1 difference before-index after-index))) (defun emerge-place-flags-in-buffer1 (difference before-index after-index) (let ((buffer-read-only nil)) ;; insert the flag before the difference (let ((before (aref (aref emerge-globalized-difference-list difference) before-index)) here) (goto-char before) ;; insert the flag itself (insert-before-markers emerge-before-flag) (setq here (point)) ;; Put the marker(s) referring to this position 1 character before the ;; end of the flag, so it won't be damaged by the user. ;; This gets a bit tricky, as there could be a number of markers ;; that have to be moved. (set-marker before (1- before)) (let ((n (1- difference)) after-marker before-marker diff-list) (while (and (>= n 0) (progn (setq diff-list (aref emerge-globalized-difference-list n) after-marker (aref diff-list after-index)) (= after-marker here))) (set-marker after-marker (1- after-marker)) (setq before-marker (aref diff-list before-index)) (if (= before-marker here) (setq before-marker (1- before-marker))) (setq n (1- n))))) ;; insert the flag after the difference (let* ((after (aref (aref emerge-globalized-difference-list difference) after-index)) (here (marker-position after))) (goto-char here) ;; insert the flag itself (insert emerge-after-flag) ;; Put the marker(s) referring to this position 1 character after the ;; beginning of the flag, so it won't be damaged by the user. ;; This gets a bit tricky, as there could be a number of markers ;; that have to be moved. (set-marker after (1+ after)) (let ((n (1+ difference)) before-marker after-marker diff-list) (while (and (< n emerge-globalized-number-of-differences) (progn (setq diff-list (aref emerge-globalized-difference-list n) before-marker (aref diff-list before-index)) (= before-marker here))) (set-marker before-marker (1+ before-marker)) (setq after-marker (aref diff-list after-index)) (if (= after-marker here) (setq after-marker (1+ after-marker))) (setq n (1+ n))))))) ;; Unselect a difference by removing the visual flags in the buffers. (defun emerge-unselect-difference (n) (let ((diff-vector (aref emerge-difference-list n))) (emerge-remove-flags-in-buffer emerge-A-buffer (aref diff-vector 0) (aref diff-vector 1)) (emerge-remove-flags-in-buffer emerge-B-buffer (aref diff-vector 2) (aref diff-vector 3)) (emerge-remove-flags-in-buffer emerge-merge-buffer (aref diff-vector 4) (aref diff-vector 5))) (run-hooks 'emerge-unselect-hook)) (defun emerge-remove-flags-in-buffer (buffer before after) (emerge-eval-in-buffer buffer (let ((buffer-read-only nil)) ;; remove the flags, if they're there (goto-char (- before (1- emerge-before-flag-length))) (if (looking-at emerge-before-flag-match) (delete-char emerge-before-flag-length) ;; the flag isn't there (ding) (message "Trouble removing flag")) (goto-char (1- after)) (if (looking-at emerge-after-flag-match) (delete-char emerge-after-flag-length) ;; the flag isn't there (ding) (message "Trouble removing flag"))))) ;; Select a difference, removing any flags that exist now. (defun emerge-unselect-and-select-difference (n &optional suppress-display) (if (and (>= emerge-current-difference 0) (< emerge-current-difference emerge-number-of-differences)) (emerge-unselect-difference emerge-current-difference)) (if (and (>= n 0) (< n emerge-number-of-differences)) (progn (emerge-select-difference n) (let* ((diff-vector (aref emerge-difference-list n)) (selection-type (aref diff-vector 6))) (if (eq selection-type 'default-A) (aset diff-vector 6 'A) (if (eq selection-type 'default-B) (aset diff-vector 6 'B)))))) (setq emerge-current-difference n) (if (not suppress-display) (progn (emerge-recenter) (emerge-refresh-mode-line)))) ;; Perform tests to see whether user should be allowed to select a version ;; of this difference: ;; a valid difference has been selected; and ;; the difference text in the merge buffer is: ;; the A version (execute a-version), or ;; the B version (execute b-version), or ;; empty (execute neither-version), or ;; argument FORCE is true (execute neither-version) ;; Otherwise, signal an error. (defun emerge-select-version (force a-version b-version neither-version) (emerge-validate-difference) (let ((buffer-read-only nil)) (let* ((diff-vector (aref emerge-difference-list emerge-current-difference)) (A-begin (1+ (aref diff-vector 0))) (A-end (1- (aref diff-vector 1))) (B-begin (1+ (aref diff-vector 2))) (B-end (1- (aref diff-vector 3))) (merge-begin (1+ (aref diff-vector 4))) (merge-end (1- (aref diff-vector 5)))) (if (emerge-compare-buffers emerge-A-buffer A-begin A-end emerge-merge-buffer merge-begin merge-end) (funcall a-version) (if (emerge-compare-buffers emerge-B-buffer B-begin B-end emerge-merge-buffer merge-begin merge-end) (funcall b-version) (if (or force (= merge-begin merge-end)) (funcall neither-version) (error "This difference region has been edited"))))))) ;; Read a file name, handling all of the various defaulting rules. (defun emerge-read-file-name (prompt alternative-default-dir default-file A-file must-match) ;; `prompt' should not have trailing ": ", so that it can be modified ;; according to context. ;; If alternative-default-dir is non-nil, it should be used as the default ;; directory instead if default-directory, if emerge-default-last-directories ;; is set. ;; If default-file is set, it should be used as the default value. ;; If A-file is set, and its directory is different from ;; alternative-default-dir, and if emerge-default-last-directories is set, ;; the default file should be the last part of A-file in the default ;; directory. (Overriding default-file.) (cond ;; If this is not the A-file argument (shown by non-nil A-file), and ;; if emerge-default-last-directories is set, and ;; the default directory exists but is not the same as the directory of the ;; A-file, ;; then make the default file have the same name as the A-file, but in ;; the default directory. ((and emerge-default-last-directories A-file alternative-default-dir (not (string-equal alternative-default-dir (file-name-directory A-file)))) (read-file-name (format "%s (default %s): " prompt (file-name-nondirectory A-file)) alternative-default-dir (concat alternative-default-dir (file-name-nondirectory A-file)) (and must-match 'confirm))) ;; If there is a default file, use it. (default-file (read-file-name (format "%s (default %s): " prompt default-file) ;; If emerge-default-last-directories is set, use the ;; directory from the same argument of the last call of ;; Emerge as the default for this argument. (and emerge-default-last-directories alternative-default-dir) default-file (and must-match 'confirm))) (t (read-file-name (concat prompt ": ") ;; If emerge-default-last-directories is set, use the ;; directory from the same argument of the last call of ;; Emerge as the default for this argument. (and emerge-default-last-directories alternative-default-dir) nil (and must-match 'confirm))))) ;; Revise the mode line to display which difference we have selected (defun emerge-refresh-mode-line () (setq mode-line-buffer-identification (list (format "Emerge: %%b diff %d of %d%s" (1+ emerge-current-difference) emerge-number-of-differences (if (and (>= emerge-current-difference 0) (< emerge-current-difference emerge-number-of-differences)) (cdr (assq (aref (aref emerge-difference-list emerge-current-difference) 6) '((A . " - A") (B . " - B") (prefer-A . " - A*") (prefer-B . " - B*") (combined . " - comb")))) "")))) (force-mode-line-update)) ;; compare two regions in two buffers for containing the same text (defun emerge-compare-buffers (buffer-x x-begin x-end buffer-y y-begin y-end) ;; first check that the two regions are the same length (if (not (and (= (- x-end x-begin) (- y-end y-begin)))) nil (catch 'exit (while (< x-begin x-end) ;; bite off and compare no more than 1000 characters at a time (let* ((compare-length (min (- x-end x-begin) 1000)) (x-string (emerge-eval-in-buffer buffer-x (buffer-substring x-begin (+ x-begin compare-length)))) (y-string (emerge-eval-in-buffer buffer-y (buffer-substring y-begin (+ y-begin compare-length))))) (if (not (string-equal x-string y-string)) (throw 'exit nil) (setq x-begin (+ x-begin compare-length)) (setq y-begin (+ y-begin compare-length))))) t))) ;; Construct a unique buffer name. ;; The first one tried is prefixsuffix, then prefix<2>suffix, ;; prefix<3>suffix, etc. (defun emerge-unique-buffer-name (prefix suffix) (if (null (get-buffer (concat prefix suffix))) (concat prefix suffix) (let ((n 2)) (while (get-buffer (format "%s<%d>%s" prefix n suffix)) (setq n (1+ n))) (format "%s<%d>%s" prefix n suffix)))) ;; Verify that we have a difference selected. (defun emerge-validate-difference () (if (not (and (>= emerge-current-difference 0) (< emerge-current-difference emerge-number-of-differences))) (error "No difference selected"))) ;;; Functions for saving and restoring a batch of variables ;; These functions save (get the values of) and restore (set the values of) ;; a list of variables. The argument is a list of symbols (the names of ;; the variables). A list element can also be a list of two functions, ;; the first of which (when called with no arguments) gets the value, and ;; the second (when called with a value as an argment) sets the value. ;; A "function" is anything that funcall can handle as an argument. (defun emerge-save-variables (vars) (mapcar (function (lambda (v) (if (symbolp v) (symbol-value v) (funcall (car v))))) vars)) (defun emerge-restore-variables (vars values) (while vars (let ((var (car vars)) (value (car values))) (if (symbolp var) (set var value) (funcall (car (cdr var)) value))) (setq vars (cdr vars)) (setq values (cdr values)))) ;; Make a temporary file that only we have access to. ;; PREFIX is appended to emerge-temp-file-prefix to make the filename prefix. (defun emerge-make-temp-file (prefix) (let ((f (make-temp-name (concat emerge-temp-file-prefix prefix)))) ;; create the file (write-region (point-min) (point-min) f nil 'no-message) (set-file-modes f emerge-temp-file-mode) f)) ;;; Functions that query the user before he can write out the current buffer. (defun emerge-query-write-file () "Ask the user whether to write out an incomplete merge. If answer is yes, call `write-file' to do so. See `emerge-query-and-call' for details of the querying process." (interactive) (emerge-query-and-call 'write-file)) (defun emerge-query-save-buffer () "Ask the user whether to save an incomplete merge. If answer is yes, call `save-buffer' to do so. See `emerge-query-and-call' for details of the querying process." (interactive) (emerge-query-and-call 'save-buffer)) (defun emerge-query-and-call (command) "Ask the user whether to save or write out the incomplete merge. If answer is yes, call COMMAND interactively. During the call, the flags around the current difference are removed." (if (yes-or-no-p "Do you really write to write out this unfinished merge? ") ;; He really wants to do it -- unselect the difference for the duration (progn (if (and (>= emerge-current-difference 0) (< emerge-current-difference emerge-number-of-differences)) (emerge-unselect-difference emerge-current-difference)) ;; call-interactively takes the value of current-prefix-arg as the ;; prefix argument value to be passed to the command. Thus, we have ;; to do nothing special to make sure the prefix argument is ;; transmitted to the command. (call-interactively command) (if (and (>= emerge-current-difference 0) (< emerge-current-difference emerge-number-of-differences)) (progn (emerge-select-difference emerge-current-difference) (emerge-recenter)))) ;; He's being smart and not doing it (message "Not written"))) ;; Make sure the current buffer (for a file) has the same contents as the ;; file on disk, and attempt to remedy the situation if not. ;; Signal an error if we can't make them the same, or the user doesn't want ;; to do what is necessary to make them the same. (defun emerge-verify-file-buffer () ;; First check if the file has been modified since the buffer visited it. (if (verify-visited-file-modtime (current-buffer)) (if (buffer-modified-p) ;; If buffer is not obsolete and is modified, offer to save (if (yes-or-no-p (format "Save file %s? " buffer-file-name)) (save-buffer) (error "Buffer out of sync for file %s" buffer-file-name)) ;; If buffer is not obsolete and is not modified, do nothing nil) (if (buffer-modified-p) ;; If buffer is obsolete and is modified, give error (error "Buffer out of sync for file %s" buffer-file-name) ;; If buffer is obsolete and is not modified, offer to revert (if (yes-or-no-p (format "Revert file %s? " buffer-file-name)) (revert-buffer t t) (error "Buffer out of sync for file %s" buffer-file-name))))) ;; Utilities that might have value outside of Emerge. ;; Set up the mode in the current buffer to duplicate the mode in another ;; buffer. (defun emerge-copy-modes (buffer) ;; Set the major mode (funcall (emerge-eval-in-buffer buffer major-mode))) ;; Define a key, even if a prefix of it is defined (defun emerge-force-define-key (keymap key definition) "Like `define-key', but forcibly creates prefix characters as needed. If some prefix of KEY has a non-prefix definition, it is redefined." ;; Find out if a prefix of key is defined (let ((v (lookup-key keymap key))) ;; If so, undefine it (if (integerp v) (define-key keymap (substring key 0 v) nil))) ;; Now define the key (define-key keymap key definition)) ;;;;; Improvements to describe-mode, so that it describes minor modes as well ;;;;; as the major mode ;;(defun describe-mode (&optional minor) ;; "Display documentation of current major mode. ;;If optional arg MINOR is non-nil (or prefix argument is given if interactive), ;;display documentation of active minor modes as well. ;;For this to work correctly for a minor mode, the mode's indicator variable ;;\(listed in `minor-mode-alist') must also be a function whose documentation ;;describes the minor mode." ;; (interactive) ;; (with-output-to-temp-buffer "*Help*" ;; (princ mode-name) ;; (princ " Mode:\n") ;; (princ (documentation major-mode)) ;; (let ((minor-modes minor-mode-alist) ;; (locals (buffer-local-variables))) ;; (while minor-modes ;; (let* ((minor-mode (car (car minor-modes))) ;; (indicator (car (cdr (car minor-modes)))) ;; (local-binding (assq minor-mode locals))) ;; ;; Document a minor mode if it is listed in minor-mode-alist, ;; ;; bound locally in this buffer, non-nil, and has a function ;; ;; definition. ;; (if (and local-binding ;; (cdr local-binding) ;; (fboundp minor-mode)) ;; (progn ;; (princ (format "\n\n\n%s minor mode (indicator%s):\n" ;; minor-mode indicator)) ;; (princ (documentation minor-mode))))) ;; (setq minor-modes (cdr minor-modes)))) ;; (save-excursion ;; (set-buffer standard-output) ;; (help-mode)) ;; (print-help-return-message))) ;; This goes with the redefinition of describe-mode. ;;;; Adjust things so that keyboard macro definitions are documented correctly. ;;(fset 'defining-kbd-macro (symbol-function 'start-kbd-macro)) ;; substitute-key-definition should work now. ;;;; Function to shadow a definition in a keymap with definitions in another. ;;(defun emerge-shadow-key-definition (olddef newdef keymap shadowmap) ;; "Shadow OLDDEF with NEWDEF for any keys in KEYMAP with entries in SHADOWMAP. ;;In other words, SHADOWMAP will now shadow all definitions of OLDDEF in KEYMAP ;;with NEWDEF. Does not affect keys that are already defined in SHADOWMAP, ;;including those whose definition is OLDDEF." ;; ;; loop through all keymaps accessible from keymap ;; (let ((maps (accessible-keymaps keymap))) ;; (while maps ;; (let ((prefix (car (car maps))) ;; (map (cdr (car maps)))) ;; ;; examine a keymap ;; (if (arrayp map) ;; ;; array keymap ;; (let ((len (length map)) ;; (i 0)) ;; (while (< i len) ;; (if (eq (aref map i) olddef) ;; ;; set the shadowing definition ;; (let ((key (concat prefix (char-to-string i)))) ;; (emerge-define-key-if-possible shadowmap key newdef))) ;; (setq i (1+ i)))) ;; ;; sparse keymap ;; (while map ;; (if (eq (cdr-safe (car-safe map)) olddef) ;; ;; set the shadowing definition ;; (let ((key ;; (concat prefix (char-to-string (car (car map)))))) ;; (emerge-define-key-if-possible shadowmap key newdef))) ;; (setq map (cdr map))))) ;; (setq maps (cdr maps))))) ;; Define a key if it (or a prefix) is not already defined in the map. (defun emerge-define-key-if-possible (keymap key definition) ;; look up the present definition of the key (let ((present (lookup-key keymap key))) (if (integerp present) ;; if it is "too long", look up the valid prefix (if (not (lookup-key keymap (substring key 0 present))) ;; if the prefix isn't defined, define it (define-key keymap key definition)) ;; if there is no present definition, define it (if (not present) (define-key keymap key definition))))) ;; Ordinary substitute-key-definition should do this now. ;;(defun emerge-recursively-substitute-key-definition (olddef newdef keymap) ;; "Like `substitute-key-definition', but act recursively on subkeymaps. ;;Make sure that subordinate keymaps aren't shared with other keymaps! ;;\(`copy-keymap' will suffice.)" ;; ;; Loop through all keymaps accessible from keymap ;; (let ((maps (accessible-keymaps keymap))) ;; (while maps ;; ;; Substitute in this keymap ;; (substitute-key-definition olddef newdef (cdr (car maps))) ;; (setq maps (cdr maps))))) ;; Show the name of the file in the buffer. (defun emerge-show-file-name () "Displays the name of the file loaded into the current buffer. If the name won't fit on one line, the minibuffer is expanded to hold it, and the command waits for a keystroke from the user. If the keystroke is SPC, it is ignored; if it is anything else, it is processed as a command." (interactive) (let ((name (buffer-file-name))) (or name (setq name "Buffer has no file name.")) (save-window-excursion (select-window (minibuffer-window)) (erase-buffer) (insert name) (if (not (pos-visible-in-window-p)) (let ((echo-keystrokes 0)) (while (and (not (pos-visible-in-window-p)) (> (1- (screen-height)) (window-height))) (enlarge-window 1)) (let ((c (read-event))) (if (not (eq c 32)) (setq unread-command-events (list c))))))))) ;; Improved auto-save file names. ;; This function fixes many problems with the standard auto-save file names: ;; Auto-save files for non-file buffers get put in the default directory ;; for the buffer, whether that makes sense or not. ;; Auto-save files for file buffers get put in the directory of the file, ;; regardless of whether we can write into it or not. ;; Auto-save files for non-file buffers don't use the process id, so if a ;; user runs more than on Emacs, they can make auto-save files that overwrite ;; each other. ;; To use this function, do: ;; (fset 'make-auto-save-file-name ;; (symbol-function 'emerge-make-auto-save-file-name)) (defun emerge-make-auto-save-file-name () "Return file name to use for auto-saves of current buffer. Does not consider `auto-save-visited-file-name'; that is checked before calling this function. You can redefine this for customization. See also `auto-save-file-name-p'." (if buffer-file-name ;; if buffer has a file, try the format /## (let ((f (concat (file-name-directory buffer-file-name) "#" (file-name-nondirectory buffer-file-name) "#"))) (if (file-writable-p f) ;; the file is writable, so use it f ;; the file isn't writable, so use the format ;; ~/#&&# (concat (getenv "HOME") "/#&" (file-name-nondirectory buffer-file-name) "&" (emerge-hash-string-into-string (file-name-directory buffer-file-name)) "#"))) ;; if buffer has no file, use the format ~/#%%# (expand-file-name (concat (getenv "HOME") "/#%" ;; quote / into \! and \ into \\ (emerge-unslashify-name (buffer-name)) "%" (make-temp-name "") "#")))) ;; Hash a string into five characters more-or-less suitable for use in a file ;; name. (Allowed characters are ! through ~, except /.) (defun emerge-hash-string-into-string (s) (let ((bins (vector 0 0 0 0 0)) (i 0)) (while (< i (length s)) (aset bins (% i 5) (% (+ (* (aref bins (% i 5)) 35) (aref s i)) 65536)) (setq i (1+ i))) (mapconcat (function (lambda (b) (setq b (+ (% b 93) ?!)) (if (>= b ?/) (setq b (1+ b))) (char-to-string b))) bins ""))) ;; Quote any /s in a string by replacing them with \!. ;; Also, replace any \s by \\, to make it one-to-one. (defun emerge-unslashify-name (s) (let ((limit 0)) (while (string-match "[/\\]" s limit) (setq s (concat (substring s 0 (match-beginning 0)) (if (string= (substring s (match-beginning 0) (match-end 0)) "/") "\\!" "\\\\") (substring s (match-end 0)))) (setq limit (1+ (match-end 0))))) s) ;; Metacharacters that have to be protected from the shell when executing ;; a diff/diff3 command. (defvar emerge-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]" "Characters that must be quoted with \\ when used in a shell command line. More precisely, a [...] regexp to match any one such character.") ;; Quote metacharacters (using \) when executing a diff/diff3 command. (defun emerge-protect-metachars (s) (let ((limit 0)) (while (string-match emerge-metachars s limit) (setq s (concat (substring s 0 (match-beginning 0)) "\\" (substring s (match-beginning 0)))) (setq limit (1+ (match-end 0))))) s) (provide 'emerge) ;;; emerge.el ends here emacs-19.30/lisp/enriched.el100444 12120 1 41220 6050711773 14177 0ustar rmsdaemon;;; enriched.el --- read and save files in text/enriched format ;; Copyright (c) 1994, 1995 Free Software Foundation, Inc. ;; Author: Boris Goldowsky ;; Keywords: wp, 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: ;; ;; This file implements reading, editing, and saving files with ;; text-properties such as faces, levels of indentation, and true line breaks ;; distinguished from newlines just used to fit text into the window. ;; ;; The file format used is the MIME text/enriched format, which is a ;; standard format defined in internet RFC 1563. All standard annotations are ;; supported except for and , which are currently not ;; possible to display. ;; ;; A separate file, enriched.doc, contains further documentation and other ;; important information about this code. It also serves as an example file ;; in text/enriched format. It should be in the etc directory of your emacs ;; distribution. (provide 'enriched) (if window-system (require 'facemenu)) ;;; ;;; Variables controlling the display ;;; (defvar enriched-verbose t "*If non-nil, give status messages when reading and writing files.") (defvar enriched-default-right-margin 10 "*Default amount of space to leave on the right edge of the screen. This can be increased inside text by changing the 'right-margin text property. Measured in character widths. If the screen is narrower than this, it is assumed to be 0.") (defvar enriched-fill-after-visiting t "If t, fills paragraphs when reading in enriched documents. If nil, only fills when you explicitly request it. If the value is 'ask, then it will query you whether to fill. Filling is never done if the current text-width is the same as the value stored in the file.") ;;; ;;; Set up faces & display table ;;; ;; A slight cheat - all emacs's faces are fixed-width. ;; The idea is just to pick one that looks different from the default. (if (internal-find-face 'fixed) nil (make-face 'fixed) (if window-system (set-face-font 'fixed (car (or (x-list-fonts "*fixed-medium*" 'default (selected-frame)) (x-list-fonts "*fixed*" 'default (selected-frame))))))) (if (internal-find-face 'excerpt) nil (make-face 'excerpt) (if window-system (make-face-italic 'excerpt nil t))) (defconst enriched-display-table (or (copy-sequence standard-display-table) (make-display-table))) (aset enriched-display-table ?\f (make-vector (1- (frame-width)) ?-)) (defconst enriched-par-props '(left-margin right-margin justification) "Text-properties that usually apply to whole paragraphs. These are set front-sticky everywhere except at hard newlines.") ;;; ;;; Variables controlling the file format ;;; (bidirectional) (defconst enriched-initial-annotation (lambda () (format "Content-Type: text/enriched\nText-Width: %d\n\n" (enriched-text-width))) "What to insert at the start of a text/enriched file. If this is a string, it is inserted. If it is a list, it should be a lambda expression, which is evaluated to get the string to insert.") (defconst enriched-annotation-format "<%s%s>" "General format of enriched-text annotations.") (defconst enriched-annotation-regexp "<\\(/\\)?\\([-A-za-z0-9]+\\)>" "Regular expression matching enriched-text annotations.") (defconst enriched-translations '((face (bold-italic "bold" "italic") (bold "bold") (italic "italic") (underline "underline") (fixed "fixed") (excerpt "excerpt") (default ) (nil enriched-encode-other-face)) (left-margin (4 "indent")) (right-margin (4 "indentright")) (justification (none "nofill") (right "flushright") (left "flushleft") (full "flushboth") (center "center")) (PARAMETER (t "param")) ; Argument of preceding annotation ;; The following are not part of the standard: (FUNCTION (enriched-decode-foreground "x-color") (enriched-decode-background "x-bg-color")) (read-only (t "x-read-only")) (unknown (nil format-annotate-value)) ; (font-size (2 "bigger") ; unimplemented ; (-2 "smaller")) ) "List of definitions of text/enriched annotations. See `format-annotate-region' and `format-deannotate-region' for the definition of this structure.") (defconst enriched-ignore '(front-sticky rear-nonsticky hard) "Properties that are OK to ignore when saving text/enriched files. Any property that is neither on this list nor dealt with by `enriched-translations' will generate a warning.") ;;; Internal variables (defvar enriched-mode nil "True if `enriched-mode' is in use.") (make-variable-buffer-local 'enriched-mode) (if (not (assq 'enriched-mode minor-mode-alist)) (setq minor-mode-alist (cons '(enriched-mode " Enriched") minor-mode-alist))) (defvar enriched-mode-hooks nil "Functions to run when entering `enriched-mode'. If you set variables in this hook, you should arrange for them to be restored to their old values if enriched-mode is left. One way to do this is to add them and their old values to `enriched-old-bindings'.") (defvar enriched-old-bindings nil "Store old variable values that we change when entering mode. The value is a list of \(VAR VALUE VAR VALUE...).") (make-variable-buffer-local 'enriched-old-bindings) (defvar enriched-text-width nil) (make-variable-buffer-local 'enriched-text-width) ;;; ;;; Define the mode ;;; ;;;###autoload (defun enriched-mode (&optional arg) "Minor mode for editing text/enriched files. These are files with embedded formatting information in the MIME standard text/enriched format. Turning the mode on runs `enriched-mode-hooks'. More information about enriched-mode is available in the file etc/enriched.doc in the Emacs distribution directory. Commands: \\\\{enriched-mode-map}" (interactive "P") (let ((mod (buffer-modified-p))) (cond ((or (<= (prefix-numeric-value arg) 0) (and enriched-mode (null arg))) ;; Turn mode off (setq enriched-mode nil) (setq buffer-file-format (delq 'text/enriched buffer-file-format)) ;; restore old variable values (while enriched-old-bindings (funcall 'set (car enriched-old-bindings) (car (cdr enriched-old-bindings))) (setq enriched-old-bindings (cdr (cdr enriched-old-bindings))))) (enriched-mode nil) ; Mode already on; do nothing. (t (setq enriched-mode t) ; Turn mode on (if (not (memq 'text/enriched buffer-file-format)) (setq buffer-file-format (cons 'text/enriched buffer-file-format))) ;; Save old variable values before we change them. ;; These will be restored if we exit enriched-mode. (setq enriched-old-bindings (list 'buffer-display-table buffer-display-table 'indent-line-function indent-line-function 'use-hard-newlines use-hard-newlines 'default-text-properties default-text-properties)) (make-local-variable 'indent-line-function) (make-local-variable 'use-hard-newlines) (make-local-variable 'default-text-properties) (setq indent-line-function 'indent-to-left-margin buffer-display-table enriched-display-table use-hard-newlines t) (let ((sticky (plist-get default-text-properties 'front-sticky)) (p enriched-par-props)) (while p (if (not (memq (car p) sticky)) (setq sticky (cons (car p) sticky))) (setq p (cdr p))) (if sticky (setq default-text-properties (plist-put default-text-properties 'front-sticky sticky)))) (run-hooks 'enriched-mode-hooks))) (set-buffer-modified-p mod) (force-mode-line-update))) ;;; ;;; Keybindings ;;; (defvar enriched-mode-map nil "Keymap for `enriched-mode'.") (if (null enriched-mode-map) (fset 'enriched-mode-map (setq enriched-mode-map (make-sparse-keymap)))) (if (not (assq 'enriched-mode minor-mode-map-alist)) (setq minor-mode-map-alist (cons (cons 'enriched-mode enriched-mode-map) minor-mode-map-alist))) (define-key enriched-mode-map "\C-a" 'beginning-of-line-text) (define-key enriched-mode-map "\C-m" 'reindent-then-newline-and-indent) (define-key enriched-mode-map "\C-j" 'reindent-then-newline-and-indent) (define-key enriched-mode-map "\M-j" 'facemenu-justification-menu) (define-key enriched-mode-map "\M-S" 'set-justification-center) (define-key enriched-mode-map "\C-x\t" 'increase-left-margin) (define-key enriched-mode-map "\C-c\C-l" 'set-left-margin) (define-key enriched-mode-map "\C-c\C-r" 'set-right-margin) ;;; ;;; Some functions dealing with text-properties, especially indentation ;;; (defun enriched-map-property-regions (prop func &optional from to) "Apply a function to regions of the buffer based on a text property. For each contiguous region of the buffer for which the value of PROPERTY is eq, the FUNCTION will be called. Optional arguments FROM and TO specify the region over which to scan. The specified function receives three arguments: the VALUE of the property in the region, and the START and END of each region." (save-excursion (save-restriction (if to (narrow-to-region (point-min) to)) (goto-char (or from (point-min))) (let ((begin (point)) end (marker (make-marker)) (val (get-text-property (point) prop))) (while (setq end (text-property-not-all begin (point-max) prop val)) (move-marker marker end) (funcall func val begin (marker-position marker)) (setq begin (marker-position marker) val (get-text-property marker prop))) (if (< begin (point-max)) (funcall func val begin (point-max))))))) (put 'enriched-map-property-regions 'lisp-indent-hook 1) (defun enriched-insert-indentation (&optional from to) "Indent and justify each line in the region." (save-excursion (save-restriction (if to (narrow-to-region (point-min) to)) (goto-char (or from (point-min))) (if (not (bolp)) (forward-line 1)) (while (not (eobp)) (if (eolp) nil ; skip blank lines (indent-to (current-left-margin)) (justify-current-line t nil t)) (forward-line 1))))) (defun enriched-text-width () "The width of unindented text in this window, in characters. This is the width of the window minus `enriched-default-right-margin'." (or enriched-text-width (let ((ww (window-width))) (setq enriched-text-width (if (> ww enriched-default-right-margin) (- ww enriched-default-right-margin) ww))))) ;;; ;;; Encoding Files ;;; ;;;###autoload (defun enriched-encode (from to) (if enriched-verbose (message "Enriched: encoding document...")) (save-restriction (narrow-to-region from to) (delete-to-left-margin) (unjustify-region) (goto-char from) (format-replace-strings '(("<" . "<<"))) (format-insert-annotations (format-annotate-region from (point-max) enriched-translations 'enriched-make-annotation enriched-ignore)) (goto-char from) (insert (if (stringp enriched-initial-annotation) enriched-initial-annotation (funcall enriched-initial-annotation))) (enriched-map-property-regions 'hard (lambda (v b e) (if (and v (= ?\n (char-after b))) (progn (goto-char b) (insert "\n")))) (point) nil) (if enriched-verbose (message nil)) ;; Return new end. (point-max))) (defun enriched-make-annotation (name positive) "Format an annotation called NAME. If POSITIVE is non-nil, this is the opening annotation, if nil, this is the matching close." (cond ((stringp name) (format enriched-annotation-format (if positive "" "/") name)) ;; Otherwise it is an annotation with parameters, represented as a list (positive (let ((item (car name)) (params (cdr name))) (concat (format enriched-annotation-format "" item) (mapconcat (lambda (i) (concat "" i "")) params "")))) (t (format enriched-annotation-format "/" (car name))))) (defun enriched-encode-other-face (old new) "Generate annotations for random face change. One annotation each for foreground color, background color, italic, etc." (cons (and old (enriched-face-ans old)) (and new (enriched-face-ans new)))) (defun enriched-face-ans (face) "Return annotations specifying FACE." (cond ((string-match "^fg:" (symbol-name face)) (list (list "x-color" (substring (symbol-name face) 3)))) ((string-match "^bg:" (symbol-name face)) (list (list "x-bg-color" (substring (symbol-name face) 3)))) ((let* ((fg (face-foreground face)) (bg (face-background face)) (props (face-font face t)) (ans (cdr (format-annotate-single-property-change 'face nil props enriched-translations)))) (if fg (setq ans (cons (list "x-color" fg) ans))) (if bg (setq ans (cons (list "x-bg-color" bg) ans))) ans)))) ;;; ;;; Decoding files ;;; ;;;###autoload (defun enriched-decode (from to) (if enriched-verbose (message "Enriched: decoding document...")) (save-excursion (save-restriction (narrow-to-region from to) (goto-char from) (let ((file-width (enriched-get-file-width)) (use-hard-newlines t)) (enriched-remove-header) ;; Deal with newlines (goto-char from) (while (search-forward-regexp "\n\n+" nil t) (if (current-justification) (delete-char -1)) (put-text-property (match-beginning 0) (point) 'hard t) (put-text-property (match-beginning 0) (point) 'front-sticky nil)) ;; Translate annotations (format-deannotate-region from (point-max) enriched-translations 'enriched-next-annotation) ;; Fill paragraphs (if (or (and file-width ; possible reasons not to fill: (= file-width (enriched-text-width))) ; correct wd. (null enriched-fill-after-visiting) ; never fill (and (eq 'ask enriched-fill-after-visiting) ; asked & declined (not (y-or-n-p "Re-fill for current display width? ")))) ;; Minimally, we have to insert indentation and justification. (enriched-insert-indentation) (if enriched-verbose (message "Filling paragraphs...")) (fill-region (point-min) (point-max)))) (if enriched-verbose (message nil)) (point-max)))) (defun enriched-next-annotation () "Find and return next text/enriched annotation. Any \"<<\" strings encountered are converted to \"<\". Return value is \(begin end name positive-p), or nil if none was found." (while (and (search-forward "<" nil 1) (progn (goto-char (match-beginning 0)) (not (looking-at enriched-annotation-regexp)))) (forward-char 1) (if (= ?< (char-after (point))) (delete-char 1) ;; A single < that does not start an annotation is an error, ;; which we note and then ignore. (message (format "Warning: malformed annotation in file at %s" (1- (point)))))) (if (not (eobp)) (let* ((beg (match-beginning 0)) (end (match-end 0)) (name (downcase (buffer-substring (match-beginning 2) (match-end 2)))) (pos (not (match-beginning 1)))) (list beg end name pos)))) (defun enriched-get-file-width () "Look for file width information on this line." (save-excursion (if (search-forward "Text-Width: " (+ (point) 1000) t) (read (current-buffer))))) (defun enriched-remove-header () "Remove file-format header at point." (while (looking-at "^[-A-Za-z]+: .*\n") (delete-region (point) (match-end 0))) (if (looking-at "^\n") (delete-char 1))) (defun enriched-decode-foreground (from to color) (let ((face (intern (concat "fg:" color)))) (cond ((internal-find-face face)) ((and window-system (facemenu-get-face face))) (window-system (message "Warning: color \"%s\" is not defined." color)) ((make-face face) (message "Warning: Color \"%s\" can't be displayed." color))) (list from to 'face face))) (defun enriched-decode-background (from to color) (let ((face (intern (concat "bg:" color)))) (cond ((internal-find-face face)) ((and window-system (facemenu-get-face face))) (window-system (message "Warning: color \"%s\" is not defined." color)) ((make-face face) (message "Warning: Color \"%s\" can't be displayed." color))) (list from to 'face face))) ;;; enriched.el ends here emacs-19.30/lisp/env.el100444 12120 1 10303 6024464743 13207 0ustar rmsdaemon;;; env.el --- functions to manipulate environment variables. ;;; Copyright 1991, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: processes, unix ;;; 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: ;; UNIX processes inherit a list of name-to-string associations from ;; their parents called their `environment'; these are commonly used ;; to control program options. This package permits you to set ;; environment variables to be passed to any sub-process run under Emacs. ;;; Code: ;; History list for environment variable names. (defvar read-envvar-name-history nil) (defun read-envvar-name (prompt &optional mustmatch) "Read environment variable name, prompting with PROMPT. Optional second arg MUSTMATCH, if non-nil, means require existing envvar name. If it is also not t, RET does not exit if it does non-null completion." (completing-read prompt (mapcar (function (lambda (enventry) (list (substring enventry 0 (string-match "=" enventry))))) process-environment) nil mustmatch nil 'read-envvar-name-history)) ;; History list for VALUE argument to setenv. (defvar setenv-history nil) ;;;###autoload (defun setenv (variable &optional value unset) "Set the value of the environment variable named VARIABLE to VALUE. VARIABLE should be a string. VALUE is optional; if not provided or is `nil', the environment variable VARIABLE will be removed. Interactively, a prefix argument means to unset the variable. Interactively, the current value (if any) of the variable appears at the front of the history list when you type in the new value. This function works by modifying `process-environment'." (interactive (if current-prefix-arg (list (read-envvar-name "Clear environment variable: " 'exact) nil t) (let* ((var (read-envvar-name "Set environment variable: " nil)) (oldval (getenv var)) newval oldhist) ;; Don't put the current value on the history ;; if it is already there. (if (equal oldval (car setenv-history)) (setq oldval nil)) ;; Now if OLDVAL is non-nil, we should add it to the history. (if oldval (setq setenv-history (cons oldval setenv-history))) (setq oldhist setenv-history) (setq newval (read-from-minibuffer (format "Set %s to value: " var) nil nil nil 'setenv-history)) ;; If we added the current value to the history, remove it. ;; Note that read-from-minibuffer may have added the new value. ;; Don't remove that! (if oldval (if (eq oldhist setenv-history) (setq setenv-history (cdr setenv-history)) (setcdr setenv-history (cdr (cdr setenv-history))))) ;; Here finally we specify the args to give call setenv with. (list var newval)))) (if unset (setq value nil)) (if (string-match "=" variable) (error "Environment variable name `%s' contains `='" variable) (let ((pattern (concat "\\`" (regexp-quote (concat variable "=")))) (case-fold-search nil) (scan process-environment) found) (if (string-equal "TZ" variable) (set-time-zone-rule value)) (while scan (cond ((string-match pattern (car scan)) (setq found t) (if (eq nil value) (setq process-environment (delq (car scan) process-environment)) (setcar scan (concat variable "=" value))) (setq scan nil))) (setq scan (cdr scan))) (or found (if value (setq process-environment (cons (concat variable "=" value) process-environment))))))) (provide 'env) ;;; env.el ends here emacs-19.30/lisp/etags.el100444 12120 1 171440 6053206041 13537 0ustar rmsdaemon;;; etags.el --- etags facility for Emacs ;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995 ;; Free Software Foundation, Inc. ;; Author: Roland McGrath ;; Keywords: tools ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;;;###autoload (defvar tags-file-name nil "*File name of tags table. To switch to a new tags table, setting this variable is sufficient. If you set this variable, do not also set `tags-table-list'. Use the `etags' program to make a tags table file.") ;; Make M-x set-variable tags-file-name like M-x visit-tags-table. ;;;###autoload (put 'tags-file-name 'variable-interactive "fVisit tags table: ") ;;;###autoload ;; Use `visit-tags-table-buffer' to cycle through tags tables in this list. (defvar tags-table-list nil "*List of file names of tags tables to search. An element that is a directory means the file \"TAGS\" in that directory. To switch to a new list of tags tables, setting this variable is sufficient. If you set this variable, do not also set `tags-file-name'. Use the `etags' program to make a tags table file.") ;;;###autoload (defvar tags-add-tables 'ask-user "*Control whether to add a new tags table to the current list. t means do; nil means don't (always start a new list). Any other value means ask the user whether to add a new tags table to the current list (as opposed to starting a new list).") (defvar tags-table-computed-list nil "List of tags tables to search, computed from `tags-table-list'. This includes tables implicitly included by other tables. The list is not always complete: the included tables of a table are not known until that table is read into core. An element that is `t' is a placeholder indicating that the preceding element is a table that has not been read into core and might contain included tables to search. See `tags-table-check-computed-list'.") (defvar tags-table-computed-list-for nil "Value of `tags-table-list' that `tags-table-computed-list' corresponds to. If `tags-table-list' changes, `tags-table-computed-list' is thrown away and recomputed; see `tags-table-check-computed-list'.") (defvar tags-table-list-pointer nil "Pointer into `tags-table-computed-list' for the current state of searching. Use `visit-tags-table-buffer' to cycle through tags tables in this list.") (defvar tags-table-list-started-at nil "Pointer into `tags-table-computed-list', where the current search started.") (defvar tags-table-set-list nil "List of sets of tags table which have been used together in the past. Each element is a list of strings which are file names.") ;;;###autoload (defvar find-tag-hook nil "*Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'. The value in the buffer in which \\[find-tag] is done is used, not the value in the buffer \\[find-tag] goes to.") ;;;###autoload (defvar find-tag-default-function nil "*A function of no arguments used by \\[find-tag] to pick a default tag. If nil, and the symbol that is the value of `major-mode' has a `find-tag-default-function' property (see `put'), that is used. Otherwise, `find-tag-default' is used.") (defvar default-tags-table-function nil "If non-nil, a function to choose a default tags file for a buffer. This function receives no arguments and should return the default tags table file to use for the current buffer.") (defvar tags-location-stack nil "List of markers which are locations visited by \\[find-tag]. Pop back to the last location with \\[negative-argument] \\[find-tag].") ;; Tags table state. ;; These variables are local in tags table buffers. (defvar tag-lines-already-matched nil "List of positions of beginnings of lines within the tags table that are already matched.") (defvar tags-table-files nil "List of file names covered by current tags table. nil means it has not yet been computed; use `tags-table-files' to do so.") (defvar tags-completion-table nil "Alist of tag names defined in current tags table.") (defvar tags-included-tables nil "List of tags tables included by the current tags table.") (defvar next-file-list nil "List of files for \\[next-file] to process.") ;; Hooks for file formats. (defvar tags-table-format-hooks '(etags-recognize-tags-table recognize-empty-tags-table) "List of functions to be called in a tags table buffer to identify the type of tags table. The functions are called in order, with no arguments, until one returns non-nil. The function should make buffer-local bindings of the format-parsing tags function variables if successful.") (defvar file-of-tag-function nil "Function to do the work of `file-of-tag' (which see).") (defvar tags-table-files-function nil "Function to do the work of `tags-table-files' (which see).") (defvar tags-completion-table-function nil "Function to build the tags-completion-table.") (defvar snarf-tag-function nil "Function to get info about a matched tag for `goto-tag-location-function'.") (defvar goto-tag-location-function nil "Function of to go to the location in the buffer specified by a tag. One argument, the tag info returned by `snarf-tag-function'.") (defvar find-tag-file-order nil "Function which checks for complete and correct match, for file name as tag.") (defvar find-tag-regexp-search-function nil "Search function passed to `find-tag-in-order' for finding a regexp tag.") (defvar find-tag-regexp-tag-order nil "Tag order passed to `find-tag-in-order' for finding a regexp tag.") (defvar find-tag-regexp-next-line-after-failure-p nil "Flag passed to `find-tag-in-order' for finding a regexp tag.") (defvar find-tag-search-function nil "Search function passed to `find-tag-in-order' for finding a tag.") (defvar find-tag-tag-order nil "Tag order passed to `find-tag-in-order' for finding a tag.") (defvar find-tag-next-line-after-failure-p nil "Flag passed to `find-tag-in-order' for finding a tag.") (defvar list-tags-function nil "Function to do the work of `list-tags' (which see).") (defvar tags-apropos-function nil "Function to do the work of `tags-apropos' (which see).") (defvar tags-included-tables-function nil "Function to do the work of `tags-included-tables' (which see).") (defvar verify-tags-table-function nil "Function to return t iff the current buffer contains a valid \(already initialized\) tags file.") ;; Initialize the tags table in the current buffer. ;; Returns non-nil iff it is a valid tags table. On ;; non-nil return, the tags table state variable are ;; made buffer-local and initialized to nil. (defun initialize-new-tags-table () (set (make-local-variable 'tag-lines-already-matched) nil) (set (make-local-variable 'tags-table-files) nil) (set (make-local-variable 'tags-completion-table) nil) (set (make-local-variable 'tags-included-tables) nil) ;; Value is t if we have found a valid tags table buffer. (let ((hooks tags-table-format-hooks)) (while (and hooks (not (funcall (car hooks)))) (setq hooks (cdr hooks))) hooks)) ;;;###autoload (defun visit-tags-table (file &optional local) "Tell tags commands to use tags table file FILE. FILE should be the name of a file created with the `etags' program. A directory name is ok too; it means file TAGS in that directory. Normally \\[visit-tags-table] sets the global value of `tags-file-name'. With a prefix arg, set the buffer-local value instead. When you find a tag with \\[find-tag], the buffer it finds the tag in is given a local value of this variable which is the name of the tags file the tag was in." (interactive (list (read-file-name "Visit tags table: (default TAGS) " default-directory (expand-file-name "TAGS" default-directory) t) current-prefix-arg)) (or (stringp file) (signal 'wrong-type-argument (list 'stringp file))) ;; Bind tags-file-name so we can control below whether the local or ;; global value gets set. Calling visit-tags-table-buffer will ;; initialize a buffer for the file and set tags-file-name to the ;; Calling visit-tags-table-buffer with tags-file-name set to FILE will ;; initialize a buffer for FILE and set tags-file-name to the ;; fully-expanded name. (let ((tags-file-name file)) (save-excursion (or (visit-tags-table-buffer file) (signal 'file-error (list "Visiting tags table" "file does not exist" file))) ;; Set FILE to the expanded name. (setq file tags-file-name))) (if local ;; Set the local value of tags-file-name. (set (make-local-variable 'tags-file-name) file) ;; Set the global value of tags-file-name. (setq-default tags-file-name file))) (defun tags-table-check-computed-list () "Compute `tags-table-computed-list' from `tags-table-list' if necessary." (let ((expanded-list (mapcar 'tags-expand-table-name tags-table-list))) (or (equal tags-table-computed-list-for expanded-list) ;; The list (or default-directory) has changed since last computed. (let* ((compute-for (mapcar 'copy-sequence expanded-list)) (tables (copy-sequence compute-for)) ;Mutated in the loop. (computed nil) table-buffer) (while tables (setq computed (cons (car tables) computed) table-buffer (get-file-buffer (car tables))) (if (and table-buffer ;; There is a buffer visiting the file. Now make sure ;; it is initialized as a tag table buffer. (save-excursion (tags-verify-table (buffer-file-name table-buffer)))) (save-excursion (set-buffer table-buffer) (if (tags-included-tables) ;; Insert the included tables into the list we ;; are processing. (setcdr tables (nconc (mapcar 'tags-expand-table-name (tags-included-tables)) (cdr tables))))) ;; This table is not in core yet. Insert a placeholder ;; saying we must read it into core to check for included ;; tables before searching the next table in the list. (setq computed (cons t computed))) (setq tables (cdr tables))) ;; Record the tags-table-list value (and the context of the ;; current directory) we computed from. (setq tags-table-computed-list-for compute-for tags-table-computed-list (nreverse computed)))))) ;; Extend `tags-table-computed-list' to remove the first `t' placeholder. ;; An element of the list that is `t' is a placeholder indicating that the ;; preceding element is a table that has not been read into core and might ;; contain included tables to search. On return, the first placeholder ;; element will be gone and the element before it read into core and its ;; included tables inserted into the list. (defun tags-table-extend-computed-list () (let ((list tags-table-computed-list)) (while (not (eq (nth 1 list) t)) (setq list (cdr list))) (save-excursion (if (tags-verify-table (car list)) ;; We are now in the buffer visiting (car LIST). Extract its ;; list of included tables and insert it into the computed list. (let ((tables (tags-included-tables)) (computed nil) table-buffer) (while tables (setq computed (cons (car tables) computed) table-buffer (get-file-buffer (car tables))) (if table-buffer (save-excursion (set-buffer table-buffer) (if (tags-included-tables) ;; Insert the included tables into the list we ;; are processing. (setcdr tables (append (tags-included-tables) tables)))) ;; This table is not in core yet. Insert a placeholder ;; saying we must read it into core to check for included ;; tables before searching the next table in the list. (setq computed (cons t computed))) (setq tables (cdr tables))) (setq computed (nreverse computed)) ;; COMPUTED now contains the list of included tables (and ;; tables included by them, etc.). Now splice this into the ;; current list. (setcdr list (nconc computed (cdr (cdr list))))) ;; It was not a valid table, so just remove the following placeholder. (setcdr list (cdr (cdr list))))))) ;; Expand tags table name FILE into a complete file name. (defun tags-expand-table-name (file) (setq file (expand-file-name file)) (if (file-directory-p file) (expand-file-name "TAGS" file) file)) ;; Like member, but comparison is done after tags-expand-table-name on both ;; sides and elements of LIST that are t are skipped. (defun tags-table-list-member (file list) (setq file (tags-expand-table-name file)) (while (and list (or (eq (car list) t) (not (string= file (tags-expand-table-name (car list)))))) (setq list (cdr list))) list) (defun tags-verify-table (file) "Read FILE into a buffer and verify that it is a valid tags table. Sets the current buffer to one visiting FILE (if it exists). Returns non-nil iff it is a valid table." (if (get-file-buffer file) ;; The file is already in a buffer. Check for the visited file ;; having changed since we last used it. (let (win) (set-buffer (get-file-buffer file)) (setq win (or verify-tags-table-function (initialize-new-tags-table))) (if (or (verify-visited-file-modtime (current-buffer)) (not (yes-or-no-p (format "Tags file %s has changed, read new contents? " file)))) (and win (funcall verify-tags-table-function)) (revert-buffer t t) (initialize-new-tags-table))) (and (file-exists-p file) (progn (set-buffer (find-file-noselect file)) (or (string= file buffer-file-name) ;; find-file-noselect has changed the file name. ;; Propagate the change to tags-file-name and tags-table-list. (let ((tail (member file tags-table-list))) (if tail (setcar tail buffer-file-name)) (if (eq file tags-file-name) (setq tags-file-name buffer-file-name)))) (initialize-new-tags-table))))) ;; Subroutine of visit-tags-table-buffer. Search the current tags tables ;; for one that has tags for THIS-FILE (or that includes a table that ;; does). Return the name of the first table table listing THIS-FILE; if ;; the table is one included by another table, it is the master table that ;; we return. If CORE-ONLY is non-nil, check only tags tables that are ;; already in buffers--don't visit any new files. (defun tags-table-including (this-file core-only) (let ((tables tags-table-computed-list) (found nil)) ;; Loop over the list, looking for a table containing tags for THIS-FILE. (while (and (not found) tables) (if core-only ;; Skip tables not in core. (while (eq (nth 1 tables) t) (setq tables (cdr (cdr tables)))) (if (eq (nth 1 tables) t) ;; This table has not been read into core yet. Read it in now. (tags-table-extend-computed-list))) (if tables ;; Select the tags table buffer and get the file list up to date. (let ((tags-file-name (car tables))) (visit-tags-table-buffer 'same) (if (member this-file (tags-table-files)) ;; Found it. (setq found tables)))) (setq tables (cdr tables))) (if found ;; Now determine if the table we found was one included by another ;; table, not explicitly listed. We do this by checking each ;; element of the computed list to see if it appears in the user's ;; explicit list; the last element we will check is FOUND itself. ;; Then we return the last one which did in fact appear in ;; tags-table-list. (let ((could-be nil) (elt tags-table-computed-list)) (while (not (eq elt (cdr found))) (if (tags-table-list-member (car elt) tags-table-list) ;; This table appears in the user's list, so it could be ;; the one which includes the table we found. (setq could-be (car elt))) (setq elt (cdr elt)) (if (eq t (car elt)) (setq elt (cdr elt)))) ;; The last element we found in the computed list before FOUND ;; that appears in the user's list will be the table that ;; included the one we found. could-be)))) ;; Subroutine of visit-tags-table-buffer. Move tags-table-list-pointer ;; along and set tags-file-name. Returns nil when out of tables. (defun tags-next-table () ;; If there is a placeholder element next, compute the list to replace it. (while (eq (nth 1 tags-table-list-pointer) t) (tags-table-extend-computed-list)) ;; Go to the next table in the list. (setq tags-table-list-pointer (cdr tags-table-list-pointer)) (or tags-table-list-pointer ;; Wrap around. (setq tags-table-list-pointer tags-table-computed-list)) (if (eq tags-table-list-pointer tags-table-list-started-at) ;; We have come full circle. No more tables. (setq tags-table-list-pointer nil) ;; Set tags-file-name to the name from the list. It is already expanded. (setq tags-file-name (car tags-table-list-pointer)))) (defun visit-tags-table-buffer (&optional cont) "Select the buffer containing the current tags table. If optional arg is a string, visit that file as a tags table. If optional arg is t, visit the next table in `tags-table-list'. If optional arg is the atom `same', don't look for a new table; just select the buffer visiting `tags-file-name'. If arg is nil or absent, choose a first buffer from information in `tags-file-name', `tags-table-list', `tags-table-list-pointer'. Returns t if it visits a tags table, or nil if there are no more in the list." ;; Set tags-file-name to the tags table file we want to visit. (cond ((eq cont 'same) ;; Use the ambient value of tags-file-name. (or tags-file-name (error (substitute-command-keys (concat "No tags table in use! " "Use \\[visit-tags-table] to select one."))))) ((eq t cont) ;; Find the next table. (if (tags-next-table) ;; Skip over nonexistent files. (while (and (not (or (get-file-buffer tags-file-name) (file-exists-p tags-file-name))) (tags-next-table))))) (t ;; Pick a table out of our hat. (tags-table-check-computed-list) ;Get it up to date, we might use it. (setq tags-file-name (or ;; If passed a string, use that. (if (stringp cont) (prog1 cont (setq cont nil))) ;; First, try a local variable. (cdr (assq 'tags-file-name (buffer-local-variables))) ;; Second, try a user-specified function to guess. (and default-tags-table-function (funcall default-tags-table-function)) ;; Third, look for a tags table that contains tags for the ;; current buffer's file. If one is found, the lists will ;; be frobnicated, and CONT will be set non-nil so we don't ;; do it below. (and buffer-file-name (or ;; First check only tables already in buffers. (tags-table-including buffer-file-name t) ;; Since that didn't find any, now do the ;; expensive version: reading new files. (tags-table-including buffer-file-name nil))) ;; Fourth, use the user variable tags-file-name, if it is ;; not already in the current list. (and tags-file-name (not (tags-table-list-member tags-file-name tags-table-computed-list)) tags-file-name) ;; Fifth, use the user variable giving the table list. ;; Find the first element of the list that actually exists. (let ((list tags-table-list) file) (while (and list (setq file (tags-expand-table-name (car list))) (not (get-file-buffer file)) (not (file-exists-p file))) (setq list (cdr list))) (car list)) ;; Finally, prompt the user for a file name. (expand-file-name (read-file-name "Visit tags table: (default TAGS) " default-directory "TAGS" t)))))) ;; Expand the table name into a full file name. (setq tags-file-name (tags-expand-table-name tags-file-name)) (if (and (eq cont t) (null tags-table-list-pointer)) ;; All out of tables. nil ;; Verify that tags-file-name names a valid tags table. ;; Bind another variable with the value of tags-file-name ;; before we switch buffers, in case tags-file-name is buffer-local. (let ((curbuf (current-buffer)) (local-tags-file-name tags-file-name)) (if (tags-verify-table local-tags-file-name) ;; We have a valid tags table. (progn ;; Bury the tags table buffer so it ;; doesn't get in the user's way. (bury-buffer (current-buffer)) ;; If this was a new table selection (CONT is nil), make ;; sure tags-table-list includes the chosen table, and ;; update the list pointer variables. (or cont ;; Look in the list for the table we chose. (let ((found (tags-table-list-member local-tags-file-name tags-table-computed-list))) (if found ;; There it is. Just switch to it. (setq tags-table-list-pointer found tags-table-list-started-at found) ;; The table is not in the current set. ;; Try to find it in another previously used set. (let ((sets tags-table-set-list)) (while (and sets (not (tags-table-list-member local-tags-file-name (car sets)))) (setq sets (cdr sets))) (if sets ;; Found in some other set. Switch to that set. (progn (or (memq tags-table-list tags-table-set-list) ;; Save the current list. (setq tags-table-set-list (cons tags-table-list tags-table-set-list))) (setq tags-table-list (car sets))) ;; Not found in any existing set. (if (and tags-table-list (or (eq t tags-add-tables) (and tags-add-tables (y-or-n-p (concat "Keep current list of " "tags tables also? "))))) ;; Add it to the current list. (setq tags-table-list (cons local-tags-file-name tags-table-list)) ;; Make a fresh list, and store the old one. (message "Starting a new list of tags tables") (or (null tags-table-list) (memq tags-table-list tags-table-set-list) (setq tags-table-set-list (cons tags-table-list tags-table-set-list))) (setq tags-table-list (list local-tags-file-name)))) ;; Recompute tags-table-computed-list. (tags-table-check-computed-list) ;; Set the tags table list state variables to start ;; over from tags-table-computed-list. (setq tags-table-list-started-at tags-table-computed-list tags-table-list-pointer tags-table-computed-list))))) ;; Return of t says the tags table is valid. t) ;; The buffer was not valid. Don't use it again. (set-buffer curbuf) (kill-local-variable 'tags-file-name) (if (eq local-tags-file-name tags-file-name) (setq tags-file-name nil)) (error "File %s is not a valid tags table" local-tags-file-name))))) (defun tags-reset-tags-tables () "Reset tags state to cancel effect of any previous \\[visit-tags-table] or \\[find-tag]." (interactive) (setq tags-file-name nil tags-location-stack nil tags-table-list nil tags-table-computed-list nil tags-table-computed-list-for nil tags-table-list-pointer nil tags-table-list-started-at nil tags-table-set-list nil)) (defun file-of-tag () "Return the file name of the file whose tags point is within. Assumes the tags table is the current buffer. File name returned is relative to tags table file's directory." (funcall file-of-tag-function)) ;;;###autoload (defun tags-table-files () "Return a list of files in the current tags table. Assumes the tags table is the current buffer. File names returned are absolute." (or tags-table-files (setq tags-table-files (funcall tags-table-files-function)))) (defun tags-included-tables () "Return a list of tags tables included by the current table. Assumes the tags table is the current buffer." (or tags-included-tables (setq tags-included-tables (funcall tags-included-tables-function)))) ;; Build tags-completion-table on demand. The single current tags table ;; and its included tags tables (and their included tables, etc.) have ;; their tags included in the completion table. (defun tags-completion-table () (or tags-completion-table (condition-case () (prog2 (message "Making tags completion table for %s..." buffer-file-name) (let ((included (tags-included-tables)) (table (funcall tags-completion-table-function))) (save-excursion ;; Iterate over the list of included tables, and combine each ;; included table's completion obarray to the parent obarray. (while included ;; Visit the buffer. (let ((tags-file-name (car included))) (visit-tags-table-buffer 'same)) ;; Recurse in that buffer to compute its completion table. (if (tags-completion-table) ;; Combine the tables. (mapatoms (function (lambda (sym) (intern (symbol-name sym) table))) tags-completion-table)) (setq included (cdr included)))) (setq tags-completion-table table)) (message "Making tags completion table for %s...done" buffer-file-name)) (quit (message "Tags completion table construction aborted.") (setq tags-completion-table nil))))) ;; Completion function for tags. Does normal try-completion, ;; but builds tags-completion-table on demand. (defun tags-complete-tag (string predicate what) (save-excursion ;; If we need to ask for the tag table, allow that. (let ((enable-recursive-minibuffers t)) (visit-tags-table-buffer)) (if (eq what t) (all-completions string (tags-completion-table) predicate) (try-completion string (tags-completion-table) predicate)))) ;; Return a default tag to search for, based on the text at point. (defun find-tag-default () (save-excursion (while (looking-at "\\sw\\|\\s_") (forward-char 1)) (if (or (re-search-backward "\\sw\\|\\s_" (save-excursion (beginning-of-line) (point)) t) (re-search-forward "\\(\\sw\\|\\s_\\)+" (save-excursion (end-of-line) (point)) t)) (progn (goto-char (match-end 0)) (buffer-substring (point) (progn (forward-sexp -1) (while (looking-at "\\s'") (forward-char 1)) (point)))) nil))) ;; Read a tag name from the minibuffer with defaulting and completion. (defun find-tag-tag (string) (let* ((default (funcall (or find-tag-default-function (get major-mode 'find-tag-default-function) 'find-tag-default))) (spec (completing-read (if default (format "%s(default %s) " string default) string) 'tags-complete-tag))) (if (equal spec "") (or default (error "There is no default tag")) spec))) (defvar last-tag nil "Last tag found by \\[find-tag].") ;; Get interactive args for find-tag{-noselect,-other-window,-regexp}. (defun find-tag-interactive (prompt &optional no-default) (if current-prefix-arg (list nil (if (< (prefix-numeric-value current-prefix-arg) 0) '- t)) (list (if no-default (read-string prompt) (find-tag-tag prompt))))) (defvar find-tag-history nil) ;;;###autoload (defun find-tag-noselect (tagname &optional next-p regexp-p) "Find tag (in current tags table) whose name contains TAGNAME. Returns the buffer containing the tag's definition and moves its point there, but does not select the buffer. The default for TAGNAME is the expression in the buffer near point. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is the atom `-' (interactively, with prefix arg that is a negative number or just \\[negative-argument]), pop back to the previous tag gone to. If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp. See documentation of variable `tags-file-name'." (interactive (find-tag-interactive "Find tag: ")) (setq find-tag-history (cons tagname find-tag-history)) ;; Save the current buffer's value of `find-tag-hook' before selecting the ;; tags table buffer. (let ((local-find-tag-hook find-tag-hook) (search-tag)) (if (eq '- next-p) ;; Pop back to a previous location. (if (null tags-location-stack) (error "No previous tag locations") (let ((marker (car tags-location-stack))) ;; Pop the stack. (setq tags-location-stack (cdr tags-location-stack)) (prog1 ;; Move to the saved location. (set-buffer (marker-buffer marker)) (goto-char (marker-position marker)) ;; Kill that marker so it doesn't slow down editing. (set-marker marker nil nil) ;; Run the user's hook. Do we really want to do this for pop? (run-hooks 'local-find-tag-hook)))) (if next-p ;; Find the same table we last used. (visit-tags-table-buffer 'same) ;; Pick a table to use. (visit-tags-table-buffer) ;; Record TAGNAME for a future call with NEXT-P non-nil. (setq last-tag tagname)) ;; Record the location so we can pop back to it later. (let ((marker (make-marker))) (save-excursion (setq search-tag (if next-p last-tag tagname)) (set-buffer ;; find-tag-in-order does the real work. (find-tag-in-order (if next-p last-tag tagname) (if regexp-p find-tag-regexp-search-function find-tag-search-function) (if regexp-p find-tag-regexp-tag-order (if (string-match "\\b.*\\.\\w*" search-tag) find-tag-file-order find-tag-tag-order)) (if regexp-p find-tag-regexp-next-line-after-failure-p find-tag-next-line-after-failure-p) (if regexp-p "matching" "containing") (not next-p))) (set-marker marker (point)) (run-hooks 'local-find-tag-hook) (setq tags-location-stack (cons marker tags-location-stack)) (current-buffer)))))) ;;;###autoload (defun find-tag (tagname &optional next-p regexp-p) "Find tag (in current tags table) whose name contains TAGNAME. Select the buffer containing the tag's definition, and move point there. The default for TAGNAME is the expression in the buffer around or before point. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is the atom `-' (interactively, with prefix arg that is a negative number or just \\[negative-argument]), pop back to the previous tag gone to. See documentation of variable `tags-file-name'." (interactive (find-tag-interactive "Find tag: ")) (switch-to-buffer (find-tag-noselect tagname next-p regexp-p))) ;;;###autoload (define-key esc-map "." 'find-tag) ;;;###autoload (defun find-tag-other-window (tagname &optional next-p regexp-p) "Find tag (in current tags table) whose name contains TAGNAME. Select the buffer containing the tag's definition in another window, and move point there. The default for TAGNAME is the expression in the buffer around or before point. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is negative (interactively, with prefix arg that is a negative number or just \\[negative-argument]), pop back to the previous tag gone to. See documentation of variable `tags-file-name'." (interactive (find-tag-interactive "Find tag other window: ")) ;; This hair is to deal with the case where the tag is found in the ;; selected window's buffer; without the hair, point is moved in both ;; windows. To prevent this, we save the selected window's point before ;; doing find-tag-noselect, and restore it after. (let* ((window-point (window-point (selected-window))) (tagbuf (find-tag-noselect tagname next-p regexp-p)) (tagpoint (progn (set-buffer tagbuf) (point)))) (set-window-point (prog1 (selected-window) (switch-to-buffer-other-window tagbuf) ;; We have to set this new window's point; it ;; might already have been displaying a ;; different portion of tagbuf, in which case ;; switch-to-buffer-other-window doesn't set ;; the window's point from the buffer. (set-window-point (selected-window) tagpoint)) window-point))) ;;;###autoload (define-key ctl-x-4-map "." 'find-tag-other-window) ;;;###autoload (defun find-tag-other-frame (tagname &optional next-p) "Find tag (in current tags table) whose name contains TAGNAME. Select the buffer containing the tag's definition in another frame, and move point there. The default for TAGNAME is the expression in the buffer around or before point. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is negative (interactively, with prefix arg that is a negative number or just \\[negative-argument]), pop back to the previous tag gone to. See documentation of variable `tags-file-name'." (interactive (find-tag-interactive "Find tag other frame: ")) (let ((pop-up-frames t)) (find-tag-other-window tagname next-p))) ;;;###autoload (define-key ctl-x-5-map "." 'find-tag-other-frame) ;;;###autoload (defun find-tag-regexp (regexp &optional next-p other-window) "Find tag (in current tags table) whose name matches REGEXP. Select the buffer containing the tag's definition and move point there. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is negative (interactively, with prefix arg that is a negative number or just \\[negative-argument]), pop back to the previous tag gone to. If third arg OTHER-WINDOW is non-nil, select the buffer in another window. See documentation of variable `tags-file-name'." (interactive (find-tag-interactive "Find tag regexp: " t)) ;; We go through find-tag-other-window to do all the display hair there. (funcall (if other-window 'find-tag-other-window 'find-tag) regexp next-p t)) ;;;###autoload (define-key esc-map [?\C-.] 'find-tag-regexp) ;; Internal tag finding function. ;; PATTERN is a string to pass to second arg SEARCH-FORWARD-FUNC, and to ;; any member of the function list ORDER (third arg). If ORDER is nil, ;; use saved state to continue a previous search. ;; Fourth arg MATCHING is a string, an English '-ing' word, to be used in ;; an error message. ;; Fifth arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match, ;; point should be moved to the next line. ;; Algorithm is as follows. For each qualifier-func in ORDER, go to ;; beginning of tags file, and perform inner loop: for each naive match for ;; PATTERN found using SEARCH-FORWARD-FUNC, qualify the naive match using ;; qualifier-func. If it qualifies, go to the specified line in the ;; specified source file and return. Qualified matches are remembered to ;; avoid repetition. State is saved so that the loop can be continued. (defun find-tag-in-order (pattern search-forward-func order next-line-after-failure-p matching first-search) (let (file ;name of file containing tag tag-info ;where to find the tag in FILE tags-table-file ;name of tags file (first-table t) (tag-order order) goto-func match-type ) (save-excursion (or first-search ;find-tag-noselect has already done it. (visit-tags-table-buffer 'same)) ;; Get a qualified match. (setq match-type (catch 'qualified-match-found ;; Iterate over the list of tags tables. (while (or first-table (visit-tags-table-buffer t)) (if first-search (setq tag-lines-already-matched nil)) (and first-search first-table ;; Start at beginning of tags file. (goto-char (point-min))) (or first-table (goto-char (point-min))) (setq first-table nil) (setq tags-table-file buffer-file-name) ;; Iterate over the list of ordering predicates. (while order (while (funcall search-forward-func pattern nil t) ;; Naive match found. Qualify the match. (and (funcall (car order) pattern) ;; Make sure it is not a previous qualified match. ;; Use of `memq' depends on numbers being eq. (not (memq (save-excursion (beginning-of-line) (point)) tag-lines-already-matched)) (throw 'qualified-match-found nil)) (if next-line-after-failure-p (forward-line 1))) ;; Try the next flavor of match. (setq order (cdr order)) (goto-char (point-min))) (setq order tag-order)) ;; We throw out on match, so only get here if there were no matches. (error "No %stags %s %s" (if first-search "" "more ") matching pattern))) ;; Found a tag; extract location info. (beginning-of-line) (setq tag-lines-already-matched (cons (point) tag-lines-already-matched)) ;; Expand the filename, using the tags table buffer's default-directory. (setq file (expand-file-name (file-of-tag)) tag-info (funcall snarf-tag-function)) ;; Get the local value in the tags table buffer before switching buffers. (setq goto-func goto-tag-location-function) ;; Find the right line in the specified file. (set-buffer (find-file-noselect file)) (widen) (push-mark) (if (eq match-type 'tag-filename-match-p) (goto-char (point-min)) (funcall goto-func tag-info)) ;; Return the buffer where the tag was found. (current-buffer)))) ;; `etags' TAGS file format support. ;; If the current buffer is a valid etags TAGS file, give it local values of ;; the tags table format variables, and return non-nil. (defun etags-recognize-tags-table () (and (etags-verify-tags-table) ;; It is annoying to flash messages on the screen briefly, ;; and this message is not useful. -- rms ;; (message "%s is an `etags' TAGS file" buffer-file-name) (mapcar (function (lambda (elt) (set (make-local-variable (car elt)) (cdr elt)))) '((file-of-tag-function . etags-file-of-tag) (tags-table-files-function . etags-tags-table-files) (tags-completion-table-function . etags-tags-completion-table) (snarf-tag-function . etags-snarf-tag) (goto-tag-location-function . etags-goto-tag-location) (find-tag-regexp-search-function . re-search-forward) (find-tag-regexp-tag-order . (tag-re-match-p)) (find-tag-regexp-next-line-after-failure-p . t) (find-tag-search-function . search-forward) (find-tag-tag-order . (tag-filename-match-p tag-exact-match-p tag-symbol-match-p tag-word-match-p tag-any-match-p)) (find-tag-file-order . (tag-filename-match-p)) (find-tag-next-line-after-failure-p . nil) (list-tags-function . etags-list-tags) (tags-apropos-function . etags-tags-apropos) (tags-included-tables-function . etags-tags-included-tables) (verify-tags-table-function . etags-verify-tags-table) )))) ;; Return non-nil iff the current buffer is a valid etags TAGS file. (defun etags-verify-tags-table () ;; Use eq instead of = in case char-after returns nil. (eq (char-after 1) ?\f)) (defun etags-file-of-tag () (save-excursion (if (looking-at "./") (re-search-forward "\\([^\n]+\\),[0-9]*\n") (re-search-backward "\f\n\\([^\n]+\\),[0-9]*\n")) (buffer-substring (match-beginning 1) (match-end 1)))) (defun etags-tags-completion-table () (let ((table (make-vector 511 0))) (save-excursion (goto-char (point-min)) ;; This monster regexp matches an etags tag line. ;; \1 is the string to match; ;; \2 is not interesting; ;; \3 is the guessed tag name; XXX guess should be better eg DEFUN ;; \4 is not interesting; ;; \5 is the explicitly-specified tag name. ;; \6 is the line to start searching at; ;; \7 is the char to start searching at. (while (re-search-forward "^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\ \[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\ \\([0-9]+\\)?,\\([0-9]+\\)?\n" nil t) (intern (if (match-beginning 5) ;; There is an explicit tag name. (buffer-substring (match-beginning 5) (match-end 5)) ;; No explicit tag name. Best guess. (buffer-substring (match-beginning 3) (match-end 3))) table))) table)) (defun etags-snarf-tag () (let (tag-text line startpos) (search-forward "\177") (setq tag-text (buffer-substring (1- (point)) (save-excursion (beginning-of-line) (point)))) ;; Skip explicit tag name if present. (search-forward "\001" (save-excursion (forward-line 1) (point)) t) (if (looking-at "[0-9]") (setq line (string-to-int (buffer-substring (point) (progn (skip-chars-forward "0-9") (point)))))) (search-forward ",") (if (looking-at "[0-9]") (setq startpos (string-to-int (buffer-substring (point) (progn (skip-chars-forward "0-9") (point)))))) ;; Leave point on the next line of the tags file. (forward-line 1) (cons tag-text (cons line startpos)))) ;; TAG-INFO is a cons (TEXT LINE . POSITION) where TEXT is the initial part ;; of a line containing the tag and POSITION is the character position of ;; TEXT within the file (starting from 1); LINE is the line number. Either ;; LINE or POSITION may be nil; POSITION is used if present. If the tag ;; isn't exactly at the given position then look around that position using ;; a search window which expands until it hits the start of file. (defun etags-goto-tag-location (tag-info) (let ((startpos (cdr (cdr tag-info))) ;; This constant is 1/2 the initial search window. ;; There is no sense in making it too small, ;; since just going around the loop once probably ;; costs about as much as searching 2000 chars. (offset 1000) (found nil) (pat (concat (if (eq selective-display t) "\\(^\\|\^m\\)" "^") (regexp-quote (car tag-info))))) ;; The character position in the tags table is 0-origin. ;; Convert it to a 1-origin Emacs character position. (if startpos (setq startpos (1+ startpos))) ;; If no char pos was given, try the given line number. (or startpos (if (car (cdr tag-info)) (setq startpos (progn (goto-line (car (cdr tag-info))) (point))))) (or startpos (setq startpos (point-min))) ;; First see if the tag is right at the specified location. (goto-char startpos) (setq found (looking-at pat)) (while (and (not found) (progn (goto-char (- startpos offset)) (not (bobp)))) (setq found (re-search-forward pat (+ startpos offset) t) offset (* 3 offset))) ; expand search window (or found (re-search-forward pat nil t) (error "Rerun etags: `%s' not found in %s" pat buffer-file-name))) ;; Position point at the right place ;; if the search string matched an extra Ctrl-m at the beginning. (and (eq selective-display t) (looking-at "\^m") (forward-char 1)) (beginning-of-line)) (defun etags-list-tags (file) (goto-char 1) (if (not (search-forward (concat "\f\n" file ",") nil t)) nil (forward-line 1) (while (not (or (eobp) (looking-at "\f"))) (let ((tag (buffer-substring (point) (progn (skip-chars-forward "^\177") (point))))) (princ (if (looking-at "[^\n]+\001") ;; There is an explicit tag name; use that. (buffer-substring (point) (progn (skip-chars-forward "^\001") (point))) tag))) (terpri) (forward-line 1)) t)) (defun etags-tags-apropos (string) (goto-char 1) (while (re-search-forward string nil t) (beginning-of-line) (princ (buffer-substring (point) (progn (skip-chars-forward "^\177") (point)))) (terpri) (forward-line 1))) (defun etags-tags-table-files () (let ((files nil) beg) (goto-char (point-min)) (while (search-forward "\f\n" nil t) (setq beg (point)) (end-of-line) (skip-chars-backward "^," beg) (or (looking-at "include$") ;; Expand in the default-directory of the tags table buffer. (setq files (cons (expand-file-name (buffer-substring beg (1- (point)))) files)))) (nreverse files))) (defun etags-tags-included-tables () (let ((files nil) beg) (goto-char (point-min)) (while (search-forward "\f\n" nil t) (setq beg (point)) (end-of-line) (skip-chars-backward "^," beg) (if (looking-at "include$") ;; Expand in the default-directory of the tags table buffer. (setq files (cons (expand-file-name (buffer-substring beg (1- (point)))) files)))) (nreverse files))) ;; Empty tags file support. ;; Recognize an empty file and give it local values of the tags table format ;; variables which do nothing. (defun recognize-empty-tags-table () (and (zerop (buffer-size)) (mapcar (function (lambda (sym) (set (make-local-variable sym) 'ignore))) '(tags-table-files-function tags-completion-table-function find-tag-regexp-search-function find-tag-search-function tags-apropos-function tags-included-tables-function)) (set (make-local-variable 'verify-tags-table-function) (function (lambda () (zerop (buffer-size))))))) ;;; Match qualifier functions for tagnames. ;;; XXX these functions assume etags file format. ;; This might be a neat idea, but it's too hairy at the moment. ;;(defmacro tags-with-syntax (&rest body) ;; (` (let ((current (current-buffer)) ;; (otable (syntax-table)) ;; (buffer (find-file-noselect (file-of-tag))) ;; table) ;; (unwind-protect ;; (progn ;; (set-buffer buffer) ;; (setq table (syntax-table)) ;; (set-buffer current) ;; (set-syntax-table table) ;; (,@ body)) ;; (set-syntax-table otable))))) ;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form)) ;; t if point is at a tag line that matches TAG exactly. ;; point should be just after a string that matches TAG. (defun tag-exact-match-p (tag) ;; The match is really exact if there is an explicit tag name. (or (and (eq (char-after (point)) ?\001) (eq (char-after (- (point) (length tag) 1)) ?\177)) ;; We are not on the explicit tag name, but perhaps it follows. (looking-at (concat "[^\177\n]*\177" (regexp-quote tag) "\001")))) ;; t if point is at a tag line that matches TAG as a symbol. ;; point should be just after a string that matches TAG. (defun tag-symbol-match-p (tag) (and (looking-at "\\Sw.*\177") (looking-at "\\S_.*\177") (save-excursion (backward-char (1+ (length tag))) (and (looking-at "\\Sw") (looking-at "\\S_"))))) ;; t if point is at a tag line that matches TAG as a word. ;; point should be just after a string that matches TAG. (defun tag-word-match-p (tag) (and (looking-at "\\b.*\177") (save-excursion (backward-char (1+ (length tag))) (looking-at "\\b")))) (defun tag-filename-match-p (tag) (and (looking-at ",") (save-excursion (backward-char (1+ (length tag))) (looking-at "\\b")))) ;; t if point is in a tag line with a tag containing TAG as a substring. (defun tag-any-match-p (tag) (looking-at ".*\177")) ;; t if point is at a tag line that matches RE as a regexp. (defun tag-re-match-p (re) (save-excursion (beginning-of-line) (let ((bol (point))) (and (search-forward "\177" (save-excursion (end-of-line) (point)) t) (re-search-backward re bol t))))) ;;;###autoload (defun next-file (&optional initialize novisit) "Select next file among files in current tags table. A first argument of t (prefix arg, if interactive) initializes to the beginning of the list of files in the tags table. If the argument is neither nil nor t, it is evalled to initialize the list of files. Non-nil second argument NOVISIT means use a temporary buffer to save time and avoid uninteresting warnings. Value is nil if the file was already visited; if the file was newly read in, the value is the filename." ;; Make the interactive arg t if there was any prefix arg. (interactive (list (if current-prefix-arg t))) (cond ((not initialize) ;; Not the first run. ) ((eq initialize t) ;; Initialize the list from the tags table. (save-excursion ;; Visit the tags table buffer to get its list of files. (visit-tags-table-buffer) ;; Copy the list so we can setcdr below. (setq next-file-list (copy-sequence (tags-table-files))) ;; Iterate over all the tags table files, collecting ;; a complete list of referenced file names. (while (visit-tags-table-buffer t) ;; Find the tail of the working list and chain on the new ;; sublist for this tags table. (let ((tail next-file-list)) (while (cdr tail) (setq tail (cdr tail))) ;; Use a copy so the next loop iteration will not modify the ;; list later returned by (tags-table-files). (if tail (setcdr tail (copy-sequence (tags-table-files))) (setq next-file-list (copy-sequence (tags-table-files)))))))) (t ;; Initialize the list by evalling the argument. (setq next-file-list (eval initialize)))) (if next-file-list () (and novisit (get-buffer " *next-file*") (kill-buffer " *next-file*")) (error "All files processed.")) (let* ((next (car next-file-list)) (new (not (get-file-buffer next)))) ;; Advance the list before trying to find the file. ;; If we get an error finding the file, don't get stuck on it. (setq next-file-list (cdr next-file-list)) (if (not (and new novisit)) (set-buffer (find-file-noselect next novisit)) ;; Like find-file, but avoids random warning messages. (set-buffer (get-buffer-create " *next-file*")) (kill-all-local-variables) (erase-buffer) (setq new next) (insert-file-contents new nil)) new)) (defvar tags-loop-operate nil "Form for `tags-loop-continue' to eval to change one file.") (defvar tags-loop-scan '(error (substitute-command-keys "No \\[tags-search] or \\[tags-query-replace] in progress.")) "Form for `tags-loop-continue' to eval to scan one file. If it returns non-nil, this file needs processing by evalling \`tags-loop-operate'. Otherwise, move on to the next file.") ;;;###autoload (defun tags-loop-continue (&optional first-time) "Continue last \\[tags-search] or \\[tags-query-replace] command. Used noninteractively with non-nil argument to begin such a command (the argument is passed to `next-file', which see). Two variables control the processing we do on each file: the value of `tags-loop-scan' is a form to be executed on each file to see if it is interesting (it returns non-nil if so) and `tags-loop-operate' is a form to evaluate to operate on an interesting file. If the latter evaluates to nil, we exit; otherwise we scan the next file." (interactive) (let (new (messaged nil)) (while (progn ;; Scan files quickly for the first or next interesting one. (while (or first-time (save-restriction (widen) (not (eval tags-loop-scan)))) (setq new (next-file first-time t)) ;; If NEW is non-nil, we got a temp buffer, ;; and NEW is the file name. (if (or messaged (and (not first-time) (> baud-rate search-slow-speed) (setq messaged t))) (message "Scanning file %s..." (or new buffer-file-name))) (setq first-time nil) (goto-char (point-min))) ;; If we visited it in a temp buffer, visit it now for real. (if new (let ((pos (point))) (erase-buffer) (set-buffer (find-file-noselect new)) (setq new nil) ;No longer in a temp buffer. (widen) (goto-char pos))) (switch-to-buffer (current-buffer)) ;; Now operate on the file. ;; If value is non-nil, continue to scan the next file. (eval tags-loop-operate))) (and messaged (null tags-loop-operate) (message "Scanning file %s...found" buffer-file-name)))) ;;;###autoload (define-key esc-map "," 'tags-loop-continue) ;;;###autoload (defun tags-search (regexp &optional file-list-form) "Search through all files listed in tags table for match for REGEXP. Stops when a match is found. To continue searching for next match, use command \\[tags-loop-continue]. See documentation of variable `tags-file-name'." (interactive "sTags search (regexp): ") (if (and (equal regexp "") (eq (car tags-loop-scan) 're-search-forward) (null tags-loop-operate)) ;; Continue last tags-search as if by M-,. (tags-loop-continue nil) (setq tags-loop-scan (list 're-search-forward (list 'quote regexp) nil t) tags-loop-operate nil) (tags-loop-continue (or file-list-form t)))) ;;;###autoload (defun tags-query-replace (from to &optional delimited file-list-form) "Query-replace-regexp FROM with TO through all files listed in tags table. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace with the command \\[tags-loop-continue]. See documentation of variable `tags-file-name'." (interactive (query-replace-read-args "Tags query replace (regexp)" t)) (setq tags-loop-scan (list 'prog1 (list 'if (list 're-search-forward (list 'quote from) nil t) ;; When we find a match, move back ;; to the beginning of it so perform-replace ;; will see it. '(goto-char (match-beginning 0)))) tags-loop-operate (list 'perform-replace (list 'quote from) (list 'quote to) t t (list 'quote delimited))) (tags-loop-continue (or file-list-form t))) ;;;###autoload (defun list-tags (filename &optional next-match) "Gives the list of functions available in file \"filename\" Searches only in \"tags-file-name\"." (interactive "sFunctions in File: ") (let (file-list) (setq file-list (tags-locate-file-in-tags-table filename (if next-match next-match nil))) (if file-list (tags-list-functions-in-file (nth 1 (car file-list)) (nth 2 (car file-list))) (message (format "%s not found in tags table" filename))))) ;;;###autoload (defun tags-apropos (regexp) "Display list of all tags in tags table REGEXP matches." (interactive "sTags apropos (regexp): ") (with-output-to-temp-buffer "*Tags List*" (princ "Tags matching regexp ") (prin1 regexp) (terpri) (save-excursion (let ((first-time t)) (while (visit-tags-table-buffer (not first-time)) (setq first-time nil) (funcall tags-apropos-function regexp)))))) ;;; XXX Kludge interface. ;; XXX If a file is in multiple tables, selection may get the wrong one. ;;;###autoload (defun select-tags-table () "Select a tags table file from a menu of those you have already used. The list of tags tables to select from is stored in `tags-table-set-list'; see the doc of that variable if you want to add names to the list." (interactive) (pop-to-buffer "*Tags Table List*") (setq buffer-read-only nil) (erase-buffer) (let ((set-list tags-table-set-list) (desired-point nil)) (if tags-table-list (progn (setq desired-point (point-marker)) (princ tags-table-list (current-buffer)) (insert "\C-m") (prin1 (car tags-table-list) (current-buffer)) ;invisible (insert "\n"))) (while set-list (if (eq (car set-list) tags-table-list) ;; Already printed it. () (princ (car set-list) (current-buffer)) (insert "\C-m") (prin1 (car (car set-list)) (current-buffer)) ;invisible (insert "\n")) (setq set-list (cdr set-list))) (if tags-file-name (progn (or desired-point (setq desired-point (point-marker))) (insert tags-file-name "\C-m") (prin1 tags-file-name (current-buffer)) ;invisible (insert "\n"))) (setq set-list (delete tags-file-name (apply 'nconc (cons (copy-sequence tags-table-list) (mapcar 'copy-sequence tags-table-set-list))))) (while set-list (insert (car set-list) "\C-m") (prin1 (car set-list) (current-buffer)) ;invisible (insert "\n") (setq set-list (delete (car set-list) set-list))) (goto-char 1) (insert-before-markers "Type `t' to select a tags table or set of tags tables:\n\n") (if desired-point (goto-char desired-point)) (set-window-start (selected-window) 1 t)) (set-buffer-modified-p nil) (select-tags-table-mode)) (defvar select-tags-table-mode-map) (let ((map (make-sparse-keymap))) (define-key map "t" 'select-tags-table-select) (define-key map " " 'next-line) (define-key map "\^?" 'previous-line) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) (define-key map "q" 'select-tags-table-quit) (setq select-tags-table-mode-map map)) (defun select-tags-table-mode () "Major mode for choosing a current tags table among those already loaded. \\{select-tags-table-mode-map}" (interactive) (kill-all-local-variables) (setq buffer-read-only t major-mode 'select-tags-table-mode mode-name "Select Tags Table") (use-local-map select-tags-table-mode-map) (setq selective-display t selective-display-ellipses nil)) (defun select-tags-table-select () "Select the tags table named on this line." (interactive) (search-forward "\C-m") (let ((name (read (current-buffer)))) (visit-tags-table name) (select-tags-table-quit) (message "Tags table now %s" name))) (defun select-tags-table-quit () "Kill the buffer and delete the selected window." (interactive) (kill-buffer (current-buffer)) (or (one-window-p) (delete-window))) ;;;###autoload (defun complete-tag () "Perform tags completion on the text around point. Completes to the set of names listed in the current tags table. The string to complete is chosen in the same way as the default for \\[find-tag] (which see)." (interactive) (or tags-table-list tags-file-name (error (substitute-command-keys "No tags table loaded. Try \\[visit-tags-table]."))) (let ((pattern (funcall (or find-tag-default-function (get major-mode 'find-tag-default-function) 'find-tag-default))) beg completion) (or pattern (error "Nothing to complete")) (search-backward pattern) (setq beg (point)) (forward-char (length pattern)) (setq completion (try-completion pattern 'tags-complete-tag nil)) (cond ((eq completion t)) ((null completion) (message "Can't find completion for \"%s\"" pattern) (ding)) ((not (string= pattern completion)) (delete-region beg (point)) (insert completion)) (t (message "Making completion list...") (with-output-to-temp-buffer "*Completions*" (display-completion-list (all-completions pattern 'tags-complete-tag nil))) (message "Making completion list...%s" "done"))))) ;;;###autoload (define-key esc-map "\t" 'complete-tag) (defun tags-list-functions-in-file (pos tag-file) "Lists the functions for the given file. Backend for `list-tags'." (let ((tag-buf (find-file-noselect tag-file)) (result-buf (get-buffer-create "*Tags Function List*")) function beg map) (save-excursion (set-buffer result-buf) (erase-buffer) (set-buffer tag-buf) (goto-char pos) (forward-line 1) (beginning-of-line) ; C-l marks end of information of a file in TAGS. (while (and (not (looking-at "^\C-l")) (not (eobp))) ; skip mere #defines, typedefs and struct definitions (if (not (or (looking-at "^#define\\s-+[a-zA-Z0-9_]+\\s-+") (looking-at "^typedef\\s-+") (looking-at "^\\s-*}"))) (progn (setq beg (point)) (skip-chars-forward "^\C-?(") (setq function (buffer-substring beg (point))) (save-excursion (set-buffer result-buf) (insert (concat function "\n"))))) (forward-line 1) (beginning-of-line))) (switch-to-buffer "*Tags Function List*") (goto-char 1) (set-buffer-modified-p nil) (setq buffer-read-only t))) (defun tags-locate-file-in-tags-table (filename first-search) "This function is used to locate `filename' in `tags-table-list'. Its internally used by the functions `find-file-from-tags' and `tags-list-tags-in-file'. If `first-search' is t, search continues from where it left off last time. Else, its a fresh search." (let (tag-list current-tags-buffer beg file found-file-list next-tag-file) (setq tag-list tags-table-list) (catch 'found-file (setq found-file-list nil next-tag-file nil) (while tag-list (setq current-tags-buffer (find-file-noselect (car tag-list))) (save-excursion (set-buffer current-tags-buffer) (if (or next-tag-file (not first-search)) (goto-char (point-min))) (if (search-forward filename nil t) (if (tag-filename-match-p filename) (progn (beginning-of-line) (setq beg (point)) (skip-chars-forward "^,") (or (looking-at ",include$") (setq file (expand-file-name (buffer-substring beg (point))))) (if (string-match filename (file-name-nondirectory file)) (progn (setq found-file-list (cons (list file (point) (buffer-file-name)) found-file-list)) (throw 'found-file found-file-list)))))) (setq tag-list (cdr tag-list)) (setq next-tag-file 't))) (throw 'found-file found-file-list)))) (provide 'etags) ;;; etags.el ends here emacs-19.30/lisp/eval-reg.el100444 12120 1 17633 5731737417 14143 0ustar rmsdaemon;;; eval-reg.el --- Redefine eval-region, and subrs that use it, in Lisp ;; Copyright (C) 1994 Daniel LaLiberte ;; Author: Daniel LaLiberte ;; Keywords: lisp ;; 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: ;;; eval-region, eval-buffer, and eval-current-buffer are redefined in ;;; Lisp to allow customizations by Lisp code. eval-region calls ;;; `read', `eval', and `prin1', so Lisp replacements of these ;;; functions will affect eval-region and anything else that calls it. ;;; eval-buffer and eval-current-buffer are redefined in Lisp to call ;;; eval-region on the buffer. ;;; Because of dynamic binding, all local variables are protected from ;;; being seen by eval by giving them funky names. But variables in ;;; routines that call eval-region are similarly exposed. ;;; Perhaps this should be one of several files in an `elisp' package ;;; that replaces Emacs Lisp subroutines with Lisp versions of the ;;; same. ;;; Eval-region may be installed, after loading, by calling: ;;; (elisp-eval-region-install). Installation can be undone with: ;;; (elisp-eval-region-uninstall). '(defpackage "elisp-eval-region" (:nicknames "elisp") (:use "elisp") (:export elisp-eval-region-install elisp-eval-region-uninstall elisp-eval-region-level with-elisp-eval-region eval-region eval-buffer eval-current-buffer )) '(in-package elisp-eval-region) ;; Save standard versions. (if (not (fboundp 'original-eval-region)) (defalias 'original-eval-region (symbol-function 'eval-region))) (if (not (fboundp 'original-eval-buffer)) (defalias 'original-eval-buffer (if (fboundp 'eval-buffer) ;; only in Emacs 19 (symbol-function 'eval-buffer) 'undefined))) (if (not (fboundp 'original-eval-current-buffer)) (defalias 'original-eval-current-buffer (symbol-function 'eval-current-buffer))) (defvar elisp-eval-region-level 0 "If the value is 0, use the original version of `elisp-eval-region'. Callers of `elisp-eval-region' should increment `elisp-eval-region-level' while the Lisp version should be used. Installing `elisp-eval-region' increments it once, and uninstalling decrements it.") ;; Installing and uninstalling should always be used in pairs, ;; or just install once and never uninstall. (defun elisp-eval-region-install () (interactive) (defalias 'eval-region 'elisp-eval-region) (defalias 'eval-buffer 'elisp-eval-buffer) (defalias 'eval-current-buffer 'elisp-eval-current-buffer) (setq elisp-eval-region-level (1+ elisp-eval-region-level))) (defun elisp-eval-region-uninstall () (interactive) (if (> 1 elisp-eval-region-level) (setq elisp-eval-region-level (1- elisp-eval-region-level)) (setq elisp-eval-region-level 0) (defalias 'eval-region (symbol-function 'original-eval-region)) (defalias 'eval-buffer (symbol-function 'original-eval-buffer)) (defalias 'eval-current-buffer (symbol-function 'original-eval-current-buffer)) )) (put 'with-elisp-eval-region 'lisp-indent-function 1) (put 'with-elisp-eval-region 'lisp-indent-hook 1) (put 'with-elisp-eval-region 'edebug-form-spec t) (defmacro with-elisp-eval-region (flag &rest body) "If FLAG is nil, decrement `eval-region-level' while executing BODY. The effect of decrementing all the way to zero is that `eval-region' will use the original `eval-region', which may be the Emacs subr or some previous redefinition. Before calling this macro, this package should already have been installed, using `elisp-eval-region-install', which increments the count once. So if another package still requires the Lisp version of the code, the count will still be non-zero. The count is not bound locally by this macro, so changes by BODY to its value will not be lost." (` (let ((elisp-code (function (lambda () (,@ body))))) (if (not (, flag)) (unwind-protect (progn (setq elisp-eval-region-level (1- elisp-eval-region-level)) (funcall elisp-code)) (setq elisp-eval-region-level (1+ elisp-eval-region-level))) (funcall elisp-code))))) (defun elisp-eval-region (elisp-start elisp-end &optional elisp-output) "Execute the region as Lisp code. When called from programs, expects two arguments, giving starting and ending indices in the current buffer of the text to be executed. Programs can pass third argument PRINTFLAG which controls printing of output: nil means discard it; anything else is stream for print. This version, from `eval-reg.el', allows Lisp customization of read, eval, and the printer." ;; Because this doesnt narrow to the region, one other difference ;; concerns inserting whitespace after the expression being evaluated. (interactive "r") (if (= 0 elisp-eval-region-level) (original-eval-region elisp-start elisp-end elisp-output) (let ((elisp-pnt (point)) (elisp-buf (current-buffer));; Outside buffer (elisp-inside-buf (current-buffer));; Buffer current while evaling ;; Mark the end because it may move. (elisp-end-marker (set-marker (make-marker) elisp-end)) elisp-form elisp-val) (goto-char elisp-start) (elisp-skip-whitespace) (while (< (point) elisp-end-marker) (setq elisp-form (read elisp-buf)) (let ((elisp-current-buffer (current-buffer))) ;; Restore the inside current-buffer. (set-buffer elisp-inside-buf) (setq elisp-val (eval elisp-form)) ;; Remember current buffer for next time. (setq elisp-inside-buf (current-buffer)) ;; Should this be protected? (set-buffer elisp-current-buffer)) (if elisp-output (let ((standard-output (or elisp-output t))) (setq values (cons elisp-val values)) (if (eq standard-output t) (prin1 elisp-val) (princ "\n") (prin1 elisp-val) (princ "\n") ))) (goto-char (min (max elisp-end-marker (point)) (progn (elisp-skip-whitespace) (point)))) ) ; while (if elisp-output nil ;; like save-excursion recovery, but done only if no error occurs ;; but mark is not restored (set-buffer elisp-buf) (goto-char elisp-pnt)) nil))) (defun elisp-skip-whitespace () ;; Leave point before the next token, skipping white space and comments. (skip-chars-forward " \t\r\n\f") (while (= (following-char) ?\;) (skip-chars-forward "^\n\r") ; skip the comment (skip-chars-forward " \t\r\n\f"))) (defun elisp-eval-current-buffer (&optional elisp-output) "Execute the current buffer as Lisp code. Programs can pass argument PRINTFLAG which controls printing of output: nil means discard it; anything else is stream for print. This version calls `eval-region' on the whole buffer." ;; The standard eval-current-buffer doesn't use eval-region. (interactive) (eval-region (point-min) (point-max) elisp-output)) (defun elisp-eval-buffer (&optional elisp-bufname elisp-printflag) "Execute BUFFER as Lisp code. Use current buffer if BUFFER is nil. Programs can pass argument PRINTFLAG which controls printing of output: nil means discard it; anything else is stream for print. This version calls `eval-region' on the whole buffer." (interactive) (if (null elisp-bufname) (setq elisp-bufname (current-buffer))) (save-excursion (set-buffer (or (get-buffer elisp-bufname) (error "No such buffer: %s" elisp-bufname))) (eval-region (point-min) (point-max) elisp-printflag))) (provide 'eval-reg) ;;; eval-reg.el ends here emacs-19.30/lisp/executable.el100444 12120 1 20770 6017437303 14543 0ustar rmsdaemon;;; executable.el --- base functionality for executable interpreter scripts ;; Copyright (C) 1994, 1995 by Free Software Foundation, Inc. ;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 ;; Keywords: languages, unix ;; 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: ;; executable.el is used by certain major modes to insert a suitable ;; #! line at the beginning of the file, if the file does not already ;; have one. ;; This is support code for the likes of sh-, awk-, perl-, tcl- or ;; makefile-mode. Those mode-setting commands can call the like of ;; `(executable-set-magic "sh")' or `(executable-set-magic "perl" "-f")'. ;; Unless the file name matches `executable-magicless-file-regexp' this will ;; search $PATH if the given interpreter isn't absolute, and then insert a ;; first line like `#! /bin/sh' or `#! /usr/local/bin/perl -f'. ;; Also it makes the file executable as soon as it's saved, if it wasn't. ;;; Code: (defvar executable-insert 'not-modified "*What to do when newly found file has no or wrong magic number: nil do nothing t insert or update magic number other insert or update magic number, but mark as unmodified. When the insertion is marked as unmodified, you can save it with \\[write-file] RET. This variable is used when `executable-set-magic' is called as a function, e.g. when Emacs sets some Un*x interpreter script mode. With \\[executable-set-magic], this is always treated as if it were `t'.") (defvar executable-query 'function "*If non-`nil', ask user before inserting or changing magic number. When this is `function', only ask when called non-interactively.") (defvar executable-magicless-file-regexp "/[Mm]akefile$\\|/\\.\\(z?profile\\|bash_profile\\|z?login\\|bash_login\\|z?logout\\|bash_logout\\|.+shrc\\|esrc\\|rcrc\\|[kz]shenv\\)$" "*On files with this kind of name no magic is inserted or changed.") (defvar executable-prefix "#! " "*Interpreter magic number prefix inserted when there was no magic number.") (defvar executable-chmod 73 "*After saving, if the file is not executable, set this mode. This mode passed to `set-file-modes' is taken absolutely when negative, or relative to the files existing modes. Do nothing if this is nil. Typical values are 73 (+x) or -493 (rwxr-xr-x).") (defvar executable-command nil) ;; Autoload cookie deleted here because it made loaddefs.el fail to load. ;; -rms (or (assoc "tail" interpreter-mode-alist) (nconc interpreter-mode-alist '(("tail" . text-mode) ("more" . text-mode) ("less" . text-mode) ("pg" . text-mode)))) (defvar executable-self-display "tail" "*Command you use with argument `+2' to make text files self-display. Note that the like of `more' doesn't work too well under Emacs \\[shell].") (defvar executable-font-lock-keywords '(("\\`#!.*/\\([^ \t\n]+\\)" 1 font-lock-keyword-face t)) "*Rules for highlighting executable scripts' magic number. This can be included in `font-lock-keywords' by modes that call `executable'.") (defvar executable-error-regexp-alist '(;; /bin/xyz: syntax error at line 14: `(' unexpected ;; /bin/xyz[5]: syntax error at line 8 : ``' unmatched ("^\\(.*[^[/]\\)\\(\\[[0-9]+\\]\\)?: .* error .* line \\([0-9]+\\)" 1 3) ;; /bin/xyz[27]: ehco: not found ("^\\(.*[^/]\\)\\[\\([0-9]+\\)\\]: .*: " 1 2) ;; /bin/xyz: syntax error near unexpected token `)' ;; /bin/xyz: /bin/xyz: line 2: `)' ("^\\(.*[^/]\\): [^0-9\n]+\n\\1: \\1: line \\([0-9]+\\):" 1 2) ;; /usr/bin/awk: syntax error at line 5 of file /bin/xyz (" error .* line \\([0-9]+\\) of file \\(.+\\)$" 2 1) ;; /usr/bin/awk: calling undefined function toto ;; input record number 3, file awktestdata ;; source line 4 of file /bin/xyz ("^[^ ].+\n\\( .+\n\\)* line \\([0-9]+\\) of file \\(.+\\)$" 3 2) ;; makefile:1: *** target pattern contains no `%'. Stop. ("^\\(.+\\):\\([0-9]+\\): " 1 2)) "Alist of regexps used to match script errors. See `compilation-error-regexp-alist'.") ;; The C function openp() slightly modified would do the trick fine (defun executable (command) "If COMMAND is an executable in $PATH its full name is returned. Else nil." (let ((list exec-path) path) (while list (setq list (if (and (setq path (expand-file-name command (car list))) (file-executable-p path) (not (file-directory-p path))) nil (setq path nil) (cdr list)))) path)) (defun executable-chmod () "This gets called after saving a file to assure that it be executable. You can set the absolute or relative mode in variable `executable-chmod' for non-executable files." (and executable-chmod buffer-file-name (or (file-executable-p buffer-file-name) (set-file-modes buffer-file-name (if (< executable-chmod 0) (- executable-chmod) (logior executable-chmod (file-modes buffer-file-name))))))) (defun executable-interpret (command) "Run script with user-specified args, and collect output in a buffer. While script runs asynchronously, you can use the \\[next-error] command to find the next error." (interactive (list (read-string "Run script: " (or executable-command buffer-file-name)))) (require 'compile) (save-some-buffers (not compilation-ask-about-save)) (make-local-variable 'executable-command) (compile-internal (setq executable-command command) "No more errors." "Interpretation" ;; Give it a simpler regexp to match. nil executable-error-regexp-alist)) ;;;###autoload (defun executable-set-magic (interpreter &optional argument) "Set this buffer's interpreter to INTERPRETER with optional ARGUMENT. The variables `executable-magicless-file-regexp', `executable-prefix', `executable-insert', `executable-query' and `executable-chmod' control when and how magic numbers are inserted or replaced and scripts made executable." (interactive "sName or path of interpreter: \nsArgument for %s: ") (setq interpreter (if (file-name-absolute-p interpreter) interpreter (or (executable interpreter) (error "Cannot find %s." interpreter))) argument (concat interpreter (and argument (string< "" argument) " ") argument)) (or buffer-read-only (if buffer-file-name (string-match executable-magicless-file-regexp buffer-file-name)) (not (or (eq this-command 'executable-set-magic) executable-insert)) (> (point-min) 1) (let ((point (point-marker)) (buffer-modified-p (buffer-modified-p))) (goto-char (point-min)) (make-local-hook 'after-save-hook) (add-hook 'after-save-hook 'executable-chmod nil t) (if (looking-at "#![ \t]*\\(.*\\)$") (and (goto-char (match-beginning 1)) (not (string= argument (buffer-substring (point) (match-end 1)))) (save-window-excursion ;; make buffer visible before question or message (switch-to-buffer (current-buffer)) (if (or (not executable-query) (and (eq executable-query 'function) (eq this-command 'executable-set-magic))) (message "%s Magic number ``%s'' replaced." this-command (buffer-substring (point-min) (match-end 1))) (y-or-n-p (concat "Replace magic number by ``" executable-prefix argument "''? ")))) (not (delete-region (point) (match-end 1))) (insert argument)) (insert executable-prefix argument ?\n)) (or (< (marker-position point) (point)) (goto-char point)) (or (eq this-command 'executable-set-magic)) (eq executable-insert t) (set-buffer-modified-p buffer-modified-p))) interpreter) ;;;###autoload (defun executable-self-display () "Turn a text file into a self-displaying Un*x command. The magic number of such a command displays all lines but itself." (interactive) (if (eq this-command 'executable-self-display) (setq this-command 'executable-set-magic)) (executable-set-magic executable-self-display "+2")) (provide 'executable) ;; executable.el ends here emacs-19.30/lisp/f90.el100444 12120 1 205411 6045202404 13026 0ustar rmsdaemon;;; f90.el --- Fortran-90 mode (free format) ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Torbj\"orn Einarsson ;; Created: Sep. 21, 1995 ;; Keywords: fortran, f90, languages ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Smart mode for editing F90 programs in FREE FORMAT. ;; Knows about continuation lines, named structured statements, and other ;; new features in F90 including HPF (High Performance Fortran) structures. ;; The basic feature is to provide an accurate indentation of F90 programs. ;; In addition, there are many more features like automatic matching of all ;; end statements, an auto-fill function to break long lines, a join-lines ;; function which joins continued lines etc etc. ;; To facilitate typing, a fairly complete list of abbreviations is provided. ;; For example, `i is short-hand for integer (if abbrev-mode is on). ;; There are two separate features for highlighting the code. ;; 1) Upcasing or capitalizing of all keywords. ;; 2) Colors/fonts using font-lock-mode. (only when using X-windows) ;; Automatic upcase of downcase of keywords is controlled by the parameter ;; f90-auto-keyword-case. ;; The indentations of lines starting with ! is determined by the first of the ;; following matches (the values in the left column are the default values): ;; start-string/regexp indent variable holding start-string/regexp ;; !!! 0 ;; !hpf\\$ (re) 0 f90-directive-comment-re ;; !!$ 0 f90-comment-region ;; ! (re) as code f90-indented-comment-re ;; default comment-column ;; Ex: Here is the result of 3 different settings of f90-indented-comment-re ;; f90-indented-comment-re !-indentation !!-indentation ;; ! as code as code ;; !! comment-column as code ;; ![^!] as code comment-column ;; Trailing comments are indented to comment-column with indent-for-comment M-; ;; f90-comment-region (C-c;) toggles insertion of f90-comment-region in region. ;; One common convention for free vs. fixed format is that free-format files ;; have the ending .f90 while the fixed format files have the ending .f. ;; To make f90-mode work, put this file in, for example, your directory ;; ~/lisp, and be sure that you have the following in your .emacs-file ;; (setq load-path (append load-path '("~/lisp"))) ;; (autoload 'f90-mode "f90" ;; "Major mode for editing Fortran 90 code in free format." t) ;; (setq auto-mode-alist (append auto-mode-alist ;; (list '("\\.f90$" . f90-mode)))) ;; Once you have entered f90-mode, you may get more info by using ;; the command describe-mode (C-h m). For online help describing various ;; functions use C-h f ;; To customize the f90-mode for your taste, use, for example: ;; (you don't have to specify values for all the parameters below) ;;(setq f90-mode-hook ;; '(lambda () (setq f90-do-indent 3 ;; f90-if-indent 3 ;; f90-type-indent 3 ;; f90-program-indent 2 ;; f90-continuation-indent 5 ;; f90-comment-region "!!$" ;; f90-directive-comment-re "!hpf\\$" ;; f90-indented-comment-re "!" ;; f90-break-delimiters "[-+\\*/,><=% \t]" ;; f90-break-before-delimiters t ;; f90-beginning-ampersand t ;; f90-smart-end 'blink ;; f90-auto-keyword-case nil ;; f90-leave-line-no nil ;; f90-startup-message t ;; indent-tabs-mode nil ;; ) ;; ;;The rest is not default. ;; (abbrev-mode 1) ; turn on abbreviation mode ;; (f90-auto-fill-mode 1) ; turn on auto-filling ;; (turn-on-font-lock) ; for highlighting ;; (if f90-auto-keyword-case ; change case of all keywords on startup ;; (f90-change-keywords f90-auto-keyword-case)) ;; )) ;; in your .emacs file (the shown values are the defaults). You can also ;; change the values of the lists f90-keywords etc. ;; The auto-fill and abbreviation minor modes are accessible from the menu, ;; or by using M-x f90-auto-fill-mode and M-x abbrev-mode, respectively. ;; Remarks ;; 1) Line numbers are by default left-justified. If f90-leave-line-no is ;; non-nil, the line numbers are never touched. ;; 2) Multi-; statements like > do i=1,20 ; j=j+i ; end do < are not handled ;; correctly, but I imagine them to be rare. ;; 3) Regexps for hilit19 are no longer supported. ;; 4) For FIXED FORMAT code, use the ordinary fortran mode. ;; 5) This mode does not work under emacs-18.x. ;; 6) Preprocessor directives, i.e., lines starting with # are left-justified ;; and are untouched by all case-changing commands. There is, at present, no ;; mechanism for treating multi-line directives (continued by \ ). ;; 7) f77 do-loops do 10 i=.. ; ; 10 continue are not correctly indented. ;; You are urged to use f90-do loops (with labels if you wish). ;; List of user commands ;; f90-previous-statement f90-next-statement ;; f90-beginning-of-subprogram f90-end-of-subprogram f90-mark-subprogram ;; f90-comment-region ;; f90-indent-line f90-indent-new-line ;; f90-indent-region (can be called by calling indent-region) ;; f90-indent-subprogram ;; f90-break-line f90-join-lines ;; f90-auto-fill-mode ;; f90-fill-region ;; f90-insert-end ;; f90-upcase-keywords f90-upcase-region-keywords ;; f90-downcase-keywords f90-downcase-region-keywords ;; f90-capitalize-keywords f90-capitalize-region-keywords ;; Thanks to all the people who have tested the mode. Special thanks to Jens ;; Bloch Helmers for encouraging me to write this code, for creative ;; suggestions as well as for the lists of hpf-commands. ;; Also thanks to the authors of the fortran and pascal modes, on which some ;; of this code is built. ;;; Code: (defconst bug-f90-mode "T.Einarsson@clab.ericsson.se" "Address of mailing list for F90 mode bugs.") ;; User options (defvar f90-do-indent 3 "*Extra indentation applied to DO blocks.") (defvar f90-if-indent 3 "*Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks.") (defvar f90-type-indent 3 "*Extra indentation applied to TYPE, INTERFACE and BLOCK DATA blocks.") (defvar f90-program-indent 2 "*Extra indentation applied to PROGRAM/MODULE/SUBROUTINE/FUNCTION blocks.") (defvar f90-continuation-indent 5 "*Extra indentation applied to F90 continuation lines.") (defvar f90-comment-region "!!$" "*String inserted by \\[f90-comment-region]\ at start of each line in region.") (defvar f90-indented-comment-re "!" "*Regexp saying which comments to be indented like code.") (defvar f90-directive-comment-re "!hpf\\$" "*Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented.") (defvar f90-beginning-ampersand t "*t makes automatic insertion of \& at beginning of continuation line.") (defvar f90-smart-end 'blink "*From an END statement, check and fill the end using matching block start. Allowed values are 'blink, 'no-blink, and nil, which determine whether to blink the matching beginning.") (defvar f90-break-delimiters "[-+\\*/><=,% \t]" "*Regexp holding list of delimiters at which lines may be broken.") (defvar f90-break-before-delimiters t "*Non-nil causes `f90-do-auto-fill' to break lines before delimiters.") (defvar f90-auto-keyword-case nil "*Automatic case conversion of keywords. The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil") (defvar f90-leave-line-no nil "*If nil, left-justify linenumbers.") (defvar f90-startup-message t "*Non-nil displays a startup message when F90 mode is first called.") (defconst f90-keywords-re ;;("allocate" "allocatable" "assign" "assignment" "backspace" "block" ;;"call" "case" "character" "close" "common" "complex" "contains" ;;"continue" "cycle" "data" "deallocate" "dimension" "do" "double" "else" ;;"elseif" "elsewhere" "end" "enddo" "endfile" "endif" "entry" "equivalence" ;;"exit" "external" "forall" "format" "function" "goto" "if" "implicit" ;;"include" "inquire" "integer" "intent" "interface" "intrinsic" "logical" ;;"module" "namelist" "none" "nullify" "only" "open" "optional" "parameter" ;;"pause" "pointer" "precision" "print" "private" "procedure" "program" ;;"public" "read" "real" "recursive" "return" "rewind" "save" "select" ;;"sequence" "stop" "subroutine" "target" "then" "type" "use" "where" ;;"while" "write") (concat "\\<\\(a\\(llocat\\(able\\|e\\)\\|ssign\\(\\|ment\\)\\)\\|b\\(ackspace\\|" "lock\\)\\|c\\(a\\(ll\\|se\\)\\|haracter\\|lose\\|o\\(m\\(mon\\|plex\\)\\|" "nt\\(ains\\|inue\\)\\)\\|ycle\\)\\|d\\(ata\\|eallocate\\|imension\\|" "o\\(\\|uble\\)\\)\\|e\\(lse\\(\\|if\\|where\\)\\|n\\(d\\(\\|do\\|file\\|" "if\\)\\|try\\)\\|quivalence\\|x\\(it\\|ternal\\)\\)\\|f\\(or\\(all\\|" "mat\\)\\|unction\\)\\|goto\\|i\\(f\\|mplicit\\|n\\(clude\\|quire\\|t\\(" "e\\(ger\\|nt\\|rface\\)\\|rinsic\\)\\)\\)\\|logical\\|module\\|n\\(" "amelist\\|one\\|ullify\\)\\|o\\(nly\\|p\\(en\\|tional\\)\\)\\|p\\(a\\(" "rameter\\|use\\)\\|ointer\\|r\\(ecision\\|i\\(nt\\|vate\\)\\|o\\(" "cedure\\|gram\\)\\)\\|ublic\\)\\|re\\(a[dl]\\|cursive\\|turn\\|wind\\)\\|" "s\\(ave\\|e\\(lect\\|quence\\)\\|top\\|ubroutine\\)\\|t\\(arget\\|hen\\|" "ype\\)\\|use\\|w\\(h\\(ere\\|ile\\)\\|rite\\)\\)\\>") "Regexp for F90 keywords.") (defconst f90-keywords-level-3-re ;; ("allocate" "allocatable" "assign" "assignment" "backspace" "close" ;; "deallocate" "endfile" "entry" "equivalence" "external" "inquire" "intent" ;; "intrinsic" "only" "open" "optional" "parameter" "pause" "pointer" "print" ;; "private" "public" "read" "recursive" "rewind" "save" "select" "sequence" ;; "target" "write") (concat "\\<\\(a\\(llocat\\(able\\|e\\)\\|ssign\\(\\|ment\\)\\)\\|backspace\\|" "close\\|deallocate\\|e\\(n\\(dfile\\|try\\)\\|quivalence\\|xternal\\)\\|" "in\\(quire\\|t\\(ent\\|rinsic\\)\\)\\|o\\(nly\\|p\\(en\\|tional\\)\\)\\|" "p\\(a\\(rameter\\|use\\)\\|ointer\\|ri\\(nt\\|vate\\)\\|ublic\\)\\|re\\(" "ad\\|cursive\\|wind\\)\\|s\\(ave\\|e\\(lect\\|quence\\)\\)\\|target\\|" "write\\)\\>") "Keyword-regexp for font-lock level >= 3.") (defconst f90-procedures-re ;; ("abs" "achar" "acos" "adjustl" "adjustr" "aimag" "aint" "all" "allocated" ;; "anint" "any" "asin" "associated" "atan" "atan2" "bit_size" "btest" ;; "ceiling" "char" "cmplx" "conjg" "cos" "cosh" "count" "cshift" ;; "date_and_time" "dble" "digits" "dim" "dot_product" "dprod" "eoshift" ;; "epsilon" "exp" "exponent" "floor" "fraction" "huge" "iachar" "iand" ;; "ibclr" "ibits" "ibset" "ichar" "ieor" "index" "int" "ior" "ishft" ;; "ishftc" "kind" "lbound" "len" "len_trim" "lge" "lgt" "lle" "llt" "log" ;; "logical" "log10" "matmul" "max" "maxexponent" "maxloc" "maxval" "merge" ;; "min" "minexponent" "minloc" "minval" "mod" "modulo" "mvbits" "nearest" ;; "nint" "not" "pack" "precision" "present" "product" "radix" ;; "random_number" "random_seed" "range" "real" "repeat" "reshape" ;; "rrspacing" "scale" "scan" "selected_int_kind" "selected_real_kind" ;; "set_exponent" "shape" "sign" "sin" "sinh" "size" "spacing" "spread" ;; "sqrt" "sum" "system_clock" "tan" "tanh" "tiny" "transfer" "transpose" ;; "trim" "ubound" "unpack" "verify") ;; A left paranthesis to avoid highlighting non-procedures. ;; Real is taken out here to avoid highlighting declarations. (concat "\\<\\(a\\(bs\\|c\\(har\\|os\\)\\|djust[lr]\\|i\\(mag\\|nt\\)\\|ll\\(\\|" "ocated\\)\\|n\\(int\\|y\\)\\|s\\(in\\|sociated\\)\\|tan2?\\)\\|b\\(" "it_size\\|test\\)\\|c\\(eiling\\|har\\|mplx\\|o\\(njg\\|sh?\\|unt\\)\\|" "shift\\)\\|d\\(ate_and_time\\|ble\\|i\\(gits\\|m\\)\\|ot_product\\|prod" "\\)\\|e\\(oshift\\|psilon\\|xp\\(\\|onent\\)\\)\\|f\\(loor\\|" "raction\\)\\|huge\\|i\\(a\\(char\\|nd\\)\\|b\\(clr\\|its\\|set\\)\\|" "char\\|eor\\|n\\(dex\\|t\\)\\|or\\|shftc?\\)\\|kind\\|l\\(bound\\|" "en\\(\\|_trim\\)\\|g[et]\\|l[et]\\|og\\(\\|10\\|ical\\)\\)\\|m\\(a\\(" "tmul\\|x\\(\\|exponent\\|loc\\|val\\)\\)\\|erge\\|in\\(\\|exponent\\|" "loc\\|val\\)\\|od\\(\\|ulo\\)\\|vbits\\)\\|n\\(earest\\|int\\|ot\\)\\|" "p\\(ack\\|r\\(e\\(cision\\|sent\\)\\|oduct\\)\\)\\|r\\(a\\(dix\\|n\\(" "dom_\\(number\\|seed\\)\\|ge\\)\\)\\|e\\(peat\\|shape\\)\\|rspacing\\)\\|" "s\\(ca\\(le\\|n\\)\\|e\\(lected_\\(int_kind\\|real_kind\\)\\|" "t_exponent\\)\\|hape\\|i\\(gn\\|nh?\\|ze\\)\\|p\\(acing\\|read\\)\\|" "qrt\\|um\\|ystem_clock\\)\\|t\\(anh?\\|iny\\|r\\(ans\\(fer\\|pose\\)\\|" "im\\)\\)\\|u\\(bound\\|npack\\)\\|verify\\)[ \t]*(") "Regexp whose first part matches F90 intrinsic procedures.") (defconst f90-operators-re ;; "and" "or" "not" "eqv" "neqv" "eq" "ne" "lt" "le" "gt" "ge" "true" "false" (concat "\\.\\(and\\|eqv?\\|false\\|g[et]\\|l[et]\\|n\\(e\\(\\|qv\\)\\|" "ot\\)\\|or\\|true\\)\\.") "Regexp matching intrinsic operators.") (defconst f90-hpf-keywords-re ;; Intrinsic procedures ;; ("all_prefix" "all_scatter" "all_suffix" "any_prefix" "any_scatter" ;; "any_suffix" "copy_prefix" "copy_scatter" "copy_suffix" "count_prefix" ;; "count_scatter" "count_suffix" "grade_down" "grade_up" "hpf_alignment" ;; "hpf_template" "hpf_distribution" "iall" "iall_prefix" "iall_scatter" ;; "iall_suffix" "iany" "iany_prefix" "iany_scatter" "iany_suffix" "iparity" ;; "iparity_prefix" "iparity_scatter" "iparity_suffix" "leadz" ;; "maxval_prefix" "maxval_scatter" "maxval_suffix" "minval_prefix" ;; "minval_scatter" "minval_suffix" "parity" "parity_prefix" ;; "parity_scatter" "parity_suffix" "popcnt" "poppar" "product_prefix" ;; "product_scatter" "product_suffix" "sum_prefix" "sum_scatter" ;; "sum_suffix" "ilen" "number_of_processors" "processors_shape") ;; Directives ;; ("align" "distribute" "dynamic" "inherit" "template" "processors" ;; "realign" "redistribute" "independent") ;; Keywords ;; ("pure" "extrinsic" "new" "with" "onto" "block" "cyclic") (concat "\\<\\(a\\(l\\(ign\\|l_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|ny_\\(" "prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|block\\|c\\(o\\(py_\\(prefix\\|" "s\\(catter\\|uffix\\)\\)\\|unt_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|" "yclic\\)\\|d\\(istribute\\|ynamic\\)\\|extrinsic\\|grade_\\(down\\|" "up\\)\\|hpf_\\(alignment\\|distribution\\|template\\)\\|i\\(a\\(ll\\(\\|" "_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|ny\\(\\|_\\(prefix\\|s\\(" "catter\\|uffix\\)\\)\\)\\)\\|len\\|n\\(dependent\\|herit\\)\\|parity\\(\\|" "_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\)\\|leadz\\|m\\(axval_\\(" "prefix\\|s\\(catter\\|uffix\\)\\)\\|inval_\\(prefix\\|s\\(catter\\|" "uffix\\)\\)\\)\\|n\\(ew\\|umber_of_processors\\)\\|onto\\|p\\(arity\\(\\|" "_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|op\\(cnt\\|par\\)\\|ro\\(" "cessors\\(\\|_shape\\)\\|duct_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|" "ure\\)\\|re\\(align\\|distribute\\)\\|sum_\\(prefix\\|s\\(catter\\|" "uffix\\)\\)\\|template\\|with\\)\\>") "Regexp for all HPF keywords, procedures and directives.") ;; Highlighting patterns (defvar f90-font-lock-keywords-1 (if (string-match "XEmacs" emacs-version) (list ; XEmacs '("\\<\\(end[ \t]*\\(program\\|module\\|function\\|subroutine\\|type\\)\\)\\>" 1 font-lock-keyword-face) '("\\<\\(end[ \t]*\\(program\\|module\\|function\\|subroutine\\|type\\)\\)\\>[ \t]*\\(\\sw+\\)" 3 font-lock-function-name-face) '("\\<\\(program\\|call\\|module\\|subroutine\\|function\\|use\\)\\>" 1 font-lock-keyword-face) '("\\<\\(program\\|call\\|module\\|subroutine\\|function\\|use\\)\\>[ \t]*\\(\\sw+\\)" 2 font-lock-function-name-face nil t) ;; Special highlighting of "module procedure foo-list" '("\\<\\(module[ \t]*procedure\\)\\>" 1 font-lock-keyword-face t) ;; Highlight definition of new type '("\\<\\(type\\)[ \t]*\\(,.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)" 1 font-lock-keyword-face) '("\\<\\(type\\)[ \t]*\\(,.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)" 3 font-lock-function-name-face) "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>") (list ; Emacs '("\\<\\(end[ \t]*\\(program\\|module\\|function\\|subroutine\\|type\\)\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) '("\\<\\(program\\|call\\|module\\|subroutine\\|function\\|use\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) ;; Special highlighting of "module procedure foo-list" '("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face t)) ;; Highlight definition of new type '("\\<\\(type\\)[ \t]*\\(,.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)" (1 font-lock-keyword-face) (3 font-lock-function-name-face)) "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>")) "This does fairly subdued highlighting of comments and function calls.") (defvar f90-font-lock-keywords-2 (append f90-font-lock-keywords-1 (if (string-match "XEmacs" emacs-version) (list ; XEmacs ;; Variable declarations (avoid the real function call) '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\)" 1 font-lock-type-face) '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\)\\(.*::\\|[ \t]*(.*)\\)?\\(.*\\)" 4 font-lock-doc-string-face) ;; do, if and select constructs '("\\<\\(end[ \t]*\\(do\\|if\\|select\\)\\)\\>" 1 font-lock-keyword-face) '("\\<\\(end[ \t]*\\(do\\|if\\|select\\)\\)\\>\\([ \t]+\\(\\sw+\\)\\)" 3 font-lock-doc-string-face) '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)\\(\\(if\\|do\\([ \t]*while\\)?\\|select[ \t]*case\\)\\)\\>" 2 font-lock-doc-string-face) '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|do\\([ \t]*while\\)?\\|select[ \t]*case\\)\\)\\>" 3 font-lock-keyword-face) ;; implicit declaration '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\|none\\)\\>" 1 font-lock-keyword-face) '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\|none\\)\\>" 2 font-lock-type-face) '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/" 1 font-lock-keyword-face) '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)\/" 2 font-lock-doc-string-face nil t) '("\\<\\(where\\|forall\\)[ \t]*(" . 1) "\\" "\\<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\>" '("\\<\\(exit\\|cycle\\)\\>" 1 font-lock-keyword-face) '("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)2\\>" 2 font-lock-doc-string-face) '("\\<\\(case\\)[ \t]+\\(default\\|(\\)" . 1) '("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)" 1 font-lock-keyword-face) '("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)" 2 font-lock-doc-string-face) '("^[ \t]*\\([0-9]+\\)" 1 font-lock-doc-string-face t)) (list ; Emacs ;; Variable declarations (avoid the real function call) '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\)\\(.*::\\|[ \t]*(.*)\\)?\\(.*\\)" (1 font-lock-type-face) (4 font-lock-variable-name-face)) ;; do, if and select constructs '("\\<\\(end[ \t]*\\(do\\|if\\|select\\)\\)\\>\\([ \t]+\\(\\sw+\\)\\)?" (1 font-lock-keyword-face) (3 font-lock-reference-face nil t)) '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|do\\([ \t]*while\\)?\\|select[ \t]*case\\)\\)\\>" (2 font-lock-reference-face nil t) (3 font-lock-keyword-face)) ;; implicit declaration '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\|none\\)\\>" (1 font-lock-keyword-face) (2 font-lock-type-face)) '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/" (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) '("\\<\\(where\\|forall\\)[ \t]*(" . 1) "\\" "\\<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\>" '("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>" (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) '("\\<\\(case\\)[ \t]+\\(default\\|(\\)" . 1) '("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)" (1 font-lock-keyword-face) (2 font-lock-reference-face)) '("^[ \t]*\\([0-9]+\\)" (1 font-lock-reference-face t))))) "Highlights declarations, do-loops and other constructions") (defvar f90-font-lock-keywords-3 (append f90-font-lock-keywords-2 (list f90-keywords-level-3-re f90-operators-re (if (string-match "XEmacs" emacs-version) (append (list f90-procedures-re) '(1 font-lock-keyword-face t)) (list f90-procedures-re '(1 font-lock-keyword-face t))) "\\" ; Avoid overwriting real defs. )) "Highlights all F90 keywords and intrinsic procedures.") (defvar f90-font-lock-keywords-4 (append f90-font-lock-keywords-3 (list f90-hpf-keywords-re)) "Highlights all F90 and HPF keywords.") (defvar f90-font-lock-keywords f90-font-lock-keywords-2 "*Default expressions to highlight in F90 mode.") ;; syntax table (defvar f90-mode-syntax-table nil "Syntax table in use in F90 mode buffers.") (if f90-mode-syntax-table () (setq f90-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?\! "<" f90-mode-syntax-table) ; beg. comment (modify-syntax-entry ?\n ">" f90-mode-syntax-table) ; end comment (modify-syntax-entry ?_ "w" f90-mode-syntax-table) ; underscore in names (modify-syntax-entry ?\' "\"" f90-mode-syntax-table) ; string quote (modify-syntax-entry ?\" "\"" f90-mode-syntax-table) ; string quote (modify-syntax-entry ?\` "w" f90-mode-syntax-table) ; for abbrevs (modify-syntax-entry ?\r " " f90-mode-syntax-table) ; return is whitespace (modify-syntax-entry ?+ "." f90-mode-syntax-table) (modify-syntax-entry ?- "." f90-mode-syntax-table) (modify-syntax-entry ?= "." f90-mode-syntax-table) (modify-syntax-entry ?* "." f90-mode-syntax-table) (modify-syntax-entry ?/ "." f90-mode-syntax-table) (modify-syntax-entry ?\\ "/" f90-mode-syntax-table)) ; escape chars ;; keys (defvar f90-mode-map () "Keymap used in F90 mode.") (if f90-mode-map () (setq f90-mode-map (make-sparse-keymap)) (define-key f90-mode-map "`" 'f90-abbrev-start) (define-key f90-mode-map "\C-c;" 'f90-comment-region) (define-key f90-mode-map "\C-\M-a" 'f90-beginning-of-subprogram) (define-key f90-mode-map "\C-\M-e" 'f90-end-of-subprogram) (define-key f90-mode-map "\C-\M-h" 'f90-mark-subprogram) (define-key f90-mode-map "\C-\M-q" 'f90-indent-subprogram) (define-key f90-mode-map "\C-j" 'f90-indent-new-line) ; LFD equals C-j (define-key f90-mode-map "\r" 'newline) (define-key f90-mode-map "\C-c\r" 'f90-break-line) ;; (define-key f90-mode-map [M-return] 'f90-break-line) (define-key f90-mode-map "\C-c\C-d" 'f90-join-lines) (define-key f90-mode-map "\C-c\C-f" 'f90-fill-region) (define-key f90-mode-map "\C-c\C-p" 'f90-previous-statement) (define-key f90-mode-map "\C-c\C-n" 'f90-next-statement) (define-key f90-mode-map "\C-c\C-w" 'f90-insert-end) (define-key f90-mode-map "\t" 'f90-indent-line)) ;; menus (if (string-match "XEmacs" emacs-version) (defvar f90-xemacs-menu '("F90" ["Indent Subprogram" f90-indent-subprogram t] ["Mark Subprogram" f90-mark-subprogram t] ["Beginning of Subprogram" f90-beginning-of-subprogram t] ["End of Subprogram" f90-end-of-subprogram t] "-----" ["(Un)Comment Region" f90-comment-region t] ["Indent Region" indent-region t] ["Fill Region" f90-fill-region t] "-----" ["Break Line at Point" f90-break-line t] ["Join with Next Line" f90-join-lines t] ["Insert Newline" newline t] ["Insert End" f90-insert-end t] "-----" ["Upcase Keywords (buffer)" f90-upcase-keywords t] ["Upcase Keywords (region)" f90-upcase-region-keywords t] ["Capitalize Keywords (buffer)" f90-capitalize-keywords t] ["Capitalize Keywords (region)" f90-capitalize-region-keywords t] ["Downcase Keywords (buffer)" f90-downcase-keywords t] ["Downcase Keywords (region)" f90-downcase-region-keywords t] "-----" ["Toggle abbrev-mode" abbrev-mode t] ["Toggle auto-fill" f90-auto-fill-mode t]) "XEmacs menu for F90 mode.") ;; Emacs (define-key f90-mode-map [menu-bar] (make-sparse-keymap)) (define-key f90-mode-map [menu-bar f90] (cons "F90" (make-sparse-keymap "f90"))) (define-key f90-mode-map [menu-bar f90 abbrev-mode] '("Toggle abbrev-mode" . abbrev-mode)) (define-key f90-mode-map [menu-bar f90 f90-auto-fill-mode] '("Toggle auto-fill" . f90-auto-fill-mode)) (define-key f90-mode-map [menu-bar f90 f90-downcase-region-keywords] '("Downcase Keywords (region)" . f90-downcase-region-keywords)) (define-key f90-mode-map [menu-bar f90 f90-downcase-keywords] '("Downcase Keywords (buffer)" . f90-downcase-keywords)) (define-key f90-mode-map [menu-bar f90 f90-capitalize-keywords] '("Capitalize Keywords (region)" . f90-capitalize-region-keywords)) (define-key f90-mode-map [menu-bar f90 f90-capitalize-region-keywords] '("Capitalize Keywords (buffer)" . f90-capitalize-keywords)) (define-key f90-mode-map [menu-bar f90 f90-upcase-region-keywords] '("Upcase Keywords (region)" . f90-upcase-region-keywords)) (define-key f90-mode-map [menu-bar f90 f90-upcase-keywords] '("Upcase Keywords (buffer)" . f90-upcase-keywords)) (define-key f90-mode-map [menu-bar f90 f90-insert-end] '("Insert end" . f90-insert-end)) (define-key f90-mode-map [menu-bar f90 f90-join-lines] '("Join with Next Line" . f90-join-lines)) (define-key f90-mode-map [menu-bar f90 f90-break-line] '("Break Line at Point" . f90-break-line)) (define-key f90-mode-map [menu-bar f90 f90-fill-region] '("Fill Region" . f90-fill-region)) (define-key f90-mode-map [menu-bar f90 indent-region] '("Indent Region" . indent-region)) (define-key f90-mode-map [menu-bar f90 f90-comment-region] '("(Un)Comment Region" . f90-comment-region)) (define-key f90-mode-map [menu-bar f90 f90-end-of-subprogram] '("End of Subprogram" . f90-end-of-subprogram)) (define-key f90-mode-map [menu-bar f90 f90-beginning-of-subprogram] '("Beginning of Subprogram" . f90-beginning-of-subprogram)) (define-key f90-mode-map [menu-bar f90 f90-mark-subprogram] '("Mark Subprogram" . f90-mark-subprogram)) (define-key f90-mode-map [menu-bar f90 f90-indent-subprogram] '("Indent Subprogram" . f90-indent-subprogram))) ;; Regexps for finding program structures. (defconst f90-blocks-re "\\(block[ \t]*data\\|do\\|if\\|interface\\|function\\|module\\|\ program\\|select\\|subroutine\\|type\\|where\\|forall\\)\\>") (defconst f90-program-block-re "\\(program\\|module\\|subroutine\\|function\\)") (defconst f90-else-like-re "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\)\\>") (defconst f90-end-if-re "end[ \t]*\\(if\\|select\\|where\\|forall\\)\\>") (defconst f90-end-type-re "end[ \t]*\\(type\\|interface\\|block[ \t]*data\\)") (defconst f90-type-def-re "\\<\\(type\\)[ \t]*\\(,.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)") (defconst f90-no-break-re "\\(\\*\\*\\|//\\|=>\\)") ;; A temporary position to make region operators faster (defvar f90-cache-position nil) (make-variable-buffer-local 'f90-cache-position) ;; Imenu support (defvar f90-imenu-generic-expression (cons (concat "^[ \t0-9]*\\(" "program[ \t]+\\(\\sw+\\)\\|" "module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)\\|" "\\(recursive[ \t]*\\)?subroutine[ \t]+\\(\\sw+\\)\\|" ; avoid end function, but allow for most other things "\\([^!]*\\([^e!].[^ \t!]\\|.[^n!][^ \t!]\\|..[^d \t!]\\)" "\\|[^!]?[^!]?\\)[ \t]*function[ \t]+\\(\\sw+\\)" "\\)") (list 2 3 6 9)) "imenu generic expression for F90 mode.") ;; When compiling under GNU Emacs, load imenu during compilation. If ;; you have 19.22 or earlier, comment this out, or get imenu. (and (fboundp 'eval-when-compile) (eval-when-compile (if (not (string-match "XEmacs" emacs-version)) (require 'imenu)) ())) ;; abbrevs have generally two letters, except standard types `c, `i, `r, `t (defvar f90-mode-abbrev-table nil) (if f90-mode-abbrev-table () (let ((ac abbrevs-changed)) (define-abbrev-table 'f90-mode-abbrev-table ()) (define-abbrev f90-mode-abbrev-table "`al" "allocate" nil) (define-abbrev f90-mode-abbrev-table "`ab" "allocatable" nil) (define-abbrev f90-mode-abbrev-table "`as" "assignment" nil) (define-abbrev f90-mode-abbrev-table "`ba" "backspace" nil) (define-abbrev f90-mode-abbrev-table "`bd" "block data" nil) (define-abbrev f90-mode-abbrev-table "`c" "character" nil) (define-abbrev f90-mode-abbrev-table "`cl" "close" nil) (define-abbrev f90-mode-abbrev-table "`cm" "common" nil) (define-abbrev f90-mode-abbrev-table "`cx" "complex" nil) (define-abbrev f90-mode-abbrev-table "`cn" "contains" nil) (define-abbrev f90-mode-abbrev-table "`cy" "cycle" nil) (define-abbrev f90-mode-abbrev-table "`de" "deallocate" nil) (define-abbrev f90-mode-abbrev-table "`df" "define" nil) (define-abbrev f90-mode-abbrev-table "`di" "dimension" nil) (define-abbrev f90-mode-abbrev-table "`dw" "do while" nil) (define-abbrev f90-mode-abbrev-table "`el" "else" nil) (define-abbrev f90-mode-abbrev-table "`eli" "else if" nil) (define-abbrev f90-mode-abbrev-table "`elw" "elsewhere" nil) (define-abbrev f90-mode-abbrev-table "`eq" "equivalence" nil) (define-abbrev f90-mode-abbrev-table "`ex" "external" nil) (define-abbrev f90-mode-abbrev-table "`ey" "entry" nil) (define-abbrev f90-mode-abbrev-table "`fl" "forall" nil) (define-abbrev f90-mode-abbrev-table "`fo" "format" nil) (define-abbrev f90-mode-abbrev-table "`fu" "function" nil) (define-abbrev f90-mode-abbrev-table "`fa" ".false." nil) (define-abbrev f90-mode-abbrev-table "`im" "implicit none" nil) (define-abbrev f90-mode-abbrev-table "`in " "include" nil) (define-abbrev f90-mode-abbrev-table "`i" "integer" nil) (define-abbrev f90-mode-abbrev-table "`it" "intent" nil) (define-abbrev f90-mode-abbrev-table "`if" "interface" nil) (define-abbrev f90-mode-abbrev-table "`lo" "logical" nil) (define-abbrev f90-mode-abbrev-table "`mo" "module" nil) (define-abbrev f90-mode-abbrev-table "`na" "namelist" nil) (define-abbrev f90-mode-abbrev-table "`nu" "nullify" nil) (define-abbrev f90-mode-abbrev-table "`op" "optional" nil) (define-abbrev f90-mode-abbrev-table "`pa" "parameter" nil) (define-abbrev f90-mode-abbrev-table "`po" "pointer" nil) (define-abbrev f90-mode-abbrev-table "`pr" "print" nil) (define-abbrev f90-mode-abbrev-table "`pi" "private" nil) (define-abbrev f90-mode-abbrev-table "`pm" "program" nil) (define-abbrev f90-mode-abbrev-table "`pu" "public" nil) (define-abbrev f90-mode-abbrev-table "`r" "real" nil) (define-abbrev f90-mode-abbrev-table "`rc" "recursive" nil) (define-abbrev f90-mode-abbrev-table "`rt" "return" nil) (define-abbrev f90-mode-abbrev-table "`rw" "rewind" nil) (define-abbrev f90-mode-abbrev-table "`se" "select" nil) (define-abbrev f90-mode-abbrev-table "`sq" "sequence" nil) (define-abbrev f90-mode-abbrev-table "`su" "subroutine" nil) (define-abbrev f90-mode-abbrev-table "`ta" "target" nil) (define-abbrev f90-mode-abbrev-table "`tr" ".true." nil) (define-abbrev f90-mode-abbrev-table "`t" "type" nil) (define-abbrev f90-mode-abbrev-table "`wh" "where" nil) (define-abbrev f90-mode-abbrev-table "`wr" "write" nil) (setq abbrevs-changed ac))) ;;;###autoload (defun f90-mode () "Major mode for editing Fortran 90 code in free format. \\[f90-indent-new-line] corrects current indentation and creates new\ indented line. \\[f90-indent-line] indents the current line correctly. \\[f90-indent-subprogram] indents the current subprogram. Type `? or `\\[help-command] to display a list of built-in\ abbrevs for F90 keywords. Key definitions: \\{f90-mode-map} Variables controlling indentation style and extra features: f90-do-indent Extra indentation within do blocks. (default 3) f90-if-indent Extra indentation within if/select case/where/forall blocks. (default 3) f90-type-indent Extra indentation within type/interface/block-data blocks. (default 3) f90-program-indent Extra indentation within program/module/subroutine/function blocks. (default 2) f90-continuation-indent Extra indentation applied to continuation lines. (default 5) f90-comment-region String inserted by \\[f90-comment-region] at start of each line in region. (default \"!!!$\") f90-indented-comment-re Regexp determining the type of comment to be intended like code. (default \"!\") f90-directive-comment-re Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented. (default \"!hpf\\\\$\") f90-break-delimiters Regexp holding list of delimiters at which lines may be broken. (default \"[-+*/><=,% \\t]\") f90-break-before-delimiters Non-nil causes `f90-do-auto-fill' to break lines before delimiters. (default t) f90-beginning-ampersand Automatic insertion of \& at beginning of continuation lines. (default t) f90-smart-end From an END statement, check and fill the end using matching block start. Allowed values are 'blink, 'no-blink, and nil, which determine whether to blink the matching beginning.) (default 'blink) f90-auto-keyword-case Automatic change of case of keywords. (default nil) The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word. f90-leave-line-no Do not left-justify line numbers. (default nil) f90-startup-message Set to nil to inhibit message first time F90 mode is used. (default t) f90-keywords List of keywords used for highlighting/upcase-keywords etc. Turning on F90 mode calls the value of the variable `f90-mode-hook' with no args, if that value is non-nil." (interactive) (kill-all-local-variables) (setq major-mode 'f90-mode) (setq mode-name "F90") (setq local-abbrev-table f90-mode-abbrev-table) (set-syntax-table f90-mode-syntax-table) (use-local-map f90-mode-map) (make-local-variable 'indent-line-function) (setq indent-line-function 'f90-indent-line) (make-local-variable 'indent-region-function) (setq indent-region-function 'f90-indent-region) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'comment-start) (setq comment-start "!") (make-local-variable 'comment-start-skip) (setq comment-start-skip "!+ *") (make-local-variable 'comment-indent-function) (setq comment-indent-function 'f90-comment-indent) (make-local-variable 'abbrev-all-caps) (setq abbrev-all-caps t) (setq indent-tabs-mode nil) ;; Setting up things for font-lock (if (string-match "Xemacs" emacs-version) (progn (put 'f90-mode 'font-lock-keywords-case-fold-search t) (if (and current-menubar (not (assoc "F90" current-menubar))) (progn (set-buffer-menubar (copy-sequence current-menubar)) (add-submenu nil f90-xemacs-menu))) (make-local-variable 'font-lock-keywords) (setq font-lock-keywords f90-font-lock-keywords)) ;; Emacs (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '((f90-font-lock-keywords f90-font-lock-keywords-1 f90-font-lock-keywords-2 f90-font-lock-keywords-3 f90-font-lock-keywords-4) nil t)) ;; Tell imenu how to handle f90. (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression f90-imenu-generic-expression)) (run-hooks 'f90-mode-hook) (if f90-startup-message (message "Emacs F90 mode; please report bugs to %s" bug-f90-mode)) (setq f90-startup-message nil)) ;; inline-functions (defsubst f90-get-beg-of-line () (save-excursion (beginning-of-line) (point))) (defsubst f90-get-end-of-line () (save-excursion (end-of-line) (point))) (defsubst f90-in-string () (let ((beg-pnt (if (and f90-cache-position (> (point) f90-cache-position)) f90-cache-position (point-min)))) (nth 3 (parse-partial-sexp beg-pnt (point))))) (defsubst f90-in-comment () (let ((beg-pnt (if (and f90-cache-position (> (point) f90-cache-position)) f90-cache-position (point-min)))) (nth 4 (parse-partial-sexp beg-pnt (point))))) (defsubst f90-line-continued () (save-excursion (let ((bol (f90-get-beg-of-line))) (end-of-line) (while (f90-in-comment) (search-backward "!" bol) (skip-chars-backward "!")) (skip-chars-backward " \t") (= (preceding-char) ?&)))) (defsubst f90-current-indentation () "Return indentation of current line. Line-numbers are considered whitespace characters." (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (current-column))) (defsubst f90-indent-to (col &optional no-line-number) "Indent current line to column COL. If no-line-number nil, jump over a possible line-number." (beginning-of-line) (if (not no-line-number) (skip-chars-forward " \t0-9")) (delete-horizontal-space) (if (zerop (current-column)) (indent-to col) (indent-to col 1))) (defsubst f90-match-piece (arg) (if (match-beginning arg) (buffer-substring (match-beginning arg) (match-end arg)))) (defsubst f90-get-present-comment-type () (save-excursion (let ((type nil) (eol (f90-get-end-of-line))) (if (f90-in-comment) (progn (beginning-of-line) (re-search-forward "[!]+" eol) (while (f90-in-string) (re-search-forward "[!]+" eol)) (setq type (buffer-substring (match-beginning 0) (match-end 0))))) type))) (defsubst f90-equal-symbols (a b) "Compare strings neglecting case and allowing for nil value." (let ((a-local (if a (downcase a) nil)) (b-local (if b (downcase b) nil))) (equal a-local b-local))) ;; XEmacs 19.11 & 19.12 gives back a single char when matching an empty regular ;; expression. Therefore, the next 2 functions are longer than necessary. (defsubst f90-looking-at-do () "Return (\"do\" name) if a do statement starts after point. Name is nil if the statement has no label." (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(do\\)\\>") (let (label (struct (f90-match-piece 3))) (if (looking-at "\\(\\sw+\\)[ \t]*\:") (setq label (f90-match-piece 1))) (list struct label)))) (defsubst f90-looking-at-select-case () "Return (\"select\" name) if a select-case statement starts after point. Name is nil if the statement has no label." (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(select\\)[ \t]*case[ \t]*(") (let (label (struct (f90-match-piece 3))) (if (looking-at "\\(\\sw+\\)[ \t]*\:") (setq label (f90-match-piece 1))) (list struct label)))) (defsubst f90-looking-at-if-then () "Return (\"if\" name) if an if () then statement starts after point. Name is nil if the statement has no label." (save-excursion (let (struct (label nil)) (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>") (progn (setq struct (f90-match-piece 3)) (if (looking-at "\\(\\sw+\\)[ \t]*\:") (setq label (f90-match-piece 1))) (goto-char (scan-lists (point) 1 0)) (skip-chars-forward " \t") (if (or (looking-at "then\\>") (if (f90-line-continued) (progn (f90-next-statement) (skip-chars-forward " \t0-9&") (looking-at "then\\>")))) (list struct label))))))) (defsubst f90-looking-at-where-or-forall () "Return (kind nil) if where/forall...end starts after point." (save-excursion (let (command) (if (looking-at "\\(where\\|forall\\)[ \t]*(") (progn (setq command (list (f90-match-piece 1) nil)) (goto-char (scan-lists (point) 1 0)) (skip-chars-forward " \t") (if (looking-at "\\(!\\|$\\)") command)))))) (defsubst f90-looking-at-type-like () "Return (kind name) at the start of a type/interface/block-data block. Name is non-nil only for type." (cond ((looking-at f90-type-def-re) (list (f90-match-piece 1) (f90-match-piece 3))) ((looking-at "\\(interface\\|block[\t]*data\\)\\>") (list (f90-match-piece 1) nil)))) (defsubst f90-looking-at-program-block-start () "Return (kind name) if a program block with name name starts after point." (cond ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>") (list (f90-match-piece 1) (f90-match-piece 2))) ((and (not (looking-at "module[ \t]*procedure\\>")) (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>")) (list (f90-match-piece 1) (f90-match-piece 2))) ((looking-at "\\(recursive[ \t]*\\)?\\(subroutine\\)[ \t]+\\(\\sw+\\)") (list (f90-match-piece 2) (f90-match-piece 3))) ((and (not (looking-at "end[ \t]*function")) (looking-at ".*\\(function\\)[ \t]+\\(\\sw+\\)")) (list (f90-match-piece 1) (f90-match-piece 2))))) (defsubst f90-looking-at-program-block-end () "Return list of type and name of end of block." (if (looking-at (concat "end[ \t]*" f90-blocks-re "?\\([ \t]+\\(\\sw+\\)\\)?\\>")) (list (f90-match-piece 1) (f90-match-piece 3)))) (defsubst f90-comment-indent () (cond ((looking-at "!!!") 0) ((and f90-directive-comment-re (looking-at f90-directive-comment-re)) 0) ((looking-at (regexp-quote f90-comment-region)) 0) ((looking-at f90-indented-comment-re) (f90-calculate-indent)) (t (skip-chars-backward " \t") (max (if (bolp) 0 (1+ (current-column))) comment-column)))) (defsubst f90-present-statement-cont () "Return continuation properties of present statement." (let (pcont cont) (save-excursion (setq pcont (if (f90-previous-statement) (f90-line-continued) nil))) (setq cont (f90-line-continued)) (cond ((and (not pcont) (not cont)) 'single) ((and (not pcont) cont) 'begin) ((and pcont (not cont)) 'end) ((and pcont cont) 'middle) (t (error))))) (defsubst f90-indent-line-no () (if f90-leave-line-no () (if (and (not (zerop (skip-chars-forward " \t"))) (looking-at "[0-9]")) (delete-horizontal-space))) (skip-chars-forward " \t0-9")) (defsubst f90-no-block-limit () (let ((eol (f90-get-end-of-line))) (save-excursion (not (or (looking-at "end") (looking-at "\\(do\\|if\\|else\\|select[ \t]*case\\|\ case\\|where\\|forall\\)\\>") (looking-at "\\(program\\|module\\|interface\\|\ block[ \t]*data\\)\\>") (looking-at "\\(contains\\|\\sw+[ \t]*:\\)") (looking-at f90-type-def-re) (re-search-forward "\\(function\\|subroutine\\)" eol t)))))) (defsubst f90-update-line () (let (bol eol) (if f90-auto-keyword-case (progn (setq bol (f90-get-beg-of-line) eol (f90-get-end-of-line)) (if f90-auto-keyword-case (f90-change-keywords f90-auto-keyword-case bol eol)))))) (defun f90-get-correct-indent () "Get correct indent for a line starting with line number. Does not check type and subprogram indentation." (let ((epnt (f90-get-end-of-line)) icol cont) (save-excursion (while (and (f90-previous-statement) (or (progn (setq cont (f90-present-statement-cont)) (or (eq cont 'end) (eq cont 'middle))) (looking-at "[ \t]*[0-9]")))) (setq icol (current-indentation)) (beginning-of-line) (if (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)" (f90-get-end-of-line) t) (progn (beginning-of-line) (skip-chars-forward " \t") (cond ((f90-looking-at-do) (setq icol (+ icol f90-do-indent))) ((or (f90-looking-at-if-then) (f90-looking-at-where-or-forall) (f90-looking-at-select-case)) (setq icol (+ icol f90-if-indent)))) (end-of-line))) (while (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t) (beginning-of-line) (skip-chars-forward " \t0-9") (cond ((f90-looking-at-do) (setq icol (+ icol f90-do-indent))) ((or (f90-looking-at-if-then) (f90-looking-at-where-or-forall) (f90-looking-at-select-case)) (setq icol (+ icol f90-if-indent))) ((looking-at f90-end-if-re) (setq icol (- icol f90-if-indent))) ((looking-at "end[ \t]*do\\>") (setq icol (- icol f90-do-indent)))) (end-of-line)) icol))) (defun f90-calculate-indent () "Calculate the indent column based on previous statements." (interactive) (let (icol cont (case-fold-search t) (pnt (point))) (save-excursion (if (not (f90-previous-statement)) (setq icol 0) (setq cont (f90-present-statement-cont)) (if (eq cont 'end) (while (not (eq 'begin (f90-present-statement-cont))) (f90-previous-statement))) (cond ((eq cont 'begin) (setq icol (+ (f90-current-indentation) f90-continuation-indent))) ((eq cont 'middle) (setq icol(current-indentation))) (t (setq icol (f90-current-indentation)) (skip-chars-forward " \t") (if (looking-at "[0-9]") (setq icol (f90-get-correct-indent)) (cond ((or (f90-looking-at-if-then) (f90-looking-at-where-or-forall) (f90-looking-at-select-case) (looking-at f90-else-like-re)) (setq icol (+ icol f90-if-indent))) ((f90-looking-at-do) (setq icol (+ icol f90-do-indent))) ((f90-looking-at-type-like) (setq icol (+ icol f90-type-indent))) ((or (f90-looking-at-program-block-start) (looking-at "contains[ \t]*\\($\\|!\\)")) (setq icol (+ icol f90-program-indent))))) (goto-char pnt) (beginning-of-line) (cond ((looking-at "[ \t]*$")) ((looking-at "[ \t]*#") ; Check for cpp directive. (setq icol 0)) (t (skip-chars-forward " \t0-9") (cond ((or (looking-at f90-else-like-re) (looking-at f90-end-if-re)) (setq icol (- icol f90-if-indent))) ((looking-at "end[ \t]*do\\>") (setq icol (- icol f90-do-indent))) ((looking-at f90-end-type-re) (setq icol (- icol f90-type-indent))) ((or (looking-at "contains[ \t]*\\(!\\|$\\)") (f90-looking-at-program-block-end)) (setq icol (- icol f90-program-indent)))))) )))) icol)) ;; Statement = statement line, a line which is neither blank, nor a comment. (defun f90-previous-statement () "Move point to beginning of the previous F90 statement. Return nil if no previous statement is found." (interactive) (let (not-first-statement) (beginning-of-line) (while (and (setq not-first-statement (zerop (forward-line -1))) (looking-at "[ \t0-9]*\\(!\\|$\\|#\\)"))) not-first-statement)) (defun f90-next-statement () "Move point to beginning of the next F90 statement. Return nil if no later statement is found." (interactive) (let (not-last-statement) (beginning-of-line) (while (and (setq not-last-statement (and (zerop (forward-line 1)) (not (eobp)))) (looking-at "[ \t0-9]*\\(!\\|$\\)"))) not-last-statement)) (defun f90-beginning-of-subprogram () "Move point to the beginning of subprogram. Return (type name) or nil if not found." (interactive) (let ((count 1) (case-fold-search t) matching-beg) (beginning-of-line) (skip-chars-forward " \t0-9") (if (setq matching-beg (f90-looking-at-program-block-start)) (setq count (- count 1))) (while (and (not (zerop count)) (re-search-backward f90-program-block-re nil 'move)) (beginning-of-line) (skip-chars-forward " \t0-9") (cond ((setq matching-beg (f90-looking-at-program-block-start)) (setq count (- count 1))) ((f90-looking-at-program-block-end) (setq count (+ count 1))))) (beginning-of-line) (if (zerop count) matching-beg (message "No beginning-found.") nil))) (defun f90-end-of-subprogram () "Move point to the end of subprogram. Return (type name) or nil if not found." (interactive) (let ((count 1) (case-fold-search t) matching-end) (beginning-of-line) (skip-chars-forward " \t0-9") (if (setq matching-end (f90-looking-at-program-block-end)) (setq count (1- count))) (end-of-line) (while (and (not (zerop count)) (re-search-forward f90-program-block-re nil 'move)) (beginning-of-line) (skip-chars-forward " \t0-9") (cond ((f90-looking-at-program-block-start) (setq count (+ count 1))) ((setq matching-end (f90-looking-at-program-block-end)) (setq count (1- count )))) (end-of-line)) (forward-line 1) (if (zerop count) matching-end (message "No end found.") nil))) (defun f90-mark-subprogram () "Put mark at end of F90 subprogram, point at beginning. Marks are pushed and highlight (grey shadow) is turned on." (interactive) (let ((pos (point)) program) (f90-end-of-subprogram) (push-mark (point) t) (goto-char pos) (setq program (f90-beginning-of-subprogram)) ;; The keywords in the preceding lists assume case-insensitivity. (if (string-match "XEmacs" emacs-version) (zmacs-activate-region) (setq mark-active t) (setq deactivate-mark nil)) program)) (defun f90-comment-region (beg-region end-region) "Comment/uncomment every line in the region. Insert f90-comment-region at the beginning of every line in the region or, if already present, remove it." (interactive "*r") (let ((end (make-marker))) (set-marker end end-region) (goto-char beg-region) (beginning-of-line) (if (looking-at (regexp-quote f90-comment-region)) (delete-region (point) (match-end 0)) (insert f90-comment-region)) (while (and (zerop (forward-line 1)) (< (point) (marker-position end))) (if (looking-at (regexp-quote f90-comment-region)) (delete-region (point) (match-end 0)) (insert f90-comment-region))) (set-marker end nil))) (defun f90-indent-line (&optional no-update) "Indent current line as F90 code." (interactive) (let (indent (no-line-number nil) (pos (make-marker)) (case-fold-search t)) (set-marker pos (point)) (beginning-of-line) ; Digits after & \n are not line-no (if (save-excursion (and (f90-previous-statement) (f90-line-continued))) (progn (setq no-line-number t) (skip-chars-forward " \t")) (f90-indent-line-no)) (if (looking-at "!") (setq indent (f90-comment-indent)) (if (and (looking-at "end") f90-smart-end) (f90-match-end)) (setq indent (f90-calculate-indent))) (if (zerop (- indent (current-column))) nil (f90-indent-to indent no-line-number)) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. (if (< (point) (marker-position pos)) (goto-char (marker-position pos))) (if (not no-update) (f90-update-line)) (if (and auto-fill-function (> (save-excursion (end-of-line) (current-column)) fill-column)) (save-excursion (f90-do-auto-fill))) (set-marker pos nil))) (defun f90-indent-new-line () "Reindent the current F90 line, insert a newline and indent the newline. An abbrev before point is expanded if `abbrev-mode' is non-nil. If run in the middle of a line, the line is not broken." (interactive) (let (string cont (case-fold-search t)) (if abbrev-mode (expand-abbrev)) (beginning-of-line) ; Reindent where likely to be needed. (f90-indent-line-no) (if (or (looking-at "\\(end\\|else\\|!\\)")) (f90-indent-line 'no-update)) (end-of-line) (delete-horizontal-space) ;Destroy trailing whitespace (setq string (f90-in-string)) (setq cont (f90-line-continued)) (if (and string (not cont)) (insert "&")) (f90-update-line) (newline) (if (or string (and cont f90-beginning-ampersand)) (insert "&")) (f90-indent-line 'no-update))) (defun f90-indent-region (beg-region end-region) "Indent every line in region by forward parsing." (interactive "*r") (let ((end-region-mark (make-marker)) (save-point (point-marker)) (block-list nil) ind-lev ind-curr ind-b cont struct beg-struct end-struct) (set-marker end-region-mark end-region) (goto-char beg-region) ;; first find a line which is not a continuation line or comment (beginning-of-line) (while (and (looking-at "[ \t]*[0-9]*\\(!\\|#\\|[ \t]*$\\)") (progn (f90-indent-line 'no-update) (zerop (forward-line 1))) (< (point) end-region-mark))) (setq cont (f90-present-statement-cont)) (while (and (or (eq cont 'middle) (eq cont 'end)) (f90-previous-statement)) (setq cont (f90-present-statement-cont))) ;; process present line for beginning of block (setq f90-cache-position (point)) (f90-indent-line 'no-update) (setq ind-lev (f90-current-indentation)) (setq ind-curr ind-lev) (beginning-of-line) (skip-chars-forward " \t0-9") (setq struct nil) (setq ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent) ((or (setq struct (f90-looking-at-if-then)) (setq struct (f90-looking-at-select-case)) (setq struct (f90-looking-at-where-or-forall)) (looking-at f90-else-like-re)) f90-if-indent) ((setq struct (f90-looking-at-type-like)) f90-type-indent) ((or(setq struct (f90-looking-at-program-block-start)) (looking-at "contains[ \t]*\\($\\|!\\)")) f90-program-indent))) (if ind-b (setq ind-lev (+ ind-lev ind-b))) (if struct (setq block-list (cons struct block-list))) (while (and (f90-line-continued) (zerop (forward-line 1)) (< (point) end-region-mark)) (if (not (zerop (- (current-indentation) (+ ind-curr f90-continuation-indent)))) (f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no))) ;; process all following lines (while (and (zerop (forward-line 1)) (< (point) end-region-mark)) (beginning-of-line) (f90-indent-line-no) (setq f90-cache-position (point)) (cond ((looking-at "[ \t]*$") (setq ind-curr 0)) ((looking-at "[ \t]*#") (setq ind-curr 0)) ((looking-at "!") (setq ind-curr (f90-comment-indent))) ((f90-no-block-limit) (setq ind-curr ind-lev)) ((looking-at f90-else-like-re) (setq ind-curr (- ind-lev f90-if-indent))) ((looking-at "contains[ \t]*\\($\\|!\\)") (setq ind-curr (- ind-lev f90-program-indent))) ((setq ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent) ((or (setq struct (f90-looking-at-if-then)) (setq struct (f90-looking-at-select-case)) (setq struct (f90-looking-at-where-or-forall))) f90-if-indent) ((setq struct (f90-looking-at-type-like)) f90-type-indent) ((setq struct (f90-looking-at-program-block-start)) f90-program-indent))) (setq ind-curr ind-lev) (if ind-b (setq ind-lev (+ ind-lev ind-b))) (setq block-list (cons struct block-list))) ((setq end-struct (f90-looking-at-program-block-end)) (setq beg-struct (car block-list) block-list (cdr block-list)) (if f90-smart-end (save-excursion (f90-block-match (car beg-struct)(car (cdr beg-struct)) (car end-struct)(car (cdr end-struct))))) (setq ind-b (cond ((looking-at f90-end-if-re) f90-if-indent) ((looking-at "end[ \t]*do\\>") f90-do-indent) ((looking-at f90-end-type-re) f90-type-indent) ((f90-looking-at-program-block-end) f90-program-indent))) (if ind-b (setq ind-lev (- ind-lev ind-b))) (setq ind-curr ind-lev)) (t (setq ind-curr ind-lev))) ;; do the indentation if necessary (if (not (zerop (- ind-curr (current-column)))) (f90-indent-to ind-curr)) (while (and (f90-line-continued) (zerop (forward-line 1)) (< (point) end-region-mark)) (if (not (zerop (- (current-indentation) (+ ind-curr f90-continuation-indent)))) (f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no)))) ;; restore point etc (setq f90-cache-position nil) (goto-char save-point) (set-marker end-region-mark nil) (set-marker save-point nil) (if (string-match "Xemacs" emacs-version) (zmacs-deactivate-region) (deactivate-mark)))) (defun f90-indent-subprogram () "Properly indent the subprogram which contains point." (interactive) (save-excursion (let (program) (setq program (f90-mark-subprogram)) (if program (progn (message (concat "Indenting " (car program) " " (car (cdr program))".")) (f90-indent-region (point) (mark)) (message (concat "Indenting " (car program) " " (car (cdr program)) "...done."))) (message "Indenting the whole file.") (f90-indent-region (point) (mark)) (message (concat "Indenting the whole file...done.")))))) ;; autofill and break-line (defun f90-break-line (&optional no-update) "Break line at point, insert continuation marker(s) and indent." (interactive) (let (ctype) (cond ((f90-in-string) (insert "&") (newline) (insert "&")) ((f90-in-comment) (delete-horizontal-space) (setq ctype (f90-get-present-comment-type)) (newline) (insert (concat ctype " "))) (t (delete-horizontal-space) (insert "&") (if (not no-update) (f90-update-line)) (newline) (if f90-beginning-ampersand (insert "& "))))) (if (not no-update) (f90-indent-line))) (defun f90-find-breakpoint () "From fill-column, search backward for break-delimiter." (let ((bol (f90-get-beg-of-line))) (re-search-backward f90-break-delimiters bol) (if f90-break-before-delimiters (progn (backward-char) (if (not (looking-at f90-no-break-re)) (forward-char))) (if (looking-at f90-no-break-re) (forward-char 2) (forward-char))))) (defun f90-auto-fill-mode (arg) "Toggle f90-auto-fill mode. With ARG, turn `f90-auto-fill' mode on iff ARG is positive. In `f90-auto-fill' mode, inserting a space at a column beyond `fill-column' automatically breaks the line at a previous space." (interactive "P") (prog1 (setq auto-fill-function (if (if (null arg) (not auto-fill-function) (> (prefix-numeric-value arg) 0)) 'f90-do-auto-fill)) (force-mode-line-update))) (defun f90-do-auto-fill () "Break line if non-white characters beyond fill-column." (interactive) ;; Break the line before or after the last delimiter (non-word char). ;; Will not break **, //, or => (specified by f90-no-break-re). ;; Start by checking that line is longer than fill-column. (if (> (save-excursion (end-of-line) (current-column)) fill-column) (progn (move-to-column fill-column) (if (and (looking-at "[ \t]*$") (not (f90-in-string))) (delete-horizontal-space) (f90-find-breakpoint) (f90-break-line) (end-of-line))))) (defun f90-join-lines () "Join present line with next line, if this line ends with \&." (interactive) (let (pos (oldpos (point))) (end-of-line) (skip-chars-backward " \t") (cond ((= (preceding-char) ?&) (delete-char -1) (setq pos (point)) (forward-line 1) (skip-chars-forward " \t") (if (looking-at "\&") (delete-char 1)) (delete-region pos (point)) (if (not (f90-in-string)) (progn (delete-horizontal-space) (insert " "))) (if (and auto-fill-function (> (save-excursion (end-of-line) (current-column)) fill-column)) (f90-do-auto-fill)) (goto-char oldpos) t)))) (defun f90-fill-region (beg-region end-region) "Fill every line in region by forward parsing. Join lines if possible." (interactive "*r") (let ((end-region-mark (make-marker)) (f90-smart-end nil) (f90-auto-keyword-case nil) indent (go-on t) (af-function auto-fill-function) (auto-fill-function nil)) (set-marker end-region-mark end-region) (goto-char beg-region) (while go-on ;; join as much as possible (while (f90-join-lines)); (setq indent (+ (f90-current-indentation) f90-continuation-indent)) ;; chop the line if necessary (while (> (save-excursion (end-of-line) (current-column)) fill-column) (move-to-column fill-column) (if (and (looking-at "[ \t]*$") (not (f90-in-string))) (delete-horizontal-space) (f90-find-breakpoint) (f90-break-line 'no-update) (f90-indent-to indent 'no-line-no))) (setq go-on (and (< (point) (marker-position end-region-mark)) (zerop (forward-line 1)))) (setq f90-cache-position (point))) (setq auto-fill-function af-function) (setq f90-cache-position nil) (if (string-match "XEmacs" emacs-version) (zmacs-deactivate-region) (deactivate-mark)))) (defun f90-block-match (beg-block beg-name end-block end-name) "Match end-struct with beg-struct and complete end-block if possible. Leave point at the end of line." (search-forward "end" (f90-get-end-of-line)) (catch 'no-match (if (not (f90-equal-symbols beg-block end-block)) (if end-block (progn (message "END %s does not match %s." end-block beg-block) (end-of-line) (throw 'no-match nil)) (message "Inserting %s." beg-block) (insert (concat " " beg-block))) (search-forward end-block)) (if (not (f90-equal-symbols beg-name end-name)) (cond ((and beg-name (not end-name)) (message "Inserting %s." beg-name) (insert (concat " " beg-name))) ((and beg-name end-name) (message "Replacing %s with %s." end-name beg-name) (search-forward end-name) (replace-match beg-name)) ((and (not beg-name) end-name) (message "Deleting %s." end-name) (search-forward end-name) (replace-match ""))) (if end-name (search-forward end-name))) (if (not (looking-at "[ \t]*!")) (delete-horizontal-space)))) (defun f90-match-end () "From an end foo statement, find the corresponding foo including name." (interactive) (let ((count 1) (top-of-window (window-start)) (matching-beg nil) (end-point (point)) (case-fold-search t) beg-name end-name beg-block end-block end-struct) (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (setq end-struct (f90-looking-at-program-block-end))) (progn (setq end-block (car end-struct)) (setq end-name (car (cdr end-struct))) (save-excursion (beginning-of-line) (while (and (not (zerop count)) (re-search-backward (concat "\\(" f90-blocks-re "\\)") nil t)) (beginning-of-line) (skip-chars-forward " \t0-9") (cond ((setq matching-beg (cond ((f90-looking-at-do)) ((f90-looking-at-if-then)) ((f90-looking-at-where-or-forall)) ((f90-looking-at-select-case)) ((f90-looking-at-type-like)) ((f90-looking-at-program-block-start)))) (setq count (- count 1))) ((looking-at (concat "end[ \t]*" f90-blocks-re "\\b")) (setq count (+ count 1))))) (if (not (zerop count)) (message "No matching beginning.") (f90-update-line) (if (eq f90-smart-end 'blink) (if (< (point) top-of-window) (message (concat "Matches " (what-line) ": " (buffer-substring (progn (beginning-of-line) (point)) (progn (end-of-line) (point))))) (sit-for 1))) (setq beg-block (car matching-beg)) (setq beg-name (car (cdr matching-beg))) (goto-char end-point) (beginning-of-line) (f90-block-match beg-block beg-name end-block end-name))))))) (defun f90-insert-end () "Inserts an complete end statement matching beginning of present block." (interactive) (let ((f90-smart-end (if f90-smart-end f90-smart-end 'blink))) (insert "end") (f90-indent-new-line))) ;; abbrevs and keywords (defun f90-abbrev-start () "Typing `\\[help-command] or `? lists all the F90 abbrevs. Any other key combination is executed normally." (interactive) (let (e c) (insert last-command-char) (setq e (next-command-event) c (if (string-match "XEmacs" emacs-version) (event-to-character e) (read-event))) ;; insert char if not equal to `?' (if (or (= c ??) (eq c help-char)) (f90-abbrev-help) (if (string-match "XEmacs" emacs-version) (setq unread-command-event e) (setq unread-command-events (list c)))))) (defun f90-abbrev-help () "List the currently defined abbrevs in F90 mode." (interactive) (message "Listing abbrev table...") (display-buffer (f90-prepare-abbrev-list-buffer)) (message "Listing abbrev table...done")) (defun f90-prepare-abbrev-list-buffer () (save-excursion (set-buffer (get-buffer-create "*Abbrevs*")) (erase-buffer) (insert-abbrev-table-description 'f90-mode-abbrev-table t) (goto-char (point-min)) (set-buffer-modified-p nil) (edit-abbrevs-mode)) (get-buffer-create "*Abbrevs*")) (defun f90-upcase-keywords () "Upcase all F90 keywords in the buffer." (interactive) (f90-change-keywords 'upcase-word)) (defun f90-capitalize-keywords () "Capitalize all F90 keywords in the buffer." (interactive) (f90-change-keywords 'capitalize-word)) (defun f90-downcase-keywords () "Downcase all F90 keywords in the buffer." (interactive) (f90-change-keywords 'downcase-word)) (defun f90-upcase-region-keywords (beg end) "Upcase all F90 keywords in the region." (interactive "*r") (f90-change-keywords 'upcase-word beg end)) (defun f90-capitalize-region-keywords (beg end) "Capitalize all F90 keywords in the region." (interactive "*r") (f90-change-keywords 'capitalize-word beg end)) (defun f90-downcase-region-keywords (beg end) "Downcase all F90 keywords in the region." (interactive "*r") (f90-change-keywords 'downcase-word beg end)) ;; Change the keywords according to argument. (defun f90-change-keywords (change-word &optional beg end) (save-excursion (setq beg (if beg beg (point-min))) (setq end (if end end (point-max))) (let ((keyword-re (concat "\\(" f90-keywords-re "\\|" f90-procedures-re "\\|" f90-hpf-keywords-re "\\|" f90-operators-re "\\)")) (ref-point (point-min)) state (modified (buffer-modified-p)) saveword back-point) (goto-char beg) (unwind-protect (while (re-search-forward keyword-re end t) (if (progn (setq state (parse-partial-sexp ref-point (point))) (or (nth 3 state) (nth 4 state) (save-excursion ; Check for cpp directive. (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "#")))) () (setq ref-point (point) back-point (save-excursion (backward-word 1) (point))) (setq saveword (buffer-substring back-point ref-point)) (funcall change-word -1) (or (string= saveword (buffer-substring back-point ref-point)) (setq modified t)))) (or modified (set-buffer-modified-p nil)))))) (provide 'f90) ;;; f90.el ends here emacs-19.30/lisp/facemenu.el100444 75424 1 56136 6050716354 14417 0ustar kwzhdaemon;;; facemenu.el --- create a face menu for interactively adding fonts to text ;; Copyright (c) 1994, 1995 Free Software Foundation, Inc. ;; Author: Boris Goldowsky ;; Keywords: 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: ;; This file defines a menu of faces (bold, italic, etc) which allows you to ;; set the face used for a region of the buffer. Some faces also have ;; keybindings, which are shown in the menu. Faces with names beginning with ;; "fg:" or "bg:", as in "fg:red", are treated specially. ;; Such faces are assumed to consist only of a foreground (if "fg:") or ;; background (if "bg:") color. They are thus put into the color submenus ;; rather than the general Face submenu. These faces can also be ;; automatically created by selecting the "Other..." menu items in the ;; "Foreground" and "Background" submenus. ;; ;; The menu also contains submenus for indentation and justification-changing ;; commands. ;;; Usage: ;; Selecting a face from the menu or typing the keyboard equivalent will ;; change the region to use that face. If you use transient-mark-mode and the ;; region is not active, the face will be remembered and used for the next ;; insertion. It will be forgotten if you move point or make other ;; modifications before inserting or typing anything. ;; ;; Faces can be selected from the keyboard as well. ;; The standard keybindings are M-g (or ESC g) + letter: ;; M-g i = "set italic", M-g b = "set bold", etc. ;;; Customization: ;; An alternative set of keybindings that may be easier to type can be set up ;; using "Alt" or "Hyper" keys. This requires that you either have or create ;; an Alt or Hyper key on your keyboard. On my keyboard, there is a key ;; labeled "Alt", but to make it act as an Alt key I have to put this command ;; into my .xinitrc: ;; xmodmap -e "add Mod3 = Alt_L" ;; Or, I can make it into a Hyper key with this: ;; xmodmap -e "keysym Alt_L = Hyper_L" -e "add Mod2 = Hyper_L" ;; Check with local X-perts for how to do it on your system. ;; Then you can define your keybindings with code like this in your .emacs: ;; (setq facemenu-keybindings ;; '((default . [?\H-d]) ;; (bold . [?\H-b]) ;; (italic . [?\H-i]) ;; (bold-italic . [?\H-l]) ;; (underline . [?\H-u]))) ;; (setq facemenu-keymap global-map) ;; (setq facemenu-key nil) ;; (define-key global-map [?\H-c] 'facemenu-set-foreground) ; set fg color ;; (define-key global-map [?\H-C] 'facemenu-set-background) ; set bg color ;; (require 'facemenu) ;; ;; The order of the faces that appear in the menu and their keybindings can be ;; controlled by setting the variables `facemenu-keybindings' and ;; `facemenu-new-faces-at-end'. List faces that you don't use in documents ;; (eg, `region') in `facemenu-unlisted-faces'. ;;; Known Problems: ;; Bold and Italic do not combine to create bold-italic if you select them ;; both, although most other combinations (eg bold + underline + some color) ;; do the intuitive thing. ;; ;; There is at present no way to display what the faces look like in ;; the menu itself. ;; ;; `list-faces-display' shows the faces in a different order than ;; this menu, which could be confusing. I do /not/ sort the list ;; alphabetically, because I like the default order: it puts the most ;; basic, common fonts first. ;; ;; Please send me any other problems, comments or ideas. ;;; Code: (provide 'facemenu) ;;; Provide some binding for startup: ;;;###autoload (define-key global-map "\M-g" 'facemenu-keymap) ;;;###autoload (autoload 'facemenu-keymap "facemenu" "Keymap for face-changing commands." t 'keymap) (defvar facemenu-key "\M-g" "Prefix key to use for facemenu commands.") (defvar facemenu-keybindings '((default . "d") (bold . "b") (italic . "i") (bold-italic . "l") ; {bold} intersect {italic} = {l} (underline . "u")) "Alist of interesting faces and keybindings. Each element is itself a list: the car is the name of the face, the next element is the key to use as a keyboard equivalent of the menu item; the binding is made in facemenu-keymap. The faces specifically mentioned in this list are put at the top of the menu, in the order specified. All other faces which are defined, except for those in `facemenu-unlisted-faces', are listed after them, but get no keyboard equivalents. If you change this variable after loading facemenu.el, you will need to call `facemenu-update' to make it take effect.") (defvar facemenu-new-faces-at-end t "Where in the menu to insert newly-created faces. This should be nil to put them at the top of the menu, or t to put them just before \"Other\" at the end.") (defvar facemenu-unlisted-faces '(modeline region secondary-selection highlight scratch-face) "List of faces not to include in the Face menu. You can set this list before loading facemenu.el, or add a face to it before creating that face if you do not want it to be listed. If you change the variable so as to eliminate faces that have already been added to the menu, call `facemenu-update' to recalculate the menu contents. If this variable is t, no faces will be added to the menu. This is useful for temporarily turning off the feature that automatically adds faces to the menu when they are created.") ;;;###autoload (defvar facemenu-face-menu (let ((map (make-sparse-keymap "Face"))) (define-key map "o" (cons "Other..." 'facemenu-set-face)) map) "Menu keymap for faces.") ;;;###autoload (defalias 'facemenu-face-menu facemenu-face-menu) ;;;###autoload (defvar facemenu-foreground-menu (let ((map (make-sparse-keymap "Foreground Color"))) (define-key map "o" (cons "Other..." 'facemenu-set-foreground)) map) "Menu keymap for foreground colors.") ;;;###autoload (defalias 'facemenu-foreground-menu facemenu-foreground-menu) ;;;###autoload (defvar facemenu-background-menu (let ((map (make-sparse-keymap "Background Color"))) (define-key map "o" (cons "Other..." 'facemenu-set-background)) map) "Menu keymap for background colors") ;;;###autoload (defalias 'facemenu-background-menu facemenu-background-menu) ;;;###autoload (defvar facemenu-special-menu (let ((map (make-sparse-keymap "Special"))) (define-key map [?s] (cons "Remove Special" 'facemenu-remove-special)) (define-key map [?t] (cons "Intangible" 'facemenu-set-intangible)) (define-key map [?v] (cons "Invisible" 'facemenu-set-invisible)) (define-key map [?r] (cons "Read-Only" 'facemenu-set-read-only)) map) "Menu keymap for non-face text-properties.") ;;;###autoload (defalias 'facemenu-special-menu facemenu-special-menu) ;;;###autoload (defvar facemenu-justification-menu (let ((map (make-sparse-keymap "Justification"))) (define-key map [?c] (cons "Center" 'set-justification-center)) (define-key map [?b] (cons "Full" 'set-justification-full)) (define-key map [?r] (cons "Right" 'set-justification-right)) (define-key map [?l] (cons "Left" 'set-justification-left)) (define-key map [?u] (cons "Unfilled" 'set-justification-none)) map) "Submenu for text justification commands.") ;;;###autoload (defalias 'facemenu-justification-menu facemenu-justification-menu) ;;;###autoload (defvar facemenu-indentation-menu (let ((map (make-sparse-keymap "Indentation"))) (define-key map [decrease-right-margin] (cons "Indent Right Less" 'decrease-right-margin)) (define-key map [increase-right-margin] (cons "Indent Right More" 'increase-right-margin)) (define-key map [decrease-left-margin] (cons "Indent Less" 'decrease-left-margin)) (define-key map [increase-left-margin] (cons "Indent More" 'increase-left-margin)) map) "Submenu for indentation commands.") ;;;###autoload (defalias 'facemenu-indentation-menu facemenu-indentation-menu) ;; This is split up to avoid an overlong line in loaddefs.el. ;;;###autoload (defvar facemenu-menu nil "Facemenu top-level menu keymap.") ;;;###autoload (setq facemenu-menu (make-sparse-keymap "Text Properties")) ;;;###autoload (let ((map facemenu-menu)) (define-key map [dc] (cons "Display Colors" 'list-colors-display)) (define-key map [df] (cons "Display Faces" 'list-faces-display)) (define-key map [dp] (cons "List Properties" 'list-text-properties-at)) (define-key map [ra] (cons "Remove All" 'facemenu-remove-all)) (define-key map [rm] (cons "Remove Properties" 'facemenu-remove-props)) (define-key map [s1] (list "-----------------"))) ;;;###autoload (let ((map facemenu-menu)) (define-key map [in] (cons "Indentation" 'facemenu-indentation-menu)) (define-key map [ju] (cons "Justification" 'facemenu-justification-menu)) (define-key map [s2] (list "-----------------")) (define-key map [sp] (cons "Special Properties" 'facemenu-special-menu)) (define-key map [bg] (cons "Background Color" 'facemenu-background-menu)) (define-key map [fg] (cons "Foreground Color" 'facemenu-foreground-menu)) (define-key map [fc] (cons "Face" 'facemenu-face-menu))) ;;;###autoload (defalias 'facemenu-menu facemenu-menu) (defvar facemenu-keymap (let ((map (make-sparse-keymap "Set face"))) (define-key map "o" (cons "Other..." 'facemenu-set-face)) map) "Keymap for face-changing commands. `Facemenu-update' fills in the keymap according to the bindings requested in `facemenu-keybindings'.") (defalias 'facemenu-keymap facemenu-keymap) ;;; Internal Variables (defvar facemenu-color-alist nil ;; Don't initialize here; that doesn't work if preloaded. "Alist of colors, used for completion. If null, `facemenu-read-color' will set it.") (defun facemenu-update () "Add or update the \"Face\" menu in the menu bar. You can call this to update things if you change any of the menu configuration variables." (interactive) ;; Global bindings: (define-key global-map [C-down-mouse-2] 'facemenu-menu) (if facemenu-key (define-key global-map facemenu-key 'facemenu-keymap)) ;; Add each defined face to the menu. (facemenu-iterate 'facemenu-add-new-face (facemenu-complete-face-list facemenu-keybindings))) ;;;###autoload (defun facemenu-set-face (face &optional start end) "Add FACE to the region or next character typed. It will be added to the top of the face list; any faces lower on the list that will not show through at all will be removed. Interactively, the face to be used is read with the minibuffer. If the region is active and there is no prefix argument, this command sets the region to the requested face. Otherwise, this command specifies the face for the next character inserted. Moving point or switching buffers before typing a character to insert cancels the specification." (interactive (list (read-face-name "Use face: "))) (barf-if-buffer-read-only) (facemenu-add-new-face face) (if (and mark-active (not current-prefix-arg)) (let ((start (or start (region-beginning))) (end (or end (region-end)))) (facemenu-add-face face start end)) (facemenu-self-insert-face face))) ;;;###autoload (defun facemenu-set-foreground (color &optional start end) "Set the foreground color of the region or next character typed. The color is prompted for. A face named `fg:color' is used \(or created). If the region is active, it will be set to the requested face. If it is inactive \(even if mark-even-if-inactive is set) the next character that is typed \(via `self-insert-command') will be set to the selected face. Moving point or switching buffers before typing a character cancels the request." (interactive (list (facemenu-read-color "Foreground color: "))) (let ((face (intern (concat "fg:" color)))) (or (facemenu-get-face face) (error "Unknown color: %s" color)) (facemenu-set-face face start end))) ;;;###autoload (defun facemenu-set-background (color &optional start end) "Set the background color of the region or next character typed. The color is prompted for. A face named `bg:color' is used \(or created). If the region is active, it will be set to the requested face. If it is inactive \(even if mark-even-if-inactive is set) the next character that is typed \(via `self-insert-command') will be set to the selected face. Moving point or switching buffers before typing a character cancels the request." (interactive (list (facemenu-read-color "Background color: "))) (let ((face (intern (concat "bg:" color)))) (or (facemenu-get-face face) (error "Unknown color: %s" color)) (facemenu-set-face face start end))) ;;;###autoload (defun facemenu-set-face-from-menu (face start end) "Set the face of the region or next character typed. This function is designed to be called from a menu; the face to use is the menu item's name. If the region is active and there is no prefix argument, this command sets the region to the requested face. Otherwise, this command specifies the face for the next character inserted. Moving point or switching buffers before typing a character to insert cancels the specification." (interactive (list last-command-event (if (and mark-active (not current-prefix-arg)) (region-beginning)) (if (and mark-active (not current-prefix-arg)) (region-end)))) (barf-if-buffer-read-only) (facemenu-get-face face) (if start (facemenu-add-face face start end) (facemenu-self-insert-face face))) (defun facemenu-self-insert-face (face) (setq self-insert-face (if (eq last-command self-insert-face-command) (cons face (if (listp self-insert-face) self-insert-face (list self-insert-face))) face) self-insert-face-command this-command)) ;;;###autoload (defun facemenu-set-invisible (start end) "Make the region invisible. This sets the `invisible' text property; it can be undone with `facemenu-remove-special'." (interactive "r") (put-text-property start end 'invisible t)) ;;;###autoload (defun facemenu-set-intangible (start end) "Make the region intangible: disallow moving into it. This sets the `intangible' text property; it can be undone with `facemenu-remove-special'." (interactive "r") (put-text-property start end 'intangible t)) ;;;###autoload (defun facemenu-set-read-only (start end) "Make the region unmodifiable. This sets the `read-only' text property; it can be undone with `facemenu-remove-special'." (interactive "r") (put-text-property start end 'read-only t)) ;;;###autoload (defun facemenu-remove-props (start end) "Remove all text properties that facemenu added to region." (interactive "*r") ; error if buffer is read-only despite the next line. (let ((inhibit-read-only t)) (remove-text-properties start end '(face nil invisible nil intangible nil read-only nil category nil)))) ;;;###autoload (defun facemenu-remove-all (start end) "Remove all text properties from the region." (interactive "*r") ; error if buffer is read-only despite the next line. (let ((inhibit-read-only t)) (set-text-properties start end nil))) ;;;###autoload (defun facemenu-remove-special (start end) "Remove all the \"special\" text properties from the region. These special properties include `invisible', `intangible' and `read-only'." (interactive "*r") ; error if buffer is read-only despite the next line. (let ((inhibit-read-only t)) (remove-text-properties start end '(invisible nil intangible nil read-only nil)))) ;;;###autoload (defun list-text-properties-at (p) "Pop up a buffer listing text-properties at LOCATION." (interactive "d") (let ((props (text-properties-at p))) (if (null props) (message "None") (with-output-to-temp-buffer "*Text Properties*" (princ (format "Text properties at %d:\n\n" p)) (while props (princ (format "%-20s %S\n" (car props) (car (cdr props)))) (setq props (cdr (cdr props)))))))) ;;;###autoload (defun facemenu-read-color (&optional prompt) "Read a color using the minibuffer." (let ((col (completing-read (or prompt "Color: ") (or facemenu-color-alist (if (or (eq window-system 'x) (eq window-system 'win32)) (mapcar 'list (x-defined-colors)))) nil t))) (if (equal "" col) nil col))) ;;;###autoload (defun list-colors-display (&optional list) "Display names of defined colors, and show what they look like. If the optional argument LIST is non-nil, it should be a list of colors to display. Otherwise, this command computes a list of colors that the current display can handle." (interactive) (if (and (null list) (or (eq window-system 'x) (eq window-system 'win32))) (progn (setq list (x-defined-colors)) ;; Delete duplicate colors. (let ((l list)) (while (cdr l) (if (facemenu-color-equal (car l) (car (cdr l))) (setcdr l (cdr (cdr l))) (setq l (cdr l))))))) (with-output-to-temp-buffer "*Colors*" (save-excursion (set-buffer standard-output) (let ((facemenu-unlisted-faces t) s) (while list (setq s (point)) (insert (car list)) (indent-to 20) (put-text-property s (point) 'face (facemenu-get-face (intern (concat "bg:" (car list))))) (setq s (point)) (insert " " (car list) "\n") (put-text-property s (point) 'face (facemenu-get-face (intern (concat "fg:" (car list))))) (setq list (cdr list))))))) (defun facemenu-color-equal (a b) "Return t if colors A and B are the same color. A and B should be strings naming colors. This function queries the window-system server to find out what the color names mean. It returns nil if the colors differ or if it can't determine the correct answer." (cond ((equal a b) t) ((and (or (eq window-system 'x) (eq window-system 'win32)) (equal (x-color-values a) (x-color-values b)))))) (defun facemenu-add-face (face start end) "Add FACE to text between START and END. For each section of that region that has a different face property, FACE will be consed onto it, and other faces that are completely hidden by that will be removed from the list. As a special case, if FACE is `default', then the region is left with NO face text property. Otherwise, selecting the default face would not have any effect." (interactive "*xFace:\nr") (if (eq face 'default) (remove-text-properties start end '(face default)) (let ((part-start start) part-end) (while (not (= part-start end)) (setq part-end (next-single-property-change part-start 'face nil end)) (let ((prev (get-text-property part-start 'face))) (put-text-property part-start part-end 'face (if (null prev) face (facemenu-active-faces (cons face (if (listp prev) prev (list prev))))))) (setq part-start part-end))))) (defun facemenu-active-faces (face-list &optional frame) "Return from FACE-LIST those faces that would be used for display. This means each face attribute is not specified in a face earlier in FACE-LIST and such a face is therefore active when used to display text. If the optional argument FRAME is given, use the faces in that frame; otherwise use the selected frame. If t, then the global, non-frame faces are used." (let* ((mask-atts (copy-sequence (internal-get-face (car face-list) frame))) (active-list (list (car face-list))) (face-list (cdr face-list)) (mask-len (length mask-atts))) (while face-list (if (let ((face-atts (internal-get-face (car face-list) frame)) (i mask-len) (useful nil)) (while (> (setq i (1- i)) 1) (and (aref face-atts i) (not (aref mask-atts i)) (aset mask-atts i (setq useful t)))) useful) (setq active-list (cons (car face-list) active-list))) (setq face-list (cdr face-list))) (nreverse active-list))) (defun facemenu-get-face (symbol) "Make sure FACE exists. If not, it is created. If it is created and is of the form `fg:color', then set the foreground to that color. If of the form `bg:color', set the background. In any case, add it to the appropriate menu. Returns the face, or nil if given a bad color." (if (or (internal-find-face symbol) (let* ((face (make-face symbol)) (name (symbol-name symbol)) (color (substring name 3))) (cond ((string-match "^fg:" name) (set-face-foreground face color) (and (or (eq window-system 'x) (eq window-system 'win32)) (x-color-defined-p color))) ((string-match "^bg:" name) (set-face-background face color) (and (or (eq window-system 'x) (eq window-system 'win32)) (x-color-defined-p color))) (t)))) symbol)) (defun facemenu-add-new-face (face) "Add a FACE to the appropriate Face menu. Automatically called when a new face is created." (let* ((name (symbol-name face)) (menu (cond ((string-match "^fg:" name) (setq name (substring name 3)) 'facemenu-foreground-menu) ((string-match "^bg:" name) (setq name (substring name 3)) 'facemenu-background-menu) (t 'facemenu-face-menu))) (key (cdr (assoc face facemenu-keybindings))) function menu-val) (cond ((eq t facemenu-unlisted-faces)) ((memq face facemenu-unlisted-faces)) (key ; has a keyboard equivalent. These go at the front. (setq function (intern (concat "facemenu-set-" name))) (fset function (` (lambda () (interactive) (facemenu-set-face (quote (, face)))))) (define-key 'facemenu-keymap key (cons name function)) (define-key menu key (cons name function))) ((facemenu-iterate ; check if equivalent face is already in the menu (lambda (m) (and (listp m) (symbolp (car m)) (face-equal (car m) face))) (cdr (symbol-function menu)))) (t ; No keyboard equivalent. Figure out where to put it: (setq key (vector face) function 'facemenu-set-face-from-menu menu-val (symbol-function menu)) (if (and facemenu-new-faces-at-end (> (length menu-val) 3)) (define-key-after menu-val key (cons name function) (car (nth (- (length menu-val) 3) menu-val))) (define-key menu key (cons name function)))))) nil) ; Return nil for facemenu-iterate (defun facemenu-complete-face-list (&optional oldlist) "Return list of all faces that are look different. Starts with given ALIST of faces, and adds elements only if they display differently from any face already on the list. The faces on ALIST will end up at the end of the returned list, in reverse order." (let ((list (nreverse (mapcar 'car oldlist)))) (facemenu-iterate (lambda (new-face) (if (not (memq new-face list)) (setq list (cons new-face list))) nil) (nreverse (face-list))) list)) (defun facemenu-iterate (func iterate-list) "Apply FUNC to each element of LIST until one returns non-nil. Returns the non-nil value it found, or nil if all were nil." (while (and iterate-list (not (funcall func (car iterate-list)))) (setq iterate-list (cdr iterate-list))) (car iterate-list)) (facemenu-update) ;;; facemenu.el ends here emacs-19.30/lisp/faces.el100444 12120 1 133773 6054206056 13533 0ustar rmsdaemon;;; faces.el --- Lisp interface to the c "face" structure ;; Copyright (C) 1992, 1993, 1994, 1995 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: ;; Mostly derived from Lucid. ;;; Code: (eval-when-compile ;; These used to be defsubsts, now they're subrs. Avoid losing if we're ;; being compiled with an old Emacs that still has defsubrs in it. (put 'face-name 'byte-optimizer nil) (put 'face-id 'byte-optimizer nil) (put 'face-font 'byte-optimizer nil) (put 'face-foreground 'byte-optimizer nil) (put 'face-background 'byte-optimizer nil) (put 'face-stipple 'byte-optimizer nil) (put 'face-underline-p 'byte-optimizer nil) (put 'set-face-font 'byte-optimizer nil) (put 'set-face-foreground 'byte-optimizer nil) (put 'set-face-background 'byte-optimizer nil) (put 'set-face-stipple 'byte-optimizer nil) (put 'set-face-underline-p 'byte-optimizer nil)) ;;;; Functions for manipulating face vectors. ;;; A face vector is a vector of the form: ;;; [face NAME ID FONT FOREGROUND BACKGROUND STIPPLE UNDERLINE] ;;; Type checkers. (defsubst internal-facep (x) (and (vectorp x) (= (length x) 8) (eq (aref x 0) 'face))) (defun facep (x) "Return t if X is a face name or an internal face vector." (and (or (internal-facep x) (and (symbolp x) (assq x global-face-data))) t)) (defmacro internal-check-face (face) (` (or (internal-facep (, face)) (signal 'wrong-type-argument (list 'internal-facep (, face)))))) ;;; Accessors. (defun face-name (face) "Return the name of face FACE." (aref (internal-get-face face) 1)) (defun face-id (face) "Return the internal ID number of face FACE." (aref (internal-get-face face) 2)) (defun face-font (face &optional frame) "Return the font name of face FACE, or nil if it is unspecified. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). The font default for a face is either nil, or a list of the form (bold), (italic) or (bold italic). If FRAME is omitted or nil, use the selected frame." (aref (internal-get-face face frame) 3)) (defun face-foreground (face &optional frame) "Return the foreground color name of face FACE, or nil if unspecified. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." (aref (internal-get-face face frame) 4)) (defun face-background (face &optional frame) "Return the background color name of face FACE, or nil if unspecified. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." (aref (internal-get-face face frame) 5)) (defun face-stipple (face &optional frame) "Return the stipple pixmap name of face FACE, or nil if unspecified. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." (aref (internal-get-face face frame) 6)) (defalias 'face-background-pixmap 'face-stipple) (defun face-underline-p (face &optional frame) "Return t if face FACE is underlined. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." (aref (internal-get-face face frame) 7)) ;;; Mutators. (defun set-face-font (face font &optional frame) "Change the font of face FACE to FONT (a string). If the optional FRAME argument is provided, change only in that frame; otherwise change each frame." (interactive (internal-face-interactive "font")) (if (stringp font) (setq font (x-resolve-font-name font 'default frame))) (internal-set-face-1 face 'font font 3 frame)) (defun set-face-foreground (face color &optional frame) "Change the foreground color of face FACE to COLOR (a string). If the optional FRAME argument is provided, change only in that frame; otherwise change each frame." (interactive (internal-face-interactive "foreground")) (internal-set-face-1 face 'foreground color 4 frame)) (defvar face-default-stipple "gray3" "Default stipple pattern used on monochrome displays. This stipple pattern is used on monochrome displays instead of shades of gray for a face background color. See `set-face-stipple' for possible values for this variable.") (defun face-color-gray-p (color &optional frame) "Return t if COLOR is a shade of gray (or white or black). FRAME specifies the frame and thus the display for interpreting COLOR." (let* ((values (x-color-values color frame)) (r (nth 0 values)) (g (nth 1 values)) (b (nth 2 values))) (and (< (abs (- r g)) (/ (max 1 (abs r) (abs g)) 20)) (< (abs (- g b)) (/ (max 1 (abs g) (abs b)) 20)) (< (abs (- b r)) (/ (max 1 (abs b) (abs r)) 20))))) (defun set-face-background (face color &optional frame) "Change the background color of face FACE to COLOR (a string). If the optional FRAME argument is provided, change only in that frame; otherwise change each frame." (interactive (internal-face-interactive "background")) ;; For a specific frame, use gray stipple instead of gray color ;; if the display does not support a gray color. (if (and frame (not (eq frame t)) color ;; Check for supportedness for foreground, not for background! ;; face-color-supported-p is smart enough to know ;; that grays are "supported" as background ;; because we are supposed to use stipple for them! (not (face-color-supported-p frame color nil))) (set-face-stipple face face-default-stipple frame) (if (null frame) (let ((frames (frame-list))) (while frames (set-face-background (face-name face) color (car frames)) (setq frames (cdr frames))) (set-face-background face color t) color) (internal-set-face-1 face 'background color 5 frame)))) (defun set-face-stipple (face pixmap &optional frame) "Change the stipple pixmap of face FACE to PIXMAP. PIXMAP should be a string, the name of a file of pixmap data. The directories listed in the `x-bitmap-file-path' variable are searched. Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is a string, containing the raw bits of the bitmap. If the optional FRAME argument is provided, change only in that frame; otherwise change each frame." (interactive (internal-face-interactive "stipple")) (internal-set-face-1 face 'background-pixmap pixmap 6 frame)) (defalias 'set-face-background-pixmap 'set-face-stipple) (defun set-face-underline-p (face underline-p &optional frame) "Specify whether face FACE is underlined. (Yes if UNDERLINE-P is non-nil.) If the optional FRAME argument is provided, change only in that frame; otherwise change each frame." (interactive (internal-face-interactive "underline-p" "underlined")) (internal-set-face-1 face 'underline underline-p 7 frame)) (defun modify-face-read-string (face default name alist) (let ((value (completing-read (if default (format "Set face %s %s (default %s): " face name (downcase default)) (format "Set face %s %s: " face name)) alist))) (cond ((equal value "none") nil) ((equal value "") default) (t value)))) (defun modify-face (face foreground background stipple bold-p italic-p underline-p) "Change the display attributes for face FACE. FOREGROUND and BACKGROUND should be color strings or nil. STIPPLE should be a stipple pattern name or nil. BOLD-P, ITALIC-P, and UNDERLINE-P specify whether the face should be set bold, in italic, and underlined, respectively. (Yes if non-nil.) If called interactively, prompts for a face and face attributes." (interactive (let* ((completion-ignore-case t) (face (symbol-name (read-face-name "Modify face: "))) (colors (mapcar 'list x-colors)) (stipples (mapcar 'list (apply 'nconc (mapcar 'directory-files x-bitmap-file-path)))) (foreground (modify-face-read-string face (face-foreground (intern face)) "foreground" colors)) (background (modify-face-read-string face (face-background (intern face)) "background" colors)) (stipple (modify-face-read-string face (face-stipple (intern face)) "stipple" stipples)) (bold-p (y-or-n-p (concat "Set face " face " bold "))) (italic-p (y-or-n-p (concat "Set face " face " italic "))) (underline-p (y-or-n-p (concat "Set face " face " underline ")))) (message "Face %s: %s" face (mapconcat 'identity (delq nil (list (and foreground (concat (downcase foreground) " foreground")) (and background (concat (downcase background) " background")) (and stipple (concat (downcase stipple) " stipple")) (and bold-p "bold") (and italic-p "italic") (and underline-p "underline"))) ", ")) (list (intern face) foreground background stipple bold-p italic-p underline-p))) (condition-case nil (set-face-foreground face foreground) (error nil)) (condition-case nil (set-face-background face background) (error nil)) (condition-case nil (set-face-stipple face stipple) (error nil)) (funcall (if bold-p 'make-face-bold 'make-face-unbold) face nil t) (funcall (if italic-p 'make-face-italic 'make-face-unitalic) face nil t) (set-face-underline-p face underline-p) (and (interactive-p) (redraw-display))) ;;;; Associating face names (symbols) with their face vectors. (defvar global-face-data nil "Internal data for face support functions. Not for external use. This is an alist associating face names with the default values for their parameters. Newly created frames get their data from here.") (defun face-list () "Returns a list of all defined face names." (mapcar 'car global-face-data)) (defun internal-find-face (name &optional frame) "Retrieve the face named NAME. Return nil if there is no such face. If the optional argument FRAME is given, this gets the face NAME for that frame; otherwise, it uses the selected frame. If FRAME is the symbol t, then the global, non-frame face is returned. If NAME is already a face, it is simply returned." (if (and (eq frame t) (not (symbolp name))) (setq name (face-name name))) (if (symbolp name) (cdr (assq name (if (eq frame t) global-face-data (frame-face-alist (or frame (selected-frame)))))) (internal-check-face name) name)) (defun internal-get-face (name &optional frame) "Retrieve the face named NAME; error if there is none. If the optional argument FRAME is given, this gets the face NAME for that frame; otherwise, it uses the selected frame. If FRAME is the symbol t, then the global, non-frame face is returned. If NAME is already a face, it is simply returned." (or (internal-find-face name frame) (internal-check-face name))) (defun internal-set-face-1 (face name value index frame) (let ((inhibit-quit t)) (if (null frame) (let ((frames (frame-list))) (while frames (internal-set-face-1 (face-name face) name value index (car frames)) (setq frames (cdr frames))) (aset (internal-get-face (if (symbolp face) face (face-name face)) t) index value) value) (or (eq frame t) (set-face-attribute-internal (face-id face) name value frame)) (aset (internal-get-face face frame) index value)))) (defun read-face-name (prompt) (let (face) (while (= (length face) 0) (setq face (completing-read prompt (mapcar '(lambda (x) (list (symbol-name x))) (face-list)) nil t))) (intern face))) (defun internal-face-interactive (what &optional bool) (let* ((fn (intern (concat "face-" what))) (prompt (concat "Set " what " of face")) (face (read-face-name (concat prompt ": "))) (default (if (fboundp fn) (or (funcall fn face (selected-frame)) (funcall fn 'default (selected-frame))))) (value (if bool (y-or-n-p (concat "Should face " (symbol-name face) " be " bool "? ")) (read-string (concat prompt " " (symbol-name face) " to: ") default)))) (list face (if (equal value "") nil value)))) (defun make-face (name) "Define a new FACE on all frames. You can modify the font, color, etc of this face with the set-face- functions. If the face already exists, it is unmodified." (interactive "SMake face: ") (or (internal-find-face name) (let ((face (make-vector 8 nil))) (aset face 0 'face) (aset face 1 name) (let* ((frames (frame-list)) (inhibit-quit t) (id (internal-next-face-id))) (make-face-internal id) (aset face 2 id) (while frames (set-frame-face-alist (car frames) (cons (cons name (copy-sequence face)) (frame-face-alist (car frames)))) (setq frames (cdr frames))) (setq global-face-data (cons (cons name face) global-face-data))) ;; when making a face after frames already exist (if (or (eq window-system 'x) (eq window-system 'win32)) (make-face-x-resource-internal face)) ;; add to menu (if (fboundp 'facemenu-add-new-face) (facemenu-add-new-face name)) face)) name) ;; Fill in a face by default based on X resources, for all existing frames. ;; This has to be done when a new face is made. (defun make-face-x-resource-internal (face &optional frame set-anyway) (cond ((null frame) (let ((frames (frame-list))) (while frames (if (or (eq (framep (car frames)) 'x) (eq (framep (car frames)) 'win32)) (make-face-x-resource-internal (face-name face) (car frames) set-anyway)) (setq frames (cdr frames))))) (t (setq face (internal-get-face (face-name face) frame)) ;; ;; These are things like "attributeForeground" instead of simply ;; "foreground" because people tend to do things like "*foreground", ;; which would cause all faces to be fully qualified, making faces ;; inherit attributes in a non-useful way. So we've made them slightly ;; less obvious to specify in order to make them work correctly in ;; more random environments. ;; ;; I think these should be called "face.faceForeground" instead of ;; "face.attributeForeground", but they're the way they are for ;; hysterical reasons. ;; (let* ((name (symbol-name (face-name face))) (fn (or (x-get-resource (concat name ".attributeFont") "Face.AttributeFont") (and set-anyway (face-font face)))) (fg (or (x-get-resource (concat name ".attributeForeground") "Face.AttributeForeground") (and set-anyway (face-foreground face)))) (bg (or (x-get-resource (concat name ".attributeBackground") "Face.AttributeBackground") (and set-anyway (face-background face)))) (bgp (or (x-get-resource (concat name ".attributeStipple") "Face.AttributeStipple") (x-get-resource (concat name ".attributeBackgroundPixmap") "Face.AttributeBackgroundPixmap") (and set-anyway (face-stipple face)))) (ulp (let ((resource (x-get-resource (concat name ".attributeUnderline") "Face.AttributeUnderline"))) (if resource (member (downcase resource) '("on" "true")) (and set-anyway (face-underline-p face))))) ) (if fn (condition-case () (cond ((string= fn "italic") (make-face-italic face)) ((string= fn "bold") (make-face-bold face)) ((string= fn "bold-italic") (make-face-bold-italic face)) (t (set-face-font face fn frame))) (error (if (member fn '("italic" "bold" "bold-italic")) (message "no %s version found for face `%s'" fn name) (message "font `%s' not found for face `%s'" fn name))))) (if fg (condition-case () (set-face-foreground face fg frame) (error (message "color `%s' not allocated for face `%s'" fg name)))) (if bg (condition-case () (set-face-background face bg frame) (error (message "color `%s' not allocated for face `%s'" bg name)))) (if bgp (condition-case () (set-face-stipple face bgp frame) (error (message "pixmap `%s' not found for face `%s'" bgp name)))) (if (or ulp set-anyway) (set-face-underline-p face ulp frame)) ))) face) (defun copy-face (old-face new-face &optional frame new-frame) "Define a face just like OLD-FACE, with name NEW-FACE. If NEW-FACE already exists as a face, it is modified to be like OLD-FACE. If it doesn't already exist, it is created. If the optional argument FRAME is given as a frame, NEW-FACE is changed on FRAME only. If FRAME is t, the frame-independent default specification for OLD-FACE is copied to NEW-FACE. If FRAME is nil, copying is done for the frame-independent defaults and for each existing frame. If the optional fourth argument NEW-FRAME is given, copy the information from face OLD-FACE on frame FRAME to NEW-FACE on frame NEW-FRAME." (or new-frame (setq new-frame frame)) (let ((inhibit-quit t)) (if (null frame) (let ((frames (frame-list))) (while frames (copy-face old-face new-face (car frames)) (setq frames (cdr frames))) (copy-face old-face new-face t)) (setq old-face (internal-get-face old-face frame)) (setq new-face (or (internal-find-face new-face new-frame) (make-face new-face))) (condition-case nil ;; A face that has a global symbolic font modifier such as `bold' ;; might legitimately get an error here. ;; Use the frame's default font in that case. (set-face-font new-face (face-font old-face frame) new-frame) (error (set-face-font new-face nil 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-stipple new-face (face-stipple old-face frame) new-frame) (set-face-underline-p new-face (face-underline-p old-face frame) new-frame)) new-face)) (defun face-equal (face1 face2 &optional frame) "True if the faces FACE1 and FACE2 display in the same way." (setq face1 (internal-get-face face1 frame) face2 (internal-get-face face2 frame)) (and (equal (face-foreground face1 frame) (face-foreground face2 frame)) (equal (face-background face1 frame) (face-background face2 frame)) (equal (face-font face1 frame) (face-font face2 frame)) (eq (face-underline-p face1 frame) (face-underline-p face2 frame)) (equal (face-stipple face1 frame) (face-stipple face2 frame)))) (defun face-differs-from-default-p (face &optional frame) "True if face FACE displays differently from the default face, on FRAME. A face is considered to be ``the same'' as the default face if it is actually specified in the same way (equivalent fonts, etc) or if it is fully unspecified, and thus inherits the attributes of any face it is displayed on top of. The optional argument FRAME specifies which frame to test; if FRAME is t, test the default for new frames. If FRAME is nil or omitted, test the selected frame." (let ((default (internal-get-face 'default frame))) (setq face (internal-get-face face frame)) (not (and (or (equal (face-foreground default frame) (face-foreground face frame)) (null (face-foreground face frame))) (or (equal (face-background default frame) (face-background face frame)) (null (face-background face frame))) (or (equal (face-font default frame) (face-font face frame)) (null (face-font face frame))) (or (equal (face-stipple default frame) (face-stipple face frame)) (null (face-stipple face frame))) (equal (face-underline-p default frame) (face-underline-p face frame)) )))) (defun face-nontrivial-p (face &optional frame) "True if face FACE has some non-nil attribute. The optional argument FRAME specifies which frame to test; if FRAME is t, test the default for new frames. If FRAME is nil or omitted, test the selected frame." (setq face (internal-get-face face frame)) (or (face-foreground face frame) (face-background face frame) (face-font face frame) (face-stipple face frame) (face-underline-p face frame))) (defun invert-face (face &optional frame) "Swap the foreground and background colors of face FACE. If the face doesn't specify both foreground and background, then set its foreground and background to the default background and foreground." (interactive (list (read-face-name "Invert face: "))) (setq face (internal-get-face face frame)) (let ((fg (face-foreground face frame)) (bg (face-background face frame))) (if (or fg bg) (progn (set-face-foreground face bg frame) (set-face-background face fg frame)) (set-face-foreground face (or (face-background 'default frame) (cdr (assq 'background-color (frame-parameters frame)))) frame) (set-face-background face (or (face-foreground 'default frame) (cdr (assq 'foreground-color (frame-parameters frame)))) frame))) face) (defun internal-try-face-font (face font &optional frame) "Like set-face-font, but returns nil on failure instead of an error." (condition-case () (set-face-font face font frame) (error nil))) ;; Manipulating font names. (defconst x-font-regexp nil) (defconst x-font-regexp-head nil) (defconst x-font-regexp-weight nil) (defconst x-font-regexp-slant nil) (defconst x-font-regexp-weight-subnum 1) (defconst x-font-regexp-slant-subnum 2) (defconst x-font-regexp-swidth-subnum 3) (defconst x-font-regexp-adstyle-subnum 4) ;;; Regexps matching font names in "Host Portable Character Representation." ;;; (let ((- "[-?]") (foundry "[^-]+") (family "[^-]+") (weight "\\(bold\\|demibold\\|medium\\)") ; 1 ; (weight\? "\\(\\*\\|bold\\|demibold\\|medium\\|\\)") ; 1 (weight\? "\\([^-]*\\)") ; 1 (slant "\\([ior]\\)") ; 2 ; (slant\? "\\([ior?*]?\\)") ; 2 (slant\? "\\([^-]?\\)") ; 2 ; (swidth "\\(\\*\\|normal\\|semicondensed\\|\\)") ; 3 (swidth "\\([^-]*\\)") ; 3 ; (adstyle "\\(\\*\\|sans\\|\\)") ; 4 (adstyle "\\([^-]*\\)") ; 4 (pixelsize "[0-9]+") (pointsize "[0-9][0-9]+") (resx "[0-9][0-9]+") (resy "[0-9][0-9]+") (spacing "[cmp?*]") (avgwidth "[0-9]+") (registry "[^-]+") (encoding "[^-]+") ) (setq x-font-regexp (concat "\\`\\*?[-?*]" foundry - family - weight\? - slant\? - swidth - adstyle - pixelsize - pointsize - resx - resy - spacing - avgwidth - registry - encoding "\\*?\\'" )) (setq x-font-regexp-head (concat "\\`[-?*]" foundry - family - weight\? - slant\? "\\([-*?]\\|\\'\\)")) (setq x-font-regexp-slant (concat - slant -)) (setq x-font-regexp-weight (concat - weight -)) nil) (defun x-resolve-font-name (pattern &optional face frame) "Return a font name matching PATTERN. All wildcards in PATTERN become substantiated. If PATTERN is nil, return the name of the frame's base font, which never contains wildcards. Given optional arguments FACE and FRAME, return a font which is also the same size as FACE on FRAME, or fail." (or (symbolp face) (setq face (face-name face))) (and (eq frame t) (setq frame nil)) (if pattern ;; Note that x-list-fonts has code to handle a face with nil as its font. (let ((fonts (x-list-fonts pattern face frame))) (or fonts (if face (if (string-match "\\*" pattern) (if (null (face-font face)) (error "No matching fonts are the same height as the frame default font") (error "No matching fonts are the same height as face `%s'" face)) (if (null (face-font face)) (error "Height of font `%s' doesn't match the frame default font" pattern) (error "Height of font `%s' doesn't match face `%s'" pattern face))) (error "No fonts match `%s'" pattern))) (car fonts)) (cdr (assq 'font (frame-parameters (selected-frame)))))) (defun x-frob-font-weight (font which) (cond ((string-match x-font-regexp font) (concat (substring font 0 (match-beginning x-font-regexp-weight-subnum)) which (substring font (match-end x-font-regexp-weight-subnum) (match-beginning x-font-regexp-adstyle-subnum)) ;; Replace the ADD_STYLE_NAME field with * ;; because the info in it may not be the same ;; for related fonts. "*" (substring font (match-end x-font-regexp-adstyle-subnum)))) ((or (string-match x-font-regexp-head font) (string-match x-font-regexp-weight font)) (concat (substring font 0 (match-beginning 1)) which (substring font (match-end 1)))))) (defun x-frob-font-slant (font which) (cond ((string-match x-font-regexp font) (concat (substring font 0 (match-beginning x-font-regexp-slant-subnum)) which (substring font (match-end x-font-regexp-slant-subnum) (match-beginning x-font-regexp-adstyle-subnum)) ;; Replace the ADD_STYLE_NAME field with * ;; because the info in it may not be the same ;; for related fonts. "*" (substring font (match-end x-font-regexp-adstyle-subnum)))) ((or (string-match x-font-regexp-head font) (string-match x-font-regexp-slant font)) (concat (substring font 0 (match-beginning 1)) which (substring font (match-end 1)))))) (defun x-make-font-bold (font) "Given an X font specification, make a bold version of it. If that can't be done, return nil." (x-frob-font-weight font "bold")) (defun x-make-font-demibold (font) "Given an X font specification, make a demibold version of it. If that can't be done, return nil." (x-frob-font-weight font "demibold")) (defun x-make-font-unbold (font) "Given an X font specification, make a non-bold version of it. If that can't be done, return nil." (x-frob-font-weight font "medium")) (defun x-make-font-italic (font) "Given an X font specification, make an italic version of it. If that can't be done, return nil." (x-frob-font-slant font "i")) (defun x-make-font-oblique (font) ; you say tomayto... "Given an X font specification, make an oblique version of it. If that can't be done, return nil." (x-frob-font-slant font "o")) (defun x-make-font-unitalic (font) "Given an X font specification, make a non-italic version of it. If that can't be done, return nil." (x-frob-font-slant font "r")) ;;; non-X-specific interface (defun make-face-bold (face &optional frame noerror) "Make the font of the given face be bold, if possible. If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face bold: "))) (if (and (eq frame t) (listp (face-font face t))) (set-face-font face (if (memq 'italic (face-font face t)) '(bold italic) '(bold)) t) (let (font) (if (null frame) (let ((frames (frame-list))) ;; Make this face bold in global-face-data. (make-face-bold face t noerror) ;; Make this face bold in each frame. (while frames (make-face-bold face (car frames) noerror) (setq frames (cdr frames)))) (setq face (internal-get-face face frame)) (setq font (or (face-font face frame) (face-font face t))) (if (listp font) (setq font nil)) (setq font (or font (face-font 'default frame) (cdr (assq 'font (frame-parameters frame))))) (or (and font (make-face-bold-internal face frame font)) ;; We failed to find a bold version of the font. noerror (error "No bold version of %S" font)))))) (defun make-face-bold-internal (face frame font) (let (f2) (or (and (setq f2 (x-make-font-bold font)) (internal-try-face-font face f2 frame)) (and (setq f2 (x-make-font-demibold font)) (internal-try-face-font face f2 frame))))) (defun make-face-italic (face &optional frame noerror) "Make the font of the given face be italic, if possible. If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face italic: "))) (if (and (eq frame t) (listp (face-font face t))) (set-face-font face (if (memq 'bold (face-font face t)) '(bold italic) '(italic)) t) (let (font) (if (null frame) (let ((frames (frame-list))) ;; Make this face italic in global-face-data. (make-face-italic face t noerror) ;; Make this face italic in each frame. (while frames (make-face-italic face (car frames) noerror) (setq frames (cdr frames)))) (setq face (internal-get-face face frame)) (setq font (or (face-font face frame) (face-font face t))) (if (listp font) (setq font nil)) (setq font (or font (face-font 'default frame) (cdr (assq 'font (frame-parameters frame))))) (or (and font (make-face-italic-internal face frame font)) ;; We failed to find an italic version of the font. noerror (error "No italic version of %S" font)))))) (defun make-face-italic-internal (face frame font) (let (f2) (or (and (setq f2 (x-make-font-italic font)) (internal-try-face-font face f2 frame)) (and (setq f2 (x-make-font-oblique font)) (internal-try-face-font face f2 frame))))) (defun make-face-bold-italic (face &optional frame noerror) "Make the font of the given face be bold and italic, if possible. If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face bold-italic: "))) (if (and (eq frame t) (listp (face-font face t))) (set-face-font face '(bold italic) t) (let (font) (if (null frame) (let ((frames (frame-list))) ;; Make this face bold-italic in global-face-data. (make-face-bold-italic face t noerror) ;; Make this face bold in each frame. (while frames (make-face-bold-italic face (car frames) noerror) (setq frames (cdr frames)))) (setq face (internal-get-face face frame)) (setq font (or (face-font face frame) (face-font face t))) (if (listp font) (setq font nil)) (setq font (or font (face-font 'default frame) (cdr (assq 'font (frame-parameters frame))))) (or (and font (make-face-bold-italic-internal face frame font)) ;; We failed to find a bold italic version. noerror (error "No bold italic version of %S" font)))))) (defun make-face-bold-italic-internal (face frame font) (let (f2 f3) (or (and (setq f2 (x-make-font-italic font)) (not (equal font f2)) (setq f3 (x-make-font-bold f2)) (not (equal f2 f3)) (internal-try-face-font face f3 frame)) (and (setq f2 (x-make-font-oblique font)) (not (equal font f2)) (setq f3 (x-make-font-bold f2)) (not (equal f2 f3)) (internal-try-face-font face f3 frame)) (and (setq f2 (x-make-font-italic font)) (not (equal font f2)) (setq f3 (x-make-font-demibold f2)) (not (equal f2 f3)) (internal-try-face-font face f3 frame)) (and (setq f2 (x-make-font-oblique font)) (not (equal font f2)) (setq f3 (x-make-font-demibold f2)) (not (equal f2 f3)) (internal-try-face-font face f3 frame))))) (defun make-face-unbold (face &optional frame noerror) "Make the font of the given face be non-bold, if possible. If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face non-bold: "))) (if (and (eq frame t) (listp (face-font face t))) (set-face-font face (if (memq 'italic (face-font face t)) '(italic) nil) t) (let (font font1) (if (null frame) (let ((frames (frame-list))) ;; Make this face unbold in global-face-data. (make-face-unbold face t noerror) ;; Make this face unbold in each frame. (while frames (make-face-unbold face (car frames) noerror) (setq frames (cdr frames)))) (setq face (internal-get-face face frame)) (setq font1 (or (face-font face frame) (face-font face t))) (if (listp font1) (setq font1 nil)) (setq font1 (or font1 (face-font 'default frame) (cdr (assq 'font (frame-parameters frame))))) (setq font (and font1 (x-make-font-unbold font1))) (or (if font (internal-try-face-font face font frame)) noerror (error "No unbold version of %S" font1)))))) (defun make-face-unitalic (face &optional frame noerror) "Make the font of the given face be non-italic, if possible. If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face non-italic: "))) (if (and (eq frame t) (listp (face-font face t))) (set-face-font face (if (memq 'bold (face-font face t)) '(bold) nil) t) (let (font font1) (if (null frame) (let ((frames (frame-list))) ;; Make this face unitalic in global-face-data. (make-face-unitalic face t noerror) ;; Make this face unitalic in each frame. (while frames (make-face-unitalic face (car frames) noerror) (setq frames (cdr frames)))) (setq face (internal-get-face face frame)) (setq font1 (or (face-font face frame) (face-font face t))) (if (listp font1) (setq font1 nil)) (setq font1 (or font1 (face-font 'default frame) (cdr (assq 'font (frame-parameters frame))))) (setq font (and font1 (x-make-font-unitalic font1))) (or (if font (internal-try-face-font face font frame)) 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) ;; If the sample text has multiple lines, line up all of them. (goto-char beg) (forward-line 1) (while (not (eobp)) (insert " ") (forward-line 1)))) (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))))))) (defun describe-face (face) "Display the properties of face FACE." (interactive (list (read-face-name "Describe face: "))) (with-output-to-temp-buffer "*Help*" (princ "Properties of face `") (princ (face-name face)) (princ "':") (terpri) (princ "Foreground: ") (princ (face-foreground face)) (terpri) (princ "Background: ") (princ (face-background face)) (terpri) (princ " Font: ") (princ (face-font face)) (terpri) (princ "Underlined: ") (princ (if (face-underline-p face) "yes" "no")) (terpri) (princ " Stipple: ") (princ (or (face-stipple face) "none")))) ;;; Make the standard faces. ;;; The C code knows the default and modeline faces as faces 0 and 1, ;;; so they must be the first two faces made. (defun face-initialize () (make-face 'default) (make-face 'modeline) (make-face 'highlight) ;; These aren't really special in any way, but they're nice to have around. (make-face 'bold) (make-face 'italic) (make-face 'bold-italic) (make-face 'region) (make-face 'secondary-selection) (make-face 'underline) (setq region-face (face-id 'region)) ;; Specify the global properties of these faces ;; so they will come out right on new frames. (make-face-bold 'bold t) (make-face-italic 'italic t) (make-face-bold-italic 'bold-italic t) (set-face-background 'highlight '("darkseagreen2" "green" t) t) (set-face-background 'region '("gray" underline) t) (set-face-background 'secondary-selection '("paleturquoise" "green" t) t) (set-face-background 'modeline '(t) t) (set-face-underline-p 'underline t t) ;; Set up the faces of all existing X Window frames ;; from those global properties, unless already set in a given frame. (let ((frames (frame-list))) (while frames (if (not (memq (framep (car frames)) '(t nil))) (let ((frame (car frames)) (rest global-face-data)) (while rest (let ((face (car (car rest)))) (or (face-differs-from-default-p face) (face-fill-in face (cdr (car rest)) frame))) (setq rest (cdr rest))))) (setq frames (cdr frames))))) ;; Like x-create-frame but also set up the faces. (defun x-create-frame-with-faces (&optional parameters) ;; Read this frame's geometry resource, if it has an explicit name, ;; and put the specs into PARAMETERS. (let* ((name (or (cdr (assq 'name parameters)) (cdr (assq 'name default-frame-alist)))) (x-resource-name name) (res-geometry (if name (x-get-resource "geometry" "Geometry"))) parsed) (if res-geometry (progn (setq parsed (x-parse-geometry res-geometry)) ;; If the resource specifies a position, ;; call the position and size "user-specified". (if (or (assq 'top parsed) (assq 'left parsed)) (setq parsed (cons '(user-position . t) (cons '(user-size . t) parsed)))) ;; Put the geometry parameters at the end. ;; Copy default-frame-alist so that they go after it. (setq parameters (append parameters default-frame-alist parsed))))) (let (frame) (if (null global-face-data) (setq frame (x-create-frame parameters)) (let* ((visibility-spec (assq 'visibility parameters)) (faces (copy-alist global-face-data)) success (rest faces)) (setq frame (x-create-frame (cons '(visibility . nil) parameters))) (unwind-protect (progn (set-frame-face-alist frame faces) (if (cdr (or (assq 'reverse parameters) (assq 'reverse default-frame-alist) (let ((resource (x-get-resource "reverseVideo" "ReverseVideo"))) (if resource (cons nil (member (downcase resource) '("on" "true"))))))) (let* ((params (frame-parameters frame)) (bg (cdr (assq 'foreground-color params))) (fg (cdr (assq 'background-color params)))) (modify-frame-parameters frame (list (cons 'foreground-color fg) (cons 'background-color bg))) (if (equal bg (cdr (assq 'border-color params))) (modify-frame-parameters frame (list (cons 'border-color fg)))) (if (equal bg (cdr (assq 'mouse-color params))) (modify-frame-parameters frame (list (cons 'mouse-color fg)))) (if (equal bg (cdr (assq 'cursor-color params))) (modify-frame-parameters frame (list (cons 'cursor-color fg)))))) ;; Copy the vectors that represent the faces. ;; Also fill them in from X resources. (while rest (let ((global (cdr (car rest)))) (setcdr (car rest) (vector 'face (face-name (cdr (car rest))) (face-id (cdr (car rest))) nil nil nil nil nil)) (face-fill-in (car (car rest)) global frame)) (make-face-x-resource-internal (cdr (car rest)) frame t) (setq rest (cdr rest))) (if (null visibility-spec) (make-frame-visible frame) (modify-frame-parameters frame (list visibility-spec))) (setq success t)) (or success (delete-frame frame))))) ;; Set up the background-mode frame parameter ;; so that programs can decide good ways of highlighting ;; on this frame. (let ((bg-resource (x-get-resource ".backgroundMode" "BackgroundMode")) (params (frame-parameters frame)) (bg-mode)) (setq bg-mode (cond (bg-resource (intern (downcase bg-resource))) ((< (apply '+ (x-color-values (cdr (assq 'background-color params)) frame)) (/ (apply '+ (x-color-values "white" frame)) 3)) 'dark) (t 'light))) (modify-frame-parameters frame (list (cons 'background-mode bg-mode) (cons 'display-type (cond ((x-display-color-p frame) 'color) ((x-display-grayscale-p frame) 'grayscale) (t 'mono)))))) frame)) ;; Update a frame's faces when we change its default font. (defun frame-update-faces (frame) (let* ((faces global-face-data) (rest faces)) (while rest (let* ((face (car (car rest))) (font (face-font face t))) (if (listp font) (let ((bold (memq 'bold font)) (italic (memq 'italic font))) ;; Ignore any previous (string-valued) font, it might not even ;; be the right size anymore. (set-face-font face nil frame) (cond ((and bold italic) (make-face-bold-italic face frame t)) (bold (make-face-bold face frame t)) (italic (make-face-italic face frame t))))) (setq rest (cdr rest))) frame))) ;; Update the colors of FACE, after FRAME's own colors have been changed. ;; This applies only to faces with global color specifications ;; that are not simple constants. (defun frame-update-face-colors (frame) (let ((faces global-face-data)) (while faces (condition-case nil (let* ((data (cdr (car faces))) (face (car (car faces))) (foreground (face-foreground data)) (background (face-background data))) ;; If the global spec is a specific color, ;; which doesn't depend on the frame's attributes, ;; we don't need to recalculate it now. (or (listp foreground) (setq foreground nil)) (or (listp background) (setq background nil)) ;; If we are going to frob this face at all, ;; reinitialize it first. (if (or foreground background) (progn (set-face-foreground face nil frame) (set-face-background face nil frame))) (if foreground (face-try-color-list 'set-face-foreground face foreground frame)) (if background (face-try-color-list 'set-face-background face background frame))) (error nil)) (setq faces (cdr faces))))) ;; Fill in the face FACE from frame-independent face data DATA. ;; DATA should be the non-frame-specific ("global") face vector ;; for the face. FACE should be a face name or face object. ;; FRAME is the frame to act on; it must be an actual frame, not nil or t. (defun face-fill-in (face data frame) (condition-case nil (let ((foreground (face-foreground data)) (background (face-background data)) (font (face-font data)) (stipple (face-stipple data))) (set-face-underline-p face (face-underline-p data) frame) (if foreground (face-try-color-list 'set-face-foreground face foreground frame)) (if background (face-try-color-list 'set-face-background face background frame)) (if (listp font) (let ((bold (memq 'bold font)) (italic (memq 'italic font))) (cond ((and bold italic) (make-face-bold-italic face frame)) (bold (make-face-bold face frame)) (italic (make-face-italic face frame)))) (if font (set-face-font face font frame))) (if stipple (set-face-stipple face stipple frame))) (error nil))) ;; Assuming COLOR is a valid color name, ;; return t if it can be displayed on FRAME. (defun face-color-supported-p (frame color background-p) (and window-system (or (x-display-color-p frame) ;; A black-and-white display can implement these. (member color '("black" "white")) ;; A black-and-white display can fake gray for background. (and background-p (face-color-gray-p color frame)) ;; A grayscale display can implement colors that are gray (more or less). (and (x-display-grayscale-p frame) (face-color-gray-p color frame))))) ;; Use FUNCTION to store a color in FACE on FRAME. ;; COLORS is either a single color or a list of colors. ;; If it is a list, try the colors one by one until one of them ;; succeeds. We signal an error only if all the colors failed. ;; t as COLORS or as an element of COLORS means to invert the face. ;; That can't fail, so any subsequent elements after the t are ignored. (defun face-try-color-list (function face colors frame) (if (stringp colors) (if (face-color-supported-p frame colors (eq function 'set-face-background)) (funcall function face colors frame)) (if (eq colors t) (invert-face face frame) (let (done) (while (and colors (not done)) (if (or (memq (car colors) '(t underline)) (face-color-supported-p frame (car colors) (eq function 'set-face-background))) (if (cdr colors) ;; If there are more colors to try, catch errors ;; and set `done' if we succeed. (condition-case nil (progn (cond ((eq (car colors) t) (invert-face face frame)) ((eq (car colors) 'underline) (set-face-underline-p face t frame)) (t (funcall function face (car colors) frame))) (setq done t)) (error nil)) ;; If this is the last color, let the error get out if it fails. ;; If it succeeds, we will exit anyway after this iteration. (cond ((eq (car colors) t) (invert-face face frame)) ((eq (car colors) 'underline) (set-face-underline-p face t frame)) (t (funcall function face (car colors) frame))))) (setq colors (cdr colors))))))) ;; If we are already using x-window frames, initialize faces for them. (if (or (eq (framep (selected-frame)) 'x) (eq (framep (selected-frame)) 'win32)) (face-initialize)) (provide 'faces) ;;; faces.el ends here emacs-19.30/lisp/fast-lock.el100444 22542 1 71307 6043707113 14642 0ustar simondaemon;;; fast-lock.el --- Automagic text properties caching for fast Font Lock mode. ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Simon Marshall ;; Keywords: faces files ;; Version: 3.08 ;;; 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: ;; Purpose: ;; ;; To make visiting a file in `font-lock-mode' faster by restoring its face ;; text properties from automatically saved associated Font Lock cache files. ;; ;; See caveats and feedback below. ;; See also the lazy-lock package. (But don't use the two at the same time!) ;; Installation: ;; ;; Put in your ~/.emacs: ;; ;; (add-hook 'font-lock-mode-hook 'turn-on-fast-lock) ;; ;; Start up a new Emacs and use font-lock as usual (except that you can use the ;; so-called "gaudier" fontification regexps on big files without frustration). ;; ;; When you visit a file (which has `font-lock-mode' enabled) that has a ;; corresponding Font Lock cache file associated with it, the Font Lock cache ;; will be loaded from that file instead of being generated by Font Lock code. ;; Caveats: ;; ;; A cache will be saved when visiting a compressed file using crypt++, but not ;; be read. This is a "feature"/"consequence"/"bug" of crypt++. ;; ;; Version control packages are likely to stamp all over file modification ;; times. Therefore the act of checking out may invalidate a cache. ;; Feedback: ;; ;; Feedback is welcome. ;; To submit a bug report (or make comments) please use the mechanism provided: ;; ;; M-x fast-lock-submit-bug-report RET ;; History: ;; ;; 0.02--1.00: ;; - Changed name from turbo-prop to fast-lock. Automagic for font-lock only. ;; - Made `fast-lock-mode' a minor mode, like G. Dinesh Dutt's fss-mode. ;; 1.00--1.01: ;; - Turn on `fast-lock-mode' only if `buffer-file-name' or `interactive-p'. ;; - Made `fast-lock-file-name' use `buffer-name' if `buffer-file-name' is nil. ;; - Moved save-all conditions to `fast-lock-save-cache'. ;; - Added `fast-lock-save-text-properties' to `kill-buffer-hook'. ;; 1.01--2.00: complete rewrite---not worth the space to document. ;; - Changed structure of text properties cache and threw out file mod checks. ;; 2.00--2.01: ;; - Made `condition-case' forms understand `quit'. ;; - Made `fast-lock' require `font-lock'. ;; - Made `fast-lock-cache-name' chase links (from Ben Liblit). ;; 2.01--3.00: ;; - Changed structure of cache to include `font-lock-keywords' (from rms). ;; - Changed `fast-lock-cache-mechanisms' to `fast-lock-cache-directories'. ;; - Removed `fast-lock-read-others'. ;; - Made `fast-lock-read-cache' ignore cache owner. ;; - Made `fast-lock-save-cache-external' create cache directory. ;; - Made `fast-lock-save-cache-external' save `font-lock-keywords'. ;; - Made `fast-lock-cache-data' check `font-lock-keywords'. ;; 3.00--3.01: incorporated port of 2.00 to Lucid, made by Barry Warsaw. ;; - Package now provides itself. ;; - Lucid: Use `font-lock-any-extents-p' for `font-lock-any-properties-p'. ;; - Lucid: Use `list-faces' for `face-list'. ;; - Lucid: Added `set-text-properties'. ;; - Lucid: Made `turn-on-fast-lock' pass 1 not t to `fast-lock-mode'. ;; - Removed test for `fast-lock-mode' from `fast-lock-read-cache'. ;; - Lucid: Added Lucid-specific `fast-lock-get-face-properties'. ;; 3.01--3.02: now works with Lucid Emacs, thanks to Barry Warsaw. ;; - Made `fast-lock-cache-name' map ":" to ";" for OS/2 (from Serganova Vera). ;; - Made `fast-lock-cache-name' use abbreviated file name (from Barry Warsaw). ;; - Lucid: Separated handlers for `error' and `quit' for `condition-case'. ;; 3.02--3.03: ;; - Changed `fast-lock-save-cache-external' to `fast-lock-save-cache-data'. ;; - Lucid: Added Lucid-specific `fast-lock-set-face-properties'. ;; 3.03--3.04: ;; - Corrected `subrp' test of Lucid code. ;; - Replaced `font-lock-any-properties-p' with `text-property-not-all'. ;; - Lucid: Made `fast-lock-set-face-properties' put `text-prop' on extents. ;; - Made `fast-lock-cache-directories' a regexp alist (from Colin Rafferty). ;; - Made `fast-lock-cache-directory' to return a usable cache file directory. ;; 3.04--3.05: ;; - Lucid: Fix for XEmacs 19.11 `text-property-not-all'. ;; - Replaced `subrp' test of Lucid code with `emacs-version' `string-match'. ;; - Made `byte-compile-warnings' omit `unresolved' on compilation. ;; - Made `fast-lock-save-cache-data' use a buffer (from Rick Sladkey). ;; - Reverted to old `fast-lock-get-face-properties' (from Rick Sladkey). ;; 3.05--3.06: incorporated hack of 3.03, made by Jonathan Stigelman (Stig). ;; - Reverted to 3.04 version of `fast-lock-get-face-properties'. ;; - XEmacs: Removed `list-faces' `defalias'. ;; - Made `fast-lock-mode' and `turn-on-fast-lock' succeed `autoload' cookies. ;; - Added `lazy-lock-submit-bug-report'. ;; - Renamed `fast-lock-save-size' to `fast-lock-minimum-size'. ;; - Made `fast-lock-save-cache' output a message if no save ever attempted. ;; - Made `fast-lock-save-cache-data' output a message if save attempted. ;; - Made `fast-lock-cache-data' output a message if load attempted. ;; - Made `fast-lock-save-cache-data' do `condition-case' not `unwind-protect'. ;; - Made `fast-lock-save-cache' and `fast-lock-read-cache' return nothing. ;; - Made `fast-lock-save-cache' check `buffer-modified-p' (Stig). ;; - Added `fast-lock-save-events'. ;; - Added `fast-lock-after-save-hook' to `after-save-hook' (Stig). ;; - Added `fast-lock-kill-buffer-hook' to `kill-buffer-hook'. ;; - Changed `fast-lock-save-caches' to `fast-lock-kill-emacs-hook'. ;; - Added `fast-lock-kill-emacs-hook' to `kill-emacs-hook'. ;; - Made `fast-lock-save-cache' check `verify-visited-file-modtime' (Stig). ;; - Made `visited-file-modtime' be the basis of the timestamp (Stig). ;; - Made `fast-lock-save-cache-1' and `fast-lock-cache-data' use/reformat it. ;; - Added `fast-lock-cache-filename' to keep track of the cache file name. ;; - Added `fast-lock-after-fontify-buffer'. ;; - Added `fast-lock-save-faces' list of faces to save (idea from Stig/Tibor). ;; - Made `fast-lock-get-face-properties' functions use it. ;; - XEmacs: Made `fast-lock-set-face-properties' do extents the Font Lock way. ;; - XEmacs: Removed fix for `text-property-not-all' (19.11 support dropped). ;; - Made `fast-lock-mode' ensure `font-lock-mode' is on. ;; - Made `fast-lock-save-cache' do `cdr-safe' not `cdr' (from Dave Foster). ;; - Made `fast-lock-save-cache' do `set-buffer' first (from Dave Foster). ;; - Made `fast-lock-save-cache' loop until saved or quit (from Georg Nikodym). ;; - Made `fast-lock-cache-data' check `buffer-modified-p'. ;; - Made `fast-lock-cache-data' do `font-lock-compile-keywords' if necessary. ;; - XEmacs: Made `font-lock-compile-keywords' `defalias'. ;; 3.06--3.07: ;; - XEmacs: Add `fast-lock-after-fontify-buffer' to the Font Lock hook. ;; - Made `fast-lock-cache-name' explain the use of `directory-abbrev-alist'. ;; - Made `fast-lock-mode' use `buffer-file-truename' not `buffer-file-name'. ;; 3.07--3.08: ;; - Made `fast-lock-read-cache' set `fast-lock-cache-filename'. (require 'font-lock) (eval-when-compile ;; Shut Emacs' byte-compiler up (cf. stop me getting mail from users). (setq byte-compile-warnings '(free-vars callargs redefine))) (defun fast-lock-submit-bug-report () "Submit via mail a bug report on fast-lock.el." (interactive) (let ((reporter-prompt-for-summary-p t)) (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "fast-lock 3.08" '(fast-lock-cache-directories fast-lock-minimum-size fast-lock-save-others fast-lock-save-events fast-lock-save-faces) nil nil (concat "Hi Si., I want to report a bug. I've read the `Bugs' section of `Info' on Emacs, so I know how to make a clear and unambiguous report. To reproduce the bug: Start a fresh Emacs via `" invocation-name " -no-init-file -no-site-file'. In the `*scratch*' buffer, evaluate:")))) ;;;###autoload (defvar fast-lock-mode nil) ; for modeline (defvar fast-lock-cache-timestamp nil) ; for saving/reading (defvar fast-lock-cache-filename nil) ; for deleting ;; User Variables: (defvar fast-lock-cache-directories '("." "~/.emacs-flc") ; - `internal', keep each file's Font Lock cache file in the same file. ; - `external', keep each file's Font Lock cache file in the same directory. "Directories in which Font Lock cache files are saved and read. Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where DIR is a directory name (relative or absolute) and REGEXP is a regexp. An attempt will be made to save or read Font Lock cache files using these items until one succeeds (i.e., until a readable or writable one is found). If an item contains REGEXP, DIR is used only if the buffer file name matches REGEXP. For example: (let ((home (expand-file-name (abbreviate-file-name (file-truename \"~/\"))))) (list (cons (concat \"^\" (regexp-quote home)) \".\") \"~/.emacs-flc\")) => ((\"^/your/true/home/directory/\" . \".\") \"~/.emacs-flc\") would cause a file's current directory to be used if the file is under your home directory hierarchy, or otherwise the absolute directory `~/.emacs-flc'.") (defvar fast-lock-minimum-size (* 25 1024) "If non-nil, the minimum size for buffers. Only buffers more than this can have associated Font Lock cache files saved. If nil, means size is irrelevant.") (defvar fast-lock-save-events '(kill-buffer kill-emacs) "A list of events under which caches will be saved. Valid events are `save-buffer', `kill-buffer' and `kill-emacs'. If concurrent editing sessions use the same associated cache file for a file's buffer, then you should add `save-buffer' to this list.") (defvar fast-lock-save-others t "If non-nil, save Font Lock cache files irrespective of file owner. If nil, means only buffer files known to be owned by you can have associated Font Lock cache files saved. Ownership may be unknown for networked files.") (defvar fast-lock-save-faces ;; Since XEmacs uses extents for everything, we have to pick the right ones. ;; In XEmacs 19.13 we can't identify which text properties are Font Lock's. (if (save-match-data (string-match "XEmacs" (emacs-version))) '(font-lock-string-face font-lock-doc-string-face font-lock-type-face font-lock-function-name-face font-lock-comment-face font-lock-keyword-face font-lock-preprocessor-face) ;; For Emacs 19.30 I don't think this is generally necessary. nil) "A list of faces that will be saved in a Font Lock cache file. If nil, means information for all faces will be saved.") ;; User Functions: ;;;###autoload (defun fast-lock-mode (&optional arg) "Toggle Fast Lock mode. With arg, turn Fast Lock mode on if and only if arg is positive and the buffer is associated with a file. Enable it automatically in your `~/.emacs' by: (add-hook 'font-lock-mode-hook 'turn-on-fast-lock) If Fast Lock mode is enabled, and the current buffer does not contain any text properties, any associated Font Lock cache is used if its timestamp matches the buffer's file, and its `font-lock-keywords' match those that you are using. Font Lock caches may be saved: - When you save the file's buffer. - When you kill an unmodified file's buffer. - When you exit Emacs, for all unmodified or saved buffers. Depending on the value of `fast-lock-save-events'. See also the commands `fast-lock-read-cache' and `fast-lock-save-cache'. Use \\[font-lock-fontify-buffer] to fontify the buffer if the cache is bad. Various methods of control are provided for the Font Lock cache. In general, see variable `fast-lock-cache-directories' and function `fast-lock-cache-name'. For saving, see variables `fast-lock-minimum-size', `fast-lock-save-events', `fast-lock-save-others' and `fast-lock-save-faces'. Use \\[fast-lock-submit-bug-report] to send bug reports or feedback." (interactive "P") ;; Only turn on if we are visiting a file. We could use `buffer-file-name', ;; but many packages temporarily wrap that to nil when doing their own thing. (set (make-local-variable 'fast-lock-mode) (and buffer-file-truename (if arg (> (prefix-numeric-value arg) 0) (not fast-lock-mode)))) (if (and fast-lock-mode (not font-lock-mode)) ;; Turned on `fast-lock-mode' rather than using `font-lock-mode-hook'. (progn (add-hook 'font-lock-mode-hook 'turn-on-fast-lock) (font-lock-mode t)) ;; Let's get down to business. (set (make-local-variable 'fast-lock-cache-timestamp) nil) (set (make-local-variable 'fast-lock-cache-filename) nil) (if (and fast-lock-mode (not font-lock-fontified)) (fast-lock-read-cache)))) (defun fast-lock-read-cache () "Read the Font Lock cache for the current buffer. The following criteria must be met for a Font Lock cache file to be read: - Fast Lock mode must be turned on in the buffer. - The buffer must not be modified. - The buffer's `font-lock-keywords' must match the cache's. - The buffer file's timestamp must match the cache's. - Criteria imposed by `fast-lock-cache-directories'. See `fast-lock-mode'." (interactive) (let ((directories fast-lock-cache-directories) (modified (buffer-modified-p)) (inhibit-read-only t) (fontified font-lock-fontified)) (set (make-local-variable 'font-lock-fontified) nil) ;; Keep trying directories until fontification is turned off. (while (and directories (not font-lock-fontified)) (let ((directory (fast-lock-cache-directory (car directories) nil))) (if (not directory) nil (setq fast-lock-cache-filename (fast-lock-cache-name directory)) (condition-case nil (if (file-readable-p fast-lock-cache-filename) (load fast-lock-cache-filename t t t)) (error nil) (quit nil))) (setq directories (cdr directories)))) ;; Unset `fast-lock-cache-filename', and restore `font-lock-fontified', if ;; we don't use a cache. (Note that `fast-lock-cache-data' sets the value ;; of `fast-lock-cache-timestamp'.) (set-buffer-modified-p modified) (if (not font-lock-fontified) (setq fast-lock-cache-filename nil font-lock-fontified fontified)))) (defun fast-lock-save-cache (&optional buffer) "Save the Font Lock cache of BUFFER or the current buffer. The following criteria must be met for a Font Lock cache file to be saved: - Fast Lock mode must be turned on in the buffer. - The event must be one of `fast-lock-save-events'. - The buffer must be at least `fast-lock-minimum-size' bytes long. - The buffer file must be owned by you, or `fast-lock-save-others' must be t. - The buffer must contain at least one `face' text property. - The buffer must not be modified. - The buffer file's timestamp must be the same as the file's on disk. - The on disk file's timestamp must be different than the buffer's cache. - Criteria imposed by `fast-lock-cache-directories'. See `fast-lock-mode'." (interactive) (save-excursion (and buffer (set-buffer buffer)) (let ((file-timestamp (visited-file-modtime)) (saved nil)) (if (and fast-lock-mode ;; ;; "Only save if the buffer matches the file, the file has ;; changed, and it was changed by the current emacs session." ;; ;; Only save if the buffer is not modified, ;; (i.e., so we don't save for something not on disk) (not (buffer-modified-p)) ;; and the file's timestamp is the same as the buffer's, ;; (i.e., someone else hasn't written the file in the meantime) (verify-visited-file-modtime (current-buffer)) ;; and the file's timestamp is different from the cache's. ;; (i.e., a save has occurred since the cache was read) (not (equal fast-lock-cache-timestamp file-timestamp)) ;; ;; Only save if user's restrictions are satisfied. (or (not fast-lock-minimum-size) (<= fast-lock-minimum-size (buffer-size))) (or fast-lock-save-others (eq (user-uid) (nth 2 (file-attributes buffer-file-name)))) ;; ;; Only save if there are `face' properties to save. (text-property-not-all (point-min) (point-max) 'face nil)) ;; Try each directory until we manage to save or the user quits. (let ((directories fast-lock-cache-directories)) (while (and directories (memq saved '(nil error))) (let* ((dir (fast-lock-cache-directory (car directories) t)) (file (and dir (fast-lock-cache-name dir)))) (if (and file (file-writable-p file)) (setq saved (fast-lock-save-cache-1 file file-timestamp))) (setq directories (cdr directories))))))))) ;;;###autoload (defun turn-on-fast-lock () "Unconditionally turn on Fast Lock mode." (fast-lock-mode t)) ;;; API Functions: (defun fast-lock-after-fontify-buffer () ;; Delete the Font Lock cache file used to restore fontification, if any. (if fast-lock-cache-filename (if (file-writable-p fast-lock-cache-filename) (delete-file fast-lock-cache-filename) (message "File %s font lock cache cannot be deleted" (buffer-name)))) ;; Flag so that a cache will be saved later even if the file is never saved. (setq fast-lock-cache-timestamp nil)) ;; Miscellaneous Functions: (defun fast-lock-after-save-hook () ;; Do `fast-lock-save-cache' if `save-buffer' is on `fast-lock-save-events'. (if (memq 'save-buffer fast-lock-save-events) (fast-lock-save-cache))) (defun fast-lock-kill-buffer-hook () ;; Do `fast-lock-save-cache' if `kill-buffer' is on `fast-lock-save-events'. (if (memq 'kill-buffer fast-lock-save-events) (fast-lock-save-cache))) (defun fast-lock-kill-emacs-hook () ;; Do `fast-lock-save-cache's if `kill-emacs' is on `fast-lock-save-events'. (if (memq 'kill-emacs fast-lock-save-events) (mapcar 'fast-lock-save-cache (buffer-list)))) (defun fast-lock-cache-directory (directory create) "Return usable directory based on DIRECTORY. Returns nil if the directory does not exist, or, if CREATE non-nil, cannot be created. DIRECTORY may be a string or a cons pair of the form (REGEXP . DIR). See `fast-lock-cache-directories'." (let ((dir (cond ((not buffer-file-name) ;; Should never be nil, but `crypt++' screws it up. nil) ((stringp directory) ;; Just a directory. directory) (t ;; A directory iff the file name matches the regexp. (let ((bufile (expand-file-name buffer-file-truename)) (case-fold-search nil)) (if (save-match-data (string-match (car directory) bufile)) (cdr directory))))))) (cond ((not dir) nil) ((file-accessible-directory-p dir) dir) (create (condition-case nil (progn (make-directory dir t) dir) (error nil)))))) ;; If you are wondering why we only hash if the directory is not ".", rather ;; than if `file-name-absolute-p', it is because if we just appended ".flc" for ;; relative cache directories (that are not ".") then it is possible that more ;; than one file would have the same cache name in that directory, if the luser ;; made a link from one relative cache directory to another. (Phew!) (defun fast-lock-cache-name (directory) "Return full cache path name using caching DIRECTORY. If DIRECTORY is `.', the path is the buffer file name appended with `.flc'. Otherwise, the path name is constructed from DIRECTORY and the buffer's true abbreviated file name, with all `/' characters in the name replaced with `#' characters, and appended with `.flc'. If the same file has different cache path names when edited on different machines, e.g., on one machine the cache file name has the prefix `#home', perhaps due to automount, try putting in your `~/.emacs' something like: (setq directory-abbrev-alist (cons '(\"^/home/\" . \"/\") directory-abbrev-alist)) Emacs automagically removes the common `/tmp_mnt' automount prefix by default. See `fast-lock-cache-directory'." (if (string-equal directory ".") (concat buffer-file-name ".flc") (let* ((bufile (expand-file-name buffer-file-truename)) (chars-alist (if (eq system-type 'emx) '((?/ . (?#)) (?# . (?# ?#)) (?: . (?\;)) (?\; . (?\; ?\;))) '((?/ . (?#)) (?# . (?# ?#))))) (mapchars (function (lambda (c) (or (cdr (assq c chars-alist)) (list c)))))) (concat (file-name-as-directory (expand-file-name directory)) (mapconcat 'char-to-string (apply 'append (mapcar mapchars bufile)) "") ".flc")))) ;; Font Lock Cache Processing Functions: (defun fast-lock-save-cache-1 (file timestamp) ;; Save the FILE with the TIMESTAMP as: ;; (fast-lock-cache-data Version=2 TIMESTAMP font-lock-keywords PROPERTIES). ;; Returns non-nil if a save was attempted to a writable cache file. (let ((tpbuf (generate-new-buffer " *fast-lock*")) (buname (buffer-name)) (saved t)) (message "Saving %s font lock cache..." buname) (condition-case nil (save-excursion (print (list 'fast-lock-cache-data 2 (list 'quote timestamp) (list 'quote font-lock-keywords) (list 'quote (fast-lock-get-face-properties))) tpbuf) (set-buffer tpbuf) (write-region (point-min) (point-max) file nil 'quietly) (setq fast-lock-cache-timestamp timestamp fast-lock-cache-filename file)) (error (setq saved 'error)) (quit (setq saved 'quit))) (kill-buffer tpbuf) (message "Saving %s font lock cache... %s." buname (cond ((eq saved 'error) "failed") ((eq saved 'quit) "aborted") (t "done"))) ;; We return non-nil regardless of whether a failure occurred. saved)) (defun fast-lock-cache-data (version timestamp keywords properties &rest ignored) ;; Change from (HIGH LOW) for back compatibility. Remove for version 3! (if (consp (cdr-safe timestamp)) (setcdr timestamp (nth 1 timestamp))) ;; Compile KEYWORDS and `font-lock-keywords' in case one is and one isn't. (let ((current font-lock-keywords)) (setq keywords (font-lock-compile-keywords keywords) font-lock-keywords (font-lock-compile-keywords current))) ;; Use the Font Lock cache PROPERTIES if we're using cache VERSION format 2, ;; the current buffer's file timestamp matches the TIMESTAMP, and the current ;; buffer's font-lock-keywords are the same as KEYWORDS. (let ((buf-timestamp (visited-file-modtime)) (buname (buffer-name)) (loaded t)) (if (or (/= version 2) (buffer-modified-p) (not (equal timestamp buf-timestamp)) (not (equal keywords font-lock-keywords))) (setq loaded nil) (message "Loading %s font lock cache..." buname) (condition-case nil (fast-lock-set-face-properties properties) (error (setq loaded 'error)) (quit (setq loaded 'quit))) (message "Loading %s font lock cache... %s." buname (cond ((eq loaded 'error) "failed") ((eq loaded 'quit) "aborted") (t "done")))) (setq font-lock-fontified (eq loaded t) fast-lock-cache-timestamp (and (eq loaded t) timestamp)))) ;; Text Properties Processing Functions: ;; This is faster, but fails if adjacent characters have different `face' text ;; properties. Maybe that's why I dropped it in the first place? ;(defun fast-lock-get-face-properties () ; "Return a list of all `face' text properties in the current buffer. ;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) ;where VALUE is a `face' property value and STARTx and ENDx are positions." ; (save-restriction ; (widen) ; (let ((start (text-property-not-all (point-min) (point-max) 'face nil)) ; (limit (point-max)) end properties value cell) ; (while start ; (setq end (next-single-property-change start 'face nil limit) ; value (get-text-property start 'face)) ; ;; Make, or add to existing, list of regions with same `face'. ; (if (setq cell (assq value properties)) ; (setcdr cell (cons start (cons end (cdr cell)))) ; (setq properties (cons (list value start end) properties))) ; (setq start (next-single-property-change end 'face))) ; properties))) (defun fast-lock-get-face-properties () "Return a list of all `face' text properties in the current buffer. Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) where VALUE is a `face' property value and STARTx and ENDx are positions. Only those `face' VALUEs in `fast-lock-save-faces' are returned." (save-restriction (widen) (let ((faces (or fast-lock-save-faces (face-list))) (limit (point-max)) properties regions face start end) (while faces (setq face (car faces) faces (cdr faces) regions () end (point-min)) ;; Make a list of start/end regions with `face' property face. (while (setq start (text-property-any end limit 'face face)) (setq end (or (text-property-not-all start limit 'face face) limit) regions (cons start (cons end regions)))) ;; Add `face' face's regions, if any, to properties. (if regions (setq properties (cons (cons face regions) properties)))) properties))) (defun fast-lock-set-face-properties (properties) "Set all `face' text properties to PROPERTIES in the current buffer. Any existing `face' text properties are removed first. Leaves buffer modified. See `fast-lock-get-face-properties' for the format of PROPERTIES." (save-restriction (widen) (font-lock-unfontify-region (point-min) (point-max)) (while properties (let ((plist (list 'face (car (car properties)))) (regions (cdr (car properties)))) ;; Set the `face' property for each start/end region. (while regions (set-text-properties (nth 0 regions) (nth 1 regions) plist) (setq regions (nthcdr 2 regions))) (setq properties (cdr properties)))))) ;; Functions for XEmacs: (if (save-match-data (string-match "XEmacs" (emacs-version))) ;; It would be better to use XEmacs 19.12's `map-extents' over extents with ;; `font-lock' property, but `face' properties are on different extents. (defun fast-lock-get-face-properties () "Return a list of all `face' text properties in the current buffer. Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) where VALUE is a `face' property value and STARTx and ENDx are positions. Only those `face' VALUEs in `fast-lock-save-faces' are returned." (save-restriction (widen) (let ((properties ()) cell) (map-extents (function (lambda (extent ignore) (let ((value (extent-face extent))) ;; We're only interested if it's one of `fast-lock-save-faces'. (if (and value (or (null fast-lock-save-faces) (memq value fast-lock-save-faces))) (let ((start (extent-start-position extent)) (end (extent-end-position extent))) ;; Make or add to existing list of regions with the same ;; `face' property value. (if (setq cell (assq value properties)) (setcdr cell (cons start (cons end (cdr cell)))) (setq properties (cons (list value start end) properties))))) ;; Return nil to keep `map-extents' going. nil)))) properties)))) (if (save-match-data (string-match "XEmacs" (emacs-version))) ;; Make extents just like XEmacs's font-lock.el does. (defun fast-lock-set-face-properties (properties) "Set all `face' text properties to PROPERTIES in the current buffer. Any existing `face' text properties are removed first. See `fast-lock-get-face-properties' for the format of PROPERTIES." (save-restriction (widen) (font-lock-unfontify-region (point-min) (point-max)) (while properties (let ((face (car (car properties))) (regions (cdr (car properties)))) ;; Set the `face' property, etc., for each start/end region. (while regions (font-lock-set-face (nth 0 regions) (nth 1 regions) face) (setq regions (nthcdr 2 regions))) (setq properties (cdr properties))))))) (if (save-match-data (string-match "XEmacs" (emacs-version))) ;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook. (add-hook 'font-lock-after-fontify-buffer-hook 'fast-lock-after-fontify-buffer)) (or (fboundp 'font-lock-compile-keywords) (defalias 'font-lock-compile-keywords 'identity)) ;; Install ourselves: ;; We don't install ourselves on `font-lock-mode-hook' as packages with similar ;; functionality exist, and fast-lock.el should be dumpable without forcing ;; people to use caches or making it difficult for people to use alternatives. (add-hook 'after-save-hook 'fast-lock-after-save-hook) (add-hook 'kill-buffer-hook 'fast-lock-kill-buffer-hook) (add-hook 'kill-emacs-hook 'fast-lock-kill-emacs-hook) ;; Maybe save on the modeline? ;;(setcdr (assq 'font-lock-mode minor-mode-alist) '(" Fast")) (or (assq 'fast-lock-mode minor-mode-alist) (setq minor-mode-alist (cons '(fast-lock-mode " Fast") minor-mode-alist))) ;; Provide ourselves: (provide 'fast-lock) ;;; fast-lock.el ends here emacs-19.30/lisp/ffap.el100444 12120 1 157255 6051504600 13360 0ustar rmsdaemon;;; ffap.el -- find-file-at-point, ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;;; Author: Michelangelo Grigni ;; 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: ;; A replacement for find-file {C-x C-f}: finds file or URL, ;; guessing default from text at point. Many features! ;; Send bugs or suggestions with M-x ffap-bug. ;; See ftp://ftp.mathcs.emory.edu:/pub/mic/emacs/ for most recent version: ;; ffap.el.gz -- this file, compressed with gzip ;; ffap-xe.el -- support code for XEmacs 19.* ;; COPYING.gz -- GNU General Public License, version 2 ;; README -- description of these and other files ;; ;; For the last version sent to elisp-archive@cis.ohio-state.edu, see: ;; ftp://ftp.cis.ohio-state.edu/pub/gnu/emacs/elisp-archive/misc/ffap.el.Z ;; (mirrored in gatekeeper.dec.com:/pub/GNU/elisp-archive/misc/) ;;; Description: ;; ;; Command find-file-at-point (== ffap) replaces find-file. With a ;; prefix, it behaves exactly like find-file. Without a prefix, it ;; first tries to guess a default file or URL based on the text around ;; the point (set `ffap-require-prefix' to swap these behaviors). ;; This is a quick way to fetch URL and file references in many ;; situations, such as in mail or news messages, README's, and ;; MANIFEST's. ;; ;; Some related commands are ffap-at-mouse, ffap-next, ffap-menu, ;; ffap-other-window, ffap-other-frame. ;; ;; This package is about user convenience. It adds nothing to the ;; elisp programmer's repertoire. ;;; Installation: ;; Quick Setup: ;; ;; For a basic installation, just install ffap.el somewhere in your ;; `load-path', byte-compile it, and add the following two lines near ;; the end of your ~/.emacs (or equivalent) file: ;; ;; (require 'ffap) ; load this file ;; (global-set-key "\C-x\C-f" 'find-file-at-point) ;; ;; Other Packages: ffap notices the presence of several other packages ;; when it is loaded. In particular, if you use ange-ftp, efs, w3, ;; complete, or ff-paths (version < 3.00), it is best to load or ;; autoload them before loading ffap (ffap does not need any of them). ;; If you use ff-paths version >= 3.00, load it after ffap. ;; Fancier Setup: ;; ;; ffap has many options. The next comment block contains some ;; fancier code that you might want to adapt for your .emacs. For ;; even more features, look at the documentation (M-x apropos ffap), ;; and perhaps check the comments in the "User Variables" and "Peanut ;; Gallery" sections of this file. ;; ;; Before loading ffap: ;; ;; (setq ffap-url-regexp nil) ; to disable all URL features ;; ;; ;; Loading ffap: ;; (require 'ffap) ; as in "Quick Setup" above ;; ;; After loading ffap: ;; ;; (global-set-key "\C-x\C-f" 'find-file-at-point) ; as in "Quick Setup" ;; (global-set-key "\C-x4f" 'ffap-other-window) ; or \C-f ;; (global-set-key "\C-x5f" 'ffap-other-frame) ; or \C-f ;; ;; (setq ffap-alist ; remove something in `ffap-alist' ;; (delete (assoc 'c-mode ffap-alist) ffap-alist)) ;; ;; (setq ffap-alist ; add something to `ffap-alist' ;; (cons ;; (cons "^[Yy][Ss][Nn][0-9]+$" ;; (defun ffap-ysn (name) ;; (concat ;; "http://snorri.chem.washington.edu/ysnarchive/issuefiles/" ;; (substring name 3) ".html"))) ;; ffap-alist)) ;; ;; ;; Before or after loading ffap: ;; ;; (setq ffap-alist nil) ; disable all `ffap-alist' actions ;; ;; (setq ffap-require-prefix t) ; without prefix, ffap == find-file ;; ;; (setq ffap-machine-p-known 'accept) ; to avoid pinging ;; ;; ;; Choose a mouse binding appropriate for your emacs version: ;; (global-set-key [S-mouse-1] 'ffap-at-mouse) ; Emacs 19 ;; (global-set-key [(meta button1)] 'ffap-at-mouse) ; XEmacs ;; (and window-system ; Emacs 18 (from .emacs) ;; (setq window-setup-hook ;; '(lambda nil (define-key mouse-map x-button-s-left ;; 'ffap-at-mouse)))) ;; ;; ;; Use Netscape instead of w3 to fetch URL's. Mosaic is very similar. ;; (if (eq window-system 'x) ;; (progn ;; ;; Get browse-url at http://wombat.doc.ic.ac.uk/emacs/browse-url.el, ;; ;; or get a (probably out of date) copy from the ftp site above. ;; (autoload 'browse-url-netscape "browse-url" nil t) ;; (setq ffap-url-fetcher 'browse-url-netscape))) ;; ;; Or for a hairier ffap-url-fetcher, get ffap-url.el (same ftp site). ;; ;; ;; Support for gnus, vm, rmail (see hook definitions for bindings): ;; (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook) ;; (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook) ;; (add-hook 'vm-mode-hook 'ffap-ro-mode-hook) ;; (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook) ;;; Related packages: ;; ;; If you have hyperbole, you may not need this package, although ffap ;; is smaller and smarter at this particular task. Also note that w3 ;; (ftp.cs.indiana.edu:/pub/elisp/w3/README) offers a similar command ;; w3-follow-url-at-point. ;; ;; The browse-url package (above) notices URL's and hands them off to ;; w3 or an external WWW browser. Package |~/misc/goto-address.el.gz| ;; by Eric J. Ding notices URL's and mail ;; addresses, and can pre-fontify a buffer to highlight them. Gnus5 ;; (ding) and vm also provide similar support in their messages. ;;; Examples: ;; ;; Try M-x find-file-at-point (maybe {C-x C-f}) on these examples. ;; These local file examples use ordinary find-file: ;; ;; ffap.el, /etc/motd, $MAIL -- find local or absolute files ;; .emacs book.sty info/cl pwd.h -- search paths depending on filename ;; (require 'rmail) -- search paths depending on major-mode ;; file:/etc/motd -- depends on `ffap-url-unwrap-local' ;; ;; These remote file examples work if you have ange-ftp or efs: ;; ;; ftp:/pub -- no ping (always works) ;; ftp.x.org:README -- no ping, a nice recursive example ;; anonymous@ftp.x.org:/README -- synonym ;; ftp.x.org://README -- synonym ;; ftp://ftp.x.org/README -- depends on `ffap-url-unwrap-remote' ;; ftp.mathcs.emory.edu -- depends on `ffap-machine-p-known' ;; mic@ftp:/ -- depends on `ffap-machine-p-local' ;; ftp.mathcs.emory.edu:/ -- depends on `ffap-ftp-sans-slash-regexp' ;; ;; These URL examples use `ffap-url-fetcher' (default w3-fetch): ;; ;; http://www.cc.emory.edu ;; http://www.cs.indiana.edu/elisp/w3/docs.html ;; http://info.cern.ch/default.html ;; news:news.newusers.questions ;; mailto:mic@mathcs.emory.edu ;; mic@mathcs.emory.edu -- same as previous ;; -- same as previous ;; -- mailto:root ;; -- see `ffap-foo@bar-prefix' ;; file:/etc/motd -- see `ffap-url-unwrap-local' ;; ftp://ftp.x.org/README -- see `ffap-url-unwrap-remote' ;; ;; Multiline gopher blocks (as in .gopherrc and usenet of yesteryear): ;; ;; Type=1 ;; Name=Electronic Texts (ffap ignores this) ;; Path= ;; Host=etext.archive.umich.edu ;; Port=70 ;;; Code: (provide 'ffap) ;;; User Variables: ;; This function is used inside defvars: (defun ffap-soft-value (name &optional default) ;; Avoid interning. Bug: (ffap-soft-value "nil" 5) --> 5 (let ((sym (intern-soft name))) (if (and sym (boundp sym)) (symbol-value sym) default))) (defvar ffap-ftp-regexp (and (or (featurep 'ange-ftp) (featurep 'efs) (and (boundp 'file-name-handler-alist) ; v19 (or (rassq 'ange-ftp-hook-function file-name-handler-alist) (rassq 'efs-file-handler-function file-name-handler-alist)))) ;; Apparently this is good enough for both ange-ftp and efs: "\\`/[^/:]+:") "*Treat paths matching this as remote ftp paths. Nil to disable. Nil also disables the generation of such paths by ffap.") (defvar ffap-url-unwrap-local t "*If set, convert local \"file:\" URL to path before prompting.") (defvar ffap-url-unwrap-remote t "*Convert remote \"file:\" or \"ftp:\" URL to path before prompting. This is ignored if `ffap-ftp-regexp' is nil.") (defvar ffap-ftp-default-user (if (or (equal (ffap-soft-value "ange-ftp-default-user") "anonymous") (equal (ffap-soft-value "efs-default-user") "anonymous")) nil "anonymous") "*User name in ftp paths generated by ffap (see host-to-ftp-path). Nil to fall back on `efs-default-user' or `ange-ftp-default-user'.") (defvar ffap-rfs-regexp ;; Remote file access built into file system? HP rfa or Andrew afs: "\\`/\\(afs\\|net\\)/." ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.") "*Paths matching this are remote file-system paths. Nil to disable.") (defvar ffap-url-regexp ;; Could just use `url-nonrelative-link' of w3, if loaded. ;; This regexp is not exhaustive, it just matches common cases. (concat "\\`\\(" "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok "\\|" "\\(ftp\\|http\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host "\\)." ; require one more character ) "Regexp matching URL's, or nil to disable.") (defvar ffap-foo@bar-prefix "mailto" "*Presumed url prefix type of strings like \"\". Sensible values are nil, \"news\", or \"mailto\".") ;;; Peanut Gallery: ;; Users of ffap occasionally suggest new features. If I consider ;; those features interesting but not clear winners (a matter of ;; personal taste) I try to leave options to enable them. Read ;; through this section, and for any features you like, put an ;; appropriate form in your ~/.emacs file. (defvar ffap-dired-wildcards nil ; "[*?][^/]*$" ;; From RHOGEE, 07 Jul 1994. ;; Disabled: dired is still available by "C-x C-d ", and ;; valid filenames may contain wildcard characters. "*A regexp matching filename wildcard characters, or nil. If find-file-at-point gets a filename matching this pattern, it passes it on to dired instead of find-file.") (defvar ffap-newfile-prompt nil ; t ;; From RHOGEE, 11 Jul 1994. ;; Disabled: this is better handled by `find-file-not-found-hooks'. "*Whether find-file-at-point prompts about a nonexistent file.") (defvar ffap-require-prefix nil ;; From RHOGEE, 20 Oct 1994. ;; This is nil so that neophytes notice ffap. Experts instead may ;; prefer to disable ffap most of the time. "*If set, reverses the prefix argument to find-file-at-point.") (defvar ffap-file-finder ;; From RHOGEE, 20 Oct 1994. ;; This allows compatibility with ff-paths version < 3.00. ;; For ff-paths version >= 3.00, just load it after ffap. (if (commandp 'find-file-using-paths) 'find-file-using-paths ;; Try to overcome load-order dependency: (eval-after-load "ff-paths" '(and (commandp 'find-file-using-paths) (setq ffap-file-finder find-file-using-paths))) 'find-file) "*The command symbol called by find-file-at-point to find a file. Probably find-file, or find-file-using-paths if you use ff-paths with version < 3.00.") (put 'ffap-file-finder 'risky-local-variable t) (defvar ffap-url-fetcher 'w3-fetch "*A function of one argument, called by ffap to fetch URL's. The default is w3-fetch from the w3 package. If you prefer Mosaic or Netscape, install http://wombat.doc.ic.ac.uk/emacs/browse-url.el, and add one of the following lines to your setup: \(setq ffap-url-fetcher 'browse-url-netscape\) \(setq ffap-url-fetcher 'browse-url-mosaic\) Or for something hairier \(choose fetch method based on url type and prompting\) get ffap-url.el wherever you ffap.el." ;; Big old `lambda' examples deleted. Some remote-control references: ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html ;; http://home.netscape.com/newsref/std/x-remote.html ) (put 'ffap-url-fetcher 'risky-local-variable t) ;;; Command ffap-next: ;; ;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995. ;; Since then, broke up into ffap-next-guess (noninteractive) and ;; ffap-next (a command), now work on files as well as url's. (defvar ffap-next-regexp ;; If you want ffap-next to find URL's only, try this: ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp) ;; (concat "\\<" (substring ffap-url-regexp 2)))) ;; ;; It pays to put a big fancy regexp here, since ffap-guesser is ;; much more time-consuming than regexp searching: "[/:.~a-zA-Z]/\\|@[a-zA-Z][-a-zA-Z0-9]*\\." "*Regular expression governing search of ffap-next.") (defvar ffap-next-guess nil "Last value returned by `ffap-next-guess'.") (defun ffap-next-guess (&optional back lim) "Move point to next file or url, and return it as a string. If nothing found, leaves point at limit and returns nil. Optional BACK argument makes search backwards. Optional LIM argument limits the search. Only considers strings that match `ffap-next-regexp'." (or lim (setq lim (if back (point-min) (point-max)))) (let (guess) (while (not (or guess (eq (point) lim))) (funcall (if back 're-search-backward 're-search-forward) ffap-next-regexp lim 'move) (setq guess (ffap-guesser))) ;; Go to end, so we do not get same guess twice: (goto-char (nth (if back 0 1) ffap-string-at-point-region)) (setq ffap-next-guess guess))) ;;;###autoload (defun ffap-next (&optional back wrap) "Search buffer for next file or url, and run ffap. Optional argument BACK says to search backwards. Optional argument WRAP says to try wrapping around if necessary. Interactively: use a single prefix to search backwards, double prefix to wrap forward, triple to wrap backwards. Actual search is done by ffap-next-guess." (interactive (cdr (assq (prefix-numeric-value current-prefix-arg) '((1) (4 t) (16 nil t) (64 t t))))) (let ((pt (point)) (guess (ffap-next-guess back))) ;; Try wraparound if necessary: (and (not guess) wrap (goto-char (if back (point-max) (point-min))) (setq guess (ffap-next-guess back pt))) (if guess (progn (sit-for 0) ; display point movement (find-file-at-point (ffap-prompter guess))) (goto-char pt) ; restore point (message "No %sfiles or URL's found." (if wrap "" "more "))))) (defun ffap-next-url (&optional back wrap) "Just like ffap-next, but searches with `ffap-url-regexp'." (interactive) (let ((ffap-next-regexp ffap-url-regexp)) (if (interactive-p) (call-interactively 'ffap-next) (ffap-next back wrap)))) ;;; Hooks for GNUS, VM, Rmail: ;; ;; See "Installation" above for suggested use of these hooks. ;; If you do not like these bindings, just write hooks with ;; whatever bindings you would prefer. ;; ;; Any suggestions of more "memorable" bindings? -- Mic (defun ffap-ro-mode-hook nil "Binds ffap-gnus-next and ffap-gnus-menu to M-l and M-m, resp." (local-set-key "\M-l" 'ffap-next) (local-set-key "\M-m" 'ffap-menu) ) (defun ffap-gnus-hook nil "Binds ffap-gnus-next and ffap-gnus-menu to L and M, resp." (set (make-local-variable 'ffap-foo@bar-prefix) "news") ; message-id's ;; Note lowercase l and m are taken: (local-set-key "L" 'ffap-gnus-next) (local-set-key "M" 'ffap-gnus-menu)) (defun ffap-gnus-wrapper (form) ; used by both commands below (and (eq (current-buffer) (get-buffer gnus-summary-buffer)) (gnus-summary-select-article)) ; get article of current line ;; Preserve selected buffer, but do not do save-window-excursion, ;; since we want to see any window created by form. Temporarily ;; select the article buffer, so we see any point movement. (let ((sb (window-buffer (selected-window)))) (gnus-configure-windows 'article) (pop-to-buffer gnus-article-buffer) (widen) ;; Skip headers at first, for ffap-gnus-next (which wraps around) (if (eq (point) (point-min)) (search-forward "\n\n" nil t)) (unwind-protect (eval form) (pop-to-buffer sb)))) (defun ffap-gnus-next nil "Run ffap-next in the GNUS article buffer." (interactive) (ffap-gnus-wrapper '(ffap-next nil t))) (defun ffap-gnus-menu nil "Run ffap-menu in the GNUS article buffer." (interactive) (ffap-gnus-wrapper '(ffap-menu))) ;;; Remote machines and paths: (fset 'ffap-replace-path-component (if (or (featurep 'efs) (and (boundp 'file-name-handler-alist) ; v19 (rassq 'efs-file-handler-function file-name-handler-alist))) 'efs-replace-path-component 'ange-ftp-replace-name-component)) (defun ffap-file-exists-string (file) ;; With certain packages (ange-ftp, jka-compr?) file-exists-p ;; sometimes returns a nicer string than it is given. Otherwise, it ;; just returns nil or t. "Return FILE \(maybe modified\) if it exists, else nil." (let ((exists (file-exists-p file))) (and exists (if (stringp exists) exists file)))) ;; I cannot decide a "best" strategy here, so these are variables. In ;; particular, if `Pinging...' is broken or takes too long on your ;; machine, try setting these all to accept or reject. (defvar ffap-machine-p-local 'reject ; this happens often "A symbol, one of: ping, accept, reject. This is what ffap-machine-p does with hostnames that have no domain.") (defvar ffap-machine-p-known 'ping ; 'accept for speed "A symbol, one of: ping, accept, reject. This is what ffap-machine-p does with hostnames that have a known domain \(see lisp/mail-extr.el for the list of known domains\).") (defvar ffap-machine-p-unknown 'reject "A symbol, one of: ping, accept, reject. This is what ffap-machine-p does with hostnames that have an unknown domain \(see lisp/mail-extr.el for the list of known domains\).") (defvar ffap-machine-p-known-domains '("com" "edu" "net" "org" "mil" "gov" "us" "arpa") ; USA USA... ;; This variable is mainly for emacs18. "Top-level domains known to ffap. Ignored if mail-extr is loadable.") (defun ffap-machine-p (host &optional service quiet) "Indicate whether HOST is the name of a real machine. The variables ffap-machine-p-local, ffap-machine-p-known, and ffap-machine-p-unknown control ffap-machine-p depending on HOST's domain \(none/known/unknown\). Pinging is done using open-network-stream to decide HOST existence. Optional SERVICE specifies the service used \(default \"discard\"\). Optional QUIET flag suppresses the \"Pinging...\" message. Returned values: A t value means that HOST answered. A symbol \(accept\) means the relevant variable told us to accept. A string means the machine exists, but does not respond for some reason." ;; Try some: ;; (ffap-machine-p "ftp") ;; (ffap-machine-p "nonesuch") ;; (ffap-machine-p "ftp.mathcs.emory.edu") ;; (ffap-machine-p "foo.bonk") ;; (ffap-machine-p "foo.bonk.com") ;; (ffap-machine-p "cs" 5678) ;; (ffap-machine-p "gopher.house.gov") ;; Not known to 19.28 ;; (ffap- (if (or (string-match "[^-a-zA-Z0-9.]" host) ; Illegal chars (?) (not (string-match "[^0-9]" host))) ; all numeric! reject it nil (let* ((domain (and (string-match "\\.[^.]*$" host) (downcase (substring host (1+ (match-beginning 0)))))) (domain-name ; t, "Country", "Local", or nil (cond ((not domain) "Local") ;; common non-country domains (some imply US though): ;; t) (t ;; Use domain-name properties from v19 lisp/mail-extr.el; ;; bbdb/mail-extr also puts this in `all-top-level-domains'. (if (or (featurep 'mail-extr) (and (load "mail-extr" t t) ;; It became a feature between 19.22 and 19.28 (provide 'mail-extr))) (get (intern-soft domain (condition-case nil mail-extr-all-top-level-domains ;; Before 19.28, the symbols were in `obarray': (error obarray))) 'domain-name) ;; Emacs18 does not have mail-extr: (and (member domain ffap-machine-p-known-domains) t)) ))) (strategy (cond ((not domain) ffap-machine-p-local) ((not domain-name) ffap-machine-p-unknown) (ffap-machine-p-known)))) (cond ((eq strategy 'accept) 'accept) ((eq strategy 'reject) nil) ;; assume (eq strategy 'ping) (t (or quiet (if (stringp domain-name) (message "Pinging %s (%s)..." host domain-name) (message "Pinging %s ..." host))) (condition-case error (progn (delete-process (open-network-stream "ffap-machine-p" nil host (or service "discard"))) t) (error (let ((mesg (car (cdr error)))) (cond ;; v18: ((string-match "^Unknown host" mesg) nil) ((string-match "not responding$" mesg) mesg) ;; v19: ;; (file-error "connection failed" "permission denied" ;; "nonesuch" "ffap-machine-p") ;; (file-error "connection failed" "host is unreachable" ;; "gopher.house.gov" "ffap-machine-p") ;; (file-error "connection failed" "address already in use" ;; "ftp.uu.net" "ffap-machine-p") ((equal mesg "connection failed") (if (equal (nth 2 error) "permission denied") nil ; host does not exist ;; Other errors mean host exists: (nth 2 error))) ;; Could be "Unknown service": (t (signal (car error) (cdr error)))))))))))) (defun ffap-file-remote-p (filename) "If FILENAME looks remote, return it \(maybe slightly improved\)." ;; (ffap-file-remote-p "/user@foo.bar.com:/pub") ;; (ffap-file-remote-p "/foo.dom://path") (or (and ffap-ftp-regexp (string-match ffap-ftp-regexp filename) ;; Convert "/host://path" to "/host:/path", to handle a dieing ;; practice of advertising ftp paths as "host.dom://path". (if (string-match "//" filename) (concat (substring filename 0 (match-beginning 0)) (substring filename (1- (match-end 0)))) filename)) (and ffap-rfs-regexp (string-match ffap-rfs-regexp filename) filename))) (defun ffap-machine-at-point nil "Return machine name from around point if it exists, or nil." (let ((mach (ffap-string-at-point "-a-zA-Z0-9." nil "."))) (and (ffap-machine-p mach) mach))) (defun ffap-fixup-machine (mach) ;; Convert a machine into an URL, an ftp path, or nil. (cond ((not (and ffap-url-regexp (stringp mach))) nil) ((string-match "\\`gopher[-.]" mach) ; or "info"? (concat "gopher://" mach "/")) ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach)) (concat "http://" mach "/")) ;; More cases? Maybe "telnet:" for archie? (ffap-ftp-regexp (ffap-host-to-path mach)) )) (defun ffap-host-to-path (host) "Convert \"HOST\" to \"/anonymous@HOST:\" (or \"\" for \"localhost\"). Variable `ffap-ftp-default-user' overrides or suppresses \"anonymous\"." (if (equal host "localhost") "" (if ffap-ftp-default-user (concat "/" ffap-ftp-default-user "@" host ":") (concat "/" host ":")))) (defun ffap-newsgroup-p (string) "Return STRING if it looks like a newsgroup name, else nil." (and (string-match ffap-newsgroup-regexp string) (let ((htbs '(gnus-active-hashtb gnus-newsrc-hashtb gnus-killed-hashtb)) (heads ffap-newsgroup-heads) htb ret) (while htbs (setq htb (car htbs) htbs (cdr htbs)) (condition-case nil (progn ;; errs: htb symbol may be unbound, or not a hash-table. ;; gnus-gethash is just a macro for intern-soft. (and (intern-soft string (symbol-value htb)) (setq ret string htbs nil)) ;; If we made it this far, GNUS is running, so ignore "heads": (setq heads nil)) (error nil))) (or ret (not heads) (let ((head (string-match "\\`\\([a-z]+\\)\\." string))) (and head (setq head (substring string 0 (match-end 1))) (member head heads) (setq ret string)))) ;; Ever any need to modify string as a newsgroup name? ret))) (defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$" "ffap-newsgroup-p quickly rejects strings that do not match this.") (defvar ffap-newsgroup-heads ; entirely inadequate '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk") "Used by ffap-newsgroup-p if GNUS is not running.") (defun ffap-url-p (string) "If STRING looks like an URL, return it (maybe improved), else nil." ;; Does it look like an URL? Ignore case. (let ((case-fold-search t)) (and ffap-url-regexp (string-match ffap-url-regexp string) ;; I lied, no improvement: string))) ;; Broke these two out of ffap-fixup-url, for sake of ffap-url package. (defun ffap-url-unwrap-local (url) "Return unwrapped local file URL, or nil. Ignores ffap-* variables." (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url) (substring url (1+ (match-end 1))))) (defun ffap-url-unwrap-remote (url) "Return unwrapped remote file URL, or nil. Ignores ffap-* variables." (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url) (concat (ffap-host-to-path (substring url (match-beginning 2) (match-end 2))) (substring url (match-beginning 3) (match-end 3))))) (defun ffap-fixup-url (url) "Given URL, clean it up and return it. May become a file name." (cond ((not (stringp url)) nil) ((and ffap-url-unwrap-local (ffap-url-unwrap-local url))) ((and ffap-url-unwrap-remote ffap-ftp-regexp (ffap-url-unwrap-remote url))) ;; Do not load w3 just for this: (t (let ((normal (and (fboundp 'url-normalize-url) (url-normalize-url url)))) ;; In case url-normalize-url is confused: (or (and normal (not (zerop (length normal))) normal) url))))) ;;; `ffap-alist': ;; ;; Search actions depending on the major-mode or extensions of the ;; current name. Note all the little defun's could be broken out, at ;; some loss of locality. I have had a vote for eliminating this ;; from ffap (featuritis) ;; First, some helpers for functions in `ffap-alist': (defun ffap-list-env (env &optional empty) ;; Replace this with parse-colon-path (lisp/files.el)? "Directory list parsed from \":\"-separated ENVinronment variable. Optional EMPTY is default if (getenv ENV) is undefined, and is also substituted for the first empty-string component, if there is one." ;; Derived from psg-list-env in RHOGEE's ff-paths and ;; bib-cite packages. The `empty' argument is intended to mimic ;; the semantics of TeX/BibTeX variables, it is substituted for ;; any empty string entry. (if (or empty (getenv env)) ; should return something (let ((start 0) match dir ret) (setq env (concat (getenv env) ":")) ; note undefined --> ":" (while (setq match (string-match ":" env start)) (setq dir (substring env start match) start (1+ match)) ;;(and (file-directory-p dir) (not (member dir ret)) ...) (setq ret (cons dir ret))) (setq ret (nreverse ret)) (and empty (setq match (member "" ret)) (progn (setcdr match (append (cdr-safe empty) (cdr match))) (setcar match (or (car-safe empty) empty)))) ret))) (defun ffap-reduce-path (path) "Remove duplicates or non-dirs from PATH." (let (ret tem) (while path (setq tem path path (cdr path)) (or (member (car tem) ret) (not (file-directory-p (car tem))) (progn (setcdr tem ret) (setq ret tem)))) (nreverse ret))) (defun ffap-add-subdirs (path) "Return PATH augmented with its immediate subdirectories." ;; (ffap-add-subdirs '("/notexist" "~")) (let (ret subs) (while path (mapcar (function (lambda (f) (and (file-directory-p f) (setq ret (cons f ret))))) (condition-case nil (directory-files (car path) t "[^.]") (error nil))) (setq ret (cons (car path) ret) path (cdr path))) (nreverse ret))) (defvar ffap-locate-jka-suffixes t "List of compression suffixes that ffap-locate-file tries. If not a list, it will be initialized by ffap-locate-file, and it will become nil unless you are using jka-compr. You might set this to nil or a list like '(\".gz\" \".z\" \".Z\").") (defun ffap-locate-file (file &optional nosuffix path) ;; If this package is only working in v19 now, maybe should ;; replace this with a quiet version of locate-library. "A generic path-searching function, defaults mimic `load' behavior. Returns path of an existing FILE that (load FILE) would load, or nil. Optional second argument NOSUFFIX, if t, is like the fourth argument for load, i.e. don't try adding suffixes \".elc\" and \".el\". If a list, it is taken as a list of suffixes to try instead. Optional third argument PATH specifies a different search path, it defaults to `load-path'." (or path (setq path load-path)) (if (file-name-absolute-p file) (setq path (list (file-name-directory file)) file (file-name-nondirectory file))) (let ((suffixes-to-try (cond ((consp nosuffix) nosuffix) (nosuffix '("")) (t '(".elc" ".el" ""))))) ;; Compensate for modern (19.28) jka-compr, that no longer searches ;; for foo.gz when you asked for foo: (or (listp ffap-locate-jka-suffixes) (setq ffap-locate-jka-suffixes (and (featurep 'jka-compr) ; an early version was jka-compr19 (not (featurep 'jka-aux)) jka-compr-file-name-handler-entry (not (string-match (car jka-compr-file-name-handler-entry) "foo")) ;; Hard to do cleverly across various jka-compr versions: '(".gz" ".Z")))) (if ffap-locate-jka-suffixes (setq suffixes-to-try (apply 'nconc (mapcar (function (lambda (suf) (cons suf (mapcar (function (lambda (x) (concat suf x))) ffap-locate-jka-suffixes)))) suffixes-to-try)))) (let (found suffixes) (while (and path (not found)) (setq suffixes suffixes-to-try) (while (and suffixes (not found)) (let ((try (expand-file-name (concat file (car suffixes)) (car path)))) (if (and (file-exists-p try) (not (file-directory-p try))) (setq found try))) (setq suffixes (cdr suffixes))) (setq path (cdr path))) found))) (defvar ffap-alist ;; A big mess! Parts are probably useless. (list (cons "\\.info\\'" (defun ffap-info (name) (ffap-locate-file name '("" ".info") (or (ffap-soft-value "Info-directory-list") (ffap-soft-value "Info-default-directory-list") ;; v18: (list (ffap-soft-value "Info-directory" "~/info/")))))) ;; Since so many info files do not have .info extension, also do this: (cons "\\`info/" (defun ffap-info-2 (name) (ffap-info (substring name 5)))) (cons "\\`[-a-z]+\\'" ;; This ignores the node! "(emacs)Top" same as "(emacs)Intro" (defun ffap-info-3 (name) (and (equal (ffap-string-around) "()") (ffap-info name)))) (cons "\\.elc?\\'" (defun ffap-el (name) (ffap-locate-file name t))) (cons 'emacs-lisp-mode (defun ffap-el-mode (name) ;; We do not bother with "" here, since it was considered above. ;; Also ignore "elc", for speed (who else reads elc files?) (and (not (string-match "\\.el\\'" name)) (ffap-locate-file name '(".el"))))) '(finder-mode . ffap-el-mode) ; v19: {C-h p} '(help-mode . ffap-el-mode) ; v19.29 (cons 'c-mode (progn ;; Need better default here: (defvar ffap-c-path '("/usr/include" "/usr/local/include")) (defun ffap-c-mode (name) (ffap-locate-file name t ffap-c-path)))) '(c++-mode . ffap-c-mode) '(cc-mode . ffap-c-mode) '("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode) (cons 'tex-mode ;; Complicated because auctex may not be loaded yet. (progn (defvar ffap-tex-path (ffap-reduce-path (append (list ".") (ffap-list-env "TEXINPUTS") ;; (ffap-list-env "BIBINPUTS") (ffap-add-subdirs (ffap-list-env "TEXINPUTS_SUBDIR" (ffap-soft-value "TeX-macro-global" '("/usr/local/lib/tex/macros" "/usr/local/lib/tex/inputs") ))))) "*Where ffap-tex-mode looks for tex files.") (defun ffap-tex-mode (name) (ffap-locate-file name '(".tex" "") ffap-tex-path)))) (cons 'latex-mode (defun ffap-latex-mode (name) ;; Any real need for "" here? (ffap-locate-file name '(".sty" ".tex" "") ffap-tex-path))) (cons "\\.\\(tex\\|sty\\|doc\\)\\'" (defun ffap-tex (name) (ffap-locate-file name t ffap-tex-path))) (cons "\\.bib\\'" (defun ffap-bib (name) (ffap-locate-file name t (ffap-list-env "BIBINPUTS" '("/usr/local/lib/tex/macros/bib"))))) (cons 'math-mode (defun ffap-math-mode (name) (while (string-match "`" name) (setq name (concat (substring name 0 (match-beginning 0)) "/" (substring name (match-end 0))))) (ffap-locate-file name '(".m" "") (ffap-soft-value "Mathematica-search-path")))) (cons "\\`\\." (defun ffap-home (name) (ffap-locate-file name t '("~")))) (cons "\\`~/" ;; Maybe a "Lisp Code Directory" reference: (defun ffap-lcd (name) (and (or ;; lisp-dir-apropos output buffer: (string-match "Lisp Code Dir" (buffer-name)) ;; Inside an LCD entry like |~/misc/ffap.el.Z|, ;; or maybe the holy LCD-Datafile itself: (member (ffap-string-around) '("||" "|\n"))) (concat ;; lispdir.el may not be loaded yet: (ffap-host-to-path (ffap-soft-value "elisp-archive-host" "archive.cis.ohio-state.edu")) (file-name-as-directory (ffap-soft-value "elisp-archive-directory" "/pub/gnu/emacs/elisp-archive/")) (substring name 2))))) (cons "^[Rr][Ff][Cc][- #]?\\([0-9]+\\)" ; no $ (progn (defvar ffap-rfc-path (concat (ffap-host-to-path "ds.internic.net") "/rfc/rfc%s.txt")) (defun ffap-rfc (name) (format ffap-rfc-path (substring name (match-beginning 1) (match-end 1)))))) ) "Alist of \(KEY . FUNCTION\), applied to text around point. If ffap-file-at-point has a string NAME (maybe \"\") which is not an existing filename, it looks for pairs with a matching KEY: * if KEY is a symbol, it should equal `major-mode'. * if KEY is a string, it should match NAME as a regular expression. If KEY matches, ffap-file-at-point calls \(FUNCTION NAME\). FUNCTION should return a file, url, or nil \(nil means keep looking for more KEY matches\). Note URL's are ok despite the function name.") (put 'ffap-alist 'risky-local-variable t) ;;; At-Point Functions: (defvar ffap-string-at-point-mode-alist '( ;; Slightly controversial decisions: ;; * strip trailing "@" and ":" ;; * no commas (good for latex) (t "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:") (math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:") ; allow backquote ;; Note: you are better off using "C-c C-c" in compilation buffers: ;; Maybe handle "$HOME", or "$(HOME)/bin/foo" in makefile-mode? ) "Alist of \(MODE CHARS BEG END\), where MODE is a major-mode or t. The data are arguments to ffap-string-at-point, used to guess the filename at point. The `t' entry is the default.") (defvar ffap-string-at-point-region '(1 1) "List (BEG END), last region returned by ffap-string-at-point.") (defvar ffap-string-at-point nil ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95. "Last string returned by ffap-string-at-point.") (defun ffap-string-at-point (&optional chars begpunct endpunct) "Return maximal string of CHARS (a string) around point. Optional BEGPUNCT chars before point are stripped from the beginning; Optional ENDPUNCT chars after point are stripped from the end. Without arguments, uses `ffap-string-at-point-mode-alist'. Also sets `ffap-string-at-point' and `ffap-string-at-point-region'." (if chars (let* ((pt (point)) (str (buffer-substring (save-excursion (skip-chars-backward chars) (and begpunct (skip-chars-forward begpunct pt)) (setcar ffap-string-at-point-region (point))) (save-excursion (skip-chars-forward chars) (and endpunct (skip-chars-backward endpunct pt)) (setcar (cdr ffap-string-at-point-region) (point)))))) (set-text-properties 0 (length str) nil str) (setq ffap-string-at-point str)) ;; Get default args from `ffap-string-at-point-mode-alist' (apply 'ffap-string-at-point (cdr (or (assq major-mode ffap-string-at-point-mode-alist) (assq t ffap-string-at-point-mode-alist) ;; avoid infinite loop! (error "ffap-string-at-point: bad alist") ))))) (defun ffap-string-around nil ;; Sometimes useful to decide how to treat a string. "Return string of two characters around last ffap-string-at-point." (save-excursion (format "%c%c" (progn (goto-char (car ffap-string-at-point-region)) (preceding-char)) ; maybe 0 (progn (goto-char (nth 1 ffap-string-at-point-region)) (following-char)) ; maybe 0 ))) (defun ffap-url-at-point nil "Return URL from around point if it exists, or nil." ;; Could use url-get-url-at-point instead ... how do they compare? ;; Both handle "URL:", ignore non-relative links, trim punctuation. ;; The other will actually look back if point is in whitespace, but ;; I would rather ffap be non-rabid in such situations. (and ffap-url-regexp (or ;; In a w3 buffer button zone? (let (tem) (and (eq major-mode 'w3-mode) ;; assume: (boundp 'w3-zone-at) (boundp 'w3-zone-data) (setq tem (w3-zone-at (point))) (consp (setq tem (w3-zone-data tem))) (nth 2 tem))) ;; Is there a reason not to strip trailing colon? (let ((name (ffap-string-at-point ;; Allow leading digits for email/news id's: "--:?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?"))) ;; (case-fold-search t), why? (cond ((string-match "^url:" name) (setq name (substring name 4))) ((and (string-match "\\`[^:@]+@[^:@]+[a-zA-Z]\\'" name) ;; "foo@bar": could be "mailto" or "news" (a Message-ID). ;; If not adorned with "<>", it must be "mailto". ;; Otherwise could be either, so consult `ffap-foo@bar-prefix'. (let ((prefix (if (and (equal (ffap-string-around) "<>") ;; At least a couple of odd characters: (string-match "[$.0-9].*[$.0-9].*@" name)) ;; Could be news: ffap-foo@bar-prefix "mailto"))) (and prefix (setq name (concat prefix ":" name)))))) ((ffap-newsgroup-p name) (setq name (concat "news:" name))) ((and (string-match "\\`[a-z0-9]+\\'" name) ; (equal (ffap-string-around) "<>") ;; (ffap-user-p name): (not (string-match "~" (expand-file-name (concat "~" name)))) ) (setq name (concat "mailto:" name))) ) (and (ffap-url-p name) name) )))) (defvar ffap-gopher-regexp "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$" "Regexp Matching a line in a gopher bookmark (maybe indented). Two subexpressions are the KEY and VALUE.") (defun ffap-gopher-at-point nil "If point is inside a gopher bookmark block, return its url." ;; We could use gopher-parse-bookmark from gopher.el, but it is not ;; so robust, and w3 users are better off without gopher.el anyway. (save-excursion (beginning-of-line) (if (looking-at ffap-gopher-regexp) (progn (while (and (looking-at ffap-gopher-regexp) (not (bobp))) (forward-line -1)) (or (looking-at ffap-gopher-regexp) (forward-line 1)) (let ((type "1") name path host (port "70")) (while (looking-at ffap-gopher-regexp) (let ((var (intern (downcase (buffer-substring (match-beginning 1) (match-end 1))))) (val (buffer-substring (match-beginning 2) (match-end 2)))) (set var val) (forward-line 1))) (if (and path (string-match "^ftp:.*@" path)) (concat "ftp://" (substring path 4 (1- (match-end 0))) (substring path (match-end 0))) (and (= (length type) 1) host;; (ffap-machine-p host) (concat "gopher://" host (if (equal port "70") "" (concat ":" port)) "/" type path)))))))) (defvar ffap-ftp-sans-slash-regexp (and ffap-ftp-regexp ;; Note: by now, we know it is not an URL. ;; Icky regexp avoids: default: 123: foo::bar cs:pub ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end) ;; Todo: handle foo.com://path "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)") "Strings matching this are coerced to ftp paths by ffap. That is, ffap just prepends \"/\". Set to nil to disable.") (defun ffap-file-at-point nil "Return filename from around point if it exists, or nil. Existence test is skipped for names that look remote. If the filename is not obvious, it also tries `ffap-alist', which may actually result in an URL rather than a filename." ;; Note: this function does not need to look for URL's, just ;; filenames. On the other hand, it is responsible for converting ;; a pseudo-URL "site.dom://path" to an ftp path "/site.dom:/path" (let* ((case-fold-search t) ; url prefixes are case-insensitive (data (match-data)) (string (ffap-string-at-point)) ; use its mode-alist (name (condition-case nil (substitute-in-file-name string) (error string))) (abs (file-name-absolute-p name)) (default-directory default-directory)) (unwind-protect (cond ;; Immediate rejects (/ and // are too common in C++): ((member name '("" "/" "//")) nil) ;; Immediately test local filenames. If default-directory is ;; remote, you probably already have a connection. ((and (not abs) (ffap-file-exists-string name))) ;; Accept remote names without actual checking (too slow): ((if abs (ffap-file-remote-p name) ;; Try adding a leading "/" (common omission in ftp paths): (and ffap-ftp-sans-slash-regexp (string-match ffap-ftp-sans-slash-regexp name) (ffap-file-remote-p (concat "/" name))))) ;; Ok, not remote, try the existence test even if it is absolute: ((and abs (ffap-file-exists-string name))) ;; File does not exist, try the alist: ((let ((alist ffap-alist) tem try case-fold-search) (while (and alist (not try)) (setq tem (car alist) alist (cdr alist)) (if (or (eq major-mode (car tem)) (and (stringp (car tem)) (string-match (car tem) name))) (and (setq try (funcall (cdr tem) name)) (setq try (or (ffap-url-p try) ; not a file! (ffap-file-remote-p try) (ffap-file-exists-string try)))))) try)) ;; Alist failed? Try to guess an active remote connection ;; from buffer variables, and try once more, both as an ;; absolute and relative path on that remote host. ((let* (ffap-rfs-regexp ; suppress (remote-dir (cond ((ffap-file-remote-p default-directory)) ((and (eq major-mode 'internal-ange-ftp-mode) (string-match "^\\*ftp \\(.*\\)@\\(.*\\)\\*$" (buffer-name))) (concat "/" (substring (buffer-name) 5 -1) ":")) ;; This is too often a bad idea: ;;((and (eq major-mode 'w3-mode) ;; (stringp url-current-server)) ;; (host-to-ange-path url-current-server)) ))) (and remote-dir (or (and (string-match "\\`\\(/?~?ftp\\)/" name) (ffap-file-exists-string (ffap-replace-path-component remote-dir (substring name (match-end 1))))) (ffap-file-exists-string (ffap-replace-path-component remote-dir name)))))) ) (store-match-data data)))) ;;; ffap-read-file-or-url: ;; ;; Want to read filenames with completion as in read-file-name, but ;; also allow URL's which read-file-name-internal would truncate at ;; the "//" string. Solution here is to replace read-file-name-internal ;; with another function that does not attempt to complete url's. ;; We implement a pretty clean completion semantics to work with ;; packages like complete.el and exit-minibuffer.el. Even for ;; complete.el (v19.22), we still need to make a small patch (it has a ;; hardwired list of `minibuffer-completion-table' values which it ;; considers to deal with filenames, this ought to be a variable). (defun ffap-read-file-or-url (prompt guess) "Read a file or url from minibuffer, with PROMPT and initial GUESS." (or guess (setq guess default-directory)) (let ((filep (not (ffap-url-p guess))) dir) ;; Tricky: guess may have or be a local directory, like "w3/w3.elc" ;; or "w3/" or "../el/ffap.el" or "../../../" (if filep (progn (or (ffap-file-remote-p guess) (setq guess (abbreviate-file-name (expand-file-name guess)))) (setq dir (file-name-directory guess)))) (apply 'completing-read prompt 'ffap-read-file-or-url-internal dir nil (if (and dir) (cons guess (length dir)) guess) (list 'file-name-history) ))) (defvar url-global-history-completion-list nil) ; variable in w3/url.el (defun ffap-read-url-internal (string dir action) ;; Complete URL's from history, always treat given url as acceptable. (let ((hist url-global-history-completion-list)) (cond ((not action) (or (try-completion string hist) string)) ((eq action t) (or (all-completions string hist) (list string))) ;; lambda? (t string)))) (defun ffap-read-file-or-url-internal (string dir action) (if (ffap-url-p string) (ffap-read-url-internal string dir action) (read-file-name-internal string dir action))) ;; Unfortunately, for complete.el to work correctly, we need to vary ;; the value it sees of minibuffer-completion-table, depending on the ;; current minibuffer contents! It would be nice if it were written a ;; little more easily. I consider this a bug in complete.el, since ;; the builtin emacs functions do not have this problem. (and (featurep 'complete) (require 'advice) (defadvice PC-do-completion (around ffap-fix act) "Work with ffap.el." (let ((minibuffer-completion-table minibuffer-completion-table) ;; (minibuffer-completion-predicate minibuffer-completion-predicate) ) (and (eq minibuffer-completion-table 'ffap-read-file-or-url-internal) (setq minibuffer-completion-table (if (ffap-url-p (buffer-string)) ;; List would work better with icomplete ... 'ffap-read-url-internal 'read-file-name-internal))) ad-do-it))) ;;; Highlighting: ;; ;; Based on overlay highlighting in Emacs 19.28 isearch.el. (defvar ffap-highlight (and window-system t) "If non-nil, ffap highlights the current buffer substring.") (defvar ffap-overlay nil "Overlay used by ffap-highlight.") (defun ffap-highlight (&optional remove) "If `ffap-highlight' is set, highlight the guess in the buffer. That is, the last buffer substring found by ffap-string-at-point. Optional argument REMOVE means to remove any such highlighting. Uses the face `ffap' if it is defined, else `highlight'." (cond (remove (and ffap-overlay (delete-overlay ffap-overlay))) ((not ffap-highlight) nil) (ffap-overlay (move-overlay ffap-overlay (car ffap-string-at-point-region) (nth 1 ffap-string-at-point-region) (current-buffer))) (t (setq ffap-overlay (apply 'make-overlay ffap-string-at-point-region)) (overlay-put ffap-overlay 'face (if (internal-find-face 'ffap nil) 'ffap 'highlight))))) ;;; The big enchilada: (defun ffap-guesser nil "Return file or URL or nil, guessed from text around point." (or (and ffap-url-regexp (ffap-fixup-url (or (ffap-url-at-point) (ffap-gopher-at-point)))) (ffap-file-at-point) ; may yield url! (ffap-fixup-machine (ffap-machine-at-point)))) (defun ffap-prompter (&optional guess) ;; Does guess and prompt step for find-file-at-point. ;; Extra complication just to do the temporary highlighting. (unwind-protect (ffap-read-file-or-url (if ffap-url-regexp "Find file or URL: " "Find file: ") (prog1 (setq guess (or guess (ffap-guesser))) (and guess (ffap-highlight)))) (ffap-highlight t))) ;;;###autoload (defun find-file-at-point (&optional filename) "Find FILENAME (or url), guessing default from text around point. If `ffap-dired-wildcards' is set, wildcard patterns are passed to dired. See also the functions ffap-file-at-point, ffap-url-at-point. With a prefix, this command behaves *exactly* like `ffap-file-finder'. If `ffap-require-prefix' is set, the prefix meaning is reversed. See ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ for most recent version." (interactive) (if (and (interactive-p) (if ffap-require-prefix (not current-prefix-arg) current-prefix-arg)) ;; Do exactly the ffap-file-finder command, even the prompting: (call-interactively ffap-file-finder) (or filename (setq filename (ffap-prompter))) (cond ((ffap-url-p filename) (funcall ffap-url-fetcher filename)) ;; This junk more properly belongs in a modified ffap-file-finder: ((and ffap-dired-wildcards (string-match ffap-dired-wildcards filename)) (dired filename)) ((or (not ffap-newfile-prompt) (file-exists-p filename) (y-or-n-p "File does not exist, create buffer? ")) (funcall ffap-file-finder ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR. (expand-file-name filename))) ;; User does not want to find a non-existent file: ((signal 'file-error (list "Opening file buffer" "no such file or directory" filename)))))) ;; M-x shortcut: (fset 'ffap 'find-file-at-point) ;;; Menu support: ;; ;; Bind ffap-menu to a key if you want, since it also works in tty mode. ;; Or just use it through the ffap-at-mouse binding (next section). (defvar ffap-menu-regexp nil "*If non-nil, overrides `ffap-next-regexp' during ffap-menu. Make this more restrictive for faster menu building. For example, try \":/\" for url (and some ftp) references.") (defvar ffap-menu-alist nil "Buffer local menu of files and urls cached by ffap-menu.") (make-variable-buffer-local 'ffap-menu-alist) ;;;###autoload (defun ffap-menu (&optional rescan) "Puts up a menu of files and urls mentioned in the buffer. Sets mark, jumps to choice, and tries to fetch it. Menu is cached in `ffap-menu-alist', but will always be rebuilt with the optional RESCAN argument (a prefix interactively). Searches buffer with `ffap-menu-regexp' (see `ffap-next-regexp')." (interactive "P") ;; (require 'imenu) -- no longer used, but roughly emulated (if (or (not ffap-menu-alist) rescan ;; or if the first entry is wrong: (and ffap-menu-alist (let ((first (car ffap-menu-alist))) (save-excursion (goto-char (cdr first)) (not (equal (car first) (ffap-guesser))))))) (ffap-menu-rescan)) ;; Tail recursive: (ffap-menu-ask (if ffap-url-regexp "Find file or URL" "Find file") (cons (cons "*Rescan Buffer*" -1) ffap-menu-alist) 'ffap-menu-cont)) (defun ffap-menu-cont (choice) ; continuation of ffap-menu (if (< (cdr choice) 0) (ffap-menu t) ; *Rescan* (push-mark) (goto-char (cdr choice)) ;; Momentary highlight: (unwind-protect (progn (and ffap-highlight (ffap-guesser) (ffap-highlight)) (sit-for 0) ; display (find-file-at-point (car choice))) (ffap-highlight t)))) (defun ffap-menu-ask (title alist cont) "Prompt from a menu of choices, and then apply some action. Arguments are TITLE, ALIST, and CONT (a continuation). This uses either a menu or the minibuffer depending on invocation. The TITLE string is used as either the prompt or menu title. Each (string . data) entry in ALIST defines a choice (data is ignored). Once the user makes a choice, function CONT is applied to the entry. Always returns nil." ;; Bug: minibuffer prompting assumes the strings are unique. ;; Todo: break up long menus into multiple panes (like imenu). (let ((choice (if (and (fboundp 'x-popup-menu) ; 19 or XEmacs 19.13 (boundp 'last-nonmenu-event) ; not in XEmacs 19.13 (listp last-nonmenu-event)) (x-popup-menu t (list "" (cons title (mapcar (function (lambda (i) (cons (car i) i))) alist)))) ;; Automatically popup completion help, one way or another: (let ((minibuffer-setup-hook 'minibuffer-completion-help) (unread-command-char -1)) ;; BUG: this code assumes that "" is not a valid choice (completing-read (format "%s (default %s): " title (car (car alist))) alist nil t ;; Let first be default: ;; (if ffap-v18 (car (car alist)) ;; (cons (car (car alist)) 0)) ;; No, then you do not get all completions! nil ))))) ;; Defaulting: convert "" to (car (car alist)) (and (equal choice "") (setq choice (car (car alist)))) (and (stringp choice) (setq choice (assoc choice alist))) (if choice (funcall cont choice) (message "No choice made!"))) nil) ; return nothing (defun ffap-menu-rescan nil (interactive) (let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp)) (range (- (point-max) (point-min))) item) (setq ffap-menu-alist nil) (save-excursion (goto-char (point-min)) (while (setq item (ffap-next-guess)) (setq ffap-menu-alist (cons (cons item (point)) ffap-menu-alist)) (message "Scanning...%2d%% <%s>" (/ (* 100 (- (point) (point-min))) range) item)))) (message "Scanning...done") ;; Remove duplicates. (setq ffap-menu-alist ; sort by item (sort ffap-menu-alist (function (lambda (a b) (string-lessp (car a) (car b)))))) (let ((ptr ffap-menu-alist)) (while (cdr ptr) (if (equal (car (car ptr)) (car (car (cdr ptr)))) (setcdr ptr (cdr (cdr ptr))) (setq ptr (cdr ptr))))) (setq ffap-menu-alist ; sort by position (sort ffap-menu-alist (function (lambda (a b) (< (cdr a) (cdr b))))))) ;;; Mouse Support: ;; ;; I suggest a mouse binding, something like: ;; (global-set-key [S-mouse-1] 'ffap-at-mouse) (defvar ffap-at-mouse-fallback 'ffap-menu "Invoked by ffap-at-mouse if no file or url found at point. A command symbol, or nil for nothing.") (put 'ffap-at-mouse-fallback 'risky-local-variable t) (defun ffap-at-mouse (e) "Find file or URL guessed from text around mouse point. If none is found, call `ffap-at-mouse-fallback'." (interactive "e") (let ((guess ;; Maybe less surprising without the save-excursion? (save-excursion (mouse-set-point e) ;; Would like to do nothing unless click was *on* text. How? ;; (cdr (posn-col-row (event-start e))) is always same as ;; current column. For posn-x-y, need pixel-width! (ffap-guesser)))) (cond (guess (ffap-highlight) (unwind-protect (progn (sit-for 0) ; display (message "Guessing `%s'" guess) (find-file-at-point guess)) (ffap-highlight t))) ((and (interactive-p) ffap-at-mouse-fallback) (call-interactively ffap-at-mouse-fallback)) ((message "No file or URL found at mouse click."))))) ;;; ffap-other-* commands ;; Suggested by KPC. Possible bindings for C-x 4 C-f, C-x 5 C-f. (defun ffap-other-window nil "Like ffap, but put buffer in another window." (interactive) (switch-to-buffer-other-window (save-window-excursion (call-interactively 'ffap) (current-buffer)))) (defun ffap-other-frame nil "Like ffap, but put buffer in another frame." (interactive) (switch-to-buffer-other-frame (save-window-excursion (call-interactively 'ffap) (current-buffer)))) ;;; ffap-bug: (defun ffap-bug nil ;; Tested with Emacs 19.28 reporter.el "Submit a bug report for ffap." (interactive) (require 'reporter) (let ((reporter-prompt-for-summary-p t)) (reporter-submit-bug-report "mic@mathcs.emory.edu" "ffap " (mapcar 'intern (all-completions "ffap-" obarray 'boundp)) ))) (fset 'ffap-submit-bug 'ffap-bug) ; another likely name ;;; Todo, End. ;; ;; * w3 may eventually make URL's part of the filesystem! ;; this package (prompt & completion) could become much simpler ;; * improve minibuffer-completion-help display of long completions ;; * notice "machine.dom blah blah blah path/file" (how?) ;; * check X selections (x-get-selection PRIMARY/SECONDARY LENGTH/TEXT) ;; * let "/path/file#key" jump to key (anchor or regexp) in /path/file ;; * notice node in "(dired)Virtual Dired" (how to handle space?) ;; * try find-tag on symbol if TAGS is loaded (need above) ;; ;; For information on URL/URI syntax, try: ;; ;; ;; ;; Local Variables? ;; foo: bar ;; End: ;;; ffap.el ends here emacs-19.30/lisp/files.el100444 75424 1 304007 6050721652 13744 0ustar kwzhdaemon;;; files.el --- file input and output commands for Emacs ;; Copyright (C) 1985, 86, 87, 92, 93, 94, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; 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: ;; Defines most of Emacs's file- and directory-handling functions, ;; including basic file visiting, backup generation, link handling, ;; ITS-id version control, load- and write-hook handling, and the like. ;;; Code: (defconst delete-auto-save-files t "*Non-nil means delete auto-save file when a buffer is saved or killed.") (defconst directory-abbrev-alist nil "*Alist of abbreviations for file directories. A list of elements of the form (FROM . TO), each meaning to replace FROM with TO when it appears in a directory name. This replacement is done when setting up the default directory of a newly visited file. *Every* FROM string should start with `^'. Do not use `~' in the TO strings. They should be ordinary absolute directory names. Use this feature when you have directories which you normally refer to via absolute symbolic links. Make TO the name of the link, and FROM the name it is linked to.") ;;; Turn off backup files on VMS since it has version numbers. (defconst make-backup-files (not (eq system-type 'vax-vms)) "*Non-nil means make a backup of a file the first time it is saved. This can be done by renaming the file or by copying. Renaming means that Emacs renames the existing file so that it is a backup file, then writes the buffer into a new file. Any other names that the old file had will now refer to the backup file. The new file is owned by you and its group is defaulted. Copying means that Emacs copies the existing file into the backup file, then writes the buffer on top of the existing file. Any other names that the old file had will now refer to the new (edited) file. The file's owner and group are unchanged. The choice of renaming or copying is controlled by the variables `backup-by-copying', `backup-by-copying-when-linked' and `backup-by-copying-when-mismatch'. See also `backup-inhibited'.") ;; Do this so that local variables based on the file name ;; are not overridden by the major mode. (defvar backup-inhibited nil "Non-nil means don't make a backup, regardless of the other parameters. This variable is intended for use by making it local to a buffer. But it is local only if you make it local.") (put 'backup-inhibited 'permanent-local t) (defconst backup-by-copying nil "*Non-nil means always use copying to create backup files. See documentation of variable `make-backup-files'.") (defconst backup-by-copying-when-linked nil "*Non-nil means use copying to create backups for files with multiple names. This causes the alternate names to refer to the latest version as edited. This variable is relevant only if `backup-by-copying' is nil.") (defconst backup-by-copying-when-mismatch nil "*Non-nil means create backups by copying if this preserves owner or group. Renaming may still be used (subject to control of other variables) when it would not result in changing the owner or group of the file; that is, for files which are owned by you and whose group matches the default for a new file created there by you. This variable is relevant only if `backup-by-copying' is nil.") (defvar backup-enable-predicate '(lambda (name) (or (< (length name) 5) (not (string-equal "/tmp/" (substring name 0 5))))) "Predicate that looks at a file name and decides whether to make backups. Called with an absolute file name as argument, it returns t to enable backup.") (defconst buffer-offer-save nil "*Non-nil in a buffer means offer to save the buffer on exit even if the buffer is not visiting a file. Automatically local in all buffers.") (make-variable-buffer-local 'buffer-offer-save) (defconst find-file-existing-other-name nil "*Non-nil means find a file under alternative names, in existing buffers. This means if any existing buffer is visiting the file you want under another name, you get the existing buffer instead of a new buffer.") (defconst find-file-visit-truename nil "*Non-nil means visit a file under its truename. The truename of a file is found by chasing all links both at the file level and at the levels of the containing directories.") (defvar buffer-file-number nil "The device number and file number of the file visited in the current buffer. The value is a list of the form (FILENUM DEVNUM). This pair of numbers uniquely identifies the file. If the buffer is visiting a new file, the value is nil.") (make-variable-buffer-local 'buffer-file-number) (put 'buffer-file-number 'permanent-local t) (defconst file-precious-flag nil "*Non-nil means protect against I/O errors while saving files. Some modes set this non-nil in particular buffers. This feature works by writing the new contents into a temporary file and then renaming the temporary file to replace the original. In this way, any I/O error in writing leaves the original untouched, and there is never any instant where the file is nonexistent. Note that this feature forces backups to be made by copying. Yet, at the same time, saving a precious file breaks any hard links between it and other files.") (defvar version-control nil "*Control use of version numbers for backup files. t means make numeric backup versions unconditionally. nil means make them for files that have some already. `never' means do not make them.") (defvar dired-kept-versions 2 "*When cleaning directory, number of versions to keep.") (defvar delete-old-versions nil "*If t, delete excess backup versions silently. If nil, ask confirmation. Any other value prevents any trimming.") (defvar kept-old-versions 2 "*Number of oldest versions to keep when a new numbered backup is made.") (defvar kept-new-versions 2 "*Number of newest versions to keep when a new numbered backup is made. Includes the new backup. Must be > 0") (defconst require-final-newline nil "*Value of t says silently ensure a file ends in a newline when it is saved. Non-nil but not t says ask user whether to add a newline when there isn't one. nil means don't add newlines.") (defconst auto-save-default t "*Non-nil says by default do auto-saving of every file-visiting buffer.") (defconst auto-save-visited-file-name nil "*Non-nil says auto-save a buffer in the file it is visiting, when practical. Normally auto-save files are written under other names.") (defconst save-abbrevs nil "*Non-nil means save word abbrevs too when files are saved. Loading an abbrev file sets this to t.") (defconst find-file-run-dired t "*Non-nil says run dired if `find-file' is given the name of a directory.") ;;;It is not useful to make this a local variable. ;;;(put 'find-file-not-found-hooks 'permanent-local t) (defvar find-file-not-found-hooks nil "List of functions to be called for `find-file' on nonexistent file. These functions are called as soon as the error is detected. `buffer-file-name' is already set up. The functions are called in the order given until one of them returns non-nil.") ;;;It is not useful to make this a local variable. ;;;(put 'find-file-hooks 'permanent-local t) (defvar find-file-hooks nil "List of functions to be called after a buffer is loaded from a file. The buffer's local variables (if any) will have been processed before the functions are called.") (defvar write-file-hooks nil "List of functions to be called before writing out a buffer to a file. If one of them returns non-nil, the file is considered already written and the rest are not called. These hooks are considered to pertain to the visited file. So this list is cleared if you change the visited file name. See also `write-contents-hooks'. Don't make this variable buffer-local; instead, use `local-write-file-hooks'.") ;;; However, in case someone does make it local... (put 'write-file-hooks 'permanent-local t) (defvar local-write-file-hooks nil "Just like `write-file-hooks', except intended for per-buffer use. The functions in this list are called before the ones in `write-file-hooks'.") (make-variable-buffer-local 'local-write-file-hooks) (put 'local-write-file-hooks 'permanent-local t) (defvar write-contents-hooks nil "List of functions to be called before writing out a buffer to a file. If one of them returns non-nil, the file is considered already written and the rest are not called. These hooks are considered to pertain to the buffer's contents, not to the particular visited file; thus, `set-visited-file-name' does not clear this variable, but changing the major mode does clear it. See also `write-file-hooks'.") (defconst enable-local-variables t "*Control use of local-variables lists in files you visit. The value can be t, nil or something else. A value of t means local-variables lists are obeyed; nil means they are ignored; anything else means query. The command \\[normal-mode] always obeys local-variables lists and ignores this variable.") (defconst enable-local-eval 'maybe "*Control processing of the \"variable\" `eval' in a file's local variables. The value can be t, nil or something else. A value of t means obey `eval' variables; nil means ignore them; anything else means query. The command \\[normal-mode] always obeys local-variables lists and ignores this variable.") ;; Avoid losing in versions where CLASH_DETECTION is disabled. (or (fboundp 'lock-buffer) (defalias 'lock-buffer 'ignore)) (or (fboundp 'unlock-buffer) (defalias 'unlock-buffer 'ignore)) ;; This hook function provides support for ange-ftp host name ;; completion. It runs the usual ange-ftp hook, but only for ;; completion operations. Having this here avoids the need ;; to load ange-ftp when it's not really in use. (defun ange-ftp-completion-hook-function (op &rest args) (if (memq op '(file-name-completion file-name-all-completions)) (apply 'ange-ftp-hook-function op args) (let ((inhibit-file-name-handlers (cons 'ange-ftp-completion-hook-function (and (eq inhibit-file-name-operation op) inhibit-file-name-handlers))) (inhibit-file-name-operation op)) (apply op args)))) (defun pwd () "Show the current default directory." (interactive nil) (message "Directory %s" default-directory)) (defvar cd-path nil "Value of the CDPATH environment variable, as a list. Not actually set up until the first time you you use it.") (defvar path-separator ":" "Character used to separate concatenated paths.") (defun parse-colon-path (cd-path) "Explode a colon-separated list of paths into a string list." (and cd-path (let (cd-prefix cd-list (cd-start 0) cd-colon) (setq cd-path (concat cd-path path-separator)) (while (setq cd-colon (string-match path-separator cd-path cd-start)) (setq cd-list (nconc cd-list (list (if (= cd-start cd-colon) nil (substitute-in-file-name (file-name-as-directory (substring cd-path cd-start cd-colon))))))) (setq cd-start (+ cd-colon 1))) cd-list))) (defun cd-absolute (dir) "Change current directory to given absolute file name DIR." ;; Put the name into directory syntax now, ;; because otherwise expand-file-name may give some bad results. (if (not (eq system-type 'vax-vms)) (setq dir (file-name-as-directory dir))) (setq dir (abbreviate-file-name (expand-file-name dir))) (if (not (file-directory-p dir)) (error "%s is not a directory" dir) (if (file-executable-p dir) (setq default-directory dir) (error "Cannot cd to %s: Permission denied" dir)))) (defun cd (dir) "Make DIR become the current buffer's default directory. If your environment includes a `CDPATH' variable, try each one of that colon-separated list of directories when resolving a relative directory name." (interactive (list (read-file-name "Change default directory: " default-directory default-directory (and (member cd-path '(nil ("./"))) (null (getenv "CDPATH")))))) (if (file-name-absolute-p dir) (cd-absolute (expand-file-name dir)) (if (null cd-path) (let ((trypath (parse-colon-path (getenv "CDPATH")))) (setq cd-path (or trypath (list "./"))))) (if (not (catch 'found (mapcar (function (lambda (x) (let ((f (expand-file-name (concat x dir)))) (if (file-directory-p f) (progn (cd-absolute f) (throw 'found t)))))) cd-path) nil)) (error "No such directory found via CDPATH environment variable")))) (defun load-file (file) "Load the Lisp file named FILE." (interactive "fLoad file: ") (load (expand-file-name file) nil nil t)) (defun load-library (library) "Load the library named LIBRARY. This is an interface to the function `load'." (interactive "sLoad library: ") (load library)) (defun file-local-copy (file &optional buffer) "Copy the file FILE into a temporary file on this machine. Returns the name of the local copy, or nil, if FILE is directly accessible." (let ((handler (find-file-name-handler file 'file-local-copy))) (if handler (funcall handler 'file-local-copy file) nil))) (defun file-truename (filename &optional counter prev-dirs) "Return the truename of FILENAME, which should be absolute. The truename of a file name is found by chasing symbolic links both at the level of the file and at the level of the directories containing it, until no links are left at any level. The arguments COUNTER and PREV-DIRS are used only in recursive calls. Do not specify them in other calls." ;; COUNTER can be a cons cell whose car is the count of how many more links ;; to chase before getting an error. ;; PREV-DIRS can be a cons cell whose car is an alist ;; of truenames we've just recently computed. ;; The last test looks dubious, maybe `+' is meant here? --simon. (if (or (string= filename "") (string= filename "~") (and (string= (substring filename 0 1) "~") (string-match "~[^/]*" filename))) (progn (setq filename (expand-file-name filename)) (if (string= filename "") (setq filename "/")))) (or counter (setq counter (list 100))) (let (done ;; For speed, remove the ange-ftp completion handler from the list. ;; We know it's not needed here. ;; For even more speed, do this only on the outermost call. (file-name-handler-alist (if prev-dirs file-name-handler-alist (let ((tem (copy-sequence file-name-handler-alist))) (delq (rassq 'ange-ftp-completion-hook-function tem) tem))))) (or prev-dirs (setq prev-dirs (list nil))) ;; If this file directly leads to a link, process that iteratively ;; so that we don't use lots of stack. (while (not done) (setcar counter (1- (car counter))) (if (< (car counter) 0) (error "Apparent cycle of symbolic links for %s" filename)) (let ((handler (find-file-name-handler filename 'file-truename))) ;; For file name that has a special handler, call handler. ;; This is so that ange-ftp can save time by doing a no-op. (if handler (setq filename (funcall handler 'file-truename filename) done t) (let ((dir (or (file-name-directory filename) default-directory)) target dirfile) ;; Get the truename of the directory. (setq dirfile (directory-file-name dir)) ;; If these are equal, we have the (or a) root directory. (or (string= dir dirfile) ;; If this is the same dir we last got the truename for, ;; save time--don't recalculate. (if (assoc dir (car prev-dirs)) (setq dir (cdr (assoc dir (car prev-dirs)))) (let ((old dir) (new (file-name-as-directory (file-truename dirfile counter prev-dirs)))) (setcar prev-dirs (cons (cons old new) (car prev-dirs))) (setq dir new)))) (if (equal ".." (file-name-nondirectory filename)) (setq filename (directory-file-name (file-name-directory (directory-file-name dir))) done t) (if (equal "." (file-name-nondirectory filename)) (setq filename (directory-file-name dir) done t) ;; Put it back on the file name. (setq filename (concat dir (file-name-nondirectory filename))) ;; Is the file name the name of a link? (setq target (file-symlink-p filename)) (if target ;; Yes => chase that link, then start all over ;; since the link may point to a directory name that uses links. ;; We can't safely use expand-file-name here ;; since target might look like foo/../bar where foo ;; is itself a link. Instead, we handle . and .. above. (setq filename (if (file-name-absolute-p target) target (concat dir target)) done nil) ;; No, we are done! (setq done t)))))))) filename)) (defun file-chase-links (filename) "Chase links in FILENAME until a name that is not a link. Does not examine containing directories for links, unlike `file-truename'." (let (tem (count 100) (newname filename)) (while (setq tem (file-symlink-p newname)) (if (= count 0) (error "Apparent cycle of symbolic links for %s" filename)) ;; In the context of a link, `//' doesn't mean what Emacs thinks. (while (string-match "//+" tem) (setq tem (concat (substring tem 0 (1+ (match-beginning 0))) (substring tem (match-end 0))))) ;; Handle `..' by hand, since it needs to work in the ;; target of any directory symlink. ;; This code is not quite complete; it does not handle ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose. (while (string-match "\\`\\.\\./" tem) (setq tem (substring tem 3)) (setq newname (file-name-as-directory ;; Do the .. by hand. (directory-file-name (file-name-directory ;; Chase links in the default dir of the symlink. (file-chase-links (directory-file-name (file-name-directory newname)))))))) (setq newname (expand-file-name tem (file-name-directory newname))) (setq count (1- count))) newname)) (defun switch-to-buffer-other-window (buffer) "Select buffer BUFFER in another window." (interactive "BSwitch to buffer in other window: ") (let ((pop-up-windows t)) (pop-to-buffer buffer t))) (defun switch-to-buffer-other-frame (buffer) "Switch to buffer BUFFER in another frame." (interactive "BSwitch to buffer in other frame: ") (let ((pop-up-frames t)) (pop-to-buffer buffer t) (raise-frame (window-frame (selected-window))))) (defun find-file (filename) "Edit file FILENAME. Switch to a buffer visiting file FILENAME, creating one if none already exists." (interactive "FFind file: ") (switch-to-buffer (find-file-noselect filename))) (defun find-file-other-window (filename) "Edit file FILENAME, in another window. May create a new window, or reuse an existing one. See the function `display-buffer'." (interactive "FFind file in other window: ") (switch-to-buffer-other-window (find-file-noselect filename))) (defun find-file-other-frame (filename) "Edit file FILENAME, in another frame. May create a new frame, or reuse an existing one. See the function `display-buffer'." (interactive "FFind file in other frame: ") (switch-to-buffer-other-frame (find-file-noselect filename))) (defun find-file-read-only (filename) "Edit file FILENAME but don't allow changes. Like \\[find-file] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." (interactive "fFind file read-only: ") (find-file filename) (setq buffer-read-only t) (current-buffer)) (defun find-file-read-only-other-window (filename) "Edit file FILENAME in another window but don't allow changes. Like \\[find-file-other-window] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." (interactive "fFind file read-only other window: ") (find-file-other-window filename) (setq buffer-read-only t) (current-buffer)) (defun find-file-read-only-other-frame (filename) "Edit file FILENAME in another frame but don't allow changes. Like \\[find-file-other-frame] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." (interactive "fFind file read-only other frame: ") (find-file-other-frame filename) (setq buffer-read-only t) (current-buffer)) (defun find-alternate-file-other-window (filename) "Find file FILENAME as a replacement for the file in the next window. This command does not select that window." (interactive (save-selected-window (other-window 1) (let ((file buffer-file-name) (file-name nil) (file-dir nil)) (and file (setq file-name (file-name-nondirectory file) file-dir (file-name-directory file))) (list (read-file-name "Find alternate file: " file-dir nil nil file-name))))) (if (one-window-p) (find-file-other-window filename) (save-selected-window (other-window 1) (find-alternate-file filename)))) (defun find-alternate-file (filename) "Find file FILENAME, select its buffer, kill previous buffer. If the current buffer now contains an empty file that you just visited \(presumably by mistake), use this command to visit the file you really want." (interactive (let ((file buffer-file-name) (file-name nil) (file-dir nil)) (and file (setq file-name (file-name-nondirectory file) file-dir (file-name-directory file))) (list (read-file-name "Find alternate file: " file-dir nil nil file-name)))) (and (buffer-modified-p) (buffer-file-name) ;; (not buffer-read-only) (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? " (buffer-name)))) (error "Aborted")) (let ((obuf (current-buffer)) (ofile buffer-file-name) (onum buffer-file-number) (otrue buffer-file-truename) (oname (buffer-name))) (if (get-buffer " **lose**") (kill-buffer " **lose**")) (rename-buffer " **lose**") (setq buffer-file-name nil) (setq buffer-file-number nil) (setq buffer-file-truename nil) (unwind-protect (progn (unlock-buffer) (find-file filename)) (cond ((eq obuf (current-buffer)) (setq buffer-file-name ofile) (setq buffer-file-number onum) (setq buffer-file-truename otrue) (lock-buffer) (rename-buffer oname)))) (or (eq (current-buffer) obuf) (kill-buffer obuf)))) (defun create-file-buffer (filename) "Create a suitably named buffer for visiting FILENAME, and return it. FILENAME (sans directory) is used unchanged if that name is free; otherwise a string <2> or <3> or ... is appended to get an unused name." (let ((lastname (file-name-nondirectory filename))) (if (string= lastname "") (setq lastname filename)) (generate-new-buffer lastname))) (defun generate-new-buffer (name) "Create and return a buffer with a name based on NAME. Choose the buffer's name using `generate-new-buffer-name'." (get-buffer-create (generate-new-buffer-name name))) (defconst automount-dir-prefix "^/tmp_mnt/" "Regexp to match the automounter prefix in a directory name.") (defvar abbreviated-home-dir nil "The user's homedir abbreviated according to `directory-abbrev-list'.") (defun abbreviate-file-name (filename) "Return a version of FILENAME shortened using `directory-abbrev-alist'. This also substitutes \"~\" for the user's home directory. Type \\[describe-variable] directory-abbrev-alist RET for more information." ;; Get rid of the prefixes added by the automounter. (if (and (string-match automount-dir-prefix filename) (file-exists-p (file-name-directory (substring filename (1- (match-end 0)))))) (setq filename (substring filename (1- (match-end 0))))) (let ((tail directory-abbrev-alist)) ;; If any elt of directory-abbrev-alist matches this name, ;; abbreviate accordingly. (while tail (if (string-match (car (car tail)) filename) (setq filename (concat (cdr (car tail)) (substring filename (match-end 0))))) (setq tail (cdr tail))) ;; Compute and save the abbreviated homedir name. ;; We defer computing this until the first time it's needed, to ;; give time for directory-abbrev-alist to be set properly. ;; We include a slash at the end, to avoid spurious matches ;; such as `/usr/foobar' when the home dir is `/usr/foo'. (or abbreviated-home-dir (setq abbreviated-home-dir (let ((abbreviated-home-dir "$foo")) (concat "^" (abbreviate-file-name (expand-file-name "~")) "\\(/\\|$\\)")))) ;; If FILENAME starts with the abbreviated homedir, ;; make it start with `~' instead. (if (and (string-match abbreviated-home-dir filename) ;; If the home dir is just /, don't change it. (not (and (= (match-end 0) 1) (= (aref filename 0) ?/))) (not (and (or (eq system-type 'ms-dos) (eq system-type 'windows-nt)) (save-match-data (string-match "^[a-zA-Z]:/$" filename))))) (setq filename (concat "~" (substring filename (match-beginning 1) (match-end 1)) (substring filename (match-end 0))))) filename)) (defvar find-file-not-true-dirname-list nil "*List of logical names for which visiting shouldn't save the true dirname. On VMS, when you visit a file using a logical name that searches a path, you may or may not want the visited file name to record the specific directory where the file was found. If you *do not* want that, add the logical name to this list as a string.") (defun find-buffer-visiting (filename) "Return the buffer visiting file FILENAME (a string). This is like `get-file-buffer', except that it checks for any buffer visiting the same file, possibly under a different name. If there is no such live buffer, return nil." (let ((buf (get-file-buffer filename)) (truename (abbreviate-file-name (file-truename filename)))) (or buf (let ((list (buffer-list)) found) (while (and (not found) list) (save-excursion (set-buffer (car list)) (if (and buffer-file-name (string= buffer-file-truename truename)) (setq found (car list)))) (setq list (cdr list))) found) (let ((number (nthcdr 10 (file-attributes truename))) (list (buffer-list)) found) (and number (while (and (not found) list) (save-excursion (set-buffer (car list)) (if (and buffer-file-name (equal buffer-file-number number) ;; Verify this buffer's file number ;; still belongs to its file. (file-exists-p buffer-file-name) (equal (nthcdr 10 (file-attributes buffer-file-name)) number)) (setq found (car list)))) (setq list (cdr list)))) found)))) (defun insert-file-contents-literally (filename &optional visit beg end replace) "Like `insert-file-contents', q.v., but only reads in the file. A buffer may be modified in several ways after reading into the buffer due to advanced Emacs features, such as file-name-handlers, format decoding, find-file-hooks, etc. This function ensures that none of these modifications will take place." (let ((file-name-handler-alist nil) (format-alist nil) (after-insert-file-functions nil) (find-buffer-file-type-function (if (fboundp 'find-buffer-file-type) (symbol-function 'find-buffer-file-type) nil))) (unwind-protect (progn (fset 'find-buffer-file-type (lambda (filename) t)) (insert-file-contents filename visit beg end replace)) (if find-buffer-file-type-function (fset 'find-buffer-file-type find-buffer-file-type-function) (fmakunbound 'find-buffer-file-type))))) (defun find-file-noselect (filename &optional nowarn rawfile) "Read file FILENAME into a buffer and return the buffer. If a buffer exists visiting FILENAME, return that one, but verify that the file has not changed since visited or saved. The buffer is not selected, just returned to the caller." (setq filename (abbreviate-file-name (expand-file-name filename))) (if (file-directory-p filename) (if find-file-run-dired (dired-noselect (if find-file-visit-truename (abbreviate-file-name (file-truename filename)) filename)) (error "%s is a directory." filename)) (let* ((buf (get-file-buffer filename)) (truename (abbreviate-file-name (file-truename filename))) (number (nthcdr 10 (file-attributes truename))) ;; Find any buffer for a file which has same truename. (other (and (not buf) (find-buffer-visiting filename))) error) ;; Let user know if there is a buffer with the same truename. (if other (progn (or nowarn (string-equal filename (buffer-file-name other)) (message "%s and %s are the same file" filename (buffer-file-name other))) ;; Optionally also find that buffer. (if (or find-file-existing-other-name find-file-visit-truename) (setq buf other)))) (if buf (or nowarn (verify-visited-file-modtime buf) (cond ((not (file-exists-p filename)) (error "File %s no longer exists!" filename)) ((yes-or-no-p (if (string= (file-name-nondirectory filename) (buffer-name buf)) (format (if (buffer-modified-p buf) "File %s changed on disk. Discard your edits? " "File %s changed on disk. Reread from disk? ") (file-name-nondirectory filename)) (format (if (buffer-modified-p buf) "File %s changed on disk. Discard your edits in %s? " "File %s changed on disk. Reread from disk into %s? ") (file-name-nondirectory filename) (buffer-name buf)))) (save-excursion (set-buffer buf) (revert-buffer t t))))) (save-excursion ;;; The truename stuff makes this obsolete. ;;; (let* ((link-name (car (file-attributes filename))) ;;; (linked-buf (and (stringp link-name) ;;; (get-file-buffer link-name)))) ;;; (if (bufferp linked-buf) ;;; (message "Symbolic link to file in buffer %s" ;;; (buffer-name linked-buf)))) (setq buf (create-file-buffer filename)) (set-buffer-major-mode buf) (set-buffer buf) (erase-buffer) (if rawfile (condition-case () (insert-file-contents-literally filename t) (file-error ;; Unconditionally set error (setq error t))) (condition-case () (insert-file-contents filename t) (file-error ;; Run find-file-not-found-hooks until one returns non-nil. (or (run-hook-with-args-until-success 'find-file-not-found-hooks) ;; If they fail too, set error. (setq error t))))) ;; Find the file's truename, and maybe use that as visited name. (setq buffer-file-truename truename) (setq buffer-file-number number) ;; On VMS, we may want to remember which directory in a search list ;; the file was found in. (and (eq system-type 'vax-vms) (let (logical) (if (string-match ":" (file-name-directory filename)) (setq logical (substring (file-name-directory filename) 0 (match-beginning 0)))) (not (member logical find-file-not-true-dirname-list))) (setq buffer-file-name buffer-file-truename)) (if find-file-visit-truename (setq buffer-file-name (setq filename (expand-file-name buffer-file-truename)))) ;; Set buffer's default directory to that of the file. (setq default-directory (file-name-directory filename)) ;; Turn off backup files for certain file names. Since ;; this is a permanent local, the major mode won't eliminate it. (and (not (funcall backup-enable-predicate buffer-file-name)) (progn (make-local-variable 'backup-inhibited) (setq backup-inhibited t))) (if rawfile nil (after-find-file error (not nowarn))))) buf))) (defvar after-find-file-from-revert-buffer nil) (defun after-find-file (&optional error warn noauto after-find-file-from-revert-buffer) "Called after finding a file and by the default revert function. Sets buffer mode, parses local variables. Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an error in reading the file. WARN non-nil means warn if there exists an auto-save file more recent than the visited file. NOAUTO means don't mess with auto-save mode. Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil means this call was from `revert-buffer'. Finishes by calling the functions in `find-file-hooks'." (setq buffer-read-only (not (file-writable-p buffer-file-name))) (if noninteractive nil (let* (not-serious (msg (cond ((and error (file-attributes buffer-file-name)) (setq buffer-read-only t) "File exists, but cannot be read.") ((not buffer-read-only) (if (and warn (file-newer-than-file-p (make-auto-save-file-name) buffer-file-name)) "Auto save file is newer; consider M-x recover-file" (setq not-serious t) (if error "(New file)" nil))) ((not error) (setq not-serious t) "Note: file is write protected") ((file-attributes (directory-file-name default-directory)) "File not found and directory write-protected") ((file-exists-p (file-name-directory buffer-file-name)) (setq buffer-read-only nil)) (t (setq buffer-read-only nil) (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name)))) "Use M-x make-dir RET RET to create the directory" "Use C-u M-x make-dir RET RET to create directory and its parents"))))) (if msg (progn (message msg) (or not-serious (sit-for 1 nil t))))) (if (and auto-save-default (not noauto)) (auto-save-mode t))) (normal-mode t) (run-hooks 'find-file-hooks)) (defun normal-mode (&optional find-file) "Choose the major mode for this buffer automatically. Also sets up any specified local variables of the file. Uses the visited file name, the -*- line, and the local variables spec. This function is called automatically from `find-file'. In that case, we may set up specified local variables depending on the value of `enable-local-variables': if it is t, we do; if it is nil, we don't; otherwise, we query. `enable-local-variables' is ignored if you run `normal-mode' explicitly." (interactive) (or find-file (funcall (or default-major-mode 'fundamental-mode))) (condition-case err (set-auto-mode) (error (message "File mode specification error: %s" (prin1-to-string err)))) (condition-case err (let ((enable-local-variables (or (not find-file) enable-local-variables))) (hack-local-variables)) (error (message "File local-variables error: %s" (prin1-to-string err))))) (defvar auto-mode-alist (mapcar 'purecopy '(("\\.text\\'" . text-mode) ("\\.c\\'" . c-mode) ("\\.h\\'" . c-mode) ("\\.tex\\'" . tex-mode) ("\\.ltx\\'" . latex-mode) ("\\.el\\'" . emacs-lisp-mode) ("\\.mm\\'" . nroff-mode) ("\\.me\\'" . nroff-mode) ("\\.ms\\'" . nroff-mode) ("\\.man\\'" . nroff-mode) ("\\.scm\\'" . scheme-mode) ("\\.l\\'" . lisp-mode) ("\\.lisp\\'" . lisp-mode) ("\\.f\\'" . fortran-mode) ("\\.for\\'" . fortran-mode) ("\\.p\\'" . pascal-mode) ("\\.pas\\'" . pascal-mode) ("\\.mss\\'" . scribe-mode) ("\\.ad[abs]\\'" . ada-mode) ("\\.icn\\'" . icon-mode) ("\\.pl\\'" . perl-mode) ("\\.cc\\'" . c++-mode) ("\\.hh\\'" . c++-mode) ("\\.C\\'" . c++-mode) ("\\.H\\'" . c++-mode) ("\\.cpp\\'" . c++-mode) ("\\.cxx\\'" . c++-mode) ("\\.hxx\\'" . c++-mode) ("\\.c\\+\\+\\'" . c++-mode) ("\\.h\\+\\+\\'" . c++-mode) ("\\.mk\\'" . makefile-mode) ("[Mm]akefile\\(.in\\)?\\'" . makefile-mode) ;;; Less common extensions come here ;;; so more common ones above are found faster. ("\\.texinfo\\'" . texinfo-mode) ("\\.texi\\'" . texinfo-mode) ("\\.s\\'" . asm-mode) ("ChangeLog\\'" . change-log-mode) ("change.log\\'" . change-log-mode) ("changelo\\'" . change-log-mode) ("ChangeLog.[0-9]+\\'" . change-log-mode) ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) ("\\.scm\\.[0-9]*\\'" . scheme-mode) ;;; The following should come after the ChangeLog pattern ;;; for the sake of ChangeLog.1, etc. ;;; and after the .scm.[0-9] pattern too. ("\\.[12345678]\\'" . nroff-mode) ("\\.TeX\\'" . tex-mode) ("\\.sty\\'" . latex-mode) ("\\.cls\\'" . latex-mode) ;LaTeX 2e class ("\\.bbl\\'" . latex-mode) ("\\.bib\\'" . bibtex-mode) ("\\.article\\'" . text-mode) ("\\.letter\\'" . text-mode) ("\\.tcl\\'" . tcl-mode) ("\\.f90\\'" . f90-mode) ("\\.lsp\\'" . lisp-mode) ("\\.awk\\'" . awk-mode) ("\\.prolog\\'" . prolog-mode) ("\\.tar\\'" . tar-mode) ("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode) ;; Mailer puts message to be edited in ;; /tmp/Re.... or Message ("^/tmp/Re" . text-mode) ("/Message[0-9]*\\'" . text-mode) ("/drafts/[0-9]+\\'" . mh-letter-mode) ;; some news reader is reported to use this ("^/tmp/fol/" . text-mode) ("\\.y\\'" . c-mode) ("\\.lex\\'" . c-mode) ("\\.oak\\'" . scheme-mode) ("\\.sgm\\'" . sgml-mode) ("\\.sgml\\'" . sgml-mode) ("\\.dtd\\'" . sgml-mode) ;; .emacs following a directory delimiter ;; in either Unix or VMS syntax. ("[]>:/]\\..*emacs\\'" . emacs-lisp-mode) ;; _emacs following a directory delimiter ;; in MsDos syntax ("[:/]_emacs\\'" . emacs-lisp-mode) ("\\.ml\\'" . lisp-mode))) "\ Alist of filename patterns vs corresponding major mode functions. Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL). \(NON-NIL stands for anything that is not nil; the value does not matter.) Visiting a file whose name matches REGEXP specifies FUNCTION as the mode function to use. FUNCTION will be called, unless it is nil. If the element has the form (REGEXP FUNCTION NON-NIL), then after calling FUNCTION (if it's not nil), we delete the suffix that matched REGEXP and search the list again for another match.") (defconst interpreter-mode-alist '(("perl" . perl-mode) ("wish" . tcl-mode) ("wishx" . tcl-mode) ("tcl" . tcl-mode) ("tclsh" . tcl-mode) ("awk" . awk-mode) ("nawk" . awk-mode) ("gawk" . awk-mode) ("scm" . scheme-mode)) "Alist mapping interpreter names to major modes. This alist applies to files whose first line starts with `#!'. Each element looks like (INTERPRETER . MODE). The car of each element is compared with the name of the interpreter specified in the first line. If it matches, mode MODE is selected.") (defconst inhibit-first-line-modes-regexps '("\\.tar\\'") "List of regexps; if one matches a file name, don't look for `-*-'.") (defconst inhibit-first-line-modes-suffixes nil "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'. When checking `inhibit-first-line-modes-regexps', we first discard from the end of the file name anything that matches one of these regexps.") (defvar user-init-file "" ; set by command-line "File name including directory of user's initialization file.") (defun set-auto-mode () "Select major mode appropriate for current buffer. This checks for a -*- mode tag in the buffer's text, compares the filename against the entries in `auto-mode-alist', or checks the interpreter that runs this file against `interpreter-mode-alist'. It does not check for the `mode:' local variable in the Local Variables section of the file; for that, use `hack-local-variables'. If `enable-local-variables' is nil, this function does not check for a -*- mode tag." ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- (let (beg end done modes) (save-excursion (goto-char (point-min)) (skip-chars-forward " \t\n") (and enable-local-variables ;; Don't look for -*- if this file name matches any ;; of the regexps in inhibit-first-line-modes-regexps. (let ((temp inhibit-first-line-modes-regexps) (name (if buffer-file-name (file-name-sans-versions buffer-file-name) (buffer-name)))) (while (let ((sufs inhibit-first-line-modes-suffixes)) (while (and sufs (not (string-match (car sufs) name))) (setq sufs (cdr sufs))) sufs) (setq name (substring name 0 (match-beginning 0)))) (while (and temp (not (string-match (car temp) name))) (setq temp (cdr temp))) (not temp)) (search-forward "-*-" (save-excursion ;; If the file begins with "#!" ;; (exec interpreter magic), look ;; for mode frobs in the first two ;; lines. You cannot necessarily ;; put them in the first line of ;; such a file without screwing up ;; the interpreter invocation. (end-of-line (and (looking-at "^#!") 2)) (point)) t) (progn (skip-chars-forward " \t") (setq beg (point)) (search-forward "-*-" (save-excursion (end-of-line) (point)) t)) (progn (forward-char -3) (skip-chars-backward " \t") (setq end (point)) (goto-char beg) (if (save-excursion (search-forward ":" end t)) ;; Find all specifications for the `mode:' variable ;; and execute them left to right. (while (let ((case-fold-search t)) (or (and (looking-at "mode:") (goto-char (match-end 0))) (re-search-forward "[ \t;]mode:" end t))) (skip-chars-forward " \t") (setq beg (point)) (if (search-forward ";" end t) (forward-char -1) (goto-char end)) (skip-chars-backward " \t") (setq modes (cons (intern (concat (downcase (buffer-substring beg (point))) "-mode")) modes))) ;; Simple -*-MODE-*- case. (setq modes (cons (intern (concat (downcase (buffer-substring beg end)) "-mode")) modes)))))) ;; If we found modes to use, invoke them now, ;; outside the save-excursion. (if modes (progn (mapcar 'funcall modes) (setq done t))) ;; If we didn't find a mode from a -*- line, try using the file name. (if (and (not done) buffer-file-name) (let ((name buffer-file-name) (keep-going t)) ;; Remove backup-suffixes from file name. (setq name (file-name-sans-versions name)) (while keep-going (setq keep-going nil) (let ((alist auto-mode-alist) (mode nil)) ;; Find first matching alist entry. (let ((case-fold-search (memq system-type '(vax-vms windows-nt)))) (while (and (not mode) alist) (if (string-match (car (car alist)) name) (if (and (consp (cdr (car alist))) (nth 2 (car alist))) (progn (setq mode (car (cdr (car alist))) name (substring name 0 (match-beginning 0)) keep-going t)) (setq mode (cdr (car alist)) keep-going nil))) (setq alist (cdr alist)))) (if mode (funcall mode) ;; If we can't deduce a mode from the file name, ;; look for an interpreter specified in the first line. (let ((interpreter (save-excursion (goto-char (point-min)) (if (looking-at "#! *\\([^ \t\n]+\\)") (buffer-substring (match-beginning 1) (match-end 1)) ""))) elt) ;; Map interpreter name to a mode. (setq elt (assoc (file-name-nondirectory interpreter) interpreter-mode-alist)) (if elt (funcall (cdr elt))))))))))) (defun hack-local-variables-prop-line () ;; Set local variables specified in the -*- line. ;; Ignore any specification for `mode:'; ;; set-auto-mode should already have handled that. (save-excursion (goto-char (point-min)) (let ((result nil) (end (save-excursion (end-of-line (and (looking-at "^#!") 2)) (point)))) ;; Parse the -*- line into the `result' alist. (cond ((not (search-forward "-*-" end t)) ;; doesn't have one. nil) ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)") ;; Simple form: "-*- MODENAME -*-". Already handled. nil) (t ;; Hairy form: '-*-' [ ':' ';' ]* '-*-' ;; (last ";" is optional). (save-excursion (if (search-forward "-*-" end t) (setq end (- (point) 3)) (error "-*- not terminated before end of line"))) (while (< (point) end) (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*") (error "malformed -*- line")) (goto-char (match-end 0)) ;; There used to be a downcase here, ;; but the manual didn't say so, ;; and people want to set var names that aren't all lc. (let ((key (intern (buffer-substring (match-beginning 1) (match-end 1)))) (val (save-restriction (narrow-to-region (point) end) (read (current-buffer))))) (or (eq key 'mode) (setq result (cons (cons key val) result))) (skip-chars-forward " \t;"))) (setq result (nreverse result)))) (if (and result (or (eq enable-local-variables t) (and enable-local-variables (save-window-excursion (condition-case nil (switch-to-buffer (current-buffer)) (error ;; If we fail to switch in the selected window, ;; it is probably a minibuffer. ;; So try another window. (condition-case nil (switch-to-buffer-other-window (current-buffer)) (error (switch-to-buffer-other-frame (current-buffer)))))) (y-or-n-p (format "Set local variables as specified in -*- line of %s? " (file-name-nondirectory buffer-file-name))))))) (while result (hack-one-local-variable (car (car result)) (cdr (car result))) (setq result (cdr result))))))) (defvar hack-local-variables-hook nil "Normal hook run after processing a file's local variables specs. Major modes can use this to examine user-specified local variables in order to initialize other data structure based on them.") (defun hack-local-variables () "Parse and put into effect this buffer's local variables spec." (hack-local-variables-prop-line) ;; Look for "Local variables:" line in last page. (save-excursion (goto-char (point-max)) (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move) (if (let ((case-fold-search t)) (and (search-forward "Local Variables:" nil t) (or (eq enable-local-variables t) (and enable-local-variables (save-window-excursion (switch-to-buffer (current-buffer)) (save-excursion (beginning-of-line) (set-window-start (selected-window) (point))) (y-or-n-p (format "Set local variables as specified at end of %s? " (if buffer-file-name (file-name-nondirectory buffer-file-name) (concat "buffer " (buffer-name)))))))))) (let ((continue t) prefix prefixlen suffix beg (enable-local-eval enable-local-eval)) ;; The prefix is what comes before "local variables:" in its line. ;; The suffix is what comes after "local variables:" in its line. (skip-chars-forward " \t") (or (eolp) (setq suffix (buffer-substring (point) (progn (end-of-line) (point))))) (goto-char (match-beginning 0)) (or (bolp) (setq prefix (buffer-substring (point) (progn (beginning-of-line) (point))))) (if prefix (setq prefixlen (length prefix) prefix (regexp-quote prefix))) (if suffix (setq suffix (concat (regexp-quote suffix) "$"))) (while continue ;; Look at next local variable spec. (if selective-display (re-search-forward "[\n\C-m]") (forward-line 1)) ;; Skip the prefix, if any. (if prefix (if (looking-at prefix) (forward-char prefixlen) (error "Local variables entry is missing the prefix"))) ;; Find the variable name; strip whitespace. (skip-chars-forward " \t") (setq beg (point)) (skip-chars-forward "^:\n") (if (eolp) (error "Missing colon in local variables entry")) (skip-chars-backward " \t") (let* ((str (buffer-substring beg (point))) (var (read str)) val) ;; Setting variable named "end" means end of list. (if (string-equal (downcase str) "end") (setq continue nil) ;; Otherwise read the variable value. (skip-chars-forward "^:") (forward-char 1) (setq val (read (current-buffer))) (skip-chars-backward "\n") (skip-chars-forward " \t") (or (if suffix (looking-at suffix) (eolp)) (error "Local variables entry is terminated incorrectly")) ;; Set the variable. "Variables" mode and eval are funny. (hack-one-local-variable var val))))))) (run-hooks 'hack-local-variables-hook)) (defconst ignored-local-variables '(enable-local-eval) "Variables to be ignored in a file's local variable spec.") ;; Get confirmation before setting these variables as locals in a file. (put 'debugger 'risky-local-variable t) (put 'enable-local-eval 'risky-local-variable t) (put 'ignored-local-variables 'risky-local-variable t) (put 'eval 'risky-local-variable t) (put 'file-name-handler-alist 'risky-local-variable t) (put 'minor-mode-map-alist 'risky-local-variable t) (put 'after-load-alist 'risky-local-variable t) (put 'buffer-file-name 'risky-local-variable t) (put 'buffer-auto-save-file-name 'risky-local-variable t) (put 'buffer-file-truename 'risky-local-variable t) (put 'exec-path 'risky-local-variable t) (put 'load-path 'risky-local-variable t) (put 'exec-directory 'risky-local-variable t) (put 'process-environment 'risky-local-variable t) ;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode. (put 'outline-level 'risky-local-variable t) (put 'rmail-output-file-alist 'risky-local-variable t) ;; This one is safe because the user gets to check it before it is used. (put 'compile-command 'safe-local-variable t) (defun hack-one-local-variable-quotep (exp) (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) ;; "Set" one variable in a local variables spec. ;; A few variable names are treated specially. (defun hack-one-local-variable (var val) (cond ((eq var 'mode) (funcall (intern (concat (downcase (symbol-name val)) "-mode")))) ((memq var ignored-local-variables) nil) ;; "Setting" eval means either eval it or do nothing. ;; Likewise for setting hook variables. ((or (get var 'risky-local-variable) (and (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$" (symbol-name var)) (not (get var 'safe-local-variable)))) ;; Permit evaling a put of a harmless property ;; if the args do nothing tricky. (if (or (and (eq var 'eval) (consp val) (eq (car val) 'put) (hack-one-local-variable-quotep (nth 1 val)) (hack-one-local-variable-quotep (nth 2 val)) ;; Only allow safe values of lisp-indent-hook; ;; not functions. (or (numberp (nth 3 val)) (equal (nth 3 val) ''defun)) (memq (nth 1 (nth 2 val)) '(lisp-indent-hook))) ;; Permit eval if not root and user says ok. (and (not (zerop (user-uid))) (or (eq enable-local-eval t) (and enable-local-eval (save-window-excursion (switch-to-buffer (current-buffer)) (save-excursion (beginning-of-line) (set-window-start (selected-window) (point))) (setq enable-local-eval (y-or-n-p (format "Process `eval' or hook local variables in file %s? " (file-name-nondirectory buffer-file-name))))))))) (if (eq var 'eval) (save-excursion (eval val)) (make-local-variable var) (set var val)) (message "Ignoring `eval:' in file's local variables"))) ;; Ordinary variable, really set it. (t (make-local-variable var) (set var val)))) (defun set-visited-file-name (filename) "Change name of file visited in current buffer to FILENAME. The next time the buffer is saved it will go in the newly specified file. nil or empty string as argument means make buffer not be visiting any file. Remember to delete the initial contents of the minibuffer if you wish to pass an empty string as the argument." (interactive "FSet visited file name: ") (if (buffer-base-buffer) (error "An indirect buffer cannot visit a file")) (let (truename) (if filename (setq filename (if (string-equal filename "") nil (expand-file-name filename)))) (if filename (progn (setq truename (file-truename filename)) (if find-file-visit-truename (setq filename truename)))) (or (equal filename buffer-file-name) (progn (and filename (lock-buffer filename)) (unlock-buffer))) (setq buffer-file-name filename) (if filename ; make buffer name reflect filename. (let ((new-name (file-name-nondirectory buffer-file-name))) (if (string= new-name "") (error "Empty file name")) (if (eq system-type 'vax-vms) (setq new-name (downcase new-name))) (setq default-directory (file-name-directory buffer-file-name)) (or (string= new-name (buffer-name)) (rename-buffer new-name t)))) (setq buffer-backed-up nil) (clear-visited-file-modtime) ;; Abbreviate the file names of the buffer. (if truename (progn (setq buffer-file-truename (abbreviate-file-name truename)) (if find-file-visit-truename (setq buffer-file-name buffer-file-truename)))) (setq buffer-file-number (if filename (nthcdr 10 (file-attributes buffer-file-name)) nil))) ;; write-file-hooks is normally used for things like ftp-find-file ;; that visit things that are not local files as if they were files. ;; Changing to visit an ordinary local file instead should flush the hook. (kill-local-variable 'write-file-hooks) (kill-local-variable 'local-write-file-hooks) (kill-local-variable 'revert-buffer-function) (kill-local-variable 'backup-inhibited) ;; If buffer was read-only because of version control, ;; that reason is gone now, so make it writable. (if vc-mode (setq buffer-read-only nil)) (kill-local-variable 'vc-mode) ;; Turn off backup files for certain file names. ;; Since this is a permanent local, the major mode won't eliminate it. (and (not (funcall backup-enable-predicate buffer-file-name)) (progn (make-local-variable 'backup-inhibited) (setq backup-inhibited t))) (let ((oauto buffer-auto-save-file-name)) ;; If auto-save was not already on, turn it on if appropriate. (if (not buffer-auto-save-file-name) (and buffer-file-name auto-save-default (auto-save-mode t)) ;; If auto save is on, start using a new name. ;; We deliberately don't rename or delete the old auto save ;; for the old visited file name. This is because perhaps ;; the user wants to save the new state and then compare with the ;; previous state from the auto save file. (setq buffer-auto-save-file-name (make-auto-save-file-name))) ;; Rename the old auto save file if any. (and oauto buffer-auto-save-file-name (file-exists-p oauto) (rename-file oauto buffer-auto-save-file-name t))) (if buffer-file-name (set-buffer-modified-p t))) (defun write-file (filename &optional confirm) "Write current buffer into file FILENAME. Makes buffer visit that file, and marks it not modified. If the buffer is already visiting a file, you can specify a directory name as FILENAME, to write a file of the same old name in that directory. If optional second arg CONFIRM is non-nil, ask for confirmation for overwriting an existing file." ;; (interactive "FWrite file: ") (interactive (list (if buffer-file-name (read-file-name "Write file: " nil nil nil nil) (read-file-name "Write file: " (cdr (assq 'default-directory (buffer-local-variables))) nil nil (buffer-name))) t)) (or (null filename) (string-equal filename "") (progn ;; If arg is just a directory, ;; use same file name, but in that directory. (if (and (file-directory-p filename) buffer-file-name) (setq filename (concat (file-name-as-directory filename) (file-name-nondirectory buffer-file-name)))) (and confirm (file-exists-p filename) (or (y-or-n-p (format "File `%s' exists; overwrite? " filename)) (error "Canceled"))) (set-visited-file-name filename))) (set-buffer-modified-p t) (save-buffer)) (defun backup-buffer () "Make a backup of the disk file visited by the current buffer, if appropriate. This is normally done before saving the buffer the first time. If the value is non-nil, it is the result of `file-modes' on the original file; this means that the caller, after saving the buffer, should change the modes of the new file to agree with the old modes." (if (and make-backup-files (not backup-inhibited) (not buffer-backed-up) (file-exists-p buffer-file-name) (memq (aref (elt (file-attributes buffer-file-name) 8) 0) '(?- ?l))) (let ((real-file-name buffer-file-name) backup-info backupname targets setmodes) ;; If specified name is a symbolic link, chase it to the target. ;; Thus we make the backups in the directory where the real file is. (setq real-file-name (file-chase-links real-file-name)) (setq backup-info (find-backup-file-name real-file-name) backupname (car backup-info) targets (cdr backup-info)) ;;; (if (file-directory-p buffer-file-name) ;;; (error "Cannot save buffer in directory %s" buffer-file-name)) (if backup-info (condition-case () (let ((delete-old-versions ;; If have old versions to maybe delete, ;; ask the user to confirm now, before doing anything. ;; But don't actually delete til later. (and targets (or (eq delete-old-versions t) (eq delete-old-versions nil)) (or delete-old-versions (y-or-n-p (format "Delete excess backup versions of %s? " real-file-name)))))) ;; Actually write the back up file. (condition-case () (if (or file-precious-flag ; (file-symlink-p buffer-file-name) backup-by-copying (and backup-by-copying-when-linked (> (file-nlinks real-file-name) 1)) (and backup-by-copying-when-mismatch (let ((attr (file-attributes real-file-name))) (or (nth 9 attr) (not (file-ownership-preserved-p real-file-name)))))) (condition-case () (copy-file real-file-name backupname t t) (file-error ;; If copying fails because file BACKUPNAME ;; is not writable, delete that file and try again. (if (and (file-exists-p backupname) (not (file-writable-p backupname))) (delete-file backupname)) (copy-file real-file-name backupname t t))) ;; rename-file should delete old backup. (rename-file real-file-name backupname t) (setq setmodes (file-modes backupname))) (file-error ;; If trouble writing the backup, write it in ~. (setq backupname (expand-file-name "~/%backup%~")) (message "Cannot write backup file; backing up in ~/%%backup%%~") (sleep-for 1) (condition-case () (copy-file real-file-name backupname t t) (file-error ;; If copying fails because file BACKUPNAME ;; is not writable, delete that file and try again. (if (and (file-exists-p backupname) (not (file-writable-p backupname))) (delete-file backupname)) (copy-file real-file-name backupname t t))))) (setq buffer-backed-up t) ;; Now delete the old versions, if desired. (if delete-old-versions (while targets (condition-case () (delete-file (car targets)) (file-error nil)) (setq targets (cdr targets)))) setmodes) (file-error nil)))))) (defun file-name-sans-versions (name &optional keep-backup-version) "Return FILENAME sans backup versions or strings. This is a separate procedure so your site-init or startup file can redefine it. If the optional argument KEEP-BACKUP-VERSION is non-nil, we do not remove backup version numbers, only true file version numbers." (let ((handler (find-file-name-handler name 'file-name-sans-versions))) (if handler (funcall handler 'file-name-sans-versions name keep-backup-version) (substring name 0 (if (eq system-type 'vax-vms) ;; VMS version number is (a) semicolon, optional ;; sign, zero or more digits or (b) period, option ;; sign, zero or more digits, provided this is the ;; second period encountered outside of the ;; device/directory part of the file name. (or (string-match ";[-+]?[0-9]*\\'" name) (if (string-match "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'" name) (match-beginning 1)) (length name)) (if keep-backup-version (length name) (or (string-match "\\.~[0-9.]+~\\'" name) (string-match "~\\'" name) (length name)))))))) (defun file-ownership-preserved-p (file) "Returns t if deleting FILE and rewriting it would preserve the owner." (let ((handler (find-file-name-handler file 'file-ownership-preserved-p))) (if handler (funcall handler 'file-ownership-preserved-p file) (let ((attributes (file-attributes file))) ;; Return t if the file doesn't exist, since it's true that no ;; information would be lost by an (attempted) delete and create. (or (null attributes) (= (nth 2 attributes) (user-uid))))))) (defun file-name-sans-extension (filename) "Return FILENAME sans final \"extension\". The extension, in a file name, is the part that follows the last `.'." (save-match-data (let ((file (file-name-sans-versions (file-name-nondirectory filename))) directory) (if (string-match "\\.[^.]*\\'" file) (if (setq directory (file-name-directory filename)) (expand-file-name (substring file 0 (match-beginning 0)) directory) (substring file 0 (match-beginning 0))) filename)))) (defun make-backup-file-name (file) "Create the non-numeric backup file name for FILE. This is a separate function so you can redefine it for customization." (if (eq system-type 'ms-dos) (let ((fn (file-name-nondirectory file))) (concat (file-name-directory file) (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn) (substring fn 0 (match-end 1))) ".bak")) (concat file "~"))) (defun backup-file-name-p (file) "Return non-nil if FILE is a backup file name (numeric or not). This is a separate function so you can redefine it for customization. You may need to redefine `file-name-sans-versions' as well." (if (eq system-type 'ms-dos) (string-match "\\.bak$" file) (string-match "~$" file))) ;; This is used in various files. ;; The usage of bv-length is not very clean, ;; but I can't see a good alternative, ;; so as of now I am leaving it alone. (defun backup-extract-version (fn) "Given the name of a numeric backup file, return the backup number. Uses the free variable `bv-length', whose value should be the index in the name where the version number begins." (if (and (string-match "[0-9]+~$" fn bv-length) (= (match-beginning 0) bv-length)) (string-to-int (substring fn bv-length -1)) 0)) ;; I believe there is no need to alter this behavior for VMS; ;; since backup files are not made on VMS, it should not get called. (defun find-backup-file-name (fn) "Find a file name for a backup file, and suggestions for deletions. Value is a list whose car is the name for the backup file and whose cdr is a list of old versions to consider deleting now. If the value is nil, don't make a backup." (let ((handler (find-file-name-handler fn 'find-backup-file-name))) ;; Run a handler for this function so that ange-ftp can refuse to do it. (if handler (funcall handler 'find-backup-file-name fn) (if (eq version-control 'never) (list (make-backup-file-name fn)) (let* ((base-versions (concat (file-name-nondirectory fn) ".~")) (bv-length (length base-versions)) possibilities (versions nil) (high-water-mark 0) (deserve-versions-p nil) (number-to-delete 0)) (condition-case () (setq possibilities (file-name-all-completions base-versions (file-name-directory fn)) versions (sort (mapcar (function backup-extract-version) possibilities) '<) high-water-mark (apply 'max 0 versions) deserve-versions-p (or version-control (> high-water-mark 0)) number-to-delete (- (length versions) kept-old-versions kept-new-versions -1)) (file-error (setq possibilities nil))) (if (not deserve-versions-p) (list (make-backup-file-name fn)) (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~") (if (and (> number-to-delete 0) ;; Delete nothing if there is overflow ;; in the number of versions to keep. (>= (+ kept-new-versions kept-old-versions -1) 0)) (mapcar (function (lambda (n) (concat fn ".~" (int-to-string n) "~"))) (let ((v (nthcdr kept-old-versions versions))) (rplacd (nthcdr (1- number-to-delete) v) ()) v)))))))))) (defun file-nlinks (filename) "Return number of names file FILENAME has." (car (cdr (file-attributes filename)))) (defun file-relative-name (filename &optional directory) "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)))) (let ((ancestor "")) (while (not (string-match (concat "^" (regexp-quote directory)) filename)) (setq directory (file-name-directory (substring directory 0 -1)) ancestor (concat "../" ancestor))) (concat ancestor (substring filename (match-end 0))))) (defun save-buffer (&optional args) "Save current buffer in visited file if modified. Versions described below. By default, makes the previous version into a backup file if previously requested or if this is the first save. With 1 or 3 \\[universal-argument]'s, marks this version to become a backup when the next save is done. With 2 or 3 \\[universal-argument]'s, unconditionally makes the previous version into a backup file. With argument of 0, never makes the previous version into a backup file. If a file's name is FOO, the names of its numbered backup versions are FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. Numeric backups (rather than FOO~) will be made if value of `version-control' is not the atom `never' and either there are already numeric versions of the file being backed up, or `version-control' is non-nil. We don't want excessive versions piling up, so there are variables `kept-old-versions', which tells Emacs how many oldest versions to keep, and `kept-new-versions', which tells how many newest versions to keep. Defaults are 2 old versions and 2 new. `dired-kept-versions' controls dired's clean-directory (.) command. If `delete-old-versions' is nil, system will query user before trimming versions. Otherwise it does it silently." (interactive "p") (let ((modp (buffer-modified-p)) (large (> (buffer-size) 50000)) (make-backup-files (or (and make-backup-files (not (eq args 0))) (memq args '(16 64))))) (and modp (memq args '(16 64)) (setq buffer-backed-up nil)) (if (and modp large) (message "Saving file %s..." (buffer-file-name))) (basic-save-buffer) (and modp (memq args '(4 64)) (setq buffer-backed-up nil)))) (defun delete-auto-save-file-if-necessary (&optional force) "Delete auto-save file for current buffer if `delete-auto-save-files' is t. Normally delete only if the file was written by this Emacs since the last real save, but optional arg FORCE non-nil means delete anyway." (and buffer-auto-save-file-name delete-auto-save-files (not (string= buffer-file-name buffer-auto-save-file-name)) (or force (recent-auto-save-p)) (progn (condition-case () (delete-file buffer-auto-save-file-name) (file-error nil)) (set-buffer-auto-saved)))) (defvar after-save-hook nil "Normal hook that is run after a buffer is saved to its file.") (defun basic-save-buffer () "Save the current buffer in its visited file, if it has been modified. After saving the buffer, run `after-save-hook'." (interactive) (save-excursion ;; In an indirect buffer, save its base buffer instead. (if (buffer-base-buffer) (set-buffer (buffer-base-buffer))) (if (buffer-modified-p) (let ((recent-save (recent-auto-save-p)) setmodes tempsetmodes) ;; On VMS, rename file and buffer to get rid of version number. (if (and (eq system-type 'vax-vms) (not (string= buffer-file-name (file-name-sans-versions buffer-file-name)))) (let (buffer-new-name) ;; Strip VMS version number before save. (setq buffer-file-name (file-name-sans-versions buffer-file-name)) ;; Construct a (unique) buffer name to correspond. (let ((buf (create-file-buffer (downcase buffer-file-name)))) (setq buffer-new-name (buffer-name buf)) (kill-buffer buf)) (rename-buffer buffer-new-name))) ;; If buffer has no file name, ask user for one. (or buffer-file-name (let ((filename (expand-file-name (read-file-name "File to save in: ") nil))) (and (file-exists-p filename) (or (y-or-n-p (format "File `%s' exists; overwrite? " filename)) (error "Canceled"))) (set-visited-file-name filename))) (or (verify-visited-file-modtime (current-buffer)) (not (file-exists-p buffer-file-name)) (yes-or-no-p (format "%s has changed since visited or saved. Save anyway? " (file-name-nondirectory buffer-file-name))) (error "Save not confirmed")) (save-restriction (widen) (and (> (point-max) 1) (/= (char-after (1- (point-max))) ?\n) (not (and (eq selective-display t) (= (char-after (1- (point-max))) ?\r))) (or (eq require-final-newline t) (and require-final-newline (y-or-n-p (format "Buffer %s does not end in newline. Add one? " (buffer-name))))) (save-excursion (goto-char (point-max)) (insert ?\n))) (or (run-hook-with-args-until-success 'write-contents-hooks) (run-hook-with-args-until-success 'local-write-file-hooks) (run-hook-with-args-until-success 'write-file-hooks) ;; If a hook returned t, file is already "written". ;; Otherwise, write it the usual way now. (setq setmodes (basic-save-buffer-1))) (setq buffer-file-number (nthcdr 10 (file-attributes buffer-file-name))) (if setmodes (condition-case () (set-file-modes buffer-file-name setmodes) (error nil)))) ;; If the auto-save file was recent before this command, ;; delete it now. (delete-auto-save-file-if-necessary recent-save) ;; Support VC `implicit' locking. (vc-after-save) (run-hooks 'after-save-hook)) (message "(No changes need to be saved)")))) ;; This does the "real job" of writing a buffer into its visited file ;; and making a backup file. This is what is normally done ;; but inhibited if one of write-file-hooks returns non-nil. ;; It returns a value to store in setmodes. (defun basic-save-buffer-1 () (let (tempsetmodes setmodes) (if (not (file-writable-p buffer-file-name)) (let ((dir (file-name-directory buffer-file-name))) (if (not (file-directory-p dir)) (error "%s is not a directory" dir) (if (not (file-exists-p buffer-file-name)) (error "Directory %s write-protected" dir) (if (yes-or-no-p (format "File %s is write-protected; try to save anyway? " (file-name-nondirectory buffer-file-name))) (setq tempsetmodes t) (error "Attempt to save to a file which you aren't allowed to write")))))) (or buffer-backed-up (setq setmodes (backup-buffer))) (let ((dir (file-name-directory buffer-file-name))) (if (and file-precious-flag (file-writable-p dir)) ;; If file is precious, write temp name, then rename it. ;; This requires write access to the containing dir, ;; which is why we don't try it if we don't have that access. (let ((realname buffer-file-name) tempname temp nogood i succeed (old-modtime (visited-file-modtime))) (setq i 0) (setq nogood t) ;; Find the temporary name to write under. (while nogood (setq tempname (format "%s#tmp#%d" dir i)) (setq nogood (file-exists-p tempname)) (setq i (1+ i))) (unwind-protect (progn (clear-visited-file-modtime) (write-region (point-min) (point-max) tempname nil realname buffer-file-truename) (setq succeed t)) ;; If writing the temp file fails, ;; delete the temp file. (or succeed (progn (delete-file tempname) (set-visited-file-modtime old-modtime)))) ;; Since we have created an entirely new file ;; and renamed it, make sure it gets the ;; right permission bits set. (setq setmodes (file-modes buffer-file-name)) ;; We succeeded in writing the temp file, ;; so rename it. (rename-file tempname buffer-file-name t)) ;; If file not writable, see if we can make it writable ;; temporarily while we write it. ;; But no need to do so if we have just backed it up ;; (setmodes is set) because that says we're superseding. (cond ((and tempsetmodes (not setmodes)) ;; Change the mode back, after writing. (setq setmodes (file-modes buffer-file-name)) (set-file-modes buffer-file-name 511))) (write-region (point-min) (point-max) buffer-file-name nil t buffer-file-truename))) setmodes)) (defun save-some-buffers (&optional arg exiting) "Save some modified file-visiting buffers. Asks user about each one. Optional argument (the prefix) non-nil means save all with no questions. Optional second argument EXITING means ask about certain non-file buffers as well as about file buffers." (interactive "P") (save-window-excursion (let ((files-done (map-y-or-n-p (function (lambda (buffer) (and (buffer-modified-p buffer) (not (buffer-base-buffer buffer)) (or (buffer-file-name buffer) (and exiting (progn (set-buffer buffer) (and buffer-offer-save (> (buffer-size) 0))))) (if arg t (if (buffer-file-name buffer) (format "Save file %s? " (buffer-file-name buffer)) (format "Save buffer %s? " (buffer-name buffer))))))) (function (lambda (buffer) (set-buffer buffer) (save-buffer))) (buffer-list) '("buffer" "buffers" "save") (list (list ?\C-r (lambda (buf) (view-buffer buf) (setq view-exit-action '(lambda (ignore) (exit-recursive-edit))) (recursive-edit) ;; Return nil to ask about BUF again. nil) "display the current buffer")))) (abbrevs-done (and save-abbrevs abbrevs-changed (progn (if (or arg (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name))) (write-abbrev-file nil)) ;; Don't keep bothering user if he says no. (setq abbrevs-changed nil) t)))) (or (> files-done 0) abbrevs-done (message "(No files need saving)"))))) (defun not-modified (&optional arg) "Mark current buffer as unmodified, not needing to be saved. With prefix arg, mark buffer as modified, so \\[save-buffer] will save. It is not a good idea to use this function in Lisp programs, because it prints a message in the minibuffer. Instead, use `set-buffer-modified-p'." (interactive "P") (message (if arg "Modification-flag set" "Modification-flag cleared")) (set-buffer-modified-p arg)) (defun toggle-read-only (&optional arg) "Change whether this buffer is visiting its file read-only. With arg, set read-only iff arg is positive." (interactive "P") (setq buffer-read-only (if (null arg) (not buffer-read-only) (> (prefix-numeric-value arg) 0))) (force-mode-line-update)) (defun insert-file (filename) "Insert contents of file FILENAME into buffer after point. Set mark after the inserted text. This function is meant for the user to run interactively. Don't call it from programs! Use `insert-file-contents' instead. \(Its calling sequence is different; see its documentation)." (interactive "*fInsert file: ") (if (file-directory-p filename) (signal 'file-error (list "Opening input file" "file is a directory" filename))) (let ((tem (insert-file-contents filename))) (push-mark (+ (point) (car (cdr tem)))))) (defun append-to-file (start end filename) "Append the contents of the region to the end of file FILENAME. When called from a function, expects three arguments, START, END and FILENAME. START and END are buffer positions saying what text to write." (interactive "r\nFAppend to file: ") (write-region start end filename t)) (defun file-newest-backup (filename) "Return most recent backup file for FILENAME or nil if no backups exist." (let* ((filename (expand-file-name filename)) (file (file-name-nondirectory filename)) (dir (file-name-directory filename)) (comp (file-name-all-completions file dir)) newest) (while comp (setq file (concat dir (car comp)) comp (cdr comp)) (if (and (backup-file-name-p file) (or (null newest) (file-newer-than-file-p file newest))) (setq newest file))) newest)) (defun rename-uniquely () "Rename current buffer to a similar name not already taken. This function is useful for creating multiple shell process buffers or multiple mail buffers, etc." (interactive) (save-match-data (let* ((base-name (if (and (string-match "<[0-9]+>\\'" (buffer-name)) (not (and buffer-file-name (string= (buffer-name) (file-name-nondirectory buffer-file-name))))) ;; If the existing buffer name has a , ;; which isn't part of the file name (if any), ;; then get rid of that. (substring (buffer-name) 0 (match-beginning 0)) (buffer-name))) (new-buf (generate-new-buffer base-name)) (name (buffer-name new-buf))) (kill-buffer new-buf) (rename-buffer name) (force-mode-line-update)))) (defun make-directory (dir &optional parents) "Create the directory DIR and any nonexistent parent dirs. Interactively, the default choice of directory to create is the current default directory for file names. That is useful when you have visited a file in a nonexistint directory. Noninteractively, the second (optional) argument PARENTS says whether to create parent directories if they don't exist." (interactive (list (read-file-name "Make directory: " default-directory default-directory nil nil) t)) (let ((handler (find-file-name-handler dir 'make-directory))) (if handler (funcall handler 'make-directory dir parents) (if (not parents) (make-directory-internal dir) (let ((dir (directory-file-name (expand-file-name dir))) create-list) (while (not (file-exists-p dir)) (setq create-list (cons dir create-list) dir (directory-file-name (file-name-directory dir)))) (while create-list (make-directory-internal (car create-list)) (setq create-list (cdr create-list)))))))) (put 'revert-buffer-function 'permanent-local t) (defvar revert-buffer-function nil "Function to use to revert this buffer, or nil to do the default. The function receives two arguments IGNORE-AUTO and NOCONFIRM, which are the arguments that `revert-buffer' received.") (put 'revert-buffer-insert-file-contents-function 'permanent-local t) (defvar revert-buffer-insert-file-contents-function nil "Function to use to insert contents when reverting this buffer. Gets two args, first the nominal file name to use, and second, t if reading the auto-save file.") (defvar before-revert-hook nil "Normal hook for `revert-buffer' to run before reverting. If `revert-buffer-function' is used to override the normal revert mechanism, this hook is not used.") (defvar after-revert-hook nil "Normal hook for `revert-buffer' to run after reverting. Note that the hook value that it runs is the value that was in effect before reverting; that makes a difference if you have buffer-local hook functions. If `revert-buffer-function' is used to override the normal revert mechanism, this hook is not used.") (defun revert-buffer (&optional ignore-auto noconfirm) "Replace the buffer text with the text of the visited file on disk. This undoes all changes since the file was visited or saved. With a prefix argument, offer to revert from latest auto-save file, if that is more recent than the visited file. When called from Lisp, the first argument is IGNORE-AUTO; only offer to revert from the auto-save file when this is nil. Note that the sense of this argument is the reverse of the prefix argument, for the sake of backward compatibility. IGNORE-AUTO is optional, defaulting to nil. Optional second argument NOCONFIRM means don't ask for confirmation at all. If the value of `revert-buffer-function' is non-nil, it is called to do the work. The default revert function runs the hook `before-revert-hook' at the beginning and `after-revert-hook' at the end." ;; I admit it's odd to reverse the sense of the prefix argument, but ;; there is a lot of code out there which assumes that the first ;; argument should be t to avoid consulting the auto-save file, and ;; there's no straightforward way to encourage authors to notice a ;; reversal of the argument sense. So I'm just changing the user ;; interface, but leaving the programmatic interface the same. (interactive (list (not current-prefix-arg))) (if revert-buffer-function (funcall revert-buffer-function ignore-auto noconfirm) (let* ((opoint (point)) (auto-save-p (and (not ignore-auto) (recent-auto-save-p) buffer-auto-save-file-name (file-readable-p buffer-auto-save-file-name) (y-or-n-p "Buffer has been auto-saved recently. Revert from auto-save file? "))) (file-name (if auto-save-p buffer-auto-save-file-name buffer-file-name))) (cond ((null file-name) (error "Buffer does not seem to be associated with any file")) ((or noconfirm (yes-or-no-p (format "Revert buffer from file %s? " file-name))) (run-hooks 'before-revert-hook) ;; If file was backed up but has changed since, ;; we shd make another backup. (and (not auto-save-p) (not (verify-visited-file-modtime (current-buffer))) (setq buffer-backed-up nil)) ;; Get rid of all undo records for this buffer. (or (eq buffer-undo-list t) (setq buffer-undo-list nil)) ;; Effectively copy the after-revert-hook status, ;; since after-find-file will clobber it. (let ((global-hook (default-value 'after-revert-hook)) (local-hook-p (local-variable-p 'after-revert-hook)) (local-hook (and (local-variable-p 'after-revert-hook) after-revert-hook))) (let (buffer-read-only ;; Don't make undo records for the reversion. (buffer-undo-list t)) (if revert-buffer-insert-file-contents-function (funcall revert-buffer-insert-file-contents-function file-name auto-save-p) (if (not (file-exists-p file-name)) (error "File %s no longer exists!" file-name)) ;; Bind buffer-file-name to nil ;; so that we don't try to lock the file. (let ((buffer-file-name nil)) (or auto-save-p (unlock-buffer))) (widen) (insert-file-contents file-name (not auto-save-p) nil nil t))) (goto-char (min opoint (point-max))) ;; Recompute the truename in case changes in symlinks ;; have changed the truename. (setq buffer-file-truename (abbreviate-file-name (file-truename buffer-file-name))) (after-find-file nil nil t t) ;; Run after-revert-hook as it was before we reverted. (setq-default revert-buffer-internal-hook global-hook) (if local-hook-p (progn (make-local-variable 'revert-buffer-internal-hook) (setq revert-buffer-internal-hook local-hook)) (kill-local-variable 'revert-buffer-internal-hook)) (run-hooks 'revert-buffer-internal-hook)) t))))) (defun recover-file (file) "Visit file FILE, but get contents from its last auto-save file." ;; Actually putting the file name in the minibuffer should be used ;; only rarely. ;; Not just because users often use the default. (interactive "fRecover file: ") (setq file (expand-file-name file)) (if (auto-save-file-name-p (file-name-nondirectory file)) (error "%s is an auto-save file" file)) (let ((file-name (let ((buffer-file-name file)) (make-auto-save-file-name)))) (cond ((if (file-exists-p file) (not (file-newer-than-file-p file-name file)) (not (file-exists-p file-name))) (error "Auto-save file %s not current" file-name)) ((save-window-excursion (if (not (eq system-type 'vax-vms)) (with-output-to-temp-buffer "*Directory*" (buffer-disable-undo standard-output) (call-process "ls" nil standard-output nil (if (file-symlink-p file) "-lL" "-l") file file-name))) (yes-or-no-p (format "Recover auto save file %s? " file-name))) (switch-to-buffer (find-file-noselect file t)) (let ((buffer-read-only nil)) (erase-buffer) (insert-file-contents file-name nil)) (after-find-file nil nil t)) (t (error "Recover-file cancelled."))))) (defun recover-session () "Recover auto save files from a previous Emacs session. This command first displays a Dired buffer showing you the previous sessions that you could recover from. To choose one, move point to the proper line and then type C-c C-c. Then you'll be asked about a number of files to recover." (interactive) (dired (concat auto-save-list-file-prefix "*")) (goto-char (point-min)) (or (looking-at "Move to the session you want to recover,") (let ((inhibit-read-only t)) (insert "Move to the session you want to recover,\n" "then type C-c C-c to select it.\n\n" "You can also delete some of these files;\n" "type d on a line to mark that file for deletion.\n\n"))) (use-local-map (nconc (make-sparse-keymap) (current-local-map))) (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish)) (defun recover-session-finish () "Choose one saved session to recover auto-save files from. This command is used in the special Dired buffer created by \\[recover-session]." (interactive) ;; Get the name of the session file to recover from. (let ((file (dired-get-filename)) files (buffer (get-buffer-create " *recover*"))) (dired-do-flagged-delete t) (unwind-protect (save-excursion ;; Read in the auto-save-list file. (set-buffer buffer) (erase-buffer) (insert-file-contents file) ;; Loop thru the text of that file ;; and get out the names of the files to recover. (while (not (eobp)) (let (thisfile autofile) (if (eolp) ;; This is a pair of lines for a non-file-visiting buffer. ;; Get the auto-save file name and manufacture ;; a "visited file name" from that. (progn (forward-line 1) (setq autofile (buffer-substring-no-properties (point) (save-excursion (end-of-line) (point)))) (setq thisfile (expand-file-name (substring (file-name-nondirectory autofile) 1 -1) (file-name-directory autofile))) (forward-line 1)) ;; This pair of lines is a file-visiting ;; buffer. Use the visited file name. (progn (setq thisfile (buffer-substring-no-properties (point) (progn (end-of-line) (point)))) (forward-line 1) (setq autofile (buffer-substring-no-properties (point) (progn (end-of-line) (point)))) (forward-line 1))) ;; Ignore a file if its auto-save file does not exist now. (if (file-exists-p autofile) (setq files (cons thisfile files))))) (setq files (nreverse files)) ;; The file contains a pair of line for each auto-saved buffer. ;; The first line of the pair contains the visited file name ;; or is empty if the buffer was not visiting a file. ;; The second line is the auto-save file name. (if files (map-y-or-n-p "Recover %s? " (lambda (file) (condition-case nil (save-excursion (recover-file file)) (error "Failed to recover `%s'" file))) files '("file" "files" "recover")) (message "No files can be recovered from this session now"))) (kill-buffer buffer)))) (defun kill-some-buffers () "For each buffer, ask whether to kill it." (interactive) (let ((list (buffer-list))) (while list (let* ((buffer (car list)) (name (buffer-name buffer))) (and (not (string-equal name "")) (/= (aref name 0) ? ) (yes-or-no-p (format "Buffer %s %s. Kill? " name (if (buffer-modified-p buffer) "HAS BEEN EDITED" "is unmodified"))) (kill-buffer buffer))) (setq list (cdr list))))) (defun auto-save-mode (arg) "Toggle auto-saving of contents of current buffer. With prefix argument ARG, turn auto-saving on if positive, else off." (interactive "P") (setq buffer-auto-save-file-name (and (if (null arg) (or (not buffer-auto-save-file-name) ;; If autosave is off because buffer has shrunk, ;; then toggling should turn it on. (< buffer-saved-size 0)) (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0)))) (if (and buffer-file-name auto-save-visited-file-name (not buffer-read-only)) buffer-file-name (make-auto-save-file-name)))) ;; If -1 was stored here, to temporarily turn off saving, ;; turn it back on. (and (< buffer-saved-size 0) (setq buffer-saved-size 0)) (if (interactive-p) (message "Auto-save %s (in this buffer)" (if buffer-auto-save-file-name "on" "off"))) buffer-auto-save-file-name) (defun rename-auto-save-file () "Adjust current buffer's auto save file name for current conditions. Also rename any existing auto save file, if it was made in this session." (let ((osave buffer-auto-save-file-name)) (setq buffer-auto-save-file-name (make-auto-save-file-name)) (if (and osave buffer-auto-save-file-name (not (string= buffer-auto-save-file-name buffer-file-name)) (not (string= buffer-auto-save-file-name osave)) (file-exists-p osave) (recent-auto-save-p)) (rename-file osave buffer-auto-save-file-name t)))) (defun make-auto-save-file-name () "Return file name to use for auto-saves of current buffer. Does not consider `auto-save-visited-file-name' as that variable is checked before calling this function. You can redefine this for customization. See also `auto-save-file-name-p'." (if buffer-file-name (concat (file-name-directory buffer-file-name) "#" (file-name-nondirectory buffer-file-name) "#") ;; Deal with buffers that don't have any associated files. (Mail ;; mode tends to create a good number of these.) (let ((buffer-name (buffer-name)) (limit 0)) ;; Use technique from Sebastian Kremer's auto-save ;; package to turn slashes into \\!. This ensures that ;; the auto-save buffer name is unique. (while (string-match "[/\\]" buffer-name limit) (setq buffer-name (concat (substring buffer-name 0 (match-beginning 0)) (if (string= (substring buffer-name (match-beginning 0) (match-end 0)) "/") "\\!" "\\\\") (substring buffer-name (match-end 0)))) (setq limit (1+ (match-end 0)))) (expand-file-name (format "#%s#%s#" buffer-name (make-temp-name "")))))) (defun auto-save-file-name-p (filename) "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. FILENAME should lack slashes. You can redefine this for customization." (string-match "^#.*#$" filename)) (defconst list-directory-brief-switches (if (eq system-type 'vax-vms) "" "-CF") "*Switches for list-directory to pass to `ls' for brief listing,") (defconst list-directory-verbose-switches (if (eq system-type 'vax-vms) "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)" "-l") "*Switches for list-directory to pass to `ls' for verbose listing,") (defun list-directory (dirname &optional verbose) "Display a list of files in or matching DIRNAME, a la `ls'. DIRNAME is globbed by the shell if necessary. Prefix arg (second arg if noninteractive) means supply -l switch to `ls'. Actions controlled by variables `list-directory-brief-switches' and `list-directory-verbose-switches'." (interactive (let ((pfx current-prefix-arg)) (list (read-file-name (if pfx "List directory (verbose): " "List directory (brief): ") nil default-directory nil) pfx))) (let ((switches (if verbose list-directory-verbose-switches list-directory-brief-switches))) (or dirname (setq dirname default-directory)) (setq dirname (expand-file-name dirname)) (with-output-to-temp-buffer "*Directory*" (buffer-disable-undo standard-output) (princ "Directory ") (princ dirname) (terpri) (save-excursion (set-buffer "*Directory*") (setq default-directory (file-name-directory dirname)) (let ((wildcard (not (file-directory-p dirname)))) (insert-directory dirname switches wildcard (not wildcard))))))) (defvar insert-directory-program "ls" "Absolute or relative name of the `ls' program used by `insert-directory'.") ;; insert-directory ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and ;; FULL-DIRECTORY-P is nil. ;; The single line of output must display FILE's name as it was ;; given, namely, an absolute path name. ;; - must insert exactly one line for each file if WILDCARD or ;; FULL-DIRECTORY-P is t, plus one optional "total" line ;; before the file lines, plus optional text after the file lines. ;; Lines are delimited by "\n", so filenames containing "\n" are not ;; allowed. ;; File lines should display the basename. ;; - must be consistent with ;; - functions dired-move-to-filename, (these two define what a file line is) ;; dired-move-to-end-of-filename, ;; dired-between-files, (shortcut for (not (dired-move-to-filename))) ;; dired-insert-headerline ;; dired-after-subdir-garbage (defines what a "total" line is) ;; - 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. SWITCHES may be a string of options, or a list of strings. Optional third arg WILDCARD means treat FILE as shell wildcard. Optional fourth arg FULL-DIRECTORY-P means file is a directory and switches do not contain `d', so that a full listing is expected. This works by running a directory listing program whose name is in the variable `insert-directory-program'. If WILDCARD, it also runs the shell specified by `shell-file-name'." ;; We need the directory in order to find the right handler. (let ((handler (find-file-name-handler (expand-file-name file) 'insert-directory))) (if handler (funcall handler 'insert-directory file switches wildcard full-directory-p) (if (eq system-type 'vax-vms) (vms-read-directory file switches (current-buffer)) (if wildcard ;; Run ls in the directory of the file pattern we asked for. (let ((default-directory (if (file-name-absolute-p file) (file-name-directory file) (file-name-directory (expand-file-name file)))) (pattern (file-name-nondirectory file)) (beg 0)) ;; Quote some characters that have special meanings in shells; ;; but don't quote the wildcards--we want them to be special. ;; We also currently don't quote the quoting characters ;; in case people want to use them explicitly to quote ;; wildcard characters. (while (string-match "[ \t\n;<>&|()#$]" pattern beg) (setq pattern (concat (substring pattern 0 (match-beginning 0)) "\\" (substring pattern (match-beginning 0))) beg (1+ (match-end 0)))) (call-process shell-file-name nil t nil "-c" (concat "\\" ;; Disregard shell aliases! insert-directory-program " -d " (if (stringp switches) switches (mapconcat 'identity switches " ")) " " pattern))) ;; SunOS 4.1.3, SVr4 and others need the "." to list the ;; directory if FILE is a symbolic link. (apply 'call-process insert-directory-program nil t nil (let (list) (if (listp switches) (setq list switches) (if (not (equal switches "")) (progn ;; Split the switches at any spaces ;; so we can pass separate options as separate args. (while (string-match " " switches) (setq list (cons (substring switches 0 (match-beginning 0)) list) switches (substring switches (match-end 0)))) (setq list (cons switches list))))) (append list (list (if full-directory-p (concat (file-name-as-directory file) ".") file)))))))))) (defvar kill-emacs-query-functions nil "Functions to call with no arguments to query about killing Emacs. If any of these functions returns nil, killing Emacs is cancelled. `save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions, but `kill-emacs', the low level primitive, does not. See also `kill-emacs-hook'.") (defun save-buffers-kill-emacs (&optional arg) "Offer to save each buffer, then kill this Emacs process. With prefix arg, silently save all file-visiting buffers, then kill." (interactive "P") (save-some-buffers arg t) (and (or (not (memq t (mapcar (function (lambda (buf) (and (buffer-file-name buf) (buffer-modified-p buf)))) (buffer-list)))) (yes-or-no-p "Modified buffers exist; exit anyway? ")) (or (not (fboundp 'process-list)) ;; process-list is not defined on VMS. (let ((processes (process-list)) active) (while processes (and (memq (process-status (car processes)) '(run stop open)) (let ((val (process-kill-without-query (car processes)))) (process-kill-without-query (car processes) val) val) (setq active t)) (setq processes (cdr processes))) (or (not active) (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))) ;; Query the user for other things, perhaps. (run-hook-with-args-until-failure 'kill-emacs-query-functions) (kill-emacs))) (define-key ctl-x-map "\C-f" 'find-file) (define-key ctl-x-map "\C-q" 'toggle-read-only) (define-key ctl-x-map "\C-r" 'find-file-read-only) (define-key ctl-x-map "\C-v" 'find-alternate-file) (define-key ctl-x-map "\C-s" 'save-buffer) (define-key ctl-x-map "s" 'save-some-buffers) (define-key ctl-x-map "\C-w" 'write-file) (define-key ctl-x-map "i" 'insert-file) (define-key esc-map "~" 'not-modified) (define-key ctl-x-map "\C-d" 'list-directory) (define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs) (define-key ctl-x-4-map "f" 'find-file-other-window) (define-key ctl-x-4-map "r" 'find-file-read-only-other-window) (define-key ctl-x-4-map "\C-f" 'find-file-other-window) (define-key ctl-x-4-map "b" 'switch-to-buffer-other-window) (define-key ctl-x-4-map "\C-o" 'display-buffer) (define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame) (define-key ctl-x-5-map "f" 'find-file-other-frame) (define-key ctl-x-5-map "\C-f" 'find-file-other-frame) (define-key ctl-x-5-map "r" 'find-file-read-only-other-frame) ;;; files.el ends here emacs-19.30/lisp/fill.el100444 12120 1 76210 6053406375 13355 0ustar rmsdaemon;;; fill.el --- fill commands for Emacs ;; Copyright (C) 1985, 1986, 1992, 1994, 1995 Free Software Foundation, Inc. ;; Keywords: wp ;; 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: ;; All the commands for filling text. These are documented in the Emacs ;; manual. ;;; Code: (defconst fill-individual-varying-indent nil "*Controls criterion for a new paragraph in `fill-individual-paragraphs'. Non-nil means changing indent doesn't end a paragraph. That mode can handle paragraphs with extra indentation on the first line, but it requires separator lines between paragraphs. A value of nil means that any change in indentation starts a new paragraph.") (defconst sentence-end-double-space t "*Non-nil means a single space does not end a sentence.") (defconst colon-double-space nil "*Non-nil means put two spaces after a colon when filling.") (defvar fill-paragraph-function nil "Mode-specific function to fill a paragraph.") (defun set-fill-prefix () "Set the fill prefix to the current line up to point. Filling expects lines to start with the fill prefix and reinserts the fill prefix in each resulting line." (interactive) (setq fill-prefix (buffer-substring (save-excursion (move-to-left-margin) (point)) (point))) (if (equal fill-prefix "") (setq fill-prefix nil)) (if fill-prefix (message "fill-prefix: \"%s\"" fill-prefix) (message "fill-prefix cancelled"))) (defconst adaptive-fill-mode t "*Non-nil means determine a paragraph's fill prefix from its text.") (defconst adaptive-fill-regexp "[ \t]*\\([#;>*]+ +\\)?" "*Regexp to match text at start of line that constitutes indentation. If Adaptive Fill mode is enabled, whatever text matches this pattern on the second line of a paragraph is used as the standard indentation for the paragraph. If the paragraph has just one line, the indentation is taken from that line.") (defvar adaptive-fill-function nil "*Function to call to choose a fill prefix for a paragraph. This function is used when `adaptive-fill-regexp' does not match.") (defun current-fill-column () "Return the fill-column to use for this line. The fill-column to use for a buffer is stored in the variable `fill-column', but can be locally modified by the `right-margin' text property, which is subtracted from `fill-column'. The fill column to use for a line is the first column at which the column number equals or exceeds the local fill-column - right-margin difference." (save-excursion (if fill-column (let* ((here (progn (beginning-of-line) (point))) (here-col 0) (eol (progn (end-of-line) (point))) margin fill-col change col) ;; Look separately at each region of line with a different right-margin. (while (and (setq margin (get-text-property here 'right-margin) fill-col (- fill-column (or margin 0)) change (text-property-not-all here eol 'right-margin margin)) (progn (goto-char (1- change)) (setq col (current-column)) (< col fill-col))) (setq here change here-col col)) (max here-col fill-col))))) (defun canonically-space-region (beg end) "Remove extra spaces between words in region. Puts one space between words in region; two between sentences. Remove indentation from each line." (interactive "r") (save-excursion (goto-char beg) ;; Nuke tabs; they get screwed up in a fill. ;; This is quick, but loses when a tab follows the end of a sentence. ;; Actually, it is difficult to tell that from "Mr.\tSmith". ;; Blame the typist. (subst-char-in-region beg end ?\t ?\ ) (while (and (< (point) end) (re-search-forward " *" end t)) (delete-region (+ (match-beginning 0) ;; Determine number of spaces to leave: (save-excursion (skip-chars-backward " ]})\"'") (cond ((and sentence-end-double-space (memq (preceding-char) '(?. ?? ?!))) 2) ((and colon-double-space (= (preceding-char) ?:)) 2) ((char-equal (preceding-char) ?\n) 0) (t 1)))) (match-end 0))) ;; Make sure sentences ending at end of line get an extra space. ;; loses on split abbrevs ("Mr.\nSmith") (goto-char beg) (while (and (< (point) end) (re-search-forward "[.?!][])}\"']*$" end t)) (insert-and-inherit ? )))) (defun fill-context-prefix (from to &optional first-line-regexp) "Compute a fill prefix from the text between FROM and TO. This uses the variables `adapive-fill-prefix' and `adaptive-fill-function'. If FIRST-LINE-REGEXP is non-nil, then when taking a prefix from the first line, insist it must match FIRST-LINE-REGEXP." (save-excursion (goto-char from) (if (eolp) (forward-line 1)) ;; Move to the second line unless there is just one. (let ((firstline (point)) ;; Non-nil if we are on the second line. at-second result) (forward-line 1) (if (>= (point) to) (goto-char firstline) (setq at-second t)) (move-to-left-margin) (let ((start (point)) (eol (save-excursion (end-of-line) (point)))) (setq result (if (not (looking-at paragraph-start)) (cond ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp)) (buffer-substring-no-properties start (match-end 0))) (adaptive-fill-function (funcall adaptive-fill-function))))) (and result (or at-second (null first-line-regexp) (string-match first-line-regexp result)) result))))) (defun fill-region-as-paragraph (from to &optional justify nosqueeze) "Fill the region as one paragraph. It removes any paragraph breaks in the region and extra newlines at the end, indents and fills lines between the margins given by the `current-left-margin' and `current-fill-column' functions. It leaves point at the beginning of the line following the paragraph. Normally performs justification according to the `current-justification' function, but with a prefix arg, does full justification instead. From a program, optional third arg JUSTIFY can specify any type of justification, and fourth arg NOSQUEEZE non-nil means not to make spaces between words canonical before filling. If `sentence-end-double-space' is non-nil, then period followed by one space does not end a sentence, so don't break a line there." (interactive (list (region-beginning) (region-end) (if current-prefix-arg 'full))) ;; Arrange for undoing the fill to restore point. (if (and buffer-undo-list (not (eq buffer-undo-list t))) (setq buffer-undo-list (cons (point) buffer-undo-list))) ;; Make sure "to" is the endpoint. (goto-char (min from to)) (setq to (max from to)) ;; Ignore blank lines at beginning of region. (skip-chars-forward " \t\n") (let ((from-plus-indent (point)) (oneleft nil)) (beginning-of-line) (setq from (point)) ;; Delete all but one soft newline at end of region. (goto-char to) (while (and (> (point) from) (eq ?\n (char-after (1- (point))))) (if (and oneleft (not (and use-hard-newlines (get-text-property (1- (point)) 'hard)))) (delete-backward-char 1) (backward-char 1) (setq oneleft t))) (setq to (point)) ;; If there was no newline, and there is text in the paragraph, then ;; create a newline. (if (and (not oneleft) (> to from-plus-indent)) (newline)) (goto-char from-plus-indent)) (if (not (> to (point))) nil ; There is no paragraph, only whitespace: exit now. (or justify (setq justify (current-justification))) ;; Don't let Adaptive Fill mode alter the fill prefix permanently. (let ((fill-prefix fill-prefix)) ;; Figure out how this paragraph is indented, if desired. (if (and adaptive-fill-mode (or (null fill-prefix) (string= fill-prefix ""))) (setq fill-prefix (fill-context-prefix from to))) (save-restriction (goto-char from) (beginning-of-line) (narrow-to-region (point) to) (if (not justify) ; filling disabled: just check indentation (progn (goto-char from) (while (not (eobp)) (if (and (not (eolp)) (< (current-indentation) (current-left-margin))) (indent-to-left-margin)) (forward-line 1))) (if use-hard-newlines (remove-text-properties from (point-max) '(hard nil))) ;; Make sure first line is indented (at least) to left margin... (if (or (memq justify '(right center)) (< (current-indentation) (current-left-margin))) (indent-to-left-margin)) ;; Delete the fill prefix from every line except the first. ;; The first line may not even have a fill prefix. (goto-char from) (let ((fpre (and fill-prefix (not (equal fill-prefix "")) (concat "[ \t]*" (regexp-quote fill-prefix) "[ \t]*")))) (and fpre (progn (if (>= (+ (current-left-margin) (length fill-prefix)) (current-fill-column)) (error "fill-prefix too long for specified width")) (goto-char from) (forward-line 1) (while (not (eobp)) (if (looking-at fpre) (delete-region (point) (match-end 0))) (forward-line 1)) (goto-char from) (and (looking-at fpre) (goto-char (match-end 0))) (setq from (point))))) ;; Remove indentation from lines other than the first. (beginning-of-line 2) (indent-region (point) (point-max) 0) (goto-char from) ;; FROM, and point, are now before the text to fill, ;; but after any fill prefix on the first line. ;; Make sure sentences ending at end of line get an extra space. ;; loses on split abbrevs ("Mr.\nSmith") (while (re-search-forward "[.?!][])}\"']*$" nil t) (or (eobp) (insert-and-inherit ?\ ))) (goto-char from) (skip-chars-forward " \t") ;; Then change all newlines to spaces. (subst-char-in-region from (point-max) ?\n ?\ ) (if (and nosqueeze (not (eq justify 'full))) nil (canonically-space-region (point) (point-max)) (goto-char (point-max)) (delete-horizontal-space) (insert-and-inherit " ")) (goto-char (point-min)) ;; This is the actual filling loop. (let ((prefixcol 0) linebeg) (while (not (eobp)) (setq linebeg (point)) (move-to-column (1+ (current-fill-column))) (if (eobp) (or nosqueeze (delete-horizontal-space)) ;; Move back to start of word. (skip-chars-backward "^ \n" linebeg) ;; Don't break after a period followed by just one space. ;; Move back to the previous place to break. ;; The reason is that if a period ends up at the end of a line, ;; further fills will assume it ends a sentence. ;; If we now know it does not end a sentence, ;; avoid putting it at the end of the line. (if sentence-end-double-space (while (and (> (point) (+ linebeg 2)) (eq (preceding-char) ?\ ) (not (eq (following-char) ?\ )) (eq (char-after (- (point) 2)) ?\.)) (forward-char -2) (skip-chars-backward "^ \n" linebeg))) ;; If the left margin and fill prefix by themselves ;; pass the fill-column, keep at least one word. ;; This handles ALL BUT the first line of the paragraph. (if (if (zerop prefixcol) (save-excursion (skip-chars-backward " \t" linebeg) (bolp)) (>= prefixcol (current-column))) ;; Ok, skip at least one word. ;; Meanwhile, don't stop at a period followed by one space. (let ((first t)) (move-to-column prefixcol) (while (and (not (eobp)) (or first (and (not (bobp)) sentence-end-double-space (save-excursion (forward-char -1) (and (looking-at "\\. ") (not (looking-at "\\. "))))))) (skip-chars-forward " \t") (skip-chars-forward "^ \n\t") (setq first nil))) ;; Normally, move back over the single space between the words. (forward-char -1)) ;; If the left margin and fill prefix by themselves ;; pass the fill-column, keep at least one word. ;; This handles the first line of the paragraph. (if (and (zerop prefixcol) (let ((fill-point (point)) nchars) (save-excursion (move-to-left-margin) (setq nchars (- fill-point (point))) (or (< nchars 0) (and fill-prefix (< nchars (length fill-prefix)) (string= (buffer-substring (point) fill-point) (substring fill-prefix 0 nchars))))))) ;; Ok, skip at least one word. But ;; don't stop at a period followed by just one space. (let ((first t)) (while (and (not (eobp)) (or first (and (not (bobp)) sentence-end-double-space (save-excursion (forward-char -1) (and (looking-at "\\. ") (not (looking-at "\\. "))))))) (skip-chars-forward " \t") (skip-chars-forward "^ \t\n") (setq first nil)))) ;; Replace whitespace here with one newline, then indent to left ;; margin. (skip-chars-backward " \t") (insert ?\n) ;; Give newline the properties of the space(s) it replaces (set-text-properties (1- (point)) (point) (text-properties-at (point))) (indent-to-left-margin) ;; Insert the fill prefix after indentation. ;; Set prefixcol so whitespace in the prefix won't get lost. (and fill-prefix (not (equal fill-prefix "")) (progn (insert-and-inherit fill-prefix) (setq prefixcol (current-column))))) ;; Justify the line just ended, if desired. (if justify (if (eobp) (justify-current-line justify t t) (forward-line -1) (justify-current-line justify nil t) (forward-line 1)))))) ;; Leave point after final newline. (goto-char (point-max))) (forward-char 1)))) (defun fill-paragraph (arg) "Fill paragraph at or after point. Prefix arg means justify as well. If `sentence-end-double-space' is non-nil, then period followed by one space does not end a sentence, so don't break a line there. If `fill-paragraph-function' is non-nil, we call it (passing our argument to it), and if it returns non-nil, we simply return its value." (interactive (list (if current-prefix-arg 'full))) (or (and fill-paragraph-function (let ((function fill-paragraph-function) fill-paragraph-function) (funcall function arg))) (let ((before (point))) (save-excursion (forward-paragraph) (or (bolp) (newline 1)) (let ((end (point)) (beg (progn (backward-paragraph) (point)))) (goto-char before) (if use-hard-newlines ;; Can't use fill-region-as-paragraph, since this paragraph may ;; still contain hard newlines. See fill-region. (fill-region beg end arg) (fill-region-as-paragraph beg end arg))))))) (defun fill-region (from to &optional justify nosqueeze to-eop) "Fill each of the paragraphs in the region. Prefix arg (non-nil third arg, if called from program) means justify as well. Noninteractively, fourth arg NOSQUEEZE non-nil means to leave whitespace other than line breaks untouched, and fifth arg TO-EOP non-nil means to keep filling to the end of the paragraph (or next hard newline, if `use-hard-newlines' is on). If `sentence-end-double-space' is non-nil, then period followed by one space does not end a sentence, so don't break a line there." (interactive (list (region-beginning) (region-end) (if current-prefix-arg 'full))) (let (end beg) (save-restriction (goto-char (max from to)) (if to-eop (progn (skip-chars-backward "\n") (forward-paragraph))) (setq end (point)) (goto-char (setq beg (min from to))) (beginning-of-line) (narrow-to-region (point) end) (while (not (eobp)) (let ((initial (point)) end) ;; If using hard newlines, break at every one for filling ;; purposes rather than using paragraph breaks. (if use-hard-newlines (progn (while (and (setq end (text-property-any (point) (point-max) 'hard t)) (not (= ?\n (char-after end))) (not (= end (point-max)))) (goto-char (1+ end))) (setq end (if end (min (point-max) (1+ end)) (point-max))) (goto-char initial)) (forward-paragraph 1) (setq end (point)) (forward-paragraph -1)) (if (< (point) beg) (goto-char beg)) (if (>= (point) initial) (fill-region-as-paragraph (point) end justify nosqueeze) (goto-char end))))))) (defconst default-justification 'left "*Method of justifying text not otherwise specified. Possible values are `left', `right', `full', `center', or `none'. The requested kind of justification is done whenever lines are filled. The `justification' text-property can locally override this variable. This variable automatically becomes buffer-local when set in any fashion.") (make-variable-buffer-local 'default-justification) (defun current-justification () "How should we justify this line? This returns the value of the text-property `justification', or the variable `default-justification' if there is no text-property. However, it returns nil rather than `none' to mean \"don't justify\"." (let ((j (or (get-text-property ;; Make sure we're looking at paragraph body. (save-excursion (skip-chars-forward " \t") (if (and (eobp) (not (bobp))) (1- (point)) (point))) 'justification) default-justification))) (if (eq 'none j) nil j))) (defun set-justification (begin end value &optional whole-par) "Set the region's justification style. The kind of justification to use is prompted for. If the mark is not active, this command operates on the current paragraph. If the mark is active, the region is used. However, if the beginning and end of the region are not at paragraph breaks, they are moved to the beginning and end of the paragraphs they are in. If `use-hard-newlines' is true, all hard newlines are taken to be paragraph breaks. When calling from a program, operates just on region between BEGIN and END, unless optional fourth arg WHOLE-PAR is non-nil. In that case bounds are extended to include entire paragraphs as in the interactive command." (interactive (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)) (let ((s (completing-read "Set justification to: " '(("left") ("right") ("full") ("center") ("none")) nil t))) (if (equal s "") (error "")) (intern s)) t)) (save-excursion (save-restriction (if whole-par (let ((paragraph-start (if use-hard-newlines "." paragraph-start)) (paragraph-ignore-fill-prefix (if use-hard-newlines t paragraph-ignore-fill-prefix))) (goto-char begin) (while (and (bolp) (not (eobp))) (forward-char 1)) (backward-paragraph) (setq begin (point)) (goto-char end) (skip-chars-backward " \t\n" begin) (forward-paragraph) (setq end (point)))) (narrow-to-region (point-min) end) (unjustify-region begin (point-max)) (put-text-property begin (point-max) 'justification value) (fill-region begin (point-max) nil t)))) (defun set-justification-none (b e) "Disable automatic filling for paragraphs in the region. If the mark is not active, this applies to the current paragraph." (interactive (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))) (set-justification b e 'none t)) (defun set-justification-left (b e) "Make paragraphs in the region left-justified. This is usually the default, but see the variable `default-justification'. If the mark is not active, this applies to the current paragraph." (interactive (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))) (set-justification b e 'left t)) (defun set-justification-right (b e) "Make paragraphs in the region right-justified: Flush at the right margin and ragged on the left. If the mark is not active, this applies to the current paragraph." (interactive (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))) (set-justification b e 'right t)) (defun set-justification-full (b e) "Make paragraphs in the region fully justified: This makes lines flush on both margins by inserting spaces between words. If the mark is not active, this applies to the current paragraph." (interactive (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))) (set-justification b e 'full t)) (defun set-justification-center (b e) "Make paragraphs in the region centered. If the mark is not active, this applies to the current paragraph." (interactive (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))) (set-justification b e 'center t)) ;; A line has up to six parts: ;; ;; >>> hello. ;; [Indent-1][FP][ Indent-2 ][text][trailing whitespace][newline] ;; ;; "Indent-1" is the left-margin indentation; normally it ends at column ;; given by the `current-left-margin' function. ;; "FP" is the fill-prefix. It can be any string, including whitespace. ;; "Indent-2" is added to justify a line if the `current-justification' is ;; `center' or `right'. In `left' and `full' justification regions, any ;; whitespace there is part of the line's text, and should not be changed. ;; Trailing whitespace is not counted as part of the line length when ;; center- or right-justifying. ;; ;; All parts of the line are optional, although the final newline can ;; only be missing on the last line of the buffer. (defun justify-current-line (&optional how eop nosqueeze) "Do some kind of justification on this line. Normally does full justification: adds spaces to the line to make it end at the column given by `current-fill-column'. Optional first argument HOW specifies alternate type of justification: it can be `left', `right', `full', `center', or `none'. If HOW is t, will justify however the `current-justification' function says to. If HOW is nil or missing, full justification is done by default. Second arg EOP non-nil means that this is the last line of the paragraph, so it will not be stretched by full justification. Third arg NOSQUEEZE non-nil means to leave interior whitespace unchanged, otherwise it is made canonical." (interactive) (if (eq t how) (setq how (or (current-justification) 'none)) (if (null how) (setq how 'full) (or (memq how '(none left right center)) (setq how 'full)))) (or (memq how '(none left)) ; No action required for these. (let ((fc (current-fill-column)) (pos (point-marker)) fp-end ; point at end of fill prefix beg ; point at beginning of line's text end ; point at end of line's text indent ; column of `beg' endcol ; column of `end' ncols) ; new indent point or offset (end-of-line) ;; Check if this is the last line of the paragraph. (if (and use-hard-newlines (null eop) (get-text-property (point) 'hard)) (setq eop t)) (skip-chars-backward " \t") ;; Quick exit if it appears to be properly justified already ;; or there is no text. (if (or (bolp) (and (memq how '(full right)) (= (current-column) fc))) nil (setq end (point)) (beginning-of-line) (skip-chars-forward " \t") ;; Skip over fill-prefix. (if (and fill-prefix (not (string-equal fill-prefix "")) (equal fill-prefix (buffer-substring (point) (min (point-max) (+ (length fill-prefix) (point)))))) (forward-char (length fill-prefix)) (if (and adaptive-fill-mode (looking-at adaptive-fill-regexp)) (goto-char (match-end 0)))) (setq fp-end (point)) (skip-chars-forward " \t") ;; This is beginning of the line's text. (setq indent (current-column)) (setq beg (point)) (goto-char end) (setq endcol (current-column)) ;; HOW can't be null or left--we would have exited already (cond ((eq 'right how) (setq ncols (- fc endcol)) (if (< ncols 0) ;; Need to remove some indentation (delete-region (progn (goto-char fp-end) (if (< (current-column) (+ indent ncols)) (move-to-column (+ indent ncols) t)) (point)) (progn (move-to-column indent) (point))) ;; Need to add some (goto-char beg) (indent-to (+ indent ncols)) ;; If point was at beginning of text, keep it there. (if (= beg pos) (move-marker pos (point))))) ((eq 'center how) ;; Figure out how much indentation is needed (setq ncols (+ (current-left-margin) (/ (- fc (current-left-margin) ;avail. space (- endcol indent)) ;text width 2))) (if (< ncols indent) ;; Have too much indentation - remove some (delete-region (progn (goto-char fp-end) (if (< (current-column) ncols) (move-to-column ncols t)) (point)) (progn (move-to-column indent) (point))) ;; Have too little - add some (goto-char beg) (indent-to ncols) ;; If point was at beginning of text, keep it there. (if (= beg pos) (move-marker pos (point))))) ((eq 'full how) ;; Insert extra spaces between words to justify line (save-restriction (narrow-to-region beg end) (or nosqueeze (canonically-space-region beg end)) (goto-char (point-max)) (setq ncols (- fc endcol)) ;; Ncols is number of additional spaces needed (if (> ncols 0) (if (and (not eop) (search-backward " " nil t)) (while (> ncols 0) (let ((nmove (+ 3 (random 3)))) (while (> nmove 0) (or (search-backward " " nil t) (progn (goto-char (point-max)) (search-backward " "))) (skip-chars-backward " ") (setq nmove (1- nmove)))) (insert-and-inherit " ") (skip-chars-backward " ") (setq ncols (1- ncols))))))) (t (error "Unknown justification value")))) (goto-char pos) (move-marker pos nil))) nil) (defun unjustify-current-line () "Remove justification whitespace from current line. If the line is centered or right-justified, this function removes any indentation past the left margin. If the line is full-jusitified, it removes extra spaces between words. It does nothing in other justification modes." (let ((justify (current-justification))) (cond ((eq 'left justify) nil) ((eq nil justify) nil) ((eq 'full justify) ; full justify: remove extra spaces (beginning-of-line-text) (canonically-space-region (point) (save-excursion (end-of-line) (point)))) ((memq justify '(center right)) (save-excursion (move-to-left-margin nil t) ;; Position ourselves after any fill-prefix. (if (and fill-prefix (not (string-equal fill-prefix "")) (equal fill-prefix (buffer-substring (point) (min (point-max) (+ (length fill-prefix) (point)))))) (forward-char (length fill-prefix))) (delete-region (point) (progn (skip-chars-forward " \t") (point)))))))) (defun unjustify-region (&optional begin end) "Remove justification whitespace from region. For centered or right-justified regions, this function removes any indentation past the left margin from each line. For full-jusitified lines, it removes extra spaces between words. It does nothing in other justification modes. Arguments BEGIN and END are optional; default is the whole buffer." (save-excursion (save-restriction (if end (narrow-to-region (point-min) end)) (goto-char (or begin (point-min))) (while (not (eobp)) (unjustify-current-line) (forward-line 1))))) (defun fill-nonuniform-paragraphs (min max &optional justifyp mailp) "Fill paragraphs within the region, allowing varying indentation within each. This command divides the region into \"paragraphs\", only at paragraph-separator lines, then fills each paragraph using as the fill prefix the smallest indentation of any line in the paragraph. When calling from a program, pass range to fill as first two arguments. Optional third and fourth arguments JUSTIFY and MAIL-FLAG: JUSTIFY to justify paragraphs (prefix arg), MAIL-FLAG for a mail message, i. e. don't fill header lines." (interactive (list (region-beginning) (region-end) (if current-prefix-arg 'full))) (let ((fill-individual-varying-indent t)) (fill-individual-paragraphs min max justifyp mailp))) (defun fill-individual-paragraphs (min max &optional justify mailp) "Fill paragraphs of uniform indentation within the region. This command divides the region into \"paragraphs\", treating every change in indentation level as a paragraph boundary, then fills each paragraph using its indentation level as the fill prefix. When calling from a program, pass range to fill as first two arguments. Optional third and fourth arguments JUSTIFY and MAIL-FLAG: JUSTIFY to justify paragraphs (prefix arg), MAIL-FLAG for a mail message, i. e. don't fill header lines." (interactive (list (region-beginning) (region-end) (if current-prefix-arg 'full))) (save-restriction (save-excursion (goto-char min) (beginning-of-line) (narrow-to-region (point) max) (if mailp (while (and (not (eobp)) (or (looking-at "[ \t]*[^ \t\n]+:") (looking-at "[ \t]*$"))) (if (looking-at "[ \t]*[^ \t\n]+:") (search-forward "\n\n" nil 'move) (forward-line 1)))) (narrow-to-region (point) max) ;; Loop over paragraphs. (while (progn (skip-chars-forward " \t\n") (not (eobp))) (move-to-left-margin) (let ((start (point)) fill-prefix fill-prefix-regexp) ;; Find end of paragraph, and compute the smallest fill-prefix ;; that fits all the lines in this paragraph. (while (progn ;; Update the fill-prefix on the first line ;; and whenever the prefix good so far is too long. (if (not (and fill-prefix (looking-at fill-prefix-regexp))) (setq fill-prefix (if (and adaptive-fill-mode adaptive-fill-regexp (looking-at adaptive-fill-regexp)) (match-string 0) (buffer-substring (point) (save-excursion (skip-chars-forward " \t") (point)))) fill-prefix-regexp (regexp-quote fill-prefix))) (forward-line 1) (move-to-left-margin) ;; Now stop the loop if end of paragraph. (and (not (eobp)) (if fill-individual-varying-indent ;; If this line is a separator line, with or ;; without prefix, end the paragraph. (and (not (looking-at paragraph-separate)) (save-excursion (not (and (looking-at fill-prefix-regexp) (progn (forward-char (length fill-prefix)) (looking-at paragraph-separate)))))) ;; If this line has more or less indent ;; than the fill prefix wants, end the paragraph. (and (looking-at fill-prefix-regexp) (save-excursion (not (progn (forward-char (length fill-prefix)) (or (looking-at paragraph-separate) (looking-at paragraph-start)))))))))) ;; Fill this paragraph, but don't add a newline at the end. (let ((had-newline (bolp))) (fill-region-as-paragraph start (point) justify) (or had-newline (delete-char -1)))))))) ;;; fill.el ends here emacs-19.30/lisp/find-dired.el100444 12120 1 16717 5775110112 14431 0ustar rmsdaemon;;; find-dired.el --- run a `find' command and dired the output ;;; Copyright (C) 1992, 1994, 1995 Free Software Foundation, Inc. ;; Author: Roland McGrath , ;; Sebastian Kremer ;; Keywords: unix ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2, or (at your option) ;;; any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; A copy of the GNU General Public License can be obtained from this ;;; program's author (send electronic mail to roland@ai.mit.edu) or from ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA ;;; 02139, USA. ;;; ;;; Code: (require 'dired) ;; find's -ls corresponds to these switches. ;; Note -b, at least GNU find quotes spaces etc. in filenames ;;;###autoload (defvar find-ls-option (if (eq system-type 'berkeley-unix) '("-ls" . "-gilsb") '("-exec ls -ld {} \\;" . "-ld")) "*Description of the option to `find' to produce an `ls -l'-type listing. This is a cons of two strings (FIND-OPTION . LS-SWITCHES). FIND-OPTION gives the option (or options) to `find' that produce the desired output. LS-SWITCHES is a list of `ls' switches to tell dired how to parse the output.") ;;;###autoload (defvar find-grep-options (if (eq system-type 'berkeley-unix) "-s" "-q") "*Option to grep to be as silent as possible. On Berkeley systems, this is `-s'; on Posix, and with GNU grep, `-q' does it. On other systems, the closest you can come is to use `-l'.") (defvar find-args nil "Last arguments given to `find' by \\[find-dired].") ;; History of find-args values entered in the minibuffer. (defvar find-args-history nil) ;;;###autoload (defun find-dired (dir args) "Run `find' and go into dired-mode on a buffer of the output. The command run (after changing into DIR) is find . \\( ARGS \\) -ls" (interactive (list (read-file-name "Run find in directory: " nil "" t) (read-string "Run find (with args): " find-args '(find-args-history . 1)))) ;; Expand DIR ("" means default-directory), and make sure it has a ;; trailing slash. (setq dir (file-name-as-directory (expand-file-name dir))) ;; Check that it's really a directory. (or (file-directory-p dir) (error "find-dired needs a directory: %s" dir)) (switch-to-buffer (get-buffer-create "*Find*")) (widen) (kill-all-local-variables) (setq buffer-read-only nil) (erase-buffer) (setq default-directory dir find-args args ; save for next interactive call args (concat "find . " (if (string= args "") "" (concat "\\( " args " \\) ")) (car find-ls-option))) ;; The next statement will bomb in classic dired (no optional arg allowed) (dired-mode dir (cdr find-ls-option)) ;; This really should rerun the find command, but I don't ;; have time for that. (use-local-map (append (make-sparse-keymap) (current-local-map))) (define-key (current-local-map) "g" 'undefined) ;; Set subdir-alist so that Tree Dired will work: (if (fboundp 'dired-simple-subdir-alist) ;; will work even with nested dired format (dired-nstd.el,v 1.15 ;; and later) (dired-simple-subdir-alist) ;; else we have an ancient tree dired (or classic dired, where ;; this does no harm) (set (make-local-variable 'dired-subdir-alist) (list (cons default-directory (point-min-marker))))) (setq buffer-read-only nil) ;; Subdir headlerline must come first because the first marker in ;; subdir-alist points there. (insert " " dir ":\n") ;; Make second line a ``find'' line in analogy to the ``total'' or ;; ``wildcard'' line. (insert " " args "\n") ;; Start the find process. (let ((proc (start-process-shell-command "find" (current-buffer) args))) (set-process-filter proc (function find-dired-filter)) (set-process-sentinel proc (function find-dired-sentinel)) ;; Initialize the process marker; it is used by the filter. (move-marker (process-mark proc) 1 (current-buffer))) (setq mode-line-process '(":%s"))) ;;;###autoload (defun find-name-dired (dir pattern) "Search DIR recursively for files matching the globbing pattern PATTERN, and run dired on those files. PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted. The command run (after changing into DIR) is find . -name 'PATTERN' -ls" (interactive "DFind-name (directory): \nsFind-name (filename wildcard): ") (find-dired dir (concat "-name '" pattern "'"))) ;; This functionality suggested by ;; From: oblanc@watcgl.waterloo.edu (Olivier Blanc) ;; Subject: find-dired, lookfor-dired ;; Date: 10 May 91 17:50:00 GMT ;; Organization: University of Waterloo (defalias 'lookfor-dired 'find-grep-dired) ;;;###autoload (defun find-grep-dired (dir args) "Find files in DIR containing a regexp ARG and start Dired on output. The command run (after changing into DIR) is find . -exec grep -s ARG {} \\\; -ls Thus ARG can also contain additional grep options." (interactive "DFind-grep (directory): \nsFind-grep (grep regexp): ") ;; find -exec doesn't allow shell i/o redirections in the command, ;; or we could use `grep -l >/dev/null' (find-dired dir (concat "! -type d -exec grep " find-grep-options " " args " {} \\\; "))) (defun find-dired-filter (proc string) ;; Filter for \\[find-dired] processes. (let ((buf (process-buffer proc))) (if (buffer-name buf) ; not killed? (save-excursion (set-buffer buf) (save-restriction (widen) (save-excursion (let ((buffer-read-only nil) (end (point-max))) (goto-char end) (insert string) (goto-char end) (or (looking-at "^") (forward-line 1)) (while (looking-at "^") (insert " ") (forward-line 1)) ;; Convert ` ./FILE' to ` FILE' ;; This would lose if the current chunk of output ;; starts or ends within the ` ./', so back up a bit: (goto-char (- end 3)) ; no error if < 0 (while (search-forward " ./" nil t) (delete-region (point) (- (point) 2))) ;; Find all the complete lines in the unprocessed ;; output and process it to add text properties. (goto-char end) (if (search-backward "\n" (process-mark proc) t) (progn (dired-insert-set-properties (process-mark proc) (1+ (point))) (move-marker (process-mark proc) (1+ (point))))) )))) ;; The buffer has been killed. (delete-process proc)))) (defun find-dired-sentinel (proc state) ;; Sentinel for \\[find-dired] processes. (let ((buf (process-buffer proc))) (if (buffer-name buf) (save-excursion (set-buffer buf) (let ((buffer-read-only nil)) (save-excursion (goto-char (point-max)) (insert "\nfind " state) (forward-char -1) ;Back up before \n at end of STATE. (insert " at " (substring (current-time-string) 0 19)) (forward-char 1) (setq mode-line-process (concat ":" (symbol-name (process-status proc)))) ;; Since the buffer and mode line will show that the ;; process is dead, we can delete it now. Otherwise it ;; will stay around until M-x list-processes. (delete-process proc) (force-mode-line-update))) (message "find-dired %s finished." (current-buffer)))))) (provide 'find-dired) ;;; find-dired.el ends here emacs-19.30/lisp/find-file.el100444 12120 1 101603 6017703563 14276 0ustar rmsdaemon;;; find-file.el --- find a file corresponding to this one given a pattern ;; Author: Henry Guillaume ;; Keywords: c, matching, tools ;; Copyright (C) 1994, 1995 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: ;; PURPOSE: ;; This package features a function called ff-find-other-file, which performs ;; the following function: ;; ;; When in a .c file, find the first corresponding .h file in a set ;; of directories and display it, and vice-versa from the .h file. ;; ;; Many people maintain their include file in a directory separate to their ;; src directory, and very often you may be editing a file and have a need to ;; visit the "other file". This package searches through a set of directories ;; to find that file. ;; ;; THE "OTHER FILE", or "corresponding file", generally has the same basename, ;; and just has a different extension as described by the ff-other-file-alist ;; variable: ;; ;; '(("\\.cc$" (".hh" ".h")) ;; ("\\.hh$" (".cc" ".C" ".CC" ".cxx" ".cpp"))) ;; ;; If the current file has a .cc extension, ff-find-other-file will attempt ;; to look for a .hh file, and then a .h file in some directory as described ;; below. The mechanism here is to replace the matched part of the original ;; filename with each of the corresponding extensions in turn. ;; ;; Alternatively, there are situations where the filename of the other file ;; cannot be determined easily with regexps. For example, a .c file may ;; have two corresponding .h files, for its public and private parts, or ;; the filename for the .c file contains part of the pathname of the .h ;; file, as between src/fooZap.cc and include/FOO/zap.hh. In that case, the ;; format above can be changed to include a function to be called when the ;; current file matches the regexp: ;; ;; '(("\\.cc$" cc-function) ;; ("\\.hh$" hh-function)) ;; ;; These functions must return a list consisting of the possible names of the ;; corresponding file, with or without path. There is no real need for more ;; than one function, and one could imagine the following value for cc-other- ;; file-alist: ;; ;; (setq cc-other-file-alist ;; '(("\\.cc$" ff-cc-hh-converter) ;; ("\\.hh$" ff-cc-hh-converter) ;; ("\\.c$" (".h")) ;; ("\\.h$" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp")))) ;; ;; ff-cc-hh-converter is included at the end of this file as a reference. ;; ;; SEARCHING is carried out in a set of directories specified by the ;; ff-search-directories variable: ;; ;; ("." "../../src" "../include/*" "/usr/local/*/src/*" "$PROJECT/src") ;; ;; This means that the corresponding file will be searched for first in ;; the current directory, then in ../../src, then in one of the directories ;; under ../include, and so on. The star is _not_ a general wildcard ;; character: it just indicates that the subdirectories of this directory ;; must each be searched in turn. Environment variables will be expanded in ;; the ff-search-directories variable. ;; ;; If the point is on a #include line, the file to be #included is searched ;; for in the same manner. This can be disabled with the ff-ignore-include ;; variable, or by calling ff-get-other-file instead of ff-find-other-file. ;; ;; If the file was not found, ff-find-other-file will prompt you for where ;; to create the new "corresponding file" (defaults to the current directory), ;; unless the variable ff-always-try-to-create is set to nil. ;; ;; GIVEN AN ARGUMENT (with the ^U prefix), ff-find-other-file will get the ;; other file in another (the other?) window (see find-file-other-window and ;; switch-to-buffer-other-window). This can be set on a more permanent basis ;; by setting ff-always-in-other-window to t in which case the ^U prefix will ;; do the opposite of what was described above. ;; ;; THERE ARE FIVE AVAILABLE HOOKS, called in this order if non-nil: ;; ;; - ff-pre-find-hooks - called before the search for the other file starts ;; - ff-not-found-hooks - called when the other file could not be found ;; - ff-pre-load-hooks - called just before the other file is 'loaded' ;; - ff-file-created-hooks - called when the other file is created ;; - ff-post-load-hooks - called just after the other file is 'loaded' ;; ;; The *load-hooks allow you to place point where you want it in the other ;; file. ;; FEEDBACK: ;; Please send me bug reports, bug fixes, and extensions, so that I can ;; merge them into the master source. ;; CREDITS: ;; Many thanks go to TUSC Computer Systems Pty Ltd for providing an environ- ;; ment that made the development of this package possible. ;; ;; Many thanks also go to all those who provided valuable feedback throughout ;; the development of this package: ;; Rolf Ebert in particular, Fritz Knabe, Heddy Boubaker, Sebastian Kremer, ;; Vasco Lopes Paulo, Mark A. Plaksin, Robert Lang, Trevor West, Kevin ;; Pereira & Benedict Lofstedt. ;; Code: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User definable variables: (defvar ff-pre-find-hooks nil "*List of functions to be called before the search for the file starts.") (defvar ff-pre-load-hooks nil "*List of functions to be called before the other file is loaded.") (defvar ff-post-load-hooks nil "*List of functions to be called after the other file is loaded.") (defvar ff-not-found-hooks nil "*List of functions to be called if the other file could not be found.") (defvar ff-file-created-hooks nil "*List of functions to be called if the other file needs to be created.") (defvar ff-case-fold-search nil "*Non-nil means ignore cases in matches (see `case-fold-search'). If you have extensions in different cases, you will want this to be nil.") (defvar ff-always-in-other-window nil "*If non-nil, find the corresponding file in another window by default. To override this, give an argument to `ff-find-other-file'.") (defvar ff-ignore-include nil "*If non-nil, ignore `#include' lines.") (defvar ff-always-try-to-create t "*If non-nil, always attempt to create the other file if it was not found.") (defvar ff-quiet-mode nil "*If non-nil, trace which directories are being searched.") (defvar ff-special-constructs '( ;; C/C++ include, for NeXTSTEP too ("^\#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]" . (lambda () (setq fname (buffer-substring (match-beginning 2) (match-end 2))))) ;; Ada import ("^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" . (lambda () (setq fname (buffer-substring (match-beginning 1) (match-end 1))) (require 'ada-mode) (setq fname (concat (ada-make-filename-from-adaname fname) ada-spec-suffix)))) ) "*A list of regular expressions specifying how to recognise special constructs such as include files etc, and an associated method for extracting the filename from that construct.") (defvar ff-other-file-alist 'cc-other-file-alist "*Alist of extensions to find given the current file's extension. This list should contain the most used extensions before the others, since the search algorithm searches sequentially through each directory specified in `ff-search-directories'. If a file is not found, a new one is created with the first matching extension (`.cc' yields `.hh'). This alist should be set by the major mode.") (defvar ff-search-directories 'cc-search-directories "*List of directories to search for a specific file. Set by default to `cc-search-directories', expanded at run-time. This list is searched through with each extension specified in `ff-other-file-alist' that matches this file's extension. So the longer the list, the longer it'll take to realise that a file may not exist. A typical format is '(\".\" \"/usr/include/*\" \"$PROJECT/*/include\") Environment variables can be inserted between slashes (`/'). They will be replaced by their definition. If a variable does not exist, it is replaced (silently) with an empty string. The stars are *not* wildcards: they are searched for together with the preceding slash. The star represents all the subdirectories except `..', and each of these subdirectories will be searched in turn.") (defvar cc-search-directories '("." "/usr/include/*" "/usr/local/include/*") "*See the description of the `ff-search-directories' variable.") (defvar cc-other-file-alist '( ("\\.cc$" (".hh" ".h")) ("\\.hh$" (".cc" ".C")) ("\\.c$" (".h")) ("\\.h$" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp")) ("\\.C$" (".H" ".hh" ".h")) ("\\.H$" (".C" ".CC")) ("\\.CC$" (".HH" ".H" ".hh" ".h")) ("\\.HH$" (".CC")) ("\\.cxx$" (".hh" ".h")) ("\\.cpp$" (".hh" ".h")) ) "*Alist of extensions to find given the current file's extension. This list should contain the most used extensions before the others, since the search algorithm searches sequentially through each directory specified in `ff-search-directories'. If a file is not found, a new one is created with the first matching extension (`.cc' yields `.hh').") (defvar ada-search-directories '("." "/usr/adainclude" "/usr/local/adainclude") "*See the description for the `ff-search-directories' variable.") (defvar ada-other-file-alist '( ("\\.ads$" (".adb")) ;; Ada specs and bodies ("\\.adb$" (".ads")) ;; GNAT filename conventions ) "*Alist of extensions to find given the current file's extension. This list should contain the most used extensions before the others, since the search algorithm searches sequentially through each directory specified in `ada-search-directories'. If a file is not found, a new one is created with the first matching extension (`.adb' yields `.ads'). ") (defvar modula2-other-file-alist '( ("\\.mi$" (".md")) ;; Modula-2 module definition ("\\.md$" (".mi")) ;; and implementation. ) "*See the description for the `ff-search-directories' variable.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; No user definable variables beyond this point! ;; ============================================== (make-variable-buffer-local 'ff-pre-find-hooks) (make-variable-buffer-local 'ff-pre-load-hooks) (make-variable-buffer-local 'ff-post-load-hooks) (make-variable-buffer-local 'ff-not-found-hooks) (make-variable-buffer-local 'ff-file-created-hooks) (make-variable-buffer-local 'ff-case-fold-search) (make-variable-buffer-local 'ff-always-in-other-window) (make-variable-buffer-local 'ff-ignore-include) (make-variable-buffer-local 'ff-quiet-mode) (make-variable-buffer-local 'ff-other-file-alist) (make-variable-buffer-local 'ff-search-directories) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User entry points ;;;###autoload (defun ff-get-other-file (&optional in-other-window) "Find the header or source file corresponding to this file. See also the documentation for `ff-find-other-file;. If optional IN-OTHER-WINDOW is non-nil, find the file in another window." (interactive "P") (let ((ignore ff-ignore-include)) (setq ff-ignore-include t) (ff-find-the-other-file in-other-window) (setq ff-ignore-include ignore))) ;;;###autoload (defun ff-find-other-file (&optional in-other-window ignore-include) "Find the header or source file corresponding to this file. Being on a `#include' line pulls in that file. If optional IN-OTHER-WINDOW is non-nil, find the file in the other window. If optional IGNORE-INCLUDE is non-nil, ignore being on `#include' lines. Variables of interest include: - ff-case-fold-search Non-nil means ignore cases in matches (see case-fold-search). If you have extensions in different cases, you will want this to be nil. - ff-always-in-other-window If non-nil, always open the other file in another window, unless an argument is given to ff-find-other-file. - ff-ignore-include If non-nil, ignores #include lines. - ff-always-try-to-create If non-nil, always attempt to create the other file if it was not found. - ff-quiet-mode If non-nil, traces which directories are being searched. - ff-special-constructs A list of regular expressions specifying how to recognise special constructs such as include files etc, and an associated method for extracting the filename from that construct. - ff-other-file-alist Alist of extensions to find given the current file's extension. - ff-search-directories List of directories searched through with each extension specified in ff-other-file-alist that matches this file's extension. - ff-pre-find-hooks List of functions to be called before the search for the file starts. - ff-pre-load-hooks List of functions to be called before the other file is loaded. - ff-post-load-hooks List of functions to be called after the other file is loaded. - ff-not-found-hooks List of functions to be called if the other file could not be found. - ff-file-created-hooks List of functions to be called if the other file has been created." (interactive "P") (let ((ignore ff-ignore-include)) (setq ff-ignore-include ignore-include) (ff-find-the-other-file in-other-window) (setq ff-ignore-include ignore))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support functions (defun ff-emacs-19 () (string-match "^19\\.[0-9]+\\.[0-9]+$" emacs-version)) (defun ff-xemacs () (or (string-match "Lucid" emacs-version) (string-match "XEmacs" emacs-version))) (defun ff-find-the-other-file (&optional in-other-window) "Find the header or source file corresponding to the current file. Being on a `#include' line pulls in that file, but see the help on the `ff-ignore-include' variable. If optional IN-OTHER-WINDOW is non-nil, find the file in another window." (let (match ;; matching regexp for this file suffixes ;; set of replacing regexps for the matching regexp action ;; function to generate the names of the other files fname ;; basename of this file pos ;; where we start matching filenames stub ;; name of the file without extension alist ;; working copy of the list of file extensions pathname ;; the pathname of the file or the #include line default-name ;; file we should create if none found format ;; what we have to match found ;; name of the file or buffer found - nil if none dirs ;; local value of ff-search-directories no-match) ;; whether we know about this kind of file (if ff-pre-find-hooks (run-hooks 'ff-pre-find-hooks)) (message "Working...") (setq dirs (if (symbolp ff-search-directories) (ff-list-replace-env-vars (symbol-value ff-search-directories)) (ff-list-replace-env-vars ff-search-directories))) (save-excursion (beginning-of-line 1) (setq fname (ff-treat-as-special))) (cond ((and (not ff-ignore-include) fname) (setq default-name fname) (setq found (ff-get-file dirs fname nil in-other-window))) ;; let's just get the corresponding file (t (setq alist (if (symbolp ff-other-file-alist) (symbol-value ff-other-file-alist) ff-other-file-alist) pathname (if (buffer-file-name) (buffer-file-name) "/none.none")) (string-match ".*/\\(.+\\)$" pathname) (setq fname (substring pathname (match-beginning 1) (match-end 1)) no-match nil match (car alist)) ;; find the table entry corresponding to this file (setq pos (ff-string-match (car match) fname)) (while (and match (if (and pos (>= pos 0)) nil (not pos))) (setq alist (cdr alist)) (setq match (car alist)) (setq pos (ff-string-match (car match) fname))) ;; no point going on if we haven't found anything (if (not match) (setq no-match t) ;; otherwise, suffixes contains what we need (setq suffixes (car (cdr match)) action (car (cdr match)) found nil) ;; if we have a function to generate new names, ;; invoke it with the name of the current file (if (and (atom action) (fboundp action)) (progn (setq suffixes (funcall action (buffer-file-name)) match (cons (car match) (list suffixes)) stub nil default-name (car suffixes))) ;; otherwise build our filename stub (cond ;; get around the problem that 0 and nil both mean false! ((= pos 0) (setq format "") (setq stub "") ) (t (setq format (concat "\\(.+\\)" (car match))) (string-match format fname) (setq stub (substring fname (match-beginning 1) (match-end 1))) )) ;; if we find nothing, we should try to get a file like this one (setq default-name (concat stub (car (car (cdr match)))))) ;; do the real work - find the file (setq found (ff-get-file dirs stub suffixes in-other-window))))) (cond (no-match ;; could not even determine the other file (message "")) (t (cond ((not found) ;; could not find the other file (if ff-not-found-hooks ;; run the hooks (run-hooks 'ff-not-found-hooks)) (cond (ff-always-try-to-create ;; try to create the file (let (name pathname) (setq name (expand-file-name (read-file-name (format "Find or create %s in: " default-name) default-directory default-name nil))) (setq pathname (if (file-directory-p name) (concat (file-name-as-directory name) default-name) (setq found name))) (ff-find-file pathname in-other-window t))) (t ;; don't create the file, just whinge (message "no file found for %s" fname)))) (t ;; matching file found nil)))) found)) ;; return buffer-name or filename (defun ff-get-file (search-dirs fname-stub &optional suffix-list other-window) "Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub). If (optional) SUFFIXES is nil, search for fname, otherwise search for fname with each of the given suffixes. Gets the file or the buffer corresponding to the name of the first file found, or nil. Arguments: (search-dirs fname-stub &optional suffix-list in-other-window) " (let ((filename (ff-get-file-name search-dirs fname-stub suffix-list))) (cond ((not filename) nil) ((bufferp (get-buffer filename)) (ff-switch-to-buffer filename other-window) filename) ((file-exists-p filename) (ff-find-file filename other-window nil) filename) (t nil)))) (defun ff-get-file-name (search-dirs fname-stub &optional suffix-list) "Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub). If (optional) SUFFIXES is nil, search for fname, otherwise search for fname with each of the given suffixes. Returns the name of the first file found. Arguments: (search-dirs fname-stub &optional suffix-list) " (let* (dirs ;; working copy of dirs to search dir ;; the current dir considered file ;; filename being looked for rest ;; pathname after first /* this-suffix ;; the suffix we are currently considering suffixes ;; working copy of suffix-list filename ;; built filename blist ;; list of live buffers buf ;; current buffer in blist found) ;; whether we have found anything (setq suffixes suffix-list) ;; suffixes is nil => fname-stub is the file we are looking for ;; otherwise fname-stub is a stub, and we append a suffix (if suffixes (setq this-suffix (car suffixes)) (setq this-suffix "") (setq suffixes (list ""))) ;; find whether the file is in a buffer first (while (and suffixes (not found)) (setq filename (concat fname-stub this-suffix)) (if (not ff-quiet-mode) (message "finding buffer %s..." filename)) (if (bufferp (get-buffer filename)) (setq found filename)) (setq blist (buffer-list)) (setq buf (buffer-name (car blist))) (while (and blist (not found)) (if (string-match (concat filename "<[0-9]+>") buf) (setq found buf)) (setq blist (cdr blist)) (setq buf (buffer-name (car blist)))) (setq suffixes (cdr suffixes)) (setq this-suffix (car suffixes))) ;; now look for the real file (setq dirs search-dirs) (setq dir (car dirs)) (while (and (not found) dirs) (setq suffixes suffix-list) ;; if dir does not contain '/*', look for the file (if (and dir (not (string-match "\\([^*]*\\)/\\\*\\(/.*\\)*" dir))) (progn ;; suffixes is nil => fname-stub is the file we are looking for ;; otherwise fname-stub is a stub, and we append a suffix (if suffixes (setq this-suffix (car suffixes)) (setq this-suffix "") (setq suffixes (list ""))) (while (and suffixes (not found)) (setq filename (concat fname-stub this-suffix)) (setq file (concat dir "/" filename)) (if (not ff-quiet-mode) (message "finding %s..." file)) (if (file-exists-p file) (setq found file)) (setq suffixes (cdr suffixes)) (setq this-suffix (car suffixes)))) ;; otherwise dir matches the '/*', so search each dir separately (progn (if (match-beginning 2) (setq rest (substring dir (match-beginning 2) (match-end 2))) (setq rest "") ) (setq dir (substring dir (match-beginning 1) (match-end 1))) (let ((dirlist (ff-all-dirs-under dir '(".."))) this-dir compl-dirs) (setq this-dir (car dirlist)) (while dirlist (setq compl-dirs (append compl-dirs (list (concat this-dir rest)) )) (setq dirlist (cdr dirlist)) (setq this-dir (car dirlist))) (if compl-dirs (setq found (ff-get-file-name compl-dirs fname-stub suffix-list)))))) (setq dirs (cdr dirs)) (setq dir (car dirs))) (if found (message "%s found" found)) found)) (defun ff-string-match (regexp string &optional start) "Like string-match (which see), but set `case-fold-search' temporarily. The value used comes from `ff-case-fold-search'." (let ((case-fold-search ff-case-fold-search)) (if regexp (string-match regexp string start)))) (defun ff-list-replace-env-vars (search-list) "Replace environment variables (of the form $VARIABLE) in SEARCH-LIST." (let (list (var (car search-list))) (while search-list (if (string-match "\\(.*\\)\\$[({]*\\([a-zA-Z0-9_]+\\)[)}]*\\(.*\\)" var) (setq var (concat (substring var (match-beginning 1) (match-end 1)) (getenv (substring var (match-beginning 2) (match-end 2))) (substring var (match-beginning 3) (match-end 3))))) (setq search-list (cdr search-list)) (setq list (cons var list)) (setq var (car search-list))) (setq search-list (reverse list)))) (defun ff-treat-as-special () "Returns the file to look for if the construct was special, else nil. The construct is defined in the variable `ff-special-constructs' (which see)." (let* (fname (list ff-special-constructs) (elem (car list)) (regexp (car elem)) (match (cdr elem))) (while (and list (not fname)) (if (and (looking-at regexp) match) (setq fname (funcall match))) (setq list (cdr list)) (setq elem (car list)) (setq regexp (car elem)) (setq match (cdr elem))) fname)) (defun ff-basename (string) "Return the basename of PATHNAME." (setq string (concat "/" string)) (string-match ".*/\\([^/]+\\)$" string) (setq string (substring string (match-beginning 1) (match-end 1)))) (defun ff-all-dirs-under (here &optional exclude) "Get all the directory files under directory HERE. Exclude all files in the optional EXCLUDE list." (if (file-directory-p here) (condition-case nil (progn (let ((files (directory-files here t)) (dirlist (list)) file) (while files (setq file (car files)) (if (and (file-directory-p file) (not (member (ff-basename file) exclude))) (setq dirlist (cons file dirlist))) (setq files (cdr files))) (setq dirlist (reverse dirlist)))) (error nil)) nil)) (defun ff-switch-file (f1 f2 file &optional in-other-window new-file) "Call F1 or F2 on FILE, according to IN-OTHER-WINDOW. In addition, this runs various hooks. Either F1 or F2 receives FILE as the sole argument. The decision of which one to call is based on IN-OTHER-WINDOW and on the global variable `ff-always-in-other-window'. F1 and F2 are typically `find-file' / `find-file-other-window' or `switch-to-buffer' / `switch-to-buffer-other-window' function pairs. If optional NEW-FILE is t, then a special hook (`ff-file-created-hooks') is called before `ff-post-load-hooks'." (if ff-pre-load-hooks (run-hooks 'ff-pre-load-hooks)) (if (or (and in-other-window (not ff-always-in-other-window)) (and (not in-other-window) ff-always-in-other-window)) (funcall f2 file) (funcall f1 file)) (if new-file (if ff-file-created-hooks (run-hooks 'ff-file-created-hooks))) (if ff-post-load-hooks (run-hooks 'ff-post-load-hooks))) (defun ff-find-file (file &optional in-other-window new-file) "Like `find-file' (which see), but may put the file in another window." (ff-switch-file 'find-file 'find-file-other-window file in-other-window new-file)) (defun ff-switch-to-buffer (file &optional in-other-window) "Like `switch-to-buffer' (which see), but may put the buffer in another window." (ff-switch-file 'switch-to-buffer 'switch-to-buffer-other-window file in-other-window nil)) (cond ((ff-emacs-19) (defun ff-goto-click (event) (set-buffer (window-buffer (posn-window (event-end event)))) (goto-char (posn-point (event-end event)))) ;;;###autoload (defun ff-mouse-find-other-file (event) "Visit the file you click on." (interactive "e") (save-excursion (ff-goto-click event) (ff-find-other-file nil))) ;;;###autoload (defun ff-mouse-find-other-file-other-window (event) "Visit the file you click on." (interactive "e") (save-excursion (ff-goto-click event) (ff-find-other-file t))) ;;;###autoload (defun locate-file (fname dirs &optional suffix-list ignore-perms) "Defines XEmacs look-alike locate-file for GNU Emacs-19." (interactive) (ff-get-file dirs fname suffix-list)) ) ((ff-xemacs) ;;;###autoload (defun ff-mouse-find-other-file (event) "Visit the file you click on." (interactive "@e") (save-excursion (mouse-set-point event) (ff-find-other-file nil))) ;;;###autoload (defun ff-mouse-find-other-file-other-window (event) "Visit the file you click on." (interactive "@e") (save-excursion (mouse-set-point event) (ff-find-other-file t))) )) (provide 'find-file) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; This section offers an example of user defined function to select files (defun ff-upcase-p (string &optional start end) "Return t if this string is all uppercase. Given START and/or END, checks between these characters." (let (match str) (if (not start) (setq start 0)) (if (not end) (setq end (length string))) (if (= start end) (setq end (1+ end))) (setq str (substring string start end)) (if (and (ff-string-match "[A-Z]+" str) (setq match (match-data)) (= (car match) 0) (= (car (cdr match)) (length str))) t nil))) (defun ff-cc-hh-converter (arg) "Discriminate file extensions. Build up a new file list based possibly on part of the directory name and the name of the file passed in." (ff-string-match "\\(.*\\)/\\([^/]+\\)/\\([^.]+\\).\\([^/]+\\)$" arg) (let ((path (if (match-beginning 1) (substring arg (match-beginning 1) (match-end 1)) nil)) (dire (if (match-beginning 2) (substring arg (match-beginning 2) (match-end 2)) nil)) (file (if (match-beginning 3) (substring arg (match-beginning 3) (match-end 3)) nil)) (extn (if (match-beginning 4) (substring arg (match-beginning 4) (match-end 4)) nil)) return-list) (cond ;; fooZapJunk.cc => ZapJunk.{hh,h} or fooZapJunk.{hh,h} ((and (string= extn "cc") (ff-string-match "^\\([a-z]+\\)\\([A-Z].+\\)$" file)) (let ((stub (substring file (match-beginning 2) (match-end 2)))) (setq dire (upcase (substring file (match-beginning 1) (match-end 1)))) (setq return-list (list (concat stub ".hh") (concat stub ".h") (concat file ".hh") (concat file ".h"))) )) ;; FOO/ZapJunk.hh => fooZapJunk.{cc,C} or ZapJunk.{cc,C} ((and (string= extn "hh") (ff-upcase-p dire) file) (let ((stub (concat (downcase dire) file))) (setq return-list (list (concat stub ".cc") (concat stub ".C") (concat file ".cc") (concat file ".C"))) )) ;; zap.cc => zap.hh or zap.h ((string= extn "cc") (let ((stub file)) (setq return-list (list (concat stub ".hh") (concat stub ".h"))) )) ;; zap.hh => zap.cc or zap.C ((string= extn "hh") (let ((stub file)) (setq return-list (list (concat stub ".cc") (concat stub ".C"))) )) (t nil)) return-list)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; This section offers an example of user defined function to place point. ;; The regexps are Ada specific. (defvar ff-function-name nil "Name of the function we are in.") (defvar ada-procedure-start-regexp) (defvar ada-package-start-regexp) ;; bind with (setq ff-pre-load-hooks 'ff-which-function-are-we-in) ;; (defun ff-which-function-are-we-in () "Return the name of the function whose definition/declaration point is in. Also remember that name in `ff-function-name'." (setq ff-function-name nil) (save-excursion (if (re-search-backward ada-procedure-start-regexp nil t) (setq ff-function-name (buffer-substring (match-beginning 0) (match-end 0))) ; we didn't find a procedure start, perhaps there is a package (if (re-search-backward ada-package-start-regexp nil t) (setq ff-function-name (buffer-substring (match-beginning 0) (match-end 0))) )))) ;; bind with (setq ff-post-load-hooks 'ff-set-point-accordingly) ;; (defun ff-set-point-accordingly () "Find the function specified in `ff-function-name'. That name was previously determined by `ff-which-function-are-we-in'." (if ff-function-name (progn (goto-char (point-min)) (search-forward ff-function-name nil t)))) ;; find-file.el ends here emacs-19.30/lisp/find-gc.el100444 74777 1 12075 5353250220 13743 0ustar esrdaemon;;; find-gc.el --- detect functions that call the garbage collector ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Maintainer: FSF ;; 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: ;;; Produce in unsafe-list the set of all functions that may invoke GC. ;;; This expects the Emacs sources to live in emacs-source-directory. ;;; It creates a temporary working directory /tmp/esrc. ;;; Code: (defun find-gc-unsafe () (trace-call-tree nil) (trace-use-tree) (find-unsafe-funcs 'Fgarbage_collect) (setq unsafe-list (sort unsafe-list (function (lambda (x y) (string-lessp (car x) (car y)))))) ) (setq emacs-source-directory "/usr/gnu/src/dist/src") ;;; This does a depth-first search to find all functions that can ;;; ultimately call the function "target". The result is an a-list ;;; in unsafe-list; the cars are the unsafe functions, and the cdrs ;;; are (one of) the unsafe functions that these functions directly ;;; call. (defun find-unsafe-funcs (target) (setq unsafe-list (list (list target))) (trace-unsafe target) ) (defun trace-unsafe (func) (let ((used (assq func subrs-used))) (or used (error "No subrs-used for %s" (car unsafe-list))) (while (setq used (cdr used)) (or (assq (car used) unsafe-list) (memq (car used) noreturn-list) (progn (setq unsafe-list (cons (cons (car used) func) unsafe-list)) (trace-unsafe (car used)))))) ) ;;; Functions on this list are safe, even if they appear to be able ;;; to call the target. (setq noreturn-list '( Fsignal Fthrow wrong_type_argument )) ;;; This produces an a-list of functions in subrs-called. The cdr of ;;; each entry is a list of functions which the function in car calls. (defun trace-call-tree (&optional already-setup) (message "Setting up directories...") (or already-setup (progn ;; Gee, wouldn't a built-in "system" function be handy here. (call-process "csh" nil nil nil "-c" "rm -rf /tmp/esrc") (call-process "csh" nil nil nil "-c" "mkdir /tmp/esrc") (call-process "csh" nil nil nil "-c" (format "ln -s %s/*.[ch] /tmp/esrc" emacs-source-directory)))) (save-excursion (set-buffer (get-buffer-create "*Trace Call Tree*")) (setq subrs-called nil) (let ((case-fold-search nil) (files source-files) name entry) (while files (message "Compiling %s..." (car files)) (call-process "csh" nil nil nil "-c" (format "gcc -dr -c /tmp/esrc/%s -o /dev/null" (car files))) (erase-buffer) (insert-file-contents (concat "/tmp/esrc/" (car files) ".rtl")) (while (re-search-forward ";; Function \\|(call_insn " nil t) (if (= (char-after (- (point) 3)) ?o) (progn (looking-at "[a-zA-Z0-9_]+") (setq name (intern (buffer-substring (match-beginning 0) (match-end 0)))) (message "%s : %s" (car files) name) (setq entry (list name) subrs-called (cons entry subrs-called))) (if (looking-at ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"") (progn (setq name (intern (buffer-substring (match-beginning 1) (match-end 1)))) (or (memq name (cdr entry)) (setcdr entry (cons name (cdr entry)))))))) (delete-file (concat "/tmp/esrc/" (car files) ".rtl")) (setq files (cdr files))))) ) ;;; This was originally generated directory-files, but there were ;;; too many files there that were not actually compiled. The ;;; list below was created for a HP-UX 7.0 system. (setq source-files '("dispnew.c" "scroll.c" "xdisp.c" "window.c" "term.c" "cm.c" "emacs.c" "keyboard.c" "macros.c" "keymap.c" "sysdep.c" "buffer.c" "filelock.c" "insdel.c" "marker.c" "minibuf.c" "fileio.c" "dired.c" "filemode.c" "cmds.c" "casefiddle.c" "indent.c" "search.c" "regex.c" "undo.c" "alloc.c" "data.c" "doc.c" "editfns.c" "callint.c" "eval.c" "fns.c" "print.c" "lread.c" "abbrev.c" "syntax.c" "unexec.c" "mocklisp.c" "bytecode.c" "process.c" "callproc.c" "doprnt.c" "x11term.c" "x11fns.c")) ;;; This produces an inverted a-list in subrs-used. The cdr of each ;;; entry is a list of functions that call the function in car. (defun trace-use-tree () (setq subrs-used (mapcar 'list (mapcar 'car subrs-called))) (let ((ptr subrs-called) p2 found) (while ptr (setq p2 (car ptr)) (while (setq p2 (cdr p2)) (if (setq found (assq (car p2) subrs-used)) (setcdr found (cons (car (car ptr)) (cdr found))))) (setq ptr (cdr ptr)))) ) ;;; find-gc.el ends here emacs-19.30/lisp/finder-inf.el100666 12120 1 73315 6045363237 14461 0ustar rmsdaemon;;; finder-inf.el --- keyword-to-package mapping ;; Keywords: help ;;; Commentary: ;; Don't edit this file. It's generated by finder.el ;;; Code: (setq finder-package-info '( ("default.el" nil nil) ("po-mode.el" nil nil) ("abbrev.el" "abbrev mode commands for Emacs" (abbrev)) ("abbrevlist.el" "list one abbrev table alphabetically ordered." (abbrev)) ("ada-mode.el" nil nil) ("add-log.el" "change log maintenance commands for Emacs" (maint)) ("advice.el" "an overloading mechanism for Emacs Lisp functions" (extensions lisp tools)) ("allout.el" nil (outline mode)) ("ange-ftp.el" "transparent FTP support for GNU Emacs" (comm)) ("appt.el" "appointment notification functions." (calendar)) ("apropos.el" "faster apropos commands." (help)) ("arc-mode.el" "simple editing of archives" (archives msdog editing major-mode)) ("array.el" "array editing commands for Gnu Emacs" (extensions)) ("asm-mode.el" "mode for editing assembler code" (tools languages)) ("assoc.el" "insert/delete/sort functions on association lists" (extensions)) ("auto-show.el" nil nil) ("autoinsert.el" "automatic mode-dependent insertion of text into new files" nil) ("autoload.el" "maintain autoloads in loaddefs.el." (maint)) ("avoid.el" nil (mouse)) ("awk-mode.el" "AWK code editing commands for Emacs" (unix languages)) ("backquote.el" nil (extensions internal)) ("bib-mode.el" "bib-mode, major mode for editing bib files." (bib)) ("bibtex.el" "BibTeX mode for GNU Emacs" (bibtex latex tex)) ("blackbox.el" "blackbox game in Emacs Lisp" (games)) ("blessmail.el" "Decide whether movemail needs special privileges." (internal)) ("bookmark.el" "set bookmarks, maybe annotate them, jump to them later." (bookmarks placeholders annotations)) ("buff-menu.el" "buffer menu main function and support functions." nil) ("byte-opt.el" "the optimization passes of the emacs-lisp byte compiler." (internal)) ("byte-run.el" "byte-compiler support for inlining" (internal)) ("bytecomp.el" "compilation of Lisp code into byte code." (internal)) ("bytecpat.el" nil nil) ("c-mode.el" "C code editing commands for Emacs" (c)) ("cal-dst.el" "calendar functions for daylight savings rules." (calendar)) ("cal-french.el" "calendar functions for the French Revolutionary calendar." (calendar)) ("cal-mayan.el" "calendar functions for the Mayan calendars." (calendar)) ("cal-menu.el" "calendar functions for menu bar and popup menu support" (calendar)) ("cal-x.el" "calendar windows in dedicated frames in x-windows" (calendar)) ("calendar.el" "Calendar functions. -*-byte-compile-dynamic: t;-*-" (calendar)) ("case-table.el" "code to extend the character set and support case tables." (i18n)) ("cc-mode.el" "major mode for editing C, C++, and Objective-C code" (c languages oop)) ("cdl.el" nil (data)) ("chistory.el" "list command history" nil) ("cl-compat.el" nil (extensions)) ("cl-extra.el" nil (extensions)) ("cl-indent.el" "enhanced lisp-indent mode" (lisp tools)) ("cl-macs.el" nil (extensions)) ("cl-seq.el" nil (extensions)) ("cl-specs.el" nil (lisp tools maint)) ("cl.el" nil (extensions)) ("cmacexp.el" "expand C macros in a region" (c)) ("cmuscheme.el" "Scheme process in a buffer. Adapted from tea.el." (processes lisp)) ("comint.el" "general command interpreter in a window stuff" (processes)) ("compare-w.el" "compare text between windows for Emacs." nil) ("compile.el" "run compiler as inferior of Emacs, parse error messages." (tools processes)) ("complete.el" nil (abbrev)) ("completion.el" "dynamic word-completion code" (abbrev)) ("cookie1.el" "retrieve random phrases from fortune cookie files" (games)) ("cplus-md.el" "C++ code editing commands for Emacs" (c languages oop)) ("cpp.el" "Highlight or hide text according to cpp conditionals." (c faces tools)) ("cust-print.el" "handles print-level and print-circle." (extensions)) ("dabbrev.el" "dynamic abbreviation package" (abbrev expand completion)) ("debug.el" "debuggers and related commands for Emacs" (lisp tools maint)) ("delsel.el" "delete selection if you insert" nil) ("derived.el" nil nil) ("desktop.el" "save partial status of Emacs when killed" (customization)) ("diary-ins.el" "calendar functions for adding diary entries." (diary calendar)) ("diary-lib.el" "diary functions." (calendar)) ("diff.el" "Run `diff' in compilation-mode." (unix tools)) ("dired-aux.el" "less commonly used parts of dired -*-byte-compile-dynamic: t;-*-" nil) ("dired-x.el" "Sebastian Kremer's Extra DIRED hacked up for GNU Emacs19" (dired extensions)) ("dired.el" "directory-browsing commands" nil) ("disass.el" "disassembler for compiled Emacs Lisp code" (internal)) ("disp-table.el" "functions for dealing with char tables." (i18n)) ("dissociate.el" "scramble text amusingly for Emacs." (games)) ("docref.el" nil (docs help lisp)) ("doctor.el" "psychological help for frustrated users." (games)) ("dos-fns.el" "MS-Dos specific functions." (internal)) ("double.el" nil (i18n)) ("dunnet.el" "Text adventure for Emacs" (games)) ("easymenu.el" "support the easymenu interface for defining a menu." (emulations)) ("ebuff-menu.el" "electric-buffer-list mode" nil) ("echistory.el" "Electric Command History Mode" nil) ("edebug.el" "a source-level debugger for Emacs Lisp" (lisp tools maint)) ("ediff-diff.el" "diff-related utilities" nil) ("ediff-init.el" "Macros, variables and defsubsts used by Ediff" nil) ("ediff-merg.el" "merging utilities" nil) ("ediff-util.el" "the core commands and utilities of ediff" nil) ("ediff-wind.el" "window manipulation utilities" nil) ("ediff.el" "a comprehensive visual interface to diff & patch" (comparing merging patching version control.)) ("edmacro.el" "keyboard macro editor" (abbrev)) ("edt-lk201.el" nil (emulations)) ("edt-mapper.el" nil (emulations)) ("edt-pc.el" nil (emulations)) ("edt-vt100.el" nil (emulations)) ("edt.el" nil (emulations)) ("ehelp.el" "bindings for electric-help mode" (help extensions)) ("electric.el" "window maker and Command loop for `electric' modes." (extensions)) ("elp.el" "Emacs Lisp Profiler" ( emacs lisp profile timing)) ("emacs-lock.el" nil ()) ("emacsbug.el" "command to report Emacs bugs to appropriate mailing list." (maint)) ("emerge.el" "merge diffs under Emacs control" (unix tools)) ("enriched.el" nil (wp faces)) ("env.el" "functions to manipulate environment variables." (processes unix)) ("etags.el" "etags facility for Emacs" (tools)) ("eval-reg.el" "Redefine eval-region, and subrs that use it, in Lisp" (lisp)) ("f90.el" nil (fortran f90 languages)) ("facemenu.el" nil (faces)) ("faces.el" "Lisp interface to the c \"face\" structure" nil) ("fast-lock.el" "Automagic text properties caching for fast Font Lock mode." (faces files)) ("files.el" "file input and output commands for Emacs" nil) ("fill.el" "fill commands for Emacs" (wp)) ("find-dired.el" "run a `find' command and dired the output" (unix)) ("find-file.el" "find a file corresponding to this one given a pattern" (c matching tools)) ("find-gc.el" "detect functions that call the garbage collector" nil) ("finder-inf.el" "keyword-to-package mapping" (help)) ("finder.el" "topic & keyword-based code finder" (help)) ("float-sup.el" "detect absence of floating-point support in Emacs runtime" nil) ("float.el" "floating point arithmetic package." (extensions)) ("flow-ctrl.el" "help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control" (hardware)) ("foldout.el" "Folding extensions for outline-mode and outline-minor-mode." (folding outline)) ("font-lock.el" nil (languages faces)) ("format.el" nil nil) ("forms-d2.el" nil nil) ("forms-pass.el" nil nil) ("forms.el" nil nil) ("fortran.el" "Fortran mode for GNU Emacs" (languages)) ("frame.el" "multi-frame management independent of window systems." (internal)) ("gnus-uu.el" "extract, view or save (uu)encoded files from gnus" (news)) ("gnus.el" "NNTP-based News Reader for GNU Emacs" (news)) ("gnusmail.el" "mail reply commands for GNUS newsreader" (news)) ("gnusmisc.el" "miscellaneous commands for GNUS newsreader" (news)) ("gnuspost.el" "post news commands for GNUS newsreader" (news)) ("gomoku.el" "Gomoku game between you and Emacs" (games)) ("gud.el" "Grand Unified Debugger mode for gdb, sdb, dbx, or xdb" (unix tools)) ("hanoi.el" "towers of hanoi in GNUmacs" (games)) ("help-macro.el" "Makes command line help such as help-for-help" nil) ("help.el" "help commands for Emacs" (help internal)) ("helper.el" "utility help package supporting help in electric modes" (help)) ("hexl.el" "edit a file in a hex dump format using the hexl filter." (data)) ("hideif.el" "hides selected code within ifdef." (c outlines)) ("hideshow.el" "minor mode cmds to selectively display blocks of code" nil) ("hilit19.el" nil (faces)) ("hippie-exp.el" "expand text trying various ways to find its expansion." (abbrev)) ("holidays.el" "holiday functions for the calendar package" (holidays calendar)) ("icomplete.el" nil nil) ("icon.el" "mode for editing Icon code" (languages)) ("ielm.el" "interaction mode for Emacs Lisp" (lisp)) ("imenu.el" "Framework for mode-specific buffer indexes." (tools)) ("indent.el" "indentation commands for Emacs" nil) ("inf-lisp.el" "an inferior-lisp mode" (processes lisp)) ("info.el" "info package for Emacs." (help)) ("informat.el" "info support functions package for Emacs" (help)) ("isearch.el" "incremental search minor mode." nil) ("iso-acc.el" nil (i18n)) ("iso-ascii.el" "set up char tables for ISO 8859/1 on ASCII terminals." (i18n)) ("iso-cvt.el" nil (tex iso latin i18n)) ("iso-insert.el" "insert functions for ISO 8859/1." (i18n)) ("iso-swed.el" "set up char tables for ISO 8859/1 for Swedish/Finnish ttys" (i18n)) ("iso-syntax.el" "set up case-conversion and syntax tables for ISO 8859/1" (i18n)) ("iso-transl.el" "keyboard input definitions for ISO 8859/1." (i18n)) ("ispell.el" nil nil) ("ispell4.el" "this is the GNU EMACS interface to GNU ISPELL version 4." (wp)) ("jka-compr.el" nil (data)) ("kermit.el" "additions to shell mode for use with kermit, etc." (comm)) ("ledit.el" "Emacs side of ledit interface" nil) ("levents.el" "emulate the Lucid event data type and associated functions." nil) ("life.el" "John Horton Conway's `Life' game for GNU Emacs" (games)) ("lisp-mnt.el" "minor mode for Emacs Lisp maintainers" (docs)) ("lisp-mode.el" "Lisp mode, and its idiosyncratic commands." (lisp languages)) ("lisp.el" "Lisp editing commands for Emacs" (lisp languages)) ("lmenu.el" "emulate Lucid's menubar support" (emulations)) ("loaddefs.el" "define standard autoloads and keys of other files" (internal)) ("loadhist.el" "lisp functions for working with feature groups" (internal)) ("loadup.el" "load up standardly loaded Lisp files for Emacs." (internal)) ("lpr.el" "print Emacs buffer on line printer." (unix)) ("ls-lisp.el" "emulate insert-directory completely in Emacs Lisp" (unix)) ("lselect.el" "Lucid interface to X Selections" (emulations)) ("lucid.el" "Emulate some Lucid Emacs functions." nil) ("lunar.el" "calendar functions for phases of the moon." (calendar)) ("macros.el" "non-primitive commands for keyboard macros." (abbrev)) ("mail-extr.el" "extract full name and address from RFC 822 mail header." (mail)) ("mail-hist.el" "Headers and message body history for outgoing mail." (mail history)) ("mail-utils.el" "utility functions used both by rmail and rnews" (mail news)) ("mailabbrev.el" "abbrev-expansion of mail aliases." (mail)) ("mailalias.el" "expand mailing address aliases defined in ~/.mailrc." (mail)) ("mailpost.el" "RMAIL coupler to /usr/uci/post mailer" (mail)) ("makefile.el" "makefile editing commands for Emacs" (unix tools)) ("makeinfo.el" nil nil) ("makesum.el" "generate key binding summary for Emacs" (help)) ("man.el" "browse UNIX manual pages" nil) ("map-ynp.el" "General-purpose boolean question-asker." (lisp extensions)) ("meese.el" "protect the impressionable young minds of America" (games)) ("menu-bar.el" "define a default menu bar." (internal)) ("metamail.el" "Metamail interface for GNU Emacs" (mail news mime multimedia)) ("mh-comp.el" "mh-e functions for composing messages" nil) ("mh-e.el" "GNU Emacs interface to the MH mail system" (mail)) ("mh-funcs.el" "mh-e functions not everyone will use right away" nil) ("mh-mime.el" "mh-e support for composing MIME messages" nil) ("mh-pick.el" "make a search pattern and search for a message in mh-e" nil) ("mh-seq.el" "mh-e sequences support" nil) ("mh-utils.el" "mh-e code needed for both sending and reading" nil) ("mhspool.el" "MH folder access using NNTP for GNU Emacs" (mail news)) ("misc.el" "basic editing commands for Emacs" nil) ("mlconvert.el" "convert buffer of Mocklisp code to real lisp." (emulations)) ("mldrag.el" nil (mouse)) ("mlsupport.el" "run-time support for mocklisp code." (extensions)) ("modula2.el" "Modula-2 editing support package" (languages)) ("mouse-sel.el" "Multi-click selection support for Emacs 19" (mouse)) ("mouse.el" "window system-independent mouse support." (hardware)) ("mpuz.el" "multiplication puzzle for GNU Emacs" (games)) ("msb.el" "Customizable buffer-selection with multiple menus." (mouse buffer menu )) ("nnspool.el" "spool access using NNTP for GNU Emacs" (news)) ("nntp.el" "NNTP (RFC977) Interface for GNU Emacs" (news)) ("noutline.el" "outline mode commands for Emacs" (outlines)) ("novice.el" "handling of disabled commands (\"novice mode\") for Emacs." (internal help)) ("nroff-mode.el" "GNU Emacs major mode for editing nroff source" (wp)) ("options.el" "edit Options command for Emacs." nil) ("outline.el" "outline mode commands for Emacs" (outlines)) ("page-ext.el" "extended page handling commands" nil) ("page.el" "page motion commands for emacs." nil) ("paragraphs.el" "paragraph and sentence parsing." (wp)) ("paren.el" "highlight matching paren." (languages faces)) ("pascal.el" nil nil) ("paths.el" "define pathnames for use by various Emacs commands." (internal)) ("pc-mode.el" nil nil) ("perl-mode.el" "Perl code editing commands for GNU Emacs" (languages)) ("picture.el" "\"Picture mode\" -- editing using quarter-plane screen model." nil) ("pp.el" nil nil) ("profile.el" "generate run time measurements of Emacs Lisp functions" (lisp tools)) ("prolog.el" "major mode for editing and running Prolog under Emacs" (languages)) ("ps-print.el" "Jim's Pretty-Good PostScript Generator for Emacs 19." (print postscript)) ("rcompile.el" nil (tools processes)) ("rect.el" "rectangle functions for GNU Emacs." (internal)) ("refbib.el" "convert refer-style references to ones usable by Latex bib" (bib tex)) ("refer.el" "look up references in bibliography files." (bib)) ("regi.el" "REGular expression Interpreting engine" ( extensions matching)) ("register.el" "register commands for Emacs." (internal)) ("replace.el" "replace commands for Emacs." nil) ("reporter.el" "customizable bug reporting of lisp programs" (bug reports lisp)) ("reposition.el" "center a Lisp function or comment on the screen" nil) ("resume.el" "process command line args from within a suspended Emacs job" (processes)) ("rfc822.el" "hairy rfc822 parser for mail and news and suchlike" (mail)) ("ring.el" "handle rings of items" (extensions)) ("rlogin.el" "remote login interface" (unix comm)) ("rmail.el" "main code of \"RMAIL\" mail reader for Emacs." (mail)) ("rmailedit.el" "\"RMAIL edit mode\" Edit the current message." (mail)) ("rmailkwd.el" "part of the \"RMAIL\" mail reader for Emacs." (mail)) ("rmailmsc.el" "miscellaneous support functions for the RMAIL mail reader" (mail)) ("rmailout.el" "\"RMAIL\" mail reader for Emacs: output message to a file." (mail)) ("rmailsort.el" "Rmail: sort messages." (mail)) ("rmailsum.el" "make summary buffers for the mail reader" (mail)) ("rnews.el" "USENET news reader for gnu emacs" (news)) ("rnewspost.el" "USENET news poster/mailer for GNU Emacs" (mail news)) ("rot13.el" "display a buffer in rot13." nil) ("rsz-mini.el" "dynamically resize minibuffer to display entire contents" (minibuffer window frame display)) ("s-region.el" "set region using shift key." (terminals)) ("saveplace.el" "automatically save place in files." (bookmarks placeholders)) ("sc.el" nil nil) ("scheme.el" "Scheme mode, and its idiosyncratic commands." (languages lisp)) ("scribe.el" "scribe mode, and its idiosyncratic commands." (wp)) ("scroll-bar.el" "window system-independent scroll bar support." (hardware)) ("select.el" "lisp portion of standard selection support." (internal)) ("sendmail.el" "mail sending commands for Emacs." (mail)) ("server.el" "Lisp code for GNU Emacs running as server process." (processes)) ("sgml-mode.el" "SGML-editing mode" (wp)) ("sh-script.el" "shell-script editing commands for Emacs" (shell programming)) ("shadowfile.el" nil nil) ("shell.el" "specialized comint.el for running the shell." (processes)) ("simple.el" "basic editing commands for Emacs" nil) ("simula.el" "SIMULA 87 code editing commands for Emacs" (languages)) ("skeleton.el" "Metalanguage for writing statement skeletons" (shell programming)) ("solar.el" "calendar functions for solar events." (calendar)) ("sort.el" "commands to sort text in an Emacs buffer." (unix)) ("soundex.el" nil (matching)) ("spell.el" "spelling correction interface for Emacs." (wp unix)) ("spook.el" "spook phrase utility for overloading the NSA line eater" (games)) ("startup.el" "process Emacs shell arguments" (internal)) ("studly.el" "StudlyCaps (tm)(r)(c)(xxx)" (games)) ("subr.el" "basic lisp subroutines for Emacs" nil) ("sun-curs.el" "cursor definitions for Sun windows" (hardware)) ("sun-fns.el" "subroutines of Mouse handling for Sun windows" (hardware)) ("supercite.el" "minor mode for citing mail and news replies" (mail news)) ("swedish.el" "miscellaneous functions for dealing with Swedish." (i18n)) ("tabify.el" "tab conversion commands for Emacs" nil) ("talk.el" "Allow several users to talk to each other through Emacs." (comm frames)) ("tar-mode.el" "simple editing of tar files from GNU emacs" (unix)) ("tcl-mode.el" nil (languages processes tools)) ("tcp.el" nil nil) ("telnet.el" "run a telnet session from within an Emacs buffer" nil) ("tempo.el" "Flexible template insertion" (extensions languages tools)) ("term-nasty.el" "Damned Things from terminfo.el" nil) ("term.el" nil nil) ("terminal.el" "terminal emulator for GNU Emacs." (comm terminals)) ("tex-mode.el" "TeX, LaTeX, and SliTeX mode commands." (tex)) ("texinfmt.el" nil nil) ("texinfo.el" nil nil) ("texnfo-upd.el" nil (maint tex docs)) ("text-mode.el" "text mode, and its idiosyncratic commands." nil) ("thingatpt.el" "Get the `thing' at point" (extensions matching mouse)) ("time-stamp.el" "Maintain last change time stamps in files edited by Emacs" (tools)) ("time.el" "display time and load in mode line of Emacs." nil) ("timer.el" "run a function with args at some time in future" nil) ("timezone.el" nil nil) ("tmm.el" nil nil) ("tpu-edt.el" "Emacs emulating TPU emulating EDT" (emulations)) ("tpu-extras.el" "Scroll margins and free cursor mode for TPU-edt" (emulations)) ("tpu-mapper.el" nil (emulations)) ("tq.el" "utility to maintain a transaction queue" (extensions)) ("trace.el" "tracing facility for Emacs Lisp functions" (tools lisp)) ("two-column.el" "minor mode for editing of two-column text" nil) ("type-break.el" "encourage rests from typing at appropriate intervals" (extensions timers)) ("uncompress.el" "auto-decompression hook for visiting .Z files" nil) ("underline.el" "insert/remove underlining (done by overstriking) in Emacs." (wp)) ("undigest.el" "digest-cracking support for the RMAIL mail reader" (mail)) ("unrmail.el" "convert Rmail files to mailbox files." (mail)) ("unused.el" "editing commands in GNU Emacs that turned out not to be used." (emulations)) ("upd-copyr.el" "update the copyright notice in a GNU Emacs Lisp file" (maint)) ("userlock.el" "handle file access contention between multiple users" (internal)) ("vc-hooks.el" "resident support for version-control" nil) ("vc.el" "drive a version-control system from within Emacs" nil) ("version.el" "record version number of Emacs." (internal)) ("vi.el" "major mode for emulating \"vi\" editor under GNU Emacs." (emulations)) ("view.el" "peruse file or buffer without editing." nil) ("vip.el" "a VI Package for GNU Emacs" (emulations)) ("viper-ex.el" nil nil) ("viper-keym.el" nil nil) ("viper-macs.el" nil nil) ("viper-mous.el" nil nil) ("viper-util.el" "Utilities used by viper.el" nil) ("viper.el" "A full-featured Vi emulator for GNU Emacs 19 and XEmacs 19," nil) ("vms-patch.el" "override parts of files.el for VMS." (vms)) ("vms-pmail.el" "use Emacs as the editor within VMS mail." (vms)) ("vmsproc.el" "run asynchronous VMS subprocesses under Emacs" (vms)) ("vmsx.el" "run asynchronous VMS subprocesses under Emacs" (vms)) ("vt-control.el" "Common VTxxx control functions" (terminals)) ("vt100-led.el" "functions for LED control on VT-100 terminals & clones." (hardware)) ("window.el" "GNU Emacs window commands aside from those written in C." nil) ("winnt.el" nil nil) ("ws-mode.el" "WordStar emulation mode for GNU Emacs" (emulations)) ("x-apollo.el" "Apollo support functions" nil) ("x-menu.el" "menu support for X " nil) ("xscheme.el" "run Scheme under Emacs" (languages lisp)) ("yow.el" "quote random zippyisms" (games)) ("browse-url.el" "ask a WWW browser to load a URL" (hypertext)) ("cal-chinese.el" "calendar functions for the Chinese calendar." (calendar)) ("cal-coptic.el" "calendar functions for the Coptic/Ethiopic calendars." (calendar)) ("cal-hebrew.el" "calendar functions for the Hebrew calendar." (calendar)) ("cal-islamic.el" "calendar functions for the Islamic calendar." (calendar)) ("cal-iso.el" "calendar functions for the ISO calendar." (calendar)) ("cal-julian.el" "calendar functions for the Julian calendar." (calendar)) ("cal-move.el" "calendar functions for movement in the calendar" (calendar)) ("cal-tex.el" "calendar functions for printing calendars with LaTeX." (calendar)) ("cc-compat.el" "cc-mode compatibility with c-mode.el confusion" (c languages oop)) ("copyright.el" "update the copyright notice in current buffer" (maint tools)) ("diary.el" "diary functions." (calendar)) ("ediff-hook.el" "setup for Ediff's menus and autoloads" nil) ("ediff-meta.el" "support for multi-file/multi-buffer processing in Ediff" nil) ("executable.el" "base functionality for executable interpreter scripts" (languages unix)) ("goto-addr.el" "click to browse URL or to send to e-mail address" (mh-e www mouse mail)) ("iso02-acc.el" "electric accent keys for Eastern Europe (ISO latin2)" nil) ("iso02-syn.el" "set up case-conversion and syntax tables for ISO 8859-2" (i18n)) ("morse.el" "Convert text to morse code and back." nil) ("pc-select.el" "emulate mark, cut, copy and paste from motif" nil) ("site-load.el" nil nil) ("site-start.el" nil nil) ("solitaire.el" "game of solitaire in Emacs Lisp" (games)) ("subdirs.el" nil nil) ("uniquify.el" "unique buffer names dependent on pathname" nil) ("xt-mouse.el" "Support the mouse when emacs run in an xterm." (mouse terminals)) )) (provide 'finder-inf) ;;; finder-inf.el ends here emacs-19.30/lisp/finder.el100444 12120 1 22574 6053400300 13660 0ustar rmsdaemon;;; finder.el --- topic & keyword-based code finder ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Created: 16 Jun 1992 ;; Version: 1.0 ;; Keywords: help ;; 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 mode uses the Keywords library header to provide code-finding ;; services by keyword. ;; ;; Things to do: ;; 1. Support multiple keywords per search. This could be extremely hairy; ;; there doesn't seem to be any way to get completing-read to exit on ;; an EOL with no substring pending, which is what we'd want to end the loop. ;; 2. Search by string in synopsis line? ;; 3. Function to check finder-package-info for unknown keywords. ;;; Code: (require 'lisp-mnt) (require 'finder-inf) (require 'picture) ;; Local variable in finder buffer. (defvar finder-headmark) (defvar finder-known-keywords '( (abbrev . "abbreviation handling, typing shortcuts, macros") (bib . "code related to the `bib' bibliography processor") (c . "support for the C language and related languages") (calendar . "calendar and time management support") (comm . "communications, networking, remote access to files") (data . "support editing files of data") (docs . "support for Emacs documentation") (emulations . "emulations of other editors") (extensions . "Emacs Lisp language extensions") (faces . "support for multiple fonts") (frames . "support for Emacs frames and window systems") (games . "games, jokes and amusements") (hardware . "support for interfacing with exotic hardware") (help . "support for on-line help systems") (hypermedia . "support for links between text or other media types") (i18n . "internationalization and alternate character-set support") (internal . "code for Emacs internals, build process, defaults") (languages . "specialized modes for editing programming languages") (lisp . "Lisp support, including Emacs Lisp") (local . "code local to your site") (maint . "maintenance aids for the Emacs development group") (mail . "modes for electronic-mail handling") (matching . "various sorts of searching and matching") (mouse . "mouse support") (news . "support for netnews reading and posting") (oop . "support for object-oriented programming") (outlines . "support for hierarchical outlining") (processes . "process, subshell, compilation, and job control support") (terminals . "support for terminal types") (tex . "code related to the TeX formatter") (tools . "programming tools") (unix . "front-ends/assistants for, or emulators of, UNIX features") (vms . "support code for vms") (wp . "word processing") )) (defvar finder-mode-map nil) (or finder-mode-map (let ((map (make-sparse-keymap))) (define-key map " " 'finder-select) (define-key map "f" 'finder-select) (define-key map "\C-m" 'finder-select) (define-key map "?" 'finder-summary) (define-key map "q" 'finder-exit) (define-key map "d" 'finder-list-keywords) (setq finder-mode-map map))) ;;; Code for regenerating the keyword list. (defvar finder-package-info nil "Assoc list mapping file names to description & keyword lists.") (defun finder-compile-keywords (&rest dirs) "Regenerate the keywords association list into the file `finder-inf.el'. Optional arguments are a list of Emacs Lisp directories to compile from; no arguments compiles from `load-path'." (save-excursion (let ((processed nil)) (find-file "finder-inf.el") (erase-buffer) (insert ";;; finder-inf.el --- keyword-to-package mapping\n") (insert ";; Keywords: help\n") (insert ";;; Commentary:\n") (insert ";; Don't edit this file. It's generated by finder.el\n\n") (insert ";;; Code:\n") (insert "\n(setq finder-package-info '(\n") (mapcar (function (lambda (d) (mapcar (function (lambda (f) (if (and (string-match "^[^=].*\\.el$" f) (not (member f processed))) (let (summary keystart keywords) (setq processed (cons f processed)) (save-excursion (set-buffer (get-buffer-create "*finder-scratch*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert-file-contents (concat (file-name-as-directory (or d ".")) f)) (setq summary (lm-synopsis)) (setq keywords (lm-keywords))) (insert (format " (\"%s\"\n " f)) (prin1 summary (current-buffer)) (insert "\n ") (setq keystart (point)) (insert (if keywords (format "(%s)" keywords) "nil") ")\n") (subst-char-in-region keystart (point) ?, ? ) ) ))) (directory-files (or d "."))) )) (or dirs load-path)) (insert "))\n\n(provide 'finder-inf)\n\n;;; finder-inf.el ends here\n") (kill-buffer "*finder-scratch*") (eval-current-buffer) ;; So we get the new keyword list immediately (basic-save-buffer) ))) ;;; Now the retrieval code (defun finder-list-keywords () "Display descriptions of the keywords in the Finder buffer." (interactive) (setq buffer-read-only nil) (erase-buffer) (mapcar (function (lambda (assoc) (let ((keyword (car assoc))) (insert (symbol-name keyword)) (insert-at-column 14 (concat (cdr assoc) "\n")) (cons (symbol-name keyword) keyword)))) finder-known-keywords) (goto-char (point-min)) (setq finder-headmark (point)) (setq buffer-read-only t) (set-buffer-modified-p nil) (balance-windows) (finder-summary)) (defun finder-list-matches (key) (setq buffer-read-only nil) (erase-buffer) (let ((id (intern key))) (insert "The following packages match the keyword `" key "':\n\n") (setq finder-headmark (point)) (mapcar (function (lambda (x) (if (memq id (car (cdr (cdr x)))) (progn (insert (car x)) (insert-at-column 16 (concat (car (cdr x)) "\n")) )) )) finder-package-info) (goto-char (point-min)) (forward-line) (setq buffer-read-only t) (set-buffer-modified-p nil) (shrink-window-if-larger-than-buffer) (finder-summary))) ;; Search for a file named FILE the same way `load' would search. (defun finder-find-library (file) (if (file-name-absolute-p file) file (let ((dirs load-path) found) (while (and dirs (not found)) (if (file-exists-p (expand-file-name (concat file ".el") (car dirs))) (setq found (expand-file-name file (car dirs))) (if (file-exists-p (expand-file-name file (car dirs))) (setq found (expand-file-name file (car dirs))))) (setq dirs (cdr dirs))) found))) (defun finder-commentary (file) (interactive) (let* ((str (lm-commentary (finder-find-library file)))) (if (null str) (error "Can't find any Commentary section")) (pop-to-buffer "*Finder*") (setq buffer-read-only nil) (erase-buffer) (insert str) (goto-char (point-min)) (delete-blank-lines) (goto-char (point-max)) (delete-blank-lines) (goto-char (point-min)) (while (re-search-forward "^;+ ?" nil t) (replace-match "" nil nil)) (goto-char (point-min)) (setq buffer-read-only t) (set-buffer-modified-p nil) (shrink-window-if-larger-than-buffer) (finder-summary) )) (defun finder-current-item () (if (and finder-headmark (< (point) finder-headmark)) (error "No keyword or filename on this line") (save-excursion (beginning-of-line) (current-word)))) (defun finder-select () (interactive) (let ((key (finder-current-item))) (if (string-match "\\.el$" key) (finder-commentary key) (finder-list-matches key)))) (defun finder-by-keyword () "Find packages matching a given keyword." (interactive) (finder-mode) (finder-list-keywords)) (defun finder-mode () "Major mode for browsing package documentation. \\ \\[finder-select] more help for the item on the current line \\[finder-exit] exit Finder mode and kill the Finder buffer. " (interactive) (pop-to-buffer "*Finder*") (setq buffer-read-only nil) (erase-buffer) (use-local-map finder-mode-map) (set-syntax-table emacs-lisp-mode-syntax-table) (setq mode-name "Finder") (setq major-mode 'finder-mode) (make-local-variable 'finder-headmark) (setq finder-headmark nil) ) (defun finder-summary () "Summarize basic Finder commands." (interactive) (message (substitute-command-keys "\\\\[finder-select] = select, \\[finder-list-keywords] = to finder directory, \\[finder-exit] = quit, \\[finder-summary] = help"))) (defun finder-exit () "Exit Finder mode and kill the buffer" (interactive) (delete-window) (kill-buffer "*Finder*")) (provide 'finder) ;;; finder.el ends here emacs-19.30/lisp/float-sup.el100444 12120 1 4132 5257335254 14315 0ustar rmsdaemon;;; float-sup.el --- detect absence of floating-point support in Emacs runtime ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. ;; Maintainer: FSF ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;; Provide a meaningful error message if we are running on ;; bare (non-float) emacs. ;; Can't test for 'floatp since that may be defined by float-imitation ;; packages like float.el in this very directory. (if (fboundp 'atan) nil (error "Floating point was disabled at compile time")) ;; provide an easy hook to tell if we are running with floats or not. ;; define pi and e via math-lib calls. (much less prone to killer typos.) (defconst pi (* 4 (atan 1)) "The value of Pi (3.1415926...)") (defconst e (exp 1) "The value of e (2.7182818...)") ;; Careful when editing this file ... typos here will be hard to spot. ;; (defconst pi 3.14159265358979323846264338327 ;; "The value of Pi (3.14159265358979323846264338327...)") (defconst degrees-to-radians (/ pi 180.0) "Degrees to radian conversion constant") (defconst radians-to-degrees (/ 180.0 pi) "Radian to degree conversion constant") ;; these expand to a single multiply by a float when byte compiled (defmacro degrees-to-radians (x) "Convert ARG from degrees to radians." (list '* (/ pi 180.0) x)) (defmacro radians-to-degrees (x) "Convert ARG from radians to degrees." (list '* (/ 180.0 pi) x)) (provide 'lisp-float-type) ;;; float-sup.el ends here emacs-19.30/lisp/float.el100444 13437 1 35533 5405344024 13663 0ustar jimbdaemon;;; float.el --- floating point arithmetic package. ;; Copyright (C) 1986 Free Software Foundation, Inc. ;; Author: Bill Rosenblatt ;; Maintainer: FSF ;; Keywords: extensions ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 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: ;; Floating point numbers are represented by dot-pairs (mant . exp) ;; where mant is the 24-bit signed integral mantissa and exp is the ;; base 2 exponent. ;; ;; Emacs LISP supports a 24-bit signed integer data type, which has a ;; range of -(2**23) to +(2**23)-1, or -8388608 to 8388607 decimal. ;; This gives six significant decimal digit accuracy. Exponents can ;; be anything in the range -(2**23) to +(2**23)-1. ;; ;; User interface: ;; function f converts from integer to floating point ;; function string-to-float converts from string to floating point ;; function fint converts a floating point to integer (with truncation) ;; function float-to-string converts from floating point to string ;; ;; Caveats: ;; - Exponents outside of the range of +/-100 or so will cause certain ;; functions (especially conversion routines) to take forever. ;; - Very little checking is done for fixed point overflow/underflow. ;; - No checking is done for over/underflow of the exponent ;; (hardly necessary when exponent can be 2**23). ;; ;; ;; Bill Rosenblatt ;; June 20, 1986 ;; ;;; Code: ;; fundamental implementation constants (defconst exp-base 2 "Base of exponent in this floating point representation.") (defconst mantissa-bits 24 "Number of significant bits in this floating point representation.") (defconst decimal-digits 6 "Number of decimal digits expected to be accurate.") (defconst expt-digits 2 "Maximum permitted digits in a scientific notation exponent.") ;; other constants (defconst maxbit (1- mantissa-bits) "Number of highest bit") (defconst mantissa-maxval (1- (ash 1 maxbit)) "Maximum permissible value of mantissa") (defconst mantissa-minval (ash 1 maxbit) "Minimum permissible value of mantissa") (defconst floating-point-regexp "^[ \t]*\\(-?\\)\\([0-9]*\\)\ \\(\\.\\([0-9]*\\)\\|\\)\ \\(\\(\\([Ee]\\)\\(-?\\)\\([0-9][0-9]*\\)\\)\\|\\)[ \t]*$" "Regular expression to match floating point numbers. Extract matches: 1 - minus sign 2 - integer part 4 - fractional part 8 - minus sign for power of ten 9 - power of ten ") (defconst high-bit-mask (ash 1 maxbit) "Masks all bits except the high-order (sign) bit.") (defconst second-bit-mask (ash 1 (1- maxbit)) "Masks all bits except the highest-order magnitude bit") ;; various useful floating point constants (setq _f0 '(0 . 1)) (setq _f1/2 '(4194304 . -23)) (setq _f1 '(4194304 . -22)) (setq _f10 '(5242880 . -19)) ;; support for decimal conversion routines (setq powers-of-10 (make-vector (1+ decimal-digits) _f1)) (aset powers-of-10 1 _f10) (aset powers-of-10 2 '(6553600 . -16)) (aset powers-of-10 3 '(8192000 . -13)) (aset powers-of-10 4 '(5120000 . -9)) (aset powers-of-10 5 '(6400000 . -6)) (aset powers-of-10 6 '(8000000 . -3)) (setq all-decimal-digs-minval (aref powers-of-10 (1- decimal-digits)) highest-power-of-10 (aref powers-of-10 decimal-digits)) (defun fashl (fnum) ; floating-point arithmetic shift left (cons (ash (car fnum) 1) (1- (cdr fnum)))) (defun fashr (fnum) ; floating point arithmetic shift right (cons (ash (car fnum) -1) (1+ (cdr fnum)))) (defun normalize (fnum) (if (> (car fnum) 0) ; make sure next-to-highest bit is set (while (zerop (logand (car fnum) second-bit-mask)) (setq fnum (fashl fnum))) (if (< (car fnum) 0) ; make sure highest bit is set (while (zerop (logand (car fnum) high-bit-mask)) (setq fnum (fashl fnum))) (setq fnum _f0))) ; "standard 0" fnum) (defun abs (n) ; integer absolute value (if (>= n 0) n (- n))) (defun fabs (fnum) ; re-normalize after taking abs value (normalize (cons (abs (car fnum)) (cdr fnum)))) (defun xor (a b) ; logical exclusive or (and (or a b) (not (and a b)))) (defun same-sign (a b) ; two f-p numbers have same sign? (not (xor (natnump (car a)) (natnump (car b))))) (defun extract-match (str i) ; used after string-match (condition-case () (substring str (match-beginning i) (match-end i)) (error ""))) ;; support for the multiplication function (setq halfword-bits (/ mantissa-bits 2) ; bits in a halfword masklo (1- (ash 1 halfword-bits)) ; isolate the lower halfword maskhi (lognot masklo) ; isolate the upper halfword round-limit (ash 1 (/ halfword-bits 2))) (defun hihalf (n) ; return high halfword, shifted down (ash (logand n maskhi) (- halfword-bits))) (defun lohalf (n) ; return low halfword (logand n masklo)) ;; Visible functions ;; Arithmetic functions (defun f+ (a1 a2) "Returns the sum of two floating point numbers." (let ((f1 (fmax a1 a2)) (f2 (fmin a1 a2))) (if (same-sign a1 a2) (setq f1 (fashr f1) ; shift right to avoid overflow f2 (fashr f2))) (normalize (cons (+ (car f1) (ash (car f2) (- (cdr f2) (cdr f1)))) (cdr f1))))) (defun f- (a1 &optional a2) ; unary or binary minus "Returns the difference of two floating point numbers." (if a2 (f+ a1 (f- a2)) (normalize (cons (- (car a1)) (cdr a1))))) (defun f* (a1 a2) ; multiply in halfword chunks "Returns the product of two floating point numbers." (let* ((i1 (car (fabs a1))) (i2 (car (fabs a2))) (sign (not (same-sign a1 a2))) (prodlo (+ (hihalf (* (lohalf i1) (lohalf i2))) (lohalf (* (hihalf i1) (lohalf i2))) (lohalf (* (lohalf i1) (hihalf i2))))) (prodhi (+ (* (hihalf i1) (hihalf i2)) (hihalf (* (hihalf i1) (lohalf i2))) (hihalf (* (lohalf i1) (hihalf i2))) (hihalf prodlo)))) (if (> (lohalf prodlo) round-limit) (setq prodhi (1+ prodhi))) ; round off truncated bits (normalize (cons (if sign (- prodhi) prodhi) (+ (cdr (fabs a1)) (cdr (fabs a2)) mantissa-bits))))) (defun f/ (a1 a2) ; SLOW subtract-and-shift algorithm "Returns the quotient of two floating point numbers." (if (zerop (car a2)) ; if divide by 0 (signal 'arith-error (list "attempt to divide by zero" a1 a2)) (let ((bits (1- maxbit)) (quotient 0) (dividend (car (fabs a1))) (divisor (car (fabs a2))) (sign (not (same-sign a1 a2)))) (while (natnump bits) (if (< (- dividend divisor) 0) (setq quotient (ash quotient 1)) (setq quotient (1+ (ash quotient 1)) dividend (- dividend divisor))) (setq dividend (ash dividend 1) bits (1- bits))) (normalize (cons (if sign (- quotient) quotient) (- (cdr (fabs a1)) (cdr (fabs a2)) (1- maxbit))))))) (defun f% (a1 a2) "Returns the remainder of first floating point number divided by second." (f- a1 (f* (ftrunc (f/ a1 a2)) a2))) ;; Comparison functions (defun f= (a1 a2) "Returns t if two floating point numbers are equal, nil otherwise." (equal a1 a2)) (defun f> (a1 a2) "Returns t if first floating point number is greater than second, nil otherwise." (cond ((and (natnump (car a1)) (< (car a2) 0)) t) ; a1 nonnegative, a2 negative ((and (> (car a1) 0) (<= (car a2) 0)) t) ; a1 positive, a2 nonpositive ((and (<= (car a1) 0) (natnump (car a2))) nil) ; a1 nonpos, a2 nonneg ((/= (cdr a1) (cdr a2)) ; same signs. exponents differ (> (cdr a1) (cdr a2))) ; compare the mantissas. (t (> (car a1) (car a2))))) ; same exponents. (defun f>= (a1 a2) "Returns t if first floating point number is greater than or equal to second, nil otherwise." (or (f> a1 a2) (f= a1 a2))) (defun f< (a1 a2) "Returns t if first floating point number is less than second, nil otherwise." (not (f>= a1 a2))) (defun f<= (a1 a2) "Returns t if first floating point number is less than or equal to second, nil otherwise." (not (f> a1 a2))) (defun f/= (a1 a2) "Returns t if first floating point number is not equal to second, nil otherwise." (not (f= a1 a2))) (defun fmin (a1 a2) "Returns the minimum of two floating point numbers." (if (f< a1 a2) a1 a2)) (defun fmax (a1 a2) "Returns the maximum of two floating point numbers." (if (f> a1 a2) a1 a2)) (defun fzerop (fnum) "Returns t if the floating point number is zero, nil otherwise." (= (car fnum) 0)) (defun floatp (fnum) "Returns t if the arg is a floating point number, nil otherwise." (and (consp fnum) (integerp (car fnum)) (integerp (cdr fnum)))) ;; Conversion routines (defun f (int) "Convert the integer argument to floating point, like a C cast operator." (normalize (cons int '0))) (defun int-to-hex-string (int) "Convert the integer argument to a C-style hexadecimal string." (let ((shiftval -20) (str "0x") (hex-chars "0123456789ABCDEF")) (while (<= shiftval 0) (setq str (concat str (char-to-string (aref hex-chars (logand (lsh int shiftval) 15)))) shiftval (+ shiftval 4))) str)) (defun ftrunc (fnum) ; truncate fractional part "Truncate the fractional part of a floating point number." (cond ((natnump (cdr fnum)) ; it's all integer, return number as is fnum) ((<= (cdr fnum) (- maxbit)) ; it's all fractional, return 0 '(0 . 1)) (t ; otherwise mask out fractional bits (let ((mant (car fnum)) (exp (cdr fnum))) (normalize (cons (if (natnump mant) ; if negative, use absolute value (ash (ash mant exp) (- exp)) (- (ash (ash (- mant) exp) (- exp)))) exp)))))) (defun fint (fnum) ; truncate and convert to integer "Convert the floating point number to integer, with truncation, like a C cast operator." (let* ((tf (ftrunc fnum)) (tint (car tf)) (texp (cdr tf))) (cond ((>= texp mantissa-bits) ; too high, return "maxint" mantissa-maxval) ((<= texp (- mantissa-bits)) ; too low, return "minint" mantissa-minval) (t ; in range (ash tint texp))))) ; shift so that exponent is 0 (defun float-to-string (fnum &optional sci) "Convert the floating point number to a decimal string. Optional second argument non-nil means use scientific notation." (let* ((value (fabs fnum)) (sign (< (car fnum) 0)) (power 0) (result 0) (str "") (temp 0) (pow10 _f1)) (if (f= fnum _f0) "0" (if (f>= value _f1) ; find largest power of 10 <= value (progn ; value >= 1, power is positive (while (f<= (setq temp (f* pow10 highest-power-of-10)) value) (setq pow10 temp power (+ power decimal-digits))) (while (f<= (setq temp (f* pow10 _f10)) value) (setq pow10 temp power (1+ power)))) (progn ; value < 1, power is negative (while (f> (setq temp (f/ pow10 highest-power-of-10)) value) (setq pow10 temp power (- power decimal-digits))) (while (f> pow10 value) (setq pow10 (f/ pow10 _f10) power (1- power))))) ; get value in range 100000 to 999999 (setq value (f* (f/ value pow10) all-decimal-digs-minval) result (ftrunc value)) (let (int) (if (f> (f- value result) _f1/2) ; round up if remainder > 0.5 (setq int (1+ (fint result))) (setq int (fint result))) (setq str (int-to-string int)) (if (>= int 1000000) (setq power (1+ power)))) (if sci ; scientific notation (setq str (concat (substring str 0 1) "." (substring str 1) "E" (int-to-string power))) ; regular decimal string (cond ((>= power (1- decimal-digits)) ; large power, append zeroes (let ((zeroes (- power decimal-digits))) (while (natnump zeroes) (setq str (concat str "0") zeroes (1- zeroes))))) ; negative power, prepend decimal ((< power 0) ; point and zeroes (let ((zeroes (- (- power) 2))) (while (natnump zeroes) (setq str (concat "0" str) zeroes (1- zeroes))) (setq str (concat "0." str)))) (t ; in range, insert decimal point (setq str (concat (substring str 0 (1+ power)) "." (substring str (1+ power))))))) (if sign ; if negative, prepend minus sign (concat "-" str) str)))) ;; string to float conversion. ;; accepts scientific notation, but ignores anything after the first two ;; digits of the exponent. (defun string-to-float (str) "Convert the string to a floating point number. Accepts a decimal string in scientific notation, with exponent preceded by either E or e. Only the six most significant digits of the integer and fractional parts are used; only the first two digits of the exponent are used. Negative signs preceding both the decimal number and the exponent are recognized." (if (string-match floating-point-regexp str 0) (let (power) (f* ; calculate the mantissa (let* ((int-subst (extract-match str 2)) (fract-subst (extract-match str 4)) (digit-string (concat int-subst fract-subst)) (mant-sign (equal (extract-match str 1) "-")) (leading-0s 0) (round-up nil)) ; get rid of leading 0's (setq power (- (length int-subst) decimal-digits)) (while (and (< leading-0s (length digit-string)) (= (aref digit-string leading-0s) ?0)) (setq leading-0s (1+ leading-0s))) (setq power (- power leading-0s) digit-string (substring digit-string leading-0s)) ; if more than 6 digits, round off (if (> (length digit-string) decimal-digits) (setq round-up (>= (aref digit-string decimal-digits) ?5) digit-string (substring digit-string 0 decimal-digits)) (setq power (+ power (- decimal-digits (length digit-string))))) ; round up and add minus sign, if necessary (f (* (+ (string-to-int digit-string) (if round-up 1 0)) (if mant-sign -1 1)))) ; calculate the exponent (power of ten) (let* ((expt-subst (extract-match str 9)) (expt-sign (equal (extract-match str 8) "-")) (expt 0) (chunks 0) (tens 0) (exponent _f1) (func 'f*)) (setq expt (+ (* (string-to-int (substring expt-subst 0 (min expt-digits (length expt-subst)))) (if expt-sign -1 1)) power)) (if (< expt 0) ; if power of 10 negative (setq expt (- expt) ; take abs val of exponent func 'f/)) ; and set up to divide, not multiply (setq chunks (/ expt decimal-digits) tens (% expt decimal-digits)) ; divide or multiply by "chunks" of 10**6 (while (> chunks 0) (setq exponent (funcall func exponent highest-power-of-10) chunks (1- chunks))) ; divide or multiply by remaining power of ten (funcall func exponent (aref powers-of-10 tens))))) _f0)) ; if invalid, return 0 (provide 'float) ;;; float.el ends here emacs-19.30/lisp/flow-ctrl.el100444 12120 1 11541 6040553057 14330 0ustar rmsdaemon;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control ;;; Copyright (C) 1990, 1991, 1994 Free Software Foundation, Inc. ;; Author Kevin Gallagher ;; Maintainer: FSF ;; Adapted-By: ESR ;; Keywords: hardware ;; 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: ;;;; Terminals that use XON/XOFF flow control can cause problems with ;;;; GNU Emacs users. This file contains Emacs Lisp code that makes it ;;;; easy for a user to deal with this problem, when using such a ;;;; terminal. ;;;; ;;;; To invoke these adjustments, a user need only invoke the function ;;;; enable-flow-control-on with a list of terminal types in his/her own ;;;; .emacs file. As arguments, give it the names of one or more terminal ;;;; types in use by that user which require flow control adjustments. ;;;; Here's an example: ;;;; ;;;; (enable-flow-control-on "vt200" "vt300" "vt101" "vt131") ;;; Portability note: This uses (getenv "TERM"), and therefore probably ;;; won't work outside of UNIX-like environments. ;;; Code: (defvar flow-control-c-s-replacement ?\034 "Character that replaces C-s, when flow control handling is enabled.") (defvar flow-control-c-q-replacement ?\036 "Character that replaces C-q, when flow control handling is enabled.") (put 'keyboard-translate-table 'char-table-extra-slots 0) ;;;###autoload (defun enable-flow-control (&optional argument) "Toggle flow control handling. When handling is enabled, user can type C-s as C-\\, and C-q as C-^. With arg, enable flow control mode if arg is positive, otherwise disable." (interactive "P") (if (if argument ;; Argument means enable if arg is positive. (<= (prefix-numeric-value argument) 0) ;; No arg means toggle. (nth 1 (current-input-mode))) (progn ;; Turn flow control off, and stop exchanging chars. (set-input-mode t nil (nth 2 (current-input-mode))) (if keyboard-translate-table (progn (aset keyboard-translate-table flow-control-c-s-replacement nil) (aset keyboard-translate-table ?\^s nil) (aset keyboard-translate-table flow-control-c-q-replacement nil) (aset keyboard-translate-table ?\^q nil)))) ;; Turn flow control on. ;; Tell emacs to pass C-s and C-q to OS. (set-input-mode nil t (nth 2 (current-input-mode))) ;; Initialize translate table, saving previous mappings, if any. (cond ((null keyboard-translate-table) (setq keyboard-translate-table (make-char-table 'keyboard-translate-table nil))) ((char-table-p keyboard-translate-table) (setq keyboard-translate-table (copy-sequence keyboard-translate-table))) (t (let ((the-table (make-char-table 'keyboard-translate-table nil))) (let ((i 0) (j (length keyboard-translate-table))) (while (< i j) (aset the-table i (elt keyboard-translate-table i)) (setq i (1+ i)))) (setq keyboard-translate-table the-table)))) ;; Swap C-s and C-\ (aset keyboard-translate-table flow-control-c-s-replacement ?\^s) (aset keyboard-translate-table ?\^s flow-control-c-s-replacement) ;; Swap C-q and C-^ (aset keyboard-translate-table flow-control-c-q-replacement ?\^q) (aset keyboard-translate-table ?\^q flow-control-c-q-replacement) (message (concat "XON/XOFF adjustment for " (getenv "TERM") ": use " (single-key-description flow-control-c-s-replacement) " for C-s, and use " (single-key-description flow-control-c-q-replacement) " for C-q")) (sleep-for 2))) ; Give user a chance to see message. ;;;###autoload (defun enable-flow-control-on (&rest losing-terminal-types) "Enable flow control if using one of a specified set of terminal types. Use `(enable-flow-control-on \"vt100\" \"h19\")' to enable flow control on VT-100 and H19 terminals. When flow control is enabled, you must type C-\\ to get the effect of a C-s, and type C-^ to get the effect of a C-q." (let ((term (getenv "TERM")) hyphend) (if term (progn ;; Strip off hyphen and what follows (while (setq hyphend (string-match "[-_][^-_]+$" term)) (setq term (substring term 0 hyphend))) (and (member term losing-terminal-types) (enable-flow-control)))))) (provide 'flow-ctrl) ;;; flow-ctrl.el ends here emacs-19.30/lisp/foldout.el100444 12120 1 47031 5567622441 14105 0ustar rmsdaemon;;; foldout.el --- Folding extensions for outline-mode and outline-minor-mode. ;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Author: Kevin Broadey ;; Created: 27 Jan 1994 ;; Version: foldout.el 1.10 dated 94/05/19 at 17:09:12 ;; Keywords: folding, outline ;; 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 file provides folding editor extensions for outline-mode and ;; outline-minor-mode buffers. What's a "folding editor"? Read on... ;; ;; Imagine you're in an outline-mode buffer and you've hidden all the text and ;; subheadings under your level-1 headings. You now want to look at the stuff ;; hidden under one of these headings. Normally you'd do C-c C-e (show-entry) ;; to expose the body or C-c C-i to expose the child (level-2) headings. ;; ;; With foldout, you do C-c C-z (foldout-zoom-subtree). This exposes the body ;; and child subheadings and narrows the buffer so that only the level-1 ;; heading, the body and the level-2 headings are visible. If you now want to ;; look under one of the level-2 headings, position the cursor on it and do C-c ;; C-z again. This exposes the level-2 body and its level-3 child subheadings ;; and narrows the buffer again. You can keep on zooming in on successive ;; subheadings as much as you like. A string in the modeline tells you how ;; deep you've gone. ;; ;; When zooming in on a heading you might only want to see the child ;; subheadings. You do this by specifying a numeric argument: C-u C-c C-z. ;; You can specify the number of levels of children too (c.f. show-children): ;; e.g. M-2 C-c C-z exposes two levels of child subheadings. Alternatively, ;; you might only be interested in the body. You do this by specifying a ;; negative argument: M-- C-c C-z. You can also cause the whole subtree to be ;; expanded, similar to C-c C-s (show-subtree), by specifying a zero argument: ;; M-0 C-c C-z. ;; ;; While you're zoomed in you can still use outline-mode's exposure and hiding ;; functions. It won't upset foldout at all. Also, since the buffer is ;; narrowed, "global" editing actions will only affect the stuff under the ;; zoomed-in heading. This is useful for restricting changes to a particular ;; chapter or section of your document. ;; ;; You unzoom (exit) a fold by doing C-c C-x (foldout-exit-fold). This hides ;; all the text and subheadings under the top-level heading and returns you to ;; the previous view of the buffer. Specifying a numeric argument exits that ;; many folds. Specifying a zero argument exits *all* folds. ;; ;; You might want to exit a fold *without* hiding the text and subheadings. ;; You do this by specifying a negative argument. For example, M--2 C-c C-x ;; exits two folds and leaves the text and subheadings exposed. ;; ;; Foldout also provides mouse bindings for entering and exiting folds and for ;; showing and hiding text. Hold down Meta and Control, then click a mouse ;; button as follows:- ;; ;; mouse-1 (foldout-mouse-zoom) zooms in on the heading clicked on:- ;; ;; single click expose body ;; double click expose subheadings ;; triple click expose body and subheadings ;; quad click expose entire subtree ;; ;; mouse-2 (foldout-mouse-show) exposes text under the heading clicked on:- ;; ;; single click expose body ;; double click expose subheadings ;; triple click expose body and subheadings ;; quad click expose entire subtree ;; ;; mouse-3 (foldout-mouse-hide-or-exit) hides text under the heading clicked ;; on or exits the fold:- ;; ;; single click hide subtree ;; double click exit fold and hide text ;; triple click exit fold without hiding text ;; quad click exit all folds and hide text ;; ;; You can change the modifier keys used by setting `foldout-mouse-modifiers'. ;;; Installation: ;; To use foldout, put this in your .emacs:- ;; ;; (require 'foldout) ;; ;; If you don't want it loaded until you need it, try this instead:- ;; ;; (eval-after-load "outline" '(require 'foldout)) ;;; Advertisements: ;; Get out-xtra.el by Per Abrahamsen for more ;; outline-mode goodies. In particular, `outline-hide-sublevels' makes ;; setup a lot easier. ;; ;; folding.el by Jamie Lokier supports folding by ;; recognising special marker text in you file. ;; ;; c-outline.el (by me) provides outline-mode support to recognise `C' ;; statements as outline headings, so with foldout you can have a folding `C' ;; code editor without having to put in start- and end-of-fold markers. This ;; is a real winner! ;;; ChangeLog: ;; 1.10 21-Mar-94 ;; foldout.el is now part of the GNU Emacs distribution!! ;; Put in changes made by RMS to version 1.8 to keep the diffs to a minimum. ;; bugfix: numeric arg to foldout-exit-fold wasn't working - looks like I don't ;; know how to use the Common LISP `loop' macro after all, so use `while' ;; instead. ;; 1.9 15-Mar-94 ;; Didn't test that very well, did I? The change to foldout-zoom-subtree ;; affected foldout-mouse-zoom: if the heading under the `level n' one clicked ;; on was at `level n+2' then it didn't get exposed. Sorry about that! ;; 1.8 15-Mar-94 ;; Changed meaning of prefix arg to foldout-zoom-subtree. arg > 0 now means ;; "expose that many children" instead of just "expose children" so it is more ;; like `show-children' (C-c C-i). Arg of C-u on its own only shows one level ;; of children, though, so you can still zoom by doing C-u C-c C-z. ;; ;; I can't think of a good meaning for the value of a negative prefix. Any ;; suggestions? ;; ;; Added advertisement for my c-outline.el package. Now you can have a folding ;; editor for c-mode without any effort! ;; 1.7 7-Mar-94 ;; I got fed up trying to work out how many blank lines there were outside the ;; narrowed region when inside a fold. Now *all* newlines before the following ;; heading are *in* the narrowed region. Thus, if the cursor is at point-max, ;; the number of blank lines above it is the number you'll get above the next ;; heading. ;; ;; Since all newlines are now inside the narrowed region, when exiting a fold ;; add a newline at the end of the region if there isn't one so that the ;; following heading doesn't accidentally get joined to the body text. ;; ;; Bugfix: `foldout-mouse-modifiers' should be `defvar', not `defconst'. ;; ;; Use "cond" instead of "case" so that lemacs-19.9 users can use the mouse. ;; ;; Improve "Commentary" entry on using the mouse. ;; ;; Add "Installation" keyword. ;; 1.6 3-Mar-94 ;; Add mouse support functions foldout-mouse-zoom, foldout-mouse-show, ;; foldout-mouse-hide-or-exit. ;; 1.5 11-Feb-94 ;; Rename `foldout-enter-subtree' to `foldout-zoom-subtree' and change ;; keystroke from C-g to C-z. This is more mnemonic and leaves C-g alone, as ;; users expect this to cancel the current key sequence. ;; ;; Added better commentary at the request of RMS. Added stuff to comply with ;; the lisp-mnt.el conventions. Added instructions on how best to load the ;; package. ;; 1.4 2-Feb-94 ;; Bugfix: end-of-fold marking was wrong:- ;; ;; End of narrowed region should be one character on from ;; (outline-end-of-subtree) so it includes the end-of-line at the end of the ;; last line of the subtree. ;; ;; End-of-fold marker should be outside the narrowed region so text inserted ;; at the end of the region goes before the marker. Need to make a special ;; case for end-of-buffer because it is impossible to set a marker that will ;; follow eob. Bummer. ;; 1.3 28-Jan-94 ;; Changed `foldout-zoom-subtree'. A zero arg now makes it expose the entire ;; subtree on entering the fold. As before, < 0 shows only the body and > 0 ;; shows only the subheadings. ;; 1.2 28-Jan-94 ;; Fixed a dumb bug - didn't make `foldout-modeline-string' buffer-local :-( ;; ;; Changed `foldout-exit-fold' to use prefix arg to say how many folds to exit. ;; Negative arg means exit but don't hide text. Zero arg means exit all folds. ;; ;; Added `foldout-inhibit-key-bindings' to inhibit key bindings. ;; 1.1 27-Jan-94 ;; Released to the net. Inspired by a question in gnu.emacs.help from ;; Jason D Lohn . ;;; Code: (require 'outline) ;; something has gone very wrong if outline-minor-mode isn't bound now. (if (not (boundp 'outline-minor-mode)) (error "Can't find outline-minor-mode")) (defconst foldout-fold-list nil "List of start and end markers for the folds currently entered. An end marker of NIL means the fold ends after (point-max).") (make-variable-buffer-local 'foldout-fold-list) (defconst foldout-modeline-string nil "Modeline string announcing that we are in an outline fold.") (make-variable-buffer-local 'foldout-modeline-string) ;; put our minor mode string immediately following outline-minor-mode's (or (assq 'foldout-modeline-string minor-mode-alist) (let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist) minor-mode-alist)) (foldout-entry '((foldout-modeline-string foldout-modeline-string)))) ;; something's wrong with outline if we can't find it (if (null outl-entry) (error "Can't find outline-minor-mode in minor-mode-alist")) ;; slip our fold announcement into the list (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))) )) (defun foldout-zoom-subtree (&optional exposure) "Open the subtree under the current heading and narrow to it. Normally the body and the immediate subheadings are exposed, but optional arg EXPOSURE \(interactively with prefix arg\) changes this:- EXPOSURE > 0 exposes n levels of subheadings (c.f. show-children) EXPOSURE < 0 exposes only the body EXPOSURE = 0 exposes the entire subtree" (interactive "P") (save-excursion (widen) (outline-back-to-heading) (let* ((exposure-value (prefix-numeric-value exposure)) (start (point)) (start-marker (point-marker)) (end (progn (outline-end-of-subtree) (skip-chars-forward "\n\^M") (point))) ;; I need a marker that will follow the end of the region even when ;; text is inserted right at the end. Text gets inserted *after* ;; markers, so I need it at end+1. Unfortunately I can't set a ;; marker at (point-max)+1, so I use NIL to mean the region ends at ;; (point-max). (end-marker (if (eobp) nil (set-marker (make-marker) (1+ end)))) ) ;; narrow to this subtree (narrow-to-region start end) ;; show the body and/or subheadings for this heading (goto-char start) (cond ((null exposure) (show-entry) (show-children)) ((< exposure-value 0) (show-entry)) ((consp exposure) (show-children)) ((> exposure-value 0) (show-children exposure-value)) (t (show-subtree)) ) ;; save the location of the fold we are entering (setq foldout-fold-list (cons (cons start-marker end-marker) foldout-fold-list)) ;; update the modeline (foldout-update-modeline) ))) (defun foldout-exit-fold (&optional num-folds) "Return to the ARG'th enclosing fold view. With ARG = 0 exit all folds. Normally causes exited folds to be hidden, but with ARG < 0, -ARG folds are exited and text is left visible." (interactive "p") (let (start-marker end-marker (hide-fold t)) ;; check there are some folds to leave (if (null foldout-fold-list) (error "Not in a fold!")) (cond ;; catch a request to leave all folds ((zerop num-folds) (setq num-folds (length foldout-fold-list))) ;; have we been told not to hide the fold? ((< num-folds 0) (setq hide-fold nil num-folds (- num-folds))) ) ;; limit the number of folds if we've been told to exit too many (setq num-folds (min num-folds (length foldout-fold-list))) ;; exit the folds (widen) (while (not (zerop num-folds)) ;; get the fold at the top of the stack (setq start-marker (car (car foldout-fold-list)) end-marker (cdr (car foldout-fold-list)) foldout-fold-list (cdr foldout-fold-list) num-folds (1- num-folds)) ;; Make sure there is a newline at the end of this fold, ;; otherwise the following heading will get joined to the body ;; text. (if end-marker (progn (goto-char end-marker) (forward-char -1) (or (memq (preceding-char) '(?\n ?\^M)) (insert ?\n)))) ;; If this is the last fold to exit, hide the text unless we've ;; been told not to. Note that at the moment point is at the ;; beginning of the following heading if there is one. ;; Also, make sure that the newline before the following heading ;; is \n otherwise it will be hidden. If there is a newline ;; before this one, make it visible too so we do the same as ;; outline.el and leave a blank line before the heading. (if (zerop num-folds) (let ((beginning-of-heading (point)) (end-of-subtree (if end-marker (progn (forward-char -1) (if (memq (preceding-char) '(?\n ?\^M)) (forward-char -1)) (point)) (point-max)))) ;; hide the subtree (if hide-fold (outline-flag-region start-marker end-of-subtree ?\^M)) ;; make sure the next heading is exposed (if end-marker (outline-flag-region end-of-subtree beginning-of-heading ?\n)) )) ;; zap the markers so they don't slow down editing (set-marker start-marker nil) (if end-marker (set-marker end-marker nil)) ) ;; narrow to the enclosing fold if there is one (if foldout-fold-list (progn (setq start-marker (car (car foldout-fold-list)) end-marker (cdr (car foldout-fold-list))) (narrow-to-region start-marker (if end-marker (1- (marker-position end-marker)) (point-max))) )) (recenter) ;; update the modeline (foldout-update-modeline) )) (defun foldout-update-modeline () "Set the modeline string to indicate our fold depth." (let ((depth (length foldout-fold-list))) (setq foldout-modeline-string (cond ;; if we're not in a fold, keep quiet ((zerop depth) nil) ;; in outline-minor-mode we're after "Outl:xx" in the modeline (outline-minor-mode (format ":%d" depth)) ;; otherwise just announce the depth (I guess we're in outline-mode) ((= depth 1) " Inside 1 fold") (t (format " Inside %d folds" depth)) )))) (defun foldout-mouse-zoom (event) "Zoom in on the heading clicked on. How much is exposed by the zoom depends on the number of mouse clicks:- 1 expose body 2 expose subheadings 3 expose body and subheadings 4 expose entire subtree" (interactive "@e") ;; swallow intervening mouse events so we only get the final click-count. (setq event (foldout-mouse-swallow-events event)) ;; go to the heading clicked on (foldout-mouse-goto-heading event) ;; zoom away (foldout-zoom-subtree (let ((nclicks (event-click-count event))) (cond ((= nclicks 1) -1) ; body only ((= nclicks 2) '(1)) ; subheadings only ((= nclicks 3) nil) ; body and subheadings (t 0))))) ; entire subtree (defun foldout-mouse-show (event) "Show what is hidden under the heading clicked on. What gets exposed depends on the number of mouse clicks:- 1 expose body 2 expose subheadings 3 expose body and subheadings 4 expose entire subtree" (interactive "@e") ;; swallow intervening mouse events so we only get the final click-count. (setq event (foldout-mouse-swallow-events event)) ;; expose the text (foldout-mouse-goto-heading event) (let ((nclicks (event-click-count event))) (cond ((= nclicks 1) (show-entry)) ((= nclicks 2) (show-children)) ((= nclicks 3) (show-entry) (show-children)) (t (show-subtree))))) (defun foldout-mouse-hide-or-exit (event) "Hide the subtree under the heading clicked on, or exit a fold. What happens depends on the number of mouse clicks:- 1 hide subtree 2 exit fold and hide text 3 exit fold without hiding text 4 exit all folds and hide text" (interactive "@e") ;; swallow intervening mouse events so we only get the final click-count. (setq event (foldout-mouse-swallow-events event)) ;; hide or exit (let ((nclicks (event-click-count event))) (if (= nclicks 1) (progn (foldout-mouse-goto-heading event) (hide-subtree)) (foldout-exit-fold (cond ((= nclicks 2) 1) ; exit and hide ((= nclicks 3) -1) ; exit don't hide (t 0)))))) ; exit all (defun foldout-mouse-swallow-events (event) "Swallow intervening mouse events so we only get the final click-count. Signal an error if the final event isn't the same type as the first one." (let ((initial-event-type (event-basic-type event))) (while (null (sit-for 0 double-click-time 'nodisplay)) (setq event (read-event))) (or (eq initial-event-type (event-basic-type event)) (error ""))) event) (defun foldout-mouse-goto-heading (event) "Go to the heading where the mouse event started. Signal an error if the event didn't occur on a heading." (goto-char (posn-point (event-start event))) (or (outline-on-heading-p) ;; outline.el sometimes treats beginning-of-buffer as a heading ;; even though outline-on-heading returns nil. (save-excursion (beginning-of-line) (bobp)) (error "Not a heading line"))) ;;; Keymaps: (defvar foldout-inhibit-key-bindings nil "Set non-NIL before loading foldout to inhibit key bindings.") (defvar foldout-mouse-modifiers '(meta control) "List of modifier keys to apply to foldout's mouse events. The default (meta control) makes foldout bind its functions to M-C-down-mouse-{1,2,3}. Valid modifiers are shift, control, meta, alt, hyper and super.") (if foldout-inhibit-key-bindings () (define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree) (define-key outline-mode-map "\C-c\C-x" 'foldout-exit-fold) (define-key outline-minor-mode-map (concat outline-minor-mode-prefix "\C-z") 'foldout-zoom-subtree) (define-key outline-minor-mode-map (concat outline-minor-mode-prefix "\C-x") 'foldout-exit-fold) (let* ((modifiers (apply 'concat (mapcar (function (lambda (modifier) (vector (cond ((eq modifier 'shift) ?S) ((eq modifier 'control) ?C) ((eq modifier 'meta) ?M) ((eq modifier 'alt) ?A) ((eq modifier 'hyper) ?H) ((eq modifier 'super) ?s) (t (error "invalid mouse modifier %s" modifier))) ?-))) foldout-mouse-modifiers))) (mouse-1 (vector (intern (concat modifiers "down-mouse-1")))) (mouse-2 (vector (intern (concat modifiers "down-mouse-2")))) (mouse-3 (vector (intern (concat modifiers "down-mouse-3"))))) (define-key outline-mode-map mouse-1 'foldout-mouse-zoom) (define-key outline-mode-map mouse-2 'foldout-mouse-show) (define-key outline-mode-map mouse-3 'foldout-mouse-hide-or-exit) (define-key outline-minor-mode-map mouse-1 'foldout-mouse-zoom) (define-key outline-minor-mode-map mouse-2 'foldout-mouse-show) (define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit) )) (provide 'foldout) ;;; foldout.el ends here emacs-19.30/lisp/font-lock.el100444 12120 1 167063 6055457637 14363 0ustar rmsdaemon;;; font-lock.el --- Electric font lock mode ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: jwz, then rms, then sm ;; 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, and so on. ;; ;; Comments will be displayed in `font-lock-comment-face'. ;; Strings will be displayed in `font-lock-string-face'. ;; Regexps are used to display selected patterns in other faces. ;; ;; To make the text you type be fontified, use M-x font-lock-mode RET. ;; When this minor mode is on, the faces of the current line are updated with ;; every insertion or deletion. ;; ;; To turn Font Lock mode on automatically, add this to your .emacs file: ;; ;; (add-hook 'emacs-lisp-mode-hook 'turn-on-font-lock) ;; ;; Fontification for a particular mode may be available in a number of levels ;; of decoration. The higher the level, the more decoration, but the more time ;; it takes to fontify. See the variable `font-lock-maximum-decoration', and ;; also the variable `font-lock-maximum-size'. ;; If you add patterns for a new mode, say foo.el's `foo-mode', say in which ;; you don't want syntactic fontification to occur, you can make Font Lock mode ;; use your regexps when turning on Font Lock by adding to `foo-mode-hook': ;; ;; (add-hook 'foo-mode-hook ;; '(lambda () (make-local-variable 'font-lock-defaults) ;; (setq font-lock-defaults '(foo-font-lock-keywords t)))) ;; ;; Nasty regexps of the form "bar\\(\\|lo\\)\\|f\\(oo\\|u\\(\\|bar\\)\\)\\|lo" ;; are made thusly: (make-regexp '("foo" "fu" "fubar" "bar" "barlo" "lo")) for ;; efficiency. See /pub/gnu/emacs/elisp-archive/functions/make-regexp.el.Z on ;; archive.cis.ohio-state.edu for this and other functions. ;; What is fontification for? You might say, "It's to make my code look nice." ;; I think it should be for adding information in the form of cues. These cues ;; should provide you with enough information to both (a) distinguish between ;; different items, and (b) identify the item meanings, without having to read ;; the items and think about it. Therefore, fontification allows you to think ;; less about, say, the structure of code, and more about, say, why the code ;; doesn't work. Or maybe it allows you to think less and drift off to sleep. ;; ;; So, here are my opinions/advice/guidelines: ;; ;; - Use the same face for the same conceptual object, across all modes. ;; i.e., (b) above, all modes that have items that can be thought of as, say, ;; keywords, should be highlighted with the same face, etc. ;; - Keep the faces distinct from each other as far as possible. ;; i.e., (a) above. ;; - Make the face attributes fit the concept as far as possible. ;; i.e., function names might be a bold colour such as blue, comments might ;; be a bright colour such as red, character strings might be brown, because, ;; err, strings are brown (that was not the reason, please believe me). ;; - Don't use a non-nil OVERRIDE unless you have a good reason. ;; Only use OVERRIDE for special things that are easy to define, such as the ;; way `...' quotes are treated in strings and comments in Emacs Lisp mode. ;; Don't use it to, say, highlight keywords in commented out code or strings. ;; - Err, that's it. ;; User variables. (defvar font-lock-verbose t "*If non-nil, means show status messages when fontifying.") ;;;###autoload (defvar font-lock-maximum-decoration nil "*If non-nil, the maximum decoration level for fontifying. If nil, use the default decoration (typically the minimum available). If t, use the maximum decoration available. If a number, use that level of decoration (or if not available the maximum). If a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL), where MAJOR-MODE is a symbol or t (meaning the default). For example: ((c++-mode . 2) (c-mode . t) (t . 1)) means use level 2 decoration for buffers in `c++-mode', the maximum decoration available for buffers in `c-mode', and level 1 decoration otherwise.") ;;;###autoload (defvar font-lock-maximum-size (* 250 1024) "*If non-nil, the maximum size for buffers for fontifying. Only buffers less than this can be fontified when Font Lock mode is turned on. If nil, means size is irrelevant. If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), where MAJOR-MODE is a symbol or t (meaning the default). For example: ((c++-mode . 256000) (c-mode . 256000) (rmail-mode . 1048576)) means that the maximum size is 250K for buffers in `c++-mode' or `c-mode', one megabyte for buffers in `rmail-mode', and size is irrelevant otherwise.") ;; Fontification variables: (defvar font-lock-comment-face 'font-lock-comment-face "Face to use for comments.") (defvar font-lock-string-face 'font-lock-string-face "Face to use for strings.") (defvar font-lock-keyword-face 'font-lock-keyword-face "Face to use for keywords.") (defvar font-lock-function-name-face 'font-lock-function-name-face "Face to use for function names.") (defvar font-lock-variable-name-face 'font-lock-variable-name-face "Face to use for variable names.") (defvar font-lock-type-face 'font-lock-type-face "Face to use for type names.") (defvar font-lock-reference-face 'font-lock-reference-face "Face to use for reference names.") (defvar font-lock-keywords nil "*A list of the keywords to highlight. Each element should be of the form: MATCHER (MATCHER . MATCH) (MATCHER . FACENAME) (MATCHER . HIGHLIGHT) (MATCHER HIGHLIGHT ...) where HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED. For highlighting single items, typically only MATCH-HIGHLIGHT is required. However, if an item or (typically) items is to be hightlighted following the instance of another item (the anchor) then MATCH-ANCHORED may be required. MATCH-HIGHLIGHT should be of the form: (MATCH FACENAME OVERRIDE LAXMATCH) Where MATCHER can be either the regexp to search for, or the function name to call to make the search (called with one argument, the limit of the search). MATCH is the subexpression of MATCHER to be highlighted. FACENAME is an expression whose value is the face name to use. FACENAME's default attributes may be defined in `font-lock-face-attributes'. OVERRIDE and LAXMATCH are flags. If OVERRIDE is t, existing fontification may be overwritten. If `keep', only parts not already fontified are highlighted. If `prepend' or `append', existing fontification is merged with the new, in which the new or existing fontification, respectively, takes precedence. If LAXMATCH is non-nil, no error is signalled if there is no MATCH in MATCHER. For example, an element of the form highlights (if not already highlighted): \"\\\\\\=\" Discrete occurrences of \"foo\" in the value of the variable `font-lock-keyword-face'. (\"fu\\\\(bar\\\\)\" . 1) Substring \"bar\" within all occurrences of \"fubar\" in the value of `font-lock-keyword-face'. (\"fubar\" . fubar-face) Occurrences of \"fubar\" in the value of `fubar-face'. (\"foo\\\\|bar\" 0 foo-bar-face t) Occurrences of either \"foo\" or \"bar\" in the value of `foo-bar-face', even if already highlighted. MATCH-ANCHORED should be of the form: (MATCHER PRE-MATCH-FORM POST-MATCH-FORM MATCH-HIGHLIGHT ...) Where MATCHER is as for MATCH-HIGHLIGHT with one exception. The limit of the search is currently guaranteed to be (no greater than) the end of the line. PRE-MATCH-FORM and POST-MATCH-FORM are evaluated before the first, and after the last, instance MATCH-ANCHORED's MATCHER is used. Therefore they can be used to initialise before, and cleanup after, MATCHER is used. Typically, PRE-MATCH-FORM is used to move to some position relative to the original MATCHER, before starting with MATCH-ANCHORED's MATCHER. POST-MATCH-FORM might be used to move, before resuming with MATCH-ANCHORED's parent's MATCHER. For example, an element of the form highlights (if not already highlighted): (\"\\\\\\=\" (0 anchor-face) (\"\\\\\\=\" nil nil (0 item-face))) Discrete occurrences of \"anchor\" in the value of `anchor-face', and subsequent discrete occurrences of \"item\" (on the same line) in the value of `item-face'. (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil. Therefore \"item\" is initially searched for starting from the end of the match of \"anchor\", and searching for subsequent instance of \"anchor\" resumes from where searching for \"item\" concluded.) Note that the MATCH-ANCHORED feature is experimental; in the future, we may replace it with other ways of providing this functionality. 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 very careful composing regexps for this list; the wrong pattern can dramatically slow things down!") (make-variable-buffer-local 'font-lock-keywords) (defvar font-lock-defaults nil "If set by a major mode, should be the defaults for Font Lock mode. The value should be like the `cdr' of an item in `font-lock-defaults-alist'.") (defvar font-lock-defaults-alist (let (;; For C and Lisp modes we use `beginning-of-defun', rather than nil, ;; for SYNTAX-BEGIN. Thus the calculation of the cache is usually ;; faster but not infallible, so we risk mis-fontification. --sm. (c-mode-defaults '((c-font-lock-keywords c-font-lock-keywords-1 c-font-lock-keywords-2 c-font-lock-keywords-3) nil nil ((?_ . "w")) beginning-of-defun)) (c++-mode-defaults '((c++-font-lock-keywords c++-font-lock-keywords-1 c++-font-lock-keywords-2 c++-font-lock-keywords-3) nil nil ((?_ . "w") (?~ . "w")) beginning-of-defun)) (lisp-mode-defaults '((lisp-font-lock-keywords lisp-font-lock-keywords-1 lisp-font-lock-keywords-2) nil nil ((?: . "w") (?- . "w") (?* . "w") (?+ . "w") (?. . "w") (?< . "w") (?> . "w") (?= . "w") (?! . "w") (?? . "w") (?$ . "w") (?% . "w") (?_ . "w") (?& . "w") (?~ . "w") (?^ . "w") (?/ . "w")) beginning-of-defun)) (scheme-mode-defaults '(scheme-font-lock-keywords nil t ((?: . "w") (?- . "w") (?* . "w") (?+ . "w") (?. . "w") (?< . "w") (?> . "w") (?= . "w") (?! . "w") (?? . "w") (?$ . "w") (?% . "w") (?_ . "w") (?& . "w") (?~ . "w") (?^ . "w") (?/ . "w")) beginning-of-defun)) ;; For TeX modes we could use `backward-paragraph' for the same reason. (tex-mode-defaults '(tex-font-lock-keywords nil nil ((?$ . "\"")))) ) (list (cons 'bibtex-mode tex-mode-defaults) (cons 'c++-c-mode c-mode-defaults) (cons 'c++-mode c++-mode-defaults) (cons 'c-mode c-mode-defaults) (cons 'elec-c-mode c-mode-defaults) (cons 'emacs-lisp-mode lisp-mode-defaults) (cons 'inferior-scheme-mode scheme-mode-defaults) (cons 'latex-mode tex-mode-defaults) (cons 'lisp-mode lisp-mode-defaults) (cons 'lisp-interaction-mode lisp-mode-defaults) (cons 'plain-tex-mode tex-mode-defaults) (cons 'scheme-mode scheme-mode-defaults) (cons 'scheme-interaction-mode scheme-mode-defaults) (cons 'slitex-mode tex-mode-defaults) (cons 'tex-mode tex-mode-defaults))) "Alist of default major mode and Font Lock defaults. Each item should be a list of the form: (MAJOR-MODE . (KEYWORDS KEYWORDS-ONLY CASE-FOLD SYNTAX-ALIST SYNTAX-BEGIN)) where MAJOR-MODE is a symbol. KEYWORDS may be a symbol (a variable or function whose value is the keywords to use for fontification) or a list of symbols. If KEYWORDS-ONLY is non-nil, syntactic fontification (strings and comments) is not performed. If CASE-FOLD is non-nil, the case of the keywords is ignored when fontifying. If SYNTAX-ALIST is non-nil, it should be a list of cons pairs of the form (CHAR . STRING) used to set the local Font Lock syntax table, for keyword and syntactic fontification (see `modify-syntax-entry'). If SYNTAX-BEGIN is non-nil, it should be a function with no args used to move backwards outside any enclosing syntactic block, for syntactic fontification. Typical values are `beginning-of-line' (i.e., the start of the line is known to be outside a syntactic block), or `beginning-of-defun' for programming modes or `backward-paragraph' for textual modes (i.e., the mode-dependent function is known to move outside a syntactic block). If nil, the beginning of the buffer is used as a position outside of a syntactic block, in the worst case. These item elements are used by Font Lock mode to set the variables `font-lock-keywords', `font-lock-keywords-only', `font-lock-keywords-case-fold-search', `font-lock-syntax-table' and `font-lock-beginning-of-syntax-function', respectively.") (defvar font-lock-keywords-only nil "*Non-nil means Font Lock should not fontify comments or strings. This is normally set via `font-lock-defaults'.") (defvar font-lock-keywords-case-fold-search nil "*Non-nil means the patterns in `font-lock-keywords' are case-insensitive. This is normally set via `font-lock-defaults'.") (defvar font-lock-syntax-table nil "Non-nil means use this syntax table for fontifying. If this is nil, the major mode's syntax table is used. This is normally set via `font-lock-defaults'.") ;; If this is nil, we only use the beginning of the buffer if we can't use ;; `font-lock-cache-position' and `font-lock-cache-state'. (defvar font-lock-beginning-of-syntax-function nil "*Non-nil means use this function to move back outside of a syntactic block. If this is nil, the beginning of the buffer is used (in the worst case). This is normally set via `font-lock-defaults'.") ;; These record the parse state at a particular position, always the start of a ;; line. Used to make `font-lock-fontify-syntactically-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) (defvar font-lock-mode nil) ; For the modeline. (defvar font-lock-fontified nil) ; Whether we have fontified the buffer. (put 'font-lock-fontified 'permanent-local t) ;;;###autoload (defvar font-lock-mode-hook nil "Function or functions to run on entry to Font Lock mode.") ;; User functions. ;;;###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'; - Strings are displayed in `font-lock-string-face'; - Certain other expressions are displayed in other faces according to the value of the variable `font-lock-keywords'. You can enable Font Lock mode in any major mode automatically by turning on in the major mode's hook. For example, put in your ~/.emacs: (add-hook 'c-mode-hook 'turn-on-font-lock) Or for any visited file with the following in your ~/.emacs: (add-hook 'find-file-hooks 'turn-on-font-lock) The default Font Lock mode faces and their attributes are defined in the variable `font-lock-face-attributes', and Font Lock mode default settings in the variable `font-lock-defaults-alist'. You can set your own default settings for some mode, by setting a buffer local value for `font-lock-defaults', via its mode hook. Where modes support different levels of fontification, you can use the variable `font-lock-maximum-decoration' to specify which level you generally prefer. When you turn Font Lock mode on/off the buffer is fontified/defontified, though fontification occurs only if the buffer is less than `font-lock-maximum-size'. To fontify a buffer without turning on Font Lock mode, and regardless of buffer size, you can use \\[font-lock-fontify-buffer]." (interactive "P") (let ((on-p (if arg (> (prefix-numeric-value arg) 0) (not font-lock-mode))) (maximum-size (if (not (consp font-lock-maximum-size)) font-lock-maximum-size (cdr (or (assq major-mode font-lock-maximum-size) (assq t font-lock-maximum-size)))))) (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp... (setq on-p nil)) (if (not on-p) (remove-hook 'after-change-functions 'font-lock-after-change-function t) (make-local-hook 'after-change-functions) (add-hook 'after-change-functions 'font-lock-after-change-function nil t)) (set (make-local-variable 'font-lock-mode) on-p) (cond (on-p (font-lock-set-defaults) (make-local-hook 'before-revert-hook) (make-local-hook 'after-revert-hook) ;; If buffer is reverted, must clean up the state. (add-hook 'before-revert-hook 'font-lock-revert-setup nil t) (add-hook 'after-revert-hook 'font-lock-revert-cleanup nil t) (run-hooks 'font-lock-mode-hook) (cond (font-lock-fontified nil) ((or (null maximum-size) (<= (buffer-size) maximum-size)) (font-lock-fontify-buffer)) (font-lock-verbose (message "Fontifying %s... buffer too big." (buffer-name))))) (font-lock-fontified (setq font-lock-fontified nil) (remove-hook 'before-revert-hook 'font-lock-revert-setup t) (remove-hook 'after-revert-hook 'font-lock-revert-cleanup t) (font-lock-unfontify-region (point-min) (point-max)) (font-lock-thing-lock-cleanup)) (t (remove-hook 'before-revert-hook 'font-lock-revert-setup t) (remove-hook 'after-revert-hook 'font-lock-revert-cleanup t) (font-lock-thing-lock-cleanup))) (force-mode-line-update))) ;;;###autoload (defun turn-on-font-lock () "Unconditionally turn on Font Lock mode." (font-lock-mode 1)) ;;;###autoload (defun font-lock-fontify-buffer () "Fontify the current buffer the way `font-lock-mode' would." (interactive) (let ((verbose (and (or font-lock-verbose (interactive-p)) (not (zerop (buffer-size)))))) (set (make-local-variable 'font-lock-fontified) nil) (if verbose (message "Fontifying %s..." (buffer-name))) ;; Turn it on to run hooks and get the right `font-lock-keywords' etc. (or font-lock-mode (font-lock-set-defaults)) (condition-case nil (save-excursion (save-match-data (font-lock-fontify-region (point-min) (point-max) verbose) (setq font-lock-fontified t))) ;; We don't restore the old fontification, so it's best to unfontify. (quit (font-lock-unfontify-region (point-min) (point-max)))) (if verbose (message "Fontifying %s... %s." (buffer-name) (if font-lock-fontified "done" "aborted"))) (font-lock-after-fontify-buffer))) ;; Fontification functions. ;; We use this wrapper. However, `font-lock-fontify-region' used to be the ;; name used for `font-lock-fontify-syntactically-region', so a change isn't ;; back-compatible. But you shouldn't be calling these directly, should you? (defun font-lock-fontify-region (beg end &optional loudly) (let ((modified (buffer-modified-p)) (buffer-undo-list t) (inhibit-read-only t) (old-syntax-table (syntax-table)) buffer-file-name buffer-file-truename) (unwind-protect (progn ;; Use the fontification syntax table, if any. (if font-lock-syntax-table (set-syntax-table font-lock-syntax-table)) ;; Now do the fontification. (if font-lock-keywords-only (font-lock-unfontify-region beg end) (font-lock-fontify-syntactically-region beg end loudly)) (font-lock-fontify-keywords-region beg end loudly)) ;; Clean up. (set-syntax-table old-syntax-table) (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))) ;; The following must be rethought, since keywords can override fontification. ; ;; Now scan for keywords, but not if we are inside a comment now. ; (or (and (not font-lock-keywords-only) ; (let ((state (parse-partial-sexp beg end nil nil ; font-lock-cache-state))) ; (or (nth 4 state) (nth 7 state)))) ; (font-lock-fontify-keywords-region beg end)) (defun font-lock-unfontify-region (beg end) (let ((modified (buffer-modified-p)) (buffer-undo-list t) (inhibit-read-only t) buffer-file-name buffer-file-truename) (remove-text-properties beg end '(face nil)) (and (not modified) (buffer-modified-p) (set-buffer-modified-p 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 ;; Rescan between start of line from `beg' and start of line after `end'. (font-lock-fontify-region (progn (goto-char beg) (beginning-of-line) (point)) (progn (goto-char end) (forward-line 1) (point)))))) ;; Syntactic fontification functions. (defun font-lock-fontify-syntactically-region (start end &optional loudly) "Put proper face on each string and comment between START and END. START should be at the beginning of a line." (let ((synstart (if comment-start-skip (concat "\\s\"\\|" comment-start-skip) "\\s\"")) (comstart (if comment-start-skip (concat "\\s<\\|" comment-start-skip) "\\s<")) state prev prevstate) (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) (save-restriction (widen) (goto-char start) ;; ;; Find the state at the `beginning-of-line' before `start'. (if (eq start font-lock-cache-position) ;; Use the cache for the state of `start'. (setq state font-lock-cache-state) ;; Find the state of `start'. (if (null font-lock-beginning-of-syntax-function) ;; Use the state at the previous cache position, if any, or ;; otherwise calculate from `point-min'. (if (or (null font-lock-cache-position) (< start font-lock-cache-position)) (setq state (parse-partial-sexp (point-min) start)) (setq state (parse-partial-sexp font-lock-cache-position start nil nil font-lock-cache-state))) ;; Call the function to move outside any syntactic block. (funcall font-lock-beginning-of-syntax-function) (setq state (parse-partial-sexp (point) start))) ;; Cache the state and position of `start'. (setq font-lock-cache-state state font-lock-cache-position start)) ;; ;; 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))) (save-restriction (narrow-to-region (point-min) end) (condition-case nil (progn (re-search-backward comstart (point-min) 'move) (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 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 synstart end t) (progn ;; Clear out the fonts of what we skip over. (remove-text-properties prev (point) '(face nil)) ;; 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) ;; ;; We found a real string start. (let ((beg (match-beginning 0))) (while (and (re-search-forward "\\s\"" end 'move) (nth 3 (parse-partial-sexp here (point) 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))) ;; ;; Clean up. (and prev (remove-text-properties prev end '(face nil))))) ;;; Additional text property functions. ;; The following three text property functions are not generally available (and ;; it's not certain that they should be) so they are inlined for speed. ;; The case for `fillin-text-property' is simple; it may or not be generally ;; useful. (Since it is used here, it is useful in at least one place.;-) ;; However, the case for `append-text-property' and `prepend-text-property' is ;; more complicated. Should they remove duplicate property values or not? If ;; so, should the first or last duplicate item remain? Or the one that was ;; added? In our implementation, the first duplicate remains. (defsubst font-lock-fillin-text-property (start end prop value &optional object) "Fill in one property of the text from START to END. Arguments PROP and VALUE specify the property and value to put where none are already in place. Therefore existing property values are not overwritten. Optional argument OBJECT is the string or buffer containing the text." (let ((start (text-property-any start end prop nil object)) next) (while start (setq next (next-single-property-change start prop object end)) (put-text-property start next prop value object) (setq start (text-property-any next end prop nil object))))) ;; This function (from simon's unique.el) is rewritten and inlined for speed. ;(defun unique (list function) ; "Uniquify LIST, deleting elements using FUNCTION. ;Return the list with subsequent duplicate items removed by side effects. ;FUNCTION is called with an element of LIST and a list of elements from LIST, ;and should return the list of elements with occurrences of the element removed, ;i.e., a function such as `delete' or `delq'. ;This function will work even if LIST is unsorted. See also `uniq'." ; (let ((list list)) ; (while list ; (setq list (setcdr list (funcall function (car list) (cdr list)))))) ; list) (defsubst font-lock-unique (list) "Uniquify LIST, deleting elements using `delq'. Return the list with subsequent duplicate items removed by side effects." (let ((list list)) (while list (setq list (setcdr list (delq (car list) (cdr list)))))) list) ;; A generalisation of `facemenu-add-face' for any property, but without the ;; removal of inactive faces via `facemenu-discard-redundant-faces' and special ;; treatment of `default'. Uses `unique' to remove duplicate property values. (defsubst font-lock-prepend-text-property (start end prop value &optional object) "Prepend to one property of the text from START to END. Arguments PROP and VALUE specify the property and value to prepend to the value already in place. The resulting property values are always lists, and unique. Optional argument OBJECT is the string or buffer containing the text." (let ((val (if (listp value) value (list value))) next prev) (while (/= start end) (setq next (next-single-property-change start prop object end) prev (get-text-property start prop object)) (put-text-property start next prop (font-lock-unique (append val (if (listp prev) prev (list prev)))) object) (setq start next)))) (defsubst font-lock-append-text-property (start end prop value &optional object) "Append to one property of the text from START to END. Arguments PROP and VALUE specify the property and value to append to the value already in place. The resulting property values are always lists, and unique. Optional argument OBJECT is the string or buffer containing the text." (let ((val (if (listp value) value (list value))) next prev) (while (/= start end) (setq next (next-single-property-change start prop object end) prev (get-text-property start prop object)) (put-text-property start next prop (font-lock-unique (append (if (listp prev) prev (list prev)) val)) object) (setq start next)))) ;;; Regexp fontification functions. (defsubst font-lock-apply-highlight (highlight) "Apply HIGHLIGHT following a match. HIGHLIGHT should be of the form MATCH-HIGHLIGHT, see `font-lock-keywords'." (let* ((match (nth 0 highlight)) (start (match-beginning match)) (end (match-end match)) (override (nth 2 highlight))) (cond ((not start) ;; No match but we might not signal an error. (or (nth 3 highlight) (error "No match %d in highlight %S" match highlight))) ((not override) ;; Cannot override existing fontification. (or (text-property-not-all start end 'face nil) (put-text-property start end 'face (eval (nth 1 highlight))))) ((eq override t) ;; Override existing fontification. (put-text-property start end 'face (eval (nth 1 highlight)))) ((eq override 'keep) ;; Keep existing fontification. (font-lock-fillin-text-property start end 'face (eval (nth 1 highlight)))) ((eq override 'prepend) ;; Prepend to existing fontification. (font-lock-prepend-text-property start end 'face (eval (nth 1 highlight)))) ((eq override 'append) ;; Append to existing fontification. (font-lock-append-text-property start end 'face (eval (nth 1 highlight))))))) (defsubst font-lock-fontify-anchored-keywords (keywords limit) "Fontify according to KEYWORDS until LIMIT. KEYWORDS should be of the form MATCH-ANCHORED, see `font-lock-keywords'." (let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights) ;; Until we come up with a cleaner solution, we make LIMIT the end of line. (save-excursion (end-of-line) (setq limit (min limit (point)))) ;; Evaluate PRE-MATCH-FORM. (eval (nth 1 keywords)) (save-match-data ;; Find an occurrence of `matcher' before `limit'. (while (if (stringp matcher) (re-search-forward matcher limit t) (funcall matcher limit)) ;; Apply each highlight to this instance of `matcher'. (setq highlights lowdarks) (while highlights (font-lock-apply-highlight (car highlights)) (setq highlights (cdr highlights))))) ;; Evaluate POST-MATCH-FORM. (eval (nth 2 keywords)))) (defun font-lock-fontify-keywords-region (start end &optional loudly) "Fontify according to `font-lock-keywords' between START and END. START should be at the beginning of a line." (let ((case-fold-search font-lock-keywords-case-fold-search) (keywords (cdr (if (eq (car-safe font-lock-keywords) t) font-lock-keywords (font-lock-compile-keywords)))) (bufname (buffer-name)) (count 0) keyword matcher highlights) ;; ;; Fontify each item in `font-lock-keywords' from `start' to `end'. (while keywords (if loudly (message "Fontifying %s... (regexps..%s)" bufname (make-string (setq count (1+ count)) ?.))) ;; ;; Find an occurrence of `matcher' from `start' to `end'. (setq keyword (car keywords) matcher (car keyword)) (goto-char start) (while (if (stringp matcher) (re-search-forward matcher end t) (funcall matcher end)) ;; Apply each highlight to this instance of `matcher', which may be ;; specific highlights or more keywords anchored to `matcher'. (setq highlights (cdr keyword)) (while highlights (if (numberp (car (car highlights))) (font-lock-apply-highlight (car highlights)) (font-lock-fontify-anchored-keywords (car highlights) end)) (setq highlights (cdr highlights)))) (setq keywords (cdr keywords))))) ;; Various functions. ;; Turn off other related packages if they're on. I prefer a hook. --sm. ;; These explicit calls are easier to understand ;; because people know what they will do. ;; A hook is a mystery because it might do anything whatever. --rms. (defun font-lock-thing-lock-cleanup () (cond ((and (boundp 'fast-lock-mode) fast-lock-mode) (fast-lock-mode -1)) ((and (boundp 'lazy-lock-mode) lazy-lock-mode) (lazy-lock-mode -1)))) ;; Do something special for these packages after fontifying. I prefer a hook. (defun font-lock-after-fontify-buffer () (cond ((and (boundp 'fast-lock-mode) fast-lock-mode) (fast-lock-after-fontify-buffer)) ((and (boundp 'lazy-lock-mode) lazy-lock-mode) (lazy-lock-after-fontify-buffer)))) ;; If the buffer is about to be reverted, it won't be fontified afterward. (defun font-lock-revert-setup () (setq font-lock-fontified nil)) ;; If the buffer has just been reverted, normally that turns off ;; Font Lock mode. So turn the mode back on if necessary. (defalias 'font-lock-revert-cleanup 'turn-on-font-lock) (defun font-lock-compile-keywords (&optional keywords) ;; Compile `font-lock-keywords' into the form (t KEYWORD ...) where KEYWORD ;; is the (MATCHER HIGHLIGHT ...) shown in the variable's doc string. (let ((keywords (or keywords font-lock-keywords))) (setq font-lock-keywords (if (eq (car-safe keywords) t) keywords (cons t (mapcar (function (lambda (item) (cond ((nlistp item) (list item '(0 font-lock-keyword-face))) ((numberp (cdr item)) (list (car item) (list (cdr item) 'font-lock-keyword-face))) ((symbolp (cdr item)) (list (car item) (list 0 (cdr item)))) ((nlistp (nth 1 item)) (list (car item) (cdr item))) (t item)))) keywords)))))) (defun font-lock-choose-keywords (keywords level) ;; Return LEVELth element of KEYWORDS. A LEVEL of nil is equal to a ;; LEVEL of 0, a LEVEL of t is equal to (1- (length KEYWORDS)). (let ((level (if (not (consp level)) level (cdr (or (assq major-mode level) (assq t level)))))) (cond ((symbolp keywords) keywords) ((numberp level) (or (nth level keywords) (car (reverse keywords)))) ((eq level t) (car (reverse keywords))) (t (car keywords))))) (defun font-lock-set-defaults () "Set fontification defaults appropriately for this mode. Sets `font-lock-keywords', `font-lock-keywords-only', `font-lock-syntax-table', `font-lock-beginning-of-syntax-function' and `font-lock-keywords-case-fold-search' using `font-lock-defaults' (or, if nil, using `font-lock-defaults-alist') and `font-lock-maximum-decoration'." ;; Set face defaults. (font-lock-make-faces) ;; Set fontification defaults. (or font-lock-keywords (let* ((defaults (or font-lock-defaults (cdr (assq major-mode font-lock-defaults-alist)))) (keywords (font-lock-choose-keywords (nth 0 defaults) font-lock-maximum-decoration))) ;; Keywords? (setq font-lock-keywords (if (fboundp keywords) (funcall keywords) (eval keywords))) ;; Syntactic? (if (nth 1 defaults) (set (make-local-variable 'font-lock-keywords-only) t)) ;; Case fold? (if (nth 2 defaults) (set (make-local-variable 'font-lock-keywords-case-fold-search) t)) ;; Syntax table? (if (nth 3 defaults) (let ((slist (nth 3 defaults))) (set (make-local-variable 'font-lock-syntax-table) (copy-syntax-table (syntax-table))) (while slist (modify-syntax-entry (car (car slist)) (cdr (car slist)) font-lock-syntax-table) (setq slist (cdr slist))))) ;; Syntax function? (if (nth 4 defaults) (set (make-local-variable 'font-lock-beginning-of-syntax-function) (nth 4 defaults)))))) ;; Colour etc. support. (defvar font-lock-display-type nil "A symbol indicating the display Emacs is running under. The symbol should be one of `color', `grayscale' or `mono'. If Emacs guesses this display attribute wrongly, either set this variable in your `~/.emacs' or set the resource `Emacs.displayType' in your `~/.Xdefaults'. See also `font-lock-background-mode' and `font-lock-face-attributes'.") (defvar font-lock-background-mode nil "A symbol indicating the Emacs background brightness. The symbol should be one of `light' or `dark'. If Emacs guesses this frame attribute wrongly, either set this variable in your `~/.emacs' or set the resource `Emacs.backgroundMode' in your `~/.Xdefaults'. See also `font-lock-display-type' and `font-lock-face-attributes'.") (defvar font-lock-face-attributes nil "A list of default attributes to use for face attributes. Each element of the list should be of the form (FACE FOREGROUND BACKGROUND BOLD-P ITALIC-P UNDERLINE-P) where FACE should be one of the face symbols `font-lock-comment-face', `font-lock-string-face', `font-lock-keyword-face', `font-lock-type-face', `font-lock-function-name-face', `font-lock-variable-name-face', and `font-lock-reference-face'. A form for each of these face symbols should be provided in the list, but other face symbols and attributes may be given and used in highlighting. See `font-lock-keywords'. Subsequent element items should be the attributes for the corresponding Font Lock mode faces. Attributes FOREGROUND and BACKGROUND should be strings \(default if nil), while BOLD-P, ITALIC-P, and UNDERLINE-P should specify the corresponding face attributes (yes if non-nil). Emacs uses default attributes based on display type and background brightness. See variables `font-lock-display-type' and `font-lock-background-mode'. Resources can be used to over-ride these face attributes. For example, the resource `Emacs.font-lock-comment-face.attributeUnderline' can be used to specify the UNDERLINE-P attribute for face `font-lock-comment-face'.") (defun font-lock-make-faces (&optional override) "Make faces from `font-lock-face-attributes'. A default list is used if this is nil. If optional OVERRIDE is non-nil, faces that already exist are reset. See `font-lock-make-face' and `list-faces-display'." ;; We don't need to `setq' any of these variables, but the user can see what ;; is being used if we do. (if (null font-lock-display-type) (setq font-lock-display-type (let ((display-resource (x-get-resource ".displayType" "DisplayType"))) (cond (display-resource (intern (downcase display-resource))) ((x-display-color-p) 'color) ((x-display-grayscale-p) 'grayscale) (t 'mono))))) (if (null font-lock-background-mode) (setq font-lock-background-mode (let ((bg-resource (x-get-resource ".backgroundMode" "BackgroundMode")) (params (frame-parameters))) (cond (bg-resource (intern (downcase bg-resource))) ((eq system-type 'ms-dos) (if (string-match "light" (cdr (assq 'background-color params))) 'light 'dark)) ((< (apply '+ (x-color-values (cdr (assq 'background-color params)))) (/ (apply '+ (x-color-values "white")) 3)) 'dark) (t 'light))))) (if (null font-lock-face-attributes) (setq font-lock-face-attributes (let ((light-bg (eq font-lock-background-mode 'light))) (cond ((memq font-lock-display-type '(mono monochrome)) ;; Emacs 19.25's font-lock defaults: ;;'((font-lock-comment-face nil nil nil t nil) ;; (font-lock-string-face nil nil nil nil t) ;; (font-lock-keyword-face nil nil t nil nil) ;; (font-lock-function-name-face nil nil t t nil) ;; (font-lock-type-face nil nil nil t nil)) (list '(font-lock-comment-face nil nil t t nil) '(font-lock-string-face nil nil nil t nil) '(font-lock-keyword-face nil nil t nil nil) (list 'font-lock-function-name-face (cdr (assq 'background-color (frame-parameters))) (cdr (assq 'foreground-color (frame-parameters))) t nil nil) '(font-lock-variable-name-face nil nil t t nil) '(font-lock-type-face nil nil t nil t) '(font-lock-reference-face nil nil t nil t))) ((memq font-lock-display-type '(grayscale greyscale grayshade greyshade)) (list (list 'font-lock-comment-face nil (if light-bg "Gray80" "DimGray") t t nil) (list 'font-lock-string-face nil (if light-bg "Gray50" "LightGray") nil t nil) (list 'font-lock-keyword-face nil (if light-bg "Gray90" "DimGray") t nil nil) (list 'font-lock-function-name-face (cdr (assq 'background-color (frame-parameters))) (cdr (assq 'foreground-color (frame-parameters))) t nil nil) (list 'font-lock-variable-name-face nil (if light-bg "Gray90" "DimGray") t t nil) (list 'font-lock-type-face nil (if light-bg "Gray80" "DimGray") t nil t) (list 'font-lock-reference-face nil (if light-bg "LightGray" "Gray50") t nil t))) (light-bg ; light colour background '((font-lock-comment-face "Firebrick") (font-lock-string-face "RosyBrown") (font-lock-keyword-face "Purple") (font-lock-function-name-face "Blue") (font-lock-variable-name-face "DarkGoldenrod") (font-lock-type-face "DarkOliveGreen") (font-lock-reference-face "CadetBlue"))) (t ; dark colour background '((font-lock-comment-face "OrangeRed") (font-lock-string-face "LightSalmon") (font-lock-keyword-face "LightSteelBlue") (font-lock-function-name-face "LightSkyBlue") (font-lock-variable-name-face "LightGoldenrod") (font-lock-type-face "PaleGreen") (font-lock-reference-face "Aquamarine"))))))) ;; Now make the faces if we have to. (mapcar (function (lambda (face-attributes) (let ((face (nth 0 face-attributes))) (cond (override ;; We can stomp all over it anyway. Get outta my face! (font-lock-make-face face-attributes)) ((and (boundp face) (facep (symbol-value face))) ;; The variable exists and is already bound to a face. nil) ((facep face) ;; We already have a face so we bind the variable to it. (set face face)) (t ;; No variable or no face. (font-lock-make-face face-attributes)))))) font-lock-face-attributes)) (defun font-lock-make-face (face-attributes) "Make a face from FACE-ATTRIBUTES. FACE-ATTRIBUTES should be like an element `font-lock-face-attributes', so that the face name is the first item in the list. A variable with the same name as the face is also set; its value is the face name." (let* ((face (nth 0 face-attributes)) (face-name (symbol-name face)) (set-p (function (lambda (face-name resource) (x-get-resource (concat face-name ".attribute" resource) (concat "Face.Attribute" resource))))) (on-p (function (lambda (face-name resource) (let ((set (funcall set-p face-name resource))) (and set (member (downcase set) '("on" "true")))))))) (make-face face) (add-to-list 'facemenu-unlisted-faces face) ;; Set attributes not set from X resources (and therefore `make-face'). (or (funcall set-p face-name "Foreground") (condition-case nil (set-face-foreground face (nth 1 face-attributes)) (error nil))) (or (funcall set-p face-name "Background") (condition-case nil (set-face-background face (nth 2 face-attributes)) (error nil))) (if (funcall set-p face-name "Bold") (and (funcall on-p face-name "Bold") (make-face-bold face nil t)) (and (nth 3 face-attributes) (make-face-bold face nil t))) (if (funcall set-p face-name "Italic") (and (funcall on-p face-name "Italic") (make-face-italic face nil t)) (and (nth 4 face-attributes) (make-face-italic face nil t))) (or (funcall set-p face-name "Underline") (set-face-underline-p face (nth 5 face-attributes))) (set face face))) ;;; Various regexp information shared by several modes. ;;; Information specific to a single mode should go in its load library. (defconst lisp-font-lock-keywords-1 (list ;; Anything not a variable or type declaration is fontified as a function. ;; It would be cleaner to allow preceding whitespace, but it would also be ;; about five times slower. (list (concat "^(\\(def\\(" ;; Variable declarations. "\\(const\\(\\|ant\\)\\|ine-key\\(\\|-after\\)\\|var\\)\\|" ;; Structure declarations. "\\(class\\|struct\\|type\\)\\|" ;; Everything else is a function declaration. "\\([^ \t\n\(\)]+\\)" "\\)\\)\\>" ;; Any whitespace and declared object. "[ \t'\(]*" "\\([^ \t\n\)]+\\)?") '(1 font-lock-keyword-face) '(8 (cond ((match-beginning 3) font-lock-variable-name-face) ((match-beginning 6) font-lock-type-face) (t font-lock-function-name-face)) nil t)) ) "Subdued level highlighting Lisp modes.") (defconst lisp-font-lock-keywords-2 (append lisp-font-lock-keywords-1 (list ;; ;; Control structures. ELisp and CLisp combined. ; (make-regexp ; '("cond" "if" "while" "let\\*?" "prog[nv12*]?" "catch" "throw" ; "save-restriction" "save-excursion" "save-window-excursion" ; "save-selected-window" "save-match-data" "unwind-protect" ; "condition-case" "track-mouse" ; "eval-after-load" "eval-and-compile" "eval-when-compile" ; "when" "unless" "do" "flet" "labels" "return" "return-from")) (cons (concat "(\\(" "\\(c\\(atch\\|ond\\(\\|ition-case\\)\\)\\|do\\|" "eval-\\(a\\(fter-load\\|nd-compile\\)\\|when-compile\\)\\|flet\\|" "if\\|l\\(abels\\|et\\*?\\)\\|prog[nv12*]?\\|return\\(\\|-from\\)\\|" "save-\\(excursion\\|match-data\\|restriction\\|selected-window\\|" "window-excursion\\)\\|t\\(hrow\\|rack-mouse\\)\\|" "un\\(less\\|wind-protect\\)\\|wh\\(en\\|ile\\)\\)" "\\)\\>") 1) ;; ;; Words inside \\[] tend to be for `substitute-command-keys'. '("\\\\\\\\\\[\\(\\sw+\\)]" 1 font-lock-reference-face prepend) ;; ;; Words inside `' tend to be symbol names. '("`\\(\\sw\\sw+\\)'" 1 font-lock-reference-face prepend) ;; ;; CLisp `:' keywords as references. '("\\<:\\sw+\\>" 0 font-lock-reference-face prepend) ;; ;; ELisp and CLisp `&' keywords as types. '("\\<\\&\\(optional\\|rest\\|whole\\)\\>" . font-lock-type-face) )) "Gaudy level highlighting for Lisp modes.") (defvar lisp-font-lock-keywords lisp-font-lock-keywords-1 "Default expressions to highlight in Lisp modes.") (defvar scheme-font-lock-keywords (eval-when-compile (list ;; ;; Declarations. Hannes Haug says ;; this works for SOS, STklos, SCOOPS, Meroon and Tiny CLOS. (list (concat "(\\(define\\(" ;; Function names. "\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)\\|" ;; Macro names, as variable names. A bit dubious, this. "\\(-syntax\\)\\|" ;; Class names. "\\(-class\\)" "\\)\\)\\>" ;; Any whitespace and declared object. "[ \t]*(?" "\\(\\sw+\\)?") '(1 font-lock-keyword-face) '(8 (cond ((match-beginning 3) font-lock-function-name-face) ((match-beginning 6) font-lock-variable-name-face) (t font-lock-type-face)) nil t)) ;; ;; Control structures. ;(make-regexp '("begin" "call-with-current-continuation" "call/cc" ; "call-with-input-file" "call-with-output-file" "case" "cond" ; "do" "else" "for-each" "if" "lambda" ; "let\\*?" "let-syntax" "letrec" "letrec-syntax" ; ;; Hannes Haug wants: ; "and" "or" "delay" ; ;; Stefan Monnier says don't bother: ; ;;"quasiquote" "quote" "unquote" "unquote-splicing" ; "map" "syntax" "syntax-rules")) (cons (concat "(\\(" "and\\|begin\\|c\\(a\\(ll\\(-with-\\(current-continuation\\|" "input-file\\|output-file\\)\\|/cc\\)\\|se\\)\\|ond\\)\\|" "d\\(elay\\|o\\)\\|else\\|for-each\\|if\\|" "l\\(ambda\\|et\\(-syntax\\|\\*?\\|rec\\(\\|-syntax\\)\\)\\)\\|" "map\\|or\\|syntax\\(\\|-rules\\)" "\\)\\>") 1) ;; ;; David Fox for SOS/STklos class specifiers. '("\\<<\\sw+>\\>" . font-lock-type-face) ;; ;; Scheme `:' keywords as references. '("\\<:\\sw+\\>" . font-lock-reference-face) )) "Default expressions to highlight in Scheme modes.") (defconst c-font-lock-keywords-1 nil "Subdued level highlighting for C modes.") (defconst c-font-lock-keywords-2 nil "Medium level highlighting for C modes.") (defconst c-font-lock-keywords-3 nil "Gaudy level highlighting for C modes.") (defconst c++-font-lock-keywords-1 nil "Subdued level highlighting for C++ modes.") (defconst c++-font-lock-keywords-2 nil "Medium level highlighting for C++ modes.") (defconst c++-font-lock-keywords-3 nil "Gaudy level highlighting for C++ modes.") (defun font-lock-match-c++-style-declaration-item-and-skip-to-next (limit) ;; Match, and move over, any declaration/definition item after point. ;; The expect syntax of an item is "word" or "word::word", possibly ending ;; with optional whitespace and a "(". Everything following the item (but ;; belonging to it) is expected to by skip-able by `forward-sexp', and items ;; are expected to be separated with a "," or ";". (if (looking-at "[ \t*&]*\\(\\sw+\\)\\(::\\(\\sw+\\)\\)?[ \t]*\\((\\)?") (save-match-data (condition-case nil (save-restriction ;; Restrict to the end of line, currently guaranteed to be LIMIT. (narrow-to-region (point-min) limit) (goto-char (match-end 1)) ;; Move over any item value, etc., to the next item. (while (not (looking-at "[ \t]*\\([,;]\\|$\\)")) (goto-char (or (scan-sexps (point) 1) (point-max)))) (goto-char (match-end 0))) (error t))))) (let ((c-keywords ; ("break" "continue" "do" "else" "for" "if" "return" "switch" "while") "break\\|continue\\|do\\|else\\|for\\|if\\|return\\|switch\\|while") (c-type-types ; ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum" ; "signed" "unsigned" "short" "long" "int" "char" "float" "double" ; "void" "volatile" "const") (concat "auto\\|c\\(har\\|onst\\)\\|double\\|e\\(num\\|xtern\\)\\|" "float\\|int\\|long\\|register\\|" "s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|typedef\\|" "un\\(ion\\|signed\\)\\|vo\\(id\\|latile\\)")) ; 6 ()s deep. (c++-keywords ; ("break" "continue" "do" "else" "for" "if" "return" "switch" "while" ; "asm" "catch" "delete" "new" "operator" "sizeof" "this" "throw" "try" ; "protected" "private" "public") (concat "asm\\|break\\|c\\(atch\\|ontinue\\)\\|d\\(elete\\|o\\)\\|" "else\\|for\\|if\\|new\\|" "p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|return\\|" "s\\(izeof\\|witch\\)\\|t\\(h\\(is\\|row\\)\\|ry\\)\\|while")) (c++-type-types ; ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum" ; "signed" "unsigned" "short" "long" "int" "char" "float" "double" ; "void" "volatile" "const" "class" "inline" "friend" "bool" ; "virtual" "complex" "template") (concat "auto\\|bool\\|c\\(har\\|lass\\|o\\(mplex\\|nst\\)\\)\\|" "double\\|e\\(num\\|xtern\\)\\|f\\(loat\\|riend\\)\\|" "in\\(line\\|t\\)\\|long\\|register\\|" "s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|" "t\\(emplate\\|ypedef\\)\\|un\\(ion\\|signed\\)\\|" "v\\(irtual\\|o\\(id\\|latile\\)\\)")) ; 11 ()s deep. ) (setq c-font-lock-keywords-1 (list ;; ;; These are all anchored at the beginning of line for speed. ;; ;; Fontify function name definitions (GNU style; without type on line). (list (concat "^\\(\\sw+\\)[ \t]*(") 1 'font-lock-function-name-face) ;; ;; Fontify filenames in #include <...> preprocessor directives as strings. '("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) ;; ;; Fontify function macro names. '("^#[ \t]*define[ \t]+\\(\\(\\sw+\\)(\\)" 2 font-lock-function-name-face) ;; ;; Fontify symbol names in #if ... defined preprocessor directives. '("^#[ \t]*if\\>" ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t))) ;; ;; Fontify otherwise as symbol names, and the preprocessor directive names. '("^\\(#[ \t]*[a-z]+\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t)) )) (setq c-font-lock-keywords-2 (append c-font-lock-keywords-1 (list ;; ;; Simple regexps for speed. ;; ;; Fontify all type specifiers. (cons (concat "\\<\\(" c-type-types "\\)\\>") 'font-lock-type-face) ;; ;; Fontify all builtin keywords (except case, default and goto; see below). (cons (concat "\\<\\(" c-keywords "\\)\\>") 'font-lock-keyword-face) ;; ;; Fontify case/goto keywords and targets, and case default/goto tags. '("\\<\\(case\\|goto\\)\\>[ \t]*\\([^ \t\n:;]+\\)?" (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) '("^[ \t]*\\(\\sw+\\)[ \t]*:" 1 font-lock-reference-face) ))) (setq c-font-lock-keywords-3 (append c-font-lock-keywords-2 ;; ;; More complicated regexps for more complete highlighting for types. ;; We still have to fontify type specifiers individually, as C is so hairy. (list ;; ;; Fontify all storage classes and type specifiers, plus their items. (list (concat "\\<\\(" c-type-types "\\)\\>" "\\([ \t*&]+\\sw+\\>\\)*") ;; Fontify each declaration item. '(font-lock-match-c++-style-declaration-item-and-skip-to-next ;; Start with point after all type specifiers. (goto-char (or (match-beginning 8) (match-end 1))) ;; Finish with point after first type specifier. (goto-char (match-end 1)) ;; Fontify as a variable or function name. (1 (if (match-beginning 4) font-lock-function-name-face font-lock-variable-name-face)))) ;; ;; Fontify structures, or typedef names, plus their items. '("\\(}\\)[ \t*]*\\sw" (font-lock-match-c++-style-declaration-item-and-skip-to-next (goto-char (match-end 1)) nil (1 (if (match-beginning 4) font-lock-function-name-face font-lock-variable-name-face)))) ;; ;; Fontify anything at beginning of line as a declaration or definition. '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*" (1 font-lock-type-face) (font-lock-match-c++-style-declaration-item-and-skip-to-next (goto-char (or (match-beginning 2) (match-end 1))) nil (1 (if (match-beginning 4) font-lock-function-name-face font-lock-variable-name-face)))) ))) (setq c++-font-lock-keywords-1 (append ;; ;; The list `c-font-lock-keywords-1' less that for function names. (cdr c-font-lock-keywords-1) ;; ;; Fontify function name definitions, possibly incorporating class name. (list '("^\\(\\sw+\\)\\(::\\(\\sw+\\)\\)?[ \t]*(" (1 (if (match-beginning 2) font-lock-type-face font-lock-function-name-face)) (3 (if (match-beginning 2) font-lock-function-name-face) nil t)) ))) (setq c++-font-lock-keywords-2 (append c++-font-lock-keywords-1 (list ;; ;; The list `c-font-lock-keywords-2' for C++ plus operator overloading. (cons (concat "\\<\\(" c++-type-types "\\)\\>") 'font-lock-type-face) ;; ;; Fontify operator function name overloading. '("\\<\\(operator\\)\\>[ \t]*\\([][)(>[ \t]*\\([^ \t\n:;]+\\)?" (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) '("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-reference-face) ;; ;; Fontify other builtin keywords. (cons (concat "\\<\\(" c++-keywords "\\)\\>") 'font-lock-keyword-face) ))) (setq c++-font-lock-keywords-3 (append c++-font-lock-keywords-2 ;; ;; More complicated regexps for more complete highlighting for types. (list ;; ;; Fontify all storage classes and type specifiers, plus their items. (list (concat "\\<\\(" c++-type-types "\\)\\>" "\\([ \t*&]+\\sw+\\>\\)*") ;; Fontify each declaration item. '(font-lock-match-c++-style-declaration-item-and-skip-to-next ;; Start with point after all type specifiers. (goto-char (or (match-beginning 13) (match-end 1))) ;; Finish with point after first type specifier. (goto-char (match-end 1)) ;; Fontify as a variable or function name. (1 (cond ((match-beginning 2) font-lock-type-face) ((match-beginning 4) font-lock-function-name-face) (t font-lock-variable-name-face))) (3 (if (match-beginning 4) font-lock-function-name-face font-lock-variable-name-face) nil t))) ;; ;; Fontify structures, or typedef names, plus their items. '("\\(}\\)[ \t*]*\\sw" (font-lock-match-c++-style-declaration-item-and-skip-to-next (goto-char (match-end 1)) nil (1 (if (match-beginning 4) font-lock-function-name-face font-lock-variable-name-face)))) ;; ;; Fontify anything at beginning of line as a declaration or definition. '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*" (1 font-lock-type-face) (font-lock-match-c++-style-declaration-item-and-skip-to-next (goto-char (or (match-beginning 2) (match-end 1))) nil (1 (cond ((match-beginning 2) font-lock-type-face) ((match-beginning 4) font-lock-function-name-face) (t font-lock-variable-name-face))) (3 (if (match-beginning 4) font-lock-function-name-face font-lock-variable-name-face) nil t))) ))) ) (defvar c-font-lock-keywords c-font-lock-keywords-1 "Default expressions to highlight in C mode.") (defvar c++-font-lock-keywords c++-font-lock-keywords-1 "Default expressions to highlight in C++ mode.") (defvar tex-font-lock-keywords ; ;; Regexps updated with help from Ulrik Dickow . ; '(("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}" ; 2 font-lock-function-name-face) ; ("\\\\\\(cite\\|label\\|pageref\\|ref\\){\\([^} \t\n]+\\)}" ; 2 font-lock-reference-face) ; ;; It seems a bit dubious to use `bold' and `italic' faces since we might ; ;; not be able to display those fonts. ; ("{\\\\bf\\([^}]+\\)}" 1 'bold keep) ; ("{\\\\\\(em\\|it\\|sl\\)\\([^}]+\\)}" 2 'italic keep) ; ("\\\\\\([a-zA-Z@]+\\|.\\)" . font-lock-keyword-face) ; ("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" 1 font-lock-function-name-face keep)) ;; Rewritten and extended for LaTeX2e by Ulrik Dickow . '(("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}" 2 font-lock-function-name-face) ("\\\\\\(cite\\|label\\|pageref\\|ref\\){\\([^} \t\n]+\\)}" 2 font-lock-reference-face) ("^[ \t]*\\\\def\\\\\\(\\(\\w\\|@\\)+\\)" 1 font-lock-function-name-face) "\\\\\\([a-zA-Z@]+\\|.\\)" ;; It seems a bit dubious to use `bold' and `italic' faces since we might ;; not be able to display those fonts. ;; LaTeX2e: \emph{This is emphasized}. ("\\\\emph{\\([^}]+\\)}" 1 'italic keep) ;; LaTeX2e: \textbf{This is bold}, \textit{...}, \textsl{...} ("\\\\text\\(\\(bf\\)\\|it\\|sl\\){\\([^}]+\\)}" 3 (if (match-beginning 2) 'bold 'italic) keep) ;; Old-style bf/em/it/sl. Stop at `\\' and un-escaped `&', for good tables. ("\\\\\\(\\(bf\\)\\|em\\|it\\|sl\\)\\>\\(\\([^}&\\]\\|\\\\[^\\]\\)+\\)" 3 (if (match-beginning 2) 'bold 'italic) keep)) "Default expressions to highlight in TeX modes.") ;; Install ourselves: (or (assq 'font-lock-mode minor-mode-alist) (setq minor-mode-alist (cons '(font-lock-mode " Font") minor-mode-alist))) ;; Provide ourselves: (provide 'font-lock) ;;; font-lock.el ends here emacs-19.30/lisp/format.el100444 22556 1 76324 6045244752 14074 0ustar erikdaemon;;; format.el --- read and save files in multiple formats ;; Copyright (c) 1994, 1995 Free Software Foundation ;; Author: Boris Goldowsky ;; 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 file defines a unified mechanism for saving & loading files stored in ;; different formats. `format-alist' contains information that directs ;; Emacs to call an encoding or decoding function when reading or writing ;; files that match certain conditions. ;; ;; When a file is visited, its format is determined by matching the beginning ;; of the file against regular expressions stored in `format-alist'. If this ;; fails, you can manually translate the buffer using `format-decode-buffer'. ;; In either case, the formats used are listed in the variable ;; `buffer-file-format', and become the default format for saving the buffer. ;; To save a buffer in a different format, change this variable, or use ;; `format-write-file'. ;; ;; Auto-save files are normally created in the same format as the visited ;; file, but the variable `auto-save-file-format' can be set to a particularly ;; fast or otherwise preferred format to be used for auto-saving (or nil to do ;; no encoding on auto-save files, but then you risk losing any ;; text-properties in the buffer). ;; ;; You can manually translate a buffer into or out of a particular format with ;; the functions `format-encode-buffer' and `format-decode-buffer'. ;; To translate just the region use the functions `format-encode-region' and ;; `format-decode-region'. ;; ;; You can define a new format by writing the encoding and decoding functions, ;; and adding an entry to `format-alist'. See enriched.el for an example of ;; how to implement a file format. There are various functions defined ;; in this file that may be useful for writing the encoding and decoding ;; functions: ;; * `format-annotate-region' and `format-deannotate-region' allow a single ;; alist of information to be used for encoding and decoding. The alist ;; defines a correspondence between strings in the file ("annotations") ;; and text-properties in the buffer. ;; * `format-replace-strings' is similarly useful for doing simple ;; string->string translations in a reversible manner. (put 'buffer-file-format 'permanent-local t) (defconst format-alist '((text/enriched "Extended MIME text/enriched format." "Content-[Tt]ype:[ \t]*text/enriched" enriched-decode enriched-encode t enriched-mode) (plain "Standard ASCII format, no text properties." ;; Plain only exists so that there is an obvious neutral choice in ;; the completion list. nil nil nil nil nil)) "List of information about understood file formats. Elements are of the form \(NAME DOC-STR REGEXP FROM-FN TO-FN MODIFY MODE-FN). NAME is a symbol, which is stored in `buffer-file-format'. DOC-STR should be a single line providing more information about the format. It is currently unused, but in the future will be shown to the user if they ask for more information. REGEXP is a regular expression to match against the beginning of the file; it should match only files in that format. FROM-FN is called to decode files in that format; it gets two args, BEGIN and END, and can make any modifications it likes, returning the new end. It must make sure that the beginning of the file no longer matches REGEXP, or else it will get called again. TO-FN is called to encode a region into that format; it is also passed BEGIN and END, and either returns a list of annotations like `write-region-annotate-functions', or modifies the region and returns the new end. MODIFY, if non-nil, means the TO-FN modifies the region. If nil, TO-FN may not make any changes and should return a list of annotations. MODE-FN, if specified, is called when visiting a file with that format.") ;;; Basic Functions (called from Lisp) (defun format-annotate-function (format from to) "Returns annotations for writing region as FORMAT. FORMAT is a symbol naming one of the formats defined in `format-alist', it must be a single symbol, not a list like `buffer-file-format'. This function works like a function on `write-region-annotate-functions': it either returns a list of annotations, or returns with a different buffer current, which contains the modified text to write. For most purposes, consider using `format-encode-region' instead." ;; This function is called by write-region (actually build-annotations) ;; for each element of buffer-file-format. (let* ((info (assq format format-alist)) (to-fn (nth 4 info)) (modify (nth 5 info))) (if to-fn (if modify ;; To-function wants to modify region. Copy to safe place. (let ((copy-buf (get-buffer-create " *Format Temp*"))) (copy-to-buffer copy-buf from to) (set-buffer copy-buf) (format-insert-annotations write-region-annotations-so-far from) (funcall to-fn (point-min) (point-max)) nil) ;; Otherwise just call function, it will return annotations. (funcall to-fn from to))))) (defun format-decode (format length &optional visit-flag) ;; This function is called by insert-file-contents whenever a file is read. "Decode text from any known FORMAT. FORMAT is a symbol appearing in `format-alist' or a list of such symbols, or nil, in which case this function tries to guess the format of the data by matching against the regular expressions in `format-alist'. After a match is found and the region decoded, the alist is searched again from the beginning for another match. Second arg LENGTH is the number of characters following point to operate on. If optional third arg VISIT-FLAG is true, set `buffer-file-format' to the list of formats used, and call any mode functions defined for those formats. Returns the new length of the decoded region. For most purposes, consider using `format-decode-region' instead." (let ((mod (buffer-modified-p)) (begin (point)) (end (+ (point) length))) (if (null format) ;; Figure out which format it is in, remember list in `format'. (let ((try format-alist)) (while try (let* ((f (car try)) (regexp (nth 2 f)) (p (point))) (if (and regexp (looking-at regexp) (< (match-end 0) (+ begin length))) (progn (setq format (cons (car f) format)) ;; Decode it (if (nth 3 f) (setq end (funcall (nth 3 f) begin end))) ;; Call visit function if required (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1)) ;; Safeguard against either of the functions changing pt. (goto-char p) ;; Rewind list to look for another format (setq try format-alist)) (setq try (cdr try)))))) ;; Deal with given format(s) (or (listp format) (setq format (list format))) (let ((do format) f) (while do (or (setq f (assq (car do) format-alist)) (error "Unknown format" (car do))) ;; Decode: (if (nth 3 f) (setq end (funcall (nth 3 f) begin end))) ;; Call visit function if required (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1)) (setq do (cdr do))))) (if visit-flag (setq buffer-file-format format)) (set-buffer-modified-p mod) ;; Return new length of region (- end begin))) ;;; ;;; Interactive functions & entry points ;;; (defun format-decode-buffer (&optional format) "Translate the buffer from some FORMAT. If the format is not specified, this function attempts to guess. `buffer-file-format' is set to the format used, and any mode-functions for the format are called." (interactive (list (format-read "Translate buffer from format (default: guess): "))) (save-excursion (goto-char (point-min)) (format-decode format (buffer-size) t))) (defun format-decode-region (from to &optional format) "Decode the region from some format. Arg FORMAT is optional; if omitted the format will be determined by looking for identifying regular expressions at the beginning of the region." (interactive (list (region-beginning) (region-end) (format-read "Translate region from format (default: guess): "))) (save-excursion (goto-char from) (format-decode format (- to from) nil))) (defun format-encode-buffer (&optional format) "Translate the buffer into FORMAT. FORMAT defaults to `buffer-file-format'. It is a symbol naming one of the formats defined in `format-alist', or a list of such symbols." (interactive (list (format-read (format "Translate buffer to format (default %s): " buffer-file-format)))) (format-encode-region (point-min) (point-max) format)) (defun format-encode-region (beg end &optional format) "Translate the region into some FORMAT. FORMAT defaults to `buffer-file-format', it is a symbol naming one of the formats defined in `format-alist', or a list of such symbols." (interactive (list (region-beginning) (region-end) (format-read (format "Translate region to format (default %s): " buffer-file-format)))) (if (null format) (setq format buffer-file-format)) (if (symbolp format) (setq format (list format))) (save-excursion (goto-char end) (let ((cur-buf (current-buffer)) (end (point-marker))) (while format (let* ((info (assq (car format) format-alist)) (to-fn (nth 4 info)) (modify (nth 5 info)) result) (if to-fn (if modify (setq end (funcall to-fn beg end)) (format-insert-annotations (funcall to-fn beg end)))) (setq format (cdr format))))))) (defun format-write-file (filename format) "Write current buffer into a FILE using some FORMAT. Makes buffer visit that file and sets the format as the default for future saves. If the buffer is already visiting a file, you can specify a directory name as FILE, to write a file of the same old name in that directory." (interactive ;; Same interactive spec as write-file, plus format question. (let* ((file (if buffer-file-name (read-file-name "Write file: " nil nil nil nil) (read-file-name "Write file: " (cdr (assq 'default-directory (buffer-local-variables))) nil nil (buffer-name)))) (fmt (format-read (format "Write file `%s' in format: " (file-name-nondirectory file))))) (list file fmt))) (setq buffer-file-format format) (write-file filename)) (defun format-find-file (filename format) "Find the file FILE using data format FORMAT. If FORMAT is nil then do not do any format conversion." (interactive ;; Same interactive spec as write-file, plus format question. (let* ((file (read-file-name "Find file: ")) (fmt (format-read (format "Read file `%s' in format: " (file-name-nondirectory file))))) (list file fmt))) (let ((format-alist nil)) (find-file filename)) (if format (format-decode-buffer format))) (defun format-insert-file (filename format &optional beg end) "Insert the contents of file FILE using data format FORMAT. If FORMAT is nil then do not do any format conversion. The optional third and fourth arguments BEG and END specify the part of the file to read. The return value is like the value of `insert-file-contents': a list (ABSOLUTE-FILE-NAME . SIZE)." (interactive ;; Same interactive spec as write-file, plus format question. (let* ((file (read-file-name "Find file: ")) (fmt (format-read (format "Read file `%s' in format: " (file-name-nondirectory file))))) (list file fmt))) (let (value size) (let ((format-alist nil)) (setq value (insert-file-contents filename nil beg end)) (setq size (nth 1 value))) (if format (setq size (format-decode size format) value (cons (car value) size))) value)) (defun format-read (&optional prompt) "Read and return the name of a format. Return value is a list, like `buffer-file-format'; it may be nil. Formats are defined in `format-alist'. Optional arg is the PROMPT to use." (let* ((table (mapcar (lambda (x) (list (symbol-name (car x)))) format-alist)) (ans (completing-read (or prompt "Format: ") table nil t))) (if (not (equal "" ans)) (list (intern ans))))) ;;; ;;; Below are some functions that may be useful in writing encoding and ;;; decoding functions for use in format-alist. ;;; (defun format-replace-strings (alist &optional reverse beg end) "Do multiple replacements on the buffer. ALIST is a list of (from . to) pairs, which should be proper arguments to `search-forward' and `replace-match' respectively. Optional 2nd arg REVERSE, if non-nil, means the pairs are (to . from), so that you can use the same list in both directions if it contains only literal strings. Optional args BEGIN and END specify a region of the buffer to operate on." (save-excursion (save-restriction (or beg (setq beg (point-min))) (if end (narrow-to-region (point-min) end)) (while alist (let ((from (if reverse (cdr (car alist)) (car (car alist)))) (to (if reverse (car (cdr alist)) (cdr (car alist))))) (goto-char beg) (while (search-forward from nil t) (goto-char (match-beginning 0)) (insert to) (set-text-properties (- (point) (length to)) (point) (text-properties-at (point))) (delete-region (point) (+ (point) (- (match-end 0) (match-beginning 0))))) (setq alist (cdr alist))))))) ;;; Some list-manipulation functions that we need. (defun format-delq-cons (cons list) "Remove the given CONS from LIST by side effect, and return the new LIST. Since CONS could be the first element of LIST, write `\(setq foo \(format-delq-cons element foo))' to be sure of changing the value of `foo'." (if (eq cons list) (cdr list) (let ((p list)) (while (not (eq (cdr p) cons)) (if (null p) (error "format-delq-cons: not an element.")) (setq p (cdr p))) ;; Now (cdr p) is the cons to delete (setcdr p (cdr cons)) list))) (defun format-make-relatively-unique (a b) "Delete common elements of lists A and B, return as pair. Compares using `equal'." (let* ((acopy (copy-sequence a)) (bcopy (copy-sequence b)) (tail acopy)) (while tail (let ((dup (member (car tail) bcopy)) (next (cdr tail))) (if dup (setq acopy (format-delq-cons tail acopy) bcopy (format-delq-cons dup bcopy))) (setq tail next))) (cons acopy bcopy))) (defun format-common-tail (a b) "Given two lists that have a common tail, return it. Compares with `equal', and returns the part of A that is equal to the equivalent part of B. If even the last items of the two are not equal, returns nil." (let ((la (length a)) (lb (length b))) ;; Make sure they are the same length (if (> la lb) (setq a (nthcdr (- la lb) a)) (setq b (nthcdr (- lb la) b)))) (while (not (equal a b)) (setq a (cdr a) b (cdr b))) a) (defun format-reorder (items order) "Arrange ITEMS to following partial ORDER. Elements of ITEMS equal to elements of ORDER will be rearranged to follow the ORDER. Unmatched items will go last." (if order (let ((item (member (car order) items))) (if item (cons (car item) (format-reorder (format-delq-cons item items) (cdr order))) (format-reorder items (cdr order)))) items)) (put 'face 'format-list-valued t) ; These text-properties take values (put 'unknown 'format-list-valued t) ; that are lists, the elements of which ; should be considered separately. ; See format-deannotate-region and ; format-annotate-region. ;;; ;;; Decoding ;;; (defun format-deannotate-region (from to translations next-fn) "Translate annotations in the region into text properties. This sets text properties between FROM to TO as directed by the TRANSLATIONS and NEXT-FN arguments. NEXT-FN is a function that searches forward from point for an annotation. It should return a list of 4 elements: \(BEGIN END NAME POSITIVE). BEGIN and END are buffer positions bounding the annotation, NAME is the name searched for in TRANSLATIONS, and POSITIVE should be non-nil if this annotation marks the beginning of a region with some property, or nil if it ends the region. NEXT-FN should return nil if there are no annotations after point. The basic format of the TRANSLATIONS argument is described in the documentation for the `format-annotate-region' function. There are some additional things to keep in mind for decoding, though: When an annotation is found, the TRANSLATIONS list is searched for a text-property name and value that corresponds to that annotation. If the text-property has several annotations associated with it, it will be used only if the other annotations are also in effect at that point. The first match found whose annotations are all present is used. The text property thus determined is set to the value over the region between the opening and closing annotations. However, if the text-property name has a non-nil `format-list-valued' property, then the value will be consed onto the surrounding value of the property, rather than replacing that value. There are some special symbols that can be used in the \"property\" slot of the TRANSLATIONS list: PARAMETER and FUNCTION \(spelled in uppercase). Annotations listed under the pseudo-property PARAMETER are considered to be arguments of the immediately surrounding annotation; the text between the opening and closing parameter annotations is deleted from the buffer but saved as a string. The surrounding annotation should be listed under the pseudo-property FUNCTION. Instead of inserting a text-property for this annotation, the function listed in the VALUE slot is called to make whatever changes are appropriate. The function's first two arguments are the START and END locations, and the rest of the arguments are any PARAMETERs found in that region. Any annotations that are found by NEXT-FN but not defined by TRANSLATIONS are saved as values of the `unknown' text-property \(which is list-valued). The TRANSLATIONS list should usually contain an entry of the form \(unknown \(nil format-annotate-value)) to write these unknown annotations back into the file." (save-excursion (save-restriction (narrow-to-region (point-min) to) (goto-char from) (let (next open-ans todo loc unknown-ans) (while (setq next (funcall next-fn)) (let* ((loc (nth 0 next)) (end (nth 1 next)) (name (nth 2 next)) (positive (nth 3 next)) (found nil)) ;; Delete the annotation (delete-region loc end) (if positive ;; Positive annotations are stacked, remembering location (setq open-ans (cons (list name loc) open-ans)) ;; It is a negative annotation: ;; Close the top annotation & add its text property. ;; If the file's nesting is messed up, the close might not match ;; the top thing on the open-annotations stack. ;; If no matching annotation is open, just ignore the close. (if (not (assoc name open-ans)) (message "Extra closing annotation (%s) in file" name) ;; If one is open, but not on the top of the stack, close ;; the things in between as well. Set `found' when the real ;; oneis closed. (while (not found) (let* ((top (car open-ans)) ; first on stack: should match. (top-name (car top)) (start (car (cdr top))) ; location of start (params (cdr (cdr top))) ; parameters (aalist translations) (matched nil)) (if (equal name top-name) (setq found t) (message "Improper nesting in file.")) ;; Look through property names in TRANSLATIONS (while aalist (let ((prop (car (car aalist))) (alist (cdr (car aalist)))) ;; And look through values for each property (while alist (let ((value (car (car alist))) (ans (cdr (car alist)))) (if (member top-name ans) ;; This annotation is listed, but still have to ;; check if multiple annotations are satisfied (if (member 'nil (mapcar (lambda (r) (assoc r open-ans)) ans)) nil ; multiple ans not satisfied ;; Yes, use the current property name & ;; value. Set loop variables to nil so loop ;; will exit. (setq alist nil aalist nil matched t ;; pop annotation off stack. open-ans (cdr open-ans)) (cond ;; Check for pseudo-properties ((eq prop 'PARAMETER) ;; This is a parameter of the top open ann: ;; delete text and use as arg. (if open-ans ;; (If nothing open, discard). (setq open-ans (cons (append (car open-ans) (list (buffer-substring start loc))) (cdr open-ans)))) (delete-region start loc)) ((eq prop 'FUNCTION) ;; Not a property, but a function to call. (let ((rtn (apply value start loc params))) (if rtn (setq todo (cons rtn todo))))) (t ;; Normal property/value pair (setq todo (cons (list start loc prop value) todo))))))) (setq alist (cdr alist)))) (setq aalist (cdr aalist))) (if matched nil ;; Didn't find any match for the annotation: ;; Store as value of text-property `unknown'. (setq open-ans (cdr open-ans)) (setq todo (cons (list start loc 'unknown top-name) todo)) (setq unknown-ans (cons name unknown-ans))))))))) ;; Once entire file has been scanned, add the properties. (while todo (let* ((item (car todo)) (from (nth 0 item)) (to (nth 1 item)) (prop (nth 2 item)) (val (nth 3 item))) (put-text-property from to prop (cond ((numberp val) ; add to ambient value if numeric (+ val (or (get-text-property from prop) 0))) ((get prop 'format-list-valued) ; value gets consed onto ; list-valued properties (let ((prev (get-text-property from prop))) (cons val (if (listp prev) prev (list prev))))) (t val)))) ; normally, just set to val. (setq todo (cdr todo))) (if unknown-ans (message "Unknown annotations: %s" unknown-ans)))))) ;;; ;;; Encoding ;;; (defun format-insert-annotations (list &optional offset) "Apply list of annotations to buffer as `write-region' would. Inserts each element of the given LIST of buffer annotations at its appropriate place. Use second arg OFFSET if the annotations' locations are not relative to the beginning of the buffer: annotations will be inserted at their location-OFFSET+1 \(ie, the offset is treated as the character number of the first character in the buffer)." (if (not offset) (setq offset 0) (setq offset (1- offset))) (let ((l (reverse list))) (while l (goto-char (- (car (car l)) offset)) (insert (cdr (car l))) (setq l (cdr l))))) (defun format-annotate-value (old new) "Return OLD and NEW as a \(close . open) annotation pair. Useful as a default function for TRANSLATIONS alist when the value of the text property is the name of the annotation that you want to use, as it is for the `unknown' text property." (cons (if old (list old)) (if new (list new)))) (defun format-annotate-region (from to trans format-fn ignore) "Generate annotations for text properties in the region. Searches for changes between FROM and TO, and describes them with a list of annotations as defined by alist TRANSLATIONS and FORMAT-FN. IGNORE lists text properties not to consider; any text properties that are neither ignored nor listed in TRANSLATIONS are warned about. If you actually want to modify the region, give the return value of this function to `format-insert-annotations'. Format of the TRANSLATIONS argument: Each element is a list whose car is a PROPERTY, and the following elements are VALUES of that property followed by the names of zero or more ANNOTATIONS. Whenever the property takes on that value, the annotations \(as formatted by FORMAT-FN) are inserted into the file. When the property stops having that value, the matching negated annotation will be inserted \(it may actually be closed earlier and reopened, if necessary, to keep proper nesting). If the property's value is a list, then each element of the list is dealt with separately. If a VALUE is numeric, then it is assumed that there is a single annotation and each occurrence of it increments the value of the property by that number. Thus, given the entry \(left-margin \(4 \"indent\")), if the left margin changes from 4 to 12, two annotations will be generated. If the VALUE is nil, then instead of annotations, a function should be specified. This function is used as a default: it is called for all transitions not explicitly listed in the table. The function is called with two arguments, the OLD and NEW values of the property. It should return lists of annotations like `format-annotate-location' does. The same structure can be used in reverse for reading files." (let ((all-ans nil) ; All annotations - becomes return value (open-ans nil) ; Annotations not yet closed (loc nil) ; Current location (not-found nil)) ; Properties that couldn't be saved (while (or (null loc) (and (setq loc (next-property-change loc nil to)) (< loc to))) (or loc (setq loc from)) (let* ((ans (format-annotate-location loc (= loc from) ignore trans)) (neg-ans (format-reorder (aref ans 0) open-ans)) (pos-ans (aref ans 1)) (ignored (aref ans 2))) (setq not-found (append ignored not-found) ignore (append ignored ignore)) ;; First do the negative (closing) annotations (while neg-ans ;; Check if it's missing. This can happen (eg, a numeric property ;; going negative can generate closing annotations before there are ;; any open). Warn user & ignore. (if (not (member (car neg-ans) open-ans)) (message "Can't close %s: not open." (car neg-ans)) (while (not (equal (car neg-ans) (car open-ans))) ;; To close anno. N, need to first close ans 1 to N-1, ;; remembering to re-open them later. (setq pos-ans (cons (car open-ans) pos-ans)) (setq all-ans (cons (cons loc (funcall format-fn (car open-ans) nil)) all-ans)) (setq open-ans (cdr open-ans))) ;; Now remove the one we're really interested in from open list. (setq open-ans (cdr open-ans)) ;; And put the closing annotation here. (setq all-ans (cons (cons loc (funcall format-fn (car neg-ans) nil)) all-ans))) (setq neg-ans (cdr neg-ans))) ;; Now deal with positive (opening) annotations (let ((p pos-ans)) (while pos-ans (setq open-ans (cons (car pos-ans) open-ans)) (setq all-ans (cons (cons loc (funcall format-fn (car pos-ans) t)) all-ans)) (setq pos-ans (cdr pos-ans)))))) ;; Close any annotations still open (while open-ans (setq all-ans (cons (cons to (funcall format-fn (car open-ans) nil)) all-ans)) (setq open-ans (cdr open-ans))) (if not-found (message "These text properties could not be saved:\n %s" not-found)) (nreverse all-ans))) ;;; Internal functions for format-annotate-region. (defun format-annotate-location (loc all ignore trans) "Return annotation(s) needed at LOCATION. This includes any properties that change between LOC-1 and LOC. If ALL is true, don't look at previous location, but generate annotations for all non-nil properties. Third argument IGNORE is a list of text-properties not to consider. Return value is a vector of 3 elements: 1. List of names of the annotations to close 2. List of the names of annotations to open. 3. List of properties that were ignored or couldn't be annotated." (let* ((prev-loc (1- loc)) (before-plist (if all nil (text-properties-at prev-loc))) (after-plist (text-properties-at loc)) p negatives positives prop props not-found) ;; make list of all property names involved (setq p before-plist) (while p (if (not (memq (car p) props)) (setq props (cons (car p) props))) (setq p (cdr (cdr p)))) (setq p after-plist) (while p (if (not (memq (car p) props)) (setq props (cons (car p) props))) (setq p (cdr (cdr p)))) (while props (setq prop (car props) props (cdr props)) (if (memq prop ignore) nil ; If it's been ignored before, ignore it now. (let ((before (if all nil (car (cdr (memq prop before-plist))))) (after (car (cdr (memq prop after-plist))))) (if (equal before after) nil ; no change; ignore (let ((result (format-annotate-single-property-change prop before after trans))) (if (not result) (setq not-found (cons prop not-found)) (setq negatives (nconc negatives (car result)) positives (nconc positives (cdr result))))))))) (vector negatives positives not-found))) (defun format-annotate-single-property-change (prop old new trans) "Return annotations for PROPERTY changing from OLD to NEW. These are searched for in the TRANSLATIONS alist. If NEW does not appear in the list, but there is a default function, then that function is called. Annotations to open and to close are returned as a dotted pair." (let ((prop-alist (cdr (assoc prop trans))) default) (if (not prop-alist) nil ;; If property is numeric, nil means 0 (cond ((and (numberp old) (null new)) (setq new 0)) ((and (numberp new) (null old)) (setq old 0))) ;; If either old or new is a list, have to treat both that way. (if (or (consp old) (consp new)) (let* ((old (if (listp old) old (list old))) (new (if (listp new) new (list new))) (tail (format-common-tail old new)) close open) (while old (setq close (append (car (format-annotate-atomic-property-change prop-alist (car old) nil)) close) old (cdr old))) (while new (setq open (append (cdr (format-annotate-atomic-property-change prop-alist nil (car new))) open) new (cdr new))) (format-make-relatively-unique close open)) (format-annotate-atomic-property-change prop-alist old new))))) (defun format-annotate-atomic-property-change (prop-alist old new) "Internal function annotate a single property change. PROP-ALIST is the relevant segement of a TRANSLATIONS list. OLD and NEW are the values." (cond ;; Numerical annotation - use difference ((and (numberp old) (numberp new)) (let* ((entry (progn (while (and (car (car prop-alist)) (not (numberp (car (car prop-alist))))) (setq prop-alist (cdr prop-alist))) (car prop-alist))) (increment (car (car prop-alist))) (n (ceiling (/ (float (- new old)) (float increment)))) (anno (car (cdr (car prop-alist))))) (if (> n 0) (cons nil (make-list n anno)) (cons (make-list (- n) anno) nil)))) ;; Standard annotation (t (let ((close (and old (cdr (assoc old prop-alist)))) (open (and new (cdr (assoc new prop-alist))))) (if (or close open) (format-make-relatively-unique close open) ;; Call "Default" function, if any (let ((default (assq nil prop-alist))) (if default (funcall (car (cdr default)) old new)))))))) ;; format.el ends here emacs-19.30/lisp/forms-d2.el100666 12120 1 4232 6045202754 14035 0ustar rmsdaemon;;; forms-d2.el --- demo forms-mode ;; Author: Johan Vromans ;; Created: 1989 ;; This sample forms exploit most of the features of forms mode. ;; Set the name of the data file. (setq forms-file "forms-d2.dat") ;; Use 'forms-enumerate' to set field names and number thereof. (setq forms-number-of-fields (forms-enumerate '(arch-newsgroup ; 1 arch-volume ; 2 arch-issue ; and ... arch-article ; ... so arch-shortname ; ... ... on arch-parts arch-from arch-longname arch-keywords arch-date arch-remarks))) ;; The following functions are used by this form for layout purposes. ;; (defun arch-tocol (target &optional fill) "Produces a string to skip to column TARGET. Prepends newline if needed. The optional FILL should be a character, used to fill to the column." (if (null fill) (setq fill ? )) (if (< target (current-column)) (concat "\n" (make-string target fill)) (make-string (- target (current-column)) fill))) ;; (defun arch-rj (target field &optional fill) "Produces a string to skip to column TARGET minus the width of field FIELD. Prepends newline if needed. The optional FILL should be a character, used to fill to the column." (arch-tocol (- target (length (nth field forms-fields))) fill)) ;; Record filters. ;; (defun arch-new-record-filter (the-record) "Form a new record with some defaults." (aset the-record arch-from (user-full-name)) (aset the-record arch-date (current-time-string)) the-record ; return it ) (setq forms-new-record-filter 'arch-new-record-filter) ;; The format list. (setq forms-format-list (list "====== Public Domain Software Archive ======\n\n" arch-shortname " - " arch-longname "\n\n" "Article: " arch-newsgroup "/" arch-article " " '(arch-tocol 40) "Issue: " arch-issue " " '(arch-rj 73 10) "Date: " arch-date "\n\n" "Submitted by: " arch-from "\n" '(arch-tocol 79 ?-) "\n" "Keywords: " arch-keywords "\n\n" "Parts: " arch-parts "\n\n====== Remarks ======\n\n" arch-remarks )) ;; That's all, folks! emacs-19.30/lisp/forms-pass.el100444 12120 1 1074 6045203015 14460 0ustar rmsdaemon;;; forms-pass.el --- passwd file demo for forms-mode ;; This demo visits your passwd file. ;; use yp if present (or (file-exists-p (setq forms-file "/var/yp/src/passwd")) (setq forms-file "/etc/passwd")) (setq forms-read-only t) ; to make sure (setq forms-field-sep ":") (setq forms-number-of-fields 7) (setq forms-format-list (list "====== Visiting " forms-file " ======\n\n" "User : " 1 " Uid: " 3 " Gid: " 4 "\n\n" "Name : " 5 "\n\n" "Home : " 6 "\n\n" "Shell: " 7 "\n")) emacs-19.30/lisp/forms.el100444 22551 1 203730 6052714625 14642 0ustar jvromansdaemon;;; forms.el --- Forms mode: edit a file as a form to fill in ;; Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc. ;; Author: Johan Vromans ;; 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: ;;; Visit a file using a form. ;;; ;;; === Naming conventions ;;; ;;; The names of all variables and functions start with 'forms-'. ;;; Names which start with 'forms--' are intended for internal use, and ;;; should *NOT* be used from the outside. ;;; ;;; 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. ;;; ;;; === How it works === ;;; ;;; 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. ;;; ;;; Forms mode is a composite mode. It involves two files, and two ;;; buffers. ;;; The first file, called the control file, defines the name of the ;;; data file and the forms format. This file buffer will be used to ;;; present the forms. ;;; The second file holds the actual data. The buffer of this file ;;; 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: ;;; ;;; forms-field-sep [string, default TAB] ;;; The field separator used to separate the ;;; fields in the data file. It may be a string. ;;; ;;; 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-check-number-of-fields [bool, default t] ;;; If non-nil, a warning will be issued whenever ;;; a record is found that does not have the number ;;; of fields specified by `forms-number-of-fields'. ;;; ;;; 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 nil] ;;; 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 nil] ;;; 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-read-file-filter [symbol, default nil] ;;; If not nil: this should be the name of a ;;; function that is called after the forms data file ;;; has been read. It can be used to transform ;;; the contents of the file into a format more suitable ;;; for forms-mode processing. ;;; ;;; forms-write-file-filter [symbol, default nil] ;;; If not nil: this should be the name of a ;;; function that is called before the forms data file ;;; is written (saved) to disk. It can be used to undo ;;; the effects of `forms-read-file-filter', if any. ;;; ;;; forms-new-record-filter [symbol, default nil] ;;; If not nil: this should be the name of a ;;; function that is called when a new ;;; record is created. It can be used to fill in ;;; the new record with default fields, for example. ;;; ;;; forms-modified-record-filter [symbol, default nil] ;;; If not nil: this should be the name of a ;;; function that is called when a record has ;;; been modified. It is called after the fields ;;; are parsed. It can be used to register ;;; modification dates, for example. ;;; ;;; 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. ;;; As of emacs 19.29, the `intangible' text property ;;; is used to prevent moving into read-only fields. ;;; 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 ;;; jumping (first, last, random number) ;;; searching ;;; creating and deleting records ;;; reverting the form (NOT the file buffer) ;;; switching edit <-> view mode v.v. ;;; jumping from field to field ;;; ;;; As an documented side-effect: jumping to the last record in the ;;; file (using forms-last-record) will adjust forms--total-records if ;;; needed. ;;; ;;; The forms buffer can be in on eof two modes: edit mode or view ;;; mode. View mode is a read-only mode, you cannot modify the ;;; contents of the buffer. ;;; ;;; Edit mode commands: ;;; ;;; TAB forms-next-field ;;; \C-c TAB forms-next-field ;;; \C-c < forms-first-record ;;; \C-c > forms-last-record ;;; \C-c ? describe-mode ;;; \C-c \C-k forms-delete-record ;;; \C-c \C-q forms-toggle-read-only ;;; \C-c \C-o forms-insert-record ;;; \C-c \C-l forms-jump-record ;;; \C-c \C-n forms-next-record ;;; \C-c \C-p forms-prev-record ;;; \C-c \C-r forms-search-backward ;;; \C-c \C-s forms-search-forward ;;; \C-c \C-x forms-exit ;;; ;;; Read-only mode commands: ;;; ;;; SPC forms-next-record ;;; DEL forms-prev-record ;;; ? describe-mode ;;; \C-q forms-toggle-read-only ;;; l forms-jump-record ;;; n forms-next-record ;;; p forms-prev-record ;;; r forms-search-backward ;;; s forms-search-forward ;;; x forms-exit ;;; ;;; Of course, it is also possible to use the \C-c prefix to obtain the ;;; same command keys as in edit mode. ;;; ;;; The following bindings are available, independent of the mode: ;;; ;;; [next] forms-next-record ;;; [prior] forms-prev-record ;;; [begin] forms-first-record ;;; [end] forms-last-record ;;; [S-TAB] forms-prev-field ;;; [backtab] forms-prev-field ;;; ;;; 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' can be 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 (substring "$Revision: 2.23 $" 11 -2) "The version number of forms-mode (as string). The complete RCS id is: $Id: forms.el,v 2.23 1995/11/16 20:04:57 jvromans Exp $") (defvar forms-mode-hooks nil "Hook functions to be run upon entering Forms mode.") ;;; Mandatory variables - must be set by evaluating the control file. (defvar forms-file nil "Name of the file holding the data.") (defvar forms-format-list nil "List of formatting specifications.") (defvar forms-number-of-fields nil "Number of fields per record.") ;;; Optional variables with default values. (defvar forms-check-number-of-fields t "*If non-nil, warn about records with wrong number of fields.") (defvar forms-field-sep "\t" "Field separator character (default TAB).") (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 nil "*Non-nil means replace scroll-up/down commands in Forms mode. The replacement commands performs forms-next/prev-record.") (defvar forms-forms-jump nil "*Non-nil means redefine beginning/end-of-buffer in Forms mode. The replacement commands performs forms-first/last-record.") (defvar forms-read-file-filter nil "The name of a function that is called after reading the data file. This can be used to change the contents of the file to something more suitable for forms processing.") (defvar forms-write-file-filter nil "The name of a function that is called before writing the data file. This can be used to undo the effects of form-read-file-hook.") (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. (defvar forms--file-buffer nil "Buffer which holds the file data") (defvar forms--total-records 0 "Total number of records in the data file.") (defvar forms--current-record 0 "Number of the record currently on the screen.") (defvar forms-mode-map nil "Keymap for form buffer.") (defvar forms-mode-ro-map nil "Keymap for form buffer in view mode.") (defvar forms-mode-edit-map nil "Keymap for form buffer in edit mode.") (defvar forms--markers nil "Field markers in the screen.") (defvar forms--dyntexts nil "Dynamic texts (resulting from function calls) on the screen.") (defvar forms--the-record-list nil "List of strings of the current record, as parsed from the file.") (defvar forms--search-regexp nil "Last regexp used by forms-search functions.") (defvar forms--format nil "Formatting routine.") (defvar forms--parser nil "Forms parser routine.") (defvar forms--mode-setup nil "To keep track of forms-mode being set-up.") (make-variable-buffer-local 'forms--mode-setup) (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) "Major mode to visit files in a field-structured manner using a form. Commands: Equivalent keys in read-only mode: TAB forms-next-field TAB \\C-c TAB forms-next-field \\C-c < forms-first-record < \\C-c > forms-last-record > \\C-c ? describe-mode ? \\C-c \\C-k forms-delete-record \\C-c \\C-q forms-toggle-read-only q \\C-c \\C-o forms-insert-record \\C-c \\C-l forms-jump-record l \\C-c \\C-n forms-next-record n \\C-c \\C-p forms-prev-record p \\C-c \\C-r forms-search-reverse r \\C-c \\C-s forms-search-forward s \\C-c \\C-x forms-exit x " (interactive) ;; 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) (make-local-variable 'forms-multi-line) (make-local-variable 'forms-forms-scroll) (make-local-variable 'forms-forms-jump) (make-local-variable 'forms-use-text-properties) ;; Filter functions. (make-local-variable 'forms-read-file-filter) (make-local-variable 'forms-write-file-filter) (make-local-variable 'forms-new-record-filter) (make-local-variable 'forms-modified-record-filter) ;; Make sure no filters exist. (setq forms-read-file-filter nil) (setq forms-write-file-filter nil) (setq forms-new-record-filter nil) (setq forms-modified-record-filter nil) ;; 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...") ;; If enable-local-eval is not set to t the user is asked first. (if (or (eq enable-local-eval t) (yes-or-no-p (concat "Evaluate lisp code in buffer " (buffer-name) " to display forms "))) (eval-current-buffer) (error "`enable-local-eval' inhibits buffer evaluation")) ;; Check if the mandatory variables make sense. (or forms-file (error (concat "Forms control file error: " "'forms-file' has not been set"))) ;; Check forms-field-sep first, since it can be needed to ;; construct a default format list. (or (stringp forms-field-sep) (error (concat "Forms control file error: " "'forms-field-sep' is not a string"))) (if forms-number-of-fields (or (and (numberp forms-number-of-fields) (> forms-number-of-fields 0)) (error (concat "Forms control file error: " "'forms-number-of-fields' must be a number > 0"))) (or (null forms-format-list) (error (concat "Forms control file error: " "'forms-number-of-fields' has not been set")))) (or forms-format-list (forms--intuit-from-file)) (if forms-multi-line (if (and (stringp forms-multi-line) (eq (length forms-multi-line) 1)) (if (string= forms-multi-line forms-field-sep) (error (concat "Forms control file error: " "'forms-multi-line' is equal to 'forms-field-sep'"))) (error (concat "Forms control file 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. (if (and forms-new-record-filter (not (fboundp forms-new-record-filter))) (error (concat "Forms control file error: " "'forms-new-record-filter' is not a function"))) (if (and forms-modified-record-filter (not (fboundp forms-modified-record-filter))) (error (concat "Forms control file error: " "'forms-modified-record-filter' is not a function"))) ;; 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. (set-visited-file-name nil) ;; Prepare this buffer for further processing. (setq buffer-read-only nil) (erase-buffer) ;;(message "forms: setting up... done.") )) ;; initialization done (setq forms--mode-setup t) ;; 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. (make-local-variable 'forms--file-buffer) (make-local-variable 'forms--total-records) (make-local-variable 'forms--current-record) (make-local-variable 'forms--the-record-list) (make-local-variable 'forms--search-regexp) ; The keymaps are global, so multiple forms mode buffers can share them. ;(make-local-variable 'forms-mode-map) ;(make-local-variable 'forms-mode-ro-map) ;(make-local-variable 'forms-mode-edit-map) (if forms-mode-map ; already defined nil ;;(message "forms: building keymap...") (forms--mode-commands) ;;(message "forms: building keymap... done.") ) ;; set the major mode indicator (setq major-mode 'forms-mode) (setq mode-name "Forms") ;; find the data file (setq forms--file-buffer (find-file-noselect forms-file)) ;; Pre-transform. (let ((read-file-filter forms-read-file-filter) (write-file-filter forms-write-file-filter)) (if read-file-filter (save-excursion (set-buffer forms--file-buffer) (let ((inhibit-read-only t) (file-modified (buffer-modified-p))) (run-hooks 'read-file-filter) (if (not file-modified) (set-buffer-modified-p nil))) (if write-file-filter (progn (make-variable-buffer-local 'local-write-file-hooks) (setq local-write-file-hooks (list write-file-filter))))) (if write-file-filter (save-excursion (set-buffer forms--file-buffer) (make-variable-buffer-local 'local-write-file-hooks) (setq local-write-file-hooks (list write-file-filter)))))) ;; count the number of records, and set see if it may be modified (let (ro) (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...") ;; Since we aren't really implementing a minor mode, we hack the modeline ;; directly to get the text " View " into forms-read-only form buffers. For ;; that reason, this variable must be buffer only. (make-local-variable 'minor-mode-alist) (setq minor-mode-alist (list (list 'forms-read-only " View"))) ;;(message "forms: proceeding setup (keymaps)...") (forms--set-keymaps) ;;(message "forms: proceeding setup (commands)...") (forms--change-commands) ;;(message "forms: proceeding setup (buffer)...") (set-buffer-modified-p nil) (if (= forms--total-records 0) ;;(message "forms: proceeding setup (new file)...") (progn (insert "GNU Emacs Forms Mode version " forms-version "\n\n" (if (file-exists-p forms-file) (concat "No records available in file \"" forms-file "\".\n\n") (format "Creating new file \"%s\"\nwith %d field%s per record.\n\n" forms-file forms-number-of-fields (if (= 1 forms-number-of-fields) "" "s"))) "Use " (substitute-command-keys "\\[forms-insert-record]") " to create new records.\n") (setq forms--current-record 1) (setq buffer-read-only t) (set-buffer-modified-p nil)) ;; setup the first (or current) record to show (if (< forms--current-record 1) (setq forms--current-record 1)) (forms-jump-record forms--current-record) ) ;; user customising ;;(message "forms: proceeding setup (user hooks)...") (run-hooks 'forms-mode-hooks) ;;(message "forms: setting up... done.") ;; be helpful (forms--help) ) (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 (concat "Forms control file error: " "'forms-format-list' has not been set"))) ;; It must be a list. (or (listp forms-format-list) (error (concat "Forms control file 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 (setq forms-format-list nil) ; gonna rebuild (while the-list (let ((el (car-safe the-list)) (rem (cdr-safe the-list))) ;; If it is a symbol, eval it first. (if (and (symbolp el) (boundp el)) (setq el (eval el))) (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)) (error (concat "Forms format error: " "field number %d out of range 1..%d") 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)) (if prev-item (setq forms-format-list (append forms-format-list (list prev-item) nil))) (setq prev-item el)) ;; Try function ... ((listp el) ;; Validate. (or (fboundp (car-safe el)) (error (concat "Forms format error: " "not a function " (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 (concat "Forms format error: " "invalid element " (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 parsing 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 between two read-only segments, it inherits the ;; read-only properties. This is not what we want. ;; To solve this, read-only segments get the `insert-in-front-hooks' ;; property set with a function that temporarily switches the properties ;; of the first character of the segment to read-write, so the new ;; text gets the right properties. ;; The `post-command-hook' is used to restore the original properties. (defvar forms--iif-start nil "Record start of modification command.") (defvar forms--iif-properties nil "Original properties of the character being overridden.") (defun forms--iif-hook (begin end) "`insert-in-front-hooks' function for read-only segments." ;; Note start location. By making it a marker that points one ;; character beyond the actual location, it is guaranteed to move ;; correctly if text is inserted. (or forms--iif-start (setq forms--iif-start (copy-marker (1+ (point))))) ;; Check if there is special treatment required. (if (or (<= forms--iif-start 2) (get-text-property (- forms--iif-start 2) 'read-only)) (progn ;; Fetch current properties. (setq forms--iif-properties (text-properties-at (1- forms--iif-start))) ;; Replace them. (let ((inhibit-read-only t)) (set-text-properties (1- forms--iif-start) forms--iif-start (list 'face forms--rw-face 'front-sticky '(face)))) ;; Enable `post-command-hook' to restore the properties. (setq post-command-hook (append (list 'forms--iif-post-command-hook) post-command-hook))) ;; No action needed. Clear marker. (setq forms--iif-start nil))) (defun forms--iif-post-command-hook () "`post-command-hook' function for read-only segments." ;; Disable `post-command-hook'. (setq post-command-hook (delq 'forms--iif-hook-post-command-hook post-command-hook)) ;; Restore properties. (if forms--iif-start (let ((inhibit-read-only t)) (set-text-properties (1- forms--iif-start) forms--iif-start forms--iif-properties))) ;; Cleanup. (setq forms--iif-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)) (,@ (apply 'append (mapcar 'forms--make-format-elt-using-text-properties forms-format-list))) ;; Prevent insertion before the first text. (,@ (if (numberp (car forms-format-list)) nil '((add-text-properties (point-min) (1+ (point-min)) '(front-sticky (read-only intangible)))))) ;; Prevent insertion after the last text. (remove-text-properties (1- (point)) (point) '(rear-nonsticky))) (setq forms--iif-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)) ;; ;; ;; A string, e.g. "text: ". ;; (set-text-properties ;; (point) ;; (progn (insert "text: ") (point)) ;; (list 'face forms--ro-face ;; 'read-only 1 ;; 'insert-in-front-hooks 'forms--iif-hook ;; 'rear-nonsticky '(read-only face insert-in-front-hooks))) ;; ;; ;; 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 ;; 'front-sticky '(face)))) ;; ;; ;; Another string, e.g. "\nmore text: ". ;; (set-text-properties ;; (point) ;; (progn (insert "\nmore text: ") (point)) ;; (list 'face forms--ro-face ;; 'read-only 2 ;; 'insert-in-front-hooks 'forms--iif-hook ;; 'rear-nonsticky '(read-only face insert-in-front-hooks))) ;; ;; ;; 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 ;; 'insert-in-front-hooks 'forms--iif-hook ;; 'rear-nonsticky '(read-only face insert-in-front-hooks))) ;; ;; ;; Prevent insertion before the first text. ;; (add-text-properties (point-min) (1+ (point-min)) ;; '(front-sticky (read-only)))))) ;; ;; Prevent insertion after the last text. ;; (remove-text-properties (1- (point)) (point) ;; '(rear-nonsticky))) ;; ;; ;; wrap up ;; (setq forms--iif-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))) 'intangible t 'insert-in-front-hooks '(forms--iif-hook) 'rear-nonsticky '(face read-only insert-in-front-hooks intangible)))))) ((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 'front-sticky '(face)))))))) ((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))) 'intangible t 'insert-in-front-hooks '(forms--iif-hook) 'rear-nonsticky '(read-only face insert-in-front-hooks intangible)))))) ;; 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) (` ((insert (, el))))) ((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-no-properties here there)) (aset forms--recordv (aref forms--elements i) (buffer-substring-no-properties 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-no-properties 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-no-properties (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-no-properties here (- (point) (, (length el))))))) (` ((if (not (looking-at (, (regexp-quote el)))) (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-no-properties (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-no-properties 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))) )) (defun forms--intuit-from-file () "Get number of fields and a default form using the data file." ;; If `forms-number-of-fields' is not set, get it from the data file. (if (null forms-number-of-fields) ;; Need a file to do this. (if (not (file-exists-p forms-file)) (error "Need existing file or explicit 'forms-number-of-records'.") ;; Visit the file and extract the first record. (setq forms--file-buffer (find-file-noselect forms-file)) (let ((read-file-filter forms-read-file-filter) (the-record)) (setq the-record (save-excursion (set-buffer forms--file-buffer) (let ((inhibit-read-only t)) (run-hooks 'read-file-filter)) (goto-char (point-min)) (forms--get-record))) ;; This may be overkill, but try to avoid interference with ;; the normal processing. (kill-buffer forms--file-buffer) ;; Count the number of fields in `the-record'. (let (the-result (start-pos 0) found-pos (field-sep-length (length forms-field-sep))) (setq forms-number-of-fields 1) (while (setq found-pos (string-match forms-field-sep the-record start-pos)) (progn (setq forms-number-of-fields (1+ forms-number-of-fields)) (setq start-pos (+ field-sep-length found-pos)))))))) ;; Construct default format list. (setq forms-format-list (list "Forms file \"" forms-file "\".\n\n")) (let ((i 0)) (while (<= (setq i (1+ i)) forms-number-of-fields) (setq forms-format-list (append forms-format-list (list (format "%4d: " i) i "\n")))))) (defun forms--set-keymaps () "Set the keymaps used in this mode." (use-local-map (if forms-read-only forms-mode-ro-map forms-mode-edit-map))) (defun forms--mode-commands () "Fill the Forms mode keymaps." ;; `forms-mode-map' is always accessible via \C-c prefix. (setq forms-mode-map (make-keymap)) (define-key forms-mode-map "\t" 'forms-next-field) (define-key forms-mode-map "\C-k" 'forms-delete-record) (define-key forms-mode-map "\C-q" 'forms-toggle-read-only) (define-key forms-mode-map "\C-o" 'forms-insert-record) (define-key forms-mode-map "\C-l" 'forms-jump-record) (define-key forms-mode-map "\C-n" 'forms-next-record) (define-key forms-mode-map "\C-p" 'forms-prev-record) (define-key forms-mode-map "\C-r" 'forms-search-backward) (define-key forms-mode-map "\C-s" 'forms-search-forward) (define-key forms-mode-map "\C-x" 'forms-exit) (define-key forms-mode-map "<" 'forms-first-record) (define-key forms-mode-map ">" 'forms-last-record) (define-key forms-mode-map "\C-?" 'forms-prev-record) ;; `forms-mode-ro-map' replaces the local map when in read-only mode. (setq forms-mode-ro-map (make-keymap)) (suppress-keymap forms-mode-ro-map) (define-key forms-mode-ro-map "\C-c" forms-mode-map) (define-key forms-mode-ro-map "\t" 'forms-next-field) (define-key forms-mode-ro-map "q" 'forms-toggle-read-only) (define-key forms-mode-ro-map "l" 'forms-jump-record) (define-key forms-mode-ro-map "n" 'forms-next-record) (define-key forms-mode-ro-map "p" 'forms-prev-record) (define-key forms-mode-ro-map "r" 'forms-search-backward) (define-key forms-mode-ro-map "s" 'forms-search-forward) (define-key forms-mode-ro-map "x" 'forms-exit) (define-key forms-mode-ro-map "<" 'forms-first-record) (define-key forms-mode-ro-map ">" 'forms-last-record) (define-key forms-mode-ro-map "?" 'describe-mode) (define-key forms-mode-ro-map " " 'forms-next-record) (forms--mode-commands1 forms-mode-ro-map) (forms--mode-menu-ro forms-mode-ro-map) ;; This is the normal, local map. (setq forms-mode-edit-map (make-keymap)) (define-key forms-mode-edit-map "\t" 'forms-next-field) (define-key forms-mode-edit-map "\C-c" forms-mode-map) (forms--mode-commands1 forms-mode-edit-map) (forms--mode-menu-edit forms-mode-edit-map) ) (defun forms--mode-menu-ro (map) ;;; Menu initialisation ; (define-key map [menu-bar] (make-sparse-keymap)) (define-key map [menu-bar forms] (cons "Forms" (make-sparse-keymap "Forms"))) (define-key map [menu-bar forms menu-forms-exit] '("Exit" . forms-exit)) (define-key map [menu-bar forms menu-forms-sep1] '("----")) (define-key map [menu-bar forms menu-forms-save] '("Save Data" . forms-save-buffer)) (define-key map [menu-bar forms menu-forms-print] '("Print Data" . forms-print)) (define-key map [menu-bar forms menu-forms-describe] '("Describe Mode" . describe-mode)) (define-key map [menu-bar forms menu-forms-toggle-ro] '("Toggle View/Edit" . forms-toggle-read-only)) (define-key map [menu-bar forms menu-forms-jump-record] '("Jump" . forms-jump-record)) (define-key map [menu-bar forms menu-forms-search-backward] '("Search Backward" . forms-search-backward)) (define-key map [menu-bar forms menu-forms-search-forward] '("Search Forward" . forms-search-forward)) (define-key map [menu-bar forms menu-forms-delete-record] '("Delete" . forms-delete-record)) (define-key map [menu-bar forms menu-forms-insert-record] '("Insert" . forms-insert-record)) (define-key map [menu-bar forms menu-forms-sep2] '("----")) (define-key map [menu-bar forms menu-forms-last-record] '("Last Record" . forms-last-record)) (define-key map [menu-bar forms menu-forms-first-record] '("First Record" . forms-first-record)) (define-key map [menu-bar forms menu-forms-prev-record] '("Previous Record" . forms-prev-record)) (define-key map [menu-bar forms menu-forms-next-record] '("Next Record" . forms-next-record)) (define-key map [menu-bar forms menu-forms-sep3] '("----")) (define-key map [menu-bar forms menu-forms-prev-field] '("Previous Field" . forms-prev-field)) (define-key map [menu-bar forms menu-forms-next-field] '("Next Field" . forms-next-field)) (put 'forms-insert-record 'menu-enable '(not forms-read-only)) (put 'forms-delete-record 'menu-enable '(not forms-read-only)) ) (defun forms--mode-menu-edit (map) ;;; Menu initialisation ; (define-key map [menu-bar] (make-sparse-keymap)) (define-key map [menu-bar forms] (cons "Forms" (make-sparse-keymap "Forms"))) (define-key map [menu-bar forms menu-forms-edit--exit] '("Exit" . forms-exit)) (define-key map [menu-bar forms menu-forms-edit-sep1] '("----")) (define-key map [menu-bar forms menu-forms-edit-save] '("Save Data" . forms-save-buffer)) (define-key map [menu-bar forms menu-forms-edit-print] '("Print Data" . forms-print)) (define-key map [menu-bar forms menu-forms-edit-describe] '("Describe Mode" . describe-mode)) (define-key map [menu-bar forms menu-forms-edit-toggle-ro] '("Toggle View/Edit" . forms-toggle-read-only)) (define-key map [menu-bar forms menu-forms-edit-jump-record] '("Jump" . forms-jump-record)) (define-key map [menu-bar forms menu-forms-edit-search-backward] '("Search Backward" . forms-search-backward)) (define-key map [menu-bar forms menu-forms-edit-search-forward] '("Search Forward" . forms-search-forward)) (define-key map [menu-bar forms menu-forms-edit-delete-record] '("Delete" . forms-delete-record)) (define-key map [menu-bar forms menu-forms-edit-insert-record] '("Insert" . forms-insert-record)) (define-key map [menu-bar forms menu-forms-edit-sep2] '("----")) (define-key map [menu-bar forms menu-forms-edit-last-record] '("Last Record" . forms-last-record)) (define-key map [menu-bar forms menu-forms-edit-first-record] '("First Record" . forms-first-record)) (define-key map [menu-bar forms menu-forms-edit-prev-record] '("Previous Record" . forms-prev-record)) (define-key map [menu-bar forms menu-forms-edit-next-record] '("Next Record" . forms-next-record)) (define-key map [menu-bar forms menu-forms-edit-sep3] '("----")) (define-key map [menu-bar forms menu-forms-edit-prev-field] '("Previous Field" . forms-prev-field)) (define-key map [menu-bar forms menu-forms-edit-next-field] '("Next Field" . forms-next-field)) (put 'forms-insert-record 'menu-enable '(not forms-read-only)) (put 'forms-delete-record 'menu-enable '(not forms-read-only)) ) (defun forms--mode-commands1 (map) "Helper routine to define keys." (define-key map [TAB] 'forms-next-field) (define-key map [S-tab] 'forms-prev-field) (define-key map [next] 'forms-next-record) (define-key map [prior] 'forms-prev-record) (define-key map [begin] 'forms-first-record) (define-key map [last] 'forms-last-record) (define-key map [backtab] 'forms-prev-field) ) ;;; Changed functions (defun forms--change-commands () "Localize some commands for Forms mode." ;; scroll-down -> forms-prev-record ;; scroll-up -> forms-next-record (if forms-forms-scroll (progn (substitute-key-definition 'scroll-up 'forms-next-record (current-local-map) (current-global-map)) (substitute-key-definition 'scroll-down 'forms-prev-record (current-local-map) (current-global-map)))) ;; ;; beginning-of-buffer -> forms-first-record ;; end-of-buffer -> forms-end-record (if forms-forms-jump (progn (substitute-key-definition 'beginning-of-buffer 'forms-first-record (current-local-map) (current-global-map)) (substitute-key-definition 'end-of-buffer 'forms-last-record (current-local-map) (current-global-map)))) ;; ;; Save buffer (local-set-key "\C-x\C-s" 'forms-save-buffer) ;; ;; We have our own revert function - use it. (make-local-variable 'revert-buffer-function) (setq revert-buffer-function 'forms--revert-buffer) t) (defun forms--help () "Initial help for Forms mode." (message (substitute-command-keys (concat "\\[forms-next-record]:next" " \\[forms-prev-record]:prev" " \\[forms-first-record]:first" " \\[forms-last-record]:last" " \\[describe-mode]:help")))) (defun forms--trans (subj arg rep) "Translate in SUBJ all chars ARG into char REP. ARG and REP should be single-char strings." (let ((i 0) (x (length subj)) (re (regexp-quote arg)) (k (string-to-char rep))) (while (setq i (string-match re subj i)) (aset subj i k) (setq i (1+ i))))) (defun forms--exit (query &optional save) "Internal exit from forms mode function." (let ((buf (buffer-name forms--file-buffer))) (forms--checkmod) (if (and save (buffer-modified-p forms--file-buffer)) (forms-save-buffer)) (save-excursion (set-buffer forms--file-buffer) (delete-auto-save-file-if-necessary) (kill-buffer (current-buffer))) (if (get-buffer buf) ; not killed??? (if save (progn (beep) (message "Problem saving buffers?"))) (delete-auto-save-file-if-necessary) (kill-buffer (current-buffer))))) (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)) (let ((here (point))) (prog2 (end-of-line) (buffer-substring-no-properties here (point)) (goto-char here)))) (defun forms--show-record (the-record) "Format THE-RECORD and display it in the current buffer." ;; Split the-record. (let (the-result (start-pos 0) found-pos (field-sep-length (length forms-field-sep))) (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)) (let ((ent (substring the-record start-pos found-pos))) (setq the-result (append the-result (list ent))) (setq start-pos (+ field-sep-length found-pos)))) (setq forms--the-record-list the-result)) (setq buffer-read-only nil) (if forms-use-text-properties (let ((inhibit-read-only t)) (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 (if (null forms-check-number-of-fields) nil (beep) (message "Warning: this record has %d fields instead of %d" (length forms--the-record-list) forms-number-of-fields)) (if (< (length forms--the-record-list) forms-number-of-fields) (setq forms--the-record-list (append forms--the-record-list (make-list (- forms-number-of-fields (length forms--the-record-list)) ""))))) ;; 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) (setq buffer-read-only forms-read-only) (setq mode-line-process (concat " " forms--current-record "/" forms--total-records))) (defun forms--parse-form () "Parse contents of form into list of strings." ;; The contents of the form are parsed, and a new list of strings ;; is constructed. ;; A vector with the strings from the original record is ;; constructed, which is updated with the new contents. Therefore ;; fields which were not in the form are not modified. ;; 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)) (if forms-modified-record-filter ;; 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 (progn (message "Read-only buffer!") (beep)) (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)) (if (string-match (regexp-quote forms-field-sep) (mapconcat 'identity forms--the-record-list "")) (error "Field separator occurs in record - update refused!")) ;; 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 (message "Multi-line fields in this record - update refused!") (beep)) (save-excursion (set-buffer forms--file-buffer) ;; Use delete-region instead of kill-region, to avoid ;; adding junk to the kill-ring. (delete-region (save-excursion (beginning-of-line) (point)) (save-excursion (end-of-line) (point))) (insert the-record) (beginning-of-line)))))) (defun forms--checkmod () "Check if this form has been modified, and call forms--update if so." (if (buffer-modified-p nil) (let ((here (point))) (forms--update) (set-buffer-modified-p nil) (goto-char here)))) ;;; Start and exit ;;;###autoload (defun forms-find-file (fn) "Visit a file in Forms mode." (interactive "fForms file: ") (let ((enable-local-eval t) (enable-local-variables t)) (find-file-read-only fn) (or forms--mode-setup (forms-mode t)))) ;;;###autoload (defun forms-find-file-other-window (fn) "Visit a file in Forms mode in other window." (interactive "fFbrowse file in other window: ") (let ((enable-local-eval t) (enable-local-variables t)) (find-file-other-window fn) (or forms--mode-setup (forms-mode t)))) (defun forms-exit (query) "Normal exit from Forms mode. Modified buffers are saved." (interactive "P") (forms--exit query t)) (defun forms-exit-no-save (query) "Exit from Forms mode without saving buffers." (interactive "P") (forms--exit query nil)) ;;; Navigating commands (defun forms-next-record (arg) "Advance to the ARGth following record." (interactive "P") (forms-jump-record (+ forms--current-record (prefix-numeric-value arg)) t)) (defun forms-prev-record (arg) "Advance to the ARGth previous record." (interactive "P") (forms-jump-record (- forms--current-record (prefix-numeric-value arg)) t)) (defun forms-jump-record (arg &optional relative) "Jump to a random record." (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" arg forms--total-records)) ) ;; 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 (set-buffer forms--file-buffer) (beginning-of-line) ;; Move, and adjust the amount if needed (shouldn't happen). (if relative (if (zerop disp) nil (setq cur (+ cur disp (- (forward-line disp))))) (setq cur (+ cur disp (- (goto-line arg))))) (forms--get-record))) ;; This shouldn't happen. (if (/= forms--current-record cur) (progn (setq forms--current-record cur) (beep) (message "Stuck at record %d" cur)))))) (defun forms-first-record () "Jump to first record." (interactive) (forms-jump-record 1)) (defun forms-last-record () "Jump to last record. As a side effect: re-calculates the number of records in the data file." (interactive) (let ((numrec (save-excursion (set-buffer forms--file-buffer) (count-lines (point-min) (point-max))))) (if (= numrec forms--total-records) nil (beep) (setq forms--total-records numrec) (message "Warning: number of records changed to %d" forms--total-records))) (forms-jump-record forms--total-records)) ;;; Other commands (defun forms-toggle-read-only (arg) "Toggles read-only mode of a forms mode buffer. With an argument, enables read-only mode if the argument is positive. Otherwise enables edit mode if the visited file is writeable." (interactive "P") (if (if arg ;; Negative arg means switch it off. (<= (prefix-numeric-value arg) 0) ;; No arg means toggle. forms-read-only) ;; Enable edit mode, if possible. (let ((ro forms-read-only)) (if (save-excursion (set-buffer forms--file-buffer) buffer-read-only) (progn (setq forms-read-only t) (message "No write access to \"%s\"" forms-file) (beep)) (setq forms-read-only nil)) (if (equal ro forms-read-only) nil (forms-mode))) ;; Enable view mode. (if forms-read-only nil (forms--checkmod) ; sync (setq forms-read-only t) (forms-mode)))) ;; Sample: ;; (defun my-new-record-filter (the-fields) ;; ;; numbers are relative to 1 ;; (aset the-fields 4 (current-time-string)) ;; (aset the-fields 6 (user-login-name)) ;; the-list) ;; (setq forms-new-record-filter 'my-new-record-filter) (defun forms-insert-record (arg) "Create a new record before the current one. With ARG: store the record after the current one. If `forms-new-record-filter' contains the name of a function, it is called to fill (some of) the fields with default values." (interactive "P") (if forms-read-only (error "")) (let ((ln (if arg (1+ forms--current-record) forms--current-record)) the-list the-record) (forms--checkmod) (if forms-new-record-filter ;; 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 (make-vector (1+ forms-number-of-fields) ""))) (setq the-fields (funcall forms-new-record-filter the-fields)) (setq the-list (cdr (append the-fields nil)))) (setq the-list (make-list forms-number-of-fields ""))) (setq the-record (mapconcat 'identity the-list forms-field-sep)) (save-excursion (set-buffer forms--file-buffer) (goto-line ln) (open-line 1) (insert the-record) (beginning-of-line)) (setq forms--current-record ln)) (setq forms--total-records (1+ forms--total-records)) (forms-jump-record forms--current-record)) (defun forms-delete-record (arg) "Deletes a record. With a prefix argument: don't ask." (interactive "P") (if forms-read-only (error "")) (forms--checkmod) (if (or arg (y-or-n-p "Really delete this record? ")) (let ((ln forms--current-record)) (save-excursion (set-buffer forms--file-buffer) (goto-line ln) ;; Use delete-region instead of kill-region, to avoid ;; adding junk to the kill-ring. (delete-region (progn (beginning-of-line) (point)) (progn (beginning-of-line 2) (point)))) (setq forms--total-records (1- forms--total-records)) (if (> forms--current-record forms--total-records) (setq forms--current-record forms--total-records)) (forms-jump-record forms--current-record))) (message "")) (defun forms-search-forward (regexp) "Search forward for record containing REGEXP." (interactive (list (read-string (concat "Search forward for" (if forms--search-regexp (concat " (" forms--search-regexp ")")) ": ")))) (if (equal "" regexp) (setq regexp forms--search-regexp)) (forms--checkmod) (let (the-line the-record here (fld-sep forms-field-sep)) (if (save-excursion (set-buffer forms--file-buffer) (setq here (point)) (end-of-line) (if (null (re-search-forward regexp nil t)) (progn (goto-char here) (message (concat "\"" regexp "\" not found.")) nil) (setq the-record (forms--get-record)) (setq the-line (1+ (count-lines (point-min) (point)))))) (progn (setq forms--current-record the-line) (forms--show-record the-record) (re-search-forward regexp nil t)))) (setq forms--search-regexp regexp)) (defun forms-search-backward (regexp) "Search backward for record containing REGEXP." (interactive (list (read-string (concat "Search backward for" (if forms--search-regexp (concat " (" forms--search-regexp ")")) ": ")))) (if (equal "" regexp) (setq regexp forms--search-regexp)) (forms--checkmod) (let (the-line the-record here (fld-sep forms-field-sep)) (if (save-excursion (set-buffer forms--file-buffer) (setq here (point)) (beginning-of-line) (if (null (re-search-backward regexp nil t)) (progn (goto-char here) (message (concat "\"" regexp "\" not found.")) nil) (setq the-record (forms--get-record)) (setq the-line (1+ (count-lines (point-min) (point)))))) (progn (setq forms--current-record the-line) (forms--show-record the-record) (re-search-forward regexp nil t)))) (setq forms--search-regexp regexp)) (defun forms-save-buffer (&optional args) "Forms mode replacement for save-buffer. It saves the data buffer instead of the forms buffer. Calls `forms-write-file-filter' before writing out the data." (interactive "p") (forms--checkmod) (let ((read-file-filter forms-read-file-filter)) (save-excursion (set-buffer forms--file-buffer) (let ((inhibit-read-only t)) (save-buffer args) (if read-file-filter (run-hooks 'read-file-filter)) (set-buffer-modified-p nil)))) t) (defun forms--revert-buffer (&optional arg noconfirm) "Reverts current form to un-modified." (interactive "P") (if (or noconfirm (yes-or-no-p "Revert form to unmodified? ")) (progn (set-buffer-modified-p nil) (forms-jump-record forms--current-record)))) (defun forms-next-field (arg) "Jump to ARG-th next field." (interactive "p") (let ((i 0) (here (point)) there (cnt 0) (inhibit-point-motion-hooks t)) (if (zerop arg) (setq cnt 1) (setq cnt (+ cnt arg))) (if (catch 'done (while (< i (length forms--markers)) (if (or (null (setq there (aref forms--markers i))) (<= there here)) nil (if (<= (setq cnt (1- cnt)) 0) (progn (goto-char there) (throw 'done t)))) (setq i (1+ i)))) nil (goto-char (aref forms--markers 0))))) (defun forms-prev-field (arg) "Jump to ARG-th previous field." (interactive "p") (let ((i (length forms--markers)) (here (point)) there (cnt 0) (inhibit-point-motion-hooks t)) (if (zerop arg) (setq cnt 1) (setq cnt (+ cnt arg))) (if (catch 'done (while (> i 0) (setq i ( 1- i)) (if (or (null (setq there (aref forms--markers i))) (>= there here)) nil (if (<= (setq cnt (1- cnt)) 0) (progn (goto-char there) (throw 'done t)))))) nil (goto-char (aref forms--markers (1- (length forms--markers))))))) (defun forms-print () "Send the records to the printer with 'print-buffer', one record per page." (interactive) (let ((inhibit-read-only t) (save-record forms--current-record) (nb-record 1) (record nil)) (while (<= nb-record forms--total-records) (forms-jump-record nb-record) (setq record (buffer-string)) (save-excursion (set-buffer (get-buffer-create "*forms-print*")) (goto-char (buffer-end 1)) (insert record) (setq buffer-read-only nil) (if (< nb-record forms--total-records) (insert "\n \n"))) (setq nb-record (1+ nb-record))) (save-excursion (set-buffer "*forms-print*") (print-buffer) (set-buffer-modified-p nil) (kill-buffer (current-buffer))) (forms-jump-record save-record))) ;;; ;;; Special service ;;; (defun forms-enumerate (the-fields) "Take a quoted list of symbols, and set their values to sequential numbers. The first symbol gets number 1, the second 2 and so on. It returns the higest number. Usage: (setq forms-number-of-fields (forms-enumerate '(field1 field2 field2 ...)))" (let ((the-index 0)) (while the-fields (setq the-index (1+ the-index)) (let ((el (car-safe the-fields))) (setq the-fields (cdr-safe the-fields)) (set el the-index))) the-index)) ;;; Debugging (defvar forms--debug nil "*Enables forms-mode debugging if not nil.") (defun forms--debug (&rest args) "Internal debugging routine." (if forms--debug (let ((ret nil)) (while args (let ((el (car-safe args))) (setq args (cdr-safe args)) (if (stringp el) (setq ret (concat ret el)) (setq ret (concat ret (prin1-to-string el) " = ")) (if (boundp el) (let ((vel (eval el))) (setq ret (concat ret (prin1-to-string vel) "\n"))) (setq ret (concat ret "" "\n"))) (if (fboundp el) (setq ret (concat ret (prin1-to-string (symbol-function el)) "\n")))))) (save-excursion (set-buffer (get-buffer-create "*forms-mode debug*")) (if (zerop (buffer-size)) (emacs-lisp-mode)) (goto-char (point-max)) (insert ret))))) ;;; forms.el ends here. emacs-19.30/lisp/fortran.el100444 22542 1 173461 6043706564 14467 0ustar simondaemon;;; fortran.el --- Fortran mode for GNU Emacs ;;; Copyright (c) 1986, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael D. Prange ;; Maintainer: bug-fortran-mode@erl.mit.edu ;; Version 1.30.6 (July 27, 1995) ;; Keywords: languages ;; 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: ;; Fortran mode has been upgraded and is now maintained by Stephen A. Wood ;; (saw@cebaf.gov). It now will use either fixed format continuation line ;; markers (character in 6th column), or tab format continuation line style ;; (digit after a TAB character.) A auto-fill mode has been added to ;; automatically wrap fortran lines that get too long. ;; We acknowledge many contributions and valuable suggestions by ;; Lawrence R. Dodd, Ralf Fassel, Ralph Finch, Stephen Gildea, ;; Dr. Anil Gokhale, Ulrich Mueller, Mark Neale, Eric Prestemon, ;; Gary Sabot and Richard Stallman. ;;; This file may be used with GNU Emacs version 18.xx if the following ;;; variable and function substitutions are made. ;;; Replace: ;;; frame-width with screen-width ;;; auto-fill-function with auto-fill-hook ;;; comment-indent-function with comment-indent-hook ;;; (setq unread-command-events (list c)) with (setq unread-command-char c) ;;; Bugs to bug-fortran-mode@erl.mit.edu (defconst fortran-mode-version "version 1.30.6") ;;; Code: ;;;###autoload (defvar fortran-tab-mode-default nil "*Default tabbing/carriage control style for empty files in Fortran mode. A value of t specifies tab-digit style of continuation control. A value of nil specifies that continuation lines are marked with a character in column 6.") ;; Buffer local, used to display mode line. (defvar fortran-tab-mode-string nil "String to appear in mode line when TAB format mode is on.") (defvar fortran-do-indent 3 "*Extra indentation applied to DO blocks.") (defvar fortran-if-indent 3 "*Extra indentation applied to IF blocks.") (defvar fortran-structure-indent 3 "*Extra indentation applied to STRUCTURE, UNION, MAP and INTERFACE blocks.") (defvar fortran-continuation-indent 5 "*Extra indentation applied to Fortran continuation lines.") (defvar fortran-comment-indent-style 'fixed "*nil forces comment lines not to be touched, 'fixed makes fixed comment indentation to `fortran-comment-line-extra-indent' columns beyond `fortran-minimum-statement-indent-fixed' (for `indent-tabs-mode' of nil) or `fortran-minimum-statement-indent-tab' (for `indent-tabs-mode' of t), and 'relative indents to current Fortran indentation plus `fortran-comment-line-extra-indent'.") (defvar fortran-comment-line-extra-indent 0 "*Amount of extra indentation for text within full-line comments.") (defvar comment-line-start nil "*Delimiter inserted to start new full-line comment.") (defvar comment-line-start-skip nil "*Regexp to match the start of a full-line comment.") (defvar fortran-minimum-statement-indent-fixed 6 "*Minimum statement indentation for fixed format continuation style.") (defvar fortran-minimum-statement-indent-tab (max tab-width 6) "*Minimum statement indentation for TAB format continuation style.") ;; Note that this is documented in the v18 manuals as being a string ;; of length one rather than a single character. ;; The code in this file accepts either format for compatibility. (defvar fortran-comment-indent-char " " "*Single-character string inserted for Fortran comment indentation. Normally a space.") (defvar fortran-line-number-indent 1 "*Maximum indentation for Fortran line numbers. 5 means right-justify them within their five-column field.") (defvar fortran-check-all-num-for-matching-do nil "*Non-nil causes all numbered lines to be treated as possible DO loop ends.") (defvar fortran-blink-matching-if nil "*Non-nil causes \\[fortran-indent-line] on ENDIF statement to blink on matching IF. Also, from an ENDDO statement blink on matching DO [WHILE] statement.") (defvar fortran-continuation-string "$" "*Single-character string used for Fortran continuation lines. In fixed format continuation style, this character is inserted in column 6 by \\[fortran-split-line] to begin a continuation line. Also, if \\[fortran-indent-line] finds this at the beginning of a line, it will convert the line into a continuation line of the appropriate style. Normally $.") (defvar fortran-comment-region "c$$$" "*String inserted by \\[fortran-comment-region]\ at start of each line in region.") (defvar fortran-electric-line-number t "*Non-nil causes line number digits to be moved to the correct column as\ typed.") (defvar fortran-startup-message t "*Non-nil displays a startup message when Fortran mode is first called.") (defvar fortran-column-ruler-fixed "0 4 6 10 20 30 40 5\ \0 60 70\n\ \[ ]|{ | | | | | | | | \ \| | | | |}\n" "*String displayed above current line by \\[fortran-column-ruler]. This variable used in fixed format mode.") (defvar fortran-column-ruler-tab "0 810 20 30 40 5\ \0 60 70\n\ \[ ]| { | | | | | | | | \ \| | | | |}\n" "*String displayed above current line by \\[fortran-column-ruler]. This variable used in TAB format mode.") (defconst bug-fortran-mode "bug-fortran-mode@erl.mit.edu" "Address of mailing list for Fortran mode bugs.") (defvar fortran-mode-syntax-table nil "Syntax table in use in Fortran mode buffers.") (defvar fortran-analyze-depth 100 "Number of lines to scan to determine whether to use fixed or TAB format\ style.") (defvar fortran-break-before-delimiters t "*Non-nil causes `fortran-fill' to break lines before delimiters.") (if fortran-mode-syntax-table () (setq fortran-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?\; "w" fortran-mode-syntax-table) (modify-syntax-entry ?\r " " fortran-mode-syntax-table) (modify-syntax-entry ?+ "." fortran-mode-syntax-table) (modify-syntax-entry ?- "." fortran-mode-syntax-table) (modify-syntax-entry ?= "." fortran-mode-syntax-table) (modify-syntax-entry ?* "." fortran-mode-syntax-table) (modify-syntax-entry ?/ "." fortran-mode-syntax-table) (modify-syntax-entry ?\' "\"" fortran-mode-syntax-table) (modify-syntax-entry ?\" "\"" fortran-mode-syntax-table) (modify-syntax-entry ?\\ "/" fortran-mode-syntax-table) (modify-syntax-entry ?. "w" fortran-mode-syntax-table) (modify-syntax-entry ?_ "w" fortran-mode-syntax-table) (modify-syntax-entry ?\! "<" fortran-mode-syntax-table) (modify-syntax-entry ?\n ">" fortran-mode-syntax-table)) ;; Comments are real pain in Fortran because there is no way to represent the ;; standard comment syntax in an Emacs syntax table (we can for VAX-style). ;; Therefore an unmatched quote in a standard comment will throw fontification ;; off on the wrong track. So we do syntactic fontification with regexps. ;; Regexps done by simon@gnu with help from Ulrik Dickow and ;; probably others Si's forgotten about (sorry). (defconst fortran-font-lock-keywords-1 nil "Subdued level highlighting for Fortran mode.") (defconst fortran-font-lock-keywords-2 nil "Medium level highlighting for Fortran mode.") (defconst fortran-font-lock-keywords-3 nil "Gaudy level highlighting for Fortran mode.") (let ((comment-chars "c!*") (fortran-type-types ; (make-regexp ; (let ((simple-types '("character" "byte" "integer" "logical" ; "none" "real" "complex" ; "double[ \t]*precision" "double[ \t]*complex")) ; (structured-types '("structure" "union" "map")) ; (other-types '("record" "dimension" "parameter" "common" "save" ; "external" "intrinsic" "data" "equivalence"))) ; (append ; (mapcar (lambda (x) (concat "implicit[ \t]*" x)) simple-types) ; simple-types ; (mapcar (lambda (x) (concat "end[ \t]*" x)) structured-types) ; structured-types ; other-types))) (concat "byte\\|c\\(haracter\\|om\\(mon\\|plex\\)\\)\\|" "d\\(ata\\|imension\\|ouble" "[ \t]*\\(complex\\|precision\\)\\)\\|" "e\\(nd[ \t]*\\(map\\|structure\\|union\\)\\|" "quivalence\\|xternal\\)\\|" "i\\(mplicit[ \t]*\\(byte\\|" "c\\(haracter\\|omplex\\)\\|" "double[ \t]*\\(complex\\|precision\\)\\|" "integer\\|logical\\|none\\|real\\)\\|" "nt\\(eger\\|rinsic\\)\\)\\|" "logical\\|map\\|none\\|parameter\\|re\\(al\\|cord\\)\\|" "s\\(ave\\|tructure\\)\\|union")) (fortran-keywords ; ("continue" "format" "end" "enddo" "if" "then" "else" "endif" ; "elseif" "while" "inquire" "stop" "return" "include" "open" ; "close" "read" "write" "format" "print") (concat "c\\(lose\\|ontinue\\)\\|" "e\\(lse\\(\\|if\\)\\|nd\\(\\|do\\|if\\)\\)\\|format\\|" "i\\(f\\|n\\(clude\\|quire\\)\\)\\|open\\|print\\|" "re\\(ad\\|turn\\)\\|stop\\|then\\|w\\(hile\\|rite\\)")) (fortran-logicals ; ("and" "or" "not" "lt" "le" "eq" "ge" "gt" "ne" "true" "false") "and\\|eq\\|false\\|g[et]\\|l[et]\\|n\\(e\\|ot\\)\\|or\\|true")) (setq fortran-font-lock-keywords-1 (list ;; ;; Fontify syntactically (assuming strings cannot be quoted or span lines). (cons (concat "^[" comment-chars "].*") 'font-lock-comment-face) '(fortran-match-!-comment . font-lock-comment-face) (list (concat "^[^" comment-chars "\t\n]" (make-string 71 ?.) "\\(.*\\)") '(1 font-lock-comment-face)) '("'[^'\n]*'?" . font-lock-string-face) ;; ;; Program, subroutine and function declarations, plus calls. (list (concat "\\<\\(block[ \t]*data\\|call\\|entry\\|function\\|" "program\\|subroutine\\)\\>[ \t]*\\(\\sw+\\)?") '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t)))) (setq fortran-font-lock-keywords-2 (append fortran-font-lock-keywords-1 (list ;; ;; Fontify all type specifiers (must be first; see below). (cons (concat "\\<\\(" fortran-type-types "\\)\\>") 'font-lock-type-face) ;; ;; Fontify all builtin keywords (except logical, do and goto; see below). (concat "\\<\\(" fortran-keywords "\\)\\>") ;; ;; Fontify all builtin operators. (concat "\\.\\(" fortran-logicals "\\)\\.") ;; ;; Fontify do/goto keywords and targets, and goto tags. (list "\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)?" '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t)) (cons "^ *\\([0-9]+\\)" 'font-lock-reference-face)))) (setq fortran-font-lock-keywords-3 (append ;; ;; The list `fortran-font-lock-keywords-1'. fortran-font-lock-keywords-1 ;; ;; Fontify all type specifiers plus their declared items. (list (list (concat "\\<\\(" fortran-type-types "\\)\\>[ \t(/]*\\(*\\)?") ;; Fontify the type specifier. '(1 font-lock-type-face) ;; Fontify each declaration item (or just the /.../ block name). '(font-lock-match-c++-style-declaration-item-and-skip-to-next ;; Start after any *(...) expression. (and (match-beginning 15) (forward-sexp 1)) ;; No need to clean up. nil ;; Fontify as a variable name, functions are fontified elsewhere. (1 font-lock-variable-name-face nil t)))) ;; ;; Things extra to `fortran-font-lock-keywords-3' (must be done first). (list ;; ;; Fontify goto-like `err=label'/`end=label' in read/write statements. '(", *\\(e\\(nd\\|rr\\)\\)\\> *\\(= *\\([0-9]+\\)\\)?" (1 font-lock-keyword-face) (4 font-lock-reference-face nil t)) ;; ;; Highlight standard continuation character and in a TAB-formatted line. '("^ \\([^ 0]\\)" 1 font-lock-string-face) '("^\t\\([1-9]\\)" 1 font-lock-string-face)) ;; ;; The list `fortran-font-lock-keywords-2' less that for types (see above). (cdr (nthcdr (length fortran-font-lock-keywords-1) fortran-font-lock-keywords-2)))) ) (defvar fortran-font-lock-keywords fortran-font-lock-keywords-1 "Default expressions to highlight in Fortran mode.") (defvar fortran-mode-map () "Keymap used in Fortran mode.") (if fortran-mode-map () (setq fortran-mode-map (make-sparse-keymap)) (define-key fortran-mode-map ";" 'fortran-abbrev-start) (define-key fortran-mode-map "\C-c;" 'fortran-comment-region) (define-key fortran-mode-map "\e\C-a" 'beginning-of-fortran-subprogram) (define-key fortran-mode-map "\e\C-e" 'end-of-fortran-subprogram) (define-key fortran-mode-map "\e;" 'fortran-indent-comment) (define-key fortran-mode-map "\e\C-h" 'mark-fortran-subprogram) (define-key fortran-mode-map "\e\n" 'fortran-split-line) (define-key fortran-mode-map "\n" 'fortran-indent-new-line) (define-key fortran-mode-map "\e\C-q" 'fortran-indent-subprogram) (define-key fortran-mode-map "\C-c\C-w" 'fortran-window-create-momentarily) (define-key fortran-mode-map "\C-c\C-r" 'fortran-column-ruler) (define-key fortran-mode-map "\C-c\C-p" 'fortran-previous-statement) (define-key fortran-mode-map "\C-c\C-n" 'fortran-next-statement) (define-key fortran-mode-map "\t" 'fortran-indent-line) (define-key fortran-mode-map "0" 'fortran-electric-line-number) (define-key fortran-mode-map "1" 'fortran-electric-line-number) (define-key fortran-mode-map "2" 'fortran-electric-line-number) (define-key fortran-mode-map "3" 'fortran-electric-line-number) (define-key fortran-mode-map "4" 'fortran-electric-line-number) (define-key fortran-mode-map "5" 'fortran-electric-line-number) (define-key fortran-mode-map "6" 'fortran-electric-line-number) (define-key fortran-mode-map "7" 'fortran-electric-line-number) (define-key fortran-mode-map "8" 'fortran-electric-line-number) (define-key fortran-mode-map "9" 'fortran-electric-line-number)) (defvar fortran-mode-abbrev-table nil) (if fortran-mode-abbrev-table () (let ((ac abbrevs-changed)) (define-abbrev-table 'fortran-mode-abbrev-table ()) (define-abbrev fortran-mode-abbrev-table ";au" "automatic" nil) (define-abbrev fortran-mode-abbrev-table ";b" "byte" nil) (define-abbrev fortran-mode-abbrev-table ";bd" "block data" nil) (define-abbrev fortran-mode-abbrev-table ";ch" "character" nil) (define-abbrev fortran-mode-abbrev-table ";cl" "close" nil) (define-abbrev fortran-mode-abbrev-table ";c" "continue" nil) (define-abbrev fortran-mode-abbrev-table ";cm" "common" nil) (define-abbrev fortran-mode-abbrev-table ";cx" "complex" nil) (define-abbrev fortran-mode-abbrev-table ";df" "define" nil) (define-abbrev fortran-mode-abbrev-table ";di" "dimension" nil) (define-abbrev fortran-mode-abbrev-table ";do" "double" nil) (define-abbrev fortran-mode-abbrev-table ";dc" "double complex" nil) (define-abbrev fortran-mode-abbrev-table ";dp" "double precision" nil) (define-abbrev fortran-mode-abbrev-table ";dw" "do while" nil) (define-abbrev fortran-mode-abbrev-table ";e" "else" nil) (define-abbrev fortran-mode-abbrev-table ";ed" "enddo" nil) (define-abbrev fortran-mode-abbrev-table ";el" "elseif" nil) (define-abbrev fortran-mode-abbrev-table ";en" "endif" nil) (define-abbrev fortran-mode-abbrev-table ";eq" "equivalence" nil) (define-abbrev fortran-mode-abbrev-table ";ew" "endwhere" nil) (define-abbrev fortran-mode-abbrev-table ";ex" "external" nil) (define-abbrev fortran-mode-abbrev-table ";ey" "entry" nil) (define-abbrev fortran-mode-abbrev-table ";f" "format" nil) (define-abbrev fortran-mode-abbrev-table ";fa" ".false." nil) (define-abbrev fortran-mode-abbrev-table ";fu" "function" nil) (define-abbrev fortran-mode-abbrev-table ";g" "goto" nil) (define-abbrev fortran-mode-abbrev-table ";im" "implicit" nil) (define-abbrev fortran-mode-abbrev-table ";ib" "implicit byte" nil) (define-abbrev fortran-mode-abbrev-table ";ic" "implicit complex" nil) (define-abbrev fortran-mode-abbrev-table ";ich" "implicit character" nil) (define-abbrev fortran-mode-abbrev-table ";ii" "implicit integer" nil) (define-abbrev fortran-mode-abbrev-table ";il" "implicit logical" nil) (define-abbrev fortran-mode-abbrev-table ";ir" "implicit real" nil) (define-abbrev fortran-mode-abbrev-table ";inc" "include" nil) (define-abbrev fortran-mode-abbrev-table ";in" "integer" nil) (define-abbrev fortran-mode-abbrev-table ";intr" "intrinsic" nil) (define-abbrev fortran-mode-abbrev-table ";l" "logical" nil) (define-abbrev fortran-mode-abbrev-table ";n" "namelist" nil) (define-abbrev fortran-mode-abbrev-table ";o" "open" nil) ; was ;op (define-abbrev fortran-mode-abbrev-table ";pa" "parameter" nil) (define-abbrev fortran-mode-abbrev-table ";pr" "program" nil) (define-abbrev fortran-mode-abbrev-table ";ps" "pause" nil) (define-abbrev fortran-mode-abbrev-table ";p" "print" nil) (define-abbrev fortran-mode-abbrev-table ";rc" "record" nil) (define-abbrev fortran-mode-abbrev-table ";re" "real" nil) (define-abbrev fortran-mode-abbrev-table ";r" "read" nil) (define-abbrev fortran-mode-abbrev-table ";rt" "return" nil) (define-abbrev fortran-mode-abbrev-table ";rw" "rewind" nil) (define-abbrev fortran-mode-abbrev-table ";s" "stop" nil) (define-abbrev fortran-mode-abbrev-table ";sa" "save" nil) (define-abbrev fortran-mode-abbrev-table ";st" "structure" nil) (define-abbrev fortran-mode-abbrev-table ";sc" "static" nil) (define-abbrev fortran-mode-abbrev-table ";su" "subroutine" nil) (define-abbrev fortran-mode-abbrev-table ";tr" ".true." nil) (define-abbrev fortran-mode-abbrev-table ";ty" "type" nil) (define-abbrev fortran-mode-abbrev-table ";vo" "volatile" nil) (define-abbrev fortran-mode-abbrev-table ";w" "write" nil) (define-abbrev fortran-mode-abbrev-table ";wh" "where" nil) (setq abbrevs-changed ac))) ;;;###autoload (defun fortran-mode () "Major mode for editing Fortran code. \\[fortran-indent-line] indents the current Fortran line correctly. DO statements must not share a common CONTINUE. Type ;? or ;\\[help-command] to display a list of built-in\ abbrevs for Fortran keywords. Key definitions: \\{fortran-mode-map} Variables controlling indentation style and extra features: comment-start Normally nil in Fortran mode. If you want to use comments starting with `!', set this to the string \"!\". fortran-do-indent Extra indentation within do blocks. (default 3) fortran-if-indent Extra indentation within if blocks. (default 3) fortran-structure-indent Extra indentation within structure, union, map and interface blocks. (default 3) fortran-continuation-indent Extra indentation applied to continuation statements. (default 5) fortran-comment-line-extra-indent Amount of extra indentation for text within full-line comments. (default 0) fortran-comment-indent-style nil means don't change indentation of text in full-line comments, fixed means indent that text at `fortran-comment-line-extra-indent' beyond the value of `fortran-minimum-statement-indent-fixed' (for fixed format continuation style) or `fortran-minimum-statement-indent-tab' (for TAB format continuation style). relative means indent at `fortran-comment-line-extra-indent' beyond the indentation for a line of code. (default 'fixed) fortran-comment-indent-char Single-character string to be inserted instead of space for full-line comment indentation. (default \" \") fortran-minimum-statement-indent-fixed Minimum indentation for Fortran statements in fixed format mode. (def.6) fortran-minimum-statement-indent-tab Minimum indentation for Fortran statements in TAB format mode. (default 9) fortran-line-number-indent Maximum indentation for line numbers. A line number will get less than this much indentation if necessary to avoid reaching column 5. (default 1) fortran-check-all-num-for-matching-do Non-nil causes all numbered lines to be treated as possible \"continue\" statements. (default nil) fortran-blink-matching-if Non-nil causes \\[fortran-indent-line] on an ENDIF statement to blink on matching IF. Also, from an ENDDO statement, blink on matching DO [WHILE] statement. (default nil) fortran-continuation-string Single-character string to be inserted in column 5 of a continuation line. (default \"$\") fortran-comment-region String inserted by \\[fortran-comment-region] at start of each line in region. (default \"c$$$\") fortran-electric-line-number Non-nil causes line number digits to be moved to the correct column as typed. (default t) fortran-break-before-delimiters Non-nil causes `fortran-fill' breaks lines before delimiters. (default t) fortran-startup-message Set to nil to inhibit message first time Fortran mode is used. Turning on Fortran mode calls the value of the variable `fortran-mode-hook' with no args, if that value is non-nil." (interactive) (kill-all-local-variables) (if fortran-startup-message (message "Emacs Fortran mode %s. Bugs to %s" fortran-mode-version bug-fortran-mode)) (setq fortran-startup-message nil) (setq local-abbrev-table fortran-mode-abbrev-table) (set-syntax-table fortran-mode-syntax-table) ;; Font Lock mode support. (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '((fortran-font-lock-keywords fortran-font-lock-keywords-1 fortran-font-lock-keywords-2 fortran-font-lock-keywords-3) t t ((?/ . "$/")))) (make-local-variable 'fortran-break-before-delimiters) (setq fortran-break-before-delimiters t) (make-local-variable 'indent-line-function) (setq indent-line-function 'fortran-indent-line) (make-local-variable 'comment-indent-function) (setq comment-indent-function 'fortran-comment-hook) (make-local-variable 'comment-line-start-skip) (setq comment-line-start-skip "^[Cc*]\\(\\([^ \t\n]\\)\\2\\2*\\)?[ \t]*\\|^#.*") (make-local-variable 'comment-line-start) (setq comment-line-start "c") (make-local-variable 'comment-start-skip) (setq comment-start-skip "![ \t]*") (make-local-variable 'comment-start) (setq comment-start nil) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'abbrev-all-caps) (setq abbrev-all-caps t) (make-local-variable 'indent-tabs-mode) (setq indent-tabs-mode nil) ;;;(setq abbrev-mode t) ; ?? (abbrev-mode 1) instead?? (setq fill-column 72) ; Already local? (use-local-map fortran-mode-map) (setq mode-name "Fortran") (setq major-mode 'fortran-mode) ;;;(make-local-variable 'fortran-tab-mode) (make-local-variable 'fortran-comment-line-extra-indent) (make-local-variable 'fortran-minimum-statement-indent-fixed) (make-local-variable 'fortran-minimum-statement-indent-tab) (make-local-variable 'fortran-column-ruler-fixed) (make-local-variable 'fortran-column-ruler-tab) (make-local-variable 'fortran-tab-mode-string) (setq fortran-tab-mode-string " TAB-format") (setq indent-tabs-mode (fortran-analyze-file-format)) (run-hooks 'fortran-mode-hook)) (defun fortran-comment-hook () (save-excursion (skip-chars-backward " \t") (max (+ 1 (current-column)) comment-column))) (defun fortran-indent-comment () "Align or create comment on current line. Existing comments of all types are recognized and aligned. If the line has no comment, a side-by-side comment is inserted and aligned if the value of comment-start is not nil. Otherwise, a separate-line comment is inserted, on this line or on a new line inserted before this line if this line is not blank." (interactive) (beginning-of-line) ;; Recognize existing comments of either kind. (cond ((looking-at comment-line-start-skip) (fortran-indent-line)) ((fortran-find-comment-start-skip) ; catches any inline comment and ; leaves point after comment-start-skip (if comment-start-skip (progn (goto-char (match-beginning 0)) (if (not (= (current-column) (fortran-comment-hook))) (progn (delete-horizontal-space) (indent-to (fortran-comment-hook))))) (end-of-line))) ; otherwise goto end of line or sth else? ;; No existing comment. ;; If side-by-side comments are defined, insert one, ;; unless line is now blank. ((and comment-start (not (looking-at "^[ \t]*$"))) (end-of-line) (delete-horizontal-space) (indent-to (fortran-comment-hook)) (insert comment-start)) ;; Else insert separate-line comment, making a new line if nec. (t (if (looking-at "^[ \t]*$") (delete-horizontal-space) (beginning-of-line) (insert "\n") (forward-char -1)) (insert comment-line-start) (insert-char (if (stringp fortran-comment-indent-char) (aref fortran-comment-indent-char 0) fortran-comment-indent-char) (- (calculate-fortran-indent) (current-column)))))) (defun fortran-comment-region (beg-region end-region arg) "Comments every line in the region. Puts fortran-comment-region at the beginning of every line in the region. BEG-REGION and END-REGION are args which specify the region boundaries. With non-nil ARG, uncomments the region." (interactive "*r\nP") (let ((end-region-mark (make-marker)) (save-point (point-marker))) (set-marker end-region-mark end-region) (goto-char beg-region) (beginning-of-line) (if (not arg) ;comment the region (progn (insert fortran-comment-region) (while (and (= (forward-line 1) 0) (< (point) end-region-mark)) (insert fortran-comment-region))) (let ((com (regexp-quote fortran-comment-region))) ;uncomment the region (if (looking-at com) (delete-region (point) (match-end 0))) (while (and (= (forward-line 1) 0) (< (point) end-region-mark)) (if (looking-at com) (delete-region (point) (match-end 0)))))) (goto-char save-point) (set-marker end-region-mark nil) (set-marker save-point nil))) (defun fortran-abbrev-start () "Typing ;\\[help-command] or ;? lists all the Fortran abbrevs. Any other key combination is executed normally." (interactive) (let (c) (insert last-command-char) (if (or (eq (setq c (read-event)) ??) ;insert char if not equal to `?' (eq c help-char)) (fortran-abbrev-help) (setq unread-command-events (list c))))) (defun fortran-abbrev-help () "List the currently defined abbrevs in Fortran mode." (interactive) (message "Listing abbrev table...") (display-buffer (fortran-prepare-abbrev-list-buffer)) (message "Listing abbrev table...done")) (defun fortran-prepare-abbrev-list-buffer () (save-excursion (set-buffer (get-buffer-create "*Abbrevs*")) (erase-buffer) (insert-abbrev-table-description 'fortran-mode-abbrev-table t) (goto-char (point-min)) (set-buffer-modified-p nil) (edit-abbrevs-mode)) (get-buffer-create "*Abbrevs*")) (defun fortran-column-ruler () "Inserts a column ruler momentarily above current line, till next keystroke. The ruler is defined by the value of `fortran-column-ruler-fixed' when in fixed format mode, and `fortran-column-ruler-tab' when in TAB format mode. The key typed is executed unless it is SPC." (interactive) (momentary-string-display (if indent-tabs-mode fortran-column-ruler-tab fortran-column-ruler-fixed) (save-excursion (beginning-of-line) (if (eq (window-start (selected-window)) (window-point (selected-window))) (progn (forward-line) (point)) (point))) nil "Type SPC or any command to erase ruler.")) (defun fortran-window-create () "Makes the window 72 columns wide. See also `fortran-window-create-momentarily'." (interactive) (condition-case error (progn (let ((window-min-width 2)) (if (< (window-width) (frame-width)) (enlarge-window-horizontally (- (frame-width) (window-width) 1))) (split-window-horizontally 73) (other-window 1) (switch-to-buffer " fortran-window-extra" t) (select-window (previous-window)))) (error (message "No room for Fortran window.") 'error))) (defun fortran-window-create-momentarily (&optional arg) "Momentarily makes the window 72 columns wide. Optional ARG non-nil and non-unity disables the momentary feature. See also `fortran-window-create'." (interactive "p") (if (or (not arg) (= arg 1)) (save-window-excursion (if (not (equal (fortran-window-create) 'error)) (progn (message "Type SPC to continue editing.") (let ((char (read-event))) (or (equal char (string-to-char " ")) (setq unread-command-events (list char))))))) (fortran-window-create))) (defun fortran-split-line () "Break line at point and insert continuation marker and alignment." (interactive) (delete-horizontal-space) (if (save-excursion (beginning-of-line) (looking-at comment-line-start-skip)) (insert "\n" comment-line-start " ") (if indent-tabs-mode (progn (insert "\n\t") (insert-char (fortran-numerical-continuation-char) 1)) (insert "\n " fortran-continuation-string)));Space after \n important (fortran-indent-line)) ;when the cont string is C, c or *. (defun fortran-numerical-continuation-char () "Return a digit for tab-digit style of continuation lines. If, previous line is a tab-digit continuation line, returns that digit plus one. Otherwise return 1. Zero not allowed." (save-excursion (forward-line -1) (if (looking-at "\t[1-9]") (+ ?1 (% (- (char-after (+ (point) 1)) ?0) 9)) ?1))) (defun delete-horizontal-regexp (chars) "Delete all characters in CHARS around point. CHARS is like the inside of a [...] in a regular expression except that ] is never special and \ quotes ^, - or \." (interactive "*s") (skip-chars-backward chars) (delete-region (point) (progn (skip-chars-forward chars) (point)))) (defun fortran-electric-line-number (arg) "Self insert, but if part of a Fortran line number indent it automatically. Auto-indent does not happen if a numeric arg is used." (interactive "P") (if (or arg (not fortran-electric-line-number)) (if arg (self-insert-command (prefix-numeric-value arg)) (self-insert-command 1)) (if (or (and (= 5 (current-column)) (save-excursion (beginning-of-line) (looking-at " ")));In col 5 with only spaces to left. (and (= (if indent-tabs-mode fortran-minimum-statement-indent-tab fortran-minimum-statement-indent-fixed) (current-column)) (save-excursion (beginning-of-line) (looking-at "\t"));In col 8 with a single tab to the left. (not (or (eq last-command 'fortran-indent-line) (eq last-command 'fortran-indent-new-line)))) (save-excursion (re-search-backward "[^ \t0-9]" (save-excursion (beginning-of-line) (point)) t)) ;not a line number (looking-at "[0-9]") ;within a line number ) (self-insert-command (prefix-numeric-value arg)) (skip-chars-backward " \t") (insert last-command-char) (fortran-indent-line)))) (defun beginning-of-fortran-subprogram () "Moves point to the beginning of the current Fortran subprogram." (interactive) (let ((case-fold-search t)) (beginning-of-line -1) (re-search-backward "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]" nil 'move) (if (looking-at "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]") (forward-line 1)))) (defun end-of-fortran-subprogram () "Moves point to the end of the current Fortran subprogram." (interactive) (let ((case-fold-search t)) (beginning-of-line 2) (re-search-forward "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]" nil 'move) (goto-char (match-beginning 0)) (forward-line 1))) (defun mark-fortran-subprogram () "Put mark at end of Fortran subprogram, point at beginning. The marks are pushed." (interactive) (end-of-fortran-subprogram) (push-mark (point)) (beginning-of-fortran-subprogram)) (defun fortran-previous-statement () "Moves point to beginning of the previous Fortran statement. Returns `first-statement' if that statement is the first non-comment Fortran statement in the file, and nil otherwise." (interactive) (let (not-first-statement continue-test) (beginning-of-line) (setq continue-test (and (not (looking-at comment-line-start-skip)) (or (looking-at (concat "[ \t]*" (regexp-quote fortran-continuation-string))) (or (looking-at " [^ 0\n]") (looking-at "\t[1-9]"))))) (while (and (setq not-first-statement (= (forward-line -1) 0)) (or (looking-at comment-line-start-skip) (looking-at "[ \t]*$") (looking-at " [^ 0\n]") (looking-at "\t[1-9]") (looking-at (concat "[ \t]*" comment-start-skip))))) (cond ((and continue-test (not not-first-statement)) (message "Incomplete continuation statement.")) (continue-test (fortran-previous-statement)) ((not not-first-statement) 'first-statement)))) (defun fortran-next-statement () "Moves point to beginning of the next Fortran statement. Returns `last-statement' if that statement is the last non-comment Fortran statement in the file, and nil otherwise." (interactive) (let (not-last-statement) (beginning-of-line) (while (and (setq not-last-statement (and (= (forward-line 1) 0) (not (eobp)))) (or (looking-at comment-line-start-skip) (looking-at "[ \t]*$") (looking-at " [^ 0\n]") (looking-at "\t[1-9]") (looking-at (concat "[ \t]*" comment-start-skip))))) (if (not not-last-statement) 'last-statement))) (defun fortran-blink-matching-if () ;; From a Fortran ENDIF statement, blink the matching IF statement. (let ((top-of-window (window-start)) matching-if (endif-point (point)) message) (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "end[ \t]*if\\b")) (progn (if (not (setq matching-if (fortran-beginning-if))) (setq message "No matching if.") (if (< matching-if top-of-window) (save-excursion (goto-char matching-if) (beginning-of-line) (setq message (concat "Matches " (buffer-substring (point) (progn (end-of-line) (point)))))))) (if message (message "%s" message) (goto-char matching-if) (sit-for 1) (goto-char endif-point)))))) (defun fortran-blink-matching-do () ;; From a Fortran ENDDO statement, blink on the matching DO or DO WHILE ;; statement. This is basically copied from fortran-blink-matching-if. (let ((top-of-window (window-start)) matching-do (enddo-point (point)) message) (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "end[ \t]*do\\b")) (progn (if (not (setq matching-do (fortran-beginning-do))) (setq message "No matching do.") (if (< matching-do top-of-window) (save-excursion (goto-char matching-do) (beginning-of-line) (setq message (concat "Matches " (buffer-substring (point) (progn (end-of-line) (point)))))))) (if message (message "%s" message) (goto-char matching-do) (sit-for 1) (goto-char enddo-point)))))) (defun fortran-mark-do () "Put mark at end of Fortran DO [WHILE]-ENDDO construct, point at beginning. The marks are pushed." (interactive) (let (enddo-point do-point) (if (setq enddo-point (fortran-end-do)) (if (not (setq do-point (fortran-beginning-do))) (message "No matching do.") ;; Set mark, move point. (goto-char enddo-point) (push-mark) (goto-char do-point))))) (defun fortran-end-do () ;; Search forward for first unmatched ENDDO. Return point or nil. (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "end[ \t]*do\\b")) ;; Sitting on one. (match-beginning 0) ;; Search for one. (save-excursion (let ((count 1)) (while (and (not (= count 0)) (not (eq (fortran-next-statement) 'last-statement)) ;; Keep local to subprogram (not (looking-at "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]"))) (skip-chars-forward " \t0-9") (cond ((looking-at "end[ \t]*do\\b") (setq count (- count 1))) ((looking-at "do[ \t]+[^0-9]") (setq count (+ count 1))))) (and (= count 0) ;; All pairs accounted for. (point)))))) (defun fortran-beginning-do () ;; Search backwards for first unmatched DO [WHILE]. Return point or nil. (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "do[ \t]+")) ;; Sitting on one. (match-beginning 0) ;; Search for one. (save-excursion (let ((count 1)) (while (and (not (= count 0)) (not (eq (fortran-previous-statement) 'first-statement)) ;; Keep local to subprogram (not (looking-at "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]"))) (skip-chars-forward " \t0-9") (cond ((looking-at "do[ \t]+[^0-9]") (setq count (- count 1))) ((looking-at "end[ \t]*do\\b") (setq count (+ count 1))))) (and (= count 0) ;; All pairs accounted for. (point)))))) (defun fortran-mark-if () "Put mark at end of Fortran IF-ENDIF construct, point at beginning. The marks are pushed." (interactive) (let (endif-point if-point) (if (setq endif-point (fortran-end-if)) (if (not (setq if-point (fortran-beginning-if))) (message "No matching if.") ;; Set mark, move point. (goto-char endif-point) (push-mark) (goto-char if-point))))) (defun fortran-end-if () ;; Search forwards for first unmatched ENDIF. Return point or nil. (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "end[ \t]*if\\b")) ;; Sitting on one. (match-beginning 0) ;; Search for one. The point has been already been moved to first ;; letter on line but this should not cause troubles. (save-excursion (let ((count 1)) (while (and (not (= count 0)) (not (eq (fortran-next-statement) 'last-statement)) ;; Keep local to subprogram. (not (looking-at "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]"))) (skip-chars-forward " \t0-9") (cond ((looking-at "end[ \t]*if\\b") (setq count (- count 1))) ((looking-at "if[ \t]*(") (save-excursion (if (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") (let (then-test) ; Multi-line if-then. (while (and (= (forward-line 1) 0) ;; Search forward for then. (or (looking-at " [^ 0\n]") (looking-at "\t[1-9]")) (not (setq then-test (looking-at ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) then-test)) (setq count (+ count 1))))))) (and (= count 0) ;; All pairs accounted for. (point)))))) (defun fortran-beginning-if () ;; Search backwards for first unmatched IF-THEN. Return point or nil. (if (save-excursion ;; May be sitting on multi-line if-then statement, first move to ;; beginning of current statement. Note: `fortran-previous-statement' ;; moves to previous statement *unless* current statement is first ;; one. Only move forward if not first-statement. (if (not (eq (fortran-previous-statement) 'first-statement)) (fortran-next-statement)) (skip-chars-forward " \t0-9") (and (looking-at "if[ \t]*(") (save-match-data (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") ;; Multi-line if-then. (let (then-test) (while (and (= (forward-line 1) 0) ;; Search forward for then. (or (looking-at " [^ 0\n]") (looking-at "\t[1-9]")) (not (setq then-test (looking-at ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) then-test))))) ;; Sitting on one. (match-beginning 0) ;; Search for one. (save-excursion (let ((count 1)) (while (and (not (= count 0)) (not (eq (fortran-previous-statement) 'first-statement)) ;; Keep local to subprogram. (not (looking-at "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]"))) (skip-chars-forward " \t0-9") (cond ((looking-at "if[ \t]*(") (save-excursion (if (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") (let (then-test) ; Multi-line if-then. (while (and (= (forward-line 1) 0) ;; Search forward for then. (or (looking-at " [^ 0\n]") (looking-at "\t[1-9]")) (not (setq then-test (looking-at ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) then-test)) (setq count (- count 1))))) ((looking-at "end[ \t]*if\\b") (setq count (+ count 1))))) (and (= count 0) ;; All pairs accounted for. (point)))))) (defun fortran-indent-line () "Indents current Fortran line based on its contents and on previous lines." (interactive) (let ((cfi (calculate-fortran-indent))) (save-excursion (beginning-of-line) (if (or (not (= cfi (fortran-current-line-indentation))) (and (re-search-forward "^[ \t]*[0-9]+" (+ (point) 4) t) (not (fortran-line-number-indented-correctly-p)))) (fortran-indent-to-column cfi) (beginning-of-line) (if (and (not (looking-at comment-line-start-skip)) (fortran-find-comment-start-skip)) (fortran-indent-comment)))) ;; Never leave point in left margin. (if (< (current-column) cfi) (move-to-column cfi)) (if (and auto-fill-function (> (save-excursion (end-of-line) (current-column)) fill-column)) (save-excursion (end-of-line) (fortran-fill))) (if fortran-blink-matching-if (progn (fortran-blink-matching-if) (fortran-blink-matching-do))))) (defun fortran-indent-new-line () "Reindent the current Fortran line, insert a newline and indent the newline. An abbrev before point is expanded if `abbrev-mode' is non-nil." (interactive) (if abbrev-mode (expand-abbrev)) (save-excursion (beginning-of-line) (skip-chars-forward " \t") (if (or (looking-at "[0-9]") ;Reindent only where it is most (looking-at "end") ;likely to be necessary (looking-at "else") (looking-at (regexp-quote fortran-continuation-string))) (fortran-indent-line))) (newline) (fortran-indent-line)) (defun fortran-indent-subprogram () "Properly indents the Fortran subprogram which contains point." (interactive) (save-excursion (mark-fortran-subprogram) (message "Indenting subprogram...") (indent-region (point) (mark) nil)) (message "Indenting subprogram...done.")) (defun calculate-fortran-indent () "Calculates the Fortran indent column based on previous lines." (let (icol first-statement (case-fold-search t) (fortran-minimum-statement-indent (if indent-tabs-mode fortran-minimum-statement-indent-tab fortran-minimum-statement-indent-fixed))) (save-excursion (setq first-statement (fortran-previous-statement)) (if first-statement (setq icol fortran-minimum-statement-indent) (progn (if (= (point) (point-min)) (setq icol fortran-minimum-statement-indent) (setq icol (fortran-current-line-indentation))) (skip-chars-forward " \t0-9") (cond ((looking-at "if[ \t]*(") (if (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t_$(=a-z0-9]") (let (then-test) ;multi-line if-then (while (and (= (forward-line 1) 0) ;;search forward for then (or (looking-at " [^ 0\n]") (looking-at "\t[1-9]")) (not (setq then-test (looking-at ".*then\\b[ \t]\ *[^ \t_$(=a-z0-9]"))))) then-test)) (setq icol (+ icol fortran-if-indent)))) ((looking-at "\\(else\\|elseif\\)\\b") (setq icol (+ icol fortran-if-indent))) ((looking-at "select[ \t]*case[ \t](.*)\\b") (setq icol (+ icol fortran-if-indent))) ((looking-at "case[ \t]*(.*)[ \t]*\n") (setq icol (+ icol fortran-if-indent))) ((looking-at "case[ \t]*default\\b") (setq icol (+ icol fortran-if-indent))) ((looking-at "\\(otherwise\\|else[ \t]*where\\)\\b") (setq icol (+ icol fortran-if-indent))) ((looking-at "where[ \t]*(.*)[ \t]*\n") (setq icol (+ icol fortran-if-indent))) ((looking-at "do\\b") (setq icol (+ icol fortran-do-indent))) ((looking-at "\\(structure\\|union\\|map\\|interface\\)\\b[ \t]*[^ \t=(a-z]") (setq icol (+ icol fortran-structure-indent))) ((looking-at "end\\b[ \t]*[^ \t=(a-z]") ;; Previous END resets indent to minimum (setq icol fortran-minimum-statement-indent)))))) (save-excursion (beginning-of-line) (cond ((looking-at "[ \t]*$")) ((looking-at comment-line-start-skip) (cond ((eq fortran-comment-indent-style 'relative) (setq icol (+ icol fortran-comment-line-extra-indent))) ((eq fortran-comment-indent-style 'fixed) (setq icol (+ fortran-minimum-statement-indent fortran-comment-line-extra-indent)))) (setq fortran-minimum-statement-indent 0)) ((or (looking-at (concat "[ \t]*" (regexp-quote fortran-continuation-string))) (looking-at " [^ 0\n]") (looking-at "\t[1-9]")) (setq icol (+ icol fortran-continuation-indent))) ((looking-at "[ \t]*#") ; Check for cpp directive. (setq fortran-minimum-statement-indent 0 icol 0)) (first-statement) ((and fortran-check-all-num-for-matching-do (looking-at "[ \t]*[0-9]+") (fortran-check-for-matching-do)) (setq icol (- icol fortran-do-indent))) (t (skip-chars-forward " \t0-9") (cond ((looking-at "end[ \t]*if\\b") (setq icol (- icol fortran-if-indent))) ((looking-at "\\(else\\|elseif\\)\\b") (setq icol (- icol fortran-if-indent))) ((looking-at "case[ \t]*(.*)[ \t]*\n") (setq icol (- icol fortran-if-indent))) ((looking-at "case[ \t]*default\\b") (setq icol (- icol fortran-if-indent))) ((looking-at "\\(otherwise\\|else[ \t]*where\\)\\b") (setq icol (- icol fortran-if-indent))) ((looking-at "end[ \t]*where\\b") (setq icol (- icol fortran-if-indent))) ((and (looking-at "continue\\b") (fortran-check-for-matching-do)) (setq icol (- icol fortran-do-indent))) ((looking-at "end[ \t]*do\\b") (setq icol (- icol fortran-do-indent))) ((looking-at "end[ \t]*\ \\(structure\\|union\\|map\\|interface\\)\\b[ \t]*[^ \t=(a-z]") (setq icol (- icol fortran-structure-indent))) ((looking-at "end[ \t]*select\\b[ \t]*[^ \t=(a-z]") (setq icol (- icol fortran-if-indent))) ((and (looking-at "end\\b[ \t]*[^ \t=(a-z]") (not (= icol fortran-minimum-statement-indent))) (message "Warning: `end' not in column %d. Probably\ an unclosed block." fortran-minimum-statement-indent)))))) (max fortran-minimum-statement-indent icol))) (defun fortran-current-line-indentation () "Indentation of current line, ignoring Fortran line number or continuation. This is the column position of the first non-whitespace character aside from the line number and/or column 5/8 line-continuation character. For comment lines, returns indentation of the first non-indentation text within the comment." (save-excursion (beginning-of-line) (cond ((looking-at comment-line-start-skip) (goto-char (match-end 0)) (skip-chars-forward (if (stringp fortran-comment-indent-char) fortran-comment-indent-char (char-to-string fortran-comment-indent-char)))) ((or (looking-at " [^ 0\n]") (looking-at "\t[1-9]")) (goto-char (match-end 0))) (t ;; Move past line number. (skip-chars-forward "[ \t0-9]");From Uli )) ;; Move past whitespace. (skip-chars-forward " \t") (current-column))) (defun fortran-indent-to-column (col) "Indents current line with spaces to column COL. notes: 1) A non-zero/non-blank character in column 5 indicates a continuation line, and this continuation character is retained on indentation; 2) If `fortran-continuation-string' is the first non-whitespace character, this is a continuation line; 3) A non-continuation line which has a number as the first non-whitespace character is a numbered line. 4) A TAB followed by a digit indicates a continuation line." (save-excursion (beginning-of-line) (if (looking-at comment-line-start-skip) (if fortran-comment-indent-style (let ((char (if (stringp fortran-comment-indent-char) (aref fortran-comment-indent-char 0) fortran-comment-indent-char))) (goto-char (match-end 0)) (delete-horizontal-regexp (concat " \t" (char-to-string char))) (insert-char char (- col (current-column))))) (if (looking-at "\t[1-9]") (if indent-tabs-mode (goto-char (match-end 0)) (delete-char 2) (insert " ") (insert fortran-continuation-string)) (if (looking-at " [^ 0\n]") (if indent-tabs-mode (progn (delete-char 6) (insert "\t") (insert-char (fortran-numerical-continuation-char) 1)) (forward-char 6)) (delete-horizontal-space) ;; Put line number in columns 0-4 ;; or put continuation character in column 5. (cond ((eobp)) ((looking-at (regexp-quote fortran-continuation-string)) (if indent-tabs-mode (progn (indent-to (if indent-tabs-mode fortran-minimum-statement-indent-tab fortran-minimum-statement-indent-fixed)) (delete-char 1) (insert-char (fortran-numerical-continuation-char) 1)) (indent-to 5) (forward-char 1))) ((looking-at "[0-9]+") (let ((extra-space (- 5 (- (match-end 0) (point))))) (if (< extra-space 0) (message "Warning: line number exceeds 5-digit limit.") (indent-to (min fortran-line-number-indent extra-space)))) (skip-chars-forward "0-9"))))) ;; Point is now after any continuation character or line number. ;; Put body of statement where specified. (delete-horizontal-space) (indent-to col) ;; Indent any comment following code on the same line. (if (and comment-start-skip (fortran-find-comment-start-skip)) (progn (goto-char (match-beginning 0)) (if (not (= (current-column) (fortran-comment-hook))) (progn (delete-horizontal-space) (indent-to (fortran-comment-hook))))))))) (defun fortran-line-number-indented-correctly-p () "Return t if current line's line number is correctly indented. Do not call if there is no line number." (save-excursion (beginning-of-line) (skip-chars-forward " \t") (and (<= (current-column) fortran-line-number-indent) (or (= (current-column) fortran-line-number-indent) (progn (skip-chars-forward "0-9") (= (current-column) 5)))))) (defun fortran-check-for-matching-do () "When called from a numbered statement, returns t if matching DO is found. Otherwise return a nil." (let (charnum (case-fold-search t)) (save-excursion (beginning-of-line) (if (looking-at "[ \t]*[0-9]+") (progn (skip-chars-forward " \t") (skip-chars-forward "0") ;skip past leading zeros (setq charnum (buffer-substring (point) (progn (skip-chars-forward "0-9") (point)))) (beginning-of-line) (and (re-search-backward (concat "\\(^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]\\)\\|" "\\(^[ \t0-9]*do[ \t]*0*" charnum "\\b\\)\\|" "\\(^[ \t]*0*" charnum "\\b\\)") nil t) (looking-at (concat "^[ \t0-9]*do[ \t]*0*" charnum)))))))) (defun fortran-find-comment-start-skip () "Move to past `comment-start-skip' found on current line. Return t if `comment-start-skip' found, nil if not." ;;; In order to move point only if comment-start-skip is found, ;;; this one uses a lot of save-excursions. Note that re-search-forward ;;; moves point even if comment-start-skip is inside a string-constant. ;;; Some code expects certain values for match-beginning and end (interactive) (if (save-excursion (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t)) (let ((save-match-beginning (match-beginning 0)) (save-match-end (match-end 0))) (if (fortran-is-in-string-p (match-beginning 0)) (save-excursion (goto-char save-match-end) (fortran-find-comment-start-skip)) ; recurse for rest of line (goto-char save-match-beginning) (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t) (goto-char (match-end 0)) t)) nil)) ;;;From: simon@gnu (Simon Marshall) ;;; Find the next ! not in a string. (defun fortran-match-!-comment (limit) (let (found) (while (and (setq found (search-forward "!" limit t)) (fortran-is-in-string-p (point)))) (if (not found) nil ;; Cheaper than `looking-at' "!.*". (store-match-data (list (1- (point)) (progn (end-of-line) (min (point) limit)))) t))) ;; The above function is about 10% faster than the below... ;;(defun fortran-match-!-comment (limit) ;; (let (found) ;; (while (and (setq found (re-search-forward "!.*" limit t)) ;; (fortran-is-in-string-p (match-beginning 0)))) ;; found)) ;;;From: ralf@up3aud1.gwdg.de (Ralf Fassel) ;;; Test if TAB format continuation lines work. (defun fortran-is-in-string-p (where) "Return non-nil if POS (a buffer position) is inside a Fortran string, nil else." (save-excursion (goto-char where) (cond ((bolp) nil) ; bol is never inside a string ((save-excursion ; comment lines too (beginning-of-line)(looking-at comment-line-start-skip)) nil) (t (let (;; ok, serious now. Init some local vars: (parse-state '(0 nil nil nil nil nil 0)) (quoted-comment-start (if comment-start (regexp-quote comment-start))) (not-done t) parse-limit end-of-line ) ;; move to start of current statement (fortran-next-statement) (fortran-previous-statement) ;; now parse up to WHERE (while not-done (if (or ;; skip to next line if: ;; - comment line? (looking-at comment-line-start-skip) ;; - at end of line? (eolp) ;; - not in a string and after comment-start? (and (not (nth 3 parse-state)) comment-start (equal comment-start (char-to-string (preceding-char))))) ;; get around a bug in forward-line in versions <= 18.57 (if (or (> (forward-line 1) 0) (eobp)) (setq not-done nil)) ;; else: ;; if we are at beginning of code line, skip any ;; whitespace, labels and tab continuation markers. (if (bolp) (skip-chars-forward " \t0-9")) ;; if we are in column <= 5 now, check for continuation char (cond ((= 5 (current-column)) (forward-char 1)) ((and (< (current-column) 5) (equal fortran-continuation-string (char-to-string (following-char))) (forward-char 1)))) ;; find out parse-limit from here (setq end-of-line (save-excursion (end-of-line)(point))) (setq parse-limit (min where end-of-line)) ;; parse max up to comment-start, if non-nil and in current line (if comment-start (save-excursion (if (re-search-forward quoted-comment-start end-of-line t) (setq parse-limit (min (point) parse-limit))))) ;; now parse if still in limits (if (< (point) where) (setq parse-state (parse-partial-sexp (point) parse-limit nil nil parse-state)) (setq not-done nil)) )) ;; result is (nth 3 parse-state)))))) (defun fortran-auto-fill-mode (arg) "Toggle fortran-auto-fill mode. With ARG, turn `fortran-auto-fill' mode on iff ARG is positive. In `fortran-auto-fill' mode, inserting a space at a column beyond `fill-column' automatically breaks the line at a previous space." (interactive "P") (prog1 (setq auto-fill-function (if (if (null arg) (not auto-fill-function) (> (prefix-numeric-value arg) 0)) 'fortran-do-auto-fill nil)) (force-mode-line-update))) (defun fortran-do-auto-fill () (if (> (current-column) fill-column) (fortran-indent-line))) (defun fortran-fill () (interactive) (let* ((opoint (point)) (bol (save-excursion (beginning-of-line) (point))) (eol (save-excursion (end-of-line) (point))) (bos (min eol (+ bol (fortran-current-line-indentation)))) (quote (save-excursion (goto-char bol) (if (looking-at comment-line-start-skip) nil ; OK to break quotes on comment lines. (move-to-column fill-column) (cond ((fortran-is-in-string-p (point)) (save-excursion (re-search-backward "[^']'[^']" bol t) (if fortran-break-before-delimiters (point) (1+ (point))))) (t nil))))) ;; ;; decide where to split the line. If a position for a quoted ;; string was found above then use that, else break the line ;; before the last delimiter. ;; Delimiters are whitespace, commas, and operators. ;; Will break before a pair of *'s. ;; (fill-point (or quote (save-excursion (move-to-column (1+ fill-column)) (skip-chars-backward "^ \t\n,'+-/*=)" ;;; (if fortran-break-before-delimiters ;;; "^ \t\n,'+-/*=" "^ \t\n,'+-/*=)") ) (if (<= (point) (1+ bos)) (progn (move-to-column (1+ fill-column)) ;;;what is this doing??? (if (not (re-search-forward "[\t\n,'+-/*)=]" eol t)) (goto-char bol)))) (if (bolp) (re-search-forward "[ \t]" opoint t) (forward-char -1) (if (looking-at "'") (forward-char 1) (skip-chars-backward " \t\*"))) (if fortran-break-before-delimiters (point) (1+ (point)))))) ) ;; if we are in an in-line comment, don't break unless the ;; line of code is longer than it should be. Otherwise ;; break the line at the column computed above. ;; ;; Need to use fortran-find-comment-start-skip to make sure that quoted !'s ;; don't prevent a break. (if (not (or (save-excursion (if (and (re-search-backward comment-start-skip bol t) (not (fortran-is-in-string-p (point)))) (progn (skip-chars-backward " \t") (< (current-column) (1+ fill-column))))) (save-excursion (goto-char fill-point) (bolp)))) (if (> (save-excursion (goto-char fill-point) (current-column)) (1+ fill-column)) (progn (goto-char fill-point) (fortran-break-line)) (save-excursion (if (> (save-excursion (goto-char fill-point) (current-column)) (+ (calculate-fortran-indent) fortran-continuation-indent)) (progn (goto-char fill-point) (fortran-break-line)))))) )) (defun fortran-break-line () (let ((opoint (point)) (bol (save-excursion (beginning-of-line) (point))) (eol (save-excursion (end-of-line) (point))) (comment-string nil)) (save-excursion (if (and comment-start-skip (fortran-find-comment-start-skip)) (progn (re-search-backward comment-start-skip bol t) (setq comment-string (buffer-substring (point) eol)) (delete-region (point) eol)))) ;;; Forward line 1 really needs to go to next non white line (if (save-excursion (forward-line 1) (or (looking-at " [^ 0\n]") (looking-at "\t[1-9]"))) (progn (end-of-line) (delete-region (point) (match-end 0)) (delete-horizontal-space) (fortran-fill)) (fortran-split-line)) (if comment-string (save-excursion (goto-char bol) (end-of-line) (delete-horizontal-space) (indent-to (fortran-comment-hook)) (insert comment-string))))) (defun fortran-analyze-file-format () "Returns nil if fixed format is used, t if TAB formatting is used. Use `fortran-tab-mode-default' if no non-comment statements are found in the file before the end or the first `fortran-analyze-depth' lines." (let ((i 0)) (save-excursion (goto-char (point-min)) (setq i 0) (while (not (or (eobp) (looking-at "\t") (looking-at " ") (> i fortran-analyze-depth))) (forward-line) (setq i (1+ i))) (cond ((looking-at "\t") t) ((looking-at " ") nil) (fortran-tab-mode-default t) (t nil))))) (or (assq 'fortran-tab-mode-string minor-mode-alist) (setq minor-mode-alist (cons '(fortran-tab-mode-string (indent-tabs-mode fortran-tab-mode-string)) minor-mode-alist))) (provide 'fortran) ;;; fortran.el ends here emacs-19.30/lisp/frame.el100444 75424 1 67546 5770237271 13741 0ustar kwzhdaemon;;; frame.el --- multi-frame management independent of window systems. ;;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal ;;; This file is part of GNU Emacs. ;;; ;;; GNU Emacs is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2, or (at your option) ;;; any later version. ;;; ;;; GNU Emacs is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Emacs; see the file COPYING. If not, write to ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (defvar frame-creation-function nil "Window-system dependent function to call to create a new frame. The window system startup file should set this to its frame creation function, which should take an alist of parameters as its argument.") ;;; The initial value given here for this must ask for a minibuffer. ;;; There must always exist a frame with a minibuffer, and after we ;;; delete the terminal frame, this will be the only frame. (defvar initial-frame-alist '((minibuffer . t)) "Alist of frame parameters for creating the initial X window frame. You can set this in your `.emacs' file; for example, (setq initial-frame-alist '((top . 1) (left . 1) (width . 80) (height . 55))) Parameters specified here supersede the values given in `default-frame-alist'. If the value calls for a frame without a minibuffer, and you have not created a minibuffer frame on your own, one is created according to `minibuffer-frame-alist'. You can specify geometry-related options for just the initial frame by setting this variable in your `.emacs' file; however, they won't take effect until Emacs reads `.emacs', which happens after first creating the frame. If you want the frame to have the proper geometry as soon as it appears, you need to use this three-step process: * Specify X resources to give the geometry you want. * Set `default-frame-alist' to override these options so that they don't affect subsequent frames. * Set `initial-frame-alist' in a way that matches the X resources, to override what you put in `default-frame-alist'.") (defvar minibuffer-frame-alist '((width . 80) (height . 2)) "Alist of frame parameters for initially creating a minibuffer frame. You can set this in your `.emacs' file; for example, (setq minibuffer-frame-alist '((top . 1) (left . 1) (width . 80) (height . 2))) Parameters specified here supersede the values given in `default-frame-alist'.") (defvar pop-up-frame-alist nil "Alist of frame parameters used when creating pop-up frames. Pop-up frames are used for completions, help, and the like. This variable can be set in your init file, like this: (setq pop-up-frame-alist '((width . 80) (height . 20))) These supersede the values given in `default-frame-alist'.") (setq pop-up-frame-function (function (lambda () (make-frame pop-up-frame-alist)))) (defvar special-display-frame-alist '((height . 14) (width . 80) (unsplittable . t)) "*Alist of frame parameters used when creating special frames. Special frames are used for buffers whose names are in `special-display-buffer-names' and for buffers whose names match one of the regular expressions in `special-display-regexps'. This variable can be set in your init file, like this: (setq special-display-frame-alist '((width . 80) (height . 20))) These supersede the values given in `default-frame-alist'.") ;; Display BUFFER in its own frame, reusing an existing window if any. ;; Return the window chosen. ;; Currently we do not insist on selecting the window within its frame. ;; If ARGS is an alist, use it as a list of frame parameter specs. ;; If ARGS is a list whose car is a symbol, ;; use (car ARGS) as a function to do the work. ;; Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args. (defun special-display-popup-frame (buffer &optional args) (if (and args (symbolp (car args))) (apply (car args) buffer (cdr args)) (let ((window (get-buffer-window buffer t))) (if window ;; If we have a window already, make it visible. (let ((frame (window-frame window))) (make-frame-visible frame) (raise-frame frame) window) ;; If no window yet, make one in a new frame. (let ((frame (make-frame (append args special-display-frame-alist)))) (set-window-buffer (frame-selected-window frame) buffer) (set-window-dedicated-p (frame-selected-window frame) t) (frame-selected-window frame)))))) ;; Handle delete-frame events from the X server. (defun handle-delete-frame (event) (interactive "e") (let ((frame (posn-window (event-start event))) (i 0) (tail (frame-list))) (while tail (and (frame-visible-p (car tail)) (not (eq (car tail) frame)) (setq i (1+ i))) (setq tail (cdr tail))) (if (> i 0) (delete-frame frame t) (kill-emacs)))) ;;;; Arrangement of frames at startup ;;; 1) Load the window system startup file from the lisp library and read the ;;; high-priority arguments (-q and the like). The window system startup ;;; file should create any frames specified in the window system defaults. ;;; ;;; 2) If no frames have been opened, we open an initial text frame. ;;; ;;; 3) Once the init file is done, we apply any newly set parameters ;;; in initial-frame-alist to the frame. ;; These are now called explicitly at the proper times, ;; since that is easier to understand. ;; Actually using hooks within Emacs is bad for future maintenance. --rms. ;; (add-hook 'before-init-hook 'frame-initialize) ;; (add-hook 'window-setup-hook 'frame-notice-user-settings) ;;; If we create the initial frame, this is it. (defvar frame-initial-frame nil) ;; Record the parameters used in frame-initialize to make the initial frame. (defvar frame-initial-frame-alist) (defvar frame-initial-geometry-arguments nil) ;;; startup.el calls this function before loading the user's init ;;; file - if there is no frame with a minibuffer open now, create ;;; one to display messages while loading the init file. (defun frame-initialize () ;; Are we actually running under a window system at all? (if (and window-system (not noninteractive)) (progn ;; Turn on special-display processing only if there's a window system. (setq special-display-function 'special-display-popup-frame) ;; If there is no frame with a minibuffer besides the terminal ;; frame, then we need to create the opening frame. Make sure ;; it has a minibuffer, but let initial-frame-alist omit the ;; minibuffer spec. (or (delq terminal-frame (minibuffer-frame-list)) (progn (setq frame-initial-frame-alist (append initial-frame-alist default-frame-alist)) ;; Record these with their default values ;; if they don't have any values explicitly. (or (assq 'vertical-scroll-bars frame-initial-frame-alist) (setq frame-initial-frame-alist (cons '(vertical-scroll-bars . t) frame-initial-frame-alist))) (or (assq 'horizontal-scroll-bars frame-initial-frame-alist) (setq frame-initial-frame-alist (cons '(horizontal-scroll-bars . t) frame-initial-frame-alist))) (setq default-minibuffer-frame (setq frame-initial-frame (make-frame initial-frame-alist))) ;; Delete any specifications for window geometry parameters ;; so that we won't reapply them in frame-notice-user-settings. ;; It would be wrong to reapply them then, ;; because that would override explicit user resizing. (setq initial-frame-alist (frame-remove-geometry-params initial-frame-alist)))) ;; At this point, we know that we have a frame open, so we ;; can delete the terminal frame. (delete-frame terminal-frame) (setq terminal-frame nil)) ;; No, we're not running a window system. Use make-terminal-frame if ;; we support that feature, otherwise arrange to cause errors. (setq frame-creation-function (if (fboundp 'make-terminal-frame) 'make-terminal-frame (function (lambda (parameters) (error "Can't create multiple frames without a window system"))))))) ;;; startup.el calls this function after loading the user's init ;;; file. Now default-frame-alist and initial-frame-alist contain ;;; information to which we must react; do what needs to be done. (defun frame-notice-user-settings () ;; Make menu-bar-mode and default-frame-alist consistent. (if (boundp 'menu-bar-mode) (let ((default (assq 'menu-bar-lines default-frame-alist))) (if default (setq menu-bar-mode (not (eq (cdr default) 0))) (setq default-frame-alist (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0)) default-frame-alist))))) ;; Creating and deleting frames may shift the selected frame around, ;; and thus the current buffer. Protect against that. We don't ;; want to use save-excursion here, because that may also try to set ;; the buffer of the selected window, which fails when the selected ;; window is the minibuffer. (let ((old-buffer (current-buffer))) ;; If the initial frame is still around, apply initial-frame-alist ;; and default-frame-alist to it. (if (frame-live-p frame-initial-frame) ;; The initial frame we create above always has a minibuffer. ;; If the user wants to remove it, or make it a minibuffer-only ;; frame, then we'll have to delete the current frame and make a ;; new one; you can't remove or add a root window to/from an ;; existing frame. ;; ;; NOTE: default-frame-alist was nil when we created the ;; existing frame. We need to explicitly include ;; default-frame-alist in the parameters of the screen we ;; create here, so that its new value, gleaned from the user's ;; .emacs file, will be applied to the existing screen. (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist) (assq 'minibuffer default-frame-alist) '(minibuffer . t))) t)) ;; Create the new frame. (let (parms new) ;; If the frame isn't visible yet, wait till it is. ;; If the user has to position the window, ;; Emacs doesn't know its real position until ;; the frame is seen to be visible. (while (not (cdr (assq 'visibility (frame-parameters frame-initial-frame)))) (sleep-for 1)) (setq parms (frame-parameters frame-initial-frame)) ;; Get rid of `name' unless it was specified explicitly before. (or (assq 'name frame-initial-frame-alist) (setq parms (delq (assq 'name parms) parms))) (setq parms (append initial-frame-alist default-frame-alist parms nil)) ;; Get rid of `reverse', because that was handled ;; when we first made the frame. (setq parms (cons '(reverse) (delq (assq 'reverse parms) parms))) (if (assq 'height frame-initial-geometry-arguments) (setq parms (frame-delete-all 'height parms))) (if (assq 'width frame-initial-geometry-arguments) (setq parms (frame-delete-all 'width parms))) (if (assq 'left frame-initial-geometry-arguments) (setq parms (frame-delete-all 'left parms))) (if (assq 'top frame-initial-geometry-arguments) (setq parms (frame-delete-all 'top parms))) (setq new (make-frame ;; Use the geometry args that created the existing ;; frame, rather than the parms we get for it. (append frame-initial-geometry-arguments '((user-size . t) (user-position . t)) parms))) ;; The initial frame, which we are about to delete, may be ;; the only frame with a minibuffer. If it is, create a ;; new one. (or (delq frame-initial-frame (minibuffer-frame-list)) (make-initial-minibuffer-frame nil)) ;; If the initial frame is serving as a surrogate ;; minibuffer frame for any frames, we need to wean them ;; onto a new frame. The default-minibuffer-frame ;; variable must be handled similarly. (let ((users-of-initial (filtered-frame-list (function (lambda (frame) (and (not (eq frame frame-initial-frame)) (eq (window-frame (minibuffer-window frame)) frame-initial-frame))))))) (if (or users-of-initial (eq default-minibuffer-frame frame-initial-frame)) ;; Choose an appropriate frame. Prefer frames which ;; are only minibuffers. (let* ((new-surrogate (car (or (filtered-frame-list (function (lambda (frame) (eq (cdr (assq 'minibuffer (frame-parameters frame))) 'only)))) (minibuffer-frame-list)))) (new-minibuffer (minibuffer-window new-surrogate))) (if (eq default-minibuffer-frame frame-initial-frame) (setq default-minibuffer-frame new-surrogate)) ;; Wean the frames using frame-initial-frame as ;; their minibuffer frame. (mapcar (function (lambda (frame) (modify-frame-parameters frame (list (cons 'minibuffer new-minibuffer))))) users-of-initial)))) ;; Redirect events enqueued at this frame to the new frame. ;; Is this a good idea? (redirect-frame-focus frame-initial-frame new) ;; Finally, get rid of the old frame. (delete-frame frame-initial-frame t)) ;; Otherwise, we don't need all that rigamarole; just apply ;; the new parameters. (let (newparms allparms tail) (setq allparms (append initial-frame-alist default-frame-alist)) (if (assq 'height frame-initial-geometry-arguments) (setq allparms (frame-delete-all 'height allparms))) (if (assq 'width frame-initial-geometry-arguments) (setq allparms (frame-delete-all 'width allparms))) (if (assq 'left frame-initial-geometry-arguments) (setq allparms (frame-delete-all 'left allparms))) (if (assq 'top frame-initial-geometry-arguments) (setq allparms (frame-delete-all 'top allparms))) (setq tail allparms) ;; Find just the parms that have changed since we first ;; made this frame. Those are the ones actually set by ;; the init file. For those parms whose values we already knew ;; (such as those spec'd by command line options) ;; it is undesirable to specify the parm again ;; once the user has seen the frame and been able to alter it ;; manually. (while tail (let (newval oldval) (setq oldval (assq (car (car tail)) frame-initial-frame-alist)) (setq newval (cdr (assq (car (car tail)) allparms))) (or (and oldval (eq (cdr oldval) newval)) (setq newparms (cons (cons (car (car tail)) newval) newparms)))) (setq tail (cdr tail))) (setq newparms (nreverse newparms)) (modify-frame-parameters frame-initial-frame newparms) (if (assq 'font newparms) (frame-update-faces frame-initial-frame))))) ;; Restore the original buffer. (set-buffer old-buffer) ;; Make sure the initial frame can be GC'd if it is ever deleted. ;; Make sure frame-notice-user-settings does nothing if called twice. (setq frame-initial-frame nil))) (defun make-initial-minibuffer-frame (display) (let ((parms (append minibuffer-frame-alist '((minibuffer . only))))) (if display (make-frame-on-display display parms) (make-frame parms)))) ;; Delete from ALIST all elements whose car is KEY. ;; Return the modified alist. (defun frame-delete-all (key alist) (setq alist (copy-sequence alist)) (let ((tail alist)) (while tail (if (eq (car (car tail)) key) (setq alist (delq (car tail) alist))) (setq tail (cdr tail))) alist)) ;;;; Creation of additional frames, and other frame miscellanea ;;; Return some frame other than the current frame, creating one if ;;; necessary. Note that the minibuffer frame, if separate, is not ;;; considered (see next-frame). (defun get-other-frame () (let ((s (if (equal (next-frame (selected-frame)) (selected-frame)) (make-frame) (next-frame (selected-frame))))) s)) (defun next-multiframe-window () "Select the next window, regardless of which frame it is on." (interactive) (select-window (next-window (selected-window) (> (minibuffer-depth) 0) t))) (defun previous-multiframe-window () "Select the previous window, regardless of which frame it is on." (interactive) (select-window (previous-window (selected-window) (> (minibuffer-depth) 0) t))) (defun make-frame-on-display (display &optional parameters) "Make a frame on display DISPLAY. The optional second argument PARAMETERS specifies additional frame parameters." (interactive "sMake frame on display: ") (make-frame (cons (cons 'display display) parameters))) ;; Alias, kept temporarily. (defalias 'new-frame 'make-frame) (defun make-frame (&optional parameters) "Create a new frame, displaying the current buffer. Optional argument PARAMETERS is an alist of parameters for the new frame. Specifically, PARAMETERS is a list of pairs, each having the form (NAME . VALUE). Here are some of the parameters allowed (not a complete list): \(name . STRING) - The frame should be named STRING. \(height . NUMBER) - The frame should be NUMBER text lines high. If this parameter is present, the width parameter must also be given. \(width . NUMBER) - The frame should be NUMBER characters in width. If this parameter is present, the height parameter must also be given. \(minibuffer . t) - the frame should have a minibuffer \(minibuffer . nil) - the frame should have no minibuffer \(minibuffer . only) - the frame should contain only a minibuffer \(minibuffer . WINDOW) - the frame should use WINDOW as its minibuffer window." (interactive) (let ((nframe)) (run-hooks 'before-make-frame-hook) (setq nframe (funcall frame-creation-function parameters)) (run-hooks 'after-make-frame-hook) nframe)) (defun filtered-frame-list (predicate) "Return a list of all live frames which satisfy PREDICATE." (let ((frames (frame-list)) good-frames) (while (consp frames) (if (funcall predicate (car frames)) (setq good-frames (cons (car frames) good-frames))) (setq frames (cdr frames))) good-frames)) (defun minibuffer-frame-list () "Return a list of all frames with their own minibuffers." (filtered-frame-list (function (lambda (frame) (eq frame (window-frame (minibuffer-window frame))))))) (defun frame-remove-geometry-params (param-list) "Return the parameter list PARAM-LIST, but with geometry specs removed. This deletes all bindings in PARAM-LIST for `top', `left', `width', `height', `user-size' and `user-position' parameters. Emacs uses this to avoid overriding explicit moves and resizings from the user during startup." (setq param-list (cons nil param-list)) (let ((tail param-list)) (while (consp (cdr tail)) (if (and (consp (car (cdr tail))) (memq (car (car (cdr tail))) '(height width top left user-position user-size))) (progn (setq frame-initial-geometry-arguments (cons (car (cdr tail)) frame-initial-geometry-arguments)) (setcdr tail (cdr (cdr tail)))) (setq tail (cdr tail))))) (setq frame-initial-geometry-arguments (nreverse frame-initial-geometry-arguments)) (cdr param-list)) (defun other-frame (arg) "Select the ARG'th different visible frame, and raise it. All frames are arranged in a cyclic order. This command selects the frame ARG steps away in that order. A negative ARG moves in the opposite order." (interactive "p") (let ((frame (selected-frame))) (while (> arg 0) (setq frame (next-frame frame)) (while (not (eq (frame-visible-p frame) t)) (setq frame (next-frame frame))) (setq arg (1- arg))) (while (< arg 0) (setq frame (previous-frame frame)) (while (not (eq (frame-visible-p frame) t)) (setq frame (previous-frame frame))) (setq arg (1+ arg))) (raise-frame frame) (select-frame frame) (set-mouse-position (selected-frame) (1- (frame-width)) 0) (if (fboundp 'unfocus-frame) (unfocus-frame)))) ;;;; Frame configurations (defun current-frame-configuration () "Return a list describing the positions and states of all frames. Its car is `frame-configuration'. Each element of the cdr is a list of the form (FRAME ALIST WINDOW-CONFIG), where FRAME is a frame object, ALIST is an association list specifying some of FRAME's parameters, and WINDOW-CONFIG is a window configuration object for FRAME." (cons 'frame-configuration (mapcar (function (lambda (frame) (list frame (frame-parameters frame) (current-window-configuration frame)))) (frame-list)))) (defun set-frame-configuration (configuration &optional nodelete) "Restore the frames to the state described by CONFIGURATION. Each frame listed in CONFIGURATION has its position, size, window configuration, and other parameters set as specified in CONFIGURATION. Ordinarily, this function deletes all existing frames not listed in CONFIGURATION. But if optional second argument NODELETE is given and non-nil, the unwanted frames are iconified instead." (or (frame-configuration-p configuration) (signal 'wrong-type-argument (list 'frame-configuration-p configuration))) (let ((config-alist (cdr configuration)) frames-to-delete) (mapcar (function (lambda (frame) (let ((parameters (assq frame config-alist))) (if parameters (progn (modify-frame-parameters frame ;; Since we can't set a frame's minibuffer status, ;; we might as well omit the parameter altogether. (let* ((parms (nth 1 parameters)) (mini (assq 'minibuffer parms))) (if mini (setq parms (delq mini parms))) parms)) (set-window-configuration (nth 2 parameters))) (setq frames-to-delete (cons frame frames-to-delete)))))) (frame-list)) (if nodelete ;; Note: making frames invisible here was tried ;; but led to some strange behavior--each time the frame ;; was made visible again, the window manager asked afresh ;; for where to put it. (mapcar 'iconify-frame frames-to-delete) (mapcar 'delete-frame frames-to-delete)))) ;;;; Convenience functions for accessing and interactively changing ;;;; frame parameters. (defun frame-height (&optional frame) "Return number of lines available for display on FRAME. If FRAME is omitted, describe the currently selected frame." (cdr (assq 'height (frame-parameters frame)))) (defun frame-width (&optional frame) "Return number of columns available for display on FRAME. If FRAME is omitted, describe the currently selected frame." (cdr (assq 'width (frame-parameters frame)))) (defun set-default-font (font-name) "Set the font of the selected frame to FONT. When called interactively, prompt for the name of the font to use." (interactive "sFont name: ") (modify-frame-parameters (selected-frame) (list (cons 'font font-name))) ;; Update faces that want a bold or italic version of the default font. (frame-update-faces (selected-frame))) (defun set-background-color (color-name) "Set the background color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use." (interactive "sColor: ") (modify-frame-parameters (selected-frame) (list (cons 'background-color color-name))) (frame-update-face-colors (selected-frame))) (defun set-foreground-color (color-name) "Set the foreground color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use." (interactive "sColor: ") (modify-frame-parameters (selected-frame) (list (cons 'foreground-color color-name))) (frame-update-face-colors (selected-frame))) (defun set-cursor-color (color-name) "Set the text cursor color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use." (interactive "sColor: ") (modify-frame-parameters (selected-frame) (list (cons 'cursor-color color-name)))) (defun set-mouse-color (color-name) "Set the color of the mouse pointer of the selected frame to COLOR. When called interactively, prompt for the name of the color to use." (interactive "sColor: ") (modify-frame-parameters (selected-frame) (list (cons 'mouse-color color-name)))) (defun set-border-color (color-name) "Set the color of the border of the selected frame to COLOR. When called interactively, prompt for the name of the color to use." (interactive "sColor: ") (modify-frame-parameters (selected-frame) (list (cons 'border-color color-name)))) (defun auto-raise-mode (arg) "Toggle whether or not the selected frame should auto-raise. With arg, turn auto-raise mode on if and only if arg is positive. Note that this controls Emacs's own auto-raise feature. Some window managers allow you to enable auto-raise for certain windows. You can use that for Emacs windows if you wish, but if you do, that is beyond the control of Emacs and this command has no effect on it." (interactive "P") (if (null arg) (setq arg (if (cdr (assq 'auto-raise (frame-parameters (selected-frame)))) -1 1))) (modify-frame-parameters (selected-frame) (list (cons 'auto-raise (> arg 0))))) (defun auto-lower-mode (arg) "Toggle whether or not the selected frame should auto-lower. With arg, turn auto-lower mode on if and only if arg is positive. Note that this controls Emacs's own auto-lower feature. Some window managers allow you to enable auto-lower for certain windows. You can use that for Emacs windows if you wish, but if you do, that is beyond the control of Emacs and this command has no effect on it." (interactive "P") (if (null arg) (setq arg (if (cdr (assq 'auto-lower (frame-parameters (selected-frame)))) -1 1))) (modify-frame-parameters (selected-frame) (list (cons 'auto-lower (> arg 0))))) (defun toggle-scroll-bar (arg) "Toggle whether or not the selected frame has vertical scroll bars. With arg, turn vertical scroll bars on if and only if arg is positive." (interactive "P") (if (null arg) (setq arg (if (cdr (assq 'vertical-scroll-bars (frame-parameters (selected-frame)))) -1 1))) (modify-frame-parameters (selected-frame) (list (cons 'vertical-scroll-bars (> arg 0))))) (defun toggle-horizontal-scroll-bar (arg) "Toggle whether or not the selected frame has horizontal scroll bars. With arg, turn horizontal scroll bars on if and only if arg is positive. Horizontal scroll bars aren't implemented yet." (interactive "P") (error "Horizontal scroll bars aren't implemented yet")) ;;;; Aliases for backward compatibility with Emacs 18. (defalias 'screen-height 'frame-height) (defalias 'screen-width 'frame-width) (defun set-screen-width (cols &optional pretend) "Obsolete function to change the size of the screen to COLS columns.\n\ Optional second arg non-nil means that redisplay should use COLS columns\n\ but that the idea of the actual width of the frame should not be changed.\n\ This function is provided only for compatibility with Emacs 18; new code\n\ should use `set-frame-width instead'." (set-frame-width (selected-frame) cols pretend)) (defun set-screen-height (lines &optional pretend) "Obsolete function to change the height of the screen to LINES lines.\n\ Optional second arg non-nil means that redisplay should use LINES lines\n\ but that the idea of the actual height of the screen should not be changed.\n\ This function is provided only for compatibility with Emacs 18; new code\n\ should use `set-frame-width' instead." (set-frame-height (selected-frame) lines pretend)) (make-obsolete 'screen-height 'frame-height) (make-obsolete 'screen-width 'frame-width) (make-obsolete 'set-screen-width 'set-frame-width) (make-obsolete 'set-screen-height 'set-frame-height) ;;;; Key bindings (defvar ctl-x-5-map (make-sparse-keymap) "Keymap for frame commands.") (defalias 'ctl-x-5-prefix ctl-x-5-map) (define-key ctl-x-map "5" 'ctl-x-5-prefix) (define-key ctl-x-5-map "2" 'make-frame) (define-key ctl-x-5-map "0" 'delete-frame) (define-key ctl-x-5-map "o" 'other-frame) (provide 'frame) ;;; frame.el ends here emacs-19.30/lisp/gnus-cache.el100444 23053 1 30035 6046561261 14755 0ustar larsidaemon;;; gnus-cache.el --- cache interface for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Code: (require 'gnus) (defvar gnus-cache-directory (concat gnus-article-save-directory "cache/") "*The directory where cached articles will be stored.") (defvar gnus-cache-enter-articles '(ticked dormant) "*Classes of articles to enter into the cache.") (defvar gnus-cache-remove-articles '(read) "*Classes of articles to remove from the cache.") (defvar gnus-cache-buffer nil) (defun gnus-cache-change-buffer (group) (and gnus-cache-buffer ;; see if the current group's overview cache has been loaded (or (string= group (car gnus-cache-buffer)) ;; another overview cache is current, save it (gnus-cache-save-buffers))) ;; if gnus-cache buffer is nil, create it (or gnus-cache-buffer ;; create cache buffer (save-excursion (setq gnus-cache-buffer (cons group (set-buffer (get-buffer-create " *gnus-cache-overview*")))) (buffer-disable-undo (current-buffer)) ;; insert the contents of this groups cache overview (erase-buffer) (let ((file (gnus-cache-file-name group ".overview"))) (and (file-exists-p file) (insert-file-contents file))) ;; we have a fresh (empty/just loaded) buffer, ;; mark it as unmodified to save a redundant write later. (set-buffer-modified-p nil)))) (defun gnus-cache-save-buffers () ;; save the overview buffer if it exists and has been modified ;; delete empty cache subdirectories (if (null gnus-cache-buffer) () (let ((buffer (cdr gnus-cache-buffer)) (overview-file (gnus-cache-file-name (car gnus-cache-buffer) ".overview"))) ;; write the overview only if it was modified (if (buffer-modified-p buffer) (save-excursion (set-buffer buffer) (if (> (buffer-size) 0) ;; non-empty overview, write it out (progn (gnus-make-directory (file-name-directory overview-file)) (write-region (point-min) (point-max) overview-file nil 'quietly)) ;; empty overview file, remove it (and (file-exists-p overview-file) (delete-file overview-file)) ;; if possible, remove group's cache subdirectory (condition-case nil ;; FIXME: we can detect the error type and warn the user ;; of any inconsistencies (articles w/o nov entries?). ;; for now, just be conservative...delete only if safe -- sj (delete-directory (file-name-directory overview-file)) (error nil))))) ;; kill the buffer, it's either unmodified or saved (gnus-kill-buffer buffer) (setq gnus-cache-buffer nil)))) ;; Return whether an article is a member of a class. (defun gnus-cache-member-of-class (class ticked dormant unread) (or (and ticked (memq 'ticked class)) (and dormant (memq 'dormant class)) (and unread (memq 'unread class)) (and (not unread) (memq 'read class)))) (defun gnus-cache-file-name (group article) (concat (file-name-as-directory gnus-cache-directory) (if (gnus-use-long-file-name 'not-cache) group (let ((group (concat group ""))) (if (string-match ":" group) (aset group (match-beginning 0) ?/)) (gnus-replace-chars-in-string group ?. ?/))) "/" (if (stringp article) article (int-to-string article)))) (defun gnus-cache-possibly-enter-article (group article headers ticked dormant unread) (let ((number (mail-header-number headers)) file dir) (if (or (not (vectorp headers)) ; This might be a dummy article. (< number 0) ; Reffed article from other group. (not (gnus-cache-member-of-class gnus-cache-enter-articles ticked dormant unread)) (file-exists-p (setq file (gnus-cache-file-name group article)))) () ; Do nothing. ;; Possibly create the cache directory. (or (file-exists-p (setq dir (file-name-directory file))) (gnus-make-directory dir)) ;; Save the article in the cache. (if (file-exists-p file) t ; The article already is saved, so we end here. (let ((gnus-use-cache nil)) (gnus-summary-select-article)) (save-excursion (set-buffer gnus-article-buffer) (save-restriction (widen) (write-region (point-min) (point-max) file nil 'quiet)) (gnus-cache-change-buffer group) (set-buffer (cdr gnus-cache-buffer)) (goto-char (point-max)) (forward-line -1) (while (condition-case () (and (not (bobp)) (> (read (current-buffer)) number)) (error ;; The line was malformed, so we just remove it!! (gnus-delete-line) t)) (forward-line -1)) (if (bobp) (if (not (eobp)) (progn (beginning-of-line) (if (< (read (current-buffer)) number) (forward-line 1))) (beginning-of-line)) (forward-line 1)) (beginning-of-line) ;; [number subject from date id references chars lines xref] (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n" (mail-header-number headers) (mail-header-subject headers) (mail-header-from headers) (mail-header-date headers) (mail-header-id headers) (or (mail-header-references headers) "") (or (mail-header-chars headers) "") (or (mail-header-lines headers) "") (or (mail-header-xref headers) "")))) t)))) (defun gnus-cache-enter-remove-article (article) (setq gnus-cache-removeable-articles (cons article gnus-cache-removeable-articles))) (defsubst gnus-cache-possibly-remove-article (article ticked dormant unread) (let ((file (gnus-cache-file-name gnus-newsgroup-name article))) (if (or (not (file-exists-p file)) (not (gnus-cache-member-of-class gnus-cache-remove-articles ticked dormant unread))) nil (save-excursion (delete-file file) (set-buffer (cdr gnus-cache-buffer)) (goto-char (point-min)) (if (or (looking-at (concat (int-to-string article) "\t")) (search-forward (concat "\n" (int-to-string article) "\t") (point-max) t)) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))))))) (defun gnus-cache-possibly-remove-articles () (let ((articles gnus-cache-removeable-articles) (cache-articles (gnus-cache-articles-in-group gnus-newsgroup-name)) article) (gnus-cache-change-buffer gnus-newsgroup-name) (while articles (setq article (car articles) articles (cdr articles)) (if (memq article cache-articles) ;; The article was in the cache, so we see whether we are ;; supposed to remove it from the cache. (gnus-cache-possibly-remove-article article (memq article gnus-newsgroup-marked) (memq article gnus-newsgroup-dormant) (or (memq article gnus-newsgroup-unreads) (memq article gnus-newsgroup-unselected)))))) ;; the overview file might have been modified, save it ;; safe because we're only called at group exit anyway (gnus-cache-save-buffers)) (defun gnus-cache-request-article (article group) (let ((file (gnus-cache-file-name group article))) (if (not (file-exists-p file)) () (erase-buffer) ;; There may be some overlays that we have to kill... (insert "i") (let ((overlays (overlays-at (point-min)))) (while overlays (delete-overlay (car overlays)) (setq overlays (cdr overlays)))) (erase-buffer) (insert-file-contents file) t))) (defun gnus-cache-articles-in-group (group) (let ((dir (file-name-directory (gnus-cache-file-name group 1))) articles) (if (not (file-exists-p dir)) nil (setq articles (directory-files dir nil "^[0-9]+$" t)) (if (not articles) nil (sort (mapcar (function (lambda (name) (string-to-int name))) articles) '<))))) (defun gnus-cache-active-articles (group) (let ((articles (gnus-cache-articles-in-group group))) (and articles (cons (car articles) (gnus-last-element articles))))) (defun gnus-cache-possibly-alter-active (group active) (let ((cache-active (gnus-cache-active-articles group))) (and cache-active (< (car cache-active) (car active)) (setcar active (car cache-active))) (and cache-active (> (cdr cache-active) (cdr active)) (setcdr active (cdr cache-active))))) (defun gnus-cache-retrieve-headers (articles group) (let* ((cached (gnus-cache-articles-in-group group)) (articles (gnus-sorted-complement articles cached)) (cache-file (gnus-cache-file-name group ".overview")) type) (let ((gnus-use-cache nil)) (setq type (and articles (gnus-retrieve-headers articles group)))) (gnus-cache-save-buffers) (save-excursion (cond ((not (file-exists-p cache-file)) type) ((null type) (set-buffer nntp-server-buffer) (erase-buffer) (insert-file-contents cache-file) 'nov) ((eq type 'nov) (gnus-cache-braid-nov group cached) type) (t (gnus-cache-braid-heads group cached) type))))) (defun gnus-cache-braid-nov (group cached) (let ((cache-buf (get-buffer-create " *gnus-cache*")) beg end) (gnus-cache-save-buffers) (save-excursion (set-buffer cache-buf) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert-file-contents (gnus-cache-file-name group ".overview")) (goto-char (point-min)) (insert "\n") (goto-char (point-min))) (set-buffer nntp-server-buffer) (goto-char (point-min)) (while cached (while (and (not (eobp)) (< (read (current-buffer)) (car cached))) (forward-line 1)) (beginning-of-line) (save-excursion (set-buffer cache-buf) (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") nil t) (setq beg (progn (beginning-of-line) (point)) end (progn (end-of-line) (point))) (setq beg nil))) (if beg (progn (insert-buffer-substring cache-buf beg end) (insert "\n"))) (setq cached (cdr cached))) (kill-buffer cache-buf))) (defun gnus-cache-braid-heads (group cached) (let ((cache-buf (get-buffer-create " *gnus-cache*"))) (save-excursion (set-buffer cache-buf) (buffer-disable-undo (current-buffer)) (erase-buffer)) (set-buffer nntp-server-buffer) (goto-char (point-min)) (while cached (while (and (not (eobp)) (looking-at "2.. +\\([0-9]+\\) ") (< (progn (goto-char (match-beginning 1)) (read (current-buffer))) (car cached))) (search-forward "\n.\n" nil 'move)) (beginning-of-line) (save-excursion (set-buffer cache-buf) (erase-buffer) (insert-file-contents (gnus-cache-file-name group (car cached))) (goto-char (point-min)) (insert "220 " (int-to-string (car cached)) " Article retrieved.\n") (search-forward "\n\n" nil 'move) (delete-region (point) (point-max)) (forward-char -1) (insert ".")) (insert-buffer-substring cache-buf) (setq cached (cdr cached))) (kill-buffer cache-buf))) (defun gnus-jog-cache () "Go through all groups and put the articles into the cache." (interactive) (let ((newsrc (cdr gnus-newsrc-alist)) (gnus-cache-enter-articles '(unread)) (gnus-mark-article-hook nil) (gnus-expert-user t) (gnus-large-newsgroup nil)) (while newsrc (gnus-summary-read-group (car (car newsrc))) (if (not (eq major-mode 'gnus-summary-mode)) () (while gnus-newsgroup-unreads (gnus-summary-select-article t t nil (car gnus-newsgroup-unreads)) (setq gnus-newsgroup-unreads (cdr gnus-newsgroup-unreads))) (kill-buffer (current-buffer))) (setq newsrc (cdr newsrc))))) (provide 'gnus-cache) ;;; gnus-cache.el ends here emacs-19.30/lisp/gnus-cite.el100444 23053 1 47464 6046561273 14657 0ustar larsidaemon;;; gnus-cite.el --- parse citations in articles for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Keywords: news, mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Code: (require 'gnus) (require 'gnus-msg) (require 'gnus-ems) (eval-and-compile (autoload 'gnus-article-add-button "gnus-vis") ) ;;; Customization: (defvar gnus-cite-parse-max-size 25000 "Maximum article size (in bytes) where parsing citations is allowed. Set it to nil to parse all articles.") (defvar gnus-cite-prefix-regexp "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>" "Regexp matching the longest possible citation prefix on a line.") (defvar gnus-cite-max-prefix 20 "Maximal possible length for a citation prefix.") (defvar gnus-supercite-regexp (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" ">>>>> +\"\\([^\"\n]+\\)\" +==") "Regexp matching normal SuperCite attribution lines. The first regexp group should match a prefix added by another package.") (defvar gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +==" "Regexp matching mangled SuperCite attribution lines. The first regexp group should match the SuperCite attribution.") (defvar gnus-cite-minimum-match-count 2 "Minimal number of identical prefix'es before we believe it is a citation.") ;see gnus-cus.el ;(defvar gnus-cite-face-list ; (if (eq gnus-display-type 'color) ; (if (eq gnus-background-mode 'dark) 'light 'dark) ; '(italic)) ; "Faces used for displaying different citations. ;It is either a list of face names, or one of the following special ;values: ;dark: Create faces from `gnus-face-dark-name-list'. ;light: Create faces from `gnus-face-light-name-list'. ;The variable `gnus-make-foreground' determines whether the created ;faces change the foreground or the background colors.") (defvar gnus-cite-attribution-prefix "in article\\|in <" "Regexp matching the beginning of an attribution line.") (defvar gnus-cite-attribution-postfix "\\(wrote\\|writes\\|said\\|says\\):[ \t]*$" "Regexp matching the end of an attribution line. The text matching the first grouping will be used as a button.") ;see gnus-cus.el ;(defvar gnus-cite-attribution-face 'underline ; "Face used for attribution lines. ;It is merged with the face for the cited text belonging to the attribution.") ;see gnus-cus.el ;(defvar gnus-cite-hide-percentage 50 ; "Only hide cited text if it is larger than this percent of the body.") ;see gnus-cus.el ;(defvar gnus-cite-hide-absolute 10 ; "Only hide cited text if there is at least this number of cited lines.") ;see gnus-cus.el ;(defvar gnus-face-light-name-list ; '("light blue" "light cyan" "light yellow" "light pink" ; "pale green" "beige" "orange" "magenta" "violet" "medium purple" ; "turquoise") ; "Names of light colors.") ;see gnus-cus.el ;(defvar gnus-face-dark-name-list ; '("dark salmon" "firebrick" ; "dark green" "dark orange" "dark khaki" "dark violet" ; "dark turquoise") ; "Names of dark colors.") ;;; Internal Variables: (defvar gnus-article-length nil) ;; Length of article last time we parsed it. ;; BUG! KLUDGE! UGLY! FIX ME! (defvar gnus-cite-prefix-alist nil) ;; Alist of citation prefixes. ;; The cdr is a list of lines with that prefix. (defvar gnus-cite-attribution-alist nil) ;; Alist of attribution lines. ;; The car is a line number. ;; The cdr is the prefix for the citation started by that line. (defvar gnus-cite-loose-prefix-alist nil) ;; Alist of citation prefixes that have no matching attribution. ;; The cdr is a list of lines with that prefix. (defvar gnus-cite-loose-attribution-alist nil) ;; Alist of attribution lines that have no matching citation. ;; Each member has the form (WROTE IN PREFIX TAG), where ;; WROTE: is the attribution line number ;; IN: is the line number of the previous line if part of the same attribution, ;; PREFIX: Is the citation prefix of the attribution line(s), and ;; TAG: Is a SuperCite tag, if any. ;;; Commands: (defun gnus-article-highlight-citation (&optional force) "Highlight cited text. Each citation in the article will be highlighted with a different face. The faces are taken from `gnus-cite-face-list'. Attribution lines are highlighted with the same face as the corresponding citation merged with `gnus-cite-attribution-face'. Text is considered cited if at least `gnus-cite-minimum-match-count' lines matches `gnus-cite-prefix-regexp' with the same prefix. Lines matching `gnus-cite-attribution-postfix' and perhaps `gnus-cite-attribution-prefix' are considered attribution lines." (interactive (list 'force)) ;; Create dark or light faces if necessary. (cond ((eq gnus-cite-face-list 'light) (setq gnus-cite-face-list (mapcar 'gnus-make-face gnus-face-light-name-list))) ((eq gnus-cite-face-list 'dark) (setq gnus-cite-face-list (mapcar 'gnus-make-face gnus-face-dark-name-list)))) (save-excursion (set-buffer gnus-article-buffer) (gnus-cite-parse-maybe force) (let ((buffer-read-only nil) (alist gnus-cite-prefix-alist) (faces gnus-cite-face-list) (inhibit-point-motion-hooks t) face entry prefix skip numbers number face-alist) ;; Loop through citation prefixes. (while alist (setq entry (car alist) alist (cdr alist) prefix (car entry) numbers (cdr entry) face (car faces) faces (or (cdr faces) gnus-cite-face-list) face-alist (cons (cons prefix face) face-alist)) (while numbers (setq number (car numbers) numbers (cdr numbers)) (and (not (assq number gnus-cite-attribution-alist)) (not (assq number gnus-cite-loose-attribution-alist)) (gnus-cite-add-face number prefix face)))) ;; Loop through attribution lines. (setq alist gnus-cite-attribution-alist) (while alist (setq entry (car alist) alist (cdr alist) number (car entry) prefix (cdr entry) skip (gnus-cite-find-prefix number) face (cdr (assoc prefix face-alist))) ;; Add attribution button. (goto-line number) (if (re-search-forward gnus-cite-attribution-postfix (save-excursion (end-of-line 1) (point)) t) (gnus-article-add-button (match-beginning 1) (match-end 1) 'gnus-cite-toggle prefix)) ;; Highlight attribution line. (gnus-cite-add-face number skip face) (gnus-cite-add-face number skip gnus-cite-attribution-face)) ;; Loop through attribution lines. (setq alist gnus-cite-loose-attribution-alist) (while alist (setq entry (car alist) alist (cdr alist) number (car entry) skip (gnus-cite-find-prefix number)) (gnus-cite-add-face number skip gnus-cite-attribution-face))))) (defun gnus-article-hide-citation (&optional force) "Hide all cited text except attribution lines. See the documentation for `gnus-article-highlight-citation'." (interactive (list 'force)) (save-excursion (set-buffer gnus-article-buffer) (gnus-cite-parse-maybe force) (let ((buffer-read-only nil) (alist gnus-cite-prefix-alist) (inhibit-point-motion-hooks t) numbers number) (while alist (setq numbers (cdr (car alist)) alist (cdr alist)) (while numbers (setq number (car numbers) numbers (cdr numbers)) (goto-line number) (or (assq number gnus-cite-attribution-alist) (add-text-properties (point) (progn (forward-line 1) (point)) gnus-hidden-properties))))))) (defun gnus-article-hide-citation-maybe (&optional force) "Hide cited text that has an attribution line. This will do nothing unless at least `gnus-cite-hide-percentage' percent and at least `gnus-cite-hide-absolute' lines of the body is cited text with attributions. When called interactively, these two variables are ignored. See also the documentation for `gnus-article-highlight-citation'." (interactive (list 'force)) (save-excursion (set-buffer gnus-article-buffer) (gnus-cite-parse-maybe force) (goto-char (point-min)) (search-forward "\n\n" nil t) (let ((start (point)) (atts gnus-cite-attribution-alist) (buffer-read-only nil) (inhibit-point-motion-hooks t) (hiden 0) total) (goto-char (point-max)) (re-search-backward gnus-signature-separator nil t) (setq total (count-lines start (point))) (while atts (setq hiden (+ hiden (length (cdr (assoc (cdr (car atts)) gnus-cite-prefix-alist)))) atts (cdr atts))) (if (or force (and (> (* 100 hiden) (* gnus-cite-hide-percentage total)) (> hiden gnus-cite-hide-absolute))) (progn (setq atts gnus-cite-attribution-alist) (while atts (setq total (cdr (assoc (cdr (car atts)) gnus-cite-prefix-alist)) atts (cdr atts)) (while total (setq hiden (car total) total (cdr total)) (goto-line hiden) (or (assq hiden gnus-cite-attribution-alist) (add-text-properties (point) (progn (forward-line 1) (point)) gnus-hidden-properties))))))))) ;;; Internal functions: (defun gnus-cite-parse-maybe (&optional force) ;; Parse if the buffer has changes since last time. (if (eq gnus-article-length (- (point-max) (point-min))) () ;;Reset parser information. (setq gnus-cite-prefix-alist nil gnus-cite-attribution-alist nil gnus-cite-loose-prefix-alist nil gnus-cite-loose-attribution-alist nil) ;; Parse if not too large. (if (and (not force) gnus-cite-parse-max-size (> (buffer-size) gnus-cite-parse-max-size)) () (setq gnus-article-length (- (point-max) (point-min))) (gnus-cite-parse)))) (defun gnus-cite-parse () ;; Parse and connect citation prefixes and attribution lines. ;; Parse current buffer searching for citation prefixes. (goto-char (point-min)) (or (search-forward "\n\n" nil t) (goto-char (point-max))) (let ((line (1+ (count-lines (point-min) (point)))) (case-fold-search t) (max (save-excursion (goto-char (point-max)) (re-search-backward gnus-signature-separator nil t) (point))) alist entry start begin end numbers prefix) ;; Get all potential prefixes in `alist'. (while (< (point) max) ;; Each line. (setq begin (point) end (progn (beginning-of-line 2) (point)) start end) (goto-char begin) ;; Ignore standard SuperCite attribution prefix. (if (looking-at gnus-supercite-regexp) (if (match-end 1) (setq end (1+ (match-end 1))) (setq end (1+ begin)))) ;; Ignore very long prefixes. (if (> end (+ (point) gnus-cite-max-prefix)) (setq end (+ (point) gnus-cite-max-prefix))) (while (re-search-forward gnus-cite-prefix-regexp (1- end) t) ;; Each prefix. (setq end (match-end 0) prefix (buffer-substring begin end)) (set-text-properties 0 (length prefix) nil prefix) (setq entry (assoc prefix alist)) (if entry (setcdr entry (cons line (cdr entry))) (setq alist (cons (list prefix line) alist))) (goto-char begin)) (goto-char start) (setq line (1+ line))) ;; We got all the potential prefixes. Now create ;; `gnus-cite-prefix-alist' containing the oldest prefix for each ;; line that appears at least gnus-cite-minimum-match-count ;; times. First sort them by length. Longer is older. (setq alist (sort alist (lambda (a b) (> (length (car a)) (length (car b)))))) (while alist (setq entry (car alist) prefix (car entry) numbers (cdr entry) alist (cdr alist)) (cond ((null numbers) ;; No lines with this prefix that wasn't also part of ;; a longer prefix. ) ((< (length numbers) gnus-cite-minimum-match-count) ;; Too few lines with this prefix. We keep it a bit ;; longer in case it is an exact match for an attribution ;; line, but we don't remove the line from other ;; prefixes. (setq gnus-cite-prefix-alist (cons entry gnus-cite-prefix-alist))) (t (setq gnus-cite-prefix-alist (cons entry gnus-cite-prefix-alist)) ;; Remove articles from other prefixes. (let ((loop alist) current) (while loop (setq current (car loop) loop (cdr loop)) (setcdr current (gnus-set-difference (cdr current) numbers)))))))) ;; No citations have been connected to attribution lines yet. (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil)) ;; Parse current buffer searching for attribution lines. (goto-char (point-min)) (search-forward "\n\n" nil t) (while (re-search-forward gnus-cite-attribution-postfix (point-max) t) (let* ((start (match-beginning 0)) (end (match-end 0)) (wrote (count-lines (point-min) end)) (prefix (gnus-cite-find-prefix wrote)) ;; Check previous line for an attribution leader. (tag (progn (beginning-of-line 1) (and (looking-at gnus-supercite-secondary-regexp) (buffer-substring (match-beginning 1) (match-end 1))))) (in (progn (goto-char start) (and (re-search-backward gnus-cite-attribution-prefix (save-excursion (beginning-of-line 0) (point)) t) (not (re-search-forward gnus-cite-attribution-postfix start t)) (count-lines (point-min) (1+ (point))))))) (if (eq wrote in) (setq in nil)) (goto-char end) (setq gnus-cite-loose-attribution-alist (cons (list wrote in prefix tag) gnus-cite-loose-attribution-alist)))) ;; Find exact supercite citations. (gnus-cite-match-attributions 'small nil (lambda (prefix tag) (if tag (concat "\\`" (regexp-quote prefix) "[ \t]*" (regexp-quote tag) ">")))) ;; Find loose supercite citations after attributions. (gnus-cite-match-attributions 'small t (lambda (prefix tag) (if tag (concat "\\<" (regexp-quote tag) "\\>")))) ;; Find loose supercite citations anywhere. (gnus-cite-match-attributions 'small nil (lambda (prefix tag) (if tag (concat "\\<" (regexp-quote tag) "\\>")))) ;; Find nested citations after attributions. (gnus-cite-match-attributions 'small-if-unique t (lambda (prefix tag) (concat "\\`" (regexp-quote prefix) ".+"))) ;; Find nested citations anywhere. (gnus-cite-match-attributions 'small nil (lambda (prefix tag) (concat "\\`" (regexp-quote prefix) ".+"))) ;; Remove loose prefixes with too few lines. (let ((alist gnus-cite-loose-prefix-alist) entry) (while alist (setq entry (car alist) alist (cdr alist)) (if (< (length (cdr entry)) gnus-cite-minimum-match-count) (setq gnus-cite-prefix-alist (delq entry gnus-cite-prefix-alist) gnus-cite-loose-prefix-alist (delq entry gnus-cite-loose-prefix-alist))))) ;; Find flat attributions. (gnus-cite-match-attributions 'first t nil) ;; Find any attributions (are we getting desperate yet?). (gnus-cite-match-attributions 'first nil nil)) (defun gnus-cite-match-attributions (sort after fun) ;; Match all loose attributions and citations (SORT AFTER FUN) . ;; ;; If SORT is `small', the citation with the shortest prefix will be ;; used, if it is `first' the first prefix will be used, if it is ;; `small-if-unique' the shortest prefix will be used if the ;; attribution line does not share its own prefix with other ;; loose attribution lines, otherwise the first prefix will be used. ;; ;; If AFTER is non-nil, only citations after the attribution line ;; will be concidered. ;; ;; If FUN is non-nil, it will be called with the arguments (WROTE ;; PREFIX TAG) and expected to return a regular expression. Only ;; citations whose prefix matches the regular expression will be ;; concidered. ;; ;; WROTE is the attribution line number. ;; PREFIX is the attribution line prefix. ;; TAG is the SuperCite tag on the attribution line. (let ((atts gnus-cite-loose-attribution-alist) (case-fold-search t) att wrote in prefix tag regexp limit smallest best size) (while atts (setq att (car atts) atts (cdr atts) wrote (nth 0 att) in (nth 1 att) prefix (nth 2 att) tag (nth 3 att) regexp (if fun (funcall fun prefix tag) "") size (cond ((eq sort 'small) t) ((eq sort 'first) nil) (t (< (length (gnus-cite-find-loose prefix)) 2))) limit (if after wrote -1) smallest 1000000 best nil) (let ((cites gnus-cite-loose-prefix-alist) cite candidate numbers first compare) (while cites (setq cite (car cites) cites (cdr cites) candidate (car cite) numbers (cdr cite) first (apply 'min numbers) compare (if size (length candidate) first)) (and (> first limit) regexp (string-match regexp candidate) (< compare smallest) (setq best cite smallest compare)))) (if (null best) () (setq gnus-cite-loose-attribution-alist (delq att gnus-cite-loose-attribution-alist)) (setq gnus-cite-attribution-alist (cons (cons wrote (car best)) gnus-cite-attribution-alist)) (if in (setq gnus-cite-attribution-alist (cons (cons in (car best)) gnus-cite-attribution-alist))) (if (memq best gnus-cite-loose-prefix-alist) (let ((loop gnus-cite-prefix-alist) (numbers (cdr best)) current) (setq gnus-cite-loose-prefix-alist (delq best gnus-cite-loose-prefix-alist)) (while loop (setq current (car loop) loop (cdr loop)) (if (eq current best) () (setcdr current (gnus-set-difference (cdr current) numbers)) (if (null (cdr current)) (setq gnus-cite-loose-prefix-alist (delq current gnus-cite-loose-prefix-alist) atts (delq current atts))))))))))) (defun gnus-cite-find-loose (prefix) ;; Return a list of loose attribution lines prefixed by PREFIX. (let* ((atts gnus-cite-loose-attribution-alist) att line lines) (while atts (setq att (car atts) line (car att) atts (cdr atts)) (if (string-equal (gnus-cite-find-prefix line) prefix) (setq lines (cons line lines)))) lines)) (defun gnus-cite-add-face (number prefix face) ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. (if face (let ((inhibit-point-motion-hooks t) from to) (goto-line number) (forward-char (length prefix)) (skip-chars-forward " \t") (setq from (point)) (end-of-line 1) (skip-chars-backward " \t") (setq to (point)) (if (< from to) (gnus-overlay-put (gnus-make-overlay from to) 'face face))))) (defun gnus-cite-toggle (prefix) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil) (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) (inhibit-point-motion-hooks t) number) (while numbers (setq number (car numbers) numbers (cdr numbers)) (goto-line number) (cond ((get-text-property (point) 'invisible) (remove-text-properties (point) (progn (forward-line 1) (point)) gnus-hidden-properties)) ((assq number gnus-cite-attribution-alist)) (t (add-text-properties (point) (progn (forward-line 1) (point)) gnus-hidden-properties))))))) (defun gnus-cite-find-prefix (line) ;; Return citation prefix for LINE. (let ((alist gnus-cite-prefix-alist) (prefix "") entry) (while alist (setq entry (car alist) alist (cdr alist)) (if (memq line (cdr entry)) (setq prefix (car entry)))) prefix)) (gnus-ems-redefine) (provide 'gnus-cite) ;;; gnus-cite.el ends here emacs-19.30/lisp/gnus-cus.el100444 23053 1 44553 6046561304 14514 0ustar larsidaemon;;; gnus-cus.el --- User friendly customization of Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: help, news ;; Version: 0.1 ;; 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: ;;; Code: (require 'custom) (require 'gnus-ems) ;; The following is just helper functions and data, not ment to be set ;; by the user. (defun gnus-make-face (color) ;; Create entry for face with COLOR. (custom-face-lookup color nil nil nil nil nil)) (defvar gnus-face-light-name-list '("light blue" "light cyan" "light yellow" "light pink" "pale green" "beige" "orange" "magenta" "violet" "medium purple" "turquoise")) (defvar gnus-face-dark-name-list '("RoyalBlue" "firebrick" "dark green" "OrangeRed" "dark khaki" "dark violet" "SteelBlue4")) ; CornflowerBlue SeaGreen OrangeRed SteelBlue4 DeepPink3 ; DarkOlviveGreen4 (custom-declare '() '((tag . "GNUS") (doc . "\ The coffe-brewing, all singing, all dancing, kitchen sink newsreader.") (type . group) (data ((tag . "Visual") (doc . "\ GNUS can be made colorful and fun or grey and dull as you wish.") (type . group) (data ((tag . "Visual") (doc . "Enable visual features. If `visual' is disabled, there will be no menus and few faces. Most of the visual customization options below will be ignored. GNUS will use less space and be faster as a result.") (default . t) (name . gnus-visual) (type . toggle)) ((tag . "WWW Browser") (doc . "\ WWW Browser to call when clicking on an URL button in the article buffer. You can choose between one of the predefined browsers, or `Other'.") (name . gnus-button-url) (calculate . (cond ((boundp 'browse-url-browser-function) browse-url-browser-function) ((fboundp 'w3-fetch) 'w3-fetch) ((eq window-system 'x) 'gnus-netscape-open-url))) (type . choice) (data ((tag . "W3") (type . const) (default . w3-fetch)) ((tag . "Netscape") (type . const) (default . gnus-netscape-open-url)) ((prompt . "Other") (doc . "\ You must specify the name of a Lisp function here. The lisp function should open a WWW browser when called with an URL (a string). ") (default . __uninitialized__) (type . symbol)))) ((tag . "Mouse Face") (doc . "\ Face used for group or summary buffer mouse highlighting. The line beneath the mouse pointer will be highlighted with this face.") (name . gnus-mouse-face) (calculate . (if (boundp 'gnus-mouse-face) gnus-mouse-face 'highlight)) (type . face)) ((tag . "Article Display") (doc . "Controls how the article buffer will look. The list below contains various filters you can use to change the look of the article. If you leave the list empty, the article will appear exactly as it is stored on the disk. The list entries will hide or highlight various parts of the article, making it easier to find the information you want.") (name . gnus-article-display-hook) (type . list) (default . (gnus-article-hide-headers-if-wanted gnus-article-treat-overstrike gnus-article-maybe-highlight)) (data ((type . repeat) (header . nil) (data (tag . "Filter") (type . choice) (data ((tag . "Treat Overstrike") (doc . "\ Convert use of overstrike into bold and underline. Two identical letters separated by a backspace are displayed as a single bold letter, while a letter followed by a backspace and an underscore will be displayed as a single underlined letter. This technique was developed for old line printers (think about it), and is still in use on some newsgroups, in particular the ClariNet hierearchy. ") (type . const) (default . gnus-article-treat-overstrike)) ((tag . "Word Wrap") (doc . "\ Format too long lines. ") (type . const) (default . gnus-article-word-wrap)) ((tag . "Remove CR") (doc . "\ Remove carriage returns from an article. ") (type . const) (default . gnus-article-remove-cr)) ((tag . "Display X-Face") (doc . "\ Look for an X-Face header and display it if present. See also `X Face Command' for a definition of the external command used for decoding and displaying the face. ") (type . const) (default . gnus-article-display-x-face)) ((tag . "Unquote Printable") (doc . "\ Tranform MIME quoted printable into 8-bit characters. Quoted printable is often seen by strings like `=EF' where you would expect a non-English letter. ") (type . const) (default . gnus-article-de-quoted-unreadable)) ((tag . "Universal Time") (doc . "\ Convert date header to universal time. ") (type . const) (default . gnus-article-date-ut)) ((tag . "Local Time") (doc . "\ Convert date header to local timezone. ") (type . const) (default . gnus-article-date-local)) ((tag . "Lapsed Time") (doc . "\ Replace date header with a header showing the articles age. ") (type . const) (default . gnus-article-date-lapsed)) ((tag . "Highlight") (doc . "\ Highlight headers, citations, signature, and buttons. ") (type . const) (default . gnus-article-highlight)) ((tag . "Maybe Highlight") (doc . "\ Highlight headers, signature, and buttons if `Visual' is turned on. ") (type . const) (default . gnus-article-maybe-highlight)) ((tag . "Highlight Some") (doc . "\ Highlight headers, signature, and buttons. ") (type . const) (default . gnus-article-highlight-some)) ((tag . "Highlight Headers") (doc . "\ Highlight headers as specified by `Article Header Highligting'. ") (type . const) (default . gnus-article-highlight-headers)) ((tag . "Highlight Signature") (doc . "\ Highlight the signature as specified by `Article Signature Face'. ") (type . const) (default . gnus-article-highlight-signature)) ((tag . "Citation") (doc . "\ Highlight the citations as specified by `Citation Faces'. ") (type . const) (default . gnus-article-highlight-citation)) ((tag . "Hide") (doc . "\ Hide unwanted headers, excess citation, and the signature. ") (type . const) (default . gnus-article-hide)) ((tag . "Hide Headers If Wanted") (doc . "\ Hide headers, but allow user to display them with `t' or `v'. ") (type . const) (default . gnus-article-hide-headers-if-wanted)) ((tag . "Hide Headers") (doc . "\ Hide unwanted headers and possibly sort them as well. Most likely you want to use `Hide Headers If Wanted' instead. ") (type . const) (default . gnus-article-hide-headers)) ((tag . "Hide Signature") (doc . "\ Hide the signature. ") (type . const) (default . gnus-article-hide-signature)) ((tag . "Hide Excess Citations") (doc . "\ Hide excess citation. Excess is defined by `Citation Hide Percentage' and `Citation Hide Absolute'. ") (type . const) (default . gnus-article-hide-citation-maybe)) ((tag . "Hide Citations") (doc . "\ Hide all cited text. ") (type . const) (default . gnus-article-hide-citation)) ((tag . "Add Buttons") (doc . "\ Make URL's into clickable buttons. ") (type . const) (default . gnus-article-add-buttons)) ((prompt . "Other") (doc . "\ Name of Lisp function to call. Push the `Filter' button to select one of the predefined filters. ") (type . symbol))))))) ((tag . "Article Button Face") (doc . "\ Face used for highlighting buttons in the article buffer. An article button is a piece of text that you can activate by pressing `RET' or `mouse-2' above it.") (name . gnus-article-button-face) (default . bold) (type . face)) ((tag . "Article Mouse Face") (doc . "\ Face used for mouse highlighting in the article buffer. Article buttons will be displayed in this face when the cursor is above them.") (name . gnus-article-mouse-face) (default . highlight) (type . face)) ((tag . "Article Signature Face") (doc . "\ Face used for highlighting a signature in the article buffer.") (name . gnus-signature-face) (default . italic) (type . face)) ((tag . "Article Header Highlighting") (doc . "\ Controls highlighting of article header. Below is a list of article header names, and the faces used for displaying the name and content of the header. The `Header' field should contain the name of the header. The field actually contains a regular expression that should match the beginning of the header line, but if you don't know what a regular expression is, just write the name of the header. The second field is the `Name' field, which determines how the the header name (i.e. the part of the header left of the `:') is displayed. The third field is the `Content' field, which determines how the content (i.e. the part of the header right of the `:') is displayed. If you leave the last `Header' field in the list empty, the `Name' and `Content' fields will determine how headers not listed above are displayed. If you only want to change the display of the name part for a specific header, specify `None' in the `Content' field. Similarly, specify `None' in the `Name' field if you only want to leave the name part alone.") (name . gnus-header-face-alist) (type . list) (calculate . (cond ((not (eq gnus-display-type 'color)) '(("" bold italic))) ((eq gnus-background-mode 'dark) (list (list "From" nil (custom-face-lookup "dark blue" nil nil t t nil)) (list "Subject" nil (custom-face-lookup "pink" nil nil t t nil)) (list "Newsgroups:.*," nil (custom-face-lookup "yellow" nil nil t t nil)) (list "" (custom-face-lookup "cyan" nil nil t nil nil) (custom-face-lookup "forestgreen" nil nil nil t nil)))) (t (list (list "From" nil (custom-face-lookup "RoyalBlue" nil nil t t nil)) (list "Subject" nil (custom-face-lookup "firebrick" nil nil t t nil)) (list "Newsgroups:.*," nil (custom-face-lookup "indianred" nil nil t t nil)) (list "" (custom-face-lookup "DarkGreen" nil nil t nil nil) (custom-face-lookup "DarkGreen" nil nil nil t nil)))))) (data ((type . repeat) (header . nil) (data (type . list) (compact . t) (data ((type . string) (prompt . "Header") (tag . "Header ")) "\n " ((type . face) (prompt . "Name") (tag . "Name ")) "\n " ((type . face) (tag . "Content")) "\n"))))) ((tag . "Attribution Face") (doc . "\ Face used for attribution lines. It is merged with the face for the cited text belonging to the attribution.") (name . gnus-cite-attribution-face) (default . underline) (type . face)) ((tag . "Citation Faces") (doc . "\ List of faces used for highlighting citations. When there are citations from multiple articles in the same message, Gnus will try to give each citation from each article its own face. This should make it easier to see who wrote what.") (name . gnus-cite-face-list) (import . gnus-custom-import-cite-face-list) (type . list) (calculate . (cond ((not (eq gnus-display-type 'color)) '(italic)) ((eq gnus-background-mode 'dark) (mapcar 'gnus-make-face gnus-face-light-name-list)) (t (mapcar 'gnus-make-face gnus-face-dark-name-list)))) (data ((type . repeat) (header . nil) (data (type . face) (tag . "Face"))))) ((tag . "Citation Hide Percentage") (doc . "\ Only hide excess citation if above this percentage of the body.") (name . gnus-cite-hide-percentage) (default . 50) (type . integer)) ((tag . "Citation Hide Absolute") (doc . "\ Only hide excess citation if above this number of lines in the body.") (name . gnus-cite-hide-absolute) (default . 10) (type . integer)) ((tag . "Summary Selected Face") (doc . "\ Face used for highlighting the current article in the summary buffer.") (name . gnus-summary-selected-face) (default . underline) (type . face)) ((tag . "Summary Line Highlighting") (doc . "\ Controls the higlighting of summary buffer lines. Below is a list of `Form'/`Face' pairs. When deciding how a a particular summary line should be displayed, each form is evaluated. The content of the face field after the first true form is used. You can change how those summary lines are displayed, by editing the face field. It is also possible to change and add form fields, but currently that requires an understanding of Lisp expressions. Hopefully this will change in a future release. For now, you can use the following variables in the Lisp expression: score: The article's score default: The default article score. below: The score below which articles are automatically marked as read. mark: The article's mark.") (name . gnus-summary-highlight) (type . list) (calculate . (cond ((not (eq gnus-display-type 'color)) '(((> score default) . bold) ((< score default) . italic))) ((eq gnus-background-mode 'dark) (list (cons '(= mark gnus-canceled-mark) (custom-face-lookup "yellow" "black" nil nil nil nil)) (cons '(and (> score default) (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark))) (custom-face-lookup "pink" nil nil t nil nil)) (cons '(and (< score default) (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark))) (custom-face-lookup "pink" nil nil nil t nil)) (cons '(or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark)) (custom-face-lookup "pink" nil nil nil nil nil)) (cons '(and (> score default) (= mark gnus-ancient-mark)) (custom-face-lookup "dark blue" nil nil t nil nil)) (cons '(and (< score default) (= mark gnus-ancient-mark)) (custom-face-lookup "SkyBlue" nil nil nil t nil)) (cons '(= mark gnus-ancient-mark) (custom-face-lookup "SkyBlue" nil nil nil nil nil)) (cons '(and (> score default) (= mark gnus-unread-mark)) (custom-face-lookup "white" nil nil t nil nil)) (cons '(and (< score default) (= mark gnus-unread-mark)) (custom-face-lookup "white" nil nil nil t nil)) (cons '(= mark gnus-unread-mark) (custom-face-lookup "white" nil nil nil nil nil)) (cons '(> score default) 'bold) (cons '(< score default) 'italic))) (t (list (cons '(= mark gnus-canceled-mark) (custom-face-lookup "yellow" "black" nil nil nil nil)) (cons '(and (> score default) (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark))) (custom-face-lookup "firebrick" nil nil t nil nil)) (cons '(and (< score default) (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark))) (custom-face-lookup "firebrick" nil nil nil t nil)) (cons '(or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark)) (custom-face-lookup "firebrick" nil nil nil nil nil)) (cons '(and (> score default) (= mark gnus-ancient-mark)) (custom-face-lookup "RoyalBlue" nil nil t nil nil)) (cons '(and (< score default) (= mark gnus-ancient-mark)) (custom-face-lookup "RoyalBlue" nil nil nil t nil)) (cons '(= mark gnus-ancient-mark) (custom-face-lookup "RoyalBlue" nil nil nil nil nil)) (cons '(and (> score default) (/= mark gnus-unread-mark)) (custom-face-lookup "DarkGreen" nil nil t nil nil)) (cons '(and (< score default) (/= mark gnus-unread-mark)) (custom-face-lookup "DarkGreen" nil nil nil t nil)) (cons '(/= mark gnus-unread-mark) (custom-face-lookup "DarkGreen" nil nil nil nil nil)) (cons '(> score default) 'bold) (cons '(< score default) 'italic))))) (data ((type . repeat) (header . nil) (data (type . pair) (compact . t) (data ((type . sexp) (width . 60) (tag . "Form")) "\n " ((type . face) (tag . "Face")) "\n"))))) ;; Do not define `gnus-button-alist' before we have ;; some `complexity' attribute so we can hide it from ;; beginners. ))))) (defun gnus-custom-import-cite-face-list (custom alist) ;; Backward compatible groking of light and dark. (cond ((eq alist 'light) (setq alist (mapcar 'gnus-make-face gnus-face-light-name-list))) ((eq alist 'dark) (setq alist (mapcar 'gnus-make-face gnus-face-dark-name-list)))) (funcall (custom-super custom 'import) custom alist)) ;(defun gnus-custom-import-swap-alist (custom alist) ; ;; Swap key and value in CUSTOM ALIST. ; (let ((swap (mapcar (lambda (e) (cons (cdr e) (car e))) alist))) ; (funcall (custom-super custom 'import) custom swap))) ;(defun gnus-custom-export-swap-alist (custom alist) ; ;; Swap key and value in CUSTOM ALIST. ; (let ((swap (mapcar (lambda (e) (cons (cdr e) (car e))) alist))) ; (funcall (custom-super custom 'export) custom swap))) (provide 'gnus-cus) ;;; gnus-cus.el ends here emacs-19.30/lisp/gnus-edit.el100444 23053 1 52374 6046561321 14646 0ustar larsidaemon;;; gnus-edit.el --- Gnus SCORE file editing ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: news, help ;; Version: 0.2 ;;; Commentary: ;; ;; Type `M-x gnus-score-customize RET' to invoke. ;;; Code: (require 'custom) (require 'gnus-score) (defconst gnus-score-custom-data '((tag . "Score") (doc . "Customization of Gnus SCORE files. SCORE files allow you to assign a score to each article when you enter a group, and automatically mark the articles as read or delete them based on the score. In the summary buffer you can use the score to sort the articles by score (`C-c C-s C-s') or to jump to the unread article with the highest score (`,').") (type . group) (data "\n" ((header . nil) (doc . "Name of SCORE file to customize. Enter the name in the `File' field, then push the [Load] button to load it. When done editing, push the [Save] button to save the file. Several score files may apply to each group, and several groups may use the same score file. This is controlled implicitly by the name of the score file and the value of the global variable `gnus-score-find-score-files-function', and explicitly by the the `Files' and `Exclude Files' entries.") (compact . t) (type . group) (data ((tag . "Load") (type . button) (query . gnus-score-custom-load)) ((tag . "Save") (type . button) (query . gnus-score-custom-save)) ((name . file) (tag . "File") (directory . "~/News/") (default-file . "SCORE") (type . file)))) ((name . files) (tag . "Files") (doc . "\ List of score files to load when the the current score file is loaded. You can use this to share score entries between multiple score files. Push the `[INS]' button add a score file to the list, or `[DEL]' to delete a score file from the list.") (type . list) (data ((type . repeat) (header . nil) (data (type . file) (directory . "~/News/"))))) ((name . exclude-files) (tag . "Exclude Files") (doc . "\ List of score files to exclude when the the current score file is loaded. You can use this if you have a score file you want to share between a number of newsgroups, except for the newsgroup this score file matches. [ Did anyone get that? ] Push the `[INS]' button add a score file to the list, or `[DEL]' to delete a score file from the list.") (type . list) (data ((type . repeat) (header . nil) (data (type . file) (directory . "~/News/"))))) ((name . mark) (tag . "Mark") (doc . "\ Articles below this score will be automatically marked as read. This means that when you enter the summary buffer, the articles will be shown but will already be marked as read. You can then press `x' to get rid of them entirely. By default articles with a negative score will be marked as read. To change this, push the `Mark' button, and choose `Integer'. You can then enter a value in the `Mark' field.") (type . gnus-score-custom-maybe-type)) ((name . expunge) (tag . "Expunge") (doc . "\ Articles below this score will not be shown in the summary buffer.") (type . gnus-score-custom-maybe-type)) ((name . mark-and-expunge) (tag . "Mark and Expunge") (doc . "\ Articles below this score will be marked as read, but not shown. Someone should explain me the difference between this and `expunge' alone or combined with `mark'.") (type . gnus-score-custom-maybe-type)) ((name . eval) (tag . "Eval") (doc . "\ Evaluate this lisp expression when the entering summary buffer.") (type . sexp)) ((name . read-only) (tag . "Read Only") (doc . "Read-only score files will not be updated or saved. Except from this buffer, of course!") (type . toggle)) ((type . doc) (doc . "\ Each news header has an associated list of score entries. You can use the [INS] buttons to add new score entries anywhere in the list, or the [DEL] buttons to delete specific score entries. Each score entry should specify a string that should be matched with the content actual header in order to determine whether the entry applies to that header. Enter that string in the `Match' field. If the score entry matches, the articles score will be adjusted with some amount. Enter that amount in the in the `Score' field. You should specify a positive amount for score entries that matches articles you find interesting, and a negative amount for score entries matching articles you would rather avoid. The final score for the article will be the sum of the score of all score entries that match the article. The score entry can be either permanent or expirable. To make the entry permanent, push the `Date' button and choose the `Permanent' entry. To make the entry expirable, choose instead the `Integer' entry. After choosing the you can enter the date the score entry was last matched in the `Date' field. The date will be automatically updated each time the score entry matches an article. When the date become too old, the the score entry will be removed. For your convenience, the date is specified as the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC. Finally, you can choose what kind of match you want to perform by pushing the `Type' button. For most entries you can choose between `Exact' which mean the header content must be exactly identical to the match string, or `Substring' meaning the match string should be somewhere in the header content, or even `Regexp' to use Emacs regular expression matching. The last choice is `Fuzzy' which is like `Exact' except that whitespace derivations, a beginning `Re:' or a terminating parenthetical remark are all ignored. Each of the four types have a variant which will ignore case in the comparison. That variant is indicated with a `(fold)' after its name.")) ((name . from) (tag . "From") (doc . "Scoring based on the authors email address.") (type . gnus-score-custom-string-type)) ((name . subject) (tag . "Subject") (doc . "Scoring based on the articles subject.") (type . gnus-score-custom-string-type)) ((name . followup) (tag . "Followup") (doc . "Scoring based on who the article is a followup to. If you want to see all followups to your own articles, add an entry with a positive score matching your email address here. You can also put an entry with a negative score matching someone who is so annoying that you don't even want to see him quoted in followups.") (type . gnus-score-custom-string-type)) ((name . xref) (tag . "Xref") (doc . "Scoring based on article crossposting. If you want to score based on which newsgroups an article is posted to, this is the header to use. The syntax is a little different from the `Newsgroups' header, but scoring in `Xref' is much faster. As an example, to match all crossposted articles match on `:.*:' using the `Regexp' type.") (type . gnus-score-custom-string-type)) ((name . references) (tag . "References") (doc . "Scoring based on article references. The `References' header gives you an alternative way to score on followups. If you for example want to see follow all discussions where people from `iesd.auc.dk' school participate, you can add a substring match on `iesd.auc.dk>' on this header.") (type . gnus-score-custom-string-type)) ((name . message-id) (tag . "Message-ID") (doc . "Scoring based on the articles message-id. This isn't very useful, but Lars like completeness. You can use it to match all messaged generated by recent Gnus version with a `Substring' match on `.fsf@'.") (type . gnus-score-custom-string-type)) ((type . doc) (doc . "\ WARNING: Scoring on the following three pseudo headers is very slow! Scoring on any of the real headers use a technique that avoids scanning the entire article, only the actual headers you score on are scanned, and this scanning has been heavily optimized. Using just a single entry for one the three pseudo-headers `Head', `Body', and `All' will require GNUS to retrieve and scan the entire article, which can be very slow on large groups. However, if you add one entry for any of these headers, you can just as well add several. Each subsequent entry cost relatively little extra time.")) ((name . head) (tag . "Head") (doc . "Scoring based on the article header. Instead of matching the content of a single header, the entire header section of the article is matched. You can use this to match on arbitrary headers, foe example to single out TIN lusers, use a substring match on `Newsreader: TIN'. That should get 'em!") (type . gnus-score-custom-string-type)) ((name . body) (tag . "Body") (doc . "Scoring based on the article body. If you think any article that mentions `Kibo' is inherently interesting, do a substring match on His name. You Are Allowed.") (type . gnus-score-custom-string-type)) ((name . all) (tag . "All") (doc . "Scoring based on the whole article.") (type . gnus-score-custom-string-type)) ((name . date) (tag . "Date") (doc . "Scoring based on article date. You can change the score of articles that have been posted before, after, or at a specific date. You should add the date in the `Match' field, and then select `before', `after', or `at' by pushing the `Type' button. Imagine you want to lower the score of very old articles, or want to raise the score of articles from the future (such things happen!). Then you can't use date scoring for that. In fact, I can't imagine anything you would want to use this for. For your convenience, the date is specified in Usenet date format.") (type . gnus-score-custom-date-type)) ((type . doc) (doc . "\ The Lines and Chars headers use integer based scoring. This means that you should write an integer in the `Match' field, and the push the `Type' field to if the `Chars' or `Lines' header should be larger, equal, or smaller than the number you wrote in the match field.")) ((name . chars) (tag . "Characters") (doc . "Scoring based on the number of characters in the article.") (type . gnus-score-custom-integer-type)) ((name . lines) (tag . "Lines") (doc . "Scoring based on the number of lines in the article.") (type . gnus-score-custom-integer-type)) ((name . orphan) (tag . "Orphan") (doc . "Score to add to articles with no parents.") (type . gnus-score-custom-maybe-type)) ((name . adapt) (tag . "Adapt") (doc . "Adapting the score files to your newsreading habits. When you have finished reading a group GNUS can automatically create new score entries based on which articles you read and which you skipped. This is normally controled by the two global variables `gnus-use-adaptive-scoring' and `gnus-default-adaptive-score-alist', The first determines whether adaptive scoring should be enabled or not, while the second determines what score entries should be created. You can overwrite the setting of `gnus-use-adaptive-scoring' by selecting `Enable' or `Disable' by pressing the `Adapt' button. Selecting `Custom' will allow you to specify the exact adaption rules (overwriting `gnus-default-adaptive-score-alist').") (type . choice) (data ((tag . "Default") (default . nil) (type . const)) ((tag . "Enable") (default . t) (type . const)) ((tag . "Disable") (default . ignore) (type . const)) ((tag . "Custom") (doc . "Customization of adaptive scoring. Each time you read an article it will be marked as read. Likewise, if you delete it it will be marked as deleted, and if you tick it it will be marked as ticked. When you leave a group, GNUS can automatically create score file entries based on these marks, so next time you enter the group articles with subjects that you read last time have higher score and articles with subjects that deleted will have lower score. Below is a list of such marks. You can insert new marks to the list by pushing on one of the `[INS]' buttons in the left margin to create a new entry and then pushing the `Mark' button to select the mark. For each mark there is another list, this time of article headers, which determine how the mark should affect that header. The `[INS]' buttons of this list are indented to indicate that the belong to the mark above. Push the `Header' button to choose a header, and then enter a score value in the `Score' field. For each article that are marked with `Mark' when you leave the group, a temporary score entry for the articles `Header' with the value of `Score' will be added the adapt file. If the score entry already exists, `Score' will be added to its value. If you understood that, you are smart. You can select the special value `Other' when pressing the `Mark' or `Header' buttons. This is because Lars might add more useful values there. If he does, it is up to you to figure out what they are named.") (type . list) (default . ((__uninitialized__))) (data ((type . repeat) (header . nil) (data . ((type . list) (header . nil) (compact . t) (data ((type . choice) (tag . "Mark") (data ((tag . "Unread") (default . gnus-unread-mark) (type . const)) ((tag . "Ticked") (default . gnus-ticked-mark) (type . const)) ((tag . "Dormant") (default . gnus-dormant-mark) (type . const)) ((tag . "Deleted") (default . gnus-del-mark) (type . const)) ((tag . "Read") (default . gnus-read-mark) (type . const)) ((tag . "Expirable") (default . gnus-expirable-mark) (type . const)) ((tag . "Killed") (default . gnus-killed-mark) (type . const)) ((tag . "Kill-file") (default . gnus-kill-file-mark) (type . const)) ((tag . "Low-score") (default . gnus-low-score-mark) (type . const)) ((tag . "Catchup") (default . gnus-catchup-mark) (type . const)) ((tag . "Ancient") (default . gnus-ancient-mark) (type . const)) ((tag . "Canceled") (default . gnus-canceled-mark) (type . const)) ((prompt . "Other") (default . ??) (type . sexp)))) ((type . repeat) (prefix . " ") (data . ((type . list) (compact . t) (data ((tag . "Header") (type . choice) (data ((tag . "Subject") (default . subject) (type . const)) ((prompt . "From") (tag . "From ") (default . from) (type . const)) ((prompt . "Other") (width . 7) (default . nil) (type . symbol)))) ((tag . "Score") (type . integer)))))))))))))) ((name . local) (tag . "Local") (doc . "\ List of local variables to set when this score file is loaded. Using this entry can provide a convenient way to set variables that will affect the summary mode for only some specific groups, i.e. those groups matched by the current score file.") (type . list) (data ((type . repeat) (header . nil) (data . ((type . list) (compact . t) (data ((tag . "Name") (width . 26) (type . symbol)) ((tag . "Value") (width . 26) (type . sexp))))))))))) (defconst gnus-score-custom-type-properties '((gnus-score-custom-maybe-type (type . choice) (data ((type . integer) (default . 0)) ((tag . "Default") (type . const) (default . nil)))) (gnus-score-custom-string-type (type . list) (data ((type . repeat) (header . nil) (data . ((type . list) (compact . t) (data ((tag . "Match") (width . 59) (type . string)) "\n " ((tag . "Score") (type . integer)) ((tag . "Date") (type . choice) (data ((type . integer) (default . 0) (width . 9)) ((tag . "Permanent") (type . const) (default . nil)))) ((tag . "Type") (type . choice) (data ((tag . "Exact") (default . E) (type . const)) ((tag . "Substring") (default . S) (type . const)) ((tag . "Regexp") (default . R) (type . const)) ((tag . "Fuzzy") (default . F) (type . const)) ((tag . "Exact (fold)") (default . e) (type . const)) ((tag . "Substring (fold)") (default . s) (type . const)) ((tag . "Regexp (fold)") (default . r) (type . const)) ((tag . "Fuzzy (fold)") (default . f) (type . const)))))))))) (gnus-score-custom-integer-type (type . list) (data ((type . repeat) (header . nil) (data . ((type . list) (compact . t) (data ((tag . "Match") (type . integer)) ((tag . "Score") (type . integer)) ((tag . "Date") (type . choice) (data ((type . integer) (default . 0) (width . 9)) ((tag . "Permanent") (type . const) (default . nil)))) ((tag . "Type") (type . choice) (data ((tag . "<") (default . <) (type . const)) ((tag . ">") (default . >) (type . const)) ((tag . "=") (default . =) (type . const)) ((tag . ">=") (default . >=) (type . const)) ((tag . "<=") (default . <=) (type . const)))))))))) (gnus-score-custom-date-type (type . list) (data ((type . repeat) (header . nil) (data . ((type . list) (compact . t) (data ((tag . "Match") (width . 59) (type . string)) "\n " ((tag . "Score") (type . integer)) ((tag . "Date") (type . choice) (data ((type . integer) (default . 0) (width . 9)) ((tag . "Permanent") (type . const) (default . nil)))) ((tag . "Type") (type . choice) (data ((tag . "Before") (default . before) (type . const)) ((tag . "After") (default . after) (type . const)) ((tag . "At") (default . at) (type . const)))))))))))) (defvar gnus-score-custom-file nil "Name of SCORE file being customized.") (defun gnus-score-customize () "Create a buffer for editing gnus SCORE files." (interactive) (let (gnus-score-alist) (custom-buffer-create "*Score Edit*" gnus-score-custom-data gnus-score-custom-type-properties 'gnus-score-custom-set 'gnus-score-custom-get 'gnus-score-custom-save)) (make-local-variable 'gnus-score-custom-file) (setq gnus-score-custom-file (expand-file-name "SCORE" "~/News")) (make-local-variable 'gnus-score-alist) (setq gnus-score-alist nil) (custom-reset-all)) (defun gnus-score-custom-get (name) (if (eq name 'file) gnus-score-custom-file (let ((entry (assoc (symbol-name name) gnus-score-alist))) (if entry (mapcar 'gnus-score-custom-sanify (cdr entry)) (setq entry (assoc name gnus-score-alist)) (if (or (memq name '(files exclude-files local)) (and (eq name 'adapt) (not (symbolp (car (cdr entry)))))) (cdr entry) (car (cdr entry))))))) (defun gnus-score-custom-set (name value) (cond ((eq name 'file) (setq gnus-score-custom-file value)) ((assoc (symbol-name name) gnus-score-alist) (if value (setcdr (assoc (symbol-name name) gnus-score-alist) value) (setq gnus-score-alist (delq (assoc (symbol-name name) gnus-score-alist) gnus-score-alist)))) ((assoc (symbol-name name) gnus-header-index) (if value (setq gnus-score-alist (cons (cons (symbol-name name) value) gnus-score-alist)))) ((assoc name gnus-score-alist) (cond ((null value) (setq gnus-score-alist (delq (assoc name gnus-score-alist) gnus-score-alist))) ((and (listp value) (not (eq name 'eval))) (setcdr (assoc name gnus-score-alist) value)) (t (setcdr (assoc name gnus-score-alist) (list value))))) ((null value)) ((and (listp value) (not (eq name 'eval))) (setq gnus-score-alist (cons (cons name value) gnus-score-alist))) (t (setq gnus-score-alist (cons (cons name (list value)) gnus-score-alist))))) (defun gnus-score-custom-sanify (entry) (list (nth 0 entry) (or (nth 1 entry) gnus-score-interactive-default-score) (nth 2 entry) (cond ((null (nth 3 entry)) 's) ((memq (nth 3 entry) '(before after at >= <=)) (nth 3 entry)) (t (intern (substring (symbol-name (nth 3 entry)) 0 1)))))) (defvar gnus-score-cache nil) (defun gnus-score-custom-load () (interactive) (let ((file (custom-name-value 'file))) (if (eq file custom-nil) (error "You must specify a file name")) (setq file (expand-file-name file "~/News")) (gnus-score-load file) (setq gnus-score-custom-file file) (custom-reset-all) (message "Loaded"))) (defun gnus-score-custom-save () (interactive) (custom-apply-all) (gnus-score-remove-from-cache gnus-score-custom-file) (let ((file gnus-score-custom-file) (score gnus-score-alist) emacs-lisp-mode-hook) (save-excursion (set-buffer (get-buffer-create "*Score*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (pp score (current-buffer)) (gnus-make-directory (file-name-directory file)) (write-region (point-min) (point-max) file nil 'silent) (kill-buffer (current-buffer)))) (message "Saved")) (provide 'gnus-edit) ;;; gnus-edit.el end here emacs-19.30/lisp/gnus-ems.el100444 23053 1 57124 6046561335 14510 0ustar larsidaemon;;; gnus-ems.el --- functions for making Gnus work under different Emacsen ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Code: (defvar gnus-mouse-2 [mouse-2]) (defvar gnus-group-mode-hook ()) (defvar gnus-summary-mode-hook ()) (defvar gnus-article-mode-hook ()) (defalias 'gnus-make-overlay 'make-overlay) (defalias 'gnus-overlay-put 'overlay-put) (defalias 'gnus-move-overlay 'move-overlay) (or (fboundp 'mail-file-babyl-p) (fset 'mail-file-babyl-p 'rmail-file-p)) ;; Don't warn about these undefined variables. ;defined in gnus.el (defvar gnus-active-hashtb) (defvar gnus-article-buffer) (defvar gnus-auto-center-summary) (defvar gnus-buffer-list) (defvar gnus-current-headers) (defvar gnus-level-killed) (defvar gnus-level-zombie) (defvar gnus-newsgroup-bookmarks) (defvar gnus-newsgroup-dependencies) (defvar gnus-newsgroup-headers-hashtb-by-number) (defvar gnus-newsgroup-selected-overlay) (defvar gnus-newsrc-hashtb) (defvar gnus-read-mark) (defvar gnus-refer-article-method) (defvar gnus-reffed-article-number) (defvar gnus-unread-mark) (defvar gnus-version) (defvar gnus-view-pseudos) (defvar gnus-view-pseudos-separately) (defvar gnus-visual) (defvar gnus-zombie-list) ;defined in gnus-msg.el (defvar gnus-article-copy) (defvar gnus-check-before-posting) ;defined in gnus-vis.el (defvar gnus-article-button-face) (defvar gnus-article-mouse-face) (defvar gnus-summary-selected-face) ;; We do not byte-compile this file, because error messages are such a ;; bore. (defun gnus-set-text-properties-xemacs (start end props &optional buffer) "You should NEVER use this function. It is ideologically blasphemous. It is provided only to ease porting of broken FSF Emacs programs." (if (and (stringp buffer) (not (setq buffer (get-buffer buffer)))) nil (map-extents (lambda (extent ignored) (remove-text-properties start end (list (extent-property extent 'text-prop) nil) buffer)) buffer start end nil nil 'text-prop) (add-text-properties start end props buffer))) (eval '(progn (if (string-match "XEmacs\\|Lucid" emacs-version) () ;; Added by Per Abrahamsen . (defvar gnus-display-type (condition-case nil (let ((display-resource (x-get-resource ".displayType" "DisplayType"))) (cond (display-resource (intern (downcase display-resource))) ((x-display-color-p) 'color) ((x-display-grayscale-p) 'grayscale) (t 'mono))) (error 'mono)) "A symbol indicating the display Emacs is running under. The symbol should be one of `color', `grayscale' or `mono'. If Emacs guesses this display attribute wrongly, either set this variable in your `~/.emacs' or set the resource `Emacs.displayType' in your `~/.Xdefaults'. See also `gnus-background-mode'. This is a meta-variable that will affect what default values other variables get. You would normally not change this variable, but pounce directly on the real variables themselves.") (defvar gnus-background-mode (condition-case nil (let ((bg-resource (x-get-resource ".backgroundMode" "BackgroundMode")) (params (frame-parameters))) (cond (bg-resource (intern (downcase bg-resource))) ((and (cdr (assq 'background-color params)) (< (apply '+ (x-color-values (cdr (assq 'background-color params)))) (/ (apply '+ (x-color-values "white")) 3))) 'dark) (t 'light))) (error 'light)) "A symbol indicating the Emacs background brightness. The symbol should be one of `light' or `dark'. If Emacs guesses this frame attribute wrongly, either set this variable in your `~/.emacs' or set the resource `Emacs.backgroundMode' in your `~/.Xdefaults'. See also `gnus-display-type'. This is a meta-variable that will affect what default values other variables get. You would normally not change this variable, but pounce directly on the real variables themselves.")) (cond ((string-match "XEmacs\\|Lucid" emacs-version) ;; XEmacs definitions. (setq gnus-mouse-2 [button2]) (or (memq 'underline (list-faces)) (and (fboundp 'make-face) (funcall (intern "make-face") 'underline))) ;; Must avoid calling set-face-underline-p directly, because it ;; is a defsubst in emacs19, and will make the .elc files non ;; portable! (or (face-differs-from-default-p 'underline) (funcall 'set-face-underline-p 'underline t)) (defalias 'gnus-make-overlay 'make-extent) (defalias 'gnus-overlay-put 'set-extent-property) (defun gnus-move-overlay (extent start end &optional buffer) (set-extent-endpoints extent start end)) (require 'text-props) (fset 'set-text-properties 'gnus-set-text-properties-xemacs) (or (boundp 'standard-display-table) (setq standard-display-table nil)) (or (boundp 'read-event) (fset 'read-event 'next-command-event)) ;; Fix by "jeff (j.d.) sparkes" . (defvar gnus-display-type (device-class) "A symbol indicating the display Emacs is running under. The symbol should be one of `color', `grayscale' or `mono'. If Emacs guesses this display attribute wrongly, either set this variable in your `~/.emacs' or set the resource `Emacs.displayType' in your `~/.Xdefaults'. See also `gnus-background-mode'. This is a meta-variable that will affect what default values other variables get. You would normally not change this variable, but pounce directly on the real variables themselves.") (or (fboundp 'x-color-values) (fset 'x-color-values (lambda (color) (color-instance-rgb-components (make-color-instance color))))) (defvar gnus-background-mode (let ((bg-resource (condition-case () (x-get-resource ".backgroundMode" "BackgroundMode" 'string) (error nil))) (params (frame-parameters))) (cond (bg-resource (intern (downcase bg-resource))) ((and (assq 'background-color params) (< (apply '+ (x-color-values (cdr (assq 'background-color params)))) (/ (apply '+ (x-color-values "white")) 3))) 'dark) (t 'light))) "A symbol indicating the Emacs background brightness. The symbol should be one of `light' or `dark'. If Emacs guesses this frame attribute wrongly, either set this variable in your `~/.emacs' or set the resource `Emacs.backgroundMode' in your `~/.Xdefaults'. See also `gnus-display-type'. This is a meta-variable that will affect what default values other variables get. You would normally not change this variable, but pounce directly on the real variables themselves.") (defun gnus-install-mouse-tracker () (require 'mode-motion) (setq mode-motion-hook 'mode-motion-highlight-line))) ((and (not (string-match "28.9" emacs-version)) (not (string-match "29" emacs-version))) ;; Remove the `intangible' prop. (let ((props (and (boundp 'gnus-hidden-properties) gnus-hidden-properties))) (while (and props (not (eq (car (cdr props)) 'intangible))) (setq props (cdr props))) (and props (setcdr props (cdr (cdr (cdr props)))))) (or (fboundp 'buffer-substring-no-properties) (defun buffer-substring-no-properties (beg end) (format "%s" (buffer-substring beg end))))) ((boundp 'MULE) (provide 'gnusutil)) ))) (eval-and-compile (cond ((not window-system) (defun gnus-dummy-func (&rest args)) (let ((funcs '(mouse-set-point set-face-foreground set-face-background x-popup-menu))) (while funcs (or (fboundp (car funcs)) (fset (car funcs) 'gnus-dummy-func)) (setq funcs (cdr funcs)))))) (or (fboundp 'file-regular-p) (defun file-regular-p (file) (and (not (file-directory-p file)) (not (file-symlink-p file)) (file-exists-p file)))) (or (fboundp 'face-list) (defun face-list (&rest args))) ) (defun gnus-highlight-selected-summary-xemacs () ;; Highlight selected article in summary buffer (if gnus-summary-selected-face (progn (if gnus-newsgroup-selected-overlay (delete-extent gnus-newsgroup-selected-overlay)) (setq gnus-newsgroup-selected-overlay (make-extent (gnus-point-at-bol) (gnus-point-at-eol))) (set-extent-face gnus-newsgroup-selected-overlay gnus-summary-selected-face)))) (defun gnus-summary-recenter-xemacs () (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) (t 2))) (height (- (window-height) 2)) (bottom (save-excursion (goto-char (point-max)) (forward-line (- height)) (point))) (window (get-buffer-window (current-buffer)))) (and ;; The user has to want it, gnus-auto-center-summary ;; the article buffer must be displayed, (get-buffer-window gnus-article-buffer) ;; Set the window start to either `bottom', which is the biggest ;; possible valid number, or the second line from the top, ;; whichever is the least. (set-window-start window (min bottom (save-excursion (forward-line (- top)) (point))))))) (defun gnus-group-insert-group-line-info-xemacs (group) (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) (beg (point)) active info) (if entry (progn (setq info (nth 2 entry)) (gnus-group-insert-group-line nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info))) (setq active (gnus-gethash group gnus-active-hashtb)) (gnus-group-insert-group-line nil group (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) nil (if active (- (1+ (cdr active)) (car active)) 0) nil)) (save-excursion (goto-char beg) (remove-text-properties (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol)) '(gnus-group nil))))) (defun gnus-summary-refer-article-xemacs (message-id) "Refer article specified by MESSAGE-ID. NOTE: This command only works with newsgroups that use real or simulated NNTP." (interactive "sMessage-ID: ") (if (or (not (stringp message-id)) (zerop (length message-id))) () ;; Construct the correct Message-ID if necessary. ;; Suggested by tale@pawl.rpi.edu. (or (string-match "^<" message-id) (setq message-id (concat "<" message-id))) (or (string-match ">$" message-id) (setq message-id (concat message-id ">"))) (let ((header (car (gnus-gethash (downcase message-id) gnus-newsgroup-dependencies)))) (if header (or (gnus-summary-goto-article (mail-header-number header)) ;; The header has been read, but the article had been ;; expunged, so we insert it again. (let ((beg (point))) (gnus-summary-insert-line nil header 0 nil gnus-read-mark nil nil (mail-header-subject header)) (save-excursion (goto-char beg) (remove-text-properties (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol)) '(gnus-number nil gnus-mark nil gnus-level nil))) (forward-line -1) (mail-header-number header))) (let ((gnus-override-method gnus-refer-article-method) (gnus-ancient-mark gnus-read-mark) (tmp-point (window-start (get-buffer-window gnus-article-buffer))) number tmp-buf) (and gnus-refer-article-method (gnus-check-server gnus-refer-article-method)) ;; Save the old article buffer. (save-excursion (set-buffer gnus-article-buffer) (gnus-kill-buffer " *temp Article*") (setq tmp-buf (rename-buffer " *temp Article*"))) (prog1 (if (gnus-article-prepare message-id nil (gnus-read-header message-id)) (progn (setq number (mail-header-number gnus-current-headers)) (gnus-rebuild-thread message-id) (gnus-summary-goto-subject number) (gnus-summary-recenter) (gnus-article-set-window-start (cdr (assq number gnus-newsgroup-bookmarks))) message-id) ;; We restore the old article buffer. (save-excursion (kill-buffer gnus-article-buffer) (set-buffer tmp-buf) (rename-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (and tmp-point (set-window-start (get-buffer-window (current-buffer)) tmp-point))))))))))) (defun gnus-summary-insert-pseudos-xemacs (pslist &optional not-view) (let ((buffer-read-only nil) (article (gnus-summary-article-number)) b) (or (gnus-summary-goto-subject article) (error (format "No such article: %d" article))) (or gnus-newsgroup-headers-hashtb-by-number (gnus-make-headers-hashtable-by-number)) (gnus-summary-position-cursor) ;; If all commands are to be bunched up on one line, we collect ;; them here. (if gnus-view-pseudos-separately () (let ((ps (setq pslist (sort pslist 'gnus-pseudos<))) files action) (while ps (setq action (cdr (assq 'action (car ps)))) (setq files (list (cdr (assq 'name (car ps))))) (while (and ps (cdr ps) (string= (or action "1") (or (cdr (assq 'action (car (cdr ps)))) "2"))) (setq files (cons (cdr (assq 'name (car (cdr ps)))) files)) (setcdr ps (cdr (cdr ps)))) (if (not files) () (if (not (string-match "%s" action)) (setq files (cons " " files))) (setq files (cons " " files)) (and (assq 'execute (car ps)) (setcdr (assq 'execute (car ps)) (funcall (if (string-match "%s" action) 'format 'concat) action (mapconcat (lambda (f) f) files " "))))) (setq ps (cdr ps))))) (if (and gnus-view-pseudos (not not-view)) (while pslist (and (assq 'execute (car pslist)) (gnus-execute-command (cdr (assq 'execute (car pslist))) (eq gnus-view-pseudos 'not-confirm))) (setq pslist (cdr pslist))) (save-excursion (while pslist (gnus-summary-goto-subject (or (cdr (assq 'article (car pslist))) (gnus-summary-article-number))) (forward-line 1) (setq b (point)) (insert " " (file-name-nondirectory (cdr (assq 'name (car pslist)))) ": " (or (cdr (assq 'execute (car pslist))) "") "\n") (add-text-properties b (1+ b) (list 'gnus-number gnus-reffed-article-number 'gnus-mark gnus-unread-mark 'gnus-level 0 'gnus-pseudo (car pslist))) ;; Fucking XEmacs redisplay bug with truncated lines. (goto-char b) (sit-for 0) ;; Grumble.. Fucking XEmacs stickyness of text properties. (remove-text-properties (1+ b) (1+ (gnus-point-at-eol)) '(gnus-number nil gnus-mark nil gnus-level nil)) (forward-line -1) (gnus-sethash (int-to-string gnus-reffed-article-number) (car pslist) gnus-newsgroup-headers-hashtb-by-number) (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) (setq pslist (cdr pslist))))))) (defun gnus-copy-article-buffer-xemacs (&optional article-buffer) (setq gnus-article-copy (get-buffer-create " *gnus article copy*")) (buffer-disable-undo gnus-article-copy) (or (memq gnus-article-copy gnus-buffer-list) (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list))) (let ((article-buffer (or article-buffer gnus-article-buffer)) buf) (if (and (get-buffer article-buffer) (buffer-name (get-buffer article-buffer))) (save-excursion (set-buffer article-buffer) (widen) (setq buf (buffer-substring (point-min) (point-max))) (set-buffer gnus-article-copy) (erase-buffer) (insert (format "%s" buf)))))) (defun gnus-article-push-button-xemacs (event) "Check text under the mouse pointer for a callback function. If the text under the mouse pointer has a `gnus-callback' property, call it with the value of the `gnus-data' text property." (interactive "e") (set-buffer (window-buffer (event-window event))) (let* ((pos (event-closest-point event)) (data (get-text-property pos 'gnus-data)) (fun (get-text-property pos 'gnus-callback))) (if fun (funcall fun data)))) ;; Re-build the thread containing ID. (defun gnus-rebuild-thread-xemacs (id) (let ((dep gnus-newsgroup-dependencies) (buffer-read-only nil) parent headers refs thread art) (while (and id (setq headers (car (setq art (gnus-gethash (downcase id) dep))))) (setq parent art) (setq id (and (setq refs (mail-header-references headers)) (string-match "\\(<[^>]+>\\) *$" refs) (substring refs (match-beginning 1) (match-end 1))))) (setq thread (gnus-make-sub-thread (car parent))) (gnus-rebuild-remove-articles thread) (let ((beg (point))) (gnus-summary-prepare-threads (list thread) 0) (save-excursion (while (and (>= (point) beg) (not (bobp))) (or (eobp) (remove-text-properties (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol)) '(gnus-number nil gnus-mark nil gnus-level nil))) (forward-line -1))) (gnus-summary-update-lines beg (point))))) ;; Fixed by Christopher Davis . (defun gnus-article-add-button-xemacs (from to fun &optional data) "Create a button between FROM and TO with callback FUN and data DATA." (and gnus-article-button-face (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) (add-text-properties from to (append (and gnus-article-mouse-face (list 'mouse-face gnus-article-mouse-face)) (list 'gnus-callback fun) (and data (list 'gnus-data data)) (list 'highlight t)))) (defun gnus-window-top-edge-xemacs (&optional window) (nth 1 (window-pixel-edges window))) ;; Select the lowest window on the frame. (defun gnus-appt-select-lowest-window-xemacs () (let* ((lowest-window (selected-window)) (bottom-edge (car (cdr (cdr (cdr (window-pixel-edges)))))) (last-window (previous-window)) (window-search t)) (while window-search (let* ((this-window (next-window)) (next-bottom-edge (car (cdr (cdr (cdr (window-pixel-edges this-window))))))) (if (< bottom-edge next-bottom-edge) (progn (setq bottom-edge next-bottom-edge) (setq lowest-window this-window))) (select-window this-window) (if (eq last-window this-window) (progn (select-window lowest-window) (setq window-search nil))))))) (defun gnus-ems-redefine () (cond ((string-match "XEmacs\\|Lucid" emacs-version) ;; XEmacs definitions. (fset 'gnus-mouse-face-function 'identity) (fset 'gnus-summary-make-display-table (lambda () nil)) (fset 'gnus-visual-turn-off-edit-menu 'identity) (fset 'gnus-highlight-selected-summary 'gnus-highlight-selected-summary-xemacs) (fset 'gnus-summary-recenter 'gnus-summary-recenter-xemacs) (fset 'gnus-group-insert-group-line-info 'gnus-group-insert-group-line-info-xemacs) (fset 'gnus-copy-article-buffer 'gnus-copy-article-buffer-xemacs) (fset 'gnus-summary-refer-article 'gnus-summary-refer-article-xemacs) (fset 'gnus-summary-insert-pseudos 'gnus-summary-insert-pseudos-xemacs) (fset 'gnus-article-push-button 'gnus-article-push-button-xemacs) (fset 'gnus-rebuild-thread 'gnus-rebuild-thread-xemacs) (fset 'gnus-article-add-button 'gnus-article-add-button-xemacs) (fset 'gnus-window-top-edge 'gnus-window-top-edge-xemacs) (fset 'set-text-properties 'gnus-set-text-properties-xemacs) (or (fboundp 'appt-select-lowest-window) (fset 'appt-select-lowest-window 'gnus-appt-select-lowest-window-xemacs)) (if (not gnus-visual) () (setq gnus-group-mode-hook (cons '(lambda () (easy-menu-add gnus-group-reading-menu) (easy-menu-add gnus-group-group-menu) (easy-menu-add gnus-group-misc-menu) (gnus-install-mouse-tracker)) gnus-group-mode-hook)) (setq gnus-summary-mode-hook (cons '(lambda () (easy-menu-add gnus-summary-article-menu) (easy-menu-add gnus-summary-thread-menu) (easy-menu-add gnus-summary-misc-menu) (easy-menu-add gnus-summary-post-menu) (easy-menu-add gnus-summary-kill-menu) (gnus-install-mouse-tracker)) gnus-summary-mode-hook)) (setq gnus-article-mode-hook (cons '(lambda () (easy-menu-add gnus-article-article-menu) (easy-menu-add gnus-article-treatment-menu)) gnus-article-mode-hook))) (defvar gnus-logo (make-glyph (make-specifier 'image))) (defun gnus-group-startup-xmessage (&optional x y) "Insert startup message in current buffer." ;; Insert the message. (erase-buffer) (if (featurep 'xpm) (progn (set-glyph-property gnus-logo 'image "~/tmp/gnus.xpm") (set-glyph-image gnus-logo "~/tmp/gnus.xpm" 'global 'x) (insert " ") (set-extent-begin-glyph (make-extent (point) (point)) gnus-logo) (insert " Gnus * A newsreader for Emacsen A Praxis Release * larsi@ifi.uio.no") (goto-char (point-min)) (while (not (eobp)) (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2) ? )) (forward-line 1)) (goto-char (point-min)) ;; +4 is fuzzy factor. (insert-char ?\n (/ (max (- (window-height) (or y 24)) 0) 2))) (insert (format " %s A newsreader for GNU Emacs Based on GNUS written by Masanobu UMEDA A Praxis Release larsi@ifi.uio.no " gnus-version)) ;; And then hack it. ;; 18 is the longest line. (indent-rigidly (point-min) (point-max) (/ (max (- (window-width) (or x 28)) 0) 2)) (goto-char (point-min)) ;; +4 is fuzzy factor. (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2))) ;; Fontify some. (goto-char (point-min)) (search-forward "Praxis") (put-text-property (match-beginning 0) (match-end 0) 'face 'bold) (goto-char (point-min))) ) ((boundp 'MULE) ;; Mule definitions (if (not (fboundp 'truncate-string)) (defun truncate-string (str width) (let ((w (string-width str)) (col 0) (idx 0) (p-idx 0) chr) (if (<= w width) str (while (< col width) (setq chr (aref str idx) col (+ col (char-width chr)) p-idx idx idx (+ idx (char-bytes chr)) )) (substring str 0 (if (= col width) idx p-idx)) ))) ) (defalias 'gnus-truncate-string 'truncate-string) (defun gnus-cite-add-face (number prefix face) ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. (if face (let ((inhibit-point-motion-hooks t) from to) (goto-line number) (if (boundp 'MULE) (forward-char (chars-in-string prefix)) (forward-char (length prefix))) (skip-chars-forward " \t") (setq from (point)) (end-of-line 1) (skip-chars-backward " \t") (setq to (point)) (if (< from to) (gnus-overlay-put (gnus-make-overlay from to) 'face face))))) (defun gnus-max-width-function (el max-width) (` (let* ((val (eval (, el))) (valstr (if (numberp val) (int-to-string val) val))) (if (> (length valstr) (, max-width)) (truncate-string valstr (, max-width)) valstr)))) (fset 'gnus-summary-make-display-table (lambda () nil)) (if (boundp 'gnus-check-before-posting) (setq gnus-check-before-posting (delq 'long-lines (delq 'control-chars gnus-check-before-posting))) ) ) )) (provide 'gnus-ems) ;; Local Variables: ;; byte-compile-warnings: '(redefine callargs) ;; End: ;;; gnus-ems.el ends here emacs-19.30/lisp/gnus-kill.el100444 23053 1 54017 6046561347 14660 0ustar larsidaemon;;; gnus-kill.el --- kill commands for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Code: (require 'gnus) (defvar gnus-kill-file-mode-hook nil "*A hook for Gnus kill file mode.") (defvar gnus-kill-expiry-days 7 "*Number of days before expiring unused kill file entries.") (defvar gnus-kill-save-kill-file nil "*If non-nil, will save kill files after processing them.") (defvar gnus-winconf-kill-file nil) (defmacro gnus-raise (field expression level) (` (gnus-kill (, field) (, expression) (function (gnus-summary-raise-score (, level))) t))) (defmacro gnus-lower (field expression level) (` (gnus-kill (, field) (, expression) (function (gnus-summary-raise-score (- (, level)))) t))) ;;; ;;; Gnus Kill File Mode ;;; (defvar gnus-kill-file-mode-map nil) (if gnus-kill-file-mode-map nil (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map)) (define-key gnus-kill-file-mode-map "\C-c\C-k\C-s" 'gnus-kill-file-kill-by-subject) (define-key gnus-kill-file-mode-map "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-author) (define-key gnus-kill-file-mode-map "\C-c\C-k\C-t" 'gnus-kill-file-kill-by-thread) (define-key gnus-kill-file-mode-map "\C-c\C-k\C-x" 'gnus-kill-file-kill-by-xref) (define-key gnus-kill-file-mode-map "\C-c\C-a" 'gnus-kill-file-apply-buffer) (define-key gnus-kill-file-mode-map "\C-c\C-e" 'gnus-kill-file-apply-last-sexp) (define-key gnus-kill-file-mode-map "\C-c\C-c" 'gnus-kill-file-exit)) (defun gnus-kill-file-mode () "Major mode for editing kill files. If you are using this mode - you probably shouldn't. Kill files perform badly and paint with a pretty broad brush. Score files, on the other hand, are vastly faster (40x speedup) and give you more control over what to do. In addition to Emacs-Lisp Mode, the following commands are available: \\{gnus-kill-file-mode-map} A kill file contains Lisp expressions to be applied to a selected newsgroup. The purpose is to mark articles as read on the basis of some set of regexps. A global kill file is applied to every newsgroup, and a local kill file is applied to a specified newsgroup. Since a global kill file is applied to every newsgroup, for better performance use a local one. A kill file can contain any kind of Emacs Lisp expressions expected to be evaluated in the Summary buffer. Writing Lisp programs for this purpose is not so easy because the internal working of Gnus must be well-known. For this reason, Gnus provides a general function which does this easily for non-Lisp programmers. The `gnus-kill' function executes commands available in Summary Mode by their key sequences. `gnus-kill' should be called with FIELD, REGEXP and optional COMMAND and ALL. FIELD is a string representing the header field or an empty string. If FIELD is an empty string, the entire article body is searched for. REGEXP is a string which is compared with FIELD value. COMMAND is a string representing a valid key sequence in Summary mode or Lisp expression. COMMAND defaults to '(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is executed in the Summary buffer. If the second optional argument ALL is non-nil, the COMMAND is applied to articles which are already marked as read or unread. Articles which are marked are skipped over by default. For example, if you want to mark articles of which subjects contain the string `AI' as read, a possible kill file may look like: (gnus-kill \"Subject\" \"AI\") If you want to mark articles with `D' instead of `X', you can use the following expression: (gnus-kill \"Subject\" \"AI\" \"d\") In this example it is assumed that the command `gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode. It is possible to delete unnecessary headers which are marked with `X' in a kill file as follows: (gnus-expunge \"X\") If the Summary buffer is empty after applying kill files, Gnus will exit the selected newsgroup normally. If headers which are marked with `D' are deleted in a kill file, it is impossible to read articles which are marked as read in the previous Gnus sessions. Marks other than `D' should be used for articles which should really be deleted. Entry to this mode calls emacs-lisp-mode-hook and gnus-kill-file-mode-hook with no arguments, if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map gnus-kill-file-mode-map) (set-syntax-table emacs-lisp-mode-syntax-table) (setq major-mode 'gnus-kill-file-mode) (setq mode-name "Kill") (lisp-mode-variables nil) (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook)) (defun gnus-kill-file-edit-file (newsgroup) "Begin editing a kill file for NEWSGROUP. If NEWSGROUP is nil, the global kill file is selected." (interactive "sNewsgroup: ") (let ((file (gnus-newsgroup-kill-file newsgroup))) (gnus-make-directory (file-name-directory file)) ;; Save current window configuration if this is first invocation. (or (and (get-file-buffer file) (get-buffer-window (get-file-buffer file))) (setq gnus-winconf-kill-file (current-window-configuration))) ;; Hack windows. (let ((buffer (find-file-noselect file))) (cond ((get-buffer-window buffer) (pop-to-buffer buffer)) ((eq major-mode 'gnus-group-mode) (gnus-configure-windows 'group) ;Take all windows. (pop-to-buffer buffer)) ((eq major-mode 'gnus-summary-mode) (gnus-configure-windows 'article) (pop-to-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer) (switch-to-buffer buffer)) (t ;No good rules. (find-file-other-window file)))) (gnus-kill-file-mode))) ;; Fix by Sudish Joseph . (defun gnus-kill-set-kill-buffer () (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)) (buffer (find-file-noselect file))) (set-buffer buffer) (gnus-kill-file-mode) (bury-buffer buffer))) (defun gnus-kill-file-enter-kill (field regexp) ;; Enter kill file entry. ;; FIELD: String containing the name of the header field to kill. ;; REGEXP: The string to kill. (save-excursion (let (string) (or (eq major-mode 'gnus-kill-file-mode) (gnus-kill-set-kill-buffer)) (current-buffer) (goto-char (point-max)) (insert (setq string (format "(gnus-kill %S %S)\n" field regexp))) (gnus-kill-file-apply-string string)))) (defun gnus-kill-file-kill-by-subject () "Kill by subject." (interactive) (gnus-kill-file-enter-kill "Subject" (if (vectorp gnus-current-headers) (regexp-quote (gnus-simplify-subject (mail-header-subject gnus-current-headers))) ""))) (defun gnus-kill-file-kill-by-author () "Kill by author." (interactive) (gnus-kill-file-enter-kill "From" (if (vectorp gnus-current-headers) (regexp-quote (mail-header-from gnus-current-headers)) ""))) (defun gnus-kill-file-kill-by-thread () "Kill by author." (interactive "p") (gnus-kill-file-enter-kill "References" (if (vectorp gnus-current-headers) (regexp-quote (mail-header-id gnus-current-headers)) ""))) (defun gnus-kill-file-kill-by-xref () "Kill by Xref." (interactive) (let ((xref (and (vectorp gnus-current-headers) (mail-header-xref gnus-current-headers))) (start 0) group) (if xref (while (string-match " \\([^ \t]+\\):" xref start) (setq start (match-end 0)) (if (not (string= (setq group (substring xref (match-beginning 1) (match-end 1))) gnus-newsgroup-name)) (gnus-kill-file-enter-kill "Xref" (concat " " (regexp-quote group) ":")))) (gnus-kill-file-enter-kill "Xref" "")))) (defun gnus-kill-file-raise-followups-to-author (level) "Raise score for all followups to the current author." (interactive "p") (let ((name (mail-header-from gnus-current-headers)) string) (save-excursion (gnus-kill-set-kill-buffer) (goto-char (point-min)) (setq name (read-string (concat "Add " level " to followup articles to: ") (regexp-quote name))) (setq string (format "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n" "From" name level)) (insert string) (gnus-kill-file-apply-string string)) (message "Added temporary score file entry for followups to %s." name))) (defun gnus-kill-file-apply-buffer () "Apply current buffer to current newsgroup." (interactive) (if (and gnus-current-kill-article (get-buffer gnus-summary-buffer)) ;; Assume newsgroup is selected. (gnus-kill-file-apply-string (buffer-string)) (ding) (message "No newsgroup is selected."))) (defun gnus-kill-file-apply-string (string) "Apply STRING to current newsgroup." (interactive) (let ((string (concat "(progn \n" string "\n)"))) (save-excursion (save-window-excursion (pop-to-buffer gnus-summary-buffer) (eval (car (read-from-string string))))))) (defun gnus-kill-file-apply-last-sexp () "Apply sexp before point in current buffer to current newsgroup." (interactive) (if (and gnus-current-kill-article (get-buffer gnus-summary-buffer)) ;; Assume newsgroup is selected. (let ((string (buffer-substring (save-excursion (forward-sexp -1) (point)) (point)))) (save-excursion (save-window-excursion (pop-to-buffer gnus-summary-buffer) (eval (car (read-from-string string)))))) (ding) (message "No newsgroup is selected."))) (defun gnus-kill-file-exit () "Save a kill file, then return to the previous buffer." (interactive) (save-buffer) (let ((killbuf (current-buffer))) ;; We don't want to return to article buffer. (and (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) ;; Delete the KILL file windows. (delete-windows-on killbuf) ;; Restore last window configuration if available. (and gnus-winconf-kill-file (set-window-configuration gnus-winconf-kill-file)) (setq gnus-winconf-kill-file nil) ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu. (kill-buffer killbuf))) ;; For kill files (defun gnus-Newsgroup-kill-file (newsgroup) "Return the name of a kill file for NEWSGROUP. If NEWSGROUP is nil, return the global kill file instead." (cond ((or (null newsgroup) (string-equal newsgroup "")) ;; The global kill file is placed at top of the directory. (expand-file-name gnus-kill-file-name (or gnus-kill-files-directory "~/News"))) (gnus-use-long-file-name ;; Append ".KILL" to capitalized newsgroup name. (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup) "." gnus-kill-file-name) (or gnus-kill-files-directory "~/News"))) (t ;; Place "KILL" under the hierarchical directory. (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" gnus-kill-file-name) (or gnus-kill-files-directory "~/News"))))) (defun gnus-expunge (marks) "Remove lines marked with MARKS." (save-excursion (set-buffer gnus-summary-buffer) (gnus-summary-remove-lines-marked-with marks))) (defun gnus-apply-kill-file-internal () "Apply a kill file to the current newsgroup. Returns the number of articles marked as read." (let* ((kill-files (list (gnus-newsgroup-kill-file nil) (gnus-newsgroup-kill-file gnus-newsgroup-name))) (unreads (length gnus-newsgroup-unreads)) (gnus-summary-inhibit-highlight t) beg) (setq gnus-newsgroup-kill-headers nil) (or gnus-newsgroup-headers-hashtb-by-number (gnus-make-headers-hashtable-by-number)) ;; If there are any previously scored articles, we remove these ;; from the `gnus-newsgroup-headers' list that the score functions ;; will see. This is probably pretty wasteful when it comes to ;; conses, but is, I think, faster than having to assq in every ;; single score function. (let ((files kill-files)) (while files (if (file-exists-p (car files)) (let ((headers gnus-newsgroup-headers)) (if gnus-kill-killed (setq gnus-newsgroup-kill-headers (mapcar (lambda (header) (mail-header-number header)) headers)) (while headers (or (gnus-member-of-range (mail-header-number (car headers)) gnus-newsgroup-killed) (setq gnus-newsgroup-kill-headers (cons (mail-header-number (car headers)) gnus-newsgroup-kill-headers))) (setq headers (cdr headers)))) (setq files nil)) (setq files (cdr files))))) (if (not gnus-newsgroup-kill-headers) () (save-window-excursion (save-excursion (while kill-files (if (not (file-exists-p (car kill-files))) () (message "Processing kill file %s..." (car kill-files)) (find-file (car kill-files)) (gnus-add-current-to-buffer-list) (goto-char (point-min)) (if (consp (condition-case nil (read (current-buffer)) (error nil))) (gnus-kill-parse-gnus-kill-file) (gnus-kill-parse-rn-kill-file)) (message "Processing kill file %s...done" (car kill-files))) (setq kill-files (cdr kill-files))))) (gnus-set-mode-line 'summary) (if beg (let ((nunreads (- unreads (length gnus-newsgroup-unreads)))) (or (eq nunreads 0) (message "Marked %d articles as read" nunreads)) nunreads) 0)))) ;; Parse a Gnus killfile. (defun gnus-score-insert-help (string alist idx) (save-excursion (pop-to-buffer "*Score Help*") (buffer-disable-undo (current-buffer)) (erase-buffer) (insert string ":\n\n") (while alist (insert (format " %c: %s\n" (car (car alist)) (nth idx (car alist)))) (setq alist (cdr alist))))) (defun gnus-kill-parse-gnus-kill-file () (goto-char (point-min)) (gnus-kill-file-mode) (let (beg form) (while (progn (setq beg (point)) (setq form (condition-case () (read (current-buffer)) (error nil)))) (or (listp form) (error "Illegal kill entry (possibly rn kill file?): %s" form)) (if (or (eq (car form) 'gnus-kill) (eq (car form) 'gnus-raise) (eq (car form) 'gnus-lower)) (progn (delete-region beg (point)) (insert (or (eval form) ""))) (save-excursion (set-buffer gnus-summary-buffer) (condition-case () (eval form) (error nil))))) (and (buffer-modified-p) gnus-kill-save-kill-file (save-buffer)) (set-buffer-modified-p nil))) ;; Parse an rn killfile. (defun gnus-kill-parse-rn-kill-file () (goto-char (point-min)) (gnus-kill-file-mode) (let ((mod-to-header '((?a . "") (?h . "") (?f . "from") (?: . "subject"))) (com-to-com '((?m . " ") (?j . "X"))) pattern modifier commands) (while (not (eobp)) (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)")) () (setq pattern (buffer-substring (match-beginning 1) (match-end 1))) (setq modifier (if (match-beginning 2) (char-after (match-beginning 2)) ?s)) (setq commands (buffer-substring (match-beginning 3) (match-end 3))) ;; The "f:+" command marks everything *but* the matches as read, ;; so we simply first match everything as read, and then unmark ;; PATTERN later. (and (string-match "\\+" commands) (progn (gnus-kill "from" ".") (setq commands "m"))) (gnus-kill (or (cdr (assq modifier mod-to-header)) "subject") pattern (if (string-match "m" commands) '(gnus-summary-mark-as-unread nil " ") '(gnus-summary-mark-as-read nil "X")) nil t)) (forward-line 1)))) ;; Kill changes and new format by suggested by JWZ and Sudish Joseph ;; . (defun gnus-kill (field regexp &optional exe-command all silent) "If FIELD of an article matches REGEXP, execute COMMAND. Optional 1st argument COMMAND is default to (gnus-summary-mark-as-read nil \"X\"). If optional 2nd argument ALL is non-nil, articles marked are also applied to. If FIELD is an empty string (or nil), entire article body is searched for. COMMAND must be a lisp expression or a string representing a key sequence." ;; We don't want to change current point nor window configuration. (let ((old-buffer (current-buffer))) (save-excursion (save-window-excursion ;; Selected window must be summary buffer to execute keyboard ;; macros correctly. See command_loop_1. (switch-to-buffer gnus-summary-buffer 'norecord) (goto-char (point-min)) ;From the beginning. (let ((kill-list regexp) (date (current-time-string)) (command (or exe-command '(gnus-summary-mark-as-read nil gnus-kill-file-mark))) kill kdate prev) (if (listp kill-list) ;; It is a list. (if (not (consp (cdr kill-list))) ;; It's on the form (regexp . date). (if (zerop (gnus-execute field (car kill-list) command nil (not all))) (if (> (gnus-days-between date (cdr kill-list)) gnus-kill-expiry-days) (setq regexp nil)) (setcdr kill-list date)) (while (setq kill (car kill-list)) (if (consp kill) ;; It's a temporary kill. (progn (setq kdate (cdr kill)) (if (zerop (gnus-execute field (car kill) command nil (not all))) (if (> (gnus-days-between date kdate) gnus-kill-expiry-days) ;; Time limit has been exceeded, so we ;; remove the match. (if prev (setcdr prev (cdr kill-list)) (setq regexp (cdr regexp)))) ;; Successful kill. Set the date to today. (setcdr kill date))) ;; It's a permanent kill. (gnus-execute field kill command nil (not all))) (setq prev kill-list) (setq kill-list (cdr kill-list)))) (gnus-execute field kill-list command nil (not all)))))) (switch-to-buffer old-buffer) (if (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent)) (gnus-pp-gnus-kill (nconc (list 'gnus-kill field (if (consp regexp) (list 'quote regexp) regexp)) (if (or exe-command all) (list (list 'quote exe-command))) (if all (list t) nil)))))) (defun gnus-pp-gnus-kill (object) (if (or (not (consp (nth 2 object))) (not (consp (cdr (nth 2 object)))) (and (eq 'quote (car (nth 2 object))) (not (consp (cdr (car (cdr (nth 2 object)))))))) (concat "\n" (prin1-to-string object)) (save-excursion (set-buffer (get-buffer-create "*Gnus PP*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object))) (let ((klist (car (cdr (nth 2 object)))) (first t)) (while klist (insert (if first (progn (setq first nil) "") "\n ") (prin1-to-string (car klist))) (setq klist (cdr klist)))) (insert ")") (and (nth 3 object) (insert "\n " (if (and (consp (nth 3 object)) (not (eq 'quote (car (nth 3 object))))) "'" "") (prin1-to-string (nth 3 object)))) (and (nth 4 object) (insert "\n t")) (insert ")") (prog1 (buffer-substring (point-min) (point-max)) (kill-buffer (current-buffer)))))) (defun gnus-execute-1 (function regexp form header) (save-excursion (let (did-kill) (if (null header) nil ;Nothing to do. (if function ;; Compare with header field. (let (value) (and header (progn (setq value (funcall function header)) ;; Number (Lines:) or symbol must be converted to string. (or (stringp value) (setq value (prin1-to-string value))) (setq did-kill (string-match regexp value))) (if (stringp form) ;Keyboard macro. (execute-kbd-macro form) (funcall form)))) ;; Search article body. (let ((gnus-current-article nil) ;Save article pointer. (gnus-last-article nil) (gnus-break-pages nil) ;No need to break pages. (gnus-mark-article-hook nil)) ;Inhibit marking as read. (message "Searching for article: %d..." (mail-header-number header)) (gnus-article-setup-buffer) (gnus-article-prepare (mail-header-number header) t) (if (save-excursion (set-buffer gnus-article-buffer) (goto-char (point-min)) (setq did-kill (re-search-forward regexp nil t))) (if (stringp form) ;Keyboard macro. (execute-kbd-macro form) (eval form)))))) did-kill))) (defun gnus-execute (field regexp form &optional backward ignore-marked) "If FIELD of article header matches REGEXP, execute lisp FORM (or a string). If FIELD is an empty string (or nil), entire article body is searched for. If optional 1st argument BACKWARD is non-nil, do backward instead. If optional 2nd argument IGNORE-MARKED is non-nil, articles which are marked as read or ticked are ignored." (save-excursion (let ((killed-no 0) function article header) (if (or (null field) (string-equal field "")) (setq function nil) ;; Get access function of header filed. (setq function (intern-soft (concat "gnus-header-" (downcase field)))) (if (and function (fboundp function)) (setq function (symbol-function function)) (error "Unknown header field: \"%s\"" field)) ;; Make FORM funcallable. (if (and (listp form) (not (eq (car form) 'lambda))) (setq form (list 'lambda nil form)))) ;; Starting from the current article. (while (or (and (not article) (setq article (gnus-summary-article-number)) t) (setq article (gnus-summary-search-subject backward (not ignore-marked)))) (and (or (null gnus-newsgroup-kill-headers) (memq article gnus-newsgroup-kill-headers)) (vectorp (setq header (gnus-get-header-by-number article))) (gnus-execute-1 function regexp form header) (setq killed-no (1+ killed-no)))) killed-no))) emacs-19.30/lisp/gnus-mh.el100444 23053 1 17644 6046561360 14331 0ustar larsidaemon;;; gnus-mh.el --- mh-e interface for Gnus ;; Copyright (C) 1994,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Send mail using mh-e. ;; The following mh-e interface is all cooperative works of ;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP ;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki ;; SHINGU). ;;; Code: (require 'mh-e) (require 'mh-comp) (require 'gnus) (require 'gnus-msg) (defun gnus-summary-save-article-folder (&optional arg) "Append the current article to an mh folder. If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") (let ((gnus-default-article-saver 'gnus-summary-save-in-folder)) (gnus-summary-save-article arg))) (defun gnus-summary-save-in-folder (&optional folder) "Save this article to MH folder (using `rcvstore' in MH library). Optional argument FOLDER specifies folder name." ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet. (mh-find-path) (let ((folder (or folder (mh-prompt-for-folder "Save article in" (funcall gnus-folder-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-folder) t))) (errbuf (get-buffer-create " *Gnus rcvstore*"))) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) (unwind-protect (call-process-region (point-min) (point-max) (expand-file-name "rcvstore" mh-lib) nil errbuf nil folder) (set-buffer errbuf) (if (zerop (buffer-size)) (message "Article saved in folder: %s" folder) (message "%s" (buffer-string))) (kill-buffer errbuf)))) (setq gnus-newsgroup-last-folder folder))) (defun gnus-mail-reply-using-mhe (&optional yank) "Compose reply mail using mh-e. Optional argument YANK means yank original article. The command \\[mh-yank-cur-msg] yank the original message into current buffer." (let (from cc subject date to reply-to to-userid orig-to references message-id (config (current-window-configuration)) buffer) (pop-to-buffer gnus-article-buffer) (setq buffer (current-buffer)) (save-excursion (save-restriction (or gnus-user-login-name ; we need this (setq gnus-user-login-name (or (getenv "USER") (getenv "LOGNAME")))) (gnus-article-show-all-headers);; so colors are happy ;; lots of junk to avoid mh-send deleting other windows (setq from (or (gnus-fetch-field "from") "") subject (let ((subject (or (gnus-fetch-field "subject") "(None)"))) (if (and subject (not (string-match "^[Rr][Ee]:.+$" subject))) (concat "Re: " subject) subject)) reply-to (gnus-fetch-field "reply-to") cc (gnus-fetch-field "cc") orig-to (or (gnus-fetch-field "to") "") date (gnus-fetch-field "date") references (gnus-fetch-field "references") message-id (gnus-fetch-field "message-id")) (setq to (or reply-to from)) (setq to-userid (mail-strip-quoted-names orig-to)) (if (or (string-match "," orig-to) (not (string-match (substring to-userid 0 (string-match "@" to-userid)) gnus-user-login-name))) (setq cc (concat (if cc (concat cc ", ") "") orig-to))) ;; mh-yank-cur-msg needs to have mh-show-buffer set in the ;; *Article* buffer (setq mh-show-buffer buffer))) (mh-find-path) (mh-send-sub (or to "") (or cc "") (or subject "(None)") config);; Erik Selberg 1/23/94 (let ((draft (current-buffer)) (gnus-mail-buffer (current-buffer)) mail-buf) (if (not yank) (gnus-configure-windows 'reply 'force) (gnus-configure-windows 'reply-yank 'force)) (setq mail-buf gnus-mail-buffer) (pop-to-buffer mail-buf);; always in the display, so won't have window probs (switch-to-buffer draft)) ;; (mh-send to (or cc "") subject);; shouldn't use according to mhe ;; note - current buffer is now draft! (save-excursion (mh-insert-fields "In-reply-to:" (concat (substring from 0 (string-match " *at \\| *@ \\| *(\\| *<" from)) "'s message of " date)) (nnheader-insert-references references message-id)) ;; need this for mh-yank-cur-msg (setq mh-sent-from-folder buffer) (setq mh-sent-from-msg 1) (setq mh-show-buffer buffer) (setq mh-previous-window-config config)) ;; Then, yank original article if requested. (if yank (let ((last (point))) (mh-yank-cur-msg) (goto-char last))) (run-hooks 'gnus-mail-hook)) ;; gnus-mail-forward-using-mhe is contributed by Jun-ichiro Itoh ;; (defun gnus-mail-forward-using-mhe (&optional buffer) "Forward the current message to another user using mh-e." ;; First of all, prepare mhe mail buffer. (let* ((to (read-string "To: ")) (cc (read-string "Cc: ")) (buffer (or buffer gnus-article-buffer)) (config (current-window-configuration));; need to add this - erik (subject (gnus-forward-make-subject buffer))) (setq mh-show-buffer buffer) (mh-find-path) (mh-send-sub to (or cc "") (or subject "(None)") config);; Erik Selberg 1/23/94 (let ((draft (current-buffer)) (gnus-mail-buffer (current-buffer)) mail-buf) (gnus-configure-windows 'reply-yank 'force) (setq mail-buf (eval (cdr (assq 'mail gnus-window-to-buffer)))) (pop-to-buffer mail-buf);; always in the display, so won't have window probs (switch-to-buffer draft) ) (save-excursion (goto-char (point-max)) (insert "\n------- Forwarded Message\n\n") (insert-buffer buffer) (goto-char (point-max)) (insert "\n------- End of Forwarded Message\n") (setq mh-sent-from-folder buffer) (setq mh-sent-from-msg 1) (setq mh-previous-window-config config) (run-hooks 'gnus-mail-hook) ))) (defun gnus-mail-other-window-using-mhe () "Compose mail other window using mh-e." (let ((to (read-string "To: ")) (cc (read-string "Cc: ")) (subject (read-string "Subject: "))) (gnus-article-show-all-headers) ;I don't think this is really needed. (setq mh-show-buffer (current-buffer)) (mh-find-path) (mh-send-other-window to cc subject) (setq mh-sent-from-folder (current-buffer)) (setq mh-sent-from-msg 1) (run-hooks 'gnus-mail-hook))) (defun gnus-Folder-save-name (newsgroup headers &optional last-folder) "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. If variable `gnus-use-long-file-name' is nil, it is +News.group. Otherwise, it is like +news/group." (or last-folder (concat "+" (if gnus-use-long-file-name (gnus-capitalize-newsgroup newsgroup) (gnus-newsgroup-directory-form newsgroup))))) (defun gnus-folder-save-name (newsgroup headers &optional last-folder) "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. If variable `gnus-use-long-file-name' is nil, it is +news.group. Otherwise, it is like +news/group." (or last-folder (concat "+" (if gnus-use-long-file-name newsgroup (gnus-newsgroup-directory-form newsgroup))))) ;;; gnus-mh.el ends here emacs-19.30/lisp/gnus-msg.el100444 23053 1 176020 6046561376 14534 0ustar larsidaemon;;; gnus-msg.el --- mail and post interface for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Code: (require 'gnus) (require 'sendmail) (require 'gnus-ems) (defvar gnus-organization-file "/usr/lib/news/organization" "*Local news organization file.") (defvar gnus-prepare-article-hook (list 'gnus-inews-insert-signature) "*A hook called after preparing body, but before preparing header headers. The default hook (`gnus-inews-insert-signature') inserts a signature file specified by the variable `gnus-signature-file'.") (defvar gnus-post-prepare-function nil "*Function that is run after a post buffer has been prepared. It is called with the name of the newsgroup that is posted to. It might be used, for instance, for inserting signatures based on the newsgroup name. (In that case, `gnus-signature-file' and `mail-signature' should both be set to nil).") (defvar gnus-post-prepare-hook nil "*Hook that is run after a post buffer has been prepared. If you want to insert the signature, you might put `gnus-inews-insert-signature' in this hook.") (defvar gnus-use-followup-to t "*Specifies what to do with Followup-To header. If nil, ignore the header. If it is t, use its value, but ignore `poster'. If it is the symbol `ask', query the user before posting. If it is the symbol `use', always use the value.") (defvar gnus-followup-to-function nil "*A variable that contains a function that returns a followup address. The function will be called in the buffer of the article that is being followed up. The buffer will be narrowed to the headers of the article. To pick header headers, one might use `mail-fetch-field'. The function will be called with the name of the current newsgroup as the argument. Here's an example `gnus-followup-to-function': (setq gnus-followup-to-function (lambda (group) (cond ((string= group \"mail.list\") (or (mail-fetch-field \"sender\") (mail-fetch-field \"from\"))) (t (or (mail-fetch-field \"reply-to\") (mail-fetch-field \"from\"))))))") (defvar gnus-reply-to-function nil "*A variable that contains a function that returns a reply address. See the `gnus-followup-to-function' variable for an explanation of how this variable is used. This function should return a string that will be used to fill in the header. This function may also return a list. In that case, every list element should be a cons where the first car should be a string with the header name, and the cdr should be a string with the header value.") (defvar gnus-author-copy (getenv "AUTHORCOPY") "*Save outgoing articles in this file. Initialized from the AUTHORCOPY environment variable. If this variable begins with the character \"|\", outgoing articles will be piped to the named program. It is possible to save an article in an MH folder as follows: \(setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\") If the first character is not a pipe, articles are saved using the function specified by the `gnus-author-copy-saver' variable.") (defvar gnus-mail-self-blind nil "*Non-nil means insert a BCC header in all outgoing articles. This will result in having a copy of the article mailed to yourself. The BCC header is inserted when the post buffer is initialized, so you can remove or alter the BCC header to override the default.") (defvar gnus-author-copy-saver (function rmail-output) "*A function called to save outgoing articles. This function will be called with the same of the file to store the article in. The default function is `rmail-output' which saves in Unix mailbox format.") (defvar gnus-user-login-name nil "*The login name of the user. Got from the function `user-login-name' if undefined.") (defvar gnus-user-full-name nil "*The full name of the user. Got from the NAME environment variable if undefined.") (defvar gnus-user-from-line nil "*Your full, complete e-mail address. Overrides the other Gnus variables if it is non-nil. Here are two example values of this variable: \"Lars Magne Ingebrigtsen \" and \"larsi@ifi.uio.no (Lars Magne Ingebrigtsen)\" The first version is recommended, but the name has to be quoted if it contains non-alphanumerical characters.") (defvar gnus-signature-file "~/.signature" "*Your signature file. If the variable is a string that doesn't correspond to a file, the string itself is inserted.") (defvar gnus-signature-function nil "*A function that should return a signature file name. The function will be called with the name of the newsgroup being posted to. If the function returns a string that doesn't correspond to a file, the string itself is inserted. If the function returns nil, the `gnus-signature-file' variable will be used instead.") (defvar gnus-required-headers '(From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader) "*Headers to be generated or prompted for when posting an article. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID. Organization, Lines and X-Newsreader are optional. If you want Gnus not to insert some header, remove it from this list.") (defvar gnus-deletable-headers '(Message-ID Date) "*Headers to be deleted if they already exists and were generated by Gnus previously.") (defvar gnus-removable-headers '(NNTP-Posting-Host Bcc Xref) "*Headers to be removed unconditionally before posting.") (defvar gnus-check-before-posting '(subject-cmsg multiple-headers sendsys message-id from long-lines control-chars size new-text signature) "In non-nil, Gnus will attempt to run some checks on outgoing posts. If this variable is t, Gnus will check everything it can. If it is a list, then those elements in that list will be checked.") (defvar gnus-delete-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Supersedes:" "*Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before posting to avoid any confusion.") (defvar gnus-auto-mail-to-author nil "*If non-nil, mail the authors of articles a copy of your follow-ups. If this variable is `ask', the user will be prompted for whether to mail a copy. The string given by `gnus-mail-courtesy-message' will be inserted at the beginning of the mail copy. Mail is sent using the function specified by the `gnus-mail-send-method' variable.") ;; Added by Ethan Bradford . (defvar gnus-mail-courtesy-message "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n" "*This is inserted at the start of a mailed copy of a posted message. If this variable is nil, no such courtesy message will be added.") (defvar gnus-mail-reply-method (function gnus-mail-reply-using-mail) "*Function to compose a reply. Three pre-made functions are `gnus-mail-reply-using-mail' (sendmail); `gnus-mail-reply-using-mhe' (MH-E); and `gnus-mail-reply-using-vm'.") (defvar gnus-mail-forward-method (function gnus-mail-forward-using-mail) "*Function to forward the current message to another user. Three pre-made functions are `gnus-mail-forward-using-mail' (sendmail); `gnus-mail-forward-using-mhe' (MH-E); and `gnus-mail-forward-using-vm'.") (defvar gnus-mail-other-window-method 'gnus-mail-other-window-using-mail "*Function to compose mail in the other window. Three pre-made functions are `gnus-mail-other-window-using-mail' (sendmail); `gnus-mail-other-window-using-mhe' (MH-E); and `gnus-mail-other-window-using-vm'.") (defvar gnus-mail-send-method send-mail-function "*Function to mail a message which is also being posted as an article. The message must have To or Cc header. The default is copied from the variable `send-mail-function'.") (defvar gnus-inews-article-function 'gnus-inews-article "*Function to post an article.") (defvar gnus-inews-article-hook (list 'gnus-inews-do-fcc) "*A hook called before finally posting an article. The default hook (`gnus-inews-do-fcc') does FCC processing (ie. saves the article to a file).") (defvar gnus-inews-article-header-hook nil "*A hook called after inserting the headers in an article to be posted. The hook is called from the *post-news* buffer, narrowed to the headers.") (defvar gnus-mail-hook nil "*A hook called as the last thing after setting up a mail buffer.") ;;; Internal variables. (defvar gnus-post-news-buffer "*post-news*") (defvar gnus-mail-buffer "*mail*") (defvar gnus-summary-send-map nil) (defvar gnus-article-copy nil) (defvar gnus-reply-subject nil) (eval-and-compile (autoload 'gnus-uu-post-news "gnus-uu" nil t) (autoload 'rmail-output "rmailout")) ;;; ;;; Gnus Posting Functions ;;; (define-prefix-command 'gnus-summary-send-map) (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map) (define-key gnus-summary-send-map "p" 'gnus-summary-post-news) (define-key gnus-summary-send-map "f" 'gnus-summary-followup) (define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original) (define-key gnus-summary-send-map "b" 'gnus-summary-followup-and-reply) (define-key gnus-summary-send-map "B" 'gnus-summary-followup-and-reply-with-original) (define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article) (define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article) (define-key gnus-summary-send-map "r" 'gnus-summary-reply) (define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original) (define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window) (define-key gnus-summary-send-map "u" 'gnus-uu-post-news) (define-key gnus-summary-send-map "om" 'gnus-summary-mail-forward) (define-key gnus-summary-send-map "op" 'gnus-summary-post-forward) (define-key gnus-summary-send-map "Om" 'gnus-uu-digest-mail-forward) (define-key gnus-summary-send-map "Op" 'gnus-uu-digest-post-forward) ;;; Internal functions. (defun gnus-number-base36 (num len) (if (if (< len 0) (<= num 0) (= len 0)) "" (concat (gnus-number-base36 (/ num 36) (1- len)) (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" (% num 36)))))) ;;; Post news commands of Gnus group mode and summary mode (defun gnus-group-mail () "Start composing a mail." (interactive) (funcall gnus-mail-other-window-method)) (defun gnus-group-post-news () "Post an article." (interactive) (let ((gnus-newsgroup-name nil)) (gnus-post-news 'post nil nil gnus-article-buffer))) (defun gnus-summary-post-news () "Post an article." (interactive) (gnus-set-global-variables) (gnus-post-news 'post gnus-newsgroup-name)) (defun gnus-summary-followup (yank &optional yank-articles) "Compose a followup to an article. If prefix argument YANK is non-nil, original article is yanked automatically." (interactive "P") (gnus-set-global-variables) (if yank-articles (gnus-summary-goto-subject (car yank-articles))) (save-window-excursion (gnus-summary-select-article)) (let ((headers (gnus-get-header-by-number (gnus-summary-article-number))) (gnus-newsgroup-name gnus-newsgroup-name)) ;; Check Followup-To: poster. (set-buffer gnus-article-buffer) (if (and gnus-use-followup-to (string-equal "poster" (gnus-fetch-field "followup-to")) (or (not (memq gnus-use-followup-to '(t ask))) (not (gnus-y-or-n-p "Do you want to ignore `Followup-To: poster'? ")))) ;; Mail to the poster. (gnus-summary-reply yank) (gnus-post-news nil gnus-newsgroup-name headers gnus-article-buffer (or yank-articles (not (not yank))))))) (defun gnus-summary-followup-with-original (n) "Compose a followup to an article and include the original article." (interactive "P") (gnus-summary-followup t (gnus-summary-work-articles n))) ;; Suggested by Daniel Quinlan . (defun gnus-summary-followup-and-reply (yank &optional yank-articles) "Compose a followup and do an auto mail to author." (interactive "P") (gnus-set-global-variables) (let ((gnus-auto-mail-to-author t)) (gnus-summary-followup yank yank-articles))) (defun gnus-summary-followup-and-reply-with-original (n) "Compose a followup, include the original, and do an auto mail to author." (interactive "P") (gnus-summary-followup-and-reply t (gnus-summary-work-articles n))) (defun gnus-summary-cancel-article (n) "Cancel an article you posted." (interactive "P") (gnus-set-global-variables) (let ((articles (gnus-summary-work-articles n))) (while articles (gnus-summary-select-article t nil nil (car articles)) (and (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news)) (gnus-summary-mark-as-read (car articles) gnus-canceled-mark)) (gnus-summary-remove-process-mark (car articles)) (gnus-article-hide-headers-if-wanted) (setq articles (cdr articles))))) (defun gnus-summary-supersede-article () "Compose an article that will supersede a previous article. This is done simply by taking the old article and adding a Supersedes header line with the old Message-ID." (interactive) (gnus-set-global-variables) (gnus-summary-select-article t) (if (not (string-equal (downcase (mail-strip-quoted-names (mail-header-from gnus-current-headers))) (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) (error "This article is not yours.")) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (goto-char (point-min)) (search-forward "\n\n" nil t) (if (not (re-search-backward "^Message-ID: " nil t)) (error "No Message-ID in this article")))) (if (gnus-post-news 'post gnus-newsgroup-name) (progn (erase-buffer) (insert-buffer gnus-article-buffer) (if (search-forward "\n\n" nil t) (forward-char -1) (goto-char (point-max))) (narrow-to-region (point-min) (point)) (goto-char (point-min)) (and gnus-delete-supersedes-headers (delete-matching-lines gnus-delete-supersedes-headers)) (goto-char (point-min)) (if (not (re-search-forward "^Message-ID: " nil t)) (error "No Message-ID in this article") (replace-match "Supersedes: " t t)) (goto-char (point-max)) (insert mail-header-separator) (widen) (forward-line 1)))) ;;;###autoload (defalias 'sendnews 'gnus-post-news) ;;;###autoload (defalias 'postnews 'gnus-post-news) (defun gnus-copy-article-buffer (&optional article-buffer) ;; make a copy of the article buffer with all text properties removed ;; this copy is in the buffer gnus-article-copy. ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used ;; this buffer should be passed to all mail/news reply/post routines. (setq gnus-article-copy (get-buffer-create " *gnus article copy*")) (buffer-disable-undo gnus-article-copy) (or (memq gnus-article-copy gnus-buffer-list) (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list))) (let ((article-buffer (or article-buffer gnus-article-buffer))) (if (and (get-buffer article-buffer) (buffer-name (get-buffer article-buffer))) (save-excursion (set-buffer article-buffer) (widen) (copy-to-buffer gnus-article-copy (point-min) (point-max)) (set-text-properties (point-min) (point-max) nil gnus-article-copy))))) (defun gnus-post-news (post &optional group header article-buffer yank subject) "Begin editing a new USENET news article to be posted. Type \\[describe-mode] in the buffer to get a list of commands." (interactive (list t)) (gnus-copy-article-buffer article-buffer) (if (or (not gnus-novice-user) gnus-expert-user (not (eq 'post (nth 1 (assoc (format "%s" (car (gnus-find-method-for-group gnus-newsgroup-name))) gnus-valid-select-methods)))) (and group (assq 'to-address (nth 5 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))) (gnus-y-or-n-p "Are you sure you want to post to all of USENET? ")) (let ((sumart (if (not post) (save-excursion (set-buffer gnus-summary-buffer) (cons (current-buffer) gnus-current-article)))) (from (and header (mail-header-from header))) (winconf (current-window-configuration)) real-group) (and gnus-interactive-post (not gnus-expert-user) post (not group) (progn (setq gnus-newsgroup-name (setq group (completing-read "Group: " gnus-active-hashtb))) (or subject (setq subject (read-string "Subject: "))))) (setq mail-reply-buffer gnus-article-copy) (let ((newsgroup-name (or group gnus-newsgroup-name ""))) (setq real-group (and group (gnus-group-real-name group))) (setq gnus-post-news-buffer (gnus-request-post-buffer post real-group subject header gnus-article-copy (nth 2 (and group (gnus-gethash group gnus-newsrc-hashtb))) (or (cdr (assq 'to-group (nth 5 (nth 2 (gnus-gethash newsgroup-name gnus-newsrc-hashtb))))) (if (and (boundp 'gnus-followup-to-function) gnus-followup-to-function gnus-article-copy) (save-excursion (set-buffer gnus-article-copy) (funcall gnus-followup-to-function group)))) gnus-use-followup-to)) (if post (gnus-configure-windows 'post 'force) (if yank (gnus-configure-windows 'followup-yank 'force) (gnus-configure-windows 'followup 'force))) (gnus-overload-functions) (make-local-variable 'gnus-article-reply) (make-local-variable 'gnus-article-check-size) (make-local-variable 'gnus-reply-subject) (setq gnus-reply-subject (and header (mail-header-subject header))) (setq gnus-article-reply sumart) ;; Handle `gnus-auto-mail-to-author'. ;; Suggested by Daniel Quinlan . ;; Revised to respect Reply-To by Ulrik Dickow . (let ((to (and (not post) (if (if (eq gnus-auto-mail-to-author 'ask) (y-or-n-p "Also send mail to author? ") gnus-auto-mail-to-author) (or (save-excursion (set-buffer gnus-article-copy) (gnus-fetch-field "reply-to")) from))))) (if to (if (mail-fetch-field "To") (progn (beginning-of-line) (insert "Cc: " to "\n")) (mail-position-on-field "To") (insert to)))) ;; Handle author copy using BCC field. (if (and gnus-mail-self-blind (not (mail-fetch-field "bcc"))) (progn (mail-position-on-field "Bcc") (insert (if (stringp gnus-mail-self-blind) gnus-mail-self-blind (user-login-name))))) ;; Handle author copy using FCC field. (if gnus-author-copy (progn (mail-position-on-field "Fcc") (insert gnus-author-copy))) (goto-char (point-min)) (if post (cond ((not group) (re-search-forward "^Newsgroup:" nil t) (end-of-line)) ((not subject) (re-search-forward "^Subject:" nil t) (end-of-line)) (t (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1))) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) (if (not yank) () (save-excursion (if (not (listp yank)) (news-reply-yank-original nil) (setq yank (reverse yank)) (while yank (save-excursion (save-window-excursion (set-buffer gnus-summary-buffer) (gnus-summary-select-article nil nil nil (car yank)) (gnus-summary-remove-process-mark (car yank))) (let ((mail-reply-buffer gnus-article-copy)) (gnus-copy-article-buffer) (let ((news-reply-yank-message-id (save-excursion (set-buffer gnus-article-copy) (mail-fetch-field "message-id"))) (news-reply-yank-from (save-excursion (set-buffer gnus-article-copy) (mail-fetch-field "from")))) (news-reply-yank-original nil)) (setq yank (cdr yank))))))))) (if gnus-post-prepare-function (funcall gnus-post-prepare-function group)) (run-hooks 'gnus-post-prepare-hook) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)))) (setq gnus-article-check-size (cons (buffer-size) (gnus-article-checksum))) (message "") t) (defun gnus-inews-news (&optional use-group-method) "Send a news message. If given a prefix, and the group is a foreign group, this function will attempt to use the foreign server to post the article." (interactive "P") (or gnus-current-select-method (setq gnus-current-select-method gnus-select-method)) (let* ((case-fold-search nil) (server-running (gnus-server-opened gnus-current-select-method)) (reply gnus-article-reply) error post-result) (save-excursion ;; Connect to default NNTP server if necessary. ;; Suggested by yuki@flab.fujitsu.junet. (gnus-start-news-server) ;Use default server. ;; NNTP server must be opened before current buffer is modified. (widen) (goto-char (point-min)) (run-hooks 'news-inews-hook) (save-restriction (narrow-to-region (point-min) (progn (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (match-beginning 0))) ;; Correct newsgroups field: change sequence of spaces to comma and ;; eliminate spaces around commas. Eliminate imbedded line breaks. (goto-char (point-min)) (if (re-search-forward "^Newsgroups: +" nil t) (save-restriction (narrow-to-region (point) (if (re-search-forward "^[^ \t]" nil t) (match-beginning 0) (forward-line 1) (point))) (goto-char (point-min)) (while (re-search-forward "\n[ \t]+" nil t) (replace-match " " t t)) ;No line breaks (too confusing) (goto-char (point-min)) (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) (replace-match "," t t)) (goto-char (point-min)) ;; Remove a trailing comma. (if (re-search-forward ",$" nil t) (replace-match "" t t)))) ;; Added by Per Abrahamsen . ;; Help save the the world! (or gnus-expert-user (let ((newsgroups (mail-fetch-field "newsgroups")) (followup-to (mail-fetch-field "followup-to")) groups to) (if (and newsgroups (string-match "," newsgroups) (not followup-to)) (progn (while (string-match "," newsgroups) (setq groups (cons (list (substring newsgroups 0 (match-beginning 0))) groups)) (setq newsgroups (substring newsgroups (match-end 0)))) (setq groups (nreverse (cons (list newsgroups) groups))) (setq to (completing-read "Followups to: (default all groups) " groups)) (if (> (length to) 0) (progn (goto-char (point-min)) (insert "Followup-To: " to "\n"))))))) ;; Cleanup Followup-To. (goto-char (point-min)) (if (search-forward-regexp "^Followup-To: +" nil t) (save-restriction (narrow-to-region (point) (if (re-search-forward "^[^ \t]" nil 'end) (match-beginning 0) (point-max))) (goto-char (point-min)) (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing) (goto-char (point-min)) (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ","))) ;; Mail the message too if To:, Bcc:. or Cc: exists. (let* ((types '("to" "bcc" "cc")) (ty types) fcc-line) (while ty (or (mail-fetch-field (car ty) nil t) (setq types (delete (car ty) types))) (setq ty (cdr ty))) (if (not types) ;; We do not want to send mail. () (if (not gnus-mail-send-method) (progn (ding) (gnus-message 1 "No mailer defined. To: and/or Cc: fields ignored.") (sit-for 1)) (save-excursion ;; We want to remove Fcc, because we want to handle ;; that one ourselves... (goto-char (point-min)) (if (re-search-forward "^Fcc: " nil t) (progn (setq fcc-line (buffer-substring (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) (forward-line -1) (gnus-delete-line))) ;; We generate a Message-ID so that the mail and the ;; news copy of the message both get the same ID. (or (mail-fetch-field "message-id") (not (memq 'Message-ID gnus-required-headers)) (progn (goto-char (point-max)) (insert "Message-ID: " (gnus-inews-message-id) "\n"))) (save-restriction (widen) (gnus-message 5 "Sending via mail...") (if (and gnus-mail-courtesy-message (or (member "to" types) (member "cc" types))) ;; We only want to insert the courtesy mail ;; message if we use to or cc; bcc should not ;; have one. Well, if both bcc and to are ;; present, it will get one anyway. (progn ;; Insert "courtesy" mail message. (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) (insert gnus-mail-courtesy-message) (funcall gnus-mail-send-method) (goto-char (point-min)) (search-forward gnus-mail-courtesy-message) (replace-match "" t t)) (funcall gnus-mail-send-method)) (gnus-message 5 "Sending via mail...done") (goto-char (point-min)) (narrow-to-region (point) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))) (goto-char (point-min)) (while (re-search-forward "^BCC:" nil t) (delete-region (match-beginning 0) ;; There might be continuation headers. (if (re-search-forward "^[^ \t]" nil t) (match-beginning 0) ;; Uhm... or something like this. (forward-line 1) (point))))) (if fcc-line (progn (goto-char (point-max)) (insert fcc-line)))))))) ;; Send to server. (gnus-message 5 "Posting to USENET...") (setq post-result (funcall gnus-inews-article-function use-group-method)) (cond ((eq post-result 'illegal) (setq error t) (ding)) (post-result (gnus-message 5 "Posting to USENET...done") (if (gnus-buffer-exists-p (car-safe reply)) (progn (save-excursion (set-buffer gnus-summary-buffer) (gnus-summary-mark-article-as-replied (cdr reply))))) (set-buffer-modified-p nil)) (t ;; We cannot signal an error. (setq error t) (ding) (gnus-message 1 "Article rejected: %s" (gnus-status-message gnus-select-method))))) ;; If NNTP server is opened by gnus-inews-news, close it by myself. (or server-running (gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name))) (let ((conf gnus-prev-winconf)) (if (not error) (progn (bury-buffer) ;; Restore last window configuration. (and conf (set-window-configuration conf))))))) (defun gnus-inews-check-post () "Check whether the post looks ok." (or (not gnus-check-before-posting) (and ;; We narrow to the headers and check them first. (save-excursion (save-restriction (goto-char (point-min)) (narrow-to-region (point) (progn (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (match-beginning 0))) (goto-char (point-min)) (and ;; Check for commands in Subject. (or (gnus-check-before-posting 'subject-cmsg) (save-excursion (if (string-match "^cmsg " (mail-fetch-field "subject")) (gnus-y-or-n-p "The control code \"cmsg \" is in the subject. Really post? ") t))) ;; Check for multiple identical headers. (or (gnus-check-before-posting 'multiple-headers) (save-excursion (let (found) (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t)) (save-excursion (or (re-search-forward (concat "^" (setq found (buffer-substring (match-beginning 0) (- (match-end 0) 2)))) nil t) (setq found nil)))) (if found (gnus-y-or-n-p (format "Multiple %s headers. Really post? " found)) t)))) ;; Check for version and sendsys. (or (gnus-check-before-posting 'sendsys) (save-excursion (if (re-search-forward "^Sendsys:\\|^Version:" nil t) (gnus-y-or-n-p (format "The article contains a %s command. Really post? " (buffer-substring (match-beginning 0) (1- (match-end 0))))) t))) ;; Check the Message-Id header. (or (gnus-check-before-posting 'message-id) (save-excursion (let* ((case-fold-search t) (message-id (mail-fetch-field "message-id"))) (or (not message-id) (and (string-match "@" message-id) (string-match "@[^\\.]*\\." message-id)) (gnus-y-or-n-p (format "The Message-ID looks strange: \"%s\". Really post? " message-id)))))) ;; Check the From header. (or (gnus-check-before-posting 'from) (save-excursion (let* ((case-fold-search t) (from (mail-fetch-field "from"))) (cond ((not from) (gnus-y-or-n-p "There is no From line. Really post? ")) ((not (string-match "@[^\\.]*\\." from)) (gnus-y-or-n-p (format "The address looks strange: \"%s\". Really post? " from))) ((string-match "(.*).*(.*)" from) (gnus-y-or-n-p (format "The From header looks strange: \"%s\". Really post? " from))) (t t))))) ))) ;; Check for long lines. (or (gnus-check-before-posting 'long-lines) (save-excursion (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (while (and (progn (end-of-line) (< (current-column) 80)) (zerop (forward-line 1)))) (or (bolp) (eobp) (gnus-y-or-n-p (format "You have lines longer than 79 characters. Really post? "))))) ;; Check for control characters. (or (gnus-check-before-posting 'control-chars) (save-excursion (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) (gnus-y-or-n-p "The article contains control characters. Really post? ") t))) ;; Check excessive size. (or (gnus-check-before-posting 'size) (if (> (buffer-size) 60000) (gnus-y-or-n-p (format "The article is %d octets long. Really post? " (buffer-size))) t)) ;; Use the (size . checksum) variable to see whether the ;; article is empty or has only quoted text. (or (gnus-check-before-posting 'new-text) (if (and (= (buffer-size) (car gnus-article-check-size)) (= (gnus-article-checksum) (cdr gnus-article-check-size))) (gnus-y-or-n-p "It looks like there's no new text in your article. Really post? ") t)) ;; Check the length of the signature. (or (gnus-check-before-posting 'signature) (progn (goto-char (point-max)) (if (not (re-search-backward gnus-signature-separator nil t)) t (if (> (count-lines (point) (point-max)) 5) (gnus-y-or-n-p (format "Your .sig is %d lines; it should be max 4. Really post? " (count-lines (point) (point-max)))) t))))))) (defun gnus-article-checksum () (let ((sum 0)) (save-excursion (while (not (eobp)) (setq sum (logxor sum (following-char))) (forward-char 1))) sum)) ;; Returns non-nil if this type is not to be checked. (defun gnus-check-before-posting (type) (not (or (not gnus-check-before-posting) (if (listp gnus-check-before-posting) (memq type gnus-check-before-posting) t)))) (defun gnus-cancel-news () "Cancel an article you posted." (interactive) (if (or gnus-expert-user (gnus-yes-or-no-p "Do you really want to cancel this article? ")) (let ((from nil) (newsgroups nil) (message-id nil) (distribution nil)) (or (gnus-member-of-valid 'post gnus-newsgroup-name) (error "This backend does not support canceling")) (save-excursion ;; Get header info. from original article. (save-restriction (gnus-article-show-all-headers) (goto-char (point-min)) (search-forward "\n\n" nil 'move) (narrow-to-region (point-min) (point)) (setq from (mail-fetch-field "from")) (setq newsgroups (mail-fetch-field "newsgroups")) (setq message-id (mail-fetch-field "message-id")) (setq distribution (mail-fetch-field "distribution"))) ;; Verify if the article is absolutely user's by comparing ;; user id with value of its From: field. (if (not (string-equal (downcase (mail-strip-quoted-names from)) (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) (progn (ding) (gnus-message 3 "This article is not yours.") nil) ;; Make control article. (set-buffer (get-buffer-create " *Gnus-canceling*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert "Newsgroups: " newsgroups "\n" "Subject: cancel " message-id "\n" "Control: cancel " message-id "\n" (if distribution (concat "Distribution: " distribution "\n") "") mail-header-separator "\n" "This is a cancel message from " from ".\n") ;; Send the control article to NNTP server. (gnus-message 5 "Canceling your article...") (prog1 (if (funcall gnus-inews-article-function) (gnus-message 5 "Canceling your article...done") (progn (ding) (gnus-message 1 "Cancel failed; %s" (gnus-status-message gnus-newsgroup-name)) nil) t) ;; Kill the article buffer. (kill-buffer (current-buffer)))))))) ;;; Lowlevel inews interface (defun gnus-inews-article (&optional use-group-method) "Post an article in current buffer using NNTP protocol." (let ((artbuf (current-buffer)) (tmpbuf (get-buffer-create " *Gnus-posting*"))) (widen) (goto-char (point-max)) ;; require a newline at the end for inews to append .signature to (or (= (preceding-char) ?\n) (insert ?\n)) ;; Prepare article headers. All message body such as signature ;; must be inserted before Lines: field is prepared. (save-restriction (goto-char (point-min)) (narrow-to-region (point-min) (save-excursion (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (match-beginning 0))) (gnus-inews-remove-headers) (gnus-inews-insert-headers) (run-hooks 'gnus-inews-article-header-hook) (widen)) ;; Check whether the article is a good Net Citizen. (if (and gnus-article-check-size (not (gnus-inews-check-post))) ;; Aber nein! 'illegal ;; Looks ok, so we do the nasty. (save-excursion (set-buffer tmpbuf) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert-buffer-substring artbuf) ;; Remove the header separator. (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (replace-match "" t t) ;; This hook may insert a signature. (save-excursion (goto-char (point-min)) (let ((gnus-newsgroup-name (or (mail-fetch-field "newsgroups") gnus-newsgroup-name))) (run-hooks 'gnus-prepare-article-hook))) ;; Run final inews hooks. This hook may do FCC. ;; The article must be saved before being posted because ;; `gnus-request-post' modifies the buffer. (run-hooks 'gnus-inews-article-hook) ;; Post an article to NNTP server. ;; Return NIL if post failed. (prog1 (gnus-request-post (if use-group-method (gnus-find-method-for-group gnus-newsgroup-name) gnus-select-method) use-group-method) (kill-buffer (current-buffer))))))) (defun gnus-inews-remove-headers () (let ((case-fold-search t) (headers gnus-removable-headers)) ;; Remove toxic headers. (while headers (goto-char (point-min)) (and (re-search-forward (concat "^" (downcase (format "%s" (car headers)))) nil t) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) (setq headers (cdr headers))))) (defun gnus-inews-insert-headers () "Prepare article headers. Headers already prepared in the buffer are not modified. Headers in `gnus-required-headers' will be generated." (let ((Date (gnus-inews-date)) (Message-ID (gnus-inews-message-id)) (Organization (gnus-inews-organization)) (From (gnus-inews-user-name)) (Path (gnus-inews-path)) (Subject nil) (Newsgroups nil) (Distribution nil) (Lines (gnus-inews-lines)) (X-Newsreader gnus-version) (headers gnus-required-headers) (case-fold-search t) header value elem) ;; First we remove any old generated headers. (let ((headers gnus-deletable-headers)) (while headers (goto-char (point-min)) (and (re-search-forward (concat "^" (symbol-name (car headers)) ": *") nil t) (get-text-property (1+ (match-beginning 0)) 'gnus-deletable) (gnus-delete-line)) (setq headers (cdr headers)))) ;; If there are References, and no "Re: ", then the thread has ;; changed name. See Son-of-1036. (if (and (mail-fetch-field "references") (get-buffer gnus-article-buffer)) (let ((psubject (gnus-simplify-subject-re (mail-fetch-field "subject")))) (or (and psubject gnus-reply-subject (string= (gnus-simplify-subject-re gnus-reply-subject) psubject)) (progn (string-match "@" Message-ID) (setq Message-ID (concat (substring Message-ID 0 (match-beginning 0)) "_-_" (substring Message-ID (match-beginning 0)))))))) ;; Go through all the required headers and see if they are in the ;; articles already. If they are not, or are empty, they are ;; inserted automatically - except for Subject, Newsgroups and ;; Distribution. (while headers (goto-char (point-min)) (setq elem (car headers)) (if (consp elem) (setq header (car elem)) (setq header elem)) (if (or (not (re-search-forward (concat "^" (downcase (symbol-name header)) ":") nil t)) (progn ;; The header was found. We insert a space after the ;; colon, if there is none. (if (/= (following-char) ? ) (insert " ")) ;; Find out whether the header is empty... (looking-at "[ \t]*$"))) ;; So we find out what value we should insert. (progn (setq value (or (if (consp elem) ;; The element is a cons. Either the cdr is ;; a string to be inserted verbatim, or it ;; is a function, and we insert the value ;; returned from this function. (or (and (stringp (cdr elem)) (cdr elem)) (and (fboundp (cdr elem)) (funcall (cdr elem)))) ;; The element is a symbol. We insert the ;; value of this symbol, if any. (and (boundp header) (symbol-value header))) ;; We couldn't generate a value for this header, ;; so we just ask the user. (read-from-minibuffer (format "Empty header for %s; enter value: " header)))) ;; Finally insert the header. (save-excursion (if (bolp) (progn (goto-char (point-max)) (insert (symbol-name header) ": " value "\n") (forward-line -1)) (replace-match value t t)) ;; Add the deletable property to the headers that require it. (and (memq header gnus-deletable-headers) (progn (beginning-of-line) (looking-at "[^:]+: ")) (add-text-properties (point) (match-end 0) '(gnus-deletable t face italic) (current-buffer)))))) (setq headers (cdr headers))) ;; Insert new Sender if the From is strange. (let ((from (mail-fetch-field "from")) (sender (mail-fetch-field "sender"))) (if (and from (not (string= (downcase (car (gnus-extract-address-components from))) (downcase (gnus-inews-real-user-address)))) (or (null sender) (not (string= (downcase (car (gnus-extract-address-components sender))) (downcase (gnus-inews-real-user-address)))))) (progn (goto-char (point-min)) (and (re-search-forward "^Sender:" nil t) (progn (beginning-of-line) (insert "Original-") (beginning-of-line))) (insert "Sender: " (gnus-inews-real-user-address) "\n")))))) (defun gnus-inews-insert-signature () "Insert a signature file. If `gnus-signature-function' is bound and returns a string, this string is used instead of the variable `gnus-signature-file'. In either case, if the string is a file name, this file is inserted. If the string is not a file name, the string itself is inserted. If you never want any signature inserted, set both of these variables to nil." (save-excursion (let ((signature (or (and gnus-signature-function (funcall gnus-signature-function gnus-newsgroup-name)) gnus-signature-file))) (if (and signature (or (file-exists-p signature) (string-match " " signature) (not (string-match "^/[^/]+/" (expand-file-name signature))))) (progn (goto-char (point-max)) (if (and mail-signature (search-backward "\n-- \n" nil t)) () ;; Delete any previous signatures. (if (search-backward "\n-- \n" nil t) (delete-region (point) (point-max))) (or (eolp) (insert "\n")) (insert "-- \n") (if (file-exists-p signature) (insert-file-contents signature) (insert signature)) (goto-char (point-max)) (or (bolp) (insert "\n")))))))) ;; Written by "Mr. Per Persson" . (defun gnus-inews-insert-mime-headers () (let ((mail-header-separator "")) (or (mail-position-on-field "Mime-Version") (insert "1.0") (cond ((save-excursion (beginning-of-buffer) (re-search-forward "[\200-\377]" nil t)) (or (mail-position-on-field "Content-Type") (insert "text/plain; charset=ISO-8859-1")) (or (mail-position-on-field "Content-Transfer-Encoding") (insert "8bit"))) (t (or (mail-position-on-field "Content-Type") (insert "text/plain; charset=US-ASCII")) (or (mail-position-on-field "Content-Transfer-Encoding") (insert "7bit"))))))) (defun gnus-inews-do-fcc () "Process FCC: fields in current article buffer. Unless the first character of the field is `|', the article is saved to the specified file using the function specified by the variable gnus-author-copy-saver. The default function rmail-output saves in Unix mailbox format. If the first character is `|', the contents of the article is send to a program specified by the rest of the value." (let ((fcc-list nil) (fcc-file nil) (case-fold-search t)) ;Should ignore case. (save-excursion (save-restriction (goto-char (point-min)) (search-forward "\n\n") (narrow-to-region (point-min) (point)) (goto-char (point-min)) (while (re-search-forward "^FCC:[ \t]*" nil t) (setq fcc-list (cons (buffer-substring (point) (progn (end-of-line) (skip-chars-backward " \t") (point))) fcc-list)) (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) ;; Process FCC operations. (widen) (while fcc-list (setq fcc-file (car fcc-list)) (setq fcc-list (cdr fcc-list)) (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file) (let ((program (substring fcc-file (match-beginning 1) (match-end 1)))) ;; Suggested by yuki@flab.fujitsu.junet. ;; Send article to named program. (call-process-region (point-min) (point-max) shell-file-name nil nil nil "-c" program))) (t ;; Suggested by hyoko@flab.fujitsu.junet. ;; Save article in Unix mail format by default. (gnus-make-directory (file-name-directory fcc-file)) (if (and gnus-author-copy-saver (not (eq gnus-author-copy-saver 'rmail-output))) (funcall gnus-author-copy-saver fcc-file) (if (and (file-readable-p fcc-file) (mail-file-babyl-p fcc-file)) (gnus-output-to-rmail fcc-file) (rmail-output fcc-file 1 t t)))))))))) (defun gnus-inews-path () "Return uucp path." (let ((login-name (gnus-inews-login-name))) (cond ((null gnus-use-generic-path) (concat (nth 1 gnus-select-method) "!" login-name)) ((stringp gnus-use-generic-path) ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. (concat gnus-use-generic-path "!" login-name)) (t login-name)))) (defun gnus-inews-user-name () "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"." (let ((full-name (gnus-inews-full-name)) (address (if (or gnus-user-login-name gnus-use-generic-from gnus-local-domain (getenv "DOMAINNAME")) (concat (gnus-inews-login-name) "@" (gnus-inews-domain-name gnus-use-generic-from)) user-mail-address))) (or gnus-user-from-line (concat address ;; User's full name. (cond ((string-equal full-name "&") ;Unix hack. (concat " (" (user-login-name) ")")) ((string-match "[^ ]+@[^ ]+ +(.*)" address) "") (t (concat " (" full-name ")"))))))) (defun gnus-inews-real-user-address () "Return the \"real\" user address. This function tries to ignore all user modifications, and give as trustworthy answer as possible." (concat (user-login-name) "@" (gnus-inews-full-address))) (defun gnus-inews-login-name () "Return login name." (or gnus-user-login-name (getenv "LOGNAME") (user-login-name))) (defun gnus-inews-full-name () "Return full user name." (or gnus-user-full-name (getenv "NAME") (user-full-name))) (defun gnus-inews-domain-name (&optional genericfrom) "Return user's domain name. If optional argument GENERICFROM is a string, use it as the domain name; if it is non-nil, strip off local host name from the domain name. If the function `system-name' returns full internet name and the domain is undefined, the domain name is got from it." (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME")) (let* ((system-name (system-name)) (domain (or (if (stringp genericfrom) genericfrom) (getenv "DOMAINNAME") gnus-local-domain ;; Function `system-name' may return full internet name. ;; Suggested by Mike DeCorte . (if (string-match "\\." system-name) (substring system-name (match-end 0))) (read-string "Domain name (no host): "))) (host (or (if (string-match "\\." system-name) (substring system-name 0 (match-beginning 0))) system-name))) (if (string-equal "." (substring domain 0 1)) (setq domain (substring domain 1))) ;; Support GENERICFROM as same as standard Bnews system. ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com. (cond ((null genericfrom) (concat host "." domain)) ;;((stringp genericfrom) genericfrom) (t domain))) (if (string-match "\\." (system-name)) (system-name) (substring user-mail-address (1+ (string-match "@" user-mail-address)))))) (defun gnus-inews-full-address () (let ((domain (gnus-inews-domain-name)) (system (system-name)) (case-fold-search t)) (if (string-match "\\." system) system (if (string-match (concat "^" (regexp-quote system)) domain) domain (concat system "." domain))))) (defun gnus-inews-message-id () "Generate unique Message-ID for user." ;; Message-ID should not contain a slash and should be terminated by ;; a number. I don't know the reason why it is so. (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-full-address) ">")) (defvar gnus-unique-id-char nil) ;; If you ever change this function, make sure the new version ;; cannot generate IDs that the old version could. ;; You might for example insert a "." somewhere (not next to another dot ;; or string boundary), or modify the newsreader name to "Ding". (defun gnus-inews-unique-id () ;; Dont use microseconds from (current-time), they may be unsupported. ;; Instead we use this randomly inited counter. (setq gnus-unique-id-char (% (1+ (or gnus-unique-id-char (logand (random t) (1- (lsh 1 20))))) ;; (current-time) returns 16-bit ints, ;; and 2^16*25 just fits into 4 digits i base 36. (* 25 25))) (let ((tm (if (fboundp 'current-time) (current-time) '(12191 46742 287898)))) (concat (if (memq system-type '(ms-dos emx vax-vms)) (let ((user (downcase (gnus-inews-login-name)))) (while (string-match "[^a-z0-9_]" user) (aset user (match-beginning 0) ?_)) user) (gnus-number-base36 (user-uid) -1)) (gnus-number-base36 (+ (car tm) (lsh (% gnus-unique-id-char 25) 16)) 4) (gnus-number-base36 (+ (nth 1 tm) (lsh (/ gnus-unique-id-char 25) 16)) 4) ;; Append the newsreader name, because while the generated ;; ID is unique to this newsreader, other newsreaders might ;; otherwise generate the same ID via another algorithm. ".fsf"))) (defun gnus-inews-date () "Current time string." (timezone-make-date-arpa-standard (current-time-string) (current-time-zone))) (defun gnus-inews-organization () "Return user's organization. The ORGANIZATION environment variable is used if defined. If not, the variable `gnus-local-organization' is used instead. If it is a function, the function will be called with the current newsgroup name as the argument. If this is a file name, the contents of this file will be used as the organization." (let* ((organization (or (getenv "ORGANIZATION") (if gnus-local-organization (if (and (symbolp gnus-local-organization) (fboundp gnus-local-organization)) (funcall gnus-local-organization gnus-newsgroup-name) gnus-local-organization)) gnus-organization-file "~/.organization"))) (and (stringp organization) (> (length organization) 0) (or (file-exists-p organization) (string-match " " organization) (not (string-match "^/usr/lib/" organization))) (save-excursion (gnus-set-work-buffer) (if (file-exists-p organization) (insert-file-contents organization) (insert organization)) (goto-char (point-min)) (while (re-search-forward " *\n *" nil t) (replace-match " " t t)) (buffer-substring (point-min) (point-max)))))) (defun gnus-inews-lines () "Count the number of lines and return numeric string." (save-excursion (save-restriction (widen) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) (int-to-string (count-lines (point) (point-max)))))) ;;; ;;; Gnus Mail Functions ;;; ;;; Mail reply commands of Gnus summary mode (defun gnus-summary-reply (yank &optional yank-articles) "Reply mail to news author. If prefix argument YANK is non-nil, original article is yanked automatically. Customize the variable gnus-mail-reply-method to use another mailer." (interactive "P") ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells) ;; Stripping headers should be specified with mail-yank-ignored-headers. (gnus-set-global-variables) (if yank-articles (gnus-summary-goto-subject (car yank-articles))) (gnus-summary-select-article) (let ((gnus-newsgroup-name gnus-newsgroup-name)) (bury-buffer gnus-article-buffer) (funcall gnus-mail-reply-method (or yank-articles (not (not yank)))))) (defun gnus-summary-reply-with-original (n) "Reply mail to news author with original article. Customize the variable gnus-mail-reply-method to use another mailer." (interactive "P") (gnus-summary-reply t (gnus-summary-work-articles n))) (defun gnus-summary-mail-forward (post) "Forward the current message to another user. Customize the variable gnus-mail-forward-method to use another mailer." (interactive "P") (gnus-set-global-variables) (gnus-summary-select-article) (gnus-copy-article-buffer) (let ((gnus-newsgroup-name gnus-newsgroup-name)) (if post (gnus-forward-using-post gnus-article-copy) (funcall gnus-mail-forward-method gnus-article-copy)))) (defun gnus-summary-post-forward () "Forward the current article to a newsgroup." (interactive) (gnus-summary-mail-forward t)) (defvar gnus-nastygram-message "The following article was inappropriately posted to %s.\n" "Format string to insert in nastygrams. The current group name will be inserted at \"%s\".") (defun gnus-summary-mail-nastygram (n) "Send a nastygram to the author of the current article." (interactive "P") (if (or gnus-expert-user (gnus-y-or-n-p "Really send a nastygram to the author of the current article? ")) (let ((group gnus-newsgroup-name)) (gnus-summary-reply-with-original n) (set-buffer gnus-mail-buffer) (insert (format gnus-nastygram-message group)) (gnus-mail-send-and-exit)))) (defun gnus-summary-mail-other-window () "Compose mail in other window. Customize the variable `gnus-mail-other-window-method' to use another mailer." (interactive) (gnus-set-global-variables) (let ((gnus-newsgroup-name gnus-newsgroup-name)) (funcall gnus-mail-other-window-method))) (defun gnus-mail-reply-using-mail (&optional yank to-address) (save-excursion (set-buffer gnus-summary-buffer) (let ((group (gnus-group-real-name gnus-newsgroup-name)) (cur (cons (current-buffer) (cdr gnus-article-current))) (winconf (current-window-configuration)) from subject date reply-to message-of references message-id sender follow-to sendto elt) (set-buffer (get-buffer-create gnus-mail-buffer)) (mail-mode) (make-local-variable 'gnus-article-reply) (setq gnus-article-reply cur) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) (if (and (buffer-modified-p) (> (buffer-size) 0) (not (gnus-y-or-n-p "Unsent article being composed; erase it? "))) () (erase-buffer) (save-excursion (gnus-copy-article-buffer) (save-restriction (set-buffer gnus-article-copy) (gnus-narrow-to-headers) (if (and (boundp 'gnus-reply-to-function) gnus-reply-to-function) (setq follow-to (funcall gnus-reply-to-function group))) (setq from (mail-fetch-field "from")) (setq date (or (mail-fetch-field "date") (mail-header-date gnus-current-headers))) (and from (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) (setq message-of (concat (if stop-pos (substring from 0 stop-pos) from) "'s message of " date)))) (setq sender (mail-fetch-field "sender")) (setq subject (or (mail-fetch-field "subject") "Re: none")) (or (string-match "^[Rr][Ee]:" subject) (setq subject (concat "Re: " subject))) (setq reply-to (mail-fetch-field "reply-to")) (setq references (mail-fetch-field "references")) (setq message-id (mail-fetch-field "message-id")) (widen)) (setq news-reply-yank-from (or from "(nobody)"))) (setq news-reply-yank-message-id (or message-id "(unknown Message-ID)")) ;; Gather the "to" addresses out of the follow-to list and remove ;; them as we go. (if (and follow-to (listp follow-to)) (while (setq elt (assoc "To" follow-to)) (setq sendto (concat sendto (and sendto ", ") (cdr elt))) (setq follow-to (delq elt follow-to)))) (mail-setup (or to-address (if (and follow-to (not (stringp follow-to))) sendto (or follow-to reply-to from sender ""))) subject message-of nil gnus-article-copy nil) (auto-save-mode auto-save-default) (use-local-map (copy-keymap mail-mode-map)) (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) (if (and follow-to (listp follow-to)) (progn (goto-char (point-min)) (re-search-forward "^To:" nil t) (beginning-of-line) (forward-line 1) (while follow-to (insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n") (setq follow-to (cdr follow-to))))) (nnheader-insert-references references message-id) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) (if (not yank) (gnus-configure-windows 'reply 'force) (let ((last (point)) end) (if (not (listp yank)) (progn (save-excursion (mail-yank-original nil)) (or mail-yank-hooks mail-citation-hook (run-hooks 'news-reply-header-hook))) (while yank (save-window-excursion (set-buffer gnus-summary-buffer) (gnus-summary-select-article nil nil nil (car yank)) (gnus-summary-remove-process-mark (car yank))) (save-excursion (gnus-copy-article-buffer) (mail-yank-original nil) (setq end (point))) (or mail-yank-hooks mail-citation-hook (run-hooks 'news-reply-header-hook)) (goto-char end) (setq yank (cdr yank)))) (goto-char last)) (gnus-configure-windows 'reply-yank 'force)) (run-hooks 'gnus-mail-hook))))) (defun gnus-mail-yank-original () (interactive) (save-excursion (mail-yank-original nil)) (or mail-yank-hooks mail-citation-hook (run-hooks 'news-reply-header-hook))) (defun gnus-mail-send-and-exit () (interactive) (let ((reply gnus-article-reply) (winconf gnus-prev-winconf)) (mail-send-and-exit nil) (if (get-buffer gnus-group-buffer) (progn (if (gnus-buffer-exists-p (car-safe reply)) (progn (set-buffer (car reply)) (and (cdr reply) (gnus-summary-mark-article-as-replied (cdr reply))))) (and winconf (set-window-configuration winconf)))))) (defun gnus-forward-make-subject (buffer) (save-excursion (set-buffer buffer) (concat "[" (if (memq 'mail (assoc (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name))) gnus-valid-select-methods)) (gnus-fetch-field "From") gnus-newsgroup-name) "] " (or (gnus-fetch-field "Subject") "")))) (defun gnus-forward-insert-buffer (buffer) (let ((beg (goto-char (point-max)))) (insert "------- Start of forwarded message -------\n") (insert-buffer buffer) (goto-char (point-max)) (insert "------- End of forwarded message -------\n") ;; Suggested by Sudish Joseph . (goto-char beg) (while (setq beg (next-single-property-change (point) 'invisible)) (goto-char beg) (delete-region beg (or (next-single-property-change (point) 'invisible) (point-max)))))) (defun gnus-mail-forward-using-mail (&optional buffer) "Forward the current message to another user using mail." ;; This is almost a carbon copy of rmail-forward in rmail.el. (let* ((forward-buffer (or buffer (current-buffer))) (winconf (current-window-configuration)) (subject (gnus-forward-make-subject forward-buffer))) (set-buffer forward-buffer) (mail nil nil subject) (use-local-map (copy-keymap (current-local-map))) (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) (gnus-forward-insert-buffer forward-buffer) (goto-char (point-min)) (re-search-forward "^To: " nil t) (gnus-configure-windows 'mail-forward 'force) ;; You have a chance to arrange the message. (run-hooks 'gnus-mail-forward-hook) (run-hooks 'gnus-mail-hook))) (defun gnus-forward-using-post (&optional buffer) (save-excursion (let* ((forward-buffer (or buffer (current-buffer))) (subject (gnus-forward-make-subject forward-buffer)) (gnus-newsgroup-name nil)) (gnus-post-news 'post nil nil nil nil subject) (save-excursion (gnus-forward-insert-buffer forward-buffer) ;; You have a chance to arrange the message. (run-hooks 'gnus-mail-forward-hook))))) (defun gnus-mail-other-window-using-mail () "Compose mail other window using mail." (let ((winconf (current-window-configuration))) (mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer)) (use-local-map (copy-keymap (current-local-map))) (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) (run-hooks 'gnus-mail-hook) (gnus-configure-windows 'summary-mail 'force))) (defun gnus-article-mail (yank) "Send a reply to the address near point. If YANK is non-nil, include the original article." (interactive "P") (let ((address (buffer-substring (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) (and address (progn (switch-to-buffer gnus-summary-buffer) (funcall gnus-mail-reply-method yank address))))) (defun gnus-bug () "Send a bug report to the Gnus maintainers." (interactive) (let ((winconf (current-window-configuration))) (delete-other-windows) (switch-to-buffer "*Gnus Help Bug*") (erase-buffer) (insert gnus-bug-message) (goto-char (point-min)) (pop-to-buffer "*Gnus Bug*") (erase-buffer) (mail-mode) (mail-setup gnus-maintainer nil nil nil nil nil) (auto-save-mode auto-save-default) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) (use-local-map (copy-keymap mail-mode-map)) (local-set-key "\C-c\C-c" 'gnus-bug-mail-send-and-exit) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) (insert (format "%s\n%s\n\n\n\n\n" (gnus-version) (emacs-version))) (gnus-debug) (goto-char (point-min)) (search-forward "Subject: " nil t) (message ""))) (defun gnus-bug-mail-send-and-exit () "Send the bug message and exit." (interactive) (and (get-buffer "*Gnus Help Bug*") (kill-buffer "*Gnus Help Bug*")) (gnus-mail-send-and-exit)) (defun gnus-debug () "Attemps to go through the Gnus source file and report what variables have been changed. The source file has to be in the Emacs load path." (interactive) (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el")) file dirs expr olist sym) (message "Please wait while we snoop your variables...") (sit-for 0) (save-excursion (set-buffer (get-buffer-create " *gnus bug info*")) (buffer-disable-undo (current-buffer)) (while files (erase-buffer) (setq dirs load-path) (while dirs (if (or (not (car dirs)) (not (stringp (car dirs))) (not (file-exists-p (setq file (concat (file-name-as-directory (car dirs)) (car files)))))) (setq dirs (cdr dirs)) (setq dirs nil) (insert-file-contents file) (goto-char (point-min)) (or (re-search-forward "^;;* *Internal variables" nil t) (error "Malformed sources in file %s" file)) (narrow-to-region (point-min) (point)) (goto-char (point-min)) (while (setq expr (condition-case () (read (current-buffer)) (error nil))) (condition-case () (and (eq (car expr) 'defvar) (stringp (nth 3 expr)) (or (not (boundp (nth 1 expr))) (not (equal (eval (nth 2 expr)) (symbol-value (nth 1 expr))))) (setq olist (cons (nth 1 expr) olist))) (error nil))))) (setq files (cdr files))) (kill-buffer (current-buffer))) (insert "------------------- Environment follows -------------------\n\n") (while olist (if (boundp (car olist)) (insert "(setq " (symbol-name (car olist)) (if (or (consp (setq sym (symbol-value (car olist)))) (and (symbolp sym) (not (or (eq sym nil) (eq sym t))))) " '" " ") (prin1-to-string (symbol-value (car olist))) ")\n") (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) (setq olist (cdr olist))) (insert "\n\n") ;; Remove any null chars - they seem to cause trouble for some ;; mailers. (Byte-compiled output from the stuff above.) (goto-char (point-min)) (while (re-search-forward "[\000\200]" nil t) (replace-match "" t t)))) (gnus-ems-redefine) (provide 'gnus-msg) ;;; gnus-msg.el ends here emacs-19.30/lisp/gnus-score.el100444 23053 1 156256 6046561417 15066 0ustar larsidaemon;;; gnus-score.el --- scoring code for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Code: (require 'gnus) (defvar gnus-score-expiry-days 7 "*Number of days before unused score file entries are expired.") (defvar gnus-orphan-score nil "*All orphans get this score added. Set in the score file.") (defvar gnus-default-adaptive-score-alist '((gnus-kill-file-mark) (gnus-unread-mark) (gnus-read-mark (from 3) (subject 30)) (gnus-catchup-mark (subject -10)) (gnus-killed-mark (from -1) (subject -20)) (gnus-del-mark (from -2) (subject -15))) "*Alist of marks and scores.") (defvar gnus-score-mimic-keymap nil "*Have the score entry functions pretend that they are a keymap.") (defvar gnus-score-exact-adapt-limit 10 "*Number that says how long a match has to be before using substring matching. When doing adaptive scoring, one normally uses fuzzy or substring matching. However, if the header one matches is short, the possibility for false positives is great, so if the length of the match is less than this variable, exact matching will be used. If this variable is nil, exact matching will always be used.") ;; Internal variables. (defvar gnus-score-help-winconf nil) (defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist) (defvar gnus-score-trace nil) (defvar gnus-score-edit-buffer nil) (defvar gnus-score-alist nil "Alist containing score information. The keys can be symbols or strings. The following symbols are defined. touched: If this alist has been modified. mark: Automatically mark articles below this. expunge: Automatically expunge articles below this. files: List of other score files to load when loading this one. eval: Sexp to be evaluated when the score file is loaded. String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) where HEADER is the header being scored, MATCH is the string we are looking for, TYPE is a flag indicating whether it should use regexp or substring matching, SCORE is the score to add and DATE is the date of the last successful match.") (defvar gnus-score-cache nil) (defvar gnus-scores-articles nil) (defvar gnus-header-index nil) (defvar gnus-score-index nil) (eval-and-compile (autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap) (autoload 'appt-select-lowest-window "appt.el")) ;;; Summary mode score maps. (defvar gnus-summary-score-map nil) (define-prefix-command 'gnus-summary-score-map) (define-key gnus-summary-mode-map "V" 'gnus-summary-score-map) (define-key gnus-summary-score-map "s" 'gnus-summary-set-score) (define-key gnus-summary-score-map "a" 'gnus-summary-score-entry) (define-key gnus-summary-score-map "S" 'gnus-summary-current-score) (define-key gnus-summary-score-map "c" 'gnus-score-change-score-file) (define-key gnus-summary-score-map "m" 'gnus-score-set-mark-below) (define-key gnus-summary-score-map "x" 'gnus-score-set-expunge-below) (define-key gnus-summary-score-map "e" 'gnus-score-edit-alist) (define-key gnus-summary-score-map "f" 'gnus-score-edit-file) (define-key gnus-summary-score-map "t" 'gnus-score-find-trace) (define-key gnus-summary-score-map "C" 'gnus-score-customize) ;; Summary score file commands ;; Much modification of the kill (ahem, score) code and lots of the ;; functions are written by Per Abrahamsen . (defun gnus-summary-lower-score (&optional score) "Make a score entry based on the current article. The user will be prompted for header to score on, match type, permanence, and the string to be used. The numerical prefix will be used as score." (interactive "P") (gnus-summary-increase-score (- (gnus-score-default score)))) (defun gnus-summary-increase-score (&optional score) "Make a score entry based on the current article. The user will be prompted for header to score on, match type, permanence, and the string to be used. The numerical prefix will be used as score." (interactive "P") (gnus-set-global-variables) (let* ((nscore (gnus-score-default score)) (prefix (if (< nscore 0) ?L ?I)) (increase (> nscore 0)) (char-to-header '((?a "from" nil nil string) (?s "subject" nil nil string) (?b "body" "" nil body-string) (?h "head" "" nil body-string) (?i "message-id" nil t string) (?t "references" "message-id" t string) (?x "xref" nil nil string) (?l "lines" nil nil number) (?d "date" nil nil date) (?f "followup" nil nil string))) (char-to-type '((?s s "substring" string) (?e e "exact string" string) (?f f "fuzzy string" string) (?r r "regexp string" string) (?s s "substring" body-string) (?r s "regexp string" body-string) (?b before "before date" date) (?a at "at date" date) (?n now "this date" date) (?< < "less than number" number) (?> > "greater than number" number) (?= = "equal to number" number))) (char-to-perm (list (list ?t (current-time-string) "temporary") '(?p perm "permanent") '(?i now "immediate"))) (mimic gnus-score-mimic-keymap) hchar entry temporary tchar pchar end type) ;; First we read the header to score. (while (not hchar) (if mimic (progn (sit-for 1) (message "%c-" prefix)) (message "%s header (%s?): " (if increase "Increase" "Lower") (mapconcat (lambda (s) (char-to-string (car s))) char-to-header ""))) (setq hchar (read-char)) (if (not (or (= hchar ??) (= hchar ?\C-h))) () (setq hchar nil) (gnus-score-insert-help "Match on header" char-to-header 1))) (and (get-buffer "*Score Help*") (progn (kill-buffer "*Score Help*") (and gnus-score-help-winconf (set-window-configuration gnus-score-help-winconf)))) (or (setq entry (assq (downcase hchar) char-to-header)) (progn (ding) (setq end t) (if mimic (message "%c %c" prefix hchar) (message "")))) (if (or end (/= (downcase hchar) hchar)) (progn ;; This was a majuscle, so we end reading and set the defaults. (if mimic (message "%c %c" prefix hchar) (message "")) (setq type nil temporary (current-time-string))) ;; We continue reading - the type. (while (not tchar) (if mimic (progn (sit-for 1) (message "%c %c-" prefix hchar)) (message "%s header '%s' with match type (%s?): " (if increase "Increase" "Lower") (nth 1 entry) (mapconcat (lambda (s) (if (eq (nth 4 entry) (nth 3 s)) (char-to-string (car s)) "")) char-to-type ""))) (setq tchar (read-char)) (if (not (or (= tchar ??) (= tchar ?\C-h))) () (setq tchar nil) (gnus-score-insert-help "Match type" char-to-type 2))) (and (get-buffer "*Score Help*") (progn (and gnus-score-help-winconf (set-window-configuration gnus-score-help-winconf)) (kill-buffer "*Score Help*"))) (or (setq type (nth 1 (assq (downcase tchar) char-to-type))) (progn (ding) (if mimic (message "%c %c" prefix hchar) (message "")) (setq end t))) (if (or end (/= (downcase tchar) tchar)) (progn ;; It was a majuscle, so we end reading and the the default. (if mimic (message "%c %c %c" prefix hchar tchar) (message "")) (setq temporary (current-time-string))) ;; We continue reading. (while (not pchar) (if mimic (progn (sit-for 1) (message "%c %c %c-" prefix hchar tchar)) (message "%s permanence (%s?): " (if increase "Increase" "Lower") (mapconcat (lambda (s) (char-to-string (car s))) char-to-perm ""))) (setq pchar (read-char)) (if (not (or (= pchar ??) (= pchar ?\C-h))) () (setq pchar nil) (gnus-score-insert-help "Match permanence" char-to-perm 2))) (and (get-buffer "*Score Help*") (progn (and gnus-score-help-winconf (set-window-configuration gnus-score-help-winconf)) (kill-buffer "*Score Help*"))) (if mimic (message "%c %c %c" prefix hchar tchar pchar) (message "")) (if (setq temporary (nth 1 (assq pchar char-to-perm))) () (ding) (setq end t) (if mimic (message "%c %c %c %c" prefix hchar tchar pchar) (message ""))))) ;; We have all the data, so we enter this score. (if end () (gnus-summary-score-entry (nth 1 entry) ; Header (if (string= (nth 2 entry) "") "" (gnus-summary-header (or (nth 2 entry) (nth 1 entry)))) ; Match type ; Type (if (eq 's score) nil score) ; Score (if (eq 'perm temporary) ; Temp nil temporary) (not (nth 3 entry))) ; Prompt ))) (defun gnus-score-insert-help (string alist idx) (setq gnus-score-help-winconf (current-window-configuration)) (save-excursion (set-buffer (get-buffer-create "*Score Help*")) (buffer-disable-undo (current-buffer)) (delete-windows-on (current-buffer)) (erase-buffer) (insert string ":\n\n") (let ((max -1) (list alist) (i 0) n width pad format) ;; find the longest string to display (while list (setq n (length (nth idx (car list)))) (or (> max n) (setq max n)) (setq list (cdr list))) (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end (setq n (/ (window-width) max)) ; items per line (setq width (/ (window-width) n)) ; width of each item ;; insert `n' items, each in a field of width `width' (while alist (if (< i n) () (setq i 0) (delete-char -1) ; the `\n' takes a char (insert "\n")) (setq pad (- width 3)) (setq format (concat "%c: %-" (int-to-string pad) "s")) (insert (format format (car (car alist)) (nth idx (car alist)))) (setq alist (cdr alist)) (setq i (1+ i)))) ;; display ourselves in a small window at the bottom (appt-select-lowest-window) (split-window) (pop-to-buffer "*Score Help*") (shrink-window-if-larger-than-buffer) (select-window (get-buffer-window gnus-summary-buffer)))) (defun gnus-summary-header (header &optional no-err) ;; Return HEADER for current articles, or error. (let ((article (gnus-summary-article-number)) headers) (if article (if (and (setq headers (gnus-get-header-by-number article)) (vectorp headers)) (aref headers (nth 1 (assoc header gnus-header-index))) (if no-err nil (error "Pseudo-articles can't be scored"))) (if no-err (error "No article on current line") nil)))) (defun gnus-summary-score-entry (header match type score date &optional prompt silent) "Enter score file entry. HEADER is the header being scored. MATCH is the string we are looking for. TYPE is the match type: substring, regexp, exact, fuzzy. SCORE is the score to add. DATE is the expire date, or nil for no expire, or 'now for immediate expire. If optional argument `PROMPT' is non-nil, allow user to edit match. If optional argument `SILENT' is nil, show effect of score entry." (interactive (list (completing-read "Header: " gnus-header-index (lambda (x) (fboundp (nth 2 x))) t) (read-string "Match: ") (if (y-or-n-p "Use regexp match? ") 'r 's) (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) (cond ((not (y-or-n-p "Add to score file? ")) 'now) ((y-or-n-p "Expire kill? ") (current-time-string)) (t nil)))) ;; Regexp is the default type. (if (eq type t) (setq type 'r)) ;; Simplify matches... (cond ((or (eq type 'r) (eq type 's) (eq type nil)) (setq match (if match (gnus-simplify-subject-re match) ""))) ((eq type 'f) (setq match (gnus-simplify-subject-fuzzy match)))) (let ((score (gnus-score-default score)) (header (downcase header))) (and prompt (setq match (read-string (format "Match %s on %s, %s: " (cond ((eq date 'now) "now") ((stringp date) "temp") (t "permanent")) header (if (< score 0) "lower" "raise")) (if (numberp match) (int-to-string match) match)))) (and (>= (nth 1 (assoc header gnus-header-index)) 0) (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-string) (not silent) (gnus-summary-score-effect header match type score)) ;; If this is an integer comparison, we transform from string to int. (and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) (setq match (string-to-int match))) (if (eq date 'now) () (and (= score gnus-score-interactive-default-score) (setq score nil)) (let ((new (cond (type (list match score (and date (gnus-day-number date)) type)) (date (list match score (gnus-day-number date))) (score (list match score)) (t (list match)))) (old (gnus-score-get header)) elem) ;; We see whether we can collapse some score entries. ;; This isn't quite correct, because there may be more elements ;; later on with the same key that have matching elems... Hm. (if (and old (setq elem (assoc match old)) (eq (nth 3 elem) (nth 3 new)) (or (and (numberp (nth 2 elem)) (numberp (nth 2 new))) (and (not (nth 2 elem)) (not (nth 2 new))))) ;; Yup, we just add this new score to the old elem. (setcar (cdr elem) (+ (or (nth 1 elem) gnus-score-interactive-default-score) (or (nth 1 new) gnus-score-interactive-default-score))) ;; Nope, we have to add a new elem. (gnus-score-set header (if old (cons new old) (list new))))) (gnus-score-set 'touched '(t))))) (defun gnus-summary-score-effect (header match type score) "Simulate the effect of a score file entry. HEADER is the header being scored. MATCH is the string we are looking for. TYPE is a flag indicating if it is a regexp or substring. SCORE is the score to add." (interactive (list (completing-read "Header: " gnus-header-index (lambda (x) (fboundp (nth 2 x))) t) (read-string "Match: ") (y-or-n-p "Use regexp match? ") (prefix-numeric-value current-prefix-arg))) (save-excursion (or (and (stringp match) (> (length match) 0)) (error "No match")) (goto-char (point-min)) (let ((regexp (cond ((eq type 'f) (gnus-simplify-subject-fuzzy match)) (type match) (t (concat "\\`.*" (regexp-quote match) ".*\\'"))))) (while (not (eobp)) (let ((content (gnus-summary-header header 'noerr)) (case-fold-search t)) (and content (if (if (eq type 'f) (string-equal (gnus-simplify-subject-fuzzy content) regexp) (string-match regexp content)) (gnus-summary-raise-score score)))) (beginning-of-line 2))))) (defun gnus-summary-score-crossposting (score date) ;; Enter score file entry for current crossposting. ;; SCORE is the score to add. ;; DATE is the expire date. (let ((xref (gnus-summary-header "xref")) (start 0) group) (or xref (error "This article is not crossposted")) (while (string-match " \\([^ \t]+\\):" xref start) (setq start (match-end 0)) (if (not (string= (setq group (substring xref (match-beginning 1) (match-end 1))) gnus-newsgroup-name)) (gnus-summary-score-entry "xref" (concat " " group ":") nil score date t))))) ;;; ;;; Gnus Score Files ;;; ;; All score code written by Per Abrahamsen . ;; Added by Per Abrahamsen . (defun gnus-score-set-mark-below (score) "Automatically mark articles with score below SCORE as read." (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) (string-to-int (read-string "Mark below: "))))) (setq score (or score gnus-summary-default-score 0)) (gnus-score-set 'mark (list score)) (gnus-score-set 'touched '(t)) (setq gnus-summary-mark-below score) (gnus-summary-update-lines)) (defun gnus-score-set-expunge-below (score) "Automatically expunge articles with score below SCORE." (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) (string-to-int (read-string "Expunge below: "))))) (setq score (or score gnus-summary-default-score 0)) (gnus-score-set 'expunge (list score)) (gnus-score-set 'touched '(t))) (defun gnus-score-set (symbol value &optional alist) ;; Set SYMBOL to VALUE in ALIST. (let* ((alist (or alist gnus-score-alist (progn (gnus-score-load (gnus-score-file-name gnus-newsgroup-name)) gnus-score-alist))) (entry (assoc symbol alist))) (cond ((gnus-score-get 'read-only alist) ;; This is a read-only score file, so we do nothing. ) (entry (setcdr entry value)) ((null alist) (error "Empty alist")) (t (setcdr alist (cons (cons symbol value) (cdr alist))))))) (defun gnus-score-get (symbol &optional alist) ;; Get SYMBOL's definition in ALIST. (cdr (assoc symbol (or alist gnus-score-alist (progn (gnus-score-load (gnus-score-file-name gnus-newsgroup-name)) gnus-score-alist))))) (defun gnus-score-change-score-file (file) "Change current score alist." (interactive (list (read-file-name "Edit score file: " gnus-kill-files-directory))) (gnus-score-load-file file) (gnus-set-mode-line 'summary)) (defun gnus-score-edit-alist (file) "Edit the current score alist." (interactive (list gnus-current-score-file)) (let ((winconf (current-window-configuration))) (and (buffer-name gnus-summary-buffer) (gnus-score-save)) (setq gnus-score-edit-buffer (find-file-noselect file)) (gnus-configure-windows 'edit-score) (gnus-score-mode) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) (gnus-message 4 (substitute-command-keys "\\\\[gnus-score-edit-done] to save edits"))) (defun gnus-score-edit-file (file) "Edit a score file." (interactive (list (read-file-name "Edit score file: " gnus-kill-files-directory))) (and (buffer-name gnus-summary-buffer) (gnus-score-save)) (let ((winconf (current-window-configuration))) (setq gnus-score-edit-buffer (find-file-noselect file)) (gnus-configure-windows 'edit-score) (gnus-score-mode) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) (gnus-message 4 (substitute-command-keys "\\\\[gnus-score-edit-done] to save edits"))) (defun gnus-score-load-file (file) ;; Load score file FILE. Returns a list a retrieved score-alists. (setq gnus-kill-files-directory (or gnus-kill-files-directory "~/News/")) (let* ((file (expand-file-name (or (and (string-match (concat "^" (expand-file-name gnus-kill-files-directory)) (expand-file-name file)) file) (concat gnus-kill-files-directory file)))) (cached (assoc file gnus-score-cache)) (global (member file gnus-internal-global-score-files)) lists alist) (if cached ;; The score file was already loaded. (setq alist (cdr cached)) ;; We load the score file. (setq gnus-score-alist nil) (setq alist (gnus-score-load-score-alist file)) ;; We add '(touched) to the alist to signify that it hasn't been ;; touched (yet). (or (assq 'touched alist) (setq alist (cons (list 'touched nil) alist))) ;; If it is a global score file, we make it read-only. (and global (not (assq 'read-only alist)) (setq alist (cons (list 'read-only t) alist))) ;; Update cache. (setq gnus-score-cache (cons (cons file alist) gnus-score-cache))) ;; If there are actual scores in the alist, we add it to the ;; return value of this function. (if (memq t (mapcar (lambda (e) (stringp (car e))) alist)) (setq lists (list alist))) ;; Treat the other possible atoms in the score alist. (let ((mark (car (gnus-score-get 'mark alist))) (expunge (car (gnus-score-get 'expunge alist))) (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist))) (files (gnus-score-get 'files alist)) (exclude-files (gnus-score-get 'exclude-files alist)) (orphan (car (gnus-score-get 'orphan alist))) (adapt (gnus-score-get 'adapt alist)) (local (gnus-score-get 'local alist)) (eval (car (gnus-score-get 'eval alist)))) ;; We do not respect eval and files atoms from global score ;; files. (and files (not global) (setq lists (apply 'append lists (mapcar (lambda (file) (gnus-score-load-file file)) files)))) (and eval (not global) (eval eval)) ;; We then expand any exclude-file directives. (setq gnus-scores-exclude-files (nconc (mapcar (lambda (sfile) (expand-file-name sfile (file-name-directory file))) exclude-files) gnus-scores-exclude-files)) (if (not local) () (save-excursion (set-buffer gnus-summary-buffer) (while local (and (consp (car local)) (symbolp (car (car local))) (progn (make-local-variable (car (car local))) (set (car (car local)) (nth 1 (car local))))) (setq local (cdr local))))) (if orphan (setq gnus-orphan-score orphan)) (setq gnus-adaptive-score-alist (cond ((equal adapt '(t)) (setq gnus-newsgroup-adaptive t) gnus-default-adaptive-score-alist) ((equal adapt '(ignore)) (setq gnus-newsgroup-adaptive nil)) ((consp adapt) (setq gnus-newsgroup-adaptive t) adapt) (t ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring) gnus-default-adaptive-score-alist))) (setq gnus-summary-mark-below (or mark mark-and-expunge gnus-summary-mark-below)) (setq gnus-summary-expunge-below (or expunge mark-and-expunge gnus-summary-expunge-below))) (setq gnus-current-score-file file) (setq gnus-score-alist alist) lists)) (defun gnus-score-load (file) ;; Load score FILE. (let ((cache (assoc file gnus-score-cache))) (if cache (setq gnus-score-alist (cdr cache)) (setq gnus-score-alist nil) (gnus-score-load-score-alist file) (or gnus-score-alist (setq gnus-score-alist (copy-alist '((touched nil))))) (setq gnus-score-cache (cons (cons file gnus-score-alist) gnus-score-cache))))) (defun gnus-score-remove-from-cache (file) (setq gnus-score-cache (delq (assoc file gnus-score-cache) gnus-score-cache))) (defun gnus-score-load-score-alist (file) (let (alist) (if (file-readable-p file) (progn (save-excursion (gnus-set-work-buffer) (insert-file-contents file) (goto-char (point-min)) ;; Only do the loading if the score file isn't empty. (if (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t)) (setq alist (condition-case () (read (current-buffer)) (error (progn (gnus-message 3 "Problem with score file %s" file) (ding) (sit-for 2) nil)))))) (if (eq (car alist) 'setq) (setq gnus-score-alist (gnus-score-transform-old-to-new alist)) (setq gnus-score-alist alist)) (setq gnus-score-alist (gnus-score-check-syntax gnus-score-alist file))) (setq gnus-score-alist nil)))) (defun gnus-score-check-syntax (alist file) (cond ((null alist) nil) ((not (consp alist)) (gnus-message 1 "Score file is not a list: %s" file) (ding) nil) (t (let ((a alist) err) (while (and a (not err)) (cond ((not (listp (car a))) (gnus-message 3 "Illegal score element %s in %s" (car a) file) (setq err t)) ((and (stringp (car (car a))) (not (listp (nth 1 (car a))))) (gnus-message 3 "Illegal header match %s in %s" (nth 1 (car a)) file) (setq err t)) (t (setq a (cdr a))))) (if err (progn (ding) nil) alist))))) (defun gnus-score-transform-old-to-new (alist) (let* ((alist (nth 2 alist)) out entry) (if (eq (car alist) 'quote) (setq alist (nth 1 alist))) (while alist (setq entry (car alist)) (if (stringp (car entry)) (let ((scor (cdr entry))) (setq out (cons entry out)) (while scor (setcar scor (list (car (car scor)) (nth 2 (car scor)) (and (nth 3 (car scor)) (gnus-day-number (nth 3 (car scor)))) (if (nth 1 (car scor)) 'r 's))) (setq scor (cdr scor)))) (setq out (cons (if (not (listp (cdr entry))) (list (car entry) (cdr entry)) entry) out))) (setq alist (cdr alist))) (cons (list 'touched t) (nreverse out)))) (defun gnus-score-save () ;; Save all score information. (let ((cache gnus-score-cache)) (save-excursion (setq gnus-score-alist nil) (set-buffer (get-buffer-create "*Score*")) (buffer-disable-undo (current-buffer)) (let (entry score file) (while cache (setq entry (car cache) cache (cdr cache) file (car entry) score (cdr entry)) (if (or (not (equal (gnus-score-get 'touched score) '(t))) (gnus-score-get 'read-only score) (and (file-exists-p file) (not (file-writable-p file)))) () (setq score (setcdr entry (delq (assq 'touched score) score))) (erase-buffer) (let (emacs-lisp-mode-hook) (if (string-match (concat gnus-adaptive-file-suffix "$") file) ;; This is an adaptive score file, so we do not run ;; it through `pp'. These files can get huge, and ;; are not meant to be edited by human hands. (insert (format "%S" score)) ;; This is a normal score file, so we print it very ;; prettily. (pp score (current-buffer)))) (if (not (gnus-make-directory (file-name-directory file))) () ;; If the score file is empty, we delete it. (if (zerop (buffer-size)) (delete-file file) ;; There are scores, so we write the file. (and (file-writable-p file) (write-region (point-min) (point-max) file nil 'silent))))))) (kill-buffer (current-buffer))))) (defun gnus-score-headers (score-files &optional trace) ;; Score `gnus-newsgroup-headers'. (let (scores) ;; PLM: probably this is not the best place to clear orphan-score (setq gnus-orphan-score nil) (setq gnus-scores-articles nil) (setq gnus-scores-exclude-files nil) ;; Load the score files. (while score-files (if (stringp (car score-files)) ;; It is a string, which means that it's a score file name, ;; so we load the score file and add the score alist to ;; the list of alists. (setq scores (nconc (gnus-score-load-file (car score-files)) scores)) ;; It is an alist, so we just add it to the list directly. (setq scores (nconc (car score-files) scores))) (setq score-files (cdr score-files))) ;; Prune the score files that are to be excluded, if any. (if (not gnus-scores-exclude-files) () (let ((s scores) c) (while s (and (setq c (rassq (car s) gnus-score-cache)) (member (car c) gnus-scores-exclude-files) (setq scores (delq (car s) scores))) (setq s (cdr s))))) (if (not (and gnus-summary-default-score scores (> (length gnus-newsgroup-headers) (length gnus-newsgroup-scored)))) () (let* ((entries gnus-header-index) (now (gnus-day-number (current-time-string))) (expire (- now gnus-score-expiry-days)) (headers gnus-newsgroup-headers) (current-score-file gnus-current-score-file) entry header) (gnus-message 5 "Scoring...") ;; Create articles, an alist of the form `(HEADER . SCORE)'. (while headers (setq header (car headers) headers (cdr headers)) ;; WARNING: The assq makes the function O(N*S) while it could ;; be written as O(N+S), where N is (length gnus-newsgroup-headers) ;; and S is (length gnus-newsgroup-scored). (or (assq (mail-header-number header) gnus-newsgroup-scored) (setq gnus-scores-articles ;Total of 2 * N cons-cells used. (cons (cons header (or gnus-summary-default-score 0)) gnus-scores-articles)))) (save-excursion (set-buffer (get-buffer-create "*Headers*")) (buffer-disable-undo (current-buffer)) ;; Set the global variant of this variable. (setq gnus-current-score-file current-score-file) ;; score orphans (if gnus-orphan-score (progn (setq gnus-score-index (nth 1 (assoc "references" gnus-header-index))) (gnus-score-orphans gnus-orphan-score))) ;; Run each header through the score process. (while entries (setq entry (car entries) header (nth 0 entry) entries (cdr entries)) (setq gnus-score-index (nth 1 (assoc header gnus-header-index))) (if (< 0 (apply 'max (mapcar (lambda (score) (length (gnus-score-get header score))) scores))) (funcall (nth 2 entry) scores header now expire trace))) ;; Remove the buffer. (kill-buffer (current-buffer))) ;; Add articles to `gnus-newsgroup-scored'. (while gnus-scores-articles (or (= gnus-summary-default-score (cdr (car gnus-scores-articles))) (setq gnus-newsgroup-scored (cons (cons (mail-header-number (car (car gnus-scores-articles))) (cdr (car gnus-scores-articles))) gnus-newsgroup-scored))) (setq gnus-scores-articles (cdr gnus-scores-articles))) (gnus-message 5 "Scoring...done"))))) (defun gnus-get-new-thread-ids (articles) (let ((index (nth 1 (assoc "message-id" gnus-header-index))) (refind gnus-score-index) id-list art this tref) (while articles (setq art (car articles) this (aref (car art) index) tref (aref (car art) refind) articles (cdr articles)) (if (string-equal tref "") ;no references line (setq id-list (cons this id-list)))) id-list)) ;; Orphan functions written by plm@atcmp.nl (Peter Mutsaers). (defun gnus-score-orphans (score) (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles)) alike articles art arts this last this-id) (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) articles gnus-scores-articles) ;;more or less the same as in gnus-score-string (erase-buffer) (while articles (setq art (car articles) this (aref (car art) gnus-score-index) articles (cdr articles)) ;;completely skip if this is empty (not a child, so not an orphan) (if (not (string= this "")) (if (equal last this) ;; O(N*H) cons-cells used here, where H is the number of ;; headers. (setq alike (cons art alike)) (if last (progn ;; Insert the line, with a text property on the ;; terminating newline refering to the articles with ;; this line. (insert last ?\n) (put-text-property (1- (point)) (point) 'articles alike))) (setq alike (list art) last this)))) (and last ; Bwadr, duplicate code. (progn (insert last ?\n) (put-text-property (1- (point)) (point) 'articles alike))) ;; PLM: now delete those lines that contain an entry from new-thread-ids (while new-thread-ids (setq this-id (car new-thread-ids) new-thread-ids (cdr new-thread-ids)) (goto-char (point-min)) (while (search-forward this-id nil t) ;; found a match. remove this line (beginning-of-line) (kill-line 1))) ;; now for each line: update its articles with score by moving to ;; every end-of-line in the buffer and read the articles property (goto-char (point-min)) (while (eq 0 (progn (end-of-line) (setq arts (get-text-property (point) 'articles)) (while arts (setq art (car arts) arts (cdr arts)) (setcdr art (+ score (cdr art)))) (forward-line)))))) (defun gnus-score-integer (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) entries alist) ;; Find matches. (while scores (setq alist (car scores) scores (cdr scores) entries (assoc header alist)) (while (cdr entries) ;First entry is the header index. (let* ((rest (cdr entries)) (kill (car rest)) (match (nth 0 kill)) (type (or (nth 3 kill) '>)) (score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) (match-func (if (or (eq type '>) (eq type '<) (eq type '<=) (eq type '>=) (eq type '=)) type (error "Illegal match type: %s" type))) (articles gnus-scores-articles)) ;; Instead of doing all the clever stuff that ;; `gnus-score-string' does to minimize searches and stuff, ;; I will assume that people generally will put so few ;; matches on numbers that any cleverness will take more ;; time than one would gain. (while articles (and (funcall match-func (or (aref (car (car articles)) gnus-score-index) 0) match) (progn (and trace (setq gnus-score-trace (cons (cons (car (car articles)) kill) gnus-score-trace))) (setq found t) (setcdr (car articles) (+ score (cdr (car articles)))))) (setq articles (cdr articles))) ;; Update expire date (cond ((null date)) ;Permanent entry. (found ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ((< date expire) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) (setq entries rest)))))) (defun gnus-score-date (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) entries alist) ;; Find matches. (while scores (setq alist (car scores) scores (cdr scores) entries (assoc header alist)) (while (cdr entries) ;First entry is the header index. (let* ((rest (cdr entries)) (kill (car rest)) (match (timezone-make-date-sortable (nth 0 kill))) (type (or (nth 3 kill) 'before)) (score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) (match-func (cond ((eq type 'after) 'string<) ((eq type 'before) 'gnus-string>) ((eq type 'at) 'string=) (t (error "Illegal match type: %s" type)))) (articles gnus-scores-articles) l) ;; Instead of doing all the clever stuff that ;; `gnus-score-string' does to minimize searches and stuff, ;; I will assume that people generally will put so few ;; matches on numbers that any cleverness will take more ;; time than one would gain. (while articles (and (setq l (aref (car (car articles)) gnus-score-index)) (funcall match-func match (timezone-make-date-sortable l)) (progn (and trace (setq gnus-score-trace (cons (cons (car (car articles)) kill) gnus-score-trace))) (setq found t) (setcdr (car articles) (+ score (cdr (car articles)))))) (setq articles (cdr articles))) ;; Update expire date (cond ((null date)) ;Permanent entry. (found ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ((< date expire) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) (setq entries rest)))))) (defun gnus-score-body (scores header now expire &optional trace) (save-excursion (set-buffer nntp-server-buffer) (save-restriction (let* ((buffer-read-only nil) (articles gnus-scores-articles) (last (mail-header-number (car (car gnus-scores-articles)))) (all-scores scores) (request-func (cond ((string= "head" (downcase header)) 'gnus-request-head) ((string= "body" (downcase header)) 'gnus-request-body) (t 'gnus-request-article))) entries alist ofunc article) ;; Not all backends support partial fetching. In that case, ;; we just fetch the entire article. (or (gnus-check-backend-function (and (string-match "^gnus-" (symbol-name request-func)) (intern (substring (symbol-name request-func) (match-end 0)))) gnus-newsgroup-name) (progn (setq ofunc request-func) (setq request-func 'gnus-request-article))) (while articles (setq article (mail-header-number (car (car articles)))) (gnus-message 7 "Scoring on article %s of %s..." article last) (if (not (funcall request-func article gnus-newsgroup-name)) () (widen) (goto-char (point-min)) ;; If just parts of the article is to be searched, but the ;; backend didn't support partial fetching, we just narrow ;; to the relevant parts. (if ofunc (if (eq ofunc 'gnus-request-head) (narrow-to-region (point) (or (search-forward "\n\n" nil t) (point-max))) (narrow-to-region (or (search-forward "\n\n" nil t) (point)) (point-max)))) (setq scores all-scores) ;; Find matches. (while scores (setq alist (car scores) scores (cdr scores) entries (assoc header alist)) (while (cdr entries) ;First entry is the header index. (let* ((rest (cdr entries)) (kill (car rest)) (match (nth 0 kill)) (type (or (nth 3 kill) 's)) (score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) (case-fold-search (not (or (eq type 'R) (eq type 'S) (eq type 'Regexp) (eq type 'String)))) (search-func (cond ((or (eq type 'r) (eq type 'R) (eq type 'regexp) (eq type 'Regexp)) 're-search-forward) ((or (eq type 's) (eq type 'S) (eq type 'string) (eq type 'String)) 'search-forward) (t (error "Illegal match type: %s" type))))) (goto-char (point-min)) (if (funcall search-func match nil t) ;; Found a match, update scores. (progn (setcdr (car articles) (+ score (cdr (car articles)))) (setq found t) (and trace (setq gnus-score-trace (cons (cons (car (car articles)) kill) gnus-score-trace))))) ;; Update expire date (cond ((null date)) ;Permanent entry. (found ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ((< date expire) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) (setq entries rest))))) (setq articles (cdr articles))))))) (defun gnus-score-followup (scores header now expire &optional trace) ;; Insert the unique article headers in the buffer. (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) (current-score-file gnus-current-score-file) (all-scores scores) ;; gnus-score-index is used as a free variable. alike last this art entries alist articles) ;; Change score file to the adaptive score file. All entries that ;; this function makes will be put into this file. (gnus-score-load-file (gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix)) (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) articles gnus-scores-articles) (erase-buffer) (while articles (setq art (car articles) this (aref (car art) gnus-score-index) articles (cdr articles)) (if (equal last this) (setq alike (cons art alike)) (if last (progn (insert last ?\n) (put-text-property (1- (point)) (point) 'articles alike))) (setq alike (list art) last this))) (and last ; Bwadr, duplicate code. (progn (insert last ?\n) (put-text-property (1- (point)) (point) 'articles alike))) ;; Find matches. (while scores (setq alist (car scores) scores (cdr scores) entries (assoc header alist)) (while (cdr entries) ;First entry is the header index. (let* ((rest (cdr entries)) (kill (car rest)) (match (nth 0 kill)) (type (or (nth 3 kill) 's)) (score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) (mt (aref (symbol-name type) 0)) (case-fold-search (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) (dmt (downcase mt)) (search-func (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) (t (error "Illegal match type: %s" type)))) arts art) (goto-char (point-min)) (if (= dmt ?e) (while (funcall search-func match nil t) (and (= (progn (beginning-of-line) (point)) (match-beginning 0)) (= (progn (end-of-line) (point)) (match-end 0)) (progn (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. (while arts (setq art (car arts) arts (cdr arts)) (gnus-score-add-followups (car art) score all-scores))))) (while (funcall search-func match nil t) (end-of-line) (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. (while arts (setq art (car arts) arts (cdr arts)) (gnus-score-add-followups (car art) score all-scores)))) ;; Update expire date (cond ((null date)) ;Permanent entry. (found ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ((< date expire) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) (setq entries rest)))) ;; We change the score file back to the previous one. (gnus-score-load-file current-score-file))) (defun gnus-score-add-followups (header score scores) (save-excursion (set-buffer gnus-summary-buffer) (let* ((id (mail-header-id header)) (scores (car scores)) entry dont) ;; Don't enter a score if there already is one. (while scores (setq entry (car scores)) (and (equal "references" (car entry)) (or (null (nth 3 (car (cdr entry)))) (eq 's (nth 3 (car (cdr entry))))) (progn (if (assoc id entry) (setq dont t)))) (setq scores (cdr scores))) (or dont (gnus-summary-score-entry "references" id 's score (current-time-string) nil t))))) (defun gnus-score-string (score-list header now expire &optional trace) ;; Score ARTICLES according to HEADER in SCORE-LIST. ;; Update matches entries to NOW and remove unmatched entried older ;; than EXPIRE. ;; Insert the unique article headers in the buffer. (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) ;; gnus-score-index is used as a free variable. alike last this art entries alist articles scores fuzzy) ;; Sorting the articles costs os O(N*log N) but will allow us to ;; only match with each unique header. Thus the actual matching ;; will be O(M*U) where M is the number of strings to match with, ;; and U is the number of unique headers. It is assumed (but ;; untested) this will be a net win because of the large constant ;; factor involved with string matching. (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) articles gnus-scores-articles) (erase-buffer) (while articles (setq art (car articles) this (aref (car art) gnus-score-index) articles (cdr articles)) (if (equal last this) ;; O(N*H) cons-cells used here, where H is the number of ;; headers. (setq alike (cons art alike)) (if last (progn ;; Insert the line, with a text property on the ;; terminating newline refering to the articles with ;; this line. (insert last ?\n) (put-text-property (1- (point)) (point) 'articles alike))) (setq alike (list art) last this))) (and last ; Bwadr, duplicate code. (progn (insert last ?\n) (put-text-property (1- (point)) (point) 'articles alike))) ;; Find ordinary matches. (setq scores score-list) (while scores (setq alist (car scores) scores (cdr scores) entries (assoc header alist)) (while (cdr entries) ;First entry is the header index. (let* ((rest (cdr entries)) (kill (car rest)) (match (nth 0 kill)) (type (or (nth 3 kill) 's)) (score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) (mt (aref (symbol-name type) 0)) (case-fold-search (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) (dmt (downcase mt)) (search-func (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) (t (error "Illegal match type: %s" type)))) arts art) (if (= dmt ?f) (setq fuzzy t) (goto-char (point-min)) (if (= dmt ?e) (while (and (not (eobp)) (funcall search-func match nil t)) (and (= (progn (beginning-of-line) (point)) (match-beginning 0)) (= (progn (end-of-line) (point)) (match-end 0)) (progn (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. (if trace (while arts (setq art (car arts) arts (cdr arts)) (setcdr art (+ score (cdr art))) (setq gnus-score-trace (cons (cons (mail-header-number (car art)) kill) gnus-score-trace))) (while arts (setq art (car arts) arts (cdr arts)) (setcdr art (+ score (cdr art))))))) (forward-line 1)) (and (string= match "") (setq match "\n")) (while (and (not (eobp)) (funcall search-func match nil t)) (goto-char (match-beginning 0)) (end-of-line) (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. (if trace (while arts (setq art (car arts) arts (cdr arts)) (setcdr art (+ score (cdr art))) (setq gnus-score-trace (cons (cons (mail-header-number (car art)) kill) gnus-score-trace))) (while arts (setq art (car arts) arts (cdr arts)) (setcdr art (+ score (cdr art))))) (forward-line 1))) ;; Update expire date (cond ((null date)) ;Permanent entry. (found ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ((< date expire) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries)))) (setq entries rest)))) ;; Find fuzzy matches. (setq scores (and fuzzy score-list)) (if fuzzy (gnus-simplify-buffer-fuzzy)) (while scores (setq alist (car scores) scores (cdr scores) entries (assoc header alist)) (while (cdr entries) ;First entry is the header index. (let* ((rest (cdr entries)) (kill (car rest)) (match (nth 0 kill)) (type (or (nth 3 kill) 's)) (score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) (mt (aref (symbol-name type) 0)) (case-fold-search (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) (dmt (downcase mt)) (search-func (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) (t (error "Illegal match type: %s" type)))) arts art) (if (/= dmt ?f) () (goto-char (point-min)) (while (and (not (eobp)) (funcall search-func match nil t)) (and (= (progn (beginning-of-line) (point)) (match-beginning 0)) (= (progn (end-of-line) (point)) (match-end 0)) (progn (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. (if trace (while arts (setq art (car arts) arts (cdr arts)) (setcdr art (+ score (cdr art))) (setq gnus-score-trace (cons (cons (mail-header-number (car art)) kill) gnus-score-trace))) (while arts (setq art (car arts) arts (cdr arts)) (setcdr art (+ score (cdr art))))))) (forward-line 1)) ;; Update expire date (cond ((null date)) ;Permanent entry. (found ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ((< date expire) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries)))) (setq entries rest)))))) (defun gnus-score-string< (a1 a2) ;; Compare headers in articles A2 and A2. ;; The header index used is the free variable `gnus-score-index'. (string-lessp (aref (car a1) gnus-score-index) (aref (car a2) gnus-score-index))) (defun gnus-score-build-cons (article) ;; Build a `gnus-newsgroup-scored' type cons from ARTICLE. (cons (mail-header-number (car article)) (cdr article))) (defconst gnus-header-index ;; Name to index alist. '(("number" 0 gnus-score-integer) ("subject" 1 gnus-score-string) ("from" 2 gnus-score-string) ("date" 3 gnus-score-date) ("message-id" 4 gnus-score-string) ("references" 5 gnus-score-string) ("chars" 6 gnus-score-integer) ("lines" 7 gnus-score-integer) ("xref" 8 gnus-score-string) ("head" -1 gnus-score-body) ("body" -1 gnus-score-body) ("all" -1 gnus-score-body) ("followup" 2 gnus-score-followup))) (defun gnus-current-score-file-nondirectory (&optional score-file) (let ((score-file (or score-file gnus-current-score-file))) (if score-file (gnus-short-group-name (file-name-nondirectory score-file)) "none"))) (defun gnus-score-adaptive () (save-excursion (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist)) (alist malist) (date (current-time-string)) elem headers match) ;; First we transform the adaptive rule alist into something ;; that's faster to process. (while malist (setq elem (car malist)) (if (symbolp (car elem)) (setcar elem (symbol-value (car elem)))) (setq elem (cdr elem)) (while elem (setcdr (car elem) (cons (symbol-name (car (car elem))) (cdr (car elem)))) (setcar (car elem) (intern (concat "gnus-header-" (downcase (symbol-name (car (car elem))))))) (setq elem (cdr elem))) (setq malist (cdr malist))) ;; We change the score file to the adaptive score file. (gnus-score-load-file (gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix)) ;; The we score away. (goto-char (point-min)) (while (not (eobp)) (setq elem (cdr (assq (gnus-summary-article-mark) alist))) (if (or (not elem) (get-text-property (point) 'gnus-pseudo)) () (setq headers (gnus-get-header-by-number (gnus-summary-article-number))) (while (and elem headers) (setq match (funcall (car (car elem)) headers)) (gnus-summary-score-entry (nth 1 (car elem)) match (cond ((numberp match) '=) ((equal (nth 1 (car elem)) "date") 'a) (t ;; Whether we use substring or exact matches are controlled ;; here. (if (or (not gnus-score-exact-adapt-limit) (< (length match) gnus-score-exact-adapt-limit)) 'e (if (equal (nth 1 (car elem)) "subject") 'f 's)))) (nth 2 (car elem)) date nil t) (setq elem (cdr elem)))) (forward-line 1))))) (defun gnus-score-remove-lines-adaptive (marks) (save-excursion (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist)) (alist malist) (date (current-time-string)) (cur-score gnus-current-score-file) elem headers match) ;; First we transform the adaptive rule alist into something ;; that's faster to process. (while malist (setq elem (car malist)) (if (symbolp (car elem)) (setcar elem (symbol-value (car elem)))) (setq elem (cdr elem)) (while elem (setcdr (car elem) (cons (symbol-name (car (car elem))) (cdr (car elem)))) (setcar (car elem) (intern (concat "gnus-header-" (downcase (symbol-name (car (car elem))))))) (setq elem (cdr elem))) (setq malist (cdr malist))) ;; The we score away. (goto-char (point-min)) ;; We change the score file to the adaptive score file. (gnus-score-load-file (gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix)) (while (re-search-forward marks nil t) (beginning-of-line) (setq elem (cdr (assq (gnus-summary-article-mark) alist))) (if (or (not elem) (get-text-property (gnus-point-at-bol) 'gnus-pseudo)) () (setq headers (gnus-get-header-by-number (gnus-summary-article-number))) (while elem (setq match (funcall (car (car elem)) headers)) (gnus-summary-score-entry (nth 1 (car elem)) match (if (or (not gnus-score-exact-adapt-limit) (< (length match) gnus-score-exact-adapt-limit)) 'e 's) (nth 2 (car elem)) date nil t) (setq elem (cdr elem)))) (delete-region (point) (progn (forward-line 1) (point)))) ;; Switch back to the old score file. (gnus-score-load-file cur-score)))) ;;; ;;; Score mode. ;;; (defvar gnus-score-mode-map nil) (defvar gnus-score-mode-hook nil) (if gnus-score-mode-map () (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map)) (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-done) (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date)) (defun gnus-score-mode () "Mode for editing score files. This mode is an extended emacs-lisp mode. \\{gnus-score-mode-map}" (interactive) (kill-all-local-variables) (use-local-map gnus-score-mode-map) (set-syntax-table emacs-lisp-mode-syntax-table) (setq major-mode 'gnus-score-mode) (setq mode-name "Score") (lisp-mode-variables nil) (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook)) (defun gnus-score-edit-insert-date () "Insert date in numerical format." (interactive) (insert (int-to-string (gnus-day-number (current-time-string))))) (defun gnus-score-edit-done () "Save the score file and return to the summary buffer." (interactive) (let ((bufnam (buffer-file-name (current-buffer))) (winconf gnus-prev-winconf)) (gnus-make-directory (file-name-directory (buffer-file-name))) (save-buffer) (kill-buffer (current-buffer)) (gnus-score-remove-from-cache bufnam) (gnus-score-load-file bufnam) (and winconf (set-window-configuration winconf)))) (defun gnus-score-find-trace () "Find all score rules applied to this article." (interactive) (let ((gnus-newsgroup-headers (list (gnus-get-header-by-number (gnus-summary-article-number)))) (gnus-newsgroup-scored nil) (buf (current-buffer)) trace) (setq gnus-score-trace nil) (gnus-possibly-score-headers 'trace) (or (setq trace gnus-score-trace) (error "No score rules apply to the current article.")) (pop-to-buffer "*Gnus Scores*") (gnus-add-current-to-buffer-list) (erase-buffer) (while trace (insert (format "%S\n" (cdr (car trace)))) (setq trace (cdr trace))) (goto-char (point-min)) (pop-to-buffer buf))) (provide 'gnus-score) ;;; gnus-score.el ends here emacs-19.30/lisp/gnus-uu.el100444 23053 1 176672 6046561445 14411 0ustar larsidaemon;;; gnus-uu.el --- extract (uu)encoded files in Gnus ;; Copyright (C) 1985,86,87,93,94,95 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 ;; Version: v3.0 ;; Keyword: news ;; 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: ;;; Code: (require 'gnus) (require 'gnus-msg) ;; Default viewing action rules (defvar gnus-uu-default-view-rules '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") ("\\.pas$" "cat %s | sed s/\r//g") ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") ("\\.tga$" "tgatoppm %s | xv -") ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" "sox -v .5 %s -t .au -u - > /dev/audio") ("\\.au$" "cat %s > /dev/audio") ("\\.mod$" "str32") ("\\.ps$" "ghostview") ("\\.dvi$" "xdvi") ("\\.html$" "xmosaic") ("\\.mpe?g$" "mpeg_play") ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" "gnus-uu-archive")) "*Default actions to be taken when the user asks to view a file. To change the behaviour, you can either edit this variable or set `gnus-uu-user-view-rules' to something useful. For example: To make gnus-uu use 'xli' to display JPEG and GIF files, put the following in your .emacs file: (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\"))) Both these variables are lists of lists with two string elements. The first string is a regular expression. If the file name matches this regular expression, the command in the second string is executed with the file as an argument. If the command string contains \"%s\", the file name will be inserted at that point in the command string. If there's no \"%s\" in the command string, the file name will be appended to the command string before executing. There are several user variables to tailor the behaviour of gnus-uu to your needs. First we have `gnus-uu-user-view-rules', which is the variable gnus-uu first consults when trying to decide how to view a file. If this variable contains no matches, gnus-uu examines the default rule variable provided in this package. If gnus-uu finds no match here, it uses `gnus-uu-user-view-rules-end' to try to make a match.") (defvar gnus-uu-user-view-rules nil "*Variable detailing what actions are to be taken to view a file. See the documentation on the `gnus-uu-default-view-rules' variable for details.") (defvar gnus-uu-user-view-rules-end '(("" "file")) "*Variable saying what actions are to be taken if no rule matched the file name. See the documentation on the `gnus-uu-default-view-rules' variable for details.") ;; Default unpacking commands (defvar gnus-uu-default-archive-rules '(("\\.tar$" "tar xf") ("\\.zip$" "unzip -o") ("\\.ar$" "ar x") ("\\.arj$" "unarj x") ("\\.zoo$" "zoo -e") ("\\.\\(lzh\\|lha\\)$" "lha x") ("\\.Z$" "uncompress") ("\\.gz$" "gunzip") ("\\.arc$" "arc -x"))) (defvar gnus-uu-destructive-archivers (list "uncompress" "gunzip")) (defvar gnus-uu-user-archive-rules nil "*A list that can be set to override the default archive unpacking commands. To use, for instance, 'untar' to unpack tar files and 'zip -x' to unpack zip files, say the following: (setq gnus-uu-user-archive-rules '((\"\\\\.tar$\" \"untar\") (\"\\\\.zip$\" \"zip -x\")))") (defvar gnus-uu-ignore-files-by-name nil "*A regular expression saying what files should not be viewed based on name. If, for instance, you want gnus-uu to ignore all .au and .wav files, you could say something like (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") Note that this variable can be used in conjunction with the `gnus-uu-ignore-files-by-type' variable.") (defvar gnus-uu-ignore-files-by-type nil "*A regular expression saying what files that shouldn't be viewed, based on MIME file type. If, for instance, you want gnus-uu to ignore all audio files and all mpegs, you could say something like (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") Note that this variable can be used in conjunction with the `gnus-uu-ignore-files-by-name' variable.") ;; Pseudo-MIME support (defconst gnus-uu-ext-to-mime-list '(("\\.gif$" "image/gif") ("\\.jpe?g$" "image/jpeg") ("\\.tiff?$" "image/tiff") ("\\.xwd$" "image/xwd") ("\\.pbm$" "image/pbm") ("\\.pgm$" "image/pgm") ("\\.ppm$" "image/ppm") ("\\.xbm$" "image/xbm") ("\\.pcx$" "image/pcx") ("\\.tga$" "image/tga") ("\\.ps$" "image/postscript") ("\\.fli$" "video/fli") ("\\.wav$" "audio/wav") ("\\.aiff$" "audio/aiff") ("\\.hcom$" "audio/hcom") ("\\.voc$" "audio/voc") ("\\.smp$" "audio/smp") ("\\.mod$" "audio/mod") ("\\.dvi$" "image/dvi") ("\\.mpe?g$" "video/mpeg") ("\\.au$" "audio/basic") ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain") ("\\.\\(c\\|h\\)$" "text/source") ("read.*me" "text/plain") ("\\.html$" "text/html") ("\\.bat$" "text/bat") ("\\.[1-6]$" "text/man") ("\\.flc$" "video/flc") ("\\.rle$" "video/rle") ("\\.pfx$" "video/pfx") ("\\.avi$" "video/avi") ("\\.sme$" "video/sme") ("\\.rpza$" "video/prza") ("\\.dl$" "video/dl") ("\\.qt$" "video/qt") ("\\.rsrc$" "video/rsrc") ("\\..*$" "unknown/unknown"))) ;; Various variables users may set (defvar gnus-uu-tmp-dir "/tmp/" "*Variable saying where gnus-uu is to do its work. Default is \"/tmp/\".") (defvar gnus-uu-do-not-unpack-archives nil "*Non-nil means that gnus-uu won't peek inside archives looking for files to dispay. Default is nil.") (defvar gnus-uu-view-and-save nil "*Non-nil means that the user will always be asked to save a file after viewing it. If the variable is nil, the user will only be asked to save if the viewing is unsuccessful. Default is nil.") (defvar gnus-uu-ignore-default-view-rules nil "*Non-nil means that gnus-uu will ignore the default viewing rules. Only the user viewing rules will be consulted. Default is nil.") (defvar gnus-uu-ignore-default-archive-rules nil "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. Only the user unpacking commands will be consulted. Default is nil.") (defvar gnus-uu-kill-carriage-return t "*Non-nil means that gnus-uu will strip all carriage returns from articles. Default is t.") (defvar gnus-uu-view-with-metamail nil "*Non-nil means that files will be viewed with metamail. The gnus-uu viewing functions will be ignored and gnus-uu will try to guess at a content-type based on file name suffixes. Default it nil.") (defvar gnus-uu-unmark-articles-not-decoded nil "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. Default is nil.") (defvar gnus-uu-correct-stripped-uucode nil "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. Default is nil.") (defvar gnus-uu-save-in-digest nil "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. If this variable is nil, gnus-uu will just save everything in a file without any embellishments. The digesting almost conforms to RFC1153 - no easy way to specify any meaningful volume and issue numbers were found, so I simply dropped them.") (defvar gnus-uu-digest-headers '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" "^Summary:" "^References:") "*List of regexps to match headers included in digested messages. The headers will be included in the sequence they are matched.") (defvar gnus-uu-save-separate-articles nil "*Non-nil means that gnus-uu will save articles in separate files.") ;; Internal variables (defvar gnus-uu-saved-article-name nil) (defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") (defconst gnus-uu-end-string "^end[ \t]*$") (defconst gnus-uu-body-line "^M") (let ((i 61)) (while (> (setq i (1- i)) 0) (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]"))) (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$"))) ;"^M.............................................................?$" (defconst gnus-uu-shar-begin-string "^#! */bin/sh") (defvar gnus-uu-shar-file-name nil) (defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") (defconst gnus-uu-postscript-begin-string "^%!PS-") (defconst gnus-uu-postscript-end-string "^%%EOF$") (defvar gnus-uu-file-name nil) (defconst gnus-uu-uudecode-process nil) (defvar gnus-uu-binhex-article-name nil) (defvar gnus-uu-generated-file-list nil) (defvar gnus-uu-work-dir nil) (defconst gnus-uu-output-buffer-name " *Gnus UU Output*") (defvar gnus-uu-default-dir default-directory) ;; Keymaps (defvar gnus-uu-extract-map nil) (defvar gnus-uu-extract-view-map nil) (defvar gnus-uu-mark-map nil) (define-prefix-command 'gnus-uu-mark-map) (define-key gnus-summary-mark-map "P" 'gnus-uu-mark-map) (define-key gnus-uu-mark-map "p" 'gnus-summary-mark-as-processable) (define-key gnus-uu-mark-map "u" 'gnus-summary-unmark-as-processable) (define-key gnus-uu-mark-map "U" 'gnus-summary-unmark-all-processable) (define-key gnus-uu-mark-map "s" 'gnus-uu-mark-series) (define-key gnus-uu-mark-map "r" 'gnus-uu-mark-region) (define-key gnus-uu-mark-map "R" 'gnus-uu-mark-by-regexp) (define-key gnus-uu-mark-map "t" 'gnus-uu-mark-thread) (define-key gnus-uu-mark-map "a" 'gnus-uu-mark-all) (define-key gnus-uu-mark-map "S" 'gnus-uu-mark-sparse) (define-prefix-command 'gnus-uu-extract-map) (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map) ;;(define-key gnus-uu-extract-map "x" 'gnus-uu-extract-any) ;;(define-key gnus-uu-extract-map "m" 'gnus-uu-extract-mime) (define-key gnus-uu-extract-map "u" 'gnus-uu-decode-uu) (define-key gnus-uu-extract-map "U" 'gnus-uu-decode-uu-and-save) (define-key gnus-uu-extract-map "s" 'gnus-uu-decode-unshar) (define-key gnus-uu-extract-map "S" 'gnus-uu-decode-unshar-and-save) (define-key gnus-uu-extract-map "o" 'gnus-uu-decode-save) (define-key gnus-uu-extract-map "O" 'gnus-uu-decode-save) (define-key gnus-uu-extract-map "b" 'gnus-uu-decode-binhex) (define-key gnus-uu-extract-map "B" 'gnus-uu-decode-binhex) (define-key gnus-uu-extract-map "p" 'gnus-uu-decode-postscript) (define-key gnus-uu-extract-map "P" 'gnus-uu-decode-postscript-and-save) (define-prefix-command 'gnus-uu-extract-view-map) (define-key gnus-uu-extract-map "v" 'gnus-uu-extract-view-map) (define-key gnus-uu-extract-view-map "u" 'gnus-uu-decode-uu-view) (define-key gnus-uu-extract-view-map "U" 'gnus-uu-decode-uu-and-save-view) (define-key gnus-uu-extract-view-map "s" 'gnus-uu-decode-unshar-view) (define-key gnus-uu-extract-view-map "S" 'gnus-uu-decode-unshar-and-save-view) (define-key gnus-uu-extract-view-map "o" 'gnus-uu-decode-save-view) (define-key gnus-uu-extract-view-map "O" 'gnus-uu-decode-save-view) (define-key gnus-uu-extract-view-map "b" 'gnus-uu-decode-binhex-view) (define-key gnus-uu-extract-view-map "B" 'gnus-uu-decode-binhex-view) (define-key gnus-uu-extract-view-map "p" 'gnus-uu-decode-postscript-view) (define-key gnus-uu-extract-view-map "P" 'gnus-uu-decode-postscript-and-save-view) ;; Commands. (defun gnus-uu-decode-uu (n) "Uudecodes the current article." (interactive "P") (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n)) (defun gnus-uu-decode-uu-and-save (n dir) "Decodes and saves the resulting file." (interactive (list current-prefix-arg (file-name-as-directory (read-file-name "Uudecode and save in dir: " gnus-uu-default-dir gnus-uu-default-dir t)))) (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir)) (defun gnus-uu-decode-unshar (n) "Unshars the current article." (interactive "P") (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan)) (defun gnus-uu-decode-unshar-and-save (n dir) "Unshars and saves the current article." (interactive (list current-prefix-arg (file-name-as-directory (read-file-name "Unshar and save in dir: " gnus-uu-default-dir gnus-uu-default-dir t)))) (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan)) (defun gnus-uu-decode-save (n file) "Saves the current article." (interactive (list current-prefix-arg (read-file-name (if gnus-uu-save-separate-articles "Save articles is dir: " "Save articles in file: ") gnus-uu-default-dir gnus-uu-default-dir))) (setq gnus-uu-saved-article-name file) (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t) (setq gnus-uu-generated-file-list (delete file gnus-uu-generated-file-list))) (defun gnus-uu-decode-binhex (n dir) "Unbinhexes the current article." (interactive (list current-prefix-arg (file-name-as-directory (read-file-name "Unbinhex and save in dir: " gnus-uu-default-dir gnus-uu-default-dir)))) (setq gnus-uu-binhex-article-name (make-temp-name (concat gnus-uu-work-dir "binhex"))) (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) (defun gnus-uu-decode-uu-view (n) "Uudecodes and views the current article." (interactive "P") (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-uu n))) (defun gnus-uu-decode-uu-and-save-view (n dir) "Decodes, views and saves the resulting file." (interactive (list current-prefix-arg (read-file-name "Uudecode, view and save in dir: " gnus-uu-default-dir gnus-uu-default-dir t))) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-uu-and-save n dir))) (defun gnus-uu-decode-unshar-view (n) "Unshars and views the current article." (interactive "P") (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-unshar n))) (defun gnus-uu-decode-unshar-and-save-view (n dir) "Unshars and saves the current article." (interactive (list current-prefix-arg (read-file-name "Unshar, view and save in dir: " gnus-uu-default-dir gnus-uu-default-dir t))) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-unshar-and-save n dir))) (defun gnus-uu-decode-save-view (n file) "Saves and views the current article." (interactive (list current-prefix-arg (read-file-name (if gnus-uu-save-separate-articles "Save articles is dir: " "Save articles in file: ") gnus-uu-default-dir gnus-uu-default-dir))) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-save n file))) (defun gnus-uu-decode-binhex-view (n file) "Unbinhexes and views the current article." (interactive (list current-prefix-arg (read-file-name "Unbinhex, view and save in dir: " gnus-uu-default-dir gnus-uu-default-dir))) (setq gnus-uu-binhex-article-name (make-temp-name (concat gnus-uu-work-dir "binhex"))) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-binhex n file))) ;; Digest and forward articles (defun gnus-uu-digest-mail-forward (n &optional post) "Digests and forwards all articles in this series." (interactive "P") (let ((gnus-uu-save-in-digest t) (file (make-temp-name (concat gnus-uu-tmp-dir "forward"))) buf) (gnus-uu-decode-save n file) (gnus-uu-add-file file) (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*"))) (gnus-add-current-to-buffer-list) (erase-buffer) (delete-other-windows) (insert-file file) (goto-char (point-min)) (and (re-search-forward "^Subject: ") (progn (delete-region (point) (gnus-point-at-eol)) (insert "Digested Articles"))) (goto-char (point-min)) (and (re-search-forward "^From: ") (progn (delete-region (point) (gnus-point-at-eol)) (insert "Various"))) (if post (gnus-forward-using-post) (funcall gnus-mail-forward-method)) (delete-file file) (kill-buffer buf))) (defun gnus-uu-digest-post-forward (n) "Digest and forward to a newsgroup." (interactive "P") (gnus-uu-digest-mail-forward n t)) ;; Process marking. (defun gnus-uu-mark-by-regexp (regexp) "Ask for a regular expression and set the process mark on all articles that match." (interactive (list (read-from-minibuffer "Mark (regexp): "))) (gnus-set-global-variables) (let ((articles (gnus-uu-find-articles-matching regexp))) (while articles (gnus-summary-set-process-mark (car articles)) (setq articles (cdr articles))) (message "")) (gnus-summary-position-cursor)) (defun gnus-uu-mark-series () "Mark the current series with the process mark." (interactive) (gnus-set-global-variables) (let ((articles (gnus-uu-find-articles-matching))) (while articles (gnus-summary-set-process-mark (car articles)) (setq articles (cdr articles))) (message "")) (gnus-summary-position-cursor)) (defun gnus-uu-mark-region (beg end) "Marks all articles between point and mark." (interactive "r") (gnus-set-global-variables) (save-excursion (goto-char beg) (while (< (point) end) (gnus-summary-set-process-mark (gnus-summary-article-number)) (forward-line 1))) (gnus-summary-position-cursor)) (defun gnus-uu-mark-thread () "Marks all articles downwards in this thread." (interactive) (gnus-set-global-variables) (let ((level (gnus-summary-thread-level))) (while (and (gnus-summary-set-process-mark (gnus-summary-article-number)) (zerop (gnus-summary-next-subject 1)) (> (gnus-summary-thread-level) level)))) (gnus-summary-position-cursor)) (defun gnus-uu-mark-sparse () "Mark all series that have some articles marked." (interactive) (gnus-set-global-variables) (let ((marked (nreverse gnus-newsgroup-processable)) subject articles total headers) (or marked (error "No articles marked with the process mark")) (setq gnus-newsgroup-processable nil) (save-excursion (while marked (and (setq headers (gnus-get-header-by-number (car marked))) (setq subject (mail-header-subject headers) articles (gnus-uu-find-articles-matching (gnus-uu-reginize-string subject)) total (nconc total articles))) (while articles (gnus-summary-set-process-mark (car articles)) (setcdr marked (delq (car articles) (cdr marked))) (setq articles (cdr articles))) (setq marked (cdr marked))) (setq gnus-newsgroup-processable (nreverse total))) (gnus-summary-position-cursor))) (defun gnus-uu-mark-all () "Mark all articles in \"series\" order." (interactive) (gnus-set-global-variables) (setq gnus-newsgroup-processable nil) (save-excursion (goto-char (point-min)) (let (number) (while (and (not (eobp)) (setq number (gnus-summary-article-number))) (if (not (memq number gnus-newsgroup-processable)) (save-excursion (gnus-uu-mark-series))) (forward-line 1)))) (gnus-summary-position-cursor)) ;; All PostScript functions written by Erik Selberg . (defun gnus-uu-decode-postscript (n) "Gets postscript of the current article." (interactive "P") (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n)) (defun gnus-uu-decode-postscript-view (n) "Gets and views the current article." (interactive "P") (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-postscript n))) (defun gnus-uu-decode-postscript-and-save (n dir) "Extracts postscript and saves the current article." (interactive (list current-prefix-arg (file-name-as-directory (read-file-name "Save in dir: " gnus-uu-default-dir gnus-uu-default-dir t)))) (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n dir)) (defun gnus-uu-decode-postscript-and-save-view (n dir) "Decodes, views and saves the resulting file." (interactive (list current-prefix-arg (read-file-name "Where do you want to save the file(s)? " gnus-uu-default-dir gnus-uu-default-dir t))) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-postscript-and-save n dir))) ;; Internal functions. (defun gnus-uu-decode-with-method (method n &optional save not-insert scan) (gnus-uu-initialize scan) (if save (setq gnus-uu-default-dir save)) (let ((articles (gnus-uu-get-list-of-articles n)) files) (setq files (gnus-uu-grab-articles articles method t)) (let ((gnus-current-article (car articles))) (and scan (setq files (gnus-uu-scan-directory gnus-uu-work-dir)))) (and save (gnus-uu-save-files files save)) (setq files (gnus-uu-unpack-files files)) (gnus-uu-add-file (mapcar (lambda (file) (cdr (assq 'name file))) files)) (setq files (nreverse (gnus-uu-get-actions files))) (or not-insert (gnus-summary-insert-pseudos files save)))) ;; Return a list of files in dir. (defun gnus-uu-scan-directory (dir) (let ((files (directory-files dir t)) dirs out) (while files (cond ((string-match "/\\.\\.?$" (car files))) ((file-directory-p (car files)) (setq dirs (cons (car files) dirs))) (t (setq out (cons (list (cons 'name (car files)) (cons 'article gnus-current-article)) out)))) (setq files (cdr files))) (apply 'nconc out (mapcar (lambda (d) (gnus-uu-scan-directory d)) dirs)))) (defun gnus-uu-save-files (files dir) (let ((len (length files)) to-file file) (while files (and (setq file (cdr (assq 'name (car files)))) (file-exists-p file) (progn (setq to-file (if (file-directory-p dir) (concat dir (file-name-nondirectory file)) dir)) (and (or (not (file-exists-p to-file)) (gnus-y-or-n-p (format "%s exists; overwrite? " to-file))) (copy-file file to-file t t)))) (setq files (cdr files))) (message "Saved %d file%s" len (if (> len 1) "s" "")))) ;; Functions for saving and possibly digesting articles without ;; any decoding. ;; Function called by gnus-uu-grab-articles to treat each article. (defun gnus-uu-save-article (buffer in-state) (cond (gnus-uu-save-separate-articles (save-excursion (set-buffer buffer) (write-region 1 (point-max) (concat gnus-uu-saved-article-name gnus-current-article)) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) ((eq in-state 'last) (list 'end)) (t (list 'middle))))) ((not gnus-uu-save-in-digest) (save-excursion (set-buffer buffer) (write-region 1 (point-max) gnus-uu-saved-article-name t) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) ((eq in-state 'last) (list 'end)) (t (list 'middle))))) (t (let ((name (file-name-nondirectory gnus-uu-saved-article-name)) beg subj headers headline sorthead body end-string state) (if (or (eq in-state 'first) (eq in-state 'first-and-last)) (progn (setq state (list 'begin)) (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*")) (erase-buffer)) (save-excursion (set-buffer (get-buffer-create "*gnus-uu-pre*")) (erase-buffer) (insert (format "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" (current-time-string) name name)))) (if (not (eq in-state 'end)) (setq state (list 'middle)))) (save-excursion (set-buffer (get-buffer "*gnus-uu-body*")) (goto-char (setq beg (point-max))) (save-excursion (save-restriction (set-buffer buffer) (let (buffer-read-only) (set-text-properties (point-min) (point-max) nil) ;; These two are necessary for XEmacs 19.12 fascism. (put-text-property (point-min) (point-max) 'invisible nil) (put-text-property (point-min) (point-max) 'intangible nil)) (goto-char (point-min)) (re-search-forward "\n\n") (setq body (buffer-substring (1- (point)) (point-max))) (narrow-to-region 1 (point)) (if (not (setq headers gnus-uu-digest-headers)) (setq sorthead (buffer-substring (point-min) (point-max))) (while headers (setq headline (car headers)) (setq headers (cdr headers)) (goto-char (point-min)) (if (re-search-forward headline nil t) (setq sorthead (concat sorthead (buffer-substring (match-beginning 0) (or (and (re-search-forward "^[^ \t]" nil t) (1- (point))) (progn (forward-line 1) (point))))))))) (widen))) (insert sorthead)(goto-char (point-max)) (insert body)(goto-char (point-max)) (insert (concat "\n" (make-string 30 ?-) "\n\n")) (goto-char beg) (if (re-search-forward "^Subject: \\(.*\\)$" nil t) (progn (setq subj (buffer-substring (match-beginning 1) (match-end 1))) (save-excursion (set-buffer (get-buffer "*gnus-uu-pre*")) (insert (format " %s\n" subj)))))) (if (or (eq in-state 'last) (eq in-state 'first-and-last)) (progn (save-excursion (set-buffer (get-buffer "*gnus-uu-pre*")) (insert (format "\n\n%s\n\n" (make-string 70 ?-))) (write-region 1 (point-max) gnus-uu-saved-article-name)) (save-excursion (set-buffer (get-buffer "*gnus-uu-body*")) (goto-char (point-max)) (insert (concat (setq end-string (format "End of %s Digest" name)) "\n")) (insert (concat (make-string (length end-string) ?*) "\n")) (write-region 1 (point-max) gnus-uu-saved-article-name t)) (kill-buffer (get-buffer "*gnus-uu-pre*")) (kill-buffer (get-buffer "*gnus-uu-body*")) (setq state (cons 'end state)))) (if (memq 'begin state) (cons gnus-uu-saved-article-name state) state))))) ;; Binhex treatment - not very advanced. (defconst gnus-uu-binhex-body-line "^[^:]...............................................................$") (defconst gnus-uu-binhex-begin-line "^:...............................................................$") (defconst gnus-uu-binhex-end-line ":$") (defun gnus-uu-binhex-article (buffer in-state) (let (state start-char) (save-excursion (set-buffer buffer) (widen) (goto-char (point-min)) (if (not (re-search-forward gnus-uu-binhex-begin-line nil t)) (if (not (re-search-forward gnus-uu-binhex-body-line nil t)) (setq state (list 'wrong-type)))) (if (memq 'wrong-type state) () (beginning-of-line) (setq start-char (point)) (if (looking-at gnus-uu-binhex-begin-line) (progn (setq state (list 'begin)) (write-region 1 1 gnus-uu-binhex-article-name)) (setq state (list 'middle))) (goto-char (point-max)) (re-search-backward (concat gnus-uu-binhex-body-line "\\|" gnus-uu-binhex-end-line) nil t) (if (looking-at gnus-uu-binhex-end-line) (setq state (if (memq 'begin state) (cons 'end state) (list 'end)))) (beginning-of-line) (forward-line 1) (if (file-exists-p gnus-uu-binhex-article-name) (append-to-file start-char (point) gnus-uu-binhex-article-name)))) (if (memq 'begin state) (cons gnus-uu-binhex-article-name state) state))) ;; PostScript (defun gnus-uu-decode-postscript-article (process-buffer in-state) (let ((state (list 'ok)) start-char end-char file-name) (save-excursion (set-buffer process-buffer) (goto-char (point-min)) (if (not (re-search-forward gnus-uu-postscript-begin-string nil t)) (setq state (list 'wrong-type)) (beginning-of-line) (setq start-char (point)) (if (not (re-search-forward gnus-uu-postscript-end-string nil t)) (setq state (list 'wrong-type)) (setq end-char (point)) (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) (insert-buffer-substring process-buffer start-char end-char) (setq file-name (concat gnus-uu-work-dir (cdr gnus-article-current) ".ps")) (write-region (point-min) (point-max) file-name) (setq state (list file-name'begin 'end)) )) ) state)) ;; Find actions. (defun gnus-uu-get-actions (files) (let ((ofiles files) action name) (while files (setq name (cdr (assq 'name (car files)))) (and (setq action (gnus-uu-get-action name)) (setcar files (nconc (list (if (string= action "gnus-uu-archive") (cons 'action "file") (cons 'action action)) (cons 'execute (if (string-match "%" action) (format action name) (concat action " " name)))) (car files)))) (setq files (cdr files))) ofiles)) (defun gnus-uu-get-action (file-name) (let (action) (setq action (gnus-uu-choose-action file-name (append gnus-uu-user-view-rules (if gnus-uu-ignore-default-view-rules nil gnus-uu-default-view-rules) gnus-uu-user-view-rules-end))) (if (and (not (string= (or action "") "gnus-uu-archive")) gnus-uu-view-with-metamail) (if (setq action (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) (setq action (format "metamail -d -b -c \"%s\"" action)))) action)) ;; Functions for treating subjects and collecting series. (defun gnus-uu-reginize-string (string) ;; Takes a string and puts a \ in front of every special character; ;; ignores any leading "version numbers" thingies that they use in ;; the comp.binaries groups, and either replaces anything that looks ;; like "2/3" with "[0-9]+/[0-9]+" or, if it can't find something ;; like that, replaces the last two numbers with "[0-9]+". This, in ;; my experience, should get most postings of a series. (let ((count 2) (vernum "v[0-9]+[a-z][0-9]+:") beg) (save-excursion (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert (regexp-quote string)) (setq beg 1) (setq case-fold-search nil) (goto-char (point-min)) (if (looking-at vernum) (progn (replace-match vernum t t) (setq beg (length vernum)))) (goto-char beg) (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t) (replace-match " [0-9]+/[0-9]+") (goto-char beg) (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t) (replace-match "[0-9]+ of [0-9]+") (end-of-line) (while (and (re-search-backward "[0-9]" nil t) (> count 0)) (while (and (looking-at "[0-9]") (< 1 (goto-char (1- (point)))))) (re-search-forward "[0-9]+" nil t) (replace-match "[0-9]+") (backward-char 5) (setq count (1- count))))) (goto-char beg) (while (re-search-forward "[ \t]+" nil t) (replace-match "[ \t]*" t t)) (buffer-substring 1 (point-max))))) (defun gnus-uu-get-list-of-articles (n) ;; If N is non-nil, the article numbers of the N next articles ;; will be returned. ;; If any articles have been marked as processable, they will be ;; returned. ;; Failing that, articles that have subjects that are part of the ;; same "series" as the current will be returned. (let (articles) (cond (n (let ((backward (< n 0)) (n (abs n))) (save-excursion (while (and (> n 0) (setq articles (cons (gnus-summary-article-number) articles)) (gnus-summary-search-forward nil nil backward)) (setq n (1- n)))) (nreverse articles))) (gnus-newsgroup-processable (reverse gnus-newsgroup-processable)) (t (gnus-uu-find-articles-matching))))) (defun gnus-uu-string< (l1 l2) (string< (car l1) (car l2))) (defun gnus-uu-find-articles-matching (&optional subject only-unread do-not-translate) ;; Finds all articles that matches the regexp SUBJECT. If it is ;; nil, the current article name will be used. If ONLY-UNREAD is ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is ;; non-nil, article names are not equalized before sorting. (let ((subject (or subject (gnus-uu-reginize-string (gnus-summary-subject-string)))) list-of-subjects) (save-excursion (if (not subject) () ;; Collect all subjects matching subject. (let ((case-fold-search t) subj mark) (goto-char (point-min)) (while (not (eobp)) (and (setq subj (gnus-summary-subject-string)) (string-match subject subj) (or (not only-unread) (= (setq mark (gnus-summary-article-mark)) gnus-unread-mark) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)) (setq list-of-subjects (cons (cons subj (gnus-summary-article-number)) list-of-subjects))) (forward-line 1))) ;; Expand numbers, sort, and return the list of article ;; numbers. (mapcar (lambda (sub) (cdr sub)) (sort (gnus-uu-expand-numbers list-of-subjects (not do-not-translate)) 'gnus-uu-string<)))))) (defun gnus-uu-expand-numbers (string-list &optional translate) ;; Takes a list of strings and "expands" all numbers in all the ;; strings. That is, this function makes all numbers equal length by ;; prepending lots of zeroes before each number. This is to ease later ;; sorting to find out what sequence the articles are supposed to be ;; decoded in. Returns the list of expanded strings. (let ((out-list string-list) string) (save-excursion (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) (buffer-disable-undo (current-buffer)) (while string-list (erase-buffer) (insert (car (car string-list))) ;; Translate multiple spaces to one space. (goto-char (point-min)) (while (re-search-forward "[ \t]+" nil t) (replace-match " ")) ;; Translate all characters to "a". (goto-char (point-min)) (if translate (while (re-search-forward "[A-Za-z]" nil t) (replace-match "a" t t))) ;; Expand numbers. (goto-char (point-min)) (while (re-search-forward "[0-9]+" nil t) (replace-match (format "%06d" (string-to-int (buffer-substring (match-beginning 0) (match-end 0)))))) (setq string (buffer-substring 1 (point-max))) (setcar (car string-list) string) (setq string-list (cdr string-list)))) out-list)) ;; `gnus-uu-grab-articles' is the general multi-article treatment ;; function. It takes a list of articles to be grabbed and a function ;; to apply to each article. ;; ;; The function to be called should take two parameters. The first ;; parameter is the article buffer. The function should leave the ;; result, if any, in this buffer. Most treatment functions will just ;; generate files... ;; ;; The second parameter is the state of the list of articles, and can ;; have four values: `first', `middle', `last' and `first-and-last'. ;; ;; The function should return a list. The list may contain the ;; following symbols: ;; `error' if an error occurred ;; `begin' if the beginning of an encoded file has been received ;; If the list returned contains a `begin', the first element of ;; the list *must* be a string with the file name of the decoded ;; file. ;; `end' if the the end of an encoded file has been received ;; `middle' if the article was a body part of an encoded file ;; `wrong-type' if the article was not a part of an encoded file ;; `ok', which can be used everything is ok (defvar gnus-uu-has-been-grabbed nil) (defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article) (let (art) (if (not (and gnus-uu-has-been-grabbed gnus-uu-unmark-articles-not-decoded)) () (if dont-unmark-last-article (progn (setq art (car gnus-uu-has-been-grabbed)) (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))) (while gnus-uu-has-been-grabbed (gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t) (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) (if dont-unmark-last-article (setq gnus-uu-has-been-grabbed (list art)))))) ;; This function takes a list of articles and a function to apply to ;; each article grabbed. ;; ;; This function returns a list of files decoded if the grabbing and ;; the process-function has been successful and nil otherwise. (defun gnus-uu-grab-articles (articles process-function &optional sloppy limit no-errors) (let ((state 'first) has-been-begin article result-file result-files process-state article-buffer) (if (not (gnus-server-opened gnus-current-select-method)) (progn (gnus-start-news-server) (gnus-request-group gnus-newsgroup-name))) (setq gnus-uu-has-been-grabbed nil) (while (and articles (not (memq 'error process-state)) (or sloppy (not (memq 'end process-state)))) (setq article (car articles)) (setq articles (cdr articles)) (setq gnus-uu-has-been-grabbed (cons article gnus-uu-has-been-grabbed)) (if (eq articles ()) (if (eq state 'first) (setq state 'first-and-last) (setq state 'last))) (message "Getting article %d, %s" article (gnus-uu-part-number article)) (if (not (= (or gnus-current-article 0) article)) (let ((nntp-async-number nil)) (gnus-request-article article gnus-newsgroup-name nntp-server-buffer) (setq gnus-last-article gnus-current-article) (setq gnus-current-article article) (setq gnus-article-current (cons gnus-newsgroup-name article)) (if (stringp nntp-server-buffer) (setq article-buffer nntp-server-buffer) (setq article-buffer (buffer-name nntp-server-buffer)))) (gnus-summary-stop-page-breaking) (setq article-buffer gnus-article-buffer)) (buffer-disable-undo article-buffer) ;; Mark article as read. (and (memq article gnus-newsgroup-processable) (gnus-summary-remove-process-mark article)) (run-hooks 'gnus-mark-article-hook) (setq process-state (funcall process-function article-buffer state)) (if (or (memq 'begin process-state) (and (or (eq state 'first) (eq state 'first-and-last)) (memq 'ok process-state))) (progn (if has-been-begin (if (and result-file (file-exists-p result-file)) (delete-file result-file))) (if (memq 'begin process-state) (setq result-file (car process-state))) (setq has-been-begin t))) (if (memq 'end process-state) (progn (setq gnus-uu-has-been-grabbed nil) (setq result-files (cons (list (cons 'name result-file) (cons 'article article)) result-files)) (setq has-been-begin nil) (and limit (= (length result-files) limit) (setq articles nil)))) (if (and (or (eq state 'last) (eq state 'first-and-last)) (not (memq 'end process-state))) (if (and result-file (file-exists-p result-file)) (delete-file result-file))) (if (not (memq 'wrong-type process-state)) () (if gnus-uu-unmark-articles-not-decoded (gnus-summary-tick-article article t))) (if (and (not has-been-begin) (not sloppy) (or (memq 'end process-state) (memq 'middle process-state))) (progn (setq process-state (list 'error)) (message "No begin part at the beginning") (sleep-for 2)) (setq state 'middle))) ;; Make sure the last article is put in the article buffer & fix ;; windows etc. (if (not (string= article-buffer gnus-article-buffer)) (save-excursion (set-buffer (get-buffer-create gnus-article-buffer)) (let ((buffer-read-only nil)) (widen) (erase-buffer) (insert-buffer-substring article-buffer) (gnus-set-mode-line 'article) (goto-char (point-min))))) (gnus-set-mode-line 'summary) (if result-files () (if (not has-been-begin) (if (not no-errors) (message "Wrong type file")) (if (memq 'error process-state) (setq result-files nil) (if (not (or (memq 'ok process-state) (memq 'end process-state))) (progn (if (not no-errors) (message "End of articles reached before end of file")) (setq result-files nil)) (gnus-uu-unmark-list-of-grabbed))))) result-files)) (defun gnus-uu-part-number (article) (let ((subject (mail-header-subject (gnus-get-header-by-number article)))) (if (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject) (substring subject (match-beginning 0) (match-end 0)) ""))) (defun gnus-uu-uudecode-sentinel (process event) (delete-process (get-process process))) (defun gnus-uu-uustrip-article (process-buffer in-state) ;; Uudecodes a file asynchronously. (let ((state (list 'ok)) (process-connection-type nil) start-char pst name-beg name-end) (save-excursion (set-buffer process-buffer) (let ((case-fold-search nil) (buffer-read-only nil)) (goto-char (point-min)) (if gnus-uu-kill-carriage-return (progn (while (search-forward "\r" nil t) (delete-backward-char 1)) (goto-char (point-min)))) (if (not (re-search-forward gnus-uu-begin-string nil t)) (if (not (re-search-forward gnus-uu-body-line nil t)) (setq state (list 'wrong-type)))) (if (memq 'wrong-type state) () (beginning-of-line) (setq start-char (point)) (if (looking-at gnus-uu-begin-string) (progn (setq name-end (match-end 1) name-beg (match-beginning 1)) ;; Remove any non gnus-uu-body-line right after start. (forward-line 1) (or (looking-at gnus-uu-body-line) (gnus-delete-line)) ; Replace any slashes and spaces in file names before decoding (goto-char name-beg) (while (re-search-forward "/" name-end t) (replace-match ",")) (goto-char name-beg) (while (re-search-forward " " name-end t) (replace-match "_")) (goto-char name-beg) (if (re-search-forward "_*$" name-end t) (replace-match "")) (setq gnus-uu-file-name (buffer-substring name-beg name-end)) (and gnus-uu-uudecode-process (setq pst (process-status (or gnus-uu-uudecode-process "nevair"))) (if (or (eq pst 'stop) (eq pst 'run)) (progn (delete-process gnus-uu-uudecode-process) (gnus-uu-unmark-list-of-grabbed t)))) (if (get-process "*uudecode*") (delete-process "*uudecode*")) (setq gnus-uu-uudecode-process (start-process "*uudecode*" (get-buffer-create gnus-uu-output-buffer-name) "sh" "-c" (format "cd %s ; uudecode" gnus-uu-work-dir))) (set-process-sentinel gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) (setq state (list 'begin)) (gnus-uu-add-file (concat gnus-uu-work-dir gnus-uu-file-name))) (setq state (list 'middle))) (goto-char (point-max)) (re-search-backward (concat gnus-uu-body-line "\\|" gnus-uu-end-string) nil t) (beginning-of-line) (if (looking-at gnus-uu-end-string) (setq state (cons 'end state))) (forward-line 1) (and gnus-uu-uudecode-process (setq pst (process-status (or gnus-uu-uudecode-process "nevair"))) (if (or (eq pst 'run) (eq pst 'stop)) (progn (if gnus-uu-correct-stripped-uucode (progn (gnus-uu-check-correct-stripped-uucode start-char (point)) (goto-char (point-max)) (re-search-backward (concat gnus-uu-body-line "\\|" gnus-uu-end-string) nil t) (forward-line 1))) (condition-case nil (process-send-region gnus-uu-uudecode-process start-char (point)) (error (progn (delete-process gnus-uu-uudecode-process) (message "gnus-uu: Couldn't uudecode") ; (sleep-for 2) (setq state (list 'wrong-type))))) (if (memq 'end state) (accept-process-output gnus-uu-uudecode-process))) (setq state (list 'wrong-type)))) (if (not gnus-uu-uudecode-process) (setq state (list 'wrong-type))))) (if (memq 'begin state) (cons (concat gnus-uu-work-dir gnus-uu-file-name) state) state)))) ;; This function is used by `gnus-uu-grab-articles' to treat ;; a shared article. (defun gnus-uu-unshar-article (process-buffer in-state) (let ((state (list 'ok)) start-char) (save-excursion (set-buffer process-buffer) (goto-char (point-min)) (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) (setq state (list 'wrong-type)) (beginning-of-line) (setq start-char (point)) (call-process-region start-char (point-max) "sh" nil (get-buffer-create gnus-uu-output-buffer-name) nil "-c" (concat "cd " gnus-uu-work-dir " ; sh")))) state)) ;; Returns the name of what the shar file is going to unpack. (defun gnus-uu-find-name-in-shar () (let ((oldpoint (point)) res) (goto-char (point-min)) (if (re-search-forward gnus-uu-shar-name-marker nil t) (setq res (buffer-substring (match-beginning 1) (match-end 1)))) (goto-char oldpoint) res)) ;; `gnus-uu-choose-action' chooses what action to perform given the name ;; and `gnus-uu-file-action-list'. Returns either nil if no action is ;; found, or the name of the command to run if such a rule is found. (defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore) (let ((action-list (copy-sequence file-action-list)) (case-fold-search t) rule action) (and (or no-ignore (and (not (and gnus-uu-ignore-files-by-name (string-match gnus-uu-ignore-files-by-name file-name))) (not (and gnus-uu-ignore-files-by-type (string-match gnus-uu-ignore-files-by-type (or (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list t) "")))))) (while (not (or (eq action-list ()) action)) (setq rule (car action-list)) (setq action-list (cdr action-list)) (if (string-match (car rule) file-name) (setq action (car (cdr rule)))))) action)) (defun gnus-uu-treat-archive (file-path) ;; Unpacks an archive. Returns t if unpacking is successful. (let ((did-unpack t) action command dir) (setq action (gnus-uu-choose-action file-path (append gnus-uu-user-archive-rules (if gnus-uu-ignore-default-archive-rules nil gnus-uu-default-archive-rules)))) (if (not action) (error "No unpackers for the file %s" file-path)) (string-match "/[^/]*$" file-path) (setq dir (substring file-path 0 (match-beginning 0))) (if (member action gnus-uu-destructive-archivers) (copy-file file-path (concat file-path "~") t)) (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) (save-excursion (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) (erase-buffer)) (message "Unpacking: %s..." (gnus-uu-command action file-path)) (if (= 0 (call-process "sh" nil (get-buffer-create gnus-uu-output-buffer-name) nil "-c" command)) (message "") (message "Error during unpacking of archive") (setq did-unpack nil)) (if (member action gnus-uu-destructive-archivers) (rename-file (concat file-path "~") file-path t)) did-unpack)) (defun gnus-uu-dir-files (dir) (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$")) files file) (while dirs (if (file-directory-p (setq file (car dirs))) (setq files (append files (gnus-uu-dir-files file))) (setq files (cons file files))) (setq dirs (cdr dirs))) files)) (defun gnus-uu-unpack-files (files &optional ignore) ;; Go through FILES and look for files to unpack. (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) (ofiles files) file did-unpack file-entry) (gnus-uu-add-file totfiles) (while files (setq file (cdr (setq file-entry (assq 'name (car files))))) (if (and (not (member file ignore)) (equal (gnus-uu-get-action (file-name-nondirectory file)) "gnus-uu-archive")) (progn (setq did-unpack (cons file did-unpack)) (or (gnus-uu-treat-archive file) (message "Error during unpacking of %s" file)) (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir)) (nfiles newfiles)) (gnus-uu-add-file newfiles) (while nfiles (or (member (car nfiles) totfiles) (setq ofiles (cons (list (cons 'name (car nfiles)) (cons 'original file)) ofiles))) (setq nfiles (cdr nfiles))) (setq totfiles newfiles)))) (setq files (cdr files))) (if did-unpack (gnus-uu-unpack-files ofiles (append did-unpack ignore)) ofiles))) (defun gnus-uu-ls-r (dir) (let* ((files (gnus-uu-directory-files dir t)) (ofiles files)) (while files (if (file-directory-p (car files)) (progn (setq ofiles (delete (car files) ofiles)) (setq ofiles (append ofiles (gnus-uu-ls-r (car files)))))) (setq files (cdr files))) ofiles)) ;; Various stuff (defun gnus-uu-directory-files (dir &optional full) (let (files out file) (setq files (directory-files dir full)) (while files (setq file (car files)) (setq files (cdr files)) (or (string-match "/\\.\\.?$" file) (setq out (cons file out)))) (setq out (nreverse out)) out)) (defun gnus-uu-check-correct-stripped-uucode (start end) (let (found beg length) (if (not gnus-uu-correct-stripped-uucode) () (goto-char start) (if (re-search-forward " \\|`" end t) (progn (goto-char start) (while (not (eobp)) (progn (if (looking-at "\n") (replace-match "")) (forward-line 1)))) (while (not (eobp)) (if (looking-at (concat gnus-uu-begin-string "\\|" gnus-uu-end-string)) () (if (not found) (progn (beginning-of-line) (setq beg (point)) (end-of-line) (setq length (- (point) beg)))) (setq found t) (beginning-of-line) (setq beg (point)) (end-of-line) (if (not (= length (- (point) beg))) (insert (make-string (- length (- (point) beg)) ? )))) (forward-line 1)))))) (defvar gnus-uu-tmp-alist nil) (defun gnus-uu-initialize (&optional scan) (let (entry) (if (and (not scan) (if (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist)) (if (file-exists-p (cdr entry)) (setq gnus-uu-work-dir (cdr entry)) (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) nil))) t (setq gnus-uu-tmp-dir (file-name-as-directory (expand-file-name gnus-uu-tmp-dir))) (if (not (file-directory-p gnus-uu-tmp-dir)) (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) (if (not (file-writable-p gnus-uu-tmp-dir)) (error "Temp directory %s can't be written to" gnus-uu-tmp-dir))) (setq gnus-uu-work-dir (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) (gnus-uu-add-file gnus-uu-work-dir) (if (not (file-directory-p gnus-uu-work-dir)) (gnus-make-directory gnus-uu-work-dir)) (set-file-modes gnus-uu-work-dir 448) (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) (setq gnus-uu-tmp-alist (cons (cons gnus-newsgroup-name gnus-uu-work-dir) gnus-uu-tmp-alist))))) ;; Kills the temporary uu buffers, kills any processes, etc. (defun gnus-uu-clean-up () (let (buf pst) (and gnus-uu-uudecode-process (setq pst (process-status (or gnus-uu-uudecode-process "nevair"))) (if (or (eq pst 'stop) (eq pst 'run)) (delete-process gnus-uu-uudecode-process))) (and (setq buf (get-buffer gnus-uu-output-buffer-name)) (kill-buffer buf)))) ;; `gnus-uu-check-for-generated-files' deletes any generated files that ;; hasn't been deleted, if, for instance, the user terminated decoding ;; with `C-g'. (defun gnus-uu-check-for-generated-files () (let (file dirs) (while gnus-uu-generated-file-list (setq file (car gnus-uu-generated-file-list)) (setq gnus-uu-generated-file-list (cdr gnus-uu-generated-file-list)) (if (not (string-match "/\\.[\\.]?$" file)) (progn (if (file-directory-p file) (setq dirs (cons file dirs)) (if (file-exists-p file) (delete-file file)))))) (setq dirs (nreverse dirs)) (while dirs (setq file (car dirs)) (setq dirs (cdr dirs)) (if (file-directory-p file) (if (string-match "/$" file) (delete-directory (substring file 0 (match-beginning 0))) (delete-directory file)))))) ;; Add a file (or a list of files) to be checked (and deleted if it/they ;; still exists upon exiting the newsgroup). (defun gnus-uu-add-file (file) (if (stringp file) (setq gnus-uu-generated-file-list (cons file gnus-uu-generated-file-list)) (setq gnus-uu-generated-file-list (append file gnus-uu-generated-file-list)))) ;; Inputs an action and a file and returns a full command, putting ;; quotes round the file name and escaping any quotes in the file name. (defun gnus-uu-command (action file) (let ((ofile "")) (while (string-match "!\\|`\\|\"\\|\\$\\|\\\\\\|&" file) (progn (setq ofile (concat ofile (substring file 0 (match-beginning 0)) "\\" (substring file (match-beginning 0) (match-end 0)))) (setq file (substring file (1+ (match-beginning 0)))))) (setq ofile (concat "\"" ofile file "\"")) (if (string-match "%s" action) (format action ofile) (concat action " " ofile)))) ;; Initializing (add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up) (add-hook 'gnus-exit-group-hook 'gnus-uu-check-for-generated-files) ;;; ;;; uuencoded posting ;;; (require 'sendmail) (require 'rnews) ;; Any function that is to be used as and encoding method will take two ;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg" ;; and "spiral.jpg", respectively.) The function should return nil if ;; the encoding wasn't successful. (defvar gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode "Function used for encoding binary files. There are three functions supplied with gnus-uu for encoding files: `gnus-uu-post-encode-uuencode', which does straight uuencoding; `gnus-uu-post-encode-mime', which encodes with base64 and adds MIME headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with uuencode and adds MIME headers.") (defvar gnus-uu-post-include-before-composing nil "Non-nil means that gnus-uu will ask for a file to encode before you compose the article. If this variable is t, you can either include an encoded file with \\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article.") (defvar gnus-uu-post-length 990 "Maximum length of an article. The encoded file will be split into how many articles it takes to post the entire file.") (defvar gnus-uu-post-threaded nil "Non-nil means that gnus-uu will post the encoded file in a thread. This may not be smart, as no other decoder I have seen are able to follow threads when collecting uuencoded articles. (Well, I have seen one package that does that - gnus-uu, but somehow, I don't think that counts...) Default is nil.") (defvar gnus-uu-post-separate-description t "Non-nil means that the description will be posted in a separate article. The first article will typically be numbered (0/x). If this variable is nil, the description the user enters will be included at the beginning of the first article, which will be numbered (1/x). Default is t.") (defvar gnus-uu-post-binary-separator "--binary follows this line--") (defvar gnus-uu-post-message-id nil) (defvar gnus-uu-post-inserted-file-name nil) (defvar gnus-uu-winconf-post-news nil) (defun gnus-uu-post-news () "Compose an article and post an encoded file." (interactive) (setq gnus-uu-post-inserted-file-name nil) (setq gnus-uu-winconf-post-news (current-window-configuration)) (gnus-summary-post-news) (use-local-map (copy-keymap (current-local-map))) (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) (if gnus-uu-post-include-before-composing (save-excursion (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary))))) (defun gnus-uu-post-insert-binary-in-article () "Inserts an encoded file in the buffer. The user will be asked for a file name." (interactive) (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer))) (error "Not in post-news buffer")) (save-excursion (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) ;; Encodes with uuencode and substitutes all spaces with backticks. (defun gnus-uu-post-encode-uuencode (path file-name) (if (gnus-uu-post-encode-file "uuencode" path file-name) (progn (goto-char (point-min)) (forward-line 1) (while (re-search-forward " " nil t) (replace-match "`")) t))) ;; Encodes with uuencode and adds MIME headers. (defun gnus-uu-post-encode-mime-uuencode (path file-name) (if (gnus-uu-post-encode-uuencode path file-name) (progn (gnus-uu-post-make-mime file-name "x-uue") t))) ;; Encodes with base64 and adds MIME headers (defun gnus-uu-post-encode-mime (path file-name) (if (gnus-uu-post-encode-file "mmencode" path file-name) (progn (gnus-uu-post-make-mime file-name "base64") t))) ;; Adds MIME headers. (defun gnus-uu-post-make-mime (file-name encoding) (goto-char (point-min)) (insert (format "Content-Type: %s; name=\"%s\"\n" (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) file-name)) (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) (save-restriction (set-buffer gnus-post-news-buffer) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line -1) (narrow-to-region 1 (point)) (or (mail-fetch-field "mime-version") (progn (widen) (insert "MIME-Version: 1.0\n"))) (widen))) ;; Encodes a file PATH with COMMAND, leaving the result in the ;; current buffer. (defun gnus-uu-post-encode-file (command path file-name) (= 0 (call-process "sh" nil t nil "-c" (format "%s %s %s" command path file-name)))) (defun gnus-uu-post-news-inews () "Posts the composed news article and encoded file. If no file has been included, the user will be asked for a file." (interactive) (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer))) (error "Not in post news buffer")) (let (file-name) (if gnus-uu-post-inserted-file-name (setq file-name gnus-uu-post-inserted-file-name) (setq file-name (gnus-uu-post-insert-binary))) (if gnus-uu-post-threaded (let ((gnus-required-headers (if (memq 'Message-ID gnus-required-headers) gnus-required-headers (cons 'Message-ID gnus-required-headers))) gnus-inews-article-hook) (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook) gnus-inews-article-hook (list gnus-inews-article-hook))) (setq gnus-inews-article-hook (cons '(lambda () (save-excursion (goto-char (point-min)) (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t) (setq gnus-uu-post-message-id (buffer-substring (match-beginning 1) (match-end 1))) (setq gnus-uu-post-message-id nil)))) gnus-inews-article-hook)) (gnus-uu-post-encoded file-name t)) (gnus-uu-post-encoded file-name nil))) (setq gnus-uu-post-inserted-file-name nil) (and gnus-uu-winconf-post-news (set-window-configuration gnus-uu-winconf-post-news))) ;; Asks for a file to encode, encodes it and inserts the result in ;; the current buffer. Returns the file name the user gave. (defun gnus-uu-post-insert-binary () (let ((uuencode-buffer-name "*uuencode buffer*") file-path uubuf file-name) (setq file-path (read-file-name "What file do you want to encode? ")) (if (not (file-exists-p file-path)) (error "%s: No such file" file-path)) (goto-char (point-max)) (insert (format "\n%s\n" gnus-uu-post-binary-separator)) (if (string-match "^~/" file-path) (setq file-path (concat "$HOME" (substring file-path 1)))) (if (string-match "/[^/]*$" file-path) (setq file-name (substring file-path (1+ (match-beginning 0)))) (setq file-name file-path)) (unwind-protect (if (save-excursion (set-buffer (setq uubuf (get-buffer-create uuencode-buffer-name))) (erase-buffer) (funcall gnus-uu-post-encode-method file-path file-name)) (insert-buffer uubuf) (error "Encoding unsuccessful")) (kill-buffer uubuf)) file-name)) ;; Posts the article and all of the encoded file. (defun gnus-uu-post-encoded (file-name &optional threaded) (let ((send-buffer-name "*uuencode send buffer*") (encoded-buffer-name "*encoded buffer*") (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]") (separator (concat mail-header-separator "\n\n")) uubuf length parts header i end beg beg-line minlen buf post-buf whole-len beg-binary end-binary) (setq post-buf (current-buffer)) (goto-char (point-min)) (if (not (re-search-forward (if gnus-uu-post-separate-description (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") (concat "^" (regexp-quote mail-header-separator) "$")) nil t)) (error "Internal error: No binary/header separator")) (beginning-of-line) (forward-line 1) (setq beg-binary (point)) (setq end-binary (point-max)) (save-excursion (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) (erase-buffer) (insert-buffer-substring post-buf beg-binary end-binary) (goto-char (point-min)) (setq length (count-lines 1 (point-max))) (setq parts (/ length gnus-uu-post-length)) (if (not (< (% length gnus-uu-post-length) 4)) (setq parts (1+ parts)))) (if gnus-uu-post-separate-description (forward-line -1)) (kill-region (point) (point-max)) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (beginning-of-line) (setq header (buffer-substring 1 (point))) (goto-char (point-min)) (if (not gnus-uu-post-separate-description) () (if (and (not threaded) (re-search-forward "^Subject: " nil t)) (progn (end-of-line) (insert (format " (0/%d)" parts)))) (gnus-inews-news)) (save-excursion (setq i 1) (setq beg 1) (while (not (> i parts)) (set-buffer (get-buffer-create send-buffer-name)) (erase-buffer) (insert header) (if (and threaded gnus-uu-post-message-id) (insert (format "References: %s\n" gnus-uu-post-message-id))) (insert separator) (setq whole-len (- 62 (length (format top-string "" file-name i parts "")))) (if (> 1 (setq minlen (/ whole-len 2))) (setq minlen 1)) (setq beg-line (format top-string (make-string minlen ?-) file-name i parts (make-string (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) (goto-char (point-min)) (if (not (re-search-forward "^Subject: " nil t)) () (if (not threaded) (progn (end-of-line) (insert (format " (%d/%d)" i parts))) (if (or (and (= i 2) gnus-uu-post-separate-description) (and (= i 1) (not gnus-uu-post-separate-description))) (replace-match "Subject: Re: ")))) (goto-char (point-max)) (save-excursion (set-buffer uubuf) (goto-char beg) (if (= i parts) (goto-char (point-max)) (forward-line gnus-uu-post-length)) (if (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4)) (forward-line -4)) (setq end (point))) (insert-buffer-substring uubuf beg end) (insert beg-line) (insert "\n") (setq beg end) (setq i (1+ i)) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (beginning-of-line) (forward-line 2) (if (re-search-forward (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") nil t) (progn (replace-match "") (forward-line 1))) (insert beg-line) (insert "\n") (gnus-inews-news))) (and (setq buf (get-buffer send-buffer-name)) (kill-buffer buf)) (and (setq buf (get-buffer encoded-buffer-name)) (kill-buffer buf)) (if (not gnus-uu-post-separate-description) (progn (set-buffer-modified-p nil) (and (fboundp 'bury-buffer) (bury-buffer)))))) (provide 'gnus-uu) ;; gnus-uu.el ends here emacs-19.30/lisp/gnus-vis.el100444 23053 1 141371 6046561462 14544 0ustar larsidaemon;;; gnus-vis.el --- display-oriented parts of Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Per Abrahamsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Code: (require 'gnus) (require 'gnus-ems) (require 'easymenu) (require 'custom) (defvar gnus-group-menu-hook nil "*Hook run after the creation of the group mode menu.") (defvar gnus-summary-menu-hook nil "*Hook run after the creation of the summary mode menu.") (defvar gnus-article-menu-hook nil "*Hook run after the creation of the article mode menu.") (defvar gnus-server-menu-hook nil "*Hook run after the creation of the server mode menu.") (defvar gnus-browse-menu-hook nil "*Hook run after the creation of the browse mode menu.") ;;; Summary highlights. ;(defvar gnus-summary-highlight-properties ; '((unread "ForestGreen" "green") ; (ticked "Firebrick" "pink") ; (read "black" "white") ; (low italic italic) ; (high bold bold) ; (canceled "yellow/black" "black/yellow"))) ;(defvar gnus-summary-highlight-translation ; '(((unread (= mark gnus-unread-mark)) ; (ticked (or (= mark gnus-ticked-mark) (= mark gnus-dormant-mark))) ; (read (not (or (= mark gnus-unread-mark) (= mark gnus-dormant-mark) ; (= mark gnus-ticked-mark) (= mark gnus-canceled-mark)))) ; (canceled (= mark gnus-canceled-mark))) ; ((low (< score gnus-summary-default-score)) ; (high (> score gnus-summary-default-score))))) ;(defun gnus-visual-map-face-translation () ; (let ((props gnus-summary-highlight-properties) ; (trans gnus-summary-highlight-translation) ; map) ; (while props))) ;see gnus-cus.el ;(defvar gnus-summary-selected-face 'underline ; "*Face used for highlighting the current article in the summary buffer.") ;see gnus-cus.el ;(defvar gnus-summary-highlight ; (cond ((not (eq gnus-display-type 'color)) ; '(((> score default) . bold) ; ((< score default) . italic))) ; ((eq gnus-background-mode 'dark) ; (list (cons '(= mark gnus-canceled-mark) ; (custom-face-lookup "yellow" "black" nil nil nil nil)) ; (cons '(and (> score default) ; (or (= mark gnus-dormant-mark) ; (= mark gnus-ticked-mark))) ; (custom-face-lookup "pink" nil nil t nil nil)) ; (cons '(and (< score default) ; (or (= mark gnus-dormant-mark) ; (= mark gnus-ticked-mark))) ; (custom-face-lookup "pink" nil nil nil t nil)) ; (cons '(or (= mark gnus-dormant-mark) ; (= mark gnus-ticked-mark)) ; (custom-face-lookup "pink" nil nil nil nil nil)) ; (cons '(and (> score default) (= mark gnus-ancient-mark)) ; (custom-face-lookup "SkyBlue" nil nil t nil nil)) ; (cons '(and (< score default) (= mark gnus-ancient-mark)) ; (custom-face-lookup "SkyBlue" nil nil nil t nil)) ; (cons '(= mark gnus-ancient-mark) ; (custom-face-lookup "SkyBlue" nil nil nil nil nil)) ; (cons '(and (> score default) (= mark gnus-unread-mark)) ; (custom-face-lookup "white" nil nil t nil nil)) ; (cons '(and (< score default) (= mark gnus-unread-mark)) ; (custom-face-lookup "white" nil nil nil t nil)) ; (cons '(= mark gnus-unread-mark) ; (custom-face-lookup "white" nil nil nil nil nil)) ; (cons '(> score default) 'bold) ; (cons '(< score default) 'italic))) ; (t ; (list (cons '(= mark gnus-canceled-mark) ; (custom-face-lookup "yellow" "black" nil nil nil nil)) ; (cons '(and (> score default) ; (or (= mark gnus-dormant-mark) ; (= mark gnus-ticked-mark))) ; (custom-face-lookup "firebrick" nil nil t nil nil)) ; (cons '(and (< score default) ; (or (= mark gnus-dormant-mark) ; (= mark gnus-ticked-mark))) ; (custom-face-lookup "firebrick" nil nil nil t nil)) ; (cons '(or (= mark gnus-dormant-mark) ; (= mark gnus-ticked-mark)) ; (custom-face-lookup "firebrick" nil nil nil nil nil)) ; (cons '(and (> score default) (= mark gnus-ancient-mark)) ; (custom-face-lookup "RoyalBlue" nil nil t nil nil)) ; (cons '(and (< score default) (= mark gnus-ancient-mark)) ; (custom-face-lookup "RoyalBlue" nil nil nil t nil)) ; (cons '(= mark gnus-ancient-mark) ; (custom-face-lookup "RoyalBlue" nil nil nil nil nil)) ; (cons '(and (> score default) (/= mark gnus-unread-mark)) ; (custom-face-lookup "DarkGreen" nil nil t nil nil)) ; (cons '(and (< score default) (/= mark gnus-unread-mark)) ; (custom-face-lookup "DarkGreen" nil nil nil t nil)) ; (cons '(/= mark gnus-unread-mark) ; (custom-face-lookup "DarkGreen" nil nil nil nil nil)) ; (cons '(> score default) 'bold) ; (cons '(< score default) 'italic)))) ; "*Alist of `(FORM . FACE)'. ;Summary lines are highlighted with the FACE for the first FORM which ;evaluate to a non-nil value. ;Point will be at the beginning of the line when FORM is evaluated. ;The following can be used for convenience: ;score: (gnus-summary-article-score) ;default: gnus-summary-default-score ;below: gnus-summary-mark-below ;mark: (gnus-summary-article-mark) ;The latter can be used like this: ; ((= mark gnus-replied-mark) . underline)") ;;; article highlights ;see gnus-cus.el ;(defvar gnus-header-face-alist ; (cond ((not (eq gnus-display-type 'color)) ; '(("" bold italic))) ; ((eq gnus-background-mode 'dark) ; (list (list "From" nil ; (custom-face-lookup "SkyBlue" nil nil t t nil)) ; (list "Subject" nil ; (custom-face-lookup "pink" nil nil t t nil)) ; (list "Newsgroups:.*," nil ; (custom-face-lookup "yellow" nil nil t t nil)) ; (list "" ; (custom-face-lookup "cyan" nil nil t nil nil) ; (custom-face-lookup "green" nil nil nil t nil)))) ; (t ; (list (list "From" nil ; (custom-face-lookup "RoyalBlue" nil nil t t nil)) ; (list "Subject" nil ; (custom-face-lookup "firebrick" nil nil t t nil)) ; (list "Newsgroups:.*," nil ; (custom-face-lookup "red" nil nil t t nil)) ; (list "" ; (custom-face-lookup "DarkGreen" nil nil t nil nil) ; (custom-face-lookup "DarkGreen" nil nil nil t nil))))) ; "Alist of headers and faces used for highlighting them. ;The entries in the list has the form `(REGEXP NAME CONTENT)', where ;REGEXP is a regular expression matching the beginning of the header, ;NAME is the face used for highlighting the header name and CONTENT is ;the face used for highlighting the header content. ;The first non-nil NAME or CONTENT with a matching REGEXP in the list ;will be used.") ;see gnus-cus.el ;(defvar gnus-make-foreground t ; "Non nil means foreground color to highlight citations.") ;see gnus-cus.el ;(defvar gnus-article-button-face 'bold ; "Face used for text buttons.") ;see gnus-cus.el ;(defvar gnus-article-mouse-face (if (boundp 'gnus-mouse-face) ; gnus-mouse-face ; 'highlight) ; "Face used when the mouse is over the button.") ;see gnus-cus.el ;(defvar gnus-signature-face 'italic ; "Face used for signature.") (defvar gnus-button-alist '(("in\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 (assq (count-lines (point-min) (match-end 0)) gnus-cite-attribution-alist) gnus-button-message-id 3) ;; This is how URLs _should_ be embedded in text... ("]*\\)>" 0 t gnus-button-url 1) ;; Next regexp stolen from highlight-headers.el. ;; Modified by Vladimir Alexiev. ("\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]" 0 t gnus-button-url 0)) "Alist of regexps matching buttons in an article. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where REGEXP: is the string matching text around the button, BUTTON: is the number of the regexp grouping actually matching the button, FORM: is a lisp expression which must eval to true for the button to be added, CALLBACK: is the function to call when the user push this button, and each PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. CALLBACK can also be a variable, in that case the value of that variable it the real callback function.") ;see gnus-cus.el ;(eval-when-compile ; (defvar browse-url-browser-function)) ;see gnus-cus.el ;(defvar gnus-button-url ; (cond ((boundp 'browse-url-browser-function) browse-url-browser-function) ; ((fboundp 'w3-fetch) 'w3-fetch) ; ((eq window-system 'x) 'gnus-netscape-open-url)) ; "*Function to fetch URL. ;The function will be called with one argument, the URL to fetch. ;Useful values of this function are: ;w3-fetch: ; defined in the w3 emacs package by William M. Perry. ;gnus-netscape-open-url: ; open url in existing netscape, start netscape if none found. ;gnus-netscape-start-url: ; start new netscape with url.") (eval-and-compile (autoload 'nnkiboze-generate-groups "nnkiboze") (autoload 'gnus-cite-parse-maybe "gnus-cite" nil t)) ;;; ;;; gnus-menu ;;; (defun gnus-visual-turn-off-edit-menu (type) (define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) [menu-bar edit] 'undefined)) ;; Newsgroup buffer (defun gnus-group-make-menu-bar () (gnus-visual-turn-off-edit-menu 'group) (or (boundp 'gnus-group-reading-menu) (progn (easy-menu-define gnus-group-reading-menu gnus-group-mode-map "" '("Group" ["Read" gnus-group-read-group t] ["Select" gnus-group-select-group t] ["See old articles" gnus-group-select-group-all t] ["Catch up" gnus-group-catchup-current t] ["Catch up all articles" gnus-group-catchup-current-all t] ["Check for new articles" gnus-group-get-new-news-this-group t] ["Toggle subscription" gnus-group-unsubscribe-current-group t] ["Kill" gnus-group-kill-group t] ["Yank" gnus-group-yank-group t] ["Describe" gnus-group-describe-group t] ["Fetch FAQ" gnus-group-fetch-faq t] ["Edit kill file" gnus-group-edit-local-kill t] ["Expire articles" gnus-group-expire-articles t] ["Set group level" gnus-group-set-current-level t] )) (easy-menu-define gnus-group-group-menu gnus-group-mode-map "" '("Groups" ("Listing" ["List subscribed groups" gnus-group-list-groups t] ["List all groups" gnus-group-list-all-groups t] ["List groups matching..." gnus-group-list-matching t] ["List killed groups" gnus-group-list-killed t] ["List zombie groups" gnus-group-list-zombies t] ["Describe all groups" gnus-group-describe-all-groups t] ["Group apropos" gnus-group-apropos t] ["Group and description apropos" gnus-group-description-apropos t] ["List groups matching..." gnus-group-list-matching t]) ("Mark" ["Mark group" gnus-group-mark-group t] ["Unmark group" gnus-group-unmark-group t] ["Mark region" gnus-group-mark-region t]) ("Subscribe" ["Subscribe to random group" gnus-group-unsubscribe-group t] ["Kill all newsgroups in region" gnus-group-kill-region t] ["Kill all zombie groups" gnus-group-kill-all-zombies t]) ("Foreign groups" ["Make a foreign group" gnus-group-make-group t] ["Add a directory group" gnus-group-make-directory-group t] ["Add the help group" gnus-group-make-help-group t] ["Add the archive group" gnus-group-make-archive-group t] ["Make a doc group" gnus-group-make-doc-group t] ["Make a kiboze group" gnus-group-make-kiboze-group t] ["Make a virtual group" gnus-group-make-empty-virtual t] ["Add a group to a virtual" gnus-group-add-to-virtual t]) ("Editing groups" ["Parameters" gnus-group-edit-group-parameters t] ["Select method" gnus-group-edit-group-method t] ["Info" gnus-group-edit-group t]) ["Read a directory as a group" gnus-group-enter-directory t] ["Jump to group" gnus-group-jump-to-group t] ["Best unread group" gnus-group-best-unread-group t] )) (easy-menu-define gnus-group-misc-menu gnus-group-mode-map "" '("Misc" ["Send a bug report" gnus-bug t] ["Send a mail" gnus-group-mail t] ["Post an article" gnus-group-post-news t] ["Customize score file" gnus-score-customize (not (string-match "XEmacs" emacs-version)) ] ["Check for new news" gnus-group-get-new-news t] ["Delete bogus groups" gnus-group-check-bogus-groups t] ["Find new newsgroups" gnus-find-new-newsgroups t] ["Restart Gnus" gnus-group-restart t] ["Read init file" gnus-group-read-init-file t] ["Browse foreign server" gnus-group-browse-foreign-server t] ["Enter server buffer" gnus-group-enter-server-mode t] ["Expire expirable articles" gnus-group-expire-all-groups t] ["Generate any kiboze groups" nnkiboze-generate-groups t] ["Gnus version" gnus-version t] ["Save .newsrc files" gnus-group-save-newsrc t] ["Suspend Gnus" gnus-group-suspend t] ["Clear dribble buffer" gnus-group-clear-dribble t] ["Exit from Gnus" gnus-group-exit t] ["Exit without saving" gnus-group-quit t] ["Edit global kill file" gnus-group-edit-global-kill t] ["Sort group buffer" gnus-group-sort-groups t] )) (run-hooks 'gnus-group-menu-hook) ))) ;; Server mode (defun gnus-server-make-menu-bar () (gnus-visual-turn-off-edit-menu 'server) (or (boundp 'gnus-server-menu) (progn (easy-menu-define gnus-server-menu gnus-server-mode-map "" '("Server" ["Add" gnus-server-add-server t] ["Browse" gnus-server-read-server t] ["List" gnus-server-list-servers t] ["Kill" gnus-server-kill-server t] ["Yank" gnus-server-yank-server t] ["Copy" gnus-server-copy-server t] ["Edit" gnus-server-edit-server t] ["Exit" gnus-server-exit t] )) (run-hooks 'gnus-server-menu-hook) ))) ;; Browse mode (defun gnus-browse-make-menu-bar () (gnus-visual-turn-off-edit-menu 'browse) (or (boundp 'gnus-browse-menu) (progn (easy-menu-define gnus-browse-menu gnus-browse-mode-map "" '("Browse" ["Subscribe" gnus-browse-unsubscribe-current-group t] ["Read" gnus-group-read-group t] ["Exit" gnus-browse-exit t] )) (run-hooks 'gnus-browse-menu-hook) ))) ;; Summary buffer (defun gnus-summary-make-menu-bar () (gnus-visual-turn-off-edit-menu 'summary) (or (boundp 'gnus-summary-misc-menu) (progn (easy-menu-define gnus-summary-misc-menu gnus-summary-mode-map "" '("Misc" ("Mark" ("Read" ["Mark as read" gnus-summary-mark-as-read-forward t] ["Mark same subject and select" gnus-summary-kill-same-subject-and-select t] ["Mark same subject" gnus-summary-kill-same-subject t] ["Catchup" gnus-summary-catchup t] ["Catchup all" gnus-summary-catchup-all t] ["Catchup to here" gnus-summary-catchup-to-here t] ["Catchup region" gnus-summary-mark-region-as-read t]) ("Various" ["Tick" gnus-summary-tick-article-forward t] ["Mark as dormant" gnus-summary-mark-as-dormant t] ["Remove marks" gnus-summary-clear-mark-forward t] ["Set expirable mark" gnus-summary-mark-as-expirable t] ["Set bookmark" gnus-summary-set-bookmark t] ["Remove bookmark" gnus-summary-remove-bookmark t]) ("Display" ["Remove lines marked as read" gnus-summary-remove-lines-marked-as-read t] ["Remove lines marked with..." gnus-summary-remove-lines-marked-with t] ["Show dormant articles" gnus-summary-show-all-dormant t] ["Hide dormant articles" gnus-summary-hide-all-dormant t] ["Show expunged articles" gnus-summary-show-all-expunged t]) ("Process mark" ["Set mark" gnus-summary-mark-as-processable t] ["Remove mark" gnus-summary-unmark-as-processable t] ["Remove all marks" gnus-summary-unmark-all-processable t] ["Mark series" gnus-uu-mark-series t] ["Mark region" gnus-uu-mark-region t] ["Mark by regexp" gnus-uu-mark-by-regexp t] ["Mark all" gnus-uu-mark-all t] ["Mark sparse" gnus-uu-mark-sparse t] ["Mark thread" gnus-uu-mark-thread t])) ("Move" ["Scroll article forwards" gnus-summary-next-page t] ["Next unread article" gnus-summary-next-unread-article t] ["Previous unread article" gnus-summary-prev-unread-article t] ["Next article" gnus-summary-next-article t] ["Previous article" gnus-summary-prev-article t] ["Next article same subject" gnus-summary-next-same-subject t] ["Previous article same subject" gnus-summary-prev-same-subject t] ["First unread article" gnus-summary-first-unread-article t] ["Go to subject number..." gnus-summary-goto-subject t] ["Go to the last article" gnus-summary-goto-last-article t] ["Pop article off history" gnus-summary-pop-article t]) ("Sort" ["Sort by number" gnus-summary-sort-by-number t] ["Sort by author" gnus-summary-sort-by-author t] ["Sort by subject" gnus-summary-sort-by-subject t] ["Sort by date" gnus-summary-sort-by-date t] ["Sort by score" gnus-summary-sort-by-score t]) ("Exit" ["Catchup and exit" gnus-summary-catchup-and-exit t] ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] ["Exit group" gnus-summary-exit t] ["Exit group without updating" gnus-summary-exit-no-update t] ["Reselect group" gnus-summary-reselect-current-group t] ["Rescan group" gnus-summary-rescan-group t]) ["Fetch group FAQ" gnus-summary-fetch-faq t] ["Filter articles" gnus-summary-execute-command t] ["Toggle line truncation" gnus-summary-toggle-truncation t] ["Expire expirable articles" gnus-summary-expire-articles t] ["Describe group" gnus-summary-describe-group t] ["Edit local kill file" gnus-summary-edit-local-kill t] )) (easy-menu-define gnus-summary-kill-menu gnus-summary-mode-map "" (cons "Score" (nconc (list ["Enter score" gnus-summary-score-entry t]) (gnus-visual-score-map 'increase) (gnus-visual-score-map 'lower) '(["Current score" gnus-summary-current-score t] ["Set score" gnus-summary-set-score t] ["Customize score file" gnus-score-customize t] ["Switch current score file" gnus-score-change-score-file t] ["Set mark below" gnus-score-set-mark-below t] ["Set expunge below" gnus-score-set-expunge-below t] ["Edit current score file" gnus-score-edit-alist t] ["Edit score file" gnus-score-edit-file t] ["Trace score" gnus-score-find-trace t] ["Increase score" gnus-summary-increase-score t] ["Lower score" gnus-summary-lower-score t])))) (and nil '(("Default header" ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) :style radio :selected (null gnus-score-default-header)] ["From" (gnus-score-set-default 'gnus-score-default-header 'a) :style radio :selected (eq gnus-score-default-header 'a )] ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) :style radio :selected (eq gnus-score-default-header 's )] ["Article body" (gnus-score-set-default 'gnus-score-default-header 'b) :style radio :selected (eq gnus-score-default-header 'b )] ["All headers" (gnus-score-set-default 'gnus-score-default-header 'h) :style radio :selected (eq gnus-score-default-header 'h )] ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i) :style radio :selected (eq gnus-score-default-header 'i )] ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) :style radio :selected (eq gnus-score-default-header 't )] ["Crossposting" (gnus-score-set-default 'gnus-score-default-header 'x) :style radio :selected (eq gnus-score-default-header 'x )] ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) :style radio :selected (eq gnus-score-default-header 'l )] ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) :style radio :selected (eq gnus-score-default-header 'd )] ["Followups to author" (gnus-score-set-default 'gnus-score-default-header 'f) :style radio :selected (eq gnus-score-default-header 'f )]) ("Default type" ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) :style radio :selected (null gnus-score-default-type)] ;; The `:active' key is commented out in the following, ;; because the GNU Emacs hack to support radio buttons use ;; active to indicate which button is selected. ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) :style radio ;; :active (not (memq gnus-score-default-header '(l d))) :selected (eq gnus-score-default-type 's)] ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r) :style radio ;; :active (not (memq gnus-score-default-header '(l d))) :selected (eq gnus-score-default-type 'r)] ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e) :style radio ;; :active (not (memq gnus-score-default-header '(l d))) :selected (eq gnus-score-default-type 'e)] ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f) :style radio ;; :active (not (memq gnus-score-default-header '(l d))) :selected (eq gnus-score-default-type 'f)] ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b) :style radio ;; :active (eq (gnus-score-default-header 'd)) :selected (eq gnus-score-default-type 'b)] ["At date" (gnus-score-set-default 'gnus-score-default-type 'n) :style radio ;; :active (eq (gnus-score-default-header 'd)) :selected (eq gnus-score-default-type 'n)] ["After date" (gnus-score-set-default 'gnus-score-default-type 'a) :style radio ;; :active (eq (gnus-score-default-header 'd)) :selected (eq gnus-score-default-type 'a)] ["Less than number" (gnus-score-set-default 'gnus-score-default-type '<) :style radio ;; :active (eq (gnus-score-default-header 'l)) :selected (eq gnus-score-default-type '<)] ["Equal to number" (gnus-score-set-default 'gnus-score-default-type '=) :style radio ;; :active (eq (gnus-score-default-header 'l)) :selected (eq gnus-score-default-type '=)] ["Greater than number" (gnus-score-set-default 'gnus-score-default-type '>) :style radio ;; :active (eq (gnus-score-default-header 'l)) :selected (eq gnus-score-default-type '>)]) ["Default fold" gnus-score-default-fold-toggle :style toggle :selected gnus-score-default-fold] ("Default duration" ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil) :style radio :selected (null gnus-score-default-duration)] ["Permanent" (gnus-score-set-default 'gnus-score-default-duration 'p) :style radio :selected (eq gnus-score-default-duration 'p)] ["Temporary" (gnus-score-set-default 'gnus-score-default-duration 't) :style radio :selected (eq gnus-score-default-duration 't)] ["Immediate" (gnus-score-set-default 'gnus-score-default-duration 'i) :style radio :selected (eq gnus-score-default-duration 'i)]) )) (easy-menu-define gnus-summary-article-menu gnus-summary-mode-map "" '("Article" ("Hide" ["All" gnus-article-hide t] ["Headers" gnus-article-hide-headers t] ["Signature" gnus-article-hide-signature t] ["Citation" gnus-article-hide-citation t]) ("Highlight" ["All" gnus-article-highlight t] ["Headers" gnus-article-highlight-headers t] ["Signature" gnus-article-highlight-signature t] ["Citation" gnus-article-highlight-citation t]) ("Date" ["Local" gnus-article-date-local t] ["UT" gnus-article-date-ut t] ["Lapsed" gnus-article-date-lapsed t]) ("Filter" ["Overstrike" gnus-article-treat-overstrike t] ["Word wrap" gnus-article-word-wrap t] ["CR" gnus-article-remove-cr t] ["Show X-Face" gnus-article-display-x-face t] ["Quoted-Printable" gnus-article-de-quoted-unreadable t] ["Rot 13" gnus-summary-caesar-message t] ["Add buttons" gnus-article-add-buttons t] ["Stop page breaking" gnus-summary-stop-page-breaking t] ["Toggle MIME" gnus-summary-toggle-mime t] ["Toggle header" gnus-summary-toggle-header t]) ("Output" ["Save in default format" gnus-summary-save-article t] ["Save in file" gnus-summary-save-article-file t] ["Save in Unix mail format" gnus-summary-save-article-mail t] ["Save in MH folder" gnus-summary-save-article-folder t] ["Save in VM folder" gnus-summary-save-article-vm t] ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] ["Pipe through a filter" gnus-summary-pipe-output t]) ("Backend" ["Respool article" gnus-summary-respool-article t] ["Move article" gnus-summary-move-article t] ["Copy article" gnus-summary-copy-article t] ["Import file" gnus-summary-import-article t] ["Edit article" gnus-summary-edit-article t] ["Delete article" gnus-summary-delete-article t]) ("Extract" ["Uudecode" gnus-uu-decode-uu t] ["Uudecode and save" gnus-uu-decode-uu-and-save t] ["Unshar" gnus-uu-decode-unshar t] ["Unshar and save" gnus-uu-decode-unshar-and-save t] ["Save" gnus-uu-decode-save t] ["Binhex" gnus-uu-decode-binhex t]) ["Enter digest buffer" gnus-summary-enter-digest-group t] ["Isearch article" gnus-summary-isearch-article t] ["Search all articles" gnus-summary-search-article-forward t] ["Beginning of the article" gnus-summary-beginning-of-article t] ["End of the article" gnus-summary-end-of-article t] ["Fetch parent of article" gnus-summary-refer-parent-article t] ["Fetch article with id..." gnus-summary-refer-article t] ["Redisplay" gnus-summary-show-article t])) (easy-menu-define gnus-summary-thread-menu gnus-summary-mode-map "" '("Threads" ["Toggle threading" gnus-summary-toggle-threads t] ["Display hidden thread" gnus-summary-show-thread t] ["Hide thread" gnus-summary-hide-thread t] ["Go to next thread" gnus-summary-next-thread t] ["Go to previous thread" gnus-summary-prev-thread t] ["Go down thread" gnus-summary-down-thread t] ["Go up thread" gnus-summary-up-thread t] ["Mark thread as read" gnus-summary-kill-thread t] ["Lower thread score" gnus-summary-lower-thread t] ["Raise thread score" gnus-summary-raise-thread t] )) (easy-menu-define gnus-summary-post-menu gnus-summary-mode-map "" '("Post" ["Post an article" gnus-summary-post-news t] ["Followup" gnus-summary-followup t] ["Followup and yank" gnus-summary-followup-with-original t] ["Supersede article" gnus-summary-supersede-article t] ["Cancel article" gnus-summary-cancel-article t] ["Reply" gnus-summary-reply t] ["Reply and yank" gnus-summary-reply-with-original t] ["Mail forward" gnus-summary-mail-forward t] ["Post forward" gnus-summary-post-forward t] ["Digest and mail" gnus-uu-digest-mail-forward t] ["Digest and post" gnus-uu-digest-post-forward t] ["Send a mail" gnus-summary-mail-other-window t] ["Reply & followup" gnus-summary-followup-and-reply t] ["Reply & followup and yank" gnus-summary-followup-and-reply-with-original t] ["Uuencode and post" gnus-uu-post-news t] )) (run-hooks 'gnus-summary-menu-hook) ))) (defun gnus-score-set-default (var value) ;; A version of set that updates the GNU Emacs menu-bar. (set var value) ;; It is the message that forces the active status to be updated. (message "")) (defvar gnus-score-default-header nil "Default header when entering new scores. Should be one of the following symbols. a: from s: subject b: body h: head i: message-id t: references x: xref l: lines d: date f: followup If nil, the user will be asked for a header.") (defvar gnus-score-default-type nil "Default match type when entering new scores. Should be one of the following symbols. s: substring e: exact string f: fuzzy string r: regexp string b: before date a: at date n: this date <: less than number >: greater than number =: equal to number If nil, the user will be asked for a match type.") (defvar gnus-score-default-fold nil "Use case folding for new score file entries iff not nil.") (defun gnus-score-default-fold-toggle () "Toggle folding for new score file entries." (interactive) (setq gnus-score-default-fold (not gnus-score-default-fold)) (if gnus-score-default-fold (message "New score file entries will be case insensitive.") (message "New score file entries will be case sensitive."))) (defvar gnus-score-default-duration nil "Default duration of effect when entering new scores. Should be one of the following symbols. t: temporary p: permanent i: immediate If nil, the user will be asked for a duration.") (defun gnus-visual-score-map (type) (if t nil (let ((headers '(("author" "from" string) ("subject" "subject" string) ("article body" "body" string) ("article head" "head" string) ("xref" "xref" string) ("lines" "lines" number) ("followups to author" "followup" string))) (types '((number ("less than" <) ("greater than" >) ("equal" =)) (string ("substring" s) ("exact string" e) ("fuzzy string" f) ("regexp" r)))) (perms '(("temporary" (current-time-string)) ("permanent" nil) ("immediate" now))) header) (list (apply 'nconc (list (if (eq type 'lower) "Lower score" "Increase score")) (let (outh) (while headers (setq header (car headers)) (setq outh (cons (apply 'nconc (list (car header)) (let ((ts (cdr (assoc (nth 2 header) types))) outt) (while ts (setq outt (cons (apply 'nconc (list (car (car ts))) (let ((ps perms) outp) (while ps (setq outp (cons (vector (car (car ps)) (list 'gnus-summary-score-entry (nth 1 header) (if (or (string= (nth 1 header) "head") (string= (nth 1 header) "body")) "" (list 'gnus-summary-header (nth 1 header))) (list 'quote (nth 1 (car ts))) (list 'gnus-score-default nil) (nth 1 (car ps)) t) t) outp)) (setq ps (cdr ps))) (list (nreverse outp)))) outt)) (setq ts (cdr ts))) (list (nreverse outt)))) outh)) (setq headers (cdr headers))) (list (nreverse outh)))))))) ;; Article buffer (defun gnus-article-make-menu-bar () (gnus-visual-turn-off-edit-menu 'summary) (or (boundp 'gnus-article-article-menu) (progn (easy-menu-define gnus-article-article-menu gnus-article-mode-map "" '("Article" ["Scroll forwards" gnus-article-next-page t] ["Scroll backwards" gnus-article-prev-page t] ["Show summary" gnus-article-show-summary t] ["Fetch Message-ID at point" gnus-article-refer-article t] ["Mail to address at point" gnus-article-mail t] )) (easy-menu-define gnus-article-treatment-menu gnus-article-mode-map "" '("Treatment" ["Hide headers" gnus-article-hide-headers t] ["Hide signature" gnus-article-hide-signature t] ["Hide citation" gnus-article-hide-citation t] ["Treat overstrike" gnus-article-treat-overstrike t] ["Remove carriage return" gnus-article-remove-cr t] ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] )) (run-hooks 'gnus-article-menu-hook) ))) ;;; ;;; summary highlights ;;; (defun gnus-highlight-selected-summary () ;; Added by Per Abrahamsen . ;; Highlight selected article in summary buffer (if gnus-summary-selected-face (save-excursion (let* ((beg (progn (beginning-of-line) (point))) (end (progn (end-of-line) (point))) ;; Fix by Mike Dugan . (from (if (get-text-property beg 'mouse-face) beg (1+ (or (next-single-property-change beg 'mouse-face nil end) beg)))) (to (1- (or (next-single-property-change from 'mouse-face nil end) end)))) ;; If no mouse-face prop on line (e.g. xemacs) we ;; will have to = from = end, so we highlight the ;; entire line instead. (if (= (+ to 2) from) (progn (setq from beg) (setq to end))) (if gnus-newsgroup-selected-overlay (gnus-move-overlay gnus-newsgroup-selected-overlay from to (current-buffer)) (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to)) (gnus-overlay-put gnus-newsgroup-selected-overlay 'face gnus-summary-selected-face)))))) ;; New implementation by Christian Limpach . (defun gnus-summary-highlight-line () "Highlight current line according to `gnus-summary-highlight'." (let* ((list gnus-summary-highlight) (p (point)) (end (progn (end-of-line) (point))) ;; now find out where the line starts and leave point there. (beg (progn (beginning-of-line) (point))) (score (or (cdr (assq (or (get-text-property beg 'gnus-number) gnus-current-article) gnus-newsgroup-scored)) gnus-summary-default-score 0)) (default gnus-summary-default-score) (mark (get-text-property beg 'gnus-mark)) (inhibit-read-only t)) (while (and list (not (eval (car (car list))))) (setq list (cdr list))) (let ((face (and list (cdr (car list))))) (or (eobp) (eq face (get-text-property beg 'face)) (put-text-property beg end 'face (if (boundp face) (symbol-value face) face)))) (goto-char p))) ;;; ;;; gnus-carpal ;;; (defvar gnus-carpal-group-buffer-buttons '(("next" . gnus-group-next-unread-group) ("prev" . gnus-group-prev-unread-group) ("read" . gnus-group-read-group) ("select" . gnus-group-select-group) ("catch-up" . gnus-group-catchup-current) ("new-news" . gnus-group-get-new-news-this-group) ("toggle-sub" . gnus-group-unsubscribe-current-group) ("subscribe" . gnus-group-unsubscribe-group) ("kill" . gnus-group-kill-group) ("yank" . gnus-group-yank-group) ("describe" . gnus-group-describe-group) "list" ("subscribed" . gnus-group-list-groups) ("all" . gnus-group-list-all-groups) ("killed" . gnus-group-list-killed) ("zombies" . gnus-group-list-zombies) ("matching" . gnus-group-list-matching) ("post" . gnus-group-post-news) ("mail" . gnus-group-mail) ("rescan" . gnus-group-get-new-news) ("browse-foreign" . gnus-group-browse-foreign) ("exit" . gnus-group-exit))) (defvar gnus-carpal-summary-buffer-buttons '("mark" ("read" . gnus-summary-mark-as-read-forward) ("tick" . gnus-summary-tick-article-forward) ("clear" . gnus-summary-clear-mark-forward) ("expirable" . gnus-summary-mark-as-expirable) "move" ("scroll" . gnus-summary-next-page) ("next-unread" . gnus-summary-next-unread-article) ("prev-unread" . gnus-summary-prev-unread-article) ("first" . gnus-summary-first-unread-article) ("best" . gnus-summary-best-unread-article) "article" ("headers" . gnus-summary-toggle-header) ("uudecode" . gnus-uu-decode-uu) ("enter-digest" . gnus-summary-enter-digest-group) ("fetch-parent" . gnus-summary-refer-parent-article) "mail" ("move" . gnus-summary-move-article) ("copy" . gnus-summary-copy-article) ("respool" . gnus-summary-respool-article) "threads" ("lower" . gnus-summary-lower-thread) ("kill" . gnus-summary-kill-thread) "post" ("post" . gnus-summary-post-news) ("mail" . gnus-summary-mail) ("followup" . gnus-summary-followup-with-original) ("reply" . gnus-summary-reply-with-original) ("cancel" . gnus-summary-cancel-article) "misc" ("exit" . gnus-summary-exit) ("fed-up" . gnus-summary-catchup-and-goto-next-group))) (defvar gnus-carpal-server-buffer-buttons '(("add" . gnus-server-add-server) ("browse" . gnus-server-browse-server) ("list" . gnus-server-list-servers) ("kill" . gnus-server-kill-server) ("yank" . gnus-server-yank-server) ("copy" . gnus-server-copy-server) ("exit" . gnus-server-exit))) (defvar gnus-carpal-browse-buffer-buttons '(("subscribe" . gnus-browse-unsubscribe-current-group) ("exit" . gnus-browse-exit))) (defvar gnus-carpal-group-buffer "*Carpal Group*") (defvar gnus-carpal-summary-buffer "*Carpal Summary*") (defvar gnus-carpal-server-buffer "*Carpal Server*") (defvar gnus-carpal-browse-buffer "*Carpal Browse*") (defvar gnus-carpal-attached-buffer nil) (defvar gnus-carpal-mode-hook nil "*Hook run in carpal mode buffers.") (defvar gnus-carpal-button-face 'bold "*Face used on carpal buttons.") (defvar gnus-carpal-header-face 'bold-italic "*Face used on carpal buffer headers.") (defvar gnus-carpal-mode-map nil) (put 'gnus-carpal-mode 'mode-class 'special) (if gnus-carpal-mode-map nil (setq gnus-carpal-mode-map (make-keymap)) (suppress-keymap gnus-carpal-mode-map) (define-key gnus-carpal-mode-map " " 'gnus-carpal-select) (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select) (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select)) (defun gnus-carpal-mode () "Major mode for clicking buttons. All normal editing commands are switched off. \\ The following commands are available: \\{gnus-carpal-mode-map}" (interactive) (kill-all-local-variables) (setq mode-line-modified "-- ") (setq major-mode 'gnus-carpal-mode) (setq mode-name "Gnus Carpal") (setq mode-line-process nil) (use-local-map gnus-carpal-mode-map) (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) (make-local-variable 'gnus-carpal-attached-buffer) (run-hooks 'gnus-carpal-mode-hook)) (defun gnus-carpal-setup-buffer (type) (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type))))) (if (get-buffer buffer) () (save-excursion (set-buffer (get-buffer-create buffer)) (gnus-carpal-mode) (setq gnus-carpal-attached-buffer (intern (format "gnus-%s-buffer" type))) (gnus-add-current-to-buffer-list) (let ((buttons (symbol-value (intern (format "gnus-carpal-%s-buffer-buttons" type)))) (buffer-read-only nil) button) (while buttons (setq button (car buttons) buttons (cdr buttons)) (if (stringp button) (set-text-properties (point) (prog2 (insert button) (point) (insert " ")) (list 'face gnus-carpal-header-face)) (set-text-properties (point) (prog2 (insert (car button)) (point) (insert " ")) (list 'gnus-callback (cdr button) 'face gnus-carpal-button-face 'mouse-face 'highlight)))) (let ((fill-column (- (window-width) 2))) (fill-region (point-min) (point-max))) (set-window-point (get-buffer-window (current-buffer)) (point-min))))))) (defun gnus-carpal-select () "Select the button under point." (interactive) (let ((func (get-text-property (point) 'gnus-callback))) (if (null func) () (pop-to-buffer (symbol-value gnus-carpal-attached-buffer)) (call-interactively func)))) (defun gnus-carpal-mouse-select (event) "Select the button under the mouse pointer." (interactive "e") (mouse-set-point event) (gnus-carpal-select)) ;;; ;;; article highlights ;;; ;; Written by Per Abrahamsen . ;;; Internal Variables: (defvar gnus-button-regexp nil) ;; Regexp matching any of the regexps from `gnus-button-alist'. (defvar gnus-button-last nil) ;; The value of `gnus-button-alist' when `gnus-button-regexp' was build. ;;; Commands: (defun gnus-article-push-button (event) "Check text under the mouse pointer for a callback function. If the text under the mouse pointer has a `gnus-callback' property, call it with the value of the `gnus-data' text property." (interactive "e") (set-buffer (window-buffer (posn-window (event-start event)))) (let* ((pos (posn-point (event-start event))) (data (get-text-property pos 'gnus-data)) (fun (get-text-property pos 'gnus-callback))) (if fun (funcall fun data)))) (defun gnus-article-press-button () "Check text at point for a callback function. If the text at point has a `gnus-callback' property, call it with the value of the `gnus-data' text property." (interactive) (let* ((data (get-text-property (point) 'gnus-data)) (fun (get-text-property (point) 'gnus-callback))) (if fun (funcall fun data)))) ;; Suggested by Arne Elofsson (defun gnus-article-next-button () "Move point to next button." (interactive) (if (get-text-property (point) 'gnus-callback) (goto-char (next-single-property-change (point) 'gnus-callback nil (point-max)))) (let ((pos (next-single-property-change (point) 'gnus-callback))) (if pos (goto-char pos) (setq pos (next-single-property-change (point-min) 'gnus-callback)) (if pos (goto-char pos) (error "No buttons found"))))) (defun gnus-article-highlight (&optional force) "Highlight current article. This function calls `gnus-article-highlight-headers', `gnus-article-highlight-citation', `gnus-article-highlight-signature', and `gnus-article-add-buttons' to do the highlighting. See the documentation for those functions." (interactive (list 'force)) (gnus-article-highlight-headers) (gnus-article-highlight-citation force) (gnus-article-highlight-signature) (gnus-article-add-buttons force)) (defun gnus-article-highlight-some (&optional force) "Highlight current article. This function calls `gnus-article-highlight-headers', `gnus-article-highlight-signature', and `gnus-article-add-buttons' to do the highlighting. See the documentation for those functions." (interactive (list 'force)) (gnus-article-highlight-headers) (gnus-article-highlight-signature) (gnus-article-add-buttons)) (defun gnus-article-hide (&optional force) "Hide current article. This function calls `gnus-article-hide-headers', `gnus-article-hide-citation-maybe', and `gnus-article-hide-signature' to do the hiding. See the documentation for those functions." (interactive (list 'force)) (gnus-article-hide-headers) (gnus-article-hide-citation-maybe force) (gnus-article-hide-signature)) (defun gnus-article-highlight-headers () "Highlight article headers as specified by `gnus-header-face-alist'." (interactive) (save-excursion (set-buffer gnus-article-buffer) (goto-char (point-min)) (if (not (search-forward "\n\n" nil t)) () (beginning-of-line 0) (while (not (bobp)) (let ((alist gnus-header-face-alist) (buffer-read-only nil) (case-fold-search t) (end (point)) (inhibit-point-motion-hooks t) begin entry regexp header-face field-face header-found field-found) (re-search-backward "^[^ \t]" nil t) (setq begin (point)) (while alist (setq entry (car alist) regexp (nth 0 entry) header-face (nth 1 entry) field-face (nth 2 entry) alist (cdr alist)) (if (looking-at regexp) (let ((from (point))) (skip-chars-forward "^:\n") (and (not header-found) header-face (progn (put-text-property from (point) 'face header-face) (setq header-found t))) (and (not field-found) field-face (progn (skip-chars-forward ": \t") (let ((from (point))) (goto-char end) (skip-chars-backward " \t") (put-text-property from (point) 'face field-face) (setq field-found t)))))) (goto-char begin))))))) (defun gnus-article-highlight-signature () "Highlight the signature in an article. It does this by highlighting everything after `gnus-signature-separator' using `gnus-signature-face'." (interactive) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) (goto-char (point-max)) (and (re-search-backward gnus-signature-separator nil t) gnus-signature-face (let ((start (match-beginning 0)) (end (match-end 0))) (gnus-article-add-button start end 'gnus-signature-toggle end) (gnus-overlay-put (gnus-make-overlay end (point-max)) 'face gnus-signature-face)))))) (defun gnus-article-hide-signature () "Hide the signature in an article. It does this by making everything after `gnus-signature-separator' invisible." (interactive) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (goto-char (point-max)) (and (re-search-backward gnus-signature-separator nil t) gnus-signature-face (add-text-properties (match-end 0) (point-max) gnus-hidden-properties))))) (defun gnus-article-add-buttons (&optional force) "Find external references in article and make them to buttons. External references are things like message-ids and URLs, as specified by `gnus-button-alist'." (interactive (list 'force)) (if (eq gnus-button-last gnus-button-alist) () (setq gnus-button-regexp (mapconcat 'car gnus-button-alist "\\|") gnus-button-last gnus-button-alist)) (save-excursion (set-buffer gnus-article-buffer) (gnus-cite-parse-maybe force) (let ((buffer-read-only nil) (inhibit-point-motion-hooks t) (case-fold-search t)) (goto-char (point-min)) (or (search-forward "\n\n" nil t) (goto-char (point-max))) (while (re-search-forward gnus-button-regexp nil t) (goto-char (match-beginning 0)) (let* ((from (point)) (entry (gnus-button-entry)) (start (and entry (match-beginning (nth 1 entry)))) (end (and entry (match-end (nth 1 entry)))) (form (nth 2 entry))) (if (not entry) () (goto-char (match-end 0)) (if (eval form) (gnus-article-add-button start end 'gnus-button-push (set-marker (make-marker) from))))))))) (defun gnus-netscape-open-url (url) "Open URL in netscape, or start new scape with URL." (let ((process (start-process (concat "netscape " url) nil "netscape" "-remote" (concat "openUrl(" url ")'")))) (set-process-sentinel process (` (lambda (process change) (or (eq (process-exit-status process) 0) (gnus-netscape-start-url (, url)))))))) (defun gnus-netscape-start-url (url) "Start netscape with URL." (start-process (concat "netscape" url) nil "netscape" url)) ;;; External functions: (defun gnus-article-add-button (from to fun &optional data) "Create a button between FROM and TO with callback FUN and data DATA." (and gnus-article-button-face (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) (add-text-properties from to (append (and gnus-article-mouse-face (list 'mouse-face gnus-article-mouse-face)) (list 'gnus-callback fun) (and data (list 'gnus-data data))))) ;;; Internal functions: (defun gnus-signature-toggle (end) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (if (get-text-property end 'invisible) (remove-text-properties end (point-max) gnus-hidden-properties) (add-text-properties end (point-max) gnus-hidden-properties))))) ;see gnus-cus.el ;(defun gnus-make-face (color) ; ;; Create entry for face with COLOR. ; (if gnus-make-foreground ; (custom-face-lookup color nil nil nil nil nil) ; (custom-face-lookup nil color nil nil nil nil))) (defun gnus-button-entry () ;; Return the first entry in `gnus-button-alist' matching this place. (let ((alist gnus-button-alist) (entry nil)) (while alist (setq entry (car alist) alist (cdr alist)) (if (looking-at (car entry)) (setq alist nil) (setq entry nil))) entry)) (defun gnus-button-push (marker) ;; Push button starting at MARKER. (save-excursion (set-buffer gnus-article-buffer) (goto-char marker) (let* ((entry (gnus-button-entry)) (inhibit-point-motion-hooks t) (fun (nth 3 entry)) (args (mapcar (lambda (group) (let ((string (buffer-substring (match-beginning group) (match-end group)))) (set-text-properties 0 (length string) nil string) string)) (nthcdr 4 entry)))) (cond ((fboundp fun) (apply fun args)) ((and (boundp fun) (fboundp (symbol-value fun))) (apply (symbol-value fun) args)) (t (message "You must define `%S' to use this button" (cons fun args))))))) (defun gnus-button-message-id (message-id) ;; Push on MESSAGE-ID. (save-excursion (set-buffer gnus-summary-buffer) (gnus-summary-refer-article message-id))) ;;; Compatibility Functions: (or (fboundp 'rassoc) ;; Introduced in Emacs 19.29. (defun rassoc (elt list) "Return non-nil if ELT is `equal' to the cdr of an element of LIST. The value is actually the element of LIST whose cdr is ELT." (let (result) (while list (setq result (car list)) (if (equal (cdr result) elt) (setq list nil) (setq result nil list (cdr list)))) result))) ; (require 'gnus-cus) (gnus-ems-redefine) (provide 'gnus-vis) ;;; gnus-vis.el ends here emacs-19.30/lisp/gnus-vm.el100444 23053 1 21236 6046561474 14345 0ustar larsidaemon;;; gnus-vm.el --- vm interface for Gnus ;; Copyright (C) 1994,95 Free Software Foundation, Inc. ;; Author: Per Persson ;; Keywords: news, mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Major contributors: ;; Christian Limpach ;; Some code stolen from: ;; Rick Sladkey ;;; Code: (require 'sendmail) (require 'gnus) (require 'gnus-msg) (eval-when-compile (autoload 'vm-mode "vm") (autoload 'vm-save-message "vm") (autoload 'vm-forward-message "vm") (autoload 'vm-reply "vm") (autoload 'vm-mail "vm")) (defvar gnus-vm-inhibit-window-system nil "Inhibit loading `win-vm' if using a window-system. Has to be set before gnus-vm is loaded.") (or gnus-vm-inhibit-window-system (condition-case nil (if window-system (require 'win-vm)) (error nil))) (if (not (featurep 'vm)) (load "vm")) (defun gnus-vm-make-folder (&optional buffer) (let ((article (or buffer (current-buffer))) (tmp-folder (generate-new-buffer " *tmp-folder*")) (start (point-min)) (end (point-max))) (set-buffer tmp-folder) (insert-buffer-substring article start end) (goto-char (point-min)) (if (looking-at "^\\(From [^ ]+ \\).*$") (replace-match (concat "\\1" (current-time-string))) (insert "From " gnus-newsgroup-name " " (current-time-string) "\n")) (while (re-search-forward "\n\nFrom " nil t) (replace-match "\n\n>From ")) ;; insert a newline, otherwise the last line gets lost (goto-char (point-max)) (insert "\n") (vm-mode) tmp-folder)) (defun gnus-summary-save-article-vm (&optional arg) "Append the current article to a vm folder. If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") (let ((gnus-default-article-saver 'gnus-summary-save-in-vm)) (gnus-summary-save-article arg))) (defun gnus-summary-save-in-vm (&optional folder) (interactive) (let ((default-name (funcall gnus-mail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-mail))) (or folder (setq folder (read-file-name (concat "Save article in VM folder: (default " (file-name-nondirectory default-name) ") ") (file-name-directory default-name) default-name))) (setq folder (expand-file-name folder (and default-name (file-name-directory default-name)))) (gnus-make-directory (file-name-directory folder)) (set-buffer gnus-article-buffer) (save-excursion (save-restriction (widen) (let ((vm-folder (gnus-vm-make-folder))) (vm-save-message folder) (kill-buffer vm-folder)))) ;; Remember the directory name to save articles. (setq gnus-newsgroup-last-mail folder))) (defun gnus-mail-forward-using-vm (&optional buffer) "Forward the current message to another user using vm." (let* ((gnus-buffer (or buffer (current-buffer))) (subject (gnus-forward-make-subject gnus-buffer))) (or (featurep 'win-vm) (if gnus-use-full-window (pop-to-buffer gnus-article-buffer) (switch-to-buffer gnus-article-buffer))) (gnus-copy-article-buffer) (set-buffer gnus-article-copy) (save-excursion (save-restriction (widen) (let ((vm-folder (gnus-vm-make-folder)) (vm-forward-message-hook (append (symbol-value 'vm-forward-message-hook) '((lambda () (save-excursion (mail-position-on-field "Subject") (beginning-of-line) (looking-at "^\\(Subject: \\).*$") (replace-match (concat "\\1" subject)))))))) (vm-forward-message) (gnus-vm-init-reply-buffer gnus-buffer) (run-hooks 'gnus-mail-hook) (kill-buffer vm-folder)))))) (defun gnus-vm-init-reply-buffer (buffer) (make-local-variable 'gnus-summary-buffer) (setq gnus-summary-buffer buffer) (set 'vm-mail-buffer nil) (use-local-map (copy-keymap (current-local-map))) (local-set-key "\C-c\C-y" 'gnus-yank-article)) (defun gnus-mail-reply-using-vm (&optional yank) "Compose reply mail using vm. Optional argument YANK means yank original article. The command \\[vm-yank-message] yank the original message into current buffer." (let ((gnus-buffer (current-buffer))) (gnus-copy-article-buffer) (set-buffer gnus-article-copy) (save-excursion (save-restriction (widen) (let ((vm-folder (gnus-vm-make-folder gnus-article-copy))) (vm-reply 1) (gnus-vm-init-reply-buffer gnus-buffer) (setq gnus-buffer (current-buffer)) (and yank ;; nil will (magically :-)) yank the current article (gnus-yank-article nil)) (kill-buffer vm-folder)))) (if (featurep 'win-vm) nil (pop-to-buffer gnus-buffer)) (run-hooks 'gnus-mail-hook))) (defun gnus-mail-other-window-using-vm () "Compose mail in the other window using VM." (interactive) (let ((gnus-buffer (current-buffer))) (vm-mail) (gnus-vm-init-reply-buffer gnus-buffer)) (run-hooks 'gnus-mail-hook)) (defun gnus-yank-article (article &optional prefix) ;; Based on vm-yank-message by Kyle Jones. "Yank article number N into the current buffer at point. When called interactively N is read from the minibuffer. This command is meant to be used in GNUS created Mail mode buffers; the yanked article comes from the newsgroup containing the article you are replying to or forwarding. All article headers are yanked along with the text. Point is left before the inserted text, the mark after. Any hook functions bound to `mail-citation-hook' are run, after inserting the text and setting point and mark. Prefix arg means to ignore `mail-citation-hook', don't set the mark, prepend the value of `vm-included-text-prefix' to every yanked line. For backwards compatibility, if `mail-citation-hook' is set to nil, `mail-yank-hooks' is run instead. If that is also nil, a default action is taken." (interactive (list (let ((result 0) default prompt) (setq default (and gnus-summary-buffer (save-excursion (set-buffer gnus-summary-buffer) (and gnus-current-article (int-to-string gnus-current-article)))) prompt (if default (format "Yank article number: (default %s) " default) "Yank article number: ")) (while (and (not (stringp result)) (zerop result)) (setq result (read-string prompt)) (and (string= result "") default (setq result default)) (or (string-match "^<.*>$" result) (setq result (string-to-int result)))) result) current-prefix-arg)) (if gnus-summary-buffer (save-excursion (let ((message (current-buffer)) (start (point)) end (tmp (generate-new-buffer " *tmp-yank*"))) (set-buffer gnus-summary-buffer) ;; Make sure the connection to the server is alive. (or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name)) (progn (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-request-group gnus-newsgroup-name t))) (and (stringp article) (let ((gnus-override-method gnus-refer-article-method)) (gnus-read-header article))) (gnus-request-article (or article gnus-current-article) gnus-newsgroup-name tmp) (set-buffer tmp) (run-hooks 'gnus-article-prepare-hook) ;; Decode MIME message. (if (and gnus-show-mime (gnus-fetch-field "Mime-Version")) (funcall gnus-show-mime-method)) ;; Perform the article display hooks. (let ((buffer-read-only nil)) (run-hooks 'gnus-article-display-hook)) (append-to-buffer message (point-min) (point-max)) (kill-buffer tmp) (set-buffer message) (setq end (point)) (goto-char start) (if (or prefix (not (or mail-citation-hook mail-yank-hooks))) (save-excursion (while (< (point) end) (insert (symbol-value 'vm-included-text-prefix)) (forward-line 1))) (push-mark end) (cond (mail-citation-hook (run-hooks 'mail-citation-hook)) (mail-yank-hooks (run-hooks 'mail-yank-hooks)))))))) (provide 'gnus-vm) ;;; gnus-vm.el ends here. emacs-19.30/lisp/gnus.el100444 23053 1 1774275 6053235747 14007 0ustar larsidaemon;;; gnus.el --- a newsreader for GNU Emacs ;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Although Gnus looks suspiciously like GNUS, it isn't quite the same ;; beast. Most internal structures have been changed. If you have ;; written packages that depend on any of the hash tables, ;; `gnus-newsrc-alist', `gnus-killed-assoc', marked lists, the .newsrc ;; buffer, or internal knowledge of the `nntp-header-' macros, or ;; dependence on the buffers having a certain format, your code will ;; fail. ;;; Code: (eval '(run-hooks 'gnus-load-hook)) (require 'mail-utils) (require 'timezone) (require 'nnheader) ;; Site dependent variables. These variables should be defined in ;; paths.el. (defvar gnus-default-nntp-server nil "Specify a default NNTP server. This variable should be defined in paths.el, and should never be set by the user. If you want to change servers, you should use `gnus-select-method'. See the documentation to that variable.") (defconst gnus-backup-default-subscribed-newsgroups '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") "Default default new newsgroups the first time Gnus is run. Should be set in paths.el, and shouldn't be touched by the user.") (defvar gnus-local-domain nil "Local domain name without a host name. The DOMAINNAME environment variable is used instead if it is defined. If the `system-name' function returns the full Internet name, there is no need to set this variable.") (defvar gnus-local-organization nil "String with a description of what organization (if any) the user belongs to. The ORGANIZATION environment variable is used instead if it is defined. If this variable contains a function, this function will be called with the current newsgroup name as the argument. The function should return a string. In any case, if the string (either in the variable, in the environment variable, or returned by the function) is a file name, the contents of this file will be used as the organization.") (defvar gnus-use-generic-from nil "If nil, the full host name will be the system name prepended to the domain name. If this is a string, the full host name will be this string. If this is non-nil, non-string, the domain name will be used as the full host name.") (defvar gnus-use-generic-path nil "If nil, use the NNTP server name in the Path header. If stringp, use this; if non-nil, use no host name (user name only).") ;; Customization variables ;; Don't touch this variable. (defvar gnus-nntp-service "nntp" "*NNTP service name (\"nntp\" or 119). This is an obsolete variable, which is scarcely used. If you use an nntp server for your newsgroup and want to change the port number used to 899, you would say something along these lines: (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") (defvar gnus-select-method (nconc (list 'nntp (or (getenv "NNTPSERVER") (if (and gnus-default-nntp-server (not (string= gnus-default-nntp-server ""))) gnus-default-nntp-server) (system-name))) (if (or (null gnus-nntp-service) (equal gnus-nntp-service "nntp")) nil (list gnus-nntp-service))) "*Default method for selecting a newsgroup. This variable should be a list, where the first element is how the news is to be fetched, the second is the address. For instance, if you want to get your news via NNTP from \"flab.flab.edu\", you could say: (setq gnus-select-method '(nntp \"flab.flab.edu\")) If you want to use your local spool, say: (setq gnus-select-method (list 'nnspool (system-name))) If you use this variable, you must set `gnus-nntp-server' to nil. There is a lot more to know about select methods and virtual servers - see the manual for details.") ;; Added by Sudish Joseph . (defvar gnus-post-method nil "*Preferred method for posting USENET news. If this variable is nil, Gnus will use the current method to decide which method to use when posting. If it is non-nil, it will override the current method. This method will not be used in mail groups and the like, only in \"real\" newsgroups. The value must be a valid method as discussed in the documentation of `gnus-select-method'.") (defvar gnus-refer-article-method nil "*Preferred method for fetching an article by Message-ID. If you are reading news from the local spool (with nnspool), fetching articles by Message-ID is painfully slow. By setting this method to an nntp method, you might get acceptable results. The value of this variable must be a valid select method as discussed in the documentation of `gnus-select-method'") (defvar gnus-secondary-select-methods nil "*A list of secondary methods that will be used for reading news. This is a list where each element is a complete select method (see `gnus-select-method'). If, for instance, you want to read your mail with the nnml backend, you could set this variable: (setq gnus-secondary-select-methods '((nnml \"\")))") (defvar gnus-secondary-servers nil "*List of NNTP servers that the user can choose between interactively. To make Gnus query you for a server, you have to give `gnus' a non-numeric prefix - `C-u M-x gnus', in short.") (defvar gnus-nntp-server nil "*The name of the host running the NNTP server. This variable is semi-obsolete. Use the `gnus-select-method' variable instead.") (defvar gnus-startup-file "~/.newsrc" "*Your `.newsrc' file. `.newsrc-SERVER' will be used instead if that exists.") (defvar gnus-init-file "~/.gnus" "*Your Gnus elisp startup file. If a file with the .el or .elc suffixes exist, it will be read instead.") (defvar gnus-group-faq-directory "/ftp@mirrors.aol.com:/pub/rtfm/usenet/" "*Directory where the group FAQs are stored. This will most commonly be on a remote machine, and the file will be fetched by ange-ftp. Note that Gnus uses an aol machine as the default directory. If this feels fundamentally unclean, just think of it as a way to finally get something of value back from them. If the default site is too slow, try one of these: North America: ftp.uu.net /usenet/news.answers mirrors.aol.com /pub/rtfm/usenet ftp.seas.gwu.edu /pub/rtfm rtfm.mit.edu /pub/usenet/news.answers Europe: ftp.uni-paderborn.de /pub/FAQ ftp.Germany.EU.net /pub/newsarchive/news.answers ftp.sunet.se /pub/usenet Asia: nctuccca.edu.tw /USENET/FAQ hwarang.postech.ac.kr /pub/usenet/news.answers ftp.hk.super.net /mirror/faqs") (defvar gnus-group-archive-directory "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" "*The address of the (ding) archives.") (defvar gnus-group-recent-archive-directory "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" "*The address of the most recent (ding) articles.") (defvar gnus-default-subscribed-newsgroups nil "*This variable lists what newsgroups should be subscribed the first time Gnus is used. It should be a list of strings. If it is `t', Gnus will not do anything special the first time it is started; it'll just use the normal newsgroups subscription methods.") (defvar gnus-use-cross-reference t "*Non-nil means that cross referenced articles will be marked as read. If nil, ignore cross references. If t, mark articles as read in subscribed newsgroups. If neither t nor nil, mark as read in all newsgroups.") (defvar gnus-use-dribble-file t "*Non-nil means that Gnus will use a dribble file to store user updates. If Emacs should crash without saving the .newsrc files, complete information can be restored from the dribble file.") (defvar gnus-asynchronous nil "*If non-nil, Gnus will supply backends with data needed for async article fetching.") (defvar gnus-asynchronous-article-function nil "*Function for picking articles to pre-fetch, possibly.") (defvar gnus-score-file-single-match-alist nil "*Alist mapping regexps to lists of score files. Each element of this alist should be of the form (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) If the name of a group is matched by REGEXP, the corresponding scorefiles will be used for that group. The first match found is used, subsequent matching entries are ignored (to use multiple matches, see gnus-score-file-multiple-match-alist). These score files are loaded in addition to any files returned by gnus-score-find-score-files-function (which see).") (defvar gnus-score-file-multiple-match-alist nil "*Alist mapping regexps to lists of score files. Each element of this alist should be of the form (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) If the name of a group is matched by REGEXP, the corresponding scorefiles will be used for that group. If multiple REGEXPs match a group, the score files corresponding to each match will be used (for only one match to be used, see gnus-score-file-single-match-alist). These score files are loaded in addition to any files returned by gnus-score-find-score-files-function (which see).") (defvar gnus-score-file-suffix "SCORE" "*Suffix of the score files.") (defvar gnus-adaptive-file-suffix "ADAPT" "*Suffix of the adaptive score files.") (defvar gnus-score-find-score-files-function 'gnus-score-find-bnews "*Function used to find score files. The function will be called with the group name as the argument, and should return a list of score files to apply to that group. The score files do not actually have to exist. Predefined values are: gnus-score-find-single: Only apply the group's own score file. gnus-score-find-hierarchical: Also apply score files from parent groups. gnus-score-find-bnews: Apply score files whose names matches. See the documentation to these functions for more information. This variable can also be a list of functions to be called. Each function should either return a list of score files, or a list of score alists.") (defvar gnus-score-interactive-default-score 1000 "*Scoring commands will raise/lower the score with this number as the default.") (defvar gnus-large-newsgroup 200 "*The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than this value, confirmation is required for selecting the newsgroup.") ;; Suggested by Andrew Eskilsson . (defvar gnus-no-groups-message "No news is horrible news" "*Message displayed by Gnus when no groups are available.") (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) "*Non-nil means that the default name of a file to save articles in is the group name. If it's nil, the directory form of the group name is used instead. If this variable is a list, and the list contains the element `not-score', long file names will not be used for score files; if it contains the element `not-save', long file names will not be used for saving; and if it contains the element `not-kill', long file names will not be used for kill files.") (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/") "*Name of the directory articles will be saved in (default \"~/News\"). Initialized from the SAVEDIR environment variable.") (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/") "*Name of the directory where kill files will be stored (default \"~/News\"). Initialized from the SAVEDIR environment variable.") (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail "*A function to save articles in your favorite format. The function must be interactively callable (in other words, it must be an Emacs command). Gnus provides the following functions: * gnus-summary-save-in-rmail (Rmail format) * gnus-summary-save-in-mail (Unix mail format) * gnus-summary-save-in-folder (MH folder) * gnus-summary-save-in-file (article format). * gnus-summary-save-in-vm (use VM's folder format).") (defvar gnus-rmail-save-name (function gnus-plain-save-name) "*A function generating a file name to save articles in Rmail format. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") (defvar gnus-mail-save-name (function gnus-plain-save-name) "*A function generating a file name to save articles in Unix mail format. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") (defvar gnus-folder-save-name (function gnus-folder-save-name) "*A function generating a file name to save articles in MH folder. The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.") (defvar gnus-file-save-name (function gnus-numeric-save-name) "*A function generating a file name to save articles in article format. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") (defvar gnus-split-methods nil "*Variable used to suggest where articles are to be saved. The syntax of this variable is the same as `nnmail-split-methods'. For instance, if you would like to save articles related to Gnus in the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", you could set this variable to something like: '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))") (defvar gnus-save-score nil "*If non-nil, save group scoring info.") (defvar gnus-use-adaptive-scoring nil "*If non-nil, use some adaptive scoring scheme.") (defvar gnus-use-cache nil "*If non-nil, Gnus will cache (some) articles locally.") (defvar gnus-use-scoring t "*If non-nil, enable scoring.") (defvar gnus-fetch-old-headers nil "*Non-nil means that Gnus will try to build threads by grabbing old headers. If an unread article in the group refers to an older, already read (or just marked as read) article, the old article will not normally be displayed in the Summary buffer. If this variable is non-nil, Gnus will attempt to grab the headers to the old articles, and thereby build complete threads. If it has the value `some', only enough headers to connect otherwise loose threads will be displayed. The server has to support XOVER for any of this to work.") ;see gnus-cus.el ;(defvar gnus-visual t ; "*If non-nil, will do various highlighting. ;If nil, no mouse highlights (or any other highlights) will be ;performed. This might speed up Gnus some when generating large group ;and summary buffers.") (defvar gnus-novice-user t "*Non-nil means that you are a usenet novice. If non-nil, verbose messages may be displayed and confirmations may be required.") (defvar gnus-expert-user nil "*Non-nil means that you will never be asked for confirmation about anything. And that means *anything*.") (defvar gnus-verbose 7 "*Integer that says how verbose Gnus should be. The higher the number, the more messages Gnus will flash to say what it's doing. At zero, Gnus will be totally mute; at five, Gnus will display most important messages; and at ten, Gnus will keep on jabbering all the time.") (defvar gnus-keep-same-level nil "*Non-nil means that the next newsgroup after the current will be on the same level. When you type, for instance, `n' after reading the last article in the current newsgroup, you will go to the next newsgroup. If this variable is nil, the next newsgroup will be the next from the group buffer. If this variable is non-nil, Gnus will either put you in the next newsgroup with the same level, or, if no such newsgroup is available, the next newsgroup with the lowest possible level higher than the current level. If this variable is `best', Gnus will make the next newsgroup the one with the best level.") (defvar gnus-summary-make-false-root 'adopt "*nil means that Gnus won't gather loose threads. If the root of a thread has expired or been read in a previous session, the information necessary to build a complete thread has been lost. Instead of having many small sub-threads from this original thread scattered all over the summary buffer, Gnus can gather them. If non-nil, Gnus will try to gather all loose sub-threads from an original thread into one large thread. If this variable is non-nil, it should be one of `none', `adopt', `dummy' or `empty'. If this variable is `none', Gnus will not make a false root, but just present the sub-threads after another. If this variable is `dummy', Gnus will create a dummy root that will have all the sub-threads as children. If this variable is `adopt', Gnus will make one of the \"children\" the parent and mark all the step-children as such. If this variable is `empty', the \"children\" are printed with empty subject fields. (Or rather, they will be printed with a string given by the `gnus-summary-same-subject' variable.)") (defvar gnus-summary-gather-subject-limit nil "*Maximum length of subject comparisons when gathering loose threads. Use nil to compare full subjects. Setting this variable to a low number will help gather threads that have been corrupted by newsreaders chopping off subject lines, but it might also mean that unrelated articles that have subject that happen to begin with the same few characters will be incorrectly gathered. If this variable is `fuzzy', Gnus will use a fuzzy algorithm when comparing subjects.") ;; Added by Per Abrahamsen . (defvar gnus-summary-same-subject "" "*String indicating that the current article has the same subject as the previous. This variable will only be used if the value of `gnus-summary-make-false-root' is `empty'.") (defvar gnus-summary-goto-unread t "*If non-nil, marking commands will go to the next unread article.") (defvar gnus-group-goto-unread t "*If non-nil, movement commands will go to the next unread and subscribed group.") (defvar gnus-check-new-newsgroups t "*Non-nil means that Gnus will add new newsgroups at startup. If this variable is `ask-server', Gnus will ask the server for new groups since the last time it checked. This means that the killed list is no longer necessary, so you could set `gnus-save-killed-list' to nil. A variant is to have this variable be a list of select methods. Gnus will then use the `ask-server' method on all these select methods to query for new groups from all those servers. Eg. (setq gnus-check-new-newsgroups '((nntp \"some.server\") (nntp \"other.server\"))) If this variable is nil, then you have to tell Gnus explicitly to check for new newsgroups with \\\\[gnus-find-new-newsgroups].") (defvar gnus-check-bogus-newsgroups nil "*Non-nil means that Gnus will check and remove bogus newsgroup at startup. If this variable is nil, then you have to tell Gnus explicitly to check for bogus newsgroups with \\\\[gnus-group-check-bogus-groups].") (defvar gnus-read-active-file t "*Non-nil means that Gnus will read the entire active file at startup. If this variable is nil, Gnus will only know about the groups in your `.newsrc' file. If this variable is `some', Gnus will try to only read the relevant parts of the active file from the server. Not all servers support this, and it might be quite slow with other servers, but this should generally be faster than both the t and nil value. If you set this variable to nil or `some', you probably still want to be told about new newsgroups that arrive. To do that, set `gnus-check-new-newsgroups' to `ask-server'. This may not work properly with all servers.") (defvar gnus-level-subscribed 5 "*Groups with levels less than or equal to this variable are subscribed.") (defvar gnus-level-unsubscribed 7 "*Groups with levels less than or equal to this variable are unsubscribed. Groups with levels less than `gnus-level-subscribed', which should be less than this variable, are subscribed.") (defvar gnus-level-zombie 8 "*Groups with this level are zombie groups.") (defvar gnus-level-killed 9 "*Groups with this level are killed.") (defvar gnus-level-default-subscribed 3 "*New subscribed groups will be subscribed at this level.") (defvar gnus-level-default-unsubscribed 6 "*New unsubscribed groups will be unsubscribed at this level.") (defvar gnus-activate-foreign-newsgroups 4 "*If nil, Gnus will not check foreign newsgroups at startup. If it is non-nil, it should be a number between one and nine. Foreign newsgroups that have a level lower or equal to this number will be activated on startup. For instance, if you want to active all subscribed newsgroups, but not the rest, you'd set this variable to `gnus-level-subscribed'. If you subscribe to lots of newsgroups from different servers, startup might take a while. By setting this variable to nil, you'll save time, but you won't be told how many unread articles there are in the groups.") (defvar gnus-save-newsrc-file t "*Non-nil means that Gnus will save the `.newsrc' file. Gnus always saves its own startup file, which is called \".newsrc.eld\". The file called \".newsrc\" is in a format that can be readily understood by other newsreaders. If you don't plan on using other newsreaders, set this variable to nil to save some time on exit.") (defvar gnus-save-killed-list t "*If non-nil, save the list of killed groups to the startup file. This will save both time (when starting and quitting) and space (both memory and disk), but it will also mean that Gnus has no record of which groups are new and which are old, so the automatic new newsgroups subscription methods become meaningless. You should always set `gnus-check-new-newsgroups' to `ask-server' or nil if you set this variable to nil.") (defvar gnus-interactive-catchup t "*If non-nil, require your confirmation when catching up a group.") (defvar gnus-interactive-post t "*If non-nil, group name will be asked for when posting.") (defvar gnus-interactive-exit t "*If non-nil, require your confirmation when exiting Gnus.") (defvar gnus-kill-killed t "*If non-nil, Gnus will apply kill files to already killed articles. If it is nil, Gnus will never apply kill files to articles that have already been through the scoring process, which might very well save lots of time.") (defvar gnus-extract-address-components 'gnus-extract-address-components "*Function for extracting address components from a From header. Two pre-defined function exist: `gnus-extract-address-components', which is the default, quite fast, and too simplistic solution, and `mail-extract-address-components', which works much better, but is slower.") (defvar gnus-summary-default-score 0 "*Default article score level. If this variable is nil, scoring will be disabled.") (defvar gnus-summary-zcore-fuzz 0 "*Fuzziness factor for the zcore in the summary buffer. Articles with scores closer than this to `gnus-summary-default-score' will not be marked.") (defvar gnus-simplify-subject-fuzzy-regexp nil "*Regular expression that will be removed from subject strings if fuzzy subject simplification is selected.") (defvar gnus-group-default-list-level gnus-level-subscribed "*Default listing level. Ignored if `gnus-group-use-permanent-levels' is non-nil.") (defvar gnus-group-use-permanent-levels nil "*If non-nil, once you set a level, Gnus will use this level.") (defvar gnus-show-mime nil "*If non-nil, do mime processing of articles. The articles will simply be fed to the function given by `gnus-show-mime-method'.") (defvar gnus-strict-mime t "*If nil, decode MIME header even if there is not Mime-Version field.") (defvar gnus-show-mime-method (function metamail-buffer) "*Function to process a MIME message. The function is called from the article buffer.") (defvar gnus-show-threads t "*If non-nil, display threads in summary mode.") (defvar gnus-thread-hide-subtree nil "*If non-nil, hide all threads initially. If threads are hidden, you have to run the command `gnus-summary-show-thread' by hand or use `gnus-select-article-hook' to expose hidden threads.") (defvar gnus-thread-hide-killed t "*If non-nil, hide killed threads automatically.") (defvar gnus-thread-ignore-subject nil "*If non-nil, ignore subjects and do all threading based on the Reference header. If nil, which is the default, articles that have different subjects from their parents will start separate threads.") (defvar gnus-thread-indent-level 4 "*Number that says how much each sub-thread should be indented.") (defvar gnus-ignored-newsgroups (purecopy (mapconcat 'identity '("^to\\." ; not "real" groups "^[0-9. \t]+ " ; all digits in name "[][\"#'()]" ; bogus characters ) "\\|")) "*A regexp to match uninteresting newsgroups in the active file. Any lines in the active file matching this regular expression are removed from the newsgroup list before anything else is done to it, thus making them effectively non-existent.") (defvar gnus-ignored-headers "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:" "*All headers that match this regexp will be hidden. If `gnus-visible-headers' is non-nil, this variable will be ignored.") (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:" "*All headers that do not match this regexp will be hidden. If this variable is non-nil, `gnus-ignored-headers' will be ignored.") (defvar gnus-sorted-header-list '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" "^Cc:" "^Date:" "^Organization:") "*This variable is a list of regular expressions. If it is non-nil, headers that match the regular expressions will be placed first in the article buffer in the sequence specified by this list.") (defvar gnus-show-all-headers nil "*If non-nil, don't hide any headers.") (defvar gnus-save-all-headers t "*If non-nil, don't remove any headers before saving.") (defvar gnus-inhibit-startup-message nil "*If non-nil, the startup message will not be displayed.") (defvar gnus-signature-separator "^-- *$" "Regexp matching signature separator.") (defvar gnus-auto-extend-newsgroup t "*If non-nil, extend newsgroup forward and backward when requested.") (defvar gnus-auto-select-first t "*If non-nil, select the first unread article when entering a group. If you want to prevent automatic selection of the first unread article in some newsgroups, set the variable to nil in `gnus-select-group-hook'.") (defvar gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. If the value is t and the next newsgroup is empty, Gnus will exit summary mode and go back to group mode. If the value is neither nil nor t, Gnus will select the following unread newsgroup. In particular, if the value is the symbol `quietly', the next unread newsgroup will be selected without any confirmations.") (defvar gnus-auto-select-same nil "*If non-nil, select the next article with the same subject.") (defvar gnus-summary-check-current nil "*If non-nil, consider the current article when moving. The \"unread\" movement commands will stay on the same line if the current article is unread.") (defvar gnus-auto-center-summary t "*If non-nil, always center the current summary buffer.") (defvar gnus-break-pages t "*If non-nil, do page breaking on articles. The page delimiter is specified by the `gnus-page-delimiter' variable.") (defvar gnus-page-delimiter "^\^L" "*Regexp describing what to use as article page delimiters. The default value is \"^\^L\", which is a form linefeed at the beginning of a line.") (defvar gnus-use-full-window t "*If non-nil, use the entire Emacs screen.") (defvar gnus-window-configuration nil "Obsolete variable. See `gnus-buffer-configuration'.") (defvar gnus-buffer-configuration '((group ([group 1.0 point] (if gnus-carpal [group-carpal 4]))) (summary ([summary 1.0 point] (if gnus-carpal [summary-carpal 4]))) (article ([summary 0.25 point] (if gnus-carpal [summary-carpal 4]) [article 1.0])) (server ([server 1.0 point] (if gnus-carpal [server-carpal 2]))) (browse ([browse 1.0 point] (if gnus-carpal [browse-carpal 2]))) (group-mail ([mail 1.0 point])) (summary-mail ([mail 1.0 point])) (summary-reply ([article 0.5] [mail 1.0 point])) (info ([nil 1.0 point])) (summary-faq ([summary 0.25] [faq 1.0 point])) (edit-group ([group 0.5] [edit-group 1.0 point])) (edit-server ([server 0.5] [edit-server 1.0 point])) (edit-score ([summary 0.25] [edit-score 1.0 point])) (post ([post 1.0 point])) (reply ([article 0.5] [mail 1.0 point])) (mail-forward ([mail 1.0 point])) (post-forward ([post 1.0 point])) (reply-yank ([mail 1.0 point])) (followup ([article 0.5] [post 1.0 point])) (followup-yank ([post 1.0 point]))) "Window configuration for all possible Gnus buffers. This variable is a list of lists. Each of these lists has a NAME and a RULE. The NAMEs are commonsense names like `group', which names a rule used when displaying the group buffer; `summary', which names a rule for what happens when you enter a group and do not display an article buffer; and so on. See the value of this variable for a complete list of NAMEs. Each RULE is a list of vectors. The first element in this vector is the name of the buffer to be displayed; the second element is the percentage of the screen this buffer is to occupy (a number in the 0.0-0.99 range); the optional third element is `point', which should be present to denote which buffer point is to go to after making this buffer configuration.") (defvar gnus-window-to-buffer '((group . gnus-group-buffer) (summary . gnus-summary-buffer) (article . gnus-article-buffer) (server . gnus-server-buffer) (browse . "*Gnus Browse Server*") (edit-group . gnus-group-edit-buffer) (edit-server . gnus-server-edit-buffer) (group-carpal . gnus-carpal-group-buffer) (summary-carpal . gnus-carpal-summary-buffer) (server-carpal . gnus-carpal-server-buffer) (browse-carpal . gnus-carpal-browse-buffer) (edit-score . gnus-score-edit-buffer) (mail . gnus-mail-buffer) (post . gnus-post-news-buffer) (faq . gnus-faq-buffer)) "Mapping from short symbols to buffer names or buffer variables.") (defvar gnus-carpal nil "*If non-nil, display clickable icons.") (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies "*Function called with a group name when new group is detected. A few pre-made functions are supplied: `gnus-subscribe-randomly' inserts new groups at the beginning of the list of groups; `gnus-subscribe-alphabetically' inserts new groups in strict alphabetic order; `gnus-subscribe-hierarchically' inserts new groups in hierarchical newsgroup order; `gnus-subscribe-interactively' asks for your decision.") ;; Suggested by a bug report by Hallvard B Furuseth. ;; . (defvar gnus-subscribe-options-newsgroup-method (function gnus-subscribe-alphabetically) "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines. If, for instance, you want to subscribe to all newsgroups in the \"no\" and \"alt\" hierarchies, you'd put the following in your .newsrc file: options -n no.all alt.all Gnus will the subscribe all new newsgroups in these hierarchies with the subscription method in this variable.") (defvar gnus-subscribe-hierarchical-interactive nil "*If non-nil, Gnus will offer to subscribe hierarchically. When a new hierarchy appears, Gnus will ask the user: 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys): If the user pressed `d', Gnus will descend the hierarchy, `y' will subscribe to all newsgroups in the hierarchy and `s' will skip this hierarchy in its entirety.") (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet "*Function used for sorting the group buffer. This function will be called with group info entries as the arguments for the groups to be sorted. Pre-made functions include `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread' and `gnus-group-sort-by-level'") ;; Mark variables suggested by Thomas Michanek ;; . (defvar gnus-unread-mark ? "*Mark used for unread articles.") (defvar gnus-ticked-mark ?! "*Mark used for ticked articles.") (defvar gnus-dormant-mark ?? "*Mark used for dormant articles.") (defvar gnus-del-mark ?r "*Mark used for del'd articles.") (defvar gnus-read-mark ?R "*Mark used for read articles.") (defvar gnus-expirable-mark ?E "*Mark used for expirable articles.") (defvar gnus-killed-mark ?K "*Mark used for killed articles.") (defvar gnus-kill-file-mark ?X "*Mark used for articles killed by kill files.") (defvar gnus-low-score-mark ?Y "*Mark used for articles with a low score.") (defvar gnus-catchup-mark ?C "*Mark used for articles that are caught up.") (defvar gnus-replied-mark ?A "*Mark used for articles that have been replied to.") (defvar gnus-process-mark ?# "*Process mark.") (defvar gnus-ancient-mark ?O "*Mark used for ancient articles.") (defvar gnus-canceled-mark ?G "*Mark used for canceled articles.") (defvar gnus-score-over-mark ?+ "*Score mark used for articles with high scores.") (defvar gnus-score-below-mark ?- "*Score mark used for articles with low scores.") (defvar gnus-empty-thread-mark ? "*There is no thread under the article.") (defvar gnus-not-empty-thread-mark ?= "*There is a thread under the article.") (defvar gnus-dummy-mark ?Z "*This is a dummy article.") (defvar gnus-view-pseudo-asynchronously nil "*If non-nil, Gnus will view pseudo-articles asynchronously.") (defvar gnus-view-pseudos nil "*If `automatic', pseudo-articles will be viewed automatically. If `not-confirm', pseudos will be viewed automatically, and the user will not be asked to confirm the command.") (defvar gnus-view-pseudos-separately t "*If non-nil, one pseudo-article will be created for each file to be viewed. If nil, all files that use the same viewing command will be given as a list of parameters to that command.") (defvar gnus-group-line-format "%M%S%p%5y: %(%g%)\n" "*Format of group lines. It works along the same lines as a normal formatting string, with some simple extensions. %M Only marked articles (character, \"*\" or \" \") %S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \") %L Level of subscribedness (integer) %N Number of unread articles (integer) %I Number of dormant articles (integer) %i Number of ticked and dormant (integer) %T Number of ticked articles (integer) %R Number of read articles (integer) %t Total number of articles (integer) %y Number of unread, unticked articles (integer) %G Group name (string) %g Qualified group name (string) %D Group description (string) %s Select method (string) %o Moderated group (char, \"m\") %p Process mark (char) %O Moderated group (string, \"(m)\" or \"\") %n Select from where (string) %z A string that look like `<%s:%n>' if a foreign select method is used %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, where X is the letter following %u. The function will be passed the current header as argument. The function should return a string, which will be inserted into the buffer just like information from any other group specifier. Text between %( and %) will be highlighted with `gnus-mouse-face' when the mouse point move inside the area. There can only be one such area. Note that this format specification is not always respected. For reasons of efficiency, when listing killed groups, this specification is ignored altogether. If the spec is changed considerably, your output may end up looking strange when listing both alive and killed groups. If you use %o or %O, reading the active file will be slower and quite a bit of extra memory will be used. %D will also worsen performance. Also note that if you change the format specification to include any of these specs, you must probably re-start Gnus to see them go into effect.") (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" "*The format specification of the lines in the summary buffer. It works along the same lines as a normal formatting string, with some simple extensions. %N Article number, left padded with spaces (string) %S Subject (string) %s Subject if it is at the root of a thread, and \"\" otherwise (string) %n Name of the poster (string) %a Extracted name of the poster (string) %A Extracted address of the poster (string) %F Contents of the From: header (string) %x Contents of the Xref: header (string) %D Date of the article (string) %d Date of the article (string) in DD-MMM format %M Message-id of the article (string) %r References of the article (string) %c Number of characters in the article (integer) %L Number of lines in the article (integer) %I Indentation based on thread level (a string of spaces) %T A string with two possible values: 80 spaces if the article is on thread level two or larger and 0 spaces on level one %R \"A\" if this article has been replied to, \" \" otherwise (character) %U Status of this article (character, \"R\", \"K\", \"-\" or \" \") %[ Opening bracket (character, \"[\" or \"<\") %] Closing bracket (character, \"]\" or \">\") %> Spaces of length thread-level (string) %< Spaces of length (- 20 thread-level) (string) %i Article score (number) %z Article zcore (character) %t Number of articles under the current thread (number). %e Whether the thread is empty or not (character). %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, where X is the letter following %u. The function will be passed the current header as argument. The function should return a string, which will be inserted into the summary just like information from any other summary specifier. Text between %( and %) will be highlighted with `gnus-mouse-face' when the mouse point is placed inside the area. There can only be one such area. The %U (status), %R (replied) and %z (zcore) specs have to be handled with care. For reasons of efficiency, Gnus will compute what column these characters will end up in, and \"hard-code\" that. This means that it is illegal to have these specs after a variable-length spec. Well, you might not be arrested, but your summary buffer will look strange, which is bad enough. The smart choice is to have these specs as for to the left as possible. This restriction may disappear in later versions of Gnus.") (defvar gnus-summary-dummy-line-format "* : : %S\n" "*The format specification for the dummy roots in the summary buffer. It works along the same lines as a normal formatting string, with some simple extensions. %S The subject") (defvar gnus-summary-mode-line-format "Gnus %G/%A %Z" "*The format specification for the summary mode line.") (defvar gnus-article-mode-line-format "Gnus %G/%A %S" "*The format specification for the article mode line.") (defvar gnus-group-mode-line-format "Gnus List of groups {%M:%S} " "*The format specification for the group mode line.") (defvar gnus-valid-select-methods '(("nntp" post address prompt-address) ("nnspool" post) ("nnvirtual" none virtual prompt-address) ("nnmbox" mail respool) ("nnml" mail respool) ("nnmh" mail respool) ("nndir" none prompt-address address) ("nneething" none prompt-address) ("nndigest" none) ("nndoc" none prompt-address) ("nnbabyl" mail respool) ("nnkiboze" post virtual) ;;("nnsoup" post) ("nnfolder" mail respool)) "An alist of valid select methods. The first element of each list lists should be a string with the name of the select method. The other elements may be be the category of this method (ie. `post', `mail', `none' or whatever) or other properties that this method has (like being respoolable). If you implement a new select method, all you should have to change is this variable. I think.") (defvar gnus-updated-mode-lines '(group article summary) "*List of buffers that should update their mode lines. The list may contain the symbols `group', `article' and `summary'. If the corresponding symbol is present, Gnus will keep that mode line updated with information that may be pertinent. If this variable is nil, screen refresh may be quicker.") ;; Added by Keinonen Kari . (defvar gnus-mode-non-string-length 21 "*Max length of mode-line non-string contents. If this is nil, Gnus will take space as is needed, leaving the rest of the modeline intact.") ;see gnus-cus.el ;(defvar gnus-mouse-face 'highlight ; "*Face used for mouse highlighting in Gnus. ;No mouse highlights will be done if `gnus-visual' is nil.") (defvar gnus-summary-mark-below nil "*Mark all articles with a score below this variable as read. This variable is local to each summary buffer and usually set by the score file.") (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number) "*List of functions used for sorting threads in the summary buffer. By default, threads are sorted by article number. Each function takes two threads and return non-nil if the first thread should be sorted before the other. If you use more than one function, the primary sort function should be the last. Ready-mady functions include `gnus-thread-sort-by-number', `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').") (defvar gnus-thread-score-function '+ "*Function used for calculating the total score of a thread. The function is called with the scores of the article and each subthread and should then return the score of the thread. Some functions you can use are `+', `max', or `min'.") (defvar gnus-options-subscribe nil "*All new groups matching this regexp will be subscribed unconditionally. Note that this variable deals only with new newsgroups. This variable does not affect old newsgroups.") (defvar gnus-options-not-subscribe nil "*All new groups matching this regexp will be ignored. Note that this variable deals only with new newsgroups. This variable does not affect old (already subscribed) newsgroups.") (defvar gnus-auto-expirable-newsgroups nil "*Groups in which to automatically mark read articles as expirable. If non-nil, this should be a regexp that should match all groups in which to perform auto-expiry. This only makes sense for mail groups.") (defvar gnus-hidden-properties '(invisible t intangible t) "Property list to use for hiding text.") (defvar gnus-modtime-botch nil "*Non-nil means .newsrc should be deleted prior to save. Its use is due to the bogus appearance that .newsrc was modified on disc.") ;; Hooks. (defvar gnus-group-mode-hook nil "*A hook for Gnus group mode.") (defvar gnus-summary-mode-hook nil "*A hook for Gnus summary mode. This hook is run before any variables are set in the summary buffer.") (defvar gnus-article-mode-hook nil "*A hook for Gnus article mode.") (defun gnus-summary-prepare-exit-hook nil "*A hook called when preparing to exit from the summary buffer. It calls `gnus-summary-expire-articles' by default.") (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles) (defun gnus-summary-exit-hook nil "*A hook called on exit from the summary buffer.") (defvar gnus-open-server-hook nil "*A hook called just before opening connection to the news server.") (defvar gnus-load-hook nil "*A hook run while Gnus is loaded.") (defvar gnus-startup-hook nil "*A hook called at startup. This hook is called after Gnus is connected to the NNTP server.") (defvar gnus-get-new-news-hook nil "*A hook run just before Gnus checks for new news.") (defvar gnus-group-prepare-function 'gnus-group-prepare-flat "*A function that is called to generate the group buffer. The function is called with three arguments: The first is a number; all group with a level less or equal to that number should be listed, if the second is non-nil, empty groups should also be displayed. If the third is non-nil, it is a number. No groups with a level lower than this number should be displayed. The only current function implemented is `gnus-group-prepare-flat'.") (defvar gnus-group-prepare-hook nil "*A hook called after the group buffer has been generated. If you want to modify the group buffer, you can use this hook.") (defvar gnus-summary-prepare-hook nil "*A hook called after the summary buffer has been generated. If you want to modify the summary buffer, you can use this hook.") (defvar gnus-article-prepare-hook nil "*A hook called after an article has been prepared in the article buffer. If you want to run a special decoding program like nkf, use this hook.") ;(defvar gnus-article-display-hook nil ; "*A hook called after the article is displayed in the article buffer. ;The hook is designed to change the contents of the article ;buffer. Typical functions that this hook may contain are ;`gnus-article-hide-headers' (hide selected headers), ;`gnus-article-maybe-highlight' (perform fancy article highlighting), ;`gnus-article-hide-signature' (hide signature) and ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).") ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted) ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike) ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight) (defvar gnus-article-x-face-command "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" "String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command.") (defvar gnus-article-x-face-too-ugly nil "Regexp matching posters whose face shouldn't be shown automatically.") (defvar gnus-select-group-hook nil "*A hook called when a newsgroup is selected. If you'd like to simplify subjects like the `gnus-summary-next-same-subject' command does, you can use the following hook: (setq gnus-select-group-hook (list (lambda () (mapcar (lambda (header) (mail-header-set-subject header (gnus-simplify-subject (mail-header-subject header) 're-only))) gnus-newsgroup-headers))))") (defvar gnus-select-article-hook '(gnus-summary-show-thread) "*A hook called when an article is selected. The default hook shows conversation thread subtrees of the selected article automatically using `gnus-summary-show-thread'.") (defvar gnus-apply-kill-hook '(gnus-apply-kill-file) "*A hook called to apply kill files to a group. This hook is intended to apply a kill file to the selected newsgroup. The function `gnus-apply-kill-file' is called by default. Since a general kill file is too heavy to use only for a few newsgroups, I recommend you to use a lighter hook function. For example, if you'd like to apply a kill file to articles which contains a string `rmgroup' in subject in newsgroup `control', you can use the following hook: (setq gnus-apply-kill-hook (list (lambda () (cond ((string-match \"control\" gnus-newsgroup-name) (gnus-kill \"Subject\" \"rmgroup\") (gnus-expunge \"X\"))))))") (defvar gnus-visual-mark-article-hook (list 'gnus-highlight-selected-summary) "*Hook run after selecting an article in the summary buffer. It is meant to be used for highlighting the article in some way. It is not run if `gnus-visual' is nil.") (defvar gnus-exit-group-hook nil "*A hook called when exiting (not quitting) summary mode.") (defvar gnus-suspend-gnus-hook nil "*A hook called when suspending (not exiting) Gnus.") (defvar gnus-exit-gnus-hook nil "*A hook called when exiting Gnus.") (defvar gnus-save-newsrc-hook nil "*A hook called when saving the newsrc file.") (defvar gnus-summary-update-hook (list 'gnus-summary-highlight-line) "*A hook called when a summary line is changed. The hook will not be called if `gnus-visual' is nil. The default function `gnus-summary-highlight-line' will highlight the line according to the `gnus-summary-highlight' variable.") (defvar gnus-mark-article-hook (list 'gnus-summary-mark-unread-as-read) "*A hook called when an article is selected for the first time. The hook is intended to mark an article as read (or unread) automatically when it is selected.") ;; Remove any hilit infestation. (add-hook 'gnus-startup-hook (lambda () (remove-hook 'gnus-summary-prepare-hook 'hilit-rehighlight-buffer-quietly) (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks) (setq gnus-mark-article-hook '(gnus-summary-mark-unread-as-read)) (remove-hook 'gnus-article-prepare-hook 'hilit-rehighlight-buffer-quietly))) ;; Internal variables ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) (defvar gnus-newsgroup-selected-overlay nil) (defvar gnus-article-mode-map nil) (defvar gnus-dribble-buffer nil) (defvar gnus-headers-retrieved-by nil) (defvar gnus-article-reply nil) (defvar gnus-override-method nil) (defvar gnus-article-check-size nil) (defvar gnus-current-score-file nil) (defvar gnus-internal-global-score-files nil) (defvar gnus-score-file-list nil) (defvar gnus-scores-exclude-files nil) (defvar gnus-current-move-group nil) (defvar gnus-newsgroup-dependencies nil) (defvar gnus-newsgroup-threads nil) (defvar gnus-newsgroup-async nil) (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*") (defvar gnus-newsgroup-adaptive nil) (defvar gnus-summary-display-table nil) (defconst gnus-group-line-format-alist (list (list ?M 'marked ?c) (list ?S 'subscribed ?c) (list ?L 'level ?d) (list ?N 'number ?s) (list ?I 'number-of-dormant ?d) (list ?T 'number-of-ticked ?d) (list ?R 'number-of-read ?s) (list ?t 'number-total ?d) (list ?y 'number-of-unread-unticked ?s) (list ?i 'number-of-ticked-and-dormant ?d) (list ?g 'group ?s) (list ?G 'qualified-group ?s) (list ?D 'newsgroup-description ?s) (list ?o 'moderated ?c) (list ?O 'moderated-string ?s) (list ?p 'process-marked ?c) (list ?s 'news-server ?s) (list ?n 'news-method ?s) (list ?z 'news-method-string ?s) (list ?u 'user-defined ?s))) (defconst gnus-summary-line-format-alist (list (list ?N 'number ?d) (list ?S 'subject ?s) (list ?s 'subject-or-nil ?s) (list ?n 'name ?s) (list ?A '(car (cdr (funcall gnus-extract-address-components from))) ?s) (list ?a '(or (car (funcall gnus-extract-address-components from)) from) ?s) (list ?F 'from ?s) (list ?x (macroexpand '(mail-header-xref header)) ?s) (list ?D (macroexpand '(mail-header-date header)) ?s) (list ?d '(gnus-dd-mmm (mail-header-date header)) ?s) (list ?M (macroexpand '(mail-header-id header)) ?s) (list ?r (macroexpand '(mail-header-references header)) ?s) (list ?c '(or (mail-header-chars header) 0) ?d) (list ?L 'lines ?d) (list ?I 'indentation ?s) (list ?T '(if (= level 0) "" (make-string (frame-width) ? )) ?s) (list ?R 'replied ?c) (list ?\[ 'opening-bracket ?c) (list ?\] 'closing-bracket ?c) (list ?\> '(make-string level ? ) ?s) (list ?\< '(make-string (max 0 (- 20 level)) ? ) ?s) (list ?i 'score ?d) (list ?z 'score-char ?c) (list ?U 'unread ?c) (list ?t '(gnus-summary-number-of-articles-in-thread (and (boundp 'thread) (car thread))) ?d) (list ?e '(gnus-summary-number-of-articles-in-thread (and (boundp 'thread) (car thread)) t) ?c) (list ?u 'user-defined ?s)) "An alist of format specifications that can appear in summary lines, and what variables they correspond with, along with the type of the variable (string, integer, character, etc).") (defconst gnus-summary-dummy-line-format-alist (list (list ?S 'subject ?s) (list ?N 'number ?d) (list ?u 'user-defined ?s))) (defconst gnus-summary-mode-line-format-alist (list (list ?G 'group-name ?s) (list ?g '(gnus-short-group-name group-name) ?s) (list ?A 'article-number ?d) (list ?Z 'unread-and-unselected ?s) (list ?V 'gnus-version ?s) (list ?U 'unread ?d) (list ?S 'subject ?s) (list ?e 'unselected ?d) (list ?u 'user-defined ?s) (list ?s '(gnus-current-score-file-nondirectory) ?s))) (defconst gnus-group-mode-line-format-alist (list (list ?S 'news-server ?s) (list ?M 'news-method ?s) (list ?u 'user-defined ?s))) (defvar gnus-have-read-active-file nil) (defconst gnus-maintainer "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") (defconst gnus-version "Gnus v5.1" "Version number for this version of Gnus.") (defvar gnus-info-nodes '((gnus-group-mode "(gnus)The Group Buffer") (gnus-summary-mode "(gnus)The Summary Buffer") (gnus-article-mode "(gnus)The Article Buffer")) "Assoc list of major modes and related Info nodes.") (defvar gnus-group-buffer "*Group*") (defvar gnus-summary-buffer "*Summary*") (defvar gnus-article-buffer "*Article*") (defvar gnus-server-buffer "*Server*") (defvar gnus-work-buffer " *gnus work*") (defvar gnus-buffer-list nil "Gnus buffers that should be killed on exit.") (defvar gnus-server-alist nil "List of available servers.") (defvar gnus-variable-list '(gnus-newsrc-options gnus-newsrc-options-n gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist gnus-killed-list gnus-zombie-list) "Gnus variables saved in the quick startup file.") (defvar gnus-overload-functions '((news-inews gnus-inews-news "rnewspost")) "Functions overloaded by gnus. It is a list of `(original overload &optional file)'.") (defvar gnus-newsrc-options nil "Options line in the .newsrc file.") (defvar gnus-newsrc-options-n nil "List of regexps representing groups to be subscribed/ignored unconditionally.") (defvar gnus-newsrc-last-checked-date nil "Date Gnus last asked server for new newsgroups.") (defvar gnus-newsrc-alist nil "Assoc list of read articles. gnus-newsrc-hashtb should be kept so that both hold the same information.") (defvar gnus-newsrc-hashtb nil "Hashtable of gnus-newsrc-alist.") (defvar gnus-killed-list nil "List of killed newsgroups.") (defvar gnus-killed-hashtb nil "Hash table equivalent of gnus-killed-list.") (defvar gnus-zombie-list nil "List of almost dead newsgroups.") (defvar gnus-description-hashtb nil "Descriptions of newsgroups.") (defvar gnus-list-of-killed-groups nil "List of newsgroups that have recently been killed by the user.") (defvar gnus-active-hashtb nil "Hashtable of active articles.") (defvar gnus-moderated-list nil "List of moderated newsgroups.") (defvar gnus-group-marked nil) (defvar gnus-current-startup-file nil "Startup file for the current host.") (defvar gnus-last-search-regexp nil "Default regexp for article search command.") (defvar gnus-last-shell-command nil "Default shell command on article.") (defvar gnus-current-select-method nil "The current method for selecting a newsgroup.") (defvar gnus-group-list-mode nil) (defvar gnus-article-internal-prepare-hook nil) (defvar gnus-newsgroup-name nil) (defvar gnus-newsgroup-begin nil) (defvar gnus-newsgroup-end nil) (defvar gnus-newsgroup-last-rmail nil) (defvar gnus-newsgroup-last-mail nil) (defvar gnus-newsgroup-last-folder nil) (defvar gnus-newsgroup-last-file nil) (defvar gnus-newsgroup-auto-expire nil) (defvar gnus-newsgroup-active nil) (defvar gnus-newsgroup-unreads nil "List of unread articles in the current newsgroup.") (defvar gnus-newsgroup-unselected nil "List of unselected unread articles in the current newsgroup.") (defvar gnus-newsgroup-reads nil "Alist of read articles and article marks in the current newsgroup.") (defvar gnus-newsgroup-marked nil "List of ticked articles in the current newsgroup (a subset of unread art).") (defvar gnus-newsgroup-killed nil "List of ranges of articles that have been through the scoring process.") (defvar gnus-newsgroup-kill-headers nil) (defvar gnus-newsgroup-replied nil "List of articles that have been replied to in the current newsgroup.") (defvar gnus-newsgroup-expirable nil "List of articles in the current newsgroup that can be expired.") (defvar gnus-newsgroup-processable nil "List of articles in the current newsgroup that can be processed.") (defvar gnus-newsgroup-bookmarks nil "List of articles in the current newsgroup that have bookmarks.") (defvar gnus-newsgroup-dormant nil "List of dormant articles in the current newsgroup.") (defvar gnus-newsgroup-scored nil "List of scored articles in the current newsgroup.") (defvar gnus-newsgroup-headers nil "List of article headers in the current newsgroup.") (defvar gnus-newsgroup-headers-hashtb-by-number nil) (defvar gnus-newsgroup-ancient nil "List of `gnus-fetch-old-headers' articles in the current newsgroup.") (defvar gnus-current-article nil) (defvar gnus-article-current nil) (defvar gnus-current-headers nil) (defvar gnus-have-all-headers nil) (defvar gnus-last-article nil) (defvar gnus-newsgroup-history nil) (defvar gnus-current-kill-article nil) ;; Save window configuration. (defvar gnus-prev-winconf nil) ;; Format specs (defvar gnus-summary-line-format-spec nil) (defvar gnus-summary-dummy-line-format-spec nil) (defvar gnus-group-line-format-spec nil) (defvar gnus-summary-mode-line-format-spec nil) (defvar gnus-article-mode-line-format-spec nil) (defvar gnus-group-mode-line-format-spec nil) (defvar gnus-summary-mark-positions nil) (defvar gnus-group-mark-positions nil) (defvar gnus-summary-expunge-below nil) (defvar gnus-reffed-article-number nil) ; Let the byte-compiler know that we know about this variable. (defvar rmail-default-rmail-file) (defvar gnus-cache-removeable-articles nil) (defconst gnus-summary-local-variables '(gnus-newsgroup-name gnus-newsgroup-begin gnus-newsgroup-end gnus-newsgroup-last-rmail gnus-newsgroup-last-mail gnus-newsgroup-last-folder gnus-newsgroup-last-file gnus-newsgroup-auto-expire gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked gnus-newsgroup-reads gnus-newsgroup-replied gnus-newsgroup-expirable gnus-newsgroup-processable gnus-newsgroup-killed gnus-newsgroup-bookmarks gnus-newsgroup-dormant gnus-newsgroup-headers gnus-newsgroup-headers-hashtb-by-number gnus-current-article gnus-current-headers gnus-have-all-headers gnus-last-article gnus-article-internal-prepare-hook gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay gnus-newsgroup-scored gnus-newsgroup-kill-headers gnus-newsgroup-threads gnus-newsgroup-async gnus-score-alist gnus-current-score-file gnus-summary-expunge-below gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files gnus-newsgroup-history gnus-newsgroup-ancient (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) gnus-cache-removeable-articles) "Variables that are buffer-local to the summary buffers.") (defconst gnus-bug-message "Sending a bug report to the Gnus Towers. ======================================== The buffer below is a mail buffer. When you press `C-c C-c', it will be sent to the Gnus Bug Exterminators. At the bottom of the buffer you'll see lots of variable settings. Please do not delete those. They will tell the Bug People what your environment is, so that it will be easier to locate the bugs. If you have found a bug that makes Emacs go \"beep\", set debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') and include the backtrace in your bug report. Please describe the bug in annoying, painstaking detail. Thank you for your help in stamping out bugs. ") ;;; End of variables. ;; Define some autoload functions Gnus might use. (eval-and-compile ;; Various (autoload 'metamail-buffer "metamail") (autoload 'Info-goto-node "info") (autoload 'hexl-hex-string-to-integer "hexl") (autoload 'pp "pp") (autoload 'pp-to-string "pp") (autoload 'pp-eval-expression "pp") (autoload 'mail-extract-address-components "mail-extr") (autoload 'nnmail-split-fancy "nnmail") (autoload 'nnvirtual-catchup-group "nnvirtual") ;; timezone (autoload 'timezone-make-date-arpa-standard "timezone") (autoload 'timezone-fix-time "timezone") (autoload 'timezone-make-sortable-date "timezone") (autoload 'timezone-make-time-string "timezone") ;; rmail & friends (autoload 'mail-position-on-field "sendmail") (autoload 'mail-setup "sendmail") (autoload 'rmail-output "rmailout") (autoload 'news-mail-other-window "rnewspost") (autoload 'news-reply-yank-original "rnewspost") (autoload 'news-caesar-buffer-body "rnewspost") (autoload 'rmail-insert-rmail-file-header "rmail") (autoload 'rmail-count-new-messages "rmail") (autoload 'rmail-show-message "rmail") ;; gnus-soup ;;(autoload 'gnus-group-brew-soup "gnus-soup" nil t) ;;(autoload 'gnus-brew-soup "gnus-soup" nil t) ;;(autoload 'gnus-soup-add-article "gnus-soup" nil t) ;;(autoload 'gnus-soup-send-replies "gnus-soup" nil t) ;;(autoload 'gnus-soup-save-areas "gnus-soup" nil t) ;;(autoload 'gnus-soup-pack-packet "gnus-soup" nil t) ;;(autoload 'nnsoup-pack-replies "nnsoup" nil t) ;; gnus-mh (autoload 'gnus-mail-reply-using-mhe "gnus-mh") (autoload 'gnus-mail-forward-using-mhe "gnus-mh") (autoload 'gnus-mail-other-window-using-mhe "gnus-mh") (autoload 'gnus-summary-save-in-folder "gnus-mh" nil t) (autoload 'gnus-summary-save-article-folder "gnus-mh") (autoload 'gnus-Folder-save-name "gnus-mh") (autoload 'gnus-folder-save-name "gnus-mh") ;; gnus-vis misc (autoload 'gnus-group-make-menu-bar "gnus-vis") (autoload 'gnus-summary-make-menu-bar "gnus-vis") (autoload 'gnus-server-make-menu-bar "gnus-vis") (autoload 'gnus-article-make-menu-bar "gnus-vis") (autoload 'gnus-browse-make-menu-bar "gnus-vis") (autoload 'gnus-highlight-selected-summary "gnus-vis") (autoload 'gnus-summary-highlight-line "gnus-vis") (autoload 'gnus-carpal-setup-buffer "gnus-vis") ;; gnus-vis article (autoload 'gnus-article-push-button "gnus-vis" nil t) (autoload 'gnus-article-press-button "gnus-vis" nil t) (autoload 'gnus-article-highlight "gnus-vis" nil t) (autoload 'gnus-article-highlight-some "gnus-vis" nil t) (autoload 'gnus-article-hide "gnus-vis" nil t) (autoload 'gnus-article-hide-signature "gnus-vis" nil t) (autoload 'gnus-article-highlight-headers "gnus-vis" nil t) (autoload 'gnus-article-highlight-signature "gnus-vis" nil t) (autoload 'gnus-article-add-buttons "gnus-vis" nil t) (autoload 'gnus-article-next-button "gnus-vis" nil t) (autoload 'gnus-article-add-button "gnus-vis") ;; gnus-cite (autoload 'gnus-article-highlight-citation "gnus-cite" nil t) (autoload 'gnus-article-hide-citation-maybe "gnus-cite" nil t) (autoload 'gnus-article-hide-citation "gnus-cite" nil t) ;; gnus-kill (autoload 'gnus-kill "gnus-kill") (autoload 'gnus-apply-kill-file-internal "gnus-kill") (autoload 'gnus-kill-file-edit-file "gnus-kill") (autoload 'gnus-kill-file-raise-followups-to-author "gnus-kill") (autoload 'gnus-execute "gnus-kill") (autoload 'gnus-expunge "gnus-kill") ;; gnus-cache (autoload 'gnus-cache-possibly-enter-article "gnus-cache") (autoload 'gnus-cache-save-buffers "gnus-cache") (autoload 'gnus-cache-possibly-remove-articles "gnus-cache") (autoload 'gnus-cache-request-article "gnus-cache") (autoload 'gnus-cache-retrieve-headers "gnus-cache") (autoload 'gnus-cache-possibly-alter-active "gnus-cache") (autoload 'gnus-jog-cache "gnus-cache" nil t) (autoload 'gnus-cache-enter-remove-article "gnus-cache") ;; gnus-score (autoload 'gnus-summary-increase-score "gnus-score" nil t) (autoload 'gnus-summary-lower-score "gnus-score" nil t) (autoload 'gnus-summary-score-map "gnus-score" nil nil 'keymap) (autoload 'gnus-score-save "gnus-score") (autoload 'gnus-score-headers "gnus-score") (autoload 'gnus-current-score-file-nondirectory "gnus-score") (autoload 'gnus-score-adaptive "gnus-score") (autoload 'gnus-score-remove-lines-adaptive "gnus-score") (autoload 'gnus-score-find-trace "gnus-score") ;; gnus-edit (autoload 'gnus-score-customize "gnus-edit" nil t) ;; gnus-uu (autoload 'gnus-uu-extract-map "gnus-uu" nil nil 'keymap) (autoload 'gnus-uu-mark-map "gnus-uu" nil nil 'keymap) (autoload 'gnus-uu-digest-mail-forward "gnus-uu" nil t) (autoload 'gnus-uu-digest-post-forward "gnus-uu" nil t) (autoload 'gnus-uu-mark-series "gnus-uu" nil t) (autoload 'gnus-uu-mark-region "gnus-uu" nil t) (autoload 'gnus-uu-mark-by-regexp "gnus-uu" nil t) (autoload 'gnus-uu-mark-all "gnus-uu" nil t) (autoload 'gnus-uu-mark-sparse "gnus-uu" nil t) (autoload 'gnus-uu-mark-thread "gnus-uu" nil t) (autoload 'gnus-uu-decode-uu "gnus-uu" nil t) (autoload 'gnus-uu-decode-uu-and-save "gnus-uu" nil t) (autoload 'gnus-uu-decode-unshar "gnus-uu" nil t) (autoload 'gnus-uu-decode-unshar-and-save "gnus-uu" nil t) (autoload 'gnus-uu-decode-save "gnus-uu" nil t) (autoload 'gnus-uu-decode-binhex "gnus-uu" nil t) (autoload 'gnus-uu-decode-uu-view "gnus-uu" nil t) (autoload 'gnus-uu-decode-uu-and-save-view "gnus-uu" nil t) (autoload 'gnus-uu-decode-unshar-view "gnus-uu" nil t) (autoload 'gnus-uu-decode-unshar-and-save-view "gnus-uu" nil t) (autoload 'gnus-uu-decode-save-view "gnus-uu" nil t) (autoload 'gnus-uu-decode-binhex-view "gnus-uu" nil t) ;; gnus-msg (autoload 'gnus-summary-send-map "gnus-msg" nil nil 'keymap) (autoload 'gnus-group-post-news "gnus-msg" nil t) (autoload 'gnus-group-mail "gnus-msg" nil t) (autoload 'gnus-summary-post-news "gnus-msg" nil t) (autoload 'gnus-summary-followup "gnus-msg" nil t) (autoload 'gnus-summary-followup-with-original "gnus-msg" nil t) (autoload 'gnus-summary-followup-and-reply "gnus-msg" nil t) (autoload 'gnus-summary-followup-and-reply-with-original "gnus-msg" nil t) (autoload 'gnus-summary-cancel-article "gnus-msg" nil t) (autoload 'gnus-summary-supersede-article "gnus-msg" nil t) (autoload 'gnus-post-news "gnus-msg" nil t) (autoload 'gnus-inews-news "gnus-msg" nil t) (autoload 'gnus-cancel-news "gnus-msg" nil t) (autoload 'gnus-summary-reply "gnus-msg" nil t) (autoload 'gnus-summary-reply-with-original "gnus-msg" nil t) (autoload 'gnus-summary-mail-forward "gnus-msg" nil t) (autoload 'gnus-summary-mail-other-window "gnus-msg" nil t) (autoload 'gnus-mail-reply-using-mail "gnus-msg") (autoload 'gnus-mail-yank-original "gnus-msg") (autoload 'gnus-mail-send-and-exit "gnus-msg") (autoload 'gnus-mail-forward-using-mail "gnus-msg") (autoload 'gnus-mail-other-window-using-mail "gnus-msg") (autoload 'gnus-article-mail "gnus-msg") (autoload 'gnus-bug "gnus-msg" nil t) ;; gnus-vm (autoload 'gnus-summary-save-in-vm "gnus-vm" nil t) (autoload 'gnus-summary-save-article-vm "gnus-vm" nil t) (autoload 'gnus-mail-forward-using-vm "gnus-vm") (autoload 'gnus-mail-reply-using-vm "gnus-vm") (autoload 'gnus-mail-other-window-using-vm "gnus-vm" nil t) (autoload 'gnus-yank-article "gnus-vm" nil t) ) ;; Fix by Hallvard B Furuseth . ;; If you want the cursor to go somewhere else, set these two ;; functions in some startup hook to whatever you want. (defalias 'gnus-summary-position-cursor 'gnus-goto-colon) (defalias 'gnus-group-position-cursor 'gnus-goto-colon) ;;; Various macros and substs. (defmacro gnus-eval-in-buffer-window (buffer &rest forms) "Pop to BUFFER, evaluate FORMS, and then returns to original window." (` (let ((GnusStartBufferWindow (selected-window))) (unwind-protect (progn (pop-to-buffer (, buffer)) (,@ forms)) (select-window GnusStartBufferWindow))))) (defmacro gnus-gethash (string hashtable) "Get hash value of STRING in HASHTABLE." ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable)))) ;;(` (abbrev-expansion (, string) (, hashtable))) (` (symbol-value (intern-soft (, string) (, hashtable))))) (defmacro gnus-sethash (string value hashtable) "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." ;; We cannot use define-abbrev since it only accepts string as value. ;; (set (intern string hashtable) value)) (` (set (intern (, string) (, hashtable)) (, value)))) (defsubst gnus-buffer-substring (beg end) (buffer-substring (match-beginning beg) (match-end end))) ;; modified by MORIOKA Tomohiko ;; function `substring' might cut on a middle of multi-octet ;; character. (defun gnus-truncate-string (str width) (substring str 0 width)) ;; Added by Geoffrey T. Dairiki . A safe way ;; to limit the length of a string. This function is necessary since ;; `(substr "abc" 0 30)' pukes with "Args out of range". (defsubst gnus-limit-string (str width) (if (> (length str) width) (substring str 0 width) str)) (defsubst gnus-simplify-subject-re (subject) "Remove \"Re:\" from subject lines." (let ((case-fold-search t)) (if (string-match "^re: *" subject) (substring subject (match-end 0)) subject))) (defsubst gnus-goto-char (point) (and point (goto-char point))) (defmacro gnus-buffer-exists-p (buffer) (` (and (, buffer) (funcall (if (stringp (, buffer)) 'get-buffer 'buffer-name) (, buffer))))) (defmacro gnus-kill-buffer (buffer) (` (if (gnus-buffer-exists-p (, buffer)) (kill-buffer (, buffer))))) (defsubst gnus-point-at-bol () "Return point at the beginning of line." (let ((p (point))) (beginning-of-line) (prog1 (point) (goto-char p)))) (defsubst gnus-point-at-eol () "Return point at the beginning of line." (let ((p (point))) (end-of-line) (prog1 (point) (goto-char p)))) ;; Delete the current line (and the next N lines.); (defmacro gnus-delete-line (&optional n) (` (delete-region (progn (beginning-of-line) (point)) (progn (forward-line (, (or n 1))) (point))))) ;; Suggested by Brian Edmonds . (defvar gnus-init-inhibit nil) (defun gnus-read-init-file (&optional inhibit-next) (if gnus-init-inhibit (setq gnus-init-inhibit nil) (setq gnus-init-inhibit inhibit-next) (and gnus-init-file (or (and (file-exists-p gnus-init-file) ;; Don't try to load a directory. (not (file-directory-p gnus-init-file))) (file-exists-p (concat gnus-init-file ".el")) (file-exists-p (concat gnus-init-file ".elc"))) (load gnus-init-file nil t)))) ;;; Load the user startup file. ;; (eval '(gnus-read-init-file 'inhibit)) ;;; Load the compatability functions. (require 'gnus-cus) (require 'gnus-ems) ;;; ;;; Gnus Utility Functions ;;; (defun gnus-extract-address-components (from) (let (name address) ;; First find the address - the thing with the @ in it. This may ;; not be accurate in mail addresses, but does the trick most of ;; the time in news messages. (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) (setq address (substring from (match-beginning 0) (match-end 0)))) ;; Then we check whether the "name
" format is used. (and address ;; Fix by MORIOKA Tomohiko ;; Linear white space is not required. (string-match (concat "[ \t]*<" (regexp-quote address) ">") from) (and (setq name (substring from 0 (match-beginning 0))) ;; Strip any quotes from the name. (string-match "\".*\"" name) (setq name (substring name 1 (1- (match-end 0)))))) ;; If not, then "address (name)" is used. (or name (and (string-match "(.+)" from) (setq name (substring from (1+ (match-beginning 0)) (1- (match-end 0))))) (and (string-match "()" from) (setq name address)) ;; Fix by MORIOKA Tomohiko . ;; XOVER might not support folded From headers. (and (string-match "(.*" from) (setq name (substring from (1+ (match-beginning 0)) (match-end 0))))) ;; Fix by Hallvard B Furuseth . (list (or name from) (or address from)))) (defun gnus-fetch-field (field) "Return the value of the header FIELD of current article." (save-excursion (save-restriction (let ((case-fold-search t)) (gnus-narrow-to-headers) (mail-fetch-field field))))) (defun gnus-goto-colon () (beginning-of-line) (search-forward ":" (gnus-point-at-eol) t)) (defun gnus-narrow-to-headers () (widen) (save-excursion (narrow-to-region (goto-char (point-min)) (if (search-forward "\n\n" nil t) (1- (point)) (point-max))))) (defvar gnus-old-specs nil) (defun gnus-update-format-specifications () (gnus-make-thread-indent-array) (let ((formats '(summary summary-dummy group summary-mode group-mode article-mode)) old-format new-format) (while formats (setq new-format (symbol-value (intern (format "gnus-%s-line-format" (car formats))))) (or (and (setq old-format (cdr (assq (car formats) gnus-old-specs))) (equal old-format new-format)) (set (intern (format "gnus-%s-line-format-spec" (car formats))) (gnus-parse-format new-format (symbol-value (intern (format "gnus-%s-line-format-alist" (if (eq (car formats) 'article-mode) 'summary-mode (car formats)))))))) (setq gnus-old-specs (cons (cons (car formats) new-format) (delq (car formats) gnus-old-specs))) (setq formats (cdr formats)))) (gnus-update-group-mark-positions) (gnus-update-summary-mark-positions) (if (and (string-match "%D" gnus-group-line-format) (not gnus-description-hashtb) gnus-read-active-file) (gnus-read-all-descriptions-files))) (defun gnus-update-summary-mark-positions () (save-excursion (let ((gnus-replied-mark 129) (gnus-score-below-mark 130) (gnus-score-over-mark 130) (thread nil) pos) (gnus-set-work-buffer) (gnus-summary-insert-line nil [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) (goto-char (point-min)) (setq pos (list (cons 'unread (and (search-forward "\200" nil t) (- (point) 2))))) (goto-char (point-min)) (setq pos (cons (cons 'replied (and (search-forward "\201" nil t) (- (point) 2))) pos)) (goto-char (point-min)) (setq pos (cons (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) pos)) (setq gnus-summary-mark-positions pos)))) (defun gnus-update-group-mark-positions () (save-excursion (let ((gnus-process-mark 128) (gnus-group-marked '("dummy.group"))) (gnus-sethash "dummy.group" '(0 . 0) gnus-active-hashtb) (gnus-set-work-buffer) (gnus-group-insert-group-line nil "dummy.group" 0 nil 0 nil) (goto-char (point-min)) (setq gnus-group-mark-positions (list (cons 'process (and (search-forward "\200" nil t) (- (point) 2)))))))) (defun gnus-mouse-face-function (form) (` (let ((string (, form))) (put-text-property 0 (length string) 'mouse-face gnus-mouse-face string) string))) (defun gnus-max-width-function (el max-width) (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width))) (` (let* ((val (eval (, el))) (valstr (if (numberp val) (int-to-string val) val))) (if (> (length valstr) (, max-width)) (substring valstr 0 (, max-width)) valstr)))) (defun gnus-parse-format (format spec-alist) ;; This function parses the FORMAT string with the help of the ;; SPEC-ALIST and returns a list that can be eval'ed to return the ;; string. If the FORMAT string contains the specifiers %( and %) ;; the text between them will have the mouse-face text property. (if (string-match "\\`\\(.*\\)%(\\(.*\\)%)\\(.*\n?\\)\\'" format) (if (and gnus-visual gnus-mouse-face) (let ((pre (substring format (match-beginning 1) (match-end 1))) (button (substring format (match-beginning 2) (match-end 2))) (post (substring format (match-beginning 3) (match-end 3)))) (list 'concat (gnus-parse-simple-format pre spec-alist) (gnus-mouse-face-function (gnus-parse-simple-format button spec-alist)) (gnus-parse-simple-format post spec-alist))) (gnus-parse-simple-format (concat (substring format (match-beginning 1) (match-end 1)) (substring format (match-beginning 2) (match-end 2)) (substring format (match-beginning 3) (match-end 3))) spec-alist)) (gnus-parse-simple-format format spec-alist))) (defun gnus-parse-simple-format (format spec-alist) ;; This function parses the FORMAT string with the help of the ;; SPEC-ALIST and returns a list that can be eval'ed to return the ;; string. The list will consist of the symbol `format', a format ;; specification string, and a list of forms depending on the ;; SPEC-ALIST. (let ((max-width 0) spec flist fstring newspec elem beg) (save-excursion (gnus-set-work-buffer) (insert format) (goto-char (point-min)) (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?" nil t) (setq spec (string-to-char (buffer-substring (match-beginning 2) (match-end 2)))) ;; First check if there are any specs that look anything like ;; "%12,12A", ie. with a "max width specification". These have ;; to be treated specially. (if (setq beg (match-beginning 1)) (setq max-width (string-to-int (buffer-substring (1+ (match-beginning 1)) (match-end 1)))) (setq max-width 0) (setq beg (match-beginning 2))) ;; Find the specification from `spec-alist'. (if (not (setq elem (cdr (assq spec spec-alist)))) (setq elem '("*" ?s))) ;; Treat user defined format specifiers specially (and (eq (car elem) 'user-defined) (setq elem (list (list (intern (concat "gnus-user-format-function-" (buffer-substring (match-beginning 3) (match-end 3)))) 'header) ?s)) (delete-region (match-beginning 3) (match-end 3))) (if (not (zerop max-width)) (let ((el (car elem))) (cond ((= (car (cdr elem)) ?c) (setq el (list 'char-to-string el))) ((= (car (cdr elem)) ?d) (numberp el) (setq el (list 'int-to-string el)))) (setq flist (cons (gnus-max-width-function el max-width) flist)) (setq newspec ?s)) (setq flist (cons (car elem) flist)) (setq newspec (car (cdr elem)))) ;; Remove the old specification (and possibly a ",12" string). (delete-region beg (match-end 2)) ;; Insert the new specification. (goto-char beg) (insert newspec)) (setq fstring (buffer-substring 1 (point-max)))) (cons 'format (cons fstring (nreverse flist))))) (defun gnus-set-work-buffer () (if (get-buffer gnus-work-buffer) (progn (set-buffer gnus-work-buffer) (erase-buffer)) (set-buffer (get-buffer-create gnus-work-buffer)) (kill-all-local-variables) (buffer-disable-undo (current-buffer)) (gnus-add-current-to-buffer-list))) ;; Article file names when saving. (defun gnus-Numeric-save-name (newsgroup headers &optional last-file) "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num. Otherwise, it is like ~/News/news/group/num." (let ((default (expand-file-name (concat (if (gnus-use-long-file-name 'not-save) (gnus-capitalize-newsgroup newsgroup) (gnus-newsgroup-directory-form newsgroup)) "/" (int-to-string (mail-header-number headers))) (or gnus-article-save-directory "~/News")))) (if (and last-file (string-equal (file-name-directory default) (file-name-directory last-file)) (string-match "^[0-9]+$" (file-name-nondirectory last-file))) default (or last-file default)))) (defun gnus-numeric-save-name (newsgroup headers &optional last-file) "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is non-nil, it is ~/News/news.group/num. Otherwise, it is like ~/News/news/group/num." (let ((default (expand-file-name (concat (if (gnus-use-long-file-name 'not-save) newsgroup (gnus-newsgroup-directory-form newsgroup)) "/" (int-to-string (mail-header-number headers))) (or gnus-article-save-directory "~/News")))) (if (and last-file (string-equal (file-name-directory default) (file-name-directory last-file)) (string-match "^[0-9]+$" (file-name-nondirectory last-file))) default (or last-file default)))) (defun gnus-Plain-save-name (newsgroup headers &optional last-file) "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is non-nil, it is ~/News/News.group. Otherwise, it is like ~/News/news/group/news." (or last-file (expand-file-name (if (gnus-use-long-file-name 'not-save) (gnus-capitalize-newsgroup newsgroup) (concat (gnus-newsgroup-directory-form newsgroup) "/news")) (or gnus-article-save-directory "~/News")))) (defun gnus-plain-save-name (newsgroup headers &optional last-file) "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is non-nil, it is ~/News/news.group. Otherwise, it is like ~/News/news/group/news." (or last-file (expand-file-name (if (gnus-use-long-file-name 'not-save) newsgroup (concat (gnus-newsgroup-directory-form newsgroup) "/news")) (or gnus-article-save-directory "~/News")))) ;; For subscribing new newsgroup (defun gnus-subscribe-hierarchical-interactive (groups) (let ((groups (sort groups 'string<)) prefixes prefix start ans group starts) (while groups (setq prefixes (list "^")) (while (and groups prefixes) (while (not (string-match (car prefixes) (car groups))) (setq prefixes (cdr prefixes))) (setq prefix (car prefixes)) (setq start (1- (length prefix))) (if (and (string-match "[^\\.]\\." (car groups) start) (cdr groups) (setq prefix (concat "^" (substring (car groups) 0 (match-end 0)))) (string-match prefix (car (cdr groups)))) (progn (setq prefixes (cons prefix prefixes)) (message "Descend hierarchy %s? ([y]nsq): " (substring prefix 1 (1- (length prefix)))) (setq ans (read-char)) (cond ((= ans ?n) (while (and groups (string-match prefix (setq group (car groups)))) (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups))) (setq starts (cdr starts))) ((= ans ?s) (while (and groups (string-match prefix (setq group (car groups)))) (gnus-sethash group group gnus-killed-hashtb) (gnus-subscribe-alphabetically (car groups)) (setq groups (cdr groups))) (setq starts (cdr starts))) ((= ans ?q) (while groups (setq group (car groups)) (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups)))) (t nil))) (message "Subscribe %s? ([n]yq)" (car groups)) (setq ans (read-char)) (setq group (car groups)) (cond ((= ans ?y) (gnus-subscribe-alphabetically (car groups)) (gnus-sethash group group gnus-killed-hashtb)) ((= ans ?q) (while groups (setq group (car groups)) (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups)))) (t (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb))) (setq groups (cdr groups))))))) (defun gnus-subscribe-randomly (newsgroup) "Subscribe new NEWSGROUP by making it the first newsgroup." (gnus-subscribe-newsgroup newsgroup)) (defun gnus-subscribe-alphabetically (newgroup) "Subscribe new NEWSGROUP and insert it in alphabetical order." ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) (let ((groups (cdr gnus-newsrc-alist)) before) (while (and (not before) groups) (if (string< newgroup (car (car groups))) (setq before (car (car groups))) (setq groups (cdr groups)))) (gnus-subscribe-newsgroup newgroup before))) (defun gnus-subscribe-hierarchically (newgroup) "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order." ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) (save-excursion (set-buffer (find-file-noselect gnus-current-startup-file)) (let ((groupkey newgroup) before) (while (and (not before) groupkey) (goto-char (point-min)) (let ((groupkey-re (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]"))) (while (and (re-search-forward groupkey-re nil t) (progn (setq before (buffer-substring (match-beginning 1) (match-end 1))) (string< before newgroup))))) ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) (setq groupkey (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey) (substring groupkey (match-beginning 1) (match-end 1))))) (gnus-subscribe-newsgroup newgroup before)))) (defun gnus-subscribe-interactively (newsgroup) "Subscribe new NEWSGROUP interactively. It is inserted in hierarchical newsgroup order if subscribed. If not, it is killed." (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup)) (gnus-subscribe-hierarchically newsgroup) (setq gnus-killed-list (cons newsgroup gnus-killed-list)))) (defun gnus-subscribe-zombies (newsgroup) "Make new NEWSGROUP a zombie group." (setq gnus-zombie-list (cons newsgroup gnus-zombie-list))) (defun gnus-subscribe-newsgroup (newsgroup &optional next) "Subscribe new NEWSGROUP. If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made the first newsgroup." ;; We subscribe the group by changing its level to `subscribed'. (gnus-group-change-level newsgroup gnus-level-default-subscribed gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb)) (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)) ;; For directories (defun gnus-newsgroup-directory-form (newsgroup) "Make hierarchical directory name from NEWSGROUP name." (let ((newsgroup (gnus-newsgroup-saveable-name newsgroup)) (len (length newsgroup)) idx) ;; If this is a foreign group, we don't want to translate the ;; entire name. (if (setq idx (string-match ":" newsgroup)) (aset newsgroup idx ?/) (setq idx 0)) ;; Replace all occurrences of `.' with `/'. (while (< idx len) (if (= (aref newsgroup idx) ?.) (aset newsgroup idx ?/)) (setq idx (1+ idx))) newsgroup)) (defun gnus-newsgroup-saveable-name (group) ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) ;; with dots. (gnus-replace-chars-in-string group ?/ ?.)) (defun gnus-make-directory (dir) "Make DIRECTORY recursively." ;; Why don't we use `(make-directory dir 'parents)'? That's just one ;; of the many mysteries of the universe. (let* ((dir (expand-file-name dir default-directory)) dirs err) (if (string-match "/$" dir) (setq dir (substring dir 0 (match-beginning 0)))) ;; First go down the path until we find a directory that exists. (while (not (file-exists-p dir)) (setq dirs (cons dir dirs)) (string-match "/[^/]+$" dir) (setq dir (substring dir 0 (match-beginning 0)))) ;; Then create all the subdirs. (while (and dirs (not err)) (condition-case () (make-directory (car dirs)) (error (setq err t))) (setq dirs (cdr dirs))) ;; We return whether we were successful or not. (not dirs))) (defun gnus-capitalize-newsgroup (newsgroup) "Capitalize NEWSGROUP name." (and (not (zerop (length newsgroup))) (concat (char-to-string (upcase (aref newsgroup 0))) (substring newsgroup 1)))) ;; Var (defun gnus-simplify-subject (subject &optional re-only) "Remove `Re:' and words in parentheses. If optional argument RE-ONLY is non-nil, strip `Re:' only." (let ((case-fold-search t)) ;Ignore case. ;; Remove `Re:' and `Re^N:'. (if (string-match "^re:[ \t]*" subject) (setq subject (substring subject (match-end 0)))) ;; Remove words in parentheses from end. (or re-only (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject) (setq subject (substring subject 0 (match-beginning 0))))) ;; Return subject string. subject)) ;; Remove any leading "re:"s, any trailing paren phrases, and simplify ;; all whitespace. (defun gnus-simplify-subject-fuzzy (subject) (let ((case-fold-search t)) (save-excursion (gnus-set-work-buffer) (insert subject) (inline (gnus-simplify-buffer-fuzzy)) (buffer-string)))) (defun gnus-simplify-buffer-fuzzy () (goto-char (point-min)) ;; Fix by Stainless Steel Rat . (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*" nil t) (replace-match "" t t)) (goto-char (point-min)) (while (re-search-forward "[ \t\n]*([^()]*)[ \t\n]*$" nil t) (replace-match "" t t)) (goto-char (point-min)) (while (re-search-forward "[ \t]+" nil t) (replace-match " " t t)) (goto-char (point-min)) (while (re-search-forward "[ \t]+$" nil t) (replace-match "" t t)) (goto-char (point-min)) (while (re-search-forward "^[ \t]+" nil t) (replace-match "" t t)) (if gnus-simplify-subject-fuzzy-regexp (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t) (replace-match "" t t)))) ;; Add the current buffer to the list of buffers to be killed on exit. (defun gnus-add-current-to-buffer-list () (or (memq (current-buffer) gnus-buffer-list) (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list)))) (defun gnus-string> (s1 s2) (not (or (string< s1 s2) (string= s1 s2)))) ;; Functions accessing headers. ;; Functions are more convenient than macros in some cases. (defun gnus-header-number (header) (mail-header-number header)) (defun gnus-header-subject (header) (mail-header-subject header)) (defun gnus-header-from (header) (mail-header-from header)) (defun gnus-header-xref (header) (mail-header-xref header)) (defun gnus-header-lines (header) (mail-header-lines header)) (defun gnus-header-date (header) (mail-header-date header)) (defun gnus-header-id (header) (mail-header-id header)) (defun gnus-header-message-id (header) (mail-header-id header)) (defun gnus-header-chars (header) (mail-header-chars header)) (defun gnus-header-references (header) (mail-header-references header)) ;;; General various misc type functions. (defun gnus-clear-system () "Clear all variables and buffers." ;; Clear Gnus variables. (let ((variables gnus-variable-list)) (while variables (set (car variables) nil) (setq variables (cdr variables)))) ;; Clear other internal variables. (setq gnus-list-of-killed-groups nil gnus-have-read-active-file nil gnus-newsrc-alist nil gnus-newsrc-hashtb nil gnus-killed-list nil gnus-zombie-list nil gnus-killed-hashtb nil gnus-active-hashtb nil gnus-moderated-list nil gnus-description-hashtb nil gnus-newsgroup-headers nil gnus-newsgroup-headers-hashtb-by-number nil gnus-newsgroup-name nil gnus-server-alist nil gnus-current-select-method nil) ;; Reset any score variables. (and (boundp 'gnus-score-cache) (set 'gnus-score-cache nil)) (and (boundp 'gnus-internal-global-score-files) (set 'gnus-internal-global-score-files nil)) ;; Kill the startup file. (and gnus-current-startup-file (get-file-buffer gnus-current-startup-file) (kill-buffer (get-file-buffer gnus-current-startup-file))) ;; Save any cache buffers. (and gnus-use-cache (gnus-cache-save-buffers)) ;; Clear the dribble buffer. (gnus-dribble-clear) ;; Kill global KILL file buffer. (if (get-file-buffer (gnus-newsgroup-kill-file nil)) (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) (gnus-kill-buffer nntp-server-buffer) ;; Kill Gnus buffers. (while gnus-buffer-list (gnus-kill-buffer (car gnus-buffer-list)) (setq gnus-buffer-list (cdr gnus-buffer-list)))) (defun gnus-windows-old-to-new (setting) ;; First we take care of the really, really old Gnus 3 actions. (if (symbolp setting) (setq setting (cond ((memq setting '(SelectArticle)) 'article) ((memq setting '(SelectSubject ExpandSubject)) 'summary) ((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group) (t setting)))) (if (or (listp setting) (not (and gnus-window-configuration (memq setting '(group summary article))))) setting (let* ((setting (if (eq setting 'group) (if (assq 'newsgroup gnus-window-configuration) 'newsgroup 'newsgroups) setting)) (elem (car (cdr (assq setting gnus-window-configuration)))) (total (apply '+ elem)) (types '(group summary article)) (pbuf (if (eq setting 'newsgroups) 'group 'summary)) (i 0) perc out) (while (< i 3) (or (not (numberp (nth i elem))) (zerop (nth i elem)) (progn (setq perc (/ (* 1.0 (nth 0 elem)) total)) (setq out (cons (if (eq pbuf (nth i types)) (vector (nth i types) perc 'point) (vector (nth i types) perc)) out)))) (setq i (1+ i))) (list (nreverse out))))) (defun gnus-add-configuration (conf) (setq gnus-buffer-configuration (cons conf (delq (assq (car conf) gnus-buffer-configuration) gnus-buffer-configuration)))) (defun gnus-configure-windows (setting &optional force) (setq setting (gnus-windows-old-to-new setting)) (let ((r (if (symbolp setting) (cdr (assq setting gnus-buffer-configuration)) setting)) (in-buf (current-buffer)) rule val w height hor ohor heights sub jump-buffer rel total to-buf all-visible) (or r (error "No such setting: %s" setting)) (if (and (not force) (setq all-visible (gnus-all-windows-visible-p r))) ;; All the windows mentioned are already visible, so we just ;; put point in the assigned buffer, and do not touch the ;; winconf. (select-window (get-buffer-window all-visible t)) ;; Either remove all windows or just remove all Gnus windows. (if gnus-use-full-window (delete-other-windows) (gnus-remove-some-windows) (switch-to-buffer nntp-server-buffer)) (while r (setq hor (car r) ohor nil) ;; We have to do the (possible) horizontal splitting before the ;; vertical. (if (and (listp (car hor)) (eq (car (car hor)) 'horizontal)) (progn (split-window nil (if (integerp (nth 1 (car hor))) (nth 1 (car hor)) (- (frame-width) (floor (* (frame-width) (nth 1 (car hor)))))) t) (setq hor (cdr hor)))) ;; Go through the rules and eval the elements that are to be ;; evaled. (while hor (if (setq val (if (vectorp (car hor)) (car hor) (eval (car hor)))) (progn ;; Expand short buffer name. (setq w (aref val 0)) (and (setq w (cdr (assq w gnus-window-to-buffer))) (progn (setq val (apply 'vector (mapcar 'identity val))) (aset val 0 w))) (setq ohor (cons val ohor)))) (setq hor (cdr hor))) (setq rule (cons (nreverse ohor) rule)) (setq r (cdr r))) (setq rule (nreverse rule)) ;; We tally the window sizes. (setq total (window-height)) (while rule (setq hor (car rule)) (if (and (listp (car hor)) (eq (car (car hor)) 'horizontal)) (setq hor (cdr hor))) (setq sub 0) (while hor (setq rel (aref (car hor) 1) heights (cons (cond ((and (floatp rel) (= 1.0 rel)) 'x) ((integerp rel) rel) (t (max (floor (* total rel)) 4))) heights) sub (+ sub (if (numberp (car heights)) (car heights) 0)) hor (cdr hor))) (setq heights (nreverse heights) hor (car rule)) ;; We then go through these heighs and create windows for them. (while heights (setq height (car heights) heights (cdr heights)) (and (eq height 'x) (setq height (- total sub))) (and heights (split-window nil height)) (setq to-buf (aref (car hor) 0)) (switch-to-buffer (cond ((not to-buf) in-buf) ((symbolp to-buf) (symbol-value (aref (car hor) 0))) (t (aref (car hor) 0)))) (and (> (length (car hor)) 2) (eq (aref (car hor) 2) 'point) (setq jump-buffer (current-buffer))) (other-window 1) (setq hor (cdr hor))) (setq rule (cdr rule))) ;; Finally, we pop to the buffer that's supposed to have point. (or jump-buffer (error "Missing `point' in spec for %s" setting)) (select-window (get-buffer-window jump-buffer t)) (set-buffer jump-buffer)))) (defun gnus-all-windows-visible-p (rule) (let (invisible hor jump-buffer val buffer) ;; Go through the rules and eval the elements that are to be ;; evaled. (while (and rule (not invisible)) (setq hor (car rule) rule (cdr rule)) (while (and hor (not invisible)) (if (setq val (if (vectorp (car hor)) (car hor) (if (not (eq (car (car hor)) 'horizontal)) (eval (car hor))))) (progn ;; Expand short buffer name. (setq buffer (or (cdr (assq (aref val 0) gnus-window-to-buffer)) (aref val 0))) (setq buffer (if (symbolp buffer) (symbol-value buffer) buffer)) (and (> (length val) 2) (eq 'point (aref val 2)) (setq jump-buffer buffer)) (setq invisible (not (and buffer (get-buffer-window buffer)))))) (setq hor (cdr hor)))) (and (not invisible) jump-buffer))) (defun gnus-window-top-edge (&optional window) (nth 1 (window-edges window))) (defun gnus-remove-some-windows () (let ((buffers gnus-window-to-buffer) buf bufs lowest-buf lowest) (save-excursion ;; Remove windows on all known Gnus buffers. (while buffers (setq buf (cdr (car buffers))) (if (symbolp buf) (setq buf (and (boundp buf) (symbol-value buf)))) (and buf (get-buffer-window buf) (progn (setq bufs (cons buf bufs)) (pop-to-buffer buf) (if (or (not lowest) (< (gnus-window-top-edge) lowest)) (progn (setq lowest (gnus-window-top-edge)) (setq lowest-buf buf))))) (setq buffers (cdr buffers))) ;; Remove windows on *all* summary buffers. (let (wins) (walk-windows (lambda (win) (let ((buf (window-buffer win))) (if (string-match "^\\*Summary" (buffer-name buf)) (progn (setq bufs (cons buf bufs)) (pop-to-buffer buf) (if (or (not lowest) (< (gnus-window-top-edge) lowest)) (progn (setq lowest-buf buf) (setq lowest (gnus-window-top-edge)))))))))) (and lowest-buf (progn (pop-to-buffer lowest-buf) (switch-to-buffer nntp-server-buffer))) (while bufs (and (not (eq (car bufs) lowest-buf)) (delete-windows-on (car bufs))) (setq bufs (cdr bufs)))))) (defun gnus-version () "Version numbers of this version of Gnus." (interactive) (let ((methods gnus-valid-select-methods) (mess gnus-version) meth) ;; Go through all the legal select methods and add their version ;; numbers to the total version string. Only the backends that are ;; currently in use will have their message numbers taken into ;; consideration. (while methods (setq meth (intern (concat (car (car methods)) "-version"))) (and (boundp meth) (stringp (symbol-value meth)) (setq mess (concat mess "; " (symbol-value meth)))) (setq methods (cdr methods))) (gnus-message 2 mess))) (defun gnus-info-find-node () "Find Info documentation of Gnus." (interactive) ;; Enlarge info window if needed. (let ((mode major-mode)) (gnus-configure-windows 'info) (Info-goto-node (car (cdr (assq mode gnus-info-nodes)))))) (defun gnus-overload-functions (&optional overloads) "Overload functions specified by optional argument OVERLOADS. If nothing is specified, use the variable gnus-overload-functions." (let ((defs nil) (overloads (or overloads gnus-overload-functions))) (while overloads (setq defs (car overloads)) (setq overloads (cdr overloads)) ;; Load file before overloading function if necessary. Make ;; sure we cannot use `require' always. (and (not (fboundp (car defs))) (car (cdr (cdr defs))) (load (car (cdr (cdr defs))) nil 'nomessage)) (fset (car defs) (car (cdr defs)))))) (defun gnus-replace-chars-in-string (string &rest pairs) "Replace characters in STRING from FROM to TO." (let ((string (substring string 0)) ;Copy string. (len (length string)) (idx 0) sym to) (or (zerop (% (length pairs) 2)) (error "Odd number of translation pairs")) (setplist 'sym pairs) ;; Replace all occurrences of FROM with TO. (while (< idx len) (if (setq to (get 'sym (aref string idx))) (aset string idx to)) (setq idx (1+ idx))) string)) (defun gnus-days-between (date1 date2) ;; Return the number of days between date1 and date2. (- (gnus-day-number date1) (gnus-day-number date2))) (defun gnus-day-number (date) (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) ) (timezone-parse-date date)))) (timezone-absolute-from-gregorian (nth 1 dat) (nth 2 dat) (car dat)))) ;; Returns a floating point number that says how many seconds have ;; lapsed between Jan 1 12:00:00 1970 and DATE. (defun gnus-seconds-since-epoch (date) (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti))) (timezone-parse-date date))) (ttime (mapcar (lambda (ti) (and ti (string-to-int ti))) (timezone-parse-time (aref (timezone-parse-date date) 3)))) (edate (mapcar (lambda (ti) (and ti (string-to-int ti))) (timezone-parse-date "Jan 1 12:00:00 1970"))) (tday (- (timezone-absolute-from-gregorian (nth 1 tdate) (nth 2 tdate) (nth 0 tdate)) (timezone-absolute-from-gregorian (nth 1 edate) (nth 2 edate) (nth 0 edate))))) (+ (nth 2 ttime) (* (nth 1 ttime) 60) (* 1.0 (nth 0 ttime) 60 60) (* 1.0 tday 60 60 24)))) (defun gnus-file-newer-than (file date) (let ((fdate (nth 5 (file-attributes file)))) (or (> (car fdate) (car date)) (and (= (car fdate) (car date)) (> (nth 1 fdate) (nth 1 date)))))) (defun gnus-group-read-only-p (&optional group) "Check whether GROUP supports editing or not. If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note that that variable is buffer-local to the summary buffers." (let ((group (or group gnus-newsgroup-name))) (not (gnus-check-backend-function 'request-replace-article group)))) ;; Two silly functions to ensure that all `y-or-n-p' questions clear ;; the echo area. (defun gnus-y-or-n-p (prompt) (prog1 (y-or-n-p prompt) (message ""))) (defun gnus-yes-or-no-p (prompt) (prog1 (yes-or-no-p prompt) (message ""))) ;; Check whether to use long file names. (defun gnus-use-long-file-name (symbol) ;; The variable has to be set... (and gnus-use-long-file-name ;; If it isn't a list, then we return t. (or (not (listp gnus-use-long-file-name)) ;; If it is a list, and the list contains `symbol', we ;; return nil. (not (memq symbol gnus-use-long-file-name))))) ;; I suspect there's a better way, but I haven't taken the time to do ;; it yet. -erik selberg@cs.washington.edu (defun gnus-dd-mmm (messy-date) "Return a string like DD-MMM from a big messy string" (let ((datevec (timezone-parse-date messy-date))) (format "%2s-%s" (or (aref datevec 2) "??") (capitalize (or (car (nth (1- (string-to-number (aref datevec 1))) timezone-months-assoc)) "???"))))) ;; Make a hash table (default and minimum size is 255). ;; Optional argument HASHSIZE specifies the table size. (defun gnus-make-hashtable (&optional hashsize) (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0)) ;; Make a number that is suitable for hashing; bigger than MIN and one ;; less than 2^x. (defun gnus-create-hash-size (min) (let ((i 1)) (while (< i min) (setq i (* 2 i))) (1- i))) ;; Show message if message has a lower level than `gnus-verbose'. ;; Guide-line for numbers: ;; 1 - error messages, 3 - non-serious error messages, 5 - messages ;; for things that take a long time, 7 - not very important messages ;; on stuff, 9 - messages inside loops. (defun gnus-message (level &rest args) (if (<= level gnus-verbose) (apply 'message args) ;; We have to do this format thingie here even if the result isn't ;; shown - the return value has to be the same as the return value ;; from `message'. (apply 'format args))) ;; Generate a unique new group name. (defun gnus-generate-new-group-name (leaf) (let ((name leaf) (num 0)) (while (gnus-gethash name gnus-newsrc-hashtb) (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) name)) (defun gnus-ephemeral-group-p (group) "Say whether GROUP is ephemeral or not." (assoc 'quit-config (gnus-find-method-for-group group))) (defun gnus-group-quit-config (group) "Return the quit-config of GROUP." (nth 1 (assoc 'quit-config (gnus-find-method-for-group group)))) ;;; List and range functions (defun gnus-last-element (list) "Return last element of LIST." (while (cdr list) (setq list (cdr list))) (car list)) (defun gnus-copy-sequence (list) "Do a complete, total copy of a list." (if (and (consp list) (not (consp (cdr list)))) (cons (car list) (cdr list)) (mapcar (lambda (elem) (if (consp elem) (if (consp (cdr elem)) (gnus-copy-sequence elem) (cons (car elem) (cdr elem))) elem)) list))) (defun gnus-set-difference (list1 list2) "Return a list of elements of LIST1 that do not appear in LIST2." (let ((list1 (copy-sequence list1))) (while list2 (setq list1 (delq (car list2) list1)) (setq list2 (cdr list2))) list1)) (defun gnus-sorted-complement (list1 list2) "Return a list of elements of LIST1 that do not appear in LIST2. Both lists have to be sorted over <." (let (out) (if (or (null list1) (null list2)) (or list1 list2) (while (and list1 list2) (cond ((= (car list1) (car list2)) (setq list1 (cdr list1) list2 (cdr list2))) ((< (car list1) (car list2)) (setq out (cons (car list1) out)) (setq list1 (cdr list1))) (t (setq out (cons (car list2) out)) (setq list2 (cdr list2))))) (nconc (nreverse out) (or list1 list2))))) (defun gnus-intersection (list1 list2) (let ((result nil)) (while list2 (if (memq (car list2) list1) (setq result (cons (car list2) result))) (setq list2 (cdr list2))) result)) (defun gnus-sorted-intersection (list1 list2) ;; LIST1 and LIST2 have to be sorted over <. (let (out) (while (and list1 list2) (cond ((= (car list1) (car list2)) (setq out (cons (car list1) out) list1 (cdr list1) list2 (cdr list2))) ((< (car list1) (car list2)) (setq list1 (cdr list1))) (t (setq list2 (cdr list2))))) (nreverse out))) (defun gnus-set-sorted-intersection (list1 list2) ;; LIST1 and LIST2 have to be sorted over <. ;; This function modifies LIST1. (let* ((top (cons nil list1)) (prev top)) (while (and list1 list2) (cond ((= (car list1) (car list2)) (setq prev list1 list1 (cdr list1) list2 (cdr list2))) ((< (car list1) (car list2)) (setcdr prev (cdr list1)) (setq list1 (cdr list1))) (t (setq list2 (cdr list2))))) (setcdr prev nil) (cdr top))) (defun gnus-compress-sequence (numbers &optional always-list) "Convert list of numbers to a list of ranges or a single range. If ALWAYS-LIST is non-nil, this function will always release a list of ranges." (let* ((first (car numbers)) (last (car numbers)) result) (if (null numbers) nil (if (not (listp (cdr numbers))) numbers (while numbers (cond ((= last (car numbers)) nil) ;Omit duplicated number ((= (1+ last) (car numbers)) ;Still in sequence (setq last (car numbers))) (t ;End of one sequence (setq result (cons (if (= first last) first (cons first last)) result)) (setq first (car numbers)) (setq last (car numbers)))) (setq numbers (cdr numbers))) (if (and (not always-list) (null result)) (if (= first last) (list first) (cons first last)) (nreverse (cons (if (= first last) first (cons first last)) result))))))) (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range) (defun gnus-uncompress-range (ranges) "Expand a list of ranges into a list of numbers. RANGES is either a single range on the form `(num . num)' or a list of these ranges." (let (first last result) (cond ((null ranges) nil) ((not (listp (cdr ranges))) (setq first (car ranges)) (setq last (cdr ranges)) (while (<= first last) (setq result (cons first result)) (setq first (1+ first))) (nreverse result)) (t (while ranges (if (atom (car ranges)) (if (numberp (car ranges)) (setq result (cons (car ranges) result))) (setq first (car (car ranges))) (setq last (cdr (car ranges))) (while (<= first last) (setq result (cons first result)) (setq first (1+ first)))) (setq ranges (cdr ranges))) (nreverse result))))) (defun gnus-add-to-range (ranges list) "Return a list of ranges that has all articles from both RANGES and LIST. Note: LIST has to be sorted over `<'." (if (not ranges) (gnus-compress-sequence list t) (setq list (copy-sequence list)) (or (listp (cdr ranges)) (setq ranges (list ranges))) (let ((out ranges) ilist lowest highest temp) (while (and ranges list) (setq ilist list) (setq lowest (or (and (atom (car ranges)) (car ranges)) (car (car ranges)))) (while (and list (cdr list) (< (car (cdr list)) lowest)) (setq list (cdr list))) (if (< (car ilist) lowest) (progn (setq temp list) (setq list (cdr list)) (setcdr temp nil) (setq out (nconc (gnus-compress-sequence ilist t) out)))) (setq highest (or (and (atom (car ranges)) (car ranges)) (cdr (car ranges)))) (while (and list (<= (car list) highest)) (setq list (cdr list))) (setq ranges (cdr ranges))) (if list (setq out (nconc (gnus-compress-sequence list t) out))) (setq out (sort out (lambda (r1 r2) (< (or (and (atom r1) r1) (car r1)) (or (and (atom r2) r2) (car r2)))))) (setq ranges out) (while ranges (if (atom (car ranges)) (if (cdr ranges) (if (atom (car (cdr ranges))) (if (= (1+ (car ranges)) (car (cdr ranges))) (progn (setcar ranges (cons (car ranges) (car (cdr ranges)))) (setcdr ranges (cdr (cdr ranges))))) (if (= (1+ (car ranges)) (car (car (cdr ranges)))) (progn (setcar (car (cdr ranges)) (car ranges)) (setcar ranges (car (cdr ranges))) (setcdr ranges (cdr (cdr ranges))))))) (if (cdr ranges) (if (atom (car (cdr ranges))) (if (= (1+ (cdr (car ranges))) (car (cdr ranges))) (progn (setcdr (car ranges) (car (cdr ranges))) (setcdr ranges (cdr (cdr ranges))))) (if (= (1+ (cdr (car ranges))) (car (car (cdr ranges)))) (progn (setcdr (car ranges) (cdr (car (cdr ranges)))) (setcdr ranges (cdr (cdr ranges)))))))) (setq ranges (cdr ranges))) out))) (defun gnus-remove-from-range (ranges list) "Return a list of ranges that has all articles from LIST removed from RANGES. Note: LIST has to be sorted over `<'." ;; !!! This function shouldn't look like this, but I've got a headache. (gnus-compress-sequence (gnus-sorted-complement (gnus-uncompress-range ranges) list))) (defun gnus-member-of-range (number ranges) (if (not (listp (cdr ranges))) (and (>= number (car ranges)) (<= number (cdr ranges))) (let ((not-stop t)) (while (and ranges (if (numberp (car ranges)) (>= number (car ranges)) (>= number (car (car ranges)))) not-stop) (if (if (numberp (car ranges)) (= number (car ranges)) (and (>= number (car (car ranges))) (<= number (cdr (car ranges))))) (setq not-stop nil)) (setq ranges (cdr ranges))) (not not-stop)))) ;;; ;;; Gnus group mode ;;; (defvar gnus-group-mode-map nil) (defvar gnus-group-group-map nil) (defvar gnus-group-mark-map nil) (defvar gnus-group-list-map nil) (defvar gnus-group-sub-map nil) (put 'gnus-group-mode 'mode-class 'special) (if gnus-group-mode-map nil (setq gnus-group-mode-map (make-keymap)) (suppress-keymap gnus-group-mode-map) (define-key gnus-group-mode-map " " 'gnus-group-read-group) (define-key gnus-group-mode-map "=" 'gnus-group-select-group) (define-key gnus-group-mode-map "\r" 'gnus-group-select-group) (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group) (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group) (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group) (define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group) (define-key gnus-group-mode-map "N" 'gnus-group-next-group) (define-key gnus-group-mode-map "P" 'gnus-group-prev-group) (define-key gnus-group-mode-map "\M-n" 'gnus-group-next-unread-group-same-level) (define-key gnus-group-mode-map "\M-p" 'gnus-group-prev-unread-group-same-level) (define-key gnus-group-mode-map "," 'gnus-group-best-unread-group) (define-key gnus-group-mode-map "." 'gnus-group-first-unread-group) (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group) (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group) (define-key gnus-group-mode-map "c" 'gnus-group-catchup-current) (define-key gnus-group-mode-map "C" 'gnus-group-catchup-current-all) (define-key gnus-group-mode-map "l" 'gnus-group-list-groups) (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups) (define-key gnus-group-mode-map "m" 'gnus-group-mail) (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news) (define-key gnus-group-mode-map "\M-g" 'gnus-group-get-new-news-this-group) (define-key gnus-group-mode-map "R" 'gnus-group-restart) (define-key gnus-group-mode-map "r" 'gnus-group-read-init-file) (define-key gnus-group-mode-map "B" 'gnus-group-browse-foreign-server) (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups) (define-key gnus-group-mode-map "F" 'gnus-find-new-newsgroups) (define-key gnus-group-mode-map "\C-c\C-d" 'gnus-group-describe-group) (define-key gnus-group-mode-map "\M-d" 'gnus-group-describe-all-groups) (define-key gnus-group-mode-map "\C-c\C-a" 'gnus-group-apropos) (define-key gnus-group-mode-map "\C-c\M-\C-a" 'gnus-group-description-apropos) (define-key gnus-group-mode-map "a" 'gnus-group-post-news) (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill) (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill) (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group) (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group) (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region) (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups) (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-group-list-killed) (define-key gnus-group-mode-map "\C-c\C-x" 'gnus-group-expire-articles) (define-key gnus-group-mode-map "\C-c\M-\C-x" 'gnus-group-expire-all-groups) (define-key gnus-group-mode-map "V" 'gnus-version) (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc) (define-key gnus-group-mode-map "z" 'gnus-group-suspend) (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble) (define-key gnus-group-mode-map "q" 'gnus-group-exit) (define-key gnus-group-mode-map "Q" 'gnus-group-quit) (define-key gnus-group-mode-map "\M-f" 'gnus-group-fetch-faq) (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly) (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node) (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group-method) (define-key gnus-group-mode-map "^" 'gnus-group-enter-server-mode) (define-key gnus-group-mode-map gnus-mouse-2 'gnus-mouse-pick-group) (define-key gnus-group-mode-map "<" 'beginning-of-buffer) (define-key gnus-group-mode-map ">" 'end-of-buffer) (define-key gnus-group-mode-map "\C-c\C-b" 'gnus-bug) (define-key gnus-group-mode-map "\C-c\C-s" 'gnus-group-sort-groups) (define-key gnus-group-mode-map "#" 'gnus-group-mark-group) (define-key gnus-group-mode-map "\M-#" 'gnus-group-unmark-group) (define-prefix-command 'gnus-group-mark-map) (define-key gnus-group-mode-map "M" 'gnus-group-mark-map) (define-key gnus-group-mark-map "m" 'gnus-group-mark-group) (define-key gnus-group-mark-map "u" 'gnus-group-unmark-group) (define-key gnus-group-mark-map "w" 'gnus-group-mark-region) (define-prefix-command 'gnus-group-group-map) (define-key gnus-group-mode-map "G" 'gnus-group-group-map) (define-key gnus-group-group-map "d" 'gnus-group-make-directory-group) (define-key gnus-group-group-map "h" 'gnus-group-make-help-group) (define-key gnus-group-group-map "a" 'gnus-group-make-archive-group) (define-key gnus-group-group-map "k" 'gnus-group-make-kiboze-group) (define-key gnus-group-group-map "m" 'gnus-group-make-group) (define-key gnus-group-group-map "E" 'gnus-group-edit-group) (define-key gnus-group-group-map "e" 'gnus-group-edit-group-method) (define-key gnus-group-group-map "p" 'gnus-group-edit-group-parameters) (define-key gnus-group-group-map "v" 'gnus-group-add-to-virtual) (define-key gnus-group-group-map "V" 'gnus-group-make-empty-virtual) (define-key gnus-group-group-map "D" 'gnus-group-enter-directory) (define-key gnus-group-group-map "f" 'gnus-group-make-doc-group) ;;(define-key gnus-group-group-map "sb" 'gnus-group-brew-soup) ;;(define-key gnus-group-group-map "sw" 'gnus-soup-save-areas) ;;(define-key gnus-group-group-map "ss" 'gnus-soup-send-replies) ;;(define-key gnus-group-group-map "sp" 'gnus-soup-pack-packet) ;;(define-key gnus-group-group-map "sr" 'nnsoup-pack-replies) (define-prefix-command 'gnus-group-list-map) (define-key gnus-group-mode-map "A" 'gnus-group-list-map) (define-key gnus-group-list-map "k" 'gnus-group-list-killed) (define-key gnus-group-list-map "z" 'gnus-group-list-zombies) (define-key gnus-group-list-map "s" 'gnus-group-list-groups) (define-key gnus-group-list-map "u" 'gnus-group-list-all-groups) (define-key gnus-group-list-map "a" 'gnus-group-apropos) (define-key gnus-group-list-map "d" 'gnus-group-description-apropos) (define-key gnus-group-list-map "m" 'gnus-group-list-matching) (define-key gnus-group-list-map "M" 'gnus-group-list-all-matching) (define-prefix-command 'gnus-group-sub-map) (define-key gnus-group-mode-map "S" 'gnus-group-sub-map) (define-key gnus-group-sub-map "l" 'gnus-group-set-current-level) (define-key gnus-group-sub-map "t" 'gnus-group-unsubscribe-current-group) (define-key gnus-group-sub-map "s" 'gnus-group-unsubscribe-group) (define-key gnus-group-sub-map "k" 'gnus-group-kill-group) (define-key gnus-group-sub-map "y" 'gnus-group-yank-group) (define-key gnus-group-sub-map "w" 'gnus-group-kill-region) (define-key gnus-group-sub-map "z" 'gnus-group-kill-all-zombies)) (defun gnus-group-mode () "Major mode for reading news. All normal editing commands are switched off. \\ The group buffer lists (some of) the groups available. For instance, `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' lists all zombie groups. Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). The following commands are available: \\{gnus-group-mode-map}" (interactive) (if gnus-visual (gnus-group-make-menu-bar)) (kill-all-local-variables) (setq mode-line-modified "-- ") (make-local-variable 'mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) (and (equal (nth 3 mode-line-format) " ") (setcar (nthcdr 3 mode-line-format) "")) (setq major-mode 'gnus-group-mode) (setq mode-name "Group") (gnus-group-set-mode-line) (setq mode-line-process nil) (use-local-map gnus-group-mode-map) (buffer-disable-undo (current-buffer)) (setq truncate-lines t) (setq buffer-read-only t) (run-hooks 'gnus-group-mode-hook)) (defun gnus-mouse-pick-group (e) (interactive "e") (mouse-set-point e) (gnus-group-read-group nil)) ;; Look at LEVEL and find out what the level is really supposed to be. ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens ;; will depend on whether `gnus-group-use-permanent-levels' is used. (defun gnus-group-default-level (&optional level number-or-nil) (cond (gnus-group-use-permanent-levels (setq gnus-group-default-list-level (or level gnus-group-default-list-level)) (or gnus-group-default-list-level gnus-level-subscribed)) (number-or-nil level) (t (or level gnus-group-default-list-level gnus-level-subscribed)))) (defvar gnus-tmp-prev-perm nil) ;;;###autoload (defun gnus-no-server (&optional arg) "Read network news. If ARG is a positive number, Gnus will use that as the startup level. If ARG is nil, Gnus will be started at level 2. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use. As opposed to `gnus', this command will not connect to the local server." (interactive "P") (let ((perm (cons gnus-group-use-permanent-levels gnus-group-default-list-level))) (setq gnus-tmp-prev-perm nil) (setq gnus-group-use-permanent-levels t) (gnus (or arg (1- gnus-level-default-subscribed)) t) (setq gnus-tmp-prev-perm perm))) ;;;###autoload (defun gnus (&optional arg dont-connect) "Read network news. If ARG is non-nil and a positive number, Gnus will use that as the startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use." (interactive "P") (if (get-buffer gnus-group-buffer) (progn (switch-to-buffer gnus-group-buffer) (gnus-group-get-new-news)) (gnus-clear-system) (nnheader-init-server-buffer) ;; We do this if `gnus-no-server' has been run. (if gnus-tmp-prev-perm (setq gnus-group-use-permanent-levels (car gnus-tmp-prev-perm) gnus-group-default-list-level (cdr gnus-tmp-prev-perm) gnus-tmp-prev-perm nil)) (gnus-read-init-file) (gnus-group-setup-buffer) (let ((buffer-read-only nil)) (erase-buffer) (if (not gnus-inhibit-startup-message) (progn (gnus-group-startup-message) (sit-for 0)))) (let ((level (and arg (numberp arg) (> arg 0) arg)) did-connect) (unwind-protect (progn (or dont-connect (setq did-connect (gnus-start-news-server (and arg (not level)))))) (if (and (not dont-connect) (not did-connect)) (gnus-group-quit) (run-hooks 'gnus-startup-hook) ;; NNTP server is successfully open. ;; Find the current startup file name. (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file)) ;; Read the dribble file. (and gnus-use-dribble-file (gnus-dribble-read-file)) (gnus-summary-make-display-table) (gnus-setup-news nil level) (gnus-group-list-groups level) (gnus-configure-windows 'group)))))) (defun gnus-unload () "Unload all Gnus features." (interactive) (or (boundp 'load-history) (error "Sorry, `gnus-unload' is not implemented in this Emacs version.")) (let ((history load-history) feature) (while history (and (string-match "^gnus" (car (car history))) (setq feature (cdr (assq 'provide (car history)))) (unload-feature feature 'force)) (setq history (cdr history))))) (defun gnus-group-startup-message (&optional x y) "Insert startup message in current buffer." ;; Insert the message. (erase-buffer) (insert (format " _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ _ ___ _ _ _ __ _ ___ __ _ __ _ _ _ _ _ _ _ _ _ _ __ ___ _ _ _ _ _ _ _ _ _ _ _ __ Gnus * A newsreader for Emacsen A Praxis release * larsi@ifi.uio.no " gnus-version)) ;; And then hack it. ;; 18 is the longest line. (indent-rigidly (point-min) (point-max) (/ (max (- (window-width) (or x 46)) 0) 2)) (goto-char (point-min)) (let* ((pheight (count-lines (point-min) (point-max))) (wheight (window-height)) (rest (- wheight pheight))) (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ;; Fontify some. (goto-char (point-min)) (search-forward "Praxis") (put-text-property (match-beginning 0) (match-end 0) 'face 'bold) (goto-char (point-min))) (defun gnus-group-startup-message-old (&optional x y) "Insert startup message in current buffer." ;; Insert the message. (erase-buffer) (insert (format " %s A newsreader for GNU Emacs Based on GNUS written by Masanobu UMEDA A Praxis Release larsi@ifi.uio.no " gnus-version)) ;; And then hack it. ;; 18 is the longest line. (indent-rigidly (point-min) (point-max) (/ (max (- (window-width) (or x 28)) 0) 2)) (goto-char (point-min)) ;; +4 is fuzzy factor. (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2)) ;; Fontify some. (goto-char (point-min)) (search-forward "Praxis") (put-text-property (match-beginning 0) (match-end 0) 'face 'bold) (goto-char (point-min))) (defun gnus-group-setup-buffer () (or (get-buffer gnus-group-buffer) (progn (switch-to-buffer gnus-group-buffer) (gnus-add-current-to-buffer-list) (gnus-group-mode) (and gnus-carpal (gnus-carpal-setup-buffer 'group))))) (defun gnus-group-list-groups (&optional level unread) "List newsgroups with level LEVEL or lower that have unread articles. Default is all subscribed groups. If argument UNREAD is non-nil, groups with no unread articles are also listed." (interactive (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) (or (gnus-group-default-level nil t) gnus-group-default-list-level gnus-level-subscribed)))) (or level (setq level (car gnus-group-list-mode) unread (cdr gnus-group-list-mode))) (setq level (gnus-group-default-level level)) (gnus-group-setup-buffer) ;May call from out of group buffer (let ((case-fold-search nil) (group (gnus-group-group-name))) (funcall gnus-group-prepare-function level unread nil) (if (zerop (buffer-size)) (gnus-message 5 gnus-no-groups-message) (goto-char (point-min)) (if (not group) ;; Go to the first group with unread articles. (gnus-group-search-forward nil nil nil t) ;; Find the right group to put point on. If the current group ;; has disapeared in the new listing, try to find the next ;; one. If no next one can be found, just leave point at the ;; first newsgroup in the buffer. (if (not (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-group (intern group)))) (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb)))) (while (and newsrc (not (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-group (intern (car (car newsrc))))))) (setq newsrc (cdr newsrc))) (or newsrc (progn (goto-char (point-max)) (forward-line -1)))))) ;; Adjust cursor point. (gnus-group-position-cursor)))) (defun gnus-group-prepare-flat (level &optional all lowest regexp) "List all newsgroups with unread articles of level LEVEL or lower. If ALL is non-nil, list groups that have no unread articles. If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. If REGEXP, only list groups matching REGEXP." (set-buffer gnus-group-buffer) (let ((buffer-read-only nil) (newsrc (cdr gnus-newsrc-alist)) (lowest (or lowest 1)) info clevel unread group) (erase-buffer) (if (< lowest gnus-level-zombie) ;; List living groups. (while newsrc (setq info (car newsrc) group (car info) newsrc (cdr newsrc) unread (car (gnus-gethash group gnus-newsrc-hashtb))) (and unread ; This group might be bogus (or (not regexp) (string-match regexp group)) (<= (setq clevel (car (cdr info))) level) (>= clevel lowest) (or all ; We list all groups? (eq unread t) ; We list unactivated groups (> unread 0) ; We list groups with unread articles (cdr (assq 'tick (nth 3 info)))) ; And groups with tickeds (gnus-group-insert-group-line nil group (car (cdr info)) (nth 3 info) unread (nth 4 info))))) ;; List dead groups. (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) (gnus-group-prepare-flat-list-dead (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) gnus-level-zombie ?Z regexp)) (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) (gnus-group-prepare-flat-list-dead (setq gnus-killed-list (sort gnus-killed-list 'string<)) gnus-level-killed ?K regexp)) (gnus-group-set-mode-line) (setq gnus-group-list-mode (cons level all)) (run-hooks 'gnus-group-prepare-hook))) (defun gnus-group-prepare-flat-list-dead (groups level mark regexp) ;; List zombies and killed lists somehwat faster, which was ;; suggested by Jack Vinson . It does ;; this by ignoring the group format specification altogether. (let (group beg) (while groups (setq group (car groups) groups (cdr groups)) (if (or (not regexp) (string-match regexp group)) (progn (setq beg (point)) (insert (format " %c *: %s\n" mark group)) (add-text-properties beg (1+ beg) (list 'gnus-group (intern group) 'gnus-unread t 'gnus-level level))))))) (defun gnus-group-real-name (group) "Find the real name of a foreign newsgroup." (if (string-match ":[^:]+$" group) (substring group (1+ (match-beginning 0))) group)) (defun gnus-group-prefixed-name (group method) "Return the whole name from GROUP and METHOD." (and (stringp method) (setq method (gnus-server-to-method method))) (concat (format "%s" (car method)) (if (and (assoc (format "%s" (car method)) (gnus-methods-using 'address)) (not (string= (nth 1 method) ""))) (concat "+" (nth 1 method))) ":" group)) (defun gnus-group-real-prefix (group) "Return the prefix of the current group name." (if (string-match "^[^:]+:" group) (substring group 0 (match-end 0)) "")) (defun gnus-group-method-name (group) "Return the method used for selecting GROUP." (let ((prefix (gnus-group-real-prefix group))) (if (equal prefix "") gnus-select-method (if (string-match "^[^\\+]+\\+" prefix) (list (intern (substring prefix 0 (1- (match-end 0)))) (substring prefix (match-end 0) (1- (length prefix)))) (list (intern (substring prefix 0 (1- (length prefix)))) ""))))) (defun gnus-group-foreign-p (group) "Return nil if GROUP is native, non-nil if it is foreign." (string-match ":" group)) (defun gnus-group-set-info (info &optional method-only-group part) (let* ((entry (gnus-gethash (or method-only-group (car info)) gnus-newsrc-hashtb)) (part-info info) (info (if method-only-group (nth 2 entry) info))) (if (not method-only-group) () (or entry (error "Trying to change non-existent group %s" method-only-group)) ;; We have recevied parts of the actual group info - either the ;; select method or the group parameters. We first check ;; whether we have to extend the info, and if so, do that. (let ((len (length info)) (total (if (eq part 'method) 5 6))) (and (< len total) (setcdr (nthcdr (1- len) info) (make-list (- total len) nil))) ;; Then we enter the new info. (setcar (nthcdr (1- total) info) part-info))) ;; We uncompress some lists of marked articles. (let (marked) (if (not (setq marked (nth 3 info))) () (while marked (or (eq 'score (car (car marked))) (eq 'bookmark (car (car marked))) (eq 'killed (car (car marked))) (setcdr (car marked) (gnus-uncompress-range (cdr (car marked))))) (setq marked (cdr marked))))) (if entry () ;; This is a new group, so we just create it. (save-excursion (set-buffer gnus-group-buffer) (if (nth 4 info) ;; It's a foreign group... (gnus-group-make-group (gnus-group-real-name (car info)) (prin1-to-string (car (nth 4 info))) (nth 1 (nth 4 info))) ;; It's a native group. (gnus-group-make-group (car info))) (gnus-message 6 "Note: New group created") (setq entry (gnus-gethash (gnus-group-prefixed-name (gnus-group-real-name (car info)) (or (nth 4 info) gnus-select-method)) gnus-newsrc-hashtb)))) ;; Whether it was a new group or not, we now have the entry, so we ;; can do the update. (if entry (progn (setcar (nthcdr 2 entry) info) (if (and (not (eq (car entry) t)) (gnus-gethash (car info) gnus-active-hashtb)) (let ((marked (nth 3 info))) (setcar entry (max 0 (- (length (gnus-list-of-unread-articles (car info))) (length (cdr (assq 'tick marked))) (length (cdr (assq 'dormant marked))))))))) (error "No such group: %s" (car info))))) (defun gnus-group-set-method-info (group select-method) (gnus-group-set-info select-method group 'method)) (defun gnus-group-set-params-info (group params) (gnus-group-set-info params group 'params)) (defun gnus-group-update-group-line () "This function updates the current line in the newsgroup buffer and moves the point to the colon." (let* ((buffer-read-only nil) (group (gnus-group-group-name)) (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))) (if (and entry (not (gnus-ephemeral-group-p group))) (gnus-dribble-enter (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) ")"))) (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point))) (gnus-group-insert-group-line-info group) (forward-line -1) (gnus-group-position-cursor))) (defun gnus-group-insert-group-line-info (group) (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) active info) (if entry (progn (setq info (nth 2 entry)) (gnus-group-insert-group-line nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info))) (setq active (gnus-gethash group gnus-active-hashtb)) (gnus-group-insert-group-line nil group (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) nil (if active (- (1+ (cdr active)) (car active)) 0) nil)))) (defun gnus-group-insert-group-line (gformat group level marked number method) (let* ((gformat (or gformat gnus-group-line-format-spec)) (active (gnus-gethash group gnus-active-hashtb)) (number-total (if active (1+ (- (cdr active) (car active))) 0)) (number-of-dormant (length (cdr (assq 'dormant marked)))) (number-of-ticked (length (cdr (assq 'tick marked)))) (number-of-ticked-and-dormant (+ number-of-ticked number-of-dormant)) (number-of-unread-unticked (if (numberp number) (int-to-string (max 0 number)) "*")) (number-of-read (if (numberp number) (max 0 (- number-total number)) "*")) (subscribed (cond ((<= level gnus-level-subscribed) ? ) ((<= level gnus-level-unsubscribed) ?U) ((= level gnus-level-zombie) ?Z) (t ?K))) (qualified-group (gnus-group-real-name group)) (newsgroup-description (if gnus-description-hashtb (or (gnus-gethash group gnus-description-hashtb) "") "")) (moderated (if (member group gnus-moderated-list) ?m ? )) (moderated-string (if (eq moderated ?m) "(m)" "")) (method (gnus-server-get-method group method)) (news-server (or (car (cdr method)) "")) (news-method (or (car method) "")) (news-method-string (if method (format "(%s:%s)" (car method) (car (cdr method))) "")) (marked (if (and (numberp number) (zerop number) (> number-of-ticked 0)) ?* ? )) (number (if (eq number t) "*" (+ number number-of-dormant number-of-ticked))) (process-marked (if (member group gnus-group-marked) gnus-process-mark ? )) (buffer-read-only nil) header ; passed as parameter to user-funcs. b) (beginning-of-line) (setq b (point)) ;; Insert the text. (insert (eval gformat)) (add-text-properties b (1+ b) (list 'gnus-group (intern group) 'gnus-unread (if (numberp number) (string-to-int number-of-unread-unticked) t) 'gnus-marked marked 'gnus-level level)))) (defun gnus-group-update-group (group &optional visible-only) "Update newsgroup info of GROUP. If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already." (save-excursion (set-buffer gnus-group-buffer) (let ((buffer-read-only nil) visible) (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) (if (and entry (not (gnus-ephemeral-group-p group))) (gnus-dribble-enter (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) ")")))) ;; Buffer may be narrowed. (save-restriction (widen) ;; Search a line to modify. If the buffer is large, the search ;; takes long time. In most cases, current point is on the line ;; we are looking for. So, first of all, check current line. (if (or (progn (beginning-of-line) (eq (get-text-property (point) 'gnus-group) (intern group))) (progn (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-group (intern group))))) ;; GROUP is listed in current buffer. So, delete old line. (progn (setq visible t) (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point)))) ;; No such line in the buffer, find out where it's supposed to ;; go, and insert it there (or at the end of the buffer). ;; Fix by Per Abrahamsen . (or visible-only (let ((entry (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb))))) (while (and entry (car entry) (not (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-group (intern (car (car entry))))))) (setq entry (cdr entry))) (or entry (goto-char (point-max))))))) (if (or visible (not visible-only)) (gnus-group-insert-group-line-info group)) (gnus-group-set-mode-line)))) (defun gnus-group-set-mode-line () (if (memq 'group gnus-updated-mode-lines) (let* ((gformat (or gnus-group-mode-line-format-spec (setq gnus-group-mode-line-format-spec (gnus-parse-format gnus-group-mode-line-format gnus-group-mode-line-format-alist)))) (news-server (car (cdr gnus-select-method))) (news-method (car gnus-select-method)) (max-len 60) (mode-string (eval gformat))) (setq mode-string (eval gformat)) (if (> (length mode-string) max-len) (setq mode-string (substring mode-string 0 (- max-len 4)))) (setq mode-line-buffer-identification mode-string) (set-buffer-modified-p t)))) (defun gnus-group-group-name () "Get the name of the newsgroup on the current line." (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group))) (and group (symbol-name group)))) (defun gnus-group-group-level () "Get the level of the newsgroup on the current line." (get-text-property (gnus-point-at-bol) 'gnus-level)) (defun gnus-group-group-unread () "Get the number of unread articles of the newsgroup on the current line." (get-text-property (gnus-point-at-bol) 'gnus-unread)) (defun gnus-group-search-forward (&optional backward all level first-too) "Find the next newsgroup with unread articles. If BACKWARD is non-nil, find the previous newsgroup instead. If ALL is non-nil, just find any newsgroup. If LEVEL is non-nil, find group with level LEVEL, or higher if no such group exists. If FIRST-TOO, the current line is also eligible as a target." (let ((way (if backward -1 1)) (low gnus-level-killed) (beg (point)) pos found lev) (if (and backward (progn (beginning-of-line)) (bobp)) nil (or first-too (forward-line way)) (while (and (not (eobp)) (not (setq found (and (or all (and (let ((unread (get-text-property (point) 'gnus-unread))) (or (eq unread t) (and unread (> unread 0)))) (setq lev (get-text-property (point) 'gnus-level)) (<= lev gnus-level-subscribed))) (or (not level) (and (setq lev (get-text-property (point) 'gnus-level)) (or (= lev level) (and (< lev low) (< level lev) (progn (setq low lev) (setq pos (point)) nil)))))))) (zerop (forward-line way))))) (if found (progn (gnus-group-position-cursor) t) (goto-char (or pos beg)) (and pos t)))) ;;; Gnus group mode commands ;; Group marking. (defun gnus-group-mark-group (n &optional unmark no-advance) "Mark the current group." (interactive "p") (let ((buffer-read-only nil) group) (while (and (> n 0) (setq group (gnus-group-group-name)) (progn (beginning-of-line) (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) (delete-char 1) (if unmark (progn (insert " ") (setq gnus-group-marked (delete group gnus-group-marked))) (insert "#") (setq gnus-group-marked (cons group (delete group gnus-group-marked)))) t) (or no-advance (zerop (gnus-group-next-group 1)))) (setq n (1- n))) (gnus-summary-position-cursor) n)) (defun gnus-group-unmark-group (n) "Remove the mark from the current group." (interactive "p") (gnus-group-mark-group n 'unmark)) (defun gnus-group-mark-region (unmark beg end) "Mark all groups between point and mark. If UNMARK, remove the mark instead." (interactive "P\nr") (let ((num (count-lines beg end))) (save-excursion (goto-char beg) (- num (gnus-group-mark-group num unmark))))) (defun gnus-group-remove-mark (group) (and (gnus-group-goto-group group) (save-excursion (gnus-group-mark-group 1 'unmark t)))) ;; Return a list of groups to work on. Take into consideration N (the ;; prefix) and the list of marked groups. (defun gnus-group-process-prefix (n) (cond (n (setq n (prefix-numeric-value n)) ;; There is a prefix, so we return a list of the N next ;; groups. (let ((way (if (< n 0) -1 1)) (n (abs n)) group groups) (save-excursion (while (and (> n 0) (setq group (gnus-group-group-name))) (setq groups (cons group groups)) (setq n (1- n)) (forward-line way))) (nreverse groups))) (gnus-group-marked ;; No prefix, but a list of marked articles. (reverse gnus-group-marked)) (t ;; Neither marked articles or a prefix, so we return the ;; current group. (let ((group (gnus-group-group-name))) (and group (list group)))))) ;; Selecting groups. (defun gnus-group-read-group (&optional all no-article group) "Read news in this newsgroup. If the prefix argument ALL is non-nil, already read articles become readable. If the optional argument NO-ARTICLE is non-nil, no article will be auto-selected upon group entry." (interactive "P") (let ((group (or group (gnus-group-group-name))) number active marked entry) (or group (error "No group on current line")) (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash group gnus-newsrc-hashtb))))) ;; This group might be a dead group. In that case we have to get ;; the number of unread articles from `gnus-active-hashtb'. (if entry (setq number (car entry)) (if (setq active (gnus-gethash group gnus-active-hashtb)) (setq number (- (1+ (cdr active)) (car active))))) (gnus-summary-read-group group (or all (and (numberp number) (zerop (+ number (length (cdr (assq 'tick marked))) (length (cdr (assq 'dormant marked))))))) no-article))) (defun gnus-group-select-group (&optional all) "Select this newsgroup. No article is selected automatically. If argument ALL is non-nil, already read articles become readable." (interactive "P") (gnus-group-read-group all t)) (defun gnus-group-select-group-all () "Select the current group and display all articles in it." (interactive) (gnus-group-select-group 'all)) ;; Enter a group that is not in the group buffer. Non-nil is returned ;; if selection was successful. (defun gnus-group-read-ephemeral-group (group method &optional activate quit-config) (let ((group (if (gnus-group-foreign-p group) group (gnus-group-prefixed-name group method)))) (gnus-sethash group (list t nil (list group gnus-level-default-subscribed nil nil (append method (list (list 'quit-config (if quit-config quit-config (cons (current-buffer) 'summary))))))) gnus-newsrc-hashtb) (set-buffer gnus-group-buffer) (or (gnus-check-server method) (error "Unable to contact server: %s" (gnus-status-message method))) (if activate (or (gnus-request-group group) (error "Couldn't request group"))) (condition-case () (gnus-group-read-group t t group) (error nil) (quit nil)) (not (equal major-mode 'gnus-group-mode)))) (defun gnus-group-jump-to-group (group) "Jump to newsgroup GROUP." (interactive (list (completing-read "Group: " gnus-active-hashtb nil (memq gnus-select-method gnus-have-read-active-file)))) (if (equal group "") (error "Empty group name")) (let ((b (text-property-any (point-min) (point-max) 'gnus-group (intern group)))) (if b ;; Either go to the line in the group buffer... (goto-char b) ;; ... or insert the line. (or (gnus-gethash group gnus-active-hashtb) (gnus-activate-group group) (error "%s error: %s" group (gnus-status-message group))) (gnus-group-update-group group) (goto-char (text-property-any (point-min) (point-max) 'gnus-group (intern group))))) ;; Adjust cursor point. (gnus-group-position-cursor)) (defun gnus-group-goto-group (group) "Goto to newsgroup GROUP." (let ((b (text-property-any (point-min) (point-max) 'gnus-group (intern group)))) (and b (goto-char b)))) (defun gnus-group-next-group (n) "Go to next N'th newsgroup. If N is negative, search backward instead. Returns the difference between N and the number of skips actually done." (interactive "p") (gnus-group-next-unread-group n t)) (defun gnus-group-next-unread-group (n &optional all level) "Go to next N'th unread newsgroup. If N is negative, search backward instead. If ALL is non-nil, choose any newsgroup, unread or not. If LEVEL is non-nil, choose the next group with level LEVEL, or, if no such group can be found, the next group with a level higher than LEVEL. Returns the difference between N and the number of skips actually made." (interactive "p") (let ((backward (< n 0)) (n (abs n))) (while (and (> n 0) (gnus-group-search-forward backward (or (not gnus-group-goto-unread) all) level)) (setq n (1- n))) (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread") (if level " on this level or higher" ""))) n)) (defun gnus-group-prev-group (n) "Go to previous N'th newsgroup. Returns the difference between N and the number of skips actually done." (interactive "p") (gnus-group-next-unread-group (- n) t)) (defun gnus-group-prev-unread-group (n) "Go to previous N'th unread newsgroup. Returns the difference between N and the number of skips actually done." (interactive "p") (gnus-group-next-unread-group (- n))) (defun gnus-group-next-unread-group-same-level (n) "Go to next N'th unread newsgroup on the same level. If N is negative, search backward instead. Returns the difference between N and the number of skips actually done." (interactive "p") (gnus-group-next-unread-group n t (gnus-group-group-level)) (gnus-group-position-cursor)) (defun gnus-group-prev-unread-group-same-level (n) "Go to next N'th unread newsgroup on the same level. Returns the difference between N and the number of skips actually done." (interactive "p") (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) (gnus-group-position-cursor)) (defun gnus-group-best-unread-group (&optional exclude-group) "Go to the group with the highest level. If EXCLUDE-GROUP, do not go to that group." (interactive) (goto-char (point-min)) (let ((best 100000) unread best-point) (while (setq unread (get-text-property (point) 'gnus-unread)) (if (and (numberp unread) (> unread 0)) (progn (if (and (< (get-text-property (point) 'gnus-level) best) (or (not exclude-group) (not (equal exclude-group (gnus-group-group-name))))) (progn (setq best (get-text-property (point) 'gnus-level)) (setq best-point (point)))))) (forward-line 1)) (if best-point (goto-char best-point)) (gnus-summary-position-cursor) (and best-point (gnus-group-group-name)))) (defun gnus-group-first-unread-group () "Go to the first group with unread articles." (interactive) (prog1 (let ((opoint (point)) unread) (goto-char (point-min)) (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active. (not (zerop unread)) ; Has unread articles. (zerop (gnus-group-next-unread-group 1))) ; Next unread group. (point) ; Success. (goto-char opoint) nil)) ; Not success. (gnus-group-position-cursor))) (defun gnus-group-enter-server-mode () "Jump to the server buffer." (interactive) (gnus-server-setup-buffer) (gnus-configure-windows 'server) (gnus-server-prepare)) (defun gnus-group-make-group (name &optional method address) "Add a new newsgroup. The user will be prompted for a NAME, for a select METHOD, and an ADDRESS." (interactive (cons (read-string "Group name: ") (let ((method (completing-read "Method: " (append gnus-valid-select-methods gnus-server-alist) nil t))) (if (assoc method gnus-valid-select-methods) (list method (if (memq 'prompt-address (assoc method gnus-valid-select-methods)) (read-string "Address: ") "")) (list method nil))))) (let* ((meth (and method (if address (list (intern method) address) method))) (nname (if method (gnus-group-prefixed-name name meth) name)) info) (and (gnus-gethash nname gnus-newsrc-hashtb) (error "Group %s already exists" nname)) (gnus-group-change-level (setq info (list t nname gnus-level-default-subscribed nil nil meth)) gnus-level-default-subscribed gnus-level-killed (and (gnus-group-group-name) (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)) t) (gnus-sethash nname (cons 1 0) gnus-active-hashtb) (or (gnus-ephemeral-group-p name) (gnus-dribble-enter (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))) (gnus-group-insert-group-line-info nname) (if (assoc method gnus-valid-select-methods) (require (intern method))) (and (gnus-check-backend-function 'request-create-group nname) (gnus-request-create-group nname)))) (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." (interactive (list (gnus-group-group-name))) (let ((done-func '(lambda () "Exit editing mode and update the information." (interactive) (gnus-group-edit-group-done 'part 'group))) (part (or part 'info)) (winconf (current-window-configuration)) info) (or group (error "No group on current line")) (or (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (error "Killed group; can't be edited")) (set-buffer (get-buffer-create gnus-group-edit-buffer)) (gnus-configure-windows 'edit-group) (gnus-add-current-to-buffer-list) (emacs-lisp-mode) ;; Suggested by Hallvard B Furuseth . (use-local-map (copy-keymap emacs-lisp-mode-map)) (local-set-key "\C-c\C-c" done-func) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) ;; We modify the func to let it know what part it is editing. (setcar (cdr (nth 4 done-func)) (list 'quote part)) (setcar (cdr (cdr (nth 4 done-func))) group) (erase-buffer) (insert (cond ((eq part 'method) ";; Type `C-c C-c' after editing the select method.\n\n") ((eq part 'params) ";; Type `C-c C-c' after editing the group parameters.\n\n") ((eq part 'info) ";; Type `C-c C-c' after editing the group info.\n\n"))) (let ((cinfo (gnus-copy-sequence info)) marked) (if (not (setq marked (nth 3 cinfo))) () (while marked (or (eq 'score (car (car marked))) (eq 'bookmark (car (car marked))) (eq 'killed (car (car marked))) (not (numberp (car (cdr (car marked))))) (setcdr (car marked) (gnus-compress-sequence (sort (cdr (car marked)) '<) t))) (setq marked (cdr marked)))) (insert (pp-to-string (cond ((eq part 'method) (or (nth 4 info) "native")) ((eq part 'params) (nth 5 info)) (t cinfo))) "\n")))) (defun gnus-group-edit-group-method (group) "Edit the select method of GROUP." (interactive (list (gnus-group-group-name))) (gnus-group-edit-group group 'method)) (defun gnus-group-edit-group-parameters (group) "Edit the group parameters of GROUP." (interactive (list (gnus-group-group-name))) (gnus-group-edit-group group 'params)) (defun gnus-group-edit-group-done (part group) "Get info from buffer, update variables and jump to the group buffer." (set-buffer (get-buffer-create gnus-group-edit-buffer)) (goto-char (point-min)) (let ((form (read (current-buffer))) (winconf gnus-prev-winconf)) (if (eq part 'info) (gnus-group-set-info form) (gnus-group-set-info form group part)) (kill-buffer (current-buffer)) (and winconf (set-window-configuration winconf)) (set-buffer gnus-group-buffer) (gnus-group-update-group (gnus-group-group-name)) (gnus-group-position-cursor))) (defun gnus-group-make-help-group () "Create the Gnus documentation group." (interactive) (let ((path (cons (concat installation-directory "etc/") load-path)) (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) file) (and (gnus-gethash name gnus-newsrc-hashtb) (error "Documentation group already exists")) (while (and path (not (file-exists-p (setq file (concat (file-name-as-directory (car path)) "gnus-tut.txt"))))) (setq path (cdr path))) (if (not path) (message "Couldn't find doc group") (gnus-group-make-group (gnus-group-real-name name) (list 'nndoc name (list 'nndoc-address file) (list 'nndoc-article-type 'mbox))))) (gnus-group-position-cursor)) (defun gnus-group-make-doc-group (file type) "Create a group that uses a single file as the source." (interactive (list (read-file-name "File name: ") (let ((err "") found char) (while (not found) (message "%sFile type (mbox, babyl, digest) [mbd]: " err) (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) ((= char ?b) 'babyl) ((= char ?d) 'digest) (t (setq err (format "%c unknown. " char)) nil)))) found))) (let* ((file (expand-file-name file)) (name (gnus-generate-new-group-name (gnus-group-prefixed-name (file-name-nondirectory file) '(nndoc ""))))) (gnus-group-make-group (gnus-group-real-name name) (list 'nndoc name (list 'nndoc-address file) (list 'nndoc-article-type type))))) (defun gnus-group-make-archive-group (&optional all) "Create the (ding) Gnus archive group of the most recent articles. Given a prefix, create a full group." (interactive "P") (let ((group (gnus-group-prefixed-name (if all "ding.archives" "ding.recent") '(nndir "")))) (and (gnus-gethash group gnus-newsrc-hashtb) (error "Archive group already exists")) (gnus-group-make-group (gnus-group-real-name group) "nndir" (if all gnus-group-archive-directory gnus-group-recent-archive-directory))) (gnus-group-position-cursor)) (defun gnus-group-make-directory-group (dir) "Create an nndir group. The user will be prompted for a directory. The contents of this directory will be used as a newsgroup. The directory should contain mail messages or news articles in files that have numeric names." (interactive (list (read-file-name "Create group from directory: "))) (or (file-exists-p dir) (error "No such directory")) (or (file-directory-p dir) (error "Not a directory")) (gnus-group-make-group dir "nndir" dir) (gnus-group-position-cursor)) (defun gnus-group-make-kiboze-group (group address scores) "Create an nnkiboze group. The user will be prompted for a name, a regexp to match groups, and score file entries for articles to include in the group." (interactive (list (read-string "nnkiboze group name: ") (read-string "Source groups (regexp): ") (let ((headers (mapcar (lambda (group) (list group)) '("subject" "from" "number" "date" "message-id" "references" "chars" "lines" "xref"))) scores header regexp regexps) (while (not (equal "" (setq header (completing-read "Match on header: " headers nil t)))) (setq regexps nil) (while (not (equal "" (setq regexp (read-string (format "Match on %s (string): " header))))) (setq regexps (cons (list regexp nil nil 'r) regexps))) (setq scores (cons (cons header regexps) scores))) scores))) (gnus-group-make-group group "nnkiboze" address) (save-excursion (gnus-set-work-buffer) (let (emacs-lisp-mode-hook) (pp scores (current-buffer))) (write-region (point-min) (point-max) (concat (or gnus-kill-files-directory "~/News") "nnkiboze:" group "." gnus-score-file-suffix))) (gnus-group-position-cursor)) (defun gnus-group-add-to-virtual (n vgroup) "Add the current group to a virtual group." (interactive (list current-prefix-arg (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t "nnvirtual:"))) (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) (error "%s is not an nnvirtual group" vgroup)) (let* ((groups (gnus-group-process-prefix n)) (method (nth 4 (nth 2 (gnus-gethash vgroup gnus-newsrc-hashtb))))) (setcar (cdr method) (concat (nth 1 method) "\\|" (mapconcat (lambda (s) (gnus-group-remove-mark s) (concat "\\(^" (regexp-quote s) "$\\)")) groups "\\|")))) (gnus-group-position-cursor)) (defun gnus-group-make-empty-virtual (group) "Create a new, fresh, empty virtual group." (interactive "sCreate new, empty virtual group: ") (let* ((method (list 'nnvirtual "^$")) (pgroup (gnus-group-prefixed-name group method))) ;; Check whether it exists already. (and (gnus-gethash pgroup gnus-newsrc-hashtb) (error "Group %s already exists." pgroup)) ;; Subscribe the new group after the group on the current line. (gnus-subscribe-group pgroup (gnus-group-group-name) method) (gnus-group-update-group pgroup) (forward-line -1) (gnus-group-position-cursor))) (defun gnus-group-enter-directory (dir) "Enter an ephemeral nneething group." (interactive "DDirectory to read: ") (let* ((method (list 'nneething dir)) (leaf (gnus-group-prefixed-name (file-name-nondirectory (directory-file-name dir)) method)) (name (gnus-generate-new-group-name leaf))) (let ((nneething-read-only t)) (or (gnus-group-read-ephemeral-group name method t (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode) 'summary 'group))) (error "Couldn't enter %s" dir))))) ;; Group sorting commands ;; Suggested by Joe Hildebrand . (defun gnus-group-sort-groups () "Sort the group buffer using `gnus-group-sort-function'." (interactive) (setq gnus-newsrc-alist (sort (cdr gnus-newsrc-alist) gnus-group-sort-function)) (gnus-make-hashtable-from-newsrc-alist) (gnus-group-list-groups)) (defun gnus-group-sort-by-alphabet (info1 info2) (string< (car info1) (car info2))) (defun gnus-group-sort-by-unread (info1 info2) (let ((n1 (car (gnus-gethash (car info1) gnus-newsrc-hashtb))) (n2 (car (gnus-gethash (car info2) gnus-newsrc-hashtb)))) (< (or (and (numberp n1) n1) 0) (or (and (numberp n2) n2) 0)))) (defun gnus-group-sort-by-level (info1 info2) (< (nth 1 info1) (nth 1 info2))) ;; Group catching up. (defun gnus-group-catchup-current (&optional n all) "Mark all articles not marked as unread in current newsgroup as read. If prefix argument N is numeric, the ARG next newsgroups will be caught up. If ALL is non-nil, marked articles will also be marked as read. Cross references (Xref: header) of articles are ignored. The difference between N and actual number of newsgroups that were caught up is returned." (interactive "P") (if (not (or (not gnus-interactive-catchup) ;Without confirmation? gnus-expert-user (gnus-y-or-n-p (if all "Do you really want to mark all articles as read? " "Mark all unread articles as read? ")))) n (let ((groups (gnus-group-process-prefix n)) (ret 0)) (while groups ;; Virtual groups have to be given special treatment. (let ((method (gnus-find-method-for-group (car groups)))) (if (eq 'nnvirtual (car method)) (nnvirtual-catchup-group (gnus-group-real-name (car groups)) (nth 1 method) all))) (gnus-group-remove-mark (car groups)) (if (prog1 (gnus-group-goto-group (car groups)) (gnus-group-catchup (car groups) all)) (gnus-group-update-group-line) (setq ret (1+ ret))) (setq groups (cdr groups))) (gnus-group-next-unread-group 1) ret))) (defun gnus-group-catchup-current-all (&optional n) "Mark all articles in current newsgroup as read. Cross references (Xref: header) of articles are ignored." (interactive "P") (gnus-group-catchup-current n 'all)) (defun gnus-group-catchup (group &optional all) "Mark all articles in GROUP as read. If ALL is non-nil, all articles are marked as read. The return value is the number of articles that were marked as read, or nil if no action could be taken." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (num (car entry)) (marked (nth 3 (nth 2 entry)))) (if (not (numberp (car entry))) (gnus-message 1 "Can't catch up; non-active group") ;; Do the updating only if the newsgroup isn't killed. (if (not entry) () (gnus-update-read-articles group (and (not all) (append (cdr (assq 'tick marked)) (cdr (assq 'dormant marked)))) nil (and (not all) (cdr (assq 'tick marked)))) (and all (setq marked (nth 3 (nth 2 entry))) (setcar (nthcdr 3 (nth 2 entry)) (delq (assq 'dormant marked) (nth 3 (nth 2 entry))))))) num)) (defun gnus-group-expire-articles (&optional n) "Expire all expirable articles in the current newsgroup." (interactive "P") (let ((groups (gnus-group-process-prefix n)) group) (or groups (error "No groups to expire")) (while groups (setq group (car groups) groups (cdr groups)) (gnus-group-remove-mark group) (if (not (gnus-check-backend-function 'request-expire-articles group)) () (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (expirable (if (memq 'total-expire (nth 5 info)) (cons nil (gnus-list-of-read-articles group)) (assq 'expire (nth 3 info))))) (and expirable (setcdr expirable (gnus-request-expire-articles (cdr expirable) group)))))))) (defun gnus-group-expire-all-groups () "Expire all expirable articles in all newsgroups." (interactive) (save-excursion (gnus-message 5 "Expiring...") (let ((gnus-group-marked (mapcar (lambda (info) (car info)) (cdr gnus-newsrc-alist)))) (gnus-group-expire-articles nil))) (gnus-group-position-cursor) (gnus-message 5 "Expiring...done")) (defun gnus-group-set-current-level (n level) "Set the level of the next N groups to LEVEL." (interactive "P\nnLevel: ") (or (and (>= level 1) (<= level gnus-level-killed)) (error "Illegal level: %d" level)) (let ((groups (gnus-group-process-prefix n)) group) (while groups (setq group (car groups) groups (cdr groups)) (gnus-group-remove-mark group) (gnus-message 6 "Changed level of %s from %d to %d" group (gnus-group-group-level) level) (gnus-group-change-level group level (gnus-group-group-level)) (gnus-group-update-group-line))) (gnus-group-position-cursor)) (defun gnus-group-unsubscribe-current-group (&optional n) "Toggle subscription of the current group. If given numerical prefix, toggle the N next groups." (interactive "P") (let ((groups (gnus-group-process-prefix n)) group) (while groups (setq group (car groups) groups (cdr groups)) (gnus-group-remove-mark group) (gnus-group-unsubscribe-group group (if (<= (gnus-group-group-level) gnus-level-subscribed) gnus-level-default-unsubscribed gnus-level-default-subscribed)) (gnus-group-update-group-line)) (gnus-group-next-group 1))) (defun gnus-group-unsubscribe-group (group &optional level) "Toggle subscribe from/to unsubscribe GROUP. New newsgroup is added to .newsrc automatically." (interactive (list (completing-read "Group: " gnus-active-hashtb nil (memq gnus-select-method gnus-have-read-active-file)))) (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) (cond ((string-match "^[ \t]$" group) (error "Empty group name")) (newsrc ;; Toggle subscription flag. (gnus-group-change-level newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) gnus-level-subscribed) (1+ gnus-level-subscribed) gnus-level-default-subscribed))) (gnus-group-update-group group)) ((and (stringp group) (or (not (memq gnus-select-method gnus-have-read-active-file)) (gnus-gethash group gnus-active-hashtb))) ;; Add new newsgroup. (gnus-group-change-level group (if level level gnus-level-default-subscribed) (or (and (member group gnus-zombie-list) gnus-level-zombie) gnus-level-killed) (and (gnus-group-group-name) (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) (gnus-group-update-group group)) (t (error "No such newsgroup: %s" group))) (gnus-group-position-cursor))) (defun gnus-group-transpose-groups (n) "Move the current newsgroup up N places. If given a negative prefix, move down instead. The difference between N and the number of steps taken is returned." (interactive "p") (or (gnus-group-group-name) (error "No group on current line")) (gnus-group-kill-group 1) (prog1 (forward-line (- n)) (gnus-group-yank-group) (gnus-group-position-cursor))) (defun gnus-group-kill-all-zombies () "Kill all zombie newsgroups." (interactive) (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) (setq gnus-zombie-list nil) (gnus-group-list-groups)) (defun gnus-group-kill-region (begin end) "Kill newsgroups in current region (excluding current point). The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." (interactive "r") (let ((lines ;; Count lines. (save-excursion (count-lines (progn (goto-char begin) (beginning-of-line) (point)) (progn (goto-char end) (beginning-of-line) (point)))))) (goto-char begin) (beginning-of-line) ;Important when LINES < 1 (gnus-group-kill-group lines))) (defun gnus-group-kill-group (&optional n) "The the next N groups. The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. However, only groups that were alive can be yanked; already killed groups or zombie groups can't be yanked. The return value is the name of the (last) group that was killed." (interactive "P") (let ((buffer-read-only nil) (groups (gnus-group-process-prefix n)) group entry level) (while groups (setq group (car groups) groups (cdr groups)) (gnus-group-remove-mark group) (setq level (gnus-group-group-level)) (gnus-delete-line) (if (setq entry (gnus-gethash group gnus-newsrc-hashtb)) (setq gnus-list-of-killed-groups (cons (cons (car entry) (nth 2 entry)) gnus-list-of-killed-groups))) (gnus-group-change-level (if entry entry group) gnus-level-killed (if entry nil level))) (gnus-group-position-cursor) group)) (defun gnus-group-yank-group (&optional arg) "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it before the current newsgroup. The numeric ARG specifies how many newsgroups are to be yanked. The name of the (last) newsgroup yanked is returned." (interactive "p") (if (not arg) (setq arg 1)) (let (info group prev) (while (>= (setq arg (1- arg)) 0) (if (not (setq info (car gnus-list-of-killed-groups))) (error "No more newsgroups to yank")) (setq group (nth 2 info)) ;; Find which newsgroup to insert this one before - search ;; backward until something suitable is found. If there are no ;; other newsgroups in this buffer, just make this newsgroup the ;; first newsgroup. (setq prev (gnus-group-group-name)) (gnus-group-change-level info (nth 2 info) gnus-level-killed (and prev (gnus-gethash prev gnus-newsrc-hashtb)) t) (gnus-group-insert-group-line-info (nth 1 info)) (setq gnus-list-of-killed-groups (cdr gnus-list-of-killed-groups))) (forward-line -1) (gnus-group-position-cursor) group)) (defun gnus-group-list-all-groups (&optional arg) "List all newsgroups with level ARG or lower. Default is gnus-level-unsubscribed, which lists all subscribed and most unsubscribed groups." (interactive "P") (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) (defun gnus-group-list-killed () "List all killed newsgroups in the group buffer." (interactive) (if (not gnus-killed-list) (gnus-message 6 "No killed groups") (let (gnus-group-list-mode) (funcall gnus-group-prepare-function gnus-level-killed t gnus-level-killed)) (goto-char (point-min))) (gnus-group-position-cursor)) (defun gnus-group-list-zombies () "List all zombie newsgroups in the group buffer." (interactive) (if (not gnus-zombie-list) (gnus-message 6 "No zombie groups") (let (gnus-group-list-mode) (funcall gnus-group-prepare-function gnus-level-zombie t gnus-level-zombie)) (goto-char (point-min))) (gnus-group-position-cursor)) (defun gnus-group-get-new-news (&optional arg) "Get newly arrived articles. If ARG is non-nil, it should be a number between one and nine to specify which levels you are interested in re-scanning." (interactive "P") (run-hooks 'gnus-get-new-news-hook) (setq arg (gnus-group-default-level arg t)) (if (and gnus-read-active-file (not arg)) (progn (gnus-read-active-file) (gnus-get-unread-articles (or arg (1+ gnus-level-subscribed)))) (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) (gnus-get-unread-articles (or arg (1+ gnus-level-subscribed))))) (gnus-group-list-groups)) (defun gnus-group-get-new-news-this-group (&optional n) "Check for newly arrived news in the current group (and the N-1 next groups). The difference between N and the number of newsgroup checked is returned. If N is negative, this group and the N-1 previous groups will be checked." (interactive "P") (let* ((groups (gnus-group-process-prefix n)) (ret (if (numberp n) (- n (length groups)) 0)) group) (while groups (setq group (car groups) groups (cdr groups)) (gnus-group-remove-mark group) (or (gnus-get-new-news-in-group group) (progn (ding) (message "%s error: %s" group (gnus-status-message group)) (sit-for 2)))) (gnus-group-next-unread-group 1 t) (gnus-summary-position-cursor) ret)) (defun gnus-get-new-news-in-group (group) (and group (gnus-activate-group group) (progn (gnus-get-unread-articles-in-group (nth 2 (gnus-gethash group gnus-newsrc-hashtb)) (gnus-gethash group gnus-active-hashtb)) (gnus-group-update-group-line) t))) (defun gnus-group-fetch-faq (group) "Fetch the FAQ for the current group." (interactive (list (gnus-group-real-name (gnus-group-group-name)))) (or group (error "No group name given")) (let ((file (concat gnus-group-faq-directory (gnus-group-real-name group)))) (if (not (file-exists-p file)) (error "No such file: %s" file) (find-file file)))) (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." (interactive (list current-prefix-arg (gnus-group-group-name))) (and force (setq gnus-description-hashtb nil)) (let ((method (gnus-find-method-for-group group)) desc) (or group (error "No group name given")) (and (or (and gnus-description-hashtb ;; We check whether this group's method has been ;; queried for a description file. (gnus-gethash (gnus-group-prefixed-name "" method) gnus-description-hashtb)) (setq desc (gnus-group-get-description group)) (gnus-read-descriptions-file method)) (message (or desc (gnus-gethash group gnus-description-hashtb) "No description available"))))) ;; Suggested by Per Abrahamsen . (defun gnus-group-describe-all-groups (&optional force) "Pop up a buffer with descriptions of all newsgroups." (interactive "P") (and force (setq gnus-description-hashtb nil)) (if (not (or gnus-description-hashtb (gnus-read-all-descriptions-files))) (error "Couldn't request descriptions file")) (let ((buffer-read-only nil) b) (erase-buffer) (mapatoms (lambda (group) (setq b (point)) (insert (format " *: %-20s %s\n" (symbol-name group) (symbol-value group))) (add-text-properties b (1+ b) (list 'gnus-group group 'gnus-unread t 'gnus-marked nil 'gnus-level (1+ gnus-level-subscribed)))) gnus-description-hashtb) (goto-char (point-min)) (gnus-group-position-cursor))) ;; Suggested by by Daniel Quinlan . (defun gnus-group-apropos (regexp &optional search-description) "List all newsgroups that have names that match a regexp." (interactive "sGnus apropos (regexp): ") (let ((prev "") (obuf (current-buffer)) groups des) ;; Go through all newsgroups that are known to Gnus. (mapatoms (lambda (group) (and (symbol-name group) (string-match regexp (symbol-name group)) (setq groups (cons (symbol-name group) groups)))) gnus-active-hashtb) ;; Go through all descriptions that are known to Gnus. (if search-description (mapatoms (lambda (group) (and (string-match regexp (symbol-value group)) (gnus-gethash (symbol-name group) gnus-active-hashtb) (setq groups (cons (symbol-name group) groups)))) gnus-description-hashtb)) (if (not groups) (gnus-message 3 "No groups matched \"%s\"." regexp) ;; Print out all the groups. (save-excursion (pop-to-buffer "*Gnus Help*") (buffer-disable-undo (current-buffer)) (erase-buffer) (setq groups (sort groups 'string<)) (while groups ;; Groups may be entered twice into the list of groups. (if (not (string= (car groups) prev)) (progn (insert (setq prev (car groups)) "\n") (if (and gnus-description-hashtb (setq des (gnus-gethash (car groups) gnus-description-hashtb))) (insert " " des "\n")))) (setq groups (cdr groups))) (goto-char (point-min)))) (pop-to-buffer obuf))) (defun gnus-group-description-apropos (regexp) "List all newsgroups that have names or descriptions that match a regexp." (interactive "sGnus description apropos (regexp): ") (if (not (or gnus-description-hashtb (gnus-read-all-descriptions-files))) (error "Couldn't request descriptions file")) (gnus-group-apropos regexp t)) ;; Suggested by Per Abrahamsen . (defun gnus-group-list-matching (level regexp &optional all lowest) "List all groups with unread articles that match REGEXP. If the prefix LEVEL is non-nil, it should be a number that says which level to cut off listing groups. If ALL, also list groups with no unread articles. If LOWEST, don't list groups with level lower than LOWEST." (interactive "P\nsList newsgroups matching: ") (gnus-group-prepare-flat (or level gnus-level-subscribed) all (or lowest 1) regexp) (goto-char (point-min)) (gnus-group-position-cursor)) (defun gnus-group-list-all-matching (level regexp &optional lowest) "List all groups that match REGEXP. If the prefix LEVEL is non-nil, it should be a number that says which level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST." (interactive "P\nsList newsgroups matching: ") (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest)) ;; Suggested by Jack Vinson . (defun gnus-group-save-newsrc () "Save the Gnus startup files." (interactive) (gnus-save-newsrc-file)) (defun gnus-group-restart (&optional arg) "Force Gnus to read the .newsrc file." (interactive "P") (gnus-save-newsrc-file) (gnus-setup-news 'force) (gnus-group-list-groups arg)) (defun gnus-group-read-init-file () "Read the Gnus elisp init file." (interactive) (gnus-read-init-file)) (defun gnus-group-check-bogus-groups (&optional silent) "Check bogus newsgroups. If given a prefix, don't ask for confirmation before removing a bogus group." (interactive "P") (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) (gnus-group-list-groups)) (defun gnus-group-edit-global-kill (&optional article group) "Edit the global kill file. If GROUP, edit that local kill file instead." (interactive "P") (setq gnus-current-kill-article article) (gnus-kill-file-edit-file group) (gnus-message 6 (substitute-command-keys "Editing a global kill file (Type \\[gnus-kill-file-exit] to exit)"))) (defun gnus-group-edit-local-kill (article group) "Edit a local kill file." (interactive (list nil (gnus-group-group-name))) (gnus-group-edit-global-kill article group)) (defun gnus-group-force-update () "Update `.newsrc' file." (interactive) (gnus-save-newsrc-file)) (defun gnus-group-suspend () "Suspend the current Gnus session. In fact, cleanup buffers except for group mode buffer. The hook gnus-suspend-gnus-hook is called before actually suspending." (interactive) (run-hooks 'gnus-suspend-gnus-hook) ;; Kill Gnus buffers except for group mode buffer. (let ((group-buf (get-buffer gnus-group-buffer))) ;; Do this on a separate list in case the user does a ^G before we finish (let ((gnus-buffer-list (delq group-buf (delq gnus-dribble-buffer (append gnus-buffer-list nil))))) (while gnus-buffer-list (gnus-kill-buffer (car gnus-buffer-list)) (setq gnus-buffer-list (cdr gnus-buffer-list)))) (if group-buf (progn (setq gnus-buffer-list (list group-buf)) (bury-buffer group-buf) (delete-windows-on group-buf t))))) (defun gnus-group-clear-dribble () "Clear all information from the dribble buffer." (interactive) (gnus-dribble-clear)) (defun gnus-group-exit () "Quit reading news after updating .newsrc.eld and .newsrc. The hook `gnus-exit-gnus-hook' is called before actually exiting." (interactive) (if (or noninteractive ;For gnus-batch-kill (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed (not gnus-interactive-exit) ;Without confirmation gnus-expert-user (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) (progn (run-hooks 'gnus-exit-gnus-hook) ;; Offer to save data from non-quitted summary buffers. (gnus-offer-save-summaries) ;; Save the newsrc file(s). (gnus-save-newsrc-file) ;; Kill-em-all. (gnus-close-backends) ;; Reset everything. (gnus-clear-system)))) (defun gnus-close-backends () ;; Send a close request to all backends that support such a request. (let ((methods gnus-valid-select-methods) func) (while methods (if (fboundp (setq func (intern (concat (car (car methods)) "-request-close")))) (funcall func)) (setq methods (cdr methods))))) (defun gnus-group-quit () "Quit reading news without updating .newsrc.eld or .newsrc. The hook `gnus-exit-gnus-hook' is called before actually exiting." (interactive) (if (or noninteractive ;For gnus-batch-kill (zerop (buffer-size)) (not (gnus-server-opened gnus-select-method)) gnus-expert-user (not gnus-current-startup-file) (gnus-yes-or-no-p (format "Quit reading news without saving %s? " (file-name-nondirectory gnus-current-startup-file)))) (progn (run-hooks 'gnus-exit-gnus-hook) (if gnus-use-full-window (delete-other-windows) (gnus-remove-some-windows)) (gnus-dribble-save) (gnus-close-backends) (gnus-clear-system)))) (defun gnus-offer-save-summaries () (save-excursion (let ((buflist (buffer-list)) buffers bufname) (while buflist (and (setq bufname (buffer-name (car buflist))) (string-match "Summary" bufname) (save-excursion (set-buffer bufname) ;; We check that this is, indeed, a summary buffer. (eq major-mode 'gnus-summary-mode)) (setq buffers (cons bufname buffers))) (setq buflist (cdr buflist))) (and buffers (map-y-or-n-p "Update summary buffer %s? " (lambda (buf) (set-buffer buf) (gnus-summary-exit)) buffers))))) (defun gnus-group-describe-briefly () "Give a one line description of the group mode commands." (interactive) (gnus-message 7 (substitute-command-keys "\\\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"))) (defun gnus-group-browse-foreign-server (method) "Browse a foreign news server. If called interactively, this function will ask for a select method (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). If not, METHOD should be a list where the first element is the method and the second element is the address." (interactive (list (let ((how (completing-read "Which backend: " (append gnus-valid-select-methods gnus-server-alist) nil t "nntp"))) ;; We either got a backend name or a virtual server name. ;; If the first, we also need an address. (if (assoc how gnus-valid-select-methods) (list (intern how) ;; Suggested by mapjph@bath.ac.uk. (completing-read "Address: " (mapcar (lambda (server) (list server)) gnus-secondary-servers))) ;; We got a server name, so we find the method. (gnus-server-to-method how))))) (gnus-browse-foreign-server method)) ;;; ;;; Browse Server Mode ;;; (defvar gnus-browse-mode-hook nil) (defvar gnus-browse-mode-map nil) (put 'gnus-browse-mode 'mode-class 'special) (if gnus-browse-mode-map nil (setq gnus-browse-mode-map (make-keymap)) (suppress-keymap gnus-browse-mode-map) (define-key gnus-browse-mode-map " " 'gnus-browse-read-group) (define-key gnus-browse-mode-map "=" 'gnus-browse-select-group) (define-key gnus-browse-mode-map "n" 'gnus-browse-next-group) (define-key gnus-browse-mode-map "p" 'gnus-browse-prev-group) (define-key gnus-browse-mode-map "\177" 'gnus-browse-prev-group) (define-key gnus-browse-mode-map "N" 'gnus-browse-next-group) (define-key gnus-browse-mode-map "P" 'gnus-browse-prev-group) (define-key gnus-browse-mode-map "\M-n" 'gnus-browse-next-group) (define-key gnus-browse-mode-map "\M-p" 'gnus-browse-prev-group) (define-key gnus-browse-mode-map "\r" 'gnus-browse-select-group) (define-key gnus-browse-mode-map "u" 'gnus-browse-unsubscribe-current-group) (define-key gnus-browse-mode-map "l" 'gnus-browse-exit) (define-key gnus-browse-mode-map "L" 'gnus-browse-exit) (define-key gnus-browse-mode-map "q" 'gnus-browse-exit) (define-key gnus-browse-mode-map "Q" 'gnus-browse-exit) (define-key gnus-browse-mode-map "\C-c\C-c" 'gnus-browse-exit) (define-key gnus-browse-mode-map "?" 'gnus-browse-describe-briefly) (define-key gnus-browse-mode-map "\C-c\C-i" 'gnus-info-find-node) ) (defvar gnus-browse-current-method nil) (defvar gnus-browse-return-buffer nil) (defvar gnus-browse-buffer "*Gnus Browse Server*") (defun gnus-browse-foreign-server (method &optional return-buffer) (setq gnus-browse-current-method method) (setq gnus-browse-return-buffer return-buffer) (let ((gnus-select-method method) groups group) (gnus-message 5 "Connecting to %s..." (nth 1 method)) (or (gnus-check-server method) (error "Unable to contact server: %s" (gnus-status-message method))) (or (gnus-request-list method) (error "Couldn't request list: %s" (gnus-status-message method))) (get-buffer-create gnus-browse-buffer) (gnus-add-current-to-buffer-list) (and gnus-carpal (gnus-carpal-setup-buffer 'browse)) (gnus-configure-windows 'browse) (buffer-disable-undo (current-buffer)) (let ((buffer-read-only nil)) (erase-buffer)) (gnus-browse-mode) (setq mode-line-buffer-identification (format "Gnus Browse Server {%s:%s}" (car method) (car (cdr method)))) (save-excursion (set-buffer nntp-server-buffer) (let ((cur (current-buffer))) (goto-char (point-min)) (or (string= gnus-ignored-newsgroups "") (delete-matching-lines gnus-ignored-newsgroups)) (while (re-search-forward "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t) (goto-char (match-end 1)) (setq groups (cons (cons (buffer-substring (match-beginning 1) (match-end 1)) (max 0 (- (1+ (read cur)) (read cur)))) groups))))) (setq groups (sort groups (lambda (l1 l2) (string< (car l1) (car l2))))) (let ((buffer-read-only nil)) (while groups (setq group (car groups)) (insert (format "K%7d: %s\n" (cdr group) (car group))) (setq groups (cdr groups)))) (switch-to-buffer (current-buffer)) (goto-char (point-min)) (gnus-group-position-cursor))) (defun gnus-browse-mode () "Major mode for browsing a foreign server. All normal editing commands are switched off. \\ The only things you can do in this buffer is 1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group. The group will be inserted into the group buffer upon exit from this buffer. 2) `\\[gnus-browse-read-group]' to read a group ephemerally. 3) `\\[gnus-browse-exit]' to return to the group buffer." (interactive) (kill-all-local-variables) (if gnus-visual (gnus-browse-make-menu-bar)) (setq mode-line-modified "-- ") (make-local-variable 'mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) (and (equal (nth 3 mode-line-format) " ") (setcar (nthcdr 3 mode-line-format) "")) (setq major-mode 'gnus-browse-mode) (setq mode-name "Browse Server") (setq mode-line-process nil) (use-local-map gnus-browse-mode-map) (buffer-disable-undo (current-buffer)) (setq truncate-lines t) (setq buffer-read-only t) (run-hooks 'gnus-browse-mode-hook)) (defun gnus-browse-read-group (&optional no-article) "Enter the group at the current line." (interactive) (let ((group (gnus-browse-group-name))) (or (gnus-group-read-ephemeral-group group gnus-browse-current-method nil (cons (current-buffer) 'browse)) (error "Couldn't enter %s" group)))) (defun gnus-browse-select-group () "Select the current group." (interactive) (gnus-browse-read-group 'no)) (defun gnus-browse-next-group (n) "Go to the next group." (interactive "p") (prog1 (forward-line n) (gnus-group-position-cursor))) (defun gnus-browse-prev-group (n) "Go to the next group." (interactive "p") (gnus-browse-next-group (- n))) (defun gnus-browse-unsubscribe-current-group (arg) "(Un)subscribe to the next ARG groups." (interactive "p") (and (eobp) (error "No group at current line.")) (let ((ward (if (< arg 0) -1 1)) (arg (abs arg))) (while (and (> arg 0) (not (eobp)) (gnus-browse-unsubscribe-group) (zerop (gnus-browse-next-group ward))) (setq arg (1- arg))) (gnus-group-position-cursor) (if (/= 0 arg) (gnus-message 7 "No more newsgroups")) arg)) (defun gnus-browse-group-name () (save-excursion (beginning-of-line) (if (not (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)) () (gnus-group-prefixed-name (buffer-substring (match-beginning 1) (match-end 1)) gnus-browse-current-method)))) (defun gnus-browse-unsubscribe-group () "Toggle subscription of the current group in the browse buffer." (let ((sub nil) (buffer-read-only nil) group) (save-excursion (beginning-of-line) ;; If this group it killed, then we want to subscribe it. (if (= (following-char) ?K) (setq sub t)) (setq group (gnus-browse-group-name)) (delete-char 1) (if sub (progn (gnus-group-change-level (list t group gnus-level-default-subscribed nil nil gnus-browse-current-method) gnus-level-default-subscribed gnus-level-killed (and (car (nth 1 gnus-newsrc-alist)) (gnus-gethash (car (nth 1 gnus-newsrc-alist)) gnus-newsrc-hashtb)) t) (insert ? )) (gnus-group-change-level group gnus-level-killed gnus-level-default-subscribed) (insert ?K))) t)) (defun gnus-browse-exit () "Quit browsing and return to the group buffer." (interactive) (if (eq major-mode 'gnus-browse-mode) (kill-buffer (current-buffer))) (if gnus-browse-return-buffer (gnus-configure-windows 'server 'force) (gnus-configure-windows 'group 'force) (gnus-group-list-groups nil))) (defun gnus-browse-describe-briefly () "Give a one line description of the group mode commands." (interactive) (gnus-message 6 (substitute-command-keys "\\\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) ;;; ;;; Gnus summary mode ;;; (defvar gnus-summary-mode-map nil) (defvar gnus-summary-mark-map nil) (defvar gnus-summary-mscore-map nil) (defvar gnus-summary-article-map nil) (defvar gnus-summary-thread-map nil) (defvar gnus-summary-goto-map nil) (defvar gnus-summary-exit-map nil) (defvar gnus-summary-interest-map nil) (defvar gnus-summary-sort-map nil) (defvar gnus-summary-backend-map nil) (defvar gnus-summary-save-map nil) (defvar gnus-summary-wash-map nil) (defvar gnus-summary-wash-hide-map nil) (defvar gnus-summary-wash-highlight-map nil) (defvar gnus-summary-wash-time-map nil) (defvar gnus-summary-help-map nil) (put 'gnus-summary-mode 'mode-class 'special) (if gnus-summary-mode-map nil (setq gnus-summary-mode-map (make-keymap)) (suppress-keymap gnus-summary-mode-map) ;; Non-orthogonal keys (define-key gnus-summary-mode-map " " 'gnus-summary-next-page) (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page) (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up) (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article) (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article) (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article) (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article) (define-key gnus-summary-mode-map "\M-\C-n" 'gnus-summary-next-same-subject) (define-key gnus-summary-mode-map "\M-\C-p" 'gnus-summary-prev-same-subject) (define-key gnus-summary-mode-map "\M-n" 'gnus-summary-next-unread-subject) (define-key gnus-summary-mode-map "\M-p" 'gnus-summary-prev-unread-subject) (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article) (define-key gnus-summary-mode-map "," 'gnus-summary-best-unread-article) (define-key gnus-summary-mode-map "\M-s" 'gnus-summary-search-article-forward) (define-key gnus-summary-mode-map "\M-r" 'gnus-summary-search-article-backward) (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article) (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article) (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-subject) (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article) (define-key gnus-summary-mode-map "\M-^" 'gnus-summary-refer-article) (define-key gnus-summary-mode-map "u" 'gnus-summary-tick-article-forward) (define-key gnus-summary-mode-map "!" 'gnus-summary-tick-article-forward) (define-key gnus-summary-mode-map "U" 'gnus-summary-tick-article-backward) (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward) (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward) (define-key gnus-summary-mode-map "E" 'gnus-summary-mark-as-expirable) (define-key gnus-summary-mode-map "\M-u" 'gnus-summary-clear-mark-forward) (define-key gnus-summary-mode-map "\M-U" 'gnus-summary-clear-mark-backward) (define-key gnus-summary-mode-map "k" 'gnus-summary-kill-same-subject-and-select) (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject) (define-key gnus-summary-mode-map "\M-\C-k" 'gnus-summary-kill-thread) (define-key gnus-summary-mode-map "\M-\C-l" 'gnus-summary-lower-thread) (define-key gnus-summary-mode-map "e" 'gnus-summary-edit-article) (define-key gnus-summary-mode-map "#" 'gnus-summary-mark-as-processable) (define-key gnus-summary-mode-map "\M-#" 'gnus-summary-unmark-as-processable) (define-key gnus-summary-mode-map "\M-\C-t" 'gnus-summary-toggle-threads) (define-key gnus-summary-mode-map "\M-\C-s" 'gnus-summary-show-thread) (define-key gnus-summary-mode-map "\M-\C-h" 'gnus-summary-hide-thread) (define-key gnus-summary-mode-map "\M-\C-f" 'gnus-summary-next-thread) (define-key gnus-summary-mode-map "\M-\C-b" 'gnus-summary-prev-thread) (define-key gnus-summary-mode-map "\M-\C-u" 'gnus-summary-up-thread) (define-key gnus-summary-mode-map "\M-\C-d" 'gnus-summary-down-thread) (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command) (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit) (define-key gnus-summary-mode-map "\C-w" 'gnus-summary-mark-region-as-read) (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation) (define-key gnus-summary-mode-map "?" 'gnus-summary-mark-as-dormant) (define-key gnus-summary-mode-map "\C-c\M-\C-s" 'gnus-summary-show-all-expunged) (define-key gnus-summary-mode-map "\C-c\C-s\C-n" 'gnus-summary-sort-by-number) (define-key gnus-summary-mode-map "\C-c\C-s\C-a" 'gnus-summary-sort-by-author) (define-key gnus-summary-mode-map "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject) (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date) (define-key gnus-summary-mode-map "\C-c\C-s\C-i" 'gnus-summary-sort-by-score) (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window) (define-key gnus-summary-mode-map "\C-x\C-s" 'gnus-summary-reselect-current-group) (define-key gnus-summary-mode-map "\M-g" 'gnus-summary-rescan-group) (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking) (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message) (define-key gnus-summary-mode-map "\M-t" 'gnus-summary-toggle-mime) (define-key gnus-summary-mode-map "f" 'gnus-summary-followup) (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original) (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article) (define-key gnus-summary-mode-map "r" 'gnus-summary-reply) (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original) (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward) (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article) (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-article-mail) (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output) (define-key gnus-summary-mode-map "\M-k" 'gnus-summary-edit-local-kill) (define-key gnus-summary-mode-map "\M-K" 'gnus-summary-edit-global-kill) (define-key gnus-summary-mode-map "V" 'gnus-version) (define-key gnus-summary-mode-map "\C-c\C-d" 'gnus-summary-describe-group) (define-key gnus-summary-mode-map "q" 'gnus-summary-exit) (define-key gnus-summary-mode-map "Q" 'gnus-summary-exit-no-update) (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node) (define-key gnus-summary-mode-map gnus-mouse-2 'gnus-mouse-pick-article) (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window) (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news) (define-key gnus-summary-mode-map "x" 'gnus-summary-remove-lines-marked-as-read) ; (define-key gnus-summary-mode-map "X" 'gnus-summary-remove-lines-marked-with) (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article) (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header) (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article) ; (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly) (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article) (define-key gnus-summary-mode-map "\C-c\C-v\C-v" 'gnus-uu-decode-uu-view) (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-enter-digest-group) (define-key gnus-summary-mode-map "v" 'gnus-summary-verbose-headers) (define-key gnus-summary-mode-map "\C-c\C-b" 'gnus-bug) ;; Sort of orthogonal keymap (define-prefix-command 'gnus-summary-mark-map) (define-key gnus-summary-mode-map "M" 'gnus-summary-mark-map) (define-key gnus-summary-mark-map "t" 'gnus-summary-tick-article-forward) (define-key gnus-summary-mark-map "!" 'gnus-summary-tick-article-forward) (define-key gnus-summary-mark-map "d" 'gnus-summary-mark-as-read-forward) (define-key gnus-summary-mark-map "r" 'gnus-summary-mark-as-read-forward) (define-key gnus-summary-mark-map "c" 'gnus-summary-clear-mark-forward) (define-key gnus-summary-mark-map " " 'gnus-summary-clear-mark-forward) (define-key gnus-summary-mark-map "e" 'gnus-summary-mark-as-expirable) (define-key gnus-summary-mark-map "x" 'gnus-summary-mark-as-expirable) (define-key gnus-summary-mark-map "?" 'gnus-summary-mark-as-dormant) (define-key gnus-summary-mark-map "b" 'gnus-summary-set-bookmark) (define-key gnus-summary-mark-map "B" 'gnus-summary-remove-bookmark) (define-key gnus-summary-mark-map "#" 'gnus-summary-mark-as-processable) (define-key gnus-summary-mark-map "\M-#" 'gnus-summary-unmark-as-processable) (define-key gnus-summary-mark-map "\M-r" 'gnus-summary-remove-lines-marked-as-read) (define-key gnus-summary-mark-map "\M-\C-r" 'gnus-summary-remove-lines-marked-with) (define-key gnus-summary-mark-map "D" 'gnus-summary-show-all-dormant) (define-key gnus-summary-mark-map "\M-D" 'gnus-summary-hide-all-dormant) (define-key gnus-summary-mark-map "S" 'gnus-summary-show-all-expunged) (define-key gnus-summary-mark-map "C" 'gnus-summary-catchup) (define-key gnus-summary-mark-map "H" 'gnus-summary-catchup-to-here) (define-key gnus-summary-mark-map "\C-c" 'gnus-summary-catchup-all) (define-key gnus-summary-mark-map "k" 'gnus-summary-kill-same-subject-and-select) (define-key gnus-summary-mark-map "K" 'gnus-summary-kill-same-subject) (define-prefix-command 'gnus-summary-mscore-map) (define-key gnus-summary-mark-map "V" 'gnus-summary-mscore-map) (define-key gnus-summary-mscore-map "c" 'gnus-summary-clear-above) (define-key gnus-summary-mscore-map "u" 'gnus-summary-tick-above) (define-key gnus-summary-mscore-map "m" 'gnus-summary-mark-above) (define-key gnus-summary-mscore-map "k" 'gnus-summary-kill-below) (define-key gnus-summary-mark-map "P" 'gnus-uu-mark-map) (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map) (define-prefix-command 'gnus-summary-goto-map) (define-key gnus-summary-mode-map "G" 'gnus-summary-goto-map) (define-key gnus-summary-goto-map "n" 'gnus-summary-next-unread-article) (define-key gnus-summary-goto-map "p" 'gnus-summary-prev-unread-article) (define-key gnus-summary-goto-map "N" 'gnus-summary-next-article) (define-key gnus-summary-goto-map "P" 'gnus-summary-prev-article) (define-key gnus-summary-goto-map "\C-n" 'gnus-summary-next-same-subject) (define-key gnus-summary-goto-map "\C-p" 'gnus-summary-prev-same-subject) (define-key gnus-summary-goto-map "\M-n" 'gnus-summary-next-unread-subject) (define-key gnus-summary-goto-map "\M-p" 'gnus-summary-prev-unread-subject) (define-key gnus-summary-goto-map "f" 'gnus-summary-first-unread-article) (define-key gnus-summary-goto-map "b" 'gnus-summary-best-unread-article) (define-key gnus-summary-goto-map "g" 'gnus-summary-goto-subject) (define-key gnus-summary-goto-map "l" 'gnus-summary-goto-last-article) (define-key gnus-summary-goto-map "p" 'gnus-summary-pop-article) (define-prefix-command 'gnus-summary-thread-map) (define-key gnus-summary-mode-map "T" 'gnus-summary-thread-map) (define-key gnus-summary-thread-map "k" 'gnus-summary-kill-thread) (define-key gnus-summary-thread-map "l" 'gnus-summary-lower-thread) (define-key gnus-summary-thread-map "i" 'gnus-summary-raise-thread) (define-key gnus-summary-thread-map "T" 'gnus-summary-toggle-threads) (define-key gnus-summary-thread-map "s" 'gnus-summary-show-thread) (define-key gnus-summary-thread-map "S" 'gnus-summary-show-all-threads) (define-key gnus-summary-thread-map "h" 'gnus-summary-hide-thread) (define-key gnus-summary-thread-map "H" 'gnus-summary-hide-all-threads) (define-key gnus-summary-thread-map "n" 'gnus-summary-next-thread) (define-key gnus-summary-thread-map "p" 'gnus-summary-prev-thread) (define-key gnus-summary-thread-map "u" 'gnus-summary-up-thread) (define-key gnus-summary-thread-map "d" 'gnus-summary-down-thread) (define-key gnus-summary-thread-map "#" 'gnus-uu-mark-thread) (define-prefix-command 'gnus-summary-exit-map) (define-key gnus-summary-mode-map "Z" 'gnus-summary-exit-map) (define-key gnus-summary-exit-map "c" 'gnus-summary-catchup-and-exit) (define-key gnus-summary-exit-map "C" 'gnus-summary-catchup-all-and-exit) (define-key gnus-summary-exit-map "E" 'gnus-summary-exit-no-update) (define-key gnus-summary-exit-map "Q" 'gnus-summary-exit) (define-key gnus-summary-exit-map "Z" 'gnus-summary-exit) (define-key gnus-summary-exit-map "n" 'gnus-summary-catchup-and-goto-next-group) (define-key gnus-summary-exit-map "R" 'gnus-summary-reselect-current-group) (define-key gnus-summary-exit-map "G" 'gnus-summary-rescan-group) (define-key gnus-summary-exit-map "N" 'gnus-summary-next-group) (define-key gnus-summary-exit-map "P" 'gnus-summary-prev-group) (define-prefix-command 'gnus-summary-article-map) (define-key gnus-summary-mode-map "A" 'gnus-summary-article-map) (define-key gnus-summary-article-map " " 'gnus-summary-next-page) (define-key gnus-summary-article-map "n" 'gnus-summary-next-page) (define-key gnus-summary-article-map "\177" 'gnus-summary-prev-page) (define-key gnus-summary-article-map "p" 'gnus-summary-prev-page) (define-key gnus-summary-article-map "\r" 'gnus-summary-scroll-up) (define-key gnus-summary-article-map "<" 'gnus-summary-beginning-of-article) (define-key gnus-summary-article-map ">" 'gnus-summary-end-of-article) (define-key gnus-summary-article-map "b" 'gnus-summary-beginning-of-article) (define-key gnus-summary-article-map "e" 'gnus-summary-end-of-article) (define-key gnus-summary-article-map "^" 'gnus-summary-refer-parent-article) (define-key gnus-summary-article-map "r" 'gnus-summary-refer-parent-article) (define-key gnus-summary-article-map "g" 'gnus-summary-show-article) (define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article) (define-prefix-command 'gnus-summary-wash-map) (define-key gnus-summary-mode-map "W" 'gnus-summary-wash-map) (define-prefix-command 'gnus-summary-wash-hide-map) (define-key gnus-summary-wash-map "W" 'gnus-summary-wash-hide-map) (define-key gnus-summary-wash-hide-map "a" 'gnus-article-hide) (define-key gnus-summary-wash-hide-map "h" 'gnus-article-hide-headers) (define-key gnus-summary-wash-hide-map "s" 'gnus-article-hide-signature) (define-key gnus-summary-wash-hide-map "c" 'gnus-article-hide-citation) (define-key gnus-summary-wash-hide-map "\C-c" 'gnus-article-hide-citation-maybe) (define-prefix-command 'gnus-summary-wash-highlight-map) (define-key gnus-summary-wash-map "H" 'gnus-summary-wash-highlight-map) (define-key gnus-summary-wash-highlight-map "a" 'gnus-article-highlight) (define-key gnus-summary-wash-highlight-map "h" 'gnus-article-highlight-headers) (define-key gnus-summary-wash-highlight-map "c" 'gnus-article-highlight-citation) (define-key gnus-summary-wash-highlight-map "s" 'gnus-article-highlight-signature) (define-prefix-command 'gnus-summary-wash-time-map) (define-key gnus-summary-wash-map "T" 'gnus-summary-wash-time-map) (define-key gnus-summary-wash-time-map "z" 'gnus-article-date-ut) (define-key gnus-summary-wash-time-map "u" 'gnus-article-date-ut) (define-key gnus-summary-wash-time-map "l" 'gnus-article-date-local) (define-key gnus-summary-wash-time-map "e" 'gnus-article-date-lapsed) (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons) (define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike) (define-key gnus-summary-wash-map "w" 'gnus-article-word-wrap) (define-key gnus-summary-wash-map "c" 'gnus-article-remove-cr) (define-key gnus-summary-wash-map "q" 'gnus-article-de-quoted-unreadable) (define-key gnus-summary-wash-map "f" 'gnus-article-display-x-face) (define-key gnus-summary-wash-map "l" 'gnus-summary-stop-page-breaking) (define-key gnus-summary-wash-map "r" 'gnus-summary-caesar-message) (define-key gnus-summary-wash-map "t" 'gnus-summary-toggle-header) (define-key gnus-summary-wash-map "m" 'gnus-summary-toggle-mime) (define-prefix-command 'gnus-summary-help-map) (define-key gnus-summary-mode-map "H" 'gnus-summary-help-map) (define-key gnus-summary-help-map "v" 'gnus-version) (define-key gnus-summary-help-map "f" 'gnus-summary-fetch-faq) (define-key gnus-summary-help-map "d" 'gnus-summary-describe-group) (define-key gnus-summary-help-map "h" 'gnus-summary-describe-briefly) (define-key gnus-summary-help-map "i" 'gnus-info-find-node) (define-prefix-command 'gnus-summary-backend-map) (define-key gnus-summary-mode-map "B" 'gnus-summary-backend-map) (define-key gnus-summary-backend-map "e" 'gnus-summary-expire-articles) (define-key gnus-summary-backend-map "\M-\C-e" 'gnus-summary-expire-articles-now) (define-key gnus-summary-backend-map "\177" 'gnus-summary-delete-article) (define-key gnus-summary-backend-map "m" 'gnus-summary-move-article) (define-key gnus-summary-backend-map "r" 'gnus-summary-respool-article) (define-key gnus-summary-backend-map "w" 'gnus-summary-edit-article) (define-key gnus-summary-backend-map "c" 'gnus-summary-copy-article) (define-key gnus-summary-backend-map "q" 'gnus-summary-fancy-query) (define-key gnus-summary-backend-map "i" 'gnus-summary-import-article) (define-prefix-command 'gnus-summary-save-map) (define-key gnus-summary-mode-map "O" 'gnus-summary-save-map) (define-key gnus-summary-save-map "o" 'gnus-summary-save-article) (define-key gnus-summary-save-map "m" 'gnus-summary-save-article-mail) (define-key gnus-summary-save-map "r" 'gnus-summary-save-article-rmail) (define-key gnus-summary-save-map "f" 'gnus-summary-save-article-file) (define-key gnus-summary-save-map "h" 'gnus-summary-save-article-folder) (define-key gnus-summary-save-map "v" 'gnus-summary-save-article-vm) (define-key gnus-summary-save-map "p" 'gnus-summary-pipe-output) ; (define-key gnus-summary-save-map "s" 'gnus-soup-add-article) (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map) (define-key gnus-summary-mode-map "\M-&" 'gnus-summary-universal-argument) ; (define-key gnus-summary-various-map "\C-s" 'gnus-summary-search-article-forward) ; (define-key gnus-summary-various-map "\C-r" 'gnus-summary-search-article-backward) ; (define-key gnus-summary-various-map "r" 'gnus-summary-refer-article) ; (define-key gnus-summary-various-map "&" 'gnus-summary-execute-command) ; (define-key gnus-summary-various-map "T" 'gnus-summary-toggle-truncation) ; (define-key gnus-summary-various-map "e" 'gnus-summary-expand-window) (define-key gnus-summary-article-map "D" 'gnus-summary-enter-digest-group) ; (define-key gnus-summary-various-map "k" 'gnus-summary-edit-local-kill) ; (define-key gnus-summary-various-map "K" 'gnus-summary-edit-global-kill) (define-key gnus-summary-mode-map "V" 'gnus-summary-score-map) ; (define-prefix-command 'gnus-summary-sort-map) ; (define-key gnus-summary-various-map "s" 'gnus-summary-sort-map) ; (define-key gnus-summary-sort-map "n" 'gnus-summary-sort-by-number) ; (define-key gnus-summary-sort-map "a" 'gnus-summary-sort-by-author) ; (define-key gnus-summary-sort-map "s" 'gnus-summary-sort-by-subject) ; (define-key gnus-summary-sort-map "d" 'gnus-summary-sort-by-date) ; (define-key gnus-summary-sort-map "i" 'gnus-summary-sort-by-score) (define-key gnus-summary-mode-map "I" 'gnus-summary-increase-score) (define-key gnus-summary-mode-map "L" 'gnus-summary-lower-score) ) (defun gnus-summary-mode (&optional group) "Major mode for reading articles. All normal editing commands are switched off. \\ Each line in this buffer represents one article. To read an article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', respectively. You can also post articles and send mail from this buffer. To follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author of an article, type `\\[gnus-summary-reply]'. There are approx. one gazillion commands you can execute in this buffer; read the info pages for more information (`\\[gnus-info-find-node]'). The following commands are available: \\{gnus-summary-mode-map}" (interactive) (if gnus-visual (gnus-summary-make-menu-bar)) (kill-all-local-variables) (let ((locals gnus-summary-local-variables)) (while locals (if (consp (car locals)) (progn (make-local-variable (car (car locals))) (set (car (car locals)) (eval (cdr (car locals))))) (make-local-variable (car locals)) (set (car locals) nil)) (setq locals (cdr locals)))) (gnus-make-thread-indent-array) (setq mode-line-modified "-- ") (make-local-variable 'mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) (and (equal (nth 3 mode-line-format) " ") (setcar (nthcdr 3 mode-line-format) "")) (setq major-mode 'gnus-summary-mode) (setq mode-name "Summary") (make-local-variable 'minor-mode-alist) (use-local-map gnus-summary-mode-map) (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) ;Disable modification (setq truncate-lines t) (setq selective-display t) (setq selective-display-ellipses t) ;Display `...' (setq buffer-display-table gnus-summary-display-table) (setq gnus-newsgroup-name group) (run-hooks 'gnus-summary-mode-hook)) (defun gnus-summary-make-display-table () ;; Change the display table. Odd characters have a tendency to mess ;; up nicely formatted displays - we make all possible glyphs ;; display only a single character. ;; We start from the standard display table, if any. (setq gnus-summary-display-table (or (copy-sequence standard-display-table) (make-display-table))) ;; Nix out all the control chars... (let ((i 32)) (while (>= (setq i (1- i)) 0) (aset gnus-summary-display-table i [??]))) ;; ... but not newline and cr, of course. (cr is necessary for the ;; selective display). (aset gnus-summary-display-table ?\n nil) (aset gnus-summary-display-table ?\r nil) ;; We nix out any glyphs over 126 that are not set already. (let ((i 256)) (while (>= (setq i (1- i)) 127) ;; Only modify if the entry is nil. (or (aref gnus-summary-display-table i) (aset gnus-summary-display-table i [??]))))) (defun gnus-summary-clear-local-variables () (let ((locals gnus-summary-local-variables)) (while locals (if (consp (car locals)) (and (vectorp (car (car locals))) (set (car (car locals)) nil)) (and (vectorp (car locals)) (set (car locals) nil))) (setq locals (cdr locals))))) ;; Some summary mode macros. ;; Return a header specified by a NUMBER. (defun gnus-get-header-by-number (number) (save-excursion (set-buffer gnus-summary-buffer) (or gnus-newsgroup-headers-hashtb-by-number (gnus-make-headers-hashtable-by-number)) (gnus-gethash (int-to-string number) gnus-newsgroup-headers-hashtb-by-number))) ;; Fast version of the function above. (defmacro gnus-get-header-by-num (number) (` (gnus-gethash (int-to-string (, number)) gnus-newsgroup-headers-hashtb-by-number))) (defmacro gnus-summary-search-forward (&optional unread subject backward) "Search for article forward. If UNREAD is non-nil, only unread articles are selected. If SUBJECT is non-nil, the article which has the same subject will be searched for. If BACKWARD is non-nil, the search will be performed backwards instead." (` (gnus-summary-search-subject (, backward) (, unread) (, subject)))) (defmacro gnus-summary-search-backward (&optional unread subject) "Search for article backward. If 1st optional argument UNREAD is non-nil, only unread article is selected. If 2nd optional argument SUBJECT is non-nil, the article which has the same subject will be searched for." (` (gnus-summary-search-forward (, unread) (, subject) t))) (defmacro gnus-summary-article-number (&optional number-or-nil) "The article number of the article on the current line. If there isn's an article number here, then we return the current article number." (if number-or-nil '(get-text-property (gnus-point-at-bol) 'gnus-number) '(or (get-text-property (gnus-point-at-bol) 'gnus-number) gnus-current-article))) (defmacro gnus-summary-thread-level () "The thread level of the article on the current line." '(or (get-text-property (gnus-point-at-bol) 'gnus-level) 0)) (defmacro gnus-summary-article-mark () "The mark on the current line." '(get-text-property (gnus-point-at-bol) 'gnus-mark)) (defun gnus-summary-subject-string () "Return current subject string or nil if nothing." (let ((article (gnus-summary-article-number)) header) (and article (setq header (gnus-get-header-by-num article)) (vectorp header) (mail-header-subject header)))) ;; Various summary mode internalish functions. (defun gnus-mouse-pick-article (e) (interactive "e") (mouse-set-point e) (gnus-summary-next-page nil t)) (defun gnus-summary-setup-buffer (group) "Initialize summary buffer." (let ((buffer (concat "*Summary " group "*"))) (if (get-buffer buffer) (progn (set-buffer buffer) (not gnus-newsgroup-begin)) ;; Fix by Sudish Joseph (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) (gnus-add-current-to-buffer-list) (gnus-summary-mode group) (and gnus-carpal (gnus-carpal-setup-buffer 'summary)) (setq gnus-newsgroup-name group) t))) (defun gnus-set-global-variables () ;; Set the global equivalents of the summary buffer-local variables ;; to the latest values they had. These reflect the summary buffer ;; that was in action when the last article was fetched. (if (eq major-mode 'gnus-summary-mode) (progn (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) (marked gnus-newsgroup-marked) (unread gnus-newsgroup-unreads) (headers gnus-current-headers) (score-file gnus-current-score-file)) (save-excursion (set-buffer gnus-group-buffer) (setq gnus-newsgroup-name name) (setq gnus-newsgroup-marked marked) (setq gnus-newsgroup-unreads unread) (setq gnus-current-headers headers) (setq gnus-current-score-file score-file)))))) (defun gnus-summary-insert-dummy-line (sformat subject number) (if (not sformat) (setq sformat gnus-summary-dummy-line-format-spec)) (let (b) (beginning-of-line) (setq b (point)) (insert (eval sformat)) (add-text-properties b (1+ b) (list 'gnus-number number 'gnus-mark gnus-dummy-mark 'gnus-level 0)))) (defvar gnus-thread-indent-array nil) (defvar gnus-thread-indent-array-level gnus-thread-indent-level) (defun gnus-make-thread-indent-array () (let ((n 200)) (if (and gnus-thread-indent-array (= gnus-thread-indent-level gnus-thread-indent-array-level)) nil (setq gnus-thread-indent-array (make-vector 201 "") gnus-thread-indent-array-level gnus-thread-indent-level) (while (>= n 0) (aset gnus-thread-indent-array n (make-string (* n gnus-thread-indent-level) ? )) (setq n (1- n)))))) (defun gnus-summary-insert-line (sformat header level current unread replied expirable subject-or-nil &optional dummy score process) (or sformat (setq sformat gnus-summary-line-format-spec)) (let* ((indentation (aref gnus-thread-indent-array level)) (lines (mail-header-lines header)) (score (or score gnus-summary-default-score 0)) (score-char (if (or (null gnus-summary-default-score) (<= (abs (- score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) ? (if (< score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark))) (replied (cond (process gnus-process-mark) (replied gnus-replied-mark) (t gnus-unread-mark))) (from (mail-header-from header)) (name (cond ((string-match "(.+)" from) (substring from (1+ (match-beginning 0)) (1- (match-end 0)))) ((string-match "<[^>]+> *$" from) (let ((beg (match-beginning 0))) (or (and (string-match "^\"[^\"]*\"" from) (substring from (1+ (match-beginning 0)) (1- (match-end 0)))) (substring from 0 beg)))) (t from))) (subject (mail-header-subject header)) (number (mail-header-number header)) (opening-bracket (if dummy ?\< ?\[)) (closing-bracket (if dummy ?\> ?\])) (buffer-read-only nil) (b (progn (beginning-of-line) (point)))) (or (numberp lines) (setq lines 0)) (insert (eval sformat)) (add-text-properties b (1+ b) (list 'gnus-number number 'gnus-mark (or unread gnus-unread-mark) 'gnus-level level)))) (defun gnus-summary-update-line (&optional dont-update) ;; Update summary line after change. (or (not gnus-summary-default-score) gnus-summary-inhibit-highlight (let ((gnus-summary-inhibit-highlight t) (article (gnus-summary-article-number))) (progn (or dont-update (if (and gnus-summary-mark-below (< (gnus-summary-article-score) gnus-summary-mark-below)) (and (not (memq article gnus-newsgroup-marked)) (not (memq article gnus-newsgroup-dormant)) (memq article gnus-newsgroup-unreads) (gnus-summary-mark-article-as-read gnus-low-score-mark)) (and (eq (gnus-summary-article-mark) gnus-low-score-mark) (gnus-summary-mark-article-as-unread gnus-unread-mark)))) (and gnus-visual (run-hooks 'gnus-summary-update-hook)))))) (defun gnus-summary-update-lines (&optional beg end) ;; Mark article as read (or not) by taking into account scores. (let ((beg (or beg (point-min))) (end (or end (point-max)))) (if (or (not gnus-summary-default-score) gnus-summary-inhibit-highlight) () (let ((gnus-summary-inhibit-highlight t) article) (save-excursion (set-buffer gnus-summary-buffer) (goto-char beg) (beginning-of-line) (while (and (not (eobp)) (< (point) end)) (if (and gnus-summary-mark-below (< (or (cdr (assq (setq article (get-text-property (point) 'gnus-number)) gnus-newsgroup-scored)) gnus-summary-default-score 0) gnus-summary-mark-below)) ;; We want to possibly mark it as read... (and (not (memq article gnus-newsgroup-marked)) (not (memq article gnus-newsgroup-dormant)) (memq article gnus-newsgroup-unreads) (gnus-summary-mark-article-as-read gnus-low-score-mark)) ;; We want to possibly mark it as unread. (and (eq (get-text-property (point) 'gnus-mark) gnus-low-score-mark) (gnus-summary-mark-article-as-unread gnus-unread-mark))) ;; Do the visual highlights at the same time. (and gnus-visual (run-hooks 'gnus-summary-update-hook)) (forward-line 1))))))) (defvar gnus-tmp-gathered nil) (defun gnus-summary-number-of-articles-in-thread (thread &optional char) ;; Sum up all elements (and sub-elements) in a list. (let* ((number ;; Fix by Luc Van Eycken . (if (and (consp thread) (cdr thread)) (apply '+ 1 (mapcar 'gnus-summary-number-of-articles-in-thread (cdr thread))) 1))) (if char (if (> number 1) gnus-not-empty-thread-mark gnus-empty-thread-mark) number))) (defun gnus-summary-read-group (group &optional show-all no-article kill-buffer) "Start reading news in newsgroup GROUP. If SHOW-ALL is non-nil, already read articles are also listed. If NO-ARTICLE is non-nil, no article is selected initially." (gnus-message 5 "Retrieving newsgroup: %s..." group) (let* ((new-group (gnus-summary-setup-buffer group)) (quit-config (gnus-group-quit-config group)) (did-select (and new-group (gnus-select-newsgroup group show-all)))) (cond ((not new-group) (gnus-set-global-variables) (gnus-kill-buffer kill-buffer) (gnus-configure-windows 'summary 'force) (gnus-set-mode-line 'summary) (gnus-summary-position-cursor) (message "") t) ((null did-select) (and (eq major-mode 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer)) (progn (kill-buffer (current-buffer)) (if (not quit-config) (progn (set-buffer gnus-group-buffer) (gnus-group-jump-to-group group) (gnus-group-next-unread-group 1)) (if (not (buffer-name (car quit-config))) (gnus-configure-windows 'group 'force) (set-buffer (car quit-config)) (and (eq major-mode 'gnus-summary-mode) (gnus-set-global-variables)) (gnus-configure-windows (cdr quit-config)))))) (message "Can't select group") nil) ((eq did-select 'quit) (and (eq major-mode 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer)) (kill-buffer (current-buffer))) (gnus-kill-buffer kill-buffer) (if (not quit-config) (progn (set-buffer gnus-group-buffer) (gnus-group-jump-to-group group) (gnus-group-next-unread-group 1) (gnus-configure-windows 'group 'force)) (if (not (buffer-name (car quit-config))) (gnus-configure-windows 'group 'force) (set-buffer (car quit-config)) (and (eq major-mode 'gnus-summary-mode) (gnus-set-global-variables)) (gnus-configure-windows (cdr quit-config)))) (signal 'quit nil)) (t (gnus-set-global-variables) ;; Save the active value in effect when the group was entered. (setq gnus-newsgroup-active (gnus-copy-sequence (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))) ;; You can change the subjects in this hook. (run-hooks 'gnus-select-group-hook) ;; Do score processing. (and gnus-use-scoring (gnus-possibly-score-headers)) (gnus-update-format-specifications) ;; Generate the summary buffer. (gnus-summary-prepare) (if (zerop (buffer-size)) (cond (gnus-newsgroup-dormant (gnus-summary-show-all-dormant)) ((and gnus-newsgroup-scored show-all) (gnus-summary-show-all-expunged)))) ;; Function `gnus-apply-kill-file' must be called in this hook. (run-hooks 'gnus-apply-kill-hook) (if (zerop (buffer-size)) (progn ;; This newsgroup is empty. (gnus-summary-catchup-and-exit nil t) ;Without confirmations. (gnus-message 6 "No unread news") (gnus-kill-buffer kill-buffer) nil) ;;(save-excursion ;; (if kill-buffer ;; (let ((gnus-summary-buffer kill-buffer)) ;; (gnus-configure-windows 'group)))) ;; Hide conversation thread subtrees. We cannot do this in ;; gnus-summary-prepare-hook since kill processing may not ;; work with hidden articles. (and gnus-show-threads gnus-thread-hide-subtree (gnus-summary-hide-all-threads)) ;; Show first unread article if requested. (goto-char (point-min)) (if (and (not no-article) gnus-auto-select-first (gnus-summary-first-unread-article)) () (gnus-configure-windows 'summary 'force)) (gnus-set-mode-line 'summary) (gnus-summary-position-cursor) ;; If in async mode, we send some info to the backend. (and gnus-newsgroup-async (setq gnus-newsgroup-threads (nreverse gnus-newsgroup-threads)) (gnus-request-asynchronous gnus-newsgroup-name (if (and gnus-asynchronous-article-function (fboundp gnus-asynchronous-article-function)) (funcall gnus-asynchronous-article-function gnus-newsgroup-threads) gnus-newsgroup-threads))) (gnus-kill-buffer kill-buffer) (if (not (get-buffer-window gnus-group-buffer)) () ;; gotta use windows, because recenter does wierd stuff if ;; the current buffer ain't the displayed window. (let ((owin (selected-window))) (select-window (get-buffer-window gnus-group-buffer)) (and (gnus-group-goto-group group) (recenter)) (select-window owin)))) t)))) (defun gnus-summary-prepare () ;; Generate the summary buffer. (let ((buffer-read-only nil)) (erase-buffer) (gnus-summary-prepare-threads (if gnus-show-threads (gnus-gather-threads (gnus-sort-threads (if (and gnus-summary-expunge-below (not gnus-fetch-old-headers)) (gnus-make-threads-and-expunge) (gnus-make-threads)))) gnus-newsgroup-headers) 'cull) (gnus-summary-update-lines) ;; Create the header hashtb. (gnus-make-headers-hashtable-by-number) ;; Call hooks for modifying summary buffer. ;; Suggested by sven@tde.LTH.Se (Sven Mattisson). (goto-char (point-min)) (run-hooks 'gnus-summary-prepare-hook))) (defun gnus-gather-threads (threads) "Gather threads that have lost their roots." (if (not gnus-summary-make-false-root) threads (let ((hashtb (gnus-make-hashtable 1023)) (prev threads) (result threads) subject hthread whole-subject) (while threads (setq whole-subject (setq subject (mail-header-subject (car (car threads))))) (if gnus-summary-gather-subject-limit (or (and (numberp gnus-summary-gather-subject-limit) (> (length subject) gnus-summary-gather-subject-limit) (setq subject (substring subject 0 gnus-summary-gather-subject-limit))) (and (eq 'fuzzy gnus-summary-gather-subject-limit) (setq subject (gnus-simplify-subject-fuzzy subject)))) (setq subject (gnus-simplify-subject-re subject))) (if (setq hthread (gnus-gethash subject hashtb)) (progn (or (stringp (car (car hthread))) (setcar hthread (list whole-subject (car hthread)))) (setcdr (car hthread) (nconc (cdr (car hthread)) (list (car threads)))) (setcdr prev (cdr threads)) (setq threads prev)) (gnus-sethash subject threads hashtb)) (setq prev threads) (setq threads (cdr threads))) result))) (defun gnus-make-threads () ;; This function takes the dependencies already made by ;; `gnus-get-newsgroup-headers' and builds the trees. First we go ;; through the dependecies in the hash table and finds all the ;; roots. Roots do not refer back to any valid articles. (gnus-message 6 "Threading...") (let (roots new-roots) (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov) (gnus-build-old-threads)) (mapatoms (lambda (refs) (if (not (car (symbol-value refs))) (setq roots (append (cdr (symbol-value refs)) roots)) ;; Ok, these refer back to valid articles, but if ;; `gnus-thread-ignore-subject' is nil, we have to check that ;; the root has the same subject as its children. The children ;; that do not are made into roots and removed from the list ;; of children. (or gnus-thread-ignore-subject (let* ((prev (symbol-value refs)) (subject (gnus-simplify-subject-re (mail-header-subject (car prev)))) (headers (cdr prev))) (while headers (if (not (string= subject (gnus-simplify-subject-re (mail-header-subject (car headers))))) (progn (setq new-roots (cons (car headers) new-roots)) (setcdr prev (cdr headers))) (setq prev headers)) (setq headers (cdr headers))))))) gnus-newsgroup-dependencies) ;; We enter the new roots into the dependencies structure to ;; ensure that any possible later thread-regeneration will be ;; possible. (let ((r new-roots)) (while r (gnus-sethash (concat (mail-header-id (car r)) ".boo") (list nil (car r)) gnus-newsgroup-dependencies) (setq r (cdr r)))) (setq roots (nconc new-roots roots)) (prog1 (mapcar 'gnus-trim-thread (apply 'append (mapcar 'gnus-cut-thread (mapcar 'gnus-make-sub-thread roots)))) (gnus-message 6 "Threading...done")))) (defun gnus-make-threads-and-expunge () ;; This function takes the dependencies already made by ;; `gnus-get-newsgroup-headers' and builds the trees. First we go ;; through the dependecies in the hash table and finds all the ;; roots. Roots do not refer back to any valid articles. (gnus-message 6 "Threading...") (let ((default (or gnus-summary-default-score 0)) (below gnus-summary-expunge-below) roots article new-roots) (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov) (gnus-build-old-threads)) (mapatoms (lambda (refs) (if (not (car (symbol-value refs))) ;; These articles do not refer back to any other articles - ;; they are roots. (let ((headers (cdr (symbol-value refs)))) ;; We weed out the low-scored articles. (while headers (if (not (< (or (cdr (assq (mail-header-number (car headers)) gnus-newsgroup-scored)) default) below)) ;; It is over. (setq roots (cons (car headers) roots)) ;; It is below, so we mark it as read. (setq gnus-newsgroup-unreads (delq (mail-header-number (car headers)) gnus-newsgroup-unreads)) (setq gnus-newsgroup-reads (cons (cons (mail-header-number (car headers)) gnus-low-score-mark) gnus-newsgroup-reads))) (setq headers (cdr headers)))) ;; Ok, these refer back to valid articles, but if ;; `gnus-thread-ignore-subject' is nil, we have to check that ;; the root has the same subject as its children. The children ;; that do not are made into roots and removed from the list ;; of children. (or gnus-thread-ignore-subject (let* ((prev (symbol-value refs)) (subject (gnus-simplify-subject-re (mail-header-subject (car prev)))) (headers (cdr prev))) (while headers (if (not (string= subject (gnus-simplify-subject-re (mail-header-subject (car headers))))) (progn (if (not (< (or (cdr (assq (mail-header-number (car headers)) gnus-newsgroup-scored)) default) below)) (setq new-roots (cons (car headers) new-roots)) (setq gnus-newsgroup-unreads (delq (mail-header-number (car headers)) gnus-newsgroup-unreads)) (setq gnus-newsgroup-reads (cons (cons (mail-header-number (car headers)) gnus-low-score-mark) gnus-newsgroup-reads))) (setcdr prev (cdr headers))) (setq prev headers)) (setq headers (cdr headers))))) ;; If this article is expunged, some of the children might be ;; roots. (if (< (or (cdr (assq (mail-header-number (car (symbol-value refs))) gnus-newsgroup-scored)) default) below) (let* ((prev (symbol-value refs)) (headers (cdr prev))) (while headers (setq article (mail-header-number (car headers))) (if (not (< (or (cdr (assq article gnus-newsgroup-scored)) default) below)) (progn (setq new-roots (cons (car headers) new-roots)) (setq prev headers)) (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-reads (cons (cons article gnus-low-score-mark) gnus-newsgroup-reads)) (setcdr prev (cdr headers))) (setq headers (cdr headers)))) ;; It was not expunged, but we look at expunged children. (let* ((prev (symbol-value refs)) (headers (cdr prev)) article) (while headers (setq article (mail-header-number (car headers))) (if (not (< (or (cdr (assq article gnus-newsgroup-scored)) default) below)) (setq prev headers) (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-reads (cons (cons article gnus-low-score-mark) gnus-newsgroup-reads)) (setcdr prev (cdr headers))) (setq headers (cdr headers))))))) gnus-newsgroup-dependencies) ;; We enter the new roots into the dependencies structure to ;; ensure that any possible later thread-regeneration will be ;; possible. (let ((r new-roots)) (while r (gnus-sethash (concat (mail-header-id (car r)) ".boo") (list nil (car r)) gnus-newsgroup-dependencies) (setq r (cdr r)))) (setq roots (nconc new-roots roots)) (prog1 (mapcar 'gnus-trim-thread (apply 'append (mapcar 'gnus-cut-thread (mapcar 'gnus-make-sub-thread roots)))) (gnus-message 6 "Threading...done")))) (defun gnus-cut-thread (thread) ;; Remove leaf dormant or ancient articles from THREAD. (let ((head (car thread)) (tail (apply 'append (mapcar 'gnus-cut-thread (cdr thread))))) (if (and (null tail) (let ((number (mail-header-number head))) (or (memq number gnus-newsgroup-ancient) (memq number gnus-newsgroup-dormant) (and gnus-summary-expunge-below (eq gnus-fetch-old-headers 'some) (< (or (cdr (assq number gnus-newsgroup-scored)) gnus-summary-default-score 0) gnus-summary-expunge-below) (progn (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (setq gnus-newsgroup-reads (cons (cons number gnus-low-score-mark) gnus-newsgroup-reads)) t))))) nil (list (cons head tail))))) (defun gnus-trim-thread (thread) ;; Remove root ancient articles with only one child from THREAD. (if (and (eq gnus-fetch-old-headers 'some) (memq (mail-header-number (car thread)) gnus-newsgroup-ancient) (= (length thread) 2)) (gnus-trim-thread (nth 1 thread)) thread)) (defun gnus-make-sub-thread (root) ;; This function makes a sub-tree for a node in the tree. (let ((children (reverse (cdr (gnus-gethash (downcase (mail-header-id root)) gnus-newsgroup-dependencies))))) (cons root (mapcar 'gnus-make-sub-thread children)))) (defun gnus-build-old-threads () ;; Look at all the articles that refer back to old articles, and ;; fetch the headers for the articles that aren't there. This will ;; build complete threads - if the roots haven't been expired by the ;; server, that is. (let (id heads) (mapatoms (lambda (refs) (if (not (car (symbol-value refs))) (progn (setq heads (cdr (symbol-value refs))) (while heads (if (not (memq (mail-header-number (car heads)) gnus-newsgroup-dormant)) (progn (setq id (symbol-name refs)) (while (and (setq id (gnus-build-get-header id)) (not (car (gnus-gethash id gnus-newsgroup-dependencies))))) (setq heads nil)) (setq heads (cdr heads))))))) gnus-newsgroup-dependencies))) (defun gnus-build-get-header (id) ;; Look through the buffer of NOV lines and find the header to ;; ID. Enter this line into the dependencies hash table, and return ;; the id of the parent article (if any). (let ((deps gnus-newsgroup-dependencies) found header) (prog1 (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) (while (and (not found) (search-forward id nil t)) (beginning-of-line) (setq found (looking-at (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" (regexp-quote id)))) (or found (beginning-of-line 2))) (if found (let (ref) (beginning-of-line) (and (setq header (gnus-nov-parse-line (read (current-buffer)) deps)) (setq ref (mail-header-references header)) (string-match "\\(<[^>]+>\\) *$" ref) (substring ref (match-beginning 1) (match-end 1)))))) (and header (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers) gnus-newsgroup-ancient (cons (mail-header-number header) gnus-newsgroup-ancient)))))) ;; Re-build the thread containing ID. (defun gnus-rebuild-thread (id) (let ((dep gnus-newsgroup-dependencies) (buffer-read-only nil) parent headers refs thread art) (while (and id (setq headers (car (setq art (gnus-gethash (downcase id) dep))))) (setq parent art) (setq id (and (setq refs (mail-header-references headers)) (string-match "\\(<[^>]+>\\) *$" refs) (substring refs (match-beginning 1) (match-end 1))))) (setq thread (gnus-make-sub-thread (car parent))) (gnus-rebuild-remove-articles thread) (let ((beg (point))) (gnus-summary-prepare-threads (list thread)) (gnus-summary-update-lines beg (point))))) ;; Delete all lines in the summary buffer that correspond to articles ;; in this thread. (defun gnus-rebuild-remove-articles (thread) (and (gnus-summary-goto-subject (mail-header-number (car thread))) (gnus-delete-line)) (mapcar (lambda (th) (gnus-rebuild-remove-articles th)) (cdr thread))) (defun gnus-sort-threads (threads) ;; Sort threads as specified in `gnus-thread-sort-functions'. (let ((fun gnus-thread-sort-functions)) (while fun (gnus-message 6 "Sorting with %S..." fun) (setq threads (sort threads (car fun)) fun (cdr fun)))) (if gnus-thread-sort-functions (gnus-message 6 "Sorting...done")) threads) ;; Written by Hallvard B Furuseth . (defmacro gnus-thread-header (thread) ;; Return header of first article in THREAD. ;; Note that THREAD must never, evr be anything else than a variable - ;; using some other form will lead to serious barfage. (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; (vector thread) 2)) (defun gnus-thread-sort-by-number (h1 h2) "Sort threads by root article number." (< (mail-header-number (gnus-thread-header h1)) (mail-header-number (gnus-thread-header h2)))) (defun gnus-thread-sort-by-author (h1 h2) "Sort threads by root author." (string-lessp (let ((extract (funcall gnus-extract-address-components (mail-header-from (gnus-thread-header h1))))) (or (car extract) (cdr extract))) (let ((extract (funcall gnus-extract-address-components (mail-header-from (gnus-thread-header h2))))) (or (car extract) (cdr extract))))) (defun gnus-thread-sort-by-subject (h1 h2) "Sort threads by root subject." (string-lessp (downcase (gnus-simplify-subject-re (mail-header-subject (gnus-thread-header h1)))) (downcase (gnus-simplify-subject-re (mail-header-subject (gnus-thread-header h2)))))) (defun gnus-thread-sort-by-date (h1 h2) "Sort threads by root article date." (string-lessp (gnus-sortable-date (mail-header-date (gnus-thread-header h1))) (gnus-sortable-date (mail-header-date (gnus-thread-header h2))))) (defun gnus-thread-sort-by-score (h1 h2) "Sort threads by root article score. Unscored articles will be counted as having a score of zero." (> (or (cdr (assq (mail-header-number (gnus-thread-header h1)) gnus-newsgroup-scored)) gnus-summary-default-score 0) (or (cdr (assq (mail-header-number (gnus-thread-header h2)) gnus-newsgroup-scored)) gnus-summary-default-score 0))) (defun gnus-thread-sort-by-total-score (h1 h2) "Sort threads by the sum of all scores in the thread. Unscored articles will be counted as having a score of zero." (> (gnus-thread-total-score h1) (gnus-thread-total-score h2))) (defun gnus-thread-total-score (thread) ;; This function find the total score of THREAD. (if (consp thread) (if (stringp (car thread)) (apply gnus-thread-score-function 0 (mapcar 'gnus-thread-total-score-1 (cdr thread))) (gnus-thread-total-score-1 thread)) (gnus-thread-total-score-1 (list thread)))) (defun gnus-thread-total-score-1 (root) ;; This function find the total score of the thread below ROOT. (setq root (car root)) (apply gnus-thread-score-function (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored)) gnus-summary-default-score 0) (mapcar 'gnus-thread-total-score (cdr (gnus-gethash (downcase (mail-header-id root)) gnus-newsgroup-dependencies))))) ;; Added by Per Abrahamsen . (defvar gnus-tmp-prev-subject "") (defun gnus-summary-prepare-threads (threads &optional cull) "Prepare summary buffer from THREADS and indentation LEVEL. THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' or a straight list of headers." (message "Generating summary...") (let ((level 0) thread header number subject stack state gnus-tmp-gathered) (if (vectorp (car threads)) ;; If this is a straight (sic) list of headers, then a ;; threaded summary display isn't required, so we just create ;; an unthreaded one. (gnus-summary-prepare-unthreaded threads cull) ;; Do the threaded display. (while (or threads stack) (if threads ;; If there are some threads, we do them before the ;; threads on the stack. (setq thread threads header (car (car thread))) ;; There were no current threads, so we pop something off ;; the stack. (setq state (car stack) level (car state) thread (cdr state) stack (cdr stack) header (car (car thread)))) (if (stringp header) (progn ;; The header is a dummy root. (cond ((eq gnus-summary-make-false-root 'adopt) ;; We let the first article adopt the rest. (let ((th (car (cdr (car thread))))) (while (cdr th) (setq th (cdr th))) (setcdr th (cdr (cdr (car thread)))) (setq gnus-tmp-gathered (nconc (mapcar (lambda (h) (mail-header-number (car h))) (cdr (cdr (car thread)))) gnus-tmp-gathered)) (setcdr (cdr (car thread)) nil)) (setq level -1)) ((eq gnus-summary-make-false-root 'empty) ;; We print adopted articles with empty subject fields. (setq gnus-tmp-gathered (nconc (mapcar (lambda (h) (mail-header-number (car h))) (cdr (cdr (car thread)))) gnus-tmp-gathered)) (setq level -1)) ((eq gnus-summary-make-false-root 'dummy) ;; We output a dummy root. (gnus-summary-insert-dummy-line nil header (mail-header-number (car (car (cdr (car thread))))))) (t ;; We do not make a root for the gathered ;; sub-threads at all. (setq level -1)))) (setq number (mail-header-number header) subject (mail-header-subject header)) ;; Do the async thing. (and gnus-newsgroup-async (setq gnus-newsgroup-threads (cons (cons number (mail-header-lines header)) gnus-newsgroup-threads))) ;; We may have to root out some bad articles... (and cull (= level 0) (cond ((and (memq (setq number (mail-header-number header)) gnus-newsgroup-dormant) (null thread)) (setq header nil)) ((and gnus-summary-expunge-below (< (or (cdr (assq number gnus-newsgroup-scored)) gnus-summary-default-score 0) gnus-summary-expunge-below)) (setq header nil) (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (setq gnus-newsgroup-reads (cons (cons number gnus-low-score-mark) gnus-newsgroup-reads))))) (and header (progn (inline (gnus-summary-insert-line nil header level nil (cond ((memq number gnus-newsgroup-marked) gnus-ticked-mark) ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) ((memq number gnus-newsgroup-unreads) gnus-unread-mark) ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) (t (or (cdr (assq number gnus-newsgroup-reads)) gnus-ancient-mark))) (memq number gnus-newsgroup-replied) (memq number gnus-newsgroup-expirable) (cond ((and gnus-thread-ignore-subject (not (string= (gnus-simplify-subject-re gnus-tmp-prev-subject) (gnus-simplify-subject-re subject)))) subject) ((zerop level) (if (and (eq gnus-summary-make-false-root 'empty) (memq number gnus-tmp-gathered)) gnus-summary-same-subject subject)) (t gnus-summary-same-subject)) (and (eq gnus-summary-make-false-root 'adopt) (memq number gnus-tmp-gathered)) (cdr (assq number gnus-newsgroup-scored)) (memq number gnus-newsgroup-processable)) (setq gnus-tmp-prev-subject subject))))) (if (nth 1 thread) (setq stack (cons (cons (max 0 level) (nthcdr 1 thread)) stack))) (setq level (1+ level)) (setq threads (cdr (car thread)))))) (message "Generating summary...done")) (defun gnus-summary-prepare-unthreaded (headers &optional cull) (let (header number) ;; Do the async thing, if that is required. (if gnus-newsgroup-async (setq gnus-newsgroup-threads (mapcar (lambda (h) (cons (mail-header-number h) (mail-header-lines h))) headers))) (while headers (setq header (car headers) headers (cdr headers) number (mail-header-number header)) ;; We may have to root out some bad articles... (cond ((and cull (memq (setq number (mail-header-number header)) gnus-newsgroup-dormant))) ((and cull gnus-summary-expunge-below (< (or (cdr (assq number gnus-newsgroup-scored)) gnus-summary-default-score 0) gnus-summary-expunge-below)) (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (setq gnus-newsgroup-reads (cons (cons number gnus-low-score-mark) gnus-newsgroup-reads))) (t (gnus-summary-insert-line nil header 0 nil (cond ((memq number gnus-newsgroup-marked) gnus-ticked-mark) ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) ((memq number gnus-newsgroup-unreads) gnus-unread-mark) ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) (t (or (cdr (assq number gnus-newsgroup-reads)) gnus-ancient-mark))) (memq number gnus-newsgroup-replied) (memq number gnus-newsgroup-expirable) (mail-header-subject header) nil (cdr (assq number gnus-newsgroup-scored)) (memq number gnus-newsgroup-processable))))))) (defun gnus-select-newsgroup (group &optional read-all) "Select newsgroup GROUP. If READ-ALL is non-nil, all articles in the group are selected." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) articles) (or (gnus-check-server (setq gnus-current-select-method (gnus-find-method-for-group group))) (error "Couldn't open server")) (or (and entry (not (eq (car entry) t))) ; Either it's active... (gnus-activate-group group) ; Or we can activate it... (progn ; Or we bug out. (kill-buffer (current-buffer)) (error "Couldn't request group %s: %s" group (gnus-status-message group)))) (setq gnus-newsgroup-name group) (setq gnus-newsgroup-unselected nil) (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) (and gnus-asynchronous (gnus-check-backend-function 'request-asynchronous gnus-newsgroup-name) (setq gnus-newsgroup-async (gnus-request-asynchronous gnus-newsgroup-name))) (setq articles (gnus-articles-to-read group read-all)) (cond ((null articles) (gnus-message 3 "Couldn't select newsgroup") 'quit) ((eq articles 0) nil) (t ;; Init the dependencies hash table. (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) ;; Retrieve the headers and read them in. (gnus-message 5 "Fetching headers...") (setq gnus-newsgroup-headers (if (eq 'nov (setq gnus-headers-retrieved-by ;; This is a naughty hack. To get the ;; retrieval of old headers to work, we ;; set `nntp-nov-gap' to nil (locally), ;; and then just retrieve the headers. ;; Mucho magic. (if gnus-fetch-old-headers (let (nntp-nov-gap) (gnus-retrieve-headers (if (not (eq 1 (car articles))) (cons 1 articles) articles) gnus-newsgroup-name)) (gnus-retrieve-headers articles gnus-newsgroup-name)))) (progn (gnus-get-newsgroup-headers-xover articles)) ;; If we were to fetch old headers, but the backend didn't ;; support XOVER, then it is possible we fetched one article ;; that we shouldn't have. If that's the case, we remove it. (if (or (not gnus-fetch-old-headers) (eq 1 (car articles))) () (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) (and (looking-at "[0-9]+[ \t]+1[ \t]") ; This is not a NOV line. (delete-region ; So we delete this head. (point) (search-forward "\n.\n" nil t))))) (gnus-get-newsgroup-headers))) (gnus-message 5 "Fetching headers...done") ;; Remove canceled articles from the list of unread articles. (setq gnus-newsgroup-unreads (gnus-set-sorted-intersection gnus-newsgroup-unreads (mapcar (lambda (headers) (mail-header-number headers)) gnus-newsgroup-headers))) ;; Adjust and set lists of article marks. (and info (let (marked) (gnus-adjust-marked-articles info) (setq gnus-newsgroup-marked (copy-sequence (cdr (assq 'tick (setq marked (nth 3 info)))))) (setq gnus-newsgroup-replied (copy-sequence (cdr (assq 'reply marked)))) (setq gnus-newsgroup-expirable (copy-sequence (cdr (assq 'expire marked)))) (setq gnus-newsgroup-killed (copy-sequence (cdr (assq 'killed marked)))) (setq gnus-newsgroup-bookmarks (copy-sequence (cdr (assq 'bookmark marked)))) (setq gnus-newsgroup-dormant (copy-sequence (cdr (assq 'dormant marked)))) (setq gnus-newsgroup-scored (copy-sequence (cdr (assq 'score marked)))) (setq gnus-newsgroup-processable nil))) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire (or (and (stringp gnus-auto-expirable-newsgroups) (string-match gnus-auto-expirable-newsgroups group)) (memq 'auto-expire (nth 5 info)))) ;; First and last article in this newsgroup. (and gnus-newsgroup-headers (setq gnus-newsgroup-begin (mail-header-number (car gnus-newsgroup-headers))) (setq gnus-newsgroup-end (mail-header-number (gnus-last-element gnus-newsgroup-headers)))) (setq gnus-reffed-article-number -1) ;; GROUP is successfully selected. (or gnus-newsgroup-headers t))))) (defun gnus-articles-to-read (group read-all) ;; Find out what articles the user wants to read. (let* ((articles ;; Select all articles if `read-all' is non-nil, or if all the ;; unread articles are dormant articles. (if (or read-all (= (length gnus-newsgroup-unreads) (length gnus-newsgroup-dormant))) (gnus-uncompress-range (gnus-gethash group gnus-active-hashtb)) gnus-newsgroup-unreads)) (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) (scored (length scored-list)) (number (length articles)) (marked (+ (length gnus-newsgroup-marked) (length gnus-newsgroup-dormant))) (select (cond ((numberp read-all) read-all) (t (condition-case () (cond ((and (or (<= scored marked) (= scored number)) (numberp gnus-large-newsgroup) (> number gnus-large-newsgroup)) (let ((input (read-string (format "How many articles from %s (default %d): " gnus-newsgroup-name number)))) (if (string-match "^[ \t]*$" input) number input))) ((and (> scored marked) (< scored number)) (let ((input (read-string (format "%s %s (%d scored, %d total): " "How many articles from" group scored number)))) (if (string-match "^[ \t]*$" input) number input))) (t number)) (quit nil)))))) (setq select (if (stringp select) (string-to-number select) select)) (if (or (null select) (zerop select)) select (if (and (not (zerop scored)) (<= (abs select) scored)) (progn (setq articles (sort scored-list '<)) (setq number (length articles))) (setq articles (copy-sequence articles))) (if (< (abs select) number) (if (< select 0) ;; Select the N oldest articles. (setcdr (nthcdr (1- (abs select)) articles) nil) ;; Select the N most recent articles. (setq articles (nthcdr (- number select) articles)))) (setq gnus-newsgroup-unselected (gnus-sorted-intersection gnus-newsgroup-unreads (gnus-sorted-complement gnus-newsgroup-unreads articles))) articles))) (defun gnus-killed-articles (killed articles) (let (out) (while articles (if (inline (gnus-member-of-range (car articles) killed)) (setq out (cons (car articles) out))) (setq articles (cdr articles))) out)) (defun gnus-adjust-marked-articles (info &optional active) "Remove all marked articles that are no longer legal." (let ((marked-lists (nth 3 info)) (active (or active (gnus-gethash (car info) gnus-active-hashtb))) m prev) ;; There are many types of marked articles. (while marked-lists (setq m (cdr (setq prev (car marked-lists)))) (cond ((or (eq 'tick (car prev)) (eq 'dormant (car prev))) ;; Make sure that all ticked articles are a subset of the ;; unread/unselected articles. (while m (if (or (memq (car m) gnus-newsgroup-unreads) (memq (car m) gnus-newsgroup-unselected)) (setq prev m) (setcdr prev (cdr m))) (setq m (cdr m)))) ((eq 'score (car prev)) ;; Scored articles should be a subset of ;; unread/unselected articles. (while m (if (or (memq (car (car m)) gnus-newsgroup-unreads) (memq (car (car m)) gnus-newsgroup-unreads)) (setq prev m) (setcdr prev (cdr m))) (setq m (cdr m)))) ((eq 'bookmark (car prev)) ;; Bookmarks should be a subset of active articles. (while m (if (< (car (car m)) (car active)) (setcdr prev (cdr m)) (setq prev m)) (setq m (cdr m)))) ((eq 'killed (car prev)) ;; Articles that have been through the kill process are ;; to be a subset of active articles. (while (and m (< (or (and (numberp (car m)) (car m)) (cdr (car m))) (car active))) (setcdr prev (cdr m)) (setq m (cdr m))) (if (and m (< (or (and (numberp (car m)) (car m)) (car (car m))) (car active))) (setcar (if (numberp (car m)) m (car m)) (car active)))) ((or (eq 'reply (car prev)) (eq 'expire (car prev))) ;; The replied and expirable articles have to be articles ;; that are active. (while m (if (< (car m) (car active)) (setcdr prev (cdr m)) (setq prev m)) (setq m (cdr m))))) (setq marked-lists (cdr marked-lists))) ;; Remove all lists that are empty. (setq marked-lists (nth 3 info)) (if marked-lists (progn (while (= 1 (length (car marked-lists))) (setq marked-lists (cdr marked-lists))) (setq m (cdr (setq prev marked-lists))) (while m (if (= 1 (length (car m))) (setcdr prev (cdr m)) (setq prev m)) (setq m (cdr m))) (setcar (nthcdr 3 info) marked-lists))) ;; Finally, if there are no marked lists at all left, and if there ;; are no elements after the lists in the info list, we just chop ;; the info list off before the marked lists. (and (null marked-lists) (not (nthcdr 4 info)) (setcdr (nthcdr 2 info) nil))) info) (defun gnus-set-marked-articles (info ticked replied expirable killed dormant bookmark score) "Enter the various lists of marked articles into the newsgroup info list." (let (newmarked) (and ticked (setq newmarked (cons (cons 'tick ticked) nil))) (and replied (setq newmarked (cons (cons 'reply replied) newmarked))) (and expirable (setq newmarked (cons (cons 'expire expirable) newmarked))) (and killed (setq newmarked (cons (cons 'killed killed) newmarked))) (and dormant (setq newmarked (cons (cons 'dormant dormant) newmarked))) (and bookmark (setq newmarked (cons (cons 'bookmark bookmark) newmarked))) (and score (setq newmarked (cons (cons 'score score) newmarked))) (if (nthcdr 3 info) (progn (setcar (nthcdr 3 info) newmarked) (and (not newmarked) (not (nthcdr 4 info)) (setcdr (nthcdr 2 info) nil))) (if newmarked (setcdr (nthcdr 2 info) (list newmarked)))))) (defun gnus-add-marked-articles (group type articles &optional info force) ;; Add ARTICLES of TYPE to the info of GROUP. ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't ;; add, but replace marked articles of TYPE with ARTICLES. (let ((info (or info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))) marked m) (or (not info) (and (not (setq marked (nthcdr 3 info))) (setcdr (nthcdr 2 info) (list (list (cons type articles))))) (and (not (setq m (assq type (car marked)))) (setcar marked (cons (cons type articles) (car marked)))) (if force (setcdr m articles) (nconc m articles))))) (defun gnus-set-mode-line (where) "This function sets the mode line of the article or summary buffers. If WHERE is `summary', the summary mode line format will be used." (if (memq where gnus-updated-mode-lines) (let (mode-string) (save-excursion (set-buffer gnus-summary-buffer) (let* ((mformat (if (eq where 'article) gnus-article-mode-line-format-spec gnus-summary-mode-line-format-spec)) (group-name gnus-newsgroup-name) (article-number (or gnus-current-article 0)) (unread (- (length gnus-newsgroup-unreads) (length gnus-newsgroup-dormant))) (unread-and-unticked (- unread (length gnus-newsgroup-marked))) (unselected (length gnus-newsgroup-unselected)) (unread-and-unselected (cond ((and (zerop unread-and-unticked) (zerop unselected)) "") ((zerop unselected) (format "{%d more}" unread-and-unticked)) (t (format "{%d(+%d) more}" unread-and-unticked unselected)))) (subject (if gnus-current-headers (mail-header-subject gnus-current-headers) "")) (max-len (and gnus-mode-non-string-length (- (frame-width) gnus-mode-non-string-length))) header);; passed as argument to any user-format-funcs (setq mode-string (eval mformat)) (or (numberp max-len) (setq max-len (length mode-string))) (if (< max-len 4) (setq max-len 4)) (if (> (length mode-string) max-len) ;; modified by MORIOKA Tomohiko ;; function `substring' might cut on a middle ;; of multi-octet character. (setq mode-string (concat (gnus-truncate-string mode-string (- max-len 3)) "..."))) (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) (setq mode-line-buffer-identification mode-string) (set-buffer-modified-p t)))) (defun gnus-create-xref-hashtb (from-newsgroup headers unreads) "Go through the HEADERS list and add all Xrefs to a hash table. The resulting hash table is returned, or nil if no Xrefs were found." (let* ((from-method (gnus-find-method-for-group from-newsgroup)) (prefix (if (and (gnus-group-foreign-p from-newsgroup) (not (memq 'virtual (assoc (symbol-name (car from-method)) gnus-valid-select-methods)))) (gnus-group-real-prefix from-newsgroup))) (xref-hashtb (make-vector 63 0)) start group entry number xrefs header) (while headers (setq header (car headers)) (if (and (setq xrefs (mail-header-xref header)) (not (memq (mail-header-number header) unreads))) (progn (setq start 0) (while (string-match "\\([^ ]+\\):\\([0-9]+\\)" xrefs start) (setq start (match-end 0)) (setq group (concat prefix (substring xrefs (match-beginning 1) (match-end 1)))) (setq number (string-to-int (substring xrefs (match-beginning 2) (match-end 2)))) (if (setq entry (gnus-gethash group xref-hashtb)) (setcdr entry (cons number (cdr entry))) (gnus-sethash group (cons number nil) xref-hashtb))))) (setq headers (cdr headers))) (if start xref-hashtb nil))) (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads expirable) "Look through all the headers and mark the Xrefs as read." (let ((virtual (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group from-newsgroup))) gnus-valid-select-methods))) name entry info xref-hashtb idlist method nth4) (save-excursion (set-buffer gnus-group-buffer) (if (setq xref-hashtb (gnus-create-xref-hashtb from-newsgroup headers unreads)) (mapatoms (lambda (group) (if (string= from-newsgroup (setq name (symbol-name group))) () (setq idlist (symbol-value group)) ;; Dead groups are not updated. (if (and (prog1 (setq entry (gnus-gethash name gnus-newsrc-hashtb) info (nth 2 entry)) (if (stringp (setq nth4 (nth 4 info))) (setq nth4 (gnus-server-to-method nth4)))) ;; Only do the xrefs if the group has the same ;; select method as the group we have just read. (or (gnus-methods-equal-p nth4 (gnus-find-method-for-group from-newsgroup)) virtual (equal nth4 (setq method (gnus-find-method-for-group from-newsgroup))) (and (equal (car nth4) (car method)) (equal (nth 1 nth4) (nth 1 method)))) gnus-use-cross-reference (or (not (eq gnus-use-cross-reference t)) virtual ;; Only do cross-references on subscribed ;; groups, if that is what is wanted. (<= (nth 1 info) gnus-level-subscribed))) (gnus-group-make-articles-read name idlist expirable)))) xref-hashtb))))) (defun gnus-group-make-articles-read (group articles expirable) (let* ((num 0) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) (active (gnus-gethash group gnus-active-hashtb)) exps expirable range) ;; First peel off all illegal article numbers. (if active (let ((ids articles) (ticked (cdr (assq 'tick (nth 3 info)))) (dormant (cdr (assq 'dormant (nth 3 info)))) id first) (setq exps nil) (while ids (setq id (car ids)) (if (and first (> id (cdr active))) (progn ;; We'll end up in this situation in one particular ;; obscure situation. If you re-scan a group and get ;; a new article that is cross-posted to a different ;; group that has not been re-scanned, you might get ;; crossposted article that has a higher number than ;; Gnus believes possible. So we re-activate this ;; group as well. This might mean doing the ;; crossposting thingie will *increase* the number ;; of articles in some groups. Tsk, tsk. (setq active (or (gnus-activate-group group) active)))) (if (or (> id (cdr active)) (< id (car active)) (memq id ticked) (memq id dormant)) (setq articles (delq id articles))) (and (memq id expirable) (setq exps (cons id exps))) (setq ids (cdr ids))))) ;; Update expirable articles. (gnus-add-marked-articles nil 'expirable exps info) (and active (null (nth 2 info)) (> (car active) 1) (setcar (nthcdr 2 info) (cons 1 (1- (car active))))) (setcar (nthcdr 2 info) (setq range (gnus-add-to-range (nth 2 info) (setq articles (sort articles '<))))) ;; Then we have to re-compute how many unread ;; articles there are in this group. (if active (progn (cond ((not range) (setq num (- (1+ (cdr active)) (car active)))) ((not (listp (cdr range))) (setq num (- (cdr active) (- (1+ (cdr range)) (car range))))) (t (while range (if (numberp (car range)) (setq num (1+ num)) (setq num (+ num (- (1+ (cdr (car range))) (car (car range)))))) (setq range (cdr range))) (setq num (- (cdr active) num)))) ;; Update the number of unread articles. (setcar entry (max 0 (- num (length (cdr (assq 'tick (nth 3 info)))) (length (cdr (assq 'dormant (nth 3 info))))))) ;; Update the group buffer. (gnus-group-update-group group t))))) (defun gnus-methods-equal-p (m1 m2) (let ((m1 (or m1 gnus-select-method)) (m2 (or m2 gnus-select-method))) (or (equal m1 m2) (and (eq (car m1) (car m2)) (or (not (memq 'address (assoc (symbol-name (car m1)) gnus-valid-select-methods))) (equal (nth 1 m1) (nth 1 m2))))))) (defsubst gnus-header-value () (buffer-substring (match-end 0) (gnus-point-at-eol))) (defvar gnus-newsgroup-none-id 0) (defun gnus-get-newsgroup-headers () (setq gnus-article-internal-prepare-hook nil) (let ((cur nntp-server-buffer) (dependencies gnus-newsgroup-dependencies) headers id dep end ref) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) ;; Search to the beginning of the next header. Error messages ;; do not begin with 2 or 3. (while (re-search-forward "^[23][0-9]+ " nil t) (let ((header (make-vector 9 nil)) (case-fold-search t) (p (point)) in-reply-to) (setq id nil ref nil) (mail-header-set-number header (read cur)) ;; This implementation of this function, with nine ;; search-forwards instead of the one re-search-forward and ;; a case (which basically was the old function) is actually ;; about twice as fast, even though it looks messier. You ;; can't have everything, I guess. Speed and elegance ;; doesn't always come hand in hand. (save-restriction (narrow-to-region (point) (or (save-excursion (search-forward "\n.\n" nil t)) (point))) (if (search-forward "\nfrom: " nil t) (mail-header-set-from header (gnus-header-value)) (mail-header-set-from header "(nobody)")) (goto-char p) (if (search-forward "\nsubject: " nil t) (mail-header-set-subject header (gnus-header-value)) (mail-header-set-subject header "(none)")) (goto-char p) (and (search-forward "\nxref: " nil t) (mail-header-set-xref header (gnus-header-value))) (goto-char p) (or (numberp (and (search-forward "\nlines: " nil t) (mail-header-set-lines header (read cur)))) (mail-header-set-lines header 0)) (goto-char p) (and (search-forward "\ndate: " nil t) (mail-header-set-date header (gnus-header-value))) (goto-char p) (if (search-forward "\nmessage-id: " nil t) (mail-header-set-id header (setq id (gnus-header-value))) ;; If there was no message-id, we just fake one to make ;; subsequent routines simpler. (mail-header-set-id header (setq id (concat "none+" (int-to-string (setq gnus-newsgroup-none-id (1+ gnus-newsgroup-none-id))))))) (goto-char p) (if (search-forward "\nreferences: " nil t) (progn (mail-header-set-references header (gnus-header-value)) (setq end (match-end 0)) (save-excursion (setq ref (downcase (buffer-substring (progn (end-of-line) (search-backward ">" end t) (1+ (point))) (progn (search-backward "<" end t) (point))))))) ;; Get the references from the in-reply-to header if there ;; ware no references and the in-reply-to header looks ;; promising. (if (and (search-forward "\nin-reply-to: " nil t) (setq in-reply-to (gnus-header-value)) (string-match "<[^>]+>" in-reply-to)) (progn (mail-header-set-references header (setq ref (substring in-reply-to (match-beginning 0) (match-end 0)))) (setq ref (downcase ref))) (setq ref "none"))) ;; We do some threading while we read the headers. The ;; message-id and the last reference are both entered into ;; the same hash table. Some tippy-toeing around has to be ;; done in case an article has arrived before the article ;; which it refers to. (if (boundp (setq dep (intern (downcase id) dependencies))) (if (car (symbol-value dep)) ;; An article with this Message-ID has already ;; been seen, so we ignore this one, except we add ;; any additional Xrefs (in case the two articles ;; came from different servers. (progn (mail-header-set-xref (car (symbol-value dep)) (concat (or (mail-header-xref (car (symbol-value dep))) "") (or (mail-header-xref header) ""))) (setq header nil)) (setcar (symbol-value dep) header)) (set dep (list header))) (if header (progn (if (boundp (setq dep (intern ref dependencies))) (setcdr (symbol-value dep) (cons header (cdr (symbol-value dep)))) (set dep (list nil header))) (setq headers (cons header headers)))) (goto-char (point-max)))))) (nreverse headers))) ;; The following macros and functions were written by Felix Lee ;; . (defmacro gnus-nov-read-integer () '(prog1 (if (= (following-char) ?\t) 0 (let ((num (condition-case nil (read buffer) (error nil)))) (if (numberp num) num 0))) (or (eobp) (forward-char 1)))) (defmacro gnus-nov-skip-field () '(search-forward "\t" eol 'move)) (defmacro gnus-nov-field () '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) ;; Goes through the xover lines and returns a list of vectors (defun gnus-get-newsgroup-headers-xover (sequence) "Parse the news overview data in the server buffer, and return a list of headers that match SEQUENCE (see `nntp-retrieve-headers')." ;; Get the Xref when the users reads the articles since most/some ;; NNTP servers do not include Xrefs when using XOVER. (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) (let ((cur nntp-server-buffer) (dependencies gnus-newsgroup-dependencies) number headers header) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) (while (and sequence (not (eobp))) (setq number (read cur)) (while (and sequence (< (car sequence) number)) (setq sequence (cdr sequence))) (and sequence (eq number (car sequence)) (progn (setq sequence (cdr sequence)) (if (setq header (inline (gnus-nov-parse-line number dependencies))) (setq headers (cons header headers))))) (forward-line 1)) (setq headers (nreverse headers))) headers)) ;; This function has to be called with point after the article number ;; on the beginning of the line. (defun gnus-nov-parse-line (number dependencies) (let ((none 0) (eol (gnus-point-at-eol)) (buffer (current-buffer)) header ref id dep) ;; overview: [num subject from date id refs chars lines misc] (narrow-to-region (point) eol) (or (eobp) (forward-char)) (condition-case nil (setq header (vector number ; number (gnus-nov-field) ; subject (gnus-nov-field) ; from (gnus-nov-field) ; date (setq id (or (gnus-nov-field) (concat "none+" (int-to-string (setq none (1+ none)))))) ; id (progn (save-excursion (let ((beg (point))) (search-forward "\t" eol) (if (search-backward ">" beg t) (setq ref (downcase (buffer-substring (1+ (point)) (progn (search-backward "<" beg t) (point))))) (setq ref nil)))) (gnus-nov-field)) ; refs (gnus-nov-read-integer) ; chars (gnus-nov-read-integer) ; lines (if (= (following-char) ?\n) nil (gnus-nov-field)) ; misc )) (error (progn (ding) (message "Strange nov line.") (setq header nil) (goto-char eol)))) (widen) ;; We build the thread tree. (and header (if (boundp (setq dep (intern (downcase id) dependencies))) (if (car (symbol-value dep)) ;; An article with this Message-ID has already been seen, ;; so we ignore this one, except we add any additional ;; Xrefs (in case the two articles came from different ;; servers. (progn (mail-header-set-xref (car (symbol-value dep)) (concat (or (mail-header-xref (car (symbol-value dep))) "") (or (mail-header-xref header) ""))) (setq header nil)) (setcar (symbol-value dep) header)) (set dep (list header)))) (if header (progn (if (boundp (setq dep (intern (or ref "none") dependencies))) (setcdr (symbol-value dep) (cons header (cdr (symbol-value dep)))) (set dep (list nil header))))) header)) (defun gnus-article-get-xrefs () "Fill in the Xref value in `gnus-current-headers', if necessary. This is meant to be called in `gnus-article-internal-prepare-hook'." (let ((headers (save-excursion (set-buffer gnus-summary-buffer) gnus-current-headers))) (or (not gnus-use-cross-reference) (not headers) (and (mail-header-xref headers) (not (string= (mail-header-xref headers) ""))) (let ((case-fold-search t) xref) (save-restriction (gnus-narrow-to-headers) (goto-char (point-min)) (if (or (and (eq (downcase (following-char)) ?x) (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (progn (goto-char (1+ (match-end 0))) (setq xref (buffer-substring (point) (progn (end-of-line) (point)))) (mail-header-set-xref headers xref)))))))) (defalias 'gnus-find-header-by-number 'gnus-get-header-by-number) (make-obsolete 'gnus-find-header-by-number 'gnus-get-header-by-number) (defun gnus-make-headers-hashtable-by-number () "Make hashtable for the variable gnus-newsgroup-headers by number." (save-excursion (set-buffer gnus-summary-buffer) (let ((headers gnus-newsgroup-headers) header) (setq gnus-newsgroup-headers-hashtb-by-number (gnus-make-hashtable (length headers))) (while headers (setq header (car headers)) (gnus-sethash (int-to-string (mail-header-number header)) header gnus-newsgroup-headers-hashtb-by-number) (setq headers (cdr headers)))))) (defun gnus-more-header-backward () "Find new header backward." (let ((first (car (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))) (artnum gnus-newsgroup-begin) (header nil)) (while (and (not header) (> artnum first)) (setq artnum (1- artnum)) (setq header (gnus-read-header artnum))) header)) (defun gnus-more-header-forward (&optional backward) "Find new header forward. If BACKWARD, find new header backward instead." (if backward (gnus-more-header-backward) (let ((last (cdr (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))) (artnum gnus-newsgroup-end) (header nil)) (while (and (not header) (< artnum last)) (setq artnum (1+ artnum)) (setq header (gnus-read-header artnum))) header))) (defun gnus-extend-newsgroup (header &optional backward) "Extend newsgroup selection with HEADER. Optional argument BACKWARD means extend toward backward." (if header (let ((artnum (mail-header-number header))) (setq gnus-newsgroup-headers (if backward (cons header gnus-newsgroup-headers) (nconc gnus-newsgroup-headers (list header)))) (setq gnus-newsgroup-unselected (delq artnum gnus-newsgroup-unselected)) (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum)) (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum))))) (defun gnus-summary-work-articles (n) "Return a list of articles to be worked upon. The prefix argument, the list of process marked articles, and the current article will be taken into consideration." (let (articles) (if (and n (numberp n)) (let ((backward (< n 0)) (n (abs n))) (save-excursion (while (and (> n 0) (setq articles (cons (gnus-summary-article-number) articles)) (gnus-summary-search-forward nil nil backward)) (setq n (1- n)))) (sort articles (function <))) (or (reverse gnus-newsgroup-processable) (list (gnus-summary-article-number)))))) (defun gnus-summary-search-group (&optional backward use-level) "Search for next unread newsgroup. If optional argument BACKWARD is non-nil, search backward instead." (save-excursion (set-buffer gnus-group-buffer) (if (gnus-group-search-forward backward nil (if use-level (gnus-group-group-level) nil)) (gnus-group-group-name)))) (defun gnus-summary-best-group (&optional exclude-group) "Find the name of the best unread group. If EXCLUDE-GROUP, do not go to this group." (save-excursion (set-buffer gnus-group-buffer) (save-excursion (gnus-group-best-unread-group exclude-group)))) (defun gnus-subject-equal (s1 s2) (cond ((null gnus-summary-gather-subject-limit) (equal (gnus-simplify-subject-re s1) (gnus-simplify-subject-re s2))) ((eq gnus-summary-gather-subject-limit 'fuzzy) (equal (gnus-simplify-subject-fuzzy s1) (gnus-simplify-subject-fuzzy s2))) ((numberp gnus-summary-gather-subject-limit) (equal (gnus-limit-string s1 gnus-summary-gather-subject-limit) (gnus-limit-string s2 gnus-summary-gather-subject-limit))) (t (equal s1 s2)))) (defun gnus-summary-search-subject (&optional backward unread subject) "Search for article forward. If BACKWARD is non-nil, search backward. If UNREAD is non-nil, only unread articles are selected. If SUBJECT is non-nil, the article which has the same subject will be searched for." (let ((func (if backward 'previous-single-property-change 'next-single-property-change)) (beg (point)) (did t) pos psubject) (beginning-of-line) (and gnus-summary-check-current unread (eq (get-text-property (point) 'gnus-mark) gnus-unread-mark) (setq did nil)) (if (not did) () (forward-char (if backward (if (bobp) 0 -1) (if (eobp) 0 1))) (while (and (setq pos (funcall func (point) 'gnus-number)) (goto-char (if backward (1- pos) pos)) (setq did (not (and (or (not unread) (eq (get-text-property (point) 'gnus-mark) gnus-unread-mark)) (or (not subject) (and (setq psubject (inline (gnus-summary-subject-string))) (inline (gnus-subject-equal subject psubject))))))) (if backward (if (bobp) nil (forward-char -1) t) (if (eobp) nil (forward-char 1) t))))) (if did (progn (goto-char beg) nil) (prog1 (get-text-property (point) 'gnus-number) (gnus-summary-show-thread) (gnus-summary-position-cursor))))) (defun gnus-summary-pseudo-article () "The thread level of the article on the current line." (get-text-property (gnus-point-at-bol) 'gnus-pseudo)) (defalias 'gnus-summary-score 'gnus-summary-article-score) (make-obsolete 'gnus-summary-score 'gnus-summary-article-score) (defun gnus-summary-article-score () "Return current article score." (or (cdr (assq (gnus-summary-article-number) gnus-newsgroup-scored)) gnus-summary-default-score 0)) (defun gnus-summary-recenter () "Center point in the summary window. If `gnus-auto-center-summary' is nil, or the article buffer isn't displayed, no centering will be performed." ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) (t 2))) (height (1- (window-height))) (bottom (save-excursion (goto-char (point-max)) (forward-line (- height)) (point))) (window (get-buffer-window (current-buffer)))) (and ;; The user has to want it, gnus-auto-center-summary ;; the article buffer must be displayed, (get-buffer-window gnus-article-buffer) ;; Set the window start to either `bottom', which is the biggest ;; possible valid number, or the second line from the top, ;; whichever is the least. (set-window-start window (min bottom (save-excursion (forward-line (- top)) (point))))))) ;; Function written by Stainless Steel Rat . (defun gnus-short-group-name (group &optional levels) "Collapse GROUP name LEVELS." (let* ((name "") (foreign "") (depth -1) (skip 1) (levels (or levels (progn (while (string-match "\\." group skip) (setq skip (match-end 0) depth (+ depth 1))) depth)))) (if (string-match ":" group) (setq foreign (substring group 0 (match-end 0)) group (substring group (match-end 0)))) (while group (if (and (string-match "\\." group) (> levels 0)) (setq name (concat name (substring group 0 1)) group (substring group (match-end 0)) levels (- levels 1) name (concat name ".")) (setq name (concat foreign name group) group nil))) name)) (defun gnus-summary-jump-to-group (newsgroup) "Move point to NEWSGROUP in group mode buffer." ;; Keep update point of group mode buffer if visible. (if (eq (current-buffer) (get-buffer gnus-group-buffer)) (save-window-excursion ;; Take care of tree window mode. (if (get-buffer-window gnus-group-buffer) (pop-to-buffer gnus-group-buffer)) (gnus-group-jump-to-group newsgroup)) (save-excursion ;; Take care of tree window mode. (if (get-buffer-window gnus-group-buffer) (pop-to-buffer gnus-group-buffer) (set-buffer gnus-group-buffer)) (gnus-group-jump-to-group newsgroup)))) ;; This function returns a list of article numbers based on the ;; difference between the ranges of read articles in this group and ;; the range of active articles. (defun gnus-list-of-unread-articles (group) (let* ((read (nth 2 (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))) (active (gnus-gethash group gnus-active-hashtb)) (last (cdr active)) first nlast unread) ;; If none are read, then all are unread. (if (not read) (setq first (car active)) ;; If the range of read articles is a single range, then the ;; first unread article is the article after the last read ;; article. Sounds logical, doesn't it? (if (not (listp (cdr read))) (setq first (1+ (cdr read))) ;; `read' is a list of ranges. (if (/= (setq nlast (or (and (numberp (car read)) (car read)) (car (car read)))) 1) (setq first 1)) (while read (if first (while (< first nlast) (setq unread (cons first unread)) (setq first (1+ first)))) (setq first (1+ (if (atom (car read)) (car read) (cdr (car read))))) (setq nlast (if (atom (car (cdr read))) (car (cdr read)) (car (car (cdr read))))) (setq read (cdr read))))) ;; And add the last unread articles. (while (<= first last) (setq unread (cons first unread)) (setq first (1+ first))) ;; Return the list of unread articles. (nreverse unread))) (defun gnus-list-of-read-articles (group) (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (active (gnus-gethash group gnus-active-hashtb))) (and info active (gnus-sorted-complement (gnus-uncompress-range active) (gnus-list-of-unread-articles group))))) ;; Various summary commands (defun gnus-summary-universal-argument () "Perform any operation on all articles marked with the process mark." (interactive) (gnus-set-global-variables) (let ((articles (reverse gnus-newsgroup-processable)) func) (or articles (error "No articles marked")) (or (setq func (key-binding (read-key-sequence "C-c C-u"))) (error "Undefined key")) (while articles (gnus-summary-goto-subject (car articles)) (command-execute func) (gnus-summary-remove-process-mark (car articles)) (setq articles (cdr articles))))) (defun gnus-summary-toggle-truncation (&optional arg) "Toggle truncation of summary lines. With arg, turn line truncation on iff arg is positive." (interactive "P") (setq truncate-lines (if (null arg) (not truncate-lines) (> (prefix-numeric-value arg) 0))) (redraw-display)) (defun gnus-summary-reselect-current-group (&optional all) "Once exit and then reselect the current newsgroup. The prefix argument ALL means to select all articles." (interactive "P") (gnus-set-global-variables) (let ((current-subject (gnus-summary-article-number)) (group gnus-newsgroup-name)) (setq gnus-newsgroup-begin nil) (gnus-summary-exit t) ;; We have to adjust the point of group mode buffer because the ;; current point was moved to the next unread newsgroup by ;; exiting. (gnus-summary-jump-to-group group) (gnus-group-read-group all t) (gnus-summary-goto-subject current-subject))) (defun gnus-summary-rescan-group (&optional all) "Exit the newsgroup, ask for new articles, and select the newsgroup." (interactive "P") (gnus-set-global-variables) ;; Fix by Ilja Weis . (let ((group gnus-newsgroup-name)) (gnus-summary-exit) (gnus-summary-jump-to-group group) (save-excursion (set-buffer gnus-group-buffer) (gnus-group-get-new-news-this-group 1)) (gnus-summary-jump-to-group group) (gnus-group-read-group all))) (defun gnus-summary-update-info () (let* ((group gnus-newsgroup-name)) (if gnus-newsgroup-kill-headers (setq gnus-newsgroup-killed (gnus-compress-sequence (nconc (gnus-set-sorted-intersection (gnus-uncompress-range gnus-newsgroup-killed) (setq gnus-newsgroup-unselected (sort gnus-newsgroup-unselected '<))) (setq gnus-newsgroup-unreads (sort gnus-newsgroup-unreads '<))) t))) (or (listp (cdr gnus-newsgroup-killed)) (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) (let ((headers gnus-newsgroup-headers)) (gnus-close-group group) (run-hooks 'gnus-exit-group-hook) (gnus-update-read-articles group gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked t gnus-newsgroup-replied gnus-newsgroup-expirable gnus-newsgroup-killed gnus-newsgroup-dormant gnus-newsgroup-bookmarks (and gnus-save-score gnus-newsgroup-scored)) (and gnus-use-cross-reference (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads gnus-newsgroup-expirable)) ;; Do adaptive scoring, and possibly save score files. (and gnus-newsgroup-adaptive (gnus-score-adaptive)) (and gnus-use-scoring (fboundp 'gnus-score-save) (funcall 'gnus-score-save)) ;; Do not switch windows but change the buffer to work. (set-buffer gnus-group-buffer) (or (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-group-update-group group))))) (defun gnus-summary-exit (&optional temporary) "Exit reading current newsgroup, and then return to group selection mode. gnus-exit-group-hook is called with no arguments if that value is non-nil." (interactive) (gnus-set-global-variables) (gnus-kill-save-kill-buffer) (let* ((group gnus-newsgroup-name) (quit-config (gnus-group-quit-config gnus-newsgroup-name)) (mode major-mode) (buf (current-buffer))) (run-hooks 'gnus-summary-prepare-exit-hook) ;; Make all changes in this group permanent. (gnus-summary-update-info) (set-buffer buf) (and gnus-use-cache (gnus-cache-possibly-remove-articles)) ;; Make sure where I was, and go to next newsgroup. (set-buffer gnus-group-buffer) (or quit-config (progn (gnus-group-jump-to-group group) (gnus-group-next-unread-group 1))) (if temporary nil ;Nothing to do. ;; We set all buffer-local variables to nil. It is unclear why ;; this is needed, but if we don't, buffer-local variables are ;; not garbage-collected, it seems. This would the lead to en ;; ever-growing Emacs. (set-buffer buf) (gnus-summary-clear-local-variables) ;; We clear the global counterparts of the buffer-local ;; variables as well, just to be on the safe side. (gnus-configure-windows 'group 'force) (gnus-summary-clear-local-variables) ;; Return to group mode buffer. (if (eq mode 'gnus-summary-mode) (gnus-kill-buffer buf)) (if (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) (setq gnus-current-select-method gnus-select-method) (pop-to-buffer gnus-group-buffer) (if (not quit-config) (progn (gnus-group-jump-to-group group) (gnus-group-next-unread-group 1)) (if (not (buffer-name (car quit-config))) (gnus-configure-windows 'group 'force) (set-buffer (car quit-config)) (and (eq major-mode 'gnus-summary-mode) (gnus-set-global-variables)) (gnus-configure-windows (cdr quit-config)))) (run-hooks 'gnus-summary-exit-hook)))) (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) (defun gnus-summary-exit-no-update (&optional no-questions) "Quit reading current newsgroup without updating read article info." (interactive) (gnus-set-global-variables) (let* ((group gnus-newsgroup-name) (quit-config (gnus-group-quit-config group))) (if (or no-questions gnus-expert-user (gnus-y-or-n-p "Do you really wanna quit reading this group? ")) (progn (gnus-close-group group) (gnus-summary-clear-local-variables) (set-buffer gnus-group-buffer) (gnus-summary-clear-local-variables) ;; Return to group selection mode. (gnus-configure-windows 'group 'force) (if (get-buffer gnus-summary-buffer) (kill-buffer gnus-summary-buffer)) (if (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) (if (equal (gnus-group-group-name) group) (gnus-group-next-unread-group 1)) (if quit-config (progn (if (not (buffer-name (car quit-config))) (gnus-configure-windows 'group 'force) (set-buffer (car quit-config)) (and (eq major-mode 'gnus-summary-mode) (gnus-set-global-variables)) (gnus-configure-windows (cdr quit-config))))))))) ;; Suggested by Andrew Eskilsson . (defun gnus-summary-fetch-faq (group) "Fetch the FAQ for the current group." (interactive (list gnus-newsgroup-name)) (let (gnus-faq-buffer) (and (setq gnus-faq-buffer (gnus-group-fetch-faq group)) (gnus-configure-windows 'summary-faq)))) ;; Suggested by Per Abrahamsen . (defun gnus-summary-describe-group (&optional force) "Describe the current newsgroup." (interactive "P") (gnus-group-describe-group force gnus-newsgroup-name)) (defun gnus-summary-describe-briefly () "Describe summary mode commands briefly." (interactive) (gnus-message 6 (substitute-command-keys "\\\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) ;; Walking around group mode buffer from summary mode. (defun gnus-summary-next-group (&optional no-article target-group backward) "Exit current newsgroup and then select next unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected initially. If NEXT-GROUP, go to this group. If BACKWARD, go to previous group instead." (interactive "P") (gnus-set-global-variables) (let ((current-group gnus-newsgroup-name) (current-buffer (current-buffer)) entered) ;; First we semi-exit this group to update Xrefs and all variables. ;; We can't do a real exit, because the window conf must remain ;; the same in case the user is prompted for info, and we don't ;; want the window conf to change before that... (gnus-summary-exit t) (while (not entered) ;; Then we find what group we are supposed to enter. (set-buffer gnus-group-buffer) (gnus-group-jump-to-group current-group) (setq target-group (or target-group (if (eq gnus-keep-same-level 'best) (gnus-summary-best-group gnus-newsgroup-name) (gnus-summary-search-group backward gnus-keep-same-level)))) (if (not target-group) ;; There are no further groups, so we return to the group ;; buffer. (progn (gnus-message 5 "Returning to the group buffer") (setq entered t) (set-buffer current-buffer) (gnus-summary-exit)) ;; We try to enter the target group. (gnus-group-jump-to-group target-group) (let ((unreads (gnus-group-group-unread))) (if (and (or (eq t unreads) (and unreads (not (zerop unreads)))) (gnus-summary-read-group target-group nil no-article current-buffer)) (setq entered t) (setq current-group target-group target-group nil))))))) (defun gnus-summary-next-group-old (&optional no-article group backward) "Exit current newsgroup and then select next unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected initially. If BACKWARD, go to previous group instead." (interactive "P") (gnus-set-global-variables) (let ((ingroup gnus-newsgroup-name) (sumbuf (current-buffer)) num) (set-buffer gnus-group-buffer) (if (and group (or (and (numberp (setq num (car (gnus-gethash group gnus-newsrc-hashtb)))) (< num 1)) (null num))) (progn (gnus-group-jump-to-group group) (setq group nil)) (gnus-group-jump-to-group ingroup)) (gnus-summary-search-group backward) (let ((group (or group (gnus-summary-search-group backward)))) (set-buffer sumbuf) (gnus-summary-exit t) ;Update all information. (if (null group) (gnus-summary-exit-no-update t) (gnus-group-jump-to-group ingroup) (setq group (gnus-summary-search-group backward)) (gnus-message 5 "Selecting %s..." group) (set-buffer gnus-group-buffer) ;; We are now in group mode buffer. ;; Make sure group mode buffer point is on GROUP. (gnus-group-jump-to-group group) (if (not (eq gnus-auto-select-next 'quietly)) (progn (gnus-summary-read-group group nil no-article sumbuf) (and (string= gnus-newsgroup-name ingroup) (bufferp sumbuf) (buffer-name sumbuf) (progn (set-buffer (setq gnus-summary-buffer sumbuf)) (gnus-summary-exit-no-update t)))) (let ((prevgroup group)) (gnus-group-jump-to-group ingroup) (setq group (gnus-summary-search-group backward)) (gnus-summary-read-group group nil no-article sumbuf) (while (and (string= gnus-newsgroup-name ingroup) (bufferp sumbuf) (buffer-name sumbuf) (not (string= prevgroup (gnus-group-group-name)))) (set-buffer gnus-group-buffer) (gnus-summary-read-group (setq prevgroup (gnus-group-group-name)) nil no-article sumbuf)) (and (string= prevgroup (gnus-group-group-name)) ;; We have reached the final group in the group ;; buffer. (progn (if (buffer-name sumbuf) (progn (set-buffer sumbuf) (gnus-summary-exit))))))))))) (defun gnus-summary-prev-group (&optional no-article) "Exit current newsgroup and then select previous unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected initially." (interactive "P") (gnus-summary-next-group no-article nil t)) ;; Walking around summary lines. (defun gnus-summary-first-subject (&optional unread) "Go to the first unread subject. If UNREAD is non-nil, go to the first unread article. Returns nil if there are no unread articles." (interactive "P") (prog1 (cond ((not unread) (goto-char (point-min))) ((gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-mark gnus-unread-mark)) t) (t ;; There are no unread articles. (gnus-message 3 "No more unread articles") nil)) (gnus-summary-position-cursor))) (defun gnus-summary-next-subject (n &optional unread dont-display) "Go to next N'th summary line. If N is negative, go to the previous N'th subject line. If UNREAD is non-nil, only unread articles are selected. The difference between N and the actual number of steps taken is returned." (interactive "p") (let ((backward (< n 0)) (n (abs n))) (while (and (> n 0) (gnus-summary-search-forward unread nil backward)) (setq n (1- n))) (if (/= 0 n) (gnus-message 7 "No more%s articles" (if unread " unread" ""))) (or dont-display (progn (gnus-summary-recenter) (gnus-summary-position-cursor))) n)) (defun gnus-summary-next-unread-subject (n) "Go to next N'th unread summary line." (interactive "p") (gnus-summary-next-subject n t)) (defun gnus-summary-prev-subject (n &optional unread) "Go to previous N'th summary line. If optional argument UNREAD is non-nil, only unread article is selected." (interactive "p") (gnus-summary-next-subject (- n) unread)) (defun gnus-summary-prev-unread-subject (n) "Go to previous N'th unread summary line." (interactive "p") (gnus-summary-next-subject (- n) t)) (defun gnus-summary-goto-subject (article) "Go the subject line of ARTICLE." (interactive (list (string-to-int (completing-read "Article number: " (mapcar (lambda (headers) (list (int-to-string (mail-header-number headers)))) gnus-newsgroup-headers) nil 'require-match)))) (or article (error "No article number")) (let ((b (point))) (if (not (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-number article))) () (gnus-summary-show-thread) ;; Skip dummy articles. (if (eq (gnus-summary-article-mark) gnus-dummy-mark) (forward-line 1)) (prog1 (if (not (eobp)) article (goto-char b) nil) (gnus-summary-position-cursor))))) ;; Walking around summary lines with displaying articles. (defun gnus-summary-expand-window (&optional arg) "Make the summary buffer take up the entire Emacs frame. Given a prefix, will force an `article' buffer configuration." (interactive "P") (gnus-set-global-variables) (if arg (gnus-configure-windows 'article 'force) (gnus-configure-windows 'summary 'force))) (defun gnus-summary-display-article (article &optional all-header) "Display ARTICLE in article buffer." (gnus-set-global-variables) (if (null article) nil (prog1 (gnus-article-prepare article all-header) (gnus-summary-show-thread) (if (eq (gnus-summary-article-mark) gnus-dummy-mark) (progn (forward-line 1) (gnus-summary-position-cursor))) (run-hooks 'gnus-select-article-hook) (gnus-summary-recenter) (gnus-summary-goto-subject article) ;; Successfully display article. (gnus-summary-update-line) (gnus-article-set-window-start (cdr (assq article gnus-newsgroup-bookmarks))) t))) (defun gnus-summary-select-article (&optional all-headers force pseudo article) "Select the current article. If ALL-HEADERS is non-nil, show all header fields. If FORCE is non-nil, the article will be re-fetched even if it already present in the article buffer. If PSEUDO is non-nil, pseudo-articles will also be displayed." (and (not pseudo) (gnus-summary-pseudo-article) (error "This is a pseudo-article.")) (let ((article (or article (gnus-summary-article-number))) (all-headers (not (not all-headers))) ;Must be T or NIL. did) (prog1 (save-excursion (set-buffer gnus-summary-buffer) (if (or (null gnus-current-article) (null gnus-article-current) (null (get-buffer gnus-article-buffer)) (not (eq article (cdr gnus-article-current))) (not (equal (car gnus-article-current) gnus-newsgroup-name)) force) ;; The requested article is different from the current article. (progn (gnus-summary-display-article article all-headers) (setq did article)) (if (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) nil)) (if did (gnus-article-set-window-start (cdr (assq article gnus-newsgroup-bookmarks))))))) (defun gnus-summary-set-current-mark (&optional current-mark) "Obsolete function." nil) (defun gnus-summary-next-article (&optional unread subject backward) "Select the next article. If UNREAD, only unread articles are selected. If SUBJECT, only articles with SUBJECT are selected. If BACKWARD, the previous article is selected instead of the next." (interactive "P") (gnus-set-global-variables) (let (header) (cond ;; Is there such an article? ((and (gnus-summary-search-forward unread subject backward) (or (gnus-summary-display-article (gnus-summary-article-number)) (eq (gnus-summary-article-mark) gnus-canceled-mark))) (gnus-summary-position-cursor)) ;; If not, we try the first unread, if that is wanted. ((and subject gnus-auto-select-same (or (gnus-summary-first-unread-article) (eq (gnus-summary-article-mark) gnus-canceled-mark))) (gnus-summary-position-cursor) (gnus-message 6 "Wrapped")) ;; Try to get next/previous article not displayed in this group. ((and gnus-auto-extend-newsgroup (not unread) (not subject) (setq header (gnus-more-header-forward backward))) (gnus-extend-newsgroup header backward) (let ((buffer-read-only nil)) (goto-char (if backward (point-min) (point-max))) (gnus-summary-prepare-threads (list header))) (gnus-summary-goto-article (if backward gnus-newsgroup-begin gnus-newsgroup-end))) ;; Go to next/previous group. (t (or (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-summary-jump-to-group gnus-newsgroup-name)) (let ((cmd last-command-char) (group (if (eq gnus-keep-same-level 'best) (gnus-summary-best-group gnus-newsgroup-name) (gnus-summary-search-group backward gnus-keep-same-level)))) ;; For some reason, the group window gets selected. We change ;; it back. (select-window (get-buffer-window (current-buffer))) ;; Keep just the event type of CMD. ;(and (listp cmd) (setq cmd (car cmd))) ;; Select next unread newsgroup automagically. (cond ((not gnus-auto-select-next) (gnus-message 7 "No more%s articles" (if unread " unread" ""))) ((eq gnus-auto-select-next 'quietly) ;; Select quietly. (if (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-summary-exit) (gnus-message 7 "No more%s articles (%s)..." (if unread " unread" "") (if group (concat "selecting " group) "exiting")) (gnus-summary-next-group nil group backward))) (t (let ((keystrokes '(?\C-n ?\C-p)) key) (while (or (null key) (memq key keystrokes)) (gnus-message 7 "No more%s articles%s" (if unread " unread" "") (if (and group (not (gnus-ephemeral-group-p gnus-newsgroup-name))) (format " (Type %s for %s [%s])" (single-key-description cmd) group (car (gnus-gethash group gnus-newsrc-hashtb))) (format " (Type %s to exit %s)" (single-key-description cmd) gnus-newsgroup-name))) ;; Confirm auto selection. (let* ((event (read-char))) (setq key (if (listp event) (car event) event)) (if (memq key keystrokes) (let ((obuf (current-buffer))) (switch-to-buffer gnus-group-buffer) (and group (gnus-group-jump-to-group group)) (condition-case () (execute-kbd-macro (char-to-string key)) (error (ding) nil)) (setq group (gnus-group-group-name)) (switch-to-buffer obuf))))) (if (equal key cmd) (if (or (not group) (gnus-ephemeral-group-p gnus-newsgroup-name)) (gnus-summary-exit) (gnus-summary-next-group nil group backward)) (execute-kbd-macro (char-to-string key))))))))))) (defun gnus-summary-next-unread-article () "Select unread article after current one." (interactive) (gnus-summary-next-article t (and gnus-auto-select-same (gnus-summary-subject-string)))) (defun gnus-summary-prev-article (&optional unread subject) "Select the article after the current one. If UNREAD is non-nil, only unread articles are selected." (interactive "P") (gnus-summary-next-article unread subject t)) (defun gnus-summary-prev-unread-article () "Select unred article before current one." (interactive) (gnus-summary-prev-article t (and gnus-auto-select-same (gnus-summary-subject-string)))) (defun gnus-summary-next-page (&optional lines circular) "Show next page of selected article. If end of article, select next article. Argument LINES specifies lines to be scrolled up. If CIRCULAR is non-nil, go to the start of the article instead of instead of selecting the next article when reaching the end of the current article." (interactive "P") (setq gnus-summary-buffer (current-buffer)) (gnus-set-global-variables) (let ((article (gnus-summary-article-number)) (endp nil)) (gnus-configure-windows 'article) (if (or (null gnus-current-article) (null gnus-article-current) (/= article (cdr gnus-article-current)) (not (equal (car gnus-article-current) gnus-newsgroup-name))) ;; Selected subject is different from current article's. (gnus-summary-display-article article) (gnus-eval-in-buffer-window gnus-article-buffer (setq endp (gnus-article-next-page lines))) (if endp (cond (circular (gnus-summary-beginning-of-article)) (lines (gnus-message 3 "End of message")) ((null lines) (gnus-summary-next-unread-article))))) (gnus-summary-recenter) (gnus-summary-position-cursor))) (defun gnus-summary-prev-page (&optional lines) "Show previous page of selected article. Argument LINES specifies lines to be scrolled down." (interactive "P") (gnus-set-global-variables) (let ((article (gnus-summary-article-number))) (gnus-configure-windows 'article) (if (or (null gnus-current-article) (null gnus-article-current) (/= article (cdr gnus-article-current)) (not (equal (car gnus-article-current) gnus-newsgroup-name))) ;; Selected subject is different from current article's. (gnus-summary-display-article article) (gnus-summary-recenter) (gnus-eval-in-buffer-window gnus-article-buffer (gnus-article-prev-page lines)))) (gnus-summary-position-cursor)) (defun gnus-summary-scroll-up (lines) "Scroll up (or down) one line current article. Argument LINES specifies lines to be scrolled up (or down if negative)." (interactive "p") (gnus-set-global-variables) (gnus-configure-windows 'article) (or (gnus-summary-select-article nil nil 'pseudo) (gnus-eval-in-buffer-window gnus-article-buffer (cond ((> lines 0) (if (gnus-article-next-page lines) (gnus-message 3 "End of message"))) ((< lines 0) (gnus-article-prev-page (- lines)))))) (gnus-summary-recenter) (gnus-summary-position-cursor)) (defun gnus-summary-next-same-subject () "Select next article which has the same subject as current one." (interactive) (gnus-set-global-variables) (gnus-summary-next-article nil (gnus-summary-subject-string))) (defun gnus-summary-prev-same-subject () "Select previous article which has the same subject as current one." (interactive) (gnus-set-global-variables) (gnus-summary-prev-article nil (gnus-summary-subject-string))) (defun gnus-summary-next-unread-same-subject () "Select next unread article which has the same subject as current one." (interactive) (gnus-set-global-variables) (gnus-summary-next-article t (gnus-summary-subject-string))) (defun gnus-summary-prev-unread-same-subject () "Select previous unread article which has the same subject as current one." (interactive) (gnus-set-global-variables) (gnus-summary-prev-article t (gnus-summary-subject-string))) (defun gnus-summary-first-unread-article () "Select the first unread article. Return nil if there are no unread articles." (interactive) (gnus-set-global-variables) (prog1 (if (gnus-summary-first-subject t) (progn (gnus-summary-show-thread) (gnus-summary-first-subject t) (gnus-summary-display-article (gnus-summary-article-number)))) (gnus-summary-position-cursor))) (defun gnus-summary-best-unread-article () "Select the unread article with the highest score." (interactive) (gnus-set-global-variables) (let ((best -1000000) article score) (save-excursion (or (gnus-summary-first-subject t) (error "No unread articles")) (while (and (progn (and (> (setq score (gnus-summary-article-score)) best) (setq best score article (gnus-summary-article-number))) t) (gnus-summary-search-subject nil t)))) (if (not article) (error "No unread articles") (gnus-summary-goto-article article)) (gnus-summary-position-cursor))) (defun gnus-summary-goto-article (article &optional all-headers) "Fetch ARTICLE and display it if it exists. If ALL-HEADERS is non-nil, no header lines are hidden." (interactive (list (string-to-int (completing-read "Article number: " (mapcar (lambda (headers) (list (int-to-string (mail-header-number headers)))) gnus-newsgroup-headers) nil 'require-match)))) (prog1 (and (gnus-summary-goto-subject article) (gnus-summary-display-article article all-headers)) (gnus-summary-position-cursor))) (defun gnus-summary-goto-last-article () "Go to the previously read article." (interactive) (prog1 (and gnus-last-article (gnus-summary-goto-article gnus-last-article)) (gnus-summary-position-cursor))) (defun gnus-summary-pop-article (number) "Pop one article off the history and go to the previous. NUMBER articles will be popped off." (interactive "p") (let (to) (setq gnus-newsgroup-history (cdr (setq to (nthcdr number gnus-newsgroup-history)))) (if to (gnus-summary-goto-article (car to)) (error "Article history empty"))) (gnus-summary-position-cursor)) ;; Summary article oriented commands (defun gnus-summary-refer-parent-article (n) "Refer parent article N times. The difference between N and the number of articles fetched is returned." (interactive "p") (gnus-set-global-variables) (while (and (> n 0) (let ((ref (mail-header-references (gnus-get-header-by-num (gnus-summary-article-number))))) (if (and ref (not (equal ref "")) (string-match "<[^<>]*>[ \t]*$" ref)) (gnus-summary-refer-article (substring ref (match-beginning 0) (match-end 0))) (gnus-message 1 "No references in article %d" (gnus-summary-article-number)) nil))) (setq n (1- n))) (gnus-summary-position-cursor) n) (defun gnus-summary-refer-article (message-id) "Refer article specified by MESSAGE-ID. NOTE: This command only works with newsgroups that use real or simulated NNTP." (interactive "sMessage-ID: ") (if (or (not (stringp message-id)) (zerop (length message-id))) () ;; Construct the correct Message-ID if necessary. ;; Suggested by tale@pawl.rpi.edu. (or (string-match "^<" message-id) (setq message-id (concat "<" message-id))) (or (string-match ">$" message-id) (setq message-id (concat message-id ">"))) (let ((header (car (gnus-gethash (downcase message-id) gnus-newsgroup-dependencies)))) (if header (or (gnus-summary-goto-article (mail-header-number header)) ;; The header has been read, but the article had been ;; expunged, so we insert it again. (progn (gnus-summary-insert-line nil header 0 nil gnus-read-mark nil nil (mail-header-subject header)) (forward-line -1) (mail-header-number header))) (let ((gnus-override-method gnus-refer-article-method) (gnus-ancient-mark gnus-read-mark) (tmp-point (window-start (get-buffer-window gnus-article-buffer))) number tmp-buf) (and gnus-refer-article-method (gnus-check-server gnus-refer-article-method)) ;; Save the old article buffer. (save-excursion (set-buffer (gnus-article-setup-buffer)) (gnus-kill-buffer " *temp Article*") (setq tmp-buf (rename-buffer " *temp Article*"))) (prog1 (if (gnus-article-prepare message-id nil (gnus-read-header message-id)) (progn (setq number (mail-header-number gnus-current-headers)) (gnus-rebuild-thread message-id) (gnus-summary-goto-subject number) (if (null gnus-use-full-window) (progn (delete-windows-on tmp-buf) (gnus-configure-windows 'article 'force))) (gnus-summary-recenter) (gnus-article-set-window-start (cdr (assq number gnus-newsgroup-bookmarks))) (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook)) message-id) ;; We restore the old article buffer. (save-excursion (kill-buffer gnus-article-buffer) (set-buffer tmp-buf) (rename-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (and tmp-point (set-window-start (get-buffer-window (current-buffer)) tmp-point))))))))))) (defun gnus-summary-enter-digest-group () "Enter a digest group based on the current article." (interactive) (gnus-set-global-variables) (gnus-summary-select-article) ;; We do not want a narrowed article. (gnus-summary-stop-page-breaking) (let ((name (format "%s-%d" (gnus-group-prefixed-name gnus-newsgroup-name (list 'nndoc "")) gnus-current-article)) (ogroup gnus-newsgroup-name) (buf (current-buffer))) (if (gnus-group-read-ephemeral-group name (list 'nndoc name (list 'nndoc-address (get-buffer gnus-article-buffer)) '(nndoc-article-type digest)) t) (setcdr (nthcdr 4 (nth 2 (gnus-gethash name gnus-newsrc-hashtb))) (list (list (cons 'to-group ogroup)))) (switch-to-buffer buf) (gnus-set-global-variables) (gnus-configure-windows 'summary) (gnus-message 3 "Article not a digest?")))) (defun gnus-summary-isearch-article () "Do incremental search forward on current article." (interactive) (gnus-set-global-variables) (gnus-summary-select-article) (gnus-eval-in-buffer-window gnus-article-buffer (isearch-forward))) (defun gnus-summary-search-article-forward (regexp &optional backward) "Search for an article containing REGEXP forward. If BACKWARD, search backward instead." (interactive (list (read-string (format "Search article %s (regexp%s): " (if current-prefix-arg "backward" "forward") (if gnus-last-search-regexp (concat ", default " gnus-last-search-regexp) ""))) current-prefix-arg)) (gnus-set-global-variables) (if (string-equal regexp "") (setq regexp (or gnus-last-search-regexp "")) (setq gnus-last-search-regexp regexp)) (if (gnus-summary-search-article regexp backward) (gnus-article-set-window-start (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks))) (error "Search failed: \"%s\"" regexp))) (defun gnus-summary-search-article-backward (regexp) "Search for an article containing REGEXP backward." (interactive (list (read-string (format "Search article backward (regexp%s): " (if gnus-last-search-regexp (concat ", default " gnus-last-search-regexp) ""))))) (gnus-summary-search-article-forward regexp 'backward)) (defun gnus-summary-search-article (regexp &optional backward) "Search for an article containing REGEXP. Optional argument BACKWARD means do search for backward. gnus-select-article-hook is not called during the search." (let ((gnus-select-article-hook nil) ;Disable hook. (gnus-mark-article-hook nil) ;Inhibit marking as read. (re-search (if backward (function re-search-backward) (function re-search-forward))) (found nil) (last nil)) ;; Hidden thread subtrees must be searched for ,too. (gnus-summary-show-all-threads) (if (eobp) (forward-line -1)) ;; First of all, search current article. ;; We don't want to read article again from NNTP server nor reset ;; current point. (gnus-summary-select-article) (gnus-message 9 "Searching article: %d..." gnus-current-article) (setq last gnus-current-article) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) ;; Begin search from current point. (setq found (funcall re-search regexp nil t)))) ;; Then search next articles. (while (and (not found) (gnus-summary-display-article (gnus-summary-search-subject backward nil nil))) (gnus-message 9 "Searching article: %d..." gnus-current-article) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) (goto-char (if backward (point-max) (point-min))) (setq found (funcall re-search regexp nil t))))) (message "") ;; Adjust article pointer. (or (eq last gnus-current-article) (setq gnus-last-article last)) ;; Return T if found such article. found)) (defun gnus-summary-execute-command (header regexp command &optional backward) "Search forward for an article whose HEADER matches REGEXP and execute COMMAND. If HEADER is an empty string (or nil), the match is done on the entire article. If BACKWARD (the prefix) is non-nil, search backward instead." (interactive (list (let ((completion-ignore-case t)) (completing-read "Header name: " (mapcar (lambda (string) (list string)) '("Number" "Subject" "From" "Lines" "Date" "Message-ID" "Xref" "References")) nil 'require-match)) (read-string "Regexp: ") (read-key-sequence "Command: ") current-prefix-arg)) (gnus-set-global-variables) ;; Hidden thread subtrees must be searched as well. (gnus-summary-show-all-threads) ;; We don't want to change current point nor window configuration. (save-excursion (save-window-excursion (gnus-message 6 "Executing %s..." (key-description command)) ;; We'd like to execute COMMAND interactively so as to give arguments. (gnus-execute header regexp (` (lambda () (call-interactively '(, (key-binding command))))) backward) (gnus-message 6 "Executing %s...done" (key-description command))))) (defun gnus-summary-beginning-of-article () "Scroll the article back to the beginning." (interactive) (gnus-set-global-variables) (gnus-summary-select-article) (gnus-configure-windows 'article) (gnus-eval-in-buffer-window gnus-article-buffer (widen) (goto-char (point-min)) (and gnus-break-pages (gnus-narrow-to-page)))) (defun gnus-summary-end-of-article () "Scroll to the end of the article." (interactive) (gnus-set-global-variables) (gnus-summary-select-article) (gnus-configure-windows 'article) (gnus-eval-in-buffer-window gnus-article-buffer (widen) (goto-char (point-max)) (recenter -3) (and gnus-break-pages (gnus-narrow-to-page)))) (defun gnus-summary-show-article () "Force re-fetching of the current article." (interactive) (gnus-set-global-variables) (gnus-summary-select-article nil 'force) (gnus-configure-windows 'article) (gnus-summary-position-cursor)) (defun gnus-summary-verbose-headers (&optional arg) "Toggle permanent full header display. If ARG is a positive number, turn header display on. If ARG is a negative number, turn header display off." (interactive "P") (gnus-set-global-variables) (gnus-summary-toggle-header arg) (setq gnus-show-all-headers (cond ((or (not (numberp arg)) (zerop arg)) (not gnus-show-all-headers)) ((natnump arg) t)))) (defun gnus-summary-toggle-header (&optional arg) "Show the headers if they are hidden, or hide them if they are shown. If ARG is a positive number, show the entire header. If ARG is a negative number, hide the unwanted header lines." (interactive "P") (gnus-set-global-variables) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (if (numberp arg) (if (> arg 0) (remove-text-properties (point-min) (point-max) gnus-hidden-properties) (if (< arg 0) (run-hooks 'gnus-article-display-hook))) (if (text-property-any (point-min) (point-max) 'invisible t) (remove-text-properties (point-min) (point-max) gnus-hidden-properties) ;; We hide the headers. This song and dance act below is ;; done because `gnus-have-all-headers' is buffer-local to ;; the summary buffer, and we only want to temporarily ;; change it in that buffer. Ugh. (let ((have gnus-have-all-headers)) (save-excursion (set-buffer gnus-summary-buffer) (setq gnus-have-all-headers nil) (save-excursion (set-buffer gnus-article-buffer) (run-hooks 'gnus-article-display-hook)) (setq gnus-have-all-headers have))))) (set-window-point (get-buffer-window (current-buffer)) (point-min))))) (defun gnus-summary-show-all-headers () "Make all header lines visible." (interactive) (gnus-set-global-variables) (gnus-article-show-all-headers)) (defun gnus-summary-toggle-mime (&optional arg) "Toggle MIME processing. If ARG is a positive number, turn MIME processing on." (interactive "P") (gnus-set-global-variables) (setq gnus-show-mime (if (null arg) (not gnus-show-mime) (> (prefix-numeric-value arg) 0))) (gnus-summary-select-article t 'force)) (defun gnus-summary-caesar-message (&optional arg) "Caesar rotate the current article by 13. The numerical prefix specifies how manu places to rotate each letter forward." (interactive "P") (gnus-set-global-variables) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) (let ((start (window-start))) (news-caesar-buffer-body arg) (set-window-start (get-buffer-window (current-buffer)) start)))))) (defun gnus-summary-stop-page-breaking () "Stop page breaking in the current article." (interactive) (gnus-set-global-variables) (gnus-summary-select-article) (gnus-eval-in-buffer-window gnus-article-buffer (widen))) ;; Suggested by Brian Edmonds . (defun gnus-summary-move-article (&optional n to-newsgroup select-method) "Move the current article to a different newsgroup. If N is a positive number, move the N next articles. If N is a negative number, move the N previous articles. If N is nil and any articles have been marked with the process mark, move those articles instead. If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. If SELECT-METHOD is symbol, do not move to a specific newsgroup, but re-spool using this method. For this function to work, both the current newsgroup and the newsgroup that you want to move to have to support the `request-move' and `request-accept' functions. (Ie. mail newsgroups at present.)" (interactive "P") (gnus-set-global-variables) (or (gnus-check-backend-function 'request-move-article gnus-newsgroup-name) (error "The current newsgroup does not support article moving")) (let ((articles (gnus-summary-work-articles n)) (prefix (gnus-group-real-prefix gnus-newsgroup-name)) art-group to-method sel-met) (if (and (not to-newsgroup) (not select-method)) (setq to-newsgroup (completing-read (format "Where do you want to move %s? %s" (if (> (length articles) 1) (format "these %d articles" (length articles)) "this article") (if gnus-current-move-group (format "(%s default) " gnus-current-move-group) "")) gnus-active-hashtb nil nil prefix))) (if to-newsgroup (progn (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) (setq to-newsgroup (or gnus-current-move-group ""))) (or (gnus-gethash to-newsgroup gnus-active-hashtb) (gnus-activate-group to-newsgroup) (error "No such group: %s" to-newsgroup)) (setq gnus-current-move-group to-newsgroup))) (setq to-method (if select-method (list select-method "") (gnus-find-method-for-group to-newsgroup))) (or (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) (or (gnus-check-server to-method) (error "Can't open server %s" (car to-method))) (gnus-message 6 "Moving to %s: %s..." (or select-method to-newsgroup) articles) (while articles (if (setq art-group (gnus-request-move-article (car articles) ; Article to move gnus-newsgroup-name ; From newsgrouo (nth 1 (gnus-find-method-for-group gnus-newsgroup-name)) ; Server (list 'gnus-request-accept-article (if select-method (list 'quote select-method) to-newsgroup) (not (cdr articles))) ; Accept form (not (cdr articles)))) ; Only save nov last time (let* ((buffer-read-only nil) (entry (or (gnus-gethash (car art-group) gnus-newsrc-hashtb) (gnus-gethash (gnus-group-prefixed-name (car art-group) (if select-method (list select-method "") (gnus-find-method-for-group to-newsgroup))) gnus-newsrc-hashtb))) (info (nth 2 entry)) (article (car articles))) (gnus-summary-goto-subject article) (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point))) ;; Update the group that has been moved to. (if (not info) () ; This group does not exist yet. (if (not (memq article gnus-newsgroup-unreads)) (setcar (cdr (cdr info)) (gnus-add-to-range (nth 2 info) (list (cdr art-group))))) ;; Copy any marks over to the new group. (let ((marks '((tick . gnus-newsgroup-marked) (dormant . gnus-newsgroup-dormant) (expire . gnus-newsgroup-expirable) (bookmark . gnus-newsgroup-bookmarks) (reply . gnus-newsgroup-replied))) (to-article (cdr art-group))) (while marks (if (memq article (symbol-value (cdr (car marks)))) (gnus-add-marked-articles (car info) (car (car marks)) (list to-article) info)) (setq marks (cdr marks))))) ;; Update marks. (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (setq gnus-newsgroup-reads (cons (cons article gnus-canceled-mark) gnus-newsgroup-reads))) (gnus-message 1 "Couldn't move article %s" (car articles))) (gnus-summary-remove-process-mark (car articles)) (setq articles (cdr articles))) (gnus-set-mode-line 'summary))) (defun gnus-summary-respool-article (&optional n respool-method) "Respool the current article. The article will be squeezed through the mail spooling process again, which means that it will be put in some mail newsgroup or other depending on `nnmail-split-methods'. If N is a positive number, respool the N next articles. If N is a negative number, respool the N previous articles. If N is nil and any articles have been marked with the process mark, respool those articles instead. Respooling can be done both from mail groups and \"real\" newsgroups. In the former case, the articles in question will be moved from the current group into whatever groups they are destined to. In the latter case, they will be copied into the relevant groups." (interactive "P") (gnus-set-global-variables) (let ((respool-methods (gnus-methods-using 'respool)) (methname (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name))))) (or respool-method (setq respool-method (completing-read "What method do you want to use when respooling? " respool-methods nil t methname))) (or (string= respool-method "") (if (assoc (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name))) respool-methods) (gnus-summary-move-article n nil (intern respool-method)) (gnus-summary-copy-article n nil (intern respool-method)))))) ;; Suggested by gregj@unidata.com (Gregory J. Grubbs). (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Move the current article to a different newsgroup. If N is a positive number, move the N next articles. If N is a negative number, move the N previous articles. If N is nil and any articles have been marked with the process mark, move those articles instead. If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. If SELECT-METHOD is symbol, do not move to a specific newsgroup, but re-spool using this method. For this function to work, the newsgroup that you want to move to have to support the `request-move' and `request-accept' functions. (Ie. mail newsgroups at present.)" (interactive "P") (gnus-set-global-variables) (let ((articles (gnus-summary-work-articles n)) (copy-buf (get-buffer-create "*copy work*")) (prefix (gnus-group-real-prefix gnus-newsgroup-name)) art-group to-method) (buffer-disable-undo copy-buf) (if (and (not to-newsgroup) (not select-method)) (setq to-newsgroup (completing-read (format "Where do you want to copy %s? %s" (if (> (length articles) 1) (format "these %d articles" (length articles)) "this article") (if gnus-current-move-group (format "(%s default) " gnus-current-move-group) "")) gnus-active-hashtb nil nil prefix))) (if to-newsgroup (progn (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) (setq to-newsgroup (or gnus-current-move-group ""))) (or (gnus-gethash to-newsgroup gnus-active-hashtb) (gnus-activate-group to-newsgroup) (error "No such group: %s" to-newsgroup)) (setq gnus-current-move-group to-newsgroup))) (setq to-method (if select-method (list select-method "") (gnus-find-method-for-group to-newsgroup))) (or (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) (or (gnus-check-server to-method) (error "Can't open server %s" (car to-method))) (while articles (gnus-message 6 "Copying to %s: %s..." (or select-method to-newsgroup) articles) (if (setq art-group (save-excursion (set-buffer copy-buf) (gnus-request-article-this-buffer (car articles) gnus-newsgroup-name) (gnus-request-accept-article (if select-method (quote select-method) to-newsgroup) (not (cdr articles))))) (let* ((entry (or (gnus-gethash (car art-group) gnus-newsrc-hashtb) (gnus-gethash (gnus-group-prefixed-name (car art-group) (if select-method (list select-method "") (gnus-find-method-for-group to-newsgroup))) gnus-newsrc-hashtb))) (info (nth 2 entry)) (article (car articles))) ;; We copy the info over to the new group. (if (not info) () ; This group does not exist (yet). (if (not (memq article gnus-newsgroup-unreads)) (setcar (cdr (cdr info)) (gnus-add-to-range (nth 2 info) (list (cdr art-group))))) ;; Copy any marks over to the new group. (let ((marks '((tick . gnus-newsgroup-marked) (dormant . gnus-newsgroup-dormant) (expire . gnus-newsgroup-expirable) (bookmark . gnus-newsgroup-bookmarks) (reply . gnus-newsgroup-replied))) (to-article (cdr art-group))) (while marks (if (memq article (symbol-value (cdr (car marks)))) (gnus-add-marked-articles (car info) (car (car marks)) (list to-article) info)) (setq marks (cdr marks)))))) (gnus-message 1 "Couldn't copy article %s" (car articles))) (gnus-summary-remove-process-mark (car articles)) (setq articles (cdr articles))) (kill-buffer copy-buf))) (defun gnus-summary-import-article (file) "Import a random file into a mail newsgroup." (interactive "fImport file: ") (let ((group gnus-newsgroup-name) atts) (or (gnus-check-backend-function 'request-accept-article group) (error "%s does not support article importing" group)) (or (file-readable-p file) (not (file-regular-p file)) (error "Can't read %s" file)) (save-excursion (set-buffer (get-buffer-create " *import file*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert-file-contents file) (goto-char (point-min)) (if (nnheader-article-p) () (setq atts (file-attributes file)) (insert "From: " (read-string "From: ") "\n" "Subject: " (read-string "Subject: ") "\n" "Date: " (current-time-string (nth 5 atts)) "\n" "Chars: " (int-to-string (nth 7 atts)) "\n\n")) (gnus-request-accept-article group t) (kill-buffer (current-buffer))))) (defun gnus-summary-expire-articles () "Expire all articles that are marked as expirable in the current group." (interactive) (if (not (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name)) () (let* ((info (nth 2 (gnus-gethash gnus-newsgroup-name gnus-newsrc-hashtb))) (total (memq 'total-expire (nth 5 info))) (expirable (if total (gnus-list-of-read-articles gnus-newsgroup-name) (setq gnus-newsgroup-expirable (sort gnus-newsgroup-expirable '<)))) es) (if (not expirable) () (gnus-message 6 "Expiring articles...") ;; The list of articles that weren't expired is returned. (setq es (gnus-request-expire-articles expirable gnus-newsgroup-name)) (or total (setq gnus-newsgroup-expirable es)) ;; We go through the old list of expirable, and mark all ;; really expired articles as non-existant. (or (eq es expirable) ;If nothing was expired, we don't mark. (let ((gnus-use-cache nil)) (while expirable (or (memq (car expirable) es) (gnus-summary-mark-article (car expirable) gnus-canceled-mark)) (setq expirable (cdr expirable))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () "Expunge all expirable articles in the current group. This means that *all* articles that are marked as expirable will be deleted forever, right now." (interactive) (or gnus-expert-user (gnus-y-or-n-p "Are you really, really, really sure you want to expunge? ") (error "Phew!")) (let ((nnmail-expiry-wait -1) (nnmail-expiry-wait-function nil)) (gnus-summary-expire-articles))) ;; Suggested by Jack Vinson . (defun gnus-summary-delete-article (&optional n) "Delete the N next (mail) articles. This command actually deletes articles. This is not a marking command. The article will disappear forever from you life, never to return. If N is negative, delete backwards. If N is nil and articles have been marked with the process mark, delete these instead." (interactive "P") (or (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) (error "The current newsgroup does not support article deletion.")) ;; Compute the list of articles to delete. (let ((articles (gnus-summary-work-articles n)) not-deleted) (if (and gnus-novice-user (not (gnus-y-or-n-p (format "Do you really want to delete %s forever? " (if (> (length articles) 1) "these articles" "this article"))))) () ;; Delete the articles. (setq not-deleted (gnus-request-expire-articles articles gnus-newsgroup-name 'force)) (while articles (gnus-summary-remove-process-mark (car articles)) ;; The backend might not have been able to delete the article ;; after all. (or (memq (car articles) not-deleted) (gnus-summary-mark-article (car articles) gnus-canceled-mark)) (setq articles (cdr articles)))) (gnus-summary-position-cursor) (gnus-set-mode-line 'summary) not-deleted)) (defun gnus-summary-edit-article (&optional force) "Enter into a buffer and edit the current article. This will have permanent effect only in mail groups. If FORCE is non-nil, allow editing of articles even in read-only groups." (interactive "P") (or force (not (gnus-group-read-only-p)) (error "The current newsgroup does not support article editing.")) (gnus-summary-select-article t) (gnus-configure-windows 'article) (select-window (get-buffer-window gnus-article-buffer)) (gnus-message 6 "C-c C-c to end edits") (setq buffer-read-only nil) (text-mode) (use-local-map (copy-keymap (current-local-map))) (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) (buffer-enable-undo) (widen) (goto-char (point-min)) (search-forward "\n\n" nil t)) (defun gnus-summary-edit-article-done () "Make edits to the current article permanent." (interactive) (if (gnus-group-read-only-p) (progn (gnus-summary-edit-article-postpone) (message "The current newsgroup does not support article editing.") (ding)) (let ((buf (buffer-substring-no-properties (point-min) (point-max)))) (erase-buffer) (insert buf) (if (not (gnus-request-replace-article (cdr gnus-article-current) (car gnus-article-current) (current-buffer))) (error "Couldn't replace article.") (gnus-article-mode) (use-local-map gnus-article-mode-map) (setq buffer-read-only t) (buffer-disable-undo (current-buffer)) (gnus-configure-windows 'summary)) (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook))))) (defun gnus-summary-edit-article-postpone () "Postpone changes to the current article." (interactive) (gnus-article-mode) (use-local-map gnus-article-mode-map) (setq buffer-read-only t) (buffer-disable-undo (current-buffer)) (gnus-configure-windows 'summary) (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook))) (defun gnus-summary-fancy-query () "Query where the fancy respool algorithm would put this article." (interactive) (gnus-summary-select-article) (save-excursion (set-buffer gnus-article-buffer) (save-restriction (goto-char (point-min)) (search-forward "\n\n") (narrow-to-region (point-min) (point)) (pp-eval-expression (list 'quote (nnmail-split-fancy)))))) ;; Summary score commands. ;; Suggested by boubaker@cenatls.cena.dgac.fr. (defun gnus-summary-raise-score (n) "Raise the score of the current article by N." (interactive "p") (gnus-summary-set-score (+ (gnus-summary-article-score) n))) (defun gnus-summary-set-score (n) "Set the score of the current article to N." (interactive "p") ;; Skip dummy header line. (save-excursion (gnus-summary-show-thread) (if (eq (gnus-summary-article-mark) gnus-dummy-mark) (forward-line 1)) (let ((buffer-read-only nil)) ;; Set score. (gnus-summary-update-mark (if (= n (or gnus-summary-default-score 0)) ? (if (< n (or gnus-summary-default-score 0)) gnus-score-below-mark gnus-score-over-mark)) 'score)) (let* ((article (gnus-summary-article-number)) (score (assq article gnus-newsgroup-scored))) (if score (setcdr score n) (setq gnus-newsgroup-scored (cons (cons article n) gnus-newsgroup-scored)))) (gnus-summary-update-line))) (defun gnus-summary-current-score () "Return the score of the current article." (interactive) (message "%s" (gnus-summary-article-score))) ;; Summary marking commands. (defun gnus-summary-raise-same-subject-and-select (score) "Raise articles which has the same subject with SCORE and select the next." (interactive "p") (let ((subject (gnus-summary-subject-string))) (gnus-summary-raise-score score) (while (gnus-summary-search-subject nil nil subject) (gnus-summary-raise-score score)) (gnus-summary-next-article t))) (defun gnus-summary-raise-same-subject (score) "Raise articles which has the same subject with SCORE." (interactive "p") (let ((subject (gnus-summary-subject-string))) (gnus-summary-raise-score score) (while (gnus-summary-search-subject nil nil subject) (gnus-summary-raise-score score)) (gnus-summary-next-subject 1 t))) (defun gnus-score-default (level) (if level (prefix-numeric-value level) gnus-score-interactive-default-score)) (defun gnus-summary-raise-thread (&optional score) "Raise the score of the articles in the current thread with SCORE." (interactive "P") (setq score (gnus-score-default score)) (let (e) (save-excursion (let ((level (gnus-summary-thread-level))) (gnus-summary-raise-score score) (while (and (zerop (gnus-summary-next-subject 1 nil t)) (> (gnus-summary-thread-level) level)) (gnus-summary-raise-score score)) (setq e (point)))) (let ((gnus-summary-check-current t)) (or (zerop (gnus-summary-next-subject 1 t)) (goto-char e)))) (gnus-summary-recenter) (gnus-summary-position-cursor) (gnus-set-mode-line 'summary)) (defun gnus-summary-lower-same-subject-and-select (score) "Raise articles which has the same subject with SCORE and select the next." (interactive "p") (gnus-summary-raise-same-subject-and-select (- score))) (defun gnus-summary-lower-same-subject (score) "Raise articles which has the same subject with SCORE." (interactive "p") (gnus-summary-raise-same-subject (- score))) (defun gnus-summary-lower-thread (&optional score) "Lower score of articles in the current thread with SCORE." (interactive "P") (gnus-summary-raise-thread (- (1- (gnus-score-default score))))) (defun gnus-summary-kill-same-subject-and-select (&optional unmark) "Mark articles which has the same subject as read, and then select the next. If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles." (interactive "P") (if unmark (setq unmark (prefix-numeric-value unmark))) (let ((count (gnus-summary-mark-same-subject (gnus-summary-subject-string) unmark))) ;; Select next unread article. If auto-select-same mode, should ;; select the first unread article. (gnus-summary-next-article t (and gnus-auto-select-same (gnus-summary-subject-string))) (gnus-message 7 "%d article%s marked as %s" count (if (= count 1) " is" "s are") (if unmark "unread" "read")))) (defun gnus-summary-kill-same-subject (&optional unmark) "Mark articles which has the same subject as read. If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles." (interactive "P") (if unmark (setq unmark (prefix-numeric-value unmark))) (let ((count (gnus-summary-mark-same-subject (gnus-summary-subject-string) unmark))) ;; If marked as read, go to next unread subject. (if (null unmark) ;; Go to next unread subject. (gnus-summary-next-subject 1 t)) (gnus-message 7 "%d articles are marked as %s" count (if unmark "unread" "read")))) (defun gnus-summary-mark-same-subject (subject &optional unmark) "Mark articles with same SUBJECT as read, and return marked number. If optional argument UNMARK is positive, remove any kinds of marks. If optional argument UNMARK is negative, mark articles as unread instead." (let ((count 1)) (save-excursion (cond ((null unmark) ; Mark as read. (while (and (progn (gnus-summary-mark-article-as-read gnus-killed-mark) (gnus-summary-show-thread) t) (gnus-summary-search-forward nil subject)) (setq count (1+ count)))) ((> unmark 0) ; Tick. (while (and (progn (gnus-summary-mark-article-as-unread gnus-ticked-mark) (gnus-summary-show-thread) t) (gnus-summary-search-forward nil subject)) (setq count (1+ count)))) (t ; Mark as unread. (while (and (progn (gnus-summary-mark-article-as-unread gnus-unread-mark) (gnus-summary-show-thread) t) (gnus-summary-search-forward nil subject)) (setq count (1+ count))))) (gnus-set-mode-line 'summary) ;; Return the number of marked articles. count))) (defun gnus-summary-mark-as-processable (n &optional unmark) "Set the process mark on the next N articles. If N is negative, mark backward instead. If UNMARK is non-nil, remove the process mark instead. The difference between N and the actual number of articles marked is returned." (interactive "p") (let ((backward (< n 0)) (n (abs n))) (while (and (> n 0) (if unmark (gnus-summary-remove-process-mark (gnus-summary-article-number)) (gnus-summary-set-process-mark (gnus-summary-article-number))) (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) (setq n (1- n))) (if (/= 0 n) (gnus-message 7 "No more articles")) (gnus-summary-recenter) (gnus-summary-position-cursor) n)) (defun gnus-summary-unmark-as-processable (n) "Remove the process mark from the next N articles. If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned." (interactive "p") (gnus-summary-mark-as-processable n t)) (defun gnus-summary-unmark-all-processable () "Remove the process mark from all articles." (interactive) (save-excursion (while gnus-newsgroup-processable (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) (gnus-summary-position-cursor)) (defun gnus-summary-mark-as-expirable (n) "Mark N articles forward as expirable. If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned." (interactive "p") (gnus-summary-mark-forward n gnus-expirable-mark)) (defun gnus-summary-mark-article-as-replied (article) "Mark ARTICLE replied and update the summary line." (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied)) (let ((buffer-read-only nil)) (if (gnus-summary-goto-subject article) (progn (gnus-summary-update-mark gnus-replied-mark 'replied) t)))) (defun gnus-summary-set-bookmark (article) "Set a bookmark in current article." (interactive (list (gnus-summary-article-number))) (if (or (not (get-buffer gnus-article-buffer)) (not gnus-current-article) (not gnus-article-current) (not (equal gnus-newsgroup-name (car gnus-article-current)))) (error "No current article selected")) ;; Remove old bookmark, if one exists. (let ((old (assq article gnus-newsgroup-bookmarks))) (if old (setq gnus-newsgroup-bookmarks (delq old gnus-newsgroup-bookmarks)))) ;; Set the new bookmark, which is on the form ;; (article-number . line-number-in-body). (setq gnus-newsgroup-bookmarks (cons (cons article (save-excursion (set-buffer gnus-article-buffer) (count-lines (min (point) (save-excursion (goto-char (point-min)) (search-forward "\n\n" nil t) (point))) (point)))) gnus-newsgroup-bookmarks)) (gnus-message 6 "A bookmark has been added to the current article.")) (defun gnus-summary-remove-bookmark (article) "Remove the bookmark from the current article." (interactive (list (gnus-summary-article-number))) ;; Remove old bookmark, if one exists. (let ((old (assq article gnus-newsgroup-bookmarks))) (if old (progn (setq gnus-newsgroup-bookmarks (delq old gnus-newsgroup-bookmarks)) (gnus-message 6 "Removed bookmark.")) (gnus-message 6 "No bookmark in current article.")))) ;; Suggested by Daniel Quinlan . (defun gnus-summary-mark-as-dormant (n) "Mark N articles forward as dormant. If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned." (interactive "p") (gnus-summary-mark-forward n gnus-dormant-mark)) (defun gnus-summary-set-process-mark (article) "Set the process mark on ARTICLE and update the summary line." (setq gnus-newsgroup-processable (cons article gnus-newsgroup-processable)) (let ((buffer-read-only nil)) (if (gnus-summary-goto-subject article) (progn (gnus-summary-show-thread) (and (eq (gnus-summary-article-mark) gnus-dummy-mark) (forward-line 1)) (gnus-summary-update-mark gnus-process-mark 'replied) t)))) (defun gnus-summary-remove-process-mark (article) "Remove the process mark from ARTICLE and update the summary line." (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) (let ((buffer-read-only nil)) (if (gnus-summary-goto-subject article) (progn (gnus-summary-show-thread) (and (eq (gnus-summary-article-mark) gnus-dummy-mark) (forward-line 1)) (gnus-summary-update-mark ? 'replied) (if (memq article gnus-newsgroup-replied) (gnus-summary-update-mark gnus-replied-mark 'replied)) t)))) (defun gnus-summary-mark-forward (n &optional mark no-expire) "Mark N articles as read forwards. If N is negative, mark backwards instead. Mark with MARK. If MARK is ? , ?! or ??, articles will be marked as unread. The difference between N and the actual number of articles marked is returned." (interactive "p") (gnus-set-global-variables) (let ((backward (< n 0)) (gnus-summary-goto-unread (and gnus-summary-goto-unread (not (memq mark (list gnus-unread-mark gnus-ticked-mark gnus-dormant-mark))))) (n (abs n)) (mark (or mark gnus-del-mark))) (while (and (> n 0) (gnus-summary-mark-article nil mark no-expire) (zerop (gnus-summary-next-subject (if backward -1 1) gnus-summary-goto-unread t))) (setq n (1- n))) (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) (gnus-summary-recenter) (gnus-summary-position-cursor) (gnus-set-mode-line 'summary) n)) (defun gnus-summary-mark-article-as-read (mark) "Mark the current article quickly as read with MARK." (let ((article (gnus-summary-article-number))) (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (setq gnus-newsgroup-reads (cons (cons article mark) gnus-newsgroup-reads)) ;; Possibly remove from cache, if that is used. (and gnus-use-cache (gnus-cache-enter-remove-article article)) (and gnus-newsgroup-auto-expire (or (= mark gnus-killed-mark) (= mark gnus-del-mark) (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) (= mark gnus-read-mark)) (progn (setq mark gnus-expirable-mark) (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable)))) (while (eq (gnus-summary-article-mark) gnus-dummy-mark) (forward-line 1)) ;; Fix the mark. (gnus-summary-update-mark mark 'unread) t)) (defun gnus-summary-mark-article-as-unread (mark) "Mark the current article quickly as unread with MARK." (let ((article (gnus-summary-article-number))) (or (memq article gnus-newsgroup-unreads) (setq gnus-newsgroup-unreads (cons article gnus-newsgroup-unreads))) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) (setq gnus-newsgroup-reads (delq (assq article gnus-newsgroup-reads) gnus-newsgroup-reads)) (if (= mark gnus-ticked-mark) (setq gnus-newsgroup-marked (cons article gnus-newsgroup-marked))) (if (= mark gnus-dormant-mark) (setq gnus-newsgroup-dormant (cons article gnus-newsgroup-dormant))) ;; See whether the article is to be put in the cache. (and gnus-use-cache (vectorp (gnus-get-header-by-num article)) (save-excursion (gnus-cache-possibly-enter-article gnus-newsgroup-name article (gnus-get-header-by-num article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) (while (eq (gnus-summary-article-mark) gnus-dummy-mark) (forward-line 1)) ;; Fix the mark. (gnus-summary-update-mark mark 'unread) t)) (defun gnus-summary-mark-article (&optional article mark no-expire) "Mark ARTICLE with MARK. MARK can be any character. Four MARK strings are reserved: `? ' (unread), `?!' (ticked), `??' (dormant) and `?E' (expirable). If MARK is nil, then the default character `?D' is used. If ARTICLE is nil, then the article on the current line will be marked." (and (stringp mark) (setq mark (aref mark 0))) ;; If no mark is given, then we check auto-expiring. (and (not no-expire) gnus-newsgroup-auto-expire (or (not mark) (and (numberp mark) (or (= mark gnus-killed-mark) (= mark gnus-del-mark) (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) (= mark gnus-read-mark)))) (setq mark gnus-expirable-mark)) (let* ((mark (or mark gnus-del-mark)) (article (or article (gnus-summary-article-number)))) (or article (error "No article on current line")) (if (or (= mark gnus-unread-mark) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)) (gnus-mark-article-as-unread article mark) (gnus-mark-article-as-read article mark)) ;; See whether the article is to be put in the cache. (and gnus-use-cache (not (= mark gnus-canceled-mark)) (vectorp (gnus-get-header-by-num article)) (save-excursion (gnus-cache-possibly-enter-article gnus-newsgroup-name article (gnus-get-header-by-num article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) (if (gnus-summary-goto-subject article) (let ((buffer-read-only nil)) (gnus-summary-show-thread) (and (eq (gnus-summary-article-mark) gnus-dummy-mark) (forward-line 1)) ;; Fix the mark. (gnus-summary-update-mark mark 'unread) t)))) (defun gnus-summary-update-mark (mark type) (beginning-of-line) (let ((forward (cdr (assq type gnus-summary-mark-positions))) (buffer-read-only nil) plist) (if (not forward) () (forward-char forward) (setq plist (text-properties-at (point))) (delete-char 1) (insert mark) (and plist (add-text-properties (1- (point)) (point) plist)) (and (eq type 'unread) (progn (add-text-properties (1- (point)) (point) (list 'gnus-mark mark)) (gnus-summary-update-line (eq mark gnus-unread-mark))))))) (defun gnus-mark-article-as-read (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." ;; Make the article expirable. (let ((mark (or mark gnus-del-mark))) (if (= mark gnus-expirable-mark) (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable)) (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))) ;; Remove from unread and marked lists. (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (setq gnus-newsgroup-reads (cons (cons article mark) gnus-newsgroup-reads)) ;; Possibly remove from cache, if that is used. (and gnus-use-cache (gnus-cache-enter-remove-article article)))) (defun gnus-mark-article-as-unread (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." (let ((mark (or mark gnus-ticked-mark))) ;; Add to unread list. (or (memq article gnus-newsgroup-unreads) (setq gnus-newsgroup-unreads (cons article gnus-newsgroup-unreads))) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) (setq gnus-newsgroup-reads (delq (assq article gnus-newsgroup-reads) gnus-newsgroup-reads)) (if (= mark gnus-ticked-mark) (setq gnus-newsgroup-marked (cons article gnus-newsgroup-marked))) (if (= mark gnus-dormant-mark) (setq gnus-newsgroup-dormant (cons article gnus-newsgroup-dormant))))) (defalias 'gnus-summary-mark-as-unread-forward 'gnus-summary-tick-article-forward) (make-obsolete 'gnus-summary-mark-as-unread-forward 'gnus-summary-tick-article-forward) (defun gnus-summary-tick-article-forward (n) "Tick N articles forwards. If N is negative, tick backwards instead. The difference between N and the number of articles ticked is returned." (interactive "p") (gnus-summary-mark-forward n gnus-ticked-mark)) (defalias 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward) (make-obsolete 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward) (defun gnus-summary-tick-article-backward (n) "Tick N articles backwards. The difference between N and the number of articles ticked is returned." (interactive "p") (gnus-summary-mark-forward (- n) gnus-ticked-mark)) (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) (defun gnus-summary-tick-article (&optional article clear-mark) "Mark current article as unread. Optional 1st argument ARTICLE specifies article number to be marked as unread. Optional 2nd argument CLEAR-MARK remove any kinds of mark." (gnus-summary-mark-article article (if clear-mark gnus-unread-mark gnus-ticked-mark))) (defun gnus-summary-mark-as-read-forward (n) "Mark N articles as read forwards. If N is negative, mark backwards instead. The difference between N and the actual number of articles marked is returned." (interactive "p") (gnus-summary-mark-forward n gnus-del-mark t)) (defun gnus-summary-mark-as-read-backward (n) "Mark the N articles as read backwards. The difference between N and the actual number of articles marked is returned." (interactive "p") (gnus-summary-mark-forward (- n) gnus-del-mark t)) (defun gnus-summary-mark-as-read (&optional article mark) "Mark current article as read. ARTICLE specifies the article to be marked as read. MARK specifies a string to be inserted at the beginning of the line." (gnus-summary-mark-article article mark)) (defun gnus-summary-clear-mark-forward (n) "Clear marks from N articles forward. If N is negative, clear backward instead. The difference between N and the number of marks cleared is returned." (interactive "p") (gnus-summary-mark-forward n gnus-unread-mark)) (defun gnus-summary-clear-mark-backward (n) "Clear marks from N articles backward. The difference between N and the number of marks cleared is returned." (interactive "p") (gnus-summary-mark-forward (- n) gnus-unread-mark)) (defun gnus-summary-mark-unread-as-read () "Intended to be used by `gnus-summary-mark-article-hook'." (or (memq gnus-current-article gnus-newsgroup-marked) (memq gnus-current-article gnus-newsgroup-dormant) (memq gnus-current-article gnus-newsgroup-expirable) (gnus-summary-mark-article gnus-current-article gnus-read-mark))) (defun gnus-summary-mark-region-as-read (point mark all) "Mark all unread articles between point and mark as read. If given a prefix, mark all articles between point and mark as read, even ticked and dormant ones." (interactive "r\nP") (save-excursion (goto-char point) (beginning-of-line) (while (and (< (point) mark) (progn (and (or all (and (not (memq (gnus-summary-article-number) gnus-newsgroup-marked)) (not (memq (gnus-summary-article-number) gnus-newsgroup-dormant)))) (gnus-summary-mark-article (gnus-summary-article-number) gnus-del-mark)) t) (zerop (forward-line 1)))))) ;; Fix by Per Abrahamsen . (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-remove-lines-marked-as-read) (make-obsolete 'gnus-summary-delete-marked-as-read 'gnus-summary-remove-lines-marked-as-read) (defun gnus-summary-remove-lines-marked-as-read () "Remove lines that are marked as read." (interactive) (gnus-summary-remove-lines-marked-with (concat (mapconcat (lambda (char) (char-to-string (symbol-value char))) '(gnus-del-mark gnus-read-mark gnus-ancient-mark gnus-killed-mark gnus-kill-file-mark gnus-low-score-mark gnus-expirable-mark gnus-canceled-mark gnus-catchup-mark) "")))) (defalias 'gnus-summary-delete-marked-with 'gnus-summary-remove-lines-marked-with) (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-remove-lines-marked-with) ;; Rewrite by Daniel Quinlan . (defun gnus-summary-remove-lines-marked-with (marks) "Remove lines that are marked with MARKS (e.g. \"DK\")." (interactive "sMarks: ") ;; Fix by Sudish Joseph . (gnus-set-global-variables) (let ((buffer-read-only nil) (orig-article (gnus-summary-article-number)) (marks (concat "^[" marks "]"))) (goto-char (point-min)) (if gnus-newsgroup-adaptive (gnus-score-remove-lines-adaptive marks) (while (re-search-forward marks nil t) (gnus-delete-line))) ;; If we use dummy roots, we have to do an additional sweep over ;; the buffer. (if (not (eq gnus-summary-make-false-root 'dummy)) () (goto-char (point-min)) (setq marks (concat "^[" (char-to-string gnus-dummy-mark) "]")) (while (re-search-forward marks nil t) (if (gnus-subject-equal (gnus-summary-subject-string) (progn (forward-line 1) (gnus-summary-subject-string))) () (forward-line -1) (gnus-delete-line)))) (or (zerop (buffer-size)) (gnus-summary-goto-subject orig-article) (if (eobp) (gnus-summary-prev-subject 1) (gnus-summary-position-cursor))))) (defun gnus-summary-expunge-below (&optional score) "Remove articles with score less than SCORE." (interactive "P") (gnus-set-global-variables) (setq score (if score (prefix-numeric-value score) (or gnus-summary-default-score 0))) (save-excursion (set-buffer gnus-summary-buffer) (goto-char (point-min)) (let ((buffer-read-only nil) beg) (while (not (eobp)) (if (< (gnus-summary-article-score) score) (progn (setq beg (point)) (forward-line 1) (delete-region beg (point))) (forward-line 1))) ;; Adjust point. (or (zerop (buffer-size)) (if (eobp) (gnus-summary-prev-subject 1) (gnus-summary-position-cursor)))))) (defun gnus-summary-mark-below (score mark) "Mark articles with score less than SCORE with MARK." (interactive "P\ncMark: ") (gnus-set-global-variables) (setq score (if score (prefix-numeric-value score) (or gnus-summary-default-score 0))) (save-excursion (set-buffer gnus-summary-buffer) (goto-char (point-min)) (while (not (eobp)) (and (< (gnus-summary-article-score) score) (gnus-summary-mark-article nil mark)) (forward-line 1)))) (defun gnus-summary-kill-below (&optional score) "Mark articles with score below SCORE as read." (interactive "P") (gnus-set-global-variables) (gnus-summary-mark-below score gnus-killed-mark)) (defun gnus-summary-clear-above (&optional score) "Clear all marks from articles with score above SCORE." (interactive "P") (gnus-set-global-variables) (gnus-summary-mark-above score gnus-unread-mark)) (defun gnus-summary-tick-above (&optional score) "Tick all articles with score above SCORE." (interactive "P") (gnus-set-global-variables) (gnus-summary-mark-above score gnus-ticked-mark)) (defun gnus-summary-mark-above (score mark) "Mark articles with score over SCORE with MARK." (interactive "P\ncMark: ") (gnus-set-global-variables) (setq score (if score (prefix-numeric-value score) (or gnus-summary-default-score 0))) (save-excursion (set-buffer gnus-summary-buffer) (goto-char (point-min)) (while (not (eobp)) (if (> (gnus-summary-article-score) score) (progn (gnus-summary-mark-article nil mark) (forward-line 1)) (forward-line 1))))) ;; Suggested by Daniel Quinlan . (defun gnus-summary-show-all-expunged () "Display all the hidden articles that were expunged for low scores." (interactive) (gnus-set-global-variables) (let ((buffer-read-only nil)) (let ((scored gnus-newsgroup-scored) headers h) (while scored (or (gnus-summary-goto-subject (car (car scored))) (and (setq h (gnus-get-header-by-num (car (car scored)))) (< (cdr (car scored)) gnus-summary-expunge-below) (setq headers (cons h headers)))) (setq scored (cdr scored))) (or headers (error "No expunged articles hidden.")) (goto-char (point-min)) (save-excursion (gnus-summary-update-lines (point) (progn (gnus-summary-prepare-unthreaded (nreverse headers)) (point))))) (goto-char (point-min)) (gnus-summary-position-cursor))) (defun gnus-summary-show-all-dormant () "Display all the hidden articles that are marked as dormant." (interactive) (gnus-set-global-variables) (let ((buffer-read-only nil)) (let ((dormant gnus-newsgroup-dormant) headers h) (while dormant (or (gnus-summary-goto-subject (car dormant)) (and (setq h (gnus-get-header-by-num (car dormant))) (setq headers (cons h headers)))) (setq dormant (cdr dormant))) (or headers (error "No dormant articles hidden.")) (goto-char (point-min)) (save-excursion (gnus-summary-update-lines (point) (progn (gnus-summary-prepare-unthreaded (nreverse headers)) (point))))) (goto-char (point-min)) (gnus-summary-position-cursor))) (defun gnus-summary-hide-all-dormant () "Hide all dormant articles." (interactive) (gnus-set-global-variables) (gnus-summary-remove-lines-marked-with (char-to-string gnus-dormant-mark)) (gnus-summary-position-cursor)) (defun gnus-summary-catchup (&optional all quietly to-here not-mark) "Mark all articles not marked as unread in this newsgroup as read. If prefix argument ALL is non-nil, all articles are marked as read. If QUIETLY is non-nil, no questions will be asked. If TO-HERE is non-nil, it should be a point in the buffer. All articles before this point will be marked as read. The number of articles marked as read is returned." (interactive "P") (gnus-set-global-variables) (prog1 (if (or quietly (not gnus-interactive-catchup) ;Without confirmation? gnus-expert-user (gnus-y-or-n-p (if all "Mark absolutely all articles as read? " "Mark all unread articles as read? "))) (if (and not-mark (not gnus-newsgroup-adaptive) (not gnus-newsgroup-auto-expire)) (progn (and all (setq gnus-newsgroup-marked nil gnus-newsgroup-dormant nil)) (setq gnus-newsgroup-unreads (append gnus-newsgroup-marked gnus-newsgroup-dormant))) ;; We actually mark all articles as canceled, which we ;; have to do when using auto-expiry or adaptive scoring. (gnus-summary-show-all-threads) (if (gnus-summary-first-subject (not all)) (while (and (if to-here (< (point) to-here) t) (gnus-summary-mark-article-as-read gnus-catchup-mark) (gnus-summary-search-subject nil (not all))))) (or to-here (setq gnus-newsgroup-unreads (append gnus-newsgroup-marked gnus-newsgroup-dormant))))) (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) (if (and (not to-here) (eq 'nnvirtual (car method))) (nnvirtual-catchup-group (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all))) (gnus-summary-position-cursor))) (defun gnus-summary-catchup-to-here (&optional all) "Mark all unticked articles before the current one as read. If ALL is non-nil, also mark ticked and dormant articles as read." (interactive "P") (gnus-set-global-variables) (save-excursion (and (zerop (forward-line -1)) (progn (end-of-line) (gnus-summary-catchup all t (point)) (gnus-set-mode-line 'summary)))) (gnus-summary-position-cursor)) (defun gnus-summary-catchup-all (&optional quietly) "Mark all articles in this newsgroup as read." (interactive "P") (gnus-set-global-variables) (gnus-summary-catchup t quietly)) (defun gnus-summary-catchup-and-exit (&optional all quietly) "Mark all articles not marked as unread in this newsgroup as read, then exit. If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") (gnus-set-global-variables) (gnus-summary-catchup all quietly nil 'fast) ;; Select next newsgroup or exit. (if (and (eq gnus-auto-select-next 'quietly) (not (gnus-ephemeral-group-p gnus-newsgroup-name))) (gnus-summary-next-group nil) (gnus-summary-exit))) (defun gnus-summary-catchup-all-and-exit (&optional quietly) "Mark all articles in this newsgroup as read, and then exit." (interactive "P") (gnus-set-global-variables) (gnus-summary-catchup-and-exit t quietly)) ;; Suggested by "Arne Eofsson" . (defun gnus-summary-catchup-and-goto-next-group (&optional all) "Mark all articles in this group as read and select the next group. If given a prefix, mark all articles, unread as well as ticked, as read." (interactive "P") (gnus-set-global-variables) (gnus-summary-catchup all) (gnus-summary-next-group)) ;; Thread-based commands. (defun gnus-summary-toggle-threads (&optional arg) "Toggle showing conversation threads. If ARG is positive number, turn showing conversation threads on." (interactive "P") (gnus-set-global-variables) (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end))) (setq gnus-show-threads (if (null arg) (not gnus-show-threads) (> (prefix-numeric-value arg) 0))) (gnus-summary-prepare) (gnus-summary-goto-subject current) (gnus-summary-position-cursor))) (defun gnus-summary-show-all-threads () "Show all threads." (interactive) (gnus-set-global-variables) (save-excursion (let ((buffer-read-only nil)) (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))) (gnus-summary-position-cursor)) (defun gnus-summary-show-thread () "Show thread subtrees. Returns nil if no thread was there to be shown." (interactive) (gnus-set-global-variables) (let ((buffer-read-only nil) (orig (prog1 (point) (gnus-summary-hide-thread))) ;; first goto end then to beg, to have point at beg after let (end (progn (end-of-line) (point))) (beg (progn (beginning-of-line) (point)))) (prog1 ;; Any hidden lines here? (search-forward "\r" end t) (subst-char-in-region beg end ?\^M ?\n t) (goto-char orig) (gnus-summary-position-cursor)))) (defun gnus-summary-hide-all-threads () "Hide all thread subtrees." (interactive) (gnus-set-global-variables) (save-excursion (goto-char (point-min)) (gnus-summary-hide-thread) (while (and (not (eobp)) (zerop (forward-line 1))) (gnus-summary-hide-thread))) (gnus-summary-position-cursor)) (defun gnus-summary-hide-thread () "Hide thread subtrees. Returns nil if no threads were there to be hidden." (interactive) (gnus-set-global-variables) (let ((buffer-read-only nil) (start (point)) (level (gnus-summary-thread-level)) (end (point))) ;; Go forward until either the buffer ends or the subthread ;; ends. (if (eobp) () (while (and (zerop (forward-line 1)) (> (gnus-summary-thread-level) level)) (setq end (point))) (prog1 (save-excursion (goto-char end) (search-backward "\n" start t)) (subst-char-in-region start end ?\n ?\^M t) (forward-line -1) (gnus-summary-position-cursor))))) (defun gnus-summary-go-to-next-thread (&optional previous) "Go to the same level (or less) next thread. If PREVIOUS is non-nil, go to previous thread instead. Return the article number moved to, or nil if moving was impossible." (let ((level (gnus-summary-thread-level)) (article (gnus-summary-article-number))) (if previous (while (and (zerop (forward-line -1)) (> (gnus-summary-thread-level) level))) (while (and (save-excursion (forward-line 1) (not (eobp))) (zerop (forward-line 1)) (> (gnus-summary-thread-level) level)))) (gnus-summary-recenter) (gnus-summary-position-cursor) (let ((oart (gnus-summary-article-number))) (and (/= oart article) oart)))) (defun gnus-summary-next-thread (n) "Go to the same level next N'th thread. If N is negative, search backward instead. Returns the difference between N and the number of skips actually done." (interactive "p") (gnus-set-global-variables) (let ((backward (< n 0)) (n (abs n))) (while (and (> n 0) (gnus-summary-go-to-next-thread backward)) (setq n (1- n))) (gnus-summary-position-cursor) (if (/= 0 n) (gnus-message 7 "No more threads")) n)) (defun gnus-summary-prev-thread (n) "Go to the same level previous N'th thread. Returns the difference between N and the number of skips actually done." (interactive "p") (gnus-set-global-variables) (gnus-summary-next-thread (- n))) (defun gnus-summary-go-down-thread (&optional same) "Go down one level in the current thread. If SAME is non-nil, also move to articles of the same level." (let ((level (gnus-summary-thread-level)) (start (point))) (if (and (zerop (forward-line 1)) (> (gnus-summary-thread-level) level)) t (goto-char start) nil))) (defun gnus-summary-go-up-thread () "Go up one level in the current thread." (let ((level (gnus-summary-thread-level)) (start (point))) (while (and (zerop (forward-line -1)) (>= (gnus-summary-thread-level) level))) (if (>= (gnus-summary-thread-level) level) (progn (goto-char start) nil) t))) (defun gnus-summary-down-thread (n) "Go down thread N steps. If N is negative, go up instead. Returns the difference between N and how many steps down that were taken." (interactive "p") (gnus-set-global-variables) (let ((up (< n 0)) (n (abs n))) (while (and (> n 0) (if up (gnus-summary-go-up-thread) (gnus-summary-go-down-thread))) (setq n (1- n))) (gnus-summary-position-cursor) (if (/= 0 n) (gnus-message 7 "Can't go further")) n)) (defun gnus-summary-up-thread (n) "Go up thread N steps. If N is negative, go up instead. Returns the difference between N and how many steps down that were taken." (interactive "p") (gnus-set-global-variables) (gnus-summary-down-thread (- n))) (defun gnus-summary-kill-thread (&optional unmark) "Mark articles under current thread as read. If the prefix argument is positive, remove any kinds of marks. If the prefix argument is negative, tick articles instead." (interactive "P") (gnus-set-global-variables) (if unmark (setq unmark (prefix-numeric-value unmark))) (let ((killing t) (level (gnus-summary-thread-level))) (save-excursion ;; Expand the thread. (gnus-summary-show-thread) (while killing ;; Mark the article... (cond ((null unmark) (gnus-summary-mark-article-as-read gnus-killed-mark)) ((> unmark 0) (gnus-summary-mark-article-as-unread gnus-unread-mark)) (t (gnus-summary-mark-article-as-unread gnus-ticked-mark))) ;; ...and go forward until either the buffer ends or the subtree ;; ends. (if (not (and (zerop (forward-line 1)) (> (gnus-summary-thread-level) level))) (setq killing nil)))) ;; Hide killed subtrees. (and (null unmark) gnus-thread-hide-killed (gnus-summary-hide-thread)) ;; If marked as read, go to next unread subject. (if (null unmark) ;; Go to next unread subject. (gnus-summary-next-subject 1 t))) (gnus-set-mode-line 'summary)) ;; Summary sorting commands (defun gnus-summary-sort-by-number (&optional reverse) "Sort summary buffer by article number. Argument REVERSE means reverse order." (interactive "P") (gnus-set-global-variables) (gnus-summary-sort ;; `gnus-summary-article-number' is a macro, and `sort-subr' wants ;; a function, so we wrap it. (cons (lambda () (gnus-summary-article-number)) 'gnus-thread-sort-by-number) reverse)) (defun gnus-summary-sort-by-author (&optional reverse) "Sort summary buffer by author name alphabetically. If case-fold-search is non-nil, case of letters is ignored. Argument REVERSE means reverse order." (interactive "P") (gnus-set-global-variables) (gnus-summary-sort (cons (lambda () (let* ((header (gnus-get-header-by-num (gnus-summary-article-number))) (extract (funcall gnus-extract-address-components (mail-header-from header)))) (concat (or (car extract) (cdr extract)) "\r" (int-to-string (mail-header-number header)) "\r" (mail-header-subject header)))) 'gnus-thread-sort-by-author) reverse)) (defun gnus-summary-sort-by-subject (&optional reverse) "Sort summary buffer by subject alphabetically. `Re:'s are ignored. If case-fold-search is non-nil, case of letters is ignored. Argument REVERSE means reverse order." (interactive "P") (gnus-set-global-variables) (gnus-summary-sort (cons (lambda () (let* ((header (gnus-get-header-by-num (gnus-summary-article-number))) (extract (funcall gnus-extract-address-components (mail-header-from header)))) (concat (downcase (gnus-simplify-subject (gnus-summary-subject-string) t)) "\r" (int-to-string (mail-header-number header)) "\r" (or (car extract) (cdr extract))))) 'gnus-thread-sort-by-subject) reverse)) (defun gnus-summary-sort-by-date (&optional reverse) "Sort summary buffer by date. Argument REVERSE means reverse order." (interactive "P") (gnus-set-global-variables) (gnus-summary-sort (cons (lambda () (gnus-sortable-date (mail-header-date (gnus-get-header-by-num (gnus-summary-article-number))))) 'gnus-thread-sort-by-date) reverse)) (defun gnus-summary-sort-by-score (&optional reverse) "Sort summary buffer by score. Argument REVERSE means reverse order." (interactive "P") (gnus-set-global-variables) (gnus-summary-sort (cons (lambda () (gnus-summary-article-score)) 'gnus-thread-sort-by-score) (not reverse))) (defvar gnus-summary-already-sorted nil) (defun gnus-summary-sort (predicate reverse) ;; Sort summary buffer by PREDICATE. REVERSE means reverse order. (if gnus-summary-already-sorted () (let (buffer-read-only) (if (not gnus-show-threads) ;; We do untreaded sorting... (progn (goto-char (point-min)) (sort-subr reverse 'forward-line 'end-of-line (car predicate))) ;; ... or we do threaded sorting. (let ((gnus-thread-sort-functions (list (cdr predicate))) (gnus-summary-prepare-hook nil) (gnus-summary-already-sorted nil)) ;; We do that by simply regenerating the threads. (gnus-summary-prepare) (and gnus-show-threads gnus-thread-hide-subtree (gnus-summary-hide-all-threads)) ;; If in async mode, we send some info to the backend. (and gnus-newsgroup-async (setq gnus-newsgroup-threads (nreverse gnus-newsgroup-threads)) (gnus-request-asynchronous gnus-newsgroup-name (if (and gnus-asynchronous-article-function (fboundp gnus-asynchronous-article-function)) (funcall gnus-asynchronous-article-function gnus-newsgroup-threads) gnus-newsgroup-threads)))))))) (defun gnus-sortable-date (date) "Make sortable string by string-lessp from DATE. Timezone package is used." (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S] (year (aref date 0)) (month (aref date 1)) (day (aref date 2))) (timezone-make-sortable-date year month day (timezone-make-time-string (aref date 3) (aref date 4) (aref date 5))))) ;; Summary saving commands. (defun gnus-summary-save-article (&optional n) "Save the current article using the default saver function. If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead. The variable `gnus-default-article-saver' specifies the saver function." (interactive "P") (gnus-set-global-variables) (let ((articles (gnus-summary-work-articles n))) (while articles (let ((header (gnus-get-header-by-num (car articles)))) (if (vectorp header) (progn (save-window-excursion (gnus-summary-select-article t nil nil (car articles))) (or gnus-save-all-headers (gnus-article-hide-headers t)) ;; Remove any X-Gnus lines. (save-excursion (save-restriction (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (goto-char (point-min)) (narrow-to-region (point) (or (search-forward "\n\n" nil t) (point-max))) (while (re-search-forward "^X-Gnus" nil t) (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point)))) (widen)))) (save-window-excursion (if gnus-default-article-saver (funcall gnus-default-article-saver) (error "No default saver is defined.")))) (if (assq 'name header) (gnus-copy-file (cdr (assq 'name header))) (gnus-message 1 "Article %d is unsaveable" (car articles))))) (gnus-summary-remove-process-mark (car articles)) (setq articles (cdr articles))) (gnus-summary-position-cursor) n)) (defun gnus-summary-pipe-output (&optional arg) "Pipe the current article to a subprocess. If N is a positive number, pipe the N next articles. If N is a negative number, pipe the N previous articles. If N is nil and any articles have been marked with the process mark, pipe those articles instead." (interactive "P") (gnus-set-global-variables) (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) (gnus-summary-save-article arg))) (defun gnus-summary-save-article-mail (&optional arg) "Append the current article to an mail file. If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") (gnus-set-global-variables) (let ((gnus-default-article-saver 'gnus-summary-save-in-mail)) (gnus-summary-save-article arg))) (defun gnus-summary-save-article-rmail (&optional arg) "Append the current article to an rmail file. If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") (gnus-set-global-variables) (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) (gnus-summary-save-article arg))) (defun gnus-summary-save-article-file (&optional arg) "Append the current article to a file. If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") (gnus-set-global-variables) (let ((gnus-default-article-saver 'gnus-summary-save-in-file)) (gnus-summary-save-article arg))) (defun gnus-read-save-file-name (prompt default-name) (let ((methods gnus-split-methods) split-name) (if (not gnus-split-methods) () (save-excursion (set-buffer gnus-article-buffer) (gnus-narrow-to-headers) (while methods (goto-char (point-min)) (and (condition-case () (re-search-forward (car (car methods)) nil t) (error nil)) (setq split-name (cons (nth 1 (car methods)) split-name))) (setq methods (cdr methods))) (widen))) (cond ((null split-name) (read-file-name (concat prompt " (default " (file-name-nondirectory default-name) ") ") (file-name-directory default-name) default-name)) ((= 1 (length split-name)) (read-file-name (concat prompt " (default " (car split-name) ") ") gnus-article-save-directory (concat gnus-article-save-directory (car split-name)))) (t (setq split-name (mapcar (lambda (el) (list el)) (nreverse split-name))) (let ((result (completing-read (concat prompt " ") split-name nil nil))) (concat gnus-article-save-directory (if (string= result "") (car (car split-name)) result))))))) (defun gnus-summary-save-in-rmail (&optional filename) "Append this article to Rmail file. Optional argument FILENAME specifies file name. Directory to save to is default to `gnus-article-save-directory' which is initialized from the SAVEDIR environment variable." (interactive) (gnus-set-global-variables) (let ((default-name (funcall gnus-rmail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-rmail))) (or filename (setq filename (gnus-read-save-file-name "Save in rmail file:" default-name))) (gnus-make-directory (file-name-directory filename)) (gnus-eval-in-buffer-window gnus-article-buffer (save-excursion (save-restriction (widen) (gnus-output-to-rmail filename)))) ;; Remember the directory name to save articles (setq gnus-newsgroup-last-rmail filename))) (defun gnus-summary-save-in-mail (&optional filename) "Append this article to Unix mail file. Optional argument FILENAME specifies file name. Directory to save to is default to `gnus-article-save-directory' which is initialized from the SAVEDIR environment variable." (interactive) (gnus-set-global-variables) (let ((default-name (funcall gnus-mail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-mail))) (or filename (setq filename (gnus-read-save-file-name "Save in Unix mail file:" default-name))) (setq filename (expand-file-name filename (and default-name (file-name-directory default-name)))) (gnus-make-directory (file-name-directory filename)) (gnus-eval-in-buffer-window gnus-article-buffer (save-excursion (save-restriction (widen) (if (and (file-readable-p filename) (mail-file-babyl-p filename)) (gnus-output-to-rmail filename) (rmail-output filename 1 t t))))) ;; Remember the directory name to save articles. (setq gnus-newsgroup-last-mail filename))) (defun gnus-summary-save-in-file (&optional filename) "Append this article to file. Optional argument FILENAME specifies file name. Directory to save to is default to `gnus-article-save-directory' which is initialized from the SAVEDIR environment variable." (interactive) (gnus-set-global-variables) (let ((default-name (funcall gnus-file-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-file))) (or filename (setq filename (gnus-read-save-file-name "Save in file:" default-name))) (gnus-make-directory (file-name-directory filename)) (gnus-eval-in-buffer-window gnus-article-buffer (save-excursion (save-restriction (widen) (gnus-output-to-file filename)))) ;; Remember the directory name to save articles. (setq gnus-newsgroup-last-file filename))) (defun gnus-summary-save-in-pipe (&optional command) "Pipe this article to subprocess." (interactive) (gnus-set-global-variables) (let ((command (read-string "Shell command on article: " gnus-last-shell-command))) (if (string-equal command "") (setq command gnus-last-shell-command)) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) (shell-command-on-region (point-min) (point-max) command nil))) (setq gnus-last-shell-command command))) ;; Summary extract commands (defun gnus-summary-insert-pseudos (pslist &optional not-view) (let ((buffer-read-only nil) (article (gnus-summary-article-number)) b) (or (gnus-summary-goto-subject article) (error (format "No such article: %d" article))) (gnus-summary-position-cursor) ;; If all commands are to be bunched up on one line, we collect ;; them here. (if gnus-view-pseudos-separately () (let ((ps (setq pslist (sort pslist 'gnus-pseudos<))) files action) (while ps (setq action (cdr (assq 'action (car ps)))) (setq files (list (cdr (assq 'name (car ps))))) (while (and ps (cdr ps) (string= (or action "1") (or (cdr (assq 'action (car (cdr ps)))) "2"))) (setq files (cons (cdr (assq 'name (car (cdr ps)))) files)) (setcdr ps (cdr (cdr ps)))) (if (not files) () (if (not (string-match "%s" action)) (setq files (cons " " files))) (setq files (cons " " files)) (and (assq 'execute (car ps)) (setcdr (assq 'execute (car ps)) (funcall (if (string-match "%s" action) 'format 'concat) action (mapconcat (lambda (f) f) files " "))))) (setq ps (cdr ps))))) (if (and gnus-view-pseudos (not not-view)) (while pslist (and (assq 'execute (car pslist)) (gnus-execute-command (cdr (assq 'execute (car pslist))) (eq gnus-view-pseudos 'not-confirm))) (setq pslist (cdr pslist))) (save-excursion (while pslist (gnus-summary-goto-subject (or (cdr (assq 'article (car pslist))) (gnus-summary-article-number))) (forward-line 1) (setq b (point)) (insert " " (file-name-nondirectory (cdr (assq 'name (car pslist)))) ": " (or (cdr (assq 'execute (car pslist))) "") "\n") (add-text-properties b (1+ b) (list 'gnus-number gnus-reffed-article-number 'gnus-mark gnus-unread-mark 'gnus-level 0 'gnus-pseudo (car pslist))) (forward-line -1) (gnus-sethash (int-to-string gnus-reffed-article-number) (car pslist) gnus-newsgroup-headers-hashtb-by-number) (setq gnus-newsgroup-unreads (cons gnus-reffed-article-number gnus-newsgroup-unreads)) (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) (setq pslist (cdr pslist))))))) (defun gnus-pseudos< (p1 p2) (let ((c1 (cdr (assq 'action p1))) (c2 (cdr (assq 'action p2)))) (and c1 c2 (string< c1 c2)))) (defun gnus-request-pseudo-article (props) (cond ((assq 'execute props) (gnus-execute-command (cdr (assq 'execute props))))) (let ((gnus-current-article (gnus-summary-article-number))) (run-hooks 'gnus-mark-article-hook))) (defun gnus-execute-command (command &optional automatic) (save-excursion (gnus-article-setup-buffer) (set-buffer gnus-article-buffer) (let ((command (if automatic command (read-string "Command: " command))) (buffer-read-only nil)) (erase-buffer) (insert "$ " command "\n\n") (if gnus-view-pseudo-asynchronously (start-process "gnus-execute" nil "sh" "-c" command) (call-process "sh" nil t nil "-c" command))))) (defun gnus-copy-file (file &optional to) "Copy FILE to TO." (interactive (list (read-file-name "Copy file: " default-directory) (read-file-name "Copy file to: " default-directory))) (gnus-set-global-variables) (or to (setq to (read-file-name "Copy file to: " default-directory))) (and (file-directory-p to) (setq to (concat (file-name-as-directory to) (file-name-nondirectory file)))) (copy-file file to)) ;; Summary kill commands. (defun gnus-summary-edit-global-kill (article) "Edit the \"global\" kill file." (interactive (list (gnus-summary-article-number))) (gnus-set-global-variables) (gnus-group-edit-global-kill article)) (defun gnus-summary-edit-local-kill () "Edit a local kill file applied to the current newsgroup." (interactive) (gnus-set-global-variables) (setq gnus-current-headers (gnus-gethash (int-to-string (gnus-summary-article-number)) gnus-newsgroup-headers-hashtb-by-number)) (gnus-set-global-variables) (gnus-group-edit-local-kill (gnus-summary-article-number) gnus-newsgroup-name)) ;;; ;;; Gnus article mode ;;; (put 'gnus-article-mode 'mode-class 'special) (defvar gnus-boogaboo nil) (if gnus-article-mode-map nil (setq gnus-article-mode-map (make-keymap)) (suppress-keymap gnus-article-mode-map) (define-key gnus-article-mode-map " " 'gnus-article-next-page) (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page) (define-key gnus-article-mode-map "\C-c^" 'gnus-article-refer-article) (define-key gnus-article-mode-map "h" 'gnus-article-show-summary) (define-key gnus-article-mode-map "s" 'gnus-article-show-summary) (define-key gnus-article-mode-map "\C-c\C-m" 'gnus-article-mail) (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly) (define-key gnus-article-mode-map gnus-mouse-2 'gnus-article-push-button) (define-key gnus-article-mode-map "\r" 'gnus-article-press-button) (define-key gnus-article-mode-map "\t" 'gnus-article-next-button) (define-key gnus-article-mode-map "\C-c\C-b" 'gnus-bug) ;; Duplicate almost all summary keystrokes in the article mode map. (let ((commands (list "p" "N" "P" "\M-\C-n" "\M-\C-p" "\M-n" "\M-p" "." "," "\M-s" "\M-r" "<" ">" "j" "u" "!" "U" "d" "D" "E" "\M-u" "\M-U" "k" "\C-k" "\M-\C-k" "\M-\C-l" "e" "#" "\M-#" "\M-\C-t" "\M-\C-s" "\M-\C-h" "\M-\C-f" "\M-\C-b" "\M-\C-u" "\M-\C-d" "&" "\C-w" "\C-t" "?" "\C-c\M-\C-s" "\C-c\C-s\C-n" "\C-c\C-s\C-a" "\C-c\C-s\C-s" "\C-c\C-s\C-d" "\C-c\C-s\C-i" "\C-x\C-s" "\M-g" "w" "\C-c\C-r" "\M-t" "C" "o" "\C-o" "|" "\M-k" "\M-K" "V" "\C-c\C-d" "\C-c\C-i" "x" "X" "t" "g" "?" "l" "\C-c\C-v\C-v" "\C-d" "v" ;; "Mt" "M!" "Md" "Mr" ;; "Mc" "M " "Me" "Mx" "M?" "Mb" "MB" "M#" "M\M-#" "M\M-r" ;; "M\M-\C-r" "MD" "M\M-D" "MS" "MC" "MH" "M\C-c" "Mk" "MK" ;; "Ms" "Mc" "Mu" "Mm" "Mk" "Gn" "Gp" "GN" "GP" "G\C-n" "G\C-p" ;; "G\M-n" "G\M-p" "Gf" "Gb" "Gg" "Gl" "Gp" "Tk" "Tl" "Ti" "TT" ;; "Ts" "TS" "Th" "TH" "Tn" "Tp" "Tu" "Td" "T#" "A " "An" "A\177" "Ap" ;; "A\r" "A<" "A>" "Ab" "Ae" "A^" "Ar" "Aw" "Ac" "Ag" "At" "Am" ;; "As" "Wh" "Ws" "Wc" "Wo" "Ww" "Wd" "Wq" "Wf" "Wt" "W\C-t" ;; "WT" "WA" "Wa" "WH" "WC" "WS" "Wb" "Hv" "Hf" "Hd" "Hh" "Hi" ;; "Be" "B\177" "Bm" "Br" "Bw" "Bc" "Bq" "Bi" "Oo" "Om" "Or" ;; "Of" "Oh" "Ov" "Op" "Vu" "V\C-s" "V\C-r" "Vr" "V&" "VT" "Ve" ;; "VD" "Vk" "VK" "Vsn" "Vsa" "Vss" "Vsd" "Vsi" ))) (while (and gnus-boogaboo commands) ; disabled (define-key gnus-article-mode-map (car commands) 'gnus-article-summary-command) (setq commands (cdr commands)))) (let ((commands (list "q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" ;; "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" "=" "n" "^" "\M-^"))) (while (and gnus-boogaboo commands) ; disabled (define-key gnus-article-mode-map (car commands) 'gnus-article-summary-command-nosave) (setq commands (cdr commands))))) (defun gnus-article-mode () "Major mode for displaying an article. All normal editing commands are switched off. The following commands are available: \\ \\[gnus-article-next-page]\t Scroll the article one page forwards \\[gnus-article-prev-page]\t Scroll the article one page backwards \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point \\[gnus-article-show-summary]\t Display the summary buffer \\[gnus-article-mail]\t Send a reply to the address near point \\[gnus-article-describe-briefly]\t Describe the current mode briefly \\[gnus-info-find-node]\t Go to the Gnus info node" (interactive) (if gnus-visual (gnus-article-make-menu-bar)) (kill-all-local-variables) (setq mode-line-modified "-- ") (make-local-variable 'mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) (and (equal (nth 3 mode-line-format) " ") (setcar (nthcdr 3 mode-line-format) "")) (setq mode-name "Article") (setq major-mode 'gnus-article-mode) (make-local-variable 'minor-mode-alist) (or (assq 'gnus-show-mime minor-mode-alist) (setq minor-mode-alist (cons (list 'gnus-show-mime " MIME") minor-mode-alist))) (use-local-map gnus-article-mode-map) (make-local-variable 'page-delimiter) (setq page-delimiter gnus-page-delimiter) (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) ;Disable modification (run-hooks 'gnus-article-mode-hook)) (defun gnus-article-setup-buffer () "Initialize article mode buffer." ;; Returns the article buffer. (if (get-buffer gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) (gnus-add-current-to-buffer-list) (or (eq major-mode 'gnus-article-mode) (gnus-article-mode)) (current-buffer)) (save-excursion (set-buffer (get-buffer-create gnus-article-buffer)) (gnus-add-current-to-buffer-list) (gnus-article-mode) (current-buffer)))) ;; Set article window start at LINE, where LINE is the number of lines ;; from the head of the article. (defun gnus-article-set-window-start (&optional line) (set-window-start (get-buffer-window gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) (goto-char (point-min)) (if (not line) (point-min) (gnus-message 6 "Moved to bookmark") (search-forward "\n\n" nil t) (forward-line line) (point))))) (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." (setq group (or group gnus-newsgroup-name)) ;; Open server if it has closed. (gnus-check-server (gnus-find-method-for-group group)) ;; Using `gnus-request-article' directly will insert the article into ;; `nntp-server-buffer' - so we'll save some time by not having to ;; copy it from the server buffer into the article buffer. ;; We only request an article by message-id when we do not have the ;; headers for it, so we'll have to get those. (and (stringp article) (let ((gnus-override-method gnus-refer-article-method)) (gnus-read-header article))) ;; If the article number is negative, that means that this article ;; doesn't belong in this newsgroup (possibly), so we find its ;; message-id and request it by id instead of number. (if (not (numberp article)) () (save-excursion (set-buffer gnus-summary-buffer) (let ((header (gnus-get-header-by-num article))) (if (< article 0) (if (vectorp header) ;; It's a real article. (setq article (mail-header-id header)) ;; It is an extracted pseudo-article. (setq article 'pseudo) (gnus-request-pseudo-article header))) (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) (if (not (eq (car method) 'nneething)) () (let ((dir (concat (file-name-as-directory (nth 1 method)) (mail-header-subject header)))) (if (file-directory-p dir) (progn (setq article 'nneething) (gnus-group-enter-directory dir))))))))) ;; Check the cache. (if (and gnus-use-cache (numberp article) (gnus-cache-request-article article group)) 'article ;; Get the article and put into the article buffer. (if (or (stringp article) (numberp article)) (progn (erase-buffer) ;; There may be some overlays that we have to kill... (insert "i") (let ((overlays (overlays-at (point-min)))) (while overlays (delete-overlay (car overlays)) (setq overlays (cdr overlays)))) (erase-buffer) (let ((gnus-override-method (and (stringp article) gnus-refer-article-method))) (and (gnus-request-article article group (current-buffer)) 'article))) article))) (defun gnus-read-header (id) "Read the headers of article ID and enter them into the Gnus system." (let (header) (if (not (setq header (car (if (let ((gnus-nov-is-evil t)) (gnus-retrieve-headers (list id) gnus-newsgroup-name)) (gnus-get-newsgroup-headers))))) nil (if (stringp id) (mail-header-set-number header gnus-reffed-article-number)) (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers)) (gnus-sethash (int-to-string (mail-header-number header)) header gnus-newsgroup-headers-hashtb-by-number) (if (stringp id) (setq gnus-reffed-article-number (1- gnus-reffed-article-number))) (setq gnus-current-headers header) header))) (defun gnus-article-prepare (article &optional all-headers header) "Prepare ARTICLE in article mode buffer. ARTICLE should either be an article number or a Message-ID. If ARTICLE is an id, HEADER should be the article headers. If ALL-HEADERS is non-nil, no headers are hidden." (save-excursion ;; Make sure we start in a summary buffer. (or (eq major-mode 'gnus-summary-mode) (set-buffer gnus-summary-buffer)) (setq gnus-summary-buffer (current-buffer)) ;; Make sure the connection to the server is alive. (or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name)) (progn (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-request-group gnus-newsgroup-name t))) (let* ((article (if header (mail-header-number header) article)) (summary-buffer (current-buffer)) (internal-hook gnus-article-internal-prepare-hook) (group gnus-newsgroup-name) result) (save-excursion (gnus-article-setup-buffer) (set-buffer gnus-article-buffer) (if (not (setq result (let ((buffer-read-only nil)) (gnus-request-article-this-buffer article group)))) ;; There is no such article. (save-excursion (if (not (numberp article)) () (setq gnus-article-current (cons gnus-newsgroup-name article)) (set-buffer gnus-summary-buffer) (setq gnus-current-article article) (gnus-summary-mark-article article gnus-canceled-mark)) (gnus-message 1 "No such article (may be canceled)") (ding) nil) (if (or (eq result 'pseudo) (eq result 'nneething)) (progn (save-excursion (set-buffer summary-buffer) (setq gnus-last-article gnus-current-article gnus-newsgroup-history (cons gnus-current-article gnus-newsgroup-history) gnus-current-article 0 gnus-current-headers nil gnus-article-current nil) (if (eq result 'nneething) (gnus-configure-windows 'summary) (gnus-configure-windows 'article)) (gnus-set-global-variables)) (gnus-set-mode-line 'article)) ;; The result from the `request' was an actual article - ;; or at least some text that is now displayed in the ;; article buffer. (if (and (numberp article) (not (eq article gnus-current-article))) ;; Seems like a new article has been selected. ;; `gnus-current-article' must be an article number. (save-excursion (set-buffer summary-buffer) (setq gnus-last-article gnus-current-article gnus-newsgroup-history (cons gnus-current-article gnus-newsgroup-history) gnus-current-article article gnus-current-headers (gnus-get-header-by-num gnus-current-article) gnus-article-current (cons gnus-newsgroup-name gnus-current-article)) (gnus-summary-show-thread) (run-hooks 'gnus-mark-article-hook) (gnus-set-mode-line 'summary) (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook)) ;; Set the global newsgroup variables here. ;; Suggested by Jim Sisolak ;; . (gnus-set-global-variables) (setq gnus-have-all-headers (or all-headers gnus-show-all-headers)) (and gnus-use-cache (vectorp (gnus-get-header-by-number article)) (gnus-cache-possibly-enter-article group article (gnus-get-header-by-number article) (memq article gnus-newsgroup-marked) (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))))) ;; Hooks for getting information from the article. ;; This hook must be called before being narrowed. (let (buffer-read-only) (run-hooks 'internal-hook) (run-hooks 'gnus-article-prepare-hook) ;; Decode MIME message. (if (and gnus-show-mime (or (not gnus-strict-mime) (gnus-fetch-field "Mime-Version"))) (funcall gnus-show-mime-method)) ;; Perform the article display hooks. (run-hooks 'gnus-article-display-hook)) ;; Do page break. (goto-char (point-min)) (and gnus-break-pages (gnus-narrow-to-page)) (gnus-set-mode-line 'article) (gnus-configure-windows 'article) (goto-char (point-min)) t)))))) (defun gnus-article-show-all-headers () "Show all article headers in article mode buffer." (save-excursion (gnus-article-setup-buffer) (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (remove-text-properties (point-min) (point-max) gnus-hidden-properties)))) (defun gnus-article-hide-headers-if-wanted () "Hide unwanted headers if `gnus-have-all-headers' is nil. Provided for backwards compatability." (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) (gnus-article-hide-headers))) (defun gnus-article-hide-headers (&optional delete) "Hide unwanted headers and possibly sort them as well." (interactive "P") (save-excursion (set-buffer gnus-article-buffer) (save-restriction (let ((sorted gnus-sorted-header-list) (buffer-read-only nil) want-list beg want-l) ;; First we narrow to just the headers. (widen) (goto-char (point-min)) ;; Hide any "From " lines at the beginning of (mail) articles. (while (looking-at "From ") (forward-line 1)) (or (bobp) (add-text-properties (point-min) (point) gnus-hidden-properties)) ;; Then treat the rest of the header lines. (narrow-to-region (point) (progn (search-forward "\n\n" nil t) (forward-line -1) (point))) ;; Then we use the two regular expressions ;; `gnus-ignored-headers' and `gnus-visible-headers' to ;; select which header lines is to remain visible in the ;; article buffer. (goto-char (point-min)) (while (re-search-forward "^[^ \t]*:" nil t) (beginning-of-line) ;; We add the headers we want to keep to a list and delete ;; them from the buffer. (if (or (and (stringp gnus-visible-headers) (looking-at gnus-visible-headers)) (and (not (stringp gnus-visible-headers)) (stringp gnus-ignored-headers) (not (looking-at gnus-ignored-headers)))) (progn (setq beg (point)) (forward-line 1) ;; Be sure to get multi-line headers... (re-search-forward "^[^ \t]*:" nil t) (beginning-of-line) (setq want-list (cons (buffer-substring beg (point)) want-list)) (delete-region beg (point)) (goto-char beg)) (forward-line 1))) ;; Next we perform the sorting by looking at ;; `gnus-sorted-header-list'. (goto-char (point-min)) (while (and sorted want-list) (setq want-l want-list) (while (and want-l (not (string-match (car sorted) (car want-l)))) (setq want-l (cdr want-l))) (if want-l (progn (insert (car want-l)) (setq want-list (delq (car want-l) want-list)))) (setq sorted (cdr sorted))) ;; Any headers that were not matched by the sorted list we ;; just tack on the end of the visible header list. (while want-list (insert (car want-list)) (setq want-list (cdr want-list))) ;; And finally we make the unwanted headers invisible. (if delete (delete-region (point) (point-max)) ;; Suggested by Sudish Joseph . (add-text-properties (point) (point-max) gnus-hidden-properties)))))) ;; Written by Per Abrahamsen . (defun gnus-article-treat-overstrike () "Translate overstrikes into bold text." (interactive) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (while (search-forward "\b" nil t) (let ((next (following-char)) (previous (char-after (- (point) 2)))) (cond ((eq next previous) (put-text-property (- (point) 2) (point) 'invisible t) (put-text-property (point) (1+ (point)) 'face 'bold)) ((eq next ?_) (put-text-property (1- (point)) (1+ (point)) 'invisible t) (put-text-property (1- (point)) (point) 'face 'underline)) ((eq previous ?_) (put-text-property (- (point) 2) (point) 'invisible t) (put-text-property (point) (1+ (point)) 'face 'underline)))))))) (defun gnus-article-word-wrap () "Format too long lines." (interactive) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (goto-char (point-min)) (search-forward "\n\n" nil t) (end-of-line 1) (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$") (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?") (adaptive-fill-mode t)) (while (not (eobp)) (and (>= (current-column) (min fill-column (window-width))) (/= (preceding-char) ?:) (fill-paragraph nil)) (end-of-line 2)))))) (defun gnus-article-remove-cr () "Remove carriage returns from an article." (interactive) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (goto-char (point-min)) (while (search-forward "\r" nil t) (replace-match "" t t))))) (defun gnus-article-display-x-face (&optional force) "Look for an X-Face header and display it if present." (interactive (list 'force)) (save-excursion (set-buffer gnus-article-buffer) (let ((inhibit-point-motion-hooks t) (case-fold-search nil) from) (save-restriction (goto-char (point-min)) (search-forward "\n\n") (narrow-to-region (point-min) (point)) (goto-char (point-min)) (setq from (mail-fetch-field "from")) (if (not (and gnus-article-x-face-command (or force (not gnus-article-x-face-too-ugly) (and gnus-article-x-face-too-ugly from (not (string-match gnus-article-x-face-too-ugly from)))) (progn (goto-char (point-min)) (re-search-forward "^X-Face: " nil t)))) nil (let ((beg (point)) (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) (if (symbolp gnus-article-x-face-command) (and (or (fboundp gnus-article-x-face-command) (error "%s is not a function" gnus-article-x-face-command)) (funcall gnus-article-x-face-command beg end)) (call-process-region beg end "sh" nil 0 nil "-c" gnus-article-x-face-command)))))))) (defun gnus-article-de-quoted-unreadable (&optional force) "Do a naive translation of a quoted-printable-encoded article. This is in no way, shape or form meant as a replacement for real MIME processing, but is simply a stop-gap measure until MIME support is written. If FORCE, decode the article whether it is marked as quoted-printable or not." (interactive (list 'force)) (save-excursion (set-buffer gnus-article-buffer) (let ((case-fold-search t) (buffer-read-only nil) (type (gnus-fetch-field "content-transfer-encoding"))) (if (or force (and type (string-match "quoted-printable" type))) (progn (goto-char (point-min)) (search-forward "\n\n" nil 'move) (gnus-mime-decode-quoted-printable (point) (point-max))))))) (defun gnus-mime-decode-quoted-printable (from to) ;; Decode quoted-printable from region between FROM and TO. (save-excursion (goto-char from) (while (search-forward "=" to t) (cond ((eq (following-char) ?\n) (delete-char -1) (delete-char 1)) ((looking-at "[0-9A-F][0-9A-F]") (delete-char -1) (insert (hexl-hex-string-to-integer (buffer-substring (point) (+ 2 (point))))) (delete-char 2)) ((looking-at "=") (delete-char 1)) ((gnus-message 3 "Malformed MIME quoted-printable message")))))) (defvar gnus-article-time-units (list (cons 'year (* 365.25 24 60 60)) (cons 'week (* 7 24 60 60)) (cons 'day (* 24 60 60)) (cons 'hour (* 60 60)) (cons 'minute 60) (cons 'second 1))) (defun gnus-article-date-ut (&optional type) "Convert DATE date to universal time in the current article. If TYPE is `local', convert to local time; if it is `lapsed', output how much time has lapsed since DATE." (interactive (list 'ut)) (let ((date (mail-header-date (or gnus-current-headers (gnus-get-header-by-number (gnus-summary-article-number))""))) (date-regexp "^Date: \\|^X-Sent: ")) (if (or (not date) (string= date "")) () (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (goto-char (point-min)) (if (and (re-search-forward date-regexp nil t) (progn (beginning-of-line) (looking-at date-regexp))) (delete-region (gnus-point-at-bol) (progn (end-of-line) (1+ (point)))) (goto-char (point-min)) (goto-char (- (search-forward "\n\n") 2))) (insert (cond ((eq type 'local) (concat "Date: " (condition-case () (timezone-make-date-arpa-standard date) (error date)) "\n")) ((eq type 'ut) (concat "Date: " (condition-case () (timezone-make-date-arpa-standard date nil "UT") (error date)) "\n")) ((eq type 'lapsed) ;; If the date is seriously mangled, the timezone ;; functions are liable to bug out, so we condition-case ;; the entire thing. (let* ((real-sec (condition-case () (- (gnus-seconds-since-epoch (timezone-make-date-arpa-standard (current-time-string) (current-time-zone) "UT")) (gnus-seconds-since-epoch (timezone-make-date-arpa-standard date nil "UT"))) (error 0))) (sec (abs real-sec)) num prev) (if (zerop sec) "X-Sent: Now\n" (concat "X-Sent: " (mapconcat (lambda (unit) (if (zerop (setq num (ffloor (/ sec (cdr unit))))) "" (setq sec (- sec (* num (cdr unit)))) (prog1 (concat (if prev ", " "") (int-to-string (floor num)) " " (symbol-name (car unit)) (if (> num 1) "s" "")) (setq prev t)))) gnus-article-time-units "") (if (> real-sec 0) " ago\n" " in the future\n"))))) (t (error "Unknown conversion type: %s" type))))))))) (defun gnus-article-date-local () "Convert the current article date to the local timezone." (interactive) (gnus-article-date-ut 'local)) (defun gnus-article-date-lapsed () "Convert the current article date to time lapsed since it was sent." (interactive) (gnus-article-date-ut 'lapsed)) (defun gnus-article-maybe-highlight () "Do some article highlighting if `gnus-visual' is non-nil." (if gnus-visual (gnus-article-highlight-some))) ;; Article savers. (defun gnus-output-to-rmail (file-name) "Append the current article to an Rmail file named FILE-NAME." (require 'rmail) ;; Most of these codes are borrowed from rmailout.el. (setq file-name (expand-file-name file-name)) (setq rmail-default-rmail-file file-name) (let ((artbuf (current-buffer)) (tmpbuf (get-buffer-create " *Gnus-output*"))) (save-excursion (or (get-file-buffer file-name) (file-exists-p file-name) (if (gnus-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"))) (set-buffer tmpbuf) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert-buffer-substring artbuf) (gnus-convert-article-to-rmail) ;; Decide whether to append to a file or to an Emacs buffer. (let ((outbuf (get-file-buffer file-name))) (if (not outbuf) (append-to-file (point-min) (point-max) file-name) ;; File has been visited, in buffer OUTBUF. (set-buffer outbuf) (let ((buffer-read-only nil) (msg (and (boundp 'rmail-current-message) (symbol-value 'rmail-current-message)))) ;; If MSG is non-nil, buffer is in RMAIL mode. (if msg (progn (widen) (narrow-to-region (point-max) (point-max)))) (insert-buffer-substring tmpbuf) (if msg (progn (goto-char (point-min)) (widen) (search-backward "\^_") (narrow-to-region (point) (point-max)) (goto-char (1+ (point-min))) (rmail-count-new-messages t) (rmail-show-message msg))))))) (kill-buffer tmpbuf))) (defun gnus-output-to-file (file-name) "Append the current article to a file named FILE-NAME." (setq file-name (expand-file-name file-name)) (let ((artbuf (current-buffer)) (tmpbuf (get-buffer-create " *Gnus-output*"))) (save-excursion (set-buffer tmpbuf) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert-buffer-substring artbuf) ;; Append newline at end of the buffer as separator, and then ;; save it to file. (goto-char (point-max)) (insert "\n") (append-to-file (point-min) (point-max) file-name)) (kill-buffer tmpbuf))) (defun gnus-convert-article-to-rmail () "Convert article in current buffer to Rmail message format." (let ((buffer-read-only nil)) ;; Convert article directly into Babyl format. ;; Suggested by Rob Austein (goto-char (point-min)) (insert "\^L\n0, unseen,,\n*** EOOH ***\n") (while (search-forward "\n\^_" nil t) ;single char (replace-match "\n^_" t t)) ;2 chars: "^" and "_" (goto-char (point-max)) (insert "\^_"))) (defun gnus-narrow-to-page (&optional arg) "Make text outside current page invisible except for page delimiter. A numeric arg specifies to move forward or backward by that many pages, thus showing a page other than the one point was originally in." (interactive "P") (setq arg (if arg (prefix-numeric-value arg) 0)) (save-excursion (forward-page -1) ;Beginning of current page. (widen) (if (> arg 0) (forward-page arg) (if (< arg 0) (forward-page (1- arg)))) ;; Find the end of the page. (forward-page) ;; If we stopped due to end of buffer, stay there. ;; If we stopped after a page delimiter, put end of restriction ;; at the beginning of that line. ;; These are commented out. ;; (if (save-excursion (beginning-of-line) ;; (looking-at page-delimiter)) ;; (beginning-of-line)) (narrow-to-region (point) (progn ;; Find the top of the page. (forward-page -1) ;; If we found beginning of buffer, stay there. ;; If extra text follows page delimiter on same line, ;; include it. ;; Otherwise, show text starting with following line. (if (and (eolp) (not (bobp))) (forward-line 1)) (point))))) (defun gnus-gmt-to-local () "Rewrite Date header described in GMT to local in current buffer. Intended to be used with gnus-article-prepare-hook." (save-excursion (save-restriction (widen) (goto-char (point-min)) (narrow-to-region (point-min) (progn (search-forward "\n\n" nil 'move) (point))) (goto-char (point-min)) (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t) (let ((buffer-read-only nil) (date (buffer-substring-no-properties (match-beginning 1) (match-end 1)))) (delete-region (match-beginning 1) (match-end 1)) (insert (timezone-make-date-arpa-standard date nil (current-time-zone)))))))) ;; Article mode commands (defun gnus-article-next-page (&optional lines) "Show next page of current article. If end of article, return non-nil. Otherwise return nil. Argument LINES specifies lines to be scrolled up." (interactive "P") (move-to-window-line -1) ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo) (if (save-excursion (end-of-line) (and (pos-visible-in-window-p) ;Not continuation line. (eobp))) ;; Nothing in this page. (if (or (not gnus-break-pages) (save-excursion (save-restriction (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? t ;Nothing more. (gnus-narrow-to-page 1) ;Go to next page. nil) ;; More in this page. (condition-case () (scroll-up lines) (end-of-buffer ;; Long lines may cause an end-of-buffer error. (goto-char (point-max)))) nil)) (defun gnus-article-prev-page (&optional lines) "Show previous page of current article. Argument LINES specifies lines to be scrolled down." (interactive "P") (move-to-window-line 0) (if (and gnus-break-pages (bobp) (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer? (progn (gnus-narrow-to-page -1) ;Go to previous page. (goto-char (point-max)) (recenter -1)) (scroll-down lines))) (defun gnus-article-refer-article () "Read article specified by message-id around point." (interactive) (search-forward ">" nil t) ;Move point to end of "<....>". (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) (let ((message-id (buffer-substring (match-beginning 1) (match-end 1)))) (set-buffer gnus-summary-buffer) (gnus-summary-refer-article message-id)) (error "No references around point"))) (defun gnus-article-show-summary () "Reconfigure windows to show summary buffer." (interactive) (gnus-configure-windows 'article) (gnus-summary-goto-subject gnus-current-article)) (defun gnus-article-describe-briefly () "Describe article mode commands briefly." (interactive) (gnus-message 6 (substitute-command-keys "\\\\[gnus-article-next-page]:Next page \\[gnus-article-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) (defun gnus-article-summary-command () "Execute the last keystroke in the summary buffer." (interactive) (let ((obuf (current-buffer)) (owin (current-window-configuration)) func) (switch-to-buffer gnus-summary-buffer 'norecord) (setq func (lookup-key (current-local-map) (this-command-keys))) (call-interactively func) (set-buffer obuf) (set-window-configuration owin) (set-window-point (get-buffer-window (current-buffer)) (point)))) (defun gnus-article-summary-command-nosave () "Execute the last keystroke in the summary buffer." (interactive) (let (func) (pop-to-buffer gnus-summary-buffer 'norecord) (setq func (lookup-key (current-local-map) (this-command-keys))) (call-interactively func))) ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti) ;;;###autoload (defalias 'gnus-batch-kill 'gnus-batch-score) ;;;###autoload (defun gnus-batch-score () "Run batched scoring. Usage: emacs -batch -l gnus -f gnus-batch-score ... Newsgroups is a list of strings in Bnews format. If you want to score the comp hierarchy, you'd say \"comp.all\". If you would not like to score the alt hierarchy, you'd say \"!alt.all\"." (interactive) (let* ((yes-and-no (gnus-newsrc-parse-options (apply (function concat) (mapcar (lambda (g) (concat g " ")) command-line-args-left)))) (gnus-expert-user t) (nnmail-spool-file nil) (gnus-use-dribble-file nil) (yes (car yes-and-no)) (no (cdr yes-and-no)) group newsrc entry ;; Disable verbose message. gnus-novice-user gnus-large-newsgroup) ;; Eat all arguments. (setq command-line-args-left nil) ;; Start Gnus. (gnus) ;; Apply kills to specified newsgroups in command line arguments. (setq newsrc (cdr gnus-newsrc-alist)) (while newsrc (setq group (car (car newsrc))) (setq entry (gnus-gethash group gnus-newsrc-hashtb)) (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed) (and (car entry) (or (eq (car entry) t) (not (zerop (car entry))))) (if yes (string-match yes group) t) (or (null no) (not (string-match no group)))) (progn (gnus-summary-read-group group nil t) (and (eq (current-buffer) (get-buffer gnus-summary-buffer)) (gnus-summary-exit)))) (setq newsrc (cdr newsrc))) ;; Exit Emacs. (switch-to-buffer gnus-group-buffer) (gnus-group-save-newsrc))) (defun gnus-apply-kill-file () "Apply a kill file to the current newsgroup. Returns the number of articles marked as read." (if (or (file-exists-p (gnus-newsgroup-kill-file nil)) (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) (gnus-apply-kill-file-internal) 0)) (defun gnus-kill-save-kill-buffer () (save-excursion (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) (if (get-file-buffer file) (progn (set-buffer (get-file-buffer file)) (and (buffer-modified-p) (save-buffer)) (kill-buffer (current-buffer))))))) (defvar gnus-kill-file-name "KILL" "Suffix of the kill files.") (defun gnus-newsgroup-kill-file (newsgroup) "Return the name of a kill file name for NEWSGROUP. If NEWSGROUP is nil, return the global kill file name instead." (cond ((or (null newsgroup) (string-equal newsgroup "")) ;; The global KILL file is placed at top of the directory. (expand-file-name gnus-kill-file-name (or gnus-kill-files-directory "~/News"))) ((gnus-use-long-file-name 'not-kill) ;; Append ".KILL" to newsgroup name. (expand-file-name (concat (gnus-newsgroup-saveable-name newsgroup) "." gnus-kill-file-name) (or gnus-kill-files-directory "~/News"))) (t ;; Place "KILL" under the hierarchical directory. (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" gnus-kill-file-name) (or gnus-kill-files-directory "~/News"))))) ;;; ;;; Dribble file ;;; (defvar gnus-dribble-ignore nil) (defvar gnus-dribble-eval-file nil) (defun gnus-dribble-file-name () (concat gnus-current-startup-file "-dribble")) (defun gnus-dribble-enter (string) (if (and (not gnus-dribble-ignore) gnus-dribble-buffer (buffer-name gnus-dribble-buffer)) (let ((obuf (current-buffer))) (set-buffer gnus-dribble-buffer) (insert string "\n") (set-window-point (get-buffer-window (current-buffer)) (point-max)) (set-buffer obuf)))) (defun gnus-dribble-read-file () (let ((dribble-file (gnus-dribble-file-name))) (save-excursion (set-buffer (setq gnus-dribble-buffer (get-buffer-create (file-name-nondirectory dribble-file)))) (gnus-add-current-to-buffer-list) (erase-buffer) (set-visited-file-name dribble-file) (buffer-disable-undo (current-buffer)) (bury-buffer (current-buffer)) (set-buffer-modified-p nil) (let ((auto (make-auto-save-file-name)) (gnus-dribble-ignore t)) (if (or (file-exists-p auto) (file-exists-p dribble-file)) (progn (if (file-newer-than-file-p auto dribble-file) (setq dribble-file auto)) (insert-file-contents dribble-file) (if (not (zerop (buffer-size))) (set-buffer-modified-p t)) (if (gnus-y-or-n-p "Auto-save file exists. Do you want to read it? ") (setq gnus-dribble-eval-file t)))))))) (defun gnus-dribble-eval-file () (if (not gnus-dribble-eval-file) () (setq gnus-dribble-eval-file nil) (save-excursion (let ((gnus-dribble-ignore t)) (set-buffer gnus-dribble-buffer) (eval-buffer (current-buffer)))))) (defun gnus-dribble-delete-file () (if (file-exists-p (gnus-dribble-file-name)) (delete-file (gnus-dribble-file-name))) (if gnus-dribble-buffer (save-excursion (set-buffer gnus-dribble-buffer) (let ((auto (make-auto-save-file-name))) (if (file-exists-p auto) (delete-file auto)) (erase-buffer) (set-buffer-modified-p nil))))) (defun gnus-dribble-save () (if (and gnus-dribble-buffer (buffer-name gnus-dribble-buffer)) (save-excursion (set-buffer gnus-dribble-buffer) (save-buffer)))) (defun gnus-dribble-clear () (save-excursion (if (gnus-buffer-exists-p gnus-dribble-buffer) (progn (set-buffer gnus-dribble-buffer) (erase-buffer) (set-buffer-modified-p nil) (setq buffer-saved-size (buffer-size)))))) ;;; ;;; Server Communication ;;; (defun gnus-start-news-server (&optional confirm) "Open a method for getting news. If CONFIRM is non-nil, the user will be asked for an NNTP server." (let (how) (if gnus-current-select-method ;; Stream is already opened. nil ;; Open NNTP server. (if (null gnus-nntp-service) (setq gnus-nntp-server nil)) (if confirm (progn ;; Read server name with completion. (setq gnus-nntp-server (completing-read "NNTP server: " (mapcar (lambda (server) (list server)) (cons (list gnus-nntp-server) gnus-secondary-servers)) nil nil gnus-nntp-server)))) (if (and gnus-nntp-server (stringp gnus-nntp-server) (not (string= gnus-nntp-server ""))) (setq gnus-select-method (cond ((or (string= gnus-nntp-server "") (string= gnus-nntp-server "::")) (list 'nnspool (system-name))) ((string-match "^:" gnus-nntp-server) (list 'nnmh gnus-nntp-server (list 'nnmh-directory (file-name-as-directory (expand-file-name (concat "~/" (substring gnus-nntp-server 1))))) (list 'nnmh-get-new-mail nil))) (t (list 'nntp gnus-nntp-server))))) (setq how (car gnus-select-method)) (cond ((eq how 'nnspool) (require 'nnspool) (gnus-message 5 "Looking up local news spool...")) ((eq how 'nnmh) (require 'nnmh) (gnus-message 5 "Looking up mh spool...")) (t (require 'nntp))) (setq gnus-current-select-method gnus-select-method) (run-hooks 'gnus-open-server-hook) (or ;; gnus-open-server-hook might have opened it (gnus-server-opened gnus-select-method) (gnus-open-server gnus-select-method) (gnus-y-or-n-p (format "%s open error: '%s'. Continue? " (nth 1 gnus-select-method) (gnus-status-message gnus-select-method))) (progn (gnus-message 1 "Couldn't open server on %s" (nth 1 gnus-select-method)) (ding) nil))))) (defun gnus-check-server (&optional method) "If the news server is down, start it up again." (let ((method (if method method gnus-select-method))) (and (stringp method) (setq method (gnus-server-to-method method))) (if (gnus-server-opened method) ;; Stream is already opened. t ;; Open server. (gnus-message 5 "Opening server %s on %s..." (car method) (nth 1 method)) (run-hooks 'gnus-open-server-hook) (prog1 (gnus-open-server method) (message ""))))) (defun gnus-nntp-message (&optional message) "Check the status of the NNTP server. If the status of the server is clear and MESSAGE is non-nil, MESSAGE is returned insted of the status string." (let ((status (gnus-status-message (gnus-find-method-for-group gnus-newsgroup-name))) (message (or message ""))) (if (and (stringp status) (> (length status) 0)) status message))) (defun gnus-get-function (method function) (and (stringp method) (setq method (gnus-server-to-method method))) (let ((func (intern (format "%s-%s" (car method) function)))) (if (not (fboundp func)) (progn (require (car method)) (if (not (fboundp func)) (error "No such function: %s" func)))) func)) ;;; Interface functions to the backends. (defun gnus-open-server (method) (funcall (gnus-get-function method 'open-server) (nth 1 method) (nthcdr 2 method))) (defun gnus-close-server (method) (funcall (gnus-get-function method 'close-server) (nth 1 method))) (defun gnus-request-list (method) (funcall (gnus-get-function method 'request-list) (nth 1 method))) (defun gnus-request-list-newsgroups (method) (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method))) (defun gnus-request-newgroups (date method) (funcall (gnus-get-function method 'request-newgroups) date (nth 1 method))) (defun gnus-server-opened (method) (funcall (gnus-get-function method 'server-opened) (nth 1 method))) (defun gnus-status-message (method) (let ((method (if (stringp method) (gnus-find-method-for-group method) method))) (funcall (gnus-get-function method 'status-message) (nth 1 method)))) (defun gnus-request-group (group &optional dont-check) (let ((method (gnus-find-method-for-group group))) (funcall (gnus-get-function method 'request-group) (gnus-group-real-name group) (nth 1 method) dont-check))) (defun gnus-request-asynchronous (group &optional articles) (let ((method (gnus-find-method-for-group group))) (funcall (gnus-get-function method 'request-asynchronous) (gnus-group-real-name group) (nth 1 method) articles))) (defun gnus-list-active-group (group) (let ((method (gnus-find-method-for-group group)) (func 'list-active-group)) (and (gnus-check-backend-function func group) (funcall (gnus-get-function method func) (gnus-group-real-name group) (nth 1 method))))) (defun gnus-request-group-description (group) (let ((method (gnus-find-method-for-group group)) (func 'request-group-description)) (and (gnus-check-backend-function func group) (funcall (gnus-get-function method func) (gnus-group-real-name group) (nth 1 method))))) (defun gnus-close-group (group) (let ((method (gnus-find-method-for-group group))) (funcall (gnus-get-function method 'close-group) (gnus-group-real-name group) (nth 1 method)))) (defun gnus-retrieve-headers (articles group) (let ((method (gnus-find-method-for-group group))) (if (and gnus-use-cache (numberp (car articles))) (gnus-cache-retrieve-headers articles group) (funcall (gnus-get-function method 'retrieve-headers) articles (gnus-group-real-name group) (nth 1 method))))) (defun gnus-retrieve-groups (groups method) (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method))) (defun gnus-request-article (article group &optional buffer) (let ((method (gnus-find-method-for-group group))) (funcall (gnus-get-function method 'request-article) article (gnus-group-real-name group) (nth 1 method) buffer))) (defun gnus-request-head (article group) (let ((method (gnus-find-method-for-group group))) (funcall (gnus-get-function method 'request-head) article (gnus-group-real-name group) (nth 1 method)))) (defun gnus-request-body (article group) (let ((method (gnus-find-method-for-group group))) (funcall (gnus-get-function method 'request-body) article (gnus-group-real-name group) (nth 1 method)))) ;; Fix by Sudish Joseph . (defun gnus-request-post-buffer (post group subject header artbuf info follow-to respect-poster) (let* ((info (or info (and group (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))) (method (if (and gnus-post-method ;; Fix by Sudish Joseph . (memq 'post (assoc (format "%s" (car (gnus-find-method-for-group gnus-newsgroup-name))) gnus-valid-select-methods))) gnus-post-method (gnus-find-method-for-group gnus-newsgroup-name)))) (or (gnus-check-server method) (error "Can't open server %s:%s" (car method) (nth 1 method))) (let ((mail-self-blind nil) (mail-archive-file-name nil)) (funcall (gnus-get-function method 'request-post-buffer) post group subject header artbuf info follow-to respect-poster)))) (defun gnus-request-post (method &optional force) (and (stringp method) (setq method (gnus-server-to-method method))) (and (not force) gnus-post-method (memq 'post (assoc (format "%s" (car method)) gnus-valid-select-methods)) (setq method gnus-post-method)) (funcall (gnus-get-function method 'request-post) (nth 1 method))) (defun gnus-request-expire-articles (articles group &optional force) (let ((method (gnus-find-method-for-group group))) (funcall (gnus-get-function method 'request-expire-articles) articles (gnus-group-real-name group) (nth 1 method) force))) (defun gnus-request-move-article (article group server accept-function &optional last) (let ((method (gnus-find-method-for-group group))) (funcall (gnus-get-function method 'request-move-article) article (gnus-group-real-name group) (nth 1 method) accept-function last))) (defun gnus-request-accept-article (group &optional last) (let ((func (if (symbolp group) group (car (gnus-find-method-for-group group))))) (funcall (intern (format "%s-request-accept-article" func)) (if (stringp group) (gnus-group-real-name group) group) last))) (defun gnus-request-replace-article (article group buffer) (let ((func (car (gnus-find-method-for-group group)))) (funcall (intern (format "%s-request-replace-article" func)) article (gnus-group-real-name group) buffer))) (defun gnus-request-create-group (group) (let ((method (gnus-find-method-for-group group))) (funcall (gnus-get-function method 'request-create-group) (gnus-group-real-name group) (nth 1 method)))) (defun gnus-member-of-valid (symbol group) (memq symbol (assoc (format "%s" (car (gnus-find-method-for-group group))) gnus-valid-select-methods))) (defun gnus-secondary-method-p (method) (let ((methods gnus-secondary-select-methods) (gmethod (gnus-server-get-method nil method))) (while (and methods (not (equal (gnus-server-get-method nil (car methods)) gmethod))) (setq methods (cdr methods))) methods)) (defun gnus-find-method-for-group (group &optional info) (or gnus-override-method (and (not group) gnus-select-method) (let ((info (or info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))) method) (if (or (not info) (not (setq method (nth 4 info)))) (setq method gnus-select-method) (setq method (cond ((stringp method) (gnus-server-to-method method)) ((stringp (car method)) (gnus-server-extend-method group method)) (t method)))) (gnus-server-add-address method)))) (defun gnus-check-backend-function (func group) (let ((method (if (stringp group) (car (gnus-find-method-for-group group)) group))) (fboundp (intern (format "%s-%s" method func))))) (defun gnus-methods-using (method) (let ((valids gnus-valid-select-methods) outs) (while valids (if (memq method (car valids)) (setq outs (cons (car valids) outs))) (setq valids (cdr valids))) outs)) ;;; ;;; Active & Newsrc File Handling ;;; ;; Newsrc related functions. ;; Gnus internal format of gnus-newsrc-alist: ;; (("alt.general" 3 (1 . 1)) ;; ("alt.misc" 3 ((1 . 10) (12 . 15))) ;; ("alt.test" 7 (1 . 99) (45 57 93)) ...) ;; The first item is the group name; the second is the subscription ;; level; the third is either a range of a list of ranges of read ;; articles, the optional fourth element is a list of marked articles, ;; the optional fifth element is the select method. ;; ;; Gnus internal format of gnus-newsrc-hashtb: ;; (95 ("alt.general" 3 (1 . 1)) ("alt.misc" 3 ((1 . 10) (12 . 15))) ...) ;; This is the entry for "alt.misc". The first element is the number ;; of unread articles in "alt.misc". The cdr of this entry is the ;; element *before* "alt.misc" in gnus-newsrc-alist, which makes is ;; trivial to remove or add new elements into gnus-newsrc-alist ;; without scanning the entire list. So, to get the actual information ;; of "alt.misc", you'd say something like ;; (nth 2 (gnus-gethash "alt.misc" gnus-newsrc-hashtb)) ;; ;; Gnus internal format of gnus-active-hashtb: ;; ((1 . 1)) ;; (5 . 10)) ;; (67 . 99)) ...) ;; The only element in each entry in this hash table is a range of ;; (possibly) available articles. (Articles in this range may have ;; been expired or canceled.) ;; ;; Gnus internal format of gnus-killed-list and gnus-zombie-list: ;; ("alt.misc" "alt.test" "alt.general" ...) (defun gnus-setup-news (&optional rawfile level) "Setup news information. If RAWFILE is non-nil, the .newsrc file will also be read. If LEVEL is non-nil, the news will be set up at level LEVEL." (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))) ;; Clear some variables to re-initialize news information. (if init (setq gnus-newsrc-alist nil gnus-active-hashtb nil)) ;; Read the newsrc file and create `gnus-newsrc-hashtb'. (if init (gnus-read-newsrc-file rawfile)) ;; If we don't read the complete active file, we fill in the ;; hashtb here. (if (or (null gnus-read-active-file) (eq gnus-read-active-file 'some)) (gnus-update-active-hashtb-from-killed)) ;; Read the active file and create `gnus-active-hashtb'. ;; If `gnus-read-active-file' is nil, then we just create an empty ;; hash table. The partial filling out of the hash table will be ;; done in `gnus-get-unread-articles'. (and gnus-read-active-file (not level) (gnus-read-active-file)) (or gnus-active-hashtb (setq gnus-active-hashtb (make-vector 4095 0))) ;; Possibly eval the dribble file. (and init gnus-use-dribble-file (gnus-dribble-eval-file)) (gnus-update-format-specifications) ;; Find new newsgroups and treat them. (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level) (gnus-server-opened gnus-select-method)) (gnus-find-new-newsgroups)) ;; Find the number of unread articles in each non-dead group. (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) (gnus-get-unread-articles (or level (1+ gnus-level-subscribed)))) (if (and init gnus-check-bogus-newsgroups gnus-read-active-file (not level) (gnus-server-opened gnus-select-method)) (gnus-check-bogus-newsgroups)))) (defun gnus-find-new-newsgroups () "Search for new newsgroups and add them. Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' The `-n' option line from .newsrc is respected." (interactive) (or (gnus-check-first-time-used) (if (or (consp gnus-check-new-newsgroups) (eq gnus-check-new-newsgroups 'ask-server)) (gnus-ask-server-for-new-groups) (let ((groups 0) group new-newsgroups) (gnus-message 5 "Looking for new newsgroups...") (or gnus-have-read-active-file (gnus-read-active-file)) (setq gnus-newsrc-last-checked-date (current-time-string)) (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed)) ;; Go though every newsgroup in `gnus-active-hashtb' and compare ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. (mapatoms (lambda (sym) (if (or (null (setq group (symbol-name sym))) (null (symbol-value sym)) (gnus-gethash group gnus-killed-hashtb) (gnus-gethash group gnus-newsrc-hashtb)) () (let ((do-sub (gnus-matches-options-n group))) (cond ((eq do-sub 'subscribe) (setq groups (1+ groups)) (gnus-sethash group group gnus-killed-hashtb) (funcall gnus-subscribe-options-newsgroup-method group)) ((eq do-sub 'ignore) nil) (t (setq groups (1+ groups)) (gnus-sethash group group gnus-killed-hashtb) (if gnus-subscribe-hierarchical-interactive (setq new-newsgroups (cons group new-newsgroups)) (funcall gnus-subscribe-newsgroup-method group))))))) gnus-active-hashtb) (if new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups)) ;; Suggested by Per Abrahamsen . (if (> groups 0) (gnus-message 6 "%d new newsgroup%s arrived." groups (if (> groups 1) "s have" " has")) (gnus-message 6 "No new newsgroups.")))))) (defun gnus-matches-options-n (group) ;; Returns `subscribe' if the group is to be uncoditionally ;; subscribed, `ignore' if it is to be ignored, and nil if there is ;; no match for the group. ;; First we check the two user variables. (cond ((and gnus-options-subscribe (string-match gnus-options-subscribe group)) 'subscribe) ((and gnus-options-not-subscribe (string-match gnus-options-not-subscribe group)) 'ignore) ;; Then we go through the list that was retrieved from the .newsrc ;; file. This list has elements on the form ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list ;; is in the reverse order of the options line) is returned. (t (let ((regs gnus-newsrc-options-n)) (while (and regs (not (string-match (car (car regs)) group))) (setq regs (cdr regs))) (and regs (cdr (car regs))))))) (defun gnus-ask-server-for-new-groups () (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) (methods (cons gnus-select-method (append (and (consp gnus-check-new-newsgroups) gnus-check-new-newsgroups) gnus-secondary-select-methods))) (groups 0) (new-date (current-time-string)) (hashtb (gnus-make-hashtable 100)) group new-newsgroups got-new method) ;; Go through both primary and secondary select methods and ;; request new newsgroups. (while methods (setq method (gnus-server-get-method nil (car methods))) (and (gnus-check-server method) (gnus-request-newgroups date method) (save-excursion (setq got-new t) (set-buffer nntp-server-buffer) ;; Enter all the new groups in a hashtable. (gnus-active-to-gnus-format method hashtb 'ignore))) (setq methods (cdr methods))) (and got-new (setq gnus-newsrc-last-checked-date new-date)) ;; Now all new groups from all select methods are in `hashtb'. (mapatoms (lambda (group-sym) (setq group (symbol-name group-sym)) (if (or (null group) (null (symbol-value group-sym)) (gnus-gethash group gnus-newsrc-hashtb) (member group gnus-zombie-list) (member group gnus-killed-list)) ;; The group is already known. () (and (symbol-value group-sym) (gnus-sethash group (symbol-value group-sym) gnus-active-hashtb)) (let ((do-sub (gnus-matches-options-n group))) (cond ((eq do-sub 'subscribe) (setq groups (1+ groups)) (gnus-sethash group group gnus-killed-hashtb) (funcall gnus-subscribe-options-newsgroup-method group)) ((eq do-sub 'ignore) nil) (t (setq groups (1+ groups)) (gnus-sethash group group gnus-killed-hashtb) (if gnus-subscribe-hierarchical-interactive (setq new-newsgroups (cons group new-newsgroups)) (funcall gnus-subscribe-newsgroup-method group))))))) hashtb) (if new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups)) ;; Suggested by Per Abrahamsen . (if (> groups 0) (gnus-message 6 "%d new newsgroup%s arrived." groups (if (> groups 1) "s have" " has"))) got-new)) (defun gnus-check-first-time-used () (if (or (> (length gnus-newsrc-alist) 1) (file-exists-p gnus-startup-file) (file-exists-p (concat gnus-startup-file ".el")) (file-exists-p (concat gnus-startup-file ".eld"))) nil (gnus-message 6 "First time user; subscribing you to default groups") (or gnus-have-read-active-file (gnus-read-active-file)) (setq gnus-newsrc-last-checked-date (current-time-string)) (let ((groups gnus-default-subscribed-newsgroups) group) (if (eq groups t) nil (setq groups (or groups gnus-backup-default-subscribed-newsgroups)) (mapatoms (lambda (sym) (if (null (setq group (symbol-name sym))) () (let ((do-sub (gnus-matches-options-n group))) (cond ((eq do-sub 'subscribe) (gnus-sethash group group gnus-killed-hashtb) (funcall gnus-subscribe-options-newsgroup-method group)) ((eq do-sub 'ignore) nil) (t (setq gnus-killed-list (cons group gnus-killed-list))))))) gnus-active-hashtb) (while groups (if (gnus-gethash (car groups) gnus-active-hashtb) (gnus-group-change-level (car groups) gnus-level-default-subscribed gnus-level-killed)) (setq groups (cdr groups))) (gnus-group-make-help-group) (and gnus-novice-user (gnus-message 7 "`A k' to list killed groups")))))) (defun gnus-subscribe-group (group previous &optional method) (gnus-group-change-level (if method (list t group gnus-level-default-subscribed nil nil method) group) gnus-level-default-subscribed gnus-level-killed previous t)) ;; `gnus-group-change-level' is the fundamental function for changing ;; subscription levels of newsgroups. This might mean just changing ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back ;; again, which subscribes/unsubscribes a group, which is equally ;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and ;; from 8-9 to 1-7 means that you remove the group from the list of ;; killed (or zombie) groups and add them to the (kinda) subscribed ;; groups. And last but not least, moving from 8 to 9 and 9 to 8, ;; which is trivial. ;; ENTRY can either be a string (newsgroup name) or a list (if ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' ;; entries. ;; LEVEL is the new level of the group, OLDLEVEL is the old level and ;; PREVIOUS is the group (in hashtb entry format) to insert this group ;; after. (defun gnus-group-change-level (entry level &optional oldlevel previous fromkilled) (let (group info active num) ;; Glean what info we can from the arguments (if (consp entry) (if fromkilled (setq group (nth 1 entry)) (setq group (car (nth 2 entry)))) (setq group entry)) (if (and (stringp entry) oldlevel (< oldlevel gnus-level-zombie)) (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) (if (and (not oldlevel) (consp entry)) (setq oldlevel (car (cdr (nth 2 entry))))) (if (stringp previous) (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) (if (and (>= oldlevel gnus-level-zombie) (gnus-gethash group gnus-newsrc-hashtb)) ;; We are trying to subscribe a group that is already ;; subscribed. () ; Do nothing. (or (gnus-ephemeral-group-p group) (gnus-dribble-enter (format "(gnus-group-change-level %S %S %S %S %S)" group level oldlevel (car (nth 2 previous)) fromkilled))) ;; Then we remove the newgroup from any old structures, if needed. ;; If the group was killed, we remove it from the killed or zombie ;; list. If not, and it is in fact going to be killed, we remove ;; it from the newsrc hash table and assoc. (cond ((>= oldlevel gnus-level-zombie) (if (= oldlevel gnus-level-zombie) (setq gnus-zombie-list (delete group gnus-zombie-list)) (setq gnus-killed-list (delete group gnus-killed-list)))) (t (if (and (>= level gnus-level-zombie) entry) (progn (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) (if (nth 3 entry) (setcdr (gnus-gethash (car (nth 3 entry)) gnus-newsrc-hashtb) (cdr entry))) (setcdr (cdr entry) (cdr (cdr (cdr entry)))))))) ;; Finally we enter (if needed) the list where it is supposed to ;; go, and change the subscription level. If it is to be killed, ;; we enter it into the killed or zombie list. (cond ((>= level gnus-level-zombie) ;; Remove from the hash table. (gnus-sethash group nil gnus-newsrc-hashtb) (or (gnus-group-foreign-p group) ;; We do not enter foreign groups into the list of dead ;; groups. (if (= level gnus-level-zombie) (setq gnus-zombie-list (cons group gnus-zombie-list)) (setq gnus-killed-list (cons group gnus-killed-list))))) (t ;; If the list is to be entered into the newsrc assoc, and ;; it was killed, we have to create an entry in the newsrc ;; hashtb format and fix the pointers in the newsrc assoc. (if (>= oldlevel gnus-level-zombie) (progn (if (listp entry) (progn (setq info (cdr entry)) (setq num (car entry))) (setq active (gnus-gethash group gnus-active-hashtb)) (setq num (if active (- (1+ (cdr active)) (car active)) t)) ;; Check whether the group is foreign. If so, the ;; foreign select method has to be entered into the ;; info. (let ((method (gnus-group-method-name group))) (if (eq method gnus-select-method) (setq info (list group level nil)) (setq info (list group level nil nil method))))) (or previous (setq previous (let ((p gnus-newsrc-alist)) (while (cdr (cdr p)) (setq p (cdr p))) p))) (setq entry (cons info (cdr (cdr previous)))) (if (cdr previous) (progn (setcdr (cdr previous) entry) (gnus-sethash group (cons num (cdr previous)) gnus-newsrc-hashtb)) (setcdr previous entry) (gnus-sethash group (cons num previous) gnus-newsrc-hashtb)) (if (cdr entry) (setcdr (gnus-gethash (car (car (cdr entry))) gnus-newsrc-hashtb) entry))) ;; It was alive, and it is going to stay alive, so we ;; just change the level and don't change any pointers or ;; hash table entries. (setcar (cdr (car (cdr (cdr entry)))) level))))))) (defun gnus-kill-newsgroup (newsgroup) "Obsolete function. Kills a newsgroup." (gnus-group-change-level (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) (defun gnus-check-bogus-newsgroups (&optional confirm) "Remove bogus newsgroups. If CONFIRM is non-nil, the user has to confirm the deletion of every newsgroup." (let ((newsrc (cdr gnus-newsrc-alist)) bogus group entry) (gnus-message 5 "Checking bogus newsgroups...") (or gnus-have-read-active-file (gnus-read-active-file)) ;; Find all bogus newsgroup that are subscribed. (while newsrc (setq group (car (car newsrc))) (if (or (gnus-gethash group gnus-active-hashtb) ; Active (nth 4 (car newsrc)) ; Foreign (and confirm (not (gnus-y-or-n-p (format "Remove bogus newsgroup: %s " group))))) ;; Don't remove. () ;; Found a bogus newsgroup. (setq bogus (cons group bogus))) (setq newsrc (cdr newsrc))) ;; Remove all bogus subscribed groups by first killing them, and ;; then removing them from the list of killed groups. (while bogus (and (setq entry (gnus-gethash (car bogus) gnus-newsrc-hashtb)) (progn (gnus-group-change-level entry gnus-level-killed) (setq gnus-killed-list (delete (car bogus) gnus-killed-list)))) (setq bogus (cdr bogus))) ;; Then we remove all bogus groups from the list of killed and ;; zombie groups. They are are removed without confirmation. (let ((dead-lists '(gnus-killed-list gnus-zombie-list)) killed) (while dead-lists (setq killed (symbol-value (car dead-lists))) (while killed (setq group (car killed)) (or (gnus-gethash group gnus-active-hashtb) ;; The group is bogus. (set (car dead-lists) (delete group (symbol-value (car dead-lists))))) (setq killed (cdr killed))) (setq dead-lists (cdr dead-lists)))) (gnus-message 5 "Checking bogus newsgroups...done"))) (defun gnus-check-duplicate-killed-groups () "Remove duplicates from the list of killed groups." (interactive) (let ((killed gnus-killed-list)) (while killed (gnus-message 9 "%d" (length killed)) (setcdr killed (delete (car killed) (cdr killed))) (setq killed (cdr killed))))) ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' ;; and compute how many unread articles there are in each group. (defun gnus-get-unread-articles (&optional level) (let* ((newsrc (cdr gnus-newsrc-alist)) (level (or level (1+ gnus-level-subscribed))) (foreign-level (min (cond ((and gnus-activate-foreign-newsgroups (not (numberp gnus-activate-foreign-newsgroups))) (1+ gnus-level-subscribed)) ((numberp gnus-activate-foreign-newsgroups) gnus-activate-foreign-newsgroups) (t 0)) level)) info group active virtuals method) (gnus-message 5 "Checking new news...") (while newsrc (setq info (car newsrc) group (car info) active (gnus-gethash group gnus-active-hashtb)) ;; Check newsgroups. If the user doesn't want to check them, or ;; they can't be checked (for instance, if the news server can't ;; be reached) we just set the number of unread articles in this ;; newsgroup to t. This means that Gnus thinks that there are ;; unread articles, but it has no idea how many. (if (and (setq method (nth 4 info)) (not (gnus-server-equal gnus-select-method (gnus-server-get-method nil method))) (not (gnus-secondary-method-p method))) ;; These groups are foreign. Check the level. (if (<= (nth 1 info) foreign-level) (if (eq (car (if (stringp method) (gnus-server-to-method method) (nth 4 info))) 'nnvirtual) ;; We have to activate the virtual groups after all ;; the others, so we just pop them on a list for ;; now. (setq virtuals (cons info virtuals)) (and (setq active (gnus-activate-group (car info))) ;; Close the groups as we look at them! (gnus-close-group group)))) ;; These groups are native or secondary. (if (and (not gnus-read-active-file) (<= (nth 1 info) level)) (progn (or gnus-read-active-file (gnus-check-server method)) (setq active (gnus-activate-group (car info)))))) (if active (gnus-get-unread-articles-in-group info active) ;; The group couldn't be reached, so we nix out the number of ;; unread articles and stuff. (gnus-sethash group nil gnus-active-hashtb) (setcar (gnus-gethash group gnus-newsrc-hashtb) t)) (setq newsrc (cdr newsrc))) ;; Activate the virtual groups. This has to be done after all the ;; other groups. ;; !!! If one virtual group contains another virtual group, even ;; doing it this way might cause problems. (while virtuals (and (setq active (gnus-activate-group (car (car virtuals)))) (gnus-get-unread-articles-in-group (car virtuals) active)) (setq virtuals (cdr virtuals))) (gnus-message 5 "Checking new news...done"))) ;; Create a hash table out of the newsrc alist. The `car's of the ;; alist elements are used as keys. (defun gnus-make-hashtable-from-newsrc-alist () (let ((alist gnus-newsrc-alist) (ohashtb gnus-newsrc-hashtb) prev) (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) (setq alist (setq prev (setq gnus-newsrc-alist (if (equal (car (car gnus-newsrc-alist)) "dummy.group") gnus-newsrc-alist (cons (list "dummy.group" 0 nil) alist))))) (while alist (gnus-sethash (car (car alist)) (cons (and ohashtb (car (gnus-gethash (car (car alist)) ohashtb))) prev) gnus-newsrc-hashtb) (setq prev alist alist (cdr alist))))) (defun gnus-make-hashtable-from-killed () "Create a hash table from the killed and zombie lists." (let ((lists '(gnus-killed-list gnus-zombie-list)) list) (setq gnus-killed-hashtb (gnus-make-hashtable (+ (length gnus-killed-list) (length gnus-zombie-list)))) (while lists (setq list (symbol-value (car lists))) (setq lists (cdr lists)) (while list (gnus-sethash (car list) (car list) gnus-killed-hashtb) (setq list (cdr list)))))) (defun gnus-get-unread-articles-in-group (info active) (let* ((range (nth 2 info)) (num 0) (marked (nth 3 info))) ;; If a cache is present, we may have to alter the active info. (and gnus-use-cache (gnus-cache-possibly-alter-active (car info) active)) ;; Modify the list of read articles according to what articles ;; are available; then tally the unread articles and add the ;; number to the group hash table entry. (cond ((zerop (cdr active)) (setq num 0)) ((not range) (setq num (- (1+ (cdr active)) (car active)))) ((not (listp (cdr range))) ;; Fix a single (num . num) range according to the ;; active hash table. ;; Fix by Carsten Bormann . (and (< (cdr range) (car active)) (setcdr range (1- (car active)))) (and (> (cdr range) (cdr active)) (setcdr range (cdr active))) ;; Compute number of unread articles. (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range)))))) (t ;; The read list is a list of ranges. Fix them according to ;; the active hash table. ;; First peel off any elements that are below the lower ;; active limit. (while (and (cdr range) (>= (car active) (or (and (atom (car (cdr range))) (car (cdr range))) (car (car (cdr range)))))) (if (numberp (car range)) (setcar range (cons (car range) (or (and (numberp (car (cdr range))) (car (cdr range))) (cdr (car (cdr range)))))) (setcdr (car range) (or (and (numberp (nth 1 range)) (nth 1 range)) (cdr (car (cdr range)))))) (setcdr range (cdr (cdr range)))) ;; Adjust the first element to be the same as the lower limit. (if (and (not (atom (car range))) (< (cdr (car range)) (car active))) (setcdr (car range) (1- (car active)))) ;; Then we want to peel off any elements that are higher ;; than the upper active limit. (let ((srange range)) ;; Go past all legal elements. (while (and (cdr srange) (<= (or (and (atom (car (cdr srange))) (car (cdr srange))) (car (car (cdr srange)))) (cdr active))) (setq srange (cdr srange))) (if (cdr srange) ;; Nuke all remaining illegal elements. (setcdr srange nil)) ;; Adjust the final element. (if (and (not (atom (car srange))) (> (cdr (car srange)) (cdr active))) (setcdr (car srange) (cdr active)))) ;; Compute the number of unread articles. (while range (setq num (+ num (- (1+ (or (and (atom (car range)) (car range)) (cdr (car range)))) (or (and (atom (car range)) (car range)) (car (car range)))))) (setq range (cdr range))) (setq num (max 0 (- (cdr active) num))))) (and info (progn (and (assq 'tick marked) (inline (gnus-remove-illegal-marked-articles (assq 'tick marked) (nth 2 info)))) (and (assq 'dormant marked) (inline (gnus-remove-illegal-marked-articles (assq 'dormant marked) (nth 2 info)))) (setcar (gnus-gethash (car info) gnus-newsrc-hashtb) (setq num (max 0 (- num (length (cdr (assq 'tick marked))) (length (cdr (assq 'dormant marked))))))))) num)) (defun gnus-remove-illegal-marked-articles (marked ranges) (let ((m (cdr marked))) ;; Make sure that all ticked articles are a subset of the unread ;; articles. (while m (if (gnus-member-of-range (car m) ranges) (setcdr marked (cdr m)) (setq marked m)) (setq m (cdr m))))) (defun gnus-activate-group (group) ;; Check whether a group has been activated or not. (let ((method (gnus-find-method-for-group group)) active) (and (gnus-check-server method) ;; We escape all bugs and quit here to make it possible to ;; continue if a group is so out-there that it reports bugs ;; and stuff. (condition-case () (gnus-request-group group) (error nil) (quit nil)) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) ;; Parse the result we got from `gnus-request-group'. (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") (progn (goto-char (match-beginning 1)) (gnus-sethash group (setq active (cons (read (current-buffer)) (read (current-buffer)))) gnus-active-hashtb)) ;; Return the new active info. active))))) (defun gnus-update-read-articles (group unread unselected ticked &optional domarks replied expirable killed dormant bookmark score) "Update the list of read and ticked articles in GROUP using the UNREAD and TICKED lists. Note: UNSELECTED has to be sorted over `<'. Returns whether the updating was successful." (let* ((active (or gnus-newsgroup-active (gnus-gethash group gnus-active-hashtb))) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) (marked (nth 3 info)) (prev 1) (unread (sort (copy-sequence unread) (function <))) read) (if (or (not info) (not active)) ;; There is no info on this group if it was, in fact, ;; killed. Gnus stores no information on killed groups, so ;; there's nothing to be done. ;; One could store the information somewhere temporarily, ;; perhaps... Hmmm... () ;; Remove any negative articles numbers. (while (and unread (< (car unread) 0)) (setq unread (cdr unread))) ;; Remove any expired article numbers (while (and unread (< (car unread) (car active))) (setq unread (cdr unread))) (while (and ticked (< (car ticked) (car active))) (setq ticked (cdr ticked))) (while (and dormant (< (car dormant) (car active))) (setq dormant (cdr dormant))) (setq unread (sort (append unselected unread) '<)) ;; Compute the ranges of read articles by looking at the list of ;; unread articles. (while unread (if (/= (car unread) prev) (setq read (cons (if (= prev (1- (car unread))) prev (cons prev (1- (car unread)))) read))) (setq prev (1+ (car unread))) (setq unread (cdr unread))) (if (<= prev (cdr active)) (setq read (cons (cons prev (cdr active)) read))) ;; Enter this list into the group info. (setcar (cdr (cdr info)) (if (> (length read) 1) (nreverse read) read)) ;; Enter the list of ticked articles. (gnus-set-marked-articles info ticked (if domarks replied (cdr (assq 'reply marked))) (if domarks expirable (cdr (assq 'expire marked))) (if domarks killed (cdr (assq 'killed marked))) (if domarks dormant (cdr (assq 'dormant marked))) (if domarks bookmark (cdr (assq 'bookmark marked))) (if domarks score (cdr (assq 'score marked)))) ;; Set the number of unread articles in gnus-newsrc-hashtb. (gnus-get-unread-articles-in-group info (gnus-gethash group gnus-active-hashtb)) t))) (defun gnus-make-articles-unread (group articles) "Mark ARTICLES in GROUP as unread." (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb) (gnus-gethash (gnus-group-real-name group) gnus-newsrc-hashtb)))) (ranges (nth 2 info)) news) (while articles (and (gnus-member-of-range (car articles) ranges) (setq news (cons (car articles) news))) (setq articles (cdr articles))) (if (not news) () (setcar (nthcdr 2 info) (gnus-remove-from-range (nth 2 info) (nreverse news))) (gnus-group-update-group group t)))) ;; Enter all dead groups into the hashtb. (defun gnus-update-active-hashtb-from-killed () (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0))) (lists (list gnus-killed-list gnus-zombie-list)) killed) (while lists (setq killed (car lists)) (while killed (gnus-sethash (car killed) nil hashtb) (setq killed (cdr killed))) (setq lists (cdr lists))))) ;; Get the active file(s) from the backend(s). (defun gnus-read-active-file () (gnus-group-set-mode-line) (let ((methods (if (gnus-check-server gnus-select-method) ;; The native server is available. (cons gnus-select-method gnus-secondary-select-methods) ;; The native server is down, so we just do the ;; secondary ones. gnus-secondary-select-methods)) list-type) (setq gnus-have-read-active-file nil) (save-excursion (set-buffer nntp-server-buffer) (while methods (let* ((method (gnus-server-get-method nil (car methods))) (where (nth 1 method)) (mesg (format "Reading active file%s via %s..." (if (and where (not (zerop (length where)))) (concat " from " where) "") (car method)))) (gnus-message 5 mesg) (if (not (gnus-check-server method)) () (cond ((and (eq gnus-read-active-file 'some) (gnus-check-backend-function 'retrieve-groups (car method))) (let ((newsrc (cdr gnus-newsrc-alist)) (gmethod (gnus-server-get-method nil method)) groups) (while newsrc (and (gnus-server-equal (gnus-find-method-for-group (car (car newsrc)) (car newsrc)) gmethod) (setq groups (cons (gnus-group-real-name (car (car newsrc))) groups))) (setq newsrc (cdr newsrc))) (gnus-check-server method) (setq list-type (gnus-retrieve-groups groups method)) (cond ((not list-type) (gnus-message 1 "Cannot read partial active file from %s server." (car method)) (ding) (sit-for 2)) ((eq list-type 'active) (gnus-active-to-gnus-format method gnus-active-hashtb)) (t (gnus-groups-to-gnus-format method gnus-active-hashtb))))) (t (if (not (gnus-request-list method)) (progn (gnus-message 1 "Cannot read active file from %s server." (car method)) (ding)) (gnus-active-to-gnus-format method) ;; We mark this active file as read. (setq gnus-have-read-active-file (cons method gnus-have-read-active-file)) (gnus-message 5 "%sdone" mesg)))))) (setq methods (cdr methods)))))) ;; Read an active file and place the results in `gnus-active-hashtb'. (defun gnus-active-to-gnus-format (method &optional hashtb ignore-errors) (let ((cur (current-buffer)) (hashtb (or hashtb (if (and gnus-active-hashtb (not (equal method gnus-select-method))) gnus-active-hashtb (setq gnus-active-hashtb (if (equal method gnus-select-method) (gnus-make-hashtable (count-lines (point-min) (point-max))) (gnus-make-hashtable 4096)))))) (flag-hashtb (gnus-make-hashtable 60))) ;; Delete unnecessary lines. (goto-char (point-min)) (while (search-forward "\nto." nil t) (delete-region (1+ (match-beginning 0)) (progn (forward-line 1) (point)))) (or (string= gnus-ignored-newsgroups "") (progn (goto-char (point-min)) (delete-matching-lines gnus-ignored-newsgroups))) ;; Make the group names readable as a lisp expression even if they ;; contain special characters. ;; Fix by Luc Van Eycken . (goto-char (point-max)) (while (re-search-backward "[][';?()#]" nil t) (insert ?\\)) ;; If these are groups from a foreign select method, we insert the ;; group prefix in front of the group names. (and method (not (gnus-server-equal (gnus-server-get-method nil method) (gnus-server-get-method nil gnus-select-method))) (let ((prefix (gnus-group-prefixed-name "" method))) (goto-char (point-min)) (while (and (not (eobp)) (progn (insert prefix) (zerop (forward-line 1))))))) ;; Store the active file in a hash table. (goto-char (point-min)) (if (string-match "%[oO]" gnus-group-line-format) ;; Suggested by Brian Edmonds . ;; If we want information on moderated groups, we use this ;; loop... (let* ((mod-hashtb (make-vector 7 0)) (m (intern "m" mod-hashtb)) group max min) (while (not (eobp)) (condition-case nil (progn (narrow-to-region (point) (gnus-point-at-eol)) (setq group (let ((obarray hashtb)) (read cur))) (if (and (numberp (setq max (read cur))) (numberp (setq min (read cur))) (progn (skip-chars-forward " \t") (not (or (= (following-char) ?=) (= (following-char) ?x) (= (following-char) ?j))))) (set group (cons min max)) (set group nil)) ;; Enter moderated groups into a list. (if (eq (let ((obarray mod-hashtb)) (read cur)) m) (setq gnus-moderated-list (cons (symbol-name group) gnus-moderated-list)))) (error (and group (symbolp group) (set group nil)))) (widen) (forward-line 1))) ;; And if we do not care about moderation, we use this loop, ;; which is faster. (let (group max min) (while (not (eobp)) (condition-case () (progn (narrow-to-region (point) (gnus-point-at-eol)) ;; group gets set to a symbol interned in the hash table ;; (what a hack!!) - jwz (setq group (let ((obarray hashtb)) (read cur))) (if (and (numberp (setq max (read cur))) (numberp (setq min (read cur))) (progn (skip-chars-forward " \t") (not (or (= (following-char) ?=) (= (following-char) ?x) (= (following-char) ?j))))) (set group (cons min max)) (set group nil))) (error (progn (and group (symbolp group) (set group nil)) (or ignore-errors (gnus-message 3 "Warning - illegal active: %s" (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol))))))) (widen) (forward-line 1)))))) (defun gnus-groups-to-gnus-format (method &optional hashtb) ;; Parse a "groups" active file. (let ((cur (current-buffer)) (hashtb (or hashtb (if (and method gnus-active-hashtb) gnus-active-hashtb (setq gnus-active-hashtb (gnus-make-hashtable (count-lines (point-min) (point-max))))))) (prefix (and method (not (gnus-server-equal (gnus-server-get-method nil method) (gnus-server-get-method nil gnus-select-method))) (gnus-group-prefixed-name "" method)))) (goto-char (point-min)) ;; We split this into to separate loops, one with the prefix ;; and one without to speed the reading up somewhat. (if prefix (let (min max opoint group) (while (not (eobp)) (condition-case () (progn (read cur) (read cur) (setq min (read cur) max (read cur) opoint (point)) (skip-chars-forward " \t") (insert prefix) (goto-char opoint) (set (let ((obarray hashtb)) (read cur)) (cons min max))) (error (and group (symbolp group) (set group nil)))) (forward-line 1))) (let (min max group) (while (not (eobp)) (condition-case () (if (= (following-char) ?2) (progn (read cur) (read cur) (setq min (read cur) max (read cur)) (set (setq group (let ((obarray hashtb)) (read cur))) (cons min max)))) (error (and group (symbolp group) (set group nil)))) (forward-line 1)))))) (defun gnus-read-newsrc-file (&optional force) "Read startup file. If FORCE is non-nil, the .newsrc file is read." ;; Reset variables that might be defined in the .newsrc.eld file. (let ((variables gnus-variable-list)) (while variables (set (car variables) nil) (setq variables (cdr variables)))) (let* ((newsrc-file gnus-current-startup-file) (quick-file (concat newsrc-file ".el"))) (save-excursion ;; We always load the .newsrc.eld file. If always contains ;; much information that can not be gotten from the .newsrc ;; file (ticked articles, killed groups, foreign methods, etc.) (gnus-read-newsrc-el-file quick-file) (if (or force (and (file-newer-than-file-p newsrc-file quick-file) (file-newer-than-file-p newsrc-file (concat quick-file "d"))) (not gnus-newsrc-alist)) ;; We read the .newsrc file. Note that if there if a ;; .newsrc.eld file exists, it has already been read, and ;; the `gnus-newsrc-hashtb' has been created. While reading ;; the .newsrc file, Gnus will only use the information it ;; can find there for changing the data already read - ;; ie. reading the .newsrc file will not trash the data ;; already read (except for read articles). (save-excursion (gnus-message 5 "Reading %s..." newsrc-file) (set-buffer (find-file-noselect newsrc-file)) (buffer-disable-undo (current-buffer)) (gnus-newsrc-to-gnus-format) (kill-buffer (current-buffer)) (gnus-message 5 "Reading %s...done" newsrc-file)))))) (defun gnus-read-newsrc-el-file (file) (let ((ding-file (concat file "d"))) ;; We always, always read the .eld file. (gnus-message 5 "Reading %s..." ding-file) (let (gnus-newsrc-assoc) (condition-case nil (load ding-file t t t) (error nil)) (and gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc))) (let ((inhibit-quit t)) (gnus-uncompress-newsrc-alist)) (gnus-make-hashtable-from-newsrc-alist) (if (not (file-newer-than-file-p file ding-file)) () ;; Old format quick file (gnus-message 5 "Reading %s..." file) ;; The .el file is newer than the .eld file, so we read that one ;; as well. (gnus-read-old-newsrc-el-file file)))) ;; Parse the old-style quick startup file (defun gnus-read-old-newsrc-el-file (file) (let (newsrc killed marked group m) (prog1 (let ((gnus-killed-assoc nil) gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc) (prog1 (condition-case nil (load file t t t) (error nil)) (setq newsrc gnus-newsrc-assoc killed gnus-killed-assoc marked gnus-marked-assoc))) (setq gnus-newsrc-alist nil) (while newsrc (setq group (car newsrc)) (let ((info (nth 2 (gnus-gethash (car group) gnus-newsrc-hashtb)))) (if info (progn (setcar (nthcdr 2 info) (cdr (cdr group))) (setcar (cdr info) (if (nth 1 group) gnus-level-default-subscribed gnus-level-default-unsubscribed)) (setq gnus-newsrc-alist (cons info gnus-newsrc-alist))) (setq gnus-newsrc-alist (cons (setq info (list (car group) (if (nth 1 group) gnus-level-default-subscribed gnus-level-default-unsubscribed) (cdr (cdr group)))) gnus-newsrc-alist))) (if (setq m (assoc (car group) marked)) (setcdr (cdr (cdr info)) (cons (list (cons 'tick (cdr m))) nil)))) (setq newsrc (cdr newsrc))) (setq newsrc killed) (while newsrc (setcar newsrc (car (car newsrc))) (setq newsrc (cdr newsrc))) (setq gnus-killed-list killed)) ;; The .el file version of this variable does not begin with ;; "options", while the .eld version does, so we just add it if it ;; isn't there. (and gnus-newsrc-options (progn (and (not (string-match "^ *options" gnus-newsrc-options)) (setq gnus-newsrc-options (concat "options " gnus-newsrc-options))) (and (not (string-match "\n$" gnus-newsrc-options)) (setq gnus-newsrc-options (concat gnus-newsrc-options "\n"))) ;; Finally, if we read some options lines, we parse them. (or (string= gnus-newsrc-options "") (gnus-newsrc-parse-options gnus-newsrc-options)))) (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)) (gnus-make-hashtable-from-newsrc-alist))) (defun gnus-make-newsrc-file (file) "Make server dependent file name by catenating FILE and server host name." (let* ((file (expand-file-name file nil)) (real-file (concat file "-" (nth 1 gnus-select-method)))) (if (or (file-exists-p real-file) (file-exists-p (concat real-file ".el")) (file-exists-p (concat real-file ".eld"))) real-file file))) (defun gnus-uncompress-newsrc-alist () ;; Uncompress all lists of marked articles in the newsrc assoc. (let ((newsrc gnus-newsrc-alist) marked) (while newsrc (if (not (setq marked (nth 3 (car newsrc)))) () (while marked (or (eq 'score (car (car marked))) (eq 'bookmark (car (car marked))) (eq 'killed (car (car marked))) (setcdr (car marked) (gnus-uncompress-range (cdr (car marked))))) (setq marked (cdr marked)))) (setq newsrc (cdr newsrc))))) (defun gnus-compress-newsrc-alist () ;; Compress all lists of marked articles in the newsrc assoc. (let ((newsrc gnus-newsrc-alist) marked) (while newsrc (if (not (setq marked (nth 3 (car newsrc)))) () (while marked (or (eq 'score (car (car marked))) (eq 'bookmark (car (car marked))) (eq 'killed (car (car marked))) (setcdr (car marked) (condition-case () (gnus-compress-sequence (sort (cdr (car marked)) '<) t) (error (cdr (car marked)))))) (setq marked (cdr marked)))) (setq newsrc (cdr newsrc))))) (defun gnus-newsrc-to-gnus-format () (setq gnus-newsrc-options "") (setq gnus-newsrc-options-n nil) (or gnus-active-hashtb (setq gnus-active-hashtb (make-vector 4095 0))) (let ((buf (current-buffer)) (already-read (> (length gnus-newsrc-alist) 1)) group subscribed options-symbol newsrc Options-symbol symbol reads num1) (goto-char (point-min)) ;; We intern the symbol `options' in the active hashtb so that we ;; can `eq' against it later. (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil) (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil) (while (not (eobp)) ;; We first read the first word on the line by narrowing and ;; then reading into `gnus-active-hashtb'. Most groups will ;; already exist in that hashtb, so this will save some string ;; space. (narrow-to-region (point) (progn (skip-chars-forward "^ \t!:\n") (point))) (goto-char (point-min)) (setq symbol (and (/= (point-min) (point-max)) (let ((obarray gnus-active-hashtb)) (read buf)))) (widen) ;; Now, the symbol we have read is either `options' or a group ;; name. If it is an options line, we just add it to a string. (cond ((or (eq symbol options-symbol) (eq symbol Options-symbol)) (setq gnus-newsrc-options ;; This concatting is quite inefficient, but since our ;; thorough studies show that approx 99.37% of all ;; .newsrc files only contain a single options line, we ;; don't give a damn, frankly, my dear. (concat gnus-newsrc-options (buffer-substring (gnus-point-at-bol) ;; Options may continue on the next line. (or (and (re-search-forward "^[^ \t]" nil 'move) (progn (beginning-of-line) (point))) (point))))) (forward-line -1)) (symbol (or (boundp symbol) (set symbol nil)) ;; It was a group name. (setq subscribed (= (following-char) ?:) group (symbol-name symbol) reads nil) (if (eolp) ;; If the line ends here, this is clearly a buggy line, so ;; we put point a the beginning of line and let the cond ;; below do the error handling. (beginning-of-line) ;; We skip to the beginning of the ranges. (skip-chars-forward "!: \t")) ;; We are now at the beginning of the list of read articles. ;; We read them range by range. (while (cond ((looking-at "[0-9]+") ;; We narrow and read a number instead of buffer-substring/ ;; string-to-int because it's faster. narrow/widen is ;; faster than save-restriction/narrow, and save-restriction ;; produces a garbage object. (setq num1 (progn (narrow-to-region (match-beginning 0) (match-end 0)) (read buf))) (widen) ;; If the next character is a dash, then this is a range. (if (= (following-char) ?-) (progn ;; We read the upper bound of the range. (forward-char 1) (if (not (looking-at "[0-9]+")) ;; This is a buggy line, by we pretend that ;; it's kinda OK. Perhaps the user should be ;; dinged? (setq reads (cons num1 reads)) (setq reads (cons (cons num1 (progn (narrow-to-region (match-beginning 0) (match-end 0)) (read buf))) reads)) (widen))) ;; It was just a simple number, so we add it to the ;; list of ranges. (setq reads (cons num1 reads))) ;; If the next char in ?\n, then we have reached the end ;; of the line and return nil. (/= (following-char) ?\n)) ((= (following-char) ?\n) ;; End of line, so we end. nil) (t ;; Not numbers and not eol, so this might be a buggy ;; line... (or (eobp) ;; If it was eob instead of ?\n, we allow it. (progn ;; The line was buggy. (setq group nil) (gnus-message 3 "Mangled line: %s" (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol))) (ding) (sit-for 1))) nil)) ;; Skip past ", ". Spaces are illegal in these ranges, but ;; we allow them, because it's a common mistake to put a ;; space after the comma. (skip-chars-forward ", ")) ;; We have already read .newsrc.eld, so we gently update the ;; data in the hash table with the information we have just ;; read. (if (not group) () (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) level) (if info ;; There is an entry for this file in the alist. (progn (setcar (nthcdr 2 info) (nreverse reads)) ;; We update the level very gently. In fact, we ;; only change it if there's been a status change ;; from subscribed to unsubscribed, or vice versa. (setq level (nth 1 info)) (cond ((and (<= level gnus-level-subscribed) (not subscribed)) (setq level (if reads gnus-level-default-unsubscribed (1+ gnus-level-default-unsubscribed)))) ((and (> level gnus-level-subscribed) subscribed) (setq level gnus-level-default-subscribed))) (setcar (cdr info) level)) ;; This is a new group. (setq info (list group (if subscribed gnus-level-default-subscribed (if reads (1+ gnus-level-subscribed) gnus-level-default-unsubscribed)) (nreverse reads)))) (setq newsrc (cons info newsrc)))))) (forward-line 1)) (setq newsrc (nreverse newsrc)) (if (not already-read) () ;; We now have two newsrc lists - `newsrc', which is what we ;; have read from .newsrc, and `gnus-newsrc-alist', which is ;; what we've read from .newsrc.eld. We have to merge these ;; lists. We do this by "attaching" any (foreign) groups in the ;; gnus-newsrc-alist to the (native) group that precedes them. (let ((rc (cdr gnus-newsrc-alist)) (prev gnus-newsrc-alist) entry mentry) (while rc (or (null (nth 4 (car rc))) ; It's a native group. (assoc (car (car rc)) newsrc) ; It's already in the alist. (if (setq entry (assoc (car (car prev)) newsrc)) (setcdr (setq mentry (memq entry newsrc)) (cons (car rc) (cdr mentry))) (setq newsrc (cons (car rc) newsrc)))) (setq prev rc rc (cdr rc))))) (setq gnus-newsrc-alist newsrc) ;; We make the newsrc hashtb. (gnus-make-hashtable-from-newsrc-alist) ;; Finally, if we read some options lines, we parse them. (or (string= gnus-newsrc-options "") (gnus-newsrc-parse-options gnus-newsrc-options)))) ;; Parse options lines to find "options -n !all rec.all" and stuff. ;; The return value will be a list on the form ;; ((regexp1 . ignore) ;; (regexp2 . subscribe)...) ;; When handling new newsgroups, groups that match a `ignore' regexp ;; will be ignored, and groups that match a `subscribe' regexp will be ;; subscribed. A line like ;; options -n !all rec.all ;; will lead to a list that looks like ;; (("^rec\\..+" . subscribe) ;; ("^.+" . ignore)) ;; So all "rec.*" groups will be subscribed, while all the other ;; groups will be ignored. Note that "options -n !all rec.all" is very ;; different from "options -n rec.all !all". (defun gnus-newsrc-parse-options (options) (let (out eol) (save-excursion (gnus-set-work-buffer) (insert (regexp-quote options)) ;; First we treat all continuation lines. (goto-char (point-min)) (while (re-search-forward "\n[ \t]+" nil t) (replace-match " " t t)) ;; Then we transform all "all"s into ".+"s. (goto-char (point-min)) (while (re-search-forward "\\ball\\b" nil t) (replace-match ".+" t t)) (goto-char (point-min)) ;; We remove all other options than the "-n" ones. (while (re-search-forward "[ \t]-[^n][^-]*" nil t) (replace-match " ") (forward-char -1)) (goto-char (point-min)) ;; We are only interested in "options -n" lines - we ;; ignore the other option lines. (while (re-search-forward "[ \t]-n" nil t) (setq eol (or (save-excursion (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) (- (point) 2))) (gnus-point-at-eol))) ;; Search for all "words"... (while (re-search-forward "[^ \t,\n]+" eol t) (if (= (char-after (match-beginning 0)) ?!) ;; If the word begins with a bang (!), this is a "not" ;; spec. We put this spec (minus the bang) and the ;; symbol `ignore' into the list. (setq out (cons (cons (concat "^" (buffer-substring (1+ (match-beginning 0)) (match-end 0))) 'ignore) out)) ;; There was no bang, so this is a "yes" spec. (setq out (cons (cons (concat "^" (buffer-substring (match-beginning 0) (match-end 0))) 'subscribe) out))))) (setq gnus-newsrc-options-n out)))) (defun gnus-save-newsrc-file () "Save .newsrc file." ;; Note: We cannot save .newsrc file if all newsgroups are removed ;; from the variable gnus-newsrc-alist. (and (or gnus-newsrc-alist gnus-killed-list) gnus-current-startup-file (progn (run-hooks 'gnus-save-newsrc-hook) (save-excursion (if (and gnus-use-dribble-file (or (not gnus-dribble-buffer) (not (buffer-name gnus-dribble-buffer)) (zerop (save-excursion (set-buffer gnus-dribble-buffer) (buffer-size))))) (gnus-message 4 "(No changes need to be saved)") (if gnus-save-newsrc-file (progn (gnus-message 5 "Saving %s..." gnus-current-startup-file) ;; Make backup file of master newsrc. (gnus-gnus-to-newsrc-format) (gnus-message 5 "Saving %s...done" gnus-current-startup-file))) ;; Quickly loadable .newsrc. (set-buffer (get-buffer-create " *Gnus-newsrc*")) (setq buffer-file-name (concat gnus-current-startup-file ".eld")) (gnus-add-current-to-buffer-list) (buffer-disable-undo (current-buffer)) (erase-buffer) (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) (gnus-gnus-to-quick-newsrc-format) (save-buffer) (kill-buffer (current-buffer)) (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file) (gnus-dribble-delete-file)))))) (defun gnus-gnus-to-quick-newsrc-format () "Insert Gnus variables such as gnus-newsrc-alist in lisp format." (insert ";; Gnus startup file.\n") (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n") (insert ";; to read .newsrc.\n") (insert "(setq gnus-newsrc-file-version " (prin1-to-string gnus-version) ")\n") (let ((variables gnus-variable-list) (inhibit-quit t) (gnus-newsrc-alist (cdr gnus-newsrc-alist)) variable) ;; insert lisp expressions. (gnus-compress-newsrc-alist) (while variables (setq variable (car variables)) (and (boundp variable) (symbol-value variable) (or gnus-save-killed-list (not (eq variable 'gnus-killed-list))) (insert "(setq " (symbol-name variable) " '" (prin1-to-string (symbol-value variable)) ")\n")) (setq variables (cdr variables))) (gnus-uncompress-newsrc-alist))) (defun gnus-gnus-to-newsrc-format () ;; Generate and save the .newsrc file. (let ((newsrc (cdr gnus-newsrc-alist)) info ranges range) (save-excursion (set-buffer (create-file-buffer gnus-current-startup-file)) (setq buffer-file-name gnus-current-startup-file) (buffer-disable-undo (current-buffer)) (erase-buffer) ;; Write options. (if gnus-newsrc-options (insert gnus-newsrc-options)) ;; Write subscribed and unsubscribed. (while newsrc (setq info (car newsrc)) (if (not (nth 4 info)) ;Don't write foreign groups to .newsrc. (progn (insert (car info) (if (> (nth 1 info) gnus-level-subscribed) "!" ":")) (if (setq ranges (nth 2 info)) (progn (insert " ") (if (not (listp (cdr ranges))) (if (= (car ranges) (cdr ranges)) (insert (int-to-string (car ranges))) (insert (int-to-string (car ranges)) "-" (int-to-string (cdr ranges)))) (while ranges (setq range (car ranges) ranges (cdr ranges)) (if (or (atom range) (= (car range) (cdr range))) (insert (int-to-string (or (and (atom range) range) (car range)))) (insert (int-to-string (car range)) "-" (int-to-string (cdr range)))) (if ranges (insert ",")))))) (insert "\n"))) (setq newsrc (cdr newsrc))) ;; It has been reported that sometime the modtime on the .newsrc ;; file seems to be off. We really do want to overwrite it, so ;; we clear the modtime here before saving. It's a bit odd, ;; though... ;; sometimes the modtime clear isn't sufficient. most brute force: ;; delete the silly thing entirely first. but this fails to provide ;; such niceties as .newsrc~ creation. (if gnus-modtime-botch (delete-file gnus-startup-file) (clear-visited-file-modtime)) (save-buffer) (kill-buffer (current-buffer))))) (defun gnus-read-all-descriptions-files () (let ((methods (cons gnus-select-method gnus-secondary-select-methods))) (while methods (gnus-read-descriptions-file (car methods)) (setq methods (cdr methods))) t)) (defun gnus-read-descriptions-file (&optional method) (let ((method (or method gnus-select-method))) ;; We create the hashtable whether we manage to read the desc file ;; to avoid trying to re-read after a failed read. (or gnus-description-hashtb (setq gnus-description-hashtb (gnus-make-hashtable (length gnus-active-hashtb)))) ;; Mark this method's desc file as read. (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" gnus-description-hashtb) (gnus-message 5 "Reading descriptions file via %s..." (car method)) (cond ((not (gnus-check-server method)) (gnus-message 1 "Couldn't open server") nil) ((not (gnus-request-list-newsgroups method)) (gnus-message 1 "Couldn't read newsgroups descriptions") nil) (t (let (group) (save-excursion (save-restriction (set-buffer nntp-server-buffer) (goto-char (point-min)) (if (or (search-forward "\n.\n" nil t) (goto-char (point-max))) (progn (beginning-of-line) (narrow-to-region (point-min) (point)))) (goto-char (point-min)) (while (not (eobp)) ;; If we get an error, we set group to 0, which is not a ;; symbol... (setq group (condition-case () (let ((obarray gnus-description-hashtb)) ;; Group is set to a symbol interned in this ;; hash table. (read nntp-server-buffer)) (error 0))) (skip-chars-forward " \t") ;; ... which leads to this line being effectively ignored. (and (symbolp group) (set group (buffer-substring (point) (progn (end-of-line) (point))))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done") t))))) (defun gnus-group-get-description (group) ;; Get the description of a group by sending XGTITLE to the server. (and (gnus-request-group-description group) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) (and (looking-at "[^ \t]+[ \t]+\\(.*\\)") (buffer-substring (match-beginning 1) (match-end 1)))))) ;;; ;;; Server ;;; (defvar gnus-server-mode-hook nil "Hook run in `gnus-server-mode' buffers.") (defconst gnus-server-line-format " {%(%h:%w%)}\n" "Format of server lines. It works along the same lines as a normal formatting string, with some simple extensions.") (defvar gnus-server-mode-line-format "Gnus List of servers" "The format specification for the server mode line.") (defconst gnus-server-line-format-alist (list (list ?h 'how ?s) (list ?n 'name ?s) (list ?w 'where ?s) )) (defconst gnus-server-mode-line-format-alist (list (list ?S 'news-server ?s) (list ?M 'news-method ?s) (list ?u 'user-defined ?s))) (defvar gnus-server-line-format-spec nil) (defvar gnus-server-mode-line-format-spec nil) (defvar gnus-server-killed-servers nil) (defvar gnus-server-mode-map nil) (put 'gnus-server-mode 'mode-class 'special) (if gnus-server-mode-map nil (setq gnus-server-mode-map (make-sparse-keymap)) (suppress-keymap gnus-server-mode-map) (define-key gnus-server-mode-map " " 'gnus-server-read-server) (define-key gnus-server-mode-map "\r" 'gnus-server-read-server) (define-key gnus-server-mode-map gnus-mouse-2 'gnus-server-pick-server) (define-key gnus-server-mode-map "q" 'gnus-server-exit) (define-key gnus-server-mode-map "l" 'gnus-server-list-servers) (define-key gnus-server-mode-map "k" 'gnus-server-kill-server) (define-key gnus-server-mode-map "y" 'gnus-server-yank-server) (define-key gnus-server-mode-map "c" 'gnus-server-copy-server) (define-key gnus-server-mode-map "a" 'gnus-server-add-server) (define-key gnus-server-mode-map "e" 'gnus-server-edit-server)) (defun gnus-server-mode () "Major mode for listing and editing servers. All normal editing commands are switched off. \\ For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). The following commands are available: \\{gnus-server-mode-map}" (interactive) (if gnus-visual (gnus-server-make-menu-bar)) (kill-all-local-variables) (setq mode-line-modified "-- ") (make-local-variable 'mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) (and (equal (nth 3 mode-line-format) " ") (setcar (nthcdr 3 mode-line-format) "")) (setq major-mode 'gnus-server-mode) (setq mode-name "Server") ; (gnus-group-set-mode-line) (setq mode-line-process nil) (use-local-map gnus-server-mode-map) (buffer-disable-undo (current-buffer)) (setq truncate-lines t) (setq buffer-read-only t) (run-hooks 'gnus-server-mode-hook)) (defun gnus-server-insert-server-line (sformat name method) (let* ((sformat (or sformat gnus-server-line-format-spec)) (how (car method)) (where (nth 1 method)) b) (beginning-of-line) (setq b (point)) ;; Insert the text. (insert (eval sformat)) (add-text-properties b (1+ b) (list 'gnus-server (intern name))))) (defun gnus-server-setup-buffer () (if (get-buffer gnus-server-buffer) () (save-excursion (set-buffer (get-buffer-create gnus-server-buffer)) (gnus-server-mode) (and gnus-carpal (gnus-carpal-setup-buffer 'server))))) (defun gnus-server-prepare () (setq gnus-server-mode-line-format-spec (gnus-parse-format gnus-server-mode-line-format gnus-server-mode-line-format-alist)) (setq gnus-server-line-format-spec (gnus-parse-format gnus-server-line-format gnus-server-line-format-alist)) (let ((alist gnus-server-alist) (buffer-read-only nil)) (erase-buffer) (while alist (gnus-server-insert-server-line nil (car (car alist)) (cdr (car alist))) (setq alist (cdr alist)))) (goto-char (point-min)) (gnus-server-position-cursor)) (defun gnus-server-server-name () (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server))) (and server (symbol-name server)))) (defalias 'gnus-server-position-cursor 'gnus-goto-colon) (defconst gnus-server-edit-buffer "*Gnus edit server*") (defun gnus-server-update-server (server) (save-excursion (set-buffer gnus-server-buffer) (let ((buffer-read-only nil) (info (cdr (assoc server gnus-server-alist)))) (gnus-dribble-enter (concat "(gnus-server-set-info \"" server "\" '" (prin1-to-string info) ")")) ;; Buffer may be narrowed. (save-restriction (widen) (if (gnus-server-goto-server server) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) (let ((entry (assoc server gnus-server-alist))) (gnus-server-insert-server-line nil (car entry) (cdr entry)) (gnus-server-position-cursor)))))) (defun gnus-server-set-info (server info) ;; Enter a select method into the virtual server alist. (gnus-dribble-enter (concat "(gnus-server-set-info \"" server "\" '" (prin1-to-string info) ")")) (let* ((server (nth 1 info)) (entry (assoc server gnus-server-alist))) (if entry (setcdr entry info) (setq gnus-server-alist (nconc gnus-server-alist (list (cons server info))))))) (defun gnus-server-to-method (server) ;; Map virtual server names to select methods. (or (and (equal server "native") gnus-select-method) (cdr (assoc server gnus-server-alist)))) (defun gnus-server-extend-method (group method) ;; This function "extends" a virtual server. If the server is ;; "hello", and the select method is ("hello" (my-var "something")) ;; in the group "alt.alt", this will result in a new virtual server ;; called "helly+alt.alt". (let ((entry (gnus-copy-sequence (if (equal (car method) "native") gnus-select-method (cdr (assoc (car method) gnus-server-alist)))))) (setcar (cdr entry) (concat (nth 1 entry) "+" group)) (nconc entry (cdr method)))) (defun gnus-server-get-method (group method) ;; Input either a server name, and extended server name, or a ;; select method, and return a select method. (cond ((stringp method) (gnus-server-to-method method)) ((and (stringp (car method)) group) (gnus-server-extend-method group method)) (t (gnus-server-add-address method)))) (defun gnus-server-add-address (method) (let ((method-name (symbol-name (car method)))) (if (and (memq 'address (assoc method-name gnus-valid-select-methods)) (not (assq (intern (concat method-name "-address")) method))) (append method (list (list (intern (concat method-name "-address")) (nth 1 method)))) method))) (defun gnus-server-equal (s1 s2) (or (equal s1 s2) (and (= (length s1) (length s2)) (progn (while (and s1 (member (car s1) s2)) (setq s1 (cdr s1))) (null s1))))) ;;; Interactive server functions. (defun gnus-server-kill-server (server) "Kill the server on the current line." (interactive (list (gnus-server-server-name))) (or (gnus-server-goto-server server) (if server (error "No such server: %s" server) (error "No server on the current line"))) (gnus-dribble-enter "") (let ((buffer-read-only nil)) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) (setq gnus-server-killed-servers (cons (assoc server gnus-server-alist) gnus-server-killed-servers)) (setq gnus-server-alist (delq (car gnus-server-killed-servers) gnus-server-alist)) (gnus-server-position-cursor)) (defun gnus-server-yank-server () "Yank the previously killed server." (interactive) (or gnus-server-killed-servers (error "No killed servers to be yanked")) (let ((alist gnus-server-alist) (server (gnus-server-server-name)) (killed (car gnus-server-killed-servers))) (if (not server) (setq gnus-server-alist (nconc gnus-server-alist (list killed))) (if (string= server (car (car gnus-server-alist))) (setq gnus-server-alist (cons killed gnus-server-alist)) (while (and (cdr alist) (not (string= server (car (car (cdr alist)))))) (setq alist (cdr alist))) (setcdr alist (cons killed (cdr alist))))) (gnus-server-update-server (car killed)) (setq gnus-server-killed-servers (cdr gnus-server-killed-servers)) (gnus-server-position-cursor))) (defun gnus-server-exit () "Return to the group buffer." (interactive) (kill-buffer (current-buffer)) (switch-to-buffer gnus-group-buffer)) (defun gnus-server-list-servers () "List all available servers." (interactive) (let ((cur (gnus-server-server-name))) (gnus-server-prepare) (if cur (gnus-server-goto-server cur) (goto-char (point-max)) (forward-line -1)) (gnus-server-position-cursor))) (defun gnus-server-copy-server (from to) (interactive (list (or (gnus-server-server-name) (error "No server on the current line")) (read-string "Copy to: "))) (or from (error "No server on current line")) (or (and to (not (string= to ""))) (error "No name to copy to")) (and (assoc to gnus-server-alist) (error "%s already exists" to)) (or (assoc from gnus-server-alist) (error "%s: no such server" from)) (let ((to-entry (gnus-copy-sequence (assoc from gnus-server-alist)))) (setcar to-entry to) (setcar (nthcdr 2 to-entry) to) (setq gnus-server-killed-servers (cons to-entry gnus-server-killed-servers)) (gnus-server-yank-server))) (defun gnus-server-add-server (how where) (interactive (list (intern (completing-read "Server method: " gnus-valid-select-methods nil t)) (read-string "Server name: "))) (setq gnus-server-killed-servers (cons (list where how where) gnus-server-killed-servers)) (gnus-server-yank-server)) (defun gnus-server-goto-server (server) "Jump to a server line." (interactive (list (completing-read "Goto server: " gnus-server-alist nil t))) (let ((to (text-property-any (point-min) (point-max) 'gnus-server (intern server)))) (and to (progn (goto-char to) (gnus-server-position-cursor))))) (defun gnus-server-edit-server (server) "Edit the server on the current line." (interactive (list (gnus-server-server-name))) (or server (error "No server on current line")) (let ((winconf (current-window-configuration))) (get-buffer-create gnus-server-edit-buffer) (gnus-configure-windows 'edit-server) (gnus-add-current-to-buffer-list) (emacs-lisp-mode) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) (use-local-map (copy-keymap (current-local-map))) (let ((done-func '(lambda () "Exit editing mode and update the information." (interactive) (gnus-server-edit-server-done 'group)))) (setcar (cdr (nth 4 done-func)) server) (local-set-key "\C-c\C-c" done-func)) (erase-buffer) (insert ";; Type `C-c C-c' after you have edited the server.\n\n") (insert (pp-to-string (cdr (assoc server gnus-server-alist)))))) (defun gnus-server-edit-server-done (server) (interactive) (set-buffer (get-buffer-create gnus-server-edit-buffer)) (goto-char (point-min)) (let ((form (read (current-buffer))) (winconf gnus-prev-winconf)) (gnus-server-set-info server form) (kill-buffer (current-buffer)) (and winconf (set-window-configuration winconf)) (set-buffer gnus-server-buffer) (gnus-server-update-server (gnus-server-server-name)) (gnus-server-list-servers) (gnus-server-position-cursor))) (defun gnus-server-read-server (server) "Browse a server." (interactive (list (gnus-server-server-name))) (gnus-browse-foreign-server (gnus-server-to-method server) (current-buffer))) (defun gnus-mouse-pick-server (e) (interactive "e") (mouse-set-point e) (gnus-server-read-server (gnus-server-server-name))) ;;; ;;; entry points into gnus-score.el ;;; ;;; Finding score files. (defvar gnus-global-score-files nil "*List of global score files and directories. Set this variable if you want to use people's score files. One entry for each score file or each score file directory. Gnus will decide by itself what score files are applicable to which group. Say you want to use the single score file \"/ftp.ifi.uio.no@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all score files in the \"/ftp.some-where:/pub/score\" directory. (setq gnus-global-score-files '(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\" \"/ftp.some-where:/pub/score\"))") (defun gnus-score-score-files (group) "Return a list of all possible score files." ;; Search and set any global score files. (and gnus-global-score-files (or gnus-internal-global-score-files (gnus-score-search-global-directories gnus-global-score-files))) ;; Fix the kill-file dir variable. (setq gnus-kill-files-directory (file-name-as-directory (or gnus-kill-files-directory "~/News/"))) ;; If we can't read it, there are no score files. (if (not (file-exists-p (expand-file-name gnus-kill-files-directory))) (setq gnus-score-file-list nil) (if (gnus-use-long-file-name 'not-score) ;; We want long file names. (if (or (not gnus-score-file-list) (not (car gnus-score-file-list)) (gnus-file-newer-than gnus-kill-files-directory (car gnus-score-file-list))) (setq gnus-score-file-list (cons (nth 5 (file-attributes gnus-kill-files-directory)) (nreverse (directory-files gnus-kill-files-directory t (gnus-score-file-regexp)))))) ;; We do not use long file names, so we have to do some ;; directory traversing. (let ((mdir (length (expand-file-name gnus-kill-files-directory))) (suffixes (list gnus-score-file-suffix gnus-adaptive-file-suffix)) dir files suffix) (while suffixes (setq dir (expand-file-name (concat gnus-kill-files-directory (gnus-replace-chars-in-string group ?. ?/)))) (setq dir (gnus-replace-chars-in-string dir ?: ?/)) (setq suffix (car suffixes) suffixes (cdr suffixes)) (if (file-exists-p (concat dir "/" suffix)) (setq files (cons (concat dir "/" suffix) files))) (while (>= (1+ (length dir)) mdir) (and (file-exists-p (concat dir "/all/" suffix)) (setq files (cons (concat dir "/all/" suffix) files))) (string-match "/[^/]*$" dir) (setq dir (substring dir 0 (match-beginning 0))))) (setq gnus-score-file-list (cons nil (nreverse files))))) (cdr gnus-score-file-list))) (defun gnus-score-file-regexp () (concat "\\(" gnus-score-file-suffix "\\|" gnus-adaptive-file-suffix "\\)$")) (defun gnus-score-find-bnews (group) "Return a list of score files for GROUP. The score files are those files in the ~/News directory which matches GROUP using BNews sys file syntax." (let* ((sfiles (append (gnus-score-score-files group) gnus-internal-global-score-files)) (kill-dir (file-name-as-directory (expand-file-name gnus-kill-files-directory))) (klen (length kill-dir)) ofiles not-match regexp) (save-excursion (set-buffer (get-buffer-create "*gnus score files*")) (buffer-disable-undo (current-buffer)) ;; Go through all score file names and create regexp with them ;; as the source. (while sfiles (erase-buffer) (insert (car sfiles)) (goto-char (point-min)) ;; First remove the suffix itself. (re-search-forward (concat "." (gnus-score-file-regexp))) (replace-match "" t t) (goto-char (point-min)) (if (looking-at (regexp-quote kill-dir)) ;; If the file name was just "SCORE", `klen' is one character ;; too much. (delete-char (min (1- (point-max)) klen)) (goto-char (point-max)) (search-backward "/") (delete-region (1+ (point)) (point-min))) ;; If short file names were used, we have to translate slashes. (goto-char (point-min)) (while (re-search-forward "[/:]" nil t) (replace-match "." t t)) ;; Cludge to get rid of "nntp+" problems. (goto-char (point-min)) (and (looking-at "nn[a-z]+\\+") (progn (search-forward "+") (forward-char -1) (insert "\\"))) ;; Translate ".all" to "[./].*"; (while (search-forward ".all" nil t) (replace-match "[./:].*" t t)) (goto-char (point-min)) ;; Translate "all" to ".*". (while (search-forward "all" nil t) (replace-match ".*" t t)) (goto-char (point-min)) ;; Deal with "not."s. (if (looking-at "not.") (progn (setq not-match t) (setq regexp (buffer-substring 5 (point-max)))) (setq regexp (buffer-substring 1 (point-max))) (setq not-match nil)) ;; Finally - if this resulting regexp matches the group name, ;; we add this score file to the list of score files ;; applicable to this group. (if (or (and not-match (not (string-match regexp group))) (and (not not-match) (string-match regexp group))) (setq ofiles (cons (car sfiles) ofiles))) (setq sfiles (cdr sfiles))) (kill-buffer (current-buffer)) ;; Slight kludge here - the last score file returned should be ;; the local score file, whether it exists or not. This is so ;; that any score commands the user enters will go to the right ;; file, and not end up in some global score file. (let ((localscore (expand-file-name (if (gnus-use-long-file-name 'not-score) (concat gnus-kill-files-directory group "." gnus-score-file-suffix) (concat gnus-kill-files-directory (gnus-replace-chars-in-string group ?. ?/ ?: ?/) "/" gnus-score-file-suffix))))) ;; The localest score file might already be there, but it's ;; supposed to be the very last file, so we delete it from the ;; list if it's already there, and add it to the head of the ;; list. (setq ofiles (cons localscore (delete localscore ofiles)))) (nreverse ofiles)))) (defun gnus-score-find-single (group) "Return list containing the score file for GROUP." (list (gnus-score-file-name group gnus-adaptive-file-suffix) (gnus-score-file-name group))) (defun gnus-score-find-hierarchical (group) "Return list of score files for GROUP. This includes the score file for the group and all its parents." (let ((all (copy-sequence '(nil))) (start 0)) (while (string-match "\\." group (1+ start)) (setq start (match-beginning 0)) (setq all (cons (substring group 0 start) all))) (setq all (cons group all)) (nconc (mapcar (lambda (newsgroup) (gnus-score-file-name newsgroup gnus-adaptive-file-suffix)) (setq all (nreverse all))) (mapcar 'gnus-score-file-name all)))) (defvar gnus-score-file-alist-cache nil) (defun gnus-score-find-alist (group) "Return list of score files for GROUP. The list is determined from the variable gnus-score-file-alist." (let ((alist gnus-score-file-multiple-match-alist) score-files) ;; if this group has been seen before, return the cached entry (if (setq score-files (assoc group gnus-score-file-alist-cache)) (cdr score-files) ;ensures caching groups with no matches ;; handle the multiple match alist (while alist (and (string-match (car (car alist)) group) (setq score-files (nconc score-files (copy-sequence (cdr (car alist)))))) (setq alist (cdr alist))) (setq alist gnus-score-file-single-match-alist) ;; handle the single match alist (while alist (and (string-match (car (car alist)) group) ;; progn used just in case ("regexp") has no files ;; and score-files is still nil. -sj ;; this can be construed as a "stop searching here" feature :> ;; and used to simplify regexps in the single-alist (progn (setq score-files (nconc score-files (copy-sequence (cdr (car alist))))) (setq alist nil))) (setq alist (cdr alist))) ;; cache the score files (setq gnus-score-file-alist-cache (cons (cons group score-files) gnus-score-file-alist-cache)) score-files))) (defun gnus-possibly-score-headers (&optional trace) (let ((func gnus-score-find-score-files-function) score-files) (and func (not (listp func)) (setq func (list func))) ;; Go through all the functions for finding score files (or actual ;; scores) and add them to a list. (setq score-files (gnus-score-find-alist gnus-newsgroup-name)) (while func (and (symbolp (car func)) (fboundp (car func)) (setq score-files (nconc score-files (funcall (car func) gnus-newsgroup-name)))) (setq func (cdr func))) (if score-files (gnus-score-headers score-files trace)))) (defun gnus-score-file-name (newsgroup &optional suffix) "Return the name of a score file for NEWSGROUP." (let ((suffix (or suffix gnus-score-file-suffix))) (cond ((or (null newsgroup) (string-equal newsgroup "")) ;; The global score file is placed at top of the directory. (expand-file-name suffix (or gnus-kill-files-directory "~/News"))) ((gnus-use-long-file-name 'not-score) ;; Append ".SCORE" to newsgroup name. (expand-file-name (concat (gnus-newsgroup-saveable-name newsgroup) "." suffix) (or gnus-kill-files-directory "~/News"))) (t ;; Place "SCORE" under the hierarchical directory. (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" suffix) (or gnus-kill-files-directory "~/News")))))) (defun gnus-score-search-global-directories (files) "Scan all global score directories for score files." ;; Set the variable `gnus-internal-global-score-files' to all ;; available global score files. (interactive (list gnus-global-score-files)) (let (out) (while files (if (string-match "/$" (car files)) (setq out (nconc (directory-files (car files) t (concat (gnus-score-file-regexp) "$")))) (setq out (cons (car files) out))) (setq files (cdr files))) (setq gnus-internal-global-score-files out))) ;; Allow redefinition of Gnus functions. (gnus-ems-redefine) (provide 'gnus) ;;; gnus.el ends here emacs-19.30/lisp/gomoku.el100444 75424 1 122213 5752221326 14141 0ustar kwzhdaemon;;; gomoku.el --- Gomoku game between you and Emacs ;; Copyright (C) 1988, 1994 Free Software Foundation, Inc. ;; Author: Philippe Schnoebelen ;; Adapted-By: ESR ;; Keywords: games ;; 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: ;;; Gomoku game between you and GNU Emacs. Last modified on 13 Sep 1988 ;;; ;;; Written by Ph. Schnoebelen (phs@lifia.imag.fr), 1987, 1988 ;;; with precious advices from J.-F. Rit. ;;; This has been tested with GNU Emacs 18.50. ;; RULES: ;; ;; Gomoku is a game played between two players on a rectangular board. Each ;; player, in turn, marks a free square of its choice. The winner is the first ;; one to mark five contiguous squares in any direction (horizontally, ;; vertically or diagonally). ;; ;; I have been told that, in "The TRUE Gomoku", some restrictions are made ;; about the squares where one may play, or else there is a known forced win ;; for the first player. This program has no such restriction, but it does not ;; know about the forced win, nor do I. Furthermore, you probably do not know ;; it yourself :-). ;; There are two main places where you may want to customize the program: key ;; bindings and board display. These features are commented in the code. Go ;; and see. ;; HOW TO USE: ;; ;; The command "M-x gomoku" displays a ;; board, the size of which depends on the size of the current window. The ;; size of the board is easily modified by giving numeric arguments to the ;; gomoku command and/or by customizing the displaying parameters. ;; ;; Emacs plays when it is its turn. When it is your turn, just put the cursor ;; on the square where you want to play and hit RET, or X, or whatever key you ;; bind to the command gomoku-human-plays. When it is your turn, Emacs is ;; idle: you may switch buffers, read your mail, ... Just come back to the ;; *Gomoku* buffer and resume play. ;; ALGORITHM: ;; ;; The algorithm is briefly described in section "THE SCORE TABLE". Some ;; parameters may be modified if you want to change the style exhibited by the ;; program. ;;; Code: ;;; ;;; GOMOKU MODE AND KEYMAP. ;;; (defvar gomoku-mode-hook nil "If non-nil, its value is called on entry to Gomoku mode.") (defvar gomoku-mode-map nil "Local keymap to use in Gomoku mode.") (if gomoku-mode-map nil (setq gomoku-mode-map (make-sparse-keymap)) ;; Key bindings for cursor motion. Arrow keys are just "function" ;; keys, see below. (define-key gomoku-mode-map "y" 'gomoku-move-nw) ; Y (define-key gomoku-mode-map "u" 'gomoku-move-ne) ; U (define-key gomoku-mode-map "b" 'gomoku-move-sw) ; B (define-key gomoku-mode-map "n" 'gomoku-move-se) ; N (define-key gomoku-mode-map "h" 'gomoku-move-left) ; H (define-key gomoku-mode-map "l" 'gomoku-move-right) ; L (define-key gomoku-mode-map "j" 'gomoku-move-down) ; J (define-key gomoku-mode-map "k" 'gomoku-move-up) ; K (define-key gomoku-mode-map "\C-n" 'gomoku-move-down) ; C-N (define-key gomoku-mode-map "\C-p" 'gomoku-move-up) ; C-P (define-key gomoku-mode-map "\C-f" 'gomoku-move-right) ; C-F (define-key gomoku-mode-map "\C-b" 'gomoku-move-left) ; C-B ;; Key bindings for entering Human moves. ;; If you have a mouse, you may also bind some mouse click ... (define-key gomoku-mode-map "X" 'gomoku-human-plays) ; X (define-key gomoku-mode-map "x" 'gomoku-human-plays) ; x (define-key gomoku-mode-map "\C-m" 'gomoku-human-plays) ; RET (define-key gomoku-mode-map "\C-c\C-p" 'gomoku-human-plays) ; C-C C-P (define-key gomoku-mode-map "\C-c\C-b" 'gomoku-human-takes-back) ; C-C C-B (define-key gomoku-mode-map "\C-c\C-r" 'gomoku-human-resigns) ; C-C C-R (define-key gomoku-mode-map "\C-c\C-e" 'gomoku-emacs-plays) ; C-C C-E (define-key gomoku-mode-map [up] 'gomoku-move-up) (define-key gomoku-mode-map [down] 'gomoku-move-down) (define-key gomoku-mode-map [left] 'gomoku-move-left) (define-key gomoku-mode-map [right] 'gomoku-move-right) (define-key gomoku-mode-map [kp-enter] 'gomoku-human-plays) (define-key gomoku-mode-map [mouse-2] 'gomoku-click) (define-key gomoku-mode-map [insert] 'gomoku-human-plays)) (defun gomoku-mode () "Major mode for playing Gomoku against Emacs. You and Emacs play in turn by marking a free square. You mark it with X and Emacs marks it with O. The winner is the first to get five contiguous marks horizontally, vertically or in diagonal. You play by moving the cursor over the square you choose and hitting \\[gomoku-human-plays]. Other useful commands: \\{gomoku-mode-map} Entry to this mode calls the value of `gomoku-mode-hook' if that value is non-nil." (interactive) (setq major-mode 'gomoku-mode mode-name "Gomoku") (gomoku-display-statistics) (use-local-map gomoku-mode-map) (run-hooks 'gomoku-mode-hook)) ;;; ;;; THE BOARD. ;;; ;; The board is a rectangular grid. We code empty squares with 0, X's with 1 ;; and O's with 6. The rectangle is recorded in a one dimensional vector ;; containing padding squares (coded with -1). These squares allow us to ;; detect when we are trying to move out of the board. We denote a square by ;; its (X,Y) coords, or by the INDEX corresponding to them in the vector. The ;; leftmost topmost square has coords (1,1) and index gomoku-board-width + 2. ;; Similarly, vectors between squares may be given by two DX, DY coords or by ;; one DEPL (the difference between indexes). (defvar gomoku-board-width nil "Number of columns on the Gomoku board.") (defvar gomoku-board-height nil "Number of lines on the Gomoku board.") (defvar gomoku-board nil "Vector recording the actual state of the Gomoku board.") (defvar gomoku-vector-length nil "Length of gomoku-board vector.") (defvar gomoku-draw-limit nil ;; This is usually set to 70% of the number of squares. "After how many moves will Emacs offer a draw?") (defun gomoku-xy-to-index (x y) "Translate X, Y cartesian coords into the corresponding board index." (+ (* y gomoku-board-width) x y)) (defun gomoku-index-to-x (index) "Return corresponding x-coord of board INDEX." (% index (1+ gomoku-board-width))) (defun gomoku-index-to-y (index) "Return corresponding y-coord of board INDEX." (/ index (1+ gomoku-board-width))) (defun gomoku-init-board () "Create the gomoku-board vector and fill it with initial values." (setq gomoku-board (make-vector gomoku-vector-length 0)) ;; Every square is 0 (i.e. empty) except padding squares: (let ((i 0) (ii (1- gomoku-vector-length))) (while (<= i gomoku-board-width) ; The squares in [0..width] and in (aset gomoku-board i -1) ; [length - width - 1..length - 1] (aset gomoku-board ii -1) ; are padding squares. (setq i (1+ i) ii (1- ii)))) (let ((i 0)) (while (< i gomoku-vector-length) (aset gomoku-board i -1) ; and also all k*(width+1) (setq i (+ i gomoku-board-width 1))))) ;;; ;;; THE SCORE TABLE. ;;; ;; Every (free) square has a score associated to it, recorded in the ;; GOMOKU-SCORE-TABLE vector. The program always plays in the square having ;; the highest score. (defvar gomoku-score-table nil "Vector recording the actual score of the free squares.") ;; The key point point about the algorithm is that, rather than considering ;; the board as just a set of squares, we prefer to see it as a "space" of ;; internested 5-tuples of contiguous squares (called qtuples). ;; ;; The aim of the program is to fill one qtuple with its O's while preventing ;; you from filling another one with your X's. To that effect, it computes a ;; score for every qtuple, with better qtuples having better scores. Of ;; course, the score of a qtuple (taken in isolation) is just determined by ;; its contents as a set, i.e. not considering the order of its elements. The ;; highest score is given to the "OOOO" qtuples because playing in such a ;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because ;; not playing in it is just loosing the game, and so on. Note that a ;; "polluted" qtuple, i.e. one containing at least one X and at least one O, ;; has score zero because there is no more any point in playing in it, from ;; both an attacking and a defending point of view. ;; ;; Given the score of every qtuple, the score of a given free square on the ;; board is just the sum of the scores of all the qtuples to which it belongs, ;; because playing in that square is playing in all its containing qtuples at ;; once. And it is that function which takes into account the internesting of ;; the qtuples. ;; ;; This algorithm is rather simple but anyway it gives a not so dumb level of ;; play. It easily extends to "n-dimensional Gomoku", where a win should not ;; be obtained with as few as 5 contiguous marks: 6 or 7 (depending on n !) ;; should be preferred. ;; Here are the scores of the nine "non-polluted" configurations. Tuning ;; these values will change (hopefully improve) the strength of the program ;; and may change its style (rather aggressive here). (defconst nil-score 7 "Score of an empty qtuple.") (defconst Xscore 15 "Score of a qtuple containing one X.") (defconst XXscore 400 "Score of a qtuple containing two X's.") (defconst XXXscore 1800 "Score of a qtuple containing three X's.") (defconst XXXXscore 100000 "Score of a qtuple containing four X's.") (defconst Oscore 35 "Score of a qtuple containing one O.") (defconst OOscore 800 "Score of a qtuple containing two O's.") (defconst OOOscore 15000 "Score of a qtuple containing three O's.") (defconst OOOOscore 800000 "Score of a qtuple containing four O's.") ;; These values are not just random: if, given the following situation: ;; ;; . . . . . . . O . ;; . X X a . . . X . ;; . . . X . . . X . ;; . . . X . . . X . ;; . . . . . . . b . ;; ;; you want Emacs to play in "a" and not in "b", then the parameters must ;; satisfy the inequality: ;; ;; 6 * XXscore > XXXscore + XXscore ;; ;; because "a" mainly belongs to six "XX" qtuples (the others are less ;; important) while "b" belongs to one "XXX" and one "XX" qtuples. Other ;; conditions are required to obtain sensible moves, but the previous example ;; should illustrate the point. If you manage to improve on these values, ;; please send me a note. Thanks. ;; As we choosed values 0, 1 and 6 to denote empty, X and O squares, the ;; contents of a qtuple is uniquely determined by the sum of its elements and ;; we just have to set up a translation table. (defconst gomoku-score-trans-table (vector nil-score Xscore XXscore XXXscore XXXXscore 0 Oscore 0 0 0 0 0 OOscore 0 0 0 0 0 OOOscore 0 0 0 0 0 OOOOscore 0 0 0 0 0 0) "Vector associating qtuple contents to their score.") ;; If you do not modify drastically the previous constants, the only way for a ;; square to have a score higher than OOOOscore is to belong to a "OOOO" ;; qtuple, thus to be a winning move. Similarly, the only way for a square to ;; have a score between XXXXscore and OOOOscore is to belong to a "XXXX" ;; qtuple. We may use these considerations to detect when a given move is ;; winning or loosing. (defconst gomoku-winning-threshold OOOOscore "Threshold score beyond which an Emacs move is winning.") (defconst gomoku-loosing-threshold XXXXscore "Threshold score beyond which a human move is winning.") (defun gomoku-strongest-square () "Compute index of free square with highest score, or nil if none." ;; We just have to loop other all squares. However there are two problems: ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed ;; up future searches, we set the score of padding or occupied squares ;; to -1 whenever we meet them. ;; 2/ We want to choose randomly between equally good moves. (let ((score-max 0) (count 0) ; Number of equally good moves (square (gomoku-xy-to-index 1 1)) ; First square (end (gomoku-xy-to-index gomoku-board-width gomoku-board-height)) best-square score) (while (<= square end) (cond ;; If score is lower (i.e. most of the time), skip to next: ((< (aref gomoku-score-table square) score-max)) ;; If score is better, beware of non free squares: ((> (setq score (aref gomoku-score-table square)) score-max) (if (zerop (aref gomoku-board square)) ; is it free ? (setq count 1 ; yes: take it ! best-square square score-max score) (aset gomoku-score-table square -1))) ; no: kill it ! ;; If score is equally good, choose randomly. But first check freeness: ((not (zerop (aref gomoku-board square))) (aset gomoku-score-table square -1)) ((zerop (random (setq count (1+ count)))) (setq best-square square score-max score))) (setq square (1+ square))) ; try next square best-square)) ;;; ;;; INITIALIZING THE SCORE TABLE. ;;; ;; At initialization the board is empty so that every qtuple amounts for ;; nil-score. Therefore, the score of any square is nil-score times the number ;; of qtuples that pass through it. This number is 3 in a corner and 20 if you ;; are sufficiently far from the sides. As computing the number is time ;; consuming, we initialize every square with 20*nil-score and then only ;; consider squares at less than 5 squares from one side. We speed this up by ;; taking symmetry into account. ;; Also, as it is likely that successive games will be played on a board with ;; same size, it is a good idea to save the initial SCORE-TABLE configuration. (defvar gomoku-saved-score-table nil "Recorded initial value of previous score table.") (defvar gomoku-saved-board-width nil "Recorded value of previous board width.") (defvar gomoku-saved-board-height nil "Recorded value of previous board height.") (defun gomoku-init-score-table () "Create the score table vector and fill it with initial values." (if (and gomoku-saved-score-table ; Has it been stored last time ? (= gomoku-board-width gomoku-saved-board-width) (= gomoku-board-height gomoku-saved-board-height)) (setq gomoku-score-table (copy-sequence gomoku-saved-score-table)) ;; No, compute it: (setq gomoku-score-table (make-vector gomoku-vector-length (* 20 nil-score))) (let (i j maxi maxj maxi2 maxj2) (setq maxi (/ (1+ gomoku-board-width) 2) maxj (/ (1+ gomoku-board-height) 2) maxi2 (min 4 maxi) maxj2 (min 4 maxj)) ;; We took symmetry into account and could use it more if the board ;; would have been square and not rectangular ! ;; In our case we deal with all (i,j) in the set [1..maxi2]*[1..maxj] U ;; [maxi2+1..maxi]*[1..maxj2]. Maxi2 and maxj2 are used because the ;; board may well be less than 8 by 8 ! (setq i 1) (while (<= i maxi2) (setq j 1) (while (<= j maxj) (gomoku-init-square-score i j) (setq j (1+ j))) (setq i (1+ i))) (while (<= i maxi) (setq j 1) (while (<= j maxj2) (gomoku-init-square-score i j) (setq j (1+ j))) (setq i (1+ i)))) (setq gomoku-saved-score-table (copy-sequence gomoku-score-table) gomoku-saved-board-width gomoku-board-width gomoku-saved-board-height gomoku-board-height))) (defun gomoku-nb-qtuples (i j) "Return the number of qtuples containing square I,J." ;; This function is complicated because we have to deal ;; with ugly cases like 3 by 6 boards, but it works. ;; If you have a simpler (and correct) solution, send it to me. Thanks ! (let ((left (min 4 (1- i))) (right (min 4 (- gomoku-board-width i))) (up (min 4 (1- j))) (down (min 4 (- gomoku-board-height j)))) (+ -12 (min (max (+ left right) 3) 8) (min (max (+ up down) 3) 8) (min (max (+ (min left up) (min right down)) 3) 8) (min (max (+ (min right up) (min left down)) 3) 8)))) (defun gomoku-init-square-score (i j) "Give initial score to square I,J and to its mirror images." (let ((ii (1+ (- gomoku-board-width i))) (jj (1+ (- gomoku-board-height j))) (sc (* (gomoku-nb-qtuples i j) (aref gomoku-score-trans-table 0)))) (aset gomoku-score-table (gomoku-xy-to-index i j) sc) (aset gomoku-score-table (gomoku-xy-to-index ii j) sc) (aset gomoku-score-table (gomoku-xy-to-index i jj) sc) (aset gomoku-score-table (gomoku-xy-to-index ii jj) sc))) ;;; ;;; MAINTAINING THE SCORE TABLE. ;;; ;; We do not provide functions for computing the SCORE-TABLE given the ;; contents of the BOARD. This would involve heavy nested loops, with time ;; proportional to the size of the board. It is better to update the ;; SCORE-TABLE after each move. Updating needs not modify more than 36 ;; squares: it is done in constant time. (defun gomoku-update-score-table (square dval) "Update score table after SQUARE received a DVAL increment." ;; The board has already been updated when this function is called. ;; Updating scores is done by looking for qtuples boundaries in all four ;; directions and then calling update-score-in-direction. ;; Finally all squares received the right increment, and then are up to ;; date, except possibly for SQUARE itself if we are taking a move back for ;; its score had been set to -1 at the time. (let* ((x (gomoku-index-to-x square)) (y (gomoku-index-to-y square)) (imin (max -4 (- 1 x))) (jmin (max -4 (- 1 y))) (imax (min 0 (- gomoku-board-width x 4))) (jmax (min 0 (- gomoku-board-height y 4)))) (gomoku-update-score-in-direction imin imax square 1 0 dval) (gomoku-update-score-in-direction jmin jmax square 0 1 dval) (gomoku-update-score-in-direction (max imin jmin) (min imax jmax) square 1 1 dval) (gomoku-update-score-in-direction (max (- 1 y) -4 (- x gomoku-board-width)) (min 0 (- x 5) (- gomoku-board-height y 4)) square -1 1 dval))) (defun gomoku-update-score-in-direction (left right square dx dy dval) "Update scores for all squares in the qtuples starting between the LEFTth square and the RIGHTth after SQUARE, along the DX, DY direction, considering that DVAL has been added on SQUARE." ;; We always have LEFT <= 0, RIGHT <= 0 and DEPL > 0 but we may very well ;; have LEFT > RIGHT, indicating that no qtuple contains SQUARE along that ;; DX,DY direction. (cond ((> left right)) ; Quit (t ; Else .. (let (depl square0 square1 square2 count delta) (setq depl (gomoku-xy-to-index dx dy) square0 (+ square (* left depl)) square1 (+ square (* right depl)) square2 (+ square0 (* 4 depl))) ;; Compute the contents of the first qtuple: (setq square square0 count 0) (while (<= square square2) (setq count (+ count (aref gomoku-board square)) square (+ square depl))) (while (<= square0 square1) ;; Update the squares of the qtuple beginning in SQUARE0 and ending ;; in SQUARE2. (setq delta (- (aref gomoku-score-trans-table count) (aref gomoku-score-trans-table (- count dval)))) (cond ((not (zerop delta)) ; or else nothing to update (setq square square0) (while (<= square square2) (if (zerop (aref gomoku-board square)) ; only for free squares (aset gomoku-score-table square (+ (aref gomoku-score-table square) delta))) (setq square (+ square depl))))) ;; Then shift the qtuple one square along DEPL, this only requires ;; modifying SQUARE0 and SQUARE2. (setq square2 (+ square2 depl) count (+ count (- (aref gomoku-board square0)) (aref gomoku-board square2)) square0 (+ square0 depl))))))) ;;; ;;; GAME CONTROL. ;;; ;; Several variables are used to monitor a game, including a GAME-HISTORY (the ;; list of all (SQUARE . PREVSCORE) played) that allows to take moves back ;; (anti-updating the score table) and to compute the table from scratch in ;; case of an interruption. (defvar gomoku-game-in-progress nil "Non-nil if a game is in progress.") (defvar gomoku-game-history nil "A record of all moves that have been played during current game.") (defvar gomoku-number-of-moves nil "Number of moves already played in current game.") (defvar gomoku-number-of-human-moves nil "Number of moves already played by human in current game.") (defvar gomoku-emacs-played-first nil "Non-nil if Emacs played first.") (defvar gomoku-human-took-back nil "Non-nil if Human took back a move during the game.") (defvar gomoku-human-refused-draw nil "Non-nil if Human refused Emacs offer of a draw.") (defvar gomoku-emacs-is-computing nil ;; This is used to detect interruptions. Hopefully, it should not be needed. "Non-nil if Emacs is in the middle of a computation.") (defun gomoku-start-game (n m) "Initialize a new game on an N by M board." (setq gomoku-emacs-is-computing t) ; Raise flag (setq gomoku-game-in-progress t) (setq gomoku-board-width n gomoku-board-height m gomoku-vector-length (1+ (* (+ m 2) (1+ n))) gomoku-draw-limit (/ (* 7 n m) 10)) (setq gomoku-game-history nil gomoku-number-of-moves 0 gomoku-number-of-human-moves 0 gomoku-emacs-played-first nil gomoku-human-took-back nil gomoku-human-refused-draw nil) (gomoku-init-display n m) ; Display first: the rest takes time (gomoku-init-score-table) ; INIT-BOARD requires that the score (gomoku-init-board) ; table be already created. (setq gomoku-emacs-is-computing nil)) (defun gomoku-play-move (square val &optional dont-update-score) "Go to SQUARE, play VAL and update everything." (setq gomoku-emacs-is-computing t) ; Raise flag (cond ((= 1 val) ; a Human move (setq gomoku-number-of-human-moves (1+ gomoku-number-of-human-moves))) ((zerop gomoku-number-of-moves) ; an Emacs move. Is it first ? (setq gomoku-emacs-played-first t))) (setq gomoku-game-history (cons (cons square (aref gomoku-score-table square)) gomoku-game-history) gomoku-number-of-moves (1+ gomoku-number-of-moves)) (gomoku-plot-square square val) (aset gomoku-board square val) ; *BEFORE* UPDATE-SCORE ! (if dont-update-score nil (gomoku-update-score-table square val) ; previous val was 0: dval = val (aset gomoku-score-table square -1)) (setq gomoku-emacs-is-computing nil)) (defun gomoku-take-back () "Take back last move and update everything." (setq gomoku-emacs-is-computing t) (let* ((last-move (car gomoku-game-history)) (square (car last-move)) (oldval (aref gomoku-board square))) (if (= 1 oldval) (setq gomoku-number-of-human-moves (1- gomoku-number-of-human-moves))) (setq gomoku-game-history (cdr gomoku-game-history) gomoku-number-of-moves (1- gomoku-number-of-moves)) (gomoku-plot-square square 0) (aset gomoku-board square 0) ; *BEFORE* UPDATE-SCORE ! (gomoku-update-score-table square (- oldval)) (aset gomoku-score-table square (cdr last-move))) (setq gomoku-emacs-is-computing nil)) ;;; ;;; SESSION CONTROL. ;;; (defvar gomoku-number-of-emacs-wins 0 "Number of games Emacs won in this session.") (defvar gomoku-number-of-human-wins 0 "Number of games you won in this session.") (defvar gomoku-number-of-draws 0 "Number of games already drawn in this session.") (defun gomoku-terminate-game (result) "Terminate the current game with RESULT." (let (message) (cond ((eq result 'emacs-won) (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins)) (setq message (cond ((< gomoku-number-of-moves 20) "This was a REALLY QUICK win.") (gomoku-human-refused-draw "I won... Too bad you refused my offer of a draw !") (gomoku-human-took-back "I won... Taking moves back will not help you !") ((not gomoku-emacs-played-first) "I won... Playing first did not help you much !") ((and (zerop gomoku-number-of-human-wins) (zerop gomoku-number-of-draws) (> gomoku-number-of-emacs-wins 1)) "I'm becoming tired of winning...") (t "I won.")))) ((eq result 'human-won) (setq gomoku-number-of-human-wins (1+ gomoku-number-of-human-wins)) (setq message (cond (gomoku-human-took-back "OK, you won this one. I, for one, never take my moves back...") (gomoku-emacs-played-first "OK, you won this one... so what ?") (t "OK, you won this one. Now, let me play first just once.")))) ((eq result 'human-resigned) (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins)) (setq message "So you resign. That's just one more win for me.")) ((eq result 'nobody-won) (setq gomoku-number-of-draws (1+ gomoku-number-of-draws)) (setq message (cond (gomoku-human-took-back "This is a draw. I, for one, never take my moves back...") (gomoku-emacs-played-first "This is a draw. Just chance, I guess.") (t "This is a draw. Now, let me play first just once.")))) ((eq result 'draw-agreed) (setq gomoku-number-of-draws (1+ gomoku-number-of-draws)) (setq message (cond (gomoku-human-took-back "Draw agreed. I, for one, never take my moves back...") (gomoku-emacs-played-first "Draw agreed. You were lucky.") (t "Draw agreed. Now, let me play first just once.")))) ((eq result 'crash-game) (setq message "Sorry, I have been interrupted and cannot resume that game..."))) (gomoku-display-statistics) (if message (message message)) (ding) (setq gomoku-game-in-progress nil))) (defun gomoku-crash-game () "What to do when Emacs detects it has been interrupted." (setq gomoku-emacs-is-computing nil) (gomoku-terminate-game 'crash-game) (sit-for 4) ; Let's see the message (gomoku-prompt-for-other-game)) ;;; ;;; INTERACTIVE COMMANDS. ;;; ;;;###autoload (defun gomoku (&optional n m) "Start a Gomoku game between you and Emacs. If a game is in progress, this command allow you to resume it. If optional arguments N and M are given, an N by M board is used. You and Emacs play in turn by marking a free square. You mark it with X and Emacs marks it with O. The winner is the first to get five contiguous marks horizontally, vertically or in diagonal. You play by moving the cursor over the square you choose and hitting \\\\[gomoku-human-plays]. Use \\[describe-mode] for more info." (interactive) (gomoku-switch-to-window) (cond (gomoku-emacs-is-computing (gomoku-crash-game)) ((not gomoku-game-in-progress) (let ((max-width (gomoku-max-width)) (max-height (gomoku-max-height))) (or n (setq n max-width)) (or m (setq m max-height)) (cond ((< n 1) (error "I need at least 1 column")) ((< m 1) (error "I need at least 1 row")) ((> n max-width) (error "I cannot display %d columns in that window" n))) (if (and (> m max-height) (not (equal m gomoku-saved-board-height)) ;; Use EQUAL because SAVED-BOARD-HEIGHT may be nil (not (y-or-n-p (format "Do you really want %d rows " m)))) (setq m max-height))) (message "One moment, please...") (gomoku-start-game n m) (if (y-or-n-p "Do you allow me to play first ") (gomoku-emacs-plays) (gomoku-prompt-for-move))) ((y-or-n-p "Shall we continue our game ") (gomoku-prompt-for-move)) (t (gomoku-human-resigns)))) (defun gomoku-emacs-plays () "Compute Emacs next move and play it." (interactive) (gomoku-switch-to-window) (cond (gomoku-emacs-is-computing (gomoku-crash-game)) ((not gomoku-game-in-progress) (gomoku-prompt-for-other-game)) (t (message "Let me think...") (let (square score) (setq square (gomoku-strongest-square)) (cond ((null square) (gomoku-terminate-game 'nobody-won)) (t (setq score (aref gomoku-score-table square)) (gomoku-play-move square 6) (cond ((>= score gomoku-winning-threshold) (gomoku-find-filled-qtuple square 6) (gomoku-cross-winning-qtuple) (gomoku-terminate-game 'emacs-won)) ((zerop score) (gomoku-terminate-game 'nobody-won)) ((and (> gomoku-number-of-moves gomoku-draw-limit) (not gomoku-human-refused-draw) (gomoku-offer-a-draw)) (gomoku-terminate-game 'draw-agreed)) (t (gomoku-prompt-for-move))))))))) (defun gomoku-click (click) "Play at the square where you click." (interactive "e") (mouse-set-point click) (gomoku-human-plays)) (defun gomoku-human-plays () "Signal to the Gomoku program that you have played. You must have put the cursor on the square where you want to play. If the game is finished, this command requests for another game." (interactive) (gomoku-switch-to-window) (cond (gomoku-emacs-is-computing (gomoku-crash-game)) ((not gomoku-game-in-progress) (gomoku-prompt-for-other-game)) (t (let (square score) (setq square (gomoku-point-square)) (cond ((null square) (error "Your point is not on a square. Retry !")) ((not (zerop (aref gomoku-board square))) (error "Your point is not on a free square. Retry !")) (t (setq score (aref gomoku-score-table square)) (gomoku-play-move square 1) (cond ((and (>= score gomoku-loosing-threshold) ;; Just testing SCORE > THRESHOLD is not enough for ;; detecting wins, it just gives an indication that ;; we confirm with GOMOKU-FIND-FILLED-QTUPLE. (gomoku-find-filled-qtuple square 1)) (gomoku-cross-winning-qtuple) (gomoku-terminate-game 'human-won)) (t (gomoku-emacs-plays))))))))) (defun gomoku-human-takes-back () "Signal to the Gomoku program that you wish to take back your last move." (interactive) (gomoku-switch-to-window) (cond (gomoku-emacs-is-computing (gomoku-crash-game)) ((not gomoku-game-in-progress) (message "Too late for taking back...") (sit-for 4) (gomoku-prompt-for-other-game)) ((zerop gomoku-number-of-human-moves) (message "You have not played yet... Your move ?")) (t (message "One moment, please...") ;; It is possible for the user to let Emacs play several consecutive ;; moves, so that the best way to know when to stop taking back moves is ;; to count the number of human moves: (setq gomoku-human-took-back t) (let ((number gomoku-number-of-human-moves)) (while (= number gomoku-number-of-human-moves) (gomoku-take-back))) (gomoku-prompt-for-move)))) (defun gomoku-human-resigns () "Signal to the Gomoku program that you may want to resign." (interactive) (gomoku-switch-to-window) (cond (gomoku-emacs-is-computing (gomoku-crash-game)) ((not gomoku-game-in-progress) (message "There is no game in progress")) ((y-or-n-p "You mean, you resign ") (gomoku-terminate-game 'human-resigned)) ((y-or-n-p "You mean, we continue ") (gomoku-prompt-for-move)) (t (gomoku-terminate-game 'human-resigned)))) ; OK. Accept it ;;; ;;; PROMPTING THE HUMAN PLAYER. ;;; (defun gomoku-prompt-for-move () "Display a message asking for Human's move." (message (if (zerop gomoku-number-of-human-moves) "Your move ? (move to a free square and hit X, RET ...)" "Your move ?")) ;; This may seem silly, but if one omits the following line (or a similar ;; one), the cursor may very well go to some place where POINT is not. (save-excursion (set-buffer (other-buffer)))) (defun gomoku-prompt-for-other-game () "Ask for another game, and start it." (if (y-or-n-p "Another game ") (gomoku gomoku-board-width gomoku-board-height) (message "Chicken !"))) (defun gomoku-offer-a-draw () "Offer a draw and return T if Human accepted it." (or (y-or-n-p "I offer you a draw. Do you accept it ") (prog1 (setq gomoku-human-refused-draw t) nil))) ;;; ;;; DISPLAYING THE BOARD. ;;; ;; You may change these values if you have a small screen or if the squares ;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1). (defconst gomoku-square-width 4 "*Horizontal spacing between squares on the Gomoku board.") (defconst gomoku-square-height 2 "*Vertical spacing between squares on the Gomoku board.") (defconst gomoku-x-offset 3 "*Number of columns between the Gomoku board and the side of the window.") (defconst gomoku-y-offset 1 "*Number of lines between the Gomoku board and the top of the window.") (defun gomoku-max-width () "Largest possible board width for the current window." (1+ (/ (- (window-width (selected-window)) gomoku-x-offset gomoku-x-offset 1) gomoku-square-width))) (defun gomoku-max-height () "Largest possible board height for the current window." (1+ (/ (- (window-height (selected-window)) gomoku-y-offset gomoku-y-offset 2) ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line ! gomoku-square-height))) (defun gomoku-point-x () "Return the board column where point is, or nil if it is not a board column." (let ((col (- (current-column) gomoku-x-offset))) (if (and (>= col 0) (zerop (% col gomoku-square-width)) (<= (setq col (1+ (/ col gomoku-square-width))) gomoku-board-width)) col))) (defun gomoku-point-y () "Return the board row where point is, or nil if it is not a board row." (let ((row (- (count-lines 1 (point)) gomoku-y-offset 1))) (if (and (>= row 0) (zerop (% row gomoku-square-height)) (<= (setq row (1+ (/ row gomoku-square-height))) gomoku-board-height)) row))) (defun gomoku-point-square () "Return the index of the square point is on, or nil if not on the board." (let (x y) (and (setq x (gomoku-point-x)) (setq y (gomoku-point-y)) (gomoku-xy-to-index x y)))) (defun gomoku-goto-square (index) "Move point to square number INDEX." (gomoku-goto-xy (gomoku-index-to-x index) (gomoku-index-to-y index))) (defun gomoku-goto-xy (x y) "Move point to square at X, Y coords." (goto-line (+ 1 gomoku-y-offset (* gomoku-square-height (1- y)))) (move-to-column (+ gomoku-x-offset (* gomoku-square-width (1- x))))) (defun gomoku-plot-square (square value) "Draw 'X', 'O' or '.' on SQUARE (depending on VALUE), leave point there." (gomoku-goto-square square) (gomoku-put-char (cond ((= value 1) ?X) ((= value 6) ?O) (t ?.))) (sit-for 0)) ; Display NOW (defun gomoku-put-char (char) "Draw CHAR on the Gomoku screen." (let ((inhibit-read-only t)) (insert char) (delete-char 1) (backward-char 1))) (defun gomoku-init-display (n m) "Display an N by M Gomoku board." (buffer-disable-undo (current-buffer)) (let ((inhibit-read-only t)) (erase-buffer) (let (string1 string2 string3 string4) ;; We do not use gomoku-plot-square which would be too slow for ;; initializing the display. Rather we build STRING1 for lines where ;; board squares are to be found, and STRING2 for empty lines. STRING1 is ;; like STRING2 except for dots every DX squares. Empty lines are filled ;; with spaces so that cursor moving up and down remains on the same ;; column. (setq string1 (concat (make-string (1- gomoku-square-width) ? ) ".") string1 (apply 'concat (make-list (1- n) string1)) string1 (concat (make-string gomoku-x-offset ? ) "." string1 "\n") string2 (make-string (+ 1 gomoku-x-offset (* (1- n) gomoku-square-width)) ? ) string2 (concat string2 "\n") string3 (apply 'concat (make-list (1- gomoku-square-height) string2)) string3 (concat string3 string1) string3 (apply 'concat (make-list (1- m) string3)) string4 (apply 'concat (make-list gomoku-y-offset string2))) (insert string4 string1 string3)) (gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board (sit-for 0))) ; Display NOW (defun gomoku-display-statistics () "Obnoxiously display some statistics about previous games in mode line." ;; We store this string in the mode-line-process local variable. ;; This is certainly not the cleanest way out ... (setq mode-line-process (cond ((not (zerop gomoku-number-of-draws)) (format ": Won %d, lost %d, drew %d" gomoku-number-of-human-wins gomoku-number-of-emacs-wins gomoku-number-of-draws)) (t (format ": Won %d, lost %d" gomoku-number-of-human-wins gomoku-number-of-emacs-wins)))) (force-mode-line-update)) (defun gomoku-switch-to-window () "Find or create the Gomoku buffer, and display it." (interactive) (let ((buff (get-buffer "*Gomoku*"))) (if buff ; Buffer exists: (switch-to-buffer buff) ; no problem. (if gomoku-game-in-progress (gomoku-crash-game)) ; buffer has been killed or something (switch-to-buffer "*Gomoku*") ; Anyway, start anew. (gomoku-mode)))) ;;; ;;; CROSSING WINNING QTUPLES. ;;; ;; When someone succeeds in filling a qtuple, we draw a line over the five ;; corresponding squares. One problem is that the program does not know which ;; squares ! It only knows the square where the last move has been played and ;; who won. The solution is to scan the board along all four directions. (defvar gomoku-winning-qtuple-beg nil "First square of the winning qtuple.") (defvar gomoku-winning-qtuple-end nil "Last square of the winning qtuple.") (defvar gomoku-winning-qtuple-dx nil "Direction of the winning qtuple (along the X axis).") (defvar gomoku-winning-qtuple-dy nil "Direction of the winning qtuple (along the Y axis).") (defun gomoku-find-filled-qtuple (square value) "Return T if SQUARE belongs to a qtuple filled with VALUEs." (or (gomoku-check-filled-qtuple square value 1 0) (gomoku-check-filled-qtuple square value 0 1) (gomoku-check-filled-qtuple square value 1 1) (gomoku-check-filled-qtuple square value -1 1))) (defun gomoku-check-filled-qtuple (square value dx dy) "Return T if SQUARE belongs to a qtuple filled with VALUEs along DX, DY." ;; And record it in the WINNING-QTUPLE-... variables. (let ((a 0) (b 0) (left square) (right square) (depl (gomoku-xy-to-index dx dy)) a+4) (while (and (> a -4) ; stretch tuple left (= value (aref gomoku-board (setq left (- left depl))))) (setq a (1- a))) (setq a+4 (+ a 4)) (while (and (< b a+4) ; stretch tuple right (= value (aref gomoku-board (setq right (+ right depl))))) (setq b (1+ b))) (cond ((= b a+4) ; tuple length = 5 ? (setq gomoku-winning-qtuple-beg (+ square (* a depl)) gomoku-winning-qtuple-end (+ square (* b depl)) gomoku-winning-qtuple-dx dx gomoku-winning-qtuple-dy dy) t)))) (defun gomoku-cross-winning-qtuple () "Cross winning qtuple, as found by `gomoku-find-filled-qtuple'." (gomoku-cross-qtuple gomoku-winning-qtuple-beg gomoku-winning-qtuple-end gomoku-winning-qtuple-dx gomoku-winning-qtuple-dy)) (defun gomoku-cross-qtuple (square1 square2 dx dy) "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction." (save-excursion ; Not moving point from last square (let ((depl (gomoku-xy-to-index dx dy))) ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 (while (not (= square1 square2)) (gomoku-goto-square square1) (setq square1 (+ square1 depl)) (cond ((and (= dx 1) (= dy 0)) ; Horizontal (let ((n 1)) (while (< n gomoku-square-width) (setq n (1+ n)) (forward-char 1) (gomoku-put-char ?-)))) ((and (= dx 0) (= dy 1)) ; Vertical (let ((n 1)) (while (< n gomoku-square-height) (setq n (1+ n)) (next-line 1) (gomoku-put-char ?|)))) ((and (= dx -1) (= dy 1)) ; 1st Diagonal (backward-char (/ gomoku-square-width 2)) (next-line (/ gomoku-square-height 2)) (gomoku-put-char ?/)) ((and (= dx 1) (= dy 1)) ; 2nd Diagonal (forward-char (/ gomoku-square-width 2)) (next-line (/ gomoku-square-height 2)) (gomoku-put-char ?\\)))))) (sit-for 0)) ; Display NOW ;;; ;;; CURSOR MOTION. ;;; (defun gomoku-move-left () "Move point backward one column on the Gomoku board." (interactive) (let ((x (gomoku-point-x))) (backward-char (cond ((null x) 1) ((> x 1) gomoku-square-width) (t 0))))) (defun gomoku-move-right () "Move point forward one column on the Gomoku board." (interactive) (let ((x (gomoku-point-x))) (forward-char (cond ((null x) 1) ((< x gomoku-board-width) gomoku-square-width) (t 0))))) (defun gomoku-move-down () "Move point down one row on the Gomoku board." (interactive) (let ((y (gomoku-point-y))) (next-line (cond ((null y) 1) ((< y gomoku-board-height) gomoku-square-height) (t 0))))) (defun gomoku-move-up () "Move point up one row on the Gomoku board." (interactive) (let ((y (gomoku-point-y))) (previous-line (cond ((null y) 1) ((> y 1) gomoku-square-height) (t 0))))) (defun gomoku-move-ne () "Move point North East on the Gomoku board." (interactive) (gomoku-move-up) (gomoku-move-right)) (defun gomoku-move-se () "Move point South East on the Gomoku board." (interactive) (gomoku-move-down) (gomoku-move-right)) (defun gomoku-move-nw () "Move point North West on the Gomoku board." (interactive) (gomoku-move-up) (gomoku-move-left)) (defun gomoku-move-sw () "Move point South West on the Gomoku board." (interactive) (gomoku-move-down) (gomoku-move-left)) (provide 'gomoku) ;;; gomoku.el ends here emacs-19.30/lisp/goto-addr.el100444 12120 1 20074 6052204221 14265 0ustar rmsdaemon;;; goto-addr.el --- click to browse URL or to send to e-mail address ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Eric Ding ;; Maintainer: Eric Ding ;; Created: 15 Aug 1995 ;; Keywords: mh-e, www, mouse, mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; This package allows you to click or hit a key sequence while on a ;; URL or e-mail address, and either load the URL into a browser of ;; your choice using the browse-url package, or if it's an e-mail ;; address, to send an e-mail to that address. By default, we bind to ;; the [S-mouse-2] and the [C-c return] key sequences. ;; INSTALLATION ;; ;; To use goto-address in a particular mode (for example, while ;; reading mail in mh-e), add something like this in your .emacs file: ;; ;; (add-hook 'mh-show-mode-hook 'goto-address) ;; ;; By default, goto-address now sends using `mail' instead of `mh-send'. ;; To use mh-e to send mail, add the following to your .emacs file: ;; ;; (setq goto-address-mail-method 'goto-address-send-using-mhe) ;; ;; To rebind, for example, the mouse click method to [mouse-2] in ;; mh-show-mode, add the following (instead of the first add-hook example ;; above) to your .emacs file: ;; ;; (defun my-goto-address () ;; (goto-address) ;; (local-unset-key [S-mouse-2]) ;; (local-set-key [mouse-2] 'goto-address-at-mouse)) ;; ;; (add-hook 'mh-show-mode-hook 'my-goto-address) ;; ;; [mouse-2] is not the default mouse binding because I use goto-address in ;; some editable buffers, where [mouse-2] means mouse-yank-at-click, as well ;; as in some modes where [mouse-2] is bound to other useful functions. ;; BUG REPORTS ;; ;; Please send bug reports to me at ericding@mit.edu. ;; Known bugs/features: ;; * goto-address-mail-regexp only catches foo@bar.org style addressing, ;; not stuff like X.400 addresses, etc. ;; * regexp also catches Message-Id line, since it is in the format of ;; an Internet e-mail address (like Compuserve addresses) ;; * If show buffer is fontified after goto-address-fontify is run ;; (say, using font-lock-fontify-buffer), then font-lock face will ;; override goto-address faces. ;;; Code: (require 'browse-url) ;;; I don't expect users to want fontify'ing without highlighting. (defvar goto-address-fontify-p t "*If t, URL's and e-mail addresses in buffer are fontified. But only if `goto-address-highlight-p' is also non-nil.") (defvar goto-address-highlight-p t "*If t, URL's and e-mail addresses in buffer are highlighted.") (defvar goto-address-fontify-maximum-size 30000 "*Maximum size of file in which to fontify and/or highlight URL's.") (defvar goto-address-mail-regexp "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" "A regular expression probably matching an e-mail address.") (defvar goto-address-url-regexp (concat "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|" "telnet\\|wais\\):\\(//[-a-zA-Z0-9_.]+:" "[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*" "[-a-zA-Z0-9_=#$@~`%&*+|\\/]") "A regular expression probably matching a URL.") (defvar goto-address-mail-method 'goto-address-send-using-mail "*Function to compose mail. Two pre-made functions are `goto-address-send-using-mail' (sendmail); and `goto-address-send-using-mhe' (MH-E).") (defun goto-address-fontify () "Fontify the URL's and e-mail addresses in the current buffer. This function implements `goto-address-highlight-p' and `goto-address-fontify-p'." (save-excursion (let ((inhibit-read-only t) (inhibit-point-motion-hooks t) (modified (buffer-modified-p))) (goto-char (point-min)) (if (< (- (point-max) (point)) goto-address-fontify-maximum-size) (progn (while (re-search-forward goto-address-url-regexp nil t) (progn (goto-char (match-end 0)) (and goto-address-fontify-p (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) (put-text-property (match-beginning 0) (match-end 0) 'mouse-face 'highlight))) (goto-char (point-min)) (while (re-search-forward goto-address-mail-regexp nil t) (progn (goto-char (match-end 0)) (and goto-address-fontify-p (put-text-property (match-beginning 0) (match-end 0) 'face 'italic)) (put-text-property (match-beginning 0) (match-end 0) 'mouse-face 'secondary-selection))))) (and (buffer-modified-p) (not modified) (set-buffer-modified-p nil))))) ;;; code to find and goto addresses; much of this has been blatantly ;;; snarfed from browse-url.el (defun goto-address-at-mouse (event) "Send to the e-mail address or load the URL clicked with the mouse. Send mail to address at position of mouse click. See documentation for `goto-address-find-address-at-point'. If no address is found there, then load the URL at or before the position of the mouse click." (interactive "e") (save-excursion (let ((posn (event-start event))) (set-buffer (window-buffer (posn-window posn))) (goto-char (posn-point posn)) (let ((address (save-excursion (goto-address-find-address-at-point)))) (if (string-equal address "") (let ((url (browse-url-url-at-point))) (if (string-equal url "") (error "No e-mail address or URL found") (funcall browse-url-browser-function url))) (funcall goto-address-mail-method address)))))) (defun goto-address-at-point () "Send to the e-mail address or load the URL at point. Send mail to address at point. See documentation for `goto-address-find-address-at-point'. If no address is found there, then load the URL at or before point." (interactive) (save-excursion (let ((address (save-excursion (goto-address-find-address-at-point)))) (if (string-equal address "") (let ((url (browse-url-url-at-point))) (if (string-equal url "") (error "No e-mail address or URL found") (funcall browse-url-browser-function url))) (funcall goto-address-mail-method address))))) (defun goto-address-find-address-at-point () "Find e-mail address around or before point. Then search backwards to beginning of line for the start of an e-mail address. If no e-mail address found, return the empty string." (let ((bol (save-excursion (beginning-of-line) (point)))) (re-search-backward "[^-_A-z0-9.@]" bol 'lim) (if (or (looking-at goto-address-mail-regexp) ; already at start (let ((eol (save-excursion (end-of-line) (point)))) (and (re-search-forward goto-address-mail-regexp eol 'lim) (goto-char (match-beginning 0))))) (buffer-substring (match-beginning 0) (match-end 0)) ""))) (defun goto-address-send-using-mhe (to) (mh-find-path) (let ((cc (mh-read-address "Cc: ")) (subject (read-string "Subject: ")) (config (current-window-configuration))) (delete-other-windows) (mh-send-sub to cc subject config))) (defun goto-address-send-using-mail (to) (mail-other-window nil to) (and (goto-char (point-min)) (end-of-line 2))) ;;;###autoload (defun goto-address () "Sets up goto-address functionality in the current buffer. Allows user to use mouse/keyboard command to click to go to a URL or to send e-mail. By default, goto-address binds to S-mouse-2 and C-c RET. Also fontifies the buffer appropriately (see `goto-address-fontify-p' and `goto-address-highlight-p' for more information)." (interactive) (local-set-key [S-mouse-2] 'goto-address-at-mouse) (local-set-key "\C-c\r" 'goto-address-at-point) (if goto-address-highlight-p (goto-address-fontify))) (provide 'goto-addr) ;;; goto-addr.el ends here. emacs-19.30/lisp/gud.el100444 12120 1 166516 6042021333 13220 0ustar rmsdaemon;;; gud.el --- Grand Unified Debugger mode for gdb, sdb, dbx, or xdb ;;; under Emacs ;; Author: Eric S. Raymond ;; Maintainer: FSF ;; Keywords: unix, tools ;; Copyright (C) 1992, 1993, 1994, 1995 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: ;; The ancestral gdb.el was by W. Schelter ;; It was later rewritten by rms. Some ideas were due to Masanobu. ;; Grand Unification (sdb/dbx support) by Eric S. Raymond ;; The overloading code was then rewritten by Barry Warsaw , ;; who also hacked the mode to use comint.el. Shane Hartman ;; added support for xdb (HPUX debugger). Rick Sladkey ;; wrote the GDB command completion code. Dave Love ;; added the IRIX kluge, re-implemented the Mips-ish variant and added ;; a menu. Brian D. Carlstrom combined the IRIX kluge with ;; the gud-xdb-directories hack producing gud-dbx-directories. ;;; Code: (require 'comint) (require 'etags) ;; ====================================================================== ;; GUD commands must be visible in C buffers visited by GUD (defvar gud-key-prefix "\C-x\C-a" "Prefix of all GUD commands valid in C buffers.") (global-set-key (concat gud-key-prefix "\C-l") 'gud-refresh) (define-key ctl-x-map " " 'gud-break) ;; backward compatibility hack (defvar gud-marker-filter nil) (put 'gud-marker-filter 'permanent-local t) (defvar gud-find-file nil) (put 'gud-find-file 'permanent-local t) (defun gud-marker-filter (&rest args) (apply gud-marker-filter args)) (defun gud-find-file (file) ;; Don't get confused by double slashes in the name that comes from GDB. (while (string-match "//+" file) (setq file (replace-match "/" t t file))) (funcall gud-find-file file)) ;; Keymap definitions for menu bar entries common to all debuggers and ;; slots for debugger-dependent ones in sensible places. (Defined here ;; before use.) (defvar gud-menu-map (make-sparse-keymap "Gud") nil) (define-key gud-menu-map [refresh] '("Refresh" . gud-refresh)) (define-key gud-menu-map [remove] '("Remove Breakpoint" . gud-remove)) (define-key gud-menu-map [tbreak] nil) ; gdb, sdb and xdb (define-key gud-menu-map [break] '("Set Breakpoint" . gud-break)) (define-key gud-menu-map [up] nil) ; gdb, dbx, and xdb (define-key gud-menu-map [down] nil) ; gdb, dbx, and xdb (define-key gud-menu-map [print] '("Print Expression" . gud-print)) (define-key gud-menu-map [finish] nil) ; gdb or xdb (define-key gud-menu-map [stepi] '("Step Instruction" . gud-stepi)) (define-key gud-menu-map [step] '("Step Line" . gud-step)) (define-key gud-menu-map [next] '("Next Line" . gud-next)) (define-key gud-menu-map [cont] '("Continue" . gud-cont)) ;; ====================================================================== ;; command definition ;; This macro is used below to define some basic debugger interface commands. ;; Of course you may use `gud-def' with any other debugger command, including ;; user defined ones. ;; A macro call like (gud-def FUNC NAME KEY DOC) expands to a form ;; which defines FUNC to send the command NAME to the debugger, gives ;; it the docstring DOC, and binds that function to KEY in the GUD ;; major mode. The function is also bound in the global keymap with the ;; GUD prefix. (defmacro gud-def (func cmd key &optional doc) "Define FUNC to be a command sending STR and bound to KEY, with optional doc string DOC. Certain %-escapes in the string arguments are interpreted specially if present. These are: %f name (without directory) of current source file. %d directory of current source file. %l number of current source line %e text of the C lvalue or function-call expression surrounding point. %a text of the hexadecimal address surrounding point %p prefix argument to the command (if any) as a number The `current' source file is the file of the current buffer (if we're in a C file) or the source file current at the last break or step (if we're in the GUD buffer). The `current' line is that of the current buffer (if we're in a source file) or the source line number at the last break or step (if we're in the GUD buffer)." (list 'progn (list 'defun func '(arg) (or doc "") '(interactive "p") (list 'gud-call cmd 'arg)) (if key (list 'define-key '(current-local-map) (concat "\C-c" key) (list 'quote func))) (if key (list 'global-set-key (list 'concat 'gud-key-prefix key) (list 'quote func))))) ;; Where gud-display-frame should put the debugging arrow. This is ;; set by the marker-filter, which scans the debugger's output for ;; indications of the current program counter. (defvar gud-last-frame nil) ;; Used by gud-refresh, which should cause gud-display-frame to redisplay ;; the last frame, even if it's been called before and gud-last-frame has ;; been set to nil. (defvar gud-last-last-frame nil) ;; All debugger-specific information is collected here. ;; Here's how it works, in case you ever need to add a debugger to the mode. ;; ;; Each entry must define the following at startup: ;; ;; ;; 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 ;; strings and set the global gud-last-frame to indicate what display ;; action (if any) should be triggered by the marker. Note that only ;; whatever the method *returns* is displayed in the buffer; thus, you ;; can filter the debugger's output, interpreting some and passing on ;; the rest. ;; ;; The job of the find-file method is to visit and return the buffer indicated ;; by the car of gud-tag-frame. This may be a file name, a tag name, or ;; something else. It would be good if it also copied the Gud menubar entry. ;; ====================================================================== ;; gdb functions ;;; History of argument lists passed to gdb. (defvar gud-gdb-history nil) (defun gud-gdb-massage-args (file args) (cons "-fullname" args)) (defvar gud-gdb-marker-regexp (concat "\032\032\\([^" path-separator "\n]*\\)" path-separator "\\([0-9]*\\)" path-separator ".*\n")) ;; There's no guarantee that Emacs will hand the filter the entire ;; marker at once; it could be broken up across several strings. We ;; might even receive a big chunk with several markers in it. If we ;; receive a chunk of text which looks like it might contain the ;; beginning of a marker, we save it here between calls to the ;; filter. (defvar gud-marker-acc "") (make-variable-buffer-local 'gud-marker-acc) (defun gud-gdb-marker-filter (string) (setq gud-marker-acc (concat gud-marker-acc string)) (let ((output "")) ;; Process all the complete markers in this chunk. (while (string-match gud-gdb-marker-regexp gud-marker-acc) (setq ;; Extract the frame position from the marker. gud-last-frame (cons (substring gud-marker-acc (match-beginning 1) (match-end 1)) (string-to-int (substring gud-marker-acc (match-beginning 2) (match-end 2)))) ;; Append any text before the marker to the output we're going ;; to return - we don't include the marker in this text. output (concat output (substring gud-marker-acc 0 (match-beginning 0))) ;; Set the accumulator to the remaining text. gud-marker-acc (substring gud-marker-acc (match-end 0)))) ;; Does the remaining text look like it might end with the ;; beginning of another marker? If it does, then keep it in ;; gud-marker-acc until we receive the rest of it. Since we ;; know the full marker regexp above failed, it's pretty simple to ;; test for marker starts. (if (string-match "\032.*\\'" gud-marker-acc) (progn ;; Everything before the potential marker start can be output. (setq output (concat output (substring gud-marker-acc 0 (match-beginning 0)))) ;; Everything after, we save, to combine with later input. (setq gud-marker-acc (substring gud-marker-acc (match-beginning 0)))) (setq output (concat output gud-marker-acc) gud-marker-acc "")) output)) (defun gud-new-keymap (map) "Return a new keymap which inherits from MAP and has name `Gud'." (nconc (make-sparse-keymap "Gud") map)) (defun gud-make-debug-menu () "Make sure the current local map has a [menu-bar debug] submap. If it doesn't, replace it with a new map that inherits it, and create such a submap in that new map." (if (and (current-local-map) (lookup-key (current-local-map) [menu-bar debug])) nil (use-local-map (gud-new-keymap (current-local-map))) (define-key (current-local-map) [menu-bar debug] (cons "Gud" (gud-new-keymap gud-menu-map))))) (defun gud-gdb-find-file (f) (save-excursion (let ((buf (find-file-noselect f))) (set-buffer buf) (gud-make-debug-menu) (local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak)) (local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish)) (local-set-key [menu-bar debug up] '("Up Stack" . gud-up)) (local-set-key [menu-bar debug down] '("Down Stack" . gud-down)) buf))) (defvar gdb-minibuffer-local-map nil "Keymap for minibuffer prompting of gdb startup command.") (if gdb-minibuffer-local-map () (setq gdb-minibuffer-local-map (copy-keymap minibuffer-local-map)) (define-key gdb-minibuffer-local-map "\C-i" 'comint-dynamic-complete-filename)) ;;;###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 ") gdb-minibuffer-local-map nil '(gud-gdb-history . 1)))) (gud-common-init command-line 'gud-gdb-massage-args 'gud-gdb-marker-filter 'gud-gdb-find-file) (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set temporary breakpoint at current line.") (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line") (gud-def gud-step "step %p" "\C-s" "Step one source line with display.") (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") (gud-def gud-cont "cont" "\C-r" "Continue with display.") (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") (local-set-key "\C-i" 'gud-gdb-complete-command) (local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak)) (local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish)) (local-set-key [menu-bar debug up] '("Up Stack" . gud-up)) (local-set-key [menu-bar debug down] '("Down Stack" . gud-down)) (setq comint-prompt-regexp "^(.*gdb[+]?) *") (setq paragraph-start comint-prompt-regexp) (run-hooks 'gdb-mode-hook) ) ;; One of the nice features of GDB is its impressive support for ;; context-sensitive command completion. We preserve that feature ;; in the GUD buffer by using a GDB command designed just for Emacs. ;; The completion process filter indicates when it is finished. (defvar gud-gdb-complete-in-progress) ;; Since output may arrive in fragments we accumulate partials strings here. (defvar gud-gdb-complete-string) ;; We need to know how much of the completion to chop off. (defvar gud-gdb-complete-break) ;; The completion list is constructed by the process filter. (defvar gud-gdb-complete-list) (defvar gud-comint-buffer nil) (defun gud-gdb-complete-command () "Perform completion on the GDB command preceding point. This is implemented using the GDB `complete' command which isn't available with older versions of GDB." (interactive) (let* ((end (point)) (command (save-excursion (beginning-of-line) (and (looking-at comint-prompt-regexp) (goto-char (match-end 0))) (buffer-substring (point) end))) command-word) ;; Find the word break. This match will always succeed. (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command) (setq gud-gdb-complete-break (match-beginning 2) command-word (substring command gud-gdb-complete-break)) ;; Temporarily install our filter function. (let ((gud-marker-filter 'gud-gdb-complete-filter)) ;; Issue the command to GDB. (gud-basic-call (concat "complete " command)) (setq gud-gdb-complete-in-progress t gud-gdb-complete-string nil gud-gdb-complete-list nil) ;; Slurp the output. (while gud-gdb-complete-in-progress (accept-process-output (get-buffer-process gud-comint-buffer)))) ;; Protect against old versions of GDB. (and gud-gdb-complete-list (string-match "^Undefined command: \"complete\"" (car gud-gdb-complete-list)) (error "This version of GDB doesn't support the `complete' command.")) ;; Sort the list like readline. (setq gud-gdb-complete-list (sort gud-gdb-complete-list (function string-lessp))) ;; Remove duplicates. (let ((first gud-gdb-complete-list) (second (cdr gud-gdb-complete-list))) (while second (if (string-equal (car first) (car second)) (setcdr first (setq second (cdr second))) (setq first second second (cdr second))))) ;; Add a trailing single quote if there is a unique completion ;; and it contains an odd number of unquoted single quotes. (and (= (length gud-gdb-complete-list) 1) (let ((str (car gud-gdb-complete-list)) (pos 0) (count 0)) (while (string-match "\\([^'\\]\\|\\\\'\\)*'" str pos) (setq count (1+ count) pos (match-end 0))) (and (= (mod count 2) 1) (setq gud-gdb-complete-list (list (concat str "'")))))) ;; Let comint handle the rest. (comint-dynamic-simple-complete command-word gud-gdb-complete-list))) ;; The completion process filter is installed temporarily to slurp the ;; output of GDB up to the next prompt and build the completion list. (defun gud-gdb-complete-filter (string) (setq string (concat gud-gdb-complete-string string)) (while (string-match "\n" string) (setq gud-gdb-complete-list (cons (substring string gud-gdb-complete-break (match-beginning 0)) gud-gdb-complete-list)) (setq string (substring string (match-end 0)))) (if (string-match comint-prompt-regexp string) (progn (setq gud-gdb-complete-in-progress nil) string) (progn (setq gud-gdb-complete-string string) ""))) ;; ====================================================================== ;; sdb functions ;;; History of argument lists passed to sdb. (defvar gud-sdb-history nil) (defvar gud-sdb-needs-tags (not (file-exists-p "/var")) "If nil, we're on a System V Release 4 and don't need the tags hack.") (defvar gud-sdb-lastfile nil) (defun gud-sdb-massage-args (file args) args) (defun gud-sdb-marker-filter (string) (setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string)) (let (start) ;; Process all complete markers in this chunk (while (cond ;; System V Release 3.2 uses this format ((string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n" gud-marker-acc start) (setq gud-last-frame (cons (substring gud-marker-acc (match-beginning 2) (match-end 2)) (string-to-int (substring gud-marker-acc (match-beginning 3) (match-end 3)))))) ;; System V Release 4.0 quite often clumps two lines together ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n\\([0-9]+\\):" gud-marker-acc start) (setq gud-sdb-lastfile (substring gud-marker-acc (match-beginning 2) (match-end 2))) (setq gud-last-frame (cons gud-sdb-lastfile (string-to-int (substring gud-marker-acc (match-beginning 3) (match-end 3)))))) ;; System V Release 4.0 ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n" gud-marker-acc start) (setq gud-sdb-lastfile (substring gud-marker-acc (match-beginning 2) (match-end 2)))) ((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):" gud-marker-acc start)) (setq gud-last-frame (cons gud-sdb-lastfile (string-to-int (substring gud-marker-acc (match-beginning 1) (match-end 1)))))) (t (setq gud-sdb-lastfile nil))) (setq start (match-end 0))) ;; Search for the last incomplete line in this chunk (while (string-match "\n" gud-marker-acc start) (setq start (match-end 0))) ;; If we have an incomplete line, store it in gud-marker-acc. ;; Otherwise clear gud-marker-acc. to avoid an ;; unnecessary concat when this function runs next. (setq gud-marker-acc (if (= start (length gud-marker-acc)) (substring gud-marker-acc start) nil))) string) (defun gud-sdb-find-file (f) (save-excursion (let ((buf (if gud-sdb-needs-tags (find-tag-noselect f) (find-file-noselect f)))) (set-buffer buf) (gud-make-debug-menu) (local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak)) buf))) ;;;###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)))) (if (and gud-sdb-needs-tags (not (and (boundp 'tags-file-name) (stringp tags-file-name) (file-exists-p tags-file-name)))) (error "The sdb support requires a valid tags table to work.")) (gud-common-init command-line 'gud-sdb-massage-args 'gud-sdb-marker-filter 'gud-sdb-find-file) (gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.") (gud-def gud-tbreak "%l c" "\C-t" "Set temporary breakpoint at current line.") (gud-def gud-remove "%l d" "\C-d" "Remove breakpoint at current line") (gud-def gud-step "s %p" "\C-s" "Step one source line with display.") (gud-def gud-stepi "i %p" "\C-i" "Step one instruction with display.") (gud-def gud-next "S %p" "\C-n" "Step one line (skip functions).") (gud-def gud-cont "c" "\C-r" "Continue with display.") (gud-def gud-print "%e/" "\C-p" "Evaluate C expression at point.") (setq comint-prompt-regexp "\\(^\\|\n\\)\\*") (setq paragraph-start comint-prompt-regexp) (local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak)) (run-hooks 'sdb-mode-hook) ) ;; ====================================================================== ;; dbx functions ;;; History of argument lists passed to dbx. (defvar gud-dbx-history nil) (defvar gud-dbx-directories nil "*A list of directories that dbx should search for source code. If nil, only source files in the program directory will be known to dbx. The file names should be absolute, or relative to the directory containing the executable being debugged.") (defun gud-dbx-massage-args (file args) (nconc (let ((directories gud-dbx-directories) (result nil)) (while directories (setq result (cons (car directories) (cons "-I" result))) (setq directories (cdr directories))) (nreverse result)) args)) (defun gud-dbx-file-name (f) "Transform a relative file name to an absolute file name, for dbx." (let ((result nil)) (if (file-exists-p f) (setq result (expand-file-name f)) (let ((directories gud-dbx-directories)) (while directories (let ((path (concat (car directories) "/" f))) (if (file-exists-p path) (setq result (expand-file-name path) directories nil))) (setq directories (cdr directories))))) result)) (defun gud-dbx-marker-filter (string) (setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string)) (let (start) ;; Process all complete markers in this chunk. (while (or (string-match "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" gud-marker-acc start) (string-match "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" gud-marker-acc start)) (setq gud-last-frame (cons (substring gud-marker-acc (match-beginning 2) (match-end 2)) (string-to-int (substring gud-marker-acc (match-beginning 1) (match-end 1)))) start (match-end 0))) ;; Search for the last incomplete line in this chunk (while (string-match "\n" gud-marker-acc start) (setq start (match-end 0))) ;; If the incomplete line APPEARS to begin with another marker, keep it ;; in the accumulator. Otherwise, clear the accumulator to avoid an ;; unnecessary concat during the next call. (setq gud-marker-acc (if (string-match "\\(stopped\\|signal\\)" gud-marker-acc start) (substring gud-marker-acc (match-beginning 0)) nil))) string) ;; Functions for Mips-style dbx. Given the option `-emacs', documented in ;; OSF1, not necessarily elsewhere, it produces markers similar to gdb's. (defvar gud-mips-p (or (string-match "^mips-[^-]*-ultrix" system-configuration) ;; We haven't tested gud on this system: (string-match "^mips-[^-]*-riscos" system-configuration) ;; It's documented on OSF/1.3 (string-match "^mips-[^-]*-osf1" system-configuration) (string-match "^alpha-[^-]*-osf" system-configuration)) "Non-nil to assume the MIPS/OSF dbx conventions (argument `-emacs').") (defun gud-mipsdbx-massage-args (file args) (cons "-emacs" args)) ;; This is just like the gdb one except for the regexps since we need to cope ;; with an optional breakpoint number in [] before the ^Z^Z (defun gud-mipsdbx-marker-filter (string) (setq gud-marker-acc (concat gud-marker-acc string)) (let ((output "")) ;; Process all the complete markers in this chunk. (while (string-match ;; This is like th gdb marker but with an optional ;; leading break point number like `[1] ' "[][ 0-9]*\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" gud-marker-acc) (setq ;; Extract the frame position from the marker. gud-last-frame (cons (substring gud-marker-acc (match-beginning 1) (match-end 1)) (string-to-int (substring gud-marker-acc (match-beginning 2) (match-end 2)))) ;; Append any text before the marker to the output we're going ;; to return - we don't include the marker in this text. output (concat output (substring gud-marker-acc 0 (match-beginning 0))) ;; Set the accumulator to the remaining text. gud-marker-acc (substring gud-marker-acc (match-end 0)))) ;; Does the remaining text look like it might end with the ;; beginning of another marker? If it does, then keep it in ;; gud-marker-acc until we receive the rest of it. Since we ;; know the full marker regexp above failed, it's pretty simple to ;; test for marker starts. (if (string-match "[][ 0-9]*\032.*\\'" gud-marker-acc) (progn ;; Everything before the potential marker start can be output. (setq output (concat output (substring gud-marker-acc 0 (match-beginning 0)))) ;; Everything after, we save, to combine with later input. (setq gud-marker-acc (substring gud-marker-acc (match-beginning 0)))) (setq output (concat output gud-marker-acc) gud-marker-acc "")) output)) ;; The dbx in IRIX is a pain. It doesn't print the file name when ;; stopping at a breakpoint (but you do get it from the `up' and ;; `down' commands...). The only way to extract the information seems ;; to be with a `file' command, although the current line number is ;; available in $curline. Thus we have to look for output which ;; appears to indicate a breakpoint. Then we prod the dbx sub-process ;; to output the information we want with a combination of the ;; `printf' and `file' commands as a pseudo marker which we can ;; recognise next time through the marker-filter. This would be like ;; the gdb marker but you can't get the file name without a newline... ;; Note that gud-remove won't work since Irix dbx expects a breakpoint ;; number rather than a line number etc. Maybe this could be made to ;; work by listing all the breakpoints and picking the one(s) with the ;; correct line number, but life's too short. ;; d.love@dl.ac.uk (Dave Love) can be blamed for this (defvar gud-irix-p (string-match "^mips-[^-]*-irix" system-configuration) "Non-nil to assume the interface appropriate for IRIX dbx. This works in IRIX 4, 5 and 6.") ;; [Irix dbx seems to be a moving target. The dbx output changed ;; subtly sometime between OS v4.0.5 and v5.2 so that, for instance, ;; the output from `up' is no longer spotted by gud (and it's probably ;; not distinctive enough to try to match it -- use C-<, C-> ;; exclusively) . For 5.3 and 6.0, the $curline variable changed to ;; `long long'(why?!), so the printf stuff needed changing. The line ;; number is cast to `long' as a compromise between the new `long ;; long' and the original `int'. The process filter is also somewhat ;; unreliable, sometimes not spotting the markers; I don't know ;; whether there's anything that can be done about that. It would be ;; much better if SGI could be persuaded to (re?)instate the MIPS ;; -emacs flag for gdb-like output (which ought to be possible as most ;; of the communication I've had over it has been from sgi.com).] ;; this filter is influenced by the xdb one rather than the gdb one (defun gud-irixdbx-marker-filter (string) (let (result (case-fold-search nil)) (if (or (string-match comint-prompt-regexp string) (string-match ".*\012" string)) (setq result (concat gud-marker-acc string) gud-marker-acc "") (setq gud-marker-acc (concat gud-marker-acc string))) (if result (cond ;; look for breakpoint or signal indication e.g.: ;; [2] Process 1267 (pplot) stopped at [params:338 ,0x400ec0] ;; Process 1281 (pplot) stopped at [params:339 ,0x400ec8] ;; Process 1270 (pplot) Floating point exception [._read._read:16 ,0x452188] ((string-match "^\\(\\[[0-9]+] \\)?Process +[0-9]+ ([^)]*) [^[]+\\[[^]\n]*]\n" result) ;; prod dbx into printing out the line number and file ;; name in a form we can grok as below (process-send-string (get-buffer-process gud-comint-buffer) "printf \"\032\032%1d:\",(long)$curline;file\n")) ;; look for result of, say, "up" e.g.: ;; .pplot.pplot(0x800) ["src/pplot.f":261, 0x400c7c] ;; (this will also catch one of the lines printed by "where") ((string-match "^[^ ][^[]*\\[\"\\([^\"]+\\)\":\\([0-9]+\\), [^]]+]\n" result) (let ((file (substring result (match-beginning 1) (match-end 1)))) (if (file-exists-p file) (setq gud-last-frame (cons (substring result (match-beginning 1) (match-end 1)) (string-to-int (substring result (match-beginning 2) (match-end 2))))))) result) ((string-match ; kluged-up marker as above "\032\032\\([0-9]*\\):\\(.*\\)\n" result) (let ((file (gud-dbx-file-name (substring result (match-beginning 2) (match-end 2))))) (if (and file (file-exists-p file)) (setq gud-last-frame (cons file (string-to-int (substring result (match-beginning 1) (match-end 1))))))) (setq result (substring result 0 (match-beginning 0)))))) (or result ""))) (defun gud-dbx-find-file (f) (save-excursion (let ((realf (gud-dbx-file-name f))) (if realf (let ((buf (find-file-noselect f))) (set-buffer buf) (gud-make-debug-menu) (local-set-key [menu-bar debug up] '("Up Stack" . gud-up)) (local-set-key [menu-bar debug down] '("Down Stack" . gud-down)) buf) nil)))) ;;;###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)))) (cond (gud-mips-p (gud-common-init command-line 'gud-mipsdbx-massage-args 'gud-mipsdbx-marker-filter 'gud-dbx-find-file)) (gud-irix-p (gud-common-init command-line 'gud-dbx-massage-args 'gud-irixdbx-marker-filter 'gud-dbx-find-file)) (t (gud-common-init command-line 'gud-dbx-massage-args 'gud-dbx-marker-filter 'gud-dbx-find-file))) (cond (gud-mips-p (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.") (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.") (gud-def gud-break "stop at \"%f\":%l" "\C-b" "Set breakpoint at current line.") (gud-def gud-finish "return" "\C-f" "Finish executing current function.")) (gud-irix-p (gud-def gud-break "stop at \"%d%f\":%l" "\C-b" "Set breakpoint at current line.") (gud-def gud-finish "return" "\C-f" "Finish executing current function.") (gud-def gud-up "up %p; printf \"\032\032%1ld:\",(long)$curline;file\n" "<" "Up (numeric arg) stack frames.") (gud-def gud-down "down %p; printf \"\032\032%1ld:\",(long)$curline;file\n" ">" "Down (numeric arg) stack frames.") ;; Make dbx give out the source location info that we need. (process-send-string (get-buffer-process gud-comint-buffer) "printf \"\032\032%1d:\",(long)$curline;file\n")) (t (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.") (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.") (gud-def gud-break "file \"%d%f\"\nstop at %l" "\C-b" "Set breakpoint at current line."))) (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") (gud-def gud-step "step %p" "\C-s" "Step one line with display.") (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") (gud-def gud-cont "cont" "\C-r" "Continue with display.") (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") (setq comint-prompt-regexp "^[^)\n]*dbx) *") (setq paragraph-start comint-prompt-regexp) (local-set-key [menu-bar debug up] '("Up Stack" . gud-up)) (local-set-key [menu-bar debug down] '("Down Stack" . gud-down)) (run-hooks 'dbx-mode-hook) ) ;; ====================================================================== ;; xdb (HP PARISC debugger) functions ;;; History of argument lists passed to xdb. (defvar gud-xdb-history nil) (defvar gud-xdb-directories nil "*A list of directories that xdb should search for source code. If nil, only source files in the program directory will be known to xdb. The file names should be absolute, or relative to the directory 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 result)) args)) (defun gud-xdb-file-name (f) "Transform a relative pathname to a full pathname in xdb mode" (let ((result nil)) (if (file-exists-p f) (setq result (expand-file-name f)) (let ((directories gud-xdb-directories)) (while directories (let ((path (concat (car directories) "/" f))) (if (file-exists-p path) (setq result (expand-file-name path) directories nil))) (setq directories (cdr directories))))) result)) ;; xdb does not print the lines all at once, so we have to accumulate them (defun gud-xdb-marker-filter (string) (let (result) (if (or (string-match comint-prompt-regexp string) (string-match ".*\012" string)) (setq result (concat gud-marker-acc string) gud-marker-acc "") (setq gud-marker-acc (concat gud-marker-acc string))) (if result (if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\)[: ]" result) (string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):" result)) (let ((line (string-to-int (substring result (match-beginning 2) (match-end 2)))) (file (gud-xdb-file-name (substring result (match-beginning 1) (match-end 1))))) (if file (setq gud-last-frame (cons file line)))))) (or result ""))) (defun gud-xdb-find-file (f) (save-excursion (let ((realf (gud-xdb-file-name f))) (if realf (let ((buf (find-file-noselect realf))) (set-buffer buf) (gud-make-debug-menu) (local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak)) (local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish)) (local-set-key [menu-bar debug up] '("Up Stack" . gud-up)) (local-set-key [menu-bar debug down] '("Down Stack" . gud-down)) buf) nil)))) ;;;###autoload (defun xdb (command-line) "Run xdb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger. You can set the variable 'gud-xdb-directories' to a list of program source 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-common-init command-line 'gud-xdb-massage-args 'gud-xdb-marker-filter 'gud-xdb-find-file) (gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.") (gud-def gud-tbreak "b %f:%l\\t" "\C-t" "Set temporary breakpoint at current line.") (gud-def gud-remove "db" "\C-d" "Remove breakpoint at current line") (gud-def gud-step "s %p" "\C-s" "Step one line with display.") (gud-def gud-next "S %p" "\C-n" "Step one line (skip functions).") (gud-def gud-cont "c" "\C-r" "Continue with display.") (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.") (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.") (gud-def gud-finish "bu\\t" "\C-f" "Finish executing current function.") (gud-def gud-print "p %e" "\C-p" "Evaluate C expression at point.") (setq comint-prompt-regexp "^>") (setq paragraph-start comint-prompt-regexp) (local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak)) (local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish)) (local-set-key [menu-bar debug up] '("Up Stack" . gud-up)) (local-set-key [menu-bar debug down] '("Down Stack" . gud-down)) (run-hooks 'xdb-mode-hook)) ;; ====================================================================== ;; perldb functions ;;; History of argument lists passed to perldb. (defvar gud-perldb-history nil) (defun gud-perldb-massage-args (file args) (cons "-d" (cons (car args) (cons "-emacs" (cdr args))))) ;; There's no guarantee that Emacs will hand the filter the entire ;; marker at once; it could be broken up across several strings. We ;; might even receive a big chunk with several markers in it. If we ;; receive a chunk of text which looks like it might contain the ;; beginning of a marker, we save it here between calls to the ;; filter. (defvar gud-perldb-marker-acc "") (defun gud-perldb-marker-filter (string) (setq gud-marker-acc (concat gud-marker-acc string)) (let ((output "")) ;; Process all the complete markers in this chunk. (while (string-match "\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" gud-marker-acc) (setq ;; Extract the frame position from the marker. gud-last-frame (cons (substring gud-marker-acc (match-beginning 1) (match-end 1)) (string-to-int (substring gud-marker-acc (match-beginning 2) (match-end 2)))) ;; Append any text before the marker to the output we're going ;; to return - we don't include the marker in this text. output (concat output (substring gud-marker-acc 0 (match-beginning 0))) ;; Set the accumulator to the remaining text. gud-marker-acc (substring gud-marker-acc (match-end 0)))) ;; Does the remaining text look like it might end with the ;; beginning of another marker? If it does, then keep it in ;; gud-marker-acc until we receive the rest of it. Since we ;; know the full marker regexp above failed, it's pretty simple to ;; test for marker starts. (if (string-match "\032.*\\'" gud-marker-acc) (progn ;; Everything before the potential marker start can be output. (setq output (concat output (substring gud-marker-acc 0 (match-beginning 0)))) ;; Everything after, we save, to combine with later input. (setq gud-marker-acc (substring gud-marker-acc (match-beginning 0)))) (setq output (concat output gud-marker-acc) gud-marker-acc "")) output)) (defun gud-perldb-find-file (f) (save-excursion (let ((buf (find-file-noselect f))) (set-buffer buf) (gud-make-debug-menu) buf))) ;;;###autoload (defun perldb (command-line) "Run perldb 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 perldb (like this): " (if (consp gud-perldb-history) (car gud-perldb-history) "perl ") nil nil '(gud-perldb-history . 1)))) (gud-common-init command-line 'gud-perldb-massage-args 'gud-perldb-marker-filter 'gud-perldb-find-file) (gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.") (gud-def gud-remove "d %l" "\C-d" "Remove breakpoint at current line") (gud-def gud-step "s" "\C-s" "Step one source line with display.") (gud-def gud-next "n" "\C-n" "Step one line (skip functions).") (gud-def gud-cont "c" "\C-r" "Continue with display.") ; (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") ; (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") ; (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") (gud-def gud-print "%e" "\C-p" "Evaluate perl expression at point.") (setq comint-prompt-regexp "^ DB<[0-9]+> ") (setq paragraph-start comint-prompt-regexp) (run-hooks 'perldb-mode-hook) ) ;; ;; End of debugger-specific information ;; ;;; When we send a command to the debugger via gud-call, it's annoying ;;; to see the command and the new prompt inserted into the debugger's ;;; buffer; we have other ways of knowing the command has completed. ;;; ;;; If the buffer looks like this: ;;; -------------------- ;;; (gdb) set args foo bar ;;; (gdb) -!- ;;; -------------------- ;;; (the -!- marks the location of point), and we type `C-x SPC' in a ;;; source file to set a breakpoint, we want the buffer to end up like ;;; this: ;;; -------------------- ;;; (gdb) set args foo bar ;;; Breakpoint 1 at 0x92: file make-docfile.c, line 49. ;;; (gdb) -!- ;;; -------------------- ;;; Essentially, the old prompt is deleted, and the command's output ;;; and the new prompt take its place. ;;; ;;; Not echoing the command is easy enough; you send it directly using ;;; process-send-string, and it never enters the buffer. However, ;;; getting rid of the old prompt is trickier; you don't want to do it ;;; when you send the command, since that will result in an annoying ;;; flicker as the prompt is deleted, redisplay occurs while Emacs ;;; waits for a response from the debugger, and the new prompt is ;;; inserted. Instead, we'll wait until we actually get some output ;;; from the subprocess before we delete the prompt. If the command ;;; produced no output other than a new prompt, that prompt will most ;;; likely be in the first chunk of output received, so we will delete ;;; the prompt and then replace it with an identical one. If the ;;; command produces output, the prompt is moving anyway, so the ;;; flicker won't be annoying. ;;; ;;; So - when we want to delete the prompt upon receipt of the next ;;; chunk of debugger output, we position gud-delete-prompt-marker at ;;; the start of the prompt; the process filter will notice this, and ;;; delete all text between it and the process output marker. If ;;; gud-delete-prompt-marker points nowhere, we leave the current ;;; prompt alone. (defvar gud-delete-prompt-marker nil) (defun gud-mode () "Major mode for interacting with an inferior debugger process. You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx, or M-x xdb. Each entry point finishes by executing a hook; `gdb-mode-hook', `sdb-mode-hook', `dbx-mode-hook' or `xdb-mode-hook' respectively. After startup, the following commands are available in both the GUD interaction buffer and any source buffer GUD visits due to a breakpoint stop or step operation: \\[gud-break] sets a breakpoint at the current file and line. In the GUD buffer, the current file and line are those of the last breakpoint or step. In a source buffer, they are the buffer's file and current line. \\[gud-remove] removes breakpoints on the current file and line. \\[gud-refresh] displays in the source window the last line referred to in the gud buffer. \\[gud-step], \\[gud-next], and \\[gud-stepi] do a step-one-line, step-one-line (not entering function calls), and step-one-instruction and then update the source window with the current file and position. \\[gud-cont] continues execution. \\[gud-print] tries to find the largest C lvalue or function-call expression around point, and sends it to the debugger for value display. The above commands are common to all supported debuggers except xdb which does not support stepping instructions. Under gdb, sdb and xdb, \\[gud-tbreak] behaves exactly like \\[gud-break], except that the breakpoint is temporary; that is, it is removed when execution stops on it. Under gdb, dbx, and xdb, \\[gud-up] pops up through an enclosing stack frame. \\[gud-down] drops back down through one. If you are using gdb or xdb, \\[gud-finish] runs execution to the return from the current function and stops. All the keystrokes above are accessible in the GUD buffer with the prefix C-c, and in all buffers through the prefix C-x C-a. All pre-defined functions for which the concept make sense repeat themselves the appropriate number of times if you give a prefix argument. You may use the `gud-def' macro in the initialization hook to define other commands. Other commands for interacting with the debugger process are inherited from comint mode, which see." (interactive) (comint-mode) (setq major-mode 'gud-mode) (setq mode-name "Debugger") (setq mode-line-process '(":%s")) (use-local-map comint-mode-map) (gud-make-debug-menu) (define-key (current-local-map) "\C-c\C-l" 'gud-refresh) (make-local-variable 'gud-last-frame) (setq gud-last-frame nil) (make-local-variable 'comint-prompt-regexp) (make-local-variable 'paragraph-start) (make-local-variable 'gud-delete-prompt-marker) (setq gud-delete-prompt-marker (make-marker)) (run-hooks 'gud-mode-hook)) ;; 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. ;; The first arg is the specified command line, ;; which starts with the program to debug. ;; The other three args specify the values to use ;; for local variables in the debugger buffer. (defun gud-common-init (command-line massage-args marker-filter find-file) (let* ((words (gud-chop-words command-line)) (program (car words)) ;; Extract the file name from WORDS ;; and put t in its place. ;; Later on we will put the modified file name arg back there. (file-word (let ((w (cdr words))) (while (and w (= ?- (aref (car w) 0))) (setq w (cdr w))) (and w (prog1 (car w) (setcar w t))))) (file-subst (and file-word (substitute-in-file-name file-word))) (args (cdr words)) ;; If a directory was specified, expand the file name. ;; Otherwise, don't expand it, so GDB can use the PATH. ;; A file name without directory is literally valid ;; only if the file exists in ., and in that case, ;; omitting the expansion here has no visible effect. (file (and file-word (if (file-name-directory file-subst) (expand-file-name file-subst) file-subst))) (filepart (and file-word (concat "-" (file-name-nondirectory file))))) (switch-to-buffer (concat "*gud" filepart "*")) ;; Set default-directory to the file's directory. (and file-word ;; Don't set default-directory if no directory was specified. ;; In that case, either the file is found in the current directory, ;; in which case this setq is a no-op, ;; or it is found by searching PATH, ;; in which case we don't know what directory it was found in. (file-name-directory file) (setq default-directory (file-name-directory file))) (or (bolp) (newline)) (insert "Current directory is " default-directory "\n") ;; Put the substituted and expanded file name back in its place. (let ((w args)) (while (and w (not (eq (car w) t))) (setq w (cdr w))) (if w (setcar w file))) (apply 'make-comint (concat "gud" filepart) program nil (funcall massage-args file args))) ;; Since comint clobbered the mode, we don't set it until now. (gud-mode) (make-local-variable 'gud-marker-filter) (setq gud-marker-filter marker-filter) (make-local-variable 'gud-find-file) (setq gud-find-file find-file) (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel) (gud-set-buffer) ) (defun gud-set-buffer () (cond ((eq major-mode 'gud-mode) (setq gud-comint-buffer (current-buffer))))) (defvar gud-filter-defer-flag nil "Non-nil means don't process anything from the debugger right now. It is saved for when this flag is not set.") (defvar gud-filter-pending-text nil "Non-nil means this is text that has been saved for later in `gud-filter'.") ;; These functions are responsible for inserting output from your debugger ;; into the buffer. The hard work is done by the method that is ;; the value of gud-marker-filter. (defun gud-filter (proc string) ;; Here's where the actual buffer insertion is done (let (output process-window) (if (buffer-name (process-buffer proc)) (if gud-filter-defer-flag ;; If we can't process any text now, ;; save it for later. (setq gud-filter-pending-text (concat (or gud-filter-pending-text "") string)) (save-excursion ;; If we have to ask a question during the processing, ;; defer any additional text that comes from the debugger ;; during that time. (let ((gud-filter-defer-flag t)) ;; Process now any text we previously saved up. (if gud-filter-pending-text (setq string (concat gud-filter-pending-text string) gud-filter-pending-text nil)) (set-buffer (process-buffer proc)) ;; If we have been so requested, delete the debugger prompt. (if (marker-buffer gud-delete-prompt-marker) (progn (delete-region (process-mark proc) gud-delete-prompt-marker) (set-marker gud-delete-prompt-marker nil))) ;; Save the process output, checking for source file markers. (setq output (gud-marker-filter string)) ;; Check for a filename-and-line number. ;; Don't display the specified file ;; unless (1) point is at or after the position where output appears ;; and (2) this buffer is on the screen. (setq process-window (and gud-last-frame (>= (point) (process-mark proc)) (get-buffer-window (current-buffer))))) (if process-window (save-selected-window (select-window process-window) (gud-display-frame))) ;; Let the comint filter do the actual insertion. ;; That lets us inherit various comint features. (comint-output-filter proc output) ;; If we deferred text that arrived during this processing, ;; handle it now. (if gud-filter-pending-text (gud-filter proc ""))))))) (defun gud-sentinel (proc msg) (cond ((null (buffer-name (process-buffer proc))) ;; buffer killed ;; Stop displaying an arrow in a source file. (setq overlay-arrow-position nil) (set-process-buffer proc nil)) ((memq (process-status proc) '(signal exit)) ;; Stop displaying an arrow in a source file. (setq overlay-arrow-position nil) ;; Fix the mode line. (setq mode-line-process (concat ":" (symbol-name (process-status proc)))) (let* ((obuf (current-buffer))) ;; save-excursion isn't the right thing if ;; process-buffer is current-buffer (unwind-protect (progn ;; Write something in *compilation* and hack its mode line, (set-buffer (process-buffer proc)) (force-mode-line-update) (if (eobp) (insert ?\n mode-name " " msg) (save-excursion (goto-char (point-max)) (insert ?\n mode-name " " msg))) ;; If buffer and mode line will show that the process ;; is dead, we can delete it now. Otherwise it ;; will stay around until M-x list-processes. (delete-process proc)) ;; Restore old buffer, but don't restore old point ;; if obuf is the gud buffer. (set-buffer obuf)))))) (defun gud-display-frame () "Find and obey the last filename-and-line marker from the debugger. Obeying it means displaying in another window the specified file and line." (interactive) (if gud-last-frame (progn (gud-set-buffer) (gud-display-line (car gud-last-frame) (cdr gud-last-frame)) (setq gud-last-last-frame gud-last-frame gud-last-frame nil)))) ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen ;; and that its line LINE is visible. ;; Put the overlay-arrow on the line LINE in that buffer. ;; Most of the trickiness in here comes from wanting to preserve the current ;; region-restriction if that's possible. We use an explicit display-buffer ;; to get around the fact that this is called inside a save-excursion. (defun gud-display-line (true-file line) (let* ((last-nonmenu-event t) ; Prevent use of dialog box for questions. (buffer (gud-find-file true-file)) (window (display-buffer buffer)) (pos)) ;;; (if (equal buffer (current-buffer)) ;;; nil ;;; (setq buffer-read-only nil)) (save-excursion ;;; (setq buffer-read-only t) (set-buffer buffer) (save-restriction (widen) (goto-line line) (setq pos (point)) (setq overlay-arrow-string "=>") (or overlay-arrow-position (setq overlay-arrow-position (make-marker))) (set-marker overlay-arrow-position (point) (current-buffer))) (cond ((or (< pos (point-min)) (> pos (point-max))) (widen) (goto-char pos)))) (set-window-point window overlay-arrow-position))) ;;; The gud-call function must do the right thing whether its invoking ;;; keystroke is from the GUD buffer itself (via major-mode binding) ;;; or a C buffer. In the former case, we want to supply data from ;;; gud-last-frame. Here's how we do it: (defun gud-format-command (str arg) (let ((insource (not (eq (current-buffer) gud-comint-buffer))) (frame (or gud-last-frame gud-last-last-frame)) result) (while (and str (string-match "\\([^%]*\\)%\\([adeflp]\\)" str)) (let ((key (string-to-char (substring str (match-beginning 2)))) subst) (cond ((eq key ?f) (setq subst (file-name-nondirectory (if insource (buffer-file-name) (car frame))))) ((eq key ?d) (setq subst (file-name-directory (if insource (buffer-file-name) (car frame))))) ((eq key ?l) (setq subst (if insource (save-excursion (beginning-of-line) (save-restriction (widen) (1+ (count-lines 1 (point))))) (cdr frame)))) ((eq key ?e) (setq subst (find-c-expr))) ((eq key ?a) (setq subst (gud-read-address))) ((eq key ?p) (setq subst (if arg (int-to-string arg) "")))) (setq result (concat result (substring str (match-beginning 1) (match-end 1)) subst))) (setq str (substring str (match-end 2)))) ;; There might be text left in STR when the loop ends. (concat result str))) (defun gud-read-address () "Return a string containing the core-address found in the buffer at point." (save-excursion (let ((pt (point)) found begin) (setq found (if (search-backward "0x" (- pt 7) t) (point))) (cond (found (forward-char 2) (buffer-substring found (progn (re-search-forward "[^0-9a-f]") (forward-char -1) (point)))) (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1) (point))) (forward-char 1) (re-search-forward "[^0-9]") (forward-char -1) (buffer-substring begin (point))))))) (defun gud-call (fmt &optional arg) (let ((msg (gud-format-command fmt arg))) (message "Command: %s" msg) (sit-for 0) (gud-basic-call msg))) (defun gud-basic-call (command) "Invoke the debugger COMMAND displaying source in other window." (interactive) (gud-set-buffer) (let ((command (concat command "\n")) (proc (get-buffer-process gud-comint-buffer))) (or proc (error "Current buffer has no process")) ;; Arrange for the current prompt to get deleted. (save-excursion (set-buffer gud-comint-buffer) (goto-char (process-mark proc)) (beginning-of-line) (if (looking-at comint-prompt-regexp) (set-marker gud-delete-prompt-marker (point)))) (process-send-string proc command))) (defun gud-refresh (&optional arg) "Fix up a possibly garbled display, and redraw the arrow." (interactive "P") (recenter arg) (or gud-last-frame (setq gud-last-frame gud-last-last-frame)) (gud-display-frame)) ;;; Code for parsing expressions out of C code. The single entry point is ;;; find-c-expr, which tries to return an lvalue expression from around point. ;;; ;;; The rest of this file is a hacked version of gdbsrc.el by ;;; Debby Ayers , ;;; Rich Schaefer Schlumberger, Austin, Tx. (defun find-c-expr () "Returns the C expr that surrounds point." (interactive) (save-excursion (let ((p) (expr) (test-expr)) (setq p (point)) (setq expr (expr-cur)) (setq test-expr (expr-prev)) (while (expr-compound test-expr expr) (setq expr (cons (car test-expr) (cdr expr))) (goto-char (car expr)) (setq test-expr (expr-prev))) (goto-char p) (setq test-expr (expr-next)) (while (expr-compound expr test-expr) (setq expr (cons (car expr) (cdr test-expr))) (setq test-expr (expr-next)) ) (buffer-substring (car expr) (cdr expr))))) (defun expr-cur () "Returns the expr that point is in; point is set to beginning of expr. The expr is represented as a cons cell, where the car specifies the point in the current buffer that marks the beginning of the expr and the cdr specifies the character after the end of the expr." (let ((p (point)) (begin) (end)) (expr-backward-sexp) (setq begin (point)) (expr-forward-sexp) (setq end (point)) (if (>= p end) (progn (setq begin p) (goto-char p) (expr-forward-sexp) (setq end (point)) ) ) (goto-char begin) (cons begin end))) (defun expr-backward-sexp () "Version of `backward-sexp' that catches errors." (condition-case nil (backward-sexp) (error t))) (defun expr-forward-sexp () "Version of `forward-sexp' that catches errors." (condition-case nil (forward-sexp) (error t))) (defun expr-prev () "Returns the previous expr, point is set to beginning of that expr. The expr is represented as a cons cell, where the car specifies the point in the current buffer that marks the beginning of the expr and the cdr specifies the character after the end of the expr" (let ((begin) (end)) (expr-backward-sexp) (setq begin (point)) (expr-forward-sexp) (setq end (point)) (goto-char begin) (cons begin end))) (defun expr-next () "Returns the following expr, point is set to beginning of that expr. The expr is represented as a cons cell, where the car specifies the point in the current buffer that marks the beginning of the expr and the cdr specifies the character after the end of the expr." (let ((begin) (end)) (expr-forward-sexp) (expr-forward-sexp) (setq end (point)) (expr-backward-sexp) (setq begin (point)) (cons begin end))) (defun expr-compound-sep (span-start span-end) "Returns '.' for '->' & '.', returns ' ' for white space, returns '?' for other punctuation." (let ((result ? ) (syntax)) (while (< span-start span-end) (setq syntax (char-syntax (char-after span-start))) (cond ((= syntax ? ) t) ((= syntax ?.) (setq syntax (char-after span-start)) (cond ((= syntax ?.) (setq result ?.)) ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>)) (setq result ?.) (setq span-start (+ span-start 1))) (t (setq span-start span-end) (setq result ??))))) (setq span-start (+ span-start 1))) result)) (defun expr-compound (first second) "Non-nil if concatenating FIRST and SECOND makes a single C token. The two exprs are represented as a cons cells, where the car specifies the point in the current buffer that marks the beginning of the expr and the cdr specifies the character after the end of the expr. Link exprs of the form: Expr -> Expr Expr . Expr Expr (Expr) Expr [Expr] (Expr) Expr [Expr] Expr" (let ((span-start (cdr first)) (span-end (car second)) (syntax)) (setq syntax (expr-compound-sep span-start span-end)) (cond ((= (car first) (car second)) nil) ((= (cdr first) (cdr second)) nil) ((= syntax ?.) t) ((= syntax ? ) (setq span-start (char-after (- span-start 1))) (setq span-end (char-after span-end)) (cond ((= span-start ?) ) t ) ((= span-start ?] ) t ) ((= span-end ?( ) t ) ((= span-end ?[ ) t ) (t nil)) ) (t nil)))) (provide 'gud) ;;; gud.el ends here emacs-19.30/lisp/hanoi.el100444 75424 12 17055 5747257556 13631 0ustar kwzhstaff;;; hanoi.el --- towers of hanoi in GNUmacs ;; Author: Damon Anton Permezel ;; Maintainer: FSF ;; Keywords: games ; Author (a) 1985, Damon Anton Permezel ; This is in the public domain ; since he distributed it without copyright notice in 1985. ;;; Commentary: ;; Solves the Towers of Hanoi puzzle while-U-wait. ;; ;; The puzzle: Start with N rings, decreasing in sizes from bottom to ;; top, stacked around a post. There are two other posts. Your mission, ;; should you choose to accept it, is to shift the pile, stacked in its ;; original order, to another post. ;; ;; The challenge is to do it in the fewest possible moves. Each move ;; shifts one ring to a different post. But there's a rule; you can ;; only stack a ring on top of a larger one. ;; ;; The simplest nontrivial version of this puzzle is N = 3. Solution ;; time rises as 2**N, and programs to solve it have long been considered ;; classic introductory exercises in the use of recursion. ;; ;; The puzzle is called `Towers of Hanoi' because an early popular ;; presentation wove a fanciful legend around it. According to this ;; myth (uttered long before the Vietnam War), there is a Buddhist ;; monastery at Hanoi which contains a large room with three time-worn ;; posts in it surrounded by 21 golden discs. Monks, acting out the ;; command of an ancient prophecy, have been moving these disks, in ;; accordance with the rules of the puzzle, once every day since the ;; monastery was founded over a thousand years ago. They are said ;; believe that when the last move of the puzzle is completed, the ;; world will end in a clap of thunder. Fortunately, they are nowhere ;; even close to being done... ;;; Code: ;;; ;;; hanoi-topos - direct cursor addressing ;;; (defun hanoi-topos (row col) (goto-line row) (beginning-of-line) (forward-char col)) ;;; ;;; hanoi - user callable Towers of Hanoi ;;; ;;;###autoload (defun hanoi (nrings) "Towers of Hanoi diversion. Argument is number of rings." (interactive (list (if (null current-prefix-arg) 3 (prefix-numeric-value current-prefix-arg)))) (if (<= nrings 0) (error "Negative number of rings")) (let* (floor-row fly-row (window-height (window-height (selected-window))) (window-width (window-width (selected-window))) ;; This is the unit of spacing to use between poles. It ;; must be even. We round down, since rounding up might ;; cause us to draw off the edge of the window. (pole-spacing (logand (/ window-width 6) (lognot 1)))) (let ( ;; The poles are (1+ NRINGS) rows high; we also want an ;; empty row at the top for the flying rings, a base, and a ;; blank line underneath that. (h (+ nrings 4)) ;; If we have NRINGS rings, we label them with the numbers 0 ;; through NRINGS-1. The width of ring i is 2i+3; it pokes ;; out i spaces on either side of the pole. Rather than ;; checking if the window is wide enough to accommodate this, ;; we make sure pole-spacing is large enough, since that ;; works even when we have decremented pole-spacing to make ;; it even. (w (1+ nrings))) (if (not (and (>= window-height h) (> pole-spacing w))) (progn (delete-other-windows) (if (not (and (>= (setq window-height (window-height (selected-window))) h) (> (setq pole-spacing (logand (/ window-width 6) (lognot 1))) w))) (error "Screen is too small (need at least %dx%d)" w h)))) (setq floor-row (if (> (- window-height 3) h) (- window-height 3) window-height))) (let ((fly-row (- floor-row nrings 1)) ;; pole: column . fill height (pole-1 (cons pole-spacing floor-row)) (pole-2 (cons (* 3 pole-spacing) floor-row)) (pole-3 (cons (* 5 pole-spacing) floor-row)) (rings (make-vector nrings nil))) ;; construct the ring list (let ((i 0)) (while (< i nrings) ;; ring: [pole-number string empty-string] (aset rings i (vector nil (make-string (+ i i 3) (+ ?0 i)) (make-string (+ i i 3) ?\ ))) (setq i (1+ i)))) ;; ;; init the screen ;; (switch-to-buffer "*Hanoi*") (setq buffer-read-only nil) (buffer-disable-undo (current-buffer)) (erase-buffer) (let ((i 0)) (while (< i floor-row) (setq i (1+ i)) (insert-char ?\ (1- window-width)) (insert ?\n))) (insert-char ?= (1- window-width)) (let ((n 1)) (while (< n 6) (hanoi-topos fly-row (* n pole-spacing)) (setq n (+ n 2)) (let ((i fly-row)) (while (< i floor-row) (setq i (1+ i)) (next-line 1) (insert ?\|) (delete-char 1) (backward-char 1))))) ;(sit-for 0) ;; ;; now draw the rings in their initial positions ;; (let ((i 0) ring) (while (< i nrings) (setq ring (aref rings (- nrings 1 i))) (aset ring 0 (- floor-row i)) (hanoi-topos (cdr pole-1) (- (car pole-1) (- nrings i))) (hanoi-draw-ring ring t nil) (setcdr pole-1 (1- (cdr pole-1))) (setq i (1+ i)))) (setq buffer-read-only t) (sit-for 0) ;; ;; do it! ;; (hanoi0 (1- nrings) pole-1 pole-2 pole-3) (goto-char (point-min)) (message "Done") (setq buffer-read-only t) (force-mode-line-update) (sit-for 0)))) ;;; ;;; hanoi0 - work horse of hanoi ;;; (defun hanoi0 (n from to work) (cond ((input-pending-p) (signal 'quit (list "I can tell you've had enough"))) ((< n 0)) (t (hanoi0 (1- n) from work to) (hanoi-move-ring n from to) (hanoi0 (1- n) work to from)))) ;;; ;;; hanoi-move-ring - move ring 'n' from 'from' to 'to' ;;; ;;; (defun hanoi-move-ring (n from to) (let ((ring (aref rings n)) ; ring <- ring: (ring# . row) (buffer-read-only nil)) (let ((row (aref ring 0)) ; row <- row ring is on (col (- (car from) n 1)) ; col <- left edge of ring (dst-col (- (car to) n 1)) ; dst-col <- dest col for left edge (dst-row (cdr to))) ; dst-row <- dest row for ring (hanoi-topos row col) (while (> row fly-row) ; move up to the fly row (hanoi-draw-ring ring nil t) ; blank out ring (previous-line 1) ; move up a line (hanoi-draw-ring ring t nil) ; redraw (sit-for 0) (setq row (1- row))) (setcdr from (1+ (cdr from))) ; adjust top row ;; ;; fly the ring over to the right pole ;; (while (not (equal dst-col col)) (cond ((> dst-col col) ; dst-col > col: right shift (end-of-line 1) (delete-backward-char 2) (beginning-of-line 1) (insert ?\ ?\ ) (sit-for 0) (setq col (1+ (1+ col)))) ((< dst-col col) ; dst-col < col: left shift (beginning-of-line 1) (delete-char 2) (end-of-line 1) (insert ?\ ?\ ) (sit-for 0) (setq col (1- (1- col)))))) ;; ;; let the ring float down ;; (hanoi-topos fly-row dst-col) (while (< row dst-row) ; move down to the dest row (hanoi-draw-ring ring nil (> row fly-row)) ; blank out ring (next-line 1) ; move down a line (hanoi-draw-ring ring t nil) ; redraw ring (sit-for 0) (setq row (1+ row))) (aset ring 0 dst-row) (setcdr to (1- (cdr to)))))) ; adjust top row ;;; ;;; draw-ring - draw the ring at point, leave point unchanged ;;; ;;; Input: ;;; ring ;;; f1 - flag: t -> draw, nil -> erase ;;; f2 - flag: t -> erasing and need to draw ?\| ;;; (defun hanoi-draw-ring (ring f1 f2) (save-excursion (let* ((string (if f1 (aref ring 1) (aref ring 2))) (len (length string))) (delete-char len) (insert string) (if f2 (progn (backward-char (/ (+ len 1) 2)) (delete-char 1) (insert ?\|)))))) (provide 'hanoi) ;;; hanoi.el ends here emacs-19.30/lisp/help-macro.el100444 12120 1 14707 5774412205 14457 0ustar rmsdaemon;;; help-macro.el --- Makes command line help such as help-for-help ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: Lynn Slater ;; Created: : Mon Oct 1 11:42:39 1990 ;; Adapted-By: ESR ;; 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 file supplies the macro make-help-screen which constructs ;; single character dispatching with browsable help such as that provided ;; by help-for-help. This can be used to make many modes easier to use; for ;; example, the Gnu Emacs Empire Tool uses this for every "nested" mode map ;; called from the main mode map. ;; The name of this package was changed from help-screen.el to ;; help-macro.el in order to fit in a 14-character limit. ;;-> *********************** Example of use ********************************* ;;->(make-help-screen help-for-empire-redistribute-map ;;-> "c:civ m:mil p:population f:food ?" ;;-> "You have discovered the GEET redistribution commands ;;-> From here, you can use the following options: ;;-> ;;->c Redistribute civs from overfull sectors into connected underfull ones ;;-> The functions typically named by empire-ideal-civ-fcn control ;;-> based in part on empire-sector-civ-threshold ;;->m Redistribute military using levels given by empire-ideal-mil-fcn ;;->p Redistribute excess population to highways for max pop growth ;;-> Excess is any sector so full babies will not be born. ;;->f Even out food on highways to highway min and leave levels ;;-> This is good to pump max food to all warehouses/dist pts ;;-> ;;-> ;;->Use \\[help-for-empire-redistribute-map] for help on redistribution. ;;->Use \\[help-for-empire-extract-map] for help on data extraction. ;;->Please use \\[describe-key] to find out more about any of the other keys." ;;-> empire-shell-redistribute-map) ;;-> (define-key c-mp "\C-h" 'help-for-empire-redistribute-map) ;;-> (define-key c-mp help-character 'help-for-empire-redistribute-map) ;;; Change Log: ;; ;; 22-Jan-1991 Lynn Slater x2048 ;; Last Modified: Mon Oct 1 11:43:52 1990 #3 (Lynn Slater) ;; documented better ;;; Code: (provide 'help-macro) (require 'backquote) ;;;###autoload (defvar three-step-help nil "*Non-nil means give more info about Help command in three steps. The three steps are simple prompt, prompt with all options, and window listing and describing the options. A value of nil means skip the middle step, so that \\[help-command] \\[help-command] gives the window that lists the options.") (defmacro make-help-screen (fname help-line help-text helped-map) "Construct help-menu function name FNAME. When invoked, FNAME shows HELP-LINE and reads a command using HELPED-MAP. If the command is the help character, FNAME displays HELP-TEXT and continues trying to read a command using HELPED-MAP. When FNAME finally does get a command, it executes that command and then returns." (` (defun (, fname) () (, help-text) (interactive) (let ((line-prompt (substitute-command-keys (, help-line)))) (if three-step-help (message line-prompt)) (let* ((help-screen (documentation (quote (, fname)))) ;; We bind overriding-local-map for very small ;; sections, *excluding* where we switch buffers ;; and where we execute the chosen help command. (local-map (make-sparse-keymap)) (minor-mode-map-alist nil) (prev-frame (selected-frame)) config new-frame key char) (unwind-protect (progn (setcdr local-map (, helped-map)) (define-key local-map [t] 'undefined) (if three-step-help (progn (setq key (let ((overriding-local-map local-map)) (read-key-sequence nil))) ;; Make the HELP key translate to C-h. (if (lookup-key function-key-map key) (setq key (lookup-key function-key-map key))) (setq char (aref key 0))) (setq char ??)) (if (or (eq char ??) (eq char help-char) (memq char help-event-list)) (progn (setq config (current-window-configuration)) (switch-to-buffer-other-window "*Help*") (and (fboundp 'make-frame) (not (eq (window-frame (selected-window)) prev-frame)) (setq new-frame (window-frame (selected-window)) config nil)) (erase-buffer) (insert help-screen) (help-mode) (goto-char (point-min)) (while (or (memq char (append help-event-list (cons help-char '(?? ?\C-v ?\ ?\177 delete backspace ?\M-v)))) (eq (car-safe char) 'switch-frame) (equal key "\M-v")) (condition-case nil (progn (if (eq (car-safe char) 'switch-frame) (handle-switch-frame char)) (if (memq char '(?\C-v ?\ )) (scroll-up)) (if (or (memq char '(?\177 ?\M-v delete backspace)) (equal key "\M-v")) (scroll-down))) (error nil)) (let ((cursor-in-echo-area t) (overriding-local-map local-map)) (setq key (read-key-sequence (format "Type one of the options listed%s: " (if (pos-visible-in-window-p (point-max)) "" " or Space to scroll"))) char (aref key 0)))))) ;; Mouse clicks are not part of the help feature, ;; so reexecute them in the standard environment. (if (listp char) (setq unread-command-events (cons char unread-command-events) config nil) (let ((defn (lookup-key local-map key))) (if defn (progn (if config (progn (set-window-configuration config) (setq config nil))) (if new-frame (progn (iconify-frame new-frame) (setq new-frame nil))) (call-interactively defn)) (ding))))) (if new-frame (iconify-frame new-frame)) (if config (set-window-configuration config)))))) )) ;;; help-macro.el emacs-19.30/lisp/help.el100444 12120 1 56402 6045270435 13355 0ustar rmsdaemon;;; help.el --- help commands for Emacs ;; Copyright (C) 1985, 1986, 1993, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal ;; 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 code implements GNU Emac's on-line help system, the one invoked by ;;`M-x help-for-help'. ;;; Code: ;; Get the macro make-help-screen when this is compiled, ;; or run interpreted, but not when the compiled code is loaded. (eval-when-compile (require 'help-macro)) (defvar help-map (make-sparse-keymap) "Keymap for characters following the Help key.") (defvar help-mode-map (make-sparse-keymap) "Keymap for help mode.") (define-key global-map (char-to-string help-char) 'help-command) (define-key global-map [help] 'help-command) (define-key global-map [f1] 'help-command) (fset 'help-command help-map) (define-key help-map (char-to-string help-char) 'help-for-help) (define-key help-map [help] 'help-for-help) (define-key help-map [f1] 'help-for-help) (define-key help-map "?" 'help-for-help) (define-key help-map "\C-c" 'describe-copying) (define-key help-map "\C-d" 'describe-distribution) (define-key help-map "\C-w" 'describe-no-warranty) (define-key help-map "\C-p" 'describe-project) (define-key help-map "a" 'command-apropos) (define-key help-map "b" 'describe-bindings) (define-key help-map "c" 'describe-key-briefly) (define-key help-map "k" 'describe-key) (define-key help-map "d" 'describe-function) (define-key help-map "f" 'describe-function) (define-key help-map "F" 'view-emacs-FAQ) (define-key help-map "i" 'info) (define-key help-map "\C-f" 'Info-goto-emacs-command-node) (define-key help-map "\C-k" 'Info-goto-emacs-key-command-node) (define-key help-map "l" 'view-lossage) (define-key help-map "m" 'describe-mode) (define-key help-map "\C-n" 'view-emacs-news) (define-key help-map "n" 'view-emacs-news) (define-key help-map "p" 'finder-by-keyword) (autoload 'finder-by-keyword "finder" "Find packages matching a given keyword." t) (define-key help-map "s" 'describe-syntax) (define-key help-map "t" 'help-with-tutorial) (define-key help-map "w" 'where-is) (define-key help-map "v" 'describe-variable) (define-key help-map "q" 'help-quit) (defvar help-font-lock-keywords (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]")) (list ;; ;; The symbol itself. (list (concat "\\`\\(" name-char "+\\)\\(:\\)?") '(1 (if (match-beginning 2) font-lock-function-name-face font-lock-variable-name-face) nil t)) ;; ;; Words inside `' which tend to be symbol names. (list (concat "`\\(" sym-char sym-char "+\\)'") 1 'font-lock-reference-face t) ;; ;; CLisp `:' keywords as references. (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t))) "Default expressions to highlight in Help mode.") (defun help-mode () "Major mode for viewing help text. Entry to this mode runs the normal hook `help-mode-hook'. Commands: \\{help-mode-map}" (interactive) (kill-all-local-variables) (use-local-map help-mode-map) (setq mode-name "Help") (setq major-mode 'help-mode) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(help-font-lock-keywords)) (view-mode) (run-hooks 'help-mode-hook)) (defun help-quit () (interactive) nil) (defun help-with-tutorial () "Select the Emacs learn-by-doing tutorial." (interactive) (let ((file (expand-file-name "~/TUTORIAL"))) (delete-other-windows) (if (get-file-buffer file) (switch-to-buffer (get-file-buffer file)) (switch-to-buffer (create-file-buffer file)) (setq buffer-file-name file) (setq default-directory (expand-file-name "~/")) (setq buffer-auto-save-file-name nil) (insert-file-contents (expand-file-name "TUTORIAL" data-directory)) (goto-char (point-min)) (search-forward "\n<<") (beginning-of-line) (delete-region (point) (progn (end-of-line) (point))) (let ((n (- (window-height (selected-window)) (count-lines (point-min) (point)) 6))) (if (< n 12) (newline n) ;; Some people get confused by the large gap. (newline (/ n 2)) (insert "[Middle of page left blank for didactic purposes. " "Text continues below]") (newline (- n (/ n 2))))) (goto-char (point-min)) (set-buffer-modified-p nil)))) (defun describe-key-briefly (key) "Print the name of the function KEY invokes. KEY is a string." (interactive "kDescribe key briefly: ") ;; If this key seq ends with a down event, discard the ;; following click or drag event. Otherwise that would ;; erase the message. (let ((type (aref key (1- (length key))))) (if (listp type) (setq type (car type))) (and (symbolp type) (memq 'down (event-modifiers type)) (read-event))) (save-excursion (let ((modifiers (event-modifiers (aref key 0))) window position) ;; For a mouse button event, go to the button it applies to ;; to get the right key bindings. And go to the right place ;; in case the keymap depends on where you clicked. (if (or (memq 'click modifiers) (memq 'down modifiers) (memq 'drag modifiers)) (setq window (posn-window (event-start (aref key 0))) position (posn-point (event-start (aref key 0))))) (if (windowp window) (progn (set-buffer (window-buffer window)) (goto-char position))) ;; Ok, now look up the key and name the command. (let ((defn (key-binding key))) (if (or (null defn) (integerp defn)) (message "%s is undefined" (key-description key)) (message (if (windowp window) "%s at that spot runs the command %s" "%s runs the command %s") (key-description key) (if (symbolp defn) defn (prin1-to-string defn)))))))) (defun print-help-return-message (&optional function) "Display or return message saying how to restore windows after help command. Computes a message and applies the optional argument FUNCTION to it. If FUNCTION is nil, applies `message' to it, thus printing it." (and (not (get-buffer-window standard-output)) (let ((first-message (cond ((or (member (buffer-name standard-output) special-display-buffer-names) (assoc (buffer-name standard-output) special-display-buffer-names) (let (found (tail special-display-regexps) (name (buffer-name standard-output))) (while (and tail (not found)) (if (or (and (consp (car tail)) (string-match (car (car tail)) name)) (and (stringp (car tail)) (string-match (car tail) name))) (setq found t)) (setq tail (cdr tail))) found)) ;; If the help output buffer is a special display buffer, ;; don't say anything about how to get rid of it. ;; First of all, the user will do that with the window ;; manager, not with Emacs. ;; Secondly, the buffer has not been displayed yet, ;; so we don't know whether its frame will be selected. ;; Even the message about scrolling the help ;; might be wrong, but it seems worth showing it anyway. nil) ((not (one-window-p t)) "Type \\[switch-to-buffer-other-window] RET to restore the other window.") (pop-up-windows "Type \\[delete-other-windows] to remove help window.") (t "Type \\[switch-to-buffer] RET to remove help window.")))) (funcall (or function 'message) (concat (if first-message (substitute-command-keys first-message) "") (if first-message " " "") ;; If the help buffer will go in a separate frame, ;; it's no use mentioning a command to scroll, so don't. (if (or (member (buffer-name standard-output) special-display-buffer-names) (assoc (buffer-name standard-output) special-display-buffer-names) (memq t (mapcar '(lambda (elt) (if (consp elt) (setq elt (car elt))) (string-match elt (buffer-name standard-output))) special-display-regexps))) nil (if (or (member (buffer-name standard-output) same-window-buffer-names) (assoc (buffer-name standard-output) same-window-buffer-names) (memq t (mapcar '(lambda (elt) (if (consp elt) (setq elt (car elt))) (string-match elt (buffer-name standard-output))) same-window-regexps))) ;; Say how to scroll this window. (substitute-command-keys "\\[scroll-up] to scroll the help.") ;; Say how to scroll some other window. (substitute-command-keys "\\[scroll-other-window] to scroll the help.")))))))) (defun describe-key (key) "Display documentation of the function invoked by KEY. KEY is a string." (interactive "kDescribe key: ") ;; If this key seq ends with a down event, discard the ;; following click or drag event. Otherwise that would ;; erase the message. (let ((type (aref key (1- (length key))))) (if (listp type) (setq type (car type))) (and (symbolp type) (memq 'down (event-modifiers type)) (read-event))) (save-excursion (let ((modifiers (event-modifiers (aref key 0))) window position) ;; For a mouse button event, go to the button it applies to ;; to get the right key bindings. And go to the right place ;; in case the keymap depends on where you clicked. (if (or (memq 'click modifiers) (memq 'down modifiers) (memq 'drag modifiers)) (setq window (posn-window (event-start (aref key 0))) position (posn-point (event-start (aref key 0))))) (if (windowp window) (progn (set-buffer (window-buffer window)) (goto-char position))) (let ((defn (key-binding key))) (if (or (null defn) (integerp defn)) (message "%s is undefined" (key-description key)) (with-output-to-temp-buffer "*Help*" (princ (key-description key)) (if (windowp window) (princ " at that spot")) (princ " runs the command ") (prin1 defn) (princ ":\n") (let ((doc (documentation defn))) (if doc (progn (terpri) (princ doc)) (princ "not documented"))) (save-excursion (set-buffer standard-output) (help-mode)) (print-help-return-message))))))) (defun describe-mode () "Display documentation of current major mode and minor modes. For this to work correctly for a minor mode, the mode's indicator variable \(listed in `minor-mode-alist') must also be a function whose documentation describes the minor mode." (interactive) (with-output-to-temp-buffer "*Help*" (let ((minor-modes minor-mode-alist) (locals (buffer-local-variables))) (while minor-modes (let* ((minor-mode (car (car minor-modes))) (indicator (car (cdr (car minor-modes)))) (local-binding (assq minor-mode locals))) ;; Document a minor mode if it is listed in minor-mode-alist, ;; bound locally in this buffer, non-nil, and has a function ;; definition. (if (and local-binding (cdr local-binding) (fboundp minor-mode)) (let ((pretty-minor-mode minor-mode)) (if (string-match "-mode$" (symbol-name minor-mode)) (setq pretty-minor-mode (capitalize (substring (symbol-name minor-mode) 0 (match-beginning 0))))) (while (and indicator (symbolp indicator)) (setq indicator (symbol-value indicator))) (princ (format "%s minor mode (indicator%s):\n" pretty-minor-mode indicator)) (princ (documentation minor-mode)) (princ "\n\n")))) (setq minor-modes (cdr minor-modes)))) (princ mode-name) (princ " mode:\n") (princ (documentation major-mode)) (save-excursion (set-buffer standard-output) (help-mode)) (print-help-return-message))) ;; So keyboard macro definitions are documented correctly (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro)) (defun describe-distribution () "Display info on how to obtain the latest version of GNU Emacs." (interactive) (find-file-read-only (expand-file-name "DISTRIB" data-directory))) (defun describe-copying () "Display info on how you may redistribute copies of GNU Emacs." (interactive) (find-file-read-only (expand-file-name "COPYING" data-directory)) (goto-char (point-min))) (defun describe-project () "Display info on the GNU project." (interactive) (find-file-read-only (expand-file-name "GNU" data-directory)) (goto-char (point-min))) (defun describe-no-warranty () "Display info on all the kinds of warranty Emacs does NOT have." (interactive) (describe-copying) (let (case-fold-search) (search-forward "NO WARRANTY") (recenter 0))) (defun describe-prefix-bindings () "Describe the bindings of the prefix used to reach this command. The prefix described consists of all but the last event of the key sequence that ran this command." (interactive) (let* ((key (this-command-keys))) (describe-bindings (if (stringp key) (substring key 0 (1- (length key))) (let ((prefix (make-vector (1- (length key)) nil)) (i 0)) (while (< i (length prefix)) (aset prefix i (aref key i)) (setq i (1+ i))) prefix))))) ;; Make C-h after a prefix, when not specifically bound, ;; run describe-prefix-bindings. (setq prefix-help-command 'describe-prefix-bindings) (defun view-emacs-news () "Display info on recent changes to Emacs." (interactive) (find-file-read-only (expand-file-name "NEWS" data-directory))) (defun view-emacs-FAQ () "Display the Emacs Frequently Asked Questions (FAQ) file." (interactive) (find-file-read-only (expand-file-name "FAQ" data-directory))) (defun view-lossage () "Display last 100 input keystrokes." (interactive) (with-output-to-temp-buffer "*Help*" (princ (mapconcat (function (lambda (key) (if (or (integerp key) (symbolp key) (listp key)) (single-key-description key) (prin1-to-string key nil)))) (recent-keys) " ")) (save-excursion (set-buffer standard-output) (goto-char (point-min)) (while (progn (move-to-column 50) (not (eobp))) (search-forward " " nil t) (insert "\n")) (help-mode)) (print-help-return-message))) (defalias 'help 'help-for-help) (make-help-screen help-for-help "a b c f C-f i k C-k l m n p s t v w C-c C-d C-n C-w, or ? for more help:" "You have typed \\[help-command], the help character. Type a Help option: \(Use SPC or DEL to scroll through this text. Type \\\\[help-quit] to exit the Help command.) a command-apropos. Give a substring, and see a list of commands (functions interactively callable) that contain that substring. See also the apropos command. b describe-bindings. Display table of all key bindings. c describe-key-briefly. Type a command key sequence; it prints the function name that sequence runs. f describe-function. Type a function name and get documentation of it. C-f Info-goto-emacs-command-node. Type a function name; it takes you to the Info node for that command. F view-emacs-FAQ. Shows emacs frequently asked questions file. i info. The info documentation reader. k describe-key. Type a command key sequence; it displays the full documentation. C-k Info-goto-emacs-key-command-node. Type a command key sequence; it takes you to the Info node for the command bound to that key. l view-lossage. Shows last 100 characters you typed. m describe-mode. Print documentation of current major mode, which describes the commands peculiar to it. n view-emacs-news. Shows emacs news file. p finder-by-keyword. Find packages matching a given topic keyword. s describe-syntax. Display contents of syntax table, plus explanations t help-with-tutorial. Select the Emacs learn-by-doing tutorial. v describe-variable. Type name of a variable; it displays the variable's documentation and value. w where-is. Type command name; it prints which keystrokes invoke that command. C-c print Emacs copying permission (General Public License). C-d print Emacs ordering information. C-n print news of recent Emacs changes. C-p print information about the GNU project. C-w print information on absence of warranty for GNU Emacs." help-map) ;; Return a function which is called by the list containing point. ;; If that gives no function, return a function whose name is around point. ;; If that doesn't give a function, return nil. (defun function-called-at-point () (or (condition-case () (save-excursion (save-restriction (narrow-to-region (max (point-min) (- (point) 1000)) (point-max)) (backward-up-list 1) (forward-char 1) (let (obj) (setq obj (read (current-buffer))) (and (symbolp obj) (fboundp obj) obj)))) (error nil)) (condition-case () (let ((stab (syntax-table))) (unwind-protect (save-excursion (set-syntax-table emacs-lisp-mode-syntax-table) (or (not (zerop (skip-syntax-backward "_w"))) (eq (char-syntax (following-char)) ?w) (eq (char-syntax (following-char)) ?_) (forward-sexp -1)) (skip-chars-forward "'") (let ((obj (read (current-buffer)))) (and (symbolp obj) (fboundp obj) obj))) (set-syntax-table stab))) (error nil)))) (defun describe-function-find-file (function) (let ((files load-history) file functions) (while files (if (memq function (cdr (car files))) (setq file (car (car files)) files nil)) (setq files (cdr files))) file)) (defun describe-function (function) "Display the full documentation of FUNCTION (a symbol)." (interactive (let ((fn (function-called-at-point)) (enable-recursive-minibuffers t) val) (setq val (completing-read (if fn (format "Describe function (default %s): " fn) "Describe function: ") obarray 'fboundp t)) (list (if (equal val "") fn (intern val))))) (with-output-to-temp-buffer "*Help*" (prin1 function) (princ ": ") (let* ((def (symbol-function function)) file-name (beg (if (commandp def) "an interactive " "a "))) (princ (cond ((or (stringp def) (vectorp def)) "a keyboard macro") ((subrp def) (concat beg "built-in function")) ((byte-code-function-p def) (concat beg "compiled Lisp function")) ((symbolp def) (format "alias for `%s'" def)) ((eq (car-safe def) 'lambda) (concat beg "Lisp function")) ((eq (car-safe def) 'macro) "a Lisp macro") ((eq (car-safe def) 'mocklisp) "a mocklisp function") ((eq (car-safe def) 'autoload) (setq file-name (nth 1 def)) (format "%s autoloaded Lisp %s" (if (commandp def) "an interactive" "an") (if (nth 4 def) "macro" "function") )) (t ""))) (or file-name (setq file-name (describe-function-find-file function))) (if file-name (progn (princ " in `") ;; We used to add .el to the file name, ;; but that's completely wrong when the user used load-file. (princ file-name) (princ "'"))) (princ ".") (terpri) (let ((arglist (cond ((byte-code-function-p def) (car (append def nil))) ((eq (car-safe def) 'lambda) (nth 1 def)) (t t)))) (if (listp arglist) (progn (princ (cons function (mapcar (lambda (arg) (if (memq arg '(&optional &rest)) arg (intern (upcase (symbol-name arg))))) arglist))) (terpri)))) (let ((doc (documentation function))) (if doc (progn (terpri) (princ doc)) (princ "not documented")))) (print-help-return-message) (save-excursion (set-buffer standard-output) (help-mode) ;; Return the text we displayed. (buffer-string)))) (defun variable-at-point () (condition-case () (let ((stab (syntax-table))) (unwind-protect (save-excursion (set-syntax-table emacs-lisp-mode-syntax-table) (or (not (zerop (skip-syntax-backward "_w"))) (eq (char-syntax (following-char)) ?w) (eq (char-syntax (following-char)) ?_) (forward-sexp -1)) (skip-chars-forward "'") (let ((obj (read (current-buffer)))) (and (symbolp obj) (boundp obj) obj))) (set-syntax-table stab))) (error nil))) (defun describe-variable (variable) "Display the full documentation of VARIABLE (a symbol). Returns the documentation as a string, also." (interactive (let ((v (variable-at-point)) (enable-recursive-minibuffers t) val) (setq val (completing-read (if v (format "Describe variable (default %s): " v) "Describe variable: ") obarray 'boundp t)) (list (if (equal val "") v (intern val))))) (with-output-to-temp-buffer "*Help*" (prin1 variable) (if (not (boundp variable)) (princ " is void") (princ "'s value is ") (prin1 (symbol-value variable))) (terpri) (if (local-variable-p variable) (progn (princ (format "Local in buffer %s; " (buffer-name))) (if (not (default-boundp variable)) (princ "globally void") (princ "global value is ") (prin1 (default-value variable))) (terpri))) (terpri) (princ "Documentation:") (terpri) (let ((doc (documentation-property variable 'variable-documentation))) (princ (or doc "not documented as a variable."))) (print-help-return-message) (save-excursion (set-buffer standard-output) (help-mode) ;; Return the text we displayed. (buffer-string)))) (defun where-is (definition) "Print message listing key sequences that invoke specified command. Argument is a command definition, usually a symbol with a function definition." (interactive (let ((fn (function-called-at-point)) (enable-recursive-minibuffers t) val) (setq val (completing-read (if fn (format "Where is command (default %s): " fn) "Where is command: ") obarray 'fboundp t)) (list (if (equal val "") fn (intern val))))) (let* ((keys (where-is-internal definition overriding-local-map nil nil)) (keys1 (mapconcat 'key-description keys ", "))) (if (> (length keys1) 0) (message "%s is on %s" definition keys1) (message "%s is not on any key" definition))) nil) (defun locate-library (library &optional nosuffix) "Show the full path name of Emacs library LIBRARY. This command searches the directories in `load-path' like `M-x load-library' to find the file that `M-x load-library RET LIBRARY RET' would load. Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el' to the specified name LIBRARY (a la calling `load' instead of `load-library')." (interactive "sLocate library: ") (catch 'answer (mapcar '(lambda (dir) (mapcar '(lambda (suf) (let ((try (expand-file-name (concat library suf) dir))) (and (file-readable-p try) (null (file-directory-p try)) (progn (message "Library is file %s" try) (throw 'answer try))))) (if nosuffix '("") '(".elc" ".el" "")))) load-path) (message "No library %s in search path" library) nil)) ;;; help.el ends here emacs-19.30/lisp/helper.el100444 12120 1 11632 5752616334 13706 0ustar rmsdaemon;;; helper.el --- utility help package supporting help in electric modes ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF ;; Keywords: help ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ; hey, here's a helping hand. ;; Bind this to a string for in "... Other keys ". ;; Helper-help uses this to construct help string when scrolling. ;; Defaults to "return" (defvar Helper-return-blurb nil) ;; Keymap implementation doesn't work too well for non-standard loops. ;; But define it anyway for those who can use it. Non-standard loops ;; will probably have to use Helper-help. You can't autoload the ;; keymap either. (defvar Helper-help-map nil) (if Helper-help-map nil (setq Helper-help-map (make-keymap)) ;(fillarray Helper-help-map 'undefined) (define-key Helper-help-map "m" 'Helper-describe-mode) (define-key Helper-help-map "b" 'Helper-describe-bindings) (define-key Helper-help-map "c" 'Helper-describe-key-briefly) (define-key Helper-help-map "k" 'Helper-describe-key) ;(define-key Helper-help-map "f" 'Helper-describe-function) ;(define-key Helper-help-map "v" 'Helper-describe-variable) (define-key Helper-help-map "?" 'Helper-help-options) (define-key Helper-help-map (char-to-string help-char) 'Helper-help-options) (fset 'Helper-help-map Helper-help-map)) (defun Helper-help-scroller () (let ((blurb (or (and (boundp 'Helper-return-blurb) Helper-return-blurb) "return"))) (save-window-excursion (goto-char (window-start (selected-window))) (if (get-buffer-window "*Help*") (pop-to-buffer "*Help*") (switch-to-buffer "*Help*")) (goto-char (point-min)) (let ((continue t) state) (while continue (setq state (+ (* 2 (if (pos-visible-in-window-p (point-max)) 1 0)) (if (pos-visible-in-window-p (point-min)) 1 0))) (message (nth state '("Space forward, Delete back. Other keys %s" "Space scrolls forward. Other keys %s" "Delete scrolls back. Other keys %s" "Type anything to %s")) blurb) (setq continue (read-char)) (cond ((and (memq continue '(?\ ?\C-v)) (< state 2)) (scroll-up)) ((= continue ?\C-l) (recenter)) ((and (= continue ?\177) (zerop (% state 2))) (scroll-down)) (t (setq continue nil)))))))) (defun Helper-help-options () "Describe help options." (interactive) (message "c (key briefly), m (mode), k (key), b (bindings)") ;(message "c (key briefly), m (mode), k (key), v (variable), f (function)") (sit-for 4)) (defun Helper-describe-key-briefly (key) "Briefly describe binding of KEY." (interactive "kDescribe key briefly: ") (describe-key-briefly key) (sit-for 4)) (defun Helper-describe-key (key) "Describe binding of KEY." (interactive "kDescribe key: ") (save-window-excursion (describe-key key)) (Helper-help-scroller)) (defun Helper-describe-function () "Describe a function. Name read interactively." (interactive) (save-window-excursion (call-interactively 'describe-function)) (Helper-help-scroller)) (defun Helper-describe-variable () "Describe a variable. Name read interactively." (interactive) (save-window-excursion (call-interactively 'describe-variable)) (Helper-help-scroller)) (defun Helper-describe-mode () "Describe the current mode." (interactive) (let ((name mode-name) (documentation (documentation major-mode))) (save-excursion (set-buffer (get-buffer-create "*Help*")) (erase-buffer) (insert name " Mode\n" documentation) (help-mode))) (Helper-help-scroller)) ;;;###autoload (defun Helper-describe-bindings () "Describe local key bindings of current mode." (interactive) (message "Making binding list...") (save-window-excursion (describe-bindings)) (Helper-help-scroller)) ;;;###autoload (defun Helper-help () "Provide help for current mode." (interactive) (let ((continue t) c) (while continue (message "Help (Type ? for further options)") (setq c (read-key-sequence nil)) (setq c (lookup-key Helper-help-map c)) (cond ((eq c 'Helper-help-options) (Helper-help-options)) ((commandp c) (call-interactively c) (setq continue nil)) (t (ding) (setq continue nil)))))) (provide 'helper) ;;; helper.el ends here emacs-19.30/lisp/hexl.el100444 12120 1 64541 6054011341 13355 0ustar rmsdaemon;;; hexl.el --- edit a file in a hex dump format using the hexl filter. ;; Copyright (C) 1989, 1994 Free Software Foundation, Inc. ;; Author: Keith Gabryelski ;; Maintainer: FSF ;; Keywords: data ;; 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 package implements a major mode for editing binary files. It uses ;; a program called hexl, supplied with the GNU Emacs distribution, that ;; can filter a binary into an editable format or from the format back into ;; binary. For full instructions, invoke `hexl-mode' on an empty buffer and ;; do `M-x describe-mode'. ;; ;; This may be useful in your .emacs: ;; ;; (autoload 'hexl-find-file "hexl" ;; "Edit file FILENAME in hexl-mode." t) ;; ;; (define-key global-map "\C-c\C-h" 'hexl-find-file) ;; ;; NOTE: Remember to change HEXL-PROGRAM or HEXL-OPTIONS if needed. ;; ;; Currently hexl only supports big endian hex output with 16 bit ;; grouping. ;; ;; -iso in `hexl-options' will allow iso characters to display in the ;; ASCII region of the screen (if your emacs supports this) instead of ;; changing them to dots. ;;; Code: ;; ;; vars here ;; (defvar hexl-program "hexl" "The program that will hexlify and de-hexlify its stdin. `hexl-program' will always be concatenated with `hexl-options' and \"-de\" when dehexlfying a buffer.") (defvar hexl-iso "" "If your emacs can handle ISO characters, this should be set to \"-iso\" otherwise it should be \"\".") (defvar hexl-options (format "-hex %s" hexl-iso) "Options to hexl-program that suit your needs.") (defvar hexlify-command (format "%s%s %s" exec-directory hexl-program hexl-options) "The command to use to hexlify a buffer.") (defvar dehexlify-command (format "%s%s -de %s" exec-directory hexl-program hexl-options) "The command to use to unhexlify a buffer.") (defvar hexl-max-address 0 "Maximum offset into hexl buffer.") (defvar hexl-mode-map nil) (defvar hexl-mode-old-local-map) (defvar hexl-mode-old-mode-name) (defvar hexl-mode-old-major-mode) ;; routines ;;;###autoload (defun hexl-mode (&optional arg) "\\ A major mode for editing binary files in hex dump format. This function automatically converts a buffer into the hexl format using the function `hexlify-buffer'. Each line in the buffer has an \"address\" (displayed in hexadecimal) representing the offset into the file that the characters on this line are at and 16 characters from the file (displayed as hexadecimal values grouped every 16 bits) and as their ASCII values. If any of the characters (displayed as ASCII characters) are unprintable (control or meta characters) they will be replaced as periods. If `hexl-mode' is invoked with an argument the buffer is assumed to be in hexl format. A sample format: HEX ADDR: 0001 0203 0405 0607 0809 0a0b 0c0d 0e0f ASCII-TEXT -------- ---- ---- ---- ---- ---- ---- ---- ---- ---------------- 00000000: 5468 6973 2069 7320 6865 786c 2d6d 6f64 This is hexl-mod 00000010: 652e 2020 4561 6368 206c 696e 6520 7265 e. Each line re 00000020: 7072 6573 656e 7473 2031 3620 6279 7465 presents 16 byte 00000030: 7320 6173 2068 6578 6164 6563 696d 616c s as hexadecimal 00000040: 2041 5343 4949 0a61 6e64 2070 7269 6e74 ASCII.and print 00000050: 6162 6c65 2041 5343 4949 2063 6861 7261 able ASCII chara 00000060: 6374 6572 732e 2020 416e 7920 636f 6e74 cters. Any cont 00000070: 726f 6c20 6f72 206e 6f6e 2d41 5343 4949 rol or non-ASCII 00000080: 2063 6861 7261 6374 6572 730a 6172 6520 characters.are 00000090: 6469 7370 6c61 7965 6420 6173 2070 6572 displayed as per 000000a0: 696f 6473 2069 6e20 7468 6520 7072 696e iods in the prin 000000b0: 7461 626c 6520 6368 6172 6163 7465 7220 table character 000000c0: 7265 6769 6f6e 2e0a region.. Movement is as simple as movement in a normal emacs text buffer. Most cursor movement bindings are the same (ie. Use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line] to move the cursor left, right, down, and up). Advanced cursor movement commands (ala \\[hexl-beginning-of-line], \\[hexl-end-of-line], \\[hexl-beginning-of-buffer], and \\[hexl-end-of-buffer]) are also supported. There are several ways to change text in hexl mode: ASCII characters (character between space (0x20) and tilde (0x7E)) are bound to self-insert so you can simply type the character and it will insert itself (actually overstrike) into the buffer. \\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if it isn't bound to self-insert. An octal number can be supplied in place of another key to insert the octal number's ASCII representation. \\[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF) into the buffer at the current point. \\[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377) into the buffer at the current point. \\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255) into the buffer at the current point. \\[hexl-mode-exit] will exit hexl-mode. Note: saving the file with any of the usual Emacs commands will actually convert it back to binary format while saving. You can use \\[hexl-find-file] to visit a file in hexl-mode. \\[describe-bindings] for advanced commands." (interactive "p") (if (eq major-mode 'hexl-mode) (error "You are already in hexl mode.") (kill-all-local-variables) (make-local-variable 'hexl-mode-old-local-map) (setq hexl-mode-old-local-map (current-local-map)) (use-local-map hexl-mode-map) (make-local-variable 'hexl-mode-old-mode-name) (setq hexl-mode-old-mode-name mode-name) (setq mode-name "Hexl") (make-local-variable 'hexl-mode-old-major-mode) (setq hexl-mode-old-major-mode major-mode) (setq major-mode 'hexl-mode) (make-local-variable 'write-contents-hooks) (add-hook 'write-contents-hooks 'hexl-save-buffer) (make-local-hook 'after-revert-hook) (add-hook 'after-revert-hook 'hexl-after-revert-hook nil t) (make-local-variable 'hexl-max-address) (make-local-variable 'change-major-mode-hook) (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer) (make-local-variable 'require-final-newline) (setq require-final-newline nil) (let ((modified (buffer-modified-p)) (inhibit-read-only t) (original-point (1- (point)))) (and (eobp) (not (bobp)) (setq original-point (1- original-point))) (if (not (or (eq arg 1) (not arg))) ;; if no argument then we guess at hexl-max-address (setq hexl-max-address (+ (* (/ (1- (buffer-size)) 68) 16) 15)) (setq hexl-max-address (1- (buffer-size))) (hexlify-buffer) (set-buffer-modified-p modified) (hexl-goto-address original-point))))) (defun hexl-after-revert-hook () (hexlify-buffer) (set-buffer-modified-p nil)) (defvar hexl-in-save-buffer nil) (defun hexl-save-buffer () "Save a hexl format buffer as binary in visited file if modified." (interactive) (if hexl-in-save-buffer nil (set-buffer-modified-p (if (buffer-modified-p) (save-excursion (let ((buf (generate-new-buffer " hexl")) (name (buffer-name)) (file-name (buffer-file-name)) (start (point-min)) (end (point-max)) modified) (set-buffer buf) (insert-buffer-substring name start end) (set-buffer name) (dehexlify-buffer) ;; Prevent infinite recursion. (let ((hexl-in-save-buffer t) (buffer-file-type t)) ; for ms-dos (save-buffer)) (setq modified (buffer-modified-p)) (delete-region (point-min) (point-max)) (insert-buffer-substring buf start end) (kill-buffer buf) modified)) (message "(No changes need to be saved)") nil)) ;; Return t to indicate we have saved t t)) ;;;###autoload (defun hexl-find-file (filename) "Edit file FILENAME in hexl-mode. Switch to a buffer visiting file FILENAME, creating one in none exists." (interactive "fFilename: ") (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt)) (find-file-binary filename) (find-file filename)) (if (not (eq major-mode 'hexl-mode)) (hexl-mode))) (defun hexl-mode-exit (&optional arg) "Exit Hexl mode, returning to previous mode. With arg, don't unhexlify buffer." (interactive "p") (if (or (eq arg 1) (not arg)) (let ((modified (buffer-modified-p)) (inhibit-read-only t) (original-point (1+ (hexl-current-address)))) (dehexlify-buffer) (remove-hook 'write-contents-hook 'hexl-save-buffer) (set-buffer-modified-p modified) (goto-char original-point))) (setq mode-name hexl-mode-old-mode-name) (use-local-map hexl-mode-old-local-map) (setq major-mode hexl-mode-old-major-mode) (force-mode-line-update)) (defun hexl-maybe-dehexlify-buffer () "Convert a hexl format buffer to binary. Ask the user for confirmation." (if (y-or-n-p "Convert contents back to binary format? ") (let ((modified (buffer-modified-p)) (inhibit-read-only t) (original-point (1+ (hexl-current-address)))) (dehexlify-buffer) (remove-hook 'write-contents-hook 'hexl-save-buffer) (set-buffer-modified-p modified) (goto-char original-point)))) (defun hexl-current-address (&optional validate) "Return current hexl-address." (interactive) (let ((current-column (- (% (point) 68) 11)) (hexl-address 0)) (if (< current-column 0) (if validate (error "Point is not on a character in the file") (setq current-column 0))) (setq hexl-address (+ (* (/ (point) 68) 16) (if (>= current-column 41) (- current-column 41) (/ (- current-column (/ current-column 5)) 2)))) hexl-address)) (defun hexl-address-to-marker (address) "Return marker for ADDRESS." (interactive "nAddress: ") (+ (* (/ address 16) 68) 11 (/ (* (% address 16) 5) 2))) (defun hexl-goto-address (address) "Goto hexl-mode (decimal) address ADDRESS. Signal error if ADDRESS out of range." (interactive "nAddress: ") (if (or (< address 0) (> address hexl-max-address)) (error "Out of hexl region.")) (goto-char (hexl-address-to-marker address))) (defun hexl-goto-hex-address (hex-address) "Go to hexl-mode address (hex string) HEX-ADDRESS. Signal error if HEX-ADDRESS is out of range." (interactive "sHex Address: ") (hexl-goto-address (hexl-hex-string-to-integer hex-address))) (defun hexl-hex-string-to-integer (hex-string) "Return decimal integer for HEX-STRING." (interactive "sHex number: ") (let ((hex-num 0)) (while (not (equal hex-string "")) (setq hex-num (+ (* hex-num 16) (hexl-hex-char-to-integer (string-to-char hex-string)))) (setq hex-string (substring hex-string 1))) hex-num)) (defun hexl-octal-string-to-integer (octal-string) "Return decimal integer for OCTAL-STRING." (interactive "sOctal number: ") (let ((oct-num 0)) (while (not (equal octal-string "")) (setq oct-num (+ (* oct-num 8) (hexl-oct-char-to-integer (string-to-char octal-string)))) (setq octal-string (substring octal-string 1))) oct-num)) ;; move point functions (defun hexl-backward-char (arg) "Move to left ARG bytes (right if ARG negative) in hexl-mode." (interactive "p") (hexl-goto-address (- (hexl-current-address) arg))) (defun hexl-forward-char (arg) "Move right ARG bytes (left if ARG negative) in hexl-mode." (interactive "p") (hexl-goto-address (+ (hexl-current-address) arg))) (defun hexl-backward-short (arg) "Move to left ARG shorts (right if ARG negative) in hexl-mode." (interactive "p") (hexl-goto-address (let ((address (hexl-current-address))) (if (< arg 0) (progn (setq arg (- arg)) (while (> arg 0) (if (not (equal address (logior address 3))) (if (> address hexl-max-address) (progn (message "End of buffer.") (setq address hexl-max-address)) (setq address (logior address 3))) (if (> address hexl-max-address) (progn (message "End of buffer.") (setq address hexl-max-address)) (setq address (+ address 4)))) (setq arg (1- arg))) (if (> address hexl-max-address) (progn (message "End of buffer.") (setq address hexl-max-address)) (setq address (logior address 3)))) (while (> arg 0) (if (not (equal address (logand address -4))) (setq address (logand address -4)) (if (not (equal address 0)) (setq address (- address 4)) (message "Beginning of buffer."))) (setq arg (1- arg)))) address))) (defun hexl-forward-short (arg) "Move right ARG shorts (left if ARG negative) in hexl-mode." (interactive "p") (hexl-backward-short (- arg))) (defun hexl-backward-word (arg) "Move to left ARG words (right if ARG negative) in hexl-mode." (interactive "p") (hexl-goto-address (let ((address (hexl-current-address))) (if (< arg 0) (progn (setq arg (- arg)) (while (> arg 0) (if (not (equal address (logior address 7))) (if (> address hexl-max-address) (progn (message "End of buffer.") (setq address hexl-max-address)) (setq address (logior address 7))) (if (> address hexl-max-address) (progn (message "End of buffer.") (setq address hexl-max-address)) (setq address (+ address 8)))) (setq arg (1- arg))) (if (> address hexl-max-address) (progn (message "End of buffer.") (setq address hexl-max-address)) (setq address (logior address 7)))) (while (> arg 0) (if (not (equal address (logand address -8))) (setq address (logand address -8)) (if (not (equal address 0)) (setq address (- address 8)) (message "Beginning of buffer."))) (setq arg (1- arg)))) address))) (defun hexl-forward-word (arg) "Move right ARG words (left if ARG negative) in hexl-mode." (interactive "p") (hexl-backward-word (- arg))) (defun hexl-previous-line (arg) "Move vertically up ARG lines [16 bytes] (down if ARG negative) in hexl-mode. If there is byte at the target address move to the last byte in that line." (interactive "p") (hexl-next-line (- arg))) (defun hexl-next-line (arg) "Move vertically down ARG lines [16 bytes] (up if ARG negative) in hexl-mode. If there is no byte at the target address move to the last byte in that line." (interactive "p") (hexl-goto-address (let ((address (+ (hexl-current-address) (* arg 16)))) (if (and (< arg 0) (< address 0)) (progn (message "Out of hexl region.") (setq address (% (hexl-current-address) 16))) (if (and (> address hexl-max-address) (< (% hexl-max-address 16) (% address 16))) (setq address hexl-max-address) (if (> address hexl-max-address) (progn (message "Out of hexl region.") (setq address (+ (logand hexl-max-address -16) (% (hexl-current-address) 16))))))) address))) (defun hexl-beginning-of-buffer (arg) "Move to the beginning of the hexl buffer. Leaves `hexl-mark' at previous position. With prefix arg N, puts point N bytes of the way from the true beginning." (interactive "p") (push-mark (point)) (hexl-goto-address (+ 0 (1- arg)))) (defun hexl-end-of-buffer (arg) "Go to `hexl-max-address' minus ARG." (interactive "p") (push-mark (point)) (hexl-goto-address (- hexl-max-address (1- arg)))) (defun hexl-beginning-of-line () "Goto beginning of line in hexl mode." (interactive) (goto-char (+ (* (/ (point) 68) 68) 11))) (defun hexl-end-of-line () "Goto end of line in hexl mode." (interactive) (hexl-goto-address (let ((address (logior (hexl-current-address) 15))) (if (> address hexl-max-address) (setq address hexl-max-address)) address))) (defun hexl-scroll-down (arg) "Scroll hexl buffer window upward ARG lines; or near full window if no ARG." (interactive "P") (if (null arg) (setq arg (1- (window-height))) (setq arg (prefix-numeric-value arg))) (hexl-scroll-up (- arg))) (defun hexl-scroll-up (arg) "Scroll hexl buffer window upward ARG lines; or near full window if no ARG." (interactive "P") (if (null arg) (setq arg (1- (window-height))) (setq arg (prefix-numeric-value arg))) (let ((movement (* arg 16)) (address (hexl-current-address))) (if (or (> (+ address movement) hexl-max-address) (< (+ address movement) 0)) (message "Out of hexl region.") (hexl-goto-address (+ address movement)) (recenter 0)))) (defun hexl-beginning-of-1k-page () "Goto to beginning of 1k boundry." (interactive) (hexl-goto-address (logand (hexl-current-address) -1024))) (defun hexl-end-of-1k-page () "Goto to end of 1k boundry." (interactive) (hexl-goto-address (let ((address (logior (hexl-current-address) 1023))) (if (> address hexl-max-address) (setq address hexl-max-address)) address))) (defun hexl-beginning-of-512b-page () "Goto to beginning of 512 byte boundry." (interactive) (hexl-goto-address (logand (hexl-current-address) -512))) (defun hexl-end-of-512b-page () "Goto to end of 512 byte boundry." (interactive) (hexl-goto-address (let ((address (logior (hexl-current-address) 511))) (if (> address hexl-max-address) (setq address hexl-max-address)) address))) (defun hexl-quoted-insert (arg) "Read next input character and insert it. Useful for inserting control characters. You may also type up to 3 octal digits, to insert a character with that code" (interactive "p") (hexl-insert-char (read-quoted-char) arg)) ;00000000: 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789ABCDEF ;;;###autoload (defun hexlify-buffer () "Convert a binary buffer to hexl format." (interactive) (let ((binary-process-output nil) ; for Ms-Dos (binary-process-input t)) (shell-command-on-region (point-min) (point-max) hexlify-command t))) (defun dehexlify-buffer () "Convert a hexl format buffer to binary." (interactive) (let ((binary-process-output t) ; for Ms-Dos (binary-process-input nil)) (shell-command-on-region (point-min) (point-max) dehexlify-command t))) (defun hexl-char-after-point () "Return char for ASCII hex digits at point." (hexl-htoi (char-after (point)) (char-after (1+ (point))))) (defun hexl-htoi (lh rh) "Hex (char) LH (char) RH to integer." (+ (* (hexl-hex-char-to-integer lh) 16) (hexl-hex-char-to-integer rh))) (defun hexl-hex-char-to-integer (character) "Take a char and return its value as if it was a hex digit." (if (and (>= character ?0) (<= character ?9)) (- character ?0) (let ((ch (logior character 32))) (if (and (>= ch ?a) (<= ch ?f)) (- ch (- ?a 10)) (error (format "Invalid hex digit `%c'." ch)))))) (defun hexl-oct-char-to-integer (character) "Take a char and return its value as if it was a octal digit." (if (and (>= character ?0) (<= character ?7)) (- character ?0) (error (format "Invalid octal digit `%c'." character)))) (defun hexl-printable-character (ch) "Return a displayable string for character CH." (format "%c" (if hexl-iso (if (or (< ch 32) (and (>= ch 127) (< ch 160))) 46 ch) (if (or (< ch 32) (>= ch 127)) 46 ch)))) (defun hexl-self-insert-command (arg) "Insert this character." (interactive "p") (hexl-insert-char last-command-char arg)) (defun hexl-insert-char (ch num) "Insert a character in a hexl buffer." (let ((address (hexl-current-address t))) (while (> num 0) (let ((hex-position (+ (* (/ address 16) 68) 11 (* 2 (% address 16)) (/ (% address 16) 2))) (ascii-position (+ (* (/ address 16) 68) 52 (% address 16))) at-ascii-position) (if (= (point) ascii-position) (setq at-ascii-position t)) (goto-char hex-position) (delete-char 2) (insert (format "%02x" ch)) (goto-char ascii-position) (delete-char 1) (insert (hexl-printable-character ch)) (or (eq address hexl-max-address) (setq address (1+ address))) (hexl-goto-address address) (if at-ascii-position (progn (beginning-of-line) (forward-char 51) (forward-char (% address 16))))) (setq num (1- num))))) ;; hex conversion (defun hexl-insert-hex-char (arg) "Insert a ASCII char ARG times at point for a given hexadecimal number." (interactive "p") (let ((num (hexl-hex-string-to-integer (read-string "Hex number: ")))) (if (or (> num 255) (< num 0)) (error "Hex number out of range.") (hexl-insert-char num arg)))) (defun hexl-insert-decimal-char (arg) "Insert a ASCII char ARG times at point for a given decimal number." (interactive "p") (let ((num (string-to-int (read-string "Decimal Number: ")))) (if (or (> num 255) (< num 0)) (error "Decimal number out of range.") (hexl-insert-char num arg)))) (defun hexl-insert-octal-char (arg) "Insert a ASCII char ARG times at point for a given octal number." (interactive "p") (let ((num (hexl-octal-string-to-integer (read-string "Octal Number: ")))) (if (or (> num 255) (< num 0)) (error "Decimal number out of range.") (hexl-insert-char num arg)))) ;; startup stuff. (if hexl-mode-map nil (setq hexl-mode-map (make-sparse-keymap)) (define-key hexl-mode-map [left] 'hexl-backward-char) (define-key hexl-mode-map [right] 'hexl-forward-char) (define-key hexl-mode-map [up] 'hexl-previous-line) (define-key hexl-mode-map [down] 'hexl-next-line) (define-key hexl-mode-map [M-left] 'hexl-backward-short) (define-key hexl-mode-map [M-right] 'hexl-forward-short) (define-key hexl-mode-map [next] 'hexl-scroll-up) (define-key hexl-mode-map [prev] 'hexl-scroll-down) (define-key hexl-mode-map "\C-a" 'hexl-beginning-of-line) (define-key hexl-mode-map "\C-b" 'hexl-backward-char) (define-key hexl-mode-map "\C-d" 'undefined) (define-key hexl-mode-map "\C-e" 'hexl-end-of-line) (define-key hexl-mode-map "\C-f" 'hexl-forward-char) (if (not (eq (key-binding (char-to-string help-char)) 'help-command)) (define-key hexl-mode-map (char-to-string help-char) 'undefined)) (define-key hexl-mode-map "\C-i" 'hexl-self-insert-command) (define-key hexl-mode-map "\C-j" 'hexl-self-insert-command) (define-key hexl-mode-map "\C-k" 'undefined) (define-key hexl-mode-map "\C-m" 'hexl-self-insert-command) (define-key hexl-mode-map "\C-n" 'hexl-next-line) (define-key hexl-mode-map "\C-o" 'undefined) (define-key hexl-mode-map "\C-p" 'hexl-previous-line) (define-key hexl-mode-map "\C-q" 'hexl-quoted-insert) (define-key hexl-mode-map "\C-t" 'undefined) (define-key hexl-mode-map "\C-v" 'hexl-scroll-up) (define-key hexl-mode-map "\C-w" 'undefined) (define-key hexl-mode-map "\C-y" 'undefined) (let ((ch 32)) (while (< ch 127) (define-key hexl-mode-map (format "%c" ch) 'hexl-self-insert-command) (setq ch (1+ ch)))) (define-key hexl-mode-map "\e\C-a" 'hexl-beginning-of-512b-page) (define-key hexl-mode-map "\e\C-b" 'hexl-backward-short) (define-key hexl-mode-map "\e\C-c" 'undefined) (define-key hexl-mode-map "\e\C-d" 'hexl-insert-decimal-char) (define-key hexl-mode-map "\e\C-e" 'hexl-end-of-512b-page) (define-key hexl-mode-map "\e\C-f" 'hexl-forward-short) (define-key hexl-mode-map "\e\C-g" 'undefined) (define-key hexl-mode-map "\e\C-h" 'undefined) (define-key hexl-mode-map "\e\C-i" 'undefined) (define-key hexl-mode-map "\e\C-j" 'undefined) (define-key hexl-mode-map "\e\C-k" 'undefined) (define-key hexl-mode-map "\e\C-l" 'undefined) (define-key hexl-mode-map "\e\C-m" 'undefined) (define-key hexl-mode-map "\e\C-n" 'undefined) (define-key hexl-mode-map "\e\C-o" 'hexl-insert-octal-char) (define-key hexl-mode-map "\e\C-p" 'undefined) (define-key hexl-mode-map "\e\C-q" 'undefined) (define-key hexl-mode-map "\e\C-r" 'undefined) (define-key hexl-mode-map "\e\C-s" 'undefined) (define-key hexl-mode-map "\e\C-t" 'undefined) (define-key hexl-mode-map "\e\C-u" 'undefined) (define-key hexl-mode-map "\e\C-w" 'undefined) (define-key hexl-mode-map "\e\C-x" 'hexl-insert-hex-char) (define-key hexl-mode-map "\e\C-y" 'undefined) (define-key hexl-mode-map "\ea" 'undefined) (define-key hexl-mode-map "\eb" 'hexl-backward-word) (define-key hexl-mode-map "\ec" 'undefined) (define-key hexl-mode-map "\ed" 'undefined) (define-key hexl-mode-map "\ee" 'undefined) (define-key hexl-mode-map "\ef" 'hexl-forward-word) (define-key hexl-mode-map "\eg" 'hexl-goto-hex-address) (define-key hexl-mode-map "\eh" 'undefined) (define-key hexl-mode-map "\ei" 'undefined) (define-key hexl-mode-map "\ej" 'hexl-goto-address) (define-key hexl-mode-map "\ek" 'undefined) (define-key hexl-mode-map "\el" 'undefined) (define-key hexl-mode-map "\em" 'undefined) (define-key hexl-mode-map "\en" 'undefined) (define-key hexl-mode-map "\eo" 'undefined) (define-key hexl-mode-map "\ep" 'undefined) (define-key hexl-mode-map "\eq" 'undefined) (define-key hexl-mode-map "\er" 'undefined) (define-key hexl-mode-map "\es" 'undefined) (define-key hexl-mode-map "\et" 'undefined) (define-key hexl-mode-map "\eu" 'undefined) (define-key hexl-mode-map "\ev" 'hexl-scroll-down) (define-key hexl-mode-map "\ey" 'undefined) (define-key hexl-mode-map "\ez" 'undefined) (define-key hexl-mode-map "\e<" 'hexl-beginning-of-buffer) (define-key hexl-mode-map "\e>" 'hexl-end-of-buffer) (define-key hexl-mode-map "\C-c\C-c" 'hexl-mode-exit) (define-key hexl-mode-map "\C-x[" 'hexl-beginning-of-1k-page) (define-key hexl-mode-map "\C-x]" 'hexl-end-of-1k-page) (define-key hexl-mode-map "\C-x\C-p" 'undefined) (define-key hexl-mode-map "\C-x\C-s" 'hexl-save-buffer) (define-key hexl-mode-map "\C-x\C-t" 'undefined)) ;;; hexl.el ends here emacs-19.30/lisp/hideif.el100444 12120 1 100444 6043576323 13674 0ustar rmsdaemon;;; hide-ifdef-mode.el --- hides selected code within ifdef. ;;; Copyright (C) 1988, 1994 Free Software Foundation, Inc. ;; Author: Dan LaLiberte ;; Maintainer: FSF ;; Keywords: c, outlines ;; 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: ;;; To initialize, toggle the hide-ifdef minor mode with ;;; ;;; M-x hide-ifdef-mode ;;; ;;; This will set up key bindings and call hide-ifdef-mode-hook if it ;;; has a value. To explicitly hide ifdefs using a buffer-local ;;; define list (default empty), type ;;; ;;; M-x hide-ifdefs or C-c @ h ;;; ;;; Hide-ifdef suppresses the display of code that the preprocessor wouldn't ;;; pass through. The support of constant expressions in #if lines is ;;; limited to identifiers, parens, and the operators: &&, ||, !, and ;;; "defined". Please extend this. ;;; ;;; The hidden code is marked by ellipses (...). Be ;;; cautious when editing near ellipses, since the hidden text is ;;; still in the buffer, and you can move the point into it and modify ;;; text unawares. If you don't want to see the ellipses, set ;;; selective-display-ellipses to nil. But this can be dangerous. ;;; You can make your buffer read-only while hide-ifdef-hiding by setting ;;; hide-ifdef-read-only to a non-nil value. You can toggle this ;;; variable with hide-ifdef-toggle-read-only (C-c @ C-q). ;;; ;;; You can undo the effect of hide-ifdefs by typing ;;; ;;; M-x show-ifdefs or C-c @ s ;;; ;;; Use M-x hide-ifdef-define (C-c @ d) to define a symbol. ;;; Use M-x hide-ifdef-undef (C-c @ u) to undefine a symbol. ;;; ;;; If you define or undefine a symbol while hide-ifdef-mode is in effect, ;;; the display will be updated. Only the define list for the current ;;; buffer will be affected. You can save changes to the local define ;;; list with hide-ifdef-set-define-alist. This adds entries ;;; to hide-ifdef-define-alist. ;;; ;;; If you have defined a hide-ifdef-mode-hook, you can set ;;; up a list of symbols that may be used by hide-ifdefs as in the ;;; following example: ;;; ;;; (setq hide-ifdef-mode-hook ;;; '(lambda () ;;; (if (not hide-ifdef-define-alist) ;;; (setq hide-ifdef-define-alist ;;; '((list1 ONE TWO) ;;; (list2 TWO THREE) ;;; ))) ;;; (hide-ifdef-use-define-alist 'list2) ; use list2 by default ;;; )) ;;; ;;; You can call hide-ifdef-use-define-alist (C-c @ u) at any time to specify ;;; another list to use. ;;; ;;; To cause ifdefs to be hidden as soon as hide-ifdef-mode is called, ;;; set hide-ifdef-initially to non-nil. ;;; ;;; If you set hide-ifdef-lines to t, hide-ifdefs hides all the #ifdef lines. ;;; In the absence of highlighting, that might be a bad idea. If you set ;;; hide-ifdef-lines to nil (the default), the surrounding preprocessor ;;; lines will be displayed. That can be confusing in its own ;;; right. Other variations on display are possible, but not much ;;; better. ;;; ;;; You can explicitly hide or show individual ifdef blocks irrespective ;;; of the define list by using hide-ifdef-block and show-ifdef-block. ;;; ;;; You can move the point between ifdefs with forward-ifdef, backward-ifdef, ;;; up-ifdef, down-ifdef, next-ifdef, and previous-ifdef. ;;; ;;; If you have minor-mode-alist in your mode line (the default) two labels ;;; may appear. "Ifdef" will appear when hide-ifdef-mode is active. "Hiding" ;;; will appear when text may be hidden ("hide-ifdef-hiding" is non-nil). ;;; ;;; Written by Brian Marick, at Gould, Computer Systems Division, Urbana IL. ;;; Extensively modified by Daniel LaLiberte (while at Gould). ;;; ;;; You may freely modify and distribute this, but keep a record ;;; of modifications and send comments to: ;;; liberte@a.cs.uiuc.edu or ihnp4!uiucdcs!liberte ;;; I will continue to upgrade hide-ifdef-mode ;;; with your contributions. ;;; Code: (require 'cc-mode) (defvar hide-ifdef-mode-submap nil "Keymap used with Hide-Ifdef mode.") (defvar hide-ifdef-mode-map nil "Keymap used with Hide-Ifdef mode.") (defconst hide-ifdef-mode-prefix-key "\C-c@" "Prefix key for all Hide-Ifdef mode commands.") ;; Set up the submap that goes after the prefix key. (if hide-ifdef-mode-submap () ; dont redefine it. (setq hide-ifdef-mode-submap (make-sparse-keymap)) (define-key hide-ifdef-mode-submap "d" 'hide-ifdef-define) (define-key hide-ifdef-mode-submap "u" 'hide-ifdef-undef) (define-key hide-ifdef-mode-submap "D" 'hide-ifdef-set-define-alist) (define-key hide-ifdef-mode-submap "U" 'hide-ifdef-use-define-alist) (define-key hide-ifdef-mode-submap "h" 'hide-ifdefs) (define-key hide-ifdef-mode-submap "s" 'show-ifdefs) (define-key hide-ifdef-mode-submap "\C-d" 'hide-ifdef-block) (define-key hide-ifdef-mode-submap "\C-s" 'show-ifdef-block) (define-key hide-ifdef-mode-submap "\C-q" 'hide-ifdef-toggle-read-only) (let ((where (where-is-internal 'toggle-read-only '(keymap) t))) (if where (define-key hide-ifdef-mode-submap where 'hide-ifdef-toggle-outside-read-only))) ) ;; Set up the mode's main map, which leads via the prefix key to the submap. (if hide-ifdef-mode-map () (setq hide-ifdef-mode-map (make-sparse-keymap)) (define-key hide-ifdef-mode-map hide-ifdef-mode-prefix-key hide-ifdef-mode-submap)) (defvar hide-ifdef-mode nil "Non-nil when hide-ifdef-mode is activated.") (defvar hide-ifdef-hiding nil "Non-nil when text may be hidden.") ;; Arrange to use the mode's map when the mode is enabled. (or (assq 'hide-ifdef-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'hide-ifdef-mode hide-ifdef-mode-map) minor-mode-map-alist))) (or (assq 'hide-ifdef-hiding minor-mode-alist) (setq minor-mode-alist (cons '(hide-ifdef-hiding " Hiding") minor-mode-alist))) (or (assq 'hide-ifdef-mode minor-mode-alist) (setq minor-mode-alist (cons '(hide-ifdef-mode " Ifdef") minor-mode-alist))) ;; fix c-mode syntax table so we can recognize whole symbols. (defvar hide-ifdef-syntax-table (copy-syntax-table c-mode-syntax-table) "Syntax table used for tokenizing #if expressions.") (modify-syntax-entry ?_ "w" hide-ifdef-syntax-table) (modify-syntax-entry ?& "." hide-ifdef-syntax-table) (modify-syntax-entry ?\| "." hide-ifdef-syntax-table) ;;;###autoload (defun hide-ifdef-mode (arg) "Toggle Hide-Ifdef mode. This is a minor mode, albeit a large one. With ARG, turn Hide-Ifdef mode on iff arg is positive. In Hide-Ifdef mode, code within #ifdef constructs that the C preprocessor would eliminate may be hidden from view. Several variables affect how the hiding is done: hide-ifdef-env An association list of defined and undefined symbols for the current buffer. Initially, the global value of `hide-ifdef-env' is used. hide-ifdef-define-alist An association list of defined symbol lists. Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env' and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env' from one of the lists in `hide-ifdef-define-alist'. hide-ifdef-lines Set to non-nil to not show #if, #ifdef, #ifndef, #else, and #endif lines when hiding. hide-ifdef-initially Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode is activated. hide-ifdef-read-only Set to non-nil if you want to make buffers read only while hiding. After `show-ifdefs', read-only status is restored to previous value. \\{hide-ifdef-mode-map}" (interactive "P") (make-local-variable 'hide-ifdef-mode) (setq hide-ifdef-mode (if (null arg) (not hide-ifdef-mode) (> (prefix-numeric-value arg) 0))) (force-mode-line-update) (if hide-ifdef-mode (progn ; inherit global values (make-local-variable 'hide-ifdef-env) (setq hide-ifdef-env (default-value 'hide-ifdef-env)) (make-local-variable 'hide-ifdef-hiding) (setq hide-ifdef-hiding (default-value 'hide-ifdef-hiding)) (make-local-variable 'hif-outside-read-only) (setq hif-outside-read-only buffer-read-only) (run-hooks 'hide-ifdef-mode-hook) (if hide-ifdef-initially (hide-ifdefs) (show-ifdefs)) (message "Enter hide-ifdef-mode.") ) ; else end hide-ifdef-mode (if hide-ifdef-hiding (show-ifdefs)) (message "Exit hide-ifdef-mode.") )) ;; from outline.el with docstring fixed. (defun hif-outline-flag-region (from to flag) "Hides or shows lines from FROM to TO, according to FLAG. If FLAG is \\n (newline character) then text is shown, while if FLAG is \\^M \(control-M) the text is hidden." (let ((modp (buffer-modified-p))) (unwind-protect (progn (subst-char-in-region from to (if (= flag ?\n) ?\^M ?\n) flag t) ) (set-buffer-modified-p modp)) )) (defun hif-show-all () "Show all of the text in the current buffer." (interactive) (hif-outline-flag-region (point-min) (point-max) ?\n)) (defun hide-ifdef-region (start end) "START is the start of a #if or #else form. END is the ending part. Everything including these lines is made invisible." (hif-outline-flag-region start end ?\^M) ) (defun hif-show-ifdef-region (start end) "Everything between START and END is made visible." (hif-outline-flag-region start end ?\n) ) ;===%%SF%% evaluation (Start) === (defvar hide-ifdef-evaluator 'eval "The evaluator is given a canonical form and returns T if text under that form should be displayed.") (defvar hif-undefined-symbol nil "...is by default considered to be false.") (defvar hide-ifdef-env nil "An alist of defined symbols and their values.") (defun hif-set-var (var value) "Prepend (var value) pair to hide-ifdef-env." (setq hide-ifdef-env (cons (cons var value) hide-ifdef-env))) (defun hif-lookup (var) ; (message "hif-lookup %s" var) (let ((val (assoc var hide-ifdef-env))) (if val (cdr val) hif-undefined-symbol))) (defun hif-defined (var) (hif-lookup var) ; when #if expressions are fully supported, defined result should be 1 ; (if (assoc var hide-ifdef-env) ; 1 ; nil) ) ;===%%SF%% evaluation (End) === ;===%%SF%% parsing (Start) === ;;; The code that understands what ifs and ifdef in files look like. (defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*") (defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) (defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+")) (defconst hif-else-regexp (concat hif-cpp-prefix "else")) (defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) (defconst hif-ifx-else-endif-regexp (concat hif-ifx-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp)) (defun hif-infix-to-prefix (token-list) "Convert list of tokens in infix into prefix list" ; (message "hif-infix-to-prefix: %s" token-list) (if (= 1 (length token-list)) (` (hif-lookup (quote (, (car token-list))))) (hif-parse-if-exp token-list)) ) ; pattern to match initial identifier, !, &&, ||, (, or ). ; Added ==, + and -: garyo@avs.com 8/9/94 (defconst hif-token-regexp "^\\(!\\|&&\\|||\\|[!=]=\\|[()+-]\\|\\w+\\)") (defconst hif-end-of-comment "\\*/") (defun hif-tokenize (expr-string) "Separate string into a list of tokens" (let ((token-list nil) (expr-start 0) (expr-length (length expr-string)) (current-syntax-table (syntax-table))) (unwind-protect (progn (set-syntax-table hide-ifdef-syntax-table) (while (< expr-start expr-length) ; (message "expr-start = %d" expr-start) (sit-for 1) (cond ((string-match "^[ \t]+" expr-string expr-start) ;; skip whitespace (setq expr-start (match-end 0)) ;; stick newline in string so ^ matches on the next string-match (aset expr-string (1- expr-start) ?\n)) ((string-match "^/\\*" expr-string expr-start) (setq expr-start (match-end 0)) (aset expr-string (1- expr-start) ?\n) (or (string-match hif-end-of-comment expr-string expr-start) ; eat comment (string-match "$" expr-string expr-start)) ; multi-line comment (setq expr-start (match-end 0)) (aset expr-string (1- expr-start) ?\n)) ((string-match "^//" expr-string expr-start) (string-match "$" expr-string expr-start) (setq expr-start (match-end 0))) ((string-match hif-token-regexp expr-string expr-start) (let ((token (substring expr-string expr-start (match-end 0)))) (setq expr-start (match-end 0)) (aset expr-string (1- expr-start) ?\n) ; (message "token: %s" token) (sit-for 1) (setq token-list (cons (cond ((string-equal token "||") 'or) ((string-equal token "&&") 'and) ((string-equal token "==") 'equal) ((string-equal token "!=") 'hif-notequal) ((string-equal token "!") 'not) ((string-equal token "defined") 'hif-defined) ((string-equal token "(") 'lparen) ((string-equal token ")") 'rparen) ((string-equal token "+") 'hif-plus) ((string-equal token "-") 'hif-minus) (t (intern token))) token-list)))) (t (error "Bad #if expression: %s" expr-string))))) (set-syntax-table current-syntax-table)) (nreverse token-list))) ;;;----------------------------------------------------------------- ;;; Translate C preprocessor #if expressions using recursive descent. ;;; This parser is limited to the operators &&, ||, !, and "defined". ;;; Added ==, !=, +, and -. Gary Oberbrunner, garyo@avs.com, 8/9/94 (defun hif-parse-if-exp (token-list) "Parse the TOKEN-LIST. Return translated list in prefix form." (hif-nexttoken) (prog1 (hif-expr) (if token ; is there still a token? (error "Error: unexpected token: %s" token)))) (defun hif-nexttoken () "Pop the next token from token-list into the let variable \"token\"." (setq token (car token-list)) (setq token-list (cdr token-list)) token) (defun hif-expr () "Parse and expression of the form expr : term | expr '||' term." (let ((result (hif-term))) (while (eq token 'or) (hif-nexttoken) (setq result (list 'or result (hif-term)))) result)) (defun hif-term () "Parse a term of the form term : eq-expr | term '&&' eq-expr." (let ((result (hif-eq-expr))) (while (eq token 'and) (hif-nexttoken) (setq result (list 'and result (hif-eq-expr)))) result)) (defun hif-eq-expr () "Parse a term of the form eq-expr : math | eq-expr '=='|'!=' math." (let ((result (hif-math)) (eq-token nil)) (while (or (eq token 'equal) (eq token 'hif-notequal)) (setq eq-token token) (hif-nexttoken) (setq result (list eq-token result (hif-math)))) result)) (defun hif-math () "Parse an expression of the form math : factor | math '+|-' factor." (let ((result (hif-factor)) (math-op nil)) (while (or (eq token 'hif-plus) (eq token 'hif-minus)) (setq math-op token) (hif-nexttoken) (setq result (list math-op result (hif-factor)))) result)) (defun hif-factor () "Parse a factor of the form factor : '!' factor | '(' expr ')' | 'defined(' id ')' | id." (cond ((eq token 'not) (hif-nexttoken) (list 'not (hif-factor))) ((eq token 'lparen) (hif-nexttoken) (let ((result (hif-expr))) (if (not (eq token 'rparen)) (error "Bad token in parenthesized expression: %s" token) (hif-nexttoken) result))) ((eq token 'hif-defined) (hif-nexttoken) (if (not (eq token 'lparen)) (error "Error: expected \"(\" after \"defined\"")) (hif-nexttoken) (let ((ident token)) (if (memq token '(or and not hif-defined lparen rparen)) (error "Error: unexpected token: %s" token)) (hif-nexttoken) (if (not (eq token 'rparen)) (error "Error: expected \")\" after identifier")) (hif-nexttoken) (` (hif-defined (quote (, ident)))) )) (t ; identifier (let ((ident token)) (if (memq ident '(or and)) (error "Error: missing identifier")) (hif-nexttoken) (` (hif-lookup (quote (, ident)))) )) )) (defun hif-mathify (val) "Treat VAL as a number: if it's t or nil, use 1 or 0." (cond ((eq val t) 1) ((null val) 0) (t val))) (defun hif-plus (a b) "Like ordinary plus but treat t and nil as 1 and 0." (+ (hif-mathify a) (hif-mathify b))) (defun hif-minus (a b) "Like ordinary minus but treat t and nil as 1 and 0." (- (hif-mathify a) (hif-mathify b))) (defun hif-notequal (a b) "Like (not (equal A B)) but as one symbol." (not (equal a b))) ;;;----------- end of parser ----------------------- (defun hif-canonicalize () "When at beginning of #ifX, returns a canonical (evaluatable) form for the expression." (save-excursion (let ((negate (looking-at hif-ifndef-regexp))) (re-search-forward hif-ifx-regexp) (let* ((expr-string (buffer-substring (point) (progn (skip-chars-forward "^\n\r") (point)))) (expr (hif-infix-to-prefix (hif-tokenize expr-string)))) ; (message "hif-canonicalized: %s" expr) (if negate (list 'not expr) expr))))) (defun hif-find-any-ifX () "Position at beginning of next #if, #ifdef, or #ifndef, including one on this line." ; (message "find ifX at %d" (point)) (prog1 (re-search-forward hif-ifx-regexp (point-max) t) (beginning-of-line))) (defun hif-find-next-relevant () "Position at beginning of next #ifdef, #ifndef, #else, #endif, NOT including one on this line." ; (message "hif-find-next-relevant at %d" (point)) (end-of-line) ; avoid infinite recursion by only going to beginning of line if match found (if (re-search-forward hif-ifx-else-endif-regexp (point-max) t) (beginning-of-line))) (defun hif-find-previous-relevant () "Position at beginning of previous #ifdef, #ifndef, #else, #endif, NOT including one on this line." ; (message "hif-find-previous-relevant at %d" (point)) (beginning-of-line) ; avoid infinite recursion by only going to beginning of line if match found (if (re-search-backward hif-ifx-else-endif-regexp (point-min) t) (beginning-of-line))) (defun hif-looking-at-ifX () ;; Should eventually see #if (looking-at hif-ifx-regexp)) (defun hif-looking-at-endif () (looking-at hif-endif-regexp)) (defun hif-looking-at-else () (looking-at hif-else-regexp)) (defun hif-ifdef-to-endif () "If positioned at #ifX or #else form, skip to corresponding #endif." ; (message "hif-ifdef-to-endif at %d" (point)) (sit-for 1) (hif-find-next-relevant) (cond ((hif-looking-at-ifX) (hif-ifdef-to-endif) ; find endif of nested if (hif-ifdef-to-endif)) ; find outer endif or else ((hif-looking-at-else) (hif-ifdef-to-endif)) ; find endif following else ((hif-looking-at-endif) 'done) (t (error "Mismatched #ifdef #endif pair")))) (defun hif-endif-to-ifdef () "If positioned at #endif form, skip backward to corresponding #ifX." ; (message "hif-endif-to-ifdef at %d" (point)) (let ((start (point))) (hif-find-previous-relevant) (if (= start (point)) (error "Mismatched #ifdef #endif pair"))) (cond ((hif-looking-at-endif) (hif-endif-to-ifdef) ; find beginning of nested if (hif-endif-to-ifdef)) ; find beginning of outer if or else ((hif-looking-at-else) (hif-endif-to-ifdef)) ((hif-looking-at-ifX) 'done) (t))) ; never gets here (defun forward-ifdef (&optional arg) "Move point to beginning of line of the next ifdef-endif. With argument, do this that many times." (interactive "p") (or arg (setq arg 1)) (if (< arg 0) (backward-ifdef (- arg))) (while (< 0 arg) (setq arg (- arg)) (let ((start (point))) (if (not (hif-looking-at-ifX)) (hif-find-next-relevant)) (if (hif-looking-at-ifX) (hif-ifdef-to-endif) (goto-char start) (error "No following #ifdef") )))) (defun backward-ifdef (&optional arg) "Move point to beginning of the previous ifdef-endif. With argument, do this that many times." (interactive "p") (or arg (setq arg 1)) (if (< arg 0) (forward-ifdef (- arg))) (while (< 0 arg) (setq arg (1- arg)) (beginning-of-line) (let ((start (point))) (if (not (hif-looking-at-endif)) (hif-find-previous-relevant)) (if (hif-looking-at-endif) (hif-endif-to-ifdef) (goto-char start) (error "No previous #ifdef"))))) (defun down-ifdef () "Move point to beginning of nested ifdef or else-part." (interactive) (let ((start (point))) (hif-find-next-relevant) (if (or (hif-looking-at-ifX) (hif-looking-at-else)) () (goto-char start) (error "No following #ifdef")))) (defun up-ifdef () "Move point to beginning of enclosing ifdef or else-part." (interactive) (beginning-of-line) (let ((start (point))) (if (not (hif-looking-at-endif)) (hif-find-previous-relevant)) (if (hif-looking-at-endif) (hif-endif-to-ifdef)) (if (= start (point)) (error "No previous #ifdef")))) (defun next-ifdef (&optional arg) "Move to the beginning of the next #ifX, #else, or #endif. With argument, do this that many times." (interactive "p") (or arg (setq arg 1)) (if (< arg 0) (previous-ifdef (- arg))) (while (< 0 arg) (setq arg (1- arg)) (hif-find-next-relevant) (if (eolp) (progn (beginning-of-line) (error "No following #ifdefs, #elses, or #endifs"))))) (defun previous-ifdef (&optional arg) "Move to the beginning of the previous #ifX, #else, or #endif. With argument, do this that many times." (interactive "p") (or arg (setq arg 1)) (if (< arg 0) (next-ifdef (- arg))) (while (< 0 arg) (setq arg (1- arg)) (let ((start (point))) (hif-find-previous-relevant) (if (= start (point)) (error "No previous #ifdefs, #elses, or #endifs") )))) ;===%%SF%% parsing (End) === ;===%%SF%% hide-ifdef-hiding (Start) === ;;; A range is a structure with four components: ;;; ELSE-P True if there was an else clause for the ifdef. ;;; START The start of the range. (beginning of line) ;;; ELSE The else marker (beginning of line) ;;; Only valid if ELSE-P is true. ;;; END The end of the range. (beginning of line) (defun hif-make-range (else-p start end &optional else) (list else-p start else end)) (defun hif-range-else-p (range) (elt range 0)) (defun hif-range-start (range) (elt range 1)) (defun hif-range-else (range) (elt range 2)) (defun hif-range-end (range) (elt range 3)) ;;; Find-Range ;;; The workhorse, it delimits the #if region. Reasonably simple: ;;; Skip until an #else or #endif is found, remembering positions. If ;;; an #else was found, skip some more, looking for the true #endif. (defun hif-find-range () "Returns a Range structure describing the current #if region. Point is left unchanged." ; (message "hif-find-range at %d" (point)) (save-excursion (beginning-of-line) (let ((start (point)) (else-p nil) (else nil) (end nil)) ;; Part one. Look for either #endif or #else. ;; This loop-and-a-half dedicated to E. Dijkstra. (hif-find-next-relevant) (while (hif-looking-at-ifX) ; Skip nested ifdef (hif-ifdef-to-endif) (hif-find-next-relevant)) ;; Found either a #else or an #endif. (cond ((hif-looking-at-else) (setq else-p t) (setq else (point))) (t (setq end (point)) ; (save-excursion (end-of-line) (point)) )) ;; If found #else, look for #endif. (if else-p (progn (hif-find-next-relevant) (while (hif-looking-at-ifX) ; Skip nested ifdef (hif-ifdef-to-endif) (hif-find-next-relevant)) (if (hif-looking-at-else) (error "Found two elses in a row? Broken!")) (setq end (point)) ; (save-excursion (end-of-line) (point)) )) (hif-make-range else-p start end else)))) ;;; A bit slimy. ;;; NOTE: If there's an #ifdef at the beginning of the file, we can't ;;; hide it. There's no previous newline to replace. If we added ;;; one, we'd throw off all the counts. Feh. (defun hif-hide-line (point) "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil." (if hide-ifdef-lines (save-excursion (goto-char point) (let ((modp (buffer-modified-p))) (unwind-protect (progn (beginning-of-line) (if (not (= (point) 1)) (hide-ifdef-region (1- (point)) (point)))) (set-buffer-modified-p modp)) )) )) ;;; Hif-Possibly-Hide ;;; There are four cases. The #ifX expression is "taken" if it ;;; the hide-ifdef-evaluator returns T. Presumably, this means the code ;;; inside the #ifdef would be included when the program was ;;; compiled. ;;; ;;; Case 1: #ifX taken, and there's an #else. ;;; The #else part must be hidden. The #if (then) part must be ;;; processed for nested #ifX's. ;;; Case 2: #ifX taken, and there's no #else. ;;; The #if part must be processed for nested #ifX's. ;;; Case 3: #ifX not taken, and there's an #else. ;;; The #if part must be hidden. The #else part must be processed ;;; for nested #ifs. ;;; Case 4: #ifX not taken, and there's no #else. ;;; The #ifX part must be hidden. ;;; ;;; Further processing is done by narrowing to the relevant region ;;; and just recursively calling hide-ifdef-guts. ;;; ;;; When hif-possibly-hide returns, point is at the end of the ;;; possibly-hidden range. (defun hif-recurse-on (start end) "Call `hide-ifdef-guts' after narrowing to end of START line and END line." (save-excursion (save-restriction (goto-char start) (end-of-line) (narrow-to-region (point) end) (hide-ifdef-guts)))) (defun hif-possibly-hide () "Called at #ifX expression, this hides those parts that should be hidden, according to judgement of `hide-ifdef-evaluator'." ; (message "hif-possibly-hide") (sit-for 1) (let ((test (hif-canonicalize)) (range (hif-find-range))) ; (message "test = %s" test) (sit-for 1) (hif-hide-line (hif-range-end range)) (if (funcall hide-ifdef-evaluator test) (cond ((hif-range-else-p range) ; case 1 (hif-hide-line (hif-range-else range)) (hide-ifdef-region (hif-range-else range) (1- (hif-range-end range))) (hif-recurse-on (hif-range-start range) (hif-range-else range))) (t ; case 2 (hif-recurse-on (hif-range-start range) (hif-range-end range)))) (cond ((hif-range-else-p range) ; case 3 (hif-hide-line (hif-range-else range)) (hide-ifdef-region (hif-range-start range) (1- (hif-range-else range))) (hif-recurse-on (hif-range-else range) (hif-range-end range))) (t ; case 4 (hide-ifdef-region (point) (1- (hif-range-end range)))) )) (hif-hide-line (hif-range-start range)) ; Always hide start. (goto-char (hif-range-end range)) (end-of-line) )) (defun hide-ifdef-guts () "Does the work of `hide-ifdefs', except for the work that's pointless to redo on a recursive entry." ; (message "hide-ifdef-guts") (save-excursion (goto-char (point-min)) (while (hif-find-any-ifX) (hif-possibly-hide)))) ;===%%SF%% hide-ifdef-hiding (End) === ;===%%SF%% exports (Start) === ;;;###autoload (defvar hide-ifdef-initially nil "*Non-nil if `hide-ifdefs' should be called when Hide-Ifdef mode is first activated.") ;;;###autoload (defvar hide-ifdef-read-only nil "*Set to non-nil if you want buffer to be read-only while hiding text.") (defvar hif-outside-read-only nil "Internal variable. Saves the value of `buffer-read-only' while hiding.") ;;;###autoload (defvar hide-ifdef-lines nil "*Set to t if you don't want to see the #ifX, #else, and #endif lines.") (defun hide-ifdef-toggle-read-only () "Toggle hide-ifdef-read-only." (interactive) (setq hide-ifdef-read-only (not hide-ifdef-read-only)) (message "Hide-Read-Only %s" (if hide-ifdef-read-only "ON" "OFF")) (if hide-ifdef-hiding (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))) (force-mode-line-update)) (defun hide-ifdef-toggle-outside-read-only () "Replacement for `toggle-read-only' within Hide Ifdef mode." (interactive) (setq hif-outside-read-only (not hif-outside-read-only)) (message "Read only %s" (if hif-outside-read-only "ON" "OFF")) (setq buffer-read-only (or (and hide-ifdef-hiding hide-ifdef-read-only) hif-outside-read-only) ) (force-mode-line-update)) (defun hide-ifdef-define (var) "Define a VAR so that #ifdef VAR would be included." (interactive "SDefine what? ") (hif-set-var var 1) (if hide-ifdef-hiding (hide-ifdefs))) (defun hide-ifdef-undef (var) "Undefine a VAR so that #ifdef VAR would not be included." (interactive "SUndefine what? ") (hif-set-var var nil) (if hide-ifdef-hiding (hide-ifdefs))) (defun hide-ifdefs () "Hide the contents of some #ifdefs. Assume that defined symbols have been added to `hide-ifdef-env'. The text hidden is the text that would not be included by the C preprocessor if it were given the file with those symbols defined. Turn off hiding by calling `show-ifdefs'." (interactive) (message "Hiding...") (if (not hide-ifdef-mode) (hide-ifdef-mode 1)) ; turn on hide-ifdef-mode (if hide-ifdef-hiding (show-ifdefs)) ; Otherwise, deep confusion. (let ((inhibit-read-only t)) (setq selective-display t) (setq hide-ifdef-hiding t) (hide-ifdef-guts)) (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)) (message "Hiding done")) (defun show-ifdefs () "Cancel the effects of `hide-ifdef'. The contents of all #ifdefs is shown." (interactive) (setq buffer-read-only hif-outside-read-only) (setq selective-display nil) ; defaults (let ((inhibit-read-only t)) (hif-show-all)) (setq hide-ifdef-hiding nil)) (defun hif-find-ifdef-block () "Utility for hide and show `ifdef-block'. Set top and bottom of ifdef block." (let (max-bottom) (save-excursion (beginning-of-line) (if (not (or (hif-looking-at-else) (hif-looking-at-ifX))) (up-ifdef)) (setq top (point)) (hif-ifdef-to-endif) (setq max-bottom (1- (point)))) (save-excursion (beginning-of-line) (if (not (hif-looking-at-endif)) (hif-find-next-relevant)) (while (hif-looking-at-ifX) (hif-ifdef-to-endif) (hif-find-next-relevant)) (setq bottom (min max-bottom (1- (point)))))) ) (defun hide-ifdef-block () "Hide the ifdef block (true or false part) enclosing or before the cursor." (interactive) (if (not hide-ifdef-mode) (hide-ifdef-mode 1)) (setq selective-display t) (let (top bottom (inhibit-read-only t)) (hif-find-ifdef-block) ; set top and bottom - dynamic scoping (hide-ifdef-region top bottom) (if hide-ifdef-lines (progn (hif-hide-line top) (hif-hide-line (1+ bottom)))) (setq hide-ifdef-hiding t)) (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))) (defun show-ifdef-block () "Show the ifdef block (true or false part) enclosing or before the cursor." (interactive) (let ((inhibit-read-only t)) (if hide-ifdef-lines (save-excursion (beginning-of-line) (hif-show-ifdef-region (1- (point)) (progn (end-of-line) (point)))) (let (top bottom) (hif-find-ifdef-block) (hif-show-ifdef-region (1- top) bottom))))) ;;; definition alist support (defvar hide-ifdef-define-alist nil "A global assoc list of pre-defined symbol lists") (defun hif-compress-define-list (env) "Compress the define list ENV into a list of defined symbols only." (let ((defs (mapcar '(lambda (arg) (if (hif-lookup (car arg)) (car arg))) env)) (new-defs nil)) (while defs (if (car defs) (setq new-defs (cons (car defs) new-defs))) (setq defs (cdr defs))) new-defs)) (defun hide-ifdef-set-define-alist (name) "Set the association for NAME to `hide-ifdef-env'." (interactive "SSet define list: ") (setq hide-ifdef-define-alist (cons (cons name (hif-compress-define-list hide-ifdef-env)) hide-ifdef-define-alist))) (defun hide-ifdef-use-define-alist (name) "Set `hide-ifdef-env' to the define list specified by NAME." (interactive "SUse define list: ") (let ((define-list (assoc name hide-ifdef-define-alist))) (if define-list (setq hide-ifdef-env (mapcar '(lambda (arg) (cons arg t)) (cdr define-list))) (error "No define list for %s" name)) (if hide-ifdef-hiding (hide-ifdefs)))) (provide 'hideif) ;;; hideif.el ends here emacs-19.30/lisp/hideshow.el100444 75424 1 43330 5762721643 14444 0ustar kwzhdaemon;;; hideshow.el --- minor mode cmds to selectively display blocks of code ;;; Copyright (C) 1994,1995 Free Software Foundation ;;; Author: Thien-Thi Nguyen ;;; Version: 3.4 ;;; Keywords: C C++ lisp tools editing ;;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning ;;; 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 of the License, 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 this program; if not, write to the Free Software Foundation, Inc., ;;; 675 Mass Ave, Cambridge, MA 02139, USA. ;;; LCD Archive Entry: ;;; hideshow|Thien-Thi Nguyen|ttn@netcom.com| ;;; minor mode commands to selectively display blocks of code| ;;; 18-Oct-1994|3.4|~/modes/hideshow.el.Z| ;;; Commentary: ;;; This file provides `hs-minor-mode'. When active, six commands: ;;; hs-{hide,show}-{all,block}, hs-show-region and hs-minor-mode ;;; are available. They implement block hiding and showing. Blocks are ;;; defined in mode-specific way. In c-mode or c++-mode, they are simply ;;; curly braces, while in lisp-ish modes they are parens. Multi-line ;;; comments (c-mode) can also be hidden. The command M-x hs-minor-mode ;;; toggles the minor mode or sets it (similar to outline minor mode). ;;; See documentation for each command for more info. ;;; ;;; The variable `hs-unbalance-handler-method' controls hideshow's behavior ;;; in the case of "unbalanced parentheses". See doc for more info. ;;; Suggested usage: ;;; (load-library "hideshow") ;;; (defun my-hs-setup () "enables hideshow and binds some commands" ;;; (hs-minor-mode 1) ;;; (define-key hs-minor-mode-map "\C-ch" 'hs-hide-block) ;;; (define-key hs-minor-mode-map "\C-cs" 'hs-show-block) ;;; (define-key hs-minro-mode-map "\C-cH" 'hs-hide-all) ;;; (define-key hs-minro-mode-map "\C-cS" 'hs-show-all) ;;; (define-key hs-minor-mode-map "\C-cR" 'hs-show-region)) ;;; (add-hook 'X-mode-hook 'my-hs-setup t) ; other modes similarly ;;; ;;; where X = {emacs-lisp,c,c++,perl,...}. See the doc for the variable ;;; `hs-special-modes-alist' if you'd like to use hideshow w/ other modes. ;;; Etc: ;;; Bug reports and fixes welcome (comments, too). Thanks go to ;;; Dean Andrews ;;; Preston F. Crow ;;; Gael Marziou ;;; Keith Sheffield ;;; Jan Djarv ;;; Lars Lindberg ;;; Alf-Ivar Holm ;;; for valuable feedback, code and bug reports. ;;; Code: ;;;---------------------------------------------------------------------------- ;;; user-configurable variables (defvar hs-unbalance-handler-method 'top-level "*Symbol representing how \"unbalanced parentheses\" should be handled. This error is usually signalled by hs-show-block. One of four values: `top-level', `next-line', `signal' or `ignore'. Default is `top-level'. - `top-level' -- Show top-level block containing the currently troublesome block. - `next-line' -- Use the fact that, for an already hidden block, its end will be on the next line. Attempt to show this block. - `signal' -- Pass the error through, stopping execution. - `ignore' -- Ignore the error, continuing execution. Values other than these four will be interpreted as `signal'.") (defvar hs-special-modes-alist '((c-mode "{" "}") (c++-mode "{" "}")) "*Alist of the form (MODE START-RE END-RE FORWARD-SEXP-FUNC). If present, hideshow will use these values for the start and end regexps, respectively. Since Algol-ish languages do not have single-character block delimiters, the function `forward-sexp' which is used by hideshow doesn't work. In this case, if a similar function is provided, you can register it and have hideshow use it instead of `forward-sexp'. To add more values, use \t(pushnew '(new-mode st-re end-re function-name) \t hs-special-modes-alist :test 'equal) For example: \t(pushnew '(simula-mode \"begin\" \"end\" simula-next-statement) \t hs-special-modes-alist :test 'equal) Note that the regexps should not contain leading or trailing whitespace.") (defvar hs-hide-hooks nil "*Hooks called at the end of hs-hide-all and hs-hide-block.") (defvar hs-show-hooks nil "*Hooks called at the end of hs-show-all, hs-show-block and hs-show-region.") (defvar hs-minor-mode-prefix "\C-c" "*Prefix key to use for hideshow commands in hideshow minor mode.") ;;;---------------------------------------------------------------------------- ;;; internal variables (defvar hs-minor-mode nil "Non-nil if using hideshow mode as a minor mode of some other mode. Use the command `hs-minor-mode' to toggle this variable.") (defvar hs-minor-mode-map nil "Mode map for hideshow minor mode.") (defvar hs-menu-bar nil "Menu bar for hideshow minor mode (Xemacs only).") (defvar hs-c-start-regexp nil "Regexp for beginning of comments. Buffer-local. Differs from mode-specific comment regexps in that surrounding whitespace is stripped.") (defvar hs-c-end-regexp nil "Regexp for end of comments. Buffer-local. See `hs-c-start-regexp'.") (defvar hs-block-start-regexp nil "Regexp for beginning of block. Buffer-local.") (defvar hs-block-end-regexp nil "Regexp for end of block. Buffer-local.") (defvar hs-forward-sexp-func 'forward-sexp "Function used to do a forward-sexp. Should change for Algol-ish modes. For single-character block delimiters -- ie, the syntax table regexp for the character is either `(' or `)' -- `hs-forward-sexp-func' would just be `forward-sexp'. For other modes such as simula, a more specialized function is necessary.") (defvar hs-emacs-type 'fsf "Used to support both FSF Emacs and Xemacs.") (eval-when-compile (if (string-match "xemacs\\|lucid" emacs-version) (progn (defvar current-menubar nil "") (defun set-buffer-menubar (arg1)) (defun add-menu (arg1 arg2 arg3))))) ;;;---------------------------------------------------------------------------- ;;; support funcs ;; snarfed from outline.el, but added buffer-read-only (defun hs-flag-region (from to flag) "Hides or shows lines from FROM to TO, according to FLAG. If FLAG is \\n (newline character) then text is shown, while if FLAG is \\^M \(control-M) the text is hidden." (let ((modp (buffer-modified-p)) buffer-read-only) ; nothing is immune (unwind-protect (progn (subst-char-in-region from to (if (= flag ?\n) ?\C-m ?\n) flag t)) (set-buffer-modified-p modp)))) (defun hs-hide-block-at-point (&optional end) "Hide block iff on block beginning, optional END means reposition at end." (if (looking-at hs-block-start-regexp) (let* ((p (point)) (q (progn (funcall hs-forward-sexp-func 1) (point)))) (forward-line -1) (end-of-line) (if (and (< p (point)) (> (count-lines p q) 1)) (hs-flag-region p (point) ?\C-m)) (goto-char (if end q p))))) (defun hs-show-block-at-point (&optional end) "Show block iff on block beginning. Optional END means reposition at end." (if (looking-at hs-block-start-regexp) (let* ((p (point)) (q (condition-case error ; probably unbalanced paren (progn (funcall hs-forward-sexp-func 1) (point)) (error (cond ((eq hs-unbalance-handler-method 'ignore) ;; just ignore this block (point)) ((eq hs-unbalance-handler-method 'top-level) ;; try to get out of rat's nest and expose the whole func (if (/= (current-column) 0) (beginning-of-defun)) (setq p (point)) (re-search-forward (concat "^" hs-block-start-regexp) (point-max) t 2) (point)) ((eq hs-unbalance-handler-method 'next-line) ;; assumption is that user knows what s/he's doing (beginning-of-line) (setq p (point)) (end-of-line 2) (point)) (t ;; pass error through -- this applies to `signal', too (signal (car error) (cdr error)))))))) (hs-flag-region p q ?\n) (goto-char (if end (1+ (point)) p))))) (defun hs-safety-is-job-n () "Warns if selective-display or selective-display-ellipses is nil." (let ((str "")) (or selective-display (setq str "selective-display nil ")) (or selective-display-ellipses (setq str (concat str "selective-display-ellipses nil"))) (if (= (length str) 0) nil (message "warning: %s" str) (sit-for 2)))) (defun hs-inside-comment-p () "Returns non-nil if point is inside a comment, otherwise nil. Actually, for multi-line-able comments, returns a list containing the buffer position of the start and the end of the comment." ;; is it single-line-only or multi-line-able? (save-excursion (let ((p (point)) q) (if (string= comment-end "") ; single line (let (found) (beginning-of-line) (setq found (re-search-forward hs-c-start-regexp p t)) (and found (not (search-forward "\"" p t)))) (re-search-forward hs-c-end-regexp (point-max) 1) (setq q (point)) (forward-comment -1) (re-search-forward hs-c-start-regexp (point-max) 1) (if (< (- (point) (length comment-start)) p) (list (match-beginning 0) q)))))) (defun hs-grok-mode-type () "Setup variables for new buffers where applicable." (if (and (boundp 'comment-start) (boundp 'comment-end)) (progn (setq hs-c-start-regexp (regexp-quote comment-start)) (if (string-match " +$" hs-c-start-regexp) (setq hs-c-start-regexp (substring hs-c-start-regexp 0 (1- (match-end 0))))) (setq hs-c-end-regexp (if (string= "" comment-end) "\n" (regexp-quote comment-end))) (if (string-match "^ +" hs-c-end-regexp) (setq hs-c-end-regexp (substring hs-c-end-regexp (match-end 0)))) (let ((lookup (assoc major-mode hs-special-modes-alist))) (setq hs-block-start-regexp (or (nth 1 lookup) "\\s\(") hs-block-end-regexp (or (nth 2 lookup) "\\s\)") hs-forward-sexp-func (or (nth 3 lookup) 'forward-sexp)))))) (defun hs-find-block-beginning () "Repositions point at block-start. Return point, or nil if top-level." (let (done (here (point)) (both-regexps (concat "\\(" hs-block-start-regexp "\\)\\|\\(" hs-block-end-regexp "\\)"))) (while (and (not done) (re-search-backward both-regexps (point-min) t)) (if (match-beginning 1) ; start of start-regexp (setq done (match-beginning 1)) (goto-char (match-end 2)) ; end of end-regexp (funcall hs-forward-sexp-func -1))) (goto-char (or done here)) done)) (defmacro hs-life-goes-on (&rest body) "Executes optional BODY iff variable `hs-minor-mode' is non-nil." (list 'if 'hs-minor-mode (cons 'progn body))) ;;;---------------------------------------------------------------------------- ;;; commands ;;;###autoload (defun hs-hide-all () "Hides all top-level blocks, displaying only first and last lines. When done, point is repositioned at the beginning of the line, and hs-hide-hooks is called. See documentation for `run-hooks'." (interactive) (hs-life-goes-on (message "hiding all blocks ...") (save-excursion (hs-flag-region (point-min) (point-max) ?\n) ; eliminate weirdness (goto-char (point-min)) (let ((count 0) (top-level-re (concat "^" hs-block-start-regexp))) (while (progn (forward-comment (buffer-size)) (re-search-forward top-level-re (point-max) t)) (goto-char (match-beginning 0)) (hs-hide-block-at-point t) (message "hiding ... %d" (setq count (1+ count))))) (hs-safety-is-job-n)) (beginning-of-line) (message "hiding all blocks ... done") (run-hooks 'hs-hide-hooks))) (defun hs-show-all () "Shows all top-level blocks. When done, point is unchanged, and hs-show-hooks is called. See documentation for `run-hooks'." (interactive) (hs-life-goes-on (message "showing all blocks ...") (hs-flag-region (point-min) (point-max) ?\n) (message "showing all blocks ... done") (run-hooks 'hs-show-hooks))) ;;;###autoload (defun hs-hide-block (&optional end) "Selects a block and hides it. With prefix arg, reposition at end. Block is defined as a sexp for lispish modes, mode-specific otherwise. Comments are blocks, too. Upon completion, point is at repositioned and hs-hide-hooks is called. See documentation for `run-hooks'." (interactive "P") (hs-life-goes-on (let ((c-reg (hs-inside-comment-p))) (if c-reg (cond ((string= comment-end "") (message "can't hide a single-line comment")) ((< (count-lines (car c-reg) (nth 1 c-reg)) 2) (message "not enougn comment lines to hide")) (t (goto-char (nth 1 c-reg)) (forward-line -1) (hs-flag-region (car c-reg) (point) ?\C-m) (goto-char (if end (nth 1 c-reg) (car c-reg))) (hs-safety-is-job-n) (run-hooks 'hs-hide-hooks))) (if (or (looking-at hs-block-start-regexp) (hs-find-block-beginning)) (progn (hs-hide-block-at-point end) (hs-safety-is-job-n) (run-hooks 'hs-hide-hooks))))))) (defun hs-show-block (&optional end) "Selects a block and shows it. With prefix arg, reposition at end. Upon completion, point is repositioned hs-show-hooks are called. See documetation for `hs-hide-block' and `run-hooks'." (interactive "P") (hs-life-goes-on (let ((c-reg (hs-inside-comment-p))) (if c-reg (cond ((string= comment-end "") (message "already looking at the entire comment")) (t (hs-flag-region (car c-reg) (nth 1 c-reg) ?\n) (goto-char (if end (nth 1 c-reg) (car c-reg))))) (if (or (looking-at hs-block-start-regexp) (hs-find-block-beginning)) (progn (hs-show-block-at-point end) (hs-safety-is-job-n) (run-hooks 'hs-show-hooks))))))) (defun hs-show-region (beg end) "Shows all lines from BEG to END, without doing any block analysis. Note: hs-show-region is intended for use when when hs-show-block signals `unbalanced parentheses' and so is an emergency measure only. You may become very confused if you use this command indiscriminately." (interactive "r") (hs-life-goes-on (hs-flag-region beg end ?\n) (hs-safety-is-job-n) (run-hooks 'hs-show-hooks))) ;;;###autoload (defun hs-minor-mode (&optional arg) "Toggle hideshow minor mode. With ARG, turn hideshow minor mode on if ARG is positive, off otherwise. When hideshow minor mode is on, the menu bar is augmented with hideshow commands and the hideshow commands are enabled. The variables\n \tselective-display\n\tselective-display-ellipses\n are set to t. Lastly, the hooks set in hs-minor-mode-hook are called. See documentation for `run-hooks'.\n Turning hideshow minor mode off reverts the menu bar and the variables to default values and disables the hideshow commands." (interactive "P") (setq hs-minor-mode (if (null arg) (not hs-minor-mode) (> (prefix-numeric-value arg) 0))) (if hs-minor-mode (progn (if (eq hs-emacs-type 'lucid) (progn (set-buffer-menubar (copy-sequence current-menubar)) (add-menu nil (car hs-menu-bar) (cdr hs-menu-bar)))) (setq selective-display t selective-display-ellipses t) (hs-grok-mode-type) (run-hooks 'hs-minor-mode-hook)) (if (eq hs-emacs-type 'lucid) (set-buffer-menubar (delete hs-menu-bar current-menubar))) (kill-local-variable 'selective-display) (kill-local-variable 'selective-display-ellipses))) ;;;---------------------------------------------------------------------------- ;;; load-time setup routines ;; which emacs being used? (setq hs-emacs-type (if (string-match "xemacs\\|lucid" emacs-version) 'lucid 'fsf)) ;; keymaps and menus (if (not hs-minor-mode-map) (setq hs-minor-mode-map (make-sparse-keymap)) (cond ((eq hs-emacs-type 'lucid) (setq hs-menu-bar ; build top down for lucid '("hideshow" ["Hide Block" hs-hide-block t] ["Show Block" hs-show-block t] ["Hide All" hs-hide-all t] ["Show All" hs-show-all t] ["Show Region" hs-show-region t]))) (t ; build bottom up for others (define-key hs-minor-mode-map [menu-bar hideshow] (cons "hideshow" (make-sparse-keymap "hideshow"))) (define-key hs-minor-mode-map [menu-bar hideshow hs-show-region] '("Show Region" . hs-show-region)) (define-key hs-minor-mode-map [menu-bar hideshow hs-show-all] '("Show All" . hs-show-all)) (define-key hs-minor-mode-map [menu-bar hideshow hs-hide-all] '("Hide All" . hs-hide-all)) (define-key hs-minor-mode-map [menu-bar hideshow hs-show-block] '("Show Block" . hs-show-block)) (define-key hs-minor-mode-map [menu-bar hideshow hs-hide-block] '("Hide Block" . hs-hide-block))))) ;; some housekeeping (or (assq 'hs-minor-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'hs-minor-mode hs-minor-mode-map) minor-mode-map-alist))) (or (assq 'hs-minor-mode minor-mode-alist) (setq minor-mode-alist (append minor-mode-alist (list '(hs-minor-mode " hs"))))) ;; make some variables buffer-local (make-variable-buffer-local 'hs-minor-mode) (make-variable-buffer-local 'hs-c-start-regexp) (make-variable-buffer-local 'hs-c-end-regexp) (make-variable-buffer-local 'hs-block-start-regexp) (make-variable-buffer-local 'hs-block-end-regexp) (make-variable-buffer-local 'hs-forward-sexp-func) (put 'hs-minor-mode 'permanent-local t) (put 'hs-c-start-regexp 'permanent-local t) (put 'hs-c-end-regexp 'permanent-local t) (put 'hs-block-start-regexp 'permanent-local t) (put 'hs-block-end-regexp 'permanent-local t) (put 'hs-forward-sexp-func 'permanent-local t) ;;;---------------------------------------------------------------------------- ;;; that's it (provide 'hideshow) ;;; hideshow.el ends here emacs-19.30/lisp/hilit19.el100444 22556 1 171605 6046547510 14104 0ustar erikdaemon;;; hilit19.el --- customizable highlighting for Emacs19 ;; Copyright (c) 1993, 1994 Free Software Foundation, Inc. ;; Author: Jonathan Stigelman ;; Keywords: 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: ;; Hilit19.el is a customizable highlighting package for Emacs19. It supports ;; not only source code highlighting, but also Info, RMAIL, VM, gnus... ;; Hilit19 knows (or thinks it knows) how to highlight emacs buffers in ;; about 25 different modes. ;; ;; WHERE TO GET THE LATEST VERSIONS OF HILIT19.EL (beta and release), ;; PLUS LOTS OF OTHER *WAY COOL* STUFF VIA ANONYMOUS FTP: ;; ;; ftp.hackvan.com:/pub/stig/src/elisp/hilit19.el.gz ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; TO SUBMIT BUG REPORTS (or feedback of any sort)... ;; ;; M-x hilit-submit-feedback RET ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; hilit19.el,v 2.19 1993/09/08 18:44:10 stig Release ;; ;; LCD Archive Entry: ;; hilit19|Jonathan Stigelman|stig@hackvan.com| ;; Comprehensive (and comparatively fast) regex-based highlighting for Emacs 19| ;; 1993/09/08 18:44:10|Release 2.19|~/packages/hilit19.el.Z| ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; GENERAL OVERVIEW ;; ;; This package installs numerous hooks to colorfully highlight your ;; source code buffers as well as mail and news buffers. Most ;; programming languages have predefined highlighting patterns. ;; Just load hilit19 and files will be automatically highlighted as ;; they're loaded. ;; ;; Rehighlight a buffer by typing C-S-l (control-shift-lowercase-L). ;; ;; If, when you edit the buffer, the coloring gets messed up, just ;; redraw and the coloring will be adjusted. If automatic highlighting ;; in the current buffer has been turned off, then typing C-u C-S-l will ;; force a rehighlight of the entire buffer. ;; ;; Hilit19 can build faces by examining the names that you give to them ;; For example, green/black-bold-italic-underline would be created as ;; a face with a green foreground, and a black background, using a ;; bold-italic font...with underlining for good measure. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; SETUP -- In your .emacs: ;; ;; ;; (cond (window-system ;; (setq hilit-mode-enable-list '(not text-mode) ;; hilit-background-mode 'light ;; hilit-inhibit-hooks nil ;; hilit-inhibit-rebinding nil) ;; ;; (require 'hilit19) ;; )) ;; ;; If you like font-lock-mode and want to use both packages, then you can ;; disable hilit for the modes in which you want to use font-lock by listing ;; said modes in hilit-mode-enable-list. ;; ;; (hilit-translate type 'RoyalBlue ; enable highlighting in C/C++ ;; string nil) ; disable string highlighting ;; ;; To get 100% of the utility of hilit19, you may also have to apply the ;; patches below for info.el and vm5.33L_19/vm-summary.el ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; SETUP -- Are you using the right font for Emacs? ;; ;; Emacs cannot properly find bold and italic fonts unless you specify a ;; verbose X11 font name. If you specify a font for emacs in your ;; .Xdefaults, it *MUST* be specified using the long form of the font name. ;; Here's a good font menu: ;; ;; (setq ;; x-fixed-font-alist ;; '("Font Menu" ;; ("Misc" ;; ("6x12" "-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-*-1") ;; ("6x13" "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-*-1") ;; ("lucida 13" ;; "-b&h-lucidatypewriter-medium-r-normal-sans-0-0-0-0-m-0-*-1") ;; ("7x13" "-misc-fixed-medium-r-normal--13-120-75-75-c-70-*-1") ;; ("7x14" "-misc-fixed-medium-r-normal--14-130-75-75-c-70-*-1") ;; ("9x15" "-misc-fixed-medium-r-normal--15-140-*-*-c-*-*-1") ;; ("") ;; ("clean 8x8" "-schumacher-clean-medium-r-normal--*-80-*-*-c-*-*-1") ;; ("clean 8x14" "-schumacher-clean-medium-r-normal--*-140-*-*-c-*-*-1") ;; ("clean 8x10" "-schumacher-clean-medium-r-normal--*-100-*-*-c-*-*-1") ;; ("clean 8x16" "-schumacher-clean-medium-r-normal--*-160-*-*-c-*-*-1") ;; ("") ;; ("sony 8x16" "-sony-fixed-medium-r-normal--16-120-100-100-c-80-*-1") ;; ("") ;; ("-- Courier --") ;; ("Courier 10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-*-1") ;; ("Courier 12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-*-1") ;; ("Courier 14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-*-1") ;; ("Courier 18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-*-1") ;; ("Courier 18-b" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-*-1") ;; ))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; KNOWN BUGS/TO DO LIST/HELP WANTED/APPLY WITHIN ;; ;; * unbalanced, unescaped double quote characters can confuse hilit19. ;; This will be fixed someday, so don't bug me about it. ;; ;; * ALTHOUGH HILIT19 IS FASTER THAN FONT-LOCK-MODE... ;; For various reasons, the speed of the package could still stand to be ;; improved. If you care to do a little profiling and make things tighter... ;; ;; * hilit-toggle-highlight is flaky when auto-rehighlight is neither t nor nil. ;; Does anyone actually USE this? I think I might just remove it. ;; ;; PROJECTS THAT YOU CAN TAKE OVER BECAUSE I DON'T MUCH CARE ABOUT THEM... ;; ;; * Moved hilit-wysiwyg-replace here from my version of man.el, this is not ;; a bug. The bug is that I don't have a reverse operation yet...just a ;; stub Wysiwyg-anything really belongs in a package of it's own. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Thanks to the following people for their input: ;; ebert@enpc.enpc.fr (Rolf EBERT), ada, LaTeX & bibtex highlights ;; Vivek Khera , gnus hooks + random advice & patches ;; brian@athe.WUstl.EDU (Brian Dunford-Shore), prolog highlights ;; John Ladwig , 1st pass nroff highlights ;; campo@sunthpi3.difi.unipi.it (Massimo Campostrini), fortran highlights ;; jayb@laplace.MATH.ColoState.EDU (Jay Bourland), 1st pass dired ;; Yoshio Turner , modula 2 highlights ;; Fritz Knabe , advice & patches ;; Alon Albert , advice & patches ;; dana@thumper.bellcore.com (Dana A. Chee), working on the multi-frame bug ;; derway@ndc.com (Don Erway), for breaking it... ;; moss_r@summer.chem.su.oz.au (Richard Moss), first pass at add-pattern ;; Olivier Lecarme , Pascal & Icon patterns ;; ;; With suggestions and minor regex patches from numerous others... ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; hilit19.el,v ;; Revision 2.19 1993/09/08 18:44:10 stig ;; installed patch for elusive bug in hilit-rehighlight-region that caused ;; hilit-unhighlight-region to hang in an infinite loop. ;; ;; Revision 2.18 1993/08/27 03:51:00 stig ;; minor mods to lisp-mode and c/c++ mode patterns ;; ;; Revision 2.17 1993/08/25 02:19:17 stig ;; work-around for bug in next-overlay-change that caused dired and jargon-mode ;; to hang in an endless loop. Perhaps other modes were doing this too. ;; ;; Revision 2.16 1993/08/22 19:46:00 stig ;; bug fix for next-overlay-change and accompanying change to ;; hilit-unhighlight-region ;; ;; Revision 2.15 1993/08/20 12:16:22 stig ;; minor change to fortran patterns ;; ;; Revision 2.14 1993/08/17 14:12:10 stig ;; added default face mapping for 'formula' which is needed for new latex ;; patterns. ;; ;; twiddled the calendar-mode patterns a bit. ;; ;; Revision 2.13 1993/08/16 04:33:54 stig ;; hilit-set-mode-patterns was screwing up two part patterns. it doesn't now. ;; ;; Revision 2.12 1993/08/16 00:16:41 stig ;; changed references to default-bold-italic to just bold-italic because the ;; font for that face is maintained by emacs. ;; ;; the pattern matcher now starts it's searches from the end of the most ;; recently highlighted region (which is not necessarily the end of the most ;; recently matched regex). ;; ;; multiple errors in pattern matcher now just give an error instead of lots of ;; annoying messages and dings. ;; ;; no longer use vm-summary-mode-hooks. ;; ;; some code moved from hilit-highlight-region to hilit-set-mode-patterns. ;; This will affect you if you pass your patterns directly to ;; hilit-highlight-region....use a pseudo-mode instead. ;; ;; pattern changes to C/C++, latex, texinfo, fortran, nroff, etc. ;; ;; Revision 2.11 1993/08/13 12:12:37 stig ;; removed some crufty commented-out code ;; ;; diverged lisp-mode and emacs-lisp-mode...also added lisp keywords. ;; ;; Revision 2.10 1993/08/13 09:47:06 stig ;; added calendar-mode, icon-mode and pascal-mode patterns ;; ;; commented out hilit-toggle-highlight because I want to phase it out entirely ;; ;; Revision 2.9 1993/08/13 08:44:22 stig ;; added optional case-fold argument to hilit-set-mode-patterns, this case-fold ;; parameter is now stored in hilit-patterns-alist. ;; ;; Revision 2.8 1993/08/12 22:05:03 stig ;; fixed some typos in documentation ;; ;; twiddled some of the color defaults for dark backgrounds ;; ;; always get 'mono color defaults if (not (x-display-color-p)) ;; ;; added hilit-rehighlight-buffer-quietly to dired-after-readin-hook ;; ;; fixed bug in hilit-string-find that mishandled strings of the form: "\\" ;; ;; NEW FUNCTION: hilit-add-mode-pattern... kinda like add-hook for patterns ;; ;; fixed minor pattern bugs for latex-mode and emacs-lisp-mode ;; ;; Revision 2.7 1993/07/30 02:43:01 stig ;; added const to the list of modifiers for C/C++ types ;; ;; Revision 2.6 1993/07/30 00:30:54 stig ;; now permit selection of arbitrary subexpressions for highlighting... ;; fixed keyword patterns for C/C++ using this technique. ;; ;; Revision 2.5 1993/07/28 05:02:56 stig ;; improvements to makefile regular expressions ;; removed about 130 lines just by compacting the big defconst for ;; hilit-face-translation-table into a mapcar and defining a separate table ;; of default faces. ;; ;; Revision 2.4 1993/07/27 14:09:05 stig ;; documented another "known problem" to "head off gripe mail at the pass." ;; ;; Revision 2.3 1993/07/27 02:15:49 stig ;; (hilit-lookup-face-create) incorporated patch which improves it's behavior ;; with more than one frame... Still can't have bold on the same face in two ;; differrent fonts sizes at the same time... ;; ;; Revision 2.2 1993/07/27 02:02:59 stig ;; vastly improved the makefile patterns ;; added hook for mh-show-mode ;; ;; Revision 2.1 1993/07/24 17:46:21 stig ;; Phasing out Info-select-hook... Version 19.18 will use Info-selection-hook. ;; ;; Revision 2.0 1993/07/24 13:50:10 stig ;; better documentation and added the function hilit-submit-feedback. ;; C-S-l (control shift l) repaints the buffer. Other bindings are optional. ;; multi-line highlights no longer cause problems when ;; hilit-auto-rehighlight is 'visible ;; added hilit-predefined-face-list... ;; changed name of hilit-mode-alist to hilit-patterns-alist ;; added hilit-message-quietly to mail-setup-hook ;; added hilit-parser-alist which can be used to apply different patterns to ;; different parts of a buffer. This could be integrated in a far more ;; elegant manner, but it presently serves the purpose of not applying ;; message header patterns to message bodies in mail-mode and it's kin. ;; hilit-set-mode-patterns now takes a list of modes and an optional parse-fn ;; ;;;;;; AND THIS CAN BE APPLIED TO VM 5.33L_19 ;; ;; *** ../site/vm5.33L_19/vm-summary.el Fri Jun 4 22:17:11 1993 ;; --- ./vm-summary.el Tue Jun 22 16:39:30 1993 ;; *************** ;; *** 152,158 **** ;; (insert "->") ;; (delete-char 2) ;; (forward-char -2) ;; ! (and w vm-auto-center-summary (vm-auto-center-summary)))) ;; (and old-window (select-window old-window))))))) ;; ;; (defun vm-mark-for-display-update (message) ;; --- 152,159 ---- ;; (insert "->") ;; (delete-char 2) ;; (forward-char -2) ;; ! (and w vm-auto-center-summary (vm-auto-center-summary)) ;; ! (run-hooks 'vm-summary-pointer-hook))) ;; (and old-window (select-window old-window))))))) ;; ;; (defun vm-mark-for-display-update (message) ;; ;;;;;; ;;; Code: ;; User Options: (defvar hilit-quietly nil "* If non-nil, this inhibits progress indicators during highlighting") (defvar hilit-auto-highlight t "* T if we should highlight all buffers as we find 'em, nil to disable automatic highlighting by the find-file hook.") (defvar hilit-auto-highlight-maxout 60000 ; hilit19 keeps getting bigger... "* auto-highlight is disabled in buffers larger than this") (defvar hilit-auto-rehighlight t "* If this is non-nil, then hilit-redraw and hilit-recenter will also rehighlight part or all of the current buffer. T will rehighlight the whole buffer, a NUMBER will rehighlight that many lines before and after the cursor, and the symbol 'visible' will rehighlight only the visible portion of the current buffer. This variable is buffer-local.") (make-variable-buffer-local 'hilit-auto-rehighlight) (defvar hilit-auto-rehighlight-fallback '(20000 . 100) "* Cons of the form (THRESHOLD . FALLBACK), where FALLBACK is assigned to hilit-auto-rehighlight if the size of a newly opened buffer is larger than THRESHOLD.") (defvar hilit-face-check t "* T slows down highlighting but permits the user to change fonts without losing bold and italic faces... T causes hilit-lookup-face-create to dig through the frame parameters for the current window every time it's called. If you never change fonts in emacs, set this to NIL.") ;; Variables which must be set before loading hilit19. (defvar hilit-inhibit-rebinding nil "If non-nil, this inhibits replacement of recenter, yank, and yank-pop.") (defvar hilit-inhibit-hooks nil "If non-nil, this inhibits installation of hooks for Info, gnus, & vm.") (defvar hilit-background-mode 'light "'mono inhibits color, 'dark or 'light indicate the background brightness.") (defvar hilit-mode-enable-list nil "If a list of modes to exclusively enable or specifically disable. The sense of the list is negated if it begins with the symbol 'not'. Set this variable before you load hilit19. Ex: (perl-mode jargon-mode c-mode) ; just perl, C, and jargon modes (not text-mode) ; all modes except text mode") ;; Variables that are not generally modified directly (defvar hilit-parser-alist nil "alist of major-mode values and parsers called by hilit-rehighlight-buffer. Parsers for a given mode are IGNORED for partial rehighlights...maybe you'd like to make this more universal?") (defvar hilit-patterns-alist nil "alist of major-mode values and default highlighting patterns A highlighting pattern is a list of the form (start end face), where start is a regex, end is either a regex or a match number for start, and face is the name of an entry in hilit-face-translation-table, the name of a face, or nil (which disables the pattern). Each entry in the alist is of the form: (mode . (case-fold pattern [pattern ...])) See the hilit-lookup-face-create documentation for valid face names.") (defvar hilit-predefined-face-list (face-list) "List of faces with which hilit-lookup-face-create will NOT tamper. If hilit19 is dumped into emacs at your site, you may have to set this in your init file.") (eval-when-compile (setq byte-optimize t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Use this to report bugs: (eval-when-compile (require 'reporter)) ; no compilation gripes (defun hilit-submit-feedback () "Submit feedback on hilit19 to the author: stig@hackvan.com" (interactive) (require 'reporter) (and (y-or-n-p "Do you really want to submit a report on hilit19? ") (reporter-submit-bug-report "Jonathan Stigelman " "hilit19.el (Release 2.19)" (and (y-or-n-p "Do you need to include a dump hilit variables? ") (append '( hilit-quietly hilit-inhibit-hooks hilit-background-mode hilit-mode-enable-list hilit-auto-highlight hilit-auto-highlight-maxout hilit-auto-rehighlight hilit-auto-rehighlight-fallback hilit-face-check ) (and (y-or-n-p "Have you modified the standard patterns? ") (yes-or-no-p "Are your patterns *REALLY* relevant? ") '(hilit-parser-alist hilit-patterns-alist hilit-predefined-face-list )))) (function (lambda () (and (y-or-n-p "Is this a problem with font display? ") (insert "\nFrame Configuration:\n====================\n" (prin1-to-string (frame-configuration-to-register ?F)) "\n" )))) nil (concat "This is (check all that apply, and delete what's irrelevant):\n" " [ ] a _MASSIVE_THANK_YOU_ for writing hilit19.el\n" " [ ] An invitation to attend the next Hackers Conference\n" " [ ] You're a RIGHTEOUS HACKER, what are your rates?\n" " [ ] I've used the force and read the source, but I'M CONFUSED\n" " [ ] a PATCH. (output of 'diff -uw old.el new.el' or 'diff -cw')\n" " [ ] a SERIOUS AND REPRODUCABLE BUG that is not an EMACS bug\n" " - I *swear* that it's not already mentioned in the KNOWN BUGS\n" " - I HAVE CHECKED ftp.hackvan.com:/pub/stig/src/elisp/hilit19.el.gz\n" " for a newer release that fixes the problem.\n" " >> I HAVE ALSO CHECKED ftp.hackvan.com:/pub/stig/src/elisp/hl319.el.gz\n" " This is the alpha version...what will become hilit19 (Beta 3.0).\n" "\n" "Hey Stig, I *know* you're busy but...\n")))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; These faces are either a valid face name, or nil ;; if you want to change them, you must do so AFTER hilit19 is loaded (defconst hilit-default-face-table '( ;; used for C/C++ and Emacs Lisp and perl (comment firebrick-italic moccasin italic) (include purple Plum1 bold-italic) (define ForestGreen-bold green bold) (defun blue-bold cyan-bold bold-italic) (decl RoyalBlue cyan bold) (type nil yellow nil) (keyword RoyalBlue cyan bold-italic) (label red-underline orange-underlined underline) (string grey40 orange underline) ;; some further faces for Ada (struct black-bold white-bold bold) (glob-struct magenta Plum1 default-bold-underline) (named-param DarkGoldenrod Goldenrod underline) ;; and anotherone for LaTeX (crossref DarkGoldenrod Goldenrod underline) (formula Goldenrod DarkGoldenrod underline) ;; compilation buffers (active-error default/pink-bold default/DeepPink-bold default-underline) (error red-bold yellow bold) (warning blue-italic green italic) ;; Makefiles (some faces borrowed from C/C++ too) (rule blue-bold-underline cyan-underline default-bold-underline) ;; VM, GNUS and Text mode (msg-subject blue-bold yellow bold) (msg-from purple-bold green bold) (msg-header firebrick-bold cyan italic) (msg-separator black/tan-bold black/lightblue nil) (msg-quote ForestGreen pink italic) (summary-seen grey40 white nil) (summary-killed grey50 white nil) (summary-Xed OliveDrab2 green nil) (summary-deleted firebrick white italic) (summary-unread RoyalBlue yellow bold) (summary-new blue-bold yellow-bold bold-italic) (summary-current default/skyblue-bold green/dimgrey-bold reverse-default) (gnus-group-unsubscribed grey50 white nil) (gnus-group-empty nil nil nil) (gnus-group-full ForestGreen green italic) (gnus-group-overflowing firebrick red bold-italic) ;; dired mode (dired-directory blue-bold cyan bold) (dired-link firebrick-italic green italic) (dired-ignored ForestGreen moccasin nil) (dired-deleted red-bold-italic orange bold-italic) (dired-marked purple Plum1 nil) ;; Info-mode, and jargon-mode.el and prep.ai.mit.edu:/pub/gnu/jargon* (jargon-entry blue-bold cyan bold) (jargon-xref purple-bold Plum1 italic) (jargon-keyword firebrick-underline yellow underline) ) "alist of default faces (face . (light-default dark-default mono-default)) There is no way for the user to modify this table such that it will have any effect upon the translations used by hilit19. Instead, use the function hilit-translate AFTER hilit19 has been loaded. See also the documentation for hilit-lookup-face-create.") (defconst hilit-face-translation-table (let ((index (or (and (x-display-color-p) (cdr (assq hilit-background-mode '((light . 1) (dark . 2))))) 3))) (mapcar (function (lambda (x) (cons (car x) (nth index x)))) hilit-default-face-table)) "alist that maps symbolic face-names to real face names") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; To translate one face to another... ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmacro hilit-translate (&rest args) "(hilit-translate FROM TO FROM TO ...): translate each face FROM to the value of its TO face. This is like setq for faces. The function hilit-lookup-face-create will repeatedly translate until no more translations for the face exist in the translation table. See the documentation for hilit-lookup-face-create for names of valid faces." (or (zerop (% (length args) 2)) (error "wrong number of args")) (let (cmdl from to) (while args (setq from (car args) to (nth 1 args) args (nthcdr 2 args) cmdl (cons (list 'hilit-associate ''hilit-face-translation-table (list 'quote from) to) cmdl))) (cons 'progn cmdl))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; This function actually translates and then creates the faces... ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun hilit-lookup-face-create (face &optional force) "Get a FACE, or create it if it doesn't exist. In order for it to properly create the face, the followwing naming convention must be used: [reverse-](fgcolor[/bgcolor])[-bold][-italic][-underline] Example: (hilit-lookup-face-create 'comment-face) might create and return 'red Each color is either the name of an X color (see .../X11/lib/X11/rgb.txt), a hexadecimal specification of the form \"hex-[0-9A-Fa-f]+\", or \"default\". An optional argument, FORCE, will cause the face to be recopied from the default...which is probably of use only if you've changed fonts. See the documentation for hilit-translate and hilit-face-translation-table." ;; translate the face ... (let ((trec t) visited) (while trec (cond ((memq face visited) (error "face translation loop: %S" visited)) (t (setq visited (cons face visited) trec (assq face hilit-face-translation-table)) (and trec (setq face (cdr trec))))))) ;; make the face if we need to... (let* ((fn (symbol-name face)) (frame (selected-frame)) (basefont (cdr (assq 'font (frame-parameters frame)))) error fgcolor bgcolor) (cond ((or (null face) (memq face hilit-predefined-face-list)) ;; do nothing if the face is nil or if it's predefined. ) ((or force (not (memq face (face-list))) (and hilit-face-check (not (string= (get face 'basefont) basefont)))) (copy-face 'default 'scratch-face) (if (string-match "^reverse-?" fn) (progn (invert-face 'scratch-face) (setq fn (substring fn (match-end 0))))) ;; parse foreground color (if (string-match "^\\(hex-\\)?\\([A-Za-z0-9]+\\)" fn) (setq fgcolor (concat (if (match-beginning 1) "#") (substring fn (match-beginning 2) (match-end 2))) fn (substring fn (match-end 0))) (error "bad face name %S" face)) ;; parse background color (if (string-match "^/\\(hex-\\)?\\([A-Za-z0-9]+\\)" fn) (setq bgcolor (concat (and (match-beginning 1) "#") (substring fn (match-beginning 2) (match-end 2))) fn (substring fn (match-end 0)))) (and (string= "default" fgcolor) (setq fgcolor nil)) (and (string= "default" bgcolor) (setq bgcolor nil)) ;; catch errors if we can't allocate the color(s) (condition-case nil (progn (set-face-foreground 'scratch-face fgcolor) (set-face-background 'scratch-face bgcolor) (copy-face 'scratch-face face) (put face 'basefont basefont)) (error (message "couldn't allocate color for '%s'" (symbol-name face)) (setq face 'default) (setq error t))) (or error ;; don't bother w/ bold or italic if we didn't get the color ;; we wanted, but ignore errors making the face bold or italic ;; if the font isn't available, there's nothing to do about it... (progn (set-face-font face nil frame) (set-face-underline-p face (string-match "underline" fn)) (if (string-match ".*bold" fn) ;; make face bold in all frames (make-face-bold face nil 'noerr)) (if (string-match ".*italic" fn) ;; make face italic in all frames (make-face-italic face nil 'noerr)) )) ))) face) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Region Highlight/Unhighlight code (Both overlay and text-property versions) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defsubst hilit-region-set-face (start end face-name &optional prio prop) "Highlight region from START to END using FACE and, optionally, PRIO. The optional 5th arg, PROP is a property to set instead of 'hilit." (let ((overlay (make-overlay start end))) (overlay-put overlay 'face face-name) (overlay-put overlay (or prop 'hilit) t) (and prio (overlay-put overlay 'priority prio)))) (defun hilit-unhighlight-region (start end &optional quietly) "Unhighlights the region from START to END, optionally in a QUIET way" (interactive "r") (or quietly hilit-quietly (message "Unhighlighting")) (let ((lstart 0)) (while (and start (> start lstart) (< start end)) (mapcar (function (lambda (ovr) (and (overlay-get ovr 'hilit) (delete-overlay ovr)))) (overlays-at start)) (setq lstart start start (next-overlay-change start)))) (or quietly hilit-quietly (message "Done unhighlighting"))) ;;;; These functions use text properties instead of overlays. Text properties ;;;; are copied through kill and yank...which might be convenient, but is not ;;;; terribly efficient as of 19.12, ERGO it's been disabled ;; ;;(defsubst hilit-region-set-face (start end face-name &optional prio prop) ;; "Highlight region from START to END using FACE and, optionally, PRIO. ;;The optional 5th arg, PROP is a property to set instead of 'hilit." ;; (put-text-property start end 'face face-name) ;; ) ;; ;;(defun hilit-unhighlight-region (start end &optional quietly) ;; "Unhighlights the region from START to END, optionally in a QUIET way" ;; (interactive "r") ;; (let ((buffer-read-only nil) ;; (bm (buffer-modified-p))) ;; (remove-text-properties start end '(face)) ;; (set-buffer-modified-p bm))) ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Pattern Application code and user functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun hilit-highlight-region (start end &optional patterns quietly) "Highlights the area of the buffer between START and END (the region when interactive). Without the optional PATTERNS argument, the pattern for major-mode is used. If PATTERNS is a symbol, then the patterns associated with that symbol are used. QUIETLY suppresses progress messages if non-nil." (interactive "r") (cond ((null patterns) (setq patterns (cdr (assq major-mode hilit-patterns-alist)))) ((symbolp patterns) (setq patterns (cdr (assq patterns hilit-patterns-alist))))) ;; txt prop: (setq patterns (reverse patterns)) (let ((case-fold-search (car patterns)) (prio (1- (length patterns))) ;; txt prop: (buffer-read-only nil) ;; txt prop: (bm (buffer-modified-p)) p pstart pend face mstart (puke-count 0)) ;; txt prop: (unwind-protect (setq patterns (cdr patterns)) ; remove case-fold from head of pattern (save-excursion (save-restriction (narrow-to-region start end) (while patterns (setq p (car patterns)) (setq pstart (car p) pend (nth 1 p) face (hilit-lookup-face-create (nth 2 p))) (if (not face) ; skipped if nil nil (or quietly hilit-quietly (message "highlighting %d: %s%s" prio pstart (if (stringp pend) (concat " ... " pend) ""))) (goto-char (point-min)) (condition-case msg (cond ((symbolp pstart) ;; inner loop -- special function to find pattern (let (region) (while (setq region (funcall pstart pend)) (hilit-region-set-face (car region) (cdr region) face prio)))) ((stringp pend) ;; inner loop -- regex-start ... regex-end (while (re-search-forward pstart nil t nil) (goto-char (setq mstart (match-beginning 0))) (if (re-search-forward pend nil t nil) (hilit-region-set-face mstart (match-end 0) face prio) (forward-char 1)))) ((numberp pend) ;; inner loop -- just one regex to match whole pattern (while (re-search-forward pstart nil t nil) (goto-char (match-end pend)) (hilit-region-set-face (match-beginning pend) (match-end pend) face prio))) (t (error "malformed pattern"))) (error (if (> (setq puke-count (1+ puke-count)) 1) (error msg) (message "Error: '%s'" msg) (ding) (sit-for 4))))) (setq prio (1- prio) patterns (cdr patterns))) )) (or quietly hilit-quietly (message "")) ; "Done highlighting" ;; txt prop: (set-buffer-modified-p bm)) ; unwind protection )) (defun hilit-rehighlight-region (start end &optional quietly) "Re-highlights the region, optionally in a QUIET way" (interactive "r") (save-restriction (widen) (setq start (apply 'min start (mapcar 'overlay-start (overlays-at start))) end (apply 'max end (mapcar 'overlay-end (overlays-at end)))) (hilit-unhighlight-region start end quietly) (hilit-highlight-region start end nil quietly))) (defun hilit-rehighlight-buffer (&optional quietly) "Re-highlights the buffer, optionally in a QUIET way" (interactive "") (let ((parse-fn (cdr (assq major-mode hilit-parser-alist)))) (if parse-fn (funcall parse-fn quietly) (hilit-rehighlight-region (point-min) (point-max) quietly))) nil) (defun hilit-rehighlight-buffer-quietly () (hilit-rehighlight-buffer t)) (defun hilit-rehighlight-message (quietly) "Highlight a buffer containing a news article or mail message." (save-excursion (goto-char (point-min)) (re-search-forward "^$" nil 'noerr) (hilit-unhighlight-region (point-min) (point-max) quietly) (hilit-highlight-region (point-min) (point) 'msg-header quietly) (hilit-highlight-region (point) (point-max) 'msg-body quietly))) (defalias 'hilit-highlight-buffer 'hilit-rehighlight-buffer) ;; Well, I want to remove this function...there's one sure way to find out if ;; anyone uses it or not...and that's to comment it out. ;; ;; (defun hilit-toggle-highlight (arg) ;; "Locally toggle highlighting. With arg, forces highlighting off." ;; (interactive "P") ;; ;; FIXME -- this loses numeric information in hilit-auto-rehighlight ;; (setq hilit-auto-rehighlight ;; (and (not arg) (not hilit-auto-rehighlight))) ;; (if hilit-auto-rehighlight ;; (hilit-rehighlight-buffer) ;; (hilit-unhighlight-region (point-min) (point-max))) ;; (message "Rehighlighting is set to %s" hilit-auto-rehighlight)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; HOOKS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun hilit-find-file-hook () "Find-file hook for hilit package. See the variable hilit-auto-highlight." (cond ((and hilit-auto-highlight (assq major-mode hilit-patterns-alist)) (if (> buffer-saved-size (car hilit-auto-rehighlight-fallback)) (setq hilit-auto-rehighlight (cdr hilit-auto-rehighlight-fallback))) (if (> buffer-saved-size hilit-auto-highlight-maxout) nil (let ((bm (buffer-modified-p))) (hilit-rehighlight-buffer) (set-buffer-modified-p bm)))))) (defun hilit-repaint-command (arg) "Rehighlights according to the value of hilit-auto-rehighlight, or the prefix argument if that is specified. \t\\[hilit-repaint-command]\t\trepaint according to hilit-auto-rehighlight \t^U \\[hilit-repaint-command]\trepaint entire buffer \t^U - \\[hilit-repaint-command]\trepaint visible portion of buffer \t^U n \\[hilit-repaint-command]\trepaint n lines to either side of point" (interactive "P") (let (st en quietly) (or arg (setq arg hilit-auto-rehighlight)) (cond ((or (eq arg 'visible) (eq arg '-)) (setq st (window-start) en (window-end) quietly t)) ((numberp arg) (setq st (save-excursion (forward-line (- arg)) (point)) en (save-excursion (forward-line arg) (point)))) (arg (hilit-rehighlight-buffer))) (if st (hilit-rehighlight-region st en quietly)))) (defun hilit-recenter (arg) "Recenter, then rehighlight according to hilit-auto-rehighlight. If called with an unspecified prefix argument (^U but no number), then a rehighlight of the entire buffer is forced." (interactive "P") (recenter arg) ;; force display update (sit-for 0) (hilit-repaint-command (consp arg))) (defun hilit-yank (arg) "Yank with rehighlighting" (interactive "*P") (let ((transient-mark-mode nil)) (yank arg) (and hilit-auto-rehighlight (hilit-rehighlight-region (region-beginning) (region-end) t)) (setq this-command 'yank))) (defun hilit-yank-pop (arg) "Yank-pop with rehighlighting" (interactive "*p") (let ((transient-mark-mode nil)) (yank-pop arg) (and hilit-auto-rehighlight (hilit-rehighlight-region (region-beginning) (region-end) t)) (setq this-command 'yank))) ;;; this line highlighting stuff is untested. play with it only if you feel ;;; adventurous...don't ask me to fix it...though you're welcome to. -- Stig ;; ;; (defun hilit-rehighlight-line-quietly (&rest args) ;; "Quietly rehighlight just this line. ;; Useful as an after change hook in VM/gnus summary buffers and dired buffers. ;; If only there were an after-change-function, that is..." ;; (save-excursion ;; (push-mark nil t) ;; (hilit-rehighlight-yank-region) ;; (and orig-achange-function (apply orig-achange-function args)))) ;; ;; (defun hilit-install-line-hooks () ;; (make-variable-buffer-local 'after-change-function) ;; (make-local-variable 'orig-achange-function) ;; (setq orig-achange-function after-change-function) ;; (setq after-change-function 'hilit-rehighlight-line-quietly)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Wysiwyg Stuff... take it away and build a whole package around it! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ; For the Jargon-impaired, WYSIWYG === What You See Is What You Get ;; ; Sure, it sucks to type. Oh, well. ;; (defun hilit-wysiwyg-replace () ;; "Replace overstruck text with normal text that's been overlayed with the ;; appropriate text attribute. Suitable for a find-file hook." ;; (save-excursion ;; (goto-char (point-min)) ;; (let ((wysb (hilit-lookup-face-create 'wysiwyg-bold)) ;; (wysu (hilit-lookup-face-create 'wysiwyg-underline)) ;; (bmod (buffer-modified-p))) ;; (while (re-search-forward "\\(.\b.\\)+" nil t) ;; (let ((st (match-beginning 0)) (en (match-end 0))) ;; (goto-char st) ;; (if (looking-at "_") ;; (hilit-region-set-face st en wysu 100 'wysiwyg) ;; (hilit-region-set-face st en wysb 100 'wysiwyg)) ;; (while (and (< (point) en) (looking-at ".\b")) ;; (replace-match "") (forward-char)) ;; )) ;; (set-buffer-modified-p bmod)))) ;; ;; ; is this more appropriate as a write-file-hook or a write-contents-hook? ;; (defun hilit-wysiwyg-write-repair () ;; "Replace wysiwyg overlays with overstrike text." ;; (message "*sigh* hilit-wysiwyg-write-repair not implemented yet") ;; ;; For efficiency, this hook should copy the current buffer to a scratch ;; buffer and do it's overstriking there. Overlays are not copied, so it'll ;; be necessary to hop back and forth. This is OK since you're not fiddling ;; with--making or deleting--any overlays. THEN write the new buffer, ;; delete it, and RETURN T. << important ;; ;; Just so you know...there is already an emacs function called ;; underline-region that does underlining. I think that the thing to do is ;; extend that to do overstriking as well. ;; ;; (while (< start end) ;; (mapcar (function (lambda (ovr) ;; (and (overlay-get ovr 'hilit) (delete-overlay ovr)))) ;; (overlays-at start)) ;; (setq start (next-overlay-change start))) ;; nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Initialization. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (and (not hilit-inhibit-rebinding) window-system (progn (substitute-key-definition 'yank 'hilit-yank (current-global-map)) (substitute-key-definition 'yank-pop 'hilit-yank-pop (current-global-map)) (substitute-key-definition 'recenter 'hilit-recenter (current-global-map)))) (global-set-key [?\C-\S-l] 'hilit-repaint-command) (and window-system (add-hook 'find-file-hooks 'hilit-find-file-hook t)) (eval-when-compile (require 'gnus)) ; no compilation gripes (and (not hilit-inhibit-hooks) window-system (condition-case c (progn ;; BUFFER highlights... (mapcar (function (lambda (hook) (add-hook hook 'hilit-rehighlight-buffer-quietly))) '( Info-selection-hook ;; runs too early vm-summary-mode-hooks vm-summary-pointer-hook vm-preview-message-hook vm-show-message-hook rmail-show-message-hook mail-setup-hook mh-show-mode-hook dired-after-readin-hook )) ) (error (message "Error loading highlight hooks: %s" c) (ding) (sit-for 1)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Default patterns for various modes. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; do I need this? I changed the defconst to a defvar because defconst is ;;; inappropriate, but I don't know why I wanted hilit-patterns-alist to be ;;; reset on every reload... (setq hilit-patterns-alist nil) (defun hilit-associate (alist key val) "creates, or destructively replaces, the pair (key . val) in alist" (let ((oldentry (assq key (eval alist)))) (if oldentry (setcdr oldentry val) (set alist (cons (cons key val) (eval alist)))))) (defun hilit-set-mode-patterns (modelist patterns &optional parse-fn case-fold) "Sets the default highlighting patterns for MODE to PATTERNS. See the variable hilit-mode-enable-list. Takes optional arguments PARSE-FN and CASE-FOLD." ;; change pattern (mapcar (function (lambda (p) (and (stringp (car p)) (null (nth 1 p)) (setcar (cdr p) 0)))) patterns) (setq patterns (cons case-fold patterns)) (or (consp modelist) (setq modelist (list modelist))) (let (ok (flip (eq (car hilit-mode-enable-list) 'not))) (mapcar (function (lambda (m) (setq ok (or (null hilit-mode-enable-list) (memq m hilit-mode-enable-list))) (and flip (setq ok (not ok))) (and ok (progn (and parse-fn (hilit-associate 'hilit-parser-alist m parse-fn)) (hilit-associate 'hilit-patterns-alist m patterns))))) modelist))) (defun hilit-add-pattern (pstart pend face &optional mode first) "Highlight pstart with face for the current major-mode. Optionally, place the new pattern first in the pattern list" (interactive "sPattern start regex: \nsPattern end regex (default none): \nxFace: ") (and (equal pstart "") (error "Must specify starting regex")) (cond ((equal pend "") (setq pend 0)) ((string-match "^[0-9]+$" pend) (setq pend (string-to-int pend)))) (or mode (setq mode major-mode)) (let ((old-patterns (cdr (assq mode hilit-patterns-alist))) (new-pat (list pstart pend face))) (cond ((not old-patterns) (hilit-set-mode-patterns mode (list new-pat))) (first (setcdr old-patterns (cons new-pat (cdr old-patterns)))) (t (nconc old-patterns (list new-pat))))) (and (interactive-p) (hilit-rehighlight-buffer))) (defun hilit-string-find (qchar) "looks for a string and returns (start . end) or NIL. The argument QCHAR is the character that would precede a character constant double quote. Finds strings delimited by double quotes. The first double quote may not be preceded by QCHAR and the closing double quote may not be preceded by an odd number of backslashes." (let (st en) (while (and (search-forward "\"" nil t) (eq qchar (char-after (1- (setq st (match-beginning 0))))))) (while (and (search-forward "\"" nil t) (save-excursion (setq en (point)) (forward-char -1) (skip-chars-backward "\\\\") (forward-char 1) (not (zerop (% (- en (point)) 2)))))) (and en (cons st en)))) ;; return types on same line... ;; ("^[a-zA-z].*\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) ;; On another note, a working pattern for grabbing function definitions for C is ;; ;; ("^[a-zA-Z_]+.*[;{]$" nil ForestGreen) ; global defns ( start at col 1 ) ;; ("^[a-zA-Z_]+.*(" ")" defun) ;; ; defuns assumed to start at col 1, not with # or { ;; ;; this will make external declarations/definitions green, and function ;; definitions the defun face. Hmmm - seems to work for me anyway. (let ((comments '(("/\\*" "\\*/" comment))) (c++-comments '(("//.*$" nil comment) ("^/.*$" nil comment))) (strings '((hilit-string-find ?' string))) (preprocessor '(("^#[ \t]*\\(undef\\|define\\).*$" "[^\\]$" define) ("^#.*$" nil include)))) (hilit-set-mode-patterns '(c-mode c++-c-mode elec-c-mode) (append comments strings preprocessor '( ;; function decls are expected to have types on the previous line ("^\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) ("^\\(typedef\\|struct\\|union\\|enum\\).*$" nil decl) ;; datatype -- black magic regular expression ("[ \n\t({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\)\\([ \t]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n\t;()]\\)" nil type) ;; key words ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\)\\>[^_]" 1 keyword) ))) (hilit-set-mode-patterns 'c++-mode (append comments c++-comments strings preprocessor '( ;; function decls are expected to have types on the previous line ("^\\(\\(\\w\\|[$_]\\)+::\\)?\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) ("^\\(\\(\\w\\|[$_]\\)+[ \t]*::[ \t]*\\)?\\(\\(\\w\\|[$_]\\)+\\|operator.*\\)\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) ("^\\(template\\|typedef\\|struct\\|union\\|class\\|enum\\|public\\|private\\|protected\\).*$" nil decl) ;; datatype -- black magic regular expression ("[ \n\t({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\|class\\)\\([ \t]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n\t;()]\\)" nil type) ;; key words ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\|public\\|protected\\|private\\|delete\\|new\\)\\>[^_]" 1 keyword)))) (hilit-set-mode-patterns '(objc-mode objective-C-mode) (append comments c++-comments strings preprocessor '( ;; function decls are expected to have types on the previous line ("^\\(\\(\\w\\|[$_]\\)+::\\)?\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) ("^\\(\\(\\w\\|[$_]\\)+[ \t]*::[ \t]*\\)?\\(\\(\\w\\|[$_]\\)+\\|operator.*\\)\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) ("^\\(template\\|typedef\\|struct\\|union\\|class\\|enum\\|public\\|private\\|protected\\).*$" nil decl) ;; datatype -- black magic regular expression ("[ \n\t({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\|class\\)\\([ \t]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n\t;()]\\)" nil type) ;; key words ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\|public\\|protected\\|private\\|interface\\|implementation\\|end\\|super\\|self\\)\\>[^_]" 1 keyword)))) ) (hilit-set-mode-patterns 'perl-mode '(("\\s #.*$" nil comment) ("^#.*$" nil comment) ("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string) ("^\\(__....?__\\|\\s *\\sw+:\\)" nil label) ("^require.*$" nil include) ("^package.*$" nil decl) ("^\\s *sub\\s +\\(\\w\\|[_']\\)+" nil defun) ("\\b\\(do\\|if\\|unless\\|while\\|until\\|else\\|elsif\\|for\\|foreach\\|continue\\|next\\|redo\\|last\\|goto\\|return\\|die\\|exit\\)\\b" nil keyword))) (hilit-set-mode-patterns 'ada-mode '(;; comments ("--.*$" nil comment) ;; main structure ("[ \t\n]procedure[ \t]" "\\([ \t]\\(is\\|renames\\)\\|);\\)" glob-struct) ("[ \t\n]task[ \t]" "[ \t]is" glob-struct) ("[ \t\n]function[ \t]" "return[ \t]+[A-Za-z_0-9]+[ \t]*\\(is\\|;\\|renames\\)" glob-struct) ("[ \t\n]package[ \t]" "[ \t]\\(is\\|renames\\)" glob-struct) ;; if there is nothing before "private", it is part of the structure ("^[ \t]*private[ \t\n]" nil glob-struct) ;; if there is no indentation before the "end", then it is most ;; probably the end of the package ("^end.*$" ";" glob-struct) ;; program structure -- "null", "delay" and "terminate" omitted ("[ \n\t]\\(in\\|out\\|select\\|if\\|else\\|case\\|when\\|and\\|or\\|not\\|accept\\|loop\\|do\\|then\\|elsif\\|else\\|for\\|while\\|exit\\)[ \n\t;]" nil struct) ;; block structure ("[ \n\t]\\(begin\\|end\\|declare\\|exception\\|generic\\|raise\\|return\\|package\\|body\\)[ \n\t;]" nil struct) ;; type declaration ("^[ \t]*\\(type\\|subtype\\).*$" ";" decl) ("[ \t]+is record.*$" "end record;" decl) ;; "pragma", "with", and "use" are close to C cpp directives ("^[ \t]*\\(with\\|pragma\\|use\\)" ";" include) ;; nice for named parameters, but not so beautiful in case statements ("[A-Za-z_0-9.]+[ \t]*=>" nil named-param) ;; string constants probably not everybody likes this one ("\"" ".*\"" string))) (hilit-set-mode-patterns 'fortran-mode '(("^[*Cc].*$" nil comment) ("'[^'\n]*'" nil string) ("\\(^[ \t]*[0-9]+\\|[ \t]continue[ \t\n]\\|format\\)" nil define) ("[ \t]\\(do\\|do[ \t]*[0-9]+\\|go[ \t]*to[ \t]*[0-9]+\\|end[ \t]*do\\|if\\|else[ \t]*if\\|then\\|else\\|end[ \t]*if\\)[ \t\n(]" nil define) ("[ \t]\\(call\\|program\\|subroutine\\|function\\|stop\\|return\\|end\\|include\\)[ \t\n]" nil include) ("[ \t]\\(parameter[\t\n ]*([^)]*)\\|data\\|save\\|common[ \t\n]*/[^/]*/\\)" nil decl) ("^ ." nil type) ("implicit[ \t]*none" nil decl) ("\\([ \t]\\|implicit[ \t]*\\)\\(dimension\\|integer\\|real\\|double[ \t]*precision\\|character\\|logical\\|complex\\|double[ \t]*complex\\)\\([*][0-9]*\\|[ \t\n]\\)" nil keyword) ) nil 'case-insensitive) (hilit-set-mode-patterns '(m2-mode modula-2-mode) '(("(\\*" "\\*)" comment) (hilit-string-find ?\\ string) ("^[ \t]*PROCEDURE[ \t]+\\w+[^ \t(;]*" nil defun) ("\\<\\(RECORD\\|ARRAY\\|OF\\|POINTER\\|TO\\|BEGIN\\|END\\|FOR\\|IF\\|THEN\\|ELSE\\|ELSIF\\|CASE\\|WHILE\\|DO\\|MODULE\\|FROM\\|RETURN\\|IMPORT\\|EXPORT\\|VAR\\|LOOP\\|UNTIL\\|\\DEFINITION\\|IMPLEMENTATION\\|AND\\|OR\\|NOT\\|CONST\\|TYPE\\|QUALIFIED\\)\\>" nil keyword) ) nil 'case-insensitive) (hilit-set-mode-patterns 'prolog-mode '(("/\\*" "\\*/" comment) ("%.*$" nil comment) (":-" nil defun) ("!" nil label) ("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string) ("\\b\\(is\\|mod\\)\\b" nil keyword) ("\\(->\\|-->\\|;\\|==\\|\\\\==\\|=<\\|>=\\|<\\|>\\|=\\|\\\\=\\|=:=\\|=\\\.\\\.\\|\\\\\\\+\\)" nil decl) ("\\(\\\[\\||\\|\\\]\\)" nil include))) (hilit-set-mode-patterns '( LaTeX-mode japanese-LaTeX-mode SliTeX-mode japanese-SliTeX-mode FoilTeX-mode latex-mode ) '( ;; comments ("[^\\]%.*$" nil comment) ;; the following two match \foo[xx]{xx} or \foo*{xx} or \foo{xx} ("\\\\\\(sub\\)*\\(paragraph\\|section\\)\\(\*\\|\\[.*\\]\\)?{" "}" keyword) ("\\\\\\(chapter\\|part\\)\\(\*\\|\\[.*\\]\\)?{" "}" keyword) ("\\\\footnote\\(mark\\|text\\)?{" "}" keyword) ("\\\\[a-z]+box" nil keyword) ("\\\\\\(v\\|h\\)space\\(\*\\)?{" "}" keyword) ;; (re-)define new commands/environments/counters ("\\\\\\(re\\)?new\\(environment\\|command\\){" "}" defun) ("\\\\new\\(length\\|theorem\\|counter\\){" "}" defun) ;; various declarations/definitions ("\\\\\\(setlength\\|settowidth\\|addtolength\\|setcounter\\|addtocounter\\)" nil define) ("\\\\\\(title\\|author\\|date\\|thanks\\){" "}" define) ("\\\\documentstyle\\(\\[.*\\]\\)?{" "}" decl) ("\\\\\\(begin\\|end\\|nofiles\\|includeonly\\){" "}" decl) ("\\\\\\(raggedright\\|makeindex\\|makeglossary\\|maketitle\\)\\b" nil decl) ("\\\\\\(pagestyle\\|thispagestyle\\|pagenumbering\\){" "}" decl) ("\\\\\\(normalsize\\|small\\|footnotesize\\|scriptsize\\|tiny\\|large\\|Large\\|LARGE\\|huge\\|Huge\\)\\b" nil decl) ("\\\\\\(appendix\\|tableofcontents\\|listoffigures\\|listoftables\\)\\b" nil decl) ("\\\\\\(bf\\|em\\|it\\|rm\\|sf\\|sl\\|ss\\|tt\\)\\b" nil decl) ;; label-like things ("\\\\item\\(\\[[^]]*\\]\\)?" nil label) ("\\\\caption\\(\\[[^]]*\\]\\)?{" "}" label) ;; formulas ("[^\\]\\\\(" "\\\\)" formula) ; \( \) ("[^\\]\\\\\\[" "\\\\\\]" formula) ; \[ \] ("[^\\$]\\($\\($[^$]*\\$\\|[^$]*\\)\\$\\)" 1 formula) ; '$...$' or '$$...$$' ;; things that bring in external files ("\\\\\\(include\\|input\\|bibliography\\){" "}" include) ;; "wysiwyg" emphasis -- these don't work with nested expressions ;; ("{\\\\\\(em\\|it\\|sl\\)" "}" italic) ;; ("{\\\\bf" "}" bold) ("``" "''" string) ;; things that do some sort of cross-reference ("\\\\\\(\\(no\\)?cite\\|\\(page\\)?ref\\|label\\|index\\|glossary\\){" "}" crossref) )) (hilit-set-mode-patterns 'bibtex-mode '(;;(";.*$" nil comment) ("%.*$" nil comment) ("@[a-zA-Z]+" nil keyword) ("{[ \t]*[-a-z:_A-Z0-9]+," nil label) ; is wrong sometimes ("^[ \t]*[a-zA-Z]+[ \t]*=" nil define))) (hilit-set-mode-patterns 'compilation-mode '( ("^[-_.\"A-Za-z0-9]+\\(:\\|, line \\)[0-9]+: warning:.*$" nil warning) ("^[-_.\"A-Za-z0-9]+\\(:\\|, line \\)[0-9]+:.*$" nil error) )) (hilit-set-mode-patterns 'makefile-mode '(("^#.*$" nil comment) ("[^$]#.*$" nil comment) ;; rules ("^[^ \t\n]*%[^ \t\n]*[ \t]*::?[ \t]*[^ \t\n]*[ \t]*\\(#.*\\)?$" nil rule) ("^[.][A-Za-z][A-Za-z]?\..*$" nil rule) ;; variable definition ("^[_A-Za-z0-9]+[ \t]*\+?=" nil define) ("\\( \\|:=\\)[_A-Za-z0-9]+[ \t]*\\+=" nil define) ;; variable references ("\\$\\([^ \t\n{(]\\|[{(]@?[_A-Za-z0-9:.,%/=]+[)}]\\)" nil keyword) ("^[A-Za-z0-9.,/_-]+[ \t]*:.*$" nil defun) ("^include " nil include))) (let* ((header-patterns '(("^Subject:.*$" nil msg-subject) ("^From:.*$" nil msg-from) ("^--text follows this line--$" nil msg-separator) ("^[A-Za-z][A-Za-z0-9-]+:" nil msg-header))) (body-patterns '(("^\\(In article\\|[ \t]*\\w*[]<>}|]\\).*$" nil msg-quote))) (message-patterns (append header-patterns body-patterns))) (hilit-set-mode-patterns 'msg-header header-patterns) (hilit-set-mode-patterns 'msg-body body-patterns) (hilit-set-mode-patterns '(vm-mode text-mode mail-mode rmail-mode gnus-article-mode news-reply-mode mh-show-mode) message-patterns 'hilit-rehighlight-message)) (hilit-set-mode-patterns 'gnus-group-mode '(("^ U.*$" nil gnus-group-unsubscribed) ("^\\*? +[01]?[0-9]:.*$" nil gnus-group-empty) ("^ +[2-9][0-9]:.*$" nil gnus-group-full) ("^ +[0-9][0-9][0-9]+:.*$" nil gnus-group-overflowing))) (hilit-set-mode-patterns 'vm-summary-mode '(("^ .*$" nil summary-seen) ("^->.*$" nil summary-current) ("^ D.*$" nil summary-deleted) ("^ U.*$" nil summary-unread) ("^ N.*$" nil summary-new))) ;;; this will match only comments w/ an even (zero is even) number of quotes... ;;; which is still inadequate because it matches comments in multi-line strings ;;; how anal do you want to get about never highlighting comments in strings? ;;; I could twiddle with this forever and still it wouldn't be perfect. ;;; (";\\([^\"\n]*\"[^\"\n]*\"\\)*[^\"\n]*$" nil comment) (hilit-set-mode-patterns '(emacs-lisp-mode lisp-interaction-mode) '( (";.*" nil comment) ;;; This almost works...but I think I'll stick with the parser function ;;;("[^?]\\(\"\\(\"\\||\\([^\"]+\\|[\\]\\([\\][\\]\\)*\"\\)*\"\\)\\)" 1 string) (hilit-string-find ?\\ string) ("^\\s *(def\\(un\\|macro\\|advice\\|alias\\|subst\\)[ \t\n]" "\\()\\|nil\\)" defun) ("^\\s *(defvar\\s +\\S +" nil decl) ("^\\s *(defconst\\s +\\S +" nil define) ("^\\s *(\\(provide\\|require\\|\\(auto\\)?load\\).*$" nil include) ("\\s *\\&\\(rest\\|optional\\)\\s *" nil keyword) ("(\\(let\\*?\\|cond\\|if\\|or\\|and\\|map\\(car\\|concat\\)\\|prog[n1*]?\\|while\\|lambda\\|function\\|set\\([qf]\\|car\\|cdr\\)?\\|nconc\\|eval-when-compile\\|condition-case\\|unwind-protect\\|catch\\|throw\\|error\\)[ \t\n]" 1 keyword) )) (hilit-set-mode-patterns '(lisp-mode ilisp-mode) '( (";.*" nil comment) ("#|" "|#" comment) ;;; This almost works...but I think I'll stick with the parser function ;;;("[^?]\\(\"\\(\"\\||\\([^\"]+\\|[\\]\\([\\][\\]\\)*\"\\)*\"\\)\\)" 1 string) (hilit-string-find ?\\ string) ;; this is waaaaaaaay too slow ;; ("^\\s *(def\\(un\\|macro\\|advice\\|alias\\|method\\|subst\\)\\s \\S +[ \t\n]+\\(nil\\|(\\(([^()]*)\\|[^()]+\\)*)\\)" nil defun) ("^\\s *(def\\(un\\|macro\\|advice\\|subst\\|method\\)\\s " "\\()\\|nil\\)" defun) ("^\\s *(\\(def\\(var\\|type\\|parameter\\)\\|declare\\)\\s +\\S +" nil decl) ("^\\s *(def\\(const\\(ant\\)?\\|class\\|struct\\)\\s \\S +[ \t\n]+" nil define) ("^\\s *(\\(provide\\|require\\|\\(auto\\)?load\\).*$" nil include) ("[ \t]\\&\\(key\\|rest\\|optional\\|aux\\)\\s *" nil keyword) ("(\\(let\\*?\\|locally\\|cond\\|if\\*?\\|or\\|and\\|map\\(car\\|c[ao]n\\)?\\|prog[nv1*]?\\|while\\|when\\|unless\\|do\\(\\*\\|list\\|times\\)\\|list\\|lambda\\|function\\|values\\|set\\([qf]\\|car\\|cdr\\)?\\|rplac[ad]\\|nconc\\|block\\|go\\|return\\(-from\\)?\\|[ec]?\\(type\\)?case\\|multiple-value-\\(bind\\|setq\\|list\\|call\\|prog1\\)\\|unwind-protect\\|handler-case\\|catch\\|throw\\|eval-when\\(-compile\\)?\\)[ \t\n]" 1 keyword) )) (hilit-set-mode-patterns 'plain-tex-mode '(("^%%.*$" nil comment) ("{\\\\em\\([^}]+\\)}" nil comment) ("\\(\\\\\\w+\\)" nil keyword) ("{\\\\bf\\([^}]+\\)}" nil keyword) ("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" nil defun) ("\\\\\\(begin\\|end\\){\\([A-Za-z0-9\\*]+\\)}" nil defun) ;; ("[^\\\\]\\$\\([^$]*\\)\\$" nil string) ("\\$\\([^$]*\\)\\$" nil string) )) ;; Reasonable extensions would include smarter parameter handling for such ;; things as the .IX and .I macros, which alternate the handling of following ;; arguments. (hilit-set-mode-patterns 'nroff-mode '(("^\\.[\\\][\\\"].*$" nil comment) ("^\\.so .*$" nil include) ("^\\.[ST]H.*$" nil defun) ;; ("^[^\\.].*\"[^\\\"]*\\(\\\\\\(.\\)[^\\\"]*\\)*\"" nil string) ("\"" "[^\\]\"" string) ("^\\.[A-Z12\\\\].*$" nil define) ("\\([\\\][^ ]*\\)" nil keyword) ("^\\.[A-Z].*$" nil keyword)) nil 'case-insensitive) (hilit-set-mode-patterns 'texinfo-mode '(("^\\(@c\\|@comment\\)\\>.*$" nil comment) ("@\\(emph\\|strong\\|b\\|i\\){[^}]+}" nil comment) ;; seems broken ;; ("\\$[^$]*\\$" nil string) ("@\\(file\\|kbd\\|key\\){[^}]+}" nil string) ("^\\*.*$" nil defun) ("@\\(if\\w+\\|format\\|item\\)\\b.*$" nil defun) ("@end +[A-Za-z0-9]+[ \t]*$" nil defun) ("@\\(samp\\|code\\|var\\){[^}]+}" nil defun) ("@\\w+\\({[^}]+}\\)?" nil keyword) )) (hilit-set-mode-patterns 'dired-mode (append '(("^D.*$" nil dired-deleted) ("^\\*.*$" nil dired-marked) ("^ d.*$" nil dired-directory) ("^ l.*$" nil dired-link) ("^ -.*#.*#$" nil dired-ignored)) (list (cons (concat "^ .*\\(" (mapconcat 'regexp-quote completion-ignored-extensions "\\|") "\\)$") '(nil dired-ignored))))) (hilit-set-mode-patterns 'jargon-mode '(("^:[^:]*:" nil jargon-entry) ("{[^}]*}+" nil jargon-xref))) (hilit-set-mode-patterns 'Info-mode '(("^\\* [^:]+:+" nil jargon-entry) ("\\*[Nn]ote\\b[^:]+:+" nil jargon-xref) (" \\(Next\\|Prev\\|Up\\):" nil jargon-xref) ("- \\(Variable\\|Function\\|Macro\\|Command\\|Special Form\\|User Option\\):.*$" nil jargon-keyword))) ; lisp manual (hilit-set-mode-patterns 'calendar-mode '(("[A-Z][a-z]+ [0-9]+" nil define) ; month and year ("S M Tu W Th F S" nil label))) ; week days (hilit-set-mode-patterns 'asm-mode '(("/\\*" "\\*/" comment) ("^#[ \t]*\\(undef\\|define\\).*$" "[^\\]$" define) ("^#.*$" nil include) ;; labels ("^.+:" nil defun) ;; assembler directives ("^[ \t]*\\..*$" nil decl) ;; register names ("\\$[a-z0-9]+" nil string) ;; mnemonics ("^[ \t]*[a-z]+" nil struct))) (hilit-set-mode-patterns 'pascal-mode '(("(\\*" "\\*)" comment) ("{" "}" comment) ;; Doesn't work when there are strings in comments.... ;; ("'[^']*'" nil string) ("^#.*$" nil include) ("^[ \t]*\\(procedure\\|function\\)[ \t]+\\w+[^ \t(;]*" nil defun) ("\\<\\(program\\|begin\\|end\\)\\>" nil defun) ("\\<\\(external\\|forward\\)\\>" nil include) ("\\<\\(label\\|const\\|type\\|var\\)\\>" nil define) ("\\<\\(record\\|array\\|file\\)\\>" nil type) ("\\<\\(of\\|to\\|for\\|if\\|then\\|else\\|case\\|while\\|do\\|until\\|and\\|or\\|not\\|with\\|repeat\\)\\>" nil keyword) ) nil 'case-insensitive) (hilit-set-mode-patterns 'icon-mode '(("#.*$" nil comment) ("\"[^\\\"]*\\(\\\\.[^\\\"]*\\)*\"" nil string) ;; charsets: these do not work because of a conflict with strings ;; ("'[^\\']*\\(\\\\.[^\\']*\\)*'" nil string) ("^[ \t]*procedure[ \t]+\\w+[ \t]*(" ")" defun) ("^[ \t]*record.*(" ")" include) ("^[ \t]*\\(global\\|link\\)[ \t\n]+[A-Za-z_0-9]+\\([ \t\n]*,[ \t\n]*[A-Za-z_0-9]+\\)*" nil include) ("^[ \t]*\\(local\\|static\\)[ \t\n]+[A-Za-z_0-9]+\\([ \t\n]*,[ \t\n]*[A-Za-z_0-9]+\\)*" nil decl) ("\\<\\(initial\\|end\\)\\>" nil glob-struct) ("\\<\\(while\\|until\\|return\\|every\\|if\\|then\\|else\\|to\\|case\\|of\\|suspend\\|create\\|do\\|repeat\\|break\\)\\>" nil keyword) )) ;; as you can see, I had two similar problems for Pascal and Icon. In ;; Pascal, strings are delimited with ' and an embedded quote is doubled, ;; thus string syntax would be extremely simple. However, if a string ;; occurs within a comment, the following text is considered a string. ;; ;; In Icon, strings are similar to C ones, but there are also charsets, ;; delimited with simple quotes. I could not manage to use both regexps at ;; the same time. ;; The problem I have with my patterns for Icon is that this language has a ;; string similar constant to the C one (but a string can be cut on several ;; lines, if terminated by a dash and continued with initial blanks, like ;; this: ;; "This is a somewhat long - ;; string, written on three - ;; succesive lines" ;; in order to insert a double quote in a string, you have to escape it ;; with a \), bu also a character set constant (named a charset), which ;; uses single quotes instead of double ones. It would seem intuitive to ;; highlight both constants in the same way. (provide 'hilit19) ;;; hilit19 ends here. emacs-19.30/lisp/hippie-exp.el100444 12120 1 117303 6040146023 14501 0ustar rmsdaemon;;; hippie-exp.el --- expand text trying various ways to find its expansion. ;; Author: Anders Holst ;; Last change: 6 August 1995 ;; Version: 1.4 ;; Keywords: abbrev ;; Copyright (C) 1992 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: ;; ;; `hippie-expand' is a single function for a lot of different kinds ;; of completions and expansions. Called repeatedly it tries all ;; possible completions in succession. ;; Which kinds of completions to try, and in which order, is ;; determined by the contents of `hippie-expand-try-functions-list'. ;; Much customization of `hippie-expand' can be made by changing the ;; order of, removing, or inserting new functions in this list. ;; Given a positive numeric argument, `hippie-expand' jumps directly ;; ARG functions forward in this list. Given some other argument ;; (a negative argument or just Ctrl-U) it undoes the tried ;; completion. ;; ;; If the variable `hippie-expand-verbose' is non-nil, `hippie-expand' ;; outputs in a message which try-function in the list that is used ;; 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". ;; The variable `hippie-expand-ignore-buffers' is a list of regexps ;; matching buffer names (as strings) or major modes (as atoms) of ;; buffers that should not be searched by the try-functions named ;; "-all-buffers". ;; See also the macro `make-hippie-expand-function' below. ;; ;; A short description of the current try-functions in this file: ;; `try-complete-file-name' : very convenient to have in any buffer, ;; and not just in the minibuffer or (some) shell-mode. It goes ;; through all possible completions instead of just completing as ;; much as is unique. ;; `try-complete-file-name-partially' : To insert in the list just ;; before `try-complete-file-name' for those who want first to get ;; a file name completed only as many characters as is unique. ;; `try-expand-all-abbrevs' : can be removed if you don't use abbrevs. ;; Otherwise it looks through all abbrev-tables, starting with ;; the local followed by the global. ;; `try-expand-line' : Searches the buffer for an entire line that ;; 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). ;; `try-expand-dabbrev-all-buffers' : perhaps the most useful of them, ;; like `dabbrev-expand' but searches all Emacs buffers (except the ;; current) for matching words. (No, I don't find this one ;; particularly slow.) ;; `try-expand-dabbrev-visible': Searches the currently visible parts of ;; all windows. Can be put before `try-expand-dabbrev-all-buffers' to ;; first try the expansions you can see. ;; `try-expand-dabbrev-from-kill': Searches the kill ring for a suitable ;; completion of the word. Good to have, just in case the word was not ;; found elsewhere. ;; `try-expand-whole-kill' : Tries to complete text with a whole entry ;; from the kill ring. May be good if you don't know how far up in ;; the kill-ring the required entry is, and don't want to mess with ;; "Choose Next Paste". ;; `try-complete-lisp-symbol' : like `lisp-complete-symbol', but goes ;; through all possibilities instead of completing what is unique. ;; Might be tedious (usually a lot of possible completions) and ;; since its function is much like `lisp-complete-symbol', which ;; already has a key of its own, you might want to remove this. ;; `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 ;; time the function is called and true in succeeding calls for the ;; same string to complete. The first time the function has to ;; extract the string before point to complete, and substitute the ;; first completion alternative for it. On following calls it has to ;; substitute the next possible completion for the last tried string. ;; The try-function is to return t as long as it finds new ;; possible completions. When there are no more alternatives it has ;; to restore the text before point to its original contents, and ;; return nil (don't beep or message or anything). ;; The try-function can (should) use the following functions: ;; `he-init-string' : Initializes the text to substitute to the ;; contents of the region BEGIN to END. Also sets the variable ;; `he-search-string' to the text to expand. ;; `he-substitute-string' : substitutes STR into the region ;; initialized with `he-init-string'. (An optional second argument ;; TRANS-CASE non-nil, means transfer of case from the abbreviation ;; to the expansion is ok if that is enabled in the buffer.) ;; `he-reset-string' : Resets the initialized region to its original ;; contents. ;; There is also a variable: `he-tried-table' which is meant to contain ;; all tried expansions so far. The try-function can check this ;; variable to see whether an expansion has already been tried ;; (hint: `he-string-member'). ;; ;; Known bugs ;; ;; It may happen that some completion suggestion occurs twice, in ;; spite of the use of `he-tried-table' to prevent that. This is ;; because different try-functions may try to complete different ;; lengths of text, and thus put different amounts of the ;; text in `he-tried-table'. Anyway this seems to occur seldom enough ;; not to be too disturbing. Also it should NOT be possible for the ;; opposite situation to occur, that `hippie-expand' misses some ;; suggestion because it thinks it has already tried it. ;; ;; Acknowledgement ;; ;; I want to thank Mikael Djurfeldt in discussions with whom the idea ;; of this function took form. ;; I am also grateful to all those who have given me suggestions on ;; how to improve it, and all those who helped to find and remove bugs. ;; ;;; Code: (defvar he-num -1) (defvar he-string-beg (make-marker)) (defvar he-string-end (make-marker)) (defvar he-search-string ()) (defvar he-expand-list ()) (defvar he-tried-table ()) (defvar he-search-loc (make-marker)) (defvar he-search-loc2 ()) (defvar he-search-bw ()) (defvar he-search-bufs ()) (defvar he-searched-n-bufs ()) (defvar he-search-window ()) ;;;###autoload (defvar hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially 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.") ;;;###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 (defvar hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode) "*A list specifying which buffers not to search (if not current). Can contain both regexps matching buffer names (as strings) and major modes \(as atoms)") ;;;###autoload (defun hippie-expand (arg) "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." (interactive "P") (if (or (not arg) (and (integerp arg) (> arg 0))) (let ((first (or (= he-num -1) (not (equal this-command last-command))))) (if first (progn (setq he-num -1) (setq he-tried-table nil))) (if arg (if (not first) (he-reset-string)) (setq arg 0)) (let ((i (max (+ he-num arg) 0))) (while (not (or (>= i (length hippie-expand-try-functions-list)) (apply (nth i hippie-expand-try-functions-list) (list (= he-num i))))) (setq i (1+ i))) (setq he-num i)) (if (>= he-num (length hippie-expand-try-functions-list)) (progn (setq he-num -1) (if first (message "No expansion found") (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 hippie-expand-try-functions-list))))))) (if (and (>= he-num 0) (eq (marker-buffer he-string-beg) (current-buffer))) (progn (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))) (goto-char he-string-beg) (insert he-search-string) (delete-region (point) he-string-end) (goto-char newpos))) ;; Substitutes an expansion STR into the correct region (the region ;; initialized with `he-init-string'). ;; An optional argument TRANS-CASE means that it is ok to transfer case ;; from the abbreviation to the expansion if that is possible, and is ;; enabled in the buffer. (defun he-substitute-string (str &optional trans-case) (let ((trans-case (and trans-case case-replace case-fold-search)) (newpos (point-marker)) (subst ())) (goto-char he-string-beg) (setq subst (if trans-case (he-transfer-case he-search-string str) str)) (setq he-tried-table (cons subst he-tried-table)) (insert subst) (delete-region (point) he-string-end) (goto-char newpos))) (defun he-capitalize-first (str) (save-match-data (if (string-match "\\Sw*\\(\\sw\\).*" str) (let ((res (downcase str)) (no (match-beginning 1))) (aset res no (upcase (aref str no))) res) str))) (defun he-ordinary-case-p (str) (or (string= str (downcase str)) (string= str (upcase str)) (string= str (capitalize str)) (string= str (he-capitalize-first str)))) (defun he-transfer-case (from-str to-str) (cond ((string= from-str (substring to-str 0 (min (length from-str) (length to-str)))) to-str) ((not (he-ordinary-case-p to-str)) to-str) ((string= from-str (downcase from-str)) (downcase to-str)) ((string= from-str (upcase from-str)) (upcase to-str)) ((string= from-str (he-capitalize-first from-str)) (he-capitalize-first to-str)) ((string= from-str (capitalize from-str)) (capitalize to-str)) (t to-str))) ;; Check if STR is a member of LST. ;; Transform to the final case if optional TRANS-CASE is non-NIL. (defun he-string-member (str lst &optional trans-case) (if str (member (if (and trans-case case-replace case-fold-search) (he-transfer-case he-search-string str) str) lst))) ;; Check if STR matches any regexp in LST. ;; Ignore possible non-strings in LST. (defun he-regexp-member (str lst) (while (and lst (or (not (stringp (car lst))) (not (string-match (car lst) str)))) (setq lst (cdr lst))) lst) ;; For the real hippie-expand enthusiast: A macro that makes it ;; possible to use many functions like hippie-expand, but with ;; different try-functions-lists. ;; Usage is for example: ;; (fset 'my-complete-file (make-hippie-expand-function ;; '(try-complete-file-name-partially ;; try-complete-file-name))) ;; (fset 'my-complete-line (make-hippie-expand-function ;; '(try-expand-line ;; 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" (mapconcat 'prin1-to-string (eval try-list) ", "))) (interactive "P") (let ((hippie-expand-try-functions-list (, try-list)) (hippie-expand-verbose (, verbose))) (hippie-expand arg)))))) ;;; Here follows the try-functions and their requisites: (defun try-complete-file-name (old) "Try to complete text as a file name. 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." (if (not old) (progn (he-init-string (he-file-name-beg) (point)) (let ((name-part (he-file-name-nondirectory he-search-string)) (dir-part (expand-file-name (or (he-file-name-directory he-search-string) "")))) (if (not (he-string-member name-part he-tried-table)) (setq he-tried-table (cons name-part he-tried-table))) (if (and (not (equal he-search-string "")) (he-file-directory-p dir-part)) (setq he-expand-list (sort (file-name-all-completions name-part dir-part) 'string-lessp)) (setq he-expand-list ()))))) (while (and he-expand-list (he-string-member (car he-expand-list) he-tried-table)) (setq he-expand-list (cdr he-expand-list))) (if (null he-expand-list) (progn (if old (he-reset-string)) ()) (let ((filename (he-concat-directory-file-name (he-file-name-directory he-search-string) (car he-expand-list)))) (he-substitute-string filename) (setq he-tried-table (cons (car he-expand-list) (cdr he-tried-table))) (setq he-expand-list (cdr he-expand-list)) t))) (defun try-complete-file-name-partially (old) "Try to complete text as a file name, as many characters as unique. The argument OLD has to be nil the first call of this function. It returns t if a unique, possibly partial, completion is found, nil otherwise." (let ((expansion ())) (if (not old) (progn (he-init-string (he-file-name-beg) (point)) (let ((name-part (he-file-name-nondirectory he-search-string)) (dir-part (expand-file-name (or (he-file-name-directory he-search-string) "")))) (if (and (not (equal he-search-string "")) (he-file-directory-p dir-part)) (setq expansion (file-name-completion name-part dir-part))) (if (or (eq expansion t) (string= expansion name-part) (he-string-member expansion he-tried-table)) (setq expansion ()))))) (if (not expansion) (progn (if old (he-reset-string)) ()) (let ((filename (he-concat-directory-file-name (he-file-name-directory he-search-string) expansion))) (he-substitute-string filename) (setq he-tried-table (cons expansion (cdr he-tried-table))) t)))) (defvar he-file-name-chars (cond ((memq system-type '(vax-vms axp-vms)) "-a-zA-Z0-9_/.,~^#$+=:\\[\\]") ((memq system-type '(ms-dos ms-windows)) "-a-zA-Z0-9_/.,~^#$+=:\\\\") (t ;; More strange file formats ? "-a-zA-Z0-9_/.,~^#$+=")) "Characters that are considered part of the file name to expand.") (defun he-file-name-beg () (save-excursion (skip-chars-backward he-file-name-chars) (point))) ;; Thanks go to Richard Levitte who helped to make these ;; work under VMS, and to David Hughes who ;; helped to make it work on PC. (defun he-file-name-nondirectory (file) "Fix to make `file-name-nondirectory' work for hippie-expand under VMS." (if (memq system-type '(axp-vms vax-vms)) (let ((n (file-name-nondirectory file))) (if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n) (concat "[." (substring n (match-beginning 2) (match-end 2))) n)) (file-name-nondirectory file))) (defun he-file-name-directory (file) "Fix to make `file-name-directory' work for hippie-expand under VMS." (if (memq system-type '(axp-vms vax-vms)) (let ((n (file-name-nondirectory file)) (d (file-name-directory file))) (if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n) (concat d (substring n (match-beginning 1) (match-end 1)) "]") d)) (file-name-directory file))) (defun he-file-directory-p (file) "Fix to make `file-directory-p' work for hippie-expand under VMS." (if (memq system-type '(vax-vms axp-vms)) (or (file-directory-p file) (file-directory-p (concat file "[000000]"))) (file-directory-p dir-part))) (defun he-concat-directory-file-name (dir-part name-part) "Try to slam together two parts of a file specification, system dependently." (cond ((memq system-type '(axp-vms vax-vms)) (if (and (string= (substring dir-part -1) "]") (string= (substring name-part 0 2) "[.")) (concat (substring dir-part 0 -1) (substring name-part 1)) (concat dir-part name-part))) ((memq system-type '(ms-dos ms-windows)) (if (and (string-match "\\\\" dir-part) (not (string-match "/" dir-part)) (= (aref name-part (1- (length name-part))) ?/)) (aset name-part (1- (length name-part)) ?\\)) (concat dir-part name-part)) (t (concat dir-part name-part)))) (defun try-complete-lisp-symbol (old) "Try to complete word as an Emacs Lisp symbol. 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." (if (not old) (progn (he-init-string (he-lisp-symbol-beg) (point)) (if (not (he-string-member he-search-string he-tried-table)) (setq he-tried-table (cons he-search-string he-tried-table))) (setq he-expand-list (and (not (equal he-search-string "")) (sort (all-completions he-search-string obarray (function (lambda (sym) (or (boundp sym) (fboundp sym) (symbol-plist sym))))) 'string-lessp))))) (while (and he-expand-list (he-string-member (car he-expand-list) he-tried-table)) (setq he-expand-list (cdr he-expand-list))) (if (null he-expand-list) (progn (if old (he-reset-string)) ()) (progn (he-substitute-string (car he-expand-list)) (setq he-expand-list (cdr he-expand-list)) t))) (defun try-complete-lisp-symbol-partially (old) "Try to complete as an Emacs Lisp symbol, as many characters as unique. The argument OLD has to be nil the first call of this function. It returns t if a unique, possibly partial, completion is found, nil otherwise." (let ((expansion ())) (if (not old) (progn (he-init-string (he-lisp-symbol-beg) (point)) (if (not (string= he-search-string "")) (setq expansion (try-completion he-search-string obarray (function (lambda (sym) (or (boundp sym) (fboundp sym) (symbol-plist sym))))))) (if (or (eq expansion t) (string= expansion he-search-string) (he-string-member expansion he-tried-table)) (setq expansion ())))) (if (not expansion) (progn (if old (he-reset-string)) ()) (progn (he-substitute-string expansion) t)))) (defun he-lisp-symbol-beg () (let ((skips "-a-zA-Z0-9_.")) (save-excursion (skip-chars-backward skips) (point)))) (defun try-expand-line (old) "Try to complete the current line to an entire line in the buffer. 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 ()) (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))) (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-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 ()))))) (if (not expansion) ; Then look forward. (progn (goto-char he-search-loc) (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 (he-substitute-string expansion t) t)))) (defun try-expand-line-all-buffers (old) "Try to complete the current line, 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 ()) (strip-prompt (and (get-buffer-process (current-buffer)) comint-prompt-regexp)) (buf (current-buffer)) (orig-case-fold-search case-fold-search)) (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 (memq major-mode hippie-expand-ignore-buffers)) (not (he-regexp-member (buffer-name) hippie-expand-ignore-buffers))) (save-excursion (goto-char he-search-loc) (setq strip-prompt (and (get-buffer-process (current-buffer)) comint-prompt-regexp)) (setq expansion (let ((case-fold-search orig-case-fold-search)) (he-line-search he-search-string strip-prompt nil))) (set-marker he-search-loc (point)) (if (not expansion) (progn (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-line-search (str strip-prompt reverse) (let ((result ())) (while (and (not result) (if reverse (re-search-backward (he-line-search-regexp str strip-prompt) nil t) (re-search-forward (he-line-search-regexp str strip-prompt) nil t))) (setq result (buffer-substring (match-beginning 2) (match-end 2))) (if (he-string-member result he-tried-table t) (setq result nil))) ; if already in table, ignore result)) (defun he-line-beg (strip-prompt) (save-excursion (if (re-search-backward (he-line-search-regexp "" strip-prompt) (save-excursion (beginning-of-line) (point)) t) (match-beginning 2) (point)))) (defun he-line-search-regexp (pat strip-prompt) (if strip-prompt (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\(" (regexp-quote pat) "[^\n]*[^ \t\n]\\)") (concat "^\\(\\s-*\\)\\(" (regexp-quote pat) "[^\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) 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)) (orig-case-fold-search case-fold-search)) (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 (memq major-mode hippie-expand-ignore-buffers)) (not (he-regexp-member (buffer-name) hippie-expand-ignore-buffers))) (save-excursion (goto-char he-search-loc) (setq expansion (let ((case-fold-search orig-case-fold-search)) (he-list-search he-search-string nil))) (set-marker he-search-loc (point)) (if (not expansion) (progn (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 (and reverse (> (point) he-string-beg)) (setq err t)) (if (not err) (progn (setq result (buffer-substring beg (point))) (if (he-string-member result he-tried-table t) (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. The argument OLD has to be nil the first call of this function, and t for subsequent calls (for further possible expansions of the same string). It returns t if a new expansion is found, nil otherwise." (if (not old) (progn (he-init-string (he-dabbrev-beg) (point)) (setq he-expand-list (and (not (equal he-search-string "")) (mapcar (function (lambda (sym) (if (and (boundp sym) (vectorp (eval sym))) (abbrev-expansion (downcase he-search-string) (eval sym))))) (append '(local-abbrev-table global-abbrev-table) abbrev-table-name-list)))))) (while (and he-expand-list (or (not (car he-expand-list)) (he-string-member (car he-expand-list) he-tried-table t))) (setq he-expand-list (cdr he-expand-list))) (if (null he-expand-list) (progn (if old (he-reset-string)) ()) (progn (he-substitute-string (car he-expand-list) t) (setq he-expand-list (cdr he-expand-list)) t))) (defun try-expand-dabbrev (old) "Try to expand word \"dynamically\", searching the current buffer. The argument OLD has to be nil the first call of this function, and t for subsequent calls (for further possible expansions of the same string). It returns t if a new expansion is found, nil otherwise." (let ((expansion ())) (if (not old) (progn (he-init-string (he-dabbrev-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-dabbrev-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-dabbrev-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) t)))) (defun try-expand-dabbrev-all-buffers (old) "Tries to expand word \"dynamically\", 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 expansions of the same string). It returns t if a new expansion is found, nil otherwise." (let ((expansion ()) (buf (current-buffer)) (orig-case-fold-search case-fold-search)) (if (not old) (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 (memq major-mode hippie-expand-ignore-buffers)) (not (he-regexp-member (buffer-name) hippie-expand-ignore-buffers))) (save-excursion (goto-char he-search-loc) (setq expansion (let ((case-fold-search orig-case-fold-search)) (he-dabbrev-search he-search-string nil))) (set-marker he-search-loc (point)) (if (not expansion) (progn (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)))) ;; Thanks go to Jeff Dairiki who ;; suggested this one. (defun try-expand-dabbrev-visible (old) "Try to expand word \"dynamically\", searching visible window parts. The argument OLD has to be nil the first call of this function, and t for subsequent calls (for further possible expansions of the same string). It returns t if a new expansion is found, nil otherwise." (let ((expansion ()) (buf (current-buffer)) (flag (if (frame-visible-p (window-frame (selected-window))) 'visible t))) (if (not old) (progn (he-init-string (he-dabbrev-beg) (point)) (setq he-search-window (selected-window)) (set-marker he-search-loc (window-start he-search-window) (window-buffer he-search-window)))) (while (and (not (equal he-search-string "")) (marker-position he-search-loc) (not expansion)) (save-excursion (set-buffer (marker-buffer he-search-loc)) (goto-char he-search-loc) (setq expansion (he-dabbrev-search he-search-string () (window-end he-search-window))) (if (and expansion (eq (marker-buffer he-string-beg) (current-buffer)) (eq (marker-position he-string-beg) (match-beginning 0))) (setq expansion (he-dabbrev-search he-search-string () (window-end he-search-window)))) (set-marker he-search-loc (point) (current-buffer))) (if (not expansion) (progn (setq he-search-window (next-window he-search-window nil flag)) (if (eq he-search-window (selected-window)) (set-marker he-search-loc nil) (set-marker he-search-loc (window-start he-search-window) (window-buffer he-search-window)))))) (set-buffer buf) (if (not expansion) (progn (if old (he-reset-string)) ()) (progn (he-substitute-string expansion t) t)))) (defun he-dabbrev-search (pattern &optional reverse limit) (let ((result ()) (regpat (if (eq (char-syntax (aref pattern 0)) ?_) (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+") (concat "\\<" (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+")))) (while (and (not result) (if reverse (re-search-backward regpat limit t) (re-search-forward regpat limit t))) (setq result (buffer-substring (match-beginning 0) (match-end 0))) (if (or (and (> (match-beginning 0) (point-min)) (memq (char-syntax (char-after (1- (match-beginning 0)))) '(?_ ?w))) (he-string-member result he-tried-table t)) (setq result nil))) ; ignore if bad prefix or already in table result)) (defvar he-dabbrev-skip-space () "Non-NIL means tolerate trailing spaces in the abbreviation to expand.") (defun he-dabbrev-beg () (let ((op (point))) (save-excursion (if he-dabbrev-skip-space (skip-syntax-backward ". ")) (if (= (skip-syntax-backward "w_") 0) op (point))))) (defun try-expand-dabbrev-from-kill (old) "Try to expand word \"dynamically\", searching the kill ring. 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-dabbrev-beg) (point)) (setq he-expand-list (if (not (equal he-search-string "")) kill-ring)) (setq he-search-loc2 0))) (if (not (equal he-search-string "")) (setq expansion (he-dabbrev-kill-search he-search-string))) (if (not expansion) (progn (if old (he-reset-string)) ()) (progn (he-substitute-string expansion t) t)))) (defun he-dabbrev-kill-search (pattern) (let ((result ()) (regpat (if (eq (char-syntax (aref pattern 0)) ?_) (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+") (concat "\\<" (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+"))) (killstr (car he-expand-list))) (while (and (not result) he-expand-list) (while (and (not result) (string-match regpat killstr he-search-loc2)) (setq result (substring killstr (match-beginning 0) (match-end 0))) (setq he-search-loc2 (1+ (match-beginning 0))) (if (or (and (> (match-beginning 0) 0) (memq (char-syntax (aref killstr (1- (match-beginning 0)))) '(?_ ?w))) (he-string-member result he-tried-table t)) (setq result nil))) ; ignore if bad prefix or already in table (if (and (not result) he-expand-list) (progn (setq he-expand-list (cdr he-expand-list)) (setq killstr (car he-expand-list)) (setq he-search-loc2 0)))) result)) (defun try-expand-whole-kill (old) "Try to complete text with something from the kill ring. 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-kill-beg) (point)) (if (not (he-string-member he-search-string he-tried-table)) (setq he-tried-table (cons he-search-string he-tried-table))) (setq he-expand-list (if (not (equal he-search-string "")) kill-ring)) (setq he-search-loc2 ()))) (if (not (equal he-search-string "")) (setq expansion (he-whole-kill-search he-search-string))) (if (not expansion) (progn (if old (he-reset-string)) ()) (progn (he-substitute-string expansion) t)))) (defun he-whole-kill-search (str) (let ((case-fold-search ()) (result ()) (str (regexp-quote str)) (killstr (car he-expand-list)) (pos -1)) (while (and (not result) he-expand-list) (if (not he-search-loc2) (while (setq pos (string-match str killstr (1+ pos))) (setq he-search-loc2 (cons pos he-search-loc2)))) (while (and (not result) he-search-loc2) (setq pos (car he-search-loc2)) (setq he-search-loc2 (cdr he-search-loc2)) (save-excursion (goto-char he-string-beg) (if (and (>= (- (point) pos) (point-min)) ; avoid some string GC (eq (char-after (- (point) pos)) (aref killstr 0)) (search-backward (substring killstr 0 pos) (- (point) pos) t)) (setq result (substring killstr pos)))) (if (and result (he-string-member result he-tried-table)) (setq result nil))) ; ignore if already in table (if (and (not result) he-expand-list) (progn (setq he-expand-list (cdr he-expand-list)) (setq killstr (car he-expand-list)) (setq pos -1)))) result)) (defun he-kill-beg () (let ((op (point))) (save-excursion (skip-syntax-backward "^w_") (if (= (skip-syntax-backward "w_") 0) op (point))))) (provide 'hippie-exp) ;;; hippie-exp.el ends here emacs-19.30/lisp/holidays.el100444 22346 1 36003 6030150772 15244 0ustar reingolddaemon;;; holidays.el --- holiday functions for the calendar package ;;; Copyright (C) 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: holidays, calendar ;; 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 collection of functions implements the holiday features as described ;; in calendar.el. ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;; Technical details of all the calendrical calculations can be found in ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, ;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990), ;; pages 899-928. ``Calendrical Calculations, Part II: Three Historical ;; Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. Clamen, ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993), ;; pages 383-404. ;; Hard copies of these two papers can be obtained by sending email to ;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and ;; the message BODY containing your mailing address (snail). ;;; Code: (require 'calendar) (autoload 'holiday-julian "cal-julian" "Holiday on MONTH, DAY (Julian) called STRING." t) (autoload 'holiday-hebrew "cal-hebrew" "Holiday on MONTH, DAY (Hebrew) called STRING." t) (autoload 'holiday-rosh-hashanah-etc "cal-hebrew" "List of dates related to Rosh Hashanah, as visible in calendar window." t) (autoload 'holiday-hanukkah "cal-hebrew" "List of dates related to Hanukkah, as visible in calendar window." t) (autoload 'holiday-passover-etc "cal-hebrew" "List of dates related to Passover, as visible in calendar window." t) (autoload 'holiday-tisha-b-av-etc "cal-hebrew" "List of dates around Tisha B'Av, as visible in calendar window." t) (autoload 'holiday-islamic "cal-islamic" "Holiday on MONTH, DAY (Islamic) called STRING." t) (autoload 'holiday-chinese-new-year "cal-chinese" "Date of Chinese New Year." t) (autoload 'solar-equinoxes-solstices "solar" "Date and time of equinoxes and solstices, if visible in the calendar window. Requires floating point." t) (defun holidays (&optional arg) "Display the holidays for last month, this month, and next month. If called with an optional prefix argument, prompts for month and year. This function is suitable for execution in a .emacs file." (interactive "P") (save-excursion (let* ((completion-ignore-case t) (date (if arg (calendar-read-date t) (calendar-current-date))) (displayed-month (extract-calendar-month date)) (displayed-year (extract-calendar-year date))) (list-calendar-holidays)))) (defun check-calendar-holidays (date) "Check the list of holidays for any that occur on DATE. The value returned is a list of strings of relevant holiday descriptions. The holidays are those in the list calendar-holidays." (let* ((displayed-month (extract-calendar-month date)) (displayed-year (extract-calendar-year date)) (h (calendar-holiday-list)) (holiday-list)) (while h (if (calendar-date-equal date (car (car h))) (setq holiday-list (append holiday-list (cdr (car h))))) (setq h (cdr h))) holiday-list)) (defun calendar-cursor-holidays () "Find holidays for the date specified by the cursor in the calendar window." (interactive) (message "Checking holidays...") (let* ((date (calendar-cursor-to-date t)) (date-string (calendar-date-string date)) (holiday-list (check-calendar-holidays date)) (holiday-string (mapconcat 'identity holiday-list "; ")) (msg (format "%s: %s" date-string holiday-string))) (if (not holiday-list) (message "No holidays known for %s" date-string) (if (<= (length msg) (frame-width)) (message msg) (set-buffer (get-buffer-create holiday-buffer)) (setq buffer-read-only nil) (calendar-set-mode-line date-string) (erase-buffer) (insert (mapconcat 'identity holiday-list "\n")) (goto-char (point-min)) (set-buffer-modified-p nil) (setq buffer-read-only t) (display-buffer holiday-buffer) (message "Checking holidays...done"))))) (defun mark-calendar-holidays () "Mark notable days in the calendar window." (interactive) (setq mark-holidays-in-calendar t) (message "Marking holidays...") (let ((holiday-list (calendar-holiday-list))) (while holiday-list (mark-visible-calendar-date (car (car holiday-list)) calendar-holiday-marker) (setq holiday-list (cdr holiday-list)))) (message "Marking holidays...done")) (defun list-calendar-holidays () "Create a buffer containing the holidays for the current calendar window. The holidays are those in the list calendar-notable-days. Returns t if any holidays are found, nil if not." (interactive) (message "Looking up holidays...") (let ((holiday-list (calendar-holiday-list)) (m1 displayed-month) (y1 displayed-year) (m2 displayed-month) (y2 displayed-year)) (if (not holiday-list) (progn (message "Looking up holidays...none found") nil) (set-buffer (get-buffer-create holiday-buffer)) (setq buffer-read-only nil) (increment-calendar-month m1 y1 -1) (increment-calendar-month m2 y2 1) (calendar-set-mode-line (if (= y1 y2) (format "Notable Dates from %s to %s, %d%%-" (calendar-month-name m1) (calendar-month-name m2) y2) (format "Notable Dates from %s, %d to %s, %d%%-" (calendar-month-name m1) y1 (calendar-month-name m2) y2))) (erase-buffer) (insert (mapconcat '(lambda (x) (concat (calendar-date-string (car x)) ": " (car (cdr x)))) holiday-list "\n")) (goto-char (point-min)) (set-buffer-modified-p nil) (setq buffer-read-only t) (display-buffer holiday-buffer) (message "Looking up holidays...done") t))) (defun calendar-holiday-list () "Form the list of holidays that occur on dates in the calendar window. The holidays are those in the list calendar-holidays." (let ((p calendar-holidays) (holiday-list)) (while p (let* ((holidays (if calendar-debug-sexp (let ((stack-trace-on-error t)) (eval (car p))) (condition-case nil (eval (car p)) (error (beep) (message "Bad holiday list item: %s" (car p)) (sleep-for 2)))))) (if holidays (setq holiday-list (append holidays holiday-list)))) (setq p (cdr p))) (setq holiday-list (sort holiday-list 'calendar-date-compare)))) ;; Below are the functions that calculate the dates of holidays; these ;; are eval'ed in the function calendar-holiday-list. If you ;; write other such functions, be sure to imitate the style used below. ;; Remember that each function must return a list of items of the form ;; ((month day year) string) of VISIBLE dates in the calendar window. (defun holiday-fixed (month day string) "Holiday on MONTH, DAY (Gregorian) called STRING. If MONTH, DAY is visible, the value returned is the list (((MONTH DAY year) STRING)). Returns nil if it is not visible in the current calendar window." (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y (- 11 month)) (if (> m 9) (list (list (list month day y) string))))) (defun holiday-float (month dayname n string &optional day) "Holiday on MONTH, DAYNAME (Nth occurrence, Gregorian) called STRING. If the Nth DAYNAME in MONTH is visible, the value returned is the list \(((MONTH DAY year) STRING)). If N<0, count backward from the end of MONTH. An optional parameter DAY means the Nth DAYNAME after/before MONTH DAY. Returns nil if it is not visible in the current calendar window." (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y (- 11 month)) (if (> m 9) (list (list (calendar-nth-named-day n dayname month y day) string))))) (defun holiday-sexp (sexp string) "Sexp holiday for dates in the calendar window. SEXP is an expression in variable `year' evaluates to `date'. STRING is an expression in `date' that evaluates to the holiday description of `date'. If `date' is visible in the calendar window, the holiday STRING is on that date. If date is nil, or if the date is not visible, there is no holiday." (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y -1) (filter-visible-calendar-holidays (append (let* ((year y) (date (eval sexp)) (string (if date (eval string)))) (list (list date string))) (let* ((year (1+ y)) (date (eval sexp)) (string (if date (eval string)))) (list (list date string))))))) (defun holiday-advent () "Date of Advent, if visible in calendar window." (let ((year displayed-year) (month displayed-month)) (increment-calendar-month month year -1) (let ((advent (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 0 (calendar-absolute-from-gregorian (list 12 3 year)))))) (if (calendar-date-is-visible-p advent) (list (list advent "Advent")))))) (defun holiday-easter-etc () "List of dates related to Easter, as visible in calendar window." (if (and (> displayed-month 5) (not all-christian-calendar-holidays)) nil;; Ash Wednesday, Good Friday, and Easter are not visible. (let* ((century (1+ (/ displayed-year 100))) (shifted-epact ;; Age of moon for April 5... (% (+ 14 (* 11 (% displayed-year 19));; ...by Nicaean rule (- ;; ...corrected for the Gregorian century rule (/ (* 3 century) 4)) (/ ;; ...corrected for Metonic cycle inaccuracy. (+ 5 (* 8 century)) 25) (* 30 century));; Keeps value positive. 30)) (adjusted-epact ;; Adjust for 29.5 day month. (if (or (= shifted-epact 0) (and (= shifted-epact 1) (< 10 (% displayed-year 19)))) (1+ shifted-epact) shifted-epact)) (paschal-moon ;; Day after the full moon on or after March 21. (- (calendar-absolute-from-gregorian (list 4 19 displayed-year)) adjusted-epact)) (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7))) (mandatory (list (list (calendar-gregorian-from-absolute abs-easter) "Easter Sunday") (list (calendar-gregorian-from-absolute (- abs-easter 2)) "Good Friday") (list (calendar-gregorian-from-absolute (- abs-easter 46)) "Ash Wednesday"))) (optional (list (list (calendar-gregorian-from-absolute (- abs-easter 63)) "Septuagesima Sunday") (list (calendar-gregorian-from-absolute (- abs-easter 56)) "Sexagesima Sunday") (list (calendar-gregorian-from-absolute (- abs-easter 49)) "Shrove Sunday") (list (calendar-gregorian-from-absolute (- abs-easter 48)) "Shrove Monday") (list (calendar-gregorian-from-absolute (- abs-easter 47)) "Shrove Tuesday") (list (calendar-gregorian-from-absolute (- abs-easter 14)) "Passion Sunday") (list (calendar-gregorian-from-absolute (- abs-easter 7)) "Palm Sunday") (list (calendar-gregorian-from-absolute (- abs-easter 3)) "Maundy Thursday") (list (calendar-gregorian-from-absolute (+ abs-easter 35)) "Rogation Sunday") (list (calendar-gregorian-from-absolute (+ abs-easter 39)) "Ascension Day") (list (calendar-gregorian-from-absolute (+ abs-easter 49)) "Pentecost (Whitsunday)") (list (calendar-gregorian-from-absolute (+ abs-easter 50)) "Whitmunday") (list (calendar-gregorian-from-absolute (+ abs-easter 56)) "Trinity Sunday") (list (calendar-gregorian-from-absolute (+ abs-easter 60)) "Corpus Christi"))) (output-list (filter-visible-calendar-holidays mandatory))) (if all-christian-calendar-holidays (setq output-list (append (filter-visible-calendar-holidays optional) output-list))) output-list))) (defun holiday-greek-orthodox-easter () "Date of Easter according to the rule of the Council of Nicaea." (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y 1) (let* ((julian-year (extract-calendar-year (calendar-julian-from-absolute (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y))))) (shifted-epact ;; Age of moon for April 5. (% (+ 14 (* 11 (% julian-year 19))) 30)) (paschal-moon ;; Day after full moon on or after March 21. (- (calendar-absolute-from-julian (list 4 19 julian-year)) shifted-epact)) (nicaean-easter;; Sunday following the Paschal moon (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 0 (+ paschal-moon 7))))) (if (calendar-date-is-visible-p nicaean-easter) (list (list nicaean-easter "Pascha (Greek Orthodox Easter)")))))) (defun filter-visible-calendar-holidays (l) "Return a list of all visible holidays of those on L." (let ((visible) (p l)) (while p (and (car (car p)) (calendar-date-is-visible-p (car (car p))) (setq visible (append (list (car p)) visible))) (setq p (cdr p))) visible)) (provide 'holidays) ;;; holidays.el ends here emacs-19.30/lisp/icomplete.el100444 12120 1 25301 6045203407 14373 0ustar rmsdaemon;;; icomplete.el --- minibuffer completion incremental feedback ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. ;; Author: Ken Manheimer ;; Maintainer: Ken Manheimer ;; Created: Mar 1993 klm@nist.gov - first release to usenet ;; Keywords: help, abbrev ;; 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: ;;; Loading this package implements a more fine-grained minibuffer ;;; completion feedback scheme. Prospective completions are concisely ;;; indicated within the minibuffer itself, with each successive ;;; keystroke. ;;; See 'icomplete-completions' docstring for a description of the ;;; icomplete display format. ;;; See the `icomplete-minibuffer-setup-hook' docstring for a means to ;;; customize icomplete setup for interoperation with other ;;; minibuffer-oriented packages. ;;; To activate icomplete mode, simply load the package. You can ;;; subsequently deactivate it by invoking the function icomplete-mode ;;; with a negative prefix-arg (C-U -1 ESC-x icomplete-mode). Also, ;;; you can prevent activation of the mode during package load by ;;; first setting the variable `icomplete-mode' to nil. Icompletion ;;; can be enabled any time after the package is loaded by invoking ;;; icomplete-mode without a prefix arg. ;;; Thanks to everyone for their suggestions for refinements of this ;;; package. I particularly have to credit Michael Cook, who ;;; implemented an incremental completion style in his 'iswitch' ;;; functions that served as a model for icomplete. Some other ;;; contributors: Noah Freidman (restructuring as minor mode), Colin ;;; Rafferty (lemacs reconciliation), Lars Lindberg, RMS, and ;;; others. ;;; klm. ;;; Code: ;;;_* Provide (provide 'icomplete) ;;;_* User Customization variables ;;;_* Initialization ;;;_ = icomplete-minibuffer-setup-hook (defvar icomplete-minibuffer-setup-hook nil "*Icomplete-specific customization of minibuffer setup. This hook is run during minibuffer setup iff icomplete will be active. It is intended for use in customizing icomplete for interoperation with other packages. For instance: \(add-hook 'icomplete-minibuffer-setup-hook \(function \(lambda () \(make-local-variable 'resize-minibuffer-window-max-height) \(setq resize-minibuffer-window-max-height 3)))) will constrain rsz-mini to a maximum minibuffer height of 3 lines when icompletion is occurring.") ;;;_ + Internal Variables ;;;_ = icomplete-mode (defvar icomplete-mode t "Non-nil enables incremental minibuffer completion, once `\\[icomplete-mode]' function has set things up.") ;;;_ = icomplete-eoinput 1 (defvar icomplete-eoinput 1 "Point where minibuffer input ends and completion info begins.") (make-variable-buffer-local 'icomplete-eoinput) ;;;_ = icomplete-pre-command-hook (defvar icomplete-pre-command-hook nil "Incremental-minibuffer-completion pre-command-hook. Is run in minibuffer before user input when `icomplete-mode' is non-nil. Use `icomplete-mode' function to set it up properly for incremental minibuffer completion.") (add-hook 'icomplete-pre-command-hook 'icomplete-tidy) ;;;_ = icomplete-post-command-hook (defvar icomplete-post-command-hook nil "Incremental-minibuffer-completion post-command-hook. Is run in minibuffer after user input when `icomplete-mode' is non-nil. Use `icomplete-mode' function to set it up properly for incremental minibuffer completion.") (add-hook 'icomplete-post-command-hook 'icomplete-exhibit) ;;;_ > icomplete-mode (&optional prefix) ;;;###autoload (defun icomplete-mode (&optional prefix) "Activate incremental minibuffer completion for this emacs session, or deactivate with negative prefix arg." (interactive "p") (or prefix (setq prefix 0)) (cond ((>= prefix 0) (setq icomplete-mode t) ;; The following is not really necessary after first time - ;; no great loss. (add-hook 'minibuffer-setup-hook 'icomplete-minibuffer-setup)) (t (setq icomplete-mode nil)))) ;;;_ > icomplete-simple-completing-p () (defun icomplete-simple-completing-p () "Non-nil if current window is minibuffer that's doing simple completion. Conditions are: the selected window is a minibuffer, and not in the middle of macro execution, and minibuffer-completion-table is not a symbol (which would indicate some non-standard, non-simple completion mechansm, like file-name and other custom-func completions)." (and (window-minibuffer-p (selected-window)) (not executing-macro) (not (symbolp minibuffer-completion-table)))) ;;;_ > icomplete-minibuffer-setup () ;;;###autoload (defun icomplete-minibuffer-setup () "Run in minibuffer on activation to establish incremental completion. Usually run by inclusion in `minibuffer-setup-hook'." (cond ((and icomplete-mode (icomplete-simple-completing-p)) (make-local-hook 'pre-command-hook) (add-hook 'pre-command-hook (function (lambda () (run-hooks 'icomplete-pre-command-hook))) nil t) (make-local-hook 'post-command-hook) (add-hook 'post-command-hook (function (lambda () (run-hooks 'icomplete-post-command-hook))) nil t) (run-hooks 'icomplete-minibuffer-setup-hook)))) ;;;_* Completion ;;;_ > icomplete-tidy () (defun icomplete-tidy () "Remove completions display \(if any) prior to new user input. Should be run in on the minibuffer `pre-command-hook'. See `icomplete-mode' and `minibuffer-setup-hook'." (if (icomplete-simple-completing-p) (if (and (boundp 'icomplete-eoinput) icomplete-eoinput) (if (> icomplete-eoinput (point-max)) ;; Oops, got rug pulled out from under us - reinit: (setq icomplete-eoinput (point-max)) (let ((buffer-undo-list buffer-undo-list )) ; prevent entry (delete-region icomplete-eoinput (point-max)))) ;; Reestablish the local variable 'cause minibuffer-setup is weird: (make-local-variable 'icomplete-eoinput) (setq icomplete-eoinput 1)))) ;;;_ > icomplete-exhibit () (defun icomplete-exhibit () "Insert icomplete completions display. Should be run via minibuffer `post-command-hook'. See `icomplete-mode' and `minibuffer-setup-hook'." (if (icomplete-simple-completing-p) (let ((contents (buffer-substring (point-min)(point-max))) (buffer-undo-list t)) (save-excursion (goto-char (point-max)) ; Register the end of input, so we ; know where the extra stuff ; (match-status info) begins: (if (not (boundp 'icomplete-eoinput)) ;; In case it got wiped out by major mode business: (make-local-variable 'icomplete-eoinput)) (setq icomplete-eoinput (point)) ; Insert the match-status information: (if (> (point-max) 1) (insert-string (icomplete-completions contents minibuffer-completion-table minibuffer-completion-predicate (not minibuffer-completion-confirm)))))))) ;;;_ > icomplete-completions (name candidates predicate require-match) (defun icomplete-completions (name candidates predicate require-match) "Identify prospective candidates for minibuffer completion. The display is updated with each minibuffer keystroke during minibuffer completion. Prospective completion suffixes (if any) are displayed, bracketed by one of \(), \[], or \{} pairs. The choice of brackets is as follows: \(...) - a single prospect is identified and matching is enforced, \[...] - a single prospect is identified but matching is optional, or \{...} - multiple prospects, separated by commas, are indicated, and further input is required to distingish a single one. The displays for disambiguous matches have ` [Matched]' appended \(whether complete or not), or ` \[No matches]', if no eligible matches exist." (let ((comps (all-completions name candidates predicate)) ; "-determined" - only one candidate (open-bracket-determined (if require-match "(" "[")) (close-bracket-determined (if require-match ")" "]")) ;"-prospects" - more than one candidate (open-bracket-prospects "{") (close-bracket-prospects "}") ) (cond ((null comps) (format " %sNo matches%s" open-bracket-determined close-bracket-determined)) ((null (cdr comps)) ;one match (concat (if (and (> (length (car comps)) (length name))) (concat open-bracket-determined (substring (car comps) (length name)) close-bracket-determined) "") " [Matched]")) (t ;multiple matches (let* ((most (try-completion name candidates predicate)) (most-len (length most)) most-is-exact (alternatives (apply (function concat) (cdr (apply (function nconc) (mapcar '(lambda (com) (if (= (length com) most-len) ;; Most is one exact match, ;; note that and leave out ;; for later indication: (progn (setq most-is-exact t) ()) (list "," (substring com most-len)))) comps)))))) (concat (and (> most-len (length name)) (concat open-bracket-determined (substring most (length name)) close-bracket-determined)) open-bracket-prospects (if most-is-exact (concat "," alternatives) alternatives) close-bracket-prospects)))))) ;;;_ + Initialization ;;; If user hasn't setq-default icomplete-mode to nil, then setup for ;;; activation: (if icomplete-mode (icomplete-mode)) ;;;_* Local emacs vars. ;;;Local variables: ;;;outline-layout: (-2 :) ;;;End: ;;; icomplete.el ends here emacs-19.30/lisp/icon.el100444 12120 1 47370 6016114207 13351 0ustar rmsdaemon;;; icon.el --- mode for editing Icon code ;; Copyright (C) 1989 Free Software Foundation, Inc. ;; Author: Chris Smith ;; Created: 15 Feb 89 ;; Keywords: languages ;; 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: ;; A major mode for editing the Icon programming language. ;;; Code: (defvar icon-mode-abbrev-table nil "Abbrev table in use in Icon-mode buffers.") (define-abbrev-table 'icon-mode-abbrev-table ()) (defvar icon-mode-map () "Keymap used in Icon mode.") (if icon-mode-map () (setq icon-mode-map (make-sparse-keymap)) (define-key icon-mode-map "{" 'electric-icon-brace) (define-key icon-mode-map "}" 'electric-icon-brace) (define-key icon-mode-map "\e\C-h" 'mark-icon-function) (define-key icon-mode-map "\e\C-a" 'beginning-of-icon-defun) (define-key icon-mode-map "\e\C-e" 'end-of-icon-defun) (define-key icon-mode-map "\e\C-q" 'indent-icon-exp) (define-key icon-mode-map "\177" 'backward-delete-char-untabify) (define-key icon-mode-map "\t" 'icon-indent-command)) (defvar icon-mode-syntax-table nil "Syntax table in use in Icon-mode buffers.") (if icon-mode-syntax-table () (setq icon-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?\\ "\\" icon-mode-syntax-table) (modify-syntax-entry ?# "<" icon-mode-syntax-table) (modify-syntax-entry ?\n ">" icon-mode-syntax-table) (modify-syntax-entry ?$ "." icon-mode-syntax-table) (modify-syntax-entry ?/ "." icon-mode-syntax-table) (modify-syntax-entry ?* "." icon-mode-syntax-table) (modify-syntax-entry ?+ "." icon-mode-syntax-table) (modify-syntax-entry ?- "." icon-mode-syntax-table) (modify-syntax-entry ?= "." icon-mode-syntax-table) (modify-syntax-entry ?% "." icon-mode-syntax-table) (modify-syntax-entry ?< "." icon-mode-syntax-table) (modify-syntax-entry ?> "." icon-mode-syntax-table) (modify-syntax-entry ?& "." icon-mode-syntax-table) (modify-syntax-entry ?| "." icon-mode-syntax-table) (modify-syntax-entry ?\' "\"" icon-mode-syntax-table)) (defvar icon-indent-level 4 "*Indentation of Icon statements with respect to containing block.") (defvar icon-brace-imaginary-offset 0 "*Imagined indentation of a Icon open brace that actually follows a statement.") (defvar icon-brace-offset 0 "*Extra indentation for braces, compared with other text in same context.") (defvar icon-continued-statement-offset 4 "*Extra indent for lines not starting new statements.") (defvar icon-continued-brace-offset 0 "*Extra indent for substatements that start with open-braces. This is in addition to icon-continued-statement-offset.") (defvar icon-auto-newline nil "*Non-nil means automatically newline before and after braces inserted in Icon code.") (defvar icon-tab-always-indent t "*Non-nil means TAB in Icon mode should always reindent the current line, regardless of where in the line point is when the TAB command is used.") ;;;###autoload (defun icon-mode () "Major mode for editing Icon code. Expression and list commands understand all Icon brackets. Tab indents for Icon code. Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \\{icon-mode-map} Variables controlling indentation style: icon-tab-always-indent Non-nil means TAB in Icon mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. icon-auto-newline Non-nil means automatically newline before and after braces inserted in Icon code. icon-indent-level Indentation of Icon statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. icon-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. icon-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to `icon-continued-statement-offset'. icon-brace-offset Extra indentation for line if it starts with an open brace. icon-brace-imaginary-offset An open brace following other text is treated as if it were this far to the right of the start of its line. Turning on Icon mode calls the value of the variable `icon-mode-hook' with no args, if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map icon-mode-map) (setq major-mode 'icon-mode) (setq mode-name "Icon") (setq local-abbrev-table icon-mode-abbrev-table) (set-syntax-table icon-mode-syntax-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'indent-line-function) (setq indent-line-function 'icon-indent-line) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'comment-start) (setq comment-start "# ") (make-local-variable 'comment-end) (setq comment-end "") (make-local-variable 'comment-column) (setq comment-column 32) (make-local-variable 'comment-start-skip) (setq comment-start-skip "# *") (make-local-variable 'comment-indent-function) (setq comment-indent-function 'icon-comment-indent) (run-hooks 'icon-mode-hook)) ;; This is used by indent-for-comment to decide how much to ;; indent a comment in Icon code based on its context. (defun icon-comment-indent () (if (looking-at "^#") 0 (save-excursion (skip-chars-backward " \t") (max (if (bolp) 0 (1+ (current-column))) comment-column)))) (defun electric-icon-brace (arg) "Insert character and correct line's indentation." (interactive "P") (let (insertpos) (if (and (not arg) (eolp) (or (save-excursion (skip-chars-backward " \t") (bolp)) (if icon-auto-newline (progn (icon-indent-line) (newline) t) nil))) (progn (insert last-command-char) (icon-indent-line) (if icon-auto-newline (progn (newline) ;; (newline) may have done auto-fill (setq insertpos (- (point) 2)) (icon-indent-line))) (save-excursion (if insertpos (goto-char (1+ insertpos))) (delete-char -1)))) (if insertpos (save-excursion (goto-char insertpos) (self-insert-command (prefix-numeric-value arg))) (self-insert-command (prefix-numeric-value arg))))) (defun icon-indent-command (&optional whole-exp) (interactive "P") "Indent current line as Icon code, or in some cases insert a tab character. If `icon-tab-always-indent' is non-nil (the default), always indent current line. Otherwise, indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. A numeric argument, regardless of its value, means indent rigidly all the lines of the expression starting after point so that this line becomes properly indented. The relative indentation among the lines of the expression are preserved." (if whole-exp ;; If arg, always indent this line as Icon ;; and shift remaining lines of expression the same amount. (let ((shift-amt (icon-indent-line)) beg end) (save-excursion (if icon-tab-always-indent (beginning-of-line)) (setq beg (point)) (forward-sexp 1) (setq end (point)) (goto-char beg) (forward-line 1) (setq beg (point))) (if (> end beg) (indent-code-rigidly beg end shift-amt "#"))) (if (and (not icon-tab-always-indent) (save-excursion (skip-chars-backward " \t") (not (bolp)))) (insert-tab) (icon-indent-line)))) (defun icon-indent-line () "Indent current line as Icon code. Return the amount the indentation changed by." (let ((indent (calculate-icon-indent nil)) beg shift-amt (case-fold-search nil) (pos (- (point-max) (point)))) (beginning-of-line) (setq beg (point)) (cond ((eq indent nil) (setq indent (current-indentation))) ((eq indent t) (setq indent (calculate-icon-indent-within-comment))) ((looking-at "[ \t]*#") (setq indent 0)) (t (skip-chars-forward " \t") (if (listp indent) (setq indent (car indent))) (cond ((and (looking-at "else\\b") (not (looking-at "else\\s_"))) (setq indent (save-excursion (icon-backward-to-start-of-if) (current-indentation)))) ((or (= (following-char) ?}) (looking-at "end\\b")) (setq indent (- indent icon-indent-level))) ((= (following-char) ?{) (setq indent (+ indent icon-brace-offset)))))) (skip-chars-forward " \t") (setq shift-amt (- indent (current-column))) (if (zerop shift-amt) (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) (delete-region beg (point)) (indent-to indent) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos)))) shift-amt)) (defun calculate-icon-indent (&optional parse-start) "Return appropriate indentation for current line as Icon code. In usual case returns an integer: the column to indent to. Returns nil if line starts inside a string, t if in a comment." (save-excursion (beginning-of-line) (let ((indent-point (point)) (case-fold-search nil) state containing-sexp toplevel) (if parse-start (goto-char parse-start) (setq toplevel (beginning-of-icon-defun))) (while (< (point) indent-point) (setq parse-start (point)) (setq state (parse-partial-sexp (point) indent-point 0)) (setq containing-sexp (car (cdr state)))) (cond ((or (nth 3 state) (nth 4 state)) ;; return nil or t if should not change this line (nth 4 state)) ((and containing-sexp (/= (char-after containing-sexp) ?{)) ;; line is expression, not statement: ;; indent to just after the surrounding open. (goto-char (1+ containing-sexp)) (current-column)) (t (if toplevel ;; Outside any procedures. (progn (icon-backward-to-noncomment (point-min)) (if (icon-is-continuation-line) icon-continued-statement-offset 0)) ;; Statement level. (if (null containing-sexp) (progn (beginning-of-icon-defun) (setq containing-sexp (point)))) (goto-char indent-point) ;; Is it a continuation or a new statement? ;; Find previous non-comment character. (icon-backward-to-noncomment containing-sexp) ;; Now we get the answer. (if (icon-is-continuation-line) ;; This line is continuation of preceding line's statement; ;; indent icon-continued-statement-offset more than the ;; first line of the statement. (progn (icon-backward-to-start-of-continued-exp containing-sexp) (+ icon-continued-statement-offset (current-column) (if (save-excursion (goto-char indent-point) (skip-chars-forward " \t") (eq (following-char) ?{)) icon-continued-brace-offset 0))) ;; This line starts a new statement. ;; Position following last unclosed open. (goto-char containing-sexp) ;; Is line first statement after an open-brace? (or ;; If no, find that first statement and indent like it. (save-excursion (if (looking-at "procedure\\s ") (forward-sexp 3) (forward-char 1)) (while (progn (skip-chars-forward " \t\n") (looking-at "#")) ;; Skip over comments following openbrace. (forward-line 1)) ;; The first following code counts ;; if it is before the line we want to indent. (and (< (point) indent-point) (current-column))) ;; If no previous statement, ;; indent it relative to line brace is on. ;; For open brace in column zero, don't let statement ;; start there too. If icon-indent-level is zero, ;; use icon-brace-offset + icon-continued-statement-offset ;; instead. ;; For open-braces not the first thing in a line, ;; add in icon-brace-imaginary-offset. (+ (if (and (bolp) (zerop icon-indent-level)) (+ icon-brace-offset icon-continued-statement-offset) icon-indent-level) ;; Move back over whitespace before the openbrace. ;; If openbrace is not first nonwhite thing on the line, ;; add the icon-brace-imaginary-offset. (progn (skip-chars-backward " \t") (if (bolp) 0 icon-brace-imaginary-offset)) ;; Get initial indentation of the line we are on. (current-indentation)))))))))) ;; List of words to check for as the last thing on a line. ;; If cdr is t, next line is a continuation of the same statement, ;; if cdr is nil, next line starts a new (possibly indented) statement. (defconst icon-resword-alist '(("by" . t) ("case" . t) ("create") ("do") ("dynamic" . t) ("else") ("every" . t) ("if" . t) ("global" . t) ("initial" . t) ("link" . t) ("local" . t) ("of") ("record" . t) ("repeat" . t) ("static" . t) ("then") ("to" . t) ("until" . t) ("while" . t))) (defun icon-is-continuation-line () (let* ((ch (preceding-char)) (ch-syntax (char-syntax ch))) (if (eq ch-syntax ?w) (assoc (buffer-substring (progn (forward-word -1) (point)) (progn (forward-word 1) (point))) icon-resword-alist) (not (memq ch '(0 ?\; ?\} ?\{ ?\) ?\] ?\" ?\' ?\n)))))) (defun icon-backward-to-noncomment (lim) (let (opoint stop) (while (not stop) (skip-chars-backward " \t\n\f" lim) (setq opoint (point)) (beginning-of-line) (if (and (nth 5 (parse-partial-sexp (point) opoint)) (< lim (point))) (search-backward "#") (setq stop t))))) (defun icon-backward-to-start-of-continued-exp (lim) (if (memq (preceding-char) '(?\) ?\])) (forward-sexp -1)) (beginning-of-line) (skip-chars-forward " \t") (cond ((<= (point) lim) (goto-char (1+ lim))) ((not (icon-is-continued-line)) 0) ((and (eq (char-syntax (following-char)) ?w) (cdr (assoc (buffer-substring (point) (save-excursion (forward-word 1) (point))) icon-resword-alist))) 0) (t (end-of-line 0) (icon-backward-to-start-of-continued-exp lim)))) (defun icon-is-continued-line () (save-excursion (end-of-line 0) (icon-is-continuation-line))) (defun icon-backward-to-start-of-if (&optional limit) "Move to the start of the last \"unbalanced\" if." (or limit (setq limit (save-excursion (beginning-of-icon-defun) (point)))) (let ((if-level 1) (case-fold-search nil)) (while (not (zerop if-level)) (backward-sexp 1) (cond ((looking-at "else\\b") (setq if-level (1+ if-level))) ((looking-at "if\\b") (setq if-level (1- if-level))) ((< (point) limit) (setq if-level 0) (goto-char limit)))))) (defun mark-icon-function () "Put mark at end of Icon function, point at beginning." (interactive) (push-mark (point)) (end-of-icon-defun) (push-mark (point)) (beginning-of-line 0) (beginning-of-icon-defun)) (defun beginning-of-icon-defun () "Go to the start of the enclosing procedure; return t if at top level." (interactive) (if (re-search-backward "^procedure\\s \\|^end[ \t\n]" (point-min) 'move) (looking-at "e") t)) (defun end-of-icon-defun () (interactive) (if (not (bobp)) (forward-char -1)) (re-search-forward "\\(\\s \\|^\\)end\\(\\s \\|$\\)" (point-max) 'move) (forward-word -1) (forward-line 1)) (defun indent-icon-exp () "Indent each line of the Icon grouping following point." (interactive) (let ((indent-stack (list nil)) (contain-stack (list (point))) (case-fold-search nil) restart outer-loop-done inner-loop-done state ostate this-indent last-sexp at-else at-brace at-do (opoint (point)) (next-depth 0)) (save-excursion (forward-sexp 1)) (save-excursion (setq outer-loop-done nil) (while (and (not (eobp)) (not outer-loop-done)) (setq last-depth next-depth) ;; Compute how depth changes over this line ;; plus enough other lines to get to one that ;; does not end inside a comment or string. ;; Meanwhile, do appropriate indentation on comment lines. (setq innerloop-done nil) (while (and (not innerloop-done) (not (and (eobp) (setq outer-loop-done t)))) (setq ostate state) (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) nil nil state)) (setq next-depth (car state)) (if (and (car (cdr (cdr state))) (>= (car (cdr (cdr state))) 0)) (setq last-sexp (car (cdr (cdr state))))) (if (or (nth 4 ostate)) (icon-indent-line)) (if (or (nth 3 state)) (forward-line 1) (setq innerloop-done t))) (if (<= next-depth 0) (setq outer-loop-done t)) (if outer-loop-done nil (if (/= last-depth next-depth) (setq last-sexp nil)) (while (> last-depth next-depth) (setq indent-stack (cdr indent-stack) contain-stack (cdr contain-stack) last-depth (1- last-depth))) (while (< last-depth next-depth) (setq indent-stack (cons nil indent-stack) contain-stack (cons nil contain-stack) last-depth (1+ last-depth))) (if (null (car contain-stack)) (setcar contain-stack (or (car (cdr state)) (save-excursion (forward-sexp -1) (point))))) (forward-line 1) (skip-chars-forward " \t") (if (eolp) nil (if (and (car indent-stack) (>= (car indent-stack) 0)) ;; Line is on an existing nesting level. ;; Lines inside parens are handled specially. (if (/= (char-after (car contain-stack)) ?{) (setq this-indent (car indent-stack)) ;; Line is at statement level. ;; Is it a new statement? Is it an else? ;; Find last non-comment character before this line (save-excursion (setq at-else (looking-at "else\\W")) (setq at-brace (= (following-char) ?{)) (icon-backward-to-noncomment opoint) (if (icon-is-continuation-line) ;; Preceding line did not end in comma or semi; ;; indent this line icon-continued-statement-offset ;; more than previous. (progn (icon-backward-to-start-of-continued-exp (car contain-stack)) (setq this-indent (+ icon-continued-statement-offset (current-column) (if at-brace icon-continued-brace-offset 0)))) ;; Preceding line ended in comma or semi; ;; use the standard indent for this level. (if at-else (progn (icon-backward-to-start-of-if opoint) (setq this-indent (current-indentation))) (setq this-indent (car indent-stack)))))) ;; Just started a new nesting level. ;; Compute the standard indent for this level. (let ((val (calculate-icon-indent (if (car indent-stack) (- (car indent-stack)))))) (setcar indent-stack (setq this-indent val)))) ;; Adjust line indentation according to its contents (if (or (= (following-char) ?}) (looking-at "end\\b")) (setq this-indent (- this-indent icon-indent-level))) (if (= (following-char) ?{) (setq this-indent (+ this-indent icon-brace-offset))) ;; Put chosen indentation into effect. (or (= (current-column) this-indent) (progn (delete-region (point) (progn (beginning-of-line) (point))) (indent-to this-indent))) ;; Indent any comment following the text. (or (looking-at comment-start-skip) (if (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t) (progn (indent-for-comment) (beginning-of-line)))))))))) ;;; icon.el ends here emacs-19.30/lisp/ielm.el100444 12120 1 41576 5774631621 13367 0ustar rmsdaemon;;; ielm.el --- interaction mode for Emacs Lisp ;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Author: David Smith ;; Created: 25 Feb 1994 ;; Keywords: lisp ;; 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: ;; Provides a nice interface to evaluating Emacs Lisp expressions. ;; Input is handled by the comint package, and output is passed ;; through the pretty-printer. ;; To install: copy this file to a directory in your load-path, and ;; add the following line to your .emacs file: ;; ;; (autoload 'ielm "ielm" "Start an inferior Emacs Lisp session" t) ;; ;; For completion to work, the comint.el from FSF Emacs 19.23 is ;; required. If you do not have it, or if you are running Lemacs, ;; also add the following code to your .emacs: ;; ;; (setq ielm-mode-hook ;; '(lambda nil ;; (define-key ielm-map "\t" ;; '(lambda nil (interactive) (or (ielm-tab) ;; (lisp-complete-symbol)))))) ;; To start: M-x ielm. Type C-h m in the *ielm* buffer for more info. ;; The latest version is available by WWW from ;; http://mathssun5.lancs.ac.uk:2080/~maa036/elisp/dir.html ;; or by anonymous FTP from ;; /anonymous@wingra.stat.wisc.edu:pub/src/emacs-lisp/ielm.el.gz ;; or from the author: David M. Smith ;;; Code: (require 'comint) (require 'pp) ;;; User variables (defvar ielm-noisy t "*If non-nil, IELM will beep on error.") (defvar ielm-prompt "ELISP> " "Prompt used in IELM.") (defvar ielm-dynamic-return t "*Controls whether \\\\[ielm-return] has intelligent behaviour in IELM. If non-nil, \\[ielm-return] evaluates input for complete sexps, or inserts a newline and indents for incomplete sexps. If nil, always inserts newlines.") (defvar ielm-dynamic-multiline-inputs t "*Force multiline inputs to start from column zero? If non-nil, after entering the first line of an incomplete sexp, a newline will be inserted after the prompt, moving the input to the next line. This gives more frame width for large indented sexps, and allows functions such as `edebug-defun' to work with such inputs.") (defvar ielm-mode-hook nil "*Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started.") ;;; System variables (defvar ielm-working-buffer nil "Buffer in which IELM sexps will be evaluated. This variable is buffer-local.") (defvar ielm-header (concat "*** Welcome to IELM version " (substring "$Revision: 1.5 $" 11 -2) " *** Type (describe-mode) for help.\n" "IELM has ABSOLUTELY NO WARRANTY; type (describe-no-warranty) for details.\n") "Message to display when IELM is started.") (defvar ielm-map nil) (if ielm-map nil (if (string-match "Lucid" emacs-version) ;; Lemacs (progn (setq ielm-map (make-sparse-keymap)) (set-keymap-parent ielm-map comint-mode-map)) ;; FSF (setq ielm-map (cons 'keymap comint-mode-map))) (define-key ielm-map "\t" 'comint-dynamic-complete) (define-key ielm-map "\C-m" 'ielm-return) (define-key ielm-map "\C-j" 'ielm-send-input) (define-key ielm-map "\e\C-x" 'eval-defun) ; for consistency with (define-key ielm-map "\e\t" 'lisp-complete-symbol) ; lisp-interaction-mode ;; These bindings are from shared-lisp-mode-map -- can you inherit ;; from more than one keymap?? (define-key ielm-map "\e\C-q" 'indent-sexp) (define-key ielm-map "\eq" 'lisp-fill-paragraph) (define-key ielm-map "\177" 'backward-delete-char-untabify) ;; Some convenience bindings for setting the working buffer (define-key ielm-map "\C-c\C-b" 'ielm-change-working-buffer) (define-key ielm-map "\C-c\C-f" 'ielm-display-working-buffer) (define-key ielm-map "\C-c\C-v" 'ielm-print-working-buffer)) (defvar ielm-font-lock-keywords (list (cons (concat "^" (regexp-quote ielm-prompt)) 'font-lock-keyword-face) '("\\(^\\*\\*\\*[^*]+\\*\\*\\*\\)\\(.*$\\)" (1 font-lock-comment-face) (2 font-lock-reference-face))) "Additional expressions to highlight in ielm buffers.") ;;; Completion stuff (defun ielm-tab nil "Possibly indent the current line as lisp code." (interactive) (if (or (eq (preceding-char) ?\n) (eq (char-syntax (preceding-char)) ? )) (progn (ielm-indent-line) t))) (defun ielm-complete-symbol nil "Complete the lisp symbol before point." ;; A wrapper for lisp-complete symbol that returns non-nil if ;; completion has occurred (let* ((btick (buffer-modified-tick)) (cbuffer (get-buffer "*Completions*")) (ctick (and cbuffer (buffer-modified-tick cbuffer)))) (lisp-complete-symbol) ;; completion has occurred if: (or ;; the buffer has been modified (not (= btick (buffer-modified-tick))) ;; a completions buffer has been modifed or created (if cbuffer (not (= ctick (buffer-modified-tick cbuffer))) (get-buffer "*Completions*"))))) (defun ielm-complete-filename nil "Dynamically complete filename before point, if in a string." (if (nth 3 (parse-partial-sexp comint-last-input-start (point))) (comint-dynamic-complete-filename))) (defun ielm-indent-line nil "Indent the current line as Lisp code if it is not a prompt line." (if (save-excursion (beginning-of-line) (looking-at comint-prompt-regexp)) nil (lisp-indent-line))) ;;; Working buffer manipulation (defun ielm-print-working-buffer nil "Print the current IELM working buffer's name in the echo area." (interactive) (message "The current working buffer is: %s" (buffer-name ielm-working-buffer))) (defun ielm-display-working-buffer nil "Display the current IELM working buffer. Don't forget that selecting that buffer will change its value of `point' to its value of `window-point'!" (interactive) (display-buffer ielm-working-buffer) (ielm-print-working-buffer)) (defun ielm-change-working-buffer (buf) "Change the current IELM working buffer to BUF. This is the buffer in which all sexps entered at the IELM prompt are evaluated. You can achieve the same effect with a call to `set-buffer' at the IELM prompt." (interactive "bSet working buffer to: ") (setq ielm-working-buffer (or (get-buffer buf) (error "No such buffer"))) (ielm-print-working-buffer)) ;;; Other bindings (defun ielm-return nil "Newline and indent, or evaluate the sexp before the prompt. Complete sexps are evaluated; for incomplete sexps inserts a newline and indents. If however `ielm-dynamic-return' is nil, this always simply inserts a newline." (interactive) (if ielm-dynamic-return (let ((state (save-excursion (end-of-line) (parse-partial-sexp (ielm-pm) (point))))) (if (and (< (car state) 1) (not (nth 3 state))) (ielm-send-input) (if (and ielm-dynamic-multiline-inputs (save-excursion (beginning-of-line) (looking-at comint-prompt-regexp))) (save-excursion (goto-char (ielm-pm)) (newline 1))) (newline-and-indent))) (newline))) (defun ielm-input-sender (proc input) ;; Just sets the variable ielm-input, which is in the scope of ;; `ielm-send-input's call. (setq ielm-input input)) (defun ielm-send-input nil "Evaluate the Emacs Lisp expression after the prompt." (interactive) (let ((buf (current-buffer)) ielm-input) ; set by ielm-input-sender (comint-send-input) ; update history, markers etc. (ielm-eval-input ielm-input))) ;;; Utility functions (defun ielm-is-whitespace (string) "Return non-nil if STRING is all whitespace." (or (string= string "") (string-match "\\`[ \t\n]+\\'" string))) (defun ielm-format-errors (errlist) (let ((result "")) (while errlist (setq result (concat result (prin1-to-string (car errlist)) ", ")) (setq errlist (cdr errlist))) (substring result 0 -2))) (defun ielm-format-error (err) ;; Return a string form of the error ERR. (format "%s%s" (or (get (car err) 'error-message) "Peculiar error") (if (cdr err) (format ": %s" (ielm-format-errors (cdr err))) ""))) ;;; Evaluation (defun ielm-eval-input (ielm-string) "Evaluate the Lisp expression IELM-STRING, and pretty-print the result." ;; This is the function that actually `sends' the input to the ;; `inferior Lisp process'. All comint-send-input does is works out ;; what that input is. What this function does is evaluates that ;; input and produces `output' which gets inserted into the buffer, ;; along with a new prompt. A better way of doing this might have ;; been to actually send the output to the `cat' process, and write ;; this as in output filter that converted sexps in the output ;; stream to their evaluated value. But that would have involved ;; more process coordination than I was happy to deal with. ;; ;; NOTE: all temporary variables in this function will be in scope ;; during the eval, and so need to have non-clashing names. (let (ielm-form ; form to evaluate ielm-pos ; End posn of parse in string ielm-result ; Result, or error message ielm-error-type ; string, nil if no error (ielm-output "") ; result to display (ielm-wbuf ielm-working-buffer) ; current buffer after evaluation (ielm-pmark (ielm-pm))) (if (not (ielm-is-whitespace ielm-string)) (progn (condition-case err (let (rout) (setq rout (read-from-string ielm-string)) (setq ielm-form (car rout)) (setq ielm-pos (cdr rout))) (error (setq ielm-result (ielm-format-error err)) (setq ielm-error-type "Read error"))) (if ielm-error-type nil ;; Make sure working buffer has not been killed (if (not (buffer-name ielm-working-buffer)) (setq ielm-result "Working buffer has been killed" ielm-error-type "IELM Error" ielm-wbuf (current-buffer)) (if (ielm-is-whitespace (substring ielm-string ielm-pos)) ;; need this awful let convolution to work around ;; an Emacs bug involving local vbls and let binding (let ((:save :) (::save ::) (:::save :::)) (save-excursion (set-buffer ielm-working-buffer) (condition-case err (let ((: :save) (:: ::save) (::: :::save) (ielm-obuf (current-buffer))) (setq ielm-result (eval ielm-form)) (setq ielm-wbuf (current-buffer)) ;; The eval may have changed current-buffer; ;; need to set it back here to avoid a bug ;; in let. Don't want to use save-excursion ;; because we want to allow changes in point. (set-buffer ielm-obuf)) (error (setq ielm-result (ielm-format-error err)) (setq ielm-error-type "Eval error")) (quit (setq ielm-result "Quit during evaluation") (setq ielm-error-type "Eval error"))))) (setq ielm-error-type "IELM error") (setq ielm-result "More than one sexp in input")))) ;; If the eval changed the current buffer, mention it here (if (eq ielm-wbuf ielm-working-buffer) nil (message "current buffer is now: %s" ielm-wbuf) (setq ielm-working-buffer ielm-wbuf)) (goto-char ielm-pmark) (if (not ielm-error-type) (condition-case err ;; Self-referential objects cause loops in the printer, so ;; trap quits here. May as well do errors, too (setq ielm-output (concat ielm-output (pp-to-string ielm-result))) (error (setq ielm-error-type "IELM Error") (setq ielm-result "Error during pretty-printing (bug in pp)")) (quit (setq ielm-error-type "IELM Error") (setq ielm-result "Quit during pretty-printing")))) (if ielm-error-type (progn (if ielm-noisy (ding)) (setq ielm-output (concat ielm-output "*** " ielm-error-type " *** ")) (setq ielm-output (concat ielm-output ielm-result))) ;; There was no error, so shift the ::: values (setq ::: ::) (setq :: :) (setq : ielm-result)) (setq ielm-output (concat ielm-output "\n")))) (setq ielm-output (concat ielm-output ielm-prompt)) (comint-output-filter (ielm-process) ielm-output))) ;;; Process and marker utilities (defun ielm-process nil ;; Return the current buffer's process. (get-buffer-process (current-buffer))) (defun ielm-pm nil ;; Return the process mark of the current buffer. (process-mark (get-buffer-process (current-buffer)))) (defun ielm-set-pm (pos) ;; Set the process mark in the current buffer to POS. (set-marker (process-mark (get-buffer-process (current-buffer))) pos)) ;;; Major mode (defun inferior-emacs-lisp-mode nil "Major mode for interactively evaluating Emacs Lisp expressions. Uses the interface provided by `comint-mode' (which see). * \\\\[ielm-send-input] evaluates the sexp following the prompt. There must be at most one top-level sexp per prompt. * \\[ielm-return] inserts a newline and indents, or evaluates a complete expression (but see variable `ielm-dynamic-return'). Inputs longer than one line are moved to the line following the prompt (but see variable `ielm-dynamic-multiline-inputs'). * \\[comint-dynamic-complete] completes Lisp symbols (or filenames, within strings), or indents the line if there is nothing to complete. During evaluations, the values of the variables `:', `::', and `:::' are the results of the previous, second previous and third previous evaluations respectively. The current working buffer may be changed (with a call to `set-buffer', or with \\[ielm-change-working-buffer]), and its value is preserved between successive evaluations. In this way, expressions may be evaluated in a different buffer than the *ielm* buffer. Display the name of the working buffer with \\[ielm-print-working-buffer], or the buffer itself with \\[ielm-display-working-buffer]. Expressions evaluated by IELM are not subject to `debug-on-quit' or `debug-on-error'. The behaviour of IELM may be customised with the following variables: * To stop beeping on error, set `ielm-noisy' to nil * If you don't like the prompt, you can change it by setting `ielm-prompt'. * Set `ielm-dynamic-return' to nil for bindings like `lisp-interaction-mode' * Entry to this mode runs `comint-mode-hook' and `ielm-mode-hook' (in that order). Customised bindings may be defined in `ielm-map', which currently contains: \\{ielm-map}" (interactive) (comint-mode) (setq comint-prompt-regexp (concat "^" (regexp-quote ielm-prompt))) (make-local-variable 'paragraph-start) (setq paragraph-start comint-prompt-regexp) (setq comint-input-sender 'ielm-input-sender) (setq comint-process-echoes nil) (setq comint-dynamic-complete-functions '(ielm-tab comint-replace-by-expanded-history ielm-complete-filename ielm-complete-symbol)) (setq comint-get-old-input 'ielm-get-old-input) (setq major-mode 'inferior-emacs-lisp-mode) (setq mode-name "IELM") (use-local-map ielm-map) (set-syntax-table emacs-lisp-mode-syntax-table) (make-local-variable 'indent-line-function) (make-local-variable 'ielm-working-buffer) (setq ielm-working-buffer (current-buffer)) (setq indent-line-function 'ielm-indent-line) ;; Value holders (setq : nil) (make-local-variable ':) (setq :: nil) (make-local-variable '::) (setq ::: nil) (make-local-variable ':::) ;; font-lock support (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(ielm-font-lock-keywords nil nil ((?: . "w") (?- . "w") (?* . "w")))) ;; A dummy process to keep comint happy. It will never get any input (if (comint-check-proc (current-buffer)) nil (start-process "ielm" (current-buffer) "cat") (process-kill-without-query (ielm-process)) (goto-char (point-max)) ;; Add a silly header (insert ielm-header) (ielm-set-pm (point-max)) (comint-output-filter (ielm-process) ielm-prompt) (set-marker comint-last-input-start (ielm-pm)) (set-process-filter (get-buffer-process (current-buffer)) 'comint-output-filter)) (run-hooks 'ielm-mode-hook)) (defun ielm-get-old-input nil ;; Return the previous input surrounding point (save-excursion (beginning-of-line) (if (looking-at comint-prompt-regexp) nil (re-search-backward comint-prompt-regexp)) (comint-skip-prompt) (buffer-substring (point) (progn (forward-sexp 1) (point))))) ;;; User command ;;;###autoload (add-hook 'same-window-buffer-names "*ielm*") ;;;###autoload (defun ielm nil "Interactively evaluate Emacs Lisp expressions. Switches to the buffer `*ielm*', or creates it if it does not exist." (interactive) (if (comint-check-proc "*ielm*") nil (save-excursion (set-buffer (get-buffer-create "*ielm*")) (inferior-emacs-lisp-mode))) (pop-to-buffer "*ielm*")) ;;; ielm.el ends here emacs-19.30/lisp/imenu.el100444 12120 1 64100 6055461225 13534 0ustar rmsdaemon;;; imenu.el --- Framework for mode-specific buffer indexes. ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Ake Stenhoff ;; Lars Lindberg ;; Created: 8 Feb 1994 ;; Keywords: tools ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; ;; Purpose of this package: ;; To present a framework for mode-specific buffer indexes. ;; A buffer index is an alist of names and buffer positions. ;; For instance all functions in a C-file and their positions. ;; ;; How it works: ;; A mode-specific function is called to generate the index. It is ;; then presented to the user, who can choose from this index. ;; ;; The package comes with a set of example functions for how to ;; utilize this package. ;; There are *examples* for index gathering functions/regular ;; expressions for C/C++ and Lisp/Emacs Lisp but it is easy to ;; customize for other modes. A function for jumping to the chosen ;; index position is also supplied. ;;; Thanks goes to ;; [simon] - Simon Leinen simon@lia.di.epfl.ch ;; [dean] - Dean Andrews ada@unison.com ;; [alon] - Alon Albert al@mercury.co.il ;; [greg] - Greg Thompson gregt@porsche.visix.COM ;; [wolfgang] - Wolfgang Bangerth zcg51122@rpool1.rus.uni-stuttgart.de ;; [kai] - Kai Grossjohann grossjoh@linus.informatik.uni-dortmund.de ;; [david] - David M. Smith dsmith@stats.adelaide.edu.au ;; [christian] - Christian Egli Christian.Egli@hcsd.hac.com ;; [karl] - Karl Fogel kfogel@floss.life.uiuc.edu ;;; Code (eval-when-compile (require 'cl)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Customizable variables ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar imenu-use-keymap-menu nil "*Non-nil means use a keymap when making the mouse menu.") (defvar imenu-auto-rescan nil "*Non-nil means Imenu should always rescan the buffers.") (defvar imenu-auto-rescan-maxout 60000 "* auto-rescan is disabled in buffers larger than this. This variable is buffer-local.") (defvar imenu-always-use-completion-buffer-p nil "*Set this to non-nil for displaying the index in a completion buffer. Non-nil means always display the index in a completion buffer. Nil means display the index as a mouse menu when the mouse was used to invoke `imenu'. `never' means never automatically display a listing of any kind.") (defvar imenu-sort-function nil "*The function to use for sorting the index mouse-menu. Affects only the mouse index menu. Set this to nil if you don't want any sorting (faster). The items in the menu are then presented in the order they were found in the buffer. Set it to `imenu--sort-by-name' if you want alphabetic sorting. The function should take two arguments and return T if the first element should come before the second. The arguments are cons cells; \(NAME . POSITION). Look at `imenu--sort-by-name' for an example.") (defvar imenu-max-items 25 "*Maximum number of elements in an index mouse-menu.") (defvar imenu-scanning-message "Scanning buffer for index (%3d%%)" "*Progress message during the index scanning of the buffer. If non-nil, user gets a message during the scanning of the buffer Relevant only if the mode-specific function that creates the buffer index use `imenu-progress-message'.") (defvar imenu-space-replacement "^" "*The replacement string for spaces in index names. Used when presenting the index in a completion-buffer to make the names work as tokens.") (defvar imenu-level-separator ":" "*The separator between index names of different levels. Used for making mouse-menu titles and for flattening nested indexes with name concatenation.") (defvar imenu-submenu-name-format "%s..." "*The format for making a submenu name.") ;;;###autoload (defvar imenu-generic-expression nil "The regex pattern to use for creating a buffer index. If non-nil this pattern is passed to `imenu-create-index-with-pattern' to create a buffer index. It is an alist with elements that look like this: (MENU-TITLE REGEXP INDEX). MENU-TITLE is a string used as the title for the submenu or nil if the entries are not nested. REGEXP is a regexp that should match a construct in the buffer that is to be displayed in the menu; i.e., function or variable definitions, etc. It contains a substring which is the name to appear in the menu. See the info section on Regexps for more information. INDEX points to the substring in REGEXP that contains the name (of the function, variable or type) that is to appear in the menu. For emacs-lisp-mode for example PATTERN would look like: '((nil \"^\\\\s-*(def\\\\(un\\\\|subst\\\\|macro\\\\|advice\\\\)\\\\s-+\\\\([-A-Za-z0-9+]+\\\\)\" 2) (\"*Vars*\" \"^\\\\s-*(def\\\\(var\\\\|const\\\\)\\\\s-+\\\\([-A-Za-z0-9+]+\\\\)\" 2) (\"*Types*\" \"^\\\\s-*(def\\\\(type\\\\|struct\\\\|class\\\\|ine-condition\\\\)\\\\s-+\\\\([-A-Za-z0-9+]+\\\\)\" 2)) The variable is buffer-local.") (make-variable-buffer-local 'imenu-generic-expression) ;;;; Hooks (defvar imenu-create-index-function 'imenu-default-create-index-function "The function to use for creating a buffer index. It should be a function that takes no arguments and returns an index of the current buffer as an alist. The elements in the alist look like: (INDEX-NAME . INDEX-POSITION). You may also nest index list like \(INDEX-NAME . INDEX-ALIST). This function is called within a `save-excursion'. The variable is buffer-local.") (make-variable-buffer-local 'imenu-create-index-function) (defvar imenu-prev-index-position-function 'beginning-of-defun "Function for finding the next index position. If `imenu-create-index-function' is set to `imenu-default-create-index-function', then you must set this variable to a function that will find the next index, looking backwards in the file. The function should leave point at the place to be connected to the index and it should return nil when it doesn't find another index.") (make-variable-buffer-local 'imenu-prev-index-position-function) (defvar imenu-extract-index-name-function nil "Function for extracting the index name. This function is called after the function pointed out by `imenu-prev-index-position-function'.") (make-variable-buffer-local 'imenu-extract-index-name-function) ;;; ;;; Macro to display a progress message. ;;; RELPOS is the relative position to display. ;;; If RELPOS is nil, then the relative position in the buffer ;;; is calculated. ;;; PREVPOS is the variable in which we store the last position displayed. (defmacro imenu-progress-message (prevpos &optional relpos reverse) (` (and imenu-scanning-message (let ((pos (, (if relpos relpos (` (imenu--relative-position (, reverse))))))) (if (, (if relpos t (` (> pos (+ 5 (, prevpos)))))) (progn (message imenu-scanning-message pos) (setq (, prevpos) pos))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; Some examples of functions utilizing the framework of this ;;;; package. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Return the current/previous sexp and the location of the sexp (its ;; beginning) without moving the point. (defun imenu-example--name-and-position () (save-excursion (forward-sexp -1) (let ((beg (point)) (end (progn (forward-sexp) (point))) (marker (make-marker))) (set-marker marker beg) (cons (buffer-substring beg end) marker)))) ;;; ;;; Lisp ;;; (defun imenu-example--lisp-extract-index-name () ;; Example of a candidate for `imenu-extract-index-name-function'. ;; This will generate a flat index of definitions in a lisp file. (save-match-data (and (looking-at "(def") (condition-case nil (progn (down-list 1) (forward-sexp 2) (let ((beg (point)) (end (progn (forward-sexp -1) (point)))) (buffer-substring beg end))) (error nil))))) (defun imenu-example--create-lisp-index () ;; Example of a candidate for `imenu-create-index-function'. ;; It will generate a nested index of definitions. (let ((index-alist '()) (index-var-alist '()) (index-type-alist '()) (index-unknown-alist '()) prev-pos) (goto-char (point-max)) (imenu-progress-message prev-pos 0) ;; Search for the function (while (beginning-of-defun) (imenu-progress-message prev-pos nil t) (save-match-data (and (looking-at "(def") (save-excursion (down-list 1) (cond ((looking-at "def\\(var\\|const\\)") (forward-sexp 2) (push (imenu-example--name-and-position) index-var-alist)) ((looking-at "def\\(un\\|subst\\|macro\\|advice\\)") (forward-sexp 2) (push (imenu-example--name-and-position) index-alist)) ((looking-at "def\\(type\\|struct\\|class\\|ine-condition\\)") (forward-sexp 2) (if (= (char-after (1- (point))) ?\)) (progn (forward-sexp -1) (down-list 1) (forward-sexp 1))) (push (imenu-example--name-and-position) index-type-alist)) (t (forward-sexp 2) (push (imenu-example--name-and-position) index-unknown-alist))))))) (imenu-progress-message prev-pos 100) (and index-var-alist (push (cons (imenu-create-submenu-name "Variables") index-var-alist) index-alist)) (and index-type-alist (push (cons (imenu-create-submenu-name "Types") index-type-alist) index-alist)) (and index-unknown-alist (push (cons (imenu-create-submenu-name "Syntax-unknown") index-unknown-alist) index-alist)) index-alist)) ;; Regular expression to find C functions (defvar imenu-example--function-name-regexp-c (concat "^[a-zA-Z0-9]+[ \t]?" ; type specs; there can be no "\\([a-zA-Z0-9_*]+[ \t]+\\)?" ; more than 3 tokens, right? "\\([a-zA-Z0-9_*]+[ \t]+\\)?" "\\([*&]+[ \t]*\\)?" ; pointer "\\([a-zA-Z0-9_*]+\\)[ \t]*(" ; name )) (defun imenu-example--create-c-index (&optional regexp) (let ((index-alist '()) prev-pos char) (goto-char (point-min)) (imenu-progress-message prev-pos 0) ;; Search for the function (save-match-data (while (re-search-forward (or regexp imenu-example--function-name-regexp-c) nil t) (imenu-progress-message prev-pos) (backward-up-list 1) (save-excursion (goto-char (scan-sexps (point) 1)) (setq char (following-char))) ;; Skip this function name if it is a prototype declaration. (if (not (eq char ?\;)) (push (imenu-example--name-and-position) index-alist)))) (imenu-progress-message prev-pos 100) (nreverse index-alist))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Internal variables ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The item to use in the index for rescanning the buffer. (defconst imenu--rescan-item '("*Rescan*" . -99)) ;; The latest buffer index. ;; Buffer local. (defvar imenu--index-alist nil) (make-variable-buffer-local 'imenu--index-alist) ;; History list for 'jump-to-function-in-buffer'. ;; Making this buffer local caused it not to work! (defvar imenu--history-list nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Internal support functions ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Sort function ;;; Sorts the items depending on their index name. ;;; An item look like (NAME . POSITION). ;;; (defun imenu--sort-by-name (item1 item2) (string-lessp (car item1) (car item2))) (defun imenu--relative-position (&optional reverse) ;; Support function to calculate relative position in buffer ;; Beginning of buffer is 0 and end of buffer is 100 ;; If REVERSE is non-nil then the beginning is 100 and the end is 0. (let ((pos (point)) (total (buffer-size))) (and reverse (setq pos (- total pos))) (if (> total 50000) ;; Avoid overflow from multiplying by 100! (/ (1- pos) (max (/ total 100) 1)) (/ (* 100 (1- pos)) (max total 1))))) ;;; ;;; Function for suporting general looking submenu names. ;;; Uses `imenu-submenu-name-format' for creating the name. ;;; NAME is the base of the new submenu name. ;;; (defun imenu-create-submenu-name (name) (format imenu-submenu-name-format name)) ;; Split LIST into sublists of max length N. ;; Example (imenu--split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8)) (defun imenu--split (list n) (let ((remain list) (result '()) (sublist '()) (i 0)) (while remain (push (pop remain) sublist) (incf i) (and (= i n) ;; We have finished a sublist (progn (push (nreverse sublist) result) (setq i 0) (setq sublist '())))) ;; There might be a sublist (if the length of LIST mod n is != 0) ;; that has to be added to the result list. (and sublist (push (nreverse sublist) result)) (nreverse result))) ;;; ;;; Split a menu in to several menus. ;;; (defun imenu--split-menu (menulist title) (cons "Index menu" (mapcar (function (lambda (menu) (cons (format "(%s)" title) menu))) (imenu--split menulist imenu-max-items)))) ;;; ;;; Find all items in this buffer that should be in the index. ;;; Returns an alist on the form ;;; ((NAME . POSITION) (NAME . POSITION) ...) ;;; (defun imenu--make-index-alist () ;; Create a list for this buffer only when needed. (or (and imenu--index-alist (or (not imenu-auto-rescan) (and imenu-auto-rescan (> (buffer-size) imenu-auto-rescan-maxout)))) ;; Get the index (setq imenu--index-alist (save-excursion (funcall imenu-create-index-function)))) (or imenu--index-alist (error "No items suitable for an index found in this buffer")) ;; Add a rescan option to the index. (cons imenu--rescan-item imenu--index-alist)) ;;; ;;; Find all markers in alist and makes ;;; them point nowhere. ;;; (defun imenu--cleanup (&optional alist) ;; Sets the markers in imenu--index-alist ;; point nowhere. ;; if alist is provided use that list. (or alist (setq alist imenu--index-alist)) (and alist (mapcar (function (lambda (item) (cond ((markerp (cdr item)) (set-marker (cdr item) nil)) ((consp (cdr item)) (imenu--cleanup (cdr item)))))) alist) t)) (defun imenu--create-keymap-2 (alist counter) (let ((map nil)) (mapcar (function (lambda (item) (cond ((listp (cdr item)) (append (list (incf counter) (car item) 'keymap (car item)) (imenu--create-keymap-2 (cdr item) (+ counter 10)))) (t (let ((end (cons '(nil) t))) (cons (car item) (cons (car item) end)))) ))) alist))) (defun imenu--create-keymap-1 (title alist) (append (list 'keymap title) (imenu--create-keymap-2 alist 0))) (defun imenu--in-alist (str alist) "Check whether the string STR is contained in multi-level ALIST." (let (elt head tail res) (setq res nil) (while alist (setq elt (car alist) tail (cdr elt) alist (cdr alist) head (car elt)) (if (string= str head) (setq alist nil res elt) (if (and (listp tail) (setq res (imenu--in-alist str tail))) (setq alist nil)))) res)) (defun imenu-default-create-index-function () "*Wrapper for index searching functions. Moves point to end of buffer and then repeatedly calls `imenu-prev-index-position-function' and `imenu-extract-index-name-function'. Their results are gathered into an index alist." ;; These should really be done by setting imenu-create-index-function ;; in these major modes. But save that change for later. (cond ((and (fboundp imenu-prev-index-position-function) (fboundp imenu-extract-index-name-function)) (let ((index-alist '()) prev-pos name) (goto-char (point-max)) (imenu-progress-message prev-pos 0 t) ;; Search for the function (while (funcall imenu-prev-index-position-function) (imenu-progress-message prev-pos nil t) (save-excursion (setq name (funcall imenu-extract-index-name-function))) (and (stringp name) (push (cons name (point)) index-alist))) (imenu-progress-message prev-pos 100 t) index-alist)) ;; Use generic expression if possible. ((and imenu-generic-expression) (imenu--generic-function imenu-generic-expression)) (t (error "The mode \"%s\" does not take full advantage of imenu.el yet." mode-name)))) (defun imenu--replace-spaces (name replacement) ;; Replace all spaces in NAME with REPLACEMENT. ;; That second argument should be a string. (mapconcat (function (lambda (ch) (if (char-equal ch ?\ ) replacement (char-to-string ch)))) name "")) (defun imenu--flatten-index-alist (index-alist &optional concat-names prefix) ;; Takes a nested INDEX-ALIST and returns a flat index alist. ;; If optional CONCAT-NAMES is non-nil, then a nested index has its ;; name and a space concatenated to the names of the children. ;; Third argument PREFIX is for internal use only. (mapcan (function (lambda (item) (let* ((name (car item)) (pos (cdr item)) (new-prefix (and concat-names (if prefix (concat prefix imenu-level-separator name) name)))) (cond ((or (markerp pos) (numberp pos)) (list (cons new-prefix pos))) (t (imenu--flatten-index-alist pos new-prefix)))))) index-alist)) ;;; ;;; Generic index gathering function. ;;; (defun imenu--generic-function (patterns) ;; Built on some ideas that Erik Naggum once posted ;; to comp.emacs "Return an index of the current buffer as an alist. PATTERN is an alist with elements that look like this: (MENU-TITLE REGEXP INDEX). MENU-TITLE is a string used as the title for the submenu or nil if the entries are not nested. REGEXP is a regexp that should match a construct in the buffer that is to be displayed in the menu; i.e., function or variable definitions, etc. It contains a substring which is the name to appear in the menu. See the info section on Regexps for more information. INDEX points to the substring in REGEXP that contains the name (of the function, variable or type) that is to appear in the menu. For emacs-lisp-mode for example PATTERN would look like: '((nil \"^\\\\s-*(def\\\\(un\\\\|subst\\\\|macro\\\\|advice\\\\)\\\\s-+\\\\([-A-Za-z0-9]+\\\\)\" 2) (\"*Vars*\" \"^\\\\s-*(def\\\\(var\\\\|const\\\\)\\\\s-+\\\\([-A-Za-z0-9]+\\\\)\" 2) (\"*Types*\" \"^\\\\s-*(def\\\\(type\\\\|struct\\\\|class\\\\|ine-condition\\\\)\\\\s-+\\\\([-A-Za-z0-9]+\\\\)\" 2))' Returns an index of the current buffer as an alist. The elements in the alist look like: (INDEX-NAME . INDEX-POSITION). They may also be nested index lists like (INDEX-NAME . INDEX-ALIST) depending on pattern. \(imenu--generic-function PATTERN\)." (let ((index-alist (list 'dummy)) (found nil) (global-regexp (concat "\\(" (mapconcat (function (lambda (pattern) (identity (cadr pattern)))) patterns "\\)\\|\\(") "\\)")) prev-pos) (goto-char (point-max)) (imenu-progress-message prev-pos 0 t) (save-match-data (while (re-search-backward global-regexp nil t) (imenu-progress-message prev-pos nil t) (setq found nil) (save-excursion (goto-char (match-beginning 0)) (mapcar (function (lambda (pat) (let ((menu-title (car pat)) (regexp (cadr pat)) (index (caddr pat))) (if (and (not found) ; Only allow one entry; (looking-at regexp)) (let ((beg (match-beginning index)) (end (match-end index))) (setq found t) (push (cons (buffer-substring beg end) beg) (cdr (or (if (not (stringp menu-title)) index-alist) (assoc (imenu-create-submenu-name menu-title) index-alist) (car (push (cons (imenu-create-submenu-name menu-title) '()) index-alist)))))))))) patterns)))) (imenu-progress-message prev-pos 100 t) (delete 'dummy index-alist))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; The main functions for this package! ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun imenu--completion-buffer (index-alist &optional prompt) "Let the user select from INDEX-ALIST in a completion buffer with PROMPT. Returns t for rescan and otherwise a position number." ;; Create a list for this buffer only when needed. (let (name choice (prepared-index-alist (mapcar (function (lambda (item) (cons (imenu--replace-spaces (car item) imenu-space-replacement) (cdr item)))) index-alist))) (if (eq imenu-always-use-completion-buffer-p 'never) (setq name (completing-read (or prompt "Index item: ") prepared-index-alist nil t nil 'imenu--history-list)) (save-window-excursion ;; Display the completion buffer (with-output-to-temp-buffer "*Completions*" (display-completion-list (all-completions "" prepared-index-alist ))) (let ((minibuffer-setup-hook (function (lambda () (let ((buffer (current-buffer))) (save-excursion (set-buffer "*Completions*") (setq completion-reference-buffer buffer))))))) ;; Make a completion question (setq name (completing-read (or prompt "Index item: ") prepared-index-alist nil t nil 'imenu--history-list))))) (cond ((not (stringp name)) nil) ((string= name (car imenu--rescan-item)) t) (t (setq choice (assoc name prepared-index-alist)) (if (listp (cdr choice)) (imenu--completion-buffer (cdr choice) prompt) choice))))) (defun imenu--mouse-menu (index-alist event &optional title) "Let the user select from a buffer index from a mouse menu. INDEX-ALIST is the buffer index and EVENT is a mouse event. Returns t for rescan and otherwise a position number." (let* ((menu (imenu--split-menu (if imenu-sort-function (sort (let ((res nil) (oldlist index-alist)) ;; Copy list method from the cl package `copy-list' (while (consp oldlist) (push (pop oldlist) res)) (prog1 (nreverse res) (setcdr res oldlist))) imenu-sort-function) index-alist) (or title (buffer-name)))) position) (and imenu-use-keymap-menu (setq menu (imenu--create-keymap-1 (car menu) (if (< 1 (length (cdr menu))) (cdr menu) (cdr (cadr menu)))))) (setq position (x-popup-menu event menu)) (if imenu-use-keymap-menu (progn (cond ((and (listp position) (numberp (car position)) (stringp (nth (1- (length position)) position))) (setq position (nth (1- (length position)) position))) ((and (stringp (car position)) (null (cdr position))) (setq position (car position)))))) (cond ((eq position nil) position) ((listp position) (imenu--mouse-menu position event (if title (concat title imenu-level-separator (car (rassq position index-alist))) (car (rassq position index-alist))))) ((stringp position) (or (string= position (car imenu--rescan-item)) (imenu--in-alist position index-alist))) ((or (= position (cdr imenu--rescan-item)) (and (stringp position) (string= position (car imenu--rescan-item)))) t) (t (rassq position index-alist))))) (defun imenu-choose-buffer-index (&optional prompt alist) "Let the user select from a buffer index and return the chosen index. If the user originally activated this function with the mouse, a mouse menu is used. Otherwise a completion buffer is used and the user is prompted with PROMPT. If you call this function with index alist ALIST, then it lets the user select from ALIST. With no index alist ALIST, it calls `imenu--make-index-alist' to create the index alist. If `imenu-always-use-completion-buffer-p' is non-nil, then the completion buffer is always used, no matter if the mouse was used or not. The returned value is on the form (INDEX-NAME . INDEX-POSITION)." (let (index-alist (mouse-triggered (listp last-nonmenu-event)) (result t) ) ;; If selected by mouse, see to that the window where the mouse is ;; really is selected. (and mouse-triggered (not (equal last-nonmenu-event '(menu-bar))) (let ((window (posn-window (event-start last-nonmenu-event)))) (or (framep window) (null window) (select-window window)))) ;; Create a list for this buffer only when needed. (while (eq result t) (setq index-alist (if alist alist (imenu--make-index-alist))) (setq result (if (and mouse-triggered (not imenu-always-use-completion-buffer-p)) (imenu--mouse-menu index-alist last-nonmenu-event) (imenu--completion-buffer index-alist prompt))) (and (eq result t) (imenu--cleanup) (setq imenu--index-alist nil))) result)) ;;;###autoload (defun imenu-add-to-menubar (name) "Adds an \"imenu\" entry to the menubar for the current local keymap. NAME is the string naming the menu to be added. See 'imenu' for more information." (interactive "sMenu name: ") (and window-system (define-key (current-local-map) [menu-bar index] (cons name 'imenu)))) ;;;###autoload (defun imenu (index-item) "Jump to a place in the buffer chosen using a buffer menu or mouse menu. See `imenu-choose-buffer-index' for more information." (interactive (list (save-restriction (widen) (imenu-choose-buffer-index)))) (and index-item (progn (push-mark) (cond ((markerp (cdr index-item)) (if (or ( > (marker-position (cdr index-item)) (point-min)) ( < (marker-position (cdr index-item)) (point-max))) ;; widen if outside narrowing (widen)) (goto-char (marker-position (cdr index-item)))) (t (if (or ( > (cdr index-item) (point-min)) ( < (cdr index-item) (point-max))) ;; widen if outside narrowing (widen)) (goto-char (cdr index-item))))))) (provide 'imenu) ;;; imenu.el ends here emacs-19.30/lisp/indent.el100444 12120 1 41527 6053207754 13713 0ustar rmsdaemon;;; indent.el --- indentation commands for Emacs ;; Copyright (C) 1985, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; 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: ;; Commands for making and changing indentation in text. These are ;; described in the Emacs manual. ;;; Code: (defvar standard-indent 4 "\ Default number of columns for margin-changing functions to indent.") (defvar indent-line-function 'indent-to-left-margin "\ Function to indent current line.") (defun indent-according-to-mode () "Indent line in proper way for current major mode." (interactive) (funcall indent-line-function)) (defun indent-for-tab-command (&optional prefix-arg) "Indent line in proper way for current major mode." (interactive "P") (if (eq indent-line-function 'indent-to-left-margin) (insert-tab) (if prefix-arg (funcall indent-line-function prefix-arg) (funcall indent-line-function)))) (defun insert-tab () (if abbrev-mode (expand-abbrev)) (if indent-tabs-mode (insert ?\t) (indent-to (* tab-width (1+ (/ (current-column) tab-width)))))) (defun indent-rigidly (start end arg) "Indent all lines starting in the region sideways by ARG columns. Called from a program, takes three arguments, START, END and ARG." (interactive "r\np") (save-excursion (goto-char end) (setq end (point-marker)) (goto-char start) (or (bolp) (forward-line 1)) (while (< (point) end) (let ((indent (current-indentation)) eol-flag) (save-excursion (skip-chars-forward " \t") (setq eol-flag (eolp))) (or eol-flag (indent-to (max 0 (+ indent arg)) 0)) (delete-region (point) (progn (skip-chars-forward " \t") (point)))) (forward-line 1)) (move-marker end nil))) (defun indent-line-to (column) "Indent current line to COLUMN. This function removes or adds spaces and tabs at beginning of line only if necessary. It leaves point at end of indentation." (back-to-indentation) (let ((cur-col (current-column))) (cond ((< cur-col column) (if (> (- column (* (/ cur-col tab-width) tab-width)) tab-width) (delete-region (point) (progn (skip-chars-backward " ") (point)))) (indent-to column)) ((> cur-col column) ; too far right (after tab?) (delete-region (progn (move-to-column column t) (point)) (progn (back-to-indentation) (point))))))) (defun current-left-margin () "Return the left margin to use for this line. This is the value of the buffer-local variable `left-margin' plus the value of the `left-margin' text-property at the start of the line." (save-excursion (back-to-indentation) (max 0 (+ left-margin (or (get-text-property (if (and (eobp) (not (bobp))) (1- (point)) (point)) 'left-margin) 0))))) (defun move-to-left-margin (&optional n force) "Move to the left margin of the current line. With optional argument, move forward N-1 lines first. The column moved to is the one given by the `current-left-margin' function. If the line's indentation appears to be wrong, and this command is called interactively or with optional argument FORCE, it will be fixed." (interactive (list (prefix-numeric-value current-prefix-arg) t)) (beginning-of-line n) (skip-chars-forward " \t") (let ((lm (current-left-margin)) (cc (current-column))) (cond ((> cc lm) (if (> (move-to-column lm force) lm) ;; If lm is in a tab and we are not forcing, move before tab (backward-char 1))) ((and force (< cc lm)) (indent-to-left-margin))))) ;; This is the default indent-line-function, ;; used in Fundamental Mode, Text Mode, etc. (defun indent-to-left-margin () "Indent current line to the column given by `current-left-margin'." (indent-line-to (current-left-margin))) (defun delete-to-left-margin (&optional from to) "Remove left margin indentation from a region. This deletes to the column given by `current-left-margin'. In no case will it delete non-whitespace. Args FROM and TO are optional; default is the whole buffer." (save-excursion (goto-char (or to (point-max))) (setq to (point-marker)) (goto-char (or from (point-min))) (or (bolp) (forward-line 1)) (while (< (point) to) (delete-region (point) (progn (move-to-left-margin nil t) (point))) (forward-line 1)) (move-marker to nil))) (defun set-left-margin (from to lm) "Set the left margin of the region to WIDTH. If `auto-fill-mode' is active, re-fill the region to fit the new margin." (interactive "r\nNSet left margin to column: ") (if (interactive-p) (setq lm (prefix-numeric-value lm))) (save-excursion ;; If inside indentation, start from BOL. (goto-char from) (skip-chars-backward " \t") (if (bolp) (setq from (point))) ;; Place end after whitespace (goto-char to) (skip-chars-forward " \t") (setq to (point-marker))) ;; Delete margin indentation first, but keep paragraph indentation. (delete-to-left-margin from to) (put-text-property from to 'left-margin lm) (indent-rigidly from to lm) (if auto-fill-function (save-excursion (fill-region from to nil t t))) (move-marker to nil)) (defun set-right-margin (from to lm) "Set the right margin of the region to WIDTH. If `auto-fill-mode' is active, re-fill the region to fit the new margin." (interactive "r\nNSet right margin to width: ") (if (interactive-p) (setq lm (prefix-numeric-value lm))) (save-excursion (goto-char from) (skip-chars-backward " \t") (if (bolp) (setq from (point)))) (put-text-property from to 'right-margin lm) (if auto-fill-function (save-excursion (fill-region from to nil t t)))) (defun alter-text-property (from to prop func &optional object) "Programmatically change value of a text-property. For each region between FROM and TO that has a single value for PROPERTY, apply FUNCTION to that value and sets the property to the function's result. Optional fifth argument OBJECT specifies the string or buffer to operate on." (let ((begin from) end val) (while (setq val (get-text-property begin prop object) end (text-property-not-all begin to prop val object)) (put-text-property begin end prop (funcall func val) object) (setq begin end)) (if (< begin to) (put-text-property begin to prop (funcall func val) object)))) (defun increase-left-margin (from to inc) "Increase or decrease the left-margin of the region. With no prefix argument, this adds `standard-indent' of indentation. A prefix arg (optional third arg INC noninteractively) specifies the amount to change the margin by, in characters. If `auto-fill-mode' is active, re-fill the region to fit the new margin." (interactive "*r\nP") (setq inc (if inc (prefix-numeric-value inc) standard-indent)) (save-excursion (goto-char from) (skip-chars-backward " \t") (if (bolp) (setq from (point))) (goto-char to) (setq to (point-marker))) (alter-text-property from to 'left-margin (lambda (v) (max (- left-margin) (+ inc (or v 0))))) (indent-rigidly from to inc) (if auto-fill-function (save-excursion (fill-region from to nil t t))) (move-marker to nil)) (defun decrease-left-margin (from to inc) "Make the left margin of the region smaller. With no prefix argument, decrease the indentation by `standard-indent'. A prefix arg (optional third arg INC noninteractively) specifies the amount to change the margin by, in characters. If `auto-fill-mode' is active, re-fill the region to fit the new margin." (interactive "*r\nP") (setq inc (if inc (prefix-numeric-value inc) standard-indent)) (increase-left-margin from to (- inc))) (defun increase-right-margin (from to inc) "Increase the right-margin of the region. With no prefix argument, increase the right margin by `standard-indent'. A prefix arg (optional third arg INC noninteractively) specifies the amount to change the margin by, in characters. A negative argument decreases the right margin width. If `auto-fill-mode' is active, re-fill the region to fit the new margin." (interactive "r\nP") (if (interactive-p) (setq inc (if inc (prefix-numeric-value current-prefix-arg) standard-indent))) (save-excursion (alter-text-property from to 'right-margin (lambda (v) (+ inc (or v 0)))) (if auto-fill-function (fill-region from to nil t t)))) (defun decrease-right-margin (from to inc) "Make the right margin of the region smaller. With no prefix argument, decrease the right margin by `standard-indent'. A prefix arg (optional third arg INC noninteractively) specifies the amount of width to remove, in characters. A negative argument increases the right margin width. If `auto-fill-mode' is active, re-fills region to fit in new margin." (interactive "*r\nP") (setq inc (if inc (prefix-numeric-value inc) standard-indent)) (increase-right-margin from to (- inc))) (defun beginning-of-line-text (&optional n) "Move to the beginning of the text on this line. With optional argument, move forward N-1 lines first. From the beginning of the line, moves past the left-margin indentation, the fill-prefix, and any indentation used for centering or right-justifying the line, but does not move past any whitespace that was explicitly inserted \(such as a tab used to indent the first line of a paragraph)." (interactive "p") (beginning-of-line n) (skip-chars-forward " \t") ;; Skip over fill-prefix. (if (and fill-prefix (not (string-equal fill-prefix ""))) (if (equal fill-prefix (buffer-substring (point) (min (point-max) (+ (length fill-prefix) (point))))) (forward-char (length fill-prefix))) (if (and adaptive-fill-mode (looking-at adaptive-fill-regexp)) (goto-char (match-end 0)))) ;; Skip centering or flushright indentation (if (memq (current-justification) '(center right)) (skip-chars-forward " \t"))) (defvar indent-region-function nil "Short cut function to indent region using `indent-according-to-mode'. A value of nil means really run `indent-according-to-mode' on each line.") (defun indent-region (start end column) "Indent each nonblank line in the region. With no argument, indent each line using `indent-according-to-mode', or use `indent-region-function' to do the whole region if that's non-nil. If there is a fill prefix, make each line start with the fill prefix. With argument COLUMN, indent each line to that column. Called from a program, takes three args: START, END and COLUMN." (interactive "r\nP") (if (null column) (if fill-prefix (save-excursion (goto-char end) (setq end (point-marker)) (goto-char start) (let ((regexp (regexp-quote fill-prefix))) (while (< (point) end) (or (looking-at regexp) (and (bolp) (eolp)) (insert fill-prefix)) (forward-line 1)))) (if indent-region-function (funcall indent-region-function start end) (save-excursion (goto-char end) (setq end (point-marker)) (goto-char start) (or (bolp) (forward-line 1)) (while (< (point) end) (or (and (bolp) (eolp)) (funcall indent-line-function)) (forward-line 1)) (move-marker end nil)))) (setq column (prefix-numeric-value column)) (save-excursion (goto-char end) (setq end (point-marker)) (goto-char start) (or (bolp) (forward-line 1)) (while (< (point) end) (delete-region (point) (progn (skip-chars-forward " \t") (point))) (or (eolp) (indent-to column 0)) (forward-line 1)) (move-marker end nil)))) (defun indent-relative-maybe () "Indent a new line like previous nonblank line." (interactive) (indent-relative t)) (defun indent-relative (&optional unindented-ok) "Space out to under next indent point in previous nonblank line. An indent point is a non-whitespace character following whitespace. If the previous nonblank line has no indent points beyond the column point starts at, `tab-to-tab-stop' is done instead." (interactive "P") (if abbrev-mode (expand-abbrev)) (let ((start-column (current-column)) indent) (save-excursion (beginning-of-line) (if (re-search-backward "^[^\n]" nil t) (let ((end (save-excursion (forward-line 1) (point)))) (move-to-column start-column) ;; Is start-column inside a tab on this line? (if (> (current-column) start-column) (backward-char 1)) (or (looking-at "[ \t]") unindented-ok (skip-chars-forward "^ \t" end)) (skip-chars-forward " \t" end) (or (= (point) end) (setq indent (current-column)))))) (if indent (let ((opoint (point-marker))) (delete-region (point) (progn (skip-chars-backward " \t") (point))) (indent-to indent 0) (if (> opoint (point)) (goto-char opoint)) (move-marker opoint nil)) (tab-to-tab-stop)))) (defvar tab-stop-list '(8 16 24 32 40 48 56 64 72 80 88 96 104 112 120) "*List of tab stop positions used by `tab-to-tab-stops'. This should be a list of integers, ordered from smallest to largest.") (defvar edit-tab-stops-map nil "Keymap used in `edit-tab-stops'.") (if edit-tab-stops-map nil (setq edit-tab-stops-map (make-sparse-keymap)) (define-key edit-tab-stops-map "\C-x\C-s" 'edit-tab-stops-note-changes) (define-key edit-tab-stops-map "\C-c\C-c" 'edit-tab-stops-note-changes)) (defvar edit-tab-stops-buffer nil "Buffer whose tab stops are being edited--in case the variable `tab-stop-list' is local in that buffer.") (defun edit-tab-stops () "Edit the tab stops used by `tab-to-tab-stop'. Creates a buffer *Tab Stops* containing text describing the tab stops. A colon indicates a column where there is a tab stop. You can add or remove colons and then do \\\\[edit-tab-stops-note-changes] to make changes take effect." (interactive) (setq edit-tab-stops-buffer (current-buffer)) (switch-to-buffer (get-buffer-create "*Tab Stops*")) (use-local-map edit-tab-stops-map) (make-local-variable 'indent-tabs-mode) (setq indent-tabs-mode nil) (overwrite-mode 1) (setq truncate-lines t) (erase-buffer) (let ((tabs tab-stop-list)) (while tabs (indent-to (car tabs) 0) (insert ?:) (setq tabs (cdr tabs)))) (let ((count 0)) (insert ?\n) (while (< count 8) (insert (+ count ?0)) (insert " ") (setq count (1+ count))) (insert ?\n) (while (> count 0) (insert "0123456789") (setq count (1- count)))) (insert "\nTo install changes, type C-c C-c") (goto-char (point-min))) (defun edit-tab-stops-note-changes () "Put edited tab stops into effect." (interactive) (let (tabs) (save-excursion (goto-char 1) (end-of-line) (while (search-backward ":" nil t) (setq tabs (cons (current-column) tabs)))) (bury-buffer (prog1 (current-buffer) (switch-to-buffer edit-tab-stops-buffer))) (setq tab-stop-list tabs)) (message "Tab stops installed")) (defun tab-to-tab-stop () "Insert spaces or tabs to next defined tab-stop column. The variable `tab-stop-list' is a list of columns at which there are tab stops. Use \\[edit-tab-stops] to edit them interactively." (interactive) (and abbrev-mode (= (char-syntax (preceding-char)) ?w) (expand-abbrev)) (let ((tabs tab-stop-list)) (while (and tabs (>= (current-column) (car tabs))) (setq tabs (cdr tabs))) (if tabs (let ((opoint (point))) (skip-chars-backward " \t") (delete-region (point) opoint) (indent-to (car tabs))) (insert ?\ )))) (defun move-to-tab-stop () "Move point to next defined tab-stop column. The variable `tab-stop-list' is a list of columns at which there are tab stops. Use \\[edit-tab-stops] to edit them interactively." (interactive) (let ((tabs tab-stop-list)) (while (and tabs (>= (current-column) (car tabs))) (setq tabs (cdr tabs))) (if tabs (let ((before (point))) (move-to-column (car tabs) t) (save-excursion (goto-char before) ;; If we just added a tab, or moved over one, ;; delete any superfluous spaces before the old point. (if (and (eq (preceding-char) ?\ ) (eq (following-char) ?\t)) (let ((tabend (* (/ (current-column) tab-width) tab-width))) (while (and (> (current-column) tabend) (eq (preceding-char) ?\ )) (forward-char -1)) (delete-region (point) before)))))))) (define-key global-map "\t" 'indent-for-tab-command) (define-key esc-map "\034" 'indent-region) (define-key ctl-x-map "\t" 'indent-rigidly) (define-key esc-map "i" 'tab-to-tab-stop) ;;; indent.el ends here emacs-19.30/lisp/inf-lisp.el100444 12120 1 62675 6055461233 14156 0ustar rmsdaemon;;; inf-lisp.el --- an inferior-lisp mode ;;; Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc. ;; Author: Olin Shivers ;; Keywords: processes, lisp ;;; 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: ;;; Hacked from tea.el by Olin Shivers (shivers@cs.cmu.edu). 8/88 ;;; This file defines a a lisp-in-a-buffer package (inferior-lisp ;;; mode) built on top of comint mode. This version is more ;;; featureful, robust, and uniform than the Emacs 18 version. The ;;; key bindings are also more compatible with the bindings of Hemlock ;;; and Zwei (the Lisp Machine emacs). ;;; Since this mode is built on top of the general command-interpreter-in- ;;; a-buffer mode (comint mode), it shares a common base functionality, ;;; and a common set of bindings, with all modes derived from comint mode. ;;; This makes these modes easier to use. ;;; For documentation on the functionality provided by comint mode, and ;;; the hooks available for customising it, see the file comint.el. ;;; For further information on inferior-lisp mode, see the comments below. ;;; Needs fixin: ;;; The load-file/compile-file default mechanism could be smarter -- it ;;; doesn't know about the relationship between filename extensions and ;;; whether the file is source or executable. If you compile foo.lisp ;;; with compile-file, then the next load-file should use foo.bin for ;;; the default, not foo.lisp. This is tricky to do right, particularly ;;; because the extension for executable files varies so much (.o, .bin, ;;; .lbin, .mo, .vo, .ao, ...). ;;; ;;; It would be nice if inferior-lisp (and inferior scheme, T, ...) modes ;;; had a verbose minor mode wherein sending or compiling defuns, etc. ;;; would be reflected in the transcript with suitable comments, e.g. ;;; ";;; redefining fact". Several ways to do this. Which is right? ;;; ;;; When sending text from a source file to a subprocess, the process-mark can ;;; move off the window, so you can lose sight of the process interactions. ;;; Maybe I should ensure the process mark is in the window when I send ;;; text to the process? Switch selectable? ;;; Code: (require 'comint) (require 'lisp-mode) ;;;###autoload (defvar inferior-lisp-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'" "*What not to save on inferior Lisp's input history. Input matching this regexp is not saved on the input history in Inferior Lisp mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword \(as in :a, :c, etc.)") (defvar inferior-lisp-mode-map nil) (cond ((not inferior-lisp-mode-map) (setq inferior-lisp-mode-map (copy-keymap comint-mode-map)) (setq inferior-lisp-mode-map (nconc inferior-lisp-mode-map shared-lisp-mode-map)) (define-key inferior-lisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp) (define-key inferior-lisp-mode-map "\C-c\C-l" 'lisp-load-file) (define-key inferior-lisp-mode-map "\C-c\C-k" 'lisp-compile-file) (define-key inferior-lisp-mode-map "\C-c\C-a" 'lisp-show-arglist) (define-key inferior-lisp-mode-map "\C-c\C-d" 'lisp-describe-sym) (define-key inferior-lisp-mode-map "\C-c\C-f" 'lisp-show-function-documentation) (define-key inferior-lisp-mode-map "\C-c\C-v" 'lisp-show-variable-documentation))) ;;; These commands augment Lisp mode, so you can process Lisp code in ;;; the source files. (define-key lisp-mode-map "\M-\C-x" 'lisp-eval-defun) ; Gnu convention (define-key lisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp) ; Gnu convention (define-key lisp-mode-map "\C-c\C-e" 'lisp-eval-defun) (define-key lisp-mode-map "\C-c\C-r" 'lisp-eval-region) (define-key lisp-mode-map "\C-c\C-c" 'lisp-compile-defun) (define-key lisp-mode-map "\C-c\C-z" 'switch-to-lisp) (define-key lisp-mode-map "\C-c\C-l" 'lisp-load-file) (define-key lisp-mode-map "\C-c\C-k" 'lisp-compile-file) ; "kompile" file (define-key lisp-mode-map "\C-c\C-a" 'lisp-show-arglist) (define-key lisp-mode-map "\C-c\C-d" 'lisp-describe-sym) (define-key lisp-mode-map "\C-c\C-f" 'lisp-show-function-documentation) (define-key lisp-mode-map "\C-c\C-v" 'lisp-show-variable-documentation) ;;; This function exists for backwards compatibility. ;;; Previous versions of this package bound commands to C-c ;;; bindings, which is not allowed by the gnumacs standard. ;;; "This function binds many inferior-lisp commands to C-c bindings, ;;;where they are more accessible. C-c bindings are reserved for the ;;;user, so these bindings are non-standard. If you want them, you should ;;;have this function called by the inferior-lisp-load-hook: ;;; (setq inferior-lisp-load-hook '(inferior-lisp-install-letter-bindings)) ;;;You can modify this function to install just the bindings you want." (defun inferior-lisp-install-letter-bindings () (define-key lisp-mode-map "\C-ce" 'lisp-eval-defun-and-go) (define-key lisp-mode-map "\C-cr" 'lisp-eval-region-and-go) (define-key lisp-mode-map "\C-cc" 'lisp-compile-defun-and-go) (define-key lisp-mode-map "\C-cz" 'switch-to-lisp) (define-key lisp-mode-map "\C-cl" 'lisp-load-file) (define-key lisp-mode-map "\C-ck" 'lisp-compile-file) (define-key lisp-mode-map "\C-ca" 'lisp-show-arglist) (define-key lisp-mode-map "\C-cd" 'lisp-describe-sym) (define-key lisp-mode-map "\C-cf" 'lisp-show-function-documentation) (define-key lisp-mode-map "\C-cv" 'lisp-show-variable-documentation) (define-key inferior-lisp-mode-map "\C-cl" 'lisp-load-file) (define-key inferior-lisp-mode-map "\C-ck" 'lisp-compile-file) (define-key inferior-lisp-mode-map "\C-ca" 'lisp-show-arglist) (define-key inferior-lisp-mode-map "\C-cd" 'lisp-describe-sym) (define-key inferior-lisp-mode-map "\C-cf" 'lisp-show-function-documentation) (define-key inferior-lisp-mode-map "\C-cv" 'lisp-show-variable-documentation)) ;;;###autoload (defvar inferior-lisp-program "lisp" "*Program name for invoking an inferior Lisp with for Inferior Lisp mode.") ;;;###autoload (defvar inferior-lisp-load-command "(load \"%s\")\n" "*Format-string for building a Lisp expression to load a file. This format string should use `%s' to substitute a file name and should result in a Lisp expression that will command the inferior Lisp to load that file. The default works acceptably on most Lisps. The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\n\" produces cosmetically superior output for this application, but it works only in Common Lisp.") ;;;###autoload (defvar inferior-lisp-prompt "^[^> \n]*>+:? *" "Regexp to recognise prompts in the Inferior Lisp mode. Defaults to \"^[^> \\n]*>+:? *\", which works pretty good for Lucid, kcl, and franz. This variable is used to initialize `comint-prompt-regexp' in the Inferior Lisp buffer. More precise choices: Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\" franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\" kcl: \"^>+ *\" This is a fine thing to set in your .emacs file.") (defvar inferior-lisp-buffer nil "*The current inferior-lisp process buffer. MULTIPLE PROCESS SUPPORT =========================================================================== To run multiple Lisp processes, you start the first up with \\[inferior-lisp]. It will be in a buffer named `*inferior-lisp*'. Rename this buffer with \\[rename-buffer]. You may now start up a new process with another \\[inferior-lisp]. It will be in a new buffer, named `*inferior-lisp*'. You can switch between the different process buffers with \\[switch-to-buffer]. Commands that send text from source buffers to Lisp processes -- like `lisp-eval-defun' or `lisp-show-arglist' -- have to choose a process to send to, when you have more than one Lisp process around. This is determined by the global variable `inferior-lisp-buffer'. Suppose you have three inferior Lisps running: Buffer Process foo inferior-lisp bar inferior-lisp<2> *inferior-lisp* inferior-lisp<3> If you do a \\[lisp-eval-defun] command on some Lisp source code, what process do you send it to? - If you're in a process buffer (foo, bar, or *inferior-lisp*), you send it to that process. - If you're in some other buffer (e.g., a source file), you send it to the process attached to buffer `inferior-lisp-buffer'. This process selection is performed by function `inferior-lisp-proc'. Whenever \\[inferior-lisp] fires up a new process, it resets `inferior-lisp-buffer' to be the new process's buffer. If you only run one process, this does the right thing. If you run multiple processes, you can change `inferior-lisp-buffer' to another process buffer with \\[set-variable].") ;;;###autoload (defvar inferior-lisp-mode-hook '() "*Hook for customising Inferior Lisp mode.") (defun inferior-lisp-mode () "Major mode for interacting with an inferior Lisp process. Runs a Lisp interpreter as a subprocess of Emacs, with Lisp I/O through an Emacs buffer. Variable `inferior-lisp-program' controls which Lisp interpreter is run. Variables `inferior-lisp-prompt', `inferior-lisp-filter-regexp' and `inferior-lisp-load-command' can customize this mode for different Lisp interpreters. For information on running multiple processes in multiple buffers, see documentation for variable `inferior-lisp-buffer'. \\{inferior-lisp-mode-map} Customisation: Entry to this mode runs the hooks on `comint-mode-hook' and `inferior-lisp-mode-hook' (in that order). You can send text to the inferior Lisp process from other buffers containing Lisp source. switch-to-lisp switches the current buffer to the Lisp process buffer. lisp-eval-defun sends the current defun to the Lisp process. lisp-compile-defun compiles the current defun. lisp-eval-region sends the current region to the Lisp process. lisp-compile-region compiles the current region. Prefixing the lisp-eval/compile-defun/region commands with a \\[universal-argument] causes a switch to the Lisp process buffer after sending the text. Commands: Return after the end of the process' output sends the text from the end of process to point. Return before the end of the process' output copies the sexp ending at point to the end of the process' output, and sends it. Delete converts tabs to spaces as it moves back. Tab indents for Lisp; with argument, shifts rest of expression rigidly with the current line. C-M-q does Tab on each line starting within following expression. Paragraphs are separated only by blank lines. Semicolons start comments. If you accidentally suspend your process, use \\[comint-continue-subjob] to continue it." (interactive) (comint-mode) (setq comint-prompt-regexp inferior-lisp-prompt) (setq major-mode 'inferior-lisp-mode) (setq mode-name "Inferior Lisp") (setq mode-line-process '(":%s")) (lisp-mode-variables t) (use-local-map inferior-lisp-mode-map) ;c-c c-k for "kompile" file (setq comint-get-old-input (function lisp-get-old-input)) (setq comint-input-filter (function lisp-input-filter)) (setq comint-input-sentinel 'ignore) (run-hooks 'inferior-lisp-mode-hook)) (defun lisp-get-old-input () "Return a string containing the sexp ending at point." (save-excursion (let ((end (point))) (backward-sexp) (buffer-substring (point) end)))) (defun lisp-input-filter (str) "t if STR does not match `inferior-lisp-filter-regexp'." (not (string-match inferior-lisp-filter-regexp str))) ;;;###autoload (defun inferior-lisp (cmd) "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'. If there is a process already running in `*inferior-lisp*', just switch to that buffer. With argument, allows you to edit the command line (default is value of `inferior-lisp-program'). Runs the hooks from `inferior-lisp-mode-hook' (after the `comint-mode-hook' is run). \(Type \\[describe-mode] in the process buffer for a list of commands.)" (interactive (list (if current-prefix-arg (read-string "Run lisp: " inferior-lisp-program) inferior-lisp-program))) (if (not (comint-check-proc "*inferior-lisp*")) (let ((cmdlist (inferior-lisp-args-to-list cmd))) (set-buffer (apply (function make-comint) "inferior-lisp" (car cmdlist) nil (cdr cmdlist))) (inferior-lisp-mode))) (setq inferior-lisp-buffer "*inferior-lisp*") (pop-to-buffer "*inferior-lisp*")) ;;;###autoload (add-hook 'same-window-buffer-names "*inferior-lisp*") ;;;###autoload (defalias 'run-lisp 'inferior-lisp) ;;; Break a string up into a list of arguments. ;;; This will break if you have an argument with whitespace, as in ;;; string = "-ab +c -x 'you lose'". (defun inferior-lisp-args-to-list (string) (let ((where (string-match "[ \t]" string))) (cond ((null where) (list string)) ((not (= where 0)) (cons (substring string 0 where) (inferior-lisp-args-to-list (substring string (+ 1 where) (length string))))) (t (let ((pos (string-match "[^ \t]" string))) (if (null pos) nil (inferior-lisp-args-to-list (substring string pos (length string))))))))) (defun lisp-eval-region (start end &optional and-go) "Send the current region to the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards." (interactive "r\nP") (comint-send-region (inferior-lisp-proc) start end) (comint-send-string (inferior-lisp-proc) "\n") (if and-go (switch-to-lisp t))) (defun lisp-eval-defun (&optional and-go) "Send the current defun to the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards." (interactive "P") (save-excursion (end-of-defun) (skip-chars-backward " \t\n\r\f") ; Makes allegro happy (let ((end (point))) (beginning-of-defun) (lisp-eval-region (point) end))) (if and-go (switch-to-lisp t))) (defun lisp-eval-last-sexp (&optional and-go) "Send the previous sexp to the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards." (interactive "P") (lisp-eval-region (save-excursion (backward-sexp) (point)) (point) and-go)) ;;; Common Lisp COMPILE sux. (defun lisp-compile-region (start end &optional and-go) "Compile the current region in the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards." (interactive "r\nP") (comint-send-string (inferior-lisp-proc) (format "(funcall (compile nil `(lambda () (progn 'compile %s))))\n" (buffer-substring start end))) (if and-go (switch-to-lisp t))) (defun lisp-compile-defun (&optional and-go) "Compile the current defun in the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards." (interactive "P") (save-excursion (end-of-defun) (skip-chars-backward " \t\n\r\f") ; Makes allegro happy (let ((e (point))) (beginning-of-defun) (lisp-compile-region (point) e))) (if and-go (switch-to-lisp t))) (defun switch-to-lisp (eob-p) "Switch to the inferior Lisp process buffer. With argument, positions cursor at end of buffer." (interactive "P") (if (get-buffer inferior-lisp-buffer) (pop-to-buffer inferior-lisp-buffer) (error "No current inferior Lisp buffer")) (cond (eob-p (push-mark) (goto-char (point-max))))) ;;; Now that lisp-compile/eval-defun/region takes an optional prefix arg, ;;; these commands are redundant. But they are kept around for the user ;;; to bind if he wishes, for backwards functionality, and because it's ;;; easier to type C-c e than C-u C-c C-e. (defun lisp-eval-region-and-go (start end) "Send the current region to the inferior Lisp, and switch to its buffer." (interactive "r") (lisp-eval-region start end t)) (defun lisp-eval-defun-and-go () "Send the current defun to the inferior Lisp, and switch to its buffer." (interactive) (lisp-eval-defun t)) (defun lisp-compile-region-and-go (start end) "Compile the current region in the inferior Lisp, and switch to its buffer." (interactive "r") (lisp-compile-region start end t)) (defun lisp-compile-defun-and-go () "Compile the current defun in the inferior Lisp, and switch to its buffer." (interactive) (lisp-compile-defun t)) ;;; A version of the form in H. Shevis' soar-mode.el package. Less robust. ;;; (defun lisp-compile-sexp (start end) ;;; "Compile the s-expression bounded by START and END in the inferior lisp. ;;; If the sexp isn't a DEFUN form, it is evaluated instead." ;;; (cond ((looking-at "(defun\\s +") ;;; (goto-char (match-end 0)) ;;; (let ((name-start (point))) ;;; (forward-sexp 1) ;;; (process-send-string "inferior-lisp" ;;; (format "(compile '%s #'(lambda " ;;; (buffer-substring name-start ;;; (point))))) ;;; (let ((body-start (point))) ;;; (goto-char start) (forward-sexp 1) ; Can't use end-of-defun. ;;; (process-send-region "inferior-lisp" ;;; (buffer-substring body-start (point)))) ;;; (process-send-string "inferior-lisp" ")\n")) ;;; (t (lisp-eval-region start end))))) ;;; ;;; (defun lisp-compile-region (start end) ;;; "Each s-expression in the current region is compiled (if a DEFUN) ;;; or evaluated (if not) in the inferior lisp." ;;; (interactive "r") ;;; (save-excursion ;;; (goto-char start) (end-of-defun) (beginning-of-defun) ; error check ;;; (if (< (point) start) (error "region begins in middle of defun")) ;;; (goto-char start) ;;; (let ((s start)) ;;; (end-of-defun) ;;; (while (<= (point) end) ; Zip through ;;; (lisp-compile-sexp s (point)) ; compiling up defun-sized chunks. ;;; (setq s (point)) ;;; (end-of-defun)) ;;; (if (< s end) (lisp-compile-sexp s end))))) ;;; ;;; End of HS-style code (defvar lisp-prev-l/c-dir/file nil "Record last directory and file used in loading or compiling. This holds a cons cell of the form `(DIRECTORY . FILE)' describing the last `lisp-load-file' or `lisp-compile-file' command.") (defvar lisp-source-modes '(lisp-mode) "*Used to determine if a buffer contains Lisp source code. If it's loaded into a buffer that is in one of these major modes, it's considered a Lisp source file by `lisp-load-file' and `lisp-compile-file'. Used by these commands to determine defaults.") (defun lisp-load-file (file-name) "Load a Lisp file into the inferior Lisp process." (interactive (comint-get-source "Load Lisp file: " lisp-prev-l/c-dir/file lisp-source-modes nil)) ; NIL because LOAD ; doesn't need an exact name (comint-check-source file-name) ; Check to see if buffer needs saved. (setq lisp-prev-l/c-dir/file (cons (file-name-directory file-name) (file-name-nondirectory file-name))) (comint-send-string (inferior-lisp-proc) (format inferior-lisp-load-command file-name)) (switch-to-lisp t)) (defun lisp-compile-file (file-name) "Compile a Lisp file in the inferior Lisp process." (interactive (comint-get-source "Compile Lisp file: " lisp-prev-l/c-dir/file lisp-source-modes nil)) ; NIL = don't need ; suffix .lisp (comint-check-source file-name) ; Check to see if buffer needs saved. (setq lisp-prev-l/c-dir/file (cons (file-name-directory file-name) (file-name-nondirectory file-name))) (comint-send-string (inferior-lisp-proc) (concat "(compile-file \"" file-name "\"\)\n")) (switch-to-lisp t)) ;;; Documentation functions: function doc, var doc, arglist, and ;;; describe symbol. ;;; =========================================================================== ;;; Command strings ;;; =============== (defvar lisp-function-doc-command "(let ((fn '%s)) (format t \"Documentation for ~a:~&~a\" fn (documentation fn 'function)) (values))\n" "Command to query inferior Lisp for a function's documentation.") (defvar lisp-var-doc-command "(let ((v '%s)) (format t \"Documentation for ~a:~&~a\" v (documentation v 'variable)) (values))\n" "Command to query inferior Lisp for a variable's documentation.") (defvar lisp-arglist-command "(let ((fn '%s)) (format t \"Arglist for ~a: ~a\" fn (arglist fn)) (values))\n" "Command to query inferior Lisp for a function's arglist.") (defvar lisp-describe-sym-command "(describe '%s)\n" "Command to query inferior Lisp for a variable's documentation.") ;;; Ancillary functions ;;; =================== ;;; Reads a string from the user. (defun lisp-symprompt (prompt default) (list (let* ((prompt (if default (format "%s (default %s): " prompt default) (concat prompt ": "))) (ans (read-string prompt))) (if (zerop (length ans)) default ans)))) ;;; Adapted from function-called-at-point in help.el. (defun lisp-fn-called-at-pt () "Returns the name of the function called in the current call. The value is nil if it can't find one." (condition-case nil (save-excursion (save-restriction (narrow-to-region (max (point-min) (- (point) 1000)) (point-max)) (backward-up-list 1) (forward-char 1) (let ((obj (read (current-buffer)))) (and (symbolp obj) obj)))) (error nil))) ;;; Adapted from variable-at-point in help.el. (defun lisp-var-at-pt () (condition-case () (save-excursion (forward-sexp -1) (skip-chars-forward "'") (let ((obj (read (current-buffer)))) (and (symbolp obj) obj))) (error nil))) ;;; Documentation functions: fn and var doc, arglist, and symbol describe. ;;; ====================================================================== (defun lisp-show-function-documentation (fn) "Send a command to the inferior Lisp to give documentation for function FN. See variable `lisp-function-doc-command'." (interactive (lisp-symprompt "Function doc" (lisp-fn-called-at-pt))) (comint-proc-query (inferior-lisp-proc) (format lisp-function-doc-command fn))) (defun lisp-show-variable-documentation (var) "Send a command to the inferior Lisp to give documentation for function FN. See variable `lisp-var-doc-command'." (interactive (lisp-symprompt "Variable doc" (lisp-var-at-pt))) (comint-proc-query (inferior-lisp-proc) (format lisp-var-doc-command var))) (defun lisp-show-arglist (fn) "Send a query to the inferior Lisp for the arglist for function FN. See variable `lisp-arglist-command'." (interactive (lisp-symprompt "Arglist" (lisp-fn-called-at-pt))) (comint-proc-query (inferior-lisp-proc) (format lisp-arglist-command fn))) (defun lisp-describe-sym (sym) "Send a command to the inferior Lisp to describe symbol SYM. See variable `lisp-describe-sym-command'." (interactive (lisp-symprompt "Describe" (lisp-var-at-pt))) (comint-proc-query (inferior-lisp-proc) (format lisp-describe-sym-command sym))) ;; "Returns the current inferior Lisp process. ;; See variable `inferior-lisp-buffer'." (defun inferior-lisp-proc () (let ((proc (get-buffer-process (if (eq major-mode 'inferior-lisp-mode) (current-buffer) inferior-lisp-buffer)))) (or proc (error "No Lisp subprocess; see variable `inferior-lisp-buffer'")))) ;;; Do the user's customisation... ;;;=============================== (defvar inferior-lisp-load-hook nil "This hook is run when the library `inf-lisp' is loaded. This is a good place to put keybindings.") (run-hooks 'inferior-lisp-load-hook) ;;; CHANGE LOG ;;; =========================================================================== ;;; 7/21/92 Jim Blandy ;;; - Changed all uses of the cmulisp name or prefix to inferior-lisp; ;;; this is now the official inferior lisp package. Use the global ;;; ChangeLog from now on. ;;; 5/24/90 Olin ;;; - Split cmulisp and cmushell modes into separate files. ;;; Not only is this a good idea, it's apparently the way it'll be rel 19. ;;; - Upgraded process sends to use comint-send-string instead of ;;; process-send-string. ;;; - Explicit references to process "cmulisp" have been replaced with ;;; (cmulisp-proc). This allows better handling of multiple process bufs. ;;; - Added process query and var/function/symbol documentation ;;; commands. Based on code written by Douglas Roberts. ;;; - Added lisp-eval-last-sexp, bound to C-x C-e. ;;; ;;; 9/20/90 Olin ;;; Added a save-restriction to lisp-fn-called-at-pt. This bug and fix ;;; reported by Lennart Staflin. ;;; ;;; 3/12/90 Olin ;;; - lisp-load-file and lisp-compile-file no longer switch-to-lisp. ;;; Tale suggested this. ;;; - Reversed this decision 7/15/91. You need the visual feedback. ;;; ;;; 7/25/91 Olin ;;; Changed all keybindings of the form C-c . These are ;;; supposed to be reserved for the user to bind. This affected ;;; mainly the compile/eval-defun/region[-and-go] commands. ;;; This was painful, but necessary to adhere to the gnumacs standard. ;;; For some backwards compatibility, see the ;;; cmulisp-install-letter-bindings ;;; function. ;;; ;;; 8/2/91 Olin ;;; - The lisp-compile/eval-defun/region commands now take a prefix arg, ;;; which means switch-to-lisp after sending the text to the Lisp process. ;;; This obsoletes all the -and-go commands. The -and-go commands are ;;; kept around for historical reasons, and because the user can bind ;;; them to key sequences shorter than C-u C-c C-. ;;; - If M-x cmulisp is invoked with a prefix arg, it allows you to ;;; edit the command line. (provide 'inf-lisp) ;;; inf-lisp.el ends here emacs-19.30/lisp/info.el100444 12120 1 201040 6054440170 13361 0ustar rmsdaemon;;; info.el --- info package for Emacs. ;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help ;; 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: ;;; Note that nowadays we expect info files to be made using makeinfo. ;;; Code: (defvar Info-history nil "List of info nodes user has visited. Each element of list is a list (FILENAME NODENAME BUFFERPOS).") (defvar Info-enable-edit nil "*Non-nil means the \\\\[Info-edit] command in Info can edit the current node. This is convenient if you want to write info files by hand. However, we recommend that you not do this. It is better to write a Texinfo file and generate the Info file from that, because that gives you a printed manual as well.") (defvar Info-enable-active-nodes t "Non-nil allows Info to execute Lisp code associated with nodes. The Lisp code is executed when the node is selected.") (defvar Info-fontify t "*Non-nil enables highlighting and fonts in Info nodes.") (defvar Info-fontify-maximum-menu-size 30000 "*Maximum size of menu to fontify if `Info-fontify' is non-nil.") (defvar Info-directory-list (let ((path (getenv "INFOPATH")) ;; This is for older Emacs versions ;; which might get this info.el from the Texinfo distribution. (path-separator (if (boundp 'path-separator) path-separator (if (eq system-type 'ms-dos) ";" ":"))) (source (expand-file-name "info/" source-directory)) (sibling (if installation-directory (expand-file-name "info/" installation-directory))) alternative) (if path (let ((list nil) idx) (while (> (length path) 0) (setq idx (or (string-match path-separator path) (length path)) list (cons (substring path 0 idx) list) path (substring path (min (1+ idx) (length path))))) (nreverse list)) (if (and sibling (file-exists-p sibling)) (setq alternative sibling) (setq alternative source)) (if (or (member alternative Info-default-directory-list) (not (file-exists-p alternative)) ;; On DOS/NT, we use movable executables always, ;; and we must always find the Info dir at run time. (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt)) nil ;; Use invocation-directory for Info only if we used it for ;; exec-directory also. (not (string= exec-directory (expand-file-name "lib-src/" installation-directory))))) Info-default-directory-list (reverse (cons alternative (cdr (reverse Info-default-directory-list))))))) "List of directories to search for Info documentation files. nil means not yet initialized. In this case, Info uses the environment variable INFOPATH to initialize it, or `Info-default-directory-list' if there is no INFOPATH variable in the environment. The last element of `Info-default-directory-list' is the directory where Emacs installs the Info files that come with it. If you run the Emacs executable from the `src' directory in the Emacs source tree, the `info' directory in the source tree is used as the last element, in place of the installation Info directory. This is useful when you run a version of Emacs without installing it.") (defvar Info-additional-directory-list nil "List of additional directories to search for Info documentation files. These directories are not searched for merging the `dir' file.") (defvar Info-current-file nil "Info file that Info is now looking at, or nil. This is the name that was specified in Info, not the actual file name. It doesn't contain directory names or file name extensions added by Info.") (defvar Info-current-subfile nil "Info subfile that is actually in the *info* buffer now, or nil if current info file is not split into subfiles.") (defvar Info-current-node nil "Name of node that Info is now looking at, or nil.") (defvar Info-tag-table-marker (make-marker) "Marker pointing at beginning of current Info file's tag table. Marker points nowhere if file has no tag table.") (defvar Info-current-file-completions nil "Cached completion list for current Info file.") (defvar Info-index-alternatives nil "List of possible matches for last Info-index command.") (defvar Info-standalone nil "Non-nil if Emacs was started solely as an Info browser.") (defvar Info-suffix-list (if (eq system-type 'ms-dos) '( (".gz" . "gunzip") (".z" . "gunzip") (".inf" . nil) ("" . nil)) '( (".info.Z" . "uncompress") (".info.Y" . "unyabba") (".info.gz" . "gunzip") (".info.z" . "gunzip") (".info" . nil) (".Z" . "uncompress") (".Y" . "unyabba") (".gz" . "gunzip") (".z" . "gunzip") ("" . nil))) "List of file name suffixes and associated decoding commands. Each entry should be (SUFFIX . STRING); the file is given to the command as standard input. If STRING is nil, no decoding is done. Because the SUFFIXes are tried in order, the empty string should be last in the list.") ;; Concatenate SUFFIX onto FILENAME. SUFFIX should start with a dot. ;; First, on ms-dos, delete some of the extension in FILENAME ;; to make room. (defun info-insert-file-contents-1 (filename suffix) (if (not (eq system-type 'ms-dos)) (concat filename suffix) (let* ((sans-exts (file-name-sans-extension filename)) ;; How long is the extension in FILENAME (not counting the dot). (ext-len (max 0 (- (length filename) (length sans-exts) 1))) ext-left) ;; SUFFIX starts with a dot. If FILENAME already has one, ;; get rid of the one in SUFFIX. (or (and (<= ext-len 0) (not (eq (aref filename (1- (length filename))) ?.))) (setq suffix (substring suffix 1))) ;; How many chars of that extension should we keep? (setq ext-left (min ext-len (max 0 (- 3 (length suffix))))) ;; Get rid of the rest of the extension, and add SUFFIX. (concat (substring filename 0 (- (length filename) (- ext-len ext-left))) suffix)))) (defun info-insert-file-contents (filename &optional visit) "Insert the contents of an info file in the current buffer. Do the right thing if the file has been compressed or zipped." (let ((tail Info-suffix-list) fullname decoder) (if (file-exists-p filename) ;; FILENAME exists--see if that name contains a suffix. ;; If so, set DECODE accordingly. (progn (while (and tail (not (string-match (concat (regexp-quote (car (car tail))) "$") filename))) (setq tail (cdr tail))) (setq fullname filename decoder (cdr (car tail)))) ;; Try adding suffixes to FILENAME and see if we can find something. (while (and tail (not (file-exists-p (info-insert-file-contents-1 filename (car (car tail)))))) (setq tail (cdr tail))) ;; If we found a file with a suffix, set DECODER according to the suffix ;; and set FULLNAME to the file's actual name. (setq fullname (info-insert-file-contents-1 filename (car (car tail))) decoder (cdr (car tail))) (or tail (error "Can't find %s or any compressed version of it" filename))) ;; check for conflict with jka-compr (if (and (featurep 'jka-compr) (jka-compr-installed-p) (jka-compr-get-compression-info fullname)) (setq decoder nil)) (insert-file-contents fullname visit) (if decoder (let ((buffer-read-only nil) (default-directory (or (file-name-directory fullname) default-directory))) (call-process-region (point-min) (point-max) decoder t t))))) ;;;###autoload (add-hook 'same-window-buffer-names "*info*") ;;;###autoload (defun info (&optional file) "Enter Info, the documentation browser. Optional argument FILE specifies the file to examine; the default is the top-level directory of Info. In interactive use, a prefix argument directs this command to read a file name from the minibuffer." (interactive (if current-prefix-arg (list (read-file-name "Info file name: " nil nil t)))) (if file (Info-goto-node (concat "(" file ")")) (if (get-buffer "*info*") (pop-to-buffer "*info*") (Info-directory)))) ;;;###autoload (defun info-standalone () "Run Emacs as a standalone Info reader. Usage: emacs -f info-standalone [filename] In standalone mode, \\\\[Info-exit] exits Emacs itself." (setq Info-standalone t) (if (and command-line-args-left (not (string-match "^-" (car command-line-args-left)))) (condition-case err (progn (info (car command-line-args-left)) (setq command-line-args-left (cdr command-line-args-left))) (error (send-string-to-terminal (format "%s\n" (if (eq (car-safe err) 'error) (nth 1 err) err))) (save-buffers-kill-emacs))) (info))) ;; Go to an info node specified as separate filename and nodename. ;; no-going-back is non-nil if recovering from an error in this function; ;; it says do not attempt further (recursive) error recovery. (defun Info-find-node (filename nodename &optional no-going-back) ;; Convert filename to lower case if not found as specified. ;; Expand it. (if filename (let (temp temp-downcase found) (setq filename (substitute-in-file-name filename)) (if (string= (downcase (file-name-nondirectory filename)) "dir") (setq found t) (let ((dirs (if (string-match "^\\./" filename) ;; If specified name starts with `./' ;; then just try current directory. '("./") (if (file-name-absolute-p filename) ;; No point in searching for an ;; absolute file name '(nil) (if Info-additional-directory-list (append Info-directory-list Info-additional-directory-list) Info-directory-list))))) ;; Search the directory list for file FILENAME. (while (and dirs (not found)) (setq temp (expand-file-name filename (car dirs))) (setq temp-downcase (expand-file-name (downcase filename) (car dirs))) ;; Try several variants of specified name. (let ((suffix-list Info-suffix-list)) (while (and suffix-list (not found)) (cond ((file-exists-p (info-insert-file-contents-1 temp (car (car suffix-list)))) (setq found temp)) ((file-exists-p (info-insert-file-contents-1 temp-downcase (car (car suffix-list)))) (setq found temp-downcase))) (setq suffix-list (cdr suffix-list)))) (setq dirs (cdr dirs))))) (if found (setq filename found) (error "Info file %s does not exist" filename)))) ;; Record the node we are leaving. (if (and Info-current-file (not no-going-back)) (setq Info-history (cons (list Info-current-file Info-current-node (point)) Info-history))) ;; Go into info buffer. (switch-to-buffer "*info*") (buffer-disable-undo (current-buffer)) (or (eq major-mode 'Info-mode) (Info-mode)) (widen) (setq Info-current-node nil) (unwind-protect (progn ;; Switch files if necessary (or (null filename) (equal Info-current-file filename) (let ((buffer-read-only nil)) (setq Info-current-file nil Info-current-subfile nil Info-current-file-completions nil Info-index-alternatives nil buffer-file-name nil) (erase-buffer) (if (eq filename t) (Info-insert-dir) (info-insert-file-contents filename t) (setq default-directory (file-name-directory filename))) (set-buffer-modified-p nil) ;; See whether file has a tag table. Record the location if yes. (set-marker Info-tag-table-marker nil) (goto-char (point-max)) (forward-line -8) ;; Use string-equal, not equal, to ignore text props. (or (string-equal nodename "*") (not (search-forward "\^_\nEnd tag table\n" nil t)) (let (pos) ;; We have a tag table. Find its beginning. ;; Is this an indirect file? (search-backward "\nTag table:\n") (setq pos (point)) (if (save-excursion (forward-line 2) (looking-at "(Indirect)\n")) ;; It is indirect. Copy it to another buffer ;; and record that the tag table is in that buffer. (save-excursion (let ((buf (current-buffer))) (set-buffer (get-buffer-create " *info tag table*")) (buffer-disable-undo (current-buffer)) (setq case-fold-search t) (erase-buffer) (insert-buffer-substring buf) (set-marker Info-tag-table-marker (match-end 0)))) (set-marker Info-tag-table-marker pos)))) (setq Info-current-file (if (eq filename t) "dir" filename)))) ;; Use string-equal, not equal, to ignore text props. (if (string-equal nodename "*") (progn (setq Info-current-node nodename) (Info-set-mode-line)) ;; Search file for a suitable node. (let ((guesspos (point-min)) (regexp (concat "Node: *" (regexp-quote nodename) " *[,\t\n\177]"))) ;; First get advice from tag table if file has one. ;; Also, if this is an indirect info file, ;; read the proper subfile into this buffer. (if (marker-position Info-tag-table-marker) (save-excursion (set-buffer (marker-buffer Info-tag-table-marker)) (goto-char Info-tag-table-marker) (if (re-search-forward regexp nil t) (progn (setq guesspos (read (current-buffer))) ;; If this is an indirect file, ;; determine which file really holds this node ;; and read it in. (if (not (eq (current-buffer) (get-buffer "*info*"))) (setq guesspos (Info-read-subfile guesspos)))) (error "No such node: \"%s\"" nodename)))) (goto-char (max (point-min) (- guesspos 1000))) ;; Now search from our advised position (or from beg of buffer) ;; to find the actual node. (catch 'foo (while (search-forward "\n\^_" nil t) (forward-line 1) (let ((beg (point))) (forward-line 1) (if (re-search-backward regexp beg t) (throw 'foo t)))) (error "No such node: %s" nodename))) (Info-select-node))) ;; If we did not finish finding the specified node, ;; go back to the previous one. (or Info-current-node no-going-back (null Info-history) (let ((hist (car Info-history))) (setq Info-history (cdr Info-history)) (Info-find-node (nth 0 hist) (nth 1 hist) t) (goto-char (nth 2 hist))))) (goto-char (point-min))) ;; Cache the contents of the (virtual) dir file, once we have merged ;; it for the first time, so we can save time subsequently. (defvar Info-dir-contents nil) ;; Cache for the directory we decided to use for the default-directory ;; of the merged dir text. (defvar Info-dir-contents-directory nil) ;; Record the file attributes of all the files from which we ;; constructed Info-dir-contents. (defvar Info-dir-file-attributes nil) ;; Construct the Info directory node by merging the files named `dir' ;; from various directories. Set the *info* buffer's ;; default-directory to the first directory we actually get any text ;; from. (defun Info-insert-dir () (if (and Info-dir-contents Info-dir-file-attributes ;; Verify that none of the files we used has changed ;; since we used it. (eval (cons 'and (mapcar '(lambda (elt) (let ((curr (file-attributes (car elt)))) ;; Don't compare the access time. (if curr (setcar (nthcdr 4 curr) 0)) (setcar (nthcdr 4 (cdr elt)) 0) (equal (cdr elt) curr))) Info-dir-file-attributes)))) (insert Info-dir-contents) (let ((dirs Info-directory-list) buffers buffer others nodes dirs-done) (setq Info-dir-file-attributes nil) ;; Search the directory list for the directory file. (while dirs (let ((truename (file-truename (expand-file-name (car dirs))))) (or (member truename dirs-done) (member (directory-file-name truename) dirs-done) ;; Try several variants of specified name. ;; Try upcasing, appending `.info', or both. (let* (file (attrs (or (progn (setq file (expand-file-name "dir" truename)) (file-attributes file)) (progn (setq file (expand-file-name "DIR" truename)) (file-attributes file)) (progn (setq file (expand-file-name "dir.info" truename)) (file-attributes file)) (progn (setq file (expand-file-name "DIR.INFO" truename)) (file-attributes file))))) (setq dirs-done (cons truename (cons (directory-file-name truename) dirs-done))) (if attrs (save-excursion (or buffers (message "Composing main Info directory...")) (set-buffer (generate-new-buffer "info dir")) (insert-file-contents file) (setq buffers (cons (current-buffer) buffers) Info-dir-file-attributes (cons (cons file attrs) Info-dir-file-attributes)))))) (setq dirs (cdr dirs)))) (or buffers (error "Can't find the info directory node")) ;; Distinguish the dir file that comes with Emacs from all the ;; others. Yes, that is really what this is supposed to do. ;; If it doesn't work, fix it. (setq buffer (car buffers) others (cdr buffers)) ;; Insert the entire original dir file as a start; use its ;; default directory as the default directory for the whole ;; concatenation. (insert-buffer buffer) (setq Info-dir-contents-directory (save-excursion (set-buffer buffer) default-directory)) ;; Look at each of the other buffers one by one. (while others (let ((other (car others))) ;; In each, find all the menus. (save-excursion (set-buffer other) (goto-char (point-min)) ;; Find each menu, and add an elt to NODES for it. (while (re-search-forward "^\\* Menu:" nil t) (let (beg nodename end) (forward-line 1) (setq beg (point)) (search-backward "\n\^_") (search-forward "Node: ") (setq nodename (Info-following-node-name)) (search-forward "\n\^_" nil 'move) (beginning-of-line) (setq end (point)) (setq nodes (cons (list nodename other beg end) nodes)))))) (setq others (cdr others))) ;; Add to the main menu a menu item for each other node. (re-search-forward "^\\* Menu:") (forward-line 1) (let ((menu-items '("top")) (nodes nodes) (case-fold-search t) (end (save-excursion (search-forward "\^_" nil t) (point)))) (while nodes (let ((nodename (car (car nodes)))) (save-excursion (or (member (downcase nodename) menu-items) (re-search-forward (concat "^\\* " (regexp-quote nodename) "::") end t) (progn (insert "* " nodename "::" "\n") (setq menu-items (cons nodename menu-items)))))) (setq nodes (cdr nodes)))) ;; Now take each node of each of the other buffers ;; and merge it into the main buffer. (while nodes (let ((nodename (car (car nodes)))) (goto-char (point-min)) ;; Find the like-named node in the main buffer. (if (re-search-forward (concat "\n\^_.*\n.*Node: " (regexp-quote nodename) "[,\n\t]") nil t) (progn (search-forward "\n\^_" nil 'move) (beginning-of-line) (insert "\n")) ;; If none exists, add one. (goto-char (point-max)) (insert "\^_\nFile: dir\tNode: " nodename "\n\n* Menu:\n\n")) ;; Merge the text from the other buffer's menu ;; into the menu in the like-named node in the main buffer. (apply 'insert-buffer-substring (cdr (car nodes)))) (setq nodes (cdr nodes))) ;; Kill all the buffers we just made. (while buffers (kill-buffer (car buffers)) (setq buffers (cdr buffers))) (message "Composing main Info directory...done")) (setq Info-dir-contents (buffer-string))) (setq default-directory Info-dir-contents-directory)) (defun Info-read-subfile (nodepos) (set-buffer (marker-buffer Info-tag-table-marker)) (goto-char (point-min)) (search-forward "\n\^_") (let (lastfilepos lastfilename) (forward-line 2) (catch 'foo (while (not (looking-at "\^_")) (if (not (eolp)) (let ((beg (point)) thisfilepos thisfilename) (search-forward ": ") (setq thisfilename (buffer-substring beg (- (point) 2))) (setq thisfilepos (read (current-buffer))) ;; read in version 19 stops at the end of number. ;; Advance to the next line. (forward-line 1) (if (> thisfilepos nodepos) (throw 'foo t)) (setq lastfilename thisfilename) (setq lastfilepos thisfilepos)) (forward-line 1)))) (set-buffer (get-buffer "*info*")) (or (equal Info-current-subfile lastfilename) (let ((buffer-read-only nil)) (setq buffer-file-name nil) (widen) (erase-buffer) (info-insert-file-contents lastfilename) (set-buffer-modified-p nil) (setq Info-current-subfile lastfilename))) (goto-char (point-min)) (search-forward "\n\^_") (+ (- nodepos lastfilepos) (point)))) ;; Select the info node that point is in. (defun Info-select-node () (save-excursion ;; Find beginning of node. (search-backward "\n\^_") (forward-line 2) ;; Get nodename spelled as it is in the node. (re-search-forward "Node:[ \t]*") (setq Info-current-node (buffer-substring-no-properties (point) (progn (skip-chars-forward "^,\t\n") (point)))) (Info-set-mode-line) ;; Find the end of it, and narrow. (beginning-of-line) (let (active-expression) (narrow-to-region (point) (if (re-search-forward "\n[\^_\f]" nil t) (prog1 (1- (point)) (if (looking-at "[\n\^_\f]*execute: ") (progn (goto-char (match-end 0)) (setq active-expression (read (current-buffer)))))) (point-max))) (if Info-enable-active-nodes (eval active-expression)) (if Info-fontify (Info-fontify-node)) (run-hooks 'Info-selection-hook)))) (defun Info-set-mode-line () (setq mode-line-buffer-identification (concat "Info: (" (if Info-current-file (file-name-nondirectory Info-current-file) "") ")" (or Info-current-node "")))) ;; Go to an info node specified with a filename-and-nodename string ;; of the sort that is found in pointers in nodes. (defun Info-goto-node (nodename) "Go to info node named NAME. Give just NODENAME or (FILENAME)NODENAME." (interactive (list (Info-read-node-name "Goto node: "))) (let (filename) (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)" nodename) (setq filename (if (= (match-beginning 1) (match-end 1)) "" (substring nodename (match-beginning 2) (match-end 2))) nodename (substring nodename (match-beginning 3) (match-end 3))) (let ((trim (string-match "\\s *\\'" filename))) (if trim (setq filename (substring filename 0 trim)))) (let ((trim (string-match "\\s *\\'" nodename))) (if trim (setq nodename (substring nodename 0 trim)))) (if transient-mark-mode (deactivate-mark)) (Info-find-node (if (equal filename "") nil filename) (if (equal nodename "") "Top" nodename)))) ;; This function is used as the "completion table" while reading a node name. ;; It does completion using the alist in completion-table ;; unless STRING starts with an open-paren. (defun Info-read-node-name-1 (string predicate code) (let ((no-completion (and (> (length string) 0) (eq (aref string 0) ?\()))) (cond ((eq code nil) (if no-completion string (try-completion string completion-table predicate))) ((eq code t) (if no-completion nil (all-completions string completion-table predicate))) ((eq code 'lambda) (if no-completion t (assoc string completion-table)))))) (defun Info-read-node-name (prompt &optional default) (let* ((completion-ignore-case t) (completion-table (Info-build-node-completions)) (nodename (completing-read prompt 'Info-read-node-name-1))) (if (equal nodename "") (or default (Info-read-node-name prompt)) nodename))) (defun Info-build-node-completions () (or Info-current-file-completions (let ((compl nil)) (save-excursion (save-restriction (if (marker-buffer Info-tag-table-marker) (progn (set-buffer (marker-buffer Info-tag-table-marker)) (widen) (goto-char Info-tag-table-marker) (while (re-search-forward "\nNode: \\(.*\\)\177" nil t) (setq compl (cons (list (buffer-substring (match-beginning 1) (match-end 1))) compl)))) (widen) (goto-char (point-min)) (while (search-forward "\n\^_" nil t) (forward-line 1) (let ((beg (point))) (forward-line 1) (if (re-search-backward "Node: *\\([^,\n]*\\) *[,\n\t]" beg t) (setq compl (cons (list (buffer-substring (match-beginning 1) (match-end 1))) compl)))))))) (setq Info-current-file-completions compl)))) (defun Info-restore-point (hl) "If this node has been visited, restore the point value when we left." (while hl (if (and (equal (nth 0 (car hl)) Info-current-file) ;; Use string-equal, not equal, to ignore text props. (string-equal (nth 1 (car hl)) Info-current-node)) (progn (goto-char (nth 2 (car hl))) (setq hl nil)) ;terminate the while at next iter (setq hl (cdr hl))))) (defvar Info-last-search nil "Default regexp for \\\\[Info-search] command to search for.") (defun Info-search (regexp) "Search for REGEXP, starting from point, and select node it's found in." (interactive "sSearch (regexp): ") (if transient-mark-mode (deactivate-mark)) (if (equal regexp "") (setq regexp Info-last-search) (setq Info-last-search regexp)) (let ((found ()) current (onode Info-current-node) (ofile Info-current-file) (opoint (point)) (osubfile Info-current-subfile)) (save-excursion (save-restriction (widen) (if (null Info-current-subfile) (progn (re-search-forward regexp) (setq found (point))) (condition-case err (progn (re-search-forward regexp) (setq found (point))) (search-failed nil))))) (if (not found) ;can only happen in subfile case -- else would have erred (unwind-protect (let ((list ())) (set-buffer (marker-buffer Info-tag-table-marker)) (goto-char (point-min)) (search-forward "\n\^_\nIndirect:") (save-restriction (narrow-to-region (point) (progn (search-forward "\n\^_") (1- (point)))) (goto-char (point-min)) (search-forward (concat "\n" osubfile ": ")) (beginning-of-line) (while (not (eobp)) (re-search-forward "\\(^.*\\): [0-9]+$") (goto-char (+ (match-end 1) 2)) (setq list (cons (cons (read (current-buffer)) (buffer-substring (match-beginning 1) (match-end 1))) list)) (goto-char (1+ (match-end 0)))) (setq list (nreverse list) current (car (car list)) list (cdr list))) (while list (message "Searching subfile %s..." (cdr (car list))) (Info-read-subfile (car (car list))) (setq list (cdr list)) ;; (goto-char (point-min)) (if (re-search-forward regexp nil t) (setq found (point) list ()))) (if found (message "") (signal 'search-failed (list regexp)))) (if (not found) (progn (Info-read-subfile opoint) (goto-char opoint) (Info-select-node))))) (widen) (goto-char found) (Info-select-node) ;; Use string-equal, not equal, to ignore text props. (or (and (string-equal onode Info-current-node) (equal ofile Info-current-file)) (setq Info-history (cons (list ofile onode opoint) Info-history))))) ;; Extract the value of the node-pointer named NAME. ;; If there is none, use ERRORNAME in the error message; ;; if ERRORNAME is nil, just return nil. (defun Info-extract-pointer (name &optional errorname) (save-excursion (goto-char (point-min)) (forward-line 1) (if (re-search-backward (concat name ":") nil t) (progn (goto-char (match-end 0)) (Info-following-node-name)) (if (eq errorname t) nil (error (concat "Node has no " (capitalize (or errorname name)))))))) ;; Return the node name in the buffer following point. ;; ALLOWEDCHARS, if non-nil, goes within [...] to make a regexp ;; saying which chas may appear in the node name. (defun Info-following-node-name (&optional allowedchars) (skip-chars-forward " \t") (buffer-substring-no-properties (point) (progn (while (looking-at (concat "[" (or allowedchars "^,\t\n") "]")) (skip-chars-forward (concat (or allowedchars "^,\t\n") "(")) (if (looking-at "(") (skip-chars-forward "^)"))) (skip-chars-backward " ") (point)))) (defun Info-next () "Go to the next node of this node." (interactive) (Info-goto-node (Info-extract-pointer "next"))) (defun Info-prev () "Go to the previous node of this node." (interactive) (Info-goto-node (Info-extract-pointer "prev[ious]*" "previous"))) (defun Info-up () "Go to the superior node of this node." (interactive) (Info-goto-node (Info-extract-pointer "up")) (Info-restore-point Info-history)) (defun Info-last () "Go back to the last node visited." (interactive) (or Info-history (error "This is the first Info node you looked at")) (let (filename nodename opoint) (setq filename (car (car Info-history))) (setq nodename (car (cdr (car Info-history)))) (setq opoint (car (cdr (cdr (car Info-history))))) (setq Info-history (cdr Info-history)) (Info-find-node filename nodename) (setq Info-history (cdr Info-history)) (goto-char opoint))) (defun Info-directory () "Go to the Info directory node." (interactive) (Info-find-node "dir" "top")) (defun Info-follow-reference (footnotename) "Follow cross reference named NAME to the node it refers to. NAME may be an abbreviation of the reference name." (interactive (let ((completion-ignore-case t) completions default alt-default (start-point (point)) str i bol eol) (save-excursion ;; Store end and beginning of line. (end-of-line) (setq eol (point)) (beginning-of-line) (setq bol (point)) (goto-char (point-min)) (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t) (setq str (buffer-substring (match-beginning 1) (1- (point)))) ;; See if this one should be the default. (and (null default) (<= (match-beginning 0) start-point) (<= start-point (point)) (setq default t)) ;; See if this one should be the alternate default. (and (null alt-default) (and (<= bol (match-beginning 0)) (<= (point) eol)) (setq alt-default t)) (setq i 0) (while (setq i (string-match "[ \n\t]+" str i)) (setq str (concat (substring str 0 i) " " (substring str (match-end 0)))) (setq i (1+ i))) ;; Record as a completion and perhaps as default. (if (eq default t) (setq default str)) (if (eq alt-default t) (setq alt-default str)) (setq completions (cons (cons str nil) completions)))) ;; If no good default was found, try an alternate. (or default (setq default alt-default)) ;; If only one cross-reference found, then make it default. (if (eq (length completions) 1) (setq default (car (car completions)))) (if completions (let ((input (completing-read (if default (concat "Follow reference named: (" default ") ") "Follow reference named: ") completions nil t))) (list (if (equal input "") default input))) (error "No cross-references in this node")))) (let (target beg i (str (concat "\\*note " (regexp-quote footnotename)))) (while (setq i (string-match " " str i)) (setq str (concat (substring str 0 i) "[ \t\n]+" (substring str (1+ i)))) (setq i (+ i 6))) (save-excursion (goto-char (point-min)) (or (re-search-forward str nil t) (error "No cross-reference named %s" footnotename)) (goto-char (+ (match-beginning 0) 5)) (setq target (Info-extract-menu-node-name "Bad format cross reference" t))) (while (setq i (string-match "[ \t\n]+" target i)) (setq target (concat (substring target 0 i) " " (substring target (match-end 0)))) (setq i (+ i 1))) (Info-goto-node target))) (defun Info-extract-menu-node-name (&optional errmessage multi-line) (skip-chars-forward " \t\n") (let ((beg (point)) str i) (skip-chars-forward "^:") (forward-char 1) (setq str (if (looking-at ":") (buffer-substring-no-properties beg (1- (point))) (skip-chars-forward " \t\n") (Info-following-node-name (if multi-line "^.,\t" "^.,\t\n")))) (while (setq i (string-match "\n" str i)) (aset str i ?\ )) ;; Collapse multiple spaces. (while (string-match " +" str) (setq str (replace-match " " t t str))) str)) ;; No one calls this. ;;(defun Info-menu-item-sequence (list) ;; (while list ;; (Info-menu (car list)) ;; (setq list (cdr list)))) (defun Info-complete-menu-item (string predicate action) (let ((case-fold-search t)) (cond ((eq action nil) (let (completions (pattern (concat "\n\\* \\(" (regexp-quote string) "[^:\t\n]*\\):"))) (save-excursion (set-buffer Info-complete-menu-buffer) (goto-char (point-min)) (search-forward "\n* Menu:") (while (re-search-forward pattern nil t) (setq completions (cons (cons (format "%s" (buffer-substring (match-beginning 1) (match-end 1))) (match-beginning 1)) completions)))) (try-completion string completions predicate))) ((eq action t) (let (completions (pattern (concat "\n\\* \\(" (regexp-quote string) "[^:\t\n]*\\):"))) (save-excursion (set-buffer Info-complete-menu-buffer) (goto-char (point-min)) (search-forward "\n* Menu:") (while (re-search-forward pattern nil t) (setq completions (cons (cons (format "%s" (buffer-substring (match-beginning 1) (match-end 1))) (match-beginning 1)) completions)))) (all-completions string completions predicate))) (t (save-excursion (set-buffer Info-complete-menu-buffer) (goto-char (point-min)) (search-forward "\n* Menu:") (re-search-forward (concat "\n\\* " (regexp-quote string) ":") nil t)))))) (defun Info-menu (menu-item) "Go to node for menu item named (or abbreviated) NAME. Completion is allowed, and the menu item point is on is the default." (interactive (let ((completions '()) ;; If point is within a menu item, use that item as the default (default nil) (p (point)) beg (last nil)) (save-excursion (goto-char (point-min)) (if (not (search-forward "\n* menu:" nil t)) (error "No menu in this node")) (setq beg (point)) (and (< (point) p) (save-excursion (goto-char p) (end-of-line) (re-search-backward "\n\\* \\([^:\t\n]*\\):" beg t) (setq default (format "%s" (buffer-substring (match-beginning 1) (match-end 1))))))) (let ((item nil)) (while (null item) (setq item (let ((completion-ignore-case t) (Info-complete-menu-buffer (current-buffer))) (completing-read (if default (format "Menu item (default %s): " default) "Menu item: ") 'Info-complete-menu-item nil t))) ;; we rely on the fact that completing-read accepts an input ;; of "" even when the require-match argument is true and "" ;; is not a valid possibility (if (string= item "") (if default (setq item default) ;; ask again (setq item nil)))) (list item)))) ;; there is a problem here in that if several menu items have the same ;; name you can only go to the node of the first with this command. (Info-goto-node (Info-extract-menu-item menu-item))) (defun Info-extract-menu-item (menu-item) (setq menu-item (regexp-quote menu-item)) (save-excursion (goto-char (point-min)) (or (search-forward "\n* menu:" nil t) (error "No menu in this node")) (or (re-search-forward (concat "\n\\* " menu-item ":") nil t) (re-search-forward (concat "\n\\* " menu-item) nil t) (error "No such item in menu")) (beginning-of-line) (forward-char 2) (Info-extract-menu-node-name))) ;; If COUNT is nil, use the last item in the menu. (defun Info-extract-menu-counting (count) (save-excursion (goto-char (point-min)) (or (search-forward "\n* menu:" nil t) (error "No menu in this node")) (if count (or (search-forward "\n* " nil t count) (error "Too few items in menu")) (while (search-forward "\n* " nil t) nil)) (Info-extract-menu-node-name))) (defun Info-nth-menu-item () "Go to the node of the Nth menu item. N is the digit argument used to invoke this command." (interactive) (Info-goto-node (Info-extract-menu-counting (- (aref (this-command-keys) (1- (length (this-command-keys)))) ?0)))) (defun Info-top-node () "Go to the Top node of this file." (interactive) (Info-goto-node "Top")) (defun Info-final-node () "Go to the final node in this file." (interactive) (Info-goto-node "Top") (let (Info-history) ;; Go to the last node in the menu of Top. (Info-goto-node (Info-extract-menu-counting nil)) ;; If the last node in the menu is not last in pointer structure, ;; move forward until we can't go any farther. (while (Info-forward-node t t) nil) ;; Then keep moving down to last subnode, unless we reach an index. (while (and (not (string-match "\\" Info-current-node)) (save-excursion (search-forward "\n* Menu:" nil t))) (Info-goto-node (Info-extract-menu-counting nil))))) (defun Info-forward-node (&optional not-down no-error) "Go forward one node, considering all nodes as forming one sequence." (interactive) (goto-char (point-min)) (forward-line 1) ;; three possibilities, in order of priority: ;; 1. next node is in a menu in this node (but not in an index) ;; 2. next node is next at same level ;; 3. next node is up and next (cond ((and (not not-down) (save-excursion (search-forward "\n* menu:" nil t)) (not (string-match "\\" Info-current-node))) (Info-goto-node (Info-extract-menu-counting 1)) t) ((save-excursion (search-backward "next:" nil t)) (Info-next) t) ((and (save-excursion (search-backward "up:" nil t)) ;; Use string-equal, not equal, to ignore text props. (not (string-equal (downcase (Info-extract-pointer "up")) "top"))) (let ((old-node Info-current-node)) (Info-up) (let (Info-history success) (unwind-protect (setq success (Info-forward-node t no-error)) (or success (Info-goto-node old-node)))))) (no-error nil) (t (error "No pointer forward from this node")))) (defun Info-backward-node () "Go backward one node, considering all nodes as forming one sequence." (interactive) (let ((prevnode (Info-extract-pointer "prev[ious]*" t)) (upnode (Info-extract-pointer "up" t))) (cond ((and upnode (string-match "(" upnode)) (error "First node in file")) ((and upnode (or (null prevnode) ;; Use string-equal, not equal, ;; to ignore text properties. (string-equal (downcase prevnode) (downcase upnode)))) (Info-up)) (prevnode ;; If we move back at the same level, ;; go down to find the last subnode*. (Info-prev) (let (Info-history) (while (and (not (string-match "\\" Info-current-node)) (save-excursion (search-forward "\n* Menu:" nil t))) (Info-goto-node (Info-extract-menu-counting nil))))) (t (error "No pointer backward from this node"))))) (defun Info-exit () "Exit Info by selecting some other buffer." (interactive) (if Info-standalone (save-buffers-kill-emacs) (switch-to-buffer (prog1 (other-buffer (current-buffer)) (bury-buffer (current-buffer)))))) (defun Info-next-menu-item () (interactive) (save-excursion (forward-line -1) (search-forward "\n* menu:" nil t) (or (search-forward "\n* " nil t) (error "No more items in menu")) (Info-goto-node (Info-extract-menu-node-name)))) (defun Info-last-menu-item () (interactive) (save-excursion (forward-line 1) (let ((beg (save-excursion (and (search-backward "\n* menu:" nil t) (point))))) (or (and beg (search-backward "\n* " beg t)) (error "No previous items in menu"))) (Info-goto-node (save-excursion (goto-char (match-end 0)) (Info-extract-menu-node-name))))) (defmacro Info-no-error (&rest body) (list 'condition-case nil (cons 'progn (append body '(t))) '(error nil))) (defun Info-next-preorder () "Go to the next subnode or the next node, or go up a level." (interactive) (cond ((Info-no-error (Info-next-menu-item))) ((Info-no-error (Info-next))) ((Info-no-error (Info-up)) ;; Since we have already gone thru all the items in this menu, ;; go up to the end of this node. (goto-char (point-max))) (t (error "No more nodes")))) (defun Info-last-preorder () "Go to the last node, popping up a level if there is none." (interactive) (cond ((Info-no-error (Info-last-menu-item) ;; If we go down a menu item, go to the end of the node ;; so we can scroll back through it. (goto-char (point-max))) (recenter -1)) ((Info-no-error (Info-prev)) (goto-char (point-max)) (recenter -1)) ((Info-no-error (Info-up)) (goto-char (point-min)) (or (search-forward "\n* Menu:" nil t) (goto-char (point-max)))) (t (error "No previous nodes")))) (defun Info-scroll-up () "Scroll one screenful forward in Info, considering all nodes as one sequence. Once you scroll far enough in a node that its menu appears on the screen, the next scroll moves into its first subnode. When you scroll past the end of a node, that goes to the next node or back up to the parent node." (interactive) (if (or (< (window-start) (point-min)) (> (window-start) (point-max))) (set-window-start (selected-window) (point))) (let ((virtual-end (save-excursion (goto-char (point-min)) (if (search-forward "\n* Menu:" nil t) (point) (point-max))))) (if (or (< virtual-end (window-start)) (pos-visible-in-window-p virtual-end)) (Info-next-preorder) (scroll-up)))) (defun Info-scroll-down () "Scroll one screenful back in Info, considering all nodes as one sequence. Within the menu of a node, this goes to its last subnode. When you scroll past the beginning of a node, that goes to the previous node or back up to the parent node." (interactive) (if (or (< (window-start) (point-min)) (> (window-start) (point-max))) (set-window-start (selected-window) (point))) (let ((virtual-end (save-excursion (goto-char (point-min)) (search-forward "\n* Menu:" nil t)))) (if (or virtual-end (pos-visible-in-window-p (point-min))) (Info-last-preorder) (scroll-down)))) (defun Info-next-reference () "Move cursor to the next cross-reference or menu item in the node." (interactive) (let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:") (old-pt (point))) (or (eobp) (forward-char 1)) (or (re-search-forward pat nil t) (progn (goto-char (point-min)) (or (re-search-forward pat nil t) (progn (goto-char old-pt) (error "No cross references in this node"))))) (goto-char (match-beginning 0)) (if (looking-at "\\* Menu:") (Info-next-reference)))) (defun Info-prev-reference () "Move cursor to the previous cross-reference or menu item in the node." (interactive) (let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:") (old-pt (point))) (or (re-search-backward pat nil t) (progn (goto-char (point-max)) (or (re-search-backward pat nil t) (progn (goto-char old-pt) (error "No cross references in this node"))))) (goto-char (match-beginning 0)) (if (looking-at "\\* Menu:") (Info-prev-reference)))) (defun Info-index (topic) "Look up a string in the index for this file. The index is defined as the first node in the top-level menu whose name contains the word \"Index\", plus any immediately following nodes whose names also contain the word \"Index\". If there are no exact matches to the specified topic, this chooses the first match which is a case-insensitive substring of a topic. Use the `,' command to see the other matches. Give a blank topic name to go to the Index node itself." (interactive "sIndex topic: ") (let ((orignode Info-current-node) (rnode nil) (pattern (format "\n\\* \\([^\n:]*%s[^\n:]*\\):[ \t]*\\([^.\n]*\\)\\.[ \t]*\\([0-9]*\\)" (regexp-quote topic))) node) (Info-goto-node "Top") (or (search-forward "\n* menu:" nil t) (error "No index")) (or (re-search-forward "\n\\* \\(.*\\\\)" nil t) (error "No index")) (goto-char (match-beginning 1)) ;; Here, and subsequently in this function, ;; we bind Info-history to nil for internal node-switches ;; so that we don't put junk in the history. ;; In the first Info-goto-node call, above, we do update the history ;; because that is what the user's previous node choice into it. (let ((Info-history nil)) (Info-goto-node (Info-extract-menu-node-name))) (or (equal topic "") (let ((matches nil) (exact nil) (Info-history nil) found) (while (progn (goto-char (point-min)) (while (re-search-forward pattern nil t) (setq matches (cons (list (buffer-substring (match-beginning 1) (match-end 1)) (buffer-substring (match-beginning 2) (match-end 2)) Info-current-node (string-to-int (concat "0" (buffer-substring (match-beginning 3) (match-end 3))))) matches))) (and (setq node (Info-extract-pointer "next" t)) (string-match "\\" node))) (Info-goto-node node)) (or matches (progn (Info-last) (error "No \"%s\" in index" topic))) ;; Here it is a feature that assoc is case-sensitive. (while (setq found (assoc topic matches)) (setq exact (cons found exact) matches (delq found matches))) (setq Info-index-alternatives (nconc exact (nreverse matches))) (Info-index-next 0))))) (defun Info-index-next (num) "Go to the next matching index item from the last `i' command." (interactive "p") (or Info-index-alternatives (error "No previous `i' command in this file")) (while (< num 0) (setq num (+ num (length Info-index-alternatives)))) (while (> num 0) (setq Info-index-alternatives (nconc (cdr Info-index-alternatives) (list (car Info-index-alternatives))) num (1- num))) (Info-goto-node (nth 1 (car Info-index-alternatives))) (if (> (nth 3 (car Info-index-alternatives)) 0) (forward-line (nth 3 (car Info-index-alternatives))) (forward-line 3) ; don't search in headers (let ((name (car (car Info-index-alternatives)))) (if (or (re-search-forward (format "\\(Function\\|Command\\): %s\\( \\|$\\)" (regexp-quote name)) nil t) (search-forward (format "`%s'" name) nil t) (and (string-match "\\`.*\\( (.*)\\)\\'" name) (search-forward (format "`%s'" (substring name 0 (match-beginning 1))) nil t)) (search-forward name nil t)) (beginning-of-line) (goto-char (point-min))))) (message "Found \"%s\" in %s. %s" (car (car Info-index-alternatives)) (nth 2 (car Info-index-alternatives)) (if (cdr Info-index-alternatives) "(Press `,' for more)" "(Only match)"))) (defun Info-undefined () "Make command be undefined in Info." (interactive) (ding)) (defun Info-help () "Enter the Info tutorial." (interactive) (delete-other-windows) (Info-find-node "info" (if (< (window-height) 23) "Help-Small-Screen" "Help"))) (defun Info-summary () "Display a brief summary of all Info commands." (interactive) (save-window-excursion (switch-to-buffer "*Help*") (erase-buffer) (insert (documentation 'Info-mode)) (help-mode) (goto-char (point-min)) (let (ch flag) (while (progn (setq flag (not (pos-visible-in-window-p (point-max)))) (message (if flag "Type Space to see more" "Type Space to return to Info")) (if (not (eq ?\ (setq ch (read-event)))) (progn (setq unread-command-events (list ch)) nil) flag)) (scroll-up))) (bury-buffer "*Help*"))) (defun Info-get-token (pos start all &optional errorstring) "Return the token around POS, POS must be somewhere inside the token START is a regular expression which will match the beginning of the tokens delimited string ALL is a regular expression with a single parenthized subpattern which is the token to be returned. E.g. '{\(.*\)}' would return any string enclosed in braces around POS. SIG optional fourth argument, controls action on no match nil: return nil t: beep a string: signal an error, using that string." (save-excursion (goto-char pos) (re-search-backward start (max (point-min) (- pos 200)) 'yes) (let (found) (while (and (re-search-forward all (min (point-max) (+ pos 200)) 'yes) (not (setq found (and (<= (match-beginning 0) pos) (> (match-end 0) pos)))))) (if (and found (<= (match-beginning 0) pos) (> (match-end 0) pos)) (buffer-substring (match-beginning 1) (match-end 1)) (cond ((null errorstring) nil) ((eq errorstring t) (beep) nil) (t (error "No %s around position %d" errorstring pos))))))) (defun Info-mouse-follow-nearest-node (click) "\\Follow a node reference near point. Like \\[Info-menu], \\[Info-follow-reference], \\[Info-next], \\[Info-prev] or \\[Info-up] command, depending on where you click. At end of the node's text, moves to the next node, or up if none." (interactive "e") (let* ((start (event-start click)) (window (car start)) (pos (car (cdr start)))) (select-window window) (goto-char pos)) (and (not (Info-try-follow-nearest-node)) (save-excursion (forward-line 1) (eobp)) (Info-next-preorder))) (defun Info-follow-nearest-node () "\\Follow a node reference near point. Like \\[Info-menu], \\[Info-follow-reference], \\[Info-next], \\[Info-prev] or \\[Info-up] command, depending on where point is. If no reference to follow, moves to the next node, or up if none." (interactive) (or (Info-try-follow-nearest-node) (Info-next-preorder))) ;; Common subroutine. (defun Info-try-follow-nearest-node () "Follow a node reference near point. Return non-nil if successful." (let (node) (cond ((setq node (Info-get-token (point) "\\*note[ \n]" "\\*note[ \n]\\([^:]*\\):")) (Info-follow-reference node)) ((setq node (Info-get-token (point) "\\* " "\\* \\([^:]*\\)::")) (Info-goto-node node)) ((setq node (Info-get-token (point) "\\* " "\\* \\([^:]*\\):")) (Info-menu node)) ((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)")) (Info-goto-node node)) ((setq node (Info-get-token (point) "Next: " "Next: \\([^,\n\t]*\\)")) (Info-goto-node node)) ((setq node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)")) (Info-goto-node "Top")) ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)")) (Info-goto-node node))) node)) (defvar Info-mode-map nil "Keymap containing Info commands.") (if Info-mode-map nil (setq Info-mode-map (make-keymap)) (suppress-keymap Info-mode-map) (define-key Info-mode-map "." 'beginning-of-buffer) (define-key Info-mode-map " " 'Info-scroll-up) (define-key Info-mode-map "\C-m" 'Info-follow-nearest-node) (define-key Info-mode-map "\t" 'Info-next-reference) (define-key Info-mode-map "\e\t" 'Info-prev-reference) (define-key Info-mode-map "1" 'Info-nth-menu-item) (define-key Info-mode-map "2" 'Info-nth-menu-item) (define-key Info-mode-map "3" 'Info-nth-menu-item) (define-key Info-mode-map "4" 'Info-nth-menu-item) (define-key Info-mode-map "5" 'Info-nth-menu-item) (define-key Info-mode-map "6" 'Info-nth-menu-item) (define-key Info-mode-map "7" 'Info-nth-menu-item) (define-key Info-mode-map "8" 'Info-nth-menu-item) (define-key Info-mode-map "9" 'Info-nth-menu-item) (define-key Info-mode-map "0" 'undefined) (define-key Info-mode-map "?" 'Info-summary) (define-key Info-mode-map "]" 'Info-forward-node) (define-key Info-mode-map "[" 'Info-backward-node) (define-key Info-mode-map "<" 'Info-top-node) (define-key Info-mode-map ">" 'Info-final-node) (define-key Info-mode-map "b" 'beginning-of-buffer) (define-key Info-mode-map "d" 'Info-directory) (define-key Info-mode-map "e" 'Info-edit) (define-key Info-mode-map "f" 'Info-follow-reference) (define-key Info-mode-map "g" 'Info-goto-node) (define-key Info-mode-map "h" 'Info-help) (define-key Info-mode-map "i" 'Info-index) (define-key Info-mode-map "l" 'Info-last) (define-key Info-mode-map "m" 'Info-menu) (define-key Info-mode-map "n" 'Info-next) (define-key Info-mode-map "p" 'Info-prev) (define-key Info-mode-map "q" 'Info-exit) (define-key Info-mode-map "s" 'Info-search) ;; For consistency with Rmail. (define-key Info-mode-map "\M-s" 'Info-search) (define-key Info-mode-map "t" 'Info-top-node) (define-key Info-mode-map "u" 'Info-up) (define-key Info-mode-map "," 'Info-index-next) (define-key Info-mode-map "\177" 'Info-scroll-down) (define-key Info-mode-map [mouse-2] 'Info-mouse-follow-nearest-node) ) ;; Info mode is suitable only for specially formatted data. (put 'info-mode 'mode-class 'special) (defun Info-mode () "\\ Info mode provides commands for browsing through the Info documentation tree. Documentation in Info is divided into \"nodes\", each of which discusses one topic and contains references to other nodes which discuss related topics. Info has commands to follow the references and show you other nodes. \\[Info-help] Invoke the Info tutorial. Selecting other nodes: \\[Info-mouse-follow-nearest-node] Follow a node reference you click on. This works with menu items, cross references, and the \"next\", \"previous\" and \"up\", depending on where you click. \\[Info-next] Move to the \"next\" node of this node. \\[Info-prev] Move to the \"previous\" node of this node. \\[Info-up] Move \"up\" from this node. \\[Info-menu] Pick menu item specified by name (or abbreviation). Picking a menu item causes another node to be selected. \\[Info-directory] Go to the Info directory node. \\[Info-follow-reference] Follow a cross reference. Reads name of reference. \\[Info-last] Move to the last node you were at. \\[Info-index] Look up a topic in this file's Index and move to that node. \\[Info-index-next] (comma) Move to the next match from a previous `i' command. Moving within a node: \\[Info-scroll-up] Normally, scroll forward a full screen. If the end of the buffer is already visible, try to go to the next menu entry, or up if there is none. \\[Info-scroll-down] Normally, scroll backward. If the beginning of the buffer is already visible, try to go to the previous menu entry, or up if there is none. \\[beginning-of-buffer] Go to beginning of node. Advanced commands: \\[Info-exit] Quit Info: reselect previously selected buffer. \\[Info-edit] Edit contents of selected node. 1 Pick first item in node's menu. 2, 3, 4, 5 Pick second ... fifth item in node's menu. \\[Info-goto-node] Move to node specified by name. You may include a filename as well, as (FILENAME)NODENAME. \\[universal-argument] \\[info] Move to new Info file with completion. \\[Info-search] Search through this Info file for specified regexp, and select the node in which the next occurrence is found. \\[Info-next-reference] Move cursor to next cross-reference or menu item. \\[Info-prev-reference] Move cursor to previous cross-reference or menu item." (kill-all-local-variables) (setq major-mode 'Info-mode) (setq mode-name "Info") (use-local-map Info-mode-map) (set-syntax-table text-mode-syntax-table) (setq local-abbrev-table text-mode-abbrev-table) (setq case-fold-search t) (setq buffer-read-only t) (make-local-variable 'Info-current-file) (make-local-variable 'Info-current-subfile) (make-local-variable 'Info-current-node) (make-local-variable 'Info-tag-table-marker) (make-local-variable 'Info-history) (make-local-variable 'Info-index-alternatives) (if (memq (framep (selected-frame)) '(x pc)) (progn (make-face 'info-node) (make-face 'info-menu-5) (make-face 'info-xref) (or (face-differs-from-default-p 'info-node) (if (face-differs-from-default-p 'bold-italic) (copy-face 'bold-italic 'info-node) (copy-face 'bold 'info-node))) (or (face-differs-from-default-p 'info-menu-5) (set-face-underline-p 'info-menu-5 t)) (or (face-differs-from-default-p 'info-xref) (copy-face 'bold 'info-xref))) (setq Info-fontify nil)) (Info-set-mode-line) (run-hooks 'Info-mode-hook)) (defvar Info-edit-map nil "Local keymap used within `e' command of Info.") (if Info-edit-map nil (setq Info-edit-map (nconc (make-sparse-keymap) text-mode-map)) (define-key Info-edit-map "\C-c\C-c" 'Info-cease-edit)) ;; Info-edit mode is suitable only for specially formatted data. (put 'info-edit-mode 'mode-class 'special) (defun Info-edit-mode () "Major mode for editing the contents of an Info node. Like text mode with the addition of `Info-cease-edit' which returns to Info mode for browsing. \\{Info-edit-map}" (use-local-map Info-edit-map) (setq major-mode 'Info-edit-mode) (setq mode-name "Info Edit") (kill-local-variable 'mode-line-buffer-identification) (setq buffer-read-only nil) (force-mode-line-update) (buffer-enable-undo (current-buffer)) (run-hooks 'Info-edit-mode-hook)) (defun Info-edit () "Edit the contents of this Info node. Allowed only if variable `Info-enable-edit' is non-nil." (interactive) (or Info-enable-edit (error "Editing info nodes is not enabled")) (Info-edit-mode) (message (substitute-command-keys "Editing: Type \\\\[Info-cease-edit] to return to info"))) (defun Info-cease-edit () "Finish editing Info node; switch back to Info proper." (interactive) ;; Do this first, so nothing has changed if user C-g's at query. (and (buffer-modified-p) (y-or-n-p "Save the file? ") (save-buffer)) (use-local-map Info-mode-map) (setq major-mode 'Info-mode) (setq mode-name "Info") (Info-set-mode-line) (setq buffer-read-only t) (force-mode-line-update) (and (marker-position Info-tag-table-marker) (buffer-modified-p) (message "Tags may have changed. Use Info-tagify if necessary"))) (defvar Info-file-list-for-emacs '("ediff" "forms" "gnus" "info" ("mh" . "mh-e") "sc") "List of Info files that describe Emacs commands. An element can be a file name, or a list of the form (PREFIX . FILE) where PREFIX is a name prefix and FILE is the file to look in. If the element is just a file name, the file name also serves as the prefix.") (defun Info-find-emacs-command-nodes (command) "Return a list of locations documenting COMMAND. The `info-file' property of COMMAND says which Info manual to search. If COMMAND has no property, the variable `Info-file-list-for-emacs' defines heuristics for which Info manual to try. The locations are of the format used in Info-history, i.e. \(FILENAME NODENAME BUFFERPOS\)." (let ((where '()) (cmd-desc (concat "^\\* " (regexp-quote (symbol-name command)) ":\\s *\\(.*\\)\\.$")) (info-file "emacs")) ;default ;; Determine which info file this command is documented in. (if (get command 'info-file) (setq info-file (get command 'info-file)) ;; If it doesn't say explicitly, test its name against ;; various prefixes that we know. (let ((file-list Info-file-list-for-emacs)) (while file-list (let* ((elt (car file-list)) (name (if (consp elt) (car elt) elt)) (file (if (consp elt) (cdr elt) elt)) (regexp (concat "\\`" (regexp-quote name) "\\(\\'\\|-\\)"))) (if (string-match regexp (symbol-name command)) (setq info-file file file-list nil)) (setq file-list (cdr file-list)))))) (save-excursion (condition-case nil (Info-find-node info-file "Command Index") ;; Some manuals may not have a separate Command Index node, ;; so try just Index instead. (error (Info-find-node info-file "Index"))) ;; Take the index node off the Info history. (setq Info-history (cdr Info-history)) (goto-char (point-max)) (while (re-search-backward cmd-desc nil t) (setq where (cons (list Info-current-file (buffer-substring (match-beginning 1) (match-end 1)) 0) where))) where))) ;;;###autoload (defun Info-goto-emacs-command-node (command) "Go to the Info node in the Emacs manual for command COMMAND. The command is found by looking up in Emacs manual's Command Index or in another manual found via COMMAND's `info-file' property or the variable `Info-file-list-for-emacs'." (interactive "CFind documentation for command: ") (or (commandp command) (signal 'wrong-type-argument (list 'commandp command))) (let ((where (Info-find-emacs-command-nodes command))) (if where (let ((num-matches (length where))) ;; Get Info running, and pop to it in another window. (save-window-excursion (info)) (pop-to-buffer "*info*") (Info-find-node (car (car where)) (car (cdr (car where)))) (if (> num-matches 1) (progn ;; Info-find-node already pushed (car where) onto ;; Info-history. Put the other nodes that were found on ;; the history. (setq Info-history (nconc (cdr where) Info-history)) (message (substitute-command-keys "Found %d other entr%s. Use \\[Info-last] to see %s.") (1- num-matches) (if (> num-matches 2) "ies" "y") (if (> num-matches 2) "them" "it"))))) (error "Couldn't find documentation for %s." command)))) ;;;###autoload (defun Info-goto-emacs-key-command-node (key) "Go to the Info node in the Emacs manual the command bound to KEY, a string. Interactively, if the binding is execute-extended-command, a command is read. The command is found by looking up in Emacs manual's Command Index or in another manual found via COMMAND's `info-file' property or the variable `Info-file-list-for-emacs'." (interactive "kFind documentation for key:") (let ((command (key-binding key))) (cond ((null command) (message "%s is undefined" (key-description key))) ((and (interactive-p) (eq command 'execute-extended-command)) (Info-goto-emacs-command-node (read-command "Find documentation for command: "))) (t (Info-goto-emacs-command-node command))))) (defvar Info-title-face-alist '((?* bold underline) (?= bold-italic underline) (?- italic underline)) "*Alist of face or list of faces to use for pseudo-underlined titles. The alist key is the character the title is underlined with (?*, ?= or ?-).") (defun Info-fontify-node () (save-excursion (let ((buffer-read-only nil)) (goto-char (point-min)) (if (looking-at "^File: [^,: \t]+,?[ \t]+") (progn (goto-char (match-end 0)) (while (looking-at "[ \t]*[^:, \t\n]+:[ \t]+\\([^:,\t\n]+\\),?") (goto-char (match-end 0)) (put-text-property (match-beginning 1) (match-end 1) 'face 'info-xref) (put-text-property (match-beginning 1) (match-end 1) 'mouse-face 'highlight)))) (goto-char (point-min)) (while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*+\\|=+\\|-+\\)$" nil t) (put-text-property (match-beginning 1) (match-end 1) 'face (cdr (assq (preceding-char) Info-title-face-alist))) (put-text-property (match-end 1) (match-end 2) 'invisible t)) (goto-char (point-min)) (while (re-search-forward "\\*Note[ \n\t]+\\([^:]*\\):" nil t) (if (= (char-after (1- (match-beginning 0))) ?\") ; hack nil (put-text-property (match-beginning 1) (match-end 1) 'face 'info-xref) (put-text-property (match-beginning 1) (match-end 1) 'mouse-face 'highlight))) (goto-char (point-min)) (if (and (search-forward "\n* Menu:" nil t) (not (string-match "\\" Info-current-node)) ;; Don't take time to annotate huge menus (< (- (point-max) (point)) Info-fontify-maximum-menu-size)) (let ((n 0)) (while (re-search-forward "^\\* \\([^:\t\n]*\\):" nil t) (setq n (1+ n)) (if (memq n '(5 9)) ; visual aids to help with 1-9 keys (put-text-property (match-beginning 0) (1+ (match-beginning 0)) 'face 'info-menu-5)) (put-text-property (match-beginning 1) (match-end 1) 'face 'info-node) (put-text-property (match-beginning 1) (match-end 1) 'mouse-face 'highlight)))) (set-buffer-modified-p nil)))) (provide 'info) ;;; info.el ends here emacs-19.30/lisp/informat.el100444 12120 1 33467 6043213664 14251 0ustar rmsdaemon;;; informat.el --- info support functions package for Emacs ;; Copyright (C) 1986 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (require 'info) ;;;###autoload (defun Info-tagify () "Create or update Info-file tag table in current buffer." (interactive) ;; Save and restore point and restrictions. ;; save-restrictions would not work ;; because it records the old max relative to the end. ;; We record it relative to the beginning. (message "Tagifying %s ..." (file-name-nondirectory (buffer-file-name))) (let ((omin (point-min)) (omax (point-max)) (nomax (= (point-max) (1+ (buffer-size)))) (opoint (point))) (unwind-protect (progn (widen) (goto-char (point-min)) (if (search-forward "\^_\nIndirect:\n" nil t) (message "Cannot tagify split info file") (let ((regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]") (case-fold-search t) list) (while (search-forward "\n\^_" nil t) ;; We want the 0-origin character position of the ^_. ;; That is the same as the Emacs (1-origin) position ;; of the newline before it. (let ((beg (match-beginning 0))) (forward-line 2) (if (re-search-backward regexp beg t) (setq list (cons (list (buffer-substring-no-properties (match-beginning 1) (match-end 1)) beg) list))))) (goto-char (point-max)) (forward-line -8) (let ((buffer-read-only nil)) (if (search-forward "\^_\nEnd tag table\n" nil t) (let ((end (point))) (search-backward "\nTag table:\n") (beginning-of-line) (delete-region (point) end))) (goto-char (point-max)) (insert "\^_\f\nTag table:\n") (move-marker Info-tag-table-marker (point)) (setq list (nreverse list)) (while list (insert "Node: " (car (car list)) ?\177) (princ (car (cdr (car list))) (current-buffer)) (insert ?\n) (setq list (cdr list))) (insert "\^_\nEnd tag table\n"))))) (goto-char opoint) (narrow-to-region omin (if nomax (1+ (buffer-size)) (min omax (point-max)))))) (message "Tagifying %s ... done" (file-name-nondirectory (buffer-file-name)))) ;;;###autoload (defun Info-split () "Split an info file into an indirect file plus bounded-size subfiles. Each subfile will be up to 50,000 characters plus one node. To use this command, first visit a large Info file that has a tag table. The buffer is modified into a (small) indirect info file which should be saved in place of the original visited file. The subfiles are written in the same directory the original file is in, with names generated by appending `-' and a number to the original file name. The indirect file still functions as an Info file, but it contains just the tag table and a directory of subfiles." (interactive) (if (< (buffer-size) 70000) (error "This is too small to be worth splitting")) (goto-char (point-min)) (search-forward "\^_") (forward-char -1) (let ((start (point)) (chars-deleted 0) subfiles (subfile-number 1) (case-fold-search t) (filename (file-name-sans-versions buffer-file-name))) (goto-char (point-max)) (forward-line -8) (setq buffer-read-only nil) (or (search-forward "\^_\nEnd tag table\n" nil t) (error "Tag table required; use M-x Info-tagify")) (search-backward "\nTag table:\n") (if (looking-at "\nTag table:\n\^_") (error "Tag table is just a skeleton; use M-x Info-tagify")) (beginning-of-line) (forward-char 1) (save-restriction (narrow-to-region (point-min) (point)) (goto-char (point-min)) (while (< (1+ (point)) (point-max)) (goto-char (min (+ (point) 50000) (point-max))) (search-forward "\^_" nil 'move) (setq subfiles (cons (list (+ start chars-deleted) (concat (file-name-nondirectory filename) (format "-%d" subfile-number))) subfiles)) ;; Put a newline at end of split file, to make Unix happier. (insert "\n") (write-region (point-min) (point) (concat filename (format "-%d" subfile-number))) (delete-region (1- (point)) (point)) ;; Back up over the final ^_. (forward-char -1) (setq chars-deleted (+ chars-deleted (- (point) start))) (delete-region start (point)) (setq subfile-number (1+ subfile-number)))) (while subfiles (goto-char start) (insert (nth 1 (car subfiles)) (format ": %d" (1- (car (car subfiles)))) "\n") (setq subfiles (cdr subfiles))) (goto-char start) (insert "\^_\nIndirect:\n") (search-forward "\nTag Table:\n") (insert "(Indirect)\n"))) ;;;###autoload (defun Info-validate () "Check current buffer for validity as an Info file. Check that every node pointer points to an existing node." (interactive) (save-excursion (save-restriction (widen) (goto-char (point-min)) (if (search-forward "\nTag table:\n(Indirect)\n" nil t) (error "Don't yet know how to validate indirect info files: \"%s\"" (buffer-name (current-buffer)))) (goto-char (point-min)) (let ((allnodes '(("*"))) (regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]") (case-fold-search t) (tags-losing nil) (lossages ())) (while (search-forward "\n\^_" nil t) (forward-line 1) (let ((beg (point))) (forward-line 1) (if (re-search-backward regexp beg t) (let ((name (downcase (buffer-substring-no-properties (match-beginning 1) (progn (goto-char (match-end 1)) (skip-chars-backward " \t") (point)))))) (if (assoc name allnodes) (setq lossages (cons (list name "Duplicate node-name" nil) lossages)) (setq allnodes (cons (list name (progn (end-of-line) (and (re-search-backward "prev[ious]*:" beg t) (progn (goto-char (match-end 0)) (downcase (Info-following-node-name))))) beg) allnodes))))))) (goto-char (point-min)) (while (search-forward "\n\^_" nil t) (forward-line 1) (let ((beg (point)) thisnode next) (forward-line 1) (if (re-search-backward regexp beg t) (save-restriction (search-forward "\n\^_" nil 'move) (narrow-to-region beg (point)) (setq thisnode (downcase (buffer-substring-no-properties (match-beginning 1) (progn (goto-char (match-end 1)) (skip-chars-backward " \t") (point))))) (end-of-line) (and (search-backward "next:" nil t) (setq next (Info-validate-node-name "invalid Next")) (assoc next allnodes) (if (equal (car (cdr (assoc next allnodes))) thisnode) ;; allow multiple `next' pointers to one node (let ((tem lossages)) (while tem (if (and (equal (car (cdr (car tem))) "should have Previous") (equal (car (car tem)) next)) (setq lossages (delq (car tem) lossages))) (setq tem (cdr tem)))) (setq lossages (cons (list next "should have Previous" thisnode) lossages)))) (end-of-line) (if (re-search-backward "prev[ious]*:" nil t) (Info-validate-node-name "invalid Previous")) (end-of-line) (if (search-backward "up:" nil t) (Info-validate-node-name "invalid Up")) (if (re-search-forward "\n* Menu:" nil t) (while (re-search-forward "\n\\* " nil t) (Info-validate-node-name (concat "invalid menu item " (buffer-substring (point) (save-excursion (skip-chars-forward "^:") (point)))) (Info-extract-menu-node-name)))) (goto-char (point-min)) (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t) (goto-char (+ (match-beginning 0) 5)) (skip-chars-forward " \n") (Info-validate-node-name (concat "invalid reference " (buffer-substring (point) (save-excursion (skip-chars-forward "^:") (point)))) (Info-extract-menu-node-name "Bad format cross-reference"))))))) (setq tags-losing (not (Info-validate-tags-table))) (if (or lossages tags-losing) (with-output-to-temp-buffer " *problems in info file*" (while lossages (princ "In node \"") (princ (car (car lossages))) (princ "\", ") (let ((tem (nth 1 (car lossages)))) (cond ((string-match "\n" tem) (princ (substring tem 0 (match-beginning 0))) (princ "...")) (t (princ tem)))) (if (nth 2 (car lossages)) (progn (princ ": ") (let ((tem (nth 2 (car lossages)))) (cond ((string-match "\n" tem) (princ (substring tem 0 (match-beginning 0))) (princ "...")) (t (princ tem)))))) (terpri) (setq lossages (cdr lossages))) (if tags-losing (princ "\nTags table must be recomputed\n"))) ;; Here if info file is valid. ;; If we already made a list of problems, clear it out. (save-excursion (if (get-buffer " *problems in info file*") (progn (set-buffer " *problems in info file*") (kill-buffer (current-buffer))))) (message "File appears valid")))))) (defun Info-validate-node-name (kind &optional name) (if name nil (goto-char (match-end 0)) (skip-chars-forward " \t") (if (= (following-char) ?\() nil (setq name (buffer-substring-no-properties (point) (progn (skip-chars-forward "^,\t\n") (skip-chars-backward " ") (point)))))) (if (null name) nil (setq name (downcase name)) (or (and (> (length name) 0) (= (aref name 0) ?\()) (assoc name allnodes) (setq lossages (cons (list thisnode kind name) lossages)))) name) (defun Info-validate-tags-table () (goto-char (point-min)) (if (not (search-forward "\^_\nEnd tag table\n" nil t)) t (not (catch 'losing (let* ((end (match-beginning 0)) (start (progn (search-backward "\nTag table:\n") (1- (match-end 0)))) tem) (setq tem allnodes) (while tem (goto-char start) (or (equal (car (car tem)) "*") (search-forward (concat "Node: " (car (car tem)) "\177") end t) (throw 'losing 'x)) (setq tem (cdr tem))) (goto-char (1+ start)) (while (looking-at ".*Node: \\(.*\\)\177\\([0-9]+\\)$") (setq tem (downcase (buffer-substring-no-properties (match-beginning 1) (match-end 1)))) (setq tem (assoc tem allnodes)) (if (or (not tem) (< 1000 (progn (goto-char (match-beginning 2)) (setq tem (- (car (cdr (cdr tem))) (read (current-buffer)))) (if (> tem 0) tem (- tem))))) (throw 'losing 'y)) (forward-line 1))) (if (looking-at "\^_\n") (forward-line 1)) (or (looking-at "End tag table\n") (throw 'losing 'z)) nil)))) ;;;###autoload (defun batch-info-validate () "Runs `Info-validate' on the files remaining on the command line. Must be used only with -batch, and kills Emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" (if (not noninteractive) (error "batch-info-validate may only be used -batch.")) (let ((version-control t) (auto-save-default nil) (find-file-run-dired nil) (kept-old-versions 259259) (kept-new-versions 259259)) (let ((error 0) file (files ())) (while command-line-args-left (setq file (expand-file-name (car command-line-args-left))) (cond ((not (file-exists-p file)) (message ">> %s does not exist!" file) (setq error 1 command-line-args-left (cdr command-line-args-left))) ((file-directory-p file) (setq command-line-args-left (nconc (directory-files file) (cdr command-line-args-left)))) (t (setq files (cons file files) command-line-args-left (cdr command-line-args-left))))) (while files (setq file (car files) files (cdr files)) (let ((lose nil)) (condition-case err (progn (if buffer-file-name (kill-buffer (current-buffer))) (find-file file) (buffer-disable-undo (current-buffer)) (set-buffer-modified-p nil) (fundamental-mode) (let ((case-fold-search nil)) (goto-char (point-max)) (cond ((search-backward "\n\^_\^L\nTag table:\n" nil t) (message "%s already tagified" file)) ((< (point-max) 30000) (message "%s too small to bother tagifying" file)) (t (Info-tagify)))) (let ((loss-name " *problems in info file*")) (message "Checking validity of info file %s..." file) (if (get-buffer loss-name) (kill-buffer loss-name)) (Info-validate) (if (not (get-buffer loss-name)) nil ;(message "Checking validity of info file %s... OK" file) (message "----------------------------------------------------------------------") (message ">> PROBLEMS IN INFO FILE %s" file) (save-excursion (set-buffer loss-name) (princ (buffer-substring-no-properties (point-min) (point-max)))) (message "----------------------------------------------------------------------") (setq error 1 lose t))) (if (and (buffer-modified-p) (not lose)) (progn (message "Saving modified %s" file) (save-buffer)))) (error (message ">> Error: %s" (prin1-to-string err)))))) (kill-emacs error)))) ;;; informat.el ends here emacs-19.30/lisp/isearch.el100444 12120 1 145701 6041547667 14076 0ustar rmsdaemon;;; isearch.el --- incremental search minor mode. ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Daniel LaLiberte ;; Maintainer: FSF ;; 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: ;;;==================================================================== ;; Instructions ;; For programmed use of isearch-mode, e.g. calling (isearch-forward), ;; isearch-mode behaves modally and does not return until the search ;; is completed. It uses a recursive-edit to behave this way. Note: ;; gnus does it wrong: (call-interactively 'isearch-forward). ;; The key bindings active within isearch-mode are defined below in ;; `isearch-mode-map' which is given bindings close to the default ;; characters of the original isearch.el. With `isearch-mode', ;; however, you can bind multi-character keys and it should be easier ;; to add new commands. One bug though: keys with meta-prefix cannot ;; be longer than two chars. Also see minibuffer-local-isearch-map ;; for bindings active during `isearch-edit-string'. ;; Note to emacs version 19 users: isearch-mode should work even if ;; you switch windows with the mouse, in which case isearch-mode is ;; terminated automatically before the switch. This is true of lemacs ;; too, with a few more cleanups I've neglected in this release. ;; No one has supplied patches for epoch yet. ;; The search ring and completion commands automatically put you in ;; the minibuffer to edit the string. This gives you a chance to ;; modify the search string before executing the search. There are ;; three commands to terminate the editing: C-s and C-r exit the ;; minibuffer and search forward and reverse respectively, while C-m ;; exits and does a nonincremental search. ;; Exiting immediately from isearch uses isearch-edit-string instead ;; of nonincremental-search, if search-nonincremental-instead is non-nil. ;; The name of this option should probably be changed if we decide to ;; keep the behavior. No point in forcing nonincremental search until ;; the last possible moment. ;; TODO ;; - Integrate the emacs 19 generalized command history. ;; - Think about incorporating query-replace. ;; - Hooks and options for failed search. ;;; Change Log: ;;; Changes before those recorded in ChangeLog: ;;; Revision 1.4 92/09/14 16:26:02 liberte ;;; Added prefix args to isearch-forward, etc. to switch between ;;; string and regular expression searching. ;;; Added some support for lemacs. ;;; Added general isearch-highlight option - but only for lemacs so far. ;;; Added support for frame switching in emacs 19. ;;; Added word search option to isearch-edit-string. ;;; Renamed isearch-quit to isearch-abort. ;;; Numerous changes to comments and doc strings. ;;; ;;; Revision 1.3 92/06/29 13:10:08 liberte ;;; Moved modal isearch-mode handling into isearch-mode. ;;; Got rid of buffer-local isearch variables. ;;; isearch-edit-string used by ring adjustments, completion, and ;;; nonincremental searching. C-s and C-r are additional exit commands. ;;; Renamed all regex to regexp. ;;; Got rid of found-start and found-point globals. ;;; Generalized handling of upper-case chars. ;;; Revision 1.2 92/05/27 11:33:57 liberte ;;; Emacs version 19 has a search ring, which is supported here. ;;; Other fixes found in the version 19 isearch are included here. ;;; ;;; Also see variables search-caps-disable-folding, ;;; search-nonincremental-instead, search-whitespace-regexp, and ;;; commands isearch-toggle-regexp, isearch-edit-string. ;;; ;;; semi-modal isearching is supported. ;;; Changes for 1.1 ;;; 3/18/92 Fixed invalid-regexp. ;;; 3/18/92 Fixed yanking in regexps. ;;; Code: ;;;======================================================================== ;;; Some additional options and constants. (defconst search-exit-option t "*Non-nil means random control characters terminate incremental search.") (defvar search-slow-window-lines 1 "*Number of lines in slow search display windows. These are the short windows used during incremental search on slow terminals. Negative means put the slow search window at the top (normally it's at bottom) and the value is minus the number of lines.") (defvar search-slow-speed 1200 "*Highest terminal speed at which to use \"slow\" style incremental search. This is the style where a one-line window is created to show the line that the search has reached.") (defvar search-upper-case 'not-yanks "*If non-nil, upper case chars disable case fold searching. That is, upper and lower case chars must match exactly. This applies no matter where the chars come from, but does not apply to chars in regexps that are prefixed with `\\'. If this value is `not-yanks', yanked text is always downcased.") (defvar search-nonincremental-instead t "*If non-nil, do a nonincremental search instead if exiting immediately. Actually, `isearch-edit-string' is called to let you enter the search string, and RET terminates editing and does a nonincremental search.") (defconst search-whitespace-regexp "\\s-+" "*If non-nil, regular expression to match a sequence of whitespace chars. You might want to use something like \"[ \\t\\r\\n]+\" instead.") (defvar search-highlight nil "*Non-nil means incremental search highlights the current match.") (defvar isearch-mode-hook nil "Function(s) to call after starting up an incremental search.") (defvar isearch-mode-end-hook nil "Function(s) to call after terminating an incremental search.") ;;;================================================================== ;;; Search ring. (defvar search-ring nil "List of search string sequences.") (defvar regexp-search-ring nil "List of regular expression search string sequences.") (defconst search-ring-max 16 "*Maximum length of search ring before oldest elements are thrown away.") (defconst regexp-search-ring-max 16 "*Maximum length of regexp search ring before oldest elements are thrown away.") (defvar search-ring-yank-pointer nil "Index in `search-ring' of last string reused. nil if none yet.") (defvar regexp-search-ring-yank-pointer nil "Index in `regexp-search-ring' of last string reused. nil if none yet.") (defvar search-ring-update nil "*Non-nil if advancing or retreating in the search ring should cause search. Default value, nil, means edit the string instead.") ;;;==================================================== ;;; Define isearch-mode keymap. (defvar isearch-mode-map nil "Keymap for isearch-mode.") (or isearch-mode-map (let* ((i 0) (map (make-keymap))) (or (vectorp (nth 1 map)) (error "The initialization of isearch-mode-map must be updated")) ;; Give this map a vector 256 long, for dense binding ;; of a larger range of ordinary characters. (setcar (cdr map) (make-vector 256 nil)) ;; Make function keys, etc, exit the search. (define-key map [t] 'isearch-other-control-char) ;; Control chars, by default, end isearch mode transparently. ;; We need these explicit definitions because, in a dense keymap, ;; the binding for t does not affect characters. ;; We use a dense keymap to save space. (while (< i ?\ ) (define-key map (make-string 1 i) 'isearch-other-control-char) (setq i (1+ i))) ;; Printing chars extend the search string by default. (setq i ?\ ) (while (< i (length (nth 1 map))) (define-key map (vector i) 'isearch-printing-char) (setq i (1+ i))) ;; To handle local bindings with meta char prefix keys, define ;; another full keymap. This must be done for any other prefix ;; keys as well, one full keymap per char of the prefix key. It ;; would be simpler to disable the global keymap, and/or have a ;; default local key binding for any key not otherwise bound. (let ((meta-map (make-sparse-keymap))) (define-key map (char-to-string meta-prefix-char) meta-map) (define-key map [escape] meta-map)) (define-key map (vector meta-prefix-char t) 'isearch-other-meta-char) ;; Several non-printing chars change the searching behavior. (define-key map "\C-s" 'isearch-repeat-forward) (define-key map "\C-r" 'isearch-repeat-backward) (define-key map "\177" 'isearch-delete-char) (define-key map "\C-g" 'isearch-abort) ;; This assumes \e is the meta-prefix-char. (or (= ?\e meta-prefix-char) (error "Inconsistency in isearch.el")) (define-key map "\e\e\e" 'isearch-cancel) (define-key map [escape escape escape] 'isearch-cancel) (define-key map "\C-q" 'isearch-quote-char) (define-key map "\r" 'isearch-exit) (define-key map "\C-j" 'isearch-printing-char) (define-key map "\t" 'isearch-printing-char) (define-key map " " 'isearch-whitespace-chars) (define-key map "\C-w" 'isearch-yank-word) (define-key map "\C-y" 'isearch-yank-line) ;; Define keys for regexp chars * ? |. ;; Nothing special for + because it matches at least once. (define-key map "*" 'isearch-*-char) (define-key map "?" 'isearch-*-char) (define-key map "|" 'isearch-|-char) ;;; Turned off because I find I expect to get the global definition--rms. ;;; ;; Instead bind C-h to special help command for isearch-mode. ;;; (define-key map "\C-h" 'isearch-mode-help) (define-key map "\M-n" 'isearch-ring-advance) (define-key map "\M-p" 'isearch-ring-retreat) (define-key map "\M-y" 'isearch-yank-kill) (define-key map "\M-\t" 'isearch-complete) ;; Pass frame events transparently so they won't exit the search. ;; In particular, if we have more than one display open, then a ;; switch-frame might be generated by someone typing at another keyboard. (define-key map [switch-frame] nil) (define-key map [delete-frame] nil) (define-key map [iconify-frame] nil) (define-key map [make-frame-visible] nil) (setq isearch-mode-map map) )) ;; Some bindings you may want to put in your isearch-mode-hook. ;; Suggest some alternates... ;; (define-key isearch-mode-map "\C-t" 'isearch-toggle-case-fold) ;; (define-key isearch-mode-map "\C-t" 'isearch-toggle-regexp) ;; (define-key isearch-mode-map "\C-^" 'isearch-edit-string) (defvar minibuffer-local-isearch-map nil "Keymap for editing isearch strings in the minibuffer.") (or minibuffer-local-isearch-map (let ((map (copy-keymap minibuffer-local-map))) (define-key map "\r" 'isearch-nonincremental-exit-minibuffer) (define-key map "\M-n" 'isearch-ring-advance-edit) (define-key map "\M-p" 'isearch-ring-retreat-edit) (define-key map "\M-\t" 'isearch-complete-edit) (define-key map "\C-s" 'isearch-forward-exit-minibuffer) (define-key map "\C-r" 'isearch-reverse-exit-minibuffer) (setq minibuffer-local-isearch-map map) )) ;;;======================================================== ;; Internal variables declared globally for byte-compiler. ;; These are all set with setq while isearching ;; and bound locally while editing the search string. (defvar isearch-forward nil) ; Searching in the forward direction. (defvar isearch-regexp nil) ; Searching for a regexp. (defvar isearch-word nil) ; Searching for words. (defvar isearch-cmds nil) ; Stack of search status sets. (defvar isearch-string "") ; The current search string. (defvar isearch-message "") ; text-char-description version of isearch-string (defvar isearch-success t) ; Searching is currently successful. (defvar isearch-invalid-regexp nil) ; Regexp not well formed. (defvar isearch-within-brackets nil) ; Regexp has unclosed [. (defvar isearch-other-end nil) ; Start (end) of match if forward (backward). (defvar isearch-wrapped nil) ; Searching restarted from the top (bottom). (defvar isearch-barrier 0) ; case-fold-search while searching. ; either nil, t, or 'yes. 'yes means the same as t except that mixed ; case in the search string is ignored. (defvar isearch-case-fold-search nil) (defvar isearch-adjusted nil) (defvar isearch-slow-terminal-mode nil) ;;; If t, using a small window. (defvar isearch-small-window nil) (defvar isearch-opoint 0) ;;; The window configuration active at the beginning of the search. (defvar isearch-window-configuration nil) ;; Flag to indicate a yank occurred, so don't move the cursor. (defvar isearch-yank-flag nil) ;;; A function to be called after each input character is processed. ;;; (It is not called after characters that exit the search.) ;;; It is only set from an optional argument to `isearch-mode'. (defvar isearch-op-fun nil) ;;; Is isearch-mode in a recursive edit for modal searching. (defvar isearch-recursive-edit nil) ;;; Should isearch be terminated after doing one search? (defvar isearch-nonincremental nil) ;; New value of isearch-forward after isearch-edit-string. (defvar isearch-new-forward nil) ;;;============================================================== ;; Minor-mode-alist changes - kind of redundant with the ;; echo area, but if isearching in multiple windows, it can be useful. (or (assq 'isearch-mode minor-mode-alist) (nconc minor-mode-alist (list '(isearch-mode isearch-mode)))) (defvar isearch-mode nil) ;; Name of the minor mode, if non-nil. (make-variable-buffer-local 'isearch-mode) (define-key global-map "\C-s" 'isearch-forward) (define-key esc-map "\C-s" 'isearch-forward-regexp) (define-key global-map "\C-r" 'isearch-backward) (define-key esc-map "\C-r" 'isearch-backward-regexp) ;;;=============================================================== ;;; Entry points to isearch-mode. ;;; These four functions should replace those in loaddefs.el ;;; An alternative is to defalias isearch-forward etc to isearch-mode, ;;; and look at this-command to set the options accordingly. (defun isearch-forward (&optional regexp-p no-recursive-edit) "\ Do incremental search forward. With a prefix argument, do an incremental regular expression search instead. \\ As you type characters, they add to the search string and are found. The following non-printing keys are bound in `isearch-mode-map'. Type \\[isearch-delete-char] to cancel characters from end of search string. Type \\[isearch-exit] to exit, leaving point at location found. Type LFD (C-j) to match end of line. Type \\[isearch-repeat-forward] to search again forward,\ \\[isearch-repeat-backward] to search again backward. Type \\[isearch-yank-word] to yank word from buffer onto end of search\ string and search for it. Type \\[isearch-yank-line] to yank rest of line onto end of search string\ and search for it. Type \\[isearch-quote-char] to quote control character to search for it. \\[isearch-abort] while searching or when search has failed cancels input\ back to what has been found successfully. \\[isearch-abort] when search is successful aborts and moves point to\ starting point. Also supported is a search ring of the previous 16 search strings. Type \\[isearch-ring-advance] to search for the next item in the search ring. Type \\[isearch-ring-retreat] to search for the previous item in the search\ ring. Type \\[isearch-complete] to complete the search string using the search ring. The above keys, bound in `isearch-mode-map', are often controlled by options; do M-x apropos on search-.* to find them. Other control and meta characters terminate the search and are then executed normally (depending on `search-exit-option'). Likewise for function keys and mouse button events. If this function is called non-interactively, it does not return to the calling function until the search is done." (interactive "P\np") (isearch-mode t (not (null regexp-p)) nil (not no-recursive-edit))) (defun isearch-forward-regexp (&optional not-regexp no-recursive-edit) "\ Do incremental search forward for regular expression. With a prefix argument, do a regular string search instead. Like ordinary incremental search except that your input is treated as a regexp. See \\[isearch-forward] for more info." (interactive "P\np") (isearch-mode t (null not-regexp) nil (not no-recursive-edit))) (defun isearch-backward (&optional regexp-p no-recursive-edit) "\ Do incremental search backward. With a prefix argument, do a regular expression search instead. See \\[isearch-forward] for more information." (interactive "P\np") (isearch-mode nil (not (null regexp-p)) nil (not no-recursive-edit))) (defun isearch-backward-regexp (&optional not-regexp no-recursive-edit) "\ Do incremental search backward for regular expression. With a prefix argument, do a regular string search instead. Like ordinary incremental search except that your input is treated as a regexp. See \\[isearch-forward] for more info." (interactive "P\np") (isearch-mode nil (null not-regexp) nil (not no-recursive-edit))) (defun isearch-mode-help () (interactive) (describe-function 'isearch-forward) (isearch-update)) ;;;================================================================== ;; isearch-mode only sets up incremental search for the minor mode. ;; All the work is done by the isearch-mode commands. ;; Not used yet: ;;(defconst isearch-commands '(isearch-forward isearch-backward ;; isearch-forward-regexp isearch-backward-regexp) ;; "List of commands for which isearch-mode does not recursive-edit.") (defun isearch-mode (forward &optional regexp op-fun recursive-edit word-p) "Start isearch minor mode. Called by `isearch-forward', etc. \\{isearch-mode-map}" ;; Initialize global vars. (setq isearch-forward forward isearch-regexp regexp isearch-word word-p isearch-op-fun op-fun isearch-case-fold-search case-fold-search isearch-string "" isearch-message "" isearch-cmds nil isearch-success t isearch-wrapped nil isearch-barrier (point) isearch-adjusted nil isearch-yank-flag nil isearch-invalid-regexp nil isearch-within-brackets nil isearch-slow-terminal-mode (and (<= baud-rate search-slow-speed) (> (window-height) (* 4 search-slow-window-lines))) isearch-other-end nil isearch-small-window nil isearch-opoint (point) search-ring-yank-pointer nil regexp-search-ring-yank-pointer nil) (setq isearch-window-configuration (if isearch-slow-terminal-mode (current-window-configuration) nil)) (setq isearch-mode " Isearch") ;; forward? regexp? (force-mode-line-update) (isearch-push-state) (setq overriding-terminal-local-map isearch-mode-map) (isearch-update) (run-hooks 'isearch-mode-hook) (setq mouse-leave-buffer-hook '(isearch-done)) ;; isearch-mode can be made modal (in the sense of not returning to ;; the calling function until searching is completed) by entering ;; a recursive-edit and exiting it when done isearching. (if recursive-edit (let ((isearch-recursive-edit t)) (recursive-edit))) isearch-success) ;;;==================================================== ;; Some high level utilities. Others below. (defun isearch-update () ;; Called after each command to update the display. (if (null unread-command-events) (progn (if (not (input-pending-p)) (isearch-message)) (if (and isearch-slow-terminal-mode (not (or isearch-small-window (pos-visible-in-window-p)))) (let ((found-point (point))) (setq isearch-small-window t) (move-to-window-line 0) (let ((window-min-height 1)) (split-window nil (if (< search-slow-window-lines 0) (1+ (- search-slow-window-lines)) (- (window-height) (1+ search-slow-window-lines))))) (if (< search-slow-window-lines 0) (progn (vertical-motion (- 1 search-slow-window-lines)) (set-window-start (next-window) (point)) (set-window-hscroll (next-window) (window-hscroll)) (set-window-hscroll (selected-window) 0)) (other-window 1)) (goto-char found-point))) (if isearch-other-end (if (< isearch-other-end (point)) ; isearch-forward? (isearch-highlight isearch-other-end (point)) (isearch-highlight (point) isearch-other-end)) (isearch-dehighlight nil)) )) (setq ;; quit-flag nil not for isearch-mode isearch-adjusted nil isearch-yank-flag nil) ) (defun isearch-done (&optional nopush edit) (setq mouse-leave-buffer-hook nil) ;; Called by all commands that terminate isearch-mode. ;; If NOPUSH is non-nil, we don't push the string on the search ring. (setq overriding-terminal-local-map nil) ;; (setq pre-command-hook isearch-old-pre-command-hook) ; for lemacs (isearch-dehighlight t) (let ((found-start (window-start (selected-window))) (found-point (point))) (if isearch-window-configuration (set-window-configuration isearch-window-configuration)) (if isearch-small-window (goto-char found-point) ;; Exiting the save-window-excursion clobbers window-start; restore it. (set-window-start (selected-window) found-start t)) ;; If there was movement, mark the starting position. ;; Maybe should test difference between and set mark iff > threshold. (if (/= (point) isearch-opoint) (or (and transient-mark-mode mark-active) (progn (push-mark isearch-opoint t) (or executing-macro (> (minibuffer-depth) 0) (message "Mark saved where search started")))))) (setq isearch-mode nil) (force-mode-line-update) (if (and (> (length isearch-string) 0) (not nopush)) ;; Update the ring data. (isearch-update-ring isearch-string isearch-regexp)) (run-hooks 'isearch-mode-end-hook) (and (not edit) isearch-recursive-edit (exit-recursive-edit))) (defun isearch-update-ring (string &optional regexp) "Add STRING to the beginning of the search ring. REGEXP says which ring to use." (if regexp (if (or (null regexp-search-ring) (not (string= string (car regexp-search-ring)))) (progn (setq regexp-search-ring (cons string regexp-search-ring)) (if (> (length regexp-search-ring) regexp-search-ring-max) (setcdr (nthcdr (1- search-ring-max) regexp-search-ring) nil)))) (if (or (null search-ring) (not (string= string (car search-ring)))) (progn (setq search-ring (cons string search-ring)) (if (> (length search-ring) search-ring-max) (setcdr (nthcdr (1- search-ring-max) search-ring) nil)))))) ;;;======================================================= ;;; Switching buffers should first terminate isearch-mode. ;;; This is done quite differently for each variant of emacs. ;;; For lemacs, see Exiting in lemacs below ;; For Emacs 19, the frame switch event is handled. (defun isearch-switch-frame-handler () (interactive) ;; Is this necessary? ;; First terminate isearch-mode. (isearch-done) (handle-switch-frame (car (cdr (isearch-last-command-char))))) ;;;======================================================== ;;;==================================================== ;; Commands active while inside of the isearch minor mode. (defun isearch-exit () "Exit search normally. However, if this is the first command after starting incremental search and `search-nonincremental-instead' is non-nil, do a nonincremental search instead via `isearch-edit-string'." (interactive) (if (and search-nonincremental-instead (= 0 (length isearch-string))) (let ((isearch-nonincremental t)) (isearch-edit-string))) (isearch-done)) (defun isearch-edit-string () "Edit the search string in the minibuffer. The following additional command keys are active while editing. \\ \\[exit-minibuffer] to resume incremental searching with the edited string. \\[isearch-nonincremental-exit-minibuffer] to do one nonincremental search. \\[isearch-forward-exit-minibuffer] to resume isearching forward. \\[isearch-reverse-exit-minibuffer] to resume isearching backward. \\[isearch-ring-advance-edit] to replace the search string with the next item in the search ring. \\[isearch-ring-retreat-edit] to replace the search string with the previous item in the search ring. \\[isearch-complete-edit] to complete the search string using the search ring. \\ If first char entered is \\[isearch-yank-word], then do word search instead." ;; This code is very hairy for several reasons, explained in the code. ;; Mainly, isearch-mode must be terminated while editing and then restarted. ;; If there were a way to catch any change of buffer from the minibuffer, ;; this could be simplified greatly. ;; Editing doesn't back up the search point. Should it? (interactive) (condition-case err (let ((isearch-nonincremental isearch-nonincremental) ;; Locally bind all isearch global variables to protect them ;; from recursive isearching. ;; isearch-string -message and -forward are not bound ;; so they may be changed. Instead, save the values. (isearch-new-string isearch-string) (isearch-new-message isearch-message) (isearch-new-forward isearch-forward) (isearch-new-word isearch-word) (isearch-regexp isearch-regexp) (isearch-op-fun isearch-op-fun) (isearch-cmds isearch-cmds) (isearch-success isearch-success) (isearch-wrapped isearch-wrapped) (isearch-barrier isearch-barrier) (isearch-adjusted isearch-adjusted) (isearch-yank-flag isearch-yank-flag) (isearch-invalid-regexp isearch-invalid-regexp) (isearch-within-brackets isearch-within-brackets) ;;; Don't bind this. We want isearch-search, below, to set it. ;;; And the old value won't matter after that. ;;; (isearch-other-end isearch-other-end) ;;; Perhaps some of these other variables should be bound for a ;;; shorter period, ending before the next isearch-search. ;;; But there doesn't seem to be a real bug, so let's not risk it now. (isearch-opoint isearch-opoint) (isearch-slow-terminal-mode isearch-slow-terminal-mode) (isearch-small-window isearch-small-window) (isearch-recursive-edit isearch-recursive-edit) ;; Save current configuration so we can restore it here. (isearch-window-configuration (current-window-configuration)) ) ;; Actually terminate isearching until editing is done. ;; This is so that the user can do anything without failure, ;; like switch buffers and start another isearch, and return. (condition-case err (isearch-done t t) (exit nil)) ; was recursive editing (isearch-message) ;; for read-char (unwind-protect (let* (;; Why does following read-char echo? ;;(echo-keystrokes 0) ;; not needed with above message (e (let ((cursor-in-echo-area t)) (read-event))) ;; Binding minibuffer-history-symbol to nil is a work-around ;; for some incompatibility with gmhist. (minibuffer-history-symbol) (message-log-max nil)) ;; If the first character the user types when we prompt them ;; for a string is the yank-word character, then go into ;; word-search mode. Otherwise unread that character and ;; read a key the normal way. ;; Word search does not apply (yet) to regexp searches, ;; no check is made here. (message (isearch-message-prefix nil nil t)) (if (eq 'isearch-yank-word (lookup-key isearch-mode-map (vector e))) (setq isearch-word t ;; so message-prefix is right isearch-new-word t) (isearch-unread e)) (setq cursor-in-echo-area nil) (setq isearch-new-string (let (junk-ring) (read-from-minibuffer (isearch-message-prefix nil nil isearch-nonincremental) isearch-string minibuffer-local-isearch-map nil 'junk-ring)) isearch-new-message (mapconcat 'isearch-text-char-description isearch-new-string ""))) ;; Always resume isearching by restarting it. (isearch-mode isearch-forward isearch-regexp isearch-op-fun nil isearch-word) ;; Copy new local values to isearch globals (setq isearch-string isearch-new-string isearch-message isearch-new-message isearch-forward isearch-new-forward isearch-word isearch-new-word)) ;; Empty isearch-string means use default. (if (= 0 (length isearch-string)) (setq isearch-string (car (if isearch-regexp regexp-search-ring search-ring))) ;; This used to set the last search string, ;; but I think it is not right to do that here. ;; Only the string actually used should be saved. ) ;; Reinvoke the pending search. (isearch-push-state) (isearch-search) (isearch-update) (if isearch-nonincremental (progn ;; (sit-for 1) ;; needed if isearch-done does: (message "") (isearch-done)))) (quit ; handle abort-recursive-edit (isearch-abort) ;; outside of let to restore outside global values ))) (defun isearch-nonincremental-exit-minibuffer () (interactive) (setq isearch-nonincremental t) (exit-minibuffer)) (defun isearch-forward-exit-minibuffer () (interactive) (setq isearch-new-forward t) (exit-minibuffer)) (defun isearch-reverse-exit-minibuffer () (interactive) (setq isearch-new-forward nil) (exit-minibuffer)) (defun isearch-cancel () "Terminate the search and go back to the starting point." (interactive) (goto-char isearch-opoint) (isearch-done t) (signal 'quit nil)) ; and pass on quit signal (defun isearch-abort () "Abort incremental search mode if searching is successful, signalling quit. Otherwise, revert to previous successful search and continue searching. Use `isearch-exit' to quit without signalling." (interactive) ;; (ding) signal instead below, if quitting (discard-input) (if isearch-success ;; If search is successful, move back to starting point ;; and really do quit. (progn (goto-char isearch-opoint) (setq isearch-success nil) (isearch-done t) ; exit isearch (signal 'quit nil)) ; and pass on quit signal ;; If search is failing, or has an incomplete regexp, ;; rub out until it is once more successful. (while (or (not isearch-success) isearch-invalid-regexp) (isearch-pop-state)) (isearch-update))) (defun isearch-repeat (direction) ;; Utility for isearch-repeat-forward and -backward. (if (eq isearch-forward (eq direction 'forward)) ;; C-s in forward or C-r in reverse. (if (equal isearch-string "") ;; If search string is empty, use last one. (setq isearch-string (or (if isearch-regexp (car regexp-search-ring) (car search-ring)) "") isearch-message (mapconcat 'isearch-text-char-description isearch-string "")) ;; If already have what to search for, repeat it. (or isearch-success (progn (goto-char (if isearch-forward (point-min) (point-max))) (setq isearch-wrapped t)))) ;; C-s in reverse or C-r in forward, change direction. (setq isearch-forward (not isearch-forward))) (setq isearch-barrier (point)) ; For subsequent \| if regexp. (if (equal isearch-string "") (setq isearch-success t) (if (and isearch-success (equal (match-end 0) (match-beginning 0))) ;; If repeating a search that found ;; an empty string, ensure we advance. (if (if isearch-forward (eobp) (bobp)) ;; If there's nowhere to advance to, fail (and wrap next time). (progn (setq isearch-success nil) (ding)) (forward-char (if isearch-forward 1 -1)) (isearch-search)) (isearch-search))) (isearch-push-state) (isearch-update)) (defun isearch-repeat-forward () "Repeat incremental search forwards." (interactive) (isearch-repeat 'forward)) (defun isearch-repeat-backward () "Repeat incremental search backwards." (interactive) (isearch-repeat 'backward)) (defun isearch-toggle-regexp () "Toggle regexp searching on or off." ;; The status stack is left unchanged. (interactive) (setq isearch-regexp (not isearch-regexp)) (if isearch-regexp (setq isearch-word nil)) (isearch-update)) (defun isearch-toggle-case-fold () "Toggle case folding in searching on or off." (interactive) (setq isearch-case-fold-search (if isearch-case-fold-search nil 'yes)) (let ((message-log-max nil)) (message "%s%s [case %ssensitive]" (isearch-message-prefix nil nil isearch-nonincremental) isearch-message (if isearch-case-fold-search "in" ""))) (setq isearch-adjusted t) (sit-for 1) (isearch-update)) (defun isearch-delete-char () "Discard last input item and move point back. If no previous match was done, just beep." (interactive) (if (null (cdr isearch-cmds)) (ding) (isearch-pop-state)) (isearch-update)) (defun isearch-yank (chunk) ;; Helper for isearch-yank-word and isearch-yank-line ;; CHUNK should be word, line or kill. (let ((string (cond ((eq chunk 'kill) (current-kill 0)) (t (save-excursion (and (not isearch-forward) isearch-other-end (goto-char isearch-other-end)) (buffer-substring (point) (save-excursion (cond ((eq chunk 'word) (forward-word 1)) ((eq chunk 'line) (end-of-line))) (point)))))))) ;; Downcase the string if not supposed to case-fold yanked strings. (if (and isearch-case-fold-search (eq 'not-yanks search-upper-case)) (setq string (downcase string))) (if isearch-regexp (setq string (regexp-quote string))) (setq isearch-string (concat isearch-string string) isearch-message (concat isearch-message (mapconcat 'isearch-text-char-description string "")) ;; Don't move cursor in reverse search. isearch-yank-flag t)) (isearch-search-and-update)) (defun isearch-yank-kill () "Pull string from kill ring into search string." (interactive) (isearch-yank 'kill)) (defun isearch-yank-word () "Pull next word from buffer into search string." (interactive) (isearch-yank 'word)) (defun isearch-yank-line () "Pull rest of line from buffer into search string." (interactive) (isearch-yank 'line)) (defun isearch-search-and-update () ;; Do the search and update the display. (if (and (not isearch-success) ;; unsuccessful regexp search may become ;; successful by addition of characters which ;; make isearch-string valid (not isearch-regexp)) nil ;; In reverse search, adding stuff at ;; the end may cause zero or many more chars to be ;; matched, in the string following point. ;; Allow all those possibilities without moving point as ;; long as the match does not extend past search origin. (if (and (not isearch-forward) (not isearch-adjusted) (condition-case () (looking-at (if isearch-regexp isearch-string (regexp-quote isearch-string))) (error nil)) (or isearch-yank-flag (<= (match-end 0) (min isearch-opoint isearch-barrier)))) (setq isearch-success t isearch-invalid-regexp nil isearch-within-brackets nil isearch-other-end (match-end 0)) ;; Not regexp, not reverse, or no match at point. (if (and isearch-other-end (not isearch-adjusted)) (goto-char (if isearch-forward isearch-other-end (min isearch-opoint isearch-barrier (1+ isearch-other-end))))) (isearch-search) )) (isearch-push-state) (if isearch-op-fun (funcall isearch-op-fun)) (isearch-update)) ;; *, ?, and | chars can make a regexp more liberal. ;; They can make a regexp match sooner or make it succeed instead of failing. ;; So go back to place last successful search started ;; or to the last ^S/^R (barrier), whichever is nearer. ;; + needs no special handling because the string must match at least once. (defun isearch-*-char () "Handle * and ? specially in regexps." (interactive) (if isearch-regexp (progn (setq isearch-adjusted t) (let ((cs (nth (if isearch-forward 5 ; isearch-other-end 2) ; saved (point) (car (cdr isearch-cmds))))) ;; (car isearch-cmds) is after last search; ;; (car (cdr isearch-cmds)) is from before it. (setq cs (or cs isearch-barrier)) (goto-char (if isearch-forward (max cs isearch-barrier) (min cs isearch-barrier)))))) (isearch-process-search-char (isearch-last-command-char))) (defun isearch-|-char () "If in regexp search, jump to the barrier." (interactive) (if isearch-regexp (progn (setq isearch-adjusted t) (goto-char isearch-barrier))) (isearch-process-search-char (isearch-last-command-char))) (defalias 'isearch-other-control-char 'isearch-other-meta-char) (defun isearch-other-meta-char () "Exit the search normally and reread this key sequence. But only if `search-exit-option' is non-nil, the default. If it is the symbol `edit', the search string is edited in the minibuffer and the meta character is unread so that it applies to editing the string." (interactive) (let* ((key (this-command-keys)) (main-event (aref key 0)) (keylist (listify-key-sequence key))) (cond ((and (= (length key) 1) (let ((lookup (lookup-key function-key-map key))) (not (or (null lookup) (integerp lookup))))) ;; Handle a function key that translates into something else. ;; If the key has a global definition too, ;; exit and unread the key itself, so its global definition runs. ;; Otherwise, unread the translation, ;; so that the translated key takes effect within isearch. (cancel-kbd-macro-events) (if (lookup-key global-map key) (progn (isearch-done) (apply 'isearch-unread keylist)) (apply 'isearch-unread (listify-key-sequence (lookup-key function-key-map key))))) ( ;; Handle an undefined shifted control character ;; by downshifting it if that makes it defined. ;; (As read-key-sequence would normally do, ;; if we didn't have a default definition.) (let ((mods (event-modifiers main-event))) (and (integerp main-event) (memq 'shift mods) (memq 'control mods) (lookup-key isearch-mode-map (let ((copy (copy-sequence key))) (aset copy 0 (- main-event (- ?\C-\S-a ?\C-a))) copy) nil))) (setcar keylist (- main-event (- ?\C-\S-a ?\C-a))) (cancel-kbd-macro-events) (apply 'isearch-unread keylist)) ((eq search-exit-option 'edit) (apply 'isearch-unread keylist) (isearch-edit-string)) (search-exit-option (let (window) (cancel-kbd-macro-events) (apply 'isearch-unread keylist) ;; Properly handle scroll-bar and mode-line clicks ;; for which a dummy prefix event was generated as (aref key 0). (and (> (length key) 1) (symbolp (aref key 0)) (listp (aref key 1)) (not (numberp (posn-point (event-start (aref key 1))))) ;; Convert the event back into its raw form, ;; with the dummy prefix implicit in the mouse event, ;; so it will get split up once again. (progn (setq unread-command-events (cdr unread-command-events)) (setq main-event (car unread-command-events)) (setcar (cdr (event-start main-event)) (car (nth 1 (event-start main-event)))))) ;; If we got a mouse click, maybe it was read with the buffer ;; it was clicked on. If so, that buffer, not the current one, ;; is in isearch mode. So end the search in that buffer. (if (and (listp main-event) (setq window (posn-window (event-start main-event))) (windowp window)) (save-excursion (set-buffer (window-buffer window)) (isearch-done)) (isearch-done)))) (t;; otherwise nil (isearch-process-search-string key key))))) (defun isearch-quote-char () "Quote special characters for incremental search." (interactive) (isearch-process-search-char (read-quoted-char (isearch-message t)))) (defun isearch-return-char () "Convert return into newline for incremental search. Obsolete." (interactive) (isearch-process-search-char ?\n)) (defun isearch-printing-char () "Add this ordinary printing character to the search string and search." (interactive) (isearch-process-search-char (isearch-last-command-char))) (defun isearch-whitespace-chars () "Match all whitespace chars, if in regexp mode. If you want to search for just a space, type C-q SPC." (interactive) (if isearch-regexp (if (and search-whitespace-regexp (not isearch-within-brackets)) (isearch-process-search-string search-whitespace-regexp " ") (isearch-printing-char)) (progn ;; This way of doing word search doesn't correctly extend current search. ;; (setq isearch-word t) ;; (setq isearch-adjusted t) ;; (goto-char isearch-barrier) (isearch-printing-char)))) (defun isearch-process-search-char (char) ;; Append the char to the search string, update the message and re-search. (isearch-process-search-string (isearch-char-to-string char) (isearch-text-char-description char))) (defun isearch-process-search-string (string message) (setq isearch-string (concat isearch-string string) isearch-message (concat isearch-message message)) (isearch-search-and-update)) ;;=========================================================== ;; Search Ring (defun isearch-ring-adjust1 (advance) ;; Helper for isearch-ring-adjust (let* ((ring (if isearch-regexp regexp-search-ring search-ring)) (length (length ring)) (yank-pointer-name (if isearch-regexp 'regexp-search-ring-yank-pointer 'search-ring-yank-pointer)) (yank-pointer (eval yank-pointer-name))) (if (zerop length) () (set yank-pointer-name (setq yank-pointer (mod (+ (or yank-pointer 0) (if advance -1 1)) length))) (setq isearch-string (nth yank-pointer ring) isearch-message (mapconcat 'isearch-text-char-description isearch-string ""))))) (defun isearch-ring-adjust (advance) ;; Helper for isearch-ring-advance and isearch-ring-retreat (if (cdr isearch-cmds) ;; is there more than one thing on stack? (isearch-pop-state)) (isearch-ring-adjust1 advance) (isearch-push-state) (if search-ring-update (progn (isearch-search) (isearch-update)) (isearch-edit-string) )) (defun isearch-ring-advance () "Advance to the next search string in the ring." ;; This could be more general to handle a prefix arg, but who would use it. (interactive) (isearch-ring-adjust 'advance)) (defun isearch-ring-retreat () "Retreat to the previous search string in the ring." (interactive) (isearch-ring-adjust nil)) (defun isearch-ring-advance-edit (n) "Insert the next element of the search history into the minibuffer." (interactive "p") (let* ((yank-pointer-name (if isearch-regexp 'regexp-search-ring-yank-pointer 'search-ring-yank-pointer)) (yank-pointer (eval yank-pointer-name)) (ring (if isearch-regexp regexp-search-ring search-ring)) (length (length ring))) (if (zerop length) () (set yank-pointer-name (setq yank-pointer (mod (- (or yank-pointer 0) n) length))) (erase-buffer) (insert (nth yank-pointer ring)) (goto-char (point-max))))) (defun isearch-ring-retreat-edit (n) "Inserts the previous element of the search history into the minibuffer." (interactive "p") (isearch-ring-advance-edit (- n))) ;;(defun isearch-ring-adjust-edit (advance) ;; "Use the next or previous search string in the ring while in minibuffer." ;; (isearch-ring-adjust1 advance) ;; (erase-buffer) ;; (insert isearch-string)) ;;(defun isearch-ring-advance-edit () ;; (interactive) ;; (isearch-ring-adjust-edit 'advance)) ;;(defun isearch-ring-retreat-edit () ;; "Retreat to the previous search string in the ring while in the minibuffer." ;; (interactive) ;; (isearch-ring-adjust-edit nil)) (defun isearch-complete1 () ;; Helper for isearch-complete and isearch-complete-edit ;; Return t if completion OK, nil if no completion exists. (let* ((ring (if isearch-regexp regexp-search-ring search-ring)) (alist (mapcar (function (lambda (string) (list string))) ring)) (completion-ignore-case case-fold-search) (completion (try-completion isearch-string alist))) (cond ((eq completion t) ;; isearch-string stays the same t) ((or completion ; not nil, must be a string (= 0 (length isearch-string))) ; shouldnt have to say this (if (equal completion isearch-string) ;; no extension? (if completion-auto-help (with-output-to-temp-buffer "*Isearch completions*" (display-completion-list (all-completions isearch-string alist)))) (setq isearch-string completion)) t) (t (message "No completion") ; waits a second if in minibuffer nil)))) (defun isearch-complete () "Complete the search string from the strings on the search ring. The completed string is then editable in the minibuffer. If there is no completion possible, say so and continue searching." (interactive) (if (isearch-complete1) (isearch-edit-string) ;; else (sit-for 1) (isearch-update))) (defun isearch-complete-edit () "Same as `isearch-complete' except in the minibuffer." (interactive) (setq isearch-string (buffer-string)) (if (isearch-complete1) (progn (erase-buffer) (insert isearch-string)))) ;;;============================================================== ;; The search status stack (and isearch window-local variables, not used). ;; Need a structure for this. (defun isearch-top-state () (let ((cmd (car isearch-cmds))) (setq isearch-string (car cmd) isearch-message (car (cdr cmd)) isearch-success (nth 3 cmd) isearch-forward (nth 4 cmd) isearch-other-end (nth 5 cmd) isearch-word (nth 6 cmd) isearch-invalid-regexp (nth 7 cmd) isearch-wrapped (nth 8 cmd) isearch-barrier (nth 9 cmd) isearch-within-brackets (nth 10 cmd) isearch-case-fold-search (nth 11 cmd)) (goto-char (car (cdr (cdr cmd)))))) (defun isearch-pop-state () (setq isearch-cmds (cdr isearch-cmds)) (isearch-top-state) ) (defun isearch-push-state () (setq isearch-cmds (cons (list isearch-string isearch-message (point) isearch-success isearch-forward isearch-other-end isearch-word isearch-invalid-regexp isearch-wrapped isearch-barrier isearch-within-brackets isearch-case-fold-search) isearch-cmds))) ;;;================================================================== ;; Message string (defun isearch-message (&optional c-q-hack ellipsis) ;; Generate and print the message string. (let ((cursor-in-echo-area ellipsis) (m (concat (isearch-message-prefix c-q-hack ellipsis isearch-nonincremental) isearch-message (isearch-message-suffix c-q-hack ellipsis) ))) (if c-q-hack m (let ((message-log-max nil)) (message "%s" m))))) (defun isearch-message-prefix (&optional c-q-hack ellipsis nonincremental) ;; If about to search, and previous search regexp was invalid, ;; check that it still is. If it is valid now, ;; let the message we display while searching say that it is valid. (and isearch-invalid-regexp ellipsis (condition-case () (progn (re-search-forward isearch-string (point) t) (setq isearch-invalid-regexp nil isearch-within-brackets nil)) (error nil))) ;; If currently failing, display no ellipsis. (or isearch-success (setq ellipsis nil)) (let ((m (concat (if isearch-success "" "failing ") (if (and isearch-wrapped (if isearch-forward (> (point) isearch-opoint) (< (point) isearch-opoint))) "over") (if isearch-wrapped "wrapped ") (if isearch-word "word " "") (if isearch-regexp "regexp " "") (if nonincremental "search" "I-search") (if isearch-forward ": " " backward: ") ))) (aset m 0 (upcase (aref m 0))) m)) (defun isearch-message-suffix (&optional c-q-hack ellipsis) (concat (if c-q-hack "^Q" "") (if isearch-invalid-regexp (concat " [" isearch-invalid-regexp "]") ""))) ;;;======================================================== ;;; Searching (defun isearch-search () ;; Do the search with the current search string. (isearch-message nil t) (if (and (eq isearch-case-fold-search t) search-upper-case) (setq isearch-case-fold-search (isearch-no-upper-case-p isearch-string isearch-regexp))) (condition-case lossage (let ((inhibit-quit nil) (case-fold-search isearch-case-fold-search)) (if isearch-regexp (setq isearch-invalid-regexp nil)) (setq isearch-within-brackets nil) (setq isearch-success (funcall (cond (isearch-word (if isearch-forward 'word-search-forward 'word-search-backward)) (isearch-regexp (if isearch-forward 're-search-forward 're-search-backward)) (t (if isearch-forward 'search-forward 'search-backward))) isearch-string nil t)) (if isearch-success (setq isearch-other-end (if isearch-forward (match-beginning 0) (match-end 0))))) (quit (isearch-unread ?\C-g) (setq isearch-success nil)) (invalid-regexp (setq isearch-invalid-regexp (car (cdr lossage))) (setq isearch-within-brackets (string-match "\\`Unmatched \\[" isearch-invalid-regexp)) (if (string-match "\\`Premature \\|\\`Unmatched \\|\\`Invalid " isearch-invalid-regexp) (setq isearch-invalid-regexp "incomplete input"))) (error ;; stack overflow in regexp search. (setq isearch-invalid-regexp (car (cdr lossage))))) (if isearch-success nil ;; Ding if failed this time after succeeding last time. (and (nth 3 (car isearch-cmds)) (ding)) (goto-char (nth 2 (car isearch-cmds))))) ;;;======================================================== ;;; Highlighting (defvar isearch-overlay nil) (defun isearch-highlight (beg end) (if (or (null search-highlight) (null window-system)) nil (or isearch-overlay (setq isearch-overlay (make-overlay beg end))) (move-overlay isearch-overlay beg end (current-buffer)) (overlay-put isearch-overlay 'face (if (internal-find-face 'isearch nil) 'isearch 'region)))) (defun isearch-dehighlight (totally) (if isearch-overlay (delete-overlay isearch-overlay))) ;;;=========================================================== ;;; General utilities (defun isearch-no-upper-case-p (string regexp-flag) "Return t if there are no upper case chars in STRING. If REGEXP-FLAG is non-nil, disregard letters preceeded by `\\' (but not `\\\\') since they have special meaning in a regexp." (let ((case-fold-search nil)) (not (string-match (if regexp-flag "\\(^\\|\\\\\\\\\\|[^\\]\\)[A-Z]" "[A-Z]") string)))) ;;;================================================= ;; Portability functions to support various Emacs versions. ;; To quiet the byte-compiler. (defvar unread-command-event) (defvar unread-command-events) (defvar last-command-event) (defun isearch-char-to-string (c) (make-string 1 c)) (defun isearch-text-char-description (c) (if (and (integerp c) (or (< c ?\ ) (= c ?\^?))) (text-char-description c) (isearch-char-to-string c))) ;; General function to unread characters or events. (defun isearch-unread (&rest char-or-events) (setq unread-command-events (append char-or-events unread-command-events))) (defun isearch-last-command-char () ;; General function to return the last command character. last-command-char) ;;; isearch.el ends here emacs-19.30/lisp/iso-acc.el100444 12120 1 30135 6035243571 13736 0ustar rmsdaemon;;; iso-acc.el -- minor mode providing electric accent keys ;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: Johan Vromans ;; Version: 1.7 (modified) ;; Maintainer: FSF ;; Keywords: i18n ;; 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: ;; Function `iso-accents-mode' activates a minor mode in which ;; typewriter "dead keys" are emulated. The purpose of this emulation ;; is to provide a simple means for inserting accented characters ;; according to the ISO-8859-1 character set. ;; ;; In `iso-accents-mode', pseudo accent characters are used to ;; introduce accented keys. The pseudo-accent characters are: ;; ;; ' (minute) -> grave accent ;; ` (backtick) -> acute accent ;; " (second) -> diaeresis ;; ^ (caret) -> circumflex ;; ~ (tilde) -> tilde over the character ;; / (slash) -> slash through the character. ;; Also: /A is A-with-ring and /E is AE ligature. ;; ;; The action taken depends on the key that follows the pseudo accent. ;; In general: ;; ;; pseudo-accent + appropriate letter -> accented letter ;; pseudo-accent + space -> pseudo-accent ;; pseudo-accent + pseudo-accent -> accent (if available) ;; pseudo-accent + other -> pseudo-accent + other ;; ;; If the pseudo-accent is followed by anything else than a ;; self-insert-command, the dead-key code is terminated, the ;; pseudo-accent inserted 'as is' and the bell is rung to signal this. ;; ;; Function `iso-accents-mode' can be used to enable the iso accents ;; minor mode, or disable it. ;; If you want only some of these characters to serve as accents, ;; set iso-accents-enable to the list of characters that should be special. ;;; Code: (provide 'iso-acc) (defvar iso-languages '(("portuguese" (?' ?` ?^ ?\" ?~) (((?' ?A) ?\301) ((?' ?E) ?\311) ((?' ?I) ?\315) ((?' ?O) ?\323) ((?' ?U) ?\332) ((?' ?C) ?\307) ((?' ?a) ?\341) ((?' ?e) ?\351) ((?' ?i) ?\355) ((?' ?o) ?\363) ((?' ?u) ?\372) ((?' ?c) ?\347) ((?' ? ) ?') ((?` ?A) ?\300) ((?` ?a) ?\340) ((?` ? ) ?`) ((?^ ?A) ?\302) ((?^ ?E) ?\312) ((?^ ?O) ?\324) ((?^ ?a) ?\342) ((?^ ?e) ?\352) ((?^ ?o) ?\364) ((?^ ? ) ?^) ((?\" ?U) ?\334) ((?\" ?u) ?\374) ((?\" ? ) ?\") ((?\~ ?A) ?\303) ((?\~ ?O) ?\325) ((?\~ ?a) ?\343) ((?\~ ?o) ?\365) ((?\~ ?\ ) ?\~))) ("french" (?' ?` ?^ ?\" ?~) (((?' ?A) ?\301) ((?' ?E) ?\311) ((?' ?I) ?\315) ((?' ?O) ?\323) ((?' ?U) ?\332) ((?' ?C) ?\307) ((?' ?a) ?\341) ((?' ?e) ?\351) ((?' ?i) ?\355) ((?' ?o) ?\363) ((?' ?u) ?\372) ((?' ?c) ?\347) ((?' ? ) ?') ((?` ?A) ?\300) ((?` ?E) ?\310) ((?` ?a) ?\340) ((?` ?e) ?\350) ((?` ? ) ?`) ((?^ ?A) ?\302) ((?^ ?E) ?\312) ((?^ ?I) ?\316) ((?^ ?O) ?\324) ((?^ ?U) ?\333) ((?^ ?a) ?\342) ((?^ ?e) ?\352) ((?^ ?i) ?\356) ((?^ ?o) ?\364) ((?^ ?u) ?\373) ((?^ ? ) ?^) ((?\" ?U) ?\334) ((?\" ?u) ?\374) ((?\" ? ) ?\") ((?\~ ?A) ?\303) ((?\~ ?O) ?\325) ((?\~ ?a) ?\343) ((?\~ ?o) ?\365) ((?\~ ?\ ) ?\~))) ("default" (?' ?` ?^ ?\" ?~ ?/) (((?' ?A) ?\301) ((?' ?E) ?\311) ((?' ?I) ?\315) ((?' ?O) ?\323) ((?' ?U) ?\332) ((?' ?Y) ?\335) ((?' ?a) ?\341) ((?' ?e) ?\351) ((?' ?i) ?\355) ((?' ?o) ?\363) ((?' ?u) ?\372) ((?' ?y) ?\375) ((?' ?') ?\264) ((?' ? ) ?') ((?` ?A) ?\300) ((?` ?E) ?\310) ((?` ?I) ?\314) ((?` ?O) ?\322) ((?` ?U) ?\331) ((?` ?a) ?\340) ((?` ?e) ?\350) ((?` ?i) ?\354) ((?` ?o) ?\362) ((?` ?u) ?\371) ((?` ? ) ?`) ((?` ?`) ?`) ((?^ ?A) ?\302) ((?^ ?E) ?\312) ((?^ ?I) ?\316) ((?^ ?O) ?\324) ((?^ ?U) ?\333) ((?^ ?a) ?\342) ((?^ ?e) ?\352) ((?^ ?i) ?\356) ((?^ ?o) ?\364) ((?^ ?u) ?\373) ((?^ ? ) ?^) ((?^ ?^) ?^) ((?\" ?A) ?\304) ((?\" ?E) ?\313) ((?\" ?I) ?\317) ((?\" ?O) ?\326) ((?\" ?U) ?\334) ((?\" ?a) ?\344) ((?\" ?e) ?\353) ((?\" ?i) ?\357) ((?\" ?o) ?\366) ((?\" ?s) ?\337) ((?\" ?u) ?\374) ((?\" ?y) ?\377) ((?\" ? ) ?\") ((?\" ?\") ?\250) ((?\~ ?A) ?\303) ((?\~ ?C) ?\307) ((?\~ ?D) ?\320) ((?\~ ?N) ?\321) ((?\~ ?O) ?\325) ((?\~ ?T) ?\336) ((?\~ ?a) ?\343) ((?\~ ?c) ?\347) ((?\~ ?d) ?\360) ((?\~ ?n) ?\361) ((?\~ ?o) ?\365) ((?\~ ?t) ?\376) ((?\~ ?>) ?\273) ((?\~ ?<) ?\253) ((?\~ ?\ ) ?\~) ((?\~ ?\~) ?\270) ((?\/ ?A) ?\305) ((?\/ ?E) ?\306) ((?\/ ?O) ?\330) ((?\/ ?a) ?\345) ((?\/ ?e) ?\346) ((?\/ ?o) ?\370) ((?\/ ?\ ) ?\/) ((?\/ ?\/) ?\260)))) "List of language-specific customizations for the ISO Accents mode. Each element of the list is of the form (LANGUAGE ENABLE LIST). LANGUAGE is a string naming the language. ENABLE is a list of characters that will be used as accent prefixes. It will be the value of the iso-accents-enable variable. LIST is a list of accent translations. It will be the value of the iso-accents-list variable.") (defvar iso-language nil "Language for which ISO Accents mode is currently customized. Change it with the `iso-accents-customize' function.") (defvar iso-accents-list nil "Association list for ISO accent combinations, for the chosen language.") (defvar iso-accents-mode nil "*Non-nil enables ISO Accents mode. Setting this variable makes it local to the current buffer. See the function `iso-accents-mode'.") (make-variable-buffer-local 'iso-accents-mode) (defun iso-accents-accent-key (prompt) "Modify the following character by adding an accent to it." ;; Pick up the accent character. (if iso-accents-mode (iso-accents-compose prompt) (char-to-string last-input-char))) (defun iso-accents-compose-key (prompt) "Modify the following character by adding an accent to it." ;; Pick up the accent character. (let ((combined (iso-accents-compose prompt))) (if unread-command-events (let ((unread unread-command-events)) (setq unread-command-events nil) (error "Characters %s and %s cannot be composed" (single-key-description (aref combined 0)) (single-key-description (car unread))))) combined)) (defun iso-accents-compose (prompt) (let* ((first-char last-input-char) ;; Wait for the second key and look up the combination. (second-char (if (or prompt (not (eq (key-binding "a") 'self-insert-command)) ;; Called from anything but the command loop. this-command) (progn (message "%s%c" (or prompt "Compose with ") first-char) (read-event)) (insert first-char) (prog1 (read-event) (delete-region (1- (point)) (point))))) (entry (assoc (list first-char second-char) iso-accents-list))) (if entry ;; Found it: delete the first character and insert the combination. (concat (list (nth 1 entry))) ;; Otherwise, advance and schedule the second key for execution. (setq unread-command-events (list second-char)) (vector first-char)))) (defvar iso-accents-enable nil "*List of accent keys that become prefixes in ISO Accents mode. The default is (?' ?` ?^ ?\" ?~ ?/), which contains all the supported accent keys. For certain languages, you might want to remove some of those characters that are not actually used.") ;; It is a matter of taste if you want the minor mode indicated ;; in the mode line... ;; If so, uncomment the next four lines. ;; (or (assq 'iso-accents-mode minor-mode-map-alist) ;; (setq minor-mode-alist ;; (append minor-mode-alist ;; '((iso-accents-mode " ISO-Acc"))))) ;;;###autoload (defun iso-accents-mode (&optional arg) "Toggle ISO Accents mode, in which accents modify the following letter. This permits easy insertion of accented characters according to ISO-8859-1. When Iso-accents mode is enabled, accent character keys \(`, ', \", ^, / and ~) do not self-insert; instead, they modify the following letter key so that it inserts an ISO accented letter. The variable `iso-accents-enable' specifies the list of characters to enable as accents. If you don't need all of them, remove the ones you don't need from that list. Special combinations: ~c gives a c with cedilla, ~d gives an Icelandic eth (d with dash). ~t gives an Icelandic thorn. \"s gives German sharp s. /a gives a with ring. /e gives an a-e ligature. ~< and ~> give guillemets. ~! gives an inverted exclamation mark. ~? gives an inverted question mark. With an argument, a positive argument enables ISO Accents mode, and a negative argument disables it." (interactive "P") (if (if arg ;; Negative arg means switch it off. (<= (prefix-numeric-value arg) 0) ;; No arg means toggle. iso-accents-mode) (setq iso-accents-mode nil) ;; Enable electric accents. (setq iso-accents-mode t))) (defun iso-accents-customize (language) "Customize the ISO accents machinery for a particular language. It selects the customization based on the specifications in the `iso-languages' variable." (interactive (list (completing-read "Language: " iso-languages nil t))) (let ((table (assoc language iso-languages)) c) (if (not table) (error "Unknown language") (setq iso-language language) (setq iso-accents-enable (car (cdr table))) (setq iso-accents-list (car (cdr (cdr table)))) (if key-translation-map (substitute-key-definition 'iso-accents-accent-key nil key-translation-map) (setq key-translation-map (make-sparse-keymap))) (setq c iso-accents-enable) (while c (define-key key-translation-map (char-to-string (car c)) 'iso-accents-accent-key) (setq c (cdr c)))))) (defun iso-accentuate (start end) "Convert two-character sequences in region into accented characters. Noninteractively, this operates on text from START to END. This uses the same conversion that ISO Accents mode uses for type-in." (interactive "r") (save-excursion (save-restriction (narrow-to-region start end) (goto-char start) (forward-char 1) (let (entry) (while (< (point) end) (if (and (memq (preceding-char) iso-accents-enable) (<= ?A (following-char)) (<= (following-char) ?z) (setq entry (assoc (list (preceding-char) (following-char)) iso-accents-list))) (progn (forward-char -1) (delete-char 2) (insert (car (cdr entry))) (setq end (1- end))) (forward-char 1))))))) (defun iso-accent-rassoc-unit (value alist) (while (and alist (not (eq (car (cdr (car alist))) value))) (setq alist (cdr alist))) (if alist (car alist) nil)) (defun iso-unaccentuate (start end) "Convert accented characters in the region into two-character sequences. Noninteractively, this operates on text from START to END. This uses the opposite of the conversion done by ISO Accents mode for type-in." (interactive "r") (save-excursion (save-restriction (narrow-to-region start end) (goto-char start) (let (entry) (while (< (point) end) (if (and (> (following-char) 127) (setq entry (iso-accent-rassoc-unit (following-char) iso-accents-list))) (progn (delete-char 1) (insert (car (car entry)) (car (cdr (car entry)))) (setq end (1+ end))) (forward-char 1))))))) (defun iso-deaccentuate (start end) "Convert accented characters in the region into unaccented characters. Noninteractively, this operates on text from START to END." (interactive "r") (save-excursion (save-restriction (narrow-to-region start end) (goto-char start) (let (entry) (while (< (point) end) (if (and (> (following-char) 127) (setq entry (iso-accent-rassoc-unit (following-char) iso-accents-list))) (progn (delete-char 1) (insert (car (cdr (car entry))))) (forward-char 1))))))) (iso-accents-customize "default") ;;; iso-acc.el ends here emacs-19.30/lisp/iso-ascii.el100444 12120 1 15373 5401144240 14274 0ustar rmsdaemon;;; iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals. ;; Copyright (C) 1987 Free Software Foundation, Inc. ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n ;; 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: ;; Written by Howard Gayle. See display-table.el for details. ;; This code sets up to display ISO 8859/1 characters on plain ;; ASCII terminals. The display strings for the characters are ;; more-or-less based on TeX. ;;; Code: (require 'disp-table) (standard-display-ascii 160 "{_}") ; NBSP (no-break space) (standard-display-ascii 161 "{!}") ; inverted exclamation mark (standard-display-ascii 162 "{c}") ; cent sign (standard-display-ascii 163 "{GBP}") ; pound sign (standard-display-ascii 164 "{$}") ; general currency sign (standard-display-ascii 165 "{JPY}") ; yen sign (standard-display-ascii 166 "{|}") ; broken vertical line (standard-display-ascii 167 "{S}") ; section sign (standard-display-ascii 168 "{\"}") ; diaeresis (standard-display-ascii 169 "{C}") ; copyright sign (standard-display-ascii 170 "{_a}") ; ordinal indicator, feminine (standard-display-ascii 171 "{<<}") ; left angle quotation mark (standard-display-ascii 172 "{~}") ; not sign (standard-display-ascii 173 "{-}") ; soft hyphen (standard-display-ascii 174 "{R}") ; registered sign (standard-display-ascii 175 "{=}") ; macron (standard-display-ascii 176 "{o}") ; degree sign (standard-display-ascii 177 "{+-}") ; plus or minus sign (standard-display-ascii 178 "{2}") ; superscript two (standard-display-ascii 179 "{3}") ; superscript three (standard-display-ascii 180 "{'}") ; acute accent (standard-display-ascii 181 "{u}") ; micro sign (standard-display-ascii 182 "{P}") ; pilcrow (standard-display-ascii 183 "{.}") ; middle dot (standard-display-ascii 184 "{,}") ; cedilla (standard-display-ascii 185 "{1}") ; superscript one (standard-display-ascii 186 "{_o}") ; ordinal indicator, masculine (standard-display-ascii 187 "{>>}") ; right angle quotation mark (standard-display-ascii 188 "{1/4}") ; fraction one-quarter (standard-display-ascii 189 "{1/2}") ; fraction one-half (standard-display-ascii 190 "{3/4}") ; fraction three-quarters (standard-display-ascii 191 "{?}") ; inverted question mark (standard-display-ascii 192 "{`A}") ; A with grave accent (standard-display-ascii 193 "{'A}") ; A with acute accent (standard-display-ascii 194 "{^A}") ; A with circumflex accent (standard-display-ascii 195 "{~A}") ; A with tilde (standard-display-ascii 196 "{\"A}") ; A with diaeresis or umlaut mark (standard-display-ascii 197 "{AA}") ; A with ring (standard-display-ascii 198 "{AE}") ; AE diphthong (standard-display-ascii 199 "{,C}") ; C with cedilla (standard-display-ascii 200 "{`E}") ; E with grave accent (standard-display-ascii 201 "{'E}") ; E with acute accent (standard-display-ascii 202 "{^E}") ; E with circumflex accent (standard-display-ascii 203 "{\"E}") ; E with diaeresis or umlaut mark (standard-display-ascii 204 "{`I}") ; I with grave accent (standard-display-ascii 205 "{'I}") ; I with acute accent (standard-display-ascii 206 "{^I}") ; I with circumflex accent (standard-display-ascii 207 "{\"I}") ; I with diaeresis or umlaut mark (standard-display-ascii 208 "{-D}") ; D with stroke, Icelandic eth (standard-display-ascii 209 "{~N}") ; N with tilde (standard-display-ascii 210 "{`O}") ; O with grave accent (standard-display-ascii 211 "{'O}") ; O with acute accent (standard-display-ascii 212 "{^O}") ; O with circumflex accent (standard-display-ascii 213 "{~O}") ; O with tilde (standard-display-ascii 214 "{\"O}") ; O with diaeresis or umlaut mark (standard-display-ascii 215 "{x}") ; multiplication sign (standard-display-ascii 216 "{/O}") ; O with slash (standard-display-ascii 217 "{`U}") ; U with grave accent (standard-display-ascii 218 "{'U}") ; U with acute accent (standard-display-ascii 219 "{^U}") ; U with circumflex accent (standard-display-ascii 220 "{\"U}") ; U with diaeresis or umlaut mark (standard-display-ascii 221 "{'Y}") ; Y with acute accent (standard-display-ascii 222 "{TH}") ; capital thorn, Icelandic (standard-display-ascii 223 "{ss}") ; small sharp s, German (standard-display-ascii 224 "{`a}") ; a with grave accent (standard-display-ascii 225 "{'a}") ; a with acute accent (standard-display-ascii 226 "{^a}") ; a with circumflex accent (standard-display-ascii 227 "{~a}") ; a with tilde (standard-display-ascii 228 "{\"a}") ; a with diaeresis or umlaut mark (standard-display-ascii 229 "{aa}") ; a with ring (standard-display-ascii 230 "{ae}") ; ae diphthong (standard-display-ascii 231 "{,c}") ; c with cedilla (standard-display-ascii 232 "{`e}") ; e with grave accent (standard-display-ascii 233 "{'e}") ; e with acute accent (standard-display-ascii 234 "{^e}") ; e with circumflex accent (standard-display-ascii 235 "{\"e}") ; e with diaeresis or umlaut mark (standard-display-ascii 236 "{`i}") ; i with grave accent (standard-display-ascii 237 "{'i}") ; i with acute accent (standard-display-ascii 238 "{^i}") ; i with circumflex accent (standard-display-ascii 239 "{\"i}") ; i with diaeresis or umlaut mark (standard-display-ascii 240 "{-d}") ; d with stroke, Icelandic eth (standard-display-ascii 241 "{~n}") ; n with tilde (standard-display-ascii 242 "{`o}") ; o with grave accent (standard-display-ascii 243 "{'o}") ; o with acute accent (standard-display-ascii 244 "{^o}") ; o with circumflex accent (standard-display-ascii 245 "{~o}") ; o with tilde (standard-display-ascii 246 "{\"o}") ; o with diaeresis or umlaut mark (standard-display-ascii 247 "{/}") ; division sign (standard-display-ascii 248 "{/o}") ; o with slash (standard-display-ascii 249 "{`u}") ; u with grave accent (standard-display-ascii 250 "{'u}") ; u with acute accent (standard-display-ascii 251 "{^u}") ; u with circumflex accent (standard-display-ascii 252 "{\"u}") ; u with diaeresis or umlaut mark (standard-display-ascii 253 "{'y}") ; y with acute accent (standard-display-ascii 254 "{th}") ; small thorn, Icelandic (standard-display-ascii 255 "{\"y}") ; small y with diaeresis or umlaut mark (provide 'iso-ascii) ;;; iso-ascii.el ends here emacs-19.30/lisp/iso-cvt.el100444 12120 1 42142 6045203470 14000 0ustar rmsdaemon;;; iso-cvt.-el -- translate to ISO 8859-1 from/to net/TeX conventions ;; This file was formerly called gm-lingo.el. ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: Michael Gschwind ;; Keywords: tex, iso, latin, i18n ;; 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 lisp code serves two purposes, both of which involve ;; the translation of various conventions for representing European ;; character sets to ISO 8859-1. ; Net support: ; Various conventions exist in Newsgroups on how to represent national ; characters. The functions provided here translate these net conventions ; to ISO. ; ; Calling `iso-german' will turn the net convention for umlauts ("a etc.) ; into ISO latin1 umlaute for easy reading. ; 'iso-spanish' will turn net conventions for representing spanish ; to ISO latin1. (Note that accents are omitted in news posts most ; of the time, only enye is escaped.) ; TeX support ; This mode installs hooks which change TeX files to ISO Latin-1 for ; simplified editing. When the TeX file is saved, ISO latin1 characters are ; translated back to escape sequences. ; ; An alternative is a TeX style that handles 8 bit ISO files ; (available on ftp.vlsivie.tuwien.ac.at in /pub/8bit) ; - but these files are difficult to transmit ... so while the net is ; still @ 7 bit this may be useful ;; TO DO: ; The net support should install hooks (like TeX support does) ; which recognizes certains news groups and translates all articles from ; those groups. ; ; Cover more cases for translation (There is an infinite number of ways to ; represent accented characters in TeX) ;; SEE ALSO: ; If you are interested in questions related to using the ISO 8859-1 ; characters set (configuring emacs, Unix, etc. to use ISO), then you ; can get the ISO 8859-1 FAQ via anonymous ftp from ; ftp.vlsivie.tuwien.ac.at in /pub/bit/FAQ-ISO-8859-1 ;;; Code: (provide 'iso-cvt) (defvar iso-spanish-trans-tab '( ("~n" "ñ") ("\([a-zA-Z]\)#" "\\1ñ") ("~N" "Ñ") ("\\([-a-zA-Z\"`]\\)\"u" "\\1ü") ("\\([-a-zA-Z\"`]\\)\"U" "\\1Ü") ("\\([-a-zA-Z]\\)'o" "\\1ó") ("\\([-a-zA-Z]\\)'O" "\\Ó") ("\\([-a-zA-Z]\\)'e" "\\1é") ("\\([-a-zA-Z]\\)'E" "\\1É") ("\\([-a-zA-Z]\\)'a" "\\1á") ("\\([-a-zA-Z]\\)'A" "\\1A") ("\\([-a-zA-Z]\\)'i" "\\1í") ("\\([-a-zA-Z]\\)'I" "\\1Í") ) "Spanish translation table.") (defun iso-translate-conventions (trans-tab) "Use the translation table TRANS-TAB to translate the current buffer." (save-excursion (goto-char (point-min)) (let ((work-tab trans-tab) (buffer-read-only nil) (case-fold-search nil)) (while work-tab (save-excursion (let ((trans-this (car work-tab))) (while (re-search-forward (car trans-this) nil t) (replace-match (car (cdr trans-this)) t nil))) (setq work-tab (cdr work-tab))))))) (defun iso-spanish () "Translate net conventions for Spanish to ISO 8859-1." (interactive) (iso-translate-conventions iso-spanish-trans-tab)) (defvar iso-aggressive-german-trans-tab '( ("\"a" "ä") ("\"A" "Ä") ("\"o" "ö") ("\"O" "Ö") ("\"u" "ü") ("\"U" "Ü") ("\"s" "ß") ("\\\\3" "ß") ) "German translation table. This table uses an aggressive translation approach and may erroneously translate too much.") (defvar iso-conservative-german-trans-tab '( ("\\([-a-zA-Z\"`]\\)\"a" "\\1ä") ("\\([-a-zA-Z\"`]\\)\"A" "\\1Ä") ("\\([-a-zA-Z\"`]\\)\"o" "\\1ö") ("\\([-a-zA-Z\"`]\\)\"O" "\\1Ö") ("\\([-a-zA-Z\"`]\\)\"u" "\\1ü") ("\\([-a-zA-Z\"`]\\)\"U" "\\1Ü") ("\\([-a-zA-Z\"`]\\)\"s" "\\1ß") ("\\([-a-zA-Z\"`]\\)\\\\3" "\\1ß") ) "German translation table. This table uses a conservative translation approach and may translate too little.") (defvar iso-german-trans-tab iso-aggressive-german-trans-tab "Currently active translation table for German.") (defun iso-german () "Translate net conventions for German to ISO 8859-1." (interactive) (iso-translate-conventions iso-german-trans-tab)) (defvar iso-iso2tex-trans-tab '( ("ä" "{\\\\\"a}") ("à" "{\\\\`a}") ("á" "{\\\\'a}") ("ã" "{\\\\~a}") ("â" "{\\\\^a}") ("ë" "{\\\\\"e}") ("è" "{\\\\`e}") ("é" "{\\\\'e}") ("ê" "{\\\\^e}") ("ï" "{\\\\\"\\\\i}") ("ì" "{\\\\`\\\\i}") ("í" "{\\\\'\\\\i}") ("î" "{\\\\^\\\\i}") ("ö" "{\\\\\"o}") ("ò" "{\\\\`o}") ("ó" "{\\\\'o}") ("õ" "{\\\\~o}") ("ô" "{\\\\^o}") ("ü" "{\\\\\"u}") ("ù" "{\\\\`u}") ("ú" "{\\\\'u}") ("û" "{\\\\^u}") ("Ä" "{\\\\\"A}") ("À" "{\\\\`A}") ("Á" "{\\\\'A}") ("Ã" "{\\\\~A}") ("Â" "{\\\\^A}") ("Ë" "{\\\\\"E}") ("È" "{\\\\`E}") ("É" "{\\\\'E}") ("Ê" "{\\\\^E}") ("Ï" "{\\\\\"I}") ("Ì" "{\\\\`I}") ("Í" "{\\\\'I}") ("Î" "{\\\\^I}") ("Ö" "{\\\\\"O}") ("Ò" "{\\\\`O}") ("Ó" "{\\\\'O}") ("Õ" "{\\\\~O}") ("Ô" "{\\\\^O}") ("Ü" "{\\\\\"U}") ("Ù" "{\\\\`U}") ("Ú" "{\\\\'U}") ("Û" "{\\\\^U}") ("ñ" "{\\\\~n}") ("Ñ" "{\\\\~N}") ("ç" "{\\\\c c}") ("Ç" "{\\\\c C}") ("ß" "{\\\\ss}") ("\306" "{\\\\AE}") ("\346" "{\\\\ae}") ("\305" "{\\\\AA}") ("\345" "{\\\\aa}") ("\251" "{\\\\copyright}") ("£" "{\\\\pounds}") ("¶" "{\\\\P}") ("§" "{\\\\S}") ("¿" "{?`}") ("¡" "{!`}") ) "Translation table for translating ISO 8859-1 characters to TeX sequences.") (defun iso-iso2tex () "Translate ISO 8859-1 characters to TeX sequences." (interactive) (iso-translate-conventions iso-iso2tex-trans-tab)) (defvar iso-tex2iso-trans-tab '( ("{\\\\\"a}" "ä") ("{\\\\`a}" "à") ("{\\\\'a}" "á") ("{\\\\~a}" "ã") ("{\\\\^a}" "â") ("{\\\\\"e}" "ë") ("{\\\\`e}" "è") ("{\\\\'e}" "é") ("{\\\\^e}" "ê") ("{\\\\\"\\\\i}" "ï") ("{\\\\`\\\\i}" "ì") ("{\\\\'\\\\i}" "í") ("{\\\\^\\\\i}" "î") ("{\\\\\"i}" "ï") ("{\\\\`i}" "ì") ("{\\\\'i}" "í") ("{\\\\^i}" "î") ("{\\\\\"o}" "ö") ("{\\\\`o}" "ò") ("{\\\\'o}" "ó") ("{\\\\~o}" "õ") ("{\\\\^o}" "ô") ("{\\\\\"u}" "ü") ("{\\\\`u}" "ù") ("{\\\\'u}" "ú") ("{\\\\^u}" "û") ("{\\\\\"A}" "Ä") ("{\\\\`A}" "À") ("{\\\\'A}" "Á") ("{\\\\~A}" "Ã") ("{\\\\^A}" "Â") ("{\\\\\"E}" "Ë") ("{\\\\`E}" "È") ("{\\\\'E}" "É") ("{\\\\^E}" "Ê") ("{\\\\\"I}" "Ï") ("{\\\\`I}" "Ì") ("{\\\\'I}" "Í") ("{\\\\^I}" "Î") ("{\\\\\"O}" "Ö") ("{\\\\`O}" "Ò") ("{\\\\'O}" "Ó") ("{\\\\~O}" "Õ") ("{\\\\^O}" "Ô") ("{\\\\\"U}" "Ü") ("{\\\\`U}" "Ù") ("{\\\\'U}" "Ú") ("{\\\\^U}" "Û") ("{\\\\~n}" "ñ") ("{\\\\~N}" "Ñ") ("{\\\\c c}" "ç") ("{\\\\c C}" "Ç") ("\\\\\"a" "ä") ("\\\\`a" "à") ("\\\\'a" "á") ("\\\\~a" "ã") ("\\\\^a" "â") ("\\\\\"e" "ë") ("\\\\`e" "è") ("\\\\'e" "é") ("\\\\^e" "ê") ("\\\\\"\\\\i" "ï") ("\\\\`\\\\i" "ì") ("\\\\'\\\\i" "í") ("\\\\^\\\\i" "î") ("\\\\\"i" "ï") ("\\\\`i" "ì") ("\\\\'i" "í") ("\\\\^i" "î") ("\\\\\"o" "ö") ("\\\\`o" "ò") ("\\\\'o" "ó") ("\\\\~o" "õ") ("\\\\^o" "ô") ("\\\\\"u" "ü") ("\\\\`u" "ù") ("\\\\'u" "ú") ("\\\\^u" "û") ("\\\\\"A" "Ä") ("\\\\`A" "À") ("\\\\'A" "Á") ("\\\\~A" "Ã") ("\\\\^A" "Â") ("\\\\\"E" "Ë") ("\\\\`E" "È") ("\\\\'E" "É") ("\\\\^E" "Ê") ("\\\\\"I" "Ï") ("\\\\`I" "Ì") ("\\\\'I" "Í") ("\\\\^I" "Î") ("\\\\\"O" "Ö") ("\\\\`O" "Ò") ("\\\\'O" "Ó") ("\\\\~O" "Õ") ("\\\\^O" "Ô") ("\\\\\"U" "Ü") ("\\\\`U" "Ù") ("\\\\'U" "Ú") ("\\\\^U" "Û") ("\\\\~n" "ñ") ("\\\\~N" "Ñ") ("\\\\\"{a}" "ä") ("\\\\`{a}" "à") ("\\\\'{a}" "á") ("\\\\~{a}" "ã") ("\\\\^{a}" "â") ("\\\\\"{e}" "ë") ("\\\\`{e}" "è") ("\\\\'{e}" "é") ("\\\\^{e}" "ê") ("\\\\\"{\\\\i}" "ï") ("\\\\`{\\\\i}" "ì") ("\\\\'{\\\\i}" "í") ("\\\\^{\\\\i}" "î") ("\\\\\"{i}" "ï") ("\\\\`{i}" "ì") ("\\\\'{i}" "í") ("\\\\^{i}" "î") ("\\\\\"{o}" "ö") ("\\\\`{o}" "ò") ("\\\\'{o}" "ó") ("\\\\~{o}" "õ") ("\\\\^{o}" "ô") ("\\\\\"{u}" "ü") ("\\\\`{u}" "ù") ("\\\\'{u}" "ú") ("\\\\^{u}" "û") ("\\\\\"{A}" "Ä") ("\\\\`{A}" "À") ("\\\\'{A}" "Á") ("\\\\~{A}" "Ã") ("\\\\^{A}" "Â") ("\\\\\"{E}" "Ë") ("\\\\`{E}" "È") ("\\\\'{E}" "É") ("\\\\^{E}" "Ê") ("\\\\\"{I}" "Ï") ("\\\\`{I}" "Ì") ("\\\\'{I}" "Í") ("\\\\^{I}" "Î") ("\\\\\"{O}" "Ö") ("\\\\`{O}" "Ò") ("\\\\'{O}" "Ó") ("\\\\~{O}" "Õ") ("\\\\^{O}" "Ô") ("\\\\\"{U}" "Ü") ("\\\\`{U}" "Ù") ("\\\\'{U}" "Ú") ("\\\\^{U}" "Û") ("\\\\~{n}" "ñ") ("\\\\~{N}" "Ñ") ("\\\\c{c}" "ç") ("\\\\c{C}" "Ç") ("{\\\\ss}" "ß") ("{\\\\AE}" "\306") ("{\\\\ae}" "\346") ("{\\\\AA}" "\305") ("{\\\\aa}" "\345") ("{\\\\copyright}" "\251") ("\\\\copyright{}" "\251") ("{\\\\pounds}" "£" ) ("{\\\\P}" "¶" ) ("{\\\\S}" "§" ) ("\\\\pounds{}" "£" ) ("\\\\P{}" "¶" ) ("\\\\S{}" "§" ) ("{\\?`}" "¿") ("{!`}" "¡") ("\\?`" "¿") ("!`" "¡") ) "Translation table for translating TeX sequences to ISO 8859-1 characters. This table is not exhaustive (and due to TeX's power can never be). It only contains commonly used sequences.") (defun iso-tex2iso () "Translate TeX sequences to ISO 8859-1 characters." (interactive) (iso-translate-conventions iso-tex2iso-trans-tab)) (defvar iso-gtex2iso-trans-tab '( ("{\\\\\"a}" "ä") ("{\\\\`a}" "à") ("{\\\\'a}" "á") ("{\\\\~a}" "ã") ("{\\\\^a}" "â") ("{\\\\\"e}" "ë") ("{\\\\`e}" "è") ("{\\\\'e}" "é") ("{\\\\^e}" "ê") ("{\\\\\"\\\\i}" "ï") ("{\\\\`\\\\i}" "ì") ("{\\\\'\\\\i}" "í") ("{\\\\^\\\\i}" "î") ("{\\\\\"i}" "ï") ("{\\\\`i}" "ì") ("{\\\\'i}" "í") ("{\\\\^i}" "î") ("{\\\\\"o}" "ö") ("{\\\\`o}" "ò") ("{\\\\'o}" "ó") ("{\\\\~o}" "õ") ("{\\\\^o}" "ô") ("{\\\\\"u}" "ü") ("{\\\\`u}" "ù") ("{\\\\'u}" "ú") ("{\\\\^u}" "û") ("{\\\\\"A}" "Ä") ("{\\\\`A}" "À") ("{\\\\'A}" "Á") ("{\\\\~A}" "Ã") ("{\\\\^A}" "Â") ("{\\\\\"E}" "Ë") ("{\\\\`E}" "È") ("{\\\\'E}" "É") ("{\\\\^E}" "Ê") ("{\\\\\"I}" "Ï") ("{\\\\`I}" "Ì") ("{\\\\'I}" "Í") ("{\\\\^I}" "Î") ("{\\\\\"O}" "Ö") ("{\\\\`O}" "Ò") ("{\\\\'O}" "Ó") ("{\\\\~O}" "Õ") ("{\\\\^O}" "Ô") ("{\\\\\"U}" "Ü") ("{\\\\`U}" "Ù") ("{\\\\'U}" "Ú") ("{\\\\^U}" "Û") ("{\\\\~n}" "ñ") ("{\\\\~N}" "Ñ") ("{\\\\c c}" "ç") ("{\\\\c C}" "Ç") ("\\\\\"a" "ä") ("\\\\`a" "à") ("\\\\'a" "á") ("\\\\~a" "ã") ("\\\\^a" "â") ("\\\\\"e" "ë") ("\\\\`e" "è") ("\\\\'e" "é") ("\\\\^e" "ê") ("\\\\\"\\\\i" "ï") ("\\\\`\\\\i" "ì") ("\\\\'\\\\i" "í") ("\\\\^\\\\i" "î") ("\\\\\"i" "ï") ("\\\\`i" "ì") ("\\\\'i" "í") ("\\\\^i" "î") ("\\\\\"o" "ö") ("\\\\`o" "ò") ("\\\\'o" "ó") ("\\\\~o" "õ") ("\\\\^o" "ô") ("\\\\\"u" "ü") ("\\\\`u" "ù") ("\\\\'u" "ú") ("\\\\^u" "û") ("\\\\\"A" "Ä") ("\\\\`A" "À") ("\\\\'A" "Á") ("\\\\~A" "Ã") ("\\\\^A" "Â") ("\\\\\"E" "Ë") ("\\\\`E" "È") ("\\\\'E" "É") ("\\\\^E" "Ê") ("\\\\\"I" "Ï") ("\\\\`I" "Ì") ("\\\\'I" "Í") ("\\\\^I" "Î") ("\\\\\"O" "Ö") ("\\\\`O" "Ò") ("\\\\'O" "Ó") ("\\\\~O" "Õ") ("\\\\^O" "Ô") ("\\\\\"U" "Ü") ("\\\\`U" "Ù") ("\\\\'U" "Ú") ("\\\\^U" "Û") ("\\\\~n" "ñ") ("\\\\~N" "Ñ") ("\\\\\"{a}" "ä") ("\\\\`{a}" "à") ("\\\\'{a}" "á") ("\\\\~{a}" "ã") ("\\\\^{a}" "â") ("\\\\\"{e}" "ë") ("\\\\`{e}" "è") ("\\\\'{e}" "é") ("\\\\^{e}" "ê") ("\\\\\"{\\\\i}" "ï") ("\\\\`{\\\\i}" "ì") ("\\\\'{\\\\i}" "í") ("\\\\^{\\\\i}" "î") ("\\\\\"{i}" "ï") ("\\\\`{i}" "ì") ("\\\\'{i}" "í") ("\\\\^{i}" "î") ("\\\\\"{o}" "ö") ("\\\\`{o}" "ò") ("\\\\'{o}" "ó") ("\\\\~{o}" "õ") ("\\\\^{o}" "ô") ("\\\\\"{u}" "ü") ("\\\\`{u}" "ù") ("\\\\'{u}" "ú") ("\\\\^{u}" "û") ("\\\\\"{A}" "Ä") ("\\\\`{A}" "À") ("\\\\'{A}" "Á") ("\\\\~{A}" "Ã") ("\\\\^{A}" "Â") ("\\\\\"{E}" "Ë") ("\\\\`{E}" "È") ("\\\\'{E}" "É") ("\\\\^{E}" "Ê") ("\\\\\"{I}" "Ï") ("\\\\`{I}" "Ì") ("\\\\'{I}" "Í") ("\\\\^{I}" "Î") ("\\\\\"{O}" "Ö") ("\\\\`{O}" "Ò") ("\\\\'{O}" "Ó") ("\\\\~{O}" "Õ") ("\\\\^{O}" "Ô") ("\\\\\"{U}" "Ü") ("\\\\`{U}" "Ù") ("\\\\'{U}" "Ú") ("\\\\^{U}" "Û") ("\\\\~{n}" "ñ") ("\\\\~{N}" "Ñ") ("\\\\c{c}" "ç") ("\\\\c{C}" "Ç") ("{\\\\ss}" "ß") ("{\\\\AE}" "\306") ("{\\\\ae}" "\346") ("{\\\\AA}" "\305") ("{\\\\aa}" "\345") ("{\\\\copyright}" "\251") ("\\\\copyright{}" "\251") ("{\\\\pounds}" "£" ) ("{\\\\P}" "¶" ) ("{\\\\S}" "§" ) ("\\\\pounds{}" "£" ) ("\\\\P{}" "¶" ) ("\\\\S{}" "§" ) ("?`" "¿") ("!`" "¡") ("{?`}" "¿") ("{!`}" "¡") ("\"a" "ä") ("\"A" "Ä") ("\"o" "ö") ("\"O" "Ö") ("\"u" "ü") ("\"U" "Ü") ("\"s" "ß") ("\\\\3" "ß") ) "Translation table for translating German TeX sequences to ISO 8859-1. This table is not exhaustive (and due to TeX's power can never be). It only contains commonly used sequences.") (defvar iso-iso2gtex-trans-tab '( ("ä" "\"a") ("à" "{\\\\`a}") ("á" "{\\\\'a}") ("ã" "{\\\\~a}") ("â" "{\\\\^a}") ("ë" "{\\\\\"e}") ("è" "{\\\\`e}") ("é" "{\\\\'e}") ("ê" "{\\\\^e}") ("ï" "{\\\\\"\\\\i}") ("ì" "{\\\\`\\\\i}") ("í" "{\\\\'\\\\i}") ("î" "{\\\\^\\\\i}") ("ö" "\"o") ("ò" "{\\\\`o}") ("ó" "{\\\\'o}") ("õ" "{\\\\~o}") ("ô" "{\\\\^o}") ("ü" "\"u") ("ù" "{\\\\`u}") ("ú" "{\\\\'u}") ("û" "{\\\\^u}") ("Ä" "\"A") ("À" "{\\\\`A}") ("Á" "{\\\\'A}") ("Ã" "{\\\\~A}") ("Â" "{\\\\^A}") ("Ë" "{\\\\\"E}") ("È" "{\\\\`E}") ("É" "{\\\\'E}") ("Ê" "{\\\\^E}") ("Ï" "{\\\\\"I}") ("Ì" "{\\\\`I}") ("Í" "{\\\\'I}") ("Î" "{\\\\^I}") ("Ö" "\"O") ("Ò" "{\\\\`O}") ("Ó" "{\\\\'O}") ("Õ" "{\\\\~O}") ("Ô" "{\\\\^O}") ("Ü" "\"U") ("Ù" "{\\\\`U}") ("Ú" "{\\\\'U}") ("Û" "{\\\\^U}") ("ñ" "{\\\\~n}") ("Ñ" "{\\\\~N}") ("ç" "{\\\\c c}") ("Ç" "{\\\\c C}") ("ß" "\"s") ("\306" "{\\\\AE}") ("\346" "{\\\\ae}") ("\305" "{\\\\AA}") ("\345" "{\\\\aa}") ("\251" "{\\\\copyright}") ("£" "{\\\\pounds}") ("¶" "{\\\\P}") ("§" "{\\\\S}") ("¿" "{?`}") ("¡" "{!`}") ) "Translation table for translating ISO 8859-1 characters to German TeX.") (defun iso-gtex2iso () "Translate German TeX sequences to ISO 8859-1 characters." (interactive) (iso-translate-conventions iso-gtex2iso-trans-tab)) (defun iso-iso2gtex () "Translate ISO 8859-1 characters to German TeX sequences." (interactive) (iso-translate-conventions iso-iso2gtex-trans-tab)) (defun iso-german-tex-p () "Check if tex buffer is German LaTeX." (save-excursion (save-restriction (widen) (goto-char (point-min)) (re-search-forward "\\\\documentstyle\\[.*german.*\\]" nil t)))) (defun iso-fix-iso2tex () "Turn ISO 8859-1 (aka. ISO Latin-1) buffer into TeX sequences. If German TeX is used, German TeX sequences are generated." (if (or (equal major-mode 'latex-mode) (equal major-mode 'LaTeX-mode)) ; AucTeX wants this (if (iso-german-tex-p) (iso-iso2gtex) (iso-iso2tex))) (if (or (equal major-mode 'tex-mode) (equal major-mode 'TeX-mode) ; AucTeX wants this (equal major-mode 'plain-tex-mode)) (iso-iso2tex))) (defun iso-fix-tex2iso () "Turn TeX sequences into ISO 8859-1 (aka. ISO Latin-1) characters. This function recognices German TeX buffers." (if (or (equal major-mode 'latex-mode) (equal major-mode 'Latex-mode)) ; AucTeX wants this (if (iso-german-tex-p) (iso-gtex2iso) (iso-tex2iso))) (if (or (equal major-mode 'tex-mode) (equal major-mode 'TeX-mode) ; AucTeX wants this (equal major-mode 'plain-tex-mode)) (iso-tex2iso))) (defun iso-cvt-ffh () "find-file-hook for iso-cvt.el." (iso-fix-tex2iso) (set-buffer-modified-p nil)) (defun iso-cvt-wfh () "write file hook for iso-cvt.el." (iso-fix-iso2tex)) (defun iso-cvt-ash () "after save hook for iso-cvt.el." (iso-fix-tex2iso) (set-buffer-modified-p nil)) (add-hook 'find-file-hooks 'iso-cvt-ffh) (add-hook 'write-file-hooks 'iso-cvt-wfh) (add-hook 'after-save-hook 'iso-cvt-ash) ;;; iso-cvt.el ends here emacs-19.30/lisp/iso-insert.el100444 75424 13 32466 5561560625 14472 0ustar kwzhuser;;; iso-insert.el --- insert functions for ISO 8859/1. ;; Copyright (C) 1987, 1994 Free Software Foundation, Inc. ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n ;; 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: ;; Written by Howard Gayle. See case-table.el for details. ;;; Code: (defun insert-no-break-space () (interactive "*") (insert 160) ) (defun insert-inverted-exclamation-mark () (interactive "*") (insert 161) ) (defun insert-cent-sign () (interactive "*") (insert 162) ) (defun insert-pound-sign () (interactive "*") (insert 163) ) (defun insert-general-currency-sign () (interactive "*") (insert 164) ) (defun insert-yen-sign () (interactive "*") (insert 165) ) (defun insert-broken-vertical-line () (interactive "*") (insert 166) ) (defun insert-section-sign () (interactive "*") (insert 167) ) (defun insert-diaeresis () (interactive "*") (insert 168) ) (defun insert-copyright-sign () (interactive "*") (insert 169) ) (defun insert-ordinal-indicator-feminine () (interactive "*") (insert 170) ) (defun insert-angle-quotation-mark-left () (interactive "*") (insert 171) ) (defun insert-not-sign () (interactive "*") (insert 172) ) (defun insert-soft-hyphen () (interactive "*") (insert 173) ) (defun insert-registered-sign () (interactive "*") (insert 174) ) (defun insert-macron () (interactive "*") (insert 175) ) (defun insert-degree-sign () (interactive "*") (insert 176) ) (defun insert-plus-or-minus-sign () (interactive "*") (insert 177) ) (defun insert-superscript-two () (interactive "*") (insert 178) ) (defun insert-superscript-three () (interactive "*") (insert 179) ) (defun insert-acute-accent () (interactive "*") (insert 180) ) (defun insert-micro-sign () (interactive "*") (insert 181) ) (defun insert-pilcrow () (interactive "*") (insert 182) ) (defun insert-middle-dot () (interactive "*") (insert 183) ) (defun insert-cedilla () (interactive "*") (insert 184) ) (defun insert-superscript-one () (interactive "*") (insert 185) ) (defun insert-ordinal-indicator-masculine () (interactive "*") (insert 186) ) (defun insert-angle-quotation-mark-right () (interactive "*") (insert 187) ) (defun insert-fraction-one-quarter () (interactive "*") (insert 188) ) (defun insert-fraction-one-half () (interactive "*") (insert 189) ) (defun insert-fraction-three-quarters () (interactive "*") (insert 190) ) (defun insert-inverted-question-mark () (interactive "*") (insert 191) ) (defun insert-A-grave () (interactive "*") (insert 192) ) (defun insert-A-acute () (interactive "*") (insert 193) ) (defun insert-A-circumflex () (interactive "*") (insert 194) ) (defun insert-A-tilde () (interactive "*") (insert 195) ) (defun insert-A-umlaut () (interactive "*") (insert 196) ) (defun insert-A-ring () (interactive "*") (insert 197) ) (defun insert-AE () (interactive "*") (insert 198) ) (defun insert-C-cedilla () (interactive "*") (insert 199) ) (defun insert-E-grave () (interactive "*") (insert 200) ) (defun insert-E-acute () (interactive "*") (insert 201) ) (defun insert-E-circumflex () (interactive "*") (insert 202) ) (defun insert-E-umlaut () (interactive "*") (insert 203) ) (defun insert-I-grave () (interactive "*") (insert 204) ) (defun insert-I-acute () (interactive "*") (insert 205) ) (defun insert-I-circumflex () (interactive "*") (insert 206) ) (defun insert-I-umlaut () (interactive "*") (insert 207) ) (defun insert-D-stroke () (interactive "*") (insert 208) ) (defun insert-N-tilde () (interactive "*") (insert 209) ) (defun insert-O-grave () (interactive "*") (insert 210) ) (defun insert-O-acute () (interactive "*") (insert 211) ) (defun insert-O-circumflex () (interactive "*") (insert 212) ) (defun insert-O-tilde () (interactive "*") (insert 213) ) (defun insert-O-umlaut () (interactive "*") (insert 214) ) (defun insert-multiplication-sign () (interactive "*") (insert 215) ) (defun insert-O-slash () (interactive "*") (insert 216) ) (defun insert-U-grave () (interactive "*") (insert 217) ) (defun insert-U-acute () (interactive "*") (insert 218) ) (defun insert-U-circumflex () (interactive "*") (insert 219) ) (defun insert-U-umlaut () (interactive "*") (insert 220) ) (defun insert-Y-acute () (interactive "*") (insert 221) ) (defun insert-THORN () (interactive "*") (insert 222) ) (defun insert-ss () (interactive "*") (insert 223) ) (defun insert-a-grave () (interactive "*") (insert 224) ) (defun insert-a-acute () (interactive "*") (insert 225) ) (defun insert-a-circumflex () (interactive "*") (insert 226) ) (defun insert-a-tilde () (interactive "*") (insert 227) ) (defun insert-a-umlaut () (interactive "*") (insert 228) ) (defun insert-a-ring () (interactive "*") (insert 229) ) (defun insert-ae () (interactive "*") (insert 230) ) (defun insert-c-cedilla () (interactive "*") (insert 231) ) (defun insert-e-grave () (interactive "*") (insert 232) ) (defun insert-e-acute () (interactive "*") (insert 233) ) (defun insert-e-circumflex () (interactive "*") (insert 234) ) (defun insert-e-umlaut () (interactive "*") (insert 235) ) (defun insert-i-grave () (interactive "*") (insert 236) ) (defun insert-i-acute () (interactive "*") (insert 237) ) (defun insert-i-circumflex () (interactive "*") (insert 238) ) (defun insert-i-umlaut () (interactive "*") (insert 239) ) (defun insert-d-stroke () (interactive "*") (insert 240) ) (defun insert-n-tilde () (interactive "*") (insert 241) ) (defun insert-o-grave () (interactive "*") (insert 242) ) (defun insert-o-acute () (interactive "*") (insert 243) ) (defun insert-o-circumflex () (interactive "*") (insert 244) ) (defun insert-o-tilde () (interactive "*") (insert 245) ) (defun insert-o-umlaut () (interactive "*") (insert 246) ) (defun insert-division-sign () (interactive "*") (insert 247) ) (defun insert-o-slash () (interactive "*") (insert 248) ) (defun insert-u-grave () (interactive "*") (insert 249) ) (defun insert-u-acute () (interactive "*") (insert 250) ) (defun insert-u-circumflex () (interactive "*") (insert 251) ) (defun insert-u-umlaut () (interactive "*") (insert 252) ) (defun insert-y-acute () (interactive "*") (insert 253) ) (defun insert-thorn () (interactive "*") (insert 254) ) (defun insert-y-umlaut () (interactive "*") (insert 255) ) (defvar 8859-1-map nil "Keymap for ISO 8859/1 character insertion.") (if 8859-1-map nil (setq 8859-1-map (make-keymap)) (define-key 8859-1-map " " 'insert-no-break-space) (define-key 8859-1-map "!" 'insert-inverted-exclamation-mark) (define-key 8859-1-map "\"" (make-sparse-keymap)) (define-key 8859-1-map "\"\"" 'insert-diaeresis) (define-key 8859-1-map "\"A" 'insert-A-umlaut) (define-key 8859-1-map "\"E" 'insert-E-umlaut) (define-key 8859-1-map "\"I" 'insert-I-umlaut) (define-key 8859-1-map "\"O" 'insert-O-umlaut) (define-key 8859-1-map "\"U" 'insert-U-umlaut) (define-key 8859-1-map "\"a" 'insert-a-umlaut) (define-key 8859-1-map "\"e" 'insert-e-umlaut) (define-key 8859-1-map "\"i" 'insert-i-umlaut) (define-key 8859-1-map "\"o" 'insert-o-umlaut) (define-key 8859-1-map "\"u" 'insert-u-umlaut) (define-key 8859-1-map "\"y" 'insert-y-umlaut) (define-key 8859-1-map "'" (make-sparse-keymap)) (define-key 8859-1-map "''" 'insert-acute-accent) (define-key 8859-1-map "'A" 'insert-A-acute) (define-key 8859-1-map "'E" 'insert-E-acute) (define-key 8859-1-map "'I" 'insert-I-acute) (define-key 8859-1-map "'O" 'insert-O-acute) (define-key 8859-1-map "'U" 'insert-U-acute) (define-key 8859-1-map "'Y" 'insert-Y-acute) (define-key 8859-1-map "'a" 'insert-a-acute) (define-key 8859-1-map "'e" 'insert-e-acute) (define-key 8859-1-map "'i" 'insert-i-acute) (define-key 8859-1-map "'o" 'insert-o-acute) (define-key 8859-1-map "'u" 'insert-u-acute) (define-key 8859-1-map "'y" 'insert-y-acute) (define-key 8859-1-map "$" 'insert-general-currency-sign) (define-key 8859-1-map "+" 'insert-plus-or-minus-sign) (define-key 8859-1-map "," (make-sparse-keymap)) (define-key 8859-1-map ",," 'insert-cedilla) (define-key 8859-1-map ",C" 'insert-C-cedilla) (define-key 8859-1-map ",c" 'insert-c-cedilla) (define-key 8859-1-map "-" 'insert-soft-hyphen) (define-key 8859-1-map "." 'insert-middle-dot) (define-key 8859-1-map "/" (make-sparse-keymap)) (define-key 8859-1-map "//" 'insert-division-sign) (define-key 8859-1-map "/O" 'insert-O-slash) (define-key 8859-1-map "/o" 'insert-o-slash) (define-key 8859-1-map "1" (make-sparse-keymap)) (define-key 8859-1-map "1/" (make-sparse-keymap)) (define-key 8859-1-map "1/2" 'insert-fraction-one-half) (define-key 8859-1-map "1/4" 'insert-fraction-one-quarter) (define-key 8859-1-map "3" (make-sparse-keymap)) (define-key 8859-1-map "3/" (make-sparse-keymap)) (define-key 8859-1-map "3/4" 'insert-fraction-three-quarters) (define-key 8859-1-map "<" 'insert-angle-quotation-mark-left) (define-key 8859-1-map "=" 'insert-macron) (define-key 8859-1-map ">" 'insert-angle-quotation-mark-right) (define-key 8859-1-map "?" 'insert-inverted-question-mark) (define-key 8859-1-map "A" 'insert-A-ring) (define-key 8859-1-map "E" 'insert-AE) (define-key 8859-1-map "C" 'insert-copyright-sign) (define-key 8859-1-map "D" 'insert-D-stroke) (define-key 8859-1-map "L" 'insert-pound-sign) (define-key 8859-1-map "P" 'insert-pilcrow) (define-key 8859-1-map "R" 'insert-registered-sign) (define-key 8859-1-map "S" 'insert-section-sign) (define-key 8859-1-map "T" 'insert-THORN) (define-key 8859-1-map "Y" 'insert-yen-sign) (define-key 8859-1-map "^" (make-sparse-keymap)) (define-key 8859-1-map "^1" 'insert-superscript-one) (define-key 8859-1-map "^2" 'insert-superscript-two) (define-key 8859-1-map "^3" 'insert-superscript-three) (define-key 8859-1-map "^A" 'insert-A-circumflex) (define-key 8859-1-map "^E" 'insert-E-circumflex) (define-key 8859-1-map "^I" 'insert-I-circumflex) (define-key 8859-1-map "^O" 'insert-O-circumflex) (define-key 8859-1-map "^U" 'insert-U-circumflex) (define-key 8859-1-map "^a" 'insert-a-circumflex) (define-key 8859-1-map "^e" 'insert-e-circumflex) (define-key 8859-1-map "^i" 'insert-i-circumflex) (define-key 8859-1-map "^o" 'insert-o-circumflex) (define-key 8859-1-map "^u" 'insert-u-circumflex) (define-key 8859-1-map "_" (make-sparse-keymap)) (define-key 8859-1-map "_a" 'insert-ordinal-indicator-feminine) (define-key 8859-1-map "_o" 'insert-ordinal-indicator-masculine) (define-key 8859-1-map "`" (make-sparse-keymap)) (define-key 8859-1-map "`A" 'insert-A-grave) (define-key 8859-1-map "`E" 'insert-E-grave) (define-key 8859-1-map "`I" 'insert-I-grave) (define-key 8859-1-map "`O" 'insert-O-grave) (define-key 8859-1-map "`U" 'insert-U-grave) (define-key 8859-1-map "`a" 'insert-a-grave) (define-key 8859-1-map "`e" 'insert-e-grave) (define-key 8859-1-map "`i" 'insert-i-grave) (define-key 8859-1-map "`o" 'insert-o-grave) (define-key 8859-1-map "`u" 'insert-u-grave) (define-key 8859-1-map "a" 'insert-a-ring) (define-key 8859-1-map "e" 'insert-ae) (define-key 8859-1-map "c" 'insert-cent-sign) (define-key 8859-1-map "d" 'insert-d-stroke) (define-key 8859-1-map "o" 'insert-degree-sign) (define-key 8859-1-map "s" 'insert-ss) (define-key 8859-1-map "t" 'insert-thorn) (define-key 8859-1-map "u" 'insert-micro-sign) (define-key 8859-1-map "x" 'insert-multiplication-sign) (define-key 8859-1-map "|" 'insert-broken-vertical-line) (define-key 8859-1-map "~" (make-sparse-keymap)) (define-key 8859-1-map "~A" 'insert-A-tilde) (define-key 8859-1-map "~N" 'insert-N-tilde) (define-key 8859-1-map "~O" 'insert-O-tilde) (define-key 8859-1-map "~a" 'insert-a-tilde) (define-key 8859-1-map "~n" 'insert-n-tilde) (define-key 8859-1-map "~o" 'insert-o-tilde) (define-key 8859-1-map "~~" 'insert-not-sign) (if (not (lookup-key global-map "\C-x8")) (define-key global-map "\C-x8" 8859-1-map)) ) (provide 'iso-insert) ;;; iso-insert.el ends here emacs-19.30/lisp/iso-swed.el100444 12120 1 16371 5401144260 14147 0ustar rmsdaemon;;; iso-swed.el --- set up char tables for ISO 8859/1 for Swedish/Finnish ttys ;; Copyright (C) 1987 Free Software Foundation, Inc. ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n ;; 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: ;; Written by Howard Gayle. See case-table.el for details. ;;; Code: ;; This code sets up to display ISO 8859/1 characters on ;; terminals that have ASCII in the G0 set and a Swedish/Finnish ;; version of ISO 646 in the G1 set. The G1 set differs from ;; ASCII as follows: ;; ;; ASCII G1 ;; $ general currency sign ;; @ capital E with acute accent ;; [ capital A with diaeresis or umlaut mark ;; \ capital O with diaeresis or umlaut mark ;; ] capital A with ring ;; ^ capital U with diaeresis or umlaut mark ;; ` small e with acute accent ;; { small a with diaeresis or umlaut mark ;; | small o with diaeresis or umlaut mark ;; } small a with ring ;; ~ small u with diaeresis or umlaut mark (require 'disp-table) (standard-display-ascii 160 "{_}") ; NBSP (no-break space) (standard-display-ascii 161 "{!}") ; inverted exclamation mark (standard-display-ascii 162 "{c}") ; cent sign (standard-display-ascii 163 "{GBP}") ; pound sign (standard-display-g1 164 ?$) ; general currency sign (standard-display-ascii 165 "{JPY}") ; yen sign (standard-display-ascii 166 "{|}") ; broken vertical line (standard-display-ascii 167 "{S}") ; section sign (standard-display-ascii 168 "{\"}") ; diaeresis (standard-display-ascii 169 "{C}") ; copyright sign (standard-display-ascii 170 "{_a}") ; ordinal indicator, feminine (standard-display-ascii 171 "{<<}") ; left angle quotation mark (standard-display-ascii 172 "{~}") ; not sign (standard-display-ascii 173 "{-}") ; soft hyphen (standard-display-ascii 174 "{R}") ; registered sign (standard-display-ascii 175 "{=}") ; macron (standard-display-ascii 176 "{o}") ; degree sign (standard-display-ascii 177 "{+-}") ; plus or minus sign (standard-display-ascii 178 "{2}") ; superscript two (standard-display-ascii 179 "{3}") ; superscript three (standard-display-ascii 180 "{'}") ; acute accent (standard-display-ascii 181 "{u}") ; micro sign (standard-display-ascii 182 "{P}") ; pilcrow (standard-display-ascii 183 "{.}") ; middle dot (standard-display-ascii 184 "{,}") ; cedilla (standard-display-ascii 185 "{1}") ; superscript one (standard-display-ascii 186 "{_o}") ; ordinal indicator, masculine (standard-display-ascii 187 "{>>}") ; right angle quotation mark (standard-display-ascii 188 "{1/4}") ; fraction one-quarter (standard-display-ascii 189 "{1/2}") ; fraction one-half (standard-display-ascii 190 "{3/4}") ; fraction three-quarters (standard-display-ascii 191 "{?}") ; inverted question mark (standard-display-ascii 192 "{`A}") ; A with grave accent (standard-display-ascii 193 "{'A}") ; A with acute accent (standard-display-ascii 194 "{^A}") ; A with circumflex accent (standard-display-ascii 195 "{~A}") ; A with tilde (standard-display-g1 196 ?[) ; A with diaeresis or umlaut mark (standard-display-g1 197 ?]) ; A with ring (standard-display-ascii 198 "{AE}") ; AE diphthong (standard-display-ascii 199 "{,C}") ; C with cedilla (standard-display-ascii 200 "{`E}") ; E with grave accent (standard-display-g1 201 ?@) ; E with acute accent (standard-display-ascii 202 "{^E}") ; E with circumflex accent (standard-display-ascii 203 "{\"E}") ; E with diaeresis or umlaut mark (standard-display-ascii 204 "{`I}") ; I with grave accent (standard-display-ascii 205 "{'I}") ; I with acute accent (standard-display-ascii 206 "{^I}") ; I with circumflex accent (standard-display-ascii 207 "{\"I}") ; I with diaeresis or umlaut mark (standard-display-ascii 208 "{-D}") ; D with stroke, Icelandic eth (standard-display-ascii 209 "{~N}") ; N with tilde (standard-display-ascii 210 "{`O}") ; O with grave accent (standard-display-ascii 211 "{'O}") ; O with acute accent (standard-display-ascii 212 "{^O}") ; O with circumflex accent (standard-display-ascii 213 "{~O}") ; O with tilde (standard-display-g1 214 ?\\) ; O with diaeresis or umlaut mark (standard-display-ascii 215 "{x}") ; multiplication sign (standard-display-ascii 216 "{/O}") ; O with slash (standard-display-ascii 217 "{`U}") ; U with grave accent (standard-display-ascii 218 "{'U}") ; U with acute accent (standard-display-ascii 219 "{^U}") ; U with circumflex accent (standard-display-g1 220 ?^) ; U with diaeresis or umlaut mark (standard-display-ascii 221 "{'Y}") ; Y with acute accent (standard-display-ascii 222 "{TH}") ; capital thorn, Icelandic (standard-display-ascii 223 "{ss}") ; small sharp s, German (standard-display-ascii 224 "{`a}") ; a with grave accent (standard-display-ascii 225 "{'a}") ; a with acute accent (standard-display-ascii 226 "{^a}") ; a with circumflex accent (standard-display-ascii 227 "{~a}") ; a with tilde (standard-display-g1 228 ?{) ; a with diaeresis or umlaut mark (standard-display-g1 229 ?}) ; a with ring (standard-display-ascii 230 "{ae}") ; ae diphthong (standard-display-ascii 231 "{,c}") ; c with cedilla (standard-display-ascii 232 "{`e}") ; e with grave accent (standard-display-g1 233 ?`) ; e with acute accent (standard-display-ascii 234 "{^e}") ; e with circumflex accent (standard-display-ascii 235 "{\"e}") ; e with diaeresis or umlaut mark (standard-display-ascii 236 "{`i}") ; i with grave accent (standard-display-ascii 237 "{'i}") ; i with acute accent (standard-display-ascii 238 "{^i}") ; i with circumflex accent (standard-display-ascii 239 "{\"i}") ; i with diaeresis or umlaut mark (standard-display-ascii 240 "{-d}") ; d with stroke, Icelandic eth (standard-display-ascii 241 "{~n}") ; n with tilde (standard-display-ascii 242 "{`o}") ; o with grave accent (standard-display-ascii 243 "{'o}") ; o with acute accent (standard-display-ascii 244 "{^o}") ; o with circumflex accent (standard-display-ascii 245 "{~o}") ; o with tilde (standard-display-g1 246 ?|) ; o with diaeresis or umlaut mark (standard-display-ascii 247 "{/}") ; division sign (standard-display-ascii 248 "{/o}") ; o with slash (standard-display-ascii 249 "{`u}") ; u with grave accent (standard-display-ascii 250 "{'u}") ; u with acute accent (standard-display-ascii 251 "{^u}") ; u with circumflex accent (standard-display-g1 252 ?~) ; u with diaeresis or umlaut mark (standard-display-ascii 253 "{'y}") ; y with acute accent (standard-display-ascii 254 "{th}") ; small thorn, Icelandic (standard-display-ascii 255 "{\"y}") ; small y with diaeresis or umlaut mark (provide 'iso-swed) ;;; iso-swed.el ends here emacs-19.30/lisp/iso-syntax.el100444 12120 1 11762 6042472157 14545 0ustar rmsdaemon;;; iso-syntax.el --- set up case-conversion and syntax tables for ISO 8859/1 ;; Copyright (C) 1988 Free Software Foundation, Inc. ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n ;; 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: ;; Written by Howard Gayle. See case-table.el for details. ;;; Code: (require 'case-table) (let ((downcase (standard-case-table))) (set-case-syntax 160 " " downcase) ; NBSP (no-break space) (set-case-syntax 161 "." downcase) ; inverted exclamation mark (set-case-syntax 162 "w" downcase) ; cent sign (set-case-syntax 163 "w" downcase) ; pound sign (set-case-syntax 164 "w" downcase) ; general currency sign (set-case-syntax 165 "w" downcase) ; yen sign (set-case-syntax 166 "_" downcase) ; broken vertical line (set-case-syntax 167 "w" downcase) ; section sign (set-case-syntax 168 "w" downcase) ; diaeresis (set-case-syntax 169 "_" downcase) ; copyright sign (set-case-syntax 170 "w" downcase) ; ordinal indicator, feminine (set-case-syntax-delims 171 187 downcase) ; angle quotation marks (set-case-syntax 172 "_" downcase) ; not sign (set-case-syntax 173 "_" downcase) ; soft hyphen (set-case-syntax 174 "_" downcase) ; registered sign (set-case-syntax 175 "w" downcase) ; macron (set-case-syntax 176 "_" downcase) ; degree sign (set-case-syntax 177 "_" downcase) ; plus or minus sign (set-case-syntax 178 "w" downcase) ; superscript two (set-case-syntax 179 "w" downcase) ; superscript three (set-case-syntax 180 "w" downcase) ; acute accent (set-case-syntax 181 "_" downcase) ; micro sign (set-case-syntax 182 "w" downcase) ; pilcrow (set-case-syntax 183 "_" downcase) ; middle dot (set-case-syntax 184 "w" downcase) ; cedilla (set-case-syntax 185 "w" downcase) ; superscript one (set-case-syntax 186 "w" downcase) ; ordinal indicator, masculine ;; 187 ; See 171 above. (set-case-syntax 188 "_" downcase) ; fraction one-quarter (set-case-syntax 189 "_" downcase) ; fraction one-half (set-case-syntax 190 "_" downcase) ; fraction three-quarters (set-case-syntax 191 "." downcase) ; inverted question mark (set-case-syntax-pair 192 224 downcase) ; A with grave accent (set-case-syntax-pair 193 225 downcase) ; A with acute accent (set-case-syntax-pair 194 226 downcase) ; A with circumflex accent (set-case-syntax-pair 195 227 downcase) ; A with tilde (set-case-syntax-pair 196 228 downcase) ; A with diaeresis or umlaut mark (set-case-syntax-pair 197 229 downcase) ; A with ring (set-case-syntax-pair 198 230 downcase) ; AE diphthong (set-case-syntax-pair 199 231 downcase) ; C with cedilla (set-case-syntax-pair 200 232 downcase) ; E with grave accent (set-case-syntax-pair 201 233 downcase) ; E with acute accent (set-case-syntax-pair 202 234 downcase) ; E with circumflex accent (set-case-syntax-pair 203 235 downcase) ; E with diaeresis or umlaut mark (set-case-syntax-pair 204 236 downcase) ; I with grave accent (set-case-syntax-pair 205 237 downcase) ; I with acute accent (set-case-syntax-pair 206 238 downcase) ; I with circumflex accent (set-case-syntax-pair 207 239 downcase) ; I with diaeresis or umlaut mark (set-case-syntax-pair 208 240 downcase) ; D with stroke, Icelandic eth (set-case-syntax-pair 209 241 downcase) ; N with tilde (set-case-syntax-pair 210 242 downcase) ; O with grave accent (set-case-syntax-pair 211 243 downcase) ; O with acute accent (set-case-syntax-pair 212 244 downcase) ; O with circumflex accent (set-case-syntax-pair 213 245 downcase) ; O with tilde (set-case-syntax-pair 214 246 downcase) ; O with diaeresis or umlaut mark (set-case-syntax 215 "_" downcase) ; multiplication sign (set-case-syntax-pair 216 248 downcase) ; O with slash (set-case-syntax-pair 217 249 downcase) ; U with grave accent (set-case-syntax-pair 218 250 downcase) ; U with acute accent (set-case-syntax-pair 219 251 downcase) ; U with circumflex accent (set-case-syntax-pair 220 252 downcase) ; U with diaeresis or umlaut mark (set-case-syntax-pair 221 253 downcase) ; Y with acute accent (set-case-syntax-pair 222 254 downcase) ; thorn, Icelandic (set-case-syntax 223 "w" downcase) ; small sharp s, German (set-case-syntax 247 "_" downcase) ; division sign (set-case-syntax 255 "w" downcase) ; small y with diaeresis or umlaut mark ) (provide 'iso-syntax) ;;; iso-syntax.el ends here emacs-19.30/lisp/iso-transl.el100444 12120 1 17460 6035244376 14525 0ustar rmsdaemon;;; iso-transl.el --- keyboard input definitions for ISO 8859/1. ;; Copyright (C) 1987, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n ;; 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: ;; Loading this package defines three ways of entering the non-ASCII ;; printable characters with codes above 127: the prefix C-x 8, or the ;; Alt key, or a dead accent key. For example, you can enter uppercase ;; A-umlaut as `C-x 8 " A' or `Alt-" A' (if you have an Alt key) or ;; `umlaut A' (if you have an umlaut/diaeresis key). ;;; Code: (defvar iso-transl-dead-key-alist '((?\' . mute-acute) (?\` . mute-grave) (?\" . mute-diaeresis) (?\^ . mute-asciicircum) (?\~ . mute-asciitilde)) "Mapping of ASCII characters to their corresponding dead-key symbols.") ;; Some X servers use these alternate names. (or key-translation-map (setq key-translation-map (make-sparse-keymap))) (define-key key-translation-map [dead-acute] [mute-acute]) (define-key key-translation-map [dead-grave] [mute-grave]) (define-key key-translation-map [dead-diaeresis] [mute-diaeresis]) (define-key key-translation-map [dead-asciicircum] [mute-asciicircum]) (define-key key-translation-map [dead-asciitilde] [mute-asciitilde]) ;; Someone reports that these keys don't work if shifted. ;; This might fix it--no word yet. (define-key key-translation-map [S-dead-acute] [mute-acute]) (define-key key-translation-map [S-dead-grave] [mute-grave]) (define-key key-translation-map [S-dead-diaeresis] [mute-diaeresis]) (define-key key-translation-map [S-dead-asciicircum] [mute-asciicircum]) (define-key key-translation-map [S-dead-asciitilde] [mute-asciitilde]) ;; The two-character mnemonics are intended to be available in all languages. ;; The ones beginning with `*' have one-character synonyms, but a ;; language-specific table might override the short form for its own use. (defvar iso-transl-char-map '(("* " . [160])(" " . [160]) ("*!" . [161])("!" . [161]) ("\"\"" . [168]) ("\"A" . [196]) ("\"E" . [203]) ("\"I" . [207]) ("\"O" . [214]) ("\"U" . [220]) ("\"a" . [228]) ("\"e" . [235]) ("\"i" . [239]) ("\"o" . [246]) ("\"s" . [223]) ("\"u" . [252]) ("\"y" . [255]) ("''" . [180]) ("'A" . [193]) ("'E" . [201]) ("'I" . [205]) ("'O" . [211]) ("'U" . [218]) ("'Y" . [221]) ("'a" . [225]) ("'e" . [233]) ("'i" . [237]) ("'o" . [243]) ("'u" . [250]) ("'y" . [253]) ("*$" . [164])("$" . [164]) ("*+" . [177])("+" . [177]) (",," . [184]) (",C" . [199]) (",c" . [231]) ("*-" . [173])("-" . [173]) ("*." . [183])("." . [183]) ("//" . [247]) ("/A" . [197]) ("/E" . [198]) ("/O" . [216]) ("/a" . [229]) ("/e" . [230]) ("/o" . [248]) ("1/2" . [189]) ("1/4" . [188]) ("3/4" . [190]) ("*<" . [171])("<" . [171]) ("*=" . [175])("=" . [175]) ("*>" . [187])(">" . [187]) ("*?" . [191])("?" . [191]) ("*C" . [169])("C" . [169]) ("*L" . [163])("L" . [163]) ("*P" . [182])("P" . [182]) ("*R" . [174])("R" . [174]) ("*S" . [167])("S" . [167]) ("*Y" . [165])("Y" . [165]) ("^1" . [185]) ("^2" . [178]) ("^3" . [179]) ("^A" . [194]) ("^E" . [202]) ("^I" . [206]) ("^O" . [212]) ("^U" . [219]) ("^a" . [226]) ("^e" . [234]) ("^i" . [238]) ("^o" . [244]) ("^u" . [251]) ("_a" . [170]) ("_o" . [186]) ("`A" . [192]) ("`E" . [200]) ("`I" . [204]) ("`O" . [210]) ("`U" . [217]) ("`a" . [224]) ("`e" . [232]) ("`i" . [236]) ("`o" . [242]) ("`u" . [249]) ("*c" . [162])("c" . [162]) ("*o" . [176])("o" . [176]) ("*u" . [181])("u" . [181]) ("*m" . [181])("m" . [181]) ("*x" . [215])("x" . [215]) ("*|" . [166])("|" . [166]) ("~A" . [195]) ("~D" . [208]) ("~N" . [209]) ("~O" . [213]) ("~T" . [222]) ("~a" . [227]) ("~d" . [240]) ("~n" . [241]) ("~o" . [245]) ("~t" . [254]) ("~~" . [172])) "Alist of character translations for entering ISO characters. Each element has the form (STRING . VECTOR). The sequence STRING of ASCII chars translates into the sequence VECTOR. (VECTOR is normally one character long.)") ;; Language-specific translation lists. (defvar iso-transl-language-alist '(("Esperanto" ("C" . [198]) ("G" . [216]) ("H" . [166]) ("J" . [172]) ("S" . [222]) ("U" . [221]) ("c" . [230]) ("g" . [248]) ("h" . [182]) ("j" . [188]) ("s" . [254]) ("u" . [253])) ("French" ("C" . [199]) ("c" . [231])) ("German" ("A" . [196]) ("O" . [214]) ("U" . [220]) ("a" . [228]) ("o" . [246]) ("s" . [223]) ("u" . [252])) ("Portuguese" ("C" . [199]) ("c" . [231])) ("Spanish" ("!" . [161]) ("?" . [191]) ("N" . [241]) ("n" . [209])))) (defvar iso-transl-ctl-x-8-map nil "Keymap for C-x 8 prefix.") (or iso-transl-ctl-x-8-map (setq iso-transl-ctl-x-8-map (make-sparse-keymap))) (or key-translation-map (setq key-translation-map (make-sparse-keymap))) (define-key key-translation-map "\C-x8" iso-transl-ctl-x-8-map) ;; For each entry in the alist, we'll make up to three ways to generate ;; the character in question: the prefix `C-x 8'; the ALT modifier on ;; the first key of the sequence; and (if applicable) replacing the first ;; key of the sequence with the corresponding dead key. For example, a ;; character associated with the string "~n" can be input with `C-x 8 ~ n' ;; or `Alt-~ n' or `mute-asciitilde n'. (defun iso-transl-define-keys (alist) (while alist (define-key iso-transl-ctl-x-8-map (car (car alist)) (cdr (car alist))) (let ((vec (vconcat (car (car alist)))) (deadpair (assq (aref (car (car alist)) 0) iso-transl-dead-key-alist))) (aset vec 0 (logior (aref vec 0) ?\A-\^@)) (define-key key-translation-map vec (cdr (car alist))) (define-key isearch-mode-map (vector (aref vec 0)) nil) (if deadpair (let ((deadvec (copy-sequence vec))) (aset deadvec 0 (cdr deadpair)) (define-key isearch-mode-map (vector (aref deadvec 0)) nil) (define-key key-translation-map deadvec (cdr (car alist)))))) (setq alist (cdr alist)))) (defun iso-transl-set-language (lang) (interactive (list (let ((completion-ignore-case t)) (completing-read "Set which language? " iso-transl-language-alist nil t)))) (iso-transl-define-keys (cdr (assoc lang iso-transl-language-alist)))) ;; The standard mapping comes automatically. You can partially overlay it ;; with a language-specific mapping by using `M-x iso-transl-set-language'. (iso-transl-define-keys iso-transl-char-map) (define-key isearch-mode-map "\C-x" nil) (define-key isearch-mode-map [?\C-x t] 'isearch-other-control-char) (define-key isearch-mode-map "\C-x8" nil) (provide 'iso-transl) ;;; iso-transl.el ends here emacs-19.30/lisp/iso02-acc.el100444 22556 1 6114 6045245622 14227 0ustar erikdaemon;;; iso02-acc.el --- electric accent keys for Eastern Europe (ISO latin2) ;; Copyright (C) 1995 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. ;;; Code: (defvar iso-accents-list '(((?' ?A) ?\301) ((?' ?C) ?\306) ((?' ?D) ?\320) ((?' ?E) ?\311) ((?' ?I) ?\315) ((?' ?L) ?\305) ((?' ?N) ?\321) ((?' ?O) ?\323) ((?' ?R) ?\300) ((?' ?S) ?\246) ((?' ?U) ?\332) ((?' ?Y) ?\335) ((?' ?Z) ?\254) ((?' ?a) ?\341) ((?' ?c) ?\346) ((?' ?d) ?\360) ((?' ?e) ?\351) ((?' ?i) ?\355) ((?' ?l) ?\345) ((?' ?n) ?\361) ((?' ?o) ?\363) ((?' ?r) ?\340) ((?' ?s) ?\266) ((?' ?u) ?\372) ((?' ?y) ?\375) ((?' ?z) ?\274) ((?' ?') ?\264) ((?' ? ) ?') ((?` ?A) ?\241) ((?` ?C) ?\307) ((?` ?E) ?\312) ((?` ?L) ?\243) ((?` ?S) ?\252) ((?` ?T) ?\336) ((?` ?Z) ?\257) ((?` ?a) ?\261) ((?` ?l) ?\263) ((?` ?c) ?\347) ((?` ?e) ?\352) ((?` ?s) ?\272) ((?` ?t) ?\376) ((?` ?z) ?\277) ((?` ? ) ?`) ((?` ?`) ?\252) ((?` ?.) ?\377) ((?^ ?A) ?\302) ((?^ ?O) ?\324) ((?^ ?a) ?\342) ((?^ ?o) ?\364) ((?^ ? ) ?^) ((?^ ?^) ?^) ; no special code? ((?\" ?A) ?\304) ((?\" ?E) ?\313) ((?\" ?O) ?\326) ((?\" ?U) ?\334) ((?\" ?a) ?\344) ((?\" ?e) ?\353) ((?\" ?o) ?\366) ((?\" ?s) ?\337) ((?\" ?u) ?\374) ((?\" ? ) ?\") ((?\" ?\") ?\250) ((?\~ ?A) ?\303) ((?\~ ?C) ?\310) ((?\~ ?D) ?\317) ((?\~ ?L) ?\245) ((?\~ ?N) ?\322) ((?\~ ?O) ?\325) ((?\~ ?R) ?\330) ((?\~ ?S) ?\251) ((?\~ ?T) ?\253) ((?\~ ?U) ?\333) ((?\~ ?Z) ?\256) ((?\~ ?a) ?\323) ((?\~ ?c) ?\350) ((?\~ ?d) ?\357) ((?\~ ?l) ?\265) ((?\~ ?n) ?\362) ((?\~ ?o) ?\365) ((?\~ ?r) ?\370) ((?\~ ?s) ?\271) ((?\~ ?t) ?\273) ((?\~ ?u) ?\373) ((?\~ ?z) ?\276) ((?\~ ?\ ) ?\~) ((?\~ ?v) ?\242) ;; v accent ((?\~ ?\~) ?\242) ;; v accent ((?\~ ?\.) ?\270) ;; cedilla accent ) "Association list for ISO latin-2 accent combinations.") (defvar iso-accents-enable '(?' ?` ?^ ?\" ?~) "*List of accent keys that become prefixes in ISO Accents mode. The default is (?' ?` ?^ ?\" ?~), which contains all the supported accent keys. For certain languages, you might want to remove some of those characters that are not actually used.") (require 'iso-acc) ;;; iso02-acc.el ends here emacs-19.30/lisp/iso02-syn.el100444 22556 1 10713 6044346072 14332 0ustar erikdaemon;;; iso02-syn.el --- set up case-conversion and syntax tables for ISO 8859-2 ;;; (ISO latin2, i.e. East Block character set) ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Michael Gschwind (mike@vlsivie.tuwien.ac.at) ;; Keywords: i18n ;; 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: ;; Written by Michael Gschwind. See case-table.el for details. ;;; Code: (require 'case-table) (let ((downcase (standard-case-table))) (set-case-syntax 160 " " downcase) ; NBSP (no-break space) (set-case-syntax-pair 161 177 downcase) ; A with hook (set-case-syntax 162 "w" downcase) ; u accent (set-case-syntax-pair 163 179 downcase) ; L with slash (set-case-syntax 164 "w" downcase) ; general currency sign (set-case-syntax-pair 165 181 downcase) ; L with v (set-case-syntax-pair 166 182 downcase) ; S with acute accent (set-case-syntax 167 "w" downcase) ; section sign (set-case-syntax 168 "w" downcase) ; diaeresis (set-case-syntax-pair 169 185 downcase) ; S with v (set-case-syntax-pair 170 186 downcase) ; S with cedilla (set-case-syntax-pair 171 187 downcase) ; T with v (set-case-syntax-pair 172 188 downcase) ; Z with acute accent (set-case-syntax 173 "_" downcase) ; soft hyphen (set-case-syntax-pair 174 190 downcase) ; Z with v (set-case-syntax-pair 175 191 downcase) ; Z with dot (set-case-syntax 176 "_" downcase) ; degree sign (set-case-syntax 178 "w" downcase) ; hook accent (set-case-syntax 180 "w" downcase) ; acute accent (set-case-syntax 183 "_" downcase) ; v accent (set-case-syntax 184 "w" downcase) ; cedilla (set-case-syntax 189 "w" downcase) ; Hungarian '' accent (set-case-syntax-pair 192 224 downcase) ; R with acute accent (set-case-syntax-pair 193 225 downcase) ; A with acute accent (set-case-syntax-pair 194 226 downcase) ; A with circumflex accent (set-case-syntax-pair 195 227 downcase) ; A with u accent (set-case-syntax-pair 196 228 downcase) ; A with diaeresis or umlaut mark (set-case-syntax-pair 197 229 downcase) ; L with acute accent (set-case-syntax-pair 198 230 downcase) ; C with acute accent (set-case-syntax-pair 199 231 downcase) ; C with cedilla (set-case-syntax-pair 200 232 downcase) ; C with v accent (set-case-syntax-pair 201 233 downcase) ; E with acute accent (set-case-syntax-pair 202 234 downcase) ; E with hook (set-case-syntax-pair 203 235 downcase) ; E with diaeresis (set-case-syntax-pair 204 236 downcase) ; E with v accent (set-case-syntax-pair 205 237 downcase) ; I with acute accent (set-case-syntax-pair 206 238 downcase) ; I with circumflex accent (set-case-syntax-pair 207 239 downcase) ; D with v accent (set-case-syntax-pair 208 240 downcase) ; D with stroke (set-case-syntax-pair 209 241 downcase) ; N with acute accent (set-case-syntax-pair 210 242 downcase) ; N with v accent (set-case-syntax-pair 211 243 downcase) ; O with acute accent (set-case-syntax-pair 212 244 downcase) ; O with circumflex accent (set-case-syntax-pair 213 245 downcase) ; O with Hungarian accent (set-case-syntax-pair 214 246 downcase) ; O with diaeresis or umlaut mark (set-case-syntax 215 "_" downcase) ; multiplication sign (set-case-syntax-pair 216 248 downcase) ; R with v accent (set-case-syntax-pair 217 249 downcase) ; U with ring (set-case-syntax-pair 218 250 downcase) ; U with acute accent (set-case-syntax-pair 219 251 downcase) ; U with Hungaraian accent (set-case-syntax-pair 220 252 downcase) ; U with diaeresis or umlaut mark (set-case-syntax-pair 221 253 downcase) ; Y with acute accent (set-case-syntax-pair 222 254 downcase) ; T with hook (set-case-syntax 223 "w" downcase) ; small sharp s, German (set-case-syntax 247 "_" downcase) ; division sign (set-case-syntax 255 "w" downcase) ; dot accent ) (provide 'iso02-syn) ;;; iso-syntax.el ends here emacs-19.30/lisp/ispell.el100444 12120 1 270352 6045204004 13724 0ustar rmsdaemon;;; ispell.el --- spell checking using Ispell ;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;;; Authors : Ken Stevens ;;; Note: version numbers and time stamp are not updated ;;; when this file is edited for release with GNU Emacs. ;;; Last Modified On: Tue Jun 13 12:05:28 EDT 1995 ;;; Update Revision : 2.37 ;;; Syntax : emacs-lisp ;;; Status : Release with 3.1.12+ ispell. ;;; Version : International Ispell Version 3.1 by Geoff Kuenning. ;;; Bug Reports : ispell-el-bugs@itcorp.com ;;; Note: version numbers and time stamp are not updated ;;; when this file is edited for release with GNU Emacs. ;;; 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: ;;; ;;; INSTRUCTIONS ;;; ;;; This code contains a section of user-settable variables that you should ;;; inspect prior to installation. Look past the end of the history list. ;;; Set them up for your locale and the preferences of the majority of the ;;; users. Otherwise the users may need to set a number of variables ;;; themselves. ;;; You particularly may want to change the default dictionary for your ;;; country and language. ;;; ;;; ;;; To fully install this, add this file to your Emacs Lisp directory and ;;; compile it with M-X byte-compile-file. Then add the following to the ;;; appropriate init file: ;;; ;;; (autoload 'ispell-word "ispell" ;;; "Check the spelling of word in buffer." t) ;;; (global-set-key "\e$" 'ispell-word) ;;; (autoload 'ispell-region "ispell" ;;; "Check the spelling of region." t) ;;; (autoload 'ispell-buffer "ispell" ;;; "Check the spelling of buffer." t) ;;; (autoload 'ispell-complete-word "ispell" ;;; "Look up current word in dictionary and try to complete it." t) ;;; (autoload 'ispell-change-dictionary "ispell" ;;; "Change ispell dictionary." t) ;;; (autoload 'ispell-message "ispell" ;;; "Check spelling of mail message or news post.") ;;; ;;; Depending on the mail system you use, you may want to include these: ;;; ;;; (add-hook 'news-inews-hook 'ispell-message) ;;; (add-hook 'mail-send-hook 'ispell-message) ;;; (add-hook 'mh-before-send-letter-hook 'ispell-message) ;;; ;;; ;;; Ispell has a TeX parser and a nroff parser (the default). ;;; The parsing is controlled by the variable ispell-parser. Currently ;;; it is just a "toggle" between TeX and nroff, but if more parsers are ;;; added it will be updated. See the variable description for more info. ;;; ;;; ;;; TABLE OF CONTENTS ;;; ;;; ispell-word ;;; ispell-region ;;; ispell-buffer ;;; ispell-message ;;; ispell-continue ;;; ispell-complete-word ;;; ispell-complete-word-interior-frag ;;; ispell-change-dictionary ;;; ispell-kill-ispell ;;; ispell-pdict-save ;;; ;;; ;;; Commands in ispell-region: ;;; Character replacement: Replace word with choice. May query-replace. ;;; ' ': Accept word this time. ;;; 'i': Accept word and insert into private dictionary. ;;; 'a': Accept word for this session. ;;; 'A': Accept word and place in buffer-local dictionary. ;;; 'r': Replace word with typed-in value. Rechecked. ;;; 'R': Replace word with typed-in value. Query-replaced in buffer. Rechecked. ;;; '?': Show these commands ;;; 'x': Exit spelling buffer. Move cursor to original point. ;;; 'X': Exit spelling buffer. Leave cursor at the current point. ;;; 'q': Quit spelling session (Kills ispell process). ;;; 'l': Look up typed-in replacement in alternate dictionary. Wildcards okay. ;;; 'u': Like 'i', but the word is lower-cased first. ;;; 'm': Like 'i', but allows one to include dictionary completion info. ;;; 'C-l': redraws screen ;;; 'C-r': recursive edit ;;; 'C-z': suspend emacs or iconify frame ;;; ;;; Buffer-Local features: ;;; There are a number of buffer-local features that can be used to customize ;;; ispell for the current buffer. This includes language dictionaries, ;;; personal dictionaries, parsing, and local word spellings. Each of these ;;; local customizations are done either through local variables, or by ;;; including the keyword and argument(s) at the end of the buffer (usually ;;; prefixed by the comment characters). See the end of this file for ;;; examples. The local keywords and variables are: ;;; ;;; ispell-dictionary-keyword language-dictionary ;;; uses local variable ispell-local-dictionary ;;; ispell-pdict-keyword personal-dictionary ;;; uses local variable ispell-local-pdict ;;; ispell-parsing-keyword mode-arg extended-char-arg ;;; ispell-words-keyword any number of local word spellings ;;; ;;; ;;; BUGS: ;;; Highlighting in version 19 still doesn't work on tty's. ;;; On some versions of emacs, growing the minibuffer fails. ;;; ;;; HISTORY ;;; ;;; Revision 2.37 1995/6/13 12:05:28 stevens ;;; Removed autoload from ispell-dictionary-alist. *choices* mode-line shows ;;; misspelled word. Block skip for pgp & forwarded messages added. ;;; RMS: the autoload changes had problems and I removed them. ;;; ;;; Revision 2.36 1995/2/6 17:39:38 stevens ;;; Properly adjust screen with different ispell-choices-win-default-height ;;; settings. Skips SGML entity references. ;;; ;;; Revision 2.35 1995/1/13 14:16:46 stevens ;;; Skips SGML tags, ispell-change-dictionary fix for add-hook, assure personal ;;; dictionary is saved when called from the menu ;;; ;;; Revision 2.34 1994/12/08 13:17:41 stevens ;;; Interaction corrected to function with all 3.1 ispell versions. ;;; ;;; Revision 2.33 1994/11/24 02:31:20 stevens ;;; Repaired bug introduced in 2.32 that corrupts buffers when correcting. ;;; Improved buffer scrolling. Nondestructive buffer selections allowed. ;;; ;;; Revision 2.32 1994/10/31 21:10:08 geoff ;;; Many revisions accepted from RMS/FSF. I think (though I don't know) that ;;; this represents an 'official' version. ;;; ;;; Revision 2.31 1994/5/31 10:18:17 stevens ;;; Repaired comments. buffer-local commands executed in `ispell-word' now. ;;; German dictionary described for extended character mode. Dict messages. ;;; ;;; Revision 2.30 1994/5/20 22:18:36 stevens ;;; Continue ispell from ispell-word, C-z functionality fixed. ;;; ;;; Revision 2.29 1994/5/12 09:44:33 stevens ;;; Restored ispell-use-ptys-p, ispell-message aborts sends with interrupt. ;;; defined fn ispell ;;; ;;; Revision 2.28 1994/4/28 16:24:40 stevens ;;; Window checking when ispell-message put on gnus-inews-article-hook jwz. ;;; prefixed ispell- to highlight functions and horiz-scroll fn. ;;; Try and respect case of word in ispell-complete-word. ;;; Ignore non-char events. Ispell-use-ptys-p commented out. Lucid menu. ;;; Better interrupt handling. ispell-message improvements from Ethan. ;;; ;;; Revision 2.27 ;;; version 18 explicit C-g handling disabled as it didn't work. Added ;;; ispell-extra-args for ispell customization (jwz) ;;; ;;; Revision 2.26 1994/2/15 16:11:14 stevens ;;; name changes for copyright assignment. Added word-frags in complete-word. ;;; Horizontal scroll (John Conover). Query-replace matches words now. bugs. ;;; ;;; Revision 2.25 ;;; minor mods, upgraded ispell-message ;;; ;;; Revision 2.24 ;;; query-replace more robust, messages, defaults, ispell-change-dict. ;;; ;;; Revision 2.23 1993/11/22 23:47:03 stevens ;;; ispell-message, Fixed highlighting, added menu-bar, fixed ispell-help, ... ;;; ;;; Revision 2.22 ;;; Added 'u' command. Fixed default in ispell-local-dictionary. ;;; fixed affix rules display. Tib skipping more robust. Contributions by ;;; Per Abraham (parser selection), Denis Howe, and Eberhard Mattes. ;;; ;;; Revision 2.21 1993/06/30 14:09:04 stevens ;;; minor bugs. (nroff word skipping fixed) ;;; ;;; Revision 2.20 1993/06/30 14:09:04 stevens ;;; ;;; Debugging and contributions by: Boris Aronov, Rik Faith, Chris Moore, ;;; Kevin Rodgers, Malcolm Davis. ;;; Particular thanks to Michael Lipp, Jamie Zawinski, Phil Queinnec ;;; and John Heidemann for suggestions and code. ;;; Major update including many tweaks. ;;; Many changes were integrations of suggestions. ;;; lookup-words rehacked to use call-process (Jamie). ;;; ispell-complete-word rehacked to be compatible with the rest of the ;;; system for word searching and to include multiple wildcards, ;;; and it's own dictionary. ;;; query-replace capability added. New options 'X', 'R', and 'A'. ;;; buffer-local modes for dictionary, word-spelling, and formatter-parsing. ;;; Many random bugs, like commented comments being skipped, fix to ;;; keep-choices-win, fix for math mode, added pipe mode choice, ;;; fixed 'q' command, ispell-word checks previous word and leave cursor ;;; in same location. Fixed tib code which could drop spelling regions. ;;; Cleaned up setq calls for efficiency. Gave more context on window overlays. ;;; Assure context on ispell-command-loop. Window lossage in look cmd fixed. ;;; Due to pervasive opinion, common-lisp package syntax removed. Display ;;; problem when not highlighting. ;;; ;;; Revision 2.19 1992/01/10 10:54:08 geoff ;;; Make another attempt at fixing the "Bogus, dude" problem. This one is ;;; less elegant, but has the advantage of working. ;;; ;;; Revision 2.18 1992/01/07 10:04:52 geoff ;;; Fix the "Bogus, Dude" problem in ispell-word. ;;; ;;; Revision 2.17 1991/09/12 00:01:42 geoff ;;; Add some changes to make ispell-complete-word work better, though ;;; still not perfectly. ;;; ;;; Revision 2.16 91/09/04 18:00:52 geoff ;;; More updates from Sebastian, to make the multiple-dictionary support ;;; more flexible. ;;; ;;; Revision 2.15 91/09/04 17:30:02 geoff ;;; Sebastian Kremer's tib support ;;; ;;; Revision 2.14 91/09/04 16:19:37 geoff ;;; Don't do set-window-start if the move-to-window-line moved us ;;; downward, rather than upward. This prevents getting the buffer all ;;; confused. Also, don't use the "not-modified" function to clear the ;;; modification flag; instead use set-buffer-modified-p. This prevents ;;; extra messages from flashing. ;;; ;;; Revision 2.13 91/09/04 14:35:41 geoff ;;; Fix a spelling error in a comment. Add code to handshake with the ;;; ispell process before sending anything to it. ;;; ;;; Revision 2.12 91/09/03 20:14:21 geoff ;;; Add Sebastian Kremer's multiple-language support. ;;; ;;; ;;; Walt Buehring ;;; Texas Instruments - Computer Science Center ;;; ARPA: Buehring%TI-CSL@CSNet-Relay ;;; UUCP: {smu, texsun, im4u, rice} ! ti-csl ! buehring ;;; ;;; ispell-region and associated routines added by ;;; Perry Smith ;;; pedz@bobkat ;;; Tue Jan 13 20:18:02 CST 1987 ;;; ;;; extensively modified by Mark Davies and Andrew Vignaux ;;; {mark,andrew}@vuwcomp ;;; Sun May 10 11:45:04 NZST 1987 ;;; ;;; Ken Stevens ARPA: k.stevens@ieee.org ;;; Tue Jan 3 16:59:07 PST 1989 ;;; This file has overgone a major overhaul to be compatible with ispell ;;; version 2.1. Most of the functions have been totally rewritten, and ;;; many user-accessible variables have been added. The syntax table has ;;; been removed since it didn't work properly anyway, and a filter is ;;; used rather than a buffer. Regular expressions are used based on ;;; ispell's internal definition of characters (see ispell(4)). ;;; Some new updates: ;;; - Updated to version 3.0 to include terse processing. ;;; - Added a variable for the look command. ;;; - Fixed a bug in ispell-word when cursor is far away from the word ;;; that is to be checked. ;;; - Ispell places the incorrect word or guess in the minibuffer now. ;;; - fixed a bug with 'l' option when multiple windows are on the screen. ;;; - lookup-words just didn't work with the process filter. Fixed. ;;; - Rewrote the process filter to make it cleaner and more robust ;;; in the event of a continued line not being completed. ;;; - Made ispell-init-process more robust in handling errors. ;;; - Fixed bug in continuation location after a region has been modified by ;;; correcting a misspelling. ;;; Mon 17 Sept 1990 ;;; ;;; Sebastian Kremer ;;; Wed Aug 7 14:02:17 MET DST 1991 ;;; - Ported ispell-complete-word from Ispell 2 to Ispell 3. ;;; - Added ispell-kill-ispell command. ;;; - Added ispell-dictionary and ispell-dictionary-alist variables to ;;; support other than default language. See their docstrings and ;;; command ispell-change-dictionary. ;;; - (ispelled it :-) ;;; - Added ispell-skip-tib variable to support the tib bibliography ;;; program. ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ********************************************************************** ;;; The following variables should be set according to personal preference ;;; and location of binaries: ;;; ********************************************************************** ;;; ******* THIS FILE IS WRITTEN FOR ISPELL VERSION 3.1 ;;; Code: (defvar ispell-highlight-p t "*Highlight spelling errors when non-nil.") (defvar ispell-highlight-face 'highlight "*The face used for Ispell highlighting. For Emacses with overlays. Possible values are `highlight', `modeline', `secondary-selection', `region', and `underline'. This variable can be set by the user to whatever face they desire. It's most convenient if the cursor color and highlight color are slightly different.") (defvar ispell-check-comments nil "*Spelling of comments checked when non-nil.") (defvar ispell-query-replace-choices nil "*Corrections made throughout region when non-nil. Uses `query-replace' (\\[query-replace]) for corrections.") (defvar ispell-skip-tib nil "*Does not spell check `tib' bibliography references when non-nil. Skips any text between strings matching regular expressions `ispell-tib-ref-beginning' and `ispell-tib-ref-end'. TeX users beware: Any field starting with [. will skip until a .] -- even your whole buffer -- unless you set `ispell-skip-tib' to nil. That includes a [.5mm] type of number....") (defvar ispell-tib-ref-beginning "[[<]\\." "Regexp matching the beginning of a Tib reference.") (defvar ispell-tib-ref-end "\\.[]>]" "Regexp matching the end of a Tib reference.") (defvar ispell-keep-choices-win t "*When not nil, the `*Choices*' window remains for spelling session. This minimizes redisplay thrashing.") (defvar ispell-choices-win-default-height 2 "*The default size of the `*Choices*' window, including status line. Must be greater than 1.") (defvar ispell-program-name "ispell" "Program invoked by \\[ispell-word] and \\[ispell-region] commands.") (defvar ispell-alternate-dictionary (cond ((file-exists-p "/usr/dict/web2") "/usr/dict/web2") ((file-exists-p "/usr/share/dict/web2") "/usr/share/dict/web2") ((file-exists-p "/usr/dict/words") "/usr/dict/words") ((file-exists-p "/usr/lib/dict/words") "/usr/lib/dict/words") ((file-exists-p "/usr/share/dict/words") "/usr/share/dict/words") ((file-exists-p "/sys/dict") "/sys/dict") (t "/usr/dict/words")) "*Alternate dictionary for spelling help.") (defvar ispell-complete-word-dict ispell-alternate-dictionary "*Dictionary used for word completion.") (defvar ispell-grep-command "egrep" "Name of the grep command for search processes.") (defvar ispell-grep-options "-i" "String of options to use when running the program in `ispell-grep-command'. Should probably be \"-i\" or \"-e\". Some machines (like the NeXT) don't support \"-i\"") (defvar ispell-look-command "look" "Name of the look command for search processes. This must be an absolute file name.") (defvar ispell-look-p (file-exists-p ispell-look-command) "*Non-nil means use `look' rather than `grep'. Default is based on whether `look' seems to be available.") (defvar ispell-have-new-look nil "*Non-nil means use the `-r' option (regexp) when running `look'.") (defvar ispell-look-options (if ispell-have-new-look "-dfr" "-df") "String of command options for `ispell-look-command'.") (defvar ispell-use-ptys-p nil "When non-nil, Emacs uses ptys to communicate with Ispell. When nil, Emacs uses pipes.") (defvar ispell-following-word nil "*Non-nil means `ispell-word' checks the word around or after point. Otherwise `ispell-word' checks the preceding word.") (defvar ispell-help-in-bufferp nil "*Non-nil means display interactive keymap help in a buffer. Otherwise use the minibuffer.") (defvar ispell-quietly nil "*Non-nil means suppress messages in `ispell-word'.") (defvar ispell-format-word (function upcase) "*Formatting function for displaying word being spell checked. The function must take one string argument and return a string.") ;;;###autoload (defvar ispell-personal-dictionary nil "*File name of your personal spelling dictionary, or nil. If nil, the default personal dictionary, \"~/.ispell_DICTNAME\" is used, where DICTNAME is the name of your default dictionary.") (defvar ispell-silently-savep nil "*When non-nil, save the personal dictionary without confirmation.") ;;; This variable contains the current dictionary being used if the ispell ;;; process is running. Otherwise it contains the global default. (defvar ispell-dictionary nil "If non-nil, a dictionary to use instead of the default one. This is passed to the ispell process using the `-d' switch and is used as key in `ispell-dictionary-alist' (which see). You should set this variable before your first use of Emacs spell-checking commands in the Emacs session, or else use the \\[ispell-change-dictionary] command to change it. Otherwise, this variable only takes effect in a newly started Ispell process.") (defvar ispell-extra-args nil "*If non-nil, a list of extra switches to pass to the Ispell program. For example, '(\"-W\" \"3\") to cause it to accept all 1-3 character words as correct. See also `ispell-dictionary-alist', which may be used for language-specific arguments.") ;;; The preparation of the menu bar menu must be autoloaded ;;; because otherwise this file gets autoloaded every time Emacs starts ;;; so that it can set up the menus and determine keyboard equivalents. ;;;###autoload (defvar ispell-dictionary-alist-1 ; sk 9-Aug-1991 18:28 '((nil ; default (english.aff) "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil) ("english" ; make english explicitly selectable "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil) ("british" ; british version "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B" "-d" "british") nil) ("deutsch" ; deutsch.aff "[a-zA-Z\"]" "[^a-zA-Z\"]" "[']" t ("-C") "~tex") ("deutsch8" "[a-zA-Z\304\326\334\344\366\337\374]" "[^a-zA-Z\304\326\334\344\366\337\374]" "[']" t ("-C" "-d" "deutsch") "~latin1") ("nederlands" ; nederlands.aff "[A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]" "[^A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]" "[']" t ("-C") nil) ("nederlands8" ; dutch8.aff "[A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]" "[^A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]" "[']" t ("-C") nil))) ;;;###autoload (defvar ispell-dictionary-alist-2 '(("svenska" ;7 bit swedish mode "[A-Za-z}{|\\133\\135\\\\]" "[^A-Za-z}{|\\133\\135\\\\]" "[']" nil ("-C") nil) ("svenska8" ;8 bit swedish mode "[A-Za-z\345\344\366\305\304\366]" "[^A-Za-z\345\344\366\305\304\366]" "[']" nil ("-C" "-d" "svenska") "~list") ; Add `"-T" "list"' instead? ("francais7" "[A-Za-z]" "[^A-Za-z]" "[`'^---]" t nil nil) ("francais" ; francais.aff "[A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374]" "[^A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374]" "[---']" t nil "~list") ("francais-tex" ; francais.aff "[A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374\\]" "[^A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374\\]" "[---'^`\"]" t nil "~tex") ("dansk" ; dansk.aff "[A-Z\306\330\305a-z\346\370\345]" "[^A-Z\306\330\305a-z\346\370\345]" "" nil ("-C") nil) )) ;;; ispell-dictionary-alist is set up from two subvariables above ;;; to avoid having very long lines in loaddefs.el. ;;;###autoload (defvar ispell-dictionary-alist (append ispell-dictionary-alist-1 ispell-dictionary-alist-2) "An alist of dictionaries and their associated parameters. Each element of this list is also a list: \(DICTIONARY-NAME CASECHARS NOT-CASECHARS OTHERCHARS MANY-OTHERCHARS-P ISPELL-ARGS EXTENDED-CHARACTER-MODE\) DICTIONARY-NAME is a possible value of variable `ispell-dictionary', nil means the default dictionary. CASECHARS is a regular expression of valid characters that comprise a word. NOT-CASECHARS is the opposite regexp of CASECHARS. OTHERCHARS is a regular expression of other characters that are valid in word constructs. Otherchars cannot be adjacent to each other in a word, nor can they begin or end a word. This implies we can't check \"Stevens'\" as a correct possessive and other correct formations. Hint: regexp syntax requires the hyphen to be declared first here. MANY-OTHERCHARS-P is non-nil if many otherchars are to be allowed in a word instead of only one. ISPELL-ARGS is a list of additional arguments passed to the ispell subprocess. EXTENDED-CHARACTER-MODE should be used when dictionaries are used which have been configured in an Ispell affix file. (For example, umlauts can be encoded as \\\"a, a\\\", \"a, ...) Defaults are ~tex and ~nroff in English. This has the same effect as the command-line `-T' option. The buffer Major Mode controls Ispell's parsing in tex or nroff mode, but the dictionary can control the extended character mode. Both defaults can be overruled in a buffer-local fashion. See `ispell-parsing-keyword' for details on this. Note that the CASECHARS and OTHERCHARS slots of the alist should contain the same character set as casechars and otherchars in the language.aff file \(e.g., english.aff\).") ;;;###autoload (defvar ispell-menu-map nil "Key map for ispell menu") ;;;###autoload (defvar ispell-menu-lucid nil "Spelling menu for Lucid Emacs.") ;;; Break out lucid menu and split into several calls to avoid having ;;; long lines in loaddefs.el. Detect need off following constant. ;;;###autoload (defconst ispell-menu-map-needed ; make sure this is not Lucid Emacs (and (not ispell-menu-map) ;;; This is commented out because it fails in Emacs. ;;; due to the fact that menu-bar is loaded much later than loaddefs. ;;; ;; make sure this isn't Lucid Emacs ;;; (featurep 'menu-bar) (not (string-match "Lucid" emacs-version)))) ;;; Set up dictionary ;;;###autoload (if ispell-menu-map-needed (let ((dicts (reverse (cons (cons "default" nil) ispell-dictionary-alist))) name) (setq ispell-menu-map (make-sparse-keymap "Spell")) ;; add the dictionaries to the bottom of the list. (while dicts (setq name (car (car dicts)) dicts (cdr dicts)) (if (stringp name) (define-key ispell-menu-map (vector (intern name)) (cons (concat "Select " (capitalize name)) (list 'lambda () '(interactive) (list 'ispell-change-dictionary name)))))))) ;;; define commands in menu in opposite order you want them to appear. ;;;###autoload (if ispell-menu-map-needed (progn (define-key ispell-menu-map [ispell-change-dictionary] '("Change Dictionary" . ispell-change-dictionary)) (define-key ispell-menu-map [ispell-kill-ispell] '("Kill Process" . ispell-kill-ispell)) (define-key ispell-menu-map [ispell-pdict-save] '("Save Dictionary" . (lambda () (interactive) (ispell-pdict-save t t)))) (define-key ispell-menu-map [ispell-complete-word] '("Complete Word" . ispell-complete-word)) (define-key ispell-menu-map [ispell-complete-word-interior-frag] '("Complete Word Frag" . ispell-complete-word-interior-frag)))) ;;;###autoload (if ispell-menu-map-needed (progn (define-key ispell-menu-map [ispell-continue] '("Continue Check" . ispell-continue)) (define-key ispell-menu-map [ispell-word] '("Check Word" . ispell-word)) (define-key ispell-menu-map [ispell-region] '("Check Region" . ispell-region)) (define-key ispell-menu-map [ispell-buffer] '("Check Buffer" . ispell-buffer)))) ;;;###autoload (if ispell-menu-map-needed (progn (define-key ispell-menu-map [ispell-message] '("Check Message" . ispell-message)) (define-key ispell-menu-map [ispell-help] ;; use (x-popup-menu last-nonmenu-event(list "" ispell-help-list)) ? '("Help" . (lambda () (interactive) (describe-function 'ispell-help)))) (put 'ispell-region 'menu-enable 'mark-active) (fset 'ispell-menu-map (symbol-value 'ispell-menu-map)))) ;;; Xemacs version 19 (if (and (string-lessp "19" emacs-version) (string-match "Lucid" emacs-version)) (let ((dicts (cons (cons "default" nil) ispell-dictionary-alist)) (current-menubar (or current-menubar default-menubar)) (menu '(["Help" (describe-function 'ispell-help) t] ;;["Help" (popup-menu ispell-help-list) t] ["Check Message" ispell-message t] ["Check Buffer" ispell-buffer t] ["Check Word" ispell-word t] ["Check Region" ispell-region (or (not zmacs-regions) (mark))] ["Continue Check" ispell-continue t] ["Complete Word Frag"ispell-complete-word-interior-frag t] ["Complete Word" ispell-complete-word t] ["Kill Process" ispell-kill-ispell t] "-" ["Save Dictionary" (ispell-pdict-save t t) t] ["Change Dictionary" ispell-change-dictionary t])) name) (while dicts (setq name (car (car dicts)) dicts (cdr dicts)) (if (stringp name) (setq menu (append menu (list (vector (concat "Select " (capitalize name)) (list 'ispell-change-dictionary name) t)))))) (setq ispell-menu-lucid menu) (if current-menubar (progn (delete-menu-item '("Edit" "Spell")) ; in case already defined (add-menu '("Edit") "Spell" ispell-menu-lucid))))) ;;; ********************************************************************** ;;; The following are used by ispell, and should not be changed. ;;; ********************************************************************** ;;; The version must be 3.1 or greater for this version of ispell.el ;;; There is an incompatibility between version 3.1.12 and lower versions. (defconst ispell-required-version '("3.1." 12) "Ispell versions with which this version of ispell.el is known to work.") (defvar ispell-offset 1 "Offset that maps protocol differences between ispell 3.1 versions.") (defun ispell-get-casechars () (nth 1 (assoc ispell-dictionary ispell-dictionary-alist))) (defun ispell-get-not-casechars () (nth 2 (assoc ispell-dictionary ispell-dictionary-alist))) (defun ispell-get-otherchars () (nth 3 (assoc ispell-dictionary ispell-dictionary-alist))) (defun ispell-get-many-otherchars-p () (nth 4 (assoc ispell-dictionary ispell-dictionary-alist))) (defun ispell-get-ispell-args () (nth 5 (assoc ispell-dictionary ispell-dictionary-alist))) (defun ispell-get-extended-character-mode () (nth 6 (assoc ispell-dictionary ispell-dictionary-alist))) (defvar ispell-process nil "The process object for Ispell.") (defvar ispell-pdict-modified-p nil "Non-nil means personal dictionary has modifications to be saved.") ;;; If you want to save the dictionary when quitting, must do so explicitly. ;;; When non-nil, the spell session is terminated. ;;; When numeric, contains cursor location in buffer, and cursor remains there. (defvar ispell-quit nil) (defvar ispell-filter nil "Output filter from piped calls to Ispell.") (defvar ispell-filter-continue nil "Control variable for Ispell filter function.") (defvar ispell-process-directory nil "The directory where `ispell-process' was started.") (defvar ispell-query-replace-marker (make-marker) "Marker for `query-replace' processing.") (defvar ispell-checking-message nil "Non-nil when we're checking a mail message") (defconst ispell-choices-buffer "*Choices*") (defvar ispell-overlay nil "Overlay variable for Ispell highlighting.") ;;; *** Buffer Local Definitions *** ;;; This is the local dictionary to use. When nil the default dictionary will ;;; be used. Do not redefine default value or it will override the global! (defvar ispell-local-dictionary nil "If non-nil, a dictionary to use for Ispell commands in this buffer. The value must be a string dictionary name in `ispell-dictionary-alist'. This variable becomes buffer-local when set in any fashion. Setting ispell-local-dictionary to a value has the same effect as calling \\[ispell-change-dictionary] with that value. This variable is automatically set when defined in the file with either `ispell-dictionary-keyword' or the Local Variable syntax.") (make-variable-buffer-local 'ispell-local-dictionary) ;; Use default directory, unless locally set. (set-default 'ispell-local-dictionary nil) (defconst ispell-words-keyword "LocalWords: " "The keyword for local oddly-spelled words to accept. The keyword will be followed by any number of local word spellings. There can be multiple of these keywords in the file.") (defconst ispell-dictionary-keyword "Local IspellDict: " "The keyword for local dictionary definitions. There should be only one dictionary keyword definition per file, and it should be followed by a correct dictionary name in `ispell-dictionary-alist'.") (defconst ispell-parsing-keyword "Local IspellParsing: " "The keyword for overriding default Ispell parsing. Determined by the buffer's major mode and extended-character mode as well as the default dictionary. The above keyword string should be followed by `latex-mode' or `nroff-mode' to put the current buffer into the desired parsing mode. Extended character mode can be changed for this buffer by placing a `~' followed by an extended-character mode -- such as `~.tex'.") (defvar ispell-skip-sgml nil "Skips spell checking of SGML tags and entity references when non-nil. This variable is set when major-mode is sgml-mode or html-mode.") (defvar ispell-local-pdict ispell-personal-dictionary "A buffer local variable containing the current personal dictionary. If non-nil, the value must be a string, which is a file name. If you specify a personal dictionary for the current buffer which is different from the current personal dictionary, the effect is similar to calling \\[ispell-change-dictionary]. This variable is automatically set when defined in the file with either `ispell-pdict-keyword' or the local variable syntax.") (make-variable-buffer-local 'ispell-local-pdict) (defconst ispell-pdict-keyword "Local IspellPersDict: " "The keyword for defining buffer local dictionaries.") (defvar ispell-buffer-local-name nil "Contains the buffer name if local word definitions were used. Ispell is then restarted because the local words could conflict.") (defvar ispell-parser 'use-mode-name "*Indicates whether ispell should parse the current buffer as TeX Code. Special value `use-mode-name' tries to guess using the name of major-mode. Default parser is 'nroff. Currently the only other valid parser is 'tex. You can set this variable in hooks in your init file -- eg: (add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex))))") (defvar ispell-region-end (make-marker) "Marker that allows spelling continuations.") (defvar ispell-check-only nil "If non-nil, `ispell-word' does not try to correct the word.") ;;; ********************************************************************** ;;; ********************************************************************** (and (string-lessp "19" emacs-version) (not (boundp 'epoch::version)) (defalias 'ispell 'ispell-buffer)) ;;;###autoload (define-key global-map "\M-$" 'ispell-word) ;;;###autoload (defun ispell-word (&optional following quietly continue) "Check spelling of word under or before the cursor. If the word is not found in dictionary, display possible corrections in a window allowing you to choose one. With a prefix argument (or if CONTINUE is non-nil), resume interrupted spell-checking of a buffer or region. If optional argument FOLLOWING is non-nil or if `ispell-following-word' is non-nil when called interactively, then the following word \(rather than preceding\) is checked when the cursor is not over a word. When the optional argument QUIETLY is non-nil or `ispell-quietly' is non-nil when called interactively, non-corrective messages are suppressed. Word syntax described by `ispell-dictionary-alist' (which see). This will check or reload the dictionary. Use \\[ispell-change-dictionary] or \\[ispell-region] to update the Ispell process." (interactive (list nil nil current-prefix-arg)) (if continue (ispell-continue) (if (interactive-p) (setq following ispell-following-word quietly ispell-quietly)) (ispell-accept-buffer-local-defs) ; use the correct dictionary (let ((cursor-location (point)) ; retain cursor location (word (ispell-get-word following)) start end poss replace) ;; destructure return word info list. (setq start (car (cdr word)) end (car (cdr (cdr word))) word (car word)) ;; now check spelling of word. (or quietly (message "Checking spelling of %s..." (funcall ispell-format-word word))) (process-send-string ispell-process "%\n") ;put in verbose mode (process-send-string ispell-process (concat "^" word "\n")) ;; wait until ispell has processed word (while (progn (accept-process-output ispell-process) (not (string= "" (car ispell-filter))))) ;;(process-send-string ispell-process "!\n") ;back to terse mode. (setq ispell-filter (cdr ispell-filter)) (if (listp ispell-filter) (setq poss (ispell-parse-output (car ispell-filter)))) (cond ((eq poss t) (or quietly (message "%s is correct" (funcall ispell-format-word word)))) ((stringp poss) (or quietly (message "%s is correct because of root %s" (funcall ispell-format-word word) (funcall ispell-format-word poss)))) ((null poss) (message "Error in ispell process")) (ispell-check-only ; called from ispell minor mode. (beep)) (t ; prompt for correct word. (save-window-excursion (setq replace (ispell-command-loop (car (cdr (cdr poss))) (car (cdr (cdr (cdr poss)))) (car poss) start end))) (cond ((equal 0 replace) (ispell-add-per-file-word-list (car poss))) (replace (setq word (if (atom replace) replace (car replace)) cursor-location (+ (- (length word) (- end start)) cursor-location)) (if (not (equal word (car poss))) (progn (delete-region start end) (insert word))) (if (not (atom replace)) ; recheck spelling of replacement (progn (goto-char cursor-location) (ispell-word following quietly))))) (if (get-buffer ispell-choices-buffer) (kill-buffer ispell-choices-buffer)))) (goto-char cursor-location) ; return to original location (ispell-pdict-save ispell-silently-savep) (if ispell-quit (setq ispell-quit nil))))) (defun ispell-get-word (following &optional extra-otherchars) "Return the word for spell-checking according to ispell syntax. If optional argument FOLLOWING is non-nil or if `ispell-following-word' is non-nil when called interactively, then the following word \(rather than preceding\) is checked when the cursor is not over a word. Optional second argument contains otherchars that can be included in word many times. Word syntax described by `ispell-dictionary-alist' (which see)." (let* ((ispell-casechars (ispell-get-casechars)) (ispell-not-casechars (ispell-get-not-casechars)) (ispell-otherchars (ispell-get-otherchars)) (ispell-many-otherchars-p (ispell-get-many-otherchars-p)) (word-regexp (concat ispell-casechars "+\\(" ispell-otherchars "?" (if extra-otherchars (concat extra-otherchars "?")) ispell-casechars "+\\)" (if (or ispell-many-otherchars-p extra-otherchars) "*" "?"))) did-it-once start end word) ;; find the word (if (not (looking-at ispell-casechars)) (if following (re-search-forward ispell-casechars (point-max) t) (re-search-backward ispell-casechars (point-min) t))) ;; move to front of word (re-search-backward ispell-not-casechars (point-min) 'start) (while (and (or (looking-at ispell-otherchars) (and extra-otherchars (looking-at extra-otherchars))) (not (bobp)) (or (not did-it-once) ispell-many-otherchars-p)) (if (and extra-otherchars (looking-at extra-otherchars)) (progn (backward-char 1) (if (looking-at ispell-casechars) (re-search-backward ispell-not-casechars (point-min) 'move))) (setq did-it-once t) (backward-char 1) (if (looking-at ispell-casechars) (re-search-backward ispell-not-casechars (point-min) 'move) (backward-char -1)))) ;; Now mark the word and save to string. (or (re-search-forward word-regexp (point-max) t) (error "No word found to check!")) (setq start (match-beginning 0) end (point) word (buffer-substring start end)) (list word start end))) ;;; Global ispell-pdict-modified-p is set by ispell-command-loop and ;;; tracks changes in the dictionary. The global may either be ;;; a value or a list, whose value is the state of whether the ;;; dictionary needs to be saved. (defun ispell-pdict-save (&optional no-query force-save) "Check to see if the personal dictionary has been modified. If so, ask if it needs to be saved." (interactive (list ispell-silently-savep t)) (if (and ispell-pdict-modified-p (listp ispell-pdict-modified-p)) (setq ispell-pdict-modified-p (car ispell-pdict-modified-p))) (if (or ispell-pdict-modified-p force-save) (if (or no-query (y-or-n-p "Personal dictionary modified. Save? ")) (progn (process-send-string ispell-process "#\n") (message "Personal dictionary saved.")))) ;; unassert variable, even if not saved to avoid questioning. (setq ispell-pdict-modified-p nil)) (defun ispell-command-loop (miss guess word start end) "Display possible corrections from list MISS. GUESS lists possibly valid affix construction of WORD. Returns nil to keep word. Returns 0 to insert locally into buffer-local dictionary. Returns string for new chosen word. Returns list for new replacement word (will be rechecked). Highlights the word, which is assumed to run from START to END. Global `ispell-pdict-modified-p' becomes a list where the only value indicates whether the dictionary has been modified when option `a' or `i' is used." (let ((textbuf (current-buffer)) (count ?0) (line 2) (max-lines (- (window-height) 4)) ; assure 4 context lines. (choices miss) (window-min-height (min window-min-height ispell-choices-win-default-height)) (command-characters '( ? ?i ?a ?A ?r ?R ?? ?x ?X ?q ?l ?u ?m )) (skipped 0) char num result textwin highlighted) ;; setup the *Choices* buffer with valid data. (save-excursion (set-buffer (get-buffer-create ispell-choices-buffer)) (setq mode-line-format (concat "-- %b -- word: " word)) (erase-buffer) (if guess (progn (insert "Affix rules generate and capitalize " "this word as shown below:\n\t") (while guess (if (> (+ 4 (current-column) (length (car guess))) (window-width)) (progn (insert "\n\t") (setq line (1+ line)))) (insert (car guess) " ") (setq guess (cdr guess))) (insert "\nUse option `i' if this is a correct composition" " from the derivative root.\n") (setq line (+ line (if choices 3 2))))) (while (and choices (< (if (> (+ 7 (current-column) (length (car choices)) (if (> count ?~) 3 0)) (window-width)) (progn (insert "\n") (setq line (1+ line))) line) max-lines)) ;; not so good if there are over 20 or 30 options, but then, if ;; there are that many you don't want to scan them all anyway... (while (memq count command-characters) ; skip command characters. (setq count (1+ count) skipped (1+ skipped))) (insert "(" count ") " (car choices) " ") (setq choices (cdr choices) count (1+ count))) (setq count (- count ?0 skipped))) ;; Assure word is visible (if (not (pos-visible-in-window-p end)) (sit-for 0)) ;; Display choices for misspelled word. (let ((choices-window (get-buffer-window ispell-choices-buffer))) (if choices-window (if (= line (window-height choices-window)) (select-window choices-window) ;; *Choices* window changed size. Adjust the choices window ;; without scrolling the spelled window when possible (let ((window-line (- line (window-height choices-window))) (visible (progn (forward-line -1) (point)))) (if (< line ispell-choices-win-default-height) (setq window-line (+ window-line (- ispell-choices-win-default-height line)))) (move-to-window-line 0) (forward-line window-line) (set-window-start (selected-window) (if (> (point) visible) visible (point))) (goto-char end) (select-window (previous-window)) ; *Choices* window (enlarge-window window-line))) ;; Overlay *Choices* window when it isn't showing (ispell-overlay-window (max line ispell-choices-win-default-height))) (switch-to-buffer ispell-choices-buffer) (goto-char (point-min))) (select-window (setq textwin (next-window))) ;; highlight word, protecting current buffer status (unwind-protect (progn (if ispell-highlight-p (ispell-highlight-spelling-error start end t)) ;; Loop until a valid choice is made. (while (eq t (setq result (progn (undo-boundary) (message (concat "C-h or ? for more options; SPC to leave " "unchanged, Character to replace word")) (let ((inhibit-quit t)) (setq char (if (fboundp 'read-char-exclusive) (read-char-exclusive) (read-char)) skipped 0) (if (or quit-flag (= char ?\C-g)) ; C-g is like typing X (setq char ?X quit-flag nil))) ;; Adjust num to array offset skipping command characters. (let ((com-chars command-characters)) (while com-chars (if (and (> (car com-chars) ?0) (< (car com-chars) char)) (setq skipped (1+ skipped))) (setq com-chars (cdr com-chars))) (setq num (- char ?0 skipped))) (cond ((= char ? ) nil) ; accept word this time only ((= char ?i) ; accept and insert word into pers dict (process-send-string ispell-process (concat "*" word "\n")) (setq ispell-pdict-modified-p '(t)) ; dictionary modified! nil) ((or (= char ?a) (= char ?A)) ; accept word without insert (process-send-string ispell-process (concat "@" word "\n")) (if (null ispell-pdict-modified-p) (setq ispell-pdict-modified-p (list ispell-pdict-modified-p))) (if (= char ?A) 0)) ; return 0 for ispell-add buffer-local ((or (= char ?r) (= char ?R)) ; type in replacement (if (or (= char ?R) ispell-query-replace-choices) (list (read-string "Query-replacement for: " word) t) (cons (read-string "Replacement for: " word) nil))) ((or (= char ??) (= char help-char) (= char ?\C-h)) (ispell-help) t) ;; Quit and move point back. ((= char ?x) (ispell-pdict-save ispell-silently-savep) (message "Exited spell-checking") (setq ispell-quit t) nil) ;; Quit and preserve point. ((= char ?X) (ispell-pdict-save ispell-silently-savep) (message (substitute-command-keys (concat "Spell-checking suspended;" " use C-u \\[ispell-word] to resume"))) (setq ispell-quit (max (point-min) (- (point) (length word)))) nil) ((= char ?q) (if (y-or-n-p "Really kill Ispell process? ") (progn (ispell-kill-ispell t) ; terminate process. (setq ispell-quit (or (not ispell-checking-message) (point)) ispell-pdict-modified-p nil)) t)) ; continue if they don't quit. ((= char ?l) (let ((new-word (read-string "Lookup string (`*' is wildcard): " word)) (new-line 2)) (if new-word (progn (save-excursion (set-buffer (get-buffer-create ispell-choices-buffer)) (erase-buffer) (setq count ?0 skipped 0 mode-line-format (concat "-- %b -- word: " new-word) miss (lookup-words new-word) choices miss) (while (and choices ; adjust choices window. (< (if (> (+ 7 (current-column) (length (car choices)) (if (> count ?~) 3 0)) (window-width)) (progn (insert "\n") (setq new-line (1+ new-line))) new-line) max-lines)) (while (memq count command-characters) (setq count (1+ count) skipped (1+ skipped))) (insert "(" count ") " (car choices) " ") (setq choices (cdr choices) count (1+ count))) (setq count (- count ?0 skipped))) (select-window (previous-window)) (if (and (/= new-line line) (> (max line new-line) ispell-choices-win-default-height)) (let* ((minh ispell-choices-win-default-height) (gr-bl (if (< line minh) ; blanks (- minh line) 0)) (shr-bl (if (< new-line minh) ; blanks (- minh new-line) 0))) (if (> new-line line) (enlarge-window (- new-line line gr-bl)) (shrink-window (- line new-line shr-bl))) (setq line new-line))) (select-window (next-window))))) t) ; reselect from new choices ((= char ?u) (process-send-string ispell-process (concat "*" (downcase word) "\n")) (setq ispell-pdict-modified-p '(t)) ; dictionary modified! nil) ((= char ?m) ; type in what to insert (process-send-string ispell-process (concat "*" (read-string "Insert: " word) "\n")) (setq ispell-pdict-modified-p '(t)) (cons word nil)) ((and (>= num 0) (< num count)) (if ispell-query-replace-choices ; Query replace flag (list (nth num miss) 'query-replace) (nth num miss))) ((= char ?\C-l) (redraw-display) t) ((= char ?\C-r) (save-window-excursion (recursive-edit)) t) ((= char ?\C-z) (funcall (key-binding "\C-z")) t) (t (ding) t)))))) result) ;; protected (if ispell-highlight-p ; unhighlight (save-window-excursion (select-window textwin) (ispell-highlight-spelling-error start end)))))) ;;;###autoload (defun ispell-help () "Display a list of the options available when a misspelling is encountered. Selections are: DIGIT: Replace the word with a digit offered in the *Choices* buffer. SPC: Accept word this time. `i': Accept word and insert into private dictionary. `a': Accept word for this session. `A': Accept word and place in `buffer-local dictionary'. `r': Replace word with typed-in value. Rechecked. `R': Replace word with typed-in value. Query-replaced in buffer. Rechecked. `?': Show these commands. `x': Exit spelling buffer. Move cursor to original point. `X': Exit spelling buffer. Leaves cursor at the current point, and permits the aborted check to be completed later. `q': Quit spelling session (Kills ispell process). `l': Look up typed-in replacement in alternate dictionary. Wildcards okay. `u': Like `i', but the word is lower-cased first. `m': Like `i', but allows one to include dictionary completion information. `C-l': redraws screen `C-r': recursive edit `C-z': suspend emacs or iconify frame" (let ((help-1 (concat "[r/R]eplace word; [a/A]ccept for this session; " "[i]nsert into private dictionary")) (help-2 (concat "[l]ook a word up in alternate dictionary; " "e[x/X]it; [q]uit session")) (help-3 (concat "[u]ncapitalized insert into dictionary. " "Type 'C-h d ispell-help' for more help"))) (save-window-excursion (if ispell-help-in-bufferp (progn (ispell-overlay-window 4) (switch-to-buffer (get-buffer-create "*Ispell Help*")) (insert (concat help-1 "\n" help-2 "\n" help-3)) (sit-for 5) (kill-buffer "*Ispell Help*")) (select-window (minibuffer-window)) ;;(enlarge-window 2) (erase-buffer) (cond ((string-match "Lucid" emacs-version) (message help-3) (enlarge-window 1) (message help-2) (enlarge-window 1) (message help-1) (goto-char (point-min))) (t (if (string-lessp "19" emacs-version) (message nil)) (enlarge-window 2) (insert (concat help-1 "\n" help-2 "\n" help-3)))) (sit-for 5) (erase-buffer))))) (defun lookup-words (word &optional lookup-dict) "Look up word in word-list dictionary. A `*' serves as a wild card. If no wild cards, `look' is used if it exists. Otherwise the variable `ispell-grep-command' contains the command used to search for the words (usually egrep). Optional second argument contains the dictionary to use; the default is `ispell-alternate-dictionary'." ;; We don't use the filter for this function, rather the result is written ;; into a buffer. Hence there is no need to save the filter values. (if (null lookup-dict) (setq lookup-dict ispell-alternate-dictionary)) (let* ((process-connection-type ispell-use-ptys-p) (wild-p (string-match "\\*" word)) (look-p (and ispell-look-p ; Only use look for an exact match. (or ispell-have-new-look (not wild-p)))) (ispell-grep-buffer (get-buffer-create "*Ispell-Temp*")) ; result buf (prog (if look-p ispell-look-command ispell-grep-command)) (args (if look-p ispell-look-options ispell-grep-options)) status results loc) (unwind-protect (save-window-excursion (message "Starting \"%s\" process..." (file-name-nondirectory prog)) (set-buffer ispell-grep-buffer) (if look-p nil ;; convert * to .* (insert "^" word "$") (while (search-backward "*" nil t) (insert ".")) (setq word (buffer-string)) (erase-buffer)) (setq status (call-process prog nil t nil args word lookup-dict)) ;; grep returns status 1 and no output when word not found, which ;; is a perfectly normal thing. (if (stringp status) (setq results (cons (format "error: %s exited with signal %s" (file-name-nondirectory prog) status) results)) ;; else collect words into `results' in FIFO order (goto-char (point-max)) ;; assure we've ended with \n (or (bobp) (= (preceding-char) ?\n) (insert ?\n)) (while (not (bobp)) (setq loc (point)) (forward-line -1) (setq results (cons (buffer-substring (point) (1- loc)) results))))) ;; protected (kill-buffer ispell-grep-buffer) (if (and results (string-match ".+: " (car results))) (error "%s error: %s" ispell-grep-command (car results)))) results)) ;;; "ispell-filter" is a list of output lines from the generating function. ;;; Each full line (ending with \n) is a separate item on the list. ;;; "output" can contain multiple lines, part of a line, or both. ;;; "start" and "end" are used to keep bounds on lines when "output" contains ;;; multiple lines. ;;; "ispell-filter-continue" is true when we have received only part of a ;;; line as output from a generating function ("output" did not end with \n) ;;; NOTE THAT THIS FUNCTION WILL FAIL IF THE PROCESS OUTPUT DOESNT END WITH \n! ;;; This is the case when a process dies or fails. The default behavior ;;; in this case treats the next input received as fresh input. (defun ispell-filter (process output) "Output filter function for ispell, grep, and look." (let ((start 0) (continue t) end) (while continue (setq end (string-match "\n" output start)) ; get text up to the newline. ;; If we get out of sync and ispell-filter-continue is asserted when we ;; are not continuing, treat the next item as a separate list. When ;; ispell-filter-continue is asserted, ispell-filter *should* always be a ;; list! ;; Continue with same line (item)? (if (and ispell-filter-continue ispell-filter (listp ispell-filter)) ;; Yes. Add it to the prev item (setcar ispell-filter (concat (car ispell-filter) (substring output start end))) ;; No. This is a new line and item. (setq ispell-filter (cons (substring output start end) ispell-filter))) (if (null end) ;; We've completed reading the output, but didn't finish the line. (setq ispell-filter-continue t continue nil) ;; skip over newline, this line complete. (setq ispell-filter-continue nil end (1+ end)) (if (= end (length output)) ; No more lines in output (setq continue nil) ; so we can exit the filter. (setq start end)))))) ; else move start to next line of input ;;; This function destroys the mark location if it is in the word being ;;; highlighted. (defun ispell-highlight-spelling-error-generic (start end &optional highlight) "Highlight the word from START to END with a kludge using `inverse-video'. When the optional third arg HIGHLIGHT is set, the word is highlighted; otherwise it is displayed normally." (let ((modified (buffer-modified-p)) ; don't allow this fn to modify buffer (buffer-read-only nil) ; Allow highlighting read-only buffers. (text (buffer-substring start end)) ; Save highlight region (inhibit-quit t) ; inhibit interrupt processing here. (buffer-undo-list t)) ; don't clutter the undo list. (delete-region start end) (insert-char ? (- end start)) ; mimimize amount of redisplay (sit-for 0) ; update display (if highlight (setq inverse-video (not inverse-video))) ; toggle video (delete-region start end) ; delete whitespace (insert text) ; insert text in inverse video. (sit-for 0) ; update display showing inverse video. (if highlight (setq inverse-video (not inverse-video))) ; toggle video (set-buffer-modified-p modified))) ; don't modify if flag not set. (defun ispell-highlight-spelling-error-lucid (start end &optional highlight) "Highlight the word from START to END using `isearch-highlight'. When the optional third arg HIGHLIGHT is set, the word is highlighted, otherwise it is displayed normally." (if highlight (isearch-highlight start end) (isearch-dehighlight t)) ;;(sit-for 0) ) (defun ispell-highlight-spelling-error-overlay (start end &optional highlight) "Highlight the word from START to END using overlays. When the optional third arg HIGHLIGHT is set, the word is highlighted otherwise it is displayed normally. The variable `ispell-highlight-face' selects the face to use for highlighting." (if highlight (progn (setq ispell-overlay (make-overlay start end)) (overlay-put ispell-overlay 'face ispell-highlight-face)) (delete-overlay ispell-overlay))) (defun ispell-highlight-spelling-error (start end &optional highlight) (cond ((string-match "Lucid" emacs-version) (ispell-highlight-spelling-error-lucid start end highlight)) ((and (string-lessp "19" emacs-version) (featurep 'faces) window-system) (ispell-highlight-spelling-error-overlay start end highlight)) (t (ispell-highlight-spelling-error-generic start end highlight)))) (defun ispell-overlay-window (height) "Create a window covering the top HEIGHT lines of the current window. Ensure that the line above point is still visible but otherwise avoid scrolling the current window. Leave the new window selected." (save-excursion (let ((oldot (save-excursion (forward-line -1) (point))) (top (save-excursion (move-to-window-line height) (point)))) ;; If line above old point (line starting at olddot) would be ;; hidden by new window, scroll it to just below new win ;; otherwise set top line of other win so it doesn't scroll. (if (< oldot top) (setq top oldot)) ;; NB: Lemacs 19.9 bug: If a window of size N (N includes the mode ;; line) is demanded, the last line is not visible. ;; At least this happens on AIX 3.2, lemacs w/ Motif, font 9x15. ;; So we increment the height for this case. (if (string-match "19\.9.*Lucid" (emacs-version)) (setq height (1+ height))) (split-window nil height) (set-window-start (next-window) top)))) ;;; Should we add a compound word match return value? (defun ispell-parse-output (output) "Parse the OUTPUT string from Ispell and return: 1: t for an exact match. 2: A string containing the root word for a match via suffix removal. 3: A list of possible correct spellings of the format: '(\"ORIGINAL-WORD\" OFFSET MISS-LIST GUESS-LIST) ORIGINAL-WORD is a string of the possibly misspelled word. OFFSET is an integer giving the line offset of the word. MISS-LIST and GUESS-LIST are possibly null lists of guesses and misses." (cond ((string= output "") t) ; for startup with pipes... ((string= output "*") t) ; exact match ((string= output "-") t) ; compound word match ((string= (substring output 0 1) "+") ; found cuz of root word (substring output 2)) ; return root word (t ; need to process &, ?, and #'s (let ((type (substring output 0 1)) ; &, ?, or # (original-word (substring output 2 (string-match " " output 2))) (cur-count 0) ; contains number of misses + guesses count miss-list guess-list offset) (setq output (substring output (match-end 0))) ; skip over misspelling (if (string= type "#") (setq count 0) ; no misses for type # (setq count (string-to-int output) ; get number of misses. output (substring output (1+ (string-match " " output 1))))) (setq offset (string-to-int output)) (if (string= type "#") ; No miss or guess list. (setq output nil) (setq output (substring output (1+ (string-match " " output 1))))) (while output (let ((end (string-match ", \\|\\($\\)" output))) ; end of miss/guess. (setq cur-count (1+ cur-count)) (if (> cur-count count) (setq guess-list (cons (substring output 0 end) guess-list)) (setq miss-list (cons (substring output 0 end) miss-list))) (if (match-end 1) ; True only when at end of line. (setq output nil) ; no more misses or guesses (setq output (substring output (+ end 2)))))) (list original-word offset miss-list guess-list))))) (defun check-ispell-version () ;; This is a little wasteful as we actually launch ispell twice: once ;; to make sure it's the right version, and once for real. But people ;; get confused by version mismatches *all* the time (and I've got the ;; email to prove it) so I think this is worthwhile. And the -v[ersion] ;; option is the only way I can think of to do this that works with ;; all versions, since versions earlier than 3.0.09 didn't identify ;; themselves on startup. (save-excursion (let ((case-fold-search t) ;; avoid bugs when syntax of `.' changes in various default modes (default-major-mode 'fundamental-mode) status) (set-buffer (get-buffer-create " *ispell-tmp*")) (erase-buffer) (setq status (call-process ispell-program-name nil t nil "-v")) (goto-char (point-min)) (if (not (memq status '(0 nil))) (error "%s exited with %s %s" ispell-program-name (if (stringp status) "signal" "code") status)) (if (not (re-search-forward (concat "\\b\\(" (regexp-quote (car ispell-required-version)) "\\)\\([0-9]*\\)\\b") nil t)) (error "%s version %s* is required: try renaming ispell4.el to ispell.el" ispell-program-name (car ispell-required-version)) ;; check that it is the correct version. (if (< (car (read-from-string (buffer-substring (match-beginning 2) (match-end 2)))) (car (cdr ispell-required-version))) (setq ispell-offset 0))) (kill-buffer (current-buffer))))) (defun ispell-init-process () "Check status of Ispell process and start if necessary." (if (and ispell-process (eq (process-status ispell-process) 'run) ;; If we're using a personal dictionary, assure ;; we're in the same default directory! (or (not ispell-personal-dictionary) (equal ispell-process-directory default-directory))) (setq ispell-filter nil ispell-filter-continue nil) ;; may need to restart to select new personal dictionary. (ispell-kill-ispell t) (message "Starting new Ispell process...") (sit-for 0) (check-ispell-version) (setq ispell-process (let ((process-connection-type ispell-use-ptys-p)) (apply 'start-process "ispell" nil ispell-program-name "-a" ; accept single input lines "-m" ; make root/affix combos not in dict (let (args) ;; Local dictionary becomes the global dictionary in use. (if ispell-local-dictionary (setq ispell-dictionary ispell-local-dictionary)) (setq args (ispell-get-ispell-args)) (if ispell-dictionary ; use specified dictionary (setq args (append (list "-d" ispell-dictionary) args))) (if ispell-personal-dictionary ; use specified pers dict (setq args (append args (list "-p" (expand-file-name ispell-personal-dictionary))))) (setq args (append args ispell-extra-args)) args))) ispell-filter nil ispell-filter-continue nil ispell-process-directory default-directory) (set-process-filter ispell-process 'ispell-filter) (accept-process-output ispell-process) ; Get version ID line (cond ((null ispell-filter) (error "%s did not output version line" ispell-program-name)) ((and (stringp (car ispell-filter)) (if (string-match "warning: " (car ispell-filter)) (progn (accept-process-output ispell-process 5) ; 1st was warn msg. (stringp (car ispell-filter))) (null (cdr ispell-filter))) (string-match "^@(#) " (car ispell-filter))) ;; got the version line as expected (we already know it's the right ;; version, so don't bother checking again.) nil) (t ;; Otherwise, it must be an error message. Show the user. ;; But first wait to see if some more output is going to arrive. ;; Otherwise we get cool errors like "Can't open ". (sleep-for 1) (accept-process-output) (error "%s" (mapconcat 'identity ispell-filter "\n")))) (setq ispell-filter nil) ; Discard version ID line (let ((extended-char-mode (ispell-get-extended-character-mode))) (if extended-char-mode (process-send-string ispell-process (concat extended-char-mode "\n")))) (process-kill-without-query ispell-process))) ;;;###autoload (defun ispell-kill-ispell (&optional no-error) "Kill current Ispell process (so that you may start a fresh one). With NO-ERROR, just return non-nil if there was no Ispell running." (interactive) (if (not (and ispell-process (eq (process-status ispell-process) 'run))) (or no-error (error "There is no ispell process running!")) (kill-process ispell-process) (setq ispell-process nil) (message "Ispell process killed") nil)) ;;; ispell-change-dictionary is set in some people's hooks. Maybe this should ;;; call ispell-init-process rather than wait for a spell checking command? ;;;###autoload (defun ispell-change-dictionary (dict &optional arg) "Change `ispell-dictionary' (q.v.) and kill old Ispell process. A new one will be started as soon as necessary. By just answering RET you can find out what the current dictionary is. With prefix argument, set the default directory." (interactive (list (completing-read "Use new dictionary (RET for current, SPC to complete): " (cons (cons "default" nil) ispell-dictionary-alist) nil t) current-prefix-arg)) (if (equal dict "default") (setq dict nil)) ;; This relies on completing-read's bug of returning "" for no match (cond ((equal dict "") (message "Using %s dictionary" (or ispell-local-dictionary ispell-dictionary "default"))) ((and (equal dict ispell-dictionary) (or (null ispell-local-dictionary) (equal dict ispell-local-dictionary))) ;; Specified dictionary is the default already. No-op (and (interactive-p) (message "No change, using %s dictionary" (or dict "default")))) (t ; reset dictionary! (if (assoc dict ispell-dictionary-alist) (progn (if (or arg (null dict)) ; set default dictionary (setq ispell-dictionary dict)) (if (null arg) ; set local dictionary (setq ispell-local-dictionary dict))) (error "Illegal dictionary: %s" dict)) (ispell-kill-ispell t) (message "(Next %sIspell command will use %s dictionary)" (cond ((equal ispell-local-dictionary ispell-dictionary) "") (arg "global ") (t "local ")) (or (if (or (equal ispell-local-dictionary ispell-dictionary) (null arg)) ispell-local-dictionary ispell-dictionary) "default"))))) ;;; Spelling of comments are checked when ispell-check-comments is non-nil. ;;;###autoload (defun ispell-region (reg-start reg-end) "Interactively check a region for spelling errors." (interactive "r") ; Don't flag errors on read-only bufs. (ispell-accept-buffer-local-defs) ; set up dictionary, local words, etc. (unwind-protect (save-excursion (message "Spell checking %s using %s dictionary..." (if (and (= reg-start (point-min)) (= reg-end (point-max))) (buffer-name) "region") (or ispell-dictionary "default")) ;; Returns cursor to original location. (save-window-excursion (goto-char reg-start) (let ((transient-mark-mode nil) ref-type) (while (and (not ispell-quit) (< (point) reg-end)) (let ((start (point)) (offset-change 0) (end (save-excursion (end-of-line) (min (point) reg-end))) (ispell-casechars (ispell-get-casechars)) string) (cond ; LOOK AT THIS LINE AND SKIP OR PROCESS ((eolp) ; END OF LINE, just go to next line. (forward-char 1)) ((and (null ispell-check-comments) ; SKIPPING COMMENTS comment-start ; skip comments that start on the line. (search-forward comment-start end t)) ; or found here. (if (= (- (point) start) (length comment-start)) ;; comment starts the line. Skip entire line or region (if (string= "" comment-end) ; skip to next line (beginning-of-line 2) ; or jump to comment end. (search-forward comment-end reg-end 'limit)) ;; Comment later in line. Check spelling before comment. (let ((limit (- (point) (length comment-start)))) (goto-char (1- limit)) (if (looking-at "\\\\") ; "quoted" comment, don't skip ;; quoted comment. Skip over comment-start (if (= start (1- limit)) (setq limit (+ limit (length comment-start))) (setq limit (1- limit)))) (goto-char start) ;; Only check when "casechars" or math before comment (if (or (re-search-forward ispell-casechars limit t) (re-search-forward "[][()$]" limit t)) (setq string (concat "^" (buffer-substring start limit) "\n") offset-change (- offset-change ispell-offset))) (goto-char limit)))) ((looking-at "[---#@*+!%~^]") ; SKIP SPECIAL ISPELL CHARACTERS (forward-char 1)) ((or (and ispell-skip-tib ; SKIP TIB REFERENCES OR SGML MARKUP (re-search-forward ispell-tib-ref-beginning end t) (setq ref-type 'tib)) (and ispell-skip-sgml (search-forward "[<&]" end t) (setq ref-type 'sgml))) (if (or (and (eq 'tib ref-type) ; tib tag is 2 chars. (= (- (point) 2) start)) (and (eq 'sgml ref-type) ; sgml skips 1 char. (= (- (point) 1) start))) ;; Skip to end of reference, not necessarily on this line ;; Return an error if tib/sgml reference not found (if (or (and (eq 'tib ref-type) (not (re-search-forward ispell-tib-ref-end reg-end t))) (and (eq 'sgml ref-type) (not (search-forward "[>;]" reg-end t)))) (progn (ispell-pdict-save ispell-silently-savep) (ding) (message (concat "Open tib or SGML command. Fix buffer or set " (if (eq 'tib ref-type) "ispell-skip-tib" "ispell-skip-sgml") " to nil")) ;; keep cursor at error location (setq ispell-quit (- (point) 2)))) ;; Check spelling between reference and start of the line. (let ((limit (- (point) (if (eq 'tib ref-type) 2 1)))) (goto-char start) (if (or (re-search-forward ispell-casechars limit t) (re-search-forward "[][()$]" limit t)) (setq string (concat "^" (buffer-substring start limit) "\n") offset-change (- offset-change ispell-offset))) (goto-char limit)))) ((or (re-search-forward ispell-casechars end t) ; TEXT EXISTS (re-search-forward "[][()$]" end t)) ; or MATH COMMANDS (setq string (concat "^" (buffer-substring start end) "\n") offset-change (- offset-change ispell-offset)) (goto-char end)) (t (beginning-of-line 2))) ; EMPTY LINE, skip it. (setq end (point)) ; "end" tracks end of region to check. (if string ; there is something to spell! (let (poss) ;; send string to spell process and get input. (process-send-string ispell-process string) (while (progn (accept-process-output ispell-process) ;; Last item of output contains a blank line. (not (string= "" (car ispell-filter))))) ;; parse all inputs from the stream one word at a time. ;; Place in FIFO order and remove the blank item. (setq ispell-filter (nreverse (cdr ispell-filter))) (while (and (not ispell-quit) ispell-filter) (setq poss (ispell-parse-output (car ispell-filter))) (if (listp poss) ; spelling error occurred. (let* ((word-start (+ start offset-change (car (cdr poss)))) (word-end (+ word-start (length (car poss)))) replace) (goto-char word-start) ;; Adjust the horizontal scroll & point (ispell-horiz-scroll) (goto-char word-end) (ispell-horiz-scroll) (goto-char word-start) (ispell-horiz-scroll) (if (/= word-end (progn (search-forward (car poss) word-end t) (point))) ;; This occurs due to filter pipe problems (error (concat "Ispell misalignment: word " "`%s' point %d; please retry") (car poss) word-start)) (if (not (pos-visible-in-window-p)) (sit-for 0)) (if ispell-keep-choices-win (setq replace (ispell-command-loop (car (cdr (cdr poss))) (car (cdr (cdr (cdr poss)))) (car poss) word-start word-end)) (save-window-excursion (setq replace (ispell-command-loop (car (cdr (cdr poss))) (car (cdr (cdr (cdr poss)))) (car poss) word-start word-end)))) (cond ((and replace (listp replace)) ;; REPLACEMENT WORD entered. Recheck line ;; starting with the replacement word. (setq ispell-filter nil string (buffer-substring word-start word-end)) (let ((change (- (length (car replace)) (length (car poss))))) ;; adjust regions (setq reg-end (+ reg-end change) offset-change (+ offset-change change))) (if (not (equal (car replace) (car poss))) (progn (delete-region word-start word-end) (insert (car replace)))) ;; I only need to recheck typed-in replacements (if (not (eq 'query-replace (car (cdr replace)))) (backward-char (length (car replace)))) (setq end (point)) ; reposition for recheck ;; when second arg exists, query-replace, saving regions (if (car (cdr replace)) (unwind-protect (save-window-excursion (set-marker ispell-query-replace-marker reg-end) ;; Assume case-replace & ;; case-fold-search correct? (query-replace string (car replace) t)) (setq reg-end (marker-position ispell-query-replace-marker)) (set-marker ispell-query-replace-marker nil)))) ((or (null replace) (equal 0 replace)) ; ACCEPT/INSERT (if (equal 0 replace) ; BUFFER-LOCAL DICT ADD (setq reg-end (ispell-add-per-file-word-list (car poss) reg-end))) ;; This avoids pointing out the word that was ;; just accepted (via 'i' or 'a') if it follows ;; on the same line. ;; Redo check following the accepted word. (if (and ispell-pdict-modified-p (listp ispell-pdict-modified-p)) ;; Word accepted. Recheck line. (setq ispell-pdict-modified-p ; update flag (car ispell-pdict-modified-p) ispell-filter nil ; discontinue check end word-start))) ; reposition loc. (replace ; STRING REPLACEMENT for this word. (delete-region word-start word-end) (insert replace) (let ((change (- (length replace) (length (car poss))))) (setq reg-end (+ reg-end change) offset-change (+ offset-change change) end (+ end change))))) (if (not ispell-quit) (message (concat "Continuing spelling check using " (or ispell-dictionary "default") " dictionary..."))) (sit-for 0))) ;; finished with line! (setq ispell-filter (cdr ispell-filter))))) (goto-char end))))) (not ispell-quit)) ;; protected (if (get-buffer ispell-choices-buffer) (kill-buffer ispell-choices-buffer)) (if ispell-quit (progn ;; preserve or clear the region for ispell-continue. (if (not (numberp ispell-quit)) (set-marker ispell-region-end nil) ;; Enable ispell-continue. (set-marker ispell-region-end reg-end) (goto-char ispell-quit)) ;; Check for aborting (if (and ispell-checking-message (numberp ispell-quit)) (progn (setq ispell-quit nil) (error "Message send aborted."))) (setq ispell-quit nil)) (set-marker ispell-region-end nil) ;; Only save if successful exit. (ispell-pdict-save ispell-silently-savep) (message "Spell-checking done")))) ;;;###autoload (defun ispell-buffer () "Check the current buffer for spelling errors interactively." (interactive) (ispell-region (point-min) (point-max))) ;;;###autoload (defun ispell-continue () (interactive) "Continue a spelling session after making some changes." (if (not (marker-position ispell-region-end)) (message "No session to continue. Use 'X' command when checking!") (if (not (equal (marker-buffer ispell-region-end) (current-buffer))) (message "Must continue ispell from buffer %s" (buffer-name (marker-buffer ispell-region-end))) (ispell-region (point) (marker-position ispell-region-end))))) ;;; Horizontal scrolling (defun ispell-horiz-scroll () "Places point within the horizontal visibility of its window area." (if truncate-lines ; display truncating lines? ;; See if display needs to be scrolled. (let ((column (- (current-column) (max (window-hscroll) 1)))) (if (and (< column 0) (> (window-hscroll) 0)) (scroll-right (max (- column) 10)) (if (>= column (- (window-width) 2)) (scroll-left (max (- column (window-width) -3) 10))))))) ;;; Interactive word completion. ;;; Forces "previous-word" processing. Do we want to make this selectable? ;;;###autoload (defun ispell-complete-word (&optional interior-frag) "Look up word before or under point in dictionary (see lookup-words command) and try to complete it. If optional INTERIOR-FRAG is non-nil then the word may be a character sequence inside of a word. Standard ispell choices are then available." (interactive "P") (let ((cursor-location (point)) case-fold-search (word (ispell-get-word nil "\\*")) ; force "previous-word" processing. start end possibilities replacement) (setq start (car (cdr word)) end (car (cdr (cdr word))) word (car word) possibilities (or (string= word "") ; Will give you every word (lookup-words (concat (if interior-frag "*") word "*") ispell-complete-word-dict))) (cond ((eq possibilities t) (message "No word to complete")) ((null possibilities) (message "No match for \"%s\"" word)) (t ; There is a modification... (cond ; Try and respect case of word. ((string-match "^[^A-Z]+$" word) (setq possibilities (mapcar 'downcase possibilities))) ((string-match "^[^a-z]+$" word) (setq possibilities (mapcar 'upcase possibilities))) ((string-match "^[A-Z]" word) (setq possibilities (mapcar 'capitalize possibilities)))) (save-window-excursion (setq replacement (ispell-command-loop possibilities nil word start end))) (cond ((equal 0 replacement) ; BUFFER-LOCAL ADDITION (ispell-add-per-file-word-list word)) (replacement ; REPLACEMENT WORD (delete-region start end) (setq word (if (atom replacement) replacement (car replacement)) cursor-location (+ (- (length word) (- end start)) cursor-location)) (insert word) (if (not (atom replacement)) ; recheck spelling of replacement. (progn (goto-char cursor-location) (ispell-word nil t))))) (if (get-buffer ispell-choices-buffer) (kill-buffer ispell-choices-buffer)))) (ispell-pdict-save ispell-silently-savep) (goto-char cursor-location))) ;;;###autoload (defun ispell-complete-word-interior-frag () "Completes word matching character sequence inside a word." (interactive) (ispell-complete-word t)) ;;; ********************************************************************** ;;; Ispell Minor Mode ;;; ********************************************************************** (defvar ispell-minor-mode nil "Non-nil if Ispell minor mode is enabled.") ;; Variable indicating that ispell minor mode is active. (make-variable-buffer-local 'ispell-minor-mode) (or (assq 'ispell-minor-mode minor-mode-alist) (setq minor-mode-alist (cons '(ispell-minor-mode " Spell") minor-mode-alist))) (defvar ispell-minor-keymap (let ((map (make-sparse-keymap))) (define-key map " " 'ispell-minor-check) (define-key map "\r" 'ispell-minor-check) map) "Keymap used for Ispell minor mode.") (or (not (boundp 'minor-mode-map-alist)) (assoc 'ispell-minor-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'ispell-minor-mode ispell-minor-keymap) minor-mode-map-alist))) ;;;###autoload (defun ispell-minor-mode (&optional arg) "Toggle Ispell minor mode. With prefix arg, turn Ispell minor mode on iff arg is positive. In Ispell minor mode, pressing SPC or RET warns you if the previous word is incorrectly spelled." (interactive "P") (setq ispell-minor-mode (not (or (and (null arg) ispell-minor-mode) (<= (prefix-numeric-value arg) 0)))) (force-mode-line-update)) (defun ispell-minor-check () ;; Check previous word then continue with the normal binding of this key. (interactive "*") (let ((ispell-minor-mode nil) (ispell-check-only t)) (save-restriction (narrow-to-region (point-min) (point)) (ispell-word nil t)) (call-interactively (key-binding (this-command-keys))))) ;;; ********************************************************************** ;;; Ispell Message ;;; ********************************************************************** ;;; Original from D. Quinlan, E. Bradford, A. Albert, and M. Ernst (defvar ispell-message-text-end (mapconcat (function identity) '( ;; Matches postscript files. "^%!PS-Adobe-[123].0" ;; Matches uuencoded text "^begin [0-9][0-9][0-9] .*\nM.*\nM.*\nM" ;; Matches shell files (esp. auto-decoding) "^#! /bin/[ck]?sh" ;; Matches context difference listing "\\(diff -c .*\\)?\n\\*\\*\\* .*\n--- .*\n\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*" ;; Matches reporter.el bug report "^current state:\n==============\n" ;; Matches "----------------- cut here" ;; and "------- Start of forwarded message" "^[-=_]+\\s ?\\(cut here\\|Start of forwarded message\\)") "\\|") "*End of text which will be checked in ispell-message. If it is a string, limit at first occurrence of that regular expression. Otherwise, it must be a function which is called to get the limit.") (defvar ispell-message-start-skip (mapconcat (function identity) '( ;; Matches forwarded messages "^---* Forwarded Message" ;; Matches PGP Public Key block "^---*BEGIN PGP [A-Z ]*--*" ) "\\|") "Spelling is skipped inside these start/end groups by ispell-message. Assumed that blocks are not mutually inclusive.") (defvar ispell-message-end-skip (mapconcat (function identity) '( ;; Matches forwarded messages "^--- End of Forwarded Message" ;; Matches PGP Public Key block "^---*END PGP [A-Z ]*--*" ) "\\|") "Spelling is skipped inside these start/end groups by ispell-message. Assumed that blocks are not mutually inclusive.") ;;;###autoload (defun ispell-message () "Check the spelling of a mail message or news post. Don't check spelling of message headers except the Subject field. Don't check included messages. To abort spell checking of a message REGION and send the message anyway, use the `x' or `q' command. (Any subsequent regions will be checked.) The `X' command aborts the message send so that you can edit the buffer. To spell-check whenever a message is sent, include the appropriate lines in your .emacs file: (add-hook 'news-inews-hook 'ispell-message) (add-hook 'mail-send-hook 'ispell-message) (add-hook 'mh-before-send-letter-hook 'ispell-message) You can bind this to the key C-c i in GNUS or mail by adding to `news-reply-mode-hook' or `mail-mode-hook' the following lambda expression: (function (lambda () (local-set-key \"\\C-ci\" 'ispell-message)))" (interactive) (save-excursion (goto-char (point-min)) (let* ((internal-messagep (save-excursion (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t))) (limit (copy-marker (cond ((not ispell-message-text-end) (point-max)) ((char-or-string-p ispell-message-text-end) (if (re-search-forward ispell-message-text-end nil t) (match-beginning 0) (point-max))) (t (min (point-max) (funcall ispell-message-text-end)))))) (cite-regexp ;Prefix of inserted text (cond ((featurep 'supercite) ; sc 3.0 (concat "\\(" (sc-cite-regexp) "\\)" "\\|" (ispell-non-empty-string sc-reference-tag-string))) ((featurep 'sc) ; sc 2.3 (concat "\\(" sc-cite-regexp "\\)" "\\|" (ispell-non-empty-string sc-reference-tag-string))) ((equal major-mode 'news-reply-mode) ;GNUS (concat "In article <" "\\|" (if mail-yank-prefix (ispell-non-empty-string mail-yank-prefix) "^ \\|^\t"))) ((equal major-mode 'mh-letter-mode) ; mh mail message (ispell-non-empty-string mh-ins-buf-prefix)) ((not internal-messagep) ; Assume n sent us this message. (concat "In [a-zA-Z.]+ you write:" "\\|" "In <[^,;&+=]+> [^,;&+=]+ writes:" "\\|" " *> *")) ((boundp 'vm-included-text-prefix) ; VM mail message (concat "[^,;&+=]+ writes:" "\\|" (ispell-non-empty-string vm-included-text-prefix))) (mail-yank-prefix ; vanilla mail message. (ispell-non-empty-string mail-yank-prefix)) (t "^ \\|^\t"))) (cite-regexp-start (concat "^[ \t]*$\\|" cite-regexp)) (cite-regexp-end (concat "^\\(" cite-regexp "\\)")) (old-case-fold-search case-fold-search) (case-fold-search t) (ispell-checking-message t)) (goto-char (point-min)) ;; Skip header fields except Subject: without Re:'s ;;(search-forward mail-header-separator nil t) (while (if internal-messagep (< (point) internal-messagep) (and (looking-at "[a-zA-Z---]+:\\|\t\\| ") (not (eobp)))) (if (looking-at "Subject: *") ; Spell check new subject fields (progn (goto-char (match-end 0)) (if (and (not (looking-at ".*Re\\>")) (not (looking-at "\\["))) (let ((case-fold-search old-case-fold-search)) (ispell-region (point) (progn (end-of-line) (while (looking-at "\n[ \t]") (end-of-line 2)) (point))))))) (forward-line 1)) (setq case-fold-search nil) ;; Skip mail header, particularly for non-english languages. (if (looking-at (concat (regexp-quote mail-header-separator) "$")) (forward-line 1)) (while (< (point) limit) ;; Skip across text cited from other messages. (while (and (looking-at cite-regexp-start) (< (point) limit) (zerop (forward-line 1)))) (if (< (point) limit) (let* ((start (point)) ;; Check the next batch of lines that *aren't* cited. (end-c (and (re-search-forward cite-regexp-end limit 'end) (match-beginning 0))) ;; Skip a block of included text. (end-fwd (and (goto-char start) (re-search-forward ispell-message-start-skip limit 'end) (progn (beginning-of-line) (point)))) (end (or (and end-c end-fwd (min end-c end-fwd)) end-c end-fwd ;; defalut to limit of text. (marker-position limit)))) (goto-char start) (ispell-region start end) (if (and end-fwd (= end end-fwd)) (progn (goto-char end) (re-search-forward ispell-message-end-skip limit 'end)) (goto-char end))))) (set-marker limit nil)))) (defun ispell-non-empty-string (string) (if (or (not string) (string-equal string "")) "\\'\\`" ; An unmatchable string if string is null. (regexp-quote string))) ;;; ********************************************************************** ;;; Buffer Local Functions ;;; ********************************************************************** (defun ispell-accept-buffer-local-defs () "Load all buffer-local information, restarting ispell when necessary." (ispell-buffer-local-dict) ; May kill ispell-process. (ispell-buffer-local-words) ; Will initialize ispell-process. (ispell-buffer-local-parsing)) (defun ispell-buffer-local-parsing () "Place Ispell into parsing mode for this buffer. Overrides the default parsing mode. Includes latex/nroff modes and extended character mode." ;; (ispell-init-process) must already be called. (process-send-string ispell-process "!\n") ; Put process in terse mode. ;; We assume all major modes with "tex-mode" in them should use latex parsing (if (or (and (eq ispell-parser 'use-mode-name) (string-match "[Tt][Ee][Xx]-mode" (symbol-name major-mode))) (eq ispell-parser 'tex)) (process-send-string ispell-process "+\n") ; set ispell mode to tex (process-send-string ispell-process "-\n")) ; set mode to normal (nroff) ;; Hard-wire test for SGML & HTML mode. (setq ispell-skip-sgml (memq major-mode '(sgml-mode html-mode))) ;; Set default extended character mode for given buffer, if any. (let ((extended-char-mode (ispell-get-extended-character-mode))) (if extended-char-mode (process-send-string ispell-process (concat extended-char-mode "\n")))) ;; Set buffer-local parsing mode and extended character mode, if specified. (save-excursion (goto-char (point-min)) ;; Uses last valid definition (while (search-forward ispell-parsing-keyword nil t) (let ((end (save-excursion (end-of-line) (point))) (case-fold-search t) string) (while (re-search-forward " *\\([^ \"]+\\)" end t) ;; space separated definitions. (setq string (buffer-substring (match-beginning 1) (match-end 1))) (cond ((string-match "latex-mode" string) (process-send-string ispell-process "+\n~tex\n")) ((string-match "nroff-mode" string) (process-send-string ispell-process "-\n~nroff")) ((string-match "~" string) ; Set extended character mode. (process-send-string ispell-process (concat string "\n"))) (t (message "Illegal Ispell Parsing argument!") (sit-for 2)))))))) ;;; Can kill the current ispell process (defun ispell-buffer-local-dict () "Initializes local dictionary. When a dictionary is defined in the buffer (see variable `ispell-dictionary-keyword'), it will override the local setting from \\[ispell-change-dictionary]. Both should not be used to define a buffer-local dictionary." (save-excursion (goto-char (point-min)) (let (end) ;; Override the local variable definition. ;; Uses last valid definition. (while (search-forward ispell-dictionary-keyword nil t) (setq end (save-excursion (end-of-line) (point))) (if (re-search-forward " *\\([^ \"]+\\)" end t) (setq ispell-local-dictionary (buffer-substring (match-beginning 1) (match-end 1))))) (goto-char (point-min)) (while (search-forward ispell-pdict-keyword nil t) (setq end (save-excursion (end-of-line) (point))) (if (re-search-forward " *\\([^ \"]+\\)" end t) (setq ispell-local-pdict (buffer-substring (match-beginning 1) (match-end 1))))))) ;; Reload if new personal dictionary defined. (if (and ispell-local-pdict (not (equal ispell-local-pdict ispell-personal-dictionary))) (progn (ispell-kill-ispell t) (setq ispell-personal-dictionary ispell-local-pdict))) ;; Reload if new dictionary defined. (if (and ispell-local-dictionary (not (equal ispell-local-dictionary ispell-dictionary))) (ispell-change-dictionary ispell-local-dictionary))) (defun ispell-buffer-local-words () "Loads the buffer-local dictionary in the current buffer." (if (and ispell-buffer-local-name (not (equal ispell-buffer-local-name (buffer-name)))) (progn (ispell-kill-ispell t) (setq ispell-buffer-local-name nil))) (ispell-init-process) (save-excursion (goto-char (point-min)) (while (search-forward ispell-words-keyword nil t) (or ispell-buffer-local-name (setq ispell-buffer-local-name (buffer-name))) (let ((end (save-excursion (end-of-line) (point))) string) ;; buffer-local words separated by a space, and can contain ;; any character other than a space. (while (re-search-forward " *\\([^ ]+\\)" end t) (setq string (buffer-substring (match-beginning 1) (match-end 1))) (process-send-string ispell-process (concat "@" string "\n"))))))) ;;; returns optionally adjusted region-end-point. (defun ispell-add-per-file-word-list (word &optional reg-end) "Adds new word to the per-file word list." (or ispell-buffer-local-name (setq ispell-buffer-local-name (buffer-name))) (if (null reg-end) (setq reg-end 0)) (save-excursion (goto-char (point-min)) (let (case-fold-search line-okay search done string) (while (not done) (setq search (search-forward ispell-words-keyword nil 'move) line-okay (< (+ (length word) 1 ; 1 for space after word.. (progn (end-of-line) (current-column))) 80)) (if (or (and search line-okay) (null search)) (progn (setq done t) (if (null search) (progn (open-line 1) (setq string (concat comment-start " " ispell-words-keyword)) ;; in case the keyword is in the middle of the file.... (if (> reg-end (point)) (setq reg-end (+ reg-end (length string)))) (insert string) (if (and comment-end (not (equal "" comment-end))) (save-excursion (open-line 1) (forward-line 1) (insert comment-end))))) (if (> reg-end (point)) (setq reg-end (+ 1 reg-end (length word)))) (insert (concat " " word))))))) reg-end) (defconst ispell-version "2.37 -- Tue Jun 13 12:05:28 EDT 1995") (provide 'ispell) ;;; LOCAL VARIABLES AND BUFFER-LOCAL VALUE EXAMPLES. ;;; Local Variable options: ;;; mode: name(-mode) ;;; eval: expression ;;; local-variable: value ;;; The following sets the buffer local dictionary to english! ;;; Local Variables: ;;; mode: emacs-lisp ;;; comment-column: 40 ;;; ispell-local-dictionary: "english" ;;; End: ;;; MORE EXAMPLES OF ISPELL BUFFER-LOCAL VALUES ;;; The following places this file in nroff parsing and extended char modes. ;;; Local IspellParsing: nroff-mode ~nroff ;;; Change IspellDict to IspellDict: to enable the following line. ;;; Local IspellDict english ;;; Change IspellPersDict to IspellPersDict: to enable the following line. ;;; Local IspellPersDict ~/.ispell_lisp ;;; The following were automatically generated by ispell using the 'A' command: ; LocalWords: ispell ispell-highlight-p ispell-check-comments query-replace ; LocalWords: ispell-query-replace-choices ispell-skip-tib non-nil tib ; LocalWords: regexps ispell-tib-ref-beginning ispell-tib-ref-end ;; ispell.el ends here emacs-19.30/lisp/ispell4.el100444 75424 1 114134 5760501036 14215 0ustar kwzhdaemon;;; ispell.el --- this is the GNU EMACS interface to GNU ISPELL version 4. ;;Copyright (C) 1990, 1991, 1993 Free Software Foundation, Inc. ;; Keywords: wp ;;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 package provides a graceful interface to ispell, the GNU ;; spelling checker. ;;; Code: (defvar ispell-have-new-look t "Non-nil means use the `-r' option when running `look'.") (defvar ispell-enable-tex-parser nil "Non-nil enables experimental TeX parser in Ispell for TeX-mode buffers.") (defvar ispell-process nil "The process running Ispell") (defvar ispell-next-message nil "An integer: where in `*ispell*' buffer to find next message from Ispell.") (defvar ispell-command "ispell" "Command for running Ispell.") (defvar ispell-command-options nil "*String (or list of strings) to pass to Ispell as command arguments. You can specify your private dictionary via the -p option. The -S option is always passed to Ispell as the last parameter, and need not be mentioned here.") (defvar ispell-look-command "look" "*Command for running look.") ;Each marker in this list points to the start of a word that ;ispell thought was bad last time it did the :file command. ;Notice that if the user accepts or inserts a word into his ;private dictionary, then some "good" words will be on the list. ;We would like to deal with this by looking up the words again just before ;presenting them to the user, but that is too slow on machines ;without the select system call. Therefore, see the variable ;ispell-recently-accepted. (defvar ispell-bad-words nil "A list of markers reflecting the output of the Ispell `:file' command.") ;list of words that the user has accepted, but that might still ;be on the bad-words list (defvar ispell-recently-accepted nil) ;; 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 (defvar ispell-dump-needed nil) (defun ispell-flush-bad-words () (while ispell-bad-words (if (markerp (car ispell-bad-words)) (set-marker (car ispell-bad-words) nil)) (setq ispell-bad-words (cdr ispell-bad-words))) (setq ispell-recently-accepted nil)) (defun kill-ispell () "Kill the Ispell process. Any changes in your private dictionary that have not already been dumped will be lost." (interactive) (if ispell-process (delete-process ispell-process)) (setq ispell-process nil) (ispell-flush-bad-words)) (put 'ispell-startup-error 'error-conditions '(ispell-startup-error error)) (put 'ispell-startup-error 'error-message "Problem starting ispell - see buffer *ispell*") ;; Start an ispell subprocess; check the version; and display the greeting. (defun start-ispell () (message "Starting ispell ...") (let ((buf (get-buffer "*ispell*"))) (if buf (kill-buffer buf))) (condition-case err (setq ispell-process (apply 'start-process "ispell" "*ispell*" ispell-command (append (if (listp ispell-command-options) ispell-command-options (list ispell-command-options)) '("-S")))) (file-error (signal 'ispell-startup-error nil))) (process-kill-without-query ispell-process) (buffer-disable-undo (process-buffer ispell-process)) (accept-process-output ispell-process) (let (last-char) (save-excursion (set-buffer (process-buffer ispell-process)) (bury-buffer (current-buffer)) (setq last-char (- (point-max) 1)) (while (not (eq (char-after last-char) ?=)) (cond ((not (eq (process-status ispell-process) 'run)) (kill-ispell) (signal 'ispell-startup-error nil))) (accept-process-output ispell-process) (setq last-char (- (point-max) 1))) (goto-char (point-min)) (let ((greeting (read (current-buffer)))) (if (not (= (car greeting) 1)) (error "Bad ispell version: wanted 1, got %d" (car greeting))) (message (car (cdr greeting)))) (delete-region (point-min) last-char)))) ;; Make sure ispell is ready for a command. ;; Leaves buffer set to *ispell*, point at '='. (defun ispell-sync (intr) (if (or (null ispell-process) (not (eq (process-status ispell-process) 'run))) (start-ispell)) (if intr (interrupt-process ispell-process)) (let (last-char) (set-buffer (process-buffer ispell-process)) (bury-buffer (current-buffer)) (setq last-char (- (point-max) 1)) (while (not (eq (char-after last-char) ?=)) (accept-process-output ispell-process) (setq last-char (- (point-max) 1))) (goto-char last-char))) ;; Send a command to ispell. Choices are: ;; ;; WORD Check spelling of WORD. Result is ;; ;; nil not found ;; t spelled ok ;; list of strings near misses ;; ;; :file FILENAME scan the named file, and print the file offsets of ;; any misspelled words ;; ;; :insert WORD put word in private dictionary ;; ;; :accept WORD don't complain about word any more this session ;; ;; :dump write out the current private dictionary, if necessary. ;; ;; :reload reread private dictionary (default: `~/ispell.words') ;; ;; :tex ;; :troff ;; :generic set type of parser to use when scanning whole files (defun ispell-cmd (&rest strings) (save-excursion (ispell-sync t) (set-buffer (process-buffer ispell-process)) (bury-buffer (current-buffer)) (erase-buffer) (setq ispell-next-message (point-min)) (while strings (process-send-string ispell-process (car strings)) (setq strings (cdr strings))) (process-send-string ispell-process "\n") (accept-process-output ispell-process) (ispell-sync nil))) (defun ispell-dump () (cond (ispell-dump-needed (setq ispell-dump-needed nil) (ispell-cmd ":dump")))) (defun ispell-insert (word) (ispell-cmd ":insert " word) (if ispell-bad-words (setq ispell-recently-accepted (cons word ispell-recently-accepted))) (setq ispell-dump-needed t)) (defun ispell-accept (word) (ispell-cmd ":accept " word) (if ispell-bad-words (setq ispell-recently-accepted (cons word ispell-recently-accepted)))) ;; Return the next message sent by the Ispell subprocess. (defun ispell-next-message () (save-excursion (set-buffer (process-buffer ispell-process)) (bury-buffer (current-buffer)) (save-restriction (goto-char ispell-next-message) (narrow-to-region (point) (progn (forward-sexp 1) (point))) (setq ispell-next-message (point)) (goto-char (point-min)) (read (current-buffer))))) (defun ispell-tex-buffer-p () (memq major-mode '(plain-tex-mode latex-mode slitex-mode))) (defvar ispell-menu-map (make-sparse-keymap "Spell")) (defalias 'ispell-menu-map ispell-menu-map) (define-key ispell-menu-map [ispell-complete-word-interior-frag] '("Complete Interior Fragment" . ispell-complete-word-interior-frag)) (define-key ispell-menu-map [ispell-complete-word] '("Complete Word" . ispell-complete-word)) (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-message] '("Check Message" . ispell-message)) (define-key ispell-menu-map [ispell-word] '("Check Word" . ispell-word)) (define-key ispell-menu-map [ispell-region] '("Check Region" . ispell-region)) (define-key ispell-menu-map [ispell-buffer] '("Check Buffer" . ispell)) ;;;autoload (defun ispell (&optional buf start end) "Run Ispell over current buffer's visited file. First the file is scanned for misspelled words, then Ispell enters a loop with the following commands for every misspelled word: DIGIT Near miss selector. If the misspelled word is close to some words in the dictionary, they are offered as near misses. r Replace. Replace the word with a string you type. Each word of your new string is also checked. i Insert. Insert this word in your private dictionary (by default, `$HOME/ispell.words'). a Accept. Accept this word for the rest of this editing session, but don't put it in your private dictionary. l Lookup. Look for a word in the dictionary by fast binary search, or search for a regular expression in the dictionary using grep. SPACE Accept the word this time, but complain if it is seen again. q, \\[keyboard-quit] Leave the command loop. You can come back later with \\[ispell-next]." (interactive) (if (null start) (setq start 0)) (if (null end) (setq end 0)) (if (null buf) (setq buf (current-buffer))) (setq buf (get-buffer buf)) (if (null buf) (error "Can't find buffer")) ;; 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) (let ((filename buffer-file-name) (delete-temp nil)) (unwind-protect (progn (cond ((or (null filename) (find-file-name-handler buffer-file-name nil)) (setq filename (make-temp-name "/usr/tmp/ispell")) (setq delete-temp t) (write-region (point-min) (point-max) filename)) ((and (buffer-modified-p buf) (y-or-n-p (format "Save file %s? " filename))) (save-buffer))) (message "Ispell scanning file...") (if (and ispell-enable-tex-parser (ispell-tex-buffer-p)) (ispell-cmd ":tex") (ispell-cmd ":generic")) (ispell-cmd (format ":file %s %d %d" filename start end))) (if delete-temp (condition-case () (delete-file filename) (file-error nil))))) (message "Parsing ispell output ...") (ispell-flush-bad-words) (let (pos bad-words) (while (numberp (setq pos (ispell-next-message))) ;;ispell may check the words on the line following the end ;;of the region - therefore, don't record anything out of range (if (or (= end 0) (< pos end)) (setq bad-words (cons (set-marker (make-marker) (+ pos 1)) bad-words)))) (setq bad-words (cons pos bad-words)) (setq ispell-bad-words (nreverse bad-words)))) (cond ((not (markerp (car ispell-bad-words))) (setq ispell-bad-words nil) (message "No misspellings.") t) (t (message "Ispell parsing done.") (ispell-next)))) ;;;autoload (defalias 'ispell-buffer 'ispell) (defun ispell-next () "Resume command loop for most recent Ispell command. Return value is t unless exit is due to typing `q'." (interactive) (setq ispell-window-configuration nil) (prog1 (unwind-protect (catch 'ispell-quit ;; There used to be a save-excursion here, ;; but that was annoying: it's better if point doesn't move ;; when you type q. (let (next) (while (markerp (setq next (car ispell-bad-words))) (switch-to-buffer (marker-buffer next)) (push-mark) (ispell-point next "at saved position.") (setq ispell-bad-words (cdr ispell-bad-words)) (set-marker next nil))) t) (ispell-dehighlight) (if ispell-window-configuration (set-window-configuration ispell-window-configuration)) (cond ((null ispell-bad-words) (error "Ispell has not yet been run")) ((markerp (car ispell-bad-words)) (message (substitute-command-keys "Type \\[ispell-next] to continue"))) ((eq (car ispell-bad-words) nil) (setq ispell-bad-words nil) (message "No more misspellings (but checker was interrupted)")) ((eq (car ispell-bad-words) t) (setq ispell-bad-words nil) (message "Ispell done")) (t (setq ispell-bad-words nil) (message "Bad ispell internal list")))) (ispell-dump))) ;;;autoload (defun ispell-word (&optional resume) "Check the spelling of the word under the cursor. See the command `ispell' for more information. With a prefix argument, resume handling of the previous Ispell command." (interactive "P") (if resume (ispell-next) (condition-case err (unwind-protect (catch 'ispell-quit (save-window-excursion (ispell-point (point) "at point.")) (ispell-dump)) (ispell-dehighlight)) (ispell-startup-error (cond ((y-or-n-p "Problem starting ispell, use old-style spell instead? ") (load-library "spell") (define-key esc-map "$" 'spell-word) (spell-word))))))) ;;;autoload (define-key esc-map "$" 'ispell-word) ;;;autoload (defun ispell-region (start &optional end) "Check the spelling for all of the words in the region." (interactive "r") (ispell (current-buffer) start end)) (defun ispell-letterp (c) (and c (or (and (>= c ?A) (<= c ?Z)) (and (>= c ?a) (<= c ?z)) (>= c 128)))) (defun ispell-letter-or-quotep (c) (and c (or (and (>= c ?A) (<= c ?Z)) (and (>= c ?a) (<= c ?z)) (= c ?') (>= c 128)))) (defun ispell-find-word-start () ;;backward to a letter (if (not (ispell-letterp (char-after (point)))) (while (and (not (bobp)) (not (ispell-letterp (char-after (- (point) 1))))) (backward-char))) ;;backward to beginning of word (while (ispell-letter-or-quotep (char-after (- (point) 1))) (backward-char)) (skip-chars-forward "'")) (defun ispell-find-word-end () (while (ispell-letter-or-quotep (char-after (point))) (forward-char)) (skip-chars-backward "'")) (defun ispell-next-word () (while (and (not (eobp)) (not (ispell-letterp (char-after (point))))) (forward-char))) ;if end is nil, then do one word at start ;otherwise, do all words from the beginning of the word where ;start points, to the end of the word where end points (defun ispell-point (start message) (let ((wend (make-marker)) rescan end) ;; There used to be a save-excursion here, ;; but that was annoying: it's better if point doesn't move ;; when you type q. (goto-char start) (ispell-find-word-start) ;find correct word start (setq start (point-marker)) (ispell-find-word-end) ;now find correct end (setq end (point-marker)) ;; Do nothing if we don't find a word. (if (< start end) (while (< start end) (goto-char start) (ispell-find-word-end) ;find end of current word ;could be before 'end' if ;user typed replacement ;that is more than one word (set-marker wend (point)) (setq rescan nil) (setq word (buffer-substring start wend)) (cond ((ispell-still-bad word) ;;; This just causes confusion. -- rms. ;;; (goto-char start) ;;; (sit-for 0) (message (format "Ispell checking %s" word)) (ispell-cmd word) (let ((message (ispell-next-message))) (cond ((eq message t) (message "%s: ok" word)) ((or (null message) (consp message)) (setq rescan (ispell-command-loop word start wend message))) (t (error "unknown ispell response %s" message)))))) (cond ((null rescan) (goto-char wend) (ispell-next-word) (set-marker start (point)))))) ;;clear the choices buffer; otherwise it's hard for the user to tell ;;when we get back to the command loop (let ((buf (get-buffer "*ispell choices*"))) (cond (buf (set-buffer buf) (erase-buffer)))) (set-marker start nil) (set-marker end nil) (set-marker wend nil))) (defun ispell-still-bad (word) (let ((words ispell-recently-accepted) (ret t) (case-fold-search t)) (while words (cond ((eq (string-match (car words) word) 0) (setq ret nil) (setq words nil))) (setq words (cdr words))) ret)) (defun ispell-show-choices (word message first-line) ;;if there is only one window on the frame, make the ispell ;;messages winow be small. otherwise just use the other window (let* ((selwin (selected-window)) (resize (eq selwin (next-window))) (buf (get-buffer-create "*ispell choices*")) w) (or ispell-window-configuration (setq ispell-window-configuration (current-window-configuration))) (setq w (display-buffer buf)) (buffer-disable-undo buf) (if resize (unwind-protect (progn (select-window w) (enlarge-window (- 6 (window-height w)))) (select-window selwin))) (save-excursion (set-buffer buf) (bury-buffer buf) (set-window-point w (point-min)) (set-window-start w (point-min)) (erase-buffer) (insert first-line "\n") (insert "SPC skip; A accept; I insert; DIGIT select; R replace; \ L lookup; Q quit\n") (cond ((not (null message)) (let ((i 0)) (while (< i 3) (let ((j 0)) (while (< j 3) (let* ((n (+ (* j 3) i)) (choice (nth n message))) (cond (choice (let ((str (format "%d %s" n choice))) (insert str) (insert-char ? (- 20 (length str))))))) (setq j (+ j 1)))) (insert "\n") (setq i (+ i 1))))))))) (defun ispell-command-loop (word start end message) (let ((flag t) (rescan nil) first-line) (if (null message) (setq first-line (concat "No near misses for '" word "'")) (setq first-line (concat "Near misses for '" word "'"))) (ispell-highlight start end) (while flag (ispell-show-choices word message first-line) (message "Ispell command: ") (undo-boundary) (let ((c (downcase (read-char))) replacement) (cond ((and (>= c ?0) (<= c ?9) (setq replacement (nth (- c ?0) message))) (ispell-replace start end replacement) (setq flag nil)) ((= c ?q) (throw 'ispell-quit nil)) ((= c (nth 3 (current-input-mode))) (keyboard-quit)) ((= c ? ) (setq flag nil)) ((= c ?r) (ispell-replace start end (read-string "Replacement: ")) (setq rescan t) (setq flag nil)) ((= c ?i) (ispell-insert word) (setq flag nil)) ((= c ?a) (ispell-accept word) (setq flag nil)) ((= c ?l) (let ((val (ispell-do-look word))) (setq first-line (car val)) (setq message (cdr val)))) ((= c ??) (message "Type 'C-h d ispell' to the emacs main loop for more help") (sit-for 2)) (t (message "Bad ispell command") (sit-for 2))))) rescan)) (defun ispell-do-look (bad-word) (let (regex buf words) (cond ((null ispell-have-new-look) (setq regex (read-string "Lookup: "))) (t (setq regex (read-string "Lookup (regex): " "^")))) (setq buf (get-buffer-create "*ispell look*")) (save-excursion (set-buffer buf) (delete-region (point-min) (point-max)) (if ispell-have-new-look (call-process ispell-look-command nil buf nil "-r" regex) (call-process ispell-look-command nil buf nil regex)) (goto-char (point-min)) (forward-line 10) (delete-region (point) (point-max)) (goto-char (point-min)) (while (not (= (point-min) (point-max))) (end-of-line) (setq words (cons (buffer-substring (point-min) (point)) words)) (forward-line) (delete-region (point-min) (point))) (kill-buffer buf) (cons (format "Lookup '%s'" regex) (reverse words))))) (defun ispell-replace (start end new) (goto-char start) (insert new) (delete-region (point) end)) (defun reload-ispell () "Tell Ispell to re-read your private dictionary." (interactive) (ispell-cmd ":reload")) (defun batch-make-ispell () (byte-compile-file "ispell.el") (find-file "ispell.texinfo") (let ((old-dir default-directory) (default-directory "/tmp")) (texinfo-format-buffer)) (Info-validate) (if (get-buffer " *problems in info file*") (kill-emacs 1)) (write-region (point-min) (point-max) "ispell.info")) (defvar ispell-highlight t "*Non-nil means to highlight ispell words.") (defvar ispell-overlay nil) (defun ispell-dehighlight () (and ispell-overlay (progn (delete-overlay ispell-overlay) (setq ispell-overlay nil)))) (defun ispell-highlight (start end) (and ispell-highlight window-system (progn (or ispell-overlay (progn (setq ispell-overlay (make-overlay start end)) (overlay-put ispell-overlay 'face (if (internal-find-face 'ispell) 'ispell 'region)))) (move-overlay ispell-overlay start end (current-buffer))))) ;;;; ispell-complete-word ;;; Brief Description: ;;; Complete word fragment at point using dictionary and replace with full ;;; word. Expansion done in current buffer like lisp-complete-symbol. ;;; Completion of interior word fragments possible with prefix argument. ;;; Known Problem: ;;; Does not use private dictionary because GNU `look' does not use it. It ;;; would be nice if GNU `look' took standard input; this would allow gzip'ed ;;; dictionaries to be used. GNU `look' also has a bug, see ;;; `ispell-gnu-look-still-broken-p'. ;;; Motivation: ;;; The `l', "regular expression look up", keymap option of ispell-word ;;; (ispell-do-look) can only be run after finding a misspelled word. So ;;; ispell-do-look can not be used to look for words starting with `cat' to ;;; find `catechetical' since `cat' is a correctly spelled word. Furthermore, ;;; ispell-do-look does not return the entire list returned by `look'. ;;; ;;; ispell-complete-word allows you to get a completion list from the system ;;; dictionary and expand a word fragment at the current position in a buffer. ;;; These examples assume ispell-complete-word is bound to M-TAB as it is in ;;; text-mode; the `Complete Word' and `Complete Interior Fragment' entries of ;;; the "Spell" submenu under the "Edit" menu may also be used instead of ;;; M-TAB and C-u M-TAB, respectively. ;;; ;;; EXAMPLE 1: The word `Saskatchewan' needs to be spelled. The user may ;;; type `Sas' and hit M-TAB and a completion list will be built using the ;;; shell command `look' and displayed in the *Completions* buffer: ;;; ;;; Possible completions are: ;;; sash sashay ;;; sashayed sashed ;;; sashes sashimi ;;; Saskatchewan Saskatoon ;;; sass sassafras ;;; sassier sassing ;;; sasswood sassy ;;; ;;; By viewing this list the user will hopefully be motivated to insert the ;;; letter `k' after the `sas'. When M-TAB is hit again the word `Saskat' ;;; will be inserted in place of `sas' (note case) since this is a unique ;;; substring completion. The narrowed completion list can be viewed with ;;; another M-TAB ;;; ;;; Possible completions are: ;;; Saskatchewan Saskatoon ;;; ;;; Inserting the letter `c' and hitting M-TAB will narrow the completion ;;; possibilities to just `Saskatchewan' and this will be inserted in the ;;; buffer. At any point the user may click the mouse on a completion to ;;; select it. ;;; ;;; EXAMPLE 2: The user has typed `Sasaquane' and M-$ (ispell-word) gives no ;;; "near-misses" in which case you back up to `Sas' and hit M-TAB and find ;;; the correct word as above. The `Sas' will be replaced by `Saskatchewan' ;;; and the remaining word fragment `aquane' can be deleted. ;;; ;;; EXAMPLE 3: If a version of `look' is used that supports regular ;;; expressions, then `ispell-have-new-look' should be t (its default) and ;;; interior word fragments may also be used for the search. The word ;;; `pneumonia' needs to be spelled. The user can only remember the ;;; interior fragment `mon' in which case `C-u M-TAB' on `mon' gives a list ;;; of all words containing the interior word fragment `mon'. Typing `p' ;;; and M-TAB will narrow this list to all the words starting with `p' and ;;; containing `mon' from which `pneumonia' can be found as above. ;;; The user-defined variables are: ;;; ;;; ispell-look-command ;;; ispell-look-dictionary ;;; ispell-gnu-look-still-broken-p ;;; Algorithm (some similarity to lisp-complete-symbol): ;;; ;;; * call-process on command ispell-look-command (default: "look") to find ;;; words in ispell-look-dictionary matching `string' (or `regexp' if ;;; ispell-have-new-look is t). Parse output and store results in ;;; ispell-lookup-completions-alist. ;;; ;;; * Build completion list using try-completion and `string' ;;; ;;; * Replace `string' in buffer with matched common substring completion. ;;; ;;; * Display completion list only if there is no matched common substring. ;;; ;;; * Rebuild ispell-lookup-completions-alist, on a next call, only when ;;; beginning of word fragment has changed. ;;; ;;; * Interior fragments searches are performed similarly with the exception ;;; that the entire fragment at point is initially removed from the buffer, ;;; the STRING passed to try-completion and all-completions is just "" and ;;; not the interior fragment; this allows all completions containing the ;;; interior fragment to be shown. The location in the buffer is stored to ;;; decide whether future completion narrowing of the current list should be ;;; done or if a new list should be built. See interior fragment example ;;; above. ;;; ;;; * Robust searches are done using a `look' with -r (regular expression) ;;; switch if ispell-have-new-look is t. ;;;; User-defined variables. (defvar ispell-look-dictionary nil "*If non-nil then spelling dictionary as string for `ispell-complete-word'. Overrides default dictionary file such as \"/usr/dict/words\" or GNU look's \"${prefix}/lib/ispell/ispell.words\"") (defvar ispell-gnu-look-still-broken-p nil "*t if GNU look -r can give different results with and without trialing `.*'. Example: `look -dfr \"^ya\" foo' returns nothing, while `look -dfr \"^ya.*\" foo' returns `yacc', where `foo' is a dictionary file containing the three lines y y's yacc Both commands should return `yacc'. If `ispell-complete-word' erroneously states that no completions exist for a string, then setting this variable to t will help find those completions.") ;;;; Internal variables. ;;; Possible completions for last word fragment. (defvar ispell-lookup-completions-alist nil) ;;; Last word fragment processed by `ispell-complete-word'. (defvar ispell-lookup-last-word nil) ;;; Buffer local variables. ;;; Value of interior-frag in last call to `ispell-complete-word'. (defvar ispell-lookup-last-interior-p nil) (make-variable-buffer-local 'ispell-lookup-last-interior-p) (put 'ispell-lookup-last-interior-p 'permanent-local t) ;;; Buffer position in last call to `ispell-complete-word'. (defvar ispell-lookup-last-bow nil) (make-variable-buffer-local 'ispell-lookup-last-bow) (put 'ispell-lookup-last-bow 'permanent-local t) ;;;; Interactive functions. ;;;autoload (defun ispell-complete-word (&optional interior-frag) "Complete word using letters at point to word beginning using `look'. With optional argument INTERIOR-FRAG, word fragment at point is assumed to be an interior word fragment in which case `ispell-have-new-look' should be t. See also `ispell-look-dictionary' and `ispell-gnu-look-still-broken-p'." (interactive "P") ;; `look' must support regexp expressions in order to perform an interior ;; fragment search. (if (and interior-frag (not ispell-have-new-look)) (error (concat "Sorry, `ispell-have-new-look' is nil. " "You also will need GNU Ispell's `look'."))) (let* ((completion-ignore-case t) ;; Get location of beginning of word fragment. (bow (save-excursion (skip-chars-backward "a-zA-Z'") (point))) ;; Get the string to look up. (string (buffer-substring bow (point))) ;; Get regexp for which we search and, if necessary, an interior word ;; fragment. (regexp (if interior-frag (concat "^.*" string ".*") ;; If possible use fast binary search: no trailing `.*'. (concat "^" string (if ispell-gnu-look-still-broken-p ".*")))) ;; We want all completions for case of interior fragments so set ;; prefix to an empty string. (prefix (if interior-frag "" string)) ;; Are we continuing from a previous interior fragment search? ;; Check last value of interior-word and if the point has moved. (continuing-an-interior-frag-p (and ispell-lookup-last-interior-p (equal ispell-lookup-last-bow bow))) ;; Are we starting a unique word fragment search? Always t for ;; interior word fragment search. (new-unique-string-p (or interior-frag (null ispell-lookup-last-word) (let ((case-fold-search t)) ;; Can we locate last word fragment as a substring of current ;; word fragment? If the last word fragment is larger than ;; the current string then we will have to rebuild the list ;; later. (not (string-match (concat "^" ispell-lookup-last-word) string))))) completion) ;; Check for perfect completion already. That is, maybe the user has hit ;; M-x ispell-complete-word one too many times? (if (string-equal string "") (if (string-equal (concat ispell-lookup-last-word " ") (buffer-substring (save-excursion (forward-word -1) (point)) (point))) (error "Perfect match already") (error "No word fragment at point"))) ;; Create list of words from system dictionary starting with `string' if ;; new string and not continuing from a previous interior fragment search. (if (and (not continuing-an-interior-frag-p) new-unique-string-p) (setq ispell-lookup-completions-alist (ispell-lookup-build-list string regexp))) ;; Check for a completion of `string' in the list and store `string' and ;; other variables for the next call. (setq completion (try-completion prefix ispell-lookup-completions-alist) ispell-lookup-last-word string ispell-lookup-last-interior-p interior-frag ispell-lookup-last-bow bow) ;; Test the completion status. (cond ;; * Guess is a perfect match. ((eq completion t) (insert " ") (message "Perfect match.")) ;; * No possibilities. ((null completion) (message "Can't find completion for \"%s\"" string) (beep)) ;; * Replace string fragment with matched common substring completion. ((and (not (string-equal completion "")) ;; Fold case so a completion list is built when `string' and common ;; substring differ only in case. (let ((case-fold-search t)) (not (string-match (concat "^" completion "$") string)))) (search-backward string bow) (replace-match completion nil t) ; FIXEDCASE doesn't work? or LITERAL? (message "Proposed unique substring. Repeat for completions list.")) ;; * String is a common substring completion already. Make list. (t (message "Making completion list...") (if (string-equal completion "") (delete-region bow (point))) (let ((list (all-completions prefix ispell-lookup-completions-alist))) (with-output-to-temp-buffer "*Completions*" (display-completion-list list))) (message "Making completion list...done"))))) ;;;autoload (defun ispell-complete-word-interior-frag () "Runs `ispell-complete-word' with a non-nil INTERIOR-FRAG. A completion list is built for word fragment at point which is assumed to be an interior word fragment. `ispell-have-new-look' should be t." (interactive) (ispell-complete-word t)) ;;;; Internal Function. ;;; Build list of words using ispell-look-command from dictionary ;;; ispell-look-dictionary (if this is a non-nil string). Look for words ;;; starting with STRING if ispell-have-new-look is nil or look for REGEXP if ;;; ispell-have-new-look is t. Returns result as an alist suitable for use by ;;; try-completion, all-completions, and completing-read. (defun ispell-lookup-build-list (string regexp) (save-excursion (message "Building list...") (set-buffer (get-buffer-create " *ispell look*")) (erase-buffer) (if (stringp ispell-look-dictionary) (if ispell-have-new-look (call-process ispell-look-command nil t nil "-fr" regexp ispell-look-dictionary) (call-process ispell-look-command nil t nil "-f" string ispell-look-dictionary)) (if ispell-have-new-look (call-process ispell-look-command nil t nil "-fr" regexp) (call-process ispell-look-command nil t nil "-f" string))) ;; Build list for try-completion and all-completions by storing each line ;; of output starting from bottom of buffer and deleting upwards. (let (list) (goto-char (point-min)) (while (not (= (point-min) (point-max))) (end-of-line) (setq list (cons (buffer-substring (point-min) (point)) list)) (forward-line) (delete-region (point-min) (point))) ;; Clean. (erase-buffer) (message "Building list...done") ;; Make the list into an alist and return. (mapcar 'list (nreverse list))))) ;; Return regexp-quote of STRING if STRING is non-empty. ;; Otherwise return an unmatchable regexp. (defun ispell-non-empty-string (string) (if (or (not string) (string-equal string "")) "\\'\\`" ; An unmatchable string if string is null. (regexp-quote string))) (defvar ispell-message-cite-regexp "^ \\|^\t" "*Regular expression to match lines cited from one message into another.") (defvar ispell-message-text-end (concat "^\\(" (mapconcat (function identity) '( ;; Matches postscript files. "%!PS-Adobe-2.0" ;; Matches uuencoded text "begin [0-9][0-9][0-9] .*\nM.*\nM.*\nM" ;; Matches shell files (esp. auto-decoding) "#! /bin/sh" ;; Matches difference listing "diff -c .*\n\\*\\*\\* .*\n--- " ;; Matches "--------------------- cut here" "[-=]+\\s cut here") "\\|") "\\)") "*End of text which will be checked in ispell-message. If it is a string, limit at first occurence of that regular expression. Otherwise, it must be a function which is called to get the limit.") (defvar ispell-message-limit (* 100 80) "*Ispell-message will check no more than this number of characters.") ;;;autoload (defun ispell-message () "Check the spelling of a mail message or news post. Don't check spelling of message headers (except subject) or included messages. To spell-check whenever a message is sent, include this line in .emacs: (setq news-inews-hook (setq mail-send-hook 'ispell-message)) Or you can bind the function to C-c i in gnus or mail with: (setq mail-mode-hook (setq news-reply-mode-hook (function (lambda () (local-set-key \"\\C-ci\" 'ispell-message)))))" (interactive) (save-excursion (let (non-internal-message (old-case-fold-search case-fold-search) (case-fold-search nil)) (goto-char (point-min)) ;; Don't spell-check the headers. (if (search-forward mail-header-separator nil t) ;; Move to first body line. (forward-line 1) (while (and (looking-at "[a-zA-Z-]+:\\|\t\\| ") (not (eobp))) (forward-line 1)) (setq non-internal-message t) ) (let* ((cite-regexp ;Prefix of inserted text (cond ((featurep 'supercite) ; sc 3.0 (concat "\\(" (sc-cite-regexp) "\\)" "\\|" (ispell-non-empty-string sc-reference-tag-string))) ((featurep 'sc) ; sc 2.3 (concat "\\(" sc-cite-regexp "\\)" "\\|" (ispell-non-empty-string sc-reference-tag-string))) (non-internal-message ; Assume nn sent us this message. (concat "In [a-zA-Z.]+ you write:" "\\|" "In <[^,;&+=]+> [^,;&+=]+ writes:" "\\|" " *> *")) ((equal major-mode 'news-reply-mode) ;Gnus (concat "In article <" "\\|" (if mail-yank-prefix (ispell-non-empty-string mail-yank-prefix) ispell-message-cite-regexp))) ((boundp 'vm-included-text-prefix) ; VM mail message (concat "[^,;&+=]+ writes:" "\\|" (ispell-non-empty-string vm-included-text-prefix) )) ((boundp 'mh-ins-buf-prefix) ; mh mail message (ispell-non-empty-string mh-ins-buf-prefix)) (mail-yank-prefix ; vanilla mail message. (ispell-non-empty-string mail-yank-prefix)) (t ispell-message-cite-regexp))) (continue t) (limit (min (+ (point-min) ispell-message-limit) (point-max) (save-excursion (cond ((not ispell-message-text-end) (point-max)) ((char-or-string-p ispell-message-text-end) (if (re-search-forward ispell-message-text-end nil 'end) (match-beginning 0) (point-max))) (t (funcall ispell-message-text-end)))))) (search-limit ; Search limit which won't stop in middle of citation (+ limit (length cite-regexp))) ) ;; Check the subject (save-excursion (let ((case-fold-search t) (message-begin (point))) (goto-char (point-min)) ;; "\\s *" matches newline if subject is empty (if (and (re-search-forward "^Subject:[\t ]*" message-begin t) (not (looking-at "re\\>"))) (setq continue (ispell-region (- (point) 1) (progn (end-of-line) (while (looking-at "\n[ \t]") (end-of-line 2)) (point)))) ))) ;; Check the body. (while (and (< (point) limit) continue) ;; Skip across text cited from other messages. (while (and (looking-at (concat "^[ \t]*$\\|" cite-regexp)) (< (point) limit)) (forward-line 1)) (if (< (point) limit) ;; Check the next batch of lines that *aren't* cited. (let ((start (point))) (if (re-search-forward (concat "^\\(" cite-regexp "\\)") search-limit 'end) (beginning-of-line)) (if (> (point) limit) (goto-char limit)) (let ((case-fold-search old-case-fold-search)) (save-excursion (setq continue (ispell-region (- start 1) (point)))))))))))) (provide 'ispell) ;;; ispell.el ends here emacs-19.30/lisp/jka-compr.el100444 12120 1 61112 6054406443 14302 0ustar rmsdaemon;;; jka-compr.el --- reading/writing/loading compressed files ;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: jka@ece.cmu.edu (Jay K. Adams) ;; Keywords: data ;; 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 package implements low-level support for reading, writing, ;;; and loading compressed files. It hooks into the low-level file ;;; I/O functions (including write-region and insert-file-contents) so ;;; that they automatically compress or uncompress a file if the file ;;; appears to need it (based on the extension of the file name). ;;; Packages like Rmail, VM, GNUS, and Info should be able to work ;;; with compressed files without modification. ;;; INSTRUCTIONS: ;;; ;;; To use jka-compr, simply load this package, and edit as usual. ;;; Its operation should be transparent to the user (except for ;;; messages appearing when a file is being compressed or ;;; uncompressed). ;;; ;;; The variable, jka-compr-compression-info-list can be used to ;;; customize jka-compr to work with other compression programs. ;;; The default value of this variable allows jka-compr to work with ;;; Unix compress and gzip. ;;; ;;; If you are concerned about the stderr output of gzip and other ;;; compression/decompression programs showing up in your buffers, you ;;; should set the discard-error flag in the compression-info-list. ;;; This will cause the stderr of all programs to be discarded. ;;; However, it also causes emacs to call compression/uncompression ;;; programs through a shell (which is specified by jka-compr-shell). ;;; This may be a drag if, on your system, starting up a shell is ;;; slow. ;;; ;;; If you don't want messages about compressing and decompressing ;;; to show up in the echo area, you can set the compress-name and ;;; decompress-name fields of the jka-compr-compression-info-list to ;;; nil. ;;; APPLICATION NOTES: ;;; ;;; crypt++ ;;; jka-compr can coexist with crpyt++ if you take all the decompression ;;; entries out of the crypt-encoding-list. Clearly problems will arise if ;;; you have two programs trying to compress/decompress files. jka-compr ;;; will not "work with" crypt++ in the following sense: you won't be able to ;;; decode encrypted compressed files--that is, files that have been ;;; compressed then encrypted (in that order). Theoretically, crypt++ and ;;; jka-compr could properly handle a file that has been encrypted then ;;; compressed, but there is little point in trying to compress an encrypted ;;; file. ;;; ;;; ACKNOWLEDGMENTS ;;; ;;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs. Many people ;;; have made helpful suggestions, reported bugs, and even fixed bugs in ;;; jka-compr. I recall the following people as being particularly helpful. ;;; ;;; Jean-loup Gailly ;;; David Hughes ;;; Richard Pieri ;;; Daniel Quinlan ;;; Chris P. Ross ;;; Rick Sladkey ;;; ;;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for ;;; Version 18 of Emacs. ;;; ;;; After I had made progress on the original jka-compr for V18, I learned of a ;;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly ;;; what I was trying to do. I looked over the jam-zcat source code and ;;; probably got some ideas from it. ;;; ;;; Code: (defvar jka-compr-shell "sh" "*Shell to be used for calling compression programs. The value of this variable only matters if you want to discard the stderr of a compression/decompression program (see the documentation for `jka-compr-compression-info-list').") (defvar jka-compr-use-shell t) ;;; I have this defined so that .Z files are assumed to be in unix ;;; compress format; and .gz files, in gzip format. (defvar jka-compr-compression-info-list ;;[regexp ;; compr-message compr-prog compr-args ;; uncomp-message uncomp-prog uncomp-args ;; can-append auto-mode-flag] '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'" "compressing" "compress" ("-c") "uncompressing" "uncompress" ("-c") nil t] ["\\.tgz\\'" "zipping" "gzip" ("-c" "-q") "unzipping" "gzip" ("-c" "-q" "-d") t nil] ["\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'" "zipping" "gzip" ("-c" "-q") "unzipping" "gzip" ("-c" "-q" "-d") t t]) "List of vectors that describe available compression techniques. Each element, which describes a compression technique, is a vector of the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS APPEND-FLAG EXTENSION], where: regexp is a regexp that matches filenames that are compressed with this format compress-msg is the message to issue to the user when doing this type of compression (nil means no message) compress-program is a program that performs this compression compress-args is a list of args to pass to the compress program uncompress-msg is the message to issue to the user when doing this type of uncompression (nil means no message) uncompress-program is a program that performs this compression uncompress-args is a list of args to pass to the uncompress program append-flag is non-nil if this compression technique can be appended auto-mode flag non-nil means strip the regexp from file names before attempting to set the mode. Because of the way `call-process' is defined, discarding the stderr output of a program adds the overhead of starting a shell each time the program is invoked.") (defvar jka-compr-mode-alist-additions (list (cons "\\.tgz\\'" 'tar-mode)) "A list of pairs to add to auto-mode-alist when jka-compr is installed.") (defvar jka-compr-file-name-handler-entry nil "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.") ;;; Functions for accessing the return value of jka-get-compression-info (defun jka-compr-info-regexp (info) (aref info 0)) (defun jka-compr-info-compress-message (info) (aref info 1)) (defun jka-compr-info-compress-program (info) (aref info 2)) (defun jka-compr-info-compress-args (info) (aref info 3)) (defun jka-compr-info-uncompress-message (info) (aref info 4)) (defun jka-compr-info-uncompress-program (info) (aref info 5)) (defun jka-compr-info-uncompress-args (info) (aref info 6)) (defun jka-compr-info-can-append (info) (aref info 7)) (defun jka-compr-info-strip-extension (info) (aref info 8)) (defun jka-compr-get-compression-info (filename) "Return information about the compression scheme of FILENAME. The determination as to which compression scheme, if any, to use is based on the filename itself and `jka-compr-compression-info-list'." (catch 'compression-info (let ((case-fold-search nil)) (mapcar (function (lambda (x) (and (string-match (jka-compr-info-regexp x) filename) (throw 'compression-info x)))) jka-compr-compression-info-list) nil))) (put 'compression-error 'error-conditions '(compression-error file-error error)) (defvar jka-compr-acceptable-retval-list '(0 2 141)) (defun jka-compr-error (prog args infile message &optional errfile) (let ((errbuf (get-buffer-create " *jka-compr-error*")) (curbuf (current-buffer))) (set-buffer errbuf) (widen) (erase-buffer) (insert (format "Error while executing \"%s %s < %s\"\n\n" prog (mapconcat 'identity args " ") infile)) (and errfile (insert-file-contents errfile)) (set-buffer curbuf) (display-buffer errbuf)) (signal 'compression-error (list "Opening input file" (format "error %s" message) infile))) (defvar jka-compr-dd-program "/bin/dd") (defvar jka-compr-dd-blocksize 256) (defun jka-compr-partial-uncompress (prog message args infile beg len) "Call program PROG with ARGS args taking input from INFILE. Fourth and fifth args, BEG and LEN, specify which part of the output to keep: LEN chars starting BEG chars from the beginning." (let* ((skip (/ beg jka-compr-dd-blocksize)) (prefix (- beg (* skip jka-compr-dd-blocksize))) (count (and len (1+ (/ (+ len prefix) jka-compr-dd-blocksize)))) (start (point)) (err-file (jka-compr-make-temp-name)) (run-string (format "%s %s 2> %s | %s bs=%d skip=%d %s 2> /dev/null" prog (mapconcat 'identity args " ") err-file jka-compr-dd-program jka-compr-dd-blocksize skip ;; dd seems to be unreliable about ;; providing the last block. So, always ;; read one more than you think you need. (if count (concat "count=" (1+ count)) "")))) (unwind-protect (or (memq (call-process jka-compr-shell infile t nil "-c" run-string) jka-compr-acceptable-retval-list) (jka-compr-error prog args infile message err-file)) (jka-compr-delete-temp-file err-file)) ;; Delete the stuff after what we want, if there is any. (and len (< (+ start prefix len) (point)) (delete-region (+ start prefix len) (point))) ;; Delete the stuff before what we want. (delete-region start (+ start prefix)))) (defun jka-compr-call-process (prog message infile output temp args) (if jka-compr-use-shell (let ((err-file (jka-compr-make-temp-name))) (unwind-protect (or (memq (call-process jka-compr-shell infile (if (stringp output) nil output) nil "-c" (format "%s %s 2> %s %s" prog (mapconcat 'identity args " ") err-file (if (stringp output) (concat "> " output) ""))) jka-compr-acceptable-retval-list) (jka-compr-error prog args infile message err-file)) (jka-compr-delete-temp-file err-file))) (or (zerop (apply 'call-process prog infile (if (stringp output) temp output) nil args)) (jka-compr-error prog args infile message)) (and (stringp output) (let ((cbuf (current-buffer))) (set-buffer temp) (write-region (point-min) (point-max) output) (erase-buffer) (set-buffer cbuf))))) ;;; Support for temp files. Much of this was inspired if not lifted ;;; from ange-ftp. (defvar jka-compr-temp-name-template "/tmp/jka-com" "Prefix added to all temp files created by jka-compr. There should be no more than seven characters after the final `/'") (defvar jka-compr-temp-name-table (make-vector 31 nil)) (defun jka-compr-make-temp-name (&optional local-copy) "This routine will return the name of a new file." (let* ((lastchar ?a) (prevchar ?a) (template (concat jka-compr-temp-name-template "aa")) (lastpos (1- (length template))) (not-done t) file entry) (while not-done (aset template lastpos lastchar) (setq file (concat (make-temp-name template) "#")) (setq entry (intern file jka-compr-temp-name-table)) (if (or (get entry 'active) (file-exists-p file)) (progn (setq lastchar (1+ lastchar)) (if (> lastchar ?z) (progn (setq prevchar (1+ prevchar)) (setq lastchar ?a) (if (> prevchar ?z) (error "Can't allocate temp file.") (aset template (1- lastpos) prevchar))))) (put entry 'active (not local-copy)) (setq not-done nil))) file)) (defun jka-compr-delete-temp-file (temp) (put (intern temp jka-compr-temp-name-table) 'active nil) (condition-case () (delete-file temp) (error nil))) (defun jka-compr-write-region (start end file &optional append visit) (let* ((filename (expand-file-name file)) (visit-file (if (stringp visit) (expand-file-name visit) filename)) (info (jka-compr-get-compression-info visit-file))) (if info (let ((can-append (jka-compr-info-can-append info)) (compress-program (jka-compr-info-compress-program info)) (compress-message (jka-compr-info-compress-message info)) (uncompress-program (jka-compr-info-uncompress-program info)) (uncompress-message (jka-compr-info-uncompress-message info)) (compress-args (jka-compr-info-compress-args info)) (uncompress-args (jka-compr-info-uncompress-args info)) (base-name (file-name-nondirectory visit-file)) temp-file cbuf temp-buffer) (setq cbuf (current-buffer) temp-buffer (get-buffer-create " *jka-compr-wr-temp*")) (set-buffer temp-buffer) (widen) (erase-buffer) (set-buffer cbuf) (if (and append (not can-append) (file-exists-p filename)) (let* ((local-copy (file-local-copy filename)) (local-file (or local-copy filename))) (setq temp-file local-file)) (setq temp-file (jka-compr-make-temp-name))) (and compress-message (message "%s %s..." compress-message base-name)) (jka-compr-run-real-handler 'write-region (list start end temp-file t 'dont)) (jka-compr-call-process compress-program (concat compress-message " " base-name) temp-file temp-buffer nil compress-args) (set-buffer temp-buffer) (jka-compr-run-real-handler 'write-region (list (point-min) (point-max) filename (and append can-append) 'dont)) (erase-buffer) (set-buffer cbuf) (jka-compr-delete-temp-file temp-file) (and compress-message (message "%s %s...done" compress-message base-name)) (cond ((eq visit t) (setq buffer-file-name filename) (set-visited-file-modtime)) ((stringp visit) (setq buffer-file-name visit) (let ((buffer-file-name filename)) (set-visited-file-modtime)))) (and (or (eq visit t) (eq visit nil) (stringp visit)) (message "Wrote %s" visit-file)) nil) (jka-compr-run-real-handler 'write-region (list start end filename append visit))))) (defun jka-compr-insert-file-contents (file &optional visit beg end replace) (barf-if-buffer-read-only) (and (or beg end) visit (error "Attempt to visit less than an entire file")) (let* ((filename (expand-file-name file)) (info (jka-compr-get-compression-info filename))) (if info (let ((uncompress-message (jka-compr-info-uncompress-message info)) (uncompress-program (jka-compr-info-uncompress-program info)) (uncompress-args (jka-compr-info-uncompress-args info)) (base-name (file-name-nondirectory filename)) (notfound nil) (local-copy (jka-compr-run-real-handler 'file-local-copy (list filename))) local-file size start) (setq local-file (or local-copy filename)) (and visit (setq buffer-file-name filename)) (unwind-protect ; to make sure local-copy gets deleted (progn (and uncompress-message (message "%s %s..." uncompress-message base-name)) (condition-case error-code (progn (if replace (goto-char (point-min))) (setq start (point)) (if (or beg end) (jka-compr-partial-uncompress uncompress-program (concat uncompress-message " " base-name) uncompress-args local-file (or beg 0) (if (and beg end) (- end beg) end)) ;; If visiting, bind off buffer-file-name so that ;; file-locking will not ask whether we should ;; really edit the buffer. (let ((buffer-file-name (if visit nil buffer-file-name))) (jka-compr-call-process uncompress-program (concat uncompress-message " " base-name) local-file t nil uncompress-args))) (setq size (- (point) start)) (if replace (let* ((del-beg (point)) (del-end (+ del-beg size))) (delete-region del-beg (min del-end (point-max))))) (goto-char start)) (error (if (and (eq (car error-code) 'file-error) (eq (nth 3 error-code) local-file)) (if visit (setq notfound error-code) (signal 'file-error (cons "Opening input file" (nthcdr 2 error-code)))) (signal (car error-code) (cdr error-code)))))) (and local-copy (file-exists-p local-copy) (delete-file local-copy))) (and visit (progn (unlock-buffer) (setq buffer-file-name filename) (set-visited-file-modtime))) (and uncompress-message (message "%s %s...done" uncompress-message base-name)) (and visit notfound (signal 'file-error (cons "Opening input file" (nth 2 notfound)))) ;; Run the functions that insert-file-contents would. (let ((p after-insert-file-functions) (insval size)) (while p (setq insval (funcall (car p) size)) (if insval (progn (or (integerp insval) (signal 'wrong-type-argument (list 'integerp insval))) (setq size insval))) (setq p (cdr p)))) (list filename size)) (jka-compr-run-real-handler 'insert-file-contents (list file visit beg end replace))))) (defun jka-compr-file-local-copy (file) (let* ((filename (expand-file-name file)) (info (jka-compr-get-compression-info filename))) (if info (let ((uncompress-message (jka-compr-info-uncompress-message info)) (uncompress-program (jka-compr-info-uncompress-program info)) (uncompress-args (jka-compr-info-uncompress-args info)) (base-name (file-name-nondirectory filename)) (local-copy (jka-compr-run-real-handler 'file-local-copy (list filename))) (temp-file (jka-compr-make-temp-name t)) (temp-buffer (get-buffer-create " *jka-compr-flc-temp*")) (notfound nil) (cbuf (current-buffer)) local-file) (setq local-file (or local-copy filename)) (unwind-protect (progn (and uncompress-message (message "%s %s..." uncompress-message base-name)) (set-buffer temp-buffer) (jka-compr-call-process uncompress-program (concat uncompress-message " " base-name) local-file t nil uncompress-args) (and uncompress-message (message "%s %s...done" uncompress-message base-name)) (write-region (point-min) (point-max) temp-file nil 'dont)) (and local-copy (file-exists-p local-copy) (delete-file local-copy)) (set-buffer cbuf) (kill-buffer temp-buffer)) temp-file) (jka-compr-run-real-handler 'file-local-copy (list filename))))) ;;; Support for loading compressed files. (defun jka-compr-load (file &optional noerror nomessage nosuffix) "Documented as original." (let* ((local-copy (jka-compr-file-local-copy file)) (load-file (or local-copy file))) (unwind-protect (let (inhibit-file-name-operation inhibit-file-name-handlers) (or nomessage (message "Loading %s..." file)) (let ((load-force-doc-strings t)) (load load-file noerror t t)) (or nomessage (message "Loading %s...done." file))) (jka-compr-delete-temp-file local-copy)) t)) (defun jka-compr-byte-compiler-base-file-name (file) (let ((info (jka-compr-get-compression-info file))) (if (and info (jka-compr-info-strip-extension info)) (save-match-data (substring file 0 (string-match (jka-compr-info-regexp info) file))) file))) (put 'write-region 'jka-compr 'jka-compr-write-region) (put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents) (put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy) (put 'load 'jka-compr 'jka-compr-load) (put 'byte-compiler-base-file-name 'jka-compr 'jka-compr-byte-compiler-base-file-name) (defun jka-compr-handler (operation &rest args) (save-match-data (let ((jka-op (get operation 'jka-compr))) (if jka-op (apply jka-op args) (jka-compr-run-real-handler operation args))))) ;; If we are given an operation that we don't handle, ;; call the Emacs primitive for that operation, ;; and manipulate the inhibit variables ;; to prevent the primitive from calling our handler again. (defun jka-compr-run-real-handler (operation args) (let ((inhibit-file-name-handlers (cons 'jka-compr-handler (and (eq inhibit-file-name-operation operation) inhibit-file-name-handlers))) (inhibit-file-name-operation operation)) (apply operation args))) ;;;###autoload (defun auto-compression-mode (&optional arg) "Toggle automatic file compression and uncompression. With prefix argument ARG, turn auto compression on if positive, else off. Returns the new status of auto compression (non-nil means on)." (interactive "P") (let* ((installed (jka-compr-installed-p)) (flag (if (null arg) (not installed) (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0)))))) (cond ((and flag installed) t) ; already installed ((and (not flag) (not installed)) nil) ; already not installed (flag (jka-compr-install)) (t (jka-compr-uninstall))) (and (interactive-p) (if flag (message "Automatic file (de)compression is now ON.") (message "Automatic file (de)compression is now OFF."))) flag)) (defalias 'toggle-auto-compression 'auto-compression-mode) (defun jka-compr-build-file-regexp () (concat "\\(" (mapconcat 'jka-compr-info-regexp jka-compr-compression-info-list "\\)\\|\\(") "\\)")) (defun jka-compr-install () "Install jka-compr. This adds entries to `file-name-handler-alist' and `auto-mode-alist' and `inhibit-first-line-modes-suffixes'." (setq jka-compr-file-name-handler-entry (cons (jka-compr-build-file-regexp) 'jka-compr-handler)) (setq file-name-handler-alist (cons jka-compr-file-name-handler-entry file-name-handler-alist)) (mapcar (function (lambda (x) (and (jka-compr-info-strip-extension x) ;; Make entries in auto-mode-alist so that modes ;; are chosen right according to the file names ;; sans `.gz'. (setq auto-mode-alist (cons (list (jka-compr-info-regexp x) nil 'jka-compr) auto-mode-alist)) ;; Also add these regexps to ;; inhibit-first-line-modes-suffixes, so that a ;; -*- line in the first file of a compressed tar ;; file doesn't override tar-mode. (setq inhibit-first-line-modes-suffixes (cons (jka-compr-info-regexp x) inhibit-first-line-modes-suffixes))))) jka-compr-compression-info-list) (setq auto-mode-alist (append auto-mode-alist jka-compr-mode-alist-additions))) (defun jka-compr-uninstall () "Uninstall jka-compr. This removes the entries in `file-name-handler-alist' and `auto-mode-alist' and `inhibit-first-line-modes-suffixes' that were added by `jka-compr-installed'." ;; Delete from inhibit-first-line-modes-suffixes ;; what jka-compr-install added. (mapcar (function (lambda (x) (and (jka-compr-info-strip-extension x) (setq inhibit-first-line-modes-suffixes (delete (jka-compr-info-regexp x) inhibit-first-line-modes-suffixes))))) jka-compr-compression-info-list) (let* ((fnha (cons nil file-name-handler-alist)) (last fnha)) (while (cdr last) (if (eq (cdr (car (cdr last))) 'jka-compr-handler) (setcdr last (cdr (cdr last))) (setq last (cdr last)))) (setq file-name-handler-alist (cdr fnha))) (let* ((ama (cons nil auto-mode-alist)) (last ama) entry) (while (cdr last) (setq entry (car (cdr last))) (if (or (member entry jka-compr-mode-alist-additions) (and (consp (cdr entry)) (eq (nth 2 entry) 'jka-compr))) (setcdr last (cdr (cdr last))) (setq last (cdr last)))) (setq auto-mode-alist (cdr ama)))) (defun jka-compr-installed-p () "Return non-nil if jka-compr is installed. The return value is the entry in `file-name-handler-alist' for jka-compr." (let ((fnha file-name-handler-alist) (installed nil)) (while (and fnha (not installed)) (and (eq (cdr (car fnha)) 'jka-compr-handler) (setq installed (car fnha))) (setq fnha (cdr fnha))) installed)) ;;; Add the file I/O hook if it does not already exist. ;;; Make sure that jka-compr-file-name-handler-entry is eq to the ;;; entry for jka-compr in file-name-handler-alist. (and (jka-compr-installed-p) (jka-compr-uninstall)) (jka-compr-install) (provide 'jka-compr) ;; jka-compr.el ends here. emacs-19.30/lisp/kermit.el100444 12120 1 14575 5637121040 13716 0ustar rmsdaemon;;; kermit.el --- additions to shell mode for use with kermit, etc. ;; Copyright (C) 1988 Free Software Foundation, Inc. ;; Author: Jeff Norden ;; Created: 15 Feb 1988 ;; Keywords: comm ;; 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: ;; I'm not sure, but I think somebody asked about running kermit under shell ;; mode a while ago. Anyway, here is some code that I find useful. The result ;; is that I can log onto machines with primitive operating systems (VMS and ;; ATT system V :-), and still have the features of shell-mode available for ;; command history, etc. It's also handy to be able to run a file transfer in ;; an emacs window. The transfer is in the "background", but you can also ;; monitor or stop it easily. ;; The ^\ key is bound to a function for sending escape sequences to kermit, ;; and ^C^Q can be used to send any control characters needed thru to the ;; system you connect to. A more serious problem is that some brain-dead ;; systems will not recognize a ^J as an end-of-line character. So LFD is ;; bound to a new function which acts just like CR usually does in shell-mode, ;; but a ^M is sent as an end-of-line. Functions are also provided to swap the ;; bindings of CR and LFD. I've also included a filter which will clean out ;; any ^M's or ^@'s that get typed at you, but I don't really recommend it. ;; There doesn't seem to be an acceptably fast way to do this via emacs-lisp. ;; Invoking kermit by the command " kermit | tr -d '\015' " seems to work ;; better (on my system anyway). ;; Here's how I've been using this setup. We have several machines connected ;; thru a fairly stupid terminal switch. If I want to connect to unix system, ;; then I use the LFD key to talk to the switch, and ignore any ^M's in the ;; buffer, and do a " stty -echo nl " after I log in. Then the only real ;; difference from being in local shell-mode is that you need to type ;; ^C^Q^C to send an interrupt, and ^C^Q^Z for a stop signal, etc. (since ^C^C ;; just generates a local stop signal, which kermit ignores). ;; To connect to a VMS system, I use a shell script to invoke kermit thru the ;; tr filter, do "M-X kermit-send-cr", and then tell VMS that I'm on a ;; half-duplex terminal. ;; Some caveats: ;; 1) Kermit under shell mode is a real pain if you don't have pty's. I ;; recently discovered this on our 3b2/400. When kermit can't find a tty, it ;; assumes it is supposed to be in remote mode. So the simple command "kermit" ;; won't work in shell mode on such a system. You can get around this by using ;; the -c (connect) command line option, which means you also have to specify a ;; line and baud on the command line, as in "kermit -l /dev/tty53 -b 9600 -c". ;; However, this will cause kermit to exit when the connection is closed. So ;; in order to do a file transfer, you have to think ahead and and add -r ;; (receive) to the command line. This means that you can't use the server ;; feature. The only fix I can see is to muck around with the source code for ;; kermit, although this probably wouldn't be too hard. What is needed is an ;; option to force kermit to be local, to use stdin and stdout for interactive ;; speech, and to forget about cbreak mode. ;; Please let me know if any bugs turn up. ;; Feb 1988, Jeff Norden - jeff@colgate.csnet ;;; Code: (require 'shell) (defvar kermit-esc-char "\C-\\" "*Kermit's escape char") (defun kermit-esc () "For sending escape sequences to a kermit running in shell mode." (interactive) (process-send-string (get-buffer-process (current-buffer)) (concat kermit-esc-char (char-to-string (read-char))))) (defun kermit-send-char () "Send an arbitrary character to a program in shell mode." (interactive) (process-send-string (get-buffer-process (current-buffer)) (char-to-string (read-char)))) (define-key shell-mode-map "\C-\\" 'kermit-esc) (define-key shell-mode-map "\C-c\C-q" 'kermit-send-char) ;; extra bindings for folks suffering form ^S/^Q braindamage: (define-key shell-mode-map "\C-c\\" 'kermit-esc) (defun kermit-send-input-cr () "Like \\[comint-send-input] but end the line with carriage-return." (interactive) (comint-send-input) (comint-send-string (get-buffer-process (current-buffer)) "\r")) ;; This is backwards of what makes sense, but ... (define-key shell-mode-map "\n" 'kermit-send-input-cr) (defun kermit-default-cr () "Make RETURN end the line with carriage-return and LFD end it with a newline. This is useful for talking to other systems on which carriage-return is the normal way to end a line." (interactive) (define-key shell-mode-map "\r" 'kermit-send-input-cr) (define-key shell-mode-map "\n" 'comint-send-input)) (defun kermit-default-nl () "Make RETURN end the line with a newline char. This is the default state. In this state, use LFD to send a line and end it with a carriage-return." (interactive) (define-key shell-mode-map "\n" 'kermit-send-input-cr) (define-key shell-mode-map "\r" 'comint-send-input)) (defun kermit-clean-filter (proc str) "Strip ^M and ^@ characters from process output." (save-excursion (let ((beg (process-mark proc))) (set-buffer (process-buffer proc)) (goto-char beg) (insert-before-markers str) (while (re-search-backward "[\r\C-a]+" beg t) (replace-match ""))))) (defun kermit-clean-on () "Delete all null characters and ^M's from the kermit output. Note that another (perhaps better) way to do this is to use the command `kermit | tr -d '\\015''." (interactive) (set-process-filter (get-buffer-process (current-buffer)) 'kermit-clean-filter)) (defun kermit-clean-off () "Cancel a previous kermit-clean-shell-on command." (interactive) (set-process-filter (get-buffer-process (current-buffer)) nil)) ;;; kermit.el ends here emacs-19.30/lisp/ledit.el100444 74777 1 11541 5353350060 13535 0ustar esrdaemon;;; ledit.el --- Emacs side of ledit interface ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keyord: languages ;; 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 is a major mode for editing Liszt. See etc/LEDIT for details. ;;; Code: ;;; To do: ;;; o lisp -> emacs side of things (grind-definition and find-definition) (defvar ledit-mode-map nil) (defconst ledit-zap-file (concat "/tmp/" (user-login-name) ".l1") "File name for data sent to Lisp by Ledit.") (defconst ledit-read-file (concat "/tmp/" (user-login-name) ".l2") "File name for data sent to Ledit by Lisp.") (defconst ledit-compile-file (concat "/tmp/" (user-login-name) ".l4") "File name for data sent to Lisp compiler by Ledit.") (defconst ledit-buffer "*LEDIT*" "Name of buffer in which Ledit accumulates data to send to Lisp.") ;;;###autoload (defconst ledit-save-files t "\ *Non-nil means Ledit should save files before transferring to Lisp.") ;;;###autoload (defconst ledit-go-to-lisp-string "%?lisp" "\ *Shell commands to execute to resume Lisp job.") ;;;###autoload (defconst ledit-go-to-liszt-string "%?liszt" "\ *Shell commands to execute to resume Lisp compiler job.") (defun ledit-save-defun () "Save the current defun in the ledit buffer" (interactive) (save-excursion (end-of-defun) (let ((end (point))) (beginning-of-defun) (append-to-buffer ledit-buffer (point) end)) (message "Current defun saved for Lisp"))) (defun ledit-save-region (beg end) "Save the current region in the ledit buffer" (interactive "r") (append-to-buffer ledit-buffer beg end) (message "Region saved for Lisp")) (defun ledit-zap-defun-to-lisp () "Carry the current defun to Lisp." (interactive) (ledit-save-defun) (ledit-go-to-lisp)) (defun ledit-zap-defun-to-liszt () "Carry the current defun to liszt." (interactive) (ledit-save-defun) (ledit-go-to-liszt)) (defun ledit-zap-region-to-lisp (beg end) "Carry the current region to Lisp." (interactive "r") (ledit-save-region beg end) (ledit-go-to-lisp)) (defun ledit-go-to-lisp () "Suspend Emacs and restart a waiting Lisp job." (interactive) (if ledit-save-files (save-some-buffers)) (if (get-buffer ledit-buffer) (save-excursion (set-buffer ledit-buffer) (goto-char (point-min)) (write-region (point-min) (point-max) ledit-zap-file) (erase-buffer))) (suspend-emacs ledit-go-to-lisp-string) (load ledit-read-file t t)) (defun ledit-go-to-liszt () "Suspend Emacs and restart a waiting Liszt job." (interactive) (if ledit-save-files (save-some-buffers)) (if (get-buffer ledit-buffer) (save-excursion (set-buffer ledit-buffer) (goto-char (point-min)) (insert "(declare (macros t))\n") (write-region (point-min) (point-max) ledit-compile-file) (erase-buffer))) (suspend-emacs ledit-go-to-liszt-string) (load ledit-read-file t t)) (defun ledit-setup () "Set up key bindings for the Lisp/Emacs interface." (if (not ledit-mode-map) (progn (setq ledit-mode-map (nconc (make-sparse-keymap) shared-lisp-mode-map)))) (define-key ledit-mode-map "\e\^d" 'ledit-save-defun) (define-key ledit-mode-map "\e\^r" 'ledit-save-region) (define-key ledit-mode-map "\^xz" 'ledit-go-to-lisp) (define-key ledit-mode-map "\e\^c" 'ledit-go-to-liszt)) (ledit-setup) ;;;###autoload (defun ledit-mode () "\\Major mode for editing text and stuffing it to a Lisp job. Like Lisp mode, plus these special commands: \\[ledit-save-defun] -- record defun at or after point for later transmission to Lisp job. \\[ledit-save-region] -- record region for later transmission to Lisp job. \\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text. \\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job and transmit saved text. \\{ledit-mode-map} To make Lisp mode automatically change to Ledit mode, do (setq lisp-mode-hook 'ledit-from-lisp-mode)" (interactive) (lisp-mode) (ledit-from-lisp-mode)) ;;;###autoload (defun ledit-from-lisp-mode () (use-local-map ledit-mode-map) (setq mode-name "Ledit") (setq major-mode 'ledit-mode) (run-hooks 'ledit-mode-hook)) ;;; ledit.el ends here emacs-19.30/lisp/levents.el100444 12120 1 21221 6017705702 14073 0ustar rmsdaemon;;; levents.el --- emulate the Lucid event data type and associated functions. ;; Copyright (C) 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: ;; Things we cannot emulate in Lisp: ;; It is not possible to emulate current-mouse-event as a variable, ;; though it is not hard to obtain the data from (this-command-keys). ;; We do not have a variable unread-command-event; ;; instead, we have the more general unread-command-events. ;; Our read-key-sequence and read-char are not precisely ;; compatible with those in Lucid Emacs, but they should work ok. ;;; Code: (defun next-command-event (event) (error "You must rewrite to use `read-command-event' instead of `next-command-event'")) (defun next-event (event) (error "You must rewrite to use `read-event' instead of `next-event'")) (defun dispatch-event (event) (error "`dispatch-event' not supported")) ;; Make events of type eval, menu and timeout ;; execute properly. (define-key global-map [menu] 'execute-eval-event) (define-key global-map [timeout] 'execute-eval-event) (define-key global-map [eval] 'execute-eval-event) (defun execute-eval-event (event) (interactive "e") (funcall (nth 1 event) (nth 2 event))) (put 'eval 'event-symbol-elements '(eval)) (put 'menu 'event-symbol-elements '(eval)) (put 'timeout 'event-symbol-elements '(eval)) (defun allocate-event () "Returns an empty event structure. In this emulation, it returns nil." nil) (defun button-press-event-p (obj) "True if the argument is a mouse-button-press event object." (and (consp obj) (symbolp (car obj)) (memq 'down (get (car obj) 'event-symbol-elements)))) (defun button-release-event-p (obj) "True if the argument is a mouse-button-release event object." (and (consp obj) (symbolp (car obj)) (or (memq 'click (get (car obj) 'event-symbol-elements)) (memq 'drag (get (car obj) 'event-symbol-elements))))) (defun character-to-event (ch &optional event) "Converts a numeric ASCII value to an event structure, replete with bucky bits. The character is the first argument, and the event to fill in is the second. This function contains knowledge about what the codes mean -- for example, the number 9 is converted to the character Tab, not the distinct character Control-I. Beware that character-to-event and event-to-character are not strictly inverse functions, since events contain much more information than the ASCII character set can encode." ch) (defun copy-event (event1 &optional event2) "Make a copy of the given event object. In this emulation, `copy-event' just returns its argument." event1) (defun deallocate-event (event) "Allow the given event structure to be reused. In actual Lucid Emacs, you MUST NOT use this event object after calling this function with it. You will lose. It is not necessary to call this function, as event objects are garbage- collected like all other objects; however, it may be more efficient to explicitly deallocate events when you are sure that that is safe. This emulation does not actually deallocate or reuse events except via garbage collection and `cons'." nil) (defun enqueue-eval-event: (function object) "Add an eval event to the back of the queue. It will be the next event read after all pending events." (setq unread-command-events (nconc unread-command-events (list (list 'eval function object))))) (defun eval-event-p (obj) "True if the argument is an eval or menu event object." (eq (car-safe obj) 'eval)) (defun event-button (event) "Return the button-number of the given mouse-button-press event." (let ((sym (car (get (car event) 'event-symbol-elements)))) (cdr (assq sym '((mouse-1 . 1) (mouse-2 . 2) (mouse-3 . 3) (mouse-4 . 4) (mouse-5 . 5)))))) (defun event-function (event) "Return the callback function of the given timeout, menu, or eval event." (nth 1 event)) (defun event-key (event) "Returns the KeySym of the given key-press event. The value is an ASCII printing character (not upper case) or a symbol." (if (symbolp event) (car (get event 'event-symbol-elements)) (let ((base (logand event (1- (lsh 1 18))))) (downcase (if (< base 32) (logior base 64) base))))) (defun event-object (event) "Returns the function argument of the given timeout, menu, or eval event." (nth 2 event)) (defun event-point (event) "Returns the character position of the given mouse-related event. If the event did not occur over a window, or did not occur over text, then this returns nil. Otherwise, it returns an index into the buffer visible in the event's window." (posn-point (event-end event))) (defun event-process (event) "Returns the process of the given process-output event." (nth 1 event)) (defun event-timestamp (event) "Returns the timestamp of the given event object. In Lucid Emacs, this works for any kind of event. In this emulation, it returns nil for non-mouse-related events." (and (listp event) (posn-timestamp (event-end event)))) (defun event-to-character (event &optional lenient) "Returns the closest ASCII approximation to the given event object. If the event isn't a keypress, this returns nil. If the second argument is non-nil, then this is lenient in its translation; it will ignore modifier keys other than control and meta, and will ignore the shift modifier on those characters which have no shifted ASCII equivalent (Control-Shift-A for example, will be mapped to the same ASCII code as Control-A.) If the second arg is nil, then nil will be returned for events which have no direct ASCII equivalent." (if (symbolp event) (and lenient (cdr (assq event '((backspace . 8) (delete . 127) (tab . 9) (return . 10) (enter . 10))))) ;; Our interpretation is, ASCII means anything a number can represent. (if (integerp event) event nil))) (defun event-window (event) "Returns the window of the given mouse-related event object." (posn-window (event-end event))) (defun event-x (event) "Returns the X position in characters of the given mouse-related event." (/ (car (posn-col-row (event-end event))) (frame-char-width (window-frame (event-window event))))) (defun event-x-pixel (event) "Returns the X position in pixels of the given mouse-related event." (car (posn-col-row (event-end event)))) (defun event-y (event) "Returns the Y position in characters of the given mouse-related event." (/ (cdr (posn-col-row (event-end event))) (frame-char-height (window-frame (event-window event))))) (defun event-y-pixel (event) "Returns the Y position in pixels of the given mouse-related event." (cdr (posn-col-row (event-end event)))) (defun key-press-event-p (obj) "True if the argument is a keyboard event object." (or (integerp obj) (and (symbolp obj) (get obj 'event-symbol-elements)))) (defun menu-event-p (obj) "True if the argument is a menu event object." (eq (car-safe obj) 'menu)) (defun motion-event-p (obj) "True if the argument is a mouse-motion event object." (eq (car-safe obj) 'mouse-movement)) (defun read-command-event () "Return the next keyboard or mouse event; execute other events. This is similar to the function `next-command-event' of Lucid Emacs, but different in that it returns the event rather than filling in an existing event object." (let (event) (while (progn (setq event (read-event)) (not (or (key-press-event-p event) (button-press-event-p event) (button-release-event-p event) (menu-event-p event)))) (let ((type (car-safe event))) (cond ((eq type 'eval) (funcall (nth 1 event) (nth 2 event))) ((eq type 'switch-frame) (select-frame (nth 1 event)))))) event)) (defun process-event-p (obj) "True if the argument is a process-output event object. GNU Emacs 19 does not currently generate process-output events." (eq (car-safe obj) 'process)) (defun timeout-event-p (obj) "True if the argument is a timeout event object. GNU Emacs 19 does not currently generate timeout events." (eq (car-safe obj) 'timeout)) ;;; levents.el ends here emacs-19.30/lisp/life.el100444 12120 1 23473 6017702204 13337 0ustar rmsdaemon;;; life.el --- John Horton Conway's `Life' game for GNU Emacs ;; Copyright (C) 1988 Free Software Foundation, Inc. ;; Author: Kyle Jones ;; Keywords: games ;; 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: ;; A demonstrator for John Horton Conway's "Life" cellular automaton ;; in Emacs Lisp. Picks a random one of a set of interesting Life ;; patterns and evolves it according to the familiar rules. ;;; Code: (defconst life-patterns [("@@@" " @@" "@@@") ("@@@ @@@" "@@ @@ " "@@@ @@@") ("@@@ @@@" "@@ @@" "@@@ @@@") ("@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@") ("@@@@@@@@@@") (" @@@@@@@@@@ " " @@@@@@@@@@ " " @@@@@@@@@@ " "@@@@@@@@@@ " "@@@@@@@@@@ ") ("@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@") ("@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @") ("@@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@") ("@@@@@@@@@" "@ @ @" "@ @@@@@ @" "@ @ @ @" "@@@ @@@" "@ @ @ @" "@ @@@@@ @" "@ @ @" "@@@@@@@@@")] "Vector of rectangles containing some Life startup patterns.") ;; Macros are used macros for manifest constants instead of variables ;; because the compiler will convert them to constants, which should ;; eval faster than symbols. ;; ;; Don't change any of the life-* macro constants unless you thoroughly ;; understand the `life-grim-reaper' function. (defmacro life-life-char () ?@) (defmacro life-death-char () (1+ (life-life-char))) (defmacro life-birth-char () 3) (defmacro life-void-char () ?\ ) (defmacro life-life-string () (char-to-string (life-life-char))) (defmacro life-death-string () (char-to-string (life-death-char))) (defmacro life-birth-string () (char-to-string (life-birth-char))) (defmacro life-void-string () (char-to-string (life-void-char))) (defmacro life-not-void-regexp () (concat "[^" (life-void-string) "\n]")) (defmacro life-increment (variable) (list 'setq variable (list '1+ variable))) ;; list of numbers that tell how many characters to move to get to ;; each of a cell's eight neighbors. (defconst life-neighbor-deltas nil) ;; window display always starts here. Easier to deal with than ;; (scroll-up) and (scroll-down) when trying to center the display. (defconst life-window-start nil) ;; For mode line (defconst life-current-generation nil) ;; Sadly, mode-line-format won't display numbers. (defconst life-generation-string nil) (defvar life-initialized nil "Non-nil if `life' has been run at least once.") ;;;###autoload (defun life (&optional sleeptime) "Run Conway's Life simulation. The starting pattern is randomly selected. Prefix arg (optional first arg non-nil from a program) is the number of seconds to sleep between generations (this defaults to 1)." (interactive "p") (or life-initialized (random t)) (setq life-initialized t) (or sleeptime (setq sleeptime 1)) (life-setup) (life-display-generation sleeptime) (catch 'life-exit (while t (let ((inhibit-quit t)) (life-grim-reaper) (life-expand-plane-if-needed) (life-increment-generation) (life-display-generation sleeptime))))) (defalias 'life-mode 'life) (put 'life-mode 'mode-class 'special) (defun life-setup () (let (n) (switch-to-buffer (get-buffer-create "*Life*") t) (erase-buffer) (kill-all-local-variables) (setq case-fold-search nil mode-name "Life" major-mode 'life-mode truncate-lines t life-current-generation 0 life-generation-string "0" mode-line-buffer-identification '("Life: generation " life-generation-string) fill-column (1- (window-width)) life-window-start 1) (buffer-disable-undo (current-buffer)) ;; stuff in the random pattern (life-insert-random-pattern) ;; make sure (life-life-char) is used throughout (goto-char (point-min)) (while (re-search-forward (life-not-void-regexp) nil t) (replace-match (life-life-string) t t)) ;; center the pattern horizontally (goto-char (point-min)) (setq n (/ (- fill-column (save-excursion (end-of-line) (point))) 2)) (while (not (eobp)) (indent-to n) (forward-line)) ;; center the pattern vertically (setq n (/ (- (1- (window-height)) (count-lines (point-min) (point-max))) 2)) (goto-char (point-min)) (newline n) (goto-char (point-max)) (newline n) ;; pad lines out to fill-column (goto-char (point-min)) (while (not (eobp)) (end-of-line) (indent-to fill-column) (move-to-column fill-column) (delete-region (point) (progn (end-of-line) (point))) (forward-line)) ;; expand tabs to spaces (untabify (point-min) (point-max)) ;; before starting be sure the automaton has room to grow (life-expand-plane-if-needed) ;; compute initial neighbor deltas (life-compute-neighbor-deltas))) (defun life-compute-neighbor-deltas () (setq life-neighbor-deltas (list -1 (- fill-column) (- (1+ fill-column)) (- (+ 2 fill-column)) 1 fill-column (1+ fill-column) (+ 2 fill-column)))) (defun life-insert-random-pattern () (insert-rectangle (elt life-patterns (random (length life-patterns)))) (insert ?\n)) (defun life-increment-generation () (life-increment life-current-generation) (setq life-generation-string (int-to-string life-current-generation))) (defun life-grim-reaper () ;; Clear the match information. Later we check to see if it ;; is still clear, if so then all the cells have died. (store-match-data nil) (goto-char (point-min)) ;; For speed declare all local variable outside the loop. (let (point char pivot living-neighbors list) (while (search-forward (life-life-string) nil t) (setq list life-neighbor-deltas living-neighbors 0 pivot (1- (point))) (while list (setq point (+ pivot (car list)) char (char-after point)) (cond ((eq char (life-void-char)) (subst-char-in-region point (1+ point) (life-void-char) 1 t)) ((< char 3) (subst-char-in-region point (1+ point) char (1+ char) t)) ((< char 9) (subst-char-in-region point (1+ point) char 9 t)) ((>= char (life-life-char)) (life-increment living-neighbors))) (setq list (cdr list))) (if (memq living-neighbors '(2 3)) () (subst-char-in-region pivot (1+ pivot) (life-life-char) (life-death-char) t)))) (if (null (match-beginning 0)) (life-extinct-quit)) (subst-char-in-region 1 (point-max) 9 (life-void-char) t) (subst-char-in-region 1 (point-max) 1 (life-void-char) t) (subst-char-in-region 1 (point-max) 2 (life-void-char) t) (subst-char-in-region 1 (point-max) (life-birth-char) (life-life-char) t) (subst-char-in-region 1 (point-max) (life-death-char) (life-void-char) t)) (defun life-expand-plane-if-needed () (catch 'done (goto-char (point-min)) (while (not (eobp)) ;; check for life at beginning or end of line. If found at ;; either end, expand at both ends, (cond ((or (eq (following-char) (life-life-char)) (eq (progn (end-of-line) (preceding-char)) (life-life-char))) (goto-char (point-min)) (while (not (eobp)) (insert (life-void-char)) (end-of-line) (insert (life-void-char)) (forward-char)) (setq fill-column (+ 2 fill-column)) (scroll-left 1) (life-compute-neighbor-deltas) (throw 'done t))) (forward-line))) (goto-char (point-min)) ;; check for life within the first two lines of the buffer. ;; If present insert two lifeless lines at the beginning.. (cond ((search-forward (life-life-string) (+ (point) fill-column fill-column 2) t) (goto-char (point-min)) (insert-char (life-void-char) fill-column) (insert ?\n) (insert-char (life-void-char) fill-column) (insert ?\n) (setq life-window-start (+ life-window-start fill-column 1)))) (goto-char (point-max)) ;; check for life within the last two lines of the buffer. ;; If present insert two lifeless lines at the end. (cond ((search-backward (life-life-string) (- (point) fill-column fill-column 2) t) (goto-char (point-max)) (insert-char (life-void-char) fill-column) (insert ?\n) (insert-char (life-void-char) fill-column) (insert ?\n) (setq life-window-start (+ life-window-start fill-column 1))))) (defun life-display-generation (sleeptime) (goto-char life-window-start) (recenter 0) ;; Redisplay; if the user has hit a key, exit the loop. (or (eq t (sit-for sleeptime)) (throw 'life-exit nil))) (defun life-extinct-quit () (life-display-generation 0) (signal 'life-extinct nil)) (put 'life-extinct 'error-conditions '(life-extinct quit)) (put 'life-extinct 'error-message "All life has perished") (provide 'life) ;;; life.el ends here emacs-19.30/lisp/lisp-mnt.el100444 75424 1 33036 5770115514 14370 0ustar kwzhdaemon;;; lisp-mnt.el --- minor mode for Emacs Lisp maintainers ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Maintainer: Eric S. Raymond ;; Created: 14 Jul 1992 ;; Version: $Id: lisp-mnt.el,v 1.11 1995/06/15 20:42:24 kwzh Exp $ ;; Keywords: docs ;; X-Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out! ;; 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 minor mode adds some services to Emacs-Lisp editing mode. ;; ;; First, it knows about the header conventions for library packages. ;; One entry point supports generating synopses from a library directory. ;; Another can be used to check for missing headers in library files. ;; ;; Another entry point automatically addresses bug mail to a package's ;; maintainer or author. ;; This file can be loaded by your lisp-mode-hook. Have it (require 'lisp-mnt) ;; This file is an example of the header conventions. Note the following ;; features: ;; ;; * Header line --- makes it possible to extract a one-line summary of ;; the package's uses automatically for use in library synopses, KWIC ;; indexes and the like. ;; ;; Format is three semicolons, followed by the filename, followed by ;; three dashes, followed by the summary. All fields space-separated. ;; ;; * Author line --- contains the name and net address of at least ;; the principal author. ;; ;; If there are multiple authors, they should be listed on continuation ;; lines led by ;;, like this: ;; ;; ;; Author: Ashwin Ram ;; ;; Dave Sill ;; ;; David Lawrence ;; ;; Noah Friedman ;; ;; Joe Wells ;; ;; Dave Brennan ;; ;; Eric Raymond ;; ;; This field may have some special values; notably "FSF", meaning ;; "Free Software Foundation". ;; ;; * Maintainer line --- should be a single name/address as in the Author ;; line, or an address only, or the string "FSF". If there is no maintainer ;; line, the person(s) in the Author field are presumed to be it. The example ;; in this file is mildly bogus because the maintainer line is redundant. ;; The idea behind these two fields is to be able to write a lisp function ;; that does "send mail to the author" without having to mine the name out by ;; hand. Please be careful about surrounding the network address with <> if ;; there's also a name in the field. ;; ;; * Created line --- optional, gives the original creation date of the ;; file. For historical interest, basically. ;; ;; * Version line --- intended to give the reader a clue if they're looking ;; at a different version of the file than the one they're accustomed to. This ;; may be an RCS or SCCS header. ;; ;; * Adapted-By line --- this is for FSF's internal use. The person named ;; in this field was the one responsible for installing and adapting the ;; package for the distribution. (This file doesn't have one because the ;; author *is* one of the maintainers.) ;; ;; * Keywords line --- used by the finder code (now under construction) ;; for finding Emacs Lisp code related to a topic. ;; ;; * X-Bogus-Bureaucratic-Cruft line --- this is a joke and an example ;; of a comment header. Headers starting with `X-' should never be used ;; for any real purpose; this is the way to safely add random headers ;; without invoking the wrath of any program. ;; ;; * Commentary line --- enables lisp code to find the developer's and ;; maintainers' explanations of the package internals. ;; ;; * Change log line --- optional, exists to terminate the commentary ;; section and start a change-log part, if one exists. ;; ;; * Code line --- exists so Lisp can know where commentary and/or ;; change-log sections end. ;; ;; * Footer line --- marks end-of-file so it can be distinguished from ;; an expanded formfeed or the results of truncation. ;;; Change Log: ;; Tue Jul 14 23:44:17 1992 ESR ;; * Created. ;;; Code: (require 'picture) ; provides move-to-column-force (require 'emacsbug) ;; These functions all parse the headers of the current buffer (defun lm-section-mark (hd &optional after) ;; Return the buffer location of a given section start marker (save-excursion (let ((case-fold-search t)) (goto-char (point-min)) (if (re-search-forward (concat "^;;;;* " hd ":[ \t]*$") nil t) (progn (beginning-of-line) (if after (forward-line 1)) (point)) nil)))) (defun lm-code-mark () ;; Return the buffer location of the code start marker (lm-section-mark "Code")) (defun lm-header (hd) ;; Return the contents of a named header (goto-char (point-min)) (let ((case-fold-search t)) (if (re-search-forward (concat "^;; " hd ": \\(.*\\)") (lm-code-mark) t) (buffer-substring (match-beginning 1) (match-end 1)) nil))) (defun lm-header-multiline (hd) ;; Return the contents of a named header, with possible continuation lines. ;; Note -- the returned value is a list of strings, one per line. (save-excursion (goto-char (point-min)) (let ((res (save-excursion (lm-header hd)))) (if res (progn (forward-line 1) (setq res (list res)) (while (looking-at "^;;\t\\(.*\\)") (setq res (cons (buffer-substring (match-beginning 1) (match-end 1)) res)) (forward-line 1)) )) res))) ;; These give us smart access to the header fields and commentary (defun lm-summary (&optional file) ;; Return the buffer's or FILE's one-line summary. (save-excursion (if file (find-file file)) (goto-char (point-min)) (prog1 (if (looking-at "^;;; [^ ]+ --- \\(.*\\)") (buffer-substring (match-beginning 1) (match-end 1))) (if file (kill-buffer (current-buffer))) ))) (defun lm-crack-address (x) ;; Given a string containing a human and email address, parse it ;; into a cons pair (name . address). (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x) (cons (substring x (match-beginning 1) (match-end 1)) (substring x (match-beginning 2) (match-end 2)))) ((string-match "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" x) (cons (substring x (match-beginning 2) (match-end 2)) (substring x (match-beginning 1) (match-end 1)))) ((string-match "\\S-+@\\S-+" x) (cons nil x)) (t (cons x nil)))) (defun lm-authors (&optional file) ;; Return the buffer's or FILE's author list. Each element of the ;; list is a cons; the car is a name-aming-humans, the cdr an email ;; address. (save-excursion (if file (find-file file)) (let ((authorlist (lm-header-multiline "author"))) (prog1 (mapcar 'lm-crack-address authorlist) (if file (kill-buffer (current-buffer))) )))) (defun lm-maintainer (&optional file) ;; Get a package's bug-report & maintenance address. Parse it out of FILE, ;; or the current buffer if FILE is nil. ;; The return value is a (name . address) cons. (save-excursion (if file (find-file file)) (prog1 (let ((maint (lm-header "maintainer"))) (if maint (lm-crack-address maint) (car (lm-authors)))) (if file (kill-buffer (current-buffer))) ))) (defun lm-creation-date (&optional file) ;; Return a package's creation date, if any. Parse it out of FILE, ;; or the current buffer if FILE is nil. (save-excursion (if file (find-file file)) (prog1 (lm-header "created") (if file (kill-buffer (current-buffer))) ))) (defun lm-last-modified-date (&optional file) ;; Return a package's last-modified date, if you can find one. (save-excursion (if file (find-file file)) (prog1 (if (progn (goto-char (point-min)) (re-search-forward "\\$Id: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) " (lm-code-mark) t)) (format "%s %s %s" (buffer-substring (match-beginning 3) (match-end 3)) (nth (string-to-int (buffer-substring (match-beginning 2) (match-end 2))) '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) (buffer-substring (match-beginning 1) (match-end 1)) )) (if file (kill-buffer (current-buffer))) ))) (defun lm-version (&optional file) ;; Return the package's version field. ;; If none, look for an RCS or SCCS header to crack it out of. (save-excursion (if file (find-file file)) (prog1 (or (lm-header "version") (let ((header-max (lm-code-mark))) (goto-char (point-min)) (cond ;; Look for an RCS header ((re-search-forward "\\$Id: [^ ]+ \\([^ ]+\\) " header-max t) (buffer-substring (match-beginning 1) (match-end 1))) ;; Look for an SCCS header ((re-search-forward (concat (regexp-quote "@(#)") (regexp-quote (file-name-nondirectory (buffer-file-name))) "\t\\([012345679.]*\\)") header-max t) (buffer-substring (match-beginning 1) (match-end 1))) (t nil)))) (if file (kill-buffer (current-buffer))) ))) (defun lm-keywords (&optional file) ;; Return the header containing the package's topic keywords. ;; Parse them out of FILE, or the current buffer if FILE is nil. (save-excursion (if file (find-file file)) (prog1 (let ((keywords (lm-header "keywords"))) (and keywords (downcase keywords))) (if file (kill-buffer (current-buffer))) ))) (defun lm-adapted-by (&optional file) ;; Return the name or code of the person who cleaned up this package ;; for distribution. Parse it out of FILE, or the current buffer if ;; FILE is nil. (save-excursion (if file (find-file file)) (prog1 (lm-header "adapted-by") (if file (kill-buffer (current-buffer))) ))) (defun lm-commentary (&optional file) ;; Return the commentary region of a file, as a string. (save-excursion (if file (find-file file)) (prog1 (let ((commentary (lm-section-mark "Commentary" t)) (change-log (lm-section-mark "Change Log")) (code (lm-section-mark "Code"))) (and commentary (if change-log (buffer-substring commentary change-log) (buffer-substring commentary code))) ) (if file (kill-buffer (current-buffer))) ))) ;;; Verification and synopses (defun insert-at-column (col &rest pieces) (if (> (current-column) col) (insert "\n")) (move-to-column-force col) (apply 'insert pieces)) (defconst lm-comment-column 16) (defun lm-verify (&optional file showok) "Check that the current buffer (or FILE if given) is in proper format. If FILE is a directory, recurse on its files and generate a report into a temporary buffer." (if (and file (file-directory-p file)) (progn (switch-to-buffer (get-buffer-create "*lm-verify*")) (erase-buffer) (mapcar '(lambda (f) (if (string-match ".*\\.el$" f) (let ((status (lm-verify f))) (if status (progn (insert f ":") (insert-at-column lm-comment-column status "\n")) (and showok (progn (insert f ":") (insert-at-column lm-comment-column "OK\n"))))))) (directory-files file)) ) (save-excursion (if file (find-file file)) (prog1 (cond ((not (lm-summary)) "Can't find a package summary") ((not (lm-code-mark)) "Can't find a code section marker") ((progn (goto-char (point-max)) (forward-line -1) (looking-at (concat ";;; " file "ends here"))) "Can't find a footer line") ) (if file (kill-buffer (current-buffer))) )))) (defun lm-synopsis (&optional file showall) "Generate a synopsis listing for the buffer or the given FILE if given. If FILE is a directory, recurse on its files and generate a report into a temporary buffer. If SHOWALL is on, also generate a line for files which do not include a recognizable synopsis." (if (and file (file-directory-p file)) (progn (switch-to-buffer (get-buffer-create "*lm-verify*")) (erase-buffer) (mapcar '(lambda (f) (if (string-match ".*\\.el$" f) (let ((syn (lm-synopsis f))) (if syn (progn (insert f ":") (insert-at-column lm-comment-column syn "\n")) (and showall (progn (insert f ":") (insert-at-column lm-comment-column "NA\n"))))))) (directory-files file)) ) (save-excursion (if file (find-file file)) (prog1 (lm-summary) (if file (kill-buffer (current-buffer))) )))) (defun lm-report-bug (topic) "Report a bug in the package currently being visited to its maintainer. Prompts for bug subject. Leaves you in a mail buffer." (interactive "sBug Subject: ") (let ((package (buffer-name)) (addr (lm-maintainer)) (version (lm-version))) (mail nil (if addr (concat (car addr) " <" (cdr addr) ">") bug-gnu-emacs) topic) (goto-char (point-max)) (insert "\nIn " package (if version (concat " version " version) "") "\n\n") (message (substitute-command-keys "Type \\[mail-send] to send bug report.")))) (provide 'lisp-mnt) ;;; lisp-mnt.el ends here emacs-19.30/lisp/lisp-mode.el100444 12120 1 72553 6051032071 14310 0ustar rmsdaemon;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands. ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: lisp, languages ;; 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: ;; The base major mode for editing Lisp code (used also for Emacs Lisp). ;; This mode is documented in the Emacs manual ;;; Code: (defvar lisp-mode-syntax-table nil "") (defvar emacs-lisp-mode-syntax-table nil "") (defvar lisp-mode-abbrev-table nil "") (if (not emacs-lisp-mode-syntax-table) (let ((i 0)) (setq emacs-lisp-mode-syntax-table (make-syntax-table)) (while (< i ?0) (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table) (setq i (1+ i))) (setq i (1+ ?9)) (while (< i ?A) (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table) (setq i (1+ i))) (setq i (1+ ?Z)) (while (< i ?a) (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table) (setq i (1+ i))) (setq i (1+ ?z)) (while (< i 128) (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table) (setq i (1+ i))) (modify-syntax-entry ? " " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?\t " " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?\n "> " emacs-lisp-mode-syntax-table) ;; Give CR the same syntax as newline, for selective-display. (modify-syntax-entry ?\^m "> " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?\; "< " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?` "' " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?' "' " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?, "' " emacs-lisp-mode-syntax-table) ;; Used to be singlequote; changed for flonums. (modify-syntax-entry ?. "_ " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?# "' " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?\" "\" " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?\\ "\\ " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?\( "() " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?\) ")( " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?\[ "(] " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?\] ")[ " emacs-lisp-mode-syntax-table))) (if (not lisp-mode-syntax-table) (progn (setq lisp-mode-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table)) (modify-syntax-entry ?\| "\" " lisp-mode-syntax-table) (modify-syntax-entry ?\[ "_ " lisp-mode-syntax-table) (modify-syntax-entry ?\] "_ " lisp-mode-syntax-table))) (define-abbrev-table 'lisp-mode-abbrev-table ()) (defvar lisp-imenu-generic-expression '( (nil "^\\s-*(def\\(un\\|subst\\|macro\\|advice\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2) ("Variables" "^\\s-*(def\\(var\\|const\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2) ("Types" "^\\s-*(def\\(type\\|struct\\|class\\|ine-condition\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2)) "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.") (defun lisp-mode-variables (lisp-syntax) (cond (lisp-syntax (set-syntax-table lisp-mode-syntax-table))) (setq local-abbrev-table lisp-mode-abbrev-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat page-delimiter "\\|$" )) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) (make-local-variable 'fill-paragraph-function) (setq fill-paragraph-function 'lisp-fill-paragraph) (make-local-variable 'indent-line-function) (setq indent-line-function 'lisp-indent-line) (make-local-variable 'indent-region-function) (setq indent-region-function 'lisp-indent-region) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (make-local-variable 'outline-regexp) (setq outline-regexp ";;; \\|(....") (make-local-variable 'comment-start) (setq comment-start ";") (make-local-variable 'comment-start-skip) (setq comment-start-skip ";+ *") (make-local-variable 'comment-column) (setq comment-column 40) (make-local-variable 'comment-indent-function) (setq comment-indent-function 'lisp-comment-indent) (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression lisp-imenu-generic-expression)) (defvar shared-lisp-mode-map () "Keymap for commands shared by all sorts of Lisp modes.") (if shared-lisp-mode-map () (setq shared-lisp-mode-map (make-sparse-keymap)) (define-key shared-lisp-mode-map "\e\C-q" 'indent-sexp) (define-key shared-lisp-mode-map "\177" 'backward-delete-char-untabify)) (defvar emacs-lisp-mode-map () "Keymap for Emacs Lisp mode. All commands in `shared-lisp-mode-map' are inherited by this map.") (if emacs-lisp-mode-map () (let ((map (make-sparse-keymap "Emacs-Lisp"))) (setq emacs-lisp-mode-map (nconc (make-sparse-keymap) shared-lisp-mode-map)) (define-key emacs-lisp-mode-map "\e\t" 'lisp-complete-symbol) (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun) (define-key emacs-lisp-mode-map [menu-bar] (make-sparse-keymap)) (define-key emacs-lisp-mode-map [menu-bar emacs-lisp] (cons "Emacs-Lisp" map)) (define-key map [edebug-defun] '("Instrument Function for Debugging" . edebug-defun)) (define-key map [byte-recompile] '("Byte-recompile Directory..." . byte-recompile-directory)) (define-key map [byte-compile] '("Byte-compile This File" . emacs-lisp-byte-compile)) (define-key map [separator-eval] '("--")) (define-key map [eval-buffer] '("Evaluate Buffer" . eval-current-buffer)) (define-key map [eval-region] '("Evaluate Region" . eval-region)) (define-key map [eval-sexp] '("Evaluate Last S-expression" . eval-last-sexp)) (define-key map [separator-format] '("--")) (define-key map [comment-region] '("Comment Out Region" . comment-region)) (define-key map [indent-region] '("Indent Region" . indent-region)) (define-key map [indent-line] '("Indent Line" . lisp-indent-line)) (put 'eval-region 'menu-enable 'mark-active) (put 'comment-region 'menu-enable 'mark-active) (put 'indent-region 'menu-enable 'mark-active))) (defun emacs-lisp-byte-compile () "Byte compile the file containing the current buffer." (interactive) (if buffer-file-name (byte-compile-file buffer-file-name) (error "The buffer must be saved in a file first."))) (defun emacs-lisp-mode () "Major mode for editing Lisp code to run in Emacs. Commands: Delete converts tabs to spaces as it moves back. Blank lines separate paragraphs. Semicolons start comments. \\{emacs-lisp-mode-map} Entry to this mode calls the value of `emacs-lisp-mode-hook' if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map emacs-lisp-mode-map) (set-syntax-table emacs-lisp-mode-syntax-table) (setq major-mode 'emacs-lisp-mode) (setq mode-name "Emacs-Lisp") (lisp-mode-variables nil) (run-hooks 'emacs-lisp-mode-hook)) (defvar lisp-mode-map () "Keymap for ordinary Lisp mode. All commands in `shared-lisp-mode-map' are inherited by this map.") (if lisp-mode-map () (setq lisp-mode-map (nconc (make-sparse-keymap) shared-lisp-mode-map)) (define-key lisp-mode-map "\e\C-x" 'lisp-eval-defun) (define-key lisp-mode-map "\C-c\C-z" 'run-lisp)) (defun lisp-mode () "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp. Commands: Delete converts tabs to spaces as it moves back. Blank lines separate paragraphs. Semicolons start comments. \\{lisp-mode-map} Note that `run-lisp' may be used either to start an inferior Lisp job or to switch back to an existing one. Entry to this mode calls the value of `lisp-mode-hook' if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map lisp-mode-map) (setq major-mode 'lisp-mode) (setq mode-name "Lisp") (lisp-mode-variables t) (set-syntax-table lisp-mode-syntax-table) (run-hooks 'lisp-mode-hook)) ;; This will do unless shell.el is loaded. (defun lisp-eval-defun nil "Send the current defun to the Lisp process made by \\[run-lisp]." (interactive) (error "Process lisp does not exist")) (defvar lisp-interaction-mode-map () "Keymap for Lisp Interaction moe. All commands in `shared-lisp-mode-map' are inherited by this map.") (if lisp-interaction-mode-map () (setq lisp-interaction-mode-map (nconc (make-sparse-keymap) shared-lisp-mode-map)) (define-key lisp-interaction-mode-map "\e\C-x" 'eval-defun) (define-key lisp-interaction-mode-map "\e\t" 'lisp-complete-symbol) (define-key lisp-interaction-mode-map "\n" 'eval-print-last-sexp)) (defun lisp-interaction-mode () "Major mode for typing and evaluating Lisp forms. Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression before point, and prints its value into the buffer, advancing point. Commands: Delete converts tabs to spaces as it moves back. Paragraphs are separated only by blank lines. Semicolons start comments. \\{lisp-interaction-mode-map} Entry to this mode calls the value of `lisp-interaction-mode-hook' if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map lisp-interaction-mode-map) (setq major-mode 'lisp-interaction-mode) (setq mode-name "Lisp Interaction") (set-syntax-table emacs-lisp-mode-syntax-table) (lisp-mode-variables nil) (run-hooks 'lisp-interaction-mode-hook)) (defun eval-print-last-sexp () "Evaluate sexp before point; print value into current buffer." (interactive) (let ((standard-output (current-buffer))) (terpri) (eval-last-sexp t) (terpri))) (defun eval-last-sexp (eval-last-sexp-arg-internal) "Evaluate sexp before point; print value in minibuffer. With argument, print output into current buffer." (interactive "P") (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)) (opoint (point))) (prin1 (let ((stab (syntax-table))) (eval (unwind-protect (save-excursion (set-syntax-table emacs-lisp-mode-syntax-table) (forward-sexp -1) (save-restriction (narrow-to-region (point-min) opoint) (read (current-buffer)))) (set-syntax-table stab))))))) (defun eval-defun (eval-defun-arg-internal) "Evaluate defun that point is in or before. Print value in minibuffer. With argument, insert value in current buffer after the defun." (interactive "P") (let ((standard-output (if eval-defun-arg-internal (current-buffer) t)) (form (save-excursion (end-of-defun) (beginning-of-defun) (read (current-buffer))))) (if (and (eq (car form) 'defvar) (cdr-safe (cdr-safe form))) (setq form (cons 'defconst (cdr form)))) (prin1 (eval form)))) (defun lisp-comment-indent () (if (looking-at "\\s<\\s<\\s<") (current-column) (if (looking-at "\\s<\\s<") (let ((tem (calculate-lisp-indent))) (if (listp tem) (car tem) tem)) (skip-chars-backward " \t") (max (if (bolp) 0 (1+ (current-column))) comment-column)))) (defconst lisp-indent-offset nil "") (defconst lisp-indent-function 'lisp-indent-function "") (defun lisp-indent-line (&optional whole-exp) "Indent current line as Lisp code. With argument, indent any additional lines of the same expression rigidly along with this one." (interactive "P") (let ((indent (calculate-lisp-indent)) shift-amt beg end (pos (- (point-max) (point)))) (beginning-of-line) (setq beg (point)) (skip-chars-forward " \t") (if (looking-at "\\s<\\s<\\s<") ;; Don't alter indentation of a ;;; comment line. (goto-char (- (point-max) pos)) (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<"))) ;; Single-semicolon comment lines should be indented ;; as comment lines, not as code. (progn (indent-for-comment) (forward-char -1)) (if (listp indent) (setq indent (car indent))) (setq shift-amt (- indent (current-column))) (if (zerop shift-amt) nil (delete-region beg (point)) (indent-to indent))) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) ;; If desired, shift remaining lines of expression the same amount. (and whole-exp (not (zerop shift-amt)) (save-excursion (goto-char beg) (forward-sexp 1) (setq end (point)) (goto-char beg) (forward-line 1) (setq beg (point)) (> end beg)) (indent-code-rigidly beg end shift-amt))))) (defvar calculate-lisp-indent-last-sexp) (defun calculate-lisp-indent (&optional parse-start) "Return appropriate indentation for current line as Lisp code. In usual case returns an integer: the column to indent to. Can instead return a list, whose car is the column to indent to. This means that following lines at the same level of indentation should not necessarily be indented the same way. The second element of the list is the buffer position of the start of the containing expression." (save-excursion (beginning-of-line) (let ((indent-point (point)) state paren-depth ;; setting this to a number inhibits calling hook (desired-indent nil) (retry t) calculate-lisp-indent-last-sexp containing-sexp) (if parse-start (goto-char parse-start) (beginning-of-defun)) ;; Find outermost containing sexp (while (< (point) indent-point) (setq state (parse-partial-sexp (point) indent-point 0))) ;; Find innermost containing sexp (while (and retry state (> (setq paren-depth (elt state 0)) 0)) (setq retry nil) (setq calculate-lisp-indent-last-sexp (elt state 2)) (setq containing-sexp (elt state 1)) ;; Position following last unclosed open. (goto-char (1+ containing-sexp)) ;; Is there a complete sexp since then? (if (and calculate-lisp-indent-last-sexp (> calculate-lisp-indent-last-sexp (point))) ;; Yes, but is there a containing sexp after that? (let ((peek (parse-partial-sexp calculate-lisp-indent-last-sexp indent-point 0))) (if (setq retry (car (cdr peek))) (setq state peek))))) (if retry nil ;; Innermost containing sexp found (goto-char (1+ containing-sexp)) (if (not calculate-lisp-indent-last-sexp) ;; indent-point immediately follows open paren. ;; Don't call hook. (setq desired-indent (current-column)) ;; Find the start of first element of containing sexp. (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) (cond ((looking-at "\\s(") ;; First element of containing sexp is a list. ;; Indent under that list. ) ((> (save-excursion (forward-line 1) (point)) calculate-lisp-indent-last-sexp) ;; This is the first line to start within the containing sexp. ;; It's almost certainly a function call. (if (= (point) calculate-lisp-indent-last-sexp) ;; Containing sexp has nothing before this line ;; except the first element. Indent under that element. nil ;; Skip the first element, find start of second (the first ;; argument of the function call) and indent under. (progn (forward-sexp 1) (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t))) (backward-prefix-chars)) (t ;; Indent beneath first sexp on same line as ;; calculate-lisp-indent-last-sexp. Again, it's ;; almost certainly a function call. (goto-char calculate-lisp-indent-last-sexp) (beginning-of-line) (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) (backward-prefix-chars))))) ;; Point is at the point to indent under unless we are inside a string. ;; Call indentation hook except when overridden by lisp-indent-offset ;; or if the desired indentation has already been computed. (let ((normal-indent (current-column))) (cond ((elt state 3) ;; Inside a string, don't change indentation. (goto-char indent-point) (skip-chars-forward " \t") (current-column)) ((and (integerp lisp-indent-offset) containing-sexp) ;; Indent by constant offset (goto-char containing-sexp) (+ (current-column) lisp-indent-offset)) (desired-indent) ((and (boundp 'lisp-indent-function) lisp-indent-function (not retry)) (or (funcall lisp-indent-function indent-point state) normal-indent)) (t normal-indent)))))) (defun lisp-indent-function (indent-point state) (let ((normal-indent (current-column))) (goto-char (1+ (elt state 1))) (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) (if (and (elt state 2) (not (looking-at "\\sw\\|\\s_"))) ;; car of form doesn't seem to be a a symbol (progn (if (not (> (save-excursion (forward-line 1) (point)) calculate-lisp-indent-last-sexp)) (progn (goto-char calculate-lisp-indent-last-sexp) (beginning-of-line) (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t))) ;; Indent under the list or under the first sexp on the same ;; line as calculate-lisp-indent-last-sexp. Note that first ;; thing on that line has to be complete sexp since we are ;; inside the innermost containing sexp. (backward-prefix-chars) (current-column)) (let ((function (buffer-substring (point) (progn (forward-sexp 1) (point)))) method) (setq method (or (get (intern-soft function) 'lisp-indent-function) (get (intern-soft function) 'lisp-indent-hook))) (cond ((or (eq method 'defun) (and (null method) (> (length function) 3) (string-match "\\`def" function))) (lisp-indent-defform state indent-point)) ((integerp method) (lisp-indent-specform method state indent-point normal-indent)) (method (funcall method state indent-point))))))) (defconst lisp-body-indent 2 "Number of columns to indent the second line of a `(def...)' form.") (defun lisp-indent-specform (count state indent-point normal-indent) (let ((containing-form-start (elt state 1)) (i count) body-indent containing-form-column) ;; Move to the start of containing form, calculate indentation ;; to use for non-distinguished forms (> count), and move past the ;; function symbol. lisp-indent-function guarantees that there is at ;; least one word or symbol character following open paren of containing ;; form. (goto-char containing-form-start) (setq containing-form-column (current-column)) (setq body-indent (+ lisp-body-indent containing-form-column)) (forward-char 1) (forward-sexp 1) ;; Now find the start of the last form. (parse-partial-sexp (point) indent-point 1 t) (while (and (< (point) indent-point) (condition-case () (progn (setq count (1- count)) (forward-sexp 1) (parse-partial-sexp (point) indent-point 1 t)) (error nil)))) ;; Point is sitting on first character of last (or count) sexp. (if (> count 0) ;; A distinguished form. If it is the first or second form use double ;; lisp-body-indent, else normal indent. With lisp-body-indent bound ;; to 2 (the default), this just happens to work the same with if as ;; the older code, but it makes unwind-protect, condition-case, ;; with-output-to-temp-buffer, et. al. much more tasteful. The older, ;; less hacked, behavior can be obtained by replacing below with ;; (list normal-indent containing-form-start). (if (<= (- i count) 1) (list (+ containing-form-column (* 2 lisp-body-indent)) containing-form-start) (list normal-indent containing-form-start)) ;; A non-distinguished form. Use body-indent if there are no ;; distinguished forms and this is the first undistinguished form, ;; or if this is the first undistinguished form and the preceding ;; distinguished form has indentation at least as great as body-indent. (if (or (and (= i 0) (= count 0)) (and (= count 0) (<= body-indent normal-indent))) body-indent normal-indent)))) (defun lisp-indent-defform (state indent-point) (goto-char (car (cdr state))) (forward-line 1) (if (> (point) (car (cdr (cdr state)))) (progn (goto-char (car (cdr state))) (+ lisp-body-indent (current-column))))) ;; (put 'progn 'lisp-indent-function 0), say, causes progn to be indented ;; like defun if the first form is placed on the next line, otherwise ;; it is indented like any other form (i.e. forms line up under first). (put 'lambda 'lisp-indent-function 'defun) (put 'autoload 'lisp-indent-function 'defun) (put 'progn 'lisp-indent-function 0) (put 'prog1 'lisp-indent-function 1) (put 'prog2 'lisp-indent-function 2) (put 'save-excursion 'lisp-indent-function 0) (put 'save-window-excursion 'lisp-indent-function 0) (put 'save-selected-window 'lisp-indent-function 0) (put 'save-restriction 'lisp-indent-function 0) (put 'save-match-data 'lisp-indent-function 0) (put 'let 'lisp-indent-function 1) (put 'let* 'lisp-indent-function 1) (put 'while 'lisp-indent-function 1) (put 'if 'lisp-indent-function 2) (put 'catch 'lisp-indent-function 1) (put 'condition-case 'lisp-indent-function 2) (put 'unwind-protect 'lisp-indent-function 1) (put 'with-output-to-temp-buffer 'lisp-indent-function 1) (defun indent-sexp (&optional endpos) "Indent each line of the list starting just after point. If optional arg ENDPOS is given, indent each line, stopping when ENDPOS is encountered." (interactive) (let ((indent-stack (list nil)) (next-depth 0) ;; If ENDPOS is non-nil, use nil as STARTING-POINT ;; so that calculate-lisp-indent will find the beginning of ;; the defun we are in. ;; If ENDPOS is nil, it is safe not to scan before point ;; since every line we indent is more deeply nested than point is. (starting-point (if endpos nil (point))) (last-point (point)) last-depth bol outer-loop-done inner-loop-done state this-indent) (or endpos ;; Get error now if we don't have a complete sexp after point. (save-excursion (forward-sexp 1))) (save-excursion (setq outer-loop-done nil) (while (if endpos (< (point) endpos) (not outer-loop-done)) (setq last-depth next-depth inner-loop-done nil) ;; Parse this line so we can learn the state ;; to indent the next line. ;; This inner loop goes through only once ;; unless a line ends inside a string. (while (and (not inner-loop-done) (not (setq outer-loop-done (eobp)))) (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) nil nil state)) (setq next-depth (car state)) ;; If the line contains a comment other than the sort ;; that is indented like code, ;; indent it now with indent-for-comment. ;; Comments indented like code are right already. ;; In any case clear the in-comment flag in the state ;; because parse-partial-sexp never sees the newlines. (if (car (nthcdr 4 state)) (progn (indent-for-comment) (end-of-line) (setcar (nthcdr 4 state) nil))) ;; If this line ends inside a string, ;; go straight to next line, remaining within the inner loop, ;; and turn off the \-flag. (if (car (nthcdr 3 state)) (progn (forward-line 1) (setcar (nthcdr 5 state) nil)) (setq inner-loop-done t))) (and endpos (<= next-depth 0) (progn (setq indent-stack (append indent-stack (make-list (- next-depth) nil)) last-depth (- last-depth next-depth) next-depth 0))) (or outer-loop-done endpos (setq outer-loop-done (<= next-depth 0))) (if outer-loop-done (forward-line 1) (while (> last-depth next-depth) (setq indent-stack (cdr indent-stack) last-depth (1- last-depth))) (while (< last-depth next-depth) (setq indent-stack (cons nil indent-stack) last-depth (1+ last-depth))) ;; Now go to the next line and indent it according ;; to what we learned from parsing the previous one. (forward-line 1) (setq bol (point)) (skip-chars-forward " \t") ;; But not if the line is blank, or just a comment ;; (except for double-semi comments; indent them as usual). (if (or (eobp) (looking-at "\\s<\\|\n")) nil (if (and (car indent-stack) (>= (car indent-stack) 0)) (setq this-indent (car indent-stack)) (let ((val (calculate-lisp-indent (if (car indent-stack) (- (car indent-stack)) starting-point)))) (if (integerp val) (setcar indent-stack (setq this-indent val)) (setcar indent-stack (- (car (cdr val)))) (setq this-indent (car val))))) (if (/= (current-column) this-indent) (progn (delete-region bol (point)) (indent-to this-indent))))) (or outer-loop-done (setq outer-loop-done (= (point) last-point)) (setq last-point (point))))))) ;; Indent every line whose first char is between START and END inclusive. (defun lisp-indent-region (start end) (save-excursion (let ((endmark (copy-marker end))) (goto-char start) (and (bolp) (not (eolp)) (lisp-indent-line)) (indent-sexp endmark) (set-marker endmark nil)))) ;;;; Lisp paragraph filling commands. (defun lisp-fill-paragraph (&optional justify) "Like \\[fill-paragraph], but handle Emacs Lisp comments. If any of the current line is a comment, fill the comment or the paragraph of it that point is in, preserving the comment's indentation and initial semicolons." (interactive "P") (let ( ;; Non-nil if the current line contains a comment. has-comment ;; If has-comment, the appropriate fill-prefix for the comment. comment-fill-prefix ) ;; Figure out what kind of comment we are looking at. (save-excursion (beginning-of-line) (cond ;; A line with nothing but a comment on it? ((looking-at "[ \t]*;[; \t]*") (setq has-comment t comment-fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))) ;; A line with some code, followed by a comment? Remember that the ;; semi which starts the comment shouldn't be part of a string or ;; character. ((progn (while (not (looking-at ";\\|$")) (skip-chars-forward "^;\n\"\\\\?") (cond ((eq (char-after (point)) ?\\) (forward-char 2)) ((memq (char-after (point)) '(?\" ??)) (forward-sexp 1)))) (looking-at ";+[\t ]*")) (setq has-comment t) (setq comment-fill-prefix (concat (make-string (current-column) ? ) (buffer-substring (match-beginning 0) (match-end 0))))))) (if (not has-comment) (fill-paragraph justify) ;; Narrow to include only the comment, and then fill the region. (save-restriction (narrow-to-region ;; Find the first line we should include in the region to fill. (save-excursion (while (and (zerop (forward-line -1)) (looking-at "^[ \t]*;"))) ;; We may have gone to far. Go forward again. (or (looking-at "^[ \t]*;") (forward-line 1)) (point)) ;; Find the beginning of the first line past the region to fill. (save-excursion (while (progn (forward-line 1) (looking-at "^[ \t]*;"))) (point))) ;; Lines with only semicolons on them can be paragraph boundaries. (let ((paragraph-start (concat paragraph-start "\\|[ \t;]*$")) (paragraph-separate (concat paragraph-start "\\|[ \t;]*$")) (fill-prefix comment-fill-prefix)) (fill-paragraph justify)))) t)) (defun indent-code-rigidly (start end arg &optional nochange-regexp) "Indent all lines of code, starting in the region, sideways by ARG columns. Does not affect lines starting inside comments or strings, assuming that the start of the region is not inside them. Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP. The last is a regexp which, if matched at the beginning of a line, means don't indent that line." (interactive "r\np") (let (state) (save-excursion (goto-char end) (setq end (point-marker)) (goto-char start) (or (bolp) (setq state (parse-partial-sexp (point) (progn (forward-line 1) (point)) nil nil state))) (while (< (point) end) (or (car (nthcdr 3 state)) (and nochange-regexp (looking-at nochange-regexp)) ;; If line does not start in string, indent it (let ((indent (current-indentation))) (delete-region (point) (progn (skip-chars-forward " \t") (point))) (or (eolp) (indent-to (max 0 (+ indent arg)) 0)))) (setq state (parse-partial-sexp (point) (progn (forward-line 1) (point)) nil nil state)))))) (provide 'lisp-mode) ;;; lisp-mode.el ends here emacs-19.30/lisp/lisp.el100444 12120 1 24024 5640223432 13362 0ustar rmsdaemon;;; lisp.el --- Lisp editing commands for Emacs ;; Copyright (C) 1985, 1986, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: lisp, languages ;; 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: ;; Lisp editing commands to go with Lisp major mode. ;;; Code: ;; Note that this variable is used by non-lisp modes too. (defvar defun-prompt-regexp nil "*Non-nil => regexp to ignore, before the character that starts a defun. This is only necessary if the opening paren or brace is not in column 0. See `beginning-of-defun'.") (make-variable-buffer-local 'defun-prompt-regexp) (defvar parens-require-spaces t "Non-nil => `insert-parentheses' should insert whitespace as needed.") (defun forward-sexp (&optional arg) "Move forward across one balanced expression (sexp). With argument, do it that many times. Negative arg -N means move backward across N balanced expressions." (interactive "p") (or arg (setq arg 1)) (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) (if (< arg 0) (backward-prefix-chars))) (defun backward-sexp (&optional arg) "Move backward across one balanced expression (sexp). With argument, do it that many times. Negative arg -N means move forward across N balanced expressions." (interactive "p") (or arg (setq arg 1)) (forward-sexp (- arg))) (defun mark-sexp (arg) "Set mark ARG sexps from point. The place mark goes is the same place \\[forward-sexp] would move to with the same argument." (interactive "p") (push-mark (save-excursion (forward-sexp arg) (point)) nil t)) (defun forward-list (&optional arg) "Move forward across one balanced group of parentheses. With argument, do it that many times. Negative arg -N means move backward across N groups of parentheses." (interactive "p") (or arg (setq arg 1)) (goto-char (or (scan-lists (point) arg 0) (buffer-end arg)))) (defun backward-list (&optional arg) "Move backward across one balanced group of parentheses. With argument, do it that many times. Negative arg -N means move forward across N groups of parentheses." (interactive "p") (or arg (setq arg 1)) (forward-list (- arg))) (defun down-list (arg) "Move forward down one level of parentheses. With argument, do this that many times. A negative argument means move backward but still go down a level. In Lisp programs, an argument is required." (interactive "p") (let ((inc (if (> arg 0) 1 -1))) (while (/= arg 0) (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) (setq arg (- arg inc))))) (defun backward-up-list (arg) "Move backward out of one level of parentheses. With argument, do this that many times. A negative argument means move forward but still to a less deep spot. In Lisp programs, an argument is required." (interactive "p") (up-list (- arg))) (defun up-list (arg) "Move forward out of one level of parentheses. With argument, do this that many times. A negative argument means move backward but still to a less deep spot. In Lisp programs, an argument is required." (interactive "p") (let ((inc (if (> arg 0) 1 -1))) (while (/= arg 0) (goto-char (or (scan-lists (point) inc 1) (buffer-end arg))) (setq arg (- arg inc))))) (defun kill-sexp (arg) "Kill the sexp (balanced expression) following the cursor. With argument, kill that many sexps after the cursor. Negative arg -N means kill N sexps before the cursor." (interactive "p") (let ((opoint (point))) (forward-sexp arg) (kill-region opoint (point)))) (defun backward-kill-sexp (arg) "Kill the sexp (balanced expression) preceding the cursor. With argument, kill that many sexps before the cursor. Negative arg -N means kill N sexps after the cursor." (interactive "p") (kill-sexp (- arg))) (defun beginning-of-defun (&optional arg) "Move backward to the beginning of a defun. With argument, do it that many times. Negative arg -N means move forward to Nth following beginning of defun. Returns t unless search stops due to beginning or end of buffer. Normally a defun starts when there is an char with open-parenthesis syntax at the beginning of a line. If `defun-prompt-regexp' is non-nil, then a string which matches that regexp may precede the open-parenthesis, and point ends up at the beginning of the line." (interactive "p") (and (beginning-of-defun-raw arg) (progn (beginning-of-line) t))) (defun beginning-of-defun-raw (&optional arg) "Move point to the character that starts a defun. This is identical to beginning-of-defun, except that point does not move to the beginning of the line when `defun-prompt-regexp' is non-nil." (interactive "p") (and arg (< arg 0) (not (eobp)) (forward-char 1)) (and (re-search-backward (if defun-prompt-regexp (concat "^\\s(\\|" "\\(" defun-prompt-regexp "\\)\\s(") "^\\s(") nil 'move (or arg 1)) (progn (goto-char (1- (match-end 0)))) t)) (defun buffer-end (arg) (if (> arg 0) (point-max) (point-min))) (defun end-of-defun (&optional arg) "Move forward to next end of defun. With argument, do it that many times. Negative argument -N means move back to Nth preceding end of defun. An end of a defun occurs right after the close-parenthesis that matches the open-parenthesis that starts a defun; see `beginning-of-defun'." (interactive "p") (if (or (null arg) (= arg 0)) (setq arg 1)) (let ((first t)) (while (and (> arg 0) (< (point) (point-max))) (let ((pos (point)) npos) (while (progn (if (and first (progn (end-of-line 1) (beginning-of-defun-raw 1))) nil (or (bobp) (forward-char -1)) (beginning-of-defun-raw -1)) (setq first nil) (forward-list 1) (skip-chars-forward " \t") (if (looking-at "\\s<\\|\n") (forward-line 1)) (<= (point) pos)))) (setq arg (1- arg))) (while (< arg 0) (let ((pos (point))) (beginning-of-defun-raw 1) (forward-sexp 1) (forward-line 1) (if (>= (point) pos) (if (beginning-of-defun-raw 2) (progn (forward-list 1) (skip-chars-forward " \t") (if (looking-at "\\s<\\|\n") (forward-line 1))) (goto-char (point-min))))) (setq arg (1+ arg))))) (defun mark-defun () "Put mark at end of this defun, point at beginning. The defun marked is the one that contains point or follows point." (interactive) (push-mark (point)) (end-of-defun) (push-mark (point) nil t) (beginning-of-defun) (re-search-backward "^\n" (- (point) 1) t)) (defun insert-parentheses (arg) "Put parentheses around next ARG sexps. Leave point after open-paren. No argument is equivalent to zero: just insert `()' and leave point between. If `parens-require-spaces' is non-nil, this command also inserts a space before and after, depending on the surrounding characters." (interactive "P") (if arg (setq arg (prefix-numeric-value arg)) (setq arg 0)) (or (eq arg 0) (skip-chars-forward " \t")) (and parens-require-spaces (not (bobp)) (memq (char-syntax (preceding-char)) '(?w ?_ ?\) )) (insert " ")) (insert ?\() (save-excursion (or (eq arg 0) (forward-sexp arg)) (insert ?\)) (and parens-require-spaces (not (eobp)) (memq (char-syntax (following-char)) '(?w ?_ ?\( )) (insert " ")))) (defun move-past-close-and-reindent () "Move past next `)', delete indentation before it, then indent after it." (interactive) (up-list 1) (forward-char -1) (while (save-excursion ; this is my contribution (let ((before-paren (point))) (back-to-indentation) (= (point) before-paren))) (delete-indentation)) (forward-char 1) (newline-and-indent)) (defun lisp-complete-symbol () "Perform completion on Lisp symbol preceding point. Compare that symbol against the known Lisp symbols. The context determines which symbols are considered. If the symbol starts just after an open-parenthesis, only symbols with function definitions are considered. Otherwise, all symbols with function definitions, values or properties are considered." (interactive) (let* ((end (point)) (buffer-syntax (syntax-table)) (beg (unwind-protect (save-excursion (set-syntax-table emacs-lisp-mode-syntax-table) (backward-sexp 1) (while (= (char-syntax (following-char)) ?\') (forward-char 1)) (point)) (set-syntax-table buffer-syntax))) (pattern (buffer-substring beg end)) (predicate (if (eq (char-after (1- beg)) ?\() 'fboundp (function (lambda (sym) (or (boundp sym) (fboundp sym) (symbol-plist sym)))))) (completion (try-completion pattern obarray predicate))) (cond ((eq completion t)) ((null completion) (message "Can't find completion for \"%s\"" pattern) (ding)) ((not (string= pattern completion)) (delete-region beg end) (insert completion)) (t (message "Making completion list...") (let ((list (all-completions pattern obarray predicate)) (completion-fixup-function (function (lambda () (if (save-excursion (goto-char (max (point-min) (- (point) 4))) (looking-at " ")) (forward-char -4)))))) (or (eq predicate 'fboundp) (let (new) (while list (setq new (cons (if (fboundp (intern (car list))) (list (car list) " ") (car list)) new)) (setq list (cdr list))) (setq list (nreverse new)))) (with-output-to-temp-buffer "*Completions*" (display-completion-list list))) (message "Making completion list...%s" "done"))))) ;;; lisp.el ends here emacs-19.30/lisp/lmenu.el100444 12120 1 44315 5753550354 13553 0ustar rmsdaemon;;; lmenu.el --- emulate Lucid's menubar support ;; Keywords: emulations ;; Copyright (C) 1992, 1993, 1994 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. ;;; Code: ;; First, emulate the Lucid menubar support in GNU Emacs 19. ;; Arrange to use current-menubar to set up part of the menu bar. (defvar current-menubar) (setq recompute-lucid-menubar 'recompute-lucid-menubar) (defun recompute-lucid-menubar () (define-key lucid-menubar-map [menu-bar] (condition-case nil (make-lucid-menu-keymap "menu-bar" current-menubar) (error (message "Invalid data in current-menubar moved to lucid-failing-menubar") (sit-for 1) (setq lucid-failing-menubar current-menubar current-menubar nil)))) (setq lucid-menu-bar-dirty-flag nil)) (defvar lucid-menubar-map (make-sparse-keymap)) (or (assq 'current-menubar minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'current-menubar lucid-menubar-map) minor-mode-map-alist))) (defun set-menubar-dirty-flag () (force-mode-line-update) (setq lucid-menu-bar-dirty-flag t)) (defvar add-menu-item-count 0) ;; This is a variable whose value is always nil. (defvar make-lucid-menu-keymap-disable nil) ;; Return a menu keymap corresponding to a Lucid-style menu list ;; MENU-ITEMS, and with name MENU-NAME. (defun make-lucid-menu-keymap (menu-name menu-items) (let ((menu (make-sparse-keymap menu-name))) ;; Process items in reverse order, ;; since the define-key loop reverses them again. (setq menu-items (reverse menu-items)) (while menu-items (let ((item (car menu-items)) command name callback) (cond ((stringp item) (setq command nil) (setq name (if (string-match "^-+$" item) "" item))) ((consp item) (setq command (make-lucid-menu-keymap (car item) (cdr item))) (setq name (car item))) ((vectorp item) (setq command (make-symbol (format "menu-function-%d" add-menu-item-count)) add-menu-item-count (1+ add-menu-item-count) name (aref item 0) callback (aref item 1)) (if (symbolp callback) (fset command callback) (fset command (list 'lambda () '(interactive) callback))) (let ((i 2)) (while (< i (length item)) (cond ((eq (aref item i) ':active) (put command 'menu-enable (or (aref item (1+ i)) 'make-lucid-menu-keymap-disable)) (setq i (+ 2 i))) ((eq (aref item i) ':suffix) ;; unimplemented (setq i (+ 2 i))) ((eq (aref item i) ':keys) ;; unimplemented (setq i (+ 2 i))) ((eq (aref item i) ':style) ;; unimplemented (setq i (+ 2 i))) ((eq (aref item i) ':selected) ;; unimplemented (setq i (+ 2 i))) ((and (symbolp (aref item i)) (= ?: (string-to-char (symbol-name (aref item i))))) (error "Unrecognized menu item keyword: %S" (aref item i))) ((= i 2) ;; old-style format: active-p &optional suffix (put command 'menu-enable (or (aref item i) 'make-lucid-menu-keymap-disable)) ;; suffix is unimplemented (setq i (length item))) (t (error "Unexpected menu item value: %S" (aref item i)))))))) (if (null command) ;; Handle inactive strings specially--allow any number ;; of identical ones. (setcdr menu (cons (list nil name) (cdr menu))) (if name (define-key menu (vector (intern name)) (cons name command))))) (setq menu-items (cdr menu-items))) menu)) (defun popup-menu (menu-desc) "Pop up the given menu. A menu is a list of menu items, strings, and submenus. The first element of a menu must be a string, which is the name of the menu. This is the string that will be displayed in the parent menu, if any. For toplevel menus, it is ignored. This string is not displayed in the menu itself. A menu item is a vector containing: - the name of the menu item (a string); - the `callback' of that item; - a list of keywords with associated values: - :active active-p a form specifying whether this item is selectable; - :suffix suffix a string to be appended to the name as an `argument' to the command, like `Kill Buffer NAME'; - :keys command-keys a string, suitable for `substitute-command-keys', to specify the keyboard equivalent of a command when the callback is a form (this is not necessary when the callback is a symbol, as the keyboard equivalent is computed automatically in that case); - :style style a symbol: nil for a normal menu item, `toggle' for a toggle button (a single option that can be turned on or off), or `radio' for a radio button (one of a group of mutually exclusive options); - :selected form for `toggle' or `radio' style, a form that specifies whether the button will be in the selected state. Alternately, the vector may contain exactly 3 or 4 elements, with the third element specifying `active-p' and the fourth specifying `suffix'. If the `callback' of a menu item is a symbol, then it must name a command. It will be invoked with `call-interactively'. If it is a list, then it is evaluated with `eval'. If an element of a menu is a string, then that string will be presented in the menu as unselectable text. If an element of a menu is a string consisting solely of hyphens, then that item will be presented as a solid horizontal line. If an element of a menu is a list, it is treated as a submenu. The name of that submenu (the first element in the list) will be used as the name of the item representing this menu on the parent. The syntax, more precisely: form := command := callback := command | form active-p := text := name := suffix := command-keys := object-style := 'nil' | 'toggle' | 'radio' keyword := ':active' active-p | ':suffix' suffix | ':keys' command-keys | ':style' object-style | ':selected' form menu-item := '[' name callback active-p [ suffix ] ']' | '[' name callback [ keyword ]+ ']' menu := '(' name [ menu-item | menu | text ]+ ')'" (let ((menu (make-lucid-menu-keymap (car menu-desc) (cdr menu-desc))) (pos (mouse-pixel-position)) answer cmd) (while (and menu (setq answer (x-popup-menu (list (list (nth 1 pos) (nthcdr 2 pos)) (car pos)) menu))) (setq cmd (lookup-key menu (apply 'vector answer))) (setq menu nil) (and cmd (if (keymapp cmd) (setq menu cmd) (call-interactively cmd)))))) (defun popup-dialog-box (data) "Pop up a dialog box. A dialog box description is a list. - The first element of the list is a string to display in the dialog box. - The rest of the elements are descriptions of the dialog box's buttons. Each one is a vector of three elements: - The first element is the text of the button. - The second element is the `callback'. - The third element is t or nil, whether this button is selectable. If the `callback' of a button is a symbol, then it must name a command. It will be invoked with `call-interactively'. If it is a list, then it is evaluated with `eval'. One (and only one) of the buttons may be `nil'. This marker means that all following buttons should be flushright instead of flushleft. The syntax, more precisely: form := command := callback := command | form active-p := name := partition := 'nil' button := '[' name callback active-p ']' dialog := '(' name [ button ]+ [ partition [ button ]+ ] ')'" (let ((name (car data)) (tail (cdr data)) converted choice meaning) (while tail (if (null (car tail)) (setq converted (cons nil converted)) (let ((item (aref (car tail) 0)) (callback (aref (car tail) 1)) (enable (aref (car tail) 2))) (setq converted (cons (if enable (cons item callback) item) converted)))) (setq tail (cdr tail))) (setq choice (x-popup-dialog t (cons name (nreverse converted)))) (if choice (if (symbolp choice) (call-interactively choice) (eval choice))))) ;; This is empty because the usual elements of the menu bar ;; are provided by menu-bar.el instead. ;; It would not make sense to duplicate them here. (defconst default-menubar nil) (defun set-menubar (menubar) "Set the default menubar to be menubar." (setq-default current-menubar (copy-sequence menubar)) (set-menubar-dirty-flag)) (defun set-buffer-menubar (menubar) "Set the buffer-local menubar to be menubar." (make-local-variable 'current-menubar) (setq current-menubar (copy-sequence menubar)) (set-menubar-dirty-flag)) ;;; menu manipulation functions (defun find-menu-item (menubar item-path-list &optional parent) "Searches MENUBAR for item given by ITEM-PATH-LIST. Returns (ITEM . PARENT), where PARENT is the immediate parent of the item found. Signals an error if the item is not found." (or parent (setq item-path-list (mapcar 'downcase item-path-list))) (if (not (consp menubar)) nil (let ((rest menubar) result) (while rest (if (and (car rest) (equal (car item-path-list) (downcase (if (vectorp (car rest)) (aref (car rest) 0) (if (stringp (car rest)) (car rest) (car (car rest))))))) (setq result (car rest) rest nil) (setq rest (cdr rest)))) (if (cdr item-path-list) (if (consp result) (find-menu-item (cdr result) (cdr item-path-list) result) (if result (signal 'error (list "not a submenu" result)) (signal 'error (list "no such submenu" (car item-path-list))))) (cons result parent))))) (defun disable-menu-item (path) "Make the named menu item be unselectable. PATH is a list of strings which identify the position of the menu item in the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." (let* ((menubar current-menubar) (pair (find-menu-item menubar path)) (item (car pair)) (menu (cdr pair))) (or item (signal 'error (list (if menu "No such menu item" "No such menu") path))) (if (consp item) (error "can't disable menus, only menu items")) (aset item 2 nil) (set-menubar-dirty-flag) item)) (defun enable-menu-item (path) "Make the named menu item be selectable. PATH is a list of strings which identify the position of the menu item in the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." (let* ((menubar current-menubar) (pair (find-menu-item menubar path)) (item (car pair)) (menu (cdr pair))) (or item (signal 'error (list (if menu "No such menu item" "No such menu") path))) (if (consp item) (error "%S is a menu, not a menu item" path)) (aset item 2 t) (set-menubar-dirty-flag) item)) (defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before) (if before (setq before (downcase before))) (let* ((menubar current-menubar) (menu (condition-case () (car (find-menu-item menubar menu-path)) (error nil))) (item (if (listp menu) (car (find-menu-item (cdr menu) (list item-name))) (signal 'error (list "not a submenu" menu-path))))) (or menu (let ((rest menu-path) (so-far menubar)) (while rest ;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest))))) (setq menu (if (eq so-far menubar) (car (find-menu-item so-far (list (car rest)))) (car (find-menu-item (cdr so-far) (list (car rest)))))) (or menu (let ((rest2 so-far)) (or rest2 (error "Trying to modify a menu that doesn't exist")) (while (and (cdr rest2) (car (cdr rest2))) (setq rest2 (cdr rest2))) (setcdr rest2 (nconc (list (setq menu (list (car rest)))) (cdr rest2))))) (setq so-far menu) (setq rest (cdr rest))))) (or menu (setq menu menubar)) (if item nil ; it's already there (if item-p (setq item (vector item-name item-data enabled-p)) (setq item (cons item-name item-data))) ;; if BEFORE is specified, try to add it there. (if before (setq before (car (find-menu-item menu (list before))))) (let ((rest menu) (added-before nil)) (while rest (if (eq before (car (cdr rest))) (progn (setcdr rest (cons item (cdr rest))) (setq rest nil added-before t)) (setq rest (cdr rest)))) (if (not added-before) ;; adding before the first item on the menubar itself is harder (if (and (eq menu menubar) (eq before (car menu))) (setq menu (cons item menu) current-menubar menu) ;; otherwise, add the item to the end. (nconc menu (list item)))))) (if item-p (progn (aset item 1 item-data) (aset item 2 (not (null enabled-p)))) (setcar item item-name) (setcdr item item-data)) (set-menubar-dirty-flag) item)) (defun add-menu-item (menu-path item-name function enabled-p &optional before) "Add a menu item to some menu, creating the menu first if necessary. If the named item exists already, it is changed. MENU-PATH identifies the menu under which the new menu item should be inserted. It is a list of strings; for example, (\"File\") names the top-level \"File\" menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". ITEM-NAME is the string naming the menu item to be added. FUNCTION is the command to invoke when this menu item is selected. If it is a symbol, then it is invoked with `call-interactively', in the same way that functions bound to keys are invoked. If it is a list, then the list is simply evaluated. ENABLED-P controls whether the item is selectable or not. BEFORE, if provided, is the name of a menu item before which this item should be added, if this item is not on the menu already. If the item is already present, it will not be moved." (or menu-path (error "must specify a menu path")) (or item-name (error "must specify an item name")) (add-menu-item-1 t menu-path item-name function enabled-p before)) (defun delete-menu-item (path) "Remove the named menu item from the menu hierarchy. PATH is a list of strings which identify the position of the menu item in the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." (let* ((menubar current-menubar) (pair (find-menu-item menubar path)) (item (car pair)) (menu (or (cdr pair) menubar))) (if (not item) nil ;; the menubar is the only special case, because other menus begin ;; with their name. (if (eq menu current-menubar) (setq current-menubar (delq item menu)) (delq item menu)) (set-menubar-dirty-flag) item))) (defun relabel-menu-item (path new-name) "Change the string of the specified menu item. PATH is a list of strings which identify the position of the menu item in the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the menu item called \"Item\" under the \"Foo\" submenu of \"Menu\". NEW-NAME is the string that the menu item will be printed as from now on." (or (stringp new-name) (setq new-name (signal 'wrong-type-argument (list 'stringp new-name)))) (let* ((menubar current-menubar) (pair (find-menu-item menubar path)) (item (car pair)) (menu (cdr pair))) (or item (signal 'error (list (if menu "No such menu item" "No such menu") path))) (if (and (consp item) (stringp (car item))) (setcar item new-name) (aset item 0 new-name)) (set-menubar-dirty-flag) item)) (defun add-menu (menu-path menu-name menu-items &optional before) "Add a menu to the menubar or one of its submenus. If the named menu exists already, it is changed. MENU-PATH identifies the menu under which the new menu should be inserted. It is a list of strings; for example, (\"File\") names the top-level \"File\" menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". If MENU-PATH is nil, then the menu will be added to the menubar itself. MENU-NAME is the string naming the menu to be added. MENU-ITEMS is a list of menu item descriptions. Each menu item should be a vector of three elements: - a string, the name of the menu item; - a symbol naming a command, or a form to evaluate; - and a form whose value determines whether this item is selectable. BEFORE, if provided, is the name of a menu before which this menu should be added, if this menu is not on its parent already. If the menu is already present, it will not be moved." (or menu-name (error "must specify a menu name")) (or menu-items (error "must specify some menu items")) (add-menu-item-1 nil menu-path menu-name menu-items t before)) (defvar put-buffer-names-in-file-menu t) ;; Don't unconditionally enable menu bars; leave that up to the user. ;;(let ((frames (frame-list))) ;; (while frames ;; (modify-frame-parameters (car frames) '((menu-bar-lines . 1))) ;; (setq frames (cdr frames)))) ;;(or (assq 'menu-bar-lines default-frame-alist) ;; (setq default-frame-alist ;; (cons '(menu-bar-lines . 1) default-frame-alist))) (set-menubar default-menubar) (provide 'lmenu) ;;; lmenu.el ends here emacs-19.30/lisp/loaddefs.el100666 12120 1 1255771 6055526116 14270 0ustar rmsdaemon;;; loaddefs.el --- define standard autoloads and keys of other files ;; Copyright (C) 1985,86,87,92,93,94, 95 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal ;; 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: ;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ;;; Special formatting conventions are used in this file! ;;; ;;; a backslash-newline is used at the beginning of a documentation string ;;; when that string should be stored in the file etc/DOCnnn, not in core. ;;; ;;; Such strings read into Lisp as numbers (during the pure-loading phase). ;;; ;;; But you must obey certain rules to make sure the string is understood ;;; and goes into etc/DOCnnn properly. Otherwise, the string will not go ;;; anywhere! ;;; ;;; The doc string must appear in the standard place in a call to ;;; defun, autoload, defvar or defconst. No Lisp macros are recognized. ;;; The open-paren starting the definition must appear in column 0. ;;; ;;; In defvar and defconst, there is an additional rule: ;;; The double-quote that starts the string must be on the same ;;; line as the defvar or defconst. ;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ;;; ********************************************************************** ;;; You should never need to write autoloads by hand and put them here. ;;; ;;; It is no longer necessary. Instead use autoload.el to maintain them ;;; for you. Just insert ";;;###autoload" before defuns or defmacros you ;;; want to be autoloaded, or other forms you want copied into loaddefs.el ;;; (defvars, key definitions, etc.). For example, ;;; ;;;###autoload ;;; (defun foobar () ....) ;;; ;;;###autoload (define-key global-map "f" 'foobar) ;;; ;;;###autoload ;;; (defvar foobar-var nil "\ ;;; This is foobar-var's doc-string.") ;;; ;;; Then do M-x update-file-autoloads on the file to update loaddefs.el. ;;; ;;; You can also use M-x update-directory-autoloads to update the autoloads ;;; in loaddefs.el for all .el files in the lisp/ directory, or M-x ;;; update-autoloads-here to update the autoloads for each file that ;;; already has an autoload section in this file. ;;; ********************************************************************** ;;; Code: ;;; This code was NOT generated by autoload.el. (defconst mode-line-buffer-identification (purecopy '("%F: %12b")) "Mode-line control for identifying the buffer being displayed. Its default value is (\"%F: %12b\"). Under X, `%F' is replaced with `Emacs'. Major modes that edit things other than ordinary files may change this \(e.g. Info, Dired,...)") (make-variable-buffer-local 'mode-line-buffer-identification) (defconst mode-line-process nil "Mode-line control for displaying info on process status. Normally nil in most modes, since there is no process to display.") (make-variable-buffer-local 'mode-line-process) (defconst mode-line-modified (purecopy '("--%1*%1+-")) "Mode-line control for displaying whether current buffer is modified.") (make-variable-buffer-local 'mode-line-modified) (setq-default mode-line-format (list (purecopy "") 'mode-line-modified 'mode-line-buffer-identification (purecopy " ") 'global-mode-string (purecopy " %[(") 'mode-name 'mode-line-process 'minor-mode-alist (purecopy "%n") (purecopy ")%]--") (purecopy '(line-number-mode "L%l--")) (purecopy '(column-number-mode "C%c--")) (purecopy '(-3 . "%p")) (purecopy "-%-"))) (defvar minor-mode-alist nil "\ Alist saying how to show minor modes in the mode line. Each element looks like (VARIABLE STRING); STRING is included in the mode line iff VARIABLE's value is non-nil. Actually, STRING need not be a string; any possible mode-line element is okay. See `mode-line-format'.") (setq minor-mode-alist (mapcar 'purecopy '((abbrev-mode " Abbrev") (overwrite-mode overwrite-mode) (auto-fill-function " Fill") ;; not really a minor mode... (defining-kbd-macro " Def")))) ;; These variables are used by autoloadable packages. ;; They are defined here so that they do not get overridden ;; by the loading of those packages. ;; Names in directory that end in one of these ;; are ignored in completion, ;; making it more likely you will get a unique match. (setq completion-ignored-extensions (cond ((or (eq system-type 'ms-dos) (eq system-type 'windows-nt)) '(".o" ".elc" "~" ".bin" ".bak" ".obj" ".map" ".dvi" ".toc" ".log" ".aux" ".a" ".ln" ".lof" ".blg" ".bbl" ".glo" ".idx" ".lot" ".fmt")) ((eq system-type 'vax-vms) '(".obj" ".elc" ".exe" ".bin" ".lbin" ".sbin" ".dvi" ".toc" ".log" ".aux" ".lof" ".brn" ".rnt" ".mem" ".lni" ".lis" ".olb" ".tlb" ".mlb" ".hlb" ".glo" ".idx" ".lot" ".fmt")) (t '(".o" ".elc" "~" ".bin" ".lbin" ".fasl" ".dvi" ".toc" ".log" ".aux" ".a" ".ln" ".lof" ".blg" ".bbl" ".glo" ".idx" ".lot" ".fmt")))) (make-variable-buffer-local 'indent-tabs-mode) ;; This is here to avoid autoloading etags on M-TAB. ;; M-x visit-tags-table will autoload etags, which will redefine complete-tag. (defun complete-tag () "Perform tags completion on the text around point. Completes to the set of names listed in the current tags table. The string to complete is chosen in the same way as the default for \\[find-tag] (which see)." (interactive) (error (substitute-command-keys "No tags table loaded. Try \\[visit-tags-table]."))) ;; Reduce total amount of space we must allocate during this function ;; that we will not need to keep permanently. (garbage-collect) (define-key ctl-x-map "n" (make-sparse-keymap)) (define-key ctl-x-map "r" (make-sparse-keymap)) (setq help-event-list '(help f1)) ;These commands are defined in editfns.c ;but they are not assigned to keys there. (put 'narrow-to-region 'disabled t) (define-key ctl-x-map "nn" 'narrow-to-region) (define-key ctl-x-map "nw" 'widen) ;; (define-key ctl-x-map "n" 'narrow-to-region) ;; (define-key ctl-x-map "w" 'widen) (define-key global-map "\C-j" 'newline-and-indent) (define-key global-map "\C-m" 'newline) (define-key global-map "\C-o" 'open-line) (define-key esc-map "\C-o" 'split-line) (define-key global-map "\C-q" 'quoted-insert) (define-key esc-map "^" 'delete-indentation) (define-key esc-map "\\" 'delete-horizontal-space) (define-key esc-map "m" 'back-to-indentation) (define-key ctl-x-map "\C-o" 'delete-blank-lines) (define-key esc-map " " 'just-one-space) (define-key esc-map "z" 'zap-to-char) (define-key esc-map "=" 'count-lines-region) (define-key ctl-x-map "=" 'what-cursor-position) (define-key esc-map ":" 'eval-expression) ;; Define ESC ESC : like ESC : for people who type ESC ESC out of habit. (define-key esc-map "\M-:" 'eval-expression) ;; Changed from C-x ESC so that function keys work following C-x. (define-key ctl-x-map "\e\e" 'repeat-complex-command) (define-key ctl-x-map "u" 'advertised-undo) ;; Many people are used to typing C-/ on X terminals and getting C-_. (define-key global-map [?\C-/] 'undo) (define-key global-map "\C-_" 'undo) (define-key esc-map "!" 'shell-command) (define-key esc-map "|" 'shell-command-on-region) ;; This is an experiment--make up and down arrows do history. (define-key minibuffer-local-map [up] 'previous-history-element) (define-key minibuffer-local-map [down] 'next-history-element) (define-key minibuffer-local-ns-map [up] 'previous-history-element) (define-key minibuffer-local-ns-map [down] 'next-history-element) (define-key minibuffer-local-completion-map [up] 'previous-history-element) (define-key minibuffer-local-completion-map [down] 'next-history-element) (define-key minibuffer-local-must-match-map [up] 'previous-history-element) (define-key minibuffer-local-must-match-map [down] 'next-history-element) (define-key global-map "\C-u" 'universal-argument) (let ((i ?0)) (while (<= i ?9) (define-key esc-map (char-to-string i) 'digit-argument) (setq i (1+ i)))) (define-key esc-map "-" 'negative-argument) ;; Define control-digits. (let ((i ?0)) (while (<= i ?9) (define-key global-map (read (format "[?\\C-%c]" i)) 'digit-argument) (setq i (1+ i)))) (define-key global-map [?\C--] 'negative-argument) ;; Define control-meta-digits. (let ((i ?0)) (while (<= i ?9) (define-key esc-map (read (format "[?\\C-%c]" i)) 'digit-argument) (setq i (1+ i)))) (define-key global-map [?\C-\M--] 'negative-argument) (define-key global-map "\C-k" 'kill-line) (define-key global-map "\C-w" 'kill-region) (define-key esc-map "w" 'kill-ring-save) (define-key esc-map "\C-w" 'append-next-kill) (define-key global-map "\C-y" 'yank) (define-key esc-map "y" 'yank-pop) ;; (define-key ctl-x-map "a" 'append-to-buffer) (define-key global-map "\C-@" 'set-mark-command) ;; Many people are used to typing C-SPC and getting C-@. (define-key global-map [?\C-\ ] 'set-mark-command) (define-key ctl-x-map "\C-x" 'exchange-point-and-mark) (define-key ctl-x-map "\C-@" 'pop-global-mark) (define-key ctl-x-map [?\C-\ ] 'pop-global-mark) (define-key global-map "\C-n" 'next-line) (define-key global-map "\C-p" 'previous-line) (define-key ctl-x-map "\C-n" 'set-goal-column) ;;(defun function-key-error () ;; (interactive) ;; (error "That function key is not bound to anything.")) (define-key global-map [menu] 'execute-extended-command) (define-key global-map [find] 'search-forward) ;; natural bindings for terminal keycaps --- defined in X keysym order (define-key global-map [home] 'beginning-of-buffer) (define-key global-map [M-home] 'beginning-of-buffer-other-window) (define-key global-map [left] 'backward-char) (define-key global-map [up] 'previous-line) (define-key global-map [right] 'forward-char) (define-key global-map [down] 'next-line) (define-key global-map [prior] 'scroll-down) (define-key global-map [next] 'scroll-up) (define-key global-map [C-up] 'backward-paragraph) (define-key global-map [C-down] 'forward-paragraph) (define-key global-map [C-prior] 'scroll-right) (define-key global-map [C-next] 'scroll-left) (define-key global-map [M-next] 'scroll-other-window) (define-key global-map [M-prior] 'scroll-other-window-down) (define-key global-map [end] 'end-of-buffer) (define-key global-map [M-end] 'end-of-buffer-other-window) (define-key global-map [begin] 'beginning-of-buffer) (define-key global-map [M-begin] 'beginning-of-buffer-other-window) ;; (define-key global-map [select] 'function-key-error) ;; (define-key global-map [print] 'function-key-error) (define-key global-map [execute] 'execute-extended-command) (define-key global-map [insert] 'overwrite-mode) (define-key global-map [C-insert] 'kill-ring-save) (define-key global-map [S-insert] 'yank) (define-key global-map [undo] 'undo) (define-key global-map [redo] 'repeat-complex-command) ;; (define-key global-map [clearline] 'function-key-error) (define-key global-map [insertline] 'open-line) (define-key global-map [deleteline] 'kill-line) ;; (define-key global-map [insertchar] 'function-key-error) (define-key global-map [deletechar] 'delete-char) ;; (define-key global-map [backtab] 'function-key-error) ;; (define-key global-map [f1] 'function-key-error) ;; (define-key global-map [f2] 'function-key-error) ;; (define-key global-map [f3] 'function-key-error) ;; (define-key global-map [f4] 'function-key-error) ;; (define-key global-map [f5] 'function-key-error) ;; (define-key global-map [f6] 'function-key-error) ;; (define-key global-map [f7] 'function-key-error) ;; (define-key global-map [f8] 'function-key-error) ;; (define-key global-map [f9] 'function-key-error) ;; (define-key global-map [f10] 'function-key-error) ;; (define-key global-map [f11] 'function-key-error) ;; (define-key global-map [f12] 'function-key-error) ;; (define-key global-map [f13] 'function-key-error) ;; (define-key global-map [f14] 'function-key-error) ;; (define-key global-map [f15] 'function-key-error) ;; (define-key global-map [f16] 'function-key-error) ;; (define-key global-map [f17] 'function-key-error) ;; (define-key global-map [f18] 'function-key-error) ;; (define-key global-map [f19] 'function-key-error) ;; (define-key global-map [f20] 'function-key-error) ;; (define-key global-map [f21] 'function-key-error) ;; (define-key global-map [f22] 'function-key-error) ;; (define-key global-map [f23] 'function-key-error) ;; (define-key global-map [f24] 'function-key-error) ;; (define-key global-map [f25] 'function-key-error) ;; (define-key global-map [f26] 'function-key-error) ;; (define-key global-map [f27] 'function-key-error) ;; (define-key global-map [f28] 'function-key-error) ;; (define-key global-map [f29] 'function-key-error) ;; (define-key global-map [f30] 'function-key-error) ;; (define-key global-map [f31] 'function-key-error) ;; (define-key global-map [f32] 'function-key-error) ;; (define-key global-map [f33] 'function-key-error) ;; (define-key global-map [f34] 'function-key-error) ;; (define-key global-map [f35] 'function-key-error) ;; (define-key global-map [kp-backtab] 'function-key-error) ;; (define-key global-map [kp-space] 'function-key-error) ;; (define-key global-map [kp-tab] 'function-key-error) ;; (define-key global-map [kp-enter] 'function-key-error) ;; (define-key global-map [kp-f1] 'function-key-error) ;; (define-key global-map [kp-f2] 'function-key-error) ;; (define-key global-map [kp-f3] 'function-key-error) ;; (define-key global-map [kp-f4] 'function-key-error) ;; (define-key global-map [kp-multiply] 'function-key-error) ;; (define-key global-map [kp-add] 'function-key-error) ;; (define-key global-map [kp-separator] 'function-key-error) ;; (define-key global-map [kp-subtract] 'function-key-error) ;; (define-key global-map [kp-decimal] 'function-key-error) ;; (define-key global-map [kp-divide] 'function-key-error) ;; (define-key global-map [kp-0] 'function-key-error) ;; (define-key global-map [kp-1] 'function-key-error) ;; (define-key global-map [kp-2] 'function-key-error) ;; (define-key global-map [kp-3] 'function-key-error) ;; (define-key global-map [kp-4] 'function-key-error) ;; (define-key global-map [kp-5] 'recenter) ;; (define-key global-map [kp-6] 'function-key-error) ;; (define-key global-map [kp-7] 'function-key-error) ;; (define-key global-map [kp-8] 'function-key-error) ;; (define-key global-map [kp-9] 'function-key-error) ;; (define-key global-map [kp-equal] 'function-key-error) ;; X11R6 distinguishes these keys from the non-kp keys. ;; Make them behave like the non-kp keys unless otherwise bound. (define-key function-key-map [kp-home] [home]) (define-key function-key-map [kp-left] [left]) (define-key function-key-map [kp-up] [up]) (define-key function-key-map [kp-right] [right]) (define-key function-key-map [kp-down] [down]) (define-key function-key-map [kp-prior] [prior]) (define-key function-key-map [kp-next] [next]) (define-key function-key-map [M-kp-next] [M-next]) (define-key function-key-map [kp-end] [end]) (define-key function-key-map [kp-begin] [begin]) (define-key function-key-map [kp-insert] [insert]) (define-key function-key-map [kp-delete] [delete]) (define-key global-map [mouse-movement] 'ignore) (define-key global-map "\C-t" 'transpose-chars) (define-key esc-map "t" 'transpose-words) (define-key esc-map "\C-t" 'transpose-sexps) (define-key ctl-x-map "\C-t" 'transpose-lines) (define-key esc-map ";" 'indent-for-comment) (define-key esc-map "j" 'indent-new-comment-line) (define-key esc-map "\C-j" 'indent-new-comment-line) (define-key ctl-x-map ";" 'set-comment-column) (define-key ctl-x-map "f" 'set-fill-column) (define-key ctl-x-map "$" 'set-selective-display) (define-key esc-map "@" 'mark-word) (define-key esc-map "f" 'forward-word) (define-key esc-map "b" 'backward-word) (define-key esc-map "d" 'kill-word) (define-key esc-map "\177" 'backward-kill-word) (define-key esc-map "<" 'beginning-of-buffer) (define-key esc-map ">" 'end-of-buffer) (define-key ctl-x-map "h" 'mark-whole-buffer) (define-key esc-map "\\" 'delete-horizontal-space) (defalias 'mode-specific-command-prefix (make-sparse-keymap)) (defconst mode-specific-map (symbol-function 'mode-specific-command-prefix) "Keymap for characters following C-c.") (define-key global-map "\C-c" 'mode-specific-command-prefix) (global-set-key [M-right] 'forward-word) (global-set-key [M-left] 'backward-word) ;; ilya@math.ohio-state.edu says these bindings are standard on PC editors. (global-set-key [C-right] 'forward-word) (global-set-key [C-left] 'backward-word) ;; This is not quite compatible, but at least is analogous (global-set-key [C-delete] 'backward-kill-word) ;; This is "move to the clipboard", or as close as we come. (global-set-key [S-delete] 'kill-region) (define-key esc-map "\C-f" 'forward-sexp) (define-key esc-map "\C-b" 'backward-sexp) (define-key esc-map "\C-u" 'backward-up-list) (define-key esc-map "\C-@" 'mark-sexp) (define-key esc-map [?\C-\ ] 'mark-sexp) (define-key esc-map "\C-d" 'down-list) (define-key esc-map "\C-k" 'kill-sexp) (define-key global-map [C-M-delete] 'backward-kill-sexp) (define-key global-map [C-M-backspace] 'backward-kill-sexp) (define-key esc-map "\C-n" 'forward-list) (define-key esc-map "\C-p" 'backward-list) (define-key esc-map "\C-a" 'beginning-of-defun) (define-key esc-map "\C-e" 'end-of-defun) (define-key esc-map "\C-h" 'mark-defun) (define-key esc-map "(" 'insert-parentheses) (define-key esc-map ")" 'move-past-close-and-reindent) (define-key esc-map "\t" 'lisp-complete-symbol) (define-key ctl-x-map "\C-e" 'eval-last-sexp) (define-key ctl-x-map "r\C-@" 'point-to-register) (define-key ctl-x-map [?r ?\C-\ ] 'point-to-register) (define-key ctl-x-map "r " 'point-to-register) (define-key ctl-x-map "rj" 'jump-to-register) (define-key ctl-x-map "rs" 'copy-to-register) (define-key ctl-x-map "rx" 'copy-to-register) (define-key ctl-x-map "ri" 'insert-register) (define-key ctl-x-map "rg" 'insert-register) (define-key ctl-x-map "rr" 'copy-rectangle-to-register) (define-key ctl-x-map "rc" 'clear-rectangle) (define-key ctl-x-map "rk" 'kill-rectangle) (define-key ctl-x-map "rd" 'delete-rectangle) (define-key ctl-x-map "ry" 'yank-rectangle) (define-key ctl-x-map "ro" 'open-rectangle) (define-key ctl-x-map "rt" 'string-rectangle) (define-key ctl-x-map "rw" 'window-configuration-to-register) (define-key ctl-x-map "rf" 'frame-configuration-to-register) ;; These key bindings are deprecated; use the above C-x r map instead. ;; We use these aliases so \[...] will show the C-x r bindings instead. (defalias 'point-to-register-compatibility-binding 'point-to-register) (defalias 'jump-to-register-compatibility-binding 'jump-to-register) (defalias 'copy-to-register-compatibility-binding 'copy-to-register) (defalias 'insert-register-compatibility-binding 'insert-register) (define-key ctl-x-map "/" 'point-to-register-compatibility-binding) (define-key ctl-x-map "j" 'jump-to-register-compatibility-binding) (define-key ctl-x-map "x" 'copy-to-register-compatibility-binding) (define-key ctl-x-map "g" 'insert-register-compatibility-binding) ;; (define-key ctl-x-map "r" 'copy-rectangle-to-register) (define-key esc-map "q" 'fill-paragraph) ;; (define-key esc-map "g" 'fill-region) (define-key ctl-x-map "." 'set-fill-prefix) (define-key esc-map "{" 'backward-paragraph) (define-key esc-map "}" 'forward-paragraph) (define-key esc-map "h" 'mark-paragraph) (define-key esc-map "a" 'backward-sentence) (define-key esc-map "e" 'forward-sentence) (define-key esc-map "k" 'kill-sentence) (define-key ctl-x-map "\177" 'backward-kill-sentence) (define-key ctl-x-map "[" 'backward-page) (define-key ctl-x-map "]" 'forward-page) (define-key ctl-x-map "\C-p" 'mark-page) (define-key ctl-x-map "l" 'count-lines-page) (define-key ctl-x-map "np" 'narrow-to-page) ;; (define-key ctl-x-map "p" 'narrow-to-page) (define-key ctl-x-map "al" 'add-mode-abbrev) (define-key ctl-x-map "a\C-a" 'add-mode-abbrev) (define-key ctl-x-map "ag" 'add-global-abbrev) (define-key ctl-x-map "a+" 'add-mode-abbrev) (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) (define-key ctl-x-map "a'" 'expand-abbrev) ;; (define-key ctl-x-map "\C-a" 'add-mode-abbrev) ;; (define-key ctl-x-map "\+" 'add-global-abbrev) ;; (define-key ctl-x-map "\C-h" 'inverse-add-mode-abbrev) ;; (define-key ctl-x-map "\-" 'inverse-add-global-abbrev) (define-key esc-map "'" 'abbrev-prefix-mark) (define-key ctl-x-map "'" 'expand-abbrev) ;;; Generated autoloads follow (made by autoload.el). ;;; To sort them, execute the following after narrowing ;;; to a region starting just after the following formfeed (control-l) ;;; and ending just after the last formfeed in the file. ;;;(sort-regexp-fields nil "\n*.*\n.*from \\(.*\\)[^ ]* " "\\1" ;;; (point-min) (point-max)) ;;;### (autoloads (ada-make-filename-from-adaname ada-mode) "ada-mode" "ada-mode.el" (12437 324)) ;;; Generated autoloads from ada-mode.el (autoload (quote ada-mode) "ada-mode" "\ Ada Mode is the major mode for editing Ada code. Bindings are as follows: (Note: 'LFD' is control-j.) Indent line '\\[ada-tab]' Indent line, insert newline and indent the new line. '\\[newline-and-indent]' Re-format the parameter-list point is in '\\[ada-format-paramlist]' Indent all lines in region '\\[ada-indent-region]' Call external pretty printer program '\\[ada-call-pretty-printer]' Adjust case of identifiers and keywords in region '\\[ada-adjust-case-region]' Adjust case of identifiers and keywords in buffer '\\[ada-adjust-case-buffer]' Call EXTERNAL pretty printer (if you have one) '\\[ada-call-pretty-printer]' Fill comment paragraph '\\[ada-fill-comment-paragraph]' Fill comment paragraph and justify each line '\\[ada-fill-comment-paragraph-justify]' Fill comment paragraph, justify and append postfix '\\[ada-fill-comment-paragraph-postfix]' Next func/proc/task '\\[ada-next-procedure]' Previous func/proc/task '\\[ada-previous-procedure]' Next package '\\[ada-next-package]' Previous package '\\[ada-previous-package]' Goto matching start of current 'end ...;' '\\[ada-move-to-start]' Goto end of current block '\\[ada-move-to-end]' Comments are handled using standard GNU Emacs conventions, including: Start a comment '\\[indent-for-comment]' Comment region '\\[comment-region]' Uncomment region '\\[ada-uncomment-region]' Continue comment on next line '\\[indent-new-comment-line]' If you use imenu.el: Display index-menu of functions & procedures '\\[imenu]' If you use find-file.el: Switch to other file (Body <-> Spec) '\\[ff-find-other-file]' or '\\[ff-mouse-find-other-file] Switch to other file in other window '\\[ada-ff-other-window]' or '\\[ff-mouse-find-other-file-other-window] If you use this function in a spec and no body is available, it gets created with body stubs. If you use ada-xref.el: Goto declaration: '\\[ada-point-and-xref]' on the identifier or '\\[ada-goto-declaration]' with point on the identifier Complete identifier: '\\[ada-complete-identifier]' Execute Gnatf: '\\[ada-gnatf-current]'" t nil) (autoload (quote ada-make-filename-from-adaname) "ada-mode" "\ Determine the filename of a package/procedure from its own Ada name." t nil) ;;;*** ;;;### (autoloads (add-log-current-defun change-log-mode add-change-log-entry-other-window add-change-log-entry find-change-log prompt-for-change-log-name) "add-log" "add-log.el" (12428 26197)) ;;; Generated autoloads from add-log.el (autoload (quote prompt-for-change-log-name) "add-log" "\ Prompt for a change log name." nil nil) (autoload (quote find-change-log) "add-log" "\ Find a change log file for \\[add-change-log-entry] and return the name. Optional arg FILE-NAME specifies the file to use. If FILE-NAME is nil, use the value of `change-log-default-name'. If 'change-log-default-name' is nil, behave as though it were 'ChangeLog' \(or whatever we use on this operating system). If 'change-log-default-name' contains a leading directory component, then simply find it in the current directory. Otherwise, search in the current directory and its successive parents for a file so named. Once a file is found, `change-log-default-name' is set locally in the current buffer to the complete file name." nil nil) (autoload (quote add-change-log-entry) "add-log" "\ Find change log file and add an entry for today. Optional arg (interactive prefix) non-nil means prompt for user name and site. Second arg is file name of change log. If nil, uses `change-log-default-name'. Third arg OTHER-WINDOW non-nil means visit in other window. Fourth arg NEW-ENTRY non-nil means always create a new entry at the front; never append to an existing entry." t nil) (autoload (quote add-change-log-entry-other-window) "add-log" "\ Find change log file in other window and add an entry for today. Optional arg (interactive prefix) non-nil means prompt for user name and site. Second arg is file name of change log. If nil, uses `change-log-default-name'." t nil) (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window) (autoload (quote change-log-mode) "add-log" "\ Major mode for editing change logs; like Indented Text Mode. Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74. New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window]. Each entry behaves as a paragraph, and the entries for one day as a page. Runs `change-log-mode-hook'." t nil) (autoload (quote add-log-current-defun) "add-log" "\ Return name of function definition point is in, or nil. Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...), Texinfo (@node titles), Perl, and Fortran. Other modes are handled by a heuristic that looks in the 10K before point for uppercase headings starting in the first column or identifiers followed by `:' or `=', see variable `add-log-current-defun-header-regexp'. Has a preference of looking backwards." nil nil) ;;;*** ;;;### (autoloads (defadvice ad-add-advice) "advice" "advice.el" (12135 49154)) ;;; Generated autoloads from advice.el (defvar ad-redefinition-action (quote warn) "\ *Defines what to do with redefinitions during Advice de/activation. Redefinition occurs if a previously activated function that already has an original definition associated with it gets redefined and then de/activated. In such a case we can either accept the current definition as the new original definition, discard the current definition and replace it with the old original, or keep it and raise an error. The values `accept', `discard', `error' or `warn' govern what will be done. `warn' is just like `accept' but it additionally prints a warning message. All other values will be interpreted as `error'.") (defvar ad-default-compilation-action (quote maybe) "\ *Defines whether to compile advised definitions during activation. A value of `always' will result in unconditional compilation, `never' will always avoid compilation, `maybe' will compile if the byte-compiler is already loaded, and `like-original' will compile if the original definition of the advised function is compiled or a built-in function. Every other value will be interpreted as `maybe'. This variable will only be considered if the COMPILE argument of `ad-activate' was supplied as nil.") (autoload (quote ad-add-advice) "advice" "\ Adds a piece of ADVICE to FUNCTION's list of advices in CLASS. If FUNCTION already has one or more pieces of advice of the specified CLASS then POSITION determines where the new piece will go. The value of POSITION can either be `first', `last' or a number where 0 corresponds to `first'. Numbers outside the range will be mapped to the closest extreme position. If there was already a piece of ADVICE with the same name, then the position argument will be ignored and the old advice will be overwritten with the new one. If the FUNCTION was not advised already, then its advice info will be initialized. Redefining a piece of advice whose name is part of the cache-id will clear the cache." nil nil) (autoload (quote defadvice) "advice" "\ Defines a piece of advice for FUNCTION (a symbol). The syntax of `defadvice' is as follows: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) [DOCSTRING] [INTERACTIVE-FORM] BODY... ) FUNCTION ::= Name of the function to be advised. CLASS ::= `before' | `around' | `after' | `activation' | `deactivation'. NAME ::= Non-nil symbol that names this piece of advice. POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first', see also `ad-add-advice'. ARGLIST ::= An optional argument list to be used for the advised function instead of the argument list of the original. The first one found in before/around/after-advices will be used. FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'. All flags can be specified with unambiguous initial substrings. DOCSTRING ::= Optional documentation for this piece of advice. INTERACTIVE-FORM ::= Optional interactive form to be used for the advised function. The first one found in before/around/after-advices will be used. BODY ::= Any s-expression. Semantics of the various flags: `protect': The piece of advice will be protected against non-local exits in any code that precedes it. If any around-advice of a function is protected then automatically all around-advices will be protected (the complete onion). `activate': All advice of FUNCTION will be activated immediately if FUNCTION has been properly defined prior to this application of `defadvice'. `compile': In conjunction with `activate' specifies that the resulting advised function should be compiled. `disable': The defined advice will be disabled, hence, it will not be used during activation until somebody enables it. `preactivate': Preactivates the advised FUNCTION at macro-expansion/compile time. This generates a compiled advised definition according to the current advice state that will be used during activation if appropriate. Only use this if the `defadvice' gets actually compiled. `freeze': Expands the `defadvice' into a redefining `defun/defmacro' according to this particular single advice. No other advice information will be saved. Frozen advices cannot be undone, they behave like a hard redefinition of the advised function. `freeze' implies `activate' and `preactivate'. The documentation of the advised function can be dumped onto the `DOC' file during preloading. Look at the file `advice.el' for comprehensive documentation." nil (quote macro)) ;;;*** ;;;### (autoloads (ange-ftp-hook-function) "ange-ftp" "ange-ftp.el" (12433 49824)) ;;; 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))) (or (assoc "^/[^/:]*\\'" file-name-handler-alist) (setq file-name-handler-alist (cons (quote ("^/[^/:]*\\'" . ange-ftp-completion-hook-function)) file-name-handler-alist))) ;;;*** ;;;### (autoloads (appt-make-list) "appt" "appt.el" (12404 27843)) ;;; Generated autoloads from appt.el (defvar appt-issue-message t "\ *Non-nil means check for appointments in the diary buffer. To be detected, the diary entry must have the time as the first thing on a line.") (defvar appt-message-warning-time 12 "\ *Time in minutes before an appointment that the warning begins.") (defvar appt-audible t "\ *Non-nil means beep to indicate appointment.") (defvar appt-visible t "\ *Non-nil means display appointment message in echo area.") (defvar appt-display-mode-line t "\ *Non-nil means display minutes to appointment and time on the mode line.") (defvar appt-msg-window t "\ *Non-nil means display appointment message in another window.") (defvar appt-display-duration 10 "\ *The number of seconds an appointment message is displayed.") (defvar appt-display-diary t "\ *Non-nil means to display the next days diary on the screen. This will occur at midnight when the appointment list is updated.") (autoload (quote appt-make-list) "appt" nil nil nil) ;;;*** ;;;### (autoloads (apropos-documentation apropos-value apropos apropos-command) "apropos" "apropos.el" (12305 5489)) ;;; Generated autoloads from apropos.el (fset (quote command-apropos) (quote apropos-command)) (autoload (quote apropos-command) "apropos" "\ Shows commands (interactively callable functions) that match REGEXP. With optional prefix ARG or if `apropos-do-all' is non-nil, also show variables." t nil) (autoload (quote apropos) "apropos" "\ Show all bound symbols whose names match REGEXP. With optional prefix ARG or if `apropos-do-all' is non-nil, also show unbound symbols and key bindings, which is a little more time-consuming. Returns list of symbols and documentation found." t nil) (autoload (quote apropos-value) "apropos" "\ Show all symbols whose value's printed image matches REGEXP. With optional prefix ARG or if `apropos-do-all' is non-nil, also looks at the function and at the names and values of properties. Returns list of symbols and values found." t nil) (autoload (quote apropos-documentation) "apropos" "\ Show symbols whose names or documentation contain matches for REGEXP. With optional prefix ARG or if `apropos-do-all' is non-nil, also use documentation that is not stored in the documentation file and show key bindings. Returns list of symbols and documentation found." t nil) ;;;*** ;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (12437 9405)) ;;; Generated autoloads from arc-mode.el (autoload (quote archive-mode) "arc-mode" "\ Major mode for viewing an archive file in a dired-like way. You can move around using the usual cursor motion commands. Letters no longer insert themselves. Type `e' to pull a file out of the archive and into its own buffer; or click mouse-2 on the file's line in the archive mode buffer. If you edit a sub-file of this archive (as with the `e' command) and save it, the contents of that buffer will be saved back into the archive. \\{archive-mode-map}" nil nil) ;;;*** ;;;### (autoloads (asm-mode) "asm-mode" "asm-mode.el" (12145 57463)) ;;; Generated autoloads from asm-mode.el (autoload (quote asm-mode) "asm-mode" "\ Major mode for editing typical assembler code. Features a private abbrev table and the following bindings: \\[asm-colon] outdent a preceding label, tab to next tab stop. \\[tab-to-tab-stop] tab to next tab stop. \\[asm-newline] newline, then tab to next tab stop. \\[asm-comment] smart placement of assembler comments. The character used for making comments is set by the variable `asm-comment-char' (which defaults to `?;'). Alternatively, you may set this variable in `asm-mode-set-comment-hook', which is called near the beginning of mode initialization. Turning on Asm mode runs the hook `asm-mode-hook' at the end of initialization. Special commands: \\{asm-mode-map} " t nil) ;;;*** ;;;### (autoloads (auto-show-mode) "auto-show" "auto-show.el" (12437 471)) ;;; Generated autoloads from auto-show.el (autoload (quote auto-show-mode) "auto-show" "\ Turn automatic horizontal scroll mode on or off. With arg, turn auto scrolling on if arg is positive, off otherwise." t nil) ;;;*** ;;;### (autoloads (define-auto-insert auto-insert) "autoinsert" "autoinsert.el" (12285 35264)) ;;; Generated autoloads from autoinsert.el (autoload (quote auto-insert) "autoinsert" "\ Insert default contents into a new file if `auto-insert' is non-nil. Matches the visited file name against the elements of `auto-insert-alist'." t nil) (autoload (quote define-auto-insert) "autoinsert" "\ Associate CONDITION with (additional) ACTION in `auto-insert-alist'. Optional AFTER means to insert action after all existing actions for CONDITION, or if CONDITION had no actions, after all other CONDITIONs." nil nil) ;;;*** ;;;### (autoloads (batch-update-autoloads update-directory-autoloads update-autoloads-here update-file-autoloads) "autoload" "autoload.el" (12285 34483)) ;;; Generated autoloads from autoload.el (autoload (quote update-file-autoloads) "autoload" "\ Update the autoloads for FILE in `generated-autoload-file' \(which FILE might bind in its local variables)." t nil) (autoload (quote update-autoloads-here) "autoload" "\ Update sections of the current buffer generated by \\[update-file-autoloads]." t nil) (autoload (quote update-directory-autoloads) "autoload" "\ Run \\[update-file-autoloads] on each .el file in DIR." t nil) (autoload (quote batch-update-autoloads) "autoload" "\ Update the autoloads for the files or directories on the command line. Runs \\[update-file-autoloads] on files and \\[update-directory-autoloads] on directories. Must be used only with -batch, and kills Emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke `emacs -batch -f batch-update-autoloads *.el'." nil nil) ;;;*** ;;;### (autoloads (mouse-avoidance-mode) "avoid" "avoid.el" (12437 508)) ;;; Generated autoloads from avoid.el (autoload (quote mouse-avoidance-mode) "avoid" "\ Set cursor avoidance mode to MODE. MODE should be one of the symbols `banish', `exile', `jump', `animate', `cat-and-mouse', `proteus', or `none'. If MODE is nil, toggle mouse avoidance between `none` and `banish' modes. Positive numbers and symbols other than the above are treated as equivalent to `banish'; negative numbers and `-' are equivalent to `none'. Effects of the different modes: * banish: Move the mouse to the upper-right corner on any keypress. * exile: Move the mouse to the corner only if the cursor gets too close, and allow it to return once the cursor is out of the way. * jump: If the cursor gets too close to the mouse, displace the mouse a random distance & direction. * animate: As `jump', but shows steps along the way for illusion of motion. * cat-and-mouse: Same as `animate'. * proteus: As `animate', but changes the shape of the mouse pointer too. Whenever the mouse is moved, the frame is also raised. \(see `mouse-avoidance-threshold' for definition of \"too close\", and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for definition of \"random distance\".)" t nil) ;;;*** ;;;### (autoloads (awk-mode) "awk-mode" "awk-mode.el" (12116 38333)) ;;; Generated autoloads from awk-mode.el (autoload (quote awk-mode) "awk-mode" "\ Major mode for editing AWK code. This is much like C mode except for the syntax of comments. It uses the same keymap as C mode and has the same variables for customizing indentation. It has its own abbrev table and its own syntax table. Turning on AWK mode calls the value of the variable `awk-mode-hook' with no args, if that value is non-nil." t nil) ;;;*** ;;;### (autoloads (backquote) "backquote" "backquote.el" (12437 592)) ;;; Generated autoloads from backquote.el (autoload (quote backquote) "backquote" "\ Argument STRUCTURE describes a template to build. The whole structure acts as if it were quoted except for certain places where expressions are evaluated and inserted or spliced in. For example: b => (ba bb bc) ; assume b has this value `(a b c) => (a b c) ; backquote acts like quote `(a ,b c) => (a (ba bb bc) c) ; insert the value of b `(a ,@b c) => (a ba bb bc c) ; splice in the value of b Vectors work just like lists. Nested backquotes are permitted." nil (quote macro)) (defalias (quote \`) (symbol-function (quote backquote))) ;;;*** ;;;### (autoloads (bibtex-mode) "bibtex" "bibtex.el" (12322 49197)) ;;; Generated autoloads from bibtex.el (autoload (quote bibtex-mode) "bibtex" "\ Major mode for editing BibTeX files. \\{bibtex-mode-map} A command such as \\[bibtex-Book] will outline the fields for a BibTeX book entry. The optional fields start with the string OPT, and thus ignored by BibTeX. The OPT string may be removed from a field with \\[bibtex-remove-OPT]. \\[bibtex-kill-optional-field] kills the current optional field entirely. \\[bibtex-remove-double-quotes-or-braces] removes the double-quotes or braces around the text of the current field. \\[bibtex-empty-field] replaces the text of the current field with the default \"\" or {}. The command \\[bibtex-clean-entry] cleans the current entry, i.e. (i) removes double-quotes or braces from entirely numerical fields, (ii) removes OPT from all non-empty optional fields, (iii) removes all empty optional fields, and (iv) checks that no non-optional fields are empty. Use \\[bibtex-find-text] to position the cursor at the end of the current field. Use \\[bibtex-next-field] to move to end of the next field. The following may be of interest as well: Functions: bibtex-entry bibtex-print-help-message bibtex-beginning-of-entry bibtex-end-of-entry bibtex-ispell-abstract bibtex-narrow-to-entry bibtex-hide-entry-bodies bibtex-sort-entries bibtex-validate-buffer bibtex-pop-previous bibtex-pop-next bibtex-complete-string Variables: bibtex-field-left-delimiter bibtex-field-right-delimiter bibtex-include-OPTcrossref bibtex-include-OPTkey bibtex-include-OPTannote bibtex-mode-user-optional-fields bibtex-clean-entry-zap-empty-opts bibtex-sort-ignore-string-entries bibtex-maintain-sorted-entries bibtex-entry-field-alist bibtex-predefined-strings bibtex-string-files --------------------------------------------------------- Entry to this mode calls the value of bibtex-mode-hook if that value is non-nil." t nil) ;;;*** ;;;### (autoloads (blackbox) "blackbox" "blackbox.el" (11356 18211)) ;;; Generated autoloads from blackbox.el (autoload (quote blackbox) "blackbox" "\ Play blackbox. Optional prefix argument is the number of balls; the default is 4. What is blackbox? Blackbox is a game of hide and seek played on an 8 by 8 grid (the Blackbox). Your opponent (Emacs, in this case) has hidden several balls (usually 4) within this box. By shooting rays into the box and observing where they emerge it is possible to deduce the positions of the hidden balls. The fewer rays you use to find the balls, the lower your score. Overview of play: \\To play blackbox, type \\[blackbox]. An optional prefix argument specifies the number of balls to be hidden in the box; the default is four. The cursor can be moved around the box with the standard cursor movement keys. To shoot a ray, move the cursor to the edge of the box and press SPC. The result will be determined and the playfield updated. You may place or remove balls in the box by moving the cursor into the box and pressing \\[bb-romp]. When you think the configuration of balls you have placed is correct, press \\[bb-done]. You will be informed whether you are correct or not, and be given your score. Your score is the number of letters and numbers around the outside of the box plus five for each incorrectly placed ball. If you placed any balls incorrectly, they will be indicated with `x', and their actual positions indicated with `o'. Details: There are three possible outcomes for each ray you send into the box: Detour: the ray is deflected and emerges somewhere other than where you sent it in. On the playfield, detours are denoted by matching pairs of numbers -- one where the ray went in, and the other where it came out. Reflection: the ray is reflected and emerges in the same place it was sent in. On the playfield, reflections are denoted by the letter `R'. Hit: the ray strikes a ball directly and is absorbed. It does not emerge from the box. On the playfield, hits are denoted by the letter `H'. The rules for how balls deflect rays are simple and are best shown by example. As a ray approaches a ball it is deflected ninety degrees. Rays can be deflected multiple times. In the diagrams below, the dashes represent empty box locations and the letter `O' represents a ball. The entrance and exit points of each ray are marked with numbers as described under \"Detour\" above. Note that the entrance and exit points are always interchangeable. `*' denotes the path taken by the ray. Note carefully the relative positions of the ball and the ninety degree deflection it causes. 1 - * - - - - - - - - - - - - - - - - - - - - - - - * - - - - - - - - - - - - - - - - - - - - - - 1 * * - - - - - - - - - - - - - - - O - - - - O - - - O - - - - - - - O - - - - - - - * * * * - - - - - - - - - - - - - * * * * * 2 3 * * * - - * - - - - - - - - - - - - - * - - - - - - - O - * - - - - - - - - - - - - - * - - - - - - - - * * - - - - - - - - - - - - - * - - - - - - - - * - O - 2 3 As mentioned above, a reflection occurs when a ray emerges from the same point it was sent in. This can happen in several ways: - - - - - - - - - - - - - - - - - - - - - - - - - - - - O - - - - - O - O - - - - - - - - - - - R * * * * - - - - - - - * - - - - O - - - - - - - - - - - O - - - - - - * - - - - R - - - - - - - - - - - - - - - - - - - * - - - - - - - - - - - - - - - - - - - - - - - * - - - - - - - - - - - - - - - - - - - - R * * * * - - - - - - - - - - - - - - - - - - - - - - - - O - - - - - - - - - - - In the first example, the ray is deflected downwards by the upper ball, then left by the lower ball, and finally retraces its path to its point of origin. The second example is similar. The third example is a bit anomalous but can be rationalized by realizing the ray never gets a chance to get into the box. Alternatively, the ray can be thought of as being deflected downwards and immediately emerging from the box. A hit occurs when a ray runs straight into a ball: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - O - - - - - - - - - - - - - - - O - - - H * * * * - - - - - - - - - - - - H * * * * O - - - - - - * - - - - - - - - - - - - - - - - O - - - - - - O - - - - H * * * O - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Be sure to compare the second example of a hit with the first example of a reflection." t nil) ;;;*** ;;;### (autoloads (bookmark-menu-delete bookmark-menu-rename bookmark-menu-locate bookmark-menu-jump bookmark-menu-insert bookmark-bmenu-list bookmark-load bookmark-save bookmark-write bookmark-delete bookmark-insert bookmark-rename bookmark-insert-location bookmark-relocate bookmark-jump bookmark-set) "bookmark" "bookmark.el" (12339 39506)) ;;; Generated autoloads from bookmark.el (if (symbolp (key-binding "r")) nil (progn (define-key ctl-x-map "rb" (quote bookmark-jump)) (define-key ctl-x-map "rm" (quote bookmark-set)) (define-key ctl-x-map "rl" (quote bookmark-bmenu-list)))) (defvar bookmark-map nil "\ Keymap containing bindings to bookmark functions. It is not bound to any key by default: to bind it so that you have a bookmark prefix, just use `global-set-key' and bind a key of your choice to `bookmark-map'. All interactive bookmark functions have a binding in this keymap.") (define-prefix-command (quote bookmark-map)) (define-key bookmark-map "x" (quote bookmark-set)) (define-key bookmark-map "m" (quote bookmark-set)) (define-key bookmark-map "j" (quote bookmark-jump)) (define-key bookmark-map "g" (quote bookmark-jump)) (define-key bookmark-map "i" (quote bookmark-insert)) (define-key bookmark-map "e" (quote edit-bookmarks)) (define-key bookmark-map "f" (quote bookmark-insert-location)) (define-key bookmark-map "r" (quote bookmark-rename)) (define-key bookmark-map "d" (quote bookmark-delete)) (define-key bookmark-map "l" (quote bookmark-load)) (define-key bookmark-map "w" (quote bookmark-write)) (define-key bookmark-map "s" (quote bookmark-save)) (add-hook (quote kill-emacs-hook) (function (lambda nil (and (featurep (quote bookmark)) bookmark-alist (bookmark-time-to-save-p t) (bookmark-save))))) (autoload (quote bookmark-set) "bookmark" "\ Set a bookmark named NAME inside a file. If name is nil, then the user will be prompted. With prefix arg, will not overwrite a bookmark that has the same name as NAME if such a bookmark already exists, but instead will \"push\" the new bookmark onto the bookmark alist. Thus the most recently set bookmark with name NAME would be the one in effect at any given time, but the others are still there, should you decide to delete the most recent one. To yank words from the text of the buffer and use them as part of the bookmark name, type C-w while setting a bookmark. Successive C-w's yank successive words. Typing C-u inserts the name of the last bookmark used in the buffer \(as an aid in using a single bookmark name to track your progress through a large file). If no bookmark was used, then C-u inserts the name of the file being visited. Use \\[bookmark-delete] to remove bookmarks (you give it a name, and it removes only the first instance of a bookmark with that name from the list of bookmarks.)" t nil) (autoload (quote bookmark-jump) "bookmark" "\ Jump to bookmark BOOKMARK (a point in some file). You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this. If the file pointed to by BOOKMARK no longer exists, you will be asked if you wish to give the bookmark a new location, and bookmark-jump will then jump to the new location, as well as recording it in place of the old one in the permanent bookmark record." t nil) (autoload (quote bookmark-relocate) "bookmark" "\ Relocate BOOKMARK -- prompts for a filename, and makes an already existing bookmark point to that file, instead of the one it used to point at. Useful when a file has been renamed after a bookmark was set in it." t nil) (autoload (quote bookmark-insert-location) "bookmark" "\ Insert the name of the file associated with BOOKMARK. Optional second arg NO-HISTORY means don't record this in the minibuffer history list `bookmark-history'." t nil) (autoload (quote bookmark-rename) "bookmark" "\ Change the name of OLD bookmark to NEW name. If called from keyboard, prompts for OLD and NEW. If called from menubar, OLD is selected from a menu, and prompts for NEW. If called from Lisp, prompts for NEW if only OLD was passed as an argument. If called with two strings, then no prompting is done. You must pass at least OLD when calling from Lisp. While you are entering the new name, consecutive C-w's insert consectutive words from the text of the buffer into the new bookmark name." t nil) (autoload (quote bookmark-insert) "bookmark" "\ Insert the text of the file pointed to by bookmark BOOKMARK. You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this." t nil) (autoload (quote bookmark-delete) "bookmark" "\ Delete BOOKMARK from the bookmark list. Removes only the first instance of a bookmark with that name. If there are one or more other bookmarks with the same name, they will not be deleted. Defaults to the \"current\" bookmark (that is, the one most recently used in this file, if any). Optional second arg BATCH means don't update the bookmark list buffer, probably because we were called from there." t nil) (autoload (quote bookmark-write) "bookmark" "\ Write bookmarks to a file (for which the user will be prompted interactively). Don't use this in Lisp programs; use bookmark-save instead." t nil) (autoload (quote bookmark-save) "bookmark" "\ Save currently defined bookmarks. Saves by default in the file defined by the variable `bookmark-default-file'. With a prefix arg, save it in file FILE \(second argument). If you are calling this from Lisp, the two arguments are PREFIX-ARG and FILE, and if you just want it to write to the default file, then pass no arguments. Or pass in nil and FILE, and it will save in FILE instead. If you pass in one argument, and it is non-nil, then the user will be interactively queried for a file to save in. When you want to load in the bookmarks from a file, use `bookmark-load', \\[bookmark-load]. That function will prompt you for a file, defaulting to the file defined by variable `bookmark-default-file'." t nil) (autoload (quote bookmark-load) "bookmark" "\ Load bookmarks from FILE (which must be in bookmark format). Appends loaded bookmarks to the front of the list of bookmarks. If optional second argument REVERT is non-nil, existing bookmarks are destroyed. Optional third arg NO-MSG means don't display any messages while loading. If you load a file that doesn't contain a proper bookmark alist, you will corrupt Emacs's bookmark list. Generally, you should only load in files that were created with the bookmark functions in the first place. Your own personal bookmark file, `~/.emacs.bmk', is maintained automatically by Emacs; you shouldn't need to load it explicitly." t nil) (autoload (quote bookmark-bmenu-list) "bookmark" "\ Display a list of existing bookmarks. The list is displayed in a buffer named `*Bookmark List*'. The leftmost column displays a D if the bookmark is flagged for deletion, or > if it is flagged for displaying." t nil) (defalias (quote list-bookmarks) (quote bookmark-bmenu-list)) (defalias (quote edit-bookmarks) (quote bookmark-bmenu-list)) (autoload (quote bookmark-menu-insert) "bookmark" "\ Insert the text of the file pointed to by bookmark BOOKMARK. You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this. Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp (the one without the \"-menu-\" in its name)." t nil) (autoload (quote bookmark-menu-jump) "bookmark" "\ Jump to bookmark BOOKMARK (a point in some file). You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this. Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp (the one without the \"-menu-\" in its name)." t nil) (autoload (quote bookmark-menu-locate) "bookmark" "\ Insert the name of the file associated with BOOKMARK. \(This is not the same as the contents of that file). Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp (the one without the \"-menu-\" in its name)." t nil) (autoload (quote bookmark-menu-rename) "bookmark" "\ Change the name of OLD-BOOKMARK to NEWNAME. If called from keyboard, prompts for OLD-BOOKMARK and NEWNAME. If called from menubar, OLD-BOOKMARK is selected from a menu, and prompts for NEWNAME. If called from Lisp, prompts for NEWNAME if only OLD-BOOKMARK was passed as an argument. If called with two strings, then no prompting is done. You must pass at least OLD-BOOKMARK when calling from Lisp. While you are entering the new name, consecutive C-w's insert consectutive words from the text of the buffer into the new bookmark name. Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp (the one without the \"-menu-\" in its name)." t nil) (autoload (quote bookmark-menu-delete) "bookmark" "\ Delete the bookmark named NAME from the bookmark list. Removes only the first instance of a bookmark with that name. If there are one or more other bookmarks with the same name, they will not be deleted. Defaults to the \"current\" bookmark (that is, the one most recently used in this file, if any). Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp (the one without the \"-menu-\" in its name)." t nil) (defvar menu-bar-bookmark-map (make-sparse-keymap "Bookmark functions")) (defalias (quote menu-bar-bookmark-map) (symbol-value (quote menu-bar-bookmark-map))) (define-key menu-bar-bookmark-map [load] (quote ("Load a Bookmark File" . bookmark-load))) (define-key menu-bar-bookmark-map [write] (quote ("Write (to another file)" . bookmark-write))) (define-key menu-bar-bookmark-map [save] (quote ("Save (in default file)" . bookmark-save))) (define-key menu-bar-bookmark-map [edit] (quote ("Edit Bookmark List" . bookmark-bmenu-list))) (define-key menu-bar-bookmark-map [delete] (quote ("Delete Bookmark" . bookmark-menu-delete))) (define-key menu-bar-bookmark-map [rename] (quote ("Rename Bookmark" . bookmark-menu-rename))) (define-key menu-bar-bookmark-map [locate] (quote ("Insert Location" . bookmark-menu-locate))) (define-key menu-bar-bookmark-map [insert] (quote ("Insert Contents" . bookmark-menu-insert))) (define-key menu-bar-bookmark-map [set] (quote ("Set Bookmark" . bookmark-set))) (define-key menu-bar-bookmark-map [jump] (quote ("Jump to Bookmark" . bookmark-menu-jump))) ;;;*** ;;;### (autoloads (batch-byte-recompile-directory batch-byte-compile display-call-tree byte-compile compile-defun byte-compile-file byte-recompile-directory byte-force-recompile) "bytecomp" "bytecomp.el" (12451 35049)) ;;; Generated autoloads from bytecomp.el (autoload (quote byte-force-recompile) "bytecomp" "\ Recompile every `.el' file in DIRECTORY that already has a `.elc' file. Files in subdirectories of DIRECTORY are processed also." t nil) (autoload (quote byte-recompile-directory) "bytecomp" "\ Recompile every `.el' file in DIRECTORY that needs recompilation. This is if a `.elc' file exists but is older than the `.el' file. Files in subdirectories of DIRECTORY are processed also. If the `.elc' file does not exist, normally the `.el' file is *not* compiled. But a prefix argument (optional second arg) means ask user, for each such `.el' file, whether to compile it. Prefix argument 0 means don't ask and compile the file anyway. A nonzero prefix argument also means ask about each subdirectory. If the third argument FORCE is non-nil, recompile every `.el' file that already has a `.elc' file." t nil) (autoload (quote byte-compile-file) "bytecomp" "\ Compile a file of Lisp code named FILENAME into a file of byte code. The output file's name is made by appending `c' to the end of FILENAME. With prefix arg (noninteractively: 2nd arg), load the file after compiling." t nil) (autoload (quote compile-defun) "bytecomp" "\ Compile and evaluate the current top-level form. Print the result in the minibuffer. With argument, insert value in current buffer after the form." t nil) (autoload (quote byte-compile) "bytecomp" "\ If FORM is a symbol, byte-compile its function definition. If FORM is a lambda or a macro, byte-compile it as a function." nil nil) (autoload (quote display-call-tree) "bytecomp" "\ Display a call graph of a specified file. This lists which functions have been called, what functions called them, and what functions they call. The list includes all functions whose definitions have been compiled in this Emacs session, as well as all functions called by those functions. The call graph does not include macros, inline functions, or primitives that the byte-code interpreter knows about directly (eq, cons, etc.). The call tree also lists those functions which are not known to be called \(that is, to which no calls have been compiled), and which cannot be invoked interactively." t nil) (autoload (quote batch-byte-compile) "bytecomp" "\ Run `byte-compile-file' on the files remaining on the command line. Use this from the command line, with `-batch'; it won't work in an interactive Emacs. Each file is processed even if an error occurred previously. For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" nil nil) (autoload (quote batch-byte-recompile-directory) "bytecomp" "\ Runs `byte-recompile-directory' on the dirs remaining on the command line. Must be used only with `-batch', and kills Emacs on completion. For example, invoke `emacs -batch -f batch-byte-recompile-directory .'." nil nil) ;;;*** ;;;### (autoloads nil "cal-dst" "cal-dst.el" (12384 54305)) ;;; Generated autoloads from cal-dst.el (put (quote calendar-daylight-savings-starts) (quote risky-local-variable) t) (put (quote calendar-daylight-savings-ends) (quote risky-local-variable) t) ;;;*** ;;;### (autoloads (list-yahrzeit-dates) "cal-hebrew" "cal-hebrew.el" (12384 54943)) ;;; Generated autoloads from cal-hebrew.el (autoload (quote list-yahrzeit-dates) "cal-hebrew" "\ 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) ;;;*** ;;;### (autoloads (calendar) "calendar" "calendar.el" (12413 13265)) ;;; Generated autoloads from calendar.el (defvar calendar-week-start-day 0 "\ *The day of the week on which a week in the calendar begins. 0 means Sunday (default), 1 means Monday, and so on.") (defvar calendar-offset 0 "\ *The offset of the principal month from the center of the calendar window. 0 means the principal month is in the center (default), -1 means on the left, +1 means on the right. Larger (or smaller) values push the principal month off the screen.") (defvar view-diary-entries-initially nil "\ *Non-nil means display current date's diary entries on entry. The diary is displayed in another window when the calendar is first displayed, if the current date is visible. The number of days of diary entries displayed is governed by the variable `number-of-diary-entries'.") (defvar number-of-diary-entries 1 "\ *Specifies how many days of diary entries are to be displayed initially. This variable affects the diary display when the command M-x diary is used, or if the value of the variable `view-diary-entries-initially' is t. For example, if the default value 1 is used, then only the current day's diary entries will be displayed. If the value 2 is used, then both the current day's and the next day's entries will be displayed. The value can also be a vector such as [0 2 2 2 2 4 1]; this value says to display no diary entries on Sunday, the display the entries for the current date and the day after on Monday through Thursday, display Friday through Monday's entries on Friday, and display only Saturday's entries on Saturday. This variable does not affect the diary display with the `d' command from the calendar; in that case, the prefix argument controls the number of days of diary entries displayed.") (defvar mark-diary-entries-in-calendar nil "\ *Non-nil means mark dates with diary entries, in the calendar window. The marking symbol is specified by the variable `diary-entry-marker'.") (defvar view-calendar-holidays-initially nil "\ *Non-nil means display holidays for current three month period on entry. The holidays are displayed in another window when the calendar is first displayed.") (defvar mark-holidays-in-calendar nil "\ *Non-nil means mark dates of holidays in the calendar window. The marking symbol is specified by the variable `calendar-holiday-marker'.") (defvar all-hebrew-calendar-holidays nil "\ *If nil, show only major holidays from the Hebrew calendar. This means only those Jewish holidays that appear on secular calendars. If t, show all the holidays that would appear in a complete Hebrew calendar.") (defvar all-christian-calendar-holidays nil "\ *If nil, show only major holidays from the Christian calendar. This means only those Christian holidays that appear on secular calendars. If t, show all the holidays that would appear in a complete Christian calendar.") (defvar all-islamic-calendar-holidays nil "\ *If nil, show only major holidays from the Islamic calendar. This means only those Islamic holidays that appear on secular calendars. If t, show all the holidays that would appear in a complete Islamic calendar.") (defvar calendar-load-hook nil "\ *List of functions to be called after the calendar is first loaded. This is the place to add key bindings to `calendar-mode-map'.") (defvar initial-calendar-window-hook nil "\ *List of functions to be called when the calendar window is first opened. The functions invoked are called after the calendar window is opened, but once opened is never called again. Leaving the calendar with the `q' command and reentering it will cause these functions to be called again.") (defvar today-visible-calendar-hook nil "\ *List of functions called whenever the current date is visible. This can be used, for example, to replace today's date with asterisks; a function `calendar-star-date' is included for this purpose: (setq today-visible-calendar-hook 'calendar-star-date) It can also be used to mark the current date with `calendar-today-marker'; a function is also provided for this: (setq today-visible-calendar-hook 'calendar-mark-today) The corresponding variable `today-invisible-calendar-hook' is the list of functions called when the calendar function was called when the current date is not visible in the window. Other than the use of the provided functions, the changing of any characters in the calendar buffer by the hooks may cause the failure of the functions that move by days and weeks.") (defvar today-invisible-calendar-hook nil "\ *List of functions called whenever the current date is not visible. The corresponding variable `today-visible-calendar-hook' is the list of functions called when the calendar function was called when the current date is visible in the window. Other than the use of the provided functions, the changing of any characters in the calendar buffer by the hooks may cause the failure of the functions that move by days and weeks.") (defvar diary-file "~/diary" "\ *Name of the file in which one's personal diary of dates is kept. The file's entries are lines in any of the forms MONTH/DAY MONTH/DAY/YEAR MONTHNAME DAY MONTHNAME DAY, YEAR DAYNAME at the beginning of the line; the remainder of the line is the diary entry string for that date. MONTH and DAY are one or two digit numbers, YEAR is a number and may be written in full or abbreviated to the final two digits. If the date does not contain a year, it is generic and applies to any year. DAYNAME entries apply to any date on which is on that day of the week. MONTHNAME and DAYNAME can be spelled in full, abbreviated to three characters (with or without a period), capitalized or not. Any of DAY, MONTH, or MONTHNAME, YEAR can be `*' which matches any day, month, or year, respectively. The European style (in which the day precedes the month) can be used instead, if you execute `european-calendar' when in the calendar, or set `european-calendar-style' to t in your .emacs file. The European forms are DAY/MONTH DAY/MONTH/YEAR DAY MONTHNAME DAY MONTHNAME YEAR DAYNAME To revert to the default American style from the European style, execute `american-calendar' in the calendar. A diary entry can be preceded by the character `diary-nonmarking-symbol' (ordinarily `&') to make that entry nonmarking--that is, it will not be marked on dates in the calendar window but will appear in a diary window. Multiline diary entries are made by indenting lines after the first with either a TAB or one or more spaces. Lines not in one the above formats are ignored. Here are some sample diary entries (in the default American style): 12/22/1988 Twentieth wedding anniversary!! &1/1. Happy New Year! 10/22 Ruth's birthday. 21: Payday Tuesday--weekly meeting with grad students at 10am Supowit, Shen, Bitner, and Kapoor to attend. 1/13/89 Friday the thirteenth!! &thu 4pm squash game with Lloyd. mar 16 Dad's birthday April 15, 1989 Income tax due. &* 15 time cards due. If the first line of a diary entry consists only of the date or day name with no trailing blanks or punctuation, then that line is not displayed in the diary window; only the continuation lines is shown. For example, the single diary entry 02/11/1989 Bill Blattner visits Princeton today 2pm Cognitive Studies Committee meeting 2:30-5:30 Lizzie at Lawrenceville for `Group Initiative' 4:00pm Jamie Tappenden 7:30pm Dinner at George and Ed's for Alan Ryan 7:30-10:00pm dance at Stewart Country Day School will appear in the diary window without the date line at the beginning. This facility allows the diary window to look neater, but can cause confusion if used with more than one day's entries displayed. Diary entries can be based on Lisp sexps. For example, the diary entry %%(diary-block 11 1 1990 11 10 1990) Vacation causes the diary entry \"Vacation\" to appear from November 1 through November 10, 1990. Other functions available are `diary-float', `diary-anniversary', `diary-cyclic', `diary-day-of-year', `diary-iso-date', `diary-french-date', `diary-hebrew-date', `diary-islamic-date', `diary-mayan-date', `diary-chinese-date', `diary-coptic-date', `diary-ethiopic-date', `diary-yahrzeit', `diary-sunrise-sunset', `diary-phases-of-moon', `diary-parasha', `diary-omer', `diary-rosh-hodesh', and `diary-sabbath-candles'. See the documentation for the function `list-sexp-diary-entries' for more details. Diary entries based on the Hebrew and/or the Islamic calendar are also possible, but because these are somewhat slow, they are ignored unless you set the `nongregorian-diary-listing-hook' and the `nongregorian-diary-marking-hook' appropriately. See the documentation for these functions for details. Diary files can contain directives to include the contents of other files; for details, see the documentation for the variable `list-diary-entries-hook'.") (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 "%%" "\ *The string used to indicate a sexp diary entry in diary-file. See the documentation for the function `list-sexp-diary-entries'.") (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 DAY/MONTH/YEAR DAY MONTHNAME DAY MONTHNAME YEAR DAYNAME Names can be capitalized or not, written in full, or abbreviated to three characters with or without a period.") (defvar american-date-diary-pattern (quote ((month "/" day "[^/0-9]") (month "/" day "/" year "[^0-9]") (monthname " *" day "[^,0-9]") (monthname " *" day ", *" year "[^0-9]") (dayname "\\W"))) "\ *List of pseudo-patterns describing the American patterns of date used. See the documentation of `diary-date-forms' for an explanation.") (defvar european-date-diary-pattern (quote ((day "/" month "[^/0-9]") (day "/" month "/" year "[^0-9]") (backup day " *" monthname "\\W+\\<[^*0-9]") (day " *" monthname " *" year "[^0-9]") (dayname "\\W"))) "\ *List of pseudo-patterns describing the European patterns of date used. See the documentation of `diary-date-forms' for an explanation.") (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-form 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-form' for an explanation.") (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 this hook. This function enables you to use shared diary files together with your own. The files included are specified in the diary file by lines of the form #include \"filename\" This is recursive; that is, #include directives in files thus included are obeyed. You can change the \"#include\" to some other string by changing the variable `diary-include-string'. When you use `include-other-diary-files' as part of the list-diary-entries-hook, you will probably also want to use the function `mark-included-diary-files' as part of `mark-diary-entries-hook'. For example, you could use (setq list-diary-entries-hook '(include-other-diary-files sort-diary-entries)) (setq diary-display-hook 'fancy-diary-display) in your `.emacs' file to cause the fancy diary buffer to be displayed with diary entries from various included files, each day's entries sorted into lexicographic order.") (defvar diary-hook nil "\ *List of functions called after the display of the diary. Can be used for appointment notification.") (defvar diary-display-hook nil "\ *List of functions that handle the display of the diary. If nil (the default), `simple-diary-display' is used. Use `ignore' for no diary display. Ordinarily, this just displays the diary buffer (with holidays indicated in the mode line), if there are any relevant entries. At the time these functions are called, the variable `diary-entries-list' is a list, in order by date, of all relevant diary entries in the form of ((MONTH DAY YEAR) STRING), where string is the diary entry for the given date. This can be used, for example, a different buffer for display (perhaps combined with holidays), or produce hard copy output. A function `fancy-diary-display' is provided as an alternative choice for this hook; this function prepares a special noneditable diary buffer with the relevant diary entries that has neat day-by-day arrangement with headings. The fancy diary buffer will show the holidays unless the variable `holidays-in-diary-buffer' is set to nil. Ordinarily, the fancy diary buffer will not show days for which there are no diary entries, even if that day is a holiday; if you want such days to be shown in the fancy diary buffer, set the variable `diary-list-include-blanks' to t.") (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 "\ *List of functions called after marking diary entries in the calendar. A function `mark-included-diary-files' is also provided for use as the mark-diary-entries-hook; it enables you to use shared diary files together with your own. The files included are specified in the diary file by lines of the form #include \"filename\" This is recursive; that is, #include directives in files thus included are obeyed. You can change the \"#include\" to some other string by changing the variable `diary-include-string'. When you use `mark-included-diary-files' as part of the mark-diary-entries-hook, you will probably also want to use the function `include-other-diary-files' as part of `list-diary-entries-hook'.") (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 "\ *Non-nil means include holidays in the diary display. The holidays appear 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 makes the diary display faster.") (put (quote general-holidays) (quote risky-local-variable) t) (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.") (put (quote oriental-holidays) (quote risky-local-variable) t) (defvar oriental-holidays (quote ((if (fboundp (quote atan)) (holiday-chinese-new-year)))) "\ *Oriental holidays. See the documentation for `calendar-holidays' for details.") (put (quote local-holidays) (quote risky-local-variable) t) (defvar local-holidays nil "\ *Local holidays. See the documentation for `calendar-holidays' for details.") (put (quote other-holidays) (quote risky-local-variable) t) (defvar other-holidays nil "\ *User defined holidays. See the documentation for `calendar-holidays' for details.") (put (quote hebrew-holidays-1) (quote risky-local-variable) t) (defvar hebrew-holidays-1 (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)"))))) (put (quote hebrew-holidays-2) (quote risky-local-variable) t) (defvar hebrew-holidays-2 (quote ((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"))))) (put (quote hebrew-holidays-3) (quote risky-local-variable) t) (defvar hebrew-holidays-3 (quote ((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"))))) (put (quote hebrew-holidays-4) (quote risky-local-variable) t) (defvar hebrew-holidays-4 (quote ((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))))) (put (quote hebrew-holidays) (quote risky-local-variable) t) (defvar hebrew-holidays (append hebrew-holidays-1 hebrew-holidays-2 hebrew-holidays-3 hebrew-holidays-4) "\ *Jewish holidays. See the documentation for `calendar-holidays' for details.") (put (quote christian-holidays) (quote risky-local-variable) t) (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.") (put (quote islamic-holidays) (quote risky-local-variable) t) (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.") (put (quote solar-holidays) (quote risky-local-variable) t) (defvar solar-holidays (quote ((if (fboundp (quote atan)) (solar-equinoxes-solstices)) (if (progn (require (quote cal-dst)) t) (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-starts-time (float 60)) calendar-standard-time-zone-name) ""))))) (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-ends-time (float 60)) calendar-daylight-time-zone-name) "")))))) "\ *Sun-related holidays. See the documentation for `calendar-holidays' for details.") (put (quote calendar-holidays) (quote risky-local-variable) t) (defvar calendar-setup nil "\ The frame set up of the calendar. The choices are `one-frame' (calendar and diary together in one separate, dediciated frame) or `two-frames' (calendar and diary in separate, dedicated frames); with any other value the current frame is used.") (autoload (quote calendar) "calendar" "\ Choose between the one frame, two frame, or basic calendar displays. The original function `calendar' has been renamed `calendar-basic-setup'." t nil) ;;;*** ;;;### (autoloads (set-case-syntax set-case-syntax-pair set-case-syntax-delims copy-case-table describe-buffer-case-table) "case-table" "case-table.el" (12435 57930)) ;;; Generated autoloads from case-table.el (autoload (quote describe-buffer-case-table) "case-table" "\ Describe the case table of the current buffer." t nil) (autoload (quote copy-case-table) "case-table" nil nil nil) (autoload (quote set-case-syntax-delims) "case-table" "\ Make characters L and R a matching pair of non-case-converting delimiters. This sets the entries for L and R in TABLE, which is a string that will be used as the downcase part of a case table. It also modifies `standard-syntax-table' to indicate left and right delimiters." nil nil) (autoload (quote set-case-syntax-pair) "case-table" "\ Make characters UC and LC a pair of inter-case-converting letters. This sets the entries for characters UC and LC in TABLE, which is a string that will be used as the downcase part of a case table. It also modifies `standard-syntax-table' to give them the syntax of word constituents." nil nil) (autoload (quote set-case-syntax) "case-table" "\ Make characters C case-invariant with syntax SYNTAX. This sets the entries for character C in TABLE, which is a string that will be used as the downcase part of a case table. It also modifies `standard-syntax-table'. SYNTAX should be \" \", \"w\", \".\" or \"_\"." nil nil) ;;;*** ;;;### (autoloads (objc-mode c-mode c++-mode) "cc-mode" "cc-mode.el" (12435 61040)) ;;; Generated autoloads from cc-mode.el (autoload (quote c++-mode) "cc-mode" "\ Major mode for editing C++ code. To submit a problem report, enter `\\[c-submit-bug-report]' from a c++-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the problem, including a reproducable test case and send the message. To see what version of cc-mode you are running, enter `\\[c-version]'. Note that the details of configuring c++-mode have been moved to the accompanying texinfo manual (which is not yet completed -- volunteers are welcome). Until then, please read the README file that came with the cc-mode distribution. The hook variable `c++-mode-hook' is run with no args, if that variable is bound and has a non-nil value. Also the common hook c-mode-common-hook is run first, by this defun, `c-mode', and `objc-mode'. Key bindings: \\{c++-mode-map}" t nil) (autoload (quote c-mode) "cc-mode" "\ Major mode for editing K&R and ANSI C code. To submit a problem report, enter `\\[c-submit-bug-report]' from a c-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the problem, including a reproducable test case and send the message. To see what version of cc-mode you are running, enter `\\[c-version]'. Note that the details of configuring c-mode have been moved to the accompanying texinfo manual (which is not yet completed -- volunteers are welcome). Until then, please read the README file that came with the cc-mode distribution. The hook variable `c-mode-hook' is run with no args, if that value is bound and has a non-nil value. Also the common hook c-mode-common-hook is run first, by this defun, `c++-mode', and `objc-mode'. Key bindings: \\{c-mode-map}" t nil) (autoload (quote objc-mode) "cc-mode" "\ Major mode for editing Objective C code. To submit a problem report, enter `\\[c-submit-bug-report]' from an objc-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the problem, including a reproducable test case and send the message. To see what version of cc-mode you are running, enter `\\[c-version]'. Note that the details of configuring objc-mode have been moved to the accompanying texinfo manual (which is not yet completed -- volunteers are welcome). Until then, please read the README file that came with the cc-mode distribution. The hook variable `objc-mode-hook' is run with no args, if that value is bound and has a non-nil value. Also the common hook c-mode-common-hook is run first, by this defun, `c-mode', and `c++-mode'. Key bindings: \\{objc-mode-map}" t nil) ;;;*** ;;;### (autoloads (command-history-mode list-command-history repeat-matching-complex-command) "chistory" "chistory.el" (11942 52235)) ;;; Generated autoloads from chistory.el (autoload (quote repeat-matching-complex-command) "chistory" "\ Edit and re-evaluate complex command with name matching PATTERN. Matching occurrences are displayed, most recent first, until you select a form for evaluation. If PATTERN is empty (or nil), every form in the command history is offered. The form is placed in the minibuffer for editing and the result is evaluated." t nil) (autoload (quote list-command-history) "chistory" "\ List history of commands typed to minibuffer. The number of commands listed is controlled by `list-command-history-max'. Calls value of `list-command-history-filter' (if non-nil) on each history element to judge if that element should be excluded from the list. The buffer is left in Command History mode." t nil) (autoload (quote command-history-mode) "chistory" "\ Major mode for examining commands from `command-history'. The number of commands listed is controlled by `list-command-history-max'. The command history is filtered by `list-command-history-filter' if non-nil. Use \\\\[command-history-repeat] to repeat the command on the current line. Otherwise much like Emacs-Lisp Mode except that there is no self-insertion and digits provide prefix arguments. Tab does not indent. \\{command-history-map} Calls the value of `command-history-hook' if that is non-nil. The Command History listing is recomputed each time this mode is invoked." t nil) ;;;*** ;;;### (autoloads (common-lisp-indent-function) "cl-indent" "cl-indent.el" (11285 49748)) ;;; Generated autoloads from cl-indent.el (autoload (quote common-lisp-indent-function) "cl-indent" nil nil nil) ;;;*** ;;;### (autoloads (run-scheme) "cmuscheme" "cmuscheme.el" (12338 795)) ;;; Generated autoloads from cmuscheme.el (autoload (quote run-scheme) "cmuscheme" "\ Run an inferior Scheme process, input and output via buffer *scheme*. If there is a process already running in `*scheme*', switch to that buffer. With argument, allows you to edit the command line (default is value of `scheme-program-name'). Runs the hooks `inferior-scheme-mode-hook' \(after the `comint-mode-hook' is run). \(Type \\[describe-mode] in the process buffer for a list of commands.)" t nil) (add-hook 'same-window-buffer-names "*scheme*") ;;;*** ;;;### (autoloads (comint-run make-comint) "comint" "comint.el" (12423 63603)) ;;; Generated autoloads from comint.el (autoload (quote make-comint) "comint" "\ Make a comint process NAME in a buffer, running PROGRAM. The name of the buffer is made by surrounding NAME with `*'s. PROGRAM should be either a string denoting an executable program to create via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP connection to be opened via `open-network-stream'. If there is already a running process in that buffer, it is not restarted. Optional third arg STARTFILE is the name of a file to send the contents of to the process. If PROGRAM is a string, any more args are arguments to PROGRAM." nil nil) (autoload (quote comint-run) "comint" "\ Run PROGRAM in a comint buffer and switch to it. The buffer name is made by surrounding the file name of PROGRAM with `*'s. The file name is used to make a symbol name, such as `comint-sh-hook', and any hooks on this symbol are run in the buffer. See `make-comint' and `comint-exec'." t nil) ;;;*** ;;;### (autoloads (compare-windows) "compare-w" "compare-w.el" (11983 50606)) ;;; Generated autoloads from compare-w.el (autoload (quote compare-windows) "compare-w" "\ Compare text in current window with text in next window. Compares the text starting at point in each window, moving over text in each one as far as they match. This command pushes the mark in each window at the prior location of point in that window. If both windows display the same buffer, the mark is pushed twice in that buffer: first in the other window, then in the selected window. A prefix arg means ignore changes in whitespace. The variable `compare-windows-whitespace' controls how whitespace is skipped. If `compare-ignore-case' is non-nil, changes in case are also ignored." t nil) ;;;*** ;;;### (autoloads (next-error compilation-minor-mode grep compile) "compile" "compile.el" (12409 27006)) ;;; Generated autoloads from compile.el (defvar compilation-mode-hook nil "\ *List of hook functions run by `compilation-mode' (see `run-hooks').") (defvar compilation-window-height nil "\ *Number of lines in a compilation window. If nil, use Emacs default.") (defvar compilation-buffer-name-function nil "\ Function to compute the name of a compilation buffer. The function receives one argument, the name of the major mode of the compilation buffer. It should return a string. nil means compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.") (defvar compilation-finish-function nil "\ *Function to call when a compilation process finishes. It is called with two arguments: the compilation buffer, and a string describing how the process finished.") (defvar compilation-search-path (quote (nil)) "\ *List of directories to search for source files named in error messages. Elements should be directory names, not file names of directories. nil as an element means to try the default directory.") (autoload (quote compile) "compile" "\ Compile the program including the current buffer. Default: run `make'. Runs COMMAND, a shell command, in a separate process asynchronously with output going to the buffer `*compilation*'. You can then use the command \\[next-error] to find the next error message and move to the source code that caused it. Interactively, prompts for the command if `compilation-read-command' is non-nil; otherwise uses `compile-command'. With prefix arg, always prompts. To run more than one compilation at once, start one and rename the `*compilation*' buffer to some other name with \\[rename-buffer]. Then start the next one. The name used for the buffer is actually whatever is returned by the function in `compilation-buffer-name-function', so you can set that to a function that generates a unique name." t nil) (autoload (quote grep) "compile" "\ Run grep, with user-specified args, and collect output in a buffer. While grep runs asynchronously, you can use the \\[next-error] command to find the text that grep hits refer to. This command uses a special history list for its arguments, so you can easily repeat a grep command." t nil) (autoload (quote compilation-minor-mode) "compile" "\ Toggle compilation minor mode. With arg, turn compilation mode on if and only if arg is positive. See `compilation-mode'." t nil) (autoload (quote next-error) "compile" "\ Visit next compilation error message and corresponding source code. This operates on the output from the \\[compile] command. If all preparsed error messages have been processed, the error message buffer is checked for new ones. A prefix arg specifies how many error messages to move; negative means move back to previous error messages. Just C-u as a prefix means reparse the error message buffer and start at the first error. \\[next-error] normally applies to the most recent compilation started, but as long as you are in the middle of parsing errors from one compilation output buffer, you stay with that compilation output buffer. Use \\[next-error] in a compilation output buffer to switch to processing errors from that compilation. See variables `compilation-parse-errors-function' and `compilation-error-regexp-alist' for customization ideas." t nil) (define-key ctl-x-map "`" 'next-error) ;;;*** ;;;### (autoloads (shuffle-vector cookie-snarf cookie-insert cookie) "cookie1" "cookie1.el" (11418 1804)) ;;; Generated autoloads from cookie1.el (autoload (quote cookie) "cookie1" "\ Return a random phrase from PHRASE-FILE. When the phrase file is read in, display STARTMSG at beginning of load, ENDMSG at end." nil nil) (autoload (quote cookie-insert) "cookie1" "\ Insert random phrases from PHRASE-FILE; COUNT of them. When the phrase file is read in, display STARTMSG at beginning of load, ENDMSG at end." nil nil) (autoload (quote cookie-snarf) "cookie1" "\ Reads in the PHRASE-FILE, returns it as a vector of strings. Emit STARTMSG and ENDMSG before and after. Caches the result; second and subsequent calls on the same file won't go to disk." nil nil) (autoload (quote shuffle-vector) "cookie1" "\ Randomly permute the elements of VECTOR (all permutations equally likely)" nil nil) ;;;*** ;;;### (autoloads (copyright copyright-update) "copyright" "copyright.el" (12292 1171)) ;;; Generated autoloads from copyright.el (autoload (quote copyright-update) "copyright" "\ Update the copyright notice at the beginning of the buffer to indicate the current year. If optional prefix ARG is given replace the years in the notice rather than adding the current year after them. If necessary and `copyright-current-gpl-version' is set, the copying permissions following the copyright, if any, are updated as well." t nil) (autoload (quote copyright) "copyright" "\ Insert a copyright by $ORGANIZATION notice at cursor." t nil) ;;;*** ;;;### (autoloads (cpp-parse-edit cpp-highlight-buffer) "cpp" "cpp.el" (12180 44882)) ;;; Generated autoloads from cpp.el (autoload (quote cpp-highlight-buffer) "cpp" "\ Highlight C code according to preprocessor conditionals. This command pops up a buffer which you should edit to specify what kind of highlighting to use, and the criteria for highlighting. A prefix arg suppresses display of that buffer." t nil) (autoload (quote cpp-parse-edit) "cpp" "\ Edit display information for cpp conditionals." t nil) ;;;*** ;;;### (autoloads (dabbrev-expand dabbrev-completion) "dabbrev" "dabbrev.el" (12424 2787)) ;;; Generated autoloads from dabbrev.el (define-key esc-map "/" (quote dabbrev-expand)) (define-key esc-map [67108911] (quote dabbrev-completion)) (autoload (quote dabbrev-completion) "dabbrev" "\ Completion on current word. Like \\[dabbrev-expand] but finds all expansions in the current buffer and presents suggestions for completion. With a prefix argument, it searches all buffers accepted by the function pointed out by `dabbrev-friend-buffer-function' to find the completions. If the prefix argument is 16 (which comes from C-u C-u), then it searches *all* buffers. With no prefix argument, it reuses an old completion list if there is a suitable one already." t nil) (autoload (quote dabbrev-expand) "dabbrev" "\ Expand previous word \"dynamically\". Expands to the most recent, preceding word for which this is a prefix. If no suitable preceding word is found, words following point are considered. If still no suitable word is found, then look in the buffers accepted by the function pointed out by variable `dabbrev-friend-buffer-function'. A positive prefix argument, N, says to take the Nth backward *distinct* possibility. A negative argument says search forward. If the cursor has not moved from the end of the previous expansion and no argument is given, replace the previously-made expansion with the next possible expansion not yet tried. The variable `dabbrev-backward-only' may be used to limit the direction of search to backward if set non-nil. See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]." t nil) ;;;*** ;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug" "debug.el" (12141 3542)) ;;; Generated autoloads from debug.el (setq debugger (quote debug)) (autoload (quote debug) "debug" "\ Enter debugger. To return, type \\`\\[debugger-continue]'. Arguments are mainly for use when this is called from the internals of the evaluator. You may call with no args, or you may pass nil as the first arg and any other args you like. In that case, the list of args after the first will be printed into the backtrace buffer." t nil) (autoload (quote debug-on-entry) "debug" "\ Request FUNCTION to invoke debugger each time it is called. If you tell the debugger to continue, FUNCTION's execution proceeds. This works by modifying the definition of FUNCTION, which must be written in Lisp, not predefined. Use \\[cancel-debug-on-entry] to cancel the effect of this command. Redefining FUNCTION also cancels it." t nil) (autoload (quote cancel-debug-on-entry) "debug" "\ Undo effect of \\[debug-on-entry] on FUNCTION. If argument is nil or an empty string, cancel for all functions." t nil) ;;;*** ;;;### (autoloads (delete-selection-mode) "delsel" "delsel.el" (12373 62512)) ;;; Generated autoloads from delsel.el (defalias (quote pending-delete-mode) (quote delete-selection-mode)) (autoload (quote delete-selection-mode) "delsel" "\ Toggle Delete Selection mode. When ON, typed text replaces the selection if the selection is active. When OFF, typed text is just inserted at point." t nil) ;;;*** ;;;### (autoloads (derived-mode-init-mode-variables define-derived-mode) "derived" "derived.el" (12425 54367)) ;;; Generated autoloads from derived.el (autoload (quote define-derived-mode) "derived" "\ Create a new mode as a variant of an existing mode. The arguments to this command are as follow: CHILD: the name of the command for the derived mode. PARENT: the name of the command for the parent mode (ie. text-mode). NAME: a string which will appear in the status line (ie. \"Hypertext\") DOCSTRING: an optional documentation string--if you do not supply one, the function will attempt to invent something useful. BODY: forms to execute just before running the hooks for the new mode. Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode: (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\") You could then make new key bindings for `LaTeX-thesis-mode-map' without changing regular LaTeX mode. In this example, BODY is empty, and DOCSTRING is generated by default. On a more complicated level, the following command uses sgml-mode as the parent, and then sets the variable `case-fold-search' to nil: (define-derived-mode article-mode sgml-mode \"Article\" \"Major mode for editing technical articles.\" (setq case-fold-search nil)) Note that if the documentation string had been left out, it would have been generated automatically, with a reference to the keymap." nil (quote macro)) (autoload (quote derived-mode-init-mode-variables) "derived" "\ Initialise variables for a new mode. Right now, if they don't already exist, set up a blank keymap, an empty syntax table, and an empty abbrev table -- these will be merged the first time the mode is used." nil nil) ;;;*** ;;;### (autoloads (diary) "diary-lib" "diary-lib.el" (12470 43759)) ;;; Generated autoloads from diary-lib.el (autoload (quote diary) "diary-lib" "\ Generate the diary window for ARG days starting with the current date. If no argument is provided, the number of days of diary entries is governed by the variable `number-of-diary-entries'. This function is suitable for execution in a `.emacs' file." t nil) ;;;*** ;;;### (autoloads (diff-backup diff) "diff" "diff.el" (11949 32903)) ;;; Generated autoloads from diff.el (autoload (quote diff) "diff" "\ Find and display the differences between OLD and NEW files. Interactively the current buffer's file name is the default for NEW and a backup file for NEW is the default for OLD. With prefix arg, prompt for diff switches." t nil) (autoload (quote diff-backup) "diff" "\ Diff this file with its backup file or vice versa. Uses the latest backup, if there are several numerical backups. If this file is a backup, diff it with its original. The backup file is the first file given to `diff'." t nil) ;;;*** ;;;### (autoloads (dired-noselect dired-other-frame dired-other-window dired) "dired" "dired.el" (12374 5214)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches "-al" "\ *Switches passed to `ls' for dired. MUST contain the `l' option. May contain all other options that don't contradict `-l'; may contain even `F', `b', `i' and `s'. See also the variable `dired-ls-F-marks-symlinks' concerning the `F' switch.") (defvar dired-chown-program (if (memq system-type (quote (hpux dgux usg-unix-v irix linux))) "chown" "/etc/chown") "\ Name of chown command (usually `chown' or `/etc/chown').") (defvar dired-ls-F-marks-symlinks nil "\ *Informs dired about how `ls -lF' marks symbolic links. Set this to t if `insert-directory-program' with `-lF' marks the symbolic link itself with a trailing @ (usually the case under Ultrix). Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to nil (the default), if it gives `bar@ -> foo', set it to t. Dired checks if there is really a @ appended. Thus, if you have a marking `ls' program on one host and a non-marking on another host, and don't care about symbolic links which really end in a @, you can always set this variable to t.") (defvar dired-trivial-filenames "^\\.\\.?$\\|^#" "\ *Regexp of files to skip when finding first file of a directory. A value of nil means move to the subdir line. A value of t means move to first file.") (defvar dired-keep-marker-rename t "\ *Controls marking of renamed files. If t, files keep their previous marks when they are renamed. If a character, renamed files (whether previously marked or not) are afterward marked with that character.") (defvar dired-keep-marker-copy 67 "\ *Controls marking of copied files. If t, copied files are marked if and as the corresponding original files were. If a character, copied files are unconditionally marked with that character.") (defvar dired-keep-marker-hardlink 72 "\ *Controls marking of newly made hard links. If t, they are marked if and as the files linked to were marked. If a character, new links are unconditionally marked with that character.") (defvar dired-keep-marker-symlink 89 "\ *Controls marking of newly made symbolic links. If t, they are marked if and as the files linked to were marked. If a character, new links are unconditionally marked with that character.") (defvar dired-dwim-target nil "\ *If non-nil, dired tries to guess a default target directory. This means: if there is a dired buffer displayed in the next window, use its current subdir, instead of the current subdir of this dired buffer. The target is used in the prompt for file copy, rename etc.") (defvar dired-copy-preserve-time t "\ *If non-nil, Dired preserves the last-modified time in a file copy. \(This works on only some systems.)") (define-key ctl-x-map "d" 'dired) (autoload (quote dired) "dired" "\ \"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it. Optional second argument SWITCHES specifies the `ls' options used. \(Interactively, use a prefix argument to be able to specify SWITCHES.) Dired displays a list of files in DIRNAME (which may also have shell wildcards appended to select certain files). If DIRNAME is a cons, its first element is taken as the directory name and the resr as an explicit list of files to make directory entries for. \\You can move around in it with the usual commands. You can flag files for deletion with \\[dired-flag-file-deletion] and then delete them by typing \\[dired-do-flagged-delete]. Type \\[describe-mode] after entering dired for more info. If DIRNAME is already in a dired buffer, that buffer is used without refresh." t nil) (define-key ctl-x-4-map "d" 'dired-other-window) (autoload (quote dired-other-window) "dired" "\ \"Edit\" directory DIRNAME. Like `dired' but selects in another window." t nil) (define-key ctl-x-5-map "d" 'dired-other-frame) (autoload (quote dired-other-frame) "dired" "\ \"Edit\" directory DIRNAME. Like `dired' but makes a new frame." t nil) (autoload (quote dired-noselect) "dired" "\ Like `dired' but returns the dired buffer as value, does not select it." nil nil) ;;;*** ;;;### (autoloads (dired-do-query-replace dired-do-search 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-rename-file dired-copy-file dired-relist-file dired-remove-file dired-add-file dired-do-redisplay dired-do-load dired-do-byte-compile dired-do-compress dired-compress-file 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" (12355 15919)) ;;; Generated autoloads from dired-aux.el (autoload (quote dired-diff) "dired-aux" "\ Compare file at point with file FILE using `diff'. FILE defaults to the file at the mark. The prompted-for file is the first file given to `diff'. With prefix arg, prompt for second argument SWITCHES, which is options for `diff'." t nil) (autoload (quote dired-backup-diff) "dired-aux" "\ Diff this file with its backup file or vice versa. Uses the latest backup, if there are several numerical backups. If this file is a backup, diff it with its original. The backup file is the first file given to `diff'. With prefix arg, prompt for argument SWITCHES which is options for `diff'." t nil) (autoload (quote dired-do-chmod) "dired-aux" "\ Change the mode of the marked (or next ARG) files. This calls chmod, thus symbolic modes like `g+w' are allowed." t nil) (autoload (quote dired-do-chgrp) "dired-aux" "\ Change the group of the marked (or next ARG) files." t nil) (autoload (quote dired-do-chown) "dired-aux" "\ Change the owner of the marked (or next ARG) files." t nil) (autoload (quote dired-do-print) "dired-aux" "\ Print the marked (or next ARG) files. Uses the shell command coming from variables `lpr-command' and `lpr-switches' as default." t nil) (autoload (quote dired-do-shell-command) "dired-aux" "\ Run a shell command COMMAND on the marked files. If no files are marked or a specific numeric prefix arg is given, the next ARG files are used. Just \\[universal-argument] means the current file. The prompt mentions the file(s) or the marker, as appropriate. If there is output, it goes to a separate buffer. Normally the command is run on each file individually. However, if there is a `*' in the command then it is run just once with the entire file list substituted there. No automatic redisplay of dired buffers is attempted, as there's no telling what files the command may have changed. Type \\[dired-do-redisplay] to redisplay the marked files. The shell command has the top level directory as working directory, so output files usually are created there instead of in a subdir." t nil) (autoload (quote dired-do-kill-lines) "dired-aux" "\ Kill all marked lines (not the files). With a prefix argument, kill that many lines starting with the current line. \(A negative argument kills lines before the current line.) To kill an entire subdirectory, go to its directory header line and use this command with a prefix argument (the value does not matter)." t nil) (autoload (quote dired-compress-file) "dired-aux" nil nil nil) (autoload (quote dired-do-compress) "dired-aux" "\ Compress or uncompress marked (or next ARG) files." t nil) (autoload (quote dired-do-byte-compile) "dired-aux" "\ Byte compile marked (or next ARG) Emacs Lisp files." t nil) (autoload (quote dired-do-load) "dired-aux" "\ Load the marked (or next ARG) Emacs Lisp files." t nil) (autoload (quote dired-do-redisplay) "dired-aux" "\ Redisplay all marked (or next ARG) files. If on a subdir line, redisplay that subdirectory. In that case, a prefix arg lets you edit the `ls' switches used for the new listing." t nil) (autoload (quote dired-add-file) "dired-aux" nil nil nil) (autoload (quote dired-remove-file) "dired-aux" nil nil nil) (autoload (quote dired-relist-file) "dired-aux" nil nil nil) (autoload (quote dired-copy-file) "dired-aux" nil nil nil) (autoload (quote dired-rename-file) "dired-aux" nil nil nil) (autoload (quote dired-create-directory) "dired-aux" "\ Create a directory called DIRECTORY." t nil) (autoload (quote dired-do-copy) "dired-aux" "\ Copy all marked (or next ARG) files, or copy the current file. This normally preserves the last-modified date when copying. When operating on just the current file, you specify the new name. When operating on multiple or marked files, you specify a directory, and new copies of these files are made in that directory with the same names that the files currently have." t nil) (autoload (quote dired-do-symlink) "dired-aux" "\ Make symbolic links to current file or all marked (or next ARG) files. When operating on just the current file, you specify the new name. When operating on multiple or marked files, you specify a directory and new symbolic links are made in that directory with the same names that the files currently have." t nil) (autoload (quote dired-do-hardlink) "dired-aux" "\ Add names (hard links) current file or all marked (or next ARG) files. When operating on just the current file, you specify the new name. When operating on multiple or marked files, you specify a directory and new hard links are made in that directory with the same names that the files currently have." t nil) (autoload (quote dired-do-rename) "dired-aux" "\ Rename current file or all marked (or next ARG) files. When renaming just the current file, you specify the new name. When renaming multiple or marked files, you specify a directory." t nil) (autoload (quote dired-do-rename-regexp) "dired-aux" "\ Rename marked files containing REGEXP to NEWNAME. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. NEWNAME may contain \\=\\ or \\& as in `query-replace-regexp'. REGEXP defaults to the last regexp used. With a zero prefix arg, renaming by regexp affects the complete pathname - usually only the non-directory part of file names is used and changed." t nil) (autoload (quote dired-do-copy-regexp) "dired-aux" "\ Copy all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info." t nil) (autoload (quote dired-do-hardlink-regexp) "dired-aux" "\ Hardlink all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info." t nil) (autoload (quote dired-do-symlink-regexp) "dired-aux" "\ Symlink all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info." t nil) (autoload (quote dired-upcase) "dired-aux" "\ Rename all marked (or next ARG) files to upper case." t nil) (autoload (quote dired-downcase) "dired-aux" "\ Rename all marked (or next ARG) files to lower case." t nil) (autoload (quote dired-maybe-insert-subdir) "dired-aux" "\ Insert this subdirectory into the same dired buffer. If it is already present, just move to it (type \\[dired-do-redisplay] to refresh), else inserts it at its natural place (as `ls -lR' would have done). With a prefix arg, you may edit the ls switches used for this listing. You can add `R' to the switches to expand the whole tree starting at this subdirectory. This function takes some pains to conform to `ls -lR' output." t nil) (autoload (quote dired-prev-subdir) "dired-aux" "\ Go to previous subdirectory, regardless of level. When called interactively and not on a subdir line, go to this subdir's line." t nil) (autoload (quote dired-goto-subdir) "dired-aux" "\ Go to end of header line of DIR in this dired buffer. Return value of point on success, otherwise return nil. The next char is either \\n, or \\r if DIR is hidden." t nil) (autoload (quote dired-mark-subdir-files) "dired-aux" "\ Mark all files except `.' and `..'." t nil) (autoload (quote dired-kill-subdir) "dired-aux" "\ Remove all lines of current subdirectory. Lower levels are unaffected." t nil) (autoload (quote dired-tree-up) "dired-aux" "\ Go up ARG levels in the dired tree." t nil) (autoload (quote dired-tree-down) "dired-aux" "\ Go down in the dired tree." t nil) (autoload (quote dired-hide-subdir) "dired-aux" "\ Hide or unhide the current subdirectory and move to next directory. Optional prefix arg is a repeat factor. Use \\[dired-hide-all] to (un)hide all directories." t nil) (autoload (quote dired-hide-all) "dired-aux" "\ Hide all subdirectories, leaving only their header lines. If there is already something hidden, make everything visible again. Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." t nil) (autoload (quote dired-do-search) "dired-aux" "\ Search through all marked files for a match for REGEXP. Stops when a match is found. To continue searching for next match, use command \\[tags-loop-continue]." t nil) (autoload (quote dired-do-query-replace) "dired-aux" "\ Do `query-replace-regexp' of FROM with TO, on all marked files. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit] or ESC), you can resume the query replace with the command \\[tags-loop-continue]." t nil) ;;;*** ;;;### (autoloads (dired-jump) "dired-x" "dired-x.el" (12374 5734)) ;;; Generated autoloads from dired-x.el (autoload (quote dired-jump) "dired-x" "\ Jump to dired buffer corresponding to current buffer. If in a file, dired the current directory and move to file's line. If in dired already, pop up a level and goto old directory's line. In case the proper dired file line cannot be found, refresh the dired buffer and try again." t nil) ;;;*** ;;;### (autoloads (disassemble) "disass" "disass.el" (12437 9616)) ;;; Generated autoloads from disass.el (autoload (quote disassemble) "disass" "\ Print disassembled code for OBJECT in (optional) BUFFER. OBJECT can be a symbol defined as a function, or a function itself \(a lambda expression or a compiled-function object). If OBJECT is not already compiled, we compile it, but do not redefine OBJECT if it is a symbol." t nil) ;;;*** ;;;### (autoloads (standard-display-european create-glyph standard-display-underline standard-display-graphic standard-display-g1 standard-display-ascii standard-display-default standard-display-8bit describe-current-display-table describe-display-table set-display-table-slot display-table-slot make-display-table) "disp-table" "disp-table.el" (12411 11888)) ;;; Generated autoloads from disp-table.el (autoload (quote make-display-table) "disp-table" "\ Return a new, empty display table." nil nil) (autoload (quote display-table-slot) "disp-table" "\ Return the value of the extra slot in DISPLAY-TABLE named SLOT. SLOT may be a number from 0 to 5 inclusive, or a slot name (symbol)." nil nil) (autoload (quote set-display-table-slot) "disp-table" "\ Set the value of the extra slot in DISPLAY-TABLE named SLOT to VALUE. SLOT may be a number from 0 to 5 inclusive, or a name (symbol). See `display-table-slot-name-alist' for the names and numbers." nil nil) (autoload (quote describe-display-table) "disp-table" "\ Describe the display table DT in a help buffer." nil nil) (autoload (quote describe-current-display-table) "disp-table" "\ Describe the display table in use in the selected window and buffer." t nil) (autoload (quote standard-display-8bit) "disp-table" "\ Display characters in the range L to H literally." nil nil) (autoload (quote standard-display-default) "disp-table" "\ Display characters in the range L to H using the default notation." nil nil) (autoload (quote standard-display-ascii) "disp-table" "\ Display character C using printable string S." nil nil) (autoload (quote standard-display-g1) "disp-table" "\ Display character C as character SC in the g1 character set. This function assumes that your terminal uses the SO/SI characters; it is meaningless for an X frame." nil nil) (autoload (quote standard-display-graphic) "disp-table" "\ Display character C as character GC in graphics character set. This function assumes VT100-compatible escapes; it is meaningless for an X frame." nil nil) (autoload (quote standard-display-underline) "disp-table" "\ Display character C as character UC plus underlining." nil nil) (autoload (quote create-glyph) "disp-table" nil nil nil) (autoload (quote standard-display-european) "disp-table" "\ Toggle display of European characters encoded with ISO 8859. When enabled, characters in the range of 160 to 255 display not as octal escapes, but as accented characters. With prefix argument, enable European character display iff arg is positive." t nil) ;;;*** ;;;### (autoloads (dissociated-press) "dissociate" "dissociate.el" (11829 12540)) ;;; Generated autoloads from dissociate.el (autoload (quote dissociated-press) "dissociate" "\ Dissociate the text of the current buffer. Output goes in buffer named *Dissociation*, which is redisplayed each time text is added to it. Every so often the user must say whether to continue. If ARG is positive, require ARG chars of continuity. If ARG is negative, require -ARG words of continuity. Default is 2." t nil) ;;;*** ;;;### (autoloads (docref-setup) "docref" "docref.el" (12437 909)) ;;; Generated autoloads from docref.el (autoload (quote docref-setup) "docref" "\ Process docref cross-references in the current buffer. See also \\(f@docref-subst)." t nil) ;;;*** ;;;### (autoloads (doctor) "doctor" "doctor.el" (11718 57582)) ;;; Generated autoloads from doctor.el (autoload (quote doctor) "doctor" "\ Switch to *doctor* buffer and start giving psychotherapy." t nil) ;;;*** ;;;### (autoloads (double-mode) "double" "double.el" (12437 939)) ;;; Generated autoloads from double.el (autoload (quote double-mode) "double" "\ Toggle Double mode. With prefix arg, turn Double mode on iff arg is positive. When Double mode is on, some keys will insert different strings when pressed twice. See variable `double-map' for details." t nil) ;;;*** ;;;### (autoloads (dunnet) "dunnet" "dunnet.el" (12376 18678)) ;;; Generated autoloads from dunnet.el (autoload (quote dunnet) "dunnet" "\ Switch to *dungeon* buffer and start game." t nil) ;;;*** ;;;### (autoloads (easy-menu-create-keymaps easy-menu-do-define easy-menu-define) "easymenu" "easymenu.el" (12221 28588)) ;;; Generated autoloads from easymenu.el (autoload (quote easy-menu-define) "easymenu" "\ Define a menu bar submenu in maps MAPS, according to MENU. The menu keymap is stored in symbol SYMBOL, both as its value and as its function definition. DOC is used as the doc string for SYMBOL. The first element of MENU must be a string. It is the menu bar item name. The rest of the elements are menu items. A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE] NAME is a string--the menu item name. CALLBACK is a command to run when the item is chosen, or a list to evaluate when the item is chosen. ENABLE is an expression; the item is enabled for selection whenever this expression's value is non-nil. Alternatively, a menu item may have the form: [ NAME CALLBACK [ KEYWORD ARG ] ... ] Where KEYWORD is one of the symbol defined below. :keys KEYS KEYS is a string; a complex keyboard equivalent to this menu item. This is normally not needed because keyboard equivalents are usually computed automatically. :active ENABLE ENABLE is an expression; the item is enabled for selection whenever this expression's value is non-nil. :suffix NAME NAME is a string; the name of an argument to CALLBACK. :style STYLE is a symbol describing the type of menu item. The following are defined: toggle: A checkbox. Currently just prepend the name with the string \"Toggle \". radio: A radio button. nil: An ordinary menu item. :selected SELECTED SELECTED is an expression; the checkbox or radio button is selected whenever this expression's value is non-nil. Currently just disable radio buttons, no effect on checkboxes. A menu item can be a string. Then that string appears in the menu as unselectable text. A string consisting solely of hyphens is displayed as a solid horizontal line. A menu item can be a list. It is treated as a submenu. The first element should be the submenu name. That's used as the menu item in the top-level menu. The cdr of the submenu list is a list of menu items, as above." nil (quote macro)) (autoload (quote easy-menu-do-define) "easymenu" nil nil nil) (autoload (quote easy-menu-create-keymaps) "easymenu" nil nil nil) ;;;*** ;;;### (autoloads (electric-buffer-list) "ebuff-menu" "ebuff-menu.el" (12298 52725)) ;;; Generated autoloads from ebuff-menu.el (autoload (quote electric-buffer-list) "ebuff-menu" "\ Pops up a buffer describing the set of Emacs buffers. Vaguely like ITS lunar select buffer; combining typeoutoid buffer listing with menuoid buffer selection. If the very next character typed is a space then the buffer list window disappears. Otherwise, one may move around in the buffer list window, marking buffers to be selected, saved or deleted. To exit and select a new buffer, type a space when the cursor is on the appropriate line of the buffer-list window. Other commands are much like those of buffer-menu-mode. Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil. \\{electric-buffer-menu-mode-map}" t nil) ;;;*** ;;;### (autoloads (Electric-command-history-redo-expression) "echistory" "echistory.el" (11722 62680)) ;;; Generated autoloads from echistory.el (autoload (quote Electric-command-history-redo-expression) "echistory" "\ Edit current history line in minibuffer and execute result. With prefix arg NOCONFIRM, execute current line as-is without editing." t nil) ;;;*** ;;;### (autoloads (edebug-eval-top-level-form def-edebug-spec) "edebug" "edebug.el" (12417 12892)) ;;; Generated autoloads from edebug.el (autoload (quote def-edebug-spec) "edebug" "\ Set the edebug-form-spec property of SYMBOL according to SPEC. Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol \(naming a function), or a list." nil (quote macro)) (defalias (quote edebug-defun) (quote edebug-eval-top-level-form)) (autoload (quote edebug-eval-top-level-form) "edebug" "\ Evaluate a top level form, such as a defun or defmacro. This is like `eval-defun', but the code is always instrumented for Edebug. Print its name in the minibuffer and leave point where it is, or if an error occurs, leave point after it with mark at the original point." t nil) ;;;*** ;;;### (autoloads (ediff-version ediff-revision ediff-patch-buffer ediff-merge-revisions-with-ancestor ediff-merge-revisions ediff-merge-buffers-with-ancestor ediff-merge-buffers ediff-merge-files-with-ancestor ediff-merge-files ediff-regions-linewise ediff-regions-wordwise ediff-windows-linewise ediff-windows-wordwise ediff-merge-directory-revisions-with-ancestor ediff-merge-directory-revisions ediff-merge-directories-with-ancestor ediff-merge-directories ediff-directories3 ediff-directory-revisions ediff-directories ediff-buffers3 ediff-buffers ediff-files3 ediff-files ediff-patch-file) "ediff" "ediff.el" (12415 10792)) ;;; Generated autoloads from ediff.el (autoload (quote ediff-patch-file) "ediff" "\ Run Ediff by patching FILE-TP-PATCH." t nil) (defalias (quote epatch) (quote ediff-patch-file)) (defalias (quote epatch-buffer) (quote ediff-patch-buffer)) (autoload (quote ediff-files) "ediff" "\ Run Ediff on a pair of files, FILE-A and FILE-B." t nil) (autoload (quote ediff-files3) "ediff" "\ Run Ediff on three files, FILE-A, FILE-B, and FILE-C." t nil) (defalias (quote ediff3) (quote ediff-files3)) (defalias (quote ediff) (quote ediff-files)) (autoload (quote ediff-buffers) "ediff" "\ Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B." t nil) (autoload (quote ediff-buffers3) "ediff" "\ Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C." t nil) (autoload (quote ediff-directories) "ediff" "\ Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have the same name in both. The third argument, REGEXP, is a regular expression that further filters the file names." t nil) (defalias (quote edirs) (quote ediff-directories)) (autoload (quote ediff-directory-revisions) "ediff" "\ Run Ediff on a directory, DIR1, comparing its files with their revisions. The second argument, REGEXP, is a regular expression that filters the file names. Only the files that are under revision control are taken into account." t nil) (defalias (quote edir-revisions) (quote ediff-directory-revisions)) (autoload (quote ediff-directories3) "ediff" "\ Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that have the same name in all three. The last argument, REGEXP, is a regular expression that further filters the file names." t nil) (defalias (quote edirs3) (quote ediff-directories3)) (autoload (quote ediff-merge-directories) "ediff" "\ Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have the same name in both. The third argument, REGEXP, is a regular expression that further filters the file names." t nil) (defalias (quote edirs-merge) (quote ediff-merge-directories)) (autoload (quote ediff-merge-directories-with-ancestor) "ediff" "\ Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have the same name in both. The third argument, REGEXP, is a regular expression that further filters the file names." t nil) (autoload (quote ediff-merge-directory-revisions) "ediff" "\ Run Ediff on a directory, DIR1, merging its files with their revisions. The second argument, REGEXP, is a regular expression that filters the file names. Only the files that are under revision control are taken into account." t nil) (defalias (quote edir-merge-revisions) (quote ediff-merge-directory-revisions)) (autoload (quote ediff-merge-directory-revisions-with-ancestor) "ediff" "\ Run Ediff on a directory, DIR1, merging its files with their revisions and ancestors. The second argument, REGEXP, is a regular expression that filters the file names. Only the files that are under revision control are taken into account." t nil) (defalias (quote edir-merge-revisions-with-ancestor) (quote ediff-merge-directory-revisions-with-ancestor)) (defalias (quote edirs-merge-with-ancestor) (quote ediff-merge-directories-with-ancestor)) (autoload (quote ediff-windows-wordwise) "ediff" "\ Compare WIND-A and WIND-B, which are selected by clicking, wordwise. With prefix argument, DUMB-MODE, or on a non-windowing display, works as follows: If WIND-A is nil, use selected window. If WIND-B is nil, use window next to WIND-A." t nil) (autoload (quote ediff-windows-linewise) "ediff" "\ Compare WIND-A and WIND-B, which are selected by clicking, linewise. With prefix argument, DUMB-MODE, or on a non-windowing display, works as follows: If WIND-A is nil, use selected window. If WIND-B is nil, use window next to WIND-A." t nil) (autoload (quote ediff-regions-wordwise) "ediff" "\ Run Ediff on a pair of regions in two different buffers. Regions (i.e., point and mark) are assumed to be set in advance. This function is effective only for relatively small regions, up to 200 lines. For large regions, use `ediff-regions-linewise'." t nil) (autoload (quote ediff-regions-linewise) "ediff" "\ Run Ediff on a pair of regions in two different buffers. Regions (i.e., point and mark) are assumed to be set in advance. Each region is enlarged to contain full lines. This function is effective for large regions, over 100-200 lines. For small regions, use `ediff-regions-wordwise'." t nil) (defalias (quote ediff-merge) (quote ediff-merge-files)) (autoload (quote ediff-merge-files) "ediff" "\ Merge two files without ancestor." t nil) (autoload (quote ediff-merge-files-with-ancestor) "ediff" "\ Merge two files with ancestor." t nil) (defalias (quote ediff-merge-with-ancestor) (quote ediff-merge-files-with-ancestor)) (autoload (quote ediff-merge-buffers) "ediff" "\ Merge buffers without ancestor." t nil) (autoload (quote ediff-merge-buffers-with-ancestor) "ediff" "\ Merge buffers with ancestor." t nil) (autoload (quote ediff-merge-revisions) "ediff" "\ Run Ediff by merging two revisions of a file. The file is the optional FILE argument or the file visited by the current buffer." t nil) (autoload (quote ediff-merge-revisions-with-ancestor) "ediff" "\ Run Ediff by merging two revisions of a file with a common ancestor. The file is the the optional FILE argument or the file visited by the current buffer." t nil) (autoload (quote ediff-patch-buffer) "ediff" "\ Run Ediff by patching BUFFER-NAME." t nil) (autoload (quote ediff-revision) "ediff" "\ Run Ediff by comparing versions of a file. The file is an optional FILE argument or the file visited by the current buffer. Use `vc.el' or `rcs.el' depending on `ediff-version-control-package'." t nil) (autoload (quote ediff-version) "ediff" "\ Return string describing the version of Ediff. When called interactively, displays the version." t nil) ;;;*** ;;;### (autoloads (ediff-show-registry) "ediff-meta" "ediff-meta.el" (12415 10770)) ;;; Generated autoloads from ediff-meta.el (autoload (quote ediff-show-registry) "ediff-meta" "\ Display Ediff's registry." t nil) (defalias (quote eregistry) (quote ediff-show-registry)) ;;;*** ;;;### (autoloads (ediff-show-registry) "ediff-mult" "ediff-mult.el" (12464 64202)) ;;; Generated autoloads from ediff-mult.el (autoload (quote ediff-show-registry) "ediff-mult" "\ Display Ediff's registry." t nil) (defalias (quote eregistry) (quote ediff-show-registry)) ;;;*** ;;;### (autoloads (insert-kbd-macro format-kbd-macro read-kbd-macro edit-named-kbd-macro edit-last-kbd-macro edit-kbd-macro) "edmacro" "edmacro.el" (12352 45149)) ;;; Generated autoloads from edmacro.el (define-key ctl-x-map "\C-k" 'edit-kbd-macro) (defvar edmacro-eight-bits nil "\ *Non-nil if edit-kbd-macro should leave 8-bit characters intact. Default nil means to write characters above \\177 in octal notation.") (autoload (quote edit-kbd-macro) "edmacro" "\ Edit a keyboard macro. At the prompt, type any key sequence which is bound to a keyboard macro. Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit the last 100 keystrokes as a keyboard macro, or `M-x' to edit a macro by its command name. With a prefix argument, format the macro in a more concise way." t nil) (autoload (quote edit-last-kbd-macro) "edmacro" "\ Edit the most recently defined keyboard macro." t nil) (autoload (quote edit-named-kbd-macro) "edmacro" "\ Edit a keyboard macro which has been given a name by `name-last-kbd-macro'." t nil) (autoload (quote read-kbd-macro) "edmacro" "\ Read the region as a keyboard macro definition. The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\". See documentation for `edmacro-mode' for details. Leading/trailing \"C-x (\" and \"C-x )\" in the text are allowed and ignored. The resulting macro is installed as the \"current\" keyboard macro. In Lisp, may also be called with a single STRING argument in which case the result is returned rather than being installed as the current macro. The result will be a string if possible, otherwise an event vector. Second argument NEED-VECTOR means to return an event vector always." t nil) (autoload (quote format-kbd-macro) "edmacro" "\ Return the keyboard macro MACRO as a human-readable string. This string is suitable for passing to `read-kbd-macro'. Second argument VERBOSE means to put one command per line with comments. If VERBOSE is `1', put everything on one line. If VERBOSE is omitted or nil, use a compact 80-column format." nil nil) (autoload (quote insert-kbd-macro) "edmacro" "\ Insert in buffer the definition of kbd macro NAME, as Lisp code. Optional second arg KEYS means also record the keys it is on \(this is the prefix argument, when calling interactively). This Lisp code will, when executed, define the kbd macro with the same definition it has now. If you say to record the keys, the Lisp code will also rebind those keys to the macro. Only global key bindings are recorded since executing this Lisp code always makes global bindings. To save a kbd macro, visit a file of Lisp code such as your `~/.emacs', use this command, and then save the file." t nil) ;;;*** ;;;### (autoloads (edt-emulation-on) "edt" "edt.el" (12437 1142)) ;;; Generated autoloads from edt.el (autoload (quote edt-emulation-on) "edt" "\ Turn on EDT Emulation." t nil) ;;;*** ;;;### (autoloads (electric-helpify with-electric-help) "ehelp" "ehelp.el" (12441 11042)) ;;; Generated autoloads from ehelp.el (autoload (quote with-electric-help) "ehelp" "\ Pop up an \"electric\" help buffer. The arguments are THUNK &optional BUFFER NOERASE MINHEIGHT. THUNK is a function of no arguments which is called to initialize the contents of BUFFER. BUFFER defaults to `*Help*'. BUFFER will be erased before THUNK is called unless NOERASE is non-nil. THUNK will be called while BUFFER is current and with `standard-output' bound to the buffer specified by BUFFER. If THUNK returns nil, we display BUFFER starting at the top, and shrink the window to fit. If THUNK returns non-nil, we don't do those things. After THUNK has been called, this function \"electrically\" pops up a window in which BUFFER is displayed and allows the user to scroll through that buffer in electric-help-mode. The window's height will be at least MINHEIGHT if this value is non-nil. If THUNK returns nil, we display BUFFER starting at the top, and shrink the window to fit. If THUNK returns non-nil, we don't do those things. When the user exits (with `electric-help-exit', or otherwise) the help buffer's window disappears (i.e., we use `save-window-excursion') BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit." nil nil) (autoload (quote electric-helpify) "ehelp" nil nil nil) ;;;*** ;;;### (autoloads (elp-submit-bug-report elp-results elp-instrument-package elp-instrument-list elp-restore-function elp-instrument-function) "elp" "elp.el" (12033 65120)) ;;; Generated autoloads from elp.el (autoload (quote elp-instrument-function) "elp" "\ Instrument FUNSYM for profiling. FUNSYM must be a symbol of a defined function." t nil) (autoload (quote elp-restore-function) "elp" "\ Restore an instrumented function to its original definition. Argument FUNSYM is the symbol of a defined function." t nil) (autoload (quote elp-instrument-list) "elp" "\ Instrument for profiling, all functions in `elp-function-list'. Use optional LIST if provided instead." t nil) (autoload (quote elp-instrument-package) "elp" "\ Instrument for profiling, all functions which start with PREFIX. For example, to instrument all ELP functions, do the following: \\[elp-instrument-package] RET elp- RET" t nil) (autoload (quote elp-results) "elp" "\ Display current profiling results. If `elp-reset-after-results' is non-nil, then current profiling information for all instrumented functions are reset after results are displayed." t nil) (autoload (quote elp-submit-bug-report) "elp" "\ Submit via mail, a bug report on elp." t nil) ;;;*** ;;;### (autoloads (report-emacs-bug) "emacsbug" "emacsbug.el" (12421 42207)) ;;; Generated autoloads from emacsbug.el (autoload (quote report-emacs-bug) "emacsbug" "\ Report a bug in GNU Emacs. Prompts for bug subject. Leaves you in a mail buffer." t nil) ;;;*** ;;;### (autoloads (emerge-merge-directories emerge-revisions-with-ancestor emerge-revisions emerge-files-with-ancestor-remote emerge-files-remote emerge-files-with-ancestor-command emerge-files-command emerge-buffers-with-ancestor emerge-buffers emerge-files-with-ancestor emerge-files) "emerge" "emerge.el" (12189 23987)) ;;; Generated autoloads from emerge.el (defvar menu-bar-emerge-menu (make-sparse-keymap "Emerge")) (fset (quote menu-bar-emerge-menu) (symbol-value (quote menu-bar-emerge-menu))) (define-key menu-bar-emerge-menu [emerge-merge-directories] (quote ("Merge Directories ..." . emerge-merge-directories))) (define-key menu-bar-emerge-menu [emerge-revisions-with-ancestor] (quote ("Revisions with Ancestor ..." . emerge-revisions-with-ancestor))) (define-key menu-bar-emerge-menu [emerge-revisions] (quote ("Revisions ..." . emerge-revisions))) (define-key menu-bar-emerge-menu [emerge-files-with-ancestor] (quote ("Files with Ancestor ..." . emerge-files-with-ancestor))) (define-key menu-bar-emerge-menu [emerge-files] (quote ("Files ..." . emerge-files))) (define-key menu-bar-emerge-menu [emerge-buffers-with-ancestor] (quote ("Buffers with Ancestor ..." . emerge-buffers-with-ancestor))) (define-key menu-bar-emerge-menu [emerge-buffers] (quote ("Buffers ..." . emerge-buffers))) (autoload (quote emerge-files) "emerge" "\ Run Emerge on two files." t nil) (autoload (quote emerge-files-with-ancestor) "emerge" "\ Run Emerge on two files, giving another file as the ancestor." t nil) (autoload (quote emerge-buffers) "emerge" "\ Run Emerge on two buffers." t nil) (autoload (quote emerge-buffers-with-ancestor) "emerge" "\ Run Emerge on two buffers, giving another buffer as the ancestor." t nil) (autoload (quote emerge-files-command) "emerge" nil nil nil) (autoload (quote emerge-files-with-ancestor-command) "emerge" nil nil nil) (autoload (quote emerge-files-remote) "emerge" nil nil nil) (autoload (quote emerge-files-with-ancestor-remote) "emerge" nil nil nil) (autoload (quote emerge-revisions) "emerge" "\ Emerge two RCS revisions of a file." t nil) (autoload (quote emerge-revisions-with-ancestor) "emerge" "\ Emerge two RCS revisions of a file, with another revision as ancestor." t nil) (autoload (quote emerge-merge-directories) "emerge" nil t nil) ;;;*** ;;;### (autoloads (enriched-decode enriched-encode enriched-mode) "enriched" "enriched.el" (12437 1242)) ;;; Generated autoloads from enriched.el (autoload (quote enriched-mode) "enriched" "\ Minor mode for editing text/enriched files. These are files with embedded formatting information in the MIME standard text/enriched format. Turning the mode on runs `enriched-mode-hooks'. More information about enriched-mode is available in the file etc/enriched.doc in the Emacs distribution directory. Commands: \\\\{enriched-mode-map}" t nil) (autoload (quote enriched-encode) "enriched" nil nil nil) (autoload (quote enriched-decode) "enriched" nil nil nil) ;;;*** ;;;### (autoloads (setenv) "env" "env.el" (12370 27107)) ;;; Generated autoloads from env.el (autoload (quote setenv) "env" "\ Set the value of the environment variable named VARIABLE to VALUE. VARIABLE should be a string. VALUE is optional; if not provided or is `nil', the environment variable VARIABLE will be removed. Interactively, a prefix argument means to unset the variable. Interactively, the current value (if any) of the variable appears at the front of the history list when you type in the new value. This function works by modifying `process-environment'." t nil) ;;;*** ;;;### (autoloads (complete-tag select-tags-table tags-apropos list-tags tags-query-replace tags-search tags-loop-continue next-file find-tag-regexp find-tag-other-frame find-tag-other-window find-tag find-tag-noselect tags-table-files visit-tags-table) "etags" "etags.el" (12437 9767)) ;;; Generated autoloads from etags.el (defvar tags-file-name nil "\ *File name of tags table. To switch to a new tags table, setting this variable is sufficient. If you set this variable, do not also set `tags-table-list'. Use the `etags' program to make a tags table file.") (put 'tags-file-name 'variable-interactive "fVisit tags table: ") (defvar tags-table-list nil "\ *List of file names of tags tables to search. An element that is a directory means the file \"TAGS\" in that directory. To switch to a new list of tags tables, setting this variable is sufficient. If you set this variable, do not also set `tags-file-name'. Use the `etags' program to make a tags table file.") (defvar tags-add-tables (quote ask-user) "\ *Control whether to add a new tags table to the current list. t means do; nil means don't (always start a new list). Any other value means ask the user whether to add a new tags table to the current list (as opposed to starting a new list).") (defvar find-tag-hook nil "\ *Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'. The value in the buffer in which \\[find-tag] is done is used, not the value in the buffer \\[find-tag] goes to.") (defvar find-tag-default-function nil "\ *A function of no arguments used by \\[find-tag] to pick a default tag. If nil, and the symbol that is the value of `major-mode' has a `find-tag-default-function' property (see `put'), that is used. Otherwise, `find-tag-default' is used.") (autoload (quote visit-tags-table) "etags" "\ Tell tags commands to use tags table file FILE. FILE should be the name of a file created with the `etags' program. A directory name is ok too; it means file TAGS in that directory. Normally \\[visit-tags-table] sets the global value of `tags-file-name'. With a prefix arg, set the buffer-local value instead. When you find a tag with \\[find-tag], the buffer it finds the tag in is given a local value of this variable which is the name of the tags file the tag was in." t nil) (autoload (quote tags-table-files) "etags" "\ Return a list of files in the current tags table. Assumes the tags table is the current buffer. File names returned are absolute." nil nil) (autoload (quote find-tag-noselect) "etags" "\ Find tag (in current tags table) whose name contains TAGNAME. Returns the buffer containing the tag's definition and moves its point there, but does not select the buffer. The default for TAGNAME is the expression in the buffer near point. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is the atom `-' (interactively, with prefix arg that is a negative number or just \\[negative-argument]), pop back to the previous tag gone to. If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp. See documentation of variable `tags-file-name'." t nil) (autoload (quote find-tag) "etags" "\ Find tag (in current tags table) whose name contains TAGNAME. Select the buffer containing the tag's definition, and move point there. The default for TAGNAME is the expression in the buffer around or before point. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is the atom `-' (interactively, with prefix arg that is a negative number or just \\[negative-argument]), pop back to the previous tag gone to. See documentation of variable `tags-file-name'." t nil) (define-key esc-map "." 'find-tag) (autoload (quote find-tag-other-window) "etags" "\ Find tag (in current tags table) whose name contains TAGNAME. Select the buffer containing the tag's definition in another window, and move point there. The default for TAGNAME is the expression in the buffer around or before point. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is negative (interactively, with prefix arg that is a negative number or just \\[negative-argument]), pop back to the previous tag gone to. See documentation of variable `tags-file-name'." t nil) (define-key ctl-x-4-map "." 'find-tag-other-window) (autoload (quote find-tag-other-frame) "etags" "\ Find tag (in current tags table) whose name contains TAGNAME. Select the buffer containing the tag's definition in another frame, and move point there. The default for TAGNAME is the expression in the buffer around or before point. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is negative (interactively, with prefix arg that is a negative number or just \\[negative-argument]), pop back to the previous tag gone to. See documentation of variable `tags-file-name'." t nil) (define-key ctl-x-5-map "." 'find-tag-other-frame) (autoload (quote find-tag-regexp) "etags" "\ Find tag (in current tags table) whose name matches REGEXP. Select the buffer containing the tag's definition and move point there. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is negative (interactively, with prefix arg that is a negative number or just \\[negative-argument]), pop back to the previous tag gone to. If third arg OTHER-WINDOW is non-nil, select the buffer in another window. See documentation of variable `tags-file-name'." t nil) (define-key esc-map [?\C-.] 'find-tag-regexp) (autoload (quote next-file) "etags" "\ Select next file among files in current tags table. A first argument of t (prefix arg, if interactive) initializes to the beginning of the list of files in the tags table. If the argument is neither nil nor t, it is evalled to initialize the list of files. Non-nil second argument NOVISIT means use a temporary buffer to save time and avoid uninteresting warnings. Value is nil if the file was already visited; if the file was newly read in, the value is the filename." t nil) (autoload (quote tags-loop-continue) "etags" "\ Continue last \\[tags-search] or \\[tags-query-replace] command. Used noninteractively with non-nil argument to begin such a command (the argument is passed to `next-file', which see). Two variables control the processing we do on each file: the value of `tags-loop-scan' is a form to be executed on each file to see if it is interesting (it returns non-nil if so) and `tags-loop-operate' is a form to evaluate to operate on an interesting file. If the latter evaluates to nil, we exit; otherwise we scan the next file." t nil) (define-key esc-map "," 'tags-loop-continue) (autoload (quote tags-search) "etags" "\ Search through all files listed in tags table for match for REGEXP. Stops when a match is found. To continue searching for next match, use command \\[tags-loop-continue]. See documentation of variable `tags-file-name'." t nil) (autoload (quote tags-query-replace) "etags" "\ Query-replace-regexp FROM with TO through all files listed in tags table. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace with the command \\[tags-loop-continue]. See documentation of variable `tags-file-name'." t nil) (autoload (quote list-tags) "etags" "\ Gives the list of functions available in file \"filename\" Searches only in \"tags-file-name\"." t nil) (autoload (quote tags-apropos) "etags" "\ Display list of all tags in tags table REGEXP matches." t nil) (autoload (quote select-tags-table) "etags" "\ Select a tags table file from a menu of those you have already used. The list of tags tables to select from is stored in `tags-table-set-list'; see the doc of that variable if you want to add names to the list." t nil) (autoload (quote complete-tag) "etags" "\ Perform tags completion on the text around point. Completes to the set of names listed in the current tags table. The string to complete is chosen in the same way as the default for \\[find-tag] (which see)." t nil) (define-key esc-map "\t" 'complete-tag) ;;;*** ;;;### (autoloads (executable-self-display executable-set-magic) "executable" "executable.el" (12350 16067)) ;;; Generated autoloads from executable.el (autoload (quote executable-set-magic) "executable" "\ Set this buffer's interpreter to INTERPRETER with optional ARGUMENT. The variables `executable-magicless-file-regexp', `executable-prefix', `executable-insert', `executable-query' and `executable-chmod' control when and how magic numbers are inserted or replaced and scripts made executable." t nil) (autoload (quote executable-self-display) "executable" "\ Turn a text file into a self-displaying Un*x command. The magic number of such a command displays all lines but itself." t nil) ;;;*** ;;;### (autoloads (f90-mode) "f90" "f90.el" (12437 1284)) ;;; Generated autoloads from f90.el (autoload (quote f90-mode) "f90" "\ Major mode for editing Fortran 90 code in free format. \\[f90-indent-new-line] corrects current indentation and creates new indented line. \\[f90-indent-line] indents the current line correctly. \\[f90-indent-subprogram] indents the current subprogram. Type `? or `\\[help-command] to display a list of built-in abbrevs for F90 keywords. Key definitions: \\{f90-mode-map} Variables controlling indentation style and extra features: f90-do-indent Extra indentation within do blocks. (default 3) f90-if-indent Extra indentation within if/select case/where/forall blocks. (default 3) f90-type-indent Extra indentation within type/interface/block-data blocks. (default 3) f90-program-indent Extra indentation within program/module/subroutine/function blocks. (default 2) f90-continuation-indent Extra indentation applied to continuation lines. (default 5) f90-comment-region String inserted by \\[f90-comment-region] at start of each line in region. (default \"!!!$\") f90-indented-comment-re Regexp determining the type of comment to be intended like code. (default \"!\") f90-directive-comment-re Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented. (default \"!hpf\\\\$\") f90-break-delimiters Regexp holding list of delimiters at which lines may be broken. (default \"[-+*/><=,% \\t]\") f90-break-before-delimiters Non-nil causes `f90-do-auto-fill' to break lines before delimiters. (default t) f90-beginning-ampersand Automatic insertion of & at beginning of continuation lines. (default t) f90-smart-end From an END statement, check and fill the end using matching block start. Allowed values are 'blink, 'no-blink, and nil, which determine whether to blink the matching beginning.) (default 'blink) f90-auto-keyword-case Automatic change of case of keywords. (default nil) The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word. f90-leave-line-no Do not left-justify line numbers. (default nil) f90-startup-message Set to nil to inhibit message first time F90 mode is used. (default t) f90-keywords List of keywords used for highlighting/upcase-keywords etc. Turning on F90 mode calls the value of the variable `f90-mode-hook' with no args, if that value is non-nil." t nil) ;;;*** ;;;### (autoloads (list-colors-display facemenu-read-color list-text-properties-at facemenu-remove-special facemenu-remove-all facemenu-remove-props facemenu-set-read-only facemenu-set-intangible facemenu-set-invisible facemenu-set-face-from-menu facemenu-set-background facemenu-set-foreground facemenu-set-face) "facemenu" "facemenu.el" (12437 1331)) ;;; Generated autoloads from facemenu.el (define-key global-map "\M-g" 'facemenu-keymap) (autoload 'facemenu-keymap "facemenu" "Keymap for face-changing commands." t 'keymap) (defvar facemenu-face-menu (let ((map (make-sparse-keymap "Face"))) (define-key map "o" (cons "Other..." (quote facemenu-set-face))) map) "\ Menu keymap for faces.") (defalias (quote facemenu-face-menu) facemenu-face-menu) (defvar facemenu-foreground-menu (let ((map (make-sparse-keymap "Foreground Color"))) (define-key map "o" (cons "Other..." (quote facemenu-set-foreground))) map) "\ Menu keymap for foreground colors.") (defalias (quote facemenu-foreground-menu) facemenu-foreground-menu) (defvar facemenu-background-menu (let ((map (make-sparse-keymap "Background Color"))) (define-key map "o" (cons "Other..." (quote facemenu-set-background))) map) "\ Menu keymap for background colors") (defalias (quote facemenu-background-menu) facemenu-background-menu) (defvar facemenu-special-menu (let ((map (make-sparse-keymap "Special"))) (define-key map [115] (cons "Remove Special" (quote facemenu-remove-special))) (define-key map [116] (cons "Intangible" (quote facemenu-set-intangible))) (define-key map [118] (cons "Invisible" (quote facemenu-set-invisible))) (define-key map [114] (cons "Read-Only" (quote facemenu-set-read-only))) map) "\ Menu keymap for non-face text-properties.") (defalias (quote facemenu-special-menu) facemenu-special-menu) (defvar facemenu-justification-menu (let ((map (make-sparse-keymap "Justification"))) (define-key map [99] (cons "Center" (quote set-justification-center))) (define-key map [98] (cons "Full" (quote set-justification-full))) (define-key map [114] (cons "Right" (quote set-justification-right))) (define-key map [108] (cons "Left" (quote set-justification-left))) (define-key map [117] (cons "Unfilled" (quote set-justification-none))) map) "\ Submenu for text justification commands.") (defalias (quote facemenu-justification-menu) facemenu-justification-menu) (defvar facemenu-indentation-menu (let ((map (make-sparse-keymap "Indentation"))) (define-key map [decrease-right-margin] (cons "Indent Right Less" (quote decrease-right-margin))) (define-key map [increase-right-margin] (cons "Indent Right More" (quote increase-right-margin))) (define-key map [decrease-left-margin] (cons "Indent Less" (quote decrease-left-margin))) (define-key map [increase-left-margin] (cons "Indent More" (quote increase-left-margin))) map) "\ Submenu for indentation commands.") (defalias (quote facemenu-indentation-menu) facemenu-indentation-menu) (defvar facemenu-menu nil "\ Facemenu top-level menu keymap.") (setq facemenu-menu (make-sparse-keymap "Text Properties")) (let ((map facemenu-menu)) (define-key map [dc] (cons "Display Colors" (quote list-colors-display))) (define-key map [df] (cons "Display Faces" (quote list-faces-display))) (define-key map [dp] (cons "List Properties" (quote list-text-properties-at))) (define-key map [ra] (cons "Remove All" (quote facemenu-remove-all))) (define-key map [rm] (cons "Remove Properties" (quote facemenu-remove-props))) (define-key map [s1] (list "-----------------"))) (let ((map facemenu-menu)) (define-key map [in] (cons "Indentation" (quote facemenu-indentation-menu))) (define-key map [ju] (cons "Justification" (quote facemenu-justification-menu))) (define-key map [s2] (list "-----------------")) (define-key map [sp] (cons "Special Properties" (quote facemenu-special-menu))) (define-key map [bg] (cons "Background Color" (quote facemenu-background-menu))) (define-key map [fg] (cons "Foreground Color" (quote facemenu-foreground-menu))) (define-key map [fc] (cons "Face" (quote facemenu-face-menu)))) (defalias (quote facemenu-menu) facemenu-menu) (autoload (quote facemenu-set-face) "facemenu" "\ Add FACE to the region or next character typed. It will be added to the top of the face list; any faces lower on the list that will not show through at all will be removed. Interactively, the face to be used is read with the minibuffer. If the region is active and there is no prefix argument, this command sets the region to the requested face. Otherwise, this command specifies the face for the next character inserted. Moving point or switching buffers before typing a character to insert cancels the specification." t nil) (autoload (quote facemenu-set-foreground) "facemenu" "\ Set the foreground color of the region or next character typed. The color is prompted for. A face named `fg:color' is used (or created). If the region is active, it will be set to the requested face. If it is inactive (even if mark-even-if-inactive is set) the next character that is typed (via `self-insert-command') will be set to the selected face. Moving point or switching buffers before typing a character cancels the request." t nil) (autoload (quote facemenu-set-background) "facemenu" "\ Set the background color of the region or next character typed. The color is prompted for. A face named `bg:color' is used (or created). If the region is active, it will be set to the requested face. If it is inactive (even if mark-even-if-inactive is set) the next character that is typed (via `self-insert-command') will be set to the selected face. Moving point or switching buffers before typing a character cancels the request." t nil) (autoload (quote facemenu-set-face-from-menu) "facemenu" "\ Set the face of the region or next character typed. This function is designed to be called from a menu; the face to use is the menu item's name. If the region is active and there is no prefix argument, this command sets the region to the requested face. Otherwise, this command specifies the face for the next character inserted. Moving point or switching buffers before typing a character to insert cancels the specification." t nil) (autoload (quote facemenu-set-invisible) "facemenu" "\ Make the region invisible. This sets the `invisible' text property; it can be undone with `facemenu-remove-special'." t nil) (autoload (quote facemenu-set-intangible) "facemenu" "\ Make the region intangible: disallow moving into it. This sets the `intangible' text property; it can be undone with `facemenu-remove-special'." t nil) (autoload (quote facemenu-set-read-only) "facemenu" "\ Make the region unmodifiable. This sets the `read-only' text property; it can be undone with `facemenu-remove-special'." t nil) (autoload (quote facemenu-remove-props) "facemenu" "\ Remove all text properties that facemenu added to region." t nil) (autoload (quote facemenu-remove-all) "facemenu" "\ Remove all text properties from the region." t nil) (autoload (quote facemenu-remove-special) "facemenu" "\ Remove all the \"special\" text properties from the region. These special properties include `invisible', `intangible' and `read-only'." t nil) (autoload (quote list-text-properties-at) "facemenu" "\ Pop up a buffer listing text-properties at LOCATION." t nil) (autoload (quote facemenu-read-color) "facemenu" "\ Read a color using the minibuffer." nil nil) (autoload (quote list-colors-display) "facemenu" "\ Display names of defined colors, and show what they look like. If the optional argument LIST is non-nil, it should be a list of colors to display. Otherwise, this command computes a list of colors that the current display can handle." t nil) ;;;*** ;;;### (autoloads (turn-on-fast-lock fast-lock-mode) "fast-lock" "fast-lock.el" (12431 36427)) ;;; Generated autoloads from fast-lock.el (defvar fast-lock-mode nil) (autoload (quote fast-lock-mode) "fast-lock" "\ Toggle Fast Lock mode. With arg, turn Fast Lock mode on if and only if arg is positive and the buffer is associated with a file. Enable it automatically in your `~/.emacs' by: (add-hook 'font-lock-mode-hook 'turn-on-fast-lock) If Fast Lock mode is enabled, and the current buffer does not contain any text properties, any associated Font Lock cache is used if its timestamp matches the buffer's file, and its `font-lock-keywords' match those that you are using. Font Lock caches may be saved: - When you save the file's buffer. - When you kill an unmodified file's buffer. - When you exit Emacs, for all unmodified or saved buffers. Depending on the value of `fast-lock-save-events'. See also the commands `fast-lock-read-cache' and `fast-lock-save-cache'. Use \\[font-lock-fontify-buffer] to fontify the buffer if the cache is bad. Various methods of control are provided for the Font Lock cache. In general, see variable `fast-lock-cache-directories' and function `fast-lock-cache-name'. For saving, see variables `fast-lock-minimum-size', `fast-lock-save-events', `fast-lock-save-others' and `fast-lock-save-faces'. Use \\[fast-lock-submit-bug-report] to send bug reports or feedback." t nil) (autoload (quote turn-on-fast-lock) "fast-lock" "\ Unconditionally turn on Fast Lock mode." nil nil) ;;;*** ;;;### (autoloads (find-grep-dired find-name-dired find-dired) "find-dired" "find-dired.el" (12276 36938)) ;;; Generated autoloads from find-dired.el (defvar find-ls-option (if (eq system-type (quote berkeley-unix)) (quote ("-ls" . "-gilsb")) (quote ("-exec ls -ld {} \\;" . "-ld"))) "\ *Description of the option to `find' to produce an `ls -l'-type listing. This is a cons of two strings (FIND-OPTION . LS-SWITCHES). FIND-OPTION gives the option (or options) to `find' that produce the desired output. LS-SWITCHES is a list of `ls' switches to tell dired how to parse the output.") (defvar find-grep-options (if (eq system-type (quote berkeley-unix)) "-s" "-q") "\ *Option to grep to be as silent as possible. On Berkeley systems, this is `-s'; on Posix, and with GNU grep, `-q' does it. On other systems, the closest you can come is to use `-l'.") (autoload (quote find-dired) "find-dired" "\ Run `find' and go into dired-mode on a buffer of the output. The command run (after changing into DIR) is find . \\( ARGS \\) -ls" t nil) (autoload (quote find-name-dired) "find-dired" "\ Search DIR recursively for files matching the globbing pattern PATTERN, and run dired on those files. PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted. The command run (after changing into DIR) is find . -name 'PATTERN' -ls" t nil) (autoload (quote find-grep-dired) "find-dired" "\ Find files in DIR containing a regexp ARG and start Dired on output. The command run (after changing into DIR) is find . -exec grep -s ARG {} \\; -ls Thus ARG can also contain additional grep options." t nil) ;;;*** ;;;### (autoloads (ff-find-other-file ff-get-other-file) "find-file" "find-file.el" (12351 34675)) ;;; Generated autoloads from find-file.el (autoload (quote ff-get-other-file) "find-file" "\ Find the header or source file corresponding to this file. See also the documentation for `ff-find-other-file;. If optional IN-OTHER-WINDOW is non-nil, find the file in another window." t nil) (autoload (quote ff-find-other-file) "find-file" "\ Find the header or source file corresponding to this file. Being on a `#include' line pulls in that file. If optional IN-OTHER-WINDOW is non-nil, find the file in the other window. If optional IGNORE-INCLUDE is non-nil, ignore being on `#include' lines. Variables of interest include: - ff-case-fold-search Non-nil means ignore cases in matches (see case-fold-search). If you have extensions in different cases, you will want this to be nil. - ff-always-in-other-window If non-nil, always open the other file in another window, unless an argument is given to ff-find-other-file. - ff-ignore-include If non-nil, ignores #include lines. - ff-always-try-to-create If non-nil, always attempt to create the other file if it was not found. - ff-quiet-mode If non-nil, traces which directories are being searched. - ff-special-constructs A list of regular expressions specifying how to recognise special constructs such as include files etc, and an associated method for extracting the filename from that construct. - ff-other-file-alist Alist of extensions to find given the current file's extension. - ff-search-directories List of directories searched through with each extension specified in ff-other-file-alist that matches this file's extension. - ff-pre-find-hooks List of functions to be called before the search for the file starts. - ff-pre-load-hooks List of functions to be called before the other file is loaded. - ff-post-load-hooks List of functions to be called after the other file is loaded. - ff-not-found-hooks List of functions to be called if the other file could not be found. - ff-file-created-hooks List of functions to be called if the other file has been created." t nil) ;;;*** ;;;### (autoloads (enable-flow-control-on enable-flow-control) "flow-ctrl" "flow-ctrl.el" (12418 54831)) ;;; Generated autoloads from flow-ctrl.el (autoload (quote enable-flow-control) "flow-ctrl" "\ Toggle flow control handling. When handling is enabled, user can type C-s as C-\\, and C-q as C-^. With arg, enable flow control mode if arg is positive, otherwise disable." t nil) (autoload (quote enable-flow-control-on) "flow-ctrl" "\ Enable flow control if using one of a specified set of terminal types. Use `(enable-flow-control-on \"vt100\" \"h19\")' to enable flow control on VT-100 and H19 terminals. When flow control is enabled, you must type C-\\ to get the effect of a C-s, and type C-^ to get the effect of a C-q." nil nil) ;;;*** ;;;### (autoloads (font-lock-fontify-buffer turn-on-font-lock font-lock-mode) "font-lock" "font-lock.el" (12437 1384)) ;;; Generated autoloads from font-lock.el (defvar font-lock-maximum-decoration nil "\ *If non-nil, the maximum decoration level for fontifying. If nil, use the default decoration (typically the minimum available). If t, use the maximum decoration available. If a number, use that level of decoration (or if not available the maximum). If a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL), where MAJOR-MODE is a symbol or t (meaning the default). For example: ((c++-mode . 2) (c-mode . t) (t . 1)) means use level 2 decoration for buffers in `c++-mode', the maximum decoration available for buffers in `c-mode', and level 1 decoration otherwise.") (defvar font-lock-maximum-size (* 250 1024) "\ *If non-nil, the maximum size for buffers for fontifying. Only buffers less than this can be fontified when Font Lock mode is turned on. If nil, means size is irrelevant. If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), where MAJOR-MODE is a symbol or t (meaning the default). For example: ((c++-mode . 256000) (c-mode . 256000) (rmail-mode . 1048576)) means that the maximum size is 250K for buffers in `c++-mode' or `c-mode', one megabyte for buffers in `rmail-mode', and size is irrelevant otherwise.") (defvar font-lock-mode-hook nil "\ 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'; - Strings are displayed in `font-lock-string-face'; - Certain other expressions are displayed in other faces according to the value of the variable `font-lock-keywords'. You can enable Font Lock mode in any major mode automatically by turning on in the major mode's hook. For example, put in your ~/.emacs: (add-hook 'c-mode-hook 'turn-on-font-lock) Or for any visited file with the following in your ~/.emacs: (add-hook 'find-file-hooks 'turn-on-font-lock) The default Font Lock mode faces and their attributes are defined in the variable `font-lock-face-attributes', and Font Lock mode default settings in the variable `font-lock-defaults-alist'. You can set your own default settings for some mode, by setting a buffer local value for `font-lock-defaults', via its mode hook. Where modes support different levels of fontification, you can use the variable `font-lock-maximum-decoration' to specify which level you generally prefer. When you turn Font Lock mode on/off the buffer is fontified/defontified, though fontification occurs only if the buffer is less than `font-lock-maximum-size'. To fontify a buffer without turning on Font Lock mode, and regardless of buffer size, you can use \\[font-lock-fontify-buffer]." t nil) (autoload (quote turn-on-font-lock) "font-lock" "\ Unconditionally turn on Font Lock mode." nil nil) (autoload (quote font-lock-fontify-buffer) "font-lock" "\ Fontify the current buffer the way `font-lock-mode' would." t nil) ;;;*** ;;;### (autoloads (forms-find-file-other-window forms-find-file forms-mode) "forms" "forms.el" (12437 1594)) ;;; Generated autoloads from forms.el (autoload (quote forms-mode) "forms" "\ Major mode to visit files in a field-structured manner using a form. Commands: Equivalent keys in read-only mode: TAB forms-next-field TAB \\C-c TAB forms-next-field \\C-c < forms-first-record < \\C-c > forms-last-record > \\C-c ? describe-mode ? \\C-c \\C-k forms-delete-record \\C-c \\C-q forms-toggle-read-only q \\C-c \\C-o forms-insert-record \\C-c \\C-l forms-jump-record l \\C-c \\C-n forms-next-record n \\C-c \\C-p forms-prev-record p \\C-c \\C-r forms-search-reverse r \\C-c \\C-s forms-search-forward s \\C-c \\C-x forms-exit x " 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" (12431 36212)) ;;; Generated autoloads from fortran.el (defvar fortran-tab-mode-default nil "\ *Default tabbing/carriage control style for empty files in Fortran mode. A value of t specifies tab-digit style of continuation control. A value of nil specifies that continuation lines are marked with a character in column 6.") (autoload (quote fortran-mode) "fortran" "\ Major mode for editing Fortran code. \\[fortran-indent-line] indents the current Fortran line correctly. DO statements must not share a common CONTINUE. Type ;? or ;\\[help-command] to display a list of built-in abbrevs for Fortran keywords. Key definitions: \\{fortran-mode-map} Variables controlling indentation style and extra features: comment-start Normally nil in Fortran mode. If you want to use comments starting with `!', set this to the string \"!\". fortran-do-indent Extra indentation within do blocks. (default 3) fortran-if-indent Extra indentation within if blocks. (default 3) fortran-structure-indent Extra indentation within structure, union, map and interface blocks. (default 3) fortran-continuation-indent Extra indentation applied to continuation statements. (default 5) fortran-comment-line-extra-indent Amount of extra indentation for text within full-line comments. (default 0) fortran-comment-indent-style nil means don't change indentation of text in full-line comments, fixed means indent that text at `fortran-comment-line-extra-indent' beyond the value of `fortran-minimum-statement-indent-fixed' (for fixed format continuation style) or `fortran-minimum-statement-indent-tab' (for TAB format continuation style). relative means indent at `fortran-comment-line-extra-indent' beyond the indentation for a line of code. (default 'fixed) fortran-comment-indent-char Single-character string to be inserted instead of space for full-line comment indentation. (default \" \") fortran-minimum-statement-indent-fixed Minimum indentation for Fortran statements in fixed format mode. (def.6) fortran-minimum-statement-indent-tab Minimum indentation for Fortran statements in TAB format mode. (default 9) fortran-line-number-indent Maximum indentation for line numbers. A line number will get less than this much indentation if necessary to avoid reaching column 5. (default 1) fortran-check-all-num-for-matching-do Non-nil causes all numbered lines to be treated as possible \"continue\" statements. (default nil) fortran-blink-matching-if Non-nil causes \\[fortran-indent-line] on an ENDIF statement to blink on matching IF. Also, from an ENDDO statement, blink on matching DO [WHILE] statement. (default nil) fortran-continuation-string Single-character string to be inserted in column 5 of a continuation line. (default \"$\") fortran-comment-region String inserted by \\[fortran-comment-region] at start of each line in region. (default \"c$$$\") fortran-electric-line-number Non-nil causes line number digits to be moved to the correct column as typed. (default t) fortran-break-before-delimiters Non-nil causes `fortran-fill' breaks lines before delimiters. (default t) fortran-startup-message Set to nil to inhibit message first time Fortran mode is used. Turning on Fortran mode calls the value of the variable `fortran-mode-hook' with no args, if that value is non-nil." t nil) ;;;*** ;;;### (autoloads (gnus-batch-score gnus gnus-no-server) "gnus" "gnus.el" (12442 58213)) ;;; Generated autoloads from gnus.el (autoload (quote gnus-no-server) "gnus" "\ Read network news. If ARG is a positive number, Gnus will use that as the startup level. If ARG is nil, Gnus will be started at level 2. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use. As opposed to `gnus', this command will not connect to the local server." t nil) (autoload (quote gnus) "gnus" "\ Read network news. If ARG is non-nil and a positive number, Gnus will use that as the startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use." t nil) (defalias (quote gnus-batch-kill) (quote gnus-batch-score)) (autoload (quote gnus-batch-score) "gnus" "\ Run batched scoring. Usage: emacs -batch -l gnus -f gnus-batch-score ... Newsgroups is a list of strings in Bnews format. If you want to score the comp hierarchy, you'd say \"comp.all\". If you would not like to score the alt hierarchy, you'd say \"!alt.all\"." t nil) ;;;*** ;;;### (autoloads nil "gnus-msg" "gnus-msg.el" (12442 58110)) ;;; Generated autoloads from gnus-msg.el (defalias (quote sendnews) (quote gnus-post-news)) (defalias (quote postnews) (quote gnus-post-news)) ;;;*** ;;;### (autoloads (gnus-post-news) "gnuspost" "gnuspost.el" (12248 23474)) ;;; Generated autoloads from gnuspost.el (defalias (quote sendnews) (quote gnus-post-news)) (defalias (quote postnews) (quote gnus-post-news)) (autoload (quote gnus-post-news) "gnuspost" "\ Begin editing a new USENET news article to be posted. Type \\[describe-mode] once editing the article to get a list of commands." t nil) ;;;*** ;;;### (autoloads (gomoku) "gomoku" "gomoku.el" (12201 8918)) ;;; Generated autoloads from gomoku.el (autoload (quote gomoku) "gomoku" "\ Start a Gomoku game between you and Emacs. If a game is in progress, this command allow you to resume it. If optional arguments N and M are given, an N by M board is used. You and Emacs play in turn by marking a free square. You mark it with X and Emacs marks it with O. The winner is the first to get five contiguous marks horizontally, vertically or in diagonal. You play by moving the cursor over the square you choose and hitting \\\\[gomoku-human-plays]. Use \\[describe-mode] for more info." t nil) ;;;*** ;;;### (autoloads (goto-address) "goto-addr" "goto-addr.el" (12456 62933)) ;;; Generated autoloads from goto-addr.el (autoload (quote goto-address) "goto-addr" "\ Sets up goto-address functionality in the current buffer. Allows user to use mouse/keyboard command to click to go to a URL or to send e-mail. By default, goto-address binds to S-mouse-2 and C-c RET. Also fontifies the buffer appropriately (see `goto-address-fontify-p' and `goto-address-highlight-p' for more information)." t nil) ;;;*** ;;;### (autoloads (perldb xdb dbx sdb gdb) "gud" "gud.el" (12424 8923)) ;;; Generated autoloads from gud.el (autoload (quote gdb) "gud" "\ 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." t nil) (autoload (quote sdb) "gud" "\ 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." t nil) (autoload (quote dbx) "gud" "\ 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." t nil) (autoload (quote xdb) "gud" "\ Run xdb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger. You can set the variable 'gud-xdb-directories' to a list of program source directories if your program contains sources from more than one directory." t nil) (autoload (quote perldb) "gud" "\ Run perldb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger." t nil) ;;;*** ;;;### (autoloads (hanoi) "hanoi" "hanoi.el" (12189 24430)) ;;; Generated autoloads from hanoi.el (autoload (quote hanoi) "hanoi" "\ Towers of Hanoi diversion. Argument is number of rings." t nil) ;;;*** ;;;### (autoloads nil "help-macro" "help-macro.el" (12274 5253)) ;;; Generated autoloads from help-macro.el (defvar three-step-help nil "\ *Non-nil means give more info about Help command in three steps. The three steps are simple prompt, prompt with all options, and window listing and describing the options. A value of nil means skip the middle step, so that \\[help-command] \\[help-command] gives the window that lists the options.") ;;;*** ;;;### (autoloads (Helper-help Helper-describe-bindings) "helper" "helper.el" (12203 7388)) ;;; Generated autoloads from helper.el (autoload (quote Helper-describe-bindings) "helper" "\ Describe local key bindings of current mode." t nil) (autoload (quote Helper-help) "helper" "\ Provide help for current mode." t nil) ;;;*** ;;;### (autoloads (hexlify-buffer hexl-find-file hexl-mode) "hexl" "hexl.el" (12366 29967)) ;;; Generated autoloads from hexl.el (autoload (quote hexl-mode) "hexl" "\ \\ A major mode for editing binary files in hex dump format. This function automatically converts a buffer into the hexl format using the function `hexlify-buffer'. Each line in the buffer has an \"address\" (displayed in hexadecimal) representing the offset into the file that the characters on this line are at and 16 characters from the file (displayed as hexadecimal values grouped every 16 bits) and as their ASCII values. If any of the characters (displayed as ASCII characters) are unprintable (control or meta characters) they will be replaced as periods. If `hexl-mode' is invoked with an argument the buffer is assumed to be in hexl format. A sample format: HEX ADDR: 0001 0203 0405 0607 0809 0a0b 0c0d 0e0f ASCII-TEXT -------- ---- ---- ---- ---- ---- ---- ---- ---- ---------------- 00000000: 5468 6973 2069 7320 6865 786c 2d6d 6f64 This is hexl-mod 00000010: 652e 2020 4561 6368 206c 696e 6520 7265 e. Each line re 00000020: 7072 6573 656e 7473 2031 3620 6279 7465 presents 16 byte 00000030: 7320 6173 2068 6578 6164 6563 696d 616c s as hexadecimal 00000040: 2041 5343 4949 0a61 6e64 2070 7269 6e74 ASCII.and print 00000050: 6162 6c65 2041 5343 4949 2063 6861 7261 able ASCII chara 00000060: 6374 6572 732e 2020 416e 7920 636f 6e74 cters. Any cont 00000070: 726f 6c20 6f72 206e 6f6e 2d41 5343 4949 rol or non-ASCII 00000080: 2063 6861 7261 6374 6572 730a 6172 6520 characters.are 00000090: 6469 7370 6c61 7965 6420 6173 2070 6572 displayed as per 000000a0: 696f 6473 2069 6e20 7468 6520 7072 696e iods in the prin 000000b0: 7461 626c 6520 6368 6172 6163 7465 7220 table character 000000c0: 7265 6769 6f6e 2e0a region.. Movement is as simple as movement in a normal emacs text buffer. Most cursor movement bindings are the same (ie. Use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line] to move the cursor left, right, down, and up). Advanced cursor movement commands (ala \\[hexl-beginning-of-line], \\[hexl-end-of-line], \\[hexl-beginning-of-buffer], and \\[hexl-end-of-buffer]) are also supported. There are several ways to change text in hexl mode: ASCII characters (character between space (0x20) and tilde (0x7E)) are bound to self-insert so you can simply type the character and it will insert itself (actually overstrike) into the buffer. \\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if it isn't bound to self-insert. An octal number can be supplied in place of another key to insert the octal number's ASCII representation. \\[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF) into the buffer at the current point. \\[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377) into the buffer at the current point. \\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255) into the buffer at the current point. \\[hexl-mode-exit] will exit hexl-mode. Note: saving the file with any of the usual Emacs commands will actually convert it back to binary format while saving. You can use \\[hexl-find-file] to visit a file in hexl-mode. \\[describe-bindings] for advanced commands." t nil) (autoload (quote hexl-find-file) "hexl" "\ Edit file FILENAME in hexl-mode. Switch to a buffer visiting file FILENAME, creating one in none exists." t nil) (autoload (quote hexlify-buffer) "hexl" "\ Convert a binary buffer to hexl format." t nil) ;;;*** ;;;### (autoloads (hide-ifdef-mode) "hideif" "hideif.el" (12430 64723)) ;;; Generated autoloads from hideif.el (autoload (quote hide-ifdef-mode) "hideif" "\ Toggle Hide-Ifdef mode. This is a minor mode, albeit a large one. With ARG, turn Hide-Ifdef mode on iff arg is positive. In Hide-Ifdef mode, code within #ifdef constructs that the C preprocessor would eliminate may be hidden from view. Several variables affect how the hiding is done: hide-ifdef-env An association list of defined and undefined symbols for the current buffer. Initially, the global value of `hide-ifdef-env' is used. hide-ifdef-define-alist An association list of defined symbol lists. Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env' and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env' from one of the lists in `hide-ifdef-define-alist'. hide-ifdef-lines Set to non-nil to not show #if, #ifdef, #ifndef, #else, and #endif lines when hiding. hide-ifdef-initially Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode is activated. hide-ifdef-read-only Set to non-nil if you want to make buffers read only while hiding. After `show-ifdefs', read-only status is restored to previous value. \\{hide-ifdef-mode-map}" t nil) (defvar hide-ifdef-initially nil "\ *Non-nil if `hide-ifdefs' should be called when Hide-Ifdef mode is first activated.") (defvar hide-ifdef-read-only nil "\ *Set to non-nil if you want buffer to be read-only while hiding text.") (defvar hide-ifdef-lines nil "\ *Set to t if you don't want to see the #ifX, #else, and #endif lines.") ;;;*** ;;;### (autoloads (hs-minor-mode hs-hide-block hs-hide-all) "hideshow" "hideshow.el" (12235 41891)) ;;; Generated autoloads from hideshow.el (autoload (quote hs-hide-all) "hideshow" "\ Hides all top-level blocks, displaying only first and last lines. When done, point is repositioned at the beginning of the line, and hs-hide-hooks is called. See documentation for `run-hooks'." t nil) (autoload (quote hs-hide-block) "hideshow" "\ Selects a block and hides it. With prefix arg, reposition at end. Block is defined as a sexp for lispish modes, mode-specific otherwise. Comments are blocks, too. Upon completion, point is at repositioned and hs-hide-hooks is called. See documentation for `run-hooks'." t nil) (autoload (quote hs-minor-mode) "hideshow" "\ Toggle hideshow minor mode. With ARG, turn hideshow minor mode on if ARG is positive, off otherwise. When hideshow minor mode is on, the menu bar is augmented with hideshow commands and the hideshow commands are enabled. The variables selective-display selective-display-ellipses are set to t. Lastly, the hooks set in hs-minor-mode-hook are called. See documentation for `run-hooks'. Turning hideshow minor mode off reverts the menu bar and the variables to default values and disables the hideshow commands." t nil) ;;;*** ;;;### (autoloads (make-hippie-expand-function hippie-expand) "hippie-exp" "hippie-exp.el" (12416 52243)) ;;; Generated autoloads from hippie-exp.el (defvar hippie-expand-try-functions-list (quote (try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially 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.") (defvar hippie-expand-ignore-buffers (quote ("^ \\*.*\\*$" dired-mode)) "\ *A list specifying which buffers not to search (if not current). Can contain both regexps matching buffer names (as strings) and major modes \(as atoms)") (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 (quote macro)) ;;;*** ;;;### (autoloads (icomplete-minibuffer-setup icomplete-mode) "icomplete" "icomplete.el" (12437 1799)) ;;; Generated autoloads from icomplete.el (autoload (quote icomplete-mode) "icomplete" "\ Activate incremental minibuffer completion for this emacs session, or deactivate with negative prefix arg." t nil) (autoload (quote icomplete-minibuffer-setup) "icomplete" "\ Run in minibuffer on activation to establish incremental completion. Usually run by inclusion in `minibuffer-setup-hook'." nil nil) ;;;*** ;;;### (autoloads (icon-mode) "icon" "icon.el" (12344 39047)) ;;; Generated autoloads from icon.el (autoload (quote icon-mode) "icon" "\ Major mode for editing Icon code. Expression and list commands understand all Icon brackets. Tab indents for Icon code. Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \\{icon-mode-map} Variables controlling indentation style: icon-tab-always-indent Non-nil means TAB in Icon mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. icon-auto-newline Non-nil means automatically newline before and after braces inserted in Icon code. icon-indent-level Indentation of Icon statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. icon-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. icon-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to `icon-continued-statement-offset'. icon-brace-offset Extra indentation for line if it starts with an open brace. icon-brace-imaginary-offset An open brace following other text is treated as if it were this far to the right of the start of its line. Turning on Icon mode calls the value of the variable `icon-mode-hook' with no args, if that value is non-nil." t nil) ;;;*** ;;;### (autoloads (ielm) "ielm" "ielm.el" (12275 13201)) ;;; Generated autoloads from ielm.el (add-hook 'same-window-buffer-names "*ielm*") (autoload (quote ielm) "ielm" "\ Interactively evaluate Emacs Lisp expressions. Switches to the buffer `*ielm*', or creates it if it does not exist." t nil) ;;;*** ;;;### (autoloads (imenu imenu-add-to-menubar) "imenu" "imenu.el" (12312 10290)) ;;; Generated autoloads from imenu.el (defvar imenu-generic-expression nil "\ The regex pattern to use for creating a buffer index. If non-nil this pattern is passed to `imenu-create-index-with-pattern' to create a buffer index. It is an alist with elements that look like this: (MENU-TITLE REGEXP INDEX). MENU-TITLE is a string used as the title for the submenu or nil if the entries are not nested. REGEXP is a regexp that should match a construct in the buffer that is to be displayed in the menu; i.e., function or variable definitions, etc. It contains a substring which is the name to appear in the menu. See the info section on Regexps for more information. INDEX points to the substring in REGEXP that contains the name (of the function, variable or type) that is to appear in the menu. For emacs-lisp-mode for example PATTERN would look like: '((nil \"^\\s-*(def\\(un\\|subst\\|macro\\|advice\\)\\s-+\\([-A-Za-z0-9+]+\\)\" 2) (\"*Vars*\" \"^\\s-*(def\\(var\\|const\\)\\s-+\\([-A-Za-z0-9+]+\\)\" 2) (\"*Types*\" \"^\\s-*(def\\(type\\|struct\\|class\\|ine-condition\\)\\s-+\\([-A-Za-z0-9+]+\\)\" 2)) The variable is buffer-local.") (autoload (quote imenu-add-to-menubar) "imenu" "\ Adds an \"imenu\" entry to the menubar for the current local keymap. NAME is the string naming the menu to be added. See 'imenu' for more information." t nil) (autoload (quote imenu) "imenu" "\ Jump to a place in the buffer chosen using a buffer menu or mouse menu. See `imenu-choose-buffer-index' for more information." t nil) ;;;*** ;;;### (autoloads (inferior-lisp) "inf-lisp" "inf-lisp.el" (12338 880)) ;;; Generated autoloads from inf-lisp.el (defvar inferior-lisp-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'" "\ *What not to save on inferior Lisp's input history. Input matching this regexp is not saved on the input history in Inferior Lisp mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword \(as in :a, :c, etc.)") (defvar inferior-lisp-program "lisp" "\ *Program name for invoking an inferior Lisp with for Inferior Lisp mode.") (defvar inferior-lisp-load-command "(load \"%s\")\n" "\ *Format-string for building a Lisp expression to load a file. This format string should use `%s' to substitute a file name and should result in a Lisp expression that will command the inferior Lisp to load that file. The default works acceptably on most Lisps. The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\ \" produces cosmetically superior output for this application, but it works only in Common Lisp.") (defvar inferior-lisp-prompt "^[^> \n]*>+:? *" "\ Regexp to recognise prompts in the Inferior Lisp mode. Defaults to \"^[^> \\n]*>+:? *\", which works pretty good for Lucid, kcl, and franz. This variable is used to initialize `comint-prompt-regexp' in the Inferior Lisp buffer. More precise choices: Lucid Common Lisp: \"^\\(>\\|\\(->\\)+\\) *\" franz: \"^\\(->\\|<[0-9]*>:\\) *\" kcl: \"^>+ *\" This is a fine thing to set in your .emacs file.") (defvar inferior-lisp-mode-hook (quote nil) "\ *Hook for customising Inferior Lisp mode.") (autoload (quote inferior-lisp) "inf-lisp" "\ Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'. If there is a process already running in `*inferior-lisp*', just switch to that buffer. With argument, allows you to edit the command line (default is value of `inferior-lisp-program'). Runs the hooks from `inferior-lisp-mode-hook' (after the `comint-mode-hook' is run). \(Type \\[describe-mode] in the process buffer for a list of commands.)" t nil) (add-hook 'same-window-buffer-names "*inferior-lisp*") (defalias (quote run-lisp) (quote inferior-lisp)) ;;;*** ;;;### (autoloads (Info-goto-emacs-key-command-node Info-goto-emacs-command-node info-standalone info) "info" "info.el" (12429 5597)) ;;; Generated autoloads from info.el (add-hook 'same-window-buffer-names "*info*") (autoload (quote info) "info" "\ Enter Info, the documentation browser. Optional argument FILE specifies the file to examine; the default is the top-level directory of Info. In interactive use, a prefix argument directs this command to read a file name from the minibuffer." t nil) (autoload (quote info-standalone) "info" "\ Run Emacs as a standalone Info reader. Usage: emacs -f info-standalone [filename] In standalone mode, \\\\[Info-exit] exits Emacs itself." nil nil) (autoload (quote Info-goto-emacs-command-node) "info" "\ Go to the Info node in the Emacs manual for command COMMAND. The command is found by looking up in Emacs manual's Command Index or in another manual found via COMMAND's `info-file' property or the variable `Info-file-list-for-emacs'." t nil) (autoload (quote Info-goto-emacs-key-command-node) "info" "\ Go to the Info node in the Emacs manual the command bound to KEY, a string. Interactively, if the binding is execute-extended-command, a command is read. The command is found by looking up in Emacs manual's Command Index or in another manual found via COMMAND's `info-file' property or the variable `Info-file-list-for-emacs'." t nil) ;;;*** ;;;### (autoloads (batch-info-validate Info-validate Info-split Info-tagify) "informat" "informat.el" (12429 6068)) ;;; Generated autoloads from informat.el (autoload (quote Info-tagify) "informat" "\ Create or update Info-file tag table in current buffer." t nil) (autoload (quote Info-split) "informat" "\ Split an info file into an indirect file plus bounded-size subfiles. Each subfile will be up to 50,000 characters plus one node. To use this command, first visit a large Info file that has a tag table. The buffer is modified into a (small) indirect info file which should be saved in place of the original visited file. The subfiles are written in the same directory the original file is in, with names generated by appending `-' and a number to the original file name. The indirect file still functions as an Info file, but it contains just the tag table and a directory of subfiles." t nil) (autoload (quote Info-validate) "informat" "\ Check current buffer for validity as an Info file. Check that every node pointer points to an existing node." t nil) (autoload (quote batch-info-validate) "informat" "\ Runs `Info-validate' on the files remaining on the command line. Must be used only with -batch, and kills Emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" nil nil) ;;;*** ;;;### (autoloads (iso-accents-mode) "iso-acc" "iso-acc.el" (12405 18297)) ;;; Generated autoloads from iso-acc.el (autoload (quote iso-accents-mode) "iso-acc" "\ Toggle ISO Accents mode, in which accents modify the following letter. This permits easy insertion of accented characters according to ISO-8859-1. When Iso-accents mode is enabled, accent character keys \(`, ', \", ^, / and ~) do not self-insert; instead, they modify the following letter key so that it inserts an ISO accented letter. The variable `iso-accents-enable' specifies the list of characters to enable as accents. If you don't need all of them, remove the ones you don't need from that list. Special combinations: ~c gives a c with cedilla, ~d gives an Icelandic eth (d with dash). ~t gives an Icelandic thorn. \"s gives German sharp s. /a gives a with ring. /e gives an a-e ligature. ~< and ~> give guillemets. ~! gives an inverted exclamation mark. ~? gives an inverted question mark. With an argument, a positive argument enables ISO Accents mode, and a negative argument disables it." t nil) ;;;*** ;;;### (autoloads (ispell-message ispell-minor-mode ispell-complete-word-interior-frag ispell-complete-word ispell-continue ispell-buffer ispell-region ispell-change-dictionary ispell-kill-ispell ispell-help ispell-word) "ispell" "ispell.el" (12437 2052)) ;;; Generated autoloads from ispell.el (defvar ispell-personal-dictionary nil "\ *File name of your personal spelling dictionary, or nil. If nil, the default personal dictionary, \"~/.ispell_DICTNAME\" is used, where DICTNAME is the name of your default dictionary.") (defvar ispell-dictionary-alist-1 (quote ((nil "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil) ("english" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil) ("british" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B" "-d" "british") nil) ("deutsch" "[a-zA-Z\"]" "[^a-zA-Z\"]" "[']" t ("-C") "~tex") ("deutsch8" "[a-zA-ZÄÖÜäößü]" "[^a-zA-ZÄÖÜäößü]" "[']" t ("-C" "-d" "deutsch") "~latin1") ("nederlands" "[A-Za-zÀ-ÅÇÈ-ÏÒ-ÖÙ-Üà-åçè-ïñò-öù-ü]" "[^A-Za-zÀ-ÅÇÈ-ÏÒ-ÖÙ-Üà-åçè-ïñò-öù-ü]" "[']" t ("-C") nil) ("nederlands8" "[A-Za-zÀ-ÅÇÈ-ÏÒ-ÖÙ-Üà-åçè-ïñò-öù-ü]" "[^A-Za-zÀ-ÅÇÈ-ÏÒ-ÖÙ-Üà-åçè-ïñò-öù-ü]" "[']" t ("-C") nil)))) (defvar ispell-dictionary-alist-2 (quote (("svenska" "[A-Za-z}{|\\133\\135\\\\]" "[^A-Za-z}{|\\133\\135\\\\]" "[']" nil ("-C") nil) ("svenska8" "[A-Za-zåäöÅÄö]" "[^A-Za-zåäöÅÄö]" "[']" nil ("-C" "-d" "svenska") "~list") ("francais7" "[A-Za-z]" "[^A-Za-z]" "[`'^---]" t nil nil) ("francais" "[A-Za-zÀÂÆÇÈÉÊËÎÏÔÙÛÜàâçèéêëîïôùûü]" "[^A-Za-zÀÂÆÇÈÉÊËÎÏÔÙÛÜàâçèéêëîïôùûü]" "[---']" t nil "~list") ("francais-tex" "[A-Za-zÀÂÆÇÈÉÊËÎÏÔÙÛÜàâçèéêëîïôùûü\\]" "[^A-Za-zÀÂÆÇÈÉÊËÎÏÔÙÛÜàâçèéêëîïôùûü\\]" "[---'^`\"]" t nil "~tex") ("dansk" "[A-ZÆØÅa-zæøå]" "[^A-ZÆØÅa-zæøå]" "" nil ("-C") nil)))) (defvar ispell-dictionary-alist (append ispell-dictionary-alist-1 ispell-dictionary-alist-2) "\ An alist of dictionaries and their associated parameters. Each element of this list is also a list: \(DICTIONARY-NAME CASECHARS NOT-CASECHARS OTHERCHARS MANY-OTHERCHARS-P ISPELL-ARGS EXTENDED-CHARACTER-MODE) DICTIONARY-NAME is a possible value of variable `ispell-dictionary', nil means the default dictionary. CASECHARS is a regular expression of valid characters that comprise a word. NOT-CASECHARS is the opposite regexp of CASECHARS. OTHERCHARS is a regular expression of other characters that are valid in word constructs. Otherchars cannot be adjacent to each other in a word, nor can they begin or end a word. This implies we can't check \"Stevens'\" as a correct possessive and other correct formations. Hint: regexp syntax requires the hyphen to be declared first here. MANY-OTHERCHARS-P is non-nil if many otherchars are to be allowed in a word instead of only one. ISPELL-ARGS is a list of additional arguments passed to the ispell subprocess. EXTENDED-CHARACTER-MODE should be used when dictionaries are used which have been configured in an Ispell affix file. (For example, umlauts can be encoded as \\\"a, a\\\", \"a, ...) Defaults are ~tex and ~nroff in English. This has the same effect as the command-line `-T' option. The buffer Major Mode controls Ispell's parsing in tex or nroff mode, but the dictionary can control the extended character mode. Both defaults can be overruled in a buffer-local fashion. See `ispell-parsing-keyword' for details on this. Note that the CASECHARS and OTHERCHARS slots of the alist should contain the same character set as casechars and otherchars in the language.aff file (e.g., english.aff).") (defvar ispell-menu-map nil "\ Key map for ispell menu") (defvar ispell-menu-lucid nil "\ Spelling menu for Lucid Emacs.") (defconst ispell-menu-map-needed (and (not ispell-menu-map) (not (string-match "Lucid" emacs-version)))) (if ispell-menu-map-needed (let ((dicts (reverse (cons (cons "default" nil) ispell-dictionary-alist))) name) (setq ispell-menu-map (make-sparse-keymap "Spell")) (while dicts (setq name (car (car dicts)) dicts (cdr dicts)) (if (stringp name) (define-key ispell-menu-map (vector (intern name)) (cons (concat "Select " (capitalize name)) (list (quote lambda) nil (quote (interactive)) (list (quote ispell-change-dictionary) name)))))))) (if ispell-menu-map-needed (progn (define-key ispell-menu-map [ispell-change-dictionary] (quote ("Change Dictionary" . ispell-change-dictionary))) (define-key ispell-menu-map [ispell-kill-ispell] (quote ("Kill Process" . ispell-kill-ispell))) (define-key ispell-menu-map [ispell-pdict-save] (quote ("Save Dictionary" lambda nil (interactive) (ispell-pdict-save t t)))) (define-key ispell-menu-map [ispell-complete-word] (quote ("Complete Word" . ispell-complete-word))) (define-key ispell-menu-map [ispell-complete-word-interior-frag] (quote ("Complete Word Frag" . ispell-complete-word-interior-frag))))) (if ispell-menu-map-needed (progn (define-key ispell-menu-map [ispell-continue] (quote ("Continue Check" . ispell-continue))) (define-key ispell-menu-map [ispell-word] (quote ("Check Word" . ispell-word))) (define-key ispell-menu-map [ispell-region] (quote ("Check Region" . ispell-region))) (define-key ispell-menu-map [ispell-buffer] (quote ("Check Buffer" . ispell-buffer))))) (if ispell-menu-map-needed (progn (define-key ispell-menu-map [ispell-message] (quote ("Check Message" . ispell-message))) (define-key ispell-menu-map [ispell-help] (quote ("Help" lambda nil (interactive) (describe-function (quote ispell-help))))) (put (quote ispell-region) (quote menu-enable) (quote mark-active)) (fset (quote ispell-menu-map) (symbol-value (quote ispell-menu-map))))) (define-key global-map "¤" (quote ispell-word)) (autoload (quote ispell-word) "ispell" "\ Check spelling of word under or before the cursor. If the word is not found in dictionary, display possible corrections in a window allowing you to choose one. With a prefix argument (or if CONTINUE is non-nil), resume interrupted spell-checking of a buffer or region. If optional argument FOLLOWING is non-nil or if `ispell-following-word' is non-nil when called interactively, then the following word \(rather than preceding) is checked when the cursor is not over a word. When the optional argument QUIETLY is non-nil or `ispell-quietly' is non-nil when called interactively, non-corrective messages are suppressed. Word syntax described by `ispell-dictionary-alist' (which see). This will check or reload the dictionary. Use \\[ispell-change-dictionary] or \\[ispell-region] to update the Ispell process." t nil) (autoload (quote ispell-help) "ispell" "\ Display a list of the options available when a misspelling is encountered. Selections are: DIGIT: Replace the word with a digit offered in the *Choices* buffer. SPC: Accept word this time. `i': Accept word and insert into private dictionary. `a': Accept word for this session. `A': Accept word and place in `buffer-local dictionary'. `r': Replace word with typed-in value. Rechecked. `R': Replace word with typed-in value. Query-replaced in buffer. Rechecked. `?': Show these commands. `x': Exit spelling buffer. Move cursor to original point. `X': Exit spelling buffer. Leaves cursor at the current point, and permits the aborted check to be completed later. `q': Quit spelling session (Kills ispell process). `l': Look up typed-in replacement in alternate dictionary. Wildcards okay. `u': Like `i', but the word is lower-cased first. `m': Like `i', but allows one to include dictionary completion information. `C-l': redraws screen `C-r': recursive edit `C-z': suspend emacs or iconify frame" nil nil) (autoload (quote ispell-kill-ispell) "ispell" "\ Kill current Ispell process (so that you may start a fresh one). With NO-ERROR, just return non-nil if there was no Ispell running." t nil) (autoload (quote ispell-change-dictionary) "ispell" "\ Change `ispell-dictionary' (q.v.) and kill old Ispell process. A new one will be started as soon as necessary. By just answering RET you can find out what the current dictionary is. With prefix argument, set the default directory." t nil) (autoload (quote ispell-region) "ispell" "\ Interactively check a region for spelling errors." t nil) (autoload (quote ispell-buffer) "ispell" "\ Check the current buffer for spelling errors interactively." t nil) (autoload (quote ispell-continue) "ispell" nil t nil) (autoload (quote ispell-complete-word) "ispell" "\ Look up word before or under point in dictionary (see lookup-words command) and try to complete it. If optional INTERIOR-FRAG is non-nil then the word may be a character sequence inside of a word. Standard ispell choices are then available." t nil) (autoload (quote ispell-complete-word-interior-frag) "ispell" "\ Completes word matching character sequence inside a word." t nil) (autoload (quote ispell-minor-mode) "ispell" "\ Toggle Ispell minor mode. With prefix arg, turn Ispell minor mode on iff arg is positive. In Ispell minor mode, pressing SPC or RET warns you if the previous word is incorrectly spelled." t nil) (autoload (quote ispell-message) "ispell" "\ Check the spelling of a mail message or news post. Don't check spelling of message headers except the Subject field. Don't check included messages. To abort spell checking of a message REGION and send the message anyway, use the `x' or `q' command. (Any subsequent regions will be checked.) The `X' command aborts the message send so that you can edit the buffer. To spell-check whenever a message is sent, include the appropriate lines in your .emacs file: (add-hook 'news-inews-hook 'ispell-message) (add-hook 'mail-send-hook 'ispell-message) (add-hook 'mh-before-send-letter-hook 'ispell-message) You can bind this to the key C-c i in GNUS or mail by adding to `news-reply-mode-hook' or `mail-mode-hook' the following lambda expression: (function (lambda () (local-set-key \"\\C-ci\" 'ispell-message)))" t nil) ;;;*** ;;;### (autoloads (auto-compression-mode) "jka-compr" "jka-compr.el" (12437 52288)) ;;; Generated autoloads from jka-compr.el (autoload (quote auto-compression-mode) "jka-compr" "\ Toggle automatic file compression and uncompression. With prefix argument ARG, turn auto compression on if positive, else off. Returns the new status of auto compression (non-nil means on)." t nil) ;;;*** ;;;### (autoloads (ledit-from-lisp-mode ledit-mode) "ledit" "ledit.el" (11181 53296)) ;;; Generated autoloads from ledit.el (defconst ledit-save-files t "\ *Non-nil means Ledit should save files before transferring to Lisp.") (defconst ledit-go-to-lisp-string "%?lisp" "\ *Shell commands to execute to resume Lisp job.") (defconst ledit-go-to-liszt-string "%?liszt" "\ *Shell commands to execute to resume Lisp compiler job.") (autoload (quote ledit-mode) "ledit" "\ \\Major mode for editing text and stuffing it to a Lisp job. Like Lisp mode, plus these special commands: \\[ledit-save-defun] -- record defun at or after point for later transmission to Lisp job. \\[ledit-save-region] -- record region for later transmission to Lisp job. \\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text. \\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job and transmit saved text. \\{ledit-mode-map} To make Lisp mode automatically change to Ledit mode, do (setq lisp-mode-hook 'ledit-from-lisp-mode)" t nil) (autoload (quote ledit-from-lisp-mode) "ledit" nil nil nil) ;;;*** ;;;### (autoloads (life) "life" "life.el" (12351 33924)) ;;; Generated autoloads from life.el (autoload (quote life) "life" "\ Run Conway's Life simulation. The starting pattern is randomly selected. Prefix arg (optional first arg non-nil from a program) is the number of seconds to sleep between generations (this defaults to 1)." t nil) ;;;*** ;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (12315 24591)) ;;; Generated autoloads from loadhist.el (autoload (quote unload-feature) "loadhist" "\ Unload the library that provided FEATURE, restoring all its autoloads. If the feature is required by any other loaded code, and optional FORCE is nil, raise an error." t nil) ;;;*** ;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer) "lpr" "lpr.el" (12217 8152)) ;;; Generated autoloads from lpr.el (defvar lpr-switches nil "\ *List of strings to pass as extra switch args to `lpr' when it is invoked.") (defvar lpr-command (if (memq system-type (quote (usg-unix-v dgux hpux irix))) "lp" "lpr") "\ *Name of program for printing a file.") (autoload (quote lpr-buffer) "lpr" "\ Print buffer contents as with Unix command `lpr'. `lpr-switches' is a list of extra switches (strings) to pass to lpr." t nil) (autoload (quote print-buffer) "lpr" "\ Print buffer contents as with Unix command `lpr -p'. `lpr-switches' is a list of extra switches (strings) to pass to lpr." t nil) (autoload (quote lpr-region) "lpr" "\ Print region contents as with Unix command `lpr'. `lpr-switches' is a list of extra switches (strings) to pass to lpr." t nil) (autoload (quote print-region) "lpr" "\ Print region contents as with Unix command `lpr -p'. `lpr-switches' is a list of extra switches (strings) to pass to lpr." t nil) ;;;*** ;;;### (autoloads (phases-of-moon) "lunar" "lunar.el" (12384 53826)) ;;; Generated autoloads from lunar.el (autoload (quote phases-of-moon) "lunar" "\ Display the quarters of the moon for last month, this month, and next month. If called with an optional prefix argument, prompts for month and year. This function is suitable for execution in a .emacs file." t nil) ;;;*** ;;;### (autoloads (apply-macro-to-region-lines kbd-macro-query insert-kbd-macro name-last-kbd-macro) "macros" "macros.el" (12342 4949)) ;;; Generated autoloads from macros.el (autoload (quote name-last-kbd-macro) "macros" "\ Assign a name to the last keyboard macro defined. Argument SYMBOL is the name to define. The symbol's function definition becomes the keyboard macro string. Such a \"function\" cannot be called from Lisp, but it is a valid editor command." t nil) (autoload (quote insert-kbd-macro) "macros" "\ Insert in buffer the definition of kbd macro NAME, as Lisp code. Optional second arg KEYS means also record the keys it is on \(this is the prefix argument, when calling interactively). This Lisp code will, when executed, define the kbd macro with the same definition it has now. If you say to record the keys, the Lisp code will also rebind those keys to the macro. Only global key bindings are recorded since executing this Lisp code always makes global bindings. To save a kbd macro, visit a file of Lisp code such as your `~/.emacs', use this command, and then save the file." t nil) (autoload (quote kbd-macro-query) "macros" "\ Query user during kbd macro execution. With prefix argument, enters recursive edit, reading keyboard commands even within a kbd macro. You can give different commands each time the macro executes. Without prefix argument, asks whether to continue running the macro. Your options are: \\ \\[act] Finish this iteration normally and continue with the next. \\[skip] Skip the rest of this iteration, and start the next. \\[exit] Stop the macro entirely right now. \\[recenter] Redisplay the screen, then ask again. \\[edit] Enter recursive edit; ask again when you exit from that." t nil) (autoload (quote apply-macro-to-region-lines) "macros" "\ For each complete line between point and mark, move to the beginning of the line, and run the last keyboard macro. When called from lisp, this function takes two arguments TOP and BOTTOM, describing the current region. TOP must be before BOTTOM. The optional third argument MACRO specifies a keyboard macro to execute. This is useful for quoting or unquoting included text, adding and removing comments, or producing tables where the entries are regular. For example, in Usenet articles, sections of text quoted from another author are indented, or have each line start with `>'. To quote a section of text, define a keyboard macro which inserts `>', put point and mark at opposite ends of the quoted section, and use `\\[apply-macro-to-region-lines]' to mark the entire section. Suppose you wanted to build a keyword table in C where each entry looked like this: { \"foo\", foo_data, foo_function }, { \"bar\", bar_data, bar_function }, { \"baz\", baz_data, baz_function }, You could enter the names in this format: foo bar baz and write a macro to massage a word into a table entry: \\C-x ( \\M-d { \"\\C-y\", \\C-y_data, \\C-y_function }, \\C-x ) and then select the region of un-tablified names and use `\\[apply-macro-to-region-lines]' to build the table from the names. " t nil) (define-key ctl-x-map "q" 'kbd-macro-query) ;;;*** ;;;### (autoloads (what-domain mail-extract-address-components) "mail-extr" "mail-extr.el" (12233 29328)) ;;; Generated autoloads from mail-extr.el (autoload (quote mail-extract-address-components) "mail-extr" "\ Given an RFC-822 ADDRESS, extract full name and canonical address. Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). If no name can be extracted, FULL-NAME will be nil. ADDRESS may be a string or a buffer. If it is a buffer, the visible (narrowed) portion of the buffer will be interpreted as the address. (This feature exists so that the clever caller might be able to avoid consing a string.) If ADDRESS contains more than one RFC-822 address, only the first is returned. Some day this function may be extended to extract multiple addresses, or perhaps return the position at which parsing stopped." nil nil) (autoload (quote what-domain) "mail-extr" "\ Convert mail domain DOMAIN to the country it corresponds to." t nil) ;;;*** ;;;### (autoloads (mail-hist-put-headers-into-history mail-hist-enable mail-hist-define-keys) "mail-hist" "mail-hist.el" (12267 49663)) ;;; Generated autoloads from mail-hist.el (autoload (quote mail-hist-define-keys) "mail-hist" "\ Define keys for accessing mail header history. For use in hooks." nil nil) (autoload (quote mail-hist-enable) "mail-hist" nil nil nil) (defvar mail-hist-keep-history t "\ *Non-nil means keep a history for headers and text of outgoing mail.") (autoload (quote mail-hist-put-headers-into-history) "mail-hist" "\ Put headers and contents of this message into mail header history. Each header has its own independent history, as does the body of the message. This function normally would be called when the message is sent." nil nil) ;;;*** ;;;### (autoloads (mail-fetch-field mail-file-babyl-p) "mail-utils" "mail-utils.el" (12412 12667)) ;;; Generated autoloads from mail-utils.el (defvar mail-use-rfc822 nil "\ *If non-nil, use a full, hairy RFC822 parser on mail addresses. Otherwise, (the default) use a smaller, somewhat faster, and often correct parser.") (autoload (quote mail-file-babyl-p) "mail-utils" nil nil nil) (autoload (quote mail-fetch-field) "mail-utils" "\ Return the value of the header field FIELD-NAME. The buffer is expected to be narrowed to just the headers of the message. If second arg LAST is non-nil, use the last such field if there are several. If third arg ALL is non-nil, concatenate all such fields with commas between." nil nil) ;;;*** ;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup) "mailabbrev" "mailabbrev.el" (12437 34059)) ;;; Generated autoloads from mailabbrev.el (autoload (quote mail-abbrevs-setup) "mailabbrev" nil nil nil) (autoload (quote build-mail-abbrevs) "mailabbrev" "\ Read mail aliases from personal mail alias file and set `mail-abbrevs'. By default this is the file specified by `mail-personal-alias-file'." nil nil) (autoload (quote define-mail-abbrev) "mailabbrev" "\ Define NAME as a mail alias abbrev that translates to DEFINITION. If DEFINITION contains multiple addresses, separate them with commas." t nil) ;;;*** ;;;### (autoloads (define-mail-alias) "mailalias" "mailalias.el" (12289 15684)) ;;; Generated autoloads from mailalias.el (autoload (quote define-mail-alias) "mailalias" "\ Define NAME as a mail alias that translates to DEFINITION. This means that sending a message to NAME will actually send to DEFINITION. Normally, the addresses in DEFINITION must be separated by commas. If FROM-MAILRC-FILE is non-nil, then addresses in DEFINITION can be separated by spaces; an address can contain spaces if it is quoted with double-quotes." t nil) ;;;*** ;;;### (autoloads (makefile-mode) "make-mode" "make-mode.el" (12436 36139)) ;;; Generated autoloads from make-mode.el (autoload (quote makefile-mode) "make-mode" "\ Major mode for editing Makefiles. This function ends by invoking the function(s) `makefile-mode-hook'. \\{makefile-mode-map} In the browser, use the following keys: \\{makefile-browser-map} Makefile mode can be configured by modifying the following variables: makefile-browser-buffer-name: Name of the macro- and target browser buffer. makefile-target-colon: The string that gets appended to all target names inserted by `makefile-insert-target'. \":\" or \"::\" are quite common values. makefile-macro-assign: The string that gets appended to all macro names inserted by `makefile-insert-macro'. The normal value should be \" = \", since this is what standard make expects. However, newer makes such as dmake allow a larger variety of different macro assignments, so you might prefer to use \" += \" or \" := \" . makefile-tab-after-target-colon: If you want a TAB (instead of a space) to be appended after the target colon, then set this to a non-nil value. makefile-browser-leftmost-column: Number of blanks to the left of the browser selection mark. makefile-browser-cursor-column: Column in which the cursor is positioned when it moves up or down in the browser. makefile-browser-selected-mark: String used to mark selected entries in the browser. makefile-browser-unselected-mark: String used to mark unselected entries in the browser. makefile-browser-auto-advance-after-selection-p: If this variable is set to a non-nil value the cursor will automagically advance to the next line after an item has been selected in the browser. makefile-pickup-everything-picks-up-filenames-p: If this variable is set to a non-nil value then `makefile-pickup-everything' also picks up filenames as targets (i.e. it calls `makefile-find-filenames-as-targets'), otherwise filenames are omitted. makefile-cleanup-continuations-p: If this variable is set to a non-nil value then makefile-mode will assure that no line in the file ends with a backslash (the continuation character) followed by any whitespace. This is done by silently removing the trailing whitespace, leaving the backslash itself intact. IMPORTANT: Please note that enabling this option causes makefile-mode to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\". makefile-browser-hook: A function or list of functions to be called just before the browser is entered. This is executed in the makefile buffer. makefile-special-targets-list: List of special targets. You will be offered to complete on one of those in the minibuffer whenever you enter a `.'. at the beginning of a line in Makefile mode." t nil) ;;;*** ;;;### (autoloads (make-command-summary) "makesum" "makesum.el" (11181 53304)) ;;; Generated autoloads from makesum.el (autoload (quote make-command-summary) "makesum" "\ Make a summary of current key bindings in the buffer *Summary*. Previous contents of that buffer are killed first." t nil) ;;;*** ;;;### (autoloads (man) "man" "man.el" (12328 56650)) ;;; Generated autoloads from man.el (defalias (quote manual-entry) (quote man)) (autoload (quote man) "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-method' for what happens when the buffer is ready. If a buffer already exists for this man page, it will display immediately." t nil) ;;;*** ;;;### (autoloads (map-y-or-n-p) "map-ynp" "map-ynp.el" (12247 10697)) ;;; Generated autoloads from map-ynp.el (autoload (quote map-y-or-n-p) "map-ynp" "\ Ask a series of boolean questions. Takes args PROMPTER ACTOR LIST, and optional args HELP and ACTION-ALIST. LIST is a list of objects, or a function of no arguments to return the next object or nil. If PROMPTER is a string, the prompt is (format PROMPTER OBJECT). If not a string, PROMPTER is a function of one arg (an object from LIST), which returns a string to be used as the prompt for that object. If the return value is not a string, it may be nil to ignore the object or non-nil to act on the object without asking the user. ACTOR is a function of one arg (an object from LIST), which gets called with each object that the user answers `yes' for. If HELP is given, it is a list (OBJECT OBJECTS ACTION), where OBJECT is a string giving the singular noun for an elt of LIST; OBJECTS is the plural noun for elts of LIST, and ACTION is a transitive verb describing ACTOR. The default is (\"object\" \"objects\" \"act on\"). At the prompts, the user may enter y, Y, or SPC to act on that object; n, N, or DEL to skip that object; ! to act on all following objects; ESC or q to exit (skip all following objects); . (period) to act on the current object and then exit; or \\[help-command] to get help. If ACTION-ALIST is given, it is an alist (KEY FUNCTION HELP) of extra keys that will be accepted. KEY is a character; FUNCTION is a function of one arg (an object from LIST); HELP is a string. When the user hits KEY, FUNCTION is called. If it returns non-nil, the object is considered \"acted upon\", and the next object from LIST is processed. If it returns nil, the prompt is repeated for the same object. Final optional argument NO-CURSOR-IN-ECHO-AREA non-nil says not to set `cursor-in-echo-area' while prompting. This function uses `query-replace-map' to define the standard responses, but not all of the responses which `query-replace' understands are meaningful here. Returns the number of actions taken." nil nil) ;;;*** ;;;### (autoloads (mh-letter-mode mh-smail-other-window mh-smail-batch mh-smail) "mh-comp" "mh-comp.el" (12441 32363)) ;;; Generated autoloads from mh-comp.el (autoload (quote mh-smail) "mh-comp" "\ Compose and send mail with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. See documentation of `\\[mh-send]' for more details on composing mail." t nil) (autoload (quote mh-smail-batch) "mh-comp" "\ Set up a mail composition draft with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. This function does not prompt the user for any header fields, and thus is suitable for use by programs that want to create a mail buffer. Users should use `\\[mh-smail]' to compose mail." nil nil) (autoload (quote mh-smail-other-window) "mh-comp" "\ Compose and send mail in other window with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. See documentation of `\\[mh-send]' for more details on composing mail." t nil) (autoload (quote mh-letter-mode) "mh-comp" "\ Mode for composing letters in mh-e.\\ When you have finished composing, type \\[mh-send-letter] to send the message using the MH mail handling system. See the documentation for \\[mh-edit-mhn] for information on composing MIME messages. \\{mh-letter-mode-map} Variables controlling this mode (defaults in parentheses): mh-delete-yanked-msg-window (nil) If non-nil, \\[mh-yank-cur-msg] will delete any windows displaying the yanked message. mh-yank-from-start-of-msg (t) If non-nil, \\[mh-yank-cur-msg] will include the entire message. If `body', just yank the body (no header). If nil, only the portion of the message following the point will be yanked. If there is a region, this variable is ignored. mh-ins-buf-prefix (\"> \") String to insert before each non-blank line of a message as it is inserted in a draft letter. mh-signature-file-name (\"~/.signature\") File to be inserted into message by \\[mh-insert-signature]. Upon invoking mh-letter-mode, text-mode-hook and mh-letter-mode-hook are invoked with no args, if those values are non-nil." t nil) ;;;*** ;;;### (autoloads (mh-version mh-rmail) "mh-e" "mh-e.el" (12441 32337)) ;;; Generated autoloads from mh-e.el (autoload (quote mh-rmail) "mh-e" "\ Inc(orporate) new mail with MH, or, with arg, scan an MH mail folder. This function is an entry point to mh-e, the Emacs front end to the MH mail system." t nil) (autoload (quote mh-version) "mh-e" "\ Display version information about mh-e and the MH mail handling system." t nil) ;;;*** ;;;### (autoloads nil "mh-mime" "mh-mime.el" (12441 32419)) ;;; Generated autoloads from mh-mime.el (defvar mh-mime-content-types (quote (("text/plain") ("text/richtext") ("multipart/mixed") ("multipart/alternative") ("multipart/digest") ("multipart/parallel") ("message/rfc822") ("message/partial") ("message/external-body") ("application/octet-stream") ("application/postscript") ("image/jpeg") ("image/gif") ("audio/basic") ("video/mpeg"))) "\ Legal MIME content types. See documentation for \\[mh-edit-mhn].") ;;;*** ;;;### (autoloads nil "mh-utils" "mh-utils.el" (12441 32380)) ;;; Generated autoloads from mh-utils.el (put (quote mh-progs) (quote risky-local-variable) t) (put (quote mh-lib) (quote risky-local-variable) t) ;;;*** ;;;### (autoloads (convert-mocklisp-buffer) "mlconvert" "mlconvert.el" (12144 35507)) ;;; Generated autoloads from mlconvert.el (autoload (quote convert-mocklisp-buffer) "mlconvert" "\ Convert buffer of Mocklisp code to real Lisp that GNU Emacs can run." t nil) ;;;*** ;;;### (autoloads (modula-2-mode) "modula2" "modula2.el" (12352 43076)) ;;; Generated autoloads from modula2.el (autoload (quote modula-2-mode) "modula2" "\ This is a mode intended to support program development in Modula-2. All control constructs of Modula-2 can be reached by typing C-c followed by the first character of the construct. \\ \\[m2-begin] begin \\[m2-case] case \\[m2-definition] definition \\[m2-else] else \\[m2-for] for \\[m2-header] header \\[m2-if] if \\[m2-module] module \\[m2-loop] loop \\[m2-or] or \\[m2-procedure] procedure Control-c Control-w with \\[m2-record] record \\[m2-stdio] stdio \\[m2-type] type \\[m2-until] until \\[m2-var] var \\[m2-while] while \\[m2-export] export \\[m2-import] import \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment \\[suspend-emacs] suspend Emacs \\[m2-toggle] toggle \\[m2-compile] compile \\[m2-next-error] next-error \\[m2-link] link `m2-indent' controls the number of spaces for each indentation. `m2-compile-command' holds the command to compile a Modula-2 program. `m2-link-command' holds the command to link a Modula-2 program." t nil) ;;;*** ;;;### (autoloads (mpuz) "mpuz" "mpuz.el" (11684 27378)) ;;; Generated autoloads from mpuz.el (autoload (quote mpuz) "mpuz" "\ Multiplication puzzle with GNU Emacs." t nil) ;;;*** ;;;### (autoloads (nnkiboze-generate-groups) "nnkiboze" "nnkiboze.el" (12442 58296)) ;;; Generated autoloads from nnkiboze.el (autoload (quote nnkiboze-generate-groups) "nnkiboze" "\ Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups Finds out what articles are to be part of the nnkiboze groups." t nil) ;;;*** ;;;### (autoloads (nnml-generate-nov-databases) "nnml" "nnml.el" (12442 58338)) ;;; Generated autoloads from nnml.el (autoload (quote nnml-generate-nov-databases) "nnml" "\ Generate nov databases in all nnml mail newsgroups." t nil) ;;;*** ;;;### (autoloads (disable-command enable-command disabled-command-hook) "novice" "novice.el" (12088 17075)) ;;; Generated autoloads from novice.el (setq disabled-command-hook (quote disabled-command-hook)) (autoload (quote disabled-command-hook) "novice" nil nil nil) (autoload (quote enable-command) "novice" "\ Allow COMMAND to be executed without special confirmation from now on. The user's .emacs file is altered so that this will apply to future sessions." t nil) (autoload (quote disable-command) "novice" "\ Require special confirmation to execute COMMAND from now on. The user's .emacs file is altered so that this will apply to future sessions." t nil) ;;;*** ;;;### (autoloads (nroff-mode) "nroff-mode" "nroff-mode.el" (12300 10924)) ;;; Generated autoloads from nroff-mode.el (autoload (quote nroff-mode) "nroff-mode" "\ Major mode for editing text intended for nroff to format. \\{nroff-mode-map} Turning on Nroff mode runs `text-mode-hook', then `nroff-mode-hook'. Also, try `nroff-electric-mode', for automatically inserting closing requests for requests that are used in matched pairs." t nil) ;;;*** ;;;### (autoloads (edit-options list-options) "options" "options.el" (12135 28451)) ;;; Generated autoloads from options.el (autoload (quote list-options) "options" "\ Display a list of Emacs user options, with values and documentation." t nil) (autoload (quote edit-options) "options" "\ Edit a list of Emacs user option values. Selects a buffer containing such a list, in which there are commands to set the option values. Type \\[describe-mode] in that buffer for a list of commands." t nil) ;;;*** ;;;### (autoloads (outline-minor-mode outline-mode) "outline" "outline.el" (12197 36782)) ;;; Generated autoloads from outline.el (autoload (quote outline-mode) "outline" "\ Set major mode for editing outlines with selective display. Headings are lines which start with asterisks: one for major headings, two for subheadings, etc. Lines not starting with asterisks are body lines. Body text or subheadings under a heading can be made temporarily invisible, or visible again. Invisible lines are attached to the end of the heading, so they move with it, if the line is killed and yanked back. A heading with text hidden under it is marked with an ellipsis (...). Commands:\\ \\[outline-next-visible-heading] outline-next-visible-heading move by visible headings \\[outline-previous-visible-heading] outline-previous-visible-heading \\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings \\[outline-backward-same-level] outline-backward-same-level \\[outline-up-heading] outline-up-heading move from subheading to heading \\[hide-body] make all text invisible (not headings). \\[show-all] make everything in buffer visible. The remaining commands are used when point is on a heading line. They apply to some of the body or subheadings of that heading. \\[hide-subtree] hide-subtree make body and subheadings invisible. \\[show-subtree] show-subtree make body and subheadings visible. \\[show-children] show-children make direct subheadings visible. No effect on body, or subheadings 2 or more levels down. With arg N, affects subheadings N levels down. \\[hide-entry] make immediately following body invisible. \\[show-entry] make it visible. \\[hide-leaves] make body under heading and under its subheadings invisible. The subheadings remain visible. \\[show-branches] make all subheadings at all levels visible. The variable `outline-regexp' can be changed to control what is a heading. A line is a heading if `outline-regexp' matches something at the beginning of the line. The longer the match, the deeper the level. Turning on outline mode calls the value of `text-mode-hook' and then of `outline-mode-hook', if they are non-nil." t nil) (autoload (quote outline-minor-mode) "outline" "\ Toggle Outline minor mode. With arg, turn Outline minor mode on if arg is positive, off otherwise. See the command `outline-mode' for more information on this mode." t nil) ;;;*** ;;;### (autoloads (pascal-mode) "pascal" "pascal.el" (12437 2286)) ;;; Generated autoloads from pascal.el (autoload (quote pascal-mode) "pascal" "\ Major mode for editing Pascal code. \\ TAB indents for Pascal code. Delete converts tabs to spaces as it moves back. \\[pascal-complete-word] completes the word around current point with respect to position in code \\[pascal-show-completions] shows all possible completions at this point. Other useful functions are: \\[pascal-mark-defun] - Mark function. \\[pascal-insert-block] - insert begin ... end; \\[pascal-star-comment] - insert (* ... *) \\[pascal-comment-area] - Put marked area in a comment, fixing nested comments. \\[pascal-uncomment-area] - Uncomment an area commented with \\[pascal-comment-area]. \\[pascal-beg-of-defun] - Move to beginning of current function. \\[pascal-end-of-defun] - Move to end of current function. \\[pascal-goto-defun] - Goto function prompted for in the minibuffer. \\[pascal-outline] - Enter pascal-outline-mode (see also pascal-outline). Variables controlling indentation/edit style: pascal-indent-level (default 3) Indentation of Pascal statements with respect to containing block. pascal-case-indent (default 2) Indentation for case statements. pascal-auto-newline (default nil) Non-nil means automatically newline after simcolons and the punctation mark after an end. pascal-tab-always-indent (default t) Non-nil means TAB in Pascal mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. pascal-auto-endcomments (default t) Non-nil means a comment { ... } is set after the ends which ends cases and functions. The name of the function or case will be set between the braces. pascal-auto-lineup (default t) List of contexts where auto lineup of :'s or ='s hould be done. See also the user variables pascal-type-keywords, pascal-start-keywords and pascal-separator-keywords. Turning on Pascal mode calls the value of the variable pascal-mode-hook with no args, if that value is non-nil." t nil) ;;;*** ;;;### (autoloads (pc-bindings-mode) "pc-mode" "pc-mode.el" (12437 2392)) ;;; Generated autoloads from pc-mode.el (autoload (quote pc-bindings-mode) "pc-mode" "\ Set up certain key bindings for PC compatibility. The keys affected are: Delete (and its variants) delete forward instead of backward. C-Backspace kills backward a word (as C-Delete normally would). M-Backspace does undo. Home and End move to beginning and end of line C-Home and C-End move to beginning and end of buffer. C-Escape does list-buffers." t nil) ;;;*** ;;;### (autoloads (pc-selection-mode) "pc-select" "pc-select.el" (12419 61975)) ;;; Generated autoloads from pc-select.el (autoload (quote pc-selection-mode) "pc-select" "\ Change mark behaviour to emulate motif, MAC or MS-Windows cut and paste style. This mode will switch on delete-selection-mode and transient-mark-mode. The cursor keys (and others) are bound to new functions which will modify the status of the mark. It will be possible to select regions with shift-cursorkeys. All this tries to emulate the look-and-feel of GUIs like motif, the MAC GUI or MS-Windows (sorry for the last one)." t nil) ;;;*** ;;;### (autoloads (perl-mode) "perl-mode" "perl-mode.el" (12309 32447)) ;;; Generated autoloads from perl-mode.el (autoload (quote perl-mode) "perl-mode" "\ Major mode for editing Perl code. Expression and list commands understand all Perl brackets. Tab indents for Perl code. Comments are delimited with # ... \\n. Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \\{perl-mode-map} Variables controlling indentation style: perl-tab-always-indent Non-nil means TAB in Perl mode should always indent the current line, regardless of where in the line point is when the TAB command is used. perl-tab-to-comment Non-nil means that for lines which don't need indenting, TAB will either delete an empty comment, indent an existing comment, move to end-of-line, or if at end-of-line already, create a new comment. perl-nochange Lines starting with this regular expression are not auto-indented. perl-indent-level Indentation of Perl statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. perl-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. perl-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to `perl-continued-statement-offset'. perl-brace-offset Extra indentation for line if it starts with an open brace. perl-brace-imaginary-offset An open brace following other text is treated as if it were this far to the right of the start of its line. perl-label-offset Extra indentation for line that is a label. Various indentation styles: K&R BSD BLK GNU LW perl-indent-level 5 8 0 2 4 perl-continued-statement-offset 5 8 4 2 4 perl-continued-brace-offset 0 0 0 0 -4 perl-brace-offset -5 -8 0 0 0 perl-brace-imaginary-offset 0 0 4 0 0 perl-label-offset -5 -8 -2 -2 -2 Turning on Perl mode runs the normal hook `perl-mode-hook'." t nil) ;;;*** ;;;### (autoloads (picture-mode) "picture" "picture.el" (12189 27091)) ;;; Generated autoloads from picture.el (autoload (quote picture-mode) "picture" "\ Switch to Picture mode, in which a quarter-plane screen model is used. Printing characters replace instead of inserting themselves with motion afterwards settable by these commands: C-c < Move left after insertion. C-c > Move right after insertion. C-c ^ Move up after insertion. C-c . Move down after insertion. C-c ` Move northwest (nw) after insertion. C-c ' Move northeast (ne) after insertion. C-c / Move southwest (sw) after insertion. C-c \\ Move southeast (se) after insertion. The current direction is displayed in the mode line. The initial direction is right. Whitespace is inserted and tabs are changed to spaces when required by movement. You can move around in the buffer with these commands: \\[picture-move-down] Move vertically to SAME column in previous line. \\[picture-move-up] Move vertically to SAME column in next line. \\[picture-end-of-line] Move to column following last non-whitespace character. \\[picture-forward-column] Move right inserting spaces if required. \\[picture-backward-column] Move left changing tabs to spaces if required. C-c C-f Move in direction of current picture motion. C-c C-b Move in opposite direction of current picture motion. Return Move to beginning of next line. You can edit tabular text with these commands: M-Tab Move to column beneath (or at) next interesting character. `Indents' relative to a previous line. Tab Move to next stop in tab stop list. C-c Tab Set tab stops according to context of this line. With ARG resets tab stops to default (global) value. See also documentation of variable picture-tab-chars which defines \"interesting character\". You can manually change the tab stop list with command \\[edit-tab-stops]. You can manipulate text with these commands: C-d Clear (replace) ARG columns after point without moving. C-c C-d Delete char at point - the command normally assigned to C-d. \\[picture-backward-clear-column] Clear (replace) ARG columns before point, moving back over them. \\[picture-clear-line] Clear ARG lines, advancing over them. The cleared text is saved in the kill ring. \\[picture-open-line] Open blank line(s) beneath current line. You can manipulate rectangles with these commands: C-c C-k Clear (or kill) a rectangle and save it. C-c C-w Like C-c C-k except rectangle is saved in named register. C-c C-y Overlay (or insert) currently saved rectangle at point. C-c C-x Like C-c C-y except rectangle is taken from named register. \\[copy-rectangle-to-register] Copies a rectangle to a register. \\[advertised-undo] Can undo effects of rectangle overlay commands commands if invoked soon enough. You can return to the previous mode with: C-c C-c Which also strips trailing whitespace from every line. Stripping is suppressed by supplying an argument. Entry to this mode calls the value of picture-mode-hook if non-nil. Note that Picture mode commands will work outside of Picture mode, but they are not defaultly assigned to keys." t nil) (defalias (quote edit-picture) (quote picture-mode)) ;;;*** ;;;### (autoloads (pp-eval-last-sexp pp-eval-expression pp) "pp" "pp.el" (12437 2425)) ;;; Generated autoloads from pp.el (autoload (quote pp) "pp" "\ Output the pretty-printed representation of OBJECT, any Lisp object. Quoting characters are printed when needed to make output that `read' can handle, whenever this is possible. Output stream is STREAM, or value of `standard-output' (which see)." nil nil) (autoload (quote pp-eval-expression) "pp" "\ Evaluate EXPRESSION and pretty-print value into a new display buffer. If the pretty-printed value fits on one line, the message line is used instead. Value is also consed on to front of variable values 's value." t nil) (autoload (quote pp-eval-last-sexp) "pp" "\ Run `pp-eval-expression' on sexp before point (which see). With argument, pretty-print output into current buffer. Ignores leading comment characters." t nil) ;;;*** ;;;### (autoloads (run-prolog prolog-mode) "prolog" "prolog.el" (12117 59000)) ;;; Generated autoloads from prolog.el (autoload (quote prolog-mode) "prolog" "\ Major mode for editing Prolog code for Prologs. Blank lines and `%%...' separate paragraphs. `%'s start comments. Commands: \\{prolog-mode-map} Entry to this mode calls the value of `prolog-mode-hook' if that value is non-nil." t nil) (autoload (quote run-prolog) "prolog" "\ Run an inferior Prolog process, input and output via buffer *prolog*." t nil) ;;;*** ;;;### (autoloads (ps-despool ps-spool-region-with-faces ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ps-print-buffer) "ps-print" "ps-print.el" (12322 31800)) ;;; Generated autoloads from ps-print.el (autoload (quote ps-print-buffer) "ps-print" "\ Generate and print a PostScript image of the buffer. When called with a numeric prefix argument (C-u), prompts the user for the name of a file to save the PostScript image in, instead of sending it to the printer. More specifically, the FILENAME argument is treated as follows: if it is nil, send the image to the printer. If FILENAME is a string, save the PostScript image in a file with that name. If FILENAME is a number, prompt the user for the name of the file to save in." t nil) (autoload (quote ps-print-buffer-with-faces) "ps-print" "\ Generate and print a PostScript image of the buffer. Like `ps-print-buffer', but includes font, color, and underline information in the generated image." t nil) (autoload (quote ps-print-region) "ps-print" "\ Generate and print a PostScript image of the region. Like `ps-print-buffer', but prints just the current region." t nil) (autoload (quote ps-print-region-with-faces) "ps-print" "\ Generate and print a PostScript image of the region. Like `ps-print-region', but includes font, color, and underline information in the generated image." t nil) (autoload (quote ps-spool-buffer) "ps-print" "\ Generate and spool a PostScript image of the buffer. Like `ps-print-buffer' except that the PostScript image is saved in a local buffer to be sent to the printer later. Use the command `ps-despool' to send the spooled images to the printer." t nil) (autoload (quote ps-spool-buffer-with-faces) "ps-print" "\ Generate and spool a PostScript image of the buffer. Like `ps-spool-buffer', but includes font, color, and underline information in the generated image. Use the command `ps-despool' to send the spooled images to the printer." t nil) (autoload (quote ps-spool-region) "ps-print" "\ Generate a PostScript image of the region and spool locally. Like `ps-spool-buffer', but spools just the current region. Use the command `ps-despool' to send the spooled images to the printer." t nil) (autoload (quote ps-spool-region-with-faces) "ps-print" "\ Generate a PostScript image of the region and spool locally. Like `ps-spool-region', but includes font, color, and underline information in the generated image. Use the command `ps-despool' to send the spooled images to the printer." t nil) (autoload (quote ps-despool) "ps-print" "\ Send the spooled PostScript to the printer. When called with a numeric prefix argument (C-u), prompt the user for the name of a file to save the spooled PostScript in, instead of sending it to the printer. More specifically, the FILENAME argument is treated as follows: if it is nil, send the image to the printer. If FILENAME is a string, save the PostScript image in a file with that name. If FILENAME is a number, prompt the user for the name of the file to save in." t nil) ;;;*** ;;;### (autoloads (remote-compile) "rcompile" "rcompile.el" (12437 2458)) ;;; Generated autoloads from rcompile.el (autoload (quote remote-compile) "rcompile" "\ Compile the the current buffer's directory on HOST. Log in as USER. See \\[compile]." t nil) ;;;*** ;;;### (autoloads (clear-rectangle string-rectangle open-rectangle insert-rectangle yank-rectangle kill-rectangle extract-rectangle delete-extract-rectangle delete-rectangle) "rect" "rect.el" (11969 21329)) ;;; Generated autoloads from rect.el (autoload (quote delete-rectangle) "rect" "\ Delete (don't save) text in rectangle with point and mark as corners. The same range of columns is deleted in each line starting with the line where the region begins and ending with the line where the region ends." t nil) (autoload (quote delete-extract-rectangle) "rect" "\ Delete contents of rectangle and return it as a list of strings. Arguments START and END are the corners of the rectangle. The value is list of strings, one for each line of the rectangle." nil nil) (autoload (quote extract-rectangle) "rect" "\ Return contents of rectangle with corners at START and END. Value is list of strings, one for each line of the rectangle." nil nil) (autoload (quote kill-rectangle) "rect" "\ Delete rectangle with corners at point and mark; save as last killed one. Calling from program, supply two args START and END, buffer positions. But in programs you might prefer to use `delete-extract-rectangle'." t nil) (autoload (quote yank-rectangle) "rect" "\ Yank the last killed rectangle with upper left corner at point." t nil) (autoload (quote insert-rectangle) "rect" "\ Insert text of RECTANGLE with upper left corner at point. RECTANGLE's first line is inserted at point, its second line is inserted at a point vertically under point, etc. RECTANGLE should be a list of strings. After this command, the mark is at the upper left corner and point is at the lower right corner." nil nil) (autoload (quote open-rectangle) "rect" "\ Blank out rectangle with corners at point and mark, shifting text right. The text previously in the region is not overwritten by the blanks, but instead winds up to the right of the rectangle." t nil) (autoload (quote string-rectangle) "rect" "\ Insert STRING on each line of the region-rectangle, shifting text right. The left edge of the rectangle specifies the column for insertion. This command does not delete or overwrite any existing text. Called from a program, takes three args; START, END and STRING." t nil) (autoload (quote clear-rectangle) "rect" "\ Blank out rectangle with corners at point and mark. The text previously in the region is overwritten by the blanks. When called from a program, requires two args which specify the corners." t nil) ;;;*** ;;;### (autoloads (reporter-submit-bug-report) "reporter" "reporter.el" (12169 48728)) ;;; Generated autoloads from reporter.el (autoload (quote reporter-submit-bug-report) "reporter" nil nil nil) ;;;*** ;;;### (autoloads (reposition-window) "reposition" "reposition.el" (11718 57433)) ;;; Generated autoloads from reposition.el (autoload (quote reposition-window) "reposition" "\ Make the current definition and/or comment visible. Further invocations move it to the top of the window or toggle the visibility of comments that precede it. Point is left unchanged unless prefix ARG is supplied. If the definition is fully onscreen, it is moved to the top of the window. If it is partly offscreen, the window is scrolled to get the definition (or as much as will fit) onscreen, unless point is in a comment which is also partly offscreen, in which case the scrolling attempts to get as much of the comment onscreen as possible. Initially `reposition-window' attempts to make both the definition and preceding comments visible. Further invocations toggle the visibility of the comment lines. If ARG is non-nil, point may move in order to make the whole defun visible (if only part could otherwise be made so), to make the defun line visible (if point is in code and it could not be made so, or if only comments, including the first comment line, are visible), or to make the first comment line visible (if point is in a comment)." t nil) (define-key esc-map "\C-l" 'reposition-window) ;;;*** ;;;### (autoloads (resume-suspend-hook) "resume" "resume.el" (12256 39758)) ;;; Generated autoloads from resume.el (autoload (quote resume-suspend-hook) "resume" "\ Clear out the file used for transmitting args when Emacs resumes." nil nil) ;;;*** ;;;### (autoloads (make-ring ring-p) "ring" "ring.el" (11786 5543)) ;;; Generated autoloads from ring.el (autoload (quote ring-p) "ring" "\ Returns t if X is a ring; nil otherwise." nil nil) (autoload (quote make-ring) "ring" "\ Make a ring that can contain SIZE elements." nil nil) ;;;*** ;;;### (autoloads (rlogin) "rlogin" "rlogin.el" (12433 24202)) ;;; Generated autoloads from rlogin.el (add-hook 'same-window-regexps "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)") (autoload (quote rlogin) "rlogin" "\ Open a network login connection to HOST via the `rlogin' program. Input is sent line-at-a-time to the remote connection. Communication with the remote host is recorded in a buffer `*rlogin-HOST*' \(or `*rlogin-USER@HOST*' if the remote username differs). If a prefix argument is given and the buffer `*rlogin-HOST*' already exists, a new buffer with a different connection will be made. When called from a program, if the optional second argument is a string or buffer, it names the buffer to use. The variable `rlogin-program' contains the name of the actual program to run. It can be a relative or absolute path. The variable `rlogin-explicit-args' is a list of arguments to give to the rlogin when starting. They are added after any arguments given in INPUT-ARGS. If the default value of `rlogin-directory-tracking-mode' is t, then the default directory in that buffer is set to a remote (FTP) file name to access your home directory on the remote machine. Occasionally this causes an error, if you cannot access the home directory on that machine. This error is harmless as long as you don't try to use that default directory. If `rlogin-directory-tracking-mode' is neither t nor nil, then the default directory is initially set up to your (local) home directory. This is useful if the remote machine and your local machine share the same files via NFS. This is the default. If you wish to change directory tracking styles during a session, use the function `rlogin-directory-tracking-mode' rather than simply setting the variable." t nil) ;;;*** ;;;### (autoloads (rmail-input rmail-mode rmail) "rmail" "rmail.el" (12431 36815)) ;;; 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-" "\ A regular expression specifying part of the value of the default value of the variable `rmail-dont-reply-to-names', for when the user does not set `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:\\|^x400-originator:\\|^x400-recipients:\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:\\|^\\(resent-\\|\\)message-id:\\|^summary-line:" "\ *Regexp to match Header fields that Rmail should normally hide.") (defvar rmail-displayed-headers nil "\ *Regexp to match Header fields that Rmail should display. If nil, display all header fields except those matched by `rmail-ignored-headers'.") (defvar rmail-retry-ignored-headers nil "\ *Headers that should be stripped when retrying a failed message.") (defvar rmail-highlighted-headers "^From:\\|^Subject:" "\ *Regexp to match Header fields that Rmail should normally highlight. A value of nil means don't highlight. See also `rmail-highlight-face'.") (defvar rmail-highlight-face nil "\ *Face used by Rmail for highlighting headers.") (defvar rmail-delete-after-output nil "\ *Non-nil means automatically delete a message that is copied to a file.") (defvar rmail-primary-inbox-list nil "\ *List of files which are inboxes for user's primary mail file `~/RMAIL'. `nil' means the default, which is (\"/usr/spool/mail/$USER\") \(the name varies depending on the operating system, 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.") (defvar rmail-secondary-file-directory "~/" "\ *Directory for additional secondary Rmail files.") (defvar rmail-secondary-file-regexp "\\.xmail$" "\ *Regexp for which files are secondary Rmail files.") (autoload (quote rmail) "rmail" "\ Read and edit incoming mail. Moves messages into file named by `rmail-file-name' (a babyl format file) and edits that file in RMAIL Mode. Type \\[describe-mode] once editing that file, for a list of RMAIL commands. May be called with file name as argument; then performs rmail editing on that file, but does not copy any new mail into the file. Interactively, if you supply a prefix argument, then you have a chance to specify a file name with the minibuffer. If `rmail-display-summary' is non-nil, make a summary for this RMAIL file." t nil) (autoload (quote rmail-mode) "rmail" "\ Rmail Mode is used by \\\\[rmail] for editing Rmail files. All normal editing commands are turned off. Instead, these commands are available: \\[rmail-beginning-of-message] Move point to front of this message (same as \\[beginning-of-buffer]). \\[scroll-up] Scroll to next screen of this message. \\[scroll-down] Scroll to previous screen of this message. \\[rmail-next-undeleted-message] Move to Next non-deleted message. \\[rmail-previous-undeleted-message] Move to Previous non-deleted message. \\[rmail-next-message] Move to Next message whether deleted or not. \\[rmail-previous-message] Move to Previous message whether deleted or not. \\[rmail-first-message] Move to the first message in Rmail file. \\[rmail-last-message] Move to the last message in Rmail file. \\[rmail-show-message] Jump to message specified by numeric position in file. \\[rmail-search] Search for string and show message it is found in. \\[rmail-delete-forward] Delete this message, move to next nondeleted. \\[rmail-delete-backward] Delete this message, move to previous nondeleted. \\[rmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages till a deleted message is found. \\[rmail-edit-current-message] Edit the current message. \\[rmail-cease-edit] to return to Rmail. \\[rmail-expunge] Expunge deleted messages. \\[rmail-expunge-and-save] Expunge and save the file. \\[rmail-quit] Quit Rmail: expunge, save, then switch to another buffer. \\[save-buffer] Save without expunging. \\[rmail-get-new-mail] Move new mail from system spool directory into this file. \\[rmail-mail] Mail a message (same as \\[mail-other-window]). \\[rmail-continue] Continue composing outgoing message started before. \\[rmail-reply] Reply to this message. Like \\[rmail-mail] but initializes some fields. \\[rmail-retry-failure] Send this message again. Used on a mailer failure message. \\[rmail-forward] Forward this message to another user. \\[rmail-output-to-rmail-file] Output this message to an Rmail file (append it). \\[rmail-output] Output this message to a Unix-format mail file (append it). \\[rmail-input] Input Rmail file. Run Rmail on that file. \\[rmail-add-label] Add label to message. It will be displayed in the mode line. \\[rmail-kill-label] Kill label. Remove a label from current message. \\[rmail-next-labeled-message] Move to Next message with specified label (label defaults to last one specified). Standard labels: filed, unseen, answered, forwarded, deleted. Any other label is present only if you add it with \\[rmail-add-label]. \\[rmail-previous-labeled-message] Move to Previous message with specified label \\[rmail-summary] Show headers buffer, with a one line summary of each message. \\[rmail-summary-by-labels] Summarize only messages with particular label(s). \\[rmail-summary-by-recipients] Summarize only messages with particular recipient(s). \\[rmail-summary-by-regexp] Summarize only messages with particular regexp(s). \\[rmail-summary-by-topic] Summarize only messages with subject line regexp(s). \\[rmail-toggle-header] Toggle display of complete header." t nil) (autoload (quote rmail-input) "rmail" "\ Run Rmail on file FILENAME." t nil) ;;;*** ;;;### (autoloads (news-post-news) "rnewspost" "rnewspost.el" (12206 60016)) ;;; Generated autoloads from rnewspost.el (autoload (quote news-post-news) "rnewspost" "\ Begin editing a new USENET news article to be posted. Type \\[describe-mode] once editing the article to get a list of commands." t nil) ;;;*** ;;;### (autoloads (toggle-rot13-mode rot13-other-window) "rot13" "rot13.el" (11869 10108)) ;;; Generated autoloads from rot13.el (autoload (quote rot13-other-window) "rot13" "\ Display current buffer in rot 13 in another window. To terminate the rot13 display, delete that window." t nil) (autoload (quote toggle-rot13-mode) "rot13" "\ Toggle the use of rot 13 encoding for the current window." t nil) ;;;*** ;;;### (autoloads (resize-minibuffer-mode) "rsz-mini" "rsz-mini.el" (12346 16649)) ;;; Generated autoloads from rsz-mini.el (defvar resize-minibuffer-mode nil "\ *If non-`nil', resize the minibuffer so its entire contents are visible.") (defvar resize-minibuffer-window-max-height nil "\ *Maximum size the minibuffer window is allowed to become. If less than 1 or not a number, the limit is the height of the frame in which the active minibuffer window resides.") (defvar resize-minibuffer-window-exactly t "\ *Allow making minibuffer exactly the size to display all its contents. If `nil', the minibuffer window can temporarily increase in size but never get smaller while it is active. Any other value allows exact resizing.") (defvar resize-minibuffer-frame nil "\ *Allow changing the frame height of minibuffer frames. If non-`nil' and the active minibuffer is the sole window in its frame, allow changing the frame height.") (defvar resize-minibuffer-frame-max-height nil "\ *Maximum size the minibuffer frame is allowed to become. If less than 1 or not a number, there is no limit.") (defvar resize-minibuffer-frame-exactly t "\ *Allow making minibuffer frame exactly the size to display all its contents. If `nil', the minibuffer frame can temporarily increase in size but never get smaller while it is active. Any other value allows exact resizing.") (autoload (quote resize-minibuffer-mode) "rsz-mini" "\ Enable or disable resize-minibuffer mode. A negative prefix argument disables this mode. A positive argument or argument of 0 enables it. When this minor mode is enabled, the minibuffer is dynamically resized to contain the entire region of text put in it as you type. The variable `resize-minibuffer-mode' is set to t or nil depending on whether this mode is active or not. The maximum height to which the minibuffer can grow is controlled by the variable `resize-minibuffer-window-max-height'. The variable `resize-minibuffer-window-exactly' determines whether the minibuffer window should ever be shrunk to make it no larger than needed to display its contents. When using a window system, it is possible for a minibuffer to be the sole window in a frame. Since that window is already its maximum size, the only way to make more text visible at once is to increase the size of the frame. The variable `resize-minibuffer-frame' controls whether this should be done. The variables `resize-minibuffer-frame-max-height' and `resize-minibuffer-frame-exactly' are analogous to their window counterparts." t nil) ;;;*** ;;;### (autoloads (scheme-mode) "scheme" "scheme.el" (12156 22189)) ;;; Generated autoloads from scheme.el (autoload (quote scheme-mode) "scheme" "\ Major mode for editing Scheme code. Editing commands are similar to those of lisp-mode. In addition, if an inferior Scheme process is running, some additional commands will be defined, for evaluating expressions and controlling the interpreter, and the state of the process will be displayed in the modeline of all Scheme buffers. The names of commands that interact with the Scheme process start with \"xscheme-\". For more information see the documentation for xscheme-interaction-mode. Commands: Delete converts tabs to spaces as it moves back. Blank lines separate paragraphs. Semicolons start comments. \\{scheme-mode-map} Entry to this mode calls the value of scheme-mode-hook if that value is non-nil." t nil) ;;;*** ;;;### (autoloads (scribe-mode) "scribe" "scribe.el" (12198 51390)) ;;; Generated autoloads from scribe.el (autoload (quote scribe-mode) "scribe" "\ Major mode for editing files of Scribe (a text formatter) source. Scribe-mode is similar text-mode, with a few extra commands added. \\{scribe-mode-map} Interesting variables: scribe-fancy-paragraphs Non-nil makes Scribe mode use a different style of paragraph separation. scribe-electric-quote Non-nil makes insert of double quote use `` or '' depending on context. scribe-electric-parenthesis Non-nil makes an open-parenthesis char (one of `([<{') automatically insert its close if typed after an @Command form." t nil) ;;;*** ;;;### (autoloads (mail-other-frame mail-other-window mail mail-mode) "sendmail" "sendmail.el" (12442 42000)) ;;; Generated autoloads from sendmail.el (defvar mail-from-style (quote angles) "\ *Specifies how \"From:\" fields look. If `nil', they contain just the return address like: king@grassland.com If `parens', they look like: king@grassland.com (Elvis Parsley) If `angles', they look like: Elvis Parsley ") (defvar mail-self-blind nil "\ Non-nil means insert BCC to self in messages to be sent. This is done when the message is initialized, so you can remove or alter the BCC field to override the default.") (defvar mail-interactive nil "\ Non-nil means when sending a message wait for and display errors. nil means let mailer mail back a message to report errors.") (defvar mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\ Delete these headers from old message when it's inserted in a reply.") (defvar send-mail-function (quote sendmail-send-it) "\ Function to call to send the current buffer as mail. The headers should be delimited by a line whose contents match the variable `mail-header-separator'.") (defvar mail-header-separator "--text follows this line--" "\ *Line used to separate headers from text in messages being composed.") (defvar mail-archive-file-name nil "\ *Name of file to write all outgoing messages in, or nil for none. This can be an inbox file or an Rmail file.") (defvar mail-default-reply-to nil "\ *Address to insert as default Reply-to field of outgoing messages. If nil, it will be initialized from the REPLYTO environment variable when you first send mail.") (defvar mail-alias-file nil "\ *If non-nil, the name of a file to use instead of `/usr/lib/aliases'. This file defines aliases to be expanded by the mailer; this is a different feature from that of defining aliases in `.mailrc' to be expanded in Emacs. This variable has no effect unless your system uses sendmail as its mailer.") (defvar mail-personal-alias-file "~/.mailrc" "\ *If non-nil, the name of the user's personal mail alias file. This file typically should be in same format as the `.mailrc' file used by the `Mail' or `mailx' program. This file need not actually exist.") (defvar mail-signature nil "\ *Text inserted at end of mail buffer when a message is initialized. If t, it means to insert the contents of the file `mail-signature-file'.") (autoload (quote mail-mode) "sendmail" "\ Major mode for editing mail to be sent. Like Text Mode but with these additional commands: C-c C-s mail-send (send the message) C-c C-c mail-send-and-exit C-c C-f move to a header field (and create it if there isn't): C-c C-f C-t move to To: C-c C-f C-s move to Subject: C-c C-f C-c move to CC: C-c C-f C-b move to BCC: C-c C-f C-f move to FCC: C-c C-t mail-text (move to beginning of message text). C-c C-w mail-signature (insert `mail-signature-file' file). C-c C-y mail-yank-original (insert current message, in Rmail). C-c C-q mail-fill-yanked-message (fill what was yanked). C-c C-v mail-sent-via (add a Sent-via field for each To or CC)." t nil) (autoload (quote mail) "sendmail" "\ Edit a message to be sent. Prefix arg means resume editing (don't erase). When this function returns, the buffer `*mail*' is selected. The value is t if the message was newly initialized; otherwise, nil. Optionally, the signature file `mail-signature-file' can be inserted at the end; see the variable `mail-signature'. \\ While editing message, type \\[mail-send-and-exit] to send the message and exit. Various special commands starting with C-c are available in sendmail mode to move to message header fields: \\{mail-mode-map} If `mail-self-blind' is non-nil, a BCC to yourself is inserted when the message is initialized. If `mail-default-reply-to' is non-nil, it should be an address (a string); a Reply-to: field with that address is inserted. If `mail-archive-file-name' is non-nil, an FCC field with that file name is inserted. The normal hook `mail-setup-hook' is run after the message is initialized. It can add more default fields to the message. When calling from a program, the first argument if non-nil says not to erase the existing contents of the `*mail*' buffer. The second through fifth arguments, TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil the initial contents of those header fields. These arguments should not have final newlines. The sixth argument REPLYBUFFER is a buffer whose contents should be yanked if the user types C-c C-y. The seventh argument ACTIONS is a list of actions to take if/when the message is sent. Each action looks like (FUNCTION . ARGS); when the message is sent, we apply FUNCTION to ARGS. This is how Rmail arranges to mark messages `answered'." t nil) (autoload (quote mail-other-window) "sendmail" "\ Like `mail' command, but display mail buffer in another window." t nil) (autoload (quote mail-other-frame) "sendmail" "\ Like `mail' command, but display mail buffer in another frame." t nil) (define-key ctl-x-map "m" 'mail) (define-key ctl-x-4-map "m" 'mail-other-window) (define-key ctl-x-5-map "m" 'mail-other-frame) (add-hook 'same-window-buffer-names "*mail*") ;;;*** ;;;### (autoloads (server-start) "server" "server.el" (12400 19910)) ;;; Generated autoloads from server.el (autoload (quote server-start) "server" "\ Allow this Emacs process to be a server for client processes. This starts a server communications subprocess through which client \"editors\" can send your editing commands to this Emacs job. To use the server, set up the program `emacsclient' in the Emacs distribution as your standard \"editor\". Prefix arg means just kill any existing server communications subprocess." t nil) ;;;*** ;;;### (autoloads (sgml-mode) "sgml-mode" "sgml-mode.el" (12256 39759)) ;;; Generated autoloads from sgml-mode.el (autoload (quote sgml-mode) "sgml-mode" "\ Major mode for editing SGML. Makes > display the matching <. Makes / display matching /. Use \\[sgml-validate] to validate your document with an SGML parser." t nil) ;;;*** ;;;### (autoloads (sh-mode) "sh-script" "sh-script.el" (12441 35631)) ;;; Generated autoloads from sh-script.el (autoload (quote sh-mode) "sh-script" "\ Major mode for editing shell scripts. This mode works for many shells, since they all have roughly the same syntax, as far as commands, arguments, variables, pipes, comments etc. are concerned. Unless the file's magic number indicates the shell, your usual shell is assumed. Since filenames rarely give a clue, they are not further analyzed. This mode adapts to the variations between shells (see `sh-set-shell') by means of an inheritance based feature lookup (see `sh-feature'). This mechanism applies to all variables (including skeletons) that pertain to shell-specific features. The default style of this mode is that of Rosenblatt's Korn shell book. The syntax of the statements varies with the shell being used. The following commands are available, based on the current shell's syntax: \\[sh-case] case statement \\[sh-for] for loop \\[sh-function] function definition \\[sh-if] if statement \\[sh-indexed-loop] indexed loop from 1 to n \\[sh-while-getopts] while getopts loop \\[sh-repeat] repeat loop \\[sh-select] select loop \\[sh-until] until loop \\[sh-while] while loop \\[backward-delete-char-untabify] Delete backward one position, even if it was a tab. \\[sh-newline-and-indent] Delete unquoted space and indent new line same as this one. \\[sh-end-of-command] Go to end of successive commands. \\[sh-beginning-of-command] Go to beginning of successive commands. \\[sh-set-shell] Set this buffer's shell, and maybe its magic number. \\[sh-execute-region] Have optional header and region be executed in a subshell. \\[sh-maybe-here-document] Without prefix, following an unquoted < inserts here document. {, (, [, ', \", ` Unless quoted with \\, insert the pairs {}, (), [], or '', \"\", ``. If you generally program a shell different from your login shell you can set `sh-shell-path' accordingly. If your shell's file name doesn't correctly indicate what shell it is use `sh-alias-alist' to translate. If your shell gives error messages with line numbers, you can use \\[executable-interpret] with your script for an edit-interpret-debug cycle." t nil) (defalias (quote shell-script-mode) (quote sh-mode)) ;;;*** ;;;### (autoloads (shell) "shell" "shell.el" (12261 65275)) ;;; Generated autoloads from shell.el (defvar shell-prompt-pattern "^[^#$%>\n]*[#$%>] *" "\ Regexp to match prompts in the inferior shell. Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well. 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.") (autoload (quote shell) "shell" "\ Run an inferior shell, with I/O through buffer *shell*. If buffer exists but shell process is not running, make new shell. If buffer exists and shell process is running, just switch to buffer `*shell*'. Program used comes from variable `explicit-shell-file-name', or (if that is nil) from the ESHELL environment variable, or else from SHELL if there is no ESHELL. If a file `~/.emacs_SHELLNAME' exists, it is given as initial input (Note that this may lose due to a timing error if the shell discards input when it starts up.) The buffer is put in Shell mode, giving commands for sending input and controlling the subjobs of the shell. See `shell-mode'. See also the variable `shell-prompt-pattern'. The shell file name (sans directories) is used to make a symbol name such as `explicit-csh-args'. If that symbol is a variable, its value is used as a list of arguments when invoking the shell. Otherwise, one argument `-i' is passed to the shell. \(Type \\[describe-mode] in the shell buffer for a list of commands.)" t nil) (add-hook 'same-window-buffer-names "*shell*") ;;;*** ;;;### (autoloads (skeleton-pair-insert-maybe skeleton-insert skeleton-proxy define-skeleton) "skeleton" "skeleton.el" (12441 35845)) ;;; Generated autoloads from skeleton.el (defvar skeleton-filter (quote identity) "\ Function for transforming a skeleton-proxy's aliases' variable value.") (autoload (quote define-skeleton) "skeleton" "\ Define a user-configurable COMMAND that enters a statement skeleton. DOCUMENTATION is that of the command, while the variable of the same name, which contains the skeleton, has a documentation to that effect. INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'." nil (quote macro)) (autoload (quote skeleton-proxy) "skeleton" "\ Insert skeleton defined by variable of same name (see `skeleton-insert'). Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). This command can also be an abbrev expansion (3rd and 4th columns in \\[edit-abbrevs] buffer: \"\" command-name). When called as a function, optional first argument STR may also be a string which will be the value of `str' whereas the skeleton's interactor is then ignored." t nil) (autoload (quote skeleton-insert) "skeleton" "\ Insert the complex statement skeleton SKELETON describes very concisely. With optional third REGIONS wrap first interesting point (`_') in skeleton around next REGIONS words, if REGIONS is positive. If REGIONS is negative, wrap REGIONS preceding interregions into first REGIONS interesting positions \(successive `_'s) in skeleton. An interregion is the stretch of text between two contiguous marked points. If you marked A B C [] (where [] is the cursor) in alphabetical order, the 3 interregions are simply the last 3 regions. But if you marked B A [] C, the interregions are B-A, A-[], []-C. Optional fourth STR is the value for the variable `str' within the skeleton. When this is non-`nil' the interactor gets ignored, and this should be a valid skeleton element. SKELETON is made up as (INTERACTOR ELEMENT ...). INTERACTOR may be nil if not needed, a prompt-string or an expression for complex read functions. If ELEMENT is a string or a character it gets inserted (see also `skeleton-transformation'). Other possibilities are: \\n go to next line and indent according to mode _ interesting point, interregion here, point after termination > indent line (or interregion if > _) according to major mode & do next ELEMENT if previous moved point | do next ELEMENT if previous didn't move point -num delete num preceding characters (see `skeleton-untabify') resume: skipped, continue here if quit is signaled nil skipped Further elements can be defined via `skeleton-further-elements'. ELEMENT may itself be a SKELETON with an INTERACTOR. The user is prompted repeatedly for different inputs. The SKELETON is processed as often as the user enters a non-empty string. \\[keyboard-quit] terminates skeleton insertion, but continues after `resume:' and positions at `_' if any. If INTERACTOR in such a subskeleton is a prompt-string which contains a \".. %s ..\" it is formatted with `skeleton-subprompt'. Such an INTERACTOR may also a list of strings with the subskeleton being repeated once for each string. Quoted lisp-expressions are evaluated evaluated for their side-effect. Other lisp-expressions are evaluated and the value treated as above. Note that expressions may not return `t' since this impplies an endless loop. Modes can define other symbols by locally setting them to any valid skeleton element. The following local variables are available: str first time: read a string according to INTERACTOR then: insert previously read string once more help help-form during interaction with the user or `nil' input initial input (string or cons with index) while reading str v1, v2 local variables for memorising anything you want When done with skeleton, but before going back to `_'-point call `skeleton-end-hook' if that is non-`nil'." nil nil) (autoload (quote skeleton-pair-insert-maybe) "skeleton" "\ Insert the character you type ARG times. With no ARG, if `skeleton-pair' is non-nil, and if `skeleton-pair-on-word' is non-nil or we are not before or inside a word, and if `skeleton-pair-filter' returns nil, pairing is performed. If a match is found in `skeleton-pair-alist', that is inserted, else the defaults are used. These are (), [], {}, <> and `' for the symmetrical ones, and the same character twice for the others." t nil) ;;;*** ;;;### (autoloads (solar-equinoxes-solstices sunrise-sunset) "solar" "solar.el" (12384 53888)) ;;; 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. The value can be either a decimal fraction (one place of accuracy is sufficient), + north, - south, such as 40.7 for New York City, or the value can be a vector [degrees minutes north/south] such as [40 50 north] for New York City. This variable should be set in site-local.el.") (defvar calendar-longitude nil "\ *Longitude of `calendar-location-name' in degrees. The value can be either a decimal fraction (one place of accuracy is sufficient), + east, - west, such as -73.9 for New York City, or the value can be a vector [degrees minutes east/west] such as [73 55 west] for New York City. This variable should be set in site-local.el.") (defvar calendar-location-name (quote (let ((float-output-format "%.1f")) (format "%s%s, %s%s" (if (numberp calendar-latitude) (abs calendar-latitude) (+ (aref calendar-latitude 0) (/ (aref calendar-latitude 1) 60.0))) (if (numberp calendar-latitude) (if (> calendar-latitude 0) "N" "S") (if (equal (aref calendar-latitude 2) (quote north)) "N" "S")) (if (numberp calendar-longitude) (abs calendar-longitude) (+ (aref calendar-longitude 0) (/ (aref calendar-longitude 1) 60.0))) (if (numberp calendar-longitude) (if (> calendar-longitude 0) "E" "W") (if (equal (aref calendar-longitude 2) (quote east)) "E" "W"))))) "\ *Expression evaluating to name of `calendar-longitude', calendar-latitude'. For example, \"New York City\". Default value is just the latitude, longitude pair. This variable should be set in site-local.el.") (autoload (quote sunrise-sunset) "solar" "\ Local time of sunrise and sunset for today. Accurate to +/- 2 minutes. If called with an optional prefix argument, prompt for date. If called with an optional double prefix argument, prompt for longitude, latitude, time zone, and date, and always use standard time. This function is suitable for execution in a .emacs file." t nil) (autoload (quote solar-equinoxes-solstices) "solar" "\ Date and time of equinoxes and solstices, if visible in the calendar window. Requires floating point." nil nil) ;;;*** ;;;### (autoloads (solitaire) "solitaire" "solitaire.el" (12437 2599)) ;;; Generated autoloads from solitaire.el (autoload (quote solitaire) "solitaire" "\ Play Solitaire. To play Solitaire, type \\[solitaire]. \\ Move around the board using the cursor keys. Move stones using \\[solitaire-move] followed by a direction key. Undo moves using \\[solitaire-undo]. Check for possible moves using \\[solitaire-do-check]. \(The variable solitaire-auto-eval controls whether to automatically check after each move or undo) What is Solitaire? I don't know who invented this game, but it seems to be rather old and it's origin seems be northern Africa. Here's how to play: Initially, the board will look similar to this: Le Solitaire ============ o o o o o o o o o o o o o o o o . o o o o o o o o o o o o o o o o Let's call the o's stones and the .'s holes. One stone fits into one hole. As you can see, all holes but one are occupied by stones. The aim of the game is to get rid of all but one stone, leaving that last one in the middle of the board if you're cool. A stone can be moved if there is another stone next to it, and a hole after that one. Thus there must be three fields in a row, either horizontally or vertically, up, down, left or right, which look like this: o o . Then the first stone is moved to the hole, jumping over the second, which therefore is taken away. The above thus `evaluates' to: . . o That's all. Here's the board after two moves: o o o . o o o o . o o o o o . o o o o o o o o o o o o o o o o o o Pick your favourite shortcuts: \\{solitaire-mode-map}" t nil) ;;;*** ;;;### (autoloads (reverse-region sort-columns sort-regexp-fields sort-fields sort-numeric-fields sort-pages sort-paragraphs sort-lines sort-subr) "sort" "sort.el" (12164 38924)) ;;; Generated autoloads from sort.el (autoload (quote sort-subr) "sort" "\ General text sorting routine to divide buffer into records and sort them. Arguments are REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN. We divide the accessible portion of the buffer into disjoint pieces called sort records. A portion of each sort record (perhaps all of it) is designated as the sort key. The records are rearranged in the buffer in order by their sort keys. The records may or may not be contiguous. Usually the records are rearranged in order of ascending sort key. If REVERSE is non-nil, they are rearranged in order of descending sort key. The next four arguments are functions to be called to move point across a sort record. They will be called many times from within sort-subr. NEXTRECFUN is called with point at the end of the previous record. It moves point to the start of the next record. It should move point to the end of the buffer if there are no more records. The first record is assumed to start at the position of point when sort-subr is called. ENDRECFUN is called with point within the record. It should move point to the end of the record. STARTKEYFUN moves from the start of the record to the start of the key. It may return either a non-nil value to be used as the key, or else the key is the substring between the values of point after STARTKEYFUN and ENDKEYFUN are called. If STARTKEYFUN is nil, the key starts at the beginning of the record. ENDKEYFUN moves from the start of the sort key to the end of the sort key. ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the same as ENDRECFUN." nil nil) (autoload (quote sort-lines) "sort" "\ Sort lines in region alphabetically; argument means descending order. Called from a program, there are three arguments: REVERSE (non-nil means reverse order), BEG and END (region to sort)." t nil) (autoload (quote sort-paragraphs) "sort" "\ Sort paragraphs in region alphabetically; argument means descending order. Called from a program, there are three arguments: REVERSE (non-nil means reverse order), BEG and END (region to sort)." t nil) (autoload (quote sort-pages) "sort" "\ Sort pages in region alphabetically; argument means descending order. Called from a program, there are three arguments: REVERSE (non-nil means reverse order), BEG and END (region to sort)." t nil) (autoload (quote sort-numeric-fields) "sort" "\ Sort lines in region numerically by the ARGth field of each line. Fields are separated by whitespace and numbered from 1 up. Specified field must contain a number in each line of the region. With a negative arg, sorts by the ARGth field counted from the right. Called from a program, there are three arguments: FIELD, BEG and END. BEG and END specify region to sort." t nil) (autoload (quote sort-fields) "sort" "\ Sort lines in region lexicographically by the ARGth field of each line. Fields are separated by whitespace and numbered from 1 up. With a negative arg, sorts by the ARGth field counted from the right. Called from a program, there are three arguments: FIELD, BEG and END. BEG and END specify region to sort." t nil) (autoload (quote sort-regexp-fields) "sort" "\ Sort the region lexicographically as specified by RECORD-REGEXP and KEY. RECORD-REGEXP specifies the textual units which should be sorted. For example, to sort lines RECORD-REGEXP would be \"^.*$\" KEY specifies the part of each record (ie each match for RECORD-REGEXP) is to be used for sorting. If it is \"\\digit\" then the digit'th \"\\(...\\)\" match field from RECORD-REGEXP is used. If it is \"\\&\" then the whole record is used. Otherwise, it is a regular-expression for which to search within the record. If a match for KEY is not found within a record then that record is ignored. With a negative prefix arg sorts in reverse order. For example: to sort lines in the region by the first word on each line starting with the letter \"f\", RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\=\\\"" t nil) (autoload (quote sort-columns) "sort" "\ Sort lines in region alphabetically by a certain range of columns. For the purpose of this command, the region includes the entire line that point is in and the entire line the mark is in. The column positions of point and mark bound the range of columns to sort on. A prefix argument means sort into reverse order. Note that `sort-columns' rejects text that contains tabs, because tabs could be split across the specified columns and it doesn't know how to handle that. Also, when possible, it uses the `sort' utility program, which doesn't understand tabs. Use \\[untabify] to convert tabs to spaces before sorting." t nil) (autoload (quote reverse-region) "sort" "\ Reverse the order of lines in a region. From a program takes two point or marker arguments, BEG and END." t nil) ;;;*** ;;;### (autoloads (spell-string spell-region spell-word spell-buffer) "spell" "spell.el" (12040 61663)) ;;; Generated autoloads from spell.el (put (quote spell-filter) (quote risky-local-variable) t) (autoload (quote spell-buffer) "spell" "\ Check spelling of every word in the buffer. For each incorrect word, you are asked for the correct spelling and then put into a query-replace to fix some or all occurrences. If you do not want to change a word, just give the same word as its \"correct\" spelling; then the query replace is skipped." t nil) (autoload (quote spell-word) "spell" "\ Check spelling of word at or before point. If it is not correct, ask user for the correct spelling and `query-replace' the entire buffer to substitute it." t nil) (autoload (quote spell-region) "spell" "\ Like `spell-buffer' but applies only to region. Used in a program, applies from START to END. DESCRIPTION is an optional string naming the unit being checked: for example, \"word\"." t nil) (autoload (quote spell-string) "spell" "\ Check spelling of string supplied as argument." t nil) ;;;*** ;;;### (autoloads (snarf-spooks spook) "spook" "spook.el" (11332 39077)) ;;; Generated autoloads from spook.el (autoload (quote spook) "spook" "\ 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) ;;;*** ;;;### (autoloads (sc-cite-original) "supercite" "supercite.el" (12336 37675)) ;;; Generated autoloads from supercite.el (autoload (quote sc-cite-original) "supercite" "\ Workhorse citing function which performs the initial citation. This is callable from the various mail and news readers' reply function according to the agreed upon standard. See `\\[sc-describe]' for more details. `sc-cite-original' does not do any yanking of the original message but it does require a few things: 1) The reply buffer is the current buffer. 2) The original message has been yanked and inserted into the reply buffer. 3) Verbose mail headers from the original message have been inserted into the reply buffer directly before the text of the original message. 4) Point is at the beginning of the verbose headers. 5) Mark is at the end of the body of text to be cited. For Emacs 19's, the region need not be active (and typically isn't when this function is called. Also, the hook `sc-pre-hook' is run before, and `sc-post-hook' is run after the guts of this function." nil nil) ;;;*** ;;;### (autoloads (tabify untabify) "tabify" "tabify.el" (12170 7254)) ;;; Generated autoloads from tabify.el (autoload (quote untabify) "tabify" "\ Convert all tabs in region to multiple spaces, preserving columns. Called non-interactively, the region is specified by arguments START and END, rather than by the position of point and mark. The variable `tab-width' controls the spacing of tab stops." t nil) (autoload (quote tabify) "tabify" "\ Convert multiple spaces in region to tabs when possible. A group of spaces is partially replaced by tabs when this can be done without changing the column they end at. Called non-interactively, the region is specified by arguments START and END, rather than by the position of point and mark. The variable `tab-width' controls the spacing of tab stops." t nil) ;;;*** ;;;### (autoloads (talk-connect) "talk" "talk.el" (12277 42090)) ;;; Generated autoloads from talk.el (autoload (quote talk-connect) "talk" "\ Connect to display DISPLAY for the Emacs talk group." t nil) ;;;*** ;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (12305 27749)) ;;; Generated autoloads from tar-mode.el (autoload (quote tar-mode) "tar-mode" "\ Major mode for viewing a tar file as a dired-like listing of its contents. You can move around using the usual cursor motion commands. Letters no longer insert themselves. Type `e' to pull a file out of the tar file and into its own buffer; or click mouse-2 on the file's line in the Tar mode buffer. Type `c' to copy an entry from the tar file into another file on disk. If you edit a sub-file of this archive (as with the `e' command) and save it with Control-x Control-s, the contents of that buffer will be saved back into the tar-file buffer; in this way you can edit a file inside of a tar archive without extracting it and re-archiving it. See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. \\{tar-mode-map}" nil nil) ;;;*** ;;;### (autoloads (tcl-mode) "tcl-mode" "tcl-mode.el" (12437 2667)) ;;; Generated autoloads from tcl-mode.el (autoload (quote tcl-mode) "tcl-mode" "\ Major mode for editing tcl scripts. The following keys are bound: \\{tcl-mode-map} " t nil) ;;;*** ;;;### (autoloads (rsh telnet) "telnet" "telnet.el" (12131 55286)) ;;; Generated autoloads from telnet.el (add-hook 'same-window-regexps "\\*telnet-.*\\*\\(\\|<[0-9]+>\\)") (autoload (quote telnet) "telnet" "\ Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer `*telnet-HOST*'. Normally input is edited in Emacs and sent a line at a time." t nil) (add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)") (autoload (quote rsh) "telnet" "\ Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer `*rsh-HOST*'. Normally input is edited in Emacs and sent a line at a time." t nil) ;;;*** ;;;### (autoloads (term make-term) "term" "term.el" (12437 2708)) ;;; Generated autoloads from term.el (autoload (quote make-term) "term" "\ Make a term process NAME in a buffer, running PROGRAM. The name of the buffer is made by surrounding NAME with `*'s. If there is already a running process in that buffer, it is not restarted. Optional third arg STARTFILE is the name of a file to send the contents of to the process. Any more args are arguments to PROGRAM." nil nil) (autoload (quote term) "term" "\ Start a terminal-emulator in a new buffer." t nil) ;;;*** ;;;### (autoloads (terminal-emulator) "terminal" "terminal.el" (12399 2206)) ;;; Generated autoloads from terminal.el (autoload (quote terminal-emulator) "terminal" "\ Under a display-terminal emulator in BUFFER, run PROGRAM on arguments ARGS. ARGS is a list of argument-strings. Remaining arguments are WIDTH and HEIGHT. BUFFER's contents are made an image of the display generated by that program, and any input typed when BUFFER is the current Emacs buffer is sent to that program an keyboard input. Interactively, BUFFER defaults to \"*terminal*\" and PROGRAM and ARGS are parsed from an input-string using your usual shell. WIDTH and HEIGHT are determined from the size of the current window -- WIDTH will be one less than the window's width, HEIGHT will be its height. To switch buffers and leave the emulator, or to give commands to the emulator itself (as opposed to the program running under it), type Control-^. The following character is an emulator command. Type Control-^ twice to send it to the subprogram. This escape character may be changed using the variable `terminal-escape-char'. `Meta' characters may not currently be sent through the terminal emulator. Here is a list of some of the variables which control the behaviour of the emulator -- see their documentation for more information: terminal-escape-char, terminal-scrolling, terminal-more-processing, terminal-redisplay-interval. This function calls the value of terminal-mode-hook if that exists and is non-nil after the terminal buffer has been set up and the subprocess started." t nil) ;;;*** ;;;### (autoloads (tex-start-shell slitex-mode latex-mode plain-tex-mode tex-mode) "tex-mode" "tex-mode.el" (12442 41336)) ;;; Generated autoloads from tex-mode.el (defvar tex-shell-file-name nil "\ *If non-nil, the shell file name to run in the subshell used to run TeX.") (defvar tex-directory "." "\ *Directory in which temporary files are left. You can make this `/tmp' if your TEXINPUTS has no relative directories in it and you don't try to apply \\[tex-region] or \\[tex-buffer] when there are `\\input' commands with relative directories.") (defvar tex-offer-save t "\ *If non-nil, ask about saving modified buffers before \\[tex-file] is run.") (defvar tex-run-command "tex" "\ *Command used to run TeX subjob. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end.") (defvar latex-run-command "latex" "\ *Command used to run LaTeX subjob. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end.") (defvar latex-block-names nil "\ *User defined LaTeX block names. Combined with `standard-latex-block-names' for minibuffer completion.") (defvar slitex-run-command "slitex" "\ *Command used to run SliTeX subjob. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end.") (defvar tex-bibtex-command "bibtex" "\ *Command used by `tex-bibtex-file' to gather bibliographic data. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end.") (defvar tex-dvi-print-command "lpr -d" "\ *Command used by \\[tex-print] to print a .dvi file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end.") (defvar tex-alt-dvi-print-command "lpr -d" "\ *Command used by \\[tex-print] with a prefix arg to print a .dvi file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end. If two printers are not enough of a choice, you can set the variable `tex-alt-dvi-print-command' to an expression that asks what you want; for example, (setq tex-alt-dvi-print-command '(format \"lpr -P%s\" (read-string \"Use printer: \"))) would tell \\[tex-print] with a prefix argument to ask you which printer to use.") (defvar tex-dvi-view-command nil "\ *Command used by \\[tex-view] to display a `.dvi' file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end. This can be set conditionally so that the previewer used is suitable for the window system being used. For example, (setq tex-dvi-view-command (if (eq window-system 'x) \"xdvi\" \"dvi2tty * | cat -s\")) would tell \\[tex-view] to use xdvi under X windows and to use dvi2tty otherwise.") (defvar tex-show-queue-command "lpq" "\ *Command used by \\[tex-show-print-queue] to show the print queue. Should show the queue(s) that \\[tex-print] puts jobs on.") (defvar tex-default-mode (quote plain-tex-mode) "\ *Mode to enter for a new file that might be either TeX or LaTeX. This variable is used when it can't be determined whether the file is plain TeX or LaTeX or what because the file contains no commands. Normally set to either `plain-tex-mode' or `latex-mode'.") (defvar tex-open-quote "``" "\ *String inserted by typing \\[tex-insert-quote] to open a quotation.") (defvar tex-close-quote "''" "\ *String inserted by typing \\[tex-insert-quote] to close a quotation.") (autoload (quote tex-mode) "tex-mode" "\ Major mode for editing files of input for TeX, LaTeX, or SliTeX. Tries to determine (by looking at the beginning of the file) whether this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode', `latex-mode', or `slitex-mode', respectively. If it cannot be determined, such as if there are no commands in the file, the value of `tex-default-mode' says which mode to use." t nil) (defalias (quote TeX-mode) (quote tex-mode)) (defalias (quote LaTeX-mode) (quote latex-mode)) (autoload (quote plain-tex-mode) "tex-mode" "\ Major mode for editing files of input for plain TeX. Makes $ and } display the characters they match. Makes \" insert `` when it seems to be the beginning of a quotation, and '' when it appears to be the end; it inserts \" only after a \\. Use \\[tex-region] to run TeX on the current region, plus a \"header\" copied from the top of the file (containing macro definitions, etc.), running TeX under a special subshell. \\[tex-buffer] does the whole buffer. \\[tex-file] saves the buffer and then processes the file. \\[tex-print] prints the .dvi file made by any of these. \\[tex-view] previews the .dvi file made by any of these. \\[tex-bibtex-file] runs bibtex on the file of the current buffer. Use \\[validate-tex-buffer] to check buffer for paragraphs containing mismatched $'s or braces. Special commands: \\{tex-mode-map} Mode variables: tex-run-command Command string used by \\[tex-region] or \\[tex-buffer]. tex-directory Directory in which to create temporary files for TeX jobs run by \\[tex-region] or \\[tex-buffer]. tex-dvi-print-command Command string used by \\[tex-print] to print a .dvi file. tex-alt-dvi-print-command Alternative command string used by \\[tex-print] (when given a prefix argument) to print a .dvi file. tex-dvi-view-command Command string used by \\[tex-view] to preview a .dvi file. tex-show-queue-command Command string used by \\[tex-show-print-queue] to show the print queue that \\[tex-print] put your job on. Entering Plain-tex mode runs the hook `text-mode-hook', then the hook `tex-mode-hook', and finally the hook `plain-tex-mode-hook'. When the special subshell is initiated, the hook `tex-shell-hook' is run." t nil) (defalias (quote plain-TeX-mode) (quote plain-tex-mode)) (autoload (quote latex-mode) "tex-mode" "\ Major mode for editing files of input for LaTeX. Makes $ and } display the characters they match. Makes \" insert `` when it seems to be the beginning of a quotation, and '' when it appears to be the end; it inserts \" only after a \\. Use \\[tex-region] to run LaTeX on the current region, plus the preamble copied from the top of the file (containing \\documentstyle, etc.), running LaTeX under a special subshell. \\[tex-buffer] does the whole buffer. \\[tex-file] saves the buffer and then processes the file. \\[tex-print] prints the .dvi file made by any of these. \\[tex-view] previews the .dvi file made by any of these. \\[tex-bibtex-file] runs bibtex on the file of the current buffer. Use \\[validate-tex-buffer] to check buffer for paragraphs containing mismatched $'s or braces. Special commands: \\{tex-mode-map} Mode variables: latex-run-command Command string used by \\[tex-region] or \\[tex-buffer]. tex-directory Directory in which to create temporary files for LaTeX jobs run by \\[tex-region] or \\[tex-buffer]. tex-dvi-print-command Command string used by \\[tex-print] to print a .dvi file. tex-alt-dvi-print-command Alternative command string used by \\[tex-print] (when given a prefix argument) to print a .dvi file. tex-dvi-view-command Command string used by \\[tex-view] to preview a .dvi file. tex-show-queue-command Command string used by \\[tex-show-print-queue] to show the print queue that \\[tex-print] put your job on. Entering Latex mode runs the hook `text-mode-hook', then `tex-mode-hook', and finally `latex-mode-hook'. When the special subshell is initiated, `tex-shell-hook' is run." t nil) (autoload (quote slitex-mode) "tex-mode" "\ Major mode for editing files of input for SliTeX. Makes $ and } display the characters they match. Makes \" insert `` when it seems to be the beginning of a quotation, and '' when it appears to be the end; it inserts \" only after a \\. Use \\[tex-region] to run SliTeX on the current region, plus the preamble copied from the top of the file (containing \\documentstyle, etc.), running SliTeX under a special subshell. \\[tex-buffer] does the whole buffer. \\[tex-file] saves the buffer and then processes the file. \\[tex-print] prints the .dvi file made by any of these. \\[tex-view] previews the .dvi file made by any of these. \\[tex-bibtex-file] runs bibtex on the file of the current buffer. Use \\[validate-tex-buffer] to check buffer for paragraphs containing mismatched $'s or braces. Special commands: \\{tex-mode-map} Mode variables: slitex-run-command Command string used by \\[tex-region] or \\[tex-buffer]. tex-directory Directory in which to create temporary files for SliTeX jobs run by \\[tex-region] or \\[tex-buffer]. tex-dvi-print-command Command string used by \\[tex-print] to print a .dvi file. tex-alt-dvi-print-command Alternative command string used by \\[tex-print] (when given a prefix argument) to print a .dvi file. tex-dvi-view-command Command string used by \\[tex-view] to preview a .dvi file. tex-show-queue-command Command string used by \\[tex-show-print-queue] to show the print queue that \\[tex-print] put your job on. Entering SliTeX mode runs the hook `text-mode-hook', then the hook `tex-mode-hook', then the hook `latex-mode-hook', and finally the hook `slitex-mode-hook'. When the special subshell is initiated, the hook `tex-shell-hook' is run." t nil) (autoload (quote tex-start-shell) "tex-mode" nil nil nil) ;;;*** ;;;### (autoloads (texinfo-format-region texinfo-format-buffer) "texinfmt" "texinfmt.el" (12437 2800)) ;;; Generated autoloads from texinfmt.el (autoload (quote texinfo-format-buffer) "texinfmt" "\ Process the current buffer as texinfo code, into an Info file. The Info file output is generated in a buffer visiting the Info file names specified in the @setfilename command. Non-nil argument (prefix, if interactive) means don't make tag table and don't split the file if large. You can use Info-tagify and Info-split to do these manually." t nil) (autoload (quote texinfo-format-region) "texinfmt" "\ Convert the current region of the Texinfo file to Info format. This lets you see what that part of the file will look like in Info. The command is bound to \\[texinfo-format-region]. The text that is converted to Info is stored in a temporary buffer." t nil) ;;;*** ;;;### (autoloads (texinfo-mode) "texinfo" "texinfo.el" (12437 2860)) ;;; Generated autoloads from texinfo.el (autoload (quote texinfo-mode) "texinfo" "\ Major mode for editing Texinfo files. It has these extra commands: \\{texinfo-mode-map} 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. Editing commands are like text-mode except that the syntax table is 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]. This command shows the structure of a Texinfo file by listing the lines with the @-sign commands for @chapter, @section, and the like. These lines are displayed in another window called the *Occur* window. In that window, you can position the cursor over one of the lines and use \\[occur-mode-goto-occurrence], to jump to the corresponding spot in the Texinfo file. In addition, Texinfo mode provides commands that insert various frequently used @-sign commands into the buffer. You can use these commands to save keystrokes. And you can insert balanced braces with \\[texinfo-insert-braces] and later use the command \\[up-list] to move forward past the closing brace. Also, Texinfo mode provides functions for automatically creating or updating menus and node pointers. These functions * insert the `Next', `Previous' and `Up' pointers of a node, * insert or update the menu for a section, and * create a master menu for a Texinfo source file. Here are the functions: texinfo-update-node \\[texinfo-update-node] texinfo-every-node-update \\[texinfo-every-node-update] texinfo-sequential-node-update texinfo-make-menu \\[texinfo-make-menu] texinfo-all-menus-update \\[texinfo-all-menus-update] texinfo-master-menu texinfo-indent-menu-description (column &optional region-p) The `texinfo-column-for-description' variable specifies the column to which menu descriptions are indented. Passed an argument (a prefix argument, if interactive), the `texinfo-update-node' and `texinfo-make-menu' functions do their jobs in the region. To use the updating commands, you must structure your Texinfo file hierarchically, such that each `@node' line, with the exception of the Top node, is accompanied by some kind of section line, such as an `@chapter' or `@section' line. If the file has a `top' node, it must be called `top' or `Top' and be the first node in the file. Entering Texinfo mode calls the value of text-mode-hook, and then the value of texinfo-mode-hook." t nil) ;;;*** ;;;### (autoloads (texinfo-sequential-node-update texinfo-every-node-update texinfo-update-node) "texnfo-upd" "texnfo-upd.el" (12437 19984)) ;;; Generated autoloads from texnfo-upd.el (autoload (quote texinfo-update-node) "texnfo-upd" "\ Without any prefix argument, update the node in which point is located. Non-nil argument (prefix, if interactive) means update the nodes in the marked region. The functions for creating or updating nodes and menus, and their keybindings, are: texinfo-update-node (&optional region-p) \\[texinfo-update-node] texinfo-every-node-update () \\[texinfo-every-node-update] texinfo-sequential-node-update (&optional region-p) texinfo-make-menu (&optional region-p) \\[texinfo-make-menu] texinfo-all-menus-update () \\[texinfo-all-menus-update] texinfo-master-menu () texinfo-indent-menu-description (column &optional region-p) The `texinfo-column-for-description' variable specifies the column to which menu descriptions are indented. Its default value is 32." t nil) (autoload (quote texinfo-every-node-update) "texnfo-upd" "\ Update every node in a Texinfo file." t nil) (autoload (quote texinfo-sequential-node-update) "texnfo-upd" "\ Update one node (or many) in a Texinfo file with sequential pointers. This function causes the `Next' or `Previous' pointer to point to the immediately preceding or following node, even if it is at a higher or lower hierarchical level in the document. Continually pressing `n' or `p' takes you straight through the file. Without any prefix argument, update the node in which point is located. Non-nil argument (prefix, if interactive) means update the nodes in the marked region. This command makes it awkward to navigate among sections and subsections; it should be used only for those documents that are meant to be read like a novel rather than a reference, and for which the Info `g*' command is inadequate." t nil) ;;;*** ;;;### (autoloads (thing-at-point bounds-of-thing-at-point forward-thing) "thingatpt" "thingatpt.el" (12300 10535)) ;;; Generated autoloads from thingatpt.el (autoload (quote forward-thing) "thingatpt" "\ Move forward to the end of the next THING." nil nil) (autoload (quote bounds-of-thing-at-point) "thingatpt" "\ Determine the start and end buffer locations for the THING at point, where THING is an entity for which there is a either a corresponding forward-THING operation, or corresponding beginning-of-THING and end-of-THING operations, eg. 'word, 'sentence, 'defun. Return a cons cell '(start . end) giving the start and end positions." nil nil) (autoload (quote thing-at-point) "thingatpt" "\ Return the THING at point, where THING is an entity defined by bounds-of-thing-at-point." nil nil) ;;;*** ;;;### (autoloads (display-time) "time" "time.el" (12433 21239)) ;;; Generated autoloads from time.el (defvar display-time-day-and-date nil "\ *Non-nil means \\[display-time] should display day and date as well as time.") (autoload (quote display-time) "time" "\ Display current time, load level, and mail flag in mode line of each buffer. Updates automatically every minute. If `display-time-day-and-date' is non-nil, the current day and date are displayed as well. After each update, `display-time-hook' is run with `run-hooks'." t nil) ;;;*** ;;;### (autoloads (time-stamp-toggle-active time-stamp) "time-stamp" "time-stamp.el" (12437 26449)) ;;; Generated autoloads from time-stamp.el (autoload (quote time-stamp) "time-stamp" "\ Update the time stamp string in the buffer. If you put a time stamp template anywhere in the first 8 lines of a file, it can be updated every time you save the file. See the top of `time-stamp.el' for a sample. The template looks like one of the following: Time-stamp: <> Time-stamp: \" \" The time stamp is written between the brackets or quotes, resulting in Time-stamp: <95/01/18 10:20:51 gildea> Only does its thing if the variable time-stamp-active is non-nil. Typically used on write-file-hooks for automatic time-stamping. The format of the time stamp is determined by the variable time-stamp-format. The variables time-stamp-line-limit, time-stamp-start, and time-stamp-end control finding the template." t nil) (autoload (quote time-stamp-toggle-active) "time-stamp" "\ Toggle time-stamp-active, setting whether \\[time-stamp] updates a buffer. With arg, turn time stamping on if and only if arg is positive." t nil) ;;;*** ;;;### (autoloads (run-at-time) "timer" "timer.el" (11985 30147)) ;;; Generated autoloads from timer.el (autoload (quote run-at-time) "timer" "\ Run a function at a time, and optionally on a regular interval. Arguments are TIME, REPEAT, FUNCTION &rest ARGS. TIME, a string, can be specified absolutely or relative to now. TIME can also be an integer, a number of seconds. REPEAT, an integer number of seconds, is the interval on which to repeat the call to the function. If REPEAT is nil or 0, call it just once. Absolute times may be specified in a wide variety of formats; Something of the form `HOUR:MIN:SEC TIMEZONE MONTH/DAY/YEAR', where all fields are numbers, works; the format used by the Unix `date' command works too. Relative times may be specified as a series of numbers followed by units: 1 min denotes one minute from now. min does too. 1 min 5 sec denotes 65 seconds from now. 1 min 2 sec 3 hour 4 day 5 week 6 fortnight 7 month 8 year denotes the sum of all the given durations from now." t nil) ;;;*** ;;;### (autoloads (tmm-prompt tmm-menubar) "tmm" "tmm.el" (12452 8515)) ;;; Generated autoloads from tmm.el (define-key global-map "\M-`" 'tmm-menubar) (define-key global-map [f10] 'tmm-menubar) (define-key global-map [menu-bar mouse-1] 'tmm-menubar) (autoload (quote tmm-menubar) "tmm" "\ Text-mode emulation of looking and choosing from a menubar. See the documentation for `tmm-prompt'." t nil) (autoload (quote tmm-prompt) "tmm" "\ Text-mode emulation of calling the bindings in keymap. Creates a text-mode menu of possible choices. You can access the elements in the menu: *) Either via history mechanism from minibuffer; *) Or via completion-buffer that is automatically shown. The last alternative is currently a hack, you cannot use mouse reliably. If the optional argument IN-POPUP is set, is argument-compatible with `x-popup-menu', otherwise the argument BIND should be a cdr of sparse keymap." nil nil) ;;;*** ;;;### (autoloads (tpu-edt-on) "tpu-edt" "tpu-edt.el" (12440 19294)) ;;; Generated autoloads from tpu-edt.el (fset (quote tpu-edt-mode) (quote tpu-edt-on)) (fset (quote tpu-edt) (quote tpu-edt-on)) (autoload (quote tpu-edt-on) "tpu-edt" "\ Turn on TPU/edt emulation." t nil) ;;;*** ;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins) "tpu-extras" "tpu-extras.el" (12311 16501)) ;;; Generated autoloads from tpu-extras.el (autoload (quote tpu-set-scroll-margins) "tpu-extras" "\ Set scroll margins." t nil) (autoload (quote tpu-set-cursor-free) "tpu-extras" "\ Allow the cursor to move freely about the screen." t nil) (autoload (quote tpu-set-cursor-bound) "tpu-extras" "\ Constrain the cursor to the flow of the text." t nil) ;;;*** ;;;### (autoloads (tq-create) "tq" "tq.el" (12215 52362)) ;;; Generated autoloads from tq.el (autoload (quote tq-create) "tq" "\ Create and return a transaction queue communicating with PROCESS. PROCESS should be a subprocess capable of sending and receiving streams of bytes. It may be a local process, or it may be connected to a tcp server on another machine." nil nil) ;;;*** ;;;### (autoloads (trace-function-background trace-function) "trace" "trace.el" (12201 32675)) ;;; Generated autoloads from trace.el (defvar trace-buffer "*trace-output*" "\ *Trace output will by default go to that buffer.") (autoload (quote trace-function) "trace" "\ Traces FUNCTION with trace output going to BUFFER. For every call of FUNCTION Lisp-style trace messages that display argument and return values will be inserted into BUFFER. This function generates the trace advice for FUNCTION and activates it together with any other advice there might be!! The trace BUFFER will popup whenever FUNCTION is called. Do not use this to trace functions that switch buffers or do any other display oriented stuff, use `trace-function-background' instead." t nil) (autoload (quote trace-function-background) "trace" "\ Traces FUNCTION with trace output going quietly to BUFFER. For every call of FUNCTION Lisp-style trace messages that display argument and return values will be inserted into BUFFER. This function generates the trace advice for FUNCTION and activates it together with any other advice there might be!! Trace output will quietly go to BUFFER without changing the window or buffer configuration at all." t nil) ;;;*** ;;;### (autoloads (2C-split 2C-associate-buffer 2C-two-columns) "two-column" "two-column.el" (12441 34577)) ;;; Generated autoloads from two-column.el (autoload '2C-command "two-column" () t 'keymap) (global-set-key "6" (quote 2C-command)) (global-set-key [f2] (quote 2C-command)) (autoload (quote 2C-two-columns) "two-column" "\ Split current window vertically for two-column editing. When called the first time, associates a buffer with the current buffer in two-column minor mode (see \\[describe-mode] ). Runs `2C-other-buffer-hook' in the new buffer. When called again, restores the screen layout with the current buffer first and the associated buffer to it's right." t nil) (autoload (quote 2C-associate-buffer) "two-column" "\ Associate another buffer with this one in two-column minor mode. Can also be used to associate a just previously visited file, by accepting the proposed default buffer. \(See \\[describe-mode] .)" t nil) (autoload (quote 2C-split) "two-column" "\ Split a two-column text at point, into two buffers in two-column minor mode. Point becomes the local value of `2C-window-width'. Only lines that have the ARG same preceding characters at that column get split. The ARG preceding characters without any leading whitespace become the local value for `2C-separator'. This way lines that continue across both columns remain untouched in the first buffer. This function can be used with a prototype line, to set up things. You write the first line of each column and then split that line. E.g.: First column's text sSs Second column's text \\___/\\ / \\ 5 character Separator You type M-5 \\[2C-split] with the point here. \(See \\[describe-mode] .)" t nil) ;;;*** ;;;### (autoloads (type-break-guestimate-keystroke-threshold type-break-statistics type-break type-break-mode) "type-break" "type-break.el" (12003 12693)) ;;; Generated autoloads from type-break.el (defvar type-break-mode nil "\ *Non-`nil' means typing break mode is enabled. See the docstring for the `type-break-mode' command for more information.") (defvar type-break-interval (* 60 60) "\ *Number of seconds between scheduled typing breaks.") (defvar type-break-good-rest-interval (/ type-break-interval 6) "\ *Number of seconds of idle time considered to be an adequate typing rest. When this variable is non-`nil', emacs checks the idle time between keystrokes. If this idle time is long enough to be considered a \"good\" rest from typing, then the next typing break is simply rescheduled for later. If a break is interrupted before this much time elapses, the user will be asked whether or not really to interrupt the break.") (defvar type-break-keystroke-threshold (let* ((wpm 35) (avg-word-length 5) (upper (* wpm avg-word-length (/ type-break-interval 60))) (lower (/ upper 5))) (cons lower upper)) "\ *Upper and lower bound on number of keystrokes for considering typing break. This structure is a pair of numbers. The first number is the minimum number of keystrokes that must have been entered since the last typing break before considering another one, even if the scheduled time has elapsed; the break is simply rescheduled until later if the minimum threshold hasn't been reached. If this first value is nil, then there is no minimum threshold; as soon as the scheduled time has elapsed, the user will always be queried. The second number is the maximum number of keystrokes that can be entered before a typing break is requested immediately, pre-empting the originally scheduled break. If this second value is nil, then no pre-emptive breaks will occur; only scheduled ones will. Keys with bucky bits (shift, control, meta, etc) are counted as only one keystroke even though they really require multiple keys to generate them. The command `type-break-guestimate-keystroke-threshold' can be used to guess a reasonably good pair of values for this variable.") (autoload (quote type-break-mode) "type-break" "\ Enable or disable typing-break mode. This is a minor mode, but it is global to all buffers by default. When this mode is enabled, the user is encouraged to take typing breaks at appropriate intervals; either after a specified amount of time or when the user has exceeded a keystroke threshold. When the time arrives, the user is asked to take a break. If the user refuses at that time, emacs will ask again in a short period of time. The idea is to give the user enough time to find a good breaking point in his or her work, but be sufficiently annoying to discourage putting typing breaks off indefinitely. A negative prefix argument disables this mode. No argument or any non-negative argument enables it. The user may enable or disable this mode by setting the variable of the same name, though setting it in that way doesn't reschedule a break or reset the keystroke counter. If the mode was previously disabled and is enabled as a consequence of calling this function, it schedules a break with `type-break-schedule' to make sure one occurs (the user can call that command to reschedule the break at any time). It also initializes the keystroke counter. The variable `type-break-interval' specifies the number of seconds to schedule between regular typing breaks. This variable doesn't directly affect the time schedule; it simply provides a default for the `type-break-schedule' command. If set, the variable `type-break-good-rest-interval' specifies the minimum amount of time which is considered a reasonable typing break. Whenever that time has elapsed, typing breaks are automatically rescheduled for later even if emacs didn't prompt you to take one first. Also, if a break is ended before this much time has elapsed, the user will be asked whether or not to continue. The variable `type-break-keystroke-threshold' is used to determine the thresholds at which typing breaks should be considered. You can use the command `type-break-guestimate-keystroke-threshold' to try to approximate good values for this. There are several variables that affect how or when warning messages about imminent typing breaks are displayed. They include: type-break-warning-message-mode type-break-time-warning-intervals type-break-keystroke-warning-intervals type-break-warning-repeat type-break-warning-countdown-string type-break-warning-countdown-string-type There are several variables that affect how and when queries to begin a typing break occur. They include: type-break-query-function type-break-query-interval Finally, the command `type-break-statistics' prints interesting things." t nil) (autoload (quote type-break) "type-break" "\ Take a typing break. During the break, a demo selected from the functions listed in `type-break-demo-functions' is run. After the typing break is finished, the next break is scheduled as per the function `type-break-schedule'." t nil) (autoload (quote type-break-statistics) "type-break" "\ Print statistics about typing breaks in a temporary buffer. This includes the last time a typing break was taken, when the next one is scheduled, the keystroke thresholds and the current keystroke count, etc." t nil) (autoload (quote type-break-guestimate-keystroke-threshold) "type-break" "\ Guess values for the minimum/maximum keystroke threshold for typing breaks. If called interactively, the user is prompted for their guess as to how many words per minute they usually type. This value should not be your maximum WPM, but your average. Of course, this is harder to gauge since it can vary considerably depending on what you are doing. For example, one tends actually to type less when debugging a program, as opposed to writing documentation. (Perhaps a separate program should be written to estimate average typing speed.) From that, this command sets the values in `type-break-keystroke-threshold' based on a fairly simple algorithm involving assumptions about the average length of words (5). For the minimum threshold, it uses about a fifth of the computed maximum threshold. When called from lisp programs, the optional args WORDLEN and FRAC can be used to override the default assumption about average word length and the fraction of the maximum threshold to which to set the minimum threshold. FRAC should be the inverse of the fractional value; for example, a value of 2 would mean to use one half, a value of 4 would mean to use one quarter, etc." t nil) ;;;*** ;;;### (autoloads (ununderline-region underline-region) "underline" "underline.el" (11652 54624)) ;;; Generated autoloads from underline.el (autoload (quote underline-region) "underline" "\ Underline all nonblank characters in the region. Works by overstriking underscores. Called from program, takes two arguments START and END which specify the range to operate on." t nil) (autoload (quote ununderline-region) "underline" "\ Remove all underlining (overstruck underscores) in the region. Called from program, takes two arguments START and END which specify the range to operate on." t nil) ;;;*** ;;;### (autoloads (unrmail batch-unrmail) "unrmail" "unrmail.el" (12402 45362)) ;;; Generated autoloads from unrmail.el (autoload (quote batch-unrmail) "unrmail" "\ Convert Rmail files to system inbox format. Specify the input Rmail file names as command line arguments. For each Rmail file, the corresponding output file name is made by adding `.mail' at the end. For example, invoke `emacs -batch -f batch-unrmail RMAIL'." nil nil) (autoload (quote unrmail) "unrmail" "\ Convert Rmail file FILE to system inbox format file TO-FILE." t nil) ;;;*** ;;;### (autoloads (ask-to-update-copyright update-copyright) "copyright" "copyright.el" (12065 4870)) ;;; Generated autoloads from copyright.el (defvar replace-copying-with nil "\ *If non-nil, replace copying notices with this file.") (autoload (quote update-copyright) "copyright" "\ Update the copyright notice at the beginning of the buffer to indicate the current year. If optional arg REPLACE is given \(interactively, with prefix arg) replace the years in the notice rather than adding the current year after them. If `replace-copying-with' is set, the copying permissions following the copyright are replaced as well. If optional third argument ASK is non-nil, the user is prompted for whether or not to update the copyright. If optional fourth argument ASK-YEAR is non-nil, the user is prompted for whether or not to replace the year rather than adding to it." t nil) (autoload (quote ask-to-update-copyright) "copyright" "\ If the current buffer contains a copyright notice that is out of date, ask the user if it should be updated with `update-copyright' (which see). Put this on write-file-hooks." nil nil) ;;;*** ;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock) "userlock" "userlock.el" (11968 23424)) ;;; Generated autoloads from userlock.el (autoload (quote ask-user-about-lock) "userlock" "\ Ask user what to do when he wants to edit FILE but it is locked by USER. This function has a choice of three things to do: do (signal 'buffer-file-locked (list FILE USER)) to refrain from editing the file return t (grab the lock on the file) return nil (edit the file even though it is locked). You can rewrite it to use any criterion you like to choose which one to do." nil nil) (autoload (quote ask-user-about-supersession-threat) "userlock" "\ Ask a user who is about to modify an obsolete buffer what to do. This function has two choices: it can return, in which case the modification of the buffer will proceed, or it can (signal 'file-supersession (file)), in which case the proposed buffer modification will not be made. You can rewrite this to use any criterion you like to choose which one to do. The buffer in question is current when this function is called." nil nil) ;;;*** ;;;### (autoloads (vc-update-change-log vc-rename-file vc-cancel-version vc-revert-buffer vc-print-log vc-retrieve-snapshot vc-create-snapshot vc-directory vc-insert-headers vc-version-other-window vc-diff vc-register vc-next-action) "vc" "vc.el" (12440 36668)) ;;; Generated autoloads from vc.el (defvar vc-checkin-hook nil "\ *List of functions called after a checkin is done. See `run-hooks'.") (autoload (quote vc-next-action) "vc" "\ Do the next logical checkin or checkout operation on the current file. If you call this from within a VC dired buffer with no files marked, it will operate on the file in the current line. If you call this from within a VC dired buffer, and one or more files are marked, it will accept a log message and then operate on each one. The log message will be used as a comment for any register or checkin operations, but ignored when doing checkouts. Attempted lock steals will raise an error. A prefix argument lets you specify the version number to use. For RCS and SCCS files: If the file is not already registered, this registers it for version control and then retrieves a writable, locked copy for editing. If the file is registered and not locked by anyone, this checks out a writable and locked file ready for editing. If the file is checked out and locked by the calling user, this first checks to see if the file has changed since checkout. If not, it performs a revert. If the file has been changed, this pops up a buffer for entry of a log message; when the message has been entered, it checks in the resulting changes along with the log message as change commentary. If the variable `vc-keep-workfiles' is non-nil (which is its default), a read-only copy of the changed file is left in place afterwards. If the file is registered and locked by someone else, you are given the option to steal the lock. For CVS files: If the file is not already registered, this registers it for version control. This does a \"cvs add\", but no \"cvs commit\". If the file is added but not committed, it is committed. If your working file is changed, but the repository file is unchanged, this pops up a buffer for entry of a log message; when the message has been entered, it checks in the resulting changes along with the logmessage as change commentary. A writable file is retained. If the repository file is changed, you are asked if you want to merge in the changes into your working copy." t nil) (autoload (quote vc-register) "vc" "\ Register the current file into your version-control system." t nil) (autoload (quote vc-diff) "vc" "\ Display diffs between file versions. Normally this compares the current file and buffer with the most recent checked in version of that file. This uses no arguments. With a prefix argument, it reads the file name to use and two version designators specifying which versions to compare." t nil) (autoload (quote vc-version-other-window) "vc" "\ Visit version REV of the current buffer in another window. If the current buffer is named `F', the version is named `F.~REV~'. If `F.~REV~' already exists, it is used instead of being re-created." t nil) (autoload (quote vc-insert-headers) "vc" "\ Insert headers in a file for use with your version-control system. Headers desired are inserted at the start of the buffer, and are pulled from the variable `vc-header-alist'." t nil) (autoload (quote vc-directory) "vc" "\ Show version-control status of the current directory and subdirectories. Normally it creates a Dired buffer that lists only the locked files in all these directories. With a prefix argument, it lists all files." t nil) (autoload (quote vc-create-snapshot) "vc" "\ Make a snapshot called NAME. The snapshot is made from all registered files at or below the current directory. For each file, the version level of its latest version becomes part of the named configuration." t nil) (autoload (quote vc-retrieve-snapshot) "vc" "\ Retrieve the snapshot called NAME. This function fails if any files are locked at or below the current directory Otherwise, all registered files are checked out (unlocked) at their version levels in the snapshot." t nil) (autoload (quote vc-print-log) "vc" "\ List the change log of the current buffer in a window." t nil) (autoload (quote vc-revert-buffer) "vc" "\ Revert the current buffer's file back to the latest checked-in version. This asks for confirmation if the buffer contents are not identical to that version. If the back-end is CVS, this will give you the most recent revision of the file on the branch you are editing." t nil) (autoload (quote vc-cancel-version) "vc" "\ Get rid of most recently checked in version of this file. A prefix argument means do not revert the buffer afterwards." t nil) (autoload (quote vc-rename-file) "vc" "\ Rename file OLD to NEW, and rename its master file likewise." t nil) (autoload (quote vc-update-change-log) "vc" "\ Find change log file and add entries from recent RCS logs. The mark is left at the end of the text prepended to the change log. 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) ;;;*** ;;;### (autoloads (vi-mode) "vi" "vi.el" (12317 15023)) ;;; Generated autoloads from vi.el (autoload (quote vi-mode) "vi" "\ Major mode that acts like the `vi' editor. The purpose of this mode is to provide you the combined power of vi (namely, the \"cross product\" effect of commands and repeat last changes) and Emacs. This command redefines nearly all keys to look like vi commands. It records the previous major mode, and any vi command for input \(`i', `a', `s', etc.) switches back to that mode. Thus, ordinary Emacs (in whatever major mode you had been using) is \"input\" mode as far as vi is concerned. To get back into vi from \"input\" mode, you must issue this command again. Therefore, it is recommended that you assign it to a key. Major differences between this mode and real vi : * Limitations and unsupported features - Search patterns with line offset (e.g. /pat/+3 or /pat/z.) are not supported. - Ex commands are not implemented; try ':' to get some hints. - No line undo (i.e. the 'U' command), but multi-undo is a standard feature. * Modifications - The stopping positions for some point motion commands (word boundary, pattern search) are slightly different from standard 'vi'. Also, no automatic wrap around at end of buffer for pattern searching. - Since changes are done in two steps (deletion then insertion), you need to undo twice to completely undo a change command. But this is not needed for undoing a repeated change command. - No need to set/unset 'magic', to search for a string with regular expr in it just put a prefix arg for the search commands. Replace cmds too. - ^R is bound to incremental backward search, so use ^L to redraw screen. * Extensions - Some standard (or modified) Emacs commands were integrated, such as incremental search, query replace, transpose objects, and keyboard macros. - In command state, ^X links to the 'ctl-x-map', and ESC can be linked to esc-map or set undefined. These can give you the full power of Emacs. - See vi-com-map for those keys that are extensions to standard vi, e.g. `vi-name-last-change-or-macro', `vi-verify-spelling', `vi-locate-def', `vi-mark-region', and 'vi-quote-words'. Some of them are quite handy. - Use \\[vi-switch-mode] to switch among different modes quickly. Syntax table and abbrevs while in vi mode remain as they were in Emacs." t nil) ;;;*** ;;;### (autoloads (view-mode view-buffer-other-window view-buffer view-file-other-window view-file) "view" "view.el" (12409 31604)) ;;; Generated autoloads from view.el (defvar view-highlight-face (quote highlight) "\ *The overlay face used for highlighting the match found by View mode search.") (autoload (quote view-file) "view" "\ View FILE in View mode, returning to previous buffer when done. 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. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-mode-hook'." t nil) (autoload (quote view-file-other-window) "view" "\ View FILE in View mode in other window. Return to previous buffer when done. 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. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-mode-hook'." t nil) (autoload (quote view-buffer) "view" "\ View BUFFER in View mode, returning to previous buffer when done. 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. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-mode-hook'." t nil) (autoload (quote view-buffer-other-window) "view" "\ View BUFFER in View mode in another window. Return to previous buffer when done, unless NOT-RETURN is non-nil. 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. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-mode-hook'." t nil) (autoload (quote view-mode) "view" "\ Toggle View mode. If you use this function to turn on View mode, \"exiting\" View mode does nothing except turn View mode off. The other way to turn View mode on is by calling `view-mode-enter'." t nil) ;;;*** ;;;### (autoloads (vip-mode) "vip" "vip.el" (12264 64333)) ;;; Generated autoloads from vip.el (autoload (quote vip-mode) "vip" "\ Turn on VIP emulation of VI." t nil) ;;;*** ;;;### (autoloads (viper-mode) "viper" "viper.el" (12437 3256)) ;;; Generated autoloads from viper.el (autoload (quote viper-mode) "viper" "\ Turn on Viper emulation of Vi." t nil) (defalias (quote vip-mode) (quote viper-mode)) ;;;*** ;;;### (autoloads (wordstar-mode) "ws-mode" "ws-mode.el" (12351 35378)) ;;; Generated autoloads from ws-mode.el (autoload (quote wordstar-mode) "ws-mode" "\ Major mode with WordStar-like key bindings. BUGS: - Help menus with WordStar commands (C-j just calls help-for-help) are not implemented - Options for search and replace - Show markers (C-k h) is somewhat strange - Search and replace (C-q a) is only available in forward direction No key bindings beginning with ESC are installed, they will work Emacs-like. The key bindings are: C-a backward-word C-b fill-paragraph C-c scroll-up-line C-d forward-char C-e previous-line C-f forward-word C-g delete-char C-h backward-char C-i indent-for-tab-command C-j help-for-help C-k ordstar-C-k-map C-l ws-repeat-search C-n open-line C-p quoted-insert C-r scroll-down-line C-s backward-char C-t kill-word C-u keyboard-quit C-v overwrite-mode C-w scroll-down C-x next-line C-y kill-complete-line C-z scroll-up C-k 0 ws-set-marker-0 C-k 1 ws-set-marker-1 C-k 2 ws-set-marker-2 C-k 3 ws-set-marker-3 C-k 4 ws-set-marker-4 C-k 5 ws-set-marker-5 C-k 6 ws-set-marker-6 C-k 7 ws-set-marker-7 C-k 8 ws-set-marker-8 C-k 9 ws-set-marker-9 C-k b ws-begin-block C-k c ws-copy-block C-k d save-buffers-kill-emacs C-k f find-file C-k h ws-show-markers C-k i ws-indent-block C-k k ws-end-block C-k p ws-print-block C-k q kill-emacs C-k r insert-file C-k s save-some-buffers C-k t ws-mark-word C-k u ws-exdent-block C-k C-u keyboard-quit C-k v ws-move-block C-k w ws-write-block C-k x kill-emacs C-k y ws-delete-block C-o c wordstar-center-line C-o b switch-to-buffer C-o j justify-current-line C-o k kill-buffer C-o l list-buffers C-o m auto-fill-mode C-o r set-fill-column C-o C-u keyboard-quit C-o wd delete-other-windows C-o wh split-window-horizontally C-o wo other-window C-o wv split-window-vertically C-q 0 ws-find-marker-0 C-q 1 ws-find-marker-1 C-q 2 ws-find-marker-2 C-q 3 ws-find-marker-3 C-q 4 ws-find-marker-4 C-q 5 ws-find-marker-5 C-q 6 ws-find-marker-6 C-q 7 ws-find-marker-7 C-q 8 ws-find-marker-8 C-q 9 ws-find-marker-9 C-q a ws-query-replace C-q b ws-to-block-begin C-q c end-of-buffer C-q d end-of-line C-q f ws-search C-q k ws-to-block-end C-q l ws-undo C-q p ws-last-cursorp C-q r beginning-of-buffer C-q C-u keyboard-quit C-q w ws-last-error C-q y ws-kill-eol C-q DEL ws-kill-bol " t nil) ;;;*** ;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (12409 22243)) ;;; Generated autoloads from xt-mouse.el (autoload (quote xterm-mouse-mode) "xt-mouse" "\ Toggle XTerm mouse mode. With prefix arg, turn XTerm mouse mode on iff arg is positive. Turn it on to use emacs mouse commands, and off to use xterm mouse commands." t nil) ;;;*** ;;;### (autoloads (psychoanalyze-pinhead insert-zippyism yow) "yow" "yow.el" (11968 23503)) ;;; Generated autoloads from yow.el (autoload (quote yow) "yow" "\ Return or display a random Zippy quotation. With prefix arg, insert it." t nil) (autoload (quote insert-zippyism) "yow" "\ Prompt with completion for a known Zippy quotation, and insert it at point." t nil) (autoload (quote psychoanalyze-pinhead) "yow" "\ Zippy goes to the analyst." t nil) ;;;*** ;;; Don't make backup versions of this file - most of it is generated ;;; automatically by autoload.el, and what isn't changes rarely. ;;; Local Variables: ;;; version-control: never ;;; no-byte-compile: t ;;; no-update-autoloads: t ;;; End: ;;; loaddefs.el ends here emacs-19.30/lisp/loadhist.el100444 12120 1 11015 6006660017 14217 0ustar rmsdaemon;;; loadhist.el --- lisp functions for working with feature groups ;;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Version: 1.0 ;; Keywords: internal ;; 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: ;; These functions exploit the load-history system variable. ;; Entry points include `unload-feature', `symbol-file', and `feature-file'. ;;; Code: (defun symbol-file (sym) "Return the input source from which SYM was loaded. This is a file name, or nil if the source was a buffer with no associated file." (catch 'foundit (mapcar (function (lambda (x) (if (memq sym (cdr x)) (throw 'foundit (car x))))) load-history) nil)) (defun feature-symbols (feature) "Return the file and list of symbols associated with a given FEATURE." (catch 'foundit (mapcar (function (lambda (x) (if (member (cons 'provide feature) (cdr x)) (throw 'foundit x)))) load-history) nil)) (defun feature-file (feature) "Return the file name from which a given FEATURE was loaded. Actually, return the load argument, if any; this is sometimes the name of a Lisp file without an extension. If the feature came from an eval-buffer on a buffer with no associated file, or an eval-region, return nil." (if (not (featurep feature)) (error "%s is not a currently loaded feature" (symbol-name feature)) (car (feature-symbols feature)))) (defun file-provides (file) "Return the list of features provided by FILE." (let ((symbols (cdr (assoc file load-history))) (provides nil)) (mapcar (function (lambda (x) (if (and (consp x) (eq (car x) 'provide)) (setq provides (cons (cdr x) provides))))) symbols) provides )) (defun file-requires (file) "Return the list of features required by FILE." (let ((symbols (cdr (assoc file load-history))) (requires nil)) (mapcar (function (lambda (x) (if (and (consp x) (eq (car x) 'require)) (setq requires (cons (cdr x) requires))))) symbols) requires )) (defun file-set-intersect (p q) ;; Return the set intersection of two lists (let ((ret nil)) (mapcar (function (lambda (x) (if (memq x q) (setq ret (cons x ret))))) p) ret )) (defun file-dependents (file) "Return the list of loaded libraries that depend on FILE. This can include FILE itself." (let ((provides (file-provides file)) (dependents nil)) (mapcar (function (lambda (x) (if (file-set-intersect provides (file-requires (car x))) (setq dependents (cons (car x) dependents))))) load-history) dependents )) ;;;###autoload (defun unload-feature (feature &optional force) "Unload the library that provided FEATURE, restoring all its autoloads. If the feature is required by any other loaded code, and optional FORCE is nil, raise an error." (interactive "SFeature: ") (if (not (featurep feature)) (error "%s is not a currently loaded feature" (symbol-name feature))) (if (not force) (let* ((file (feature-file feature)) (dependents (delete file (copy-sequence (file-dependents file))))) (if dependents (error "Loaded libraries %s depend on %s" (prin1-to-string dependents) file) ))) (let* ((flist (feature-symbols feature)) (file (car flist))) (mapcar (function (lambda (x) (cond ((stringp x) nil) ((consp x) ;; Remove any feature names that this file provided. (if (eq (car x) 'provide) (setq features (delq (cdr x) features)))) ((boundp x) (makunbound x)) ((fboundp x) (fmakunbound x) (let ((aload (get x 'autoload))) (if aload (fset x (cons 'autoload aload)))))))) (cdr flist)) ;; Delete the load-history element for this file. (let ((elt (assoc file load-history))) (setq load-history (delq elt load-history))))) (provide 'loadhist) ;;; loadhist.el ends here emacs-19.30/lisp/loadup.el100444 12120 1 17032 6045506767 13717 0ustar rmsdaemon;;; loadup.el --- load up standardly loaded Lisp files for Emacs. ;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal ;; 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 is loaded into a bare Emacs to make a dumpable one. ;;; Code: (message "Using load-path %s" load-path) ;;; We don't want to have any undo records in the dumped Emacs. (buffer-disable-undo "*scratch*") (load "subr") ;; We specify .el in case someone compiled version.el by mistake. (load "version.el") (garbage-collect) (load "byte-run") (garbage-collect) (load "map-ynp") (garbage-collect) (load "loaddefs.el") ;Don't get confused if someone compiled loaddefs by mistake. (garbage-collect) (load "simple") (garbage-collect) (load "help") (garbage-collect) (load "files") (garbage-collect) (load "format") (garbage-collect) (load "indent") (garbage-collect) (load "isearch") (garbage-collect) (load "window") (if (fboundp 'delete-frame) (progn (garbage-collect) (load "frame"))) (if (fboundp 'frame-face-alist) (progn (garbage-collect) (load "faces") (load "facemenu"))) (if (fboundp 'track-mouse) (progn (garbage-collect) (load "mouse") (garbage-collect) (load "scroll-bar") (load "select"))) (load "menu-bar") (garbage-collect) (load "paths.el") ;Don't get confused if someone compiled paths by mistake. (garbage-collect) (load "startup") (garbage-collect) (load "lisp") (garbage-collect) (load "page") (garbage-collect) (load "register") (garbage-collect) (load "paragraphs") (garbage-collect) (load "lisp-mode") (garbage-collect) (load "text-mode") (garbage-collect) (load "fill") (garbage-collect) (load "replace") (if (eq system-type 'vax-vms) (progn (garbage-collect) (load "vmsproc"))) (garbage-collect) (load "abbrev") (garbage-collect) (load "buff-menu") (if (eq system-type 'vax-vms) (progn (garbage-collect) (load "vms-patch"))) (if (eq system-type 'windows-nt) (progn (garbage-collect) (load "ls-lisp") (garbage-collect) (load "winnt") (garbage-collect))) (if (eq system-type 'ms-dos) (progn (load "ls-lisp") (garbage-collect) (load "dos-fns") (garbage-collect) (load "disp-table") ; needed to setup ibm-pc char set, see internal.el (garbage-collect))) (if (fboundp 'atan) ; preload some constants and (progn ; floating pt. functions if (garbage-collect) ; we have float support. (load "float-sup"))) (garbage-collect) (load "vc-hooks") (load "ediff-hook") ;If you want additional libraries to be preloaded and their ;doc strings kept in the DOC file rather than in core, ;you may load them with a "site-load.el" file. ;But you must also cause them to be scanned when the DOC file ;is generated. For VMS, you must edit ../vms/makedoc.com. ;For other systems, you must edit ../src/Makefile.in. (if (load "site-load" t) (garbage-collect)) (if (fboundp 'x-popup-menu) (precompute-menubar-bindings)) ;; Turn on recording of which commands get rebound, ;; for the sake of the next call to precompute-menubar-bindings. (setq define-key-rebound-commands nil) ;; Determine which last version number to use ;; based on the executables that now exist. (if (and (or (equal (nth 3 command-line-args) "dump") (equal (nth 4 command-line-args) "dump")) (not (eq system-type 'ms-dos))) (let* ((base (concat "emacs-" emacs-version ".")) (files (file-name-all-completions base default-directory)) (versions (mapcar (function (lambda (name) (string-to-int (substring name (length base))))) files))) (setq emacs-version (format "%s.%d" emacs-version (if versions (1+ (apply 'max versions)) 1))))) ;; Note: all compiled Lisp files loaded above this point ;; must be among the ones parsed by make-docfile ;; to construct DOC. Any that are not processed ;; for DOC will not have doc strings in the dumped Emacs. (message "Finding pointers to doc strings...") (if (or (equal (nth 3 command-line-args) "dump") (equal (nth 4 command-line-args) "dump")) (let ((name emacs-version)) (while (string-match "[^-+_.a-zA-Z0-9]+" name) (setq name (concat (downcase (substring name 0 (match-beginning 0))) "-" (substring name (match-end 0))))) (if (memq system-type '(ms-dos windows-nt)) (setq name (expand-file-name (if (fboundp 'make-frame) "DOC-X" "DOC") "../etc")) (setq name (concat (expand-file-name "../etc/DOC-") name)) (if (file-exists-p name) (delete-file name)) (copy-file (expand-file-name "../etc/DOC") name t)) (Snarf-documentation (file-name-nondirectory name))) (Snarf-documentation "DOC")) (message "Finding pointers to doc strings...done") ;Note: You can cause additional libraries to be preloaded ;by writing a site-init.el that loads them. ;See also "site-load" above. (load "site-init" t) (setq current-load-list nil) (garbage-collect) ;;; At this point, we're ready to resume undo recording for scratch. (buffer-enable-undo "*scratch*") (if (or (equal (nth 3 command-line-args) "dump") (equal (nth 4 command-line-args) "dump")) (if (eq system-type 'vax-vms) (progn (message "Dumping data as file temacs.dump") (dump-emacs "temacs.dump" "temacs") (kill-emacs)) (let ((name (concat "emacs-" emacs-version))) (while (string-match "[^-+_.a-zA-Z0-9]+" name) (setq name (concat (downcase (substring name 0 (match-beginning 0))) "-" (substring name (match-end 0))))) (if (eq system-type 'ms-dos) (message "Dumping under the name emacs") (message "Dumping under names emacs and %s" name))) (condition-case () (delete-file "emacs") (file-error nil)) ;; We used to dump under the name xemacs, but that occasionally ;; confused people installing Emacs (they'd install the file ;; under the name `xemacs'), and it's inconsistent with every ;; other GNU product's build process. (dump-emacs "emacs" "temacs") (message "%d pure bytes used" pure-bytes-used) ;; Recompute NAME now, so that it isn't set when we dump. (if (not (memq system-type '(ms-dos windows-nt))) (let ((name (concat "emacs-" emacs-version))) (while (string-match "[^-+_.a-zA-Z0-9]+" name) (setq name (concat (downcase (substring name 0 (match-beginning 0))) "-" (substring name (match-end 0))))) (add-name-to-file "emacs" name t))) (kill-emacs))) ;; Avoid error if user loads some more libraries now. (setq purify-flag nil) ;; For machines with CANNOT_DUMP defined in config.h, ;; this file must be loaded each time Emacs is run. ;; So run the startup code now. (or (equal (nth 3 command-line-args) "dump") (equal (nth 4 command-line-args) "dump") (progn ;; Avoid loading loadup.el a second time! (setq command-line-args (cdr (cdr command-line-args))) (eval top-level))) ;;; loadup.el ends here emacs-19.30/lisp/lpr.el100444 75424 1 14145 5756217730 13431 0ustar kwzhdaemon;;; lpr.el --- print Emacs buffer on line printer. ;; Copyright (C) 1985, 1988, 1992, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: unix ;; 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: ;; Commands to send the region or a buffer your printer. Entry points ;; are `lpr-buffer', `print-buffer', lpr-region', or `print-region'; option ;; variables include `lpr-switches' and `lpr-command'. ;;; Code: ;;;###autoload (defvar lpr-switches nil "*List of strings to pass as extra switch args to `lpr' when it is invoked.") (defvar lpr-add-switches (eq system-type 'berkeley-unix) "*Non-nil means construct -T and -J options for the `lpr'.") ;;;###autoload (defvar lpr-command (if (memq system-type '(usg-unix-v dgux hpux irix)) "lp" "lpr") "*Name of program for printing a file.") ;; Default is nil, because that enables us to use pr -f ;; which is more reliable than pr with no args, which is what lpr -p does. (defvar lpr-headers-switches nil "*List of strings to use as options for `lpr' to request page headings. If nil, we run `lpr-page-header-program' to make page headings and print the result.") (defvar print-region-function nil "Function to call to print the region on a printer. See definition of `print-region-1' for calling conventions.") (defvar lpr-page-header-program "pr" "*Name of program for adding page headers to a file.") (defvar lpr-page-header-switches '("-f") "*List of strings to use as options for `lpr-page-header-program'.") ;;;###autoload (defun lpr-buffer () "Print buffer contents as with Unix command `lpr'. `lpr-switches' is a list of extra switches (strings) to pass to lpr." (interactive) (print-region-1 (point-min) (point-max) lpr-switches nil)) ;;;###autoload (defun print-buffer () "Print buffer contents as with Unix command `lpr -p'. `lpr-switches' is a list of extra switches (strings) to pass to lpr." (interactive) (print-region-1 (point-min) (point-max) lpr-switches t)) ;;;###autoload (defun lpr-region (start end) "Print region contents as with Unix command `lpr'. `lpr-switches' is a list of extra switches (strings) to pass to lpr." (interactive "r") (print-region-1 start end lpr-switches nil)) ;;;###autoload (defun print-region (start end) "Print region contents as with Unix command `lpr -p'. `lpr-switches' is a list of extra switches (strings) to pass to lpr." (interactive "r") (print-region-1 start end lpr-switches t)) (defun print-region-1 (start end switches page-headers) ;; On some MIPS system, having a space in the job name ;; crashes the printer demon. But using dashes looks ugly ;; and it seems to annoying to do for that MIPS system. (let ((name (concat (buffer-name) " Emacs buffer")) (title (concat (buffer-name) " Emacs buffer")) (width tab-width) switch-string) (save-excursion (if page-headers (if lpr-headers-switches ;; It is possible to use an lpr option ;; to get page headers. (setq switches (append (if (stringp lpr-headers-switches) (list lpr-headers-switches) lpr-headers-switches) switches)))) (setq switch-string (if switches (concat " with options " (mapconcat 'identity switches " ")) "")) (message "Spooling%s..." switch-string) (if (/= tab-width 8) (let ((new-coords (print-region-new-buffer start end))) (setq start (car new-coords) end (cdr new-coords)) (setq tab-width width) (save-excursion (goto-char end) (setq end (point-marker))) (untabify (point-min) (point-max)))) (if page-headers (if lpr-headers-switches ;; We handled this above by modifying SWITCHES. nil ;; Run a separate program to get page headers. (let ((new-coords (print-region-new-buffer start end))) (setq start (car new-coords) end (cdr new-coords))) (apply 'call-process-region start end lpr-page-header-program t t nil (nconc (and lpr-add-switches (list "-h" title)) lpr-page-header-switches)) (setq start (point-min) end (point-max)))) (apply (or print-region-function 'call-process-region) (nconc (list start end lpr-command nil nil nil) (nconc (and lpr-add-switches (list "-J" name)) ;; These belong in pr if we are using that. (and lpr-add-switches lpr-headers-switches (list "-T" title)) switches))) (if (markerp end) (set-marker end nil)) (message "Spooling%s...done" switch-string)))) ;; This function copies the text between start and end ;; into a new buffer, makes that buffer current. ;; It returns the new range to print from the new current buffer ;; as (START . END). (defun print-region-new-buffer (ostart oend) (if (string= (buffer-name) " *spool temp*") (cons ostart oend) (let ((oldbuf (current-buffer))) (set-buffer (get-buffer-create " *spool temp*")) (widen) (erase-buffer) (insert-buffer-substring oldbuf ostart oend) (cons (point-min) (point-max))))) (defun printify-region (begin end) "Turn nonprinting characters (other than TAB, LF, SPC, RET, and FF) in the current buffer into printable representations as control or hexadecimal escapes." (interactive "r") (save-excursion (goto-char begin) (let (c) (while (re-search-forward "[\^@-\^h\^k\^n-\^_\177-\377]" end t) (setq c (preceding-char)) (delete-backward-char 1) (insert (if (< c ?\ ) (format "\\^%c" (+ c ?@)) (format "\\%02x" c))))))) (provide 'lpr) ;;; lpr.el ends here emacs-19.30/lisp/ls-lisp.el100444 75424 1 20654 5770115515 14213 0ustar kwzhdaemon;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp ;; Author: Sebastian Kremer ;; Keywords: unix ;; Copyright (C) 1992, 1994 by Sebastian Kremer ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;; INSTALLATION ======================================================= ;; ;; Put this file into your load-path. To use it, load it ;; with (load "ls-lisp"). ;; OVERVIEW =========================================================== ;; This file overloads the function insert-directory to implement it ;; directly from Emacs lisp, without running `ls' in a subprocess. ;; It is useful if you cannot afford to fork Emacs on a real memory UNIX, ;; under VMS, or if you don't have the ls program, or if you want ;; different format from what ls offers. ;; This function uses regexps instead of shell ;; wildcards. If you enter regexps remember to double each $ sign. ;; For example, to include files *.el, enter `.*\.el$$', ;; resulting in the regexp `.*\.el$'. ;; RESTRICTIONS ===================================================== ;; * many ls switches are ignored, see docstring of `insert-directory'. ;; * Only numeric uid/gid ;; TODO ============================================================== ;; Recognize some more ls switches: R F ;;; Code: (defun insert-directory (file &optional switches 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. Optional fourth arg FULL-DIRECTORY-P means file is a directory and switches do not contain `d', so that a full listing is expected. This version of the function comes from `ls-lisp.el'. It does not support ordinary shell wildcards; instead, it allows regular expressions to match file names. The switches that work are: A a c i r S s t u" (let ((handler (find-file-name-handler file 'insert-directory))) (if handler (funcall handler 'insert-directory file switches wildcard full-directory-p) ;; Convert SWITCHES to a list of characters. (setq switches (append switches nil)) (if wildcard (setq wildcard (file-name-nondirectory file) ; actually emacs regexp ;; perhaps convert it from shell to emacs syntax? file (file-name-directory file))) (if (or wildcard full-directory-p) (let* ((dir (file-name-as-directory file)) (default-directory dir);; so that file-attributes works (sum 0) elt short (file-list (directory-files dir nil wildcard)) file-alist ;; do all bindings here for speed fil attr) (cond ((memq ?A switches) (setq file-list (ls-lisp-delete-matching "^\\.\\.?$" file-list))) ((not (memq ?a switches)) ;; if neither -A nor -a, flush . files (setq file-list (ls-lisp-delete-matching "^\\." file-list)))) (setq file-alist (mapcar (function (lambda (x) ;; file-attributes("~bogus") bombs (cons x (file-attributes (expand-file-name x))))) ;; inserting the call to directory-files right here ;; seems to stimulate an Emacs bug ;; ILLEGAL DATATYPE (#o37777777727) or #o67 file-list)) (insert "total \007\n") ; filled in afterwards (setq file-alist (ls-lisp-handle-switches file-alist switches)) (while file-alist (setq elt (car file-alist) file-alist (cdr file-alist) short (car elt) attr (cdr elt)) (and attr (setq sum (+ sum (nth 7 attr))) (insert (ls-lisp-format short attr switches)))) ;; Fill in total size of all files: (save-excursion (search-backward "total \007") (goto-char (match-end 0)) (delete-char -1) (insert (format "%d" (1+ (/ sum 1024)))))) ;; if not full-directory-p, FILE *must not* end in /, as ;; file-attributes will not recognize a symlink to a directory ;; must make it a relative filename as ls does: (setq file (file-name-nondirectory file)) (insert (ls-lisp-format file (file-attributes file) switches)))))) (defun ls-lisp-delete-matching (regexp list) ;; Delete all elements matching REGEXP from LIST, return new list. ;; Should perhaps use setcdr for efficiency. (let (result) (while list (or (string-match regexp (car list)) (setq result (cons (car list) result))) (setq list (cdr list))) result)) (defun ls-lisp-handle-switches (file-alist switches) ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES). ;; Return new alist sorted according to SWITCHES which is a list of ;; characters. Default sorting is alphabetically. (let (index) (setq file-alist (sort file-alist (cond ((memq ?S switches) ; sorted on size (function (lambda (x y) ;; 7th file attribute is file size ;; Make largest file come first (< (nth 7 (cdr y)) (nth 7 (cdr x)))))) ((memq ?t switches) ; sorted on time (setq index (ls-lisp-time-index switches)) (function (lambda (x y) (ls-lisp-time-lessp (nth index (cdr y)) (nth index (cdr x)))))) (t ; sorted alphabetically (function (lambda (x y) (string-lessp (car x) (car y))))))))) (if (memq ?r switches) ; reverse sort order (setq file-alist (nreverse file-alist))) file-alist) ;; From Roland McGrath. Can use this to sort on time. (defun ls-lisp-time-lessp (time0 time1) (let ((hi0 (car time0)) (hi1 (car time1)) (lo0 (car (cdr time0))) (lo1 (car (cdr time1)))) (or (< hi0 hi1) (and (= hi0 hi1) (< lo0 lo1))))) (defun ls-lisp-format (file-name file-attr &optional switches) (let ((file-type (nth 0 file-attr))) (concat (if (memq ?i switches) ; inode number (format "%6d " (nth 10 file-attr))) ;; nil is treated like "" in concat (if (memq ?s switches) ; size in K (format "%4d " (1+ (/ (nth 7 file-attr) 1024)))) (nth 8 file-attr) ; permission bits ;; numeric uid/gid are more confusing than helpful ;; Emacs should be able to make strings of them. ;; user-login-name and user-full-name could take an ;; optional arg. (format " %3d %8s %8s %8d " (nth 1 file-attr) ; no. of links (if (= (user-uid) (nth 2 file-attr)) (user-login-name) (int-to-string (nth 2 file-attr))) ; uid (if (eq system-type 'ms-dos) "root" ; everything is root on MSDOS. (int-to-string (nth 3 file-attr))) ; gid (nth 7 file-attr) ; size in bytes ) (ls-lisp-format-time file-attr switches) " " file-name (if (stringp file-type) ; is a symbolic link (concat " -> " file-type) "") "\n" ))) (defun ls-lisp-time-index (switches) ;; Return index into file-attributes according to ls SWITCHES. (cond ((memq ?c switches) 6) ; last mode change ((memq ?u switches) 4) ; last access ;; default is last modtime (t 5))) (defun ls-lisp-format-time (file-attr switches) ;; Format time string for file with attributes FILE-ATTR according ;; to SWITCHES (a list of ls option letters of which c and u are recognized). ;; file-attributes's time is in a braindead format ;; Emacs 19 can format it using a new optional argument to ;; current-time-string, for Emacs 18 we just return the faked fixed ;; date "Jan 00 00:00 ". (condition-case error-data (let* ((time (current-time-string (nth (ls-lisp-time-index switches) file-attr))) (date (substring time 4 11)) ; "Apr 30 " (clock (substring time 11 16)) ; "11:27" (year (substring time 19 24)) ; " 1992" (same-year (equal year (substring (current-time-string) 19 24)))) (concat date ; has trailing SPC (if same-year ;; this is not exactly the same test used by ls ;; ls tests if the file is older than 6 months ;; but we can't do time differences easily clock year))) (error "Jan 00 00:00"))) (provide 'ls-lisp) ;;; ls-lisp.el ends here emacs-19.30/lisp/lselect.el100444 74777 1 20616 5365710442 14101 0ustar esrdaemon;;; lselect.el --- Lucid interface to X Selections ;; Keywords: emulations ;; This won't completely work until we support or emulate Lucid-style extents. ;; Copyright (C) 1990, 1993 Free Software Foundation, Inc. ;; Based on Lucid's selection code. ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;;; The selection code requires us to use certain symbols whose names are ;;; all upper-case; this may seem tasteless, but it makes there be a 1:1 ;;; correspondence between these symbols and X Atoms (which are upcased.) (defalias 'x-get-cutbuffer 'x-get-cut-buffer) (defalias 'x-store-cutbuffer 'x-set-cut-buffer) (or (find-face 'primary-selection) (make-face 'primary-selection)) (or (find-face 'secondary-selection) (make-face 'secondary-selection)) (defun x-get-secondary-selection () "Return text selected from some X window." (x-get-selection-internal 'SECONDARY 'STRING)) (defvar primary-selection-extent nil "The extent of the primary selection; don't use this.") (defvar secondary-selection-extent nil "The extent of the secondary selection; don't use this.") (defun x-select-make-extent-for-selection (selection previous-extent face) ;; Given a selection, this makes an extent in the buffer which holds that ;; selection, for highlighting purposes. If the selection isn't associated ;; with a buffer, this does nothing. (let ((buffer nil) (valid (and (extentp previous-extent) (extent-buffer previous-extent) (buffer-name (extent-buffer previous-extent)))) start end) (cond ((stringp selection) ;; if we're selecting a string, lose the previous extent used ;; to highlight the selection. (setq valid nil)) ((consp selection) (setq start (min (car selection) (cdr selection)) end (max (car selection) (cdr selection)) valid (and valid (eq (marker-buffer (car selection)) (extent-buffer previous-extent))) buffer (marker-buffer (car selection)))) ((extentp selection) (setq start (extent-start-position selection) end (extent-end-position selection) valid (and valid (eq (extent-buffer selection) (extent-buffer previous-extent))) buffer (extent-buffer selection))) ) (if (and (not valid) (extentp previous-extent) (extent-buffer previous-extent) (buffer-name (extent-buffer previous-extent))) (delete-extent previous-extent)) (if (not buffer) ;; string case nil ;; normal case (if valid (set-extent-endpoints previous-extent start end) (setq previous-extent (make-extent start end buffer)) ;; use same priority as mouse-highlighting so that conflicts between ;; the selection extent and a mouse-highlighted extent are resolved ;; by the usual size-and-endpoint-comparison method. (set-extent-priority previous-extent mouse-highlight-priority) (set-extent-face previous-extent face))))) (defun x-own-selection (selection &optional type) "Make a primary X Selection of the given argument. The argument may be a string, a cons of two markers, or an extent. In the latter cases the selection is considered to be the text between the markers, or the between extents endpoints." (interactive (if (not current-prefix-arg) (list (read-string "Store text for pasting: ")) (list (cons ;; these need not be ordered. (copy-marker (point-marker)) (copy-marker (mark-marker)))))) (or type (setq type 'PRIMARY)) (x-set-selection selection type) (cond ((eq type 'PRIMARY) (setq primary-selection-extent (x-select-make-extent-for-selection selection primary-selection-extent 'primary-selection))) ((eq type 'SECONDARY) (setq secondary-selection-extent (x-select-make-extent-for-selection selection secondary-selection-extent 'secondary-selection)))) selection) (defun x-own-secondary-selection (selection &optional type) "Make a secondary X Selection of the given argument. The argument may be a string or a cons of two markers (in which case the selection is considered to be the text between those markers.)" (interactive (if (not current-prefix-arg) (list (read-string "Store text for pasting: ")) (list (cons ;; these need not be ordered. (copy-marker (point-marker)) (copy-marker (mark-marker)))))) (x-own-selection selection 'SECONDARY)) (defun x-own-clipboard (string) "Paste the given string to the X Clipboard." (x-own-selection string 'CLIPBOARD)) (defun x-disown-selection (&optional secondary-p) "Assuming we own the selection, disown it. With an argument, discard the secondary selection instead of the primary selection." (x-disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY))) (defun x-dehilight-selection (selection) "for use as a value of x-lost-selection-hooks." (cond ((eq selection 'PRIMARY) (if primary-selection-extent (let ((inhibit-quit t)) (delete-extent primary-selection-extent) (setq primary-selection-extent nil))) (if zmacs-regions (zmacs-deactivate-region))) ((eq selection 'SECONDARY) (if secondary-selection-extent (let ((inhibit-quit t)) (delete-extent secondary-selection-extent) (setq secondary-selection-extent nil))))) nil) (setq x-lost-selection-hooks 'x-dehilight-selection) (defun x-notice-selection-requests (selection type successful) "for possible use as the value of x-sent-selection-hooks." (if (not successful) (message "Selection request failed to convert %s to %s" selection type) (message "Sent selection %s as %s" selection type))) (defun x-notice-selection-failures (selection type successful) "for possible use as the value of x-sent-selection-hooks." (or successful (message "Selection request failed to convert %s to %s" selection type))) ;(setq x-sent-selection-hooks 'x-notice-selection-requests) ;(setq x-sent-selection-hooks 'x-notice-selection-failures) ;;; Random utility functions (defun x-kill-primary-selection () "If there is a selection, delete the text it covers, and copy it to both the kill ring and the Clipboard." (interactive) (or (x-selection-owner-p) (error "emacs does not own the primary selection")) (setq last-command nil) (or primary-selection-extent (error "the primary selection is not an extent?")) (save-excursion (set-buffer (extent-buffer primary-selection-extent)) (kill-region (extent-start-position primary-selection-extent) (extent-end-position primary-selection-extent))) (x-disown-selection nil)) (defun x-delete-primary-selection () "If there is a selection, delete the text it covers *without* copying it to the kill ring or the Clipboard." (interactive) (or (x-selection-owner-p) (error "emacs does not own the primary selection")) (setq last-command nil) (or primary-selection-extent (error "the primary selection is not an extent?")) (save-excursion (set-buffer (extent-buffer primary-selection-extent)) (delete-region (extent-start-position primary-selection-extent) (extent-end-position primary-selection-extent))) (x-disown-selection nil)) (defun x-copy-primary-selection () "If there is a selection, copy it to both the kill ring and the Clipboard." (interactive) (setq last-command nil) (or (x-selection-owner-p) (error "emacs does not own the primary selection")) (or primary-selection-extent (error "the primary selection is not an extent?")) (save-excursion (set-buffer (extent-buffer primary-selection-extent)) (copy-region-as-kill (extent-start-position primary-selection-extent) (extent-end-position primary-selection-extent)))) (defun x-yank-clipboard-selection () "If someone owns a Clipboard selection, insert it at point." (interactive) (setq last-command nil) (let ((clip (x-get-clipboard))) (or clip (error "there is no clipboard selection")) (push-mark) (insert clip))) ;;; lselect.el ends here. emacs-19.30/lisp/lucid.el100444 75424 12 20615 5741112327 13603 0ustar kwzhstaff;;; lucid.el --- Emulate some Lucid Emacs functions. ;; Copyright (C) 1993, 1995 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. (defun add-timeout (secs function object &optional resignal) (run-at-time secs resignal function object)) (defun disable-timeout (timeout) (cancel-timer timeout)) (defun copy-tree (tree) (if (consp tree) (cons (copy-tree (car tree)) (copy-tree (cdr tree))) (if (vectorp tree) (let* ((new (copy-sequence tree)) (i (1- (length new)))) (while (>= i 0) (aset new i (copy-tree (aref new i))) (setq i (1- i))) new) tree))) (defalias 'current-time-seconds 'current-time) (defun keymap-parent (keymap) (let ((tail (cdr keymap))) (while (and tail (not (eq (car tail) 'keymap))) (setq tail (cdr tail))) tail)) (defun set-keymap-parent (keymap new-parent) (let ((tail keymap)) (while (and tail (cdr tail) (not (eq (car (cdr tail)) 'keymap))) (setq tail (cdr tail))) (if tail (setcdr tail new-parent)))) (defun remprop (symbol prop) (let ((plist (symbol-plist symbol))) (while (eq (car plist) prop) (setplist symbol (setq plist (cdr (cdr plist))))) (while plist (if (eq (nth 2 plist) prop) (setcdr (cdr plist) (nthcdr 4 plist))) (setq plist (cdr (cdr plist)))))) (defun map-keymap (function keymap &optional sort-first) "Call FUNCTION for every binding in KEYMAP. This includes bindings inherited from a parent keymap. FUNCTION receives two arguments each time it is called: the character (more generally, the event type) that is bound, and the binding it has. Note that passing the event type directly to `define-key' does not work in Emacs 19. We do not emulate that particular feature of Lucid Emacs. If your code does that, modify it to make a vector containing the event type that you get. That will work in both versions of Emacs." (if sort-first (let (list) (map-keymap (function (lambda (a b) (setq list (cons (cons a b) list)))) keymap) (setq list (sort list (function (lambda (a b) (setq a (car a) b (car b)) (if (integerp a) (if (integerp b) (< a b) t) (if (integerp b) t (string< a b))))))) (while list (funcall function (car (car list)) (cdr (car list))) (setq list (cdr list)))) (while (consp keymap) (if (consp (car keymap)) (funcall function (car (car keymap)) (cdr (car keymap))) (if (vectorp (car keymap)) (let ((i (1- (length (car keymap)))) (vector (car keymap))) (while (>= i 0) (funcall function i (aref vector i)) (setq i (1- i)))))) (setq keymap (cdr keymap))))) (defun read-number (prompt &optional integers-only) "Read a number from the minibuffer. Keep reentering the minibuffer until we get suitable input. If optional argument INTEGERS-ONLY is non-nil, insist on an integer." (interactive) (let (success (number nil) (predicate (if integers-only 'integerp 'numberp))) (while (not success) (let ((input-string (read-string prompt))) (condition-case () (setq number (read input-string)) (error)) (if (funcall predicate number) (setq success t) (let ((cursor-in-echo-area t)) (message "Please type %s" (if integers-only "an integer" "a number")) (sit-for 1))))) number)) (defun real-path-name (name &optional default) (file-truename (expand-file-name name default))) ;; It's not clear what to return if the mouse is not in FRAME. (defun read-mouse-position (frame) (let ((pos (mouse-position))) (if (eq (car pos) frame) (cdr pos)))) (defun switch-to-other-buffer (arg) "Switch to the previous buffer. With a numeric arg N, switch to the Nth most recent buffer. With an arg of 0, buries the current buffer at the bottom of the buffer stack." (interactive "p") (if (eq arg 0) (bury-buffer (current-buffer))) (switch-to-buffer (if (<= arg 1) (other-buffer (current-buffer)) (nth arg (apply 'nconc (mapcar (lambda (buf) (if (= ?\ (string-to-char (buffer-name buf))) nil (list buf))) (buffer-list))))))) (defalias 'find-face 'internal-find-face) (defalias 'get-face 'internal-get-face) (defalias 'try-face-font 'internal-try-face-font) (defun make-extent (beg end &optional buffer) (make-overlay beg end buffer)) (defun set-extent-property (extent prop value) (if (eq prop 'duplicable) (cond ((and value (not (overlay-get extent prop))) ;; If becoming duplicable, copy all overlayprops to text props. (add-text-properties (overlay-start extent) (overlay-end extent) (overlay-properties extent) (overlay-buffer extent))) ;; If becoming no longer duplicable, remove these text props. ((and (not value) (overlay-get extent prop)) (remove-text-properties (overlay-start extent) (overlay-end extent) (overlay-properties extent) (overlay-buffer extent)))) ;; If extent is already duplicable, put this property ;; on the text as well as on the overlay. (if (overlay-get extent 'duplicable) (put-text-property (overlay-start extent) (overlay-end extent) prop value (overlay-buffer extent)))) (overlay-put extent prop value)) (defun set-extent-face (extent face) (set-extent-property extent 'face face)) (defun delete-extent (extent) (set-extent-property extent 'duplicable nil) (delete-overlay extent)) ;; Support the Lucid names with `screen' instead of `frame'. (defalias 'current-screen-configuration 'current-frame-configuration) (defalias 'delete-screen 'delete-frame) (defalias 'find-file-new-screen 'find-file-other-frame) (defalias 'find-file-read-only-new-screen 'find-file-read-only-other-frame) (defalias 'find-tag-new-screen 'find-tag-other-frame) ;;(defalias 'focus-screen 'focus-frame) (defalias 'iconify-screen 'iconify-frame) (defalias 'mail-new-screen 'mail-other-frame) (defalias 'make-screen-invisible 'make-frame-invisible) (defalias 'make-screen-visible 'make-frame-visible) ;; (defalias 'minibuffer-screen-list 'minibuffer-frame-list) (defalias 'modify-screen-parameters 'modify-frame-parameters) (defalias 'next-screen 'next-frame) ;; (defalias 'next-multiscreen-window 'next-multiframe-window) ;; (defalias 'previous-multiscreen-window 'previous-multiframe-window) ;; (defalias 'redirect-screen-focus 'redirect-frame-focus) (defalias 'redraw-screen 'redraw-frame) ;; (defalias 'screen-char-height 'frame-char-height) ;; (defalias 'screen-char-width 'frame-char-width) ;; (defalias 'screen-configuration-to-register 'frame-configuration-to-register) ;; (defalias 'screen-focus 'frame-focus) (defalias 'screen-height 'frame-height) (defalias 'screen-list 'frame-list) ;; (defalias 'screen-live-p 'frame-live-p) (defalias 'screen-parameters 'frame-parameters) (defalias 'screen-pixel-height 'frame-pixel-height) (defalias 'screen-pixel-width 'frame-pixel-width) (defalias 'screen-root-window 'frame-root-window) (defalias 'screen-selected-window 'frame-selected-window) (defalias 'lower-screen 'lower-frame) (defalias 'raise-screen 'raise-frame) (defalias 'screen-visible-p 'frame-visible-p) (defalias 'screen-width 'frame-width) (defalias 'screenp 'framep) (defalias 'select-screen 'select-frame) (defalias 'selected-screen 'selected-frame) ;; (defalias 'set-screen-configuration 'set-frame-configuration) ;; (defalias 'set-screen-height 'set-frame-height) (defalias 'set-screen-position 'set-frame-position) (defalias 'set-screen-size 'set-frame-size) ;; (defalias 'set-screen-width 'set-frame-width) (defalias 'switch-to-buffer-new-screen 'switch-to-buffer-other-frame) ;; (defalias 'unfocus-screen 'unfocus-frame) (defalias 'visible-screen-list 'visible-frame-list) (defalias 'window-screen 'window-frame) (defalias 'x-create-screen 'x-create-frame) (defalias 'x-new-screen 'make-frame) (provide 'lucid) ;;; end of lucid.el emacs-19.30/lisp/lunar.el100444 22346 1 37660 6030151102 14547 0ustar reingolddaemon;;; lunar.el --- calendar functions for phases of the moon. ;; Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: moon, lunar phases, calendar, diary ;; 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 collection of functions implements lunar phases for calendar.el and ;; diary.el. ;; Based on ``Astronomical Formulae for Calculators,'' 3rd ed., by Jean Meeus, ;; Willmann-Bell, Inc., 1985 and ``Astronomical Algorithms'' by Jean Meeus, ;; Willmann-Bell, Inc., 1991. ;; ;; WARNING: The calculations will be accurate only to within a few minutes. ;; The author would be delighted to have an astronomically more sophisticated ;; person rewrite the code for the lunar calculations in this file! ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (if (fboundp 'atan) (require 'lisp-float-type) (error "Lunar calculations impossible since floating point is unavailable.")) (require 'solar) (defun lunar-phase-list (month year) "List of lunar phases for three months starting with Gregorian MONTH, YEAR." (let ((end-month month) (end-year year) (start-month month) (start-year year)) (increment-calendar-month end-month end-year 3) (increment-calendar-month start-month start-year -1) (let* ((end-date (list (list end-month 1 end-year))) (start-date (list (list start-month (calendar-last-day-of-month start-month start-year) start-year))) (index (* 4 (truncate (* 12.3685 (+ year ( / (calendar-day-number (list month 1 year)) 366.0) -1900))))) (new-moon (lunar-phase index)) (list)) (while (calendar-date-compare new-moon end-date) (if (calendar-date-compare start-date new-moon) (setq list (append list (list new-moon)))) (setq index (1+ index)) (setq new-moon (lunar-phase index))) list))) (defun lunar-phase (index) "Local date and time of lunar phase INDEX. Integer below INDEX/4 gives the lunation number, counting from Jan 1, 1900; remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon, 3 last quarter." (let* ((phase (mod index 4)) (index (/ index 4.0)) (time (/ index 1236.85)) (date (+ (calendar-absolute-from-gregorian '(1 0.5 1900)) 0.75933 (* 29.53058868 index) (* 0.0001178 time time) (* -0.000000155 time time time) (* 0.00033 (solar-sin-degrees (+ 166.56 (* 132.87 time) (* -0.009173 time time)))))) (sun-anomaly (mod (+ 359.2242 (* 29.105356 index) (* -0.0000333 time time) (* -0.00000347 time time time)) 360.0)) (moon-anomaly (mod (+ 306.0253 (* 385.81691806 index) (* 0.0107306 time time) (* 0.00001236 time time time)) 360.0)) (moon-lat (mod (+ 21.2964 (* 390.67050646 index) (* -0.0016528 time time) (* -0.00000239 time time time)) 360.0)) (adjustment (if (memq phase '(0 2)) (+ (* (- 0.1734 (* 0.000393 time)) (solar-sin-degrees sun-anomaly)) (* 0.0021 (solar-sin-degrees (* 2 sun-anomaly))) (* -0.4068 (solar-sin-degrees moon-anomaly)) (* 0.0161 (solar-sin-degrees (* 2 moon-anomaly))) (* -0.0004 (solar-sin-degrees (* 3 moon-anomaly))) (* 0.0104 (solar-sin-degrees (* 2 moon-lat))) (* -0.0051 (solar-sin-degrees (+ sun-anomaly moon-anomaly))) (* -0.0074 (solar-sin-degrees (- sun-anomaly moon-anomaly))) (* 0.0004 (solar-sin-degrees (+ (* 2 moon-lat) sun-anomaly))) (* -0.0004 (solar-sin-degrees (- (* 2 moon-lat) sun-anomaly))) (* -0.0006 (solar-sin-degrees (+ (* 2 moon-lat) moon-anomaly))) (* 0.0010 (solar-sin-degrees (- (* 2 moon-lat) moon-anomaly))) (* 0.0005 (solar-sin-degrees (+ (* 2 moon-anomaly) sun-anomaly)))) (+ (* (- 0.1721 (* 0.0004 time)) (solar-sin-degrees sun-anomaly)) (* 0.0021 (solar-sin-degrees (* 2 sun-anomaly))) (* -0.6280 (solar-sin-degrees moon-anomaly)) (* 0.0089 (solar-sin-degrees (* 2 moon-anomaly))) (* -0.0004 (solar-sin-degrees (* 3 moon-anomaly))) (* 0.0079 (solar-sin-degrees (* 2 moon-lat))) (* -0.0119 (solar-sin-degrees (+ sun-anomaly moon-anomaly))) (* -0.0047 (solar-sin-degrees (- sun-anomaly moon-anomaly))) (* 0.0003 (solar-sin-degrees (+ (* 2 moon-lat) sun-anomaly))) (* -0.0004 (solar-sin-degrees (- (* 2 moon-lat) sun-anomaly))) (* -0.0006 (solar-sin-degrees (+ (* 2 moon-lat) moon-anomaly))) (* 0.0021 (solar-sin-degrees (- (* 2 moon-lat) moon-anomaly))) (* 0.0003 (solar-sin-degrees (+ (* 2 moon-anomaly) sun-anomaly))) (* 0.0004 (solar-sin-degrees (- sun-anomaly (* 2 moon-anomaly)))) (* -0.0003 (solar-sin-degrees (+ (* 2 sun-anomaly) moon-anomaly)))))) (adj (+ 0.0028 (* -0.0004 (solar-cosine-degrees sun-anomaly)) (* 0.0003 (solar-cosine-degrees moon-anomaly)))) (adjustment (cond ((= phase 1) (+ adjustment adj)) ((= phase 2) (- adjustment adj)) (t adjustment))) (date (+ date adjustment)) (date (+ date (/ (- calendar-time-zone (solar-ephemeris-correction (extract-calendar-year (calendar-gregorian-from-absolute (truncate date))))) 60.0 24.0))) (time (* 24 (- date (truncate date)))) (date (calendar-gregorian-from-absolute (truncate date))) (adj (dst-adjust-time date time))) (list (car adj) (apply 'solar-time-string (cdr adj)) phase))) (defun lunar-phase-name (phase) "Name of lunar PHASE. 0 = new moon, 1 = first quarter, 2 = full moon, 3 = last quarter." (cond ((= 0 phase) "New Moon") ((= 1 phase) "First Quarter Moon") ((= 2 phase) "Full Moon") ((= 3 phase) "Last Quarter Moon"))) (defun calendar-phases-of-moon () "Create a buffer with the lunar phases for the current calendar window." (interactive) (message "Computing phases of the moon...") (let ((m1 displayed-month) (y1 displayed-year) (m2 displayed-month) (y2 displayed-year)) (increment-calendar-month m1 y1 -1) (increment-calendar-month m2 y2 1) (set-buffer (get-buffer-create lunar-phases-buffer)) (setq buffer-read-only nil) (calendar-set-mode-line (if (= y1 y2) (format "Phases of the Moon from %s to %s, %d%%-" (calendar-month-name m1) (calendar-month-name m2) y2) (format "Phases of the Moon from %s, %d to %s, %d%%-" (calendar-month-name m1) y1 (calendar-month-name m2) y2))) (erase-buffer) (insert (mapconcat '(lambda (x) (let ((date (car x)) (time (car (cdr x))) (phase (car (cdr (cdr x))))) (concat (calendar-date-string date) ": " (lunar-phase-name phase) " " time))) (lunar-phase-list m1 y1) "\n")) (goto-char (point-min)) (set-buffer-modified-p nil) (setq buffer-read-only t) (display-buffer lunar-phases-buffer) (message "Computing phases of the moon...done"))) ;;;###autoload (defun phases-of-moon (&optional arg) "Display the quarters of the moon for last month, this month, and next month. If called with an optional prefix argument, prompts for month and year. This function is suitable for execution in a .emacs file." (interactive "P") (save-excursion (let* ((date (if arg (calendar-read-date t) (calendar-current-date))) (displayed-month (extract-calendar-month date)) (displayed-year (extract-calendar-year date))) (calendar-phases-of-moon)))) (defun diary-phases-of-moon () "Moon phases diary entry." (let* ((index (* 4 (truncate (* 12.3685 (+ (extract-calendar-year date) ( / (calendar-day-number date) 366.0) -1900))))) (phase (lunar-phase index))) (while (calendar-date-compare phase (list date)) (setq index (1+ index)) (setq phase (lunar-phase index))) (if (calendar-date-equal (car phase) date) (concat (lunar-phase-name (car (cdr (cdr phase)))) " " (car (cdr phase)))))) ;; For the Chinese calendar the calculations for the new moon need to be more ;; accurate than those above, so we use more terms in the approximation. (defun lunar-new-moon-time (k) "Astronomical (Julian) day number of K th new moon." (let* ((T (/ k 1236.85)) (T2 (* T T)) (T3 (* T T T)) (T4 (* T2 T2)) (JDE (+ 2451550.09765 (* 29.530588853 k) (* 0.0001337 T2) (* -0.000000150 T3) (* 0.00000000073 T4))) (E (- 1 (* 0.002516 T) (* 0.0000074 T2))) (sun-anomaly (+ 2.5534 (* 29.10535669 k) (* -0.0000218 T2) (* -0.00000011 T3))) (moon-anomaly (+ 201.5643 (* 385.81693528 k) (* 0.0107438 T2) (* 0.00001239 T3) (* -0.000000058 T4))) (moon-argument (+ 160.7108 (* 390.67050274 k) (* -0.0016341 T2) (* -0.00000227 T3) (* 0.000000011 T4))) (omega (+ 124.7746 (* -1.56375580 k) (* 0.0020691 T2) (* 0.00000215 T3))) (A1 (+ 299.77 (* 0.107408 k) (* -0.009173 T2))) (A2 (+ 251.88 (* 0.016321 k))) (A3 (+ 251.83 (* 26.641886 k))) (A4 (+ 349.42 (* 36.412478 k))) (A5 (+ 84.66 (* 18.206239 k))) (A6 (+ 141.74 (* 53.303771 k))) (A7 (+ 207.14 (* 2.453732 k))) (A8 (+ 154.84 (* 7.306860 k))) (A9 (+ 34.52 (* 27.261239 k))) (A10 (+ 207.19 (* 0.121824 k))) (A11 (+ 291.34 (* 1.844379 k))) (A12 (+ 161.72 (* 24.198154 k))) (A13 (+ 239.56 (* 25.513099 k))) (A14 (+ 331.55 (* 3.592518 k))) (correction (+ (* -0.40720 (solar-sin-degrees moon-anomaly)) (* 0.17241 E (solar-sin-degrees sun-anomaly)) (* 0.01608 (solar-sin-degrees (* 2 moon-anomaly))) (* 0.01039 (solar-sin-degrees (* 2 moon-argument))) (* 0.00739 E (solar-sin-degrees (- moon-anomaly sun-anomaly))) (* -0.00514 E (solar-sin-degrees (+ moon-anomaly sun-anomaly))) (* 0.00208 E E (solar-sin-degrees (* 2 sun-anomaly))) (* -0.00111 (solar-sin-degrees (- moon-anomaly (* 2 moon-argument)))) (* -0.00057 (solar-sin-degrees (+ moon-anomaly (* 2 moon-argument)))) (* 0.00056 E (solar-sin-degrees (+ (* 2 moon-anomaly) sun-anomaly))) (* -0.00042 (solar-sin-degrees (* 3 moon-anomaly))) (* 0.00042 E (solar-sin-degrees (+ sun-anomaly (* 2 moon-argument)))) (* 0.00038 E (solar-sin-degrees (- sun-anomaly (* 2 moon-argument)))) (* -0.00024 E (solar-sin-degrees (- (* 2 moon-anomaly) sun-anomaly))) (* -0.00017 (solar-sin-degrees omega)) (* -0.00007 (solar-sin-degrees (+ moon-anomaly (* 2 sun-anomaly)))) (* 0.00004 (solar-sin-degrees (- (* 2 moon-anomaly) (* 2 moon-argument)))) (* 0.00004 (solar-sin-degrees (* 3 sun-anomaly))) (* 0.00003 (solar-sin-degrees (+ moon-anomaly sun-anomaly (* -2 moon-argument)))) (* 0.00003 (solar-sin-degrees (+ (* 2 moon-anomaly) (* 2 moon-argument)))) (* -0.00003 (solar-sin-degrees (+ moon-anomaly sun-anomaly (* 2 moon-argument)))) (* 0.00003 (solar-sin-degrees (- moon-anomaly sun-anomaly (* -2 moon-argument)))) (* -0.00002 (solar-sin-degrees (- moon-anomaly sun-anomaly (* 2 moon-argument)))) (* -0.00002 (solar-sin-degrees (+ (* 3 moon-anomaly) sun-anomaly))) (* 0.00002 (solar-sin-degrees (* 4 moon-anomaly))))) (additional (+ (* 0.000325 (solar-sin-degrees A1)) (* 0.000165 (solar-sin-degrees A2)) (* 0.000164 (solar-sin-degrees A3)) (* 0.000126 (solar-sin-degrees A4)) (* 0.000110 (solar-sin-degrees A5)) (* 0.000062 (solar-sin-degrees A6)) (* 0.000060 (solar-sin-degrees A7)) (* 0.000056 (solar-sin-degrees A8)) (* 0.000047 (solar-sin-degrees A9)) (* 0.000042 (solar-sin-degrees A10)) (* 0.000040 (solar-sin-degrees A11)) (* 0.000037 (solar-sin-degrees A12)) (* 0.000035 (solar-sin-degrees A13)) (* 0.000023 (solar-sin-degrees A14)))) (newJDE (+ JDE correction additional))) (+ newJDE (- (solar-ephemeris-correction (extract-calendar-year (calendar-gregorian-from-absolute (floor (calendar-absolute-from-astro newJDE)))))) (/ calendar-time-zone 60.0 24.0)))) (defun lunar-new-moon-on-or-after (d) "Astronomical (Julian) day number of first new moon on or after astronomical (Julian) day number d. The fractional part is the time of day. The date and time are local time, including any daylight savings rules, as governed by the values of calendar-daylight-savings-starts, calendar-daylight-savings-starts-time, calendar-daylight-savings-ends, calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and calendar-time-zone." (let* ((date (calendar-gregorian-from-absolute (floor (calendar-absolute-from-astro d)))) (year (+ (extract-calendar-year date) (/ (calendar-day-number date) 365.25))) (k (floor (* (- year 2000.0) 12.3685))) (date (lunar-new-moon-time k))) (while (< date d) (setq k (1+ k)) (setq date (lunar-new-moon-time k))) (let* ((a-date (calendar-absolute-from-astro date)) (time (* 24 (- a-date (truncate a-date)))) (date (calendar-gregorian-from-absolute (truncate a-date))) (adj (dst-adjust-time date time))) (calendar-astro-from-absolute (+ (calendar-absolute-from-gregorian (car adj)) (/ (car (cdr adj)) 24.0)))))) (provide 'lunar) ;;; lunar.el ends here emacs-19.30/lisp/macros.el100444 12120 1 23661 6015411525 13704 0ustar rmsdaemon;;; macros.el --- non-primitive commands for keyboard macros. ;; Copyright (C) 1985, 86, 87, 92, 94, 95 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: abbrev ;; 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: ;; Extension commands for keyboard macros. These permit you to assign ;; a name to the last-defined keyboard macro, expand and insert the ;; lisp corresponding to a macro, query the user from within a macro, ;; or apply a macro to each line in the reason. ;;; Code: ;;;###autoload (defun name-last-kbd-macro (symbol) "Assign a name to the last keyboard macro defined. Argument SYMBOL is the name to define. The symbol's function definition becomes the keyboard macro string. Such a \"function\" cannot be called from Lisp, but it is a valid editor command." (interactive "SName for last kbd macro: ") (or last-kbd-macro (error "No keyboard macro defined")) (and (fboundp symbol) (not (stringp (symbol-function symbol))) (not (vectorp (symbol-function symbol))) (error "Function %s is already defined and not a keyboard macro." symbol)) (fset symbol last-kbd-macro)) ;;;###autoload (defun insert-kbd-macro (macroname &optional keys) "Insert in buffer the definition of kbd macro NAME, as Lisp code. Optional second arg KEYS means also record the keys it is on \(this is the prefix argument, when calling interactively). This Lisp code will, when executed, define the kbd macro with the same definition it has now. If you say to record the keys, the Lisp code will also rebind those keys to the macro. Only global key bindings are recorded since executing this Lisp code always makes global bindings. To save a kbd macro, visit a file of Lisp code such as your `~/.emacs', use this command, and then save the file." (interactive "CInsert kbd macro (name): \nP") (let (definition) (if (string= (symbol-name macroname) "") (progn (setq macroname 'last-kbd-macro definition last-kbd-macro) (insert "(setq ")) (setq definition (symbol-function macroname)) (insert "(fset '")) (prin1 macroname (current-buffer)) (insert "\n ") (if (stringp definition) (let ((beg (point)) end) (prin1 definition (current-buffer)) (setq end (point-marker)) (goto-char beg) (while (< (point) end) (let ((char (following-char))) (cond ((= char 0) (delete-region (point) (1+ (point))) (insert "\\C-@")) ((< char 27) (delete-region (point) (1+ (point))) (insert "\\C-" (+ 96 char))) ((= char ?\C-\\) (delete-region (point) (1+ (point))) (insert "\\C-\\\\")) ((< char 32) (delete-region (point) (1+ (point))) (insert "\\C-" (+ 64 char))) ((< char 127) (forward-char 1)) ((= char 127) (delete-region (point) (1+ (point))) (insert "\\C-?")) ((= char 128) (delete-region (point) (1+ (point))) (insert "\\M-\\C-@")) ((= char (aref "\M-\C-\\" 0)) (delete-region (point) (1+ (point))) (insert "\\M-\\C-\\\\")) ((< char 155) (delete-region (point) (1+ (point))) (insert "\\M-\\C-" (- char 32))) ((< char 160) (delete-region (point) (1+ (point))) (insert "\\M-\\C-" (- char 64))) ((= char (aref "\M-\\" 0)) (delete-region (point) (1+ (point))) (insert "\\M-\\\\")) ((< char 255) (delete-region (point) (1+ (point))) (insert "\\M-" (- char 128))) ((= char 255) (delete-region (point) (1+ (point))) (insert "\\M-\\C-?")))))) (if (vectorp definition) (let ((len (length definition)) (i 0) char mods) (while (< i len) (insert (if (zerop i) ?\[ ?\ )) (setq char (aref definition i) i (1+ i)) (cond ((not (numberp char)) (prin1 char (current-buffer))) (t (insert "?") (setq mods (event-modifiers char) char (event-basic-type char)) (while mods (cond ((eq (car mods) 'control) (insert "\\C-")) ((eq (car mods) 'meta) (insert "\\M-")) ((eq (car mods) 'hyper) (insert "\\H-")) ((eq (car mods) 'super) (insert "\\s-")) ((eq (car mods) 'alt) (insert "\\A-")) ((and (eq (car mods) 'shift) (>= char ?a) (<= char ?z)) (setq char (upcase char))) ((eq (car mods) 'shift) (insert "\\S-"))) (setq mods (cdr mods))) (cond ((= char ?\\) (insert "\\\\")) ((= char 127) (insert "\\C-?")) ((< char 127) (insert char)) (t (insert "\\" (format "%o" char))))))) (insert ?\])) (prin1 definition (current-buffer)))) (insert ")\n") (if keys (let ((keys (where-is-internal macroname '(keymap)))) (while keys (insert "(global-set-key ") (prin1 (car keys) (current-buffer)) (insert " '") (prin1 macroname (current-buffer)) (insert ")\n") (setq keys (cdr keys))))))) ;;;###autoload (defun kbd-macro-query (flag) "Query user during kbd macro execution. With prefix argument, enters recursive edit, reading keyboard commands even within a kbd macro. You can give different commands each time the macro executes. Without prefix argument, asks whether to continue running the macro. Your options are: \\ \\[act] Finish this iteration normally and continue with the next. \\[skip] Skip the rest of this iteration, and start the next. \\[exit] Stop the macro entirely right now. \\[recenter] Redisplay the screen, then ask again. \\[edit] Enter recursive edit; ask again when you exit from that." (interactive "P") (or executing-macro defining-kbd-macro (error "Not defining or executing kbd macro")) (if flag (let (executing-macro defining-kbd-macro) (recursive-edit)) (if (not executing-macro) nil (let ((loop t) (msg (substitute-command-keys "Proceed with macro?\\\ (\\[act], \\[skip], \\[exit], \\[recenter], \\[edit]) "))) (while loop (let ((key (let ((executing-macro nil) (defining-kbd-macro nil)) (message msg) (read-event))) def) (setq key (vector key)) (setq def (lookup-key query-replace-map key)) (cond ((eq def 'act) (setq loop nil)) ((eq def 'skip) (setq loop nil) (setq executing-macro "")) ((eq def 'exit) (setq loop nil) (setq executing-macro t)) ((eq def 'recenter) (recenter nil)) ((eq def 'edit) (let (executing-macro defining-kbd-macro) (recursive-edit))) ((eq def 'quit) (setq quit-flag t)) (t (or (eq def 'help) (ding)) (with-output-to-temp-buffer "*Help*" (princ (substitute-command-keys "Specify how to proceed with keyboard macro execution. Possibilities: \\ \\[act] Finish this iteration normally and continue with the next. \\[skip] Skip the rest of this iteration, and start the next. \\[exit] Stop the macro entirely right now. \\[recenter] Redisplay the screen, then ask again. \\[edit] Enter recursive edit; ask again when you exit from that.")) (save-excursion (set-buffer standard-output) (help-mode))))))))))) ;;;###autoload (defun apply-macro-to-region-lines (top bottom &optional macro) "For each complete line between point and mark, move to the beginning of the line, and run the last keyboard macro. When called from lisp, this function takes two arguments TOP and BOTTOM, describing the current region. TOP must be before BOTTOM. The optional third argument MACRO specifies a keyboard macro to execute. This is useful for quoting or unquoting included text, adding and removing comments, or producing tables where the entries are regular. For example, in Usenet articles, sections of text quoted from another author are indented, or have each line start with `>'. To quote a section of text, define a keyboard macro which inserts `>', put point and mark at opposite ends of the quoted section, and use `\\[apply-macro-to-region-lines]' to mark the entire section. Suppose you wanted to build a keyword table in C where each entry looked like this: { \"foo\", foo_data, foo_function }, { \"bar\", bar_data, bar_function }, { \"baz\", baz_data, baz_function }, You could enter the names in this format: foo bar baz and write a macro to massage a word into a table entry: \\C-x ( \\M-d { \"\\C-y\", \\C-y_data, \\C-y_function }, \\C-x ) and then select the region of un-tablified names and use `\\[apply-macro-to-region-lines]' to build the table from the names. " (interactive "r") (or macro (progn (if (null last-kbd-macro) (error "No keyboard macro has been defined.")) (setq macro last-kbd-macro))) (save-excursion (let ((end-marker (progn (goto-char bottom) (beginning-of-line) (point-marker))) next-line-marker) (goto-char top) (if (not (bolp)) (forward-line 1)) (setq next-line-marker (point-marker)) (while (< next-line-marker end-marker) (goto-char next-line-marker) (save-excursion (forward-line 1) (set-marker next-line-marker (point))) (save-excursion (execute-kbd-macro (or macro last-kbd-macro)))) (set-marker end-marker nil) (set-marker next-line-marker nil)))) ;;;###autoload (define-key ctl-x-map "q" 'kbd-macro-query) ;;; macros.el ends here emacs-19.30/lisp/mail-extr.el100444 75424 1 206072 5762271220 14547 0ustar kwzhdaemon;;; mail-extr.el --- extract full name and address from RFC 822 mail header. ;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. ;; Author: Joe Wells ;; Maintainer: Jamie Zawinski ;; Version: 1.8 ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; The entry point of this code is ;; ;; mail-extract-address-components: (address) ;; ;; Given an RFC-822 ADDRESS, extract full name and canonical address. ;; Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). ;; If no name can be extracted, FULL-NAME will be nil. ;; ADDRESS may be a string or a buffer. If it is a buffer, the visible ;; (narrowed) portion of the buffer will be interpreted as the address. ;; (This feature exists so that the clever caller might be able to avoid ;; consing a string.) ;; If ADDRESS contains more than one RFC-822 address, only the first is ;; returned. ;; ;; This code is more correct (and more heuristic) parser than the code in ;; rfc822.el. And despite its size, it's fairly fast. ;; ;; There are two main benefits: ;; ;; 1. Higher probability of getting the correct full name for a human than ;; any other package we know of. (On the other hand, it will cheerfully ;; mangle non-human names/comments.) ;; 2. Address part is put in a canonical form. ;; ;; The interface is not yet carved in stone; please give us suggestions. ;; ;; We have an extensive test-case collection of funny addresses if you want to ;; work with the code. Developing this code requires frequent testing to ;; make sure you're not breaking functionality. The test cases aren't included ;; because they are over 100K. ;; ;; If you find an address that mail-extr fails on, please send it to the ;; maintainer along with what you think the correct results should be. We do ;; not consider it a bug if mail-extr mangles a comment that does not ;; correspond to a real human full name, although we would prefer that ;; mail-extr would return the comment as-is. ;; ;; Features: ;; ;; * Full name handling: ;; ;; * knows where full names can be found in an address. ;; * avoids using empty comments and quoted text. ;; * extracts full names from mailbox names. ;; * recognizes common formats for comments after a full name. ;; * puts a period and a space after each initial. ;; * understands & referring to the mailbox name, capitalized. ;; * strips name prefixes like "Prof.", etc. ;; * understands what characters can occur in names (not just letters). ;; * figures out middle initial from mailbox name. ;; * removes funny nicknames. ;; * keeps suffixes such as Jr., Sr., III, etc. ;; * reorders "Last, First" type names. ;; ;; * Address handling: ;; ;; * parses rfc822 quoted text, comments, and domain literals. ;; * parses rfc822 multi-line headers. ;; * does something reasonable with rfc822 GROUP addresses. ;; * handles many rfc822 noncompliant and garbage addresses. ;; * canonicalizes addresses (after stripping comments/phrases outside <>). ;; * converts ! addresses into .UUCP and %-style addresses. ;; * converts rfc822 ROUTE addresses to %-style addresses. ;; * truncates %-style addresses at leftmost fully qualified domain name. ;; * handles local relative precedence of ! vs. % and @ (untested). ;; ;; It does almost no string creation. It primarily uses the built-in ;; parsing routines with the appropriate syntax tables. This should ;; result in greater speed. ;; ;; TODO: ;; ;; * handle all test cases. (This will take forever.) ;; * software to pick the correct header to use (eg., "Senders-Name:"). ;; * multiple addresses in the "From:" header (almost all of the necessary ;; code is there). ;; * flag to not treat `,' as an address separator. (This is useful when ;; there is a "From:" header but no "Sender:" header, because then there ;; is only allowed to be one address.) ;; * mailbox name does not necessarily contain full name. ;; * fixing capitalization when it's all upper or lowercase. (Hard!) ;; * some of the domain literal handling is missing. (But I've never even ;; seen one of these in a mail address, so maybe no big deal.) ;; * arrange to have syntax tables byte-compiled. ;; * speed hacks. ;; * delete unused variables. ;; * arrange for testing with different relative precedences of ! vs. @ ;; and %. ;; * insert documentation strings! ;; * handle X.400-gatewayed addresses according to RFC 1148. ;;; Change Log: ;; ;; Thu Feb 17 17:57:33 1994 Jamie Zawinski (jwz@lucid.com) ;; ;; * merged with jbw's latest version ;; ;; Wed Feb 9 21:56:27 1994 Jamie Zawinski (jwz@lucid.com) ;; ;; * high-bit chars in comments weren't treated as word syntax ;; ;; Sat Feb 5 03:13:40 1994 Jamie Zawinski (jwz@lucid.com) ;; ;; * call replace-match with fixed-case arg ;; ;; Thu Dec 16 21:56:45 1993 Jamie Zawinski (jwz@lucid.com) ;; ;; * some more cleanup, doc, added provide ;; ;; Tue Mar 23 21:23:18 1993 Joe Wells (jbw at csd.bu.edu) ;; ;; * Made mail-full-name-prefixes a user-customizable variable. ;; Allow passing the address as a buffer as well as as a string. ;; Allow [ and ] as name characters (Finnish character set). ;; ;; Mon Mar 22 21:20:56 1993 Joe Wells (jbw at bigbird.bu.edu) ;; ;; * Handle "null" addresses. Handle = used for spacing in mailbox ;; name. Fix bug in handling of ROUTE-ADDR-type addresses that are ;; missing their brackets. Handle uppercase "JR". Extract full ;; names from X.400 addresses encoded in RFC-822. Fix bug in ;; handling of multiple addresses where first has trailing comment. ;; Handle more kinds of telephone extension lead-ins. ;; ;; Mon Mar 22 20:16:57 1993 Joe Wells (jbw at bigbird.bu.edu) ;; ;; * Handle HZ encoding for embedding GB encoded chinese characters. ;; ;; Mon Mar 22 00:46:12 1993 Joe Wells (jbw at bigbird.bu.edu) ;; ;; * Fixed too broad matching of ham radio call signs. Fixed bug in ;; handling an unmatched ' in a name string. Enhanced recognition ;; of when . in the mailbox name terminates the name portion. ;; Narrowed conversion of . to space to only the necessary ;; situation. Deal with VMS's stupid date stamps. Handle a unique ;; way of introducing an alternate address. Fixed spacing bug I ;; introduced in switching last name order. Fixed bug in handling ;; address with ! and % but no @. Narrowed the cases in which ;; certain trailing words are discarded. ;; ;; Sun Mar 21 21:41:06 1993 Joe Wells (jbw at bigbird.bu.edu) ;; ;; * Fixed bugs in handling GROUP addresses. Certain words in the ;; middle of a name no longer terminate it. Handle LISTSERV list ;; names. Ignore comment field containing mailbox name. ;; ;; Sun Mar 21 14:39:38 1993 Joe Wells (jbw at bigbird.bu.edu) ;; ;; * Moved variant-method code back into main function. Handle ;; underscores as spaces in comments. Handle leading nickname. Add ;; flag to ignore single-word names. Other changes. ;; ;; Mon Feb 1 22:23:31 1993 Joe Wells (jbw at bigbird.bu.edu) ;; ;; * Added in changes by Rod Whitby and Jamie Zawinski. This ;; includes the flag mail-extr-guess-middle-initial and the fix for ;; handling multiple addresses correctly. (Whitby just changed ;; a > to a <.) ;; ;; Mon Apr 6 23:59:09 1992 Joe Wells (jbw at bigbird.bu.edu) ;; ;; * Cleaned up some more. Release version 1.0 to world. ;; ;; Sun Apr 5 19:39:08 1992 Joe Wells (jbw at bigbird.bu.edu) ;; ;; * Cleaned up full name extraction extensively. ;; ;; Sun Feb 2 14:45:24 1992 Joe Wells (jbw at bigbird.bu.edu) ;; ;; * Total rewrite. Integrated mail-canonicalize-address into ;; mail-extract-address-components. Now handles GROUP addresses more ;; or less correctly. Better handling of lots of different cases. ;; ;; Fri Jun 14 19:39:50 1991 ;; * Created. ;;; Code: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; User configuration variable definitions. ;; (defvar mail-extr-guess-middle-initial nil "*Whether to try to guess middle initial from mail address. If true, then when we see an address like \"John Smith \" we will assume that \"John Q. Smith\" is the fellow's name.") (defvar mail-extr-ignore-single-names t "*Whether to ignore a name that is just a single word. If true, then when we see an address like \"Idiot \" we will act as though we couldn't find a full name in the address.") ;; Matches a leading title that is not part of the name (does not ;; contribute to uniquely identifying the person). (defvar mail-extr-full-name-prefixes (purecopy "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]") "*Matches prefixes to the full name that identify a person's position. These are stripped from the full name because they do not contribute to uniquely identifying the person.") (defvar mail-extr-@-binds-tighter-than-! nil "*Whether the local mail transport agent looks at ! before @.") (defvar mail-extr-mangle-uucp nil "*Whether to throw away information in UUCP addresses by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\".") ;;---------------------------------------------------------------------- ;; what orderings are meaningful????? ;;(defvar mail-operator-precedence-list '(?! ?% ?@)) ;; Right operand of a % or a @ must be a domain name, period. No other ;; operators allowed. Left operand of a @ is an address relative to that ;; site. ;; Left operand of a ! must be a domain name. Right operand is an ;; arbitrary address. ;;---------------------------------------------------------------------- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Constant definitions. ;; ;; Codes in ;; Names in ISO 8859-1 Name ;; ISO 10XXX ISO 8859-2 in ;; ISO 6937 ISO 10646 RFC Swedish ;; etc. Hex Oct 1345 TeX Split ASCII Description ;; --------- ---------- ---- --- ----- ----- ------------------------------- ;; %a E4 344 a: \"a ae { latin small a + diaeresis d ;; %o F6 366 o: \"o oe | latin small o + diaeresis v ;; @a E5 345 aa \oa aa } latin small a + ring above e ;; %u FC 374 u: \"u ue ~ latin small u + diaeresis | ;; /e E9 351 e' \'e ` latin small e + acute i ;; %A C4 304 A: \"A AE [ latin capital a + diaeresis D ;; %O D6 326 O: \"O OE \ latin capital o + diaeresis V ;; @A C5 305 AA \oA AA ] latin capital a + ring above E ;; %U DC 334 U: \"U UE ^ latin capital u + diaeresis \ ;; /E C9 311 E' \'E @ latin capital e + acute I ;; NOTE: @a and @A are not in ISO 8859-2 (the codes mentioned above invoke ;; /l and /L). Some of this data was retrieved from ;; listserv@jhuvm.hcf.jhu.edu. ;; Any character that can occur in a name, not counting characters that ;; separate parts of a multipart name (hyphen and period). ;; Yes, there are weird people with digits in their names. ;; You will also notice the consideration for the ;; Swedish/Finnish/Norwegian character set. (defconst mail-extr-all-letters-but-separators (purecopy "][A-Za-z{|}'~0-9`\200-\377")) ;; Any character that can occur in a name in an RFC822 address including ;; the separator (hyphen and possibly period) for multipart names. ;; #### should . be in here? (defconst mail-extr-all-letters (purecopy (concat mail-extr-all-letters-but-separators "---"))) ;; Any character that can start a name. ;; Keep this set as minimal as possible. (defconst mail-extr-first-letters (purecopy "A-Za-z\200-\377")) ;; Any character that can end a name. ;; Keep this set as minimal as possible. (defconst mail-extr-last-letters (purecopy "A-Za-z\200-\377`'.")) (defconst mail-extr-leading-garbage (purecopy (format "[^%s]+" mail-extr-first-letters))) ;; (defconst mail-extr-non-name-chars ;; (purecopy (concat "^" mail-extr-all-letters "."))) ;; (defconst mail-extr-non-begin-name-chars ;; (purecopy (concat "^" mail-extr-first-letters))) ;; (defconst mail-extr-non-end-name-chars ;; (purecopy (concat "^" mail-extr-last-letters))) ;; Matches an initial not followed by both a period and a space. ;; (defconst mail-extr-bad-initials-pattern ;; (purecopy ;; (format "\\(\\([^%s]\\|\\`\\)[%s]\\)\\(\\.\\([^ ]\\)\\| \\|\\([^%s .]\\)\\|\\'\\)" ;; mail-extr-all-letters mail-extr-first-letters mail-extr-all-letters))) ;; Matches periods used instead of spaces. Must not match the period ;; following an initial. (defconst mail-extr-bad-dot-pattern (purecopy (format "\\([%s][%s]\\)\\.+\\([%s]\\)" mail-extr-all-letters mail-extr-last-letters mail-extr-first-letters))) ;; Matches an embedded or leading nickname that should be removed. ;; (defconst mail-extr-nickname-pattern ;; (purecopy ;; (format "\\([ .]\\|\\`\\)[\"'`\[\(]\\([ .%s]+\\)[\]\"'\)] " ;; mail-extr-all-letters))) ;; Matches the occurrence of a generational name suffix, and the last ;; character of the preceding name. This is important because we want to ;; keep such suffixes: they help to uniquely identify the person. ;; *** Perhaps this should be a user-customizable variable. However, the ;; *** regular expression is fairly tricky to alter, so maybe not. (defconst mail-extr-full-name-suffix-pattern (purecopy (format "\\(,? ?\\([JjSs][Rr]\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)" mail-extr-all-letters mail-extr-all-letters))) (defconst mail-extr-roman-numeral-pattern (purecopy "V?I+V?\\b")) ;; Matches a trailing uppercase (with other characters possible) acronym. ;; Must not match a trailing uppercase last name or trailing initial (defconst mail-extr-weird-acronym-pattern (purecopy "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)")) ;; Matches a mixed-case or lowercase name (not an initial). ;; #### Match Latin1 lower case letters here too? ;; (defconst mail-extr-mixed-case-name-pattern ;; (purecopy ;; (format ;; "\\b\\([a-z][%s]*[%s]\\|[%s][%s]*[a-z][%s]*[%s]\\|[%s][%s]*[a-z]\\)" ;; mail-extr-all-letters mail-extr-last-letters ;; mail-extr-first-letters mail-extr-all-letters mail-extr-all-letters ;; mail-extr-last-letters mail-extr-first-letters mail-extr-all-letters))) ;; Matches a trailing alternative address. ;; #### Match Latin1 letters here too? ;; #### Match _ before @ here too? (defconst mail-extr-alternative-address-pattern (purecopy "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]")) ;; Matches a variety of trailing comments not including comma-delimited ;; comments. (defconst mail-extr-trailing-comment-start-pattern (purecopy " [-{]\\|--\\|[+@#>, Mark Feit ;; , Michael Covington . ;; Examples: DX504 DX515 K5MRU K8DHK KA9WGN KA9WGN KD3FU KD6EUI KD6HBW ;; KE9TV KF0NV N1API N3FU N3GZE N3IGS N4KCC N7IKQ N9HHU W4YHF W6ANK WA2SUH ;; WB7VZI N2NJZ NR3G KJ4KK AB4UM AL7NI KH6OH WN3KBT N4TMI W1A N0NZO (defconst mail-extr-ham-call-sign-pattern (purecopy "\\b\\(DX[0-9]+\\|[AKNW][A-Z]?[0-9][A-Z][A-Z]?[A-Z]?\\)")) ;; Possible trailing suffixes: "\\(/\\(KT\\|A[AEG]\\|[R0-9]\\)\\)?" ;; /KT == Temporary Technician (has CSC but not "real" license) ;; /AA == Temporary Advanced ;; /AE == Temporary Extra ;; /AG == Temporary General ;; /R == repeater ;; /# == stations operating out of home district ;; I don't include these in the regexp above because I can't imagine ;; anyone putting them with their name in an e-mail address. ;; Matches normal single-part name (defconst mail-extr-normal-name-pattern (purecopy (format "\\b[%s][%s]+[%s]" mail-extr-first-letters mail-extr-all-letters-but-separators mail-extr-last-letters))) ;; Matches a single word name. ;; (defconst mail-extr-one-name-pattern ;; (purecopy (concat "\\`" mail-extr-normal-name-pattern "\\'"))) ;; Matches normal two names with missing middle initial ;; The first name is not allowed to have a hyphen because this can cause ;; false matches where the "middle initial" is actually the first letter ;; of the second part of the first name. (defconst mail-extr-two-name-pattern (purecopy (concat "\\`\\(" mail-extr-normal-name-pattern "\\|" mail-extr-initial-pattern "\\) +\\(" mail-extr-name-pattern "\\)\\(,\\|\\'\\)"))) (defconst mail-extr-listserv-list-name-pattern (purecopy "Multiple recipients of list \\([-A-Z]+\\)")) (defconst mail-extr-stupid-vms-date-stamp-pattern (purecopy "[0-9][0-9]-[JFMASOND][aepuco][nbrylgptvc]-[0-9][0-9][0-9][0-9] [0-9]+ *")) ;;; HZ -- GB (PRC Chinese character encoding) in ASCII embedding protocol ;; ;; In ASCII mode, a byte is interpreted as an ASCII character, unless a '~' is ;; encountered. The character '~' is an escape character. By convention, it ;; must be immediately followed ONLY by '~', '{' or '\n' (), with the ;; following special meaning. ;; ;; o The escape sequence '~~' is interpreted as a '~'. ;; o The escape-to-GB sequence '~{' switches the mode from ASCII to GB. ;; o The escape sequence '~\n' is a line-continuation marker to be consumed ;; with no output produced. ;; ;; In GB mode, characters are interpreted two bytes at a time as (pure) GB ;; codes until the escape-from-GB code '~}' is read. This code switches the ;; mode from GB back to ASCII. (Note that the escape-from-GB code '~}' ;; ($7E7D) is outside the defined GB range.) (defconst mail-extr-hz-embedded-gb-encoded-chinese-pattern (purecopy "~{\\([^~].\\|~[^\}]\\)+~}")) ;; The leading optional lowercase letters are for a bastardized version of ;; the encoding, as is the optional nature of the final slash. (defconst mail-extr-x400-encoded-address-pattern (purecopy "[a-z]?[a-z]?\\(/[A-Za-z]+\\(\\.[A-Za-z]+\\)?=[^/]+\\)+/?\\'")) (defconst mail-extr-x400-encoded-address-field-pattern-format (purecopy "/%s=\\([^/]+\\)\\(/\\|\\'\\)")) (defconst mail-extr-x400-encoded-address-surname-pattern ;; S stands for Surname (family name). (purecopy (format mail-extr-x400-encoded-address-field-pattern-format "[Ss]"))) (defconst mail-extr-x400-encoded-address-given-name-pattern ;; G stands for Given name. (purecopy (format mail-extr-x400-encoded-address-field-pattern-format "[Gg]"))) (defconst mail-extr-x400-encoded-address-full-name-pattern ;; PN stands for Personal Name. When used it represents the combination ;; of the G and S fields. ;; "The one system I used having this field asked it with the prompt ;; `Personal Name'. But they mapped it into G and S on outgoing real ;; X.400 addresses. As they mapped G and S into PN on incoming..." (purecopy (format mail-extr-x400-encoded-address-field-pattern-format "[Pp][Nn]"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Syntax tables used for quick parsing. ;; (defconst mail-extr-address-syntax-table (make-syntax-table)) (defconst mail-extr-address-comment-syntax-table (make-syntax-table)) (defconst mail-extr-address-domain-literal-syntax-table (make-syntax-table)) (defconst mail-extr-address-text-comment-syntax-table (make-syntax-table)) (defconst mail-extr-address-text-syntax-table (make-syntax-table)) (mapcar (function (lambda (pair) (let ((syntax-table (symbol-value (car pair)))) (mapcar (function (lambda (item) (if (eq 2 (length item)) ;; modifying syntax of a single character (modify-syntax-entry (car item) (car (cdr item)) syntax-table) ;; modifying syntax of a range of characters (let ((char (nth 0 item)) (bound (nth 1 item)) (syntax (nth 2 item))) (while (<= char bound) (modify-syntax-entry char syntax syntax-table) (setq char (1+ char))))))) (cdr pair))))) '((mail-extr-address-syntax-table (?\000 ?\037 "w") ;control characters (?\040 " ") ;SPC (?! ?~ "w") ;printable characters (?\177 "w") ;DEL (?\200 ?\377 "w") ;high-bit-on characters (?\240 " ") ;nobreakspace (?\t " ") (?\r " ") (?\n " ") (?\( ".") (?\) ".") (?< ".") (?> ".") (?@ ".") (?, ".") (?\; ".") (?: ".") (?\\ "\\") (?\" "\"") (?. ".") (?\[ ".") (?\] ".") ;; % and ! aren't RFC822 characters, but it is convenient to pretend (?% ".") (?! ".") ;; this needs to be word-constituent when not in .UUCP mode ) (mail-extr-address-comment-syntax-table (?\000 ?\377 "w") (?\040 " ") (?\240 " ") (?\t " ") (?\r " ") (?\n " ") (?\( "\(\)") (?\) "\)\(") (?\\ "\\")) (mail-extr-address-domain-literal-syntax-table (?\000 ?\377 "w") (?\040 " ") (?\240 " ") (?\t " ") (?\r " ") (?\n " ") (?\[ "\(\]") ;?????? (?\] "\)\[") ;?????? (?\\ "\\")) (mail-extr-address-text-comment-syntax-table (?\000 ?\377 "w") (?\040 " ") (?\240 " ") (?\t " ") (?\r " ") (?\n " ") (?\( "\(\)") (?\) "\)\(") (?\[ "\(\]") (?\] "\)\[") (?\{ "\(\}") (?\} "\)\{") (?\\ "\\") (?\" "\"") ;; (?\' "\)\`") ;; (?\` "\(\'") ) (mail-extr-address-text-syntax-table (?\000 ?\177 ".") (?\200 ?\377 "w") (?\040 " ") (?\t " ") (?\r " ") (?\n " ") (?A ?Z "w") (?a ?z "w") (?- "w") (?\} "w") (?\{ "w") (?| "w") (?\' "w") (?~ "w") (?0 ?9 "w")) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Utility functions and macros. ;; (defmacro mail-extr-delete-char (n) ;; in v19, delete-char is compiled as a function call, but delete-region ;; is byte-coded, so it's much much faster. (list 'delete-region '(point) (list '+ '(point) n))) (defmacro mail-extr-skip-whitespace-forward () ;; v19 fn skip-syntax-forward is more tasteful, but not byte-coded. '(skip-chars-forward " \t\n\r\240")) (defmacro mail-extr-skip-whitespace-backward () ;; v19 fn skip-syntax-backward is more tasteful, but not byte-coded. '(skip-chars-backward " \t\n\r\240")) (defmacro mail-extr-undo-backslash-quoting (beg end) (`(save-excursion (save-restriction (narrow-to-region (, beg) (, end)) (goto-char (point-min)) ;; undo \ quoting (while (search-forward "\\" nil t) (mail-extr-delete-char -1) (or (eobp) (forward-char 1)) ))))) (defmacro mail-extr-nuke-char-at (pos) (` (save-excursion (goto-char (, pos)) (mail-extr-delete-char 1) (insert ?\ )))) (put 'mail-extr-nuke-outside-range 'edebug-form-spec '(symbolp &optional form form atom)) (defmacro mail-extr-nuke-outside-range (list-symbol beg-symbol end-symbol &optional no-replace) ;; LIST-SYMBOL names a variable holding a list of buffer positions ;; BEG-SYMBOL and END-SYMBOL name variables delimiting a range ;; Each element of LIST-SYMBOL which lies outside of the range is ;; deleted from the list. ;; Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL ;; which lie outside of the range, one character at that position is ;; replaced with a SPC. (or (memq no-replace '(t nil)) (error "no-replace must be t or nil, evalable at macroexpand-time.")) (` (let ((temp (, list-symbol)) ch) (while temp (setq ch (car temp)) (cond ((or (> ch (, end-symbol)) (< ch (, beg-symbol))) (,@ (if no-replace nil (` ((mail-extr-nuke-char-at ch))))) (setcar temp nil))) (setq temp (cdr temp))) (setq (, list-symbol) (delq nil (, list-symbol)))))) (defun mail-extr-demarkerize (marker) ;; if arg is a marker, destroys the marker, then returns the old value. ;; otherwise returns the arg. (if (markerp marker) (let ((temp (marker-position marker))) (set-marker marker nil) temp) marker)) (defun mail-extr-markerize (pos) ;; coerces pos to a marker if non-nil. (if (or (markerp pos) (null pos)) pos (copy-marker pos))) (defmacro mail-extr-last (list) ;; Returns last element of LIST. ;; Could be a subst. (` (let ((list (, list))) (while (not (null (cdr list))) (setq list (cdr list))) (car list)))) (defmacro mail-extr-safe-move-sexp (arg) ;; Safely skip over one balanced sexp, if there is one. Return t if success. (` (condition-case error (progn (goto-char (scan-sexps (point) (, arg))) t) (error ;; #### kludge kludge kludge kludge kludge kludge kludge !!! (if (string-equal (nth 1 error) "Unbalanced parentheses") nil (while t (signal (car error) (cdr error)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; The main function to grind addresses ;; (defvar disable-initial-guessing-flag) ; dynamic assignment (defvar cbeg) ; dynamic assignment (defvar cend) ; dynamic assignment ;;;###autoload (defun mail-extract-address-components (address) "Given an RFC-822 ADDRESS, extract full name and canonical address. Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). If no name can be extracted, FULL-NAME will be nil. ADDRESS may be a string or a buffer. If it is a buffer, the visible (narrowed) portion of the buffer will be interpreted as the address. (This feature exists so that the clever caller might be able to avoid consing a string.) If ADDRESS contains more than one RFC-822 address, only the first is returned. Some day this function may be extended to extract multiple addresses, or perhaps return the position at which parsing stopped." (let ((canonicalization-buffer (get-buffer-create " *canonical address*")) (extraction-buffer (get-buffer-create " *extract address components*")) char ;; multiple-addresses <-pos >-pos @-pos :-pos ,-pos !-pos %-pos \;-pos group-:-pos group-\;-pos route-addr-:-pos record-pos-symbol first-real-pos last-real-pos phrase-beg phrase-end cbeg cend ; dynamically set from -voodoo quote-beg quote-end atom-beg atom-end mbox-beg mbox-end \.-ends-name temp ;; name-suffix fi mi li ; first, middle, last initial saved-%-pos saved-!-pos saved-@-pos domain-pos \.-pos insert-point ;; mailbox-name-processed-flag disable-initial-guessing-flag ; dynamically set from -voodoo ) (save-excursion (set-buffer extraction-buffer) (fundamental-mode) (kill-all-local-variables) (buffer-disable-undo extraction-buffer) (set-syntax-table mail-extr-address-syntax-table) (widen) (erase-buffer) (setq case-fold-search nil) ;; Insert extra space at beginning to allow later replacement with < ;; without having to move markers. (insert ?\ ) ;; Insert the address itself. (cond ((stringp address) (insert address)) ((bufferp address) (insert-buffer-substring address)) (t (error "Illegal address: %s" address))) ;; stolen from rfc822.el ;; Unfold multiple lines. (goto-char (point-min)) (while (re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ \t]" nil t) (replace-match "\\1 " t)) ;; first pass grabs useful information about address (goto-char (point-min)) (while (progn (mail-extr-skip-whitespace-forward) (not (eobp))) (setq char (char-after (point))) (or first-real-pos (if (not (eq char ?\()) (setq first-real-pos (point)))) (cond ;; comment ((eq char ?\() (set-syntax-table mail-extr-address-comment-syntax-table) ;; only record the first non-empty comment's position (if (and (not cbeg) (save-excursion (forward-char 1) (mail-extr-skip-whitespace-forward) (not (eq ?\) (char-after (point)))))) (setq cbeg (point))) ;; TODO: don't record if unbalanced (or (mail-extr-safe-move-sexp 1) (forward-char 1)) (set-syntax-table mail-extr-address-syntax-table) (if (and cbeg (not cend)) (setq cend (point)))) ;; quoted text ((eq char ?\") ;; only record the first non-empty quote's position (if (and (not quote-beg) (save-excursion (forward-char 1) (mail-extr-skip-whitespace-forward) (not (eq ?\" (char-after (point)))))) (setq quote-beg (point))) ;; TODO: don't record if unbalanced (or (mail-extr-safe-move-sexp 1) (forward-char 1)) (if (and quote-beg (not quote-end)) (setq quote-end (point)))) ;; domain literals ((eq char ?\[) (set-syntax-table mail-extr-address-domain-literal-syntax-table) (or (mail-extr-safe-move-sexp 1) (forward-char 1)) (set-syntax-table mail-extr-address-syntax-table)) ;; commas delimit addresses when outside < > pairs. ((and (eq char ?,) (or (and (null <-pos) ;; Handle ROUTE-ADDR address that is missing its <. (not (eq ?@ (char-after (1+ (point)))))) (and >-pos ;; handle weird munged addresses ;; BUG FIX: This test was reversed. Thanks to the ;; brilliant Rod Whitby ;; for discovering this! (< (mail-extr-last <-pos) (car >-pos))))) ;; It'd be great if some day this worked, but for now, punt. ;; (setq multiple-addresses t) ;; ;; *** Why do I want this: ;; (mail-extr-delete-char 1) ;; (narrow-to-region (point-min) (point)) (delete-region (point) (point-max)) (setq char ?\() ; HAVE I NO SHAME?? ) ;; record the position of various interesting chars, determine ;; legality later. ((setq record-pos-symbol (cdr (assq char '((?< . <-pos) (?> . >-pos) (?@ . @-pos) (?: . :-pos) (?, . ,-pos) (?! . !-pos) (?% . %-pos) (?\; . \;-pos))))) (set record-pos-symbol (cons (point) (symbol-value record-pos-symbol))) (forward-char 1)) ((eq char ?.) (forward-char 1)) ((memq char '( ;; comment terminator illegal ?\) ;; domain literal terminator illegal ?\] ;; \ allowed only within quoted strings, ;; domain literals, and comments ?\\ )) (mail-extr-nuke-char-at (point)) (forward-char 1)) (t (forward-word 1))) (or (eq char ?\() ;; At the end of first address of a multiple address header. (and (eq char ?,) (eobp)) (setq last-real-pos (point)))) ;; Use only the leftmost <, if any. Replace all others with spaces. (while (cdr <-pos) (mail-extr-nuke-char-at (car <-pos)) (setq <-pos (cdr <-pos))) ;; Use only the rightmost >, if any. Replace all others with spaces. (while (cdr >-pos) (mail-extr-nuke-char-at (nth 1 >-pos)) (setcdr >-pos (nthcdr 2 >-pos))) ;; If multiple @s and a :, but no < and >, insert around buffer. ;; Example: @foo.bar.dom,@xxx.yyy.zzz:mailbox@aaa.bbb.ccc ;; This commonly happens on the UUCP "From " line. Ugh. (cond ((and (> (length @-pos) 1) (eq 1 (length :-pos)) ;TODO: check if between last two @s (not \;-pos) (not <-pos)) (goto-char (point-min)) (mail-extr-delete-char 1) (setq <-pos (list (point))) (insert ?<))) ;; If < but no >, insert > in rightmost possible position (cond ((and <-pos (null >-pos)) (goto-char (point-max)) (setq >-pos (list (point))) (insert ?>))) ;; If > but no <, replace > with space. (cond ((and >-pos (null <-pos)) (mail-extr-nuke-char-at (car >-pos)) (setq >-pos nil))) ;; Turn >-pos and <-pos into non-lists (setq >-pos (car >-pos) <-pos (car <-pos)) ;; Trim other punctuation lists of items outside < > pair to handle ;; stupid MTAs. (cond (<-pos ; don't need to check >-pos also ;; handle bozo software that violates RFC 822 by sticking ;; punctuation marks outside of a < > pair (mail-extr-nuke-outside-range @-pos <-pos >-pos t) ;; RFC 822 says nothing about these two outside < >, but ;; remove those positions from the lists to make things ;; easier. (mail-extr-nuke-outside-range !-pos <-pos >-pos t) (mail-extr-nuke-outside-range %-pos <-pos >-pos t))) ;; Check for : that indicates GROUP list and for : part of ;; ROUTE-ADDR spec. ;; Can't possibly be more than two :. Nuke any extra. (while :-pos (setq temp (car :-pos) :-pos (cdr :-pos)) (cond ((and <-pos >-pos (> temp <-pos) (< temp >-pos)) (if (or route-addr-:-pos (< (length @-pos) 2) (> temp (car @-pos)) (< temp (nth 1 @-pos))) (mail-extr-nuke-char-at temp) (setq route-addr-:-pos temp))) ((or (not <-pos) (and <-pos (< temp <-pos))) (setq group-:-pos temp)))) ;; Nuke any ; that is in or to the left of a < > pair or to the left ;; of a GROUP starting :. Also, there may only be one ;. (while \;-pos (setq temp (car \;-pos) \;-pos (cdr \;-pos)) (cond ((and <-pos >-pos (> temp <-pos) (< temp >-pos)) (mail-extr-nuke-char-at temp)) ((and (or (not group-:-pos) (> temp group-:-pos)) (not group-\;-pos)) (setq group-\;-pos temp)))) ;; Nuke unmatched GROUP syntax characters. (cond ((and group-:-pos (not group-\;-pos)) ;; *** Do I really need to erase it? (mail-extr-nuke-char-at group-:-pos) (setq group-:-pos nil))) (cond ((and group-\;-pos (not group-:-pos)) ;; *** Do I really need to erase it? (mail-extr-nuke-char-at group-\;-pos) (setq group-\;-pos nil))) ;; Handle junk like ";@host.company.dom" that sendmail adds. ;; **** should I remember comment positions? (cond (group-\;-pos ;; this is fine for now (mail-extr-nuke-outside-range !-pos group-:-pos group-\;-pos t) (mail-extr-nuke-outside-range @-pos group-:-pos group-\;-pos t) (mail-extr-nuke-outside-range %-pos group-:-pos group-\;-pos t) (mail-extr-nuke-outside-range ,-pos group-:-pos group-\;-pos t) (and last-real-pos (> last-real-pos (1+ group-\;-pos)) (setq last-real-pos (1+ group-\;-pos))) ;; *** This may be wrong: (and cend (> cend group-\;-pos) (setq cend nil cbeg nil)) (and quote-end (> quote-end group-\;-pos) (setq quote-end nil quote-beg nil)) ;; This was both wrong and unnecessary: ;;(narrow-to-region (point-min) group-\;-pos) ;; *** The entire handling of GROUP addresses seems rather lame. ;; *** It deserves a complete rethink, except that these addresses ;; *** are hardly ever seen. )) ;; Any commas must be between < and : of ROUTE-ADDR. Nuke any ;; others. ;; Hell, go ahead an nuke all of the commas. ;; **** This will cause problems when we start handling commas in ;; the PHRASE part .... no it won't ... yes it will ... ????? (mail-extr-nuke-outside-range ,-pos 1 1) ;; can only have multiple @s inside < >. The fact that some MTAs ;; put de-bracketed ROUTE-ADDRs in the UUCP-style "From " line is ;; handled above. ;; Locate PHRASE part of ROUTE-ADDR. (cond (<-pos (goto-char <-pos) (mail-extr-skip-whitespace-backward) (setq phrase-end (point)) (goto-char (or ;;group-:-pos (point-min))) (mail-extr-skip-whitespace-forward) (if (< (point) phrase-end) (setq phrase-beg (point)) (setq phrase-end nil)))) ;; handle ROUTE-ADDRS with real ROUTEs. ;; If there are multiple @s, then we assume ROUTE-ADDR syntax, and ;; any % or ! must be semantically meaningless. ;; TODO: do this processing into canonicalization buffer (cond (route-addr-:-pos (setq !-pos nil %-pos nil >-pos (copy-marker >-pos) route-addr-:-pos (copy-marker route-addr-:-pos)) (goto-char >-pos) (insert-before-markers ?X) (goto-char (car @-pos)) (while (setq @-pos (cdr @-pos)) (mail-extr-delete-char 1) (setq %-pos (cons (point-marker) %-pos)) (insert "%") (goto-char (1- >-pos)) (save-excursion (insert-buffer-substring extraction-buffer (car @-pos) route-addr-:-pos) (delete-region (car @-pos) route-addr-:-pos)) (or (cdr @-pos) (setq saved-@-pos (list (point))))) (setq @-pos saved-@-pos) (goto-char >-pos) (mail-extr-delete-char -1) (mail-extr-nuke-char-at route-addr-:-pos) (mail-extr-demarkerize route-addr-:-pos) (setq route-addr-:-pos nil >-pos (mail-extr-demarkerize >-pos) %-pos (mapcar 'mail-extr-demarkerize %-pos)))) ;; de-listify @-pos (setq @-pos (car @-pos)) ;; TODO: remove comments in the middle of an address (set-buffer canonicalization-buffer) (fundamental-mode) (kill-all-local-variables) (buffer-disable-undo canonicalization-buffer) (set-syntax-table mail-extr-address-syntax-table) (setq case-fold-search nil) (widen) (erase-buffer) (insert-buffer-substring extraction-buffer) (if <-pos (narrow-to-region (progn (goto-char (1+ <-pos)) (mail-extr-skip-whitespace-forward) (point)) >-pos) (if (and first-real-pos last-real-pos) (narrow-to-region first-real-pos last-real-pos) ;; ****** Oh no! What if the address is completely empty! ;; *** Is this correct? (narrow-to-region (point-max) (point-max)) )) (and @-pos %-pos (mail-extr-nuke-outside-range %-pos (point-min) @-pos)) (and %-pos !-pos (mail-extr-nuke-outside-range !-pos (point-min) (car %-pos))) (and @-pos !-pos (not %-pos) (mail-extr-nuke-outside-range !-pos (point-min) @-pos)) ;; Error condition:?? (and %-pos (not @-pos)) ;; WARNING: THIS CODE IS DUPLICATED BELOW. (cond ((and %-pos (not @-pos)) (goto-char (car %-pos)) (mail-extr-delete-char 1) (setq @-pos (point)) (insert "@") (setq %-pos (cdr %-pos)))) (if mail-extr-mangle-uucp (cond (!-pos ;; **** I don't understand this save-restriction and the ;; narrow-to-region inside it. Why did I do that? (save-restriction (cond ((and @-pos mail-extr-@-binds-tighter-than-!) (goto-char @-pos) (setq %-pos (cons (point) %-pos) @-pos nil) (mail-extr-delete-char 1) (insert "%") (setq insert-point (point-max))) (mail-extr-@-binds-tighter-than-! (setq insert-point (point-max))) (%-pos (setq insert-point (mail-extr-last %-pos) saved-%-pos (mapcar 'mail-extr-markerize %-pos) %-pos nil @-pos (mail-extr-markerize @-pos))) (@-pos (setq insert-point @-pos) (setq @-pos (mail-extr-markerize @-pos))) (t (setq insert-point (point-max)))) (narrow-to-region (point-min) insert-point) (setq saved-!-pos (car !-pos)) (while !-pos (goto-char (point-max)) (cond ((and (not @-pos) (not (cdr !-pos))) (setq @-pos (point)) (insert-before-markers "@ ")) (t (setq %-pos (cons (point) %-pos)) (insert-before-markers "% "))) (backward-char 1) (insert-buffer-substring (current-buffer) (if (nth 1 !-pos) (1+ (nth 1 !-pos)) (point-min)) (car !-pos)) (mail-extr-delete-char 1) (or (save-excursion (mail-extr-safe-move-sexp -1) (mail-extr-skip-whitespace-backward) (eq ?. (preceding-char))) (insert-before-markers (if (save-excursion (mail-extr-skip-whitespace-backward) (eq ?. (preceding-char))) "" ".") "uucp")) (setq !-pos (cdr !-pos)))) (and saved-%-pos (setq %-pos (append (mapcar 'mail-extr-demarkerize saved-%-pos) %-pos))) (setq @-pos (mail-extr-demarkerize @-pos)) (narrow-to-region (1+ saved-!-pos) (point-max))))) ;; WARNING: THIS CODE IS DUPLICATED ABOVE. (cond ((and %-pos (not @-pos)) (goto-char (car %-pos)) (mail-extr-delete-char 1) (setq @-pos (point)) (insert "@") (setq %-pos (cdr %-pos)))) (setq %-pos (nreverse %-pos)) ;; RFC 1034 doesn't approve of this, oh well: (downcase-region (or (car %-pos) @-pos (point-max)) (point-max)) (cond (%-pos ; implies @-pos valid (setq temp %-pos) (catch 'truncated (while temp (goto-char (or (nth 1 temp) @-pos)) (mail-extr-skip-whitespace-backward) (save-excursion (mail-extr-safe-move-sexp -1) (setq domain-pos (point)) (mail-extr-skip-whitespace-backward) (setq \.-pos (eq ?. (preceding-char)))) (cond ((and \.-pos ;; #### string consing (let ((s (intern-soft (buffer-substring domain-pos (point)) mail-extr-all-top-level-domains))) (and s (get s 'domain-name)))) (narrow-to-region (point-min) (point)) (goto-char (car temp)) (mail-extr-delete-char 1) (setq @-pos (point)) (setcdr temp nil) (setq %-pos (delq @-pos %-pos)) (insert "@") (throw 'truncated t))) (setq temp (cdr temp)))))) (setq mbox-beg (point-min) mbox-end (if %-pos (car %-pos) (or @-pos (point-max)))) ;; Done canonicalizing address. (set-buffer extraction-buffer) ;; Decide what part of the address to search to find the full name. (cond ( ;; Example: "First M. Last" (and phrase-beg (eq quote-beg phrase-beg) (<= quote-end phrase-end)) (narrow-to-region (1+ quote-beg) (1- quote-end)) (mail-extr-undo-backslash-quoting (point-min) (point-max))) ;; Example: First Last (phrase-beg (narrow-to-region phrase-beg phrase-end)) ;; Example: fml@foo.bar.dom (First M. Last) (cbeg (narrow-to-region (1+ cbeg) (1- cend)) (mail-extr-undo-backslash-quoting (point-min) (point-max)) ;; Deal with spacing problems (goto-char (point-min)) ; (cond ((not (search-forward " " nil t)) ; (goto-char (point-min)) ; (cond ((search-forward "_" nil t) ; ;; Handle the *idiotic* use of underlines as spaces. ; ;; Example: fml@foo.bar.dom (First_M._Last) ; (goto-char (point-min)) ; (while (search-forward "_" nil t) ; (replace-match " " t))) ; ((search-forward "." nil t) ; ;; Fix . used as space ; ;; Example: danj1@cb.att.com (daniel.jacobson) ; (goto-char (point-min)) ; (while (re-search-forward mail-extr-bad-dot-pattern nil t) ; (replace-match "\\1 \\2" t)))))) ) ;; Otherwise we try to get the name from the mailbox portion ;; of the address. ;; Example: First_M_Last@foo.bar.dom (t ;; *** Work in canon buffer instead? No, can't. Hmm. (goto-char (point-max)) (narrow-to-region (point) (point)) (insert-buffer-substring canonicalization-buffer mbox-beg mbox-end) (goto-char (point-min)) ;; Example: First_Last.XXX@foo.bar.dom (setq \.-ends-name (re-search-forward "[_0-9]" nil t)) (goto-char (point-min)) (if (not mail-extr-mangle-uucp) (modify-syntax-entry ?! "w" (syntax-table))) (while (progn (mail-extr-skip-whitespace-forward) (not (eobp))) (setq char (char-after (point))) (cond ((eq char ?\") (setq quote-beg (point)) (or (mail-extr-safe-move-sexp 1) ;; TODO: handle this error condition!!!!! (forward-char 1)) ;; take into account deletions (setq quote-end (- (point) 2)) (save-excursion (backward-char 1) (mail-extr-delete-char 1) (goto-char quote-beg) (mail-extr-delete-char 1)) (mail-extr-undo-backslash-quoting quote-beg quote-end) (or (eq ?\ (char-after (point))) (insert " ")) ;; (setq mailbox-name-processed-flag t) (setq \.-ends-name t)) ((eq char ?.) (if (memq (char-after (1+ (point))) '(?_ ?=)) (progn (forward-char 1) (mail-extr-delete-char 1) (insert ?\ )) (if \.-ends-name (narrow-to-region (point-min) (point)) (mail-extr-delete-char 1) (insert " "))) ;; (setq mailbox-name-processed-flag t) ) ((memq (char-syntax char) '(?. ?\\)) (mail-extr-delete-char 1) (insert " ") ;; (setq mailbox-name-processed-flag t) ) (t (setq atom-beg (point)) (forward-word 1) (setq atom-end (point)) (goto-char atom-beg) (save-restriction (narrow-to-region atom-beg atom-end) (cond ;; Handle X.400 addresses encoded in RFC-822. ;; *** Shit! This has to handle the case where it is ;; *** embedded in a quote too! ;; *** Shit! The input is being broken up into atoms ;; *** by periods! ((looking-at mail-extr-x400-encoded-address-pattern) ;; Copy the contents of the individual fields that ;; might hold name data to the beginning. (mapcar (function (lambda (field-pattern) (cond ((save-excursion (re-search-forward field-pattern nil t)) (insert-buffer-substring (current-buffer) (match-beginning 1) (match-end 1)) (insert " "))))) (list mail-extr-x400-encoded-address-given-name-pattern mail-extr-x400-encoded-address-surname-pattern mail-extr-x400-encoded-address-full-name-pattern)) ;; Discard the rest, since it contains stuff like ;; routing information, not part of a name. (mail-extr-skip-whitespace-backward) (delete-region (point) (point-max)) ;; Handle periods used for spacing. (while (re-search-forward mail-extr-bad-dot-pattern nil t) (replace-match "\\1 \\2" t)) ;; (setq mailbox-name-processed-flag t) ) ;; Handle normal addresses. (t (goto-char (point-min)) ;; Handle _ and = used for spacing. (while (re-search-forward "\\([^_=]+\\)[_=]" nil t) (replace-match "\\1 " t) ;; (setq mailbox-name-processed-flag t) ) (goto-char (point-max)))))))) ;; undo the dirty deed (if (not mail-extr-mangle-uucp) (modify-syntax-entry ?! "." (syntax-table))) ;; ;; If we derived the name from the mailbox part of the address, ;; and we only got one word out of it, don't treat that as a ;; name. "foo@bar" --> (nil "foo@bar"), not ("foo" "foo@bar") ;; (if (not mailbox-name-processed-flag) ;; (delete-region (point-min) (point-max))) )) (set-syntax-table mail-extr-address-text-syntax-table) (mail-extr-voodoo mbox-beg mbox-end canonicalization-buffer) (goto-char (point-min)) ;; If name is "First Last" and userid is "F?L", then assume ;; the middle initial is the second letter in the userid. ;; Initial code by Jamie Zawinski ;; *** Make it work when there's a suffix as well. (goto-char (point-min)) (cond ((and mail-extr-guess-middle-initial (not disable-initial-guessing-flag) (eq 3 (- mbox-end mbox-beg)) (progn (goto-char (point-min)) (looking-at mail-extr-two-name-pattern))) (setq fi (char-after (match-beginning 0)) li (char-after (match-beginning 3))) (save-excursion (set-buffer canonicalization-buffer) ;; char-equal is ignoring case here, so no need to upcase ;; or downcase. (let ((case-fold-search t)) (and (char-equal fi (char-after mbox-beg)) (char-equal li (char-after (1- mbox-end))) (setq mi (char-after (1+ mbox-beg)))))) (cond ((and mi ;; TODO: use better table than syntax table (eq ?w (char-syntax mi))) (goto-char (match-beginning 3)) (insert (upcase mi) ". "))))) ;; Nuke name if it is the same as mailbox name. (let ((buffer-length (- (point-max) (point-min))) (i 0) (names-match-flag t)) (cond ((and (> buffer-length 0) (eq buffer-length (- mbox-end mbox-beg))) (goto-char (point-max)) (insert-buffer-substring canonicalization-buffer mbox-beg mbox-end) (while (and names-match-flag (< i buffer-length)) (or (eq (downcase (char-after (+ i (point-min)))) (downcase (char-after (+ i buffer-length (point-min))))) (setq names-match-flag nil)) (setq i (1+ i))) (delete-region (+ (point-min) buffer-length) (point-max)) (if names-match-flag (narrow-to-region (point) (point)))))) ;; Nuke name if it's just one word. (goto-char (point-min)) (and mail-extr-ignore-single-names (not (re-search-forward "[- ]" nil t)) (narrow-to-region (point) (point))) ;; Result (list (if (not (= (point-min) (point-max))) (buffer-string)) (progn (set-buffer canonicalization-buffer) (if (not (= (point-min) (point-max))) (buffer-string)))) ))) (defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer) (let ((word-count 0) (case-fold-search nil) mixed-case-flag lower-case-flag ;;upper-case-flag suffix-flag last-name-comma-flag ;;cbeg cend initial begin-again-flag drop-this-word-if-trailing-flag drop-last-word-if-trailing-flag word-found-flag this-word-beg last-word-beg name-beg name-end name-done-flag ) (save-excursion (set-syntax-table mail-extr-address-text-syntax-table) ;; This was moved above. ;; Fix . used as space ;; But it belongs here because it occurs not only as ;; rypens@reks.uia.ac.be (Piet.Rypens) ;; but also as ;; "Piet.Rypens" ;;(goto-char (point-min)) ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t) ;; (replace-match "\\1 \\2" t)) (cond ((not (search-forward " " nil t)) (goto-char (point-min)) (cond ((search-forward "_" nil t) ;; Handle the *idiotic* use of underlines as spaces. ;; Example: fml@foo.bar.dom (First_M._Last) (goto-char (point-min)) (while (search-forward "_" nil t) (replace-match " " t))) ((search-forward "." nil t) ;; Fix . used as space ;; Example: danj1@cb.att.com (daniel.jacobson) (goto-char (point-min)) (while (re-search-forward mail-extr-bad-dot-pattern nil t) (replace-match "\\1 \\2" t)))))) ;; Loop over the words (and other junk) in the name. (goto-char (point-min)) (while (not name-done-flag) (cond (word-found-flag ;; Last time through this loop we skipped over a word. (setq last-word-beg this-word-beg) (setq drop-last-word-if-trailing-flag drop-this-word-if-trailing-flag) (setq word-found-flag nil))) (cond (begin-again-flag ;; Last time through the loop we found something that ;; indicates we should pretend we are beginning again from ;; the start. (setq word-count 0) (setq last-word-beg nil) (setq drop-last-word-if-trailing-flag nil) (setq mixed-case-flag nil) (setq lower-case-flag nil) ;; (setq upper-case-flag nil) (setq begin-again-flag nil) )) ;; Initialize for this iteration of the loop. (mail-extr-skip-whitespace-forward) (if (eq word-count 0) (narrow-to-region (point) (point-max))) (setq this-word-beg (point)) (setq drop-this-word-if-trailing-flag nil) ;; Decide what to do based on what we are looking at. (cond ;; Delete title ((and (eq word-count 0) (looking-at mail-extr-full-name-prefixes)) (goto-char (match-end 0)) (narrow-to-region (point) (point-max))) ;; Stop after name suffix ((and (>= word-count 2) (looking-at mail-extr-full-name-suffix-pattern)) (mail-extr-skip-whitespace-backward) (setq suffix-flag (point)) (if (eq ?, (following-char)) (forward-char 1) (insert ?,)) ;; Enforce at least one space after comma (or (eq ?\ (following-char)) (insert ?\ )) (mail-extr-skip-whitespace-forward) (cond ((memq (following-char) '(?j ?J ?s ?S)) (capitalize-word 1) (if (eq (following-char) ?.) (forward-char 1) (insert ?.))) (t (upcase-word 1))) (setq word-found-flag t) (setq name-done-flag t)) ;; Handle SCA names ((looking-at "MKA \\(.+\\)") ; "Mundanely Known As" (goto-char (match-beginning 1)) (narrow-to-region (point) (point-max)) (setq begin-again-flag t)) ;; Check for initial last name followed by comma ((and (eq ?, (following-char)) (eq word-count 1)) (forward-char 1) (setq last-name-comma-flag t) (or (eq ?\ (following-char)) (insert ?\ ))) ;; Stop before trailing comma-separated comment ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. ;; *** This case is redundant??? ;;((eq ?, (following-char)) ;; (setq name-done-flag t)) ;; Delete parenthesized/quoted comment/nickname ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`)) (setq cbeg (point)) (set-syntax-table mail-extr-address-text-comment-syntax-table) (cond ((memq (following-char) '(?\' ?\`)) (or (search-forward "'" nil t (if (eq ?\' (following-char)) 2 1)) (mail-extr-delete-char 1))) (t (or (mail-extr-safe-move-sexp 1) (goto-char (point-max))))) (set-syntax-table mail-extr-address-text-syntax-table) (setq cend (point)) (cond ;; Handle case of entire name being quoted ((and (eq word-count 0) (looking-at " *\\'") (>= (- cend cbeg) 2)) (narrow-to-region (1+ cbeg) (1- cend)) (goto-char (point-min))) (t ;; Handle case of quoted initial (if (and (or (= 3 (- cend cbeg)) (and (= 4 (- cend cbeg)) (eq ?. (char-after (+ 2 cbeg))))) (not (looking-at " *\\'"))) (setq initial (char-after (1+ cbeg))) (setq initial nil)) (delete-region cbeg cend) (if initial (insert initial ". "))))) ;; Handle & substitution ((and (or (bobp) (eq ?\ (preceding-char))) (looking-at "&\\( \\|\\'\\)")) (mail-extr-delete-char 1) (capitalize-region (point) (progn (insert-buffer-substring canonicalization-buffer mbox-beg mbox-end) (point))) (setq disable-initial-guessing-flag t) (setq word-found-flag t)) ;; Handle *Stupid* VMS date stamps ((looking-at mail-extr-stupid-vms-date-stamp-pattern) (replace-match "" t)) ;; Handle Chinese characters. ((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern) (goto-char (match-end 0)) (setq word-found-flag t)) ;; Skip initial garbage characters. ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. ((and (eq word-count 0) (looking-at mail-extr-leading-garbage)) (goto-char (match-end 0)) ;; *** Skip backward over these??? ;; (skip-chars-backward "& \"") (narrow-to-region (point) (point-max))) ;; Various stopping points ((or ;; Stop before ALL CAPS acronyms, if preceded by mixed-case ;; words. Example: XT-DEM. (and (>= word-count 2) mixed-case-flag (looking-at mail-extr-weird-acronym-pattern) (not (looking-at mail-extr-roman-numeral-pattern))) ;; Stop before trailing alternative address (looking-at mail-extr-alternative-address-pattern) ;; Stop before trailing comment not introduced by comma ;; THIS CASE MUST BE AFTER AN EARLIER CASE. (looking-at mail-extr-trailing-comment-start-pattern) ;; Stop before telephone numbers (looking-at mail-extr-telephone-extension-pattern)) (setq name-done-flag t)) ;; Delete ham radio call signs ((looking-at mail-extr-ham-call-sign-pattern) (delete-region (match-beginning 0) (match-end 0))) ;; Fixup initials ((looking-at mail-extr-initial-pattern) (or (eq (following-char) (upcase (following-char))) (setq lower-case-flag t)) (forward-char 1) (if (eq ?. (following-char)) (forward-char 1) (insert ?.)) (or (eq ?\ (following-char)) (insert ?\ )) (setq word-found-flag t)) ;; Handle BITNET LISTSERV list names. ((and (eq word-count 0) (looking-at mail-extr-listserv-list-name-pattern)) (narrow-to-region (match-beginning 1) (match-end 1)) (setq word-found-flag t) (setq name-done-flag t)) ;; Regular name words ((looking-at mail-extr-name-pattern) (setq name-beg (point)) (setq name-end (match-end 0)) ;; Certain words will be dropped if they are at the end. (and (>= word-count 2) (not lower-case-flag) (or ;; A trailing 4-or-more letter lowercase words preceded by ;; mixed case or uppercase words will be dropped. (looking-at "[a-z][a-z][a-z][a-z]+[ \t]*\\'") ;; Drop a trailing word which is terminated with a period. (eq ?. (char-after (1- name-end)))) (setq drop-this-word-if-trailing-flag t)) ;; Set the flags that indicate whether we have seen a lowercase ;; word, a mixed case word, and an uppercase word. (if (re-search-forward "[a-z]" name-end t) (if (progn (goto-char name-beg) (re-search-forward "[A-Z]" name-end t)) (setq mixed-case-flag t) (setq lower-case-flag t)) ;; (setq upper-case-flag t) ) (goto-char name-end) (setq word-found-flag t)) (t (setq name-done-flag t) )) ;; Count any word that we skipped over. (if word-found-flag (setq word-count (1+ word-count)))) ;; If the last thing in the name is 2 or more periods, or one or more ;; other sentence terminators (but not a single period) then keep them ;; and the preceeding word. This is for the benefit of whole sentences ;; in the name field: it's better behavior than dropping the last word ;; of the sentence... (if (and (not suffix-flag) (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'")) (goto-char (setq suffix-flag (point-max)))) ;; Drop everything after point and certain trailing words. (narrow-to-region (point-min) (or (and drop-last-word-if-trailing-flag last-word-beg) (point))) ;; Xerox's mailers SUCK!!!!!! ;; We simply refuse to believe that any last name is PARC or ADOC. ;; If it looks like that is the last name, that there is no meaningful ;; here at all. Actually I guess it would be best to map patterns ;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't ;; actually know that that is what's going on. (cond ((not suffix-flag) (goto-char (point-min)) (let ((case-fold-search t)) (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'") (erase-buffer))))) ;; If last name first put it at end (but before suffix) (cond (last-name-comma-flag (goto-char (point-min)) (search-forward ",") (setq name-end (1- (point))) (goto-char (or suffix-flag (point-max))) (or (eq ?\ (preceding-char)) (insert ?\ )) (insert-buffer-substring (current-buffer) (point-min) name-end) (goto-char name-end) (skip-chars-forward "\t ,") (narrow-to-region (point) (point-max)))) ;; Delete leading and trailing junk characters. ;; *** This is probably completly unneeded now. ;;(goto-char (point-max)) ;;(skip-chars-backward mail-extr-non-end-name-chars) ;;(if (eq ?. (following-char)) ;; (forward-char 1)) ;;(narrow-to-region (point) ;; (progn ;; (goto-char (point-min)) ;; (skip-chars-forward mail-extr-non-begin-name-chars) ;; (point))) ;; Compress whitespace (goto-char (point-min)) (while (re-search-forward "[ \t\n]+" nil t) (replace-match (if (eobp) "" " ") t)) ))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Table of top-level domain names. ;; ;; This is used during address canonicalization; be careful of format changes. ;; Keep in mind that the country abbreviations follow ISO-3166. There is ;; a U.S. FIPS that specifies a different set of two-letter country ;; abbreviations. (defconst mail-extr-all-top-level-domains (let ((ob (make-vector 509 0))) (mapcar (function (lambda (x) (put (intern (downcase (car x)) ob) 'domain-name (if (nth 2 x) (format (nth 2 x) (nth 1 x)) (nth 1 x))))) '( ;; ISO 3166 codes: ("ae" "United Arab Emirates") ("ag" "Antigua and Barbuda") ("al" "Albania") ("ao" "Angola") ("aq" "Antarctica") ; continent ("ar" "Argentina" "Argentine Republic") ("at" "Austria" "The Republic of %s") ("au" "Australia") ("az" "Azerbaijan") ("bb" "Barbados") ("bd" "Bangladesh") ("be" "Belgium" "The Kingdom of %s") ("bf" "Burkina Faso") ("bg" "Bulgaria") ("bh" "Bahrain") ("bm" "Bermuda") ("bo" "Bolivia" "Republic of %s") ("br" "Brazil" "The Federative Republic of %s") ("bs" "Bahamas") ("bw" "Botswana") ("by" "Belarus") ("bz" "Belize") ("ca" "Canada") ("cg" "Congo") ("ch" "Switzerland" "The Swiss Confederation") ("ci" "Ivory Coast") ("cl" "Chile" "The Republic of %s") ("cm" "Cameroon") ; In .fr domain ("cn" "China" "The People's Republic of %s") ("co" "Colombia") ("cr" "Costa Rica" "The Republic of %s") ("cs" "Czechoslovakia") ("cu" "Cuba") ("cy" "Cyprus") ("cz" "Czech Republic") ("de" "Germany") ("dk" "Denmark") ("dm" "Dominica") ("do" "Dominican Republic" "The %s") ("dz" "Algeria") ("ec" "Ecuador" "The Republic of %s") ("ee" "Estonia") ("eg" "Egypt" "The Arab Republic of %s") ("er" "Eritrea") ("es" "Spain" "The Kingdom of %s") ("fi" "Finland" "The Republic of %s") ("fj" "Fiji") ("fo" "Faroe Islands") ("fr" "France") ("gb" "Great Britain") ("gd" "Grenada") ("ge" "Georgia") ("gf" "Guyana (Fr.)") ("gp" "Guadeloupe (Fr.)") ("gr" "Greece" "The Hellenic Republic (%s)") ("gt" "Guatemala") ("gu" "Guam (U.S.)") ("hk" "Hong Kong") ("hn" "Honduras") ("hr" "Croatia") ("ht" "Haiti") ("hu" "Hungary" "The Hungarian Republic") ;??? ("id" "Indonesia") ("ie" "Ireland") ("il" "Israel" "The State of %s") ("in" "India" "The Republic of %s") ("ir" "Iran") ("is" "Iceland" "The Republic of %s") ("it" "Italy" "The Italian Republic") ("jm" "Jamaica") ("jp" "Japan") ("ke" "Kenya") ("kn" "St. Kitts, Nevis, and Anguilla") ("kp" "Korea (North)") ("kr" "Korea (South)") ("kw" "Kuwait") ("kz" "Kazachstan") ("lb" "Lebanon") ("lc" "St. Lucia") ("li" "Liechtenstein") ("lk" "Sri Lanka" "The Democratic Socialist Republic of %s") ("ls" "Lesotho") ("lt" "Lithuania") ("lu" "Luxembourg") ("lv" "Latvia") ("ma" "Morocco") ("md" "Moldova") ("mg" "Madagascar") ("mk" "Macedonia") ("ml" "Mali") ("mo" "Macau") ("mt" "Malta") ("mu" "Mauritius") ("mw" "Malawi") ("mx" "Mexico" "The United Mexican States") ("my" "Malaysia" "%s (changed to Myanmar?)") ;??? ("mz" "Mozambique") ("na" "Namibia") ("nc" "New Caledonia (Fr.)") ("ne" "Niger") ; In .fr domain ("ni" "Nicaragua" "The Republic of %s") ("nl" "Netherlands" "The Kingdom of the %s") ("no" "Norway" "The Kingdom of %s") ("np" "Nepal") ; Via .in domain ("nz" "New Zealand") ("pa" "Panama") ("pe" "Peru") ("pf" "Polynesia (Fr.)") ("pg" "Papua New Guinea") ("ph" "Philippines" "The Republic of the %s") ("pk" "Pakistan") ("pl" "Poland") ("pr" "Puerto Rico (U.S.)") ("pt" "Portugal" "The Portugese Republic") ("py" "Paraguay") ("re" "Reunion (Fr.)") ; In .fr domain ("ro" "Romania") ("ru" "Russian Federation") ("sa" "Saudi Arabia") ("sc" "Seychelles") ("sd" "Sudan") ("se" "Sweden" "The Kingdom of %s") ("sg" "Singapore" "The Republic of %s") ("si" "Slovenia") ("sj" "Svalbard and Jan Mayen Is.") ; In .no domain ("sk" "Slovakia" "The Slovak Republic") ("sn" "Senegal") ("sr" "Suriname") ("su" "Soviet Union") ("sz" "Swaziland") ("tg" "Togo") ("th" "Thailand" "The Kingdom of %s") ("tm" "Turkmenistan") ; In .su domain ("tn" "Tunisia") ("tr" "Turkey" "The Republic of %s") ("tt" "Trinidad and Tobago") ("tw" "Taiwan") ("ua" "Ukraine") ("uk" "United Kingdom" "The %s of Great Britain and Northern Ireland") ("us" "United States" "The %s of America") ("uy" "Uruguay" "The Eastern Republic of %s") ("vc" "St. Vincent and the Grenadines") ("ve" "Venezuela" "The Republic of %s") ("vi" "Virgin Islands (U.S.)") ("vn" "Vietnam") ("vu" "Vanuatu") ("yu" "Yugoslavia" "The Socialist Federal Republic of %s") ("za" "South Africa" "The Republic of %s (or Zambia? Zaire?)") ("zw" "Zimbabwe" "Republic of %s") ;; Special top-level domains: ("arpa" t "Advanced Research Projects Agency (U.S. DoD)") ("bitnet" t "Because It's Time NET") ("com" t "Commercial") ("edu" t "Educational") ("gov" t "Government (U.S.)") ("int" t "International (NATO)") ("mil" t "Military (U.S.)") ("nato" t "North Atlantic Treaty Organization") ("net" t "Network") ("org" t "Non-profit Organization") ;;("unter-dom" t "? (Ger.)") ("uucp" t "Unix to Unix CoPy") ;;("fipnet" nil "?") )) ob)) ;;;###autoload (defun what-domain (domain) "Convert mail domain DOMAIN to the country it corresponds to." (interactive (let ((completion-ignore-case t)) (list (completing-read "Domain: " mail-extr-all-top-level-domains nil t)))) (or (setq domain (intern-soft (downcase domain) mail-extr-all-top-level-domains)) (error "no such domain")) (message "%s: %s" (upcase (symbol-name domain)) (get domain 'domain-name))) ;(let ((all nil)) ; (mapatoms #'(lambda (x) ; (if (and (boundp x) ; (string-match "^mail-extr-" (symbol-name x))) ; (setq all (cons x all))))) ; (setq all (sort all #'string-lessp)) ; (cons 'setq ; (apply 'nconc (mapcar #'(lambda (x) ; (list x (symbol-value x))) ; all)))) (provide 'mail-extr) ;;; mail-extr.el ends here emacs-19.30/lisp/mail-hist.el100444 12120 1 26434 5772740777 14337 0ustar rmsdaemon;;; mail-hist.el --- Headers and message body history for outgoing mail. ;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Author: Karl Fogel ;; Created: March, 1994 ;; Keywords: mail, history ;; 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. ;;; Commentary: ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of ;; time. ;; ;; To use this package, put it in a directory in your load-path, and ;; put this in your .emacs file: ;; ;; (load "mail-hist" nil t) ;; ;; Or you could do it with autoloads and hooks in your .emacs: ;; ;; (add-hook 'mail-mode-hook 'mail-hist-define-keys) ;; (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history) ;; (add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) ;or rmail, etc ;; (autoload 'mail-hist-define-keys "mail-hist") ;; (autoload 'mail-hist-put-headers-into-history "mail-hist") ;; ;; Once it's installed, use M-p and M-n from mail headers to recover ;; previous/next contents in the history for that header, or, in the ;; body of the message, to recover previous/next text of the message. ;; This only applies to outgoing mail -- mail-hist ignores received ;; messages. ;; ;; Although repeated history requests do clear out the text from the ;; previous request, an isolated request just inserts its text at ;; point, so that you can mix the histories of different messages ;; easily. This might be confusing at times, but there should be no ;; problems that undo can't handle. ;;; Code: (require 'ring) ;;;###autoload (defun mail-hist-define-keys () "Define keys for accessing mail header history. For use in hooks." (local-set-key "\M-p" 'mail-hist-previous-input) (local-set-key "\M-n" 'mail-hist-next-input)) ;;;###autoload (defun mail-hist-enable () (add-hook 'mail-mode-hook 'mail-hist-define-keys) (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)) (defvar mail-hist-header-ring-alist nil "Alist of form (header-name . history-ring). Used for knowing which history list to look in when the user asks for previous/next input.") (defvar mail-hist-history-size (or kill-ring-max 1729) "*The maximum number of elements in a mail field's history. Oldest elements are dumped first.") ;;;###autoload (defvar mail-hist-keep-history t "*Non-nil means keep a history for headers and text of outgoing mail.") ;; For handling repeated history requests (defvar mail-hist-access-count 0) (defvar mail-hist-last-bounds nil) ;; (start . end) A pair indicating the buffer positions delimiting the ;; last inserted history, so it can be replaced by a new input if the ;; command is repeated. (defvar mail-hist-header-regexp "^[^:]*:" "Regular expression for matching headers in a mail message.") (defsubst mail-hist-current-header-name () "Get name of mail header point is currently in, without the colon. Returns nil if not in a header, implying that point is in the body of the message." (if (save-excursion (re-search-backward (concat "^" (regexp-quote mail-header-separator) "$") nil t)) nil ; then we are in the body of the message (save-excursion (let* ((body-start ; limit possibility of false headers (save-excursion (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t))) (name-start (re-search-backward mail-hist-header-regexp nil t)) (name-end (prog2 (search-forward ":" body-start t) (1- (point))))) (and name-start name-end (downcase (buffer-substring name-start name-end))))))) (defsubst mail-hist-forward-header (count) "Move forward COUNT headers (backward if COUNT is negative). If last/first header is encountered first, stop there and returns nil. Places point on the first non-whitespace on the line following the colon after the header name, or on the second space following that if the header is empty." (let ((boundary (save-excursion (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t)))) (and boundary (let ((unstopped t)) (setq boundary (save-excursion (goto-char boundary) (beginning-of-line) (1- (point)))) (if (> count 0) (while (> count 0) (setq unstopped (re-search-forward mail-hist-header-regexp boundary t)) (setq count (1- count))) ;; because the current header will match too. (setq count (1- count)) ;; count is negative (while (< count 0) (setq unstopped (re-search-backward mail-hist-header-regexp nil t)) (setq count (1+ count))) ;; we end up behind the header, so must move to the front (re-search-forward mail-hist-header-regexp boundary t)) ;; Now we are right after the colon (and (looking-at "\\s-") (forward-char 1)) ;; return nil if didn't go as far as asked, otherwise point unstopped)))) (defsubst mail-hist-beginning-of-header () "Move to the start of the current header. The start of the current header is defined as one space after the colon, or just after the colon if it is not followed by whitespace." ;; this is slick as all heck: (if (mail-hist-forward-header -1) (mail-hist-forward-header 1) (mail-hist-forward-header 1) (mail-hist-forward-header -1))) (defsubst mail-hist-current-header-contents () "Get the contents of the mail header in which point is located." (save-excursion (mail-hist-beginning-of-header) (let ((start (point))) (or (mail-hist-forward-header 1) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))) (beginning-of-line) (buffer-substring start (1- (point)))))) (defsubst mail-hist-get-header-ring (header) "Get HEADER's history ring, or nil if none. HEADER is a string without the colon." (setq header (downcase header)) (cdr (assoc header mail-hist-header-ring-alist))) (defvar mail-hist-text-size-limit nil "*Don't store any header or body with more than this many characters. If the value is nil, that means no limit on text size.") (defun mail-hist-text-too-long-p (text) "Return t if TEXT does not exceed mail-hist's size limit. The variable `mail-hist-text-size-limit' defines this limit." (if mail-hist-text-size-limit (> (length text) mail-hist-text-size-limit))) (defsubst mail-hist-add-header-contents-to-ring (header &optional contents) "Add the contents of HEADER to the header history ring. Optional argument CONTENTS is a string which will be the contents \(instead of whatever's found in the header)." (setq header (downcase header)) (let ((ctnts (or contents (mail-hist-current-header-contents))) (ring (cdr (assoc header mail-hist-header-ring-alist)))) (if (mail-hist-text-too-long-p ctnts) (setq ctnts "")) (or ring ;; If the ring doesn't exist, we'll have to make it and add it ;; to the mail-header-ring-alist: (prog1 (setq ring (make-ring mail-hist-history-size)) (setq mail-hist-header-ring-alist (cons (cons header ring) mail-hist-header-ring-alist)))) (ring-insert ring ctnts))) ;;;###autoload (defun mail-hist-put-headers-into-history () "Put headers and contents of this message into mail header history. Each header has its own independent history, as does the body of the message. This function normally would be called when the message is sent." (and mail-hist-keep-history (save-excursion (goto-char (point-min)) (while (mail-hist-forward-header 1) (mail-hist-add-header-contents-to-ring (mail-hist-current-header-name))) (let ((body-contents (save-excursion (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil) (forward-line 1) (buffer-substring (point) (point-max))))) (mail-hist-add-header-contents-to-ring "body" body-contents))))) (defun mail-hist-previous-input (header) "Insert the previous contents of this mail header or message body. Moves back through the history of sent mail messages. Each header has its own independent history, as does the body of the message. The history only contains the contents of outgoing messages, not received mail." (interactive (list (or (mail-hist-current-header-name) "body"))) (setq header (downcase header)) (let* ((ring (cdr (assoc header mail-hist-header-ring-alist))) (len (ring-length ring)) (repeat (eq last-command 'mail-hist-input-access))) (if repeat (setq mail-hist-access-count (ring-plus1 mail-hist-access-count len)) (setq mail-hist-access-count 0)) (if (null ring) (progn (ding) (message "No history for \"%s\"." header)) (if (ring-empty-p ring) (error "\"%s\" ring is empty." header) (and repeat (delete-region (car mail-hist-last-bounds) (cdr mail-hist-last-bounds))) (let ((start (point))) (insert (ring-ref ring mail-hist-access-count)) (setq mail-hist-last-bounds (cons start (point))) (setq this-command 'mail-hist-input-access)))))) (defun mail-hist-next-input (header) "Insert next contents of this mail header or message body. Moves back through the history of sent mail messages. Each header has its own independent history, as does the body of the message. Although you can do so, it does not make much sense to call this without having called `mail-hist-previous-header' first (\\[mail-hist-previous-header]). The history only contains the contents of outgoing messages, not received mail." (interactive (list (or (mail-hist-current-header-name) "body"))) (setq header (downcase header)) (let* ((ring (cdr (assoc header mail-hist-header-ring-alist))) (len (ring-length ring)) (repeat (eq last-command 'mail-hist-input-access))) (if repeat (setq mail-hist-access-count (ring-minus1 mail-hist-access-count len)) (setq mail-hist-access-count 0)) (if (null ring) (progn (ding) (message "No history for \"%s\"." header)) (if (ring-empty-p ring) (error "\"%s\" ring is empty." header) (and repeat (delete-region (car mail-hist-last-bounds) (cdr mail-hist-last-bounds))) (let ((start (point))) (insert (ring-ref ring mail-hist-access-count)) (setq mail-hist-last-bounds (cons start (point))) (setq this-command 'mail-hist-input-access)))))) (provide 'mail-hist) ;; mail-hist.el ends here emacs-19.30/lisp/mail-utils.el100444 12120 1 21354 6053424460 14501 0ustar rmsdaemon;;; mail-utils.el --- utility functions used both by rmail and rnews ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail, news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Utility functions for mail and netnews handling. These handle fine ;; points of header parsing. ;;; Code: ;;; We require lisp-mode to make sure that lisp-mode-syntax-table has ;;; been initialized. (require 'lisp-mode) ;;;###autoload (defvar mail-use-rfc822 nil "\ *If non-nil, use a full, hairy RFC822 parser on mail addresses. Otherwise, (the default) use a smaller, somewhat faster, and often correct parser.") ;; Returns t if file FILE is an Rmail file. ;;;###autoload (defun mail-file-babyl-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)))) (defun mail-string-delete (string start end) "Returns a string containing all of STRING except the part from START (inclusive) to END (exclusive)." (if (null end) (substring string 0 start) (concat (substring string 0 start) (substring string end nil)))) (defun mail-strip-quoted-names (address) "Delete comments and quoted strings in an address list ADDRESS. Also delete leading/trailing whitespace and replace FOO with just BAR. Return a modified address list." (if (null address) nil (if mail-use-rfc822 (progn (require 'rfc822) (mapconcat 'identity (rfc822-addresses address) ", ")) (let (pos) (string-match "\\`[ \t\n]*" address) ;; strip surrounding whitespace (setq address (substring address (match-end 0) (string-match "[ \t\n]*\\'" address (match-end 0)))) ;; Detect nested comments. (if (string-match "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*(" address) ;; Strip nested comments. (save-excursion (set-buffer (get-buffer-create " *temp*")) (erase-buffer) (insert address) (set-syntax-table lisp-mode-syntax-table) (goto-char 1) (while (search-forward "(" nil t) (forward-char -1) (skip-chars-backward " \t") (delete-region (point) (save-excursion (condition-case () (forward-sexp 1) (error (goto-char (point-max)))) (point)))) (setq address (buffer-string)) (erase-buffer)) ;; Strip non-nested comments an easier way. (while (setq pos (string-match ;; This doesn't hack rfc822 nested comments ;; `(xyzzy (foo) whinge)' properly. Big deal. "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*)" address)) (setq address (mail-string-delete address pos (match-end 0))))) ;; strip `quoted' names (This is supposed to hack `"Foo Bar" ') (setq pos 0) (while (setq pos (string-match "[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*" address pos)) ;; If the next thing is "@", we have "foo bar"@host. Leave it. (if (and (> (length address) (match-end 0)) (= (aref address (match-end 0)) ?@)) (setq pos (match-end 0)) (setq address (mail-string-delete address pos (match-end 0))))) ;; Retain only part of address in <> delims, if there is such a thing. (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)[^,]*<\\([^>,]*>\\)" address)) (let ((junk-beg (match-end 1)) (junk-end (match-beginning 2)) (close (match-end 0))) (setq address (mail-string-delete address (1- close) close)) (setq address (mail-string-delete address junk-beg junk-end)))) address)))) (or (and (boundp 'rmail-default-dont-reply-to-names) (not (null rmail-default-dont-reply-to-names))) (setq rmail-default-dont-reply-to-names "info-")) ; rmail-dont-reply-to-names is defined in loaddefs (defun rmail-dont-reply-to (userids) "Returns string of mail addresses USERIDS sans any recipients that start with matches for `rmail-dont-reply-to-names'. Usenet paths ending in an element that matches are removed also." (if (null rmail-dont-reply-to-names) (setq rmail-dont-reply-to-names (concat (if rmail-default-dont-reply-to-names (concat rmail-default-dont-reply-to-names "\\|") "") (concat (regexp-quote (user-login-name)) "\\>")))) (let ((match (concat "\\(^\\|,\\)[ \t\n]*\\([^,\n]*!\\|\\)\\(" rmail-dont-reply-to-names "\\)")) (case-fold-search t) pos epos) (while (setq pos (string-match match userids)) (if (> pos 0) (setq pos (match-beginning 2))) (setq epos (if (string-match "[ \t\n,]+" userids (match-end 0)) (match-end 0) (length userids))) (setq userids (mail-string-delete userids pos epos))) ;; get rid of any trailing commas (if (setq pos (string-match "[ ,\t\n]*\\'" userids)) (setq userids (substring userids 0 pos))) ;; remove leading spaces. they bother me. (if (string-match "\\s *" userids) (substring userids (match-end 0)) userids))) ;;;###autoload (defun mail-fetch-field (field-name &optional last all) "Return the value of the header field FIELD-NAME. The buffer is expected to be narrowed to just the headers of the message. If second arg LAST is non-nil, use the last such field if there are several. If third arg ALL is non-nil, concatenate all such fields with commas between." (save-excursion (goto-char (point-min)) (let ((case-fold-search t) (name (concat "^" (regexp-quote field-name) "[ \t]*:[ \t]*"))) (if all (let ((value "")) (while (re-search-forward name nil t) (let ((opoint (point))) (while (progn (forward-line 1) (looking-at "[ \t]"))) ;; Back up over newline, then trailing spaces or tabs (forward-char -1) (while (member (preceding-char) '(? ?\t)) (forward-char -1)) (setq value (concat value (if (string= value "") "" ", ") (buffer-substring-no-properties opoint (point)))))) (and (not (string= value "")) value)) (if (re-search-forward name nil t) (progn (if last (while (re-search-forward name nil t))) (let ((opoint (point))) (while (progn (forward-line 1) (looking-at "[ \t]"))) ;; Back up over newline, then trailing spaces or tabs (forward-char -1) (while (member (preceding-char) '(? ?\t)) (forward-char -1)) (buffer-substring-no-properties opoint (point))))))))) ;; Parse a list of tokens separated by commas. ;; It runs from point to the end of the visible part of the buffer. ;; Whitespace before or after tokens is ignored, ;; but whitespace within tokens is kept. (defun mail-parse-comma-list () (let (accumulated beg) (skip-chars-forward " ") (while (not (eobp)) (setq beg (point)) (skip-chars-forward "^,") (skip-chars-backward " ") (setq accumulated (cons (buffer-substring beg (point)) accumulated)) (skip-chars-forward "^,") (skip-chars-forward ", ")) accumulated)) (defun mail-comma-list-regexp (labels) (let (pos) (setq pos (or (string-match "[^ \t]" labels) 0)) ;; Remove leading and trailing whitespace. (setq labels (substring labels pos (string-match "[ \t]*$" labels pos))) ;; Change each comma to \|, and flush surrounding whitespace. (while (setq pos (string-match "[ \t]*,[ \t]*" labels)) (setq labels (concat (substring labels 0 pos) "\\|" (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) ;;; mail-utils.el ends here emacs-19.30/lisp/mailabbrev.el100444 12120 1 54200 6045302413 14513 0ustar rmsdaemon;;; mailabbrev.el --- abbrev-expansion of mail aliases. ;;; Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc. ;; Author: Jamie Zawinski ;; Maintainer: Jamie Zawinski ;; Created: 19 Oct 90 ;; Keywords: mail ;;; This file is part of GNU Emacs. ;;; GNU Emacs is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2, or (at your option) ;;; any later version. ;;; GNU Emacs is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Emacs; see the file COPYING. If not, write to ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; This file ensures that, when the point is in a To:, CC:, BCC:, or From: ;;; field, word-abbrevs are defined for each of your mail aliases. These ;;; aliases will be defined from your .mailrc file (or the file specified by ;;; the MAILRC environment variable) if it exists. Your mail aliases will ;;; expand any time you type a word-delimiter at the end of an abbreviation. ;;; ;;; What you see is what you get: no abbreviations will be expanded after you ;;; have sent the mail, unlike the old system. This means you don't suffer ;;; the annoyance of having the system do things behind your back -- if an ;;; address you typed is going to be rewritten, you know it immediately, ;;; instead of after the mail has been sent and it's too late to do anything ;;; about it. You will never again be screwed because you forgot to delete an ;;; old alias from your .mailrc when a new local user arrives and is given a ;;; userid which conflicts with one of your aliases, for example. ;;; ;;; Your mail alias abbrevs will be in effect only when the point is in an ;;; appropriate header field. When in the body of the message, or other ;;; header fields, the mail aliases will not expand. Rather, the normal ;;; mode-specific abbrev table (mail-mode-abbrev-table) will be used if ;;; defined. So if you use mail-mode specific abbrevs, this code will not ;;; adversely affect you. You can control which header fields the abbrevs ;;; are used in by changing the variable mail-abbrev-mode-regexp. ;;; ;;; If auto-fill mode is on, abbrevs will wrap at commas instead of at word ;;; boundaries; also, header continuation-lines will be properly indented. ;;; ;;; You can also insert a mail alias with mail-interactive-insert-alias ;;; (bound to C-c C-a), which prompts you for an alias (with completion) ;;; and inserts its expansion at point. ;;; ;;; This file fixes a bug in the old system which prohibited your .mailrc ;;; file from having lines like ;;; ;;; alias someone "John Doe " ;;; ;;; That is, if you want an address to have embedded spaces, simply surround it ;;; with double-quotes. This is necessary because the format of the .mailrc ;;; file bogusly uses spaces as address delimiters. The following line defines ;;; an alias which expands to three addresses: ;;; ;;; alias foobar addr-1 addr-2 "address three " ;;; ;;; (This is bogus because mail-delivery programs want commas, not spaces, ;;; but that's what the file format is, so we have to live with it.) ;;; ;;; If you like, you can call the function define-mail-abbrev to define your ;;; mail aliases instead of using a .mailrc file. When you call it in this ;;; way, addresses are separated by commas. ;;; ;;; CAVEAT: This works on most Sun systems; I have been told that some versions ;;; of /bin/mail do not understand double-quotes in the .mailrc file. So you ;;; should make sure your version does before including verbose addresses like ;;; this. One solution to this, if you are on a system whose /bin/mail doesn't ;;; work that way, (and you still want to be able to /bin/mail to send mail in ;;; addition to emacs) is to define minimal aliases (without full names) in ;;; your .mailrc file, and use define-mail-abbrev to redefine them when sending ;;; mail from emacs; this way, mail sent from /bin/mail will work, and mail ;;; sent from emacs will be pretty. ;;; ;;; Aliases in the mailrc file may be nested. If you define aliases like ;;; alias group1 fred ethel ;;; alias group2 larry curly moe ;;; alias everybody group1 group2 ;;; Then when you type "everybody" on the To: line, it will be expanded to ;;; fred, ethyl, larry, curly, moe ;;; ;;; Aliases may also contain forward references; the alias of "everybody" can ;;; precede the aliases of "group1" and "group2". ;;; ;;; This code also understands the "source" .mailrc command, for reading ;;; aliases from some other file as well. ;;; ;;; Aliases may contain hyphens, as in "alias foo-bar foo@bar"; word-abbrevs ;;; normally cannot contain hyphens, but this code works around that for the ;;; specific case of mail-alias word-abbrevs. ;;; ;;; To read in the contents of another .mailrc-type file from emacs, use the ;;; command Meta-X merge-mail-abbrevs. The rebuild-mail-abbrevs command is ;;; similar, but will delete existing aliases first. ;;; ;;; If you would like your aliases to be expanded when you type M-> or ^N to ;;; move out of the mail-header into the message body (instead of having to ;;; type SPC at the end of the abbrev before moving away) then you can do ;;; ;;; (define-key mail-mode-map "\C-n" 'mail-abbrev-next-line) ;;; (define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer) ;;; ;;; If you want multiple addresses separated by a string other than ", " then ;;; you can set the variable mail-alias-separator-string to it. This has to ;;; be a comma bracketed by whitespace if you want any kind of reasonable ;;; behaviour. ;;; ;;; Thanks to Harald Hanche-Olsen, Michael Ernst, David Loeffler, and ;;; Noah Friedman for suggestions and bug reports. ;;; To use this package, do (add-hook 'mail-setup-hook 'mail-abbrevs-setup). ;;; Code: (require 'sendmail) ;; originally defined in sendmail.el - used to be an alist, now is a table. (defvar mail-abbrevs nil "Word-abbrev table of mail address aliases. If this is nil, it means the aliases have not yet been initialized and should be read from the .mailrc file. (This is distinct from there being no aliases, which is represented by this being a table with no entries.)") ;;;###autoload (defun mail-abbrevs-setup () (if (and (not (vectorp mail-abbrevs)) (file-exists-p mail-personal-alias-file)) (build-mail-abbrevs)) (make-local-hook 'pre-abbrev-expand-hook) (add-hook 'pre-abbrev-expand-hook 'sendmail-pre-abbrev-expand-hook nil t) (abbrev-mode 1)) ;;;###autoload (defun build-mail-abbrevs (&optional file recursivep) "Read mail aliases from personal mail alias file and set `mail-abbrevs'. By default this is the file specified by `mail-personal-alias-file'." (setq file (expand-file-name (or file mail-personal-alias-file))) (if (vectorp mail-abbrevs) nil (setq mail-abbrevs nil) (define-abbrev-table 'mail-abbrevs '())) (message "Parsing %s..." file) (let ((buffer nil) (obuf (current-buffer))) (unwind-protect (progn (setq buffer (generate-new-buffer "mailrc")) (buffer-disable-undo buffer) (set-buffer buffer) (cond ((get-file-buffer file) (insert (save-excursion (set-buffer (get-file-buffer file)) (buffer-substring (point-min) (point-max))))) ((not (file-exists-p file))) (t (insert-file-contents file))) ;; Don't lose if no final newline. (goto-char (point-max)) (or (eq (preceding-char) ?\n) (newline)) (goto-char (point-min)) ;; Delete comments from the file (while (search-forward "# " nil t) (let ((p (- (point) 2))) (end-of-line) (delete-region p (point)))) (goto-char (point-min)) ;; handle "\\\n" continuation lines (while (not (eobp)) (end-of-line) (if (= (preceding-char) ?\\) (progn (delete-char -1) (delete-char 1) (insert ?\ )) (forward-char 1))) (goto-char (point-min)) (while (re-search-forward "^\\(a\\(lias\\)?\\|g\\(roup\\)?\\|source\\)[ \t]+" nil t) (beginning-of-line) (if (looking-at "source[ \t]+\\([^ \t\n]+\\)") (progn (end-of-line) (build-mail-abbrevs (substitute-in-file-name (buffer-substring (match-beginning 1) (match-end 1))) t)) (re-search-forward "[ \t]+\\([^ \t\n]+\\)") (let* ((name (buffer-substring (match-beginning 1) (match-end 1))) (start (progn (skip-chars-forward " \t") (point)))) (end-of-line) ; (message "** %s \"%s\"" name (buffer-substring start (point)))(sit-for 1) (define-mail-abbrev name (buffer-substring start (point)) t)))) ;; Resolve forward references in .mailrc file. ;; This would happen automatically before the first abbrev was ;; expanded, but why not do it now. (or recursivep (mail-resolve-all-aliases)) mail-abbrevs) (if buffer (kill-buffer buffer)) (set-buffer obuf))) (message "Parsing %s... done" file)) (defvar mail-alias-separator-string ", " "*A string inserted between addresses in multi-address mail aliases. This has to contain a comma, so \", \" is a reasonable value. You might also want something like \",\\n \" to get each address on its own line.") ;; define-mail-abbrev sets this flag, which causes mail-resolve-all-aliases ;; to be called before expanding abbrevs if it's necessary. (defvar mail-abbrev-aliases-need-to-be-resolved t) ;; originally defined in mailalias.el ; build-mail-abbrevs calls this with ;; stuff parsed from the .mailrc file. ;; ;;;###autoload (defun define-mail-abbrev (name definition &optional from-mailrc-file) "Define NAME as a mail alias abbrev that translates to DEFINITION. If DEFINITION contains multiple addresses, separate them with commas." ;; When this is called from build-mail-abbrevs, the third argument is ;; true, and we do some evil space->comma hacking like /bin/mail does. (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") ;; Read the defaults first, if we have not done so. (if (vectorp mail-abbrevs) nil (setq mail-abbrevs nil) (define-abbrev-table 'mail-abbrevs '()) (if (file-exists-p mail-personal-alias-file) (build-mail-abbrevs))) ;; strip garbage from front and end (if (string-match "\\`[ \t\n,]+" definition) (setq definition (substring definition (match-end 0)))) (if (string-match "[ \t\n,]+\\'" definition) (setq definition (substring definition 0 (match-beginning 0)))) (let* ((result '()) (L (length definition)) (start (if (> L 0) 0)) end) (while start ;; If we're reading from the mailrc file, then addresses are delimited ;; by spaces, and addresses with embedded spaces must be surrounded by ;; double-quotes. Otherwise, addresses are separated by commas. (if from-mailrc-file (if (eq ?\" (aref definition start)) (setq start (1+ start) end (string-match "\"[ \t,]*" definition start)) (setq end (string-match "[ \t,]+" definition start))) (setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start))) (setq result (cons (substring definition start end) result)) (setq start (and end (/= (match-end 0) L) (match-end 0)))) (setq definition (mapconcat (function identity) (nreverse result) mail-alias-separator-string))) (setq mail-abbrev-aliases-need-to-be-resolved t) (setq name (downcase name)) ;; use an abbrev table instead of an alist for mail-abbrevs. (let ((abbrevs-changed abbrevs-changed)) ; protect this from being changed. (define-abbrev mail-abbrevs name definition 'mail-abbrev-expand-hook))) (defun mail-resolve-all-aliases () "Resolve all forward references in the mail aliases table." (if mail-abbrev-aliases-need-to-be-resolved (progn ;; (message "Resolving mail aliases...") (if (vectorp mail-abbrevs) (mapatoms (function mail-resolve-all-aliases-1) mail-abbrevs)) (setq mail-abbrev-aliases-need-to-be-resolved nil) ;; (message "Resolving mail aliases... done.") ))) (defun mail-resolve-all-aliases-1 (sym &optional so-far) (if (memq sym so-far) (error "mail alias loop detected: %s" (mapconcat 'symbol-name (cons sym so-far) " <- "))) (let ((definition (and (boundp sym) (symbol-value sym)))) (if definition (let ((result '()) (start 0)) (while start (let ((end (string-match "[ \t\n]*,[, \t\n]*" definition start))) (setq result (cons (substring definition start end) result) start (and end (match-end 0))))) (setq definition (mapconcat (function (lambda (x) (or (mail-resolve-all-aliases-1 (intern-soft (downcase x) mail-abbrevs) (cons sym so-far)) x))) (nreverse result) mail-alias-separator-string)) (set sym definition)))) (symbol-value sym)) (defun mail-abbrev-expand-hook () "For use as the fourth arg to `define-abbrev'. After expanding a mail-abbrev, if Auto Fill mode is on and we're past the fill-column, break the line at the previous comma, and indent the next line." (save-excursion (let ((p (point)) bol comma fp) (beginning-of-line) (setq bol (point)) (goto-char p) (while (and auto-fill-function (>= (current-column) fill-column) (search-backward "," bol t)) (setq comma (point)) (forward-char 1) ; Now we are just past the comma. (insert "\n") (delete-horizontal-space) (setq p (point)) (indent-relative) (setq fp (buffer-substring p (point))) ;; Go to the end of the new line. (end-of-line) (if (> (current-column) fill-column) ;; It's still too long; do normal auto-fill. (let ((fill-prefix (or fp "\t"))) (do-auto-fill))) ;; Resume the search. (goto-char comma) )))) ;;; Syntax tables and abbrev-expansion (defvar mail-abbrev-mode-regexp "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):" "*Regexp to select mail-headers in which mail abbrevs should be expanded. This string will be handed to `looking-at' with point at the beginning of the current line; if it matches, abbrev mode will be turned on, otherwise it will be turned off. (You don't need to worry about continuation lines.) This should be set to match those mail fields in which you want abbreviations turned on.") (defvar mail-mode-header-syntax-table (let ((tab (copy-syntax-table text-mode-syntax-table))) ;; This makes the characters "@%!._-" be considered symbol-constituents ;; but not word-constituents, so forward-sexp will move you over an ;; entire address, but forward-word will only move you over a sequence ;; of alphanumerics. (Clearly the right thing.) (modify-syntax-entry ?@ "_" tab) (modify-syntax-entry ?% "_" tab) (modify-syntax-entry ?! "_" tab) (modify-syntax-entry ?. "_" tab) (modify-syntax-entry ?_ "_" tab) (modify-syntax-entry ?- "_" tab) (modify-syntax-entry ?< "(>" tab) (modify-syntax-entry ?> ")<" tab) tab) "The syntax table used in send-mail mode when in a mail-address header. `mail-mode-syntax-table' is used when the cursor is in the message body or in non-address headers.") (defvar mail-abbrev-syntax-table (let* ((tab (copy-syntax-table mail-mode-header-syntax-table)) (_ (aref (standard-syntax-table) ?_)) (w (aref (standard-syntax-table) ?w))) (map-char-table (function (lambda (key value) (if (equal value _) (set-char-table-range tab key w)))) tab) tab) "The syntax-table used for abbrev-expansion purposes. This is not actually made the current syntax table of the buffer, but simply controls the set of characters which may be a part of the name of a mail alias.") (defun mail-abbrev-in-expansion-header-p () "Whether point is in a mail-address header field." (let ((case-fold-search t)) (and ;; ;; we are on an appropriate header line... (save-excursion (beginning-of-line) ;; skip backwards over continuation lines. (while (and (looking-at "^[ \t]") (not (= (point) (point-min)))) (forward-line -1)) ;; are we at the front of an appropriate header line? (looking-at mail-abbrev-mode-regexp)) ;; ;; ...and we are before the mail-header-separator (< (point) (save-excursion (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n") nil 0) (point)))))) (defvar mail-mode-abbrev-table) ; quiet the compiler (defun sendmail-pre-abbrev-expand-hook () (and (and mail-abbrevs (not (eq mail-abbrevs t))) (if (mail-abbrev-in-expansion-header-p) (progn ;; ;; We are in a To: (or CC:, or whatever) header, and ;; should use word-abbrevs to expand mail aliases. ;; Before anything else, resolve aliases if they need it. (and mail-abbrev-aliases-need-to-be-resolved (mail-resolve-all-aliases)) ;; Now proceed with the abbrev section. ;; - First, install the mail-abbrevs as the word-abbrev table. ;; - Then install the mail-abbrev-syntax-table, which ;; temporarily marks all of the ;; non-alphanumeric-atom-characters (the "_" ;; syntax ones) as being normal word-syntax. We do this ;; because the C code for expand-abbrev only works on words, ;; and we want these characters to be considered words for ;; the purpose of abbrev expansion. ;; - Then we call expand-abbrev again, recursively, to do ;; the abbrev expansion with the above syntax table. ;; - Then we do a trick which tells the expand-abbrev frame ;; which invoked us to not continue (and thus not ;; expand twice.) This means that any abbrev expansion ;; will happen as a result of this function's call to ;; expand-abbrev, and not as a result of the call to ;; expand-abbrev which invoked *us*. ;; - Then we set the syntax table to ;; mail-mode-header-syntax-table, which doesn't have ;; anything to do with abbrev expansion, but ;; is just for the user's convenience (see its doc string.) ;; (setq local-abbrev-table mail-abbrevs) ;; If the character just typed was non-alpha-symbol-syntax, ;; then don't expand the abbrev now (that is, don't expand ;; when the user types -.) Check the character's syntax in ;; the mail-mode-header-syntax-table. (set-syntax-table mail-mode-header-syntax-table) (or (and (integerp last-command-char) (eq (char-syntax last-command-char) ?_)) (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop. ;; Use this table so that abbrevs can have hyphens in them. (set-syntax-table mail-abbrev-syntax-table) (expand-abbrev) ;; Now set it back to what it was before. (set-syntax-table mail-mode-header-syntax-table))) (setq abbrev-start-location (point-max) ; This is the trick. abbrev-start-location-buffer (current-buffer))) ;; We're not in a mail header where mail aliases should ;; be expanded, then use the normal mail-mode abbrev table ;; (if any) and the normal mail-mode syntax table. (setq local-abbrev-table (and (boundp 'mail-mode-abbrev-table) mail-mode-abbrev-table)) (set-syntax-table mail-mode-syntax-table)) )) ;;; utilities (defun merge-mail-abbrevs (file) "Merge mail aliases from the given file with existing ones." (interactive (list (let ((insert-default-directory t) (default-directory (expand-file-name "~/")) (def mail-personal-alias-file)) (read-file-name (format "Read additional aliases from file: (default %s) " def) default-directory (expand-file-name def default-directory) t)))) (build-mail-abbrevs file)) (defun rebuild-mail-abbrevs (&optional file) "Rebuild all the mail aliases from the given file." (interactive (list (let ((insert-default-directory t) (default-directory (expand-file-name "~/")) (def mail-personal-alias-file)) (read-file-name (format "Read mail aliases from file: (default %s) " def) default-directory (expand-file-name def default-directory) t)))) (if (null file) (setq file buffer-file-name)) (setq mail-abbrevs nil) (build-mail-abbrevs file)) (defun mail-interactive-insert-alias (&optional alias) "Prompt for and insert a mail alias." (interactive (progn (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) (list (completing-read "Expand alias: " mail-abbrevs nil t)))) (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) (insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) "")) (mail-abbrev-expand-hook)) (defun mail-abbrev-next-line (&optional arg) "Expand any mail abbrev, then move cursor vertically down ARG lines. If there is no character in the target line exactly under the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. If there is no line in the buffer after this one, a newline character is inserted to create a line and the cursor moves to that line. The command \\[set-goal-column] can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically. This goal column is stored in `goal-column', which is nil when there is none. If you are thinking of using this in a Lisp program, consider using `forward-line' instead. It is usually easier to use and more reliable (no dependence on goal column, etc.)." (interactive "p") (if (looking-at "[ \t]*\n") (expand-abbrev)) (setq this-command 'next-line) (next-line arg)) (defun mail-abbrev-end-of-buffer (&optional arg) "Expand any mail abbrev, then move point to end of buffer. Leave mark at previous position. With arg N, put point N/10 of the way from the true end. 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) (end-of-buffer arg)) (define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias) ;;(define-key mail-mode-map "\C-n" 'mail-abbrev-next-line) ;;(define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer) (provide 'mailabbrev) emacs-19.30/lisp/mailalias.el100444 22035 1 20007 6000236504 14346 0ustar potdaemon;;; mailalias.el --- expand mailing address aliases defined in ~/.mailrc. ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Basic functions for defining and expanding mail aliases. ;; These seal off the interface to the alias-definition parts of a ;; .mailrc file formatted for BSD's Mail or USL's mailx. ;;; Code: (require 'sendmail) ;; Called from sendmail-send-it, or similar functions, ;; only if some mail aliases are defined. (defun expand-mail-aliases (beg end &optional exclude) "Expand all mail aliases in suitable header fields found between BEG and END. Suitable header fields are `To', `From', `CC' and `BCC', `Reply-to', and their `Resent-' variants. Optional second arg EXCLUDE may be a regular expression defining text to be removed from alias expansions." (sendmail-synch-aliases) (if (eq mail-aliases t) (progn (setq mail-aliases nil) (build-mail-aliases))) (goto-char beg) (setq end (set-marker (make-marker) end)) (let ((case-fold-search nil)) (while (let ((case-fold-search t)) (re-search-forward "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):" end t)) (skip-chars-forward " \t") (let ((beg1 (point)) end1 pos epos seplen ;; DISABLED-ALIASES records aliases temporarily disabled ;; while we scan text that resulted from expanding those aliases. ;; Each element is (ALIAS . TILL-WHEN), where TILL-WHEN ;; is where to reenable the alias (expressed as number of chars ;; counting from END1). (disabled-aliases nil)) (re-search-forward "^[^ \t]" end 'move) (beginning-of-line) (skip-chars-backward " \t\n") (setq end1 (point-marker)) (goto-char beg1) (while (< (point) end1) (setq pos (point)) ;; Reenable any aliases which were disabled for ranges ;; that we have passed out of. (while (and disabled-aliases (> pos (- end1 (cdr (car disabled-aliases))))) (setq disabled-aliases (cdr disabled-aliases))) ;; EPOS gets position of end of next name; ;; SEPLEN gets length of whitespace&separator that follows it. (if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t) (setq epos (match-beginning 0) seplen (- (point) epos)) (setq epos (marker-position end1) seplen 0)) (let (translation (string (buffer-substring-no-properties pos epos))) (if (and (not (assoc string disabled-aliases)) (setq translation (cdr (assoc string mail-aliases)))) (progn ;; This name is an alias. Disable it. (setq disabled-aliases (cons (cons string (- end1 epos)) disabled-aliases)) ;; Replace the alias with its expansion ;; then rescan the expansion for more aliases. (goto-char pos) (insert translation) (if exclude (let ((regexp (concat "\\b\\(" exclude "\\)\\b")) (end (point-marker))) (goto-char pos) (while (re-search-forward regexp end t) (replace-match "")) (goto-char end))) (delete-region (point) (+ (point) (- epos pos))) (goto-char pos)) ;; Name is not an alias. Skip to start of next name. (goto-char epos) (forward-char seplen)))) (set-marker end1 nil))) (set-marker end nil))) ;; Called by mail-setup, or similar functions, only if the file specified ;; by mail-personal-alias-file (usually `~/.mailrc') exists. (defun build-mail-aliases (&optional file) "Read mail aliases from personal aliases file and set `mail-aliases'. By default, this is the file specified by `mail-personal-alias-file'." (setq file (expand-file-name (or file mail-personal-alias-file))) (let ((buffer nil) (obuf (current-buffer))) (unwind-protect (progn (setq buffer (generate-new-buffer "mailrc")) (buffer-disable-undo buffer) (set-buffer buffer) (while file (cond ((get-file-buffer file) (insert (save-excursion (set-buffer (get-file-buffer file)) (buffer-substring (point-min) (point-max))))) ((file-exists-p file) (insert-file-contents file)) ((file-exists-p (setq file (concat "~/" file))) (insert-file-contents file)) (t (setq file nil))) ;; Don't lose if no final newline. (goto-char (point-max)) (or (eq (preceding-char) ?\n) (newline)) (goto-char (point-min)) ;; handle "\\\n" continuation lines (while (not (eobp)) (end-of-line) (if (= (preceding-char) ?\\) (progn (delete-char -1) (delete-char 1) (insert ?\ )) (forward-char 1))) (goto-char (point-min)) ;; handle `source' directives -- Eddy/1994/May/25 (cond ((re-search-forward "^source[ \t]+" nil t) (re-search-forward "\\S-+") (setq file (buffer-substring (match-beginning 0) (match-end 0))) (beginning-of-line) (insert "# ") ; to ensure we don't re-process this file (beginning-of-line)) (t (setq file nil)))) (goto-char (point-min)) (while (re-search-forward "^\\(a\\|alias\\|g\\|group\\)[ \t]+\\([^ \t]+\\)" nil t) (let* ((name (match-string 2)) (start (progn (skip-chars-forward " \t") (point)))) (end-of-line) (define-mail-alias name (buffer-substring start (point)) t))) mail-aliases) (if buffer (kill-buffer buffer)) (set-buffer obuf)))) ;; Always autoloadable in case the user wants to define aliases ;; interactively or in .emacs. ;;;###autoload (defun define-mail-alias (name definition &optional from-mailrc-file) "Define NAME as a mail alias that translates to DEFINITION. This means that sending a message to NAME will actually send to DEFINITION. Normally, the addresses in DEFINITION must be separated by commas. If FROM-MAILRC-FILE is non-nil, then addresses in DEFINITION can be separated by spaces; an address can contain spaces if it is quoted with double-quotes." (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") ;; Read the defaults first, if we have not done so. (sendmail-synch-aliases) (if (eq mail-aliases t) (progn (setq mail-aliases nil) (if (file-exists-p mail-personal-alias-file) (build-mail-aliases)))) ;; strip garbage from front and end (if (string-match "\\`[ \t\n,]+" definition) (setq definition (substring definition (match-end 0)))) (if (string-match "[ \t\n,]+\\'" definition) (setq definition (substring definition 0 (match-beginning 0)))) (let ((result '()) ;; If DEFINITION is null string, avoid looping even once. (start (and (not (equal definition "")) 0)) (L (length definition)) end tem) (while start ;; If we're reading from the mailrc file, then addresses are delimited ;; by spaces, and addresses with embedded spaces must be surrounded by ;; double-quotes. Otherwise, addresses are separated by commas. (if from-mailrc-file (if (eq ?\" (aref definition start)) (setq start (1+ start) end (string-match "\"[ \t,]*" definition start)) (setq end (string-match "[ \t,]+" definition start))) (setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start))) (setq result (cons (substring definition start end) result)) (setq start (and end (/= (match-end 0) L) (match-end 0)))) (setq definition (mapconcat (function identity) (nreverse result) ", ")) (setq tem (assoc name mail-aliases)) (if tem (rplacd tem definition) (setq mail-aliases (cons (cons name definition) mail-aliases))))) (provide 'mailalias) ;;; mailalias.el ends here emacs-19.30/lisp/mailpost.el100444 12120 1 6127 5257330730 14233 0ustar rmsdaemon;;; mailpost.el --- RMAIL coupler to /usr/uci/post mailer ;; This is in the public domain ;; since Delp distributed it without a copyright notice in 1986. ;; Author: Gary Delp ;; Maintainer: FSF ;; Created: 13 Jan 1986 ;; Keywords: mail ;;; Commentary: ;; Yet another mail interface. this for the rmail system to provide ;; the missing sendmail interface on systems without /usr/lib/sendmail, ;; but with /usr/uci/post. ;;; Code: (require 'mailalias) (require 'sendmail) ;; (setq send-mail-function 'post-mail-send-it) (defun post-mail-send-it () "The MH -post interface for `rmail-mail' to call. To use it, include \"(setq send-mail-function 'post-mail-send-it)\" in site-init." (let ((errbuf (if mail-interactive (generate-new-buffer " post-mail errors") 0)) (temfile "/tmp/,rpost") (tembuf (generate-new-buffer " post-mail temp")) (case-fold-search nil) delimline (mailbuf (current-buffer))) (unwind-protect (save-excursion (set-buffer tembuf) (erase-buffer) (insert-buffer-substring mailbuf) (goto-char (point-max)) ;; require one newline at the end. (or (= (preceding-char) ?\n) (insert ?\n)) ;; Change header-delimiter to be what post-mail expects. (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n")) (replace-match "\n\n") (backward-char 1) (setq delimline (point-marker)) (if mail-aliases (expand-mail-aliases (point-min) delimline)) (goto-char (point-min)) ;; ignore any blank lines in the header (while (and (re-search-forward "\n\n\n*" delimline t) (< (point) delimline)) (replace-match "\n")) ;; Find and handle any FCC fields. (let ((case-fold-search t)) (goto-char (point-min)) (if (re-search-forward "^FCC:" delimline t) (mail-do-fcc delimline)) ;; If there is a From and no Sender, put it a Sender. (goto-char (point-min)) (and (re-search-forward "^From:" delimline t) (not (save-excursion (goto-char (point-min)) (re-search-forward "^Sender:" delimline t))) (progn (forward-line 1) (insert "Sender: " (user-login-name) "\n"))) ;; don't send out a blank subject line (goto-char (point-min)) (if (re-search-forward "^Subject:[ \t]*\n" delimline t) (replace-match "")) (if mail-interactive (save-excursion (set-buffer errbuf) (erase-buffer)))) (write-file (setq temfile (make-temp-name temfile))) (set-file-modes temfile 384) (apply 'call-process (append (list (if (boundp 'post-mail-program) post-mail-program "/usr/uci/lib/mh/post") nil errbuf nil "-nofilter" "-msgid") (if mail-interactive '("-watch") '("-nowatch")) (list temfile))) (if mail-interactive (save-excursion (set-buffer errbuf) (goto-char (point-min)) (while (re-search-forward "\n\n* *" nil t) (replace-match "; ")) (if (not (zerop (buffer-size))) (error "Sending...failed to %s" (buffer-substring (point-min) (point-max))))))) (kill-buffer tembuf) (if (bufferp errbuf) (switch-to-buffer errbuf))))) ;;; mailpost.el ends here emacs-19.30/lisp/make-mode.el100444 75424 1 136145 6050716634 14513 0ustar kwzhdaemon;;; make-mode.el --- makefile editing commands for Emacs ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc. ;; Author: Thomas Neumann ;; Eric S. Raymond ;; Adapted-By: ESR ;; Keywords: unix, tools ;; RMS: ;; This needs work. ;; Also, the doc strings need fixing: the first line doesn't stand alone, ;; and other usage is not high quality. Symbol names don't have `...'. ;; 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: ;; A major mode for editing makefiles. The mode knows about Makefile ;; syntax and defines M-n and M-p to move to next and previous productions. ;; ;; The keys $, =, : and . are electric; they try to help you fill in a ;; macro reference, macro definition, ordinary target name, or special ;; target name, respectively. Such names are completed using a list of ;; targets and macro names parsed out of the makefile. This list is ;; automatically updated, if necessary, whenever you invoke one of ;; these commands. You can force it to be updated with C-c C-p. ;; ;; The command C-c C-f adds certain filenames in the current directory ;; as targets. You can filter out filenames by setting the variable ;; makefile-ignored-files-in-pickup-regex. ;; ;; The command C-c C-u grinds for a bit, then pops up a report buffer ;; showing which target names are up-to-date with respect to their ;; prerequisites, which targets are out-of-date, and which have no ;; prerequisites. ;; ;; The command C-c C-b pops up a browser window listing all target and ;; macro names. You can mark or unmark items wit C-c SPC, and insert ;; all marked items back in the Makefile with C-c TAB. ;; ;; The command C-c TAB in the makefile buffer inserts a GNU make builtin. ;; You will be prompted for the builtin's args. ;; ;; There are numerous other customization variables. ;; ;; To Do: ;; ;; * makefile-backslash-region should be given better behavior. ;; * Consider binding C-c C-c to comment-region (like cc-mode). ;; * Eliminate electric stuff entirely. ;; * It might be nice to highlight targets differently depending on ;; whether they are up-to-date or not. Not sure how this would ;; interact with font-lock. ;; * Would be nice to edit the commands in ksh-mode and have ;; indentation and slashification done automatically. Hard. ;; * Consider removing browser mode. It seems useless. ;; * ":" should notice when a new target is made and add it to the ;; list (or at least set makefile-need-target-pickup). ;; * Make browser into a major mode. ;; * Clean up macro insertion stuff. It is a mess. ;; * Browser entry and exit is weird. Normalize. ;; * Browser needs to be rewritten. Right now it is kind of a crock. ;; Should at least: ;; * Act more like dired/buffer menu/whatever. ;; * Highlight as mouse traverses. ;; * B2 inserts. ;; * Update documentation above. ;; * Update texinfo manual. ;; * Update files.el. ;;; Code: (provide 'makefile) ;; Sadly we need this for a macro. (eval-when-compile (require 'imenu)) ;;; ------------------------------------------------------------ ;;; Configurable stuff ;;; ------------------------------------------------------------ (defvar makefile-browser-buffer-name "*Macros and Targets*" "Name of the macro- and target browser buffer.") (defvar makefile-target-colon ":" "String to append to all target names inserted by `makefile-insert-target'. \":\" or \"::\" are common values.") (defvar makefile-macro-assign " = " "String to append to all macro names inserted by `makefile-insert-macro'. The normal value should be \" = \", since this is what standard make expects. However, newer makes such as dmake allow a larger variety of different macro assignments, so you might prefer to use \" += \" or \" := \" .") (defvar makefile-electric-keys nil "If non-nil, install electric keybindings. Default is nil.") (defvar makefile-use-curly-braces-for-macros-p nil "Controls the style of generated macro references. t (actually non-nil) means macro references should use curly braces, like `${this}'. nil means use parentheses, like `$(this)'.") (defvar makefile-tab-after-target-colon t "If non-nil, insert a TAB after a target colon. Otherwise, a space is inserted. The default is t.") (defvar makefile-browser-leftmost-column 10 "Number of blanks to the left of the browser selection mark.") (defvar makefile-browser-cursor-column 10 "Column in which the cursor is positioned when it moves up or down in the browser.") (defvar makefile-backslash-column 48 "*Column in which `makefile-backslash-region' inserts backslashes.") (defvar makefile-browser-selected-mark "+ " "String used to mark selected entries in the browser.") (defvar makefile-browser-unselected-mark " " "String used to mark unselected entries in the browser.") (defvar makefile-browser-auto-advance-after-selection-p t "If non-nil, cursor will move after item is selected in browser.") (defvar makefile-pickup-everything-picks-up-filenames-p nil "If non-nil, `makefile-pickup-everything' picks up filenames as targets. \(i.e. it calls `makefile-find-filenames-as-targets'). Otherwise filenames are omitted.") (defvar makefile-cleanup-continuations-p t "If non-nil, automatically clean up continuation lines when saving. A line is cleaned up by removing all whitespace following a trailing backslash. This is done silently. IMPORTANT: Please note that enabling this option causes makefile-mode to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \'it seems necessary\'.") (defvar makefile-browser-hook '()) ;; ;; Special targets for DMake, Sun's make ... ;; (defvar makefile-special-targets-list '(("DEFAULT") ("DONE") ("ERROR") ("EXPORT") ("FAILED") ("GROUPEPILOG") ("GROUPPROLOG") ("IGNORE") ("IMPORT") ("INCLUDE") ("INCLUDEDIRS") ("INIT") ("KEEP_STATE") ("MAKEFILES") ("MAKE_VERSION") ("NO_PARALLEL") ("PARALLEL") ("PHONY") ("PRECIOUS") ("REMOVE") ("SCCS_GET") ("SILENT") ("SOURCE") ("SUFFIXES") ("WAIT") ("c.o") ("C.o") ("m.o") ("el.elc") ("y.c") ("s.o")) "List of special targets. You will be offered to complete on one of those in the minibuffer whenever you enter a \".\" at the beginning of a line in makefile-mode.") (defvar makefile-runtime-macros-list '(("@") ("&") (">") ("<") ("*") ("^") ("?") ("%") ("$")) "List of macros that are resolved by make at runtime. If you insert a macro reference using makefile-insert-macro-ref, the name of the macro is checked against this list. If it can be found its name will not be enclosed in { } or ( ).") ;; Note that the first big subexpression is used by font lock. Note ;; that if you change this regexp you must fix the imenu index ;; function defined at the end of the file. (defconst makefile-dependency-regex "^\\([^ \n\t#:]+\\([ \t]+[^ \t\n#:]+\\)*\\)[ \t]*:\\([ \t]*$\\|\\([^=\n].*$\\)\\)" "Regex used to find dependency lines in a makefile.") ;; Note that the first subexpression is used by font lock. Note that ;; if you change this regexp you must fix the imenu index function ;; defined at the end of the file. (defconst makefile-macroassign-regex "^\\([^ \n\t][^:#= \t\n]*\\)[ \t]*[*:+]?:?=" "Regex used to find macro assignment lines in a makefile.") (defconst makefile-ignored-files-in-pickup-regex "\\(^\\..*\\)\\|\\(.*~$\\)\\|\\(.*,v$\\)\\|\\(\\.[chy]\\)" "Regex for filenames that will NOT be included in the target list.") (add-to-list 'facemenu-unlisted-faces 'makefile-space-face) (defvar makefile-space-face 'makefile-space-face "Face to use for highlighting leading spaces in Font-Lock mode.") (defconst makefile-font-lock-keywords (list ;; Do macro assignments. These get the "variable-name" face rather ;; arbitrarily. (list makefile-macroassign-regex 1 'font-lock-variable-name-face) ;; ;; Variable references even in targets/strings/comments: '("\\$[({]\\([a-zA-Z0-9_]+\\)[})]" 1 font-lock-reference-face t) ;; ;; Do dependencies. These get the function name face. (list makefile-dependency-regex 1 'font-lock-function-name-face) ;; Highlight lines that contain just whitespace. ;; They can cause trouble, especially if they start with a tab. '("^[ \t]+$" . makefile-space-face) ;; Highlight shell comments that Make treats as commands, ;; since these can fool people. '("^\t+#" makefile-space-face t) ;; Highlight spaces that precede tabs. ;; They can make a tab fail to be effective. '("^\\( +\\)\t" 1 makefile-space-face))) ;;; ------------------------------------------------------------ ;;; The following configurable variables are used in the ;;; up-to-date overview . ;;; The standard configuration assumes that your `make' program ;;; can be run in question/query mode using the `-q' option, this ;;; means that the command ;;; ;;; make -q foo ;;; ;;; should return an exit status of zero if the target `foo' is ;;; up to date and a nonzero exit status otherwise. ;;; Many makes can do this although the docs/manpages do not mention ;;; it. Try it with your favourite one. GNU make, System V make, and ;;; Dennis Vadura's DMake have no problems. ;;; Set the variable `makefile-brave-make' to the name of the ;;; make utility that does this on your system. ;;; To understand what this is all about see the function definition ;;; of `makefile-query-by-make-minus-q' . ;;; ------------------------------------------------------------ (defvar makefile-brave-make "make" "A make that can handle the `-q' option.") (defvar makefile-query-one-target-method 'makefile-query-by-make-minus-q "Function to call to determine whether a make target is up to date. The function must satisfy this calling convention: * As its first argument, it must accept the name of the target to be checked, as a string. * As its second argument, it may accept the name of a makefile as a string. Depending on what you're going to do you may not need this. * It must return the integer value 0 (zero) if the given target should be considered up-to-date in the context of the given makefile, any nonzero integer value otherwise.") (defvar makefile-up-to-date-buffer-name "*Makefile Up-to-date overview*" "Name of the Up-to-date overview buffer.") ;;; --- end of up-to-date-overview configuration ------------------ (defvar makefile-mode-map nil "The keymap that is used in Makefile mode.") (if makefile-mode-map () (setq makefile-mode-map (make-sparse-keymap)) ;; set up the keymap (define-key makefile-mode-map "\C-c:" 'makefile-insert-target-ref) (if makefile-electric-keys (progn (define-key makefile-mode-map "$" 'makefile-insert-macro-ref) (define-key makefile-mode-map ":" 'makefile-electric-colon) (define-key makefile-mode-map "=" 'makefile-electric-equal) (define-key makefile-mode-map "." 'makefile-electric-dot))) (define-key makefile-mode-map "\C-c\C-f" 'makefile-pickup-filenames-as-targets) (define-key makefile-mode-map "\C-c\C-b" 'makefile-switch-to-browser) (define-key makefile-mode-map "\C-c\C-p" 'makefile-pickup-everything) (define-key makefile-mode-map "\C-c\C-u" 'makefile-create-up-to-date-overview) (define-key makefile-mode-map "\C-c\C-i" 'makefile-insert-gmake-function) (define-key makefile-mode-map "\C-c\C-\\" 'makefile-backslash-region) (define-key makefile-mode-map "\M-p" 'makefile-previous-dependency) (define-key makefile-mode-map "\M-n" 'makefile-next-dependency) (define-key makefile-mode-map "\e\t" 'makefile-complete) ;; Make menus. (define-key makefile-mode-map [menu-bar makefile-mode] (cons "Makefile" (make-sparse-keymap "Makefile"))) (define-key makefile-mode-map [menu-bar makefile-mode browse] '("Pop up Makefile Browser" . makefile-switch-to-browser)) (define-key makefile-mode-map [menu-bar makefile-mode complete] '("Complete Target or Macro" . makefile-complete)) (define-key makefile-mode-map [menu-bar makefile-mode pickup] '("Find Targets and Macros" . makefile-pickup-everything)) (define-key makefile-mode-map [menu-bar makefile-mode prev] '("Move to Previous Dependency" . makefile-previous-dependency)) (define-key makefile-mode-map [menu-bar makefile-mode next] '("Move to Next Dependency" . makefile-next-dependency))) (defvar makefile-browser-map nil "The keymap that is used in the macro- and target browser.") (if makefile-browser-map () (setq makefile-browser-map (make-sparse-keymap)) (define-key makefile-browser-map "n" 'makefile-browser-next-line) (define-key makefile-browser-map "\C-n" 'makefile-browser-next-line) (define-key makefile-browser-map "p" 'makefile-browser-previous-line) (define-key makefile-browser-map "\C-p" 'makefile-browser-previous-line) (define-key makefile-browser-map " " 'makefile-browser-toggle) (define-key makefile-browser-map "i" 'makefile-browser-insert-selection) (define-key makefile-browser-map "I" 'makefile-browser-insert-selection-and-quit) (define-key makefile-browser-map "\C-c\C-m" 'makefile-browser-insert-continuation) (define-key makefile-browser-map "q" 'makefile-browser-quit) ;; disable horizontal movement (define-key makefile-browser-map "\C-b" 'undefined) (define-key makefile-browser-map "\C-f" 'undefined)) (defvar makefile-mode-syntax-table nil) (if makefile-mode-syntax-table () (setq makefile-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?\( "() " makefile-mode-syntax-table) (modify-syntax-entry ?\) ")( " makefile-mode-syntax-table) (modify-syntax-entry ?\[ "(] " makefile-mode-syntax-table) (modify-syntax-entry ?\] ")[ " makefile-mode-syntax-table) (modify-syntax-entry ?\{ "(} " makefile-mode-syntax-table) (modify-syntax-entry ?\} "){ " makefile-mode-syntax-table) (modify-syntax-entry ?\' "\" " makefile-mode-syntax-table) (modify-syntax-entry ?\` "\" " makefile-mode-syntax-table) (modify-syntax-entry ?# "< " makefile-mode-syntax-table) (modify-syntax-entry ?\n "> " makefile-mode-syntax-table)) ;;; ------------------------------------------------------------ ;;; Internal variables. ;;; You don't need to configure below this line. ;;; ------------------------------------------------------------ (defvar makefile-target-table nil "Table of all target names known for this buffer.") (defvar makefile-macro-table nil "Table of all macro names known for this buffer.") (defvar makefile-browser-client "A buffer in Makefile mode that is currently using the browser.") (defvar makefile-browser-selection-vector nil) (defvar makefile-has-prereqs nil) (defvar makefile-need-target-pickup t) (defvar makefile-need-macro-pickup t) (defvar makefile-mode-hook '()) ;; Each element looks like '("GNU MAKE FUNCTION" "ARG" "ARG" ... ) ;; Each "ARG" is used as a prompt for a required argument. (defconst makefile-gnumake-functions-alist '( ;; Text functions ("subst" "From" "To" "In") ("patsubst" "Pattern" "Replacement" "In") ("strip" "Text") ("findstring" "Find what" "In") ("filter" "Pattern" "Text") ("filter-out" "Pattern" "Text") ("sort" "List") ;; Filename functions ("dir" "Names") ("notdir" "Names") ("suffix" "Names") ("basename" "Names") ("addsuffix" "Suffix" "Names") ("join" "List 1" "List 2") ("word" "Index" "Text") ("words" "Text") ("firstword" "Text") ("wildcard" "Pattern") ;; Misc functions ("foreach" "Variable" "List" "Text") ("origin" "Variable") ("shell" "Command"))) ;;; ------------------------------------------------------------ ;;; The mode function itself. ;;; ------------------------------------------------------------ ;;;###autoload (defun makefile-mode () "Major mode for editing Makefiles. This function ends by invoking the function(s) `makefile-mode-hook'. \\{makefile-mode-map} In the browser, use the following keys: \\{makefile-browser-map} Makefile mode can be configured by modifying the following variables: makefile-browser-buffer-name: Name of the macro- and target browser buffer. makefile-target-colon: The string that gets appended to all target names inserted by `makefile-insert-target'. \":\" or \"::\" are quite common values. makefile-macro-assign: The string that gets appended to all macro names inserted by `makefile-insert-macro'. The normal value should be \" = \", since this is what standard make expects. However, newer makes such as dmake allow a larger variety of different macro assignments, so you might prefer to use \" += \" or \" := \" . makefile-tab-after-target-colon: If you want a TAB (instead of a space) to be appended after the target colon, then set this to a non-nil value. makefile-browser-leftmost-column: Number of blanks to the left of the browser selection mark. makefile-browser-cursor-column: Column in which the cursor is positioned when it moves up or down in the browser. makefile-browser-selected-mark: String used to mark selected entries in the browser. makefile-browser-unselected-mark: String used to mark unselected entries in the browser. makefile-browser-auto-advance-after-selection-p: If this variable is set to a non-nil value the cursor will automagically advance to the next line after an item has been selected in the browser. makefile-pickup-everything-picks-up-filenames-p: If this variable is set to a non-nil value then `makefile-pickup-everything' also picks up filenames as targets (i.e. it calls `makefile-find-filenames-as-targets'), otherwise filenames are omitted. makefile-cleanup-continuations-p: If this variable is set to a non-nil value then makefile-mode will assure that no line in the file ends with a backslash (the continuation character) followed by any whitespace. This is done by silently removing the trailing whitespace, leaving the backslash itself intact. IMPORTANT: Please note that enabling this option causes makefile-mode to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\". makefile-browser-hook: A function or list of functions to be called just before the browser is entered. This is executed in the makefile buffer. makefile-special-targets-list: List of special targets. You will be offered to complete on one of those in the minibuffer whenever you enter a `.'. at the beginning of a line in Makefile mode." (interactive) (kill-all-local-variables) (make-local-variable 'local-write-file-hooks) (setq local-write-file-hooks '(makefile-cleanup-continuations makefile-warn-suspicious-lines)) (make-local-variable 'makefile-target-table) (make-local-variable 'makefile-macro-table) (make-local-variable 'makefile-has-prereqs) (make-local-variable 'makefile-need-target-pickup) (make-local-variable 'makefile-need-macro-pickup) ;; Font lock. (if (fboundp 'makefile-define-space-face) (makefile-define-space-face)) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(makefile-font-lock-keywords)) ;; Add-log. (make-local-variable 'add-log-current-defun-function) (setq add-log-current-defun-function 'makefile-add-log-defun) ;; Imenu. (make-local-variable 'imenu-create-index-function) (setq imenu-create-index-function 'makefile-menu-index-function) ;; Dabbrev. (make-local-variable 'dabbrev-abbrev-skip-leading-regexp) (setq dabbrev-abbrev-skip-leading-regexp "\\$") ;; Comment stuff. (make-local-variable 'comment-start) (setq comment-start "#") (make-local-variable 'comment-end) (setq comment-end "") (make-local-variable 'comment-start-skip) (setq comment-start-skip "#+[ \t]*") ;; become the current major mode (setq major-mode 'makefile-mode) (setq mode-name "Makefile") ;; Activate keymap and syntax table. (use-local-map makefile-mode-map) (set-syntax-table makefile-mode-syntax-table) ;; Real TABs are important in makefiles (setq indent-tabs-mode t) (run-hooks 'makefile-mode-hook)) ;;; Motion code. (defun makefile-next-dependency () "Move point to the beginning of the next dependency line." (interactive) (let ((here (point))) (end-of-line) (if (re-search-forward makefile-dependency-regex (point-max) t) (progn (beginning-of-line) t) ; indicate success (goto-char here) nil))) (defun makefile-previous-dependency () "Move point to the beginning of the previous dependency line." (interactive) (let ((here (point))) (beginning-of-line) (if (re-search-backward makefile-dependency-regex (point-min) t) (progn (beginning-of-line) t) ; indicate success (goto-char here) nil))) ;;; Electric keys. Blech. (defun makefile-electric-dot (arg) "Prompt for the name of a special target to insert. Only does electric insertion at beginning of line. Anywhere else just self-inserts." (interactive "p") (if (bolp) (makefile-insert-special-target) (self-insert-command arg))) (defun makefile-insert-special-target () "Propmt for and insert a special target name. Uses `makefile-special-targets' list." (interactive) (makefile-pickup-targets) (let ((special-target (completing-read "Special target: " makefile-special-targets-list nil nil nil))) (if (zerop (length special-target)) () (insert "." special-target ":") (makefile-forward-after-target-colon)))) (defun makefile-electric-equal (arg) "Prompt for name of a macro to insert. Only does prompting if point is at beginning of line. Anywhere else just self-inserts." (interactive "p") (makefile-pickup-macros) (if (bolp) (call-interactively 'makefile-insert-macro) (self-insert-command arg))) (defun makefile-insert-macro (macro-name) "Prepare definition of a new macro." (interactive "sMacro Name: ") (makefile-pickup-macros) (if (not (zerop (length macro-name))) (progn (beginning-of-line) (insert macro-name makefile-macro-assign) (setq makefile-need-macro-pickup t) (makefile-remember-macro macro-name)))) (defun makefile-insert-macro-ref (macro-name) "Complete on a list of known macros, then insert complete ref at point." (interactive (list (progn (makefile-pickup-macros) (completing-read "Refer to macro: " makefile-macro-table nil nil nil)))) (makefile-do-macro-insertion macro-name)) (defun makefile-insert-target (target-name) "Prepare definition of a new target (dependency line)." (interactive "sTarget: ") (if (not (zerop (length target-name))) (progn (beginning-of-line) (insert target-name makefile-target-colon) (makefile-forward-after-target-colon) (end-of-line) (setq makefile-need-target-pickup t) (makefile-remember-target target-name)))) (defun makefile-insert-target-ref (target-name) "Complete on a list of known targets, then insert target-ref at point." (interactive (list (progn (makefile-pickup-targets) (completing-read "Refer to target: " makefile-target-table nil nil nil)))) (if (not (zerop (length target-name))) (insert target-name " "))) (defun makefile-electric-colon (arg) "Prompt for name of new target. Prompting only happens at beginning of line. Anywhere else just self-inserts." (interactive "p") (if (bolp) (call-interactively 'makefile-insert-target) (self-insert-command arg))) ;;; ------------------------------------------------------------ ;;; Extracting targets and macros from an existing makefile ;;; ------------------------------------------------------------ (defun makefile-pickup-targets () "Notice names of all target definitions in Makefile." (interactive) (if (not makefile-need-target-pickup) nil (setq makefile-need-target-pickup nil) (setq makefile-target-table nil) (setq makefile-has-prereqs nil) (save-excursion (goto-char (point-min)) (while (re-search-forward makefile-dependency-regex (point-max) t) (makefile-add-this-line-targets))) (message "Read targets OK."))) (defun makefile-add-this-line-targets () (save-excursion (beginning-of-line) (let ((done-with-line nil) (line-number (1+ (count-lines (point-min) (point))))) (while (not done-with-line) (skip-chars-forward " \t") (if (not (setq done-with-line (or (eolp) (char-equal (char-after (point)) ?:)))) (progn (let* ((start-of-target-name (point)) (target-name (progn (skip-chars-forward "^ \t:#") (buffer-substring start-of-target-name (point)))) (has-prereqs (not (looking-at ":[ \t]*$")))) (if (makefile-remember-target target-name has-prereqs) (message "Picked up target \"%s\" from line %d" target-name line-number))))))))) (defun makefile-pickup-macros () "Notice names of all macro definitions in Makefile." (interactive) (if (not makefile-need-macro-pickup) nil (setq makefile-need-macro-pickup nil) (setq makefile-macro-table nil) (save-excursion (goto-char (point-min)) (while (re-search-forward makefile-macroassign-regex (point-max) t) (makefile-add-this-line-macro) (forward-line 1))) (message "Read macros OK."))) (defun makefile-add-this-line-macro () (save-excursion (beginning-of-line) (skip-chars-forward " \t") (if (not (eolp)) (let* ((start-of-macro-name (point)) (line-number (1+ (count-lines (point-min) (point)))) (macro-name (progn (skip-chars-forward "^ \t:#=*") (buffer-substring start-of-macro-name (point))))) (if (makefile-remember-macro macro-name) (message "Picked up macro \"%s\" from line %d" macro-name line-number)))))) (defun makefile-pickup-everything (arg) "Notice names of all macros and targets in Makefile. Prefix arg means force pickups to be redone." (interactive "P") (if arg (progn (setq makefile-need-target-pickup t) (setq makefile-need-macro-pickup t))) (makefile-pickup-macros) (makefile-pickup-targets) (if makefile-pickup-everything-picks-up-filenames-p (makefile-pickup-filenames-as-targets))) (defun makefile-pickup-filenames-as-targets () "Scan the current directory for filenames to use as targets. Checks each filename against `makefile-ignored-files-in-pickup-regex' and adds all qualifying names to the list of known targets." (interactive) (let* ((dir (file-name-directory (buffer-file-name))) (raw-filename-list (if dir (file-name-all-completions "" dir) (file-name-all-completions "" "")))) (mapcar '(lambda (name) (if (and (not (file-directory-p name)) (not (string-match makefile-ignored-files-in-pickup-regex name))) (if (makefile-remember-target name) (message "Picked up file \"%s\" as target" name)))) raw-filename-list))) ;;; Completion. (defun makefile-complete () "Perform completion on Makefile construct preceding point. Can complete variable and target names. The context determines which are considered." (interactive) (let* ((beg (save-excursion (skip-chars-backward "^$(){}:#= \t\n") (point))) (try (buffer-substring beg (point))) (do-macros nil) (paren nil)) (save-excursion (goto-char beg) (let ((pc (preceding-char))) (cond ;; Beginning of line means anything. ((bolp) ()) ;; Preceding "$" means macros only. ((= pc ?$) (setq do-macros t)) ;; Preceding "$(" or "${" means macros only. ((and (or (= pc ?{) (= pc ?\()) (progn (setq paren pc) (backward-char) (and (not (bolp)) (= (preceding-char) ?$)))) (setq do-macros t))))) ;; Try completion. (let* ((table (append (if do-macros '() makefile-target-table) makefile-macro-table)) (completion (try-completion try table))) (cond ;; Exact match, so insert closing paren or colon. ((eq completion t) (insert (if do-macros (if (eq paren ?{) ?} ?\)) (if (save-excursion (goto-char beg) (bolp)) ":" " ")))) ;; No match. ((null completion) (message "Can't find completion for \"%s\"" try) (ding)) ;; Partial completion. ((not (string= try completion)) ;; FIXME it would be nice to supply the closing paren if an ;; exact, unambiguous match were found. That is not possible ;; right now. Ditto closing ":" for targets. (delete-region beg (point)) ;; DO-MACROS means doing macros only. If not that, then check ;; to see if this completion is a macro. Special insertion ;; must be done for macros. (if (or do-macros (assoc completion makefile-macro-table)) (let ((makefile-use-curly-braces-for-macros-p (or (eq paren ?{) makefile-use-curly-braces-for-macros-p))) (delete-backward-char 2) (makefile-do-macro-insertion completion) (delete-backward-char 1)) ;; Just insert targets. (insert completion))) ;; Can't complete any more, so make completion list. FIXME ;; this doesn't do the right thing when the completion is ;; actually inserted. I don't think there is an easy way to do ;; that. (t (message "Making completion list...") (let ((list (all-completions try table))) (with-output-to-temp-buffer "*Completions*" (display-completion-list list))) (message "Making completion list...done")))))) ;; Backslashification. Stolen from cc-mode.el. (defun makefile-backslashify-current-line (doit) (end-of-line) (if doit (if (not (save-excursion (forward-char -1) (eq (char-after (point)) ?\\ ))) (progn (if (>= (current-column) makefile-backslash-column) (insert " \\") (while (<= (current-column) makefile-backslash-column) (insert "\t") (end-of-line)) (delete-char -1) (while (< (current-column) makefile-backslash-column) (insert " ") (end-of-line)) (insert "\\")))) (if (not (bolp)) (progn (forward-char -1) (if (eq (char-after (point)) ?\\ ) (let ((saved (save-excursion (end-of-line) (point)))) (skip-chars-backward " \t") (delete-region (point) saved))))))) (defun makefile-backslash-region (beg end arg) "Insert backslashes at end of every line in region. Useful for defining multi-line rules. If called with a prefix argument, trailing backslahes are removed." (interactive "r\nP") (save-excursion (let ((do-lastline-p (progn (goto-char end) (not (bolp))))) (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (while (not (save-excursion (forward-line 1) (eobp))) (makefile-backslashify-current-line (null arg)) (forward-line 1))) (and do-lastline-p (progn (goto-char end) (makefile-backslashify-current-line (null arg))))))) ;;; ------------------------------------------------------------ ;;; Browser mode. ;;; ------------------------------------------------------------ (defun makefile-browser-format-target-line (target selected) (format (concat (make-string makefile-browser-leftmost-column ?\ ) (if selected makefile-browser-selected-mark makefile-browser-unselected-mark) "%s%s") target makefile-target-colon)) (defun makefile-browser-format-macro-line (macro selected) (format (concat (make-string makefile-browser-leftmost-column ?\ ) (if selected makefile-browser-selected-mark makefile-browser-unselected-mark) (makefile-format-macro-ref macro)))) (defun makefile-browser-fill (targets macros) (let ((inhibit-read-only t)) (goto-char (point-min)) (erase-buffer) (mapconcat (function (lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n"))) targets "") (mapconcat (function (lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n"))) macros "") (sort-lines nil (point-min) (point-max)) (goto-char (1- (point-max))) (delete-char 1) ; remove unnecessary newline at eob (goto-char (point-min)) (forward-char makefile-browser-cursor-column))) ;;; ;;; Moving up and down in the browser ;;; (defun makefile-browser-next-line () "Move the browser selection cursor to the next line." (interactive) (if (not (makefile-last-line-p)) (progn (forward-line 1) (forward-char makefile-browser-cursor-column)))) (defun makefile-browser-previous-line () "Move the browser selection cursor to the previous line." (interactive) (if (not (makefile-first-line-p)) (progn (forward-line -1) (forward-char makefile-browser-cursor-column)))) ;;; ;;; Quitting the browser (returns to client buffer) ;;; (defun makefile-browser-quit () "Leave the browser and return to the makefile buffer." (interactive) (let ((my-client makefile-browser-client)) (setq makefile-browser-client nil) ; we quitted, so NO client! (set-buffer-modified-p nil) (kill-buffer (current-buffer)) (pop-to-buffer my-client))) ;;; ;;; Toggle state of a browser item ;;; (defun makefile-browser-toggle () "Toggle the selection state of the browser item at the cursor position." (interactive) (let ((this-line (count-lines (point-min) (point)))) (setq this-line (max 1 this-line)) (makefile-browser-toggle-state-for-line this-line) (goto-line this-line) (let ((inhibit-read-only t)) (beginning-of-line) (if (makefile-browser-on-macro-line-p) (let ((macro-name (makefile-browser-this-line-macro-name))) (kill-line) (insert (makefile-browser-format-macro-line macro-name (makefile-browser-get-state-for-line this-line)))) (let ((target-name (makefile-browser-this-line-target-name))) (kill-line) (insert (makefile-browser-format-target-line target-name (makefile-browser-get-state-for-line this-line)))))) (beginning-of-line) (forward-char makefile-browser-cursor-column) (if makefile-browser-auto-advance-after-selection-p (makefile-browser-next-line)))) ;;; ;;; Making insertions into the client buffer ;;; (defun makefile-browser-insert-continuation () "Insert a makefile continuation. In the makefile buffer, go to (end-of-line), insert a \'\\\' character, insert a new blank line, go to that line and indent by one TAB. This is most useful in the process of creating continued lines when copying large dependencies from the browser to the client buffer. \(point) advances accordingly in the client buffer." (interactive) (save-excursion (set-buffer makefile-browser-client) (end-of-line) (insert "\\\n\t"))) (defun makefile-browser-insert-selection () "Insert all selected targets and/or macros in the makefile buffer. Insertion takes place at point." (interactive) (save-excursion (goto-line 1) (let ((current-line 1)) (while (not (eobp)) (if (makefile-browser-get-state-for-line current-line) (makefile-browser-send-this-line-item)) (forward-line 1) (setq current-line (1+ current-line)))))) (defun makefile-browser-insert-selection-and-quit () (interactive) (makefile-browser-insert-selection) (makefile-browser-quit)) (defun makefile-browser-send-this-line-item () (if (makefile-browser-on-macro-line-p) (save-excursion (let ((macro-name (makefile-browser-this-line-macro-name))) (set-buffer makefile-browser-client) (insert (makefile-format-macro-ref macro-name) " "))) (save-excursion (let ((target-name (makefile-browser-this-line-target-name))) (set-buffer makefile-browser-client) (insert target-name " "))))) (defun makefile-browser-start-interaction () (use-local-map makefile-browser-map) (setq buffer-read-only t)) (defun makefile-browse (targets macros) (interactive) (if (zerop (+ (length targets) (length macros))) (progn (beep) (message "No macros or targets to browse! Consider running 'makefile-pickup-everything\'")) (let ((browser-buffer (get-buffer-create makefile-browser-buffer-name))) (pop-to-buffer browser-buffer) (make-variable-buffer-local 'makefile-browser-selection-vector) (makefile-browser-fill targets macros) (shrink-window-if-larger-than-buffer) (setq makefile-browser-selection-vector (make-vector (+ (length targets) (length macros)) nil)) (makefile-browser-start-interaction)))) (defun makefile-switch-to-browser () (interactive) (run-hooks 'makefile-browser-hook) (setq makefile-browser-client (current-buffer)) (makefile-pickup-targets) (makefile-pickup-macros) (makefile-browse makefile-target-table makefile-macro-table)) ;;; ------------------------------------------------------------ ;;; Up-to-date overview buffer ;;; ------------------------------------------------------------ (defun makefile-create-up-to-date-overview () "Create a buffer containing an overview of the state of all known targets. Known targets are targets that are explicitly defined in that makefile; in other words, all targets that appear on the left hand side of a dependency in the makefile." (interactive) (if (y-or-n-p "Are you sure that the makefile being edited is consistent? ") ;; ;; The rest of this function operates on a temporary makefile, created by ;; writing the current contents of the makefile buffer. ;; (let ((saved-target-table makefile-target-table) (this-buffer (current-buffer)) (makefile-up-to-date-buffer (get-buffer-create makefile-up-to-date-buffer-name)) (filename (makefile-save-temporary)) ;; ;; Forget the target table because it may contain picked-up filenames ;; that are not really targets in the current makefile. ;; We don't want to query these, so get a new target-table with just the ;; targets that can be found in the makefile buffer. ;; The 'old' target table will be restored later. ;; (real-targets (progn (makefile-pickup-targets) makefile-target-table)) (prereqs makefile-has-prereqs) ) (set-buffer makefile-up-to-date-buffer) (setq buffer-read-only nil) (erase-buffer) (makefile-query-targets filename real-targets prereqs) (if (zerop (buffer-size)) ; if it did not get us anything (progn (kill-buffer (current-buffer)) (message "No overview created!"))) (set-buffer this-buffer) (setq makefile-target-table saved-target-table) (if (get-buffer makefile-up-to-date-buffer-name) (progn (pop-to-buffer (get-buffer makefile-up-to-date-buffer-name)) (shrink-window-if-larger-than-buffer) (sort-lines nil (point-min) (point-max)) (setq buffer-read-only t)))))) (defun makefile-save-temporary () "Create a temporary file from the current makefile buffer." (let ((filename (makefile-generate-temporary-filename))) (write-region (point-min) (point-max) filename nil 0) filename)) ; return the filename (defun makefile-generate-temporary-filename () "Create a filename suitable for use in `makefile-save-temporary'. Be careful to allow brain-dead file systems (DOS, SYSV ...) to cope with the generated name!" (let ((my-name (user-login-name)) (my-uid (int-to-string (user-uid)))) (concat "mktmp" (if (> (length my-name) 3) (substring my-name 0 3) my-name) "." (if (> (length my-uid) 3) (substring my-uid 0 3) my-uid)))) (defun makefile-query-targets (filename target-table prereq-list) "Fill the up-to-date overview buffer. Checks each target in TARGET-TABLE using `makefile-query-one-target-method' and generates the overview, one line per target name." (insert (mapconcat (function (lambda (item) (let* ((target-name (car item)) (no-prereqs (not (member target-name prereq-list))) (needs-rebuild (or no-prereqs (funcall makefile-query-one-target-method target-name filename)))) (format "\t%s%s" target-name (cond (no-prereqs " .. has no prerequisites") (needs-rebuild " .. NEEDS REBUILD") (t " .. is up to date")))) )) target-table "\n")) (goto-char (point-min)) (delete-file filename)) ; remove the tmpfile (defun makefile-query-by-make-minus-q (target &optional filename) (not (zerop (call-process makefile-brave-make nil nil nil "-f" filename "-q" target)))) ;;; ------------------------------------------------------------ ;;; Continuation cleanup ;;; ------------------------------------------------------------ (defun makefile-cleanup-continuations () (if (eq major-mode 'makefile-mode) (if (and makefile-cleanup-continuations-p (not buffer-read-only)) (save-excursion (goto-char (point-min)) (while (re-search-forward "\\\\[ \t]+$" (point-max) t) (replace-match "\\" t t)))))) ;;; ------------------------------------------------------------ ;;; Warn of suspicious lines ;;; ------------------------------------------------------------ (defun makefile-warn-suspicious-lines () (let ((dont-save nil)) (if (eq major-mode 'makefile-mode) (let ((suspicious (save-excursion (goto-char (point-min)) (re-search-forward "\\(^[\t]+$\\)\\|\\(^[ ]+[\t]\\)" (point-max) t)))) (if suspicious (let ((line-nr (count-lines (point-min) suspicious))) (setq dont-save (not (y-or-n-p (format "Suspicious line %d. Save anyway " line-nr)))))))) dont-save)) ;;; ------------------------------------------------------------ ;;; GNU make function support ;;; ------------------------------------------------------------ (defun makefile-insert-gmake-function () "Insert a GNU make function call. Asks for the name of the function to use (with completion). Then prompts for all required parameters." (interactive) (let* ((gm-function-name (completing-read "Function: " makefile-gnumake-functions-alist nil t nil)) (gm-function-prompts (cdr (assoc gm-function-name makefile-gnumake-functions-alist)))) (if (not (zerop (length gm-function-name))) (insert (makefile-format-macro-ref (concat gm-function-name " " (makefile-prompt-for-gmake-funargs gm-function-name gm-function-prompts))) " ")))) (defun makefile-prompt-for-gmake-funargs (function-name prompt-list) (mapconcat (function (lambda (one-prompt) (read-string (format "[%s] %s: " function-name one-prompt) nil))) prompt-list ",")) ;;; ------------------------------------------------------------ ;;; Utility functions ;;; ------------------------------------------------------------ (defun makefile-do-macro-insertion (macro-name) "Insert a macro reference." (if (not (zerop (length macro-name))) (if (assoc macro-name makefile-runtime-macros-list) (insert "$" macro-name) (insert (makefile-format-macro-ref macro-name))))) (defun makefile-remember-target (target-name &optional has-prereqs) "Remember a given target if it is not already remembered for this buffer." (if (not (zerop (length target-name))) (progn (if (not (assoc target-name makefile-target-table)) (setq makefile-target-table (cons (list target-name) makefile-target-table))) (if has-prereqs (setq makefile-has-prereqs (cons target-name makefile-has-prereqs)))))) (defun makefile-remember-macro (macro-name) "Remember a given macro if it is not already remembered for this buffer." (if (not (zerop (length macro-name))) (if (not (assoc macro-name makefile-macro-table)) (setq makefile-macro-table (cons (list macro-name) makefile-macro-table))))) (defun makefile-forward-after-target-colon () "Move point forward after inserting the terminating colon of a target. This acts according to the value of `makefile-tab-after-target-colon'." (if makefile-tab-after-target-colon (insert "\t") (insert " "))) (defun makefile-browser-on-macro-line-p () "Determine if point is on a macro line in the browser." (save-excursion (beginning-of-line) (re-search-forward "\\$[{(]" (makefile-end-of-line-point) t))) (defun makefile-browser-this-line-target-name () "Extract the target name from a line in the browser." (save-excursion (end-of-line) (skip-chars-backward "^ \t") (buffer-substring (point) (1- (makefile-end-of-line-point))))) (defun makefile-browser-this-line-macro-name () "Extract the macro name from a line in the browser." (save-excursion (beginning-of-line) (re-search-forward "\\$[{(]" (makefile-end-of-line-point) t) (let ((macro-start (point))) (skip-chars-forward "^})") (buffer-substring macro-start (point))))) (defun makefile-format-macro-ref (macro-name) "Format a macro reference. Uses `makefile-use-curly-braces-for-macros-p'." (if (or (char-equal ?\( (string-to-char macro-name)) (char-equal ?\{ (string-to-char macro-name))) (format "$%s" macro-name) (if makefile-use-curly-braces-for-macros-p (format "${%s}" macro-name) (format "$(%s)" macro-name)))) (defun makefile-browser-get-state-for-line (n) (aref makefile-browser-selection-vector (1- n))) (defun makefile-browser-set-state-for-line (n to-state) (aset makefile-browser-selection-vector (1- n) to-state)) (defun makefile-browser-toggle-state-for-line (n) (makefile-browser-set-state-for-line n (not (makefile-browser-get-state-for-line n)))) (defun makefile-beginning-of-line-point () (save-excursion (beginning-of-line) (point))) (defun makefile-end-of-line-point () (save-excursion (end-of-line) (point))) (defun makefile-last-line-p () (= (makefile-end-of-line-point) (point-max))) (defun makefile-first-line-p () (= (makefile-beginning-of-line-point) (point-min))) ;;; Support for other packages, like add-log and imenu. (defun makefile-add-log-defun () ;; "Return name of target or macro point is in, or nil." (save-excursion (beginning-of-line) (cond ((looking-at makefile-macroassign-regex) (buffer-substring (match-beginning 1) (match-end 1))) ((progn (or (eobp) (forward-char)) (re-search-backward makefile-dependency-regex nil t)) (buffer-substring (match-beginning 1) (match-end 1))) (t nil)))) ;; FIXME it might be nice to have them separated by macro vs target. (defun makefile-menu-index-function () ;; "Generate alist of indices for imenu." (let (alist stupid (re (concat makefile-dependency-regex "\\|" makefile-macroassign-regex))) (imenu-progress-message stupid 0) (goto-char (point-min)) (while (re-search-forward re nil t) (imenu-progress-message stupid) (let ((n (if (match-beginning 1) 1 5))) (setq alist (cons (cons (buffer-substring (match-beginning n) (match-end n)) (match-beginning n)) alist)))) (imenu-progress-message stupid 100) (nreverse alist))) (defun makefile-define-space-face () (make-face 'makefile-space-face) (or (not (eq window-system 'x)) (face-differs-from-default-p 'makefile-space-face) (let* ((params (frame-parameters)) (light-bg (cdr (assq 'background-mode params))) (bg-color (cond ((eq (cdr (assq 'display-type params)) 'mono) (if light-bg "black" "white")) ((eq (cdr (assq 'display-type params)) 'grayscale) (if light-bg "black" "white")) (light-bg ; Light color background. "hotpink") (t ; Dark color background. "hotpink")))) (set-face-background 'makefile-space-face bg-color)))) ;;; make-mode.el ends here emacs-19.30/lisp/makeinfo.el100444 12120 1 21362 6045204205 14203 0ustar rmsdaemon;;; makeinfo.el --- run makeinfo conveniently ;; Copyright (C) 1991, 1993 Free Software Foundation, Inc. ;; Author: Robert J. Chassell ;; Maintainer: FSF ;; 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: ;;; The Texinfo mode `makeinfo' related commands are: ;; makeinfo-region to run makeinfo on the current region. ;; makeinfo-buffer to run makeinfo on the current buffer, or ;; with optional prefix arg, on current region ;; kill-compilation to kill currently running makeinfo job ;; makeinfo-recenter-makeinfo-buffer to redisplay *compilation* buffer ;;; Keybindings (defined in `texinfo.el') ;; makeinfo bindings ; (define-key texinfo-mode-map "\C-c\C-m\C-r" 'makeinfo-region) ; (define-key texinfo-mode-map "\C-c\C-m\C-b" 'makeinfo-buffer) ; (define-key texinfo-mode-map "\C-c\C-m\C-k" 'kill-compilation) ; (define-key texinfo-mode-map "\C-c\C-m\C-l" ; 'makeinfo-recenter-compilation-buffer) ;;; Code: ;;; Variables used by `makeinfo' (require 'compile) (defvar makeinfo-run-command "makeinfo" "*Command used to run `makeinfo' subjob. 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'; the proper way to specify those is with the Texinfo commands `@footnotestyle` and `@paragraphindent'.") (require 'texinfo) (defvar makeinfo-compilation-process nil "Process that runs `makeinfo'. Should start out nil.") (defvar makeinfo-temp-file nil "Temporary file name used for text being sent as input to `makeinfo'.") (defvar makeinfo-output-file-name nil "Info file name used for text output by `makeinfo'.") ;;; The `makeinfo' function definitions (defun makeinfo-region (region-beginning region-end) "Make Info file from region of current Texinfo file, and switch to it. This command does not offer the `next-error' feature since it would apply to a temporary file, not the original; use the `makeinfo-buffer' command to gain use of `next-error'." (interactive "r") (let (filename-or-header filename-or-header-beginning filename-or-header-end) ;; Cannot use `let' for makeinfo-temp-file or ;; makeinfo-output-file-name since `makeinfo-compilation-sentinel' ;; needs them. (setq makeinfo-temp-file (concat (make-temp-name (substring (buffer-file-name) 0 (or (string-match "\\.tex" (buffer-file-name)) (length (buffer-file-name))))) ".texinfo")) (save-excursion (save-restriction (widen) (goto-char (point-min)) (let ((search-end (save-excursion (forward-line 100) (point)))) ;; Find and record the Info filename, ;; or else explain that a filename is needed. (if (re-search-forward "^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*" search-end t) (setq makeinfo-output-file-name (buffer-substring (match-beginning 1) (match-end 1))) (error "The texinfo file needs a line saying: @setfilename ")) ;; Find header and specify its beginning and end. (goto-char (point-min)) (if (and (prog1 (search-forward tex-start-of-header search-end t) (beginning-of-line) ;; Mark beginning of header. (setq filename-or-header-beginning (point))) (prog1 (search-forward tex-end-of-header nil t) (beginning-of-line) ;; Mark end of header (setq filename-or-header-end (point)))) ;; Insert the header into the temporary file. (write-region (min filename-or-header-beginning region-beginning) filename-or-header-end makeinfo-temp-file nil nil) ;; Else no header; insert @filename line into temporary file. (goto-char (point-min)) (search-forward "@setfilename" search-end t) (beginning-of-line) (setq filename-or-header-beginning (point)) (forward-line 1) (setq filename-or-header-end (point)) (write-region (min filename-or-header-beginning region-beginning) filename-or-header-end makeinfo-temp-file nil nil)) ;; Insert the region into the file. (write-region (max region-beginning filename-or-header-end) region-end makeinfo-temp-file t nil) ;; Run the `makeinfo-compile' command in the *compilation* buffer (save-excursion (makeinfo-compile (concat makeinfo-run-command " " makeinfo-options " " makeinfo-temp-file) "Use `makeinfo-buffer' to gain use of the `next-error' command" nil))))))) ;;; Actually run makeinfo. COMMAND is the command to run. ;;; ERROR-MESSAGE is what to say when next-error can't find another error. ;;; If PARSE-ERRORS is non-nil, do try to parse error messages. (defun makeinfo-compile (command error-message parse-errors) (let ((buffer (compile-internal command error-message nil (and (not parse-errors) ;; If we do want to parse errors, pass nil. ;; Otherwise, use this function, which won't ;; ever find any errors. '(lambda (&rest ignore) (setq compilation-error-list nil)))))) (set-process-sentinel (get-buffer-process buffer) 'makeinfo-compilation-sentinel))) ;; Delete makeinfo-temp-file after processing is finished, ;; and visit Info file. ;; This function is called when the compilation process changes state. ;; Based on `compilation-sentinel' in compile.el (defun makeinfo-compilation-sentinel (proc msg) (compilation-sentinel proc msg) (if (and makeinfo-temp-file (file-exists-p makeinfo-temp-file)) (delete-file makeinfo-temp-file)) ;; Always use the version on disk. (if (get-file-buffer makeinfo-output-file-name) (progn (set-buffer makeinfo-output-file-name) (revert-buffer t t)) (find-file makeinfo-output-file-name)) (goto-char (point-min))) (defun makeinfo-buffer () "Make Info file from current buffer. Use the \\[next-error] command to move to the next error \(if there are errors\)." (interactive) (cond ((null buffer-file-name) (error "Buffer not visiting any file")) ((buffer-modified-p) (if (y-or-n-p "Buffer modified; do you want to save it? ") (save-buffer)))) ;; Find and record the Info filename, ;; or else explain that a filename is needed. (save-excursion (goto-char (point-min)) (let ((search-end (save-excursion (forward-line 100) (point)))) (if (re-search-forward "^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*" search-end t) (setq makeinfo-output-file-name (buffer-substring (match-beginning 1) (match-end 1))) (error "The texinfo file needs a line saying: @setfilename ")))) (save-excursion (makeinfo-compile (concat makeinfo-run-command " " makeinfo-options " " buffer-file-name) "No more errors." t))) (defun makeinfo-recenter-compilation-buffer (linenum) "Redisplay `*compilation*' buffer so most recent output can be seen. The last line of the buffer is displayed on line LINE of the window, or centered if LINE is nil." (interactive "P") (let ((makeinfo-buffer (get-buffer "*compilation*")) (old-buffer (current-buffer))) (if (null makeinfo-buffer) (message "No *compilation* buffer") (pop-to-buffer makeinfo-buffer) (bury-buffer makeinfo-buffer) (goto-char (point-max)) (recenter (if linenum (prefix-numeric-value linenum) (/ (window-height) 2))) (pop-to-buffer old-buffer) ))) ;;; Place `provide' at end of file. (provide 'makeinfo) ;;; makeinfo.el ends here emacs-19.30/lisp/makesum.el100444 74777 1 7165 5353350070 14066 0ustar esrdaemon;;; makesum.el --- generate key binding summary for Emacs ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help ;; 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: ;; Displays a nice human-readable summary of all keybindings in a ;; two-column format. ;;; Code: ;;;###autoload (defun make-command-summary () "Make a summary of current key bindings in the buffer *Summary*. Previous contents of that buffer are killed first." (interactive) (message "Making command summary...") ;; This puts a description of bindings in a buffer called *Help*. (save-window-excursion (describe-bindings)) (with-output-to-temp-buffer "*Summary*" (save-excursion (let ((cur-mode mode-name)) (set-buffer standard-output) (erase-buffer) (insert-buffer-substring "*Help*") (goto-char (point-min)) (delete-region (point) (progn (forward-line 1) (point))) (while (search-forward " " nil t) (replace-match " ")) (goto-char (point-min)) (while (search-forward "-@ " nil t) (replace-match "-SP")) (goto-char (point-min)) (while (search-forward " .. ~ " nil t) (replace-match "SP .. ~")) (goto-char (point-min)) (while (search-forward "C-?" nil t) (replace-match "DEL")) (goto-char (point-min)) (while (search-forward "C-i" nil t) (replace-match "TAB")) (goto-char (point-min)) (if (re-search-forward "^Local Bindings:" nil t) (progn (forward-char -1) (insert " for " cur-mode " Mode") (while (search-forward "??\n" nil t) (delete-region (point) (progn (forward-line -1) (point)))))) (goto-char (point-min)) (insert "Emacs command summary, " (substring (current-time-string) 0 10) ".\n") ;; Delete "key binding" and underlining of dashes. (delete-region (point) (progn (forward-line 2) (point))) (forward-line 1) ;Skip blank line (while (not (eobp)) (let ((beg (point))) (or (re-search-forward "^$" nil t) (goto-char (point-max))) (double-column beg (point)) (forward-line 1))) (goto-char (point-min))))) (message "Making command summary...done")) (defun double-column (start end) (interactive "r") (let (half cnt line lines nlines (from-end (- (point-max) end))) (setq nlines (count-lines start end)) (if (<= nlines 1) nil (setq half (/ (1+ nlines) 2)) (goto-char start) (save-excursion (forward-line half) (while (< half nlines) (setq half (1+ half)) (setq line (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq lines (cons line lines)) (delete-region (point) (progn (forward-line 1) (point))))) (setq lines (nreverse lines)) (while lines (end-of-line) (indent-to 41) (insert (car lines)) (forward-line 1) (setq lines (cdr lines)))) (goto-char (- (point-max) from-end)))) ;;; makesum.el ends here emacs-19.30/lisp/man.el100444 12120 1 113426 6055442370 13220 0ustar rmsdaemon;;; man.el --- browse UNIX manual pages ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: Barry A. Warsaw ;; Keywords: help ;; Adapted-By: ESR, pot ;; 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 code provides a function, `man', with which you can browse ;; UNIX manual pages. Formatting is done in background so that you ;; can continue to use your Emacs while processing is going on. ;; ;; The mode also supports hypertext-like following of manual page SEE ;; ALSO references, and other features. See below or do `?' in a ;; manual page buffer for details. ;; ========== Credits and History ========== ;; In mid 1991, several people posted some interesting improvements to ;; man.el from the standard emacs 18.57 distribution. I liked many of ;; these, but wanted everthing in one single package, so I decided ;; to incorporate them into a single manual browsing mode. While ;; much of the code here has been rewritten, and some features added, ;; these folks deserve lots of credit for providing the initial ;; excellent packages on which this one is based. ;; Nick Duffek , posted a very nice ;; improvement which retrieved and cleaned the manpages in a ;; background process, and which correctly deciphered such options as ;; man -k. ;; Eric Rose , submitted manual.el which ;; provided a very nice manual browsing mode. ;; This package was available as `superman.el' from the LCD package ;; for some time before it was accepted into Emacs 19. The entry ;; point and some other names have been changed to make it a drop-in ;; replacement for the old man.el package. ;; Francesco Potorti` cleaned it up thoroughly, ;; making it faster, more robust and more tolerant of different ;; systems' man idiosynchrasies. ;; ========== Features ========== ;; + Runs "man" in the background and pipes the results through a ;; series of sed and awk scripts so that all retrieving and cleaning ;; is done in the background. The cleaning commands are configurable. ;; + Syntax is the same as Un*x man ;; + Functionality is the same as Un*x man, including "man -k" and ;; "man
", etc. ;; + Provides a manual browsing mode with keybindings for traversing ;; the sections of a manpage, following references in the SEE ALSO ;; section, and more. ;; + Multiple manpages created with the same man command are put into ;; a narrowed buffer circular list. ;; ============= TODO =========== ;; - Add a command for printing. ;; - The awk script deletes multiple blank lines. This behaviour does ;; not allow to understand if there was indeed a blank line at the ;; end or beginning of a page (after the header, or before the ;; footer). A different algorithm should be used. It is easy to ;; compute how many blank lines there are before and after the page ;; headers, and after the page footer. But it is possible to compute ;; the number of blank lines before the page footer by euristhics ;; only. Is it worth doing? ;; - Allow a user option to mean that all the manpages should go in ;; the same buffer, where they can be browsed with M-n and M-p. ;; - Allow completion on the manpage name when calling man. This ;; requires a reliable list of places where manpages can be found. The ;; drawback would be that if the list is not complete, the user might ;; be led to believe that the manpages in the missing directories do ;; not exist. ;;; Code: (require 'assoc) ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ;; empty defvars (keep the compiler quiet) (defvar Man-notify) (defvar Man-current-page) (defvar Man-page-list) (defvar Man-filter-list) (defvar Man-original-frame) (defvar Man-arguments) (defvar Man-sections-alist) (defvar Man-refpages-alist) (defvar Man-uses-untabify-flag) (defvar Man-page-mode-string) (defvar Man-sed-script) ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ;; user variables (defvar Man-fontify-manpage-flag t "*Make up the manpage with fonts.") (defvar Man-overstrike-face 'bold "*Face to use when fontifying overstrike.") (defvar Man-underline-face 'underline "*Face to use when fontifying underlining.") ;; Use the value of the obsolete user option Man-notify, if set. (defvar Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly) "*Selects the behavior when manpage is ready. This variable may have one of the following values, where (sf) means that the frames are switched, so the manpage is displayed in the frame where the man command was called from: newframe -- put the manpage in its own frame (see `Man-frame-parameters') pushy -- make the manpage the current buffer in the current window bully -- make the manpage the current buffer and only window (sf) aggressive -- make the manpage the current buffer in the other window (sf) friendly -- display manpage in the other window but don't make current (sf) polite -- don't display manpage, but prints message and beep when ready quiet -- like `polite', but don't beep meek -- make no indication that the manpage is ready Any other value of `Man-notify-method' is equivalent to `meek'.") (defvar Man-frame-parameters nil "*Frame parameter list for creating a new frame for a manual page.") (defvar Man-downcase-section-letters-flag t "*Letters in sections are converted to lower case. Some Un*x man commands can't handle uppercase letters in sections, for example \"man 2V chmod\", but they are often displayed in the manpage with the upper case letter. When this variable is t, the section letter (e.g., \"2V\") is converted to lowercase (e.g., \"2v\") before being sent to the man background process.") (defvar Man-circular-pages-flag t "*If t, the manpage list is treated as circular for traversal.") (defvar Man-section-translations-alist (list '("3C++" . "3") ;; Some systems have a real 3x man section, so let's comment this. ;; '("3X" . "3") ; Xlib man pages '("3X11" . "3") '("1-UCB" . "")) "*Association list of bogus sections to real section numbers. Some manpages (e.g. the Sun C++ 2.1 manpages) have section numbers in their references which Un*x `man' does not recognize. This association list is used to translate those sections, when found, to the associated section number.") (defvar manual-program "man" "The name of the program that produces man pages.") (defvar Man-untabify-command "pr" "Command used for untabifying.") (defvar Man-untabify-command-args (list "-t" "-e") "List of arguments to be passed to Man-untabify-command (which see).") (defvar Man-sed-command "sed" "Command used for processing sed scripts.") (defvar Man-awk-command "awk" "Command used for processing awk scripts.") (defvar Man-mode-line-format '("" mode-line-modified mode-line-buffer-identification " " global-mode-string " " Man-page-mode-string " %[(" mode-name mode-line-process minor-mode-alist ")%]----" (-3 . "%p") "-%-") "Mode line format for manual mode buffer.") (defvar Man-mode-map nil "Keymap for Man mode.") (defvar Man-mode-hook nil "Hook run when Man mode is enabled.") (defvar Man-cooked-hook nil "Hook run after removing backspaces but before Man-mode processing.") (defvar Man-name-regexp "[-a-zA-Z0-9_][-a-zA-Z0-9_.]*" "Regular expression describing the name of a manpage (without section).") (defvar Man-section-regexp "[0-9][a-zA-Z+]*\\|[LNln]" "Regular expression describing a manpage section within parentheses.") (defvar Man-page-header-regexp (concat "^[ \t]*\\(" Man-name-regexp "(\\(" Man-section-regexp "\\))\\).*\\1") "Regular expression describing the heading of a page.") (defvar Man-heading-regexp "^\\([A-Z][A-Z ]+\\)$" "Regular expression describing a manpage heading entry.") (defvar Man-see-also-regexp "SEE ALSO" "Regular expression for SEE ALSO heading (or your equivalent). This regexp should not start with a `^' character.") (defvar Man-first-heading-regexp "^[ \t]*NAME$\\|^[ \t]*No manual entry fo.*$" "Regular expression describing first heading on a manpage. This regular expression should start with a `^' character.") (defvar Man-reference-regexp (concat "\\(" Man-name-regexp "\\)(\\(" Man-section-regexp "\\))") "Regular expression describing a reference in the SEE ALSO section.") (defvar Man-switches "" "Switches passed to the man command, as a single string.") (defvar Man-specified-section-option (if (string-match "-solaris[0-9.]*$" system-configuration) "-s" "") "Option that indicates a specified a manual section name.") ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; end user variables ;; other variables and keymap initializations (make-variable-buffer-local 'Man-sections-alist) (make-variable-buffer-local 'Man-refpages-alist) (make-variable-buffer-local 'Man-page-list) (make-variable-buffer-local 'Man-current-page) (make-variable-buffer-local 'Man-page-mode-string) (make-variable-buffer-local 'Man-original-frame) (make-variable-buffer-local 'Man-arguments) (setq-default Man-sections-alist nil) (setq-default Man-refpages-alist nil) (setq-default Man-page-list nil) (setq-default Man-current-page 0) (setq-default Man-page-mode-string "1 of 1") (defconst Man-sysv-sed-script "\ /\b/ { s/_\b//g s/\b_//g s/o\b+/o/g s/+\bo/o/g :ovstrk s/\\(.\\)\b\\1/\\1/g t ovstrk } /\e\\[[0-9][0-9]*m/ s///g" "Script for sysV-like sed to nuke backspaces and ANSI codes from manpages.") (defconst Man-berkeley-sed-script "\ /\b/ { s/_\b//g\\ s/\b_//g\\ s/o\b+/o/g\\ s/+\bo/o/g\\ :ovstrk\\ s/\\(.\\)\b\\1/\\1/g\\ t ovstrk\\ }\\ /\e\\[[0-9][0-9]*m/ s///g" "Script for berkeley-like sed to nuke backspaces and ANSI codes from manpages.") (if Man-mode-map nil (setq Man-mode-map (make-keymap)) (suppress-keymap Man-mode-map) (define-key Man-mode-map " " 'scroll-up) (define-key Man-mode-map "\177" 'scroll-down) (define-key Man-mode-map "n" 'Man-next-section) (define-key Man-mode-map "p" 'Man-previous-section) (define-key Man-mode-map "\en" 'Man-next-manpage) (define-key Man-mode-map "\ep" 'Man-previous-manpage) (define-key Man-mode-map ">" 'end-of-buffer) (define-key Man-mode-map "<" 'beginning-of-buffer) (define-key Man-mode-map "." 'beginning-of-buffer) (define-key Man-mode-map "r" 'Man-follow-manual-reference) (define-key Man-mode-map "t" 'toggle-truncate-lines) (define-key Man-mode-map "g" 'Man-goto-section) (define-key Man-mode-map "s" 'Man-goto-see-also-section) (define-key Man-mode-map "k" 'Man-kill) (define-key Man-mode-map "q" 'Man-quit) (define-key Man-mode-map "m" 'man) (define-key Man-mode-map "?" 'describe-mode) ) ;; ====================================================================== ;; utilities (defsubst Man-init-defvars () "Used for initialising variables based on the value of window-system. This is necessary if one wants to dump man.el with emacs." ;; The following is necessary until fonts are implemented on ;; terminals. (setq Man-fontify-manpage-flag (and Man-fontify-manpage-flag window-system)) (defconst Man-uses-untabify-flag t ;; don't use pr: it is buggy ;; (or (not (file-readable-p "/etc/passwd")) ;; (/= 0 (apply 'call-process ;; Man-untabify-command nil nil nil ;; (append Man-untabify-command-args ;; (list "/etc/passwd"))))) "When non-nil use `untabify' instead of Man-untabify-command.") (defconst Man-sed-script (cond (Man-fontify-manpage-flag nil) ((= 0 (call-process Man-sed-command nil nil nil Man-sysv-sed-script)) Man-sysv-sed-script) ((= 0 (call-process Man-sed-command nil nil nil Man-berkeley-sed-script)) Man-berkeley-sed-script) (t nil)) "Script for sed to nuke backspaces and ANSI codes from manpages.") (defvar Man-filter-list (list (cons Man-sed-command (list (if Man-sed-script (concat "-e '" Man-sed-script "'") "") "-e '/^[\001-\032][\001-\032]*$/d'" "-e '/\e[789]/s///g'" "-e '/Reformatting page. Wait/d'" "-e '/Reformatting entry. Wait/d'" "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'" "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'" "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'" "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'" "-e '/^Printed[ \t][0-9].*[0-9]$/d'" "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'" "-e '/^[A-za-z].*Last[ \t]change:/d'" "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'" "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'" )) (cons Man-awk-command (list "'\n" "BEGIN { blankline=0; anonblank=0; }\n" "/^$/ { if (anonblank==0) next; }\n" "{ anonblank=1; }\n" "/^$/ { blankline++; next; }\n" "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n" "'" )) (if (not Man-uses-untabify-flag) (cons Man-untabify-command Man-untabify-command-args) )) "*Manpage cleaning filter command phrases. This variable contains a list of the following form: '((command-string phrase-string*)*) Each phrase-string is concatenated onto the command-string to form a command filter. The (standard) output (and standard error) of the Un*x man command is piped through each command filter in the order the commands appear in the association list. The final output is placed in the manpage buffer.") ) (defsubst Man-match-substring (&optional n string) "Return the substring matched by the last search. Optional arg N means return the substring matched by the Nth paren grouping. Optional second arg STRING means return a substring from that string instead of from the current buffer." (if (null n) (setq n 0)) (if string (substring string (match-beginning n) (match-end n)) (buffer-substring (match-beginning n) (match-end n)))) (defsubst Man-make-page-mode-string () "Formats part of the mode line for Man mode." (format "%s page %d of %d" (or (nth 2 (nth (1- Man-current-page) Man-page-list)) "") Man-current-page (length Man-page-list))) (defsubst Man-build-man-command () "Builds the entire background manpage and cleaning command." (let ((command (concat manual-program " " Man-switches " %s 2>/dev/null")) (flist Man-filter-list)) (while (and flist (car flist)) (let ((pcom (car (car flist))) (pargs (cdr (car flist)))) (setq command (concat command " | " pcom " " (mapconcat '(lambda (phrase) (if (not (stringp phrase)) (error "Malformed Man-filter-list")) phrase) pargs " "))) (setq flist (cdr flist)))) command)) (defun Man-translate-references (ref) "Translates REF from \"chmod(2V)\" to \"2v chmod\" style. Leave it as is if already in that style. Possibly downcase and translate the section (see the Man-downcase-section-letters-flag and the Man-section-translations-alist variables)." (let ((name "") (section "") (slist Man-section-translations-alist)) (cond ;; "chmod(2V)" case ? ((string-match (concat "^" Man-reference-regexp "$") ref) (setq name (Man-match-substring 1 ref) section (Man-match-substring 2 ref))) ;; "2v chmod" case ? ((string-match (concat "^\\(" Man-section-regexp "\\) +\\(" Man-name-regexp "\\)$") ref) (setq name (Man-match-substring 2 ref) section (Man-match-substring 1 ref)))) (if (string= name "") ref ; Return the reference as is (if Man-downcase-section-letters-flag (setq section (downcase section))) (while slist (let ((s1 (car (car slist))) (s2 (cdr (car slist)))) (setq slist (cdr slist)) (if Man-downcase-section-letters-flag (setq s1 (downcase s1))) (if (not (string= s1 section)) nil (setq section (if Man-downcase-section-letters-flag (downcase s2) s2) slist nil)))) (concat Man-specified-section-option section " " name)))) ;; ====================================================================== ;; default man entry: get word under point (defsubst Man-default-man-entry () "Make a guess at a default manual entry. This guess is based on the text surrounding the cursor, and the default section number is selected from `Man-auto-section-alist'." (let (default-title) (save-excursion ;; Default man entry title is any word the cursor is on, or if ;; cursor not on a word, then nearest preceding word. Cannot ;; use the current-word function because it skips the dots. (if (not (looking-at "[-a-zA-Z_.]")) (skip-chars-backward "^a-zA-Z")) (skip-chars-backward "-(a-zA-Z_0-9_.") (if (looking-at "(") (forward-char 1)) (setq default-title (buffer-substring (point) (progn (skip-chars-forward "-a-zA-Z0-9_.") (point)))) ;; If looking at something like ioctl(2) or brc(1M), include the ;; section number in the returned value. Remove text properties. (let ((result (concat default-title (if (looking-at (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) (format "(%s)" (Man-match-substring 1)))))) (set-text-properties 0 (length result) nil result) result)))) ;; ====================================================================== ;; Top level command and background process sentinel ;; For compatibility with older versions. ;;;###autoload (defalias 'manual-entry 'man) ;;;###autoload (defun man (man-args) "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-method' for what happens when the buffer is ready. If a buffer already exists for this man page, it will display immediately." (interactive (list (let* ((default-entry (Man-default-man-entry)) (input (read-string (format "Manual entry%s: " (if (string= default-entry "") "" (format " (default %s)" default-entry)))))) (if (string= input "") (if (string= default-entry "") (error "No man args given") default-entry) input)))) ;; Init the man package variables, if not already done. (Man-init-defvars) ;; Possibly translate the "subject(section)" syntax into the ;; "section subject" syntax and possibly downcase the section. (setq man-args (Man-translate-references man-args)) (Man-getpage-in-background man-args)) (defun Man-getpage-in-background (topic) "Uses TOPIC to build and fire off the manpage and cleaning command." (let* ((man-args topic) (bufname (concat "*Man " man-args "*")) (buffer (get-buffer bufname))) (if buffer (Man-notify-when-ready buffer) (require 'env) (message "Invoking %s %s in the background" manual-program man-args) (setq buffer (generate-new-buffer bufname)) (save-excursion (set-buffer buffer) (setq Man-original-frame (selected-frame)) (setq Man-arguments man-args)) (let ((process-environment (copy-sequence process-environment))) ;; Prevent any attempt to use display terminal fanciness. (setenv "TERM" "dumb") (set-process-sentinel (start-process manual-program buffer "sh" "-c" (format (Man-build-man-command) man-args)) 'Man-bgproc-sentinel))))) (defun Man-notify-when-ready (man-buffer) "Notify the user when MAN-BUFFER is ready. See the variable `Man-notify-method' for the different notification behaviors." (let ((saved-frame (save-excursion (set-buffer man-buffer) Man-original-frame))) (cond ((eq Man-notify-method 'newframe) ;; Since we run asynchronously, perhaps while Emacs is waiting ;; for input, we must not leave a different buffer current. We ;; can't rely on the editor command loop to reselect the ;; selected window's buffer. (save-excursion (set-buffer man-buffer) (make-frame Man-frame-parameters))) ((eq Man-notify-method 'pushy) (switch-to-buffer man-buffer)) ((eq Man-notify-method 'bully) (and window-system (frame-live-p saved-frame) (select-frame saved-frame)) (pop-to-buffer man-buffer) (delete-other-windows)) ((eq Man-notify-method 'aggressive) (and window-system (frame-live-p saved-frame) (select-frame saved-frame)) (pop-to-buffer man-buffer)) ((eq Man-notify-method 'friendly) (and window-system (frame-live-p saved-frame) (select-frame saved-frame)) (display-buffer man-buffer 'not-this-window)) ((eq Man-notify-method 'polite) (beep) (message "Manual buffer %s is ready" (buffer-name man-buffer))) ((eq Man-notify-method 'quiet) (message "Manual buffer %s is ready" (buffer-name man-buffer))) ((or (eq Man-notify-method 'meek) t) (message "")) ))) (defun Man-fontify-manpage () "Convert overstriking and underlining to the correct fonts. Same for the ANSI bold and normal escape sequences." (interactive) (message "Please wait: making up the %s man page..." Man-arguments) (goto-char (point-min)) (while (search-forward "\e[1m" nil t) (delete-backward-char 4) (put-text-property (point) (progn (if (search-forward "\e[0m" nil 'move) (delete-backward-char 4)) (point)) 'face Man-overstrike-face)) (goto-char (point-min)) (while (search-forward "_\b" nil t) (backward-delete-char 2) (put-text-property (point) (1+ (point)) 'face Man-underline-face)) (goto-char (point-min)) (while (search-forward "\b_" nil t) (backward-delete-char 2) (put-text-property (1- (point)) (point) 'face Man-underline-face)) (goto-char (point-min)) (while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t) (replace-match "\\1") (put-text-property (1- (point)) (point) 'face Man-overstrike-face)) (goto-char (point-min)) (while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o") (put-text-property (1- (point)) (point) 'face 'bold)) (goto-char (point-min)) (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+") (put-text-property (1- (point)) (point) 'face 'bold)) ;; \255 is some kind of dash in Latin-1. (goto-char (point-min)) (while (search-forward "\255" nil t) (replace-match "-")) (message "%s man page made up" Man-arguments)) (defun Man-cleanup-manpage () "Remove overstriking and underlining from the current buffer." (interactive) (message "Please wait: cleaning up the %s man page..." Man-arguments) (if (or (interactive-p) (not Man-sed-script)) (progn (goto-char (point-min)) (while (search-forward "_\b" nil t) (backward-delete-char 2)) (goto-char (point-min)) (while (search-forward "\b_" nil t) (backward-delete-char 2)) (goto-char (point-min)) (while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t) (replace-match "\\1")) (goto-char (point-min)) (while (re-search-forward "\e\\[[0-9]+m" nil t) (replace-match "")) (goto-char (point-min)) (while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o")) )) (goto-char (point-min)) (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+")) ;; \255 is some kind of dash in Latin-1. (goto-char (point-min)) (while (search-forward "\255" nil t) (replace-match "-")) (message "%s man page cleaned up" Man-arguments)) (defun Man-bgproc-sentinel (process msg) "Manpage background process sentinel." (let ((Man-buffer (process-buffer process)) (delete-buff nil) (err-mess nil)) (if (null (buffer-name Man-buffer)) ;; deleted buffer (set-process-buffer process nil) (save-excursion (set-buffer Man-buffer) (let ((case-fold-search nil)) (goto-char (point-min)) (cond ((or (looking-at "No \\(manual \\)*entry for") (looking-at "[^\n]*: nothing appropriate$")) (setq err-mess (buffer-substring (point) (progn (end-of-line) (point))) delete-buff t)) ((not (and (eq (process-status process) 'exit) (= (process-exit-status process) 0))) (setq err-mess (concat (buffer-name Man-buffer) ": process " (let ((eos (1- (length msg)))) (if (= (aref msg eos) ?\n) (substring msg 0 eos) msg)))) (goto-char (point-max)) (insert (format "\nprocess %s" msg)) )) (if delete-buff (kill-buffer Man-buffer) (if Man-fontify-manpage-flag (Man-fontify-manpage) (Man-cleanup-manpage)) (run-hooks 'Man-cooked-hook) (Man-mode) (set-buffer-modified-p nil) )) ;; Restore case-fold-search before calling ;; Man-notify-when-ready because it may switch buffers. (if (not delete-buff) (Man-notify-when-ready Man-buffer)) (if err-mess (error err-mess)) )))) ;; ====================================================================== ;; set up manual mode in buffer and build alists (defun Man-mode () "A mode for browsing Un*x manual pages. The following man commands are available in the buffer. Try \"\\[describe-key] RET\" for more information: \\[man] Prompt to retrieve a new manpage. \\[Man-follow-manual-reference] Retrieve reference in SEE ALSO section. \\[Man-next-manpage] Jump to next manpage in circular list. \\[Man-previous-manpage] Jump to previous manpage in circular list. \\[Man-next-section] Jump to next manpage section. \\[Man-previous-section] Jump to previous manpage section. \\[Man-goto-section] Go to a manpage section. \\[Man-goto-see-also-section] Jumps to the SEE ALSO manpage section. \\[Man-quit] Deletes the manpage window, bury its buffer. \\[Man-kill] Deletes the manpage window, kill its buffer. \\[describe-mode] Prints this help text. The following variables may be of some use. Try \"\\[describe-variable] RET\" for more information: Man-notify-method What happens when manpage formatting is done. Man-downcase-section-letters-flag Force section letters to lower case. Man-circular-pages-flag Treat multiple manpage list as circular. Man-auto-section-alist List of major modes and their section numbers. Man-section-translations-alist List of section numbers and their Un*x equiv. Man-filter-list Background manpage filter command. Man-mode-line-format Mode line format for Man mode buffers. Man-mode-map Keymap bindings for Man mode buffers. Man-mode-hook Normal hook run on entry to Man mode. Man-section-regexp Regexp describing manpage section letters. Man-heading-regexp Regexp describing section headers. Man-see-also-regexp Regexp for SEE ALSO section (or your equiv). Man-first-heading-regexp Regexp for first heading on a manpage. Man-reference-regexp Regexp matching a references in SEE ALSO. Man-switches Background `man' command switches. The following key bindings are currently in effect in the buffer: \\{Man-mode-map}" (interactive) (setq major-mode 'Man-mode mode-name "Man" buffer-auto-save-file-name nil mode-line-format Man-mode-line-format truncate-lines t buffer-read-only t) (buffer-disable-undo (current-buffer)) (auto-fill-mode -1) (use-local-map Man-mode-map) (Man-build-page-list) (Man-strip-page-headers) (Man-unindent) (Man-goto-page 1) (run-hooks 'Man-mode-hook)) (defsubst Man-build-section-alist () "Build the association list of manpage sections." (setq Man-sections-alist nil) (goto-char (point-min)) (let ((case-fold-search nil)) (while (re-search-forward Man-heading-regexp (point-max) t) (aput 'Man-sections-alist (Man-match-substring 1)) (forward-line 1)))) (defsubst Man-build-references-alist () "Build the association list of references (in the SEE ALSO section)." (setq Man-refpages-alist nil) (save-excursion (if (Man-find-section Man-see-also-regexp) (let ((start (progn (forward-line 1) (point))) (end (progn (Man-next-section 1) (point))) hyphenated (runningpoint -1)) (save-restriction (narrow-to-region start end) (goto-char (point-min)) (back-to-indentation) (while (and (not (eobp)) (/= (point) runningpoint)) (setq runningpoint (point)) (if (re-search-forward Man-reference-regexp end t) (let* ((word (Man-match-substring 0)) (len (1- (length word)))) (if hyphenated (setq word (concat hyphenated word) hyphenated nil)) (if (= (aref word len) ?-) (setq hyphenated (substring word 0 len)) (aput 'Man-refpages-alist word)))) (skip-chars-forward " \t\n,"))))))) (defun Man-build-page-list () "Build the list of separate manpages in the buffer." (setq Man-page-list nil) (let ((page-start (point-min)) (page-end (point-max)) (header "")) (goto-char page-start) ;; (switch-to-buffer (current-buffer))(debug) (while (not (eobp)) (setq header (if (looking-at Man-page-header-regexp) (Man-match-substring 1) nil)) ;; Go past both the current and the next Man-first-heading-regexp (if (re-search-forward Man-first-heading-regexp nil 'move 2) (let ((p (progn (beginning-of-line) (point)))) ;; We assume that the page header is delimited by blank ;; lines and that it contains at most one blank line. So ;; if we back by three blank lines we will be sure to be ;; before the page header but not before the possible ;; previous page header. (search-backward "\n\n" nil t 3) (if (re-search-forward Man-page-header-regexp p 'move) (beginning-of-line)))) (setq page-end (point)) (setq Man-page-list (append Man-page-list (list (list (copy-marker page-start) (copy-marker page-end) header)))) (setq page-start page-end) ))) (defun Man-strip-page-headers () "Strip all the page headers but the first from the manpage." (let ((buffer-read-only nil) (case-fold-search nil) (page-list Man-page-list) (page ()) (header "")) (while page-list (setq page (car page-list)) (and (nth 2 page) (goto-char (car page)) (re-search-forward Man-first-heading-regexp nil t) (setq header (buffer-substring (car page) (match-beginning 0))) ;; Since the awk script collapses all successive blank ;; lines into one, and since we don't want to get rid of ;; the fast awk script, one must choose between adding ;; spare blank lines between pages when there were none and ;; deleting blank lines at page boundaries when there were ;; some. We choose the first, so we comment the following ;; line. ;; (setq header (concat "\n" header))) (while (search-forward header (nth 1 page) t) (replace-match ""))) (setq page-list (cdr page-list))))) (defun Man-unindent () "Delete the leading spaces that indent the manpage." (let ((buffer-read-only nil) (case-fold-search nil) (page-list Man-page-list)) (while page-list (let ((page (car page-list)) (indent "") (nindent 0)) (narrow-to-region (car page) (car (cdr page))) (if Man-uses-untabify-flag (untabify (point-min) (point-max))) (if (catch 'unindent (goto-char (point-min)) (if (not (re-search-forward Man-first-heading-regexp nil t)) (throw 'unindent nil)) (beginning-of-line) (setq indent (buffer-substring (point) (progn (skip-chars-forward " ") (point)))) (setq nindent (length indent)) (if (zerop nindent) (throw 'unindent nil)) (setq indent (concat indent "\\|$")) (goto-char (point-min)) (while (not (eobp)) (if (looking-at indent) (forward-line 1) (throw 'unindent nil))) (goto-char (point-min))) (while (not (eobp)) (or (eolp) (delete-char nindent)) (forward-line 1))) (setq page-list (cdr page-list)) )))) ;; ====================================================================== ;; Man mode commands (defun Man-next-section (n) "Move point to Nth next section (default 1)." (interactive "p") (let ((case-fold-search nil)) (if (looking-at Man-heading-regexp) (forward-line 1)) (if (re-search-forward Man-heading-regexp (point-max) t n) (beginning-of-line) (goto-char (point-max))))) (defun Man-previous-section (n) "Move point to Nth previous section (default 1)." (interactive "p") (let ((case-fold-search nil)) (if (looking-at Man-heading-regexp) (forward-line -1)) (if (re-search-backward Man-heading-regexp (point-min) t n) (beginning-of-line) (goto-char (point-min))))) (defun Man-find-section (section) "Move point to SECTION if it exists, otherwise don't move point. Returns t if section is found, nil otherwise." (let ((curpos (point)) (case-fold-search nil)) (goto-char (point-min)) (if (re-search-forward (concat "^" section) (point-max) t) (progn (beginning-of-line) t) (goto-char curpos) nil) )) (defun Man-goto-section () "Query for section to move point to." (interactive) (aput 'Man-sections-alist (let* ((default (aheadsym Man-sections-alist)) (completion-ignore-case t) chosen (prompt (concat "Go to section: (default " default ") "))) (setq chosen (completing-read prompt Man-sections-alist)) (if (or (not chosen) (string= chosen "")) default chosen))) (Man-find-section (aheadsym Man-sections-alist))) (defun Man-goto-see-also-section () "Move point the the \"SEE ALSO\" section. Actually the section moved to is described by `Man-see-also-regexp'." (interactive) (if (not (Man-find-section Man-see-also-regexp)) (error (concat "No " Man-see-also-regexp " section found in the current manpage")))) (defun Man-follow-manual-reference (reference) "Get one of the manpages referred to in the \"SEE ALSO\" section. Specify which reference to use; default is based on word at point." (interactive (if (not Man-refpages-alist) (error "There are no references in the current man page") (list (let* ((default (or (car (all-completions (save-excursion (skip-syntax-backward "w()") (skip-chars-forward " \t") (let ((word (current-word))) ;; strip a trailing '-': (if (string-match "-$" word) (substring word 0 (match-beginning 0)) word))) Man-refpages-alist)) (aheadsym Man-refpages-alist))) chosen (prompt (concat "Refer to: (default " default ") "))) (setq chosen (completing-read prompt Man-refpages-alist nil t)) (if (or (not chosen) (string= chosen "")) default chosen))))) (if (not Man-refpages-alist) (error "Can't find any references in the current manpage") (aput 'Man-refpages-alist reference) (Man-getpage-in-background (Man-translate-references (aheadsym Man-refpages-alist))))) (defun Man-kill () "Kill the buffer containing the manpage." (interactive) (let ((buff (current-buffer))) (delete-windows-on buff) (kill-buffer buff)) (if (and window-system (or (eq Man-notify-method 'newframe) (and pop-up-frames (eq Man-notify-method 'bully)))) (delete-frame))) (defun Man-quit () "Bury the buffer containing the manpage." (interactive) (let ((buff (current-buffer))) (delete-windows-on buff) (bury-buffer buff)) (if (and window-system (or (eq Man-notify-method 'newframe) (and pop-up-frames (eq Man-notify-method 'bully)))) (delete-frame))) (defun Man-goto-page (page) "Go to the manual page on page PAGE." (interactive (if (not Man-page-list) (let ((args Man-arguments)) (kill-buffer (current-buffer)) (error "Can't find the %s manpage" args)) (if (= (length Man-page-list) 1) (error "You're looking at the only manpage in the buffer") (list (read-minibuffer (format "Go to manpage [1-%d]: " (length Man-page-list))))))) (if (not Man-page-list) (let ((args Man-arguments)) (kill-buffer (current-buffer)) (error "Can't find the %s manpage" args))) (if (or (< page 1) (> page (length Man-page-list))) (error "No manpage %d found" page)) (let* ((page-range (nth (1- page) Man-page-list)) (page-start (car page-range)) (page-end (car (cdr page-range)))) (setq Man-current-page page Man-page-mode-string (Man-make-page-mode-string)) (widen) (goto-char page-start) (narrow-to-region page-start page-end) (Man-build-section-alist) (Man-build-references-alist) (goto-char (point-min)))) (defun Man-next-manpage () "Find the next manpage entry in the buffer." (interactive) (if (= (length Man-page-list) 1) (error "This is the only manpage in the buffer")) (if (< Man-current-page (length Man-page-list)) (Man-goto-page (1+ Man-current-page)) (if Man-circular-pages-flag (Man-goto-page 1) (error "You're looking at the last manpage in the buffer")))) (defun Man-previous-manpage () "Find the previous manpage entry in the buffer." (interactive) (if (= (length Man-page-list) 1) (error "This is the only manpage in the buffer")) (if (> Man-current-page 1) (Man-goto-page (1- Man-current-page)) (if Man-circular-pages-flag (Man-goto-page (length Man-page-list)) (error "You're looking at the first manpage in the buffer")))) (provide 'man) ;;; man.el ends here emacs-19.30/lisp/map-ynp.el100444 12241 1 21241 5765624711 14471 0ustar rolanddaemon;;; map-ynp.el --- General-purpose boolean question-asker. ;;; Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Roland McGrath ;; Keywords: lisp, extensions ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2, or (at your option) ;;; any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; A copy of the GNU General Public License can be obtained from this ;;; program's author (send electronic mail to roland@ai.mit.edu) or from ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA ;;; 02139, USA. ;;; Commentary: ;;; map-y-or-n-p is a general-purpose question-asking function. ;;; It asks a series of y/n questions (a la y-or-n-p), and decides to ;;; applies an action to each element of a list based on the answer. ;;; The nice thing is that you also get some other possible answers ;;; to use, reminiscent of query-replace: ! to answer y to all remaining ;;; questions; ESC or q to answer n to all remaining questions; . to answer ;;; y once and then n for the remainder; and you can get help with C-h. ;;; Code: ;;;###autoload (defun map-y-or-n-p (prompter actor list &optional help action-alist no-cursor-in-echo-area) "Ask a series of boolean questions. Takes args PROMPTER ACTOR LIST, and optional args HELP and ACTION-ALIST. LIST is a list of objects, or a function of no arguments to return the next object or nil. If PROMPTER is a string, the prompt is \(format PROMPTER OBJECT\). If not a string, PROMPTER is a function of one arg (an object from LIST), which returns a string to be used as the prompt for that object. If the return value is not a string, it may be nil to ignore the object or non-nil to act on the object without asking the user. ACTOR is a function of one arg (an object from LIST), which gets called with each object that the user answers `yes' for. If HELP is given, it is a list (OBJECT OBJECTS ACTION), where OBJECT is a string giving the singular noun for an elt of LIST; OBJECTS is the plural noun for elts of LIST, and ACTION is a transitive verb describing ACTOR. The default is \(\"object\" \"objects\" \"act on\"\). At the prompts, the user may enter y, Y, or SPC to act on that object; n, N, or DEL to skip that object; ! to act on all following objects; ESC or q to exit (skip all following objects); . (period) to act on the current object and then exit; or \\[help-command] to get help. If ACTION-ALIST is given, it is an alist (KEY FUNCTION HELP) of extra keys that will be accepted. KEY is a character; FUNCTION is a function of one arg (an object from LIST); HELP is a string. When the user hits KEY, FUNCTION is called. If it returns non-nil, the object is considered \"acted upon\", and the next object from LIST is processed. If it returns nil, the prompt is repeated for the same object. Final optional argument NO-CURSOR-IN-ECHO-AREA non-nil says not to set `cursor-in-echo-area' while prompting. This function uses `query-replace-map' to define the standard responses, but not all of the responses which `query-replace' understands are meaningful here. Returns the number of actions taken." (let* ((actions 0) user-keys mouse-event map prompt char elt tail def delayed-switch-frame (next (if (or (and list (symbolp list)) (subrp list) (byte-code-function-p list) (and (consp list) (eq (car list) 'lambda))) (function (lambda () (setq elt (funcall list)))) (function (lambda () (if list (progn (setq elt (car list) list (cdr list)) t) nil)))))) (if (listp last-nonmenu-event) ;; Make a list describing a dialog box. (let ((object (capitalize (nth 0 help))) (objects (capitalize (nth 1 help))) (action (capitalize (nth 2 help)))) (setq map (` (("Yes" . act) ("No" . skip) ("Quit" . exit) ((, (if help (concat action " " object " And Quit") "Do it and Quit")) . act-and-exit) ((, (if help (concat action " All " objects) "Do All")) . automatic) (,@ (mapcar (lambda (elt) (cons (capitalize (nth 2 elt)) (vector (nth 1 elt)))) action-alist)))) mouse-event last-nonmenu-event)) (setq user-keys (if action-alist (concat (mapconcat (function (lambda (elt) (key-description (char-to-string (car elt))))) action-alist ", ") " ") "") ;; Make a map that defines each user key as a vector containing ;; its definition. map (cons 'keymap (append (mapcar (lambda (elt) (cons (car elt) (vector (nth 1 elt)))) action-alist) query-replace-map)))) (unwind-protect (progn (if (stringp prompter) (setq prompter (` (lambda (object) (format (, prompter) object))))) (while (funcall next) (setq prompt (funcall prompter elt)) (cond ((stringp prompt) ;; Prompt the user about this object. (setq quit-flag nil) (if mouse-event (setq def (or (x-popup-dialog mouse-event (cons prompt map)) 'quit)) ;; Prompt in the echo area. (let ((cursor-in-echo-area (not no-cursor-in-echo-area)) (message-log-max nil)) (message "%s(y, n, !, ., q, %sor %s) " prompt user-keys (key-description (vector help-char))) (setq char (read-event)) ;; Show the answer to the question. (message "%s(y, n, !, ., q, %sor %s) %s" prompt user-keys (key-description (vector help-char)) (single-key-description char))) (setq def (lookup-key map (vector char)))) (cond ((eq def 'exit) (setq next (function (lambda () nil)))) ((eq def 'act) ;; Act on the object. (funcall actor elt) (setq actions (1+ actions))) ((eq def 'skip) ;; Skip the object. ) ((eq def 'act-and-exit) ;; Act on the object and then exit. (funcall actor elt) (setq actions (1+ actions) next (function (lambda () nil)))) ((or (eq def 'quit) (eq def 'exit-prefix)) (setq quit-flag t) (setq next (` (lambda () (setq next '(, next)) '(, elt))))) ((eq def 'automatic) ;; Act on this and all following objects. (if (funcall prompter elt) (progn (funcall actor elt) (setq actions (1+ actions)))) (while (funcall next) (if (funcall prompter elt) (progn (funcall actor elt) (setq actions (1+ actions)))))) ((eq def 'help) (with-output-to-temp-buffer "*Help*" (princ (let ((object (if help (nth 0 help) "object")) (objects (if help (nth 1 help) "objects")) (action (if help (nth 2 help) "act on"))) (concat (format "Type SPC or `y' to %s the current %s; DEL or `n' to skip the current %s; ! to %s all remaining %s; ESC or `q' to exit;\n" action object object action objects) (mapconcat (function (lambda (elt) (format "%c to %s" (nth 0 elt) (nth 2 elt)))) action-alist ";\n") (if action-alist ";\n") (format "or . (period) to %s \ the current %s and exit." action object)))) (save-excursion (set-buffer standard-output) (help-mode))) (setq next (` (lambda () (setq next '(, next)) '(, elt))))) ((vectorp def) ;; A user-defined key. (if (funcall (aref def 0) elt) ;Call its function. ;; The function has eaten this object. (setq actions (1+ actions)) ;; Regurgitated; try again. (setq next (` (lambda () (setq next '(, next)) '(, elt)))))) ((and (consp char) (eq (car char) 'switch-frame)) ;; switch-frame event. Put it off until we're done. (setq delayed-switch-frame char) (setq next (` (lambda () (setq next '(, next)) '(, elt))))) (t ;; Random char. (message "Type %s for help." (key-description (vector help-char))) (beep) (sit-for 1) (setq next (` (lambda () (setq next '(, next)) '(, elt))))))) (prompt (funcall actor elt) (setq actions (1+ actions)))))) (if delayed-switch-frame (setq unread-command-events (cons delayed-switch-frame unread-command-events)))) ;; Clear the last prompt from the minibuffer. (let ((message-log-max nil)) (message "")) ;; Return the number of actions that were taken. actions)) ;;; map-ynp.el ends here emacs-19.30/lisp/meese.el100444 12120 1 1547 5605603616 13505 0ustar rmsdaemon;;; meese.el --- protect the impressionable young minds of America ;; This is in the public domain on account of being distributed since ;; 1985 or 1986 without a copyright notice. ;; Maintainer: FSF ;; Keywords: games ;;; Code: (defun protect-innocence-hook () (let ((dir (file-name-directory buffer-file-name))) (if (and (equal buffer-file-name (expand-file-name "sex.6" dir)) (file-exists-p buffer-file-name) (not (y-or-n-p "Are you over 18? "))) (progn (clear-visited-file-modtime) (setq buffer-file-name (expand-file-name "celibacy.1" dir)) (let ((inhibit-read-only t)) ; otherwise (erase-buffer) may bomb. (erase-buffer) (insert-file-contents buffer-file-name t)) (rename-buffer (file-name-nondirectory buffer-file-name)))))) (add-hook 'find-file-hooks 'protect-innocence-hook) (provide 'meese) ;;; meese.el ends here emacs-19.30/lisp/menu-bar.el100444 12120 1 60104 6052670552 14127 0ustar rmsdaemon;;; menu-bar.el --- define a default menu bar. ;; Author: RMS ;; Keywords: internal ;; Copyright (C) 1993, 1994, 1995 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. ;; Avishai Yacobi suggested some menu rearrangements. ;;; Code: ;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key ;; definitions made in loaddefs.el. (or (lookup-key global-map [menu-bar]) (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar"))) (defvar menu-bar-help-menu (make-sparse-keymap "Help")) ;; Force Help item to come last, after the major mode's own items. ;; The symbol used to be called `help', but that gets confused with the ;; help key. (setq menu-bar-final-items '(help-menu)) (define-key global-map [menu-bar help-menu] (cons "Help" menu-bar-help-menu)) (defvar menu-bar-search-menu (make-sparse-keymap "Search")) (define-key global-map [menu-bar search] (cons "Search" menu-bar-search-menu)) (defvar menu-bar-edit-menu (make-sparse-keymap "Edit")) (define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu)) (defvar menu-bar-tools-menu (make-sparse-keymap "Tools")) (define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu)) (defvar menu-bar-files-menu (make-sparse-keymap "Files")) (define-key global-map [menu-bar files] (cons "Files" menu-bar-files-menu)) ;; This alias is for compatibility with 19.28 and before. (defvar menu-bar-file-menu menu-bar-files-menu) (defvar vc-menu-map (make-sparse-keymap "Version Control")) (define-key menu-bar-tools-menu [calendar] '("Display Calendar" . calendar)) (define-key menu-bar-tools-menu [rmail] '("Read Mail" . rmail)) (define-key menu-bar-tools-menu [gnus] '("Read Net News" . gnus)) (define-key menu-bar-tools-menu [separator-vc] '("--")) (define-key menu-bar-tools-menu [vc-menu] (cons "Version Control" vc-menu-map)) (define-key menu-bar-tools-menu [separator-compare] '("--")) (define-key menu-bar-tools-menu [epatch] '("Apply Patch" . menu-bar-epatch-menu)) (define-key menu-bar-tools-menu [ediff-merge] '("Merge" . menu-bar-ediff-merge-menu)) (define-key menu-bar-tools-menu [compare] '("Compare" . menu-bar-ediff-menu)) (define-key menu-bar-tools-menu [separator-print] '("--")) (put 'print-region 'menu-enable 'mark-active) (put 'ps-print-region-with-faces 'menu-enable 'mark-active) (define-key menu-bar-tools-menu [ps-print-region] '("Postscript Print Region" . ps-print-region-with-faces)) (define-key menu-bar-tools-menu [ps-print-buffer] '("Postscript Print Buffer" . ps-print-buffer-with-faces)) (define-key menu-bar-tools-menu [print-region] '("Print Region" . print-region)) (define-key menu-bar-tools-menu [print-buffer] '("Print Buffer" . print-buffer)) (define-key menu-bar-files-menu [exit-emacs] '("Exit Emacs" . save-buffers-kill-emacs)) (define-key menu-bar-files-menu [separator-exit] '("--")) (define-key menu-bar-files-menu [one-window] '("One Window" . delete-other-windows)) (define-key menu-bar-files-menu [split-window] '("Split Window" . split-window-vertically)) (if (fboundp 'delete-frame) (progn ;; Don't use delete-frame as event name ;; because that is a special event. (define-key menu-bar-files-menu [delete-this-frame] '("Delete Frame" . delete-frame)) (define-key menu-bar-files-menu [make-frame-on-display] '("Open New Display..." . make-frame-on-display)) (define-key menu-bar-files-menu [make-frame] '("Make New Frame" . make-frame)))) (define-key menu-bar-files-menu [separator-buffers] '("--")) (define-key menu-bar-files-menu [kill-buffer] '("Kill Current Buffer" . kill-this-buffer)) (define-key menu-bar-files-menu [insert-file] '("Insert File..." . insert-file)) (define-key menu-bar-files-menu [revert-buffer] '("Revert Buffer" . revert-buffer)) (define-key menu-bar-files-menu [write-file] '("Save Buffer As..." . write-file)) (define-key menu-bar-files-menu [save-buffer] '("Save Buffer" . save-buffer)) (define-key menu-bar-files-menu [dired] '("Open Directory..." . dired)) (define-key menu-bar-files-menu [open-file] '("Open File..." . find-file)) (defun nonincremental-search-forward (string) "Read a string and search for it nonincrementally." (interactive "sSearch for string: ") (if (equal string "") (search-forward (car search-ring)) (isearch-update-ring string nil) (search-forward string))) (defun nonincremental-search-backward (string) "Read a string and search backward for it nonincrementally." (interactive "sSearch for string: ") (if (equal string "") (search-backward (car search-ring)) (isearch-update-ring string nil) (search-backward string))) (defun nonincremental-re-search-forward (string) "Read a regular expression and search for it nonincrementally." (interactive "sSearch for regexp: ") (if (equal string "") (re-search-forward (car regexp-search-ring)) (isearch-update-ring string t) (re-search-forward string))) (defun nonincremental-re-search-backward (string) "Read a regular expression and search backward for it nonincrementally." (interactive "sSearch for regexp: ") (if (equal string "") (re-search-backward (car regexp-search-ring)) (isearch-update-ring string t) (re-search-backward string))) (defun nonincremental-repeat-search-forward () "Search forward for the previous search string." (interactive) (search-forward (car search-ring))) (defun nonincremental-repeat-search-backward () "Search backward for the previous search string." (interactive) (search-backward (car search-ring))) (defun nonincremental-repeat-re-search-forward () "Search forward for the previous regular expression." (interactive) (re-search-forward (car regexp-search-ring))) (defun nonincremental-repeat-re-search-backward () "Search backward for the previous regular expression." (interactive) (re-search-backward (car regexp-search-ring))) (define-key menu-bar-search-menu [query-replace-regexp] '("Query Replace Regexp..." . query-replace-regexp)) (define-key menu-bar-search-menu [query-replace] '("Query Replace..." . query-replace)) (define-key menu-bar-search-menu [find-tag] '("Find Tag..." . find-tag)) (define-key menu-bar-search-menu [bookmark] '("Bookmarks" . menu-bar-bookmark-map)) (define-key menu-bar-search-menu [separator-search] '("--")) (define-key menu-bar-search-menu [nonincremental-repeat-re-search-back] '("Repeat Regexp Backwards" . nonincremental-repeat-re-search-backward)) (define-key menu-bar-search-menu [nonincremental-repeat-search-back] '("Repeat Backwards" . nonincremental-repeat-search-backward)) (define-key menu-bar-search-menu [nonincremental-repeat-re-search-fwd] '("Repeat Regexp" . nonincremental-repeat-re-search-forward)) (define-key menu-bar-search-menu [nonincremental-repeat-search-fwd] '("Repeat Search" . nonincremental-repeat-search-forward)) (define-key menu-bar-search-menu [separator-repeat] '("--")) (define-key menu-bar-search-menu [re-search-back] '("Regexp Search Backwards..." . nonincremental-re-search-backward)) (define-key menu-bar-search-menu [search-back] '("Search Backwards..." . nonincremental-search-backward)) (define-key menu-bar-search-menu [re-search-fwd] '("Regexp Search..." . nonincremental-re-search-forward)) (define-key menu-bar-search-menu [search-fwd] '("Search..." . nonincremental-search-forward)) (if (fboundp 'start-process) (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 [props] '("Text Properties" . facemenu-menu)) (define-key menu-bar-edit-menu [separator-edit] '("--")) (define-key menu-bar-edit-menu [clear] '("Clear" . delete-region)) (define-key menu-bar-edit-menu [paste] '("Paste Most Recent" . yank)) (defvar yank-menu (cons "Select Yank" nil)) (fset 'yank-menu (cons 'keymap yank-menu)) (define-key menu-bar-edit-menu [select-paste] '("Select and Paste" . yank-menu)) (define-key menu-bar-edit-menu [copy] '("Copy" . menu-bar-kill-ring-save)) (define-key menu-bar-edit-menu [cut] '("Cut" . kill-region)) (define-key menu-bar-edit-menu [undo] '("Undo" . undo)) (defun menu-bar-kill-ring-save (beg end) (interactive "r") (if (mouse-region-match) (message "Select a region with the mouse does `copy' automatically") (kill-ring-save beg end))) (put 'fill-region 'menu-enable '(and mark-active (not buffer-read-only))) (put 'kill-region 'menu-enable '(and mark-active (not buffer-read-only))) (put 'menu-bar-kill-ring-save 'menu-enable 'mark-active) (put 'yank 'menu-enable '(and (x-selection-exists-p) (not buffer-read-only))) (put 'yank-menu 'menu-enable '(and (cdr yank-menu) (not buffer-read-only))) (put 'delete-region 'menu-enable '(and mark-active (not buffer-read-only) (not (mouse-region-match)))) (put 'undo 'menu-enable '(and (not buffer-read-only) (if (eq last-command 'undo) pending-undo-list (consp buffer-undo-list)))) (put 'query-replace 'menu-enable '(not buffer-read-only)) (put 'query-replace-regexp 'menu-enable '(not buffer-read-only)) (autoload 'ispell-menu-map "ispell" nil t 'keymap) ;; These are alternative definitions for the cut, paste and copy ;; menu items. Use them if your system expects these to use the clipboard. (put 'clipboard-kill-region 'menu-enable 'mark-active) (put 'clipboard-kill-ring-save 'menu-enable 'mark-active) (put 'clipboard-yank 'menu-enable '(or (x-selection-exists-p) (x-selection-exists-p 'CLIPBOARD))) (defun clipboard-yank () "Reinsert the last stretch of killed text, or the clipboard contents." (interactive) (let ((x-select-enable-clipboard t)) (yank))) (defun clipboard-kill-ring-save (beg end) "Copy region to kill ring, and save in the X clipboard." (interactive "r") (let ((x-select-enable-clipboard t)) (kill-ring-save beg end))) (defun clipboard-kill-region (beg end) "Kill the region, and save it in the X clipboard." (interactive "r") (let ((x-select-enable-clipboard t)) (kill-region beg end))) (defun menu-bar-enable-clipboard () "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard. Do the same for the keys of the same name." (interactive) ;; We can't use constant list structure here because it becomes pure, ;; and because it gets modified with cache data. (define-key menu-bar-edit-menu [paste] (cons "Paste" 'clipboard-yank)) (define-key menu-bar-edit-menu [copy] (cons "Copy" 'clipboard-kill-ring-save)) (define-key menu-bar-edit-menu [cut] (cons "Cut" 'clipboard-kill-region)) (define-key global-map [f20] 'clipboard-kill-region) (define-key global-map [f16] 'clipboard-kill-ring-save) (define-key global-map [f18] 'clipboard-yank) ;; X11R6 versions (define-key global-map [cut] 'clipboard-kill-region) (define-key global-map [copy] 'clipboard-kill-ring-save) (define-key global-map [paste] 'clipboard-yank)) (define-key menu-bar-help-menu [emacs-version] '("Show Version" . emacs-version)) (define-key menu-bar-help-menu [report-emacs-bug] '("Send Bug Report..." . report-emacs-bug)) (define-key menu-bar-help-menu [finder-by-keyword] '("Find Lisp Packages..." . finder-by-keyword)) (define-key menu-bar-help-menu [emacs-tutorial] '("Emacs Tutorial" . help-with-tutorial)) (define-key menu-bar-help-menu [man] '("Man..." . manual-entry)) (define-key menu-bar-help-menu [describe-variable] '("Describe Variable..." . describe-variable)) (define-key menu-bar-help-menu [describe-function] '("Describe Function..." . describe-function)) (define-key menu-bar-help-menu [describe-key] '("Describe Key..." . describe-key)) (define-key menu-bar-help-menu [list-keybindings] '("List Keybindings" . describe-bindings)) (define-key menu-bar-help-menu [command-apropos] '("Command Apropos..." . command-apropos)) (define-key menu-bar-help-menu [describe-mode] '("Describe Mode" . describe-mode)) (define-key menu-bar-help-menu [info] '("Browse Manuals" . info)) (define-key menu-bar-help-menu [emacs-faq] '("Emacs FAQ" . view-emacs-FAQ)) (define-key menu-bar-help-menu [emacs-news] '("Emacs News" . view-emacs-news)) (defun kill-this-buffer () ; for the menubar "Kills the current buffer." (interactive) (kill-buffer (current-buffer))) (defun kill-this-buffer-enabled-p () (let ((count 0) (buffers (buffer-list))) (while buffers (or (string-match "^ " (buffer-name (car buffers))) (setq count (1+ count))) (setq buffers (cdr buffers))) (and (not (window-minibuffer-p (selected-window))) (> count 1)))) (put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p)) (put 'save-buffer 'menu-enable '(and (buffer-modified-p) (not (window-minibuffer-p (selected-window))))) (put 'write-file 'menu-enable '(not (window-minibuffer-p (selected-window)))) (put 'find-file 'menu-enable '(not (window-minibuffer-p (selected-window)))) (put 'dired 'menu-enable '(not (window-minibuffer-p (selected-window)))) (put 'insert-file 'menu-enable '(not (window-minibuffer-p (selected-window)))) (put 'revert-buffer 'menu-enable '(or revert-buffer-function revert-buffer-insert-file-contents-function (and (buffer-file-name) (or (buffer-modified-p) (not (verify-visited-file-modtime (current-buffer))))))) ;; Permit deleting frame if it would leave a visible or iconified frame. (put 'delete-frame 'menu-enable '(delete-frame-enabled-p)) (defun delete-frame-enabled-p () "Return non-nil if `delete-frame' should be enabled in the menu bar." (let ((frames (frame-list)) (count 0)) (while frames (if (frame-visible-p (car frames)) (setq count (1+ count))) (setq frames (cdr frames))) (> count 1))) (put 'advertised-undo 'menu-enable '(and (not (eq t buffer-undo-list)) (if (eq last-command 'undo) (and (boundp 'pending-undo-list) pending-undo-list) buffer-undo-list))) (defvar yank-menu-length 20 "*Maximum length to display in the yank-menu.") (defun menu-bar-update-yank-menu (string old) (let ((front (car (cdr yank-menu))) (menu-string (if (<= (length string) yank-menu-length) string (concat (substring string 0 (/ yank-menu-length 2)) "..." (substring string (- (/ yank-menu-length 2))))))) ;; Don't let the menu string be all dashes ;; because that has a special meaning in a menu. (if (string-match "\\`-+\\'" menu-string) (setq menu-string (concat menu-string " "))) ;; If we're supposed to be extending an existing string, and that ;; string really is at the front of the menu, then update it in place. (if (and old (or (eq old (car front)) (string= old (car front)))) (progn (setcar front string) (setcar (cdr front) menu-string)) (setcdr yank-menu (cons (cons string (cons menu-string 'menu-bar-select-yank)) (cdr yank-menu))))) (if (> (length (cdr yank-menu)) kill-ring-max) (setcdr (nthcdr kill-ring-max yank-menu) nil))) (defun menu-bar-select-yank () (interactive "*") (push-mark (point)) (insert last-command-event)) ;; This definition is just to show what this looks like. ;; It gets overridden below when menu-bar-update-buffers is called. (define-key global-map [menu-bar buffer] (cons "Buffers" (make-sparse-keymap "Buffers"))) (defvar buffers-menu-max-size 10 "*Maximum number of entries which may appear on the Buffers menu. If this is 10, then only the ten most-recently-selected buffers are shown. If this is nil, then all buffers are shown. A large number or nil slows down menu responsiveness.") (defvar list-buffers-directory nil) (defvar menu-bar-update-buffers-maxbuf) (defun menu-bar-select-buffer () (interactive) (switch-to-buffer last-command-event)) (defun menu-bar-select-frame () (interactive) (make-frame-visible last-command-event) (raise-frame last-command-event) (select-frame last-command-event)) (defun menu-bar-update-buffers-1 (elt) (cons (format (format "%%%ds %%s%%s %%s" menu-bar-update-buffers-maxbuf) (cdr elt) (if (buffer-modified-p (car elt)) "*" " ") (save-excursion (set-buffer (car elt)) (if buffer-read-only "%" " ")) (let ((file (or (buffer-file-name (car elt)) (save-excursion (set-buffer (car elt)) list-buffers-directory) ""))) (setq file (or (file-name-directory file) "")) (if (> (length file) 20) (setq file (concat "..." (substring file -17)))) file)) (car elt))) (defvar menu-bar-buffers-menu-list-buffers-entry nil) (defun menu-bar-update-buffers () ;; If user discards the Buffers item, play along. (and (lookup-key (current-global-map) [menu-bar buffer]) (frame-or-buffer-changed-p) (let ((buffers (buffer-list)) (frames (frame-list)) buffers-menu frames-menu) ;; If requested, list only the N most recently selected buffers. (if (and (integerp buffers-menu-max-size) (> buffers-menu-max-size 1)) (if (> (length buffers) buffers-menu-max-size) (setcdr (nthcdr buffers-menu-max-size buffers) nil))) ;; Make the menu of buffers proper. (setq buffers-menu (cons "Select Buffer" (let* ((buffer-list (mapcar 'list buffers)) tail (menu-bar-update-buffers-maxbuf 0) (maxlen 0) alist head) ;; Put into each element of buffer-list ;; the name for actual display, ;; perhaps truncated in the middle. (setq tail buffer-list) (while tail (let ((name (buffer-name (car (car tail))))) (setcdr (car tail) (if (> (length name) 27) (concat (substring name 0 12) "..." (substring name -12)) name))) (setq tail (cdr tail))) ;; Compute the maximum length of any name. (setq tail buffer-list) (while tail (or (eq ?\ (aref (cdr (car tail)) 0)) (setq menu-bar-update-buffers-maxbuf (max menu-bar-update-buffers-maxbuf (length (cdr (car tail)))))) (setq tail (cdr tail))) ;; Set ALIST to an alist of the form ;; ITEM-STRING . BUFFER (setq tail buffer-list) (while tail (let ((elt (car tail))) (or (eq ?\ (aref (cdr elt) 0)) (setq alist (cons (menu-bar-update-buffers-1 elt) alist))) (and alist (> (length (car (car alist))) maxlen) (setq maxlen (length (car (car alist)))))) (setq tail (cdr tail))) (setq alist (nreverse alist)) ;; Make the menu item for list-buffers ;; or reuse the one we already have. ;; The advantage in reusing one ;; is that it already has the keyboard equivalent ;; cached, so we save the time to look that up again. (or menu-bar-buffers-menu-list-buffers-entry (setq menu-bar-buffers-menu-list-buffers-entry (cons 'list-buffers (cons "" 'list-buffers)))) ;; Update the item string for menu's new width. (setcar (cdr menu-bar-buffers-menu-list-buffers-entry) (concat (make-string (max (- (/ maxlen 2) 8) 0) ?\ ) "List All Buffers")) ;; Now make the actual list of items, ;; ending with the list-buffers item. (nconc (mapcar '(lambda (pair) ;; This is somewhat risque, to use ;; the buffer name itself as the event ;; type to define, but it works. ;; It would not work to use the buffer ;; since a buffer as an event has its ;; own meaning. (nconc (list (buffer-name (cdr pair)) (car pair) (cons nil nil)) 'menu-bar-select-buffer)) alist) (list menu-bar-buffers-menu-list-buffers-entry))))) ;; Make a Frames menu if we have more than one frame. (if (cdr frames) (setq frames-menu (cons "Select Frame" (mapcar '(lambda (frame) (nconc (list frame (cdr (assq 'name (frame-parameters frame))) (cons nil nil)) 'menu-bar-select-frame)) frames)))) (if buffers-menu (setq buffers-menu (cons 'keymap buffers-menu))) (if frames-menu (setq frames-menu (cons 'keymap frames-menu))) (define-key (current-global-map) [menu-bar buffer] (cons "Buffers" (if (and buffers-menu frames-menu) (list 'keymap "Buffers and Frames" (cons 'buffers (cons "Buffers" buffers-menu)) (cons 'frames (cons "Frames" frames-menu))) (or buffers-menu frames-menu 'undefined))))))) (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers) (menu-bar-update-buffers) ;; this version is too slow ;;;(defun format-buffers-menu-line (buffer) ;;; "Returns a string to represent the given buffer in the Buffer menu. ;;;nil means the buffer shouldn't be listed. You can redefine this." ;;; (if (string-match "\\` " (buffer-name buffer)) ;;; nil ;;; (save-excursion ;;; (set-buffer buffer) ;;; (let ((size (buffer-size))) ;;; (format "%s%s %-19s %6s %-15s %s" ;;; (if (buffer-modified-p) "*" " ") ;;; (if buffer-read-only "%" " ") ;;; (buffer-name) ;;; size ;;; mode-name ;;; (or (buffer-file-name) "")))))) ;;; Set up a menu bar menu for the minibuffer. (mapcar (function (lambda (map) (define-key map [menu-bar minibuf] (cons "Minibuf" (make-sparse-keymap "Minibuf"))))) (list minibuffer-local-ns-map minibuffer-local-must-match-map minibuffer-local-isearch-map minibuffer-local-map minibuffer-local-completion-map)) (mapcar (function (lambda (map) (define-key map [menu-bar minibuf ?\?] '("List Completions" . minibuffer-completion-help)) (define-key map [menu-bar minibuf space] '("Complete Word" . minibuffer-complete-word)) (define-key map [menu-bar minibuf tab] '("Complete" . minibuffer-complete)) )) (list minibuffer-local-must-match-map minibuffer-local-completion-map)) (mapcar (function (lambda (map) (define-key map [menu-bar minibuf quit] '("Quit" . keyboard-escape-quit)) (define-key map [menu-bar minibuf return] '("Enter" . exit-minibuffer)) )) (list minibuffer-local-ns-map minibuffer-local-must-match-map minibuffer-local-isearch-map minibuffer-local-map minibuffer-local-completion-map)) (defvar menu-bar-mode nil) (defun menu-bar-mode (flag) "Toggle display of a menu bar on each frame. This command applies to all frames that exist and frames to be created in the future. With a numeric argument, if the argument is negative, turn off menu bars; otherwise, turn on menu bars." (interactive "P") ;; Make menu-bar-mode and default-frame-alist consistent. (let ((default (assq 'menu-bar-lines default-frame-alist))) (if default (setq menu-bar-mode (not (eq (cdr default) 0))) (setq default-frame-alist (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0)) default-frame-alist)))) ;; Toggle or set the mode, according to FLAG. (setq menu-bar-mode (if (null flag) (not menu-bar-mode) (> (prefix-numeric-value flag) 0))) ;; Apply it to default-frame-alist. (let ((parameter (assq 'menu-bar-lines default-frame-alist))) (if (consp parameter) (setcdr parameter (if menu-bar-mode 1 0)) (setq default-frame-alist (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0)) default-frame-alist)))) ;; Apply it to existing frames. (let ((frames (frame-list))) (while frames (let ((height (cdr (assq 'height (frame-parameters (car frames)))))) (modify-frame-parameters (car frames) (list (cons 'menu-bar-lines (if menu-bar-mode 1 0)))) (modify-frame-parameters (car frames) (list (cons 'height height)))) (setq frames (cdr frames))))) (provide 'menu-bar) ;;; menu-bar.el ends here emacs-19.30/lisp/metamail.el100444 12120 1 10722 5433337030 14204 0ustar rmsdaemon;;; metamail.el --- Metamail interface for GNU Emacs ;; Copyright (C) 1993 Masanobu UMEDA ;; Author: Masanobu UMEDA ;; Version: $Header: /home/gd/gnu/emacs/19.0/lisp/RCS/metamail.el,v 1.1 1993/07/20 03:02:12 rms Exp $ ;; Keywords: mail, news, mime, multimedia ;; 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: ;; LCD Archive Entry: ;; metamail|Masanobu UMEDA|umerin@mse.kyutech.ac.jp| ;; Metamail interface for GNU Emacs| ;; $Date: 1993/07/20 03:02:12 $|$Revision: 1.1 $|~/misc/metamail.el.Z| ;; Note: Metamail does not have all options which is compatible with ;; the environment variables. For that reason, matamail.el have to ;; hack the environment variables. In addition, there is no way to ;; display all header fields without extra informative body messages ;; which is suppressed by "-q" option. ;; The idea of using metamail to process MIME messages is from ;; gnus-mime.el by Spike . ;;; Code: (defvar metamail-program-name "metamail" "*Metamail program name.") (defvar metamail-environment '("KEYHEADS=*") "*Environment variables passed to `metamail'. It must ba a list of strings that have the format ENVVARNAME=VALUE.") (defvar metamail-switches '("-m" "emacs" "-x" "-d" "-z") "*Switches for `metamail' program. -z is required to remove zap file.") (defun metamail-buffer (&optional buffer nodisplay) "Process current buffer through `metamail'. Optional 1st argument BUFFER specifies a buffer to be filled (nil means current). Optional 2nd argument NODISPLAY non-nil means buffer is not redisplayed as output is inserted." (interactive) (metamail-region (point-min) (point-max) buffer nodisplay)) (defun metamail-region (beg end &optional buffer nodisplay) "Process current region through 'metamail'. Optional 1st argument BUFFER specifies a buffer to be filled (nil means current). Optional 2nd argument NODISPLAY non-nil means buffer is not redisplayed as output is inserted." (interactive "r") (let ((curbuf (current-buffer)) (buffer-read-only nil) (metafile (make-temp-name "/tmp/metamail"))) (save-excursion ;; Gee! Metamail does not ouput to stdout if input comes from ;; stdin. (write-region beg end metafile nil 'nomessage) (if buffer (set-buffer buffer)) (setq buffer-read-only nil) ;; Clear destination buffer. (if (eq curbuf (current-buffer)) (delete-region beg end) (delete-region (point-min) (point-max))) ;; We have to pass the environment variable KEYHEADS to display ;; all header fields. Metamail should have an optional argument ;; to pass such information directly. (let ((process-environment (append metamail-environment process-environment))) (apply (function call-process) metamail-program-name nil t ;Output to current buffer (not nodisplay) ;Force redisplay (append metamail-switches (list metafile)))) ;; `metamail' may not delete the temporary file! (condition-case error (delete-file metafile) (error nil)) ))) ;(defun metamail-region (beg end &optional buffer) ; "Process current region through 'metamail'. ;Optional argument BUFFER specifies a buffer to be filled (nil means current)." ; (interactive "r") ; (let ((curbuf (current-buffer)) ; (buffer-read-only nil) ; (metafile (make-temp-name "/tmp/metamail"))) ; (save-excursion ; (write-region (point-min) (point-max) metafile nil 'nomessage) ; (if (eq curbuf ; (if buffer (get-buffer buffer) (current-buffer))) ; (delete-region (point-min) (point-max))) ; (apply (function call-process) ; metamail-program-name ; nil ; (or buffer t) ;BUFFER or current buffer ; nil ;don't redisplay ; (append metamail-switches (list metafile))) ; ))) (provide 'metamail) ;;; metamail.el ends here emacs-19.30/lisp/mh-comp.el100444 75424 1 114370 6046277153 14213 0ustar kwzhdaemon;;; mh-comp --- mh-e functions for composing messages ;; Time-stamp: <95/08/19 17:48:59 gildea> ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. ;; This file is part of mh-e, 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: ;; Internal support for mh-e package. ;;; Change Log: ;; $Id: mh-comp.el,v 1.7 1995/11/03 02:28:52 kwzh Exp $ ;;; Code: (provide 'mh-comp) (require 'mh-utils) ;;; Site customization (see also mh-utils.el): (defvar mh-send-prog "send" "Name of the MH send program. Some sites need to change this because of a name conflict.") (defvar mh-redist-full-contents nil "Non-nil if the `dist' command needs whole letter for redistribution. This is the case only when `send' is compiled with the BERK option. If MH will not allow you to redist a previously redist'd msg, set to nil.") (defvar mh-note-repl "-" "String whose first character is used to notate replied to messages.") (defvar mh-note-forw "F" "String whose first character is used to notate forwarded messages.") (defvar mh-note-dist "R" "String whose first character is used to notate redistributed messages.") (defvar mh-yank-hooks nil "Obsolete hook for modifying a citation just inserted in the mail buffer. Each hook function can find the citation between point and mark. And each hook function should leave point and mark around the citation text as modified. This is a normal hook, misnamed for historical reasons. It is semi-obsolete and is only used if mail-citation-hook is nil.") (defvar mail-citation-hook nil "*Hook for modifying a citation just inserted in the mail buffer. Each hook function can find the citation between point and mark. And each hook function should leave point and mark around the citation text as modified. If this hook is entirely empty (nil), the text of the message is inserted with mh-ins-buf-prefix prefixed to each line. See also the variable mh-yank-from-start-of-msg, which controls how much of the message passed to the hook.") ;;; Copied from sendmail.el for Hyperbole (defvar mail-header-separator "--------" "*Line used by MH to separate headers from text in messages being composed.") ;;; Personal preferences: (defvar mh-delete-yanked-msg-window nil "*Controls window display when a message is yanked by \\\\[mh-yank-cur-msg]. If non-nil, yanking the current message into a draft letter deletes any windows displaying the message.") (defvar mh-yank-from-start-of-msg t "*Controls which part of a message is yanked by \\\\[mh-yank-cur-msg]. If non-nil, include the entire message. If the symbol `body', then yank the message minus the header. If nil, yank only the portion of the message following the point. If the show buffer has a region, this variable is ignored.") (defvar mh-ins-buf-prefix "> " "*String to put before each non-blank line of a yanked or inserted message. \\Used when the message is inserted into an outgoing letter by \\[mh-insert-letter] or \\[mh-yank-cur-msg].") (defvar mh-reply-default-reply-to nil "*Sets the person or persons to whom a reply will be sent. If nil, prompt for recipient. If non-nil, then \\`\\[mh-reply]' will use this value and it should be one of \"from\", \"to\", \"cc\", or \"all\". The values \"cc\" and \"all\" do the same thing.") (defvar mh-signature-file-name "~/.signature" "*Name of file containing the user's signature. Inserted into message by \\\\[mh-insert-signature].") (defvar mh-forward-subject-format "%s: %s" "*Format to generate the Subject: line contents for a forwarded message. The two string arguments to the format are the sender of the original message and the original subject line.") (defvar mh-comp-formfile "components" "Name of file to be used as a skeleton for composing messages. Default is \"components\". If not a complete path name, the file is searched for first in the user's MH directory, then in the system MH lib directory.") (defvar mh-repl-formfile "replcomps" "Name of file to be used as a skeleton for replying to messages. Default is \"replcomps\". If not a complete path name, the file is searched for first in the user's MH directory, then in the system MH lib directory.") ;;; Hooks: (defvar mh-letter-mode-hook nil "Invoked in `mh-letter-mode' on a new letter.") (defvar mh-compose-letter-function nil "Invoked when setting up a letter draft. It is passed three arguments: TO recipients, SUBJECT, and CC recipients.") (defvar mh-before-send-letter-hook nil "Invoked at the beginning of the \\\\[mh-send-letter] command.") (defvar mh-rejected-letter-start (concat "^ ----- Unsent message follows -----$" ;from sendmail V5 "\\|^ ----- Original message follows -----$" ;from sendmail V8 "\\|^------- Unsent Draft$" ;from MH itself "\\|^---------- Original Message ----------$" ;from zmailer "\\|^ --- The unsent message follows ---$" ;from AIX mail system "\\|^ Your message follows:$" ;from MMDF-II "\\|^Content-Description: Returned Content$" ;1993 KJ sendmail ) "Regexp specifying the beginning of the wrapper around a returned letter. This wrapper is generated by the mail system when rejecting a letter.") (defvar mh-new-draft-cleaned-headers "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:" "Regexp of header lines to remove before offering a message as a new draft. Used by the \\`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.") (defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:") ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:") ("d" . "Dcc:")) "Alist of (final-character . field-name) choices for mh-to-field.") (defvar mh-letter-mode-map (copy-keymap text-mode-map) "Keymap for composing mail.") (defvar mh-letter-mode-syntax-table nil "Syntax table used by mh-e while in MH-Letter mode.") (if mh-letter-mode-syntax-table () (setq mh-letter-mode-syntax-table (make-syntax-table text-mode-syntax-table)) (modify-syntax-entry ?% "." mh-letter-mode-syntax-table)) ;;;###autoload (defun mh-smail () "Compose and send mail with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. See documentation of `\\[mh-send]' for more details on composing mail." (interactive) (mh-find-path) (call-interactively 'mh-send)) (defvar mh-error-if-no-draft nil) ;raise error over using old draft ;;;###autoload (defun mh-smail-batch () "Set up a mail composition draft with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. This function does not prompt the user for any header fields, and thus is suitable for use by programs that want to create a mail buffer. Users should use `\\[mh-smail]' to compose mail." (mh-find-path) (let ((mh-error-if-no-draft t)) (mh-send "" "" ""))) (defun mh-edit-again (msg) "Clean-up a draft or a message previously sent and make it resendable. Default is the current message. The variable mh-new-draft-cleaned-headers specifies the headers to remove. See also documentation for `\\[mh-send]' function." (interactive (list (mh-get-msg-num t))) (let* ((from-folder mh-current-folder) (config (current-window-configuration)) (draft (cond ((and mh-draft-folder (equal from-folder mh-draft-folder)) (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t) (rename-buffer (format "draft-%d" msg)) (buffer-name)) (t (mh-read-draft "clean-up" (mh-msg-filename msg) nil))))) (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil) (goto-char (point-min)) (save-buffer) (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil config))) (defun mh-extract-rejected-mail (msg) "Extract a letter returned by the mail system and make it resendable. Default is the current message. The variable mh-new-draft-cleaned-headers gives the headers to clean out of the original message. See also documentation for `\\[mh-send]' function." (interactive (list (mh-get-msg-num t))) (let ((from-folder mh-current-folder) (config (current-window-configuration)) (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil))) (goto-char (point-min)) (cond ((re-search-forward mh-rejected-letter-start nil t) (skip-chars-forward " \t\n") (delete-region (point-min) (point)) (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)) (t (message "Does not appear to be a rejected letter."))) (goto-char (point-min)) (save-buffer) (mh-compose-and-send-mail draft "" from-folder msg (mh-get-header-field "To:") (mh-get-header-field "From:") (mh-get-header-field "Cc:") nil nil config))) (defun mh-forward (to cc &optional msg-or-seq) "Forward a message or message sequence. Defaults to displayed message. If optional prefix argument provided, then prompt for the message sequence. See also documentation for `\\[mh-send]' function." (interactive (list (mh-read-address "To: ") (mh-read-address "Cc: ") (if current-prefix-arg (mh-read-seq-default "Forward" t) (mh-get-msg-num t)))) (or msg-or-seq (setq msg-or-seq (mh-get-msg-num t))) (let* ((folder mh-current-folder) (config (current-window-configuration)) ;; forw always leaves file in "draft" since it doesn't have -draft (draft-name (expand-file-name "draft" mh-user-path)) (draft (cond ((or (not (file-exists-p draft-name)) (y-or-n-p "The file 'draft' exists. Discard it? ")) (mh-exec-cmd "forw" "-build" mh-current-folder msg-or-seq) (prog1 (mh-read-draft "" draft-name t) (mh-insert-fields "To:" to "Cc:" cc) (save-buffer))) (t (mh-read-draft "" draft-name nil))))) (let (orig-from orig-subject) (goto-char (point-min)) (re-search-forward "^------- Forwarded Message") (forward-line 1) (skip-chars-forward " \t\n") (save-restriction (narrow-to-region (point) (point-max)) (setq orig-from (mh-get-header-field "From:")) (setq orig-subject (mh-get-header-field "Subject:"))) (let ((forw-subject (mh-forwarded-letter-subject orig-from orig-subject))) (mh-insert-fields "Subject:" forw-subject) (goto-char (point-min)) (re-search-forward "^------- Forwarded Message") (forward-line -1) (delete-other-windows) (if (numberp msg-or-seq) (mh-add-msgs-to-seq msg-or-seq 'forwarded t) (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t)) (mh-compose-and-send-mail draft "" folder msg-or-seq to forw-subject cc mh-note-forw "Forwarded:" config))))) (defun mh-forwarded-letter-subject (from subject) ;; Return a Subject suitable for a forwarded message. ;; Original message has headers FROM and SUBJECT. (let ((addr-start (string-match "<" from)) (comment (string-match "(" from))) (cond ((and addr-start (> addr-start 0)) ;; Full Name (setq from (substring from 0 (1- addr-start)))) (comment ;; luser@host (Full Name) (setq from (substring from (1+ comment) (1- (length from))))))) (format mh-forward-subject-format from subject)) ;;;###autoload (defun mh-smail-other-window () "Compose and send mail in other window with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. See documentation of `\\[mh-send]' for more details on composing mail." (interactive) (mh-find-path) (call-interactively 'mh-send-other-window)) (defun mh-redistribute (to cc &optional msg) "Redistribute a letter. Depending on how your copy of MH was compiled, you may need to change the setting of the variable mh-redist-full-contents. See its documentation." (interactive (list (mh-read-address "Redist-To: ") (mh-read-address "Redist-Cc: ") (mh-get-msg-num t))) (or msg (setq msg (mh-get-msg-num t))) (save-window-excursion (let ((folder mh-current-folder) (draft (mh-read-draft "redistribution" (if mh-redist-full-contents (mh-msg-filename msg) nil) nil))) (mh-goto-header-end 0) (insert "Resent-To: " to "\n") (if (not (equal cc "")) (insert "Resent-cc: " cc "\n")) (mh-clean-msg-header (point-min) "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:" nil) (save-buffer) (message "Redistributing...") (if mh-redist-full-contents (call-process "/bin/sh" nil 0 nil "-c" (format "mhdist=1 mhaltmsg=%s %s -push %s" buffer-file-name (expand-file-name mh-send-prog mh-progs) buffer-file-name)) (call-process "/bin/sh" nil 0 nil "-c" (format "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s" (mh-msg-filename msg folder) (expand-file-name mh-send-prog mh-progs) buffer-file-name))) (mh-annotate-msg msg folder mh-note-dist "-component" "Resent:" "-text" (format "\"%s %s\"" to cc)) (kill-buffer draft) (message "Redistributing...done")))) (defun mh-reply (message &optional includep) "Reply to MESSAGE (default: current message). If optional prefix argument INCLUDEP provided, then include the message in the reply using filter mhl.reply in your MH directory. Prompts for type of addresses to reply to: from sender only, to sender and primary recipients, cc/all sender and all recipients. If the file named by `mh-repl-formfile' exists, it is used as a skeleton for the reply. See also documentation for `\\[mh-send]' function." (interactive (list (mh-get-msg-num t) current-prefix-arg)) (let ((minibuffer-help-form "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients")) (let ((reply-to (or mh-reply-default-reply-to (completing-read "Reply to whom: " '(("from") ("to") ("cc") ("all")) nil t))) (folder mh-current-folder) (show-buffer mh-show-buffer) (config (current-window-configuration))) (message "Composing a reply...") (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder" (if (stringp mh-repl-formfile) ;must be string, but we're paranoid (list "-form" mh-repl-formfile)) mh-current-folder message (cond ((or (equal reply-to "from") (equal reply-to "")) '("-nocc" "all")) ((equal reply-to "to") '("-cc" "to")) ((or (equal reply-to "cc") (equal reply-to "all")) '("-cc" "all" "-nocc" "me"))) (if includep '("-filter" "mhl.reply"))) (let ((draft (mh-read-draft "reply" (expand-file-name "reply" mh-user-path) t))) (delete-other-windows) (save-buffer) (let ((to (mh-get-header-field "To:")) (subject (mh-get-header-field "Subject:")) (cc (mh-get-header-field "Cc:"))) (goto-char (point-min)) (mh-goto-header-end 1) (or includep (mh-in-show-buffer (show-buffer) (mh-display-msg message folder))) (mh-add-msgs-to-seq message 'answered t) (message "Composing a reply...done") (mh-compose-and-send-mail draft "" folder message to subject cc mh-note-repl "Replied:" config)))))) (defun mh-send (to cc subject) "Compose and send a letter. The file named by `mh-comp-formfile' will be used as the form. Do not call this function from outside mh-e; use \\[mh-smail] instead. The letter is composed in mh-letter-mode; see its documentation for more details. If `mh-compose-letter-function' is defined, it is called on the draft and passed three arguments: to, subject, and cc." (interactive (list (mh-read-address "To: ") (mh-read-address "Cc: ") (read-string "Subject: "))) (let ((config (current-window-configuration))) (delete-other-windows) (mh-send-sub to cc subject config))) (defun mh-send-other-window (to cc subject) "Compose and send a letter in another window. Do not call this function from outside mh-e; use \\[mh-smail-other-window] instead. See also documentation for `\\[mh-send]' function." (interactive (list (mh-read-address "To: ") (mh-read-address "Cc: ") (read-string "Subject: "))) (let ((pop-up-windows t)) (mh-send-sub to cc subject (current-window-configuration)))) (defun mh-send-sub (to cc subject config) ;; Do the real work of composing and sending a letter. ;; Expects the TO, CC, and SUBJECT fields as arguments. ;; CONFIG is the window configuration before sending mail. (let ((folder mh-current-folder) (msg-num (mh-get-msg-num nil))) (message "Composing a message...") (let ((draft (mh-read-draft "message" (let (components) (cond ((file-exists-p (setq components (expand-file-name mh-comp-formfile mh-user-path))) components) ((file-exists-p (setq components (expand-file-name mh-comp-formfile mh-lib))) components) (t (error (format "Can't find components file \"%s\"" components))))) nil))) (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc) (goto-char (point-max)) (message "Composing a message...done") (mh-compose-and-send-mail draft "" folder msg-num to subject cc nil nil config)))) (defun mh-read-draft (use initial-contents delete-contents-file) ;; Read draft file into a draft buffer and make that buffer the current one. ;; USE is a message used for prompting about the intended use of the message. ;; INITIAL-CONTENTS is filename that is read into an empty buffer, or NIL ;; if buffer should not be modified. Delete the initial-contents file if ;; DELETE-CONTENTS-FILE flag is set. ;; Returns the draft folder's name. ;; If the draft folder facility is enabled in ~/.mh_profile, a new buffer is ;; used each time and saved in the draft folder. The draft file can then be ;; reused. (cond (mh-draft-folder (let ((orig-default-dir default-directory) (draft-file-name (mh-new-draft-name))) (pop-to-buffer (generate-new-buffer (format "draft-%s" (file-name-nondirectory draft-file-name)))) (condition-case () (insert-file-contents draft-file-name t) (file-error)) (setq default-directory orig-default-dir))) (t (let ((draft-name (expand-file-name "draft" mh-user-path))) (pop-to-buffer "draft") ; Create if necessary (if (buffer-modified-p) (if (y-or-n-p "Draft has been modified; kill anyway? ") (set-buffer-modified-p nil) (error "Draft preserved"))) (setq buffer-file-name draft-name) (clear-visited-file-modtime) (unlock-buffer) (cond ((and (file-exists-p draft-name) (not (equal draft-name initial-contents))) (insert-file-contents draft-name) (delete-file draft-name)))))) (cond ((and initial-contents (or (zerop (buffer-size)) (if (y-or-n-p (format "A draft exists. Use for %s? " use)) (if mh-error-if-no-draft (error "A prior draft exists.")) t))) (erase-buffer) (insert-file-contents initial-contents) (if delete-contents-file (delete-file initial-contents)))) (auto-save-mode 1) (if mh-draft-folder (save-buffer)) ; Do not reuse draft name (buffer-name)) (defun mh-new-draft-name () ;; Returns the pathname of folder for draft messages. (save-excursion (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new") (buffer-substring (point-min) (1- (point-max))))) (defun mh-annotate-msg (msg buffer note &rest args) ;; Mark the MESSAGE in BUFFER listing with the character NOTE and annotate ;; the saved message with ARGS. (apply 'mh-exec-cmd "anno" buffer msg args) (save-excursion (cond ((get-buffer buffer) ; Buffer may be deleted (set-buffer buffer) (if (symbolp msg) (mh-notate-seq msg note (1+ mh-cmd-note)) (mh-notate msg note (1+ mh-cmd-note))))))) (defun mh-insert-fields (&rest name-values) ;; Insert the NAME-VALUE pairs in the current buffer. ;; If field NAME exists, append VALUE to it. ;; Do not insert any pairs whose value is the empty string. (let ((case-fold-search t)) (while name-values (let ((field-name (car name-values)) (value (car (cdr name-values)))) (cond ((equal value "") nil) ((mh-position-on-field field-name) (insert " " value)) (t (insert field-name " " value "\n"))) (setq name-values (cdr (cdr name-values))))))) (defun mh-position-on-field (field &optional ignore) ;; Move to the end of the FIELD in the header. ;; Move to end of entire header if FIELD not found. ;; Returns non-nil iff FIELD was found. ;; The optional second arg is for pre-version 4 compatibility. (if (mh-goto-header-field field) (progn (mh-header-field-end) t))) (defun mh-get-header-field (field) ;; Find and return the body of FIELD in the mail header. ;; Returns the empty string if the field is not in the header of the ;; current buffer. (if (mh-goto-header-field field) (progn (skip-chars-forward " \t") ;strip leading white space in body (let ((start (point))) (mh-header-field-end) (buffer-substring start (point)))) "")) (fset 'mh-get-field 'mh-get-header-field) ;mh-e 4 compatibility (defun mh-goto-header-field (field) ;; Move to FIELD in the message header. ;; Move to the end of the FIELD name, which should end in a colon. ;; Returns T if found, NIL if not. (goto-char (point-min)) (let ((case-fold-search t) (headers-end (save-excursion (mh-goto-header-end 0) (point)))) (re-search-forward (format "^%s" field) headers-end t))) (defun mh-header-field-end () ;; Move to the end of the current header field. ;; Handles RFC 822 continuation lines. (forward-line 1) (while (looking-at "^[ \t]") (forward-line 1)) (backward-char 1)) ;to end of previous line (defun mh-goto-header-end (arg) ;; Find the end of the message header in the current buffer and position ;; the cursor at the ARG'th newline after the header. (if (re-search-forward "^-*$" nil nil) (forward-line arg))) (defun mh-read-address (prompt) ;; Read a To: or Cc: address, prompting in the minibuffer with PROMPT. ;; May someday do completion on aliases. (read-string prompt)) ;;; Mode for composing and sending a draft message. (defvar mh-sent-from-folder nil) ;Folder of msg assoc with this letter. (defvar mh-sent-from-msg nil) ;Number of msg assoc with this letter. (defvar mh-send-args nil) ;Extra args to pass to "send" command. (defvar mh-annotate-char nil) ;Character to use to annotate mh-sent-from-msg. (defvar mh-annotate-field nil) ;Field name for message annotation. (put 'mh-letter-mode 'mode-class 'special) ;;;###autoload (defun mh-letter-mode () "Mode for composing letters in mh-e.\\ When you have finished composing, type \\[mh-send-letter] to send the message using the MH mail handling system. See the documentation for \\[mh-edit-mhn] for information on composing MIME messages. \\{mh-letter-mode-map} Variables controlling this mode (defaults in parentheses): mh-delete-yanked-msg-window (nil) If non-nil, \\[mh-yank-cur-msg] will delete any windows displaying the yanked message. mh-yank-from-start-of-msg (t) If non-nil, \\[mh-yank-cur-msg] will include the entire message. If `body', just yank the body (no header). If nil, only the portion of the message following the point will be yanked. If there is a region, this variable is ignored. mh-ins-buf-prefix (\"> \") String to insert before each non-blank line of a message as it is inserted in a draft letter. mh-signature-file-name (\"~/.signature\") File to be inserted into message by \\[mh-insert-signature]. Upon invoking mh-letter-mode, text-mode-hook and mh-letter-mode-hook are invoked with no args, if those values are non-nil." (interactive) (or mh-user-path (mh-find-path)) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-start)) (make-local-variable 'paragraph-separate) (setq paragraph-separate (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-separate)) (make-local-variable 'mh-send-args) (make-local-variable 'mh-annotate-char) (make-local-variable 'mh-annotate-field) (make-local-variable 'mh-previous-window-config) (make-local-variable 'mh-sent-from-folder) (make-local-variable 'mh-sent-from-msg) (make-local-variable 'mail-header-separator) (setq mail-header-separator "--------") ;for Hyperbole (use-local-map mh-letter-mode-map) (setq major-mode 'mh-letter-mode) (mh-set-mode-name "MH-Letter") (set-syntax-table mh-letter-mode-syntax-table) (run-hooks 'text-mode-hook) ;; if text-mode-hook turned on auto-fill, tune it for messages (cond ((and (boundp 'auto-fill-hook) auto-fill-hook) ;emacs 18 (make-local-variable 'auto-fill-hook) (setq auto-fill-hook 'mh-auto-fill-for-letter))) (cond ((and (boundp 'auto-fill-function) auto-fill-function) ;emacs 19 (make-local-variable 'auto-fill-function) (setq auto-fill-function 'mh-auto-fill-for-letter))) (run-hooks 'mh-letter-mode-hook)) (defun mh-auto-fill-for-letter () ;; Auto-fill in letters treats the header specially by inserting a tab ;; before continuation line. (if (mh-in-header-p) (let ((fill-prefix "\t")) (do-auto-fill)) (do-auto-fill))) (defun mh-in-header-p () ;; Return non-nil if the point is in the header of a draft message. (save-excursion (let ((cur-point (point))) (goto-char (point-min)) (re-search-forward "^-*$" nil t) (< cur-point (point))))) (defun mh-to-field () "Move point to the end of a specified header field. The field is indicated by the previous keystroke (the last keystroke of the command) according to the list in the variable mh-to-field-choices. Create the field if it does not exist. Set the mark to point before moving." (interactive) (expand-abbrev) (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`)) mh-to-field-choices) ;; also look for a char for version 4 compat (assoc (logior last-input-char ?`) mh-to-field-choices)))) (case-fold-search t)) (push-mark) (cond ((mh-position-on-field target) (let ((eol (point))) (skip-chars-backward " \t") (delete-region (point) eol)) (if (and (not (eq (logior last-input-char ?`) ?s)) (save-excursion (backward-char 1) (not (looking-at "[:,]")))) (insert ", ") (insert " "))) (t (if (mh-position-on-field "To:") (forward-line 1)) (insert (format "%s \n" target)) (backward-char 1))))) (defun mh-to-fcc (&optional folder) "Insert an Fcc: FOLDER field in the current message. Prompt for the field name with a completion list of the current folders." (interactive) (or folder (setq folder (mh-prompt-for-folder "Fcc" (or (and mh-default-folder-for-message-function (save-excursion (goto-char (point-min)) (funcall mh-default-folder-for-message-function))) "") t))) (let ((last-input-char ?\C-f)) (expand-abbrev) (save-excursion (mh-to-field) (insert (if (mh-folder-name-p folder) (substring folder 1) folder))))) (defun mh-insert-signature () "Insert the file named by mh-signature-file-name at the current point." (interactive) (insert-file-contents mh-signature-file-name) (force-mode-line-update)) (defun mh-check-whom () "Verify recipients of the current letter, showing expansion of any aliases." (interactive) (let ((file-name buffer-file-name)) (save-buffer) (message "Checking recipients...") (mh-in-show-buffer ("*Recipients*") (bury-buffer (current-buffer)) (erase-buffer) (mh-exec-cmd-output "whom" t file-name)) (message "Checking recipients...done"))) ;;; Routines to compose and send a letter. (defun mh-compose-and-send-mail (draft send-args sent-from-folder sent-from-msg to subject cc annotate-char annotate-field config) ;; Edit and compose a draft message in buffer DRAFT and send or save it. ;; SENT-FROM-FOLDER is buffer containing scan listing of current folder, or ;; nil if none exists. ;; SENT-FROM-MSG is the message number or sequence name or nil. ;; SEND-ARGS is an optional argument passed to the send command. ;; The TO, SUBJECT, and CC fields are passed to the ;; mh-compose-letter-function. ;; If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the ;; message. In that case, the ANNOTATE-FIELD is used to build a string ;; for mh-annotate-msg. ;; CONFIG is the window configuration to restore after sending the letter. (pop-to-buffer draft) (mh-letter-mode) (setq mh-sent-from-folder sent-from-folder) (setq mh-sent-from-msg sent-from-msg) (setq mh-send-args send-args) (setq mh-annotate-char annotate-char) (setq mh-annotate-field annotate-field) (setq mh-previous-window-config config) (setq mode-line-buffer-identification (list "{%b}")) (if (and (boundp 'mh-compose-letter-function) mh-compose-letter-function) ;; run-hooks will not pass arguments. (let ((value mh-compose-letter-function)) (if (and (listp value) (not (eq (car value) 'lambda))) (while value (funcall (car value) to subject cc) (setq value (cdr value))) (funcall mh-compose-letter-function to subject cc))))) (defun mh-send-letter (&optional arg) "Send the draft letter in the current buffer. If optional prefix argument is provided, monitor delivery. Run mh-before-send-letter-hook before doing anything." (interactive "P") (run-hooks 'mh-before-send-letter-hook) (save-buffer) (message "Sending...") (let ((draft-buffer (current-buffer)) (file-name buffer-file-name) (config mh-previous-window-config)) (cond (arg (pop-to-buffer "MH mail delivery") (erase-buffer) (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" "-nodraftfolder" mh-send-args file-name) (goto-char (point-max)) ; show the interesting part (recenter -1) (set-buffer draft-buffer)) ; for annotation below (t (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose" mh-send-args file-name))) (if mh-annotate-char (mh-annotate-msg mh-sent-from-msg mh-sent-from-folder mh-annotate-char "-component" mh-annotate-field "-text" (format "\"%s %s\"" (mh-get-header-field "To:") (mh-get-header-field "Cc:")))) (cond ((or (not arg) (y-or-n-p "Kill draft buffer? ")) (kill-buffer draft-buffer) (if config (set-window-configuration config)))) (if arg (message "Sending...done") (message "Sending...backgrounded")))) (defun mh-insert-letter (folder message verbatim) "Insert a message into the current letter. Removes the message's headers using mh-invisible-headers. Prefixes each non-blank line with mh-ins-buf-prefix. Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do not indent and do not delete headers. Leaves the mark before the letter and point after it." (interactive (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) (read-input (format "Message number%s: " (if mh-sent-from-msg (format " [%d]" mh-sent-from-msg) ""))) current-prefix-arg)) (save-restriction (narrow-to-region (point) (point)) (let ((start (point-min))) (if (equal message "") (setq message (int-to-string mh-sent-from-msg))) (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" (expand-file-name message (mh-expand-file-name folder))) (cond ((not verbatim) (mh-clean-msg-header start mh-invisible-headers mh-visible-headers) (set-mark start) ; since mh-clean-msg-header moves it (mh-insert-prefix-string mh-ins-buf-prefix)))))) (defun mh-yank-cur-msg () "Insert the current message into the draft buffer. Prefix each non-blank line in the message with the string in `mh-ins-buf-prefix'. If a region is set in the message's buffer, then only the region will be inserted. Otherwise, the entire message will be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable is nil, the portion of the message following the point will be yanked. If `mh-delete-yanked-msg-window' is non-nil, any window displaying the yanked message will be deleted." (interactive) (if (and mh-sent-from-folder mh-sent-from-msg) (let ((to-point (point)) (to-buffer (current-buffer))) (set-buffer mh-sent-from-folder) (if mh-delete-yanked-msg-window (delete-windows-on mh-show-buffer)) (set-buffer mh-show-buffer) ; Find displayed message (let ((mh-ins-str (cond ((if (boundp 'mark-active) mark-active ;Emacs 19 (mark)) ;Emacs 18 (buffer-substring (region-beginning) (region-end))) ((eq 'body mh-yank-from-start-of-msg) (buffer-substring (save-excursion (goto-char (point-min)) (mh-goto-header-end 1) (point)) (point-max))) (mh-yank-from-start-of-msg (buffer-substring (point-min) (point-max))) (t (buffer-substring (point) (point-max)))))) (set-buffer to-buffer) (save-restriction (narrow-to-region to-point to-point) (push-mark) (insert mh-ins-str) (mh-insert-prefix-string mh-ins-buf-prefix) (insert "\n")))) (error "There is no current message"))) (defun mh-insert-prefix-string (mh-ins-string) ;; Run mail-citation-hook to insert a prefix string before each line ;; in the buffer. Generality for supercite users. (set-mark (point-max)) (goto-char (point-min)) (cond (mail-citation-hook (run-hooks 'mail-citation-hook)) (mh-yank-hooks ;old hook name (run-hooks 'mh-yank-hooks)) (t (or (bolp) (forward-line 1)) (let ((zmacs-regions nil)) ;so "(mark)" works in XEmacs (while (< (point) (mark)) (insert mh-ins-string) (forward-line 1)))))) (defun mh-fully-kill-draft () "Kill the draft message file and the draft message buffer. Use \\[kill-buffer] if you don't want to delete the draft message file." (interactive) (if (y-or-n-p "Kill draft message? ") (let ((config mh-previous-window-config)) (if (file-exists-p buffer-file-name) (delete-file buffer-file-name)) (set-buffer-modified-p nil) (kill-buffer (buffer-name)) (message "") (if config (set-window-configuration config))) (error "Message not killed"))) ;;; Build the letter-mode keymap: (define-key mh-letter-mode-map "\C-c\C-f\C-b" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-f\C-c" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-f\C-d" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-f\C-f" 'mh-to-fcc) (define-key mh-letter-mode-map "\C-c\C-f\C-r" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-f\C-s" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-f\C-t" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-fb" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-fc" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-fd" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-ff" 'mh-to-fcc) (define-key mh-letter-mode-map "\C-c\C-fr" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-fs" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-ft" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-i" 'mh-insert-letter) (define-key mh-letter-mode-map "\C-c\C-q" 'mh-fully-kill-draft) (define-key mh-letter-mode-map "\C-c\C-\\" 'mh-fully-kill-draft) ;if no C-q (define-key mh-letter-mode-map "\C-c\C-s" 'mh-insert-signature) (define-key mh-letter-mode-map "\C-c\C-^" 'mh-insert-signature) ;if no C-s (define-key mh-letter-mode-map "\C-c\C-w" 'mh-check-whom) (define-key mh-letter-mode-map "\C-c\C-y" 'mh-yank-cur-msg) (define-key mh-letter-mode-map "\C-c\C-c" 'mh-send-letter) (define-key mh-letter-mode-map "\C-c\C-m\C-f" 'mh-mhn-compose-forw) (define-key mh-letter-mode-map "\C-c\C-m\C-e" 'mh-mhn-compose-anon-ftp) (define-key mh-letter-mode-map "\C-c\C-m\C-t" 'mh-mhn-compose-external-compressed-tar) (define-key mh-letter-mode-map "\C-c\C-m\C-i" 'mh-mhn-compose-insertion) (define-key mh-letter-mode-map "\C-c\C-e" 'mh-edit-mhn) (define-key mh-letter-mode-map "\C-c\C-m\C-u" 'mh-revert-mhn-edit) ;; "C-c /" prefix is used in mh-letter-mode by pgp.el ;;; autoloads from mh-mime (autoload 'mh-mhn-compose-insertion "mh-mime" "Add a directive to insert a MIME message part from a file. This is the typical way to insert non-text parts in a message. See also \\[mh-edit-mhn]." t) (autoload 'mh-mhn-compose-anon-ftp "mh-mime" "Add a directive for a MIME anonymous ftp external body part. This directive tells MH to include a reference to a message/external-body part retrievable by anonymous FTP. See also \\[mh-edit-mhn]." t) (autoload 'mh-mhn-compose-external-compressed-tar "mh-mime" "Add a directive to include a MIME reference to a compressed tar file. The file should be available via anonymous ftp. This directive tells MH to include a reference to a message/external-body part. See also \\[mh-edit-mhn]." t) (autoload 'mh-mhn-compose-forw "mh-mime" "Add a forw directive to this message, to forward a message with MIME. This directive tells MH to include another message in this one. See also \\[mh-edit-mhn]." t) (autoload 'mh-edit-mhn "mh-mime" "Format the current draft for MIME, expanding any mhn directives. Process the current draft with the mhn program, which, using directives already inserted in the draft, fills in all the MIME components and header fields. This step should be done last just before sending the message. The mhn program is part of MH version 6.8 or later. The `\\[mh-revert-mhn-edit]' command undoes this command. For assistance with creating mhn directives to insert various types of components in a message, see \\[mh-mhn-compose-insertion] (generic insertion from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward message)." t) (autoload 'mh-revert-mhn-edit "mh-mime" "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file. Optional non-nil argument means don't ask for confirmation." t) emacs-19.30/lisp/mh-e.el100444 75424 1 146661 6046277121 13504 0ustar kwzhdaemon;;; mh-e.el --- GNU Emacs interface to the MH mail system ;;; Copyright (C) 1985,86,87,88,90,92,93,94,95 Free Software Foundation, Inc. (defconst mh-e-time-stamp "Time-stamp: <95/10/30 19:14:06 gildea>") (defconst mh-e-version "5.0.2" "Version numbers of this version of mh-e.") ;; Maintainer: Stephen Gildea ;; Version: 5.0.2 ;; Keywords: mail ;; Bug-reports: include `M-x mh-version' output in any correspondence ;; This file is part of mh-e, 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: ;;; HOW TO USE: ;;; M-x mh-rmail to read mail. Type C-h m there for a list of commands. ;;; C-u M-x mh-rmail to visit any folder. ;;; M-x mh-smail to send mail. From within the mail reader, "m" works, too. ;;; MH (Message Handler) is a powerful mail reader. The MH newsgroup ;;; is comp.mail.mh; the mailing list is mh-users@ics.uci.edu (send to ;;; mh-users-request to be added). See the monthly Frequently Asked ;;; Questions posting there for information on getting MH and mh-e. ;;; mh-e is an Emacs interface to the MH mail system. ;;; The mailing list mh-e@x.org is for discussion of mh-e and ;;; announcements of new versions. Send a "subscribe" message to ;;; mh-e-request@x.org to be added. Do not report bugs here; mail ;;; them directly to the author (see top of mh-e.el source). ;;; Include the output of M-x mh-version in any bug report. ;;; mh-e works with GNU Emacs 18 or 19, and MH 6. ;;; NB. MH must have been compiled with the MHE compiler flag or several ;;; features necessary for mh-e will be missing from MH commands, specifically ;;; the -build switch to repl and forw. ;;; Your .emacs might benefit from these bindings: ;;; (global-set-key "\C-cr" 'mh-rmail) ;;; (global-set-key "\C-xm" 'mh-smail) ;;; (global-set-key "\C-x4m" 'mh-smail-other-window) ;;; Change Log: ;;; Original version for Gosling emacs by Brian Reid, Stanford, 1982. ;;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985. ;;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu ;;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu (defconst mh-e-RCS-id "$Id: mh-e.el,v 1.9 1995/11/03 02:28:26 kwzh Exp $") ;;; Code: (provide 'mh-e) (require 'mh-utils) ;;; Hooks: (defvar mh-folder-mode-hook nil "Invoked in MH-Folder mode on a new folder.") (defvar mh-inc-folder-hook nil "Invoked by \\`\\[mh-inc-folder]' after incorporating mail into a folder.") (defvar mh-show-hook nil "Invoked after \\`\\[mh-show]' shows a message.") (defvar mh-show-mode-hook nil "Invoked in MH-Show mode on each message.") (defvar mh-delete-msg-hook nil "Invoked after marking each message for deletion.") (defvar mh-refile-msg-hook nil "Invoked after marking each message for refiling.") (defvar mh-before-quit-hook nil "Invoked by \\`\\[mh-quit]' before quitting mh-e. See also mh-quit-hook.") (defvar mh-quit-hook nil "Invoked after \\`\\[mh-quit]' quits mh-e. See also mh-before-quit-hook.") ;;; Personal preferences: (defvar mh-lpr-command-format "lpr -J '%s'" "*Format for Unix command that prints a message. The string should be a Unix command line, with the string '%s' where the job's name (folder and message number) should appear. The formatted message text is piped to this command when you type \\`\\[mh-print-msg]'.") (defvar mh-scan-prog "scan" "*Program to run to generate one-line-per-message listing of a folder. Normally \"scan\" or a file name linked to scan. This file is searched for relative to the mh-progs directory unless it is an absolute pathname. Automatically becomes buffer-local when set in any fashion.") (make-variable-buffer-local 'mh-scan-prog) (defvar mh-inc-prog "inc" "*Program to run to incorporate new mail into a folder. Normally \"inc\". This file is searched for relative to the mh-progs directory unless it is an absolute pathname.") (defvar mh-print-background nil "*Print messages in the background if non-nil. WARNING: do not delete the messages until printing is finished; otherwise, your output may be truncated.") (defvar mh-recenter-summary-p nil "*Recenter summary window when the show window is toggled off if non-nil.") (defvar mh-do-not-confirm nil "*Non-nil means do not prompt for confirmation before some mh-e commands. Affects non-recoverable commands such as mh-kill-folder and mh-undo-folder.") (defvar mh-store-default-directory nil "*Last directory used by \\[mh-store-msg]; default for next store. A directory name string, or nil to use current directory.") ;;; Parameterize mh-e to work with different scan formats. The defaults work ;;; with the standard MH scan listings, in which the first 4 characters on ;;; the line are the message number, followed by two places for notations. (defvar mh-good-msg-regexp "^....[^D^]" "Regexp specifiying the scan lines that are 'good' messages.") (defvar mh-deleted-msg-regexp "^....D" "Regexp matching scan lines of deleted messages.") (defvar mh-refiled-msg-regexp "^....\\^" "Regexp matching scan lines of refiled messages.") (defvar mh-valid-scan-line "^ *[0-9]" "Regexp matching scan lines for messages (not error messages).") (defvar mh-cur-scan-msg-regexp "^....\\+" "Regexp matching scan line for the cur message.") (defvar mh-note-deleted "D" "String whose first character is used to notate deleted messages.") (defvar mh-note-refiled "^" "String whose first character is used to notate refiled messages.") (defvar mh-note-cur "+" "String whose first character is used to notate the current message.") (defvar mh-partial-folder-mode-line-annotation "select" "Annotation when displaying part of a folder. The string is displayed after the folder's name. NIL for no annotation.") ;;; Internal variables: (defvar mh-last-destination nil) ;Destination of last refile or write command. (defvar mh-folder-mode-map (make-keymap) "Keymap for MH folders.") (defvar mh-delete-list nil) ;List of msg numbers to delete. (defvar mh-refile-list nil) ;List of folder names in mh-seq-list. (defvar mh-next-direction 'forward) ;Direction to move to next message. (defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or nil if not narrowed. (defvar mh-first-msg-num nil) ;Number of first msg in buffer. (defvar mh-last-msg-num nil) ;Number of last msg in buffer. (defvar mh-mode-line-annotation nil) ;Indiction this is not the full folder. ;;; Macros and generic functions: (defun mh-mapc (func list) (while list (funcall func (car list)) (setq list (cdr list)))) ;;; Entry points: ;;;###autoload (defun mh-rmail (&optional arg) "Inc(orporate) new mail with MH, or, with arg, scan an MH mail folder. This function is an entry point to mh-e, the Emacs front end to the MH mail system." (interactive "P") (mh-find-path) (if arg (call-interactively 'mh-visit-folder) (mh-inc-folder))) ;;; mh-smail and mh-smail-other-window have been moved to the new file ;;; mh-comp.el, but Emacs 18 still looks for them here, so provide a ;;; definition here, too, for a while. (defun mh-smail () "Compose and send mail with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system." (interactive) (mh-find-path) (require 'mh-comp) (call-interactively 'mh-send)) (defun mh-smail-other-window () "Compose and send mail in other window with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system." (interactive) (mh-find-path) (require 'mh-comp) (call-interactively 'mh-send-other-window)) ;;; User executable mh-e commands: (defun mh-delete-msg (msg-or-seq) "Mark the specified MESSAGE(s) for subsequent deletion and move to the next. Default is the displayed message. If optional prefix argument is given then prompt for the message sequence." (interactive (list (if current-prefix-arg (mh-read-seq-default "Delete" t) (mh-get-msg-num t)))) (mh-delete-msg-no-motion msg-or-seq) (mh-next-msg)) (defun mh-delete-msg-no-motion (msg-or-seq) "Mark the specified MESSAGE(s) for subsequent deletion. Default is the displayed message. If optional prefix argument is provided, then prompt for the message sequence." (interactive (list (if current-prefix-arg (mh-read-seq-default "Delete" t) (mh-get-msg-num t)))) (if (numberp msg-or-seq) (mh-delete-a-msg msg-or-seq) (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq))) (defun mh-execute-commands () "Process outstanding delete and refile requests." (interactive) (if mh-narrowed-to-seq (mh-widen)) (mh-process-commands mh-current-folder) (mh-set-scan-mode) (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency (mh-make-folder-mode-line) t) ; return t for [local-]write-file-hooks (defun mh-first-msg () "Move to the first message." (interactive) (goto-char (point-min)) (while (and (not (eobp)) (not (looking-at mh-valid-scan-line))) (forward-line 1))) (defun mh-header-display () "Show the current message with all its headers. Displays headers that might have been suppressed by setting the variables `mh-clean-message-header' or `mhl-formfile', or by the fallback behavior of scrolling uninteresting headers off the top of the window. Type \"\\[mh-show]\" to show the message normally again." (interactive) (and (not mh-showing-with-headers) (or mhl-formfile mh-clean-message-header) (mh-invalidate-show-buffer)) (let ((mhl-formfile nil) (mh-clean-message-header nil)) (mh-show-msg nil) (mh-in-show-buffer (mh-show-buffer) (goto-char (point-min)) (mh-recenter 0)) (setq mh-showing-with-headers t))) (defun mh-inc-folder (&optional maildrop-name) "Inc(orporate)s new mail into the Inbox folder. Optional prefix argument specifies an alternate maildrop from the default. If the prefix argument is given, incorporates mail into the current folder, otherwise uses the folder named by `mh-inbox'. Runs `mh-inc-folder-hook' after incorporating new mail. Do not call this function from outside mh-e; use \\[mh-rmail] instead." (interactive (list (if current-prefix-arg (expand-file-name (read-file-name "inc mail from file: " mh-user-path))))) (let ((config (current-window-configuration))) (if (not maildrop-name) (cond ((not (get-buffer mh-inbox)) (mh-make-folder mh-inbox) (setq mh-previous-window-config config)) ((not (eq (current-buffer) (get-buffer mh-inbox))) (switch-to-buffer mh-inbox) (setq mh-previous-window-config config))))) (mh-get-new-mail maildrop-name) (run-hooks 'mh-inc-folder-hook)) (defun mh-last-msg () "Move to the last message." (interactive) (goto-char (point-max)) (while (and (not (bobp)) (looking-at "^$")) (forward-line -1))) (defun mh-next-undeleted-msg (&optional arg) "Move to the NTH next undeleted message in window." (interactive "p") (setq mh-next-direction 'forward) (forward-line 1) (cond ((re-search-forward mh-good-msg-regexp nil 0 arg) (beginning-of-line) (mh-maybe-show)) (t (forward-line -1) (if (get-buffer mh-show-buffer) (delete-windows-on mh-show-buffer))))) (defun mh-refile-msg (msg-or-seq folder) "Refile MESSAGE(s) (default: displayed message) into FOLDER. If optional prefix argument provided, then prompt for message sequence." (interactive (list (if current-prefix-arg (mh-read-seq-default "Refile" t) (mh-get-msg-num t)) (intern (mh-prompt-for-folder "Destination" (or (and mh-default-folder-for-message-function (let ((refile-file (mh-msg-filename (mh-get-msg-num t)))) (save-excursion (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) (insert-file-contents refile-file) (let ((buffer-file-name refile-file)) (funcall mh-default-folder-for-message-function))))) (and (eq 'refile (car mh-last-destination)) (symbol-name (cdr mh-last-destination))) "") t)))) (setq mh-last-destination (cons 'refile folder)) (if (numberp msg-or-seq) (mh-refile-a-msg msg-or-seq folder) (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder)) (mh-next-msg)) (defun mh-refile-or-write-again (message) "Re-execute the last refile or write command on the given MESSAGE. Default is the displayed message. Use the same folder or file as the previous refile or write command." (interactive (list (mh-get-msg-num t))) (if (null mh-last-destination) (error "No previous refile or write")) (cond ((eq (car mh-last-destination) 'refile) (mh-refile-a-msg message (cdr mh-last-destination)) (message "Destination folder: %s" (cdr mh-last-destination))) (t (apply 'mh-write-msg-to-file message (cdr mh-last-destination)) (message "Destination: %s" (cdr mh-last-destination)))) (mh-next-msg)) (defun mh-quit () "Quit the current mh-e folder. Start by running mh-before-quit-hook. Restore the previous window configuration, if one exists. Finish by running mh-quit-hook." (interactive) (run-hooks 'mh-before-quit-hook) (mh-update-sequences) (mh-invalidate-show-buffer) (bury-buffer (current-buffer)) (if (get-buffer mh-show-buffer) (bury-buffer mh-show-buffer)) (if mh-previous-window-config (set-window-configuration mh-previous-window-config)) (run-hooks 'mh-quit-hook)) (defun mh-page-msg (&optional arg) "Page the displayed message forwards. Scrolls ARG lines or a full screen if no argument is supplied." (interactive "P") (scroll-other-window arg)) (defun mh-previous-page (&optional arg) "Page the displayed message backwards. Scrolls ARG lines or a full screen if no argument is supplied." (interactive "P") (mh-in-show-buffer (mh-show-buffer) (scroll-down arg))) (defun mh-previous-undeleted-msg (&optional arg) "Move to the NTH previous undeleted message in window." (interactive "p") (setq mh-next-direction 'backward) (beginning-of-line) (cond ((re-search-backward mh-good-msg-regexp nil 0 arg) (mh-maybe-show)) (t (if (get-buffer mh-show-buffer) (delete-windows-on mh-show-buffer))))) (defun mh-rescan-folder (&optional range) "Rescan a folder after optionally processing the outstanding commands. If optional prefix argument is provided, prompt for the range of messages to display. Otherwise show the entire folder." (interactive (list (if current-prefix-arg (mh-read-msg-range "Range to scan [all]? ") nil))) (setq mh-next-direction 'forward) (mh-scan-folder mh-current-folder (or range "all"))) (defun mh-write-msg-to-file (msg file no-headers) "Append MESSAGE to the end of a FILE. If NO-HEADERS (prefix argument) is provided, write only the message body. Otherwise send the entire message including the headers." (interactive (list (mh-get-msg-num t) (let ((default-dir (if (eq 'write (car mh-last-destination)) (file-name-directory (car (cdr mh-last-destination))) default-directory))) (read-file-name (format "Save message%s in file: " (if current-prefix-arg " body" "")) default-dir (if (eq 'write (car mh-last-destination)) (car (cdr mh-last-destination)) (expand-file-name "mail.out" default-dir)))) current-prefix-arg)) (let ((msg-file-to-output (mh-msg-filename msg)) (output-file (mh-expand-file-name file))) (setq mh-last-destination (list 'write file (if no-headers 'no-headers))) (save-excursion (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) (insert-file-contents msg-file-to-output) (goto-char (point-min)) (if no-headers (search-forward "\n\n")) (append-to-file (point) (point-max) output-file)))) (defun mh-toggle-showing () "Toggle the scanning mode/showing mode of displaying messages." (interactive) (if mh-showing (mh-set-scan-mode) (mh-show))) (defun mh-undo (msg-or-seq) "Undo the pending deletion or refile of the specified MESSAGE(s). Default is the displayed message. If optional prefix argument is provided, then prompt for the message sequence." (interactive (list (if current-prefix-arg (mh-read-seq-default "Undo" t) (mh-get-msg-num t)))) (cond ((numberp msg-or-seq) (let ((original-position (point))) (beginning-of-line) (while (not (or (looking-at mh-deleted-msg-regexp) (looking-at mh-refiled-msg-regexp) (and (eq mh-next-direction 'forward) (bobp)) (and (eq mh-next-direction 'backward) (save-excursion (forward-line) (eobp))))) (forward-line (if (eq mh-next-direction 'forward) -1 1))) (if (or (looking-at mh-deleted-msg-regexp) (looking-at mh-refiled-msg-regexp)) (progn (mh-undo-msg (mh-get-msg-num t)) (mh-maybe-show)) (goto-char original-position) (error "Nothing to undo")))) (t (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq))) ;; update the mh-refile-list so mh-outstanding-commands-p will work (mh-mapc (function (lambda (elt) (if (not (mh-seq-to-msgs elt)) (setq mh-refile-list (delq elt mh-refile-list))))) mh-refile-list) (if (not (mh-outstanding-commands-p)) (mh-set-folder-modified-p nil))) ;;;###autoload (defun mh-version () "Display version information about mh-e and the MH mail handling system." (interactive) (mh-find-progs) (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) (insert " mh-e info:\n\nversion: " mh-e-version "\n" mh-e-time-stamp "\nEmacs: " emacs-version " on " (symbol-name system-type) " ") (condition-case () (call-process "uname" nil t nil "-a") (file-error)) (insert "\n\n MH info:\n\n" (expand-file-name "inc" mh-progs) ":\n") (let ((help-start (point))) (condition-case err-data (mh-exec-cmd-output "inc" nil "-help") (file-error (insert (mapconcat 'concat (cdr err-data) ": ")))) (goto-char help-start) (search-forward "version: " nil t) (beginning-of-line) (delete-region help-start (point)) (goto-char (point-min))) (display-buffer mh-temp-buffer)) (defun mh-visit-folder (folder &optional range) "Visit FOLDER and display RANGE of messages. Do not call this function from outside mh-e; see \\[mh-rmail] instead." (interactive (list (mh-prompt-for-folder "Visit" mh-inbox t) (mh-read-msg-range "Range [all]? "))) (let ((config (current-window-configuration))) (mh-scan-folder folder (or range "all")) (setq mh-previous-window-config config)) nil) (defun mh-compat-quit () "The \"b\" key is obsolescent; will assume you want \"\\[mh-quit]\" ..." ;; Was going to make it run mh-burst-digest, but got complaint that ;; 'b' should mean 'back', as it does in info, less, and rn. ;; This is a temporary compatibility function. (interactive) (message "%s" (documentation this-command)) (sit-for 1) (call-interactively 'mh-quit)) (defun mh-update-sequences () "Update MH's Unseen sequence and current folder and message. Flush mh-e's state out to MH. The message at the cursor becomes current." (interactive) ;; mh-update-sequences is the opposite of mh-read-folder-sequences, ;; which updates mh-e's state from MH. (let ((folder-set (mh-update-unseen)) (new-cur (mh-get-msg-num nil))) (if new-cur (let ((seq-entry (mh-find-seq 'cur))) (mh-remove-cur-notation) (setcdr seq-entry (list new-cur)) ;delete-seq-locally, add-msgs-to-seq (mh-define-sequence 'cur (list new-cur)) (beginning-of-line) (if (looking-at mh-good-msg-regexp) (mh-notate nil mh-note-cur mh-cmd-note))) (or folder-set (save-excursion (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast")))))) ;;; Support routines. (defun mh-delete-a-msg (msg) ;; Delete the MESSAGE. (save-excursion (mh-goto-msg msg nil t) (if (looking-at mh-refiled-msg-regexp) (error "Message %d is refiled. Undo refile before deleting." msg)) (if (looking-at mh-deleted-msg-regexp) nil (mh-set-folder-modified-p t) (setq mh-delete-list (cons msg mh-delete-list)) (mh-add-msgs-to-seq msg 'deleted t) (mh-notate msg mh-note-deleted mh-cmd-note) (run-hooks 'mh-delete-msg-hook)))) (defun mh-refile-a-msg (msg destination) ;; Refile MESSAGE in FOLDER. FOLDER is a symbol, not a string. (save-excursion (mh-goto-msg msg nil t) (cond ((looking-at mh-deleted-msg-regexp) (error "Message %d is deleted. Undo delete before moving." msg)) ((looking-at mh-refiled-msg-regexp) (if (y-or-n-p (format "Message %d already refiled. Copy to %s as well? " msg destination)) (mh-exec-cmd "refile" (mh-get-msg-num t) "-link" "-src" mh-current-folder (symbol-name destination)) (message "Message not copied."))) (t (mh-set-folder-modified-p t) (if (not (memq destination mh-refile-list)) (setq mh-refile-list (cons destination mh-refile-list))) (if (not (memq msg (mh-seq-to-msgs destination))) (mh-add-msgs-to-seq msg destination t)) (mh-notate msg mh-note-refiled mh-cmd-note) (run-hooks 'mh-refile-msg-hook))))) (defun mh-next-msg () ;; Move backward or forward to the next undeleted message in the buffer. (if (eq mh-next-direction 'forward) (mh-next-undeleted-msg 1) (mh-previous-undeleted-msg 1))) (defun mh-set-scan-mode () ;; Display the scan listing buffer, but do not show a message. (if (get-buffer mh-show-buffer) (delete-windows-on mh-show-buffer)) (setq mh-showing nil) (force-mode-line-update) (if mh-recenter-summary-p (mh-recenter nil))) (defun mh-undo-msg (msg) ;; Undo the deletion or refile of one MESSAGE. (cond ((memq msg mh-delete-list) (setq mh-delete-list (delq msg mh-delete-list)) (mh-delete-msg-from-seq msg 'deleted t)) (t (mh-mapc (function (lambda (dest) (mh-delete-msg-from-seq msg dest t))) mh-refile-list))) (mh-notate msg ? mh-cmd-note)) ;;; The folder data abstraction. (defun mh-make-folder (name) ;; Create and initialize a new mail folder called NAME and make it the ;; current folder. (switch-to-buffer name) (setq buffer-read-only nil) (erase-buffer) (setq buffer-read-only t) (mh-folder-mode) (mh-set-folder-modified-p nil) (setq buffer-file-name mh-folder-filename) (mh-make-folder-mode-line)) ;;; Ensure new buffers won't get this mode if default-major-mode is nil. (put 'mh-folder-mode 'mode-class 'special) (defun mh-folder-mode () "Major mh-e mode for \"editing\" an MH folder scan listing.\\ You can show the message the cursor is pointing to, and step through the messages. Messages can be marked for deletion or refiling into another folder; these commands are executed all at once with a separate command. A prefix argument (\\[universal-argument]) to delete, refile, list, or undo applies the action to a message sequence. Here is a list of the standard keys for mh-e commands, grouped by function. This list is purposefully not customized; mh-e has a long history, and many alternate key bindings as a result. This list is to encourage users to use standard keys so the other keys can perhaps someday be put to new uses. t toggle show or scan-only mode RET show message, or back to top if already showing SPC page message forward DEL page message back n next message p previous message g go to message by number d mark for deletion o, ^ mark for output (refile) to another folder ? show folder of pending refile u undo delete or refile marking x execute marked deletes and refiles i incorporate new mail m mail a new message r reply to a message f forward a message q quit mh-e M-f visit new folder M-r rescan this folder Here are all the commands with their current binding, listed in key order: \\{mh-folder-mode-map} Variables controlling mh-e operation are (defaults in parentheses): mh-recursive-folders (nil) Non-nil means commands which operate on folders do so recursively. mh-bury-show-buffer (t) Non-nil means that the buffer used to display message is buried. It will never be offered as the default other buffer. mh-clean-message-header (nil) Non-nil means remove header lines matching the regular expression specified in mh-invisible-headers from messages. mh-visible-headers (nil) If non-nil, it contains a regexp specifying the headers that are shown in a message if mh-clean-message-header is non-nil. Setting this variable overrides mh-invisible-headers. mh-do-not-confirm (nil) Non-nil means do not prompt for confirmation before executing some non-recoverable commands such as mh-kill-folder and mh-undo-folder. mhl-formfile (nil) Name of format file to be used by mhl to show messages. A value of T means use the default format file. Nil means don't use mhl to format messages. mh-lpr-command-format (\"lpr -p -J '%s'\") Format for command used to print a message on a system printer. mh-scan-prog (\"scan\") Program to run to generate one-line-per-message listing of a folder. Normally \"scan\" or a file name linked to scan. This file is searched for relative to the mh-progs directory unless it is an absolute pathname. Automatically becomes buffer-local when set in any fashion. mh-print-background (nil) Print messages in the background if non-nil. WARNING: do not delete the messages until printing is finished; otherwise, your output may be truncated. mh-recenter-summary-p (nil) If non-nil, then the scan listing is recentered when the window displaying a messages is toggled off. mh-summary-height (4) Number of lines in the summary window including the mode line. The value of mh-folder-mode-hook is called when a new folder is set up." (kill-all-local-variables) (use-local-map mh-folder-mode-map) (setq major-mode 'mh-folder-mode) (mh-set-mode-name "MH-Folder") (mh-make-local-vars 'mh-current-folder (buffer-name) ; Name of folder, a string 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/" (file-name-as-directory (mh-expand-file-name (buffer-name))) 'mh-showing nil ; Show message also? 'mh-delete-list nil ; List of msgs nums to delete 'mh-refile-list nil ; List of folder names in mh-seq-list 'mh-seq-list nil ; Alist of (seq . msgs) nums 'mh-seen-list nil ; List of displayed messages 'mh-next-direction 'forward ; Direction to move to next message 'mh-narrowed-to-seq nil ; Sequence display is narrowed to 'mh-first-msg-num nil ; Number of first msg in buffer 'mh-last-msg-num nil ; Number of last msg in buffer 'mh-msg-count nil ; Number of msgs in buffer 'mh-mode-line-annotation nil ; Indiction this is not the full folder 'mh-previous-window-config nil) ; Previous window configuration (setq truncate-lines t) (auto-save-mode -1) (setq buffer-offer-save t) (if (boundp 'local-write-file-hooks) (setq local-write-file-hooks '(mh-execute-commands)) ;Emacs 19 (make-local-variable 'write-file-hooks) (setq write-file-hooks '(mh-execute-commands))) ;Emacs 18 (make-local-variable 'revert-buffer-function) (setq revert-buffer-function 'mh-undo-folder) (or (assq 'mh-showing minor-mode-alist) (setq minor-mode-alist (cons '(mh-showing " Show") minor-mode-alist))) (run-hooks 'mh-folder-mode-hook)) (defun mh-make-local-vars (&rest pairs) ;; Take VARIABLE-VALUE pairs and make local variables initialized to the ;; value. (while pairs (make-variable-buffer-local (car pairs)) (set (car pairs) (car (cdr pairs))) (setq pairs (cdr (cdr pairs))))) (defun mh-scan-folder (folder range) ;; Scan the FOLDER over the RANGE. Return in the folder's buffer. (cond ((null (get-buffer folder)) (mh-make-folder folder)) (t (mh-process-or-undo-commands folder) (switch-to-buffer folder))) (mh-regenerate-headers range) (cond ((zerop (buffer-size)) (if (equal range "all") (message "Folder %s is empty" folder) (message "No messages in %s, range %s" folder range)) (sit-for 5))) (mh-goto-cur-msg)) (defun mh-regenerate-headers (range &optional update) ;; scan folder over range RANGE. ;; If UPDATE, append the scan lines, otherwise replace. (let ((folder mh-current-folder) scan-start) (message "Scanning %s..." folder) (with-mh-folder-updating (nil) (if update (goto-char (point-max)) (erase-buffer)) (setq scan-start (point)) (mh-exec-cmd-output mh-scan-prog nil "-noclear" "-noheader" "-width" (window-width) folder range) (goto-char scan-start) (cond ((looking-at "scan: no messages in") (keep-lines mh-valid-scan-line)) ; Flush random scan lines ((looking-at "scan: ")) ; Keep error messages (t (keep-lines mh-valid-scan-line))) ; Flush random scan lines (setq mh-seq-list (mh-read-folder-sequences folder nil)) (mh-notate-user-sequences) (or update (setq mh-mode-line-annotation (if (equal range "all") nil mh-partial-folder-mode-line-annotation))) (mh-make-folder-mode-line)) (message "Scanning %s...done" folder))) (defun mh-get-new-mail (maildrop-name) ;; Read new mail from a maildrop into the current buffer. ;; Return in the current buffer. (let ((point-before-inc (point)) (folder mh-current-folder) (new-mail-p nil)) (with-mh-folder-updating (t) (message (if maildrop-name (format "inc %s -file %s..." folder maildrop-name) (format "inc %s..." folder))) (setq mh-next-direction 'forward) (goto-char (point-max)) (let ((start-of-inc (point))) (if maildrop-name ;; I think MH 5 used "-ms-file" instead of "-file", ;; which would make inc'ing from maildrops fail. (mh-exec-cmd-output mh-inc-prog nil folder "-file" (expand-file-name maildrop-name) "-width" (window-width) "-truncate") (mh-exec-cmd-output mh-inc-prog nil "-width" (window-width))) (message (if maildrop-name (format "inc %s -file %s...done" folder maildrop-name) (format "inc %s...done" folder))) (goto-char start-of-inc) (cond ((save-excursion (re-search-forward "^inc: no mail" nil t)) (message "No new mail%s%s" (if maildrop-name " in " "") (if maildrop-name maildrop-name ""))) ((re-search-forward "^inc:" nil t) ; Error messages (error "inc error")) (t (mh-remove-cur-notation) (setq new-mail-p t))) (keep-lines mh-valid-scan-line) ; Flush random scan lines (setq mh-seq-list (mh-read-folder-sequences folder t)) (mh-notate-user-sequences) (if new-mail-p (progn (mh-make-folder-mode-line) (mh-goto-cur-msg)) (goto-char point-before-inc)))))) (defun mh-make-folder-mode-line (&optional ignored) ;; Set the fields of the mode line for a folder buffer. ;; The optional argument is now obsolete. It used to be used to pass ;; in what is now stored in the buffer-local variable ;; mh-mode-line-annotation. (save-excursion (mh-first-msg) (setq mh-first-msg-num (mh-get-msg-num nil)) (mh-last-msg) (setq mh-last-msg-num (mh-get-msg-num nil)) (setq mh-msg-count (count-lines (point-min) (point-max))) (setq mode-line-buffer-identification (list (format "{%%b%s} %d msg%s" (if mh-mode-line-annotation (format "/%s" mh-mode-line-annotation) "") mh-msg-count (if (zerop mh-msg-count) "s" (if (> mh-msg-count 1) (format "s (%d-%d)" mh-first-msg-num mh-last-msg-num) (format " (%d)" mh-first-msg-num)))))))) (defun mh-unmark-all-headers (remove-all-flags) ;; Remove all '+' flags from the headers, and if called with a non-nil ;; argument, remove all 'D', '^' and '%' flags too. ;; Optimized for speed (i.e., no regular expressions). (save-excursion (let ((case-fold-search nil) (last-line (1- (point-max))) char) (mh-first-msg) (while (<= (point) last-line) (forward-char mh-cmd-note) (setq char (following-char)) (if (or (and remove-all-flags (or (eql char (aref mh-note-deleted 0)) (eql char (aref mh-note-refiled 0)))) (eql char (aref mh-note-cur 0))) (progn (delete-char 1) (insert " "))) (if remove-all-flags (progn (forward-char 1) (if (eql (following-char) (aref mh-note-seq 0)) (progn (delete-char 1) (insert " "))))) (forward-line))))) (defun mh-remove-cur-notation () ;; Remove old cur notation (cf mh-goto-cur-msg code). (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) (save-excursion (and cur-msg (mh-goto-msg cur-msg t t) (looking-at mh-cur-scan-msg-regexp) (mh-notate nil ? mh-cmd-note))))) (defun mh-goto-cur-msg () ;; Position the cursor at the current message. (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) (cond ((and cur-msg (mh-goto-msg cur-msg t t)) (mh-notate nil mh-note-cur mh-cmd-note) (mh-recenter 0) (mh-maybe-show cur-msg)) (t (mh-last-msg) (message "No current message"))))) (defun mh-process-or-undo-commands (folder) ;; If FOLDER has outstanding commands, then either process or discard them. ;; Called by functions like mh-sort-folder, so also invalidate show buffer. (set-buffer folder) (if (mh-outstanding-commands-p) (if (or mh-do-not-confirm (y-or-n-p "Process outstanding deletes and refiles (or lose them)? ")) (mh-process-commands folder) (mh-undo-folder))) (mh-update-unseen) (mh-invalidate-show-buffer)) (defun mh-process-commands (folder) ;; Process outstanding commands for the folder FOLDER. (message "Processing deletes and refiles for %s..." folder) (set-buffer folder) (with-mh-folder-updating (nil) ;; Update the unseen sequence if it exists (mh-update-unseen) ;; Then refile messages (mh-mapc (function (lambda (dest) (let ((msgs (mh-seq-to-msgs dest))) (cond (msgs (apply 'mh-exec-cmd "refile" "-src" folder (symbol-name dest) (mh-coalesce-msg-list msgs)) (mh-delete-scan-msgs msgs)))))) mh-refile-list) (setq mh-refile-list nil) ;; Now delete messages (cond (mh-delete-list (apply 'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list mh-delete-list)) (mh-delete-scan-msgs mh-delete-list) (setq mh-delete-list nil))) ;; Don't need to remove sequences since delete and refile do so. ;; Mark cur message (if (> (buffer-size) 0) (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last")))) (and (buffer-file-name (get-buffer mh-show-buffer)) (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer)))) ;; If "inc" were to put a new msg in this file, ;; we would not notice, so mark it invalid now. (mh-invalidate-show-buffer)) (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil)) (mh-unmark-all-headers t) (mh-notate-user-sequences) (message "Processing deletes and refiles for %s...done" folder))) (defun mh-update-unseen () ;; Flush updates to the Unseen sequence out to MH. ;; Return non-NIL iff set the MH folder. (if mh-seen-list (let* ((unseen-seq (mh-find-seq mh-unseen-seq)) (unseen-msgs (mh-seq-msgs unseen-seq))) (if unseen-msgs (progn (mh-undefine-sequence mh-unseen-seq mh-seen-list) (while mh-seen-list (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs)) (setq mh-seen-list (cdr mh-seen-list))) (setcdr unseen-seq unseen-msgs) t) ;since we set the folder (setq mh-seen-list nil))))) (defun mh-delete-scan-msgs (msgs) ;; Delete the scan listing lines for each of the msgs in the LIST. (save-excursion (while msgs (if (mh-goto-msg (car msgs) t t) (mh-delete-line 1)) (setq msgs (cdr msgs))))) (defun mh-outstanding-commands-p () ;; Returns non-nil if there are outstanding deletes or refiles. (or mh-delete-list mh-refile-list)) (defun mh-coalesce-msg-list (messages) ;; Give a list of MESSAGES, return a list of message number ranges. ;; Sort of the opposite of mh-read-msg-list, which expands ranges. ;; Message lists passed to MH programs go through this so ;; command line arguments won't exceed system limits. (let ((msgs (sort (copy-sequence messages) 'mh-greaterp)) (range-high nil) (prev -1) (ranges nil)) (while prev (if range-high (if (or (not (numberp prev)) (not (eql (car msgs) (1- prev)))) (progn ;non-sequential, flush old range (if (eql prev range-high) (setq ranges (cons range-high ranges)) (setq ranges (cons (format "%s-%s" prev range-high) ranges))) (setq range-high nil)))) (or range-high (setq range-high (car msgs))) ;start new or first range (setq prev (car msgs)) (setq msgs (cdr msgs))) ranges)) (defun mh-greaterp (msg1 msg2) ;; Sort two message indicators. Strings are "smaller" than numbers. ;; Legal values are things like "cur", "last", 1, and 1820. (if (numberp msg1) (if (numberp msg2) (> msg1 msg2) t) (if (numberp msg2) nil (string-lessp msg2 msg1)))) ;;; Basic sequence handling (defun mh-delete-seq-locally (seq) ;; Remove mh-e's record of SEQUENCE. (let ((entry (mh-find-seq seq))) (setq mh-seq-list (delq entry mh-seq-list)))) (defun mh-read-folder-sequences (folder save-refiles) ;; Read and return the predefined sequences for a FOLDER. ;; If SAVE-REFILES is non-nil, then keep the sequences ;; that note messages to be refiled. (let ((seqs ())) (cond (save-refiles (mh-mapc (function (lambda (seq) ; Save the refiling sequences (if (mh-folder-name-p (mh-seq-name seq)) (setq seqs (cons seq seqs))))) mh-seq-list))) (save-excursion (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list")) (progn ;; look for name in line of form "cur: 4" or "myseq (private): 23" (while (re-search-forward "^[^: ]+" nil t) (setq seqs (cons (mh-make-seq (intern (buffer-substring (match-beginning 0) (match-end 0))) (mh-read-msg-list)) seqs))) (delete-region (point-min) (point))))) ; avoid race with mh-process-daemon seqs)) (defun mh-read-msg-list () ;; Return a list of message numbers from the current point to the end of ;; the line. Expands ranges into set of individual numbers. (let ((msgs ()) (end-of-line (save-excursion (end-of-line) (point))) num) (while (re-search-forward "[0-9]+" end-of-line t) (setq num (string-to-int (buffer-substring (match-beginning 0) (match-end 0)))) (cond ((looking-at "-") ; Message range (forward-char 1) (re-search-forward "[0-9]+" end-of-line t) (let ((num2 (string-to-int (buffer-substring (match-beginning 0) (match-end 0))))) (if (< num2 num) (error "Bad message range: %d-%d" num num2)) (while (<= num num2) (setq msgs (cons num msgs)) (setq num (1+ num))))) ((not (zerop num)) ;"pick" outputs "0" to mean no match (setq msgs (cons num msgs))))) msgs)) (defun mh-notate-user-sequences () ;; Mark the scan listing of all messages in user-defined sequences. (let ((seqs mh-seq-list) name) (while seqs (setq name (mh-seq-name (car seqs))) (if (not (mh-internal-seq name)) (mh-notate-seq name mh-note-seq (1+ mh-cmd-note))) (setq seqs (cdr seqs))))) (defun mh-internal-seq (name) ;; Return non-NIL if NAME is the name of an internal mh-e sequence. (or (memq name '(answered cur deleted forwarded printed)) (eq name mh-unseen-seq) (eq name mh-previous-seq) (mh-folder-name-p name))) (defun mh-delete-msg-from-seq (message sequence &optional internal-flag) "Delete MESSAGE from SEQUENCE. MESSAGE defaults to displayed message. From Lisp, optional third arg INTERNAL-FLAG non-nil means do not inform MH of the change." (interactive (list (mh-get-msg-num t) (mh-read-seq-default "Delete from" t) nil)) (let ((entry (mh-find-seq sequence))) (cond (entry (mh-notate-if-in-one-seq message ? (1+ mh-cmd-note) sequence) (if (not internal-flag) (mh-undefine-sequence sequence (list message))) (setcdr entry (delq message (mh-seq-msgs entry))))))) (defun mh-undefine-sequence (seq msgs) ;; Remove from the SEQUENCE the list of MSGS. (mh-exec-cmd "mark" mh-current-folder "-delete" "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))) (defun mh-define-sequence (seq msgs) ;; Define the SEQUENCE to contain the list of MSGS. ;; Do not mark pseudo-sequences or empty sequences. ;; Signals an error if SEQUENCE is an illegal name. (if (and msgs (not (mh-folder-name-p seq))) (save-excursion (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero" "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))) (defun mh-map-over-seqs (func seq-list) ;; Apply the FUNCTION to each element in the list of SEQUENCES, ;; passing the sequence name and the list of messages as arguments. (while seq-list (funcall func (mh-seq-name (car seq-list)) (mh-seq-msgs (car seq-list))) (setq seq-list (cdr seq-list)))) (defun mh-notate-if-in-one-seq (msg notation offset seq) ;; If the MESSAGE is in only the SEQUENCE, then mark the scan listing of the ;; message with the CHARACTER at the given OFFSET from the beginning of the ;; listing line. (let ((in-seqs (mh-seq-containing-msg msg nil))) (if (and (eq seq (car in-seqs)) (null (cdr in-seqs))) (mh-notate msg notation offset)))) (defun mh-seq-containing-msg (msg &optional include-internal-p) ;; Return a list of the sequences containing MESSAGE. ;; If INCLUDE-INTERNAL-P non-nil, include mh-e internal sequences in list. (let ((l mh-seq-list) (seqs ())) (while l (and (memq msg (mh-seq-msgs (car l))) (or include-internal-p (not (mh-internal-seq (mh-seq-name (car l))))) (setq seqs (cons (mh-seq-name (car l)) seqs))) (setq l (cdr l))) seqs)) ;;; User prompting commands. (defun mh-read-msg-range (prompt) ;; Read a list of blank-separated items. (let* ((buf (read-string prompt)) (buf-size (length buf)) (start 0) (input ())) (while (< start buf-size) (let ((next (read-from-string buf start buf-size))) (setq input (cons (car next) input)) (setq start (cdr next)))) (nreverse input))) ;;; Build the folder-mode keymap: (suppress-keymap mh-folder-mode-map) (define-key mh-folder-mode-map "q" 'mh-quit) (define-key mh-folder-mode-map "b" 'mh-compat-quit) (define-key mh-folder-mode-map "?" 'mh-msg-is-in-seq) (define-key mh-folder-mode-map "%" 'mh-put-msg-in-seq) (define-key mh-folder-mode-map "|" 'mh-pipe-msg) (define-key mh-folder-mode-map "\ea" 'mh-edit-again) (define-key mh-folder-mode-map "\e%" 'mh-delete-msg-from-seq) (define-key mh-folder-mode-map "\e#" 'mh-delete-seq) (define-key mh-folder-mode-map "\C-xn" 'mh-narrow-to-seq) (define-key mh-folder-mode-map "\C-xw" 'mh-widen) (define-key mh-folder-mode-map "\eb" 'mh-burst-digest) (define-key mh-folder-mode-map "\eu" 'mh-undo-folder) (define-key mh-folder-mode-map "\e " 'mh-page-digest) (define-key mh-folder-mode-map "\e\177" 'mh-page-digest-backwards) (define-key mh-folder-mode-map "\ed" 'mh-redistribute) (define-key mh-folder-mode-map "\ee" 'mh-extract-rejected-mail) (define-key mh-folder-mode-map "\ef" 'mh-visit-folder) (define-key mh-folder-mode-map "\ek" 'mh-kill-folder) (define-key mh-folder-mode-map "\el" 'mh-list-folders) (define-key mh-folder-mode-map "\en" 'mh-store-msg) (define-key mh-folder-mode-map "\ep" 'mh-pack-folder) (define-key mh-folder-mode-map "\eq" 'mh-list-sequences) (define-key mh-folder-mode-map "\es" 'mh-search-folder) (define-key mh-folder-mode-map "\er" 'mh-rescan-folder) (define-key mh-folder-mode-map "l" 'mh-print-msg) (define-key mh-folder-mode-map "t" 'mh-toggle-showing) (define-key mh-folder-mode-map "c" 'mh-copy-msg) (define-key mh-folder-mode-map "i" 'mh-inc-folder) (define-key mh-folder-mode-map "x" 'mh-execute-commands) (define-key mh-folder-mode-map "e" 'mh-execute-commands) (define-key mh-folder-mode-map "f" 'mh-forward) (define-key mh-folder-mode-map "m" 'mh-send) (define-key mh-folder-mode-map "s" 'mh-send) (define-key mh-folder-mode-map "r" 'mh-reply) (define-key mh-folder-mode-map "a" 'mh-reply) (define-key mh-folder-mode-map "j" 'mh-goto-msg) (define-key mh-folder-mode-map "g" 'mh-goto-msg) (define-key mh-folder-mode-map "\e<" 'mh-first-msg) (define-key mh-folder-mode-map "\e>" 'mh-last-msg) (define-key mh-folder-mode-map "\177" 'mh-previous-page) (define-key mh-folder-mode-map " " 'mh-page-msg) (define-key mh-folder-mode-map "\r" 'mh-show) (define-key mh-folder-mode-map "." 'mh-show) (define-key mh-folder-mode-map "," 'mh-header-display) (define-key mh-folder-mode-map "u" 'mh-undo) (define-key mh-folder-mode-map "d" 'mh-delete-msg) (define-key mh-folder-mode-map "\C-d" 'mh-delete-msg-no-motion) (define-key mh-folder-mode-map "p" 'mh-previous-undeleted-msg) (define-key mh-folder-mode-map "n" 'mh-next-undeleted-msg) (define-key mh-folder-mode-map "o" 'mh-refile-msg) (define-key mh-folder-mode-map "^" 'mh-refile-msg) (define-key mh-folder-mode-map "\C-o" 'mh-write-msg-to-file) (define-key mh-folder-mode-map ">" 'mh-write-msg-to-file) (define-key mh-folder-mode-map "!" 'mh-refile-or-write-again) ;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt ;;;autoload the other mh-e parts ;;; mh-comp (autoload 'mh-smail "mh-comp" "Compose and send mail with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. See documentation of `\\[mh-send]' for more details on composing mail." t) (autoload 'mh-smail-other-window "mh-comp" "Compose and send mail in other window with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. See documentation of `\\[mh-send]' for more details on composing mail." t) (autoload 'mh-edit-again "mh-comp" "Clean-up a draft or a message previously sent and make it resendable. Default is the current message. The variable mh-new-draft-cleaned-headers specifies the headers to remove. See also documentation for `\\[mh-send]' function." t) (autoload 'mh-extract-rejected-mail "mh-comp" "Extract a letter returned by the mail system and make it resendable. Default is the current message. The variable mh-new-draft-cleaned-headers gives the headers to clean out of the original message. See also documentation for `\\[mh-send]' function." t) (autoload 'mh-forward "mh-comp" "Forward a message or message sequence. Defaults to displayed message. If optional prefix argument provided, then prompt for the message sequence. See also documentation for `\\[mh-send]' function." t) (autoload 'mh-redistribute "mh-comp" "Redistribute a letter. Depending on how your copy of MH was compiled, you may need to change the setting of the variable mh-redist-full-contents. See its documentation." t) (autoload 'mh-reply "mh-comp" "Reply to a MESSAGE (default: displayed message). If optional prefix argument INCLUDEP provided, then include the message in the reply using filter mhl.reply in your MH directory. Prompts for type of addresses to reply to: from sender only, to sender and primary recipients, cc/all sender and all recipients. If the file named by `mh-repl-formfile' exists, it is used as a skeleton for the reply. See also documentation for `\\[mh-send]' function." t) (autoload 'mh-send "mh-comp" "Compose and send a letter. The file named by `mh-comp-formfile' will be used as the form. Do not call this function from outside mh-e; use \\[mh-smail] instead. The letter is composed in mh-letter-mode; see its documentation for more details. If `mh-compose-letter-function' is defined, it is called on the draft and passed three arguments: to, subject, and cc." t) (autoload 'mh-send-other-window "mh-comp" "Compose and send a letter in another window. Do not call this function from outside mh-e; use \\[mh-smail-other-window] instead. See also documentation for `\\[mh-send]' function." t) (autoload 'mh-letter-mode "mh-comp" "Mode for composing letters in mh-e. For more details, type \\[describe-mode] while in MH-Letter mode." t) ;;; mh-funcs (autoload 'mh-burst-digest "mh-funcs" "Burst apart the current message, which should be a digest. The message is replaced by its table of contents and the messages from the digest are inserted into the folder after that message." t) (autoload 'mh-copy-msg "mh-funcs" "Copy to another FOLDER the specified MESSAGE(s) without deleting them. Default is the displayed message. If optional prefix argument is provided, then prompt for the message sequence." t) (autoload 'mh-kill-folder "mh-funcs" "Remove the current folder." t) (autoload 'mh-list-folders "mh-funcs" "List mail folders." t) (autoload 'mh-pack-folder "mh-funcs" "Renumber the messages of a folder to be 1..n. First, offer to execute any outstanding commands for the current folder. If optional prefix argument provided, prompt for the range of messages to display after packing. Otherwise, show the entire folder." t) (autoload 'mh-pipe-msg "mh-funcs" "Pipe the current message through the given shell COMMAND. If INCLUDE-HEADERS (prefix argument) is provided, send the entire message. Otherwise just send the message's body without the headers." t) (autoload 'mh-page-digest "mh-funcs" "Advance displayed message to next digested message." t) (autoload 'mh-page-digest-backwards "mh-funcs" "Back up displayed message to previous digested message." t) (autoload 'mh-print-msg "mh-funcs" "Print MESSAGE(s) (default: displayed message) on printer. If optional prefix argument provided, then prompt for the message sequence. The variable mh-lpr-command-format is used to generate the print command. The messages are formatted by mhl. See the variable mhl-formfile." t) (autoload 'mh-sort-folder "mh-funcs" "Sort the messages in the current folder by date. Calls the MH program sortm to do the work. The arguments in the list mh-sortm-args are passed to sortm if this function is passed an argument." t) (autoload 'mh-undo-folder "mh-funcs" "Undo all commands in current folder." t) (autoload 'mh-store-msg "mh-funcs" "Store the file(s) contained in the current message into DIRECTORY. The message can contain a shar file or uuencoded file. Default directory is the last directory used, or initially the value of mh-store-default-directory or the current directory." t) (autoload 'mh-store-buffer "mh-funcs" "Store the file(s) contained in the current buffer into DIRECTORY. The buffer can contain a shar file or uuencoded file. Default directory is the last directory used, or initially the value of `mh-store-default-directory' or the current directory." t) ;;; mh-pick (autoload 'mh-search-folder "mh-pick" "Search FOLDER for messages matching a pattern. Add the messages found to the sequence named `search'." t) ;;; mh-seq (autoload 'mh-delete-seq "mh-seq" "Delete the SEQUENCE." t) (autoload 'mh-list-sequences "mh-seq" "List the sequences defined in FOLDER." t) (autoload 'mh-msg-is-in-seq "mh-seq" "Display the sequences that contain MESSAGE (default: displayed message)." t) (autoload 'mh-narrow-to-seq "mh-seq" "Restrict display of this folder to just messages in SEQUENCE Use \\[mh-widen] to undo this command." t) (autoload 'mh-put-msg-in-seq "mh-seq" "Add MESSAGE(s) (default: displayed message) to SEQUENCE. If optional prefix argument provided, then prompt for the message sequence." t) (autoload 'mh-widen "mh-seq" "Remove restrictions from current folder, thereby showing all messages." t) (autoload 'mh-rename-seq "mh-seq" "Rename SEQUENCE to have NEW-NAME." t) ;;; mh-e.el ends here emacs-19.30/lisp/mh-funcs.el100444 75424 1 31431 6046277224 14346 0ustar kwzhdaemon;;; mh-funcs --- mh-e functions not everyone will use right away ;; Time-stamp: <95/08/19 16:44:06 gildea> ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. ;; This file is part of mh-e, 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: ;;; Internal support for mh-e package. ;;; Putting these functions in a separate file lets mh-e start up faster, ;;; since less Lisp code needs to be loaded all at once. ;;; Change Log: ;; $Id: mh-funcs.el,v 1.4 1995/11/03 02:29:34 kwzh Exp $ ;;; Code: (provide 'mh-funcs) (require 'mh-e) ;;; customization (defvar mh-sortm-args nil "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command. The arguments are passed to sortm if \\[mh-sort-folder] is given a prefix argument. Normally default arguments to sortm are specified in the MH profile. For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.") (defvar mh-note-copied "C" "String whose first character is used to notate copied messages.") (defvar mh-note-printed "P" "String whose first character is used to notate printed messages.") ;;; functions (defun mh-burst-digest () "Burst apart the current message, which should be a digest. The message is replaced by its table of contents and the messages from the digest are inserted into the folder after that message." (interactive) (let ((digest (mh-get-msg-num t))) (mh-process-or-undo-commands mh-current-folder) (mh-set-folder-modified-p t) ; lock folder while bursting (message "Bursting digest...") (mh-exec-cmd "burst" mh-current-folder digest "-inplace") (with-mh-folder-updating (t) (beginning-of-line) (delete-region (point) (point-max))) (mh-regenerate-headers (format "%d-last" digest) t) (mh-goto-cur-msg) (message "Bursting digest...done"))) (defun mh-copy-msg (msg-or-seq folder) "Copy the specified MESSAGE(s) to another FOLDER without deleting them. Default is the displayed message. If optional prefix argument is provided, then prompt for the message sequence." (interactive (list (if current-prefix-arg (mh-read-seq-default "Copy" t) (mh-get-msg-num t)) (mh-prompt-for-folder "Copy to" "" t))) (mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder folder) (if (numberp msg-or-seq) (mh-notate msg-or-seq mh-note-copied mh-cmd-note) (mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note))) (defun mh-kill-folder () "Remove the current folder." (interactive) (if (or mh-do-not-confirm (yes-or-no-p (format "Remove folder %s? " mh-current-folder))) (let ((folder mh-current-folder)) (if (null mh-folder-list) (mh-set-folder-list)) (mh-set-folder-modified-p t) ; lock folder to kill it (mh-exec-cmd-daemon "rmf" folder) (setq mh-folder-list (delq (assoc folder mh-folder-list) mh-folder-list)) (run-hooks 'mh-folder-list-change-hook) (message "Folder %s removed" folder) (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain (if (get-buffer mh-show-buffer) (kill-buffer mh-show-buffer)) (kill-buffer folder)) (message "Folder not removed"))) (defun mh-list-folders () "List mail folders." (interactive) (with-output-to-temp-buffer mh-temp-buffer (save-excursion (switch-to-buffer mh-temp-buffer) (erase-buffer) (message "Listing folders...") (mh-exec-cmd-output "folders" t (if mh-recursive-folders "-recurse" "-norecurse")) (goto-char (point-min)) (message "Listing folders...done")))) (defun mh-pack-folder (range) "Renumber the messages of a folder to be 1..n. First, offer to execute any outstanding commands for the current folder. If optional prefix argument provided, prompt for the RANGE of messages to display after packing. Otherwise, show the entire folder." (interactive (list (if current-prefix-arg (mh-read-msg-range "Range to scan after packing [all]? ") "all"))) (mh-pack-folder-1 range) (mh-goto-cur-msg) (message "Packing folder...done")) (defun mh-pack-folder-1 (range) ;; Close and pack the current folder. (mh-process-or-undo-commands mh-current-folder) (message "Packing folder...") (mh-set-folder-modified-p t) ; lock folder while packing (save-excursion (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack" "-norecurse" "-fast")) (mh-regenerate-headers range)) (defun mh-pipe-msg (command include-headers) "Pipe the current message through the given shell COMMAND. If INCLUDE-HEADERS (prefix argument) is provided, send the entire message. Otherwise just send the message's body without the headers." (interactive (list (read-string "Shell command on message: ") current-prefix-arg)) (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t))) (message-directory default-directory)) (save-excursion (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) (insert-file-contents msg-file-to-pipe) (goto-char (point-min)) (if (not include-headers) (search-forward "\n\n")) (let ((default-directory message-directory)) (shell-command-on-region (point) (point-max) command nil))))) (defun mh-page-digest () "Advance displayed message to next digested message." (interactive) (mh-in-show-buffer (mh-show-buffer) ;; Go to top of screen (in case user moved point). (move-to-window-line 0) (let ((case-fold-search nil)) ;; Search for blank line and then for From: (or (and (search-forward "\n\n" nil t) (re-search-forward "^From:" nil t)) (error "No more messages in digest"))) ;; Go back to previous blank line, then forward to the first non-blank. (search-backward "\n\n" nil t) (forward-line 2) (mh-recenter 0))) (defun mh-page-digest-backwards () "Back up displayed message to previous digested message." (interactive) (mh-in-show-buffer (mh-show-buffer) ;; Go to top of screen (in case user moved point). (move-to-window-line 0) (let ((case-fold-search nil)) (beginning-of-line) (or (and (search-backward "\n\n" nil t) (re-search-backward "^From:" nil t)) (error "No previous message in digest"))) ;; Go back to previous blank line, then forward to the first non-blank. (if (search-backward "\n\n" nil t) (forward-line 2)) (mh-recenter 0))) (defun mh-print-msg (msg-or-seq) "Print MESSAGE(s) (default: displayed message) on printer. If optional prefix argument provided, then prompt for the message sequence. The variable mh-lpr-command-format is used to generate the print command. The messages are formatted by mhl. See the variable mhl-formfile." (interactive (list (if current-prefix-arg (reverse (mh-seq-to-msgs (mh-read-seq-default "Print" t))) (mh-get-msg-num t)))) (if (numberp msg-or-seq) (message "Printing message...") (message "Printing sequence...")) (let ((print-command (if (numberp msg-or-seq) (format "%s -nobell -clear %s %s | %s" (expand-file-name "mhl" mh-lib) (mh-msg-filename msg-or-seq) (if (stringp mhl-formfile) (format "-form %s" mhl-formfile) "") (format mh-lpr-command-format (if (numberp msg-or-seq) (format "%s/%d" mh-current-folder msg-or-seq) (format "Sequence from %s" mh-current-folder)))) (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s" (mapconcat (function (lambda (msg) msg)) msg-or-seq " ") (expand-file-name "mhl" mh-lib) (if (stringp mhl-formfile) (format "-form %s" mhl-formfile) "") (mh-msg-filenames msg-or-seq) (format mh-lpr-command-format (if (numberp msg-or-seq) (format "%s/%d" mh-current-folder msg-or-seq) (format "Sequence from %s" mh-current-folder))))))) (if mh-print-background (mh-exec-cmd-daemon shell-file-name "-c" print-command) (call-process shell-file-name nil nil nil "-c" print-command)) (if (numberp msg-or-seq) (mh-notate msg-or-seq mh-note-printed mh-cmd-note) (mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note)) (mh-add-msgs-to-seq msg-or-seq 'printed t) (if (numberp msg-or-seq) (message "Printing message...done") (message "Printing sequence...done")))) (defun mh-msg-filenames (msgs &optional folder) ;; Return a list of file names for MSGS in FOLDER (default current folder). (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " ")) (defun mh-sort-folder (&optional extra-args) "Sort the messages in the current folder by date. Calls the MH program sortm to do the work. The arguments in the list mh-sortm-args are passed to sortm if this function is passed an argument." (interactive "P") (mh-process-or-undo-commands mh-current-folder) (setq mh-next-direction 'forward) (mh-set-folder-modified-p t) ; lock folder while sorting (message "Sorting folder...") (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args)) (message "Sorting folder...done") (mh-scan-folder mh-current-folder "all")) (defun mh-undo-folder (&rest ignore) "Undo all pending deletes and refiles in current folder." (interactive) (cond ((or mh-do-not-confirm (yes-or-no-p "Undo all commands in folder? ")) (setq mh-delete-list nil mh-refile-list nil mh-seq-list nil mh-next-direction 'forward) (with-mh-folder-updating (nil) (mh-unmark-all-headers t))) (t (message "Commands not undone.") (sit-for 2)))) (defun mh-store-msg (directory) "Store the file(s) contained in the current message into DIRECTORY. The message can contain a shar file or uuencoded file. Default directory is the last directory used, or initially the value of mh-store-default-directory or the current directory." (interactive (list (let ((udir (or mh-store-default-directory default-directory))) (read-file-name "Store message in directory: " udir udir nil)))) (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t)))) (save-excursion (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) (insert-file-contents msg-file-to-store) (mh-store-buffer directory)))) (defun mh-store-buffer (directory) "Store the file(s) contained in the current buffer into DIRECTORY. The buffer can contain a shar file or uuencoded file. Default directory is the last directory used, or initially the value of `mh-store-default-directory' or the current directory." (interactive (list (let ((udir (or mh-store-default-directory default-directory))) (read-file-name "Store buffer in directory: " udir udir nil)))) (let ((store-directory (expand-file-name directory)) (sh-start (save-excursion (goto-char (point-min)) (if (re-search-forward "^#![ \t]*/bin/sh\\|^#\\|^: " nil t) (progn ;; The "cut here" pattern was removed from above ;; because it seemed to hurt more than help. ;; But keep this to make it easier to put it back. (if (looking-at "^[^a-z0-9\"]*cut here\\b") (forward-line 1)) (beginning-of-line) (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$") nil ;most likely end of a uuencode (point)))))) (log-buffer (get-buffer-create "*Store Output*")) (command "sh") (uudecode-filename "(unknown filename)")) (if (not sh-start) (save-excursion (goto-char (point-min)) (if (re-search-forward "^begin [0-7]+ " nil t) (setq uudecode-filename (buffer-substring (point) (progn (end-of-line) (point))))))) (save-excursion (set-buffer log-buffer) (erase-buffer) (if (not (file-directory-p store-directory)) (progn (insert "mkdir " directory "\n") (call-process "mkdir" nil log-buffer t store-directory))) (insert "cd " directory "\n") (setq mh-store-default-directory directory) (if (not sh-start) (progn (setq command "uudecode") (insert uudecode-filename " being uudecoded...\n")))) (set-window-start (display-buffer log-buffer) 0) ;watch progress (let (value) (let ((default-directory (file-name-as-directory store-directory))) (setq value (call-process-region sh-start (point-max) command nil log-buffer t))) (set-buffer log-buffer) (mh-handle-process-error command value)) (insert "\n(mh-store finished)\n"))) emacs-19.30/lisp/mh-mime.el100444 75424 1 20766 6046277243 14171 0ustar kwzhdaemon;;; mh-mime --- mh-e support for composing MIME messages ;; Time-stamp: <95/08/19 16:45:17 gildea> ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. ;; This file is part of mh-e, 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: ;;; Internal support for mh-e package. ;;; Support for generating an mhn composition file. ;;; MIME is supported only by MH 6.8 or later. ;;; Change Log: ;; $Id: mh-mime.el,v 1.5 1995/11/03 02:29:49 kwzh Exp $ ;;; Code: (provide 'mh-mime) (require 'mh-comp) ;; To do: ;; paragraph code should not fill # lines if MIME enabled. ;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter] ;; invokes mh-edit-mhn automatically before sending.) ;; actually, instead of mh-auto-edit-mhn, ;; should read automhnproc from profile ;; MIME option to mh-forward ;; command to move to content-description insertion point (defvar mh-mhn-args nil "Extra arguments to have \\[mh-edit-mhn] pass to the \"mhn\" command. The arguments are passed to mhn if \\[mh-edit-mhn] is given a prefix argument. Normally default arguments to mhn are specified in the MH profile.") (defvar mh-edit-mhn-hook nil "Invoked on the formatted letter by \\\\[mh-edit-mhn].") ;;;###autoload (defvar mh-mime-content-types '(("text/plain") ("text/richtext") ("multipart/mixed") ("multipart/alternative") ("multipart/digest") ("multipart/parallel") ("message/rfc822") ("message/partial") ("message/external-body") ("application/octet-stream") ("application/postscript") ("image/jpeg") ("image/gif") ("audio/basic") ("video/mpeg")) "Legal MIME content types. See documentation for \\[mh-edit-mhn].") (defun mh-mhn-compose-insertion (pathname type description) "Add a directive to insert a MIME message part from a file. This is the typical way to insert non-text parts in a message. Arguments are PATHNAME, which tells where to find the file, TYPE, the MIME content type, and DESCRIPTION, a line of text for the Content-description header. See also \\[mh-edit-mhn]." (interactive (list (read-file-name "Insert contents of: ") (completing-read "Content-type: " mh-mime-content-types nil nil nil) (read-string "Content-description: "))) (mh-mhn-compose-type pathname type description)) (defun mh-mhn-compose-type (pathname type &optional description attributes comment) (beginning-of-line) (insert "#" type) (and attributes (insert "; " attributes)) (and comment (insert " (" comment ")")) (insert " [") (and description (insert description)) (insert "] " (expand-file-name pathname)) (insert "\n")) (defun mh-mhn-compose-anon-ftp (host pathname type description) "Add a directive for a MIME anonymous ftp external body part. This directive tells MH to include a reference to a message/external-body part retrievable by anonymous FTP. Arguments are HOST and PATHNAME, which tell where to find the file, TYPE, the MIME content type, and DESCRIPTION, a line of text for the Content-description header. See also \\[mh-edit-mhn]." (interactive (list (read-string "Remote host: ") (read-string "Remote pathname: ") (completing-read "External Content-type: " mh-mime-content-types nil nil nil) (read-string "External Content-description: "))) (mh-mhn-compose-external-type "anon-ftp" host pathname type description)) (defun mh-mhn-compose-external-compressed-tar (host pathname description) "Add a directive to include a MIME reference to a compressed tar file. The file should be available via anonymous ftp. This directive tells MH to include a reference to a message/external-body part. Arguments are HOST and PATHNAME, which tell where to find the file, and DESCRIPTION, a line of text for the Content-description header. See also \\[mh-edit-mhn]." (interactive (list (read-string "Remote host: ") (read-string "Remote pathname: ") (read-string "Tar file Content-description: "))) (mh-mhn-compose-external-type "anon-ftp" host pathname "application/octet-stream" description "type=tar; conversions=x-compress" "mode=image")) (defun mh-mhn-compose-external-type (access-type host pathname type &optional description attributes extra-params comment) (beginning-of-line) (insert "#@" type) (and attributes (insert "; " attributes)) (and comment (insert " (" comment ") ")) (insert " [") (and description (insert description)) (insert "] ") (insert "access-type=" access-type "; ") (insert "site=" host) (insert "; name=" (file-name-nondirectory pathname)) (insert "; directory=\"" (file-name-directory pathname) "\"") (and extra-params (insert "; " extra-params)) (insert "\n")) (defun mh-mhn-compose-forw (&optional description folder messages) "Add a forw directive to this message, to forward a message with MIME. This directive tells MH to include the named messages in this one. Arguments are DESCRIPTION, a line of text for the Content-description header, and FOLDER and MESSAGES, which name the message(s) to be forwarded. See also \\[mh-edit-mhn]." (interactive (list (read-string "Forw Content-description: ") (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) (read-string (format "Messages%s: " (if mh-sent-from-msg (format " [%d]" mh-sent-from-msg) ""))))) (beginning-of-line) (insert "#forw [") (and description (not (string= description "")) (insert description)) (insert "]") (and folder (not (string= folder "")) (insert " " folder)) (if (and messages (not (string= messages ""))) (let ((start (point))) (insert " " messages) (subst-char-in-region start (point) ?, ? )) (if mh-sent-from-msg (insert " " (int-to-string mh-sent-from-msg)))) (insert "\n")) (defun mh-edit-mhn (&optional extra-args) "Format the current draft for MIME, expanding any mhn directives. Process the current draft with the mhn program, which, using directives already inserted in the draft, fills in all the MIME components and header fields. This step should be done last just before sending the message. The mhn program is part of MH version 6.8 or later. The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the list `mh-mhn-args' are passed to mhn if this function is passed an argument. For assistance with creating mhn directives to insert various types of components in a message, see \\[mh-mhn-compose-insertion] (generic insertion from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward message)." (interactive "*P") (save-buffer) (message "mhn editing...") (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name) "mhn" (if extra-args mh-mhn-args) buffer-file-name) (revert-buffer t t) (message "mhn editing...done") (run-hooks 'mh-edit-mhn-hook)) (defun mh-revert-mhn-edit (noconfirm) "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file. Optional non-nil argument means don't ask for confirmation." (interactive "*P") (if (null buffer-file-name) (error "Buffer does not seem to be associated with any file")) (let ((backup-strings '("," "#")) backup-file) (while (and backup-strings (not (file-exists-p (setq backup-file (concat (file-name-directory buffer-file-name) (car backup-strings) (file-name-nondirectory buffer-file-name) ".orig"))))) (setq backup-strings (cdr backup-strings))) (or backup-strings (error "mhn backup file for %s no longer exists!" buffer-file-name)) (or noconfirm (yes-or-no-p (format "Revert buffer from file %s? " backup-file)) (error "mhn edit revert not confirmed.")) (let ((buffer-read-only nil)) (erase-buffer) (insert-file-contents backup-file)) (after-find-file nil))) emacs-19.30/lisp/mh-pick.el100444 75424 1 14760 6046277266 14172 0ustar kwzhdaemon;;; mh-pick --- make a search pattern and search for a message in mh-e ;; Time-stamp: <95/08/19 16:45:16 gildea> ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. ;; This file is part of mh-e, 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: ;; Internal support for mh-e package. ;;; Change Log: ;; $Id: mh-pick.el,v 1.4 1995/11/03 02:30:09 kwzh Exp $ ;;; Code: (provide 'mh-pick) (require 'mh-e) (defvar mh-pick-mode-hook nil "Invoked in `mh-pick-mode' on a new pattern.") ;;; Internal variables: (defvar mh-pick-mode-map (make-sparse-keymap) "Keymap for searching folder.") (defvar mh-searching-folder nil) ;Folder this pick is searching. (defun mh-search-folder (folder) "Search FOLDER for messages matching a pattern. Add the messages found to the sequence named `search'." (interactive (list (mh-prompt-for-folder "Search" mh-current-folder t))) (switch-to-buffer-other-window "pick-pattern") (if (or (zerop (buffer-size)) (not (y-or-n-p "Reuse pattern? "))) (mh-make-pick-template) (message "")) (setq mh-searching-folder folder)) (defun mh-make-pick-template () ;; Initialize the current buffer with a template for a pick pattern. (erase-buffer) (insert "From: \n" "To: \n" "Cc: \n" "Date: \n" "Subject: \n" "---------\n") (mh-pick-mode) (goto-char (point-min)) (end-of-line)) (put 'mh-pick-mode 'mode-class 'special) (defun mh-pick-mode () "Mode for creating search templates in mh-e.\\ After each field name, enter the pattern to search for. If a field's value does not matter for the search, leave it empty. To search the entire message, supply the pattern in the \"body\" of the template. Each non-empty field must be matched for a message to be selected. To effect a logical \"or\", use \\[mh-search-folder] multiple times. When you have finished, type \\[mh-do-pick-search] to do the search. \\{mh-pick-mode-map} Turning on mh-pick-mode calls the value of the variable mh-pick-mode-hook if that value is non-nil." (interactive) (kill-all-local-variables) (make-local-variable 'mh-searching-folder) (use-local-map mh-pick-mode-map) (setq major-mode 'mh-pick-mode) (mh-set-mode-name "MH-Pick") (run-hooks 'mh-pick-mode-hook)) (defun mh-do-pick-search () "Find messages that match the qualifications in the current pattern buffer. Messages are searched for in the folder named in mh-searching-folder. Add the messages found to the sequence named `search'." (interactive) (let ((pattern-buffer (buffer-name)) (searching-buffer mh-searching-folder) range msgs (finding-messages t) (pattern nil) (new-buffer nil)) (save-excursion (cond ((get-buffer searching-buffer) (set-buffer searching-buffer) (setq range (list (format "%d-%d" mh-first-msg-num mh-last-msg-num)))) (t (mh-make-folder searching-buffer) (setq range '("all")) (setq new-buffer t)))) (message "Searching...") (goto-char (point-min)) (while (and range (setq pattern (mh-next-pick-field pattern-buffer))) (setq msgs (mh-seq-from-command searching-buffer 'search (mh-list-to-string (list "pick" pattern searching-buffer "-list" (mh-coalesce-msg-list range))))) (setq range msgs)) ;restrict the pick range for next pass (message "Searching...done") (if new-buffer (mh-scan-folder searching-buffer msgs) (switch-to-buffer searching-buffer)) (mh-add-msgs-to-seq msgs 'search) (delete-other-windows))) (defun mh-seq-from-command (folder seq seq-command) ;; In FOLDER, make a sequence named SEQ by executing COMMAND. ;; COMMAND is a list. The first element is a program name ;; and the subsequent elements are its arguments, all strings. (let ((msg) (msgs ()) (case-fold-search t)) (save-excursion (save-window-excursion (if (eq 0 (apply 'mh-exec-cmd-quiet nil seq-command)) ;; "pick" outputs one number per line (while (setq msg (car (mh-read-msg-list))) (setq msgs (cons msg msgs)) (forward-line 1)))) (set-buffer folder) (setq msgs (nreverse msgs)) ;put in ascending order msgs))) (defun mh-next-pick-field (buffer) ;; Return the next piece of a pick argument that can be extracted from the ;; BUFFER. ;; Return a list like ("--fieldname" "pattern") or ("-search" "bodypat") ;; or NIL if no pieces remain. (set-buffer buffer) (let ((case-fold-search t)) (cond ((eobp) nil) ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" nil t) (let* ((component (format "--%s" (downcase (buffer-substring (match-beginning 1) (match-end 1))))) (pat (buffer-substring (match-beginning 2) (match-end 2)))) (forward-line 1) (list component pat))) ((re-search-forward "^-*$" nil t) (forward-char 1) (let ((body (buffer-substring (point) (point-max)))) (if (and (> (length body) 0) (not (equal body "\n"))) (list "-search" body) nil))) (t nil)))) ;;; Build the pick-mode keymap: (define-key mh-pick-mode-map "\C-c\C-c" 'mh-do-pick-search) (define-key mh-pick-mode-map "\C-c\C-f\C-b" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-f\C-c" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-f\C-d" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-f\C-f" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-f\C-r" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-f\C-s" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-f\C-t" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-fb" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-fc" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-fd" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-ff" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-fr" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-fs" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-ft" 'mh-to-field) emacs-19.30/lisp/mh-seq.el100444 75424 1 17265 6046277276 14040 0ustar kwzhdaemon;;; mh-seq --- mh-e sequences support ;; Time-stamp: <95/08/19 16:45:15 gildea> ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. ;; This file is part of mh-e, 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: ;; Internal support for mh-e package. ;;; Change Log: ;; $Id: mh-seq.el,v 1.4 1995/11/03 02:30:17 kwzh Exp $ ;;; Code: (provide 'mh-seq) (require 'mh-e) ;;; Internal variables: (defvar mh-last-seq-used nil) ;Name of seq to which a msg was last added. (defvar mh-non-seq-mode-line-annotation nil) ;Saved value of mh-mode-line-annotation when narrowed to a seq. (defun mh-delete-seq (sequence) "Delete the SEQUENCE." (interactive (list (mh-read-seq-default "Delete" t))) (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note) sequence) (mh-undefine-sequence sequence '("all")) (mh-delete-seq-locally sequence)) (defun mh-list-sequences (folder) "List the sequences defined in FOLDER." (interactive (list (mh-prompt-for-folder "List sequences in" mh-current-folder t))) (let ((temp-buffer mh-temp-buffer) (seq-list mh-seq-list)) (with-output-to-temp-buffer temp-buffer (save-excursion (set-buffer temp-buffer) (erase-buffer) (message "Listing sequences ...") (insert "Sequences in folder " folder ":\n") (while seq-list (let ((name (mh-seq-name (car seq-list))) (sorted-seq-msgs (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<)) (last-col (- (window-width) 4)) name-spec) (insert (setq name-spec (format "%20s:" name))) (while sorted-seq-msgs (if (> (current-column) last-col) (progn (insert "\n") (move-to-column (length name-spec)))) (insert (format " %s" (car sorted-seq-msgs))) (setq sorted-seq-msgs (cdr sorted-seq-msgs))) (insert "\n")) (setq seq-list (cdr seq-list))) (goto-char (point-min)) (message "Listing sequences...done"))))) (defun mh-msg-is-in-seq (message) "Display the sequences that contain MESSAGE (default: current message)." (interactive (list (mh-get-msg-num t))) (message "Message %d is in sequences: %s" message (mapconcat 'concat (mh-list-to-string (mh-seq-containing-msg message t)) " "))) (defun mh-narrow-to-seq (sequence) "Restrict display of this folder to just messages in SEQUENCE. Use \\\\[mh-widen] to undo this command." (interactive (list (mh-read-seq "Narrow to" t))) (with-mh-folder-updating (t) (cond ((mh-seq-to-msgs sequence) (mh-widen) (let ((eob (point-max))) (mh-copy-seq-to-point sequence eob) (narrow-to-region eob (point-max)) (make-variable-buffer-local 'mh-non-seq-mode-line-annotation) (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation) (setq mh-mode-line-annotation (symbol-name sequence)) (mh-make-folder-mode-line) (mh-recenter nil) (setq mh-narrowed-to-seq sequence))) (t (error "No messages in sequence `%s'" (symbol-name sequence)))))) (defun mh-put-msg-in-seq (msg-or-seq sequence) "Add MESSAGE(s) (default: displayed message) to SEQUENCE. If optional prefix argument provided, then prompt for the message sequence." (interactive (list (if current-prefix-arg (mh-read-seq-default "Add messages from" t) (mh-get-msg-num t)) (mh-read-seq-default "Add to" nil))) (if (not (mh-internal-seq sequence)) (setq mh-last-seq-used sequence)) (mh-add-msgs-to-seq (if (numberp msg-or-seq) msg-or-seq (mh-seq-to-msgs msg-or-seq)) sequence)) (defun mh-widen () "Remove restrictions from current folder, thereby showing all messages." (interactive) (if mh-narrowed-to-seq (with-mh-folder-updating (t) (delete-region (point-min) (point-max)) (widen) (setq mh-mode-line-annotation mh-non-seq-mode-line-annotation) (mh-make-folder-mode-line))) (setq mh-narrowed-to-seq nil)) ;;; Commands to manipulate sequences. Sequences are stored in an alist ;;; of the form: ;;; ((seq-name msgs ...) (seq-name msgs ...) ...) (defun mh-read-seq-default (prompt not-empty) ;; Read and return sequence name with default narrowed or previous sequence. (mh-read-seq prompt not-empty (or mh-narrowed-to-seq mh-last-seq-used (car (mh-seq-containing-msg (mh-get-msg-num nil) nil))))) (defun mh-read-seq (prompt not-empty &optional default) ;; Read and return a sequence name. Prompt with PROMPT, raise an error ;; if the sequence is empty and the NOT-EMPTY flag is non-nil, and supply ;; an optional DEFAULT sequence. ;; A reply of '%' defaults to the first sequence containing the current ;; message. (let* ((input (completing-read (format "%s %s %s" prompt "sequence:" (if default (format "[%s] " default) "")) (mh-seq-names mh-seq-list))) (seq (cond ((equal input "%") (car (mh-seq-containing-msg (mh-get-msg-num t) nil))) ((equal input "") default) (t (intern input)))) (msgs (mh-seq-to-msgs seq))) (if (and (null msgs) not-empty) (error (format "No messages in sequence `%s'" seq))) seq)) (defun mh-seq-names (seq-list) ;; Return an alist containing the names of the SEQUENCES. (mapcar (function (lambda (entry) (list (symbol-name (mh-seq-name entry))))) seq-list)) (defun mh-rename-seq (sequence new-name) "Rename SEQUENCE to have NEW-NAME." (interactive (list (mh-read-seq "Old" t) (intern (read-string "New sequence name: ")))) (let ((old-seq (mh-find-seq sequence))) (or old-seq (error "Sequence %s does not exist" sequence)) ;; create new sequence first, since it might raise an error. (mh-define-sequence new-name (mh-seq-msgs old-seq)) (mh-undefine-sequence sequence (mh-seq-msgs old-seq)) (rplaca old-seq new-name))) (defun mh-map-to-seq-msgs (func seq &rest args) ;; Invoke the FUNCTION at each message in the SEQUENCE, passing the ;; remaining ARGS as arguments. (save-excursion (let ((msgs (mh-seq-to-msgs seq))) (while msgs (if (mh-goto-msg (car msgs) t t) (apply func (car msgs) args)) (setq msgs (cdr msgs)))))) (defun mh-notate-seq (seq notation offset) ;; Mark the scan listing of all messages in the SEQUENCE with the CHARACTER ;; at the given OFFSET from the beginning of the listing line. (mh-map-to-seq-msgs 'mh-notate seq notation offset)) (defun mh-add-to-sequence (seq msgs) ;; Add to a SEQUENCE each message the list of MSGS. (if (not (mh-folder-name-p seq)) (if msgs (apply 'mh-exec-cmd "mark" mh-current-folder "-add" "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))) (defun mh-copy-seq-to-point (seq location) ;; Copy the scan listing of the messages in SEQUENCE to after the point ;; LOCATION in the current buffer. (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location)) (defun mh-copy-line-to-point (msg location) ;; Copy the current line to the LOCATION in the current buffer. (beginning-of-line) (save-excursion (let ((beginning-of-line (point)) end) (forward-line 1) (setq end (point)) (goto-char location) (insert-buffer-substring (current-buffer) beginning-of-line end)))) emacs-19.30/lisp/mh-utils.el100444 75424 1 103751 6046277174 14421 0ustar kwzhdaemon;;; mh-utils.el --- mh-e code needed for both sending and reading ;; Time-stamp: <95/10/22 17:58:16 gildea> ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. ;; This file is part of mh-e, 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: ;; Internal support for mh-e package. ;;; Change Log: ;; $Id: mh-utils.el,v 1.6 1995/11/03 02:29:09 kwzh Exp $ ;;; Code: ;;; Set for local environment: ;;; mh-progs and mh-lib used to be set in paths.el, which tried to ;;; figure out at build time which of several possible directories MH ;;; was installed into. But if you installed MH after building Emacs, ;;; this would almost certainly be wrong, so now we do it at run time. (defvar mh-progs nil "Directory containing MH commands, such as inc, repl, and rmm.") (defvar mh-lib nil "Directory containing the MH library. This directory contains, among other things, the mhl program and the components file.") ;;;###autoload (put 'mh-progs 'risky-local-variable t) ;;;###autoload (put 'mh-lib 'risky-local-variable t) ;;; User preferences: (defvar mh-auto-folder-collect t "*Whether to start collecting MH folder names immediately in the background. Non-nil means start a background process collecting the names of all folders as soon as mh-e is loaded.") (defvar mh-recursive-folders nil "*If non-nil, then commands which operate on folders do so recursively.") (defvar mh-clean-message-header nil "*Non-nil means clean headers of messages that are displayed or inserted. The variables `mh-visible-headers' and `mh-invisible-headers' control what is removed.") (defvar mh-visible-headers nil "*If non-nil, contains a regexp specifying the headers to keep when cleaning. Only used if `mh-clean-message-header' is non-nil. Setting this variable overrides `mh-invisible-headers'.") (defvar mh-invisible-headers "^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|^Return-Path: \\|^Delivery-Date: \\|^In-Reply-To: \\|^Resent-" "Regexp matching lines in a message header that are not to be shown. If `mh-visible-headers' is non-nil, it is used instead to specify what to keep.") (defvar mh-bury-show-buffer t "*Non-nil means that the displayed show buffer for a folder is buried.") (defvar mh-summary-height 4 "*Number of lines in MH-Folder window (including the mode line).") (defvar mh-msg-number-regexp "^ *\\([0-9]+\\)" "Regexp to find the number of a message in a scan line. The message's number must be surrounded with \\( \\)") (defvar mh-msg-search-regexp "^[^0-9]*%d[^0-9]" "Format string containing a regexp matching the scan listing for a message. The desired message's number will be an argument to format.") (defvar mhl-formfile nil "*Name of format file to be used by mhl to show and print messages. A value of T means use the default format file. Nil means don't use mhl to format messages when showing; mhl is still used, with the default format file, to format messages when printing them. The format used should specify a non-zero value for overflowoffset so the message continues to conform to RFC 822 and mh-e can parse the headers.") (put 'mhl-formfile 'info-file "mh-e") (defvar mh-default-folder-for-message-function nil "Function to select a default folder for refiling or Fcc. If set to a function, that function is called with no arguments by `\\[mh-refile-msg]' and `\\[mh-to-fcc]' to get a default when prompting the user for a folder. The function is called from within a save-excursion, with point at the start of the message. It should return the folder to offer as the refile or Fcc folder, as a string with a leading `+' sign. It can also return an empty string to use no default, or NIL to calculate the default the usual way. NOTE: This variable is not an ordinary hook; It may not be a list of functions.") (defvar mh-find-path-hook nil "Invoked by mh-find-path while reading the user's MH profile.") (defvar mh-folder-list-change-hook nil "Invoked whenever the cached folder list `mh-folder-list' is changed.") (defvar mh-show-buffer-mode-line-buffer-id "{show-%s} %d" "Format string to produce `mode-line-buffer-identification' for show buffers. First argument is folder name. Second is message number.") (defvar mh-cmd-note 4 "Offset to insert notation.") (defvar mh-note-seq "%" "String whose first character is used to notate messages in a sequence.") ;;; Internal bookkeeping variables: ;; The value of `mh-folder-list-change-hook' is called whenever ;; mh-folder-list variable is set. (defvar mh-folder-list nil) ;List of folder names for completion. ;; Cached value of the `Path:' component in the user's MH profile. (defvar mh-user-path nil) ;User's mail folder directory. ;; An mh-draft-folder of NIL means do not use a draft folder. ;; Cached value of the `Draft-Folder:' component in the user's MH profile. (defvar mh-draft-folder nil) ;Name of folder containing draft messages. ;; Cached value of the `Unseen-Sequence:' component in the user's MH profile. (defvar mh-unseen-seq nil) ;Name of the Unseen sequence. ;; Cached value of the `Previous-Sequence:' component in the user's MH profile. (defvar mh-previous-seq nil) ;Name of the Previous sequence. ;; Cached value of the `Inbox:' component in the user's MH profile, ;; or "+inbox" if no such component. (defvar mh-inbox nil) ;Name of the Inbox folder. (defconst mh-temp-buffer " *mh-temp*") ;Name of mh-e scratch buffer. (defvar mh-previous-window-config nil) ;Window configuration before mh-e command. ;;; Internal variables local to a folder. (defvar mh-current-folder nil) ;Name of current folder, a string. (defvar mh-show-buffer nil) ;Buffer that displays message for this folder. (defvar mh-folder-filename nil) ;Full path of directory for this folder. (defvar mh-msg-count nil) ;Number of msgs in buffer. (defvar mh-showing nil) ;If non-nil, show the message in a separate window. ;;; This holds a documentation string used by describe-mode. (defun mh-showing () "When moving to a new message in the Folder window, also show it in a separate Show window." nil) (defvar mh-seq-list nil) ;The sequences of this folder. An alist of (seq . msgs). (defvar mh-seen-list nil) ;List of displayed messages to be removed from the Unseen sequence. ;; If non-nil, show buffer contains message with all headers. ;; If nil, show buffer contains message processed normally. (defvar mh-showing-with-headers nil) ;Showing message with headers or normally. ;;; mh-e macros (defmacro with-mh-folder-updating (save-modification-flag-p &rest body) ;; Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG-P) &body BODY). ;; Execute BODY, which can modify the folder buffer without having to ;; worry about file locking or the read-only flag, and return its result. ;; If SAVE-MODIFICATION-FLAG-P is non-nil, the buffer's modification ;; flag is unchanged, otherwise it is cleared. (setq save-modification-flag-p (car save-modification-flag-p)) ; CL style (` (prog1 (let ((mh-folder-updating-mod-flag (buffer-modified-p)) (buffer-read-only nil) (buffer-file-name nil)) ;don't let the buffer get locked (prog1 (progn (,@ body)) (mh-set-folder-modified-p mh-folder-updating-mod-flag))) (,@ (if (not save-modification-flag-p) '((mh-set-folder-modified-p nil))))))) (put 'with-mh-folder-updating 'lisp-indent-hook 1) (defmacro mh-in-show-buffer (show-buffer &rest body) ;; Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY). ;; Display buffer SHOW-BUFFER in other window and execute BODY in it. ;; Stronger than save-excursion, weaker than save-window-excursion. (setq show-buffer (car show-buffer)) ; CL style (` (let ((mh-in-show-buffer-saved-window (selected-window))) (switch-to-buffer-other-window (, show-buffer)) (if mh-bury-show-buffer (bury-buffer (current-buffer))) (unwind-protect (progn (,@ body)) (select-window mh-in-show-buffer-saved-window))))) (put 'mh-in-show-buffer 'lisp-indent-hook 1) (defmacro mh-make-seq (name msgs) (list 'cons name msgs)) (defmacro mh-seq-name (pair) (list 'car pair)) (defmacro mh-seq-msgs (pair) (list 'cdr pair)) ;;; Ensure new buffers won't get this mode if default-major-mode is nil. (put 'mh-show-mode 'mode-class 'special) (defun mh-show-mode () "Major mode for showing messages in mh-e. The value of mh-show-mode-hook is called when a new message is displayed." (kill-all-local-variables) (setq major-mode 'mh-show-mode) (mh-set-mode-name "MH-Show") (run-hooks 'mh-show-mode-hook)) (defun mh-maybe-show (&optional msg) ;; If in showing mode, then display the message pointed to by the cursor. (if mh-showing (mh-show msg))) (defun mh-show (&optional message) "Show MESSAGE (default: message at cursor). Force a two-window display with the folder window on top (size mh-summary-height) and the show buffer below it. If the message is already visible, display the start of the message. Display of the message is controlled by setting the variables `mh-clean-message-header' and `mhl-formfile'. The default behavior is to scroll uninteresting headers off the top of the window. Type \"\\[mh-header-display]\" to see the message with all its headers." (interactive) (and mh-showing-with-headers (or mhl-formfile mh-clean-message-header) (mh-invalidate-show-buffer)) (mh-show-msg message)) (defun mh-show-msg (msg) (if (not msg) (setq msg (mh-get-msg-num t))) (setq mh-showing t) (let ((folder mh-current-folder) (clean-message-header mh-clean-message-header) (show-window (get-buffer-window mh-show-buffer))) (if (not (eql (next-window (minibuffer-window)) (selected-window))) (delete-other-windows)) ; force ourself to the top window (mh-in-show-buffer (mh-show-buffer) (if (and show-window (equal (mh-msg-filename msg folder) buffer-file-name)) (progn ;just back up to start (goto-char (point-min)) (if (not clean-message-header) (mh-start-of-uncleaned-message))) (mh-display-msg msg folder)))) (if (not (= (1+ (window-height)) (screen-height))) ;not horizontally split (shrink-window (- (window-height) mh-summary-height))) (mh-recenter nil) (if (not (memq msg mh-seen-list)) (setq mh-seen-list (cons msg mh-seen-list))) (run-hooks 'mh-show-hook)) (defun mh-display-msg (msg-num folder) ;; Display message NUMBER of FOLDER. ;; Sets the current buffer to the show buffer. (set-buffer folder) ;; Bind variables in folder buffer in case they are local (let ((formfile mhl-formfile) (clean-message-header mh-clean-message-header) (invisible-headers mh-invisible-headers) (visible-headers mh-visible-headers) (msg-filename (mh-msg-filename msg-num)) (show-buffer mh-show-buffer)) (if (not (file-exists-p msg-filename)) (error "Message %d does not exist" msg-num)) (set-buffer show-buffer) (cond ((not (equal msg-filename buffer-file-name)) (mh-unvisit-file) (erase-buffer) ;; Changing contents, so this hook needs to be reinitialized. ;; pgp.el uses this. (if (boundp 'write-contents-hooks) ;Emacs 19 (setq write-contents-hooks nil)) (if formfile (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" (if (stringp formfile) (list "-form" formfile)) msg-filename) (insert-file-contents msg-filename)) (goto-char (point-min)) (cond (clean-message-header (mh-clean-msg-header (point-min) invisible-headers visible-headers) (goto-char (point-min))) (t (mh-start-of-uncleaned-message))) ;; the parts of visiting we want to do (no locking) (or (eq buffer-undo-list t) ;don't save undo info for prev msgs (setq buffer-undo-list nil)) (set-buffer-modified-p nil) (set-buffer-auto-saved) ;; the parts of set-visited-file-name we want to do (no locking) (setq buffer-file-name msg-filename) (setq buffer-backed-up nil) (auto-save-mode 1) (set-mark nil) (mh-show-mode) (setq mode-line-buffer-identification (list (format mh-show-buffer-mode-line-buffer-id folder msg-num))) (set-buffer folder) (setq mh-showing-with-headers nil))))) (defun mh-start-of-uncleaned-message () ;; position uninteresting headers off the top of the window (let ((case-fold-search t)) (re-search-forward "^To:\\|^Cc:\\|^From:\\|^Subject:\\|^Date:" nil t) (beginning-of-line) (mh-recenter 0))) (defun mh-invalidate-show-buffer () ;; Invalidate the show buffer so we must update it to use it. (if (get-buffer mh-show-buffer) (save-excursion (set-buffer mh-show-buffer) (mh-unvisit-file)))) (defun mh-unvisit-file () ;; Separate current buffer from the message file it was visiting. (or (not (buffer-modified-p)) (null buffer-file-name) ;we've been here before (yes-or-no-p (format "Message %s modified; flush changes? " (file-name-nondirectory buffer-file-name))) (error "Flushing changes not confirmed")) (clear-visited-file-modtime) (unlock-buffer) (setq buffer-file-name nil)) (defun mh-get-msg-num (error-if-no-message) ;; Return the message number of the displayed message. If the argument ;; ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is not ;; pointing to a message. (save-excursion (beginning-of-line) (cond ((looking-at mh-msg-number-regexp) (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))) (error-if-no-message (error "Cursor not pointing to message")) (t nil)))) (defun mh-msg-filename (msg &optional folder) ;; Return the file name of MESSAGE in FOLDER (default current folder). (expand-file-name (int-to-string msg) (if folder (mh-expand-file-name folder) mh-folder-filename))) (defun mh-clean-msg-header (start invisible-headers visible-headers) ;; Flush extraneous lines in a message header, from the given POINT to the ;; end of the message header. If VISIBLE-HEADERS is non-nil, it contains a ;; regular expression specifying the lines to display, otherwise ;; INVISIBLE-HEADERS contains a regular expression specifying lines to ;; delete from the header. (let ((case-fold-search t)) (save-restriction (goto-char start) (if (search-forward "\n\n" nil 'move) (backward-char 1)) (narrow-to-region start (point)) (goto-char (point-min)) (if visible-headers (while (< (point) (point-max)) (cond ((looking-at visible-headers) (forward-line 1) (while (looking-at "[ \t]") (forward-line 1))) (t (mh-delete-line 1) (while (looking-at "[ \t]") (mh-delete-line 1))))) (while (re-search-forward invisible-headers nil t) (beginning-of-line) (mh-delete-line 1) (while (looking-at "[ \t]") (mh-delete-line 1)))) (unlock-buffer)))) (defun mh-recenter (arg) ;; Like recenter but with two improvements: nil arg means recenter, ;; and only does anything if the current buffer is in the selected ;; window. (Commands like save-some-buffers can make this false.) (if (eql (get-buffer-window (current-buffer)) (selected-window)) (recenter (if arg arg '(t))))) (defun mh-delete-line (lines) ;; Delete version of kill-line. (delete-region (point) (progn (forward-line lines) (point)))) (defun mh-notate (msg notation offset) ;; Marks MESSAGE with the character NOTATION at position OFFSET. ;; Null MESSAGE means the message that the cursor points to. (save-excursion (if (or (null msg) (mh-goto-msg msg t t)) (with-mh-folder-updating (t) (beginning-of-line) (forward-char offset) (delete-char 1) (insert notation))))) (defun mh-find-msg-get-num (step) ;; Return the message number of the message on the current scan line ;; or one nearby. Jumps over non-message lines, such as inc errors. ;; STEP tells whether to search forward or backward if we have to search. (or (mh-get-msg-num nil) (let ((msg-num nil) (nreverses 0)) (while (and (not msg-num) (< nreverses 2)) (cond ((eobp) (setq step -1) (setq nreverses (1+ nreverses))) ((bobp) (setq step 1) (setq nreverses (1+ nreverses)))) (forward-line step) (setq msg-num (mh-get-msg-num nil))) msg-num))) (defun mh-goto-msg (number &optional no-error-if-no-message dont-show) "Position the cursor at message NUMBER. Optional non-nil second argument means return nil instead of signaling an error if message does not exist; in this case, the cursor is positioned near where the message would have been. Non-nil third argument means not to show the message." (interactive "NGo to message: ") (setq number (prefix-numeric-value number)) ;Emacs 19 ;; This basic routine tries to be as fast as possible, ;; using a binary search and minimal regexps. (let ((cur-msg (mh-find-msg-get-num -1)) (jump-size mh-msg-count)) (while (and (> jump-size 1) cur-msg (not (eq cur-msg number))) (cond ((< cur-msg number) (setq jump-size (min (- number cur-msg) (ash (1+ jump-size) -1))) (forward-line jump-size) (setq cur-msg (mh-find-msg-get-num 1))) (t (setq jump-size (min (- cur-msg number) (ash (1+ jump-size) -1))) (forward-line (- jump-size)) (setq cur-msg (mh-find-msg-get-num -1))))) (if (eq cur-msg number) (progn (beginning-of-line) (or dont-show (mh-maybe-show number) t)) (if (not no-error-if-no-message) (error "No message %d" number))))) (defun mh-msg-search-pat (n) ;; Return a search pattern for message N in the scan listing. (format mh-msg-search-regexp n)) (defun mh-get-profile-field (field) ;; Find and return the value of FIELD in the current buffer. ;; Returns NIL if the field is not in the buffer. (let ((case-fold-search t)) (goto-char (point-min)) (cond ((not (re-search-forward (format "^%s" field) nil t)) nil) ((looking-at "[\t ]*$") nil) (t (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) (let ((start (match-beginning 1))) (end-of-line) (buffer-substring start (point))))))) (defvar mua-paradigm "MH-E") ;from mua.el (defun mh-find-path () ;; Set mh-progs and mh-lib. ;; (This step is necessary if MH was installed after this Emacs was dumped.) ;; From profile file, set mh-user-path, mh-draft-folder, ;; mh-unseen-seq, mh-previous-seq, mh-inbox. (mh-find-progs) (save-excursion ;; Be sure profile is fully expanded before switching buffers (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile")))) (set-buffer (get-buffer-create mh-temp-buffer)) (setq buffer-offer-save nil) ;for people who set default to t (erase-buffer) (condition-case err (insert-file-contents profile) (file-error (mh-install profile err))) (setq mh-user-path (mh-get-profile-field "Path:")) (if (not mh-user-path) (setq mh-user-path "Mail")) (setq mh-user-path (file-name-as-directory (expand-file-name mh-user-path (expand-file-name "~")))) (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:")) (if mh-draft-folder (progn (if (not (mh-folder-name-p mh-draft-folder)) (setq mh-draft-folder (format "+%s" mh-draft-folder))) (if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) (error "Draft folder \"%s\" not found. Create it and try again." (mh-expand-file-name mh-draft-folder))))) (setq mh-inbox (mh-get-profile-field "Inbox:")) (cond ((not mh-inbox) (setq mh-inbox "+inbox")) ((not (mh-folder-name-p mh-inbox)) (setq mh-inbox (format "+%s" mh-inbox)))) (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:")) (if mh-unseen-seq (setq mh-unseen-seq (intern mh-unseen-seq)) (setq mh-unseen-seq 'unseen)) ;old MH default? (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) (if mh-previous-seq (setq mh-previous-seq (intern mh-previous-seq))) (setq mua-paradigm "MH-E") (run-hooks 'mh-find-path-hook)))) (defun mh-find-progs () (or (file-exists-p (expand-file-name "inc" mh-progs)) (setq mh-progs (or (mh-path-search exec-path "inc") (mh-path-search '("/usr/local/bin/mh/" "/usr/local/mh/" "/usr/bin/mh/" ;Ultrix 4.2 "/usr/new/mh/" ;Ultrix <4.2 "/usr/contrib/mh/bin/" ;BSDI "/usr/local/bin/" ) "inc") mh-progs "/usr/local/bin/"))) (or (file-exists-p (expand-file-name "mhl" mh-lib)) (setq mh-lib (or (mh-path-search '("/usr/local/lib/mh/" "/usr/local/mh/lib/" "/usr/local/bin/mh/" "/usr/lib/mh/" ;Ultrix 4.2 "/usr/new/lib/mh/" ;Ultrix <4.2 "/usr/contrib/mh/lib/" ;BSDI ) "mhl") (mh-path-search exec-path "mhl") ;unlikely mh-lib "/usr/local/lib/mh/")))) (defun mh-path-search (path file) ;; Search PATH, a list of directory names, for FILE. ;; Returns the element of PATH that contains FILE, or nil if not found. (while (and path (not (file-exists-p (expand-file-name file (car path))))) (setq path (cdr path))) (car path)) (defvar mh-no-install nil) ;do not run install-mh (defun mh-install (profile error-val) ;; Called to do error recovery if we fail to read the profile file. ;; If possible, initialize the MH environment. (if (or (getenv "MH") (file-exists-p profile) mh-no-install) (signal (car error-val) (list (format "Cannot read MH profile \"%s\"" profile) (car (cdr (cdr error-val)))))) ;; The "install-mh" command will output a short note which ;; mh-exec-cmd will display to the user. ;; The MH 5 version of install-mh might try prompt the user ;; for information, which would fail here. (mh-exec-cmd (expand-file-name "install-mh" mh-lib) "-auto") ;; now try again to read the profile file (erase-buffer) (condition-case err (insert-file-contents profile) (file-error (signal (car err) ;re-signal with more specific msg (list (format "Cannot read MH profile \"%s\"" profile) (car (cdr (cdr err)))))))) (defun mh-set-folder-modified-p (flag) ;; Mark current folder as modified or unmodified according to FLAG. (set-buffer-modified-p flag)) (defun mh-find-seq (name) (assoc name mh-seq-list)) (defun mh-seq-to-msgs (seq) ;; Return a list of the messages in SEQUENCE. (mh-seq-msgs (mh-find-seq seq))) (defun mh-add-msgs-to-seq (msgs seq &optional internal-flag) ;; Add MESSAGE(s) to the SEQUENCE. If optional FLAG is non-nil, do not mark ;; the message in the scan listing or inform MH of the addition. (let ((entry (mh-find-seq seq))) (if (and msgs (atom msgs)) (setq msgs (list msgs))) (if (null entry) (setq mh-seq-list (cons (mh-make-seq seq msgs) mh-seq-list)) (if msgs (setcdr entry (append msgs (mh-seq-msgs entry))))) (cond ((not internal-flag) (mh-add-to-sequence seq msgs) (mh-notate-seq seq mh-note-seq (1+ mh-cmd-note)))))) (autoload 'mh-add-to-sequence "mh-seq") (autoload 'mh-notate-seq "mh-seq") (autoload 'mh-read-seq-default "mh-seq") (autoload 'mh-map-to-seq-msgs "mh-seq") (defun mh-set-mode-name (mode-name-string) ;; Set the mode-name and ensure that the mode line is updated. (setq mode-name mode-name-string) (force-mode-line-update t)) (defun mh-prompt-for-folder (prompt default can-create) ;; Prompt for a folder name with PROMPT. Returns the folder's name as a ;; string. DEFAULT is used if the folder exists and the user types return. ;; If the CAN-CREATE flag is t, then a non-existent folder is made. (if (null default) (setq default "")) (let* ((prompt (format "%s folder%s" prompt (if (equal "" default) "? " (format " [%s]? " default)))) read-name folder-name) (if (null mh-folder-list) (mh-set-folder-list)) (while (and (setq read-name (completing-read prompt mh-folder-list nil nil "+")) (equal read-name "") (equal default ""))) (cond ((or (equal read-name "") (equal read-name "+")) (setq read-name default)) ((not (mh-folder-name-p read-name)) (setq read-name (format "+%s" read-name)))) (setq folder-name read-name) (cond ((and (> (length folder-name) 0) (eql (aref folder-name (1- (length folder-name))) ?/)) (setq folder-name (substring folder-name 0 -1)))) (let ((new-file-p (not (file-exists-p (mh-expand-file-name folder-name))))) (cond ((and new-file-p (y-or-n-p (format "Folder %s does not exist. Create it? " folder-name))) (message "Creating %s" folder-name) (call-process "mkdir" nil nil nil (mh-expand-file-name folder-name)) (message "Creating %s...done" folder-name) (setq mh-folder-list (cons (list read-name) mh-folder-list)) (run-hooks 'mh-folder-list-change-hook)) (new-file-p (error "Folder %s is not created" folder-name)) ((not (file-directory-p (mh-expand-file-name folder-name))) (error "\"%s\" is not a directory" (mh-expand-file-name folder-name))) ((and (null (assoc read-name mh-folder-list)) (null (assoc (concat read-name "/") mh-folder-list))) (setq mh-folder-list (cons (list read-name) mh-folder-list)) (run-hooks 'mh-folder-list-change-hook)))) folder-name)) (defvar mh-make-folder-list-process nil) ;The background process collecting the folder list. (defvar mh-folder-list-temp nil) ;mh-folder-list as it is being built. (defvar mh-folder-list-partial-line "") ;Start of last incomplete line from folder process. (defun mh-set-folder-list () ;; Sets mh-folder-list correctly. ;; A useful function for the command line or for when you need to ;; sync by hand. Format is in a form suitable for completing read. (message "Collecting folder names...") (if (not mh-make-folder-list-process) (mh-make-folder-list-background)) (while (eq (process-status mh-make-folder-list-process) 'run) (accept-process-output mh-make-folder-list-process)) (setq mh-folder-list mh-folder-list-temp) (run-hooks 'mh-folder-list-change-hook) (setq mh-folder-list-temp nil) (delete-process mh-make-folder-list-process) (setq mh-make-folder-list-process nil) (message "Collecting folder names...done")) (defun mh-make-folder-list-background () ;; Start a background process to compute a list of the user's folders. ;; Call mh-set-folder-list to wait for the result. (cond ((not mh-make-folder-list-process) (mh-find-path) (let ((process-connection-type nil)) (setq mh-make-folder-list-process (start-process "folders" nil (expand-file-name "folders" mh-progs) "-fast" (if mh-recursive-folders "-recurse" "-norecurse"))) (set-process-filter mh-make-folder-list-process 'mh-make-folder-list-filter) (process-kill-without-query mh-make-folder-list-process))))) (defun mh-make-folder-list-filter (process output) ;; parse output from "folders -fast" (let ((position 0) line-end new-folder (prevailing-match-data (match-data))) (unwind-protect ;; make sure got complete line (while (setq line-end (string-match "\n" output position)) (setq new-folder (format "+%s%s" mh-folder-list-partial-line (substring output position line-end))) (setq mh-folder-list-partial-line "") ;; is new folder a subfolder of previous? (if (and mh-folder-list-temp (string-match (regexp-quote (concat (car (car mh-folder-list-temp)) "/")) new-folder)) ;; append slash to parent folder for better completion ;; (undone by mh-prompt-for-folder) (setq mh-folder-list-temp (cons (list new-folder) (cons (list (concat (car (car mh-folder-list-temp)) "/")) (cdr mh-folder-list-temp)))) (setq mh-folder-list-temp (cons (list new-folder) mh-folder-list-temp))) (setq position (1+ line-end))) (store-match-data prevailing-match-data)) (setq mh-folder-list-partial-line (substring output position)))) (defun mh-folder-name-p (name) ;; Return non-NIL if NAME is possibly the name of a folder. ;; A name (a string or symbol) can be a folder name if it begins with "+". (if (symbolp name) (eql (aref (symbol-name name) 0) ?+) (and (> (length name) 0) (eql (aref name 0) ?+)))) ;;; Issue commands to MH. (defun mh-exec-cmd (command &rest args) ;; Execute mh-command COMMAND with ARGS. ;; The side effects are what is desired. ;; Any output is assumed to be an error and is shown to the user. ;; The output is not read or parsed by mh-e. (save-excursion (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) (apply 'call-process (expand-file-name command mh-progs) nil t nil (mh-list-to-string args)) (if (> (buffer-size) 0) (save-window-excursion (switch-to-buffer-other-window mh-temp-buffer) (sit-for 5))))) (defun mh-exec-cmd-error (env command &rest args) ;; In environment ENV, execute mh-command COMMAND with args ARGS. ;; ENV is nil or a string of space-separated "var=value" elements. ;; Signals an error if process does not complete successfully. (save-excursion (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) (let ((status (if env ;; the shell hacks necessary here shows just how broken Unix is (apply 'call-process "/bin/sh" nil t nil "-c" (format "%s %s ${1+\"$@\"}" env (expand-file-name command mh-progs)) command (mh-list-to-string args)) (apply 'call-process (expand-file-name command mh-progs) nil t nil (mh-list-to-string args))))) (mh-handle-process-error command status)))) (defun mh-exec-cmd-daemon (command &rest args) ;; Execute MH command COMMAND with ARGS in the background. ;; Any output from command is displayed in an asynchronous pop-up window. (save-excursion (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer)) (let* ((process-connection-type nil) (process (apply 'start-process command nil (expand-file-name command mh-progs) (mh-list-to-string args)))) (set-process-filter process 'mh-process-daemon))) (defun mh-process-daemon (process output) ;; Process daemon that puts output into a temporary buffer. (set-buffer (get-buffer-create mh-temp-buffer)) (insert-before-markers output) (display-buffer mh-temp-buffer)) (defun mh-exec-cmd-quiet (raise-error command &rest args) ;; Args are RAISE-ERROR, COMMANDS, ARGS.... ;; Execute MH command COMMAND with ARGS. ARGS is a list of strings. ;; Return at start of mh-temp buffer, where output can be parsed and used. ;; Returns value of call-process, which is 0 for success, ;; unless RAISE-ERROR is non-nil, in which case an error is signaled ;; if call-process returns non-0. (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) (let ((value (apply 'call-process (expand-file-name command mh-progs) nil t nil args))) (goto-char (point-min)) (if raise-error (mh-handle-process-error command value) value))) (defun mh-exec-cmd-output (command display &rest args) ;; Execute MH command COMMAND with DISPLAY flag and ARGS. ;; Put the output into buffer after point. Set mark after inserted text. ;; Output is expected to be shown to user, not parsed by mh-e. (push-mark (point) t) (apply 'call-process (expand-file-name command mh-progs) nil t display (mh-list-to-string args)) (exchange-point-and-mark)) (defun mh-exec-lib-cmd-output (command &rest args) ;; Execute MH library command COMMAND with ARGS. ;; Put the output into buffer after point. Set mark after inserted text. (apply 'mh-exec-cmd-output (expand-file-name command mh-lib) nil args)) (defun mh-handle-process-error (command status) ;; Raise error if COMMAND returned non-0 STATUS, otherwise return STATUS. ;; STATUS is return value from call-process. ;; Program output is in current buffer. ;; If output is too long to include in error message, display the buffer. (cond ((eql status 0) ;success status) ((stringp status) ;kill string (error (format "%s: %s" command status))) (t ;exit code (cond ((= (buffer-size) 0) ;program produced no error message (error (format "%s: exit code %d" command status))) (t ;; will error message fit on one line? (goto-line 2) (if (and (< (buffer-size) (screen-width)) (eobp)) (error (buffer-substring 1 (progn (goto-char 1) (end-of-line) (point)))) (display-buffer (current-buffer)) (error (format "%s failed with status %d. See error message in other window." command status)))))))) (defun mh-expand-file-name (filename &optional default) ;; Just like `expand-file-name', but also handles MH folder names. ;; Assumes that any filename that starts with '+' is a folder name. (if (mh-folder-name-p filename) (expand-file-name (substring filename 1) mh-user-path) (expand-file-name filename default))) (defun mh-list-to-string (l) ;; Flattens the list L and makes every element of the new list into a string. (nreverse (mh-list-to-string-1 l))) (defun mh-list-to-string-1 (l) (let ((new-list nil)) (while l (cond ((null (car l))) ((symbolp (car l)) (setq new-list (cons (symbol-name (car l)) new-list))) ((numberp (car l)) (setq new-list (cons (int-to-string (car l)) new-list))) ((equal (car l) "")) ((stringp (car l)) (setq new-list (cons (car l) new-list))) ((listp (car l)) (setq new-list (nconc (mh-list-to-string-1 (car l)) new-list))) (t (error "Bad element in mh-list-to-string: %s" (car l)))) (setq l (cdr l))) new-list)) (provide 'mh-utils) (and (not noninteractive) mh-auto-folder-collect (let ((mh-no-install t)) ;only get folders if MH installed (condition-case err (mh-make-folder-list-background) (file-error)))) ;so don't complain if not installed ;;; mh-utils.el ends here emacs-19.30/lisp/misc.el100444 12120 1 4022 5257332722 13331 0ustar rmsdaemon;;; misc.el --- basic editing commands for Emacs ;; Copyright (C) 1989 Free Software Foundation, Inc. ;; Maintainer: FSF ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (defun copy-from-above-command (&optional arg) "Copy characters from previous nonblank line, starting just above point. Copy ARG characters, but not past the end of that line. If no argument given, copy the entire rest of the line. The characters copied are inserted in the buffer before point." (interactive "P") (let ((cc (current-column)) n (string "")) (save-excursion (beginning-of-line) (backward-char 1) (skip-chars-backward "\ \t\n") (move-to-column cc) ;; Default is enough to copy the whole rest of the line. (setq n (if arg (prefix-numeric-value arg) (point-max))) ;; If current column winds up in middle of a tab, ;; copy appropriate number of "virtual" space chars. (if (< cc (current-column)) (if (= (preceding-char) ?\t) (progn (setq string (make-string (min n (- (current-column) cc)) ?\ )) (setq n (- n (min n (- (current-column) cc))))) ;; In middle of ctl char => copy that whole char. (backward-char 1))) (setq string (concat string (buffer-substring (point) (min (save-excursion (end-of-line) (point)) (+ n (point))))))) (insert string))) ;;; misc.el ends here emacs-19.30/lisp/mlconvert.el100444 75424 12 24050 5734105263 14514 0ustar kwzhstaff;;; mlconvert.el --- convert buffer of Mocklisp code to real lisp. ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: emulations ;; 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 package converts Mocklisp code written under a Gosling or UniPress ;; Emacs for use with GNU Emacs. The translated code will require runtime ;; support from the mlsupport.el equivalent. ;;; Code: ;;;###autoload (defun convert-mocklisp-buffer () "Convert buffer of Mocklisp code to real Lisp that GNU Emacs can run." (interactive) (emacs-lisp-mode) (set-syntax-table (copy-sequence (syntax-table))) (modify-syntax-entry ?\| "w") (message "Converting mocklisp (ugh!)...") (goto-char (point-min)) (fix-mlisp-syntax) ;; Emulation of mocklisp is accurate only within a mocklisp-function ;; so turn any non-function into a defun and then call it. (goto-char (point-min)) (condition-case ignore (while t (let ((opt (point)) (form (read (current-buffer)))) (and (listp form) (not (eq (car form) 'defun)) (progn (insert "))\n\n(ml-foo)\n\n") (save-excursion (goto-char opt) (skip-chars-forward "\n") (insert "(defun (ml-foo \n ")))))) (end-of-file nil)) (goto-char (point-min)) (insert ";;; GNU Emacs code converted from Mocklisp\n") (insert "(require 'mlsupport)\n\n") (fix-mlisp-symbols) (goto-char (point-min)) (message "Converting mocklisp...done")) (defun fix-mlisp-syntax () (while (re-search-forward "['\"]" nil t) (if (= (preceding-char) ?\") (progn (forward-char -1) (forward-sexp 1)) (delete-char -1) (insert "?") (if (or (= (following-char) ?\\) (= (following-char) ?^)) (forward-char 1) (if (looking-at "[^a-zA-Z]") (insert ?\\))) (forward-char 1) (delete-char 1)))) (defun fix-mlisp-symbols () (while (progn (skip-chars-forward " \t\n()") (not (eobp))) (cond ((or (= (following-char) ?\?) (= (following-char) ?\")) (forward-sexp 1)) ((= (following-char) ?\;) (forward-line 1)) (t (let ((start (point)) prop) (forward-sexp 1) (setq prop (get (intern-soft (buffer-substring start (point))) 'mocklisp)) (cond ((null prop)) ((stringp prop) (delete-region start (point)) (insert prop)) (t (save-excursion (goto-char start) (funcall prop))))))))) (defun ml-expansion (ml-name lisp-string) (put ml-name 'mocklisp lisp-string)) (ml-expansion 'defun "ml-defun") (ml-expansion 'if "ml-if") (ml-expansion 'setq '(lambda () (if (looking-at "setq[ \t\n]+buffer-modified-p") (replace-match "set-buffer-modified-p")))) ;;(ml-expansion 'while '(lambda () ;; (let ((end (progn (forward-sexp 2) (point-marker))) ;; (start (progn (forward-sexp -1) (point)))) ;; (let ((cond (buffer-substring start end))) ;; (cond ((equal cond "1") ;; (delete-region (point) end) ;; (insert "t")) ;; (t ;; (insert "(not (zerop ") ;; (goto-char end) ;; (insert "))"))) ;; (set-marker end nil) ;; (goto-char start))))) (ml-expansion 'arg "ml-arg") (ml-expansion 'nargs "ml-nargs") (ml-expansion 'interactive "ml-interactive") (ml-expansion 'message "ml-message") (ml-expansion 'print "ml-print") (ml-expansion 'set "ml-set") (ml-expansion 'set-default "ml-set-default") (ml-expansion 'provide-prefix-argument "ml-provide-prefix-argument") (ml-expansion 'prefix-argument-loop "ml-prefix-argument-loop") (ml-expansion 'prefix-argument "ml-prefix-arg") (ml-expansion 'use-local-map "ml-use-local-map") (ml-expansion 'use-global-map "ml-use-global-map") (ml-expansion 'modify-syntax-entry "ml-modify-syntax-entry") (ml-expansion 'error-message "error") (ml-expansion 'dot "point-marker") (ml-expansion 'mark "mark-marker") (ml-expansion 'beginning-of-file "beginning-of-buffer") (ml-expansion 'end-of-file "end-of-buffer") (ml-expansion 'exchange-dot-and-mark "exchange-point-and-mark") (ml-expansion 'set-mark "set-mark-command") (ml-expansion 'argument-prefix "universal-arg") (ml-expansion 'previous-page "ml-previous-page") (ml-expansion 'next-page "ml-next-page") (ml-expansion 'next-window "ml-next-window") (ml-expansion 'previous-window "ml-previous-window") (ml-expansion 'newline "ml-newline") (ml-expansion 'next-line "ml-next-line") (ml-expansion 'previous-line "ml-previous-line") (ml-expansion 'self-insert "self-insert-command") (ml-expansion 'meta-digit "digit-argument") (ml-expansion 'meta-minus "negative-argument") (ml-expansion 'newline-and-indent "ml-newline-and-indent") (ml-expansion 'yank-from-killbuffer "yank") (ml-expansion 'yank-buffer "insert-buffer") (ml-expansion 'copy-region "copy-region-as-kill") (ml-expansion 'delete-white-space "delete-horizontal-space") (ml-expansion 'widen-region "widen") (ml-expansion 'forward-word '(lambda () (if (looking-at "forward-word[ \t\n]*)") (replace-match "forward-word 1)")))) (ml-expansion 'backward-word '(lambda () (if (looking-at "backward-word[ \t\n]*)") (replace-match "backward-word 1)")))) (ml-expansion 'forward-paren "forward-list") (ml-expansion 'backward-paren "backward-list") (ml-expansion 'search-reverse "ml-search-backward") (ml-expansion 're-search-reverse "ml-re-search-backward") (ml-expansion 'search-forward "ml-search-forward") (ml-expansion 're-search-forward "ml-re-search-forward") (ml-expansion 'quote "regexp-quote") (ml-expansion 're-query-replace "query-replace-regexp") (ml-expansion 're-replace-string "replace-regexp") ; forward-paren-bl, backward-paren-bl (ml-expansion 'get-tty-character "read-char") (ml-expansion 'get-tty-input "read-input") (ml-expansion 'get-tty-string "read-string") (ml-expansion 'get-tty-buffer "read-buffer") (ml-expansion 'get-tty-command "read-command") (ml-expansion 'get-tty-variable "read-variable") (ml-expansion 'get-tty-no-blanks-input "read-no-blanks-input") (ml-expansion 'get-tty-key "read-key") (ml-expansion 'concat "ml-concat") (ml-expansion 'c= "char-equal") (ml-expansion 'goto-character "goto-char") (ml-expansion 'substr "ml-substr") (ml-expansion 'variable-apropos "apropos") (ml-expansion 'execute-mlisp-buffer "eval-current-buffer") (ml-expansion 'execute-mlisp-file "load") (ml-expansion 'visit-file "find-file") (ml-expansion 'read-file "find-file") (ml-expansion 'write-modified-files "save-some-buffers") (ml-expansion 'backup-before-writing "make-backup-files") (ml-expansion 'write-file-exit "save-buffers-kill-emacs") (ml-expansion 'write-named-file "write-file") (ml-expansion 'change-file-name "set-visited-file-name") (ml-expansion 'change-buffer-name "rename-buffer") (ml-expansion 'buffer-exists "get-buffer") (ml-expansion 'delete-buffer "kill-buffer") (ml-expansion 'unlink-file "delete-file") (ml-expansion 'unlink-checkpoint-files "delete-auto-save-files") (ml-expansion 'file-exists "file-exists-p") (ml-expansion 'write-current-file "save-buffer") (ml-expansion 'change-directory "cd") (ml-expansion 'temp-use-buffer "set-buffer") (ml-expansion 'fast-filter-region "filter-region") (ml-expansion 'pending-input "input-pending-p") (ml-expansion 'execute-keyboard-macro "call-last-kbd-macro") (ml-expansion 'start-remembering "start-kbd-macro") (ml-expansion 'end-remembering "end-kbd-macro") (ml-expansion 'define-keyboard-macro "name-last-kbd-macro") (ml-expansion 'define-string-macro "ml-define-string-macro") (ml-expansion 'current-column "ml-current-column") (ml-expansion 'current-indent "ml-current-indent") (ml-expansion 'insert-character "insert") (ml-expansion 'users-login-name "user-login-name") (ml-expansion 'users-full-name "user-full-name") (ml-expansion 'current-time "current-time-string") (ml-expansion 'current-numeric-time "current-numeric-time-you-lose") (ml-expansion 'current-buffer-name "buffer-name") (ml-expansion 'current-file-name "buffer-file-name") (ml-expansion 'local-binding-of "local-key-binding") (ml-expansion 'global-binding-of "global-key-binding") ;defproc (ProcedureType, "procedure-type"); (ml-expansion 'remove-key-binding "global-unset-key") (ml-expansion 'remove-binding "global-unset-key") (ml-expansion 'remove-local-binding "local-unset-key") (ml-expansion 'remove-all-local-bindings "use-local-map nil") (ml-expansion 'autoload "ml-autoload") (ml-expansion 'checkpoint-frequency "auto-save-interval") (ml-expansion 'mode-string "mode-name") (ml-expansion 'right-margin "fill-column") (ml-expansion 'tab-size "tab-width") (ml-expansion 'default-right-margin "default-fill-column") (ml-expansion 'default-tab-size "default-tab-width") (ml-expansion 'buffer-is-modified "(buffer-modified-p)") (ml-expansion 'file-modified-time "you-lose-on-file-modified-time") (ml-expansion 'needs-checkpointing "you-lose-on-needs-checkpointing") (ml-expansion 'lines-on-screen "set-frame-height") (ml-expansion 'columns-on-screen "set-frame-width") (ml-expansion 'dumped-emacs "t") (ml-expansion 'buffer-size "ml-buffer-size") (ml-expansion 'dot-is-visible "pos-visible-in-window-p") (ml-expansion 'track-eol-on-^N-^P "track-eol") (ml-expansion 'ctlchar-with-^ "ctl-arrow") (ml-expansion 'help-on-command-completion-error "completion-auto-help") (ml-expansion 'dump-stack-trace "backtrace") (ml-expansion 'pause-emacs "suspend-emacs") (ml-expansion 'compile-it "compile") (ml-expansion '!= "/=") (ml-expansion '& "logand") (ml-expansion '| "logior") (ml-expansion '^ "logxor") (ml-expansion '! "ml-not") (ml-expansion '<< "lsh") ;Variable pause-writes-files ;;; mlconvert.el ends here emacs-19.30/lisp/mldrag.el100444 12120 1 20542 6045204261 13661 0ustar rmsdaemon;;; mldrag.el --- mode line and vertical line dragging to resize windows ;;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Author: Kyle E. Jones ;; Keywords: mouse ;; 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 package lets you drag the modeline, vertical bar and ;; scrollbar to resize windows. Suggested bindings are: ;; ;; (global-set-key [mode-line down-mouse-1] 'mldrag-drag-mode-line) ;; (global-set-key [vertical-line down-mouse-1] 'mldrag-drag-vertical-line) ;; (global-set-key [vertical-scroll-bar S-down-mouse-1] ;; 'mldrag-drag-vertical-line) ;; ;; Put the bindings and (require 'mldrag) in your .emacs file. ;;; Code: (provide 'mldrag) (defun mldrag-drag-mode-line (start-event) "Change the height of the current window with the mouse. This command should be bound to a down-mouse- event, and is most usefully bound with the `mode-line' prefix. Holding down a mouse button and moving the mouse up and down will make the clicked-on window taller or shorter." (interactive "e") (let ((done nil) (echo-keystrokes 0) (start-event-frame (window-frame (car (car (cdr start-event))))) (start-event-window (car (car (cdr start-event)))) (start-nwindows (count-windows t)) (old-selected-window (selected-window)) should-enlarge-minibuffer event mouse minibuffer y top bot edges wconfig params growth) (setq params (frame-parameters)) (if (and (not (setq minibuffer (cdr (assq 'minibuffer params)))) (one-window-p t)) (error "Attempt to resize sole window")) (unwind-protect (track-mouse (progn ;; enlarge-window only works on the selected window, so ;; we must select the window where the start event originated. ;; unwind-protect will restore the old selected window later. (select-window start-event-window) ;; if this is the bottommost ordinary window, then to ;; move its modeline the minibuffer must be enlarged. (setq should-enlarge-minibuffer (and minibuffer (not (one-window-p t)) (= (nth 1 (window-edges minibuffer)) (nth 3 (window-edges))))) ;; loop reading events and sampling the position of ;; the mouse. (while (not done) (setq event (read-event) mouse (mouse-position)) ;; do nothing if ;; - there is a switch-frame event. ;; - the mouse isn't in the frame that we started in ;; - the mouse isn't in any Emacs frame ;; drag if ;; - there is a mouse-movement event ;; - there is a scroll-bar-movement event ;; (same as mouse movement for our purposes) ;; quit if ;; - there is a keyboard event or some other unknown event ;; unknown event. (cond ((integerp event) (setq done t)) ((eq (car event) 'switch-frame) nil) ((not (memq (car event) '(mouse-movement scroll-bar-movement))) (setq done t)) ((not (eq (car mouse) start-event-frame)) nil) ((null (car (cdr mouse))) nil) (t (setq y (cdr (cdr mouse)) edges (window-edges) top (nth 1 edges) bot (nth 3 edges)) ;; scale back a move that would make the ;; window too short. (cond ((< (- y top -1) window-min-height) (setq y (+ top window-min-height -1)))) ;; compute size change needed (setq growth (- y bot -1) wconfig (current-window-configuration)) ;; grow/shrink minibuffer? (if should-enlarge-minibuffer (progn ;; yes. briefly select minibuffer so ;; enlarge-window will affect the ;; correct window. (select-window minibuffer) ;; scale back shrinkage if it would ;; make the minibuffer less than 1 ;; line tall. (if (and (> growth 0) (< (- (window-height minibuffer) growth) 1)) (setq growth (1- (window-height minibuffer)))) (enlarge-window (- growth)) (select-window start-event-window)) ;; no. grow/shrink the selected window (enlarge-window growth)) ;; if this window's growth caused another ;; window to be deleted because it was too ;; short, rescind the change. ;; ;; if size change caused space to be stolen ;; from a window above this one, rescind the ;; change, but only if we didn't grow/srhink ;; the minibuffer. minibuffer size changes ;; can cause all windows to shrink... no way ;; around it. (if (or (/= start-nwindows (count-windows t)) (and (not should-enlarge-minibuffer) (/= top (nth 1 (window-edges))))) (set-window-configuration wconfig))))))) ;; restore the old selected window (select-window old-selected-window)))) (defun mldrag-drag-vertical-line (start-event) "Change the width of the current window with the mouse. This command should be bound to a down-mouse- event, and is most usefully bound with the `vertical-line' or the `vertical-scroll-bar' prefix. Holding down a mouse button and moving the mouse left and right will make the clicked-on window thinner or wider." (interactive "e") (let ((done nil) (echo-keystrokes 0) (start-event-frame (window-frame (car (car (cdr start-event))))) (start-event-window (car (car (cdr start-event)))) (start-nwindows (count-windows t)) (old-selected-window (selected-window)) event mouse x left right edges wconfig growth) (if (one-window-p t) (error "Attempt to resize sole ordinary window")) (if (= (nth 2 (window-edges start-event-window)) (frame-width start-event-frame)) (error "Attempt to drag rightmost scrollbar")) (unwind-protect (track-mouse (progn ;; enlarge-window only works on the selected window, so ;; we must select the window where the start event originated. ;; unwind-protect will restore the old selected window later. (select-window start-event-window) ;; loop reading events and sampling the position of ;; the mouse. (while (not done) (setq event (read-event) mouse (mouse-position)) ;; do nothing if ;; - there is a switch-frame event. ;; - the mouse isn't in the frame that we started in ;; - the mouse isn't in any Emacs frame ;; drag if ;; - there is a mouse-movement event ;; - there is a scroll-bar-movement event ;; (same as mouse movement for our purposes) ;; quit if ;; - there is a keyboard event or some other unknown event ;; unknown event. (cond ((integerp event) (setq done t)) ((eq (car event) 'switch-frame) nil) ((not (memq (car event) '(mouse-movement scroll-bar-movement))) (setq done t)) ((not (eq (car mouse) start-event-frame)) nil) ((null (car (cdr mouse))) nil) (t (setq x (car (cdr mouse)) edges (window-edges) left (nth 0 edges) right (nth 2 edges)) ;; scale back a move that would make the ;; window too thin. (cond ((< (- x left -1) window-min-width) (setq x (+ left window-min-width -1)))) ;; compute size change needed (setq growth (- x right -1) wconfig (current-window-configuration)) (enlarge-window growth t) ;; if this window's growth caused another ;; window to be deleted because it was too ;; thin, rescind the change. ;; ;; if size change caused space to be stolen ;; from a window to the left of this one, ;; rescind the change. (if (or (/= start-nwindows (count-windows t)) (/= left (nth 0 (window-edges)))) (set-window-configuration wconfig))))))) ;; restore the old selected window (select-window old-selected-window)))) ;; mldrag.el ends here emacs-19.30/lisp/mlsupport.el100444 75424 12 27707 5734105263 14564 0ustar kwzhstaff;;; mlsupport.el --- run-time support for mocklisp code. ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: extensions ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 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 package provides equivalents of certain primitives from Gosling ;; Emacs (including the commercial UniPress versions). These have an ;; ml- prefix to distinguish them from native GNU Emacs functions with ;; similar names. The oackage mlconvert.el translates Mocklisp code ;; to use these names. ;;; Code: (defmacro ml-defun (&rest defs) (list 'ml-defun-1 (list 'quote defs))) (defun ml-defun-1 (args) (while args (fset (car (car args)) (cons 'mocklisp (cdr (car args)))) (setq args (cdr args)))) (defmacro declare-buffer-specific (&rest vars) (cons 'progn (mapcar (function (lambda (var) (list 'make-variable-buffer-local (list 'quote var)))) vars))) (defun ml-set-default (varname value) (set-default (intern varname) value)) ; Lossage: must make various things default missing args to the prefix arg ; Alternatively, must make provide-prefix-argument do something hairy. (defun >> (val count) (lsh val (- count))) (defun novalue () nil) (defun ml-not (arg) (if (zerop arg) 1 0)) (defun provide-prefix-arg (arg form) (funcall (car form) arg)) (defun define-keymap (name) (fset (intern name) (make-keymap))) ;; Make it work to use ml-use-...-map on "esc" and such. (fset 'esc-map esc-map) (fset 'ctl-x-map ctl-x-map) (defun ml-use-local-map (name) (use-local-map (intern (concat name "-map")))) (defun ml-use-global-map (name) (use-global-map (intern (concat name "-map")))) (defun local-bind-to-key (name key) (or (current-local-map) (use-local-map (make-keymap))) (define-key (current-local-map) (if (integerp key) (if (>= key 128) (concat (char-to-string meta-prefix-char) (char-to-string (- key 128))) (char-to-string key)) key) (intern name))) (defun bind-to-key (name key) (define-key global-map (if (integerp key) (char-to-string key) key) (intern name))) (defun ml-autoload (name file) (autoload (intern name) file)) (defun ml-define-string-macro (name defn) (fset (intern name) defn)) (defun push-back-character (char) (setq unread-command-events (list char))) (defun to-col (column) (indent-to column 0)) (defmacro is-bound (&rest syms) (cons 'and (mapcar (function (lambda (sym) (list 'boundp (list 'quote sym)))) syms))) (defmacro declare-global (&rest syms) (cons 'progn (mapcar (function (lambda (sym) (list 'defvar sym nil))) syms))) (defmacro error-occurred (&rest body) (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t))) (defun return-prefix-argument (value) (setq prefix-arg value)) (defun ml-prefix-argument () (if (null current-prefix-arg) 1 (if (listp current-prefix-arg) (car current-prefix-arg) (if (eq current-prefix-arg '-) -1 current-prefix-arg)))) (defun ml-print (varname) (interactive "vPrint variable: ") (if (boundp varname) (message "%s => %s" (symbol-name varname) (symbol-value varname)) (message "%s has no value" (symbol-name varname)))) (defun ml-set (str val) (set (intern str) val)) (defun ml-message (&rest args) (message "%s" (apply 'concat args))) (defun kill-to-end-of-line () (ml-prefix-argument-loop (if (eolp) (kill-region (point) (1+ (point))) (kill-region (point) (if (search-forward ?\n nil t) (1- (point)) (point-max)))))) (defun set-auto-fill-hook (arg) (setq auto-fill-function (intern arg))) (defun auto-execute (function pattern) (if (/= (aref pattern 0) ?*) (error "Only patterns starting with * supported in auto-execute")) (setq auto-mode-alist (cons (cons (concat "\\." (substring pattern 1) "\\'") function) auto-mode-alist))) (defun move-to-comment-column () (indent-to comment-column)) (defun erase-region () (delete-region (point) (mark))) (defun delete-region-to-buffer (bufname) (copy-to-buffer bufname (point) (mark)) (delete-region (point) (mark))) (defun copy-region-to-buffer (bufname) (copy-to-buffer bufname (point) (mark))) (defun append-region-to-buffer (bufname) (append-to-buffer bufname (point) (mark))) (defun prepend-region-to-buffer (bufname) (prepend-to-buffer bufname (point) (mark))) (defun delete-next-character () (delete-char (ml-prefix-argument))) (defun delete-next-word () (delete-region (point) (progn (forward-word (ml-prefix-argument)) (point)))) (defun delete-previous-word () (delete-region (point) (progn (backward-word (ml-prefix-argument)) (point)))) (defun delete-previous-character () (delete-backward-char (ml-prefix-argument))) (defun forward-character () (forward-char (ml-prefix-argument))) (defun backward-character () (backward-char (ml-prefix-argument))) (defun ml-newline () (newline (ml-prefix-argument))) (defun ml-next-line () (next-line (ml-prefix-argument))) (defun ml-previous-line () (previous-line (ml-prefix-argument))) (defun delete-to-kill-buffer () (kill-region (point) (mark))) (defun narrow-region () (narrow-to-region (point) (mark))) (defun ml-newline-and-indent () (let ((column (current-indentation))) (newline (ml-prefix-argument)) (indent-to column))) (defun newline-and-backup () (open-line (ml-prefix-argument))) (defun quote-char () (quoted-insert (ml-prefix-argument))) (defun ml-current-column () (1+ (current-column))) (defun ml-current-indent () (1+ (current-indentation))) (defun region-around-match (&optional n) (set-mark (match-beginning n)) (goto-char (match-end n))) (defun region-to-string () (buffer-substring (min (point) (mark)) (max (point) (mark)))) (defun use-abbrev-table (name) (let ((symbol (intern (concat name "-abbrev-table")))) (or (boundp symbol) (define-abbrev-table symbol nil)) (symbol-value symbol))) (defun define-hooked-local-abbrev (name exp hook) (define-local-abbrev name exp (intern hook))) (defun define-hooked-global-abbrev (name exp hook) (define-global-abbrev name exp (intern hook))) (defun case-word-lower () (ml-casify-word 'downcase-region)) (defun case-word-upper () (ml-casify-word 'upcase-region)) (defun case-word-capitalize () (ml-casify-word 'capitalize-region)) (defun ml-casify-word (fun) (save-excursion (forward-char 1) (forward-word -1) (funcall fun (point) (progn (forward-word (ml-prefix-argument)) (point))))) (defun case-region-lower () (downcase-region (point) (mark))) (defun case-region-upper () (upcase-region (point) (mark))) (defun case-region-capitalize () (capitalize-region (point) (mark))) (defvar saved-command-line-args nil) (defun argc () (or saved-command-line-args (setq saved-command-line-args command-line-args command-line-args ())) (length command-line-args)) (defun argv (i) (or saved-command-line-args (setq saved-command-line-args command-line-args command-line-args ())) (nth i saved-command-line-args)) (defun invisible-argc () (length (or saved-command-line-args command-line-args))) (defun invisible-argv (i) (nth i (or saved-command-line-args command-line-args))) (defun exit-emacs () (interactive) (condition-case () (exit-recursive-edit) (error (kill-emacs)))) ;; Lisp function buffer-size returns total including invisible; ;; mocklisp wants just visible. (defun ml-buffer-size () (- (point-max) (point-min))) (defun previous-command () last-command) (defun beginning-of-window () (goto-char (window-start))) (defun end-of-window () (goto-char (window-start)) (vertical-motion (- (window-height) 2))) (defun ml-search-forward (string) (search-forward string nil nil (ml-prefix-argument))) (defun ml-re-search-forward (string) (re-search-forward string nil nil (ml-prefix-argument))) (defun ml-search-backward (string) (search-backward string nil nil (ml-prefix-argument))) (defun ml-re-search-backward (string) (re-search-backward string nil nil (ml-prefix-argument))) (defvar use-users-shell 1 "Mocklisp compatibility variable; 1 means use shell from SHELL env var. 0 means use /bin/sh.") (defvar use-csh-option-f 1 "Mocklisp compatibility variable; 1 means pass -f when calling csh.") (defun filter-region (command) (let ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh")) (csh (equal (file-name-nondirectory shell) "csh"))) (call-process-region (point) (mark) shell t t nil (if (and csh use-csh-option-f) "-cf" "-c") (concat "exec " command)))) (defun execute-monitor-command (command) (let ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh")) (csh (equal (file-name-nondirectory shell) "csh"))) (call-process shell nil t t (if (and csh use-csh-option-f) "-cf" "-c") (concat "exec " command)))) (defun use-syntax-table (name) (set-syntax-table (symbol-value (intern (concat name "-syntax-table"))))) (defun line-to-top-of-window () (recenter (1- (ml-prefix-argument)))) (defun ml-previous-page (&optional arg) (let ((count (or arg (ml-prefix-argument)))) (while (> count 0) (scroll-down nil) (setq count (1- count))) (while (< count 0) (scroll-up nil) (setq count (1+ count))))) (defun ml-next-page () (previous-page (- (ml-prefix-argument)))) (defun page-next-window (&optional arg) (let ((count (or arg (ml-prefix-argument)))) (while (> count 0) (scroll-other-window nil) (setq count (1- count))) (while (< count 0) (scroll-other-window '-) (setq count (1+ count))))) (defun ml-next-window () (select-window (next-window))) (defun ml-previous-window () (select-window (previous-window))) (defun scroll-one-line-up () (scroll-up (ml-prefix-argument))) (defun scroll-one-line-down () (scroll-down (ml-prefix-argument))) (defun split-current-window () (split-window (selected-window))) (defun last-key-struck () last-command-char) (defun execute-mlisp-line (string) (eval (read string))) (defun move-dot-to-x-y (x y) (goto-char (window-start (selected-window))) (vertical-motion (1- y)) (move-to-column (1- x))) (defun ml-modify-syntax-entry (string) (let ((i 5) (len (length string)) (datastring (substring string 0 2))) (if (= (aref string 0) ?\-) (aset datastring 0 ?\ )) (if (= (aref string 2) ?\{) (if (= (aref string 4) ?\ ) (aset datastring 0 ?\<) (error "Two-char comment delimiter: use modify-syntax-entry directly"))) (if (= (aref string 3) ?\}) (if (= (aref string 4) ?\ ) (aset datastring 0 ?\>) (error "Two-char comment delimiter: use modify-syntax-entry directly"))) (while (< i len) (modify-syntax-entry (aref string i) datastring) (setq i (1+ i)) (if (and (< i len) (= (aref string i) ?\-)) (let ((c (aref string (1- i))) (lim (aref string (1+ i)))) (while (<= c lim) (modify-syntax-entry c datastring) (setq c (1+ c))) (setq i (+ 2 i))))))) (defun ml-substr (string from to) (let ((length (length string))) (if (< from 0) (setq from (+ from length))) (if (< to 0) (setq to (+ to length))) (substring string from (+ from to)))) (defun ml-concat (&rest args) (let ((newargs nil) this) (while args (setq this (car args)) (if (numberp this) (setq this (number-to-string this))) (setq newargs (cons this newargs) args (cdr args))) (apply 'concat (nreverse newargs)))) (provide 'mlsupport) ;;; mlsupport.el ends here emacs-19.30/lisp/modula2.el100444 12120 1 31125 6020124104 13743 0ustar rmsdaemon;;; modula2.el --- Modula-2 editing support package ;; Author: Michael Schmidt ;; Tom Perrine ;; Keywords: languages ;; The authors distributed this without a copyright notice ;; back in 1988, so it is in the public domain. The original included ;; the following credit: ;; Author Mick Jordan ;; amended Peter Robinson ;;; Commentary: ;; A major mode for editing Modula-2 code. It provides convenient abbrevs ;; for Modula-2 keywords, knows about the standard layout rules, and supports ;; a native compile command. ;;; Code: ;;; Added by Tom Perrine (TEP) (defvar m2-mode-syntax-table nil "Syntax table in use in Modula-2 buffers.") (defvar m2-compile-command "m2c" "Command to compile Modula-2 programs") (defvar m2-link-command "m2l" "Command to link Modula-2 programs") (defvar m2-link-name nil "Name of the executable.") (if m2-mode-syntax-table () (let ((table (make-syntax-table))) (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?\( ". 1" table) (modify-syntax-entry ?\) ". 4" table) (modify-syntax-entry ?* ". 23" table) (modify-syntax-entry ?+ "." table) (modify-syntax-entry ?- "." table) (modify-syntax-entry ?= "." table) (modify-syntax-entry ?% "." table) (modify-syntax-entry ?< "." table) (modify-syntax-entry ?> "." table) (modify-syntax-entry ?\' "\"" table) (setq m2-mode-syntax-table table))) ;;; Added by TEP (defvar m2-mode-map nil "Keymap used in Modula-2 mode.") (if m2-mode-map () (let ((map (make-sparse-keymap))) (define-key map "\^i" 'm2-tab) (define-key map "\C-cb" 'm2-begin) (define-key map "\C-cc" 'm2-case) (define-key map "\C-cd" 'm2-definition) (define-key map "\C-ce" 'm2-else) (define-key map "\C-cf" 'm2-for) (define-key map "\C-ch" 'm2-header) (define-key map "\C-ci" 'm2-if) (define-key map "\C-cm" 'm2-module) (define-key map "\C-cl" 'm2-loop) (define-key map "\C-co" 'm2-or) (define-key map "\C-cp" 'm2-procedure) (define-key map "\C-c\C-w" 'm2-with) (define-key map "\C-cr" 'm2-record) (define-key map "\C-cs" 'm2-stdio) (define-key map "\C-ct" 'm2-type) (define-key map "\C-cu" 'm2-until) (define-key map "\C-cv" 'm2-var) (define-key map "\C-cw" 'm2-while) (define-key map "\C-cx" 'm2-export) (define-key map "\C-cy" 'm2-import) (define-key map "\C-c{" 'm2-begin-comment) (define-key map "\C-c}" 'm2-end-comment) (define-key map "\C-j" 'm2-newline) (define-key map "\C-c\C-z" 'suspend-emacs) (define-key map "\C-c\C-v" 'm2-visit) (define-key map "\C-c\C-t" 'm2-toggle) (define-key map "\C-c\C-l" 'm2-link) (define-key map "\C-c\C-c" 'm2-compile) (setq m2-mode-map map))) (defvar m2-indent 5 "*This variable gives the indentation in Modula-2-Mode") ;;;###autoload (defun modula-2-mode () "This is a mode intended to support program development in Modula-2. All control constructs of Modula-2 can be reached by typing C-c followed by the first character of the construct. \\ \\[m2-begin] begin \\[m2-case] case \\[m2-definition] definition \\[m2-else] else \\[m2-for] for \\[m2-header] header \\[m2-if] if \\[m2-module] module \\[m2-loop] loop \\[m2-or] or \\[m2-procedure] procedure Control-c Control-w with \\[m2-record] record \\[m2-stdio] stdio \\[m2-type] type \\[m2-until] until \\[m2-var] var \\[m2-while] while \\[m2-export] export \\[m2-import] import \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment \\[suspend-emacs] suspend Emacs \\[m2-toggle] toggle \\[m2-compile] compile \\[m2-next-error] next-error \\[m2-link] link `m2-indent' controls the number of spaces for each indentation. `m2-compile-command' holds the command to compile a Modula-2 program. `m2-link-command' holds the command to link a Modula-2 program." (interactive) (kill-all-local-variables) (use-local-map m2-mode-map) (setq major-mode 'modula-2-mode) (setq mode-name "Modula-2") (make-local-variable 'comment-column) (setq comment-column 41) (make-local-variable 'end-comment-column) (setq end-comment-column 75) (set-syntax-table m2-mode-syntax-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) ; (make-local-variable 'indent-line-function) ; (setq indent-line-function 'c-indent-line) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'comment-start) (setq comment-start "(* ") (make-local-variable 'comment-end) (setq comment-end " *)") (make-local-variable 'comment-column) (setq comment-column 41) (make-local-variable 'comment-start-skip) (setq comment-start-skip "/\\*+ *") (make-local-variable 'comment-indent-function) (setq comment-indent-function 'c-comment-indent) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (run-hooks 'm2-mode-hook)) (defun m2-newline () "Insert a newline and indent following line like previous line." (interactive) (let ((hpos (current-indentation))) (newline) (indent-to hpos))) (defun m2-tab () "Indent to next tab stop." (interactive) (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent))) (defun m2-begin () "Insert a BEGIN keyword and indent for the next line." (interactive) (insert "BEGIN") (m2-newline) (m2-tab)) (defun m2-case () "Build skeleton CASE statment, prompting for the ." (interactive) (let ((name (read-string "Case-Expression: "))) (insert "CASE " name " OF") (m2-newline) (m2-newline) (insert "END (* case " name " *);")) (end-of-line 0) (m2-tab)) (defun m2-definition () "Build skeleton DEFINITION MODULE, prompting for the ." (interactive) (insert "DEFINITION MODULE ") (let ((name (read-string "Name: "))) (insert name ";\n\n\n\nEND " name ".\n")) (previous-line 3)) (defun m2-else () "Insert ELSE keyword and indent for next line." (interactive) (m2-newline) (backward-delete-char-untabify m2-indent ()) (insert "ELSE") (m2-newline) (m2-tab)) (defun m2-for () "Build skeleton FOR loop statment, prompting for the loop parameters." (interactive) (insert "FOR ") (let ((name (read-string "Loop Initialiser: ")) limit by) (insert name " TO ") (setq limit (read-string "Limit: ")) (insert limit) (setq by (read-string "Step: ")) (if (not (string-equal by "")) (insert " BY " by)) (insert " DO") (m2-newline) (m2-newline) (insert "END (* for " name " to " limit " *);")) (end-of-line 0) (m2-tab)) (defun m2-header () "Insert a comment block containing the module title, author, etc." (interactive) (insert "(*\n Title: \t") (insert (read-string "Title: ")) (insert "\n Created:\t") (insert (current-time-string)) (insert "\n Author: \t") (insert (user-full-name)) (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n")) (insert "*)\n\n")) (defun m2-if () "Insert skeleton IF statment, prompting for ." (interactive) (insert "IF ") (let ((thecondition (read-string ": "))) (insert thecondition " THEN") (m2-newline) (m2-newline) (insert "END (* if " thecondition " *);")) (end-of-line 0) (m2-tab)) (defun m2-loop () "Build skeleton LOOP (with END)." (interactive) (insert "LOOP") (m2-newline) (m2-newline) (insert "END (* loop *);") (end-of-line 0) (m2-tab)) (defun m2-module () "Build skeleton IMPLEMENTATION MODULE, prompting for ." (interactive) (insert "IMPLEMENTATION MODULE ") (let ((name (read-string "Name: "))) (insert name ";\n\n\n\nEND " name ".\n") (previous-line 3) (m2-header) (m2-type) (newline) (m2-var) (newline) (m2-begin) (m2-begin-comment) (insert " Module " name " Initialisation Code ")) (m2-end-comment) (newline) (m2-tab)) (defun m2-or () (interactive) (m2-newline) (backward-delete-char-untabify m2-indent) (insert "|") (m2-newline) (m2-tab)) (defun m2-procedure () (interactive) (insert "PROCEDURE ") (let ((name (read-string "Name: " )) args) (insert name " (") (insert (read-string "Arguments: ") ")") (setq args (read-string "Result Type: ")) (if (not (string-equal args "")) (insert " : " args)) (insert ";") (m2-newline) (insert "BEGIN") (m2-newline) (m2-newline) (insert "END ") (insert name) (insert ";") (end-of-line 0) (m2-tab))) (defun m2-with () (interactive) (insert "WITH ") (let ((name (read-string "Record-Type: "))) (insert name) (insert " DO") (m2-newline) (m2-newline) (insert "END (* with " name " *);")) (end-of-line 0) (m2-tab)) (defun m2-record () (interactive) (insert "RECORD") (m2-newline) (m2-newline) (insert "END (* record *);") (end-of-line 0) (m2-tab)) (defun m2-stdio () (interactive) (insert " FROM TextIO IMPORT WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER, WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN, WriteREAL, ReadREAL, WriteBITSET, ReadBITSET, WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars, WriteString, ReadString, WhiteSpace, EndOfLine; FROM SysStreams IMPORT sysIn, sysOut, sysErr; ")) (defun m2-type () (interactive) (insert "TYPE") (m2-newline) (m2-tab)) (defun m2-until () (interactive) (insert "REPEAT") (m2-newline) (m2-newline) (insert "UNTIL ") (insert (read-string ": ") ";") (end-of-line 0) (m2-tab)) (defun m2-var () (interactive) (m2-newline) (insert "VAR") (m2-newline) (m2-tab)) (defun m2-while () (interactive) (insert "WHILE ") (let ((name (read-string ": "))) (insert name " DO" ) (m2-newline) (m2-newline) (insert "END (* while " name " *);")) (end-of-line 0) (m2-tab)) (defun m2-export () (interactive) (insert "EXPORT QUALIFIED ")) (defun m2-import () (interactive) (insert "FROM ") (insert (read-string "Module: ")) (insert " IMPORT ")) (defun m2-begin-comment () (interactive) (if (not (bolp)) (indent-to comment-column 0)) (insert "(* ")) (defun m2-end-comment () (interactive) (if (not (bolp)) (indent-to end-comment-column)) (insert "*)")) (defun m2-compile () (interactive) (setq modulename (buffer-name)) (compile (concat m2-compile-command " " modulename))) (defun m2-link () (interactive) (setq modulename (buffer-name)) (if m2-link-name (compile (concat m2-link-command " " m2-link-name)) (compile (concat m2-link-command " " (setq m2-link-name (read-string "Name of executable: " modulename)))))) (defun m2-execute-monitor-command (command) (let* ((shell shell-file-name) (csh (equal (file-name-nondirectory shell) "csh"))) (call-process shell nil t t "-cf" (concat "exec " command)))) (defun m2-visit () (interactive) (let ((deffile nil) (modfile nil) modulename) (save-excursion (setq modulename (read-string "Module name: ")) (switch-to-buffer "*Command Execution*") (m2-execute-monitor-command (concat "m2whereis " modulename)) (goto-char (point-min)) (condition-case () (progn (re-search-forward "\\(.*\\.def\\) *$") (setq deffile (buffer-substring (match-beginning 1) (match-end 1)))) (search-failed ())) (condition-case () (progn (re-search-forward "\\(.*\\.mod\\) *$") (setq modfile (buffer-substring (match-beginning 1) (match-end 1)))) (search-failed ())) (if (not (or deffile modfile)) (error "I can find neither definition nor implementation of %s" modulename))) (cond (deffile (find-file deffile) (if modfile (save-excursion (find-file modfile)))) (modfile (find-file modfile))))) (defun m2-toggle () "Toggle between .mod and .def files for the module." (interactive) (cond ((string-equal (substring (buffer-name) -4) ".def") (find-file-other-window (concat (substring (buffer-name) 0 -4) ".mod"))) ((string-equal (substring (buffer-name) -4) ".mod") (find-file-other-window (concat (substring (buffer-name) 0 -4) ".def"))) ((string-equal (substring (buffer-name) -3) ".mi") (find-file-other-window (concat (substring (buffer-name) 0 -3) ".md"))) ((string-equal (substring (buffer-name) -3) ".md") (find-file-other-window (concat (substring (buffer-name) 0 -3) ".mi"))))) ;;; modula2.el ends here emacs-19.30/lisp/morse.el100444 12120 1 6342 6043626504 13530 0ustar rmsdaemon;;; morse.el --- Convert text to morse code and back. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Rick Farnbach ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (defvar morse-code '(("a" . ".-") ("b" . "-...") ("c" . "-.-.") ("d" . "-..") ("e" . ".") ("f" . "..-.") ("g" . "--.") ("h" . "....") ("i" . "..") ("j" . ".---") ("k" . "-.-") ("l" . ".-..") ("m" . "--") ("n" . "-.") ("o" . "---") ("p" . ".--.") ("q" . "--.-") ("r" . ".-.") ("s" . "...") ("t" . "-") ("u" . "..-") ("v" . "...-") ("w" . ".--") ("x" . "-..-") ("y" . "-.--") ("z" . "--..") ;; Punctuation ("=" . "-...-") ("?" . "..--..") ("/" . "-..-.") ("," . "--..--") ("." . ".-.-.-") (":" . "---...") ("'" . ".----.") ("-" . "-....-") ("(" . "-.--.-") (")" . "-.--.-") ;; Numbers ("0" . "-----") ("1" . ".----") ("2" . "..---") ("3" . "...--") ("4" . "....-") ("5" . ".....") ("6" . "-....") ("7" . "--...") ("8" . "---..") ("9" . "----.")) "Morse code character set.") (defun morse-region (beg end) "Convert all text in a given region to morse code." (interactive "r") (if (integerp end) (setq end (copy-marker end))) (save-excursion (let ((sep "") str morse) (goto-char beg) (while (< (point) end) (setq str (downcase (buffer-substring (point) (1+ (point))))) (cond ((looking-at "\\s-+") (goto-char (match-end 0)) (setq sep "")) ((setq morse (assoc str morse-code)) (delete-char 1) (insert sep (cdr morse)) (setq sep "/")) (t (forward-char 1) (setq sep ""))))))) (defun unmorse-region (beg end) "Convert morse coded text in region to ordinary ASCII text." (interactive "r") (if (integerp end) (setq end (copy-marker end))) (save-excursion (let (str paren morse) (goto-char beg) (while (< (point) end) (if (null (looking-at "[-.]+")) (forward-char 1) (setq str (buffer-substring (match-beginning 0) (match-end 0))) (if (null (setq morse (rassoc str morse-code))) (goto-char (match-end 0)) (replace-match (if (string-equal "(" (car morse)) (if (setq paren (null paren)) "(" ")") (car morse)) t) (if (looking-at "/") (delete-char 1)))))))) (provide 'morse) ;;; morse.el ends here emacs-19.30/lisp/mouse-sel.el100444 12120 1 53641 6052425504 14335 0ustar rmsdaemon;;; mouse-sel.el --- Multi-click selection support for Emacs 19 ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Mike Williams ;; Keywords: mouse ;; 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. ;;; Commentary: ;; ;; This module provides multi-click mouse support for GNU Emacs versions ;; 19.18 and later. I've tried to make it behave more like standard X ;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers. ;; Basically: ;; ;; * Clicking mouse-1 starts (cancels) selection, dragging extends it. ;; ;; * Clicking or dragging mouse-3 extends the selection as well. ;; ;; * Double-clicking on word constituents selects words. ;; Double-clicking on symbol constituents selects symbols. ;; Double-clicking on quotes or parentheses selects sexps. ;; Double-clicking on whitespace selects whitespace. ;; Triple-clicking selects lines. ;; Quad-clicking selects paragraphs. ;; ;; * Selecting sets the region & X primary selection, but does NOT affect ;; the kill-ring. Because the mouse handlers set the primary selection ;; directly, mouse-sel sets the variables interprogram-cut-function ;; and interprogram-paste-function to nil. ;; ;; * Clicking mouse-2 inserts the contents of the primary selection at ;; the mouse position (or point, if mouse-yank-at-point is non-nil). ;; ;; * Pressing mouse-2 while selecting or extending copies selection ;; to the kill ring. Pressing mouse-1 or mouse-3 kills it. ;; ;; * Double-clicking mouse-3 also kills selection. ;; ;; * M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2 ;; & mouse-3, but operate on the X secondary selection rather than the ;; primary selection and region. ;; ;; This module requires my thingatpt.el module, which it uses to find the ;; bounds of words, lines, sexps, etc. ;; ;; Thanks to KevinB@bartley.demon.co.uk for his useful input. ;; ;;--- Customisation ------------------------------------------------------- ;; ;; * You may want to use none or more of following: ;; ;; ;; Enable region highlight ;; (transient-mark-mode 1) ;; ;; ;; But only in the selected window ;; (setq highlight-nonselected-windows nil) ;; ;; ;; Enable pending-delete ;; (delete-selection-mode 1) ;; ;; * You can control the way mouse-sel binds its keys by setting the value ;; of mouse-sel-default-bindings before loading mouse-sel. ;; ;; (a) If mouse-sel-default-bindings = t (the default) ;; ;; Mouse sets and insert selection ;; mouse-1 mouse-select ;; mouse-2 mouse-insert-selection ;; mouse-3 mouse-extend ;; ;; Selection/kill-ring interaction is disabled ;; interprogram-cut-function = nil ;; interprogram-paste-function = nil ;; ;; (b) If mouse-sel-default-bindings = 'interprogram-cut-paste ;; ;; Mouse sets selection, and pastes from kill-ring ;; mouse-1 mouse-select ;; mouse-2 mouse-yank-at-click ;; mouse-3 mouse-extend ;; ;; Selection/kill-ring interaction is retained ;; interprogram-cut-function = x-select-text ;; interprogram-paste-function = x-cut-buffer-or-selection-value ;; ;; What you lose is the ability to select some text in ;; delete-selection-mode and yank over the top of it. ;; ;; (c) If mouse-sel-default-bindings = nil, no bindings are made. ;; ;; * By default, mouse-insert-selection (mouse-2) inserts the selection at ;; the mouse position. You can tell it to insert at point instead with: ;; ;; (setq mouse-yank-at-point t) ;; ;; * I like to leave point at the end of the region nearest to where the ;; mouse was, even though this makes region highlighting mis-leading (the ;; cursor makes it look like one extra character is selected). You can ;; disable this behaviour with: ;; ;; (setq mouse-sel-leave-point-near-mouse nil) ;; ;; * By default, mouse-select cycles the click count after 4 clicks. That ;; is, clicking mouse-1 five times has the same effect as clicking it ;; once, clicking six times has the same effect as clicking twice, etc. ;; Disable this behaviour with: ;; ;; (setq mouse-sel-cycle-clicks nil) ;; ;; * The variables mouse-sel-{set,get}-selection-function control how the ;; selection is handled. Under X Windows, these variables default so ;; that the X primary selection is used. Under other windowing systems, ;; alternate functions are used, which simply store the selection value ;; in a variable. ;; ;; * You can change the selection highlight face by altering the properties ;; of mouse-drag-overlay, eg. ;; ;; (overlay-put mouse-drag-overlay 'face 'bold) ;;; Code: ================================================================= (provide 'mouse-sel) (require 'mouse) (require 'thingatpt) ;;=== User Variables ====================================================== (defvar mouse-sel-leave-point-near-mouse t "*Leave point near last mouse position. If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end of the region nearest to where the mouse last was. If nil, point will always be placed at the beginning of the region.") (defvar mouse-sel-cycle-clicks t "*If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks.") (defvar mouse-sel-default-bindings t "Set to nil before loading `mouse-sel' to prevent default mouse bindings.") ;;=== Internal Variables/Constants ======================================== (defvar mouse-sel-primary-thing nil "Type of PRIMARY selection in current buffer.") (make-variable-buffer-local 'mouse-sel-primary-thing) (defvar mouse-sel-secondary-thing nil "Type of SECONDARY selection in current buffer.") (make-variable-buffer-local 'mouse-sel-secondary-thing) ;; Ensure that secondary overlay is defined (if (overlayp mouse-secondary-overlay) nil (setq mouse-secondary-overlay (make-overlay 1 1)) (overlay-put mouse-secondary-overlay 'face 'secondary-selection)) (defconst mouse-sel-selection-alist '((PRIMARY mouse-drag-overlay mouse-sel-primary-thing) (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing)) "Alist associating selections with variables. Each element is of the form: (SELECTION-NAME OVERLAY-SYMBOL SELECTION-THING-SYMBOL) where SELECTION-NAME = name of selection OVERLAY-SYMBOL = name of variable containing overlay to use SELECTION-THING-SYMBOL = name of variable where the current selection type for this selection should be stored.") (defvar mouse-sel-set-selection-function (if (fboundp 'x-set-selection) 'x-set-selection) "Function to call to set selection. Called with two arguments: SELECTION, the name of the selection concerned, and VALUE, the text to store.") (defvar mouse-sel-get-selection-function (if (fboundp 'x-get-selection) 'x-get-selection) "Function to call to get the selection. Called with one argument: SELECTION: the name of the selection concerned.") ;;=== Support/access functions ============================================ (defun mouse-sel-determine-selection-thing (nclicks) "Determine what `thing' `mouse-sel' should operate on. The first argument is NCLICKS, is the number of consecutive mouse clicks at the same position. Double-clicking on word constituents selects words. Double-clicking on symbol constituents selects symbols. Double-clicking on quotes or parentheses selects sexps. Double-clicking on whitespace selects whitespace. Triple-clicking selects lines. Quad-clicking selects paragraphs. Feel free to re-define this function to support your own desired multi-click semantics." (let* ((next-char (char-after (point))) (char-syntax (if next-char (char-syntax next-char)))) (if mouse-sel-cycle-clicks (setq nclicks (1+ (% (1- nclicks) 4)))) (cond ((= nclicks 1) nil) ((= nclicks 3) 'line) ((>= nclicks 4) 'paragraph) ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp) ((memq next-char '(? ?\t ?\n)) 'whitespace) ((eq char-syntax ?_) 'symbol) ((eq char-syntax ?w) 'word)))) (defun mouse-sel-set-selection (selection value) "Set the specified SELECTION to VALUE." (if mouse-sel-set-selection-function (funcall mouse-sel-set-selection-function selection value) (put 'mouse-sel-internal-selection selection value))) (defun mouse-sel-get-selection (selection) "Get the value of the specified SELECTION." (if mouse-sel-get-selection-function (funcall mouse-sel-get-selection-function selection) (get 'mouse-sel-internal-selection selection))) (defun mouse-sel-selection-overlay (selection) "Return overlay corresponding to SELECTION." (let ((symbol (nth 1 (assoc selection mouse-sel-selection-alist)))) (or symbol (error "No overlay corresponding to %s selection" selection)) (symbol-value symbol))) (defun mouse-sel-selection-thing (selection) "Return overlay corresponding to SELECTION." (let ((symbol (nth 2 (assoc selection mouse-sel-selection-alist)))) (or symbol (error "No symbol corresponding to %s selection" selection)) symbol)) (defun mouse-sel-region-to-primary (orig-window) "Convert region to PRIMARY overlay and deactivate region. Argument ORIG-WINDOW specifies the window the cursor was in when the originating command was issued, and is used to determine whether the region was visible or not." (if transient-mark-mode (let ((overlay (mouse-sel-selection-overlay 'PRIMARY))) (cond ((and mark-active (or highlight-nonselected-windows (eq orig-window (selected-window)))) ;; Region was visible, so convert region to overlay (move-overlay overlay (region-beginning) (region-end) (current-buffer))) ((eq orig-window (selected-window)) ;; Point was visible, so set overlay at point (move-overlay overlay (point) (point) (current-buffer))) (t ;; Nothing was visible, so remove overlay (delete-overlay overlay))) (setq mark-active nil)))) (defun mouse-sel-primary-to-region (&optional direction) "Convert PRIMARY overlay to region. Optional argument DIRECTION specifies the mouse drag direction: a value of 1 indicates that the mouse was dragged left-to-right, otherwise it was dragged right-to-left." (let* ((overlay (mouse-sel-selection-overlay 'PRIMARY)) (start (overlay-start overlay)) (end (overlay-end overlay))) (if (eq start end) (progn (if start (goto-char start)) (deactivate-mark)) (if (and mouse-sel-leave-point-near-mouse (eq direction 1)) (progn (goto-char end) (push-mark start 'nomsg 'active)) (goto-char start) (push-mark end 'nomsg 'active))) (if transient-mark-mode (delete-overlay overlay)))) (defmacro mouse-sel-eval-at-event-end (event &rest forms) "Evaluate forms at mouse position. Move to the end position of EVENT, execute FORMS, and restore original point and window." (` (let ((posn (event-end (, event)))) (if posn (mouse-minibuffer-check (, event))) (if (and posn (not (windowp (posn-window posn)))) (error "Cursor not in text area of window")) (let (orig-window orig-point-marker) (setq orig-window (selected-window)) (if posn (select-window (posn-window posn))) (setq orig-point-marker (point-marker)) (if (and posn (numberp (posn-point posn))) (goto-char (posn-point posn))) (unwind-protect (progn (,@ forms)) (goto-char (marker-position orig-point-marker)) (move-marker orig-point-marker nil) (select-window orig-window) ))))) (put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1) ;;=== Select ============================================================== (defun mouse-select (event) "Set region/selection using the mouse. Click sets point & mark to click position. Dragging extends region/selection. Multi-clicking selects word/lines/paragraphs, as determined by 'mouse-sel-determine-selection-thing. Clicking mouse-2 while selecting copies selected text to the kill-ring. Clicking mouse-1 or mouse-3 kills the selected text. This should be bound to a down-mouse event." (interactive "@e") (let (direction) (unwind-protect (setq direction (mouse-select-internal 'PRIMARY event)) (mouse-sel-primary-to-region direction)))) (defun mouse-select-secondary (event) "Set secondary selection using the mouse. Click sets the start of the secondary selection to click position. Dragging extends the secondary selection. Multi-clicking selects word/lines/paragraphs, as determined by 'mouse-sel-determine-selection-thing. Clicking mouse-2 while selecting copies selected text to the kill-ring. Clicking mouse-1 or mouse-3 kills the selected text. This should be bound to a down-mouse event." (interactive "e") (mouse-select-internal 'SECONDARY event)) (defun mouse-select-internal (selection event) "Set SELECTION using the mouse." (mouse-sel-eval-at-event-end event (let ((thing-symbol (mouse-sel-selection-thing selection)) (overlay (mouse-sel-selection-overlay selection))) (set thing-symbol (mouse-sel-determine-selection-thing (event-click-count event))) (let ((object-bounds (bounds-of-thing-at-point (symbol-value thing-symbol)))) (if object-bounds (progn (move-overlay overlay (car object-bounds) (cdr object-bounds) (current-buffer))) (move-overlay overlay (point) (point) (current-buffer))))) (mouse-extend-internal selection))) ;;=== Extend ============================================================== (defun mouse-extend (event) "Extend region/selection using the mouse." (interactive "e") (let ((orig-window (selected-window)) direction) (select-window (posn-window (event-end event))) (unwind-protect (progn (mouse-sel-region-to-primary orig-window) (setq direction (mouse-extend-internal 'PRIMARY event))) (mouse-sel-primary-to-region direction)))) (defun mouse-extend-secondary (event) "Extend secondary selection using the mouse." (interactive "e") (save-window-excursion (mouse-extend-internal 'SECONDARY event))) (defun mouse-extend-internal (selection &optional initial-event) "Extend specified SELECTION using the mouse. Track mouse-motion events, adjusting the SELECTION appropriately. Optional argument INITIAL-EVENT specifies an initial down-mouse event to process. See documentation for mouse-select-internal for more details." (mouse-sel-eval-at-event-end initial-event (let ((orig-cursor-type (cdr (assoc 'cursor-type (frame-parameters (selected-frame)))))) (unwind-protect (let* ((thing-symbol (mouse-sel-selection-thing selection)) (overlay (mouse-sel-selection-overlay selection)) (orig-window (selected-window)) (orig-window-frame (window-frame orig-window)) (top (nth 1 (window-edges orig-window))) (bottom (nth 3 (window-edges orig-window))) (mark-active nil) ; inhibit normal region highlight (echo-keystrokes 0) ; don't echo mouse events min max direction event) ;; Get current bounds of overlay (if (eq (overlay-buffer overlay) (current-buffer)) (setq min (overlay-start overlay) max (overlay-end overlay)) (setq min (point) max min) (set thing-symbol nil)) ;; Bar cursor (if (fboundp 'modify-frame-parameters) (modify-frame-parameters (selected-frame) '((cursor-type . bar)))) ;; Handle dragging (track-mouse (while (if initial-event ; Use initial event (prog1 (setq event initial-event) (setq initial-event nil)) (setq event (read-event)) (and (consp event) (memq (car event) '(mouse-movement switch-frame)))) (let ((selection-thing (symbol-value thing-symbol)) (end (event-end event))) (cond ;; Ignore any movement outside the frame ((eq (car-safe event) 'switch-frame) nil) ((and (posn-window end) (not (eq (let ((posn-w (posn-window end))) (if (windowp posn-w) (window-frame posn-w) posn-w)) (window-frame orig-window)))) nil) ;; Different window, same frame ((not (eq (posn-window end) orig-window)) (let ((end-row (cdr (cdr (mouse-position))))) (cond ((and end-row (not (bobp)) (< end-row top)) (mouse-scroll-subr orig-window (- end-row top) overlay max)) ((and end-row (not (eobp)) (>= end-row bottom)) (mouse-scroll-subr orig-window (1+ (- end-row bottom)) overlay min)) ))) ;; On the mode line ((eq (posn-point end) 'mode-line) (mouse-scroll-subr orig-window 1 overlay min)) ;; In original window (t (goto-char (posn-point end))) ) ;; Determine direction of drag (cond ((and (not direction) (not (eq min max))) (setq direction (if (< (point) (/ (+ min max) 2)) -1 1))) ((and (not (eq direction -1)) (<= (point) min)) (setq direction -1)) ((and (not (eq direction 1)) (>= (point) max)) (setq direction 1))) (if (not selection-thing) nil ;; If dragging forward, goal is next character (if (and (eq direction 1) (not (eobp))) (forward-char 1)) ;; Move to start/end of selected thing (let ((goal (point))) (goto-char (if (eq 1 direction) min max)) (condition-case nil (progn (while (> (* direction (- goal (point))) 0) (forward-thing selection-thing direction)) (let ((end (point))) (forward-thing selection-thing (- direction)) (goto-char (if (> (* direction (- goal (point))) 0) end (point))))) (error)))) ;; Move overlay (move-overlay overlay (if (eq 1 direction) min (point)) (if (eq -1 direction) max (point)) (current-buffer)) ))) ; end track-mouse ;; Finish up after dragging (let ((overlay-start (overlay-start overlay)) (overlay-end (overlay-end overlay))) ;; Set selection (if (not (eq overlay-start overlay-end)) (mouse-sel-set-selection selection (buffer-substring overlay-start overlay-end))) ;; Handle copy/kill (let (this-command) (cond ((eq (event-basic-type last-input-event) 'mouse-2) (copy-region-as-kill overlay-start overlay-end) (read-event) (read-event)) ((and (memq (event-basic-type last-input-event) '(mouse-1 mouse-3)) (memq 'down (event-modifiers last-input-event))) (kill-region overlay-start overlay-end) (move-overlay overlay overlay-start overlay-start) (read-event) (read-event)) ((and (eq (event-basic-type last-input-event) 'mouse-3) (memq 'double (event-modifiers last-input-event))) (kill-region overlay-start overlay-end) (move-overlay overlay overlay-start overlay-start))))) direction) ;; Restore cursor (if (fboundp 'modify-frame-parameters) (modify-frame-parameters (selected-frame) (list (cons 'cursor-type orig-cursor-type)))) )))) ;;=== Paste =============================================================== (defun mouse-insert-selection (event) "Insert the contents of the PRIMARY selection at mouse click. If `mouse-yank-at-point' is non-nil, insert at point instead." (interactive "e") (mouse-insert-selection-internal 'PRIMARY event)) (defun mouse-insert-secondary (event) "Insert the contents of the SECONDARY selection at mouse click. If `mouse-yank-at-point' is non-nil, insert at point instead." (interactive "e") (mouse-insert-selection-internal 'SECONDARY event)) (defun mouse-insert-selection-internal (selection event) "Insert the contents of the named SELECTION at mouse click. If `mouse-yank-at-point' is non-nil, insert at point instead." (or mouse-yank-at-point (mouse-set-point event)) (if mouse-sel-get-selection-function (progn (push-mark (point) 'nomsg) (insert (or (funcall mouse-sel-get-selection-function selection) ""))))) ;;=== Handle loss of selections =========================================== (defun mouse-sel-lost-selection-hook (selection) "Remove the overlay for a lost selection." (let ((overlay (mouse-sel-selection-overlay selection))) (delete-overlay overlay))) (add-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook) ;;=== Key bindings ======================================================== (if (not mouse-sel-default-bindings) nil (global-unset-key [mouse-1]) (global-unset-key [drag-mouse-1]) (global-unset-key [mouse-3]) (global-set-key [down-mouse-1] 'mouse-select) (global-set-key [down-mouse-3] 'mouse-extend) (global-unset-key [M-mouse-1]) (global-unset-key [M-drag-mouse-1]) (global-unset-key [M-mouse-3]) (global-set-key [M-down-mouse-1] 'mouse-select-secondary) (global-set-key [M-down-mouse-3] 'mouse-extend-secondary) (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) nil (global-set-key [mouse-2] 'mouse-insert-selection) (setq interprogram-cut-function nil interprogram-paste-function nil)) (global-set-key [M-mouse-2] 'mouse-insert-secondary) ) ;;=== Bug reporting ======================================================= (defconst mouse-sel-maintainer-address "mikew@gopher.dosli.govt.nz") (defun mouse-sel-submit-bug-report () "Submit a bug report on mouse-sel.el via mail." (interactive) (require 'reporter) (reporter-submit-bug-report mouse-sel-maintainer-address (concat "mouse-sel.el " (or (condition-case nil mouse-sel-version (error)) "(distributed with Emacs)")) (list 'transient-mark-mode 'delete-selection-mode 'mouse-sel-default-bindings 'mouse-sel-leave-point-near-mouse 'mouse-sel-cycle-clicks 'mouse-sel-selection-alist 'mouse-sel-set-selection-function 'mouse-sel-get-selection-function 'mouse-yank-at-point))) ;; mouse-sel.el ends here. emacs-19.30/lisp/mouse.el100444 12120 1 200706 6054455303 13572 0ustar rmsdaemon;;; mouse.el --- window system-independent mouse support ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: hardware ;; 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 package provides various useful commands (including help ;; system access) through the mouse. All this code assumes that mouse ;; interpretation has been abstracted into Emacs input events. ;; ;; The code is rather X-dependent. ;;; Code: ;;; Utility functions. ;;; Indent track-mouse like progn. (put 'track-mouse 'lisp-indent-function 0) (defvar mouse-yank-at-point nil "*If non-nil, mouse yank commands yank at point instead of at click.") ;; Provide a mode-specific menu on a mouse button. (defun mouse-major-mode-menu (event) "Pop up a mode-specific menu of mouse commands." ;; Switch to the window clicked on, because otherwise ;; the mode's commands may not make sense. (interactive "@e") (let ((newmap (make-sparse-keymap)) (unread-command-events (list event))) ;; Make a keymap in which our last command leads to a menu (define-key newmap (vector (car event)) (nconc (make-sparse-keymap "Menu") (mouse-major-mode-menu-1 (and (current-local-map) (lookup-key (current-local-map) [menu-bar]))))) (mouse-major-mode-menu-compute-equiv-keys newmap) ;; Make NEWMAP override the usual definition ;; of the mouse button that got us here. ;; Then read the user's menu choice. (let* ((minor-mode-map-alist (cons (cons t newmap) minor-mode-map-alist)) ;; read-key-sequence quits if the user aborts the menu. ;; If that happens, do nothing silently. (keyseq (condition-case nil (read-key-sequence "") (quit nil))) (command (if keyseq (lookup-key newmap keyseq)))) (if command (command-execute command))))) ;; Compute and cache the equivalent keys in MENU and all its submenus. (defun mouse-major-mode-menu-compute-equiv-keys (menu) (and (eq (car menu) 'keymap) (x-popup-menu nil menu)) (while menu (and (consp (car menu)) (consp (cdr (car menu))) (let ((tail (cdr (car menu)))) (while (and (consp tail) (not (eq (car tail) 'keymap))) (setq tail (cdr tail))) (if (consp tail) (mouse-major-mode-menu-compute-equiv-keys tail)))) (setq menu (cdr menu)))) ;; Given a mode's menu bar keymap, ;; if it defines exactly one menu bar menu, ;; return just that menu. ;; Otherwise return a menu for all of them. (defun mouse-major-mode-menu-1 (menubar) (if menubar (let ((tail menubar) submap) (while tail (if (consp (car tail)) (if submap (setq submap t) (setq submap (cdr (car tail))))) (setq tail (cdr tail))) (if (eq submap t) menubar submap)))) ;; Commands that operate on windows. (defun mouse-minibuffer-check (event) (let ((w (posn-window (event-start event)))) (and (window-minibuffer-p w) (not (minibuffer-window-active-p w)) (error "Minibuffer window is not active"))) ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook)) (defun mouse-delete-window (click) "Delete the window you click on. This must be bound to a mouse click." (interactive "e") (mouse-minibuffer-check click) (delete-window (posn-window (event-start click)))) (defun mouse-select-window (click) "Select the window clicked on; don't move point." (interactive "e") (mouse-minibuffer-check click) (let ((oframe (selected-frame)) (frame (window-frame (posn-window (event-start click))))) (select-window (posn-window (event-start click))) (raise-frame frame) (select-frame frame) (or (eq frame oframe) (set-mouse-position (selected-frame) (1- (frame-width)) 0)) (unfocus-frame))) (defun mouse-tear-off-window (click) "Delete the window clicked on, and create a new frame displaying its buffer." (interactive "e") (mouse-minibuffer-check click) (let* ((window (posn-window (event-start click))) (buf (window-buffer window)) (frame (make-frame))) (select-frame frame) (switch-to-buffer buf) (delete-window window))) (defun mouse-delete-other-windows () "Delete all window except the one you click on." (interactive "@") (delete-other-windows)) (defun mouse-split-window-vertically (click) "Select Emacs window mouse is on, then split it vertically in half. The window is split at the line clicked on. This command must be bound to a mouse click." (interactive "@e") (mouse-minibuffer-check click) (let ((start (event-start click))) (select-window (posn-window start)) (let ((new-height (1+ (cdr (posn-col-row (event-end click))))) (first-line window-min-height) (last-line (- (window-height) window-min-height))) (if (< last-line first-line) (error "Window too short to split") (split-window-vertically (min (max new-height first-line) last-line)))))) (defun mouse-split-window-horizontally (click) "Select Emacs window mouse is on, then split it horizontally in half. The window is split at the column clicked on. This command must be bound to a mouse click." (interactive "@e") (mouse-minibuffer-check click) (let ((start (event-start click))) (select-window (posn-window start)) (let ((new-width (1+ (car (posn-col-row (event-end click))))) (first-col window-min-width) (last-col (- (window-width) window-min-width))) (if (< last-col first-col) (error "Window too narrow to split") (split-window-horizontally (min (max new-width first-col) last-col)))))) (defun mouse-drag-mode-line (start-event) "Change the height of a window by dragging on the mode line." (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (let ((done nil) (echo-keystrokes 0) (start-event-frame (window-frame (car (car (cdr start-event))))) (start-event-window (car (car (cdr start-event)))) (start-nwindows (count-windows t)) (old-selected-window (selected-window)) should-enlarge-minibuffer event mouse minibuffer y top bot edges wconfig params growth) (setq params (frame-parameters)) (if (and (not (setq minibuffer (cdr (assq 'minibuffer params)))) (one-window-p t)) (error "Attempt to resize sole window")) (track-mouse (progn ;; enlarge-window only works on the selected window, so ;; we must select the window where the start event originated. ;; unwind-protect will restore the old selected window later. (select-window start-event-window) ;; if this is the bottommost ordinary window, then to ;; move its modeline the minibuffer must be enlarged. (setq should-enlarge-minibuffer (and minibuffer (not (one-window-p t)) (= (nth 1 (window-edges minibuffer)) (nth 3 (window-edges))))) ;; loop reading events and sampling the position of ;; the mouse. (while (not done) (setq event (read-event) mouse (mouse-position)) ;; do nothing if ;; - there is a switch-frame event. ;; - the mouse isn't in the frame that we started in ;; - the mouse isn't in any Emacs frame ;; drag if ;; - there is a mouse-movement event ;; - there is a scroll-bar-movement event ;; (same as mouse movement for our purposes) ;; quit if ;; - there is a keyboard event or some other unknown event ;; unknown event. (cond ((integerp event) (setq done t)) ((eq (car event) 'switch-frame) nil) ((not (memq (car event) '(mouse-movement scroll-bar-movement))) (if (consp event) (setq unread-command-events (cons event unread-command-events))) (setq done t)) ((not (eq (car mouse) start-event-frame)) nil) ((null (car (cdr mouse))) nil) (t (setq y (cdr (cdr mouse)) edges (window-edges) top (nth 1 edges) bot (nth 3 edges)) ;; scale back a move that would make the ;; window too short. (cond ((< (- y top -1) window-min-height) (setq y (+ top window-min-height -1)))) ;; compute size change needed (setq growth (- y bot -1) wconfig (current-window-configuration)) ;; grow/shrink minibuffer? (if should-enlarge-minibuffer (progn ;; yes. briefly select minibuffer so ;; enlarge-window will affect the ;; correct window. (select-window minibuffer) ;; scale back shrinkage if it would ;; make the minibuffer less than 1 ;; line tall. (if (and (> growth 0) (< (- (window-height minibuffer) growth) 1)) (setq growth (1- (window-height minibuffer)))) (enlarge-window (- growth)) (select-window start-event-window)) ;; no. grow/shrink the selected window (enlarge-window growth)) ;; if this window's growth caused another ;; window to be deleted because it was too ;; short, rescind the change. ;; ;; if size change caused space to be stolen ;; from a window above this one, rescind the ;; change, but only if we didn't grow/srhink ;; the minibuffer. minibuffer size changes ;; can cause all windows to shrink... no way ;; around it. (if (or (/= start-nwindows (count-windows t)) (and (not should-enlarge-minibuffer) (/= top (nth 1 (window-edges))))) (set-window-configuration wconfig))))))))) (defun mouse-drag-vertical-line (start-event) "Change the width of a window by dragging on the vertical line." (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (let ((done nil) (echo-keystrokes 0) (start-event-frame (window-frame (car (car (cdr start-event))))) (start-event-window (car (car (cdr start-event)))) (start-nwindows (count-windows t)) (old-selected-window (selected-window)) event mouse x left right edges wconfig growth) (if (one-window-p t) (error "Attempt to resize sole ordinary window")) (if (= (nth 2 (window-edges start-event-window)) (frame-width start-event-frame)) (error "Attempt to drag rightmost scrollbar")) (track-mouse (progn ;; enlarge-window only works on the selected window, so ;; we must select the window where the start event originated. ;; unwind-protect will restore the old selected window later. (select-window start-event-window) ;; loop reading events and sampling the position of ;; the mouse. (while (not done) (setq event (read-event) mouse (mouse-position)) ;; do nothing if ;; - there is a switch-frame event. ;; - the mouse isn't in the frame that we started in ;; - the mouse isn't in any Emacs frame ;; drag if ;; - there is a mouse-movement event ;; - there is a scroll-bar-movement event ;; (same as mouse movement for our purposes) ;; quit if ;; - there is a keyboard event or some other unknown event ;; unknown event. (cond ((integerp event) (setq done t)) ((eq (car event) 'switch-frame) nil) ((not (memq (car event) '(mouse-movement scroll-bar-movement))) (if (consp event) (setq unread-command-events (cons event unread-command-events))) (setq done t)) ((not (eq (car mouse) start-event-frame)) nil) ((null (car (cdr mouse))) nil) (t (setq x (car (cdr mouse)) edges (window-edges) left (nth 0 edges) right (nth 2 edges)) ;; scale back a move that would make the ;; window too thin. (cond ((< (- x left -1) window-min-width) (setq x (+ left window-min-width -1)))) ;; compute size change needed (setq growth (- x right -1) wconfig (current-window-configuration)) (enlarge-window growth t) ;; if this window's growth caused another ;; window to be deleted because it was too ;; thin, rescind the change. ;; ;; if size change caused space to be stolen ;; from a window to the left of this one, ;; rescind the change. (if (or (/= start-nwindows (count-windows t)) (/= left (nth 0 (window-edges)))) (set-window-configuration wconfig))))))))) (defun mouse-set-point (event) "Move point to the position clicked on with the mouse. This should be bound to a mouse click event type." (interactive "e") (mouse-minibuffer-check event) ;; Use event-end in case called from mouse-drag-region. ;; If EVENT is a click, event-end and event-start give same value. (let ((posn (event-end event))) (if (not (windowp (posn-window posn))) (error "Cursor not in text area of window")) (select-window (posn-window posn)) (if (numberp (posn-point posn)) (goto-char (posn-point posn))))) (defvar mouse-last-region-beg nil) (defvar mouse-last-region-end nil) (defvar mouse-last-region-tick nil) (defun mouse-region-match () "Return non-nil if there's an active region that was set with the mouse." (and (mark t) mark-active (eq mouse-last-region-beg (region-beginning)) (eq mouse-last-region-end (region-end)) (eq mouse-last-region-tick (buffer-modified-tick)))) (defun mouse-set-region (click) "Set the region to the text dragged over, and copy to kill ring. This should be bound to a mouse drag event." (interactive "e") (mouse-minibuffer-check click) (let ((posn (event-start click)) (end (event-end click))) (select-window (posn-window posn)) (if (numberp (posn-point posn)) (goto-char (posn-point posn))) ;; If mark is highlighted, no need to bounce the cursor. ;; On X, we highlight while dragging, thus once again no need to bounce. (or transient-mark-mode (eq (framep (selected-frame)) 'x) (eq (framep (selected-frame)) 'pc) (eq (framep (selected-frame)) 'win32) (sit-for 1)) (push-mark) (set-mark (point)) (if (numberp (posn-point end)) (goto-char (posn-point end))) ;; Don't set this-command to kill-region, so that a following ;; C-w will not double the text in the kill ring. ;; Ignore last-command so we don't append to a preceding kill. (let (this-command last-command) (copy-region-as-kill (mark) (point))) (mouse-set-region-1))) (defun mouse-set-region-1 () (setq mouse-last-region-beg (region-beginning)) (setq mouse-last-region-end (region-end)) (setq mouse-last-region-tick (buffer-modified-tick))) (defvar mouse-scroll-delay 0.25 "*The pause between scroll steps caused by mouse drags, in seconds. If you drag the mouse beyond the edge of a window, Emacs scrolls the window to bring the text beyond that edge into view, with a delay of this many seconds between scroll steps. Scrolling stops when you move the mouse back into the window, or release the button. This variable's value may be non-integral. Setting this to zero causes Emacs to scroll as fast as it can.") (defvar mouse-scroll-min-lines 1 "*The minimum number of lines scrolled by dragging mouse out of window. Moving the mouse out the top or bottom edge of the window begins scrolling repeatedly. The number of lines scrolled per repetition is normally equal to the number of lines beyond the window edge that the mouse has moved. However, it always scrolls at least the number of lines specified by this variable.") (defun mouse-scroll-subr (window jump &optional overlay start) "Scroll the window WINDOW, JUMP lines at a time, until new input arrives. If OVERLAY is an overlay, let it stretch from START to the far edge of the newly visible text. Upon exit, point is at the far edge of the newly visible text." (cond ((and (> jump 0) (< jump mouse-scroll-min-lines)) (setq jump mouse-scroll-min-lines)) ((and (< jump 0) (< (- jump) mouse-scroll-min-lines)) (setq jump (- mouse-scroll-min-lines)))) (let ((opoint (point))) (while (progn (goto-char (window-start window)) (if (not (zerop (vertical-motion jump window))) (progn (set-window-start window (point)) (if (natnump jump) (progn (goto-char (window-end window)) ;; window-end doesn't reflect the window's new ;; start position until the next redisplay. Hurrah. (vertical-motion (1- jump) window)) (goto-char (window-start window))) (if overlay (move-overlay overlay start (point))) ;; Now that we have scrolled WINDOW properly, ;; put point back where it was for the redisplay ;; so that we don't mess up the selected window. (or (eq window (selected-window)) (goto-char opoint)) (sit-for mouse-scroll-delay))))) (or (eq window (selected-window)) (goto-char opoint)))) ;; Create an overlay and immediately delete it, to get "overlay in no buffer". (defvar mouse-drag-overlay (make-overlay 1 1)) (delete-overlay mouse-drag-overlay) (overlay-put mouse-drag-overlay 'face 'region) (defvar mouse-selection-click-count 0) (defvar mouse-selection-click-count-buffer nil) (defun mouse-drag-region (start-event) "Set the region to the text that the mouse is dragged over. Highlight the drag area as you move the mouse. This must be bound to a button-down mouse event. In Transient Mark mode, the highlighting remains once you release the mouse button. Otherwise, it does not." (interactive "e") (mouse-minibuffer-check start-event) (let* ((start-posn (event-start start-event)) (start-point (posn-point start-posn)) (start-window (posn-window start-posn)) (start-frame (window-frame start-window)) (bounds (window-edges start-window)) (top (nth 1 bounds)) (bottom (if (window-minibuffer-p start-window) (nth 3 bounds) ;; Don't count the mode line. (1- (nth 3 bounds)))) (click-count (1- (event-click-count start-event)))) (setq mouse-selection-click-count click-count) (setq mouse-selection-click-count-buffer (current-buffer)) (mouse-set-point start-event) ;; In case the down click is in the middle of some intangible text, ;; use the end of that text, and put it in START-POINT. (if (< (point) start-point) (goto-char start-point)) (setq start-point (point)) (let ((range (mouse-start-end start-point start-point click-count))) (move-overlay mouse-drag-overlay (car range) (nth 1 range) (window-buffer start-window))) (deactivate-mark) ;; end-of-range is used only in the single-click case. ;; It is the place where the drag has reached so far ;; (but not outside the window where the drag started). (let (event end end-point (end-of-range (point))) (track-mouse (while (progn (setq event (read-event)) (or (mouse-movement-p event) (eq (car-safe event) 'switch-frame))) (if (eq (car-safe event) 'switch-frame) nil (setq end (event-end event) end-point (posn-point end)) (cond ;; Are we moving within the original window? ((and (eq (posn-window end) start-window) (integer-or-marker-p end-point)) ;; Go to START-POINT first, so that when we move to END-POINT, ;; if it's in the middle of intangible text, ;; point jumps in the direction away from START-POINT. (goto-char start-point) (goto-char end-point) (if (zerop (% click-count 3)) (setq end-of-range (point))) (let ((range (mouse-start-end start-point (point) click-count))) (move-overlay mouse-drag-overlay (car range) (nth 1 range)))) (t (let ((mouse-row (cdr (cdr (mouse-position))))) (cond ((null mouse-row)) ((< mouse-row top) (mouse-scroll-subr start-window (- mouse-row top) mouse-drag-overlay start-point) ;; Without this, point tends to jump back to the starting ;; position where the mouse button was pressed down. (setq end-of-range (overlay-start mouse-drag-overlay))) ((>= mouse-row bottom) (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) mouse-drag-overlay start-point) (setq end-of-range (overlay-end mouse-drag-overlay)))))))))) (if (consp event) (let ((fun (key-binding (vector (car event))))) ;; Run the binding of the terminating up-event, if possible. ;; In the case of a multiple click, it gives the wrong results, ;; because it would fail to set up a region. (if (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun)) ;; In this case, we can just let the up-event execute normally. (let ((end (event-end event))) ;; Set the position in the event before we replay it, ;; because otherwise it may have a position in the wrong ;; buffer. (setcar (cdr end) end-of-range) ;; Delete the overlay before calling the function, ;; because delete-overlay increases buffer-modified-tick. (delete-overlay mouse-drag-overlay) (setq unread-command-events (cons event unread-command-events))) (if (not (= (overlay-start mouse-drag-overlay) (overlay-end mouse-drag-overlay))) (let (last-command this-command) (push-mark (overlay-start mouse-drag-overlay) t t) (goto-char (overlay-end mouse-drag-overlay)) (delete-overlay mouse-drag-overlay) (copy-region-as-kill (point) (mark t)) (mouse-set-region-1)) (goto-char (overlay-end mouse-drag-overlay)) (setq this-command 'mouse-set-point) (delete-overlay mouse-drag-overlay)))) (delete-overlay mouse-drag-overlay))))) ;; Commands to handle xterm-style multiple clicks. (defun mouse-skip-word (dir) "Skip over word, over whitespace, or over identical punctuation. If DIR is positive skip forward; if negative, skip backward." (let* ((char (following-char)) (syntax (char-to-string (char-syntax char)))) (cond ((or (string= syntax "w") (string= syntax " ")) (if (< dir 0) (skip-syntax-backward syntax) (skip-syntax-forward syntax))) ((string= syntax "_") (if (< dir 0) (skip-syntax-backward "w_") (skip-syntax-forward "w_"))) ((< dir 0) (while (and (not (bobp)) (= (preceding-char) char)) (forward-char -1))) (t (while (and (not (eobp)) (= (following-char) char)) (forward-char 1)))))) ;; Return a list of region bounds based on START and END according to MODE. ;; If MODE is 0 then set point to (min START END), mark to (max START END). ;; If MODE is 1 then set point to start of word at (min START END), ;; mark to end of word at (max START END). ;; If MODE is 2 then do the same for lines. (defun mouse-start-end (start end mode) (if (> start end) (let ((temp start)) (setq start end end temp))) (setq mode (mod mode 3)) (cond ((= mode 0) (list start end)) ((and (= mode 1) (= start end) (char-after start) (= (char-syntax (char-after start)) ?\()) (list start (save-excursion (goto-char start) (forward-sexp 1) (point)))) ((and (= mode 1) (= start end) (char-after start) (= (char-syntax (char-after start)) ?\))) (list (save-excursion (goto-char (1+ start)) (backward-sexp 1) (point)) (1+ start))) ((= mode 1) (list (save-excursion (goto-char start) (mouse-skip-word -1) (point)) (save-excursion (goto-char end) (mouse-skip-word 1) (point)))) ((= mode 2) (list (save-excursion (goto-char start) (beginning-of-line 1) (point)) (save-excursion (goto-char end) (forward-line 1) (point)))))) ;; Subroutine: set the mark where CLICK happened, ;; but don't do anything else. (defun mouse-set-mark-fast (click) (mouse-minibuffer-check click) (let ((posn (event-start click))) (select-window (posn-window posn)) (if (numberp (posn-point posn)) (push-mark (posn-point posn) t t)))) ;; Momentarily show where the mark is, if highlighting doesn't show it. (defun mouse-show-mark () (or transient-mark-mode (save-excursion (goto-char (mark t)) (sit-for 1)))) (defun mouse-set-mark (click) "Set mark at the position clicked on with the mouse. Display cursor at that position for a second. This must be bound to a mouse click." (interactive "e") (mouse-minibuffer-check click) (select-window (posn-window (event-start click))) ;; We don't use save-excursion because that preserves the mark too. (let ((point-save (point))) (unwind-protect (progn (mouse-set-point click) (push-mark nil t t) (or transient-mark-mode (sit-for 1))) (goto-char point-save)))) (defun mouse-kill (click) "Kill the region between point and the mouse click. The text is saved in the kill ring, as with \\[kill-region]." (interactive "e") (mouse-minibuffer-check click) (let* ((posn (event-start click)) (click-posn (posn-point posn))) (select-window (posn-window posn)) (if (numberp click-posn) (kill-region (min (point) click-posn) (max (point) click-posn))))) (defun mouse-yank-at-click (click arg) "Insert the last stretch of killed text at the position clicked on. Also move point to one end of the text thus inserted (normally the end). Prefix arguments are interpreted as with \\[yank]. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click." (interactive "e\nP") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (or mouse-yank-at-point (mouse-set-point click)) (setq this-command 'yank) (setq mouse-selection-click-count 0) (yank arg)) (defun mouse-kill-ring-save (click) "Copy the region between point and the mouse click in the kill ring. This does not delete the region; it acts like \\[kill-ring-save]." (interactive "e") (mouse-set-mark-fast click) (let (this-command last-command) (kill-ring-save (point) (mark t))) (mouse-show-mark)) ;;; This function used to delete the text between point and the mouse ;;; whenever it was equal to the front of the kill ring, but some ;;; people found that confusing. ;;; A list (TEXT START END), describing the text and position of the last ;;; invocation of mouse-save-then-kill. (defvar mouse-save-then-kill-posn nil) (defun mouse-save-then-kill-delete-region (beg end) ;; We must make our own undo boundaries ;; because they happen automatically only for the current buffer. (undo-boundary) (if (or (= beg end) (eq buffer-undo-list t)) ;; If we have no undo list in this buffer, ;; just delete. (delete-region beg end) ;; Delete, but make the undo-list entry share with the kill ring. ;; First, delete just one char, so in case buffer is being modified ;; for the first time, the undo list records that fact. (let (before-change-function after-change-function before-change-functions after-change-functions) (delete-region beg (+ beg (if (> end beg) 1 -1)))) (let ((buffer-undo-list buffer-undo-list)) ;; Undo that deletion--but don't change the undo list! (let (before-change-function after-change-function before-change-functions after-change-functions) (primitive-undo 1 buffer-undo-list)) ;; Now delete the rest of the specified region, ;; but don't record it. (setq buffer-undo-list t) (if (/= (length (car kill-ring)) (- (max end beg) (min end beg))) (error "Lossage in mouse-save-then-kill-delete-region")) (delete-region beg end)) (let ((tail buffer-undo-list)) ;; Search back in buffer-undo-list for the string ;; that came from deleting one character. (while (and tail (not (stringp (car (car tail))))) (setq tail (cdr tail))) ;; Replace it with an entry for the entire deleted text. (and tail (setcar tail (cons (car kill-ring) (min beg end)))))) (undo-boundary)) (defun mouse-save-then-kill (click) "Save text to point in kill ring; the second time, kill the text. If the text between point and the mouse is the same as what's at the front of the kill ring, this deletes the text. Otherwise, it adds the text to the kill ring, like \\[kill-ring-save], which prepares for a second click to delete the text. If you have selected words or lines, this command extends the selection through the word or line clicked on. If you do this again in a different position, it extends the selection again. If you do this twice in the same position, the selection is killed." (interactive "e") (let ((before-scroll point-before-scroll)) (mouse-minibuffer-check click) (let ((click-posn (posn-point (event-start click))) ;; Don't let a subsequent kill command append to this one: ;; prevent setting this-command to kill-region. (this-command this-command)) (if (and (save-excursion (set-buffer (window-buffer (posn-window (event-start click)))) (and (mark t) (> (mod mouse-selection-click-count 3) 0) ;; Don't be fooled by a recent click in some other buffer. (eq mouse-selection-click-count-buffer (current-buffer))))) (if (not (and (eq last-command 'mouse-save-then-kill) (equal click-posn (car (cdr-safe (cdr-safe mouse-save-then-kill-posn)))))) ;; Find both ends of the object selected by this click. (let* ((range (mouse-start-end click-posn click-posn mouse-selection-click-count))) ;; Move whichever end is closer to the click. ;; That's what xterm does, and it seems reasonable. (if (< (abs (- click-posn (mark t))) (abs (- click-posn (point)))) (set-mark (car range)) (goto-char (nth 1 range))) ;; We have already put the old region in the kill ring. ;; Replace it with the extended region. ;; (It would be annoying to make a separate entry.) (kill-new (buffer-substring (point) (mark t)) t) (mouse-set-region-1) ;; Arrange for a repeated mouse-3 to kill this region. (setq mouse-save-then-kill-posn (list (car kill-ring) (point) click-posn)) (mouse-show-mark)) ;; If we click this button again without moving it, ;; that time kill. (mouse-save-then-kill-delete-region (mark) (point)) (setq mouse-selection-click-count 0) (setq mouse-save-then-kill-posn nil)) (if (and (eq last-command 'mouse-save-then-kill) mouse-save-then-kill-posn (eq (car mouse-save-then-kill-posn) (car kill-ring)) (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn))) ;; If this is the second time we've called ;; mouse-save-then-kill, delete the text from the buffer. (progn (mouse-save-then-kill-delete-region (point) (mark)) ;; After we kill, another click counts as "the first time". (setq mouse-save-then-kill-posn nil)) (if (or (and (eq last-command 'mouse-save-then-kill) mouse-save-then-kill-posn) (and mark-active transient-mark-mode) (and (memq last-command '(mouse-drag-region mouse-set-region)) (or mark-even-if-inactive (not transient-mark-mode)))) ;; We have a selection or suitable region, so adjust it. (let* ((posn (event-start click)) (new (posn-point posn))) (select-window (posn-window posn)) (if (numberp new) (progn ;; Move whichever end of the region is closer to the click. ;; That is what xterm does, and it seems reasonable. (if (< (abs (- new (point))) (abs (- new (mark t)))) (goto-char new) (set-mark new)) (setq deactivate-mark nil))) (kill-new (buffer-substring (point) (mark t)) t) (mouse-show-mark)) ;; Set the mark where point is, then move where clicked. (mouse-set-mark-fast click) (if before-scroll (goto-char before-scroll)) (exchange-point-and-mark) (kill-new (buffer-substring (point) (mark t)))) (mouse-set-region-1) (setq mouse-save-then-kill-posn (list (car kill-ring) (point) click-posn))))))) (global-set-key [M-mouse-1] 'mouse-start-secondary) (global-set-key [M-drag-mouse-1] 'mouse-set-secondary) (global-set-key [M-down-mouse-1] 'mouse-drag-secondary) (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill) (global-set-key [M-mouse-2] 'mouse-yank-secondary) ;; An overlay which records the current secondary selection ;; or else is deleted when there is no secondary selection. ;; May be nil. (defvar mouse-secondary-overlay nil) (defvar mouse-secondary-click-count 0) ;; A marker which records the specified first end for a secondary selection. ;; May be nil. (defvar mouse-secondary-start nil) (defun mouse-start-secondary (click) "Set one end of the secondary selection to the position clicked on. Use \\[mouse-secondary-save-then-kill] to set the other end and complete the secondary selection." (interactive "e") (mouse-minibuffer-check click) (let ((posn (event-start click))) (save-excursion (set-buffer (window-buffer (posn-window posn))) ;; Cancel any preexisting secondary selection. (if mouse-secondary-overlay (delete-overlay mouse-secondary-overlay)) (if (numberp (posn-point posn)) (progn (or mouse-secondary-start (setq mouse-secondary-start (make-marker))) (move-marker mouse-secondary-start (posn-point posn))))))) (defun mouse-set-secondary (click) "Set the secondary selection to the text that the mouse is dragged over. This must be bound to a mouse drag event." (interactive "e") (mouse-minibuffer-check click) (let ((posn (event-start click)) beg (end (event-end click))) (save-excursion (set-buffer (window-buffer (posn-window posn))) (if (numberp (posn-point posn)) (setq beg (posn-point posn))) (if mouse-secondary-overlay (move-overlay mouse-secondary-overlay beg (posn-point end)) (setq mouse-secondary-overlay (make-overlay beg (posn-point end)))) (overlay-put mouse-secondary-overlay 'face 'secondary-selection)))) (defun mouse-drag-secondary (start-event) "Set the secondary selection to the text that the mouse is dragged over. Highlight the drag area as you move the mouse. This must be bound to a button-down mouse event." (interactive "e") (mouse-minibuffer-check start-event) (let* ((start-posn (event-start start-event)) (start-point (posn-point start-posn)) (start-window (posn-window start-posn)) (start-frame (window-frame start-window)) (bounds (window-edges start-window)) (top (nth 1 bounds)) (bottom (if (window-minibuffer-p start-window) (nth 3 bounds) ;; Don't count the mode line. (1- (nth 3 bounds)))) (click-count (1- (event-click-count start-event)))) (save-excursion (set-buffer (window-buffer start-window)) (setq mouse-secondary-click-count click-count) (or mouse-secondary-overlay (setq mouse-secondary-overlay (make-overlay (point) (point)))) (overlay-put mouse-secondary-overlay 'face 'secondary-selection) (if (> (mod click-count 3) 0) ;; Double or triple press: make an initial selection ;; of one word or line. (let ((range (mouse-start-end start-point start-point click-count))) (set-marker mouse-secondary-start nil) (move-overlay mouse-secondary-overlay 1 1 (window-buffer start-window)) (move-overlay mouse-secondary-overlay (car range) (nth 1 range) (window-buffer start-window))) ;; Single-press: cancel any preexisting secondary selection. (or mouse-secondary-start (setq mouse-secondary-start (make-marker))) (set-marker mouse-secondary-start start-point) (delete-overlay mouse-secondary-overlay)) (let (event end end-point) (track-mouse (while (progn (setq event (read-event)) (or (mouse-movement-p event) (eq (car-safe event) 'switch-frame))) (if (eq (car-safe event) 'switch-frame) nil (setq end (event-end event) end-point (posn-point end)) (cond ;; Are we moving within the original window? ((and (eq (posn-window end) start-window) (integer-or-marker-p end-point)) (let ((range (mouse-start-end start-point end-point click-count))) (if (or (/= start-point end-point) (null (marker-position mouse-secondary-start))) (progn (set-marker mouse-secondary-start nil) (move-overlay mouse-secondary-overlay (car range) (nth 1 range)))))) (t (let ((mouse-row (cdr (cdr (mouse-position))))) (cond ((null mouse-row)) ((< mouse-row top) (mouse-scroll-subr start-window (- mouse-row top) mouse-secondary-overlay start-point)) ((>= mouse-row bottom) (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) mouse-secondary-overlay start-point))))))))) (if (consp event) ;;; (eq (get (event-basic-type event) 'event-kind) 'mouse-click) ;;; (eq (posn-window (event-end event)) start-window) ;;; (numberp (posn-point (event-end event))) (if (marker-position mouse-secondary-start) (save-window-excursion (delete-overlay mouse-secondary-overlay) (x-set-selection 'SECONDARY nil) (select-window start-window) (save-excursion (goto-char mouse-secondary-start) (sit-for 1))) (x-set-selection 'SECONDARY (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay))))))))) (defun mouse-yank-secondary (click) "Insert the secondary selection at the position clicked on. Move point to the end of the inserted text. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click." (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (or mouse-yank-at-point (mouse-set-point click)) (insert (x-get-selection 'SECONDARY))) (defun mouse-kill-secondary () "Kill the text in the secondary selection. This is intended more as a keyboard command than as a mouse command but it can work as either one. The current buffer (in case of keyboard use), or the buffer clicked on, must be the one that the secondary selection is in. This requirement is to prevent accidents." (interactive) (let* ((keys (this-command-keys)) (click (elt keys (1- (length keys))))) (or (eq (overlay-buffer mouse-secondary-overlay) (if (listp click) (window-buffer (posn-window (event-start click))) (current-buffer))) (error "Select or click on the buffer where the secondary selection is"))) (let (this-command) (save-excursion (set-buffer (overlay-buffer mouse-secondary-overlay)) (kill-region (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay)))) (delete-overlay mouse-secondary-overlay) ;;; (x-set-selection 'SECONDARY nil) (setq mouse-secondary-overlay nil)) (defun mouse-secondary-save-then-kill (click) "Save text to point in kill ring; the second time, kill the text. You must use this in a buffer where you have recently done \\[mouse-start-secondary]. If the text between where you did \\[mouse-start-secondary] and where you use this command matches the text at the front of the kill ring, this command deletes the text. Otherwise, it adds the text to the kill ring, like \\[kill-ring-save], which prepares for a second click with this command to delete the text. If you have already made a secondary selection in that buffer, this command extends or retracts the selection to where you click. If you do this again in a different position, it extends or retracts again. If you do this twice in the same position, it kills the selection." (interactive "e") (mouse-minibuffer-check click) (let ((posn (event-start click)) (click-posn (posn-point (event-start click))) ;; Don't let a subsequent kill command append to this one: ;; prevent setting this-command to kill-region. (this-command this-command)) (or (eq (window-buffer (posn-window posn)) (or (and mouse-secondary-overlay (overlay-buffer mouse-secondary-overlay)) (if mouse-secondary-start (marker-buffer mouse-secondary-start)))) (error "Wrong buffer")) (save-excursion (set-buffer (window-buffer (posn-window posn))) (if (> (mod mouse-secondary-click-count 3) 0) (if (not (and (eq last-command 'mouse-secondary-save-then-kill) (equal click-posn (car (cdr-safe (cdr-safe mouse-save-then-kill-posn)))))) ;; Find both ends of the object selected by this click. (let* ((range (mouse-start-end click-posn click-posn mouse-secondary-click-count))) ;; Move whichever end is closer to the click. ;; That's what xterm does, and it seems reasonable. (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay))) (abs (- click-posn (overlay-end mouse-secondary-overlay)))) (move-overlay mouse-secondary-overlay (car range) (overlay-end mouse-secondary-overlay)) (move-overlay mouse-secondary-overlay (overlay-start mouse-secondary-overlay) (nth 1 range))) ;; We have already put the old region in the kill ring. ;; Replace it with the extended region. ;; (It would be annoying to make a separate entry.) (kill-new (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay)) t) ;; Arrange for a repeated mouse-3 to kill this region. (setq mouse-save-then-kill-posn (list (car kill-ring) (point) click-posn))) ;; If we click this button again without moving it, ;; that time kill. (progn (mouse-save-then-kill-delete-region (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay)) (setq mouse-save-then-kill-posn nil) (setq mouse-secondary-click-count 0) (delete-overlay mouse-secondary-overlay))) (if (and (eq last-command 'mouse-secondary-save-then-kill) mouse-save-then-kill-posn (eq (car mouse-save-then-kill-posn) (car kill-ring)) (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn))) ;; If this is the second time we've called ;; mouse-secondary-save-then-kill, delete the text from the buffer. (progn (mouse-save-then-kill-delete-region (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay)) (setq mouse-save-then-kill-posn nil) (delete-overlay mouse-secondary-overlay)) (if (overlay-start mouse-secondary-overlay) ;; We have a selection, so adjust it. (progn (if (numberp click-posn) (progn ;; Move whichever end of the region is closer to the click. ;; That is what xterm does, and it seems reasonable. (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay))) (abs (- click-posn (overlay-end mouse-secondary-overlay)))) (move-overlay mouse-secondary-overlay click-posn (overlay-end mouse-secondary-overlay)) (move-overlay mouse-secondary-overlay (overlay-start mouse-secondary-overlay) click-posn)) (setq deactivate-mark nil))) (if (eq last-command 'mouse-secondary-save-then-kill) ;; If the front of the kill ring comes from ;; an immediately previous use of this command, ;; replace it with the extended region. ;; (It would be annoying to make a separate entry.) (kill-new (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay)) t) (copy-region-as-kill (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay)))) (if mouse-secondary-start ;; All we have is one end of a selection, ;; so put the other end here. (let ((start (+ 0 mouse-secondary-start))) (kill-ring-save start click-posn) (if mouse-secondary-overlay (move-overlay mouse-secondary-overlay start click-posn) (setq mouse-secondary-overlay (make-overlay start click-posn))) (overlay-put mouse-secondary-overlay 'face 'secondary-selection)))) (setq mouse-save-then-kill-posn (list (car kill-ring) (point) click-posn)))) (if (overlay-buffer mouse-secondary-overlay) (x-set-selection 'SECONDARY (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay))))))) (defun mouse-buffer-menu (event) "Pop up a menu of buffers for selection with the mouse. This switches buffers in the window that you clicked on, and selects that window." (interactive "e") (mouse-minibuffer-check event) (let ((menu (list "Buffer Menu" (cons "Select Buffer" (let ((tail (buffer-list)) (maxbuf 0) head) (while tail (or (eq ?\ (aref (buffer-name (car tail)) 0)) (setq maxbuf (max maxbuf (length (buffer-name (car tail)))))) (setq tail (cdr tail))) (setq tail (buffer-list)) (while tail (let ((elt (car tail))) (if (not (string-match "^ " (buffer-name elt))) (setq head (cons (cons (format (format "%%%ds %%s%%s %%s" maxbuf) (buffer-name elt) (if (buffer-modified-p elt) "*" " ") (save-excursion (set-buffer elt) (if buffer-read-only "%" " ")) (or (buffer-file-name elt) (save-excursion (set-buffer elt) (if list-buffers-directory (expand-file-name list-buffers-directory))) "")) elt) head)))) (setq tail (cdr tail))) (reverse head)))))) (let ((buf (x-popup-menu event menu)) (window (posn-window (event-start event)))) (if buf (progn (or (framep window) (select-window window)) (switch-to-buffer buf)))))) ;;; These need to be rewritten for the new scroll bar implementation. ;;;!! ;; Commands for the scroll bar. ;;;!! ;;;!! (defun mouse-scroll-down (click) ;;;!! (interactive "@e") ;;;!! (scroll-down (1+ (cdr (mouse-coords click))))) ;;;!! ;;;!! (defun mouse-scroll-up (click) ;;;!! (interactive "@e") ;;;!! (scroll-up (1+ (cdr (mouse-coords click))))) ;;;!! ;;;!! (defun mouse-scroll-down-full () ;;;!! (interactive "@") ;;;!! (scroll-down nil)) ;;;!! ;;;!! (defun mouse-scroll-up-full () ;;;!! (interactive "@") ;;;!! (scroll-up nil)) ;;;!! ;;;!! (defun mouse-scroll-move-cursor (click) ;;;!! (interactive "@e") ;;;!! (move-to-window-line (1+ (cdr (mouse-coords click))))) ;;;!! ;;;!! (defun mouse-scroll-absolute (event) ;;;!! (interactive "@e") ;;;!! (let* ((pos (car event)) ;;;!! (position (car pos)) ;;;!! (length (car (cdr pos)))) ;;;!! (if (<= length 0) (setq length 1)) ;;;!! (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size))))) ;;;!! (newpos (* (/ (* (/ (buffer-size) scale-factor) ;;;!! position) ;;;!! length) ;;;!! scale-factor))) ;;;!! (goto-char newpos) ;;;!! (recenter '(4))))) ;;;!! ;;;!! (defun mouse-scroll-left (click) ;;;!! (interactive "@e") ;;;!! (scroll-left (1+ (car (mouse-coords click))))) ;;;!! ;;;!! (defun mouse-scroll-right (click) ;;;!! (interactive "@e") ;;;!! (scroll-right (1+ (car (mouse-coords click))))) ;;;!! ;;;!! (defun mouse-scroll-left-full () ;;;!! (interactive "@") ;;;!! (scroll-left nil)) ;;;!! ;;;!! (defun mouse-scroll-right-full () ;;;!! (interactive "@") ;;;!! (scroll-right nil)) ;;;!! ;;;!! (defun mouse-scroll-move-cursor-horizontally (click) ;;;!! (interactive "@e") ;;;!! (move-to-column (1+ (car (mouse-coords click))))) ;;;!! ;;;!! (defun mouse-scroll-absolute-horizontally (event) ;;;!! (interactive "@e") ;;;!! (let* ((pos (car event)) ;;;!! (position (car pos)) ;;;!! (length (car (cdr pos)))) ;;;!! (set-window-hscroll (selected-window) 33))) ;;;!! ;;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up) ;;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute) ;;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down) ;;;!! ;;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor) ;;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor) ;;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor) ;;;!! ;;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full) ;;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full) ;;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full) ;;;!! ;;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full) ;;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full) ;;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full) ;;;!! ;;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left) ;;;!! (global-set-key [horizontal-scroll-bar mouse-2] ;;;!! 'mouse-scroll-absolute-horizontally) ;;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right) ;;;!! ;;;!! (global-set-key [horizontal-slider mouse-1] ;;;!! 'mouse-scroll-move-cursor-horizontally) ;;;!! (global-set-key [horizontal-slider mouse-2] ;;;!! 'mouse-scroll-move-cursor-horizontally) ;;;!! (global-set-key [horizontal-slider mouse-3] ;;;!! 'mouse-scroll-move-cursor-horizontally) ;;;!! ;;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full) ;;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full) ;;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full) ;;;!! ;;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full) ;;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full) ;;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full) ;;;!! ;;;!! (global-set-key [horizontal-scroll-bar S-mouse-2] ;;;!! 'mouse-split-window-horizontally) ;;;!! (global-set-key [mode-line S-mouse-2] ;;;!! 'mouse-split-window-horizontally) ;;;!! (global-set-key [vertical-scroll-bar S-mouse-2] ;;;!! 'mouse-split-window) ;;;!! ;;;; ;;;!! ;;;; Here are experimental things being tested. Mouse events ;;;!! ;;;; are of the form: ;;;!! ;;;; ((x y) window screen-part key-sequence timestamp) ;;;!! ;; ;;;!! ;;;; ;;;!! ;;;; Dynamically track mouse coordinates ;;;!! ;;;; ;;;!! ;; ;;;!! ;;(defun track-mouse (event) ;;;!! ;; "Track the coordinates, absolute and relative, of the mouse." ;;;!! ;; (interactive "@e") ;;;!! ;; (while mouse-grabbed ;;;!! ;; (let* ((pos (read-mouse-position (selected-screen))) ;;;!! ;; (abs-x (car pos)) ;;;!! ;; (abs-y (cdr pos)) ;;;!! ;; (relative-coordinate (coordinates-in-window-p ;;;!! ;; (list (car pos) (cdr pos)) ;;;!! ;; (selected-window)))) ;;;!! ;; (if (consp relative-coordinate) ;;;!! ;; (message "mouse: [%d %d], (%d %d)" abs-x abs-y ;;;!! ;; (car relative-coordinate) ;;;!! ;; (car (cdr relative-coordinate))) ;;;!! ;; (message "mouse: [%d %d]" abs-x abs-y))))) ;;;!! ;;;!! ;; ;;;!! ;; Dynamically put a box around the line indicated by point ;;;!! ;; ;;;!! ;; ;;;!! ;;(require 'backquote) ;;;!! ;; ;;;!! ;;(defun mouse-select-buffer-line (event) ;;;!! ;; (interactive "@e") ;;;!! ;; (let ((relative-coordinate ;;;!! ;; (coordinates-in-window-p (car event) (selected-window))) ;;;!! ;; (abs-y (car (cdr (car event))))) ;;;!! ;; (if (consp relative-coordinate) ;;;!! ;; (progn ;;;!! ;; (save-excursion ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate))) ;;;!! ;; (x-draw-rectangle ;;;!! ;; (selected-screen) ;;;!! ;; abs-y 0 ;;;!! ;; (save-excursion ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate))) ;;;!! ;; (end-of-line) ;;;!! ;; (push-mark nil t) ;;;!! ;; (beginning-of-line) ;;;!! ;; (- (region-end) (region-beginning))) 1)) ;;;!! ;; (sit-for 1) ;;;!! ;; (x-erase-rectangle (selected-screen)))))) ;;;!! ;; ;;;!! ;;(defvar last-line-drawn nil) ;;;!! ;;(defvar begin-delim "[^ \t]") ;;;!! ;;(defvar end-delim "[^ \t]") ;;;!! ;; ;;;!! ;;(defun mouse-boxing (event) ;;;!! ;; (interactive "@e") ;;;!! ;; (save-excursion ;;;!! ;; (let ((screen (selected-screen))) ;;;!! ;; (while (= (x-mouse-events) 0) ;;;!! ;; (let* ((pos (read-mouse-position screen)) ;;;!! ;; (abs-x (car pos)) ;;;!! ;; (abs-y (cdr pos)) ;;;!! ;; (relative-coordinate ;;;!! ;; (coordinates-in-window-p (` ((, abs-x) (, abs-y))) ;;;!! ;; (selected-window))) ;;;!! ;; (begin-reg nil) ;;;!! ;; (end-reg nil) ;;;!! ;; (end-column nil) ;;;!! ;; (begin-column nil)) ;;;!! ;; (if (and (consp relative-coordinate) ;;;!! ;; (or (not last-line-drawn) ;;;!! ;; (not (= last-line-drawn abs-y)))) ;;;!! ;; (progn ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate))) ;;;!! ;; (if (= (following-char) 10) ;;;!! ;; () ;;;!! ;; (progn ;;;!! ;; (setq begin-reg (1- (re-search-forward end-delim))) ;;;!! ;; (setq begin-column (1- (current-column))) ;;;!! ;; (end-of-line) ;;;!! ;; (setq end-reg (1+ (re-search-backward begin-delim))) ;;;!! ;; (setq end-column (1+ (current-column))) ;;;!! ;; (message "%s" (buffer-substring begin-reg end-reg)) ;;;!! ;; (x-draw-rectangle screen ;;;!! ;; (setq last-line-drawn abs-y) ;;;!! ;; begin-column ;;;!! ;; (- end-column begin-column) 1)))))))))) ;;;!! ;; ;;;!! ;;(defun mouse-erase-box () ;;;!! ;; (interactive) ;;;!! ;; (if last-line-drawn ;;;!! ;; (progn ;;;!! ;; (x-erase-rectangle (selected-screen)) ;;;!! ;; (setq last-line-drawn nil)))) ;;;!! ;;;!! ;;; (defun test-x-rectangle () ;;;!! ;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap))) ;;;!! ;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing) ;;;!! ;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box)) ;;;!! ;;;!! ;; ;;;!! ;; Here is how to do double clicking in lisp. About to change. ;;;!! ;; ;;;!! ;;;!! (defvar double-start nil) ;;;!! (defconst double-click-interval 300 ;;;!! "Max ticks between clicks") ;;;!! ;;;!! (defun double-down (event) ;;;!! (interactive "@e") ;;;!! (if double-start ;;;!! (let ((interval (- (nth 4 event) double-start))) ;;;!! (if (< interval double-click-interval) ;;;!! (progn ;;;!! (backward-up-list 1) ;;;!! ;; (message "Interval %d" interval) ;;;!! (sleep-for 1))) ;;;!! (setq double-start nil)) ;;;!! (setq double-start (nth 4 event)))) ;;;!! ;;;!! (defun double-up (event) ;;;!! (interactive "@e") ;;;!! (and double-start ;;;!! (> (- (nth 4 event ) double-start) double-click-interval) ;;;!! (setq double-start nil))) ;;;!! ;;;!! ;;; (defun x-test-doubleclick () ;;;!! ;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap))) ;;;!! ;;; (define-key doubleclick-test-map mouse-button-left 'double-down) ;;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up)) ;;;!! ;;;!! ;; ;;;!! ;; This scrolls while button is depressed. Use preferable in scroll bar. ;;;!! ;; ;;;!! ;;;!! (defvar scrolled-lines 0) ;;;!! (defconst scroll-speed 1) ;;;!! ;;;!! (defun incr-scroll-down (event) ;;;!! (interactive "@e") ;;;!! (setq scrolled-lines 0) ;;;!! (incremental-scroll scroll-speed)) ;;;!! ;;;!! (defun incr-scroll-up (event) ;;;!! (interactive "@e") ;;;!! (setq scrolled-lines 0) ;;;!! (incremental-scroll (- scroll-speed))) ;;;!! ;;;!! (defun incremental-scroll (n) ;;;!! (while (= (x-mouse-events) 0) ;;;!! (setq scrolled-lines (1+ (* scroll-speed scrolled-lines))) ;;;!! (scroll-down n) ;;;!! (sit-for 300 t))) ;;;!! ;;;!! (defun incr-scroll-stop (event) ;;;!! (interactive "@e") ;;;!! (message "Scrolled %d lines" scrolled-lines) ;;;!! (setq scrolled-lines 0) ;;;!! (sleep-for 1)) ;;;!! ;;;!! ;;; (defun x-testing-scroll () ;;;!! ;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix))) ;;;!! ;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down) ;;;!! ;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up) ;;;!! ;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop) ;;;!! ;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop))) ;;;!! ;;;!! ;; ;;;!! ;; Some playthings suitable for picture mode? They need work. ;;;!! ;; ;;;!! ;;;!! (defun mouse-kill-rectangle (event) ;;;!! "Kill the rectangle between point and the mouse cursor." ;;;!! (interactive "@e") ;;;!! (let ((point-save (point))) ;;;!! (save-excursion ;;;!! (mouse-set-point event) ;;;!! (push-mark nil t) ;;;!! (if (> point-save (point)) ;;;!! (kill-rectangle (point) point-save) ;;;!! (kill-rectangle point-save (point)))))) ;;;!! ;;;!! (defun mouse-open-rectangle (event) ;;;!! "Kill the rectangle between point and the mouse cursor." ;;;!! (interactive "@e") ;;;!! (let ((point-save (point))) ;;;!! (save-excursion ;;;!! (mouse-set-point event) ;;;!! (push-mark nil t) ;;;!! (if (> point-save (point)) ;;;!! (open-rectangle (point) point-save) ;;;!! (open-rectangle point-save (point)))))) ;;;!! ;;;!! ;; Must be a better way to do this. ;;;!! ;;;!! (defun mouse-multiple-insert (n char) ;;;!! (while (> n 0) ;;;!! (insert char) ;;;!! (setq n (1- n)))) ;;;!! ;;;!! ;; What this could do is not finalize until button was released. ;;;!! ;;;!! (defun mouse-move-text (event) ;;;!! "Move text from point to cursor position, inserting spaces." ;;;!! (interactive "@e") ;;;!! (let* ((relative-coordinate ;;;!! (coordinates-in-window-p (car event) (selected-window)))) ;;;!! (if (consp relative-coordinate) ;;;!! (cond ((> (current-column) (car relative-coordinate)) ;;;!! (delete-char ;;;!! (- (car relative-coordinate) (current-column)))) ;;;!! ((< (current-column) (car relative-coordinate)) ;;;!! (mouse-multiple-insert ;;;!! (- (car relative-coordinate) (current-column)) " ")) ;;;!! ((= (current-column) (car relative-coordinate)) (ding)))))) ;; Choose a completion with the mouse. (defun mouse-choose-completion (event) "Click on an alternative in the `*Completions*' buffer to choose it." (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (let ((buffer (window-buffer)) choice base-size) (save-excursion (set-buffer (window-buffer (posn-window (event-start event)))) (if completion-reference-buffer (setq buffer completion-reference-buffer)) (setq base-size completion-base-size) (save-excursion (goto-char (posn-point (event-start event))) (let (beg end) (if (and (not (eobp)) (get-text-property (point) 'mouse-face)) (setq end (point) beg (1+ (point)))) (if (null beg) (error "No completion here")) (setq beg (previous-single-property-change beg 'mouse-face)) (setq end (or (next-single-property-change end 'mouse-face) (point-max))) (setq choice (buffer-substring beg end))))) (let ((owindow (selected-window))) (select-window (posn-window (event-start event))) (if (and (one-window-p t 'selected-frame) (window-dedicated-p (selected-window))) ;; This is a special buffer's frame (iconify-frame (selected-frame)) (or (window-dedicated-p (selected-window)) (bury-buffer))) (select-window owindow)) (choose-completion-string choice buffer base-size))) ;; Font selection. (defun font-menu-add-default () (let* ((default (cdr (assq 'font (frame-parameters (selected-frame))))) (font-alist x-fixed-font-alist) (elt (or (assoc "Misc" font-alist) (nth 1 font-alist)))) (if (assoc "Default" elt) (delete (assoc "Default" elt) elt)) (setcdr elt (cons (list "Default" (cdr (assq 'font (frame-parameters (selected-frame))))) (cdr elt))))) (defvar x-fixed-font-alist '("Font menu" ("Misc" ;; For these, we specify the pixel height and width. ("fixed" "fixed") ("6x10" "-misc-fixed-medium-r-normal--10-*-*-*-c-60-iso8859-1" "6x10") ("6x12" "-misc-fixed-medium-r-semicondensed--12-*-*-*-c-60-iso8859-1" "6x12") ("6x13" "-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1" "6x13") ("7x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-70-iso8859-1" "7x13") ("7x14" "-misc-fixed-medium-r-normal--14-*-*-*-c-70-iso8859-1" "7x14") ("8x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-80-iso8859-1" "8x13") ("9x15" "-misc-fixed-medium-r-normal--15-*-*-*-c-90-iso8859-1" "9x15") ("10x20" "-misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1" "10x20") ("11x18" "-misc-fixed-medium-r-normal--18-*-*-*-c-110-iso8859-1" "11x18") ("12x24" "-misc-fixed-medium-r-normal--24-*-*-*-c-120-iso8859-1" "12x24") ("") ("clean 5x8" "-schumacher-clean-medium-r-normal--8-*-*-*-c-50-iso8859-1") ("clean 6x8" "-schumacher-clean-medium-r-normal--8-*-*-*-c-60-iso8859-1") ("clean 8x8" "-schumacher-clean-medium-r-normal--8-*-*-*-c-80-iso8859-1") ("clean 8x10" "-schumacher-clean-medium-r-normal--10-*-*-*-c-80-iso8859-1") ("clean 8x14" "-schumacher-clean-medium-r-normal--14-*-*-*-c-80-iso8859-1") ("clean 8x16" "-schumacher-clean-medium-r-normal--16-*-*-*-c-80-iso8859-1") ("") ("sony 8x16" "-sony-fixed-medium-r-normal--16-*-*-*-c-80-iso8859-1")) ;;; We don't seem to have these; who knows what they are. ;;; ("fg-18" "fg-18") ;;; ("fg-25" "fg-25") ;;; ("lucidasanstypewriter-12" "lucidasanstypewriter-12") ;;; ("lucidasanstypewriter-bold-14" "lucidasanstypewriter-bold-14") ;;; ("lucidasanstypewriter-bold-24" "lucidasanstypewriter-bold-24") ;;; ("lucidatypewriter-bold-r-24" "-b&h-lucidatypewriter-bold-r-normal-sans-24-240-75-75-m-140-iso8859-1") ;;; ("fixed-medium-20" "-misc-fixed-medium-*-*-*-20-*-*-*-*-*-*-*") ("Courier" ;; For these, we specify the point height. ("8" "-adobe-courier-medium-r-normal--*-80-*-*-m-*-iso8859-1") ("10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-iso8859-1") ("12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1") ("14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-iso8859-1") ("18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-iso8859-1") ("24" "-adobe-courier-medium-r-normal--*-240-*-*-m-*-iso8859-1") ("8 bold" "-adobe-courier-bold-r-normal--*-80-*-*-m-*-iso8859-1") ("10 bold" "-adobe-courier-bold-r-normal--*-100-*-*-m-*-iso8859-1") ("12 bold" "-adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1") ("14 bold" "-adobe-courier-bold-r-normal--*-140-*-*-m-*-iso8859-1") ("18 bold" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-iso8859-1") ("24 bold" "-adobe-courier-bold-r-normal--*-240-*-*-m-*-iso8859-1") ("8 slant" "-adobe-courier-medium-o-normal--*-80-*-*-m-*-iso8859-1") ("10 slant" "-adobe-courier-medium-o-normal--*-100-*-*-m-*-iso8859-1") ("12 slant" "-adobe-courier-medium-o-normal--*-120-*-*-m-*-iso8859-1") ("14 slant" "-adobe-courier-medium-o-normal--*-140-*-*-m-*-iso8859-1") ("18 slant" "-adobe-courier-medium-o-normal--*-180-*-*-m-*-iso8859-1") ("24 slant" "-adobe-courier-medium-o-normal--*-240-*-*-m-*-iso8859-1") ("8 bold slant" "-adobe-courier-bold-o-normal--*-80-*-*-m-*-iso8859-1") ("10 bold slant" "-adobe-courier-bold-o-normal--*-100-*-*-m-*-iso8859-1") ("12 bold slant" "-adobe-courier-bold-o-normal--*-120-*-*-m-*-iso8859-1") ("14 bold slant" "-adobe-courier-bold-o-normal--*-140-*-*-m-*-iso8859-1") ("18 bold slant" "-adobe-courier-bold-o-normal--*-180-*-*-m-*-iso8859-1") ("24 bold slant" "-adobe-courier-bold-o-normal--*-240-*-*-m-*-iso8859-1")) ) "X fonts suitable for use in Emacs.") (defun mouse-set-font (&rest fonts) "Select an emacs font from a list of known good fonts" (interactive (x-popup-menu last-nonmenu-event x-fixed-font-alist)) (if fonts (let (font) (while fonts (condition-case nil (progn (set-default-font (car fonts)) (setq font (car fonts)) (setq fonts nil)) (error (setq fonts (cdr fonts))))) (if (null font) (error "Font not found"))))) ;;; Bindings for mouse commands. (define-key global-map [down-mouse-1] 'mouse-drag-region) (global-set-key [mouse-1] 'mouse-set-point) (global-set-key [drag-mouse-1] 'mouse-set-region) ;; These are tested for in mouse-drag-region. (global-set-key [double-mouse-1] 'mouse-set-point) (global-set-key [triple-mouse-1] 'mouse-set-point) (global-set-key [mouse-2] 'mouse-yank-at-click) (global-set-key [mouse-3] 'mouse-save-then-kill) ;; By binding these to down-going events, we let the user use the up-going ;; event to make the selection, saving a click. (global-set-key [C-down-mouse-1] 'mouse-buffer-menu) (if (not (eq system-type 'ms-dos)) (global-set-key [S-down-mouse-1] 'mouse-set-font)) ;; C-down-mouse-2 is bound in facemenu.el. (global-set-key [C-down-mouse-3] 'mouse-major-mode-menu) ;; Replaced with dragging mouse-1 ;; (global-set-key [S-mouse-1] 'mouse-set-mark) (global-set-key [mode-line mouse-1] 'mouse-select-window) (global-set-key [mode-line drag-mouse-1] 'mouse-select-window) (global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line) (global-set-key [mode-line mouse-2] 'mouse-delete-other-windows) (global-set-key [mode-line mouse-3] 'mouse-delete-window) (global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally) (global-set-key [vertical-scroll-bar C-mouse-2] 'mouse-split-window-vertically) (global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically) (global-set-key [vertical-line down-mouse-1] 'mouse-drag-vertical-line) (global-set-key [vertical-line mouse-1] 'mouse-select-window) (provide 'mouse) ;;; mouse.el ends here emacs-19.30/lisp/mpuz.el100444 12120 1 34777 5551065362 13435 0ustar rmsdaemon;;; mpuz.el --- multiplication puzzle for GNU Emacs ;;; Copyright (C) 1990 Free Software Foundation, Inc. ;; Author: Philippe Schnoebelen ;; Keywords: games ;; 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: ;; When this package is loaded, `M-x mpuz' generates a random multiplication ;; puzzle. This is a multiplication example in which each digit has been ;; consistently replaced with some letter. Your job is to reconstruct ;; the original digits. Type `?' while the mode is active for detailed help. ;;; Code: (random t) ; randomize (defvar mpuz-silent nil "*Set this to T if you don't want dings on inputs.") (defun mpuz-ding () "Dings, unless global variable `mpuz-silent' forbids it." (or mpuz-silent (ding t))) ;; Mpuz mode and keymaps ;;---------------------- (defvar mpuz-mode-hook nil) (defvar mpuz-mode-map nil "Local keymap to use in Mult Puzzle.") (if mpuz-mode-map nil (setq mpuz-mode-map (make-sparse-keymap)) (define-key mpuz-mode-map "a" 'mpuz-try-letter) (define-key mpuz-mode-map "b" 'mpuz-try-letter) (define-key mpuz-mode-map "c" 'mpuz-try-letter) (define-key mpuz-mode-map "d" 'mpuz-try-letter) (define-key mpuz-mode-map "e" 'mpuz-try-letter) (define-key mpuz-mode-map "f" 'mpuz-try-letter) (define-key mpuz-mode-map "g" 'mpuz-try-letter) (define-key mpuz-mode-map "h" 'mpuz-try-letter) (define-key mpuz-mode-map "i" 'mpuz-try-letter) (define-key mpuz-mode-map "j" 'mpuz-try-letter) (define-key mpuz-mode-map "A" 'mpuz-try-letter) (define-key mpuz-mode-map "B" 'mpuz-try-letter) (define-key mpuz-mode-map "C" 'mpuz-try-letter) (define-key mpuz-mode-map "D" 'mpuz-try-letter) (define-key mpuz-mode-map "E" 'mpuz-try-letter) (define-key mpuz-mode-map "F" 'mpuz-try-letter) (define-key mpuz-mode-map "G" 'mpuz-try-letter) (define-key mpuz-mode-map "H" 'mpuz-try-letter) (define-key mpuz-mode-map "I" 'mpuz-try-letter) (define-key mpuz-mode-map "J" 'mpuz-try-letter) (define-key mpuz-mode-map "\C-g" 'mpuz-offer-abort) (define-key mpuz-mode-map "?" 'describe-mode)) (defun mpuz-mode () "Multiplication puzzle mode. You have to guess which letters stand for which digits in the multiplication displayed inside the `*Mult Puzzle*' buffer. You may enter a guess for a letter's value by typing first the letter, then the digit. Thus, to guess that A=3, type A 3. To leave the game to do other editing work, just switch buffers. Then you may resume the game with M-x mpuz. You may abort a game by typing \\\\[mpuz-offer-abort]." (interactive) (setq major-mode 'mpuz-mode mode-name "Mult Puzzle") (use-local-map mpuz-mode-map) (run-hooks 'mpuz-mode-hook)) ;; Some variables for statistics ;;------------------------------ (defvar mpuz-nb-errors 0 "Number of errors made in current game.") (defvar mpuz-nb-completed-games 0 "Number of games completed.") (defvar mpuz-nb-cumulated-errors 0 "Number of errors made in previous games.") ;; Some variables for game tracking ;;--------------------------------- (defvar mpuz-in-progress nil "True if a game is currently in progress.") (defvar mpuz-found-digits (make-vector 10 nil) "A vector recording which digits have been decrypted.") (defmacro mpuz-digit-solved-p (digit) (list 'aref 'mpuz-found-digits digit)) ;; A puzzle uses a permutation of [0..9] into itself. ;; We use both the permutation and its inverse. ;;--------------------------------------------------- (defvar mpuz-digit-to-letter (make-vector 10 0) "A permutation from [0..9] to [0..9].") (defvar mpuz-letter-to-digit (make-vector 10 0) "The inverse of mpuz-digit-to-letter.") (defmacro mpuz-to-digit (letter) (list 'aref 'mpuz-letter-to-digit letter)) (defmacro mpuz-to-letter (digit) (list 'aref 'mpuz-digit-to-letter digit)) (defun mpuz-build-random-perm () "Initialize puzzle coding with a random permutation." (let ((letters (list 0 1 2 3 4 5 6 7 8 9)) ; new cons cells, because of delq (index 10) elem) (while letters (setq elem (nth (random index) letters) letters (delq elem letters) index (1- index)) (aset mpuz-digit-to-letter index elem) (aset mpuz-letter-to-digit elem index)))) ;; A puzzle also uses a board displaying a multiplication. ;; Every digit appears in the board, crypted or not. ;;------------------------------------------------------ (defvar mpuz-board (make-vector 10 nil) "The board associates to any digit the list of squares where it appears.") (defun mpuz-put-digit-on-board (number square) "Put (last digit of) NUMBER on SQUARE of the puzzle board." ;; i.e. push SQUARE on NUMBER square-list (setq number (% number 10)) (aset mpuz-board number (cons square (aref mpuz-board number)))) (defun mpuz-check-all-solved () "Check whether all digits have been solved. Return t if yes." (catch 'found (let ((digit -1)) (while (> 10 (setq digit (1+ digit))) (if (and (not (mpuz-digit-solved-p digit)) ; unsolved (aref mpuz-board digit)) ; and appearing in the puzzle ! (throw 'found nil)))) t)) ;; To build a puzzle, we take two random numbers and multiply them. ;; We also take a random permutation for encryption. ;; The random numbers are only use to see which digit appears in which square ;; of the board. Everything is stored in individual squares. ;;--------------------------------------------------------------------------- (defun mpuz-random-puzzle () "Draw random values to be multiplied in a puzzle." (mpuz-build-random-perm) (fillarray mpuz-board nil) ; erase the board (let (A B C D E) ;; A,B,C,D & E, are the five rows of our multiplication. ;; Choose random values, discarding uninteresting cases. (while (progn (setq A (random 1000) B (random 100) C (* A (% B 10)) D (* A (/ B 10)) E (* A B)) (or (< C 1000) (< D 1000)))) ; forbid leading zeros in C or D ;; Individual digits are now put on their respectives squares. ;; [NB: A square is a pair of the screen.] (mpuz-put-digit-on-board A '(2 . 9)) (mpuz-put-digit-on-board (/ A 10) '(2 . 7)) (mpuz-put-digit-on-board (/ A 100) '(2 . 5)) (mpuz-put-digit-on-board B '(4 . 9)) (mpuz-put-digit-on-board (/ B 10) '(4 . 7)) (mpuz-put-digit-on-board C '(6 . 9)) (mpuz-put-digit-on-board (/ C 10) '(6 . 7)) (mpuz-put-digit-on-board (/ C 100) '(6 . 5)) (mpuz-put-digit-on-board (/ C 1000) '(6 . 3)) (mpuz-put-digit-on-board D '(8 . 7)) (mpuz-put-digit-on-board (/ D 10) '(8 . 5)) (mpuz-put-digit-on-board (/ D 100) '(8 . 3)) (mpuz-put-digit-on-board (/ D 1000) '(8 . 1)) (mpuz-put-digit-on-board E '(10 . 9)) (mpuz-put-digit-on-board (/ E 10) '(10 . 7)) (mpuz-put-digit-on-board (/ E 100) '(10 . 5)) (mpuz-put-digit-on-board (/ E 1000) '(10 . 3)) (mpuz-put-digit-on-board (/ E 10000) '(10 . 1)))) ;; Display ;;-------- (defconst mpuz-framework " . . . Number of errors (this game): 0 x . . ------- . . . . Number of completed games: 0 . . . . --------- Average number of errors: 0.00 . . . . ." "The general picture of the puzzle screen, as a string.") (defun mpuz-create-buffer () "Create (or recreate) the puzzle buffer. Return it." (let ((buff (get-buffer-create "*Mult Puzzle*"))) (save-excursion (set-buffer buff) (let ((buffer-read-only nil)) (erase-buffer) (insert mpuz-framework) (mpuz-paint-board) (mpuz-paint-errors) (mpuz-paint-statistics))) buff)) (defun mpuz-paint-errors () "Paint error count on the puzzle screen." (mpuz-switch-to-window) (let ((buffer-read-only nil)) (goto-line 3) (move-to-column 49) (mpuz-delete-line) (insert (prin1-to-string mpuz-nb-errors)))) (defun mpuz-paint-statistics () "Paint statistics about previous games on the puzzle screen." (let* ((mean (if (zerop mpuz-nb-completed-games) 0 (/ (+ mpuz-nb-completed-games (* 200 mpuz-nb-cumulated-errors)) (* 2 mpuz-nb-completed-games)))) (frac-part (% mean 100))) (let ((buffer-read-only nil)) (goto-line 7) (move-to-column 51) (mpuz-delete-line) (insert (prin1-to-string mpuz-nb-completed-games)) (goto-line 9) (move-to-column 50) (mpuz-delete-line) (insert (format "%d.%d%d" (/ mean 100) (/ frac-part 10) (% frac-part 10)))))) (defun mpuz-paint-board () "Paint board situation on the puzzle screen." (mpuz-switch-to-window) (let ((letter -1)) (while (> 10 (setq letter (1+ letter))) (mpuz-paint-digit (mpuz-to-digit letter)))) (goto-char (point-min))) (defun mpuz-paint-digit (digit) "Paint all occurrences of DIGIT on the puzzle board." ;; (mpuz-switch-to-window) (let ((char (if (mpuz-digit-solved-p digit) (+ digit ?0) (+ (mpuz-to-letter digit) ?A))) (square-l (aref mpuz-board digit))) (let ((buffer-read-only nil)) (while square-l (goto-line (car (car square-l))) ; line before column ! (move-to-column (cdr (car square-l))) (insert char) (delete-char 1) (backward-char 1) (setq square-l (cdr square-l)))))) (defun mpuz-delete-line () "Clear from point to next newline." ; & put nothing in the kill ring (while (not (= ?\n (char-after (point)))) (delete-char 1))) (defun mpuz-get-buffer () "Get the puzzle buffer if it exists." (get-buffer "*Mult Puzzle*")) (defun mpuz-switch-to-window () "Find or create the Mult-Puzzle buffer, and display it." (let ((buff (mpuz-get-buffer))) (or buff (setq buff (mpuz-create-buffer))) (switch-to-buffer buff) (or buffer-read-only (toggle-read-only)) (mpuz-mode))) ;; Game control ;;------------- (defun mpuz-abort-game () "Abort any puzzle in progress." (message "Mult Puzzle aborted.") (setq mpuz-in-progress nil mpuz-nb-errors 0) (fillarray mpuz-board nil) (let ((buff (mpuz-get-buffer))) (if buff (kill-buffer buff)))) (defun mpuz-start-new-game () "Start a new puzzle." (message "Here we go...") (setq mpuz-nb-errors 0 mpuz-in-progress t) (fillarray mpuz-found-digits nil) ; initialize mpuz-found-digits (mpuz-random-puzzle) (mpuz-switch-to-window) (mpuz-paint-board) (mpuz-paint-errors) (mpuz-ask-for-try)) (defun mpuz-offer-new-game () "Ask if user wants to start a new puzzle." (if (y-or-n-p "Start a new game ") (mpuz-start-new-game) (message "OK. I won't."))) ;;;###autoload (defun mpuz () "Multiplication puzzle with GNU Emacs." ;; Main entry point (interactive) (mpuz-switch-to-window) (if mpuz-in-progress (mpuz-offer-abort) (mpuz-start-new-game))) (defun mpuz-offer-abort () "Ask if user wants to abort current puzzle." (interactive) (if (y-or-n-p "Abort game ") (mpuz-abort-game) (mpuz-ask-for-try))) (defun mpuz-ask-for-try () "Ask for user proposal in puzzle." (message "Your try ?")) (defun mpuz-try-letter () "Propose a digit for a letter in puzzle." (interactive) (if mpuz-in-progress (let (letter-char digit digit-char message) (setq letter-char (upcase last-command-char) digit (mpuz-to-digit (- letter-char ?A))) (cond ((mpuz-digit-solved-p digit) (message "%c already solved." letter-char)) ((null (aref mpuz-board digit)) (message "%c does not appear." letter-char)) ((progn (message "%c = " letter-char) ;; has been entered. ;; Print " =" and ;; read or = (setq digit-char (read-char)) (if (eq digit-char ?=) (setq digit-char (read-char))) (message "%c = %c" letter-char digit-char) (or (> digit-char ?9) (< digit-char ?0))) ; bad input (ding t)) (t (mpuz-try-proposal letter-char digit-char)))) (mpuz-offer-new-game))) (defun mpuz-try-proposal (letter-char digit-char) "Propose LETTER-CHAR as code for DIGIT-CHAR." (let* ((letter (- letter-char ?A)) (digit (- digit-char ?0)) (correct-digit (mpuz-to-digit letter))) (cond ((mpuz-digit-solved-p correct-digit) (message "%c has already been found.")) ((= digit correct-digit) (message "%c = %c correct !" letter-char digit-char) (mpuz-ding) (mpuz-correct-guess digit)) (t ;;; incorrect guess (message "%c = %c incorrect !" letter-char digit-char) (mpuz-ding) (setq mpuz-nb-errors (1+ mpuz-nb-errors)) (mpuz-paint-errors))))) (defun mpuz-correct-guess (digit) "Handle correct guessing of DIGIT." (aset mpuz-found-digits digit t) ; Mark digit as solved (mpuz-paint-digit digit) ; Repaint it (now as a digit) (if (mpuz-check-all-solved) (mpuz-close-game))) (defun mpuz-close-game () "Housecleaning when puzzle has been solved." (setq mpuz-in-progress nil mpuz-nb-cumulated-errors (+ mpuz-nb-cumulated-errors mpuz-nb-errors) mpuz-nb-completed-games (1+ mpuz-nb-completed-games)) (mpuz-paint-statistics) (let ((message (mpuz-congratulate))) (message message) (sit-for 4) (if (y-or-n-p (concat message " Start a new game ")) (mpuz-start-new-game) (message "Good Bye !")))) (defun mpuz-congratulate () "Build a congratulation message when puzzle is solved." (format "Puzzle solved with %d errors. %s" mpuz-nb-errors (cond ((= mpuz-nb-errors 0) "That's perfect !") ((= mpuz-nb-errors 1) "That's very good !") ((= mpuz-nb-errors 2) "That's good.") ((= mpuz-nb-errors 3) "That's not bad.") ((= mpuz-nb-errors 4) "That's not too bad...") ((and (>= mpuz-nb-errors 5) (< mpuz-nb-errors 10)) "That's bad !") ((and (>= mpuz-nb-errors 10) (< mpuz-nb-errors 15)) "That's awful.") ((>= mpuz-nb-errors 15) "That's not serious.")))) (defun mpuz-show-solution () "Display solution for debugging purposes." (interactive) (mpuz-switch-to-window) (let (digit list) (setq digit -1) (while (> 10 (setq digit (1+ digit))) (or (mpuz-digit-solved-p digit) (setq list (cons digit list)))) (mapcar 'mpuz-correct-guess list))) ;;; mpuz.el ends here emacs-19.30/lisp/msb.el100444 12120 1 77355 6045436206 13220 0ustar rmsdaemon;;; msb.el --- Customizable buffer-selection with multiple menus. ;; Copyright (C) 1993, 1994, 1995 Lars Lindberg ;; ;; Author: Lars Lindberg ;; Created: 8 Oct 1993 ;; Lindberg's last update version: 3.31 ;; Keywords: mouse buffer menu ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; ;; Purpose of this package: ;; 1. Offer a function for letting the user choose buffer, ;; not necessarily for switching to it. ;; 2. Make a better mouse-buffer-menu. ;; ;; Installation: ;; 1. Byte compile msb first. It uses things in the cl package that ;; are slow if not compiled, but blazingly fast when compiled. I ;; have also had one report that said that msb malfunctioned when ;; not compiled. ;; 2. (require 'msb) ;; Note! You now use msb instead of mouse-buffer-menu. ;; 3. Now try the menu bar Buffers menu. ;; ;; Customization: ;; Look at the variable `msb-menu-cond' for deciding what menus you ;; want. It's not that hard to customize, despite my not-so-good ;; doc-string. Feel free to send me a better doc-string. ;; There are some constants for you to try here: ;; msb--few-menus ;; msb--very-many-menus (default) ;; ;; Look at the variable `msb-item-handling-function' for customization ;; of the appearance of every menu item. Try for instance setting ;; it to `msb-alon-item-handler'. ;; ;; Look at the variable `msb-item-sort-function' for customization ;; of sorting the menus. Set it to t for instance, which means no ;; sorting - you will get latest used buffer first. ;; ;; Also check out the variable `msb-display-invisible-buffers-p'. ;; Known bugs: ;; - Files-by-directory ;; + No possibility to show client/changed buffers separately. ;; + All file buffers only appear in in a file sub-menu, they will ;; for instance not appear in the Mail sub-menu. ;; Future enhancements: ;;; Thanks goes to ;; Mark Brader ;; Jim Berry ;; Hans Chalupsky ;; Larry Rosenberg ;; Will Henney ;; Jari Aalto ;; Michael Kifer ;; Gael Marziou ;; Dave Gillespie ;; Alon Albert ;; Kevin Broadey, ;; Ake Stenhof ;; Richard Stallman ;; Steve Fisk ;;; Code: (require 'cl) ;;; ;;; Some example constants to be used for `msb-menu-cond'. See that ;;; variable for more information. Please note that if the condition ;;; returns `multi', then the buffer can appear in several menus. ;;; (defconst msb--few-menus '(((and (boundp 'server-buffer-clients) server-buffer-clients 'multi) 3030 "Clients (%d)") ((and msb-display-invisible-buffers-p (msb-invisible-buffer-p) 'multi) 3090 "Invisible buffers (%d)") ((eq major-mode 'dired-mode) 2010 "Dired (%d)" msb-dired-item-handler msb-sort-by-directory) ((eq major-mode 'Man-mode) 4090 "Manuals (%d)") ((eq major-mode 'w3-mode) 4020 "WWW (%d)") ((or (memq major-mode '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode)) (memq major-mode '(mh-letter-mode mh-show-mode mh-folder-mode)) (memq major-mode '(gnus-summary-mode news-reply-mode gnus-group-mode gnus-article-mode gnus-kill-file-mode gnus-browse-killed-mode))) 4010 "Mail (%d)") ((not buffer-file-name) 4099 "Buffers (%d)") ('no-multi 1099 "Files (%d)"))) (defconst msb--very-many-menus '(((and (boundp 'server-buffer-clients) server-buffer-clients 'multi) 1010 "Clients (%d)") ((and (boundp 'vc-mode) vc-mode 'multi) 1020 "Version Control (%d)") ((and buffer-file-name (buffer-modified-p) 'multi) 1030 "Changed files (%d)") ((and (get-buffer-process (current-buffer)) 'multi) 1040 "Processes (%d)") ((and msb-display-invisible-buffers-p (msb-invisible-buffer-p) 'multi) 1090 "Invisible buffers (%d)") ((eq major-mode 'dired-mode) 2010 "Dired (%d)" ;; Note this different menu-handler msb-dired-item-handler ;; Also note this item-sorter msb-sort-by-directory) ((eq major-mode 'Man-mode) 4030 "Manuals (%d)") ((eq major-mode 'w3-mode) 4020 "WWW (%d)") ((or (memq major-mode '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode)) (memq major-mode '(mh-letter-mode mh-show-mode mh-folder-mode)) (memq major-mode '(gnus-summary-mode news-reply-mode gnus-group-mode gnus-article-mode gnus-kill-file-mode gnus-browse-killed-mode))) 4010 "Mail (%d)") ;; Catchup for all non-file buffers ((and (not buffer-file-name) 'no-multi) 4099 "Other non-file buffers (%d)") ((and (string-match "/\\.[^/]*$" buffer-file-name) 'multi) 3090 "Hidden Files (%d)") ((memq major-mode '(c-mode c++-mode)) 3010 "C/C++ Files (%d)") ((eq major-mode 'emacs-lisp-mode) 3020 "Elisp Files (%d)") ((eq major-mode 'latex-mode) 3030 "LaTex Files (%d)") ('no-multi 3099 "Other files (%d)"))) ;; msb--many-menus is obsolete (defvar msb--many-menus msb--very-many-menus) ;;; ;;; Customizable variables ;;; (defvar msb-separator-diff 100 "*Non-nil means use separators. The separators will appear between all menus that have a sorting key that differs by this value or more.") (defvar msb-files-by-directory-sort-key 0 "*The sort key for files sorted by directory") (defvar msb-max-menu-items 15 "*The maximum number of items in a menu. If this variable is set to 15 for instance, then the submenu will be split up in minor parts, 15 items each. Nil means no limit.") (defvar msb-max-file-menu-items 10 "*The maximum number of items from different directories. When the menu is of type `file by directory', this is the maximum number of buffers that are clumped togehter from different directories. Set this to 1 if you want one menu per directory instead of clumping them together. If the value is not a number, then the value 10 is used.") (defvar msb-most-recently-used-sort-key -1010 "*Where should the menu with the most recently used buffers be placed?") (defvar msb-display-most-recently-used 15 "*How many buffers should be in the most-recently-used menu. No buffers at all if less than 1 or nil (or any non-number).") (defvar msb-most-recently-used-title "Most recently used (%d)" "*The title for the most-recently-used menu.") (defvar msb-horizontal-shift-function '(lambda () 0) "*Function that specifies a number of pixels by which the top menu should be shifted leftwards.") (defvar msb-display-invisible-buffers-p nil "*Show invisible buffers or not. Non-nil means that the buffer menu should include buffers that have names that starts with a space character.") (defvar msb-item-handling-function 'msb-item-handler "*The appearance of a buffer menu. The default function to call for handling the appearance of a menu item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH, where the latter is the max length of all buffer names. The function should return the string to use in the menu. When the function is called, BUFFER is the current buffer. This function is called for items in the variable `msb-menu-cond' that have nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more information.") (defvar msb-item-sort-function 'msb-sort-by-name "*The order of items in a buffer menu. The default function to call for handling the order of items in a menu item. This function is called like a sort function. The items look like (ITEM-NAME . BUFFER). ITEM-NAME is the name of the item that will appear in the menu. BUFFER is the buffer, this is not necessarily the current buffer. Set this to nil or t if you don't want any sorting (faster).") (defvar msb-files-by-directory nil "*Non-nil means that files should be sorted by directory instead of the groups in msb-menu-cond.") (defvar msb-menu-cond msb--very-many-menus "*List of criterias for splitting the mouse buffer menu. The elements in the list should be of this type: (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN). When making the split, the buffers are tested one by one against the CONDITION, just like a lisp cond: When hitting a true condition, the other criterias are *not* tested and the buffer name will appear in the menu with the menu-title corresponding to the true condition. If the condition returns the symbol `multi', then the buffer will be added to this menu *and* tested for other menus too. If it returns `no-multi', then the buffer will only be added if it hasn't been added to any other menu. During this test, the buffer in question is the current buffer, and the test is surrounded by calls to `save-excursion' and `save-match-data'. The categories are sorted by MENU-SORT-KEY. Smaller keys are on top. nil means don't display this menu. MENU-TITLE is really a format. If you add %d in it, the %d is replaced with the number of items in that menu. ITEM-HANDLING-FN, is optional. If it is supplied and is a function, than it is used for displaying the items in that particular buffer menu, otherwise the function pointed out by `msb-item-handling-function' is used. ITEM-SORT-FN, is also optional. If it is not supplied, the function pointed out by `msb-item-sort-function' is used. If it is nil, then no sort takes place and the buffers are presented in least-recently-used order. If it is t, then no sort takes place and the buffers are presented in most-recently-used order. If it is supplied and non-nil and not t than it is used for sorting the items in that particular buffer menu. Note1: There should always be a `catch-all' as last element, in this list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION). Note2: A buffer menu appears only if it has at least one buffer in it. Note3: If you have a CONDITION that can't be evaluated you will get an error every time you do \\[msb].") (defvar msb-after-load-hooks nil "Hooks to be run after the msb package has been loaded.") ;;; ;;; Internal variables ;;; ;; The last calculated menu. (defvar msb--last-buffer-menu nil) ;; If this is non-nil, then it is a string that describes the error. (defvar msb--error nil) ;;; ;;; Some example function to be used for `msb-item-handling-function'. ;;; (defun msb-item-handler (buffer &optional maxbuf) "Create one string item, concerning BUFFER, for the buffer menu. The item looks like: *% The `*' appears only if the buffer is marked as modified. The `%' appears only if the buffer is read-only. Optional second argument MAXBUF is completely ignored." (let ((name (buffer-name)) (modified (if (buffer-modified-p) "*" " ")) (read-only (if buffer-read-only "%" " "))) (format "%s%s %s" modified read-only name))) (eval-when-compile (require 'dired)) ;; `dired' can be called with a list of the form (directory file1 file2 ...) ;; which causes `dired-directory' to be in the same form. (defun msb--dired-directory () (cond ((stringp dired-directory) (abbreviate-file-name (expand-file-name dired-directory))) ((consp dired-directory) (abbreviate-file-name (expand-file-name (car dired-directory)))) (t (error "Unknown type of `dired-directory' in buffer %s" (buffer-name))))) (defun msb-dired-item-handler (buffer &optional maxbuf) "Create one string item, concerning a dired BUFFER, for the buffer menu. The item looks like: *% The `*' appears only if the buffer is marked as modified. The `%' appears only if the buffer is read-only. Optional second argument MAXBUF is completely ignored." (let ((name (msb--dired-directory)) (modified (if (buffer-modified-p) "*" " ")) (read-only (if buffer-read-only "%" " "))) (format "%s%s %s" modified read-only name))) (defun msb-alon-item-handler (buffer maxbuf) "Create one string item for the buffer menu. The item looks like: *%# The `*' appears only if the buffer is marked as modified. The `%' appears only if the buffer is read-only. The `#' appears only version control file (SCCS/RCS)." (format (format "%%%ds %%s%%s%%s %%s" maxbuf) (buffer-name buffer) (if (buffer-modified-p) "*" " ") (if buffer-read-only "%" " ") (if (and (boundp 'vc-mode) vc-mode) "#" " ") (or buffer-file-name ""))) ;;; ;;; Some example function to be used for `msb-item-sort-function'. ;;; (defun msb-sort-by-name (item1 item2) "Sorts the items depending on their buffer-name An item look like (NAME . BUFFER)." (string-lessp (buffer-name (cdr item1)) (buffer-name (cdr item2)))) (defun msb-sort-by-directory (item1 item2) "Sorts the items depending on their directory. Made for dired. An item look like (NAME . BUFFER)." (string-lessp (save-excursion (set-buffer (cdr item1)) (msb--dired-directory)) (save-excursion (set-buffer (cdr item2)) (msb--dired-directory)))) ;;; ;;; msb ;;; ;;; This function can be used instead of (mouse-buffer-menu EVENT) ;;; function in "mouse.el". ;;; (defun msb (event) "Pop up several menus of buffers for selection with the mouse. This command switches buffers in the window that you clicked on, and selects that window. See the function `mouse-select-buffer' and the variable `msb-menu-cond' for more information about how the menus are split." (interactive "e") (let ((old-window (selected-window)) (window (posn-window (event-start event)))) (unless (framep window) (select-window window)) (let ((buffer (mouse-select-buffer event))) (if buffer (switch-to-buffer buffer) (select-window old-window)))) nil) ;;; ;;; Some supportive functions ;;; (defun msb-invisible-buffer-p (&optional buffer) "Return t if optional BUFFER is an \"invisible\" buffer. If the argument is left out or nil, then the current buffer is considered." (and (> (length (buffer-name buffer)) 0) (eq ?\ (aref (buffer-name buffer) 0)))) ;; Strip one hierarcy level from the end of PATH. (defun msb--strip-path (path) (save-match-data (if (string-match "\\(.+\\)/[^/]+$" path) (substring path (match-beginning 1) (match-end 1)) "/"))) ;; Create an alist with all buffers from LIST that lies under the same ;; directory will be in the same item as the directory string as ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) ...) (defun msb--init-file-alist (list) (let ((buffer-alist (sort (mapcan (function (lambda (buffer) (let ((file-name (buffer-file-name buffer))) (when file-name (list (cons (msb--strip-path file-name) buffer)))))) list) (function (lambda (item1 item2) (string< (car item1) (car item2))))))) ;; Make alist that looks like ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...) (let ((path nil) (buffers nil) (result nil)) (append (mapcan (function (lambda (item) (cond ((and path (string= path (car item))) (push (cdr item) buffers) nil) (t (when path (setq result (cons path buffers))) (setq path (car item)) (setq buffers (list (cdr item))) (and result (list result)))))) buffer-alist) (list (cons path buffers)))))) ;; Choose file-menu with respect to directory for every buffer in LIST. (defun msb--choose-file-menu (list) (let ((buffer-alist (msb--init-file-alist list)) (final-list nil) (max-clumped-together (if (numberp msb-max-file-menu-items) msb-max-file-menu-items 10)) (top-found-p nil) (last-path nil) first rest path buffers) (setq first (car buffer-alist)) (setq rest (cdr buffer-alist)) (setq path (car first)) (setq buffers (cdr first)) (while rest (let ((found-p nil) (tmp-rest rest) new-path item) (setq item (car tmp-rest)) (while (and tmp-rest (<= (length buffers) max-clumped-together) (>= (length (car item)) (length path)) (string= path (substring (car item) 0 (length path)))) (setq found-p t) (setq buffers (append buffers (cdr item))) (setq tmp-rest (cdr tmp-rest)) (setq item (car tmp-rest))) (cond ((> (length buffers) max-clumped-together) (setq last-path (car first)) (setq first (cons (format (if top-found-p "%s/... (%d)" "%s (%d)") (car first) (length (cdr first))) (cdr first))) (setq top-found-p nil) (push first final-list) (setq first (car rest) rest (cdr rest)) (setq path (car first) buffers (cdr first))) (t (when found-p (setq top-found-p t) (setq first (cons path buffers) rest tmp-rest)) (setq path (msb--strip-path path) buffers (cdr first)) (when (and last-path (or (and (>= (length path) (length last-path)) (string= last-path (substring path 0 (length last-path)))) (and (< (length path) (length last-path)) (string= path (substring last-path 0 (length path)))))) (setq first (cons (format (if top-found-p "%s/... (%d)" "%s (%d)") (car first) (length (cdr first))) (cdr first))) (setq top-found-p nil) (push first final-list) (setq first (car rest) rest (cdr rest)) (setq path (car first) buffers (cdr first))))))) (setq first (cons (format (if top-found-p "%s/... (%d)" "%s (%d)") (car first) (length (cdr first))) (cdr first))) (setq top-found-p nil) (push first final-list) (nreverse final-list))) ;; Create a vector as: ;; [BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER) ;; from an element in `msb-menu-cond'. See that variable for a ;; description of its elements. (defun msb--create-function-info (menu-cond-elt) (let* ((list-symbol (make-symbol "-msb-buffer-list")) (tmp-ih (and (> (length menu-cond-elt) 3) (nth 3 menu-cond-elt))) (item-handler (if (and tmp-ih (fboundp tmp-ih)) tmp-ih msb-item-handling-function)) (tmp-s (if (> (length menu-cond-elt) 4) (nth 4 menu-cond-elt) msb-item-sort-function)) (sorter (if (or (fboundp tmp-s) (null tmp-s) (eq tmp-s t)) tmp-s msb-item-sort-function))) (when (< (length menu-cond-elt) 3) (error "Wrong format of msb-menu-cond.")) (when (and (> (length menu-cond-elt) 3) (not (fboundp tmp-ih))) (signal 'invalid-function (list tmp-ih))) (when (and (> (length menu-cond-elt) 4) tmp-s (not (fboundp tmp-s)) (not (eq tmp-s t))) (signal 'invalid-function (list tmp-s))) (set list-symbol ()) (vector list-symbol ;BUFFER-LIST-VARIABLE (nth 0 menu-cond-elt) ;CONDITION (nth 1 menu-cond-elt) ;SORT-KEY (nth 2 menu-cond-elt) ;MENU-TITLE item-handler ;ITEM-HANDLER sorter) ;SORTER )) ;; This defsubst is only used in `msb--choose-menu' below. It was ;; pulled out merely to make the code somewhat clearer. The indention ;; level was too big. (defsubst msb--collect (function-info-vector) (let ((result nil) (multi-flag nil) function-info-list) (setq function-info-list (loop for fi across function-info-vector if (and (setq result (eval (aref fi 1))) ;Test CONDITION (not (and (eq result 'no-multi) multi-flag)) (progn (when (eq result 'multi) (setq multi-flag t)) t)) collect fi until (and result (not (eq result 'multi))))) (when (and (not function-info-list) (not result)) (error "No catch-all in msb-menu-cond!")) function-info-list)) ;; Adds BUFFER to the menu depicted by FUNCTION-INFO ;; All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER) ;; to the buffer-list variable in function-info. (defun msb--add-to-menu (buffer function-info max-buffer-name-length) (let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE ;; Here comes the hairy side-effect! (set list-symbol (cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER buffer max-buffer-name-length) buffer) (eval list-symbol))))) ;; Selects the appropriate menu for BUFFER. ;; This is all side-effects, folks! ;; This should be optimized. (defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length) (unless (and (not msb-display-invisible-buffers-p) (msb-invisible-buffer-p buffer)) (condition-case nil (save-excursion (set-buffer buffer) ;; Menu found. Add to this menu (mapc (function (lambda (function-info) (msb--add-to-menu buffer function-info max-buffer-name-length))) (msb--collect function-info-vector))) (error (unless msb--error (setq msb--error (format "In msb-menu-cond, error for buffer `%s'." (buffer-name buffer))) (error msb--error)))))) ;; Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the ;; buffer-list is empty. (defun msb--create-sort-item (function-info) (let ((buffer-list (eval (aref function-info 0)))) (when buffer-list (let ((sorter (aref function-info 5)) ;SORTER (sort-key (aref function-info 2))) ;MENU-SORT-KEY (when sort-key (cons sort-key (cons (format (aref function-info 3) ;MENU-TITLE (length buffer-list)) (cond ((null sorter) buffer-list) ((eq sorter t) (nreverse buffer-list)) (t (sort buffer-list sorter)))))))))) ;; Returns a list on the form ((TITLE . BUFFER-LIST)) for ;; the most recently used buffers. (defun msb--most-recently-used-menu (max-buffer-name-length) (when (and (numberp msb-display-most-recently-used) (> msb-display-most-recently-used 0)) (let* ((buffers (cdr (buffer-list))) (most-recently-used (loop with n = 0 for buffer in buffers if (save-excursion (set-buffer buffer) (and (not (msb-invisible-buffer-p)) (not (eq major-mode 'dired-mode)))) collect (save-excursion (set-buffer buffer) (cons (funcall msb-item-handling-function buffer max-buffer-name-length) buffer)) and do (incf n) until (>= n msb-display-most-recently-used)))) (cons (if (stringp msb-most-recently-used-title) (format msb-most-recently-used-title (length most-recently-used)) (signal 'wrong-type-argument (list msb-most-recently-used-title))) most-recently-used)))) (defun msb--create-buffer-menu-2 () (let ((max-buffer-name-length 0) file-buffers function-info-vector) ;; Calculate the longest buffer name. (mapc (function (lambda (buffer) (if (or msb-display-invisible-buffers-p (not (msb-invisible-buffer-p))) (setq max-buffer-name-length (max max-buffer-name-length (length (buffer-name buffer))))))) (buffer-list)) ;; Make a list with elements of type ;; (BUFFER-LIST-VARIABLE ;; CONDITION ;; MENU-SORT-KEY ;; MENU-TITLE ;; ITEM-HANDLER ;; SORTER) ;; Uses "function-global" variables: ;; function-info-vector (setq function-info-vector (apply (function vector) (mapcar (function msb--create-function-info) msb-menu-cond))) ;; Split the buffer-list into several lists; one list for each ;; criteria. This is the most critical part with respect to time. (mapc (function (lambda (buffer) (cond ((and msb-files-by-directory (buffer-file-name buffer)) (push buffer file-buffers)) (t (msb--choose-menu buffer function-info-vector max-buffer-name-length))))) (buffer-list)) (when file-buffers (setq file-buffers (mapcar (function (lambda (buffer-list) (cons msb-files-by-directory-sort-key (cons (car buffer-list) (sort (mapcar (function (lambda (buffer) (cons (save-excursion (set-buffer buffer) (funcall msb-item-handling-function buffer max-buffer-name-length)) buffer))) (cdr buffer-list)) (function (lambda (item1 item2) (string< (car item1) (car item2))))))))) (msb--choose-file-menu file-buffers)))) ;; Now make the menu - a list of (TITLE . BUFFER-LIST) (let* (menu (most-recently-used (msb--most-recently-used-menu max-buffer-name-length)) (others (append file-buffers (loop for elt across function-info-vector for value = (msb--create-sort-item elt) if value collect value)))) (setq menu (mapcar 'cdr ;Remove the SORT-KEY ;; Sort the menus - not the items. (msb--add-separators (sort ;; Get a list of (SORT-KEY TITLE . BUFFER-LIST) ;; Also sorts the items within the menus. (if (cdr most-recently-used) (cons ;; Add most recent used buffers (cons msb-most-recently-used-sort-key most-recently-used) others) others) (function (lambda (elt1 elt2) (< (car elt1) (car elt2)))))))) ;; Now make it a keymap menu (append '(keymap "Select Buffer") (msb--make-keymap-menu menu) (when msb-separator-diff (list (list 'separator "---"))) (list (cons 'toggle (cons (if msb-files-by-directory "*Files by type*" "*Files by directory*") 'msb--toggle-menu-type))))))) (defun msb--create-buffer-menu () (save-match-data (save-excursion (msb--create-buffer-menu-2)))) ;;; ;;; Multi purpose function for selecting a buffer with the mouse. ;;; (defun msb--toggle-menu-type () (interactive) (setq msb-files-by-directory (not msb-files-by-directory)) (menu-bar-update-buffers t)) (defun mouse-select-buffer (event) "Pop up several menus of buffers, for selection with the mouse. Returns the selected buffer or nil if no buffer is selected. The way the buffers are split is conveniently handled with the variable `msb-menu-cond'." ;; Popup the menu and return the selected buffer. (when (or msb--error (not msb--last-buffer-menu) (not (fboundp 'frame-or-buffer-changed-p)) (frame-or-buffer-changed-p)) (setq msb--error nil) (setq msb--last-buffer-menu (msb--create-buffer-menu))) (let ((position event) choice) (when (and (fboundp 'posn-x-y) (fboundp 'posn-window)) (let ((posX (car (posn-x-y (event-start event)))) (posY (cdr (posn-x-y (event-start event)))) (posWind (posn-window (event-start event)))) ;; adjust position (setq posX (- posX (funcall msb-horizontal-shift-function)) position (list (list posX posY) posWind)))) ;; This `sit-for' magically makes the menu stay up if the mouse ;; button is released withing 0.1 second. (sit-for 0 100) ;; Popup the menu (setq choice (x-popup-menu position msb--last-buffer-menu)) (cond ((eq (car choice) 'toggle) ;; Bring up the menu again with type toggled. (msb--toggle-menu-type) (mouse-select-buffer event)) ((and (numberp (car choice)) (null (cdr choice))) (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice) msb--last-buffer-menu)))) (mouse-select-buffer event))) ((while (numberp (car choice)) (setq choice (cdr choice)))) ((and (stringp (car choice)) (null (cdr choice))) (car choice)) ((null choice) choice) (t (error "Unknown form for buffer: %s" choice))))) ;; Add separators (defun msb--add-separators (sorted-list) (cond ((or (not msb-separator-diff) (not (numberp msb-separator-diff))) sorted-list) (t (let ((last-key nil)) (mapcan (function (lambda (item) (cond ((and msb-separator-diff last-key (> (- (car item) last-key) msb-separator-diff)) (setq last-key (car item)) (list (cons last-key 'separator) item)) (t (setq last-key (car item)) (list item))))) sorted-list))))) (defun msb--split-menus-2 (list mcount result) (cond ((> (length list) msb-max-menu-items) (let ((count 0) sub-name (tmp-list nil)) (while (< count msb-max-menu-items) (push (pop list) tmp-list) (incf count)) (setq tmp-list (nreverse tmp-list)) (setq sub-name (concat (car (car tmp-list)) "...")) (push (append (list mcount sub-name 'keymap sub-name) tmp-list) result)) (msb--split-menus-2 list (1+ mcount) result)) ((null result) list) (t (let (sub-name) (setq sub-name (concat (car (car list)) "...")) (push (append (list mcount sub-name 'keymap sub-name) list) result)) (nreverse result)))) (defun msb--split-menus (list) (msb--split-menus-2 list 0 nil)) (defun msb--make-keymap-menu (raw-menu) (let ((end (cons '(nil) 'menu-bar-select-buffer)) (mcount 0)) (mapcar (function (lambda (sub-menu) (cond ((eq 'separator sub-menu) (list 'separator "---")) (t (let ((buffers (mapcar (function (lambda (item) (let ((string (car item)) (buffer (cdr item))) (cons (buffer-name buffer) (cons string end))))) (cdr sub-menu)))) (append (list (incf mcount) (car sub-menu) 'keymap (car sub-menu)) (msb--split-menus buffers))))))) raw-menu))) (defun menu-bar-update-buffers (&optional arg) ;; If user discards the Buffers item, play along. (when (and (lookup-key (current-global-map) [menu-bar buffer]) (or (not (fboundp 'frame-or-buffer-changed-p)) (frame-or-buffer-changed-p) arg)) (let ((frames (frame-list)) buffers-menu frames-menu) ;; Make the menu of buffers proper. (setq msb--last-buffer-menu (msb--create-buffer-menu)) (setq buffers-menu msb--last-buffer-menu) ;; Make a Frames menu if we have more than one frame. (when (cdr frames) (let* ((frame-length (length frames)) (f-title (format "Frames (%d)" frame-length))) ;; List only the N most recently selected frames (when (and (integerp msb-max-menu-items) (> msb-max-menu-items 1) (> frame-length msb-max-menu-items)) (setcdr (nthcdr msb-max-menu-items frames) nil)) (setq frames-menu (nconc (list 'frame f-title '(nil) 'keymap f-title) (mapcar (function (lambda (frame) (nconc (list frame (cdr (assq 'name (frame-parameters frame))) (cons nil nil)) 'menu-bar-select-frame))) frames))))) (define-key (current-global-map) [menu-bar buffer] (cons "Buffers" (if (and buffers-menu frames-menu) ;; Combine Frame and Buffers menus with separator between (nconc (list 'keymap "Buffers and Frames" frames-menu (and msb-separator-diff '(separator "---"))) (cddr buffers-menu)) (or buffers-menu 'undefined))))))) (when (and (boundp 'menu-bar-update-hook) (not (fboundp 'frame-or-buffer-changed-p))) (defvar msb--buffer-count 0) (defun frame-or-buffer-changed-p () (let ((count (length (buffer-list)))) (when (/= count msb--buffer-count) (setq msb--buffer-count count) t)))) (unless (or (not (boundp 'menu-bar-update-hook)) (memq 'menu-bar-update-buffers menu-bar-update-hook)) (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)) (and (fboundp 'mouse-buffer-menu) (substitute-key-definition 'mouse-buffer-menu 'msb (current-global-map))) (provide 'msb) (eval-after-load 'msb (run-hooks 'msb-after-load-hooks)) ;;; msb.el ends here emacs-19.30/lisp/nnbabyl.el100444 23053 1 45112 6046561600 14364 0ustar larsidaemon;;; nnbabyl.el --- rmail mbox access for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; For an overview of what the interface functions do, please see the ;; Gnus sources. ;;; Code: (require 'nnheader) (require 'rmail) (require 'nnmail) (defvar nnbabyl-mbox-file (expand-file-name "~/RMAIL") "The name of the rmail box file in the users home directory.") (defvar nnbabyl-active-file (expand-file-name "~/.rmail-active") "The name of the active file for the rmail box.") (defvar nnbabyl-get-new-mail t "If non-nil, nnbabyl will check the incoming mail file and split the mail.") (defvar nnbabyl-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") (defvar nnbabyl-mail-delimiter "\^_") (defconst nnbabyl-version "nnbabyl 1.0" "nnbabyl version.") (defvar nnbabyl-mbox-buffer nil) (defvar nnbabyl-current-group nil) (defvar nnbabyl-status-string "") (defvar nnbabyl-group-alist nil) (defvar nnbabyl-active-timestamp nil) (defvar nnbabyl-current-server nil) (defvar nnbabyl-server-alist nil) (defvar nnbabyl-server-variables (list (list 'nnbabyl-mbox-file nnbabyl-mbox-file) (list 'nnbabyl-active-file nnbabyl-active-file) (list 'nnbabyl-get-new-mail nnbabyl-get-new-mail) '(nnbabyl-current-group nil) '(nnbabyl-status-string "") '(nnbabyl-group-alist nil))) ;;; Interface functions (defun nnbabyl-retrieve-headers (sequence &optional newsgroup server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let ((number (length sequence)) (count 0) article art-string start stop) (nnbabyl-possibly-change-newsgroup newsgroup) (if (stringp (car sequence)) 'headers (while sequence (setq article (car sequence)) (setq art-string (nnbabyl-article-string article)) (set-buffer nnbabyl-mbox-buffer) (if (or (search-forward art-string nil t) (search-backward art-string nil t)) (progn (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) (while (and (not (looking-at ".+:")) (zerop (forward-line 1)))) (setq start (point)) (search-forward "\n\n" nil t) (setq stop (1- (point))) (set-buffer nntp-server-buffer) (insert "221 " (int-to-string article) " Article retrieved.\n") (insert-buffer-substring nnbabyl-mbox-buffer start stop) (goto-char (point-max)) (insert ".\n"))) (setq sequence (cdr sequence)) (setq count (1+ count)) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) (zerop (% count 20)) gnus-verbose-backends (message "nnbabyl: Receiving headers... %d%%" (/ (* count 100) number)))) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) gnus-verbose-backends (message "nnbabyl: Receiving headers...done")) ;; Fold continuation lines. (set-buffer nntp-server-buffer) (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers)))) (defun nnbabyl-open-server (server &optional defs) (nnheader-init-server-buffer) (if (equal server nnbabyl-current-server) t (if nnbabyl-current-server (setq nnbabyl-server-alist (cons (list nnbabyl-current-server (nnheader-save-variables nnbabyl-server-variables)) nnbabyl-server-alist))) (let ((state (assoc server nnbabyl-server-alist))) (if state (progn (nnheader-restore-variables (nth 1 state)) (setq nnbabyl-server-alist (delq state nnbabyl-server-alist))) (nnheader-set-init-variables nnbabyl-server-variables defs))) (setq nnbabyl-current-server server))) (defun nnbabyl-close-server (&optional server) t) (defun nnbabyl-server-opened (&optional server) (and (equal server nnbabyl-current-server) nnbabyl-mbox-buffer (buffer-name nnbabyl-mbox-buffer) nntp-server-buffer (buffer-name nntp-server-buffer))) (defun nnbabyl-status-message (&optional server) nnbabyl-status-string) (defun nnbabyl-request-article (article &optional newsgroup server buffer) (nnbabyl-possibly-change-newsgroup newsgroup) (if (stringp article) nil (save-excursion (set-buffer nnbabyl-mbox-buffer) (goto-char (point-min)) (if (search-forward (nnbabyl-article-string article) nil t) (let (start stop summary-line) (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) (while (and (not (looking-at ".+:")) (zerop (forward-line 1)))) (setq start (point)) (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter) nil t) (forward-line -1)) (goto-char (point-max))) (setq stop (point)) (let ((nntp-server-buffer (or buffer nntp-server-buffer))) (set-buffer nntp-server-buffer) (erase-buffer) (insert-buffer-substring nnbabyl-mbox-buffer start stop) (goto-char (point-min)) ;; If there is an EOOH header, then we have to remove some ;; duplicated headers. (setq summary-line (looking-at "Summary-line:")) (if (search-forward "\n*** EOOH ***" nil t) (if summary-line ;; The headers to be deleted are located before the ;; EOOH line... (delete-region (point-min) (progn (forward-line 1) (point))) ;; ...or after. (delete-region (progn (beginning-of-line) (point)) (or (search-forward "\n\n" nil t) (point))))) t)))))) (defun nnbabyl-request-group (group &optional server dont-check) (save-excursion (if (nnbabyl-possibly-change-newsgroup group) (if dont-check t (nnbabyl-get-new-mail group) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let ((active (assoc group nnbabyl-group-alist))) (insert (format "211 %d %d %d %s\n" (1+ (- (cdr (car (cdr active))) (car (car (cdr active))))) (car (car (cdr active))) (cdr (car (cdr active))) (car active)))) t))))) (defun nnbabyl-close-group (group &optional server) t) (defun nnbabyl-request-create-group (group &optional server) (nnmail-activate 'nnbabyl) (or (assoc group nnbabyl-group-alist) (let (active) (setq nnbabyl-group-alist (cons (list group (setq active (cons 1 0))) nnbabyl-group-alist)) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))) t) (defun nnbabyl-request-list (&optional server) (if server (nnbabyl-get-new-mail)) (save-excursion (or (nnmail-find-file nnbabyl-active-file) (progn (setq nnbabyl-group-alist (nnmail-get-active)) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) (nnmail-find-file nnbabyl-active-file))))) (defun nnbabyl-request-newgroups (date &optional server) (nnbabyl-request-list server)) (defun nnbabyl-request-list-newsgroups (&optional server) (setq nnbabyl-status-string "nnbabyl: LIST NEWSGROUPS is not implemented.") nil) (defun nnbabyl-request-post (&optional server) (mail-send-and-exit nil)) (defalias 'nnbabyl-request-post-buffer 'nnmail-request-post-buffer) (defun nnbabyl-request-expire-articles (articles newsgroup &optional server force) (nnbabyl-possibly-change-newsgroup newsgroup) (let* ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function newsgroup)) nnmail-expiry-wait)) (is-old t) rest) (nnmail-activate 'nnbabyl) (save-excursion (set-buffer nnbabyl-mbox-buffer) (set-text-properties (point-min) (point-max) nil) (while (and articles is-old) (goto-char (point-min)) (if (search-forward (nnbabyl-article-string (car articles)) nil t) (if (or force (setq is-old (> (nnmail-days-between (current-time-string) (buffer-substring (point) (progn (end-of-line) (point)))) days))) (progn (and gnus-verbose-backends (message "Deleting article %s..." (car articles))) (nnbabyl-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) (save-buffer) ;; Find the lowest active article in this group. (let ((active (nth 1 (assoc newsgroup nnbabyl-group-alist)))) (goto-char (point-min)) (while (and (not (search-forward (nnbabyl-article-string (car active)) nil t)) (<= (car active) (cdr active))) (setcar active (1+ (car active))) (goto-char (point-min)))) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) (nconc rest articles)))) (defun nnbabyl-request-move-article (article group server accept-form &optional last) (nnbabyl-possibly-change-newsgroup group) (let ((buf (get-buffer-create " *nnbabyl move*")) result) (and (nnbabyl-request-article article group server) (save-excursion (set-buffer buf) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) (if (re-search-forward "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) (setq result (eval accept-form)) (kill-buffer (current-buffer)) result) (save-excursion (set-buffer nnbabyl-mbox-buffer) (goto-char (point-min)) (if (search-forward (nnbabyl-article-string article) nil t) (nnbabyl-delete-mail)) (and last (save-buffer)))) result)) (defun nnbabyl-request-accept-article (group &optional last) (let ((buf (current-buffer)) result beg) (and (nnmail-activate 'nnbabyl) (save-excursion (goto-char (point-min)) (search-forward "\n\n" nil t) (forward-line -1) (save-excursion (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) (let ((nnmail-split-methods (if (stringp group) (list (list group "")) nnmail-split-methods))) (setq result (car (nnbabyl-save-mail)))) (set-buffer nnbabyl-mbox-buffer) (goto-char (point-max)) (search-backward "\n\^_") (goto-char (match-end 0)) (insert-buffer buf) (and last (progn (save-buffer) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))) result)))) (defun nnbabyl-request-replace-article (article group buffer) (nnbabyl-possibly-change-newsgroup group) (save-excursion (set-buffer nnbabyl-mbox-buffer) (goto-char (point-min)) (if (not (search-forward (nnbabyl-article-string article) nil t)) nil (nnbabyl-delete-mail t t) (insert-buffer-substring buffer) (save-buffer) t))) ;;; Low-Level Interface ;; If FORCE, delete article no matter how many X-Gnus-Newsgroup ;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox ;; delimeter line. (defun nnbabyl-delete-mail (&optional force leave-delim) ;; Delete the current X-Gnus-Newsgroup line. (or force (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) ;; Beginning of the article. (save-excursion (save-restriction (widen) (narrow-to-region (save-excursion (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) (if leave-delim (progn (forward-line 1) (point)) (match-beginning 0))) (progn (forward-line 1) (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter) nil t) (if (and (not (bobp)) leave-delim) (progn (forward-line -2) (point)) (match-beginning 0))) (point-max)))) (goto-char (point-min)) ;; Only delete the article if no other groups owns it as well. (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) (delete-region (point-min) (point-max)))))) (defun nnbabyl-possibly-change-newsgroup (newsgroup) (if (or (not nnbabyl-mbox-buffer) (not (buffer-name nnbabyl-mbox-buffer))) (save-excursion (nnbabyl-read-mbox))) (or nnbabyl-group-alist (nnmail-activate 'nnbabyl)) (if newsgroup (if (assoc newsgroup nnbabyl-group-alist) (setq nnbabyl-current-group newsgroup) (setq nnbabyl-status-string "No such group in file") nil))) (defun nnbabyl-article-string (article) (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" (int-to-string article) " ")) (defun nnbabyl-insert-lines () "Insert how many lines and chars there are in the body of the mail." (let (lines chars) (save-excursion (goto-char (point-min)) (if (search-forward "\n\n" nil t) (progn ;; There may be an EOOH line here... (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*") (search-forward "\n\n" nil t)) (setq chars (- (point-max) (point))) (setq lines (- (count-lines (point) (point-max)) 1)) ;; Move back to the end of the headers. (goto-char (point-min)) (search-forward "\n\n" nil t) (forward-char -1) (save-excursion (if (re-search-backward "^Lines: " nil t) (delete-region (point) (progn (forward-line 1) (point))))) (insert (format "Lines: %d\n" lines)) chars))))) (defun nnbabyl-save-mail () ;; Called narrowed to an article. (let ((group-art (nreverse (nnmail-article-group 'nnbabyl-active-number)))) (nnbabyl-insert-lines) (nnmail-insert-xref group-art) (nnbabyl-insert-newsgroup-line group-art) (run-hooks 'nnbabyl-prepare-save-mail-hook) group-art)) (defun nnbabyl-insert-newsgroup-line (group-art) (save-excursion (goto-char (point-min)) (while (looking-at "From ") (replace-match "Mail-from: From " t t) (forward-line 1)) ;; If there is a C-l at the beginning of the narrowed region, this ;; isn't really a "save", but rather a "scan". (goto-char (point-min)) (or (looking-at "\^L") (save-excursion (insert "\^L\n0, unseen,,\n*** EOOH ***\n") (goto-char (point-max)) (insert "\^_\n"))) (if (search-forward "\n\n" nil t) (progn (forward-char -1) (while group-art (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" (car (car group-art)) (cdr (car group-art)) (current-time-string))) (setq group-art (cdr group-art))))) t)) (defun nnbabyl-active-number (group) ;; Find the next article number in GROUP. (let ((active (car (cdr (assoc group nnbabyl-group-alist))))) (if active (setcdr active (1+ (cdr active))) ;; This group is new, so we create a new entry for it. ;; This might be a bit naughty... creating groups on the drop of ;; a hat, but I don't know... (setq nnbabyl-group-alist (cons (list group (setq active (cons 1 1))) nnbabyl-group-alist))) (cdr active))) (defun nnbabyl-read-mbox () (nnmail-activate 'nnbabyl) (or (file-exists-p nnbabyl-mbox-file) (save-excursion (set-buffer (setq nnbabyl-mbox-buffer (create-file-buffer nnbabyl-mbox-file))) (setq buffer-file-name nnbabyl-mbox-file) (insert "BABYL OPTIONS:\n\n\^_") (write-region (point-min) (point-max) nnbabyl-mbox-file t 'nomesg))) (if (and nnbabyl-mbox-buffer (buffer-name nnbabyl-mbox-buffer) (save-excursion (set-buffer nnbabyl-mbox-buffer) (= (buffer-size) (nth 7 (file-attributes nnbabyl-mbox-file))))) () (save-excursion (let ((delim (concat "^" nnbabyl-mail-delimiter)) start end) (set-buffer (setq nnbabyl-mbox-buffer (nnheader-find-file-noselect nnbabyl-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)) (widen) (setq buffer-read-only nil) (fundamental-mode) (goto-char (point-min)) (re-search-forward delim nil t) (setq start (match-end 0)) (while (re-search-forward delim nil t) (setq end (match-end 0)) (or (search-backward "\nX-Gnus-Newsgroup: " start t) (progn (goto-char end) (save-excursion (save-restriction (goto-char start) (narrow-to-region start end) (nnbabyl-save-mail) (setq end (point-max)))))) (goto-char (setq start end))) (and (buffer-modified-p (current-buffer)) (save-buffer)) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))) (defun nnbabyl-remove-incoming-delims () (goto-char (point-min)) (while (search-forward "\^_" nil t) (replace-match "?" t t))) (defun nnbabyl-get-new-mail (&optional group) "Read new incoming mail." (let* ((spools (nnmail-get-spool-files group)) (group-in group) incoming incomings) (nnbabyl-read-mbox) (if (or (not nnbabyl-get-new-mail) (not nnmail-spool-file)) () ;; We go through all the existing spool files and split the ;; mail from each. (while spools (and (file-exists-p (car spools)) (> (nth 7 (file-attributes (car spools))) 0) (progn (and gnus-verbose-backends (message "nnbabyl: Reading incoming mail...")) (if (not (setq incoming (nnmail-move-inbox (car spools) (concat nnbabyl-mbox-file "-Incoming")))) () (setq incomings (cons incoming incomings)) (save-excursion (setq group (nnmail-get-split-group (car spools) group-in)) (let* ((nnmail-prepare-incoming-hook (cons 'nnbabyl-remove-incoming-delims nnmail-prepare-incoming-hook)) in-buf) (setq in-buf (nnmail-split-incoming incoming 'nnbabyl-save-mail t group)) (set-buffer in-buf) (goto-char (point-min)) (while (search-forward "\n\^_\n" nil t) (delete-char -1)) (set-buffer nnbabyl-mbox-buffer) (goto-char (point-max)) (search-backward "\n\^_" nil t) (goto-char (match-end 0)) (insert-buffer-substring in-buf) (kill-buffer in-buf)))))) (setq spools (cdr spools))) ;; If we did indeed read any incoming spools, we save all info. (and (buffer-modified-p nnbabyl-mbox-buffer) (save-excursion (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) (set-buffer nnbabyl-mbox-buffer) (save-buffer))) (if incomings (run-hooks 'nnmail-read-incoming-hook)) (while incomings (setq incoming (car incomings)) (and nnmail-delete-incoming (file-exists-p incoming) (file-writable-p incoming) (delete-file incoming)) (setq incomings (cdr incomings)))))) (provide 'nnbabyl) ;;; nnbabyl.el ends here emacs-19.30/lisp/nndir.el100444 23053 1 10273 6046561612 14054 0ustar larsidaemon;;; nndir.el --- single directory newsgroup access for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Code: (require 'nnheader) (require 'nnmh) (require 'nnml) (eval-and-compile (autoload 'mail-send-and-exit "sendmail")) (defconst nndir-version "nndir 1.0") (defvar nndir-current-directory nil "Current news group directory.") (defvar nndir-status-string "") (defvar nndir-nov-is-evil nil "*Non-nil means that nndir will never retrieve NOV headers.") ;;; Interface functions. (defun nndir-retrieve-headers (sequence &optional newsgroup server) (nndir-execute-nnml-command '(nnml-retrieve-headers sequence group server) server)) (defun nndir-open-server (host &optional service) "Open nndir backend." (setq nndir-status-string "") (nnheader-init-server-buffer)) (defun nndir-close-server (&optional server) "Close news server." t) (defun nndir-server-opened (&optional server) "Return server process status, T or NIL. If the stream is opened, return T, otherwise return NIL." (and nntp-server-buffer (get-buffer nntp-server-buffer))) (defun nndir-status-message (&optional server) "Return server status response as string." nndir-status-string) (defun nndir-request-article (id &optional newsgroup server buffer) (nndir-execute-nnmh-command '(nnmh-request-article id group server buffer) server)) (defun nndir-request-group (group &optional server dont-check) "Select news GROUP." (nndir-execute-nnmh-command '(nnmh-request-group group "" dont-check) server)) (defun nndir-request-list (&optional server dir) "Get list of active articles in all newsgroups." (nndir-execute-nnmh-command '(nnmh-request-list nil dir) server)) (defun nndir-request-newgroups (date &optional server) (nndir-execute-nnmh-command '(nnmh-request-newgroups date server) server)) (defun nndir-request-post (&optional server) "Post a new news in current buffer." (mail-send-and-exit nil)) (defalias 'nndir-request-post-buffer 'nnmail-request-post-buffer) (defun nndir-request-expire-articles (articles newsgroup &optional server force) "Expire all articles in the ARTICLES list in group GROUP." (setq nndir-status-string "nndir: expire not possible") nil) (defun nndir-close-group (group &optional server) t) (defun nndir-request-move-article (article group server accept-form) (setq nndir-status-string "nndir: move not possible") nil) (defun nndir-request-accept-article (group) (setq nndir-status-string "nndir: accept not possible") nil) ;;; Low-Level Interface (defun nndir-execute-nnmh-command (command server) (let ((dir (expand-file-name server))) (and (string-match "/$" dir) (setq dir (substring dir 0 (match-beginning 0)))) (string-match "/[^/]+$" dir) (let ((group (substring dir (1+ (match-beginning 0)))) (nnmh-directory (substring dir 0 (1+ (match-beginning 0)))) (nnmh-get-new-mail nil)) (eval command)))) (defun nndir-execute-nnml-command (command server) (let ((dir (expand-file-name server))) (and (string-match "/$" dir) (setq dir (substring dir 0 (match-beginning 0)))) (string-match "/[^/]+$" dir) (let ((group (substring dir (1+ (match-beginning 0)))) (nnml-directory (substring dir 0 (1+ (match-beginning 0)))) (nnml-nov-is-evil nndir-nov-is-evil) (nnml-get-new-mail nil)) (eval command)))) (provide 'nndir) ;;; nndir.el ends here emacs-19.30/lisp/nndoc.el100444 23053 1 30330 6046561624 14042 0ustar larsidaemon;;; nndoc.el --- single file access for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Code: (require 'nnheader) (require 'rmail) (require 'nnmail) (defvar nndoc-article-type 'mbox "*Type of the file - one of `mbox', `babyl' or `digest'.") (defvar nndoc-digest-type 'traditional "Type of the last digest. Auto-detected from the article header. Possible values: `traditional' -- the \"lots of dashes\" (30+) rules used; we currently also do unconditional RFC 934 unquoting. `rfc1341' -- RFC 1341 digest (MIME, unique boundary, no quoting).") (defconst nndoc-type-to-regexp (list (list 'mbox (concat "^" rmail-unix-mail-delimiter) (concat "^" rmail-unix-mail-delimiter) nil "^$" nil nil nil) (list 'babyl "\^_\^L *\n" "\^_" "^[0-9].*\n" "^$" nil nil "\\*\\*\\* EOOH \\*\\*\\*\n\\(^.+\n\\)*") (list 'digest "^------------------------------*[\n \t]+" "^------------------------------*[\n \t]+" nil "^ ?$" "^------------------------------*[\n \t]+" "^End of" nil)) "Regular expressions for articles of the various types.") (defvar nndoc-article-begin nil) (defvar nndoc-article-end nil) (defvar nndoc-head-begin nil) (defvar nndoc-head-end nil) (defvar nndoc-first-article nil) (defvar nndoc-end-of-file nil) (defvar nndoc-body-begin nil) (defvar nndoc-current-server nil) (defvar nndoc-server-alist nil) (defvar nndoc-server-variables (list (list 'nndoc-article-type nndoc-article-type) '(nndoc-article-begin nil) '(nndoc-article-end nil) '(nndoc-head-begin nil) '(nndoc-head-end nil) '(nndoc-first-article nil) '(nndoc-current-buffer nil) '(nndoc-group-alist nil) '(nndoc-end-of-file nil) '(nndoc-body-begin nil) '(nndoc-address nil))) (defconst nndoc-version "nndoc 1.0" "nndoc version.") (defvar nndoc-current-buffer nil "Current nndoc news buffer.") (defvar nndoc-address nil) (defvar nndoc-status-string "") (defvar nndoc-group-alist nil) ;;; Interface functions (defun nndoc-retrieve-headers (sequence &optional newsgroup server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let ((prev 2) article p beg lines) (nndoc-possibly-change-buffer newsgroup server) (if (stringp (car sequence)) 'headers (set-buffer nndoc-current-buffer) (widen) (goto-char (point-min)) (re-search-forward (or nndoc-first-article nndoc-article-begin) nil t) (or (not nndoc-head-begin) (re-search-forward nndoc-head-begin nil t)) (re-search-forward nndoc-head-end nil t) (while sequence (setq article (car sequence)) (set-buffer nndoc-current-buffer) (if (not (nndoc-forward-article (max 0 (- article prev)))) () (setq p (point)) (setq beg (or (and (re-search-backward nndoc-article-begin nil t) (match-end 0)) (point-min))) (goto-char p) (setq lines (count-lines (point) (or (and (re-search-forward nndoc-article-end nil t) (goto-char (match-beginning 0))) (goto-char (point-max))))) (set-buffer nntp-server-buffer) (insert (format "221 %d Article retrieved.\n" article)) (insert-buffer-substring nndoc-current-buffer beg p) (goto-char (point-max)) (or (= (char-after (1- (point))) ?\n) (insert "\n")) (insert (format "Lines: %d\n" lines)) (insert ".\n")) (setq prev article sequence (cdr sequence))) ;; Fold continuation lines. (set-buffer nntp-server-buffer) (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers)))) (defun nndoc-open-server (server &optional defs) (nnheader-init-server-buffer) (if (equal server nndoc-current-server) t (if nndoc-current-server (setq nndoc-server-alist (cons (list nndoc-current-server (nnheader-save-variables nndoc-server-variables)) nndoc-server-alist))) (let ((state (assoc server nndoc-server-alist))) (if state (progn (nnheader-restore-variables (nth 1 state)) (setq nndoc-server-alist (delq state nndoc-server-alist))) (nnheader-set-init-variables nndoc-server-variables defs))) (setq nndoc-current-server server) (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp)))) (setq nndoc-article-begin (nth 0 defs)) (setq nndoc-article-end (nth 1 defs)) (setq nndoc-head-begin (nth 2 defs)) (setq nndoc-head-end (nth 3 defs)) (setq nndoc-first-article (nth 4 defs)) (setq nndoc-end-of-file (nth 5 defs)) (setq nndoc-body-begin (nth 6 defs))) t)) (defun nndoc-close-server (&optional server) t) (defun nndoc-server-opened (&optional server) (and (equal server nndoc-current-server) nntp-server-buffer (buffer-name nntp-server-buffer))) (defun nndoc-status-message (&optional server) nndoc-status-string) (defun nndoc-request-article (article &optional newsgroup server buffer) (nndoc-possibly-change-buffer newsgroup server) (save-excursion (let ((buffer (or buffer nntp-server-buffer))) (set-buffer buffer) (erase-buffer) (if (stringp article) nil (nndoc-insert-article article) ;; Unquote quoted non-separators in digests. (if (and (eq nndoc-article-type 'digest) (eq nndoc-digest-type 'traditional)) (progn (goto-char (point-min)) (while (re-search-forward "^- -"nil t) (replace-match "-" t t)))) ;; Some assholish digests do not have a blank line after the ;; headers. Aargh! (goto-char (point-min)) (if (search-forward "\n\n" nil t) () ; We let this one pass. (if (re-search-forward "^[ \t]+$" nil t) (replace-match "" t t) ; We nix out a line of blanks. (while (and (looking-at "[^ ]+:") (zerop (forward-line 1)))) ;; We just insert a couple of lines. If you read digests ;; that are so badly formatted, you don't deserve any ;; better. Blphphpht! (insert "\n\n"))) t)))) (defun nndoc-request-group (group &optional server dont-check) "Select news GROUP." (save-excursion (if (not (nndoc-possibly-change-buffer group server)) (progn (setq nndoc-status-string "No such file or buffer") nil) (nndoc-set-header-dependent-regexps) ; hack for MIME digests (if dont-check t (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let ((number (nndoc-number-of-articles))) (if (zerop number) (progn (nndoc-close-group group) nil) (insert (format "211 %d %d %d %s\n" number 1 number group)) t))))))) (defun nndoc-close-group (group &optional server) (nndoc-possibly-change-buffer group server) (kill-buffer nndoc-current-buffer) (setq nndoc-group-alist (delq (assoc group nndoc-group-alist) nndoc-group-alist)) (setq nndoc-current-buffer nil) (setq nndoc-current-server nil) t) (defun nndoc-request-list (&optional server) nil) (defun nndoc-request-newgroups (date &optional server) nil) (defun nndoc-request-list-newsgroups (&optional server) nil) (defalias 'nndoc-request-post 'nnmail-request-post) (defalias 'nndoc-request-post-buffer 'nnmail-request-post-buffer) ;;; Internal functions. (defun nndoc-possibly-change-buffer (group source) (let (buf) (cond ;; The current buffer is this group's buffer. ((and nndoc-current-buffer (eq nndoc-current-buffer (setq buf (cdr (assoc group nndoc-group-alist)))))) ;; We change buffers by taking an old from the group alist. ;; `source' is either a string (a file name) or a buffer object. (buf (setq nndoc-current-buffer buf)) ;; It's a totally new group. ((or (and (bufferp nndoc-address) (buffer-name nndoc-address)) (and (stringp nndoc-address) (file-exists-p nndoc-address) (not (file-directory-p nndoc-address)))) (setq nndoc-group-alist (cons (cons group (setq nndoc-current-buffer (get-buffer-create (concat " *nndoc " group "*")))) nndoc-group-alist)) (save-excursion (set-buffer nndoc-current-buffer) (buffer-disable-undo (current-buffer)) (erase-buffer) (if (stringp nndoc-address) (insert-file-contents nndoc-address) (save-excursion (set-buffer nndoc-address) (widen)) (insert-buffer-substring nndoc-address)) t))))) ;; MIME (RFC 1341) digest hack by Ulrik Dickow . (defun nndoc-set-header-dependent-regexps () (if (not (eq nndoc-article-type 'digest)) () (let ((case-fold-search t) ; We match a bit too much, keep it simple. (boundary-id) (b-delimiter)) (save-excursion (set-buffer nndoc-current-buffer) (goto-char (point-min)) (if (and (re-search-forward (concat "\n\n\\|^Content-Type: *multipart/digest;[ \t\n]*[ \t]" "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"") nil t) (match-beginning 1)) (setq nndoc-digest-type 'rfc1341 boundary-id (format "%s" (buffer-substring (match-beginning 1) (match-end 1))) b-delimiter (concat "\n--" boundary-id "[\n \t]+") nndoc-article-begin b-delimiter ; Too strict: "[ \t]*$" nndoc-article-end (concat "\n--" boundary-id "\\(--\\)?[\n \t]+") nndoc-first-article b-delimiter ; ^eof ends article too. nndoc-end-of-file (concat "\n--" boundary-id "--[ \t]*$")) (setq nndoc-digest-type 'traditional)))))) (defun nndoc-forward-article (n) (while (and (> n 0) (re-search-forward nndoc-article-begin nil t) (or (not nndoc-head-begin) (re-search-forward nndoc-head-begin nil t)) (re-search-forward nndoc-head-end nil t)) (setq n (1- n))) (zerop n)) (defun nndoc-number-of-articles () (save-excursion (set-buffer nndoc-current-buffer) (widen) (goto-char (point-min)) (let ((num 0)) (if (re-search-forward (or nndoc-first-article nndoc-article-begin) nil t) (progn (setq num 1) (while (and (re-search-forward nndoc-article-begin nil t) (or (not nndoc-end-of-file) (not (looking-at nndoc-end-of-file))) (or (not nndoc-head-begin) (re-search-forward nndoc-head-begin nil t)) (re-search-forward nndoc-head-end nil t)) (setq num (1+ num))))) num))) (defun nndoc-narrow-to-article (article) (save-excursion (set-buffer nndoc-current-buffer) (widen) (goto-char (point-min)) (while (and (re-search-forward nndoc-article-begin nil t) (not (zerop (setq article (1- article)))))) (if (not (zerop article)) () (narrow-to-region (match-end 0) (or (and (re-search-forward nndoc-article-end nil t) (match-beginning 0)) (point-max))) t))) ;; Insert article ARTICLE in the current buffer. (defun nndoc-insert-article (article) (let ((ibuf (current-buffer))) (save-excursion (set-buffer nndoc-current-buffer) (widen) (goto-char (point-min)) (while (and (re-search-forward nndoc-article-begin nil t) (not (zerop (setq article (1- article)))))) (if (not (zerop article)) () (narrow-to-region (match-end 0) (or (and (re-search-forward nndoc-article-end nil t) (match-beginning 0)) (point-max))) (goto-char (point-min)) (and nndoc-head-begin (re-search-forward nndoc-head-begin nil t) (narrow-to-region (point) (point-max))) (or (re-search-forward nndoc-head-end nil t) (goto-char (point-max))) (append-to-buffer ibuf (point-min) (point)) (and nndoc-body-begin (re-search-forward nndoc-body-begin nil t)) (append-to-buffer ibuf (point) (point-max)) t)))) (provide 'nndoc) ;;; nndoc.el ends here emacs-19.30/lisp/nneething.el100444 23053 1 23442 6046561634 14727 0ustar larsidaemon;;; nneething.el --- random file access for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Based on nnspool.el by Masanobu UMEDA . ;; For an overview of what the interface functions do, please see the ;; Gnus sources. ;;; Code: (require 'nnheader) (require 'nnmail) (defvar nneething-map-file-directory "~/.nneething/" "*Map files directory.") (defvar nneething-exclude-files "~$" "*Regexp saying what files to exclude from the group.") (defvar nneething-map-file ".nneething" "*Name of map files.") (defconst nneething-version "nneething 1.0" "nneething version.") (defvar nneething-current-directory nil "Current news group directory.") (defvar nneething-status-string "") (defvar nneething-group-alist nil) (defvar nneething-directory nil) (defvar nneething-group nil) (defvar nneething-map nil) (defvar nneething-read-only nil) (defvar nneething-active nil) (defvar nneething-server-variables (list (list 'nneething-directory nneething-directory) '(nneething-current-directory nil) '(nneething-status-string "") '(nneething-group-alist))) ;;; Interface functions. (defun nneething-retrieve-headers (sequence &optional newsgroup server) (nneething-possibly-change-directory newsgroup) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let* ((number (length sequence)) (count 0) (large (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup))) article file) (if (stringp (car sequence)) 'headers (while sequence (setq article (car sequence)) (setq file (nneething-file-name article)) (if (and (file-exists-p file) (not (zerop (nth 7 (file-attributes file))))) (progn (insert (format "221 %d Article retrieved.\n" article)) (nneething-insert-head file) (insert ".\n"))) (setq sequence (cdr sequence) count (1+ count)) (and large (zerop (% count 20)) (message "nneething: Receiving headers... %d%%" (/ (* count 100) number)))) (and large (message "nneething: Receiving headers...done")) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers)))) (defun nneething-open-server (server &optional defs) (setq nneething-status-string "") (nnheader-init-server-buffer)) (defun nneething-close-server (&optional server) t) (defun nneething-server-opened (&optional server) t) (defun nneething-status-message (&optional server) nneething-status-string) (defun nneething-request-article (id &optional newsgroup server buffer) (nneething-possibly-change-directory newsgroup) (let ((file (if (stringp id) nil (nneething-file-name id))) (nntp-server-buffer (or buffer nntp-server-buffer))) (and (stringp file) ; We did not request by Message-ID. (file-exists-p file) ; The file exists. (not (file-directory-p file)) ; It's not a dir. (save-excursion (nnmail-find-file file) ; Insert the file in the nntp buf. (or (nnheader-article-p) ; Either it's a real article... (progn (goto-char (point-min)) (nneething-make-head file) ; ... or we fake some headers. (insert "\n"))) t)))) (defun nneething-request-group (group &optional dir dont-check) (nneething-possibly-change-directory group dir) (or dont-check (nneething-create-mapping)) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (if (> (car nneething-active) (cdr nneething-active)) (insert (format "211 0 1 0 %s\n" group)) (insert (format "211 %d %d %d %s\n" (- (1+ (cdr nneething-active)) (car nneething-active)) (car nneething-active) (cdr nneething-active) group))) t)) (defun nneething-request-list (&optional server dir) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer)) nil) (defun nneething-request-newgroups (date &optional server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer)) nil) (defun nneething-request-post (&optional server) (mail-send-and-exit nil)) (defalias 'nneething-request-post-buffer 'nnmail-request-post-buffer) (defun nneething-close-group (group &optional server) t) ;;; Internal functions. (defun nneething-possibly-change-directory (group &optional dir) (if (not group) () (if (and nneething-group (string= group nneething-group)) t (let (entry) (if (setq entry (assoc group nneething-group-alist)) (progn (setq nneething-group group) (setq nneething-directory (nth 1 entry)) (setq nneething-map (nth 2 entry)) (setq nneething-active (nth 3 entry))) (setq nneething-group group) (setq nneething-directory dir) (setq nneething-map nil) (setq nneething-active (cons 1 0)) (nneething-create-mapping) (setq nneething-group-alist (cons (list group dir nneething-map nneething-active) nneething-group-alist))))))) (defun nneething-map-file () ;; We make sure that the .neething directory exists. (make-directory nneething-map-file-directory 'parents) ;; We store it in a special directory under the user's home dir. (concat (file-name-as-directory nneething-map-file-directory) nneething-group nneething-map-file)) (defun nneething-create-mapping () ;; Read nneething-active and nneething-map (let ((map-file (nneething-map-file)) (files (directory-files nneething-directory)) touched) (if (file-exists-p map-file) (condition-case nil (load map-file nil t t) (error nil))) (or nneething-active (setq nneething-active (cons 1 0))) ;; Remove files matching that regexp. (let ((f files) prev) (while f (if (string-match nneething-exclude-files (car f)) (if prev (setcdr prev (cdr f)) (setq files (cdr files))) (setq prev f)) (setq f (cdr f)))) ;; Remove files that have disappeared from the map. (let ((map nneething-map) prev) (while map (if (member (car (car map)) files) (setq prev map) (setq touched t) (if prev (setcdr prev (cdr map)) (setq nneething-map (cdr nneething-map)))) (setq map (cdr map)))) ;; Find all new files and enter them into the map. (while files (or (assoc (car files) nneething-map) ; If already in the map, ignore. (progn (setq touched t) (setcdr nneething-active (1+ (cdr nneething-active))) (setq nneething-map (cons (cons (car files) (cdr nneething-active)) nneething-map)))) (setq files (cdr files))) (if (or (not touched) nneething-read-only) () (save-excursion (set-buffer (get-buffer-create " *nneething map*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert "(setq nneething-map '" (prin1-to-string nneething-map) ")\n" "(setq nneething-active '" (prin1-to-string nneething-active) ")\n") (write-region (point-min) (point-max) map-file nil 'nomesg) (kill-buffer (current-buffer)))))) (defvar nneething-message-id-number 0) (defvar nneething-work-buffer " *nneething work*") (defun nneething-insert-head (file) (and (nneething-get-head file) (insert-buffer-substring nneething-work-buffer))) (defun nneething-make-head (file) (let ((atts (file-attributes file))) (insert "Subject: " (file-name-nondirectory file) "\n" "Message-ID: \n" "Date: " (current-time-string (nth 5 atts)) "\n" (nneething-from-line (nth 2 atts)) "Chars: " (int-to-string (nth 7 atts)) "\n"))) (defun nneething-from-line (uid) (let ((login (condition-case nil (user-login-name uid) (error (cond ((= uid (user-uid)) (user-login-name)) ((zerop uid) "root") (t (int-to-string uid)))))) (name (condition-case nil (user-full-name uid) (error (cond ((= uid (user-uid)) (user-full-name)) ((zerop uid) "Ms. Root")))))) (concat "From: " login "@" (system-name) (if name (concat " (" name ")") "") "\n"))) (defun nneething-get-head (file) (save-excursion (set-buffer (get-buffer-create nneething-work-buffer)) (setq case-fold-search nil) (buffer-disable-undo (current-buffer)) (erase-buffer) (cond ((not (file-exists-p file)) ;; The file do not exist. nil) ((or (file-directory-p file) (file-symlink-p file)) ;; It's a dir, so we fudge a head. (nneething-make-head file) t) (t ;; We examine the file. (nnheader-insert-head file) (if (nnheader-article-p) (delete-region (progn (goto-char (point-min)) (or (and (search-forward "\n\n" nil t) (1- (point))) (point-max))) (point-max)) (erase-buffer) (nneething-make-head file)) t)))) (defun nneething-number-to-file (number) (car (rassq number nneething-map))) (defun nneething-file-name (article) (concat (file-name-as-directory nneething-directory) (if (numberp article) (nneething-number-to-file article) article))) (provide 'nneething) ;;; nneething.el ends here emacs-19.30/lisp/nnfolder.el100444 23053 1 61061 6046561645 14560 0ustar larsidaemon;;; nnfolder.el --- mail folder access for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Scott Byer ;; Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail ;; This file is part of GNU Emacs. ;; 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: ;; For an overview of what the interface functions do, please see the ;; Gnus sources. ;; Various enhancements by byer@mv.us.adobe.com (Scott Byer). ;;; Code: (require 'nnheader) (require 'rmail) (require 'nnmail) (defvar nnfolder-directory (expand-file-name "~/Mail/") "The name of the mail box file in the users home directory.") (defvar nnfolder-active-file (concat (file-name-as-directory nnfolder-directory) "active") "The name of the active file.") ;; I renamed this variable to somehting more in keeping with the general GNU ;; style. -SLB (defvar nnfolder-ignore-active-file nil "If non-nil, causes nnfolder to do some extra work in order to determine the true active ranges of an mbox file. Note that the active file is still saved, but it's values are not used. This costs some extra time when scanning an mbox when opening it.") ;; Note that this variable may not be completely implemented yet. -SLB (defvar nnfolder-always-close nil "If non-nil, nnfolder attempts to only ever have one mbox open at a time. This is a straight space/performance trade off, as the mboxes will have to be scanned every time they are read in. If nil (default), nnfolder will attempt to keep the buffers around (saving the nnfolder's buffer upon group close, but not killing it), speeding some things up tremendously, especially such things as moving mail. All buffers always get killed upon server close.") (defvar nnfolder-newsgroups-file (concat (file-name-as-directory nnfolder-directory) "newsgroups") "Mail newsgroups description file.") (defvar nnfolder-get-new-mail t "If non-nil, nnfolder will check the incoming mail file and split the mail.") (defvar nnfolder-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") (defconst nnfolder-version "nnfolder 1.0" "nnfolder version.") (defconst nnfolder-article-marker "X-Gnus-Article-Number: " "String used to demarcate what the article number for a message is.") (defvar nnfolder-current-group nil) (defvar nnfolder-current-buffer nil) (defvar nnfolder-status-string "") (defvar nnfolder-group-alist nil) (defvar nnfolder-buffer-alist nil) (defvar nnfolder-active-timestamp nil) (defmacro nnfolder-article-string (article) (` (concat "\n" nnfolder-article-marker (int-to-string (, article)) " "))) (defvar nnfolder-current-server nil) (defvar nnfolder-server-alist nil) (defvar nnfolder-server-variables (list (list 'nnfolder-directory nnfolder-directory) (list 'nnfolder-active-file nnfolder-active-file) (list 'nnfolder-newsgroups-file nnfolder-newsgroups-file) (list 'nnfolder-get-new-mail nnfolder-get-new-mail) '(nnfolder-current-group nil) '(nnfolder-current-buffer nil) '(nnfolder-status-string "") '(nnfolder-group-alist nil) '(nnfolder-buffer-alist nil) '(nnfolder-active-timestamp nil))) ;;; Interface functions (defun nnfolder-retrieve-headers (sequence &optional newsgroup server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let ((delim-string (concat "^" rmail-unix-mail-delimiter)) article art-string start stop) (nnfolder-possibly-change-group newsgroup) (set-buffer nnfolder-current-buffer) (goto-char (point-min)) (if (stringp (car sequence)) 'headers (while sequence (setq article (car sequence)) (setq art-string (nnfolder-article-string article)) (set-buffer nnfolder-current-buffer) (if (or (search-forward art-string nil t) ;; Don't search the whole file twice! Also, articles ;; probably have some locality by number, so searching ;; backwards will be faster. Especially if we're at the ;; beginning of the buffer :-). -SLB (search-backward art-string nil t)) (progn (setq start (or (re-search-backward delim-string nil t) (point))) (search-forward "\n\n" nil t) (setq stop (1- (point))) (set-buffer nntp-server-buffer) (insert (format "221 %d Article retrieved.\n" article)) (insert-buffer-substring nnfolder-current-buffer start stop) (goto-char (point-max)) (insert ".\n"))) (setq sequence (cdr sequence))) ;; Fold continuation lines. (set-buffer nntp-server-buffer) (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers)))) (defun nnfolder-open-server (server &optional defs) (nnheader-init-server-buffer) (if (equal server nnfolder-current-server) t (if nnfolder-current-server (setq nnfolder-server-alist (cons (list nnfolder-current-server (nnheader-save-variables nnfolder-server-variables)) nnfolder-server-alist))) (let ((state (assoc server nnfolder-server-alist))) (if state (progn (nnheader-restore-variables (nth 1 state)) (setq nnfolder-server-alist (delq state nnfolder-server-alist))) (nnheader-set-init-variables nnfolder-server-variables defs))) (setq nnfolder-current-server server))) (defun nnfolder-close-server (&optional server) t) (defun nnfolder-server-opened (&optional server) (and (equal server nnfolder-current-server) nntp-server-buffer (buffer-name nntp-server-buffer))) (defun nnfolder-request-close () (let ((alist nnfolder-buffer-alist)) (while alist (nnfolder-close-group (car (car alist)) nil t) (setq alist (cdr alist)))) (setq nnfolder-buffer-alist nil nnfolder-group-alist nil)) (defun nnfolder-status-message (&optional server) nnfolder-status-string) (defun nnfolder-request-article (article &optional newsgroup server buffer) (nnfolder-possibly-change-group newsgroup) (if (stringp article) nil (save-excursion (set-buffer nnfolder-current-buffer) (goto-char (point-min)) (if (search-forward (nnfolder-article-string article) nil t) (let (start stop) (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) (setq start (point)) (forward-line 1) (or (and (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t) (forward-line -1)) (goto-char (point-max))) (setq stop (point)) (let ((nntp-server-buffer (or buffer nntp-server-buffer))) (set-buffer nntp-server-buffer) (erase-buffer) (insert-buffer-substring nnfolder-current-buffer start stop) (goto-char (point-min)) (while (looking-at "From ") (delete-char 5) (insert "X-From-Line: ") (forward-line 1)) t)))))) (defun nnfolder-request-group (group &optional server dont-check) (save-excursion (nnmail-activate 'nnfolder) (nnfolder-possibly-change-group group) (and (assoc group nnfolder-group-alist) (progn (if dont-check t (nnfolder-get-new-mail group) (let* ((active (assoc group nnfolder-group-alist)) (group (car active)) (range (car (cdr active))) (minactive (car range)) (maxactive (cdr range))) ;; I've been getting stray 211 lines in my nnfolder active ;; file. So, let's make sure that doesn't happen. -SLB (set-buffer nntp-server-buffer) (erase-buffer) (if (not active) () (insert (format "211 %d %d %d %s\n" (1+ (- maxactive minactive)) minactive maxactive group)) t))))))) ;; Don't close the buffer if we're not shutting down the server. This way, ;; we can keep the buffer in the group buffer cache, and not have to grovel ;; over the buffer again unless we add new mail to it or modify it in some ;; way. (defun nnfolder-close-group (group &optional server force) ;; Make sure we _had_ the group open. (if (or (assoc group nnfolder-buffer-alist) (equal group nnfolder-current-group)) (progn (nnfolder-possibly-change-group group) (save-excursion (set-buffer nnfolder-current-buffer) ;; If the buffer was modified, write the file out now. (and (buffer-modified-p) (save-buffer)) (if (or force nnfolder-always-close) ;; If we're shutting the server down, we need to kill the ;; buffer and remove it from the open buffer list. Or, of ;; course, if we're trying to minimize our space impact. (progn (kill-buffer (current-buffer)) (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist) nnfolder-buffer-alist))))))) (setq nnfolder-current-group nil nnfolder-current-buffer nil) t) (defun nnfolder-request-create-group (group &optional server) (nnmail-activate 'nnfolder) (or (assoc group nnfolder-group-alist) (let (active) (setq nnfolder-group-alist (cons (list group (setq active (cons 1 0))) nnfolder-group-alist)) (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) t) (defun nnfolder-request-list (&optional server) (if server (nnfolder-get-new-mail)) (save-excursion (nnmail-find-file nnfolder-active-file) (setq nnfolder-group-alist (nnmail-get-active)))) (defun nnfolder-request-newgroups (date &optional server) (nnfolder-request-list server)) (defun nnfolder-request-list-newsgroups (&optional server) (save-excursion (nnmail-find-file nnfolder-newsgroups-file))) (defun nnfolder-request-post (&optional server) (mail-send-and-exit nil)) (defalias 'nnfolder-request-post-buffer 'nnmail-request-post-buffer) (defun nnfolder-request-expire-articles (articles newsgroup &optional server force) (nnfolder-possibly-change-group newsgroup) (let* ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function newsgroup)) nnmail-expiry-wait)) (is-old t) rest) (nnmail-activate 'nnfolder) (save-excursion (set-buffer nnfolder-current-buffer) (while (and articles is-old) (goto-char (point-min)) (if (search-forward (nnfolder-article-string (car articles)) nil t) (if (or force (setq is-old (> (nnmail-days-between (current-time-string) (buffer-substring (point) (progn (end-of-line) (point)))) days))) (progn (and gnus-verbose-backends (message "Deleting article %s..." (car articles))) (nnfolder-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) (and (buffer-modified-p) (save-buffer)) ;; Find the lowest active article in this group. (let* ((active (car (cdr (assoc newsgroup nnfolder-group-alist)))) (marker (concat "\n" nnfolder-article-marker)) (number "[0-9]+") (activemin (cdr active))) (goto-char (point-min)) (while (and (search-forward marker nil t) (re-search-forward number nil t)) (setq activemin (min activemin (string-to-number (buffer-substring (match-beginning 0) (match-end 0)))))) (setcar active activemin)) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (nconc rest articles)))) (defun nnfolder-request-move-article (article group server accept-form &optional last) (nnfolder-possibly-change-group group) (let ((buf (get-buffer-create " *nnfolder move*")) result) (and (nnfolder-request-article article group server) (save-excursion (set-buffer buf) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) (while (re-search-forward (concat "^" nnfolder-article-marker) (save-excursion (search-forward "\n\n" nil t) (point)) t) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) (setq result (eval accept-form)) (kill-buffer buf) result) (save-excursion (nnfolder-possibly-change-group group) (set-buffer nnfolder-current-buffer) (goto-char (point-min)) (if (search-forward (nnfolder-article-string article) nil t) (nnfolder-delete-mail)) (and last (buffer-modified-p) (save-buffer)))) result)) (defun nnfolder-request-accept-article (group &optional last) (and (stringp group) (nnfolder-possibly-change-group group)) (let ((buf (current-buffer)) result) (goto-char (point-min)) (cond ((looking-at "X-From-Line: ") (replace-match "From ")) ((not (looking-at "From ")) (insert "From nobody " (current-time-string) "\n"))) (and (nnfolder-request-list) (save-excursion (set-buffer buf) (goto-char (point-min)) (search-forward "\n\n" nil t) (forward-line -1) (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) (delete-region (point) (progn (forward-line 1) (point)))) (setq result (car (nnfolder-save-mail (and (stringp group) group))))) (save-excursion (set-buffer nnfolder-current-buffer) (and last (buffer-modified-p) (save-buffer)))) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) result)) (defun nnfolder-request-replace-article (article group buffer) (nnfolder-possibly-change-group group) (save-excursion (set-buffer nnfolder-current-buffer) (goto-char (point-min)) (if (not (search-forward (nnfolder-article-string article) nil t)) nil (nnfolder-delete-mail t t) (insert-buffer-substring buffer) (and (buffer-modified-p) (save-buffer)) t))) ;;; Internal functions. (defun nnfolder-delete-mail (&optional force leave-delim) ;; Beginning of the article. (save-excursion (save-restriction (narrow-to-region (save-excursion (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) (if leave-delim (progn (forward-line 1) (point)) (match-beginning 0))) (progn (forward-line 1) (or (and (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t) (if (and (not (bobp)) leave-delim) (progn (forward-line -2) (point)) (match-beginning 0))) (point-max)))) (delete-region (point-min) (point-max))))) (defun nnfolder-possibly-change-group (group) (or (file-exists-p nnfolder-directory) (make-directory (directory-file-name nnfolder-directory))) (nnfolder-possibly-activate-groups nil) (or (assoc group nnfolder-group-alist) (not (file-exists-p (concat (file-name-as-directory nnfolder-directory) group))) (progn (setq nnfolder-group-alist (cons (list group (cons 1 0)) nnfolder-group-alist)) (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) (let (inf file) (if (and (equal group nnfolder-current-group) nnfolder-current-buffer (buffer-name nnfolder-current-buffer)) () (setq nnfolder-current-group group) ;; If we have to change groups, see if we don't already have the mbox ;; in memory. If we do, verify the modtime and destroy the mbox if ;; needed so we can rescan it. (if (setq inf (assoc group nnfolder-buffer-alist)) (setq nnfolder-current-buffer (nth 1 inf))) ;; If the buffer is not live, make sure it isn't in the alist. If it ;; is live, verify that nobody else has touched the file since last ;; time. (if (or (not (and nnfolder-current-buffer (buffer-name nnfolder-current-buffer))) (not (and (bufferp nnfolder-current-buffer) (verify-visited-file-modtime nnfolder-current-buffer)))) (progn (if (and nnfolder-current-buffer (buffer-name nnfolder-current-buffer) (bufferp nnfolder-current-buffer)) (kill-buffer nnfolder-current-buffer)) (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)) (setq inf nil))) (if inf () (save-excursion (setq file (concat (file-name-as-directory nnfolder-directory) group)) (if (file-directory-p (file-truename file)) () (if (not (file-exists-p file)) (write-region 1 1 file t 'nomesg)) (setq nnfolder-current-buffer (set-buffer (nnfolder-read-folder file))) (setq nnfolder-buffer-alist (cons (list group (current-buffer)) nnfolder-buffer-alist))))))) (setq nnfolder-current-group group)) (defun nnfolder-save-mail (&optional group) "Called narrowed to an article." (let* ((nnmail-split-methods (if group (list (list group "")) nnmail-split-methods)) (group-art-list (nreverse (nnmail-article-group 'nnfolder-active-number))) save-list group-art) (setq save-list group-art-list) (nnmail-insert-lines) (nnmail-insert-xref group-art-list) (run-hooks 'nnfolder-prepare-save-mail-hook) ;; Insert the mail into each of the destination groups. (while group-art-list (setq group-art (car group-art-list) group-art-list (cdr group-art-list)) ;; Kill the previous newsgroup markers. (goto-char (point-min)) (search-forward "\n\n" nil t) (forward-line -1) (while (search-backward (concat "\n" nnfolder-article-marker) nil t) (delete-region (1+ (point)) (progn (forward-line 2) (point)))) ;; Insert the new newsgroup marker. (nnfolder-possibly-change-group (car group-art)) (nnfolder-insert-newsgroup-line group-art) (let ((beg (point-min)) (end (point-max)) (obuf (current-buffer))) (set-buffer nnfolder-current-buffer) (goto-char (point-max)) (insert-buffer-substring obuf beg end) (set-buffer obuf))) ;; Did we save it anywhere? save-list)) (defun nnfolder-insert-newsgroup-line (group-art) (save-excursion (goto-char (point-min)) (if (search-forward "\n\n" nil t) (progn (forward-char -1) (insert (format (concat nnfolder-article-marker "%d %s\n") (cdr group-art) (current-time-string))))))) (defun nnfolder-possibly-activate-groups (&optional group) (save-excursion ;; If we're looking for the activation of a specific group, find out ;; its real name and switch to it. (if group (nnfolder-possibly-change-group group)) ;; If the group alist isn't active, activate it now. (nnmail-activate 'nnfolder))) (defun nnfolder-active-number (group) (save-excursion ;; Find the next article number in GROUP. (prog1 (let ((active (car (cdr (assoc group nnfolder-group-alist))))) (if active (setcdr active (1+ (cdr active))) ;; This group is new, so we create a new entry for it. ;; This might be a bit naughty... creating groups on the drop of ;; a hat, but I don't know... (setq nnfolder-group-alist (cons (list group (setq active (cons 1 1))) nnfolder-group-alist))) (cdr active)) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (nnfolder-possibly-activate-groups group) ))) ;; This method has a problem if you've accidentally let the active list get ;; out of sync with the files. This could happen, say, if you've ;; accidentally gotten new mail with something other than Gnus (but why ;; would _that_ ever happen? :-). In that case, we will be in the middle of ;; processing the file, ready to add new X-Gnus article number markers, and ;; we'll run accross a message with no ID yet - the active list _may_not_ be ;; ready for us yet. ;; To handle this, I'm modifying this routine to maintain the maximum ID seen ;; so far, and when we hit a message with no ID, we will _manually_ scan the ;; rest of the message looking for any more, possibly higher IDs. We'll ;; assume the maximum that we find is the highest active. Note that this ;; shouldn't cost us much extra time at all, but will be a lot less ;; vulnerable to glitches between the mbox and the active file. (defun nnfolder-read-folder (file) (save-excursion (nnfolder-possibly-activate-groups nil) ;; We should be paranoid here and make sure the group is in the alist, ;; and add it if it isn't. ;;(if (not (assoc nnfoler-current-group nnfolder-group-alist) (set-buffer (setq nnfolder-current-buffer (nnheader-find-file-noselect file nil 'raw))) (buffer-disable-undo (current-buffer)) (let ((delim (concat "^" rmail-unix-mail-delimiter)) (marker (concat "\n" nnfolder-article-marker)) (number "[0-9]+") (active (car (cdr (assoc nnfolder-current-group nnfolder-group-alist)))) activenumber activemin start end) (goto-char (point-min)) ;; ;; Anytime the active number is 1 or 0, it is supect. In that case, ;; search the file manually to find the active number. Or, of course, ;; if we're being paranoid. (This would also be the place to build ;; other lists from the header markers, such as expunge lists, etc., if ;; we ever desired to abandon the active file entirely for mboxes.) (setq activenumber (cdr active)) (if (or nnfolder-ignore-active-file (< activenumber 2)) (progn (setq activemin (max (1- (lsh 1 23)) (1- (lsh 1 24)) (1- (lsh 1 25)))) (while (and (search-forward marker nil t) (re-search-forward number nil t)) (let ((newnum (string-to-number (buffer-substring (match-beginning 0) (match-end 0))))) (setq activenumber (max activenumber newnum)) (setq activemin (min activemin newnum)))) (setcar active (max 1 (min activemin activenumber))) (setcdr active (max activenumber (cdr active))) (goto-char (point-min)))) ;; Keep track of the active number on our own, and insert it back into ;; the active list when we're done. Also, prime the pump to cut down on ;; the number of searches we do. (setq end (point-marker)) (set-marker end (or (and (re-search-forward delim nil t) (match-beginning 0)) (point-max))) (while (not (= end (point-max))) (setq start (marker-position end)) (goto-char end) ;; There may be more than one "From " line, so we skip past ;; them. (while (looking-at delim) (forward-line 1)) (set-marker end (or (and (re-search-forward delim nil t) (match-beginning 0)) (point-max))) (goto-char start) (if (not (search-forward marker end t)) (progn (narrow-to-region start end) (nnmail-insert-lines) (nnfolder-insert-newsgroup-line (cons nil (nnfolder-active-number nnfolder-current-group))) (widen)))) ;; Make absolutely sure that the active list reflects reality! (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (current-buffer)))) (defun nnfolder-get-new-mail (&optional group) "Read new incoming mail." (let* ((spools (nnmail-get-spool-files group)) (group-in group) incomings incoming) (if (or (not nnfolder-get-new-mail) (not nnmail-spool-file)) () ;; We first activate all the groups. (nnfolder-possibly-activate-groups nil) ;; The we go through all the existing spool files and split the ;; mail from each. (while spools (and (file-exists-p (car spools)) (> (nth 7 (file-attributes (car spools))) 0) (progn (and gnus-verbose-backends (message "nnfolder: Reading incoming mail...")) (if (not (setq incoming (nnmail-move-inbox (car spools) (concat (file-name-as-directory nnfolder-directory) "Incoming")))) () (setq incomings (cons incoming incomings)) (setq group (nnmail-get-split-group (car spools) group-in)) (nnmail-split-incoming incoming 'nnfolder-save-mail nil group)))) (setq spools (cdr spools))) ;; If we did indeed read any incoming spools, we save all info. (if incoming (progn (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (run-hooks 'nnmail-read-incoming-hook) (and gnus-verbose-backends (message "nnfolder: Reading incoming mail...done")))) (let ((bufs nnfolder-buffer-alist)) (save-excursion (while bufs (if (not (buffer-name (nth 1 (car bufs)))) (setq nnfolder-buffer-alist (delq (car bufs) nnfolder-buffer-alist)) (set-buffer (nth 1 (car bufs))) (and (buffer-modified-p) (save-buffer))) (setq bufs (cdr bufs))))) (while incomings (setq incoming (car incomings)) (and nnmail-delete-incoming (file-writable-p incoming) (file-exists-p incoming) (delete-file incoming)) (setq incomings (cdr incomings)))))) (provide 'nnfolder) ;;; nnfolder.el ends here emacs-19.30/lisp/nnheader.el100444 23053 1 30757 6046561656 14547 0ustar larsidaemon;;; nnheader.el --- header access macros for Gnus and its backends ;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; These macros may look very much like the ones in GNUS 4.1. They ;; are, in a way, but you should note that the indices they use have ;; been changed from the internal GNUS format to the NOV format. Makes ;; it possible to read headers from XOVER much faster. ;; ;; The format of a header is now: ;; [number subject from date id references chars lines xref] ;; ;; (That last entry is defined as "misc" in the NOV format, but Gnus ;; uses it for xrefs.) ;;; Code: (defalias 'nntp-header-number 'mail-header-number) (defmacro mail-header-number (header) "Return article number in HEADER." (` (aref (, header) 0))) (defalias 'nntp-set-header-number 'mail-header-set-number) (defmacro mail-header-set-number (header number) "Set article number of HEADER to NUMBER." (` (aset (, header) 0 (, number)))) (defalias 'nntp-header-subject 'mail-header-subject) (defmacro mail-header-subject (header) "Return subject string in HEADER." (` (aref (, header) 1))) (defalias 'nntp-set-header-subject 'mail-header-set-subject) (defmacro mail-header-set-subject (header subject) "Set article subject of HEADER to SUBJECT." (` (aset (, header) 1 (, subject)))) (defalias 'nntp-header-from 'mail-header-from) (defmacro mail-header-from (header) "Return author string in HEADER." (` (aref (, header) 2))) (defalias 'nntp-set-header-from 'mail-header-set-from) (defmacro mail-header-set-from (header from) "Set article author of HEADER to FROM." (` (aset (, header) 2 (, from)))) (defalias 'nntp-header-date 'mail-header-date) (defmacro mail-header-date (header) "Return date in HEADER." (` (aref (, header) 3))) (defalias 'nntp-set-header-date 'mail-header-set-date) (defmacro mail-header-set-date (header date) "Set article date of HEADER to DATE." (` (aset (, header) 3 (, date)))) (defalias 'nntp-header-id 'mail-header-id) (defmacro mail-header-id (header) "Return Id in HEADER." (` (aref (, header) 4))) (defalias 'nntp-set-header-id 'mail-header-set-id) (defmacro mail-header-set-id (header id) "Set article Id of HEADER to ID." (` (aset (, header) 4 (, id)))) (defalias 'nntp-header-references 'mail-header-references) (defmacro mail-header-references (header) "Return references in HEADER." (` (aref (, header) 5))) (defalias 'nntp-set-header-references 'mail-header-set-references) (defmacro mail-header-set-references (header ref) "Set article references of HEADER to REF." (` (aset (, header) 5 (, ref)))) (defalias 'nntp-header-chars 'mail-header-chars) (defmacro mail-header-chars (header) "Return number of chars of article in HEADER." (` (aref (, header) 6))) (defalias 'nntp-set-header-chars 'mail-header-set-chars) (defmacro mail-header-set-chars (header chars) "Set number of chars in article of HEADER to CHARS." (` (aset (, header) 6 (, chars)))) (defalias 'nntp-header-lines 'mail-header-lines) (defmacro mail-header-lines (header) "Return lines in HEADER." (` (aref (, header) 7))) (defalias 'nntp-set-header-lines 'mail-header-set-lines) (defmacro mail-header-set-lines (header lines) "Set article lines of HEADER to LINES." (` (aset (, header) 7 (, lines)))) (defalias 'nntp-header-xref 'mail-header-xref) (defmacro mail-header-xref (header) "Return xref string in HEADER." (` (aref (, header) 8))) (defalias 'nntp-set-header-xref 'mail-header-set-xref) (defmacro mail-header-set-xref (header xref) "Set article xref of HEADER to xref." (` (aset (, header) 8 (, xref)))) ;; Various cruft the backends and Gnus need to communicate. (defvar nntp-server-buffer nil) (defvar gnus-verbose-backends t "*If non-nil, Gnus backends will generate lots of comments.") (defvar gnus-nov-is-evil nil "If non-nil, Gnus backends will never output headers in the NOV format.") (defvar news-reply-yank-from nil) (defvar news-reply-yank-message-id nil) ;; All backends use this function, so I moved it to this file. (defun nnheader-init-server-buffer () (save-excursion (setq nntp-server-buffer (get-buffer-create " *nntpd*")) (set-buffer nntp-server-buffer) (buffer-disable-undo (current-buffer)) (erase-buffer) (kill-all-local-variables) (setq case-fold-search t) ;Should ignore case. t)) (defun nnheader-set-init-variables (server defs) (let ((s server) val) ;; First we set the server variables in the sequence required. We ;; use the definitions from the `defs' list where that is ;; possible. (while s (set (car (car s)) (if (setq val (assq (car (car s)) defs)) (nth 1 val) (nth 1 (car s)))) (setq s (cdr s))) ;; The we go through the defs list and set any variables that were ;; not set in the first sweep. (while defs (if (not (assq (car (car defs)) server)) (set (car (car defs)) (if (and (symbolp (nth 1 (car defs))) (not (boundp (nth 1 (car defs))))) (nth 1 (car defs)) (eval (nth 1 (car defs)))))) (setq defs (cdr defs))))) (defun nnheader-save-variables (server) (let (out) (while server (setq out (cons (list (car (car server)) (symbol-value (car (car server)))) out)) (setq server (cdr server))) (nreverse out))) (defun nnheader-restore-variables (state) (while state (set (car (car state)) (nth 1 (car state))) (setq state (cdr state)))) ;; Read the head of an article. (defun nnheader-insert-head (file) (let ((beg 0) (chop 1024)) (while (and (eq chop (nth 1 (nnheader-insert-file-contents-literally file nil beg (setq beg (+ chop beg))))) (prog1 (not (search-backward "\n\n" nil t)) (goto-char (point-max))))))) (defun nnheader-article-p () (goto-char (point-min)) (if (not (search-forward "\n\n" nil t)) nil (narrow-to-region (point-min) (1- (point))) (goto-char (point-min)) (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") (goto-char (match-end 0))) (prog1 (eobp) (widen)))) ;; Written by Erik Naggum . (defun nnheader-insert-file-contents-literally (filename &optional visit beg end replace) "Like `insert-file-contents', q.v., but only reads in the file. A buffer may be modified in several ways after reading into the buffer due to advanced Emacs features, such as file-name-handlers, format decoding, find-file-hooks, etc. This function ensures that none of these modifications will take place." (let ( ; (file-name-handler-alist nil) (format-alist nil) (after-insert-file-functions nil) (find-buffer-file-type-function (if (fboundp 'find-buffer-file-type) (symbol-function 'find-buffer-file-type) nil))) (unwind-protect (progn (fset 'find-buffer-file-type (lambda (filename) t)) (insert-file-contents filename visit beg end replace)) (if find-buffer-file-type-function (fset 'find-buffer-file-type find-buffer-file-type-function) (fmakunbound 'find-buffer-file-type))))) (defun nnheader-find-file-noselect (filename &optional nowarn rawfile) "Read file FILENAME into a buffer and return the buffer. If a buffer exists visiting FILENAME, return that one, but verify that the file has not changed since visited or saved. The buffer is not selected, just returned to the caller." (setq filename (abbreviate-file-name (expand-file-name filename))) (if (file-directory-p filename) (if find-file-run-dired (dired-noselect filename) (error "%s is a directory." filename)) (let* ((buf (get-file-buffer filename)) (truename (abbreviate-file-name (file-truename filename))) (number (nthcdr 10 (file-attributes truename))) ;; Find any buffer for a file which has same truename. (other (and (not buf) (if (fboundp 'find-buffer-visiting) (find-buffer-visiting filename) (get-file-buffer filename)))) error) ;; Let user know if there is a buffer with the same truename. (if other (progn (or nowarn (string-equal filename (buffer-file-name other)) (message "%s and %s are the same file" filename (buffer-file-name other))) ;; Optionally also find that buffer. (if (or (and (boundp 'find-file-existing-other-name) find-file-existing-other-name) find-file-visit-truename) (setq buf other)))) (if buf (or nowarn (verify-visited-file-modtime buf) (cond ((not (file-exists-p filename)) (error "File %s no longer exists!" filename)) ((yes-or-no-p (if (string= (file-name-nondirectory filename) (buffer-name buf)) (format (if (buffer-modified-p buf) "File %s changed on disk. Discard your edits? " "File %s changed on disk. Reread from disk? ") (file-name-nondirectory filename)) (format (if (buffer-modified-p buf) "File %s changed on disk. Discard your edits in %s? " "File %s changed on disk. Reread from disk into %s? ") (file-name-nondirectory filename) (buffer-name buf)))) (save-excursion (set-buffer buf) (revert-buffer t t))))) (save-excursion ;;; The truename stuff makes this obsolete. ;;; (let* ((link-name (car (file-attributes filename))) ;;; (linked-buf (and (stringp link-name) ;;; (get-file-buffer link-name)))) ;;; (if (bufferp linked-buf) ;;; (message "Symbolic link to file in buffer %s" ;;; (buffer-name linked-buf)))) (setq buf (create-file-buffer filename)) ;; (set-buffer-major-mode buf) (set-buffer buf) (erase-buffer) (if rawfile (condition-case () (nnheader-insert-file-contents-literally filename t) (file-error ;; Unconditionally set error (setq error t))) (condition-case () (insert-file-contents filename t) (file-error ;; Run find-file-not-found-hooks until one returns non-nil. (or t ; (run-hook-with-args-until-success 'find-file-not-found-hooks) ;; If they fail too, set error. (setq error t))))) ;; Find the file's truename, and maybe use that as visited name. (setq buffer-file-truename truename) (setq buffer-file-number number) ;; On VMS, we may want to remember which directory in a search list ;; the file was found in. (and (eq system-type 'vax-vms) (let (logical) (if (string-match ":" (file-name-directory filename)) (setq logical (substring (file-name-directory filename) 0 (match-beginning 0)))) (not (member logical find-file-not-true-dirname-list))) (setq buffer-file-name buffer-file-truename)) (if find-file-visit-truename (setq buffer-file-name (setq filename (expand-file-name buffer-file-truename)))) ;; Set buffer's default directory to that of the file. (setq default-directory (file-name-directory filename)) ;; Turn off backup files for certain file names. Since ;; this is a permanent local, the major mode won't eliminate it. (and (not (funcall backup-enable-predicate buffer-file-name)) (progn (make-local-variable 'backup-inhibited) (setq backup-inhibited t))) (if rawfile nil (after-find-file error (not nowarn))))) buf))) (defun nnheader-insert-references (references message-id) (if (and (not references) (not message-id)) () ; This is illegal, but not all articles have Message-IDs. (mail-position-on-field "References") ;; Fold long references line to follow RFC1036. (let ((begin (gnus-point-at-bol)) (fill-column 78) (fill-prefix "\t")) (if references (insert references)) (if (and references message-id) (insert " ")) (if message-id (insert message-id)) ;; The region must end with a newline to fill the region ;; without inserting extra newline. (fill-region-as-paragraph begin (1+ (point)))))) (provide 'nnheader) ;;; nnheader.el ends here emacs-19.30/lisp/nnkiboze.el100444 23053 1 27505 6046561670 14573 0ustar larsidaemon;;; nnkiboze.el --- select virtual news access for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; The other access methods (nntp, nnspool, etc) are general news ;; access methods. This module relies on Gnus and can not be used ;; separately. ;;; Code: (require 'nntp) (require 'nnheader) (require 'gnus) (require 'gnus-score) (defvar nnkiboze-directory (expand-file-name (or gnus-article-save-directory "~/News/")) "nnkiboze will put its files in this directory.") (defconst nnkiboze-version "nnkiboze 1.0" "Version numbers of this version of nnkiboze.") (defvar nnkiboze-current-group nil) (defvar nnkiboze-current-score-group "") (defvar nnkiboze-status-string "") ;;; Interface functions. (defun nnkiboze-retrieve-headers (articles &optional group server) (nnkiboze-possibly-change-newsgroups group) (if gnus-nov-is-evil nil (if (stringp (car articles)) 'headers (let ((first (car articles)) (last (progn (while (cdr articles) (setq articles (cdr articles))) (car articles))) (nov (nnkiboze-nov-file-name))) (if (file-exists-p nov) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (insert-file-contents nov) (goto-char (point-min)) (while (and (not (eobp)) (< first (read (current-buffer)))) (forward-line 1)) (beginning-of-line) (if (not (eobp)) (delete-region 1 (point))) (while (and (not (eobp)) (>= last (read (current-buffer)))) (forward-line 1)) (beginning-of-line) (if (not (eobp)) (delete-region (point) (point-max))) 'nov)))))) (defun nnkiboze-open-server (newsgroups &optional something) "Open a virtual newsgroup that contains NEWSGROUPS." (gnus-make-directory nnkiboze-directory) (nnheader-init-server-buffer)) (defun nnkiboze-close-server (&rest dum) "Close news server." t) (defalias 'nnkiboze-request-quit (symbol-function 'nnkiboze-close-server)) (defun nnkiboze-server-opened (&optional server) "Return server process status, T or NIL. If the stream is opened, return T, otherwise return NIL." (and nntp-server-buffer (get-buffer nntp-server-buffer))) (defun nnkiboze-status-message (&optional server) "Return server status response as string." nnkiboze-status-string) (defun nnkiboze-request-article (article &optional newsgroup server buffer) "Select article by message number." (nnkiboze-possibly-change-newsgroups newsgroup) (if (not (numberp article)) ;; This is a real cludge. It might not work at times, but it ;; does no harm I think. The only alternative is to offer no ;; article fetching by message-id at all. (nntp-request-article article newsgroup gnus-nntp-server buffer) (let* ((header (gnus-get-header-by-number article)) (xref (mail-header-xref header)) igroup iarticle) (or xref (error "nnkiboze: No xref")) (or (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) (error "nnkiboze: Malformed xref")) (setq igroup (substring xref (match-beginning 1) (match-end 1))) (setq iarticle (string-to-int (substring xref (match-beginning 2) (match-end 2)))) (and (gnus-request-group igroup t) (gnus-request-article iarticle igroup buffer))))) (defun nnkiboze-request-group (group &optional server dont-check) "Make GROUP the current newsgroup." (nnkiboze-possibly-change-newsgroups group) (if dont-check () (let ((nov-file (nnkiboze-nov-file-name)) beg end total) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (if (not (file-exists-p nov-file)) (insert (format "211 0 0 0 %s\n" group)) (insert-file-contents nov-file) (if (zerop (buffer-size)) (insert (format "211 0 0 0 %s\n" group)) (goto-char (point-min)) (and (looking-at "[0-9]+") (setq beg (read (current-buffer)))) (goto-char (point-max)) (and (re-search-backward "^[0-9]" nil t) (setq end (read (current-buffer)))) (setq total (count-lines (point-min) (point-max))) (erase-buffer) (insert (format "211 %d %d %d %s\n" total beg end group))))))) t) (defun nnkiboze-close-group (group &optional server) (nnkiboze-possibly-change-newsgroups group) ;; Remove NOV lines of articles that are marked as read. (if (not (file-exists-p (nnkiboze-nov-file-name))) () (save-excursion (let ((unreads gnus-newsgroup-unreads) (unselected gnus-newsgroup-unselected)) (set-buffer (get-buffer-create "*nnkiboze work*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (let ((cur (current-buffer)) article) (insert-file-contents (nnkiboze-nov-file-name)) (goto-char (point-min)) (while (looking-at "[0-9]+") (if (or (memq (setq article (read cur)) unreads) (memq article unselected)) (forward-line 1) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point))))) (write-file (nnkiboze-nov-file-name)) (kill-buffer (current-buffer))))) (setq nnkiboze-current-group nil))) (defun nnkiboze-request-list (&optional server) (setq nnkiboze-status-string "nnkiboze: LIST is not implemented.") nil) (defun nnkiboze-request-newgroups (date &optional server) "List new groups." (setq nnkiboze-status-string "NEWGROUPS is not supported.") nil) (defun nnkiboze-request-list-newsgroups (&optional server) (setq nnkiboze-status-string "nnkiboze: LIST NEWSGROUPS is not implemented.") nil) (defalias 'nnkiboze-request-post 'nntp-request-post) (defalias 'nnkiboze-request-post-buffer 'nntp-request-post-buffer) ;;; Internal functions. (defun nnkiboze-possibly-change-newsgroups (group) (setq nnkiboze-current-group group)) (defun nnkiboze-prefixed-name (group) (gnus-group-prefixed-name group '(nnkiboze ""))) ;;;###autoload (defun nnkiboze-generate-groups () "Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups Finds out what articles are to be part of the nnkiboze groups." (interactive) (let ((nnmail-spool-file nil) (gnus-use-dribble-file nil) (gnus-read-active-file t) (gnus-expert-user t)) (gnus)) (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist)) (newsrc gnus-newsrc-alist)) (while newsrc (if (string-match "nnkiboze" (car (car newsrc))) (nnkiboze-generate-group (car (car newsrc)))) (setq newsrc (cdr newsrc))))) (defun nnkiboze-score-file (group) (list (expand-file-name (concat gnus-kill-files-directory nnkiboze-current-score-group "." gnus-score-file-suffix)))) (defun nnkiboze-generate-group (group) (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (newsrc-file (concat nnkiboze-directory group ".newsrc")) (nov-file (concat nnkiboze-directory group ".nov")) (regexp (nth 1 (nth 4 info))) (gnus-expert-user t) (gnus-large-newsgroup nil) (gnus-score-find-score-files-function 'nnkiboze-score-file) gnus-select-group-hook gnus-summary-prepare-hook gnus-thread-sort-functions gnus-show-threads gnus-visual method nnkiboze-newsrc nov-buffer gname newsrc active ginfo lowest) (setq nnkiboze-current-score-group group) (or info (error "No such group: %s" group)) (and (file-exists-p newsrc-file) (load newsrc-file)) (save-excursion (set-buffer (setq nov-buffer (find-file-noselect nov-file))) (buffer-disable-undo (current-buffer))) ;; Go through the active hashtb and add new all groups that match the ;; kiboze regexp. (mapatoms (lambda (group) (if (and (string-match regexp (setq gname (symbol-name group))) ; Match (not (assoc gname nnkiboze-newsrc)) ; It isn't registered (numberp (car (symbol-value group))) ; It is active (not (string-match "^nnkiboze:" gname))) ; Exclude kibozes (setq nnkiboze-newsrc (cons (cons gname (1- (car (symbol-value group)))) nnkiboze-newsrc)))) gnus-active-hashtb) (setq newsrc nnkiboze-newsrc) (while newsrc (if (not (setq active (gnus-gethash (car (car newsrc)) gnus-active-hashtb))) (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) (switch-to-buffer gnus-group-buffer) (gnus-group-jump-to-group (car (car newsrc))) (if (and (setq ginfo (nth 2 (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) (nth 3 ginfo)) (setcar (nthcdr 3 ginfo) nil)) (if (not (and (or (not ginfo) (> (length (gnus-list-of-unread-articles (car ginfo))) 0)) (progn (gnus-group-select-group nil) (eq major-mode 'gnus-summary-mode)))) () (setq lowest (cdr (car newsrc))) (setq method (gnus-find-method-for-group gnus-newsgroup-name)) (and (eq method gnus-select-method) (setq method nil)) (while gnus-newsgroup-scored (if (> (car (car gnus-newsgroup-scored)) lowest) (nnkiboze-enter-nov nov-buffer (gnus-get-header-by-number (car (car gnus-newsgroup-scored))) (if method (gnus-group-prefixed-name gnus-newsgroup-name method) gnus-newsgroup-name))) (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) (gnus-summary-quit))) (setcdr (car newsrc) (car active)) (setq newsrc (cdr newsrc))) (set-buffer nov-buffer) (save-buffer) (kill-buffer (current-buffer)) (set-buffer (get-buffer-create "*nnkiboze work*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert "(setq nnkiboze-newsrc '" (prin1-to-string nnkiboze-newsrc) ")\n") (write-file newsrc-file) (kill-buffer (current-buffer)) (switch-to-buffer gnus-group-buffer) (gnus-group-list-groups 5 nil))) (defun nnkiboze-enter-nov (buffer header group) (save-excursion (set-buffer buffer) (goto-char (point-max)) (let ((xref (mail-header-xref header)) (prefix (gnus-group-real-prefix group)) (first t) article) (if (zerop (forward-line -1)) (progn (setq article (1+ (read (current-buffer)))) (forward-line 1)) (setq article 1)) (insert (int-to-string article) "\t" (or (mail-header-subject header) "") "\t" (or (mail-header-from header) "") "\t" (or (mail-header-date header) "") "\t" (or (mail-header-id header) "") "\t" (or (mail-header-references header) "") "\t" (int-to-string (or (mail-header-chars header) 0)) "\t" (int-to-string (or (mail-header-lines header) 0)) "\t") (if (or (not xref) (equal "" xref)) (insert "Xref: " (system-name) " " group ":" (int-to-string (mail-header-number header)) "\t\n") (insert (mail-header-xref header) "\t\n") (search-backward "\t" nil t) (search-backward "\t" nil t) (while (re-search-forward "[^ ]+:[0-9]+" (save-excursion (end-of-line) (point)) t) (if first ;; The first xref has to be the group this article ;; really came for - this is the article nnkiboze ;; will request when it is asked for the article. (save-excursion (goto-char (match-beginning 0)) (insert prefix group ":" (int-to-string (mail-header-number header)) " ") (setq first nil))) (save-excursion (goto-char (match-beginning 0)) (insert prefix))))))) (defun nnkiboze-nov-file-name () (concat nnkiboze-directory (nnkiboze-prefixed-name nnkiboze-current-group) ".nov")) (provide 'nnkiboze) ;;; nnkiboze.el ends here emacs-19.30/lisp/nnmail.el100444 23053 1 75054 6046561703 14231 0ustar larsidaemon;;; nnmail.el --- mail support functions for the Gnus mail backends ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Code: (require 'nnheader) (require 'rmail) (require 'timezone) (require 'sendmail) (defvar nnmail-split-methods '(("mail.misc" "")) "*Incoming mail will be split according to this variable. If you'd like, for instance, one mail group for mail from the \"4ad-l\" mailing list, one group for junk mail and one for everything else, you could do something like this: (setq nnmail-split-methods '((\"mail.4ad\" \"From:.*4ad\") (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\") (\"mail.misc\" \"\"))) As you can see, this variable is a list of lists, where the first element in each \"rule\" is the name of the group (which, by the way, does not have to be called anything beginning with \"mail\", \"yonka.zow\" is a fine, fine name), and the second is a regexp that nnmail will try to match on the header to find a fit. The second element can also be a function. In that case, it will be called narrowed to the headers with the first element of the rule as the argument. It should return a non-nil value if it thinks that the mail belongs in that group. The last element should always have \"\" as the regexp. This variable can also have a function as its value.") ;; Suggested by Erik Selberg . (defvar nnmail-crosspost t "*If non-nil, do crossposting if several split methods match the mail. If nil, the first match found will be used.") ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). (defvar nnmail-keep-last-article nil "*If non-nil, nnmail will never delete the last expired article in a directory. You may need to set this variable if other programs are putting new mail into folder numbers that Gnus has marked as expired.") (defvar nnmail-expiry-wait 7 "*Articles that are older than `nnmail-expiry-wait' days will be expired.") (defvar nnmail-expiry-wait-function nil "*Variable that holds function to specify how old articles should be before they are expired. The function will be called with the name of the group that the expiry is to be performed in, and it should return an integer that says how many days an article can be stored before it is considered 'old'. Eg.: (setq nnmail-expiry-wait-function (lambda (newsgroup) (cond ((string-match \"private\" newsgroup) 31) ((string-match \"junk\" newsgroup) 1) (t 7))))") (defvar nnmail-spool-file (or (getenv "MAIL") (concat "/usr/spool/mail/" (user-login-name))) "Where the mail backends will look for incoming mail. This variable is \"/usr/spool/mail/$user\" by default. If this variable is nil, no mail backends will read incoming mail. If this variable is a list, all files mentioned in this list will be used as incoming mailboxes.") (defvar nnmail-use-procmail nil "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files. The file(s) in `nnmail-spool-file' will also be read.") (defvar nnmail-procmail-directory "~/incoming/" "*When using procmail (and the like), incoming mail is put in this directory. The Gnus mail backends will read the mail from this directory.") (defvar nnmail-procmail-suffix ".spool" "*Suffix of files created by procmail (and the like). This variable might be a suffix-regexp to match the suffixes of several files - eg. \".spool[0-9]*\".") (defvar nnmail-resplit-incoming nil "*If non-nil, re-split incoming procmail sorted mail.") (defvar nnmail-movemail-program "movemail" "*A command to be executed to move mail from the inbox. The default is \"movemail\".") (defvar nnmail-read-incoming-hook nil "*Hook that will be run after the incoming mail has been transferred. The incoming mail is moved from `nnmail-spool-file' (which normally is something like \"/usr/spool/mail/$user\") to the user's home directory. This hook is called after the incoming mail box has been emptied, and can be used to call any mail box programs you have running (\"xwatch\", etc.) Eg. (add-hook 'nnmail-read-incoming-hook (lambda () (start-process \"mailsend\" nil \"/local/bin/mailsend\" \"read\" \"mbox\")))") ;; Suggested by Erik Selberg . (defvar nnmail-prepare-incoming-hook nil "*Hook called before treating incoming mail. The hook is run in a buffer with all the new, incoming mail.") ;; Suggested by Mejia Pablo J . (defvar nnmail-tmp-directory nil "*If non-nil, use this directory for temporary storage when reading incoming mail.") (defvar nnmail-large-newsgroup 50 "*The number of the articles which indicates a large newsgroup. If the number of the articles is greater than the value, verbose messages will be shown to indicate the current status.") (defvar nnmail-split-fancy "mail.misc" "*Incoming mail can be split according to this fancy variable. To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'. The format is this variable is SPLIT, where SPLIT can be one of the following: GROUP: Mail will be stored in GROUP (a string). \(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains VALUE (a regexp), store the messages as specified by SPLIT. \(| SPLIT...): Process each SPLIT expression until one of them matches. A SPLIT expression is said to match if it will cause the mail message to be stored in one or more groups. \(& SPLIT...): Process each SPLIT expression. FIELD must match a complete field name. VALUE must match a complete word according to the fundamental mode syntax table. You can use .* in the regexps to match partial field names or words. FIELD and VALUE can also be lisp symbols, in that case they are expanded as specified in `nnmail-split-abbrev-alist'. Example: \(setq nnmail-split-methods 'nnmail-split-fancy nnmail-split-fancy ;; Messages from the mailer deamon are not crossposted to any of ;; the ordinary groups. Warnings are put in a separate group ;; from real errors. '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\") \"mail.misc\")) ;; Non-error messages are crossposted to all relevant ;; groups, but we don't crosspost between the group for the ;; (ding) list and the group for other (ding) related mail. (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\") (\"subject\" \"ding\" \"ding.misc\")) ;; Other mailing lists... (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\") (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\") ;; People... (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\")) ;; Unmatched mail goes to the catch all group. \"misc.misc\"))") (defvar nnmail-split-abbrev-alist '((any . "from\\|to\\|cc\\|sender\\|apparently-to") (mail . "mailer-daemon\\|postmaster")) "*Alist of abbreviations allowed in `nnmail-split-fancy'.") (defvar nnmail-delete-incoming t "*If non-nil, the mail backends will delete incoming files after splitting.") (defvar nnmail-message-id-cache-length 1000 "*The approximate number of Message-IDs nnmail will keep in its cache. If this variable is nil, no checking on duplicate messages will be perfomed.") (defvar nnmail-message-id-cache-file "~/.nnmail-cache" "*The file name of the nnmail Message-ID cache.") (defvar nnmail-delete-duplicates nil "*If non-nil, nnmail will delete any duplicate mails it sees.") (defconst nnmail-version "nnmail 1.0" "nnmail version.") (defun nnmail-request-post (&optional server) (mail-send-and-exit nil)) (defun nnmail-request-post-buffer (post group subject header article-buffer info follow-to respect-poster) (let ((method-address (cdr (assq 'to-address (nth 5 info)))) from date to reply-to message-of references message-id cc new-cc sendto elt) (setq method-address (if (and (stringp method-address) (string= method-address "")) nil method-address)) (save-excursion (set-buffer (get-buffer-create "*mail*")) (mail-mode) (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) (if (and (buffer-modified-p) (> (buffer-size) 0) (not (y-or-n-p "Unsent mail being composed; erase it? "))) () (erase-buffer) (if post (progn (mail-setup method-address subject nil nil nil nil) (auto-save-mode auto-save-default)) (save-excursion (set-buffer article-buffer) (goto-char (point-min)) (narrow-to-region (point-min) (progn (search-forward "\n\n") (point))) (let ((buffer-read-only nil)) (set-text-properties (point-min) (point-max) nil)) (setq from (mail-header-from header)) (setq date (mail-header-date header)) (and from (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) (setq message-of (concat (if stop-pos (substring from 0 stop-pos) from) "'s message of " date)))) (setq cc (mail-strip-quoted-names (or (mail-fetch-field "cc") ""))) (setq to (mail-strip-quoted-names (or (mail-fetch-field "to") ""))) (setq new-cc (rmail-dont-reply-to (concat (or to "") (if cc (concat (if to ", " "") cc) "")))) (let ((rmail-dont-reply-to-names (regexp-quote (mail-strip-quoted-names (or method-address reply-to from ""))))) (setq new-cc (rmail-dont-reply-to new-cc))) (setq subject (mail-header-subject header)) (or (string-match "^[Rr][Ee]:" subject) (setq subject (concat "Re: " subject))) (setq reply-to (mail-fetch-field "reply-to")) (setq references (mail-header-references header)) (setq message-id (mail-header-id header)) (widen)) (setq news-reply-yank-from from) (setq news-reply-yank-message-id message-id) ;; Gather the "to" addresses out of the follow-to list and remove ;; them as we go. (if (and follow-to (listp follow-to)) (while (setq elt (assoc "To" follow-to)) (setq sendto (concat sendto (and sendto ", ") (cdr elt))) (setq follow-to (delq elt follow-to)))) (mail-setup (if (and follow-to (listp follow-to)) sendto (or method-address reply-to from "")) subject message-of (if (zerop (length new-cc)) nil new-cc) article-buffer nil) (auto-save-mode auto-save-default) ;; Note that "To" elements should already be in the message. (if (and follow-to (listp follow-to)) (progn (goto-char (point-min)) (re-search-forward "^To:" nil t) (beginning-of-line) (forward-line 1) (while follow-to (insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n") (setq follow-to (cdr follow-to))))) (nnheader-insert-references references message-id))) (current-buffer)))) (defun nnmail-find-file (file) "Insert FILE in server buffer safely." (set-buffer nntp-server-buffer) (erase-buffer) (condition-case () (progn (insert-file-contents file) t) (file-error nil))) (defun nnmail-article-pathname (group mail-dir) "Make pathname for GROUP." (concat (file-name-as-directory (expand-file-name mail-dir)) (nnmail-replace-chars-in-string group ?. ?/) "/")) (defun nnmail-replace-chars-in-string (string from to) "Replace characters in STRING from FROM to TO." (let ((string (substring string 0)) ;Copy string. (len (length string)) (idx 0)) ;; Replace all occurrences of FROM with TO. (while (< idx len) (if (= (aref string idx) from) (aset string idx to)) (setq idx (1+ idx))) string)) (defun nnmail-days-between (date1 date2) ;; Return the number of days between date1 and date2. (let ((d1 (mapcar (lambda (s) (and s (string-to-int s)) ) (timezone-parse-date date1))) (d2 (mapcar (lambda (s) (and s (string-to-int s)) ) (timezone-parse-date date2)))) (- (timezone-absolute-from-gregorian (nth 1 d1) (nth 2 d1) (car d1)) (timezone-absolute-from-gregorian (nth 1 d2) (nth 2 d2) (car d2))))) ;; Function taken from rmail.el. (defun nnmail-move-inbox (inbox tofile) (let ((inbox (file-truename (expand-file-name (substitute-in-file-name inbox)))) movemail popmail errors) ;; Check whether the inbox is to be moved to the special tmp dir. (if nnmail-tmp-directory (setq tofile (concat (file-name-as-directory nnmail-tmp-directory) (file-name-nondirectory tofile)))) ;; Make the filename unique. (setq tofile (nnmail-make-complex-temp-name (expand-file-name tofile))) ;; We create the directory the tofile is to reside in if it ;; doesn't exist. (or (file-exists-p (file-name-directory tofile)) (make-directory tofile 'parents)) ;; If getting from mail spool directory, ;; use movemail to move rather than just renaming, ;; so as to interlock with the mailer. (or (setq popmail (string-match "^po:" (file-name-nondirectory inbox))) (setq movemail t)) (if popmail (setq inbox (file-name-nondirectory inbox))) (if movemail ;; On some systems, /usr/spool/mail/foo is a directory ;; and the actual inbox is /usr/spool/mail/foo/foo. (if (file-directory-p inbox) (setq inbox (expand-file-name (user-login-name) inbox)))) (if popmail (message "Getting mail from post office ...") (if (or (and (file-exists-p tofile) (/= 0 (nth 7 (file-attributes tofile)))) (and (file-exists-p inbox) (/= 0 (nth 7 (file-attributes inbox))))) (message "Getting mail from %s..." inbox))) ;; Set TOFILE if have not already done so, and ;; rename or copy the file INBOX to TOFILE if and as appropriate. (cond ((or (file-exists-p tofile) (and (not popmail) (not (file-exists-p inbox)))) nil) ((and (not movemail) (not popmail)) ;; Try copying. If that fails (perhaps no space), ;; rename instead. (condition-case nil (copy-file inbox tofile nil) (error ;; Third arg is t so we can replace existing file TOFILE. (rename-file inbox tofile t))) ;; Make the real inbox file empty. ;; Leaving it deleted could cause lossage ;; because mailers often won't create the file. (condition-case () (write-region (point) (point) inbox) (file-error nil))) (t (unwind-protect (save-excursion (setq errors (generate-new-buffer " *nnmail loss*")) (buffer-disable-undo errors) (call-process (expand-file-name nnmail-movemail-program exec-directory) nil errors nil inbox tofile) (if (not (buffer-modified-p errors)) ;; No output => movemail won nil (set-buffer errors) (subst-char-in-region (point-min) (point-max) ?\n ?\ ) (goto-char (point-max)) (skip-chars-backward " \t") (delete-region (point) (point-max)) (goto-char (point-min)) (if (looking-at "movemail: ") (delete-region (point-min) (match-end 0))) (beep t) (message (concat "movemail: " (buffer-substring (point-min) (point-max)))) (sit-for 3) nil))))) (and errors (buffer-name errors) (kill-buffer errors)) tofile)) (defun nnmail-get-active () "Returns an assoc of group names and active ranges. nn*-request-list should have been called before calling this function." (let (group-assoc) ;; Go through all groups from the active list. (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) (while (re-search-forward "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) (setq group-assoc (cons (list (buffer-substring (match-beginning 1) (match-end 1)) (cons (string-to-int (buffer-substring (match-beginning 3) (match-end 3))) (string-to-int (buffer-substring (match-beginning 2) (match-end 2))))) group-assoc)))) ;; ;; In addition, add all groups mentioned in `nnmail-split-methods'. ;; (let ((methods (and (not (symbolp nnmail-split-methods)) ;; nnmail-split-methods))) ;; (while methods ;; (if (not (assoc (car (car methods)) group-assoc)) ;; (setq group-assoc ;; (cons (list (car (car methods)) (cons 1 0)) ;; group-assoc))) ;; (setq methods (cdr methods))) group-assoc)) (defun nnmail-save-active (group-assoc file-name) (let (group) (save-excursion (set-buffer (get-buffer-create " *nnmail active*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (while group-assoc (setq group (car group-assoc)) (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) ) (car (car (cdr group))))) (setq group-assoc (cdr group-assoc))) (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg) (kill-buffer (current-buffer))))) (defun nnmail-get-split-group (file group) (if (or (eq nnmail-spool-file 'procmail) nnmail-use-procmail) (cond (group group) ((string-match (concat "^" (expand-file-name (file-name-as-directory nnmail-procmail-directory)) "\\(.*\\)" nnmail-procmail-suffix "$") (expand-file-name file)) (substring (expand-file-name file) (match-beginning 1) (match-end 1))) (t group)) group)) (defun nnmail-split-incoming (incoming func &optional dont-kill group) "Go through the entire INCOMING file and pick out each individual mail. FUNC will be called with the buffer narrowed to each mail." (let ((delim (concat "^" rmail-unix-mail-delimiter)) ;; If this is a group-specific split, we bind the split ;; methods to just this group. (nnmail-split-methods (if (and group (or (eq nnmail-spool-file 'procmail) nnmail-use-procmail) (not nnmail-resplit-incoming)) (list (list group "")) nnmail-split-methods)) start end content-length do-search message-id) (save-excursion ;; Open the message-id cache. (nnmail-cache-open) ;; Insert the incoming file. (set-buffer (get-buffer-create " *nnmail incoming*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert-file-contents incoming) (goto-char (point-min)) (save-excursion (run-hooks 'nnmail-prepare-incoming-hook)) ;; Go to the beginning of the first mail... (if (and (re-search-forward delim nil t) (goto-char (match-beginning 0))) ;; and then carry on until the bitter end. (while (not (eobp)) (setq start (point)) ;; Skip all the headers in case there are more "From "s... (if (not (search-forward "\n\n" nil t)) (forward-line 1)) ;; Find the Message-ID header. (save-excursion (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t) (setq message-id (buffer-substring (match-beginning 1) (match-end 1))) ;; There is no Message-ID here, so we create one. (forward-line -1) (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))) ;; Look for a Content-Length header. (if (not (save-excursion (and (re-search-backward "^Content-Length: \\([0-9]+\\)" start t) (setq content-length (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))) ;; We destroy the header, since none of ;; the backends ever use it, and we do not ;; want to confuse other mailers by having ;; a (possibly) faulty header. (progn (insert "X-") t)))) (setq do-search t) (if (or (= (+ (point) content-length) (point-max)) (save-excursion (goto-char (+ (point) content-length)) (looking-at delim))) (progn (goto-char (+ (point) content-length)) (setq do-search nil)) (setq do-search t))) ;; Go to the beginning of the next article - or to the end ;; of the buffer. (if do-search (if (re-search-forward delim nil t) (goto-char (match-beginning 0)) (goto-char (point-max)))) (save-excursion (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) ;; If this is a duplicate message, then we do not save it. (if (nnmail-cache-id-exists-p message-id) (delete-region (point-min) (point-max)) (nnmail-cache-insert message-id) (funcall func)) (setq end (point-max)))) (goto-char end))) ;; Close the message-id cache. (nnmail-cache-close) (if dont-kill (current-buffer) (kill-buffer (current-buffer)))))) ;; Mail crossposts syggested by Brian Edmonds . (defun nnmail-article-group (func) "Look at the headers and return an alist of groups that match. FUNC will be called with the group name to determine the article number." (let ((methods nnmail-split-methods) (obuf (current-buffer)) (beg (point-min)) end group-art) (if (and (sequencep methods) (= (length methods) 1)) ;; If there is only just one group to put everything in, we ;; just return a list with just this one method in. (setq group-art (list (cons (car (car methods)) (funcall func (car (car methods)))))) ;; We do actual comparison. (save-excursion ;; Find headers. (goto-char beg) (setq end (if (search-forward "\n\n" nil t) (point) (point-max))) (set-buffer (get-buffer-create " *nnmail work*")) (buffer-disable-undo (current-buffer)) (erase-buffer) ;; Copy the headers into the work buffer. (insert-buffer-substring obuf beg end) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) (if (and (symbolp nnmail-split-methods) (fboundp nnmail-split-methods)) (setq group-art (mapcar (lambda (group) (cons group (funcall func group))) (condition-case nil (funcall nnmail-split-methods) (error (message "\ Problems with `nnmail-split-methods', using `bogus' mail group") (sit-for 1) '("bogus"))))) ;; Go throught the split methods to find a match. (while (and methods (or nnmail-crosspost (not group-art))) (goto-char (point-max)) (if (or (cdr methods) (not (equal "" (nth 1 (car methods))))) (if (and (condition-case () (if (stringp (nth 1 (car methods))) (re-search-backward (car (cdr (car methods))) nil t) ;; Suggested by Brian Edmonds ;; . (funcall (nth 1 (car methods)) (car (car methods)))) (error nil)) ;; Don't enter the article into the same group twice. (not (assoc (car (car methods)) group-art))) (setq group-art (cons (cons (car (car methods)) (funcall func (car (car methods)))) group-art))) (or group-art (setq group-art (list (cons (car (car methods)) (funcall func (car (car methods)))))))) (setq methods (cdr methods)))) (kill-buffer (current-buffer)) group-art)))) (defun nnmail-insert-lines () "Insert how many lines and chars there are in the body of the mail." (let (lines chars) (save-excursion (goto-char (point-min)) (if (search-forward "\n\n" nil t) (progn (setq chars (- (point-max) (point))) (setq lines (- (count-lines (point) (point-max)) 1)) (forward-char -1) (save-excursion (if (re-search-backward "^Lines: " nil t) (delete-region (point) (progn (forward-line 1) (point))))) (insert (format "Lines: %d\n" lines)) chars))))) (defun nnmail-insert-xref (group-alist) "Insert an Xref line based on the (group . article) alist." (save-excursion (goto-char (point-min)) (if (search-forward "\n\n" nil t) (progn (forward-char -1) (if (re-search-backward "^Xref: " nil t) (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) (insert (format "Xref: %s" (system-name))) (while group-alist (insert (format " %s:%d" (car (car group-alist)) (cdr (car group-alist)))) (setq group-alist (cdr group-alist))) (insert "\n"))))) ;; Written by byer@mv.us.adobe.com (Scott Byer). (defun nnmail-make-complex-temp-name (prefix) (let ((newname (make-temp-name prefix)) (newprefix prefix)) (while (file-exists-p newname) (setq newprefix (concat newprefix "x")) (setq newname (make-temp-name newprefix))) newname)) ;; Written by Per Abrahamsen . (defun nnmail-split-fancy () "Fancy splitting method. See the documentation for the variable `nnmail-split-fancy' for documentation." (nnmail-split-it nnmail-split-fancy)) (defvar nnmail-split-cache nil) ;; Alist of split expresions their equivalent regexps. (defun nnmail-split-it (split) ;; Return a list of groups matching SPLIT. (cond ((stringp split) ;; A group. (list split)) ((eq (car split) '&) (apply 'nconc (mapcar 'nnmail-split-it (cdr split)))) ((eq (car split) '|) (let (done) (while (and (not done) (cdr split)) (setq split (cdr split) done (nnmail-split-it (car split)))) done)) ((assq split nnmail-split-cache) ;; A compiled match expression. (goto-char (point-max)) (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t) (nnmail-split-it (nth 2 split)))) (t ;; An uncompiled match. (let* ((field (nth 0 split)) (value (nth 1 split)) (regexp (concat "^\\(" (if (symbolp field) (cdr (assq field nnmail-split-abbrev-alist)) field) "\\):.*\\<\\(" (if (symbolp value) (cdr (assq value nnmail-split-abbrev-alist)) value) "\\>\\)"))) (setq nnmail-split-cache (cons (cons split regexp) nnmail-split-cache)) (goto-char (point-max)) (if (re-search-backward regexp nil t) (nnmail-split-it (nth 2 split))))))) ;; Get a list of spool files to read. (defun nnmail-get-spool-files (&optional group) (if (null nnmail-spool-file) ;; No spool file whatsoever. nil) (let* ((procmails ;; If procmail is used to get incoming mail, the files ;; are stored in this directory. (and (file-exists-p nnmail-procmail-directory) (directory-files nnmail-procmail-directory t (concat (if group group "") nnmail-procmail-suffix "$") t))) (p procmails)) ;; Remove any directories that inadvertantly match the procmail ;; suffix, which might happen if the suffix is "". (while p (and (or (file-directory-p (car p)) (file-symlink-p (car p))) (setq procmails (delete (car p) procmails))) (setq p (cdr p))) (cond ((listp nnmail-spool-file) (append nnmail-spool-file procmails)) ((stringp nnmail-spool-file) (cons nnmail-spool-file procmails)) (t procmails)))) ;; Activate a backend only if it isn't already activated. ;; If FORCE, re-read the active file even if the backend is ;; already activated. (defun nnmail-activate (backend &optional force) (let (file timestamp file-time) (if (or (not (symbol-value (intern (format "%s-group-alist" backend)))) force (and (setq file (condition-case () (symbol-value (intern (format "%s-active-file" backend))) (error nil))) (setq file-time (nth 5 (file-attributes file))) (or (not (setq timestamp (condition-case () (symbol-value (intern (format "%s-active-timestamp" backend))) (error 'none)))) (not (consp timestamp)) (equal timestamp '(0 0)) (> (nth 0 file-time) (nth 0 timestamp)) (and (= (nth 0 file-time) (nth 0 timestamp)) (> (nth 1 file-time) (nth 1 timestamp)))))) (save-excursion (or (eq timestamp 'none) (set (intern (format "%s-active-timestamp" backend)) (current-time))) (funcall (intern (format "%s-request-list" backend))) (set (intern (format "%s-group-alist" backend)) (nnmail-get-active)))) t)) (defun nnmail-message-id () (concat "<" (nnmail-unique-id) "@totally-fudged-out-message-id>")) (defvar nnmail-unique-id-char nil) (defun nnmail-number-base36 (num len) (if (if (< len 0) (<= num 0) (= len 0)) "" (concat (nnmail-number-base36 (/ num 36) (1- len)) (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" (% num 36)))))) (defun nnmail-unique-id () (setq nnmail-unique-id-char (% (1+ (or nnmail-unique-id-char (logand (random t) (1- (lsh 1 20))))) ;; (current-time) returns 16-bit ints, ;; and 2^16*25 just fits into 4 digits i base 36. (* 25 25))) (let ((tm (if (fboundp 'current-time) (current-time) '(12191 46742 287898)))) (concat (nnmail-number-base36 (+ (car tm) (lsh (% nnmail-unique-id-char 25) 16)) 4) (nnmail-number-base36 (+ (nth 1 tm) (lsh (/ nnmail-unique-id-char 25) 16)) 4)))) ;;; ;;; nnmail duplicate handling ;;; (defvar nnmail-cache-buffer nil) (defun nnmail-cache-open () (if (or (not nnmail-delete-duplicates) (and nnmail-cache-buffer (buffer-name nnmail-cache-buffer))) () ; The buffer is open. (save-excursion (set-buffer (setq nnmail-cache-buffer (get-buffer-create " *nnmail message-id cache*"))) (buffer-disable-undo (current-buffer)) (and (file-exists-p nnmail-message-id-cache-file) (insert-file-contents nnmail-message-id-cache-file)) (current-buffer)))) (defun nnmail-cache-close () (if (or (not nnmail-cache-buffer) (not nnmail-delete-duplicates) (not (buffer-name nnmail-cache-buffer)) (not (buffer-modified-p nnmail-cache-buffer))) () ; The buffer is closed. (save-excursion (set-buffer nnmail-cache-buffer) ;; Weed out the excess number of Message-IDs. (goto-char (point-max)) (and (search-backward "\n" nil t nnmail-message-id-cache-length) (progn (beginning-of-line) (delete-region (point-min) (point)))) ;; Save the buffer. (or (file-exists-p (file-name-directory nnmail-message-id-cache-file)) (make-directory (file-name-directory nnmail-message-id-cache-file) t)) (write-region (point-min) (point-max) nnmail-message-id-cache-file nil 'silent) (set-buffer-modified-p nil)))) (defun nnmail-cache-insert (id) (and nnmail-delete-duplicates (save-excursion (set-buffer nnmail-cache-buffer) (goto-char (point-max)) (insert id "\n")))) (defun nnmail-cache-id-exists-p (id) (and nnmail-delete-duplicates (save-excursion (set-buffer nnmail-cache-buffer) (goto-char (point-max)) (search-backward id nil t)))) (provide 'nnmail) ;;; nnmail.el ends here emacs-19.30/lisp/nnmbox.el100444 23053 1 37610 6046561714 14252 0ustar larsidaemon;;; nnmbox.el --- mail mbox access for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; For an overview of what the interface functions do, please see the ;; Gnus sources. ;;; Code: (require 'nnheader) (require 'rmail) (require 'nnmail) (defvar nnmbox-mbox-file (expand-file-name "~/mbox") "The name of the mail box file in the user's home directory.") (defvar nnmbox-active-file (expand-file-name "~/.mbox-active") "The name of the active file for the mail box.") (defvar nnmbox-get-new-mail t "If non-nil, nnmbox will check the incoming mail file and split the mail.") (defvar nnmbox-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") (defconst nnmbox-version "nnmbox 1.0" "nnmbox version.") (defvar nnmbox-current-group nil "Current nnmbox news group directory.") (defconst nnmbox-mbox-buffer nil) (defvar nnmbox-status-string "") (defvar nnmbox-group-alist nil) (defvar nnmbox-active-timestamp nil) (defvar nnmbox-current-server nil) (defvar nnmbox-server-alist nil) (defvar nnmbox-server-variables (list (list 'nnmbox-mbox-file nnmbox-mbox-file) (list 'nnmbox-active-file nnmbox-active-file) (list 'nnmbox-get-new-mail nnmbox-get-new-mail) '(nnmbox-current-group nil) '(nnmbox-status-string "") '(nnmbox-group-alist nil))) ;;; Interface functions (defun nnmbox-retrieve-headers (sequence &optional newsgroup server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let ((number (length sequence)) (count 0) article art-string start stop) (nnmbox-possibly-change-newsgroup newsgroup) (if (stringp (car sequence)) 'headers (while sequence (setq article (car sequence)) (setq art-string (nnmbox-article-string article)) (set-buffer nnmbox-mbox-buffer) (if (or (search-forward art-string nil t) (progn (goto-char (point-min)) (search-forward art-string nil t))) (progn (setq start (save-excursion (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) (point))) (search-forward "\n\n" nil t) (setq stop (1- (point))) (set-buffer nntp-server-buffer) (insert (format "221 %d Article retrieved.\n" article)) (insert-buffer-substring nnmbox-mbox-buffer start stop) (goto-char (point-max)) (insert ".\n"))) (setq sequence (cdr sequence)) (setq count (1+ count)) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) (zerop (% count 20)) gnus-verbose-backends (message "nnmbox: Receiving headers... %d%%" (/ (* count 100) number)))) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) gnus-verbose-backends (message "nnmbox: Receiving headers...done")) ;; Fold continuation lines. (set-buffer nntp-server-buffer) (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers)))) (defun nnmbox-open-server (server &optional defs) (nnheader-init-server-buffer) (if (equal server nnmbox-current-server) t (if nnmbox-current-server (setq nnmbox-server-alist (cons (list nnmbox-current-server (nnheader-save-variables nnmbox-server-variables)) nnmbox-server-alist))) (let ((state (assoc server nnmbox-server-alist))) (if state (progn (nnheader-restore-variables (nth 1 state)) (setq nnmbox-server-alist (delq state nnmbox-server-alist))) (nnheader-set-init-variables nnmbox-server-variables defs))) (setq nnmbox-current-server server))) (defun nnmbox-close-server (&optional server) t) (defun nnmbox-server-opened (&optional server) (and (equal server nnmbox-current-server) nnmbox-mbox-buffer (buffer-name nnmbox-mbox-buffer) nntp-server-buffer (buffer-name nntp-server-buffer))) (defun nnmbox-status-message (&optional server) nnmbox-status-string) (defun nnmbox-request-article (article &optional newsgroup server buffer) (nnmbox-possibly-change-newsgroup newsgroup) (if (stringp article) nil (save-excursion (set-buffer nnmbox-mbox-buffer) (goto-char (point-min)) (if (search-forward (nnmbox-article-string article) nil t) (let (start stop) (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) (setq start (point)) (forward-line 1) (or (and (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t) (forward-line -1)) (goto-char (point-max))) (setq stop (point)) (let ((nntp-server-buffer (or buffer nntp-server-buffer))) (set-buffer nntp-server-buffer) (erase-buffer) (insert-buffer-substring nnmbox-mbox-buffer start stop) (goto-char (point-min)) (while (looking-at "From ") (delete-char 5) (insert "X-From-Line: ") (forward-line 1)) t)))))) (defun nnmbox-request-group (group &optional server dont-check) (save-excursion (if (nnmbox-possibly-change-newsgroup group) (if dont-check t (nnmbox-get-new-mail group) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let ((active (assoc group nnmbox-group-alist))) (insert (format "211 %d %d %d %s\n" (1+ (- (cdr (car (cdr active))) (car (car (cdr active))))) (car (car (cdr active))) (cdr (car (cdr active))) (car active)))) t))))) (defun nnmbox-close-group (group &optional server) t) (defun nnmbox-request-list (&optional server) (if server (nnmbox-get-new-mail)) (save-excursion (or (nnmail-find-file nnmbox-active-file) (progn (setq nnmbox-group-alist (nnmail-get-active)) (nnmail-save-active nnmbox-group-alist nnmbox-active-file) (nnmail-find-file nnmbox-active-file))))) (defun nnmbox-request-newgroups (date &optional server) (nnmbox-request-list server)) (defun nnmbox-request-list-newsgroups (&optional server) (setq nnmbox-status-string "nnmbox: LIST NEWSGROUPS is not implemented.") nil) (defun nnmbox-request-post (&optional server) (mail-send-and-exit nil)) (defalias 'nnmbox-request-post-buffer 'nnmail-request-post-buffer) (defun nnmbox-request-expire-articles (articles newsgroup &optional server force) (nnmbox-possibly-change-newsgroup newsgroup) (let* ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function newsgroup)) nnmail-expiry-wait)) (is-old t) rest) (nnmail-activate 'nnmbox) (save-excursion (set-buffer nnmbox-mbox-buffer) (while (and articles is-old) (goto-char (point-min)) (if (search-forward (nnmbox-article-string (car articles)) nil t) (if (or force (setq is-old (> (nnmail-days-between (current-time-string) (buffer-substring (point) (progn (end-of-line) (point)))) days))) (progn (and gnus-verbose-backends (message "Deleting article %s..." (car articles))) (nnmbox-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) (save-buffer) ;; Find the lowest active article in this group. (let ((active (nth 1 (assoc newsgroup nnmbox-group-alist)))) (goto-char (point-min)) (while (and (not (search-forward (nnmbox-article-string (car active)) nil t)) (<= (car active) (cdr active))) (setcar active (1+ (car active))) (goto-char (point-min)))) (nnmail-save-active nnmbox-group-alist nnmbox-active-file) (nconc rest articles)))) (defun nnmbox-request-move-article (article group server accept-form &optional last) (nnmbox-possibly-change-newsgroup group) (let ((buf (get-buffer-create " *nnmbox move*")) result) (and (nnmbox-request-article article group server) (save-excursion (set-buffer buf) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) (while (re-search-forward "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) (setq result (eval accept-form)) (kill-buffer buf) result) (save-excursion (set-buffer nnmbox-mbox-buffer) (goto-char (point-min)) (if (search-forward (nnmbox-article-string article) nil t) (nnmbox-delete-mail)) (and last (save-buffer)))) result)) (defun nnmbox-request-accept-article (group &optional last) (let ((buf (current-buffer)) result) (goto-char (point-min)) (if (looking-at "X-From-Line: ") (replace-match "From ") (insert "From nobody " (current-time-string) "\n")) (and (nnmail-activate 'nnmbox) (progn (set-buffer buf) (goto-char (point-min)) (search-forward "\n\n" nil t) (forward-line -1) (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) (delete-region (point) (progn (forward-line 1) (point)))) (setq result (nnmbox-save-mail (and (stringp group) group)))) (save-excursion (set-buffer nnmbox-mbox-buffer) (insert-buffer-substring buf) (and last (save-buffer)) result) (nnmail-save-active nnmbox-group-alist nnmbox-active-file)) (car result))) (defun nnmbox-request-replace-article (article group buffer) (nnmbox-possibly-change-newsgroup group) (save-excursion (set-buffer nnmbox-mbox-buffer) (goto-char (point-min)) (if (not (search-forward (nnmbox-article-string article) nil t)) nil (nnmbox-delete-mail t t) (insert-buffer-substring buffer) (save-buffer) t))) ;;; Internal functions. ;; If FORCE, delete article no matter how many X-Gnus-Newsgroup ;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox ;; delimeter line. (defun nnmbox-delete-mail (&optional force leave-delim) ;; Delete the current X-Gnus-Newsgroup line. (or force (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) ;; Beginning of the article. (save-excursion (save-restriction (narrow-to-region (save-excursion (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) (if leave-delim (progn (forward-line 1) (point)) (match-beginning 0))) (progn (forward-line 1) (or (and (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t) (if (and (not (bobp)) leave-delim) (progn (forward-line -2) (point)) (match-beginning 0))) (point-max)))) (goto-char (point-min)) ;; Only delete the article if no other groups owns it as well. (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) (delete-region (point-min) (point-max)))))) (defun nnmbox-possibly-change-newsgroup (newsgroup) (if (or (not nnmbox-mbox-buffer) (not (buffer-name nnmbox-mbox-buffer))) (save-excursion (set-buffer (setq nnmbox-mbox-buffer (nnheader-find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)))) (if (not nnmbox-group-alist) (nnmail-activate 'nnmbox)) (if newsgroup (if (assoc newsgroup nnmbox-group-alist) (setq nnmbox-current-group newsgroup)))) (defun nnmbox-article-string (article) (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" (int-to-string article) " ")) (defun nnmbox-save-mail (&optional group) "Called narrowed to an article." (let* ((nnmail-split-methods (if group (list (list group "")) nnmail-split-methods)) (group-art (nreverse (nnmail-article-group 'nnmbox-active-number)))) (nnmail-insert-lines) (nnmail-insert-xref group-art) (nnmbox-insert-newsgroup-line group-art) (run-hooks 'nnml-prepare-save-mail-hook) group-art)) (defun nnmbox-insert-newsgroup-line (group-art) (save-excursion (goto-char (point-min)) (if (search-forward "\n\n" nil t) (progn (forward-char -1) (while group-art (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" (car (car group-art)) (cdr (car group-art)) (current-time-string))) (setq group-art (cdr group-art))))) t)) (defun nnmbox-active-number (group) ;; Find the next article number in GROUP. (let ((active (car (cdr (assoc group nnmbox-group-alist))))) (if active (setcdr active (1+ (cdr active))) ;; This group is new, so we create a new entry for it. ;; This might be a bit naughty... creating groups on the drop of ;; a hat, but I don't know... (setq nnmbox-group-alist (cons (list group (setq active (cons 1 1))) nnmbox-group-alist))) (cdr active))) (defun nnmbox-read-mbox () (nnmail-activate 'nnmbox) (if (not (file-exists-p nnmbox-mbox-file)) (write-region 1 1 nnmbox-mbox-file t 'nomesg)) (if (and nnmbox-mbox-buffer (buffer-name nnmbox-mbox-buffer) (save-excursion (set-buffer nnmbox-mbox-buffer) (= (buffer-size) (nth 7 (file-attributes nnmbox-mbox-file))))) () (save-excursion (let ((delim (concat "^" rmail-unix-mail-delimiter)) start end) (set-buffer (setq nnmbox-mbox-buffer (nnheader-find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)) (goto-char (point-min)) (while (re-search-forward delim nil t) (setq start (match-beginning 0)) (if (not (search-forward "\nX-Gnus-Newsgroup: " (save-excursion (setq end (or (and (re-search-forward delim nil t) (match-beginning 0)) (point-max)))) t)) (save-excursion (save-restriction (narrow-to-region start end) (nnmbox-save-mail)))) (goto-char end)))))) (defun nnmbox-get-new-mail (&optional group) "Read new incoming mail." (let* ((spools (nnmail-get-spool-files group)) (group-in group) incoming incomings) (nnmbox-read-mbox) (if (or (not nnmbox-get-new-mail) (not nnmail-spool-file)) () ;; We go through all the existing spool files and split the ;; mail from each. (while spools (and (file-exists-p (car spools)) (> (nth 7 (file-attributes (car spools))) 0) (progn (and gnus-verbose-backends (message "nnmbox: Reading incoming mail...")) (if (not (setq incoming (nnmail-move-inbox (car spools) (concat nnmbox-mbox-file "-Incoming")))) () (setq incomings (cons incoming incomings)) (save-excursion (setq group (nnmail-get-split-group (car spools) group-in)) (let ((in-buf (nnmail-split-incoming incoming 'nnmbox-save-mail t group))) (set-buffer nnmbox-mbox-buffer) (goto-char (point-max)) (insert-buffer-substring in-buf) (kill-buffer in-buf)))))) (setq spools (cdr spools))) ;; If we did indeed read any incoming spools, we save all info. (and (buffer-modified-p nnmbox-mbox-buffer) (save-excursion (nnmail-save-active nnmbox-group-alist nnmbox-active-file) (set-buffer nnmbox-mbox-buffer) (save-buffer))) (if incomings (run-hooks 'nnmail-read-incoming-hook)) (while incomings (setq incoming (car incomings)) (and nnmail-delete-incoming (file-exists-p incoming) (file-writable-p incoming) (delete-file incoming)) (setq incomings (cdr incomings)))))) (provide 'nnmbox) ;;; nnmbox.el ends here emacs-19.30/lisp/nnmh.el100444 23053 1 40135 6046561731 13704 0ustar larsidaemon;;; nnmh.el --- mhspool access for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Based on nnspool.el by Masanobu UMEDA . ;; For an overview of what the interface functions do, please see the ;; Gnus sources. ;;; Code: (require 'nnheader) (require 'rmail) (require 'nnmail) (require 'gnus) (defvar nnmh-directory "~/Mail/" "*Mail spool directory.") (defvar nnmh-get-new-mail t "*If non-nil, nnmh will check the incoming mail file and split the mail.") (defvar nnmh-prepare-save-mail-hook nil "*Hook run narrowed to an article before saving.") (defvar nnmh-be-safe nil "*If non-nil, nnmh will check all articles to make sure whether they are new or not.") (defconst nnmh-version "nnmh 1.0" "nnmh version.") (defvar nnmh-current-directory nil "Current news group directory.") (defvar nnmh-status-string "") (defvar nnmh-group-alist nil) (defvar nnmh-current-server nil) (defvar nnmh-server-alist nil) (defvar nnmh-server-variables (list (list 'nnmh-directory nnmh-directory) (list 'nnmh-get-new-mail nnmh-get-new-mail) '(nnmh-current-directory nil) '(nnmh-status-string "") '(nnmh-group-alist))) ;;; Interface functions. (defun nnmh-retrieve-headers (sequence &optional newsgroup server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let* ((file nil) (number (length sequence)) (large (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup))) (count 0) beg article) (nnmh-possibly-change-directory newsgroup) (if (stringp (car sequence)) 'headers (while sequence (setq article (car sequence)) (setq file (concat nnmh-current-directory (int-to-string article))) (if (and (file-exists-p file) (not (file-directory-p file))) (progn (insert (format "221 %d Article retrieved.\n" article)) (setq beg (point)) (nnheader-insert-head file) (goto-char beg) (if (search-forward "\n\n" nil t) (forward-char -1) (goto-char (point-max)) (insert "\n\n")) (insert ".\n") (delete-region (point) (point-max)))) (setq sequence (cdr sequence)) (setq count (1+ count)) (and large (zerop (% count 20)) (message "nnmh: Receiving headers... %d%%" (/ (* count 100) number)))) (and large (message "nnmh: Receiving headers...done")) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers)))) (defun nnmh-open-server (server &optional defs) (nnheader-init-server-buffer) (if (equal server nnmh-current-server) t (if nnmh-current-server (setq nnmh-server-alist (cons (list nnmh-current-server (nnheader-save-variables nnmh-server-variables)) nnmh-server-alist))) (let ((state (assoc server nnmh-server-alist))) (if state (progn (nnheader-restore-variables (nth 1 state)) (setq nnmh-server-alist (delq state nnmh-server-alist))) (nnheader-set-init-variables nnmh-server-variables defs))) (setq nnmh-current-server server))) (defun nnmh-close-server (&optional server) t) (defun nnmh-server-opened (&optional server) (and (equal server nnmh-current-server) nntp-server-buffer (buffer-name nntp-server-buffer))) (defun nnmh-status-message (&optional server) nnmh-status-string) (defun nnmh-request-article (id &optional newsgroup server buffer) (nnmh-possibly-change-directory newsgroup) (let ((file (if (stringp id) nil (concat nnmh-current-directory (int-to-string id)))) (nntp-server-buffer (or buffer nntp-server-buffer))) (and (stringp file) (file-exists-p file) (not (file-directory-p file)) (save-excursion (nnmail-find-file file))))) (defun nnmh-request-group (group &optional server dont-check) (and nnmh-get-new-mail (or dont-check (nnmh-get-new-mail group))) (let ((pathname (nnmh-article-pathname group nnmh-directory)) dir) (if (file-directory-p pathname) (progn (setq nnmh-current-directory pathname) (and nnmh-get-new-mail nnmh-be-safe (nnmh-update-gnus-unreads group)) (or dont-check (progn (setq dir (sort (mapcar (function (lambda (name) (string-to-int name))) (directory-files pathname nil "^[0-9]+$" t)) '<)) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (if dir (insert (format "211 %d %d %d %s\n" (length dir) (car dir) (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) group)) (insert (format "211 0 1 0 %s\n" group)))))) t) (setq nnmh-status-string "No such group") nil))) (defun nnmh-request-list (&optional server dir) (or dir (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (setq dir (file-truename (file-name-as-directory nnmh-directory))))) (setq dir (expand-file-name dir)) ;; Recurse down all directories. (let ((dirs (and (file-readable-p dir) (> (nth 1 (file-attributes (file-chase-links dir))) 2) (directory-files dir t nil t)))) (while dirs (if (and (not (string-match "/\\.\\.?$" (car dirs))) (file-directory-p (car dirs)) (file-readable-p (car dirs))) (nnmh-request-list nil (car dirs))) (setq dirs (cdr dirs)))) ;; For each directory, generate an active file line. (if (not (string= (expand-file-name nnmh-directory) dir)) (let ((files (mapcar (lambda (name) (string-to-int name)) (directory-files dir nil "^[0-9]+$" t)))) (if (null files) () (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-max)) (insert (format "%s %d %d y\n" (progn (string-match (file-truename (file-name-as-directory (expand-file-name nnmh-directory))) dir) (nnmail-replace-chars-in-string (substring dir (match-end 0)) ?/ ?.)) (apply (function max) files) (apply (function min) files))))))) (setq nnmh-group-alist (nnmail-get-active)) (and server nnmh-get-new-mail (nnmh-get-new-mail)) t) (defun nnmh-request-newgroups (date &optional server) (nnmh-request-list server)) (defun nnmh-request-post (&optional server) (mail-send-and-exit nil)) (defalias 'nnmh-request-post-buffer 'nnmail-request-post-buffer) (defun nnmh-request-expire-articles (articles newsgroup &optional server force) (nnmh-possibly-change-directory newsgroup) (let* ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function newsgroup)) nnmail-expiry-wait)) (active-articles (mapcar (function (lambda (name) (string-to-int name))) (directory-files nnmh-current-directory nil "^[0-9]+$" t))) (max-article (and active-articles (apply 'max active-articles))) (is-old t) article rest mod-time) (nnmail-activate 'nnmh) (while (and articles is-old) (setq article (concat nnmh-current-directory (int-to-string (car articles)))) (if (setq mod-time (nth 5 (file-attributes article))) (if (and (or (not nnmail-keep-last-article) (not max-article) (not (= (car articles) max-article))) (not (equal mod-time '(0 0))) (or force (setq is-old (> (nnmail-days-between (current-time-string) (current-time-string mod-time)) days)))) (progn (and gnus-verbose-backends (message "Deleting article %s..." article)) (condition-case () (delete-file article) (file-error (setq rest (cons (car articles) rest))))) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) (message "") (nconc rest articles))) (defun nnmh-close-group (group &optional server) t) (defun nnmh-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnmh move*")) result) (and (nnmh-request-article article group server) (save-excursion (set-buffer buf) (insert-buffer-substring nntp-server-buffer) (setq result (eval accept-form)) (kill-buffer (current-buffer)) result) (condition-case () (delete-file (concat nnmh-current-directory (int-to-string article))) (file-error nil))) result)) (defun nnmh-request-accept-article (group &optional last) (if (stringp group) (and (nnmail-activate 'nnmh) ;; We trick the choosing function into believing that only one ;; group is availiable. (let ((nnmail-split-methods (list (list group "")))) (car (nnmh-save-mail)))) (and (nnmail-activate 'nnmh) (car (nnmh-save-mail))))) (defun nnmh-request-replace-article (article group buffer) (nnmh-possibly-change-directory group) (save-excursion (set-buffer buffer) (nnmh-possibly-create-directory group) (condition-case () (progn (write-region (point-min) (point-max) (concat nnmh-current-directory (int-to-string article)) nil (if gnus-verbose-backends nil 'nomesg)) t) (error nil)))) ;;; Internal functions. (defun nnmh-possibly-change-directory (newsgroup) (if newsgroup (let ((pathname (nnmh-article-pathname newsgroup nnmh-directory))) (if (file-directory-p pathname) (setq nnmh-current-directory pathname) (error "No such newsgroup: %s" newsgroup))))) (defun nnmh-possibly-create-directory (group) (let (dir dirs) (setq dir (nnmh-article-pathname group nnmh-directory)) (while (not (file-directory-p dir)) (setq dirs (cons dir dirs)) (setq dir (file-name-directory (directory-file-name dir)))) (while dirs (if (make-directory (directory-file-name (car dirs))) (error "Could not create directory %s" (car dirs))) (and gnus-verbose-backends (message "Creating mail directory %s" (car dirs))) (setq dirs (cdr dirs))))) (defun nnmh-save-mail () "Called narrowed to an article." (let ((group-art (nreverse (nnmail-article-group 'nnmh-active-number)))) (nnmail-insert-lines) (nnmail-insert-xref group-art) (run-hooks 'nnmh-prepare-save-mail-hook) (goto-char (point-min)) (while (looking-at "From ") (replace-match "X-From-Line: ") (forward-line 1)) ;; We save the article in all the newsgroups it belongs in. (let ((ga group-art) first) (while ga (nnmh-possibly-create-directory (car (car ga))) (let ((file (concat (nnmh-article-pathname (car (car ga)) nnmh-directory) (int-to-string (cdr (car ga)))))) (if first ;; It was already saved, so we just make a hard link. (add-name-to-file first file t) ;; Save the article. (write-region (point-min) (point-max) file nil nil) (setq first file))) (setq ga (cdr ga)))) group-art)) (defun nnmh-active-number (group) "Compute the next article number in GROUP." (let ((active (car (cdr (assoc group nnmh-group-alist))))) ;; The group wasn't known to nnmh, so we just create an active ;; entry for it. (or active (progn (setq active (cons 1 0)) (setq nnmh-group-alist (cons (list group active) nnmh-group-alist)))) (setcdr active (1+ (cdr active))) (while (file-exists-p (concat (nnmh-article-pathname group nnmh-directory) (int-to-string (cdr active)))) (setcdr active (1+ (cdr active)))) (cdr active))) (defun nnmh-article-pathname (group mail-dir) "Make pathname for GROUP." (let ((mail-dir (file-name-as-directory (expand-file-name mail-dir)))) (if (file-directory-p (concat mail-dir group)) (concat mail-dir group "/") (concat mail-dir (nnmail-replace-chars-in-string group ?. ?/) "/")))) (defun nnmh-get-new-mail (&optional group) "Read new incoming mail." (let* ((spools (nnmail-get-spool-files group)) (group-in group) incoming incomings) (if (or (not nnmh-get-new-mail) (not nnmail-spool-file)) () ;; We first activate all the groups. (or nnmh-group-alist (nnmh-request-list)) ;; The we go through all the existing spool files and split the ;; mail from each. (while spools (and (file-exists-p (car spools)) (> (nth 7 (file-attributes (car spools))) 0) (progn (and gnus-verbose-backends (message "nnmh: Reading incoming mail...")) (if (not (setq incoming (nnmail-move-inbox (car spools) (concat (file-name-as-directory nnmh-directory) "Incoming")))) () (setq incomings (cons incoming incomings)) (setq group (nnmail-get-split-group (car spools) group-in)) (nnmail-split-incoming incoming 'nnmh-save-mail nil group)))) (setq spools (cdr spools))) ;; If we did indeed read any incoming spools, we save all info. (if incoming (message "nnmh: Reading incoming mail...done")) (while incomings (setq incoming (car incomings)) (and nnmail-delete-incoming (file-exists-p incoming) (file-writable-p incoming) (delete-file incoming)) (setq incomings (cdr incomings)))))) (defun nnmh-update-gnus-unreads (group) ;; Go through the .nnmh-articles file and compare with the actual ;; articles in this folder. The articles that are "new" will be ;; marked as unread by Gnus. (let* ((dir nnmh-current-directory) (files (sort (mapcar (function (lambda (name) (string-to-int name))) (directory-files nnmh-current-directory nil "^[0-9]+$" t)) '<)) (nnmh-file (concat dir ".nnmh-articles")) new articles) ;; Load the .nnmh-articles file. (if (file-exists-p nnmh-file) (setq articles (let (nnmh-newsgroup-articles) (condition-case nil (load nnmh-file nil t t) (error nil)) nnmh-newsgroup-articles))) ;; Add all new articles to the `new' list. (let ((art files)) (while art (if (not (assq (car art) articles)) (setq new (cons (car art) new))) (setq art (cdr art)))) ;; Remove all deleted articles. (let ((art articles)) (while art (if (not (memq (car (car art)) files)) (setq articles (delq (car art) articles))) (setq art (cdr art)))) ;; Check whether the highest-numbered articles really are the ones ;; that Gnus thinks they are by looking at the time-stamps. (let ((art articles)) (while (and art (not (equal (nth 5 (file-attributes (concat dir (int-to-string (car (car art)))))) (cdr (car art))))) (setq articles (delq (car art) articles)) (setq new (cons (car (car art)) new)) (setq art (cdr art)))) ;; Go through all the new articles and add them, and their ;; time-stamps to the list. (let ((n new)) (while n (setq articles (cons (cons (car n) (nth 5 (file-attributes (concat dir (int-to-string (car n)))))) articles)) (setq n (cdr n)))) ;; Make Gnus mark all new articles as unread. (or (zerop (length new)) (gnus-make-articles-unread (gnus-group-prefixed-name group (list 'nnmh "")) (setq new (sort new '<)))) ;; Sort the article list with highest numbers first. (setq articles (sort articles (lambda (art1 art2) (> (car art1) (car art2))))) ;; Finally write this list back to the .nnmh-articles file. (save-excursion (set-buffer (get-buffer-create "*nnmh out*")) (insert ";; Gnus article active file for " group "\n\n") (insert "(setq nnmh-newsgroup-articles '") (insert (prin1-to-string articles) ")\n") (write-region (point-min) (point-max) nnmh-file nil 'nomesg) (kill-buffer (current-buffer))))) (provide 'nnmh) ;;; nnmh.el ends here emacs-19.30/lisp/nnml.el100444 23053 1 53770 6046561742 13723 0ustar larsidaemon;;; nnml.el --- mail spool access for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Based on nnspool.el by Masanobu UMEDA . ;; For an overview of what the interface functions do, please see the ;; Gnus sources. ;;; Code: (require 'nnheader) (require 'nnmail) (defvar nnml-directory "~/Mail/" "Mail spool directory.") (defvar nnml-active-file (concat nnml-directory "active") "Mail active file.") (defvar nnml-newsgroups-file (concat nnml-directory "newsgroups") "Mail newsgroups description file.") (defvar nnml-get-new-mail t "If non-nil, nnml will check the incoming mail file and split the mail.") (defvar nnml-nov-is-evil nil "If non-nil, Gnus will never generate and use nov databases for mail groups. Using nov databases will speed up header fetching considerably. This variable shouldn't be flipped much. If you have, for some reason, set this to t, and want to set it to nil again, you should always run the `nnml-generate-nov-databases' command. The function will go through all nnml directories and generate nov databases for them all. This may very well take some time.") (defvar nnml-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") (defconst nnml-version "nnml 1.0" "nnml version.") (defvar nnml-nov-file-name ".overview") (defvar nnml-current-directory nil) (defvar nnml-status-string "") (defvar nnml-nov-buffer-alist nil) (defvar nnml-group-alist nil) (defvar nnml-active-timestamp nil) ;; Server variables. (defvar nnml-current-server nil) (defvar nnml-server-alist nil) (defvar nnml-server-variables (list (list 'nnml-directory nnml-directory) (list 'nnml-active-file nnml-active-file) (list 'nnml-newsgroups-file nnml-newsgroups-file) (list 'nnml-get-new-mail nnml-get-new-mail) (list 'nnml-nov-is-evil nnml-nov-is-evil) (list 'nnml-nov-file-name nnml-nov-file-name) '(nnml-current-directory nil) '(nnml-status-string "") '(nnml-nov-buffer-alist nil) '(nnml-group-alist nil) '(nnml-active-timestamp nil))) ;;; Interface functions. (defun nnml-retrieve-headers (sequence &optional newsgroup server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let ((file nil) (number (length sequence)) (count 0) beg article) (if (stringp (car sequence)) 'headers (nnml-possibly-change-directory newsgroup) (if (nnml-retrieve-headers-with-nov sequence) 'nov (while sequence (setq article (car sequence)) (setq file (concat nnml-current-directory (int-to-string article))) (if (and (file-exists-p file) (not (file-directory-p file))) (progn (insert (format "221 %d Article retrieved.\n" article)) (setq beg (point)) (nnheader-insert-head file) (goto-char beg) (if (search-forward "\n\n" nil t) (forward-char -1) (goto-char (point-max)) (insert "\n\n")) (insert ".\n") (delete-region (point) (point-max)))) (setq sequence (cdr sequence)) (setq count (1+ count)) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) (zerop (% count 20)) gnus-verbose-backends (message "nnml: Receiving headers... %d%%" (/ (* count 100) number)))) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) gnus-verbose-backends (message "nnml: Receiving headers...done")) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers))))) (defun nnml-open-server (server &optional defs) (nnheader-init-server-buffer) (if (equal server nnml-current-server) t (if nnml-current-server (setq nnml-server-alist (cons (list nnml-current-server (nnheader-save-variables nnml-server-variables)) nnml-server-alist))) (let ((state (assoc server nnml-server-alist))) (if state (progn (nnheader-restore-variables (nth 1 state)) (setq nnml-server-alist (delq state nnml-server-alist))) (nnheader-set-init-variables nnml-server-variables defs))) (setq nnml-current-server server))) (defun nnml-close-server (&optional server) t) (defun nnml-server-opened (&optional server) (and (equal server nnml-current-server) nntp-server-buffer (buffer-name nntp-server-buffer))) (defun nnml-status-message (&optional server) nnml-status-string) (defun nnml-request-article (id &optional newsgroup server buffer) (nnml-possibly-change-directory newsgroup) (let ((file (if (stringp id) nil (concat nnml-current-directory (int-to-string id)))) (nntp-server-buffer (or buffer nntp-server-buffer))) (if (and (stringp file) (file-exists-p file) (not (file-directory-p file))) (save-excursion (nnmail-find-file file))))) (defun nnml-request-group (group &optional server dont-check) (if (not (nnml-possibly-change-directory group)) (progn (setq nnml-status-string "Invalid group (no such directory)") nil) (if dont-check t (nnml-get-new-mail group) (nnmail-activate 'nnml) (let ((active (nth 1 (assoc group nnml-group-alist)))) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (if (not active) () (insert (format "211 %d %d %d %s\n" (max (1+ (- (cdr active) (car active))) 0) (car active) (cdr active) group)) t)))))) (defun nnml-close-group (group &optional server) t) (defun nnml-request-close () (setq nnml-current-server nil) (setq nnml-server-alist nil) t) (defun nnml-request-create-group (group &optional server) (nnmail-activate 'nnml) (or (assoc group nnml-group-alist) (let (active) (setq nnml-group-alist (cons (list group (setq active (cons 1 0))) nnml-group-alist)) (nnml-possibly-create-directory group) (nnml-possibly-change-directory group) (let ((articles (mapcar (lambda (file) (string-to-int file)) (directory-files nnml-current-directory nil "^[0-9]+$")))) (and articles (progn (setcar active (apply 'min articles)) (setcdr active (apply 'max articles))))) (nnmail-save-active nnml-group-alist nnml-active-file))) t) (defun nnml-request-list (&optional server) (if server (nnml-get-new-mail)) (save-excursion (nnmail-find-file nnml-active-file) (setq nnml-group-alist (nnmail-get-active)))) (defun nnml-request-newgroups (date &optional server) (nnml-request-list server)) (defun nnml-request-list-newsgroups (&optional server) (save-excursion (nnmail-find-file nnml-newsgroups-file))) (defun nnml-request-post (&optional server) (mail-send-and-exit nil)) (defalias 'nnml-request-post-buffer 'nnmail-request-post-buffer) (defun nnml-request-expire-articles (articles newsgroup &optional server force) (nnml-possibly-change-directory newsgroup) (let* ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function newsgroup)) nnmail-expiry-wait)) (active-articles (mapcar (function (lambda (name) (string-to-int name))) (directory-files nnml-current-directory nil "^[0-9]+$" t))) (max-article (and active-articles (apply 'max active-articles))) (is-old t) article rest mod-time) (nnmail-activate 'nnml) (while (and articles is-old) (setq article (concat nnml-current-directory (int-to-string (car articles)))) (if (setq mod-time (nth 5 (file-attributes article))) (if (and (or (not nnmail-keep-last-article) (not max-article) (not (= (car articles) max-article))) (or force (and (not (equal mod-time '(0 0))) (setq is-old (> (nnmail-days-between (current-time-string) (current-time-string mod-time)) days))))) (progn (and gnus-verbose-backends (message "Deleting article %s..." article)) (condition-case () (delete-file article) (file-error (setq rest (cons (car articles) rest)))) (setq active-articles (delq (car articles) active-articles)) (nnml-nov-delete-article newsgroup (car articles))) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) (let ((active (nth 1 (assoc newsgroup nnml-group-alist)))) (and active (setcar active (or (and active-articles (apply 'min active-articles)) 0))) (nnmail-save-active nnml-group-alist nnml-active-file)) (nnml-save-nov) (message "") (nconc rest articles))) (defun nnml-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnml move*")) result) (and (nnml-request-article article group server) (save-excursion (set-buffer buf) (insert-buffer-substring nntp-server-buffer) (setq result (eval accept-form)) (kill-buffer (current-buffer)) result) (progn (condition-case () (delete-file (concat nnml-current-directory (int-to-string article))) (file-error nil)) (nnml-nov-delete-article group article) (and last (nnml-save-nov)))) result)) (defun nnml-request-accept-article (group &optional last) (let (result) (if (stringp group) (and (nnmail-activate 'nnml) ;; We trick the choosing function into believing that only one ;; group is availiable. (let ((nnmail-split-methods (list (list group "")))) (setq result (car (nnml-save-mail)))) (progn (nnmail-save-active nnml-group-alist nnml-active-file) (and last (nnml-save-nov)))) (and (nnmail-activate 'nnml) (setq result (car (nnml-save-mail))) (progn (nnmail-save-active nnml-group-alist nnml-active-file) (and last (nnml-save-nov))))) result)) (defun nnml-request-replace-article (article group buffer) (nnml-possibly-change-directory group) (save-excursion (set-buffer buffer) (nnml-possibly-create-directory group) (if (not (condition-case () (progn (write-region (point-min) (point-max) (concat nnml-current-directory (int-to-string article)) nil (if gnus-verbose-backends nil 'nomesg)) t) (error nil))) () (let ((chars (nnmail-insert-lines)) (art (concat (int-to-string article) "\t")) nov-line) (setq nov-line (nnml-make-nov-line chars)) ;; Replace the NOV line in the NOV file. (save-excursion (set-buffer (nnml-open-nov group)) (goto-char (point-min)) (if (or (looking-at art) (search-forward (concat "\n" art) nil t)) ;; Delete the old NOV line. (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point))) ;; The line isn't here, so we have to find out where ;; we should insert it. (This situation should never ;; occur, but one likes to make sure...) (while (and (looking-at "[0-9]+\t") (< (string-to-int (buffer-substring (match-beginning 0) (match-end 0))) article) (zerop (forward-line 1))))) (beginning-of-line) (insert (int-to-string article) nov-line) (nnml-save-nov) t))))) ;;; Internal functions (defun nnml-retrieve-headers-with-nov (articles) (if (or gnus-nov-is-evil nnml-nov-is-evil) nil (let ((first (car articles)) (last (progn (while (cdr articles) (setq articles (cdr articles))) (car articles))) (nov (concat nnml-current-directory nnml-nov-file-name))) (if (file-exists-p nov) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (insert-file-contents nov) (goto-char (point-min)) (while (and (not (eobp)) (< first (read (current-buffer)))) (forward-line 1)) (beginning-of-line) (if (not (eobp)) (delete-region 1 (point))) (while (and (not (eobp)) (>= last (read (current-buffer)))) (forward-line 1)) (beginning-of-line) (if (not (eobp)) (delete-region (point) (point-max))) t))))) (defun nnml-possibly-change-directory (newsgroup &optional force) (if newsgroup (let ((pathname (nnmail-article-pathname newsgroup nnml-directory))) (and (or force (file-directory-p pathname)) (setq nnml-current-directory pathname))) t)) (defun nnml-possibly-create-directory (group) (let (dir dirs) (setq dir (nnmail-article-pathname group nnml-directory)) (while (not (file-directory-p dir)) (setq dirs (cons dir dirs)) (setq dir (file-name-directory (directory-file-name dir)))) (while dirs (make-directory (directory-file-name (car dirs))) (and gnus-verbose-backends (message "Creating mail directory %s" (car dirs))) (setq dirs (cdr dirs))))) (defun nnml-save-mail () "Called narrowed to an article." (let ((group-art (nreverse (nnmail-article-group 'nnml-active-number))) chars nov-line) (setq chars (nnmail-insert-lines)) (nnmail-insert-xref group-art) (run-hooks 'nnml-prepare-save-mail-hook) (goto-char (point-min)) (while (looking-at "From ") (replace-match "X-From-Line: ") (forward-line 1)) ;; We save the article in all the newsgroups it belongs in. (let ((ga group-art) first) (while ga (nnml-possibly-create-directory (car (car ga))) (let ((file (concat (nnmail-article-pathname (car (car ga)) nnml-directory) (int-to-string (cdr (car ga)))))) (if first ;; It was already saved, so we just make a hard link. (add-name-to-file first file t) ;; Save the article. (write-region (point-min) (point-max) file nil (if gnus-verbose-backends nil 'nomesg)) (setq first file))) (setq ga (cdr ga)))) ;; Generate a nov line for this article. We generate the nov ;; line after saving, because nov generation destroys the ;; header. (setq nov-line (nnml-make-nov-line chars)) ;; Output the nov line to all nov databases that should have it. (let ((ga group-art)) (while ga (nnml-add-nov (car (car ga)) (cdr (car ga)) nov-line) (setq ga (cdr ga)))) group-art)) (defun nnml-active-number (group) "Compute the next article number in GROUP." (let ((active (car (cdr (assoc group nnml-group-alist))))) ;; The group wasn't known to nnml, so we just create an active ;; entry for it. (or active (progn (setq active (cons 1 0)) (setq nnml-group-alist (cons (list group active) nnml-group-alist)))) (setcdr active (1+ (cdr active))) (while (file-exists-p (concat (nnmail-article-pathname group nnml-directory) (int-to-string (cdr active)))) (setcdr active (1+ (cdr active)))) (cdr active))) (defun nnml-get-new-mail (&optional group) "Read new incoming mail." (let* ((spools (nnmail-get-spool-files group)) (group-in group) incoming incomings) (if (or (not nnml-get-new-mail) (not nnmail-spool-file)) () ;; We first activate all the groups. (nnmail-activate 'nnml) ;; The we go through all the existing spool files and split the ;; mail from each. (while spools (and (file-exists-p (car spools)) (> (nth 7 (file-attributes (car spools))) 0) (progn (and gnus-verbose-backends (message "nnml: Reading incoming mail...")) (if (not (setq incoming (nnmail-move-inbox (car spools) (concat nnml-directory "Incoming")))) () (setq group (nnmail-get-split-group (car spools) group-in)) (nnmail-split-incoming incoming 'nnml-save-mail nil group) (setq incomings (cons incoming incomings))))) (setq spools (cdr spools))) ;; If we did indeed read any incoming spools, we save all info. (if incoming (progn (nnmail-save-active nnml-group-alist nnml-active-file) (nnml-save-nov) (run-hooks 'nnmail-read-incoming-hook) (and gnus-verbose-backends (message "nnml: Reading incoming mail...done")))) (while incomings (setq incoming (car incomings)) (and nnmail-delete-incoming (file-exists-p incoming) (file-writable-p incoming) (delete-file incoming)) (setq incomings (cdr incomings)))))) (defun nnml-add-nov (group article line) "Add a nov line for the GROUP base." (save-excursion (set-buffer (nnml-open-nov group)) (goto-char (point-max)) (insert (int-to-string article) line))) (defsubst nnml-header-value () (buffer-substring (match-end 0) (save-excursion (end-of-line) (point)))) (defun nnml-make-nov-line (chars) "Create a nov from the current headers." (let ((case-fold-search t) subject from date id references lines xref in-reply-to char) (save-excursion (save-restriction (goto-char (point-min)) (narrow-to-region (point) (1- (or (search-forward "\n\n" nil t) (point-max)))) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) (subst-char-in-region (point-min) (point-max) ?\t ? ) ;; [number subject from date id references chars lines xref] (save-excursion (goto-char (point-min)) (while (re-search-forward "^\\(from\\|subject\\|message-id\\|date\\|lines\\|xref\\|references\\|in-reply-to\\): " nil t) (beginning-of-line) (setq char (downcase (following-char))) (cond ((eq char ?s) (setq subject (nnml-header-value))) ((eq char ?f) (setq from (nnml-header-value))) ((eq char ?x) (setq xref (nnml-header-value))) ((eq char ?l) (setq lines (nnml-header-value))) ((eq char ?d) (setq date (nnml-header-value))) ((eq char ?m) (setq id (setq id (nnml-header-value)))) ((eq char ?r) (setq references (nnml-header-value))) ((eq char ?i) (setq in-reply-to (nnml-header-value)))) (forward-line 1)) (and (not references) in-reply-to (string-match "<[^>]+>" in-reply-to) (setq references (substring in-reply-to (match-beginning 0) (match-end 0))))) ;; [number subject from date id references chars lines xref] (format "\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t%s\t\n" (or subject "(none)") (or from "(nobody)") (or date "") (or id (concat "nnml-dummy-id-" (mapconcat (lambda (time) (int-to-string time)) (current-time) "-"))) (or references "") (or chars 0) (or lines "0") (or xref "")))))) (defun nnml-open-nov (group) (or (cdr (assoc group nnml-nov-buffer-alist)) (let ((buffer (find-file-noselect (concat (nnmail-article-pathname group nnml-directory) nnml-nov-file-name)))) (save-excursion (set-buffer buffer) (buffer-disable-undo (current-buffer))) (setq nnml-nov-buffer-alist (cons (cons group buffer) nnml-nov-buffer-alist)) buffer))) (defun nnml-save-nov () (save-excursion (while nnml-nov-buffer-alist (if (buffer-name (cdr (car nnml-nov-buffer-alist))) (progn (set-buffer (cdr (car nnml-nov-buffer-alist))) (and (buffer-modified-p) (write-region 1 (point-max) (buffer-file-name) nil 'nomesg)) (set-buffer-modified-p nil) (kill-buffer (current-buffer)))) (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist))))) ;;;###autoload (defun nnml-generate-nov-databases (dir) "Generate nov databases in all nnml mail newsgroups." (interactive (progn (setq nnml-group-alist nil) (list nnml-directory))) (nnml-open-server (or nnml-current-server "")) (let ((dirs (directory-files dir t nil t))) (while dirs (if (and (not (string-match "/\\.\\.$" (car dirs))) (not (string-match "/\\.$" (car dirs))) (file-directory-p (car dirs))) (nnml-generate-nov-databases (car dirs))) (setq dirs (cdr dirs)))) (let ((files (sort (mapcar (function (lambda (name) (string-to-int name))) (directory-files dir nil "^[0-9]+$" t)) (function <))) (nov (concat dir "/" nnml-nov-file-name)) (nov-buffer (get-buffer-create "*nov*")) nov-line chars) (if files (setq nnml-group-alist (cons (list (nnmail-replace-chars-in-string (substring (expand-file-name dir) (length (expand-file-name nnml-directory))) ?/ ?.) (cons (car files) (let ((f files)) (while (cdr f) (setq f (cdr f))) (car f)))) nnml-group-alist))) (if files (save-excursion (set-buffer nntp-server-buffer) (if (file-exists-p nov) (delete-file nov)) (save-excursion (set-buffer nov-buffer) (buffer-disable-undo (current-buffer)) (erase-buffer)) (while files (erase-buffer) (insert-file-contents (concat dir "/" (int-to-string (car files)))) (goto-char (point-min)) (narrow-to-region 1 (save-excursion (search-forward "\n\n" nil t) (setq chars (- (point-max) (point))) (point))) (if (not (= 0 chars)) ; none of them empty files... (progn (setq nov-line (nnml-make-nov-line chars)) (save-excursion (set-buffer nov-buffer) (goto-char (point-max)) (insert (int-to-string (car files)) nov-line)))) (widen) (setq files (cdr files))) (save-excursion (set-buffer nov-buffer) (write-region 1 (point-max) (expand-file-name nov) nil 'nomesg) (kill-buffer (current-buffer))))) (nnmail-save-active nnml-group-alist nnml-active-file))) (defun nnml-nov-delete-article (group article) (save-excursion (set-buffer (nnml-open-nov group)) (goto-char (point-min)) (if (re-search-forward (concat "^" (int-to-string article) "\t") nil t) (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) t)) (provide 'nnml) ;;; nnml.el ends here emacs-19.30/lisp/nnspool.el100444 23053 1 40061 6046561753 14436 0ustar larsidaemon;;; nnspool.el --- spool access for GNU Emacs ;; Copyright (C) 1988,89,90,93,94,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Code: (require 'nnheader) (require 'nntp) (require 'timezone) (defvar nnspool-inews-program news-inews-program "Program to post news. This is most commonly `inews' or `injnews'.") (defvar nnspool-inews-switches '("-h") "Switches for nnspool-request-post to pass to `inews' for posting news. If you are using Cnews, you probably should set this variable to nil.") (defvar nnspool-spool-directory news-path "Local news spool directory.") (defvar nnspool-nov-directory (concat nnspool-spool-directory "over.view/") "Local news nov directory.") (defvar nnspool-lib-dir "/usr/lib/news/" "Where the local news library files are stored.") (defvar nnspool-active-file (concat nnspool-lib-dir "active") "Local news active file.") (defvar nnspool-newsgroups-file (concat nnspool-lib-dir "newsgroups") "Local news newsgroups file.") (defvar nnspool-distributions-file (concat nnspool-lib-dir "distributions") "Local news distributions file.") (defvar nnspool-history-file (concat nnspool-lib-dir "history") "Local news history file.") (defvar nnspool-active-times-file (concat nnspool-lib-dir "active.times") "Local news active date file.") (defvar nnspool-large-newsgroup 50 "The number of the articles which indicates a large newsgroup. If the number of the articles is greater than the value, verbose messages will be shown to indicate the current status.") (defvar nnspool-nov-is-evil nil "Non-nil means that nnspool will never return NOV lines instead of headers.") (defconst nnspool-sift-nov-with-sed nil "If non-nil, use sed to get the relevant portion from the overview file. If nil, nnspool will load the entire file into a buffer and process it there.") (defconst nnspool-version "nnspool 2.0" "Version numbers of this version of NNSPOOL.") (defvar nnspool-current-directory nil "Current news group directory.") (defvar nnspool-current-group nil) (defvar nnspool-status-string "") (defvar nnspool-current-server nil) (defvar nnspool-server-alist nil) (defvar nnspool-server-variables (list (list 'nnspool-inews-program nnspool-inews-program) (list 'nnspool-inews-switches nnspool-inews-switches) (list 'nnspool-spool-directory nnspool-spool-directory) (list 'nnspool-nov-directory nnspool-nov-directory) (list 'nnspool-lib-dir nnspool-lib-dir) (list 'nnspool-active-file nnspool-active-file) (list 'nnspool-newsgroups-file nnspool-newsgroups-file) (list 'nnspool-distributions-file nnspool-distributions-file) (list 'nnspool-history-file nnspool-history-file) (list 'nnspool-active-times-file nnspool-active-times-file) (list 'nnspool-large-newsgroup nnspool-large-newsgroup) (list 'nnspool-nov-is-evil nnspool-nov-is-evil) (list 'nnspool-sift-nov-with-sed nnspool-sift-nov-with-sed) '(nnspool-current-directory nil) '(nnspool-current-group nil) '(nnspool-status-string ""))) ;;; Interface functions. (defun nnspool-retrieve-headers (sequence &optional newsgroup server) "Retrieve the headers for the articles in SEQUENCE. Newsgroup must be selected before calling this function." (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let* ((number (length sequence)) (count 0) (do-message (and (numberp nnspool-large-newsgroup) (> number nnspool-large-newsgroup))) file beg article) (if (not (nnspool-possibly-change-directory newsgroup)) () (if (and (numberp (car sequence)) (nnspool-retrieve-headers-with-nov sequence)) 'nov (while sequence (setq article (car sequence)) (if (stringp article) (progn (setq file (nnspool-find-article-by-message-id article)) (setq article 0)) (setq file (concat nnspool-current-directory (int-to-string article)))) (and file (file-exists-p file) (progn (insert (format "221 %d Article retrieved.\n" article)) (setq beg (point)) (nnheader-insert-head file) (goto-char beg) (search-forward "\n\n" nil t) (forward-char -1) (insert ".\n") (delete-region (point) (point-max)))) (setq sequence (cdr sequence)) (and do-message (zerop (% (setq count (1+ count)) 20)) (message "NNSPOOL: Receiving headers... %d%%" (/ (* count 100) number)))) (and do-message (message "NNSPOOL: Receiving headers...done")) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers))))) (defun nnspool-open-server (server &optional defs) (nnheader-init-server-buffer) (if (equal server nnspool-current-server) t (if nnspool-current-server (setq nnspool-server-alist (cons (list nnspool-current-server (nnheader-save-variables nnspool-server-variables)) nnspool-server-alist))) (let ((state (assoc server nnspool-server-alist))) (if state (progn (nnheader-restore-variables (nth 1 state)) (setq nnspool-server-alist (delq state nnspool-server-alist))) (nnheader-set-init-variables nnspool-server-variables defs))) (setq nnspool-current-server server))) (defun nnspool-close-server (&optional server) t) (defun nnspool-server-opened (&optional server) (and (equal server nnspool-current-server) nntp-server-buffer (buffer-name nntp-server-buffer))) (defun nnspool-status-message (&optional server) "Return server status response as string." nnspool-status-string) (defun nnspool-request-article (id &optional newsgroup server buffer) "Select article by message ID (or number)." (nnspool-possibly-change-directory newsgroup) (let ((file (if (stringp id) (nnspool-find-article-by-message-id id) (concat nnspool-current-directory (prin1-to-string id)))) (nntp-server-buffer (or buffer nntp-server-buffer))) (if (and (stringp file) (file-exists-p file) (not (file-directory-p file))) (save-excursion (nnspool-find-file file))))) (defun nnspool-request-body (id &optional newsgroup server) "Select article body by message ID (or number)." (nnspool-possibly-change-directory newsgroup) (if (nnspool-request-article id) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) (if (search-forward "\n\n" nil t) (delete-region (point-min) (point))) t))) (defun nnspool-request-head (id &optional newsgroup server) "Select article head by message ID (or number)." (nnspool-possibly-change-directory newsgroup) (if (nnspool-request-article id) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) (if (search-forward "\n\n" nil t) (delete-region (1- (point)) (point-max))) t))) (defun nnspool-request-group (group &optional server dont-check) "Select news GROUP." (let ((pathname (nnspool-article-pathname (nnspool-replace-chars-in-string group ?. ?/))) dir) (if (not (file-directory-p pathname)) (progn (setq nnspool-status-string "Invalid group name (no such directory)") nil) (setq nnspool-current-directory pathname) (setq nnspool-status-string "") (if (not dont-check) (progn (setq dir (directory-files pathname nil "^[0-9]+$" t)) ;; yes, completely empty spool directories *are* possible ;; Fix by Sudish Joseph (and dir (setq dir (sort (mapcar (function (lambda (name) (string-to-int name))) dir) '<))) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (if dir (insert (format "211 %d %d %d %s\n" (length dir) (car dir) (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) group)) (insert (format "211 0 0 0 %s\n" group)))))) t))) (defun nnspool-close-group (group &optional server) t) (defun nnspool-request-list (&optional server) "List active newsgroups." (save-excursion (nnspool-find-file nnspool-active-file))) (defun nnspool-request-list-newsgroups (&optional server) "List newsgroups (defined in NNTP2)." (save-excursion (nnspool-find-file nnspool-newsgroups-file))) (defun nnspool-request-list-distributions (&optional server) "List distributions (defined in NNTP2)." (save-excursion (nnspool-find-file nnspool-distributions-file))) ;; Suggested by Hallvard B Furuseth . (defun nnspool-request-newgroups (date &optional server) "List groups created after DATE." (if (nnspool-find-file nnspool-active-times-file) (save-excursion ;; Find the last valid line. (goto-char (point-max)) (while (and (not (looking-at "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] ")) (zerop (forward-line -1)))) (let ((seconds (nnspool-seconds-since-epoch date)) groups) ;; Go through lines and add the latest groups to a list. (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ") (progn ;; We insert a .0 to make the list reader ;; interpret the number as a float. It is far ;; too big to be stored in a lisp integer. (goto-char (1- (match-end 0))) (insert ".0") (> (progn (goto-char (match-end 1)) (read (current-buffer))) seconds)) (setq groups (cons (buffer-substring (match-beginning 1) (match-end 1)) groups)) (zerop (forward-line -1)))) (erase-buffer) (while groups (insert (car groups) " 0 0 y\n") (setq groups (cdr groups)))) t) nil)) (defun nnspool-request-post (&optional server) "Post a new news in current buffer." (save-excursion (let* ((process-connection-type nil) ; t bugs out on Solaris (inews-buffer (generate-new-buffer " *nnspool post*")) (proc (apply 'start-process "*nnspool inews*" inews-buffer nnspool-inews-program nnspool-inews-switches))) (set-process-sentinel proc 'nnspool-inews-sentinel) (process-send-region proc (point-min) (point-max)) ;; We slap a condition-case around this, because the process may ;; have exited already... (condition-case nil (process-send-eof proc) (error nil)) t))) (defun nnspool-inews-sentinel (proc status) (save-excursion (set-buffer (process-buffer proc)) (goto-char (point-min)) (if (or (zerop (buffer-size)) (search-forward "spooled" nil t)) (kill-buffer (current-buffer)) ;; Make status message by unfolding lines. (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo) (setq nnspool-status-string (buffer-string)) (message "nnspool: %s" nnspool-status-string) ;(kill-buffer (current-buffer)) ))) (defalias 'nnspool-request-post-buffer 'nntp-request-post-buffer) ;;; Internal functions. (defun nnspool-retrieve-headers-with-nov (articles) (if (or gnus-nov-is-evil nnspool-nov-is-evil) nil (let ((nov (concat (file-name-as-directory nnspool-nov-directory) (nnspool-replace-chars-in-string nnspool-current-group ?. ?/) "/.overview")) article) (if (file-exists-p nov) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (if nnspool-sift-nov-with-sed (nnspool-sift-nov-with-sed articles nov) (insert-file-contents nov) ;; First we find the first wanted line. We issue a number ;; of search-forwards - the first article we are lookign ;; for may be expired, so we have to go on searching until ;; we find one of the articles we want. (while (and articles (setq article (concat (int-to-string (car articles)) "\t")) (not (or (looking-at article) (search-forward (concat "\n" article) nil t)))) (setq articles (cdr articles))) (if (not articles) () (beginning-of-line) (delete-region (point-min) (point)) ;; Then we find the last wanted line. We go to the end ;; of the buffer and search backward much the same way ;; we did to find the first article. ;; !!! Perhaps it would be better just to do a (last articles), ;; and go forward successively over each line and ;; compare to avoid this (reverse), like this: ;; (while (and (>= last (read nntp-server-buffer))) ;; (zerop (forward-line 1)))) (setq articles (reverse articles)) (goto-char (point-max)) (while (and articles (not (search-backward (concat "\n" (int-to-string (car articles)) "\t") nil t))) (setq articles (cdr articles))) (if articles (progn (forward-line 2) (delete-region (point) (point-max))))) (or articles (progn (erase-buffer) nil)))))))) (defun nnspool-sift-nov-with-sed (articles file) (let ((first (car articles)) (last (progn (while (cdr articles) (setq articles (cdr articles))) (car articles)))) (call-process "awk" nil t nil (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}" (1- first) (1+ last)) file))) ;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). (defun nnspool-find-article-by-message-id (id) "Return full pathname of an article identified by message-ID." (save-excursion (let ((buf (get-buffer-create " *nnspool work*"))) (set-buffer buf) (erase-buffer) (call-process "grep" nil t nil id nnspool-history-file) (goto-char (point-min)) (if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ \t\n]*\\)") (concat nnspool-spool-directory (nnspool-replace-chars-in-string (buffer-substring (match-beginning 1) (match-end 1)) ?. ?/)))))) (defun nnspool-find-file (file) "Insert FILE in server buffer safely." (set-buffer nntp-server-buffer) (erase-buffer) (condition-case () (progn (insert-file-contents file) t) (file-error nil))) (defun nnspool-possibly-change-directory (newsgroup) (if newsgroup (let ((pathname (nnspool-article-pathname (nnspool-replace-chars-in-string newsgroup ?. ?/)))) (if (file-directory-p pathname) (progn (setq nnspool-current-directory pathname) (setq nnspool-current-group newsgroup)) (setq nnspool-status-string (format "No such newsgroup: %s" newsgroup)) nil)) t)) (defun nnspool-article-pathname (group) "Make pathname for GROUP." (concat (file-name-as-directory nnspool-spool-directory) group "/")) (defun nnspool-replace-chars-in-string (string from to) "Replace characters in STRING from FROM to TO." (let ((string (substring string 0)) ;Copy string. (len (length string)) (idx 0)) ;; Replace all occurrences of FROM with TO. (while (< idx len) (if (= (aref string idx) from) (aset string idx to)) (setq idx (1+ idx))) string)) (defun nnspool-number-base-10 (num pos) (if (<= pos 0) "" (setcdr num (+ (* (% (car num) 10) 65536) (cdr num))) (apply 'concat (reverse (list (char-to-string (aref "0123456789" (% (cdr num) 10))) (progn (setcdr num (/ (cdr num) 10)) (setcar num (/ (car num) 10)) (nnspool-number-base-10 num (1- pos)))))))) (defun nnspool-seconds-since-epoch (date) (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti))) (timezone-parse-date date))) (ttime (mapcar (lambda (ti) (and ti (string-to-int ti))) (timezone-parse-time (aref (timezone-parse-date date) 3)))) (unix (encode-time (nth 2 ttime) (nth 1 ttime) (nth 0 ttime) (nth 2 tdate) (nth 1 tdate) (nth 0 tdate) (nth 4 tdate)))) (+ (* (car unix) 65536.0) (car (cdr unix))))) (provide 'nnspool) ;;; nnspool.el ends here emacs-19.30/lisp/nntp.el100444 12120 1 126663 6053415430 13426 0ustar rmsdaemon;;; nntp.el --- nntp access for Gnus ;; Copyright (C) 1987,88,89,90,92,93,94,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Code: (require 'rnews) (require 'sendmail) (require 'nnheader) (eval-when-compile (require 'cl)) (eval-and-compile (autoload 'news-setup "rnewspost") (autoload 'news-reply-mode "rnewspost") (autoload 'nnmail-request-post-buffer "nnmail") (autoload 'cancel-timer "timer") (autoload 'telnet "telnet" nil t) (autoload 'telnet-send-input "telnet" nil t) (autoload 'timezone-parse-date "timezone")) (defvar nntp-server-hook nil "*Hooks for the NNTP server. If the kanji code of the NNTP server is different from the local kanji code, the correct kanji code of the buffer associated with the NNTP server must be specified as follows: \(setq nntp-server-hook (function (lambda () ;; Server's Kanji code is EUC (NEmacs hack). (make-local-variable 'kanji-fileio-code) (setq kanji-fileio-code 0)))) If you'd like to change something depending on the server in this hook, use the variable `nntp-address'.") (defvar nntp-server-opened-hook nil "*Hook used for sending commands to the server at startup. The default value is `nntp-send-mode-reader', which makes an innd server spawn an nnrpd server. Another useful function to put in this hook might be `nntp-send-authinfo', which will prompt for a password to allow posting from the server. Note that this is only necessary to do on servers that use strict access control.") (add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader) (defvar nntp-open-server-function 'nntp-open-network-stream "*Function used for connecting to a remote system. It will be called with the address of the remote system. Two pre-made functions are `nntp-open-network-stream', which is the default, and simply connects to some port or other on the remote system (see nntp-port-number). The other is `nntp-open-rlogin', which does an rlogin on the remote system, and then does a telnet to the NNTP server available there (see nntp-rlogin-parameters).") (defvar nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp") "*Parameters to `nntp-open-login'. That function may be used as `nntp-open-server-function'. In that case, this list will be used as the parameter list given to rsh.") (defvar nntp-rlogin-user-name nil "*User name on remote system when using the rlogin connect method.") (defvar nntp-address nil "*The name of the NNTP server.") (defvar nntp-port-number "nntp" "*Port number to connect to.") (defvar nntp-large-newsgroup 50 "*The number of the articles which indicates a large newsgroup. If the number of the articles is greater than the value, verbose messages will be shown to indicate the current status.") (defvar nntp-buggy-select (memq system-type '(fujitsu-uts)) "*t if your select routine is buggy. If the select routine signals error or fall into infinite loop while waiting for the server response, the variable must be set to t. In case of Fujitsu UTS, it is set to T since `accept-process-output' doesn't work properly.") (defvar nntp-maximum-request 400 "*The maximum number of the requests sent to the NNTP server at one time. If Emacs hangs up while retrieving headers, set the variable to a lower value.") (defvar nntp-debug-read 10000 "*Display '...' every 10Kbytes of a message being received if it is non-nil. If it is a number, dots are displayed per the number.") (defvar nntp-nov-is-evil nil "*If non-nil, nntp will never attempt to use XOVER when talking to the server.") (defvar nntp-xover-commands '("XOVER" "XOVERVIEW") "*List of strings that are used as commands to fetch NOV lines from a server. The strings are tried in turn until a positive response is gotten. If none of the commands are successful, nntp will just grab headers one by one.") (defvar nntp-nov-gap 20 "*Maximum allowed gap between two articles. If the gap between two consecutive articles is bigger than this variable, split the XOVER request into two requests.") (defvar nntp-connection-timeout nil "*Number of seconds to wait before an nntp connection times out. If this variable is nil, which is the default, no timers are set.") (defvar nntp-news-default-headers nil "*If non-nil, override `mail-default-headers' when posting news.") (defvar nntp-prepare-server-hook nil "*Hook run before a server is opened. If can be used to set up a server remotely, for instance. Say you have an account at the machine \"other.machine\". This machine has access to an NNTP server that you can't access locally. You could then use this hook to rsh to the remote machine and start a proxy NNTP server there that you can connect to.") (defvar nntp-async-number 5 "*How many articles should be prefetched when in asynchronous mode.") (defconst nntp-version "nntp 4.0" "Version numbers of this version of NNTP.") (defvar nntp-server-buffer nil "Buffer associated with the NNTP server process.") (defvar nntp-server-process nil "The NNTP server process. You'd better not use this variable in NNTP front-end program, but instead use `nntp-server-buffer'.") (defvar nntp-status-string nil "Save the server response message. You'd better not use this variable in NNTP front-end program but instead call function `nntp-status-message' to get status message.") (defvar nntp-opened-connections nil "All (possibly) opened connections.") (defvar nntp-server-xover 'try) (defvar nntp-server-list-active-group 'try) (defvar nntp-current-group "") (defvar nntp-timeout-servers nil) (defvar nntp-async-process nil) (defvar nntp-async-buffer nil) (defvar nntp-async-articles nil) (defvar nntp-async-fetched nil) (defvar nntp-async-group-alist nil) (defvar nntp-current-server nil) (defvar nntp-server-alist nil) (defvar nntp-server-variables (list (list 'nntp-server-hook nntp-server-hook) (list 'nntp-server-opened-hook nntp-server-opened-hook) (list 'nntp-port-number nntp-port-number) (list 'nntp-address nntp-address) (list 'nntp-large-newsgroup nntp-large-newsgroup) (list 'nntp-buggy-select nntp-buggy-select) (list 'nntp-maximum-request nntp-maximum-request) (list 'nntp-debug-read nntp-debug-read) (list 'nntp-nov-is-evil nntp-nov-is-evil) (list 'nntp-xover-commands nntp-xover-commands) (list 'nntp-connection-timeout nntp-connection-timeout) (list 'nntp-news-default-headers nntp-news-default-headers) (list 'nntp-prepare-server-hook nntp-prepare-server-hook) (list 'nntp-async-number nntp-async-number) '(nntp-async-process nil) '(nntp-async-buffer nil) '(nntp-async-articles nil) '(nntp-async-fetched nil) '(nntp-async-group-alist nil) '(nntp-server-process nil) '(nntp-status-string nil) '(nntp-server-xover try) '(nntp-server-list-active-group try) '(nntp-current-group ""))) ;;; Interface functions. (defun nntp-retrieve-headers (sequence &optional newsgroup server) "Retrieve the headers to the articles in SEQUENCE." (nntp-possibly-change-server newsgroup server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (if (and (not gnus-nov-is-evil) (not nntp-nov-is-evil) (nntp-retrieve-headers-with-xover sequence)) 'nov (let ((number (length sequence)) (count 0) (received 0) (last-point (point-min))) ;; Send HEAD command. (while sequence (nntp-send-strings-to-server "HEAD" (if (numberp (car sequence)) (int-to-string (car sequence)) (car sequence))) (setq sequence (cdr sequence) count (1+ count)) ;; Every 400 header requests we have to read stream in order ;; to avoid deadlock. (if (or (null sequence) ;All requests have been sent. (zerop (% count nntp-maximum-request))) (progn (nntp-accept-response) (while (progn (goto-char last-point) ;; Count replies. (while (re-search-forward "^[0-9]" nil t) (setq received (1+ received))) (setq last-point (point)) (< received count)) ;; If number of headers is greater than 100, give ;; informative messages. (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (zerop (% received 20)) (message "NNTP: Receiving headers... %d%%" (/ (* received 100) number))) (nntp-accept-response))))) ;; Wait for text of last command. (goto-char (point-max)) (re-search-backward "^[0-9]" nil t) (if (looking-at "^[23]") (while (progn (goto-char (- (point-max) 3)) (not (looking-at "^\\.\r?\n"))) (nntp-accept-response))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (message "NNTP: Receiving headers...done")) ;; Now all of replies are received. (setq received number) ;; First, fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " ")) ;; Remove all "\r"'s (goto-char (point-min)) (while (search-forward "\r" nil t) (replace-match "")) 'headers)))) (defun nntp-retrieve-groups (groups &optional server) (nntp-possibly-change-server nil server) (save-excursion (set-buffer nntp-server-buffer) (and (eq nntp-server-list-active-group 'try) (nntp-try-list-active (car groups))) (erase-buffer) (let ((count 0) (received 0) (last-point (point-min)) (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP"))) (while groups (nntp-send-strings-to-server command (car groups)) (setq groups (cdr groups)) (setq count (1+ count)) ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. (if (or (null groups) ;All requests have been sent. (zerop (% count nntp-maximum-request))) (progn (nntp-accept-response) (while (progn (goto-char last-point) ;; Count replies. (while (re-search-forward "^[0-9]" nil t) (setq received (1+ received))) (setq last-point (point)) (< received count)) (nntp-accept-response))))) ;; Wait for the reply from the final command. (if nntp-server-list-active-group (progn (goto-char (point-max)) (re-search-backward "^[0-9]" nil t) (if (looking-at "^[23]") (while (progn (goto-char (- (point-max) 3)) (not (looking-at "^\\.\r?\n"))) (nntp-accept-response))))) ;; Now all replies are received. We remove CRs. (goto-char (point-min)) (while (search-forward "\r" nil t) (replace-match "" t t)) (if nntp-server-list-active-group (progn ;; We have read active entries, so we just delete the ;; superfluos gunk. (goto-char (point-min)) (while (re-search-forward "^[.2-5]" nil t) (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) 'active) 'group)))) (defun nntp-open-server (server &optional defs connectionless) "Open the virtual server SERVER. If CONNECTIONLESS is non-nil, don't attempt to connect to any physical servers." (nnheader-init-server-buffer) (if (nntp-server-opened server) t (if (or (stringp (car defs)) (numberp (car defs))) (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs)))) (or (assq 'nntp-address defs) (setq defs (append defs (list (list 'nntp-address server))))) (if (and nntp-current-server (not (equal server nntp-current-server))) (setq nntp-server-alist (cons (list nntp-current-server (nnheader-save-variables nntp-server-variables)) nntp-server-alist))) (let ((state (assoc server nntp-server-alist))) (if state (progn (nnheader-restore-variables (nth 1 state)) (setq nntp-server-alist (delq state nntp-server-alist))) (nnheader-set-init-variables nntp-server-variables defs))) (setq nntp-current-server server) ;; We have now changed to the proper virtual server. We then ;; check that the physical server is opened. (if (or (nntp-server-opened server) connectionless) () (if (member nntp-address nntp-timeout-servers) nil ;; We open a connection to the physical nntp server. (run-hooks 'nntp-prepare-server-hook) (nntp-open-server-semi-internal nntp-address nntp-port-number))))) (defun nntp-close-server (&optional server) "Close connection to SERVER." (nntp-possibly-change-server nil server t) (unwind-protect (progn ;; Un-set default sentinel function before closing connection. (and nntp-server-process (eq 'nntp-default-sentinel (process-sentinel nntp-server-process)) (set-process-sentinel nntp-server-process nil)) ;; We cannot send QUIT command unless the process is running. (if (nntp-server-opened) (nntp-send-command nil "QUIT"))) (nntp-close-server-internal server) (setq nntp-timeout-servers (delete server nntp-timeout-servers)))) (defalias 'nntp-request-quit (symbol-function 'nntp-close-server)) (defun nntp-request-close () "Close all server connections." (let (proc) (while nntp-opened-connections (setq proc (pop nntp-opened-connections)) (and proc (delete-process proc))) (and nntp-async-buffer (get-buffer nntp-async-buffer) (kill-buffer nntp-async-buffer)) (while nntp-server-alist (and (setq proc (nth 1 (assq 'nntp-async-buffer (car nntp-server-alist)))) (buffer-name proc) (kill-buffer proc)) (setq nntp-server-alist (cdr nntp-server-alist))) (setq nntp-current-server nil nntp-timeout-servers nil nntp-async-group-alist nil))) (defun nntp-server-opened (&optional server) "Say whether a connection to SERVER has been opened." (and (equal server nntp-current-server) nntp-server-buffer (buffer-name nntp-server-buffer) nntp-server-process (memq (process-status nntp-server-process) '(open run)))) (defun nntp-status-message (&optional server) "Return server status as a string." (if (and nntp-status-string ;; NNN MESSAGE (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$" nntp-status-string)) (substring nntp-status-string (match-beginning 1) (match-end 1)) ;; Empty message if nothing. (or nntp-status-string ""))) (defun nntp-request-article (id &optional newsgroup server buffer) "Request article ID (message-id or number)." (nntp-possibly-change-server newsgroup server) (let (found) ;; First we see whether we can get the article from the async buffer. (if (and (numberp id) nntp-async-articles (memq id nntp-async-fetched)) (save-excursion (set-buffer nntp-async-buffer) (let ((opoint (point)) (art (if (numberp id) (int-to-string id) id)) beg end) (if (and (or (re-search-forward (concat "^2.. +" art) nil t) (progn (goto-char (point-min)) (re-search-forward (concat "^2.. +" art) opoint t))) (progn (beginning-of-line) (setq beg (point) end (re-search-forward "^\\.\r?\n" nil t)))) (progn (setq found t) (save-excursion (set-buffer (or buffer nntp-server-buffer)) (erase-buffer) (insert-buffer-substring nntp-async-buffer beg end) (let ((nntp-server-buffer (current-buffer))) (nntp-decode-text))) (delete-region beg end) (and nntp-async-articles (nntp-async-fetch-articles id))))))) (if found t ;; The article was not in the async buffer, so we fetch it now. (unwind-protect (progn (if buffer (set-process-buffer nntp-server-process buffer)) (let ((nntp-server-buffer (or buffer nntp-server-buffer)) (art (or (and (numberp id) (int-to-string id)) id))) ;; If NEmacs, end of message may look like: "\256\215" (".^M") (prog1 (nntp-send-command "^\\.\r?\n" "ARTICLE" art) (nntp-decode-text) (and nntp-async-articles (nntp-async-fetch-articles id))))) (if buffer (set-process-buffer nntp-server-process nntp-server-buffer)))))) (defun nntp-request-body (id &optional newsgroup server) "Request body of article ID (message-id or number)." (nntp-possibly-change-server newsgroup server) (prog1 ;; If NEmacs, end of message may look like: "\256\215" (".^M") (nntp-send-command "^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id)) (nntp-decode-text))) (defun nntp-request-head (id &optional newsgroup server) "Request head of article ID (message-id or number)." (nntp-possibly-change-server newsgroup server) (prog1 (nntp-send-command "^\\.\r?\n" "HEAD" (or (and (numberp id) (int-to-string id)) id)) (nntp-decode-text))) (defun nntp-request-stat (id &optional newsgroup server) "Request STAT of article ID (message-id or number)." (nntp-possibly-change-server newsgroup server) (nntp-send-command "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id))) (defun nntp-request-group (group &optional server dont-check) "Select GROUP." (nntp-send-command "^.*\r?\n" "GROUP" group) (setq nntp-current-group group) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) (looking-at "[23]"))) (defun nntp-request-asynchronous (group &optional server articles) (and nntp-async-articles (nntp-async-request-group group)) (and nntp-async-number (if (not (or (nntp-async-server-opened) (nntp-async-open-server))) (progn (message "Can't open second connection to %s" nntp-address) (ding) (setq nntp-async-articles nil) (sit-for 2)) (setq nntp-async-articles articles) (setq nntp-async-fetched nil) (save-excursion (set-buffer nntp-async-buffer) (erase-buffer)) (nntp-async-send-strings "GROUP" group) t))) (defun nntp-list-active-group (group &optional server) (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group)) (defun nntp-request-group-description (group &optional server) "Get description of GROUP." (nntp-possibly-change-server nil server) (prog1 (nntp-send-command "^.*\r?\n" "XGTITLE" group) (nntp-decode-text))) (defun nntp-close-group (group &optional server) (setq nntp-current-group nil) t) (defun nntp-request-list (&optional server) "List active groups." (nntp-possibly-change-server nil server) (prog1 (nntp-send-command "^\\.\r?\n" "LIST") (nntp-decode-text))) (defun nntp-request-list-newsgroups (&optional server) "List groups." (nntp-possibly-change-server nil server) (prog1 (nntp-send-command "^\\.\r?\n" "LIST NEWSGROUPS") (nntp-decode-text))) (defun nntp-request-newgroups (date &optional server) "List new groups." (nntp-possibly-change-server nil server) (let* ((date (timezone-parse-date date)) (time-string (format "%s%02d%02d %s%s%s" (substring (aref date 0) 2) (string-to-int (aref date 1)) (string-to-int (aref date 2)) (substring (aref date 3) 0 2) (substring (aref date 3) 3 5) (substring (aref date 3) 6 8)))) (prog1 (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string) (nntp-decode-text)))) (defun nntp-request-list-distributions (&optional server) "List distributions." (nntp-possibly-change-server nil server) (prog1 (nntp-send-command "^\\.\r?\n" "LIST DISTRIBUTIONS") (nntp-decode-text))) (defun nntp-request-last (&optional newsgroup server) "Decrease the current article pointer." (nntp-possibly-change-server newsgroup server) (nntp-send-command "^[23].*\r?\n" "LAST")) (defun nntp-request-next (&optional newsgroup server) "Advance the current article pointer." (nntp-possibly-change-server newsgroup server) (nntp-send-command "^[23].*\r?\n" "NEXT")) (defun nntp-request-post (&optional server) "Post the current buffer." (nntp-possibly-change-server nil server) (if (nntp-send-command "^[23].*\r?\n" "POST") (progn (nntp-encode-text) (nntp-send-region-to-server (point-min) (point-max)) ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not ;; appended to end of the status message. (nntp-wait-for-response "^[23].*\n")))) (defun nntp-request-post-buffer (post group subject header article-buffer info follow-to respect-poster) "Request a buffer suitable for composing an article. If POST, this is an original article; otherwise it's a followup. GROUP is the group to be posted to, the article should have subject SUBJECT. HEADER is a Gnus header vector. ARTICLE-BUFFER contains the article being followed up. INFO is a Gnus info list. If FOLLOW-TO, post to this group instead. If RESPECT-POSTER, heed the special \"poster\" value of the Followup-to header." (if (assq 'to-address (nth 5 info)) (nnmail-request-post-buffer post group subject header article-buffer info follow-to respect-poster) (let ((mail-default-headers (or nntp-news-default-headers mail-default-headers)) from date to followup-to newsgroups message-of references distribution message-id) (save-excursion (set-buffer (get-buffer-create "*post-news*")) (news-reply-mode) (if (and (buffer-modified-p) (> (buffer-size) 0) (not (y-or-n-p "Unsent article being composed; erase it? "))) () (erase-buffer) (if post (news-setup nil subject nil group nil) (save-excursion (set-buffer article-buffer) (goto-char (point-min)) (narrow-to-region (point-min) (progn (search-forward "\n\n") (point))) (setq from (mail-header-from header)) (setq date (mail-header-date header)) (and from (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) (setq message-of (concat (if stop-pos (substring from 0 stop-pos) from) "'s message of " date)))) (setq subject (or subject (mail-header-subject header))) (or (string-match "^[Rr][Ee]:" subject) (setq subject (concat "Re: " subject))) (setq followup-to (mail-fetch-field "followup-to")) (if (or (null respect-poster) ;Ignore followup-to: field. (string-equal "" followup-to) ;Bogus header. (string-equal "poster" followup-to);Poster (and (eq respect-poster 'ask) followup-to (not (y-or-n-p (concat "Followup to " followup-to "? "))))) (setq followup-to nil)) (setq newsgroups (or follow-to followup-to (mail-fetch-field "newsgroups"))) (setq references (mail-header-references header)) (setq distribution (mail-fetch-field "distribution")) ;; Remove bogus distribution. (and (stringp distribution) (string-match "world" distribution) (setq distribution nil)) (setq message-id (mail-header-id header)) (widen)) (setq news-reply-yank-from from) (setq news-reply-yank-message-id message-id) (news-setup to subject message-of (if (stringp newsgroups) newsgroups "") article-buffer) (if (and newsgroups (listp newsgroups)) (progn (goto-char (point-min)) (while newsgroups (insert (car (car newsgroups)) ": " (cdr (car newsgroups)) "\n") (setq newsgroups (cdr newsgroups))))) (nnheader-insert-references references message-id) (if distribution (progn (mail-position-on-field "Distribution") (insert distribution))))) (current-buffer))))) ;;; Internal functions. (defun nntp-send-mode-reader () "Send the MODE READER command to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will make innd servers spawn an nnrpd process to allow actual article reading." (nntp-send-command "^.*\r?\n" "MODE READER")) (defun nntp-send-authinfo () "Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" (read-string "NNTP password: "))) (defun nntp-send-authinfo-from-file () "Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." (and (file-exists-p "~/.nntp-authinfo") (save-excursion (set-buffer (get-buffer-create " *tull*")) (insert-file-contents "~/.nntp-authinfo") (goto-char (point-min)) (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" (buffer-substring (point) (progn (end-of-line) (point)))) (kill-buffer (current-buffer))))) (defun nntp-default-sentinel (proc status) "Default sentinel function for NNTP server process." (let ((servers nntp-server-alist) server) ;; Go through the alist of server names and find the name of the ;; server that the process that sent the signal is connected to. ;; If you get my drift. (if (equal proc nntp-server-process) (setq server nntp-address) (while (and servers (not (equal proc (nth 1 (assq 'nntp-server-process (car servers)))))) (setq servers (cdr servers))) (setq server (car (car servers)))) (and server (progn (message "nntp: Connection closed to server %s" server) (ding))))) (defun nntp-kill-connection (server) (let ((proc (nth 1 (assq 'nntp-server-process (assoc server nntp-server-alist))))) (and proc (delete-process (process-name proc))) (nntp-close-server server) (setq nntp-timeout-servers (cons server nntp-timeout-servers)) (setq nntp-status-string (message "Connection timed out to server %s." server)) (ding) (sit-for 1))) ;; Encoding and decoding of NNTP text. (defun nntp-decode-text () "Decode text transmitted by NNTP. 0. Delete status line. 1. Delete `^M' at end of line. 2. Delete `.' at end of buffer (end of text mark). 3. Delete `.' at beginning of line." (save-excursion (set-buffer nntp-server-buffer) ;; Insert newline at end of buffer. (goto-char (point-max)) (or (bolp) (insert "\n")) ;; Delete status line. (goto-char (point-min)) (delete-region (point) (progn (forward-line 1) (point))) ;; Delete `^M' at the end of lines. (while (not (eobp)) (end-of-line) (and (= (preceding-char) ?\r) (delete-char -1)) (forward-line 1)) ;; Delete `.' at end of the buffer (end of text mark). (goto-char (point-max)) (forward-line -1) (if (looking-at "^\\.\n") (delete-region (point) (progn (forward-line 1) (point)))) ;; Replace `..' at beginning of line with `.'. (goto-char (point-min)) ;; (replace-regexp "^\\.\\." ".") (while (search-forward "\n.." nil t) (delete-char -1)))) (defun nntp-encode-text () "Encode text in current buffer for NNTP transmission. 1. Insert `.' at beginning of line. 2. Insert `.' at end of buffer (end of text mark)." (save-excursion ;; Insert newline at end of buffer. (goto-char (point-max)) (or (bolp) (insert "\n")) ;; Replace `.' at beginning of line with `..'. (goto-char (point-min)) ;; (replace-regexp "^\\." "..") (while (search-forward "\n." nil t) (insert ".")) ;; Insert `.' at end of buffer (end of text mark). (goto-char (point-max)) (insert ".\r\n"))) ;;; ;;; Synchronous Communication with NNTP Server. ;;; (defun nntp-send-command (response cmd &rest args) "Wait for server RESPONSE after sending CMD and optional ARGS to server." (save-excursion ;; Clear communication buffer. (set-buffer nntp-server-buffer) (erase-buffer) (apply 'nntp-send-strings-to-server cmd args) (if response (nntp-wait-for-response response) t))) (defun nntp-wait-for-response (regexp &optional slow) "Wait for server response which matches REGEXP." (save-excursion (let ((status t) (wait t) (dotnum 0) ;Number of "." being displayed. (dotsize ;How often "." displayed. (if (numberp nntp-debug-read) nntp-debug-read 10000))) (set-buffer nntp-server-buffer) ;; Wait for status response (RFC977). ;; 1xx - Informative message. ;; 2xx - Command ok. ;; 3xx - Command ok so far, send the rest of it. ;; 4xx - Command was correct, but couldn't be performed for some ;; reason. ;; 5xx - Command unimplemented, or incorrect, or a serious ;; program error occurred. (nntp-accept-response) (while wait (goto-char (point-min)) (if slow (progn (cond ((re-search-forward "^[23][0-9][0-9]" nil t) (setq wait nil)) ((re-search-forward "^[45][0-9][0-9]" nil t) (setq status nil) (setq wait nil)) (t (nntp-accept-response))) (if (not wait) (delete-region (point-min) (progn (beginning-of-line) (point))))) (cond ((looking-at "[23]") (setq wait nil)) ((looking-at "[45]") (setq status nil) (setq wait nil)) (t (nntp-accept-response))))) ;; Save status message. (end-of-line) (setq nntp-status-string (buffer-substring (point-min) (point))) (if status (progn (setq wait t) (while wait (goto-char (point-max)) (forward-line -1) ;(beginning-of-line) ;;(message (buffer-substring ;; (point) ;; (save-excursion (end-of-line) (point)))) (if (looking-at regexp) (setq wait nil) (if nntp-debug-read (let ((newnum (/ (buffer-size) dotsize))) (if (not (= dotnum newnum)) (progn (setq dotnum newnum) (message "NNTP: Reading %s" (make-string dotnum ?.)))))) (nntp-accept-response))) ;; Remove "...". (if (and nntp-debug-read (> dotnum 0)) (message "")) ;; Successfully received server response. t))))) ;;; ;;; Low-Level Interface to NNTP Server. ;;; (defun nntp-retrieve-headers-with-xover (sequence) (erase-buffer) (cond ;; This server does not talk NOV. ((not nntp-server-xover) nil) ;; We don't care about gaps. ((not nntp-nov-gap) (nntp-send-xover-command (car sequence) (nntp-last-element sequence) 'wait) (goto-char (point-min)) (if (looking-at "[1-5][0-9][0-9] ") (delete-region (point) (progn (forward-line 1) (point)))) (while (search-forward "\r" nil t) (replace-match "" t t)) (goto-char (point-max)) (forward-line -1) (if (looking-at "\\.") (delete-region (point) (progn (forward-line 1) (point))))) ;; We do it the hard way. For each gap, an XOVER command is sent ;; to the server. We do not wait for a reply from the server, we ;; just send them off as fast as we can. That means that we have ;; to count the number of responses we get back to find out when we ;; have gotten all we asked for. ((numberp nntp-nov-gap) (let ((count 0) (received 0) (last-point (point-min)) (buf (current-buffer)) first) ;; We have to check `nntp-server-xover'. If it gets set to nil, ;; that means that the server does not understand XOVER, but we ;; won't know that until we try. (while (and nntp-server-xover sequence) (setq first (car sequence)) ;; Search forward until we find a gap, or until we run out of ;; articles. (while (and (cdr sequence) (< (- (nth 1 sequence) (car sequence)) nntp-nov-gap)) (setq sequence (cdr sequence))) (if (not (nntp-send-xover-command first (car sequence))) () (setq sequence (cdr sequence) count (1+ count)) ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. (if (or (null sequence) ;All requests have been sent. (zerop (% count nntp-maximum-request))) (progn (accept-process-output) ;; On some Emacs versions the preceding function has ;; a tendency to change the buffer. Perhaps. It's ;; quite difficult to reporduce, because it only ;; seems to happen once in a blue moon. (set-buffer buf) (while (progn (goto-char last-point) ;; Count replies. (while (re-search-forward "^[0-9][0-9][0-9] " nil t) (setq received (1+ received))) (setq last-point (point)) (< received count)) (accept-process-output) (set-buffer buf)))))) (if (not nntp-server-xover) () ;; Wait for the reply from the final command. (goto-char (point-max)) (re-search-backward "^[0-9][0-9][0-9] " nil t) (if (looking-at "^[23]") (while (progn (goto-char (point-max)) (forward-line -1) (not (looking-at "^\\.\r?\n"))) (nntp-accept-response))) ;; We remove any "." lines and status lines. (goto-char (point-min)) (while (search-forward "\r" nil t) (delete-char -1)) (goto-char (point-min)) (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] "))))) nntp-server-xover) (defun nntp-send-xover-command (beg end &optional wait-for-reply) (let ((range (format "%d-%d" beg end))) (if (stringp nntp-server-xover) ;; If `nntp-server-xover' is a string, then we just send this ;; command. (if wait-for-reply (nntp-send-command "^\\.\r?\n" nntp-server-xover range) ;; We do not wait for the reply. (progn (nntp-send-strings-to-server nntp-server-xover range) t)) (let ((commands nntp-xover-commands)) ;; `nntp-xover-commands' is a list of possible XOVER commands. ;; We try them all until we get at positive response. (while (and commands (eq nntp-server-xover 'try)) (nntp-send-command "^\\.\r?\n" (car commands) range) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) (and (looking-at "[23]") ; No error message. ;; We also have to look at the lines. Some buggy ;; servers give back simple lines with just the ;; article number. How... helpful. (progn (forward-line 1) (looking-at "[0-9]+\t...")) ; More text after number. (setq nntp-server-xover (car commands)))) (setq commands (cdr commands))) ;; If none of the commands worked, we disable XOVER. (if (eq nntp-server-xover 'try) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (setq nntp-server-xover nil))) nntp-server-xover)))) (defun nntp-send-strings-to-server (&rest strings) "Send list of STRINGS to news server as command and its arguments." (let ((cmd (concat (mapconcat 'identity strings " ") "\r\n"))) ;; We open the nntp server if it is down. (or (nntp-server-opened nntp-current-server) (nntp-open-server nntp-current-server) (error (nntp-status-message))) ;; Send the strings. (process-send-string nntp-server-process cmd))) (defun nntp-send-region-to-server (begin end) "Send current buffer region (from BEGIN to END) to news server." (save-excursion ;; We have to work in the buffer associated with NNTP server ;; process because of NEmacs hack. (copy-to-buffer nntp-server-buffer begin end) (set-buffer nntp-server-buffer) (setq begin (point-min)) (setq end (point-max)) ;; `process-send-region' does not work if text to be sent is very ;; large. I don't know maximum size of text sent correctly. (let ((last nil) (size 100)) ;Size of text sent at once. (save-restriction (narrow-to-region begin end) (goto-char begin) (while (not (eobp)) ;;(setq last (min end (+ (point) size))) ;; NEmacs gets confused if character at `last' is Kanji. (setq last (save-excursion (goto-char (min end (+ (point) size))) (or (eobp) (forward-char 1)) ;Adjust point (point))) (process-send-region nntp-server-process (point) last) ;; I don't know whether the next codes solve the known ;; problem of communication error of GNU Emacs. (accept-process-output) ;;(sit-for 0) (goto-char last)))) ;; We cannot erase buffer, because reply may be received. (delete-region begin end))) (defun nntp-open-server-semi-internal (server &optional service) "Open SERVER. If SERVER is nil, use value of environment variable `NNTPSERVER'. If SERVICE, this this as the port number." (let ((server (or server (getenv "NNTPSERVER"))) (status nil) (timer (and nntp-connection-timeout (cond ((fboundp 'run-at-time) (run-at-time nntp-connection-timeout nil 'nntp-kill-connection server)) ((fboundp 'start-itimer) ;; Not sure if this will work or not, only one way to ;; find out (eval '(start-itimer "nntp-timeout" (lambda () (nntp-kill-connection server)) nntp-connection-timeout nil))))))) (save-excursion (set-buffer nntp-server-buffer) (setq nntp-status-string "") (message "nntp: Connecting to server on %s..." server) (cond ((and server (nntp-open-server-internal server service)) (setq nntp-address server) (setq status (condition-case nil (nntp-wait-for-response "^[23].*\r?\n" 'slow) (error nil) (quit nil))) (or status (nntp-close-server-internal server)) (and nntp-server-process (progn (set-process-sentinel nntp-server-process 'nntp-default-sentinel) ;; You can send commands at startup like AUTHINFO here. ;; Added by Hallvard B Furuseth (run-hooks 'nntp-server-opened-hook)))) ((null server) (setq nntp-status-string "NNTP server is not specified.")) (t ; We couldn't open the server. (setq nntp-status-string (buffer-substring (point-min) (point-max))) (setq nntp-timeout-servers (cons server nntp-timeout-servers)))) (and timer (cancel-timer timer)) (message "") (or status (setq nntp-current-server nil nntp-async-number nil)) status))) (defun nntp-open-server-internal (server &optional service) "Open connection to news server on SERVER by SERVICE (default is nntp)." (let (proc) (save-excursion ;; Use TCP/IP stream emulation package if needed. (or (fboundp 'open-network-stream) (require 'tcp)) ;; Initialize communication buffer. (nnheader-init-server-buffer) (set-buffer nntp-server-buffer) (if (setq proc (condition-case nil (funcall nntp-open-server-function server) (error nil))) (progn (setq nntp-server-process proc) ;; Suggested by Hallvard B Furuseth . (process-kill-without-query proc) (setq nntp-address server) ;; It is possible to change kanji-fileio-code in this hook. (run-hooks 'nntp-server-hook) (push proc nntp-opened-connections) nntp-server-process))))) (defun nntp-open-network-stream (server) (open-network-stream "nntpd" nntp-server-buffer server nntp-port-number)) (defun nntp-open-rlogin (server) (let ((proc (start-process "nntpd" nntp-server-buffer "rsh" server))) (process-send-string proc (mapconcat 'identity nntp-rlogin-parameters " ")) (process-send-string proc "\n"))) (defun nntp-telnet-to-machine () (let (b) (telnet "localhost") (goto-char (point-min)) (while (not (re-search-forward "^login: *" nil t)) (sit-for 1) (goto-char (point-min))) (goto-char (point-max)) (insert "larsi") (telnet-send-input) (setq b (point)) (while (not (re-search-forward ">" nil t)) (sit-for 1) (goto-char b)) (goto-char (point-max)) (insert "ls") (telnet-send-input))) (defun nntp-close-server-internal (&optional server) "Close connection to news server." (nntp-possibly-change-server nil server) (if nntp-server-process (delete-process nntp-server-process)) (setq nntp-server-process nil) (setq nntp-address "")) (defun nntp-accept-response () "Read response of server. It is well-known that the communication speed will be much improved by defining this function as macro." ;; To deal with server process exiting before ;; accept-process-output is called. ;; Suggested by Jason Venner . ;; This is a copy of `nntp-default-sentinel'. (let ((buf (current-buffer))) (prog1 (if (or (not nntp-server-process) (not (memq (process-status nntp-server-process) '(open run)))) (error "nntp: Process connection closed; %s" (nntp-status-message)) (if nntp-buggy-select (progn ;; We cannot use `accept-process-output'. ;; Fujitsu UTS requires messages during sleep-for. ;; I don't know why. (message "NNTP: Reading...") (sleep-for 1) (message "")) (condition-case errorcode (accept-process-output nntp-server-process) (error (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode)) ;; Ignore select error. nil) (t (signal (car errorcode) (cdr errorcode)))))))) (set-buffer buf)))) (defun nntp-last-element (list) "Return last element of LIST." (while (cdr list) (setq list (cdr list))) (car list)) (defun nntp-possibly-change-server (newsgroup server &optional connectionless) "Check whether the virtual server needs changing." (if (and server (not (nntp-server-opened server))) ;; This virtual server isn't open, so we (re)open it here. (nntp-open-server server nil t)) (if (and newsgroup (not (equal newsgroup nntp-current-group))) ;; Set the proper current group. (nntp-request-group newsgroup server))) (defun nntp-try-list-active (group) (nntp-list-active-group group) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) (cond ((looking-at "5[0-9]+") (setq nntp-server-list-active-group nil)) (t (setq nntp-server-list-active-group t))))) (defun nntp-async-server-opened () (and nntp-async-process (memq (process-status nntp-async-process) '(open run)))) (defun nntp-async-open-server () (save-excursion (set-buffer (generate-new-buffer " *async-nntp*")) (setq nntp-async-buffer (current-buffer)) (buffer-disable-undo (current-buffer))) (let ((nntp-server-process nil) (nntp-server-buffer nntp-async-buffer)) (nntp-open-server-semi-internal nntp-address nntp-port-number) (if (not (setq nntp-async-process nntp-server-process)) (progn (setq nntp-async-number nil)) (set-process-buffer nntp-async-process nntp-async-buffer)))) (defun nntp-async-fetch-articles (article) (if (stringp article) () (let ((articles (cdr (memq (assq article nntp-async-articles) nntp-async-articles))) (max (cond ((numberp nntp-async-number) nntp-async-number) ((eq nntp-async-number t) (length nntp-async-articles)) (t 0))) nart) (while (and (>= (setq max (1- max)) 0) articles) (or (memq (setq nart (car (car articles))) nntp-async-fetched) (progn (nntp-async-send-strings "ARTICLE " (int-to-string nart)) (setq nntp-async-fetched (cons nart nntp-async-fetched)))) (setq articles (cdr articles)))))) (defun nntp-async-send-strings (&rest strings) (let ((cmd (concat (mapconcat 'identity strings " ") "\r\n"))) (or (nntp-async-server-opened) (nntp-async-open-server) (error (nntp-status-message))) (process-send-string nntp-async-process cmd))) (defun nntp-async-request-group (group) (if (equal group nntp-current-group) () (let ((asyncs (assoc group nntp-async-group-alist))) ;; A new group has been selected, so we push the current state ;; of async articles on an alist, and pull the old state off. (setq nntp-async-group-alist (cons (list nntp-current-group nntp-async-articles nntp-async-fetched nntp-async-process) (delq asyncs nntp-async-group-alist))) (and asyncs (progn (setq nntp-async-articles (nth 1 asyncs)) (setq nntp-async-fetched (nth 2 asyncs)) (setq nntp-async-process (nth 3 asyncs))))))) (provide 'nntp) ;;; nntp.el ends here emacs-19.30/lisp/nnvirtual.el100444 23053 1 40367 6046562002 14765 0ustar larsidaemon;;; nnvirtual.el --- virtual newsgroups access for Gnus ;; Copyright (C) 1994,95 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; The other access methods (nntp, nnspool, etc) are general news ;; access methods. This module relies on Gnus and can not be used ;; separately. ;;; Code: (require 'nntp) (require 'nnheader) (require 'gnus) (defconst nnvirtual-version "nnvirtual 1.0" "Version number of this version of nnvirtual.") (defvar nnvirtual-group-alist nil) (defvar nnvirtual-current-group nil) (defvar nnvirtual-current-groups nil) (defvar nnvirtual-current-mapping nil) (defvar nnvirtual-do-not-open nil) (defvar nnvirtual-status-string "") ;;; Interface functions. (defun nnvirtual-retrieve-headers (sequence &optional newsgroup server) "Retrieve the headers for the articles in SEQUENCE." (nnvirtual-possibly-change-newsgroups newsgroup server t) (save-excursion (set-buffer (get-buffer-create "*virtual headers*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (if (stringp (car sequence)) 'headers (let ((map nnvirtual-current-mapping) (offset 0) articles beg group active top article result prefix fetched-articles group-method) (while sequence (while (< (car (car map)) (car sequence)) (setq offset (car (car map))) (setq map (cdr map))) (setq top (car (car map))) (setq group (nth 1 (car map))) (setq prefix (gnus-group-real-prefix group)) (setq active (nth 2 (car map))) (setq articles nil) (while (and sequence (<= (car sequence) top)) (setq articles (cons (- (+ active (car sequence)) offset) articles)) (setq sequence (cdr sequence))) (setq articles (nreverse articles)) (if (and articles (setq result (progn (setq group-method (gnus-find-method-for-group group)) (and (or (gnus-server-opened group-method) (gnus-open-server group-method)) (gnus-request-group group t) (gnus-retrieve-headers articles group))))) (save-excursion (set-buffer nntp-server-buffer) ;; If we got HEAD headers, we convert them into NOV ;; headers. This is slow, inefficient and, come to think ;; of it, downright evil. So sue me. I couldn't be ;; bothered to write a header parse routine that could ;; parse a mixed HEAD/NOV buffer. (and (eq result 'headers) (nnvirtual-convert-headers)) (goto-char (point-min)) (setq fetched-articles nil) (while (not (eobp)) (setq beg (point) article (read nntp-server-buffer) fetched-articles (cons article fetched-articles)) (delete-region beg (point)) (insert (int-to-string (+ (- article active) offset))) (beginning-of-line) (looking-at "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") (goto-char (match-end 0)) (or (search-forward "\t" (save-excursion (end-of-line) (point)) t) (end-of-line)) (while (= (char-after (1- (point))) ? ) (forward-char -1) (delete-char 1)) (if (eolp) (progn (end-of-line) (or (= (char-after (1- (point))) ?\t) (insert ?\t)) (insert (format "Xref: %s %s:%d\t" (system-name) group article))) (if (not (string= "" prefix)) (while (re-search-forward "[^ ]+:[0-9]+" (save-excursion (end-of-line) (point)) t) (save-excursion (goto-char (match-beginning 0)) (insert prefix)))) (end-of-line) (or (= (char-after (1- (point))) ?\t) (insert ?\t))) (forward-line 1)))) (goto-char (point-max)) (insert-buffer-substring nntp-server-buffer) ;; We have now massaged and inserted the headers from one ;; group. In case some of the articles have expired or been ;; cancelled, we have to mark them as read in the component ;; group. (let ((unfetched (gnus-sorted-complement articles (nreverse fetched-articles)))) (and unfetched (gnus-group-make-articles-read group unfetched nil)))) ;; The headers are ready for reading, so they are inserted into ;; the nntp-server-buffer, which is where Gnus expects to find ;; them. (prog1 (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (insert-buffer-substring "*virtual headers*") 'nov) (kill-buffer (current-buffer))))))) (defun nnvirtual-open-server (newsgroups &optional something) "Open a virtual newsgroup that contains NEWSGROUPS." (nnheader-init-server-buffer)) (defun nnvirtual-close-server (&rest dum) "Close news server." t) (defun nnvirtual-request-close () (setq nnvirtual-current-group nil nnvirtual-current-groups nil nnvirtual-current-mapping nil nnvirtual-group-alist nil) t) (defun nnvirtual-server-opened (&optional server) "Return server process status, T or NIL. If the stream is opened, return T, otherwise return NIL." (and nntp-server-buffer (get-buffer nntp-server-buffer))) (defun nnvirtual-status-message (&optional server) "Return server status response as string." nnvirtual-status-string) (defun nnvirtual-request-article (article &optional newsgroup server buffer) "Select article by message number." (nnvirtual-possibly-change-newsgroups newsgroup server t) (and (numberp article) (let ((map nnvirtual-current-mapping) (offset 0) group-method) (while (< (car (car map)) article) (setq offset (car (car map))) (setq map (cdr map))) (setq group-method (gnus-find-method-for-group (nth 1 (car map)))) (or (gnus-server-opened group-method) (gnus-open-server group-method)) (gnus-request-group (nth 1 (car map)) t) (gnus-request-article (- (+ (nth 2 (car map)) article) offset) (nth 1 (car map)) buffer)))) (defun nnvirtual-request-group (group &optional server dont-check) "Make GROUP the current newsgroup." (nnvirtual-possibly-change-newsgroups group server dont-check) (let ((map nnvirtual-current-mapping)) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (if map (progn (while (cdr map) (setq map (cdr map))) (insert (format "211 %d 1 %d %s\n" (car (car map)) (car (car map)) group)) t) (setq nnvirtual-status-string "No component groups") (setq nnvirtual-current-group nil) nil)))) (defun nnvirtual-close-group (group &optional server) (if (not nnvirtual-current-group) () (nnvirtual-possibly-change-newsgroups group server t) (nnvirtual-update-marked) (setq nnvirtual-current-group nil nnvirtual-current-groups nil nnvirtual-current-mapping nil) (setq nnvirtual-group-alist (delq (assoc group nnvirtual-group-alist) nnvirtual-group-alist)))) (defun nnvirtual-request-list (&optional server) (setq nnvirtual-status-string "nnvirtual: LIST is not implemented.") nil) (defun nnvirtual-request-newgroups (date &optional server) "List new groups." (setq nnvirtual-status-string "NEWGROUPS is not supported.") nil) (defun nnvirtual-request-list-newsgroups (&optional server) (setq nnvirtual-status-string "nnvirtual: LIST NEWSGROUPS is not implemented.") nil) (defalias 'nnvirtual-request-post 'nntp-request-post) (defun nnvirtual-request-post-buffer (post group subject header article-buffer info follow-to respect-poster) (nntp-request-post-buffer post "" subject header article-buffer info follow-to respect-poster)) ;;; Internal functions. ;; Convert HEAD headers into NOV headers. (defun nnvirtual-convert-headers () (save-excursion (set-buffer nntp-server-buffer) (let* ((gnus-newsgroup-dependencies (make-vector 100 0)) (headers (gnus-get-newsgroup-headers)) header) (erase-buffer) (while headers (setq header (car headers) headers (cdr headers)) (insert (int-to-string (mail-header-number header)) "\t" (or (mail-header-subject header) "") "\t" (or (mail-header-from header) "") "\t" (or (mail-header-date header) "") "\t" (or (mail-header-id header) "") "\t" (or (mail-header-references header) "") "\t" (int-to-string (or (mail-header-chars header) 0)) "\t" (int-to-string (or (mail-header-lines header) 0)) "\t" (if (mail-header-xref header) (concat "Xref: " (mail-header-xref header) "\t") "") "\n"))))) (defun nnvirtual-possibly-change-newsgroups (group regexp &optional check) (let ((inf t)) (or (not group) (and nnvirtual-current-group (string= group nnvirtual-current-group)) (and (setq inf (assoc group nnvirtual-group-alist)) (string= (nth 3 inf) regexp) (progn (setq nnvirtual-current-group (car inf)) (setq nnvirtual-current-groups (nth 1 inf)) (setq nnvirtual-current-mapping (nth 2 inf))))) (if (or (not check) (not inf)) (progn (and inf (setq nnvirtual-group-alist (delq inf nnvirtual-group-alist))) (setq nnvirtual-current-mapping nil) (setq nnvirtual-current-group group) (let ((newsrc gnus-newsrc-alist) (virt-group (gnus-group-prefixed-name nnvirtual-current-group '(nnvirtual "")))) (setq nnvirtual-current-groups nil) (while newsrc (and (string-match regexp (car (car newsrc))) (not (string= (car (car newsrc)) virt-group)) (setq nnvirtual-current-groups (cons (car (car newsrc)) nnvirtual-current-groups))) (setq newsrc (cdr newsrc)))) (if nnvirtual-current-groups (progn (nnvirtual-create-mapping group) (setq nnvirtual-group-alist (cons (list group nnvirtual-current-groups nnvirtual-current-mapping regexp) nnvirtual-group-alist))) (setq nnvirtual-status-string (format "nnvirtual: No newsgroups for this virtual newsgroup")))))) nnvirtual-current-groups) (defun nnvirtual-create-mapping (group) (let* ((group (gnus-group-prefixed-name group (list 'nnvirtual ""))) (info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (groups nnvirtual-current-groups) (offset 0) reads unread igroup itotal ireads) ;; The virtual group doesn't exist. (?) (or info (error "No such group: %s" group)) (setq nnvirtual-current-mapping nil) (while groups ;; Added by Sudish Joseph . (setq igroup (car groups)) (let ((info (nth 2 (gnus-gethash igroup gnus-newsrc-hashtb))) (active (gnus-gethash igroup gnus-active-hashtb))) ;; See if the group has had its active list read this session ;; if not, we do it now. (if (null active) (if (gnus-activate-group igroup) (progn (gnus-get-unread-articles-in-group info (gnus-gethash igroup gnus-active-hashtb)) (setq active (gnus-gethash igroup gnus-active-hashtb))) (message "Couldn't open component group %s" igroup))) (if (null active) () ;; And then we do the mapping for this component group. If ;; you feel tempted to cast your eyes to the soup below - ;; don't. It'll hurt your soul. Suffice to say that it ;; assigns ranges of nnvirtual article numbers to the ;; different component groups. To get the article number ;; from the nnvirtual number, one does something like ;; (+ (- number offset) (car active)), where `offset' is the ;; slice the mess below assigns, and active is the lowest ;; active article in the component group. (setq itotal (1+ (- (cdr active) (car active)))) (if (setq ireads (nth 2 info)) (let ((itreads (if (not (listp (cdr ireads))) (setq ireads (list (cons (car ireads) (cdr ireads)))) (setq ireads (copy-alist ireads))))) (if (< (or (and (numberp (car ireads)) (car ireads)) (cdr (car ireads))) (car active)) (setq ireads (setq itreads (cdr ireads)))) (if (and ireads (< (or (and (numberp (car ireads)) (car ireads)) (car (car ireads))) (car active))) (setcar (or (and (numberp (car ireads)) ireads) (car ireads)) (1+ (car active)))) (while itreads (setcar (or (and (numberp (car itreads)) itreads) (car itreads)) (+ (max 1 (- (if (numberp (car itreads)) (car itreads) (car (car itreads))) (car active))) offset)) (if (not (numberp (car itreads))) (setcdr (car itreads) (+ (- (cdr (car itreads)) (car active)) offset))) (setq itreads (cdr itreads))) (setq reads (nconc reads ireads)))) (setq offset (+ offset (1- itotal))) (setq nnvirtual-current-mapping (cons (list offset igroup (car active)) nnvirtual-current-mapping))) (setq groups (cdr groups)))) (setq nnvirtual-current-mapping (nreverse nnvirtual-current-mapping)) ;; Set Gnus active info. (gnus-sethash group (cons 1 (1- offset)) gnus-active-hashtb) ;; Set Gnus read info. (setcar (nthcdr 2 info) reads) ;; Then we deal with the marks. (let ((map nnvirtual-current-mapping) (marks '(tick dormant reply expire score)) (offset 0) tick dormant reply expire score marked active) (while map (setq igroup (nth 1 (car map))) (setq active (nth 2 (car map))) (setq marked (nth 3 (nth 2 (gnus-gethash igroup gnus-newsrc-hashtb)))) (let ((m marks)) (while m (and (assq (car m) marked) (set (car m) (nconc (mapcar (lambda (art) (if (numberp art) (if (< art active) 0 (+ (- art active) offset)) (cons (+ (- (car art) active) offset) (cdr art)))) (cdr (assq (car m) marked))) (symbol-value (car m))))) (setq m (cdr m)))) (setq offset (car (car map))) (setq map (cdr map))) ;; Put the list of marked articles in the info of the virtual group. (let ((m marks) marked) (while m (and (symbol-value (car m)) (setq marked (cons (cons (car m) (symbol-value (car m))) marked))) (setq m (cdr m))) (if (nthcdr 3 info) (setcar (nthcdr 3 info) marked) (setcdr (nthcdr 2 info) (list marked))))))) (defun nnvirtual-update-marked () (let ((mark-lists '((gnus-newsgroup-marked . tick) (gnus-newsgroup-dormant . dormant) (gnus-newsgroup-expirable . expire) (gnus-newsgroup-replied . reply))) marks art-group group-alist g) (while mark-lists (setq marks (symbol-value (car (car mark-lists)))) ;; Find out what groups the mark belong to. (while marks (setq art-group (nnvirtual-art-group (car marks))) (if (setq g (assoc (car art-group) group-alist)) (nconc g (list (cdr art-group))) (setq group-alist (cons (list (car art-group) (cdr art-group)) group-alist))) (setq marks (cdr marks))) ;; The groups that don't have marks must have no marks. (Yup.) (let ((groups nnvirtual-current-groups)) (while groups (or (assoc (car groups) group-alist) (setq group-alist (cons (list (car groups)) group-alist))) (setq groups (cdr groups)))) ;; The we update the list of marks. (while group-alist (gnus-add-marked-articles (car (car group-alist)) (cdr (car mark-lists)) (cdr (car group-alist)) nil t) (gnus-group-update-group (car (car group-alist)) t) (setq group-alist (cdr group-alist))) (setq mark-lists (cdr mark-lists))))) (defun nnvirtual-art-group (article) (let ((map nnvirtual-current-mapping) (offset 0)) (while (< (car (car map)) (if (numberp article) article (car article))) (setq offset (car (car map)) map (cdr map))) (cons (nth 1 (car map)) (if (numberp article) (- (+ article (nth 2 (car map))) offset) (cons (- (+ (car article) (nth 2 (car map))) offset) (cdr article)))))) (defun nnvirtual-catchup-group (group &optional server all) (nnvirtual-possibly-change-newsgroups group server) (let ((gnus-group-marked nnvirtual-current-groups) (gnus-expert-user t)) (save-excursion (set-buffer gnus-group-buffer) (gnus-group-catchup-current nil all)))) (provide 'nnvirtual) ;;; nnvirtual.el ends here emacs-19.30/lisp/noutline.el100444 12120 1 55711 6042026557 14265 0ustar rmsdaemon;;; outline.el --- outline mode commands for Emacs ;; Copyright (C) 1986, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: outlines ;; 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 package is a major mode for editing outline-format documents. ;; An outline can be `abstracted' to show headers at any given level, ;; with all stuff below hidden. See the Emacs manual for details. ;;; Code: ;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS. (defvar outline-regexp nil "*Regular expression to match the beginning of a heading. Any line whose beginning matches this regexp is considered to start a heading. The recommended way to set this is with a Local Variables: list in the file it applies to. See also outline-heading-end-regexp.") ;; Can't initialize this in the defvar above -- some major modes have ;; already assigned a local value to it. (or (default-value 'outline-regexp) (setq-default outline-regexp "[*\^L]+")) (defvar outline-heading-end-regexp "\n" "*Regular expression to match the end of a heading line. You can assume that point is at the beginning of a heading when this regexp is searched for. The heading ends at the end of the match. The recommended way to set this is with a `Local Variables:' list in the file it applies to.") (defvar outline-mode-prefix-map nil) (if outline-mode-prefix-map nil (setq outline-mode-prefix-map (make-sparse-keymap)) (define-key outline-mode-prefix-map "\C-n" 'outline-next-visible-heading) (define-key outline-mode-prefix-map "\C-p" 'outline-previous-visible-heading) (define-key outline-mode-prefix-map "\C-i" 'show-children) (define-key outline-mode-prefix-map "\C-s" 'show-subtree) (define-key outline-mode-prefix-map "\C-d" 'hide-subtree) (define-key outline-mode-prefix-map "\C-u" 'outline-up-heading) (define-key outline-mode-prefix-map "\C-f" 'outline-forward-same-level) (define-key outline-mode-prefix-map "\C-b" 'outline-backward-same-level) (define-key outline-mode-prefix-map "\C-t" 'hide-body) (define-key outline-mode-prefix-map "\C-a" 'show-all) (define-key outline-mode-prefix-map "\C-c" 'hide-entry) (define-key outline-mode-prefix-map "\C-e" 'show-entry) (define-key outline-mode-prefix-map "\C-l" 'hide-leaves) (define-key outline-mode-prefix-map "\C-k" 'show-branches) (define-key outline-mode-prefix-map "\C-q" 'hide-sublevels) (define-key outline-mode-prefix-map "\C-o" 'hide-other)) (defvar outline-mode-menu-bar-map nil) (if outline-mode-menu-bar-map nil (setq outline-mode-menu-bar-map (make-sparse-keymap)) (define-key outline-mode-menu-bar-map [hide] (cons "Hide" (make-sparse-keymap "Hide"))) (define-key outline-mode-menu-bar-map [hide hide-other] '("Hide Other" . hide-other)) (define-key outline-mode-menu-bar-map [hide hide-sublevels] '("Hide Sublevels" . hide-sublevels)) (define-key outline-mode-menu-bar-map [hide hide-subtree] '("Hide Subtree" . hide-subtree)) (define-key outline-mode-menu-bar-map [hide hide-entry] '("Hide Entry" . hide-entry)) (define-key outline-mode-menu-bar-map [hide hide-body] '("Hide Body" . hide-body)) (define-key outline-mode-menu-bar-map [hide hide-leaves] '("Hide Leaves" . hide-leaves)) (define-key outline-mode-menu-bar-map [show] (cons "Show" (make-sparse-keymap "Show"))) (define-key outline-mode-menu-bar-map [show show-subtree] '("Show Subtree" . show-subtree)) (define-key outline-mode-menu-bar-map [show show-children] '("Show Children" . show-children)) (define-key outline-mode-menu-bar-map [show show-branches] '("Show Branches" . show-branches)) (define-key outline-mode-menu-bar-map [show show-entry] '("Show Entry" . show-entry)) (define-key outline-mode-menu-bar-map [show show-all] '("Show All" . show-all)) (define-key outline-mode-menu-bar-map [headings] (cons "Headings" (make-sparse-keymap "Headings"))) (define-key outline-mode-menu-bar-map [headings outline-backward-same-level] '("Previous Same Level" . outline-backward-same-level)) (define-key outline-mode-menu-bar-map [headings outline-forward-same-level] '("Next Same Level" . outline-forward-same-level)) (define-key outline-mode-menu-bar-map [headings outline-previous-visible-heading] '("Previous" . outline-previous-visible-heading)) (define-key outline-mode-menu-bar-map [headings outline-next-visible-heading] '("Next" . outline-next-visible-heading)) (define-key outline-mode-menu-bar-map [headings outline-up-heading] '("Up" . outline-up-heading))) (defvar outline-mode-map nil "") (if outline-mode-map nil (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map)) (define-key outline-mode-map "\C-c" outline-mode-prefix-map) (define-key outline-mode-map [menu-bar] outline-mode-menu-bar-map)) (defvar outline-minor-mode nil "Non-nil if using Outline mode as a minor mode of some other mode.") (make-variable-buffer-local 'outline-minor-mode) (put 'outline-minor-mode 'permanent-local t) (or (assq 'outline-minor-mode minor-mode-alist) (setq minor-mode-alist (append minor-mode-alist (list '(outline-minor-mode " Outl"))))) (defvar outline-font-lock-keywords '(;; Highlight headings according to the level. ("^\\(\\*+\\)[ \t]*\\(.+\\)?[ \t]*$" (1 font-lock-string-face) (2 (let ((len (- (match-end 1) (match-beginning 1)))) (or (cdr (assq len '((1 . font-lock-function-name-face) (2 . font-lock-keyword-face) (3 . font-lock-comment-face)))) font-lock-variable-name-face)) nil t)) ;; Highight citations of the form [1] and [Mar94]. ("\\[\\([A-Z][A-Za-z]+\\)*[0-9]+\\]" . font-lock-type-face)) "Additional expressions to highlight in Outline mode.") (defvar outline-view-change-hook nil "Normal hook to be run after outline visibility changes.") ;;;autoload (defun outline-mode () "Set major mode for editing outlines with selective display. Headings are lines which start with asterisks: one for major headings, two for subheadings, etc. Lines not starting with asterisks are body lines. Body text or subheadings under a heading can be made temporarily invisible, or visible again. Invisible lines are attached to the end of the heading, so they move with it, if the line is killed and yanked back. A heading with text hidden under it is marked with an ellipsis (...). Commands:\\ \\[outline-next-visible-heading] outline-next-visible-heading move by visible headings \\[outline-previous-visible-heading] outline-previous-visible-heading \\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings \\[outline-backward-same-level] outline-backward-same-level \\[outline-up-heading] outline-up-heading move from subheading to heading \\[hide-body] make all text invisible (not headings). \\[show-all] make everything in buffer visible. The remaining commands are used when point is on a heading line. They apply to some of the body or subheadings of that heading. \\[hide-subtree] hide-subtree make body and subheadings invisible. \\[show-subtree] show-subtree make body and subheadings visible. \\[show-children] show-children make direct subheadings visible. No effect on body, or subheadings 2 or more levels down. With arg N, affects subheadings N levels down. \\[hide-entry] make immediately following body invisible. \\[show-entry] make it visible. \\[hide-leaves] make body under heading and under its subheadings invisible. The subheadings remain visible. \\[show-branches] make all subheadings at all levels visible. The variable `outline-regexp' can be changed to control what is a heading. A line is a heading if `outline-regexp' matches something at the beginning of the line. The longer the match, the deeper the level. Turning on outline mode calls the value of `text-mode-hook' and then of `outline-mode-hook', if they are non-nil." (interactive) (kill-all-local-variables) (use-local-map outline-mode-map) (setq mode-name "Outline") (setq major-mode 'outline-mode) (define-abbrev-table 'text-mode-abbrev-table ()) (setq local-abbrev-table text-mode-abbrev-table) (set-syntax-table text-mode-syntax-table) (make-local-variable 'line-move-ignore-invisible) (setq line-move-ignore-invisible t) ;; Cause use of ellipses for invisible text. (setq buffer-invisibility-spec '((t . t))) (make-local-variable 'paragraph-start) (setq paragraph-start (concat paragraph-start "\\|\\(" outline-regexp "\\)")) ;; Inhibit auto-filling of header lines. (make-local-variable 'auto-fill-inhibit-regexp) (setq auto-fill-inhibit-regexp outline-regexp) (make-local-variable 'paragraph-separate) (setq paragraph-separate (concat paragraph-separate "\\|\\(" outline-regexp "\\)")) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(outline-font-lock-keywords t)) (make-local-variable 'change-major-mode-hook) (add-hook 'change-major-mode-hook 'show-all) (run-hooks 'text-mode-hook 'outline-mode-hook)) (defvar outline-minor-mode-prefix "\C-c@" "*Prefix key to use for Outline commands in Outline minor mode. The value of this variable is checked as part of loading Outline mode. After that, changing the prefix key requires manipulating keymaps.") (defvar outline-minor-mode-map nil) (if outline-minor-mode-map nil (setq outline-minor-mode-map (make-sparse-keymap)) (define-key outline-minor-mode-map [menu-bar] outline-mode-menu-bar-map) (define-key outline-minor-mode-map outline-minor-mode-prefix outline-mode-prefix-map)) (or (assq 'outline-minor-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'outline-minor-mode outline-minor-mode-map) minor-mode-map-alist))) ;;;autoload (defun outline-minor-mode (&optional arg) "Toggle Outline minor mode. With arg, turn Outline minor mode on if arg is positive, off otherwise. See the command `outline-mode' for more information on this mode." (interactive "P") (setq outline-minor-mode (if (null arg) (not outline-minor-mode) (> (prefix-numeric-value arg) 0))) (if outline-minor-mode (progn (make-local-variable 'line-move-ignore-invisible) (setq line-move-ignore-invisible t) ;; Cause use of ellipses for invisible text. (setq buffer-invisibility-spec '((t . t))) (run-hooks 'outline-minor-mode-hook)) (setq line-move-ignore-invisible nil) ;; Cause use of ellipses for invisible text. (setq buffer-invisibility-spec t)) ;; When turning off outline mode, get rid of any outline hiding. (or outline-minor-mode (show-all)) (force-mode-line-update)) (defvar outline-level 'outline-level "Function of no args to compute a header's nesting level in an outline. It can assume point is at the beginning of a header line.") ;; This used to count columns rather than characters, but that made ^L ;; appear to be at level 2 instead of 1. Columns would be better for ;; tab handling, but the default regexp doesn't use tabs, and anyone ;; who changes the regexp can also redefine the outline-level variable ;; as appropriate. (defun outline-level () "Return the depth to which a statement is nested in the outline. Point must be at the beginning of a header line. This is actually the number of characters that `outline-regexp' matches." (save-excursion (looking-at outline-regexp) (- (match-end 0) (match-beginning 0)))) (defun outline-next-preface () "Skip forward to just before the next heading line. If there's no following heading line, stop before the newline at the end of the buffer." (if (re-search-forward (concat "\n\\(" outline-regexp "\\)") nil 'move) (goto-char (match-beginning 0))) (if (bolp) (forward-char -1))) (defun outline-next-heading () "Move to the next (possibly invisible) heading line." (interactive) (if (re-search-forward (concat "\n\\(" outline-regexp "\\)") nil 'move) (goto-char (1+ (match-beginning 0))))) (defsubst outline-visible () "Non-nil if the character after point is visible." (not (get-char-property (point) 'invisible))) (defun outline-back-to-heading () "Move to previous heading line, or beg of this line if it's a heading. Only visible heading lines are considered." (beginning-of-line) (or (outline-on-heading-p) (let (found) (while (not found) (setq found (and (re-search-backward (concat "^\\(" outline-regexp "\\)") nil t) (outline-visible)))) found) (error "before first heading"))) (defun outline-on-heading-p () "Return t if point is on a (visible) heading line." (save-excursion (beginning-of-line) (and (bolp) (outline-visible) (looking-at outline-regexp)))) (defun outline-end-of-heading () (if (re-search-forward outline-heading-end-regexp nil 'move) (forward-char -1))) (defun outline-next-visible-heading (arg) "Move to the next visible heading line. With argument, repeats or can move backward if negative. A heading line is one that starts with a `*' (or that `outline-regexp' matches)." (interactive "p") (if (< arg 0) (beginning-of-line) (end-of-line)) (while (and (not (bobp)) (< arg 0)) (while (and (not (bobp)) (re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move) (not (outline-visible)))) (setq arg (1+ arg))) (while (and (not (eobp)) (> arg 0)) (while (and (not (eobp)) (re-search-forward (concat "^\\(" outline-regexp "\\)") nil 'move) (not (outline-visible)))) (setq arg (1- arg))) (beginning-of-line)) (defun outline-previous-visible-heading (arg) "Move to the previous heading line. With argument, repeats or can move forward if negative. A heading line is one that starts with a `*' (or that `outline-regexp' matches)." (interactive "p") (outline-next-visible-heading (- arg))) (defun outline-flag-region (from to flag) "Hides or shows lines from FROM to TO, according to FLAG. If FLAG is nil then text is shown, while if FLAG is t the text is hidden." (let ((inhibit-read-only t)) (save-excursion (goto-char from) (end-of-line) (outline-discard-overlays (point) to 'outline) (if flag (let ((o (make-overlay (point) to))) (overlay-put o 'invisible flag) (overlay-put o 'outline t))))) (run-hooks 'outline-view-change-hook)) ;; Exclude from the region BEG ... END all overlays ;; with a non-nil PROP property. ;; Exclude them by shrinking them to exclude BEG ... END, ;; or even by splitting them if necessary. ;; Overlays without a non-nil PROP property are not touched. (defun outline-discard-overlays (beg end prop) (if (< end beg) (setq beg (prog1 end (setq end beg)))) (save-excursion (goto-char beg) (while (< (point) end) (let ((overlays (overlays-at (point)))) (while overlays (let ((o (car overlays))) (if (overlay-get o prop) ;; Either push this overlay outside beg...end ;; or split it to exclude beg...end ;; or delete it entirely (if it is contained in beg...end). (if (< (overlay-start o) beg) (if (> (overlay-end o) end) (let ((o1 (outline-copy-overlay o))) (move-overlay o1 (overlay-start o1) beg) (move-overlay o (overlay-start o) beg))) (if (> (overlay-end o) end) (move-overlay o end (overlay-end o)) (delete-overlay o))))) (setq overlays (cdr overlays)))) (goto-char (next-overlay-change (point)))))) ;; Make a copy of overlay O, with the same beginning, end and properties. (defun outline-copy-overlay (o) (let ((o1 (make-overlay (overlay-start o) (overlay-end o) (overlay-buffer o))) (props (overlay-properties o))) (while props (overlay-put o1 (car props) (nth 1 props)) (setq props (cdr (cdr props)))) o1)) (defun hide-entry () "Hide the body directly following this heading." (interactive) (outline-back-to-heading) (outline-end-of-heading) (save-excursion (outline-flag-region (point) (progn (outline-next-preface) (point)) t))) (defun show-entry () "Show the body directly following this heading." (interactive) (save-excursion (outline-flag-region (point) (progn (outline-next-preface) (point)) nil))) (defun hide-body () "Hide all of buffer except headings." (interactive) (hide-region-body (point-min) (point-max))) (defun hide-region-body (start end) "Hide all body lines in the region, but not headings." (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) (if (outline-on-heading-p) (outline-end-of-heading)) (while (not (eobp)) (outline-flag-region (point) (progn (outline-next-preface) (point)) t) (if (not (eobp)) (progn (forward-char (if (looking-at "\n\n") 2 1)) (outline-end-of-heading))))))) (defun show-all () "Show all of the text in the buffer." (interactive) (outline-flag-region (point-min) (point-max) nil)) (defun hide-subtree () "Hide everything after this heading at deeper levels." (interactive) (outline-flag-subtree t)) (defun hide-leaves () "Hide all body after this heading at deeper levels." (interactive) (outline-back-to-heading) (outline-end-of-heading) (hide-region-body (point) (progn (outline-end-of-subtree) (point)))) (defun show-subtree () "Show everything after this heading at deeper levels." (interactive) (outline-flag-subtree nil)) (defun hide-sublevels (levels) "Hide everything but the top LEVELS levels of headers, in whole buffer." (interactive "p") (if (< levels 1) (error "Must keep at least one level of headers")) (setq levels (1- levels)) (save-excursion (goto-char (point-min)) ;; Keep advancing to the next top-level heading. (while (or (and (bobp) (outline-on-heading-p)) (outline-next-heading)) (let ((end (save-excursion (outline-end-of-subtree) (point)))) ;; Hide everything under that. (outline-flag-region (point) end t) ;; Show the first LEVELS levels under that. (if (> levels 0) (show-children levels)) ;; Move to the next, since we already found it. (goto-char end))))) (defun hide-other () "Hide everything except for the current body and the parent headings." (interactive) (hide-sublevels 1) (let ((last (point)) (pos (point))) (while (save-excursion (and (end-of-line 0) (not (outline-visible)))) (save-excursion (beginning-of-line) (if (eq last (point)) (progn (outline-next-heading) (outline-flag-region last (point) nil)) (show-children) (setq last (point))))))) (defun outline-flag-subtree (flag) (save-excursion (outline-back-to-heading) (outline-end-of-heading) (outline-flag-region (point) (progn (outline-end-of-subtree) (point)) flag))) (defun outline-end-of-subtree () (outline-back-to-heading) (let ((opoint (point)) (first t) (level (funcall outline-level))) (while (and (not (eobp)) (or first (> (funcall outline-level) level))) (setq first nil) (outline-next-heading)) (if (bolp) (progn ;; Go to end of line before heading (forward-char -1) (if (bolp) ;; leave blank line before heading (forward-char -1)))))) (defun show-branches () "Show all subheadings of this heading, but not their bodies." (interactive) (show-children 1000)) (defun show-children (&optional level) "Show all direct subheadings of this heading. Prefix arg LEVEL is how many levels below the current level should be shown. Default is enough to cause the following heading to appear." (interactive "P") (setq level (if level (prefix-numeric-value level) (save-excursion (outline-back-to-heading) (let ((start-level (funcall outline-level))) (outline-next-heading) (if (eobp) 1 (max 1 (- (funcall outline-level) start-level))))))) (save-excursion (save-restriction (outline-back-to-heading) (setq level (+ level (funcall outline-level))) (narrow-to-region (point) (progn (outline-end-of-subtree) (if (eobp) (point-max) (1+ (point))))) (goto-char (point-min)) (while (and (not (eobp)) (progn (outline-next-heading) (not (eobp)))) (if (<= (funcall outline-level) level) (save-excursion (outline-flag-region (save-excursion (forward-char -1) (if (bolp) (forward-char -1)) (point)) (progn (outline-end-of-heading) (point)) nil))))))) (defun outline-up-heading (arg) "Move to the heading line of which the present line is a subheading. With argument, move up ARG levels." (interactive "p") (outline-back-to-heading) (if (eq (funcall outline-level) 1) (error "")) (while (and (> (funcall outline-level) 1) (> arg 0) (not (bobp))) (let ((present-level (funcall outline-level))) (while (not (< (funcall outline-level) present-level)) (outline-previous-visible-heading 1)) (setq arg (- arg 1))))) (defun outline-forward-same-level (arg) "Move forward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading." (interactive "p") (outline-back-to-heading) (while (> arg 0) (let ((point-to-move-to (save-excursion (outline-get-next-sibling)))) (if point-to-move-to (progn (goto-char point-to-move-to) (setq arg (1- arg))) (progn (setq arg 0) (error "")))))) (defun outline-get-next-sibling () "Move to next heading of the same level, and return point or nil if none." (let ((level (funcall outline-level))) (outline-next-visible-heading 1) (while (and (> (funcall outline-level) level) (not (eobp))) (outline-next-visible-heading 1)) (if (< (funcall outline-level) level) nil (point)))) (defun outline-backward-same-level (arg) "Move backward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading." (interactive "p") (outline-back-to-heading) (while (> arg 0) (let ((point-to-move-to (save-excursion (outline-get-last-sibling)))) (if point-to-move-to (progn (goto-char point-to-move-to) (setq arg (1- arg))) (progn (setq arg 0) (error "")))))) (defun outline-get-last-sibling () "Move to next heading of the same level, and return point or nil if none." (let ((level (funcall outline-level))) (outline-previous-visible-heading 1) (while (and (> (funcall outline-level) level) (not (bobp))) (outline-previous-visible-heading 1)) (if (< (funcall outline-level) level) nil (point)))) (provide 'outline) (provide 'noutline) ;;; outline.el ends here emacs-19.30/lisp/novice.el100444 75424 12 11402 5716041263 13762 0ustar kwzhstaff;;; novice.el --- handling of disabled commands ("novice mode") for Emacs. ;; Copyright (C) 1985, 1986, 1987, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal, help ;; 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 mode provides a hook which is, by default, attached to various ;; putatively dangerous commands in a (probably futile) attempt to ;; prevent lusers from shooting themselves in the feet. ;;; Code: ;; This function is called (by autoloading) ;; to handle any disabled command. ;; The command is found in this-command ;; and the keys are returned by (this-command-keys). ;;;###autoload (setq disabled-command-hook 'disabled-command-hook) ;;;###autoload (defun disabled-command-hook (&rest ignore) (let (char) (save-window-excursion (with-output-to-temp-buffer "*Help*" (let ((keys (this-command-keys))) (if (or (eq (aref keys 0) (if (stringp keys) (aref "\M-x" 0) ?\M-x)) (and (>= (length keys) 2) (eq (aref keys 0) meta-prefix-char) (eq (aref keys 1) ?x))) (princ "You have invoked the disabled command ") (princ "You have typed ") (princ (key-description keys)) (princ ", invoking disabled command "))) (princ this-command) (princ ":\n") ;; Print any special message saying why the command is disabled. (if (stringp (get this-command 'disabled)) (princ (get this-command 'disabled))) (princ (or (condition-case () (documentation this-command) (error nil)) "<< not documented >>")) ;; Keep only the first paragraph of the documentation. (save-excursion (set-buffer "*Help*") (goto-char (point-min)) (if (search-forward "\n\n" nil t) (delete-region (1- (point)) (point-max)) (goto-char (point-max)))) (princ "\n\n") (princ "You can now type Space to try the command just this once, but leave it disabled, Y to try it and enable it (no questions if you use it again), N to do nothing (command remains disabled).") (save-excursion (set-buffer standard-output) (help-mode))) (message "Type y, n or Space: ") (let ((cursor-in-echo-area t)) (while (not (memq (setq char (downcase (read-char))) '(? ?y ?n))) (ding) (message "Please type y, n or Space: ")))) (if (= char ?y) (if (and user-init-file (not (string= "" user-init-file)) (y-or-n-p "Enable command for future editing sessions also? ")) (enable-command this-command) (put this-command 'disabled nil))) (if (/= char ?n) (call-interactively this-command)))) ;;;###autoload (defun enable-command (command) "Allow COMMAND to be executed without special confirmation from now on. The user's .emacs file is altered so that this will apply to future sessions." (interactive "CEnable command: ") (put command 'disabled nil) (save-excursion (set-buffer (find-file-noselect (substitute-in-file-name user-init-file))) (goto-char (point-min)) (if (search-forward (concat "(put '" (symbol-name command) " ") nil t) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) ;; Explicitly enable, in case this command is disabled by default ;; or in case the code we deleted was actually a comment. (goto-char (point-max)) (insert "\n(put '" (symbol-name command) " 'disabled nil)\n") (save-buffer))) ;;;###autoload (defun disable-command (command) "Require special confirmation to execute COMMAND from now on. The user's .emacs file is altered so that this will apply to future sessions." (interactive "CDisable command: ") (if (not (commandp command)) (error "Invalid command name `%s'" command)) (put command 'disabled t) (save-excursion (set-buffer (find-file-noselect (substitute-in-file-name user-init-file))) (goto-char (point-min)) (if (search-forward (concat "(put '" (symbol-name command) " ") nil t) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) (goto-char (point-max)) (insert "\n(put '" (symbol-name command) " 'disabled t)\n") (save-buffer))) ;;; novice.el ends here emacs-19.30/lisp/nroff-mode.el100444 12120 1 22631 6003025254 14445 0ustar rmsdaemon;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source ;; Copyright (C) 1985, 1986, 1994, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: wp ;; 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 package is a major mode for editing nroff source code. It knows ;; about various nroff constructs, ms, mm, and me macros, and will fill ;; and indent paragraphs properly in their presence. It also includes ;; a command to count text lines (excluding nroff constructs), a command ;; to center a line, and movement commands that know how to skip macros. ;; Paragraph filling and line-counting currently don't respect comments, ;; as they should. ;;; Code: (defvar nroff-mode-abbrev-table nil "Abbrev table used while in nroff mode.") (define-abbrev-table 'nroff-mode-abbrev-table ()) (defvar nroff-mode-map nil "Major mode keymap for nroff mode.") (if (not nroff-mode-map) (progn (setq nroff-mode-map (make-sparse-keymap)) (define-key nroff-mode-map "\t" 'tab-to-tab-stop) (define-key nroff-mode-map "\es" 'center-line) (define-key nroff-mode-map "\e?" 'count-text-lines) (define-key nroff-mode-map "\n" 'electric-nroff-newline) (define-key nroff-mode-map "\en" 'forward-text-line) (define-key nroff-mode-map "\ep" 'backward-text-line))) (defvar nroff-mode-syntax-table nil "Syntax table used while in nroff mode.") (defvar nroff-font-lock-keywords (list ;; Directives are . or ' at start of line, followed by ;; optional whitespace, then command (which my be longer than ;; 2 characters in groff). Perhaps the arguments should be ;; fontified as well. "^[.']\\s-*\\sw+" ;; There are numerous groff escapes; the following get things ;; like \-, \(em (standard troff) and \f[bar] (groff ;; variants). This won't currently do groff's \A'foo' and ;; the like properly. One might expect it to highlight an escape's ;; arguments in common cases, like \f. (concat "\\\\" ; backslash "\\(" ; followed by various possibilities (mapconcat 'identity '("[f*n]*\\[.+]" ; some groff extensions "(.." ; two chars after ( "[^(\"]" ; single char escape ) "\\|") "\\)") ) "Font-lock highlighting control in nroff-mode.") ;;;###autoload (defun nroff-mode () "Major mode for editing text intended for nroff to format. \\{nroff-mode-map} Turning on Nroff mode runs `text-mode-hook', then `nroff-mode-hook'. Also, try `nroff-electric-mode', for automatically inserting closing requests for requests that are used in matched pairs." (interactive) (kill-all-local-variables) (use-local-map nroff-mode-map) (setq mode-name "Nroff") (setq major-mode 'nroff-mode) (if nroff-mode-syntax-table () (setq nroff-mode-syntax-table (copy-syntax-table text-mode-syntax-table)) ;; " isn't given string quote syntax in text-mode but it ;; (arguably) should be for use round nroff arguments (with ` and ;; ' used otherwise). (modify-syntax-entry ?\" "\" 2" nroff-mode-syntax-table) ;; Comments are delimited by \" and newline. (modify-syntax-entry ?\\ "\\ 1" nroff-mode-syntax-table) (modify-syntax-entry ?\n "> 1" nroff-mode-syntax-table)) (set-syntax-table nroff-mode-syntax-table) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(nroff-font-lock-keywords nil t)) (setq local-abbrev-table nroff-mode-abbrev-table) (make-local-variable 'nroff-electric-mode) (setq nroff-electric-mode nil) (make-local-variable 'outline-regexp) (setq outline-regexp "\\.H[ ]+[1-7]+ ") (make-local-variable 'outline-level) (setq outline-level 'nroff-outline-level) ;; now define a bunch of variables for use by commands in this mode (make-local-variable 'page-delimiter) (setq page-delimiter "^\\.\\(bp\\|SK\\|OP\\)") (make-local-variable 'paragraph-start) (setq paragraph-start (concat "[.']\\|" paragraph-start)) (make-local-variable 'paragraph-separate) (setq paragraph-separate (concat "[.']\\|" paragraph-separate)) ;; comment syntax added by mit-erl!gildea 18 Apr 86 (make-local-variable 'comment-start) (setq comment-start "\\\" ") (make-local-variable 'comment-start-skip) (setq comment-start-skip "\\\\\"[ \t]*") (make-local-variable 'comment-column) (setq comment-column 24) (make-local-variable 'comment-indent-function) (setq comment-indent-function 'nroff-comment-indent) (run-hooks 'text-mode-hook 'nroff-mode-hook)) (defun nroff-outline-level () (save-excursion (looking-at outline-regexp) (skip-chars-forward ".H ") (string-to-int (buffer-substring (point) (+ 1 (point)))))) ;;; Compute how much to indent a comment in nroff/troff source. ;;; By mit-erl!gildea April 86 (defun nroff-comment-indent () "Compute indent for an nroff/troff comment. Puts a full-stop before comments on a line by themselves." (let ((pt (point))) (unwind-protect (progn (skip-chars-backward " \t") (if (bolp) (progn (setq pt (1+ pt)) (insert ?.) 1) (if (save-excursion (backward-char 1) (looking-at "^[.']")) 1 (max comment-column (* 8 (/ (+ (current-column) 9) 8)))))) ; add 9 to ensure at least two blanks (goto-char pt)))) (defun count-text-lines (start end &optional print) "Count lines in region, except for nroff request lines. All lines not starting with a period are counted up. Interactively, print result in echo area. Noninteractively, return number of non-request lines from START to END." (interactive "r\np") (if print (message "Region has %d text lines" (count-text-lines start end)) (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) (- (buffer-size) (forward-text-line (buffer-size))))))) (defun forward-text-line (&optional cnt) "Go forward one nroff text line, skipping lines of nroff requests. An argument is a repeat count; if negative, move backward." (interactive "p") (if (not cnt) (setq cnt 1)) (while (and (> cnt 0) (not (eobp))) (forward-line 1) (while (and (not (eobp)) (looking-at "[.'].")) (forward-line 1)) (setq cnt (- cnt 1))) (while (and (< cnt 0) (not (bobp))) (forward-line -1) (while (and (not (bobp)) (looking-at "[.'].")) (forward-line -1)) (setq cnt (+ cnt 1))) cnt) (defun backward-text-line (&optional cnt) "Go backward one nroff text line, skipping lines of nroff requests. An argument is a repeat count; negative means move forward." (interactive "p") (forward-text-line (- cnt))) (defconst nroff-brace-table '((".(b" . ".)b") (".(l" . ".)l") (".(q" . ".)q") (".(c" . ".)c") (".(x" . ".)x") (".(z" . ".)z") (".(d" . ".)d") (".(f" . ".)f") (".LG" . ".NL") (".SM" . ".NL") (".LD" . ".DE") (".CD" . ".DE") (".BD" . ".DE") (".DS" . ".DE") (".DF" . ".DE") (".FS" . ".FE") (".KS" . ".KE") (".KF" . ".KE") (".LB" . ".LE") (".AL" . ".LE") (".BL" . ".LE") (".DL" . ".LE") (".ML" . ".LE") (".RL" . ".LE") (".VL" . ".LE") (".RS" . ".RE") (".TS" . ".TE") (".EQ" . ".EN") (".PS" . ".PE") (".BS" . ".BE") (".G1" . ".G2") ; grap (".na" . ".ad b") (".nf" . ".fi") (".de" . ".."))) (defun electric-nroff-newline (arg) "Insert newline for nroff mode; special if electric-nroff mode. In `electric-nroff-mode', if ending a line containing an nroff opening request, automatically inserts the matching closing request after point." (interactive "P") (let ((completion (save-excursion (beginning-of-line) (and (null arg) nroff-electric-mode (<= (point) (- (point-max) 3)) (cdr (assoc (buffer-substring (point) (+ 3 (point))) nroff-brace-table))))) (needs-nl (not (looking-at "[ \t]*$")))) (if (null completion) (newline (prefix-numeric-value arg)) (save-excursion (insert "\n\n" completion) (if needs-nl (insert "\n"))) (forward-char 1)))) (defun electric-nroff-mode (&optional arg) "Toggle `nroff-electric-newline' minor mode. `nroff-electric-newline' forces Emacs to check for an nroff request at the beginning of the line, and insert the matching closing request if necessary. This command toggles that mode (off->on, on->off), with an argument, turns it on iff arg is positive, otherwise off." (interactive "P") (or (eq major-mode 'nroff-mode) (error "Must be in nroff mode")) (or (assq 'nroff-electric-mode minor-mode-alist) (setq minor-mode-alist (append minor-mode-alist (list '(nroff-electric-mode " Electric"))))) (setq nroff-electric-mode (cond ((null arg) (null nroff-electric-mode)) (t (> (prefix-numeric-value arg) 0))))) ;;; nroff-mode.el ends here emacs-19.30/lisp/options.el100444 12120 1 11302 5731667443 14120 0ustar rmsdaemon;;; options.el --- edit Options command for Emacs. ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; 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 code provides functions to list and edit the values of all global ;; option variables known to loaded Emacs Lisp code. There are two entry ;; points, `list-options' and `edit' options'. The latter enters a major ;; mode specifically for editing option values. Do `M-x describe-mode' in ;; that context for more details. ;;; Code: ;;;###autoload (defun list-options () "Display a list of Emacs user options, with values and documentation." (interactive) (save-excursion (set-buffer (get-buffer-create "*List Options*")) (Edit-options-mode)) (with-output-to-temp-buffer "*List Options*" (let (vars) (mapatoms (function (lambda (sym) (if (user-variable-p sym) (setq vars (cons sym vars)))))) (setq vars (sort vars 'string-lessp)) (while vars (let ((sym (car vars))) (princ ";; ") (prin1 sym) (princ ":\n\t") (prin1 (symbol-value sym)) (terpri) (princ (substitute-command-keys (documentation-property sym 'variable-documentation))) (princ "\n;;\n")) (setq vars (cdr vars))))) (save-excursion (set-buffer "*List Options*") (setq buffer-read-only t))) ;;;###autoload (defun edit-options () "Edit a list of Emacs user option values. Selects a buffer containing such a list, in which there are commands to set the option values. Type \\[describe-mode] in that buffer for a list of commands." (interactive) (list-options) (pop-to-buffer "*List Options*")) (defvar Edit-options-mode-map (let ((map (make-keymap))) (define-key map "s" 'Edit-options-set) (define-key map "x" 'Edit-options-toggle) (define-key map "1" 'Edit-options-t) (define-key map "0" 'Edit-options-nil) (define-key map "p" 'backward-paragraph) (define-key map " " 'forward-paragraph) (define-key map "n" 'forward-paragraph) map) "") ;; Edit Options mode is suitable only for specially formatted data. (put 'Edit-options-mode 'mode-class 'special) (defun Edit-options-mode () "\\\ Major mode for editing Emacs user option settings. Special commands are: \\[Edit-options-set] -- set variable point points at. New value read using minibuffer. \\[Edit-options-toggle] -- toggle variable, t -> nil, nil -> t. \\[Edit-options-t] -- set variable to t. \\[Edit-options-nil] -- set variable to nil. Changed values made by these commands take effect immediately. Each variable description is a paragraph. For convenience, the characters \\[backward-paragraph] and \\[forward-paragraph] move back and forward by paragraphs." (kill-all-local-variables) (set-syntax-table emacs-lisp-mode-syntax-table) (use-local-map Edit-options-mode-map) (make-local-variable 'paragraph-separate) (setq paragraph-separate "[^\^@-\^?]") (make-local-variable 'paragraph-start) (setq paragraph-start "\t") (setq truncate-lines t) (setq major-mode 'Edit-options-mode) (setq mode-name "Options") (run-hooks 'Edit-options-mode-hook)) (defun Edit-options-set () (interactive) (Edit-options-modify '(lambda (var) (eval-minibuffer (concat "New " (symbol-name var) ": "))))) (defun Edit-options-toggle () (interactive) (Edit-options-modify '(lambda (var) (not (symbol-value var))))) (defun Edit-options-t () (interactive) (Edit-options-modify '(lambda (var) t))) (defun Edit-options-nil () (interactive) (Edit-options-modify '(lambda (var) nil))) (defun Edit-options-modify (modfun) (save-excursion (let ((buffer-read-only nil) var pos) (re-search-backward "^;; \\|\\`") (forward-char 3) (setq pos (point)) (save-restriction (narrow-to-region pos (progn (end-of-line) (1- (point)))) (goto-char pos) (setq var (read (current-buffer)))) (goto-char pos) (forward-line 1) (forward-char 1) (save-excursion (set var (funcall modfun var))) (kill-sexp 1) (prin1 (symbol-value var) (current-buffer))))) ;;; options.el ends here emacs-19.30/lisp/outline.el100444 12120 1 51060 5751307656 14110 0ustar rmsdaemon;;; outline.el --- outline mode commands for Emacs ;; Copyright (C) 1986, 1993, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: outlines ;; 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 package is a major mode for editing outline-format documents. ;; An outline can be `abstracted' to show headers at any given level, ;; with all stuff below hidden. See the Emacs manual for details. ;;; Code: ;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS. (defvar outline-regexp nil "*Regular expression to match the beginning of a heading. Any line whose beginning matches this regexp is considered to start a heading. The recommended way to set this is with a Local Variables: list in the file it applies to. See also outline-heading-end-regexp.") ;; Can't initialize this in the defvar above -- some major modes have ;; already assigned a local value to it. (or (default-value 'outline-regexp) (setq-default outline-regexp "[*\^L]+")) (defvar outline-heading-end-regexp "[\n\^M]" "*Regular expression to match the end of a heading line. You can assume that point is at the beginning of a heading when this regexp is searched for. The heading ends at the end of the match. The recommended way to set this is with a \"Local Variables:\" list in the file it applies to.") (defvar outline-mode-prefix-map nil) (if outline-mode-prefix-map nil (setq outline-mode-prefix-map (make-sparse-keymap)) (define-key outline-mode-prefix-map "\C-n" 'outline-next-visible-heading) (define-key outline-mode-prefix-map "\C-p" 'outline-previous-visible-heading) (define-key outline-mode-prefix-map "\C-i" 'show-children) (define-key outline-mode-prefix-map "\C-s" 'show-subtree) (define-key outline-mode-prefix-map "\C-d" 'hide-subtree) (define-key outline-mode-prefix-map "\C-u" 'outline-up-heading) (define-key outline-mode-prefix-map "\C-f" 'outline-forward-same-level) (define-key outline-mode-prefix-map "\C-b" 'outline-backward-same-level) (define-key outline-mode-prefix-map "\C-t" 'hide-body) (define-key outline-mode-prefix-map "\C-a" 'show-all) (define-key outline-mode-prefix-map "\C-c" 'hide-entry) (define-key outline-mode-prefix-map "\C-e" 'show-entry) (define-key outline-mode-prefix-map "\C-l" 'hide-leaves) (define-key outline-mode-prefix-map "\C-k" 'show-branches) (define-key outline-mode-prefix-map "\C-q" 'hide-sublevels) (define-key outline-mode-prefix-map "\C-o" 'hide-other)) (defvar outline-mode-menu-bar-map nil) (if outline-mode-menu-bar-map nil (setq outline-mode-menu-bar-map (make-sparse-keymap)) (define-key outline-mode-menu-bar-map [hide] (cons "Hide" (make-sparse-keymap "Hide"))) (define-key outline-mode-menu-bar-map [hide hide-other] '("Hide Other" . hide-other)) (define-key outline-mode-menu-bar-map [hide hide-sublevels] '("Hide Sublevels" . hide-sublevels)) (define-key outline-mode-menu-bar-map [hide hide-subtree] '("Hide Subtree" . hide-subtree)) (define-key outline-mode-menu-bar-map [hide hide-entry] '("Hide Entry" . hide-entry)) (define-key outline-mode-menu-bar-map [hide hide-body] '("Hide Body" . hide-body)) (define-key outline-mode-menu-bar-map [hide hide-leaves] '("Hide Leaves" . hide-leaves)) (define-key outline-mode-menu-bar-map [show] (cons "Show" (make-sparse-keymap "Show"))) (define-key outline-mode-menu-bar-map [show show-subtree] '("Show Subtree" . show-subtree)) (define-key outline-mode-menu-bar-map [show show-children] '("Show Children" . show-children)) (define-key outline-mode-menu-bar-map [show show-branches] '("Show Branches" . show-branches)) (define-key outline-mode-menu-bar-map [show show-entry] '("Show Entry" . show-entry)) (define-key outline-mode-menu-bar-map [show show-all] '("Show All" . show-all)) (define-key outline-mode-menu-bar-map [headings] (cons "Headings" (make-sparse-keymap "Headings"))) (define-key outline-mode-menu-bar-map [headings outline-backward-same-level] '("Previous Same Level" . outline-backward-same-level)) (define-key outline-mode-menu-bar-map [headings outline-forward-same-level] '("Next Same Level" . outline-forward-same-level)) (define-key outline-mode-menu-bar-map [headings outline-previous-visible-heading] '("Previous" . outline-previous-visible-heading)) (define-key outline-mode-menu-bar-map [headings outline-next-visible-heading] '("Next" . outline-next-visible-heading)) (define-key outline-mode-menu-bar-map [headings outline-up-heading] '("Up" . outline-up-heading))) (defvar outline-mode-map nil "") (if outline-mode-map nil (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map)) (define-key outline-mode-map "\C-c" outline-mode-prefix-map) (define-key outline-mode-map [menu-bar] outline-mode-menu-bar-map)) (defvar outline-minor-mode nil "Non-nil if using Outline mode as a minor mode of some other mode.") (make-variable-buffer-local 'outline-minor-mode) (put 'outline-minor-mode 'permanent-local t) (or (assq 'outline-minor-mode minor-mode-alist) (setq minor-mode-alist (append minor-mode-alist (list '(outline-minor-mode " Outl"))))) (defvar outline-font-lock-keywords '(;; Highlight headings according to the level. ("^\\(\\*+\\)[ \t]*\\(.+\\)?[ \t]*$" (1 font-lock-string-face) (2 (let ((len (- (match-end 1) (match-beginning 1)))) (or (cdr (assq len '((1 . font-lock-function-name-face) (2 . font-lock-keyword-face) (3 . font-lock-comment-face)))) font-lock-variable-name-face)) nil t)) ;; Highight citations of the form [1] and [Mar94]. ("\\[\\([A-Z][A-Za-z]+\\)*[0-9]+\\]" . font-lock-type-face)) "Additional expressions to highlight in Outline mode.") ;;;###autoload (defun outline-mode () "Set major mode for editing outlines with selective display. Headings are lines which start with asterisks: one for major headings, two for subheadings, etc. Lines not starting with asterisks are body lines. Body text or subheadings under a heading can be made temporarily invisible, or visible again. Invisible lines are attached to the end of the heading, so they move with it, if the line is killed and yanked back. A heading with text hidden under it is marked with an ellipsis (...). Commands:\\ \\[outline-next-visible-heading] outline-next-visible-heading move by visible headings \\[outline-previous-visible-heading] outline-previous-visible-heading \\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings \\[outline-backward-same-level] outline-backward-same-level \\[outline-up-heading] outline-up-heading move from subheading to heading \\[hide-body] make all text invisible (not headings). \\[show-all] make everything in buffer visible. The remaining commands are used when point is on a heading line. They apply to some of the body or subheadings of that heading. \\[hide-subtree] hide-subtree make body and subheadings invisible. \\[show-subtree] show-subtree make body and subheadings visible. \\[show-children] show-children make direct subheadings visible. No effect on body, or subheadings 2 or more levels down. With arg N, affects subheadings N levels down. \\[hide-entry] make immediately following body invisible. \\[show-entry] make it visible. \\[hide-leaves] make body under heading and under its subheadings invisible. The subheadings remain visible. \\[show-branches] make all subheadings at all levels visible. The variable `outline-regexp' can be changed to control what is a heading. A line is a heading if `outline-regexp' matches something at the beginning of the line. The longer the match, the deeper the level. Turning on outline mode calls the value of `text-mode-hook' and then of `outline-mode-hook', if they are non-nil." (interactive) (kill-all-local-variables) (setq selective-display t) (use-local-map outline-mode-map) (setq mode-name "Outline") (setq major-mode 'outline-mode) (define-abbrev-table 'text-mode-abbrev-table ()) (setq local-abbrev-table text-mode-abbrev-table) (set-syntax-table text-mode-syntax-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat paragraph-start "\\|\\(" outline-regexp "\\)")) ;; Inhibit auto-filling of header lines. (make-local-variable 'auto-fill-inhibit-regexp) (setq auto-fill-inhibit-regexp outline-regexp) (make-local-variable 'paragraph-separate) (setq paragraph-separate (concat paragraph-separate "\\|\\(" outline-regexp "\\)")) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(outline-font-lock-keywords t)) (make-local-variable 'change-major-mode-hook) (add-hook 'change-major-mode-hook 'show-all) (run-hooks 'text-mode-hook 'outline-mode-hook)) (defvar outline-minor-mode-prefix "\C-c@" "*Prefix key to use for Outline commands in Outline minor mode. The value of this variable is checked as part of loading Outline mode. After that, changing the prefix key requires manipulating keymaps.") (defvar outline-minor-mode-map nil) (if outline-minor-mode-map nil (setq outline-minor-mode-map (make-sparse-keymap)) (define-key outline-minor-mode-map [menu-bar] outline-mode-menu-bar-map) (define-key outline-minor-mode-map outline-minor-mode-prefix outline-mode-prefix-map)) (or (assq 'outline-minor-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'outline-minor-mode outline-minor-mode-map) minor-mode-map-alist))) ;;;###autoload (defun outline-minor-mode (&optional arg) "Toggle Outline minor mode. With arg, turn Outline minor mode on if arg is positive, off otherwise. See the command `outline-mode' for more information on this mode." (interactive "P") (setq outline-minor-mode (if (null arg) (not outline-minor-mode) (> (prefix-numeric-value arg) 0))) (if outline-minor-mode (progn (setq selective-display t) (run-hooks 'outline-minor-mode-hook)) (setq selective-display nil)) ;; When turning off outline mode, get rid of any ^M's. (or outline-minor-mode (outline-flag-region (point-min) (point-max) ?\n)) (force-mode-line-update)) (defvar outline-level 'outline-level "Function of no args to compute a header's nesting level in an outline. It can assume point is at the beginning of a header line.") ;; This used to count columns rather than characters, but that made ^L ;; appear to be at level 2 instead of 1. Columns would be better for ;; tab handling, but the default regexp doesn't use tabs, and anyone ;; who changes the regexp can also redefine the outline-level variable ;; as appropriate. (defun outline-level () "Return the depth to which a statement is nested in the outline. Point must be at the beginning of a header line. This is actually the number of characters that `outline-regexp' matches." (save-excursion (looking-at outline-regexp) (- (match-end 0) (match-beginning 0)))) (defun outline-next-preface () "Skip forward to just before the next heading line. If there's no following heading line, stop before the newline at the end of the buffer." (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)") nil 'move) (goto-char (match-beginning 0))) (if (memq (preceding-char) '(?\n ?\^M)) (forward-char -1))) (defun outline-next-heading () "Move to the next (possibly invisible) heading line." (interactive) (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)") nil 'move) (goto-char (1+ (match-beginning 0))))) (defun outline-back-to-heading () "Move to previous heading line, or beg of this line if it's a heading. Only visible heading lines are considered." (beginning-of-line) (or (outline-on-heading-p) (re-search-backward (concat "^\\(" outline-regexp "\\)") nil t) (error "before first heading"))) (defun outline-on-heading-p () "Return t if point is on a (visible) heading line." (save-excursion (beginning-of-line) (and (bolp) (looking-at outline-regexp)))) (defun outline-end-of-heading () (if (re-search-forward outline-heading-end-regexp nil 'move) (forward-char -1))) (defun outline-next-visible-heading (arg) "Move to the next visible heading line. With argument, repeats or can move backward if negative. A heading line is one that starts with a `*' (or that `outline-regexp' matches)." (interactive "p") (if (< arg 0) (beginning-of-line) (end-of-line)) (or (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t arg) (error "")) (beginning-of-line)) (defun outline-previous-visible-heading (arg) "Move to the previous heading line. With argument, repeats or can move forward if negative. A heading line is one that starts with a `*' (or that `outline-regexp' matches)." (interactive "p") (outline-next-visible-heading (- arg))) (defun outline-flag-region (from to flag) "Hides or shows lines from FROM to TO, according to FLAG. If FLAG is `\\n' (newline character) then text is shown, while if FLAG is `\\^M' (control-M) the text is hidden." (let (buffer-read-only) (subst-char-in-region from to (if (= flag ?\n) ?\^M ?\n) flag t))) (defun hide-entry () "Hide the body directly following this heading." (interactive) (outline-back-to-heading) (outline-end-of-heading) (save-excursion (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M))) (defun show-entry () "Show the body directly following this heading." (interactive) (save-excursion (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\n))) (defun hide-body () "Hide all of buffer except headings." (interactive) (hide-region-body (point-min) (point-max))) (defun hide-region-body (start end) "Hide all body lines in the region, but not headings." (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) (if (outline-on-heading-p) (outline-end-of-heading)) (while (not (eobp)) (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M) (if (not (eobp)) (progn (forward-char (if (looking-at "[\n\^M][\n\^M]") 2 1)) (outline-end-of-heading))))))) (defun show-all () "Show all of the text in the buffer." (interactive) (outline-flag-region (point-min) (point-max) ?\n)) (defun hide-subtree () "Hide everything after this heading at deeper levels." (interactive) (outline-flag-subtree ?\^M)) (defun hide-leaves () "Hide all body after this heading at deeper levels." (interactive) (outline-back-to-heading) (outline-end-of-heading) (hide-region-body (point) (progn (outline-end-of-subtree) (point)))) (defun show-subtree () "Show everything after this heading at deeper levels." (interactive) (outline-flag-subtree ?\n)) (defun hide-sublevels (levels) "Hide everything but the top LEVELS levels of headers, in whole buffer." (interactive "p") (if (< levels 1) (error "Must keep at least one level of headers")) (setq levels (1- levels)) (save-excursion (goto-char (point-min)) ;; Keep advancing to the next top-level heading. (while (or (and (bobp) (outline-on-heading-p)) (outline-next-heading)) (let ((end (save-excursion (outline-end-of-subtree) (point)))) ;; Hide everything under that. (outline-flag-region (point) end ?\^M) ;; Show the first LEVELS levels under that. (if (> levels 0) (show-children levels)) ;; Move to the next, since we already found it. (goto-char end))))) (defun hide-other () "Hide everything except for the current body and the parent headings." (interactive) (hide-sublevels 1) (let ((last (point)) (pos (point))) (while (save-excursion (and (re-search-backward "[\n\r]" nil t) (eq (following-char) ?\r))) (save-excursion (beginning-of-line) (if (eq last (point)) (progn (outline-next-heading) (outline-flag-region last (point) ?\n)) (show-children) (setq last (point))))))) (defun outline-flag-subtree (flag) (save-excursion (outline-back-to-heading) (outline-end-of-heading) (outline-flag-region (point) (progn (outline-end-of-subtree) (point)) flag))) (defun outline-end-of-subtree () (outline-back-to-heading) (let ((opoint (point)) (first t) (level (funcall outline-level))) (while (and (not (eobp)) (or first (> (funcall outline-level) level))) (setq first nil) (outline-next-heading)) (if (memq (preceding-char) '(?\n ?\^M)) (progn ;; Go to end of line before heading (forward-char -1) (if (memq (preceding-char) '(?\n ?\^M)) ;; leave blank line before heading (forward-char -1)))))) (defun show-branches () "Show all subheadings of this heading, but not their bodies." (interactive) (show-children 1000)) (defun show-children (&optional level) "Show all direct subheadings of this heading. Prefix arg LEVEL is how many levels below the current level should be shown. Default is enough to cause the following heading to appear." (interactive "P") (setq level (if level (prefix-numeric-value level) (save-excursion (outline-back-to-heading) (let ((start-level (funcall outline-level))) (outline-next-heading) (if (eobp) 1 (max 1 (- (funcall outline-level) start-level))))))) (save-excursion (save-restriction (outline-back-to-heading) (setq level (+ level (funcall outline-level))) (narrow-to-region (point) (progn (outline-end-of-subtree) (if (eobp) (point-max) (1+ (point))))) (goto-char (point-min)) (while (and (not (eobp)) (progn (outline-next-heading) (not (eobp)))) (if (<= (funcall outline-level) level) (save-excursion (outline-flag-region (save-excursion (forward-char -1) (if (memq (preceding-char) '(?\n ?\^M)) (forward-char -1)) (point)) (progn (outline-end-of-heading) (point)) ?\n))))))) (defun outline-up-heading (arg) "Move to the heading line of which the present line is a subheading. With argument, move up ARG levels." (interactive "p") (outline-back-to-heading) (if (eq (funcall outline-level) 1) (error "")) (while (and (> (funcall outline-level) 1) (> arg 0) (not (bobp))) (let ((present-level (funcall outline-level))) (while (not (< (funcall outline-level) present-level)) (outline-previous-visible-heading 1)) (setq arg (- arg 1))))) (defun outline-forward-same-level (arg) "Move forward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading." (interactive "p") (outline-back-to-heading) (while (> arg 0) (let ((point-to-move-to (save-excursion (outline-get-next-sibling)))) (if point-to-move-to (progn (goto-char point-to-move-to) (setq arg (1- arg))) (progn (setq arg 0) (error "")))))) (defun outline-get-next-sibling () "Move to next heading of the same level, and return point or nil if none." (let ((level (funcall outline-level))) (outline-next-visible-heading 1) (while (and (> (funcall outline-level) level) (not (eobp))) (outline-next-visible-heading 1)) (if (< (funcall outline-level) level) nil (point)))) (defun outline-backward-same-level (arg) "Move backward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading." (interactive "p") (outline-back-to-heading) (while (> arg 0) (let ((point-to-move-to (save-excursion (outline-get-last-sibling)))) (if point-to-move-to (progn (goto-char point-to-move-to) (setq arg (1- arg))) (progn (setq arg 0) (error "")))))) (defun outline-get-last-sibling () "Move to next heading of the same level, and return point or nil if none." (let ((level (funcall outline-level))) (outline-previous-visible-heading 1) (while (and (> (funcall outline-level) level) (not (bobp))) (outline-previous-visible-heading 1)) (if (< (funcall outline-level) level) nil (point)))) (provide 'outline) ;;; outline.el ends here emacs-19.30/lisp/page-ext.el100444 75424 13 67151 5561560706 14107 0ustar kwzhuser;;; page-ext.el --- extended page handling commands ;; You may use these commands to handle an address list or other ;; small data base. ;; Copyright (C) 1990, 1991, 1993, 1994 Free Software Foundation ;; Maintainer: Robert J. Chassell ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Summary ; The current page commands are: ; forward-page C-x ] ; backward-page C-x [ ; narrow-to-page C-x p ; count-lines-page C-x l ; mark-page C-x C-p (change this to C-x C-p C-m) ; sort-pages not bound ; what-page not bound ; The new page handling commands all use `C-x C-p' as a prefix. This ; means that the key binding for `mark-page' must be changed. ; Otherwise, no other changes are made to the current commands or ; their bindings. ; New page handling commands: ; next-page C-x C-p C-n ; previous-page C-x C-p C-p ; search-pages C-x C-p C-s ; add-new-page C-x C-p C-a ; sort-pages-buffer C-x C-p s ; set-page-delimiter C-x C-p C-l ; pages-directory C-x C-p C-d ; pages-directory-for-addresses C-x C-p d ; pages-directory-goto C-c C-c ;;; Using the page commands ; The page commands are helpful in several different contexts. For ; example, programmers often divide source files into sections using the ; `page-delimiter'; you can use the `pages-directory' command to list ; the sections. ; You may change the buffer local value of the `page-delimiter' with ; the `set-page-delimiter' command. This command is bound to `C-x C-p ; C-l' The command prompts you for a new value for the page-delimiter. ; Called with a prefix-arg, the command resets the value of the ; page-delimiter to its original value. ; You may set several user options: ; ; The `pages-directory-buffer-narrowing-p' variable causes the ; `pages-directory-goto' command to narrow to the destination page. ; ; The `pages-directory-for-adding-page-narrowing-p' variable, causes the ; `add-new-page' command to narrow to the new entry. ; ; The `pages-directory-for-adding-new-page-before-current-page-p' variable ; causes the `add-new-page' command to insert a new page before current ; page. ; ; These variables are true by default. ; ; Additional, addresses-related user options are described in the next page ; of this file. ;;; Handling an address list or small data base ; You may use the page commands to handle an address list or other ; small data base. Put each address or entry on its own page. The ; first line of text in each page is a `header line' and is listed by ; the `pages-directory' or `pages-directory-for-addresses' command. ; Specifically: ; ; 1. Begin each entry with a `page-delimiter' (which is, by default, ; `^L' at the beginning of the line). ; ; 2. The first line of text in each entry is the `heading line'; it ; will appear in the pages-directory-buffer which is constructed ; using the `C-x C-p C-d' (pages-directory) command or the `C-x ; C-p d' (pages-directory-for-addresses) command. ; ; The heading line may be on the same line as the page-delimiter ; or it may follow after. It is the first non-blank line on the ; page. Conventionally, the heading line is placed on the line ; immediately following the line containing page-delimiter. ; ; 3. Follow the heading line with the body of the entry. The body ; extends up to the next `page-delimiter'. The body may be of any ; length. It is conventional to place a blank line after the last ; line of the body. ; For example, a file might look like this: ; ; FSF ; Free Software Foundation ; 675 Massachusetts Avenue ; Cambridge, MA 02139 USA ; (617) 876-3296 ; gnu@prep.ai.mit.edu ; ; ; House Subcommittee on Intellectual Property, ; U.S. House of Representatives, ; Washington, DC 20515 ; ; Congressional committee concerned with permitting or preventing ; monopolistic restrictions on the use of software technology. ; ; ; George Lakoff ; ``Women, Fire, and Dangerous Things: ; What Categories Reveal about the Mind'' ; 1987, Univ. of Chicago Press ; ; About philosophy, Whorfian effects, and linguistics. ; ; ; OBI (On line text collection.) ; Open Book Initiative ; c/o Software Tool & Die ; 1330 Beacon St, Brookline, MA 02146 USA ; (617) 739-0202 ; obi@world.std.com ; In this example, the heading lines are: ; ; FSF ; House Subcommittee on Intellectual Property ; George Lakoff ; OBI (On line text collection.) ; The `C-x C-p s' (sort-pages-buffer) command sorts the entries in the ; buffer alphabetically. ; You may use any of the page commands, including the `next-page', ; `previous-page', `add-new-page', `mark-page', and `search-pages' ; commands. ; You may use either the `C-x C-p d' (pages-directory-for-addresses) ; or the `C-x C-p C-d' (pages-directory) command to construct and ; dislay a directory of all the heading lines. ; In the directory, you may position the cursor over a heading line ; and type `C-c C-c' (pages-directory-goto) to go to the entry to ; which it refers in the pages buffer. ; You can type `C-c C-p C-a' (add-new-page) to add a new entry in the ; pages buffer or address file. This is the same command you use to ; add a new entry when you are in the pages buffer or address file. ; If you wish, you may create several different directories, ; one for each different buffer. ;; `pages-directory-for-addresses' in detail ; The `pages-directory-for-addresses' assumes a default addresses ; file. You do not need to specify the addresses file but merely type ; `C-x C-p d' from any buffer. The command finds the file, constructs ; a directory for it, and switches you to the directory. If you call ; the command with a prefix arg, `C-u C-x C-p d', it prompts you for a ; file name. ; You may customize the addresses commands: ; The `pages-addresses-file-name' variable determines the name of ; the addresses file; by default it is "~/addresses". ; The `pages-directory-for-addresses-goto-narrowing-p' variable ; determines whether `pages-directory-goto' narrows the addresses ; buffer to the entry, which it does by default. ; The `pages-directory-for-addresses-buffer-keep-windows-p' variable ; determines whether `pages-directory-for-addresses' deletes other ; windows to show as many lines as possible on the screen or works ; in the usual Emacs manner and keeps other windows. Default is to ; keep other windows. ; The `pages-directory-for-adding-addresses-narrowing-p' variable ; determines whether `pages-directory-for-addresses' narrows the ; addresses buffer to a new entry when you are adding that entry. ; Default is to narrow to new entry, which means you see a blank ; screen before you write the new entry. ;; `pages-directory' in detail ; Call the `pages-directory' command from the buffer for which you ; want a directory created; it creates a directory for the buffer and ; pops you to the directory. ; The `pages-directory' command has several options: ; Called with a prefix arg, `C-u C-x C-p C-d', the `pages-directory' ; prompts you for a regular expression and only lists only those ; header lines that are part of pages that contain matches to the ; regexp. In the example above, `C-u C-x C-p C-d 617 RET' would ; match the telephone area code of the first and fourth entries, so ; only the header lines of those two entries would appear in the ; pages-directory-buffer. ; ; Called with a numeric argument, the `pages-directory' command ; lists the number of lines in each page. This is helpful when you ; are printing hardcopy. ; Called with a negative numeric argument, the `pages-directory' ; command lists the lengths of pages whose contents match a regexp. ;;; Code: ;;; Customarily customizable variable definitions (defvar pages-directory-buffer-narrowing-p t "*If non-nil, `pages-directory-goto' narrows pages buffer to entry.") (defvar pages-directory-for-adding-page-narrowing-p t "*If non-nil, `add-new-page' narrows page buffer to new entry.") (defvar pages-directory-for-adding-new-page-before-current-page-p t "*If non-nil, `add-new-page' inserts new page before current page.") ;;; Addresses related variables (defvar pages-addresses-file-name "~/addresses" "*Standard name for file of addresses. Entries separated by page-delimiter. Used by `pages-directory-for-addresses' function.") (defvar pages-directory-for-addresses-goto-narrowing-p t "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry.") (defvar pages-directory-for-addresses-buffer-keep-windows-p t "*If nil, `pages-directory-for-addresses' deletes other windows.") (defvar pages-directory-for-adding-addresses-narrowing-p t "*If non-nil, `add-new-page' narrows addresses buffer to new entry.") ;;; Key bindings for page handling functions (global-unset-key "\C-x\C-p") (defvar ctl-x-ctl-p-map (make-sparse-keymap) "Keymap for subcommands of C-x C-p, which are for page handling.") (define-key ctl-x-map "\C-p" 'ctl-x-ctl-p-prefix) (fset 'ctl-x-ctl-p-prefix ctl-x-ctl-p-map) (define-key ctl-x-ctl-p-map "\C-n" 'next-page) (define-key ctl-x-ctl-p-map "\C-p" 'previous-page) (define-key ctl-x-ctl-p-map "\C-a" 'add-new-page) (define-key ctl-x-ctl-p-map "\C-m" 'mark-page) (define-key ctl-x-ctl-p-map "\C-s" 'search-pages) (define-key ctl-x-ctl-p-map "s" 'sort-pages-buffer) (define-key ctl-x-ctl-p-map "\C-l" 'set-page-delimiter) (define-key ctl-x-ctl-p-map "\C-d" 'pages-directory) (define-key ctl-x-ctl-p-map "d" 'pages-directory-for-addresses) ;;; Page movement function definitions (defun next-page (&optional count) "Move to the next page bounded by the `page-delimiter' variable. With arg (prefix if interactive), move that many pages." (interactive "p") (or count (setq count 1)) (widen) ;; Cannot use forward-page because of problems at page boundaries. (while (and (> count 0) (not (eobp))) (if (re-search-forward page-delimiter nil t) nil (goto-char (point-max))) (setq count (1- count))) ;; If COUNT is negative, we want to go back -COUNT + 1 page boundaries. ;; The first page boundary we reach is the top of the current page, ;; which doesn't count. (while (and (< count 1) (not (bobp))) (if (re-search-backward page-delimiter nil t) (goto-char (match-beginning 0)) (goto-char (point-min))) (setq count (1+ count))) (narrow-to-page) (goto-char (point-min)) (recenter 0)) (defun previous-page (&optional count) "Move to the previous page bounded by the `page-delimiter' variable. With arg (prefix if interactive), move that many pages." (interactive "p") (or count (setq count 1)) (next-page (- count))) ;;; Adding and searching pages (defun add-new-page (header-line) "Insert new page. Prompt for header line. If point is in the pages directory buffer, insert the new page in the buffer associated with the directory. Insert the new page just before current page if pages-directory-for-adding-new-page-before-current-page-p variable is non-nil. Else insert at exact location of point. Narrow to new page if pages-directory-for-adding-page-narrowing-p variable is non-nil. Page begins with a `^L' as the default page-delimiter. Use \\[set-page-delimiter] to change the page-delimiter. Point is left in the body of page." (interactive "sHeader line: ") (widen) ;; If in pages directory buffer (if (eq major-mode 'pages-directory-mode) (progn ;; Add new page before or after current page? (if pages-directory-for-adding-new-page-before-current-page-p (pages-directory-goto) (pages-directory-goto) (forward-page) (or (eobp) (forward-line -1))))) (widen) ;; Move point before current delimiter if desired. (and pages-directory-for-adding-new-page-before-current-page-p (if (re-search-backward page-delimiter nil t) (goto-char (match-beginning 0)) ;; If going to beginning of file, insert a page-delimiter ;; before current first page. (goto-char (point-min)) (insert (format "%s\n" ;; Remove leading `^' from page-delimiter string (if (eq '^ (car (read-from-string page-delimiter))) (substring page-delimiter 1)))) (goto-char (point-min)))) ;; Insert page delimiter at beginning of line. (if (not (looking-at "^.")) (forward-line 1)) (insert (format "%s\n%s\n\n\n" (if (eq '^ (car (read-from-string page-delimiter))) (substring page-delimiter 1)) header-line)) (forward-line -1) (and pages-directory-for-adding-page-narrowing-p (narrow-to-page))) (defvar pages-last-search nil "Value of last regexp searched for. Initially, nil.") (defun search-pages (regexp) "Search for REGEXP, starting from point, and narrow to page it is in." (interactive (list (read-string (format "Search for `%s' (end with RET): " (or pages-last-search "regexp"))))) (if (equal regexp "") (setq regexp pages-last-search) (setq pages-last-search regexp)) (widen) (re-search-forward regexp) (narrow-to-page)) ;;; Sorting pages (autoload 'sort-subr "sort" "Primary function for sorting." t nil) (defun sort-pages-in-region (reverse beg end) "Sort pages in region alphabetically. Prefix arg means reverse order. Called from a program, there are three arguments: REVERSE (non-nil means reverse order), BEG and END (region to sort)." ;;; This sort function handles ends of pages differently than ;;; `sort-pages' and works better with lists of addresses and similar ;;; files. (interactive "P\nr") (save-restriction (narrow-to-region beg end) (goto-char (point-min)) ;;; `sort-subr' takes three arguments (sort-subr reverse ;; NEXTRECFUN is called with point at the end of the ;; previous record. It moves point to the start of the ;; next record. (function (lambda () (re-search-forward page-delimiter nil t) (skip-chars-forward " \t\n") )) ;; ENDRECFUN is is called with point within the record. ;; It should move point to the end of the record. (function (lambda () (if (re-search-forward page-delimiter nil t) (goto-char (match-beginning 0)) (goto-char (point-max)))))))) (defun sort-pages-buffer (&optional reverse) "Sort pages alphabetically in buffer. Prefix arg means reverse order. \(Non-nil arg if not interactive.\)" (interactive "P") (or reverse (setq reverse nil)) (widen) (let ((beginning (point-min)) (end (point-max))) (sort-pages-in-region reverse beginning end))) ;;; Pages directory ancillary definitions (defvar pages-directory-previous-regexp nil "Value of previous regexp used by `pages-directory'. \(This regular expression may be used to select only those pages that contain matches to the regexp.\)") (defvar pages-buffer nil "The buffer for which the pages-directory function creates the directory.") (defvar pages-directory-prefix "*Directory for:" "Prefix of name of temporary buffer for pages-directory.") (defvar pages-pos-list nil "List containing the positions of the pages in the pages-buffer.") (defvar pages-directory-map nil "Keymap for the pages-directory-buffer.") (if pages-directory-map () (setq pages-directory-map (make-sparse-keymap)) (define-key pages-directory-map "\C-c\C-c" 'pages-directory-goto) (define-key pages-directory-map "\C-c\C-p\C-a" 'add-new-page)) (defvar original-page-delimiter "^\f" "Default page delimiter.") (defun set-page-delimiter (regexp reset-p) "Set buffer local value of page-delimiter to REGEXP. Called interactively with a prefix argument, reset `page-delimiter' to its original value. In a program, non-nil second arg causes first arg to be ignored and resets the page-delimiter to the original value." (interactive (if current-prefix-arg (list original-page-delimiter "^\f") (list (read-string "Set page-delimiter to regexp: " page-delimiter) nil))) (make-local-variable 'original-page-delimiter) (make-local-variable 'page-delimiter) (setq original-page-delimiter (or original-page-delimiter page-delimiter)) (if (not reset-p) (setq page-delimiter regexp) (setq page-delimiter original-page-delimiter)) (if (interactive-p) (message "The value of `page-delimiter' is now: %s" page-delimiter))) ;;; Pages directory main definitions (defun pages-directory (pages-list-all-headers-p count-lines-p &optional regexp) "Display a directory of the page headers in a temporary buffer. A header is the first non-blank line after the page-delimiter. \\[pages-directory-mode] You may move point to one of the lines in the temporary buffer, then use \\ to go to the same line in the pages buffer. In interactive use: 1. With no prefix arg, display all headers. 2. With prefix arg, display the headers of only those pages that contain matches to a regular expression for which you are prompted. 3. With numeric prefix arg, for every page, print the number of lines within each page. 4. With negative numeric prefix arg, for only those pages that match a regular expression, print the number of lines within each page. When called from a program, non-nil first arg means list all headers; non-nil second arg means print numbers of lines in each page; if first arg is nil, optional third arg is regular expression. If the buffer is narrowed, the `pages-directory' command creates a directory for only the accessible portion of the buffer." (interactive (cond ((not current-prefix-arg) (list t nil nil)) ((listp current-prefix-arg) (list nil nil (read-string (format "Select according to `%s' (end with RET): " (or pages-directory-previous-regexp "regexp"))))) ((> (prefix-numeric-value current-prefix-arg) 0) (list t t nil)) ((< (prefix-numeric-value current-prefix-arg) 0) (list nil t (read-string (format "Select according to `%s' (end with RET): " (or pages-directory-previous-regexp "regexp"))))))) (if (equal regexp "") (setq regexp pages-directory-previous-regexp) (setq pages-directory-previous-regexp regexp)) (if (interactive-p) (message "Creating directory for: %s " (buffer-name))) (let ((target-buffer (current-buffer)) (pages-directory-buffer (concat pages-directory-prefix " " (buffer-name))) (linenum 1) (pages-buffer-original-position (point)) (pages-buffer-original-page 0)) ;; `with-output-to-temp-buffer' binds the value of the variable ;; `standard-output' to the buffer named as its first argument, ;; but does not switch to that buffer. (with-output-to-temp-buffer pages-directory-buffer (save-excursion (set-buffer standard-output) (pages-directory-mode) (insert "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n) (setq pages-buffer target-buffer) (setq pages-pos-list nil)) (if pages-list-all-headers-p ;; 1. If no prefix argument, list all headers (save-excursion (goto-char (point-min)) ;; (a) Point is at beginning of buffer; but the first ;; page may not begin with a page-delimiter (save-restriction ;; If page delimiter is at beginning of buffer, skip it (if (and (save-excursion (re-search-forward page-delimiter nil t)) (= 1 (match-beginning 0))) (goto-char (match-end 0))) (narrow-to-page) (pages-copy-header-and-position count-lines-p)) ;; (b) Search within pages buffer for next page-delimiter (while (re-search-forward page-delimiter nil t) (pages-copy-header-and-position count-lines-p))) ;; 2. Else list headers whose pages match regexp. (save-excursion ;; REMOVED save-restriction AND widen FROM HERE (goto-char (point-min)) ;; (a) Handle first page (save-restriction (narrow-to-page) ;; search for selection regexp (if (save-excursion (re-search-forward regexp nil t)) (pages-copy-header-and-position count-lines-p))) ;; (b) Search for next page-delimiter (while (re-search-forward page-delimiter nil t) (save-restriction (narrow-to-page) ;; search for selection regexp (if (save-excursion (re-search-forward regexp nil t)) (pages-copy-header-and-position count-lines-p) ))))) (set-buffer standard-output) ;; Put positions in increasing order to go with buffer. (setq pages-pos-list (nreverse pages-pos-list)) (if (interactive-p) (message "%d matching lines in: %s" (length pages-pos-list) (buffer-name target-buffer)))) (pop-to-buffer pages-directory-buffer) (sit-for 0) ; otherwise forward-line fails if N > window height. (forward-line (if (= 0 pages-buffer-original-page) 1 pages-buffer-original-page)))) (defun pages-copy-header-and-position (count-lines-p) "Copy page header and its position to the Pages Directory. Only arg non-nil, count lines in page and insert before header. Used by `pages-directory' function." (let (position line-count) (if count-lines-p (save-excursion (save-restriction (narrow-to-page) (setq line-count (count-lines (point-min) (point-max)))))) ;; Keep track of page for later cursor positioning (if (<= (point) pages-buffer-original-position) (setq pages-buffer-original-page (1+ pages-buffer-original-page))) (save-excursion ;; go to first non-blank char after the page-delimiter (skip-chars-forward " \t\n") ;; set the marker here; this the place to which the ;; `pages-directory-goto' command will go (setq position (make-marker)) (set-marker position (point)) (let ((start (point)) (end (save-excursion (end-of-line) (point)))) ;; change to directory buffer (set-buffer standard-output) ;; record page position (setq pages-pos-list (cons position pages-pos-list)) ;; insert page header (insert-buffer-substring target-buffer start end)) (if count-lines-p (save-excursion (beginning-of-line) (insert (format "%3d: " line-count)))) (terpri)) (end-of-line 1))) (defun pages-directory-mode () "Mode for handling the pages-directory buffer. Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go to the same line in the pages buffer." (kill-all-local-variables) (use-local-map pages-directory-map) (setq major-mode 'pages-directory-mode) (setq mode-name "Pages-Directory") (make-local-variable 'pages-buffer) (make-local-variable 'pages-pos-list) (make-local-variable 'pages-directory-buffer-narrowing-p)) (defun pages-directory-goto () "Go to the corresponding line in the pages buffer." ;;; This function is mostly a copy of `occur-mode-goto-occurrence' (interactive) (if (or (not pages-buffer) (not (buffer-name pages-buffer))) (progn (setq pages-buffer nil pages-pos-list nil) (error "Buffer in which pages were found is deleted."))) (beginning-of-line) (let* ((pages-number (1- (count-lines (point-min) (point)))) (pos (nth pages-number pages-pos-list)) (end-of-directory-p (eobp)) (narrowing-p pages-directory-buffer-narrowing-p)) (pop-to-buffer pages-buffer) (widen) (if end-of-directory-p (goto-char (point-max)) (goto-char (marker-position pos))) (if narrowing-p (narrow-to-page)))) ;;; The `pages-directory-for-addresses' function and ancillary code (defun pages-directory-for-addresses (&optional filename) "Find addresses file and display its directory. By default, create and display directory of `pages-addresses-file-name'. Optional argument is FILENAME. In interactive use, with prefix argument, prompt for file name and provide completion. Move point to one of the lines in the displayed directory, then use \\[pages-directory-goto] to go to the same line in the addresses buffer. If pages-directory-for-addresses-goto-narrowing-p is non-nil, `pages-directory-goto' narrows addresses buffer to entry. If pages-directory-for-addresses-buffer-keep-windows-p is nil, this command deletes other windows when it displays the addresses directory." (interactive (list (if current-prefix-arg (read-file-name "Filename: " pages-addresses-file-name)))) (if (interactive-p) (message "Creating directory for: %s " (or filename pages-addresses-file-name))) (if (file-exists-p (or filename pages-addresses-file-name)) (progn (set-buffer (find-file-noselect (expand-file-name (or filename pages-addresses-file-name)))) (widen) (pages-directory t nil nil) (pages-directory-address-mode) (setq pages-directory-buffer-narrowing-p pages-directory-for-addresses-goto-narrowing-p) (or pages-directory-for-addresses-buffer-keep-windows-p (delete-other-windows)) (save-excursion (goto-char (point-min)) (delete-region (point) (save-excursion (end-of-line) (point))) (insert "=== Address List Directory: use `C-c C-c' to go to page under cursor. ===") (set-buffer-modified-p nil) )) (error "No addresses file found!"))) (defun pages-directory-address-mode () "Mode for handling the Addresses Directory buffer. Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go to the same line in the pages buffer." (use-local-map pages-directory-map) (setq major-mode 'pages-directory-address-mode) (setq mode-name "Addresses Directory") (make-local-variable 'pages-buffer) (make-local-variable 'pages-pos-list) (make-local-variable 'pages-directory-buffer-narrowing-p)) ;;; Place `provide' at end of file. (provide 'page-ext) ;;;;;;;;;;;;;;;; end of page-ext.el ;;;;;;;;;;;;;;;; emacs-19.30/lisp/page.el100444 12120 1 11447 5635736632 13353 0ustar rmsdaemon;;; page.el --- page motion commands for emacs. ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; 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 code provides the page-oriented movement and selection commands ;; documented in the Emacs manual. ;;; Code: (defun forward-page (&optional count) "Move forward to page boundary. With arg, repeat, or go back if negative. A page boundary is any line whose beginning matches the regexp `page-delimiter'." (interactive "p") (or count (setq count 1)) (while (and (> count 0) (not (eobp))) ;; In case the page-delimiter matches the null string, ;; don't find a match without moving. (if (bolp) (forward-char 1)) (if (re-search-forward page-delimiter nil t) nil (goto-char (point-max))) (setq count (1- count))) (while (and (< count 0) (not (bobp))) (forward-char -1) (let (result (end (point))) ;; If we find a match that ends where we started searching, ;; look for another one. (while (and (setq result (re-search-backward page-delimiter nil t)) (= (match-end 0) end)) ;; Just search again. ) (if result ;; We found one--move to the end of it. (goto-char (match-end 0)) ;; We found nothing--go to beg of buffer. (goto-char (point-min)))) (setq count (1+ count)))) (defun backward-page (&optional count) "Move backward to page boundary. With arg, repeat, or go fwd if negative. A page boundary is any line whose beginning matches the regexp `page-delimiter'." (interactive "p") (or count (setq count 1)) (forward-page (- count))) (defun mark-page (&optional arg) "Put mark at end of page, point at beginning. A numeric arg specifies to move forward or backward by that many pages, thus marking a page other than the one point was originally in." (interactive "P") (setq arg (if arg (prefix-numeric-value arg) 0)) (if (> arg 0) (forward-page arg) (if (< arg 0) (forward-page (1- arg)))) (forward-page) (push-mark nil t t) (forward-page -1)) (defun narrow-to-page (&optional arg) "Make text outside current page invisible. A numeric arg specifies to move forward or backward by that many pages, thus showing a page other than the one point was originally in." (interactive "P") (setq arg (if arg (prefix-numeric-value arg) 0)) (save-excursion (widen) (if (> arg 0) (forward-page arg) (if (< arg 0) (forward-page (1- arg)))) ;; Find the end of the page. (forward-page) ;; If we stopped due to end of buffer, stay there. ;; If we stopped after a page delimiter, put end of restriction ;; at the beginning of that line. (if (save-excursion (goto-char (match-beginning 0)) ; was (beginning-of-line) (looking-at page-delimiter)) (beginning-of-line)) (narrow-to-region (point) (progn ;; Find the top of the page. (forward-page -1) ;; If we found beginning of buffer, stay there. ;; If extra text follows page delimiter on same line, ;; include it. ;; Otherwise, show text starting with following line. (if (and (eolp) (not (bobp))) (forward-line 1)) (point))))) (put 'narrow-to-page 'disabled t) (defun count-lines-page () "Report number of lines on current page, and how many are before or after point." (interactive) (save-excursion (let ((opoint (point)) beg end total before after) (forward-page) (beginning-of-line) (or (looking-at page-delimiter) (end-of-line)) (setq end (point)) (backward-page) (setq beg (point)) (setq total (count-lines beg end) before (count-lines beg opoint) after (count-lines opoint end)) (message "Page has %d lines (%d + %d)" total before after)))) (defun what-page () "Print page and line number of point." (interactive) (save-restriction (widen) (save-excursion (beginning-of-line) (let ((count 1) (opoint (point))) (goto-char 1) (while (re-search-forward page-delimiter opoint t) (setq count (1+ count))) (message "Page %d, line %d" count (1+ (count-lines (point) opoint))))))) ;;; Place `provide' at end of file. (provide 'page) ;;; page.el ends here emacs-19.30/lisp/paragraphs.el100444 12120 1 31214 6011615724 14544 0ustar rmsdaemon;;; paragraphs.el --- paragraph and sentence parsing. ;; Copyright (C) 1985, 86, 87, 91, 94, 95 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: wp ;; 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 package provides the paragraph-oriented commands documented in the ;; Emacs manual. ;;; Code: (defvar use-hard-newlines nil "Non-nil means to distinguish hard and soft newlines. When this is non-nil, the functions `newline' and `open-line' add the text-property `hard' to newlines that they insert. Also, a line is only considered as a candidate to match `paragraph-start' or `paragraph-separate' if it follows a hard newline. Newlines not marked hard are called \"soft\", and are always internal to paragraphs. The fill functions always insert soft newlines. Each buffer has its own value of this variable.") (make-variable-buffer-local 'use-hard-newlines) (defconst paragraph-start "[ \t\n\f]" "\ *Regexp for beginning of a line that starts OR separates paragraphs. This regexp should match lines that separate paragraphs and should also match lines that start a paragraph \(and are part of that paragraph). This is matched against the text at the left margin, which is not necessarily the beginning of the line, so it should never use \"^\" as an anchor. This ensures that the paragraph functions will work equally well within a region of text indented by a margin setting. The variable `paragraph-separate' specifies how to distinguish lines that start paragraphs from lines that separate them. If the variable `use-hard-newlines' is nonnil, then only lines following a hard newline are considered to match.") ;; paragraph-start requires a hard newline, but paragraph-separate does not: ;; It is assumed that paragraph-separate is distinctive enough to be believed ;; whenever it occurs, while it is reasonable to set paragraph-start to ;; something very minimal, even including "." (which makes every hard newline ;; start a new paragraph). (defconst paragraph-separate "[ \t\f]*$" "\ *Regexp for beginning of a line that separates paragraphs. If you change this, you may have to change paragraph-start also. This is matched against the text at the left margin, which is not necessarily the beginning of the line, so it should not use \"^\" as an anchor. This ensures that the paragraph functions will work equally within a region of text indented by a margin setting.") (defconst sentence-end (purecopy "[.?!][]\"')}]*\\($\\| $\\|\t\\| \\)[ \t\n]*") "\ *Regexp describing the end of a sentence. All paragraph boundaries also end sentences, regardless. In order to be recognized as the end of a sentence, the ending period, question mark, or exclamation point must be followed by two spaces, unless it's inside some sort of quotes or parenthesis.") (defconst page-delimiter "^\014" "\ *Regexp describing line-beginnings that separate pages.") (defvar paragraph-ignore-fill-prefix nil "\ Non-nil means the paragraph commands are not affected by `fill-prefix'. This is desirable in modes where blank lines are the paragraph delimiters.") (defun forward-paragraph (&optional arg) "Move forward to end of paragraph. With arg N, do it N times; negative arg -N means move backward N paragraphs. A line which `paragraph-start' matches either separates paragraphs \(if `paragraph-separate' matches it also) or is the first line of a paragraph. A paragraph end is the beginning of a line which is not part of the paragraph to which the end of the previous line belongs, or the end of the buffer." (interactive "p") (or arg (setq arg 1)) (let* ((fill-prefix-regexp (and fill-prefix (not (equal fill-prefix "")) (not paragraph-ignore-fill-prefix) (regexp-quote fill-prefix))) ;; Remove ^ from paragraph-start and paragraph-sep if they are there. ;; These regexps shouldn't be anchored, because we look for them ;; starting at the left-margin. This allows paragraph commands to ;; work normally with indented text. ;; This hack will not find problem cases like "whatever\\|^something". (paragraph-start (if (and (not (equal "" paragraph-start)) (equal ?^ (aref paragraph-start 0))) (substring paragraph-start 1) paragraph-start)) (paragraph-separate (if (and (not (equal "" paragraph-start)) (equal ?^ (aref paragraph-separate 0))) (substring paragraph-separate 1) paragraph-separate)) (paragraph-separate (if fill-prefix-regexp (concat paragraph-separate "\\|" fill-prefix-regexp "[ \t]*$") paragraph-separate)) ;; This is used for searching. (sp-paragraph-start (concat "^[ \t]*\\(" paragraph-start "\\)")) start) (while (and (< arg 0) (not (bobp))) (if (and (not (looking-at paragraph-separate)) (re-search-backward "^\n" (max (1- (point)) (point-min)) t) (looking-at paragraph-separate)) nil (setq start (point)) ;; Move back over paragraph-separating lines. (forward-char -1) (beginning-of-line) (while (and (not (bobp)) (progn (move-to-left-margin) (looking-at paragraph-separate))) (forward-line -1)) (if (bobp) nil ;; Go to end of the previous (non-separating) line. (end-of-line) ;; Search back for line that starts or separates paragraphs. (if (if fill-prefix-regexp ;; There is a fill prefix; it overrides paragraph-start. (let (multiple-lines) (while (and (progn (beginning-of-line) (not (bobp))) (progn (move-to-left-margin) (not (looking-at paragraph-separate))) (looking-at fill-prefix-regexp)) (if (not (= (point) start)) (setq multiple-lines t)) (forward-line -1)) (move-to-left-margin) ;; Don't move back over a line before the paragraph ;; which doesn't start with fill-prefix ;; unless that is the only line we've moved over. (and (not (looking-at fill-prefix-regexp)) multiple-lines (forward-line 1)) (not (bobp))) (while (and (re-search-backward sp-paragraph-start nil 1) ;; Found a candidate, but need to check if it is a ;; REAL paragraph-start. (not (bobp)) (progn (setq start (point)) (move-to-left-margin) (not (looking-at paragraph-separate))) (or (not (looking-at paragraph-start)) (and use-hard-newlines (not (get-text-property (1- start) 'hard))))) (goto-char start)) (> (point) (point-min))) ;; Found one. (progn ;; Move forward over paragraph separators. ;; We know this cannot reach the place we started ;; because we know we moved back over a non-separator. (while (and (not (eobp)) (progn (move-to-left-margin) (looking-at paragraph-separate))) (forward-line 1)) ;; If line before paragraph is just margin, back up to there. (end-of-line 0) (if (> (current-column) (current-left-margin)) (forward-char 1) (skip-chars-backward " \t") (if (not (bolp)) (forward-line 1)))) ;; No starter or separator line => use buffer beg. (goto-char (point-min))))) (setq arg (1+ arg))) (while (and (> arg 0) (not (eobp))) (while (prog1 (and (not (eobp)) (progn (move-to-left-margin) (not (eobp))) (looking-at paragraph-separate)) (forward-line 1))) (if fill-prefix-regexp ;; There is a fill prefix; it overrides paragraph-start. (while (and (not (eobp)) (progn (move-to-left-margin) (not (eobp))) (not (looking-at paragraph-separate)) (looking-at fill-prefix-regexp)) (forward-line 1)) (while (and (re-search-forward sp-paragraph-start nil 1) (progn (setq start (match-beginning 0)) (goto-char start) (not (eobp))) (progn (move-to-left-margin) (not (looking-at paragraph-separate))) (or (not (looking-at paragraph-start)) (and use-hard-newlines (not (get-text-property (1- start) 'hard))))) (forward-char 1)) (if (< (point) (point-max)) (goto-char start))) (setq arg (1- arg))))) (defun backward-paragraph (&optional arg) "Move backward to start of paragraph. With arg N, do it N times; negative arg -N means move forward N paragraphs. A paragraph start is the beginning of a line which is a `first-line-of-paragraph' or which is ordinary text and follows a paragraph-separating line; except: if the first real line of a paragraph is preceded by a blank line, the paragraph starts at that blank line. See `forward-paragraph' for more information." (interactive "p") (or arg (setq arg 1)) (forward-paragraph (- arg))) (defun mark-paragraph () "Put point at beginning of this paragraph, mark at end. The paragraph marked is the one that contains point or follows point." (interactive) (forward-paragraph 1) (push-mark nil t t) (backward-paragraph 1)) (defun kill-paragraph (arg) "Kill forward to end of paragraph. With arg N, kill forward to Nth end of paragraph; negative arg -N means kill backward to Nth start of paragraph." (interactive "p") (kill-region (point) (progn (forward-paragraph arg) (point)))) (defun backward-kill-paragraph (arg) "Kill back to start of paragraph. With arg N, kill back to Nth start of paragraph; negative arg -N means kill forward to Nth end of paragraph." (interactive "p") (kill-region (point) (progn (backward-paragraph arg) (point)))) (defun transpose-paragraphs (arg) "Interchange this (or next) paragraph with previous one." (interactive "*p") (transpose-subr 'forward-paragraph arg)) (defun start-of-paragraph-text () (let ((opoint (point)) npoint) (forward-paragraph -1) (setq npoint (point)) (skip-chars-forward " \t\n") ;; If the range of blank lines found spans the original start point, ;; try again from the beginning of it. ;; Must be careful to avoid infinite loop ;; when following a single return at start of buffer. (if (and (>= (point) opoint) (< npoint opoint)) (progn (goto-char npoint) (if (> npoint (point-min)) (start-of-paragraph-text)))))) (defun end-of-paragraph-text () (let ((opoint (point))) (forward-paragraph 1) (if (eq (preceding-char) ?\n) (forward-char -1)) (if (<= (point) opoint) (progn (forward-char 1) (if (< (point) (point-max)) (end-of-paragraph-text)))))) (defun forward-sentence (&optional arg) "Move forward to next `sentence-end'. With argument, repeat. With negative argument, move backward repeatedly to `sentence-beginning'. The variable `sentence-end' is a regular expression that matches ends of sentences. Also, every paragraph boundary terminates sentences as well." (interactive "p") (or arg (setq arg 1)) (while (< arg 0) (let ((par-beg (save-excursion (start-of-paragraph-text) (point)))) (if (re-search-backward (concat sentence-end "[^ \t\n]") par-beg t) (goto-char (1- (match-end 0))) (goto-char par-beg))) (setq arg (1+ arg))) (while (> arg 0) (let ((par-end (save-excursion (end-of-paragraph-text) (point)))) (if (re-search-forward sentence-end par-end t) (skip-chars-backward " \t\n") (goto-char par-end))) (setq arg (1- arg)))) (defun backward-sentence (&optional arg) "Move backward to start of sentence. With arg, do it arg times. See `forward-sentence' for more information." (interactive "p") (or arg (setq arg 1)) (forward-sentence (- arg))) (defun kill-sentence (&optional arg) "Kill from point to end of sentence. With arg, repeat; negative arg -N means kill back to Nth start of sentence." (interactive "p") (kill-region (point) (progn (forward-sentence arg) (point)))) (defun backward-kill-sentence (&optional arg) "Kill back from point to start of sentence. With arg, repeat, or kill forward to Nth end of sentence if negative arg -N." (interactive "p") (kill-region (point) (progn (backward-sentence arg) (point)))) (defun mark-end-of-sentence (arg) "Put mark at end of sentence. Arg works as in `forward-sentence'." (interactive "p") (push-mark (save-excursion (forward-sentence arg) (point)) nil t)) (defun transpose-sentences (arg) "Interchange this (next) and previous sentence." (interactive "*p") (transpose-subr 'forward-sentence arg)) ;;; paragraphs.el ends here emacs-19.30/lisp/paren.el100444 75424 1 11743 6050716420 13726 0ustar kwzhdaemon;;; paren.el --- highlight matching paren. ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: rms@gnu.ai.mit.edu ;; 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: ;; Load this and it will display highlighting on whatever ;; paren matches the one before or after point. ;;; 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) (defvar show-paren-face 'region "*Name of face to use for showing the matching paren.") ;; Find the place to show, if there is one, ;; and show it until input arrives. (defun show-paren-command-hook () ;; Do nothing if no window system to display results with. ;; Do nothing if executing keyboard macro. ;; Do nothing if input is pending. (if window-system (let (pos dir mismatch (oldpos (point)) (face show-paren-face)) (cond ((eq (char-syntax (preceding-char)) ?\)) (setq dir -1)) ((eq (char-syntax (following-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 (not (eq (char-after (1- end)) ;; This can give nil. (matching-paren (char-after beg)))))))) ;; 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) (progn (add-to-list 'facemenu-unlisted-faces 'paren-mismatch) (make-face 'paren-mismatch) (or (face-nontrivial-p 'paren-mismatch t) (progn (set-face-background 'paren-mismatch "purple") (set-face-foreground 'paren-mismatch "white"))) (setq show-paren-mismatch-face 'paren-mismatch))) (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) (current-buffer)) (setq show-paren-overlay-1 (make-overlay (- pos dir) pos))) ;; Always set the overlay face, since it varies. (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 (current-buffer)) (setq show-paren-overlay (make-overlay (- pos dir) pos))) ;; Always set the overlay face, since it varies. (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-idle-hook 'show-paren-command-hook))) ;;; This is in case paren.el is preloaded. (add-hook 'window-setup-hook (function (lambda () (if window-system (progn (setq blink-paren-function nil) (add-hook 'post-command-idle-hook 'show-paren-command-hook)))))) (provide 'paren) ;;; paren.el ends here emacs-19.30/lisp/pascal.el100444 12120 1 153076 6045204356 13714 0ustar rmsdaemon;;; pascal.el --- major mode for editing pascal source in Emacs ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Espen Skoglund (espensk@stud.cs.uit.no) ;; Keywords: languages ;; This file is part of GNU Emacs. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; USAGE ;;; ===== ;;; Emacs should enter Pascal mode when you find a Pascal source file. ;;; When you have entered Pascal mode, you may get more info by pressing ;;; C-h m. You may also get online help describing various functions by: ;;; C-h f ;;; If you want to customize Pascal mode to fit you better, you may add ;;; these lines (the values of the variables presented here are the defaults): ;;; ;;; ;; User customization for Pascal mode ;;; (setq pascal-indent-level 3 ;;; pascal-case-indent 2 ;;; pascal-auto-newline nil ;;; pascal-tab-always-indent t ;;; pascal-auto-endcomments t ;;; pascal-auto-lineup '(all) ;;; pascal-toggle-completions nil ;;; pascal-type-keywords '("array" "file" "packed" "char" ;;; "integer" "real" "string" "record") ;;; pascal-start-keywords '("begin" "end" "function" "procedure" ;;; "repeat" "until" "while" "read" "readln" ;;; "reset" "rewrite" "write" "writeln") ;;; pascal-separator-keywords '("downto" "else" "mod" "div" "then")) ;;; KNOWN BUGS / BUGREPORTS ;;; ======================= ;;; As far as I know, there are no bugs in the current version of this ;;; package. This may not be true however, since I never use this mode ;;; myself and therefore would never notice them anyway. If you do ;;; find any bugs, you may submit them to: espensk@stud.cs.uit.no ;;; as well as to bug-gnu-emacs@prep.ai.mit.edu. ;;; Code: (defvar pascal-mode-abbrev-table nil "Abbrev table in use in Pascal-mode buffers.") (define-abbrev-table 'pascal-mode-abbrev-table ()) (defvar pascal-mode-map () "Keymap used in Pascal mode.") (if pascal-mode-map () (setq pascal-mode-map (make-sparse-keymap)) (define-key pascal-mode-map ";" 'electric-pascal-semi-or-dot) (define-key pascal-mode-map "." 'electric-pascal-semi-or-dot) (define-key pascal-mode-map ":" 'electric-pascal-colon) (define-key pascal-mode-map "=" 'electric-pascal-equal) (define-key pascal-mode-map "#" 'electric-pascal-hash) (define-key pascal-mode-map "\r" 'electric-pascal-terminate-line) (define-key pascal-mode-map "\t" 'electric-pascal-tab) (define-key pascal-mode-map "\M-\t" 'pascal-complete-word) (define-key pascal-mode-map "\M-?" 'pascal-show-completions) (define-key pascal-mode-map "\177" 'backward-delete-char-untabify) (define-key pascal-mode-map "\M-\C-h" 'pascal-mark-defun) (define-key pascal-mode-map "\C-c\C-b" 'pascal-insert-block) (define-key pascal-mode-map "\M-*" 'pascal-star-comment) (define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area) (define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area) (define-key pascal-mode-map "\M-\C-a" 'pascal-beg-of-defun) (define-key pascal-mode-map "\M-\C-e" 'pascal-end-of-defun) (define-key pascal-mode-map "\C-c\C-d" 'pascal-goto-defun) (define-key pascal-mode-map "\C-c\C-o" 'pascal-outline) ;;; A command to change the whole buffer won't be used terribly ;;; often, so no need for a key binding. ; (define-key pascal-mode-map "\C-cd" 'pascal-downcase-keywords) ; (define-key pascal-mode-map "\C-cu" 'pascal-upcase-keywords) ; (define-key pascal-mode-map "\C-cc" 'pascal-capitalize-keywords) ) (defvar pascal-imenu-generic-expression '("^[ \t]*\\(function\\|procedure\\)[ \t\n]+\\([a-zA-Z0-9_.:]+\\)" . (2)) "Imenu expression for Pascal-mode. See `imenu-generic-expression'.") (defvar pascal-keywords '("and" "array" "begin" "case" "const" "div" "do" "downto" "else" "end" "file" "for" "function" "goto" "if" "in" "label" "mod" "nil" "not" "of" "or" "packed" "procedure" "program" "record" "repeat" "set" "then" "to" "type" "until" "var" "while" "with" ;; The following are not standard in pascal, but widely used. "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write" "writeln")) ;;; ;;; Regular expressions used to calculate indent, etc. ;;; (defconst pascal-symbol-re "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>") (defconst pascal-beg-block-re "\\<\\(begin\\|case\\|record\\|repeat\\)\\>") (defconst pascal-end-block-re "\\<\\(end\\|until\\)\\>") (defconst pascal-declaration-re "\\<\\(const\\|label\\|type\\|var\\)\\>") (defconst pascal-defun-re "\\<\\(function\\|procedure\\|program\\)\\>") (defconst pascal-sub-block-re "\\<\\(if\\|else\\|for\\|while\\|with\\)\\>") (defconst pascal-noindent-re "\\<\\(begin\\|end\\|until\\|else\\)\\>") (defconst pascal-nosemi-re "\\<\\(begin\\|repeat\\|then\\|do\\|else\\)\\>") (defconst pascal-autoindent-lines-re "\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>") ;;; Strings used to mark beginning and end of excluded text (defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----") (defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}") (defvar pascal-mode-syntax-table nil "Syntax table in use in Pascal-mode buffers.") (if pascal-mode-syntax-table () (setq pascal-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?\\ "." pascal-mode-syntax-table) (modify-syntax-entry ?( "()1" pascal-mode-syntax-table) (modify-syntax-entry ?) ")(4" pascal-mode-syntax-table) (modify-syntax-entry ?* ". 23" pascal-mode-syntax-table) (modify-syntax-entry ?{ "<" pascal-mode-syntax-table) (modify-syntax-entry ?} ">" pascal-mode-syntax-table) (modify-syntax-entry ?+ "." pascal-mode-syntax-table) (modify-syntax-entry ?- "." pascal-mode-syntax-table) (modify-syntax-entry ?= "." pascal-mode-syntax-table) (modify-syntax-entry ?% "." pascal-mode-syntax-table) (modify-syntax-entry ?< "." pascal-mode-syntax-table) (modify-syntax-entry ?> "." pascal-mode-syntax-table) (modify-syntax-entry ?& "." pascal-mode-syntax-table) (modify-syntax-entry ?| "." pascal-mode-syntax-table) (modify-syntax-entry ?_ "w" pascal-mode-syntax-table) (modify-syntax-entry ?\' "\"" pascal-mode-syntax-table)) (defvar pascal-font-lock-keywords (list '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) ; ("type" "const" "real" "integer" "char" "boolean" "var" ; "record" "array" "file") (cons (concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|" "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>") 'font-lock-type-face) '("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-reference-face) '("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-reference-face) ; ("of" "to" "for" "if" "then" "else" "case" "while" ; "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end") (concat "\\<\\(" "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|" "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)" "\\)\\>") '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?" (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))) "Additional expressions to highlight in Pascal mode.") (defvar pascal-indent-level 3 "*Indentation of Pascal statements with respect to containing block.") (defvar pascal-case-indent 2 "*Indentation for case statements.") (defvar pascal-auto-newline nil "*Non-nil means automatically newline after simcolons and the punctation mark after an end.") (defvar pascal-tab-always-indent t "*Non-nil means TAB in Pascal mode should always reindent the current line, regardless of where in the line point is when the TAB command is used.") (defvar pascal-auto-endcomments t "*Non-nil means a comment { ... } is set after the ends which ends cases and functions. The name of the function or case will be set between the braces.") (defvar pascal-auto-lineup '(all) "*List of contexts where auto lineup of :'s or ='s should be done. Elements can be of type: 'paramlist', 'declaration' or 'case', which will do auto lineup in parameterlist, declarations or case-statements respectively. The word 'all' will do all lineups. '(case paramlist) for instance will do lineup in case-statements and parameterlist, while '(all) will do all lineups.") (defvar pascal-toggle-completions nil "*Non-nil means \\\\[pascal-complete-word] should try all possible completions one by one. Repeated use of \\[pascal-complete-word] will show you all of them. Normally, when there is more than one possible completion, it displays a list of all possible completions.") (defvar pascal-type-keywords '("array" "file" "packed" "char" "integer" "real" "string" "record") "*Keywords for types used when completing a word in a declaration or parmlist. \(eg. integer, real, char.) The types defined within the Pascal program will be completed runtime, and should not be added to this list.") (defvar pascal-start-keywords '("begin" "end" "function" "procedure" "repeat" "until" "while" "read" "readln" "reset" "rewrite" "write" "writeln") "*Keywords to complete when standing at the first word of a statement. \(eg. begin, repeat, until, readln.) The procedures and variables defined within the Pascal program will be completed runtime and should not be added to this list.") (defvar pascal-separator-keywords '("downto" "else" "mod" "div" "then") "*Keywords to complete when NOT standing at the first word of a statement. \(eg. downto, else, mod, then.) Variables and function names defined within the Pascal program are completed runtime and should not be added to this list.") ;;; ;;; Macros ;;; (defsubst pascal-get-beg-of-line (&optional arg) (save-excursion (beginning-of-line arg) (point))) (defsubst pascal-get-end-of-line (&optional arg) (save-excursion (end-of-line arg) (point))) (defun pascal-declaration-end () (let ((nest 1)) (while (and (> nest 0) (re-search-forward "[:=]\\|\\(\\\\)\\|\\(\\\\)" (save-excursion (end-of-line 2) (point)) t)) (cond ((match-beginning 1) (setq nest (1+ nest))) ((match-beginning 2) (setq nest (1- nest))))))) (defun pascal-declaration-beg () (let ((nest 1)) (while (and (> nest 0) (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\\\)\\|\\(\\\\)" (pascal-get-beg-of-line 0) t)) (cond ((match-beginning 1) (setq nest 0)) ((match-beginning 2) (setq nest (1- nest))) ((match-beginning 3) (setq nest (1+ nest))))) (= nest 0))) (defsubst pascal-within-string () (save-excursion (nth 3 (parse-partial-sexp (pascal-get-beg-of-line) (point))))) ;;;###autoload (defun pascal-mode () "Major mode for editing Pascal code. \\ TAB indents for Pascal code. Delete converts tabs to spaces as it moves back. \\[pascal-complete-word] completes the word around current point with respect \ to position in code \\[pascal-show-completions] shows all possible completions at this point. Other useful functions are: \\[pascal-mark-defun]\t- Mark function. \\[pascal-insert-block]\t- insert begin ... end; \\[pascal-star-comment]\t- insert (* ... *) \\[pascal-comment-area]\t- Put marked area in a comment, fixing nested comments. \\[pascal-uncomment-area]\t- Uncomment an area commented with \ \\[pascal-comment-area]. \\[pascal-beg-of-defun]\t- Move to beginning of current function. \\[pascal-end-of-defun]\t- Move to end of current function. \\[pascal-goto-defun]\t- Goto function prompted for in the minibuffer. \\[pascal-outline]\t- Enter pascal-outline-mode (see also pascal-outline). Variables controlling indentation/edit style: pascal-indent-level (default 3) Indentation of Pascal statements with respect to containing block. pascal-case-indent (default 2) Indentation for case statements. pascal-auto-newline (default nil) Non-nil means automatically newline after simcolons and the punctation mark after an end. pascal-tab-always-indent (default t) Non-nil means TAB in Pascal mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. pascal-auto-endcomments (default t) Non-nil means a comment { ... } is set after the ends which ends cases and functions. The name of the function or case will be set between the braces. pascal-auto-lineup (default t) List of contexts where auto lineup of :'s or ='s hould be done. See also the user variables pascal-type-keywords, pascal-start-keywords and pascal-separator-keywords. Turning on Pascal mode calls the value of the variable pascal-mode-hook with no args, if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map pascal-mode-map) (setq major-mode 'pascal-mode) (setq mode-name "Pascal") (setq local-abbrev-table pascal-mode-abbrev-table) (set-syntax-table pascal-mode-syntax-table) (make-local-variable 'indent-line-function) (setq indent-line-function 'pascal-indent-line) (setq comment-indent-function 'pascal-indent-comment) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments nil) (make-local-variable 'case-fold-search) (setq case-fold-search t) (make-local-variable 'comment-start) (setq comment-start "{") (make-local-variable 'comment-start-skip) (setq comment-start-skip "(\\*+ *\\|{ *") (make-local-variable 'comment-end) (setq comment-end "}") ;; Font lock support (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(pascal-font-lock-keywords nil t)) ;; Imenu support (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression pascal-imenu-generic-expression) (run-hooks 'pascal-mode-hook)) ;;; ;;; Electric functions ;;; (defun electric-pascal-terminate-line () "Terminate line and indent next line." (interactive) ;; First, check if current line should be indented (save-excursion (beginning-of-line) (skip-chars-forward " \t") (if (looking-at pascal-autoindent-lines-re) (pascal-indent-line))) (delete-horizontal-space) ; Removes trailing whitespaces (newline) ;; Indent next line (pascal-indent-line) ;; Maybe we should set some endcomments (if pascal-auto-endcomments (pascal-set-auto-comments)) ;; Check if we shall indent inside comment (let ((setstar nil)) (save-excursion (forward-line -1) (skip-chars-forward " \t") (cond ((looking-at "\\*[ \t]+)") ;; Delete region between `*' and `)' if there is only whitespaces. (forward-char 1) (delete-horizontal-space)) ((and (looking-at "(\\*\\|\\*[^)]") (not (save-excursion (search-forward "*)" (pascal-get-end-of-line) t)))) (setq setstar t)))) ;; If last line was a star comment line then this one shall be too. (if (null setstar) (pascal-indent-line) (insert "* ")))) (defun electric-pascal-semi-or-dot () "Insert `;' or `.' character and reindent the line." (interactive) (insert last-command-char) (save-excursion (beginning-of-line) (pascal-indent-line)) (if pascal-auto-newline (electric-pascal-terminate-line))) (defun electric-pascal-colon () "Insert `:' and do all indentions except line indent on this line." (interactive) (insert last-command-char) ;; Do nothing if within string. (if (pascal-within-string) () (save-excursion (beginning-of-line) (pascal-indent-line)) (let ((pascal-tab-always-indent nil)) (pascal-indent-command)))) (defun electric-pascal-equal () "Insert `=', and do indention if within type declaration." (interactive) (insert last-command-char) (if (eq (car (pascal-calculate-indent)) 'declaration) (let ((pascal-tab-always-indent nil)) (pascal-indent-command)))) (defun electric-pascal-hash () "Insert `#', and indent to coulmn 0 if this is a CPP directive." (interactive) (insert last-command-char) (if (save-excursion (beginning-of-line) (looking-at "^[ \t]*#")) (save-excursion (beginning-of-line) (delete-horizontal-space)))) (defun electric-pascal-tab () "Function called when TAB is pressed in Pascal mode." (interactive) ;; Do nothing if within a string or in a CPP directive. (if (or (pascal-within-string) (and (not (bolp)) (save-excursion (beginning-of-line) (eq (following-char) ?#)))) (insert "\t") ;; If pascal-tab-always-indent, indent the beginning of the line. (if pascal-tab-always-indent (save-excursion (beginning-of-line) (pascal-indent-line)) (insert "\t")) (pascal-indent-command))) ;;; ;;; Interactive functions ;;; (defun pascal-insert-block () "Insert Pascal begin ... end; block in the code with right indentation." (interactive) (pascal-indent-line) (insert "begin") (electric-pascal-terminate-line) (save-excursion (electric-pascal-terminate-line) (insert "end;") (beginning-of-line) (pascal-indent-line))) (defun pascal-star-comment () "Insert Pascal star comment at point." (interactive) (pascal-indent-line) (insert "(*") (electric-pascal-terminate-line) (save-excursion (electric-pascal-terminate-line) (delete-horizontal-space) (insert ")")) (insert " ")) (defun pascal-mark-defun () "Mark the current pascal function (or procedure). This puts the mark at the end, and point at the beginning." (interactive) (push-mark (point)) (pascal-end-of-defun) (push-mark (point)) (pascal-beg-of-defun) (if (fboundp 'zmacs-activate-region) (zmacs-activate-region))) (defun pascal-comment-area (start end) "Put the region into a Pascal comment. The comments that are in this area are \"deformed\": `*)' becomes `!(*' and `}' becomes `!{'. These deformed comments are returned to normal if you use \\[pascal-uncomment-area] to undo the commenting. The commented area starts with `pascal-exclude-str-start', and ends with `pascal-include-str-end'. But if you change these variables, \\[pascal-uncomment-area] won't recognize the comments." (interactive "r") (save-excursion ;; Insert start and endcomments (goto-char end) (if (and (save-excursion (skip-chars-forward " \t") (eolp)) (not (save-excursion (skip-chars-backward " \t") (bolp)))) (forward-line 1) (beginning-of-line)) (insert pascal-exclude-str-end) (setq end (point)) (newline) (goto-char start) (beginning-of-line) (insert pascal-exclude-str-start) (newline) ;; Replace end-comments within commented area (goto-char end) (save-excursion (while (re-search-backward "\\*)" start t) (replace-match "!(*" t t))) (save-excursion (while (re-search-backward "}" start t) (replace-match "!{" t t))))) (defun pascal-uncomment-area () "Uncomment a commented area; change deformed comments back to normal. This command does nothing if the pointer is not in a commented area. See also `pascal-comment-area'." (interactive) (save-excursion (let ((start (point)) (end (point))) ;; Find the boundaries of the comment (save-excursion (setq start (progn (search-backward pascal-exclude-str-start nil t) (point))) (setq end (progn (search-forward pascal-exclude-str-end nil t) (point)))) ;; Check if we're really inside a comment (if (or (equal start (point)) (<= end (point))) (message "Not standing within commented area.") (progn ;; Remove endcomment (goto-char end) (beginning-of-line) (let ((pos (point))) (end-of-line) (delete-region pos (1+ (point)))) ;; Change comments back to normal (save-excursion (while (re-search-backward "!{" start t) (replace-match "}" t t))) (save-excursion (while (re-search-backward "!(\\*" start t) (replace-match "*)" t t))) ;; Remove startcomment (goto-char start) (beginning-of-line) (let ((pos (point))) (end-of-line) (delete-region pos (1+ (point))))))))) (defun pascal-beg-of-defun () "Move backward to the beginning of the current function or procedure." (interactive) (catch 'found (if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re))) (forward-sexp 1)) (let ((nest 0) (max -1) (func 0) (reg (concat pascal-beg-block-re "\\|" pascal-end-block-re "\\|" pascal-defun-re))) (while (re-search-backward reg nil 'move) (cond ((let ((state (save-excursion (parse-partial-sexp (point-min) (point))))) (or (nth 3 state) (nth 4 state))) ; Inside string or comment ()) ((match-end 1) ; begin|case|record|repeat (if (and (looking-at "\\") (>= max 0)) (setq func (1- func))) (setq nest (1+ nest) max (max nest max))) ((match-end 2) ; end|until (if (and (= nest max) (>= max 0)) (setq func (1+ func))) (setq nest (1- nest))) ((match-end 3) ; function|procedure (if (= 0 func) (throw 'found t) (setq func (1- func))))))) nil)) (defun pascal-end-of-defun () "Move forward to the end of the current function or procedure." (interactive) (if (looking-at "\\s ") (forward-sexp 1)) (if (not (looking-at pascal-defun-re)) (pascal-beg-of-defun)) (forward-char 1) (let ((nest 0) (func 1) (reg (concat pascal-beg-block-re "\\|" pascal-end-block-re "\\|" pascal-defun-re))) (while (and (/= func 0) (re-search-forward reg nil 'move)) (cond ((let ((state (save-excursion (parse-partial-sexp (point-min) (point))))) (or (nth 3 state) (nth 4 state))) ; Inside string or comment ()) ((match-end 1) (setq nest (1+ nest)) (if (save-excursion (goto-char (match-beginning 0)) (looking-at "\\")) (setq func (1+ func)))) ((match-end 2) (setq nest (1- nest)) (if (= nest 0) (setq func (1- func)))) ((match-end 3) (setq func (1+ func)))))) (forward-line 1)) (defun pascal-end-of-statement () "Move forward to end of current statement." (interactive) (let ((nest 0) pos (regexp (concat "\\(" pascal-beg-block-re "\\)\\|\\(" pascal-end-block-re "\\)"))) (if (not (looking-at "[ \t\n]")) (forward-sexp -1)) (or (looking-at pascal-beg-block-re) ;; Skip to end of statement (setq pos (catch 'found (while t (forward-sexp 1) (cond ((looking-at "[ \t]*;") (skip-chars-forward "^;") (forward-char 1) (throw 'found (point))) ((save-excursion (forward-sexp -1) (looking-at pascal-beg-block-re)) (goto-char (match-beginning 0)) (throw 'found nil)) ((eobp) (throw 'found (point)))))))) (if (not pos) ;; Skip a whole block (catch 'found (while t (re-search-forward regexp nil 'move) (setq nest (if (match-end 1) (1+ nest) (1- nest))) (cond ((eobp) (throw 'found (point))) ((= 0 nest) (throw 'found (pascal-end-of-statement)))))) pos))) (defun pascal-downcase-keywords () "Downcase all Pascal keywords in the buffer." (interactive) (pascal-change-keywords 'downcase-word)) (defun pascal-upcase-keywords () "Upcase all Pascal keywords in the buffer." (interactive) (pascal-change-keywords 'upcase-word)) (defun pascal-capitalize-keywords () "Capitalize all Pascal keywords in the buffer." (interactive) (pascal-change-keywords 'capitalize-word)) ;; Change the keywords according to argument. (defun pascal-change-keywords (change-word) (save-excursion (let ((keyword-re (concat "\\<\\(" (mapconcat 'identity pascal-keywords "\\|") "\\)\\>"))) (goto-char (point-min)) (while (re-search-forward keyword-re nil t) (funcall change-word -1))))) ;;; ;;; Other functions ;;; (defun pascal-set-auto-comments () "Insert `{ case }' or `{ NAME }' on this line if appropriate. Insert `{ case }' if there is an `end' on the line which ends a case block. Insert `{ NAME }' if there is an `end' on the line which ends a function or procedure named NAME." (save-excursion (forward-line -1) (skip-chars-forward " \t") (if (and (looking-at "\\")) (elsed (looking-at "[ \t]*else\\>")) (type (catch 'nesting ;; Check if inside a string, comment or parenthesis (cond ((nth 3 state) (throw 'nesting 'string)) ((nth 4 state) (throw 'nesting 'comment)) ((> (car state) 0) (goto-char (scan-lists (point) -1 (car state))) (setq par (1+ (current-column)))) ((save-excursion (beginning-of-line) (eq (following-char) ?#)) (throw 'nesting 'cpp))) ;; Loop until correct indent is found (while t (backward-sexp 1) (cond (;--Escape from case statements (and (looking-at "[A-Za-z0-9]+[ \t]*:[^=]") (not complete) (save-excursion (skip-chars-backward " \t") (bolp)) (= (save-excursion (end-of-line) (backward-sexp) (point)) (point)) (> (save-excursion (goto-char oldpos) (beginning-of-line) (point)) (point))) (throw 'nesting 'caseblock)) (;--Nest block outwards (looking-at pascal-beg-block-re) (if (= nest 0) (cond ((looking-at "case\\>") (throw 'nesting 'case)) ((looking-at "record\\>") (throw 'nesting 'declaration)) (t (throw 'nesting 'block))) (setq nest (1- nest)))) (;--Nest block inwards (looking-at pascal-end-block-re) (if (and (looking-at "end\\s ") elsed (not complete)) (throw 'nesting 'block)) (setq complete t nest (1+ nest))) (;--Defun (or parameter list) (looking-at pascal-defun-re) (if (= 0 par) (throw 'nesting 'defun) (setq par 0) (let ((n 0)) (while (re-search-forward "\\(\\\\)\\|\\" oldpos t) (if (match-end 1) (setq n (1+ n)) (setq n (1- n)))) (if (> n 0) (throw 'nesting 'declaration) (throw 'nesting 'paramlist))))) (;--Declaration part (looking-at pascal-declaration-re) (if (save-excursion (goto-char oldpos) (forward-line -1) (looking-at "^[ \t]*$")) (throw 'nesting 'unknown) (throw 'nesting 'declaration))) (;--If, else or while statement (and (not complete) (looking-at pascal-sub-block-re)) (throw 'nesting 'block)) (;--Found complete statement (save-excursion (forward-sexp 1) (= (following-char) ?\;)) (setq complete t)) (;--No known statements (bobp) (throw 'nesting 'unknown)) ))))) ;; Return type of block and indent level. (if (> par 0) ; Unclosed Parenthesis (list 'contexp par) (list type (pascal-indent-level)))))) (defun pascal-indent-level () "Return the indent-level the current statement has. Do not count labels, case-statements or records." (save-excursion (beginning-of-line) (if (looking-at "[ \t]*[0-9a-zA-Z]+[ \t]*:[^=]") (search-forward ":" nil t) (if (looking-at ".*=[ \t]*record\\>") (search-forward "=" nil t))) (skip-chars-forward " \t") (current-column))) (defun pascal-indent-comment (&optional arg) "Indent current line as comment. If optional arg is non-nil, just return the column number the line should be indented to." (let* ((stcol (save-excursion (re-search-backward "(\\*\\|{" nil t) (1+ (current-column))))) (if arg stcol (delete-horizontal-space) (indent-to stcol)))) (defun pascal-indent-case () "Indent within case statements." (skip-chars-forward ": \t") (let ((end (prog2 (end-of-line) (point-marker) (re-search-backward "\\" nil t))) (beg (point)) oldpos (ind 0)) ;; Get right indent (while (< (point) (marker-position end)) (if (re-search-forward "^[ \t]*[^ \t,:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:" (marker-position end) 'move) (forward-char -1)) (delete-horizontal-space) (if (> (current-column) ind) (setq ind (current-column))) (pascal-end-of-statement)) (goto-char beg) (setq oldpos (marker-position end)) ;; Indent all case statements (while (< (point) (marker-position end)) (if (re-search-forward "^[ \t]*[^][ \t,\\.:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:" (marker-position end) 'move) (forward-char -1)) (indent-to (1+ ind)) (if (/= (following-char) ?:) () (forward-char 1) (delete-horizontal-space) (insert " ")) (setq oldpos (point)) (pascal-end-of-statement)) (goto-char oldpos))) (defun pascal-indent-paramlist (&optional arg) "Indent current line in parameterlist. If optional arg is non-nil, just return the indent of the current line in parameterlist." (save-excursion (let* ((oldpos (point)) (stpos (progn (goto-char (scan-lists (point) -1 1)) (point))) (stcol (1+ (current-column))) (edpos (progn (pascal-declaration-end) (search-backward ")" (pascal-get-beg-of-line) t) (point))) (usevar (re-search-backward "\\" stpos t))) (if arg (progn ;; If arg, just return indent (goto-char oldpos) (beginning-of-line) (if (or (not usevar) (looking-at "[ \t]*var\\>")) stcol (+ 4 stcol))) (goto-char stpos) (forward-char 1) (delete-horizontal-space) (if (and usevar (not (looking-at "var\\>"))) (indent-to (+ 4 stcol))) (pascal-indent-declaration nil stpos edpos))))) (defun pascal-indent-declaration (&optional arg start end) "Indent current lines as declaration, lining up the `:'s or `='s." (let ((pos (point-marker))) (if (and (not (or arg start)) (not (pascal-declaration-beg))) () (let ((lineup (if (or (looking-at "\\\\|\\") arg start) ":" "=")) (stpos (if start start (forward-word 2) (backward-word 1) (point))) (edpos (set-marker (make-marker) (if end end (max (progn (pascal-declaration-end) (point)) pos)))) ind) (goto-char stpos) ;; Indent lines in record block (if arg (while (<= (point) (marker-position edpos)) (beginning-of-line) (delete-horizontal-space) (if (looking-at "end\\>") (indent-to arg) (indent-to (+ arg pascal-indent-level))) (forward-line 1))) ;; Do lineup (setq ind (pascal-get-lineup-indent stpos edpos lineup)) (goto-char stpos) (while (<= (point) (marker-position edpos)) (if (search-forward lineup (pascal-get-end-of-line) 'move) (forward-char -1)) (delete-horizontal-space) (indent-to ind) (if (not (looking-at lineup)) (forward-line 1) ; No more indent if there is no : or = (forward-char 1) (delete-horizontal-space) (insert " ") ;; Indent record block (if (looking-at "record\\>") (pascal-indent-declaration (current-column))) (forward-line 1))))) ;; If arg - move point (if arg (forward-line -1) (goto-char (marker-position pos))))) ; "Return the indent level that will line up several lines within the region ;from b to e nicely. The lineup string is str." (defun pascal-get-lineup-indent (b e str) (save-excursion (let ((ind 0) (reg (concat str "\\|\\(\\\\)")) nest) (goto-char b) ;; Get rightmost position (while (< (point) e) (setq nest 1) (if (re-search-forward reg (min e (pascal-get-end-of-line 2)) 'move) (progn ;; Skip record blocks (if (match-beginning 1) (pascal-declaration-end) (progn (goto-char (match-beginning 0)) (skip-chars-backward " \t") (if (> (current-column) ind) (setq ind (current-column))) (goto-char (match-end 0))))))) ;; In case no lineup was found (if (> ind 0) (1+ ind) ;; No lineup-string found (goto-char b) (end-of-line) (skip-chars-backward " \t") (1+ (current-column)))))) ;;; ;;; Completion ;;; (defvar pascal-str nil) (defvar pascal-all nil) (defvar pascal-pred nil) (defvar pascal-buffer-to-use nil) (defvar pascal-flag nil) (defun pascal-string-diff (str1 str2) "Return index of first letter where STR1 and STR2 differs." (catch 'done (let ((diff 0)) (while t (if (or (> (1+ diff) (length str1)) (> (1+ diff) (length str2))) (throw 'done diff)) (or (equal (aref str1 diff) (aref str2 diff)) (throw 'done diff)) (setq diff (1+ diff)))))) ;; Calculate all possible completions for functions if argument is `function', ;; completions for procedures if argument is `procedure' or both functions and ;; procedures otherwise. (defun pascal-func-completion (type) ;; Build regular expression for function/procedure names (if (string= pascal-str "") (setq pascal-str "[a-zA-Z_]")) (let ((pascal-str (concat (cond ((eq type 'procedure) "\\<\\(procedure\\)\\s +") ((eq type 'function) "\\<\\(function\\)\\s +") (t "\\<\\(function\\|procedure\\)\\s +")) "\\<\\(" pascal-str "[a-zA-Z0-9_.]*\\)\\>")) match) (if (not (looking-at "\\<\\(function\\|procedure\\)\\>")) (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t)) (forward-char 1) ;; Search through all reachable functions (while (pascal-beg-of-defun) (if (re-search-forward pascal-str (pascal-get-end-of-line) t) (progn (setq match (buffer-substring (match-beginning 2) (match-end 2))) (if (or (null pascal-pred) (funcall pascal-pred match)) (setq pascal-all (cons match pascal-all))))) (goto-char (match-beginning 0))))) (defun pascal-get-completion-decl () ;; Macro for searching through current declaration (var, type or const) ;; for matches of `str' and adding the occurence tp `all' (let ((end (save-excursion (pascal-declaration-end) (point))) match) ;; Traverse lines (while (< (point) end) (if (re-search-forward "[:=]" (pascal-get-end-of-line) t) ;; Traverse current line (while (and (re-search-backward (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|" pascal-symbol-re) (pascal-get-beg-of-line) t) (not (match-end 1))) (setq match (buffer-substring (match-beginning 0) (match-end 0))) (if (string-match (concat "\\<" pascal-str) match) (if (or (null pascal-pred) (funcall pascal-pred match)) (setq pascal-all (cons match pascal-all)))))) (if (re-search-forward "\\" (pascal-get-end-of-line) t) (pascal-declaration-end) (forward-line 1))))) (defun pascal-type-completion () "Calculate all possible completions for types." (let ((start (point)) goon) ;; Search for all reachable type declarations (while (or (pascal-beg-of-defun) (setq goon (not goon))) (save-excursion (if (and (< start (prog1 (save-excursion (pascal-end-of-defun) (point)) (forward-char 1))) (re-search-forward "\\\\|\\<\\(begin\\|function\\|procedure\\)\\>" start t) (not (match-end 1))) ;; Check current type declaration (pascal-get-completion-decl)))))) (defun pascal-var-completion () "Calculate all possible completions for variables (or constants)." (let ((start (point)) goon twice) ;; Search for all reachable var declarations (while (or (pascal-beg-of-defun) (setq goon (not goon))) (save-excursion (if (> start (prog1 (save-excursion (pascal-end-of-defun) (point)))) () ; Declarations not reacable (if (search-forward "(" (pascal-get-end-of-line) t) ;; Check parameterlist (pascal-get-completion-decl)) (setq twice 2) (while (>= (setq twice (1- twice)) 0) (cond ((and (re-search-forward (concat "\\<\\(var\\|const\\)\\>\\|" "\\<\\(begin\\|function\\|procedure\\)\\>") start t) (not (match-end 2))) ;; Check var/const declarations (pascal-get-completion-decl)) ((match-end 2) (setq twice 0))))))))) (defun pascal-keyword-completion (keyword-list) "Give list of all possible completions of keywords in KEYWORD-LIST." (mapcar '(lambda (s) (if (string-match (concat "\\<" pascal-str) s) (if (or (null pascal-pred) (funcall pascal-pred s)) (setq pascal-all (cons s pascal-all))))) keyword-list)) ;; Function passed to completing-read, try-completion or ;; all-completions to get completion on STR. If predicate is non-nil, ;; it must be a function to be called for every match to check if this ;; should really be a match. If flag is t, the function returns a list ;; of all possible completions. If it is nil it returns a string, the ;; longest possible completion, or t if STR is an exact match. If flag ;; is 'lambda, the function returns t if STR is an exact match, nil ;; otherwise. (defun pascal-completion (pascal-str pascal-pred pascal-flag) (save-excursion (let ((pascal-all nil)) ;; Set buffer to use for searching labels. This should be set ;; within functins which use pascal-completions (set-buffer pascal-buffer-to-use) ;; Determine what should be completed (let ((state (car (pascal-calculate-indent)))) (cond (;--Within a declaration or parameterlist (or (eq state 'declaration) (eq state 'paramlist) (and (eq state 'defun) (save-excursion (re-search-backward ")[ \t]*:" (pascal-get-beg-of-line) t)))) (if (or (eq state 'paramlist) (eq state 'defun)) (pascal-beg-of-defun)) (pascal-type-completion) (pascal-keyword-completion pascal-type-keywords)) (;--Starting a new statement (and (not (eq state 'contexp)) (save-excursion (skip-chars-backward "a-zA-Z0-9_.") (backward-sexp 1) (or (looking-at pascal-nosemi-re) (progn (forward-sexp 1) (looking-at "\\s *\\(;\\|:[^=]\\)"))))) (save-excursion (pascal-var-completion)) (pascal-func-completion 'procedure) (pascal-keyword-completion pascal-start-keywords)) (t;--Anywhere else (save-excursion (pascal-var-completion)) (pascal-func-completion 'function) (pascal-keyword-completion pascal-separator-keywords)))) ;; Now we have built a list of all matches. Give response to caller (pascal-completion-response)))) (defun pascal-completion-response () (cond ((or (equal pascal-flag 'lambda) (null pascal-flag)) ;; This was not called by all-completions (if (null pascal-all) ;; Return nil if there was no matching label nil ;; Get longest string common in the labels (let* ((elm (cdr pascal-all)) (match (car pascal-all)) (min (length match)) exact tmp) (if (string= match pascal-str) ;; Return t if first match was an exact match (setq match t) (while (not (null elm)) ;; Find longest common string (if (< (setq tmp (pascal-string-diff match (car elm))) min) (progn (setq min tmp) (setq match (substring match 0 min)))) ;; Terminate with match=t if this is an exact match (if (string= (car elm) pascal-str) (progn (setq match t) (setq elm nil)) (setq elm (cdr elm))))) ;; If this is a test just for exact match, return nil ot t (if (and (equal pascal-flag 'lambda) (not (equal match 't))) nil match)))) ;; If flag is t, this was called by all-completions. Return ;; list of all possible completions (pascal-flag pascal-all))) (defvar pascal-last-word-numb 0) (defvar pascal-last-word-shown nil) (defvar pascal-last-completions nil) (defun pascal-complete-word () "Complete word at current point. \(See also `pascal-toggle-completions', `pascal-type-keywords', `pascal-start-keywords' and `pascal-separator-keywords'.)" (interactive) (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) (pascal-str (buffer-substring b e)) ;; The following variable is used in pascal-completion (pascal-buffer-to-use (current-buffer)) (allcomp (if (and pascal-toggle-completions (string= pascal-last-word-shown pascal-str)) pascal-last-completions (all-completions pascal-str 'pascal-completion))) (match (if pascal-toggle-completions "" (try-completion pascal-str (mapcar '(lambda (elm) (cons elm 0)) allcomp))))) ;; Delete old string (delete-region b e) ;; Toggle-completions inserts whole labels (if pascal-toggle-completions (progn ;; Update entry number in list (setq pascal-last-completions allcomp pascal-last-word-numb (if (>= pascal-last-word-numb (1- (length allcomp))) 0 (1+ pascal-last-word-numb))) (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb)) ;; Display next match or same string if no match was found (if (not (null allcomp)) (insert "" pascal-last-word-shown) (insert "" pascal-str) (message "(No match)"))) ;; The other form of completion does not necessarly do that. ;; Insert match if found, or the original string if no match (if (or (null match) (equal match 't)) (progn (insert "" pascal-str) (message "(No match)")) (insert "" match)) ;; Give message about current status of completion (cond ((equal match 't) (if (not (null (cdr allcomp))) (message "(Complete but not unique)") (message "(Sole completion)"))) ;; Display buffer if the current completion didn't help ;; on completing the label. ((and (not (null (cdr allcomp))) (= (length pascal-str) (length match))) (with-output-to-temp-buffer "*Completions*" (display-completion-list allcomp)) ;; Wait for a keypress. Then delete *Completion* window (momentary-string-display "" (point)) (delete-window (get-buffer-window (get-buffer "*Completions*"))) ))))) (defun pascal-show-completions () "Show all possible completions at current point." (interactive) (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) (pascal-str (buffer-substring b e)) ;; The following variable is used in pascal-completion (pascal-buffer-to-use (current-buffer)) (allcomp (if (and pascal-toggle-completions (string= pascal-last-word-shown pascal-str)) pascal-last-completions (all-completions pascal-str 'pascal-completion)))) ;; Show possible completions in a temporary buffer. (with-output-to-temp-buffer "*Completions*" (display-completion-list allcomp)) ;; Wait for a keypress. Then delete *Completion* window (momentary-string-display "" (point)) (delete-window (get-buffer-window (get-buffer "*Completions*"))))) (defun pascal-get-default-symbol () "Return symbol around current point as a string." (save-excursion (buffer-substring (progn (skip-chars-backward " \t") (skip-chars-backward "a-zA-Z0-9_") (point)) (progn (skip-chars-forward "a-zA-Z0-9_") (point))))) (defun pascal-build-defun-re (str &optional arg) "Return function/procedure starting with STR as regular expression. With optional second arg non-nil, STR is the complete name of the instruction." (if arg (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "\\)\\>") (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "[a-zA-Z0-9_]*\\)\\>"))) ;; Function passed to completing-read, try-completion or ;; all-completions to get completion on any function name. If ;; predicate is non-nil, it must be a function to be called for every ;; match to check if this should really be a match. If flag is t, the ;; function returns a list of all possible completions. If it is nil ;; it returns a string, the longest possible completion, or t if STR ;; is an exact match. If flag is 'lambda, the function returns t if ;; STR is an exact match, nil otherwise. (defun pascal-comp-defun (pascal-str pascal-pred pascal-flag) (save-excursion (let ((pascal-all nil) match) ;; Set buffer to use for searching labels. This should be set ;; within functins which use pascal-completions (set-buffer pascal-buffer-to-use) (let ((pascal-str pascal-str)) ;; Build regular expression for functions (if (string= pascal-str "") (setq pascal-str (pascal-build-defun-re "[a-zA-Z_]")) (setq pascal-str (pascal-build-defun-re pascal-str))) (goto-char (point-min)) ;; Build a list of all possible completions (while (re-search-forward pascal-str nil t) (setq match (buffer-substring (match-beginning 2) (match-end 2))) (if (or (null pascal-pred) (funcall pascal-pred match)) (setq pascal-all (cons match pascal-all))))) ;; Now we have built a list of all matches. Give response to caller (pascal-completion-response)))) (defun pascal-goto-defun () "Move to specified Pascal function/procedure. The default is a name found in the buffer around point." (interactive) (let* ((default (pascal-get-default-symbol)) ;; The following variable is used in pascal-comp-function (pascal-buffer-to-use (current-buffer)) (default (if (pascal-comp-defun default nil 'lambda) default "")) (label (if (not (string= default "")) ;; Do completion with default (completing-read (concat "Label: (default " default ") ") 'pascal-comp-defun nil t "") ;; There is no default value. Complete without it (completing-read "Label: " 'pascal-comp-defun nil t "")))) ;; If there was no response on prompt, use default value (if (string= label "") (setq label default)) ;; Goto right place in buffer if label is not an empty string (or (string= label "") (progn (goto-char (point-min)) (re-search-forward (pascal-build-defun-re label t)) (beginning-of-line))))) ;;; ;;; Pascal-outline-mode ;;; (defvar pascal-outline-map nil "Keymap used in Pascal Outline mode.") (if pascal-outline-map nil (if (boundp 'set-keymap-name) (set-keymap-name pascal-outline-map 'pascal-outline-map)) (if (not (boundp 'set-keymap-parent)) (setq pascal-outline-map (copy-keymap pascal-mode-map)) (setq pascal-outline-map (make-sparse-keymap)) (set-keymap-parent pascal-outline-map pascal-mode-map)) (define-key pascal-outline-map "\M-\C-a" 'pascal-outline-prev-defun) (define-key pascal-outline-map "\M-\C-e" 'pascal-outline-next-defun) (define-key pascal-outline-map "\C-c\C-d" 'pascal-outline-goto-defun) (define-key pascal-outline-map "\C-c\C-s" 'pascal-show-all) (define-key pascal-outline-map "\C-c\C-h" 'pascal-hide-other-defuns)) (defvar pascal-outline-mode nil "Non-nil while using Pascal Outline mode.") (make-variable-buffer-local 'pascal-outline-mode) (set-default 'pascal-outline-mode nil) (if (not (assoc 'pascal-outline-mode minor-mode-alist)) (setq minor-mode-alist (append minor-mode-alist (list '(pascal-outline-mode " Outl"))))) (defun pascal-outline (&optional arg) "Outline-line minor mode for Pascal mode. When in Pascal Outline mode, portions of the text being edited may be made invisible. \\ Pascal Outline mode provides some additional commands. \\[pascal-outline-prev-defun]\ \t- Move to previous function/procedure, hiding everything else. \\[pascal-outline-next-defun]\ \t- Move to next function/procedure, hiding everything else. \\[pascal-outline-goto-defun]\ \t- Goto function/procedure prompted for in minibuffer, \t hide all other functions. \\[pascal-show-all]\t- Show the whole buffer. \\[pascal-hide-other-defuns]\ \t- Hide everything but the current function (function under the cursor). \\[pascal-outline]\t- Leave pascal-outline-mode." (interactive "P") (setq pascal-outline-mode (if (null arg) (not pascal-outline-mode) t)) (if (boundp 'redraw-mode-line) (redraw-mode-line)) (if pascal-outline-mode (progn (setq selective-display t) (use-local-map pascal-outline-map)) (progn (setq selective-display nil) (pascal-show-all) (use-local-map pascal-mode-map)))) (defun pascal-outline-change (b e pascal-flag) (let ((modp (buffer-modified-p))) (unwind-protect (subst-char-in-region b e (if (= pascal-flag ?\n) ?\^M ?\n) pascal-flag) (set-buffer-modified-p modp)))) (defun pascal-show-all () "Show all of the text in the buffer." (interactive) (pascal-outline-change (point-min) (point-max) ?\n)) (defun pascal-hide-other-defuns () "Show only the current defun." (interactive) (save-excursion (let ((beg (progn (if (not (looking-at "\\(function\\|procedure\\)\\>")) (pascal-beg-of-defun)) (point))) (end (progn (pascal-end-of-defun) (backward-sexp 1) (search-forward "\n\\|\^M" nil t) (point))) (opoint (point-min))) (goto-char (point-min)) ;; Hide all functions before current function (while (re-search-forward "^\\(function\\|procedure\\)\\>" beg 'move) (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M) (setq opoint (point)) ;; Functions may be nested (if (> (progn (pascal-end-of-defun) (point)) beg) (goto-char opoint))) (if (> beg opoint) (pascal-outline-change opoint (1- beg) ?\^M)) ;; Show current function (pascal-outline-change beg end ?\n) ;; Hide nested functions (forward-char 1) (while (re-search-forward "^\\(function\\|procedure\\)\\>" end 'move) (setq opoint (point)) (pascal-end-of-defun) (pascal-outline-change opoint (point) ?\^M)) (goto-char end) (setq opoint end) ;; Hide all function after current function (while (re-search-forward "^\\(function\\|procedure\\)\\>" nil 'move) (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M) (setq opoint (point)) (pascal-end-of-defun)) (pascal-outline-change opoint (point-max) ?\^M) ;; Hide main program (if (< (progn (forward-line -1) (point)) end) (progn (goto-char beg) (pascal-end-of-defun) (backward-sexp 1) (pascal-outline-change (point) (point-max) ?\^M)))))) (defun pascal-outline-next-defun () "Move to next function/procedure, hiding all others." (interactive) (pascal-end-of-defun) (pascal-hide-other-defuns)) (defun pascal-outline-prev-defun () "Move to previous function/procedure, hiding all others." (interactive) (pascal-beg-of-defun) (pascal-hide-other-defuns)) (defun pascal-outline-goto-defun () "Move to specified function/procedure, hiding all others." (interactive) (pascal-goto-defun) (pascal-hide-other-defuns)) ;;; pascal.el ends here emacs-19.30/lisp/paths.el100444 75424 1 13714 6002565034 13740 0ustar kwzhdaemon;;; paths.el --- define pathnames for use by various Emacs commands. ;; Copyright (C) 1986, 1988, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal ;; 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: ;; These are default settings for names of certain files and directories ;; that Emacs needs to refer to from time to time. ;; If these settings are not right, override them with `setq' ;; in site-init.el. Do not change this file. ;;; Code: (defvar Info-default-directory-list (let ((start (list "/usr/local/lib/info/" ;; This comes second so that, if it is the same ;; as configure-info-directory (which is usually true) ;; and Emacs has been installed (also usually true) ;; then the list will end with two copies of this; ;; which means that the last dir file Info-insert-dir ;; finds will be the one in this directory. "/usr/local/info/")) (configdir (file-name-as-directory configure-info-directory))) (setq start (nconc start (list configdir))) start) "List of directories to search for Info documentation files. They are searched in the order they are given in this list. Therefore, the directory of Info files that come with Emacs normally should come last (so that local files override standard ones).") (defvar news-path "/usr/spool/news/" "The root directory below which all news files are stored.") (defvar news-inews-program (cond ((file-exists-p "/usr/bin/inews") "/usr/bin/inews") ((file-exists-p "/usr/local/inews") "/usr/local/inews") ((file-exists-p "/usr/local/bin/inews") "/usr/local/bin/inews") ((file-exists-p "/usr/lib/news/inews") "/usr/lib/news/inews") (t "inews")) "Program to post news.") (defvar gnus-default-nntp-server "" ;; set this to your local server "The name of the host running an NNTP server. The null string means use the local host as the server site.") (defvar gnus-nntp-service "nntp" "NNTP service name, usually \"nntp\" or 119). Go to a local news spool if its value is nil, in which case `gnus-nntp-server' should be set to `(system-name)'.") (defvar gnus-local-domain nil "*Your domain name without a host name: for example, \"ai.mit.edu\". The DOMAINNAME environment variable is used instead if defined. If the function `system-name' returns a fully qualified domain name, there is no need to set this variable.") (defvar gnus-local-organization nil "*The name of your organization, as a string. The `ORGANIZATION' environment variable is used instead if defined.") (defvar gnus-startup-file "~/.newsrc" "The file listing groups to which user is subscribed. Will use `gnus-startup-file'-SERVER instead if exists.") (defvar rmail-file-name "~/RMAIL" "Name of user's primary mail file.") (defconst rmail-spool-directory (cond ((string-match "^[^-]+-[^-]+-sco3.2v4" system-configuration) "/usr/spool/mail/") ;; On The Bull DPX/2 /usr/spool/mail is used although ;; it is usg-unix-v. ((string-match "^m68k-bull-sysv3" system-configuration) "/usr/spool/mail/") ;; SVR4 and recent BSD are said to use this. ;; Rather than trying to know precisely which systems use it, ;; let's assume this dir is never used for anything else. ((file-exists-p "/var/mail") "/var/mail/") ((memq system-type '(dgux hpux usg-unix-v unisoft-unix rtu irix)) "/usr/mail/") (t "/usr/spool/mail/")) "Name of directory used by system mailer for delivering new mail. Its name should end with a slash.") (defconst sendmail-program (cond ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail") ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail") ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail") (t "fakemail")) ;In ../etc, to interface to /bin/mail. "Program used to send messages.") (defconst remote-shell-program (cond ;; Some systems use rsh for the remote shell; others use that name for the ;; restricted shell and use remsh for the remote shell. Let's try to guess ;; based on what we actually find out there. The restricted shell is ;; almost certainly in /bin or /usr/bin, so it's probably safe to assume ;; that an rsh found elsewhere is the remote shell program. The converse ;; is not true: /usr/bin/rsh could be either one, so check that last. ((file-exists-p "/usr/ucb/remsh") "/usr/ucb/remsh") ((file-exists-p "/usr/bsd/remsh") "/usr/bsd/remsh") ((file-exists-p "/bin/remsh") "/bin/remsh") ((file-exists-p "/usr/bin/remsh") "/usr/bin/remsh") ((file-exists-p "/usr/local/bin/remsh") "/usr/local/bin/remsh") ((file-exists-p "/usr/ucb/rsh") "/usr/ucb/rsh") ((file-exists-p "/usr/bsd/rsh") "/usr/bsd/rsh") ((file-exists-p "/usr/local/bin/rsh") "/usr/local/bin/rsh") ((file-exists-p "/usr/bin/rcmd") "/usr/bin/rcmd") ((file-exists-p "/bin/rcmd") "/bin/rcmd") ((file-exists-p "/bin/rsh") "/bin/rsh") ((file-exists-p "/usr/bin/rsh") "/usr/bin/rsh") (t "rsh"))) (defconst term-file-prefix (if (eq system-type 'vax-vms) "[.term]" "term/") "If non-nil, Emacs startup does (load (concat term-file-prefix (getenv \"TERM\"))) You may set this variable to nil in your `.emacs' file if you do not wish the terminal-initialization file to be loaded.") (defconst abbrev-file-name (if (eq system-type 'vax-vms) "~/abbrev.def" "~/.abbrev_defs") "*Default name of file to read abbrevs from.") ;;; paths.el ends here emacs-19.30/lisp/pc-mode.el100444 12120 1 3421 6045204530 13713 0ustar rmsdaemon;;; pc-mode.el emulate certain key bindings used on PCs. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Keywords: emulations ;; 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. ;;;###autoload (defun pc-bindings-mode () "Set up certain key bindings for PC compatibility. The keys affected are: Delete (and its variants) delete forward instead of backward. C-Backspace kills backward a word (as C-Delete normally would). M-Backspace does undo. Home and End move to beginning and end of line C-Home and C-End move to beginning and end of buffer. C-Escape does list-buffers." (interactive) (define-key function-key-map [delete] "\C-d") (define-key function-key-map [M-delete] [?\M-d]) (define-key function-key-map [C-delete] [?\M-d]) (global-set-key [C-M-delete] 'kill-sexp) (global-set-key [C-backspace] 'backward-kill-word) (global-set-key [M-backspace] 'undo) (global-set-key [C-escape] 'list-buffers) (global-set-key [home] 'beginning-of-line) (global-set-key [end] 'end-of-line) (global-set-key [C-home] 'beginning-of-buffer) (global-set-key [C-end] 'end-of-buffer)) ;; pc-mode.el ends here emacs-19.30/lisp/pc-select.el100444 12120 1 54000 6050704604 14270 0ustar rmsdaemon;;; pc-select.el --- emulate mark, cut, copy and paste from motif ;;; (or MAC GUI) or MS-windoze (bah)) look-and-feel ;;; including key bindings ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Michael Staats ;; Created: 26 Sep 1995 ;; 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 package emulates the mark, copy, cut and paste look-and-feel of motif ;; programs (which is the same as the MAC gui and (sorry for that) MS-Windows). ;; It modifies the keybindings of the cursor keys and the next, prior, ;; home and end keys. They will modify mark-active. ;; You can still get the old behaviour of cursor moving with the ;; control sequences C-f, C-b, etc. ;; This package uses transient-mark-mode and ;; delete-selection-mode. ;; ;; In addition to that all key-bindings from the pc-mode are ;; done here too (as suggested by RMS). ;; ;; As I found out after I finished the first version, s-region.el tries ;; to do the same.... But my code is a little more complete and using ;; delete-selection-mode is very important for the look-and-feel. ;; Pete Forman provided some motif ;; compliant keybindings which I added. I had to modify them a little ;; to add the -mark and -nomark functionality of cursor moving. ;; ;; Credits: ;; Many thanks to all who made comments. ;; Thanks to RMS and Ralf Muschall for criticism. ;; Kevin Cutts added the beginning-of-buffer ;; and end-of-buffer functions which I modified a little. ;; David Biesack suggested some more cleanup. ;; Thanks to Pete Forman ;; for additional motif keybindings. ;; ;; ;; Ok, some details about the idea of pc-selection-mode: ;; ;; o The standard keys for moving around (right, left, up, down, home, end, ;; prior, next, called "move-keys" from now on) will always de-activate ;; the mark. ;; o If you press "Shift" together with the "move-keys", the region ;; you pass along is activated ;; o You have the copy, cut and paste functions (as in many other programs) ;; which will operate on the active region ;; It was not possible to bind them to C-v, C-x and C-c for obvious ;; emacs reasons. ;; They will be bound according to the "old" behaviour to S-delete (cut), ;; S-insert (paste) and C-insert (copy). These keys do the same in many ;; other programs. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; INSTALLATION: ;;;; o Put this file called "pc-select.el" into a path where emacs ;;;; looks for lisp libraries. Byte-compile if you want to. ;;;; o Put the command '(require 'pc-select) or ;;;; '(load "pc-select")' into your ~/.emacs. After that line ;;;; put the command '(pc-selection-mode)' to activate the mode. ;;;; ;;;; Please note that I am _not_ a lisp expert, I apologise for ;;;; all hacks which look ugly to an experienced lisp programmer. ;;;; Please report all errors and improvement. Thank you. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Code: ;;;; ;; misc ;;;; (provide 'pc-select) (defun copy-region-as-kill-nomark (beg end) "Save the region as if killed; but don't kill it; deactivate mark. If `interprogram-cut-function' is non-nil, also save the text for a window system cut and paste.\n Deactivating mark is to avoid confusion with delete-selection-mode and transient-mark-mode." (interactive "r") (copy-region-as-kill beg end) (setq mark-active nil) (message "Region saved")) ;;;; ;; non-interactive ;;;; (defun ensure-mark() ;; make sure mark is active ;; test if it is active, if it isn't, set it and activate it (and (not mark-active) (set-mark-command nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;; forward and mark ;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun forward-char-mark (&optional arg) "Ensure mark is active; move point right ARG characters (left if ARG negative). On reaching end of buffer, stop and signal error." (interactive "p") (ensure-mark) (forward-char arg)) (defun forward-word-mark (&optional arg) "Ensure mark is active; move point right ARG words (backward if ARG is negative). Normally returns t. If an edge of the buffer is reached, point is left there and nil is returned." (interactive "p") (ensure-mark) (forward-word arg)) (defun forward-paragraph-mark (&optional arg) "Ensure mark is active; move forward to end of paragraph. With arg N, do it N times; negative arg -N means move backward N paragraphs.\n A line which `paragraph-start' matches either separates paragraphs (if `paragraph-separate' matches it also) or is the first line of a paragraph. A paragraph end is the beginning of a line which is not part of the paragraph to which the end of the previous line belongs, or the end of the buffer." (interactive "p") (ensure-mark) (forward-paragraph arg)) (defun next-line-mark (&optional arg) "Ensure mark is active; move cursor vertically down ARG lines. If there is no character in the target line exactly under the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. If there is no line in the buffer after this one, behavior depends on the value of `next-line-add-newlines'. If non-nil, it inserts a newline character to create a line, and moves the cursor to that line. Otherwise it moves the cursor to the end of the buffer \(if already at the end of the buffer, an error is signaled).\n The command C-x C-n can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically. This goal column is stored in `goal-column', which is nil when there is none." (interactive "p") (ensure-mark) (next-line arg)) (defun end-of-line-mark (&optional arg) "Ensure mark is active; move point to end of current line. With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error." (interactive "p") (ensure-mark) (end-of-line arg)) (defun scroll-down-mark (&optional arg) "Ensure mark is active; scroll down ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll upward. When calling from a program, supply a number as argument or nil." (interactive "P") (ensure-mark) (scroll-down arg)) (defun end-of-buffer-mark (&optional arg) "Ensure mark is active; move point to the end of the buffer. With arg N, put point N/10 of the way from the end.\n If the buffer is narrowed, this command uses the beginning and size of the accessible part of the buffer.\n Don't use this command in Lisp programs! \(goto-char \(point-max)) is faster and avoids clobbering the mark." (interactive "P") (ensure-mark) (let ((size (- (point-max) (point-min)))) (goto-char (if arg (- (point-max) (if (> size 10000) ;; Avoid overflow for large buffer sizes! (* (prefix-numeric-value arg) (/ size 10)) (/ (* size (prefix-numeric-value arg)) 10))) (point-max)))) ;; If we went to a place in the middle of the buffer, ;; adjust it to the beginning of a line. (if arg (forward-line 1) ;; If the end of the buffer is not already on the screen, ;; then scroll specially to put it near, but not at, the bottom. (if (let ((old-point (point))) (save-excursion (goto-char (window-start)) (vertical-motion (window-height)) (< (point) old-point))) (progn (overlay-recenter (point)) (recenter -3))))) ;;;;;;;;; ;;;;; no mark ;;;;;;;;; (defun forward-char-nomark (&optional arg) "Deactivate mark; move point right ARG characters \(left if ARG negative). On reaching end of buffer, stop and signal error." (interactive "p") (setq mark-active nil) (forward-char arg)) (defun forward-word-nomark (&optional arg) "Deactivate mark; move point right ARG words \(backward if ARG is negative). Normally returns t. If an edge of the buffer is reached, point is left there and nil is returned." (interactive "p") (setq mark-active nil) (forward-word arg)) (defun forward-paragraph-nomark (&optional arg) "Deactivate mark; move forward to end of paragraph. With arg N, do it N times; negative arg -N means move backward N paragraphs.\n A line which `paragraph-start' matches either separates paragraphs (if `paragraph-separate' matches it also) or is the first line of a paragraph. A paragraph end is the beginning of a line which is not part of the paragraph to which the end of the previous line belongs, or the end of the buffer." (interactive "p") (setq mark-active nil) (forward-paragraph arg)) (defun next-line-nomark (&optional arg) "Deactivate mark; move cursor vertically down ARG lines. If there is no character in the target line exactly under the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. If there is no line in the buffer after this one, behavior depends on the value of `next-line-add-newlines'. If non-nil, it inserts a newline character to create a line, and moves the cursor to that line. Otherwise it moves the cursor to the end of the buffer (if already at the end of the buffer, an error is signaled).\n The command C-x C-n can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically. This goal column is stored in `goal-column', which is nil when there is none." (interactive "p") (setq mark-active nil) (next-line arg)) (defun end-of-line-nomark (&optional arg) "Deactivate mark; move point to end of current line. With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error." (interactive "p") (setq mark-active nil) (end-of-line arg)) (defun scroll-down-nomark (&optional arg) "Deactivate mark; scroll down ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll upward. When calling from a program, supply a number as argument or nil." (interactive "P") (setq mark-active nil) (scroll-down arg)) (defun end-of-buffer-nomark (&optional arg) "Deactivate mark; move point to the end of the buffer. With arg N, put point N/10 of the way from the end.\n If the buffer is narrowed, this command uses the beginning and size of the accessible part of the buffer.\n Don't use this command in Lisp programs! (goto-char (point-max)) is faster and avoids clobbering the mark." (interactive "P") (setq mark-active nil) (let ((size (- (point-max) (point-min)))) (goto-char (if arg (- (point-max) (if (> size 10000) ;; Avoid overflow for large buffer sizes! (* (prefix-numeric-value arg) (/ size 10)) (/ (* size (prefix-numeric-value arg)) 10))) (point-max)))) ;; If we went to a place in the middle of the buffer, ;; adjust it to the beginning of a line. (if arg (forward-line 1) ;; If the end of the buffer is not already on the screen, ;; then scroll specially to put it near, but not at, the bottom. (if (let ((old-point (point))) (save-excursion (goto-char (window-start)) (vertical-motion (window-height)) (< (point) old-point))) (progn (overlay-recenter (point)) (recenter -3))))) ;;;;;;;;;;;;;;;;;;;; ;;;;;; backwards and mark ;;;;;;;;;;;;;;;;;;;; (defun backward-char-mark (&optional arg) "Ensure mark is active; move point left ARG characters (right if ARG negative). On attempt to pass beginning or end of buffer, stop and signal error." (interactive "p") (ensure-mark) (backward-char arg)) (defun backward-word-mark (&optional arg) "Ensure mark is active; move backward until encountering the end of a word. With argument, do this that many times." (interactive "p") (ensure-mark) (backward-word arg)) (defun backward-paragraph-mark (&optional arg) "Ensure mark is active; move backward to start of paragraph. With arg N, do it N times; negative arg -N means move forward N paragraphs.\n A paragraph start is the beginning of a line which is a `first-line-of-paragraph' or which is ordinary text and follows a paragraph-separating line; except: if the first real line of a paragraph is preceded by a blank line, the paragraph starts at that blank line.\n See `forward-paragraph' for more information." (interactive "p") (ensure-mark) (backward-paragraph arg)) (defun previous-line-mark (&optional arg) "Ensure mark is active; move cursor vertically up ARG lines. If there is no character in the target line exactly over the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough.\n The command C-x C-n can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically.\n If you are thinking of using this in a Lisp program, consider using `forward-line' with a negative argument instead. It is usually easier to use and more reliable (no dependence on goal column, etc.)." (interactive "p") (ensure-mark) (previous-line arg)) (defun beginning-of-line-mark (&optional arg) "Ensure mark is active; move point to beginning of current line. With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error." (interactive "p") (ensure-mark) (beginning-of-line arg)) (defun scroll-up-mark (&optional arg) "Ensure mark is active; scroll upward ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll downward. When calling from a program, supply a number as argument or nil." (interactive "P") (ensure-mark) (scroll-up arg)) (defun beginning-of-buffer-mark (&optional arg) "Ensure mark is active; move point to the beginning of the buffer. With arg N, put point N/10 of the way from the beginning.\n If the buffer is narrowed, this command uses the beginning and size of the accessible part of the buffer.\n Don't use this command in Lisp programs! \(goto-char (p\oint-min)) is faster and avoids clobbering the mark." (interactive "P") (ensure-mark) (let ((size (- (point-max) (point-min)))) (goto-char (if arg (+ (point-min) (if (> size 10000) ;; Avoid overflow for large buffer sizes! (* (prefix-numeric-value arg) (/ size 10)) (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) (point-min)))) (if arg (forward-line 1))) ;;;;;;;; ;;; no mark ;;;;;;;; (defun backward-char-nomark (&optional arg) "Deactivate mark; move point left ARG characters (right if ARG negative). On attempt to pass beginning or end of buffer, stop and signal error." (interactive "p") (setq mark-active nil) (backward-char arg)) (defun backward-word-nomark (&optional arg) "Deactivate mark; move backward until encountering the end of a word. With argument, do this that many times." (interactive "p") (setq mark-active nil) (backward-word arg)) (defun backward-paragraph-nomark (&optional arg) "Deactivate mark; move backward to start of paragraph. With arg N, do it N times; negative arg -N means move forward N paragraphs.\n A paragraph start is the beginning of a line which is a `first-line-of-paragraph' or which is ordinary text and follows a paragraph-separating line; except: if the first real line of a paragraph is preceded by a blank line, the paragraph starts at that blank line.\n See `forward-paragraph' for more information." (interactive "p") (setq mark-active nil) (backward-paragraph arg)) (defun previous-line-nomark (&optional arg) "Deactivate mark; move cursor vertically up ARG lines. If there is no character in the target line exactly over the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough.\n The command C-x C-n can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically." (interactive "p") (setq mark-active nil) (previous-line arg)) (defun beginning-of-line-nomark (&optional arg) "Deactivate mark; move point to beginning of current line. With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error." (interactive "p") (setq mark-active nil) (beginning-of-line arg)) (defun scroll-up-nomark (&optional arg) "Deactivate mark; scroll upward ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll downward. When calling from a program, supply a number as argument or nil." (interactive "P") (setq mark-active nil) (scroll-up arg)) (defun beginning-of-buffer-nomark (&optional arg) "Deactivate mark; move point to the beginning of the buffer. With arg N, put point N/10 of the way from the beginning.\n If the buffer is narrowed, this command uses the beginning and size of the accessible part of the buffer.\n Don't use this command in Lisp programs! (goto-char (point-min)) is faster and avoids clobbering the mark." (interactive "P") (setq mark-active nil) (let ((size (- (point-max) (point-min)))) (goto-char (if arg (+ (point-min) (if (> size 10000) ;; Avoid overflow for large buffer sizes! (* (prefix-numeric-value arg) (/ size 10)) (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) (point-min)))) (if arg (forward-line 1))) ;;;###autoload (defun pc-selection-mode () "Change mark behaviour to emulate motif, MAC or MS-Windows cut and paste style.\n This mode will switch on delete-selection-mode and transient-mark-mode.\n The cursor keys (and others) are bound to new functions which will modify the status of the mark. It will be possible to select regions with shift-cursorkeys. All this tries to emulate the look-and-feel of GUIs like motif, the MAC GUI or MS-Windows (sorry for the last one)." (interactive) ;; ;; keybindings ;; ;; This is to avoid confusion with the delete-selection-mode ;; On simple displays you can't see that a region is active and ;; will be deleted on the next keypress. IMHO especially for ;; copy-region-as-kill this is confusing (define-key global-map "\M-w" 'copy-region-as-kill-nomark) ;; The followong keybindings are for standard ISO keyboards ;; as they are used with IBM compatible PCs, IBM RS/6000, ;; MACs, many X-Stations and probably more (define-key global-map [S-right] 'forward-char-mark) (define-key global-map [right] 'forward-char-nomark) (define-key global-map [C-S-right] 'forward-word-mark) (define-key global-map [C-right] 'forward-word-nomark) (define-key global-map [S-down] 'next-line-mark) (define-key global-map [down] 'next-line-nomark) (define-key global-map [S-end] 'end-of-line-mark) (define-key global-map [end] 'end-of-line-nomark) (global-set-key [S-C-end] 'end-of-buffer-mark) (global-set-key [C-end] 'end-of-buffer-nomark) (define-key global-map [S-next] 'scroll-up-mark) (define-key global-map [next] 'scroll-up-nomark) (define-key global-map [S-left] 'backward-char-mark) (define-key global-map [left] 'backward-char-nomark) (define-key global-map [C-S-left] 'backward-word-mark) (define-key global-map [C-left] 'backward-word-nomark) (define-key global-map [S-up] 'previous-line-mark) (define-key global-map [up] 'previous-line-nomark) (define-key global-map [S-home] 'beginning-of-line-mark) (define-key global-map [home] 'beginning-of-line-nomark) (global-set-key [S-C-home] 'beginning-of-buffer-mark) (global-set-key [C-home] 'beginning-of-buffer-nomark) (define-key global-map [S-prior] 'scroll-down-mark) (define-key global-map [prior] 'scroll-down-nomark) (define-key global-map [S-insert] 'yank) (define-key global-map [C-insert] 'copy-region-as-kill) (define-key global-map [S-delete] 'kill-region) ;; The following bindings are usueful on Sun Type 3 keyboards ;; They implement the Get-Delete-Put (copy-cut-paste) ;; functions from sunview on the L6, L8 and L10 keys (define-key global-map [f16] 'yank) (define-key global-map [f18] 'copy-region-as-kill) (define-key global-map [f20] 'kill-region) ;; The following bindings are from Pete Forman. ;; I modified them a little to work together with the ;; mark functionality I added. (global-set-key [f1] 'help) ; KHelp F1 (global-set-key [f6] 'other-window) ; KNextPane F6 (global-set-key [delete] 'delete-char) ; KDelete Del (global-set-key [C-delete] 'kill-line) ; KEraseEndLine cDel (global-set-key [M-backspace] 'undo) ; KUndo aBS (global-set-key [C-down] 'forward-paragraph-nomark) ; KNextPara cDn (global-set-key [C-up] 'backward-paragraph-nomark) ; KPrevPara cUp (global-set-key [S-C-down] 'forward-paragraph-mark) (global-set-key [S-C-up] 'backward-paragraph-mark) ;; The following bindings are taken from pc-mode.el ;; as suggested by RMS. ;; I only used the ones that are not covered above. (define-key function-key-map [M-delete] [?\M-d]) (global-set-key [C-M-delete] 'kill-sexp) (global-set-key [C-backspace] 'backward-kill-word) (global-set-key [C-escape] 'list-buffers) ;; ;; setup ;; (setq transient-mark-mode t) (setq mark-even-if-inactive t) (delete-selection-mode 1)) ;;; pc-select.el ends here emacs-19.30/lisp/perl-mode.el100444 12120 1 65344 6005277277 14325 0ustar rmsdaemon;;; perl-mode.el --- Perl code editing commands for GNU Emacs ;; Copyright (C) 1990, 1994 Free Software Foundation, Inc. ;; Author: William F. Mann ;; Maintainer: FSF ;; Adapted-By: ESR ;; Keywords: languages ;; Adapted from C code editing commands 'c-mode.el', Copyright 1987 by the ;; Free Software Foundation, under terms of its General Public License. ;; 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: ;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode") ;; to your .emacs file and change the first line of your perl script to: ;; #!/usr/bin/perl -- # -*-Perl-*- ;; With argments to perl: ;; #!/usr/bin/perl -P- # -*-Perl-*- ;; To handle files included with do 'filename.pl';, add something like ;; (setq auto-mode-alist (append (list (cons "\\.pl\\'" 'perl-mode)) ;; auto-mode-alist)) ;; to your .emacs file; otherwise the .pl suffix defaults to prolog-mode. ;; This code is based on the 18.53 version c-mode.el, with extensive ;; rewriting. Most of the features of c-mode survived intact. ;; I added a new feature which adds functionality to TAB; it is controlled ;; by the variable perl-tab-to-comment. With it enabled, TAB does the ;; first thing it can from the following list: change the indentation; ;; move past leading white space; delete an empty comment; reindent a ;; comment; move to end of line; create an empty comment; tell you that ;; the line ends in a quoted string, or has a # which should be a \#. ;; If your machine is slow, you may want to remove some of the bindings ;; to electric-perl-terminator. I changed the indenting defaults to be ;; what Larry Wall uses in perl/lib, but left in all the options. ;; I also tuned a few things: comments and labels starting in column ;; zero are left there by indent-perl-exp; perl-beginning-of-function ;; goes back to the first open brace/paren in column zero, the open brace ;; in 'sub ... {', or the equal sign in 'format ... ='; indent-perl-exp ;; (meta-^q) indents from the current line through the close of the next ;; brace/paren, so you don't need to start exactly at a brace or paren. ;; It may be good style to put a set of redundant braces around your ;; main program. This will let you reindent it with meta-^q. ;; Known problems (these are all caused by limitations in the Emacs Lisp ;; parsing routine (parse-partial-sexp), which was not designed for such ;; a rich language; writing a more suitable parser would be a big job): ;; 1) Regular expression delimiters do not act as quotes, so special ;; characters such as `'"#:;[](){} may need to be backslashed ;; in regular expressions and in both parts of s/// and tr///. ;; 2) The globbing syntax is not recognized, so special ;; characters in the pattern string must be backslashed. ;; 3) The q, qq, and << quoting operators are not recognized; see below. ;; 4) \ (backslash) always quotes the next character, so '\' is ;; treated as the start of a string. Use "\\" as a work-around. ;; 5) To make variables such a $' and $#array work, perl-mode treats ;; $ just like backslash, so '$' is the same as problem 5. ;; 6) Unfortunately, treating $ like \ makes ${var} be treated as an ;; unmatched }. See below. ;; 7) When ' (quote) is used as a package name separator, perl-mode ;; doesn't understand, and thinks it is seeing a quoted string. ;; Here are some ugly tricks to bypass some of these problems: the perl ;; expression /`/ (that's a back-tick) usually evaluates harmlessly, ;; but will trick perl-mode into starting a quoted string, which ;; can be ended with another /`/. Assuming you have no embedded ;; back-ticks, this can used to help solve problem 3: ;; ;; /`/; $ugly = q?"'$?; /`/; ;; ;; To solve problem 6, add a /{/; before each use of ${var}: ;; /{/; while (<${glob_me}>) ... ;; ;; Problem 7 is even worse, but this 'fix' does work :-( ;; $DB'stop#' ;; [$DB'line#' ;; ] =~ s/;9$//; ;;; Code: (defvar perl-mode-abbrev-table nil "Abbrev table in use in perl-mode buffers.") (define-abbrev-table 'perl-mode-abbrev-table ()) (defvar perl-mode-map () "Keymap used in Perl mode.") (if perl-mode-map () (setq perl-mode-map (make-sparse-keymap)) (define-key perl-mode-map "{" 'electric-perl-terminator) (define-key perl-mode-map "}" 'electric-perl-terminator) (define-key perl-mode-map ";" 'electric-perl-terminator) (define-key perl-mode-map ":" 'electric-perl-terminator) (define-key perl-mode-map "\e\C-a" 'perl-beginning-of-function) (define-key perl-mode-map "\e\C-e" 'perl-end-of-function) (define-key perl-mode-map "\e\C-h" 'mark-perl-function) (define-key perl-mode-map "\e\C-q" 'indent-perl-exp) (define-key perl-mode-map "\177" 'backward-delete-char-untabify) (define-key perl-mode-map "\t" 'perl-indent-command)) (autoload 'c-macro-expand "cmacexp" "Display the result of expanding all C macros occurring in the region. The expansion is entirely correct because it uses the C preprocessor." t) (defvar perl-mode-syntax-table nil "Syntax table in use in perl-mode buffers.") (if perl-mode-syntax-table () (setq perl-mode-syntax-table (make-syntax-table (standard-syntax-table))) (modify-syntax-entry ?\n ">" perl-mode-syntax-table) (modify-syntax-entry ?# "<" perl-mode-syntax-table) (modify-syntax-entry ?$ "/" perl-mode-syntax-table) (modify-syntax-entry ?% "." perl-mode-syntax-table) (modify-syntax-entry ?& "." perl-mode-syntax-table) (modify-syntax-entry ?\' "\"" perl-mode-syntax-table) (modify-syntax-entry ?* "." perl-mode-syntax-table) (modify-syntax-entry ?+ "." perl-mode-syntax-table) (modify-syntax-entry ?- "." perl-mode-syntax-table) (modify-syntax-entry ?/ "." perl-mode-syntax-table) (modify-syntax-entry ?< "." perl-mode-syntax-table) (modify-syntax-entry ?= "." perl-mode-syntax-table) (modify-syntax-entry ?> "." perl-mode-syntax-table) (modify-syntax-entry ?\\ "\\" perl-mode-syntax-table) (modify-syntax-entry ?` "\"" perl-mode-syntax-table) (modify-syntax-entry ?| "." perl-mode-syntax-table) ) (defvar perl-imenu-generic-expression '( ;; Functions (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)\\(\\s-\\|\n\\)*{" 1 ) ;;Variables ("Variables" "^\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1 ) ) "Imenu generic expression for Perl mode. See `imenu-generic-expression'.") (defvar perl-font-lock-keywords (list ; ("if" "until" "while" "elsif" "else" "unless" "for" "foreach" "continue" ; "exit" "die" "last" "goto" "next" "redo" "return" "local" "exec") (concat "\\<\\(" "continue\\|die\\|e\\(ls\\(e\\|if\\)\\|x\\(ec\\|it\\)\\)\\|" "for\\(\\|each\\)\\|goto\\|if\\|l\\(ast\\|ocal\\)\\|next\\|" "re\\(do\\|turn\\)\\|un\\(less\\|til\\)\\|while" "\\)\\>") ; ("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include" "#define" "#undef") (cons (concat "#\\(define\\|e\\(lse\\|ndif\\)\\|" "i\\(f\\(\\|def\\|ndef\\)\\|nclude\\)\\|undef\\)\\>") 'font-lock-reference-face) '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)[ \t]*[{]" 1 font-lock-function-name-face) '("[ \n\t{]*\\(eval\\)[ \n\t(;]" 1 font-lock-function-name-face) '("\\(--- .* ---\\|=== .* ===\\)" . font-lock-string-face) ) "Additional expressions to highlight in Perl mode.") (defvar perl-indent-level 4 "*Indentation of Perl statements with respect to containing block.") (defvar perl-continued-statement-offset 4 "*Extra indent for lines not starting new statements.") (defvar perl-continued-brace-offset -4 "*Extra indent for substatements that start with open-braces. This is in addition to `perl-continued-statement-offset'.") (defvar perl-brace-offset 0 "*Extra indentation for braces, compared with other text in same context.") (defvar perl-brace-imaginary-offset 0 "*Imagined indentation of an open brace that actually follows a statement.") (defvar perl-label-offset -2 "*Offset of Perl label lines relative to usual indentation.") (defvar perl-tab-always-indent t "*Non-nil means TAB in Perl mode always indents the current line. Otherwise it inserts a tab character if you type it past the first nonwhite character on the line.") ;; I changed the default to nil for consistency with general Emacs ;; conventions -- rms. (defvar perl-tab-to-comment nil "*Non-nil means TAB moves to eol or makes a comment in some cases. For lines which don't need indenting, TAB either indents an existing comment, moves to end-of-line, or if at end-of-line already, create a new comment.") (defvar perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:" "*Lines starting with this regular expression are not auto-indented.") ;;;###autoload (defun perl-mode () "Major mode for editing Perl code. Expression and list commands understand all Perl brackets. Tab indents for Perl code. Comments are delimited with # ... \\n. Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \\{perl-mode-map} Variables controlling indentation style: perl-tab-always-indent Non-nil means TAB in Perl mode should always indent the current line, regardless of where in the line point is when the TAB command is used. perl-tab-to-comment Non-nil means that for lines which don't need indenting, TAB will either delete an empty comment, indent an existing comment, move to end-of-line, or if at end-of-line already, create a new comment. perl-nochange Lines starting with this regular expression are not auto-indented. perl-indent-level Indentation of Perl statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. perl-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. perl-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to `perl-continued-statement-offset'. perl-brace-offset Extra indentation for line if it starts with an open brace. perl-brace-imaginary-offset An open brace following other text is treated as if it were this far to the right of the start of its line. perl-label-offset Extra indentation for line that is a label. Various indentation styles: K&R BSD BLK GNU LW perl-indent-level 5 8 0 2 4 perl-continued-statement-offset 5 8 4 2 4 perl-continued-brace-offset 0 0 0 0 -4 perl-brace-offset -5 -8 0 0 0 perl-brace-imaginary-offset 0 0 4 0 0 perl-label-offset -5 -8 -2 -2 -2 Turning on Perl mode runs the normal hook `perl-mode-hook'." (interactive) (kill-all-local-variables) (use-local-map perl-mode-map) (setq major-mode 'perl-mode) (setq mode-name "Perl") (setq local-abbrev-table perl-mode-abbrev-table) (set-syntax-table perl-mode-syntax-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) (make-local-variable 'indent-line-function) (setq indent-line-function 'perl-indent-line) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'comment-start) (setq comment-start "# ") (make-local-variable 'comment-end) (setq comment-end "") (make-local-variable 'comment-column) (setq comment-column 32) (make-local-variable 'comment-start-skip) (setq comment-start-skip "\\(^\\|\\s-\\);?#+ *") (make-local-variable 'comment-indent-function) (setq comment-indent-function 'perl-comment-indent) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(perl-font-lock-keywords)) ;; Tell imenu how to handle Perl. (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression perl-imenu-generic-expression) (run-hooks 'perl-mode-hook)) ;; This is used by indent-for-comment ;; to decide how much to indent a comment in Perl code ;; based on its context. (defun perl-comment-indent () (if (and (bolp) (not (eolp))) 0 ;Existing comment at bol stays there. (save-excursion (skip-chars-backward " \t") (max (if (bolp) ;Else indent at comment column 0 ; except leave at least one space if (1+ (current-column))) ; not at beginning of line. comment-column)))) (defun electric-perl-terminator (arg) "Insert character and adjust indentation. If at end-of-line, and not in a comment or a quote, correct the's indentation." (interactive "P") (let ((insertpos (point))) (and (not arg) ; decide whether to indent (eolp) (save-excursion (beginning-of-line) (and (not ; eliminate comments quickly (re-search-forward comment-start-skip insertpos t)) (or (/= last-command-char ?:) ;; Colon is special only after a label .... (looking-at "\\s-*\\(\\w\\|\\s_\\)+$")) (let ((pps (parse-partial-sexp (perl-beginning-of-function) insertpos))) (not (or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))) (progn ; must insert, indent, delete (insert-char last-command-char 1) (perl-indent-line) (delete-char -1)))) (self-insert-command (prefix-numeric-value arg))) ;; not used anymore, but may be useful someday: ;;(defun perl-inside-parens-p () ;; (condition-case () ;; (save-excursion ;; (save-restriction ;; (narrow-to-region (point) ;; (perl-beginning-of-function)) ;; (goto-char (point-max)) ;; (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\())) ;; (error nil))) (defun perl-indent-command (&optional arg) "Indent current line as Perl code, or optionally, insert a tab character. With an argument, indent the current line, regardless of other options. If `perl-tab-always-indent' is nil and point is not in the indentation area at the beginning of the line, simply insert a tab. Otherwise, indent the current line. If point was within the indentation area it is moved to the end of the indentation area. If the line was already indented properly and point was not within the indentation area, and if `perl-tab-to-comment' is non-nil (the default), then do the first possible action from the following list: 1) delete an empty comment 2) move forward to start of comment, indenting if necessary 3) move forward to end of line 4) create an empty comment 5) move backward to start of comment, indenting if necessary." (interactive "P") (if arg ; If arg, just indent this line (perl-indent-line "\f") (if (and (not perl-tab-always-indent) (> (current-column) (current-indentation))) (insert-tab) (let (bof lsexp delta (oldpnt (point))) (beginning-of-line) (setq lsexp (point)) (setq bof (perl-beginning-of-function)) (goto-char oldpnt) (setq delta (perl-indent-line "\f\\|;?#" bof)) (and perl-tab-to-comment (= oldpnt (point)) ; done if point moved (if (listp delta) ; if line starts in a quoted string (setq lsexp (or (nth 2 delta) bof)) (= delta 0)) ; done if indenting occurred (let (eol state) (end-of-line) (setq eol (point)) (if (= (char-after bof) ?=) (if (= oldpnt eol) (message "In a format statement")) (setq state (parse-partial-sexp lsexp eol)) (if (nth 3 state) (if (= oldpnt eol) ; already at eol in a string (message "In a string which starts with a %c." (nth 3 state))) (if (not (nth 4 state)) (if (= oldpnt eol) ; no comment, create one? (indent-for-comment)) (beginning-of-line) (if (re-search-forward comment-start-skip eol 'move) (if (eolp) (progn ; kill existing comment (goto-char (match-beginning 0)) (skip-chars-backward " \t") (kill-region (point) eol)) (if (or (< oldpnt (point)) (= oldpnt eol)) (indent-for-comment) ; indent existing comment (end-of-line))) (if (/= oldpnt eol) (end-of-line) (message "Use backslash to quote # characters.") (ding t)))))))))))) (defun perl-indent-line (&optional nochange parse-start) "Indent current line as Perl code. Return the amount the indentation changed by, or (parse-state) if line starts in a quoted string." (let ((case-fold-search nil) (pos (- (point-max) (point))) (bof (or parse-start (save-excursion (perl-beginning-of-function)))) beg indent shift-amt) (beginning-of-line) (setq beg (point)) (setq shift-amt (cond ((= (char-after bof) ?=) 0) ((listp (setq indent (calculate-perl-indent bof))) indent) ((looking-at (or nochange perl-nochange)) 0) (t (skip-chars-forward " \t\f") (cond ((looking-at "\\(\\w\\|\\s_\\)+:") (setq indent (max 1 (+ indent perl-label-offset)))) ((= (following-char) ?}) (setq indent (- indent perl-indent-level))) ((= (following-char) ?{) (setq indent (+ indent perl-brace-offset)))) (- indent (current-column))))) (skip-chars-forward " \t\f") (if (and (numberp shift-amt) (/= 0 shift-amt)) (progn (delete-region beg (point)) (indent-to indent))) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) shift-amt)) (defun calculate-perl-indent (&optional parse-start) "Return appropriate indentation for current line as Perl code. In usual case returns an integer: the column to indent to. Returns (parse-state) if line starts inside a string." (save-excursion (beginning-of-line) (let ((indent-point (point)) (case-fold-search nil) (colon-line-end 0) state containing-sexp) (if parse-start ;used to avoid searching (goto-char parse-start) (perl-beginning-of-function)) (while (< (point) indent-point) ;repeat until right sexp (setq parse-start (point)) (setq state (parse-partial-sexp (point) indent-point 0)) ; state = (depth_in_parens innermost_containing_list last_complete_sexp ; string_terminator_or_nil inside_commentp following_quotep ; minimum_paren-depth_this_scan) ; Parsing stops if depth in parentheses becomes equal to third arg. (setq containing-sexp (nth 1 state))) (cond ((nth 3 state) state) ; In a quoted string? ((null containing-sexp) ; Line is at top level. (skip-chars-forward " \t\f") (if (= (following-char) ?{) 0 ; move to beginning of line if it starts a function body ;; indent a little if this is a continuation line (perl-backward-to-noncomment) (if (or (bobp) (memq (preceding-char) '(?\; ?\}))) 0 perl-continued-statement-offset))) ((/= (char-after containing-sexp) ?{) ;; line is expression, not statement: ;; indent to just after the surrounding open. (goto-char (1+ containing-sexp)) (current-column)) (t ;; Statement level. Is it a continuation or a new statement? ;; Find previous non-comment character. (perl-backward-to-noncomment) ;; Back up over label lines, since they don't ;; affect whether our line is a continuation. (while (or (eq (preceding-char) ?\,) (and (eq (preceding-char) ?:) (memq (char-syntax (char-after (- (point) 2))) '(?w ?_)))) (if (eq (preceding-char) ?\,) (perl-backward-to-start-of-continued-exp containing-sexp) (beginning-of-line)) (perl-backward-to-noncomment)) ;; Now we get the answer. (if (not (memq (preceding-char) '(?\; ?\} ?\{))) ;; This line is continuation of preceding line's statement; ;; indent perl-continued-statement-offset more than the ;; previous line of the statement. (progn (perl-backward-to-start-of-continued-exp containing-sexp) (+ perl-continued-statement-offset (current-column) (if (save-excursion (goto-char indent-point) (looking-at "[ \t]*{")) perl-continued-brace-offset 0))) ;; This line starts a new statement. ;; Position at last unclosed open. (goto-char containing-sexp) (or ;; If open paren is in col 0, close brace is special (and (bolp) (save-excursion (goto-char indent-point) (looking-at "[ \t]*}")) perl-indent-level) ;; Is line first statement after an open-brace? ;; If no, find that first statement and indent like it. (save-excursion (forward-char 1) ;; Skip over comments and labels following openbrace. (while (progn (skip-chars-forward " \t\f\n") (cond ((looking-at ";?#") (forward-line 1) t) ((looking-at "\\(\\w\\|\\s_\\)+:") (save-excursion (end-of-line) (setq colon-line-end (point))) (search-forward ":"))))) ;; The first following code counts ;; if it is before the line we want to indent. (and (< (point) indent-point) (if (> colon-line-end (point)) (- (current-indentation) perl-label-offset) (current-column)))) ;; If no previous statement, ;; indent it relative to line brace is on. ;; For open paren in column zero, don't let statement ;; start there too. If perl-indent-level is zero, ;; use perl-brace-offset + perl-continued-statement-offset ;; For open-braces not the first thing in a line, ;; add in perl-brace-imaginary-offset. (+ (if (and (bolp) (zerop perl-indent-level)) (+ perl-brace-offset perl-continued-statement-offset) perl-indent-level) ;; Move back over whitespace before the openbrace. ;; If openbrace is not first nonwhite thing on the line, ;; add the perl-brace-imaginary-offset. (progn (skip-chars-backward " \t") (if (bolp) 0 perl-brace-imaginary-offset)) ;; If the openbrace is preceded by a parenthesized exp, ;; move to the beginning of that; ;; possibly a different line (progn (if (eq (preceding-char) ?\)) (forward-sexp -1)) ;; Get initial indentation of the line we are on. (current-indentation)))))))))) (defun perl-backward-to-noncomment () "Move point backward to after the first non-white-space, skipping comments." (interactive) (let (opoint stop) (while (not stop) (setq opoint (point)) (beginning-of-line) (if (re-search-forward comment-start-skip opoint 'move 1) (progn (goto-char (match-end 1)) (skip-chars-forward ";"))) (skip-chars-backward " \t\f") (setq stop (or (bobp) (not (bolp)) (forward-char -1)))))) (defun perl-backward-to-start-of-continued-exp (lim) (if (= (preceding-char) ?\)) (forward-sexp -1)) (beginning-of-line) (if (<= (point) lim) (goto-char (1+ lim))) (skip-chars-forward " \t\f")) ;; note: this may be slower than the c-mode version, but I can understand it. (defun indent-perl-exp () "Indent each line of the Perl grouping following point." (interactive) (let* ((case-fold-search nil) (oldpnt (point-marker)) (bof-mark (save-excursion (end-of-line 2) (perl-beginning-of-function) (point-marker))) eol last-mark lsexp-mark delta) (if (= (char-after (marker-position bof-mark)) ?=) (message "Can't indent a format statement") (message "Indenting Perl expression...") (save-excursion (end-of-line) (setq eol (point))) (save-excursion ; locate matching close paren (while (and (not (eobp)) (<= (point) eol)) (parse-partial-sexp (point) (point-max) 0)) (setq last-mark (point-marker))) (setq lsexp-mark bof-mark) (beginning-of-line) (while (< (point) (marker-position last-mark)) (setq delta (perl-indent-line nil (marker-position bof-mark))) (if (numberp delta) ; unquoted start-of-line? (progn (if (eolp) (delete-horizontal-space)) (setq lsexp-mark (point-marker)))) (end-of-line) (setq eol (point)) (if (nth 4 (parse-partial-sexp (marker-position lsexp-mark) eol)) (progn ; line ends in a comment (beginning-of-line) (if (or (not (looking-at "\\s-*;?#")) (listp delta) (and (/= 0 delta) (= (- (current-indentation) delta) comment-column))) (if (re-search-forward comment-start-skip eol t) (indent-for-comment))))) ; indent existing comment (forward-line 1)) (goto-char (marker-position oldpnt)) (message "Indenting Perl expression...done")))) (defun perl-beginning-of-function (&optional arg) "Move backward to next beginning-of-function, or as far as possible. With argument, repeat that many times; negative args move forward. Returns new value of point in all cases." (interactive "p") (or arg (setq arg 1)) (if (< arg 0) (forward-char 1)) (and (/= arg 0) (re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*=\\|^\\." nil 'move arg) (goto-char (1- (match-end 0)))) (point)) ;; note: this routine is adapted directly from emacs lisp.el, end-of-defun; ;; no bugs have been removed :-) (defun perl-end-of-function (&optional arg) "Move forward to next end-of-function. The end of a function is found by moving forward from the beginning of one. With argument, repeat that many times; negative args move backward." (interactive "p") (or arg (setq arg 1)) (let ((first t)) (while (and (> arg 0) (< (point) (point-max))) (let ((pos (point)) npos) (while (progn (if (and first (progn (forward-char 1) (perl-beginning-of-function 1) (not (bobp)))) nil (or (bobp) (forward-char -1)) (perl-beginning-of-function -1)) (setq first nil) (forward-list 1) (skip-chars-forward " \t") (if (looking-at "[#\n]") (forward-line 1)) (<= (point) pos)))) (setq arg (1- arg))) (while (< arg 0) (let ((pos (point))) (perl-beginning-of-function 1) (forward-sexp 1) (forward-line 1) (if (>= (point) pos) (if (progn (perl-beginning-of-function 2) (not (bobp))) (progn (forward-list 1) (skip-chars-forward " \t") (if (looking-at "[#\n]") (forward-line 1))) (goto-char (point-min))))) (setq arg (1+ arg))))) (defun mark-perl-function () "Put mark at end of Perl function, point at beginning." (interactive) (push-mark (point)) (perl-end-of-function) (push-mark (point)) (perl-beginning-of-function) (backward-paragraph)) ;;;;;;;; That's all, folks! ;;;;;;;;; emacs-19.30/lisp/picture.el100444 75424 12 62400 5747264723 14172 0ustar kwzhstaff;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model. ;; Copyright (C) 1985, 1994 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF ;; 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 code provides the picture-mode commands documented in the Emacs ;; manual. The screen is treated as a semi-infinite quarter-plane with ;; support for rectangle operations and `etch-a-sketch' character ;; insertion in any of eight directions. ;;; Code: (defun move-to-column-force (column) "Move to column COLUMN in current line. Differs from `move-to-column' in that it creates or modifies whitespace if necessary to attain exactly the specified column." (or (natnump column) (setq column 0)) (move-to-column column) (let ((col (current-column))) (if (< col column) (indent-to column) (if (and (/= col column) (= (preceding-char) ?\t)) (let (indent-tabs-mode) (delete-char -1) (indent-to col) (move-to-column column)))) ;; This call will go away when Emacs gets real horizontal autoscrolling (hscroll-point-visible))) ;; Picture Movement Commands (defun picture-beginning-of-line (&optional arg) "Position point at the beginning of the line. With ARG not nil, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error." (interactive "P") (if arg (forward-line (1- (prefix-numeric-value arg)))) (beginning-of-line) ;; This call will go away when Emacs gets real horizontal autoscrolling (hscroll-point-visible)) (defun picture-end-of-line (&optional arg) "Position point after last non-blank character on current line. With ARG not nil, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error." (interactive "P") (if arg (forward-line (1- (prefix-numeric-value arg)))) (beginning-of-line) (skip-chars-backward " \t" (prog1 (point) (end-of-line))) ;; This call will go away when Emacs gets real horizontal autoscrolling (hscroll-point-visible)) (defun picture-forward-column (arg) "Move cursor right, making whitespace if necessary. With argument, move that many columns." (interactive "p") (let ((target-column (+ (current-column) arg))) (move-to-column-force target-column) ;; Picture mode isn't really suited to multi-column characters, ;; but we might as well let the user move across them. (and (< arg 0) (> (current-column) target-column) (forward-char -1)))) (defun picture-backward-column (arg) "Move cursor left, making whitespace if necessary. With argument, move that many columns." (interactive "p") (picture-forward-column (- arg))) (defun picture-move-down (arg) "Move vertically down, making whitespace if necessary. With argument, move that many lines." (interactive "p") (let ((col (current-column))) (picture-newline arg) (move-to-column-force col))) (defconst picture-vertical-step 0 "Amount to move vertically after text character in Picture mode.") (defconst picture-horizontal-step 1 "Amount to move horizontally after text character in Picture mode.") (defun picture-move-up (arg) "Move vertically up, making whitespace if necessary. With argument, move that many lines." (interactive "p") (picture-move-down (- arg))) (defun picture-movement-right () "Move right after self-inserting character in Picture mode." (interactive) (picture-set-motion 0 1)) (defun picture-movement-left () "Move left after self-inserting character in Picture mode." (interactive) (picture-set-motion 0 -1)) (defun picture-movement-up () "Move up after self-inserting character in Picture mode." (interactive) (picture-set-motion -1 0)) (defun picture-movement-down () "Move down after self-inserting character in Picture mode." (interactive) (picture-set-motion 1 0)) (defun picture-movement-nw () "Move up and left after self-inserting character in Picture mode." (interactive) (picture-set-motion -1 -1)) (defun picture-movement-ne () "Move up and right after self-inserting character in Picture mode." (interactive) (picture-set-motion -1 1)) (defun picture-movement-sw () "Move down and left after self-inserting character in Picture mode." (interactive) (picture-set-motion 1 -1)) (defun picture-movement-se () "Move down and right after self-inserting character in Picture mode." (interactive) (picture-set-motion 1 1)) (defun picture-set-motion (vert horiz) "Set VERTICAL and HORIZONTAL increments for movement in Picture mode. The mode line is updated to reflect the current direction." (setq picture-vertical-step vert picture-horizontal-step horiz) (setq mode-name (format "Picture:%s" (car (nthcdr (+ 1 (% horiz 2) (* 3 (1+ (% vert 2)))) '(nw up ne left none right sw down se))))) (force-mode-line-update) (message "")) (defun picture-move () "Move in direction of `picture-vertical-step' and `picture-horizontal-step'." (picture-move-down picture-vertical-step) (picture-forward-column picture-horizontal-step)) (defun picture-motion (arg) "Move point in direction of current picture motion in Picture mode. With ARG do it that many times. Useful for delineating rectangles in conjunction with diagonal picture motion. Do \\[command-apropos] picture-movement to see commands which control motion." (interactive "p") (picture-move-down (* arg picture-vertical-step)) (picture-forward-column (* arg picture-horizontal-step))) (defun picture-motion-reverse (arg) "Move point in direction opposite of current picture motion in Picture mode. With ARG do it that many times. Useful for delineating rectangles in conjunction with diagonal picture motion. Do \\[command-apropos] `picture-movement' to see commands which control motion." (interactive "p") (picture-motion (- arg))) ;; Picture insertion and deletion. (defun picture-self-insert (arg) "Insert this character in place of character previously at the cursor. The cursor then moves in the direction you previously specified with the commands `picture-movement-right', `picture-movement-up', etc. Do \\[command-apropos] `picture-movement' to see those commands." (interactive "p") (while (> arg 0) (setq arg (1- arg)) (move-to-column-force (1+ (current-column))) (delete-char -1) (insert last-command-event) ; Always a character in this case. (forward-char -1) (picture-move))) (defun picture-clear-column (arg) "Clear out ARG columns after point without moving." (interactive "p") (let* ((opoint (point)) (original-col (current-column)) (target-col (+ original-col arg))) (move-to-column-force target-col) (delete-region opoint (point)) (save-excursion (indent-to (max target-col original-col))))) (defun picture-backward-clear-column (arg) "Clear out ARG columns before point, moving back over them." (interactive "p") (picture-clear-column (- arg))) (defun picture-clear-line (arg) "Clear out rest of line; if at end of line, advance to next line. Cleared-out line text goes into the kill ring, as do newlines that are advanced over. With argument, clear out (and save in kill ring) that many lines." (interactive "P") (if arg (progn (setq arg (prefix-numeric-value arg)) (kill-line arg) (newline (if (> arg 0) arg (- arg)))) (if (looking-at "[ \t]*$") (kill-ring-save (point) (progn (forward-line 1) (point))) (kill-region (point) (progn (end-of-line) (point)))))) (defun picture-newline (arg) "Move to the beginning of the following line. With argument, moves that many lines (up, if negative argument); always moves to the beginning of a line." (interactive "p") (if (< arg 0) (forward-line arg) (while (> arg 0) (end-of-line) (if (eobp) (newline) (forward-char 1)) (setq arg (1- arg)))) ;; This call will go away when Emacs gets real horizontal autoscrolling (hscroll-point-visible)) (defun picture-open-line (arg) "Insert an empty line after the current line. With positive argument insert that many lines." (interactive "p") (save-excursion (end-of-line) (open-line arg)) ;; This call will go away when Emacs gets real horizontal autoscrolling (hscroll-point-visible)) (defun picture-duplicate-line () "Insert a duplicate of the current line, below it." (interactive) (save-excursion (let ((contents (buffer-substring (progn (beginning-of-line) (point)) (progn (picture-newline 1) (point))))) (forward-line -1) (insert contents)))) ;; Like replace-match, but overwrites. (defun picture-replace-match (newtext fixedcase literal) (let (ocolumn change pos) (goto-char (setq pos (match-end 0))) (setq ocolumn (current-column)) ;; Make the replacement and undo it, to see how it changes the length. (let ((buffer-undo-list nil) list1) (replace-match newtext fixedcase literal) (setq change (- (current-column) ocolumn)) (setq list1 buffer-undo-list) (while list1 (setq list1 (primitive-undo 1 list1)))) (goto-char pos) (if (> change 0) (delete-region (point) (progn (move-to-column-force (+ change (current-column))) (point)))) (replace-match newtext fixedcase literal) (if (< change 0) (insert-char ?\ (- change))))) ;; Picture Tabs (defvar picture-tab-chars "!-~" "*A character set which controls behavior of commands \\[picture-set-tab-stops] and \\[picture-tab-search]. It is NOT a regular expression, any regexp special characters will be quoted. It defines a set of \"interesting characters\" to look for when setting \(or searching for) tab stops, initially \"!-~\" (all printing characters). For example, suppose that you are editing a table which is formatted thus: | foo | bar + baz | 23 * | bubbles | and + etc | 97 * and that `picture-tab-chars' is \"|+*\". Then invoking \\[picture-set-tab-stops] on either of the previous lines would result in the following tab stops : : : : Another example - \"A-Za-z0-9\" would produce the tab stops : : : : Note that if you want the character `-' to be in the set, it must be included in a range or else appear in a context where it cannot be taken for indicating a range (e.g. \"-A-Z\" declares the set to be the letters `A' through `Z' and the character `-'). If you want the character `\\' in the set it must be preceded by itself: \"\\\\\". The command \\[picture-tab-search] is defined to move beneath (or to) a character belonging to this set independent of the tab stops list.") (defun picture-set-tab-stops (&optional arg) "Set value of `tab-stop-list' according to context of this line. This controls the behavior of \\[picture-tab]. A tab stop is set at every column occupied by an \"interesting character\" that is preceded by whitespace. Interesting characters are defined by the variable `picture-tab-chars', see its documentation for an example of usage. With ARG, just (re)set `tab-stop-list' to its default value. The tab stops computed are displayed in the minibuffer with `:' at each stop." (interactive "P") (save-excursion (let (tabs) (if arg (setq tabs (default-value 'tab-stop-list)) (let ((regexp (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]"))) (beginning-of-line) (let ((bol (point))) (end-of-line) (while (re-search-backward regexp bol t) (skip-chars-forward " \t") (setq tabs (cons (current-column) tabs))) (if (null tabs) (error "No characters in set %s on this line." (regexp-quote picture-tab-chars)))))) (setq tab-stop-list tabs) (let ((blurb (make-string (1+ (nth (1- (length tabs)) tabs)) ?\ ))) (while tabs (aset blurb (car tabs) ?:) (setq tabs (cdr tabs))) (message blurb))))) (defun picture-tab-search (&optional arg) "Move to column beneath next interesting char in previous line. With ARG move to column occupied by next interesting character in this line. The character must be preceded by whitespace. \"interesting characters\" are defined by variable `picture-tab-chars'. If no such character is found, move to beginning of line." (interactive "P") (let ((target (current-column))) (save-excursion (if (and (not arg) (progn (beginning-of-line) (skip-chars-backward (concat "^" (regexp-quote picture-tab-chars)) (point-min)) (not (bobp)))) (move-to-column target)) (if (re-search-forward (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]") (save-excursion (end-of-line) (point)) 'move) (setq target (1- (current-column))) (setq target nil))) (if target (move-to-column-force target) (beginning-of-line)))) (defun picture-tab (&optional arg) "Tab transparently (just move point) to next tab stop. With prefix arg, overwrite the traversed text with spaces. The tab stop list can be changed by \\[picture-set-tab-stops] and \\[edit-tab-stops]. See also documentation for variable `picture-tab-chars'." (interactive "P") (let* ((opoint (point))) (move-to-tab-stop) (if arg (let (indent-tabs-mode (column (current-column))) (delete-region opoint (point)) (indent-to column))))) ;; Picture Rectangles (defconst picture-killed-rectangle nil "Rectangle killed or copied by \\[picture-clear-rectangle] in Picture mode. The contents can be retrieved by \\[picture-yank-rectangle]") (defun picture-clear-rectangle (start end &optional killp) "Clear and save rectangle delineated by point and mark. The rectangle is saved for yanking by \\[picture-yank-rectangle] and replaced with whitespace. The previously saved rectangle, if any, is lost. With prefix argument, the rectangle is actually killed, shifting remaining text." (interactive "r\nP") (setq picture-killed-rectangle (picture-snarf-rectangle start end killp))) (defun picture-clear-rectangle-to-register (start end register &optional killp) "Clear rectangle delineated by point and mark into REGISTER. The rectangle is saved in REGISTER and replaced with whitespace. With prefix argument, the rectangle is actually killed, shifting remaining text." (interactive "r\ncRectangle to register: \nP") (set-register register (picture-snarf-rectangle start end killp))) (defun picture-snarf-rectangle (start end &optional killp) (let ((column (current-column)) (indent-tabs-mode nil)) (prog1 (save-excursion (if killp (delete-extract-rectangle start end) (prog1 (extract-rectangle start end) (clear-rectangle start end)))) (move-to-column-force column)))) (defun picture-yank-rectangle (&optional insertp) "Overlay rectangle saved by \\[picture-clear-rectangle] The rectangle is positioned with upper left corner at point, overwriting existing text. With prefix argument, the rectangle is inserted instead, shifting existing text. Leaves mark at one corner of rectangle and point at the other (diagonally opposed) corner." (interactive "P") (if (not (consp picture-killed-rectangle)) (error "No rectangle saved.") (picture-insert-rectangle picture-killed-rectangle insertp))) (defun picture-yank-at-click (click arg) "Insert the last killed rectangle at the position clicked on. Also move point to one end of the text thus inserted (normally the end). Prefix arguments are interpreted as with \\[yank]. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click." (interactive "e\nP") (or mouse-yank-at-point (mouse-set-point click)) (picture-yank-rectangle arg)) (defun picture-yank-rectangle-from-register (register &optional insertp) "Overlay rectangle saved in REGISTER. The rectangle is positioned with upper left corner at point, overwriting existing text. With prefix argument, the rectangle is inserted instead, shifting existing text. Leaves mark at one corner of rectangle and point at the other (diagonally opposed) corner." (interactive "cRectangle from register: \nP") (let ((rectangle (get-register register))) (if (not (consp rectangle)) (error "Register %c does not contain a rectangle." register) (picture-insert-rectangle rectangle insertp)))) (defun picture-insert-rectangle (rectangle &optional insertp) "Overlay RECTANGLE with upper left corner at point. Optional argument INSERTP, if non-nil causes RECTANGLE to be inserted. Leaves the region surrounding the rectangle." (let ((indent-tabs-mode nil)) (if (not insertp) (save-excursion (delete-rectangle (point) (progn (picture-forward-column (length (car rectangle))) (picture-move-down (1- (length rectangle))) (point))))) (push-mark) (insert-rectangle rectangle))) ;; Picture Keymap, entry and exit points. (defconst picture-mode-map nil) (defun picture-substitute (oldfun newfun) (substitute-key-definition oldfun newfun picture-mode-map global-map)) (if (not picture-mode-map) (progn (setq picture-mode-map (list 'keymap (make-vector 256 nil))) (picture-substitute 'self-insert-command 'picture-self-insert) (picture-substitute 'forward-char 'picture-forward-column) (picture-substitute 'backward-char 'picture-backward-column) (picture-substitute 'delete-char 'picture-clear-column) ;; There are two possibilities for what is normally on DEL. (picture-substitute 'backward-delete-char-untabify 'picture-backward-clear-column) (picture-substitute 'delete-backward-char 'picture-backward-clear-column) (picture-substitute 'kill-line 'picture-clear-line) (picture-substitute 'open-line 'picture-open-line) (picture-substitute 'newline 'picture-newline) (picture-substitute 'newline-and-indent 'picture-duplicate-line) (picture-substitute 'next-line 'picture-move-down) (picture-substitute 'previous-line 'picture-move-up) (picture-substitute 'beginning-of-line 'picture-beginning-of-line) (picture-substitute 'end-of-line 'picture-end-of-line) (define-key picture-mode-map "\C-c\C-d" 'delete-char) (define-key picture-mode-map "\e\t" 'picture-toggle-tab-state) (define-key picture-mode-map "\t" 'picture-tab) (define-key picture-mode-map "\e\t" 'picture-tab-search) (define-key picture-mode-map "\C-c\t" 'picture-set-tab-stops) (define-key picture-mode-map "\C-c\C-k" 'picture-clear-rectangle) (define-key picture-mode-map "\C-c\C-w" 'picture-clear-rectangle-to-register) (define-key picture-mode-map "\C-c\C-y" 'picture-yank-rectangle) (define-key picture-mode-map "\C-c\C-x" 'picture-yank-rectangle-from-register) (define-key picture-mode-map "\C-c\C-c" 'picture-mode-exit) (define-key picture-mode-map "\C-c\C-f" 'picture-motion) (define-key picture-mode-map "\C-c\C-b" 'picture-motion-reverse) (define-key picture-mode-map "\C-c<" 'picture-movement-left) (define-key picture-mode-map "\C-c>" 'picture-movement-right) (define-key picture-mode-map "\C-c^" 'picture-movement-up) (define-key picture-mode-map "\C-c." 'picture-movement-down) (define-key picture-mode-map "\C-c`" 'picture-movement-nw) (define-key picture-mode-map "\C-c'" 'picture-movement-ne) (define-key picture-mode-map "\C-c/" 'picture-movement-sw) (define-key picture-mode-map "\C-c\\" 'picture-movement-se))) (defvar picture-mode-hook nil "If non-nil, its value is called on entry to Picture mode. Picture mode is invoked by the command \\[picture-mode].") (defvar picture-mode-old-local-map) (defvar picture-mode-old-mode-name) (defvar picture-mode-old-major-mode) (defvar picture-mode-old-truncate-lines) ;;;###autoload (defun picture-mode () "Switch to Picture mode, in which a quarter-plane screen model is used. Printing characters replace instead of inserting themselves with motion afterwards settable by these commands: C-c < Move left after insertion. C-c > Move right after insertion. C-c ^ Move up after insertion. C-c . Move down after insertion. C-c ` Move northwest (nw) after insertion. C-c ' Move northeast (ne) after insertion. C-c / Move southwest (sw) after insertion. C-c \\ Move southeast (se) after insertion. The current direction is displayed in the mode line. The initial direction is right. Whitespace is inserted and tabs are changed to spaces when required by movement. You can move around in the buffer with these commands: \\[picture-move-down] Move vertically to SAME column in previous line. \\[picture-move-up] Move vertically to SAME column in next line. \\[picture-end-of-line] Move to column following last non-whitespace character. \\[picture-forward-column] Move right inserting spaces if required. \\[picture-backward-column] Move left changing tabs to spaces if required. C-c C-f Move in direction of current picture motion. C-c C-b Move in opposite direction of current picture motion. Return Move to beginning of next line. You can edit tabular text with these commands: M-Tab Move to column beneath (or at) next interesting character. `Indents' relative to a previous line. Tab Move to next stop in tab stop list. C-c Tab Set tab stops according to context of this line. With ARG resets tab stops to default (global) value. See also documentation of variable picture-tab-chars which defines \"interesting character\". You can manually change the tab stop list with command \\[edit-tab-stops]. You can manipulate text with these commands: C-d Clear (replace) ARG columns after point without moving. C-c C-d Delete char at point - the command normally assigned to C-d. \\[picture-backward-clear-column] Clear (replace) ARG columns before point, moving back over them. \\[picture-clear-line] Clear ARG lines, advancing over them. The cleared text is saved in the kill ring. \\[picture-open-line] Open blank line(s) beneath current line. You can manipulate rectangles with these commands: C-c C-k Clear (or kill) a rectangle and save it. C-c C-w Like C-c C-k except rectangle is saved in named register. C-c C-y Overlay (or insert) currently saved rectangle at point. C-c C-x Like C-c C-y except rectangle is taken from named register. \\[copy-rectangle-to-register] Copies a rectangle to a register. \\[advertised-undo] Can undo effects of rectangle overlay commands commands if invoked soon enough. You can return to the previous mode with: C-c C-c Which also strips trailing whitespace from every line. Stripping is suppressed by supplying an argument. Entry to this mode calls the value of picture-mode-hook if non-nil. Note that Picture mode commands will work outside of Picture mode, but they are not defaultly assigned to keys." (interactive) (if (eq major-mode 'picture-mode) (error "You are already editing a picture.") (make-local-variable 'picture-mode-old-local-map) (setq picture-mode-old-local-map (current-local-map)) (use-local-map picture-mode-map) (make-local-variable 'picture-mode-old-mode-name) (setq picture-mode-old-mode-name mode-name) (make-local-variable 'picture-mode-old-major-mode) (setq picture-mode-old-major-mode major-mode) (setq major-mode 'picture-mode) (make-local-variable 'picture-killed-rectangle) (setq picture-killed-rectangle nil) (make-local-variable 'tab-stop-list) (setq tab-stop-list (default-value 'tab-stop-list)) (make-local-variable 'picture-tab-chars) (setq picture-tab-chars (default-value 'picture-tab-chars)) (make-local-variable 'picture-vertical-step) (make-local-variable 'picture-horizontal-step) (make-local-variable 'picture-mode-old-truncate-lines) (setq picture-mode-old-truncate-lines truncate-lines) (setq truncate-lines t) (picture-set-motion 0 1) ;; edit-picture-hook is what we used to run, picture-mode-hook is in doc. (run-hooks 'edit-picture-hook 'picture-mode-hook) (message (substitute-command-keys "Type \\[picture-mode-exit] in this buffer to return it to %s mode.") picture-mode-old-mode-name))) ;;;###autoload (defalias 'edit-picture 'picture-mode) (defun picture-mode-exit (&optional nostrip) "Undo picture-mode and return to previous major mode. With no argument strips whitespace from end of every line in Picture buffer otherwise just return to previous mode." (interactive "P") (if (not (eq major-mode 'picture-mode)) (error "You aren't editing a Picture.") (if (not nostrip) (picture-clean)) (setq mode-name picture-mode-old-mode-name) (use-local-map picture-mode-old-local-map) (setq major-mode picture-mode-old-major-mode) (kill-local-variable 'tab-stop-list) (setq truncate-lines picture-mode-old-truncate-lines) (force-mode-line-update))) (defun picture-clean () "Eliminate whitespace at ends of lines." (save-excursion (goto-char (point-min)) (while (re-search-forward "[ \t][ \t]*$" nil t) (delete-region (match-beginning 0) (point))))) (provide 'picture) ;;; picture.el ends here emacs-19.30/lisp/pp.el100444 12120 1 14324 6045204571 13037 0ustar rmsdaemon;;; pp.el --- pretty printer for Emacs Lisp ;; Copyright (C) 1989, 1993 Free Software Foundation, Inc. ;; Author: Randal Schwartz ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (defvar pp-escape-newlines t "*Value of print-escape-newlines used by pp-* functions.") (defun pp-to-string (object) "Return a string containing the pretty-printed representation of OBJECT, any Lisp object. Quoting characters are used when needed to make output that `read' can handle, whenever this is possible." (save-excursion (set-buffer (generate-new-buffer " pp-to-string")) (unwind-protect (progn (lisp-mode-variables t) (let ((print-escape-newlines pp-escape-newlines)) (prin1 object (current-buffer))) (goto-char (point-min)) (while (not (eobp)) ;; (message "%06d" (- (point-max) (point))) (cond ((looking-at "\\s\(") (while (looking-at "\\s(") (forward-char 1))) ((and (looking-at "\\(quote[ \t]+\\)\\([^.)]\\)") (> (match-beginning 1) 1) (= ?\( (char-after (1- (match-beginning 1)))) ;; Make sure this is a two-element list. (save-excursion (goto-char (match-beginning 2)) (forward-sexp) ;; (looking-at "[ \t]*\)") ;; Avoid mucking with match-data; does this test work? (char-equal ?\) (char-after (point))))) ;; -1 gets the paren preceding the quote as well. (delete-region (1- (match-beginning 1)) (match-end 1)) (insert "'") (forward-sexp 1) (if (looking-at "[ \t]*\)") (delete-region (match-beginning 0) (match-end 0)) (error "Malformed quote")) (backward-sexp 1)) ((condition-case err-var (prog1 t (down-list 1)) (error nil)) (backward-char 1) (skip-chars-backward " \t") (delete-region (point) (progn (skip-chars-forward " \t") (point))) (if (not (char-equal ?' (char-after (1- (point))))) (insert ?\n))) ((condition-case err-var (prog1 t (up-list 1)) (error nil)) (while (looking-at "\\s)") (forward-char 1)) (skip-chars-backward " \t") (delete-region (point) (progn (skip-chars-forward " \t") (point))) (if (not (char-equal ?' (char-after (1- (point))))) (insert ?\n))) (t (goto-char (point-max))))) (goto-char (point-min)) (indent-sexp) (buffer-string)) (kill-buffer (current-buffer))))) ;;;###autoload (defun pp (object &optional stream) "Output the pretty-printed representation of OBJECT, any Lisp object. Quoting characters are printed when needed to make output that `read' can handle, whenever this is possible. Output stream is STREAM, or value of `standard-output' (which see)." (princ (pp-to-string object) (or stream standard-output))) ;;;###autoload (defun pp-eval-expression (expression) "Evaluate EXPRESSION and pretty-print value into a new display buffer. If the pretty-printed value fits on one line, the message line is used instead. Value is also consed on to front of variable values 's value." (interactive "xPp-eval: ") (setq values (cons (eval expression) values)) (let* ((old-show-function temp-buffer-show-function) ;; Use this function to display the buffer. ;; This function either decides not to display it at all ;; or displays it in the usual way. (temp-buffer-show-function (function (lambda (buf) (save-excursion (set-buffer buf) (goto-char (point-min)) (end-of-line 1) (if (or (< (1+ (point)) (point-max)) (>= (- (point) (point-min)) (screen-width))) (let ((temp-buffer-show-function old-show-function) (old-selected (selected-window)) (window (display-buffer buf))) (goto-char (point-min)) ; expected by some hooks ... (make-frame-visible (window-frame window)) (unwind-protect (progn (select-window window) (run-hooks 'temp-buffer-show-hook)) (select-window old-selected))) (message "%s" (buffer-substring (point-min) (point))) )))))) (with-output-to-temp-buffer "*Pp Eval Output*" (pp (car values))) (save-excursion (set-buffer "*Pp Eval Output*") (emacs-lisp-mode)))) ;;;###autoload (defun pp-eval-last-sexp (arg) "Run `pp-eval-expression' on sexp before point (which see). With argument, pretty-print output into current buffer. Ignores leading comment characters." (interactive "P") (let ((stab (syntax-table)) (pt (point)) start exp) (set-syntax-table emacs-lisp-mode-syntax-table) (save-excursion (forward-sexp -1) ;; If first line is commented, ignore all leading comments: (if (save-excursion (beginning-of-line) (looking-at "[ \t]*;")) (progn (setq exp (buffer-substring (point) pt)) (while (string-match "\n[ \t]*;+" exp start) (setq start (1+ (match-beginning 0)) exp (concat (substring exp 0 start) (substring exp (match-end 0))))) (setq exp (read exp))) (setq exp (read (current-buffer))))) (set-syntax-table stab) (if arg (insert (pp-to-string (eval exp))) (pp-eval-expression exp)))) ;;; Test cases for quote ;; (pp-eval-expression ''(quote quote)) ;; (pp-eval-expression ''((quote a) (quote b))) ;; (pp-eval-expression ''('a 'b)) ; same as above ;; (pp-eval-expression ''((quote (quote quote)) (quote quote))) ;; These do not satisfy the quote test. ;; (pp-eval-expression ''quote) ;; (pp-eval-expression ''(quote)) ;; (pp-eval-expression ''(quote . quote)) ;; (pp-eval-expression ''(quote a b)) ;; (pp-eval-expression ''(quotefoo)) ;; (pp-eval-expression ''(a b)) (provide 'pp) ; so (require 'pp) works ;;; pp.el ends here. emacs-19.30/lisp/profile.el100444 75424 13 26443 5561545725 14040 0ustar kwzhuser;;; profile.el --- generate run time measurements of Emacs Lisp functions ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc. ;; Author: Boaz Ben-Zvi ;; Created: 07 Feb 1992 ;; Version: 1.0 ;; Adapted-By: ESR ;; Keywords: lisp, tools ;; 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: ; DESCRIPTION: ; ------------ ; This program can be used to monitor running time performance of Emacs Lisp ; functions. It takes a list of functions and report the real time spent ; inside these functions. It runs a process with a separate timer program. ; Caveat: the C code in ../lib-src/profile.c requires BSD-compatible ; time-of-day functions. If you're running an AT&T version prior to SVr4, ; you may have difficulty getting it to work. Your X library may supply ; the required routines if the standard C library does not. ; HOW TO USE: ; ----------- ; Set the variable profile-functions-list to the list of functions ; (as symbols) You want to profile. Call M-x profile-functions to set ; this list on and start using your program. Note that profile-functions ; MUST be called AFTER all the functions in profile-functions-list have ; been loaded !! (This call modifies the code of the profiled functions. ; Hence if you reload these functions, you need to call profile-functions ; again! ). ; To display the results do M-x profile-results . For example: ;------------------------------------------------------------------- ; (setq profile-functions-list '(sokoban-set-mode-line sokoban-load-game ; sokoban-move-vertical sokoban-move)) ; (load "sokoban") ; M-x profile-functions ; ... I play the sokoban game .......... ; M-x profile-results ; ; Function Time (Seconds.Useconds) ; ======== ======================= ; sokoban-move 0.539088 ; sokoban-move-vertical 0.410130 ; sokoban-load-game 0.453235 ; sokoban-set-mode-line 1.949203 ;----------------------------------------------------- ; To clear all the settings to profile use profile-finish. ; To set one function at a time (instead of or in addition to setting the ; above list and M-x profile-functions) use M-x profile-a-function. ;;; Code: ;;; ;;; User modifiable VARIABLES ;;; (defvar profile-functions-list nil "*List of functions to profile.") (defvar profile-timer-program (concat exec-directory "profile") "*Name of the profile timer program.") ;;; ;;; V A R I A B L E S ;;; (defvar profile-timer-process nil "Process running the timer.") (defvar profile-time-list nil "List of accumulative time for each profiled function.") (defvar profile-init-list nil "List of entry time for each function. \n\ Both how many times invoked and real time of start.") (defvar profile-max-fun-name 0 "Max length of name of any function profiled.") (defvar profile-temp-result- nil "Should NOT be used anywhere else.") (defvar profile-time (cons 0 0) "Used to return result from a filter.") (defvar profile-buffer "*profile*" "Name of profile buffer.") ;;; ;;; F U N C T I O N S ;;; (defun profile-functions (&optional flist) "Profile all the functions listed in `profile-functions-list'.\n\ With argument FLIST, use the list FLIST instead." (interactive "*P") (if (null flist) (setq flist profile-functions-list)) (mapcar 'profile-a-function flist)) (defun profile-filter (process input) "Filter for the timer process. Sets `profile-time' to the returned time." (if (zerop (string-match "\\." input)) (error "Bad output from %s" profile-timer-program) (setcar profile-time (string-to-int (substring input 0 (match-beginning 0)))) (setcdr profile-time (string-to-int (substring input (match-end 0)))))) (defun profile-print (entry) "Print one ENTRY (from `profile-time-list')." (let ((time (cdr entry)) str (offset 5)) (insert (format "%s" (car entry)) space) (move-to-column ref-column) (setq str (int-to-string (car time))) (insert str) (if (>= (length str) offset) nil (move-to-column ref-column) (insert (substring spaces 0 (- offset (length str)))) (forward-char (length str))) (setq str (int-to-string (cdr time))) (insert "." (substring "000000" 0 (- 6 (length str))) str "\n"))) (defconst spaces " ") (defun profile-results () "Display profiling results in the buffer `*profile*'. \(The buffer name comes from `profile-buffer'.)" (interactive) (let* ((ref-column (+ 8 profile-max-fun-name)) (space (substring spaces 0 ref-column))) (switch-to-buffer profile-buffer) (erase-buffer) (insert "Function" space) (move-to-column ref-column) (insert "Time (Seconds.Useconds)\n" "========" space ) (move-to-column ref-column) (insert "=======================\n") (mapcar 'profile-print profile-time-list))) (defun profile-reset-timer () (process-send-string profile-timer-process "z\n")) (defun profile-check-zero-init-times (entry) "If ENTRY has non zero time, give an error." (let ((time (cdr (cdr entry)))) (if (and (zerop (car time)) (zerop (cdr time))) nil ; OK (error "Process timer died while making performance profile.")))) (defun profile-get-time () "Get time from timer process into `profile-time'." ;; first time or if process dies (if (and (processp profile-timer-process) (eq 'run (process-status profile-timer-process))) nil (setq profile-timer-process;; [re]start the timer process (start-process "timer" (get-buffer-create profile-buffer) profile-timer-program)) (set-process-filter profile-timer-process 'profile-filter) (process-kill-without-query profile-timer-process) (profile-reset-timer) ;; check if timer died during time measurement (mapcar 'profile-check-zero-init-times profile-init-list)) ;; make timer process return current time (process-send-string profile-timer-process "p\n") (accept-process-output)) (defun profile-find-function (fun flist) "Linear search for FUN in FLIST." (if (null flist) nil (if (eq fun (car (car flist))) (cdr (car flist)) (profile-find-function fun (cdr flist))))) (defun profile-start-function (fun) "On entry, keep current time for function FUN." ;; assumes that profile-time contains the current time (let ((init-time (profile-find-function fun profile-init-list))) (if (null init-time) (error "Function %s missing from list" fun)) (if (not (zerop (car init-time)));; is it a recursive call ? (setcar init-time (1+ (car init-time))) (setcar init-time 1) ; mark first entry (setq init-time (cdr init-time)) (setcar init-time (car profile-time)) (setcdr init-time (cdr profile-time))) )) (defconst profile-million 1000000) (defun profile-update-function (fun) "When the call to the function FUN is finished, add its run time." ;; assumes that profile-time contains the current time (let ((init-time (profile-find-function fun profile-init-list)) (accum (profile-find-function fun profile-time-list)) sec usec) (if (or (null init-time) (null accum)) (error "Function %s missing from list" fun)) (setcar init-time (1- (car init-time))) ; pop one level in recursion (if (not (zerop (car init-time))) nil ; in some recursion level, do not update accum. time (setq init-time (cdr init-time)) (setq sec (- (car profile-time) (car init-time)) usec (- (cdr profile-time) (cdr init-time))) (setcar init-time 0) ; reset time to check for error (setcdr init-time 0) ; in case timer process dies (if (>= usec 0) nil (setq usec (+ usec profile-million)) (setq sec (1- sec))) (setcar accum (+ sec (car accum))) (setcdr accum (+ usec (cdr accum))) (if (< (cdr accum) profile-million) nil (setcar accum (1+ (car accum))) (setcdr accum (- (cdr accum) profile-million))) ))) (defun profile-a-function (fun) "Profile the function FUN." (interactive "aFunction to profile: ") (let ((def (symbol-function fun)) (funlen (length (symbol-name fun)))) (if (eq (car def) 'lambda) nil (error "To profile: %s must be a user-defined function" fun)) (setq profile-time-list ; add a new entry (cons (cons fun (cons 0 0)) profile-time-list)) (setq profile-init-list ; add a new entry (cons (cons fun (cons 0 (cons 0 0))) profile-init-list)) (if (< profile-max-fun-name funlen) (setq profile-max-fun-name funlen)) (fset fun (profile-fix-fun fun def)))) (defun profile-fix-fun (fun def) "Take function FUN and return it fixed for profiling.\n\ DEF is (symbol-function FUN)." (let (prefix first second third (count 2) inter suffix) (if (< (length def) 3) nil ; nothing to see (setq first (car def) second (car (cdr def)) third (car (nthcdr 2 def))) (setq prefix (list first second)) (if (and (stringp third) (< (length def) 3)) nil ; nothing to see (if (not (stringp third)) (setq inter third) (setq count 3 ; suffix to start after doc string prefix (nconc prefix (list third)) inter (car (nthcdr 3 def))) ; fourth sexp ) (if (not (and (listp inter) (eq (car inter) 'interactive))) nil (setq prefix (nconc prefix (list inter))) (setq count (1+ count))) ; skip this sexp for suffix (setq suffix (nthcdr count def)) (if (equal (car suffix) '(profile-get-time)) nil;; already set ;; prepare new function (nconc prefix (list '(profile-get-time)) ; read time (list (list 'profile-start-function (list 'quote fun))) (list (list 'setq 'profile-temp-result- (nconc (list 'progn) suffix))) (list '(profile-get-time)) ; read time (list (list 'profile-update-function (list 'quote fun))) (list 'profile-temp-result-) )))))) (defun profile-restore-fun (fun) "Restore profiled function FUN to its original state." (let ((def (symbol-function (car fun))) body index) ;; move index beyond header (setq index (cdr def)) (if (stringp (car (cdr index))) (setq index (cdr index))) (if (and (listp (car (cdr index))) (eq (car (car (cdr index))) 'interactive)) (setq index (cdr index))) (setq body (car (nthcdr 3 index))) (if (and (listp body) ; the right element ? (eq (car (cdr body)) 'profile-temp-result-)) (setcdr index (cdr (car (cdr (cdr body)))))))) (defun profile-finish () "Stop profiling functions. Clear all the settings." (interactive) (mapcar 'profile-restore-fun profile-time-list) (setq profile-max-fun-name 0) (setq profile-time-list nil) (setq profile-init-list nil)) (defun profile-quit () "Kill the timer process." (interactive) (process-send-string profile-timer-process "q\n")) ;;; profile.el ends here emacs-19.30/lisp/prolog.el100444 22552 1 21703 5725363170 14255 0ustar borisdaemon;;; prolog.el --- major mode for editing and running Prolog under Emacs ;; Copyright (C) 1986, 1987 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Keywords: languages ;; 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 package provides a major mode for editing Prolog. It knows ;; about Prolog syntax and comments, and can send regions to an inferior ;; Prolog interpreter process. ;;; Code: (defvar prolog-mode-syntax-table nil) (defvar prolog-mode-abbrev-table nil) (defvar prolog-mode-map nil) (defvar prolog-program-name "prolog" "*Program name for invoking an inferior Prolog with `run-prolog'.") (defvar prolog-consult-string "reconsult(user).\n" "*(Re)Consult mode (for C-Prolog and Quintus Prolog). ") (defvar prolog-compile-string "compile(user).\n" "*Compile mode (for Quintus Prolog).") (defvar prolog-eof-string "end_of_file.\n" "*String that represents end of file for prolog. nil means send actual operating system end of file.") (defvar prolog-indent-width 4) (if prolog-mode-syntax-table () (let ((table (make-syntax-table))) (modify-syntax-entry ?_ "w" table) (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?/ "." table) (modify-syntax-entry ?* "." table) (modify-syntax-entry ?+ "." table) (modify-syntax-entry ?- "." table) (modify-syntax-entry ?= "." table) (modify-syntax-entry ?% "<" table) (modify-syntax-entry ?\n ">" table) (modify-syntax-entry ?< "." table) (modify-syntax-entry ?> "." table) (modify-syntax-entry ?\' "\"" table) (setq prolog-mode-syntax-table table))) (define-abbrev-table 'prolog-mode-abbrev-table ()) (defun prolog-mode-variables () (set-syntax-table prolog-mode-syntax-table) (setq local-abbrev-table prolog-mode-abbrev-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "%%\\|$\\|" page-delimiter)) ;'%%..' (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) (make-local-variable 'indent-line-function) (setq indent-line-function 'prolog-indent-line) (make-local-variable 'comment-start) (setq comment-start "%") (make-local-variable 'comment-start-skip) (setq comment-start-skip "%+ *") (make-local-variable 'comment-column) (setq comment-column 48) (make-local-variable 'comment-indent-function) (setq comment-indent-function 'prolog-comment-indent)) (defun prolog-mode-commands (map) (define-key map "\t" 'prolog-indent-line) (define-key map "\e\C-x" 'prolog-consult-region)) (if prolog-mode-map nil (setq prolog-mode-map (make-sparse-keymap)) (prolog-mode-commands prolog-mode-map)) ;;;###autoload (defun prolog-mode () "Major mode for editing Prolog code for Prologs. Blank lines and `%%...' separate paragraphs. `%'s start comments. Commands: \\{prolog-mode-map} Entry to this mode calls the value of `prolog-mode-hook' if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map prolog-mode-map) (setq major-mode 'prolog-mode) (setq mode-name "Prolog") (prolog-mode-variables) (run-hooks 'prolog-mode-hook)) (defun prolog-indent-line (&optional whole-exp) "Indent current line as Prolog code. With argument, indent any additional lines of the same clause rigidly along with this one (not yet)." (interactive "p") (let ((indent (prolog-indent-level)) (pos (- (point-max) (point))) beg) (beginning-of-line) (setq beg (point)) (skip-chars-forward " \t") (if (zerop (- indent (current-column))) nil (delete-region beg (point)) (indent-to indent)) (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) )) (defun prolog-indent-level () "Compute prolog indentation level." (save-excursion (beginning-of-line) (skip-chars-forward " \t") (cond ((looking-at "%%%") 0) ;Large comment starts ((looking-at "%[^%]") comment-column) ;Small comment starts ((bobp) 0) ;Beginning of buffer (t (let ((empty t) ind more less) (if (looking-at ")") (setq less t) ;Find close (setq less nil)) ;; See previous indentation (while empty (forward-line -1) (beginning-of-line) (if (bobp) (setq empty nil) (skip-chars-forward " \t") (if (not (or (looking-at "%[^%]") (looking-at "\n"))) (setq empty nil)))) (if (bobp) (setq ind 0) ;Beginning of buffer (setq ind (current-column))) ;Beginning of clause ;; See its beginning (if (looking-at "%%[^%]") ind ;; Real prolog code (if (looking-at "(") (setq more t) ;Find open (setq more nil)) ;; See its tail (end-of-prolog-clause) (or (bobp) (forward-char -1)) (cond ((looking-at "[,(;>]") (if (and more (looking-at "[^,]")) (+ ind prolog-indent-width) ;More indentation (max tab-width ind))) ;Same indentation ((looking-at "-") tab-width) ;TAB ((or less (looking-at "[^.]")) (max (- ind prolog-indent-width) 0)) ;Less indentation (t 0)) ;No indentation ))) ))) (defun end-of-prolog-clause () "Go to end of clause in this line." (beginning-of-line 1) (let* ((eolpos (save-excursion (end-of-line) (point)))) (if (re-search-forward comment-start-skip eolpos 'move) (goto-char (match-beginning 0))) (skip-chars-backward " \t"))) (defun prolog-comment-indent () "Compute prolog comment indentation." (cond ((looking-at "%%%") 0) ((looking-at "%%") (prolog-indent-level)) (t (save-excursion (skip-chars-backward " \t") ;; Insert one space at least, except at left margin. (max (+ (current-column) (if (bolp) 0 1)) comment-column))) )) ;;; ;;; Inferior prolog mode ;;; (defvar inferior-prolog-mode-map nil) (defun inferior-prolog-mode () "Major mode for interacting with an inferior Prolog process. The following commands are available: \\{inferior-prolog-mode-map} Entry to this mode calls the value of `prolog-mode-hook' with no arguments, if that value is non-nil. Likewise with the value of `comint-mode-hook'. `prolog-mode-hook' is called after `comint-mode-hook'. You can send text to the inferior Prolog from other buffers using the commands `send-region', `send-string' and \\[prolog-consult-region]. Commands: Tab indents for Prolog; with argument, shifts rest of expression rigidly with the current line. Paragraphs are separated only by blank lines and '%%'. '%'s start comments. Return at end of buffer sends line as input. Return not at end copies rest of line to end and sends it. \\[comint-kill-input] and \\[backward-kill-word] are kill commands, imitating normal Unix input editing. \\[comint-interrupt-subjob] interrupts the shell or its current subjob if any. \\[comint-stop-subjob] stops. \\[comint-quit-subjob] sends quit signal." (interactive) (require 'comint) (comint-mode) (setq major-mode 'inferior-prolog-mode mode-name "Inferior Prolog" comint-prompt-regexp "^| [ ?][- ] *") (prolog-mode-variables) (if inferior-prolog-mode-map nil (setq inferior-prolog-mode-map (copy-keymap comint-mode-map)) (prolog-mode-commands inferior-prolog-mode-map)) (use-local-map inferior-prolog-mode-map) (run-hooks 'prolog-mode-hook)) ;;;###autoload (defun run-prolog () "Run an inferior Prolog process, input and output via buffer *prolog*." (interactive) (require 'comint) (switch-to-buffer (make-comint "prolog" prolog-program-name)) (inferior-prolog-mode)) (defun prolog-consult-region (compile beg end) "Send the region to the Prolog process made by \"M-x run-prolog\". If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode." (interactive "P\nr") (save-excursion (if compile (send-string "prolog" prolog-compile-string) (send-string "prolog" prolog-consult-string)) (send-region "prolog" beg end) (send-string "prolog" "\n") ;May be unnecessary (if prolog-eof-string (send-string "prolog" prolog-eof-string) (process-send-eof "prolog")))) ;Send eof to prolog process. (defun prolog-consult-region-and-go (compile beg end) "Send the region to the inferior Prolog, and switch to *prolog* buffer. If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode." (interactive "P\nr") (prolog-consult-region compile beg end) (switch-to-buffer "*prolog*")) ;;; prolog.el ends here emacs-19.30/lisp/ps-print.el100444 12120 1 205411 6010476070 14210 0ustar rmsdaemon;;; ps-print.el --- Jim's Pretty-Good PostScript Generator for Emacs 19. ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Jim Thompson ;; Keywords: print, PostScript ;; 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. ;; LCD Archive Entry: ;; ps-print|James C. Thompson|thompson@wg2.waii.com| ;; Jim's Pretty-Good PostScript Generator for Emacs 19 (ps-print)| ;; 26-Feb-1994|2.8|~/packages/ps-print.el| ;; Baseline-version: 2.8. (Jim's last change version -- this ;; file may have been edited as part of Emacs without changes to the ;; version number. When reporting bugs, please also report the ;; version of Emacs, if any, that ps-print was distributed with.) ;;; Commentary: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; About ps-print ;; -------------- ;; This package provides printing of Emacs buffers on PostScript ;; printers; the buffer's bold and italic text attributes are ;; preserved in the printer output. Ps-print is intended for use with ;; Emacs 19 or Lucid Emacs, together with a fontifying package such as ;; font-lock or hilit. ;; ;; Using ps-print ;; -------------- ;; ;; The Commands ;; ;; Ps-print provides eight commands for generating PostScript images ;; of Emacs buffers: ;; ;; ps-print-buffer ;; ps-print-buffer-with-faces ;; ps-print-region ;; ps-print-region-with-faces ;; ps-spool-buffer ;; ps-spool-buffer-with-faces ;; ps-spool-region ;; ps-spool-region-with-faces ;; ;; These commands all perform essentially the same function: they ;; generate PostScript images suitable for printing on a PostScript ;; printer or displaying with GhostScript. These commands are ;; collectively referred to as "ps-print- commands". ;; ;; The word "print" or "spool" in the command name determines when the ;; PostScript image is sent to the printer: ;; ;; print - The PostScript image is immediately sent to the ;; printer; ;; ;; spool - The PostScript image is saved temporarily in an ;; Emacs buffer. Many images may be spooled locally ;; before printing them. To send the spooled images ;; to the printer, use the command ps-despool. ;; ;; The spooling mechanism was designed for printing lots of small ;; files (mail messages or netnews articles) to save paper that would ;; otherwise be wasted on banner pages, and to make it easier to find ;; your output at the printer (it's easier to pick up one 50-page ;; printout than to find 50 single-page printouts). ;; ;; Ps-print has a hook in the kill-emacs-hooks so that you won't ;; accidently quit from Emacs while you have unprinted PostScript ;; waiting in the spool buffer. If you do attempt to exit with ;; spooled PostScript, you'll be asked if you want to print it, and if ;; you decline, you'll be asked to confirm the exit; this is modeled ;; on the confirmation that Emacs uses for modified buffers. ;; ;; The word "buffer" or "region" in the command name determines how ;; much of the buffer is printed: ;; ;; buffer - Print the entire buffer. ;; ;; region - Print just the current region. ;; ;; The -with-faces suffix on the command name means that the command ;; will include font, color, and underline information in the ;; PostScript image, so the printed image can look as pretty as the ;; buffer. The ps-print- commands without the -with-faces suffix ;; don't include font, color, or underline information; images printed ;; with these commands aren't as pretty, but are faster to generate. ;; ;; Two ps-print- command examples: ;; ;; ps-print-buffer - print the entire buffer, ;; without font, color, or ;; underline information, and ;; send it immediately to the ;; printer. ;; ;; ps-spool-region-with-faces - print just the current region; ;; include font, color, and ;; underline information, and ;; spool the image in Emacs to ;; send to the printer later. ;; ;; ;; Invoking Ps-Print ;; ;; To print your buffer, type ;; ;; M-x ps-print-buffer ;; ;; or substitute one of the other seven ps-print- commands. The ;; command will generate the PostScript image and print or spool it as ;; specified. By giving the command a prefix argument ;; ;; C-u M-x ps-print-buffer ;; ;; it will save the PostScript image to a file instead of sending it ;; to the printer; you will be prompted for the name of the file to ;; save the image to. The prefix argument is ignored by the commands ;; that spool their images, but you may save the spooled images to a ;; file by giving a prefix argument to ps-despool: ;; ;; C-u M-x ps-despool ;; ;; When invoked this way, ps-despool will prompt you for the name of ;; the file to save to. ;; ;; Any of the ps-print- commands can be bound to keys; I recommend ;; binding ps-spool-buffer-with-faces, ps-spool-region-with-faces, and ;; ps-despool. Here are the bindings I use on my Sun 4 keyboard: ;; ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces) ;; (global-set-key '(control f22) 'ps-despool) ;; ;; ;; The Printer Interface ;; ;; The variables ps-lpr-command and ps-lpr-switches determine what ;; command is used to send the PostScript images to the printer, and ;; what arguments to give the command. These are analogous to lpr- ;; command and lpr-switches. ;; ;; NOTE: ps-lpr-command and ps-lpr-switches take their initial values ;; from the variables lpr-command and lpr-switches. If you have ;; lpr-command set to invoke a pretty-printer such as enscript, ;; then ps-print won't work properly. ps-lpr-command must name ;; a program that does not format the files it prints. ;; ;; ;; How Ps-Print Deals With Fonts ;; ;; The ps-print-*-with-faces commands attempt to determine which faces ;; should be printed in bold or italic, but their guesses aren't ;; always right. For example, you might want to map colors into faces ;; so that blue faces print in bold, and red faces in italic. ;; ;; It is possible to force ps-print to consider specific faces bold or ;; italic, no matter what font they are displayed in, by setting the ;; variables ps-bold-faces and ps-italic-faces. These variables ;; contain lists of faces that ps-print should consider bold or ;; italic; to set them, put code like the following into your .emacs ;; file: ;; ;; (setq ps-bold-faces '(my-blue-face)) ;; (setq ps-italic-faces '(my-red-face)) ;; ;; Faces like bold-italic that are both bold and italic should go in ;; *both* lists. ;; ;; Ps-print does not attempt to guess the sizes of fonts; all text is ;; rendered using the Courier font family, in 10 point size. To ;; change the font family, change the variables ps-font, ps-font-bold, ;; ps-font-italic, and ps-font-bold-italic; fixed-pitch fonts work ;; best, but are not required. To change the font size, change the ;; variable ps-font-size. ;; ;; If you change the font family or size, you MUST also change the ;; variables ps-line-height, ps-avg-char-width, and ps-space-width, or ;; ps-print cannot correctly place line and page breaks. ;; ;; Ps-print keeps internal lists of which fonts are bold and which are ;; italic; these lists are built the first time you invoke ps-print. ;; For the sake of efficiency, the lists are built only once; the same ;; lists are referred in later invokations of ps-print. ;; ;; Because these lists are built only once, it's possible for them to ;; get out of sync, if a face changes, or if new faces are added. To ;; get the lists back in sync, you can set the variable ;; ps-build-face-reference to t, and the lists will be rebuilt the ;; next time ps-print is invoked. ;; ;; ;; How Ps-Print Deals With Color ;; ;; Ps-print detects faces with foreground and background colors ;; defined and embeds color information in the PostScript image. The ;; default foreground and background colors are defined by the ;; variables ps-default-fg and ps-default-bg. On black-and-white ;; printers, colors are displayed in grayscale. To turn off color ;; output, set ps-print-color-p to nil. ;; ;; ;; Headers ;; ;; Ps-print can print headers at the top of each page; the default ;; headers contain the following four items: on the left, the name of ;; the buffer and, if the buffer is visiting a file, the file's ;; directory; on the right, the page number and date of printing. The ;; default headers look something like this: ;; ;; ps-print.el 1/21 ;; /home/jct/emacs-lisp/ps/new 94/12/31 ;; ;; When printing on duplex printers, left and right are reversed so ;; that the page numbers are toward the outside. ;; ;; Headers are configurable. To turn them off completely, set ;; ps-print-header to nil. To turn off the header's gaudy framing ;; box, set ps-print-header-frame to nil. Page numbers are printed in ;; "n/m" format, indicating page n of m pages; to omit the total page ;; count and just print the page number, set ps-show-n-of-n to nil. ;; ;; The amount of information in the header can be changed by changing ;; the number of lines. To show less, set ps-header-lines to 1, and ;; the header will show only the buffer name and page number. To show ;; more, set ps-header-lines to 3, and the header will show the time of ;; printing below the date. ;; ;; To change the content of the headers, change the variables ;; ps-left-header and ps-right-header. These variables are lists, ;; specifying top-to-bottom the text to display on the left or right ;; side of the header. Each element of the list should be a string or ;; a symbol. Strings are inserted directly into the PostScript ;; arrays, and should contain the PostScript string delimiters '(' and ;; ')'. ;; ;; Symbols in the header format lists can either represent functions ;; or variables. Functions are called, and should return a string to ;; show in the header. Variables should contain strings to display in ;; the header. In either case, function or variable, the PostScript ;; strings delimeters are added by ps-print, and should not be part of ;; the returned value. ;; ;; Here's an example: say we want the left header to display the text ;; ;; Moe ;; Larry ;; Curly ;; ;; where we have a function to return "Moe" ;; ;; (defun moe-func () ;; "Moe") ;; ;; a variable specifying "Larry" ;; ;; (setq larry-var "Larry") ;; ;; and a literal for "Curly". Here's how ps-left-header should be ;; set: ;; ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)")) ;; ;; Note that Curly has the PostScript string delimiters inside his ;; quotes -- those aren't misplaced lisp delimiters! Without them, ;; PostScript would attempt to call the undefined function Curly, ;; which would result in a PostScript error. Since most printers ;; don't report PostScript errors except by aborting the print job, ;; this kind of error can be hard to track down. Consider yourself ;; warned. ;; ;; ;; Duplex Printers ;; ;; If you have a duplex-capable printer (one that prints both sides of ;; the paper), set ps-spool-duplex to t. Ps-print will insert blank ;; pages to make sure each buffer starts on the correct side of the ;; paper. Don't forget to set ps-lpr-switches to select duplex ;; printing for your printer. ;; ;; ;; Paper Size ;; ;; The variable ps-paper-type determines the size of paper ps-print ;; formats for; it should contain one of the symbols ps-letter, ;; ps-legal, or ps-a4. The default is ps-letter. ;; ;; ;; Installing ps-print ;; ------------------- ;; ;; 1. Place ps-print.el somewhere in your load-path and byte-compile ;; it. You can ignore all byte-compiler warnings; they are the ;; result of multi-Emacs support. This step is necessary only if ;; you're installing your own ps-print; if ps-print came with your ;; copy of Emacs, this been done already. ;; ;; 2. Place in your .emacs file the line ;; ;; (require 'ps-print) ;; ;; to load ps-print. Or you may cause any of the ps-print commands ;; to be autoloaded with an autoload command such as: ;; ;; (autoload 'ps-print-buffer "ps-print" ;; "Generate and print a PostScript image of the buffer..." t) ;; ;; 3. Make sure that the variables ps-lpr-command and ps-lpr-switches ;; contain appropriate values for your system; see the usage notes ;; below and the documentation of these variables. ;; ;; New since version 1.5 ;; --------------------- ;; Color output capability. ;; ;; Automatic detection of font attributes (bold, italic). ;; ;; Configurable headers with page numbers. ;; ;; Slightly faster. ;; ;; Support for different paper sizes. ;; ;; Better conformance to PostScript Document Structure Conventions. ;; ;; ;; Known bugs and limitations of ps-print: ;; -------------------------------------- ;; Although color printing will work in XEmacs 19.12, it doesn't work ;; well; in particular, bold or italic fonts don't print in the right ;; background color. ;; ;; Invisible properties aren't correctly ignored in XEmacs 19.12. ;; ;; Automatic font-attribute detection doesn't work well, especially ;; with hilit19 and older versions of get-create-face. Users having ;; problems with auto-font detection should use the lists ps-italic- ;; faces and ps-bold-faces and/or turn off automatic detection by ;; setting ps-auto-font-detect to nil. ;; ;; Automatic font-attribute detection doesn't work with XEmacs 19.12 ;; in tty mode; use the lists ps-italic-faces and ps-bold-faces ;; instead. ;; ;; Still too slow; could use some hand-optimization. ;; ;; ASCII Control characters other than tab, linefeed and pagefeed are ;; not handled. ;; ;; Default background color isn't working. ;; ;; Faces are always treated as opaque. ;; ;; Epoch and Emacs 18 not supported. At all. ;; ;; ;; Features to add: ;; --------------- ;; 2-up and 4-up capability. ;; ;; Line numbers. ;; ;; Wide-print (landscape) capability. ;; ;; ;; Acknowledgements ;; ---------------- ;; Thanks to Kevin Rodgers for adding support for ;; color and the invisible property. ;; ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing ;; the initial port to Emacs 19. His code is no longer part of ;; ps-print, but his work is still appreciated. ;; ;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org, ;; for adding underline support. Their code also is no longer part of ;; ps-print, but their efforts are not forgotten. ;; ;; Thanks also to all of you who mailed code to add features to ;; ps-print; although I didn't use your code, I still appreciate your ;; sharing it with me. ;; ;; Thanks to all who mailed comments, encouragement, and criticism. ;; Thanks also to all who responded to my survey; I had too many ;; responses to reply to them all, but I greatly appreciate your ;; interest. ;; ;; Jim ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Code: (defconst ps-print-version "2.8" "ps-print.el,v 2.8 1995/05/04 12:06:10 jct Exp Jim's last change version -- this file may have been edited as part of Emacs without changes to the version number. When reporting bugs, please also report the version of Emacs, if any, that ps-print was distributed with. Please send all bug fixes and enhancements to Jim Thompson .") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User Variables: (defvar ps-lpr-command lpr-command "*The shell command for printing a PostScript file.") (defvar ps-lpr-switches lpr-switches "*A list of extra switches to pass to `ps-lpr-command'.") (defvar ps-spool-duplex nil ; Not many people have duplex ; printers, so default to nil. "*Non-nil indicates spooling is for a two-sided printer. For a duplex printer, the `ps-spool-*' commands will insert blank pages as needed between print jobs so that the next buffer printed will start on the right page. Also, if headers are turned on, the headers will be reversed on duplex printers so that the page numbers fall to the left on even-numbered pages.") (defvar ps-paper-type 'ps-letter "*Specifies the size of paper to format for. Should be one of `ps-letter', `ps-legal', or `ps-a4'.") (defvar ps-print-header t "*Non-nil means print a header at the top of each page. By default, the header displays the buffer name, page number, and, if the buffer is visiting a file, the file's directory. Headers are customizable by changing variables `ps-header-left' and `ps-header-right'.") (defvar ps-print-header-frame t "*Non-nil means draw a gaudy frame around the header.") (defvar ps-show-n-of-n t "*Non-nil means show page numbers as N/M, meaning page N of M. Note: page numbers are displayed as part of headers, see variable `ps-print-headers'.") (defvar ps-print-color-p (and (or (fboundp 'x-color-values) ; Emacs (fboundp 'pixel-components)) ; XEmacs (fboundp 'float)) ; Printing color requires both floating point and x-color-values. "*If non-nil, print the buffer's text in color.") (defvar ps-default-fg '(0.0 0.0 0.0) "*RGB values of the default foreground color. Defaults to black.") (defvar ps-default-bg '(1.0 1.0 1.0) "*RGB values of the default background color. Defaults to white.") (defvar ps-font-size 10 "*Font size, in points, for generating Postscript.") (defvar ps-font "Courier" "*Font family name for ordinary text, when generating Postscript.") (defvar ps-font-bold "Courier-Bold" "*Font family name for bold text, when generating Postscript.") (defvar ps-font-italic "Courier-Oblique" "*Font family name for italic text, when generating Postscript.") (defvar ps-font-bold-italic "Courier-BoldOblique" "*Font family name for bold italic text, when generating Postscript.") (defvar ps-avg-char-width (if (fboundp 'float) 5.6 6) "*The average width, in points, of a character, for generating Postscript. This is the value that ps-print uses to determine the length, x-dimension, of the text it has printed, and thus affects the point at which long lines wrap around. If you change the font or font size, you will probably have to adjust this value to match.") (defvar ps-space-width (if (fboundp 'float) 5.6 6) "*The width of a space character, for generating Postscript. This value is used in expanding tab characters.") (defvar ps-line-height (if (fboundp 'float) 11.29 11) "*The height of a line, for generating Postscript. This is the value that ps-print uses to determine the height, y-dimension, of the lines of text it has printed, and thus affects the point at which page-breaks are placed. If you change the font or font size, you will probably have to adjust this value to match. The line-height is *not* the same as the point size of the font.") (defvar ps-auto-font-detect t "*Non-nil means automatically detect bold/italic face attributes. nil means rely solely on the lists `ps-bold-faces', `ps-italic-faces', and `ps-underlined-faces'.") (defvar ps-bold-faces '() "*A list of the \(non-bold\) faces that should be printed in bold font. This applies to generating Postscript.") (defvar ps-italic-faces '() "*A list of the \(non-italic\) faces that should be printed in italic font. This applies to generating Postscript.") (defvar ps-underlined-faces '() "*A list of the \(non-underlined\) faces that should be printed underlined. This applies to generating Postscript.") (defvar ps-header-lines 2 "*Number of lines to display in page header, when generating Postscript.") (make-variable-buffer-local 'ps-header-lines) (defvar ps-left-header (list 'ps-get-buffer-name 'ps-header-dirpart) "*The items to display on the right part of the page header. This applies to generating Postscript. The value should be a list of strings and symbols, each representing an entry in the PostScript array HeaderLinesLeft. Strings are inserted unchanged into the array; those representing PostScript string literals should be delimited with PostScript string delimiters '(' and ')'. For symbols with bound functions, the function is called and should return a string to be inserted into the array. For symbols with bound values, the value should be a string to be inserted into the array. In either case, function or variable, the string value has PostScript string delimiters added to it.") (make-variable-buffer-local 'ps-left-header) (defvar ps-right-header (list "/pagenumberstring load" 'time-stamp-yy/mm/dd 'time-stamp-hh:mm:ss) "*The items to display on the left part of the page header. This applies to generating Postscript. See the variable `ps-left-header' for a description of the format of this variable.") (make-variable-buffer-local 'ps-right-header) (defvar ps-razzle-dazzle t "*Non-nil means report progress while formatting buffer.") (defvar ps-adobe-tag "%!PS-Adobe-1.0\n" "*Contains the header line identifying the output as PostScript. By default, `ps-adobe-tag' contains the standard identifier. Some printers require slightly different versions of this line.") (defvar ps-build-face-reference t "*Non-nil means build the reference face lists. Ps-print sets this value to nil after it builds its internal reference lists of bold and italic faces. By settings its value back to t, you can force ps-print to rebuild the lists the next time you invoke one of the ...-with-faces commands. You should set this value back to t after you change the attributes of any face, or create new faces. Most users shouldn't have to worry about its setting, though.") (defvar ps-always-build-face-reference nil "*Non-nil means always rebuild the reference face lists. If this variable is non-nil, ps-print will rebuild its internal reference lists of bold and italic faces *every* time one of the -with-faces commands is called. Most users shouldn't need to set this variable.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User commands ;;;###autoload (defun ps-print-buffer (&optional filename) "Generate and print a PostScript image of the buffer. When called with a numeric prefix argument (C-u), prompts the user for the name of a file to save the PostScript image in, instead of sending it to the printer. More specifically, the FILENAME argument is treated as follows: if it is nil, send the image to the printer. If FILENAME is a string, save the PostScript image in a file with that name. If FILENAME is a number, prompt the user for the name of the file to save in." (interactive (list (ps-print-preprint current-prefix-arg))) (ps-generate (current-buffer) (point-min) (point-max) 'ps-generate-postscript) (ps-do-despool filename)) ;;;###autoload (defun ps-print-buffer-with-faces (&optional filename) "Generate and print a PostScript image of the buffer. Like `ps-print-buffer', but includes font, color, and underline information in the generated image." (interactive (list (ps-print-preprint current-prefix-arg))) (ps-generate (current-buffer) (point-min) (point-max) 'ps-generate-postscript-with-faces) (ps-do-despool filename)) ;;;###autoload (defun ps-print-region (from to &optional filename) "Generate and print a PostScript image of the region. Like `ps-print-buffer', but prints just the current region." (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg))) (ps-generate (current-buffer) from to 'ps-generate-postscript) (ps-do-despool filename)) ;;;###autoload (defun ps-print-region-with-faces (from to &optional filename) "Generate and print a PostScript image of the region. Like `ps-print-region', but includes font, color, and underline information in the generated image." (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg))) (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces) (ps-do-despool filename)) ;;;###autoload (defun ps-spool-buffer () "Generate and spool a PostScript image of the buffer. Like `ps-print-buffer' except that the PostScript image is saved in a local buffer to be sent to the printer later. Use the command `ps-despool' to send the spooled images to the printer." (interactive) (ps-generate (current-buffer) (point-min) (point-max) 'ps-generate-postscript)) ;;;###autoload (defun ps-spool-buffer-with-faces () "Generate and spool a PostScript image of the buffer. Like `ps-spool-buffer', but includes font, color, and underline information in the generated image. Use the command `ps-despool' to send the spooled images to the printer." (interactive) (ps-generate (current-buffer) (point-min) (point-max) 'ps-generate-postscript-with-faces)) ;;;###autoload (defun ps-spool-region (from to) "Generate a PostScript image of the region and spool locally. Like `ps-spool-buffer', but spools just the current region. Use the command `ps-despool' to send the spooled images to the printer." (interactive "r") (ps-generate (current-buffer) from to 'ps-generate-postscript)) ;;;###autoload (defun ps-spool-region-with-faces (from to) "Generate a PostScript image of the region and spool locally. Like `ps-spool-region', but includes font, color, and underline information in the generated image. Use the command `ps-despool' to send the spooled images to the printer." (interactive "r") (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces)) ;;;###autoload (defun ps-despool (&optional filename) "Send the spooled PostScript to the printer. When called with a numeric prefix argument (C-u), prompt the user for the name of a file to save the spooled PostScript in, instead of sending it to the printer. More specifically, the FILENAME argument is treated as follows: if it is nil, send the image to the printer. If FILENAME is a string, save the PostScript image in a file with that name. If FILENAME is a number, prompt the user for the name of the file to save in." (interactive (list (ps-print-preprint current-prefix-arg))) (ps-do-despool filename)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Utility functions and variables: (defvar ps-print-emacs-type (cond ((string-match "XEmacs" emacs-version) 'xemacs) ((string-match "Lucid" emacs-version) 'lucid) ((string-match "Epoch" emacs-version) 'epoch) (t 'emacs))) (if (or (eq ps-print-emacs-type 'lucid) (eq ps-print-emacs-type 'xemacs)) (if (< emacs-minor-version 12) (setq ps-print-color-p nil)) (require 'faces)) ; face-font, face-underline-p, ; x-font-regexp (require 'time-stamp) (defvar ps-print-prologue "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4: % If the ISOLatin1Encoding vector isn't known, define it. /ISOLatin1Encoding where { pop } { % Define the ISO Latin-1 encoding vector. % The first half is the same as the standard encoding, % except for minus instead of hyphen at code 055. /ISOLatin1Encoding StandardEncoding 0 45 getinterval aload pop /minus StandardEncoding 46 82 getinterval aload pop %*** NOTE: the following are missing in the Adobe documentation, %*** but appear in the displayed table: %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240. % \20x /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron % \24x /space /exclamdown /cent /sterling /currency /yen /brokenbar /section /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright /onequarter /onehalf /threequarters /questiondown % \30x /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn /germandbls % \34x /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex /idieresis /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn /ydieresis 256 packedarray def } ifelse /reencodeFontISO { %def dup length 5 add dict % Make a new font (a new dict % the same size as the old % one) with room for our new % symbols. begin % Make the new font the % current dictionary. { 1 index /FID ne { def } { pop pop } ifelse } forall % Copy each of the symbols % from the old dictionary to % the new except for the font % ID. /Encoding ISOLatin1Encoding def % Override the encoding with % the ISOLatin1 encoding. % Use the font's bounding box to determine the ascent, descent, % and overall height; don't forget that these values have to be % transformed using the font's matrix. FontBBox FontMatrix transform /Ascent exch def pop FontMatrix transform /Descent exch def pop /FontHeight Ascent Descent sub def % Define these in case they're not in the FontInfo (also, here % they're easier to get to. /UnderlinePosition 1 def /UnderlineThickness 1 def % Get the underline position and thickness if they're defined. currentdict /FontInfo known { FontInfo dup /UnderlinePosition known { dup /UnderlinePosition get 0 exch FontMatrix transform exch pop /UnderlinePosition exch def } if dup /UnderlineThickness known { /UnderlineThickness get 0 exch FontMatrix transform exch pop /UnderlineThickness exch def } if } if currentdict % Leave the new font on the % stack end % Stop using the font as the % current dictionary. definefont % Put the font into the font % dictionary pop % Discard the returned font. } bind def /Font { findfont exch scalefont reencodeFontISO } def /F { % Font select findfont dup /Ascent get /Ascent exch def dup /Descent get /Descent exch def dup /FontHeight get /FontHeight exch def dup /UnderlinePosition get /UnderlinePosition exch def dup /UnderlineThickness get /UnderlineThickness exch def setfont } def /FG /setrgbcolor load def /bg false def /BG { dup /bg exch def { mark 4 1 roll ] /bgcolor exch def } if } def /dobackground { % width -- currentpoint gsave newpath moveto 0 Ascent rmoveto dup 0 rlineto 0 Descent Ascent sub rlineto neg 0 rlineto closepath bgcolor aload pop setrgbcolor fill grestore } def /dobackgroundstring { % string -- stringwidth pop dobackground } def /dounderline { % fromx fromy -- currentpoint gsave UnderlineThickness setlinewidth 4 2 roll UnderlinePosition add moveto UnderlinePosition add lineto stroke grestore } def /eolbg { currentpoint pop PrintWidth LeftMargin add exch sub dobackground } def /eolul { currentpoint exch pop PrintWidth LeftMargin add exch dounderline } def /SL { % Soft Linefeed bg { eolbg } if ul { eolul } if currentpoint LineHeight sub LeftMargin exch moveto pop } def /HL /SL load def % Hard Linefeed /sp1 { currentpoint 3 -1 roll } def % Some debug /dcp { currentpoint exch 40 string cvs print (, ) print = } def /dp { print 2 copy exch 40 string cvs print (, ) print = } def /S { bg { dup dobackgroundstring } if ul { sp1 } if show ul { dounderline } if } def /W { ul { sp1 } if ( ) stringwidth % Get the width of a space pop % Discard the Y component mul % Multiply the width of a % space by the number of % spaces to plot bg { dup dobackground } if 0 rmoveto ul { dounderline } if } def /BeginDSCPage { /vmstate save def } def /BeginPage { PrintHeader { PrintHeaderFrame { HeaderFrame } if HeaderText } if LeftMargin BottomMargin PrintHeight add moveto % move to where printing will % start. } def /EndPage { bg { eolbg } if ul { eolul } if showpage % Spit out a page } def /EndDSCPage { vmstate restore } def /ul false def /UL { /ul exch def } def /h0 14 /Helvetica-Bold Font /h1 12 /Helvetica Font /h1 F /HeaderLineHeight FontHeight def /HeaderDescent Descent def /HeaderPad 2 def /SetHeaderLines { /HeaderOffset TopMargin 2 div def /HeaderLines exch def /HeaderHeight HeaderLines HeaderLineHeight mul HeaderPad 2 mul add def /PrintHeight PrintHeight HeaderHeight sub def } def /HeaderFrameStart { LeftMargin BottomMargin PrintHeight add HeaderOffset add } def /HeaderFramePath { PrintWidth 0 rlineto 0 HeaderHeight rlineto PrintWidth neg 0 rlineto 0 HeaderHeight neg rlineto } def /HeaderFrame { gsave 0.4 setlinewidth HeaderFrameStart moveto 1 -1 rmoveto HeaderFramePath 0 setgray fill HeaderFrameStart moveto HeaderFramePath gsave 0.9 setgray fill grestore gsave 0 setgray stroke grestore grestore } def /HeaderStart { HeaderFrameStart exch HeaderPad add exch HeaderLineHeight HeaderLines 1 sub mul add HeaderDescent sub HeaderPad add } def /strcat { dup length 3 -1 roll dup length dup 4 -1 roll add string dup 0 5 -1 roll putinterval dup 4 2 roll exch putinterval } def /pagenumberstring { PageNumber 32 string cvs ShowNofN { (/) strcat PageCount 32 string cvs strcat } if } def /HeaderText { HeaderStart moveto HeaderLinesRight HeaderLinesLeft Duplex PageNumber 1 and 0 eq and { exch } if { aload pop exch F gsave dup xcheck { exec } if show grestore 0 HeaderLineHeight neg rmoveto } forall HeaderStart moveto { aload pop exch F gsave dup xcheck { exec } if dup stringwidth pop PrintWidth exch sub HeaderPad 2 mul sub 0 rmoveto show grestore 0 HeaderLineHeight neg rmoveto } forall } def /ReportFontInfo { 2 copy /t0 3 1 roll Font /t0 F /lh FontHeight def /sw ( ) stringwidth pop def /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch stringwidth pop exch div def /t1 12 /Helvetica-Oblique Font /t1 F 72 72 moveto gsave (For ) show 128 string cvs show ( ) show 32 string cvs show ( point, the line height is ) show lh 32 string cvs show (, the space width is ) show sw 32 string cvs show (,) show grestore 0 FontHeight neg rmoveto (and a crude estimate of average character width is ) show aw 32 string cvs show (.) show showpage } def % 10 /Courier ReportFontInfo ") ;; Start Editing Here: (defvar ps-source-buffer nil) (defvar ps-spool-buffer-name "*PostScript*") (defvar ps-spool-buffer nil) (defvar ps-output-head nil) (defvar ps-output-tail nil) (defvar ps-page-count 0) (defvar ps-showpage-count 0) (defvar ps-current-font 0) (defvar ps-current-underline-p nil) (defvar ps-default-color (if ps-print-color-p ps-default-fg)) ; black (defvar ps-current-color ps-default-color) (defvar ps-current-bg nil) (defvar ps-razchunk 0) (defvar ps-color-format (if (eq ps-print-emacs-type 'emacs) ;;Emacs understands the %f format; we'll ;;use it to limit color RGB values to ;;three decimals to cut down some on the ;;size of the PostScript output. "%0.3f %0.3f %0.3f" ;; Lucid emacsen will have to make do with ;; %s (princ) for floats. "%s %s %s")) ;; These values determine how much print-height to deduct when headers ;; are turned on. This is a pretty clumsy way of handling it, but ;; it'll do for now. (defvar ps-header-title-line-height (if (fboundp 'float) 16.0 16));Helvetica 14 (defvar ps-header-line-height (if (fboundp 'float) 13.7 14));Helvetica 12 (defvar ps-header-pad 2) ;; LetterSmall 7.68 inch 10.16 inch ;; Tabloid 11.0 inch 17.0 inch ;; Ledger 17.0 inch 11.0 inch ;; Statement 5.5 inch 8.5 inch ;; Executive 7.5 inch 10.0 inch ;; A3 11.69 inch 16.5 inch ;; A4Small 7.47 inch 10.85 inch ;; B4 10.125 inch 14.33 inch ;; B5 7.16 inch 10.125 inch ;; All page dimensions are in PostScript points. (defvar ps-left-margin 72) ; 1 inch (defvar ps-right-margin 72) ; 1 inch (defvar ps-bottom-margin 36) ; 1/2 inch (defvar ps-top-margin 72) ; 1 inch ;; Letter 8.5 inch x 11.0 inch (defvar ps-letter-page-height 792) ; 11 inches (defvar ps-letter-page-width 612) ; 8.5 inches ;; Legal 8.5 inch x 14.0 inch (defvar ps-legal-page-height 1008) ; 14.0 inches (defvar ps-legal-page-width 612) ; 8.5 inches ;; A4 8.26 inch x 11.69 inch (defvar ps-a4-page-height 842) ; 11.69 inches (defvar ps-a4-page-width 595) ; 8.26 inches (defvar ps-pages-alist (list (list 'ps-letter ps-letter-page-width ps-letter-page-height) (list 'ps-legal ps-legal-page-width ps-legal-page-height) (list 'ps-a4 ps-a4-page-width ps-a4-page-height))) ;; Define some constants to index into the page lists. (defvar ps-page-width-i 1) (defvar ps-page-height-i 2) (defvar ps-page-dimensions nil) (defvar ps-print-width nil) (defvar ps-print-height nil) (defvar ps-height-remaining) (defvar ps-width-remaining) (defvar ps-ref-bold-faces nil) (defvar ps-ref-italic-faces nil) (defvar ps-ref-underlined-faces nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal functions (defun ps-get-page-dimensions () (setq ps-page-dimensions (assq ps-paper-type ps-pages-alist)) (let ((ps-page-width (nth ps-page-width-i ps-page-dimensions)) (ps-page-height (nth ps-page-height-i ps-page-dimensions))) (setq ps-print-height (- ps-page-height ps-top-margin ps-bottom-margin)) (setq ps-print-width (- ps-page-width ps-left-margin ps-right-margin)))) (defun ps-print-preprint (&optional filename) (if (and filename (or (numberp filename) (listp filename))) (let* ((name (concat (buffer-name) ".ps")) (prompt (format "Save PostScript to file: (default %s) " name))) (read-file-name prompt default-directory name nil)))) ;; The following functions implement a simple list-buffering scheme so ;; that ps-print doesn't have to repeatedly switch between buffers ;; while spooling. The functions ps-output and ps-output-string build ;; up the lists; the function ps-flush-output takes the lists and ;; insert its contents into the spool buffer (*PostScript*). (defun ps-output-string-prim (string) (insert "(") ;insert start-string delimiter (save-excursion ;insert string (insert string)) ;; Find and quote special characters as necessary for PS (while (re-search-forward "[()\\]" nil t) (save-excursion (forward-char -1) (insert "\\"))) (goto-char (point-max)) (insert ")")) ;insert end-string delimiter (defun ps-init-output-queue () (setq ps-output-head (list "")) (setq ps-output-tail ps-output-head)) (defun ps-output (&rest args) (setcdr ps-output-tail args) (while (cdr ps-output-tail) (setq ps-output-tail (cdr ps-output-tail)))) (defun ps-output-string (string) (ps-output t string)) (defun ps-flush-output () (save-excursion (set-buffer ps-spool-buffer) (goto-char (point-max)) (while ps-output-head (let ((it (car ps-output-head))) (if (not (eq t it)) (insert it) (setq ps-output-head (cdr ps-output-head)) (ps-output-string-prim (car ps-output-head)))) (setq ps-output-head (cdr ps-output-head)))) (ps-init-output-queue)) (defun ps-insert-file (fname) (ps-flush-output) ;; Check to see that the file exists and is readable; if not, throw ;; and error. (if (not (file-readable-p fname)) (error "Could not read file `%s'" fname)) (save-excursion (set-buffer ps-spool-buffer) (goto-char (point-max)) (insert-file fname))) ;; These functions insert the arrays that define the contents of the ;; headers. (defun ps-generate-header-line (fonttag &optional content) (ps-output " [ " fonttag " ") (cond ;; Literal strings should be output as is -- the string must ;; contain its own PS string delimiters, '(' and ')', if necessary. ((stringp content) (ps-output content)) ;; Functions are called -- they should return strings; they will be ;; inserted as strings and the PS string delimiters added. ((and (symbolp content) (fboundp content)) (ps-output-string (funcall content))) ;; Variables will have their contents inserted. They should ;; contain strings, and will be inserted as strings. ((and (symbolp content) (boundp content)) (ps-output-string (symbol-value content))) ;; Anything else will get turned into an empty string. (t (ps-output-string ""))) (ps-output " ]\n")) (defun ps-generate-header (name contents) (ps-output "/" name " [\n") (if (> ps-header-lines 0) (let ((count 1)) (ps-generate-header-line "/h0" (car contents)) (while (and (< count ps-header-lines) (setq contents (cdr contents))) (ps-generate-header-line "/h1" (car contents)) (setq count (+ count 1))) (ps-output "] def\n")))) (defun ps-output-boolean (name bool) (ps-output (format "/%s %s def\n" name (if bool "true" "false")))) (defun ps-begin-file () (setq ps-showpage-count 0) (ps-output ps-adobe-tag) (ps-output "%%Title: " (buffer-name) "\n") ;Take job name from name of ;first buffer printed (ps-output "%%Creator: " (user-full-name) "\n") (ps-output "%%CreationDate: " (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) "\n") (ps-output "%% DocumentFonts: Helvetica Helvetica-Bold " ps-font " " ps-font-bold " " ps-font-italic " " ps-font-bold-italic "\n") (ps-output "%%Pages: (atend)\n") (ps-output "%%EndComments\n\n") (ps-output-boolean "Duplex" ps-spool-duplex) (ps-output-boolean "PrintHeader" ps-print-header) (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame) (ps-output-boolean "ShowNofN" ps-show-n-of-n) (ps-output (format "/LeftMargin %d def\n" ps-left-margin)) (ps-output (format "/RightMargin %d def\n" ps-right-margin)) (ps-output (format "/BottomMargin %d def\n" ps-bottom-margin)) (ps-output (format "/TopMargin %d def\n" ps-top-margin)) (ps-get-page-dimensions) (ps-output (format "/PrintWidth %d def\n" ps-print-width)) (ps-output (format "/PrintHeight %d def\n" ps-print-height)) (ps-output (format "/LineHeight %s def\n" ps-line-height)) (ps-output ps-print-prologue) (ps-output (format "/f0 %d /%s Font\n" ps-font-size ps-font)) (ps-output (format "/f1 %d /%s Font\n" ps-font-size ps-font-bold)) (ps-output (format "/f2 %d /%s Font\n" ps-font-size ps-font-italic)) (ps-output (format "/f3 %d /%s Font\n" ps-font-size ps-font-bold-italic)) (ps-output "%%EndPrologue\n")) (defun ps-header-dirpart () (let ((fname (buffer-file-name))) (if fname (if (string-equal (buffer-name) (file-name-nondirectory fname)) (file-name-directory fname) fname) ""))) (defun ps-get-buffer-name () ;; Indulge me this little easter egg: (if (string= (buffer-name) "ps-print.el") "Hey, Cool! It's ps-print.el!!!" (buffer-name))) (defun ps-begin-job () (setq ps-page-count 0)) (defun ps-end-file () (ps-output "%%Trailer\n") (ps-output "%%Pages: " (format "%d\n" ps-showpage-count))) (defun ps-next-page () (ps-end-page) (ps-flush-output) (ps-begin-page)) (defun ps-begin-page (&optional dummypage) (ps-get-page-dimensions) (setq ps-width-remaining ps-print-width) (setq ps-height-remaining ps-print-height) ;; If headers are turned on, deduct the height of the header from ;; the print height remaining. Clumsy clumsy clumsy. (if ps-print-header (setq ps-height-remaining (- ps-height-remaining ps-header-title-line-height (* ps-header-line-height (- ps-header-lines 1)) (* 2 ps-header-pad)))) (setq ps-page-count (+ ps-page-count 1)) (ps-output "\n%%Page: " (format "%d %d\n" ps-page-count (+ 1 ps-showpage-count))) (ps-output "BeginDSCPage\n") (ps-output (format "/PageNumber %d def\n" ps-page-count)) (ps-output "/PageCount 0 def\n") (if ps-print-header (progn (ps-generate-header "HeaderLinesLeft" ps-left-header) (ps-generate-header "HeaderLinesRight" ps-right-header) (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))) (ps-output "BeginPage\n") (ps-set-font ps-current-font) (ps-set-bg ps-current-bg) (ps-set-color ps-current-color) (ps-set-underline ps-current-underline-p)) (defun ps-end-page () (setq ps-showpage-count (+ 1 ps-showpage-count)) (ps-output "EndPage\n") (ps-output "EndDSCPage\n")) (defun ps-dummy-page () (setq ps-showpage-count (+ 1 ps-showpage-count)) (ps-output "%%Page: " (format "- %d\n" ps-showpage-count) "BeginDSCPage /PrintHeader false def BeginPage EndPage EndDSCPage\n")) (defun ps-next-line () (if (< ps-height-remaining ps-line-height) (ps-next-page) (setq ps-width-remaining ps-print-width) (setq ps-height-remaining (- ps-height-remaining ps-line-height)) (ps-hard-lf))) (defun ps-continue-line () (if (< ps-height-remaining ps-line-height) (ps-next-page) (setq ps-width-remaining ps-print-width) (setq ps-height-remaining (- ps-height-remaining ps-line-height)) (ps-soft-lf))) (defun ps-hard-lf () (ps-output "HL\n")) (defun ps-soft-lf () (ps-output "SL\n")) (defun ps-find-wrappoint (from to char-width) (let ((avail (truncate (/ ps-width-remaining char-width))) (todo (- to from))) (if (< todo avail) (cons to (* todo char-width)) (cons (+ from avail) ps-width-remaining)))) (defun ps-basic-plot-string (from to &optional bg-color) (let* ((wrappoint (ps-find-wrappoint from to ps-avg-char-width)) (to (car wrappoint)) (string (buffer-substring from to))) (ps-output-string string) (ps-output " S\n") ; wrappoint)) (defun ps-basic-plot-whitespace (from to &optional bg-color) (let* ((wrappoint (ps-find-wrappoint from to ps-space-width)) (to (car wrappoint))) (ps-output (format "%d W\n" (- to from))) wrappoint)) (defun ps-plot (plotfunc from to &optional bg-color) (while (< from to) (let* ((wrappoint (funcall plotfunc from to bg-color)) (plotted-to (car wrappoint)) (plotted-width (cdr wrappoint))) (setq from plotted-to) (setq ps-width-remaining (- ps-width-remaining plotted-width)) (if (< from to) (ps-continue-line)))) (if ps-razzle-dazzle (let* ((q-todo (- (point-max) (point-min))) (q-done (- (point) (point-min))) (chunkfrac (/ q-todo 8)) (chunksize (if (> chunkfrac 1000) 1000 chunkfrac))) (if (> (- q-done ps-razchunk) chunksize) (let (foo) (setq ps-razchunk q-done) (setq foo (if (< q-todo 100) (/ (* 100 q-done) q-todo) (/ q-done (/ q-todo 100)))) (message "Formatting...%d%%" foo)))))) (defun ps-set-font (font) (setq ps-current-font font) (ps-output (format "/f%d F\n" ps-current-font))) (defvar ps-print-color-scale nil) (defun ps-set-bg (color) (if (setq ps-current-bg color) (ps-output (format ps-color-format (nth 0 color) (nth 1 color) (nth 2 color)) " true BG\n") (ps-output "false BG\n"))) (defun ps-set-color (color) (if (setq ps-current-color color) nil (setq ps-current-color ps-default-fg)) (ps-output (format ps-color-format (nth 0 ps-current-color) (nth 1 ps-current-color) (nth 2 ps-current-color)) " FG\n")) (defun ps-set-underline (underline-p) (ps-output (if underline-p "true" "false") " UL\n") (setq ps-current-underline-p underline-p)) (defun ps-plot-region (from to font fg-color &optional bg-color underline-p) (if (not (equal font ps-current-font)) (ps-set-font font)) ;; Specify a foreground color only if one's specified and it's ;; different than the current. (if (not (equal fg-color ps-current-color)) (ps-set-color fg-color)) (if (not (equal bg-color ps-current-bg)) (ps-set-bg bg-color)) ;; Toggle underlining if different. (if (not (equal underline-p ps-current-underline-p)) (ps-set-underline underline-p)) ;; Starting at the beginning of the specified region... (save-excursion (goto-char from) ;; ...break the region up into chunks separated by tabs, linefeeds, ;; and pagefeeds, and plot each chunk. (while (< from to) (if (re-search-forward "[\t\n\f]" to t) (let ((match (char-after (match-beginning 0)))) (cond ((= match ?\t) (let ((linestart (save-excursion (beginning-of-line) (point)))) (ps-plot 'ps-basic-plot-string from (- (point) 1) bg-color) (forward-char -1) (setq from (+ linestart (current-column))) (if (re-search-forward "[ \t]+" to t) (ps-plot 'ps-basic-plot-whitespace from (+ linestart (current-column)) bg-color)))) ((= match ?\n) (ps-plot 'ps-basic-plot-string from (- (point) 1) bg-color) (ps-next-line) ) ((= match ?\f) (ps-plot 'ps-basic-plot-string from (- (point) 1) bg-color) (ps-next-page))) (setq from (point))) (ps-plot 'ps-basic-plot-string from to bg-color) (setq from to))))) (defun ps-color-value (x-color-value) ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval. (/ x-color-value ps-print-color-scale)) (defun ps-color-values (x-color) (cond ((fboundp 'x-color-values) (x-color-values x-color)) ((fboundp 'pixel-components) (pixel-components x-color)) (t (error "No available function to determine X color values.")))) (defun ps-face-attributes (face) (let ((differs (face-differs-from-default-p face))) (list (memq face ps-ref-bold-faces) (memq face ps-ref-italic-faces) (memq face ps-ref-underlined-faces) (and differs (face-foreground face)) (and differs (face-background face))))) (defun ps-face-attribute-list (face-or-list) (if (listp face-or-list) (let (bold-p italic-p underline-p foreground background face-attr face) (while face-or-list (setq face (car face-or-list)) (setq face-attr (ps-face-attributes face)) (setq bold-p (or bold-p (nth 0 face-attr))) (setq italic-p (or italic-p (nth 1 face-attr))) (setq underline-p (or underline-p (nth 2 face-attr))) (if foreground nil (setq foreground (nth 3 face-attr))) (if background nil (setq background (nth 4 face-attr))) (setq face-or-list (cdr face-or-list))) (list bold-p italic-p underline-p foreground background)) (ps-face-attributes face-or-list))) (defun ps-plot-with-face (from to face) (if face (let* ((face-attr (ps-face-attribute-list face)) (bold-p (nth 0 face-attr)) (italic-p (nth 1 face-attr)) (underline-p (nth 2 face-attr)) (foreground (nth 3 face-attr)) (background (nth 4 face-attr)) (fg-color (if (and ps-print-color-p foreground) (mapcar 'ps-color-value (ps-color-values foreground)) ps-default-color)) (bg-color (if (and ps-print-color-p background) (mapcar 'ps-color-value (ps-color-values background))))) (ps-plot-region from to (cond ((and bold-p italic-p) 3) (italic-p 2) (bold-p 1) (t 0)) ; (or fg-color '(0.0 0.0 0.0)) fg-color bg-color underline-p)) (goto-char to))) (defun ps-emacs-face-kind-p (face kind kind-regex kind-list) (let ((frame-font (face-font face)) (face-defaults (face-font face t))) (or ;; Check FACE defaults: (and (listp face-defaults) (memq kind face-defaults)) ;; Check the user's preferences (memq face kind-list)))) (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list) (let* ((frame-font (or (face-font face) (face-font 'default))) (kind-cons (assq kind (x-font-properties frame-font))) (kind-spec (cdr-safe kind-cons)) (case-fold-search t)) (or (and kind-spec (string-match kind-regex kind-spec)) ;; Kludge-compatible: (memq face kind-list)))) (defun ps-face-bold-p (face) (if (eq ps-print-emacs-type 'emacs) (ps-emacs-face-kind-p face 'bold "-\\(bold\\|demibold\\)-" ps-bold-faces) (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold" ps-bold-faces))) (defun ps-face-italic-p (face) (if (eq ps-print-emacs-type 'emacs) (ps-emacs-face-kind-p face 'italic "-[io]-" ps-italic-faces) (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o" ps-italic-faces) (ps-xemacs-face-kind-p face 'SLANT "i\\|o" ps-italic-faces)))) (defun ps-face-underlined-p (face) (or (face-underline-p face) (memq face ps-underlined-faces))) ;; Ensure that face-list is fbound. (or (fboundp 'face-list) (defalias 'face-list 'list-faces)) (defun ps-build-reference-face-lists () (if ps-auto-font-detect (let ((faces (face-list)) the-face) (setq ps-ref-bold-faces nil ps-ref-italic-faces nil ps-ref-underlined-faces nil) (while faces (setq the-face (car faces)) (if (ps-face-italic-p the-face) (setq ps-ref-italic-faces (cons the-face ps-ref-italic-faces))) (if (ps-face-bold-p the-face) (setq ps-ref-bold-faces (cons the-face ps-ref-bold-faces))) (if (ps-face-underlined-p the-face) (setq ps-ref-underlined-faces (cons the-face ps-ref-underlined-faces))) (setq faces (cdr faces)))) (setq ps-ref-bold-faces ps-bold-faces) (setq ps-ref-italic-faces ps-italic-faces) (setq ps-ref-underlined-faces ps-underlined-faces)) (setq ps-build-face-reference nil)) (defun ps-mapper (extent list) (nconc list (list (list (extent-start-position extent) 'push extent) (list (extent-end-position extent) 'pull extent))) nil) (defun ps-sorter (a b) (< (car a) (car b))) (defun ps-extent-sorter (a b) (< (extent-priority a) (extent-priority b))) (defun ps-print-ensure-fontified (start end) (if (and (boundp 'lazy-lock-mode) lazy-lock-mode) (if (fboundp 'lazy-lock-fontify-region) (lazy-lock-fontify-region start end) (lazy-lock-fontify-buffer)))) (defun ps-generate-postscript-with-faces (from to) ;; Build the reference lists of faces if necessary. (if (or ps-always-build-face-reference ps-build-face-reference) (progn (message "Collecting face information...") (ps-build-reference-face-lists))) ;; Set the color scale. We do it here instead of in the defvar so ;; that ps-print can be dumped into emacs. This expression can't be ;; evaluated at dump-time because X isn't initialized. (setq ps-print-color-scale (if ps-print-color-p (float (car (ps-color-values "white"))) 1.0)) ;; Generate some PostScript. (save-restriction (narrow-to-region from to) (let ((face 'default) (position to)) (ps-print-ensure-fontified from to) (cond ((or (eq ps-print-emacs-type 'lucid) (eq ps-print-emacs-type 'xemacs)) ;; Build the list of extents... (let ((a (cons 'dummy nil)) record type extent extent-list) (map-extents 'ps-mapper nil from to a) (setq a (cdr a)) (setq a (sort a 'ps-sorter)) (setq extent-list nil) ;; Loop through the extents... (while a (setq record (car a)) (setq position (car record)) (setq record (cdr record)) (setq type (car record)) (setq record (cdr record)) (setq extent (car record)) ;; Plot up to this record. ;; XEmacs 19.12: for some reason, we're getting into a ;; situation in which some of the records have ;; positions less than 'from'. Since we've narrowed ;; the buffer, this'll generate errors. This is a ;; hack, but don't call ps-plot-with-face unless from > ;; point-min. (if (and (>= from (point-min)) (<= position (point-max))) (ps-plot-with-face from position face)) (cond ((eq type 'push) (if (extent-face extent) (setq extent-list (sort (cons extent extent-list) 'ps-extent-sorter)))) ((eq type 'pull) (setq extent-list (sort (delq extent extent-list) 'ps-extent-sorter)))) (setq face (if extent-list (extent-face (car extent-list)) 'default)) (setq from position) (setq a (cdr a))))) ((eq ps-print-emacs-type 'emacs) (let ((property-change from) (overlay-change from)) (while (< from to) (if (< property-change to) ; Don't search for property change ; unless previous search succeeded. (setq property-change (next-property-change from nil to))) (if (< overlay-change to) ; Don't search for overlay change ; unless previous search succeeded. (setq overlay-change (min (next-overlay-change from) to))) (setq position (min property-change overlay-change)) (setq face (cond ((get-text-property from 'invisible) nil) ((get-text-property from 'face)) (t 'default))) (let ((overlays (overlays-at from)) (face-priority -1)) ; text-property (while overlays (let* ((overlay (car overlays)) (overlay-face (overlay-get overlay 'face)) (overlay-invisible (overlay-get overlay 'invisible)) (overlay-priority (or (overlay-get overlay 'priority) 0))) (if (and (or overlay-invisible overlay-face) (> overlay-priority face-priority)) (setq face (cond (overlay-invisible nil) ((and face overlay-face))) face-priority overlay-priority))) (setq overlays (cdr overlays)))) ;; Plot up to this record. (ps-plot-with-face from position face) (setq from position))))) (ps-plot-with-face from to face)))) (defun ps-generate-postscript (from to) (ps-plot-region from to 0 nil)) (defun ps-generate (buffer from to genfunc) (let ((from (min to from)) (to (max to from))) (save-restriction (narrow-to-region from to) (if ps-razzle-dazzle (message "Formatting...%d%%" (setq ps-razchunk 0))) (set-buffer buffer) (setq ps-source-buffer buffer) (setq ps-spool-buffer (get-buffer-create ps-spool-buffer-name)) (ps-init-output-queue) (let (safe-marker completed-safely needs-begin-file) (unwind-protect (progn (set-buffer ps-spool-buffer) ;; Get a marker and make it point to the current end of the ;; buffer, If an error occurs, we'll delete everything from ;; the end of this marker onwards. (setq safe-marker (make-marker)) (set-marker safe-marker (point-max)) (goto-char (point-min)) (if (looking-at (regexp-quote "%!PS-Adobe-1.0")) nil (setq needs-begin-file t)) (save-excursion (set-buffer ps-source-buffer) (if needs-begin-file (ps-begin-file)) (ps-begin-job) (ps-begin-page)) (set-buffer ps-source-buffer) (funcall genfunc from to) (ps-end-page) (if (and ps-spool-duplex (= (mod ps-page-count 2) 1)) (ps-dummy-page)) (ps-flush-output) ;; Back to the PS output buffer to set the page count (set-buffer ps-spool-buffer) (goto-char (point-max)) (while (re-search-backward "^/PageCount 0 def$" nil t) (replace-match (format "/PageCount %d def" ps-page-count) t)) ;; Setting this variable tells the unwind form that the ;; the postscript was generated without error. (setq completed-safely t)) ;; Unwind form: If some bad mojo ocurred while generating ;; postscript, delete all the postscript that was generated. ;; This protects the previously spooled files from getting ;; corrupted. (if (and (markerp safe-marker) (not completed-safely)) (progn (set-buffer ps-spool-buffer) (delete-region (marker-position safe-marker) (point-max)))))) (if ps-razzle-dazzle (message "Formatting...done"))))) (defun ps-do-despool (filename) (if (or (not (boundp 'ps-spool-buffer)) (not ps-spool-buffer)) (message "No spooled PostScript to print") (ps-end-file) (ps-flush-output) (if filename (save-excursion (if ps-razzle-dazzle (message "Saving...")) (set-buffer ps-spool-buffer) (setq filename (expand-file-name filename)) (write-region (point-min) (point-max) filename) (if ps-razzle-dazzle (message "Wrote %s" filename))) ;; Else, spool to the printer (if ps-razzle-dazzle (message "Printing...")) (save-excursion (set-buffer ps-spool-buffer) (apply 'call-process-region (point-min) (point-max) ps-lpr-command nil 0 nil ps-lpr-switches)) (if ps-razzle-dazzle (message "Printing...done"))) (kill-buffer ps-spool-buffer))) (defun ps-kill-emacs-check () (let (ps-buffer) (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) (buffer-modified-p ps-buffer)) (if (y-or-n-p "Unprinted PostScript waiting; print now? ") (ps-despool))) (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) (buffer-modified-p ps-buffer)) (if (yes-or-no-p "Unprinted PostScript waiting; exit anyway? ") nil (error "Unprinted PostScript"))))) (if (fboundp 'add-hook) (add-hook 'kill-emacs-hook 'ps-kill-emacs-check) (if kill-emacs-hook (message "Won't override existing kill-emacs-hook") (setq kill-emacs-hook 'ps-kill-emacs-check))) ;;; Sample Setup Code: ;; This stuff is for anybody that's brave enough to look this far, ;; and able to figure out how to use it. It isn't really part of ps- ;; print, but I'll leave it here in hopes it might be useful: ;; WARNING!!! The following code is *sample* code only. Don't use it ;; unless you understand what it does! (defmacro ps-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs) [f22] ''f22)) (defmacro ps-c-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs) [C-f22] ''(control f22))) (defmacro ps-s-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs) [S-f22] ''(shift f22))) ;; Look in an article or mail message for the Subject: line. To be ;; placed in ps-left-headers. (defun ps-article-subject () (save-excursion (goto-char (point-min)) (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$") (buffer-substring (match-beginning 1) (match-end 1)) "Subject ???"))) ;; Look in an article or mail message for the From: line. Sorta-kinda ;; understands RFC-822 addresses and can pull the real name out where ;; it's provided. To be placed in ps-left-headers. (defun ps-article-author () (save-excursion (goto-char (point-min)) (if (re-search-forward "^From:[ \t]+\\(.*\\)$") (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1)))) (cond ;; Try first to match addresses that look like ;; thompson@wg2.waii.com (Jim Thompson) ((string-match ".*[ \t]+(\\(.*\\))" fromstring) (substring fromstring (match-beginning 1) (match-end 1))) ;; Next try to match addresses that look like ;; Jim Thompson ((string-match "\\(.*\\)[ \t]+<.*>" fromstring) (substring fromstring (match-beginning 1) (match-end 1))) ;; Couldn't find a real name -- show the address instead. (t fromstring))) "From ???"))) ;; A hook to bind to gnus-Article-prepare-hook. This will set the ps- ;; left-headers specially for gnus articles. Unfortunately, gnus- ;; article-mode-hook is called only once, the first time the *Article* ;; buffer enters that mode, so it would only work for the first time ;; we ran gnus. The second time, this hook wouldn't get set up. The ;; only alternative is gnus-article-prepare-hook. (defun ps-gnus-article-prepare-hook () (setq ps-header-lines 3) (setq ps-left-header ;; The left headers will display the article's subject, its ;; author, and the newsgroup it was in. (list 'ps-article-subject 'ps-article-author 'gnus-newsgroup-name))) ;; A hook to bind to vm-mode-hook to locally bind prsc and set the ps- ;; left-headers specially for mail messages. This header setup would ;; also work, I think, for RMAIL. (defun ps-vm-mode-hook () (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary) (setq ps-header-lines 3) (setq ps-left-header ;; The left headers will display the message's subject, its ;; author, and the name of the folder it was in. (list 'ps-article-subject 'ps-article-author 'buffer-name))) ;; Every now and then I forget to switch from the *Summary* buffer to ;; the *Article* before hitting prsc, and a nicely formatted list of ;; article subjects shows up at the printer. This function, bound to ;; prsc for the gnus *Summary* buffer means I don't have to switch ;; buffers first. (defun ps-gnus-print-article-from-summary () (interactive) (if (get-buffer "*Article*") (save-excursion (set-buffer "*Article*") (ps-spool-buffer-with-faces)))) ;; See ps-gnus-print-article-from-summary. This function does the ;; same thing for vm. (defun ps-vm-print-message-from-summary () (interactive) (if vm-mail-buffer (save-excursion (set-buffer vm-mail-buffer) (ps-spool-buffer-with-faces)))) ;; A hook to bind to bind to gnus-summary-setup-buffer to locally bind ;; prsc. (defun ps-gnus-summary-setup () (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary)) ;; Look in an article or mail message for the Subject: line. To be ;; placed in ps-left-headers. (defun ps-info-file () (save-excursion (goto-char (point-min)) (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)") (buffer-substring (match-beginning 1) (match-end 1)) "File ???"))) ;; Look in an article or mail message for the Subject: line. To be ;; placed in ps-left-headers. (defun ps-info-node () (save-excursion (goto-char (point-min)) (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)") (buffer-substring (match-beginning 1) (match-end 1)) "Node ???"))) (defun ps-info-mode-hook () (setq ps-left-header ;; The left headers will display the node name and file name. (list 'ps-info-node 'ps-info-file))) ;; WARNING! The following function is a *sample* only, and is *not* ;; meant to be used as a whole unless you understand what the effects ;; will be! (In fact, this is a copy if my setup for ps-print -- I'd ;; be very surprised if it was useful to *anybody*, without ;; modification.) (defun ps-jts-ps-setup () (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces) (global-set-key (ps-c-prsc) 'ps-despool) (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook) (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup) (add-hook 'vm-mode-hook 'ps-vm-mode-hook) (add-hook 'vm-mode-hooks 'ps-vm-mode-hook) (add-hook 'Info-mode-hook 'ps-info-mode-hook) (setq ps-spool-duplex t) (setq ps-print-color-p nil) (setq ps-lpr-command "lpr") (setq ps-lpr-switches '("-Jjct,duplex_long"))) (provide 'ps-print) ;;; ps-print.el ends here emacs-19.30/lisp/rcompile.el100444 12120 1 14513 6045204632 14230 0ustar rmsdaemon;;; rcompile.el --- run a compilation on a remote machine ;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: Albert ;; Maintainer: FSF ;; Created: 1993 Oct 6 ;; Version: 1.1 ;; Keywords: tools, processes ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; This package is for running a remote compilation and using emacs to parse ;;; the error messages. It works by rsh'ing the compilation to a remote host ;;; and parsing the output. If the file visited at the time remote-compile was ;;; called was loaded remotely (ange-ftp), the host and user name are obtained ;;; by the calling ange-ftp-ftp-name on the current directory. In this case the ;;; next-error command will also ange-ftp the files over. This is achieved ;;; automatically because the compilation-parse-errors function uses ;;; default-directory to build it's file names. If however the file visited was ;;; loaded locally, remote-compile prompts for a host and user and assumes the ;;; files mounted locally (otherwise, how was the visited file loaded). ;;; See the user defined variables section for more info. ;;; I was contemplating redefining "compile" to "remote-compile" automatically ;;; if the file visited was ange-ftp'ed but decided against it for now. If you ;;; feel this is a good idea, let me know and I'll consider it again. ;;; Installation: ;;; To use rcompile, you also need to give yourself permission to connect to ;;; the remote host. You do this by putting lines like: ;;; monopoly alon ;;; vme33 ;;; ;;; in a file named .rhosts in the home directory (of the remote machine). ;;; Be careful what you put in this file. A line like: ;;; ;;; + ;;; ;;; Will allow anyone access to your account without a password. I suggest you ;;; read the rhosts(5) manual page before you edit this file (if you are not ;;; familiar with it already) ;;; Code: (provide 'rcompile) (require 'compile) ;;; The following should not be needed. ;;; (eval-when-compile (require 'ange-ftp)) ;;;; user defined variables (defvar remote-compile-host nil "*Host for remote compilations.") (defvar remote-compile-user nil "User for remote compilations. nil means use the value returned by \\[user-login-name].") (defvar remote-compile-run-before nil "*Command to run before compilation. This can be used for setting up enviroment variables, since rsh does not invoke the shell as a login shell and files like .login \(tcsh\) and .bash_profile \(bash\) are not run. nil means run no commands.") (defvar remote-compile-prompt-for-host nil "*Non-nil means prompt for host if not available from filename.") (defvar remote-compile-prompt-for-user nil "*Non-nil means prompt for user if not available from filename.") ;;;; internal variables ;; History of remote compile hosts and users (defvar remote-compile-host-history nil) (defvar remote-compile-user-history nil) ;;;; entry point ;;;###autoload (defun remote-compile (host user command) "Compile the the current buffer's directory on HOST. Log in as USER. See \\[compile]." (interactive (let ((parsed (or (and (featurep 'ange-ftp) (ange-ftp-ftp-name default-directory)))) host user command prompt) (if parsed (setq host (nth 0 parsed) user (nth 1 parsed)) (setq prompt (if (stringp remote-compile-host) (format "Compile on host (default %s): " remote-compile-host) "Compile on host: ") host (if (or remote-compile-prompt-for-host (null remote-compile-host)) (read-from-minibuffer prompt "" nil nil 'remote-compile-host-history) remote-compile-host) user (if remote-compile-prompt-for-user (read-from-minibuffer (format "Compile by user (default %s)" (or remote-compile-user (user-login-name))) "" nil nil 'remote-compile-user-history) remote-compile-user))) (setq command (read-from-minibuffer "Compile command: " compile-command nil nil '(compile-history . 1))) (list (if (string= host "") remote-compile-host host) (if (string= user "") remote-compile-user user) command))) (setq compile-command command) (cond (user (setq remote-compile-user user)) ((null remote-compile-user) (setq remote-compile-user (user-login-name)))) (let* ((parsed (and (featurep 'ange-ftp) (ange-ftp-ftp-name default-directory))) (compile-command (format "%s %s -l %s \"(%scd %s; %s)\"" remote-shell-program host remote-compile-user (if remote-compile-run-before (concat remote-compile-run-before "; ") "") (if parsed (nth 2 parsed) default-directory) compile-command))) (setq remote-compile-host host) (save-some-buffers nil nil) (compile-internal compile-command "No more errors") ;; Set comint-file-name-prefix in the compilation buffer so ;; compilation-parse-errors will find referenced files by ange-ftp. (save-excursion (set-buffer compilation-last-buffer) (setq comint-file-name-prefix (concat "/" host ":"))))) ;;; rcompile.el ends here emacs-19.30/lisp/rect.el100444 12120 1 21230 5660251521 13346 0ustar rmsdaemon;;; rect.el --- rectangle functions for GNU Emacs. ;; Copyright (C) 1985, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal ;; 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 package provides the operations on rectangles that are ocumented ;; in the Emacs manual. ;;; Code: (defun operate-on-rectangle (function start end coerce-tabs) "Call FUNCTION for each line of rectangle with corners at START, END. If COERCE-TABS is non-nil, convert multi-column characters that span the starting or ending columns on any line to multiple spaces before calling FUNCTION. FUNCTION is called with three arguments: position of start of segment of this line within the rectangle, number of columns that belong to rectangle but are before that position, number of columns that belong to rectangle but are after point. Point is at the end of the segment of this line within the rectangle." (let (startcol startlinepos endcol endlinepos) (save-excursion (goto-char start) (setq startcol (current-column)) (beginning-of-line) (setq startlinepos (point))) (save-excursion (goto-char end) (setq endcol (current-column)) (forward-line 1) (setq endlinepos (point-marker))) (if (< endcol startcol) (setq startcol (prog1 endcol (setq endcol startcol)))) (save-excursion (goto-char startlinepos) (while (< (point) endlinepos) (let (startpos begextra endextra) (move-to-column startcol coerce-tabs) (setq begextra (- (current-column) startcol)) (setq startpos (point)) (move-to-column endcol coerce-tabs) (setq endextra (- endcol (current-column))) (if (< begextra 0) (setq endextra (+ endextra begextra) begextra 0)) (funcall function startpos begextra endextra)) (forward-line 1))) (- endcol startcol))) (defun delete-rectangle-line (startdelpos ignore ignore) (delete-region startdelpos (point))) (defun delete-extract-rectangle-line (startdelpos begextra endextra) (save-excursion (extract-rectangle-line startdelpos begextra endextra)) (delete-region startdelpos (point))) (defun extract-rectangle-line (startdelpos begextra endextra) (let ((line (buffer-substring startdelpos (point))) (end (point))) (goto-char startdelpos) (while (search-forward "\t" end t) (let ((width (- (current-column) (save-excursion (forward-char -1) (current-column))))) (setq line (concat (substring line 0 (- (point) end 1)) (spaces-string width) (substring line (+ (length line) (- (point) end))))))) (if (or (> begextra 0) (> endextra 0)) (setq line (concat (spaces-string begextra) line (spaces-string endextra)))) (setq lines (cons line lines)))) (defconst spaces-strings '["" " " " " " " " " " " " " " " " "]) (defun spaces-string (n) (if (<= n 8) (aref spaces-strings n) (let ((val "")) (while (> n 8) (setq val (concat " " val) n (- n 8))) (concat val (aref spaces-strings n))))) ;;;###autoload (defun delete-rectangle (start end) "Delete (don't save) text in rectangle with point and mark as corners. The same range of columns is deleted in each line starting with the line where the region begins and ending with the line where the region ends." (interactive "r") (operate-on-rectangle 'delete-rectangle-line start end t)) ;;;###autoload (defun delete-extract-rectangle (start end) "Delete contents of rectangle and return it as a list of strings. Arguments START and END are the corners of the rectangle. The value is list of strings, one for each line of the rectangle." (let (lines) (operate-on-rectangle 'delete-extract-rectangle-line start end t) (nreverse lines))) ;;;###autoload (defun extract-rectangle (start end) "Return contents of rectangle with corners at START and END. Value is list of strings, one for each line of the rectangle." (let (lines) (operate-on-rectangle 'extract-rectangle-line start end nil) (nreverse lines))) (defvar killed-rectangle nil "Rectangle for yank-rectangle to insert.") ;;;###autoload (defun kill-rectangle (start end) "Delete rectangle with corners at point and mark; save as last killed one. Calling from program, supply two args START and END, buffer positions. But in programs you might prefer to use `delete-extract-rectangle'." (interactive "r") (if buffer-read-only (progn (setq killed-rectangle (extract-rectangle start end)) (barf-if-buffer-read-only))) (setq killed-rectangle (delete-extract-rectangle start end))) ;;;###autoload (defun yank-rectangle () "Yank the last killed rectangle with upper left corner at point." (interactive) (insert-rectangle killed-rectangle)) ;;;###autoload (defun insert-rectangle (rectangle) "Insert text of RECTANGLE with upper left corner at point. RECTANGLE's first line is inserted at point, its second line is inserted at a point vertically under point, etc. RECTANGLE should be a list of strings. After this command, the mark is at the upper left corner and point is at the lower right corner." (let ((lines rectangle) (insertcolumn (current-column)) (first t)) (push-mark) (while lines (or first (progn (forward-line 1) (or (bolp) (insert ?\n)) (move-to-column insertcolumn t))) (setq first nil) (insert (car lines)) (setq lines (cdr lines))))) ;;;###autoload (defun open-rectangle (start end) "Blank out rectangle with corners at point and mark, shifting text right. The text previously in the region is not overwritten by the blanks, but instead winds up to the right of the rectangle." (interactive "r") (operate-on-rectangle 'open-rectangle-line start end nil) (goto-char start)) (defun open-rectangle-line (startpos begextra endextra) ;; Column where rectangle ends. (let ((endcol (+ (current-column) endextra)) whitewidth) (goto-char startpos) ;; Column where rectangle begins. (let ((begcol (- (current-column) begextra))) (skip-chars-forward " \t") ;; Width of whitespace to be deleted and recreated. (setq whitewidth (- (current-column) begcol))) ;; Delete the whitespace following the start column. (delete-region startpos (point)) ;; Open the desired width, plus same amount of whitespace we just deleted. (indent-to (+ endcol whitewidth)))) ;;;###autoload (defun string-rectangle (start end string) "Insert STRING on each line of the region-rectangle, shifting text right. The left edge of the rectangle specifies the column for insertion. This command does not delete or overwrite any existing text. Called from a program, takes three args; START, END and STRING." (interactive "r\nsString rectangle: ") (operate-on-rectangle 'string-rectangle-line start end t)) (defun string-rectangle-line (startpos begextra endextra) (let (whitespace) (goto-char startpos) ;; Compute horizontal width of following whitespace. (let ((ocol (current-column))) (skip-chars-forward " \t") (setq whitespace (- (current-column) ocol))) ;; Delete the following whitespace. (delete-region startpos (point)) ;; Insert the desired string. (insert string) ;; Insert the same width of whitespace that we had before. (indent-to (+ (current-column) whitespace)))) ;;;###autoload (defun clear-rectangle (start end) "Blank out rectangle with corners at point and mark. The text previously in the region is overwritten by the blanks. When called from a program, requires two args which specify the corners." (interactive "r") (operate-on-rectangle 'clear-rectangle-line start end t)) (defun clear-rectangle-line (startpos begextra endextra) ;; Find end of whitespace after the rectangle. (skip-chars-forward " \t") (let ((column (+ (current-column) endextra))) ;; Delete the text in the rectangle, and following whitespace. (delete-region (point) (progn (goto-char startpos) (skip-chars-backward " \t") (point))) ;; Reindent out to same column that we were at. (indent-to column))) (provide 'rect) ;;; rect.el ends here emacs-19.30/lisp/refbib.el100444 75424 12 56423 5660054441 13744 0ustar kwzhstaff;;; refbib.el --- convert refer-style references to ones usable by Latex bib ;; Copyright (C) 1989 Free Software Foundation, Inc. ;; Author: Henry Kautz ;; Keywords: bib, tex ;; 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: ;; Use: from a buffer containing the refer-style bibliography, ;; M-x r2b-convert-buffer ;; Program will prompt for an output buffer name, and will log ;; warnings during the conversion process in the buffer *Log*. ;;; Change Log: ; HISTORY ; 9/88, created H.Kautz ; modified 1/19/89, allow books with editor but no author; ; added %O ordering field; ; appended illegal multiple fields, instead of ; discarding; ; added rule, a tech report whose %R number ; contains "ISBN" is really a book ; added rule, anything with an editor is a book ; or a proceedings ; added 'manual type, for items with institution ; but no author or editor ; fixed bug so trailing blanks are trimmed ; added 'proceedings type ; used "organization" field for proceedings ; modified 2/16/89, updated help messages ; modified 2/23/89, include capitalize stop words in r2b stop words, ; fixed problems with contractions (e.g. it's), ; caught multiple stop words in a row ; modified 3/1/89, fixed capitialize-title for first words all caps ; modified 3/15/89, allow use of " to delimit fields ; modified 4/18/89, properly "quote" special characters on output ;;; Code: ;********************************************************** ; User Parameters (defvar r2b-trace-on nil "*trace conversion") (defvar r2b-journal-abbrevs '( ) " Abbreviation list for journal names. If the car of an element matches a journal name exactly, it is replaced by the cadr when output. Braces must be included if replacement is a {string}, but not if replacement is a bibtex abbreviation. The cadr may be eliminated if is exactly the same as the car. Because titles are capitalized before matching, the abbreviation for the journal name should be listed as beginning with a capital letter, even if it really doesn't. For example, a value of '((\"Aij\" \"{Artificial Intelligence}\") \(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string \"Artificial Intelligence\", but would replace Ijcai81 with the BibTeX macro \"ijcai7\".") (defvar r2b-booktitle-abbrevs '( ) " Abbreviation list for book and proceedings names. If the car of an element matches a title or booktitle exactly, it is replaced by the cadr when output. Braces must be included if replacement is a {string}, but not if replacement is a bibtex abbreviation. The cadr may be eliminated if is exactly the same as the car. Because titles are capitalized before matching, the abbreviated title should be listed as beginning with a capital letter, even if it doesn't. For example, a value of '((\"Aij\" \"{Artificial Intelligence}\") \(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string \"Artificial Intelligence\", but would replace Ijcai81 with the BibTeX macro \"ijcai7\".") (defvar r2b-proceedings-list '() " Assoc list of books or journals which are really conference proceedings, but whose name and whose abbrev expansion (as defined in `r2b-journal-abbrevs' and `r2b-booktitle-abbrevs') does not contain the words \"conference\" or \"proceedings\". (Those cases are handled automatically.) The entry must match the given data exactly. Because titles are capitalized before matching, the items in this list should begin with a capital letter. For example, suppose the title \"Ijcai81\" is used for the proceedings of a conference, and it's expansion is the BibTeX macro \"ijcai7\". Then `r2b-proceedings-list' should be '((\"Ijcai81\") ...). If instead its expansion were \"Proceedings of the Seventh International Conference on Artificial Intelligence\", then you would NOT need to include Ijcai81 in `r2b-proceedings-list' (although it wouldn't cause an error).") (defvar r2b-additional-stop-words "Some\\|What" "Words other than the `capitialize-title-stop-words' which are not to be used to build the citation key") (defvar r2b-delimit-with-quote t "*If true, then use \" to delimit fields, otherwise use braces") ;********************************************************** ; Utility Functions (defvar capitalize-title-stop-words (concat "the\\|and\\|of\\|is\\|a\\|an\\|of\\|for\\|in\\|to\\|in\\|on\\|at\\|" "by\\|with\\|that\\|its") "Words not to be capitialized in a title (unless they are the first word in the title)") (defvar capitalize-title-stop-regexp (concat "\\(" capitalize-title-stop-words "\\)\\(\\b\\|'\\)")) (defun capitalize-title-region (begin end) "Like `capitalize-region', but don't capitalize stop words, except the first." (interactive "r") (let ((case-fold-search nil) (orig-syntax-table (syntax-table))) (unwind-protect (save-restriction (set-syntax-table text-mode-syntax-table) (narrow-to-region begin end) (goto-char (point-min)) (if (looking-at "[A-Z][a-z]*[A-Z]") (forward-word 1) (capitalize-word 1)) (while (re-search-forward "\\<" nil t) (if (looking-at "[A-Z][a-z]*[A-Z]") (forward-word 1) (if (let ((case-fold-search t)) (looking-at capitalize-title-stop-regexp)) (downcase-word 1) (capitalize-word 1))) )) (set-syntax-table orig-syntax-table)))) (defun capitalize-title (s) "Like capitalize, but don't capitalize stop words, except the first." (save-excursion (set-buffer (get-buffer-create "$$$Scratch$$$")) (erase-buffer) (insert s) (capitalize-title-region (point-min) (point-max)) (buffer-string))) ;********************************************************* (defun r2b-reset () "Unbind defvars, for debugging." (interactive) (makunbound 'r2b-journal-abbrevs) (makunbound 'r2b-booktitle-abbrevs) (makunbound 'r2b-proceedings-list) (makunbound 'capitalize-title-stop-words) (makunbound 'capitalize-title-stop-regexp) (makunbound 'r2b-additional-stop-words) (makunbound 'r2b-stop-regexp)) (defvar r2b-stop-regexp (concat "\\`\\(\\(" r2b-additional-stop-words "\\|" capitalize-title-stop-words "\\)\\('\\w*\\)?\\W+\\)*\\([A-Z0-9]+\\)")) (defun r2b-trace (&rest args) (if r2b-trace-on (progn (apply (function message) args) (sit-for 0)))) (defun r2b-match (exp) "Returns string matched in current buffer." (buffer-substring (match-beginning exp) (match-end exp))) (defvar r2b-out-buf-name "*Out*" "*output from refer-to-bibtex" ) (defvar r2b-log-name "*Log*" "*logs errors from refer-to-bibtex" ) (defvar r2b-in-buf nil) (defvar r2b-out-buf nil) (defvar r2b-log nil) (defvar r2b-error-found nil) (setq r2b-variables '( r2b-error-found r2bv-author r2bv-primary-author r2bv-date r2bv-year r2bv-decade r2bv-month r2bv-title r2bv-title-first-word r2bv-editor r2bv-annote r2bv-tr r2bv-address r2bv-institution r2bv-keywords r2bv-booktitle r2bv-journal r2bv-volume r2bv-number r2bv-pages r2bv-booktitle r2bv-kn r2bv-publisher r2bv-organization r2bv-school r2bv-type r2bv-where r2bv-note r2bv-ordering )) (defun r2b-clear-variables () "Set all global vars used by r2b to nil." (let ((vars r2b-variables)) (while vars (set (car vars) nil) (setq vars (cdr vars))))) (defun r2b-warning (&rest args) (setq r2b-error-found t) (princ (apply (function format) args) r2b-log) (princ "\n" r2b-log) (princ "\n" r2b-out-buf) (princ "% " r2b-out-buf) (princ (apply (function format) args) r2b-out-buf)) (defun r2b-get-field (var field &optional unique required capitalize) "Set VAR to string value of FIELD, if any. If none, VAR is set to nil. If multiple fields appear, then separate values with the '\\nand\\t\\t', unless UNIQUE is non-nil, in which case log a warning and just concatenate the values. Trim off leading blanks and tabs on first line, and trailing blanks and tabs of every line. Log a warning and set VAR to the empty string if REQUIRED is true. Capitalize as a title if CAPITALIZE is true. Returns value of VAR." (let (item val (not-past-end t)) (r2b-trace "snarfing %s" field) (goto-char (point-min)) (while (and not-past-end (re-search-forward (concat "^" field "\\b[ \t]*\\(.*[^ \t\n]\\)[ \t]*") nil t)) (setq item (r2b-match 1)) (while (and (setq not-past-end (zerop (forward-line 1))) (not (looking-at "[ \t]*$\\|%"))) (looking-at "\\(.*[^ \t\n]\\)[ \t]*$") (setq item (concat item "\n" (r2b-match 1))) ) (if (null val) (setq val item) (if unique (progn (r2b-warning "*Illegal multiple field %s %s" field item) (setq val (concat val "\n" item)) ) (setq val (concat val "\n\t\tand " item)) ) ) ) (if (and val capitalize) (setq val (capitalize-title val))) (set var val) (if (and (null val) required) (r2b-require var)) )) (defun r2b-set-match (var n regexp string ) "Set VAR to the Nth subpattern in REGEXP matched by STRING, or nil if none." (set var (if (and (stringp string) (string-match regexp string)) (substring string (match-beginning n) (match-end n)) nil) ) ) (defvar r2b-month-abbrevs '(("jan") ("feb") ("mar") ("apr") ("may") ("jun") ("jul") ("aug") ("sep") ("oct") ("nov") ("dec"))) (defun r2b-convert-month () "Try to convert `r2bv-month' to a standard 3 letter name." (if r2bv-month (let ((months r2b-month-abbrevs)) (if (string-match "[^0-9]" r2bv-month) (progn (while (and months (not (string-match (car (car months)) r2bv-month))) (setq months (cdr months))) (if months (setq r2bv-month (car (car months))))) (progn (setq months (car (read-from-string r2bv-month))) (if (and (numberp months) (> months 0) (< months 13)) (setq r2bv-month (car (nth months r2b-month-abbrevs))) (progn (r2b-warning "* Ridiculous month") (setq r2bv-month nil)) )) )) ) ) (defun r2b-snarf-input () "Parse buffer into global variables." (let ((case-fold-search t)) (r2b-trace "snarfing...") (sit-for 0) (set-buffer r2b-in-buf) (goto-char (point-min)) (princ " " r2b-log) (princ (buffer-substring (point) (progn (end-of-line) (point))) r2b-log) (terpri r2b-log) (r2b-get-field 'r2bv-author "%A") (r2b-get-field 'r2bv-editor "%E") (cond (r2bv-author (r2b-set-match 'r2bv-primary-author 1 "\\b\\(\\w+\\)[ \t]*\\($\\|,\\)" r2bv-author) ) (r2bv-editor (r2b-set-match 'r2bv-primary-author 1 "\\b\\(\\w+\\)[ \t]*\\($\\|,\\)" r2bv-editor) ) (t (setq r2bv-primary-author "") ) ) (r2b-get-field 'r2bv-date "%D" t t) (r2b-set-match 'r2bv-year 0 "[12][0-9][0-9][0-9]" r2bv-date) (and (null r2bv-year) (r2b-set-match 'r2bv-year 1 "[^0-9]\\([0-9][0-9]\\)$" r2bv-date) (setq r2bv-year (concat "19" r2bv-year))) (r2b-set-match 'r2bv-decade 1 "..\\(..\\)" r2bv-year) (r2b-set-match 'r2bv-month 0 "[0-9]+/\\|[a-zA-Z]+" r2bv-date) (if (and (stringp r2bv-month) (string-match "\\(.*\\)/$" r2bv-month)) (setq r2bv-month (substring r2bv-month 0 (match-end 1)))) (r2b-convert-month) (r2b-get-field 'r2bv-title "%T" t t t) (r2b-set-match 'r2bv-title-first-word 4 r2b-stop-regexp r2bv-title) (r2b-get-field 'r2bv-annote "%X" t ) (r2b-get-field 'r2bv-tr "%R" t) (r2b-get-field 'r2bv-address "%C" t) (r2b-get-field 'r2bv-institution "%I" t) (r2b-get-field 'r2bv-keywords "%K") (r2b-get-field 'r2bv-booktitle "%B" t nil t) (r2b-get-field 'r2bv-journal "%J" t nil t) (r2b-get-field 'r2bv-volume "%V" t) (r2b-get-field 'r2bv-number "%N" t) (r2b-get-field 'r2bv-pages "%P" t) (r2b-get-field 'r2bv-where "%W" t) (r2b-get-field 'r2bv-ordering "%O" t) ) ) (defun r2b-put-field (field data &optional abbrevs) "Print bibtex FIELD = {DATA} if DATA not null; precede with a comma and newline; if ABBREVS list is given, then try to replace the {DATA} with an abbreviation." (if data (let (match nodelim multi-line index) (cond ((and abbrevs (setq match (assoc data abbrevs))) (if (null (cdr match)) (setq data (car match)) (setq data (car (cdr match)))) (setq nodelim t)) ((and (not (equal data "")) (not (string-match "[^0-9]" data))) (setq nodelim t)) (t (setq index 0) (while (string-match "[\\~^]" data index) (setq data (concat (substring data 0 (match-beginning 0)) "\\verb+" (substring data (match-beginning 0) (match-end 0)) "+" (substring data (match-end 0)))) (setq index (+ (match-end 0) 7))) (setq index 0) (while (string-match "[$&%#_{}]" data index) (setq data (concat (substring data 0 (match-beginning 0)) "\\" (substring data (match-beginning 0)))) (setq index (+ (match-end 0) 1))) (setq index 0) (if r2b-delimit-with-quote (while (string-match "\"" data index) (setq data (concat (substring data 0 (match-beginning 0)) "{\"}" (substring data (match-end 0)))) (setq index (+ (match-end 0) 2)))) )) (princ ", \n ") (princ field) (princ " =\t") (if (not nodelim) (if r2b-delimit-with-quote (princ "\"") (princ "{"))) (string-match ".*" data) (if (> (match-end 0) 59) (princ "\n")) (princ data) (if (not nodelim) (if r2b-delimit-with-quote (princ "\"") (princ "}"))) ) )) (defun r2b-require (vars) "If any of VARS is null, set to empty string and log error." (cond ((null vars)) ((listp vars) (r2b-require (car vars)) (r2b-require (cdr vars))) (t (if (null (symbol-value vars)) (progn (r2b-warning "*Missing value for field %s" vars) (set vars "") ))) ) ) (defmacro r2b-moveq (new old) "Set NEW to OLD and set OLD to nil." (list 'progn (list 'setq new old) (list 'setq old 'nil))) (defun r2b-isa-proceedings (name) "Return t if NAME is the name of proceedings." (and name (or (string-match "proceedings\\|conference" name) (assoc name r2b-proceedings-list) (let ((match (assoc name r2b-booktitle-abbrevs))) (and match (string-match "proceedings\\|conference" (car (cdr match))))) ))) (defun r2b-isa-university (name) "Return t if NAME is a university or similar organization, but not a publisher." (and name (string-match "university" name) (not (string-match "press" name)) )) (defun r2b-barf-output () "Generate bibtex based on global variables." (let ((standard-output r2b-out-buf) (case-fold-search t) match) (r2b-trace "...barfing") (sit-for 0) (set-buffer r2b-out-buf) (setq r2bv-kn (concat r2bv-primary-author r2bv-decade r2bv-title-first-word)) (setq r2bv-entry-kind (cond ((r2b-isa-proceedings r2bv-journal) (r2b-moveq r2bv-booktitle r2bv-journal) (if (r2b-isa-university r2bv-institution) (r2b-moveq r2bv-organization r2bv-institution) (r2b-moveq r2bv-publisher r2bv-institution)) (r2b-moveq r2bv-note r2bv-tr) (r2b-require 'r2bv-author) 'inproceedings) ((r2b-isa-proceedings r2bv-booktitle) (if (r2b-isa-university r2bv-institution) (r2b-moveq r2bv-organization r2bv-institution) (r2b-moveq r2bv-publisher r2bv-institution)) (r2b-moveq r2bv-note r2bv-tr) (r2b-require 'r2bv-author) 'inproceedings) ((and r2bv-tr (string-match "phd" r2bv-tr)) (r2b-moveq r2bv-school r2bv-institution) (r2b-require 'r2bv-school ) (r2b-require 'r2bv-author) 'phdthesis) ((and r2bv-tr (string-match "master" r2bv-tr)) (r2b-moveq r2bv-school r2bv-institution) (r2b-require 'r2bv-school ) (r2b-require 'r2bv-author) 'mastersthesis) ((and r2bv-tr (string-match "draft\\|unpublish" r2bv-tr)) (r2b-moveq r2bv-note r2bv-institution) (r2b-require 'r2bv-author) 'unpublished) (r2bv-journal (r2b-require 'r2bv-author) 'article) (r2bv-booktitle (r2b-moveq r2bv-publisher r2bv-institution) (r2b-moveq r2bv-note r2bv-tr) (r2b-require 'r2bv-publisher) (r2b-require 'r2bv-author) 'incollection) ((and r2bv-author (null r2bv-editor) (string-match "\\`personal communication\\'" r2bv-title)) 'misc) ((r2b-isa-proceedings r2bv-title) (if (r2b-isa-university r2bv-institution) (r2b-moveq r2bv-organization r2bv-institution) (r2b-moveq r2bv-publisher r2bv-institution)) (r2b-moveq r2bv-note r2bv-tr) 'proceedings) ((or r2bv-editor (and r2bv-author (or (null r2bv-tr) (string-match "\\bisbn\\b" r2bv-tr)))) (r2b-moveq r2bv-publisher r2bv-institution) (r2b-moveq r2bv-note r2bv-tr) (r2b-require 'r2bv-publisher) (if (null r2bv-editor) (r2b-require 'r2bv-author)) 'book) (r2bv-tr (r2b-require 'r2bv-institution) (if (string-match "\\`\\(\\(.\\|\n\\)+\\)[ \t\n]+\\([^ \t\n]\\)+\\'" r2bv-tr) (progn (setq r2bv-type (substring r2bv-tr 0 (match-end 1))) (setq r2bv-number (substring r2bv-tr (match-beginning 3))) (setq r2bv-tr nil)) (r2b-moveq r2bv-number r2bv-tr)) (r2b-require 'r2bv-author) 'techreport) (r2bv-institution (r2b-moveq r2bv-organization r2bv-institution) 'manual) (t 'misc) )) (r2b-require '( r2bv-year)) (if r2b-error-found (princ "\n% Warning -- Errors During Conversion Next Entry\n")) (princ "\n@") (princ r2bv-entry-kind) (princ "( ") (princ r2bv-kn) (r2b-put-field "author" r2bv-author ) (r2b-put-field "title" r2bv-title r2b-booktitle-abbrevs) (r2b-put-field "year" r2bv-year ) (r2b-put-field "month" r2bv-month r2b-month-abbrevs) (r2b-put-field "journal" r2bv-journal r2b-journal-abbrevs) (r2b-put-field "volume" r2bv-volume) (r2b-put-field "type" r2bv-type) (r2b-put-field "number" r2bv-number) (r2b-put-field "booktitle" r2bv-booktitle r2b-booktitle-abbrevs) (r2b-put-field "editor" r2bv-editor) (r2b-put-field "publisher" r2bv-publisher) (r2b-put-field "institution" r2bv-institution) (r2b-put-field "organization" r2bv-organization) (r2b-put-field "school" r2bv-school) (r2b-put-field "pages" r2bv-pages) (r2b-put-field "address" r2bv-address) (r2b-put-field "note" r2bv-note) (r2b-put-field "keywords" r2bv-keywords) (r2b-put-field "where" r2bv-where) (r2b-put-field "ordering" r2bv-ordering) (r2b-put-field "annote" r2bv-annote) (princ " )\n") ) ) (defun r2b-convert-record (output-name) "Transform current bib entry and append to buffer OUTPUT; do \"M-x r2b-help\" for more info." (interactive (list (read-string "Output to buffer: " r2b-out-buf-name))) (let (rec-end rec-begin not-done) (setq r2b-out-buf-name output-name) (setq r2b-out-buf (get-buffer-create output-name)) (setq r2b-in-buf (current-buffer)) (set-buffer r2b-out-buf) (goto-char (point-max)) (setq r2b-log (get-buffer-create r2b-log-name)) (set-buffer r2b-log) (goto-char (point-max)) (set-buffer r2b-in-buf) (setq not-done (re-search-forward "[^ \t\n]" nil t)) (if not-done (progn (re-search-backward "^[ \t]*$" nil 2) (re-search-forward "^%") (beginning-of-line nil) (setq rec-begin (point)) (re-search-forward "^[ \t]*$" nil 2) (setq rec-end (point)) (narrow-to-region rec-begin rec-end) (r2b-clear-variables) (r2b-snarf-input) (r2b-barf-output) (set-buffer r2b-in-buf) (widen) (goto-char rec-end) t) nil ) )) (defun r2b-convert-buffer (output-name) "Transform current buffer and append to buffer OUTPUT; do \"M-x r2b-help\" for more info." (interactive (list (read-string "Output to buffer: " r2b-out-buf-name))) (save-excursion (setq r2b-log (get-buffer-create r2b-log-name)) (set-buffer r2b-log) (erase-buffer)) (widen) (goto-char (point-min)) (message "Working, please be patient...") (sit-for 0) (while (r2b-convert-record output-name) t) (message "Done, results in %s, errors in %s" r2b-out-buf-name r2b-log-name) ) (defvar r2b-load-quietly nil "*Don't print help message when loaded") (defvar r2b-help-message " Refer to Bibtex Bibliography Conversion A refer-style database is of the form: %A Joe Blow %T Great Thoughts I've Thought %D 1977 etc. This utility converts these kind of databases to bibtex form, for users of TeX and LaTex. Instructions: 1. Visit the file containing the refer-style database. 2. The command M-x r2b-convert-buffer converts the entire buffer, appending it's output by default in a buffer named *Out*, and logging progress and errors in a buffer named *Log*. The original file is never modified. Note that results are appended to *Out*, so if that buffer buffer already exists and contains material you don't want to save, you should kill it first. 3. Switch to the buffer *Out* and save it as a named file. 4. To convert a single refer-style entry, simply position the cursor at the entry and enter M-x r2b-convert-record Again output is appended to *Out* and errors are logged in *Log*. This utility is very robust and pretty smart about determining the type of the entry. It includes facilities for expanding refer macros to text, or substituting bibtex macros. Do M-x describe-variable on r2b-journal-abbrevs r2b-booktitle-abbrevs r2b-proceedings-list for information on these features. If you don't want to see this help message when you load this utility, then include the following line in your .emacs file: (setq r2b-load-quietly t) To see this message again, perform M-x r2b-help Please send bug reports and suggestions to Henry Kautz kautz@research.att.com allegra!kautz") (defun r2b-help () "Print help message." (interactive) (with-output-to-temp-buffer "*Help*" (princ r2b-help-message) (save-excursion (set-buffer standard-output) (help-mode)))) (if (not r2b-load-quietly) (r2b-help)) (message "r2b loaded") (provide 'refer-to-bibtex) ;;; refbib.el ends here emacs-19.30/lisp/refer.el100444 12120 1 23635 6020016252 13516 0ustar rmsdaemon;;; refer.el --- look up references in bibliography files. ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Ashwin Ram ;; Adapted-By: ESR ;; Keywords: bib ;; 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: ;; ;; Functions to look up references in bibliography files given lists of ;; keywords, similar to refer(1). I don't use tags since tags on .bib files ;; only picks up the cite key, where as refer-find-entry looks for occurrences ;; of keywords anywhere in the bibliography entry. ;; ;; To use: ;; (autoload 'refer-find-entry "refer" nil t) ;; or (require 'refer) ;; ;; To look for an article by Knuth about semaphores: ;; Invoke refer-find-entry, then in response to the Keywords: prompt, ;; say: Knuth semaphores (a blank-separated list of keywords to be used ;; as search strings). ;; ;; To continue the previous search, i.e., to search for the next occurrence ;; of the keywords, use refer-find-next-entry, or invoke refer-find-entry ;; with a prefix argument. ;; ;; If the list of bibliography files changes, reinitialize the variable ;; refer-bib-files. ;; ;; To customize: ;; See variables refer-bib-files, refer-cache-bib-files and ;; refer-bib-files-regexp. By default, these are set up so that refer ;; looks for the keywords you specify in all the .bib files in the current ;; directory. ;; ;; The only assumption I make about bib files is that they contain a bunch ;; of entries, one to a paragraph. refer-find-entry searches paragraph by ;; paragraph, looking for a paragraph containing all the keywords ;; specified. So you should be able to use pretty much any bib file with ;; this code. If your bib file does not use paragraphs to separate ;; entries, try setting the paragraph-start/separate variables, or changing ;; the (forward-paragraph 1) call in refer-find-entry-in-file. ;;; ChangeLog: ;; ;; 01/08/89 Ashwin Ram ;; Initial release. ;; ;;; Code: (provide 'refer) (defvar refer-bib-files 'dir "*List of \\.bib files to search for references, or one of the following special values: nil = prompt for \\.bib file (if visiting a \\.bib file, use it as default) auto = read \\.bib file names from appropriate command in buffer (see refer-bib-files-regexp) dir = use all \\.bib files in current directory. If a specified file doesn't exist and has no extension, a \\.bib extension is automatically tried. If refer-bib-files is nil, auto or dir, it is setq'd to the appropriate list of files when it is first used if refer-cache-bib-files is t. If refer-cache-bib-files is nil, the list of \\.bib files to use is re-read each time it is needed.") (defvar refer-cache-bib-files t "*Variable determining whether the value of refer-bib-files should be cached. If t, initialize the value of refer-bib-files the first time it is used. If nil, re-read the list of \\.bib files depending on the value of refer-bib-files each time it is needed.") (defvar refer-bib-files-regexp "\\\\bibliography" "*Regexp matching a bibliography file declaration. The current buffer is expected to contain a line such as \\bibliography{file1,file2,file3} which is read to set up refer-bib-files. The regexp must specify the command \(such as \\bibliography) that is used to specify the list of bib files. The command is expected to specify a file name, or a list of comma-separated file names, within curly braces. If a specified file doesn't exist and has no extension, a \\.bib extension is automatically tried.") (make-variable-buffer-local 'refer-bib-files) (make-variable-buffer-local 'refer-cache-bib-files) (defun refer-find-entry (keywords &optional continue) "Find entry in refer-bib-files containing KEYWORDS. If KEYWORDS is nil, prompt user for blank-separated list of keywords. If CONTINUE is t, or if called interactively with a prefix arg, look for next entry by continuing search from previous point." (interactive (list nil current-prefix-arg)) (or keywords (setq keywords (if continue refer-previous-keywords (read-string "Keywords: ")))) (setq refer-previous-keywords keywords) (refer-find-entry-internal keywords continue)) (defun refer-find-next-entry () "Find next occurrence of entry in refer-bib-files. See refer-find-entry." (interactive) (refer-find-entry-internal refer-previous-keywords t)) (defun refer-find-entry-internal (keywords continue) (let ((keywords-list (refer-convert-string-to-list-of-strings keywords)) (files (if continue refer-saved-state (refer-get-bib-files)))) (catch 'found (while files (let ((file (cond ((file-exists-p (car files)) (car files)) ((file-exists-p (concat (car files) ".bib")) (concat (car files) ".bib"))))) (setq refer-saved-state files) (if file (if (refer-find-entry-in-file keywords-list file continue) (throw 'found (find-file file)) (setq files (cdr files))) (progn (message "Scanning %s... No such file" (car files) (ding)) (sit-for 1) (setq files (cdr files)))))) (message "Keywords \"%s\" not found in any \.bib file" keywords (ding))))) (defun refer-find-entry-in-file (keywords-list file &optional continue) (message "Scanning %s..." file) ; (expand-file-name file) (set-buffer (find-file-noselect file)) (if continue (forward-paragraph 1) (goto-char (point-min))) (let ((begin (point)) (end 0) (found nil)) (while (and (not found) (not (eobp))) (forward-paragraph 1) (setq end (point)) (setq found (refer-every (function (lambda (keyword) (goto-char begin) (re-search-forward keyword end t))) keywords-list)) (if (not found) (progn (setq begin end) (goto-char begin)))) (if found (progn (goto-char begin) (re-search-forward "\\W" nil t) (message "Scanning %s... found" file)) (progn (message "Scanning %s... not found" file) nil)))) (defun refer-every (pred l) (cond ((null l) nil) ((funcall pred (car l)) (or (null (cdr l)) (refer-every pred (cdr l)))))) (defun refer-convert-string-to-list-of-strings (s) (let ((current (current-buffer)) (temp-buffer (get-buffer-create "*refer-temp*"))) (set-buffer temp-buffer) (erase-buffer) (insert (regexp-quote s)) (goto-char (point-min)) (insert "(\"") (while (re-search-forward "[ \t]+" nil t) (replace-match "\" \"" t t)) (goto-char (point-max)) (insert "\")") (goto-char (point-min)) (prog1 (read temp-buffer) (set-buffer current)))) (defun refer-get-bib-files () (let ((files (cond ((null refer-bib-files) (list (expand-file-name (if (eq major-mode 'bibtex-mode) (read-file-name (format ".bib file: (default %s) " (file-name-nondirectory (buffer-file-name))) (file-name-directory (buffer-file-name)) (file-name-nondirectory (buffer-file-name)) t) (read-file-name ".bib file: " nil nil t))))) ((listp refer-bib-files) refer-bib-files) ((eq refer-bib-files 'auto) (save-excursion (if (progn (goto-char (point-min)) (re-search-forward (concat refer-bib-files-regexp "\{") nil t)) (let ((files (list (buffer-substring (point) (progn (re-search-forward "[,\}]" nil t) (backward-char 1) (point)))))) (while (not (looking-at "\}")) (setq files (append files (list (buffer-substring (progn (forward-char 1) (point)) (progn (re-search-forward "[,\}]" nil t) (backward-char 1) (point))))))) files) (error "No \\\\bibliography command in this buffer, can't read refer-bib-files")))) ((eq refer-bib-files 'dir) (directory-files "." t "\\.bib$")) (t (error "Illegal value for refer-bib-files: %s" refer-bib-files))))) (if refer-cache-bib-files (setq refer-bib-files files)) files)) ;;; refer.el ends here emacs-19.30/lisp/regi.el100444 12120 1 21076 6014111625 13341 0ustar rmsdaemon;;; regi.el --- REGular expression Interpreting engine ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. ;; Maintainer: bwarsaw@cen.com ;; Created: 24-Feb-1993 ;; Version: 1.8 ;; Last Modified: 1993/06/01 21:33:00 ;; Keywords: extensions, matching ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (defun regi-pos (&optional position col-p) "Return the character position at various buffer positions. Optional POSITION can be one of the following symbols: `bol' == beginning of line `boi' == beginning of indentation `eol' == end of line [default] `bonl' == beginning of next line `bopl' == beginning of previous line Optional COL-P non-nil returns `current-column' instead of character position." (save-excursion (cond ((eq position 'bol) (beginning-of-line)) ((eq position 'boi) (back-to-indentation)) ((eq position 'bonl) (forward-line 1)) ((eq position 'bopl) (forward-line -1)) (t (end-of-line))) (if col-p (current-column) (point)))) (defun regi-mapcar (predlist func &optional negate-p case-fold-search-p) "Build a regi frame where each element of PREDLIST appears exactly once. The frame contains elements where each member of PREDLIST is associated with FUNC, and optionally NEGATE-P and CASE-FOLD-SEARCH-P." (let (frame tail) (if (or negate-p case-fold-search-p) (setq tail (list negate-p))) (if case-fold-search-p (setq tail (append tail (list case-fold-search-p)))) (while predlist (let ((element (list (car predlist) func))) (if tail (setq element (append element tail))) (setq frame (append frame (list element)) predlist (cdr predlist)) )) frame)) (defun regi-interpret (frame &optional start end) "Interpret the regi frame FRAME. If optional START and END are supplied, they indicate the region of interest, and the buffer is narrowed to the beginning of the line containing START, and beginning of the line after the line containing END. Otherwise, point and mark are not set and processing continues until your FUNC returns the `abort' symbol (see below). Beware! Not supplying a START or END could put you in an infinite loop. A regi frame is a list of entries of the form: (PRED FUNC [NEGATE-P [CASE-FOLD-SEARCH]]) PRED is a predicate against which each line in the region is tested, and if a match occurs, FUNC is `eval'd. Point is then moved to the beginning of the next line, the frame is reset and checking continues. If a match doesn't occur, the next entry is checked against the current line until all entries in the frame are checked. At this point, if no match occurred, the frame is reset and point is moved to the next line. Checking continues until every line in the region is checked. Optional NEGATE-P inverts the result of PRED before FUNC is called and `case-fold-search' is bound to the optional value of CASE-FOLD-SEARCH for the PRED check. PRED can be a string, variable, function or one of the following symbols: t, nil, `begin', `end', and `every'. If PRED is a string, or a variable or list that evaluates to a string, it is interpreted as a regular expression and is matched against the current line (from the beginning) using `looking-at'. If PRED does not evaluate to a string, it is interpreted as a binary value (nil or non-nil). PRED can also be one of the following symbols: t -- always produces a true outcome `begin' -- always executes before anything else `end' -- always executes after everything else `every' -- execute after frame is matched on a line Note that NEGATE-P and CASE-FOLD-SEARCH are meaningless if PRED is one of these special symbols. Only the first occurance of each symbol in a frame entry is used, the rest are ignored. Your FUNC can return values which control regi processing. If a list is returned from your function, it can contain any combination of the following elements: the symbol `continue' Tells regi to continue processing frame-entries after a match, instead of resetting to the first entry and advancing to the next line, as is the default behavior. When returning this symbol, you must take care not to enter an infinite loop. the symbol `abort' Tells regi to terminate processing this frame. any end frame-entry is still processed. the list `(frame . NEWFRAME)' Tells regi to use NEWFRAME as its current frame. In other words, your FUNC can modify the executing regi frame on the fly. the list `(step . STEP)' Tells regi to move STEP number of lines forward during normal processing. By default, regi moves forward 1 line. STEP can be negative, but be careful of infinite loops. You should usually take care to explicitly return nil from your function if no action is to take place. Your FUNC will always be `eval'ed. The following variables will be temporarily bound to some useful information: `curline' the current line in the buffer, as a string `curframe' the full, current frame being executed `curentry' the current frame entry being executed." (save-excursion (save-restriction (let (begin-tag end-tag every-tag current-frame working-frame donep) ;; set up the narrowed region (and start end (let* ((tstart start) (start (min start end)) (end (max start end))) (narrow-to-region (progn (goto-char end) (regi-pos 'bonl)) (progn (goto-char start) (regi-pos 'bol))))) ;; lets find the special tags and remove them from the working ;; frame. note that only the last special tag is used. (mapcar (function (lambda (entry) (let ((pred (car entry)) (func (car (cdr entry)))) (cond ((eq pred 'begin) (setq begin-tag func)) ((eq pred 'end) (setq end-tag func)) ((eq pred 'every) (setq every-tag func)) (t (setq working-frame (append working-frame (list entry)))) ) ; end-cond ))) frame) ; end-mapcar ;; execute the begin entry (eval begin-tag) ;; now process the frame (setq current-frame working-frame) (while (not (or donep (eobp))) (let* ((entry (car current-frame)) (pred (nth 0 entry)) (func (nth 1 entry)) (negate-p (nth 2 entry)) (case-fold-search (nth 3 entry)) match-p) (catch 'regi-throw-top (cond ;; we are finished processing the frame for this line ((not current-frame) (setq current-frame working-frame) ;reset frame (forward-line 1) (throw 'regi-throw-top t)) ;; see if predicate evaluates to a string ((stringp (setq match-p (eval pred))) (setq match-p (looking-at match-p))) ) ; end-cond ;; now that we've done the initial matching, check for ;; negation of match (and negate-p (setq match-p (not match-p))) ;; if the line matched, package up the argument list and ;; funcall the FUNC (if match-p (let* ((curline (buffer-substring (regi-pos 'bol) (regi-pos 'eol))) (curframe current-frame) (curentry entry) (result (eval func)) (step (or (cdr (assq 'step result)) 1)) ) ;; changing frame on the fly? (if (assq 'frame result) (setq working-frame (cdr (assq 'frame result)))) ;; continue processing current frame? (if (memq 'continue result) (setq current-frame (cdr current-frame)) (forward-line step) (setq current-frame working-frame)) ;; abort current frame? (if (memq 'abort result) (progn (setq donep t) (throw 'regi-throw-top t))) ) ; end-let ;; else if no match occurred, then process the next ;; frame-entry on the current line (setq current-frame (cdr current-frame)) ) ; end-if match-p ) ; end catch ) ; end let ;; after every cycle, evaluate every-tag (eval every-tag) ) ; end-while ;; now process the end entry (eval end-tag))))) (provide 'regi) ;;; regi.el ends here emacs-19.30/lisp/register.el100444 12120 1 22270 6024075415 14243 0ustar rmsdaemon;;; register.el --- register commands for Emacs. ;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal ;; 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 package of functions emulates and somewhat extends the venerable ;; TECO's `register' feature, which permits you to save various useful ;; pieces of buffer state to named variables. The entry points are ;; documented in the Emacs user's manual. ;;; Code: (defvar register-alist nil "Alist of elements (NAME . CONTENTS), one for each Emacs register. NAME is a character (a number). CONTENTS is a string, number, frame configuration, mark or list. A list of strings represents a rectangle. A list of the form (file . NAME) represents the file named NAME.") (defun get-register (reg) "Return contents of Emacs register named REG, or nil if none." (cdr (assq reg register-alist))) (defun set-register (register value) "Set contents of Emacs register named REGISTER to VALUE. Returns VALUE. See the documentation of the variable `register-alist' for possible VALUE." (let ((aelt (assq register register-alist))) (if aelt (setcdr aelt value) (setq aelt (cons register value)) (setq register-alist (cons aelt register-alist))) value)) (defun point-to-register (register &optional arg) "Store current location of point in register REGISTER. With prefix argument, store current frame configuration. Use \\[jump-to-register] to go to that location or restore that configuration. Argument is a character, naming the register." (interactive "cPoint to register: \nP") (set-register register (if arg (current-frame-configuration) (point-marker)))) (defun window-configuration-to-register (register &optional arg) "Store the window configuration of the selected frame in register REGISTER. Use \\[jump-to-register] to restore the configuration. Argument is a character, naming the register." (interactive "cWindow configuration to register: \nP") (set-register register (current-window-configuration))) (defun frame-configuration-to-register (register &optional arg) "Store the window configuration of all frames in register REGISTER. Use \\[jump-to-register] to restore the configuration. Argument is a character, naming the register." (interactive "cFrame configuration to register: \nP") (set-register register (current-frame-configuration))) (defalias 'register-to-point 'jump-to-register) (defun jump-to-register (register &optional delete) "Move point to location stored in a register. If the register contains a file name, find that file. \(To put a file name in a register, you must use `set-register'.) If the register contains a window configuration (one frame) or a frame configuration (all frames), restore that frame or all frames accordingly. First argument is a character, naming the register. Optional second arg non-nil (interactively, prefix argument) says to delete any existing frames that the frame configuration doesn't mention. \(Otherwise, these frames are iconified.)" (interactive "cJump to register: \nP") (let ((val (get-register register))) (cond ((and (fboundp 'frame-configuration-p) (frame-configuration-p val)) (set-frame-configuration val (not delete))) ((window-configuration-p val) (set-window-configuration val)) ((markerp val) (or (marker-buffer val) (error "That register's buffer no longer exists")) (switch-to-buffer (marker-buffer val)) (goto-char val)) ((and (consp val) (eq (car val) 'file)) (find-file (cdr val))) (t (error "Register doesn't contain a buffer position or configuration"))))) ;(defun number-to-register (arg char) ; "Store a number in a register. ;Two args, NUMBER and REGISTER (a character, naming the register). ;If NUMBER is nil, digits in the buffer following point are read ;to get the number to store. ;Interactively, NUMBER is the prefix arg (none means nil)." ; (interactive "P\ncNumber to register: ") ; (set-register char ; (if arg ; (prefix-numeric-value arg) ; (if (looking-at "[0-9][0-9]*") ; (save-excursion ; (save-restriction ; (narrow-to-region (point) ; (progn (skip-chars-forward "0-9") ; (point))) ; (goto-char (point-min)) ; (read (current-buffer)))) ; 0)))) ;(defun increment-register (arg char) ; "Add NUMBER to the contents of register REGISTER. ;Interactively, NUMBER is the prefix arg (none means nil)." ; (interactive "p\ncNumber to register: ") ; (or (integerp (get-register char)) ; (error "Register does not contain a number")) ; (set-register char (+ arg (get-register char)))) (defun view-register (register) "Display what is contained in register named REGISTER. The Lisp value REGISTER is a character." (interactive "cView register: ") (let ((val (get-register register))) (if (null val) (message "Register %s is empty" (single-key-description register)) (with-output-to-temp-buffer "*Output*" (princ "Register ") (princ (single-key-description register)) (princ " contains ") (cond ((integerp val) (princ val)) ((markerp val) (let ((buf (marker-buffer val))) (if (null buf) (princ "a marker in no buffer") (princ "a buffer position:\nbuffer ") (princ (buffer-name buf)) (princ ", position ") (princ (marker-position val))))) ((window-configuration-p val) (princ "a window configuration.")) ((frame-configuration-p val) (princ "a frame configuration.")) ((and (consp val) (eq (car val) 'file)) (princ "the file ") (prin1 (cdr val)) (princ ".")) ((consp val) (princ "the rectangle:\n") (while val (princ (car val)) (terpri) (setq val (cdr val)))) ((stringp val) (princ "the text:\n") (princ val)) (t (princ "Garbage:\n") (prin1 val))))))) (defun insert-register (register &optional arg) "Insert contents of register REGISTER. (REGISTER is a character.) Normally puts point before and mark after the inserted text. If optional second arg is non-nil, puts mark before and point after. Interactively, second arg is non-nil if prefix arg is supplied." (interactive "*cInsert register: \nP") (push-mark) (let ((val (get-register register))) (cond ((consp val) (insert-rectangle val)) ((stringp val) (insert val)) ((integerp val) (princ val (current-buffer))) ((and (markerp val) (marker-position val)) (princ (marker-position val) (current-buffer))) (t (error "Register does not contain text")))) (if (not arg) (exchange-point-and-mark))) (defun copy-to-register (register start end &optional delete-flag) "Copy region into register REGISTER. With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to copy." (interactive "cCopy to register: \nr\nP") (set-register register (buffer-substring start end)) (if delete-flag (delete-region start end))) (defun append-to-register (register start end &optional delete-flag) "Append region to text in register REGISTER. With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to append." (interactive "cAppend to register: \nr\nP") (or (stringp (get-register register)) (error "Register does not contain text")) (set-register register (concat (get-register register) (buffer-substring start end))) (if delete-flag (delete-region start end))) (defun prepend-to-register (register start end &optional delete-flag) "Prepend region to text in register REGISTER. With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to prepend." (interactive "cPrepend to register: \nr\nP") (or (stringp (get-register register)) (error "Register does not contain text")) (set-register register (concat (buffer-substring start end) (get-register register))) (if delete-flag (delete-region start end))) (defun copy-rectangle-to-register (register start end &optional delete-flag) "Copy rectangular region into register REGISTER. With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions giving two corners of rectangle." (interactive "cCopy rectangle to register: \nr\nP") (set-register register (if delete-flag (delete-extract-rectangle start end) (extract-rectangle start end)))) ;;; register.el ends here emacs-19.30/lisp/replace.el100444 12120 1 62672 6024120326 14034 0ustar rmsdaemon;;; replace.el --- replace commands for Emacs. ;; Copyright (C) 1985, 1986, 1987, 1992, 1994 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 package supplies the string and regular-expression replace functions ;; documented in the Emacs user's manual. ;;; Code: (defconst case-replace t "\ *Non-nil means query-replace should preserve case in replacements.") (defvar query-replace-history nil) (defvar query-replace-interactive nil "Non-nil means `query-replace' uses the last search string. That becomes the \"string to replace\".") (defun query-replace-read-args (string regexp-flag) (let (from to) (if query-replace-interactive (setq from (car (if regexp-flag regexp-search-ring search-ring))) (setq from (read-from-minibuffer (format "%s: " string) nil nil nil 'query-replace-history))) (setq to (read-from-minibuffer (format "%s %s with: " string from) nil nil nil 'query-replace-history)) (list from to current-prefix-arg))) (defun query-replace (from-string to-string &optional arg) "Replace some occurrences of FROM-STRING with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. If `query-replace-interactive' is non-nil, the last incremental search string is used as FROM-STRING--you don't have to specify it with the minibuffer. Preserves case in each replacement if `case-replace' and `case-fold-search' are non-nil and FROM-STRING has no uppercase letters. \(Preserving case means that if the string matched is all caps, or capitalized, then its replacement is upcased or capitalized.) Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. To customize possible responses, change the \"bindings\" in `query-replace-map'." (interactive (query-replace-read-args "Query replace" nil)) (perform-replace from-string to-string t nil arg)) (define-key esc-map "%" 'query-replace) (defun query-replace-regexp (regexp to-string &optional arg) "Replace some things after point matching REGEXP with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. If `query-replace-interactive' is non-nil, the last incremental search regexp is used as REGEXP--you don't have to specify it with the minibuffer. Preserves case in each replacement if `case-replace' and `case-fold-search' are non-nil and REGEXP has no uppercase letters. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, and `\\=\\N' (where N is a digit) stands for whatever what matched the Nth `\\(...\\)' in REGEXP." (interactive (query-replace-read-args "Query replace regexp" t)) (perform-replace regexp to-string t t arg)) (defun map-query-replace-regexp (regexp to-strings &optional arg) "Replace some matches for REGEXP with various strings, in rotation. The second argument TO-STRINGS contains the replacement strings, separated by spaces. This command works like `query-replace-regexp' except that each successive replacement uses the next successive replacement string, wrapping around from the last such string to the first. Non-interactively, TO-STRINGS may be a list of replacement strings. If `query-replace-interactive' is non-nil, the last incremental search regexp is used as REGEXP--you don't have to specify it with the minibuffer. A prefix argument N says to use each replacement string N times before rotating to the next." (interactive (let (from to) (setq from (if query-replace-interactive (car regexp-search-ring) (read-from-minibuffer "Map query replace (regexp): " nil nil nil 'query-replace-history))) (setq to (read-from-minibuffer (format "Query replace %s with (space-separated strings): " from) nil nil nil 'query-replace-history)) (list from to current-prefix-arg))) (let (replacements) (if (listp to-strings) (setq replacements to-strings) (while (/= (length to-strings) 0) (if (string-match " " to-strings) (setq replacements (append replacements (list (substring to-strings 0 (string-match " " to-strings)))) to-strings (substring to-strings (1+ (string-match " " to-strings)))) (setq replacements (append replacements (list to-strings)) to-strings "")))) (perform-replace regexp replacements t t nil arg))) (defun replace-string (from-string to-string &optional delimited) "Replace occurrences of FROM-STRING with TO-STRING. Preserve case in each match if `case-replace' and `case-fold-search' are non-nil and FROM-STRING has no uppercase letters. \(Preserving case means that if the string matched is all caps, or capitalized, then its replacement is upcased or capitalized.) Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. If `query-replace-interactive' is non-nil, the last incremental search string is used as FROM-STRING--you don't have to specify it with the minibuffer. This function is usually the wrong thing to use in a Lisp program. What you probably want is a loop like this: (while (search-forward FROM-STRING nil t) (replace-match TO-STRING nil t)) which will run faster and will not set the mark or print anything." (interactive (query-replace-read-args "Replace string" nil)) (perform-replace from-string to-string nil nil delimited)) (defun replace-regexp (regexp to-string &optional delimited) "Replace things after point matching REGEXP with TO-STRING. Preserve case in each match if `case-replace' and `case-fold-search' are non-nil and REGEXP has no uppercase letters. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, and `\\=\\N' (where N is a digit) stands for whatever what matched the Nth `\\(...\\)' in REGEXP. If `query-replace-interactive' is non-nil, the last incremental search regexp is used as REGEXP--you don't have to specify it with the minibuffer. This function is usually the wrong thing to use in a Lisp program. What you probably want is a loop like this: (while (re-search-forward REGEXP nil t) (replace-match TO-STRING nil nil)) which will run faster and will not set the mark or print anything." (interactive (query-replace-read-args "Replace regexp" t)) (perform-replace regexp to-string nil t delimited)) (defvar regexp-history nil "History list for some commands that read regular expressions.") (defalias 'delete-non-matching-lines 'keep-lines) (defun keep-lines (regexp) "Delete all lines except those containing matches for REGEXP. A match split across lines preserves all the lines it lies in. Applies to all lines after point." (interactive (list (read-from-minibuffer "Keep lines (containing match for regexp): " nil nil nil 'regexp-history))) (save-excursion (or (bolp) (forward-line 1)) (let ((start (point))) (while (not (eobp)) ;; Start is first char not preserved by previous match. (if (not (re-search-forward regexp nil 'move)) (delete-region start (point-max)) (let ((end (save-excursion (goto-char (match-beginning 0)) (beginning-of-line) (point)))) ;; Now end is first char preserved by the new match. (if (< start end) (delete-region start end)))) (setq start (save-excursion (forward-line 1) (point))) ;; If the match was empty, avoid matching again at same place. (and (not (eobp)) (= (match-beginning 0) (match-end 0)) (forward-char 1)))))) (defalias 'delete-matching-lines 'flush-lines) (defun flush-lines (regexp) "Delete lines containing matches for REGEXP. If a match is split across lines, all the lines it lies in are deleted. Applies to lines after point." (interactive (list (read-from-minibuffer "Flush lines (containing match for regexp): " nil nil nil 'regexp-history))) (save-excursion (while (and (not (eobp)) (re-search-forward regexp nil t)) (delete-region (save-excursion (goto-char (match-beginning 0)) (beginning-of-line) (point)) (progn (forward-line 1) (point)))))) (defalias 'count-matches 'how-many) (defun how-many (regexp) "Print number of matches for REGEXP following point." (interactive (list (read-from-minibuffer "How many matches for (regexp): " nil nil nil 'regexp-history))) (let ((count 0) opoint) (save-excursion (while (and (not (eobp)) (progn (setq opoint (point)) (re-search-forward regexp nil t))) (if (= opoint (point)) (forward-char 1) (setq count (1+ count)))) (message "%d occurrences" count)))) (defvar occur-mode-map ()) (if occur-mode-map () (setq occur-mode-map (make-sparse-keymap)) (define-key occur-mode-map [mouse-2] 'occur-mode-mouse-goto) (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence) (define-key occur-mode-map "\C-m" 'occur-mode-goto-occurrence)) (defvar occur-buffer nil) (defvar occur-nlines nil) (defvar occur-pos-list nil) (defun occur-mode () "Major mode for output from \\[occur]. \\Move point to one of the items in this buffer, then use \\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to. Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. \\{occur-mode-map}" (kill-all-local-variables) (use-local-map occur-mode-map) (setq major-mode 'occur-mode) (setq mode-name "Occur") (make-local-variable 'occur-buffer) (make-local-variable 'occur-nlines) (make-local-variable 'occur-pos-list) (run-hooks 'occur-mode-hook)) (defun occur-mode-mouse-goto (event) "In Occur mode, go to the occurrence whose line you click on." (interactive "e") (let (buffer pos) (save-excursion (set-buffer (window-buffer (posn-window (event-end event)))) (save-excursion (goto-char (posn-point (event-end event))) (setq pos (occur-mode-find-occurrence)) (setq buffer occur-buffer))) (pop-to-buffer buffer) (goto-char (marker-position pos)))) (defun occur-mode-find-occurrence () (if (or (null occur-buffer) (null (buffer-name occur-buffer))) (progn (setq occur-buffer nil occur-pos-list nil) (error "Buffer in which occurrences were found is deleted"))) (let* ((line-count (count-lines (point-min) (save-excursion (beginning-of-line) (point)))) (occur-number (save-excursion (beginning-of-line) (/ (1- line-count) (cond ((< occur-nlines 0) (- 2 occur-nlines)) ((> occur-nlines 0) (+ 2 (* 2 occur-nlines))) (t 1))))) (pos (nth occur-number occur-pos-list))) (if (< line-count 1) (error "No occurrence on this line")) (or pos (error "No occurrence on this line")) pos)) (defun occur-mode-goto-occurrence () "Go to the occurrence the current line describes." (interactive) (let ((pos (occur-mode-find-occurrence))) (pop-to-buffer occur-buffer) (goto-char (marker-position pos)))) (defvar list-matching-lines-default-context-lines 0 "*Default number of context lines to include around a `list-matching-lines' match. A negative number means to include that many lines before the match. A positive number means to include that many lines both before and after.") (defalias 'list-matching-lines 'occur) (defun occur (regexp &optional nlines) "Show all lines in the current buffer containing a match for REGEXP. If a match spreads across multiple lines, all those lines are shown. Each line is displayed with NLINES lines before and after, or -NLINES before if NLINES is negative. NLINES defaults to `list-matching-lines-default-context-lines'. Interactively it is the prefix arg. The lines are shown in a buffer named `*Occur*'. It serves as a menu to find any of the occurrences in this buffer. \\[describe-mode] in that buffer will explain how." (interactive (list (let* ((default (car regexp-history)) (input (read-from-minibuffer (if default (format "List lines matching regexp (default `%s'): " default) "List lines matching regexp: ") nil nil nil 'regexp-history))) (if (> (length input) 0) input (setcar regexp-history default))) current-prefix-arg)) (setq nlines (if nlines (prefix-numeric-value nlines) list-matching-lines-default-context-lines)) (let ((first t) (buffer (current-buffer)) (dir default-directory) (linenum 1) (prevpos (point-min)) (final-context-start (make-marker))) ;;; (save-excursion ;;; (beginning-of-line) ;;; (setq linenum (1+ (count-lines (point-min) (point)))) ;;; (setq prevpos (point))) (with-output-to-temp-buffer "*Occur*" (save-excursion (set-buffer standard-output) (setq default-directory dir) ;; We will insert the number of lines, and "lines", later. (insert " matching ") (let ((print-escape-newlines t)) (prin1 regexp)) (insert " in buffer " (buffer-name buffer) ?. ?\n) (occur-mode) (setq occur-buffer buffer) (setq occur-nlines nlines) (setq occur-pos-list ())) (if (eq buffer standard-output) (goto-char (point-max))) (save-excursion (beginning-of-buffer) ;; Find next match, but give up if prev match was at end of buffer. (while (and (not (= prevpos (point-max))) (re-search-forward regexp nil t)) (goto-char (match-beginning 0)) (beginning-of-line) (save-match-data (setq linenum (+ linenum (count-lines prevpos (point))))) (setq prevpos (point)) (goto-char (match-end 0)) (let* ((start (save-excursion (goto-char (match-beginning 0)) (forward-line (if (< nlines 0) nlines (- nlines))) (point))) (end (save-excursion (goto-char (match-end 0)) (if (> nlines 0) (forward-line (1+ nlines)) (forward-line 1)) (point))) (tag (format "%5d" linenum)) (empty (make-string (length tag) ?\ )) tem) (save-excursion (setq tem (make-marker)) (set-marker tem (point)) (set-buffer standard-output) (setq occur-pos-list (cons tem occur-pos-list)) (or first (zerop nlines) (insert "--------\n")) (setq first nil) (insert-buffer-substring buffer start end) (set-marker final-context-start (- (point) (- end (match-end 0)))) (backward-char (- end start)) (setq tem nlines) (while (> tem 0) (insert empty ?:) (forward-line 1) (setq tem (1- tem))) (let ((this-linenum linenum)) (while (< (point) final-context-start) (if (null tag) (setq tag (format "%5d" this-linenum))) (insert tag ?:) (put-text-property (save-excursion (beginning-of-line) (point)) (save-excursion (end-of-line) (point)) 'mouse-face 'highlight) (forward-line 1) (setq tag nil) (setq this-linenum (1+ this-linenum))) (while (<= (point) final-context-start) (insert empty ?:) (forward-line 1) (setq this-linenum (1+ this-linenum)))) (while (< tem nlines) (insert empty ?:) (forward-line 1) (setq tem (1+ tem))) (goto-char (point-max))) (forward-line 1))) (set-buffer standard-output) ;; Put positions in increasing order to go with buffer. (setq occur-pos-list (nreverse occur-pos-list)) (goto-char (point-min)) (if (= (length occur-pos-list) 1) (insert "1 line") (insert (format "%d lines" (length occur-pos-list)))) (if (interactive-p) (message "%d matching lines." (length occur-pos-list))))))) ;; It would be nice to use \\[...], but there is no reasonable way ;; to make that display both SPC and Y. (defconst query-replace-help "Type Space or `y' to replace one match, Delete or `n' to skip to next, RET or `q' to exit, Period to replace one match and exit, Comma to replace but not move point immediately, C-r to enter recursive edit (\\[exit-recursive-edit] to get out again), C-w to delete match and recursive edit, C-l to clear the screen, redisplay, and offer same replacement again, ! to replace all remaining matches with no more questions, ^ to move point back to previous match." "Help message while in query-replace") (defvar query-replace-map (make-sparse-keymap) "Keymap that defines the responses to questions in `query-replace'. The \"bindings\" in this map are not commands; they are answers. The valid answers include `act', `skip', `act-and-show', `exit', `act-and-exit', `edit', `delete-and-edit', `recenter', `automatic', `backup', `exit-prefix', and `help'.") (define-key query-replace-map " " 'act) (define-key query-replace-map "\d" 'skip) (define-key query-replace-map [delete] 'skip) (define-key query-replace-map [backspace] 'skip) (define-key query-replace-map "y" 'act) (define-key query-replace-map "n" 'skip) (define-key query-replace-map "Y" 'act) (define-key query-replace-map "N" 'skip) (define-key query-replace-map "," 'act-and-show) (define-key query-replace-map "q" 'exit) (define-key query-replace-map "\r" 'exit) (define-key query-replace-map [return] 'exit) (define-key query-replace-map "." 'act-and-exit) (define-key query-replace-map "\C-r" 'edit) (define-key query-replace-map "\C-w" 'delete-and-edit) (define-key query-replace-map "\C-l" 'recenter) (define-key query-replace-map "!" 'automatic) (define-key query-replace-map "^" 'backup) (define-key query-replace-map "\C-h" 'help) (define-key query-replace-map [f1] 'help) (define-key query-replace-map [help] 'help) (define-key query-replace-map "?" 'help) (define-key query-replace-map "\C-g" 'quit) (define-key query-replace-map "\C-]" 'quit) (define-key query-replace-map "\e" 'exit-prefix) (define-key query-replace-map [escape] 'exit-prefix) (defun perform-replace (from-string replacements query-flag regexp-flag delimited-flag &optional repeat-count map) "Subroutine of `query-replace'. Its complexity handles interactive queries. Don't use this in your own program unless you want to query and set the mark just as `query-replace' does. Instead, write a simple loop like this: (while (re-search-forward \"foo[ \t]+bar\" nil t) (replace-match \"foobar\" nil nil)) which will run faster and probably do exactly what you want." (or map (setq map query-replace-map)) (let ((nocasify (not (and case-fold-search case-replace (string-equal from-string (downcase from-string))))) (literal (not regexp-flag)) (search-function (if regexp-flag 're-search-forward 'search-forward)) (search-string from-string) (real-match-data nil) ; the match data for the current match (next-replacement nil) (replacement-index 0) (keep-going t) (stack nil) (next-rotate-count 0) (replace-count 0) (lastrepl nil) ;Position after last match considered. (match-again t) (message (if query-flag (substitute-command-keys "Query replacing %s with %s: (\\\\[help] for help) ")))) (if (stringp replacements) (setq next-replacement replacements) (or repeat-count (setq repeat-count 1))) (if delimited-flag (setq search-function 're-search-forward search-string (concat "\\b" (if regexp-flag from-string (regexp-quote from-string)) "\\b"))) (push-mark) (undo-boundary) (unwind-protect ;; Loop finding occurrences that perhaps should be replaced. (while (and keep-going (not (eobp)) (funcall search-function search-string nil t) ;; If the search string matches immediately after ;; the previous match, but it did not match there ;; before the replacement was done, ignore the match. (if (or (eq lastrepl (point)) (and regexp-flag (eq lastrepl (match-beginning 0)) (not match-again))) (if (eobp) nil ;; Don't replace the null string ;; right after end of previous replacement. (forward-char 1) (funcall search-function search-string nil t)) t)) ;; Save the data associated with the real match. (setq real-match-data (match-data)) ;; Before we make the replacement, decide whether the search string ;; can match again just after this match. (if regexp-flag (setq match-again (looking-at search-string))) ;; If time for a change, advance to next replacement string. (if (and (listp replacements) (= next-rotate-count replace-count)) (progn (setq next-rotate-count (+ next-rotate-count repeat-count)) (setq next-replacement (nth replacement-index replacements)) (setq replacement-index (% (1+ replacement-index) (length replacements))))) (if (not query-flag) (progn (store-match-data real-match-data) (replace-match next-replacement nocasify literal) (setq replace-count (1+ replace-count))) (undo-boundary) (let (done replaced key def) ;; Loop reading commands until one of them sets done, ;; which means it has finished handling this occurrence. (while (not done) (store-match-data real-match-data) (replace-highlight (match-beginning 0) (match-end 0)) ;; Bind message-log-max so we don't fill up the message log ;; with a bunch of identical messages. (let ((message-log-max nil)) (message message from-string next-replacement)) (setq key (read-event)) (setq key (vector key)) (setq def (lookup-key map key)) ;; Restore the match data while we process the command. (cond ((eq def 'help) (with-output-to-temp-buffer "*Help*" (princ (concat "Query replacing " (if regexp-flag "regexp " "") from-string " with " next-replacement ".\n\n" (substitute-command-keys query-replace-help))) (save-excursion (set-buffer standard-output) (help-mode)))) ((eq def 'exit) (setq keep-going nil) (setq done t)) ((eq def 'backup) (if stack (let ((elt (car stack))) (goto-char (car elt)) (setq replaced (eq t (cdr elt))) (or replaced (store-match-data (cdr elt))) (setq stack (cdr stack))) (message "No previous match") (ding 'no-terminate) (sit-for 1))) ((eq def 'act) (or replaced (replace-match next-replacement nocasify literal)) (setq done t replaced t)) ((eq def 'act-and-exit) (or replaced (replace-match next-replacement nocasify literal)) (setq keep-going nil) (setq done t replaced t)) ((eq def 'act-and-show) (if (not replaced) (progn (replace-match next-replacement nocasify literal) (setq replaced t)))) ((eq def 'automatic) (or replaced (replace-match next-replacement nocasify literal)) (setq done t query-flag nil replaced t)) ((eq def 'skip) (setq done t)) ((eq def 'recenter) (recenter nil)) ((eq def 'edit) (store-match-data (prog1 (match-data) (save-excursion (recursive-edit)))) ;; Before we make the replacement, ;; decide whether the search string ;; can match again just after this match. (if regexp-flag (setq match-again (looking-at search-string)))) ((eq def 'delete-and-edit) (delete-region (match-beginning 0) (match-end 0)) (store-match-data (prog1 (match-data) (save-excursion (recursive-edit)))) (setq replaced t)) ;; Note: we do not need to treat `exit-prefix' ;; specially here, since we reread ;; any unrecognized character. (t (setq this-command 'mode-exited) (setq keep-going nil) (setq unread-command-events (append (listify-key-sequence key) unread-command-events)) (setq done t)))) ;; Record previous position for ^ when we move on. ;; Change markers to numbers in the match data ;; since lots of markers slow down editing. (setq stack (cons (cons (point) (or replaced (mapcar (lambda (elt) (and elt (prog1 (marker-position elt) (set-marker elt nil)))) (match-data)))) stack)) (if replaced (setq replace-count (1+ replace-count))))) (setq lastrepl (point))) (replace-dehighlight)) (or unread-command-events (message "Replaced %d occurrence%s" replace-count (if (= replace-count 1) "" "s"))) (and keep-going stack))) (defvar query-replace-highlight nil "*Non-nil means to highlight words during query replacement.") (defvar replace-overlay nil) (defun replace-dehighlight () (and replace-overlay (progn (delete-overlay replace-overlay) (setq replace-overlay nil)))) (defun replace-highlight (start end) (and query-replace-highlight (progn (or replace-overlay (progn (setq replace-overlay (make-overlay start end)) (overlay-put replace-overlay 'face (if (internal-find-face 'query-replace) 'query-replace 'region)))) (move-overlay replace-overlay start end (current-buffer))))) ;;; replace.el ends here emacs-19.30/lisp/reporter.el100444 12120 1 34746 5742337130 14275 0ustar rmsdaemon;;; reporter.el --- customizable bug reporting of lisp programs ;; Author: 1993 Barry A. Warsaw ;; Maintainer: bwarsaw@cnri.reston.va.us ;; Created: 19-Apr-1993 ;; Version: 2.21 ;; Last Modified: 1994/11/29 16:13:50 ;; Keywords: bug reports lisp ;; Copyright (C) 1993 1994 Barry A. Warsaw ;; Copyright (C) 1993 1994 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: ;; ;; Introduction ;; ============ ;; This program is for lisp package authors and can be used to ease ;; reporting of bugs. When invoked, reporter-submit-bug-report will ;; set up a mail buffer with the appropriate bug report address, ;; including a lisp expression the maintainer of the package can eval ;; to completely reproduce the environment in which the bug was ;; observed (e.g. by using eval-last-sexp). This package proved ;; especially useful during my development of cc-mode.el, which is ;; highly dependent on its configuration variables. ;; ;; Do a "C-h f reporter-submit-bug-report" for more information. ;; Here's an example usage: ;; ;;(defconst mypkg-version "9.801") ;;(defconst mypkg-maintainer-address "mypkg-help@foo.com") ;;(defun mypkg-submit-bug-report () ;; "Submit via mail a bug report on mypkg" ;; (interactive) ;; (require 'reporter) ;; (reporter-submit-bug-report ;; mypkg-maintainer-address ;; (concat "mypkg.el " mypkg-version) ;; (list 'mypkg-variable-1 ;; 'mypkg-variable-2 ;; ;; ... ;; 'mypkg-variable-last))) ;; Mailing List ;; ============ ;; I've set up a mailing list to report bugs or suggest enhancements, ;; etc. This list's intended audience is elisp package authors who are ;; using reporter and want to stay current with releases. Here are the ;; relevent addresses: ;; ;; Administrivia: reporter-request@anthem.nlm.nih.gov ;; Submissions: reporter@anthem.nlm.nih.gov ;; Packages that currently use reporter are: cc-mode, supercite, elp, ;; tcl, ediff, crypt, vm, edebug, archie, and efs. If you know of ;; others, please email me! ;; LCD Archive Entry: ;; reporter|Barry A. Warsaw|bwarsaw@cnri.reston.va.us| ;; Customizable bug reporting of lisp programs.| ;; 1994/11/29 16:13:50|2.21|~/misc/reporter.el.Z| ;;; Code: ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ;; user defined variables (defvar reporter-mailer '(vm-mail reporter-mail) "*Mail package to use to generate bug report buffer. This can either be a function symbol or a list of function symbols. If a list, it tries to use each specified mailer in order until an existing one is found. MH-E users may want to use `mh-smail'.") (defvar reporter-prompt-for-summary-p nil "Interface variable controlling prompting for problem summary. When non-nil, `reporter-submit-bug-report' prompts the user for a brief summary of the problem, and puts this summary on the Subject: line. Default behavior is to not prompt (i.e. nil). If you want reporter to prompt, you should `let' bind this variable to t before calling `reporter-submit-bug-report'. Note that this variable is not buffer-local so you should never just `setq' it.") (defvar reporter-dont-compact-list nil "Interface variable controlling compating of list values. When non-nil, this must be a list of variable symbols. When a variable containing a list value is formatted in the bug report mail buffer, it normally is compacted so that its value fits one the fewest number of lines. If the variable's symbol appears in this list, its value is printed in a more verbose style, specifically, one elemental sexp per line. Note that this variable is not buffer-local so you should never just `setq' it. If you want to changes its default value, you should `let' bind it.") ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; end of user defined variables (defvar reporter-eval-buffer nil "Buffer to retrieve variable's value from. This is necessary to properly support the printing of buffer-local variables. Current buffer will always be the mail buffer being composed.") (defconst reporter-version "2.21" "Reporter version number.") (defvar reporter-initial-text nil "The automatically created initial text of a bug report.") (make-variable-buffer-local 'reporter-initial-text) (defvar reporter-status-message nil) (defvar reporter-status-count nil) (defun reporter-update-status () ;; periodically output a status message (if (zerop (% reporter-status-count 10)) (progn (message reporter-status-message) (setq reporter-status-message (concat reporter-status-message ".")))) (setq reporter-status-count (1+ reporter-status-count))) (defun reporter-beautify-list (maxwidth compact-p) ;; pretty print a list (reporter-update-status) (let (linebreak indent-enclosing-p indent-p here) (condition-case nil ;loop exit (progn (down-list 1) (setq indent-enclosing-p t) (while t (setq here (point)) (forward-sexp 1) (if (<= maxwidth (current-column)) (if linebreak (progn (goto-char linebreak) (newline-and-indent) (setq linebreak nil)) (goto-char here) (setq indent-p (reporter-beautify-list maxwidth compact-p)) (goto-char here) (forward-sexp 1) (if indent-p (newline-and-indent)) t) (if compact-p (setq linebreak (point)) (newline-and-indent)) )) t) (error indent-enclosing-p)))) (defun reporter-lisp-indent (indent-point state) ;; a better lisp indentation style for bug reporting (save-excursion (goto-char (1+ (nth 1 state))) (current-column))) (defun reporter-dump-variable (varsym mailbuf) ;; Pretty-print the value of the variable in symbol VARSYM. MAILBUF ;; is the mail buffer being composed (reporter-update-status) (condition-case nil (let ((val (save-excursion (set-buffer reporter-eval-buffer) (symbol-value varsym))) (sym (symbol-name varsym)) (print-escape-newlines t) (maxwidth (1- (window-width))) (here (point))) (insert " " sym " " (cond ((memq val '(t nil)) "") ((listp val) "'") ((symbolp val) "'") (t "")) (prin1-to-string val)) (lisp-indent-line) ;; clean up lists, but only if the line as printed was long ;; enough to wrap (if (and val ;nil is a list, but short (listp val) (<= maxwidth (current-column))) (save-excursion (let ((compact-p (not (memq varsym reporter-dont-compact-list))) (lisp-indent-function 'reporter-lisp-indent)) (goto-char here) (reporter-beautify-list maxwidth compact-p)))) (insert "\n")) (void-variable (save-excursion (set-buffer mailbuf) (mail-position-on-field "X-Reporter-Void-Vars-Found") (end-of-line) (insert (symbol-name varsym) " "))) (error (error)))) (defun reporter-dump-state (pkgname varlist pre-hooks post-hooks) ;; Dump the state of the mode specific variables. ;; PKGNAME contains the name of the mode as it will appear in the bug ;; report (you must explicitly concat any version numbers). ;; VARLIST is the list of variables to dump. Each element in ;; VARLIST can be a variable symbol, or a cons cell. If a symbol, ;; this will be passed to `reporter-dump-variable' for insertion ;; into the mail buffer. If a cons cell, the car must be a variable ;; symbol and the cdr must be a function which will be `funcall'd ;; with arguments the symbol and the mail buffer being composed. Use ;; this to write your own custom variable value printers for ;; specific variables. ;; Note that the global variable `reporter-eval-buffer' will be bound to ;; the buffer in which `reporter-submit-bug-report' was invoked. If you ;; want to print the value of a buffer local variable, you should wrap ;; the `eval' call in your custom printer inside a `set-buffer' (and ;; probably a `save-excursion'). `reporter-dump-variable' handles this ;; properly. ;; PRE-HOOKS is run after the emacs-version and PKGNAME are inserted, but ;; before the VARLIST is dumped. POST-HOOKS is run after the VARLIST is ;; dumped. (let ((buffer (current-buffer))) (set-buffer buffer) (insert "Emacs : " (emacs-version) "\n") (and pkgname (insert "Package: " pkgname "\n")) (run-hooks 'pre-hooks) (if (not varlist) nil (insert "\ncurrent state:\n==============\n") ;; create an emacs-lisp-mode buffer to contain the output, which ;; we'll later insert into the mail buffer (condition-case fault (let ((mailbuf (current-buffer)) (elbuf (get-buffer-create " *tmp-reporter-buffer*"))) (save-excursion (set-buffer elbuf) (emacs-lisp-mode) (erase-buffer) (insert "(setq\n") (lisp-indent-line) (mapcar (function (lambda (varsym-or-cons-cell) (let ((varsym (or (car-safe varsym-or-cons-cell) varsym-or-cons-cell)) (printer (or (cdr-safe varsym-or-cons-cell) 'reporter-dump-variable))) (funcall printer varsym mailbuf) ))) varlist) (lisp-indent-line) (insert ")\n")) (insert-buffer elbuf)) (error (insert "State could not be dumped due to the following error:\n\n" (format "%s" fault) "\n\nYou should still send this bug report.")))) (run-hooks 'post-hooks) )) (defun reporter-calculate-separator () ;; returns the string regexp matching the mail separator (save-excursion (re-search-forward (concat "^\\(" ;beginning of line (mapconcat 'identity (list "[\t ]*" ;simple SMTP form "-+" ;mh-e form (regexp-quote mail-header-separator)) ;sendmail.el form "\\|") ;or them together "\\)$") ;end of line nil 'move) ;search for and move (buffer-substring (match-beginning 0) (match-end 0)))) ;; Serves as an interface to `mail', ;; but when the user says "no" to discarding an unset message, ;; it gives an error. (defun reporter-mail (&rest args) (interactive "P") (or (apply 'mail args) (error "Bug report aborted"))) ;;;###autoload (defun reporter-submit-bug-report (address pkgname varlist &optional pre-hooks post-hooks salutation) ;; Submit a bug report via mail. ;; ADDRESS is the email address for the package's maintainer. PKGNAME is ;; the name of the mode (you must explicitly concat any version numbers). ;; VARLIST is the list of variables to dump (see `reporter-dump-state' ;; for details). Optional PRE-HOOKS and POST-HOOKS are passed to ;; `reporter-dump-state'. Optional SALUTATION is inserted at the top of the ;; mail buffer, and point is left after the salutation. ;; This function will prompt for a summary if ;; reporter-prompt-for-summary-p is non-nil. ;; The mailer used is described in the variable `reporter-mailer'. (let ((reporter-eval-buffer (current-buffer)) final-resting-place after-sep-pos (reporter-status-message "Formatting bug report buffer...") (reporter-status-count 0) (problem (and reporter-prompt-for-summary-p (read-string "(Very) brief summary of problem: "))) (mailbuf (progn (call-interactively (if (nlistp reporter-mailer) reporter-mailer (let ((mlist reporter-mailer) (mailer nil)) (while mlist (if (commandp (car mlist)) (setq mailer (car mlist) mlist nil) (setq mlist (cdr mlist)))) (if (not mailer) (error "Variable `%s' does not contain a command for mailing" "reporter-mailer")) mailer))) (current-buffer)))) (require 'sendmail) (pop-to-buffer reporter-eval-buffer) (pop-to-buffer mailbuf) (goto-char (point-min)) ;; different mailers use different separators, some may not even ;; use m-h-s, but sendmail.el stuff must have m-h-s bound. (let ((mail-header-separator (reporter-calculate-separator))) (mail-position-on-field "to") (insert address) ;; insert problem summary if available (if (and reporter-prompt-for-summary-p problem pkgname) (progn (mail-position-on-field "subject") (insert pkgname "; " problem))) ;; move point to the body of the message (mail-text) (forward-line 1) (setq after-sep-pos (point)) (and salutation (insert "\n" salutation "\n\n")) (unwind-protect (progn (setq final-resting-place (point-marker)) (insert "\n\n") (reporter-dump-state pkgname varlist pre-hooks post-hooks) (goto-char final-resting-place)) (set-marker final-resting-place nil))) ;; save initial text and set up the `no-empty-submission' hook. ;; This only works for mailers that support mail-send-hook, ;; e.g. sendmail.el (if (fboundp 'add-hook) (progn (save-excursion (goto-char (point-max)) (skip-chars-backward " \t\n") (setq reporter-initial-text (buffer-substring after-sep-pos (point)))) (make-variable-buffer-local 'mail-send-hook) (add-hook 'mail-send-hook 'reporter-bug-hook))) ;; minibuf message ;; C-c C-c can't be generalized because they don't always run ;; mail-send-and-exit. E.g. vm-mail-send-and-exit. I don't want ;; to hard code these. (let* ((sendkey "C-c C-c") (killkey-whereis (where-is-internal 'kill-buffer nil t)) (killkey (if killkey-whereis (key-description killkey-whereis) "M-x kill-buffer"))) (message "Please type in your report. Hit %s to send, %s to abort." sendkey killkey)) )) (defun reporter-bug-hook () ;; prohibit sending mail if empty bug report (let ((after-sep-pos (save-excursion (beginning-of-buffer) (re-search-forward (reporter-calculate-separator) (point-max) 'move) (forward-line 1) (point)))) (save-excursion (goto-char (point-max)) (skip-chars-backward " \t\n") (if (and (= (- (point) after-sep-pos) (length reporter-initial-text)) (string= (buffer-substring after-sep-pos (point)) reporter-initial-text)) (error "Empty bug report cannot be sent")) ))) (provide 'reporter) ;;; reporter.el ends here emacs-19.30/lisp/reposition.el100444 75424 13 16357 5561560131 14562 0ustar kwzhuser;;; reposition.el --- center a Lisp function or comment on the screen ;; Copyright (C) 1991, 1994 Free Software Foundation, Inc. ;; Author: Michael D. Ernst ;; Created: Jan 1991 ;; Maintainer: FSF ;; 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: ;;; Reposition-window makes an entire function definition or comment visible, ;;; or, if it is already visible, places it at the top of the window; ;;; additional invocations toggle the visibility of comments preceding the ;;; code. For the gory details, see the documentation for reposition-window; ;;; rather than reading that, you may just want to play with it. ;;; This tries pretty hard to do the recentering correctly; the precise ;;; action depends on what the buffer looks like. If you find a situation ;;; where it doesn't behave well, let me know. This function is modeled ;;; after one of the same name in ZMACS, but the code is all-new and the ;;; behavior in some situations differs. ;;; Code: ;;;###autoload (defun reposition-window (&optional arg) "Make the current definition and/or comment visible. Further invocations move it to the top of the window or toggle the visibility of comments that precede it. Point is left unchanged unless prefix ARG is supplied. If the definition is fully onscreen, it is moved to the top of the window. If it is partly offscreen, the window is scrolled to get the definition (or as much as will fit) onscreen, unless point is in a comment which is also partly offscreen, in which case the scrolling attempts to get as much of the comment onscreen as possible. Initially `reposition-window' attempts to make both the definition and preceding comments visible. Further invocations toggle the visibility of the comment lines. If ARG is non-nil, point may move in order to make the whole defun visible (if only part could otherwise be made so), to make the defun line visible (if point is in code and it could not be made so, or if only comments, including the first comment line, are visible), or to make the first comment line visible (if point is in a comment)." (interactive "P") (let* (;; (here (save-excursion (beginning-of-line) (point))) (here (point)) ;; change this name once I've gotten rid of references to ht. ;; this is actually the number of the last screen line (ht (- (window-height (selected-window)) 2)) (line (repos-count-screen-lines (window-start) (point))) (comment-height ;; The call to max deals with the case of cursor between defuns. (max 0 (repos-count-screen-lines-signed ;; the beginning of the preceding comment (save-excursion (if (not (eobp)) (forward-char 1)) (end-of-defun -1) ;; Skip whitespace, newlines, and form feeds. (if (re-search-forward "[^ \t\n\f]" nil t) (backward-char 1)) (point)) here))) (defun-height (repos-count-screen-lines-signed (save-excursion (end-of-defun 1) ; so comments associate with following defuns (beginning-of-defun 1) (point)) here)) ;; This must be positive, so don't use the signed version. (defun-depth (repos-count-screen-lines here (save-excursion (end-of-defun 1) (point)))) (defun-line-onscreen-p (and (<= defun-height line) (<= (- line defun-height) ht)))) (cond ((or (= comment-height line) (and (= line ht) (> comment-height line) ;; if defun line offscreen, we should be in case 4 defun-line-onscreen-p)) ;; Either first comment line is at top of screen or (point at ;; bottom of screen, defun line onscreen, and first comment line ;; off top of screen). That is, it looks like we just did ;; recenter-definition, trying to fit as much of the comment ;; onscreen as possible. Put defun line at top of screen; that ;; is, show as much code, and as few comments, as possible. (if (and arg (> defun-depth (1+ ht))) ;; Can't fit whole defun onscreen without moving point. (progn (end-of-defun) (beginning-of-defun) (recenter 0)) (recenter (max defun-height 0))) ;;(repos-debug-macro "1") ) ((or (= defun-height line) (= line 0) (and (< line comment-height) (< defun-height 0))) ;; Defun line or cursor at top of screen, OR cursor in comment ;; whose first line is offscreen. ;; Avoid moving definition up even if defun runs offscreen; ;; we care more about getting the comment onscreen. (cond ((= line ht) ;; cursor on last screen line (and so in a comment) (if arg (progn (end-of-defun) (beginning-of-defun))) (recenter 0) ;;(repos-debug-macro "2a") ) ;; This condition, copied from case 4, may not be quite right ((and arg (< ht comment-height)) ;; Can't get first comment line onscreen. ;; Go there and try again. (forward-line (- comment-height)) (beginning-of-line) ;; was (reposition-window) (recenter 0) ;;(repos-debug-macro "2b") ) (t (recenter (min ht comment-height)) ;;(repos-debug-macro "2c") )) ;; (recenter (min ht comment-height)) ) ((and (> (+ line defun-depth -1) ht) defun-line-onscreen-p) ;; Defun runs off the bottom of the screen and the defun line ;; is onscreen. ;; Move the defun up. (recenter (max 0 (1+ (- ht defun-depth)) defun-height)) ;;(repos-debug-macro "3") ) (t ;; If on the bottom line and comment start is offscreen ;; then just move all comments offscreen, or at least as ;; far as they'll go. ;; Try to get as much of the comments onscreen as possible. (if (and arg (< ht comment-height)) ;; Can't get defun line onscreen; go there and try again. (progn (forward-line (- defun-height)) (beginning-of-line) (reposition-window)) (recenter (min ht comment-height))) ;;(repos-debug-macro "4") )))) ;;;###autoload (define-key esc-map "\C-l" 'reposition-window) ;;; Auxiliary functions ;; Return number of screen lines between START and END. (defun repos-count-screen-lines (start end) (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) (vertical-motion (- (point-max) (point-min)))))) ;; Return number of screen lines between START and END; returns a negative ;; number if END precedes START. (defun repos-count-screen-lines-signed (start end) (let ((lines (repos-count-screen-lines start end))) (if (< start end) lines (- lines)))) ; (defmacro repos-debug-macro (case-no) ; (` (message ; (concat "Case " (, case-no) ": %s %s %s %s %s") ; ht line comment-height defun-height defun-depth))) ;;; reposition.el ends here emacs-19.30/lisp/resume.el100444 75424 1 14541 5770115516 14127 0ustar kwzhdaemon;;; resume.el --- process command line args from within a suspended Emacs job ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Joe Wells ;; Adapted-By: ESR ;; Keywords: processes ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Theory: the first time you start Emacs, command line arguments are ;; handled normally. Then, you suspend your emacs job. When you want to edit ;; something else, you type "emacs filename" as usual, but instead of ;; starting a new emacs job, the old job is resumed instead, and the command ;; line arguments are placed in a file where the old emacs job looks for ;; them. ;; Stephan Gildea suggested bug fix (gildea@bbn.com). ;; Ideas from Michael DeCorte and other people. ;; For csh users, insert the following alias in your .cshrc file ;; (after removing the leading double semicolons, of course): ;; ;;# The following line could be just EMACS_CMD=emacs, but this depends on ;;# your site. ;;if (! $?EMACS_CMD) set EMACS_CMD=emacs ;;set JOBS_FILE=/tmp/jobs.$USER.$$ ;;set ARGS_FILE=~/.emacs_args ;;set STOP_PATT='^\[[0-9]*\] *[ +-] Stopped ............ ' ;;set SUNVIEW_CMD='emacstool -nw -f emacstool-init -f server-start' ;;set X_CMD=\'\''$EMACS_CMD -i -f server-start' ;;alias emacs \ ;;' \\ ;; jobs >! "$JOBS_FILE" \\ ;; && grep "$STOP_PATT$EMACS_CMD" "$JOBS_FILE" >& /dev/null \\ ;; && echo `pwd` \!* >! "$ARGS_FILE" && ""fg %$EMACS_CMD \\ ;;|| if (! -e ~/.emacs_server || -f ~/.emacs_server) set status=1 \\ ;; && emacsclient \!* \\ ;;|| @ status=1 - $?DISPLAY && eval "$X_CMD -i \!* &" \\ ;;|| @ status=1 - $?WINDOW_PARENT && eval "$SUNVIEW_CMD \!* &" \\ ;;|| ""$EMACS_CMD -nw \!* \\ ;;' ;; ;; The alias works as follows: ;; 1. If there is a suspended Emacs job that is a child of the ;; current shell, place its arguments in the ~/.emacs_args file and ;; resume it. ;; 2. Else if the ~/.emacs_server socket has been created, presume an ;; Emacs server is running and attempt to connect to it. If no Emacs ;; server is listening on the socket, this will fail. ;; 3. Else if the DISPLAY environment variable is set, presume we are ;; running under X Windows and start a new GNU Emacs process in the ;; background as an X client. ;; 4. Else if the WINDOW_PARENT environment variable is set, presume we ;; are running under SunView and start an emacstool process in the ;; background. ;; 5. Else start a regular Emacs process. ;; ;; Notes: ;; The output of the "jobs" command is not piped directly into "grep" ;; because that would run the "jobs" command in a subshell. ;; Before resuming a suspended emacs, the current directory and all ;; command line arguments are placed in a file name ~/.emacs_args. ;; The "-nw" switch to Emacs means no windowing system. ;; Insert this in your .emacs file: ;;(add-hook 'suspend-hook 'resume-suspend-hook) ;; Finally, put the rest in a file named "resume.el" in a lisp library ;; directory. ;;; Code: (defvar resume-emacs-args-file (expand-file-name "~/.emacs_args") "*This file is where arguments are placed for a suspended emacs job.") (defvar resume-emacs-args-buffer " *Command Line Args*" "Buffer that is used by resume-process-args.") (defun resume-process-args () "Handler for command line args given when Emacs is resumed." (let ((start-buffer (current-buffer)) (args-buffer (get-buffer-create resume-emacs-args-buffer)) length args (command-line-default-directory default-directory)) (unwind-protect (progn (set-buffer args-buffer) (erase-buffer) ;; get the contents of resume-emacs-args-file (condition-case () (let ((result (insert-file-contents resume-emacs-args-file))) (setq length (car (cdr result)))) ;; the file doesn't exist, ergo no arguments (file-error (erase-buffer) (setq length 0))) (if (<= length 0) (setq args nil) ;; get the arguments from the buffer (goto-char (point-min)) (while (not (eobp)) (skip-chars-forward " \t\n") (let ((begin (point))) (skip-chars-forward "^ \t\n") (setq args (cons (buffer-substring begin (point)) args))) (skip-chars-forward " \t\n")) ;; arguments are now in reverse order (setq args (nreverse args)) ;; make sure they're not read again (erase-buffer)) (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file) ;; if nothing was in buffer, args will be null (or (null args) (setq command-line-default-directory (file-name-as-directory (car args)) args (cdr args))) ;; actually process the arguments (command-line-1 args)) ;; If the command line args don't result in a find-file, the ;; buffer will be left in args-buffer. So we change back to the ;; original buffer. The reason I don't just use ;; (let ((default-directory foo)) ;; (command-line-1 args)) ;; in the context of the original buffer is because let does not ;; work properly with buffer-local variables. (if (eq (current-buffer) args-buffer) (set-buffer start-buffer))))) ;;;###autoload (defun resume-suspend-hook () "Clear out the file used for transmitting args when Emacs resumes." (save-excursion (set-buffer (get-buffer-create resume-emacs-args-buffer)) (erase-buffer) (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file))) (defun resume-write-buffer-to-file (buffer file) "Writes the contents of BUFFER into FILE, if permissions allow." (if (not (file-writable-p file)) (error "No permission to write file %s" file)) (save-excursion (set-buffer buffer) (clear-visited-file-modtime) (save-restriction (widen) (write-region (point-min) (point-max) file nil 'quiet)) (set-buffer-modified-p nil))) (provide 'resume) ;;; resume.el ends here emacs-19.30/lisp/rfc822.el100444 13437 1 24152 5354240644 13565 0ustar jimbdaemon;;; rfc822.el --- hairy rfc822 parser for mail and news and suchlike ;; Copyright (C) 1986, 87, 1990 Free Software Foundation, Inc. ;; Author: Richard Mlynarik ;; Maintainer: FSF ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Support functions for parsing RFC-822 headers, used by mail and news ;; modes. ;;; Code: ;; uses address-start free, throws to address (defun rfc822-bad-address (reason) (save-restriction (insert "_^_") (narrow-to-region address-start (if (re-search-forward "[,;]" nil t) (max (point-min) (1- (point))) (point-max))) ;; make the error string be suitable for inclusion in (...) (let ((losers '("\\" "(" ")" "\n"))) (while losers (goto-char (point-min)) (while (search-forward (car losers) nil t) (backward-char 1) (insert ?\\) (forward-char 1)) (setq losers (cdr losers)))) (goto-char (point-min)) (insert "(Unparsable address -- " reason ":\n\t \"") (goto-char (point-max)) (insert "\")")) (rfc822-nuke-whitespace) (throw 'address (buffer-substring address-start (point)))) (defun rfc822-nuke-whitespace (&optional leave-space) (let (ch) (while (cond ((eobp) nil) ((= (setq ch (following-char)) ?\() (forward-char 1) (while (if (eobp) (rfc822-bad-address "Unbalanced comment (...)") (/= (setq ch (following-char)) ?\))) (cond ((looking-at "[^()\\]+") (replace-match "")) ((= ch ?\() (rfc822-nuke-whitespace)) ((< (point) (1- (point-max))) (delete-char 2)) (t (rfc822-bad-address "orphaned backslash")))) ;; delete remaining "()" (forward-char -1) (delete-char 2) t) ((memq ch '(?\ ?\t ?\n)) (delete-region (point) (progn (skip-chars-forward " \t\n") (point))) t) (t nil))) (or (not leave-space) (eobp) (bobp) (= (preceding-char) ?\ ) (insert ?\ )))) (defun rfc822-looking-at (regex &optional leave-space) (if (cond ((stringp regex) (if (looking-at regex) (progn (goto-char (match-end 0)) t))) (t (if (and (not (eobp)) (= (following-char) regex)) (progn (forward-char 1) t)))) (let ((tem (match-data))) (rfc822-nuke-whitespace leave-space) (store-match-data tem) t))) (defun rfc822-snarf-word () ;; word is atom | quoted-string (cond ((= (following-char) ?\") ;; quoted-string (or (rfc822-looking-at "\"\\([^\"\\\n]\\|\\\\.\\|\\\\\n\\)*\"") (rfc822-bad-address "Unterminated quoted string"))) ((rfc822-looking-at "[^][\000-\037\177-\377 ()<>@,;:\\\".]+") ;; atom ) (t (rfc822-bad-address "Rubbish in address")))) (defun rfc822-snarf-words () (rfc822-snarf-word) (while (rfc822-looking-at ?.) (rfc822-snarf-word))) (defun rfc822-snarf-subdomain () ;; sub-domain is domain-ref | domain-literal (cond ((= (following-char) ?\[) ;; domain-ref (or (rfc822-looking-at "\\[\\([^][\\\n]\\|\\\\.\\|\\\\\n\\)*\\]") (rfc822-bad-address "Unterminated domain literal [...]"))) ((rfc822-looking-at "[^][\000-\037\177-\377 ()<>@,;:\\\".]+") ;; domain-literal = atom ) (t (rfc822-bad-address "Rubbish in host/domain specification")))) (defun rfc822-snarf-domain () (rfc822-snarf-subdomain) (while (rfc822-looking-at ?.) (rfc822-snarf-subdomain))) (defun rfc822-snarf-frob-list (name separator terminator snarfer &optional return) (let ((first t) (list ()) tem) (while (cond ((eobp) (rfc822-bad-address (format "End of addresses in middle of %s" name))) ((rfc822-looking-at terminator) nil) ((rfc822-looking-at separator) ;; multiple separators are allowed and do nothing. (while (rfc822-looking-at separator)) t) (first t) (t (rfc822-bad-address (format "Gubbish in middle of %s" name)))) (setq tem (funcall snarfer) first nil) (and return tem (setq list (if (listp tem) (nconc (reverse tem) list) (cons tem list))))) (nreverse list))) ;; return either an address (a string) or a list of addresses (defun rfc822-addresses-1 (&optional allow-groups) ;; Looking for an rfc822 `address' ;; Either a group (1*word ":" [#mailbox] ";") ;; or a mailbox (addr-spec | 1*word route-addr) ;; addr-spec is (local-part "@" domain) ;; route-addr is ("<" [1#("@" domain) ":"] addr-spec ">") ;; local-part is (word *("." word)) ;; word is (atom | quoted-string) ;; quoted-string is ("\([^\"\\n]\|\\.\|\\\n\)") ;; atom is [^\000-\037\177 ()<>@,;:\".[]]+ ;; domain is sub-domain *("." sub-domain) ;; sub-domain is domain-ref | domain-literal ;; domain-literal is "[" *(dtext | quoted-pair) "]" ;; dtext is "[^][\\n" ;; domain-ref is atom (let ((address-start (point)) (n 0)) (catch 'address ;; optimize common cases: ;; foo ;; foo.bar@bar.zap ;; followed by "\\'\\|,\\|([^()\\]*)\\'" ;; other common cases are: ;; foo bar ;; "foo bar" ;; those aren't hacked yet. (if (and (rfc822-looking-at "[^][\000-\037\177-\377 ()<>@,;:\\\"]+\\(\\|@[^][\000-\037\177-\377 ()<>@,;:\\\"]+\\)" t) (progn (or (eobp) (rfc822-looking-at ?,)))) (progn ;; rfc822-looking-at may have inserted a space (or (bobp) (/= (preceding-char) ?\ ) (delete-char -1)) ;; relying on the fact that rfc822-looking-at ;; doesn't mung match-data (throw 'address (buffer-substring address-start (match-end 0))))) (goto-char address-start) (while t (cond ((and (= n 1) (rfc822-looking-at ?@)) ;; local-part@domain (rfc822-snarf-domain) (throw 'address (buffer-substring address-start (point)))) ((rfc822-looking-at ?:) (cond ((not allow-groups) (rfc822-bad-address "A group name may not appear here")) ((= n 0) (rfc822-bad-address "No name for :...; group"))) ;; group (throw 'address ;; return a list of addresses (rfc822-snarf-frob-list ":...; group" ?\, ?\; 'rfc822-addresses-1 t))) ((rfc822-looking-at ?<) (let ((start (point)) (strip t)) (cond ((rfc822-looking-at ?>) ;; empty path ()) ((and (not (eobp)) (= (following-char) ?\@)) ;; <@foo.bar,@baz:quux@abcd.efg> (rfc822-snarf-frob-list "<...> address" ?\, ?\: (function (lambda () (if (rfc822-looking-at ?\@) (rfc822-snarf-domain) (rfc822-bad-address "Gubbish in route-addr"))))) (rfc822-snarf-words) (or (rfc822-looking-at ?@) (rfc822-bad-address "Malformed <..@..> address")) (rfc822-snarf-domain) (setq strip nil)) ((progn (rfc822-snarf-words) (rfc822-looking-at ?@)) ; allow (losing unix seems to do this) (rfc822-snarf-domain))) (let ((end (point))) (if (rfc822-looking-at ?\>) (throw 'address (buffer-substring (if strip start (1- start)) (if strip end (1+ end)))) (rfc822-bad-address "Unterminated <...> address"))))) ((looking-at "[^][\000-\037\177-\377 ()<>@,;:\\.]") ;; this allows "." to be part of the words preceding ;; an addr-spec, since many broken mailers output ;; "Hern K. Herklemeyer III ;; " (let ((again t)) (while again (or (= n 0) (bobp) (= (preceding-char) ?\ ) (insert ?\ )) (rfc822-snarf-words) (setq n (1+ n)) (setq again (or (rfc822-looking-at ?.) (looking-at "[^][\000-\037\177-\377 ()<>@,;:\\.]")))))) ((= n 0) (throw 'address nil)) ((= n 1) ; allow "foo" (losing unix seems to do this) (throw 'address (buffer-substring address-start (point)))) ((> n 1) (rfc822-bad-address "Missing comma between addresses or badly-formatted address")) ((or (eobp) (= (following-char) ?,)) (rfc822-bad-address "Missing comma or route-spec")) (t (rfc822-bad-address "Strange character or missing comma"))))))) (defun rfc822-addresses (header-text) (if (string-match "\\`[ \t]*\\([^][\000-\037\177-\377 ()<>@,;:\\\".]+\\)[ \t]*\\'" header-text) ;; Make very simple case moderately fast. (list (substring header-text (match-beginning 1) (match-end 1))) (let ((buf (generate-new-buffer " rfc822"))) (unwind-protect (save-excursion (set-buffer buf) (make-local-variable 'case-fold-search) (setq case-fold-search nil) ;For speed(?) (insert header-text) ;; unfold continuation lines (goto-char (point-min)) (while (re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ \t]" nil t) (replace-match "\\1 " t)) (goto-char (point-min)) (rfc822-nuke-whitespace) (let ((list ()) tem address-start); this is for rfc822-bad-address (while (not (eobp)) (setq address-start (point)) (setq tem (catch 'address ; this is for rfc822-bad-address (cond ((rfc822-looking-at ?\,) nil) ((looking-at "[][\000-\037\177-\377@;:\\.>)]") (forward-char) (rfc822-bad-address (format "Strange character \\%c found" (preceding-char)))) (t (rfc822-addresses-1 t))))) (cond ((null tem)) ((stringp tem) (setq list (cons tem list))) (t (setq list (nconc (nreverse tem) list))))) (nreverse list))) (and buf (kill-buffer buf)))))) (provide 'rfc822) ;;; rfc822.el ends here emacs-19.30/lisp/ring.el100444 12120 1 10302 5602412647 13352 0ustar rmsdaemon;;; ring.el --- handle rings of items ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: extensions ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 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 code defines a ring data structure. A ring is a ;;; (hd-index length . vector) ;;; list. You can insert to, remove from, and rotate a ring. When the ring ;;; fills up, insertions cause the oldest elts to be quietly dropped. ;;; ;;; In ring-ref, 0 is the index of the newest element. Higher indexes ;;; correspond to older elements until they wrap. ;;; ;;; hd-index = index of the newest item on the ring. ;;; length = number of ring items. ;;; ;;; These functions are used by the input history mechanism, but they can ;;; be used for other purposes as well. ;;; Code: ;;;###autoload (defun ring-p (x) "Returns t if X is a ring; nil otherwise." (and (consp x) (integerp (car x)) (consp (cdr x)) (integerp (car (cdr x))) (vectorp (cdr (cdr x))))) ;;;###autoload (defun make-ring (size) "Make a ring that can contain SIZE elements." (cons 0 (cons 0 (make-vector size nil)))) (defun ring-insert-at-beginning (ring item) "Add to RING the item ITEM. Add it at the front (the early end)." (let* ((vec (cdr (cdr ring))) (veclen (length vec)) (hd (car ring)) (ln (car (cdr ring)))) (setq ln (min veclen (1+ ln)) hd (ring-minus1 hd veclen)) (aset vec hd item) (setcar ring hd) (setcar (cdr ring) ln))) (defun ring-plus1 (index veclen) "INDEX+1, with wraparound" (let ((new-index (+ index 1))) (if (= new-index veclen) 0 new-index))) (defun ring-minus1 (index veclen) "INDEX-1, with wraparound" (- (if (= 0 index) veclen index) 1)) (defun ring-length (ring) "Number of elements in the ring." (car (cdr ring))) (defun ring-empty-p (ring) (= 0 (car (cdr ring)))) (defun ring-index (index head ringlen veclen) (setq index (mod index ringlen)) (mod (1- (+ head (- ringlen index))) veclen)) (defun ring-insert (ring item) "Insert onto ring RING the item ITEM, as the newest (last) item. If the ring is full, dump the oldest item to make room." (let* ((vec (cdr (cdr ring))) (veclen (length vec)) (hd (car ring)) (ln (car (cdr ring)))) (prog1 (aset vec (mod (+ hd ln) veclen) item) (if (= ln veclen) (setcar ring (ring-plus1 hd veclen)) (setcar (cdr ring) (1+ ln)))))) (defun ring-remove (ring &optional index) "Remove an item from the RING. Return the removed item. If optional INDEX is nil, remove the oldest item. If it's numeric, remove the element indexed." (if (ring-empty-p ring) (error "Ring empty") (let* ((hd (car ring)) (ln (car (cdr ring))) (vec (cdr (cdr ring))) (veclen (length vec)) (tl (mod (1- (+ hd ln)) veclen)) oldelt) (if (null index) (setq index (1- ln))) (setq index (ring-index index hd ln veclen)) (setq oldelt (aref vec index)) (while (/= index tl) (aset vec index (aref vec (ring-plus1 index veclen))) (setq index (ring-plus1 index veclen))) (aset vec tl nil) (setcar (cdr ring) (1- ln)) oldelt))) (defun ring-ref (ring index) "Returns RING's INDEX element. INDEX need not be <= the ring length, the appropriate modulo operation will be performed. Element 0 is the most recently inserted; higher indices correspond to older elements until they wrap." (if (ring-empty-p ring) (error "indexed empty ring") (let* ((hd (car ring)) (ln (car (cdr ring))) (vec (cdr (cdr ring)))) (aref vec (ring-index index hd ln (length vec)))))) (provide 'ring) ;;; ring.el ends here emacs-19.30/lisp/rlogin.el100444 21641 1 27325 6044257212 14712 0ustar friedmandaemon;;; rlogin.el --- remote login interface ;; Author: Noah Friedman ;; Maintainer: Noah Friedman ;; Keywords: unix, comm ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to: The Free Software Foundation, ;; Inc.; 675 Massachusetts Avenue.; Cambridge, MA 02139, USA. ;; $Id: rlogin.el,v 1.30 1995/10/27 22:34:50 friedman Exp $ ;;; Commentary: ;; Support for remote logins using `rlogin'. ;; This program is layered on top of shell.el; the code here only accounts ;; for the variations needed to handle a remote process, e.g. directory ;; tracking and the sending of some special characters. ;; If you wish for rlogin mode to prompt you in the minibuffer for ;; passwords when a password prompt appears, just enter m-x send-invisible ;; and type in your line, or add `comint-watch-for-password-prompt' to ;; `comint-output-filter-functions'. ;;; Code: (require 'comint) (require 'shell) (defvar rlogin-program "rlogin" "*Name of program to invoke rlogin") (defvar rlogin-explicit-args nil "*List of arguments to pass to rlogin on the command line.") (defvar rlogin-mode-hook nil "*Hooks to run after setting current buffer to rlogin-mode.") (defvar rlogin-process-connection-type nil "*If non-`nil', use a pty for the local rlogin process. If `nil', use a pipe (if pipes are supported on the local system). Generally it is better not to waste ptys on systems which have a static number of them. On the other hand, some implementations of `rlogin' assume a pty is being used, and errors will result from using a pipe instead.") (defvar rlogin-directory-tracking-mode 'local "*Control whether and how to do directory tracking in an rlogin buffer. nil means don't do directory tracking. t means do so using an ftp remote file name. Any other value means do directory tracking using local file names. This works only if the remote machine and the local one share the same directories (through NFS). This is the default. This variable becomes local to a buffer when set in any fashion for it. It is better to use the function of the same name to change the behavior of directory tracking in an rlogin session once it has begun, rather than simply setting this variable, since the function does the necessary re-synching of directories.") (make-variable-buffer-local 'rlogin-directory-tracking-mode) (defvar rlogin-host nil "*The name of the remote host. This variable is buffer-local.") (defvar rlogin-remote-user nil "*The username used on the remote host. This variable is buffer-local and defaults to your local user name. If rlogin is invoked with the `-l' option to specify the remote username, this variable is set from that.") ;; Initialize rlogin mode map. (defvar rlogin-mode-map '()) (cond ((null rlogin-mode-map) (setq rlogin-mode-map (if (consp shell-mode-map) (cons 'keymap shell-mode-map) (copy-keymap shell-mode-map))) (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C) (define-key rlogin-mode-map "\C-c\C-d" 'rlogin-send-Ctrl-D) (define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z) (define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash) (define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D) (define-key rlogin-mode-map "\C-i" 'rlogin-tab-or-complete))) ;;;###autoload (add-hook 'same-window-regexps "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)") (defvar rlogin-history nil) ;;;###autoload (defun rlogin (input-args &optional buffer) "Open a network login connection to HOST via the `rlogin' program. Input is sent line-at-a-time to the remote connection. Communication with the remote host is recorded in a buffer `*rlogin-HOST*' \(or `*rlogin-USER@HOST*' if the remote username differs\). If a prefix argument is given and the buffer `*rlogin-HOST*' already exists, a new buffer with a different connection will be made. When called from a program, if the optional second argument is a string or buffer, it names the buffer to use. The variable `rlogin-program' contains the name of the actual program to run. It can be a relative or absolute path. The variable `rlogin-explicit-args' is a list of arguments to give to the rlogin when starting. They are added after any arguments given in INPUT-ARGS. If the default value of `rlogin-directory-tracking-mode' is t, then the default directory in that buffer is set to a remote (FTP) file name to access your home directory on the remote machine. Occasionally this causes an error, if you cannot access the home directory on that machine. This error is harmless as long as you don't try to use that default directory. If `rlogin-directory-tracking-mode' is neither t nor nil, then the default directory is initially set up to your (local) home directory. This is useful if the remote machine and your local machine share the same files via NFS. This is the default. If you wish to change directory tracking styles during a session, use the function `rlogin-directory-tracking-mode' rather than simply setting the variable." (interactive (list (read-from-minibuffer "rlogin arguments (hostname first): " nil nil nil 'rlogin-history) current-prefix-arg)) (let* ((process-connection-type rlogin-process-connection-type) (args (if rlogin-explicit-args (append (rlogin-parse-words input-args) rlogin-explicit-args) (rlogin-parse-words input-args))) (host (car args)) (user (or (car (cdr (member "-l" args))) (user-login-name))) (buffer-name (if (string= user (user-login-name)) (format "*rlogin-%s*" host) (format "*rlogin-%s@%s*" user host))) proc) (cond ((null buffer)) ((stringp buffer) (setq buffer-name buffer)) ((bufferp buffer) (setq buffer-name (buffer-name buffer))) ((numberp buffer) (setq buffer-name (format "%s<%d>" buffer-name buffer))) (t (setq buffer-name (generate-new-buffer-name buffer-name)))) (setq buffer (get-buffer-create buffer-name)) (pop-to-buffer buffer-name) (cond ((comint-check-proc buffer-name)) (t (comint-exec buffer buffer-name rlogin-program nil args) (setq proc (get-buffer-process buffer)) ;; Set process-mark to point-max in case there is text in the ;; buffer from a previous exited process. (set-marker (process-mark proc) (point-max)) (rlogin-mode) ;; comint-output-filter-functions is just like a hook, except that the ;; functions in that list are passed arguments. add-hook serves well ;; enough for modifying it. (add-hook 'comint-output-filter-functions 'rlogin-carriage-filter) (make-local-variable 'rlogin-host) (setq rlogin-host host) (make-local-variable 'rlogin-remote-user) (setq rlogin-remote-user user) (cond ((eq rlogin-directory-tracking-mode t) ;; Do this here, rather than calling the tracking mode function, to ;; avoid a gratuitous resync check; the default should be the ;; user's home directory, be it local or remote. (setq comint-file-name-prefix (concat "/" rlogin-remote-user "@" rlogin-host ":")) (cd-absolute comint-file-name-prefix)) ((null rlogin-directory-tracking-mode)) (t (cd-absolute (concat comint-file-name-prefix "~/")))))))) (defun rlogin-mode () "Set major-mode for rlogin sessions. If `rlogin-mode-hook' is set, run it." (interactive) (kill-all-local-variables) (shell-mode) (setq major-mode 'rlogin-mode) (setq mode-name "rlogin") (use-local-map rlogin-mode-map) (setq shell-dirtrackp rlogin-directory-tracking-mode) (make-local-variable 'comint-file-name-prefix) (run-hooks 'rlogin-mode-hook)) (defun rlogin-directory-tracking-mode (&optional prefix) "Do remote or local directory tracking, or disable entirely. If called with no prefix argument or a unspecified prefix argument (just ``\\[universal-argument]'' with no number) do remote directory tracking via ange-ftp. If called as a function, give it no argument. If called with a negative prefix argument, disable directory tracking entirely. If called with a positive, numeric prefix argument, e.g. ``\\[universal-argument] 1 M-x rlogin-directory-tracking-mode\'', then do directory tracking but assume the remote filesystem is the same as the local system. This only works in general if the remote machine and the local one share the same directories (through NFS)." (interactive "P") (cond ((or (null prefix) (consp prefix)) (setq rlogin-directory-tracking-mode t) (setq shell-dirtrackp t) (setq comint-file-name-prefix (concat "/" rlogin-remote-user "@" rlogin-host ":"))) ((< prefix 0) (setq rlogin-directory-tracking-mode nil) (setq shell-dirtrackp nil)) (t (setq rlogin-directory-tracking-mode 'local) (setq comint-file-name-prefix "") (setq shell-dirtrackp t))) (cond (shell-dirtrackp (let* ((proc (get-buffer-process (current-buffer))) (proc-mark (process-mark proc)) (current-input (buffer-substring proc-mark (point-max))) (orig-point (point)) (offset (and (>= orig-point proc-mark) (- (point-max) orig-point)))) (unwind-protect (progn (delete-region proc-mark (point-max)) (goto-char (point-max)) (shell-resync-dirs)) (goto-char proc-mark) (insert current-input) (if offset (goto-char (- (point-max) offset)) (goto-char orig-point))))))) ;; Parse a line into its constituent parts (words separated by ;; whitespace). Return a list of the words. (defun rlogin-parse-words (line) (let ((list nil) (posn 0) (match-data (match-data))) (while (string-match "[^ \t\n]+" line posn) (setq list (cons (substring line (match-beginning 0) (match-end 0)) list)) (setq posn (match-end 0))) (store-match-data (match-data)) (nreverse list))) (defun rlogin-carriage-filter (string) (let* ((point-marker (point-marker)) (end (process-mark (get-buffer-process (current-buffer)))) (beg (or (and (boundp 'comint-last-output-start) comint-last-output-start) (- end (length string))))) (goto-char beg) (while (search-forward "\C-m" end t) (delete-char -1)) (goto-char point-marker))) (defun rlogin-send-Ctrl-C () (interactive) (send-string nil "\C-c")) (defun rlogin-send-Ctrl-D () (interactive) (send-string nil "\C-d")) (defun rlogin-send-Ctrl-Z () (interactive) (send-string nil "\C-z")) (defun rlogin-send-Ctrl-backslash () (interactive) (send-string nil "\C-\\")) (defun rlogin-delchar-or-send-Ctrl-D (arg) "\ Delete ARG characters forward, or send a C-d to process if at end of buffer." (interactive "p") (if (eobp) (rlogin-send-Ctrl-D) (delete-char arg))) (defun rlogin-tab-or-complete () "Complete file name if doing directory tracking, or just insert TAB." (interactive) (if rlogin-directory-tracking-mode (comint-dynamic-complete) (insert "\C-i"))) ;;; rlogin.el ends here emacs-19.30/lisp/rmail.el100444 12120 1 274147 6054206137 13557 0ustar rmsdaemon;;; rmail.el --- main code of "RMAIL" mail reader for Emacs. ;; Copyright (C) 1985,86,87,88,93,94,95 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;; Souped up by shane@mit-ajax based on ideas of rlk@athena.mit.edu ;; New features include attribute and keyword support, message ;; selection by dispatch table, summary by attributes and keywords, ;; expunging by dispatch table, sticky options for file commands. ;; Extended by Bob Weiner of Motorola ;; New features include: rmail and rmail-summary buffers remain ;; synchronized and key bindings basically operate the same way in both ;; buffers, summary by topic or by regular expression, rmail-reply-prefix ;; variable, and a bury rmail buffer (wipe) command. ;; (require 'mail-utils) ;; For Emacs V18 compatibility (and (not (fboundp 'buffer-disable-undo)) (fboundp 'buffer-flush-undo) (defalias 'buffer-disable-undo 'buffer-flush-undo)) ; These variables now declared in paths.el. ;(defvar rmail-spool-directory "/usr/spool/mail/" ; "This is the name of the directory used by the system mailer for\n\ ;delivering new mail. It's name should end with a slash.") ;(defvar rmail-file-name ; (expand-file-name "~/RMAIL") ; "") (defvar rmail-movemail-program nil "If non-nil, name of program for fetching new mail.") ;;;###autoload (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.") ;;;###autoload (defvar rmail-default-dont-reply-to-names "info-" "\ A regular expression specifying part of the value of the default value of the variable `rmail-dont-reply-to-names', for when the user does not set `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.") ;;;###autoload (defvar rmail-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:\\|^\\(resent-\\|\\)message-id:\\|^summary-line:" "*Regexp to match Header fields that Rmail should normally hide.") ;;;###autoload (defvar rmail-displayed-headers nil "*Regexp to match Header fields that Rmail should display. If nil, display all header fields except those matched by `rmail-ignored-headers'.") ;;;###autoload (defvar rmail-retry-ignored-headers nil "\ *Headers that should be stripped when retrying a failed message.") ;;;###autoload (defvar rmail-highlighted-headers "^From:\\|^Subject:" "\ *Regexp to match Header fields that Rmail should normally highlight. A value of nil means don't highlight. See also `rmail-highlight-face'.") ;;;###autoload (defvar rmail-highlight-face nil "\ *Face used by Rmail for highlighting headers.") ;;;###autoload (defvar rmail-delete-after-output nil "\ *Non-nil means automatically delete a message that is copied to a file.") ;;;###autoload (defvar rmail-primary-inbox-list nil "\ *List of files which are inboxes for user's primary mail file `~/RMAIL'. `nil' means the default, which is (\"/usr/spool/mail/$USER\") \(the name varies depending on the operating system, 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.") ;;;###autoload (defvar rmail-secondary-file-directory "~/" "*Directory for additional secondary Rmail files.") ;;;###autoload (defvar rmail-secondary-file-regexp "\\.xmail$" "*Regexp for which files are secondary Rmail files.") ;;;###autoload (defvar rmail-mode-hook nil "List of functions to call when Rmail is invoked.") ;;;###autoload (defvar rmail-get-new-mail-hook nil "List of functions to call when Rmail has retrieved new mail.") ;;;###autoload (defvar rmail-show-message-hook nil "List of functions to call when Rmail displays a message.") ;;;###autoload (defvar rmail-delete-message-hook nil "List of functions to call when Rmail deletes a message. When the hooks are called, the message has been marked deleted but is still the current message in the Rmail buffer.") ;; 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 ;; files). (defvar mmdf-delim1 "^\001\001\001\001\n" "Regexp marking the start of an mmdf message") (defvar mmdf-delim2 "^\001\001\001\001\n" "Regexp marking the end of an mmdf message") (defvar rmail-message-filter nil "If non nil, a filter function for new messages in RMAIL. Called with region narrowed to the message, including headers.") (defvar rmail-reply-prefix "Re: " "String to prepend to Subject line when replying to a message.") ;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:". ;; This pattern should catch all the common variants. (defvar rmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\^[0-9]+\\)?: *\\)*" "Regexp to delete from Subject line before inserting rmail-reply-prefix.") (defvar rmail-display-summary nil "If non nil, the summary buffer is always displayed.") (defvar rmail-mode-map nil) (defvar rmail-inbox-list nil) (defvar rmail-keywords nil) ;; Message counters and markers. Deleted flags. (defvar rmail-current-message nil) (defvar rmail-total-messages nil) (defvar rmail-message-vector nil) (defvar rmail-deleted-vector nil) (defvar rmail-overlay-list nil) (defvar rmail-font-lock-keywords (eval-when-compile (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-"))) (list '("^\\(From\\|Sender\\):" . font-lock-function-name-face) '("^Reply-To:.*$" . font-lock-function-name-face) '("^Subject:" . font-lock-comment-face) '("^\\(To\\|Apparently-To\\|Cc\\):" . font-lock-keyword-face) (cons (concat "^[ \t]*" "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" "[>|}].*") 'font-lock-reference-face) '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\|Date\\):.*$" . font-lock-string-face)))) "Additional expressions to highlight in Rmail mode.") ;; These are used by autoloaded rmail-summary. (defvar rmail-summary-buffer nil) (defvar rmail-summary-vector nil) ;; `Sticky' default variables. ;; Last individual label specified to a or k. (defvar rmail-last-label nil) ;; Last set of values specified to C-M-n, C-M-p, C-M-s or C-M-l. (defvar rmail-last-multi-labels nil) (defvar rmail-last-regexp nil) (defvar rmail-default-file "~/xmail" "*Default file name for \\[rmail-output].") (defvar rmail-default-rmail-file "~/XMAIL" "*Default file name for \\[rmail-output-to-rmail-file].") ;;; Regexp matching the delimiter of messages in UNIX mail format ;;; (UNIX From lines), minus the initial ^. Note that if you change ;;; this expression, you must change the code in rmail-nuke-pinhead-header ;;; that knows the exact ordering of the \\( \\) subexpressions. (defvar rmail-unix-mail-delimiter (let ((time-zone-regexp (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" "\\|[-+]?[0-9][0-9][0-9][0-9]" "\\|" "\\) *"))) (concat "From " ;; Username, perhaps with a quoted section that can contain spaces. "\\(" "[^ \n]*" "\\(\\|\".*\"[^ \n]*\\)" "\\|<[^<>\n]+>" "\\) ?" ;; The time the message was sent. "\\([^ \n]*\\) *" ; day of the week "\\([^ ]*\\) *" ; month "\\([0-9]*\\) *" ; day of month "\\([0-9:]*\\) *" ; time of day ;; Perhaps a time zone, specified by an abbreviation, or by a ;; numeric offset. time-zone-regexp ;; The year. " [0-9][0-9]\\([0-9]*\\) *" ;; On some systems the time zone can appear after the year, too. time-zone-regexp ;; Old uucp cruft. "\\(remote from .*\\)?" "\n")) nil) ;; Perform BODY in the summary buffer ;; in such a way that its cursor is properly updated in its own window. (defmacro rmail-select-summary (&rest body) (` (let ((total rmail-total-messages)) (if (rmail-summary-displayed) (let ((window (selected-window))) (save-excursion (unwind-protect (progn (pop-to-buffer rmail-summary-buffer) ;; rmail-total-messages is a buffer-local var ;; in the rmail buffer. ;; This way we make it available for the body ;; even tho the rmail buffer is not current. (let ((rmail-total-messages total)) (,@ body))) (select-window window)))) (save-excursion (set-buffer rmail-summary-buffer) (let ((rmail-total-messages total)) (,@ body)))) (rmail-maybe-display-summary)))) ;;;; *** Rmail Mode *** ;;;###autoload (defun rmail (&optional file-name-arg) "Read and edit incoming mail. Moves messages into file named by `rmail-file-name' (a babyl format file) and edits that file in RMAIL Mode. Type \\[describe-mode] once editing that file, for a list of RMAIL commands. May be called with file name as argument; then performs rmail editing on that file, but does not copy any new mail into the file. Interactively, if you supply a prefix argument, then you have a chance to specify a file name with the minibuffer. If `rmail-display-summary' is non-nil, make a summary for this RMAIL file." (interactive (if current-prefix-arg (list (read-file-name "Run rmail on RMAIL file: " nil nil t)))) (let* ((file-name (expand-file-name (or file-name-arg rmail-file-name))) (existed (get-file-buffer file-name))) ;; Like find-file, but in the case where a buffer existed ;; and the file was reverted, recompute the message-data. (if (and existed (not (verify-visited-file-modtime existed))) (progn ;; Don't be confused by apparent local-variables spec ;; in the last message in the RMAIL file. (let ((enable-local-variables nil)) (find-file file-name)) (if (and (verify-visited-file-modtime existed) (eq major-mode 'rmail-mode)) (progn (rmail-forget-messages) (rmail-set-message-counters)))) (let ((enable-local-variables nil)) (find-file file-name))) (if (eq major-mode 'rmail-edit-mode) (error "Exit Rmail Edit mode before getting new mail.")) (if (and existed (> (buffer-size) 0)) ;; Buffer not new and not empty; ensure in proper mode, but that's all. (or (eq major-mode 'rmail-mode) (rmail-mode-2)) (rmail-mode-2) ;; Convert all or part to Babyl file if possible. (rmail-convert-file) (goto-char (point-max)) (if (null rmail-inbox-list) (progn (rmail-set-message-counters) (rmail-show-message)))) (or (and (null file-name-arg) (rmail-get-new-mail)) (rmail-show-message (rmail-first-unseen-message))) (if rmail-display-summary (rmail-summary)) (rmail-construct-io-menu))) ;; Given the value of MAILPATH, return a list of inbox file names. ;; This is turned off because it is not clear that the user wants ;; all these inboxes to feed into the primary rmail file. ; (defun rmail-convert-mailpath (string) ; (let (idx list) ; (while (setq idx (string-match "[%:]" string)) ; (let ((this (substring string 0 idx))) ; (setq string (substring string (1+ idx))) ; (setq list (cons (if (string-match "%" this) ; (substring this 0 (string-match "%" this)) ; this) ; list)))) ; list)) ; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line ; will not cause emacs 18.55 problems. (defun rmail-convert-file () (let (convert) (widen) (goto-char (point-min)) ;; If file doesn't start like a Babyl file, ;; convert it to one, by adding a header and converting each message. (cond ((looking-at "BABYL OPTIONS:")) ((looking-at "Version: 5\n") ;; Losing babyl file made by old version of Rmail. ;; Just fix the babyl file header; don't make a new one, ;; so we don't lose the Labels: file attribute, etc. (let ((buffer-read-only nil)) (insert "BABYL OPTIONS: -*- rmail -*-\n"))) ((equal (point-min) (point-max)) ;; Empty RMAIL file. Just insert the header. (rmail-insert-rmail-file-header)) (t ;; Non-empty file in non-RMAIL format. Add header and convert. (setq convert t) (rmail-insert-rmail-file-header))) ;; If file was not a Babyl file or if there are ;; Unix format messages added at the end, ;; convert file as necessary. (if (or convert (save-excursion (goto-char (point-max)) (search-backward "\n\^_") (forward-char 2) (looking-at "\n*From "))) (let ((buffer-read-only nil)) (message "Converting to Babyl format...") ;; If file needs conversion, convert it all, ;; except for the BABYL header. ;; (rmail-convert-to-babyl-format would delete the header.) (goto-char (point-min)) (search-forward "\n\^_" nil t) (narrow-to-region (point) (point-max)) (rmail-convert-to-babyl-format) (message "Converting to Babyl format...done"))))) ;;; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line ;;; will not cause emacs 18.55 problems. (defun rmail-insert-rmail-file-header () (let ((buffer-read-only nil)) (insert "BABYL OPTIONS: -*- rmail -*- Version: 5 Labels: Note: This is the header of an rmail file. Note: If you are seeing it in rmail, Note: it means the file has no messages in it.\n\^_"))) (if rmail-mode-map nil (setq rmail-mode-map (make-keymap)) (suppress-keymap rmail-mode-map) (define-key rmail-mode-map "a" 'rmail-add-label) (define-key rmail-mode-map "b" 'rmail-bury) (define-key rmail-mode-map "c" 'rmail-continue) (define-key rmail-mode-map "d" 'rmail-delete-forward) (define-key rmail-mode-map "\C-d" 'rmail-delete-backward) (define-key rmail-mode-map "e" 'rmail-edit-current-message) (define-key rmail-mode-map "f" 'rmail-forward) (define-key rmail-mode-map "g" 'rmail-get-new-mail) (define-key rmail-mode-map "h" 'rmail-summary) (define-key rmail-mode-map "i" 'rmail-input) (define-key rmail-mode-map "j" 'rmail-show-message) (define-key rmail-mode-map "k" 'rmail-kill-label) (define-key rmail-mode-map "l" 'rmail-summary-by-labels) (define-key rmail-mode-map "\e\C-h" 'rmail-summary) (define-key rmail-mode-map "\e\C-l" 'rmail-summary-by-labels) (define-key rmail-mode-map "\e\C-r" 'rmail-summary-by-recipients) (define-key rmail-mode-map "\e\C-s" 'rmail-summary-by-regexp) (define-key rmail-mode-map "\e\C-t" 'rmail-summary-by-topic) (define-key rmail-mode-map "m" 'rmail-mail) (define-key rmail-mode-map "\em" 'rmail-retry-failure) (define-key rmail-mode-map "n" 'rmail-next-undeleted-message) (define-key rmail-mode-map "\en" 'rmail-next-message) (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message) (define-key rmail-mode-map "o" 'rmail-output-to-rmail-file) (define-key rmail-mode-map "\C-o" 'rmail-output) (define-key rmail-mode-map "p" 'rmail-previous-undeleted-message) (define-key rmail-mode-map "\ep" 'rmail-previous-message) (define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message) (define-key rmail-mode-map "q" 'rmail-quit) (define-key rmail-mode-map "r" 'rmail-reply) ;; I find I can't live without the default M-r command -- rms. ;; (define-key rmail-mode-map "\er" 'rmail-search-backwards) (define-key rmail-mode-map "s" 'rmail-expunge-and-save) (define-key rmail-mode-map "\es" 'rmail-search) (define-key rmail-mode-map "t" 'rmail-toggle-header) (define-key rmail-mode-map "u" 'rmail-undelete-previous-message) (define-key rmail-mode-map "w" 'rmail-edit-current-message) (define-key rmail-mode-map "x" 'rmail-expunge) (define-key rmail-mode-map "." 'rmail-beginning-of-message) (define-key rmail-mode-map "<" 'rmail-first-message) (define-key rmail-mode-map ">" 'rmail-last-message) (define-key rmail-mode-map " " 'scroll-up) (define-key rmail-mode-map "\177" 'scroll-down) (define-key rmail-mode-map "?" 'describe-mode) (define-key rmail-mode-map "\C-c\C-s\C-d" 'rmail-sort-by-date) (define-key rmail-mode-map "\C-c\C-s\C-s" 'rmail-sort-by-subject) (define-key rmail-mode-map "\C-c\C-s\C-a" 'rmail-sort-by-author) (define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient) (define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent) (define-key rmail-mode-map "\C-c\C-s\C-l" 'rmail-sort-by-lines) (define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-keywords) (define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject) (define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject) ) (define-key rmail-mode-map [menu-bar] (make-sparse-keymap)) (define-key rmail-mode-map [menu-bar classify] (cons "Classify" (make-sparse-keymap "Classify"))) (define-key rmail-mode-map [menu-bar classify input-menu] nil) (define-key rmail-mode-map [menu-bar classify output-menu] nil) (define-key rmail-mode-map [menu-bar classify output-inbox] '("Output (inbox)..." . rmail-output)) (define-key rmail-mode-map [menu-bar classify output] '("Output (Rmail)..." . rmail-output-to-rmail-file)) (define-key rmail-mode-map [menu-bar classify kill-label] '("Kill Label..." . rmail-kill-label)) (define-key rmail-mode-map [menu-bar classify add-label] '("Add Label..." . rmail-add-label)) (define-key rmail-mode-map [menu-bar summary] (cons "Summary" (make-sparse-keymap "Summary"))) (define-key rmail-mode-map [menu-bar summary senders] '("By Senders..." . rmail-summary-by-senders)) (define-key rmail-mode-map [menu-bar summary labels] '("By Labels..." . rmail-summary-by-labels)) (define-key rmail-mode-map [menu-bar summary recipients] '("By Recipients..." . rmail-summary-by-recipients)) (define-key rmail-mode-map [menu-bar summary topic] '("By Topic..." . rmail-summary-by-topic)) (define-key rmail-mode-map [menu-bar summary regexp] '("By Regexp..." . rmail-summary-by-regexp)) (define-key rmail-mode-map [menu-bar summary all] '("All" . rmail-summary)) (define-key rmail-mode-map [menu-bar mail] (cons "Mail" (make-sparse-keymap "Mail"))) (define-key rmail-mode-map [menu-bar mail rmail-get-new-mail] '("Get New Mail" . rmail-get-new-mail)) (define-key rmail-mode-map [menu-bar mail lambda] '("----")) (define-key rmail-mode-map [menu-bar mail continue] '("Continue" . rmail-continue)) (define-key rmail-mode-map [menu-bar mail resend] '("Re-send..." . rmail-resend)) (define-key rmail-mode-map [menu-bar mail forward] '("Forward" . rmail-forward)) (define-key rmail-mode-map [menu-bar mail retry] '("Retry" . rmail-retry-failure)) (define-key rmail-mode-map [menu-bar mail reply] '("Reply" . rmail-reply)) (define-key rmail-mode-map [menu-bar mail mail] '("Mail" . rmail-mail)) (define-key rmail-mode-map [menu-bar delete] (cons "Delete" (make-sparse-keymap "Delete"))) (define-key rmail-mode-map [menu-bar delete expunge/save] '("Expunge/Save" . rmail-expunge-and-save)) (define-key rmail-mode-map [menu-bar delete expunge] '("Expunge" . rmail-expunge)) (define-key rmail-mode-map [menu-bar delete undelete] '("Undelete" . rmail-undelete-previous-message)) (define-key rmail-mode-map [menu-bar delete delete] '("Delete" . rmail-delete-forward)) (define-key rmail-mode-map [menu-bar move] (cons "Move" (make-sparse-keymap "Move"))) (define-key rmail-mode-map [menu-bar move search-back] '("Search Back..." . rmail-search-backwards)) (define-key rmail-mode-map [menu-bar move search] '("Search..." . rmail-search)) (define-key rmail-mode-map [menu-bar move previous] '("Previous Nondeleted" . rmail-previous-undeleted-message)) (define-key rmail-mode-map [menu-bar move next] '("Next Nondeleted" . rmail-next-undeleted-message)) (define-key rmail-mode-map [menu-bar move last] '("Last" . rmail-last-message)) (define-key rmail-mode-map [menu-bar move first] '("First" . rmail-first-message)) (define-key rmail-mode-map [menu-bar move previous] '("Previous" . rmail-previous-message)) (define-key rmail-mode-map [menu-bar move next] '("Next" . rmail-next-message)) ;; Rmail mode is suitable only for specially formatted data. (put 'rmail-mode 'mode-class 'special) (defun rmail-mode-kill-summary () (if rmail-summary-buffer (kill-buffer rmail-summary-buffer))) ;;;###autoload (defun rmail-mode () "Rmail Mode is used by \\\\[rmail] for editing Rmail files. All normal editing commands are turned off. Instead, these commands are available: \\[rmail-beginning-of-message] Move point to front of this message (same as \\[beginning-of-buffer]). \\[scroll-up] Scroll to next screen of this message. \\[scroll-down] Scroll to previous screen of this message. \\[rmail-next-undeleted-message] Move to Next non-deleted message. \\[rmail-previous-undeleted-message] Move to Previous non-deleted message. \\[rmail-next-message] Move to Next message whether deleted or not. \\[rmail-previous-message] Move to Previous message whether deleted or not. \\[rmail-first-message] Move to the first message in Rmail file. \\[rmail-last-message] Move to the last message in Rmail file. \\[rmail-show-message] Jump to message specified by numeric position in file. \\[rmail-search] Search for string and show message it is found in. \\[rmail-delete-forward] Delete this message, move to next nondeleted. \\[rmail-delete-backward] Delete this message, move to previous nondeleted. \\[rmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages till a deleted message is found. \\[rmail-edit-current-message] Edit the current message. \\[rmail-cease-edit] to return to Rmail. \\[rmail-expunge] Expunge deleted messages. \\[rmail-expunge-and-save] Expunge and save the file. \\[rmail-quit] Quit Rmail: expunge, save, then switch to another buffer. \\[save-buffer] Save without expunging. \\[rmail-get-new-mail] Move new mail from system spool directory into this file. \\[rmail-mail] Mail a message (same as \\[mail-other-window]). \\[rmail-continue] Continue composing outgoing message started before. \\[rmail-reply] Reply to this message. Like \\[rmail-mail] but initializes some fields. \\[rmail-retry-failure] Send this message again. Used on a mailer failure message. \\[rmail-forward] Forward this message to another user. \\[rmail-output-to-rmail-file] Output this message to an Rmail file (append it). \\[rmail-output] Output this message to a Unix-format mail file (append it). \\[rmail-input] Input Rmail file. Run Rmail on that file. \\[rmail-add-label] Add label to message. It will be displayed in the mode line. \\[rmail-kill-label] Kill label. Remove a label from current message. \\[rmail-next-labeled-message] Move to Next message with specified label (label defaults to last one specified). Standard labels: filed, unseen, answered, forwarded, deleted. Any other label is present only if you add it with \\[rmail-add-label]. \\[rmail-previous-labeled-message] Move to Previous message with specified label \\[rmail-summary] Show headers buffer, with a one line summary of each message. \\[rmail-summary-by-labels] Summarize only messages with particular label(s). \\[rmail-summary-by-recipients] Summarize only messages with particular recipient(s). \\[rmail-summary-by-regexp] Summarize only messages with particular regexp(s). \\[rmail-summary-by-topic] Summarize only messages with subject line regexp(s). \\[rmail-toggle-header] Toggle display of complete header." (interactive) (rmail-mode-2) (rmail-set-message-counters) (rmail-show-message rmail-total-messages)) (defun rmail-mode-2 () (kill-all-local-variables) (rmail-mode-1) (rmail-variables) (run-hooks 'rmail-mode-hook)) (defun rmail-mode-1 () (setq major-mode 'rmail-mode) (setq mode-name "RMAIL") (setq buffer-read-only t) ;; No need to auto save RMAIL files in normal circumstances ;; because they contain no info except attribute changes ;; and deletion of messages. ;; The one exception is when messages are copied into an Rmail mode buffer. ;; rmail-output-to-rmail-file enables auto save when you do that. (setq buffer-auto-save-file-name nil) (if (boundp 'mode-line-modified) (setq mode-line-modified "--- ") (setq mode-line-format (cons "--- " (cdr (default-value 'mode-line-format))))) (use-local-map rmail-mode-map) (set-syntax-table text-mode-syntax-table) (setq local-abbrev-table text-mode-abbrev-table)) (defun rmail-variables () (make-local-variable 'revert-buffer-function) (setq revert-buffer-function 'rmail-revert) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(rmail-font-lock-keywords t)) (make-local-variable 'rmail-last-label) (make-local-variable 'rmail-last-regexp) (make-local-variable 'rmail-deleted-vector) (make-local-variable 'rmail-summary-buffer) (make-local-variable 'rmail-summary-vector) (make-local-variable 'rmail-current-message) (make-local-variable 'rmail-total-messages) (make-local-variable 'require-final-newline) (setq require-final-newline nil) (make-local-variable 'rmail-overlay-list) (setq rmail-overlay-list nil) (make-local-variable 'version-control) (setq version-control 'never) (make-local-variable 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'rmail-mode-kill-summary) (make-local-variable 'file-precious-flag) (setq file-precious-flag t) (make-local-variable 'rmail-message-vector) (make-local-variable 'rmail-inbox-list) (setq rmail-inbox-list (rmail-parse-file-inboxes)) ;; 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 (abbreviate-file-name (file-truename rmail-file-name)))) (setq rmail-inbox-list (or rmail-primary-inbox-list (list (or (getenv "MAIL") (concat rmail-spool-directory (user-login-name))))))) (make-local-variable 'rmail-keywords) ;; this gets generated as needed (setq rmail-keywords nil)) ;; Handle M-x revert-buffer done in an rmail-mode buffer. (defun rmail-revert (arg noconfirm) (let ((revert-buffer-function (default-value 'revert-buffer-function))) ;; Call our caller again, but this time it does the default thing. (if (revert-buffer arg noconfirm) ;; If the user said "yes", and we changed something, ;; reparse the messages. (progn (rmail-convert-file) (goto-char (point-max)) (rmail-mode))))) ;; Return a list of files from this buffer's Mail: option. ;; Does not assume that messages have been parsed. ;; Just returns nil if buffer does not look like Babyl format. (defun rmail-parse-file-inboxes () (save-excursion (save-restriction (widen) (goto-char 1) (cond ((looking-at "BABYL OPTIONS:") (search-forward "\n\^_" nil 'move) (narrow-to-region 1 (point)) (goto-char 1) (if (search-forward "\nMail:" nil t) (progn (narrow-to-region (point) (progn (end-of-line) (point))) (goto-char (point-min)) (mail-parse-comma-list)))))))) (defun rmail-expunge-and-save () "Expunge and save RMAIL file." (interactive) (rmail-expunge) (save-buffer) (if (rmail-summary-exists) (rmail-select-summary (set-buffer-modified-p nil)))) (defun rmail-quit () "Quit out of RMAIL." (interactive) (rmail-expunge-and-save) ;; Don't switch to the summary buffer even if it was recently visible. (if rmail-summary-buffer (progn (replace-buffer-in-windows rmail-summary-buffer) (bury-buffer rmail-summary-buffer))) (let ((obuf (current-buffer))) (replace-buffer-in-windows obuf) (bury-buffer obuf))) (defun rmail-bury () "Bury current Rmail buffer and its summary buffer." (interactive) ;; This let var was called rmail-buffer, but that interfered ;; with the buffer-local var used in summary buffers. (let ((buffer-to-bury (current-buffer))) (if (rmail-summary-exists) (let (window) (while (setq window (get-buffer-window rmail-summary-buffer)) (set-window-buffer window (other-buffer rmail-summary-buffer))) (bury-buffer rmail-summary-buffer))) (switch-to-buffer (other-buffer (current-buffer))) (bury-buffer buffer-to-bury))) (defun rmail-duplicate-message () "Create a duplicated copy of the current message. The duplicate copy goes into the Rmail file just after the original copy." (interactive) (widen) (let ((buffer-read-only nil) (number rmail-current-message) (string (buffer-substring (rmail-msgbeg rmail-current-message) (rmail-msgend rmail-current-message)))) (goto-char (rmail-msgend rmail-current-message)) (insert string) (rmail-forget-messages) (rmail-show-message number) (message "Message duplicated"))) ;;;###autoload (defun rmail-input (filename) "Run Rmail on file FILENAME." (interactive "FRun rmail on RMAIL file: ") (rmail filename)) ;; Return a list of file names for all files in or under START ;; whose names match rmail-secondary-file-regexp. ;; This includes START itself, if that name matches. ;; But normally START is a directory. (defun rmail-find-all-files (start) (if (file-accessible-directory-p start) ;; Don't sort here. (let ((files (directory-files start t rmail-secondary-file-regexp t)) (ret nil) file) (while files (setq file (car files)) (setq files (cdr files)) (setq ret (nconc (rmail-find-all-files file) ret))) ;; Sort here instead of in directory-files ;; because this list is usually much shorter. (sort ret 'string<)) (let ((case-fold-search nil)) (if (string-match rmail-secondary-file-regexp start) (list (file-name-nondirectory start)))))) (defun rmail-list-to-menu (menu-name l action &optional full-name) (let ((menu (make-sparse-keymap menu-name))) (mapcar (function (lambda (item) (let (command) (if (consp item) (progn (setq command (rmail-list-to-menu (car item) (cdr item) action (if full-name (concat full-name "/" (car item)) (car item)))) (setq name (car item))) (progn (setq name item) (setq command (list 'lambda () '(interactive) (list action (expand-file-name (if full-name (concat full-name "/" item) item) rmail-secondary-file-directory)))))) (define-key menu (vector (intern name)) (cons name command))))) (reverse l)) menu)) ;; This command is always "disabled" when it appears in a menu. (put 'rmail-disable-menu 'menu-enable ''nil) (defun rmail-construct-io-menu () (let ((files (rmail-find-all-files rmail-secondary-file-directory))) (if files (progn (define-key rmail-mode-map [menu-bar classify input-menu] (cons "Input Rmail File" (rmail-list-to-menu "Input Rmail File" files 'rmail-input))) (define-key rmail-mode-map [menu-bar classify output-menu] (cons "Output Rmail File" (rmail-list-to-menu "Output Rmail File" files 'rmail-output-to-rmail-file)))) (define-key rmail-mode-map [menu-bar classify input-menu] '("Input Rmail File" . rmail-disable-menu)) (define-key rmail-mode-map [menu-bar classify output-menu] '("Output Rmail File" . rmail-disable-menu))))) ;;;; *** Rmail input *** ;; RLK feature not added in this version: ;; argument specifies inbox file or files in various ways. (defun rmail-get-new-mail (&optional file-name) "Move any new mail from this RMAIL file's inbox files. The inbox files can be specified with the file's Mail: option. The variable `rmail-primary-inbox-list' specifies the inboxes for your primary RMAIL file if it has no Mail: option. By default, this is your /usr/spool/mail/$USER. You can also specify the file to get new mail from. In this case, the file of new mail is not changed or deleted. Noninteractively, you can pass the inbox file name as an argument. Interactively, a prefix argument causes us to read a file name and use that file as the inbox. This function runs `rmail-get-new-mail-hook' before saving the updated file. It returns t if it got any new messages." (interactive (list (if current-prefix-arg (read-file-name "Get new mail from file: ")))) ;; If the disk file has been changed from under us, ;; revert to it before we get new mail. (or (verify-visited-file-modtime (current-buffer)) (find-file (buffer-file-name))) (rmail-maybe-set-message-counters) (widen) ;; Get rid of all undo records for this buffer. (or (eq buffer-undo-list t) (setq buffer-undo-list nil)) (unwind-protect (let ((opoint (point)) (new-messages 0) (delete-files ()) ;; If buffer has not changed yet, and has not been saved yet, ;; don't replace the old backup file now. (make-backup-files (and make-backup-files (buffer-modified-p))) (buffer-read-only nil) ;; Don't make undo records for what we do in getting mail. (buffer-undo-list t)) (goto-char (point-max)) (skip-chars-backward " \t\n") ; just in case of brain damage (delete-region (point) (point-max)) ; caused by require-final-newline (save-excursion (save-restriction (narrow-to-region (point) (point)) ;; Read in the contents of the inbox files, ;; renaming them as necessary, ;; and adding to the list of files to delete eventually. (if file-name (rmail-insert-inbox-text (list file-name) nil) (setq delete-files (rmail-insert-inbox-text rmail-inbox-list t))) ;; Scan the new text and convert each message to babyl format. (goto-char (point-min)) (save-excursion (setq new-messages (rmail-convert-to-babyl-format))) (or (zerop new-messages) (let (success) (widen) (search-backward "\n\^_" nil t) (narrow-to-region (point) (point-max)) (goto-char (1+ (point-min))) (rmail-count-new-messages) (run-hooks 'rmail-get-new-mail-hook) (save-buffer))) ;; Delete the old files, now that babyl file is saved. (while delete-files (condition-case () ;; First, try deleting. (condition-case () (delete-file (car delete-files)) (file-error ;; If we can't delete it, truncate it. (write-region (point) (point) (car delete-files)))) (file-error nil)) (setq delete-files (cdr delete-files))))) (if (= new-messages 0) (progn (goto-char opoint) (if (or file-name rmail-inbox-list) (message "(No new mail has arrived)")) nil) (if (rmail-summary-exists) (rmail-select-summary (rmail-update-summary))) (message "%d new message%s read" new-messages (if (= 1 new-messages) "" "s")) ;; Move to the first new message ;; unless we have other unseen messages before it. (rmail-show-message (rmail-first-unseen-message)) ;; Update the displayed time, since that will clear out ;; the flag that says you have mail. (if (eq (process-status "display-time") 'run) (display-time-filter display-time-process "")) t)) ;; Don't leave the buffer screwed up if we get a disk-full error. (rmail-show-message))) (defun rmail-insert-inbox-text (files renamep) (let (file tofile delete-files movemail popmail) (while files (setq file (file-truename (expand-file-name (substitute-in-file-name (car files)))) tofile (expand-file-name ;; Generate name to move to from inbox name, ;; in case of multiple inboxes that need moving. (concat ".newmail-" (file-name-nondirectory file)) ;; Use the directory of this rmail file ;; because it's a nuisance to use the homedir ;; if that is on a full disk and this rmail ;; file isn't. (file-name-directory (expand-file-name buffer-file-name)))) ;; Always use movemail to rename the file, ;; since there can be mailboxes in various directories. (setq movemail t) ;;; ;; If getting from mail spool directory, ;;; ;; use movemail to move rather than just renaming, ;;; ;; so as to interlock with the mailer. ;;; (setq movemail (string= file ;;; (file-truename ;;; (concat rmail-spool-directory ;;; (file-name-nondirectory file))))) (setq popmail (string-match "^po:" (file-name-nondirectory file))) (if popmail (setq file (file-name-nondirectory file) renamep t)) (if movemail (progn ;; On some systems, /usr/spool/mail/foo is a directory ;; and the actual inbox is /usr/spool/mail/foo/foo. (if (file-directory-p file) (setq file (expand-file-name (user-login-name) file))))) (cond (popmail (message "Getting mail from post office ...")) ((and (file-exists-p tofile) (/= 0 (nth 7 (file-attributes tofile)))) (message "Getting mail from %s..." tofile)) ((and (file-exists-p file) (/= 0 (nth 7 (file-attributes file)))) (message "Getting mail from %s..." file))) ;; Set TOFILE if have not already done so, and ;; rename or copy the file FILE to TOFILE if and as appropriate. (cond ((not renamep) (setq tofile file)) ((or (file-exists-p tofile) (and (not popmail) (not (file-exists-p file)))) 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 ;; Third arg is t so we can replace existing file TOFILE. (rename-file file tofile t))) ;; Make the real inbox file empty. ;; Leaving it deleted could cause lossage ;; because mailers often won't create the file. (condition-case () (write-region (point) (point) file) (file-error nil))) (t (let ((errors nil)) (unwind-protect (save-excursion (setq errors (generate-new-buffer " *rmail loss*")) (buffer-disable-undo errors) (call-process (or rmail-movemail-program (expand-file-name "movemail" exec-directory)) nil errors nil file tofile) (if (not (buffer-modified-p errors)) ;; No output => movemail won nil (set-buffer errors) (subst-char-in-region (point-min) (point-max) ?\n ?\ ) (goto-char (point-max)) (skip-chars-backward " \t") (delete-region (point) (point-max)) (goto-char (point-min)) (if (looking-at "movemail: ") (delete-region (point-min) (match-end 0))) (beep t) (message (concat "movemail: " (buffer-substring (point-min) (point-max)))) (sit-for 3) nil)) (if errors (kill-buffer errors)))))) ;; At this point, TOFILE contains the name to read: ;; Either the alternate name (if we renamed) ;; or the actual inbox (if not renaming). (if (file-exists-p tofile) (let (size) (goto-char (point-max)) (setq size (nth 1 (insert-file-contents tofile))) (goto-char (point-max)) (or (= (preceding-char) ?\n) (zerop size) (insert ?\n)) (setq delete-files (cons tofile delete-files)))) (message "") (setq files (cdr files))) delete-files)) ;; the rmail-break-forwarded-messages feature is not implemented (defun rmail-convert-to-babyl-format () (let ((count 0) start (case-fold-search nil) (invalid-input-resync (function (lambda () (message "Invalid Babyl format in inbox!") (sit-for 1) ;; Try to get back in sync with a real message. (if (re-search-forward (concat mmdf-delim1 "\\|^From") nil t) (beginning-of-line) (goto-char (point-max))))))) (goto-char (point-min)) (save-restriction (while (not (eobp)) (cond ((looking-at "BABYL OPTIONS:");Babyl header (if (search-forward "\n\^_" nil t) ;; If we find the proper terminator, delete through there. (delete-region (point-min) (point)) (funcall invalid-input-resync) (delete-region (point-min) (point)))) ;; Babyl format message ((looking-at "\^L") (or (search-forward "\n\^_" nil t) (funcall invalid-input-resync)) (setq count (1+ count)) ;; Make sure there is no extra white space after the ^_ ;; at the end of the message. ;; Narrowing will make sure that whatever follows the junk ;; will be treated properly. (delete-region (point) (save-excursion (skip-chars-forward " \t\n") (point))) (narrow-to-region (point) (point-max))) ;;*** MMDF format ((let ((case-fold-search t)) (looking-at mmdf-delim1)) (let ((case-fold-search t)) (replace-match "\^L\n0, unseen,,\n*** EOOH ***\n") (setq start (point)) (re-search-forward mmdf-delim2 nil t) (replace-match "\^_")) (save-excursion (save-restriction (narrow-to-region start (1- (point))) (goto-char (point-min)) (while (search-forward "\n\^_" nil t); single char "\^_" (replace-match "\n^_")))); 2 chars: "^" and "_" (narrow-to-region (point) (point-max)) (setq count (1+ count))) ;;*** Mail format ((looking-at "^From ") (setq start (point)) (insert "\^L\n0, unseen,,\n*** EOOH ***\n") (rmail-nuke-pinhead-header) ;; If this message has a Content-Length field, ;; skip to the end of the contents. (let* ((header-end (save-excursion (and (re-search-forward "\n\n" nil t) (1- (point))))) (case-fold-search t) (size ;; Get the numeric value from the Content-Length field. (save-excursion ;; Back up to end of prev line, ;; in case the Content-Length field comes first. (forward-char -1) (and (search-forward "\ncontent-length: " header-end t) (let ((beg (point)) (eol (progn (end-of-line) (point)))) (string-to-int (buffer-substring beg eol))))))) (and size (if (and (natnump size) (<= (+ header-end size) (point-max)) ;; Make sure this would put us at a position ;; that we could continue from. (save-excursion (goto-char (+ header-end size)) (skip-chars-forward "\n") (or (eobp) (and (looking-at "BABYL OPTIONS:") (search-forward "\n\^_" nil t)) (and (looking-at "\^L") (search-forward "\n\^_" nil t)) (let ((case-fold-search t)) (looking-at mmdf-delim1)) (looking-at "From ")))) (goto-char (+ header-end size)) (message "Ignoring invalid Content-Length field") (sit-for 1 0 t)))) (if (re-search-forward (concat "^[\^_]?\\(" rmail-unix-mail-delimiter "\\|" mmdf-delim1 "\\|" "^BABYL OPTIONS:\\|" "\^L\n[01],\\)") nil t) (goto-char (match-beginning 1)) (goto-char (point-max))) (setq count (1+ count)) (save-excursion (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) (while (search-forward "\n\^_" nil t); single char (replace-match "\n^_")))); 2 chars: "^" and "_" (insert ?\^_) (narrow-to-region (point) (point-max))) ;; ;; This kludge is because some versions of sendmail.el ;; insert an extra newline at the beginning that shouldn't ;; be there. sendmail.el has been fixed, but old versions ;; may still be in use. -- rms, 7 May 1993. ((eolp) (delete-char 1)) (t (error "Cannot convert to babyl format"))))) count)) ;; Delete the "From ..." line, creating various other headers with ;; information from it if they don't already exist. Now puts the ;; original line into a mail-from: header line for debugging and for ;; use by the rmail-output function. (defun rmail-nuke-pinhead-header () (save-excursion (save-restriction (let ((start (point)) (end (progn (condition-case () (search-forward "\n\n") (error (goto-char (point-max)) (insert "\n\n"))) (point))) has-from has-date) (narrow-to-region start end) (let ((case-fold-search t)) (goto-char start) (setq has-from (search-forward "\nFrom:" nil t)) (goto-char start) (setq has-date (and (search-forward "\nDate:" nil t) (point))) (goto-char start)) (let ((case-fold-search nil)) (if (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t) (replace-match (concat "Mail-from: \\&" ;; Keep and reformat the date if we don't ;; have a Date: field. (if has-date "" (concat "Date: \\3, \\5 \\4 \\9 \\6 " ;; The timezone could be matched by group 7 or group 10. ;; If neither of them matched, assume EST, since only ;; Easterners would be so sloppy. ;; It's a shame the substitution can't use "\\10". (cond ((/= (match-beginning 7) (match-end 7)) "\\7") ((/= (match-beginning 10) (match-end 10)) (buffer-substring (match-beginning 10) (match-end 10))) (t "EST")) "\n")) ;; Keep and reformat the sender if we don't ;; have a From: field. (if has-from "" "From: \\1\n")) t))))))) ;;;; *** Rmail Message Formatting and Header Manipulation *** (defun rmail-reformat-message (beg end) (goto-char beg) (forward-line 1) (if (/= (following-char) ?0) (error "Bad format in RMAIL file.")) (let ((buffer-read-only nil) (delta (- (buffer-size) end))) (delete-char 1) (insert ?1) (forward-line 1) (let ((case-fold-search t)) (while (looking-at "Summary-line:\\|Mail-From:") (forward-line 1))) (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*\n") (delete-region (point) (progn (forward-line 1) (point)))) (let ((str (buffer-substring (point) (save-excursion (search-forward "\n\n" end 'move) (point))))) (insert str "*** EOOH ***\n") (narrow-to-region (point) (- (buffer-size) delta))) (goto-char (point-min)) (if rmail-message-filter (funcall rmail-message-filter)) (if (or rmail-displayed-headers rmail-ignored-headers) (rmail-clear-headers)))) (defun rmail-clear-headers (&optional ignored-headers) "Delete all header fields that Rmail should not show. If the optional argument IGNORED-HEADERS is non-nil, delete all header fields whose names match that regexp. Otherwise, if `rmail-displayed-headers' is non-nil, delete all header fields *except* those whose names match that regexp. Otherwise, delete all header fields whose names match `rmail-ignored-headers'." (if (search-forward "\n\n" nil t) (if (and rmail-displayed-headers (null ignored-headers)) (save-restriction (narrow-to-region (point-min) (point)) (let ((buffer-read-only nil) lim) (goto-char (point-min)) (while (save-excursion (re-search-forward "\n[^ \t]") (and (not (eobp)) (setq lim (1- (point))))) (if (save-excursion (re-search-forward rmail-displayed-headers lim t)) (goto-char lim) (delete-region (point) lim)))) (goto-char (point-min))) (or ignored-headers (setq ignored-headers rmail-ignored-headers)) (save-restriction (narrow-to-region (point-min) (point)) (let ((buffer-read-only nil)) (while (let ((case-fold-search t)) (goto-char (point-min)) (re-search-forward ignored-headers nil t)) (beginning-of-line) (delete-region (point) (progn (re-search-forward "\n[^ \t]") (1- (point)))))))))) (defun rmail-toggle-header () "Show original message header if pruned header currently shown, or vice versa." (interactive) (rmail-maybe-set-message-counters) (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) (let ((buffer-read-only nil)) (goto-char (point-min)) (forward-line 1) (if (= (following-char) ?1) (progn (delete-char 1) (insert ?0) (forward-line 1) (let ((case-fold-search t)) (while (looking-at "Summary-Line:\\|Mail-From:") (forward-line 1))) (insert "*** EOOH ***\n") (forward-char -1) (search-forward "\n*** EOOH ***\n") (forward-line -1) (let ((temp (point))) (and (search-forward "\n\n" nil t) (delete-region temp (point)))) (goto-char (point-min)) (search-forward "\n*** EOOH ***\n") (narrow-to-region (point) (point-max))) (rmail-reformat-message (point-min) (point-max)))) (rmail-highlight-headers)) ;;;; *** Rmail Attributes and Keywords *** ;; Make a string describing current message's attributes and keywords ;; and set it up as the name of a minor mode ;; so it will appear in the mode line. (defun rmail-display-labels () (let ((blurb "") (beg (point-min-marker)) (end (point-max-marker))) (save-excursion (unwind-protect (progn (widen) (goto-char (rmail-msgbeg rmail-current-message)) (forward-line 1) (if (looking-at "[01],") (progn (narrow-to-region (point) (progn (end-of-line) (point))) ;; Truly valid BABYL format requires a space before each ;; attribute or keyword name. Put them in if missing. (let (buffer-read-only) (goto-char (point-min)) (while (search-forward "," nil t) (or (looking-at "[ ,]") (eobp) (insert " ")))) (goto-char (point-max)) (if (search-backward ",," nil 'move) (progn (if (> (point) (1+ (point-min))) (setq blurb (buffer-substring (+ 1 (point-min)) (point)))) (if (> (- (point-max) (point)) 2) (setq blurb (concat blurb ";" (buffer-substring (+ (point) 3) (1- (point-max))))))))))) ;; Note: we don't use save-restriction because that does not work right ;; if changes are made outside the saved restriction ;; before that restriction is restored. (narrow-to-region beg end) (set-marker beg nil) (set-marker end nil))) (while (string-match " +," blurb) (setq blurb (concat (substring blurb 0 (match-beginning 0)) "," (substring blurb (match-end 0))))) (while (string-match ", +" blurb) (setq blurb (concat (substring blurb 0 (match-beginning 0)) "," (substring blurb (match-end 0))))) (setq mode-line-process (format " %d/%d%s" rmail-current-message rmail-total-messages blurb)))) ;; Turn an attribute of a message on or off according to STATE. ;; ATTR is the name of the attribute, as a string. ;; MSGNUM is message number to change; nil means current message. (defun rmail-set-attribute (attr state &optional msgnum) (let ((omax (point-max-marker)) (omin (point-min-marker)) (buffer-read-only nil)) (or msgnum (setq msgnum rmail-current-message)) (if (> msgnum 0) (unwind-protect (save-excursion (widen) (goto-char (+ 3 (rmail-msgbeg msgnum))) (let ((curstate (not (null (search-backward (concat ", " attr ",") (prog1 (point) (end-of-line)) t))))) (or (eq curstate (not (not state))) (if curstate (delete-region (point) (1- (match-end 0))) (beginning-of-line) (forward-char 2) (insert " " attr ",")))) (if (string= attr "deleted") (rmail-set-message-deleted-p msgnum state))) ;; Note: we don't use save-restriction because that does not work right ;; if changes are made outside the saved restriction ;; before that restriction is restored. (narrow-to-region omin omax) (set-marker omin nil) (set-marker omax nil) (if (= msgnum rmail-current-message) (rmail-display-labels)))))) ;; Return t if the attributes/keywords line of msg number MSG ;; contains a match for the regexp LABELS. (defun rmail-message-labels-p (msg labels) (save-excursion (save-restriction (widen) (goto-char (rmail-msgbeg msg)) (forward-char 3) (re-search-backward labels (prog1 (point) (end-of-line)) t)))) ;;;; *** Rmail Message Selection And Support *** (defun rmail-msgend (n) (marker-position (aref rmail-message-vector (1+ n)))) (defun rmail-msgbeg (n) (marker-position (aref rmail-message-vector n))) (defun rmail-widen-to-current-msgbeg (function) "Call FUNCTION with point at start of internal data of current message. Assumes that bounds were previously narrowed to display the message in Rmail. The bounds are widened enough to move point where desired, then narrowed again afterward. FUNCTION may not change the visible text of the message, but it may change the invisible header text." (save-excursion (let ((obeg (- (point-max) (point-min)))) (unwind-protect (progn (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) (goto-char (point-min)) (funcall function)) ;; Note: we don't use save-restriction because that does not work right ;; if changes are made outside the saved restriction ;; before that restriction is restored. ;; Here we assume that changes made by FUNCTION ;; occur before the visible region of the message. (narrow-to-region (- (point-max) obeg) (point-max)))))) (defun rmail-forget-messages () (unwind-protect (if (vectorp rmail-message-vector) (let* ((i 0) (v rmail-message-vector) (n (length v))) (while (< i n) (move-marker (aref v i) nil) (setq i (1+ i))))) (setq rmail-message-vector nil) (setq rmail-deleted-vector nil))) (defun rmail-maybe-set-message-counters () (if (not (and rmail-deleted-vector rmail-message-vector rmail-current-message rmail-total-messages)) (rmail-set-message-counters))) (defun rmail-count-new-messages (&optional nomsg) (let* ((case-fold-search nil) (total-messages 0) (messages-head nil) (deleted-head nil)) (or nomsg (message "Counting new messages...")) (goto-char (point-max)) ;; Put at the end of messages-head ;; the entry for message N+1, which marks ;; the end of message N. (N = number of messages). (search-backward "\n\^_") (forward-char 1) (setq messages-head (list (point-marker))) (rmail-set-message-counters-counter (point-min)) (setq rmail-current-message (1+ rmail-total-messages)) (setq rmail-total-messages (+ rmail-total-messages total-messages)) (setq rmail-message-vector (vconcat rmail-message-vector (cdr messages-head))) (aset rmail-message-vector rmail-current-message (car messages-head)) (setq rmail-deleted-vector (concat rmail-deleted-vector deleted-head)) (setq rmail-summary-vector (vconcat rmail-summary-vector (make-vector total-messages nil))) (goto-char (point-min)) (or nomsg (message "Counting new messages...done (%d)" total-messages)))) (defun rmail-set-message-counters () (rmail-forget-messages) (save-excursion (save-restriction (widen) (let* ((point-save (point)) (total-messages 0) (messages-after-point) (case-fold-search nil) (messages-head nil) (deleted-head nil)) (message "Counting messages...") (goto-char (point-max)) ;; Put at the end of messages-head ;; the entry for message N+1, which marks ;; the end of message N. (N = number of messages). (search-backward "\n\^_" nil t) (if (/= (point) (point-max)) (forward-char 1)) (setq messages-head (list (point-marker))) (rmail-set-message-counters-counter (min (point) point-save)) (setq messages-after-point total-messages) (rmail-set-message-counters-counter) (setq rmail-total-messages total-messages) (setq rmail-current-message (min total-messages (max 1 (- total-messages messages-after-point)))) (setq rmail-message-vector (apply 'vector (cons (point-min-marker) messages-head)) rmail-deleted-vector (concat "D" deleted-head) rmail-summary-vector (make-vector rmail-total-messages nil)) (message "Counting messages...done"))))) (defun rmail-set-message-counters-counter (&optional stop) (while (search-backward "\n\^_\^L\n" stop t) (forward-char 1) (setq messages-head (cons (point-marker) messages-head)) (save-excursion (setq deleted-head (cons (if (search-backward ", deleted," (prog1 (point) (forward-line 2)) t) ?D ?\ ) deleted-head))) (if (zerop (% (setq total-messages (1+ total-messages)) 20)) (message "Counting messages...%d" total-messages)))) (defun rmail-beginning-of-message () "Show current message starting from the beginning." (interactive) (rmail-show-message rmail-current-message)) (defun rmail-show-message (&optional n no-summary) "Show message number N (prefix argument), counting from start of file. If summary buffer is currently displayed, update current message there also." (interactive "p") (rmail-maybe-set-message-counters) (widen) (if (zerop rmail-total-messages) (progn (narrow-to-region (point-min) (1- (point-max))) (goto-char (point-min)) (setq mode-line-process nil)) (let (blurb) (if (not n) (setq n rmail-current-message) (cond ((<= n 0) (setq n 1 rmail-current-message 1 blurb "No previous message")) ((> n rmail-total-messages) (setq n rmail-total-messages rmail-current-message rmail-total-messages blurb "No following message")) (t (setq rmail-current-message n)))) (let ((beg (rmail-msgbeg n)) (end (rmail-msgend n))) (goto-char beg) (forward-line 1) (if (= (following-char) ?0) (progn (rmail-reformat-message beg end) (rmail-set-attribute "unseen" nil)) (search-forward "\n*** EOOH ***\n" end t) (narrow-to-region (point) end)) (goto-char (point-min)) (rmail-display-labels) (rmail-highlight-headers) (if transient-mark-mode (deactivate-mark)) (run-hooks 'rmail-show-message-hook) ;; If there is a summary buffer, try to move to this message ;; in that buffer. But don't complain if this message ;; is not mentioned in the summary. ;; Don't do this at all if we were called on behalf ;; of cursor motion in the summary buffer. (and (rmail-summary-exists) (not no-summary) (let ((curr-msg rmail-current-message)) (rmail-select-summary (rmail-summary-goto-msg curr-msg t t)))) (if blurb (message blurb)))))) ;; Find all occurrences of certain fields, and highlight them. (defun rmail-highlight-headers () ;; Do this only if the system supports faces. (if (and (fboundp 'internal-find-face) rmail-highlighted-headers) (save-excursion (search-forward "\n\n" nil 'move) (save-restriction (narrow-to-region (point-min) (point)) (let ((case-fold-search t) (inhibit-read-only t) ;; Highlight with boldface if that is available. ;; Otherwise use the `highlight' face. (face (or rmail-highlight-face (if (face-differs-from-default-p 'bold) 'bold 'highlight))) ;; List of overlays to reuse. (overlays rmail-overlay-list)) (goto-char (point-min)) (while (re-search-forward rmail-highlighted-headers nil t) (skip-chars-forward " \t") (let ((beg (point)) overlay) (while (progn (forward-line 1) (looking-at "[ \t]"))) ;; Back up over newline, then trailing spaces or tabs (forward-char -1) (while (member (preceding-char) '(? ?\t)) (forward-char -1)) (if overlays ;; Reuse an overlay we already have. (progn (setq overlay (car overlays) overlays (cdr overlays)) (overlay-put overlay 'face face) (move-overlay overlay beg (point))) ;; Make a new overlay and add it to ;; rmail-overlay-list. (setq overlay (make-overlay beg (point))) (overlay-put overlay 'face face) (setq rmail-overlay-list (cons overlay rmail-overlay-list)))))))))) (defun rmail-next-message (n) "Show following message whether deleted or not. With prefix arg N, moves forward N messages, or backward if N is negative." (interactive "p") (rmail-maybe-set-message-counters) (rmail-show-message (+ rmail-current-message n))) (defun rmail-previous-message (n) "Show previous message whether deleted or not. With prefix arg N, moves backward N messages, or forward if N is negative." (interactive "p") (rmail-next-message (- n))) (defun rmail-next-undeleted-message (n) "Show following non-deleted message. With prefix arg N, moves forward N non-deleted messages, or backward if N is negative. Returns t if a new message is being shown, nil otherwise." (interactive "p") (rmail-maybe-set-message-counters) (let ((lastwin rmail-current-message) (current rmail-current-message)) (while (and (> n 0) (< current rmail-total-messages)) (setq current (1+ current)) (if (not (rmail-message-deleted-p current)) (setq lastwin current n (1- n)))) (while (and (< n 0) (> current 1)) (setq current (1- current)) (if (not (rmail-message-deleted-p current)) (setq lastwin current n (1+ n)))) (if (/= lastwin rmail-current-message) (progn (rmail-show-message lastwin) t) (if (< n 0) (message "No previous nondeleted message")) (if (> n 0) (message "No following nondeleted message")) nil))) (defun rmail-previous-undeleted-message (n) "Show previous non-deleted message. With prefix argument N, moves backward N non-deleted messages, or forward if N is negative." (interactive "p") (rmail-next-undeleted-message (- n))) (defun rmail-first-message () "Show first message in file." (interactive) (rmail-maybe-set-message-counters) (rmail-show-message 1)) (defun rmail-last-message () "Show last message in file." (interactive) (rmail-maybe-set-message-counters) (rmail-show-message rmail-total-messages)) (defun rmail-what-message () (let ((where (point)) (low 1) (high rmail-total-messages) (mid (/ rmail-total-messages 2))) (while (> (- high low) 1) (if (>= where (rmail-msgbeg mid)) (setq low mid) (setq high mid)) (setq mid (+ low (/ (- high low) 2)))) (if (>= where (rmail-msgbeg high)) high low))) (defun rmail-message-recipients-p (msg recipients &optional primary-only) (save-restriction (goto-char (rmail-msgbeg msg)) (search-forward "\n*** EOOH ***\n") (narrow-to-region (point) (progn (search-forward "\n\n") (point))) (or (string-match recipients (or (mail-fetch-field "To") "")) (string-match recipients (or (mail-fetch-field "From") "")) (if (not primary-only) (string-match recipients (or (mail-fetch-field "Cc") "")))))) (defun rmail-message-regexp-p (msg regexp) "Return t, if for message number MSG, regexp REGEXP matches in the header." (goto-char (rmail-msgbeg msg)) (let ((end (save-excursion (search-forward "*** EOOH ***" (point-max)) (point)))) (re-search-forward regexp end t))) (defvar rmail-search-last-regexp nil) (defun rmail-search (regexp &optional n) "Show message containing next match for REGEXP. Prefix argument gives repeat count; negative argument means search backwards (through earlier messages). Interactively, empty argument means use same regexp used last time." (interactive (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0)) (prompt (concat (if reversep "Reverse " "") "Rmail search (regexp): ")) regexp) (if rmail-search-last-regexp (setq prompt (concat prompt "(default " rmail-search-last-regexp ") "))) (setq regexp (read-string prompt)) (cond ((not (equal regexp "")) (setq rmail-search-last-regexp regexp)) ((not rmail-search-last-regexp) (error "No previous Rmail search string"))) (list rmail-search-last-regexp (prefix-numeric-value current-prefix-arg)))) (or n (setq n 1)) (message "%sRmail search for %s..." (if (< n 0) "Reverse " "") regexp) (rmail-maybe-set-message-counters) (let ((omin (point-min)) (omax (point-max)) (opoint (point)) win (reversep (< n 0)) (msg rmail-current-message)) (unwind-protect (progn (widen) (while (/= n 0) ;; Check messages one by one, advancing message number up or down ;; but searching forward through each message. (if reversep (while (and (null win) (> msg 1)) (goto-char (rmail-msgbeg (setq msg (1- msg)))) (setq win (re-search-forward regexp (rmail-msgend msg) t))) (while (and (null win) (< msg rmail-total-messages)) (goto-char (rmail-msgbeg (setq msg (1+ msg)))) (setq win (re-search-forward regexp (rmail-msgend msg) t)))) (setq n (+ n (if reversep 1 -1))))) (if win (progn ;; If this is a reverse search and we found a message, ;; search backward thru this message to position point. (if reversep (progn (goto-char (rmail-msgend msg)) (re-search-backward regexp (rmail-msgbeg msg) t))) (setq win (point)) (rmail-show-message msg) (message "%sRmail search for %s...done" (if reversep "Reverse " "") regexp) (goto-char win)) (goto-char opoint) (narrow-to-region omin omax) (ding) (message "Search failed: %s" regexp))))) (defun rmail-search-backwards (regexp &optional n) "Show message containing previous match for REGEXP. Prefix argument gives repeat count; negative argument means search forward (through later messages). Interactively, empty argument means use same regexp used last time." (interactive (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0)) (prompt (concat (if reversep "Reverse " "") "Rmail search (regexp): ")) regexp) (if rmail-search-last-regexp (setq prompt (concat prompt "(default " rmail-search-last-regexp ") "))) (setq regexp (read-string prompt)) (cond ((not (equal regexp "")) (setq rmail-search-last-regexp regexp)) ((not rmail-search-last-regexp) (error "No previous Rmail search string"))) (list rmail-search-last-regexp (prefix-numeric-value current-prefix-arg)))) (rmail-search regexp (- (or n 1)))) ;; Show the first message which has the `unseen' attribute. (defun rmail-first-unseen-message () (rmail-maybe-set-message-counters) (let ((current 1) found) (save-restriction (widen) (while (and (not found) (<= current rmail-total-messages)) (if (rmail-message-labels-p current ", ?\\(unseen\\),") (setq found current)) (setq current (1+ current)))) ;; Let the caller show the message. ;; (if found ;; (rmail-show-message found)) found)) (defun rmail-next-same-subject (n) "Go to the next mail message having the same subject header. With prefix argument N, do this N times. If N is negative, go backwards instead." (interactive "p") (let* ((subject (mail-fetch-field "Subject")) (search-regexp (concat "^Subject: *\\(Re: *\\)?" (regexp-quote subject) "\n")) (forward (> n 0)) (i rmail-current-message) found) (if (string-match "Re:[ \t]*" subject) (setq subject (substring subject (match-end 0)))) (save-excursion (save-restriction (widen) (while (and (/= n 0) (if forward (< i rmail-total-messages) (> i 1))) (let (done) (while (and (not done) (if forward (< i rmail-total-messages) (> i 1))) (setq i (if forward (1+ i) (1- i))) (goto-char (rmail-msgbeg i)) (search-forward "\n*** EOOH ***\n") (let ((beg (point)) end) (search-forward "\n\n") (setq end (point)) (goto-char beg) (setq done (re-search-forward search-regexp end t)))) (if done (setq found i))) (setq n (if forward (1- n) (1+ n)))))) (if found (rmail-show-message found) (error "No %s message with same subject" (if forward "following" "previous"))))) (defun rmail-previous-same-subject (n) "Go to the previous mail message having the same subject header. With prefix argument N, do this N times. If N is negative, go forwards instead." (interactive "p") (rmail-next-same-subject (- n))) ;;;; *** Rmail Message Deletion Commands *** (defun rmail-message-deleted-p (n) (= (aref rmail-deleted-vector n) ?D)) (defun rmail-set-message-deleted-p (n state) (aset rmail-deleted-vector n (if state ?D ?\ ))) (defun rmail-delete-message () "Delete this message and stay on it." (interactive) (rmail-set-attribute "deleted" t) (run-hooks 'rmail-delete-message-hook)) (defun rmail-undelete-previous-message () "Back up to deleted message, select it, and undelete it." (interactive) (let ((msg rmail-current-message)) (while (and (> msg 0) (not (rmail-message-deleted-p msg))) (setq msg (1- msg))) (if (= msg 0) (error "No previous deleted message") (if (/= msg rmail-current-message) (rmail-show-message msg)) (rmail-set-attribute "deleted" nil) (if (rmail-summary-exists) (save-excursion (set-buffer rmail-summary-buffer) (rmail-summary-mark-undeleted msg))) (rmail-maybe-display-summary)))) (defun rmail-delete-forward (&optional backward) "Delete this message and move to next nondeleted one. Deleted messages stay in the file until the \\[rmail-expunge] command is given. With prefix argument, delete and move backward. Returns t if a new message is displayed after the delete, or nil otherwise." (interactive "P") (rmail-set-attribute "deleted" t) (run-hooks 'rmail-delete-message-hook) (let ((del-msg rmail-current-message)) (if (rmail-summary-exists) (rmail-select-summary (rmail-summary-mark-deleted del-msg))) (prog1 (rmail-next-undeleted-message (if backward -1 1)) (rmail-maybe-display-summary)))) (defun rmail-delete-backward () "Delete this message and move to previous nondeleted one. Deleted messages stay in the file until the \\[rmail-expunge] command is given." (interactive) (rmail-delete-forward t)) ;; Compute the message number a given message would have after expunging. ;; The present number of the message is OLDNUM. ;; DELETEDVEC should be rmail-deleted-vector. ;; The value is nil for a message that would be deleted. (defun rmail-msg-number-after-expunge (deletedvec oldnum) (if (or (null oldnum) (= (aref deletedvec oldnum) ?D)) nil (let ((i 0) (newnum 0)) (while (< i oldnum) (if (/= (aref deletedvec i) ?D) (setq newnum (1+ newnum))) (setq i (1+ i))) newnum))) (defun rmail-only-expunge () "Actually erase all deleted messages in the file." (interactive) (message "Expunging deleted messages...") ;; Discard all undo records for this buffer. (or (eq buffer-undo-list t) (setq buffer-undo-list nil)) (rmail-maybe-set-message-counters) (let* ((omax (- (buffer-size) (point-max))) (omin (- (buffer-size) (point-min))) (opoint (if (and (> rmail-current-message 0) (rmail-message-deleted-p rmail-current-message)) 0 (- (point) (point-min)))) (messages-head (cons (aref rmail-message-vector 0) nil)) (messages-tail messages-head) ;; Don't make any undo records for the expunging. (buffer-undo-list t) (win)) (unwind-protect (save-excursion (widen) (goto-char (point-min)) (let ((counter 0) (number 1) (total rmail-total-messages) (new-message-number rmail-current-message) (new-summary nil) (rmailbuf (current-buffer)) (buffer-read-only nil) (messages rmail-message-vector) (deleted rmail-deleted-vector) (summary rmail-summary-vector)) (setq rmail-total-messages nil rmail-current-message nil rmail-message-vector nil rmail-deleted-vector nil rmail-summary-vector nil) ;; Find each sendmail buffer that is set to reply ;; to a message in this buffer, and update its ;; message number. (let ((bufs (buffer-list))) (while bufs (save-excursion (set-buffer (car bufs)) (and (boundp 'rmail-send-actions-rmail-buffer) (eq rmail-send-actions-rmail-buffer rmailbuf) (setq rmail-send-actions-rmail-msg-number (rmail-msg-number-after-expunge deleted rmail-send-actions-rmail-msg-number)))) (setq bufs (cdr bufs)))) (while (<= number total) (if (= (aref deleted number) ?D) (progn (delete-region (marker-position (aref messages number)) (marker-position (aref messages (1+ number)))) (move-marker (aref messages number) nil) (if (> new-message-number counter) (setq new-message-number (1- new-message-number)))) (setq counter (1+ counter)) (setq messages-tail (setcdr messages-tail (cons (aref messages number) nil))) (setq new-summary (cons (if (= counter number) (aref summary (1- number))) new-summary))) (if (zerop (% (setq number (1+ number)) 20)) (message "Expunging deleted messages...%d" number))) (setq messages-tail (setcdr messages-tail (cons (aref messages number) nil))) (setq rmail-current-message new-message-number rmail-total-messages counter rmail-message-vector (apply 'vector messages-head) rmail-deleted-vector (make-string (1+ counter) ?\ ) rmail-summary-vector (vconcat (nreverse new-summary)) win t))) (message "Expunging deleted messages...done") (if (not win) (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))) (rmail-show-message (if (zerop rmail-current-message) 1 nil)) (forward-char opoint)))) (defun rmail-expunge () "Erase deleted messages from Rmail file and summary buffer." (interactive) (rmail-only-expunge) (if (rmail-summary-exists) (rmail-select-summary (rmail-update-summary)))) ;;;; *** Rmail Mailing Commands *** (defun rmail-start-mail (&rest args) (if (and window-system rmail-mail-new-frame) (prog1 (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. While composing the message, use \\[mail-yank-original] to yank the 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) "Reply to the current message. Normally include CC: to all other recipients of original message; prefix argument means ignore them. While composing the reply, use \\[mail-yank-original] to yank the original message into it." (interactive "P") (let (from reply-to cc subject date to message-id resent-reply-to (msgnum rmail-current-message) (rmail-buffer (current-buffer))) (save-excursion (save-restriction (widen) (goto-char (rmail-msgbeg rmail-current-message)) (forward-line 1) (if (= (following-char) ?0) (narrow-to-region (progn (forward-line 2) (point)) (progn (search-forward "\n\n" (rmail-msgend rmail-current-message) 'move) (point))) (narrow-to-region (point) (progn (search-forward "\n*** EOOH ***\n") (beginning-of-line) (point)))) (setq resent-reply-to (mail-fetch-field "resent-reply-to" t) from (mail-fetch-field "from") reply-to (or resent-reply-to (mail-fetch-field "reply-to" nil t) from) cc (cond (just-sender nil) (resent-reply-to (mail-fetch-field "resent-cc" t)) (t (mail-fetch-field "cc" nil t))) subject (or (and resent-reply-to (mail-fetch-field "resent-subject" t)) (mail-fetch-field "subject")) date (or (and resent-reply-to (mail-fetch-field "resent-date" t)) (mail-fetch-field "date")) to (cond (resent-reply-to (or (mail-fetch-field "resent-to" t)) "") ((mail-fetch-field "to" nil t)) ;((mail-fetch-field "apparently-to")) ack gag barf (t "")) message-id (cond (resent-reply-to (mail-fetch-field "resent-message-id" t)) ((mail-fetch-field "message-id")))))) (and (stringp subject) (setq subject (concat rmail-reply-prefix (if (string-match rmail-reply-regexp subject) (substring subject (match-end 0)) subject)))) (rmail-start-mail nil (mail-strip-quoted-names reply-to) subject (rmail-make-in-reply-to-field from date message-id) (if just-sender nil (let* ((cc-list (rmail-dont-reply-to (mail-strip-quoted-names (if (null cc) to (concat to ", " cc)))))) (if (string= cc-list "") nil cc-list))) (current-buffer) (list (list '(lambda () (let ((msgnum rmail-send-actions-rmail-msg-number)) (save-excursion (set-buffer rmail-send-actions-rmail-buffer) (if msgnum (rmail-set-attribute "answered" t msgnum)))))))) ;; We keep the rmail buffer and message number in these ;; buffer-local vars in the sendmail buffer, ;; so that rmail-only-expunge can relocate the message number. (make-local-variable 'rmail-send-actions-rmail-buffer) (make-local-variable 'rmail-send-actions-rmail-msg-number) (setq rmail-send-actions-rmail-buffer rmail-buffer) (setq rmail-send-actions-rmail-msg-number msgnum))) (defun rmail-make-in-reply-to-field (from date message-id) (cond ((not from) (if message-id message-id nil)) (mail-use-rfc822 (require 'rfc822) (let ((tem (car (rfc822-addresses from)))) (if message-id (if (string-match (regexp-quote (if (string-match "@[^@]*\\'" tem) (substring tem 0 (match-beginning 0)) tem)) message-id) ;; Message-ID is sufficiently informative message-id (concat message-id " (" tem ")")) ;; Copy TEM, discarding text properties. (setq tem (copy-sequence tem)) (set-text-properties 0 (length tem) nil tem) (setq tem (copy-sequence tem)) ;; Use prin1 to fake RFC822 quoting (let ((field (prin1-to-string tem))) (if date (concat field "'s message of " date) field))))) ((let* ((foo "[^][\000-\037\177-\377()<>@,;:\\\" ]+") (bar "[^][\000-\037\177-\377()<>@,;:\\\"]+")) ;; Can't use format because format loses on \000 (unix *^&%*^&%$!!) (or (string-match (concat "\\`[ \t]*\\(" bar "\\)\\(<" foo "@" foo ">\\)?[ \t]*\\'") ;; "Unix Loser " => "Unix Loser" from) (string-match (concat "\\`[ \t]*<" foo "@" foo ">[ \t]*(\\(" bar "\\))[ \t]*\\'") ;; "" (Losing Unix) => "Losing Unix" from))) (let ((start (match-beginning 1)) (end (match-end 1))) ;; Trim whitespace which above regexp match allows (while (and (< start end) (memq (aref from start) '(?\t ?\ ))) (setq start (1+ start))) (while (and (< start end) (memq (aref from (1- end)) '(?\t ?\ ))) (setq end (1- end))) (let ((field (substring from start end))) (if date (setq field (concat "message from " field " on " date))) (if message-id ;; " (message from Unix Loser on 1-Apr-89)" (concat message-id " (" field ")") field)))) (t ;; If we can't kludge it simply, do it correctly (let ((mail-use-rfc822 t)) (rmail-make-in-reply-to-field from date message-id))))) (defun rmail-forward (resend) "Forward the current message to another user. With prefix argument, \"resend\" the message instead of forwarding it; see the documentation of `rmail-resend'." (interactive "P") (if resend (call-interactively 'rmail-resend) (let ((forward-buffer (current-buffer)) (msgnum rmail-current-message) (subject (concat "[" (let ((from (or (mail-fetch-field "From") (mail-fetch-field ">From")))) (if from (concat (mail-strip-quoted-names from) ": ") "")) (or (mail-fetch-field "Subject") "") "]"))) ;; If only one window, use it for the mail buffer. ;; Otherwise, use another window for the mail buffer ;; so that the Rmail buffer remains visible ;; and sending the mail will get back to it. (if (funcall (if (and (not rmail-mail-new-frame) (one-window-p t)) (function mail) (function rmail-start-mail)) nil nil subject nil nil nil (list (list (function (lambda () (let ((msgnum rmail-send-actions-rmail-msg-number)) (save-excursion (set-buffer rmail-send-actions-rmail-buffer) (if msgnum (rmail-set-attribute "forwarded" t msgnum))))))))) ;; The mail buffer is now current. (save-excursion ;; We keep the rmail buffer and message number in these ;; buffer-local vars in the sendmail buffer, ;; so that rmail-only-expunge can relocate the message number. (make-local-variable 'rmail-send-actions-rmail-buffer) (make-local-variable 'rmail-send-actions-rmail-msg-number) (setq rmail-send-actions-rmail-buffer forward-buffer) (setq rmail-send-actions-rmail-msg-number msgnum) ;; Insert after header separator--before signature if any. (goto-char (point-min)) (search-forward-regexp (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) (insert "------- Start of forwarded message -------\n") (insert-buffer-substring forward-buffer) (insert "------- End of forwarded message -------\n") (push-mark)))))) (defun rmail-resend (address &optional from comment mail-alias-file) "Resend current message to ADDRESSES. ADDRESSES should be a single address, a string consisting of several addresses separated by commas, or a list of addresses. Optional FROM is the address to resend the message from, and defaults to the username of the person redistributing the message. Optional COMMENT is a string that will be inserted as a comment in the resent message. Optional ALIAS-FILE is alternate aliases file to be used by sendmail, typically for purposes of moderating a list." (interactive "sResend to: ") (require 'sendmail) (require 'mailalias) (if (not from) (setq from (user-login-name))) (let ((tembuf (generate-new-buffer " sendmail temp")) (mail-header-separator "") (case-fold-search nil) (mailbuf (current-buffer))) (unwind-protect (save-excursion ;;>> Copy message into temp buffer (set-buffer tembuf) (insert-buffer-substring mailbuf) (goto-char (point-min)) ;; Delete any Sender field, since that's not specifyable. ; Only delete Sender fields in the actual header. (re-search-forward "^$" nil 'move) ; Using "while" here rather than "if" because some buggy mail ; software may have inserted multiple Sender fields. (while (re-search-backward "^Sender:" nil t) (let (beg) (setq beg (point)) (forward-line 1) (while (looking-at "[ \t]") (forward-line 1)) (delete-region beg (point)))) ; Go back to the beginning of the buffer so the Resent- fields ; are inserted there. (goto-char (point-min)) ;;>> 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))) (if mail-self-blind (insert "Resent-Bcc: " (user-login-name) "\n")) (insert "Resent-To: " (if (stringp address) address (mapconcat 'identity address ",\n\t")) "\n") ;; Expand abbrevs in the recipients. (save-excursion (if (featurep 'mailabbrev) (let ((end (point-marker)) (local-abbrev-table mail-abbrevs) (old-syntax-table (syntax-table))) (if (and (not (vectorp mail-abbrevs)) (file-exists-p mail-personal-alias-file)) (build-mail-abbrevs)) (set-syntax-table mail-abbrev-syntax-table) (goto-char before) (while (and (< (point) end) (progn (forward-word 1) (<= (point) end))) (expand-abbrev)) (set-syntax-table old-syntax-table)) (expand-mail-aliases before (point))))) ;;>> Set up comment, if any. (if (and (sequencep comment) (not (zerop (length comment)))) (let ((before (point)) after) (insert comment) (or (eolp) (insert "\n")) (setq after (point)) (goto-char before) (while (< (point) after) (insert "Resent-Comment: ") (forward-line 1)))) ;; Don't expand aliases in the destination fields ;; of the original message. (let (mail-aliases) (funcall send-mail-function))) (kill-buffer tembuf)) (rmail-set-attribute "resent" t rmail-current-message))) (defvar mail-unsent-separator (concat "^ *---+ +Unsent message follows +---+ *$\\|" "^ *---+ +Returned message +---+ *$\\|" "^Start of returned message$\\|" "^ *---+ +Original message +---+ *$\\|" "^ *--+ +begin message +--+ *$\\|" "^ *---+ +Original message follows +---+ *$\\|" "^|? *---+ +Message text follows: +---+ *|?$") "A regexp that matches the separator before the text of a failed message.") (defun rmail-retry-failure () "Edit a mail message which is based on the contents of the current message. For a message rejected by the mail system, extract the interesting headers and the body of the original message. The variable `mail-unsent-separator' should match the string that delimits the returned original message. The variable `rmail-retry-ignored-headers' is a regular expression specifying headers which should not be copied into the new message." (interactive) (require 'mail-utils) (let (mail-buffer bounce-start bounce-end bounce-indent resending) (save-excursion ;; Narrow down to just the quoted original message (rmail-beginning-of-message) (let ((case-fold-search t)) (if (search-forward "This is a MIME-encapsulated message\n\n--" nil t) (let ((codestring (buffer-substring (progn (beginning-of-line) (point)) (progn (end-of-line) (point))))) (re-search-forward mail-unsent-separator) (setq mail-buffer (current-buffer)) (search-forward codestring) (or (search-forward "\n\n" nil t) (error "Cannot find end of Mime data in failed message")) (setq bounce-start (point)) (save-excursion (goto-char (point-max)) (search-backward codestring) (setq bounce-end (point))) (or (search-forward "\n\n" nil t) (error "Cannot find end of header in failed message"))) (or (re-search-forward mail-unsent-separator nil t) (error "Cannot parse this as a failure message")) (skip-chars-forward "\n") ;; Support a style of failure message in which the original ;; message is indented, and included within lines saying ;; `Start of returned message' and `End of returned message'. (if (looking-at " +Received:") (progn (setq bounce-start (point)) (skip-chars-forward " ") (setq bounce-indent (- (current-column))) (goto-char (point-max)) (re-search-backward "^End of returned message$" nil t) (setq bounce-end (point))) ;; One message contained a few random lines before the old ;; message header. The first line of the message started with ;; two hyphens. A blank line follows these random lines. (if (looking-at "^--") (progn (search-forward "\n\n") (skip-chars-forward "\n"))) (setq bounce-start (point) bounce-end (point-max)) (or (search-forward "\n\n" nil t) (error "Cannot find end of header in failed message"))) (setq mail-buffer (current-buffer))))) ;; Start sending a new message; default header fields from the original. ;; Turn off the usual actions for initializing the message body ;; because we want to get only the text from the failure message. (let (mail-signature mail-setup-hook) (if (rmail-start-mail nil nil nil nil nil mail-buffer) ;; Insert original text as initial text of new draft message. (progn (erase-buffer) (insert-buffer-substring mail-buffer bounce-start bounce-end) (goto-char (point-min)) (if bounce-indent (indent-rigidly (point-min) (point-max) bounce-indent)) (rmail-clear-headers rmail-retry-ignored-headers) (rmail-clear-headers "^sender:\\|^from:\\|^return-path:") (goto-char (point-min)) (save-restriction (search-forward "\n\n") (forward-line -1) (narrow-to-region (point-min) (point)) (setq resending (mail-fetch-field "resent-to")) (if mail-self-blind (if resending (insert "Resent-Bcc: " (user-login-name) "\n") (insert "BCC: " (user-login-name) "\n")))) (insert mail-header-separator) (mail-position-on-field (if resending "Resent-To" "To") t) (set-buffer mail-buffer) (rmail-beginning-of-message)))))) (defun rmail-summary-exists () "Non-nil iff in an RMAIL buffer and an associated summary buffer exists. In fact, the non-nil value returned is the summary buffer itself." (and rmail-summary-buffer (buffer-name rmail-summary-buffer) rmail-summary-buffer)) (defun rmail-summary-displayed () "t iff in RMAIL buffer and an associated summary buffer is displayed." (and rmail-summary-buffer (get-buffer-window rmail-summary-buffer))) (defvar rmail-redisplay-summary nil "*Non-nil means Rmail should show the summary when it changes. This has an effect only if a summary buffer exists.") (defvar rmail-summary-window-size nil "*Non-nil means specify the height for an Rmail summary window.") ;; Put the summary buffer back on the screen, if user wants that. (defun rmail-maybe-display-summary () (let ((selected (selected-window)) window) ;; If requested, make sure the summary is displayed. (and rmail-summary-buffer (buffer-name rmail-summary-buffer) rmail-redisplay-summary (if (get-buffer-window rmail-summary-buffer 0) ;; It's already in some frame; show that one. (let ((frame (window-frame (get-buffer-window rmail-summary-buffer 0)))) (make-frame-visible frame) (raise-frame frame)) (display-buffer rmail-summary-buffer))) ;; If requested, set the height of the summary window. (and rmail-summary-buffer (buffer-name rmail-summary-buffer) rmail-summary-window-size (setq window (get-buffer-window rmail-summary-buffer)) ;; Don't try to change the size if just one window in frame. (not (eq window (frame-root-window (window-frame window)))) (unwind-protect (progn (select-window window) (enlarge-window (- rmail-summary-window-size (window-height)))) (select-window selected))))) ;;;; *** Rmail Specify Inbox Files *** (autoload 'set-rmail-inbox-list "rmailmsc" "Set the inbox list of the current RMAIL file to FILE-NAME. This may be a list of file names separated by commas. If FILE-NAME is empty, remove any inbox list." t) ;;;; *** Rmail Commands for Labels *** (autoload 'rmail-add-label "rmailkwd" "Add LABEL to labels associated with current RMAIL message. Completion is performed over known labels when reading." t) (autoload 'rmail-kill-label "rmailkwd" "Remove LABEL from labels associated with current RMAIL message. Completion is performed over known labels when reading." t) (autoload 'rmail-next-labeled-message "rmailkwd" "Show next message with LABEL. Defaults to last label used. With prefix argument N moves forward N messages with this label." t) (autoload 'rmail-previous-labeled-message "rmailkwd" "Show previous message with LABEL. Defaults to last label used. With prefix argument N moves backward N messages with this label." t) (autoload 'rmail-read-label "rmailkwd" "PROMPT and read with completion an Rmail message label." t) ;;;; *** Rmail Edit Mode *** (autoload 'rmail-edit-current-message "rmailedit" "Edit the contents of the current message" t) ;;;; *** Rmail Sorting *** (autoload 'rmail-sort-by-date "rmailsort" "Sort messages of current Rmail file by date. If prefix argument REVERSE is non-nil, sort them in reverse order." t) (autoload 'rmail-sort-by-subject "rmailsort" "Sort messages of current Rmail file by subject. If prefix argument REVERSE is non-nil, sort them in reverse order." t) (autoload 'rmail-sort-by-author "rmailsort" "Sort messages of current Rmail file by author. If prefix argument REVERSE is non-nil, sort them in reverse order." t) (autoload 'rmail-sort-by-recipient "rmailsort" "Sort messages of current Rmail file by recipient. If prefix argument REVERSE is non-nil, sort them in reverse order." t) (autoload 'rmail-sort-by-correspondent "rmailsort" "Sort messages of current Rmail file by other correspondent. If prefix argument REVERSE is non-nil, sort them in reverse order." t) (autoload 'rmail-sort-by-lines "rmailsort" "Sort messages of current Rmail file by number of lines. If prefix argument REVERSE is non-nil, sort them in reverse order." t) (autoload 'rmail-sort-by-keywords "rmailsort" "Sort messages of current Rmail file by labels. If prefix argument REVERSE is non-nil, sort them in reverse order. KEYWORDS is a comma-separated list of labels." t) ;;;; *** Rmail Summary Mode *** (autoload 'rmail-summary "rmailsum" "Display a summary of all messages, one line per message." t) (autoload 'rmail-summary-by-labels "rmailsum" "Display a summary of all messages with one or more LABELS. LABELS should be a string containing the desired labels, separated by commas." t) (autoload 'rmail-summary-by-recipients "rmailsum" "Display a summary of all messages with the given RECIPIENTS. Normally checks the To, From and Cc fields of headers; but if PRIMARY-ONLY is non-nil (prefix arg given), only look in the To and From fields. RECIPIENTS is a string of regexps separated by commas." t) (autoload 'rmail-summary-by-regexp "rmailsum" "Display a summary of all messages according to regexp REGEXP. If the regular expression is found in the header of the message \(including in the date and other lines, as well as the subject line), Emacs will list the header line in the RMAIL-summary." t) (autoload 'rmail-summary-by-topic "rmailsum" "Display a summary of all messages with the given SUBJECT. Normally checks the Subject field of headers; but if WHOLE-MESSAGE is non-nil (prefix arg given), look in the whole message. SUBJECT is a string of regexps separated by commas." t) (autoload 'rmail-summary-by-sender "rmailsum" "Display a summary of all messages with the given SENDERS. SENDERS is a string of names separated by commas." t) ;;;; *** Rmail output messages to files *** (autoload 'rmail-output-to-rmail-file "rmailout" "Append the current message to an Rmail file named FILE-NAME. If the file does not exist, ask if it should be created. If file is being visited, the message is appended to the Emacs buffer visiting that file." t) (autoload 'rmail-output "rmailout" "Append this message to Unix mail file named FILE-NAME." t) ;;;; *** Rmail undigestification *** (autoload 'undigestify-rmail-message "undigest" "Break up a digest message into its constituent messages. Leaves original message, deleted, before the undigestified messages." t) (provide 'rmail) ;;; rmail.el ends here emacs-19.30/lisp/rmailedit.el100444 75424 12 10074 5747265035 14466 0ustar kwzhstaff;;; rmailedit.el --- "RMAIL edit mode" Edit the current message. ;; Copyright (C) 1985, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (require 'rmail) (defvar rmail-edit-map nil) (if rmail-edit-map nil ;; Make a keymap that inherits text-mode-map. (setq rmail-edit-map (nconc (make-sparse-keymap) text-mode-map)) (define-key rmail-edit-map "\C-c\C-c" 'rmail-cease-edit) (define-key rmail-edit-map "\C-c\C-]" 'rmail-abort-edit)) ;; Rmail Edit mode is suitable only for specially formatted data. (put 'rmail-edit-mode 'mode-class 'special) (defun rmail-edit-mode () "Major mode for editing the contents of an RMAIL message. The editing commands are the same as in Text mode, together with two commands to return to regular RMAIL: * rmail-abort-edit cancels the changes you have made and returns to RMAIL * rmail-cease-edit makes them permanent. \\{rmail-edit-map}" (use-local-map rmail-edit-map) (setq major-mode 'rmail-edit-mode) (setq mode-name "RMAIL Edit") (if (boundp 'mode-line-modified) (setq mode-line-modified (default-value 'mode-line-modified)) (setq mode-line-format (default-value 'mode-line-format))) (if (rmail-summary-exists) (save-excursion (set-buffer rmail-summary-buffer) (rmail-summary-disable))) (run-hooks 'text-mode-hook 'rmail-edit-mode-hook)) (defun rmail-edit-current-message () "Edit the contents of this message." (interactive) (rmail-edit-mode) (make-local-variable 'rmail-old-text) (setq rmail-old-text (buffer-substring (point-min) (point-max))) (setq buffer-read-only nil) (force-mode-line-update) (if (and (eq (key-binding "\C-c\C-c") 'rmail-cease-edit) (eq (key-binding "\C-c\C-]") 'rmail-abort-edit)) (message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort") (message (substitute-command-keys "Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort")))) (defun rmail-cease-edit () "Finish editing message; switch back to Rmail proper." (interactive) (if (rmail-summary-exists) (save-excursion (set-buffer rmail-summary-buffer) (rmail-summary-enable))) ;; Make sure buffer ends with a newline. (save-excursion (goto-char (point-max)) (if (/= (preceding-char) ?\n) (insert "\n")) ;; Adjust the marker that points to the end of this message. (set-marker (aref rmail-message-vector (1+ rmail-current-message)) (point))) (let ((old rmail-old-text)) (force-mode-line-update) (rmail-mode-1) (if (and (= (length old) (- (point-max) (point-min))) (string= old (buffer-substring (point-min) (point-max)))) () (setq old nil) (rmail-set-attribute "edited" t) (if (boundp 'rmail-summary-vector) (progn (aset rmail-summary-vector (1- rmail-current-message) nil) (save-excursion (rmail-widen-to-current-msgbeg (function (lambda () (forward-line 2) (if (looking-at "Summary-line: ") (let ((buffer-read-only nil)) (delete-region (point) (progn (forward-line 1) (point)))))))) (rmail-show-message)))))) (setq buffer-read-only t)) (defun rmail-abort-edit () "Abort edit of current message; restore original contents." (interactive) (delete-region (point-min) (point-max)) (insert rmail-old-text) (rmail-cease-edit) (rmail-highlight-headers)) ;;; rmailedit.el ends here emacs-19.30/lisp/rmailkwd.el100444 75424 1 22147 5745600013 14433 0ustar kwzhdaemon;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs. ;; Copyright (C) 1985, 1988, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;; Global to all RMAIL buffers. It exists primarily for the sake of ;; completion. It is better to use strings with the label functions ;; and let them worry about making the label. (defvar rmail-label-obarray (make-vector 47 0)) ;; Named list of symbols representing valid message attributes in RMAIL. (defconst rmail-attributes (cons 'rmail-keywords (mapcar (function (lambda (s) (intern s rmail-label-obarray))) '("deleted" "answered" "filed" "forwarded" "unseen" "edited" "resent")))) (defconst rmail-deleted-label (intern "deleted" rmail-label-obarray)) ;; Named list of symbols representing valid message keywords in RMAIL. (defvar rmail-keywords nil) (defun rmail-add-label (string) "Add LABEL to labels associated with current RMAIL message. Completion is performed over known labels when reading." (interactive (list (rmail-read-label "Add label"))) (rmail-set-label string t)) (defun rmail-kill-label (string) "Remove LABEL from labels associated with current RMAIL message. Completion is performed over known labels when reading." (interactive (list (rmail-read-label "Remove label"))) (rmail-set-label string nil)) (defun rmail-read-label (prompt) (if (not rmail-keywords) (rmail-parse-file-keywords)) (let ((result (completing-read (concat prompt (if rmail-last-label (concat " (default " (symbol-name rmail-last-label) "): ") ": ")) rmail-label-obarray nil nil))) (if (string= result "") rmail-last-label (setq rmail-last-label (rmail-make-label result t))))) (defun rmail-set-label (l state &optional n) (rmail-maybe-set-message-counters) (if (not n) (setq n rmail-current-message)) (aset rmail-summary-vector (1- n) nil) (let* ((attribute (rmail-attribute-p l)) (keyword (and (not attribute) (or (rmail-keyword-p l) (rmail-install-keyword l)))) (label (or attribute keyword))) (if label (let ((omax (- (buffer-size) (point-max))) (omin (- (buffer-size) (point-min))) (buffer-read-only nil) (case-fold-search t)) (unwind-protect (save-excursion (widen) (goto-char (rmail-msgbeg n)) (forward-line 1) (if (not (looking-at "[01],")) nil (let ((start (1+ (point))) (bound)) (narrow-to-region (point) (progn (end-of-line) (point))) (setq bound (point-max)) (search-backward ",," nil t) (if attribute (setq bound (1+ (point))) (setq start (1+ (point)))) (goto-char start) ; (while (re-search-forward "[ \t]*,[ \t]*" nil t) ; (replace-match ",")) ; (goto-char start) (if (re-search-forward (concat ", " (rmail-quote-label-name label) ",") bound 'move) (if (not state) (replace-match ",")) (if state (insert " " (symbol-name label) ","))) (if (eq label rmail-deleted-label) (rmail-set-message-deleted-p n state))))) (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)) (if (= n rmail-current-message) (rmail-display-labels))))))) ;; Commented functions aren't used by RMAIL but might be nice for user ;; packages that do stuff with RMAIL. Note that rmail-message-labels-p ;; is in rmail.el now. ;(defun rmail-message-label-p (label &optional n) ; "Returns symbol if LABEL (attribute or keyword) on NTH or current message." ; (rmail-message-labels-p (or n rmail-current-message) (regexp-quote label))) ;(defun rmail-parse-message-labels (&optional n) ; "Returns labels associated with NTH or current RMAIL message. ;The result is a list of two lists of strings. The first is the ;message attributes and the second is the message keywords." ; (let (atts keys) ; (save-restriction ; (widen) ; (goto-char (rmail-msgbeg (or n rmail-current-message))) ; (forward-line 1) ; (or (looking-at "[01],") (error "Malformed label line")) ; (forward-char 2) ; (while (looking-at "[ \t]*\\([^ \t\n,]+\\),") ; (setq atts (cons (buffer-substring (match-beginning 1) (match-end 1)) ; atts)) ; (goto-char (match-end 0))) ; (or (looking-at ",") (error "Malformed label line")) ; (forward-char 1) ; (while (looking-at "[ \t]*\\([^ \t\n,]+\\),") ; (setq keys (cons (buffer-substring (match-beginning 1) (match-end 1)) ; keys)) ; (goto-char (match-end 0))) ; (or (looking-at "[ \t]*$") (error "Malformed label line")) ; (list (nreverse atts) (nreverse keys))))) (defun rmail-attribute-p (s) (let ((symbol (rmail-make-label s))) (if (memq symbol (cdr rmail-attributes)) symbol))) (defun rmail-keyword-p (s) (let ((symbol (rmail-make-label s))) (if (memq symbol (cdr (rmail-keywords))) symbol))) (defun rmail-make-label (s &optional forcep) (cond ((symbolp s) s) (forcep (intern (downcase s) rmail-label-obarray)) (t (intern-soft (downcase s) rmail-label-obarray)))) (defun rmail-force-make-label (s) (intern (downcase s) rmail-label-obarray)) (defun rmail-quote-label-name (label) (regexp-quote (symbol-name (rmail-make-label label t)))) ;; Motion on messages with keywords. (defun rmail-previous-labeled-message (n labels) "Show previous message with one of the labels LABELS. LABELS should be a comma-separated list of label names. If LABELS is empty, the last set of labels specified is used. With prefix argument N moves backward N messages with these labels." (interactive "p\nsMove to previous msg with labels: ") (rmail-next-labeled-message (- n) labels)) (defun rmail-next-labeled-message (n labels) "Show next message with one of the labels LABELS. LABELS should be a comma-separated list of label names. If LABELS is empty, the last set of labels specified is used. With prefix argument N moves forward N messages with these labels." (interactive "p\nsMove to next msg with labels: ") (if (string= labels "") (setq labels rmail-last-multi-labels)) (or labels (error "No labels to find have been specified previously")) (setq rmail-last-multi-labels labels) (rmail-maybe-set-message-counters) (let ((lastwin rmail-current-message) (current rmail-current-message) (regexp (concat ", ?\\(" (mail-comma-list-regexp labels) "\\),"))) (save-restriction (widen) (while (and (> n 0) (< current rmail-total-messages)) (setq current (1+ current)) (if (rmail-message-labels-p current regexp) (setq lastwin current n (1- n)))) (while (and (< n 0) (> current 1)) (setq current (1- current)) (if (rmail-message-labels-p current regexp) (setq lastwin current n (1+ n))))) (rmail-show-message lastwin) (if (< n 0) (message "No previous message with labels %s" labels)) (if (> n 0) (message "No following message with labels %s" labels)))) ;;; Manipulate the file's Labels option. ;; Return a list of symbols for all ;; the keywords (labels) recorded in this file's Labels option. (defun rmail-keywords () (or rmail-keywords (rmail-parse-file-keywords))) ;; Set rmail-keywords to a list of symbols for all ;; the keywords (labels) recorded in this file's Labels option. (defun rmail-parse-file-keywords () (save-restriction (save-excursion (widen) (goto-char 1) (setq rmail-keywords (if (search-forward "\nLabels:" (rmail-msgbeg 1) t) (progn (narrow-to-region (point) (progn (end-of-line) (point))) (goto-char (point-min)) (cons 'rmail-keywords (mapcar 'rmail-force-make-label (mail-parse-comma-list))))))))) ;; Add WORD to the list in the file's Labels option. ;; Any keyword used for the first time needs this done. (defun rmail-install-keyword (word) (let ((keyword (rmail-make-label word t)) (keywords (rmail-keywords))) (if (not (or (rmail-attribute-p keyword) (rmail-keyword-p keyword))) (let ((omin (- (buffer-size) (point-min))) (omax (- (buffer-size) (point-max)))) (unwind-protect (save-excursion (widen) (goto-char 1) (let ((case-fold-search t) (buffer-read-only nil)) (or (search-forward "\nLabels:" nil t) (progn (end-of-line) (insert "\nLabels:"))) (delete-region (point) (progn (end-of-line) (point))) (setcdr keywords (cons keyword (cdr keywords))) (while (setq keywords (cdr keywords)) (insert (symbol-name (car keywords)) ",")) (delete-char -1))) (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))))) keyword)) ;;; rmailkwd.el ends here emacs-19.30/lisp/rmailmsc.el100444 12120 1 3561 5633151035 14206 0ustar rmsdaemon;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (defun set-rmail-inbox-list (file-name) "Set the inbox list of the current RMAIL file to FILE-NAME. You can specify one file name, or several names separated by commas. If FILE-NAME is empty, remove any existing inbox list." (interactive "sSet mailbox list to (comma-separated list of filenames): ") (save-excursion (let ((names (rmail-parse-file-inboxes)) (standard-output nil)) (if (or (not names) (y-or-n-p (concat "Replace " (mapconcat 'identity names ", ") "? "))) (let ((buffer-read-only nil)) (widen) (goto-char (point-min)) (search-forward "\n\^_") (re-search-backward "^Mail" nil t) (forward-line 0) (if (looking-at "Mail:") (delete-region (point) (progn (forward-line 1) (point)))) (if (not (string= file-name "")) (insert-before-markers "Mail: " file-name "\n")))))) (setq rmail-inbox-list (rmail-parse-file-inboxes)) (rmail-show-message rmail-current-message)) ;;; rmailmsc.el ends here emacs-19.30/lisp/rmailout.el100444 12120 24 27423 6030344371 13116 0ustar rms;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file. ;; Copyright (C) 1985, 1987, 1993, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (require 'rmail) ;; Temporary until Emacs always has this variable. (defvar rmail-delete-after-output nil "*Non-nil means automatically delete a message that is copied to a file.") (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). The suggestion is taken if REGEXP matches anywhere in the message buffer. 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 ;;; them out before you change the calling method. (defun rmail-output-to-rmail-file (file-name &optional count) "Append the current message to an Rmail file named FILE-NAME. If the file does not exist, ask if it should be created. 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. The default file name comes from `rmail-default-rmail-file', which is updated to the name you use in this command. A prefix argument N says to output N consecutive messages starting with the current one. Deleted messages are skipped and don't count." (interactive (let ((default-file (let (answer tail) (setq tail rmail-output-file-alist) ;; Suggest a file based on a pattern match. (while (and tail (not answer)) (save-excursion (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. (or answer rmail-default-rmail-file)))) (list (setq rmail-default-rmail-file (let ((read-file (read-file-name (concat "Output message to Rmail file: (default " (file-name-nondirectory default-file) ") ") (file-name-directory default-file) default-file))) (if (file-directory-p read-file) (expand-file-name (file-name-nondirectory default-file) read-file) (expand-file-name (or read-file default-file) (file-name-directory default-file))))) (prefix-numeric-value current-prefix-arg)))) (or count (setq count 1)) (setq file-name (expand-file-name file-name (file-name-directory rmail-default-rmail-file))) (if (and (file-readable-p file-name) (not (mail-file-babyl-p file-name))) (rmail-output file-name count) (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 ;; Temporarily turn off Deleted attribute. ;; Do this outside the save-restriction, since it would ;; shift the place in the buffer where the visible text starts. (if (rmail-message-deleted-p rmail-current-message) (progn (setq redelete t) (rmail-set-attribute "deleted" nil))) (save-restriction (widen) ;; 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) ;; Output to a file. (if rmail-fields-not-to-output ;; Delete some fields while we output. (let ((obuf (current-buffer))) (set-buffer (get-buffer-create " rmail-out-temp")) (insert-buffer-substring obuf beg end) (rmail-delete-unwanted-fields) (append-to-file (point-min) (point-max) file-name) (set-buffer obuf) (kill-buffer (get-buffer " rmail-out-temp"))) (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 ;; Turn on auto save mode, if it's off in this ;; buffer but enabled by default. (and (not buffer-auto-save-file-name) auto-save-default (auto-save-mode t)) (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-delete-unwanted-fields) (rmail-count-new-messages t) (if (rmail-summary-exists) (rmail-select-summary (rmail-update-summary))) (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-delete-unwanted-fields))))))) (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)))))) (defvar rmail-fields-not-to-output nil "*Regexp describing fields to exclude when outputting a message to a file.") ;; Delete from the buffer header fields we don't want output. ;; NOT-RMAIL if t means this buffer does not have the full header ;; and *** EOOH *** that a message in an Rmail file has. (defun rmail-delete-unwanted-fields (&optional not-rmail) (if rmail-fields-not-to-output (save-excursion (goto-char (point-min)) ;; Find the end of the header. (if (and (or not-rmail (search-forward "\n*** EOOH ***\n" nil t)) (search-forward "\n\n" nil t)) (let ((end (point-marker))) (goto-char (point-min)) (while (re-search-forward rmail-fields-not-to-output end t) (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point))))))))) ;;; There are functions elsewhere in Emacs that use this function; check ;;; them out before you change the calling method. (defun rmail-output (file-name &optional count noattribute from-gnus) "Append this message to system-inbox-format mail file named FILE-NAME. A prefix argument N says to output N consecutive messages starting with the current one. Deleted messages are skipped and don't count. When called from lisp code, N may be omitted. If the pruned message header is shown on the current message, then messages will be appended with pruned headers; otherwise, messages will be appended with their original headers. The default file name comes from `rmail-default-file', which is updated to the name you use in this command. The optional third argument NOATTRIBUTE, if non-nil, says not to set the `filed' attribute, and not to display a message. The optional fourth argument FROM-GNUS is set when called from GNUS." (interactive (let ((default-file (let (answer tail) (setq tail rmail-output-file-alist) ;; Suggest a file based on a pattern match. (while (and tail (not answer)) (save-excursion (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. (or answer rmail-default-file)))) (list (setq rmail-default-file (let ((read-file (read-file-name (concat "Output message to Unix mail file: (default " (file-name-nondirectory default-file) ") ") (file-name-directory default-file) default-file))) (if (file-directory-p read-file) (expand-file-name (file-name-nondirectory default-file) read-file) (expand-file-name (or read-file default-file) (file-name-directory default-file))))) (prefix-numeric-value current-prefix-arg)))) (or count (setq count 1)) (setq file-name (expand-file-name file-name (and rmail-default-file (file-name-directory rmail-default-file)))) (if (and (file-readable-p file-name) (mail-file-babyl-p file-name)) (rmail-output-to-rmail-file file-name count) (let ((orig-count count) (rmailbuf (current-buffer)) (case-fold-search t) (tembuf (get-buffer-create " rmail-output")) (original-headers-p (and (not from-gnus) (save-excursion (save-restriction (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) (goto-char (point-min)) (forward-line 1) (= (following-char) ?0))))) header-beginning mail-from) (while (> count 0) (or from-gnus (setq mail-from (save-excursion (save-restriction (widen) (goto-char (rmail-msgbeg rmail-current-message)) (setq header-beginning (point)) (search-forward "\n*** EOOH ***\n") (narrow-to-region header-beginning (point)) (mail-fetch-field "Mail-From"))))) (save-excursion (set-buffer tembuf) (erase-buffer) (insert-buffer-substring rmailbuf) (rmail-delete-unwanted-fields t) (insert "\n") (goto-char (point-min)) (if mail-from (insert mail-from "\n") (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.) (let ((case-fold-search nil)) (while (search-forward "\nFrom " nil t) (forward-char -5) (insert ?>))) (write-region (point-min) (point-max) file-name t (if noattribute 'nomsg))) (or noattribute (if (equal major-mode 'rmail-mode) (rmail-set-attribute "filed" t))) (setq count (1- count)) (or from-gnus (let ((next-message-p (if rmail-delete-after-output (rmail-delete-forward) (if (> count 0) (rmail-next-undeleted-message 1)))) (num-appended (- orig-count count))) (if (and next-message-p original-headers-p) (rmail-toggle-header)) (if (and (> count 0) (not next-message-p)) (progn (error (save-excursion (set-buffer rmailbuf) (format "Only %d message%s appended" num-appended (if (= num-appended 1) "" "s")))) (setq count 0)))))) (kill-buffer tembuf)))) ;;; rmailout.el ends here emacs-19.30/lisp/rmailsort.el100444 75424 13 17235 5561552117 14404 0ustar kwzhuser;;; rmailsort.el --- Rmail: sort messages. ;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Version: $Header: /gd/gnu/emacs/19.0/lisp/RCS/rmailsort.el,v 1.22 1994/05/03 22:46:37 kwzh Exp $ ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (require 'sort) (autoload 'timezone-make-date-sortable "timezone") ;; Sorting messages in Rmail buffer (defun rmail-sort-by-date (reverse) "Sort messages of current Rmail file by date. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-messages reverse (function (lambda (msg) (rmail-make-date-sortable (rmail-fetch-field msg "Date")))))) (defun rmail-sort-by-subject (reverse) "Sort messages of current Rmail file by subject. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-messages reverse (function (lambda (msg) (let ((key (or (rmail-fetch-field msg "Subject") "")) (case-fold-search t)) ;; Remove `Re:' (if (string-match "^\\(re:[ \t]*\\)*" key) (substring key (match-end 0)) key)))))) (defun rmail-sort-by-author (reverse) "Sort messages of current Rmail file by author. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-messages reverse (function (lambda (msg) (downcase ;Canonical name (mail-strip-quoted-names (or (rmail-fetch-field msg "From") (rmail-fetch-field msg "Sender") ""))))))) (defun rmail-sort-by-recipient (reverse) "Sort messages of current Rmail file by recipient. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-messages reverse (function (lambda (msg) (downcase ;Canonical name (mail-strip-quoted-names (or (rmail-fetch-field msg "To") (rmail-fetch-field msg "Apparently-To") "") )))))) (defun rmail-sort-by-correspondent (reverse) "Sort messages of current Rmail file by other correspondent. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-messages reverse (function (lambda (msg) (rmail-select-correspondent msg '("From" "Sender" "To" "Apparently-To")))))) (defun rmail-select-correspondent (msg fields) (let ((ans "")) (while (and fields (string= ans "")) (setq ans (rmail-dont-reply-to (mail-strip-quoted-names (or (rmail-fetch-field msg (car fields)) "")))) (setq fields (cdr fields))) ans)) (defun rmail-sort-by-lines (reverse) "Sort messages of current Rmail file by number of lines. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-messages reverse (function (lambda (msg) (count-lines (rmail-msgbeg msg) (rmail-msgend msg)))))) (defun rmail-sort-by-keywords (reverse labels) "Sort messages of current Rmail file by labels. If prefix argument REVERSE is non-nil, sort them in reverse order. KEYWORDS is a comma-separated list of labels." (interactive "P\nsSort by labels: ") (or (string-match "[^ \t]" labels) (error "No labels specified")) (setq labels (concat (substring labels (match-beginning 0)) ",")) (let (labelvec) (while (string-match "[ \t]*,[ \t]*" labels) (setq labelvec (cons (concat ", ?\\(" (substring labels 0 (match-beginning 0)) "\\),") labelvec)) (setq labels (substring labels (match-end 0)))) (setq labelvec (apply 'vector (nreverse labelvec))) (rmail-sort-messages reverse (function (lambda (msg) (let ((n 0)) (while (and (< n (length labelvec)) (not (rmail-message-labels-p msg (aref labelvec n)))) (setq n (1+ n))) n)))))) ;; Basic functions (defun rmail-sort-messages (reverse keyfun) "Sort messages of current Rmail file. If 1st argument REVERSE is non-nil, sort them in reverse order. 2nd argument KEYFUN is called with a message number, and should return a key." (save-excursion ;; If we are in a summary buffer, operate on the Rmail buffer. (if (eq major-mode 'rmail-summary-mode) (set-buffer rmail-buffer)) (let ((buffer-read-only nil) (predicate nil) ;< or string-lessp (sort-lists nil)) (message "Finding sort keys...") (widen) (let ((msgnum 1)) (while (>= rmail-total-messages msgnum) (setq sort-lists (cons (list (funcall keyfun msgnum) ;Make sorting key (eq rmail-current-message msgnum) ;True if current (aref rmail-message-vector msgnum) (aref rmail-message-vector (1+ msgnum))) sort-lists)) (if (zerop (% msgnum 10)) (message "Finding sort keys...%d" msgnum)) (setq msgnum (1+ msgnum)))) (or reverse (setq sort-lists (nreverse sort-lists))) ;; Decide predicate: < or string-lessp (if (numberp (car (car sort-lists))) ;Is a key numeric? (setq predicate (function <)) (setq predicate (function string-lessp))) (setq sort-lists (sort sort-lists (function (lambda (a b) (funcall predicate (car a) (car b)))))) (if reverse (setq sort-lists (nreverse sort-lists))) ;; Now we enter critical region. So, keyboard quit is disabled. (message "Reordering messages...") (let ((inhibit-quit t) ;Inhibit quit (current-message nil) (msgnum 1) (msginfo nil)) ;; There's little hope that we can easily undo after that. (buffer-disable-undo (current-buffer)) (goto-char (rmail-msgbeg 1)) ;; To force update of all markers. (insert-before-markers ?Z) (backward-char 1) ;; Now reorder messages. (while sort-lists (setq msginfo (car sort-lists)) ;; Swap two messages. (insert-buffer-substring (current-buffer) (nth 2 msginfo) (nth 3 msginfo)) (delete-region (nth 2 msginfo) (nth 3 msginfo)) ;; Is current message? (if (nth 1 msginfo) (setq current-message msgnum)) (setq sort-lists (cdr sort-lists)) (if (zerop (% msgnum 10)) (message "Reordering messages...%d" msgnum)) (setq msgnum (1+ msgnum))) ;; Delete the garbage inserted before. (delete-char 1) (setq quit-flag nil) (buffer-enable-undo) (rmail-set-message-counters) (rmail-show-message current-message) (if (rmail-summary-exists) (rmail-select-summary (rmail-update-summary))))))) (defun rmail-fetch-field (msg field) "Return the value of the header FIELD of MSG. Arguments are MSG and FIELD." (save-restriction (widen) (let ((next (rmail-msgend msg))) (goto-char (rmail-msgbeg msg)) (narrow-to-region (if (search-forward "\n*** EOOH ***\n" next t) (point) (forward-line 1) (point)) (progn (search-forward "\n\n" nil t) (point))) (mail-fetch-field field)))) (defun rmail-make-date-sortable (date) "Make DATE sortable using the function string-lessp." ;; Assume the default time zone is GMT. (timezone-make-date-sortable date "GMT" "GMT")) (provide 'rmailsort) ;;; rmailsort.el ends here emacs-19.30/lisp/rmailsum.el100444 12120 1 144434 6051204610 14266 0ustar rmsdaemon;;; rmailsum.el --- make summary buffers for the mail reader ;; Copyright (C) 1985, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Extended by Bob Weiner of Motorola ;; Provided all commands from rmail-mode in rmail-summary-mode and made key ;; bindings in both modes wholly compatible. ;;; Code: ;; For rmail-select-summary (require 'rmail) (defvar rmail-summary-font-lock-keywords '(("^....D.*" . font-lock-string-face) ; Deleted. ("^....-.*" . font-lock-type-face) ; Unread. ;; Neither of the below will be highlighted if either of the above are: ("^....[^D-] \\(......\\)" 1 font-lock-keyword-face) ; Date. ("{ \\([^}]+\\),}" 1 font-lock-comment-face)) ; Labels. "Additional expressions to highlight in Rmail Summary mode.") ;; Entry points for making a summary buffer. ;; Regenerate the contents of the summary ;; using the same selection criterion as last time. ;; M-x revert-buffer in a summary buffer calls this function. (defun rmail-update-summary (&rest ignore) (apply (car rmail-summary-redo) (cdr rmail-summary-redo))) (defun rmail-summary () "Display a summary of all messages, one line per message." (interactive) (rmail-new-summary "All" '(rmail-summary) nil)) (defun rmail-summary-by-labels (labels) "Display a summary of all messages with one or more LABELS. LABELS should be a string containing the desired labels, separated by commas." (interactive "sLabels to summarize by: ") (if (string= labels "") (setq labels (or rmail-last-multi-labels (error "No label specified")))) (setq rmail-last-multi-labels labels) (rmail-new-summary (concat "labels " labels) (list 'rmail-summary-by-labels labels) 'rmail-message-labels-p (concat ", \\(" (mail-comma-list-regexp labels) "\\),"))) (defun rmail-summary-by-recipients (recipients &optional primary-only) "Display a summary of all messages with the given RECIPIENTS. Normally checks the To, From and Cc fields of headers; but if PRIMARY-ONLY is non-nil (prefix arg given), only look in the To and From fields. RECIPIENTS is a string of regexps separated by commas." (interactive "sRecipients to summarize by: \nP") (rmail-new-summary (concat "recipients " recipients) (list 'rmail-summary-by-recipients recipients primary-only) 'rmail-message-recipients-p (mail-comma-list-regexp recipients) primary-only)) (defun rmail-summary-by-regexp (regexp) "Display a summary of all messages according to regexp REGEXP. If the regular expression is found in the header of the message \(including in the date and other lines, as well as the subject line), Emacs will list the header line in the RMAIL-summary." (interactive "sRegexp to summarize by: ") (if (string= regexp "") (setq regexp (or rmail-last-regexp (error "No regexp specified.")))) (setq rmail-last-regexp regexp) (rmail-new-summary (concat "regexp " regexp) (list 'rmail-summary-by-regexp regexp) 'rmail-message-regexp-p regexp)) ;; rmail-summary-by-topic ;; 1989 R.A. Schnitzler (defun rmail-summary-by-topic (subject &optional whole-message) "Display a summary of all messages with the given SUBJECT. Normally checks the Subject field of headers; but if WHOLE-MESSAGE is non-nil (prefix arg given), look in the whole message. SUBJECT is a string of regexps separated by commas." (interactive "sTopics to summarize by: \nP") (rmail-new-summary (concat "about " subject) (list 'rmail-summary-by-topic subject whole-message) 'rmail-message-subject-p (mail-comma-list-regexp subject) whole-message)) (defun rmail-message-subject-p (msg subject &optional whole-message) (save-restriction (goto-char (rmail-msgbeg msg)) (search-forward "\n*** EOOH ***\n") (narrow-to-region (point) (progn (search-forward (if whole-message "\^_" "\n\n")) (point))) (goto-char (point-min)) (if whole-message (re-search-forward subject nil t) (string-match subject (or (mail-fetch-field "Subject") "")) ))) (defun rmail-summary-by-senders (senders) "Display a summary of all messages with the given SENDERS. SENDERS is a string of names separated by commas." (interactive "sSenders to summarize by: ") (rmail-new-summary (concat "senders " senders) (list 'rmail-summary-by-senders senders) 'rmail-message-senders-p (mail-comma-list-regexp senders))) (defun rmail-message-senders-p (msg senders) (save-restriction (goto-char (rmail-msgbeg msg)) (search-forward "\n*** EOOH ***\n") (narrow-to-region (point) (progn (search-forward "\n\n") (point))) (string-match senders (or (mail-fetch-field "From") "")))) ;; General making of a summary buffer. (defvar rmail-summary-symbol-number 0) (defun rmail-new-summary (description redo-form function &rest args) "Create a summary of selected messages. DESCRIPTION makes part of the mode line of the summary buffer. For each message, FUNCTION is applied to the message number and ARGS... and if the result is non-nil, that message is included. nil for FUNCTION means all messages." (message "Computing summary lines...") (let (sumbuf mesg was-in-summary) (save-excursion ;; Go to the Rmail buffer. (if (eq major-mode 'rmail-summary-mode) (progn (setq was-in-summary t) (set-buffer rmail-buffer))) ;; Find its summary buffer, or make one. (setq sumbuf (if (and rmail-summary-buffer (buffer-name rmail-summary-buffer)) rmail-summary-buffer (generate-new-buffer (concat (buffer-name) "-summary")))) (setq mesg rmail-current-message) ;; Filter the messages; make or get their summary lines. (let ((summary-msgs ()) (new-summary-line-count 0)) (let ((msgnum 1) (buffer-read-only nil) (old-min (point-min-marker)) (old-max (point-max-marker))) ;; Can't use save-restriction here; that doesn't work if we ;; plan to modify text outside the original restriction. (save-excursion (widen) (goto-char (point-min)) (while (>= rmail-total-messages msgnum) (if (or (null function) (apply function (cons msgnum args))) (setq summary-msgs (cons (cons msgnum (rmail-make-summary-line msgnum)) summary-msgs))) (setq msgnum (1+ msgnum))) (setq summary-msgs (nreverse summary-msgs))) (narrow-to-region old-min old-max)) ;; Temporarily, while summary buffer is unfinished, ;; we "don't have" a summary. (setq rmail-summary-buffer nil) (save-excursion (let ((rbuf (current-buffer)) (total rmail-total-messages)) (set-buffer sumbuf) ;; Set up the summary buffer's contents. (let ((buffer-read-only nil)) (erase-buffer) (while summary-msgs (princ (cdr (car summary-msgs)) sumbuf) (setq summary-msgs (cdr summary-msgs))) (goto-char (point-min))) ;; Set up the rest of its state and local variables. (setq buffer-read-only t) (rmail-summary-mode) (make-local-variable 'minor-mode-alist) (setq minor-mode-alist (list '(t (concat ": " description)))) (setq rmail-buffer rbuf rmail-summary-redo redo-form rmail-total-messages total)))) (setq rmail-summary-buffer sumbuf)) ;; Now display the summary buffer and go to the right place in it. (or was-in-summary (progn (if (and (one-window-p) pop-up-windows (not pop-up-frames)) ;; If there is just one window, put the summary on the top. (progn (split-window (selected-window) rmail-summary-window-size) (select-window (next-window (frame-first-window))) (pop-to-buffer sumbuf) ;; If pop-to-buffer did not use that window, delete that ;; window. (This can happen if it uses another frame.) (if (not (eq sumbuf (window-buffer (frame-first-window)))) (delete-other-windows))) (pop-to-buffer sumbuf)) (set-buffer rmail-buffer) ;; This is how rmail makes the summary buffer reappear. ;; We do this here to make the window the proper size. (rmail-select-summary nil) (set-buffer rmail-summary-buffer))) (rmail-summary-goto-msg mesg t t) (rmail-summary-construct-io-menu) (message "Computing summary lines...done"))) ;; Low levels of generating a summary. (defun rmail-make-summary-line (msg) (let ((line (or (aref rmail-summary-vector (1- msg)) (progn (setq new-summary-line-count (1+ new-summary-line-count)) (if (zerop (% new-summary-line-count 10)) (message "Computing summary lines...%d" new-summary-line-count)) (rmail-make-summary-line-1 msg))))) ;; Fix up the part of the summary that says "deleted" or "unseen". (aset line 4 (if (rmail-message-deleted-p msg) ?\D (if (= ?0 (char-after (+ 3 (rmail-msgbeg msg)))) ?\- ?\ ))) line)) (defun rmail-make-summary-line-1 (msg) (goto-char (rmail-msgbeg msg)) (let* ((lim (save-excursion (forward-line 2) (point))) pos (labels (progn (forward-char 3) (concat ; (if (save-excursion (re-search-forward ",answered," lim t)) ; "*" "") ; (if (save-excursion (re-search-forward ",filed," lim t)) ; "!" "") (if (progn (search-forward ",,") (eolp)) "" (concat "{" (buffer-substring (point) (progn (end-of-line) (point))) "} "))))) (line (progn (forward-line 1) (if (looking-at "Summary-line: ") (progn (goto-char (match-end 0)) (setq line (buffer-substring (point) (progn (forward-line 1) (point))))))))) ;; Obsolete status lines lacking a # should be flushed. (and line (not (string-match "#" line)) (progn (delete-region (point) (progn (forward-line -1) (point))) (setq line nil))) ;; If we didn't get a valid status line from the message, ;; make a new one and put it in the message. (or line (let* ((case-fold-search t) (next (rmail-msgend msg)) (beg (if (progn (goto-char (rmail-msgbeg msg)) (search-forward "\n*** EOOH ***\n" next t)) (point) (forward-line 1) (point))) (end (progn (search-forward "\n\n" nil t) (point)))) (save-restriction (narrow-to-region beg end) (goto-char beg) (setq line (rmail-make-basic-summary-line))) (goto-char (rmail-msgbeg msg)) (forward-line 2) (insert "Summary-line: " line))) (setq pos (string-match "#" line)) (aset rmail-summary-vector (1- msg) (concat (format "%4d " msg) (substring line 0 pos) labels (substring line (1+ pos)))))) (defun rmail-make-basic-summary-line () (goto-char (point-min)) (concat (save-excursion (if (not (re-search-forward "^Date:" nil t)) " " (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)" (save-excursion (end-of-line) (point)) t) (format "%2d-%3s" (string-to-int (buffer-substring (match-beginning 2) (match-end 2))) (buffer-substring (match-beginning 4) (match-end 4)))) ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)" (save-excursion (end-of-line) (point)) t) (format "%2d-%3s" (string-to-int (buffer-substring (match-beginning 4) (match-end 4))) (buffer-substring (match-beginning 2) (match-end 2)))) (t "??????")))) " " (save-excursion (if (not (re-search-forward "^From:[ \t]*" nil t)) " " (let* ((from (mail-strip-quoted-names (buffer-substring (1- (point)) ;; Get all the lines of the From field ;; so that we get a whole comment if there is one, ;; so that mail-strip-quoted-names can discard it. (let ((opoint (point))) (while (progn (forward-line 1) (looking-at "[ \t]"))) ;; Back up over newline, then trailing spaces or tabs (forward-char -1) (skip-chars-backward " \t") (point))))) len mch lo) (if (string-match (concat "^" (regexp-quote (user-login-name)) "\\($\\|@\\)") from) (save-excursion (goto-char (point-min)) (if (not (re-search-forward "^To:[ \t]*" nil t)) nil (setq from (concat "to: " (mail-strip-quoted-names (buffer-substring (point) (progn (end-of-line) (skip-chars-backward " \t") (point))))))))) (setq len (length from)) (setq mch (string-match "[@%]" from)) (format "%25s" (if (or (not mch) (<= len 25)) (substring from (max 0 (- len 25))) (substring from (setq lo (cond ((< (- mch 14) 0) 0) ((< len (+ mch 11)) (- len 25)) (t (- mch 14)))) (min len (+ lo 25)))))))) " #" (if (re-search-forward "^Subject:" nil t) (progn (skip-chars-forward " \t") (buffer-substring (point) (progn (end-of-line) (point)))) (re-search-forward "[\n][\n]+" nil t) (buffer-substring (point) (progn (end-of-line) (point)))) "\n")) ;; Simple motion in a summary buffer. (defun rmail-summary-next-all (&optional number) (interactive "p") (forward-line (if number number 1)) ;; It doesn't look nice to move forward past the last message line. (and (eobp) (> number 0) (forward-line -1)) (display-buffer rmail-buffer)) (defun rmail-summary-previous-all (&optional number) (interactive "p") (forward-line (- (if number number 1))) ;; It doesn't look nice to move forward past the last message line. (and (eobp) (< number 0) (forward-line -1)) (display-buffer rmail-buffer)) (defun rmail-summary-next-msg (&optional number) "Display next non-deleted msg from rmail file. With optional prefix argument NUMBER, moves forward this number of non-deleted messages, or backward if NUMBER is negative." (interactive "p") (forward-line 0) (and (> number 0) (end-of-line)) (let ((count (if (< number 0) (- number) number)) (search (if (> number 0) 're-search-forward 're-search-backward)) (non-del-msg-found nil)) (while (and (> count 0) (setq non-del-msg-found (or (funcall search "^....[^D]" nil t) non-del-msg-found))) (setq count (1- count)))) (beginning-of-line) (display-buffer rmail-buffer)) (defun rmail-summary-previous-msg (&optional number) (interactive "p") (rmail-summary-next-msg (- (if number number 1)))) (defun rmail-summary-next-labeled-message (n labels) "Show next message with LABEL. Defaults to last labels used. With prefix argument N moves forward N messages with these labels." (interactive "p\nsMove to next msg with labels: ") (save-excursion (set-buffer rmail-buffer) (rmail-next-labeled-message n labels))) (defun rmail-summary-previous-labeled-message (n labels) "Show previous message with LABEL. Defaults to last labels used. With prefix argument N moves backward N messages with these labels." (interactive "p\nsMove to previous msg with labels: ") (save-excursion (set-buffer rmail-buffer) (rmail-previous-labeled-message n labels))) (defun rmail-summary-next-same-subject (n) "Go to the next message in the summary having the same subject. With prefix argument N, do this N times. If N is negative, go backwards." (interactive "p") (let (subject search-regexp i found (forward (> n 0))) (save-excursion (set-buffer rmail-buffer) (setq subject (mail-fetch-field "Subject")) (setq search-regexp (concat "^Subject: *\\(Re: *\\)?" (regexp-quote subject) "\n")) (setq i rmail-current-message)) (if (string-match "Re:[ \t]*" subject) (setq subject (substring subject (match-end 0)))) (save-excursion (while (and (/= n 0) (if forward (not (eobp)) (not (bobp)))) (let (done) (while (and (not done) (if forward (not (eobp)) (not (bobp)))) ;; Advance thru summary. (forward-line (if forward 1 -1)) ;; Get msg number of this line. (setq i (string-to-int (buffer-substring (point) (min (point-max) (+ 5 (point)))))) ;; See if that msg has desired subject. (save-excursion (set-buffer rmail-buffer) (save-restriction (widen) (goto-char (rmail-msgbeg i)) (search-forward "\n*** EOOH ***\n") (let ((beg (point)) end) (search-forward "\n\n") (setq end (point)) (goto-char beg) (setq done (re-search-forward search-regexp end t)))))) (if done (setq found i))) (setq n (if forward (1- n) (1+ n))))) (if found (rmail-summary-goto-msg found) (error "No %s message with same subject" (if forward "following" "previous"))))) (defun rmail-summary-previous-same-subject (n) "Go to the previous message in the summary having the same subject. With prefix argument N, do this N times. If N is negative, go forwards instead." (interactive "p") (rmail-summary-next-same-subject (- n))) ;; Delete and undelete summary commands. (defun rmail-summary-delete-forward (&optional backward) "Delete this message and move to next nondeleted one. Deleted messages stay in the file until the \\[rmail-expunge] command is given. With prefix argument, delete and move backward." (interactive "P") (let (end) (rmail-summary-goto-msg) (pop-to-buffer rmail-buffer) (rmail-delete-message) (let ((del-msg rmail-current-message)) (pop-to-buffer rmail-summary-buffer) (rmail-summary-mark-deleted del-msg) (while (and (not (if backward (bobp) (eobp))) (save-excursion (beginning-of-line) (looking-at " *[0-9]+D"))) (forward-line (if backward -1 1))) ;; It looks ugly to move to the empty line at end of buffer. (and (eobp) (not backward) (forward-line -1))))) (defun rmail-summary-delete-backward () "Delete this message and move to previous nondeleted one. Deleted messages stay in the file until the \\[rmail-expunge] command is given." (interactive) (rmail-summary-delete-forward t)) (defun rmail-summary-mark-deleted (&optional n undel) (and n (rmail-summary-goto-msg n t t)) (or (eobp) (not (overlay-get rmail-summary-overlay 'face)) (let ((buffer-read-only nil)) (skip-chars-forward " ") (skip-chars-forward "[0-9]") (if undel (if (looking-at "D") (progn (delete-char 1) (insert " "))) (delete-char 1) (insert "D")))) (beginning-of-line)) (defun rmail-summary-mark-undeleted (n) (rmail-summary-mark-deleted n t)) (defun rmail-summary-deleted-p (&optional n) (save-excursion (and n (rmail-summary-goto-msg n nil t)) (skip-chars-forward " ") (skip-chars-forward "[0-9]") (looking-at "D"))) (defun rmail-summary-undelete (&optional arg) "Undelete current message. Optional prefix ARG means undelete ARG previous messages." (interactive "p") (if (/= arg 1) (rmail-summary-undelete-many arg) (let ((buffer-read-only nil) (opoint (point))) (end-of-line) (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t) (replace-match "\\1 ") (rmail-summary-goto-msg) (pop-to-buffer rmail-buffer) (and (rmail-message-deleted-p rmail-current-message) (rmail-undelete-previous-message)) (pop-to-buffer rmail-summary-buffer)) (t (goto-char opoint)))))) (defun rmail-summary-undelete-many (&optional n) "Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs." (interactive "P") (save-excursion (set-buffer rmail-buffer) (let* ((init-msg (if n rmail-current-message rmail-total-messages)) (rmail-current-message init-msg) (n (or n rmail-total-messages)) (msgs-undeled 0)) (while (and (> rmail-current-message 0) (< msgs-undeled n)) (if (rmail-message-deleted-p rmail-current-message) (progn (rmail-set-attribute "deleted" nil) (setq msgs-undeled (1+ msgs-undeled)))) (setq rmail-current-message (1- rmail-current-message))) (set-buffer rmail-summary-buffer) (setq rmail-current-message init-msg msgs-undeled 0) (while (and (> rmail-current-message 0) (< msgs-undeled n)) (if (rmail-summary-deleted-p rmail-current-message) (progn (rmail-summary-mark-undeleted rmail-current-message) (setq msgs-undeled (1+ msgs-undeled)))) (setq rmail-current-message (1- rmail-current-message)))) (rmail-summary-goto-msg))) ;; Rmail Summary mode is suitable only for specially formatted data. (put 'rmail-summary-mode 'mode-class 'special) (defun rmail-summary-mode () "Rmail Summary Mode is invoked from Rmail Mode by using \\\\[rmail-summary]. As commands are issued in the summary buffer, they are applied to the corresponding mail messages in the rmail buffer. All normal editing commands are turned off. Instead, nearly all the Rmail mode commands are available, though many of them move only among the messages in the summary. These additional commands exist: \\[rmail-summary-undelete-many] Undelete all or prefix arg deleted messages. \\[rmail-summary-wipe] Delete the summary and go to the Rmail buffer. Commands for sorting the summary: \\[rmail-summary-sort-by-date] Sort by date. \\[rmail-summary-sort-by-subject] Sort by subject. \\[rmail-summary-sort-by-author] Sort by author. \\[rmail-summary-sort-by-recipient] Sort by recipient. \\[rmail-summary-sort-by-correspondent] Sort by correspondent. \\[rmail-summary-sort-by-lines] Sort by lines. \\[rmail-summary-sort-by-keywords] Sort by keywords." (interactive) (kill-all-local-variables) (setq major-mode 'rmail-summary-mode) (setq mode-name "RMAIL Summary") (setq truncate-lines t) (setq buffer-read-only t) (set-syntax-table text-mode-syntax-table) (make-local-variable 'rmail-buffer) (make-local-variable 'rmail-total-messages) (make-local-variable 'rmail-current-message) (setq rmail-current-message nil) (make-local-variable 'rmail-summary-redo) (setq rmail-summary-redo nil) (make-local-variable 'revert-buffer-function) (make-local-variable 'post-command-hook) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(rmail-summary-font-lock-keywords t)) (rmail-summary-enable) (run-hooks 'rmail-summary-mode-hook)) ;; Summary features need to be disabled during edit mode. (defun rmail-summary-disable () (use-local-map text-mode-map) (remove-hook 'post-command-hook 'rmail-summary-rmail-update) (setq revert-buffer-function nil)) (defun rmail-summary-enable () (use-local-map rmail-summary-mode-map) (add-hook 'post-command-hook 'rmail-summary-rmail-update) (setq revert-buffer-function 'rmail-update-summary)) ;; Show in Rmail the message described by the summary line that point is on, ;; but only if the Rmail buffer is already visible. ;; This is a post-command-hook in summary buffers. (defun rmail-summary-rmail-update () (let (buffer-read-only) (save-excursion ;; If at end of buffer, pretend we are on the last text line. (if (eobp) (forward-line -1)) (beginning-of-line) (skip-chars-forward " ") (let ((msg-num (string-to-int (buffer-substring (point) (progn (skip-chars-forward "0-9") (point)))))) (or (eq rmail-current-message msg-num) (let ((window (get-buffer-window rmail-buffer)) (owin (selected-window))) (setq rmail-current-message msg-num) (if (= (following-char) ?-) (progn (delete-char 1) (insert " "))) (if window ;; Using save-window-excursion would cause the new value ;; of point to get lost. (unwind-protect (progn (select-window window) (rmail-show-message msg-num t)) (select-window owin)) (if (buffer-name rmail-buffer) (save-excursion (set-buffer rmail-buffer) (rmail-show-message msg-num t)))))) (rmail-summary-update-highlight nil))))) (defvar rmail-summary-mode-map nil) (if rmail-summary-mode-map nil (setq rmail-summary-mode-map (make-keymap)) (suppress-keymap rmail-summary-mode-map) (define-key rmail-summary-mode-map "a" 'rmail-summary-add-label) (define-key rmail-summary-mode-map "c" 'rmail-summary-continue) (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward) (define-key rmail-summary-mode-map "\C-d" 'rmail-summary-delete-backward) (define-key rmail-summary-mode-map "e" 'rmail-summary-edit-current-message) (define-key rmail-summary-mode-map "f" 'rmail-summary-forward) (define-key rmail-summary-mode-map "g" 'rmail-summary-get-new-mail) (define-key rmail-summary-mode-map "h" 'rmail-summary) (define-key rmail-summary-mode-map "i" 'rmail-summary-input) (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg) (define-key rmail-summary-mode-map "k" 'rmail-summary-kill-label) (define-key rmail-summary-mode-map "l" 'rmail-summary-by-labels) (define-key rmail-summary-mode-map "\e\C-h" 'rmail-summary) (define-key rmail-summary-mode-map "\e\C-l" 'rmail-summary-by-labels) (define-key rmail-summary-mode-map "\e\C-r" 'rmail-summary-by-recipients) (define-key rmail-summary-mode-map "\e\C-s" 'rmail-summary-by-regexp) (define-key rmail-summary-mode-map "\e\C-t" 'rmail-summary-by-topic) (define-key rmail-summary-mode-map "m" 'rmail-summary-mail) (define-key rmail-summary-mode-map "\M-m" 'rmail-summary-retry-failure) (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg) (define-key rmail-summary-mode-map "\en" 'rmail-summary-next-all) (define-key rmail-summary-mode-map "\e\C-n" 'rmail-summary-next-labeled-message) (define-key rmail-summary-mode-map "o" 'rmail-summary-output-to-rmail-file) (define-key rmail-summary-mode-map "\C-o" 'rmail-summary-output) (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg) (define-key rmail-summary-mode-map "\ep" 'rmail-summary-previous-all) (define-key rmail-summary-mode-map "\e\C-p" 'rmail-summary-previous-labeled-message) (define-key rmail-summary-mode-map "q" 'rmail-summary-quit) (define-key rmail-summary-mode-map "r" 'rmail-summary-reply) (define-key rmail-summary-mode-map "s" 'rmail-summary-expunge-and-save) (define-key rmail-summary-mode-map "\es" 'rmail-summary-search) (define-key rmail-summary-mode-map "t" 'rmail-summary-toggle-header) (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete) (define-key rmail-summary-mode-map "\M-u" 'rmail-summary-undelete-many) (define-key rmail-summary-mode-map "w" 'rmail-summary-wipe) (define-key rmail-summary-mode-map "x" 'rmail-summary-expunge) (define-key rmail-summary-mode-map "." 'rmail-summary-beginning-of-message) (define-key rmail-summary-mode-map "<" 'rmail-summary-first-message) (define-key rmail-summary-mode-map ">" 'rmail-summary-last-message) (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up) (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down) (define-key rmail-summary-mode-map "?" 'describe-mode) (define-key rmail-summary-mode-map "\C-c\C-n" 'rmail-summary-next-same-subject) (define-key rmail-summary-mode-map "\C-c\C-p" 'rmail-summary-previous-same-subject) (define-key rmail-summary-mode-map "\C-c\C-s\C-d" 'rmail-summary-sort-by-date) (define-key rmail-summary-mode-map "\C-c\C-s\C-s" 'rmail-summary-sort-by-subject) (define-key rmail-summary-mode-map "\C-c\C-s\C-a" 'rmail-summary-sort-by-author) (define-key rmail-summary-mode-map "\C-c\C-s\C-r" 'rmail-summary-sort-by-recipient) (define-key rmail-summary-mode-map "\C-c\C-s\C-c" 'rmail-summary-sort-by-correspondent) (define-key rmail-summary-mode-map "\C-c\C-s\C-l" 'rmail-summary-sort-by-lines) (define-key rmail-summary-mode-map "\C-c\C-s\C-k" 'rmail-summary-sort-by-keywords) ) ;;; Menu bar bindings. (define-key rmail-summary-mode-map [menu-bar] (make-sparse-keymap)) (define-key rmail-summary-mode-map [menu-bar classify] (cons "Classify" (make-sparse-keymap "Classify"))) (define-key rmail-summary-mode-map [menu-bar classify output-menu] '("Output (Rmail Menu)..." . rmail-summary-output-menu)) (define-key rmail-summary-mode-map [menu-bar classify input-menu] '("Input Rmail File (menu)..." . rmail-input-menu)) (define-key rmail-summary-mode-map [menu-bar classify input-menu] '(nil)) (define-key rmail-summary-mode-map [menu-bar classify output-menu] '(nil)) (define-key rmail-summary-mode-map [menu-bar classify output-inbox] '("Output (inbox)..." . rmail-summary-output)) (define-key rmail-summary-mode-map [menu-bar classify output] '("Output (Rmail)..." . rmail-summary-output-to-rmail-file)) (define-key rmail-summary-mode-map [menu-bar classify kill-label] '("Kill Label..." . rmail-summary-kill-label)) (define-key rmail-summary-mode-map [menu-bar classify add-label] '("Add Label..." . rmail-summary-add-label)) (define-key rmail-summary-mode-map [menu-bar summary] (cons "Summary" (make-sparse-keymap "Summary"))) (define-key rmail-summary-mode-map [menu-bar summary labels] '("By Labels..." . rmail-summary-by-labels)) (define-key rmail-summary-mode-map [menu-bar summary recipients] '("By Recipients..." . rmail-summary-by-recipients)) (define-key rmail-summary-mode-map [menu-bar summary topic] '("By Topic..." . rmail-summary-by-topic)) (define-key rmail-summary-mode-map [menu-bar summary regexp] '("By Regexp..." . rmail-summary-by-regexp)) (define-key rmail-summary-mode-map [menu-bar summary all] '("All" . rmail-summary)) (define-key rmail-summary-mode-map [menu-bar mail] (cons "Mail" (make-sparse-keymap "Mail"))) (define-key rmail-summary-mode-map [menu-bar mail rmail-summary-get-new-mail] '("Get New Mail" . rmail-summary-get-new-mail)) (define-key rmail-summary-mode-map [menu-bar mail lambda] '("----")) (define-key rmail-summary-mode-map [menu-bar mail continue] '("Continue" . rmail-summary-continue)) (define-key rmail-summary-mode-map [menu-bar mail resend] '("Re-send..." . rmail-summary-resend)) (define-key rmail-summary-mode-map [menu-bar mail forward] '("Forward" . rmail-summary-forward)) (define-key rmail-summary-mode-map [menu-bar mail retry] '("Retry" . rmail-summary-retry-failure)) (define-key rmail-summary-mode-map [menu-bar mail reply] '("Reply" . rmail-summary-reply)) (define-key rmail-summary-mode-map [menu-bar mail mail] '("Mail" . rmail-summary-mail)) (define-key rmail-summary-mode-map [menu-bar delete] (cons "Delete" (make-sparse-keymap "Delete"))) (define-key rmail-summary-mode-map [menu-bar delete expunge/save] '("Expunge/Save" . rmail-summary-expunge-and-save)) (define-key rmail-summary-mode-map [menu-bar delete expunge] '("Expunge" . rmail-summary-expunge)) (define-key rmail-summary-mode-map [menu-bar delete undelete] '("Undelete" . rmail-summary-undelete)) (define-key rmail-summary-mode-map [menu-bar delete delete] '("Delete" . rmail-summary-delete-forward)) (define-key rmail-summary-mode-map [menu-bar move] (cons "Move" (make-sparse-keymap "Move"))) (define-key rmail-summary-mode-map [menu-bar move search-back] '("Search Back..." . rmail-summary-search-backward)) (define-key rmail-summary-mode-map [menu-bar move search] '("Search..." . rmail-summary-search)) (define-key rmail-summary-mode-map [menu-bar move previous] '("Previous Nondeleted" . rmail-summary-previous-msg)) (define-key rmail-summary-mode-map [menu-bar move next] '("Next Nondeleted" . rmail-summary-next-msg)) (define-key rmail-summary-mode-map [menu-bar move last] '("Last" . rmail-summary-last-message)) (define-key rmail-summary-mode-map [menu-bar move first] '("First" . rmail-summary-first-message)) (define-key rmail-summary-mode-map [menu-bar move previous] '("Previous" . rmail-summary-previous-all)) (define-key rmail-summary-mode-map [menu-bar move next] '("Next" . rmail-summary-next-all)) (defvar rmail-summary-overlay nil) (put 'rmail-summary-overlay 'permanent-local t) (defun rmail-summary-goto-msg (&optional n nowarn skip-rmail) (interactive "P") (if (consp n) (setq n (prefix-numeric-value n))) (if (eobp) (forward-line -1)) (beginning-of-line) (let* ((obuf (current-buffer)) (buf rmail-buffer) (cur (point)) message-not-found (curmsg (string-to-int (buffer-substring (point) (min (point-max) (+ 5 (point)))))) (total (save-excursion (set-buffer buf) rmail-total-messages))) ;; If message number N was specified, find that message's line ;; or set message-not-found. ;; If N wasn't specified or that message can't be found. ;; set N by default. (if (not n) (setq n curmsg) (if (< n 1) (progn (message "No preceding message") (setq n 1))) (if (> n total) (progn (message "No following message") (goto-char (point-max)) (rmail-summary-goto-msg))) (goto-char (point-min)) (if (not (re-search-forward (format "^%4d[^0-9]" n) nil t)) (progn (or nowarn (message "Message %d not found" n)) (setq n curmsg) (setq message-not-found t) (goto-char cur)))) (beginning-of-line) (skip-chars-forward " ") (skip-chars-forward "0-9") (save-excursion (if (= (following-char) ?-) (let ((buffer-read-only nil)) (delete-char 1) (insert " ")))) (rmail-summary-update-highlight message-not-found) (beginning-of-line) (if skip-rmail nil (let ((selwin (selected-window))) (unwind-protect (progn (pop-to-buffer buf) (rmail-show-message n)) (select-window selwin) ;; The actions above can alter the current buffer. Preserve it. (set-buffer obuf)))))) ;; Update the highlighted line in an rmail summary buffer. ;; That should be current. We highlight the line point is on. ;; If NOT-FOUND is non-nil, we turn off highlighting. (defun rmail-summary-update-highlight (not-found) ;; Make sure we have an overlay to use. (or rmail-summary-overlay (progn (make-local-variable 'rmail-summary-overlay) (setq rmail-summary-overlay (make-overlay (point) (point))))) ;; If this message is in the summary, use the overlay to highlight it. ;; Otherwise, don't highlight anything. (if not-found (overlay-put rmail-summary-overlay 'face nil) (move-overlay rmail-summary-overlay (save-excursion (beginning-of-line) (skip-chars-forward " ") (point)) (save-excursion (end-of-line) (point))) (overlay-put rmail-summary-overlay 'face 'highlight))) (defun rmail-summary-scroll-msg-up (&optional dist) "Scroll the Rmail window forward. If the Rmail window is displaying the end of a message, advance to the next message." (interactive "P") (if (eq dist '-) (rmail-summary-scroll-msg-down nil) (let ((rmail-buffer-window (get-buffer-window rmail-buffer))) (if rmail-buffer-window (if (let ((rmail-summary-window (selected-window))) (select-window rmail-buffer-window) (prog1 ;; Is EOB visible in the buffer? (save-excursion (let ((ht (window-height (selected-window)))) (move-to-window-line (- ht 2)) (end-of-line) (eobp))) (select-window rmail-summary-window))) (rmail-summary-next-msg (or dist 1)) (let ((other-window-scroll-buffer rmail-buffer)) (scroll-other-window dist))) ;; This forces rmail-buffer to be sized correctly later. (display-buffer rmail-buffer) (setq rmail-current-message nil))))) (defun rmail-summary-scroll-msg-down (&optional dist) "Scroll the Rmail window backward. If the Rmail window is displaying the beginning of a message, advance to the previous message." (interactive "P") (if (eq dist '-) (rmail-summary-scroll-msg-up nil) (let ((rmail-buffer-window (get-buffer-window rmail-buffer))) (if rmail-buffer-window (if (let ((rmail-summary-window (selected-window))) (select-window rmail-buffer-window) (prog1 ;; Is BOB visible in the buffer? (save-excursion (move-to-window-line 0) (beginning-of-line) (bobp)) (select-window rmail-summary-window))) (rmail-summary-previous-msg (or dist 1)) (let ((other-window-scroll-buffer rmail-buffer)) (scroll-other-window-down dist))) ;; This forces rmail-buffer to be sized correctly later. (display-buffer rmail-buffer) (setq rmail-current-message nil))))) (defun rmail-summary-beginning-of-message () "Show current message from the beginning." (interactive) (pop-to-buffer rmail-buffer) (beginning-of-buffer) (pop-to-buffer rmail-summary-buffer)) (defun rmail-summary-quit () "Quit out of Rmail and Rmail summary." (interactive) (rmail-summary-wipe) (rmail-quit)) (defun rmail-summary-wipe () "Kill and wipe away Rmail summary, remaining within Rmail." (interactive) (save-excursion (set-buffer rmail-buffer) (setq rmail-summary-buffer nil)) (let ((local-rmail-buffer rmail-buffer)) (kill-buffer (current-buffer)) ;; Delete window if not only one. (if (not (eq (selected-window) (next-window nil 'no-minibuf))) (delete-window)) ;; Switch windows to the rmail buffer, or switch to it in this window. (pop-to-buffer local-rmail-buffer))) (defun rmail-summary-expunge () "Actually erase all deleted messages and recompute summary headers." (interactive) (save-excursion (set-buffer rmail-buffer) (rmail-only-expunge)) (rmail-update-summary)) (defun rmail-summary-expunge-and-save () "Expunge and save RMAIL file." (interactive) (save-excursion (set-buffer rmail-buffer) (rmail-only-expunge)) (rmail-update-summary) (save-excursion (set-buffer rmail-buffer) (save-buffer)) (set-buffer-modified-p nil)) (defun rmail-summary-get-new-mail () "Get new mail and recompute summary headers." (interactive) (let (msg) (save-excursion (set-buffer rmail-buffer) (rmail-get-new-mail) ;; Get the proper new message number. (setq msg rmail-current-message)) ;; Make sure that message is displayed. (rmail-summary-goto-msg msg))) (defun rmail-summary-input (filename) "Run Rmail on file FILENAME." (interactive "FRun rmail on RMAIL file: ") ;; We switch windows here, then display the other Rmail file there. (pop-to-buffer rmail-buffer) (rmail filename)) (defun rmail-summary-first-message () "Show first message in Rmail file from summary buffer." (interactive) (beginning-of-buffer)) (defun rmail-summary-last-message () "Show last message in Rmail file from summary buffer." (interactive) (end-of-buffer) (forward-line -1)) (defvar rmail-summary-edit-map nil) (if rmail-summary-edit-map nil (setq rmail-summary-edit-map (nconc (make-sparse-keymap) text-mode-map)) (define-key rmail-summary-edit-map "\C-c\C-c" 'rmail-cease-edit) (define-key rmail-summary-edit-map "\C-c\C-]" 'rmail-abort-edit)) (defun rmail-summary-edit-current-message () "Edit the contents of this message." (interactive) (pop-to-buffer rmail-buffer) (rmail-edit-current-message) (use-local-map rmail-summary-edit-map)) (defun rmail-summary-cease-edit () "Finish editing message, then go back to Rmail summary buffer." (interactive) (rmail-cease-edit) (pop-to-buffer rmail-summary-buffer)) (defun rmail-summary-abort-edit () "Abort edit of current message; restore original contents. Go back to summary buffer." (interactive) (rmail-abort-edit) (pop-to-buffer rmail-summary-buffer)) (defun rmail-summary-search-backward (regexp &optional n) "Show message containing next match for REGEXP. Prefix argument gives repeat count; negative argument means search backwards (through earlier messages). Interactively, empty argument means use same regexp used last time." (interactive (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0)) (prompt (concat (if reversep "Reverse " "") "Rmail search (regexp): ")) regexp) (if rmail-search-last-regexp (setq prompt (concat prompt "(default " rmail-search-last-regexp ") "))) (setq regexp (read-string prompt)) (cond ((not (equal regexp "")) (setq rmail-search-last-regexp regexp)) ((not rmail-search-last-regexp) (error "No previous Rmail search string"))) (list rmail-search-last-regexp (prefix-numeric-value current-prefix-arg)))) ;; Don't use save-excursion because that prevents point from moving ;; properly in the summary buffer. (let ((buffer (current-buffer))) (unwind-protect (progn (set-buffer rmail-buffer) (rmail-search regexp (- n))) (set-buffer buffer)))) (defun rmail-summary-search (regexp &optional n) "Show message containing next match for REGEXP. Prefix argument gives repeat count; negative argument means search backwards (through earlier messages). Interactively, empty argument means use same regexp used last time." (interactive (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0)) (prompt (concat (if reversep "Reverse " "") "Rmail search (regexp): ")) regexp) (if rmail-search-last-regexp (setq prompt (concat prompt "(default " rmail-search-last-regexp ") "))) (setq regexp (read-string prompt)) (cond ((not (equal regexp "")) (setq rmail-search-last-regexp regexp)) ((not rmail-search-last-regexp) (error "No previous Rmail search string"))) (list rmail-search-last-regexp (prefix-numeric-value current-prefix-arg)))) ;; Don't use save-excursion because that prevents point from moving ;; properly in the summary buffer. (let ((buffer (current-buffer))) (unwind-protect (progn (set-buffer rmail-buffer) (rmail-search regexp n)) (set-buffer buffer)))) (defun rmail-summary-toggle-header () "Show original message header if pruned header currently shown, or vice versa." (interactive) (save-excursion (set-buffer rmail-buffer) (rmail-toggle-header)) ;; Inside save-excursion, some changes to point in the RMAIL buffer are lost. ;; Set point to point-min in the RMAIL buffer, if it is visible. (let ((window (get-buffer-window rmail-buffer))) (if window ;; Using save-window-excursion would lose the new value of point. (let ((owin (selected-window))) (unwind-protect (progn (select-window window) (goto-char (point-min))) (select-window owin)))))) (defun rmail-summary-add-label (label) "Add LABEL to labels associated with current Rmail message. Completion is performed over known labels when reading." (interactive (list (save-excursion (set-buffer rmail-buffer) (rmail-read-label "Add label")))) (save-excursion (set-buffer rmail-buffer) (rmail-add-label label))) (defun rmail-summary-kill-label (label) "Remove LABEL from labels associated with current Rmail message. Completion is performed over known labels when reading." (interactive (list (save-excursion (set-buffer rmail-buffer) (rmail-read-label "Kill label")))) (save-excursion (set-buffer rmail-buffer) (rmail-set-label label nil))) ;;;; *** Rmail Summary Mailing Commands *** (defun rmail-summary-mail () "Send mail in another window. While composing the message, use \\[mail-yank-original] to yank the original message into it." (interactive) (let ((window (get-buffer-window rmail-buffer))) (if window (select-window window) (set-buffer rmail-buffer))) (rmail-start-mail nil nil nil nil nil (current-buffer)) (use-local-map (copy-keymap (current-local-map))) (define-key (current-local-map) "\C-c\C-c" 'rmail-summary-send-and-exit)) (defun rmail-summary-continue () "Continue composing outgoing message previously being composed." (interactive) (let ((window (get-buffer-window rmail-buffer))) (if window (select-window window) (set-buffer rmail-buffer))) (rmail-start-mail t)) (defun rmail-summary-reply (just-sender) "Reply to the current message. Normally include CC: to all other recipients of original message; prefix argument means ignore them. While composing the reply, use \\[mail-yank-original] to yank the original message into it." (interactive "P") (let ((window (get-buffer-window rmail-buffer))) (if window (select-window window) (set-buffer rmail-buffer))) (rmail-reply just-sender) (use-local-map (copy-keymap (current-local-map))) (define-key (current-local-map) "\C-c\C-c" 'rmail-summary-send-and-exit)) (defun rmail-summary-retry-failure () "Edit a mail message which is based on the contents of the current message. For a message rejected by the mail system, extract the interesting headers and the body of the original message; otherwise copy the current message." (interactive) (let ((window (get-buffer-window rmail-buffer))) (if window (select-window window) (set-buffer rmail-buffer))) (rmail-retry-failure) (use-local-map (copy-keymap (current-local-map))) (define-key (current-local-map) "\C-c\C-c" 'rmail-summary-send-and-exit)) (defun rmail-summary-send-and-exit () "Send mail reply and return to summary buffer." (interactive) (mail-send-and-exit t)) (defun rmail-summary-forward (resend) "Forward the current message to another user. With prefix argument, \"resend\" the message instead of forwarding it; see the documentation of `rmail-resend'." (interactive "P") (save-excursion (let ((window (get-buffer-window rmail-buffer))) (if window (select-window window) (set-buffer rmail-buffer))) (rmail-forward resend) (use-local-map (copy-keymap (current-local-map))) (define-key (current-local-map) "\C-c\C-c" 'rmail-summary-send-and-exit))) (defun rmail-summary-resend () "Resend current message using 'rmail-resend'." (interactive) (save-excursion (let ((window (get-buffer-window rmail-buffer))) (if window (select-window window) (set-buffer rmail-buffer))) (call-interactively 'rmail-resend))) ;; Summary output commands. (defun rmail-summary-output-to-rmail-file (&optional file-name) "Append the current message to an Rmail file named FILE-NAME. If the file does not exist, ask if it should be created. If file is being visited, the message is appended to the Emacs buffer visiting that file." (interactive) (save-excursion (set-buffer rmail-buffer) (let ((rmail-delete-after-output nil)) (if file-name (rmail-output-to-rmail-file file-name) (call-interactively 'rmail-output-to-rmail-file)))) (if rmail-delete-after-output (rmail-summary-delete-forward nil))) (defun rmail-summary-output-menu () "Output current message to another Rmail file, chosen with a menu. Also set the default for subsequent \\[rmail-output-to-rmail-file] commands. The variables `rmail-secondary-file-directory' and `rmail-secondary-file-regexp' control which files are offered in the menu." (interactive) (save-excursion (set-buffer rmail-buffer) (let ((rmail-delete-after-output nil)) (call-interactively 'rmail-output-menu))) (if rmail-delete-after-output (rmail-summary-delete-forward nil))) (defun rmail-summary-output () "Append this message to Unix mail file named FILE-NAME." (interactive) (save-excursion (set-buffer rmail-buffer) (let ((rmail-delete-after-output nil)) (call-interactively 'rmail-output))) (if rmail-delete-after-output (rmail-summary-delete-forward nil))) (defun rmail-summary-construct-io-menu () (let ((files (rmail-find-all-files rmail-secondary-file-directory))) (if files (progn (define-key rmail-summary-mode-map [menu-bar classify input-menu] (cons "Input Rmail File" (rmail-list-to-menu "Input Rmail File" files 'rmail-summary-input))) (define-key rmail-summary-mode-map [menu-bar classify output-menu] (cons "Output Rmail File" (rmail-list-to-menu "Output Rmail File" files 'rmail-summary-output-to-rmail-file)))) (define-key rmail-summary-mode-map [menu-bar classify input-menu] '("Input Rmail File" . rmail-disable-menu)) (define-key rmail-summary-mode-map [menu-bar classify output-menu] '("Output Rmail File" . rmail-disable-menu))))) ;; Sorting messages in Rmail Summary buffer. (defun rmail-summary-sort-by-date (reverse) "Sort messages of current Rmail summary by date. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-from-summary (function rmail-sort-by-date) reverse)) (defun rmail-summary-sort-by-subject (reverse) "Sort messages of current Rmail summary by subject. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-from-summary (function rmail-sort-by-subject) reverse)) (defun rmail-summary-sort-by-author (reverse) "Sort messages of current Rmail summary by author. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-from-summary (function rmail-sort-by-author) reverse)) (defun rmail-summary-sort-by-recipient (reverse) "Sort messages of current Rmail summary by recipient. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-from-summary (function rmail-sort-by-recipient) reverse)) (defun rmail-summary-sort-by-correspondent (reverse) "Sort messages of current Rmail summary by other correspondent. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-from-summary (function rmail-sort-by-correspondent) reverse)) (defun rmail-summary-sort-by-lines (reverse) "Sort messages of current Rmail summary by lines of the message. If prefix argument REVERSE is non-nil, sort them in reverse order." (interactive "P") (rmail-sort-from-summary (function rmail-sort-by-lines) reverse)) (defun rmail-summary-sort-by-keywords (reverse labels) "Sort messages of current Rmail summary by keywords. If prefix argument REVERSE is non-nil, sort them in reverse order. KEYWORDS is a comma-separated list of labels." (interactive "P\nsSort by labels: ") (rmail-sort-from-summary (function (lambda (reverse) (rmail-sort-by-keywords reverse labels))) reverse)) (defun rmail-sort-from-summary (sortfun reverse) "Sort Rmail messages from Summary buffer and update it after sorting." (require 'rmailsort) (let ((selwin (selected-window))) (unwind-protect (progn (pop-to-buffer rmail-buffer) (funcall sortfun reverse)) (select-window selwin)))) ;;; rmailsum.el ends here emacs-19.30/lisp/rnews.el100444 12120 1 105740 5625706714 13612 0ustar rmsdaemon;;; rnews.el --- USENET news reader for gnu emacs ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Change Log: ;; Created Sun Mar 10,1985 at 21:35:01 ads and sundar@hernes.ai.mit.edu ;; Should do the point pdl stuff sometime ;; finito except pdl.... Sat Mar 16,1985 at 06:43:44 ;; lets keep the summary stuff out until we get it working .. ;; sundar@hermes.ai.mit.edu Wed Apr 10,1985 at 16:32:06 ;; hack slash maim. mly@prep.ai.mit.edu Thu 18 Apr, 1985 06:11:14 ;; modified to correct reentrance bug, to not bother with groups that ;; received no new traffic since last read completely, to find out ;; what traffic a group has available much more quickly when ;; possible, to do some completing reads for group names - should ;; be much faster... ;; KING@KESTREL.arpa, Thu Mar 13 09:03:28 1986 ;; made news-{next,previous}-group skip groups with no new messages; and ;; added checking for unsubscribed groups to news-add-news-group ;; tower@prep.ai.mit.edu Jul 18 1986 ;; bound rmail-output to C-o; and changed header-field commands binding to ;; agree with the new C-c C-f usage in sendmail ;; tower@prep Sep 3 1986 ;; added news-rotate-buffer-body ;; tower@prep Oct 17 1986 ;; made messages more user friendly, cleanuped news-inews ;; move posting and mail code to new file rnewpost.el ;; tower@prep Oct 29 1986 ;; added caesar-region, rename news-caesar-buffer-body, hacked accordingly ;; tower@prep Nov 21 1986 ;; added tower@prep 22 Apr 87 ;;; Code: (require 'mail-utils) (autoload 'rmail-output "rmailout" "Append this message to Unix mail file named FILE-NAME." t) (autoload 'news-reply "rnewspost" "Compose and post a reply to the current article on USENET. While composing the reply, use \\[mail-yank-original] to yank the original message into it." t) (autoload 'news-mail-other-window "rnewspost" "Send mail in another window. While composing the message, use \\[mail-yank-original] to yank the original message into it." t) (autoload 'news-post-news "rnewspost" "Begin editing a new USENET news article to be posted." t) (autoload 'news-mail-reply "rnewspost" "Mail a reply to the author of the current article. While composing the reply, use \\[mail-yank-original] to yank the original message into it." t) (defvar news-group-hook-alist nil "Alist of (GROUP-REGEXP . HOOK) pairs. Just before displaying a message, each HOOK is called if its GROUP-REGEXP matches the current newsgroup name.") (defvar rmail-last-file (expand-file-name "~/mbox.news")) ;Now in paths.el. ;(defvar news-path "/usr/spool/news/" ; "The root directory below which all news files are stored.") (defvar news-startup-file "$HOME/.newsrc" "Contains ~/.newsrc") (defvar news-certification-file "$HOME/.news-dates" "Contains ~/.news-dates") ;; random headers that we decide to ignore. (defvar news-ignored-headers "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:" "All random fields within the header of a message.") (defvar news-mode-map nil) (defvar news-read-first-time-p t) ;; Contains the (dotified) news groups of which you are a member. (defvar news-user-group-list nil) (defvar news-current-news-group nil) (defvar news-current-group-begin nil) (defvar news-current-group-end nil) (defvar news-current-certifications nil "An assoc list of a group name and the time at which it is known that the group had no new traffic") (defvar news-current-certifiable nil "The time when the directory we are now working on was written") (defvar news-message-filter nil "User specifiable filter function that will be called during formatting of the news file") ;(defvar news-mode-group-string "Starting-Up" ; "Mode line group name info is held in this variable") (defvar news-list-of-files nil "Global variable in which we store the list of files associated with the current newsgroup") (defvar news-list-of-files-possibly-bogus nil "variable indicating we only are guessing at which files are available. Not currently used.") ;; association list in which we store lists of the form ;; (pointified-group-name (first last old-last)) (defvar news-group-article-assoc nil) (defvar news-current-message-number 0 "Displayed Article Number") (defvar news-total-current-group 0 "Total no of messages in group") (defvar news-unsubscribe-groups ()) (defvar news-point-pdl () "List of visited news messages.") (defvar news-no-jumps-p t) (defvar news-buffer () "Buffer into which news files are read.") (defmacro news-push (item ref) (list 'setq ref (list 'cons item ref))) (defmacro news-cadr (x) (list 'car (list 'cdr x))) (defmacro news-cdar (x) (list 'cdr (list 'car x))) (defmacro news-caddr (x) (list 'car (list 'cdr (list 'cdr x)))) (defmacro news-cadar (x) (list 'car (list 'cdr (list 'car x)))) (defmacro news-caadr (x) (list 'car (list 'car (list 'cdr x)))) (defmacro news-cdadr (x) (list 'cdr (list 'car (list 'cdr x)))) (defmacro news-wins (pfx index) (` (file-exists-p (concat (, pfx) "/" (int-to-string (, index)))))) (defvar news-max-plausible-gap 2 "* In an rnews directory, the maximum possible gap size. A gap is a sequence of missing messages between two messages that exist. An empty file does not contribute to a gap -- it ends one.") (defun news-find-first-and-last (prefix base) (and (news-wins prefix base) (cons (news-find-first-or-last prefix base -1) (news-find-first-or-last prefix base 1)))) (defmacro news-/ (a1 a2) ;; a form of / that guarantees that (/ -1 2) = 0 (if (zerop (/ -1 2)) (` (/ (, a1) (, a2))) (` (if (< (, a1) 0) (- (/ (- (, a1)) (, a2))) (/ (, a1) (, a2)))))) (defun news-find-first-or-last (pfx base dirn) ;; first use powers of two to find a plausible ceiling (let ((original-dir dirn)) (while (news-wins pfx (+ base dirn)) (setq dirn (* dirn 2))) (setq dirn (news-/ dirn 2)) ;; Then use a binary search to find the high water mark (let ((offset (news-/ dirn 2))) (while (/= offset 0) (if (news-wins pfx (+ base dirn offset)) (setq dirn (+ dirn offset))) (setq offset (news-/ offset 2)))) ;; If this high-water mark is bogus, recurse. (let ((offset (* news-max-plausible-gap original-dir))) (while (and (/= offset 0) (not (news-wins pfx (+ base dirn offset)))) (setq offset (- offset original-dir))) (if (= offset 0) (+ base dirn) (news-find-first-or-last pfx (+ base dirn offset) original-dir))))) (defun rnews () "Read USENET news for groups for which you are a member and add or delete groups. You can reply to articles posted and send articles to any group. Type \\[describe-mode] once reading news to get a list of rnews commands." (interactive) (let ((last-buffer (buffer-name))) (make-local-variable 'rmail-last-file) (switch-to-buffer (setq news-buffer (get-buffer-create "*news*"))) (news-mode) (setq news-buffer-save last-buffer) (setq buffer-read-only nil) (erase-buffer) (setq buffer-read-only t) (set-buffer-modified-p t) (sit-for 0) (message "Getting new USENET news...") (news-set-mode-line) (news-get-certifications) (news-get-new-news))) (defun news-group-certification (group) (cdr-safe (assoc group news-current-certifications))) (defun news-set-current-certifiable () ;; Record the date that corresponds to the directory you are about to check (let ((file (concat news-path (string-subst-char ?/ ?. news-current-news-group)))) (setq news-current-certifiable (nth 5 (file-attributes (or (file-symlink-p file) file)))))) (defun news-get-certifications () ;; Read the certified-read file from last session (save-excursion (save-window-excursion (setq news-current-certifications (car-safe (condition-case var (let* ((file (substitute-in-file-name news-certification-file)) (buf (find-file-noselect file))) (and (file-exists-p file) (progn (switch-to-buffer buf 'norecord) (unwind-protect (read-from-string (buffer-string)) (kill-buffer buf))))) (error nil))))))) (defun news-write-certifications () ;; Write a certification file. ;; This is an assoc list of group names with doubletons that represent ;; mod times of the directory when group is read completely. (save-excursion (save-window-excursion (with-output-to-temp-buffer "*CeRtIfIcAtIoNs*" (print news-current-certifications)) (let ((buf (get-buffer "*CeRtIfIcAtIoNs*"))) (switch-to-buffer buf) (write-file (substitute-in-file-name news-certification-file)) (kill-buffer buf))))) (defun news-set-current-group-certification () (let ((cgc (assoc news-current-news-group news-current-certifications))) (if cgc (setcdr cgc news-current-certifiable) (news-push (cons news-current-news-group news-current-certifiable) news-current-certifications)))) (defun news-set-minor-modes () "Creates a minor mode list that has group name, total articles, and attribute for current article." (setq news-minor-modes (list (cons 'foo (concat news-current-message-number "/" news-total-current-group (news-get-attribute-string))))) ;; Detect Emacs versions 18.16 and up, which display ;; directly from news-minor-modes by using a list for mode-name. (or (boundp 'minor-mode-alist) (setq minor-modes news-minor-modes))) (defun news-set-message-counters () "Scan through current news-groups filelist to figure out how many messages are there. Set counters for use with minor mode display." (if (null news-list-of-files) (setq news-current-message-number 0))) (if news-mode-map nil (setq news-mode-map (make-keymap)) (suppress-keymap news-mode-map) (define-key news-mode-map "." 'beginning-of-buffer) (define-key news-mode-map " " 'scroll-up) (define-key news-mode-map "\177" 'scroll-down) (define-key news-mode-map "n" 'news-next-message) (define-key news-mode-map "c" 'news-make-link-to-message) (define-key news-mode-map "p" 'news-previous-message) (define-key news-mode-map "j" 'news-goto-message) (define-key news-mode-map "q" 'news-exit) (define-key news-mode-map "e" 'news-exit) (define-key news-mode-map "\ej" 'news-goto-news-group) (define-key news-mode-map "\en" 'news-next-group) (define-key news-mode-map "\ep" 'news-previous-group) (define-key news-mode-map "l" 'news-list-news-groups) (define-key news-mode-map "?" 'describe-mode) (define-key news-mode-map "g" 'news-get-new-news) (define-key news-mode-map "f" 'news-reply) (define-key news-mode-map "m" 'news-mail-other-window) (define-key news-mode-map "a" 'news-post-news) (define-key news-mode-map "r" 'news-mail-reply) (define-key news-mode-map "o" 'news-save-item-in-file) (define-key news-mode-map "\C-o" 'rmail-output) (define-key news-mode-map "t" 'news-show-all-headers) (define-key news-mode-map "x" 'news-force-update) (define-key news-mode-map "A" 'news-add-news-group) (define-key news-mode-map "u" 'news-unsubscribe-current-group) (define-key news-mode-map "U" 'news-unsubscribe-group) (define-key news-mode-map "\C-c\C-r" 'news-caesar-buffer-body)) (defun news-mode () "News Mode is used by M-x rnews for reading USENET Newsgroups articles. New readers can find additional help in newsgroup: news.announce.newusers . All normal editing commands are turned off. Instead, these commands are available: . move point to front of this news article (same as Meta-<). Space scroll to next screen of this news article. Delete scroll down previous page of this news article. n move to next news article, possibly next group. p move to previous news article, possibly previous group. j jump to news article specified by numeric position. M-j jump to news group. M-n goto next news group. M-p goto previous news group. l list all the news groups with current status. ? print this help message. C-c C-r caesar rotate all letters by 13 places in the article's body (rot13). g get new USENET news. f post a reply article to USENET. a post an original news article. A add a newsgroup. o save the current article in the named file (append if file exists). C-o output this message to a Unix-format mail file (append it). c \"copy\" (actually link) current or prefix-arg msg to file. warning: target directory and message file must be on same device (UNIX magic) t show all the headers this news article originally had. q quit reading news after updating .newsrc file. e exit updating .newsrc file. m mail a news article. Same as C-x 4 m. x update last message seen to be the current message. r mail a reply to this news article. Like m but initializes some fields. u unsubscribe from current newsgroup. U unsubscribe from specified newsgroup." (interactive) (kill-all-local-variables) (make-local-variable 'news-read-first-time-p) (setq news-read-first-time-p t) (make-local-variable 'news-current-news-group) ; (setq news-current-news-group "??") (make-local-variable 'news-current-group-begin) (setq news-current-group-begin 0) (make-local-variable 'news-current-message-number) (setq news-current-message-number 0) (make-local-variable 'news-total-current-group) (make-local-variable 'news-buffer-save) (make-local-variable 'version-control) (setq version-control 'never) (make-local-variable 'news-point-pdl) ; This breaks it. I don't have time to figure out why. -- RMS ; (make-local-variable 'news-group-article-assoc) (setq major-mode 'news-mode) (setq mode-line-process '(news-minor-modes)) (setq mode-name "NEWS") (news-set-mode-line) (set-syntax-table text-mode-syntax-table) (use-local-map news-mode-map) (setq local-abbrev-table text-mode-abbrev-table) (run-hooks 'news-mode-hook)) (defun string-subst-char (new old string) (let (index) (setq old (regexp-quote (char-to-string old)) string (substring string 0)) (while (setq index (string-match old string)) (aset string index new))) string) ;; update read message number (defmacro news-update-message-read (ngroup nno) (list 'setcar (list 'news-cdadr (list 'assoc ngroup 'news-group-article-assoc)) nno)) (defun news-parse-range (number-string) "Parse string representing range of numbers of he form - to a list (a . b)" (let ((n (string-match "-" number-string))) (if n (cons (string-to-int (substring number-string 0 n)) (string-to-int (substring number-string (1+ n)))) (setq n (string-to-int number-string)) (cons n n)))) ;(defun is-in (elt lis) ; (catch 'foo ; (while lis ; (if (equal (car lis) elt) ; (throw 'foo t) ; (setq lis (cdr lis)))))) (defun news-get-new-news () "Get new USENET news, if there is any for the current user." (interactive) (if (not (null news-user-group-list)) (news-update-newsrc-file)) (setq news-group-article-assoc ()) (setq news-user-group-list ()) (message "Looking up %s file..." news-startup-file) (let ((file (substitute-in-file-name news-startup-file)) (temp-user-groups ())) (save-excursion (let ((newsrcbuf (find-file-noselect file)) start end endofline tem) (set-buffer newsrcbuf) (goto-char 0) (while (search-forward ": " nil t) (setq end (point)) (beginning-of-line) (setq start (point)) (end-of-line) (setq endofline (point)) (setq tem (buffer-substring start (- end 2))) (let ((range (news-parse-range (buffer-substring end endofline)))) (if (assoc tem news-group-article-assoc) (message "You are subscribed twice to %s; I ignore second" tem) (setq temp-user-groups (cons tem temp-user-groups) news-group-article-assoc (cons (list tem (list (car range) (cdr range) (cdr range))) news-group-article-assoc))))) (kill-buffer newsrcbuf))) (setq temp-user-groups (nreverse temp-user-groups)) (message "Prefrobnicating...") (switch-to-buffer news-buffer) (setq news-user-group-list temp-user-groups) (while (and temp-user-groups (not (news-read-files-into-buffer (car temp-user-groups) nil))) (setq temp-user-groups (cdr temp-user-groups))) (if (null temp-user-groups) (message "No news is good news.") (message "")))) (defun news-list-news-groups () "Display all the news groups to which you belong." (interactive) (with-output-to-temp-buffer "*Newsgroups*" (save-excursion (set-buffer standard-output) (insert "News Group Msg No. News Group Msg No.\n") (insert "------------------------- -------------------------\n") (let ((temp news-user-group-list) (flag nil)) (while temp (let ((item (assoc (car temp) news-group-article-assoc))) (insert (car item)) (indent-to (if flag 52 20)) (insert (int-to-string (news-cadr (news-cadr item)))) (if flag (insert "\n") (indent-to 33)) (setq temp (cdr temp) flag (not flag)))))))) ;; Mode line hack (defun news-set-mode-line () "Set mode line string to something useful." (setq mode-line-process (concat " " (if (integerp news-current-message-number) (int-to-string news-current-message-number) "??") "/" (if (integerp news-current-group-end) (int-to-string news-current-group-end) news-current-group-end))) (setq mode-line-buffer-identification (concat "NEWS: " news-current-news-group ;; Enough spaces to pad group name to 17 positions. (substring " " 0 (max 0 (- 17 (length news-current-news-group)))))) (set-buffer-modified-p t) (sit-for 0)) (defun news-goto-news-group (gp) "Takes a string and goes to that news group." (interactive (list (completing-read "NewsGroup: " news-group-article-assoc))) (message "Jumping to news group %s..." gp) (news-select-news-group gp) (message "Jumping to news group %s... done." gp)) (defun news-select-news-group (gp) (let ((grp (assoc gp news-group-article-assoc))) (if (null grp) (error "Group %s not subscribed to" gp) (progn (news-update-message-read news-current-news-group (news-cdar news-point-pdl)) (news-read-files-into-buffer (car grp) nil) (news-set-mode-line))))) (defun news-goto-message (arg) "Goes to the article ARG in current newsgroup." (interactive "p") (if (null current-prefix-arg) (setq arg (read-no-blanks-input "Go to article: " ""))) (news-select-message arg)) (defun news-select-message (arg) (if (stringp arg) (setq arg (string-to-int arg))) (let ((file (concat news-path (string-subst-char ?/ ?. news-current-news-group) "/" arg))) (if (= arg (or (news-cadr (memq (news-cdar news-point-pdl) news-list-of-files)) 0)) (setcdr (car news-point-pdl) arg)) (setq news-current-message-number arg) (if (file-exists-p file) (let ((buffer-read-only nil)) (news-read-in-file file) (news-set-mode-line)) (news-set-mode-line) (error "Article %d nonexistent" arg)))) (defun news-force-update () "updates the position of last article read in the current news group" (interactive) (setcdr (car news-point-pdl) news-current-message-number) (message "Updated to %d" news-current-message-number)) (defun news-next-message (arg) "Move ARG messages forward within one newsgroup. Negative ARG moves backward. If ARG is 1 or -1, moves to next or previous newsgroup if at end." (interactive "p") (let ((no (+ arg news-current-message-number))) (if (or (< no news-current-group-begin) (> no news-current-group-end)) (cond ((= arg 1) (news-set-current-group-certification) (news-next-group)) ((= arg -1) (news-previous-group)) (t (error "Article out of range"))) (let ((plist (news-get-motion-lists news-current-message-number news-list-of-files))) (if (< arg 0) (news-select-message (nth (1- (- arg)) (car (cdr plist)))) (news-select-message (nth (1- arg) (car plist)))))))) (defun news-previous-message (arg) "Move ARG messages backward in current newsgroup. With no arg or arg of 1, move one message and move to previous newsgroup if at beginning. A negative ARG means move forward." (interactive "p") (news-next-message (- arg))) (defun news-move-to-group (arg) "Given arg move forward or backward to a new newsgroup." (let ((cg news-current-news-group)) (let ((plist (news-get-motion-lists cg news-user-group-list)) ngrp) (if (< arg 0) (or (setq ngrp (nth (1- (- arg)) (news-cadr plist))) (error "No previous news groups")) (or (setq ngrp (nth arg (car plist))) (error "No more news groups"))) (news-select-news-group ngrp)))) (defun news-next-group () "Moves to the next user group." (interactive) ; (message "Moving to next group...") (news-move-to-group 0) (while (null news-list-of-files) (news-move-to-group 0))) ; (message "Moving to next group... done.") (defun news-previous-group () "Moves to the previous user group." (interactive) ; (message "Moving to previous group...") (news-move-to-group -1) (while (null news-list-of-files) (news-move-to-group -1))) ; (message "Moving to previous group... done.") (defun news-get-motion-lists (arg listy) "Given a msgnumber/group this will return a list of two lists; one for moving forward and one for moving backward." (let ((temp listy) (result ())) (catch 'out (while temp (if (equal (car temp) arg) (throw 'out (cons (cdr temp) (list result))) (setq result (nconc (list (car temp)) result)) (setq temp (cdr temp))))))) ;; miscellaneous io routines (defun news-read-in-file (filename) (erase-buffer) (let ((start (point))) (insert-file-contents filename) (news-convert-format) ;; Run each hook that applies to the current newsgroup. (let ((hooks news-group-hook-alist)) (while hooks (goto-char start) (if (string-match (car (car hooks)) news-group-name) (funcall (cdr (car hooks)))) (setq hooks (cdr hooks)))) (goto-char start) (forward-line 1) (if (eobp) (message "(Empty file?)") (goto-char start)))) (defun news-convert-format () (save-excursion (save-restriction (let* ((start (point)) (end (condition-case () (progn (search-forward "\n\n") (point)) (error nil))) has-from has-date) (cond (end (narrow-to-region start end) (goto-char start) (setq has-from (search-forward "\nFrom:" nil t)) (cond ((and (not has-from) has-date) (goto-char start) (search-forward "\nDate:") (beginning-of-line) (kill-line) (kill-line))) (news-delete-headers start) (goto-char start))))))) (defun news-show-all-headers () "Redisplay current news item with all original headers" (interactive) (let (news-ignored-headers (buffer-read-only ())) (erase-buffer) (news-set-mode-line) (news-read-in-file (concat news-path (string-subst-char ?/ ?. news-current-news-group) "/" (int-to-string news-current-message-number))))) (defun news-delete-headers (pos) (goto-char pos) (and (stringp news-ignored-headers) (while (re-search-forward news-ignored-headers nil t) (beginning-of-line) (delete-region (point) (progn (re-search-forward "\n[^ \t]") (forward-char -1) (point)))))) (defun news-exit () "Quit news reading session and update the .newsrc file." (interactive) (if (y-or-n-p "Do you really wanna quit reading news ? ") (progn (message "Updating %s..." news-startup-file) (news-update-newsrc-file) (news-write-certifications) (message "Updating %s... done" news-startup-file) (message "Now do some real work") (and (fboundp 'bury-buffer) (bury-buffer (current-buffer))) (switch-to-buffer news-buffer-save) (setq news-user-group-list ())) (message ""))) (defun news-update-newsrc-file () "Updates the .newsrc file in the users home dir." (let ((newsrcbuf (find-file-noselect (substitute-in-file-name news-startup-file))) (tem news-user-group-list) group) (save-excursion (if (not (null news-current-news-group)) (news-update-message-read news-current-news-group (news-cdar news-point-pdl))) (set-buffer newsrcbuf) (while tem (setq group (assoc (car tem) news-group-article-assoc)) (if (= (news-cadr (news-cadr group)) (news-caddr (news-cadr group))) nil (goto-char 0) (if (search-forward (concat (car group) ": ") nil t) (kill-line nil) (insert (car group) ": \n") (backward-char 1)) (insert (int-to-string (car (news-cadr group))) "-" (int-to-string (news-cadr (news-cadr group))))) (setq tem (cdr tem))) (while news-unsubscribe-groups (setq group (assoc (car news-unsubscribe-groups) news-group-article-assoc)) (goto-char 0) (if (search-forward (concat (car group) ": ") nil t) (progn (backward-char 2) (kill-line nil) (insert "! " (int-to-string (car (news-cadr group))) "-" (int-to-string (news-cadr (news-cadr group)))))) (setq news-unsubscribe-groups (cdr news-unsubscribe-groups))) (save-buffer) (kill-buffer (current-buffer))))) (defun news-unsubscribe-group (group) "Removes you from newgroup GROUP." (interactive (list (completing-read "Unsubscribe from group: " news-group-article-assoc))) (news-unsubscribe-internal group)) (defun news-unsubscribe-current-group () "Removes you from the newsgroup you are now reading." (interactive) (if (y-or-n-p "Do you really want to unsubscribe from this group ? ") (news-unsubscribe-internal news-current-news-group))) (defun news-unsubscribe-internal (group) (let ((tem (assoc group news-group-article-assoc))) (if tem (progn (setq news-unsubscribe-groups (cons group news-unsubscribe-groups)) (news-update-message-read group (news-cdar news-point-pdl)) (if (equal group news-current-news-group) (news-next-group)) (message "")) (error "Not subscribed to group: %s" group)))) (defun news-save-item-in-file (file) "Save the current article that is being read by appending to a file." (interactive "FSave item in file: ") (append-to-file (point-min) (point-max) file)) (defun news-get-pruned-list-of-files (gp-list end-file-no) "Given a news group it finds all files in the news group. The arg must be in slashified format. Using ls was found to be too slow in a previous version." (let ((answer (and (not (and end-file-no (equal (news-set-current-certifiable) (news-group-certification gp-list)) (setq news-list-of-files nil news-list-of-files-possibly-bogus t))) (let* ((file-directory (concat news-path (string-subst-char ?/ ?. gp-list))) tem (last-winner (and end-file-no (news-wins file-directory end-file-no) (news-find-first-or-last file-directory end-file-no 1)))) (setq news-list-of-files-possibly-bogus t news-list-of-files nil) (if last-winner (progn (setq news-list-of-files-possibly-bogus t news-current-group-end last-winner) (while (> last-winner end-file-no) (news-push last-winner news-list-of-files) (setq last-winner (1- last-winner))) news-list-of-files) (if (or (not (file-directory-p file-directory)) (not (file-readable-p file-directory))) nil (setq news-list-of-files (condition-case error (directory-files file-directory) (file-error (if (string= (nth 2 error) "permission denied") (message "Newsgroup %s is read-protected" gp-list) (signal 'file-error (cdr error))) nil))) (setq tem news-list-of-files) (while tem (if (or (not (string-match "^[0-9]*$" (car tem))) ;; dont get confused by directories that look like numbers (file-directory-p (concat file-directory "/" (car tem))) (<= (string-to-int (car tem)) end-file-no)) (setq news-list-of-files (delq (car tem) news-list-of-files))) (setq tem (cdr tem))) (if (null news-list-of-files) (progn (setq news-current-group-end 0) nil) (setq news-list-of-files (mapcar 'string-to-int news-list-of-files)) (setq news-list-of-files (sort news-list-of-files '<)) (setq news-current-group-end (elt news-list-of-files (1- (length news-list-of-files)))) news-list-of-files))))))) (or answer (progn (news-set-current-group-certification) nil)))) (defun news-read-files-into-buffer (group reversep) (let* ((files-start-end (news-cadr (assoc group news-group-article-assoc))) (start-file-no (car files-start-end)) (end-file-no (news-cadr files-start-end)) (buffer-read-only nil)) (setq news-current-news-group group) (setq news-current-message-number nil) (setq news-current-group-end nil) (news-set-mode-line) (news-get-pruned-list-of-files group end-file-no) (news-set-mode-line) ;; @@ should be a lot smarter than this if we have to move ;; @@ around correctly. (setq news-point-pdl (list (cons (car files-start-end) (news-cadr files-start-end)))) (if (null news-list-of-files) (progn (erase-buffer) (setq news-current-group-end end-file-no) (setq news-current-group-begin end-file-no) (setq news-current-message-number end-file-no) (news-set-mode-line) ; (message "No new articles in " group " group.") nil) (setq news-current-group-begin (car news-list-of-files)) (if reversep (setq news-current-message-number news-current-group-end) (if (> (car news-list-of-files) end-file-no) (setcdr (car news-point-pdl) (car news-list-of-files))) (setq news-current-message-number news-current-group-begin)) (news-set-message-counters) (news-set-mode-line) (news-read-in-file (concat news-path (string-subst-char ?/ ?. group) "/" (int-to-string news-current-message-number))) (news-set-message-counters) (news-set-mode-line) t))) (defun news-add-news-group (gp) "Resubscribe to or add a USENET news group named GROUP (a string)." ; @@ (completing-read ...) ; @@ could be based on news library file ../active (slightly facist) ; @@ or (expensive to compute) all directories under the news spool directory (interactive "sAdd news group: ") (let ((file-dir (concat news-path (string-subst-char ?/ ?. gp)))) (save-excursion (if (null (assoc gp news-group-article-assoc)) (let ((newsrcbuf (find-file-noselect (substitute-in-file-name news-startup-file)))) (if (file-directory-p file-dir) (progn (switch-to-buffer newsrcbuf) (goto-char 0) (if (search-forward (concat gp "! ") nil t) (progn (message "Re-subscribing to group %s." gp) ;;@@ news-unsubscribe-groups isn't being used ;;(setq news-unsubscribe-groups ;; (delq gp news-unsubscribe-groups)) (backward-char 2) (delete-char 1) (insert ":")) (progn (message "Added %s to your list of newsgroups." gp) (end-of-buffer) (insert gp ": 1-1\n"))) (search-backward gp nil t) (let (start end endofline tem) (search-forward ": " nil t) (setq end (point)) (beginning-of-line) (setq start (point)) (end-of-line) (setq endofline (point)) (setq tem (buffer-substring start (- end 2))) (let ((range (news-parse-range (buffer-substring end endofline)))) (setq news-group-article-assoc (cons (list tem (list (car range) (cdr range) (cdr range))) news-group-article-assoc)))) (save-buffer) (kill-buffer (current-buffer))) (message "Newsgroup %s doesn't exist." gp))) (message "Already subscribed to group %s." gp))))) (defun news-make-link-to-message (number newname) "Forges a link to an rnews message numbered number (current if no arg) Good for hanging on to a message that might or might not be automatically deleted." (interactive "P FName to link to message: ") (add-name-to-file (concat news-path (string-subst-char ?/ ?. news-current-news-group) "/" (if number (prefix-numeric-value number) news-current-message-number)) newname)) ;;; caesar-region written by phr@prep.ai.mit.edu Nov 86 ;;; modified by tower@prep Nov 86 (defun caesar-region (&optional n) "Caesar rotation of region by N, default 13, for decrypting netnews." (interactive (if current-prefix-arg ; Was there a prefix arg? (list (prefix-numeric-value current-prefix-arg)) (list nil))) (cond ((not (numberp n)) (setq n 13)) (t (setq n (mod n 26)))) ;canonicalize N (if (not (zerop n)) ; no action needed for a rot of 0 (progn (if (or (not (boundp 'caesar-translate-table)) (/= (aref caesar-translate-table ?a) (+ ?a n))) (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper) (message "Building caesar-translate-table...") (setq caesar-translate-table (make-vector 256 0)) (while (< i 256) (aset caesar-translate-table i i) (setq i (1+ i))) (setq lower (concat lower lower) upper (upcase lower) i 0) (while (< i 26) (aset caesar-translate-table (+ ?a i) (aref lower (+ i n))) (aset caesar-translate-table (+ ?A i) (aref upper (+ i n))) (setq i (1+ i))) (message "Building caesar-translate-table... done"))) (let ((from (region-beginning)) (to (region-end)) (i 0) str len) (setq str (buffer-substring from to)) (setq len (length str)) (while (< i len) (aset str i (aref caesar-translate-table (aref str i))) (setq i (1+ i))) (goto-char from) (kill-region from to) (insert str))))) ;;; news-caesar-buffer-body written by paul@media-lab.mit.edu Wed Oct 1, 1986 ;;; hacked further by tower@prep.ai.mit.edu (defun news-caesar-buffer-body (&optional rotnum) "Caesar rotates all letters in the current buffer by 13 places. Used to encode/decode possibly offensive messages (commonly in net.jokes). With prefix arg, specifies the number of places to rotate each letter forward. Mail and USENET news headers are not rotated." (interactive (if current-prefix-arg ; Was there a prefix arg? (list (prefix-numeric-value current-prefix-arg)) (list nil))) (save-excursion (let ((buffer-status buffer-read-only)) (setq buffer-read-only nil) ;; setup the region (set-mark (if (progn (goto-char (point-min)) (search-forward (concat "\n" (if (equal major-mode 'news-mode) "" mail-header-separator) "\n") nil t)) (point) (point-min))) (goto-char (point-max)) (caesar-region rotnum) (setq buffer-read-only buffer-status)))) (provide 'rnews) ;;; rnews.el ends here emacs-19.30/lisp/rnewspost.el100444 12120 1 41331 5753565160 14473 0ustar rmsdaemon;;; rnewspost.el --- USENET news poster/mailer for GNU Emacs ;; Copyright (C) 1985, 1986, 1987, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail, news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;; Change Log: ;; moved posting and mail code from rnews.el ;; tower@prep.ai.mit.edu Wed Oct 29 1986 ;; brought posting code almost up to the revision of RFC 850 for News 2.11 ;; - couldn't see handling the special meaning of the Keyword: poster ;; - not worth the code space to support the old A news Title: (which ;; Subject: replaced) and Article-I.D.: (which Message-ID: replaced) ;; tower@prep Nov 86 ;; changed C-c C-r key-binding due to rename of news-caesar-buffer-body ;; tower@prep 21 Nov 86 ;; added (require 'rnews) tower@prep 22 Apr 87 ;; restricted call of news-show-all-headers in news-post-news & news-reply ;; tower@prep 28 Apr 87 ;; commented out Posting-Front-End to save USENET bytes tower@prep Jul 31 87 ;; commented out -n and -t args in news-inews tower@prep 15 Oct 87 ;Now in paths.el. ;(defvar news-inews-program "inews" ; "Function to post news.") ;; Replying and posting news items are done by these functions. ;; imported from rmail and modified to work with rnews ... ;; Mon Mar 25,1985 at 03:07:04 ads@mit-hermes. ;; this is done so that rnews can operate independently from rmail.el and ;; sendmail and dosen't have to autoload these functions. ;; ;;; >> Nuked by Mly to autoload those functions again, as the duplication of ;;; >> code was making maintenance too difficult. ;;; Code: (require 'sendmail) (require 'rnews) (defvar news-reply-mode-map () "Mode map used by news-reply.") (or news-reply-mode-map (progn (setq news-reply-mode-map (make-keymap)) (define-key news-reply-mode-map "\C-c\C-f\C-d" 'news-reply-distribution) (define-key news-reply-mode-map "\C-c\C-f\C-k" 'news-reply-keywords) (define-key news-reply-mode-map "\C-c\C-f\C-n" 'news-reply-newsgroups) (define-key news-reply-mode-map "\C-c\C-f\C-f" 'news-reply-followup-to) (define-key news-reply-mode-map "\C-c\C-f\C-s" 'mail-subject) (define-key news-reply-mode-map "\C-c\C-f\C-a" 'news-reply-summary) (define-key news-reply-mode-map "\C-c\C-t" 'mail-text) (define-key news-reply-mode-map "\C-c\C-r" 'news-caesar-buffer-body) (define-key news-reply-mode-map "\C-c\C-w" 'news-reply-signature) (define-key news-reply-mode-map "\C-c\C-y" 'news-reply-yank-original) (define-key news-reply-mode-map "\C-c\C-q" 'mail-fill-yanked-message) (define-key news-reply-mode-map "\C-c\C-c" 'news-inews) (define-key news-reply-mode-map "\C-c\C-s" 'news-inews) (define-key news-reply-mode-map [menu-bar] (make-sparse-keymap)) (define-key news-reply-mode-map [menu-bar fields] (cons "Fields" (make-sparse-keymap "Fields"))) (define-key news-reply-mode-map [menu-bar fields news-reply-distribution] '("Distribution" . news-reply-distribution)) (define-key news-reply-mode-map [menu-bar fields news-reply-keywords] '("Keywords" . news-reply-keywords)) (define-key news-reply-mode-map [menu-bar fields news-reply-newsgroups] '("Newsgroups" . news-reply-newsgroups)) (define-key news-reply-mode-map [menu-bar fields news-reply-followup-to] '("Followup-to" . news-reply-followup-to)) (define-key news-reply-mode-map [menu-bar fields mail-subject] '("Subject" . mail-subject)) (define-key news-reply-mode-map [menu-bar fields news-reply-summary] '("Summary" . news-reply-summary)) (define-key news-reply-mode-map [menu-bar fields mail-text] '("Text" . mail-text)) (define-key news-reply-mode-map [menu-bar news] (cons "News" (make-sparse-keymap "News"))) (define-key news-reply-mode-map [menu-bar news news-caesar-buffer-body] '("Rot13" . news-caesar-buffer-body)) (define-key news-reply-mode-map [menu-bar news news-reply-signature] '("Signature" . news-reply-signature)) (define-key news-reply-mode-map [menu-bar news news-reply-yank-original] '("Yank Original" . news-reply-yank-original)) (define-key news-reply-mode-map [menu-bar news mail-fill-yanked-message] '("Fill Yanked Messages" . mail-fill-yanked-message)) (define-key news-reply-mode-map [menu-bar news news-inews] '("Send" . news-inews)))) (defun news-reply-mode () "Major mode for editing news to be posted on USENET. First-time posters are asked to please read the articles in newsgroup: news.announce.newusers . Like Text Mode but with these additional commands: C-c C-s news-inews (post the message) C-c C-c news-inews C-c C-f move to a header field (and create it if there isn't): C-c C-f C-n move to Newsgroups: C-c C-f C-s move to Subj: C-c C-f C-f move to Followup-To: C-c C-f C-k move to Keywords: C-c C-f C-d move to Distribution: C-c C-f C-a move to Summary: C-c C-y news-reply-yank-original (insert current message, in NEWS). C-c C-q mail-fill-yanked-message (fill what was yanked). C-c C-r caesar rotate all letters by 13 places in the article's body (rot13)." (interactive) ;; require... (or (fboundp 'mail-setup) (load "sendmail")) (kill-all-local-variables) (make-local-variable 'mail-reply-buffer) (setq mail-reply-buffer nil) (set-syntax-table text-mode-syntax-table) (use-local-map news-reply-mode-map) (setq local-abbrev-table text-mode-abbrev-table) (setq major-mode 'news-reply-mode) (setq mode-name "News Reply") (make-local-variable 'paragraph-separate) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "^" (regexp-quote mail-header-separator) "$\\|" paragraph-start)) (setq paragraph-separate (concat "^" (regexp-quote mail-header-separator) "$\\|" paragraph-separate)) (run-hooks 'text-mode-hook 'news-reply-mode-hook)) (defvar news-reply-yank-from "Save `From:' field for `news-reply-yank-original'." "") (defvar news-reply-yank-message-id "Save `Message-Id:' field for `news-reply-yank-original'." "") (defun news-reply-yank-original (arg) "Insert the message being replied to, if any (in Mail mode). Puts point before the text and mark after. Indents each nonblank line ARG spaces (default 3). Just \\[universal-argument] as argument means don't indent and don't delete any header fields." (interactive "P") (mail-yank-original arg) (exchange-point-and-mark) (run-hooks 'news-reply-header-hook)) (defvar news-reply-header-hook '(lambda () (insert "In article " news-reply-yank-message-id " " news-reply-yank-from " writes:\n\n")) "Hook for inserting a header at the top of a yanked message.") (defun news-reply-newsgroups () "Move point to end of `Newsgroups:' field. RFC 850 constrains the `Newsgroups:' field to be a comma-separated list of valid newsgroup names at your site. For example, Newsgroups: news.misc,comp.misc,rec.misc" (interactive) (expand-abbrev) (goto-char (point-min)) (mail-position-on-field "Newsgroups")) (defun news-reply-followup-to () "Move point to end of `Followup-To:' field. Create the field if none. One usually requests followups to only one newsgroup. RFC 850 constrains the `Followup-To:' field to be a comma-separated list of valid newsgroups names at your site, and it must be a subset of the `Newsgroups:' field. For example: Newsgroups: news.misc,comp.misc,rec.misc,misc.misc,soc.misc Followup-To: news.misc,comp.misc,rec.misc" (interactive) (expand-abbrev) (or (mail-position-on-field "Followup-To" t) (progn (mail-position-on-field "newsgroups") (insert "\nFollowup-To: "))) ;; @@ could do a completing read based on the Newsgroups: field to ;; @@ fill in the Followup-To: field ) (defun news-reply-distribution () "Move point to end of `Distribution:' optional field. Create the field if none. Without this field the posting goes to all of USENET. The field is used to restrict the posting to parts of USENET." (interactive) (expand-abbrev) (mail-position-on-field "Distribution") ;; @@could do a completing read based on the news library file: ;; @@ ../distributions to fill in the field. ) (defun news-reply-keywords () "Move point to end of `Keywords:' optional field. Create the field if none. Used as an aid to the news reader, it can contain a few, well selected keywords identifying the message." (interactive) (expand-abbrev) (mail-position-on-field "Keywords")) (defun news-reply-summary () "Move point to end of `Summary:' optional field. Create the field if none. Used as an aid to the news reader, it can contain a succinct summary (abstract) of the message." (interactive) (expand-abbrev) (mail-position-on-field "Summary")) (defun news-reply-signature () "The inews program appends `~/.signature' automatically." (interactive) (message "`~/.signature' will be appended automatically.")) (defun news-setup (to subject in-reply-to newsgroups replybuffer) "Set up the news reply or posting buffer with the proper headers and mode." (setq mail-reply-buffer replybuffer) (let ((mail-setup-hook nil) ;; Avoid inserting a signature. (mail-signature)) (if (null to) ;; this hack is needed so that inews wont be confused by ;; the fcc: and bcc: fields (let ((mail-self-blind nil) (mail-archive-file-name nil)) (mail-setup to subject in-reply-to nil replybuffer nil) (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point))) (goto-char (point-max))) (mail-setup to subject in-reply-to nil replybuffer nil)) ;;;(mail-position-on-field "Posting-Front-End") ;;;(insert (emacs-version)) (goto-char (point-max)) (if (let ((case-fold-search t)) (re-search-backward "^Subject:" (point-min) t)) (progn (beginning-of-line) (insert "Newsgroups: " (or newsgroups "") "\n") (if (not newsgroups) (backward-char 1) (goto-char (point-max))))) (run-hooks 'news-setup-hook))) (defun news-inews () "Send a news message using inews." (interactive) (let* (newsgroups subject (case-fold-search nil)) (save-excursion (save-restriction (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n")) (narrow-to-region (point-min) (point)) (setq newsgroups (mail-fetch-field "newsgroups") subject (mail-fetch-field "subject"))) (widen) (goto-char (point-min)) (run-hooks 'news-inews-hook) (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n")) (replace-match "\n\n") (goto-char (point-max)) ;; require a newline at the end for inews to append .signature to (or (= (preceding-char) ?\n) (insert ?\n)) (message "Posting to USENET...") (call-process-region (point-min) (point-max) news-inews-program nil 0 nil "-h") ; take all header lines! ;@@ setting of subject and newsgroups still needed? ;"-t" subject ;"-n" newsgroups (message "Posting to USENET... done") (goto-char (point-min)) ;restore internal header separator (search-forward "\n\n") (replace-match (concat "\n" mail-header-separator "\n")) (set-buffer-modified-p nil)) (and (fboundp 'bury-buffer) (bury-buffer)))) ;@@ shares some code with news-reply and news-post-news (defun news-mail-reply () "Mail a reply to the author of the current article. While composing the reply, use \\[news-reply-yank-original] to yank the original message into it." (interactive) (let (from cc subject date to reply-to (buffer (current-buffer))) (save-restriction (narrow-to-region (point-min) (progn (goto-line (point-min)) (search-forward "\n\n") (- (point) 1))) (setq from (mail-fetch-field "from") subject (mail-fetch-field "subject") reply-to (mail-fetch-field "reply-to") date (mail-fetch-field "date"))) (setq to from) (pop-to-buffer "*mail*") (mail nil (if reply-to reply-to to) subject (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) (concat (if stop-pos (substring from 0 stop-pos) from) "'s message of " date)) nil buffer))) ;@@ the guts of news-reply and news-post-news should be combined. -tower (defun news-reply () "Compose and post a reply (aka a followup) to the current article on USENET. While composing the followup, use \\[news-reply-yank-original] to yank the original message into it." (interactive) (if (y-or-n-p "Are you sure you want to followup to all of USENET? ") (let (from cc subject date to followup-to newsgroups message-of references distribution message-id (buffer (current-buffer))) (save-restriction (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of ;@@ of article file (equal major-mode 'news-mode) ;@@ if rmail-mode, ;@@ should show full headers (progn (news-show-all-headers) ;@@ should save/restore header state, ;@@ but rnews.el lacks support (narrow-to-region (point-min) (progn (goto-char (point-min)) (search-forward "\n\n") (- (point) 1))))) (setq from (mail-fetch-field "from") news-reply-yank-from from ;; @@ not handling old Title: field subject (mail-fetch-field "subject") date (mail-fetch-field "date") followup-to (mail-fetch-field "followup-to") newsgroups (or followup-to (mail-fetch-field "newsgroups")) references (mail-fetch-field "references") ;; @@ not handling old Article-I.D.: field distribution (mail-fetch-field "distribution") message-id (mail-fetch-field "message-id") news-reply-yank-message-id message-id) (pop-to-buffer "*post-news*") (news-reply-mode) (if (and (buffer-modified-p) (not (y-or-n-p "Unsent article being composed; erase it? "))) () (progn (erase-buffer) (and subject (progn (if (string-match "\\`Re: " subject) (while (string-match "\\`Re: " subject) (setq subject (substring subject 4)))) (setq subject (concat "Re: " subject)))) (and from (progn (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) (setq message-of (concat (if stop-pos (substring from 0 stop-pos) from) "'s message of " date))))) (news-setup nil subject message-of newsgroups buffer) (if followup-to (progn (news-reply-followup-to) (insert followup-to))) (if distribution (progn (mail-position-on-field "Distribution") (insert distribution))) (mail-position-on-field "References") (if references (insert references)) (if (and references message-id) (insert " ")) (if message-id (insert message-id)) (goto-char (point-max)))))) (message ""))) ;@@ the guts of news-reply and news-post-news should be combined. -tower ;;;###autoload (defun news-post-news () "Begin editing a new USENET news article to be posted. Type \\[describe-mode] once editing the article to get a list of commands." (interactive) (if (y-or-n-p "Are you sure you want to post to all of USENET? ") (let ((buffer (current-buffer))) (save-restriction (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of ;@@ of article file (equal major-mode 'news-mode) ;@@ if rmail-mode, ;@@ should show full headers (progn (news-show-all-headers) ;@@ should save/restore header state, ;@@ but rnews.el lacks support (narrow-to-region (point-min) (progn (goto-char (point-min)) (search-forward "\n\n") (- (point) 1))))) (setq news-reply-yank-from (mail-fetch-field "from") ;; @@ not handling old Article-I.D.: field news-reply-yank-message-id (mail-fetch-field "message-id"))) (pop-to-buffer "*post-news*") (news-reply-mode) (if (and (buffer-modified-p) (not (y-or-n-p "Unsent article being composed; erase it? "))) () ;@@ not saving point from last time (progn (erase-buffer) (news-setup () () () () buffer)))) (message ""))) (defun news-mail-other-window () "Send mail in another window. While composing the message, use \\[news-reply-yank-original] to yank the original message into it." (interactive) (mail-other-window nil nil nil nil nil (current-buffer))) ;;; rnewspost.el ends here emacs-19.30/lisp/rot13.el100444 12120 1 4340 5627223574 13356 0ustar rmsdaemon;;; rot13.el --- display a buffer in rot13. ;; Copyright (C) 1988 Free Software Foundation, Inc. ;; Author: Howard Gayle: ;; Maintainer: FSF ;; 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: ;; The single entry point, `rot13-other-window', performs a Caesar cipher ;; encrypt/decrypt on the current buffer and displays the result in another ;; window. Rot13 encryption is sometimes used on USENET as a read-at-your- ;; own-risk wrapper for material some might consider offensive, such as ;; ethnic humor. ;; ;; Written by Howard Gayle. ;; This hack is mainly to show off the char table stuff. ;;; Code: (defvar rot13-display-table (let ((table (make-display-table)) (i 0)) (while (< i 26) (aset table (+ i ?a) (vector (+ (% (+ i 13) 26) ?a))) (aset table (+ i ?A) (vector (+ (% (+ i 13) 26) ?A))) (setq i (1+ i))) table) "Char table for rot 13 display.") ;;;###autoload (defun rot13-other-window () "Display current buffer in rot 13 in another window. To terminate the rot13 display, delete that window." (interactive) (let ((w (display-buffer (current-buffer) t))) (set-window-display-table w rot13-display-table))) ;;;###autoload (defun toggle-rot13-mode () "Toggle the use of rot 13 encoding for the current window." (interactive) (if (eq (window-display-table (selected-window)) rot13-display-table) (set-window-display-table (selected-window) nil) (if (null (window-display-table (selected-window))) (set-window-display-table (selected-window) rot13-display-table)))) (provide 'rot13) ;;; rot13.el ends here emacs-19.30/lisp/rsz-mini.el100444 12120 1 24567 6016440411 14173 0ustar rmsdaemon;;; rsz-mini.el --- dynamically resize minibuffer to display entire contents ;; Copyright (C) 1990, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Noah Friedman ;; Roland McGrath ;; Maintainer: friedman@prep.ai.mit.edu ;; Keywords: minibuffer, window, frame, display ;; Status: Known to work in FSF GNU Emacs 19.26 and later. ;; $Id: rsz-mini.el,v 1.9 1995/08/03 17:38:07 rms Exp $ ;; 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 package allows the entire contents (or as much as possible) of the ;; minibuffer to be visible at once when typing. As the end of a line is ;; reached, the minibuffer will resize itself. When the user is done ;; typing, the minibuffer will return to its original size. ;; In window systems where it is possible to have a frame in which the ;; minibuffer is the only window, the frame itself can be resized. In FSF ;; GNU Emacs 19.22 and earlier, the frame may not be properly returned to ;; its original size after it ceases to be active because ;; `minibuffer-exit-hook' didn't exist until version 19.23. ;; ;; Prior to Emacs 19.26, minibuffer-exit-hook wasn't called after exiting ;; from the minibuffer by hitting the quit char. That meant that the ;; frame size restoration function wasn't being called in that case. In ;; 19.26 or later, minibuffer-exit-hook should be called anyway. ;; Note that the minibuffer and echo area are not the same! They simply ;; happen to occupy roughly the same place on the frame. Messages put in ;; the echo area will not cause any resizing by this package. ;; This package is considered a minor mode but it doesn't put anything in ;; minor-mode-alist because this mode is specific to the minibuffer, which ;; has no mode line. ;; To use this package, put the following in your .emacs: ;; ;; (autoload 'resize-minibuffer-mode "rsz-mini" nil t) ;; ;; Invoking the command `resize-minibuffer-mode' will then enable this mode. ;; Simply loading this file will also enable it. ;;; Code: ;;;###autoload (defvar resize-minibuffer-mode nil "*If non-`nil', resize the minibuffer so its entire contents are visible.") ;;;###autoload (defvar resize-minibuffer-window-max-height nil "*Maximum size the minibuffer window is allowed to become. If less than 1 or not a number, the limit is the height of the frame in which the active minibuffer window resides.") ;;;###autoload (defvar resize-minibuffer-window-exactly t "*Allow making minibuffer exactly the size to display all its contents. If `nil', the minibuffer window can temporarily increase in size but never get smaller while it is active. Any other value allows exact resizing.") ;;;###autoload (defvar resize-minibuffer-frame nil "*Allow changing the frame height of minibuffer frames. If non-`nil' and the active minibuffer is the sole window in its frame, allow changing the frame height.") ;;;###autoload (defvar resize-minibuffer-frame-max-height nil "*Maximum size the minibuffer frame is allowed to become. If less than 1 or not a number, there is no limit.") ;;;###autoload (defvar resize-minibuffer-frame-exactly t "*Allow making minibuffer frame exactly the size to display all its contents. If `nil', the minibuffer frame can temporarily increase in size but never get smaller while it is active. Any other value allows exact resizing.") ;; Variable used to store the height of the minibuffer frame ;; on entry, so it can be restored on exit. It is made local before it is ;; modified. Do not use it yourself. (defvar resize-minibuffer-frame-original-height nil) ;;;###autoload (defun resize-minibuffer-mode (&optional prefix) "Enable or disable resize-minibuffer mode. A negative prefix argument disables this mode. A positive argument or argument of 0 enables it. When this minor mode is enabled, the minibuffer is dynamically resized to contain the entire region of text put in it as you type. The variable `resize-minibuffer-mode' is set to t or nil depending on whether this mode is active or not. The maximum height to which the minibuffer can grow is controlled by the variable `resize-minibuffer-window-max-height'. The variable `resize-minibuffer-window-exactly' determines whether the minibuffer window should ever be shrunk to make it no larger than needed to display its contents. When using a window system, it is possible for a minibuffer to be the sole window in a frame. Since that window is already its maximum size, the only way to make more text visible at once is to increase the size of the frame. The variable `resize-minibuffer-frame' controls whether this should be done. The variables `resize-minibuffer-frame-max-height' and `resize-minibuffer-frame-exactly' are analogous to their window counterparts." (interactive "p") (or prefix (setq prefix 0)) (cond ((>= prefix 0) (setq resize-minibuffer-mode t)) (t (setq resize-minibuffer-mode nil)))) (defun resize-minibuffer-setup () (cond (resize-minibuffer-mode (cond ((and window-system (eq 'only (cdr (assq 'minibuffer (frame-parameters))))) ;; Checking for resize-minibuffer-frame is done outside the cond ;; predicate because that should always be t if this is a minibuffer ;; frame; it just shouldn't do anything if this flag is nil. (and resize-minibuffer-frame (progn ;; Can't trust the height stored in minibuffer-frame-alist ;; since the frame can be resized by the window manager and ;; that variable isn't updated. (make-local-variable 'resize-minibuffer-frame-original-height) (setq resize-minibuffer-frame-original-height (frame-height)) (make-local-hook 'post-command-hook) (add-hook 'post-command-hook 'resize-minibuffer-frame 'append t) (make-local-hook 'minibuffer-exit-hook) (add-hook 'minibuffer-exit-hook 'resize-minibuffer-frame-restore nil t) (resize-minibuffer-frame)))) (t (make-local-variable 'post-command-hook) ;; Copy this because add-hook modifies the list structure. (setq post-command-hook (copy-sequence post-command-hook)) (add-hook 'post-command-hook 'resize-minibuffer-window 'append) (make-local-variable 'minibuffer-exit-hook) (add-hook 'minibuffer-exit-hook 'resize-minibuffer-window-restore) (resize-minibuffer-window)))))) (defun resize-minibuffer-count-window-lines (&optional start end) "Return number of window lines occupied by text in region. The number of window lines may be greater than the number of actual lines in the buffer if any wrap on the display due to their length. Optional arguments START and END default to point-min and point-max, respectively." (or start (setq start (point-min))) (or end (setq end (point-max))) (if (= start end) 0 (save-excursion (save-restriction (widen) (narrow-to-region start end) (goto-char start) (vertical-motion (buffer-size)))))) ;; Resize the minibuffer window to contain the minibuffer's contents. (defun resize-minibuffer-window () (and (eq (selected-window) (minibuffer-window)) (let ((height (window-height)) (lines (1+ (resize-minibuffer-count-window-lines)))) (and (numberp resize-minibuffer-window-max-height) (> resize-minibuffer-window-max-height 0) (setq lines (min lines resize-minibuffer-window-max-height))) (or (if resize-minibuffer-window-exactly (= lines height) (<= lines height)) (enlarge-window (- lines height)))))) ;; This resizes the minibuffer back to one line as soon as it is exited ;; (e.g. when the user hits RET). This way, subsequent messages put in the ;; echo area aren't cluttered with leftover minibuffer text. ;; It should be called by minibuffer-exit-hook. ;; ;; Note that because it calls sit-for to force a screen update, strange ;; things may happen in the minibuffer, such as unexpanded partial ;; completions by complete.el showing their completion. ;; If this bothers you, just redefine this function to do nothing, in, say, ;; your after-load-alist. Perhaps there should be an option variable, ;; but I don't know if there's really any demand for it. ;; (Clobbering this definition is harmless because eventually emacs restores ;; its idea of the minibuffer window size when the minibuffer isn't in use ;; anyway; this is just a kludge because of the timing for that update). (defun resize-minibuffer-window-restore () (cond ((not (eq (minibuffer-window) (selected-window)))) ((> (window-height) 1) (enlarge-window (- 1 (window-height))) (sit-for 0)))) ;; Resize the minibuffer frame to contain the minibuffer's contents. ;; The minibuffer frame must be the current frame. (defun resize-minibuffer-frame () (let ((height (frame-height)) (lines (1+ (resize-minibuffer-count-window-lines)))) (and (numberp resize-minibuffer-frame-max-height) (> resize-minibuffer-frame-max-height 0) (setq lines (min lines resize-minibuffer-frame-max-height))) (cond ((> lines height) (set-frame-size (selected-frame) (frame-width) lines)) ((and resize-minibuffer-frame-exactly (> height resize-minibuffer-frame-original-height) (< lines height)) (set-frame-size (selected-frame) (frame-width) lines))))) ;; Restore the original height of the frame. ;; resize-minibuffer-frame-original-height is set in ;; resize-minibuffer-setup. (defun resize-minibuffer-frame-restore () (set-frame-size (selected-frame) (frame-width) resize-minibuffer-frame-original-height)) (provide 'rsz-mini) (add-hook 'minibuffer-setup-hook 'resize-minibuffer-setup) (resize-minibuffer-mode) ;; rsz-mini.el ends here emacs-19.30/lisp/s-region.el100444 75424 1 10757 5765373172 14367 0ustar kwzhdaemon;;; s-region.el --- set region using shift key. ;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Morten Welinder (terra@diku.dk) ;; Keywords: terminals ;; Favourite-brand-of-beer: None, I hate beer. ;; 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: ;; Having loaded this code you can set the region by holding down the ;; shift key and move the cursor to the other end of the region. The ;; functionallity provided by this code is similar to that provided by ;; the editors of Borland International's compilers for ms-dos. ;; Currently, s-region-move may be bound only to events that are vectors ;; of length one and whose last element is a symbol. Also, the functions ;; that are given this kind of overlay should be (interactive "p") ;; functions. ;; If the following keys are not already bound then... ;; C-insert is bound to copy-region-as-kill ;; S-delete is bound to kill-region ;; S-insert is bound to yank ;;; Code: (defvar s-region-overlay (make-overlay 1 1)) (overlay-put s-region-overlay 'face 'region) (overlay-put s-region-overlay 'priority 1000000) ; for hilit19 (defun s-region-unshift (key) "Remove shift modifier from last keypress KEY and return that as a key." (if (vectorp key) (let ((last (aref key (1- (length key))))) (if (symbolp last) (let* ((keyname (symbol-name last)) (pos (string-match "S-" keyname))) (if pos ;; We skip all initial parts of the event assuming that ;; those are setting up the prefix argument to the command. (vector (intern (concat (substring keyname 0 pos) (substring keyname (+ 2 pos))))) (error "Non-shifted key: %S" key))) (error "Key does not end in a symbol: %S" key))) (error "Non-vector key: %S" key))) (defun s-region-move-p1 (&rest arg) "This is an overlay function to point-moving keys that are interactive \"p\"" (interactive "p") (apply (function s-region-move) arg)) (defun s-region-move-p2 (&rest arg) "This is an overlay function to point-moving keys that are interactive \"P\"" (interactive "P") (apply (function s-region-move) arg)) (defun s-region-move (&rest arg) (if (if mark-active (not (equal last-command 's-region-move)) t) (set-mark-command nil) (message "")) ; delete the "Mark set" message (setq this-command 's-region-move) (apply (key-binding (s-region-unshift (this-command-keys))) arg) (move-overlay s-region-overlay (mark) (point) (current-buffer)) (sit-for 1) (delete-overlay s-region-overlay)) (defun s-region-bind (keylist &optional map) "Bind shifted keys in KEYLIST to s-region-move-p1 or s-region-move-p2. Each key in KEYLIST is shifted and bound to one of the s-region-move functions provided it is already bound to some command or other. Optional third argument MAP specifies keymap to add binding to, defaulting to global keymap." (let ((p2 (list 'scroll-up 'scroll-down 'beginning-of-buffer 'end-of-buffer))) (or map (setq map global-map)) (while keylist (let* ((key (car keylist)) (binding (key-binding key))) (if (commandp binding) (define-key map (vector (intern (concat "S-" (symbol-name (aref key 0))))) (cond ((memq binding p2) 's-region-move-p2) (t 's-region-move-p1))))) (setq keylist (cdr keylist))))) ;; Single keys (plus modifiers) only! (s-region-bind (list [right] [left] [up] [down] [C-left] [C-right] [C-up] [C-down] [M-left] [M-right] [M-up] [M-down] [next] [previous] [home] [end] [C-next] [C-previous] [C-home] [C-end] [M-next] [M-previous] [M-home] [M-end])) (or (global-key-binding [C-insert]) (global-set-key [C-insert] 'copy-region-as-kill)) (or (global-key-binding [S-delete]) (global-set-key [S-delete] 'kill-region)) (or (global-key-binding [S-insert]) (global-set-key [S-insert] 'yank)) (provide 's-region) ;; s-region.el ends here. emacs-19.30/lisp/saveplace.el100444 12120 1 17053 6054012053 14355 0ustar rmsdaemon;;; saveplace.el --- automatically save place in files. ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: Karl Fogel ;; Maintainer: FSF ;; Created: July, 1993 ;; Version: 1.2 ;; Keywords: bookmarks, placeholders ;; 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. ;; Automatically save place in files, so that visiting them later ;; (even during a different Emacs session) automatically moves point ;; to the saved position, when the file is first found. Uses the ;; value of buffer-local variable save-place to determine whether to ;; save position or not. ;; ;; Thanks to Stefan Schoef, who sent a patch with the ;; `save-place-version-control' stuff in it. ;; this is what I was using during testing: ;; (define-key ctl-x-map "p" 'toggle-save-place) (defvar save-place-alist nil "Alist of saved places to go back to when revisiting files. Each element looks like (FILENAME . POSITION); visiting file FILENAME goes automatically to position POSITION rather than the beginning of the buffer. This alist is saved between Emacs sessions.") (defvar save-place nil "*Non-nil means automatically save place in each file. This means when you visit a file, point goes to the last place where it was when you previously visited the same file. This variable is automatically buffer-local. If you wish your place in any file to always be automatically saved, simply put this in your `~/.emacs' file: \(setq-default save-place t\)") (make-variable-buffer-local 'save-place) (defvar save-place-file "~/.emacs-places" "*Name of the file that records `save-place-alist' value.") (defvar save-place-version-control 'nospecial "*Controls whether to make numbered backups of master save-place file. It can have four values: t, nil, `never', and `nospecial'. The first three have the same meaning that they do for the variable `version-control', and the final value `nospecial' means just use the value of `version-control'.") (defvar save-place-loaded nil "Non-nil means that the `save-place-file' has been loaded.") (defun toggle-save-place (&optional parg) "Toggle whether to save your place in this file between sessions. If this mode is enabled, point is recorded when you kill the buffer or exit Emacs. Visiting this file again will go to that position, even in a later Emacs session. If called with a prefix arg, the mode is enabled if and only if the argument is positive. To save places automatically in all files, put this in your `.emacs' file: \(setq-default save-place t\)" (interactive "P") (if (not buffer-file-name) (message (format "Buffer \"%s\" not visiting a file." (buffer-name))) (if (and save-place (or (not parg) (<= parg 0))) (progn (message "No place will be saved in this file.") (setq save-place nil)) (message "Place will be saved.") (setq save-place t)))) (defun save-place-to-alist () ;; put filename and point in a cons box and then cons that onto the ;; front of the save-place-alist, if save-place is non-nil. ;; Otherwise, just delete that file from the alist. ;; first check to make sure alist has been loaded in from the master ;; file. If not, do so, then feel free to modify the alist. It ;; will be saved again when Emacs is killed. (or save-place-loaded (load-save-place-alist-from-file)) (if buffer-file-name (progn (let ((cell (assoc buffer-file-name save-place-alist))) (if cell (setq save-place-alist (delq cell save-place-alist)))) (if save-place (setq save-place-alist (cons (cons buffer-file-name (if (not (eq major-mode 'hexl-mode)) (point) (1+ (hexl-current-address)))) save-place-alist)))))) (defun save-place-alist-to-file () (let ((file (expand-file-name save-place-file))) (save-excursion (message (format "Saving places to %s..." file)) (set-buffer (get-buffer-create " *Saved Places*")) (delete-region (point-min) (point-max)) (if (file-readable-p file) (insert-file-contents file)) (delete-region (point-min) (point-max)) (goto-char (point-min)) (print save-place-alist (current-buffer)) (let ((version-control (cond ((null save-place-version-control) nil) ((eq 'never save-place-version-control) 'never) ((eq 'nospecial save-place-version-control) version-control) (t t)))) (write-file file) (kill-buffer (current-buffer)) (message (format "Saving places to %s... done." file)))))) (defun load-save-place-alist-from-file () (if (not save-place-loaded) (progn (setq save-place-loaded t) (let ((file (expand-file-name save-place-file))) ;; make sure that the alist does not get overwritten, and then ;; load it if it exists: (if (file-readable-p file) (save-excursion (message (format "Loading places from %s..." save-place-file)) ;; don't want to use find-file because we have been ;; adding hooks to it. (set-buffer (get-buffer-create " *Saved Places*")) (delete-region (point-min) (point-max)) (insert-file-contents file) (goto-char (point-min)) (setq save-place-alist (car (read-from-string (buffer-substring (point-min) (point-max))))) (kill-buffer (current-buffer)) (message (format "Loading places from %s... done." file)) t) t) nil)))) (defun save-places-to-alist () ;; go through buffer-list, saving places to alist if save-place is ;; non-nil, deleting them from alist if it is nil. (let ((buf-list (buffer-list))) (while buf-list ;; put this into a save-excursion in case someone is counting on ;; another function in kill-emacs-hook to act on the last buffer ;; they were in: (save-excursion (set-buffer (car buf-list)) ;; save-place checks buffer-file-name too, but we can avoid ;; overhead of function call by checking here too. (and buffer-file-name (save-place-to-alist)) (setq buf-list (cdr buf-list)))))) (defun save-place-find-file-hook () (or save-place-loaded (load-save-place-alist-from-file)) (let ((cell (assoc buffer-file-name save-place-alist))) (if cell (progn (or after-find-file-from-revert-buffer (goto-char (cdr cell))) ;; and make sure it will be saved again for later (setq save-place t))))) (defun save-place-kill-emacs-hook () (save-places-to-alist) (save-place-alist-to-file)) (add-hook 'find-file-hooks 'save-place-find-file-hook t) (add-hook 'kill-emacs-hook 'save-place-kill-emacs-hook) (add-hook 'kill-buffer-hook 'save-place-to-alist) (provide 'saveplace) ; why not... ;;; saveplace.el ends here emacs-19.30/lisp/sc.el100666 12120 1 43 6016404454 12744 0ustar rmsdaemon(require 'supercite) (provide 'sc) emacs-19.30/lisp/scheme.el100444 12120 1 45371 5737053255 13702 0ustar rmsdaemon;;; scheme.el --- Scheme mode, and its idiosyncratic commands. ;; Copyright (C) 1986, 1987, 1988 Free Software Foundation, Inc. ;; Author: Bill Rozas ;; Keywords: languages, lisp ;; 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: ;; Adapted from Lisp mode by Bill Rozas, jinx@prep. ;; Initially a query replace of Lisp mode, except for the indentation ;; of special forms. Probably the code should be merged at some point ;; so that there is sharing between both libraries. ;;; Code: (defvar scheme-mode-syntax-table nil "") (if (not scheme-mode-syntax-table) (let ((i 0)) (setq scheme-mode-syntax-table (make-syntax-table)) (set-syntax-table scheme-mode-syntax-table) ;; Default is atom-constituent. (while (< i 256) (modify-syntax-entry i "_ ") (setq i (1+ i))) ;; Word components. (setq i ?0) (while (<= i ?9) (modify-syntax-entry i "w ") (setq i (1+ i))) (setq i ?A) (while (<= i ?Z) (modify-syntax-entry i "w ") (setq i (1+ i))) (setq i ?a) (while (<= i ?z) (modify-syntax-entry i "w ") (setq i (1+ i))) ;; Whitespace (modify-syntax-entry ?\t " ") (modify-syntax-entry ?\n "> ") (modify-syntax-entry ?\f " ") (modify-syntax-entry ?\r " ") (modify-syntax-entry ? " ") ;; These characters are delimiters but otherwise undefined. ;; Brackets and braces balance for editing convenience. (modify-syntax-entry ?[ "(] ") (modify-syntax-entry ?] ")[ ") (modify-syntax-entry ?{ "(} ") (modify-syntax-entry ?} "){ ") (modify-syntax-entry ?\| " 23") ;; Other atom delimiters (modify-syntax-entry ?\( "() ") (modify-syntax-entry ?\) ")( ") (modify-syntax-entry ?\; "< ") (modify-syntax-entry ?\" "\" ") (modify-syntax-entry ?' " p") (modify-syntax-entry ?` " p") ;; Special characters (modify-syntax-entry ?, "_ p") (modify-syntax-entry ?@ "_ p") (modify-syntax-entry ?# "_ p14") (modify-syntax-entry ?\\ "\\ "))) (defvar scheme-mode-abbrev-table nil "") (define-abbrev-table 'scheme-mode-abbrev-table ()) (defun scheme-mode-variables () (set-syntax-table scheme-mode-syntax-table) (setq local-abbrev-table scheme-mode-abbrev-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) (make-local-variable 'indent-line-function) (setq indent-line-function 'scheme-indent-line) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (make-local-variable 'comment-start) (setq comment-start ";") (make-local-variable 'comment-start-skip) (setq comment-start-skip ";+[ \t]*") (make-local-variable 'comment-column) (setq comment-column 40) (make-local-variable 'comment-indent-function) (setq comment-indent-function 'scheme-comment-indent) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (setq mode-line-process '("" scheme-mode-line-process))) (defvar scheme-mode-line-process "") (defun scheme-mode-commands (map) (define-key map "\t" 'scheme-indent-line) (define-key map "\177" 'backward-delete-char-untabify) (define-key map "\e\C-q" 'scheme-indent-sexp)) (defvar scheme-mode-map nil) (if (not scheme-mode-map) (progn (setq scheme-mode-map (make-sparse-keymap)) (scheme-mode-commands scheme-mode-map))) ;;;###autoload (defun scheme-mode () "Major mode for editing Scheme code. Editing commands are similar to those of lisp-mode. In addition, if an inferior Scheme process is running, some additional commands will be defined, for evaluating expressions and controlling the interpreter, and the state of the process will be displayed in the modeline of all Scheme buffers. The names of commands that interact with the Scheme process start with \"xscheme-\". For more information see the documentation for xscheme-interaction-mode. Commands: Delete converts tabs to spaces as it moves back. Blank lines separate paragraphs. Semicolons start comments. \\{scheme-mode-map} Entry to this mode calls the value of scheme-mode-hook if that value is non-nil." (interactive) (kill-all-local-variables) (scheme-mode-initialize) (scheme-mode-variables) (run-hooks 'scheme-mode-hook)) (defun scheme-mode-initialize () (use-local-map scheme-mode-map) (setq major-mode 'scheme-mode) (setq mode-name "Scheme")) (defvar scheme-mit-dialect t "If non-nil, scheme mode is specialized for MIT Scheme. Set this to nil if you normally use another dialect.") (defun scheme-comment-indent (&optional pos) (save-excursion (if pos (goto-char pos)) (cond ((looking-at ";;;") (current-column)) ((looking-at ";;") (let ((tem (calculate-scheme-indent))) (if (listp tem) (car tem) tem))) (t (skip-chars-backward " \t") (max (if (bolp) 0 (1+ (current-column))) comment-column))))) (defvar scheme-indent-offset nil "") (defvar scheme-indent-function 'scheme-indent-function "") (defun scheme-indent-line (&optional whole-exp) "Indent current line as Scheme code. With argument, indent any additional lines of the same expression rigidly along with this one." (interactive "P") (let ((indent (calculate-scheme-indent)) shift-amt beg end (pos (- (point-max) (point)))) (beginning-of-line) (setq beg (point)) (skip-chars-forward " \t") (if (looking-at "[ \t]*;;;") ;; Don't alter indentation of a ;;; comment line. nil (if (listp indent) (setq indent (car indent))) (setq shift-amt (- indent (current-column))) (if (zerop shift-amt) nil (delete-region beg (point)) (indent-to indent)) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) ;; If desired, shift remaining lines of expression the same amount. (and whole-exp (not (zerop shift-amt)) (save-excursion (goto-char beg) (forward-sexp 1) (setq end (point)) (goto-char beg) (forward-line 1) (setq beg (point)) (> end beg)) (indent-code-rigidly beg end shift-amt))))) (defun calculate-scheme-indent (&optional parse-start) "Return appropriate indentation for current line as scheme code. In usual case returns an integer: the column to indent to. Can instead return a list, whose car is the column to indent to. This means that following lines at the same level of indentation should not necessarily be indented the same way. The second element of the list is the buffer position of the start of the containing expression." (save-excursion (beginning-of-line) (let ((indent-point (point)) state paren-depth desired-indent (retry t) last-sexp containing-sexp first-sexp-list-p) (if parse-start (goto-char parse-start) (beginning-of-defun)) ;; Find outermost containing sexp (while (< (point) indent-point) (setq state (parse-partial-sexp (point) indent-point 0))) ;; Find innermost containing sexp (while (and retry (setq paren-depth (car state)) (> paren-depth 0)) (setq retry nil) (setq last-sexp (nth 2 state)) (setq containing-sexp (car (cdr state))) ;; Position following last unclosed open. (goto-char (1+ containing-sexp)) ;; Is there a complete sexp since then? (if (and last-sexp (> last-sexp (point))) ;; Yes, but is there a containing sexp after that? (let ((peek (parse-partial-sexp last-sexp indent-point 0))) (if (setq retry (car (cdr peek))) (setq state peek)))) (if (not retry) ;; Innermost containing sexp found (progn (goto-char (1+ containing-sexp)) (if (not last-sexp) ;; indent-point immediately follows open paren. ;; Don't call hook. (setq desired-indent (current-column)) ;; Move to first sexp after containing open paren (parse-partial-sexp (point) last-sexp 0 t) (setq first-sexp-list-p (looking-at "\\s(")) (cond ((> (save-excursion (forward-line 1) (point)) last-sexp) ;; Last sexp is on same line as containing sexp. ;; It's almost certainly a function call. (parse-partial-sexp (point) last-sexp 0 t) (if (/= (point) last-sexp) ;; Indent beneath first argument or, if only one sexp ;; on line, indent beneath that. (progn (forward-sexp 1) (parse-partial-sexp (point) last-sexp 0 t))) (backward-prefix-chars)) (t ;; Indent beneath first sexp on same line as last-sexp. ;; Again, it's almost certainly a function call. (goto-char last-sexp) (beginning-of-line) (parse-partial-sexp (point) last-sexp 0 t) (backward-prefix-chars))))))) ;; If looking at a list, don't call hook. (if first-sexp-list-p (setq desired-indent (current-column))) ;; Point is at the point to indent under unless we are inside a string. ;; Call indentation hook except when overridden by scheme-indent-offset ;; or if the desired indentation has already been computed. (cond ((car (nthcdr 3 state)) ;; Inside a string, don't change indentation. (goto-char indent-point) (skip-chars-forward " \t") (setq desired-indent (current-column))) ((and (integerp scheme-indent-offset) containing-sexp) ;; Indent by constant offset (goto-char containing-sexp) (setq desired-indent (+ scheme-indent-offset (current-column)))) ((not (or desired-indent (and (boundp 'scheme-indent-function) scheme-indent-function (not retry) (setq desired-indent (funcall scheme-indent-function indent-point state))))) ;; Use default indentation if not computed yet (setq desired-indent (current-column)))) desired-indent))) (defun scheme-indent-function (indent-point state) (let ((normal-indent (current-column))) (save-excursion (goto-char (1+ (car (cdr state)))) (re-search-forward "\\sw\\|\\s_") (if (/= (point) (car (cdr state))) (let ((function (buffer-substring (progn (forward-char -1) (point)) (progn (forward-sexp 1) (point)))) method) ;; Who cares about this, really? ;(if (not (string-match "\\\\\\||" function))) (setq function (downcase function)) (setq method (get (intern-soft function) 'scheme-indent-function)) (cond ((integerp method) (scheme-indent-specform method state indent-point)) (method (funcall method state indent-point)) ((and (> (length function) 3) (string-equal (substring function 0 3) "def")) (scheme-indent-defform state indent-point)))))))) (defvar scheme-body-indent 2 "") (defun scheme-indent-specform (count state indent-point) (let ((containing-form-start (car (cdr state))) (i count) body-indent containing-form-column) ;; Move to the start of containing form, calculate indentation ;; to use for non-distinguished forms (> count), and move past the ;; function symbol. scheme-indent-function guarantees that there is at ;; least one word or symbol character following open paren of containing ;; form. (goto-char containing-form-start) (setq containing-form-column (current-column)) (setq body-indent (+ scheme-body-indent containing-form-column)) (forward-char 1) (forward-sexp 1) ;; Now find the start of the last form. (parse-partial-sexp (point) indent-point 1 t) (while (and (< (point) indent-point) (condition-case nil (progn (setq count (1- count)) (forward-sexp 1) (parse-partial-sexp (point) indent-point 1 t)) (error nil)))) ;; Point is sitting on first character of last (or count) sexp. (cond ((> count 0) ;; A distinguished form. Use double scheme-body-indent. (list (+ containing-form-column (* 2 scheme-body-indent)) containing-form-start)) ;; A non-distinguished form. Use body-indent if there are no ;; distinguished forms and this is the first undistinguished ;; form, or if this is the first undistinguished form and ;; the preceding distinguished form has indentation at least ;; as great as body-indent. ((and (= count 0) (or (= i 0) (<= body-indent normal-indent))) body-indent) (t normal-indent)))) (defun scheme-indent-defform (state indent-point) (goto-char (car (cdr state))) (forward-line 1) (if (> (point) (car (cdr (cdr state)))) (progn (goto-char (car (cdr state))) (+ scheme-body-indent (current-column))))) ;;; Let is different in Scheme (defun would-be-symbol (string) (not (string-equal (substring string 0 1) "("))) (defun next-sexp-as-string () ;; Assumes that protected by a save-excursion (forward-sexp 1) (let ((the-end (point))) (backward-sexp 1) (buffer-substring (point) the-end))) ;; This is correct but too slow. ;; The one below works almost always. ;;(defun scheme-let-indent (state indent-point) ;; (if (would-be-symbol (next-sexp-as-string)) ;; (scheme-indent-specform 2 state indent-point) ;; (scheme-indent-specform 1 state indent-point))) (defun scheme-let-indent (state indent-point) (skip-chars-forward " \t") (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]") (scheme-indent-specform 2 state indent-point) (scheme-indent-specform 1 state indent-point))) ;; (put 'begin 'scheme-indent-function 0), say, causes begin to be indented ;; like defun if the first form is placed on the next line, otherwise ;; it is indented like any other form (i.e. forms line up under first). (put 'begin 'scheme-indent-function 0) (put 'case 'scheme-indent-function 1) (put 'delay 'scheme-indent-function 0) (put 'do 'scheme-indent-function 2) (put 'lambda 'scheme-indent-function 1) (put 'let 'scheme-indent-function 'scheme-let-indent) (put 'let* 'scheme-indent-function 1) (put 'letrec 'scheme-indent-function 1) (put 'sequence 'scheme-indent-function 0) (put 'call-with-input-file 'scheme-indent-function 1) (put 'with-input-from-file 'scheme-indent-function 1) (put 'with-input-from-port 'scheme-indent-function 1) (put 'call-with-output-file 'scheme-indent-function 1) (put 'with-output-to-file 'scheme-indent-function 1) (put 'with-output-to-port 'scheme-indent-function 1) ;;;; MIT Scheme specific indentation. (if scheme-mit-dialect (progn (put 'fluid-let 'scheme-indent-function 1) (put 'in-package 'scheme-indent-function 1) (put 'let-syntax 'scheme-indent-function 1) (put 'local-declare 'scheme-indent-function 1) (put 'macro 'scheme-indent-function 1) (put 'make-environment 'scheme-indent-function 0) (put 'named-lambda 'scheme-indent-function 1) (put 'using-syntax 'scheme-indent-function 1) (put 'with-input-from-string 'scheme-indent-function 1) (put 'with-output-to-string 'scheme-indent-function 0) (put 'with-values 'scheme-indent-function 1) (put 'syntax-table-define 'scheme-indent-function 2) (put 'list-transform-positive 'scheme-indent-function 1) (put 'list-transform-negative 'scheme-indent-function 1) (put 'list-search-positive 'scheme-indent-function 1) (put 'list-search-negative 'scheme-indent-function 1) (put 'access-components 'scheme-indent-function 1) (put 'assignment-components 'scheme-indent-function 1) (put 'combination-components 'scheme-indent-function 1) (put 'comment-components 'scheme-indent-function 1) (put 'conditional-components 'scheme-indent-function 1) (put 'disjunction-components 'scheme-indent-function 1) (put 'declaration-components 'scheme-indent-function 1) (put 'definition-components 'scheme-indent-function 1) (put 'delay-components 'scheme-indent-function 1) (put 'in-package-components 'scheme-indent-function 1) (put 'lambda-components 'scheme-indent-function 1) (put 'lambda-components* 'scheme-indent-function 1) (put 'lambda-components** 'scheme-indent-function 1) (put 'open-block-components 'scheme-indent-function 1) (put 'pathname-components 'scheme-indent-function 1) (put 'procedure-components 'scheme-indent-function 1) (put 'sequence-components 'scheme-indent-function 1) (put 'unassigned\?-components 'scheme-indent-function 1) (put 'unbound\?-components 'scheme-indent-function 1) (put 'variable-components 'scheme-indent-function 1))) (defun scheme-indent-sexp () "Indent each line of the list starting just after point." (interactive) (let ((indent-stack (list nil)) (next-depth 0) bol outer-loop-done inner-loop-done state this-indent) (save-excursion (forward-sexp 1)) (save-excursion (setq outer-loop-done nil) (while (not outer-loop-done) (setq last-depth next-depth innerloop-done nil) (while (and (not innerloop-done) (not (setq outer-loop-done (eobp)))) (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) nil nil state)) (setq next-depth (car state)) (if (car (nthcdr 4 state)) (progn (indent-for-comment) (end-of-line) (setcar (nthcdr 4 state) nil))) (if (car (nthcdr 3 state)) (progn (forward-line 1) (setcar (nthcdr 5 state) nil)) (setq innerloop-done t))) (if (setq outer-loop-done (<= next-depth 0)) nil (while (> last-depth next-depth) (setq indent-stack (cdr indent-stack) last-depth (1- last-depth))) (while (< last-depth next-depth) (setq indent-stack (cons nil indent-stack) last-depth (1+ last-depth))) (forward-line 1) (setq bol (point)) (skip-chars-forward " \t") (if (or (eobp) (looking-at "[;\n]")) nil (if (and (car indent-stack) (>= (car indent-stack) 0)) (setq this-indent (car indent-stack)) (let ((val (calculate-scheme-indent (if (car indent-stack) (- (car indent-stack)))))) (if (integerp val) (setcar indent-stack (setq this-indent val)) (if (cdr val) (setcar indent-stack (- (car (cdr val))))) (setq this-indent (car val))))) (if (/= (current-column) this-indent) (progn (delete-region bol (point)) (indent-to this-indent))))))))) (provide 'scheme) ;;; scheme.el ends here emacs-19.30/lisp/scribe.el100444 75424 1 25675 5751544276 14120 0ustar kwzhdaemon;;; scribe.el --- scribe mode, and its idiosyncratic commands. ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: wp ;; 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: ;; A major mode for editing source in written for the Scribe text formatter. ;; Knows about Scribe syntax and standard layout rules. The command to ;; run Scribe on a buffer is bogus; someone interested should fix it. ;;; Code: (defvar scribe-mode-syntax-table nil "Syntax table used while in scribe mode.") (defvar scribe-mode-abbrev-table nil "Abbrev table used while in scribe mode.") (defvar scribe-fancy-paragraphs nil "*Non-NIL makes Scribe mode use a different style of paragraph separation.") (defvar scribe-electric-quote nil "*Non-NIL makes insert of double quote use `` or '' depending on context.") (defvar scribe-electric-parenthesis nil "*Non-NIL makes parenthesis char ( (]}> ) automatically insert its close if typed after an @Command form.") (defconst scribe-open-parentheses "[({<" "Open parenthesis characters for Scribe.") (defconst scribe-close-parentheses "])}>" "Close parenthesis characters for Scribe. These should match up with `scribe-open-parenthesis'.") (if (null scribe-mode-syntax-table) (let ((st (syntax-table))) (unwind-protect (progn (setq scribe-mode-syntax-table (copy-syntax-table text-mode-syntax-table)) (set-syntax-table scribe-mode-syntax-table) (modify-syntax-entry ?\" " ") (modify-syntax-entry ?\\ " ") (modify-syntax-entry ?@ "w ") (modify-syntax-entry ?< "(> ") (modify-syntax-entry ?> ")< ") (modify-syntax-entry ?[ "(] ") (modify-syntax-entry ?] ")[ ") (modify-syntax-entry ?{ "(} ") (modify-syntax-entry ?} "){ ") (modify-syntax-entry ?' "w ")) (set-syntax-table st)))) (defvar scribe-mode-map nil) (if scribe-mode-map nil (setq scribe-mode-map (make-sparse-keymap)) (define-key scribe-mode-map "\t" 'scribe-tab) (define-key scribe-mode-map "\e\t" 'tab-to-tab-stop) (define-key scribe-mode-map "\es" 'center-line) (define-key scribe-mode-map "\e}" 'up-list) (define-key scribe-mode-map "\eS" 'center-paragraph) (define-key scribe-mode-map "\"" 'scribe-insert-quote) (define-key scribe-mode-map "(" 'scribe-parenthesis) (define-key scribe-mode-map "[" 'scribe-parenthesis) (define-key scribe-mode-map "{" 'scribe-parenthesis) (define-key scribe-mode-map "<" 'scribe-parenthesis) (define-key scribe-mode-map "\C-c\C-c" 'scribe-chapter) (define-key scribe-mode-map "\C-c\C-t" 'scribe-section) (define-key scribe-mode-map "\C-c\C-s" 'scribe-subsection) (define-key scribe-mode-map "\C-c\C-v" 'scribe-insert-environment) (define-key scribe-mode-map "\C-c\C-e" 'scribe-bracket-region-be) (define-key scribe-mode-map "\C-c[" 'scribe-begin) (define-key scribe-mode-map "\C-c]" 'scribe-end) (define-key scribe-mode-map "\C-c\C-i" 'scribe-italicize-word) (define-key scribe-mode-map "\C-c\C-b" 'scribe-bold-word) (define-key scribe-mode-map "\C-c\C-u" 'scribe-underline-word)) ;;;###autoload (defun scribe-mode () "Major mode for editing files of Scribe (a text formatter) source. Scribe-mode is similar text-mode, with a few extra commands added. \\{scribe-mode-map} Interesting variables: scribe-fancy-paragraphs Non-nil makes Scribe mode use a different style of paragraph separation. scribe-electric-quote Non-nil makes insert of double quote use `` or '' depending on context. scribe-electric-parenthesis Non-nil makes an open-parenthesis char (one of `([<{') automatically insert its close if typed after an @Command form." (interactive) (kill-all-local-variables) (use-local-map scribe-mode-map) (setq mode-name "Scribe") (setq major-mode 'scribe-mode) (define-abbrev-table 'scribe-mode-abbrev-table ()) (setq local-abbrev-table scribe-mode-abbrev-table) (make-local-variable 'comment-start) (setq comment-start "@Comment[") (make-local-variable 'comment-start-skip) (setq comment-start-skip (concat "@Comment[" scribe-open-parentheses "]")) (make-local-variable 'comment-column) (setq comment-column 0) (make-local-variable 'comment-end) (setq comment-end "]") (make-local-variable 'paragraph-start) (setq paragraph-start (concat "\\([\n\f]\\)\\|\\(@\\w+[" scribe-open-parentheses "].*[" scribe-close-parentheses "]$\\)")) (make-local-variable 'paragraph-separate) (setq paragraph-separate (if scribe-fancy-paragraphs paragraph-start "$")) (make-local-variable 'sentence-end) (setq sentence-end "\\([.?!]\\|@:\\)[]\"')}]*\\($\\| $\\|\t\\| \\)[ \t\n]*") (make-local-variable 'compile-command) (setq compile-command (concat "scribe " (buffer-file-name))) (set-syntax-table scribe-mode-syntax-table) (run-hooks 'text-mode-hook 'scribe-mode-hook)) (defun scribe-tab () (interactive) (insert "@\\")) ;; This algorithm could probably be improved somewhat. ;; Right now, it loses seriously... (defun scribe () "Run Scribe on the current buffer." (interactive) (call-interactively 'compile)) (defun scribe-envelop-word (string count) "Surround current word with Scribe construct @STRING[...]. COUNT specifies how many words to surround. A negative count means to skip backward." (let ((spos (point)) (epos (point)) (ccoun 0) noparens) (if (not (zerop count)) (progn (if (= (char-syntax (preceding-char)) ?w) (forward-sexp (min -1 count))) (setq spos (point)) (if (looking-at (concat "@\\w[" scribe-open-parentheses "]")) (forward-char 2) (goto-char epos) (skip-chars-backward "\\W") (forward-char -1)) (forward-sexp (max count 1)) (setq epos (point)))) (goto-char spos) (while (and (< ccoun (length scribe-open-parentheses)) (save-excursion (or (search-forward (char-to-string (aref scribe-open-parentheses ccoun)) epos t) (search-forward (char-to-string (aref scribe-close-parentheses ccoun)) epos t))) (setq ccoun (1+ ccoun)))) (if (>= ccoun (length scribe-open-parentheses)) (progn (goto-char epos) (insert "@end(" string ")") (goto-char spos) (insert "@begin(" string ")")) (goto-char epos) (insert (aref scribe-close-parentheses ccoun)) (goto-char spos) (insert "@" string (aref scribe-open-parentheses ccoun)) (goto-char epos) (forward-char 3) (skip-chars-forward scribe-close-parentheses)))) (defun scribe-underline-word (count) "Underline COUNT words around point by means of Scribe constructs." (interactive "p") (scribe-envelop-word "u" count)) (defun scribe-bold-word (count) "Boldface COUNT words around point by means of Scribe constructs." (interactive "p") (scribe-envelop-word "b" count)) (defun scribe-italicize-word (count) "Italicize COUNT words around point by means of Scribe constructs." (interactive "p") (scribe-envelop-word "i" count)) (defun scribe-begin () (interactive) (insert "\n") (forward-char -1) (scribe-envelop-word "Begin" 0) (re-search-forward (concat "[" scribe-open-parentheses "]"))) (defun scribe-end () (interactive) (insert "\n") (forward-char -1) (scribe-envelop-word "End" 0) (re-search-forward (concat "[" scribe-open-parentheses "]"))) (defun scribe-chapter () (interactive) (insert "\n") (forward-char -1) (scribe-envelop-word "Chapter" 0) (re-search-forward (concat "[" scribe-open-parentheses "]"))) (defun scribe-section () (interactive) (insert "\n") (forward-char -1) (scribe-envelop-word "Section" 0) (re-search-forward (concat "[" scribe-open-parentheses "]"))) (defun scribe-subsection () (interactive) (insert "\n") (forward-char -1) (scribe-envelop-word "SubSection" 0) (re-search-forward (concat "[" scribe-open-parentheses "]"))) (defun scribe-bracket-region-be (env min max) (interactive "sEnvironment: \nr") (save-excursion (goto-char max) (insert "@end(" env ")\n") (goto-char min) (insert "@begin(" env ")\n"))) (defun scribe-insert-environment (env) (interactive "sEnvironment: ") (scribe-bracket-region-be env (point) (point)) (forward-line 1) (insert ?\n) (forward-char -1)) (defun scribe-insert-quote (count) "Insert ``, '' or \" according to preceding character. If `scribe-electric-quote' is non-NIL, insert ``, '' or \" according to preceding character. With numeric arg N, always insert N \" characters. Else just insert \"." (interactive "P") (if (or count (not scribe-electric-quote)) (self-insert-command (prefix-numeric-value count)) (let (lastfore lastback lastquote) (insert (cond ((= (preceding-char) ?\\) ?\") ((bobp) "``") (t (setq lastfore (save-excursion (and (search-backward "``" (- (point) 1000) t) (point))) lastback (save-excursion (and (search-backward "''" (- (point) 1000) t) (point))) lastquote (save-excursion (and (search-backward "\"" (- (point) 100) t) (point)))) (if (not lastquote) (cond ((not lastfore) "``") ((not lastback) "''") ((> lastfore lastback) "''") (t "``")) (cond ((and (not lastback) (not lastfore)) "\"") ((and lastback (not lastfore) (> lastquote lastback)) "\"") ((and lastback (not lastfore) (> lastback lastquote)) "``") ((and lastfore (not lastback) (> lastquote lastfore)) "\"") ((and lastfore (not lastback) (> lastfore lastquote)) "''") ((and (> lastquote lastfore) (> lastquote lastback)) "\"") ((> lastfore lastback) "''") (t "``"))))))))) (defun scribe-parenthesis (count) "If scribe-electric-parenthesis is non-NIL, insertion of an open-parenthesis character inserts the following close parenthesis character if the preceding text is of the form @Command." (interactive "P") (self-insert-command (prefix-numeric-value count)) (let (at-command paren-char point-save) (if (or count (not scribe-electric-parenthesis)) nil (save-excursion (forward-char -1) (setq point-save (point)) (skip-chars-backward (concat "^ \n\t\f" scribe-open-parentheses)) (setq at-command (and (equal (following-char) ?@) (/= (point) (1- point-save))))) (if (and at-command (setq paren-char (string-match (regexp-quote (char-to-string (preceding-char))) scribe-open-parentheses))) (save-excursion (insert (aref scribe-close-parentheses paren-char))))))) ;;; scribe.el ends here emacs-19.30/lisp/scroll-bar.el100444 75424 1 16162 5763142711 14667 0ustar kwzhdaemon;;; scroll-bar.el --- window system-independent scroll bar support. ;;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: hardware ;;; This file is part of GNU Emacs. ;;; GNU Emacs is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2, or (at your option) ;;; any later version. ;;; GNU Emacs is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Emacs; see the file COPYING. If not, write to ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;;; Commentary: ;; Window-system-independent bindings of mouse clicks on the scroll bar. ;; Presently emulates the scroll-bar behavior of xterm. ;;; Code: (require 'mouse) ;;;; Utilities. (defun scroll-bar-event-ratio (event) "Given a scroll bar event EVENT, return the scroll bar position as a ratio. The value is a cons cell (PORTION . WHOLE) containing two integers whose ratio gives the event's vertical position in the scroll bar, with 0 referring to the top and 1 to the bottom." (nth 2 event)) (defun scroll-bar-scale (num-denom whole) "Given a pair (NUM . DENOM) and WHOLE, return (/ (* NUM WHOLE) DENOM). This is handy for scaling a position on a scroll bar into real units, like buffer positions. If SCROLL-BAR-POS is the (PORTION . WHOLE) pair from a scroll bar event, then (scroll-bar-scale SCROLL-BAR-POS \(buffer-size)) is the position in the current buffer corresponding to that scroll bar position." ;; We multiply before we divide to maintain precision. ;; We use floating point because the product of a large buffer size ;; with a large scroll bar portion can easily overflow a lisp int. (truncate (/ (* (float (car num-denom)) whole) (cdr num-denom)))) ;;;; Helpful functions for enabling and disabling scroll bars. (defun scroll-bar-mode (flag) "Toggle display of vertical scroll bars on each frame. This command applies to all frames that exist and frames to be created in the future. With a numeric argument, if the argument is negative, turn off scroll bars; otherwise, turn on scroll bars." (interactive "P") (if flag (setq flag (prefix-numeric-value flag))) ;; Obtain the current setting by looking at default-frame-alist. (let ((scroll-bar-mode (let ((assq (assq 'vertical-scroll-bars default-frame-alist))) (if assq (cdr assq) t)))) ;; Tweedle it according to the argument. (setq scroll-bar-mode (if (null flag) (not scroll-bar-mode) (or (not (numberp flag)) (>= flag 0)))) ;; Apply it to default-frame-alist. (mapcar (function (lambda (param-name) (let ((parameter (assq param-name default-frame-alist))) (if (consp parameter) (setcdr parameter scroll-bar-mode) (setq default-frame-alist (cons (cons param-name scroll-bar-mode) default-frame-alist)))))) '(vertical-scroll-bars horizontal-scroll-bars)) ;; Apply it to existing frames. (let ((frames (frame-list))) (while frames (modify-frame-parameters (car frames) (list (cons 'vertical-scroll-bars scroll-bar-mode) (cons 'horizontal-scroll-bars scroll-bar-mode))) (setq frames (cdr frames)))))) ;;;; Buffer navigation using the scroll bar. ;;; This was used for up-events on button 2, but no longer. (defun scroll-bar-set-window-start (event) "Set the window start according to where the scroll bar is dragged. EVENT should be a scroll bar click or drag event." (interactive "e") (let* ((end-position (event-end event)) (window (nth 0 end-position)) (portion-whole (nth 2 end-position))) (save-excursion (set-buffer (window-buffer window)) (save-excursion (goto-char (+ (point-min) (scroll-bar-scale portion-whole (- (point-max) (point-min))))) (beginning-of-line) (set-window-start window (point)))))) ;; Scroll the window to the proper position for EVENT. (defun scroll-bar-drag-1 (event) (let* ((start-position (event-start event)) (window (nth 0 start-position)) (portion-whole (nth 2 start-position))) (save-excursion (set-buffer (window-buffer window)) ;; Calculate position relative to the accessible part of the buffer. (goto-char (+ (point-min) (scroll-bar-scale portion-whole (- (point-max) (point-min))))) (beginning-of-line) (set-window-start window (point))))) (defun scroll-bar-drag (event) "Scroll the window by dragging the scroll bar slider. If you click outside the slider, the window scrolls to bring the slider there." (interactive "e") (let* (done (echo-keystrokes 0)) (or point-before-scroll (setq point-before-scroll (point))) ;; Our scrolling can move point; don't let that clear point-before-scroll. (let (point-before-scroll) (scroll-bar-drag-1 event) (track-mouse (while (not done) (setq event (read-event)) (if (eq (car-safe event) 'mouse-movement) (setq event (read-event))) (cond ((eq (car-safe event) 'scroll-bar-movement) (scroll-bar-drag-1 event)) (t ;; Exit when we get the drag event; ignore that event. (setq done t))))) (sit-for 0)))) (defun scroll-bar-scroll-down (event) "Scroll the window's top line down to the location of the scroll bar click. EVENT should be a scroll bar click." (interactive "e") (let ((old-selected-window (selected-window))) (unwind-protect (progn (let* ((end-position (event-end event)) (window (nth 0 end-position)) (portion-whole (nth 2 end-position))) (let (point-before-scroll) (select-window window)) (or point-before-scroll (setq point-before-scroll (point))) (let (point-before-scroll) (scroll-down (scroll-bar-scale portion-whole (1- (window-height))))))) (select-window old-selected-window)))) (defun scroll-bar-scroll-up (event) "Scroll the line next to the scroll bar click to the top of the window. EVENT should be a scroll bar click." (interactive "e") (let ((old-selected-window (selected-window))) (unwind-protect (progn (let* ((end-position (event-end event)) (window (nth 0 end-position)) (portion-whole (nth 2 end-position))) (let (point-before-scroll) (select-window window)) (or point-before-scroll (setq point-before-scroll (point))) (let (point-before-scroll) (scroll-up (scroll-bar-scale portion-whole (1- (window-height))))))) (select-window old-selected-window)))) ;;;; Bindings. ;;; For now, we'll set things up to work like xterm. (global-set-key [vertical-scroll-bar mouse-1] 'scroll-bar-scroll-up) (global-set-key [vertical-scroll-bar drag-mouse-1] 'scroll-bar-scroll-up) (global-set-key [vertical-scroll-bar down-mouse-2] 'scroll-bar-drag) (global-set-key [vertical-scroll-bar mouse-3] 'scroll-bar-scroll-down) (global-set-key [vertical-scroll-bar drag-mouse-3] 'scroll-bar-scroll-down) (provide 'scroll-bar) ;;; scroll-bar.el ends here emacs-19.30/lisp/select.el100444 12120 1 24724 5743106371 13707 0ustar rmsdaemon;;; select.el --- lisp portion of standard selection support. ;; Keywords: internal ;; Copyright (c) 1993, 1994 Free Software Foundation, Inc. ;; Based partially on earlier release by Lucid. ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;; This is for temporary compatibility with pre-release Emacs 19. (defalias 'x-selection 'x-get-selection) (defun x-get-selection (&optional type data-type) "Return the value of an X Windows selection. The argument TYPE (default `PRIMARY') says which selection, and the argument DATA-TYPE (default `STRING') says how to convert the data." (x-get-selection-internal (or type 'PRIMARY) (or data-type 'STRING))) (defun x-get-clipboard () "Return text pasted to the clipboard." (x-get-selection-internal 'CLIPBOARD 'STRING)) (defun x-set-selection (type data) "Make an X Windows selection of type TYPE and value DATA. The argument TYPE (default `PRIMARY') says which selection, and DATA specifies the contents. DATA may be a string, a symbol, an integer (or a cons of two integers or list of two integers). The selection may also be a cons of two markers pointing to the same buffer, or an overlay. In these cases, the selection is considered to be the text between the markers *at whatever time the selection is examined*. Thus, editing done in the buffer after you specify the selection can alter the effective value of the selection. The data may also be a vector of valid non-vector selection values. Interactively, the text of the region is used as the selection value." (interactive (if (not current-prefix-arg) (list 'PRIMARY (read-string "Set text for pasting: ")) (list 'PRIMARY (substring (region-beginning) (region-end))))) ;; This is for temporary compatibility with pre-release Emacs 19. (if (stringp type) (setq type (intern type))) (or (x-valid-simple-selection-p data) (and (vectorp data) (let ((valid t) (i (1- (length data)))) (while (>= i 0) (or (x-valid-simple-selection-p (aref data i)) (setq valid nil)) (setq i (1- i))) valid)) (signal 'error (list "invalid selection" data))) (or type (setq type 'PRIMARY)) (if data (x-own-selection-internal type data) (x-disown-selection-internal type)) data) (defun x-valid-simple-selection-p (data) (or (stringp data) (symbolp data) (integerp data) (and (consp data) (integerp (car data)) (or (integerp (cdr data)) (and (consp (cdr data)) (integerp (car (cdr data)))))) (overlayp data) (and (consp data) (markerp (car data)) (markerp (cdr data)) (marker-buffer (car data)) (marker-buffer (cdr data)) (eq (marker-buffer (car data)) (marker-buffer (cdr data))) (buffer-name (marker-buffer (car data))) (buffer-name (marker-buffer (cdr data)))))) ;;; Cut Buffer support (defun x-get-cut-buffer (&optional which-one) "Returns the value of one of the 8 X server cut-buffers. Optional arg WHICH-ONE should be a number from 0 to 7, defaulting to 0. Cut buffers are considered obsolete; you should use selections instead." (x-get-cut-buffer-internal (if which-one (aref [CUT_BUFFER0 CUT_BUFFER1 CUT_BUFFER2 CUT_BUFFER3 CUT_BUFFER4 CUT_BUFFER5 CUT_BUFFER6 CUT_BUFFER7] which-one) 'CUT_BUFFER0))) (defun x-set-cut-buffer (string &optional push) "Store STRING into the X server's primary cut buffer. If PUSH is non-nil, also rotate the cut buffers: this means the previous value of the primary cut buffer moves the second cut buffer, and the second to the third, and so on (there are 8 buffers.) Cut buffers are considered obsolete; you should use selections instead." ;; Check the data type of STRING. (substring string 0 0) (if push (x-rotate-cut-buffers-internal 1)) (x-store-cut-buffer-internal 'CUT_BUFFER0 string)) ;;; Functions to convert the selection into various other selection types. ;;; Every selection type that Emacs handles is implemented this way, except ;;; for TIMESTAMP, which is a special case. (defun xselect-convert-to-string (selection type value) (cond ((stringp value) value) ((overlayp value) (save-excursion (or (buffer-name (overlay-buffer value)) (error "selection is in a killed buffer")) (set-buffer (overlay-buffer value)) (buffer-substring (overlay-start value) (overlay-end value)))) ((and (consp value) (markerp (car value)) (markerp (cdr value))) (or (eq (marker-buffer (car value)) (marker-buffer (cdr value))) (signal 'error (list "markers must be in the same buffer" (car value) (cdr value)))) (save-excursion (set-buffer (or (marker-buffer (car value)) (error "selection is in a killed buffer"))) (buffer-substring (car value) (cdr value)))) (t nil))) (defun xselect-convert-to-length (selection type value) (let ((value (cond ((stringp value) (length value)) ((overlayp value) (abs (- (overlay-end value) (overlay-start value)))) ((and (consp value) (markerp (car value)) (markerp (cdr value))) (or (eq (marker-buffer (car value)) (marker-buffer (cdr value))) (signal 'error (list "markers must be in the same buffer" (car value) (cdr value)))) (abs (- (car value) (cdr value))))))) (if value ; force it to be in 32-bit format. (cons (ash value -16) (logand value 65535)) nil))) (defun xselect-convert-to-targets (selection type value) ;; return a vector of atoms, but remove duplicates first. (let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist))) (rest all)) (while rest (cond ((memq (car rest) (cdr rest)) (setcdr rest (delq (car rest) (cdr rest)))) ((eq (car (cdr rest)) '_EMACS_INTERNAL) ; shh, it's a secret (setcdr rest (cdr (cdr rest)))) (t (setq rest (cdr rest))))) (apply 'vector all))) (defun xselect-convert-to-delete (selection type value) (x-disown-selection-internal selection) ;; A return value of nil means that we do not know how to do this conversion, ;; and replies with an "error". A return value of NULL means that we have ;; done the conversion (and any side-effects) but have no value to return. 'NULL) (defun xselect-convert-to-filename (selection type value) (cond ((overlayp value) (buffer-file-name (or (overlay-buffer value) (error "selection is in a killed buffer")))) ((and (consp value) (markerp (car value)) (markerp (cdr value))) (buffer-file-name (or (marker-buffer (car value)) (error "selection is in a killed buffer")))) (t nil))) (defun xselect-convert-to-charpos (selection type value) (let (a b tmp) (cond ((cond ((overlayp value) (setq a (overlay-start value) b (overlay-end value))) ((and (consp value) (markerp (car value)) (markerp (cdr value))) (setq a (car value) b (cdr value)))) (setq a (1- a) b (1- b)) ; zero-based (if (< b a) (setq tmp a a b b tmp)) (cons 'SPAN (vector (cons (ash a -16) (logand a 65535)) (cons (ash b -16) (logand b 65535)))))))) (defun xselect-convert-to-lineno (selection type value) (let (a b buf tmp) (cond ((cond ((and (consp value) (markerp (car value)) (markerp (cdr value))) (setq a (marker-position (car value)) b (marker-position (cdr value)) buf (marker-buffer (car value)))) ((overlayp value) (setq buf (overlay-buffer value) a (overlay-start value) b (overlay-end value))) ) (save-excursion (set-buffer buf) (setq a (count-lines 1 a) b (count-lines 1 b))) (if (< b a) (setq tmp a a b b tmp)) (cons 'SPAN (vector (cons (ash a -16) (logand a 65535)) (cons (ash b -16) (logand b 65535)))))))) (defun xselect-convert-to-colno (selection type value) (let (a b buf tmp) (cond ((cond ((and (consp value) (markerp (car value)) (markerp (cdr value))) (setq a (car value) b (cdr value) buf (marker-buffer a))) ((overlayp value) (setq buf (overlay-buffer value) a (overlay-start value) b (overlay-end value))) ) (save-excursion (set-buffer buf) (goto-char a) (setq a (current-column)) (goto-char b) (setq b (current-column))) (if (< b a) (setq tmp a a b b tmp)) (cons 'SPAN (vector (cons (ash a -16) (logand a 65535)) (cons (ash b -16) (logand b 65535)))))))) (defun xselect-convert-to-os (selection type size) (symbol-name system-type)) (defun xselect-convert-to-host (selection type size) (system-name)) (defun xselect-convert-to-user (selection type size) (user-full-name)) (defun xselect-convert-to-class (selection type size) "Emacs") ;; We do not try to determine the name Emacs was invoked with, ;; because it is not clean for a program's behavior to depend on that. (defun xselect-convert-to-name (selection type size) "emacs") (defun xselect-convert-to-integer (selection type value) (and (integerp value) (cons (ash value -16) (logand value 65535)))) (defun xselect-convert-to-atom (selection type value) (and (symbolp value) value)) (defun xselect-convert-to-identity (selection type value) ; used internally (vector value)) (setq selection-converter-alist '((TEXT . xselect-convert-to-string) (STRING . xselect-convert-to-string) (TARGETS . xselect-convert-to-targets) (LENGTH . xselect-convert-to-length) (DELETE . xselect-convert-to-delete) (FILE_NAME . xselect-convert-to-filename) (CHARACTER_POSITION . xselect-convert-to-charpos) (LINE_NUMBER . xselect-convert-to-lineno) (COLUMN_NUMBER . xselect-convert-to-colno) (OWNER_OS . xselect-convert-to-os) (HOST_NAME . xselect-convert-to-host) (USER . xselect-convert-to-user) (CLASS . xselect-convert-to-class) (NAME . xselect-convert-to-name) (ATOM . xselect-convert-to-atom) (INTEGER . xselect-convert-to-integer) (_EMACS_INTERNAL . xselect-convert-to-identity) )) (provide 'select) ;;; select.el ends here. emacs-19.30/lisp/sendmail.el100444 12120 1 113242 6050705233 14230 0ustar rmsdaemon;;; sendmail.el --- mail sending commands for Emacs. ;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; This mode provides mail-sending facilities from within Emacs. It is ;; documented in the Emacs user's manual. ;;; Code: ;;;###autoload (defvar mail-from-style 'angles "\ *Specifies how \"From:\" fields look. If `nil', they contain just the return address like: king@grassland.com If `parens', they look like: king@grassland.com (Elvis Parsley) If `angles', they look like: Elvis Parsley ") ;;;###autoload (defvar mail-self-blind nil "\ Non-nil means insert BCC to self in messages to be sent. This is done when the message is initialized, so you can remove or alter the BCC field to override the default.") ;;;###autoload (defvar mail-interactive nil "\ Non-nil means when sending a message wait for and display errors. nil means let mailer mail back a message to report errors.") ;;;###autoload (defvar mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\ Delete these headers from old message when it's inserted in a reply.") ;; Useful to set in site-init.el ;;;###autoload (defvar send-mail-function 'sendmail-send-it "\ Function to call to send the current buffer as mail. The headers should be delimited by a line whose contents match the variable `mail-header-separator'.") ;;;###autoload (defvar mail-header-separator "--text follows this line--" "\ *Line used to separate headers from text in messages being composed.") ;;;###autoload (defvar mail-archive-file-name nil "\ *Name of file to write all outgoing messages in, or nil for none. This can be an inbox file or an Rmail file.") ;;;###autoload (defvar mail-default-reply-to nil "*Address to insert as default Reply-to field of outgoing messages. If nil, it will be initialized from the REPLYTO environment variable when you first send mail.") ;;;###autoload (defvar mail-alias-file nil "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'. This file defines aliases to be expanded by the mailer; this is a different feature from that of defining aliases in `.mailrc' to be expanded in Emacs. This variable has no effect unless your system uses sendmail as its mailer.") ;;;###autoload (defvar mail-personal-alias-file "~/.mailrc" "*If non-nil, the name of the user's personal mail alias file. This file typically should be in same format as the `.mailrc' file used by the `Mail' or `mailx' program. This file need not actually exist.") (defvar mail-setup-hook nil "Normal hook, run each time a new outgoing mail message is initialized. The function `mail-setup' runs this hook.") (defvar mail-aliases t "Alist of mail address aliases, or t meaning should be initialized from your mail aliases file. \(The file's name is normally `~/.mailrc', but your MAILRC environment variable can override that name.) The alias definitions in the file have this form: alias ALIAS MEANING") (defvar mail-alias-modtime nil "The modification time of your mail alias file when it was last examined.") (defvar mail-yank-prefix nil "*Prefix insert on lines of yanked message being replied to. nil means use indentation.") (defvar mail-indentation-spaces 3 "*Number of spaces to insert at the beginning of each cited line. Used by `mail-yank-original' via `mail-yank-cite'.") (defvar mail-yank-hooks nil "Obsolete hook for modifying a citation just inserted in the mail buffer. Each hook function can find the citation between (point) and (mark t). And each hook function should leave point and mark around the citation text as modified. This is a normal hook, misnamed for historical reasons. It is semi-obsolete and mail agents should no longer use it.") (defvar mail-citation-hook nil "*Hook for modifying a citation just inserted in the mail buffer. Each hook function can find the citation between (point) and (mark t). And each hook function should leave point and mark around the citation text as modified. If this hook is entirely empty (nil), a default action is taken instead of no action.") (defvar mail-abbrevs-loaded nil) (defvar mail-mode-map nil) (autoload 'build-mail-aliases "mailalias" "Read mail aliases from user's personal aliases file and set `mail-aliases'." nil) (autoload 'expand-mail-aliases "mailalias" "Expand all mail aliases in suitable header fields found between BEG and END. Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants. Optional second arg EXCLUDE may be a regular expression defining text to be removed from alias expansions." nil) ;;;###autoload (defvar mail-signature nil "*Text inserted at end of mail buffer when a message is initialized. If t, it means to insert the contents of the file `mail-signature-file'.") (defvar mail-signature-file "~/.signature" "*File containing the text inserted at end of mail buffer.") (defvar mail-reply-buffer nil) (defvar mail-send-actions nil "A list of actions to be performed upon successful sending of a message.") (defvar mail-default-headers nil "*A string containing header lines, to be inserted in outgoing messages. It is inserted before you edit the message, so you can edit or delete these lines.") (defvar mail-bury-selects-summary t "*If non-nil, try to show RMAIL summary buffer after returning from mail. The functions \\[mail-send-on-exit] or \\[mail-dont-send] select the RMAIL summary buffer before returning, if it exists and this variable is non-nil.") ;; Note: could use /usr/ucb/mail instead of sendmail; ;; options -t, and -v if not interactive. (defvar mail-mailer-swallows-blank-line (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration) (file-readable-p "/etc/sendmail.cf") (let ((buffer (get-buffer-create " *temp*"))) (unwind-protect (save-excursion (set-buffer buffer) (insert-file-contents "/etc/sendmail.cf") (goto-char (point-min)) (let ((case-fold-search nil)) (re-search-forward "^OR\\>" nil t))) (kill-buffer buffer)))) ;; According to RFC822, "The field-name must be composed of printable ;; ASCII characters (i.e. characters that have decimal values between ;; 33 and 126, except colon)", i.e. any chars except ctl chars, ;; space, or colon. '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) "Set this non-nil if the system's mailer runs the header and body together. \(This problem exists on Sunos 4 when sendmail is run in remote mode.) The value should be an expression to test whether the problem will actually occur.") (defvar mail-mode-syntax-table nil "Syntax table used while in mail mode.") (if (not mail-mode-syntax-table) (progn (setq mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table)) (modify-syntax-entry ?% ". " mail-mode-syntax-table))) (defvar mail-font-lock-keywords (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-"))) (list '("^To:" . font-lock-function-name-face) '("^B?CC:\\|^Reply-To:" . font-lock-keyword-face) '("^\\(Subject:\\)[ \t]*\\(.+\\)?" (1 font-lock-comment-face) (2 font-lock-type-face nil t)) (list (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") 1 'font-lock-comment-face) (cons (concat "^[ \t]*" "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" "[>|}].*") 'font-lock-reference-face) '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*" . font-lock-string-face))) "Additional expressions to highlight in Mail mode.") (defvar mail-send-hook nil "Normal hook run before sending mail, in Mail mode.") (defun sendmail-synch-aliases () (let ((modtime (nth 5 (file-attributes mail-personal-alias-file)))) (or (equal mail-alias-modtime modtime) (setq mail-alias-modtime modtime mail-aliases t)))) (defun mail-setup (to subject in-reply-to cc replybuffer actions) (or mail-default-reply-to (setq mail-default-reply-to (getenv "REPLYTO"))) (sendmail-synch-aliases) (if (eq mail-aliases t) (progn (setq mail-aliases nil) (if (file-exists-p mail-personal-alias-file) (build-mail-aliases)))) (setq mail-send-actions actions) (setq mail-reply-buffer replybuffer) (goto-char (point-min)) (insert "To: ") (save-excursion (if to ;; Here removed code to extract names from within <...> ;; on the assumption that mail-strip-quoted-names ;; has been called and has done so. (let ((fill-prefix "\t") (address-start (point))) (insert to "\n") (fill-region-as-paragraph address-start (point-max))) (newline)) (if cc (let ((fill-prefix "\t") (address-start (progn (insert "CC: ") (point)))) (insert cc "\n") (fill-region-as-paragraph address-start (point-max)))) (if in-reply-to (let ((fill-prefix "\t") (fill-column 78) (address-start (point))) (insert "In-reply-to: " in-reply-to "\n") (fill-region-as-paragraph address-start (point-max)))) (insert "Subject: " (or subject "") "\n") (if mail-default-headers (insert mail-default-headers)) (if mail-default-reply-to (insert "Reply-to: " mail-default-reply-to "\n")) (if mail-self-blind (insert "BCC: " (user-login-name) "\n")) (if mail-archive-file-name (insert "FCC: " mail-archive-file-name "\n")) (insert mail-header-separator "\n") ;; Insert the signature. But remember the beginning of the message. (if to (setq to (point))) (cond ((eq mail-signature t) (if (file-exists-p mail-signature-file) (progn (insert "\n\n-- \n") (insert-file-contents mail-signature-file)))) (mail-signature (insert mail-signature))) (goto-char (point-max)) (or (bolp) (newline))) (if to (goto-char to)) (or to subject in-reply-to (set-buffer-modified-p nil)) (run-hooks 'mail-setup-hook)) ;;;###autoload (defun mail-mode () "Major mode for editing mail to be sent. Like Text Mode but with these additional commands: C-c C-s mail-send (send the message) C-c C-c mail-send-and-exit C-c C-f move to a header field (and create it if there isn't): C-c C-f C-t move to To: C-c C-f C-s move to Subject: C-c C-f C-c move to CC: C-c C-f C-b move to BCC: C-c C-f C-f move to FCC: C-c C-t mail-text (move to beginning of message text). C-c C-w mail-signature (insert `mail-signature-file' file). C-c C-y mail-yank-original (insert current message, in Rmail). C-c C-q mail-fill-yanked-message (fill what was yanked). C-c C-v mail-sent-via (add a Sent-via field for each To or CC)." (interactive) (kill-all-local-variables) (make-local-variable 'mail-reply-buffer) (setq mail-reply-buffer nil) (make-local-variable 'mail-send-actions) (set-syntax-table mail-mode-syntax-table) (use-local-map mail-mode-map) (setq local-abbrev-table text-mode-abbrev-table) (setq major-mode 'mail-mode) (setq mode-name "Mail") (setq buffer-offer-save t) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(mail-font-lock-keywords t)) (make-local-variable 'paragraph-separate) (make-local-variable 'paragraph-start) (setq paragraph-start (concat (regexp-quote mail-header-separator) "$\\|[ \t]*[-_][-_][-_]+$\\|" paragraph-start)) (setq paragraph-separate (concat (regexp-quote mail-header-separator) "$\\|[ \t]*[-_][-_][-_]+$\\|" paragraph-separate)) (run-hooks 'text-mode-hook 'mail-mode-hook)) ;;; Set up keymap. (if mail-mode-map nil (setq mail-mode-map (nconc (make-sparse-keymap) text-mode-map)) (define-key mail-mode-map "\C-c?" 'describe-mode) (define-key mail-mode-map "\C-c\C-f\C-t" 'mail-to) (define-key mail-mode-map "\C-c\C-f\C-b" 'mail-bcc) (define-key mail-mode-map "\C-c\C-f\C-f" 'mail-fcc) (define-key mail-mode-map "\C-c\C-f\C-c" 'mail-cc) (define-key mail-mode-map "\C-c\C-f\C-s" 'mail-subject) (define-key mail-mode-map "\C-c\C-f\C-r" 'mail-reply-to) (define-key mail-mode-map "\C-c\C-t" 'mail-text) (define-key mail-mode-map "\C-c\C-y" 'mail-yank-original) (define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message) (define-key mail-mode-map "\C-c\C-w" 'mail-signature) (define-key mail-mode-map "\C-c\C-v" 'mail-sent-via) (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit) (define-key mail-mode-map "\C-c\C-s" 'mail-send)) (define-key mail-mode-map [menu-bar mail] (cons "Mail" (make-sparse-keymap "Mail"))) (define-key mail-mode-map [menu-bar mail fill] '("Fill Citation" . mail-fill-yanked-message)) (define-key mail-mode-map [menu-bar mail yank] '("Cite Original" . mail-yank-original)) (define-key mail-mode-map [menu-bar mail signature] '("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)) (define-key mail-mode-map [menu-bar mail send] '("Send Message" . mail-send-and-exit)) (define-key mail-mode-map [menu-bar headers] (cons "Headers" (make-sparse-keymap "Move to Header"))) (define-key mail-mode-map [menu-bar headers reply-to] '("Reply-To" . mail-reply-to)) (define-key mail-mode-map [menu-bar headers sent-via] '("Sent Via" . mail-sent-via)) (define-key mail-mode-map [menu-bar headers text] '("Text" . mail-text)) (define-key mail-mode-map [menu-bar headers bcc] '("Bcc" . mail-bcc)) (define-key mail-mode-map [menu-bar headers fcc] '("Fcc" . mail-fcc)) (define-key mail-mode-map [menu-bar headers cc] '("Cc" . mail-cc)) (define-key mail-mode-map [menu-bar headers subject] '("Subject" . mail-subject)) (define-key mail-mode-map [menu-bar headers to] '("To" . mail-to)) (defun mail-send-and-exit (arg) "Send message like `mail-send', then, if no errors, exit from mail buffer. Prefix arg means don't delete this window." (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 (fboundp 'frame-parameters) (cdr (assq 'dedicated (frame-parameters))) (not (null (delq (selected-frame) (visible-frame-list))))) (delete-frame (selected-frame)) (let (rmail-flag summary-buffer) (and (not arg) (not (one-window-p)) (save-excursion (set-buffer (window-buffer (next-window (selected-window) 'not))) (setq rmail-flag (eq major-mode 'rmail-mode)) (setq summary-buffer (and mail-bury-selects-summary (boundp 'rmail-summary-buffer) rmail-summary-buffer (buffer-name rmail-summary-buffer) (not (get-buffer-window rmail-summary-buffer)) rmail-summary-buffer)))) (if rmail-flag ;; If the Rmail buffer has a summary, show that. (if summary-buffer (switch-to-buffer summary-buffer) (delete-window)) (switch-to-buffer newbuf)))))) (defun mail-send () "Send the message in the current buffer. If `mail-interactive' is non-nil, wait for success indication or error messages, and inform user. Otherwise any failure is reported in a message back to the user from the mailer." (interactive) (if (if buffer-file-name (y-or-n-p "Send buffer contents as mail message? ") (or (buffer-modified-p) (y-or-n-p "Message already sent; resend? "))) (progn (run-hooks 'mail-send-hook) (message "Sending...") (funcall send-mail-function) ;; Now perform actions on successful sending. (while mail-send-actions (condition-case nil (apply (car (car mail-send-actions)) (cdr (car mail-send-actions))) (error)) (setq mail-send-actions (cdr mail-send-actions))) (message "Sending...done") ;; If buffer has no file, mark it as unmodified and delete autosave. (if (not buffer-file-name) (progn (set-buffer-modified-p nil) (delete-auto-save-file-if-necessary t)))))) (defun sendmail-send-it () (require 'mail-utils) (let ((errbuf (if mail-interactive (generate-new-buffer " sendmail errors") 0)) (tembuf (generate-new-buffer " sendmail temp")) (case-fold-search nil) resend-to-addresses delimline (mailbuf (current-buffer))) (unwind-protect (save-excursion (set-buffer tembuf) (erase-buffer) (insert-buffer-substring mailbuf) (goto-char (point-max)) ;; require one newline at the end. (or (= (preceding-char) ?\n) (insert ?\n)) ;; Change header-delimiter to be what sendmail expects. (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (replace-match "\n") (backward-char 1) (setq delimline (point-marker)) (sendmail-synch-aliases) (if mail-aliases (expand-mail-aliases (point-min) delimline)) (goto-char (point-min)) ;; ignore any blank lines in the header (while (and (re-search-forward "\n\n\n*" delimline t) (< (point) delimline)) (replace-match "\n")) (let ((case-fold-search t)) (goto-char (point-min)) (while (re-search-forward "^Resent-to:" delimline t) (setq resend-to-addresses (save-restriction (narrow-to-region (point) (save-excursion (end-of-line) (point))) (append (mail-parse-comma-list) resend-to-addresses)))) ;;; Apparently this causes a duplicate Sender. ;;; ;; If the From is different than current user, insert Sender. ;;; (goto-char (point-min)) ;;; (and (re-search-forward "^From:" delimline t) ;;; (progn ;;; (require 'mail-utils) ;;; (not (string-equal ;;; (mail-strip-quoted-names ;;; (save-restriction ;;; (narrow-to-region (point-min) delimline) ;;; (mail-fetch-field "From"))) ;;; (user-login-name)))) ;;; (progn ;;; (forward-line 1) ;;; (insert "Sender: " (user-login-name) "\n"))) ;; Don't send out a blank subject line (goto-char (point-min)) (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t) (replace-match "")) ;; Put the "From:" field in unless for some odd reason ;; they put one in themselves. (goto-char (point-min)) (if (not (re-search-forward "^From:" delimline t)) (let* ((login user-mail-address) (fullname (user-full-name))) (cond ((eq mail-from-style 'angles) (insert "From: " fullname) (let ((fullname-start (+ (point-min) 6)) (fullname-end (point-marker))) (goto-char fullname-start) ;; Look for a character that cannot appear unquoted ;; according to RFC 822. (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" fullname-end 1) (progn ;; Quote fullname, escaping specials. (goto-char fullname-start) (insert "\"") (while (re-search-forward "[\"\\]" fullname-end 1) (replace-match "\\\\\\&" t)) (insert "\"")))) (insert " <" login ">\n")) ((eq mail-from-style 'parens) (insert "From: " login " (") (let ((fullname-start (point))) (insert fullname) (let ((fullname-end (point-marker))) (goto-char fullname-start) ;; RFC 822 says \ and nonmatching parentheses ;; must be escaped in comments. ;; Escape every instance of ()\ ... (while (re-search-forward "[()\\]" fullname-end 1) (replace-match "\\\\\\&" t)) ;; ... then undo escaping of matching parentheses, ;; including matching nested parentheses. (goto-char fullname-start) (while (re-search-forward "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" fullname-end 1) (replace-match "\\1(\\3)" t) (goto-char fullname-start)))) (insert ")\n")) ((null mail-from-style) (insert "From: " login "\n"))))) ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) (if (eval mail-mailer-swallows-blank-line) (newline)) ;; Find and handle any FCC fields. (goto-char (point-min)) (if (re-search-forward "^FCC:" delimline t) (mail-do-fcc delimline)) (if mail-interactive (save-excursion (set-buffer errbuf) (erase-buffer)))) (let ((default-directory "/")) (apply 'call-process-region (append (list (point-min) (point-max) (if (boundp 'sendmail-program) sendmail-program "/usr/lib/sendmail") nil errbuf nil "-oi") ;; Always specify who from, ;; since some systems have broken sendmails. (list "-f" (user-login-name)) ;;; ;; Don't say "from root" if running under su. ;;; (and (equal (user-real-login-name) "root") ;;; (list "-f" (user-login-name))) (and mail-alias-file (list (concat "-oA" mail-alias-file))) ;; These mean "report errors by mail" ;; and "deliver in background". (if (null mail-interactive) '("-oem" "-odb")) ;; Get the addresses from the message ;; unless this is a resend. ;; We must not do that for a resend ;; because we would find the original addresses. ;; For a resend, include the specific addresses. (or resend-to-addresses '("-t"))))) (if mail-interactive (save-excursion (set-buffer errbuf) (goto-char (point-min)) (while (re-search-forward "\n\n* *" nil t) (replace-match "; ")) (if (not (zerop (buffer-size))) (error "Sending...failed to %s" (buffer-substring (point-min) (point-max))))))) (kill-buffer tembuf) (if (bufferp errbuf) (kill-buffer errbuf))))) (defun mail-do-fcc (header-end) (let (fcc-list (rmailbuf (current-buffer)) (time (current-time)) (tembuf (generate-new-buffer " rmail output")) (case-fold-search t)) (save-excursion (goto-char (point-min)) (while (re-search-forward "^FCC:[ \t]*" header-end t) (setq fcc-list (cons (buffer-substring (point) (progn (end-of-line) (skip-chars-backward " \t") (point))) fcc-list)) (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) (set-buffer tembuf) (erase-buffer) ;; This initial newline is written out if the fcc file already exists. (insert "\nFrom " (user-login-name) " " (current-time-string time) "\n") ;; Insert the time zone before the year. (forward-char -1) (forward-word -1) (require 'mail-utils) (insert (mail-rfc822-time-zone time) " ") (goto-char (point-max)) (insert-buffer-substring rmailbuf) ;; Make sure messages are separated. (goto-char (point-max)) (insert ?\n) (goto-char 2) ;; ``Quote'' "^From " as ">From " ;; (note that this isn't really quoting, as there is no requirement ;; that "^[>]+From " be quoted in the same transparent way.) (let ((case-fold-search nil)) (while (search-forward "\nFrom " nil t) (forward-char -5) (insert ?>))) (while fcc-list (let* ((buffer (find-buffer-visiting (car fcc-list))) (curbuf (current-buffer)) (beg (point-min)) (end (point-max)) (beg2 (save-excursion (goto-char (point-min)) (forward-line 2) (point)))) (if buffer ;; File is present in a buffer => append to that buffer. (save-excursion (set-buffer buffer) ;; Keep the end of the accessible portion at the same place ;; unless it is the end of the buffer. (let ((max (if (/= (1+ (buffer-size)) (point-max)) (point-max)))) (unwind-protect ;; Code below lifted from rmailout.el ;; function rmail-output-to-rmail-file: (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 "\C-l\n0, unseen,,\n*** EOOH ***\n" "Date: " (mail-rfc822-date) "\n") (insert-buffer-substring curbuf beg2 end) (insert "\n\C-_") (goto-char (point-min)) (widen) (search-backward "\n\^_") (narrow-to-region (point) (point-max)) (rmail-count-new-messages t) (rmail-show-message msg) (setq max nil)) ;; 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 curbuf beg end))) (if max (narrow-to-region (point-min) max))))) ;; Else append to the file directly. (if (and (file-exists-p (car fcc-list)) (mail-file-babyl-p (car fcc-list))) ;; If the file is a Babyl file, ;; convert the message to Babyl format. (save-excursion (set-buffer (get-buffer-create " mail-temp")) (setq buffer-read-only nil) (erase-buffer) (insert "\C-l\n0, unseen,,\n*** EOOH ***\n" "Date: " (mail-rfc822-date) "\n") (insert-buffer-substring curbuf beg2 end) (insert "\n\C-_") (write-region (point-min) (point-max) (car fcc-list) t) (erase-buffer)) (write-region (1+ (point-min)) (point-max) (car fcc-list) t)))) (setq fcc-list (cdr fcc-list)))) (kill-buffer tembuf))) (defun mail-sent-via () "Make a Sent-via header line from each To or CC header line." (interactive) (save-excursion (goto-char (point-min)) ;; find the header-separator (search-forward (concat "\n" mail-header-separator "\n")) (forward-line -1) ;; put a marker at the end of the header (let ((end (point-marker)) (case-fold-search t) to-line) (goto-char (point-min)) ;; search for the To: lines and make Sent-via: lines from them ;; search for the next To: line (while (re-search-forward "^\\(to\\|cc\\):" end t) ;; Grab this line plus all its continuations, sans the `to:'. (let ((to-line (buffer-substring (point) (progn (if (re-search-forward "^[^ \t\n]" end t) (backward-char 1) (goto-char end)) (point))))) ;; Insert a copy, with altered header field name. (insert-before-markers "Sent-via:" to-line)))))) (defun mail-to () "Move point to end of To-field." (interactive) (expand-abbrev) (mail-position-on-field "To")) (defun mail-subject () "Move point to end of Subject-field." (interactive) (expand-abbrev) (mail-position-on-field "Subject")) (defun mail-cc () "Move point to end of CC-field. Create a CC field if none." (interactive) (expand-abbrev) (or (mail-position-on-field "cc" t) (progn (mail-position-on-field "to") (insert "\nCC: ")))) (defun mail-bcc () "Move point to end of BCC-field. Create a BCC field if none." (interactive) (expand-abbrev) (or (mail-position-on-field "bcc" t) (progn (mail-position-on-field "to") (insert "\nBCC: ")))) (defun mail-fcc (folder) "Add a new FCC field, with file name completion." (interactive "FFolder carbon copy: ") (expand-abbrev) (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC. (mail-position-on-field "to")) (insert "\nFCC: " folder)) (defun mail-reply-to () "Move point to end of Reply-To-field." (interactive) (expand-abbrev) (mail-position-on-field "Reply-To")) (defun mail-position-on-field (field &optional soft) (let (end (case-fold-search t)) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (setq end (match-beginning 0)) (goto-char (point-min)) (if (re-search-forward (concat "^" (regexp-quote field) ":") end t) (progn (re-search-forward "^[^ \t]" nil 'move) (beginning-of-line) (skip-chars-backward "\n") t) (or soft (progn (goto-char end) (insert field ": \n") (skip-chars-backward "\n"))) nil))) (defun mail-text () "Move point to beginning of message text." (interactive) (expand-abbrev) (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n"))) (defun mail-signature (atpoint) "Sign letter with contents of the file `mail-signature-file'. Prefix arg means put contents at point." (interactive "P") (save-excursion (or atpoint (goto-char (point-max))) (skip-chars-backward " \t\n") (end-of-line) (or atpoint (delete-region (point) (point-max))) (insert "\n\n-- \n") (insert-file-contents (expand-file-name mail-signature-file)))) (defun mail-fill-yanked-message (&optional justifyp) "Fill the paragraphs of a message yanked into this one. Numeric argument means justify as well." (interactive "P") (save-excursion (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n") nil t) (fill-individual-paragraphs (point) (point-max) justifyp t))) (defun mail-indent-citation () "Modify text just inserted from a message to be cited. The inserted text should be the region. When this function returns, the region is again around the modified text. Normally, indent each nonblank line `mail-indentation-spaces' spaces. However, if `mail-yank-prefix' is non-nil, insert that prefix on each line." (let ((start (point))) (mail-yank-clear-headers start (mark t)) (if (null mail-yank-prefix) (indent-rigidly start (mark t) mail-indentation-spaces) (save-excursion (goto-char start) (while (< (point) (mark t)) (insert mail-yank-prefix) (forward-line 1)))))) (defun mail-yank-original (arg) "Insert the message being replied to, if any (in rmail). Puts point before the text and mark after. Normally, indents each nonblank line ARG spaces (default 3). However, if `mail-yank-prefix' is non-nil, insert that prefix on each line. Just \\[universal-argument] as argument means don't indent, insert no prefix, and don't delete any header fields." (interactive "P") (if mail-reply-buffer (let ((start (point))) ;; If the original message is in another window in the same frame, ;; delete that window to save screen space. ;; t means don't alter other frames. (delete-windows-on mail-reply-buffer t) (insert-buffer mail-reply-buffer) (if (consp arg) nil (goto-char start) (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg) mail-indentation-spaces))) (if mail-citation-hook (run-hooks 'mail-citation-hook) (if mail-yank-hooks (run-hooks 'mail-yank-hooks) (mail-indent-citation))))) ;; This is like exchange-point-and-mark, but doesn't activate the mark. ;; It is cleaner to avoid activation, even though the command ;; loop would deactivate the mark because we inserted text. (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) (current-buffer)))) (if (not (eolp)) (insert ?\n))))) (defun mail-yank-clear-headers (start end) (if mail-yank-ignored-headers (save-excursion (goto-char start) (if (search-forward "\n\n" end t) (save-restriction (narrow-to-region start (point)) (goto-char start) (while (let ((case-fold-search t)) (re-search-forward mail-yank-ignored-headers nil t)) (beginning-of-line) (delete-region (point) (progn (re-search-forward "\n[^ \t]") (forward-char -1) (point))))))))) ;; Put these last, to reduce chance of lossage from quitting in middle of loading the file. ;;;###autoload (defun mail (&optional noerase to subject in-reply-to cc replybuffer actions) "Edit a message to be sent. Prefix arg means resume editing (don't erase). When this function returns, the buffer `*mail*' is selected. The value is t if the message was newly initialized; otherwise, nil. Optionally, the signature file `mail-signature-file' can be inserted at the end; see the variable `mail-signature'. \\ While editing message, type \\[mail-send-and-exit] to send the message and exit. Various special commands starting with C-c are available in sendmail mode to move to message header fields: \\{mail-mode-map} If `mail-self-blind' is non-nil, a BCC to yourself is inserted when the message is initialized. If `mail-default-reply-to' is non-nil, it should be an address (a string); a Reply-to: field with that address is inserted. If `mail-archive-file-name' is non-nil, an FCC field with that file name is inserted. The normal hook `mail-setup-hook' is run after the message is initialized. It can add more default fields to the message. When calling from a program, the first argument if non-nil says not to erase the existing contents of the `*mail*' buffer. The second through fifth arguments, TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil the initial contents of those header fields. These arguments should not have final newlines. The sixth argument REPLYBUFFER is a buffer whose contents should be yanked if the user types C-c C-y. The seventh argument ACTIONS is a list of actions to take if/when the message is sent. Each action looks like (FUNCTION . ARGS); when the message is sent, we apply FUNCTION to ARGS. This is how Rmail arranges to mark messages `answered'." (interactive "P") ;;; This is commented out because I found it was confusing in practice. ;;; It is easy enough to rename *mail* by hand with rename-buffer ;;; if you want to have multiple mail buffers. ;;; And then you can control which messages to save. --rms. ;;; (let ((index 1) ;;; buffer) ;;; ;; If requested, look for a mail buffer that is modified and go to it. ;;; (if noerase ;;; (progn ;;; (while (and (setq buffer ;;; (get-buffer (if (= 1 index) "*mail*" ;;; (format "*mail*<%d>" index)))) ;;; (not (buffer-modified-p buffer))) ;;; (setq index (1+ index))) ;;; (if buffer (switch-to-buffer buffer) ;;; ;; If none exists, start a new message. ;;; ;; This will never re-use an existing unmodified mail buffer ;;; ;; (since index is not 1 anymore). Perhaps it should. ;;; (setq noerase nil)))) ;;; ;; Unless we found a modified message and are happy, start a new message. ;;; (if (not noerase) ;;; (progn ;;; ;; Look for existing unmodified mail buffer. ;;; (while (and (setq buffer ;;; (get-buffer (if (= 1 index) "*mail*" ;;; (format "*mail*<%d>" index)))) ;;; (buffer-modified-p buffer)) ;;; (setq index (1+ index))) ;;; ;; If none, make a new one. ;;; (or buffer ;;; (setq buffer (generate-new-buffer "*mail*"))) ;;; ;; Go there and initialize it. ;;; (switch-to-buffer buffer) ;;; (erase-buffer) ;;; (setq default-directory (expand-file-name "~/")) ;;; (auto-save-mode auto-save-default) ;;; (mail-mode) ;;; (mail-setup to subject in-reply-to cc replybuffer actions) ;;; (if (and buffer-auto-save-file-name ;;; (file-exists-p buffer-auto-save-file-name)) ;;; (message "Auto save file for draft message exists; consider M-x mail-recover")) ;;; t)) (pop-to-buffer "*mail*") (auto-save-mode auto-save-default) (mail-mode) ;; Disconnect the buffer from its visited file ;; (in case the user has actually visited a file *mail*). ; (set-visited-file-name nil) (let (initialized) (and (not noerase) (or (not (buffer-modified-p)) (y-or-n-p "Unsent message being composed; erase it? ")) (progn (erase-buffer) (mail-setup to subject in-reply-to cc replybuffer actions) (setq initialized t))) (if (and buffer-auto-save-file-name (file-exists-p buffer-auto-save-file-name)) (message "Auto save file for draft message exists; consider M-x mail-recover")) initialized)) (defun mail-recover () "Reread contents of current buffer from its last auto-save file." (interactive) (let ((file-name (make-auto-save-file-name))) (cond ((save-window-excursion (if (not (eq system-type 'vax-vms)) (with-output-to-temp-buffer "*Directory*" (buffer-disable-undo standard-output) (let ((default-directory "/")) (call-process "ls" nil standard-output nil "-l" file-name)))) (yes-or-no-p (format "Recover auto save file %s? " file-name))) (let ((buffer-read-only nil)) (erase-buffer) (insert-file-contents file-name nil))) (t (error "mail-recover cancelled"))))) ;;;###autoload (defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer sendactions) "Like `mail' command, but display mail buffer in another window." (interactive "P") (let ((pop-up-windows t) (special-display-buffer-names nil) (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) (pop-to-buffer "*mail*")) (mail noerase to subject in-reply-to cc replybuffer sendactions)) ;;;###autoload (defun mail-other-frame (&optional noerase to subject in-reply-to cc replybuffer sendactions) "Like `mail' command, but display mail buffer in another frame." (interactive "P") (let ((pop-up-frames t) (special-display-buffer-names nil) (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) (pop-to-buffer "*mail*")) (mail noerase to subject in-reply-to cc replybuffer sendactions)) ;;; Do not execute these when sendmail.el is loaded, ;;; only in loaddefs.el. ;;;###autoload (define-key ctl-x-map "m" 'mail) ;;;###autoload (define-key ctl-x-4-map "m" 'mail-other-window) ;;;###autoload (define-key ctl-x-5-map "m" 'mail-other-frame) ;;;###autoload (add-hook 'same-window-buffer-names "*mail*") ;;; Do not add anything but external entries on this page. (provide 'sendmail) ;;; sendmail.el ends here emacs-19.30/lisp/server.el100444 12120 1 40416 6050702575 13732 0ustar rmsdaemon;;; server.el --- Lisp code for GNU Emacs running as server process. ;; Copyright (C) 1986, 1987, 1992, 1994, 1995 Free Software Foundation, Inc. ;; Author: William Sommerfeld ;; Keywords: processes ;; Changes by peck@sun.com and by rms. ;; 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 Lisp code is run in Emacs when it is to operate as ;;; a server for other processes. ;;; Load this library and do M-x server-edit to enable Emacs as a server. ;;; Emacs runs the program ../arch-lib/emacsserver as a subprocess ;;; for communication with clients. If there are no client buffers to edit, ;;; server-edit acts like (switch-to-buffer (other-buffer)) ;;; When some other program runs "the editor" to edit a file, ;;; "the editor" can be the Emacs client program ../lib-src/emacsclient. ;;; This program transmits the file names to Emacs through ;;; the server subprocess, and Emacs visits them and lets you edit them. ;;; Note that any number of clients may dispatch files to emacs to be edited. ;;; When you finish editing a Server buffer, again call server-edit ;;; to mark that buffer as done for the client and switch to the next ;;; Server buffer. When all the buffers for a client have been edited ;;; and exited with server-edit, the client "editor" will return ;;; to the program that invoked it. ;;; Your editing commands and Emacs's display output go to and from ;;; the terminal in the usual way. Thus, server operation is possible ;;; only when Emacs can talk to the terminal at the time you invoke ;;; the client. This is possible in four cases: ;;; 1. On a window system, where Emacs runs in one window and the ;;; program that wants to use "the editor" runs in another. ;;; 2. On a multi-terminal system, where Emacs runs on one terminal and the ;;; program that wants to use "the editor" runs on another. ;;; 3. When the program that wants to use "the editor" is running ;;; as a subprocess of Emacs. ;;; 4. On a system with job control, when Emacs is suspended, the program ;;; that wants to use "the editor" will stop and display ;;; "Waiting for Emacs...". It can then be suspended, and Emacs can be ;;; brought into the foreground for editing. When done editing, Emacs is ;;; suspended again, and the client program is brought into the foreground. ;;; The buffer local variable "server-buffer-clients" lists ;;; the clients who are waiting for this buffer to be edited. ;;; The global variable "server-clients" lists all the waiting clients, ;;; and which files are yet to be edited for each. ;;; Code: (defvar server-program (expand-file-name "emacsserver" exec-directory) "*The program to use as the edit server.") (defvar server-visit-hook nil "*List of hooks to call when visiting a file for the Emacs server.") (defvar server-switch-hook nil "*List of hooks to call when switching to a buffer for the Emacs server.") (defvar server-done-hook nil "*List of hooks to call when done editing a buffer for the Emacs server.") (defvar server-process nil "the current server process") (defvar server-previous-string "") (defvar server-clients nil "List of current server clients. Each element is (CLIENTID BUFFERS...) where CLIENTID is a string that can be given to the server process to identify a client. When a buffer is marked as \"done\", it is removed from this list.") (defvar server-buffer-clients nil "List of clientids for clients requesting editing of current buffer.") (make-variable-buffer-local 'server-buffer-clients) ;; Changing major modes should not erase this local. (put 'server-buffer-clients 'permanent-local t) (defvar server-window nil "*The window to use for selecting Emacs server buffers. If nil, use the selected window. If it is a frame, use the frame's selected window.") (defvar server-temp-file-regexp "^/tmp/Re\\|/draft$" "*Regexp which should match filenames of temporary files which are deleted and reused after each edit by the programs that invoke the emacs server.") (or (assq 'server-buffer-clients minor-mode-alist) (setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist))) ;; If a *server* buffer exists, ;; write STRING to it for logging purposes. (defun server-log (string) (if (get-buffer "*server*") (save-excursion (set-buffer "*server*") (goto-char (point-max)) (insert (current-time-string) " " string) (or (bolp) (newline))))) (defun server-sentinel (proc msg) (cond ((eq (process-status proc) 'exit) (server-log (message "Server subprocess exited"))) ((eq (process-status proc) 'signal) (server-log (message "Server subprocess killed"))))) ;;;###autoload (defun server-start (&optional leave-dead) "Allow this Emacs process to be a server for client processes. This starts a server communications subprocess through which client \"editors\" can send your editing commands to this Emacs job. To use the server, set up the program `emacsclient' in the Emacs distribution as your standard \"editor\". Prefix arg means just kill any existing server communications subprocess." (interactive "P") ;; kill it dead! (if server-process (progn (set-process-sentinel server-process nil) (condition-case () (delete-process server-process) (error nil)))) (condition-case () (delete-file "~/.emacs_server") (error nil)) (let* ((sysname (system-name)) (dot-index (string-match "\\." sysname))) (condition-case () (delete-file (format "/tmp/esrv%d-%s" (user-uid) sysname)) (error nil)) ;; In case the server file name was made with a domainless hostname, ;; try deleting that name too. (if dot-index (condition-case () (delete-file (format "/tmp/esrv%d-%s" (user-uid) (substring sysname 0 dot-index))) (error nil)))) ;; If we already had a server, clear out associated status. (while server-clients (let ((buffer (nth 1 (car server-clients)))) (server-buffer-done buffer))) (if leave-dead nil (if server-process (server-log (message "Restarting server"))) ;; Using a pty is wasteful, and the separate session causes ;; annoyance sometimes (some systems kill idle sessions). (let ((process-connection-type nil)) (setq server-process (start-process "server" nil server-program))) (set-process-sentinel server-process 'server-sentinel) (set-process-filter server-process 'server-process-filter) (process-kill-without-query server-process))) ;Process a request from the server to edit some files. ;Format of STRING is "Client: CLIENTID PATH PATH PATH... \n" (defun server-process-filter (proc string) (server-log string) (setq string (concat server-previous-string string)) ;; If the input is multiple lines, ;; process each line individually. (while (string-match "\n" string) (let ((request (substring string 0 (match-beginning 0))) client (files nil) (lineno 1)) ;; Remove this line from STRING. (setq string (substring string (match-end 0))) (if (string-match "^Error: " request) (message (concat "Server error: " (substring request (match-end 0)))) (if (string-match "^Client: " request) (progn (setq request (substring request (match-end 0))) (setq client (list (substring request 0 (string-match " " request)))) (setq request (substring request (match-end 0))) (while (string-match "[^ ]+ " request) (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) (setq request (substring request (match-end 0))) (if (string-match "\\`\\+[0-9]+\\'" arg) (setq lineno (read (substring arg 1))) (setq files (cons (list arg lineno) files)) (setq lineno 1)))) (server-visit-files files client) ;; CLIENT is now a list (CLIENTNUM BUFFERS...) (setq server-clients (cons client server-clients)) (server-switch-buffer (nth 1 client)) (run-hooks 'server-switch-hook) (message (substitute-command-keys "When done with a buffer, type \\[server-edit]"))))))) ;; Save for later any partial line that remains. (setq server-previous-string string)) (defun server-visit-files (files client) "Finds FILES and returns the list CLIENT with the buffers nconc'd. FILES is an alist whose elements are (FILENAME LINENUMBER)." ;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries. (let (client-record (last-nonmenu-event t) (obuf (current-buffer))) ;; Restore the current buffer afterward, but not using save-excursion, ;; because we don't want to save point in this buffer ;; if it happens to be one of those specified by the server. (unwind-protect (while files ;; If there is an existing buffer modified or the file is modified, ;; revert it. ;; If there is an existing buffer with deleted file, offer to write it. (let* ((filen (car (car files))) (obuf (get-file-buffer filen))) (if (and obuf (set-buffer obuf)) (if (file-exists-p filen) (if (or (not (verify-visited-file-modtime obuf)) (buffer-modified-p obuf)) (revert-buffer t nil)) (if (y-or-n-p (concat "File no longer exists: " filen ", write buffer to file? ")) (write-file filen))) (set-buffer (find-file-noselect filen)) (run-hooks 'server-visit-hook))) (goto-line (nth 1 (car files))) (setq server-buffer-clients (cons (car client) server-buffer-clients)) (setq client-record (cons (current-buffer) client-record)) (setq files (cdr files))) (set-buffer obuf)) (nconc client client-record))) (defun server-buffer-done (buffer) "Mark BUFFER as \"done\" for its client(s). This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED). NEXT-BUFFER is another server buffer, as a suggestion for what to select next, or nil. KILLED is t if we killed BUFFER (because it was a temp file)." (let ((running (eq (process-status server-process) 'run)) (next-buffer nil) (killed nil) (first t) (old-clients server-clients)) (while old-clients (let ((client (car old-clients))) (or next-buffer (setq next-buffer (nth 1 (memq buffer client)))) (delq buffer client) ;; Delete all dead buffers from CLIENT. (let ((tail client)) (while tail (and (bufferp (car tail)) (null (buffer-name (car tail))) (delq (car tail) client)) (setq tail (cdr tail)))) ;; If client now has no pending buffers, ;; tell it that it is done, and forget it entirely. (if (cdr client) nil (if running (progn ;; Don't send emacsserver two commands in close succession. ;; It cannot handle that. (or first (sit-for 1)) (setq first nil) (send-string server-process (format "Close: %s Done\n" (car client))) (server-log (format "Close: %s Done\n" (car client))))) (setq server-clients (delq client server-clients)))) (setq old-clients (cdr old-clients))) (if (and (bufferp buffer) (buffer-name buffer)) (progn (save-excursion (set-buffer buffer) (setq server-buffer-clients nil) (run-hooks 'server-done-hook)) (if (server-temp-file-p buffer) (progn (kill-buffer buffer) (setq killed t)) (bury-buffer buffer)))) (list next-buffer killed))) (defun server-temp-file-p (buffer) "Return non-nil if BUFFER contains a file considered temporary. These are files whose names suggest they are repeatedly reused to pass information to another program. The variable `server-temp-file-regexp' controls which filenames are considered temporary." (and (buffer-file-name buffer) (string-match server-temp-file-regexp (buffer-file-name buffer)))) (defun server-done () "Offer to save current buffer, mark it as \"done\" for clients. This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED). NEXT-BUFFER is another server buffer, as a suggestion for what to select next, or nil. KILLED is t if we killed the BUFFER (because it was a temp file)." (let ((buffer (current-buffer))) (if server-buffer-clients (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)) (if (and (buffer-modified-p) (y-or-n-p (concat "Save file " buffer-file-name "? "))) (save-buffer buffer))) (server-buffer-done buffer))))) ;; Ask before killing a server buffer. ;; It was suggested to release its client instead, ;; but I think that is dangerous--the client would proceed ;; using whatever is on disk in that file. -- rms. (defun server-kill-buffer-query-function () (or (not server-buffer-clients) (yes-or-no-p (format "Buffer `%s' still has clients; kill it? " (buffer-name (current-buffer)))))) (add-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function) (defun server-kill-emacs-query-function () (let (live-client (tail server-clients)) ;; See if any clients have any buffers that are still alive. (while tail (if (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail))))) (setq live-client t)) (setq tail (cdr tail))) (or (not live-client) (yes-or-no-p "Server buffers still have clients; exit anyway? ")))) (add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) (defun server-edit (&optional arg) "Switch to next server editing buffer; say \"Done\" for current buffer. If a server buffer is current, it is marked \"done\" and optionally saved. When all of a client's buffers are marked as \"done\", the client is notified. 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. If invoked with a prefix argument, or if there is no server process running, starts server process and that is all. Invoked by \\[server-edit]." (interactive "P") (if (or arg (not server-process) (memq (process-status server-process) '(signal exit))) (server-start nil) (apply 'server-switch-buffer (server-done)))) (defun server-switch-buffer (&optional next-buffer killed-one) "Switch to another buffer, preferably one that has a client. Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it." ;; KILLED-ONE is t in a recursive call ;; if we have already killed one temp-file server buffer. ;; This means we should avoid the final "switch to some other buffer" ;; since we've already effectively done that. (cond ((and (windowp server-window) (window-live-p server-window)) (select-window server-window)) ((framep server-window) (if (not (frame-live-p server-window)) (setq server-window (make-frame))) (select-window (frame-selected-window server-window)))) (if (window-minibuffer-p (selected-window)) (select-window (next-window nil 'nomini 0))) ;; Move to a non-dedicated window, if we have one. (let ((last-window (previous-window nil 'nomini 0))) (while (and (window-dedicated-p (selected-window)) (not (eq last-window (selected-window)))) (select-window (next-window nil 'nomini 0)))) (set-window-dedicated-p (selected-window) nil) (if next-buffer (if (and (bufferp next-buffer) (buffer-name next-buffer)) (switch-to-buffer next-buffer) ;; If NEXT-BUFFER is a dead buffer, ;; remove the server records for it ;; and try the next surviving server buffer. (apply 'server-switch-buffer (server-buffer-done next-buffer))) (if server-clients (server-switch-buffer (nth 1 (car server-clients)) killed-one) (if (not killed-one) (switch-to-buffer (other-buffer)))))) (global-set-key "\C-x#" 'server-edit) (provide 'server) ;;; server.el ends here emacs-19.30/lisp/sgml-mode.el100444 75424 1 20566 5770115517 14520 0ustar kwzhdaemon;;; sgml-mode.el --- SGML-editing mode ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: James Clark ;; Adapted-By: ESR ;; Keywords: wp ;; 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: ;; Major mode for editing the SGML document-markup language. ;;; Code: (provide 'sgml-mode) (require 'compile) ;;; sgmls is a free SGML parser available from ;;; ftp.uu.net:pub/text-processing/sgml ;;; Its error messages can be parsed by next-error. ;;; The -s option suppresses output. (defconst sgml-validate-command "sgmls -s" "*The command to validate an SGML document. The file name of current buffer file name will be appended to this, separated by a space.") (defvar sgml-saved-validate-command nil "The command last used to validate in this buffer.") (defvar sgml-mode-map nil "Keymap for SGML mode") (if sgml-mode-map () (setq sgml-mode-map (make-sparse-keymap)) (define-key sgml-mode-map ">" 'sgml-close-angle) (define-key sgml-mode-map "/" 'sgml-slash) (define-key sgml-mode-map "\C-c\C-v" 'sgml-validate)) ;;;###autoload (defun sgml-mode () "Major mode for editing SGML. Makes > display the matching <. Makes / display matching /. Use \\[sgml-validate] to validate your document with an SGML parser." (interactive) (kill-all-local-variables) (setq local-abbrev-table text-mode-abbrev-table) (use-local-map sgml-mode-map) (setq mode-name "SGML") (setq major-mode 'sgml-mode) (make-local-variable 'paragraph-start) ;; A start or end tag by itself on a line separates a paragraph. ;; This is desirable because SGML discards a newline that appears ;; immediately after a start tag or immediately before an end tag. (setq paragraph-start "^[ \t\n]\\|\ \\($\\)") (make-local-variable 'paragraph-separate) (setq paragraph-separate "^[ \t\n]*$\\|\ ^$") (make-local-variable 'sgml-saved-validate-command) (set-syntax-table text-mode-syntax-table) (make-local-variable 'comment-start) (setq comment-start "") (make-local-variable 'comment-indent-function) (setq comment-indent-function 'sgml-comment-indent) (make-local-variable 'comment-start-skip) ;; This will allow existing comments within declarations to be ;; recognized. (setq comment-start-skip "--[ \t]*") (run-hooks 'text-mode-hook 'sgml-mode-hook)) (defun sgml-comment-indent () (if (and (looking-at "--") (not (and (eq (char-after (1- (point))) ?!) (eq (char-after (- (point) 2)) ?<)))) (progn (skip-chars-backward " \t") (max comment-column (1+ (current-column)))) 0)) (defconst sgml-start-tag-regex "<[A-Za-z]\\([-.A-Za-z0-9= \n\t]\\|\"[^\"]*\"\\|'[^']*'\\)*" "Regular expression that matches a non-empty start tag. Any terminating > or / is not matched.") (defvar sgml-mode-markup-syntax-table nil "Syntax table used for scanning SGML markup.") (if sgml-mode-markup-syntax-table () (setq sgml-mode-markup-syntax-table (make-syntax-table)) (modify-syntax-entry ?< "(>" sgml-mode-markup-syntax-table) (modify-syntax-entry ?> ")<" sgml-mode-markup-syntax-table) (modify-syntax-entry ?- "_ 1234" sgml-mode-markup-syntax-table) (modify-syntax-entry ?\' "\"" sgml-mode-markup-syntax-table)) (defconst sgml-angle-distance 4000 "*If non-nil, is the maximum distance to search for matching <.") (defun sgml-close-angle (arg) "Insert > and display matching <." (interactive "p") (insert-char ?> arg) (if (> arg 0) (let ((oldpos (point)) (blinkpos)) (save-excursion (save-restriction (if sgml-angle-distance (narrow-to-region (max (point-min) (- (point) sgml-angle-distance)) oldpos)) ;; See if it's the end of a marked section. (and (> (- (point) (point-min)) 3) (eq (char-after (- (point) 2)) ?\]) (eq (char-after (- (point) 3)) ?\]) (re-search-backward "" oldpos t) (eq (point) oldpos)) (setq blinkpos msspos)))) ;; This handles cases where the > ends one of the following: ;; markup declaration starting with ]\\|!\\([[A-Za-z]\\|--\\)\\)")) ;; Check that it's not a net-enabling start tag ;; nor an unclosed start-tag. (looking-at (concat sgml-start-tag-regex "[/<]")) ;; Nor an unclosed end-tag. (looking-at "" oldpos t) (eq (point) oldpos)) (setq blinkpos pipos)))))) (if blinkpos (progn (goto-char blinkpos) (if (pos-visible-in-window-p) (sit-for 1) (message "Matches %s" (buffer-substring blinkpos (progn (end-of-line) (point))))))))))) ;;; I doubt that null end tags are used much for large elements, ;;; so use a small distance here. (defconst sgml-slash-distance 1000 "*If non-nil, is the maximum distance to search for matching /.") (defun sgml-slash (arg) "Insert / and display any previous matching /. Two /s are treated as matching if the first / ends a net-enabling start tag, and the second / is the corresponding null end tag." (interactive "p") (insert-char ?/ arg) (if (> arg 0) (let ((oldpos (point)) (blinkpos) (level 0)) (save-excursion (save-restriction (if sgml-slash-distance (narrow-to-region (max (point-min) (- (point) sgml-slash-distance)) oldpos)) (if (and (re-search-backward sgml-start-tag-regex (point-min) t) (eq (match-end 0) (1- oldpos))) () (goto-char (1- oldpos)) (while (and (not blinkpos) (search-backward "/" (point-min) t)) (let ((tagend (save-excursion (if (re-search-backward sgml-start-tag-regex (point-min) t) (match-end 0) nil)))) (if (eq tagend (point)) (if (eq level 0) (setq blinkpos (point)) (setq level (1- level))) (setq level (1+ level))))))) (if blinkpos (progn (goto-char blinkpos) (if (pos-visible-in-window-p) (sit-for 1) (message "Matches %s" (buffer-substring (progn (beginning-of-line) (point)) (1+ blinkpos)))))))))) (defun sgml-validate (command) "Validate an SGML document. Runs COMMAND, a shell command, in a separate process asynchronously with output going to the buffer *compilation*. You can then use the command \\[next-error] to find the next error message and move to the line in the SGML document that caused it." (interactive (list (read-string "Validate command: " (or sgml-saved-validate-command (concat sgml-validate-command " " (let ((name (buffer-file-name))) (and name (file-name-nondirectory name)))))))) (setq sgml-saved-validate-command command) (compile-internal command "No more errors")) ;;; sgml-mode.el ends here emacs-19.30/lisp/sh-script.el100444 22556 1 122605 6051132303 14513 0ustar erikdaemon;;; sh-script.el --- shell-script editing commands for Emacs ;; Copyright (C) 1993, 1994, 1995 by Free Software Foundation, Inc. ;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 ;; Version: 2.0d ;; Maintainer: FSF ;; Keywords: languages, unix ;; 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: ;; Major mode for editing shell scripts. Bourne, C and rc shells as well ;; as various derivatives are supported and easily derived from. Structured ;; statements can be inserted with one command or abbrev. Completion is ;; available for filenames, variables known from the script, the shell and ;; the environment as well as commands. ;;; Known Bugs: ;; - Since GNU Emacs' syntax can't handle the context-sensitive meanings of ;; the variable/number base/comment symbol `#', that has to be fontified by ;; regexp. This alas means that a quote `'' or `"' in a comment will ;; fontify VERY badly. The alternative is to have these frequent constructs ;; with `#' fontify as comments. Or maybe we intoduce a 'syntax text- ;; property? ;; - Variables in `"' strings aren't fontified because there's no way of ;; syntactically distinguishing those from `'' strings. ;;; Code: ;; page 1: variables and settings ;; page 2: mode-command and utility functions ;; page 3: statement syntax-commands for various shells ;; page 4: various other commands (require 'executable) ;; Autoload cookie deleted here because it made loaddefs.el fail to load. ;; -rms (or (assoc "sh" interpreter-mode-alist) (setq auto-mode-alist ;; matches files ;; - that have a suffix .sh, .csh or .shar (shell archive) ;; - that contain ressources for the various shells ;; - startup files for X11 (cons '("\\.c?sh\\'\\|\\.shar\\'\\|/\\.\\(z?profile\\|bash_profile\\|z?login\\|bash_login\\|z?logout\\|bash_logout\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\|rcrc\\|[kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) auto-mode-alist) interpreter-mode-alist (nconc '(("ash" . sh-mode) ("bash" . sh-mode) ("csh" . sh-mode) ("dtksh" . sh-mode) ("es" . sh-mode) ("itcsh" . sh-mode) ("jsh" . sh-mode) ("ksh" . sh-mode) ("oash" . sh-mode) ("pdksh" . sh-mode) ("rc" . sh-mode) ("sh" . sh-mode) ("sh5" . sh-mode) ("tcsh" . sh-mode) ("wksh" . sh-mode) ("wsh" . sh-mode) ("zsh" . sh-mode)) interpreter-mode-alist))) (defvar sh-ancestor-alist '((ash . sh) (bash . jsh) (dtksh . ksh) (es . rc) (itcsh . tcsh) (jcsh . csh) (jsh . sh) (ksh . ksh88) (ksh88 . jsh) (oash . sh) (pdksh . ksh88) (posix . sh) (tcsh . csh) (wksh . ksh88) (wsh . sh) (zsh . ksh88)) "*Alist showing the direct ancestor of various shells. This is the basis for `sh-feature'. See also `sh-alias-alist'. By default we have the following three hierarchies: csh C Shell jcsh C Shell with Job Control tcsh Toronto C Shell itcsh ? Toronto C Shell rc Plan 9 Shell es Extensible Shell sh Bourne Shell ash ? Shell jsh Bourne Shell with Job Control bash GNU Bourne Again Shell ksh88 Korn Shell '88 ksh Korn Shell '93 dtksh CDE Desktop Korn Shell pdksh Public Domain Korn Shell wksh Window Korn Shell zsh Z Shell oash SCO OA (curses) Shell posix IEEE 1003.2 Shell Standard wsh ? Shell") (defvar sh-alias-alist (nconc (if (eq system-type 'linux) '((csh . tcsh) (ksh . pdksh) (sh . bash))) ;; for the time being '((ksh . ksh88) (sh5 . sh))) "*Alist for transforming shell names to what they really are. Use this where the name of the executable doesn't correspond to the type of shell it really is.") (defvar sh-shell-path (or (getenv "SHELL") "/bin/sh") "*The executable of the shell being programmed.") (defvar sh-shell-arg '((bash . "-norc") (csh . "-f") (ksh88 eval progn nil (if (file-exists-p "/etc/suid_profile") nil "-p")) (pdksh) (rc . "-p") (wksh . "-motif") (zsh . "-f")) "*Single argument string for the magic number. See `sh-feature'.") (defvar sh-shell (or (cdr (assq (intern (file-name-nondirectory sh-shell-path)) sh-alias-alist)) (intern (file-name-nondirectory sh-shell-path))) "The shell being programmed. This is set by \\[sh-set-shell].") (defvar sh-abbrevs '((csh eval sh-abbrevs shell "switch" 'sh-case "getopts" 'sh-while-getopts) (es eval sh-abbrevs shell "function" 'sh-function) (ksh88 eval sh-abbrevs sh "select" 'sh-select) (rc eval sh-abbrevs shell "case" 'sh-case "function" 'sh-function) (sh eval sh-abbrevs shell "case" 'sh-case "function" 'sh-function "until" 'sh-until "getopts" 'sh-while-getopts) ;; The next entry is only used for defining the others (shell "for" sh-for "loop" sh-indexed-loop "if" sh-if "tmpfile" sh-tmp-file "while" sh-while) (zsh eval sh-abbrevs ksh88 "repeat" 'sh-repeat)) "Abbrev-table used in Shell-Script mode. See `sh-feature'. Due to the internal workings of abbrev tables, the shell name symbol is actually defined as the table for the like of \\[edit-abbrevs].") (defvar sh-mode-syntax-table '((csh eval identity sh) (sh eval sh-mode-syntax-table () ;; #'s meanings depend on context which can't be expressed here ;; ?\# "<" ;; ?\^l ">#" ;; ?\n ">#" ?\" "\"\"" ?\' "\"'" ?\` ".`" ?$ "_" ?! "_" ?% "_" ?: "_" ?. "_" ?^ "_" ?~ "_") (rc eval sh-mode-syntax-table sh ?\" "_" ?\` ".")) "Syntax-table used in Shell-Script mode. See `sh-feature'.") (defvar sh-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-c(" 'sh-function) (define-key map "\C-c\C-w" 'sh-while) (define-key map "\C-c\C-u" 'sh-until) (define-key map "\C-c\C-t" 'sh-tmp-file) (define-key map "\C-c\C-s" 'sh-select) (define-key map "\C-c\C-r" 'sh-repeat) (define-key map "\C-c\C-o" 'sh-while-getopts) (define-key map "\C-c\C-l" 'sh-indexed-loop) (define-key map "\C-c\C-i" 'sh-if) (define-key map "\C-c\C-f" 'sh-for) (define-key map "\C-c\C-c" 'sh-case) (define-key map "=" 'sh-assignment) (define-key map "\C-c+" 'sh-add) (define-key map "\C-\M-x" 'sh-execute-region) (define-key map "\C-c\C-x" 'executable-interpret) (define-key map "<" 'sh-maybe-here-document) (define-key map "(" 'skeleton-pair-insert-maybe) (define-key map "{" 'skeleton-pair-insert-maybe) (define-key map "[" 'skeleton-pair-insert-maybe) (define-key map "'" 'skeleton-pair-insert-maybe) (define-key map "`" 'skeleton-pair-insert-maybe) (define-key map "\"" 'skeleton-pair-insert-maybe) (define-key map "\t" 'sh-indent-line) (substitute-key-definition 'complete-tag 'comint-dynamic-complete map (current-global-map)) (substitute-key-definition 'newline-and-indent 'sh-newline-and-indent map (current-global-map)) (substitute-key-definition 'delete-backward-char 'backward-delete-char-untabify map (current-global-map)) (define-key map "\C-c:" 'sh-set-shell) (substitute-key-definition 'beginning-of-defun 'sh-beginning-of-compound-command map (current-global-map)) (substitute-key-definition 'backward-sentence 'sh-beginning-of-command map (current-global-map)) (substitute-key-definition 'forward-sentence 'sh-end-of-command map (current-global-map)) (define-key map [menu-bar insert] (cons "Insert" (make-sparse-keymap "Insert"))) (define-key map [menu-bar insert sh-while] '("While loop" . sh-while)) (define-key map [menu-bar insert sh-until] '("Until loop" . sh-until)) (define-key map [menu-bar insert sh-tmp-file] '("Temporary file" . sh-tmp-file)) (define-key map [menu-bar insert sh-select] '("Select statement" . sh-select)) (define-key map [menu-bar insert sh-repeat] '("Repeat loop" . sh-repeat)) (define-key map [menu-bar insert sh-while-getopts] '("Options loop" . sh-while-getopts)) (define-key map [menu-bar insert sh-indexed-loop] '("Indexed loop" . sh-indexed-loop)) (define-key map [menu-bar insert sh-if] '("If statement" . sh-if)) (define-key map [menu-bar insert sh-for] '("For loop" . sh-for)) (define-key map [menu-bar insert sh-case] '("Case statement" . sh-case)) map) "Keymap used in Shell-Script mode.") (defvar sh-dynamic-complete-functions '(shell-dynamic-complete-environment-variable shell-dynamic-complete-command comint-dynamic-complete-filename) "*Functions for doing TAB dynamic completion.") (defvar sh-require-final-newline '((csh . t) (pdksh . t) (rc eval . require-final-newline) (sh eval . require-final-newline)) "*Value of `require-final-newline' in Shell-Script mode buffers. See `sh-feature'.") (defvar sh-comment-prefix '((csh . "\\(^\\|[^$]\\|\\$[^{]\\)") (rc eval identity csh) (sh . "\\(^\\|[ \t|&;()]\\)")) "*Regexp matching what may come before a comment `#'. This must contain one \\(grouping\\) since it is the basis for fontifying comments as well as for `comment-start-skip'. See `sh-feature'.") (defvar sh-assignment-regexp '((csh . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=") ;; actually spaces are only supported in let/(( ... )) (ksh88 . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ \t]*\\([-+*/%&|~^]\\|<<\\|>>\\)?=") (rc . "\\<\\([a-zA-Z0-9_*]+\\)[ \t]*=") (sh . "\\<\\([a-zA-Z0-9_]+\\)=")) "*Regexp for the variable name and what may follow in an assignment. First grouping matches the variable name. This is upto and including the `=' sign. See `sh-feature'.") (defvar sh-indentation 4 "The width for further indentation in Shell-Script mode.") (defvar sh-remember-variable-min 3 "*Don't remember variables less than this length for completing reads.") (defvar sh-header-marker nil "When non-`nil' is the end of header for prepending by \\[sh-execute-region]. That command is also used for setting this variable.") (defvar sh-beginning-of-command "\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ \t]*\\([/~a-zA-Z0-9:]\\)" "*Regexp to determine the beginning of a shell command. The actual command starts at the beginning of the second \\(grouping\\).") (defvar sh-end-of-command "\\([/~a-zA-Z0-9:]\\)[ \t]*\\([;#)}`|&]\\|$\\)" "*Regexp to determine the end of a shell command. The actual command ends at the end of the first \\(grouping\\).") (defvar sh-here-document-word "EOF" "Word to delimit here documents.") (defvar sh-test '((sh "[ ]" . 3) (ksh88 "[[ ]]" . 4)) "Initial input in Bourne if, while and until skeletons. See `sh-feature'.") (defvar sh-builtins '((bash eval sh-append posix "alias" "bg" "bind" "builtin" "declare" "dirs" "enable" "fc" "fg" "help" "history" "jobs" "kill" "let" "local" "popd" "pushd" "source" "suspend" "typeset" "unalias") ;; The next entry is only used for defining the others (bourne eval sh-append shell "eval" "export" "getopts" "newgrp" "pwd" "read" "readonly" "times" "ulimit") (csh eval sh-append shell "alias" "chdir" "glob" "history" "limit" "nice" "nohup" "rehash" "setenv" "source" "time" "unalias" "unhash") (dtksh eval identity wksh) (es "access" "apids" "cd" "echo" "eval" "false" "let" "limit" "local" "newpgrp" "result" "time" "umask" "var" "vars" "wait" "whatis") (jsh eval sh-append sh "bg" "fg" "jobs" "kill" "stop" "suspend") (jcsh eval sh-append csh "bg" "fg" "jobs" "kill" "notify" "stop" "suspend") (ksh88 eval sh-append bourne "alias" "bg" "false" "fc" "fg" "jobs" "kill" "let" "print" "time" "typeset" "unalias" "whence") (oash eval sh-append sh "checkwin" "dateline" "error" "form" "menu" "newwin" "oadeinit" "oaed" "oahelp" "oainit" "pp" "ppfile" "scan" "scrollok" "wattr" "wclear" "werase" "win" "wmclose" "wmmessage" "wmopen" "wmove" "wmtitle" "wrefresh") (pdksh eval sh-append ksh88 "bind") (posix eval sh-append sh "command") (rc "builtin" "cd" "echo" "eval" "limit" "newpgrp" "shift" "umask" "wait" "whatis") (sh eval sh-append bourne "hash" "test" "type") ;; The next entry is only used for defining the others (shell "cd" "echo" "eval" "set" "shift" "umask" "unset" "wait") (wksh eval sh-append ksh88 "Xt[A-Z][A-Za-z]*") (zsh eval sh-append ksh88 "autoload" "bindkey" "builtin" "chdir" "compctl" "declare" "dirs" "disable" "disown" "echotc" "enable" "functions" "getln" "hash" "history" "integer" "limit" "local" "log" "popd" "pushd" "r" "readonly" "rehash" "sched" "setopt" "source" "suspend" "true" "ttyctl" "type" "unfunction" "unhash" "unlimit" "unsetopt" "vared" "which")) "*List of all shell builtins for completing read and fontification. Note that on some systems not all builtins are available or some are implemented as aliases. See `sh-feature'.") (defvar sh-leading-keywords '((csh "else") (es "true" "unwind-protect" "whatis") (rc "else") (sh "do" "elif" "else" "if" "then" "trap" "type" "until" "while")) "*List of keywords that may be immediately followed by a builtin or keyword. Given some confusion between keywords and builtins depending on shell and system, the distinction here has been based on whether they influence the flow of control or syntax. See `sh-feature'.") (defvar sh-other-keywords '((bash eval sh-append bourne "bye" "logout") ;; The next entry is only used for defining the others (bourne eval sh-append shell "done" "esac" "fi" "for" "function" "in" "return") (csh eval sh-append shell "breaksw" "default" "end" "endif" "endsw" "foreach" "goto" "if" "logout" "onintr" "repeat" "switch" "then" "while") (es "break" "catch" "exec" "exit" "fn" "for" "forever" "fork" "if" "return" "throw" "while") (ksh88 eval sh-append bourne "select") (rc "break" "case" "exec" "exit" "fn" "for" "if" "in" "return" "switch" "while") ;; The next entry is only used for defining the others (shell "break" "case" "continue" "exec" "exit") (zsh eval sh-append bash "select")) "*List of keywords not in `sh-leading-keywords'. See `sh-feature'.") (defvar sh-variables '((bash eval sh-append sh "allow_null_glob_expansion" "auto_resume" "BASH" "BASH_VERSION" "cdable_vars" "ENV" "EUID" "FCEDIT" "FIGNORE" "glob_dot_filenames" "histchars" "HISTFILE" "HISTFILESIZE" "history_control" "HISTSIZE" "hostname_completion_file" "HOSTTYPE" "IGNOREEOF" "ignoreeof" "LINENO" "MAIL_WARNING" "noclobber" "nolinks" "notify" "no_exit_on_failed_exec" "NO_PROMPT_VARS" "OLDPWD" "OPTERR" "PPID" "PROMPT_COMMAND" "PS4" "pushd_silent" "PWD" "RANDOM" "REPLY" "SECONDS" "SHLVL" "TMOUT" "UID") (csh eval sh-append shell "argv" "cdpath" "child" "echo" "histchars" "history" "home" "ignoreeof" "mail" "noclobber" "noglob" "nonomatch" "path" "prompt" "shell" "status" "time" "verbose") (es eval sh-append shell "apid" "cdpath" "CDPATH" "history" "home" "ifs" "noexport" "path" "pid" "prompt" "signals") (jcsh eval sh-append csh "notify") (ksh88 eval sh-append sh "ENV" "ERRNO" "FCEDIT" "FPATH" "HISTFILE" "HISTSIZE" "LINENO" "OLDPWD" "PPID" "PS3" "PS4" "PWD" "RANDOM" "REPLY" "SECONDS" "TMOUT") (oash eval sh-append sh "FIELD" "FIELD_MAX" "LAST_KEY" "OALIB" "PP_ITEM" "PP_NUM") (rc eval sh-append shell "apid" "apids" "cdpath" "CDPATH" "history" "home" "ifs" "path" "pid" "prompt" "status") (sh eval sh-append shell "CDPATH" "IFS" "OPTARG" "OPTIND" "PS1" "PS2") ;; The next entry is only used for defining the others (shell "COLUMNS" "EDITOR" "HOME" "HUSHLOGIN" "LANG" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES" "LC_MONETARY" "LC_NUMERIC" "LC_TIME" "LINES" "LOGNAME" "MAIL" "MAILCHECK" "MAILPATH" "PAGER" "PATH" "SHELL" "TERM" "TERMCAP" "TERMINFO" "VISUAL") (tcsh eval sh-append csh "addsuffix" "ampm" "autocorrect" "autoexpand" "autolist" "autologout" "chase_symlinks" "correct" "dextract" "edit" "el" "fignore" "gid" "histlit" "HOST" "HOSTTYPE" "HPATH" "ignore_symlinks" "listjobs" "listlinks" "listmax" "matchbeep" "nobeep" "NOREBIND" "oid" "printexitvalue" "prompt2" "prompt3" "pushdsilent" "pushdtohome" "recexact" "recognize_only_executables" "rmstar" "savehist" "SHLVL" "showdots" "sl" "SYSTYPE" "tcsh" "term" "tperiod" "tty" "uid" "version" "visiblebell" "watch" "who" "wordchars") (zsh eval sh-append ksh88 "BAUD" "bindcmds" "cdpath" "DIRSTACKSIZE" "fignore" "FIGNORE" "fpath" "HISTCHARS" "hostcmds" "hosts" "HOSTS" "LISTMAX" "LITHISTSIZE" "LOGCHECK" "mailpath" "manpath" "NULLCMD" "optcmds" "path" "POSTEDIT" "prompt" "PROMPT" "PROMPT2" "PROMPT3" "PROMPT4" "psvar" "PSVAR" "READNULLCMD" "REPORTTIME" "RPROMPT" "RPS1" "SAVEHIST" "SPROMPT" "STTY" "TIMEFMT" "TMOUT" "TMPPREFIX" "varcmds" "watch" "WATCH" "WATCHFMT" "WORDCHARS" "ZDOTDIR")) "List of all shell variables available for completing read. See `sh-feature'.") (defvar sh-font-lock-keywords '((csh eval sh-append shell '("\\${?[#?]?\\([A-Za-z_][A-Za-z0-9_]*\\|0\\)" 1 font-lock-variable-name-face)) (es eval sh-append executable-font-lock-keywords '("\\$#?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\)" 1 font-lock-variable-name-face)) (rc eval identity es) (sh eval sh-append shell '("\\$\\({#?\\)?\\([A-Za-z_][A-Za-z0-9_]*\\|[-#?@!]\\)" 2 font-lock-variable-name-face)) ;; The next entry is only used for defining the others (shell eval sh-append executable-font-lock-keywords '("\\\\." 0 font-lock-string-face) '("\\${?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\|[$*_]\\)" 1 font-lock-variable-name-face))) "*Rules for highlighting shell scripts. See `sh-feature'.") (defvar sh-font-lock-keywords-1 '((sh "[ \t]in[ \t]")) "*Additional rules for highlighting shell scripts. See `sh-feature'.") (defvar sh-font-lock-keywords-2 () "*Yet more rules for highlighting shell scripts. See `sh-feature'.") ;; mode-command and utility functions ;;;###autoload (defun sh-mode () "Major mode for editing shell scripts. This mode works for many shells, since they all have roughly the same syntax, as far as commands, arguments, variables, pipes, comments etc. are concerned. Unless the file's magic number indicates the shell, your usual shell is assumed. Since filenames rarely give a clue, they are not further analyzed. This mode adapts to the variations between shells (see `sh-set-shell') by means of an inheritance based feature lookup (see `sh-feature'). This mechanism applies to all variables (including skeletons) that pertain to shell-specific features. The default style of this mode is that of Rosenblatt's Korn shell book. The syntax of the statements varies with the shell being used. The following commands are available, based on the current shell's syntax: \\[sh-case] case statement \\[sh-for] for loop \\[sh-function] function definition \\[sh-if] if statement \\[sh-indexed-loop] indexed loop from 1 to n \\[sh-while-getopts] while getopts loop \\[sh-repeat] repeat loop \\[sh-select] select loop \\[sh-until] until loop \\[sh-while] while loop \\[backward-delete-char-untabify] Delete backward one position, even if it was a tab. \\[sh-newline-and-indent] Delete unquoted space and indent new line same as this one. \\[sh-end-of-command] Go to end of successive commands. \\[sh-beginning-of-command] Go to beginning of successive commands. \\[sh-set-shell] Set this buffer's shell, and maybe its magic number. \\[sh-execute-region] Have optional header and region be executed in a subshell. \\[sh-maybe-here-document] Without prefix, following an unquoted < inserts here document. {, (, [, ', \", ` Unless quoted with \\, insert the pairs {}, (), [], or '', \"\", ``. If you generally program a shell different from your login shell you can set `sh-shell-path' accordingly. If your shell's file name doesn't correctly indicate what shell it is use `sh-alias-alist' to translate. If your shell gives error messages with line numbers, you can use \\[executable-interpret] with your script for an edit-interpret-debug cycle." (interactive) (kill-all-local-variables) (use-local-map sh-mode-map) (make-local-variable 'indent-line-function) (make-local-variable 'indent-region-function) (make-local-variable 'skeleton-end-hook) (make-local-variable 'paragraph-start) (make-local-variable 'paragraph-separate) (make-local-variable 'comment-start) (make-local-variable 'comment-start-skip) (make-local-variable 'require-final-newline) (make-local-variable 'sh-header-marker) (make-local-variable 'sh-shell-path) (make-local-variable 'sh-shell) (make-local-variable 'skeleton-pair-alist) (make-local-variable 'skeleton-pair-filter) (make-local-variable 'comint-dynamic-complete-functions) (make-local-variable 'comint-prompt-regexp) (make-local-variable 'font-lock-keywords) (make-local-variable 'font-lock-defaults) (make-local-variable 'skeleton-filter) (make-local-variable 'skeleton-newline-indent-rigidly) (make-local-variable 'process-environment) (setq major-mode 'sh-mode mode-name "Shell-script" indent-line-function 'sh-indent-line ;; not very clever, but enables wrapping skeletons around regions indent-region-function (lambda (b e) (save-excursion (goto-char b) (skip-syntax-backward "-") (setq b (point)) (goto-char e) (skip-syntax-backward "-") (indent-rigidly b (point) sh-indentation))) skeleton-end-hook (lambda () (or (eolp) (newline) (indent-relative))) paragraph-start (concat page-delimiter "\\|$") paragraph-separate paragraph-start comment-start "# " comint-dynamic-complete-functions sh-dynamic-complete-functions ;; we can't look if previous line ended with `\' comint-prompt-regexp "^[ \t]*" font-lock-defaults '((sh-font-lock-keywords sh-font-lock-keywords-1 sh-font-lock-keywords-2) nil nil ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w"))) skeleton-pair-alist '((?` _ ?`)) skeleton-pair-filter 'sh-quoted-p skeleton-further-elements '((< '(- (min sh-indentation (current-column))))) skeleton-filter 'sh-feature skeleton-newline-indent-rigidly t) ;; parse or insert magic number for exec() and set all variables depending ;; on the shell thus determined (goto-char (point-min)) (sh-set-shell (if (looking-at "#![\t ]*\\([^\t\n ]+\\)") (match-string 1) sh-shell-path)) (run-hooks 'sh-mode-hook)) ;;;###autoload (defalias 'shell-script-mode 'sh-mode) (defun sh-font-lock-keywords (&optional keywords) "Function to get simple fontification based on `sh-font-lock-keywords'. This adds rules for comments and assignments." (sh-feature sh-font-lock-keywords (lambda (list) `((,(concat (sh-feature sh-comment-prefix) "\\(#.*\\)") 2 font-lock-comment-face t) (,(sh-feature sh-assignment-regexp) 1 font-lock-variable-name-face) ,@keywords ,@list)))) (defun sh-font-lock-keywords-1 (&optional builtins) "Function to get better fontification including keywords." (let ((keywords (concat "\\([;(){}`|&]\\|^\\)[ \t]*\\(\\(\\(" (mapconcat 'identity (sh-feature sh-leading-keywords) "\\|") "\\)[ \t]+\\)?\\(" (mapconcat 'identity (append (sh-feature sh-leading-keywords) (sh-feature sh-other-keywords)) "\\|") "\\)"))) (sh-font-lock-keywords `(,@(if builtins `((,(concat keywords "[ \t]+\\)?\\(" (mapconcat 'identity (sh-feature sh-builtins) "\\|") "\\)\\>") (2 font-lock-keyword-face nil t) (6 font-lock-function-name-face)) ,@(sh-feature sh-font-lock-keywords-2))) (,(concat keywords "\\)\\>") 2 font-lock-keyword-face) ,@(sh-feature sh-font-lock-keywords-1))))) (defun sh-font-lock-keywords-2 () "Function to get better fontification including keywords and builtins." (sh-font-lock-keywords-1 t)) (defun sh-set-shell (shell) "Set this buffer's shell to SHELL (a string). Makes this script executable via `executable-set-magic'. Calls the value of `sh-set-shell-hook' if set." (interactive (list (completing-read "Name or path of shell: " interpreter-mode-alist (lambda (x) (eq (cdr x) 'sh-mode))))) (if (eq this-command 'sh-set-shell) ;; prevent querying (setq this-command 'executable-set-magic)) (setq sh-shell (intern (file-name-nondirectory shell)) sh-shell (or (cdr (assq sh-shell sh-alias-alist)) sh-shell) sh-shell-path (executable-set-magic shell (sh-feature sh-shell-arg)) local-abbrev-table (sh-feature sh-abbrevs) require-final-newline (sh-feature sh-require-final-newline) font-lock-keywords nil ; force resetting comment-start-skip (concat (sh-feature sh-comment-prefix) "#+[\t ]*") mode-line-process (format "[%s]" sh-shell) process-environment (default-value 'process-environment) shell (sh-feature sh-variables)) (set-syntax-table (sh-feature sh-mode-syntax-table)) (setq font-lock-syntax-table) (save-excursion (while (search-forward "=" nil t) (sh-assignment 0))) (while shell (sh-remember-variable (car shell)) (setq shell (cdr shell))) (and (boundp 'font-lock-mode) font-lock-mode (font-lock-mode (font-lock-mode 0))) (run-hooks 'sh-set-shell-hook)) (defun sh-feature (list &optional function) "Index ALIST by the current shell. If ALIST isn't a list where every element is a cons, it is returned as is. Else indexing follows an inheritance logic which works in two ways: - Fall back on successive ancestors (see `sh-ancestor-alist') as long as the alist contains no value for the current shell. - If the value thus looked up is a list starting with `eval' its `cdr' is first evaluated. If that is also a list and the first argument is a symbol in ALIST it is not evaluated, but rather recursively looked up in ALIST to allow the function called to define the value for one shell to be derived from another shell. While calling the function, is the car of the alist element is the current shell. The value thus determined is physically replaced into the alist. Optional FUNCTION is applied to the determined value and the result is cached in ALIST." (or (if (consp list) (let ((l list)) (while (and l (consp (car l))) (setq l (cdr l))) (if l list))) (if function (cdr (assoc (setq function (cons sh-shell function)) list))) (let ((sh-shell sh-shell) elt val) (while (and sh-shell (not (setq elt (assq sh-shell list)))) (setq sh-shell (cdr (assq sh-shell sh-ancestor-alist)))) (if (and (consp (setq val (cdr elt))) (eq (car val) 'eval)) (setcdr elt (setq val (eval (if (consp (setq val (cdr val))) (let ((sh-shell (car (cdr val))) function) (if (assq sh-shell list) (setcar (cdr val) (list 'quote (sh-feature list)))) val) val))))) (if function (nconc list (list (cons function (setq sh-shell (car function) val (funcall (cdr function) val)))))) val))) (defun sh-abbrevs (ancestor &rest list) "Iff it isn't, define the current shell as abbrev table and fill that. Abbrev table will inherit all abbrevs from ANCESTOR, which is either an abbrev table or a list of (NAME1 EXPANSION1 ...). In addition it will define abbrevs according to the remaining arguments NAMEi EXPANSIONi ... EXPANSION may be either a string or a skeleton command." (or (if (boundp sh-shell) (symbol-value sh-shell)) (progn (if (listp ancestor) (nconc list ancestor)) (define-abbrev-table sh-shell ()) (if (vectorp ancestor) (mapatoms (lambda (atom) (or (eq atom 0) (define-abbrev (symbol-value sh-shell) (symbol-name atom) (symbol-value atom) (symbol-function atom)))) ancestor)) (while list (define-abbrev (symbol-value sh-shell) (car list) (if (stringp (car (cdr list))) (car (cdr list)) "") (if (symbolp (car (cdr list))) (car (cdr list)))) (setq list (cdr (cdr list))))) (symbol-value sh-shell))) (defun sh-mode-syntax-table (table &rest list) "Copy TABLE and set syntax for succesive CHARs according to strings S." (setq table (copy-syntax-table table)) (while list (modify-syntax-entry (car list) (car (cdr list)) table) (setq list (cdr (cdr list)))) table) (defun sh-append (ancestor &rest list) "Return list composed of first argument (a list) physically appended to rest." (nconc list ancestor)) (defun sh-modify (skeleton &rest list) "Modify a copy of SKELETON by replacing I1 with REPL1, I2 with REPL2 ..." (setq skeleton (copy-sequence skeleton)) (while list (setcar (or (nthcdr (car list) skeleton) (error "Index %d out of bounds" (car list))) (car (cdr list))) (setq list (nthcdr 2 list))) skeleton) (defun sh-indent-line () "Indent as far as preceding non-empty line, then by steps of `sh-indentation'. Lines containing only comments are considered empty." (interactive) (let ((previous (save-excursion (while (progn (line-move -1) (back-to-indentation) (or (eolp) (eq (following-char) ?#)))) (current-column))) current) (save-excursion (indent-to (if (eq this-command 'newline-and-indent) previous (if (< (current-column) (setq current (progn (back-to-indentation) (current-column)))) (if (eolp) previous 0) (delete-region (point) (progn (beginning-of-line) (point))) (if (eolp) (max previous (* (1+ (/ current sh-indentation)) sh-indentation)) (* (1+ (/ current sh-indentation)) sh-indentation)))))) (if (< (current-column) (current-indentation)) (skip-chars-forward " \t")))) (defun sh-execute-region (start end &optional flag) "Pass optional header and region to a subshell for noninteractive execution. The working directory is that of the buffer, and only environment variables are already set which is why you can mark a header within the script. With a positive prefix ARG, instead of sending region, define header from beginning of buffer to point. With a negative prefix ARG, instead of sending region, clear header." (interactive "r\nP") (if flag (setq sh-header-marker (if (> (prefix-numeric-value flag) 0) (point-marker))) (if sh-header-marker (save-excursion (let (buffer-undo-list) (goto-char sh-header-marker) (append-to-buffer (current-buffer) start end) (shell-command-on-region (point-min) (setq end (+ sh-header-marker (- end start))) sh-shell-path) (delete-region sh-header-marker end))) (shell-command-on-region start end (concat sh-shell-path " -"))))) (defun sh-remember-variable (var) "Make VARIABLE available for future completing reads in this buffer." (or (< (length var) sh-remember-variable-min) (getenv var) (setq process-environment (cons (concat var "=") process-environment))) var) (defun sh-quoted-p () "Is point preceded by an odd number of backslashes?" (eq -1 (% (save-excursion (skip-chars-backward "\\\\")) 2))) ;; statement syntax-commands for various shells ;; You are welcome to add the syntax or even completely new statements as ;; appropriate for your favorite shell. (define-skeleton sh-case "Insert a case/switch statement. See `sh-feature'." (csh "expression: " "switch( " str " )" \n > "case " (read-string "pattern: ") ?: \n > _ \n "breaksw" \n ( "other pattern, %s: " < "case " str ?: \n > _ \n "breaksw" \n) < "default:" \n > _ \n resume: < < "endsw") (es) (rc "expression: " "switch( " str " ) {" \n > "case " (read-string "pattern: ") \n > _ \n ( "other pattern, %s: " < "case " str \n > _ \n) < "case *" \n > _ \n resume: < < ?}) (sh "expression: " "case " str " in" \n > (read-string "pattern: ") ?\) \n > _ \n ";;" \n ( "other pattern, %s: " < str ?\) \n > _ \n ";;" \n) < "*)" \n > _ \n resume: < < "esac")) (put 'sh-case 'menu-enable '(sh-feature sh-case)) (define-skeleton sh-for "Insert a for loop. See `sh-feature'." (csh eval sh-modify sh 1 "foreach " 3 " ( " 5 " )" 15 "end") (es eval sh-modify rc 3 " = ") (rc eval sh-modify sh 1 "for( " 5 " ) {" 15 ?}) (sh "Index variable: " "for " str " in " _ "; do" \n > _ | ?$ & (sh-remember-variable str) \n < "done")) (define-skeleton sh-indexed-loop "Insert an indexed loop from 1 to n. See `sh-feature'." (bash eval identity posix) (csh "Index variable: " "@ " str " = 1" \n "while( $" str " <= " (read-string "upper limit: ") " )" \n > _ ?$ str \n "@ " str "++" \n < "end") (es eval sh-modify rc 3 " =") (ksh88 "Index variable: " "integer " str "=0" \n "while (( ( " str " += 1 ) <= " (read-string "upper limit: ") " )); do" \n > _ ?$ (sh-remember-variable str) \n < "done") (posix "Index variable: " str "=1" \n "while [ $" str " -le " (read-string "upper limit: ") " ]; do" \n > _ ?$ str \n str ?= (sh-add (sh-remember-variable str) 1) \n < "done") (rc "Index variable: " "for( " str " in" " `{awk 'BEGIN { for( i=1; i<=" (read-string "upper limit: ") "; i++ ) print i }'}) {" \n > _ ?$ (sh-remember-variable str) \n < ?}) (sh "Index variable: " "for " str " in `awk 'BEGIN { for( i=1; i<=" (read-string "upper limit: ") "; i++ ) print i }'`; do" \n > _ ?$ (sh-remember-variable str) \n < "done")) (defun sh-add (var delta) "Insert an addition of VAR and prefix DELTA for Bourne (type) shell." (interactive (list (completing-read "Variable: " (mapcar (lambda (var) (substring var 0 (string-match "=" var))) process-environment)) (prefix-numeric-value current-prefix-arg))) (insert (sh-feature '((bash . "$[ ") (ksh88 . "$(( ") (posix . "$(( ") (rc . "`{expr $") (sh . "`expr $") (zsh . "$[ "))) (sh-remember-variable var) (if (< delta 0) " - " " + ") (number-to-string (abs delta)) (sh-feature '((bash . " ]") (ksh88 . " ))") (posix . " ))") (rc . "}") (sh . "`") (zsh . " ]"))))) (define-skeleton sh-function "Insert a function definition. See `sh-feature'." (bash eval sh-modify ksh88 3 "() {") (ksh88 "name: " "function " str " {" \n > _ \n < "}") (rc eval sh-modify ksh88 1 "fn ") (sh () "() {" \n > _ \n < "}")) (define-skeleton sh-if "Insert an if statement. See `sh-feature'." (csh "condition: " "if( " str " ) then" \n > _ \n ( "other condition, %s: " < "else if( " str " ) then" \n > _ \n) < "else" \n > _ \n resume: < "endif") (es "condition: " "if { " str " } {" \n > _ \n ( "other condition, %s: " < "} { " str " } {" \n > _ \n) < "} {" \n > _ \n resume: < ?}) (rc eval sh-modify csh 3 " ) {" 8 '( "other condition, %s: " < "} else if( " str " ) {" \n > _ \n) 10 "} else {" 17 ?}) (sh "condition: " '(setq input (sh-feature sh-test)) "if " str "; then" \n > _ \n ( "other condition, %s: " < "elif " str "; then" \n > _ \n) < "else" \n > _ \n resume: < "fi")) (define-skeleton sh-repeat "Insert a repeat loop definition. See `sh-feature'." (es nil "forever {" \n > _ \n < ?}) (zsh "factor: " "repeat " str "; do"\n > _ \n < "done")) (put 'sh-repeat 'menu-enable '(sh-feature sh-repeat)) (define-skeleton sh-select "Insert a select statement. See `sh-feature'." (ksh88 "Index variable: " "select " str " in " _ "; do" \n > ?$ str \n < "done")) (put 'sh-select 'menu-enable '(sh-feature sh-select)) (define-skeleton sh-tmp-file "Insert code to setup temporary file handling. See `sh-feature'." (bash eval identity ksh88) (csh (file-name-nondirectory (buffer-file-name)) "set tmp = /tmp/" str ".$$" \n "onintr exit" \n _ (and (goto-char (point-max)) (not (bolp)) ?\n) "exit:\n" "rm $tmp* >&/dev/null" >) (es (file-name-nondirectory (buffer-file-name)) "local( signals = $signals sighup sigint; tmp = /tmp/" str ".$pid ) {" \n > "catch @ e {" \n > "rm $tmp^* >[2]/dev/null" \n "throw $e" \n < "} {" \n > _ \n < ?} \n < ?}) (ksh88 eval sh-modify sh 6 "EXIT") (rc (file-name-nondirectory (buffer-file-name)) "tmp = /tmp/" str ".$pid" \n "fn sigexit { rm $tmp^* >[2]/dev/null }") (sh (file-name-nondirectory (buffer-file-name)) "TMP=/tmp/" str ".$$" \n "trap \"rm $TMP* 2>/dev/null\" " ?0)) (define-skeleton sh-until "Insert an until loop. See `sh-feature'." (sh "condition: " '(setq input (sh-feature sh-test)) "until " str "; do" \n > _ \n < "done")) (put 'sh-until 'menu-enable '(sh-feature sh-until)) (define-skeleton sh-while "Insert a while loop. See `sh-feature'." (csh eval sh-modify sh 2 "while( " 4 " )" 10 "end") (es eval sh-modify rc 2 "while { " 4 " } {") (rc eval sh-modify csh 4 " ) {" 10 ?}) (sh "condition: " '(setq input (sh-feature sh-test)) "while " str "; do" \n > _ \n < "done")) (define-skeleton sh-while-getopts "Insert a while getopts loop. See `sh-feature'. Prompts for an options string which consists of letters for each recognized option followed by a colon `:' if the option accepts an argument." (bash eval sh-modify sh 18 "${0##*/}") (csh nil "while( 1 )" \n > "switch( \"$1\" )" \n '(setq input '("- x" . 2)) > > ( "option, %s: " < "case " '(eval str) '(if (string-match " +" str) (setq v1 (substring str (match-end 0)) str (substring str 0 (match-beginning 0))) (setq v1 nil)) str ?: \n > "set " v1 & " = $2" | -4 & _ \n (if v1 "shift") & \n "breaksw" \n) < "case --:" \n > "shift" \n < "default:" \n > "break" \n resume: < < "endsw" \n "shift" \n < "end") (ksh88 eval sh-modify sh 16 "print" 18 "${0##*/}" 36 "OPTIND-1") (posix eval sh-modify sh 18 "$(basename $0)") (sh "optstring: " "while getopts :" str " OPT; do" \n > "case $OPT in" \n > > '(setq v1 (append (vconcat str) nil)) ( (prog1 (if v1 (char-to-string (car v1))) (if (eq (nth 1 v1) ?:) (setq v1 (nthcdr 2 v1) v2 "\"$OPTARG\"") (setq v1 (cdr v1) v2 nil))) < str "|+" str ?\) \n > _ v2 \n ";;" \n) < "*)" \n > "echo" " \"usage: " "`basename $0`" "[ +-" '(setq v1 (point)) str '(save-excursion (while (search-backward ":" v1 t) (replace-match " arg][ +-" t t))) (if (eq (preceding-char) ?-) -5) "][ --] args\"" \n "exit 2" \n < < "esac" \n < "done" \n "shift " (sh-add "OPTIND" -1))) (put 'sh-while-getopts 'menu-enable '(sh-feature sh-while-getopts)) (defun sh-assignment (arg) "Remember preceding identifier for future completion and do self-insert." (interactive "p") (self-insert-command arg) (if (<= arg 1) (sh-remember-variable (save-excursion (if (re-search-forward (sh-feature sh-assignment-regexp) (prog1 (point) (beginning-of-line 1)) t) (match-string 1)))))) (defun sh-maybe-here-document (arg) "Inserts self. Without prefix, following unquoted `<' inserts here document. The document is bounded by `sh-here-document-word'." (interactive "*P") (self-insert-command (prefix-numeric-value arg)) (or arg (not (eq (char-after (- (point) 2)) last-command-char)) (save-excursion (backward-char 2) (sh-quoted-p)) (progn (insert sh-here-document-word) (or (eolp) (looking-at "[ \t]") (insert ? )) (end-of-line 1) (while (sh-quoted-p) (end-of-line 2)) (newline) (save-excursion (insert ?\n sh-here-document-word))))) ;; various other commands (autoload 'comint-dynamic-complete "comint" "Dynamically perform completion at point." t) (autoload 'shell-dynamic-complete-command "shell" "Dynamically complete the command at point." t) (autoload 'comint-dynamic-complete-filename "comint" "Dynamically complete the filename at point." t) (autoload 'shell-dynamic-complete-environment-variable "shell" "Dynamically complete the environment variable at point." t) (defun sh-newline-and-indent () "Strip unquoted whitespace, insert newline, and indent like current line." (interactive "*") (indent-to (prog1 (current-indentation) (delete-region (point) (progn (or (zerop (skip-chars-backward " \t")) (if (sh-quoted-p) (forward-char))) (point))) (newline)))) (defun sh-beginning-of-command () "Move point to successive beginnings of commands." (interactive) (if (re-search-backward sh-beginning-of-command nil t) (goto-char (match-beginning 2)))) (defun sh-end-of-command () "Move point to successive ends of commands." (interactive) (if (re-search-forward sh-end-of-command nil t) (goto-char (match-end 1)))) ;; sh-script.el ends here emacs-19.30/lisp/shadowfile.el100444 12120 1 75257 6045205010 14546 0ustar rmsdaemon;;; shadowfile.el --- automatic file copying for Emacs 19 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: Boris Goldowsky ;; Keywords: comm ;; 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. ;;; LCD Archive Entry: ;;; shadowfile|Boris Goldowsky|boris@gnu.ai.mit.edu| ;;; Helps you keep identical copies of files in multiple places.| ;;; $Date: 1995/10/30 17:23:17 $ |$Revision: 1.6 $|~/misc/shadowfile.el.Z| ;;; Commentary: ;;; ;;; This package helps you to keep identical copies of files in more than one ;;; place - possibly on different machines. When you save a file, it checks ;;; whether it is on the list of files with "shadows", and if so, it tries to ;;; copy it when you exit emacs (or use the shadow-copy-files command). ;;; Installation & Use: ;;; ;;; Put (require 'shadowfile) in your .emacs; add clusters (if necessary) ;;; and file groups with shadow-define-cluster, shadow-define-literal-group, ;;; and shadow-define-regexp-group (see the documentation for these functions ;;; for information on how and when to use them). After doing this once, ;;; everything should be automatic. ;;; The lists of clusters and shadows are saved in a file called ;;; .shadows, so that they can be remembered from one emacs session to ;;; another, even (as much as possible) if the emacs session terminates ;;; abnormally. The files needing to be copied are stored in .shadow_todo; if ;;; a file cannot be copied for any reason, it will stay on the list to be ;;; tried again next time. The .shadows file should itself have shadows on ;;; all your accounts so that the information in it is consistent everywhere, ;;; but .shadow_todo is local information and should have no shadows. ;;; If you do not want to copy a particular file, you can answer "no" ;;; and be asked again next time you hit C-x 4 s or exit emacs. If you do not ;;; want to be asked again, use shadow-cancel, and you will not be asked until ;;; you change the file and save it again. If you do not want to shadow ;;; that file ever again, you can edit it out of the .shadows buffer. ;;; Anytime you edit the .shadows buffer, you must type M-x shadow-read-files ;;; to load in the new information, or your changes will be overwritten! ;;; Bugs & Warnings: ;;; ;;; - It is bad to have two emacses both running shadowfile at the same ;;; time. It tries to detect this condition, but is not always successful. ;;; ;;; - You have to be careful not to edit a file in two locations ;;; before shadowfile has had a chance to copy it; otherwise ;;; "updating shadows" will overwrite one of the changed versions. ;;; ;;; - It ought to check modification times of both files to make sure ;;; it is doing the right thing. This will have to wait until ;;; file-newer-than-file-p works between machines. ;;; ;;; - It will not make directories for you, it just fails to copy files ;;; that belong in non-existent directories. ;;; ;;; Please report any bugs to me (boris@gnu.ai.mit.edu). Also let me know ;;; if you have suggestions or would like to be informed of updates. ;;; Code: (provide 'shadowfile) (require 'ange-ftp) (setq find-file-visit-truename t) ; makes life easier with symbolic links ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar shadow-noquery nil "*If t, always copy shadow files without asking. If nil \(the default), always ask. If not nil and not t, ask only if there is no buffer currently visiting the file.") (defvar shadow-inhibit-message nil "*If nonnil, do not display a message when a file needs copying.") (defvar shadow-inhibit-overload nil "If nonnil, shadowfile won't redefine C-x C-c. Normally it overloads the function `save-buffers-kill-emacs' to check for files have been changed and need to be copied to other systems.") (defvar shadow-info-file nil "File to keep shadow information in. The shadow-info-file should be shadowed to all your accounts to ensure consistency. Default: ~/.shadows") (defvar shadow-todo-file nil "File to store the list of uncopied shadows in. This means that if a remote system is down, or for any reason you cannot or decide not to copy your shadow files at the end of one emacs session, it will remember and ask you again in your next emacs session. This file must NOT be shadowed to any other system, it is host-specific. Default: ~/.shadow_todo") ;;; The following two variables should in most cases initialize themselves ;;; correctly. They are provided as variables in case the defaults are wrong ;;; on your machine \(and for efficiency). (defvar shadow-system-name (system-name) "The complete hostname of this machine.") (defvar shadow-homedir nil "Your home directory on this machine.") ;;; ;;; Internal variables whose values are stored in the info and todo files: ;;; (defvar shadow-clusters nil "List of host clusters \(see shadow-define-cluster).") (defvar shadow-literal-groups nil "List of files that are shared between hosts. This list contains shadow structures with literal filenames, created by shadow-define-group.") (defvar shadow-regexp-groups nil "List of file types that are shared between hosts. This list contains shadow structures with regexps matching filenames, created by shadow-define-regexp-group.") ;;; ;;; Other internal variables: ;;; (defvar shadow-files-to-copy nil) ; List of files that need to ; be copied to remote hosts. (defvar shadow-hashtable nil) ; for speed (defvar shadow-info-buffer nil) ; buf visiting shadow-info-file (defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Syntactic sugar; General list and string manipulation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmacro shadow-when (condition &rest body) ;; From cl.el "(shadow-when CONDITION . BODY) => evaluate BODY if CONDITION is true." (` (if (not (, condition)) () (,@ body)))) (defun shadow-union (a b) "Add members of list A to list B if they are not equal to items already in B." (if (null a) b (if (member (car a) b) (shadow-union (cdr a) b) (shadow-union (cdr a) (cons (car a) b))))) (defun shadow-find (func list) "If FUNC applied to some element of LIST is nonnil, return the first such element." (while (and list (not (funcall func (car list)))) (setq list (cdr list))) (car list)) (defun shadow-remove-if (func list) "Remove elements satisfying FUNC from LIST. Nondestructive; actually returns a copy of the list with the elements removed." (if list (if (funcall func (car list)) (shadow-remove-if func (cdr list)) (cons (car list) (shadow-remove-if func (cdr list)))) nil)) (defun shadow-join (strings sep) "Concatenate elements of the list of STRINGS with SEP between each." (cond ((null strings) "") ((null (cdr strings)) (car strings)) ((concat (car strings) " " (shadow-join (cdr strings) sep))))) (defun shadow-regexp-superquote (string) "Like regexp-quote, but includes the ^ and $ to make sure regexp matches nothing but STRING." (concat "^" (regexp-quote string) "$")) (defun shadow-suffix (prefix string) "If PREFIX begins STRING, return the rest. Return value is nonnil if PREFIX and STRING are string= up to the length of PREFIX." (let ((lp (length prefix)) (ls (length string))) (if (and (>= ls lp) (string= prefix (substring string 0 lp))) (substring string lp)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Clusters and sites ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; I use the term `site' to refer to a string which may be the name of a ;;; cluster or a literal hostname. All user-level commands should accept ;;; either. (defun shadow-make-cluster (name primary regexp) "Creates a shadow cluster called NAME, using the PRIMARY hostname, REGEXP matching all hosts in the cluster. The variable shadow-clusters associates the names of clusters to these structures. This function is for program use: to create clusters interactively, use shadow-define-cluster instead." (list name primary regexp)) (defmacro shadow-cluster-name (cluster) "Return the name of the CLUSTER." (list 'elt cluster 0)) (defmacro shadow-cluster-primary (cluster) "Return the primary hostname of a CLUSTER." (list 'elt cluster 1)) (defmacro shadow-cluster-regexp (cluster) "Return the regexp matching hosts in a CLUSTER." (list 'elt cluster 2)) (defun shadow-set-cluster (name primary regexp) "Put cluster NAME on the list of clusters, replacing old definition if any. PRIMARY and REGEXP are the information defining the cluster. For interactive use, call shadow-define-cluster instead." (let ((rest (shadow-remove-if (function (lambda (x) (equal name (car x)))) shadow-clusters))) (setq shadow-clusters (cons (shadow-make-cluster name primary regexp) rest)))) (defmacro shadow-get-cluster (name) "Return cluster named NAME, or nil." (list 'assoc name 'shadow-clusters)) (defun shadow-site-primary (site) "If SITE is a cluster, return primary host, otherwise return SITE." (let ((c (shadow-get-cluster site))) (if c (shadow-cluster-primary c) site))) ;;; SITES (defun shadow-site-cluster (site) "Given a SITE \(hostname or cluster name), return the cluster that it is in, or nil." (or (assoc site shadow-clusters) (shadow-find (function (lambda (x) (string-match (shadow-cluster-regexp x) site))) shadow-clusters))) (defun shadow-read-site () "Read a cluster name or hostname from the minibuffer." (let ((ans (completing-read "Host or cluster name [RET when done]: " shadow-clusters))) (if (equal "" ans) nil ans))) (defun shadow-site-match (site1 site2) "Nonnil iff SITE1 is or includes SITE2. Each may be a host or cluster name; if they are clusters, regexp of site1 will be matched against the primary of site2." (or (string-equal site1 site2) ; quick check (let* ((cluster1 (shadow-get-cluster site1)) (primary2 (shadow-site-primary site2))) (if cluster1 (string-match (shadow-cluster-regexp cluster1) primary2) (string-equal site1 primary2))))) (defun shadow-get-user (site) "Returns the default username for a site." (ange-ftp-get-user (shadow-site-primary site))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Filename manipulation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun shadow-parse-fullpath (fullpath) "Parse PATH into \(site user path) list, or leave it alone if it already is one. Returns nil if the argument is not a full ange-ftp pathname." (if (listp fullpath) fullpath (ange-ftp-ftp-name fullpath))) (defun shadow-parse-path (path) "Parse any PATH into \(site user path) list. Argument can be a simple path, full ange-ftp path, or already a hup list." (or (shadow-parse-fullpath path) (list shadow-system-name (user-login-name) path))) (defsubst shadow-make-fullpath (host user path) "Make an ange-ftp style fullpath out of HOST, USER (optional), and PATH. This is probably not as general as it ought to be." (concat "/" (if user (concat user "@")) host ":" path)) (defun shadow-replace-path-component (fullpath newpath) "Return FULLPATH with the pathname component changed to NEWPATH." (let ((hup (shadow-parse-fullpath fullpath))) (shadow-make-fullpath (nth 0 hup) (nth 1 hup) newpath))) (defun shadow-local-file (file) "If FILENAME is at this site, remove /user@host part. If refers to a different system or a different user on this system, return nil." (let ((hup (shadow-parse-fullpath file))) (cond ((null hup) file) ((and (shadow-site-match (nth 0 hup) shadow-system-name) (string-equal (nth 1 hup) (user-login-name))) (nth 2 hup)) (t nil)))) (defun shadow-expand-cluster-in-file-name (file) "If hostname part of FILE is a cluster, expand it into the cluster's primary hostname. Will return the pathname bare if it is a local file." (let ((hup (shadow-parse-path file)) cluster) (cond ((null hup) file) ((shadow-local-file hup)) ((shadow-make-fullpath (shadow-site-primary (nth 0 hup)) (nth 1 hup) (nth 2 hup)))))) (defun shadow-expand-file-name (file &optional default) "Expand file name and get file's true name." (file-truename (expand-file-name file default))) (defun shadow-contract-file-name (file) "Simplify FILENAME by replacing (when possible) home directory with ~, and hostname with cluster name that includes it. Filename should be absolute and true." (let* ((hup (shadow-parse-path file)) (homedir (if (shadow-local-file hup) shadow-homedir (file-name-as-directory (nth 2 (shadow-parse-fullpath (expand-file-name (shadow-make-fullpath (nth 0 hup) (nth 1 hup) "~"))))))) (suffix (shadow-suffix homedir (nth 2 hup))) (cluster (shadow-site-cluster (nth 0 hup)))) (shadow-make-fullpath (if cluster (shadow-cluster-name cluster) (nth 0 hup)) (nth 1 hup) (if suffix (concat "~/" suffix) (nth 2 hup))))) (defun shadow-same-site (pattern file) "True if the site of PATTERN and of FILE are on the same site. If usernames are supplied, they must also match exactly. PATTERN and FILE may be lists of host, user, path, or ange-ftp pathnames. FILE may also be just a local filename." (let ((pattern-sup (shadow-parse-fullpath pattern)) (file-sup (shadow-parse-path file))) (and (shadow-site-match (nth 0 pattern-sup) (nth 0 file-sup)) (or (null (nth 1 pattern-sup)) (string-equal (nth 1 pattern-sup) (nth 1 file-sup)))))) (defun shadow-file-match (pattern file &optional regexp) "Returns t if PATTERN matches FILE. If REGEXP is supplied and nonnil, the pathname part of the pattern is a regular expression, otherwise it must match exactly. The sites and usernames must match---see shadow-same-site. The pattern must be in full ange-ftp format, but the file can be any valid filename. This function does not do any filename expansion or contraction, you must do that yourself first." (let* ((pattern-sup (shadow-parse-fullpath pattern)) (file-sup (shadow-parse-path file))) (and (shadow-same-site pattern-sup file-sup) (if regexp (string-match (nth 2 pattern-sup) (nth 2 file-sup)) (string-equal (nth 2 pattern-sup) (nth 2 file-sup)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; User-level Commands ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun shadow-define-cluster (name) "Edit \(or create) the definition of a cluster. This is a group of hosts that share directories, so that copying to or from one of them is sufficient to update the file on all of them. Clusters are defined by a name, the network address of a primary host \(the one we copy files to), and a regular expression that matches the hostnames of all the sites in the cluster." (interactive (list (completing-read "Cluster name: " shadow-clusters () ()))) (let* ((old (shadow-get-cluster name)) (primary (read-string "Primary host: " (if old (shadow-cluster-primary old) name))) (regexp (let (try-regexp) (while (not (string-match (setq try-regexp (read-string "Regexp matching all host names: " (if old (shadow-cluster-regexp old) (shadow-regexp-superquote primary)))) primary)) (message "Regexp doesn't include the primary host!") (sit-for 2)) try-regexp)) ; (username (read-no-blanks-input ; (format "Username [default: %s]: " ; (shadow-get-user primary)) ; (if old (or (shadow-cluster-username old) "") ; (user-login-name)))) ) ; (if (string-equal "" username) (setq username nil)) (shadow-set-cluster name primary regexp))) (defun shadow-define-literal-group () "Declare a single file to be shared between sites. It may have different filenames on each site. When this file is edited, the new version will be copied to each of the other locations. Sites can be specific hostnames, or names of clusters \(see shadow-define-cluster)." (interactive) (let* ((hup (shadow-parse-fullpath (shadow-contract-file-name (buffer-file-name)))) (path (nth 2 hup)) user site group) (while (setq site (shadow-read-site)) (setq user (read-string (format "Username [default %s]: " (shadow-get-user site))) path (read-string "Filename: " path)) (setq group (cons (shadow-make-fullpath site (if (string-equal "" user) (shadow-get-user site) user) path) group))) (setq shadow-literal-groups (cons group shadow-literal-groups))) (shadow-write-info-file)) (defun shadow-define-regexp-group () "Make each of a group of files be shared between hosts. Prompts for regular expression; files matching this are shared between a list of sites, which are also prompted for. The filenames must be identical on all hosts \(if they aren't, use shadow-define-group instead of this function). Each site can be either a hostname or the name of a cluster \(see shadow-define-cluster)." (interactive) (let ((regexp (read-string "Filename regexp: " (if (buffer-file-name) (shadow-regexp-superquote (nth 2 (shadow-parse-path (shadow-contract-file-name (buffer-file-name)))))))) site sites usernames) (while (setq site (shadow-read-site)) (setq sites (cons site sites)) (setq usernames (cons (read-string (format "Username for %s: " site) (shadow-get-user site)) usernames))) (setq shadow-regexp-groups (cons (shadow-make-group regexp sites usernames) shadow-regexp-groups)) (shadow-write-info-file))) (defun shadow-shadows () ;; Mostly for debugging. "Interactive function to display shadows of a buffer." (interactive) (let ((msg (shadow-join (mapcar (function cdr) (shadow-shadows-of (buffer-file-name))) " "))) (message (if (zerop (length msg)) "No shadows." msg)))) (defun shadow-copy-files (&optional arg) "Copy all pending shadow files. With prefix argument, copy all pending files without query. Pending copies are stored in variable shadow-files-to-copy, and in shadow-todo-file if necessary. This function is invoked by shadow-save-buffers-kill-emacs, so it is not usually necessary to call it manually." (interactive "P") (if (and (not shadow-files-to-copy) (interactive-p)) (message "No files need to be shadowed.") (save-excursion (map-y-or-n-p (function (lambda (pair) (or arg shadow-noquery (format "Copy shadow file %s? " (cdr pair))))) (function shadow-copy-file) shadow-files-to-copy '("shadow" "shadows" "copy")) (shadow-write-todo-file t)))) (defun shadow-cancel () "Cancel the instruction to copy some files. Prompts for which copy operations to cancel. You will not be asked to copy them again, unless you make more changes to the files. To cancel a shadow permanently, remove the group from shadow-literal-groups or shadow-regexp-groups." (interactive) (map-y-or-n-p (function (lambda (pair) (format "Cancel copying %s to %s? " (car pair) (cdr pair)))) (function (lambda (pair) (shadow-remove-from-todo pair))) shadow-files-to-copy '("shadow" "shadows" "cancel copy")) (message (format "There are %d shadows to be updated." (length shadow-files-to-copy))) (shadow-write-todo-file)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Internal functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun shadow-make-group (regexp sites usernames) "Makes a description of a file group--- actually a list of regexp ange-ftp file names---from REGEXP \(name of file to be shadowed), list of SITES, and corresponding list of USERNAMES for each site." (if sites (cons (shadow-make-fullpath (car sites) (car usernames) regexp) (shadow-make-group regexp (cdr sites) (cdr usernames))) nil)) (defun shadow-copy-file (s) "Copy one shadow file." (let* ((buffer (cond ((get-file-buffer (abbreviate-file-name (shadow-expand-file-name (car s))))) ((not (file-readable-p (car s))) (if (y-or-n-p (format "Cannot find file %s--cancel copy request?" (car s))) (shadow-remove-from-todo s)) nil) ((or (eq t shadow-noquery) (y-or-n-p (format "No buffer for %s -- update shadow anyway?" (car s)))) (find-file-noselect (car s))))) (to (shadow-expand-cluster-in-file-name (cdr s)))) (shadow-when buffer (set-buffer buffer) (save-restriction (widen) (condition-case i (progn (write-region (point-min) (point-max) to) (shadow-remove-from-todo s)) (error (message (format "Shadow %s not updated!" (cdr s))))))))) (defun shadow-shadows-of (file) "Returns copy operations needed to update FILE. Filename should have clusters expanded, but otherwise can have any format. Return value is a list of dotted pairs like \(from . to), where from and to are absolute file names." (or (symbol-value (intern-soft file shadow-hashtable)) (let* ((absolute-file (shadow-expand-file-name (or (shadow-local-file file) file) shadow-homedir)) (canonical-file (shadow-contract-file-name absolute-file)) (shadows (mapcar (function (lambda (shadow) (cons absolute-file shadow))) (append (shadow-shadows-of-1 canonical-file shadow-literal-groups nil) (shadow-shadows-of-1 canonical-file shadow-regexp-groups t))))) (set (intern file shadow-hashtable) shadows)))) (defun shadow-shadows-of-1 (file groups regexp) "Return list of FILE's shadows in GROUPS, which are considered as regular expressions if third arg REGEXP is true." (if groups (let ((nonmatching (shadow-remove-if (function (lambda (x) (shadow-file-match x file regexp))) (car groups)))) (append (cond ((equal nonmatching (car groups)) nil) (regexp (let ((realpath (nth 2 (shadow-parse-fullpath file)))) (mapcar (function (lambda (x) (shadow-replace-path-component x realpath))) nonmatching))) (t nonmatching)) (shadow-shadows-of-1 file (cdr groups) regexp))))) (defun shadow-add-to-todo () "If current buffer has shadows, add them to the list of files needing to be copied." (let ((shadows (shadow-shadows-of (shadow-expand-file-name (buffer-file-name (current-buffer)))))) (shadow-when shadows (setq shadow-files-to-copy (shadow-union shadows shadow-files-to-copy)) (shadow-when (not shadow-inhibit-message) (message (substitute-command-keys "Use \\[shadow-copy-files] to update shadows.")) (sit-for 1)) (shadow-write-todo-file))) nil) ; Return nil for write-file-hooks (defun shadow-remove-from-todo (pair) "Remove PAIR from shadow-files-to-copy. PAIR must be (eq to) one of the elements of that list." (setq shadow-files-to-copy (shadow-remove-if (function (lambda (s) (eq s pair))) shadow-files-to-copy))) (defun shadow-read-files () "Visits and loads shadow-info-file and shadow-todo-file, thus restoring shadowfile's state from your last emacs session. Returns t unless files were locked; then returns nil." (interactive) (if (and (fboundp 'file-locked-p) (or (stringp (file-locked-p shadow-info-file)) (stringp (file-locked-p shadow-todo-file)))) (progn (message "Shadowfile is running in another emacs; can't have two.") (beep) (sit-for 3) nil) (save-excursion (shadow-when shadow-info-file (set-buffer (setq shadow-info-buffer (find-file-noselect shadow-info-file))) (shadow-when (and (not (buffer-modified-p)) (file-newer-than-file-p (make-auto-save-file-name) shadow-info-file)) (erase-buffer) (message "Data recovered from %s." (car (insert-file-contents (make-auto-save-file-name)))) (sit-for 1)) (eval-current-buffer)) (shadow-when shadow-todo-file (set-buffer (setq shadow-todo-buffer (find-file-noselect shadow-todo-file))) (shadow-when (and (not (buffer-modified-p)) (file-newer-than-file-p (make-auto-save-file-name) shadow-todo-file)) (erase-buffer) (message "Data recovered from %s." (car (insert-file-contents (make-auto-save-file-name)))) (sit-for 1)) (eval-current-buffer nil)) (shadow-invalidate-hashtable)) t)) (defun shadow-write-info-file () "Write out information to shadow-info-file. Also clears shadow-hashtable, since when there are new shadows defined, the old hashtable info is invalid." (shadow-invalidate-hashtable) (if shadow-info-file (save-excursion (if (not shadow-info-buffer) (setq shadow-info-buffer (find-file-noselect shadow-info-file))) (set-buffer shadow-info-buffer) (delete-region (point-min) (point-max)) (shadow-insert-var 'shadow-clusters) (shadow-insert-var 'shadow-literal-groups) (shadow-insert-var 'shadow-regexp-groups)))) (defun shadow-write-todo-file (&optional save) "Write out information to shadow-todo-file. With nonnil argument also saves the buffer." (save-excursion (if (not shadow-todo-buffer) (setq shadow-todo-buffer (find-file-noselect shadow-todo-file))) (set-buffer shadow-todo-buffer) (delete-region (point-min) (point-max)) (shadow-insert-var 'shadow-files-to-copy) (if save (shadow-save-todo-file)))) (defun shadow-save-todo-file () (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer)) (save-excursion (set-buffer shadow-todo-buffer) (condition-case nil ; have to continue even in case of (basic-save-buffer) ; error, otherwise kill-emacs might (error ; not work! (message "WARNING: Can't save shadow todo file; it is locked!") (sit-for 1)))))) (defun shadow-invalidate-hashtable () (setq shadow-hashtable (make-vector 37 0))) (defun shadow-insert-var (variable) "Prettily insert a setq command for VARIABLE. which, when later evaluated, will restore it to its current setting. SYMBOL must be the name of a variable whose value is a list." (let ((standard-output (current-buffer))) (insert (format "(setq %s" variable)) (cond ((consp (eval variable)) (insert "\n '(") (prin1 (car (eval variable))) (let ((rest (cdr (eval variable)))) (while rest (insert "\n ") (prin1 (car rest)) (setq rest (cdr rest))) (insert "))\n\n"))) (t (insert " ") (prin1 (eval variable)) (insert ")\n\n"))))) (defun shadow-save-buffers-kill-emacs (&optional arg) "Offer to save each buffer and copy shadows, then kill this Emacs process. With prefix arg, silently save all file-visiting buffers, then kill. Extended by shadowfile to automatically save `shadow-todo-file' and look for files that have been changed and need to be copied to other systems." ;; This function is necessary because we need to get control and save ;; the todo file /after/ saving other files, but /before/ the warning ;; message about unsaved buffers (because it can get modified by the ;; action of saving other buffers). `kill-emacs-hook' is no good ;; because it is not called at the correct time, and also because it is ;; called when the terminal is disconnected and we cannot ask whether ;; to copy files. (interactive "P") (shadow-save-todo-file) (save-some-buffers arg t) (shadow-copy-files) (shadow-save-todo-file) (and (or (not (memq t (mapcar (function (lambda (buf) (and (buffer-file-name buf) (buffer-modified-p buf)))) (buffer-list)))) (yes-or-no-p "Modified buffers exist; exit anyway? ")) (or (not (fboundp 'process-list)) ;; process-list is not defined on VMS. (let ((processes (process-list)) active) (while processes (and (memq (process-status (car processes)) '(run stop open)) (let ((val (process-kill-without-query (car processes)))) (process-kill-without-query (car processes) val) val) (setq active t)) (setq processes (cdr processes))) (or (not active) (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))) (kill-emacs))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Lucid Emacs compatibility ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; This is on hold until someone tells me about a working version of ;; map-ynp for Lucid Emacs. ;(shadow-when (string-match "Lucid" emacs-version) ; (require 'symlink-fix) ; (require 'ange-ftp) ; (require 'map-ynp) ; (if (not (fboundp 'file-truename)) ; (fset 'shadow-expand-file-name ; (symbol-function 'symlink-expand-file-name))) ; (if (not (fboundp 'ange-ftp-ftp-name)) ; (fset 'ange-ftp-ftp-name ; (symbol-function 'ange-ftp-ftp-path)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Hook us up ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; File shadowing is activated at load time, unless this this file is ;;; being preloaded, in which case it is added to after-init-hook. ;;; Thanks to Richard Caley for this scheme. (defun shadow-initialize () (if (null shadow-homedir) (setq shadow-homedir (file-name-as-directory (shadow-expand-file-name "~")))) (if (null shadow-info-file) (setq shadow-info-file (shadow-expand-file-name "~/.shadows"))) (if (null shadow-todo-file) (setq shadow-todo-file (shadow-expand-file-name "~/.shadow_todo"))) (if (not (shadow-read-files)) (progn (message "Shadowfile information files not found - aborting") (beep) (sit-for 3)) (shadow-when (and (not shadow-inhibit-overload) (not (fboundp 'shadow-orig-save-buffers-kill-emacs))) (fset 'shadow-orig-save-buffers-kill-emacs (symbol-function 'save-buffers-kill-emacs)) (fset 'save-buffers-kill-emacs (symbol-function 'shadow-save-buffers-kill-emacs))) (add-hook 'write-file-hooks 'shadow-add-to-todo) (define-key ctl-x-4-map "s" 'shadow-copy-files))) (if noninteractive (add-hook 'after-init-hook 'shadow-initialize) (shadow-initialize)) ;;;Local Variables: ;;;eval:(put 'shadow-when 'lisp-indent-hook 1) ;;;End: ;;; shadowfile.el ends here emacs-19.30/lisp/shell.el100444 75424 1 103173 5771377373 13772 0ustar kwzhdaemon;;; shell.el --- specialized comint.el for running the shell. ;; Copyright (C) 1988, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Olin Shivers ;; Maintainer: Simon Marshall ;; Keywords: processes ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Please send me bug reports, bug fixes, and extensions, so that I can ;;; merge them into the master source. ;;; - Olin Shivers (shivers@cs.cmu.edu) ;;; - Simon Marshall (simon@gnu.ai.mit.edu) ;;; This file defines a a shell-in-a-buffer package (shell mode) built ;;; on top of comint mode. This is actually cmushell with things ;;; renamed to replace its counterpart in Emacs 18. cmushell is more ;;; featureful, robust, and uniform than the Emacs 18 version. ;;; Since this mode is built on top of the general command-interpreter-in- ;;; a-buffer mode (comint mode), it shares a common base functionality, ;;; and a common set of bindings, with all modes derived from comint mode. ;;; This makes these modes easier to use. ;;; For documentation on the functionality provided by comint mode, and ;;; the hooks available for customising it, see the file comint.el. ;;; For further information on shell mode, see the comments below. ;;; Needs fixin: ;;; When sending text from a source file to a subprocess, the process-mark can ;;; move off the window, so you can lose sight of the process interactions. ;;; Maybe I should ensure the process mark is in the window when I send ;;; text to the process? Switch selectable? ;; YOUR .EMACS FILE ;;============================================================================= ;; Some suggestions for your .emacs file. ;; ;; ;; Define M-# to run some strange command: ;; (eval-after-load "shell" ;; '(define-key shell-mode-map "\M-#" 'shells-dynamic-spell)) ;;; Brief Command Documentation: ;;;============================================================================ ;;; Comint Mode Commands: (common to shell and all comint-derived modes) ;;; ;;; m-p comint-previous-input Cycle backwards in input history ;;; m-n comint-next-input Cycle forwards ;;; m-r comint-previous-matching-input Previous input matching a regexp ;;; m-s comint-next-matching-input Next input that matches ;;; m-c-l comint-show-output Show last batch of process output ;;; return comint-send-input ;;; c-d comint-delchar-or-maybe-eof Delete char unless at end of buff. ;;; c-c c-a comint-bol Beginning of line; skip prompt ;;; c-c c-u comint-kill-input ^u ;;; c-c c-w backward-kill-word ^w ;;; c-c c-c comint-interrupt-subjob ^c ;;; c-c c-z comint-stop-subjob ^z ;;; c-c c-\ comint-quit-subjob ^\ ;;; c-c c-o comint-kill-output Delete last batch of process output ;;; c-c c-r comint-show-output Show last batch of process output ;;; c-c c-h comint-dynamic-list-input-ring List input history ;;; send-invisible Read line w/o echo & send to proc ;;; comint-continue-subjob Useful if you accidentally suspend ;;; top-level job ;;; comint-mode-hook is the comint mode hook. ;;; Shell Mode Commands: ;;; shell Fires up the shell process ;;; tab comint-dynamic-complete Complete filename/command/history ;;; m-? comint-dynamic-list-filename-completions ;;; List completions in help buffer ;;; m-c-f shell-forward-command Forward a shell command ;;; m-c-b shell-backward-command Backward a shell command ;;; dirs Resync the buffer's dir stack ;;; dirtrack-toggle Turn dir tracking on/off ;;; comint-strip-ctrl-m Remove trailing ^Ms from output ;;; ;;; The shell mode hook is shell-mode-hook ;;; comint-prompt-regexp is initialised to shell-prompt-pattern, for backwards ;;; compatibility. ;;; Read the rest of this file for more information. ;;; Customization and Buffer Variables ;;; =========================================================================== ;;; ;;; Code: (require 'comint) ;;;###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.") (defvar shell-completion-fignore nil "*List of suffixes to be disregarded during file/command completion. This variable is used to initialize `comint-completion-fignore' in the shell buffer. The default is nil, for compatibility with most shells. Some people like (\"~\" \"#\" \"%\"). This is a fine thing to set in your `.emacs' file.") (defvar shell-delimiter-argument-list '(?\| ?& ?< ?> ?\( ?\) ?\;) "List of characters to recognise as separate arguments. This variable is used to initialize `comint-delimiter-argument-list' in the shell buffer. The default is (?\\| ?& ?< ?> ?\\( ?\\) ?\\;). This is a fine thing to set in your `.emacs' file.") (defvar shell-file-name-quote-list (append shell-delimiter-argument-list '(?\ ?\* ?\! ?\" ?\' ?\`)) "List of characters to quote when in a file name. This variable is used to initialize `comint-file-name-quote-list' in the shell buffer. The default is (?\ ?\* ?\! ?\" ?\' ?\`) plus characters in `shell-delimiter-argument-list'. This is a fine thing to set in your `.emacs' file.") (defvar shell-dynamic-complete-functions '(comint-replace-by-expanded-history shell-dynamic-complete-environment-variable shell-dynamic-complete-command shell-replace-by-expanded-directory comint-dynamic-complete-filename) "List of functions called to perform completion. This variable is used to initialise `comint-dynamic-complete-functions' in the shell buffer. This is a fine thing to set in your `.emacs' file.") (defvar shell-command-regexp "[^;&|\n]+" "*Regexp to match a single command within a pipeline. This is used for directory tracking and does not do a perfect job.") (defvar shell-completion-execonly t "*If non-nil, use executable files only for completion candidates. This mirrors the optional behavior of tcsh. Detecting executability of files may slow command completion considerably.") (defvar shell-popd-regexp "popd" "*Regexp to match subshell commands equivalent to popd.") (defvar shell-pushd-regexp "pushd" "*Regexp to match subshell commands equivalent to pushd.") (defvar shell-pushd-tohome nil "*If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd). This mirrors the optional behavior of tcsh.") (defvar shell-pushd-dextract nil "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top. This mirrors the optional behavior of tcsh.") (defvar shell-pushd-dunique nil "*If non-nil, make pushd only add unique directories to the stack. This mirrors the optional behavior of tcsh.") (defvar shell-cd-regexp "cd" "*Regexp to match subshell commands equivalent to cd.") (defvar explicit-shell-file-name nil "*If non-nil, is file name to use for explicitly requested inferior shell.") (defvar explicit-csh-args (if (eq system-type 'hpux) ;; -T persuades HP's csh not to think it is smarter ;; than us about what terminal modes to use. '("-i" "-T") '("-i")) "*Args passed to inferior shell by M-x shell, if the shell is csh. Value is a list of strings, which may be nil.") (defvar shell-input-autoexpand 'history "*If non-nil, expand input command history references on completion. This mirrors the optional behavior of tcsh (its autoexpand and histlit). If the value is `input', then the expansion is seen on input. If the value is `history', then the expansion is only when inserting into the buffer's input ring. See also `comint-magic-space' and `comint-dynamic-complete'. This variable supplies a default for `comint-input-autoexpand', for Shell mode only.") (defvar shell-dirstack nil "List of directories saved by pushd in this buffer's shell. Thus, this does not include the shell's current directory.") (defvar shell-dirtrackp t "Non-nil in a shell buffer means directory tracking is enabled.") (defvar shell-last-dir nil "Keep track of last directory for ksh `cd -' command.") (defvar shell-dirstack-query nil "Command used by `shell-resync-dir' to query the shell.") (defvar shell-mode-map nil) (cond ((not shell-mode-map) (setq shell-mode-map (nconc (make-sparse-keymap) comint-mode-map)) (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command) (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command) (define-key shell-mode-map "\t" 'comint-dynamic-complete) (define-key shell-mode-map "\M-?" 'comint-dynamic-list-filename-completions) (define-key shell-mode-map [menu-bar completion] (copy-keymap (lookup-key comint-mode-map [menu-bar completion]))) (define-key-after (lookup-key shell-mode-map [menu-bar completion]) [complete-env-variable] '("Complete Env. Variable Name" . shell-dynamic-complete-environment-variable) 'complete-file) (define-key-after (lookup-key shell-mode-map [menu-bar completion]) [expand-directory] '("Expand Directory Reference" . shell-replace-by-expanded-directory) 'complete-expand))) (defvar shell-mode-hook '() "*Hook for customising Shell mode.") (defvar shell-font-lock-keywords (list (cons shell-prompt-pattern 'font-lock-keyword-face) '("[ \t]\\([+-][^ \t\n]+\\)" 1 font-lock-comment-face) '("^[^ \t\n]+:.*" . font-lock-string-face) '("^\\[[1-9][0-9]*\\]" . font-lock-string-face)) "Additional expressions to highlight in Shell mode.") ;;; Basic Procedures ;;; =========================================================================== ;;; (defun shell-mode () "Major mode for interacting with an inferior shell. \\[comint-send-input] after the end of the process' output sends the text from the end of process to the end of the current line. \\[comint-send-input] before end of process output copies the current line minus the prompt to the end of the buffer and sends it (\\[comint-copy-old-input] just copies the current line). \\[send-invisible] reads a line of text without echoing it, and sends it to the shell. This is useful for entering passwords. Or, add the function `comint-watch-for-password-prompt' to `comint-output-filter-functions'. If you want to make multiple shell buffers, rename the `*shell*' buffer using \\[rename-buffer] or \\[rename-uniquely] and start a new shell. If you want to make shell buffers limited in length, add the function `comint-truncate-buffer' to `comint-output-filter-functions'. If you accidentally suspend your process, use \\[comint-continue-subjob] to continue it. `cd', `pushd' and `popd' commands given to the shell are watched by Emacs to keep this buffer's default directory the same as the shell's working directory. While directory tracking is enabled, the shell's working directory is displayed by \\[list-buffers] or \\[mouse-buffer-menu] in the `File' field. \\[dirs] queries the shell and resyncs Emacs' idea of what the current directory stack is. \\[dirtrack-toggle] turns directory tracking on and off. \\{shell-mode-map} Customization: Entry to this mode runs the hooks on `comint-mode-hook' and `shell-mode-hook' (in that order). Before each input, the hooks on `comint-input-filter-functions' are run. After each shell output, the hooks on `comint-output-filter-functions' are run. Variables `shell-cd-regexp', `shell-pushd-regexp' and `shell-popd-regexp' are used to match their respective commands, while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the relevant command. Variables `comint-completion-autolist', `comint-completion-addsuffix', `comint-completion-recexact' and `comint-completion-fignore' control the behavior of file name, command name and variable name completion. Variable `shell-completion-execonly' controls the behavior of command name completion. Variable `shell-completion-fignore' is used to initialise the value of `comint-completion-fignore'. Variables `comint-input-ring-file-name' and `comint-input-autoexpand' control the initialisation of the input ring history, and history expansion. Variables `comint-output-filter-functions', a hook, and `comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output' control whether input and output cause the window to scroll to the end of the buffer." (interactive) (comint-mode) (setq major-mode 'shell-mode) (setq mode-name "Shell") (use-local-map shell-mode-map) (setq comint-prompt-regexp shell-prompt-pattern) (setq comint-completion-fignore shell-completion-fignore) (setq comint-delimiter-argument-list shell-delimiter-argument-list) (setq comint-file-name-quote-list shell-file-name-quote-list) (setq comint-dynamic-complete-functions shell-dynamic-complete-functions) (make-local-variable 'paragraph-start) (setq paragraph-start comint-prompt-regexp) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(shell-font-lock-keywords t)) (make-local-variable 'shell-dirstack) (setq shell-dirstack nil) (setq shell-last-dir nil) (make-local-variable 'shell-dirtrackp) (setq shell-dirtrackp t) (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t) (setq comint-input-autoexpand shell-input-autoexpand) (make-local-variable 'list-buffers-directory) (setq list-buffers-directory (expand-file-name default-directory)) ;; shell-dependent assignments. (let ((shell (file-name-nondirectory (car (process-command (get-buffer-process (current-buffer))))))) (setq comint-input-ring-file-name (or (getenv "HISTFILE") (cond ((string-equal shell "bash") "~/.bash_history") ((string-equal shell "ksh") "~/.sh_history") (t "~/.history")))) (if (or (equal comint-input-ring-file-name "") (equal (file-truename comint-input-ring-file-name) "/dev/null")) (setq comint-input-ring-file-name nil)) (setq shell-dirstack-query (if (string-match "^k?sh$" shell) "pwd" "dirs"))) (run-hooks 'shell-mode-hook) (comint-read-input-ring t)) ;;;###autoload (defun shell () "Run an inferior shell, with I/O through buffer *shell*. If buffer exists but shell process is not running, make new shell. If buffer exists and shell process is running, just switch to buffer `*shell*'. Program used comes from variable `explicit-shell-file-name', or (if that is nil) from the ESHELL environment variable, or else from SHELL if there is no ESHELL. If a file `~/.emacs_SHELLNAME' exists, it is given as initial input (Note that this may lose due to a timing error if the shell discards input when it starts up.) The buffer is put in Shell mode, giving commands for sending input and controlling the subjobs of the shell. See `shell-mode'. See also the variable `shell-prompt-pattern'. The shell file name (sans directories) is used to make a symbol name such as `explicit-csh-args'. If that symbol is a variable, its value is used as a list of arguments when invoking the shell. Otherwise, one argument `-i' is passed to the shell. \(Type \\[describe-mode] in the shell buffer for a list of commands.)" (interactive) (if (not (comint-check-proc "*shell*")) (let* ((prog (or explicit-shell-file-name (getenv "ESHELL") (getenv "SHELL") "/bin/sh")) (name (file-name-nondirectory prog)) (startfile (concat "~/.emacs_" name)) (xargs-name (intern-soft (concat "explicit-" name "-args"))) shell-buffer) (save-excursion (set-buffer (apply 'make-comint "shell" prog (if (file-exists-p startfile) startfile) (if (and xargs-name (boundp xargs-name)) (symbol-value xargs-name) '("-i")))) (setq shell-buffer (current-buffer)) (shell-mode)) (pop-to-buffer shell-buffer)) (pop-to-buffer "*shell*"))) ;;; Don't do this when shell.el is loaded, only while dumping. ;;;###autoload (add-hook 'same-window-buffer-names "*shell*") ;;; Directory tracking ;;; =========================================================================== ;;; This code provides the shell mode input sentinel ;;; SHELL-DIRECTORY-TRACKER ;;; that tracks cd, pushd, and popd commands issued to the shell, and ;;; changes the current directory of the shell buffer accordingly. ;;; ;;; This is basically a fragile hack, although it's more accurate than ;;; the version in Emacs 18's shell.el. It has the following failings: ;;; 1. It doesn't know about the cdpath shell variable. ;;; 2. It cannot infallibly deal with command sequences, though it does well ;;; with these and with ignoring commands forked in another shell with ()s. ;;; 3. More generally, any complex command is going to throw it. Otherwise, ;;; you'd have to build an entire shell interpreter in emacs lisp. Failing ;;; that, there's no way to catch shell commands where cd's are buried ;;; inside conditional expressions, aliases, and so forth. ;;; ;;; The whole approach is a crock. Shell aliases mess it up. File sourcing ;;; messes it up. You run other processes under the shell; these each have ;;; separate working directories, and some have commands for manipulating ;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have ;;; commands that do *not* affect the current w.d. at all, but look like they ;;; do (e.g., the cd command in ftp). In shells that allow you job ;;; control, you can switch between jobs, all having different w.d.'s. So ;;; simply saying %3 can shift your w.d.. ;;; ;;; The solution is to relax, not stress out about it, and settle for ;;; a hack that works pretty well in typical circumstances. Remember ;;; that a half-assed solution is more in keeping with the spirit of Unix, ;;; anyway. Blech. ;;; ;;; One good hack not implemented here for users of programmable shells ;;; is to program up the shell w.d. manipulation commands to output ;;; a coded command sequence to the tty. Something like ;;; ESC | | ;;; where is the new current working directory. Then trash the ;;; directory tracking machinery currently used in this package, and ;;; replace it with a process filter that watches for and strips out ;;; these messages. (defun shell-directory-tracker (str) "Tracks cd, pushd and popd commands issued to the shell. This function is called on each input passed to the shell. It watches for cd, pushd and popd commands and sets the buffer's default directory to track these commands. You may toggle this tracking on and off with M-x dirtrack-toggle. If emacs gets confused, you can resync with the shell with M-x dirs. See variables `shell-cd-regexp', `shell-pushd-regexp', and `shell-popd-regexp', while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the relevant command. Environment variables are expanded, see function `substitute-in-file-name'." (if shell-dirtrackp ;; We fail gracefully if we think the command will fail in the shell. (condition-case chdir-failure (let ((start (progn (string-match "^[; \t]*" str) ; skip whitespace (match-end 0))) end cmd arg1) (while (string-match shell-command-regexp str start) (setq end (match-end 0) cmd (comint-arguments (substring str start end) 0 0) arg1 (comint-arguments (substring str start end) 1 1)) (cond ((string-match (concat "\\`\\(" shell-popd-regexp "\\)\\($\\|[ \t]\\)") cmd) (shell-process-popd (substitute-in-file-name arg1))) ((string-match (concat "\\`\\(" shell-pushd-regexp "\\)\\($\\|[ \t]\\)") cmd) (shell-process-pushd (substitute-in-file-name arg1))) ((string-match (concat "\\`\\(" shell-cd-regexp "\\)\\($\\|[ \t]\\)") cmd) (shell-process-cd (substitute-in-file-name arg1)))) (setq start (progn (string-match "[; \t]*" str end) ; skip again (match-end 0))))) (error "Couldn't cd")))) ;;; popd [+n] (defun shell-process-popd (arg) (let ((num (or (shell-extract-num arg) 0))) (cond ((and num (= num 0) shell-dirstack) (shell-cd (car shell-dirstack)) (setq shell-dirstack (cdr shell-dirstack)) (shell-dirstack-message)) ((and num (> num 0) (<= num (length shell-dirstack))) (let* ((ds (cons nil shell-dirstack)) (cell (nthcdr (1- num) ds))) (rplacd cell (cdr (cdr cell))) (setq shell-dirstack (cdr ds)) (shell-dirstack-message))) (t (error "Couldn't popd"))))) ;; Return DIR prefixed with comint-file-name-prefix as appropriate. (defun shell-prefixed-directory-name (dir) (if (= (length comint-file-name-prefix) 0) dir (if (file-name-absolute-p dir) ;; The name is absolute, so prepend the prefix. (concat comint-file-name-prefix dir) ;; For relative name we assume default-directory already has the prefix. (expand-file-name dir)))) ;;; cd [dir] (defun shell-process-cd (arg) (let ((new-dir (cond ((zerop (length arg)) (concat comint-file-name-prefix "~")) ((string-equal "-" arg) shell-last-dir) (t (shell-prefixed-directory-name arg))))) (setq shell-last-dir default-directory) (shell-cd new-dir) (shell-dirstack-message))) ;;; pushd [+n | dir] (defun shell-process-pushd (arg) (let ((num (shell-extract-num arg))) (cond ((zerop (length arg)) ;; no arg -- swap pwd and car of stack unless shell-pushd-tohome (cond (shell-pushd-tohome (shell-process-pushd (concat comint-file-name-prefix "~"))) (shell-dirstack (let ((old default-directory)) (shell-cd (car shell-dirstack)) (setq shell-dirstack (cons old (cdr shell-dirstack))) (shell-dirstack-message))) (t (message "Directory stack empty.")))) ((numberp num) ;; pushd +n (cond ((> num (length shell-dirstack)) (message "Directory stack not that deep.")) ((= num 0) (error (message "Couldn't cd."))) (shell-pushd-dextract (let ((dir (nth (1- num) shell-dirstack))) (shell-process-popd arg) (shell-process-pushd default-directory) (shell-cd dir) (shell-dirstack-message))) (t (let* ((ds (cons default-directory shell-dirstack)) (dslen (length ds)) (front (nthcdr num ds)) (back (reverse (nthcdr (- dslen num) (reverse ds)))) (new-ds (append front back))) (shell-cd (car new-ds)) (setq shell-dirstack (cdr new-ds)) (shell-dirstack-message))))) (t ;; pushd (let ((old-wd default-directory)) (shell-cd (shell-prefixed-directory-name arg)) (if (or (null shell-pushd-dunique) (not (member old-wd shell-dirstack))) (setq shell-dirstack (cons old-wd shell-dirstack))) (shell-dirstack-message)))))) ;; If STR is of the form +n, for n>0, return n. Otherwise, nil. (defun shell-extract-num (str) (and (string-match "^\\+[1-9][0-9]*$" str) (string-to-int str))) (defun shell-dirtrack-toggle () "Turn directory tracking on and off in a shell buffer." (interactive) (if (setq shell-dirtrackp (not shell-dirtrackp)) (setq list-buffers-directory default-directory) (setq list-buffers-directory nil)) (message "Directory tracking %s" (if shell-dirtrackp "ON" "OFF"))) ;;; For your typing convenience: (defalias 'dirtrack-toggle 'shell-dirtrack-toggle) (defun shell-cd (dir) "Do normal `cd' to DIR, and set `list-buffers-directory'." (if shell-dirtrackp (setq list-buffers-directory (file-name-as-directory (expand-file-name dir)))) (cd dir)) (defun shell-resync-dirs () "Resync the buffer's idea of the current directory stack. This command queries the shell with the command bound to `shell-dirstack-query' (default \"dirs\"), reads the next line output and parses it to form the new directory stack. DON'T issue this command unless the buffer is at a shell prompt. Also, note that if some other subprocess decides to do output immediately after the query, its output will be taken as the new directory stack -- you lose. If this happens, just do the command again." (interactive) (let* ((proc (get-buffer-process (current-buffer))) (pmark (process-mark proc))) (goto-char pmark) (insert shell-dirstack-query) (insert "\n") (sit-for 0) ; force redisplay (comint-send-string proc shell-dirstack-query) (comint-send-string proc "\n") (set-marker pmark (point)) (let ((pt (point))) ; wait for 1 line ;; This extra newline prevents the user's pending input from spoofing us. (insert "\n") (backward-char 1) (while (not (looking-at ".+\n")) (accept-process-output proc) (goto-char pt))) (goto-char pmark) (delete-char 1) ; remove the extra newline ;; That's the dirlist. grab it & parse it. (let* ((dl (buffer-substring (match-beginning 0) (1- (match-end 0)))) (dl-len (length dl)) (ds '()) ; new dir stack (i 0)) (while (< i dl-len) ;; regexp = optional whitespace, (non-whitespace), optional whitespace (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir (setq ds (cons (concat comint-file-name-prefix (substring dl (match-beginning 1) (match-end 1))) ds)) (setq i (match-end 0))) (let ((ds (nreverse ds))) (condition-case nil (progn (shell-cd (car ds)) (setq shell-dirstack (cdr ds)) (shell-dirstack-message)) (error (message "Couldn't cd."))))))) ;;; For your typing convenience: (defalias 'dirs 'shell-resync-dirs) ;;; Show the current dirstack on the message line. ;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo". ;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".) ;;; All the commands that mung the buffer's dirstack finish by calling ;;; this guy. (defun shell-dirstack-message () (let* ((msg "") (ds (cons default-directory shell-dirstack)) (home (expand-file-name (concat comint-file-name-prefix "~/"))) (homelen (length home))) (while ds (let ((dir (car ds))) (and (>= (length dir) homelen) (string= home (substring dir 0 homelen)) (setq dir (concat "~/" (substring dir homelen)))) ;; Strip off comint-file-name-prefix if present. (and comint-file-name-prefix (>= (length dir) (length comint-file-name-prefix)) (string= comint-file-name-prefix (substring dir 0 (length comint-file-name-prefix))) (setq dir (substring dir (length comint-file-name-prefix))) (setcar ds dir)) (setq msg (concat msg (directory-file-name dir) " ")) (setq ds (cdr ds)))) (message msg))) (defun shell-forward-command (&optional arg) "Move forward across ARG shell command(s). Does not cross lines. See `shell-command-regexp'." (interactive "p") (let ((limit (save-excursion (end-of-line nil) (point)))) (if (re-search-forward (concat shell-command-regexp "\\([;&|][\t ]*\\)+") limit 'move arg) (skip-syntax-backward " ")))) (defun shell-backward-command (&optional arg) "Move backward across ARG shell command(s). Does not cross lines. See `shell-command-regexp'." (interactive "p") (let ((limit (save-excursion (comint-bol nil) (point)))) (if (> limit (point)) (save-excursion (beginning-of-line) (setq limit (point)))) (skip-syntax-backward " " limit) (if (re-search-backward (format "[;&|]+[\t ]*\\(%s\\)" shell-command-regexp) limit 'move arg) (progn (goto-char (match-beginning 1)) (skip-chars-forward ";&|"))))) (defun shell-dynamic-complete-command () "Dynamically complete the command at point. This function is similar to `comint-dynamic-complete-filename', except that it searches `exec-path' (minus the trailing emacs library path) for completion candidates. Note that this may not be the same as the shell's idea of the path. Completion is dependent on the value of `shell-completion-execonly', plus those that effect file completion. See `shell-dynamic-complete-as-command'. Returns t if successful." (interactive) (let ((filename (comint-match-partial-filename))) (if (and filename (save-match-data (not (string-match "[~/]" filename))) (eq (match-beginning 0) (save-excursion (shell-backward-command 1) (point)))) (prog2 (message "Completing command name...") (shell-dynamic-complete-as-command))))) (defun shell-dynamic-complete-as-command () "Dynamically complete at point as a command. See `shell-dynamic-complete-filename'. Returns t if successful." (let* ((filename (or (comint-match-partial-filename) "")) (pathnondir (file-name-nondirectory filename)) (paths (cdr (reverse exec-path))) (cwd (file-name-as-directory (expand-file-name default-directory))) (ignored-extensions (and comint-completion-fignore (mapconcat (function (lambda (x) (concat (regexp-quote x) "$"))) comint-completion-fignore "\\|"))) (path "") (comps-in-path ()) (file "") (filepath "") (completions ())) ;; Go thru each path in the search path, finding completions. (while paths (setq path (file-name-as-directory (comint-directory (or (car paths) "."))) comps-in-path (and (file-accessible-directory-p path) (file-name-all-completions pathnondir path))) ;; Go thru each completion found, to see whether it should be used. (while comps-in-path (setq file (car comps-in-path) filepath (concat path file)) (if (and (not (member file completions)) (not (and ignored-extensions (string-match ignored-extensions file))) (or (string-equal path cwd) (not (file-directory-p filepath))) (or (null shell-completion-execonly) (file-executable-p filepath))) (setq completions (cons file completions))) (setq comps-in-path (cdr comps-in-path))) (setq paths (cdr paths))) ;; OK, we've got a list of completions. (let ((success (let ((comint-completion-addsuffix nil)) (comint-dynamic-simple-complete pathnondir completions)))) (if (and (memq success '(sole shortest)) comint-completion-addsuffix (not (file-directory-p (comint-match-partial-filename)))) (insert " ")) success))) (defun shell-match-partial-variable () "Return the variable at point, or nil if non is found." (save-excursion (let ((limit (point))) (if (re-search-backward "[^A-Za-z0-9_{}]" nil 'move) (or (looking-at "\\$") (forward-char 1))) ;; Anchor the search forwards. (if (or (eolp) (looking-at "[^A-Za-z0-9_{}$]")) nil (re-search-forward "\\$?{?[A-Za-z0-9_]*}?" limit) (buffer-substring (match-beginning 0) (match-end 0)))))) (defun shell-dynamic-complete-environment-variable () "Dynamically complete the environment variable at point. Completes if after a variable, i.e., if it starts with a \"$\". See `shell-dynamic-complete-as-environment-variable'. This function is similar to `comint-dynamic-complete-filename', except that it searches `process-environment' for completion candidates. Note that this may not be the same as the interpreter's idea of variable names. The main problem with this type of completion is that `process-environment' is the environment which Emacs started with. Emacs does not track changes to the environment made by the interpreter. Perhaps it would be more accurate if this function was called `shell-dynamic-complete-process-environment-variable'. Returns non-nil if successful." (interactive) (let ((variable (shell-match-partial-variable))) (if (and variable (string-match "^\\$" variable)) (prog2 (message "Completing variable name...") (shell-dynamic-complete-as-environment-variable))))) (defun shell-dynamic-complete-as-environment-variable () "Dynamically complete at point as an environment variable. Used by `shell-dynamic-complete-environment-variable'. Uses `comint-dynamic-simple-complete'." (let* ((var (or (shell-match-partial-variable) "")) (variable (substring var (or (string-match "[^$({]\\|$" var) 0))) (variables (mapcar (function (lambda (x) (substring x 0 (string-match "=" x)))) process-environment)) (addsuffix comint-completion-addsuffix) (comint-completion-addsuffix nil) (success (comint-dynamic-simple-complete variable variables))) (if (memq success '(sole shortest)) (let* ((var (shell-match-partial-variable)) (variable (substring var (string-match "[^$({]" var))) (protection (cond ((string-match "{" var) "}") ((string-match "(" var) ")") (t ""))) (suffix (cond ((null addsuffix) "") ((file-directory-p (comint-directory (getenv variable))) "/") (t " ")))) (insert protection suffix))) success)) (defun shell-replace-by-expanded-directory () "Expand directory stack reference before point. Directory stack references are of the form \"=digit\" or \"=-\". See `default-directory' and `shell-dirstack'. Returns t if successful." (interactive) (if (comint-match-partial-filename) (save-excursion (goto-char (match-beginning 0)) (let ((stack (cons default-directory shell-dirstack)) (index (cond ((looking-at "=-/?") (length shell-dirstack)) ((looking-at "=\\([0-9]+\\)") (string-to-number (buffer-substring (match-beginning 1) (match-end 1))))))) (cond ((null index) nil) ((>= index (length stack)) (error "Directory stack not that deep.")) (t (replace-match (file-name-as-directory (nth index stack)) t t) (message "Directory item: %d" index) t)))))) (provide 'shell) ;;; shell.el ends here emacs-19.30/lisp/simple.el100444 12120 1 342555 6053406640 13743 0ustar rmsdaemon;;; simple.el --- basic editing commands for Emacs ;; Copyright (C) 1985, 86, 87, 93, 94, 95 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: ;; A grab-bag of basic Emacs commands not specifically related to some ;; major mode or to file-handling. ;;; Code: (defun newline (&optional arg) "Insert a newline, and move to left margin of the new line if it's blank. The newline is marked with the text-property `hard'. With arg, insert that many newlines. In Auto Fill mode, if no numeric arg, break the preceding line if it's long." (interactive "*P") (barf-if-buffer-read-only) ;; Inserting a newline at the end of a line produces better redisplay in ;; try_window_id than inserting at the beginning of a line, and the textual ;; result is the same. So, if we're at beginning of line, pretend to be at ;; the end of the previous line. (let ((flag (and (not (bobp)) (bolp) (< (or (previous-property-change (point)) -2) (- (point) 2)))) (was-page-start (and (bolp) (looking-at page-delimiter))) (beforepos (point))) (if flag (backward-char 1)) ;; Call self-insert so that auto-fill, abbrev expansion etc. happens. ;; Set last-command-char to tell self-insert what to insert. (let ((last-command-char ?\n) ;; Don't auto-fill if we have a numeric argument. ;; Also not if flag is true (it would fill wrong line); ;; there is no need to since we're at BOL. (auto-fill-function (if (or arg flag) nil auto-fill-function))) (unwind-protect (self-insert-command (prefix-numeric-value arg)) ;; If we get an error in self-insert-command, put point at right place. (if flag (forward-char 1)))) ;; If we did *not* get an error, cancel that forward-char. (if flag (backward-char 1)) ;; Mark the newline(s) `hard'. (if use-hard-newlines (let* ((from (- (point) (if arg (prefix-numeric-value arg) 1))) (sticky (get-text-property from 'rear-nonsticky))) (put-text-property from (point) 'hard 't) ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list (if (and (listp sticky) (not (memq 'hard sticky))) (put-text-property from (point) 'rear-nonsticky (cons 'hard sticky))))) ;; If the newline leaves the previous line blank, ;; and we have a left margin, delete that from the blank line. (or flag (save-excursion (goto-char beforepos) (beginning-of-line) (and (looking-at "[ \t]$") (> (current-left-margin) 0) (delete-region (point) (progn (end-of-line) (point)))))) (if flag (forward-char 1)) ;; Indent the line after the newline, except in one case: ;; when we added the newline at the beginning of a line ;; which starts a page. (or was-page-start (move-to-left-margin nil t))) nil) (defun open-line (arg) "Insert a newline and leave point before it. If there is a fill prefix and/or a left-margin, insert them on the new line if the line would have been blank. With arg N, insert N newlines." (interactive "*p") (let* ((do-fill-prefix (and fill-prefix (bolp))) (do-left-margin (and (bolp) (> (current-left-margin) 0))) (loc (point))) (newline arg) (goto-char loc) (while (> arg 0) (cond ((bolp) (if do-left-margin (indent-to (current-left-margin))) (if do-fill-prefix (insert-and-inherit fill-prefix)))) (forward-line 1) (setq arg (1- arg))) (goto-char loc) (end-of-line))) (defun split-line () "Split current line, moving portion beyond point vertically down." (interactive "*") (skip-chars-forward " \t") (let ((col (current-column)) (pos (point))) (newline 1) (indent-to col 0) (goto-char pos))) (defun quoted-insert (arg) "Read next input character and insert it. This is useful for inserting control characters. You may also type up to 3 octal digits, to insert a character with that code. In overwrite mode, this function inserts the character anyway, and does not handle octal digits specially. This means that if you use overwrite as your normal editing mode, you can use this function to insert characters when necessary. In binary overwrite mode, this function does overwrite, and octal digits are interpreted as a character code. This is supposed to make this function useful in editing binary files." (interactive "*p") (let ((char (if (or (not overwrite-mode) (eq overwrite-mode 'overwrite-mode-binary)) (read-quoted-char) (read-char)))) (if (> arg 0) (if (eq overwrite-mode 'overwrite-mode-binary) (delete-char arg))) (while (> arg 0) (insert-and-inherit char) (setq arg (1- arg))))) (defun delete-indentation (&optional arg) "Join this line to previous and fix up whitespace at join. If there is a fill prefix, delete it from the beginning of this line. With argument, join this line to following line." (interactive "*P") (beginning-of-line) (if arg (forward-line 1)) (if (eq (preceding-char) ?\n) (progn (delete-region (point) (1- (point))) ;; If the second line started with the fill prefix, ;; delete the prefix. (if (and fill-prefix (<= (+ (point) (length fill-prefix)) (point-max)) (string= fill-prefix (buffer-substring (point) (+ (point) (length fill-prefix))))) (delete-region (point) (+ (point) (length fill-prefix)))) (fixup-whitespace)))) (defun fixup-whitespace () "Fixup white space between objects around point. Leave one space or none, according to the context." (interactive "*") (save-excursion (delete-horizontal-space) (if (or (looking-at "^\\|\\s)") (save-excursion (forward-char -1) (looking-at "$\\|\\s(\\|\\s'"))) nil (insert ?\ )))) (defun delete-horizontal-space () "Delete all spaces and tabs around point." (interactive "*") (skip-chars-backward " \t") (delete-region (point) (progn (skip-chars-forward " \t") (point)))) (defun just-one-space () "Delete all spaces and tabs around point, leaving one space." (interactive "*") (skip-chars-backward " \t") (if (= (following-char) ? ) (forward-char 1) (insert ? )) (delete-region (point) (progn (skip-chars-forward " \t") (point)))) (defun delete-blank-lines () "On blank line, delete all surrounding blank lines, leaving just one. On isolated blank line, delete that one. On nonblank line, delete any immediately following blank lines." (interactive "*") (let (thisblank singleblank) (save-excursion (beginning-of-line) (setq thisblank (looking-at "[ \t]*$")) ;; Set singleblank if there is just one blank line here. (setq singleblank (and thisblank (not (looking-at "[ \t]*\n[ \t]*$")) (or (bobp) (progn (forward-line -1) (not (looking-at "[ \t]*$"))))))) ;; Delete preceding blank lines, and this one too if it's the only one. (if thisblank (progn (beginning-of-line) (if singleblank (forward-line 1)) (delete-region (point) (if (re-search-backward "[^ \t\n]" nil t) (progn (forward-line 1) (point)) (point-min))))) ;; Delete following blank lines, unless the current line is blank ;; and there are no following blank lines. (if (not (and thisblank singleblank)) (save-excursion (end-of-line) (forward-line 1) (delete-region (point) (if (re-search-forward "[^ \t\n]" nil t) (progn (beginning-of-line) (point)) (point-max))))) ;; Handle the special case where point is followed by newline and eob. ;; Delete the line, leaving point at eob. (if (looking-at "^[ \t]*\n\\'") (delete-region (point) (point-max))))) (defun back-to-indentation () "Move point to the first non-whitespace character on this line." (interactive) (beginning-of-line 1) (skip-chars-forward " \t")) (defun newline-and-indent () "Insert a newline, then indent according to major mode. Indentation is done using the value of `indent-line-function'. In programming language modes, this is the same as TAB. In some text modes, where TAB inserts a tab, this command indents to the column specified by the function `current-left-margin'." (interactive "*") (delete-region (point) (progn (skip-chars-backward " \t") (point))) (newline) (indent-according-to-mode)) (defun reindent-then-newline-and-indent () "Reindent current line, insert newline, then indent the new line. Indentation of both lines is done according to the current major mode, which means calling the current value of `indent-line-function'. In programming language modes, this is the same as TAB. In some text modes, where TAB inserts a tab, this indents to the column specified by the function `current-left-margin'." (interactive "*") (save-excursion (delete-region (point) (progn (skip-chars-backward " \t") (point))) (indent-according-to-mode)) (newline) (indent-according-to-mode)) ;; Internal subroutine of delete-char (defun kill-forward-chars (arg) (if (listp arg) (setq arg (car arg))) (if (eq arg '-) (setq arg -1)) (kill-region (point) (+ (point) arg))) ;; Internal subroutine of backward-delete-char (defun kill-backward-chars (arg) (if (listp arg) (setq arg (car arg))) (if (eq arg '-) (setq arg -1)) (kill-region (point) (- (point) arg))) (defun backward-delete-char-untabify (arg &optional killp) "Delete characters backward, changing tabs into spaces. Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil. Interactively, ARG is the prefix arg (default 1) and KILLP is t if a prefix arg was specified." (interactive "*p\nP") (let ((count arg)) (save-excursion (while (and (> count 0) (not (bobp))) (if (= (preceding-char) ?\t) (let ((col (current-column))) (forward-char -1) (setq col (- col (current-column))) (insert-char ?\ col) (delete-char 1))) (forward-char -1) (setq count (1- count))))) (delete-backward-char arg killp) ;; In overwrite mode, back over columns while clearing them out, ;; unless at end of line. (and overwrite-mode (not (eolp)) (save-excursion (insert-char ?\ arg)))) (defun zap-to-char (arg char) "Kill up to and including ARG'th occurrence of CHAR. Goes backward if ARG is negative; error if CHAR not found." (interactive "p\ncZap to char: ") (kill-region (point) (progn (search-forward (char-to-string char) nil nil arg) ; (goto-char (if (> arg 0) (1- (point)) (1+ (point)))) (point)))) (defun beginning-of-buffer (&optional arg) "Move point to the beginning of the buffer; leave mark at previous position. With arg N, put point N/10 of the way from the beginning. If the buffer is narrowed, this command uses the beginning and size of the accessible part of the buffer. Don't use this command in Lisp programs! \(goto-char (point-min)) is faster and avoids clobbering the mark." (interactive "P") (push-mark) (let ((size (- (point-max) (point-min)))) (goto-char (if arg (+ (point-min) (if (> size 10000) ;; Avoid overflow for large buffer sizes! (* (prefix-numeric-value arg) (/ size 10)) (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) (point-min)))) (if arg (forward-line 1))) (defun end-of-buffer (&optional arg) "Move point to the end of the buffer; leave mark at previous position. With arg N, put point N/10 of the way from the end. If the buffer is narrowed, this command uses the beginning and size of the accessible part of the buffer. Don't use this command in Lisp programs! \(goto-char (point-max)) is faster and avoids clobbering the mark." (interactive "P") (push-mark) (let ((size (- (point-max) (point-min)))) (goto-char (if arg (- (point-max) (if (> size 10000) ;; Avoid overflow for large buffer sizes! (* (prefix-numeric-value arg) (/ size 10)) (/ (* size (prefix-numeric-value arg)) 10))) (point-max)))) ;; If we went to a place in the middle of the buffer, ;; adjust it to the beginning of a line. (if arg (forward-line 1) ;; If the end of the buffer is not already on the screen, ;; then scroll specially to put it near, but not at, the bottom. (if (let ((old-point (point))) (save-excursion (goto-char (window-start)) (vertical-motion (window-height)) (< (point) old-point))) (progn (overlay-recenter (point)) (recenter -3))))) (defun mark-whole-buffer () "Put point at beginning and mark at end of buffer. You probably should not use this function in Lisp programs; it is usually a mistake for a Lisp function to use any subroutine that uses or sets the mark." (interactive) (push-mark (point)) (push-mark (point-max) nil t) (goto-char (point-min))) (defun count-lines-region (start end) "Print number of lines and characters in the region." (interactive "r") (message "Region has %d lines, %d characters" (count-lines start end) (- end start))) (defun what-line () "Print the current buffer line number and narrowed line number of point." (interactive) (let ((opoint (point)) start) (save-excursion (save-restriction (goto-char (point-min)) (widen) (beginning-of-line) (setq start (point)) (goto-char opoint) (beginning-of-line) (if (/= start 1) (message "line %d (narrowed line %d)" (1+ (count-lines 1 (point))) (1+ (count-lines start (point)))) (message "Line %d" (1+ (count-lines 1 (point))))))))) (defun count-lines (start end) "Return number of lines between START and END. This is usually the number of newlines between them, but can be one more if START is not equal to END and the greater of them is not at the start of a line." (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) (if (eq selective-display t) (save-match-data (let ((done 0)) (while (re-search-forward "[\n\C-m]" nil t 40) (setq done (+ 40 done))) (while (re-search-forward "[\n\C-m]" nil t 1) (setq done (+ 1 done))) (goto-char (point-max)) (if (and (/= start end) (not (bolp))) (1+ done) done))) (- (buffer-size) (forward-line (buffer-size))))))) (defun what-cursor-position () "Print info on cursor position (on screen and within buffer)." (interactive) (let* ((char (following-char)) (beg (point-min)) (end (point-max)) (pos (point)) (total (buffer-size)) (percent (if (> total 50000) ;; Avoid overflow from multiplying by 100! (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1)) (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1)))) (hscroll (if (= (window-hscroll) 0) "" (format " Hscroll=%d" (window-hscroll)))) (col (current-column))) (if (= pos end) (if (or (/= beg 1) (/= end (1+ total))) (message "point=%d of %d(%d%%) <%d - %d> column %d %s" pos total percent beg end col hscroll) (message "point=%d of %d(%d%%) column %d %s" pos total percent col hscroll)) (if (or (/= beg 1) (/= end (1+ total))) (message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) <%d - %d> column %d %s" (single-key-description char) char char char pos total percent beg end col hscroll) (message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) column %d %s" (single-key-description char) char char char pos total percent col hscroll))))) (defun fundamental-mode () "Major mode not specialized for anything in particular. Other major modes are defined by comparison with this one." (interactive) (kill-all-local-variables)) (defvar read-expression-map (cons 'keymap minibuffer-local-map) "Minibuffer keymap used for reading Lisp expressions.") (define-key read-expression-map "\M-\t" 'lisp-complete-symbol) (put 'eval-expression 'disabled t) (defvar read-expression-history nil) ;; We define this, rather than making `eval' interactive, ;; for the sake of completion of names like eval-region, eval-current-buffer. (defun eval-expression (expression) "Evaluate EXPRESSION and print value in minibuffer. Value is also consed on to front of the variable `values'." (interactive (list (read-from-minibuffer "Eval: " nil read-expression-map t 'read-expression-history))) (setq values (cons (eval expression) values)) (prin1 (car values) t)) (defun edit-and-eval-command (prompt command) "Prompting with PROMPT, let user edit COMMAND and eval result. COMMAND is a Lisp expression. Let user edit that expression in the minibuffer, then read and evaluate the result." (let ((command (read-from-minibuffer prompt (prin1-to-string command) read-expression-map t '(command-history . 1)))) ;; If command was added to command-history as a string, ;; get rid of that. We want only evallable expressions there. (if (stringp (car command-history)) (setq command-history (cdr command-history))) ;; If command to be redone does not match front of history, ;; add it to the history. (or (equal command (car command-history)) (setq command-history (cons command command-history))) (eval command))) (defun repeat-complex-command (arg) "Edit and re-evaluate last complex command, or ARGth from last. A complex command is one which used the minibuffer. The command is placed in the minibuffer as a Lisp form for editing. The result is executed, repeating the command as changed. If the command has been changed or is not the most recent previous command it is added to the front of the command history. You can use the minibuffer history commands \\\\[next-history-element] and \\[previous-history-element] to get different commands to edit and resubmit." (interactive "p") (let ((elt (nth (1- arg) command-history)) (minibuffer-history-position arg) (minibuffer-history-sexp-flag t) newcmd) (if elt (progn (setq newcmd (let ((print-level nil)) (read-from-minibuffer "Redo: " (prin1-to-string elt) read-expression-map t (cons 'command-history arg)))) ;; If command was added to command-history as a string, ;; get rid of that. We want only evallable expressions there. (if (stringp (car command-history)) (setq command-history (cdr command-history))) ;; If command to be redone does not match front of history, ;; add it to the history. (or (equal newcmd (car command-history)) (setq command-history (cons newcmd command-history))) (eval newcmd)) (ding)))) (defvar minibuffer-history nil "Default minibuffer history list. This is used for all minibuffer input except when an alternate history list is specified.") (defvar minibuffer-history-sexp-flag nil "Non-nil when doing history operations on `command-history'. More generally, indicates that the history list being acted on contains expressions rather than strings.") (setq minibuffer-history-variable 'minibuffer-history) (setq minibuffer-history-position nil) (defvar minibuffer-history-search-history nil) (mapcar (lambda (key-and-command) (mapcar (lambda (keymap-and-completionp) ;; Arg is (KEYMAP-SYMBOL . COMPLETION-MAP-P). ;; If the cdr of KEY-AND-COMMAND (the command) is a cons, ;; its car is used if COMPLETION-MAP-P is nil, its cdr if it is t. (define-key (symbol-value (car keymap-and-completionp)) (car key-and-command) (let ((command (cdr key-and-command))) (if (consp command) ;; (and ... nil) => ... turns back on the completion-oriented ;; history commands which rms turned off since they seem to ;; do things he doesn't like. (if (and (cdr keymap-and-completionp) nil) ;XXX turned off (progn (error "EMACS BUG!") (cdr command)) (car command)) command)))) '((minibuffer-local-map . nil) (minibuffer-local-ns-map . nil) (minibuffer-local-completion-map . t) (minibuffer-local-must-match-map . t) (read-expression-map . nil)))) '(("\en" . (next-history-element . next-complete-history-element)) ([next] . (next-history-element . next-complete-history-element)) ("\ep" . (previous-history-element . previous-complete-history-element)) ([prior] . (previous-history-element . previous-complete-history-element)) ("\er" . previous-matching-history-element) ("\es" . next-matching-history-element))) (defun previous-matching-history-element (regexp n) "Find the previous history element that matches REGEXP. \(Previous history elements refer to earlier actions.) With prefix argument N, search for Nth previous match. If N is negative, find the next or Nth next match." (interactive (let* ((enable-recursive-minibuffers t) (minibuffer-history-sexp-flag nil) (regexp (read-from-minibuffer "Previous element matching (regexp): " nil minibuffer-local-map nil 'minibuffer-history-search-history))) ;; Use the last regexp specified, by default, if input is empty. (list (if (string= regexp "") (if minibuffer-history-search-history (car minibuffer-history-search-history) (error "No previous history search regexp")) regexp) (prefix-numeric-value current-prefix-arg)))) (let ((history (symbol-value minibuffer-history-variable)) prevpos (pos minibuffer-history-position)) (while (/= n 0) (setq prevpos pos) (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history))) (if (= pos prevpos) (error (if (= pos 1) "No later matching history item" "No earlier matching history item"))) (if (string-match regexp (if minibuffer-history-sexp-flag (let ((print-level nil)) (prin1-to-string (nth (1- pos) history))) (nth (1- pos) history))) (setq n (+ n (if (< n 0) 1 -1))))) (setq minibuffer-history-position pos) (erase-buffer) (let ((elt (nth (1- pos) history))) (insert (if minibuffer-history-sexp-flag (let ((print-level nil)) (prin1-to-string elt)) elt))) (goto-char (point-min))) (if (or (eq (car (car command-history)) 'previous-matching-history-element) (eq (car (car command-history)) 'next-matching-history-element)) (setq command-history (cdr command-history)))) (defun next-matching-history-element (regexp n) "Find the next history element that matches REGEXP. \(The next history element refers to a more recent action.) With prefix argument N, search for Nth next match. If N is negative, find the previous or Nth previous match." (interactive (let* ((enable-recursive-minibuffers t) (minibuffer-history-sexp-flag nil) (regexp (read-from-minibuffer "Next element matching (regexp): " nil minibuffer-local-map nil 'minibuffer-history-search-history))) ;; Use the last regexp specified, by default, if input is empty. (list (if (string= regexp "") (setcar minibuffer-history-search-history (nth 1 minibuffer-history-search-history)) regexp) (prefix-numeric-value current-prefix-arg)))) (previous-matching-history-element regexp (- n))) (defun next-history-element (n) "Insert the next element of the minibuffer history into the minibuffer." (interactive "p") (or (zerop n) (let ((narg (min (max 1 (- minibuffer-history-position n)) (length (symbol-value minibuffer-history-variable))))) (if (or (zerop narg) (= minibuffer-history-position narg)) (error (if (if (zerop narg) (> n 0) (= minibuffer-history-position 1)) "End of history; no next item" "Beginning of history; no preceding item")) (erase-buffer) (setq minibuffer-history-position narg) (let ((elt (nth (1- minibuffer-history-position) (symbol-value minibuffer-history-variable)))) (insert (if minibuffer-history-sexp-flag (let ((print-level nil)) (prin1-to-string elt)) elt))) (goto-char (point-min)))))) (defun previous-history-element (n) "Inserts the previous element of the minibuffer history into the minibuffer." (interactive "p") (next-history-element (- n))) (defun next-complete-history-element (n) "Get next element of history which is a completion of minibuffer contents." (interactive "p") (let ((point-at-start (point))) (next-matching-history-element (concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n) ;; next-matching-history-element always puts us at (point-min). ;; Move to the position we were at before changing the buffer contents. ;; This is still sensical, because the text before point has not changed. (goto-char point-at-start))) (defun previous-complete-history-element (n) "\ Get previous element of history which is a completion of minibuffer contents." (interactive "p") (next-complete-history-element (- n))) (defun goto-line (arg) "Goto line ARG, counting from line 1 at beginning of buffer." (interactive "NGoto line: ") (setq arg (prefix-numeric-value arg)) (save-restriction (widen) (goto-char 1) (if (eq selective-display t) (re-search-forward "[\n\C-m]" nil 'end (1- arg)) (forward-line (1- arg))))) ;Put this on C-x u, so we can force that rather than C-_ into startup msg (define-function 'advertised-undo 'undo) (defun undo (&optional arg) "Undo some previous changes. Repeat this command to undo more changes. A numeric argument serves as a repeat count." (interactive "*p") ;; If we don't get all the way thru, make last-command indicate that ;; for the following command. (setq this-command t) (let ((modified (buffer-modified-p)) (recent-save (recent-auto-save-p))) (or (eq (selected-window) (minibuffer-window)) (message "Undo!")) (or (eq last-command 'undo) (progn (undo-start) (undo-more 1))) (undo-more (or arg 1)) ;; Don't specify a position in the undo record for the undo command. ;; Instead, undoing this should move point to where the change is. (let ((tail buffer-undo-list) done) (while (and tail (not done) (not (null (car tail)))) (if (integerp (car tail)) (progn (setq done t) (setq buffer-undo-list (delq (car tail) buffer-undo-list)))) (setq tail (cdr tail)))) (and modified (not (buffer-modified-p)) (delete-auto-save-file-if-necessary recent-save))) ;; If we do get all the way thru, make this-command indicate that. (setq this-command 'undo)) (defvar pending-undo-list nil "Within a run of consecutive undo commands, list remaining to be undone.") (defun undo-start () "Set `pending-undo-list' to the front of the undo list. The next call to `undo-more' will undo the most recently made change." (if (eq buffer-undo-list t) (error "No undo information in this buffer")) (setq pending-undo-list buffer-undo-list)) (defun undo-more (count) "Undo back N undo-boundaries beyond what was already undone recently. Call `undo-start' to get ready to undo recent changes, then call `undo-more' one or more times to undo them." (or pending-undo-list (error "No further undo information")) (setq pending-undo-list (primitive-undo count pending-undo-list))) (defvar shell-command-history nil "History list for some commands that read shell commands.") (defvar shell-command-switch "-c" "Switch used to have the shell execute its command line argument.") (defun shell-command (command &optional output-buffer) "Execute string COMMAND in inferior shell; display output, if any. If COMMAND ends in ampersand, execute it asynchronously. The output appears in the buffer `*Async Shell Command*'. That buffer is in shell mode. Otherwise, COMMAND is executed synchronously. The output appears in the buffer `*Shell Command Output*'. If the output is one line, it is displayed in the echo area *as well*, but it is nonetheless available in buffer `*Shell Command Output*', even though that buffer is not automatically displayed. If there is no output, or if output is inserted in the current buffer, then `*Shell Command Output*' is deleted. The optional second argument OUTPUT-BUFFER, if non-nil, says to put the output in some other buffer. If OUTPUT-BUFFER is a buffer or buffer name, put the output there. If OUTPUT-BUFFER is not a buffer and not nil, insert output in current buffer. (This cannot be done asynchronously.) In either case, the output is inserted after point (leaving mark after it)." (interactive (list (read-from-minibuffer "Shell command: " nil nil nil 'shell-command-history) current-prefix-arg)) (if (and output-buffer (not (or (bufferp output-buffer) (stringp output-buffer)))) (progn (barf-if-buffer-read-only) (push-mark) ;; We do not use -f for csh; we will not support broken use of ;; .cshrcs. Even the BSD csh manual says to use ;; "if ($?prompt) exit" before things which are not useful ;; non-interactively. Besides, if someone wants their other ;; aliases for shell commands then they can still have them. (call-process shell-file-name nil t nil shell-command-switch command) ;; This is like exchange-point-and-mark, but doesn't ;; activate the mark. It is cleaner to avoid activation, ;; even though the command loop would deactivate the mark ;; because we inserted text. (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) (current-buffer))))) ;; Preserve the match data in case called from a program. (save-match-data (if (string-match "[ \t]*&[ \t]*$" command) ;; Command ending with ampersand means asynchronous. (let ((buffer (get-buffer-create (or output-buffer "*Asynch Shell Command*"))) (directory default-directory) proc) ;; Remove the ampersand. (setq command (substring command 0 (match-beginning 0))) ;; If will kill a process, query first. (setq proc (get-buffer-process buffer)) (if proc (if (yes-or-no-p "A command is running. Kill it? ") (kill-process proc) (error "Shell command in progress"))) (save-excursion (set-buffer buffer) (setq buffer-read-only nil) (erase-buffer) (display-buffer buffer) (setq default-directory directory) (setq proc (start-process "Shell" buffer shell-file-name shell-command-switch command)) (setq mode-line-process '(":%s")) (require 'shell) (shell-mode) (set-process-sentinel proc 'shell-command-sentinel) )) (shell-command-on-region (point) (point) command nil) )))) ;; We have a sentinel to prevent insertion of a termination message ;; in the buffer itself. (defun shell-command-sentinel (process signal) (if (memq (process-status process) '(exit signal)) (message "%s: %s." (car (cdr (cdr (process-command process)))) (substring signal 0 -1)))) (defun shell-command-on-region (start end command &optional output-buffer replace) "Execute string COMMAND in inferior shell with region as input. Normally display output (if any) in temp buffer `*Shell Command Output*'; Prefix arg means replace the region with it. The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE. If REPLACE is non-nil, that means insert the output in place of text from START to END, putting point and mark around it. If the output is one line, it is displayed in the echo area, but it is nonetheless available in buffer `*Shell Command Output*' even though that buffer is not automatically displayed. If there is no output, or if output is inserted in the current buffer, then `*Shell Command Output*' is deleted. If the optional fourth argument OUTPUT-BUFFER is non-nil, that says to put the output in some other buffer. If OUTPUT-BUFFER is a buffer or buffer name, put the output there. If OUTPUT-BUFFER is not a buffer and not nil, insert output in the current buffer. In either case, the output is inserted after point (leaving mark after it)." (interactive (let ((string ;; Do this before calling region-beginning ;; and region-end, in case subprocess output ;; relocates them while we are in the minibuffer. (read-from-minibuffer "Shell command on region: " nil nil nil 'shell-command-history))) ;; call-interactively recognizes region-beginning and ;; region-end specially, leaving them in the history. (list (region-beginning) (region-end) string current-prefix-arg current-prefix-arg))) (if (or replace (and output-buffer (not (or (bufferp output-buffer) (stringp output-buffer))))) ;; Replace specified region with output from command. (let ((swap (and replace (< start end)))) ;; Don't muck with mark unless REPLACE says we should. (goto-char start) (and replace (push-mark)) (call-process-region start end shell-file-name t t nil shell-command-switch command) (let ((shell-buffer (get-buffer "*Shell Command Output*"))) (and shell-buffer (not (eq shell-buffer (current-buffer))) (kill-buffer shell-buffer))) ;; Don't muck with mark unless REPLACE says we should. (and replace swap (exchange-point-and-mark))) ;; No prefix argument: put the output in a temp buffer, ;; replacing its entire contents. (let ((buffer (get-buffer-create (or output-buffer "*Shell Command Output*"))) (success nil)) (unwind-protect (if (eq buffer (current-buffer)) ;; If the input is the same buffer as the output, ;; delete everything but the specified region, ;; then replace that region with the output. (progn (setq buffer-read-only nil) (delete-region (max start end) (point-max)) (delete-region (point-min) (max start end)) (call-process-region (point-min) (point-max) shell-file-name t t nil shell-command-switch command) (setq success t)) ;; Clear the output buffer, then run the command with output there. (save-excursion (set-buffer buffer) (setq buffer-read-only nil) (erase-buffer)) (call-process-region start end shell-file-name nil buffer nil shell-command-switch command) (setq success t)) ;; Report the amount of output. (let ((lines (save-excursion (set-buffer buffer) (if (= (buffer-size) 0) 0 (count-lines (point-min) (point-max)))))) (cond ((= lines 0) (if success (message "(Shell command completed with no output)")) (kill-buffer buffer)) ((and success (= lines 1)) (message "%s" (save-excursion (set-buffer buffer) (goto-char (point-min)) (buffer-substring (point) (progn (end-of-line) (point)))))) (t (set-window-start (display-buffer buffer) 1)))))))) (defconst universal-argument-map (let ((map (make-sparse-keymap))) (define-key map [t] 'universal-argument-other-key) (define-key map (vector meta-prefix-char t) 'universal-argument-other-key) (define-key map [switch-frame] nil) (define-key map [?\C-u] 'universal-argument-more) (define-key map [?-] 'universal-argument-minus) (define-key map [?0] 'digit-argument) (define-key map [?1] 'digit-argument) (define-key map [?2] 'digit-argument) (define-key map [?3] 'digit-argument) (define-key map [?4] 'digit-argument) (define-key map [?5] 'digit-argument) (define-key map [?6] 'digit-argument) (define-key map [?7] 'digit-argument) (define-key map [?8] 'digit-argument) (define-key map [?9] 'digit-argument) map) "Keymap used while processing \\[universal-argument].") (defvar universal-argument-num-events nil "Number of argument-specifying events read by `universal-argument'. `universal-argument-other-key' uses this to discard those events from (this-command-keys), and reread only the final command.") (defun universal-argument () "Begin a numeric argument for the following command. Digits or minus sign following \\[universal-argument] make up the numeric argument. \\[universal-argument] following the digits or minus sign ends the argument. \\[universal-argument] without digits or minus sign provides 4 as argument. Repeating \\[universal-argument] without digits or minus sign multiplies the argument by 4 each time." (interactive) (setq prefix-arg (list 4)) (setq universal-argument-num-events (length (this-command-keys))) (setq overriding-terminal-local-map universal-argument-map)) ;; A subsequent C-u means to multiply the factor by 4 if we've typed ;; nothing but C-u's; otherwise it means to terminate the prefix arg. (defun universal-argument-more (arg) (interactive "P") (if (consp arg) (setq prefix-arg (list (* 4 (car arg)))) (setq prefix-arg arg) (setq overriding-terminal-local-map nil)) (setq universal-argument-num-events (length (this-command-keys)))) (defun negative-argument (arg) "Begin a negative numeric argument for the next command. \\[universal-argument] following digits or minus sign ends the argument." (interactive "P") (cond ((integerp arg) (setq prefix-arg (- arg))) ((eq arg '-) (setq prefix-arg nil)) (t (setq prefix-arg '-))) (setq universal-argument-num-events (length (this-command-keys))) (setq overriding-terminal-local-map universal-argument-map)) (defun digit-argument (arg) "Part of the numeric argument for the next command. \\[universal-argument] following digits or minus sign ends the argument." (interactive "P") (let ((digit (- (logand last-command-char ?\177) ?0))) (cond ((integerp arg) (setq prefix-arg (+ (* arg 10) (if (< arg 0) (- digit) digit)))) ((eq arg '-) ;; Treat -0 as just -, so that -01 will work. (setq prefix-arg (if (zerop digit) '- (- digit)))) (t (setq prefix-arg digit)))) (setq universal-argument-num-events (length (this-command-keys))) (setq overriding-terminal-local-map universal-argument-map)) ;; For backward compatibility, minus with no modifiers is an ordinary ;; command if digits have already been entered. (defun universal-argument-minus (arg) (interactive "P") (if (integerp arg) (universal-argument-other-key arg) (negative-argument arg))) ;; Anything else terminates the argument and is left in the queue to be ;; executed as a command. (defun universal-argument-other-key (arg) (interactive "P") (setq prefix-arg arg) (let* ((key (this-command-keys)) (keylist (listify-key-sequence key))) (setq unread-command-events (append (nthcdr universal-argument-num-events keylist) unread-command-events))) (reset-this-command-lengths) (setq overriding-terminal-local-map nil)) (defun forward-to-indentation (arg) "Move forward ARG lines and position at first nonblank character." (interactive "p") (forward-line arg) (skip-chars-forward " \t")) (defun backward-to-indentation (arg) "Move backward ARG lines and position at first nonblank character." (interactive "p") (forward-line (- arg)) (skip-chars-forward " \t")) (defvar kill-whole-line nil "*If non-nil, `kill-line' with no arg at beg of line kills the whole line.") (defun kill-line (&optional arg) "Kill the rest of the current line; if no nonblanks there, kill thru newline. With prefix argument, kill that many lines from point. Negative arguments kill lines backward. When calling from a program, nil means \"no arg\", a number counts as a prefix arg. If `kill-whole-line' is non-nil, then kill the whole line when given no argument at the beginning of a line." (interactive "P") (kill-region (point) ;; It is better to move point to the other end of the kill ;; before killing. That way, in a read-only buffer, point ;; moves across the text that is copied to the kill ring. ;; The choice has no effect on undo now that undo records ;; the value of point from before the command was run. (progn (if arg (forward-line (prefix-numeric-value arg)) (if (eobp) (signal 'end-of-buffer nil)) (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp))) (forward-line 1) (end-of-line))) (point)))) ;;;; Window system cut and paste hooks. (defvar interprogram-cut-function nil "Function to call to make a killed region available to other programs. Most window systems provide some sort of facility for cutting and pasting text between the windows of different programs. This variable holds a function that Emacs calls whenever text is put in the kill ring, to make the new kill available to other programs. The function takes one or two arguments. The first argument, TEXT, is a string containing the text which should be made available. The second, PUSH, if non-nil means this is a \"new\" kill; nil means appending to an \"old\" kill.") (defvar interprogram-paste-function nil "Function to call to get text cut from other programs. Most window systems provide some sort of facility for cutting and pasting text between the windows of different programs. This variable holds a function that Emacs calls to obtain text that other programs have provided for pasting. The function should be called with no arguments. If the function returns nil, then no other program has provided such text, and the top of the Emacs kill ring should be used. If the function returns a string, that string should be put in the kill ring as the latest kill. Note that the function should return a string only if a program other than Emacs has provided a string for pasting; if Emacs provided the most recent string, the function should return nil. If it is difficult to tell whether Emacs or some other program provided the current string, it is probably good enough to return nil if the string is equal (according to `string=') to the last text Emacs provided.") ;;;; The kill ring data structure. (defvar kill-ring nil "List of killed text sequences. Since the kill ring is supposed to interact nicely with cut-and-paste facilities offered by window systems, use of this variable should interact nicely with `interprogram-cut-function' and `interprogram-paste-function'. The functions `kill-new', `kill-append', and `current-kill' are supposed to implement this interaction; you may want to use them instead of manipulating the kill ring directly.") (defconst kill-ring-max 30 "*Maximum length of kill ring before oldest elements are thrown away.") (defvar kill-ring-yank-pointer nil "The tail of the kill ring whose car is the last thing yanked.") (defun kill-new (string &optional replace) "Make STRING the latest kill in the kill ring. Set the kill-ring-yank pointer to point to it. If `interprogram-cut-function' is non-nil, apply it to STRING. Optional second argument REPLACE non-nil means that STRING will replace the front of the kill ring, rather than being added to the list." (and (fboundp 'menu-bar-update-yank-menu) (menu-bar-update-yank-menu string (and replace (car kill-ring)))) (if replace (setcar kill-ring string) (setq kill-ring (cons string kill-ring)) (if (> (length kill-ring) kill-ring-max) (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))) (setq kill-ring-yank-pointer kill-ring) (if interprogram-cut-function (funcall interprogram-cut-function string (not replace)))) (defun kill-append (string before-p) "Append STRING to the end of the latest kill in the kill ring. If BEFORE-P is non-nil, prepend STRING to the kill. If `interprogram-cut-function' is set, pass the resulting kill to it." (kill-new (if before-p (concat string (car kill-ring)) (concat (car kill-ring) string)) t)) (defun current-kill (n &optional do-not-move) "Rotate the yanking point by N places, and then return that kill. If N is zero, `interprogram-paste-function' is set, and calling it returns a string, then that string is added to the front of the kill ring and returned as the latest kill. If optional arg DO-NOT-MOVE is non-nil, then don't actually move the yanking point; just return the Nth kill forward." (let ((interprogram-paste (and (= n 0) interprogram-paste-function (funcall interprogram-paste-function)))) (if interprogram-paste (progn ;; Disable the interprogram cut function when we add the new ;; text to the kill ring, so Emacs doesn't try to own the ;; selection, with identical text. (let ((interprogram-cut-function nil)) (kill-new interprogram-paste)) interprogram-paste) (or kill-ring (error "Kill ring is empty")) (let ((ARGth-kill-element (nthcdr (mod (- n (length kill-ring-yank-pointer)) (length kill-ring)) kill-ring))) (or do-not-move (setq kill-ring-yank-pointer ARGth-kill-element)) (car ARGth-kill-element))))) ;;;; Commands for manipulating the kill ring. (defvar kill-read-only-ok nil "*Non-nil means don't signal an error for killing read-only text.") (defun kill-region (beg end) "Kill between point and mark. The text is deleted but saved in the kill ring. The command \\[yank] can retrieve it from there. \(If you want to kill and then yank immediately, use \\[copy-region-as-kill].) If the buffer is read-only, Emacs will beep and refrain from deleting the text, but put the text in the kill ring anyway. This means that you can use the killing commands to copy text from a read-only buffer. This is the primitive for programs to kill text (as opposed to deleting it). Supply two arguments, character numbers indicating the stretch of text to be killed. Any command that calls this function is a \"kill command\". If the previous command was also a kill command, the text killed this time appends to the text killed last time to make one entry in the kill ring." (interactive "r") (cond ;; If the buffer is read-only, we should beep, in case the person ;; just isn't aware of this. However, there's no harm in putting ;; the region's text in the kill ring, anyway. ((or (and buffer-read-only (not inhibit-read-only)) (text-property-not-all beg end 'read-only nil)) (copy-region-as-kill beg end) ;; This should always barf, and give us the correct error. (if kill-read-only-ok (message "Read only text copied to kill ring") (setq this-command 'kill-region) (barf-if-buffer-read-only))) ;; In certain cases, we can arrange for the undo list and the kill ;; ring to share the same string object. This code does that. ((not (or (eq buffer-undo-list t) (eq last-command 'kill-region) ;; Use = since positions may be numbers or markers. (= beg end))) ;; Don't let the undo list be truncated before we can even access it. (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100)) (old-list buffer-undo-list) tail) (delete-region beg end) ;; Search back in buffer-undo-list for this string, ;; in case a change hook made property changes. (setq tail buffer-undo-list) (while (not (stringp (car (car tail)))) (setq tail (cdr tail))) ;; Take the same string recorded for undo ;; and put it in the kill-ring. (kill-new (car (car tail))))) (t (copy-region-as-kill beg end) (delete-region beg end))) (setq this-command 'kill-region)) ;; copy-region-as-kill no longer sets this-command, because it's confusing ;; to get two copies of the text when the user accidentally types M-w and ;; then corrects it with the intended C-w. (defun copy-region-as-kill (beg end) "Save the region as if killed, but don't kill it. If `interprogram-cut-function' is non-nil, also save the text for a window system cut and paste." (interactive "r") (if (eq last-command 'kill-region) (kill-append (buffer-substring beg end) (< end beg)) (kill-new (buffer-substring beg end))) nil) (defun kill-ring-save (beg end) "Save the region as if killed, but don't kill it. This command is similar to `copy-region-as-kill', except that it gives visual feedback indicating the extent of the region being copied. If `interprogram-cut-function' is non-nil, also save the text for a window system cut and paste." (interactive "r") (copy-region-as-kill beg end) (if (interactive-p) (let ((other-end (if (= (point) beg) end beg)) (opoint (point)) ;; Inhibit quitting so we can make a quit here ;; look like a C-g typed as a command. (inhibit-quit t)) (if (pos-visible-in-window-p other-end (selected-window)) (progn ;; Swap point and mark. (set-marker (mark-marker) (point) (current-buffer)) (goto-char other-end) (sit-for 1) ;; Swap back. (set-marker (mark-marker) other-end (current-buffer)) (goto-char opoint) ;; If user quit, deactivate the mark ;; as C-g would as a command. (and quit-flag mark-active (deactivate-mark))) (let* ((killed-text (current-kill 0)) (message-len (min (length killed-text) 40))) (if (= (point) beg) ;; Don't say "killed"; that is misleading. (message "Saved text until \"%s\"" (substring killed-text (- message-len))) (message "Saved text from \"%s\"" (substring killed-text 0 message-len)))))))) (defun append-next-kill () "Cause following command, if it kills, to append to previous kill." (interactive) (if (interactive-p) (progn (setq this-command 'kill-region) (message "If the next command is a kill, it will append")) (setq last-command 'kill-region))) (defun yank-pop (arg) "Replace just-yanked stretch of killed text with a different stretch. This command is allowed only immediately after a `yank' or a `yank-pop'. At such a time, the region contains a stretch of reinserted previously-killed text. `yank-pop' deletes that text and inserts in its place a different stretch of killed text. With no argument, the previous kill is inserted. With argument N, insert the Nth previous kill. If N is negative, this is a more recent kill. The sequence of kills wraps around, so that after the oldest one comes the newest one." (interactive "*p") (if (not (eq last-command 'yank)) (error "Previous command was not a yank")) (setq this-command 'yank) (let ((before (< (point) (mark t)))) (delete-region (point) (mark t)) (set-marker (mark-marker) (point) (current-buffer)) (insert (current-kill arg)) (if before ;; This is like exchange-point-and-mark, but doesn't activate the mark. ;; It is cleaner to avoid activation, even though the command ;; loop would deactivate the mark because we inserted text. (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) (current-buffer)))))) nil) (defun yank (&optional arg) "Reinsert the last stretch of killed text. More precisely, reinsert the stretch of killed text most recently killed OR yanked. Put point at end, and set mark at beginning. With just C-u as argument, same but put point at beginning (and mark at end). With argument N, reinsert the Nth most recently killed stretch of killed text. See also the command \\[yank-pop]." (interactive "*P") ;; If we don't get all the way thru, make last-command indicate that ;; for the following command. (setq this-command t) (push-mark (point)) (insert (current-kill (cond ((listp arg) 0) ((eq arg '-) -1) (t (1- arg))))) (if (consp arg) ;; This is like exchange-point-and-mark, but doesn't activate the mark. ;; It is cleaner to avoid activation, even though the command ;; loop would deactivate the mark because we inserted text. (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) (current-buffer))))) ;; If we do get all the way thru, make this-command indicate that. (setq this-command 'yank) nil) (defun rotate-yank-pointer (arg) "Rotate the yanking point in the kill ring. With argument, rotate that many kills forward (or backward, if negative)." (interactive "p") (current-kill arg)) (defun insert-buffer (buffer) "Insert after point the contents of BUFFER. Puts mark after the inserted text. BUFFER may be a buffer or a buffer name." (interactive (list (progn (barf-if-buffer-read-only) (read-buffer "Insert buffer: " (other-buffer (current-buffer) t) t)))) (or (bufferp buffer) (setq buffer (get-buffer buffer))) (let (start end newmark) (save-excursion (save-excursion (set-buffer buffer) (setq start (point-min) end (point-max))) (insert-buffer-substring buffer start end) (setq newmark (point))) (push-mark newmark)) nil) (defun append-to-buffer (buffer start end) "Append to specified buffer the text of the region. It is inserted into that buffer before its point. When calling from a program, give three arguments: BUFFER (or buffer name), START and END. START and END specify the portion of the current buffer to be copied." (interactive (list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t)) (region-beginning) (region-end))) (let ((oldbuf (current-buffer))) (save-excursion (set-buffer (get-buffer-create buffer)) (insert-buffer-substring oldbuf start end)))) (defun prepend-to-buffer (buffer start end) "Prepend to specified buffer the text of the region. It is inserted into that buffer after its point. When calling from a program, give three arguments: BUFFER (or buffer name), START and END. START and END specify the portion of the current buffer to be copied." (interactive "BPrepend to buffer: \nr") (let ((oldbuf (current-buffer))) (save-excursion (set-buffer (get-buffer-create buffer)) (save-excursion (insert-buffer-substring oldbuf start end))))) (defun copy-to-buffer (buffer start end) "Copy to specified buffer the text of the region. It is inserted into that buffer, replacing existing text there. When calling from a program, give three arguments: BUFFER (or buffer name), START and END. START and END specify the portion of the current buffer to be copied." (interactive "BCopy to buffer: \nr") (let ((oldbuf (current-buffer))) (save-excursion (set-buffer (get-buffer-create buffer)) (erase-buffer) (save-excursion (insert-buffer-substring oldbuf start end))))) (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. If optional argument FORCE is non-nil, access the mark value even if the mark is not currently active, and return nil if there is no mark at all. If you are using this in an editing command, you are most likely making a mistake; see the documentation of `set-mark'." (if (or force (not transient-mark-mode) 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. \(That makes a difference only in Transient Mark mode.) Also runs the hook `deactivate-mark-hook'." (if transient-mark-mode (progn (setq mark-active nil) (run-hooks 'deactivate-mark-hook)))) (defun set-mark (pos) "Set this buffer's mark to POS. Don't use this function! That is to say, don't use this function unless you want the user to see that the mark has moved, and you want the previous mark position to be lost. Normally, when a new mark is set, the old one should go on the stack. This is why most applications should use push-mark, not set-mark. Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. The mark saves a location for the user's convenience. Most editing commands should not alter the mark. To remember a location for internal use in the Lisp program, store it in a Lisp variable. Example: (let ((beg (point))) (forward-line 1) (delete-region beg (point)))." (if pos (progn (setq mark-active t) (run-hooks 'activate-mark-hook) (set-marker (mark-marker) pos (current-buffer))) ;; Normally we never clear mark-active except in Transient Mark mode. ;; But when we actually clear out the mark value too, ;; we must clear mark-active in any mode. (setq mark-active nil) (run-hooks 'deactivate-mark-hook) (set-marker (mark-marker) nil))) (defvar mark-ring nil "The list of former marks of the current buffer, most recent first.") (make-variable-buffer-local 'mark-ring) (put 'mark-ring 'permanent-local t) (defconst mark-ring-max 16 "*Maximum size of mark ring. Start discarding off end if gets this big.") (defvar global-mark-ring nil "The list of saved global marks, most recent first.") (defconst global-mark-ring-max 16 "*Maximum size of global mark ring. \ Start discarding off end if gets this big.") (defun set-mark-command (arg) "Set mark at where point is, or jump to mark. With no prefix argument, set mark, push old mark position on local mark ring, and push mark on global mark ring. With argument, jump to mark, and pop a new position for mark off the ring \(does not affect global mark ring\). Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. See the documentation of `set-mark' for more information." (interactive "P") (if (null arg) (progn (push-mark nil nil t)) (if (null (mark t)) (error "No mark set in this buffer") (goto-char (mark t)) (pop-mark)))) (defun push-mark (&optional location nomsg activate) "Set mark at LOCATION (point, by default) and push old mark on mark ring. If the last global mark pushed was not in the current buffer, also push LOCATION on the global mark ring. Display `Mark set' unless the optional second arg NOMSG is non-nil. In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil. Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. See the documentation of `set-mark' for more information. In Transient Mark mode, this does not activate the mark." (if (null (mark t)) nil (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) (if (> (length mark-ring) mark-ring-max) (progn (move-marker (car (nthcdr mark-ring-max mark-ring)) nil) (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))) (set-marker (mark-marker) (or location (point)) (current-buffer)) ;; Now push the mark on the global mark ring. (if (and global-mark-ring (eq (marker-buffer (car global-mark-ring)) (current-buffer))) ;; The last global mark pushed was in this same buffer. ;; Don't push another one. nil (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring)) (if (> (length global-mark-ring) global-mark-ring-max) (progn (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil) (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))) (or nomsg executing-macro (> (minibuffer-depth) 0) (message "Mark set")) (if (or activate (not transient-mark-mode)) (set-mark (mark t))) nil) (defun pop-mark () "Pop off mark ring into the buffer's actual mark. Does not set point. Does nothing if mark ring is empty." (if mark-ring (progn (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)) (setq mark-ring (cdr mark-ring))))) (define-function 'exchange-dot-and-mark 'exchange-point-and-mark) (defun exchange-point-and-mark () "Put the mark where point is now, and point where the mark is now. This command works even when the mark is not active, and it reactivates the mark." (interactive nil) (let ((omark (mark t))) (if (null omark) (error "No mark set in this buffer")) (set-mark (point)) (goto-char omark) nil)) (defun transient-mark-mode (arg) "Toggle Transient Mark mode. With arg, turn Transient Mark mode on if arg is positive, off otherwise. In Transient Mark mode, when the mark is active, the region is highlighted. Changing the buffer \"deactivates\" the mark. So do certain other operations that set the mark but whose main purpose is something else--for example, incremental search, \\[beginning-of-buffer], and \\[end-of-buffer]." (interactive "P") (setq transient-mark-mode (if (null arg) (not transient-mark-mode) (> (prefix-numeric-value arg) 0)))) (defun pop-global-mark () "Pop off global mark ring and jump to the top location." (interactive) ;; Pop entries which refer to non-existent buffers. (while (and global-mark-ring (not (marker-buffer (car global-mark-ring)))) (setq global-mark-ring (cdr global-mark-ring))) (or global-mark-ring (error "No global mark set")) (let* ((marker (car global-mark-ring)) (buffer (marker-buffer marker)) (position (marker-position marker))) (setq global-mark-ring (nconc (cdr global-mark-ring) (list (car global-mark-ring)))) (set-buffer buffer) (or (and (>= position (point-min)) (<= position (point-max))) (widen)) (goto-char position) (switch-to-buffer buffer))) (defvar next-line-add-newlines t "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error.") (defun next-line (arg) "Move cursor vertically down ARG lines. If there is no character in the target line exactly under the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. If there is no line in the buffer after this one, behavior depends on the value of `next-line-add-newlines'. If non-nil, it inserts a newline character to create a line, and moves the cursor to that line. Otherwise it moves the cursor to the end of the buffer. The command \\[set-goal-column] can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically. This goal column is stored in `goal-column', which is nil when there is none. If you are thinking of using this in a Lisp program, consider using `forward-line' instead. It is usually easier to use and more reliable (no dependence on goal column, etc.)." (interactive "p") (if (and next-line-add-newlines (= arg 1)) (let ((opoint (point))) (end-of-line) (if (eobp) (newline 1) (goto-char opoint) (line-move arg))) (if (interactive-p) (condition-case nil (line-move arg) ((beginning-of-buffer end-of-buffer) (ding))) (line-move arg))) nil) (defun previous-line (arg) "Move cursor vertically up ARG lines. If there is no character in the target line exactly over the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. The command \\[set-goal-column] can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically. If you are thinking of using this in a Lisp program, consider using `forward-line' with a negative argument instead. It is usually easier to use and more reliable (no dependence on goal column, etc.)." (interactive "p") (if (interactive-p) (condition-case nil (line-move (- arg)) ((beginning-of-buffer end-of-buffer) (ding))) (line-move (- arg))) nil) (defconst track-eol nil "*Non-nil means vertical motion starting at end of line keeps to ends of lines. This means moving to the end of each line moved onto. The beginning of a blank line does not count as the end of a line.") (defvar goal-column nil "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil.") (make-variable-buffer-local 'goal-column) (defvar temporary-goal-column 0 "Current goal column for vertical motion. It is the column where point was at the start of current run of vertical motion commands. When the `track-eol' feature is doing its job, the value is 9999.") (defvar line-move-ignore-invisible nil "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines. Outline mode sets this.") ;; This is the guts of next-line and previous-line. ;; Arg says how many lines to move. (defun line-move (arg) ;; Don't run any point-motion hooks, and disregard intangibility, ;; for intermediate positions. (let ((inhibit-point-motion-hooks t) (opoint (point)) new) (unwind-protect (progn (if (not (or (eq last-command 'next-line) (eq last-command 'previous-line))) (setq temporary-goal-column (if (and track-eol (eolp) ;; Don't count beg of empty line as end of line ;; unless we just did explicit end-of-line. (or (not (bolp)) (eq last-command 'end-of-line))) 9999 (current-column)))) (if (and (not (integerp selective-display)) (not line-move-ignore-invisible)) ;; Use just newline characters. (or (if (> arg 0) (progn (if (> arg 1) (forward-line (1- arg))) ;; This way of moving forward ARG lines ;; verifies that we have a newline after the last one. ;; It doesn't get confused by intangible text. (end-of-line) (zerop (forward-line 1))) (and (zerop (forward-line arg)) (bolp))) (signal (if (< arg 0) 'beginning-of-buffer 'end-of-buffer) nil)) ;; Move by arg lines, but ignore invisible ones. (while (> arg 0) (end-of-line) (and (zerop (vertical-motion 1)) (signal 'end-of-buffer nil)) ;; If the following character is currently invisible, ;; skip all characters with that same `invisible' property value. (while (and (not (eobp)) (let ((prop (get-char-property (point) 'invisible))) (if (eq buffer-invisibility-spec t) prop (or (memq prop buffer-invisibility-spec) (assq prop buffer-invisibility-spec))))) (if (get-text-property (point) 'invisible) (goto-char (next-single-property-change (point) 'invisible)) (goto-char (next-overlay-change (point))))) (setq arg (1- arg))) (while (< arg 0) (beginning-of-line) (and (zerop (vertical-motion -1)) (signal 'beginning-of-buffer nil)) (while (and (not (bobp)) (let ((prop (get-char-property (1- (point)) 'invisible))) (if (eq buffer-invisibility-spec t) prop (or (memq prop buffer-invisibility-spec) (assq prop buffer-invisibility-spec))))) (if (get-text-property (1- (point)) 'invisible) (goto-char (previous-single-property-change (point) 'invisible)) (goto-char (previous-overlay-change (point))))) (setq arg (1+ arg)))) (move-to-column (or goal-column temporary-goal-column))) ;; Remember where we moved to, go back home, ;; then do the motion over again ;; in just one step, with intangibility and point-motion hooks ;; enabled this time. (setq new (point)) (goto-char opoint) (setq inhibit-point-motion-hooks nil) (goto-char new))) nil) ;;; Many people have said they rarely use this feature, and often type ;;; it by accident. Maybe it shouldn't even be on a key. (put 'set-goal-column 'disabled t) (defun set-goal-column (arg) "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line]. Those commands will move to this position in the line moved to rather than trying to keep the same horizontal position. With a non-nil argument, clears out the goal column so that \\[next-line] and \\[previous-line] resume vertical motion. The goal column is stored in the variable `goal-column'." (interactive "P") (if arg (progn (setq goal-column nil) (message "No goal column")) (setq goal-column (current-column)) (message (substitute-command-keys "Goal column %d (use \\[set-goal-column] with an arg to unset it)") goal-column)) nil) ;;; Partial support for horizontal autoscrolling. Someday, this feature ;;; will be built into the C level and all the (hscroll-point-visible) calls ;;; will go away. (defvar hscroll-step 0 "*The number of columns to try scrolling a window by when point moves out. If that fails to bring point back on frame, point is centered instead. If this is zero, point is always centered after it moves off frame.") (defun hscroll-point-visible () "Scrolls the selected window horizontally to make point visible." (save-excursion (set-buffer (window-buffer)) (if (not (or truncate-lines (> (window-hscroll) 0) (and truncate-partial-width-windows (< (window-width) (frame-width))))) ;; Point is always visible when lines are wrapped. () ;; If point is on the invisible part of the line before window-start, ;; then hscrolling can't bring it back, so reset window-start first. (and (< (point) (window-start)) (let ((ws-bol (save-excursion (goto-char (window-start)) (beginning-of-line) (point)))) (and (>= (point) ws-bol) (set-window-start nil ws-bol)))) (let* ((here (hscroll-window-column)) (left (min (window-hscroll) 1)) (right (1- (window-width)))) ;; Allow for the truncation glyph, if we're not exactly at eol. (if (not (and (= here right) (= (following-char) ?\n))) (setq right (1- right))) (cond ;; If too far away, just recenter. But don't show too much ;; white space off the end of the line. ((or (< here (- left hscroll-step)) (> here (+ right hscroll-step))) (let ((eol (save-excursion (end-of-line) (hscroll-window-column)))) (scroll-left (min (- here (/ (window-width) 2)) (- eol (window-width) -5))))) ;; Within range. Scroll by one step (or maybe not at all). ((< here left) (scroll-right hscroll-step)) ((> here right) (scroll-left hscroll-step))))))) ;; This function returns the window's idea of the display column of point, ;; assuming that the window is already known to be truncated rather than ;; wrapped, and that we've already handled the case where point is on the ;; part of the line before window-start. We ignore window-width; if point ;; is beyond the right margin, we want to know how far. The return value ;; includes the effects of window-hscroll, window-start, and the prompt ;; string in the minibuffer. It may be negative due to hscroll. (defun hscroll-window-column () (let* ((hscroll (window-hscroll)) (startpos (save-excursion (beginning-of-line) (if (= (point) (save-excursion (goto-char (window-start)) (beginning-of-line) (point))) (goto-char (window-start))) (point))) (hpos (+ (if (and (eq (selected-window) (minibuffer-window)) (= 1 (window-start)) (= startpos (point-min))) (minibuffer-prompt-width) 0) (min 0 (- 1 hscroll)))) val) (car (cdr (compute-motion startpos (cons hpos 0) (point) (cons 0 1) 1000000 (cons hscroll 0) nil))))) ;; rms: (1) The definitions of arrow keys should not simply restate ;; what keys they are. The arrow keys should run the ordinary commands. ;; (2) The arrow keys are just one of many common ways of moving point ;; within a line. Real horizontal autoscrolling would be a good feature, ;; but supporting it only for arrow keys is too incomplete to be desirable. ;;;;; Make arrow keys do the right thing for improved terminal support ;;;;; When we implement true horizontal autoscrolling, right-arrow and ;;;;; left-arrow can lose the (if truncate-lines ...) clause and become ;;;;; aliases. These functions are bound to the corresponding keyboard ;;;;; events in loaddefs.el. ;;(defun right-arrow (arg) ;; "Move right one character on the screen (with prefix ARG, that many chars). ;;Scroll right if needed to keep point horizontally onscreen." ;; (interactive "P") ;; (forward-char arg) ;; (hscroll-point-visible)) ;;(defun left-arrow (arg) ;; "Move left one character on the screen (with prefix ARG, that many chars). ;;Scroll left if needed to keep point horizontally onscreen." ;; (interactive "P") ;; (backward-char arg) ;; (hscroll-point-visible)) (defun scroll-other-window-down (lines) "Scroll the \"other window\" down. For more details, see the documentation for `scroll-other-window'." (interactive "P") (scroll-other-window ;; Just invert the argument's meaning. ;; We can do that without knowing which window it will be. (if (eq lines '-) nil (if (null lines) '- (- (prefix-numeric-value lines)))))) (define-key esc-map [?\C-\S-v] 'scroll-other-window-down) (defun beginning-of-buffer-other-window (arg) "Move point to the beginning of the buffer in the other window. Leave mark at previous position. With arg N, put point N/10 of the way from the true beginning." (interactive "P") (let ((orig-window (selected-window)) (window (other-window-for-scrolling))) ;; We use unwind-protect rather than save-window-excursion ;; because the latter would preserve the things we want to change. (unwind-protect (progn (select-window window) ;; Set point and mark in that window's buffer. (beginning-of-buffer arg) ;; Set point accordingly. (recenter '(t))) (select-window orig-window)))) (defun end-of-buffer-other-window (arg) "Move point to the end of the buffer in the other window. Leave mark at previous position. With arg N, put point N/10 of the way from the true end." (interactive "P") ;; See beginning-of-buffer-other-window for comments. (let ((orig-window (selected-window)) (window (other-window-for-scrolling))) (unwind-protect (progn (select-window window) (end-of-buffer arg) (recenter '(t))) (select-window orig-window)))) (defun transpose-chars (arg) "Interchange characters around point, moving forward one character. With prefix arg ARG, effect is to take character before point and drag it forward past ARG other characters (backward if ARG negative). If no argument and at end of line, the previous two chars are exchanged." (interactive "*P") (and (null arg) (eolp) (forward-char -1)) (transpose-subr 'forward-char (prefix-numeric-value arg))) (defun transpose-words (arg) "Interchange words around point, leaving point at end of them. With prefix arg ARG, effect is to take word before or around point and drag it forward past ARG other words (backward if ARG negative). If ARG is zero, the words around or after point and around or after mark are interchanged." (interactive "*p") (transpose-subr 'forward-word arg)) (defun transpose-sexps (arg) "Like \\[transpose-words] but applies to sexps. Does not work on a sexp that point is in the middle of if it is a list or string." (interactive "*p") (transpose-subr 'forward-sexp arg)) (defun transpose-lines (arg) "Exchange current line and previous line, leaving point after both. With argument ARG, takes previous line and moves it past ARG lines. With argument 0, interchanges line point is in with line mark is in." (interactive "*p") (transpose-subr (function (lambda (arg) (if (= arg 1) (progn ;; Move forward over a line, ;; but create a newline if none exists yet. (end-of-line) (if (eobp) (newline) (forward-char 1))) (forward-line arg)))) arg)) (defun transpose-subr (mover arg) (let (start1 end1 start2 end2) (if (= arg 0) (progn (save-excursion (funcall mover 1) (setq end2 (point)) (funcall mover -1) (setq start2 (point)) (goto-char (mark)) (funcall mover 1) (setq end1 (point)) (funcall mover -1) (setq start1 (point)) (transpose-subr-1)) (exchange-point-and-mark))) (while (> arg 0) (funcall mover -1) (setq start1 (point)) (funcall mover 1) (setq end1 (point)) (funcall mover 1) (setq end2 (point)) (funcall mover -1) (setq start2 (point)) (transpose-subr-1) (goto-char end2) (setq arg (1- arg))) (while (< arg 0) (funcall mover -1) (setq start2 (point)) (funcall mover -1) (setq start1 (point)) (funcall mover 1) (setq end1 (point)) (funcall mover 1) (setq end2 (point)) (transpose-subr-1) (setq arg (1+ arg))))) (defun transpose-subr-1 () (if (> (min end1 end2) (max start1 start2)) (error "Don't have two things to transpose")) (let ((word1 (buffer-substring start1 end1)) (word2 (buffer-substring start2 end2))) (delete-region start2 end2) (goto-char start2) (insert word1) (goto-char (if (< start1 start2) start1 (+ start1 (- (length word1) (length word2))))) (delete-char (length word1)) (insert word2))) (defconst comment-column 32 "*Column to indent right-margin comments to. Setting this variable automatically makes it local to the current buffer. Each mode establishes a different default value for this variable; you can set the value for a particular mode using that mode's hook.") (make-variable-buffer-local 'comment-column) (defconst comment-start nil "*String to insert to start a new comment, or nil if no comment syntax.") (defconst comment-start-skip nil "*Regexp to match the start of a comment plus everything up to its body. If there are any \\(...\\) pairs, the comment delimiter text is held to begin at the place matched by the close of the first pair.") (defconst comment-end "" "*String to insert to end a new comment. Should be an empty string if comments are terminated by end-of-line.") (defconst comment-indent-hook nil "Obsolete variable for function to compute desired indentation for a comment. This function is called with no args with point at the beginning of the comment's starting delimiter.") (defconst comment-indent-function '(lambda () comment-column) "Function to compute desired indentation for a comment. This function is called with no args with point at the beginning of the comment's starting delimiter.") (defconst block-comment-start nil "*String to insert to start a new comment on a line by itself. If nil, use `comment-start' instead. Note that the regular expression `comment-start-skip' should skip this string as well as the `comment-start' string.") (defconst block-comment-end nil "*String to insert to end a new comment on a line by itself. Should be an empty string if comments are terminated by end-of-line. If nil, use `comment-end' instead.") (defun indent-for-comment () "Indent this line's comment to comment column, or insert an empty comment." (interactive "*") (let* ((empty (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))) (starter (or (and empty block-comment-start) comment-start)) (ender (or (and empty block-comment-end) comment-end))) (if (null starter) (error "No comment syntax defined") (let* ((eolpos (save-excursion (end-of-line) (point))) cpos indent begpos) (beginning-of-line) (if (re-search-forward comment-start-skip eolpos 'move) (progn (setq cpos (point-marker)) ;; Find the start of the comment delimiter. ;; If there were paren-pairs in comment-start-skip, ;; position at the end of the first pair. (if (match-end 1) (goto-char (match-end 1)) ;; If comment-start-skip matched a string with ;; internal whitespace (not final whitespace) then ;; the delimiter start at the end of that ;; whitespace. Otherwise, it starts at the ;; beginning of what was matched. (skip-syntax-backward " " (match-beginning 0)) (skip-syntax-backward "^ " (match-beginning 0))))) (setq begpos (point)) ;; Compute desired indent. (if (= (current-column) (setq indent (if comment-indent-hook (funcall comment-indent-hook) (funcall comment-indent-function)))) (goto-char begpos) ;; If that's different from current, change it. (skip-chars-backward " \t") (delete-region (point) begpos) (indent-to indent)) ;; An existing comment? (if cpos (progn (goto-char cpos) (set-marker cpos nil)) ;; No, insert one. (insert starter) (save-excursion (insert ender))))))) (defun set-comment-column (arg) "Set the comment column based on point. With no arg, set the comment column to the current column. With just minus as arg, kill any comment on this line. With any other arg, set comment column to indentation of the previous comment and then align or create a comment on this line at that column." (interactive "P") (if (eq arg '-) (kill-comment nil) (if arg (progn (save-excursion (beginning-of-line) (re-search-backward comment-start-skip) (beginning-of-line) (re-search-forward comment-start-skip) (goto-char (match-beginning 0)) (setq comment-column (current-column)) (message "Comment column set to %d" comment-column)) (indent-for-comment)) (setq comment-column (current-column)) (message "Comment column set to %d" comment-column)))) (defun kill-comment (arg) "Kill the comment on this line, if any. With argument, kill comments on that many lines starting with this one." ;; this function loses in a lot of situations. it incorrectly recognises ;; comment delimiters sometimes (ergo, inside a string), doesn't work ;; with multi-line comments, can kill extra whitespace if comment wasn't ;; through end-of-line, et cetera. (interactive "P") (or comment-start-skip (error "No comment syntax defined")) (let ((count (prefix-numeric-value arg)) endc) (while (> count 0) (save-excursion (end-of-line) (setq endc (point)) (beginning-of-line) (and (string< "" comment-end) (setq endc (progn (re-search-forward (regexp-quote comment-end) endc 'move) (skip-chars-forward " \t") (point)))) (beginning-of-line) (if (re-search-forward comment-start-skip endc t) (progn (goto-char (match-beginning 0)) (skip-chars-backward " \t") (kill-region (point) endc) ;; to catch comments a line beginnings (indent-according-to-mode)))) (if arg (forward-line 1)) (setq count (1- count))))) (defun comment-region (beg end &optional arg) "Comment or uncomment each line in the region. With just C-u prefix arg, uncomment each line in region. Numeric prefix arg ARG means use ARG comment characters. If ARG is negative, delete that many comment characters instead. Comments are terminated on each line, even for syntax in which newline does not end the comment. Blank lines do not get comments." ;; if someone wants it to only put a comment-start at the beginning and ;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x ;; is easy enough. No option is made here for other than commenting ;; every line. (interactive "r\nP") (or comment-start (error "No comment syntax is defined")) (if (> beg end) (let (mid) (setq mid beg beg end end mid))) (save-excursion (save-restriction (let ((cs comment-start) (ce comment-end) numarg) (if (consp arg) (setq numarg t) (setq numarg (prefix-numeric-value arg)) ;; For positive arg > 1, replicate the comment delims now, ;; then insert the replicated strings just once. (while (> numarg 1) (setq cs (concat cs comment-start) ce (concat ce comment-end)) (setq numarg (1- numarg)))) ;; Loop over all lines from BEG to END. (narrow-to-region beg end) (goto-char beg) (while (not (eobp)) (if (or (eq numarg t) (< numarg 0)) (progn ;; Delete comment start from beginning of line. (if (eq numarg t) (while (looking-at (regexp-quote cs)) (delete-char (length cs))) (let ((count numarg)) (while (and (> 1 (setq count (1+ count))) (looking-at (regexp-quote cs))) (delete-char (length cs))))) ;; Delete comment end from end of line. (if (string= "" ce) nil (if (eq numarg t) (progn (end-of-line) ;; This is questionable if comment-end ends in ;; whitespace. That is pretty brain-damaged, ;; though. (skip-chars-backward " \t") (if (and (>= (- (point) (point-min)) (length ce)) (save-excursion (backward-char (length ce)) (looking-at (regexp-quote ce)))) (delete-char (- (length ce))))) (let ((count numarg)) (while (> 1 (setq count (1+ count))) (end-of-line) ;; this is questionable if comment-end ends in whitespace ;; that is pretty brain-damaged though (skip-chars-backward " \t") (save-excursion (backward-char (length ce)) (if (looking-at (regexp-quote ce)) (delete-char (length ce)))))))) (forward-line 1)) ;; Insert at beginning and at end. (if (looking-at "[ \t]*$") () (insert cs) (if (string= "" ce) () (end-of-line) (insert ce))) (search-forward "\n" nil 'move))))))) (defun backward-word (arg) "Move backward until encountering the end of a word. With argument, do this that many times. In programs, it is faster to call `forward-word' with negative arg." (interactive "p") (forward-word (- arg))) (defun mark-word (arg) "Set mark arg words away from point." (interactive "p") (push-mark (save-excursion (forward-word arg) (point)) nil t)) (defun kill-word (arg) "Kill characters forward until encountering the end of a word. With argument, do this that many times." (interactive "p") (kill-region (point) (progn (forward-word arg) (point)))) (defun backward-kill-word (arg) "Kill characters backward until encountering the end of a word. With argument, do this that many times." (interactive "p") (kill-word (- arg))) (defun current-word (&optional strict) "Return the word point is on (or a nearby word) as a string. If optional arg STRICT is non-nil, return nil unless point is within or adjacent to a word." (save-excursion (let ((oldpoint (point)) (start (point)) (end (point))) (skip-syntax-backward "w_") (setq start (point)) (goto-char oldpoint) (skip-syntax-forward "w_") (setq end (point)) (if (and (eq start oldpoint) (eq end oldpoint)) ;; Point is neither within nor adjacent to a word. (and (not strict) (progn ;; Look for preceding word in same line. (skip-syntax-backward "^w_" (save-excursion (beginning-of-line) (point))) (if (bolp) ;; No preceding word in same line. ;; Look for following word in same line. (progn (skip-syntax-forward "^w_" (save-excursion (end-of-line) (point))) (setq start (point)) (skip-syntax-forward "w_") (setq end (point))) (setq end (point)) (skip-syntax-backward "w_") (setq start (point))) (buffer-substring start end))) (buffer-substring start end))))) (defconst fill-prefix nil "*String for filling to insert at front of new line, or nil for none. Setting this variable automatically makes it local to the current buffer.") (make-variable-buffer-local 'fill-prefix) (defconst auto-fill-inhibit-regexp nil "*Regexp to match lines which should not be auto-filled.") (defun do-auto-fill () (let (fc justify bol give-up (fill-prefix fill-prefix)) (if (or (not (setq justify (current-justification))) (null (setq fc (current-fill-column))) (and (eq justify 'left) (<= (current-column) fc)) (save-excursion (beginning-of-line) (setq bol (point)) (and auto-fill-inhibit-regexp (looking-at auto-fill-inhibit-regexp)))) nil ;; Auto-filling not required (if (memq justify '(full center right)) (save-excursion (unjustify-current-line))) ;; Choose a fill-prefix automatically. (if (and adaptive-fill-mode (or (null fill-prefix) (string= fill-prefix ""))) (let ((prefix (fill-context-prefix (save-excursion (backward-paragraph 1) (point)) (save-excursion (forward-paragraph 1) (point)) ;; Don't accept a non-whitespace fill prefix ;; from the first line of a paragraph. "^[ \t]*$"))) (and prefix (not (equal prefix "")) (setq fill-prefix prefix)))) (while (and (not give-up) (> (current-column) fc)) ;; Determine where to split the line. (let ((fill-point (let ((opoint (point)) bounce (first t)) (save-excursion (move-to-column (1+ fc)) ;; Move back to a word boundary. (while (or first ;; If this is after period and a single space, ;; move back once more--we don't want to break ;; the line there and make it look like a ;; sentence end. (and (not (bobp)) (not bounce) sentence-end-double-space (save-excursion (forward-char -1) (and (looking-at "\\. ") (not (looking-at "\\. ")))))) (setq first nil) (skip-chars-backward "^ \t\n") ;; If we find nowhere on the line to break it, ;; break after one word. Set bounce to t ;; so we will not keep going in this while loop. (if (bolp) (progn (re-search-forward "[ \t]" opoint t) (setq bounce t))) (skip-chars-backward " \t")) ;; Let fill-point be set to the place where we end up. (point))))) ;; If that place is not the beginning of the line, ;; break the line there. (if (save-excursion (goto-char fill-point) (not (bolp))) (let ((prev-column (current-column))) ;; If point is at the fill-point, do not `save-excursion'. ;; Otherwise, if a comment prefix or fill-prefix is inserted, ;; point will end up before it rather than after it. (if (save-excursion (skip-chars-backward " \t") (= (point) fill-point)) (indent-new-comment-line t) (save-excursion (goto-char fill-point) (indent-new-comment-line t))) ;; Now do justification, if required (if (not (eq justify 'left)) (save-excursion (end-of-line 0) (justify-current-line justify nil t))) ;; If making the new line didn't reduce the hpos of ;; the end of the line, then give up now; ;; trying again will not help. (if (>= (current-column) prev-column) (setq give-up t))) ;; No place to break => stop trying. (setq give-up t)))) ;; justify last line (justify-current-line justify t t)))) (defun auto-fill-mode (&optional arg) "Toggle auto-fill mode. With arg, turn Auto-Fill mode on if and only if arg is positive. In Auto-Fill mode, inserting a space at a column beyond `current-fill-column' automatically breaks the line at a previous space." (interactive "P") (prog1 (setq auto-fill-function (if (if (null arg) (not auto-fill-function) (> (prefix-numeric-value arg) 0)) 'do-auto-fill nil)) (force-mode-line-update))) ;; This holds a document string used to document auto-fill-mode. (defun auto-fill-function () "Automatically break line at a previous space, in insertion of text." nil) (defun turn-on-auto-fill () "Unconditionally turn on Auto Fill mode." (auto-fill-mode 1)) (defun set-fill-column (arg) "Set `fill-column' to current column, or to argument if given. The variable `fill-column' has a separate value for each buffer." (interactive "P") (setq fill-column (if (integerp arg) arg (current-column))) (message "fill-column set to %d" fill-column)) (defconst comment-multi-line nil "*Non-nil means \\[indent-new-comment-line] should continue same comment on new line, with no new terminator or starter. This is obsolete because you might as well use \\[newline-and-indent].") (defun indent-new-comment-line (&optional soft) "Break line at point and indent, continuing comment if within one. This indents the body of the continued comment under the previous comment line. This command is intended for styles where you write a comment per line, starting a new comment (and terminating it if necessary) on each line. If you want to continue one comment across several lines, use \\[newline-and-indent]. If a fill column is specified, it overrides the use of the comment column or comment indentation. The inserted newline is marked hard if `use-hard-newlines' is true, unless optional argument SOFT is non-nil." (interactive) (let (comcol comstart) (skip-chars-backward " \t") (delete-region (point) (progn (skip-chars-forward " \t") (point))) (if soft (insert-and-inherit ?\n) (newline 1)) (if fill-prefix (progn (indent-to-left-margin) (insert-and-inherit fill-prefix)) (if (not comment-multi-line) (save-excursion (if (and comment-start-skip (let ((opoint (point))) (forward-line -1) (re-search-forward comment-start-skip opoint t))) ;; The old line is a comment. ;; Set WIN to the pos of the comment-start. ;; But if the comment is empty, look at preceding lines ;; to find one that has a nonempty comment. ;; If comment-start-skip contains a \(...\) pair, ;; the real comment delimiter starts at the end of that pair. (let ((win (or (match-end 1) (match-beginning 0)))) (while (and (eolp) (not (bobp)) (let (opoint) (beginning-of-line) (setq opoint (point)) (forward-line -1) (re-search-forward comment-start-skip opoint t))) (setq win (or (match-end 1) (match-beginning 0)))) ;; Indent this line like what we found. (goto-char win) (setq comcol (current-column)) (setq comstart (buffer-substring (point) (match-end 0))))))) (if comcol (let ((comment-column comcol) (comment-start comstart) (comment-end comment-end)) (and comment-end (not (equal comment-end "")) ; (if (not comment-multi-line) (progn (forward-char -1) (insert comment-end) (forward-char 1)) ; (setq comment-column (+ comment-column (length comment-start)) ; comment-start "") ; ) ) (if (not (eolp)) (setq comment-end "")) (insert-and-inherit ?\n) (forward-char -1) (indent-for-comment) (save-excursion ;; Make sure we delete the newline inserted above. (end-of-line) (delete-char 1))) (indent-according-to-mode))))) (defun set-selective-display (arg) "Set `selective-display' to ARG; clear it if no arg. When the value of `selective-display' is a number > 0, lines whose indentation is >= that value are not displayed. The variable `selective-display' has a separate value for each buffer." (interactive "P") (if (eq selective-display t) (error "selective-display already in use for marked lines")) (let ((current-vpos (save-restriction (narrow-to-region (point-min) (point)) (goto-char (window-start)) (vertical-motion (window-height))))) (setq selective-display (and arg (prefix-numeric-value arg))) (recenter current-vpos)) (set-window-start (selected-window) (window-start (selected-window))) (princ "selective-display set to " t) (prin1 selective-display t) (princ "." t)) (defconst overwrite-mode-textual " Ovwrt" "The string displayed in the mode line when in overwrite mode.") (defconst overwrite-mode-binary " Bin Ovwrt" "The string displayed in the mode line when in binary overwrite mode.") (defun overwrite-mode (arg) "Toggle overwrite mode. With arg, turn overwrite mode on iff arg is positive. In overwrite mode, printing characters typed in replace existing text on a one-for-one basis, rather than pushing it to the right. At the end of a line, such characters extend the line. Before a tab, such characters insert until the tab is filled in. \\[quoted-insert] still inserts characters in overwrite mode; this is supposed to make it easier to insert characters when necessary." (interactive "P") (setq overwrite-mode (if (if (null arg) (not overwrite-mode) (> (prefix-numeric-value arg) 0)) 'overwrite-mode-textual)) (force-mode-line-update)) (defun binary-overwrite-mode (arg) "Toggle binary overwrite mode. With arg, turn binary overwrite mode on iff arg is positive. In binary overwrite mode, printing characters typed in replace existing text. Newlines are not treated specially, so typing at the end of a line joins the line to the next, with the typed character between them. Typing before a tab character simply replaces the tab with the character typed. \\[quoted-insert] replaces the text at the cursor, just as ordinary typing characters do. Note that binary overwrite mode is not its own minor mode; it is a specialization of overwrite-mode, entered by setting the `overwrite-mode' variable to `overwrite-mode-binary'." (interactive "P") (setq overwrite-mode (if (if (null arg) (not (eq overwrite-mode 'overwrite-mode-binary)) (> (prefix-numeric-value arg) 0)) 'overwrite-mode-binary)) (force-mode-line-update)) (defvar line-number-mode t "*Non-nil means display line number in mode line.") (defun line-number-mode (arg) "Toggle Line Number mode. With arg, turn Line Number mode on iff arg is positive. When Line Number mode is enabled, the line number appears in the mode line." (interactive "P") (setq line-number-mode (if (null arg) (not line-number-mode) (> (prefix-numeric-value arg) 0))) (force-mode-line-update)) (defvar column-number-mode nil "*Non-nil means display column number in mode line.") (defun column-number-mode (arg) "Toggle Column Number mode. With arg, turn Column Number mode on iff arg is positive. When Column Number mode is enabled, the column number appears in the mode line." (interactive "P") (setq column-number-mode (if (null arg) (not column-number-mode) (> (prefix-numeric-value arg) 0))) (force-mode-line-update)) (defvar blink-matching-paren t "*Non-nil means show matching open-paren when close-paren is inserted.") (defconst blink-matching-paren-distance 12000 "*If non-nil, is maximum distance to search for matching open-paren.") (defconst blink-matching-delay 1 "*The number of seconds that `blink-matching-open' will delay at a match.") (defconst blink-matching-paren-dont-ignore-comments nil "*Non-nil means `blink-matching-paren' should not ignore comments.") (defun blink-matching-open () "Move cursor momentarily to the beginning of the sexp before point." (interactive) (and (> (point) (1+ (point-min))) blink-matching-paren ;; Verify an even number of quoting characters precede the close. (= 1 (logand 1 (- (point) (save-excursion (forward-char -1) (skip-syntax-backward "/\\") (point))))) (let* ((oldpos (point)) (blinkpos) (mismatch)) (save-excursion (save-restriction (if blink-matching-paren-distance (narrow-to-region (max (point-min) (- (point) blink-matching-paren-distance)) oldpos)) (condition-case () (let ((parse-sexp-ignore-comments (and parse-sexp-ignore-comments (not blink-matching-paren-dont-ignore-comments)))) (setq blinkpos (scan-sexps oldpos -1))) (error nil))) (and blinkpos (/= (char-syntax (char-after blinkpos)) ?\$) (setq mismatch (or (null (matching-paren (char-after blinkpos))) (/= (char-after (1- oldpos)) (matching-paren (char-after blinkpos)))))) (if mismatch (setq blinkpos nil)) (if blinkpos (progn (goto-char blinkpos) (if (pos-visible-in-window-p) (sit-for blink-matching-delay) (goto-char blinkpos) (message "Matches %s" ;; Show what precedes the open in its line, if anything. (if (save-excursion (skip-chars-backward " \t") (not (bolp))) (buffer-substring (progn (beginning-of-line) (point)) (1+ blinkpos)) ;; Show what follows the open in its line, if anything. (if (save-excursion (forward-char 1) (skip-chars-forward " \t") (not (eolp))) (buffer-substring blinkpos (progn (end-of-line) (point))) ;; Otherwise show the previous nonblank line, ;; if there is one. (if (save-excursion (skip-chars-backward "\n \t") (not (bobp))) (concat (buffer-substring (progn (skip-chars-backward "\n \t") (beginning-of-line) (point)) (progn (end-of-line) (skip-chars-backward " \t") (point))) ;; Replace the newline and other whitespace with `...'. "..." (buffer-substring blinkpos (1+ blinkpos))) ;; There is nothing to show except the char itself. (buffer-substring blinkpos (1+ blinkpos)))))))) (cond (mismatch (message "Mismatched parentheses")) ((not blink-matching-paren-distance) (message "Unmatched parenthesis")))))))) ;Turned off because it makes dbx bomb out. (setq blink-paren-function 'blink-matching-open) ;; This executes C-g typed while Emacs is waiting for a command. ;; Quitting out of a program does not go through here; ;; that happens in the QUIT macro at the C code level. (defun keyboard-quit () "Signal a quit condition. During execution of Lisp code, this character causes a quit directly. At top-level, as an editor command, this simply beeps." (interactive) (deactivate-mark) (signal 'quit nil)) (define-key global-map "\C-g" 'keyboard-quit) (defvar buffer-quit-function nil "Function to call to \"quit\" the current buffer, or nil if none. \\[keyboard-escape-quit] calls this function when its more local actions \(such as cancelling a prefix argument, minibuffer or region) do not apply.") (defun keyboard-escape-quit () "Exit the current \"mode\" (in a generalized sense of the word). This command can exit an interactive command such as `query-replace', can clear out a prefix argument or a region, can get out of the minibuffer or other recursive edit, cancel the use of the current buffer (for special-purpose buffers), or go back to just one window (by deleting all but the selected window)." (interactive) (cond ((eq last-command 'mode-exited) nil) ((> (minibuffer-depth) 0) (abort-recursive-edit)) (current-prefix-arg nil) ((and transient-mark-mode mark-active) (deactivate-mark)) (buffer-quit-function (funcall buffer-quit-function)) ((not (one-window-p t)) (delete-other-windows)))) (define-key global-map "\e\e\e" 'keyboard-escape-quit) (defun set-variable (var val) "Set VARIABLE to VALUE. VALUE is a Lisp object. When using this interactively, supply a Lisp expression for VALUE. If you want VALUE to be a string, you must surround it with doublequotes. If VARIABLE has a `variable-interactive' property, that is used as if it were the arg to `interactive' (which see) to interactively read the value." (interactive (let* ((var (read-variable "Set variable: ")) (minibuffer-help-form '(funcall myhelp)) (myhelp (function (lambda () (with-output-to-temp-buffer "*Help*" (prin1 var) (princ "\nDocumentation:\n") (princ (substring (documentation-property var 'variable-documentation) 1)) (if (boundp var) (let ((print-length 20)) (princ "\n\nCurrent value: ") (prin1 (symbol-value var)))) (save-excursion (set-buffer standard-output) (help-mode)) nil))))) (list var (let ((prop (get var 'variable-interactive))) (if prop ;; Use VAR's `variable-interactive' property ;; as an interactive spec for prompting. (call-interactively (list 'lambda '(arg) (list 'interactive prop) 'arg)) (eval-minibuffer (format "Set %s to value: " var))))))) (set var val)) ;; Define the major mode for lists of completions. (defvar completion-list-mode-map nil "Local map for completion list buffers.") (or completion-list-mode-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'mouse-choose-completion) (define-key map [down-mouse-2] nil) (define-key map "\C-m" 'choose-completion) (define-key map "\e\e\e" 'delete-completion-window) (define-key map [left] 'previous-completion) (define-key map [right] 'next-completion) (setq completion-list-mode-map map))) ;; Completion mode is suitable only for specially formatted data. (put 'completion-list-mode 'mode-class 'special) (defvar completion-reference-buffer nil "Record the buffer that was current when the completion list was requested. This is a local variable in the completion list buffer. Initial value is nil to avoid some compiler warnings.") (defvar completion-base-size nil "Number of chars at beginning of minibuffer not involved in completion. This is a local variable in the completion list buffer but it talks about the buffer in `completion-reference-buffer'. If this is nil, it means to compare text to determine which part of the tail end of the buffer's text is involved in completion.") (defun delete-completion-window () "Delete the completion list window. Go to the window from which completion was requested." (interactive) (let ((buf completion-reference-buffer)) (delete-window (selected-window)) (if (get-buffer-window buf) (select-window (get-buffer-window buf))))) (defun previous-completion (n) "Move to the previous item in the completion list." (interactive "p") (next-completion (- n))) (defun next-completion (n) "Move to the next item in the completion list. WIth prefix argument N, move N items (negative N means move backward)." (interactive "p") (while (and (> n 0) (not (eobp))) (let ((prop (get-text-property (point) 'mouse-face)) (end (point-max))) ;; If in a completion, move to the end of it. (if prop (goto-char (next-single-property-change (point) 'mouse-face nil end))) ;; Move to start of next one. (goto-char (next-single-property-change (point) 'mouse-face nil end))) (setq n (1- n))) (while (and (< n 0) (not (bobp))) (let ((prop (get-text-property (1- (point)) 'mouse-face)) (end (point-min))) ;; If in a completion, move to the start of it. (if prop (goto-char (previous-single-property-change (point) 'mouse-face nil end))) ;; Move to end of the previous completion. (goto-char (previous-single-property-change (point) 'mouse-face nil end)) ;; Move to the start of that one. (goto-char (previous-single-property-change (point) 'mouse-face nil end))) (setq n (1+ n)))) (defun choose-completion () "Choose the completion that point is in or next to." (interactive) (let (beg end completion (buffer completion-reference-buffer) (base-size completion-base-size)) (if (and (not (eobp)) (get-text-property (point) 'mouse-face)) (setq end (point) beg (1+ (point)))) (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face)) (setq end (1- (point)) beg (point))) (if (null beg) (error "No completion here")) (setq beg (previous-single-property-change beg 'mouse-face)) (setq end (or (next-single-property-change end 'mouse-face) (point-max))) (setq completion (buffer-substring beg end)) (let ((owindow (selected-window))) (if (and (one-window-p t 'selected-frame) (window-dedicated-p (selected-window))) ;; This is a special buffer's frame (iconify-frame (selected-frame)) (or (window-dedicated-p (selected-window)) (bury-buffer))) (select-window owindow)) (choose-completion-string completion buffer base-size))) ;; Delete the longest partial match for STRING ;; that can be found before POINT. (defun choose-completion-delete-max-match (string) (let ((opoint (point)) (len (min (length string) (- (point) (point-min))))) (goto-char (- (point) (length string))) (if completion-ignore-case (setq string (downcase string))) (while (and (> len 0) (let ((tail (buffer-substring (point) (+ (point) len)))) (if completion-ignore-case (setq tail (downcase tail))) (not (string= tail (substring string 0 len))))) (setq len (1- len)) (forward-char 1)) (delete-char len))) ;; Switch to BUFFER and insert the completion choice CHOICE. ;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text ;; to keep. If it is nil, use choose-completion-delete-max-match instead. (defun choose-completion-string (choice &optional buffer base-size) (let ((buffer (or buffer completion-reference-buffer))) ;; If BUFFER is a minibuffer, barf unless it's the currently ;; active minibuffer. (if (and (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer)) (or (not (active-minibuffer-window)) (not (equal buffer (window-buffer (active-minibuffer-window)))))) (error "Minibuffer is not active for completion") ;; Insert the completion into the buffer where completion was requested. (set-buffer buffer) (if base-size (delete-region (+ base-size (point-min)) (point)) (choose-completion-delete-max-match choice)) (insert choice) (remove-text-properties (- (point) (length choice)) (point) '(mouse-face nil)) ;; Update point in the window that BUFFER is showing in. (let ((window (get-buffer-window buffer t))) (set-window-point window (point))) ;; If completing for the minibuffer, exit it with this choice. (and (equal buffer (window-buffer (minibuffer-window))) minibuffer-completion-table (exit-minibuffer))))) (defun completion-list-mode () "Major mode for buffers showing lists of possible completions. Type \\\\[choose-completion] in the completion list\ to select the completion near point. Use \\\\[mouse-choose-completion] to select one\ with the mouse." (interactive) (kill-all-local-variables) (use-local-map completion-list-mode-map) (setq mode-name "Completion List") (setq major-mode 'completion-list-mode) (make-local-variable 'completion-base-size) (setq completion-base-size nil) (run-hooks 'completion-list-mode-hook)) (defvar completion-fixup-function nil "A function to customize how completions are identified in completion lists. `completion-setup-function' calls this function with no arguments each time it has found what it thinks is one completion. Point is at the end of the completion in the completion list buffer. If this function moves point, it can alter the end of that completion.") ;; This function goes in completion-setup-hook, so that it is called ;; after the text of the completion list buffer is written. (defun completion-setup-function () (save-excursion (let ((mainbuf (current-buffer))) (set-buffer standard-output) (completion-list-mode) (make-local-variable 'completion-reference-buffer) (setq completion-reference-buffer mainbuf) ;;; The value 0 is right in most cases, but not for file name completion. ;;; so this has to be turned off. ;;; (setq completion-base-size 0) (goto-char (point-min)) (if window-system (insert (substitute-command-keys "Click \\[mouse-choose-completion] on a completion to select it.\n"))) (insert (substitute-command-keys "In this buffer, type \\[choose-completion] to \ select the completion near point.\n\n")) (forward-line 1) (while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t) (let ((beg (match-beginning 0)) (end (point))) (if completion-fixup-function (funcall completion-fixup-function)) (put-text-property beg (point) 'mouse-face 'highlight) (goto-char end)))))) (add-hook 'completion-setup-hook 'completion-setup-function) (define-key minibuffer-local-completion-map [prior] 'switch-to-completions) (define-key minibuffer-local-must-match-map [prior] 'switch-to-completions) (define-key minibuffer-local-completion-map "\M-v" 'switch-to-completions) (define-key minibuffer-local-must-match-map "\M-v" 'switch-to-completions) (defun switch-to-completions () "Select the completion list window." (interactive) ;; Make sure we have a completions window. (or (get-buffer-window "*Completions*") (minibuffer-completion-help)) (select-window (get-buffer-window "*Completions*")) (goto-char (point-min)) (search-forward "\n\n") (forward-line 1)) ;; Support keyboard commands to turn on various modifiers. ;; These functions -- which are not commands -- each add one modifier ;; to the following event. (defun event-apply-alt-modifier (ignore-prompt) (vector (event-apply-modifier (read-event) 'alt 22 "A-"))) (defun event-apply-super-modifier (ignore-prompt) (vector (event-apply-modifier (read-event) 'super 23 "s-"))) (defun event-apply-hyper-modifier (ignore-prompt) (vector (event-apply-modifier (read-event) 'hyper 24 "H-"))) (defun event-apply-shift-modifier (ignore-prompt) (vector (event-apply-modifier (read-event) 'shift 25 "S-"))) (defun event-apply-control-modifier (ignore-prompt) (vector (event-apply-modifier (read-event) 'control 26 "C-"))) (defun event-apply-meta-modifier (ignore-prompt) (vector (event-apply-modifier (read-event) 'meta 27 "M-"))) (defun event-apply-modifier (event symbol lshiftby prefix) "Apply a modifier flag to event EVENT. SYMBOL is the name of this modifier, as a symbol. LSHIFTBY is the numeric value of this modifier, in keyboard events. PREFIX is the string that represents this modifier in an event type symbol." (if (numberp event) (cond ((eq symbol 'control) (if (and (<= (downcase event) ?z) (>= (downcase event) ?a)) (- (downcase event) ?a -1) (if (and (<= (downcase event) ?Z) (>= (downcase event) ?A)) (- (downcase event) ?A -1) (logior (lsh 1 lshiftby) event)))) ((eq symbol 'shift) (if (and (<= (downcase event) ?z) (>= (downcase event) ?a)) (upcase event) (logior (lsh 1 lshiftby) event))) (t (logior (lsh 1 lshiftby) event))) (if (memq symbol (event-modifiers event)) event (let ((event-type (if (symbolp event) event (car event)))) (setq event-type (intern (concat prefix (symbol-name event-type)))) (if (symbolp event) event-type (cons event-type (cdr event))))))) (define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier) (define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier) (define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier) (define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier) (define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier) (define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier) ;;;; Keypad support. ;;; Make the keypad keys act like ordinary typing keys. If people add ;;; bindings for the function key symbols, then those bindings will ;;; override these, so this shouldn't interfere with any existing ;;; bindings. ;; Also tell read-char how to handle these keys. (mapcar (lambda (keypad-normal) (let ((keypad (nth 0 keypad-normal)) (normal (nth 1 keypad-normal))) (put keypad 'ascii-character normal) (define-key function-key-map (vector keypad) (vector normal)))) '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4) (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9) (kp-space ?\ ) (kp-tab ?\t) (kp-enter ?\r) (kp-multiply ?*) (kp-add ?+) (kp-separator ?,) (kp-subtract ?-) (kp-decimal ?.) (kp-divide ?/) (kp-equal ?=))) ;;; simple.el ends here emacs-19.30/lisp/simula.el100444 22552 1 132737 5725363657 14311 0ustar borisdaemon;;; simula.el --- SIMULA 87 code editing commands for Emacs ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Hans Henrik Eriksen ;; Maintainer: simula-mode@ifi.uio.no ;; Version: 0.992 ;; Adapted-By: ESR ;; Keywords: languages ;; 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: ;; A major mode for editing the Simula language. It knows about Simula ;; syntax and standard indentation commands. It also provides convenient ;; abbrevs for Simula keywords. ;; ;; Hans Henrik Eriksen (the author) may be reached at: ;; Institutt for informatikk, ;; Universitetet i Oslo ;;; Code: (provide 'simula-mode) (defconst simula-tab-always-indent nil "*Non-nil means TAB in SIMULA mode should always reindent the current line. Otherwise TAB indents only when point is within the run of whitespace at the beginning of the line.") (defconst simula-indent-level 3 "*Indentation of SIMULA statements with respect to containing block.") (defconst simula-substatement-offset 3 "*Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.") (defconst simula-continued-statement-offset 3 "*Extra indentation for lines not starting a statement or substatement. If value is a list, each line in a multipleline continued statement will have the car of the list extra indentation with respect to the previous line of the statement.") (defconst simula-label-offset -4711 "*Offset of SIMULA label lines relative to usual indentation.") (defconst simula-if-indent '(0 . 0) "*Extra indentation of THEN and ELSE with respect to the starting IF. Value is a cons cell, the car is extra THEN indentation and the cdr extra ELSE indentation. IF after ELSE is indented as the starting IF.") (defconst simula-inspect-indent '(0 . 0) "*Extra indentation of WHEN and OTHERWISE with respect to the INSPECT. Value is a cons cell, the car is extra WHEN indentation and the cdr extra OTHERWISE indentation.") (defconst simula-electric-indent nil "*Non-nil means `simula-indent-line' function may reindent previous line.") (defconst simula-abbrev-keyword 'upcase "*Specify how to convert case for SIMULA keywords. Value is one of the symbols `upcase', `downcase', `capitalize', \(as in) `abbrev-table' or nil if they should not be changed.") (defconst simula-abbrev-stdproc 'abbrev-table "*Specify how to convert case for standard SIMULA procedure and class names. Value is one of the symbols `upcase', `downcase', `capitalize', \(as in) `abbrev-table', or nil if they should not be changed.") (defvar simula-abbrev-file nil "*File with extra abbrev definitions for use in SIMULA mode. These are used together with the standard abbrev definitions for SIMULA. Please note that the standard definitions are required for SIMULA mode to function correctly.") (defvar simula-mode-syntax-table nil "Syntax table in SIMULA mode buffers.") (if simula-mode-syntax-table () (setq simula-mode-syntax-table (copy-syntax-table (standard-syntax-table))) (modify-syntax-entry ?! "<" simula-mode-syntax-table) (modify-syntax-entry ?$ "." simula-mode-syntax-table) (modify-syntax-entry ?% "." simula-mode-syntax-table) (modify-syntax-entry ?' "\"" simula-mode-syntax-table) (modify-syntax-entry ?\( "()" simula-mode-syntax-table) (modify-syntax-entry ?\) ")(" simula-mode-syntax-table) (modify-syntax-entry ?\; ">" simula-mode-syntax-table) (modify-syntax-entry ?\[ "." simula-mode-syntax-table) (modify-syntax-entry ?\\ "." simula-mode-syntax-table) (modify-syntax-entry ?\] "." simula-mode-syntax-table) (modify-syntax-entry ?_ "w" simula-mode-syntax-table) (modify-syntax-entry ?\| "." simula-mode-syntax-table) (modify-syntax-entry ?\{ "." simula-mode-syntax-table) (modify-syntax-entry ?\} "." simula-mode-syntax-table)) (defvar simula-mode-map () "Keymap used in SIMULA mode.") (if simula-mode-map () (setq simula-mode-map (make-sparse-keymap)) (define-key simula-mode-map "\C-c\C-u" 'simula-backward-up-level) (define-key simula-mode-map "\C-c\C-p" 'simula-previous-statement) (define-key simula-mode-map "\C-c\C-d" 'simula-forward-down-level) (define-key simula-mode-map "\C-c\C-n" 'simula-next-statement) ;(define-key simula-mode-map "\C-c\C-g" 'simula-goto-definition) ;(define-key simula-mode-map "\C-c\C-h" 'simula-standard-help) (define-key simula-mode-map "\177" 'backward-delete-char-untabify) (define-key simula-mode-map ":" 'simula-electric-label) (define-key simula-mode-map "\t" 'simula-indent-command)) (defvar simula-mode-abbrev-table nil "Abbrev table in SIMULA mode buffers") (defun simula-mode () "Major mode for editing SIMULA code. \\{simula-mode-map} Variables controlling indentation style: simula-tab-always-indent Non-nil means TAB in SIMULA mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. simula-indent-level Indentation of SIMULA statements with respect to containing block. simula-substatement-offset Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE. simula-continued-statement-offset 3 Extra indentation for lines not starting a statement or substatement, e.g. a nested FOR-loop. If value is a list, each line in a multiple- line continued statement will have the car of the list extra indentation with respect to the previous line of the statement. simula-label-offset -4711 Offset of SIMULA label lines relative to usual indentation. simula-if-indent '(0 . 0) Extra indentation of THEN and ELSE with respect to the starting IF. Value is a cons cell, the car is extra THEN indentation and the cdr extra ELSE indentation. IF after ELSE is indented as the starting IF. simula-inspect-indent '(0 . 0) Extra indentation of WHEN and OTHERWISE with respect to the corresponding INSPECT. Value is a cons cell, the car is extra WHEN indentation and the cdr extra OTHERWISE indentation. simula-electric-indent nil If this variable is non-nil, `simula-indent-line' will check the previous line to see if it has to be reindented. simula-abbrev-keyword 'upcase Determine how SIMULA keywords will be expanded. Value is one of the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table', or nil if they should not be changed. simula-abbrev-stdproc 'abbrev-table Determine how standard SIMULA procedure and class names will be expanded. Value is one of the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table', or nil if they should not be changed. Turning on SIMULA mode calls the value of the variable simula-mode-hook with no arguments, if that value is non-nil Warning: simula-mode-hook should not read in an abbrev file without calling the function simula-install-standard-abbrevs afterwards, preferably not at all." (interactive) (kill-all-local-variables) (use-local-map simula-mode-map) (setq major-mode 'simula-mode) (setq mode-name "SIMULA") (make-local-variable 'comment-column) (setq comment-column 40) (make-local-variable 'end-comment-column) (setq end-comment-column 75) (set-syntax-table simula-mode-syntax-table) (make-local-variable 'paragraph-start) (setq paragraph-start "[ \t]*$\\|\\f") (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'indent-line-function) (setq indent-line-function 'simula-indent-line) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'comment-start) (setq comment-start "! ") (make-local-variable 'comment-end) (setq comment-end " ;") (make-local-variable 'comment-start-skip) (setq comment-start-skip "!+ *") (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments nil) (make-local-variable 'comment-multi-line) (setq comment-multi-line t) (if simula-mode-abbrev-table () (if simula-abbrev-file (read-abbrev-file simula-abbrev-file) (define-abbrev-table 'simula-mode-abbrev-table ())) (let (abbrevs-changed) (simula-install-standard-abbrevs))) (setq local-abbrev-table simula-mode-abbrev-table) (abbrev-mode 1) (run-hooks 'simula-mode-hook)) (defun simula-indent-line () "Indent this line as SIMULA code. If `simula-electric-indent' is non-nil, indent previous line if necessary." (let ((origin (- (point-max) (point))) (indent (simula-calculate-indent)) (case-fold-search t)) (unwind-protect (progn ;; ;; manually expand abbrev on last line, if any ;; (end-of-line 0) (expand-abbrev) ;; now maybe we should reindent that line (if simula-electric-indent (progn (beginning-of-line) (skip-chars-forward " \t\f") (if (and (looking-at "\\(end\\|if\\|then\\|else\\|when\\|otherwise\\)\\>") (not (simula-context))) ;; yes - reindent (let ((post-indent (simula-calculate-indent))) (if (eq (current-indentation) post-indent) () (delete-horizontal-space) (indent-to post-indent))))))) (goto-char (- (point-max) origin)) (if (eq (current-indentation) indent) (back-to-indentation) (delete-horizontal-space) (indent-to indent))))) (defun simula-indent-command (&optional whole-exp) "Indent current line as SIMULA code, or insert TAB character. If `simula-tab-always-indent' is non-nil, always indent current line. Otherwise, indent only if point is before any non-whitespace character on the line. A numeric argument, regardless of its value, means indent rigidly all the lines of the SIMULA statement after point so that this line becomes properly indented. The relative indentation among the lines of the statement are preserved." (interactive "P") (let ((case-fold-search t)) (if (or whole-exp simula-tab-always-indent (save-excursion (skip-chars-backward " \t\f") (bolp))) ;; reindent current line (let ((indent (save-excursion (beginning-of-line) (simula-calculate-indent))) (current (current-indentation)) (origin (- (point-max) (point))) (bol (save-excursion (skip-chars-backward " \t\f") (bolp))) beg end) (unwind-protect (if (eq current indent) (if (save-excursion (skip-chars-backward " \t\f") (bolp)) (back-to-indentation)) (beginning-of-line) (delete-horizontal-space) (indent-to indent)) (if (not bol) (goto-char (- (point-max) origin)))) (setq origin (point)) (if whole-exp (save-excursion (beginning-of-line 2) (setq beg (point)) (goto-char origin) (simula-next-statement 1) (setq end (point)) (if (and (> end beg) (not (eq indent current))) (indent-code-rigidly beg end (- indent current) "%"))))) (insert-tab)))) (defun simula-context () "Returns value according to syntactic SIMULA context of point. 0 point inside COMMENT comment 1 point on SIMULA-compiler directive line 2 point inside END comment 3 point inside string 4 point inside character constant nil otherwise." ;; first, find out if this is a compiler directive line (if (save-excursion (beginning-of-line) (eq (following-char) ?%)) ;; YES - return 1 1 (save-excursion ;; The current line is NOT a compiler directive line. ;; Now, the strategy is to search backward to find a semicolon ;; that is NOT inside a string. The point after semicolon MUST be ;; outside a comment, since semicolons are comment-ending and ;; comments are non-recursive. We take advantage of the fact ;; that strings MUST end on the same line as they started, so ;; that we can easily decide whether we are inside a string or not. (let (return-value (origin (point))) (skip-chars-backward "^;" (point-min)) ;; found semicolon or beginning of buffer (let (loopvalue (saved-point origin)) (while (and (not (bobp)) (if (progn (beginning-of-line) ;; compiler directive line? If so, cont searching.. (eq (following-char) ?%)) t (while (< (point) saved-point) (skip-chars-forward "^;\"'") (forward-char 1) (cond ((eq (preceding-char) ?\;) (setq saved-point (point))) ((eq (preceding-char) ?\") (skip-chars-forward "^\";") (if (eq (following-char) ?\;) (setq saved-point (point) loopvalue t) (forward-char 1))) (t (if (eq (following-char) ?') (forward-char 1)) (skip-chars-forward "^';") (if (eq (following-char) ?\;) (setq saved-point (point) loopvalue t) (forward-char 1))))) loopvalue)) (backward-char 1) (skip-chars-backward "^;") (setq saved-point (point) loopvalue nil))) ;; Now we are CERTAIN that we are outside comments and strings. ;; The job now is to search forward again towards the origin ;; skipping directives, comments and strings correctly, ;; so that we know what context we are in when we find the origin. (while (and (< (point) origin) (re-search-forward "\\\\|!\\|\"\\|'\\|^%\\|\\" origin 'move)) (cond ((memq (preceding-char) '(?d ?D)) (setq return-value 2) (while (and (memq (preceding-char) '(?d ?D)) (not return-value)) (while (and (re-search-forward ";\\|\\\\|\\\\|\\\\|\\\\|^%" origin 'move) (eq (preceding-char) ?%)) (beginning-of-line 2))) (if (looking-at "[ \t\n\f]*\\(;\\|\\\\|\\\\|\\\\|\\\\)") (setq return-value nil))) ((memq (preceding-char) '(?! ?t ?T)) ; skip comment (setq return-value 0) (skip-chars-forward "^%;" origin) (while (and return-value (< (point) origin)) (if (eq (following-char) ?\;) (setq return-value nil) (if (bolp) (beginning-of-line 2) ; skip directive inside comment (forward-char 1)) ; or single '%' (skip-chars-forward "^%;" origin)))) ((eq (preceding-char) ?\") (if (not (search-forward "\"" origin 'move)) (setq return-value 3))) ((eq (preceding-char) ?\') (if (or (eq (point) origin) (eobp)) (setq return-value 4) (forward-char 1) (if (not (search-forward "'" origin 'move)) (setq return-value 4)))) ;; compiler directive line - skip (t (beginning-of-line 2)))) return-value) ))) (defun simula-electric-label () "If this is a label that starts the line, reindent the line." (interactive) (expand-abbrev) (insert ?:) (let ((origin (- (point-max) (point))) (case-fold-search t) ;; don't mix a label with an assignment operator := :- ;; therefore look at next typed character... (next-char (setq unread-command-events (list (read-event)))) (com-char last-command-char)) (unwind-protect ;; Problem: find out if character just read is a command char ;; that would insert something after ':' making it a label. ;; At least \n, \r (and maybe \t) falls into this category. ;; This is a real crock, it depends on traditional keymap ;; bindings, that is, printing characters doing self-insert, ;; and no other command sequence inserting '-' or '='. ;; simula-electric-label can be easily fooled... (if (and (not (memq next-char '(?= ?-))) (or (memq next-char '(?\n ?\r)) (and (eq next-char ?\t) simula-tab-always-indent) (not (memq (following-char) '(?= ?-)))) (not (simula-context)) ;; label? (progn (backward-char 1) (skip-chars-backward " \t\f") (skip-chars-backward "a-zA-Z0-9_") (if (looking-at "virtual\\>") nil (skip-chars-backward " \t\f") (bolp)))) (let ((amount (simula-calculate-indent))) (delete-horizontal-space) (indent-to amount))) (goto-char (- (point-max) origin))))) (defun simula-backward-up-level (count) "Move backward up COUNT block levels. If COUNT is negative, move forward up block level instead." (interactive "p") (let ((origin (point)) (case-fold-search t)) (condition-case () (if (> count 0) (while (> count 0) (re-search-backward "\\\\|\\") (if (not (simula-context)) (setq count (if (memq (following-char) '(?b ?B)) (1- count) (1+ count))))) (while (< count 0) (re-search-forward "\\\\|\\") (backward-word 1) (if (not (simula-context)) (setq count (if (memq (following-char) '(?e ?E)) (1+ count) (1- count)))) (backward-word -1))) ;; If block level not found, jump back to origin and signal an error (error (progn (goto-char origin) (error "No higher block level"))) (quit (progn (goto-char origin) (signal 'quit nil)))))) (defun simula-forward-down-level (count) "Move forward down COUNT block levels. If COUNT is negative, move backward down block level instead." (interactive "p") ;; When we search for a deeper block level, we must never ;; get out of the block where we started -> count >= start-count (let ((start-count count) (origin (point)) (case-fold-search t)) (condition-case () (if (< count 0) (while (< count 0) (re-search-backward "\\\\|\\") (if (not (simula-context)) (setq count (if (memq (following-char) '(?e ?E)) (1+ count) (1- count)))) (if (< count start-count) (signal 'error nil))) (while (> count 0) (re-search-forward "\\\\|\\") (backward-word 1) (if (not (simula-context)) (setq count (if (memq (following-char) '(?b ?B)) (1- count) (1+ count)))) (backward-word -1) ;; deeper level has to be found within starting block (if (> count start-count) (signal 'error nil)))) ;; If block level not found, jump back to origin and signal an error (error (progn (goto-char origin) (error "No containing block level"))) (quit (progn (goto-char origin) (signal 'quit nil)))))) (defun simula-previous-statement (count) "Move backward COUNT statements. If COUNT is negative, move forward instead." (interactive "p") (if (< count 0) (simula-next-statement (- count)) (let (status (case-fold-search t) (origin (point))) (condition-case () (progn (simula-skip-comment-backward) (if (memq (preceding-char) '(?n ?N)) (progn (backward-word 1) (if (not (looking-at "\\")) (backward-word -1))) (if (eq (preceding-char) ?\;) (backward-char 1))) (while (and (natnump (setq count (1- count))) (setq status (simula-search-backward ";\\|\\" nil 'move)))) (if status (progn (if (eq (following-char) ?\;) (forward-char 1) (backward-word -1)))) (simula-skip-comment-forward)) (error (progn (goto-char origin) (error "Incomplete statement (too many ENDs)"))) (quit (progn (goto-char origin) (signal 'quit nil))))))) (defun simula-next-statement (count) "Move forward COUNT statements. If COUNT is negative, move backward instead." (interactive "p") (if (< count 0) (simula-previous-statement (- count)) (let (status (case-fold-search t) (origin (point))) (condition-case () (progn (simula-skip-comment-forward) (if (looking-at "\\") (forward-word 1)) (while (and (natnump (setq count (1- count))) (setq status (simula-search-forward ";\\|\\" (point-max) 'move)))) (if (and status (/= (preceding-char) ?\;)) (progn (backward-word 1) (simula-skip-comment-backward)))) (error (progn (goto-char origin) (error "Incomplete statement (too few ENDs)"))) (quit (progn (goto-char origin) (signal 'quit nil))))))) (defun simula-skip-comment-backward () "Search towards bob to find first char that is outside a comment." (interactive) (catch 'simula-out (let (context) (while t (skip-chars-backward " \t\n\f") (if (eq (preceding-char) ?\;) (save-excursion (backward-char 1) (setq context (simula-context))) (setq context (simula-context))) (cond ((memq context '(nil 3 4)) ;; check to see if we found a label (if (and (eq (preceding-char) ?:) (not (memq (following-char) '(?- ?=))) (save-excursion (skip-chars-backward ": \t\fa-zA-Z0-9_") (not (looking-at "virtual\\>")))) (skip-chars-backward ": \t\fa-zA-Z0-9_") (throw 'simula-out nil))) ((eq context 0) ;; since we are inside a comment, it must start somewhere! (while (and (re-search-backward "!\\|\\") (memq (simula-context) '(0 1))))) ((eq context 1) (end-of-line 0) (if (bobp) (throw 'simula-out nil))) ((eq context 2) ;; an END-comment must belong to an END (re-search-backward "\\") (forward-word 1) (throw 'simula-out nil)) ;; should be impossible to get here.. ))))) (defun simula-skip-comment-forward () "Search towards eob to find first char that is outside a comment." ;; this function assumes we start with point .outside a comment (interactive) (catch 'simula-out (while t (skip-chars-forward " \t\n\f") (cond ((looking-at "!\\|\\") (search-forward ";" nil 'move)) ((and (bolp) (eq (following-char) ?%)) (beginning-of-line 2)) ((and (looking-at "[a-z0-9_]*[ \t\f]*:[^-=]") (not (looking-at "virtual\\>"))) (skip-chars-forward "a-zA-Z0-9_ \t\f:")) (t (throw 'simula-out t)))))) (defun simula-forward-up-level () (let ((continue-loop t) (origin (point)) (case-fold-search t) return-value temp) (while continue-loop (if (re-search-backward "\\\\|\\" (point-min) 'move) (setq temp (simula-context) return-value (and (memq (preceding-char) '(?d ?D)) (memq temp '(nil 2))) continue-loop (and (not return-value) (simula-forward-up-level))) (setq continue-loop nil))) (if return-value t (goto-char origin) nil))) (defun simula-calculate-indent () (save-excursion (let ((where (simula-context)) (origin (point)) (indent 0) continued start-line temp found-end prev-cont) (cond ((eq where 0) ;; ;; Comment. ;; If comment started on previous non-blank line, indent to the ;; column where the comment started, else indent as that line. ;; (skip-chars-backward " \t\n\f") (while (and (not (bolp)) (eq (simula-context) 0)) (re-search-backward "^\\|!\\|\\")) (skip-chars-forward " \t\n\f") (prog1 (current-column) (goto-char origin))) ;; ;; Detect missing string delimiters ;; ((eq where 3) (error "Inside string")) ((eq where 4) (error "Inside character constant")) ;; ;; check to see if inside ()'s ;; ((setq temp (simula-inside-parens)) temp) ;; ;; Calculate non-comment indentation (t ;; first, find out if this line starts with something that needs ;; special indentation (END/IF/THEN/ELSE/WHEN/OTHERWISE or label) ;; (skip-chars-forward " \t\f") (cond ;; ;; END ;; ((looking-at "end\\>") (setq indent (- simula-indent-level) found-end t)) ;; ;; IF/THEN/ELSE ;; ((looking-at "if\\>\\|then\\>\\|else\\>") ;; search for the *starting* IF (cond ((memq (following-char) '(?T ?t)) (setq indent (car simula-if-indent))) ((memq (following-char) '(?E ?e)) (setq indent (cdr simula-if-indent))) (t (forward-word 1) (setq indent 0))) (simula-find-if)) ;; ;; WHEN/OTHERWISE ;; ((looking-at "when\\>\\|otherwise\\>") ;; search for corresponding INSPECT (if (memq (following-char) '(?W ?w)) (setq indent (car simula-inspect-indent)) (setq indent (cdr simula-inspect-indent))) (simula-find-inspect)) ;; ;; label: ;; ((and (not (looking-at "virtual\\>")) (looking-at "[a-z0-9_]*[ \t\f]*:[^-=]")) (setq indent simula-label-offset))) ;; find line with non-comment text (simula-skip-comment-backward) (if (and found-end (not (eq (preceding-char) ?\;)) (if (memq (preceding-char) '(?N ?n)) (save-excursion (backward-word 1) (not (looking-at "begin\\>"))) t)) (progn (simula-previous-statement 1) (simula-skip-comment-backward))) (setq start-line (save-excursion (beginning-of-line) (point)) ;; - perhaps this is a continued statement continued (save-excursion (and (not (bobp)) ;; (not found-end) (if (eq (char-syntax (preceding-char)) ?w) (progn (backward-word 1) (not (looking-at "begin\\|then\\|else\\|when\\|otherwise\\|do" ))) (not (memq (preceding-char) '(?: ?\;))))))) ;; ;; MAIN calculation loop - count BEGIN/DO etc. ;; (while (not (bolp)) (if (re-search-backward ";\\|\\<\\(begin\\|end\\|if\\|else\\|then\\|when\\|otherwise\\|do\\)\\>" start-line 'move) (if (simula-context) ();; found something in a comment/string - ignore (setq temp (following-char)) (cond ((eq temp ?\;) (simula-previous-statement 1)) ((looking-at "begin\\>") (setq indent (+ indent simula-indent-level))) ((looking-at "end\\>") (forward-word 1) (simula-previous-statement 1)) ((looking-at "do\\>") (setq indent (+ indent simula-substatement-offset)) (simula-find-do-match)) ((looking-at "\\(if\\|then\\|else\\)\\>") (if (memq temp '(?I ?i)) (forward-word 1) (setq indent (+ indent simula-substatement-offset (if (memq temp '(?T ?t)) (car simula-if-indent) (cdr simula-if-indent))))) (simula-find-if)) ((looking-at "\\\\|\\") (setq indent (+ indent simula-substatement-offset (if (memq temp '(?W ?w)) (car simula-if-indent) (cdr simula-if-indent)))) (simula-find-inspect))) ;; found the start of a [sub]statement ;; add indentation for continued statement (if continued (setq indent (+ indent (if (listp simula-continued-statement-offset) (car simula-continued-statement-offset) simula-continued-statement-offset)))) (setq start-line (save-excursion (beginning-of-line) (point)) continued nil)) ;; search failed .. point is at beginning of line ;; determine if we should continue searching ;; (at or before comment or label) ;; temp = t means finished (setq temp (and (not (simula-context)) (save-excursion (skip-chars-forward " \t\f") (or (looking-at "virtual") (not (looking-at "!\\|comment\\>\\|[a-z0-9_]*[ \t\f]*:[^-=]"))))) prev-cont continued) ;; if we are finished, find current line's indentation (if temp (setq indent (+ indent (current-indentation)))) ;; find next line with non-comment SIMULA text ;; maybe indent extra if statement continues (simula-skip-comment-backward) (setq continued (and (not (bobp)) (if (eq (char-syntax (preceding-char)) ?w) (save-excursion (backward-word 1) (not (looking-at "begin\\|then\\|else\\|when\\|otherwise\\|do"))) (not (memq (preceding-char) '(?: ?\;)))))) ;; if we the state of the continued-variable ;; changed, add indentation for continued statement (if (or (and prev-cont (not continued)) (and continued (listp simula-continued-statement-offset))) (setq indent (+ indent (if (listp simula-continued-statement-offset) (car simula-continued-statement-offset) simula-continued-statement-offset)))) ;; while ends if point is at beginning of line at loop test (if (not temp) (setq start-line (save-excursion (beginning-of-line) (point))) (beginning-of-line)))) ;; ;; return indentation ;; indent))))) (defun simula-find-if () "Find starting IF of a IF-THEN[-ELSE[-IF-THEN...]] statement." (catch 'simula-out (while t (if (and (simula-search-backward "\\\\|;\\|\\"nil t) (memq (following-char) '(?I ?i))) (save-excursion ;; ;; find out if this IF was really the start of the IF statement ;; (simula-skip-comment-backward) (if (and (eq (char-syntax (preceding-char)) ?w) (progn (backward-word 1) (looking-at "else\\>"))) () (throw 'simula-out t))) (if (not (looking-at "\\")) (error "Missing IF or misplaced BEGIN or ';' (can't find IF)") ;; ;; we were at the starting IF in the first place.. ;; (throw 'simula-out t)))))) (defun simula-find-inspect () "Find INSPECT matching WHEN or OTHERWISE." (catch 'simula-out (let ((level 0)) ;; ;; INSPECTs can be nested, have to find the corresponding one ;; (while t (if (and (simula-search-backward "\\\\|\\\\|;" nil t) (/= (following-char) ?\;)) (if (memq (following-char) '(?O ?o)) (setq level (1+ level)) (if (zerop level) (throw 'simula-out t) (setq level (1- level)))) (error "Missing INSPECT or misplaced ';' (can't find INSPECT)")))))) (defun simula-find-do-match () "Find keyword matching DO: FOR, WHILE, INSPECT or WHEN" (while (and (re-search-backward "\\<\\(do\\|for\\|while\\|inspect\\|when\\|end\\|begin\\)\\>\\|;" nil 'move) (simula-context))) (if (and (looking-at "\\<\\(for\\|while\\|inspect\\|when\\)\\>") (not (simula-context))) () ;; found match (error "No matching FOR, WHILE or INSPECT for DO, or misplaced ';'"))) (defun simula-inside-parens () "Return position after `(' on line if inside parentheses, nil otherwise." (save-excursion (let ((parlevel 0)) (catch 'simula-out (while t (if (re-search-backward "(\\|)\\|;" nil t) (if (eq (simula-context) nil) ;; found something - check it out (cond ((eq (following-char) ?\;) (if (zerop parlevel) (throw 'simula-out nil) (error "Parenthesis mismatch or misplaced ';'"))) ((eq (following-char) ?\() (if (zerop parlevel) (throw 'simula-out (1+ (current-column))) (setq parlevel (1- parlevel)))) (t (setq parlevel (1+ parlevel)))) );; nothing - inside comment or string ;; search failed (throw 'simula-out nil))))))) (defun simula-goto-definition () "Goto point of definition of variable, procedure or class." (interactive)) (defun simula-expand-stdproc () (if (or (not simula-abbrev-stdproc) (simula-context)) (unexpand-abbrev) (cond ((eq simula-abbrev-stdproc 'upcase) (upcase-word -1)) ((eq simula-abbrev-stdproc 'downcase) (downcase-word -1)) ((eq simula-abbrev-stdproc 'capitalize) (capitalize-word -1))))) (defun simula-expand-keyword () (if (or (not simula-abbrev-keyword) (simula-context)) (unexpand-abbrev) (cond ((eq simula-abbrev-keyword 'upcase) (upcase-word -1)) ((eq simula-abbrev-keyword 'downcase) (downcase-word -1)) ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1))))) (defun simula-electric-keyword () "Expand SIMULA keyword. If it starts the line, reindent." ;; redisplay (let ((show-char (eq this-command 'self-insert-command))) ;; If the abbrev expansion results in reindentation, the user may have ;; to wait some time before the character he typed is displayed ;; (the char causing the expansion is inserted AFTER the hook function ;; is called). This is annoying in case of normal characters. ;; However, if the user pressed a key bound to newline, it is better ;; to have the line inserted after the begin-end match. (if show-char (progn (insert-char last-command-char 1) (sit-for 0) (backward-char 1))) (if (let ((where (simula-context)) (case-fold-search t)) (if where (if (and (eq where 2) (eq (char-syntax (preceding-char)) ?w)) (save-excursion (backward-word 1) (not (looking-at "end\\>")))))) (unexpand-abbrev) (cond ((not simula-abbrev-keyword) (unexpand-abbrev)) ((eq simula-abbrev-keyword 'upcase) (upcase-word -1)) ((eq simula-abbrev-keyword 'downcase) (downcase-word -1)) ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1))) (let ((pos (- (point-max) (point))) (case-fold-search t) null) (condition-case null (progn ;; check if the expanded word is on the beginning of the line. (if (and (eq (char-syntax (preceding-char)) ?w) (progn (backward-word 1) (if (looking-at "end\\>") (save-excursion (simula-backward-up-level 1) (if (pos-visible-in-window-p) (sit-for 1) (message (concat "Matches " (buffer-substring (point) (+ (point) (window-width)))))))) (skip-chars-backward " \t\f") (bolp))) (let ((indent (simula-calculate-indent))) (if (eq indent (current-indentation)) () (delete-horizontal-space) (indent-to indent))) (skip-chars-forward " \t\f")) ;; check for END - blow whistles and ring bells (goto-char (- (point-max) pos)) (if show-char (delete-char 1))) (quit (goto-char (- (point-max) pos)))))))) (defun simula-search-backward (string &optional limit move) (setq string (concat string "\\|\\")) (let (level) (catch 'simula-out (while (re-search-backward string limit move) (if (simula-context) () (if (looking-at "\\") (progn (setq level 0) (while (natnump level) (re-search-backward "\\\\|\\") (if (simula-context) () (setq level (if (memq (following-char) '(?b ?B)) (1- level) (1+ level)))))) (throw 'simula-out t))))))) (defun simula-search-forward (string &optional limit move) (setq string (concat string "\\|\\")) (let (level) (catch 'exit (while (re-search-forward string limit move) (goto-char (match-beginning 0)) (if (simula-context) (goto-char (1- (match-end 0))) (if (looking-at "\\") (progn (goto-char (1- (match-end 0))) (setq level 0) (while (natnump level) (re-search-forward "\\\\|\\") (backward-word 1) (if (not (simula-context)) (setq level (if (memq (following-char) '(?e ?E)) (1- level) (1+ level)))) (backward-word -1))) (goto-char (1- (match-end 0))) (throw 'exit t))))))) (defun simula-install-standard-abbrevs () "Define Simula keywords, procedures and classes in local abbrev table." ;; procedure and class names are as of the SIMULA 87 standard. (interactive) (mapcar (function (lambda (args) (apply 'define-abbrev simula-mode-abbrev-table args))) '(("abs" "Abs" simula-expand-stdproc) ("accum" "Accum" simula-expand-stdproc) ("activate" "ACTIVATE" simula-expand-keyword) ("addepsilon" "AddEpsilon" simula-expand-stdproc) ("after" "AFTER" simula-expand-keyword) ("and" "AND" simula-expand-keyword) ("arccos" "ArcCos" simula-expand-stdproc) ("arcsin" "ArcSin" simula-expand-stdproc) ("arctan" "ArcTan" simula-expand-stdproc) ("arctan2" "ArcTan2" simula-expand-stdproc) ("array" "ARRAY" simula-expand-keyword) ("at" "AT" simula-expand-keyword) ("before" "BEFORE" simula-expand-keyword) ("begin" "BEGIN" simula-expand-keyword) ("blanks" "Blanks" simula-expand-stdproc) ("boolean" "BOOLEAN" simula-expand-keyword) ("breakoutimage" "BreakOutImage" simula-expand-stdproc) ("bytefile" "ByteFile" simula-expand-stdproc) ("call" "Call" simula-expand-stdproc) ("cancel" "Cancel" simula-expand-stdproc) ("cardinal" "Cardinal" simula-expand-stdproc) ("char" "Char" simula-expand-stdproc) ("character" "CHARACTER" simula-expand-keyword) ("checkpoint" "CheckPoint" simula-expand-stdproc) ("class" "CLASS" simula-expand-keyword) ("clear" "Clear" simula-expand-stdproc) ("clocktime" "ClockTime" simula-expand-stdproc) ("close" "Close" simula-expand-stdproc) ("comment" "COMMENT" simula-expand-keyword) ("constant" "Constant" simula-expand-stdproc) ("copy" "Copy" simula-expand-stdproc) ("cos" "Cos" simula-expand-stdproc) ("cosh" "CosH" simula-expand-stdproc) ("cotan" "CoTan" simula-expand-stdproc) ("cputime" "CpuTime" simula-expand-stdproc) ("current" "Current" simula-expand-stdproc) ("datetime" "DateTime" simula-expand-stdproc) ("decimalmark" "DecimalMark" simula-expand-stdproc) ("delay" "DELAY" simula-expand-keyword) ("deleteimage" "DeleteImage" simula-expand-stdproc) ("detach" "Detach" simula-expand-stdproc) ("digit" "Digit" simula-expand-stdproc) ("directbytefile" "DirectByteFile" simula-expand-stdproc) ("directfile" "DirectFile" simula-expand-stdproc) ("discrete" "Discrete" simula-expand-stdproc) ("do" "DO" simula-expand-keyword) ("downcase" "Downcase" simula-expand-stdproc) ("draw" "Draw" simula-expand-stdproc) ("eject" "Eject" simula-expand-stdproc) ("else" "ELSE" simula-electric-keyword) ("empty" "Empty" simula-expand-stdproc) ("end" "END" simula-electric-keyword) ("endfile" "Endfile" simula-expand-stdproc) ("entier" "Entier" simula-expand-stdproc) ("eq" "EQ" simula-expand-keyword) ("eqv" "EQV" simula-expand-keyword) ("erlang" "Erlang" simula-expand-stdproc) ("error" "Error" simula-expand-stdproc) ("evtime" "EvTime" simula-expand-stdproc) ("exp" "Exp" simula-expand-stdproc) ("external" "EXTERNAL" simula-expand-keyword) ("false" "FALSE" simula-expand-keyword) ("field" "Field" simula-expand-stdproc) ("file" "File" simula-expand-stdproc) ("first" "First" simula-expand-stdproc) ("follow" "Follow" simula-expand-stdproc) ("for" "FOR" simula-expand-keyword) ("ge" "GE" simula-expand-keyword) ("getchar" "GetChar" simula-expand-stdproc) ("getfrac" "GetFrac" simula-expand-stdproc) ("getint" "GetInt" simula-expand-stdproc) ("getreal" "GetReal" simula-expand-stdproc) ("go" "GO" simula-expand-keyword) ("goto" "GOTO" simula-expand-keyword) ("gt" "GT" simula-expand-keyword) ("head" "Head" simula-expand-stdproc) ("hidden" "HIDDEN" simula-expand-keyword) ("histd" "HistD" simula-expand-stdproc) ("histo" "Histo" simula-expand-stdproc) ("hold" "Hold" simula-expand-stdproc) ("idle" "Idle" simula-expand-stdproc) ("if" "IF" simula-expand-keyword) ("image" "Image" simula-expand-stdproc) ("imagefile" "ImageFile" simula-expand-stdproc) ("imp" "IMP" simula-expand-keyword) ("in" "IN" simula-expand-keyword) ("inbyte" "InByte" simula-expand-stdproc) ("inbytefile" "InByteFile" simula-expand-stdproc) ("inchar" "InChar" simula-expand-stdproc) ("infile" "InFile" simula-expand-stdproc) ("infrac" "InFrac" simula-expand-stdproc) ("inimage" "InImage" simula-expand-stdproc) ("inint" "InInt" simula-expand-stdproc) ("inner" "INNER" simula-expand-keyword) ("inreal" "InReal" simula-expand-stdproc) ("inrecord" "InRecord" simula-expand-stdproc) ("inspect" "INSPECT" simula-expand-keyword) ("integer" "INTEGER" simula-expand-keyword) ("intext" "InText" simula-expand-stdproc) ("into" "Into" simula-expand-stdproc) ("is" "IS" simula-expand-keyword) ("isochar" "ISOChar" simula-expand-stdproc) ("isopen" "IsOpen" simula-expand-stdproc) ("isorank" "ISORank" simula-expand-stdproc) ("label" "LABEL" simula-expand-keyword) ("last" "Last" simula-expand-stdproc) ("lastitem" "LastItem" simula-expand-stdproc) ("lastloc" "LastLoc" simula-expand-stdproc) ("le" "LE" simula-expand-keyword) ("length" "Length" simula-expand-stdproc) ("letter" "Letter" simula-expand-stdproc) ("line" "Line" simula-expand-stdproc) ("linear" "Linear" simula-expand-stdproc) ("linesperpage" "LinesPerPage" simula-expand-stdproc) ("link" "Link" simula-expand-stdproc) ("linkage" "Linkage" simula-expand-stdproc) ("ln" "Ln" simula-expand-stdproc) ("locate" "Locate" simula-expand-stdproc) ("location" "Location" simula-expand-stdproc) ("lock" "Lock" simula-expand-stdproc) ("locked" "Locked" simula-expand-stdproc) ("log10" "Log10" simula-expand-stdproc) ("long" "LONG" simula-expand-keyword) ("lowcase" "LowCase" simula-expand-stdproc) ("lowerbound" "LowerBound" simula-expand-stdproc) ("lowten" "LowTen" simula-expand-stdproc) ("lt" "LT" simula-expand-keyword) ("main" "Main" simula-expand-stdproc) ("max" "Max" simula-expand-stdproc) ("maxint" "MaxInt" simula-expand-stdproc) ("maxlongreal" "MaxLongReal" simula-expand-stdproc) ("maxloc" "MaxLoc" simula-expand-stdproc) ("maxrank" "MaxRank" simula-expand-stdproc) ("maxreal" "MaxReal" simula-expand-stdproc) ("min" "Min" simula-expand-stdproc) ("minint" "MinInt" simula-expand-stdproc) ("minlongreal" "MinLongReal" simula-expand-stdproc) ("minrank" "MinRank" simula-expand-stdproc) ("minreal" "MinReal" simula-expand-stdproc) ("mod" "Mod" simula-expand-stdproc) ("more" "More" simula-expand-stdproc) ("name" "NAME" simula-expand-keyword) ("ne" "NE" simula-expand-keyword) ("negexp" "NegExp" simula-expand-stdproc) ("new" "NEW" simula-expand-keyword) ("nextev" "NextEv" simula-expand-stdproc) ("none" "NONE" simula-expand-keyword) ("normal" "Normal" simula-expand-stdproc) ("not" "NOT" simula-expand-keyword) ("notext" "NOTEXT" simula-expand-keyword) ("open" "Open" simula-expand-stdproc) ("or" "OR" simula-expand-keyword) ("otherwise" "OTHERWISE" simula-electric-keyword) ("out" "Out" simula-expand-stdproc) ("outbyte" "OutByte" simula-expand-stdproc) ("outbytefile" "OutByteFile" simula-expand-stdproc) ("outchar" "OutChar" simula-expand-stdproc) ("outfile" "OutFile" simula-expand-stdproc) ("outfix" "OutFix" simula-expand-stdproc) ("outfrac" "OutFrac" simula-expand-stdproc) ("outimage" "OutImage" simula-expand-stdproc) ("outint" "OutInt" simula-expand-stdproc) ("outreal" "OutReal" simula-expand-stdproc) ("outrecord" "OutRecord" simula-expand-stdproc) ("outtext" "OutText" simula-expand-stdproc) ("page" "Page" simula-expand-stdproc) ("passivate" "Passivate" simula-expand-stdproc) ("poisson" "Poisson" simula-expand-stdproc) ("pos" "Pos" simula-expand-stdproc) ("precede" "Precede" simula-expand-stdproc) ("pred" "Pred" simula-expand-stdproc) ("prev" "Prev" simula-expand-stdproc) ("printfile" "PrintFile" simula-expand-stdproc) ("prior" "PRIOR" simula-expand-keyword) ("procedure" "PROCEDURE" simula-expand-keyword) ("process" "Process" simula-expand-stdproc) ("protected" "PROTECTED" simula-expand-keyword) ("putchar" "PutChar" simula-expand-stdproc) ("putfix" "PutFix" simula-expand-stdproc) ("putfrac" "PutFrac" simula-expand-stdproc) ("putint" "PutInt" simula-expand-stdproc) ("putreal" "PutReal" simula-expand-stdproc) ("qua" "QUA" simula-expand-keyword) ("randint" "RandInt" simula-expand-stdproc) ("rank" "Rank" simula-expand-stdproc) ("reactivate" "REACTIVATE" simula-expand-keyword) ("real" "REAL" simula-expand-keyword) ("ref" "REF" simula-expand-keyword) ("resume" "Resume" simula-expand-stdproc) ("setaccess" "SetAccess" simula-expand-stdproc) ("setpos" "SetPos" simula-expand-stdproc) ("short" "SHORT" simula-expand-keyword) ("sign" "Sign" simula-expand-stdproc) ("simset" "SimSet" simula-expand-stdproc) ("simulaid" "SimulaId" simula-expand-stdproc) ("simulation" "Simulation" simula-expand-stdproc) ("sin" "Sin" simula-expand-stdproc) ("sinh" "SinH" simula-expand-stdproc) ("sourceline" "SourceLine" simula-expand-stdproc) ("spacing" "Spacing" simula-expand-stdproc) ("sqrt" "Sqrt" simula-expand-stdproc) ("start" "Start" simula-expand-stdproc) ("step" "STEP" simula-expand-keyword) ("strip" "Strip" simula-expand-stdproc) ("sub" "Sub" simula-expand-stdproc) ("subepsilon" "SubEpsilon" simula-expand-stdproc) ("suc" "Suc" simula-expand-stdproc) ("switch" "SWITCH" simula-expand-keyword) ("sysin" "SysIn" simula-expand-stdproc) ("sysout" "SysOut" simula-expand-stdproc) ("tan" "Tan" simula-expand-stdproc) ("tanh" "TanH" simula-expand-stdproc) ("terminate_program" "Terminate_Program" simula-expand-stdproc) ("terminated" "Terminated" simula-expand-stdproc) ("text" "TEXT" simula-expand-keyword) ("then" "THEN" simula-electric-keyword) ("this" "THIS" simula-expand-keyword) ("time" "Time" simula-expand-stdproc) ("to" "TO" simula-expand-keyword) ("true" "TRUE" simula-expand-keyword) ("uniform" "Uniform" simula-expand-stdproc) ("unlock" "Unlock" simula-expand-stdproc) ("until" "UNTIL" simula-expand-keyword) ("upcase" "Upcase" simula-expand-stdproc) ("upperbound" "UpperBound" simula-expand-stdproc) ("value" "VALUE" simula-expand-keyword) ("virtual" "VIRTUAL" simula-expand-keyword) ("wait" "Wait" simula-expand-stdproc) ("when" "WHEN" simula-electric-keyword) ("while" "WHILE" simula-expand-keyword)))) ;;; simula.el ends here emacs-19.30/lisp/skeleton.el100444 75424 1 45151 6046306005 14444 0ustar kwzhdaemon;;; skeleton.el --- Lisp language extension for writing statement skeletons ;; Copyright (C) 1993, 1994, 1995 by Free Software Foundation, Inc. ;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 ;; Maintainer: FSF ;; Keywords: extensions, abbrev, languages, tools ;; 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: ;; A very concise language extension for writing structured statement ;; skeleton insertion commands for programming language modes. This ;; originated in shell-script mode and was applied to ada-mode's ;; commands which shrunk to one third. And these commands are now ;; user configurable. ;;; Code: ;; page 1: statement skeleton language definition & interpreter ;; page 2: paired insertion ;; page 3: mirror-mode, an example for setting up paired insertion (defvar skeleton-transformation nil "*If non-nil, function applied to literal strings before they are inserted. It should take strings and characters and return them transformed, or nil which means no transformation. Typical examples might be `upcase' or `capitalize'.") ; this should be a fourth argument to defvar (put 'skeleton-transformation 'variable-interactive "aTransformation function: ") (defvar skeleton-end-hook (lambda () (or (eolp) (newline-and-indent))) "Hook called at end of skeleton but before going to point of interest. By default this moves out anything following to next line. The variables `v1' and `v2' are still set when calling this.") ;;;###autoload (defvar skeleton-filter 'identity "Function for transforming a skeleton-proxy's aliases' variable value.") (defvar skeleton-untabify t "When non-`nil' untabifies when deleting backwards with element -ARG.") (defvar skeleton-newline-indent-rigidly nil "When non-`nil', indent rigidly under current line for element `\\n'. Else use mode's `indent-line-function'.") (defvar skeleton-further-elements () "A buffer-local varlist (see `let') of mode specific skeleton elements. These variables are bound while interpreting a skeleton. Their value may in turn be any valid skeleton element if they are themselves to be used as skeleton elements.") (make-variable-buffer-local 'skeleton-further-elements) (defvar skeleton-subprompt (substitute-command-keys "RET, \\\\[abort-recursive-edit] or \\[help-command]") "*Replacement for %s in prompts of recursive subskeletons.") (defvar skeleton-abbrev-cleanup nil) (defvar skeleton-debug nil "*If non-nil `define-skeleton' will override previous definition.") ;; reduce the number of compiler warnings (defvar skeleton) (defvar skeleton-modified) (defvar skeleton-point) (defvar skeleton-regions) ;;;###autoload (defmacro define-skeleton (command documentation &rest skeleton) "Define a user-configurable COMMAND that enters a statement skeleton. DOCUMENTATION is that of the command, while the variable of the same name, which contains the skeleton, has a documentation to that effect. INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'." (if skeleton-debug (set command skeleton)) `(progn (defvar ,command ',skeleton ,documentation) (defalias ',command 'skeleton-proxy))) ;; This command isn't meant to be called, only it's aliases with meaningful ;; names are. ;;;###autoload (defun skeleton-proxy (&optional str arg) "Insert skeleton defined by variable of same name (see `skeleton-insert'). Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). This command can also be an abbrev expansion (3rd and 4th columns in \\[edit-abbrevs] buffer: \"\" command-name). When called as a function, optional first argument STR may also be a string which will be the value of `str' whereas the skeleton's interactor is then ignored." (interactive "*P\nP") (let ((function (nth 1 (backtrace-frame 1)))) (if (eq function 'nth) ; uncompiled lisp function (setq function (nth 1 (backtrace-frame 5))) (if (eq function 'byte-code) ; tracing byte-compiled function (setq function (nth 1 (backtrace-frame 2))))) (if (not (setq function (funcall skeleton-filter (symbol-value function)))) (if (memq this-command '(self-insert-command skeleton-pair-insert-maybe expand-abbrev)) (setq buffer-undo-list (primitive-undo 1 buffer-undo-list))) (skeleton-insert function (if (setq skeleton-abbrev-cleanup (or (eq this-command 'self-insert-command) (eq this-command 'skeleton-pair-insert-maybe))) () ;; Pretend C-x a e passed its prefix arg to us (if (or arg current-prefix-arg) (prefix-numeric-value (or arg current-prefix-arg)))) (if (stringp str) str)) (if skeleton-abbrev-cleanup (setq deferred-action-list t deferred-action-function 'skeleton-abbrev-cleanup skeleton-abbrev-cleanup (point)))))) (defun skeleton-abbrev-cleanup (&rest list) "Value for `post-command-hook' to remove char that expanded abbrev." (if (integerp skeleton-abbrev-cleanup) (progn (delete-region skeleton-abbrev-cleanup (point)) (setq deferred-action-list () deferred-action-function nil skeleton-abbrev-cleanup nil)))) ;;;###autoload (defun skeleton-insert (skeleton &optional skeleton-regions str) "Insert the complex statement skeleton SKELETON describes very concisely. With optional third REGIONS wrap first interesting point (`_') in skeleton around next REGIONS words, if REGIONS is positive. If REGIONS is negative, wrap REGIONS preceding interregions into first REGIONS interesting positions \(successive `_'s) in skeleton. An interregion is the stretch of text between two contiguous marked points. If you marked A B C [] (where [] is the cursor) in alphabetical order, the 3 interregions are simply the last 3 regions. But if you marked B A [] C, the interregions are B-A, A-[], []-C. Optional fourth STR is the value for the variable `str' within the skeleton. When this is non-`nil' the interactor gets ignored, and this should be a valid skeleton element. SKELETON is made up as (INTERACTOR ELEMENT ...). INTERACTOR may be nil if not needed, a prompt-string or an expression for complex read functions. If ELEMENT is a string or a character it gets inserted (see also `skeleton-transformation'). Other possibilities are: \\n go to next line and indent according to mode _ interesting point, interregion here, point after termination > indent line (or interregion if > _) according to major mode & do next ELEMENT if previous moved point | do next ELEMENT if previous didn't move point -num delete num preceding characters (see `skeleton-untabify') resume: skipped, continue here if quit is signaled nil skipped Further elements can be defined via `skeleton-further-elements'. ELEMENT may itself be a SKELETON with an INTERACTOR. The user is prompted repeatedly for different inputs. The SKELETON is processed as often as the user enters a non-empty string. \\[keyboard-quit] terminates skeleton insertion, but continues after `resume:' and positions at `_' if any. If INTERACTOR in such a subskeleton is a prompt-string which contains a \".. %s ..\" it is formatted with `skeleton-subprompt'. Such an INTERACTOR may also a list of strings with the subskeleton being repeated once for each string. Quoted lisp-expressions are evaluated evaluated for their side-effect. Other lisp-expressions are evaluated and the value treated as above. Note that expressions may not return `t' since this impplies an endless loop. Modes can define other symbols by locally setting them to any valid skeleton element. The following local variables are available: str first time: read a string according to INTERACTOR then: insert previously read string once more help help-form during interaction with the user or `nil' input initial input (string or cons with index) while reading str v1, v2 local variables for memorising anything you want When done with skeleton, but before going back to `_'-point call `skeleton-end-hook' if that is non-`nil'." (and skeleton-regions (setq skeleton-regions (if (> skeleton-regions 0) (list (point-marker) (save-excursion (forward-word skeleton-regions) (point-marker))) (setq skeleton-regions (- skeleton-regions)) ;; copy skeleton-regions - 1 elements from `mark-ring' (let ((l1 (cons (mark-marker) mark-ring)) (l2 (list (point-marker)))) (while (and l1 (> skeleton-regions 0)) (setq l2 (cons (car l1) l2) skeleton-regions (1- skeleton-regions) l1 (cdr l1))) (sort l2 '<)))) (goto-char (car skeleton-regions)) (setq skeleton-regions (cdr skeleton-regions))) (let ((beg (point)) skeleton-modified skeleton-point resume: help input v1 v2) (unwind-protect (eval `(let ,skeleton-further-elements (skeleton-internal-list skeleton str))) (run-hooks 'skeleton-end-hook) (sit-for 0) (or (pos-visible-in-window-p beg) (progn (goto-char beg) (recenter 0))) (if skeleton-point (goto-char skeleton-point))))) (defun skeleton-read (str &optional initial-input recursive) "Function for reading a string from the minibuffer within skeletons. PROMPT may contain a `%s' which will be replaced by `skeleton-subprompt'. If non-`nil' second arg INITIAL-INPUT or variable `input' is a string or cons with index to insert before reading. If third arg RECURSIVE is non-`nil' i.e. we are handling the iterator of a subskeleton, returns empty string if user didn't modify input. While reading, the value of `minibuffer-help-form' is variable `help' if that is non-`nil' or a default string." (let ((minibuffer-help-form (or (if (boundp 'help) (symbol-value 'help)) (if recursive "\ As long as you provide input you will insert another subskeleton. If you enter the empty string, the loop inserting subskeletons is left, and the current one is removed as far as it has been entered. If you quit, the current subskeleton is removed as far as it has been entered. No more of the skeleton will be inserted, except maybe for a syntactically necessary termination." "\ You are inserting a skeleton. Standard text gets inserted into the buffer automatically, and you are prompted to fill in the variable parts."))) (eolp (eolp))) ;; since Emacs doesn't show main window's cursor, do something noticeable (or eolp (open-line 1)) (unwind-protect (setq str (if (stringp str) (read-string (format str skeleton-subprompt) (setq initial-input (or initial-input (symbol-value 'input)))) (eval str))) (or eolp (delete-char 1)))) (if (and recursive (or (null str) (string= str "") (equal str initial-input) (equal str (car-safe initial-input)))) (signal 'quit t) str)) (defun skeleton-internal-list (skeleton &optional str recursive) (let* ((start (save-excursion (beginning-of-line) (point))) (column (current-column)) (line (buffer-substring start (save-excursion (end-of-line) (point)))) opoint) (or str (setq str `(setq str (skeleton-read ',(car skeleton) nil ,recursive)))) (while (setq skeleton-modified (eq opoint (point)) opoint (point) skeleton (cdr skeleton)) (condition-case quit (skeleton-internal-1 (car skeleton)) (quit (if (eq (cdr quit) 'recursive) (setq recursive 'quit skeleton (memq 'resume: skeleton)) ;; remove the subskeleton as far as it has been shown ;; the subskeleton shouldn't have deleted outside current line (end-of-line) (delete-region start (point)) (insert line) (move-to-column column) (if (cdr quit) (setq skeleton () recursive nil) (signal 'quit 'recursive))))))) ;; maybe continue loop or go on to next outer resume: section (if (eq recursive 'quit) (signal 'quit 'recursive) recursive)) (defun skeleton-internal-1 (element &optional literal) (cond ((char-or-string-p element) (if (and (integerp element) ; -num (< element 0)) (if skeleton-untabify (backward-delete-char-untabify (- element)) (delete-backward-char (- element))) (insert-before-markers (if (and skeleton-transformation (not literal)) (funcall skeleton-transformation element) element)))) ((eq element '\n) ; actually (eq '\n 'n) (if (and skeleton-regions (eq (nth 1 skeleton) '_)) (progn (or (eolp) (newline)) (indent-region (point) (car skeleton-regions) nil)) (if skeleton-newline-indent-rigidly (indent-to (prog1 (current-indentation) (newline))) (newline) (indent-according-to-mode)))) ((eq element '>) (if (and skeleton-regions (eq (nth 1 skeleton) '_)) (indent-region (point) (car skeleton-regions) nil) (indent-according-to-mode))) ((eq element '_) (if skeleton-regions (progn (goto-char (car skeleton-regions)) (setq skeleton-regions (cdr skeleton-regions)) (and (<= (current-column) (current-indentation)) (eq (nth 1 skeleton) '\n) (end-of-line 0))) (or skeleton-point (setq skeleton-point (point))))) ((eq element '&) (if skeleton-modified (setq skeleton (cdr skeleton)))) ((eq element '|) (or skeleton-modified (setq skeleton (cdr skeleton)))) ((eq 'quote (car-safe element)) (eval (nth 1 element))) ((or (stringp (car-safe element)) (consp (car-safe element))) (if (symbolp (car-safe (car element))) (while (skeleton-internal-list element nil t)) (setq literal (car element)) (while literal (skeleton-internal-list element (car literal)) (setq literal (cdr literal))))) ((null element)) ((skeleton-internal-1 (eval element) t)))) ;; Maybe belongs into simple.el or elsewhere (define-skeleton local-variables-section "Insert a local variables section. Use current comment syntax if any." () '(save-excursion (if (re-search-forward page-delimiter nil t) (error "Not on last page."))) comment-start "Local Variables:" comment-end \n comment-start "mode: " (completing-read "Mode: " obarray (lambda (symbol) (if (commandp symbol) (string-match "-mode$" (symbol-name symbol)))) t) & -5 | '(kill-line 0) & -1 | comment-end \n ( (completing-read (format "Variable, %s: " skeleton-subprompt) obarray (lambda (symbol) (or (eq symbol 'eval) (user-variable-p symbol))) t) comment-start str ": " (read-from-minibuffer "Expression: " nil read-expression-map nil 'read-expression-history) | _ comment-end \n) resume: comment-start "End:" comment-end) ;; Variables and command for automatically inserting pairs like () or "". (defvar skeleton-pair nil "*If this is nil pairing is turned off, no matter what else is set. Otherwise modes with `skeleton-pair-insert-maybe' on some keys will attempt to insert pairs of matching characters.") (defvar skeleton-pair-on-word nil "*If this is nil, paired insertion is inhibited before or inside a word.") (defvar skeleton-pair-filter (lambda ()) "Attempt paired insertion if this function returns nil, before inserting. This allows for context-sensitive checking whether pairing is appropriate.") (defvar skeleton-pair-alist () "An override alist of pairing partners matched against `last-command-char'. Each alist element, which looks like (ELEMENT ...), is passed to `skeleton-insert' with no interactor. Variable `str' does nothing. Elements might be (?` ?` _ \"''\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n ?} >).") ;;;###autoload (defun skeleton-pair-insert-maybe (arg) "Insert the character you type ARG times. With no ARG, if `skeleton-pair' is non-nil, and if `skeleton-pair-on-word' is non-nil or we are not before or inside a word, and if `skeleton-pair-filter' returns nil, pairing is performed. If a match is found in `skeleton-pair-alist', that is inserted, else the defaults are used. These are (), [], {}, <> and `' for the symmetrical ones, and the same character twice for the others." (interactive "*P") (if (or arg overwrite-mode (not skeleton-pair) (if (not skeleton-pair-on-word) (looking-at "\\w")) (funcall skeleton-pair-filter)) (self-insert-command (prefix-numeric-value arg)) (self-insert-command 1) (if skeleton-abbrev-cleanup () ;; (preceding-char) is stripped of any Meta-stuff in last-command-char (if (setq arg (assq (preceding-char) skeleton-pair-alist)) ;; typed char is inserted (car is no real interactor) (let (skeleton-end-hook) (skeleton-insert arg)) (save-excursion (insert (or (cdr (assq (preceding-char) '((?( . ?)) (?[ . ?]) (?{ . ?}) (?< . ?>) (?` . ?')))) last-command-char))))))) ;;; ;; A more serious example can be found in sh-script.el ;;; ;; The quote before (defun prevents this from being byte-compiled. ;;;(defun mirror-mode () ;;; "This major mode is an amusing little example of paired insertion. ;;;All printable characters do a paired self insert, while the other commands ;;;work normally." ;;; (interactive) ;;; (kill-all-local-variables) ;;; (make-local-variable 'pair) ;;; (make-local-variable 'pair-on-word) ;;; (make-local-variable 'pair-filter) ;;; (make-local-variable 'pair-alist) ;;; (setq major-mode 'mirror-mode ;;; mode-name "Mirror" ;;; pair-on-word t ;;; ;; in the middle column insert one or none if odd window-width ;;; pair-filter (lambda () ;;; (if (>= (current-column) ;;; (/ (window-width) 2)) ;;; ;; insert both on next line ;;; (next-line 1) ;;; ;; insert one or both? ;;; (= (* 2 (1+ (current-column))) ;;; (window-width)))) ;;; ;; mirror these the other way round as well ;;; pair-alist '((?) _ ?() ;;; (?] _ ?[) ;;; (?} _ ?{) ;;; (?> _ ?<) ;;; (?/ _ ?\\) ;;; (?\\ _ ?/) ;;; (?` ?` _ "''") ;;; (?' ?' _ "``")) ;;; ;; in this mode we exceptionally ignore the user, else it's no fun ;;; pair t) ;;; (let ((map (make-keymap)) ;;; (i ? )) ;;; (use-local-map map) ;;; (setq map (car (cdr map))) ;;; (while (< i ?\^?) ;;; (aset map i 'skeleton-pair-insert-maybe) ;;; (setq i (1+ i)))) ;;; (run-hooks 'mirror-mode-hook)) ;; skeleton.el ends here emacs-19.30/lisp/solar.el100444 22346 1 62275 6030151200 14545 0ustar reingolddaemon;;; solar.el --- calendar functions for solar events. ;; Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary, ;; holidays ;; 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 collection of functions implements the features of calendar.el, ;; diary.el, and holiday.el that deal with times of day, sunrise/sunset, and ;; eqinoxes/solstices. ;; Based on the ``Almanac for Computers 1984,'' prepared by the Nautical ;; Almanac Office, United States Naval Observatory, Washington, 1984, on ;; ``Astronomical Formulae for Calculators,'' 3rd ed., by Jean Meeus, ;; Willmann-Bell, Inc., 1985, and on ``Astronomical Algorithms'' by Jean ;; Meeus, Willmann-Bell, Inc., 1991. ;; ;; WARNINGS: ;; 1. SUNRISE/SUNSET calculations will be accurate only to +/- 2 minutes. ;; Locations should be between +/- 65 degrees of latitude. ;; Dates should be in the latter half of the 20th century. ;; ;; 2. Equinox/solstice times will be accurate only to +/- 15 minutes. ;; The author would be delighted to have an astronomically more sophisticated ;; person rewrite the code for the solar calculations in this file! ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science ;; (217) 333-6733 University of Illinois at Urbana-Champaign ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue ;; Urbana, Illinois 61801 ;;; Code: (if (fboundp 'atan) (require 'lisp-float-type) (error "Solar/lunar calculations impossible since floating point is unavailable.")) (require 'cal-dst) ;;;###autoload (defvar calendar-time-display-form '(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)'.") ;;;###autoload (defvar calendar-latitude nil "*Latitude of `calendar-location-name' in degrees. The value can be either a decimal fraction (one place of accuracy is sufficient), + north, - south, such as 40.7 for New York City, or the value can be a vector [degrees minutes north/south] such as [40 50 north] for New York City. This variable should be set in site-local.el.") ;;;###autoload (defvar calendar-longitude nil "*Longitude of `calendar-location-name' in degrees. The value can be either a decimal fraction (one place of accuracy is sufficient), + east, - west, such as -73.9 for New York City, or the value can be a vector [degrees minutes east/west] such as [73 55 west] for New York City. This variable should be set in site-local.el.") (defsubst calendar-latitude () "Convert calendar-latitude to a signed decimal fraction, if needed." (if (numberp calendar-latitude) calendar-latitude (let ((lat (+ (aref calendar-latitude 0) (/ (aref calendar-latitude 1) 60.0)))) (if (equal (aref calendar-latitude 2) 'north) lat (- lat))))) (defsubst calendar-longitude () "Convert calendar-longitude to a signed decimal fraction, if needed." (if (numberp calendar-longitude) calendar-longitude (let ((long (+ (aref calendar-longitude 0) (/ (aref calendar-longitude 1) 60.0)))) (if (equal (aref calendar-longitude 2) 'east) long (- long))))) ;;;###autoload (defvar calendar-location-name '(let ((float-output-format "%.1f")) (format "%s%s, %s%s" (if (numberp calendar-latitude) (abs calendar-latitude) (+ (aref calendar-latitude 0) (/ (aref calendar-latitude 1) 60.0))) (if (numberp calendar-latitude) (if (> calendar-latitude 0) "N" "S") (if (equal (aref calendar-latitude 2) 'north) "N" "S")) (if (numberp calendar-longitude) (abs calendar-longitude) (+ (aref calendar-longitude 0) (/ (aref calendar-longitude 1) 60.0))) (if (numberp calendar-longitude) (if (> calendar-longitude 0) "E" "W") (if (equal (aref calendar-longitude 2) 'east) "E" "W")))) "*Expression evaluating to name of `calendar-longitude', calendar-latitude'. For example, \"New York City\". Default value is just the latitude, longitude pair. This variable should be set in site-local.el.") (defvar solar-n-hemi-seasons '("Vernal Equinox" "Summer Solstice" "Autumnal Equinox" "Winter Solstice") "List of season changes for the northern hemisphere.") (defvar solar-s-hemi-seasons '("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice") "List of season changes for the southern hemisphere.") (defun solar-setup () "Prompt user for latitude, longitude, and time zone." (beep) (if (not calendar-longitude) (setq calendar-longitude (solar-get-number "Enter longitude (decimal fraction; + east, - west): "))) (if (not calendar-latitude) (setq calendar-latitude (solar-get-number "Enter latitude (decimal fraction; + north, - south): "))) (if (not calendar-time-zone) (setq calendar-time-zone (solar-get-number "Enter difference from Coordinated Universal Time (in minutes): ")))) (defun solar-get-number (prompt) "Return a number from the minibuffer, prompting with PROMPT. Returns nil if nothing was entered." (let ((x (read-string prompt ""))) (if (not (string-equal x "")) (string-to-int x)))) (defsubst solar-sin-degrees (x) (sin (degrees-to-radians (mod x 360.0)))) (defsubst solar-cosine-degrees (x) (cos (degrees-to-radians (mod x 360.0)))) (defsubst solar-tangent-degrees (x) (tan (degrees-to-radians (mod x 360.0)))) (defun solar-xy-to-quadrant (x y) "Determines the quadrant of the point X, Y." (if (> x 0) (if (> y 0) 1 4) (if (> y 0) 2 3))) (defun solar-degrees-to-quadrant (angle) "Determines the quadrant of ANGLE." (1+ (floor (mod angle 360) 90))) (defun solar-arctan (x quad) "Arctangent of X in quadrant QUAD." (let ((deg (radians-to-degrees (atan x)))) (cond ((equal quad 2) (+ deg 180)) ((equal quad 3) (+ deg 180)) ((equal quad 4) (+ deg 360)) (t deg)))) (defun solar-arccos (x) (let ((y (sqrt (- 1 (* x x))))) (solar-arctan (/ y x) (solar-xy-to-quadrant x y)))) (defun solar-arcsin (y) (let ((x (sqrt (- 1 (* y y))))) (solar-arctan (/ y x) (solar-xy-to-quadrant x y)))) (defconst solar-earth-inclination 23.441884 "Inclination of earth's equator to its solar orbit in degrees.") (defconst solar-cos-inclination (solar-cosine-degrees solar-earth-inclination) "Cosine of earth's inclination.") (defconst solar-sin-inclination (solar-sin-degrees solar-earth-inclination) "Sine of earth's inclination.") (defconst solar-earth-orbit-eccentricity 0.016718 "Eccentricity of orbit of the earth around the sun.") (defsubst solar-degrees-to-hours (deg) (/ deg 15.0)) (defsubst solar-hours-to-days (hour) (/ hour 24.0)) (defun solar-longitude-of-sun (day) "Longitude of the sun at DAY in the year." (let ((mean-anomaly (- (* 0.9856 day) 3.289))) (mod (+ mean-anomaly (* 1.916 (solar-sin-degrees mean-anomaly)) (* 0.020 (solar-sin-degrees (* 2 mean-anomaly))) 282.634) 360))) (defun solar-right-ascension (longitude) "Right ascension of the sun, given its LONGITUDE." (solar-degrees-to-hours (solar-arctan (* solar-cos-inclination (solar-tangent-degrees longitude)) (solar-degrees-to-quadrant longitude)))) (defun solar-declination (longitude) "Declination of the sun, given its LONGITUDE." (solar-arcsin (* solar-sin-inclination (solar-sin-degrees longitude)))) (defun solar-sunrise (date) "Calculates the *standard* time of sunrise for Gregorian DATE. Calculation is for location given by `calendar-latitude' and `calendar-longitude'. Returns a decimal fraction of hours. Returns nil if the sun does not rise at that location on that day." (let* ((day-of-year (calendar-day-number date)) (approx-sunrise (+ day-of-year (solar-hours-to-days (- 6 (solar-degrees-to-hours (calendar-longitude)))))) (solar-longitude-of-sun-at-sunrise (solar-longitude-of-sun approx-sunrise)) (solar-right-ascension-at-sunrise (solar-right-ascension solar-longitude-of-sun-at-sunrise)) (solar-declination-at-sunrise (solar-declination solar-longitude-of-sun-at-sunrise)) (cos-local-sunrise (/ (- (solar-cosine-degrees (+ 90 (/ 50.0 60.0))) (* (solar-sin-degrees solar-declination-at-sunrise) (solar-sin-degrees (calendar-latitude)))) (* (solar-cosine-degrees solar-declination-at-sunrise) (solar-cosine-degrees (calendar-latitude)))))) (if (<= (abs cos-local-sunrise) 1);; otherwise, no sunrise that day (let* ((local-sunrise (solar-degrees-to-hours (- 360 (solar-arccos cos-local-sunrise)))) (local-mean-sunrise (mod (- (+ local-sunrise solar-right-ascension-at-sunrise) (+ (* 0.065710 approx-sunrise) 6.622)) 24))) (+ (- local-mean-sunrise (solar-degrees-to-hours (calendar-longitude))) (/ calendar-time-zone 60.0)))))) (defun solar-sunset (date) "Calculates the *standard* time of sunset for Gregorian DATE. Calculation is for location given by `calendar-latitude' and `calendar-longitude'. Returns a decimal fractions of hours. Returns nil if the sun does not set at that location on that day." (let* ((day-of-year (calendar-day-number date)) (approx-sunset (+ day-of-year (solar-hours-to-days (- 18 (solar-degrees-to-hours (calendar-longitude)))))) (solar-longitude-of-sun-at-sunset (solar-longitude-of-sun approx-sunset)) (solar-right-ascension-at-sunset (solar-right-ascension solar-longitude-of-sun-at-sunset)) (solar-declination-at-sunset (solar-declination solar-longitude-of-sun-at-sunset)) (cos-local-sunset (/ (- (solar-cosine-degrees (+ 90 (/ 50.0 60.0))) (* (solar-sin-degrees solar-declination-at-sunset) (solar-sin-degrees (calendar-latitude)))) (* (solar-cosine-degrees solar-declination-at-sunset) (solar-cosine-degrees (calendar-latitude)))))) (if (<= (abs cos-local-sunset) 1);; otherwise, no sunset that day (let* ((local-sunset (solar-degrees-to-hours (solar-arccos cos-local-sunset))) (local-mean-sunset (mod (- (+ local-sunset solar-right-ascension-at-sunset) (+ (* 0.065710 approx-sunset) 6.622)) 24))) (+ (- local-mean-sunset (solar-degrees-to-hours (calendar-longitude))) (/ calendar-time-zone 60.0)))))) (defun solar-time-string (time time-zone) "Printable form for decimal fraction TIME in TIME-ZONE. Format used is given by `calendar-time-display-form'." (let* ((time (round (* 60 time))) (24-hours (/ time 60)) (minutes (format "%02d" (% time 60))) (12-hours (format "%d" (1+ (% (+ 24-hours 11) 12)))) (am-pm (if (>= 24-hours 12) "pm" "am")) (24-hours (format "%02d" 24-hours))) (mapconcat 'eval calendar-time-display-form ""))) (defun solar-sunrise-sunset (date) "String giving local times of sunrise and sunset on Gregorian DATE." (let* ((rise (solar-sunrise date)) (adj-rise (if rise (dst-adjust-time date rise))) (set (solar-sunset date)) (adj-set (if set (dst-adjust-time date set)))) (format "%s, %s at %s" (if (and rise (calendar-date-equal date (car adj-rise))) (concat "Sunrise " (apply 'solar-time-string (cdr adj-rise))) "No sunrise") (if (and set (calendar-date-equal date (car adj-set))) (concat "sunset " (apply 'solar-time-string (cdr adj-set))) "no sunset") (eval calendar-location-name)))) (defun solar-date-next-longitude (d l) "First moment on or after Julian day number D when sun's longitude is a multiple of L degrees at calendar-location-name with that location's local time (including any daylight savings rules). L must be an integer divisor of 360. Result is in local time expressed astronomical (Julian) day numbers. The values of calendar-daylight-savings-starts, calendar-daylight-savings-starts-time, calendar-daylight-savings-ends, calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and calendar-time-zone are used to interpret local time." (let* ((long) (start d) (start-long (solar-longitude d)) (next (mod (* l (1+ (floor (/ start-long l)))) 360)) (end (+ d (* (/ l 360.0) 400))) (end-long (solar-longitude end))) (while ;; bisection search for nearest minute (< 0.00001 (- end start)) ;; start <= d < end ;; start-long <= next < end-long when next != 0 ;; when next = 0, we look for the discontinuity (start-long is near 360 ;; and end-long is small (less than l). (setq d (/ (+ start end) 2.0)) (setq long (solar-longitude d)) (if (or (and (/= next 0) (< long next)) (and (= next 0) (< l long))) (progn (setq start d) (setq start-long long)) (setq end d) (setq end-long long))) (/ (+ start end) 2.0))) (defun solar-longitude (d) "Longitude of sun on astronomical (Julian) day number D. Accurary is about 0.01 degree (about 365.25*24*60*0.01/360 = 15 minutes). The values of calendar-daylight-savings-starts, calendar-daylight-savings-starts-time, calendar-daylight-savings-ends, calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and calendar-time-zone are used to interpret local time." (let* ((a-d (calendar-absolute-from-astro d)) (date (calendar-gregorian-from-absolute (floor a-d))) (time (* 24 (- a-d (truncate a-d)))) (rounded-abs-date (+ (calendar-absolute-from-gregorian date) (/ (round (* 60 time)) 60.0 24.0))) ;; get local standard time (a-d (- rounded-abs-date (if (dst-in-effect rounded-abs-date) (/ calendar-daylight-time-offset 24.0 60.0) 0))) ;; get Universal Time (a-d (- a-d (/ calendar-time-zone 60.0 24.0))) (date (calendar-astro-from-absolute a-d)) ;; get Ephemeris Time (date (+ date (solar-ephemeris-correction (extract-calendar-year (calendar-gregorian-from-absolute (floor (calendar-absolute-from-astro date))))))) (T (/ (- date 2451545.0) 36525.0)) (Lo (mod (+ 280.46645 (* 36000.76983 T) (* 0.0003032 T T)) 360.0)) (M (mod (+ 357.52910 (* 35999.05030 T) (* -0.0001559 T T) (* -0.00000048 T T T)) 360.0)) (e (+ 0.016708617 (* -0.000042037 T) (* -0.0000001236 T T))) (C (+ (* (+ 1.914600 (* -0.004817 T) (* -0.000014 T T)) (solar-sin-degrees M)) (* (+ 0.019993 (* -0.000101 T)) (solar-sin-degrees (* 2 M))) (* 0.000290 (solar-sin-degrees (* 3 M))))) (true-longitude (+ Lo C)) (omega (+ 125.04 (* -1934.136 T))) (apparent-longitude (mod (+ true-longitude -0.00569 (* -0.00478 (solar-sin-degrees omega))) 360.0))) apparent-longitude)) (defun solar-ephemeris-correction (year) "Ephemeris time minus Universal Time at astronomical (Julian) day D. Result is in days For the years 1800-1987, the maximum error is 1.9 seconds. For the other years, the maximum error is about 30 seconds." (cond ((and (<= 1988 year) (< year 2020)) (/ (+ year -2000 67.0) 60.0 60.0 24.0)) ((and (<= 1900 year) (< year 1988)) (let* ((theta (/ (- (calendar-astro-from-absolute (calendar-absolute-from-gregorian (list 7 1 year))) (calendar-astro-from-absolute (calendar-absolute-from-gregorian '(1 1 1900)))) 36525.0)) (theta2 (* theta theta)) (theta3 (* theta2 theta)) (theta4 (* theta2 theta2)) (theta5 (* theta3 theta2))) (+ -0.00002 (* 0.000297 theta) (* 0.025184 theta2) (* -0.181133 theta3) (* 0.553040 theta4) (* -0.861938 theta5) (* 0.677066 theta3 theta3) (* -0.212591 theta4 theta3)))) ((and (<= 1800 year) (< year 1900)) (let* ((theta (/ (- (calendar-astro-from-absolute (calendar-absolute-from-gregorian (list 7 1 year))) (calendar-astro-from-absolute (calendar-absolute-from-gregorian '(1 1 1900)))) 36525.0)) (theta2 (* theta theta)) (theta3 (* theta2 theta)) (theta4 (* theta2 theta2)) (theta5 (* theta3 theta2))) (+ -0.000009 (* 0.003844 theta) (* 0.083563 theta2) (* 0.865736 theta3) (* 4.867575 theta4) (* 15.845535 theta5) (* 31.332267 theta3 theta3) (* 38.291999 theta4 theta3) (* 28.316289 theta4 theta4) (* 11.636204 theta4 theta5) (* 2.043794 theta5 theta5)))) ((and (<= 1620 year) (< year 1800)) (let ((x (/ (- year 1600) 10.0))) (/ (+ (* 2.19167 x x) (* -40.675 x) 196.58333) 60.0 60.0 24.0))) (t (let* ((tmp (- (calendar-astro-from-absolute (calendar-absolute-from-gregorian (list 1 1 year))) 2382148)) (second (- (/ (* tmp tmp) 41048480.0) 15))) (/ second 60.0 60.0 24.0))))) ;;;###autoload (defun sunrise-sunset (&optional arg) "Local time of sunrise and sunset for today. Accurate to +/- 2 minutes. If called with an optional prefix argument, prompt for date. If called with an optional double prefix argument, prompt for longitude, latitude, time zone, and date, and always use standard time. This function is suitable for execution in a .emacs file." (interactive "p") (or arg (setq arg 1)) (if (and (< arg 16) (not (and calendar-latitude calendar-longitude calendar-time-zone))) (solar-setup)) (let* ((calendar-longitude (if (< arg 16) calendar-longitude (solar-get-number "Enter longitude (decimal fraction; + east, - west): "))) (calendar-latitude (if (< arg 16) calendar-latitude (solar-get-number "Enter latitude (decimal fraction; + north, - south): "))) (calendar-time-zone (if (< arg 16) calendar-time-zone (solar-get-number "Enter difference from Coordinated Universal Time (in minutes): "))) (calendar-location-name (if (< arg 16) calendar-location-name (let ((float-output-format "%.1f")) (format "%s%s, %s%s" (if (numberp calendar-latitude) (abs calendar-latitude) (+ (aref calendar-latitude 0) (/ (aref calendar-latitude 1) 60.0))) (if (numberp calendar-latitude) (if (> calendar-latitude 0) "N" "S") (if (equal (aref calendar-latitude 2) 'north) "N" "S")) (if (numberp calendar-longitude) (abs calendar-longitude) (+ (aref calendar-longitude 0) (/ (aref calendar-longitude 1) 60.0))) (if (numberp calendar-longitude) (if (> calendar-longitude 0) "E" "W") (if (equal (aref calendar-longitude 2) 'east) "E" "W")))))) (calendar-standard-time-zone-name (if (< arg 16) calendar-standard-time-zone-name (cond ((= calendar-time-zone 0) "UTC") ((< calendar-time-zone 0) (format "UTC%dmin" calendar-time-zone)) (t (format "UTC+%dmin" calendar-time-zone))))) (calendar-daylight-savings-starts (if (< arg 16) calendar-daylight-savings-starts)) (calendar-daylight-savings-ends (if (< arg 16) calendar-daylight-savings-ends)) (date (if (< arg 4) (calendar-current-date) (calendar-read-date))) (date-string (calendar-date-string date t)) (time-string (solar-sunrise-sunset date)) (msg (format "%s: %s" date-string time-string)) (one-window (one-window-p t))) (if (<= (length msg) (frame-width)) (message msg) (with-output-to-temp-buffer "*temp*" (princ (concat date-string "\n" time-string))) (message (substitute-command-keys (if one-window (if pop-up-windows "Type \\[delete-other-windows] to remove temp window." "Type \\[switch-to-buffer] RET to remove temp window.") "Type \\[switch-to-buffer-other-window] RET to restore old contents of temp window.")))))) (defun calendar-sunrise-sunset () "Local time of sunrise and sunset for date under cursor. Accurate to +/- 2 minutes." (interactive) (if (not (and calendar-latitude calendar-longitude calendar-time-zone)) (solar-setup)) (let ((date (calendar-cursor-to-date t))) (message "%s: %s" (calendar-date-string date t t) (solar-sunrise-sunset date)))) (defun diary-sunrise-sunset () "Local time of sunrise and sunset as a diary entry. Accurate to +/- 2 minutes." (if (not (and calendar-latitude calendar-longitude calendar-time-zone)) (solar-setup)) (solar-sunrise-sunset date)) (defun diary-sabbath-candles () "Local time of candle lighting diary entry--applies if date is a Friday. No diary entry if there is no sunset on that date." (if (not (and calendar-latitude calendar-longitude calendar-time-zone)) (solar-setup)) (if (= (% (calendar-absolute-from-gregorian date) 7) 5);; Friday (let* ((sunset (solar-sunset date)) (light (if sunset (dst-adjust-time date (- sunset (/ 18.0 60.0)))))) (if (and light (calendar-date-equal date (car light))) (format "%s Sabbath candle lighting" (apply 'solar-time-string (cdr light))))))) ;;;###autoload (defun solar-equinoxes-solstices () "Date and time of equinoxes and solstices, if visible in the calendar window. Requires floating point." (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y (cond ((= 1 (% m 3)) -1) ((= 2 (% m 3)) 1) (t 0))) (let* ((calendar-standard-time-zone-name (if calendar-time-zone calendar-standard-time-zone-name "UTC")) (calendar-daylight-savings-starts (if calendar-time-zone calendar-daylight-savings-starts)) (calendar-daylight-savings-ends (if calendar-time-zone calendar-daylight-savings-ends)) (calendar-time-zone (if calendar-time-zone calendar-time-zone 0)) (k (1- (/ m 3))) (d (solar-date-next-longitude (calendar-astro-from-absolute (calendar-absolute-from-gregorian (list (+ 3 (* k 3)) 15 y))) 90)) (abs-day (calendar-absolute-from-astro d))) (list (list (calendar-gregorian-from-absolute (floor abs-day)) (format "%s %s" (nth k (if (and calendar-latitude (< (calendar-latitude) 0)) solar-s-hemi-seasons solar-n-hemi-seasons)) (solar-time-string (* 24 (- abs-day (floor abs-day))) (if (dst-in-effect abs-day) calendar-daylight-time-zone-name calendar-standard-time-zone-name)))))))) (provide 'solar) ;;; solar.el ends here emacs-19.30/lisp/solitaire.el100444 12120 1 34310 6045205047 14407 0ustar rmsdaemon;;; solitaire.el --- game of solitaire in Emacs Lisp ;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Author: Jan Schormann ;; Created: Fri afternoon, Jun 3, 1994 ;; Keywords: games ;; 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 this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; This mode is for playing a well-known game of solitaire ;; in which you jump pegs across other pegs. ;; The game itself is somehow self-explanatory. Read the help text to ;; solitaire, and try it. ;;; Code: (defvar solitaire-mode-map nil "Keymap for playing solitaire.") (if solitaire-mode-map () (setq solitaire-mode-map (make-sparse-keymap)) (suppress-keymap solitaire-mode-map t) (define-key solitaire-mode-map "\C-f" 'solitaire-right) (define-key solitaire-mode-map "\C-b" 'solitaire-left) (define-key solitaire-mode-map "\C-p" 'solitaire-up) (define-key solitaire-mode-map "\C-n" 'solitaire-down) (define-key solitaire-mode-map [return] 'solitaire-move) (substitute-key-definition 'undo 'solitaire-undo solitaire-mode-map global-map) (define-key solitaire-mode-map " " 'solitaire-do-check) (define-key solitaire-mode-map "q" 'solitaire-quit) (define-key solitaire-mode-map [right] 'solitaire-right) (define-key solitaire-mode-map [left] 'solitaire-left) (define-key solitaire-mode-map [up] 'solitaire-up) (define-key solitaire-mode-map [down] 'solitaire-down) (define-key solitaire-mode-map [S-right] 'solitaire-move-right) (define-key solitaire-mode-map [S-left] 'solitaire-move-left) (define-key solitaire-mode-map [S-up] 'solitaire-move-up) (define-key solitaire-mode-map [S-down] 'solitaire-move-down) (define-key solitaire-mode-map [kp-6] 'solitaire-right) (define-key solitaire-mode-map [kp-4] 'solitaire-left) (define-key solitaire-mode-map [kp-8] 'solitaire-up) (define-key solitaire-mode-map [kp-2] 'solitaire-down) (define-key solitaire-mode-map [kp-5] 'solitaire-center-point) (define-key solitaire-mode-map [S-kp-6] 'solitaire-move-right) (define-key solitaire-mode-map [S-kp-4] 'solitaire-move-left) (define-key solitaire-mode-map [S-kp-8] 'solitaire-move-up) (define-key solitaire-mode-map [S-kp-2] 'solitaire-move-down) (define-key solitaire-mode-map [kp-enter] 'solitaire-move) (define-key solitaire-mode-map [kp-0] 'solitaire-undo) ;; spoil it with s ;) (define-key solitaire-mode-map [?s] 'solitaire-solve) ;; (define-key solitaire-mode-map [kp-0] 'solitaire-hint) - Not yet provided ;) ) ;; Solitaire mode is suitable only for specially formatted data. (put 'solitaire-mode 'mode-class 'special) (defun solitaire-mode () "Major mode for playing solitaire. To learn how to play solitaire, see the documentation for function `solitaire'. \\ The usual mnemonic keys move the cursor around the board; in addition, \\[solitaire-move] is a prefix character for actually moving a stone on the board." (interactive) (kill-all-local-variables) (use-local-map solitaire-mode-map) (setq truncate-lines t) (setq major-mode 'solitaire-mode) (setq mode-name "Solitaire") (run-hooks 'solitaire-mode-hook)) (defvar solitaire-stones 0 "Counter for the stones that are still there.") (defvar solitaire-center nil "Center of the board.") (defvar solitaire-start nil "Upper left corner of the board.") (defvar solitaire-start-x nil) (defvar solitaire-start-y nil) (defvar solitaire-end nil "Lower right corner of the board.") (defvar solitaire-end-x nil) (defvar solitaire-end-y nil) (defvar solitaire-auto-eval t "*Non-nil means check for possible moves after each major change. This takes a while, so switch this on if you like to be informed when the game is over, or off, if you are working on a slow machine.") (defconst solitaire-valid-directions '(solitaire-left solitaire-right solitaire-up solitaire-down)) ;;;###autoload (defun solitaire (arg) "Play Solitaire. To play Solitaire, type \\[solitaire]. \\ Move around the board using the cursor keys. Move stones using \\[solitaire-move] followed by a direction key. Undo moves using \\[solitaire-undo]. Check for possible moves using \\[solitaire-do-check]. (The variable solitaire-auto-eval controls whether to automatically check after each move or undo) What is Solitaire? I don't know who invented this game, but it seems to be rather old and it's origin seems be northern Africa. Here's how to play: Initially, the board will look similar to this: Le Solitaire ============ o o o o o o o o o o o o o o o o . o o o o o o o o o o o o o o o o Let's call the o's stones and the .'s holes. One stone fits into one hole. As you can see, all holes but one are occupied by stones. The aim of the game is to get rid of all but one stone, leaving that last one in the middle of the board if you're cool. A stone can be moved if there is another stone next to it, and a hole after that one. Thus there must be three fields in a row, either horizontally or vertically, up, down, left or right, which look like this: o o . Then the first stone is moved to the hole, jumping over the second, which therefore is taken away. The above thus `evaluates' to: . . o That's all. Here's the board after two moves: o o o . o o o o . o o o o o . o o o o o o o o o o o o o o o o o o Pick your favourite shortcuts: \\{solitaire-mode-map}" (interactive "P") (switch-to-buffer "*Solitaire*") (solitaire-mode) (setq buffer-read-only t) (setq solitaire-stones 32) (solitaire-insert-board) (solitaire-build-modeline) (goto-char (point-max)) (setq solitaire-center (search-backward ".")) (setq buffer-undo-list (list (point))) (set-buffer-modified-p nil)) (defun solitaire-build-modeline () (setq mode-line-format (list "" "---" 'mode-line-buffer-identification (if (< 1 solitaire-stones) (format "--> There are %d stones left <--" solitaire-stones) "------") 'global-mode-string " %[(" 'mode-name 'minor-mode-alist "%n" ")%]-%-")) (force-mode-line-update)) (defun solitaire-insert-board () (let* ((buffer-read-only nil) (w (window-width)) (h (window-height)) (hsep (cond ((> w 26) " ") ((> w 20) " ") (t ""))) (vsep (cond ((> h 17) "\n\n") (t "\n"))) (indent (make-string (/ (- w 7 (* 6 (length hsep))) 2) ?\ ))) (erase-buffer) (insert (make-string (/ (- h 7 (if (> h 12) 3 0) (* 6 (1- (length vsep)))) 2) ?\n)) (if (or (string= vsep "\n\n") (> h 12)) (progn (insert (format "%sLe Solitaire\n" indent)) (insert (format "%s============\n\n" indent)))) (insert indent) (setq solitaire-start (point)) (setq solitaire-start-x (current-column)) (setq solitaire-start-y (solitaire-current-line)) (insert (format " %s %so%so%so%s" hsep hsep hsep hsep vsep)) (insert (format "%s %s %so%so%so%s" indent hsep hsep hsep hsep vsep)) (insert (format "%so%so%so%so%so%so%so%s" indent hsep hsep hsep hsep hsep hsep vsep)) (insert (format "%so%so%so%s" indent hsep hsep hsep)) (setq solitaire-center (point)) (insert (format ".%so%so%so%s" hsep hsep hsep vsep)) (insert (format "%so%so%so%so%so%so%so%s" indent hsep hsep hsep hsep hsep hsep vsep)) (insert (format "%s %s %so%so%so%s" indent hsep hsep hsep hsep vsep)) (insert (format "%s %s %so%so%so%s %s " indent hsep hsep hsep hsep hsep hsep)) (setq solitaire-end (point)) (setq solitaire-end-x (current-column)) (setq solitaire-end-y (solitaire-current-line)) )) (defun solitaire-right () (interactive) (let ((start (point))) (forward-char) (while (= ?\ (following-char)) (forward-char)) (if (or (= 0 (following-char)) (= ?\ (following-char)) (= ?\n (following-char))) (goto-char start)))) (defun solitaire-left () (interactive) (let ((start (point))) (backward-char) (while (= ?\ (following-char)) (backward-char)) (if (or (= 0 (preceding-char)) (= ?\ (following-char)) (= ?\n (following-char))) (goto-char start)))) (defun solitaire-up () (interactive) (let ((start (point)) (c (current-column))) (forward-line -1) (move-to-column c) (while (and (= ?\n (following-char)) (forward-line -1) (move-to-column c) (not (bolp)))) (if (or (= 0 (preceding-char)) (= ?\ (following-char)) (= ?\= (following-char)) (= ?\n (following-char))) (goto-char start) ))) (defun solitaire-down () (interactive) (let ((start (point)) (c (current-column))) (forward-line 1) (move-to-column c) (while (and (= ?\n (following-char)) (forward-line 1) (move-to-column c) (not (eolp)))) (if (or (= 0 (following-char)) (= ?\ (following-char)) (= ?\n (following-char))) (goto-char start)))) (defun solitaire-center-point () (interactive) (goto-char solitaire-center)) (defun solitaire-move-right () (interactive) (solitaire-move '[right])) (defun solitaire-move-left () (interactive) (solitaire-move '[left])) (defun solitaire-move-up () (interactive) (solitaire-move '[up])) (defun solitaire-move-down () (interactive) (solitaire-move '[down])) (defun solitaire-possible-move (movesymbol) "Check if a move is possible from current point in the specified direction. MOVESYMBOL specifies the direction. Returns either a string, indicating cause of contraindication, or a list containing three numbers: starting field, skipped field (from which a stone will be taken away) and target." (save-excursion (let (move) (fset 'move movesymbol) (if (memq movesymbol solitaire-valid-directions) (let ((start (point)) (skip (progn (move) (point))) (target (progn (move) (point)))) (if (= skip target) "Off Board!" (if (or (/= ?o (char-after start)) (/= ?o (char-after skip)) (/= ?. (char-after target))) "Wrong move!" (list start skip target)))) "Not a valid direction")))) (defun solitaire-move (dir) "Pseudo-prefix command to move a stone in Solitaire." (interactive "kMove where? ") (let* ((class (solitaire-possible-move (lookup-key solitaire-mode-map dir))) (buffer-read-only nil)) (if (stringp class) (error class) (let ((start (car class)) (skip (car (cdr class))) (target (car (cdr (cdr class))))) (goto-char start) (delete-char 1) (insert ?.) (goto-char skip) (delete-char 1) (insert ?.) (goto-char target) (delete-char 1) (insert ?o) (goto-char target) (setq solitaire-stones (1- solitaire-stones)) (solitaire-build-modeline) (if solitaire-auto-eval (solitaire-do-check)))))) (defun solitaire-undo (arg) "Undo a move in Solitaire." (interactive "P") (let ((buffer-read-only nil)) (undo arg)) (save-excursion (setq solitaire-stones (let ((count 0)) (goto-char solitaire-end) (while (search-backward "o" solitaire-start 'done) (and (>= (current-column) solitaire-start-x) (<= (current-column) solitaire-end-x) (>= (solitaire-current-line) solitaire-start-y) (<= (solitaire-current-line) solitaire-end-y) (setq count (1+ count)))) count))) (solitaire-build-modeline) (if solitaire-auto-eval (solitaire-do-check))) (defun solitaire-check () (save-excursion (if (= 1 solitaire-stones) 0 (goto-char solitaire-end) (let ((count 0)) (while (search-backward "o" solitaire-start 'done) (and (>= (current-column) solitaire-start-x) (<= (current-column) solitaire-end-x) (>= (solitaire-current-line) solitaire-start-y) (<= (solitaire-current-line) solitaire-end-y) (mapcar (lambda (movesymbol) (if (listp (solitaire-possible-move movesymbol)) (setq count (1+ count)))) solitaire-valid-directions))) count)))) (defun solitaire-do-check (&optional arg) "Check for any possible moves in Solitaire." (interactive "P") (let ((moves (solitaire-check))) (cond ((= 1 solitaire-stones) (message "Yeah! You made it! Only the King is left!")) ((zerop moves) (message "Sorry, no more possible moves.")) ((= 1 moves) (message "There is one possible move.")) (t (message "There are %d possible moves." moves))))) (defun solitaire-current-line () "Return the vertical position of point. Seen in info on text lines." (+ (count-lines (point-min) (point)) (if (= (current-column) 0) 1 0) -1)) (defun solitaire-quit () "Quit playing Solitaire." (interactive) (kill-buffer "*Solitaire*")) ;; And here's the spoiler:) (defun solitaire-solve () "Spoil solitaire by solving the game for you - nearly ... ... stops with five stones left ;)" (interactive) (let ((allmoves [up up S-down up left left S-right up up left S-down up up right right S-left down down down S-up up S-down down down down S-up left left down S-right left left up up S-down right right right S-left left S-right right right right S-left right down down S-up down down left left S-right up up up S-down down S-up up up up S-down up right right S-left down right right down S-up left left left S-right right S-left down down left S-right S-up S-left S-left S-down S-right up S-right left left]) ;; down down S-up left S-right ;; right S-left (solitaire-auto-eval nil)) (solitaire-center-point) (mapcar (lambda (op) (if (memq op '(S-left S-right S-up S-down)) (sit-for 0.2)) (execute-kbd-macro (vector op)) (if (memq op '(S-left S-right S-up S-down)) (sit-for 0.4))) allmoves)) (solitaire-do-check)) (provide 'solitaire) ;;; solitaire.el ends here emacs-19.30/lisp/sort.el100444 12120 1 44270 6055461240 13411 0ustar rmsdaemon;;; sort.el --- commands to sort text in an Emacs buffer. ;; Copyright (C) 1986, 1987, 1994, 1995 Free Software Foundation, Inc. ;; Author: Howie Kaye ;; Maintainer: FSF ;; Keywords: unix ;; 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 package provides the sorting facilities documented in the Emacs ;;; user's manual. ;;; Code: (defvar sort-fold-case nil "*Non-nil if the buffer sort functions should ignore case.") ;;;###autoload (defun sort-subr (reverse nextrecfun endrecfun &optional startkeyfun endkeyfun) "General text sorting routine to divide buffer into records and sort them. Arguments are REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN. We divide the accessible portion of the buffer into disjoint pieces called sort records. A portion of each sort record (perhaps all of it) is designated as the sort key. The records are rearranged in the buffer in order by their sort keys. The records may or may not be contiguous. Usually the records are rearranged in order of ascending sort key. If REVERSE is non-nil, they are rearranged in order of descending sort key. The next four arguments are functions to be called to move point across a sort record. They will be called many times from within sort-subr. NEXTRECFUN is called with point at the end of the previous record. It moves point to the start of the next record. It should move point to the end of the buffer if there are no more records. The first record is assumed to start at the position of point when sort-subr is called. ENDRECFUN is called with point within the record. It should move point to the end of the record. STARTKEYFUN moves from the start of the record to the start of the key. It may return either a non-nil value to be used as the key, or else the key is the substring between the values of point after STARTKEYFUN and ENDKEYFUN are called. If STARTKEYFUN is nil, the key starts at the beginning of the record. ENDKEYFUN moves from the start of the sort key to the end of the sort key. ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the same as ENDRECFUN." ;; Heuristically try to avoid messages if sorting a small amt of text. (let ((messages (> (- (point-max) (point-min)) 50000))) (save-excursion (if messages (message "Finding sort keys...")) (let* ((sort-lists (sort-build-lists nextrecfun endrecfun startkeyfun endkeyfun)) (old (reverse sort-lists)) (case-fold-search sort-fold-case)) (if (null sort-lists) () (or reverse (setq sort-lists (nreverse sort-lists))) (if messages (message "Sorting records...")) (setq sort-lists (if (fboundp 'sortcar) (sortcar sort-lists (cond ((numberp (car (car sort-lists))) ;; This handles both ints and floats. '<) ((consp (car (car sort-lists))) (function (lambda (a b) (> 0 (compare-buffer-substrings nil (car a) (cdr a) nil (car b) (cdr b)))))) (t 'string<))) (sort sort-lists (cond ((numberp (car (car sort-lists))) 'car-less-than-car) ((consp (car (car sort-lists))) (function (lambda (a b) (> 0 (compare-buffer-substrings nil (car (car a)) (cdr (car a)) nil (car (car b)) (cdr (car b))))))) (t (function (lambda (a b) (string< (car a) (car b))))))))) (if reverse (setq sort-lists (nreverse sort-lists))) (if messages (message "Reordering buffer...")) (sort-reorder-buffer sort-lists old))) (if messages (message "Reordering buffer... Done")))) nil) ;; Parse buffer into records using the arguments as Lisp expressions; ;; return a list of records. Each record looks like (KEY STARTPOS . ENDPOS) ;; where KEY is the sort key (a number or string), ;; and STARTPOS and ENDPOS are the bounds of this record in the buffer. ;; The records appear in the list lastmost first! (defun sort-build-lists (nextrecfun endrecfun startkeyfun endkeyfun) (let ((sort-lists ()) (start-rec nil) done key) ;; Loop over sort records. ;(goto-char (point-min)) -- it is the caller's responsibility to ;arrange this if necessary (while (not (eobp)) (setq start-rec (point)) ;save record start (setq done nil) ;; Get key value, or move to start of key. (setq key (catch 'key (or (and startkeyfun (funcall startkeyfun)) ;; If key was not returned as value, ;; move to end of key and get key from the buffer. (let ((start (point))) (funcall (or endkeyfun (prog1 endrecfun (setq done t)))) (cons start (point)))))) ;; Move to end of this record (start of next one, or end of buffer). (cond ((prog1 done (setq done nil))) (endrecfun (funcall endrecfun)) (nextrecfun (funcall nextrecfun) (setq done t))) (if key (setq sort-lists (cons ;; consing optimization in case in which key ;; is same as record. (if (and (consp key) (equal (car key) start-rec) (equal (cdr key) (point))) (cons key key) (cons key (cons start-rec (point)))) sort-lists))) (and (not done) nextrecfun (funcall nextrecfun))) sort-lists)) (defun sort-reorder-buffer (sort-lists old) (let ((inhibit-quit t) (last (point-min)) (min (point-min)) (max (point-max))) ;; Make sure insertions done for reordering ;; do not go after any markers at the end of the sorted region, ;; by inserting a space to separate them. (goto-char (point-max)) (insert-before-markers " ") (narrow-to-region min (1- (point-max))) (while sort-lists (goto-char (point-max)) (insert-buffer-substring (current-buffer) last (nth 1 (car old))) (goto-char (point-max)) (insert-buffer-substring (current-buffer) (nth 1 (car sort-lists)) (cdr (cdr (car sort-lists)))) (setq last (cdr (cdr (car old))) sort-lists (cdr sort-lists) old (cdr old))) (goto-char (point-max)) (insert-buffer-substring (current-buffer) last max) ;; Delete the original copy of the text. (delete-region min max) ;; Get rid of the separator " ". (goto-char (point-max)) (narrow-to-region min (1+ (point))) (delete-region (point) (1+ (point))))) ;;;###autoload (defun sort-lines (reverse beg end) "Sort lines in region alphabetically; argument means descending order. Called from a program, there are three arguments: REVERSE (non-nil means reverse order), BEG and END (region to sort)." (interactive "P\nr") (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (sort-subr reverse 'forward-line 'end-of-line)))) ;;;###autoload (defun sort-paragraphs (reverse beg end) "Sort paragraphs in region alphabetically; argument means descending order. Called from a program, there are three arguments: REVERSE (non-nil means reverse order), BEG and END (region to sort)." (interactive "P\nr") (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (sort-subr reverse (function (lambda () (while (and (not (eobp)) (looking-at paragraph-separate)) (forward-line 1)))) 'forward-paragraph)))) ;;;###autoload (defun sort-pages (reverse beg end) "Sort pages in region alphabetically; argument means descending order. Called from a program, there are three arguments: REVERSE (non-nil means reverse order), BEG and END (region to sort)." (interactive "P\nr") (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (sort-subr reverse (function (lambda () (skip-chars-forward "\n"))) 'forward-page)))) (defvar sort-fields-syntax-table nil) (if sort-fields-syntax-table nil (let ((table (make-syntax-table)) (i 0)) (while (< i 256) (modify-syntax-entry i "w" table) (setq i (1+ i))) (modify-syntax-entry ?\ " " table) (modify-syntax-entry ?\t " " table) (modify-syntax-entry ?\n " " table) (modify-syntax-entry ?\. "_" table) ; for floating pt. numbers. -wsr (setq sort-fields-syntax-table table))) ;;;###autoload (defun sort-numeric-fields (field beg end) "Sort lines in region numerically by the ARGth field of each line. Fields are separated by whitespace and numbered from 1 up. Specified field must contain a number in each line of the region. With a negative arg, sorts by the ARGth field counted from the right. Called from a program, there are three arguments: FIELD, BEG and END. BEG and END specify region to sort." (interactive "p\nr") (sort-fields-1 field beg end (function (lambda () (sort-skip-fields field) (string-to-number (buffer-substring (point) (save-excursion ;; This is just wrong! Even without floats... ;; (skip-chars-forward "[0-9]") (forward-sexp 1) (point)))))) nil)) ;;;;;###autoload ;;(defun sort-float-fields (field beg end) ;; "Sort lines in region numerically by the ARGth field of each line. ;;Fields are separated by whitespace and numbered from 1 up. Specified field ;;must contain a floating point number in each line of the region. With a ;;negative arg, sorts by the ARGth field counted from the right. Called from a ;;program, there are three arguments: FIELD, BEG and END. BEG and END specify ;;region to sort." ;; (interactive "p\nr") ;; (sort-fields-1 field beg end ;; (function (lambda () ;; (sort-skip-fields field) ;; (string-to-number ;; (buffer-substring ;; (point) ;; (save-excursion ;; (re-search-forward ;; "[+-]?[0-9]*\.?[0-9]*\\([eE][+-]?[0-9]+\\)?") ;; (point)))))) ;; nil)) ;;;###autoload (defun sort-fields (field beg end) "Sort lines in region lexicographically by the ARGth field of each line. Fields are separated by whitespace and numbered from 1 up. With a negative arg, sorts by the ARGth field counted from the right. Called from a program, there are three arguments: FIELD, BEG and END. BEG and END specify region to sort." (interactive "p\nr") (sort-fields-1 field beg end (function (lambda () (sort-skip-fields field) nil)) (function (lambda () (skip-chars-forward "^ \t\n"))))) (defun sort-fields-1 (field beg end startkeyfun endkeyfun) (let ((tbl (syntax-table))) (if (zerop field) (setq field 1)) (unwind-protect (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (set-syntax-table sort-fields-syntax-table) (sort-subr nil 'forward-line 'end-of-line startkeyfun endkeyfun))) (set-syntax-table tbl)))) ;; Position at the beginning of field N on the current line, ;; assuming point is initially at the beginning of the line. (defun sort-skip-fields (n) (if (> n 0) ;; Skip across N - 1 fields. (let ((i (1- n))) (while (> i 0) (skip-chars-forward " \t") (skip-chars-forward "^ \t\n") (setq i (1- i))) (skip-chars-forward " \t") (if (eolp) (error "Line has too few fields: %s" (buffer-substring (save-excursion (beginning-of-line) (point)) (save-excursion (end-of-line) (point)))))) (end-of-line) ;; Skip back across - N - 1 fields. (let ((i (1- (- n)))) (while (> i 0) (skip-chars-backward " \t") (skip-chars-backward "^ \t\n") (setq i (1- i))) (skip-chars-backward " \t")) (if (bolp) (error "Line has too few fields: %s" (buffer-substring (save-excursion (beginning-of-line) (point)) (save-excursion (end-of-line) (point))))) ;; Position at the front of the field ;; even if moving backwards. (skip-chars-backward "^ \t\n"))) (defvar sort-regexp-fields-regexp) (defvar sort-regexp-record-end) ;; Move to the beginning of the next match for record-regexp, ;; and set sort-regexp-record-end to the end of that match. ;; If the next match is empty and does not advance point, ;; skip one character and try again. (defun sort-regexp-fields-next-record () (let ((oldpos (point))) (and (re-search-forward sort-regexp-fields-regexp nil 'move) (setq sort-regexp-record-end (match-end 0)) (if (= sort-regexp-record-end oldpos) (progn (forward-char 1) (re-search-forward sort-regexp-fields-regexp nil 'move) (setq sort-regexp-record-end (match-end 0))) t) (goto-char (match-beginning 0))))) ;;;###autoload (defun sort-regexp-fields (reverse record-regexp key-regexp beg end) "Sort the region lexicographically as specified by RECORD-REGEXP and KEY. RECORD-REGEXP specifies the textual units which should be sorted. For example, to sort lines RECORD-REGEXP would be \"^.*$\" KEY specifies the part of each record (ie each match for RECORD-REGEXP) is to be used for sorting. If it is \"\\\\digit\" then the digit'th \"\\\\(...\\\\)\" match field from RECORD-REGEXP is used. If it is \"\\\\&\" then the whole record is used. Otherwise, it is a regular-expression for which to search within the record. If a match for KEY is not found within a record then that record is ignored. With a negative prefix arg sorts in reverse order. For example: to sort lines in the region by the first word on each line starting with the letter \"f\", RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\\"" ;; using negative prefix arg to mean "reverse" is now inconsistent with ;; other sort-.*fields functions but then again this was before, since it ;; didn't use the magnitude of the arg to specify anything. (interactive "P\nsRegexp specifying records to sort: sRegexp specifying key within record: \nr") (cond ((or (equal key-regexp "") (equal key-regexp "\\&")) (setq key-regexp 0)) ((string-match "\\`\\\\[1-9]\\'" key-regexp) (setq key-regexp (- (aref key-regexp 1) ?0)))) (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (let (sort-regexp-record-end (sort-regexp-fields-regexp record-regexp)) (re-search-forward sort-regexp-fields-regexp) (setq sort-regexp-record-end (point)) (goto-char (match-beginning 0)) (sort-subr reverse 'sort-regexp-fields-next-record (function (lambda () (goto-char sort-regexp-record-end))) (function (lambda () (let ((n 0)) (cond ((numberp key-regexp) (setq n key-regexp)) ((re-search-forward key-regexp sort-regexp-record-end t) (setq n 0)) (t (throw 'key nil))) (condition-case () (if (fboundp 'buffer-substring-lessp) (cons (match-beginning n) (match-end n)) (buffer-substring (match-beginning n) (match-end n))) ;; if there was no such register (error (throw 'key nil))))))))))) (defvar sort-columns-subprocess t) ;;;###autoload (defun sort-columns (reverse &optional beg end) "Sort lines in region alphabetically by a certain range of columns. For the purpose of this command, the region includes the entire line that point is in and the entire line the mark is in. The column positions of point and mark bound the range of columns to sort on. A prefix argument means sort into reverse order. Note that `sort-columns' rejects text that contains tabs, because tabs could be split across the specified columns and it doesn't know how to handle that. Also, when possible, it uses the `sort' utility program, which doesn't understand tabs. Use \\[untabify] to convert tabs to spaces before sorting." (interactive "P\nr") (save-excursion (let (beg1 end1 col-beg1 col-end1 col-start col-end) (goto-char (min beg end)) (setq col-beg1 (current-column)) (beginning-of-line) (setq beg1 (point)) (goto-char (max beg end)) (setq col-end1 (current-column)) (forward-line) (setq end1 (point)) (setq col-start (min col-beg1 col-end1)) (setq col-end (max col-beg1 col-end1)) (if (search-backward "\t" beg1 t) (error "sort-columns does not work with tabs. Use M-x untabify.")) (if (not (eq system-type 'vax-vms)) ;; Use the sort utility if we can; it is 4 times as fast. (call-process-region beg1 end1 "sort" t t nil (if reverse "-rt\n" "-t\n") (concat "+0." col-start) (concat "-0." col-end)) ;; On VMS, use Emacs's own facilities. (save-excursion (save-restriction (narrow-to-region beg1 end1) (goto-char beg1) (sort-subr reverse 'forward-line 'end-of-line (function (lambda () (move-to-column col-start) nil)) (function (lambda () (move-to-column col-end) nil))))))))) ;;;###autoload (defun reverse-region (beg end) "Reverse the order of lines in a region. From a program takes two point or marker arguments, BEG and END." (interactive "r") (if (> beg end) (let (mid) (setq mid end end beg beg mid))) (save-excursion ;; put beg at the start of a line and end and the end of one -- ;; the largest possible region which fits this criteria (goto-char beg) (or (bolp) (forward-line 1)) (setq beg (point)) (goto-char end) ;; the test for bolp is for those times when end is on an empty line; ;; it is probably not the case that the line should be included in the ;; reversal; it isn't difficult to add it afterward. (or (and (eolp) (not (bolp))) (progn (forward-line -1) (end-of-line))) (setq end (point-marker)) ;; the real work. this thing cranks through memory on large regions. (let (ll (do t)) (while do (goto-char beg) (setq ll (cons (buffer-substring (point) (progn (end-of-line) (point))) ll)) (setq do (/= (point) end)) (delete-region beg (if do (1+ (point)) (point)))) (while (cdr ll) (insert (car ll) "\n") (setq ll (cdr ll))) (insert (car ll))))) (provide 'sort) ;;; sort.el ends here emacs-19.30/lisp/soundex.el100444 12120 1 5312 5602362307 14062 0ustar rmsdaemon;;; soundex.el -- implement Soundex algorithm ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Christian Plaunt ;; Maintainer: FSF ;; Keywords: matching ;; Created: Sat May 15 14:48:18 1993 ;; 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: ;; The Soundex algorithm maps English words into representations of ;; how they sound. Words with vaguely similar sound map to the same string. ;;; Code: (defvar soundex-alist '((?B . "1") (?F . "1") (?P . "1") (?V . "1") (?C . "2") (?G . "2") (?J . "2") (?K . "2") (?Q . "2") (?S . "2") (?X . "2") (?Z . "2") (?D . "3") (?T . "3") (?L . "4") (?M . "5") (?N . "5") (?R . "6")) "Alist of chars-to-key-code for building Soundex keys.") (defun soundex (word) "Return a Soundex key for WORD. Implemented as described in: Knuth, Donald E. \"The Art of Computer Programming, Vol. 3: Sorting and Searching\", Addison-Wesley (1973), pp. 391-392." (let* ((word (upcase word)) (length (length word)) (code (cdr (assq (aref word 0) soundex-alist))) (key (substring word 0 1)) (index 1) (prev-code code)) ;; once we have a four char key, we're done (while (and (> 4 (length key)) (< index length)) ;; look up the code for each letter in word at index (setq code (cdr (assq (aref word index) soundex-alist)) index (1+ index) ;; append code to key unless the same codes belong to ;; adjacent letters in the original string key (concat key (if (or (null code) (string= code prev-code)) () code)) prev-code code)) ;; return a key that is 4 chars long and padded by "0"s if needed (if (> 4 (length key)) (substring (concat key "000") 0 4) key))) ;(defvar soundex-test ; '("Euler" "Gauss" "Hilbert" "Knuth" "Lloyd" "Lukasiewicz" ; "Ellery" "Ghosh" "Heilbronn" "Kant" "Ladd" "Lissajous") ; "\n Knuth's names to demonstrate the Soundex algorithm.") ; ;(mapcar 'soundex soundex-test) ;("E460" "G200" "H416" "K530" "L300" "L222" ; "E460" "G200" "H416" "K530" "L300" "L222") ;; soundex.el ends here emacs-19.30/lisp/spell.el100444 12120 1 11705 5702170337 13540 0ustar rmsdaemon;;; spell.el --- spelling correction interface for Emacs. ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: wp, unix ;; 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 mode provides an Emacs interface to the UNIX spell(1) program. ;; Entry points are `spell-buffer', `spell-word', `spell-region' and ;; `spell-string'. These facilities are documented in the Emacs user's ;; manual. ;;; Code: (defvar spell-command "spell" "*Command to run the spell program.") (defvar spell-filter nil "*Filter function to process text before passing it to spell program. This function might remove text-processor commands. nil means don't alter the text before checking it.") ;;;###autoload (put 'spell-filter 'risky-local-variable t) ;;;###autoload (defun spell-buffer () "Check spelling of every word in the buffer. For each incorrect word, you are asked for the correct spelling and then put into a query-replace to fix some or all occurrences. If you do not want to change a word, just give the same word as its \"correct\" spelling; then the query replace is skipped." (interactive) (spell-region (point-min) (point-max) "buffer")) ;;;###autoload (defun spell-word () "Check spelling of word at or before point. If it is not correct, ask user for the correct spelling and `query-replace' the entire buffer to substitute it." (interactive) (let (beg end spell-filter) (save-excursion (if (not (looking-at "\\<")) (forward-word -1)) (setq beg (point)) (forward-word 1) (setq end (point))) (spell-region beg end (buffer-substring beg end)))) ;;;###autoload (defun spell-region (start end &optional description) "Like `spell-buffer' but applies only to region. Used in a program, applies from START to END. DESCRIPTION is an optional string naming the unit being checked: for example, \"word\"." (interactive "r") (let ((filter spell-filter) (buf (get-buffer-create " *temp*"))) (save-excursion (set-buffer buf) (widen) (erase-buffer)) (message "Checking spelling of %s..." (or description "region")) (if (and (null filter) (= ?\n (char-after (1- end)))) (if (string= "spell" spell-command) (call-process-region start end "spell" nil buf) (call-process-region start end shell-file-name nil buf nil "-c" spell-command)) (let ((oldbuf (current-buffer))) (save-excursion (set-buffer buf) (insert-buffer-substring oldbuf start end) (or (bolp) (insert ?\n)) (if filter (funcall filter)) (if (string= "spell" spell-command) (call-process-region (point-min) (point-max) "spell" t buf) (call-process-region (point-min) (point-max) shell-file-name t buf nil "-c" spell-command))))) (message "Checking spelling of %s...%s" (or description "region") (if (save-excursion (set-buffer buf) (> (buffer-size) 0)) "not correct" "correct")) (let (word newword (case-fold-search t) (case-replace t)) (while (save-excursion (set-buffer buf) (> (buffer-size) 0)) (save-excursion (set-buffer buf) (goto-char (point-min)) (setq word (downcase (buffer-substring (point) (progn (end-of-line) (point))))) (forward-char 1) (delete-region (point-min) (point)) (setq newword (read-input (concat "`" word "' not recognized; edit a replacement: ") word)) (flush-lines (concat "^" (regexp-quote word) "$"))) (if (not (equal word newword)) (progn (goto-char (point-min)) (query-replace-regexp (concat "\\b" (regexp-quote word) "\\b") newword))))))) ;;;###autoload (defun spell-string (string) "Check spelling of string supplied as argument." (interactive "sSpell string: ") (let ((buf (get-buffer-create " *temp*"))) (save-excursion (set-buffer buf) (widen) (erase-buffer) (insert string "\n") (if (string= "spell" spell-command) (call-process-region (point-min) (point-max) "spell" t t) (call-process-region (point-min) (point-max) shell-file-name t t nil "-c" spell-command)) (if (= 0 (buffer-size)) (message "%s is correct" string) (goto-char (point-min)) (while (search-forward "\n" nil t) (replace-match " ")) (message "%sincorrect" (buffer-substring 1 (point-max))))))) ;;; spell.el ends here emacs-19.30/lisp/spook.el100444 12241 1 4254 5421114245 14211 0ustar rolanddaemon;;; spook.el --- spook phrase utility for overloading the NSA line eater ;; Copyright (C) 1988, 1993 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: games ;; Created: May 1987 ;; 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: ; Steve Strassmann didn't write ; this, and even if he did, he really didn't mean for you to use it ; in an anarchistic way. ; ; To use this: ; Just before sending mail, do M-x spook. ; A number of phrases will be inserted into your buffer, to help ; give your message that extra bit of attractiveness for automated ; keyword scanners. Help defeat the NSA trunk trawler! ;;; Code: (require 'cookie1) ; Variables (defvar spook-phrases-file (concat data-directory "spook.lines") "Keep your favorite phrases here.") (defvar spook-phrase-default-count 15 "Default number of phrases to insert") ;;;###autoload (defun spook () "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 emacs-19.30/lisp/startup.el100444 12120 1 76160 6052421051 14120 0ustar rmsdaemon;;; startup.el --- process Emacs shell arguments ;; Copyright (C) 1985, 1986, 1992, 1994, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal ;; 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 file parses the command line and gets Emacs running. Options on ;; the command line are handled in precedence order. The order is the ;; one in the list below; first described means first handled. Options ;; within each category (delimited by a bar) are handled in the order ;; encountered on the command line. ;; ------------------------- ;; -version Print Emacs version to stderr, then exit ;; --version successfully right away. ;; This option is handled by emacs.c ;; ------------------------- ;; -help Print a short usage description and exit ;; --help successfully right away. ;; This option is handled by emacs.c ;; ------------------------- ;; -nl Do not use shared memory (for systems that ;; -no-shared-memory support this) for the dumped Emacs data. ;; This option is handled by emacs.c ;; ;; -map For VMS. ;; --map-data This option is handled by emacs.c ;; ------------------------- ;; -t FILE Use FILE as the name of the terminal. ;; --terminal FILE Using this implies "-nw" also. ;; This option is handled by emacs.c ;; ------------------------- ;; -d DISPNAME Use DISPNAME as the name of the X-windows ;; -display DISPNAME display for the initial frame. ;; --display DISPNAME This option is handled by emacs.c ;; ------------------------- ;; -nw Do not use a windows system (but use the ;; --no-windows terminal instead.) ;; This option is handled by emacs.c ;; ------------------------- ;; -batch Execute noninteractively (messages go to stdout, ;; --batch variable noninteractive set to t) ;; This option is handled by emacs.c ;; ------------------------- ;; -q Do not load user's init file and do not load ;; -no-init-file "default.el". Regardless of this switch, ;; --no-init-file "site-start" is still loaded. ;; ------------------------- ;; -no-site-file Do not load "site-start.el". (This is the ONLY ;; --no-site-file way to prevent loading that file.) ;; ------------------------- ;; -u USER Load USER's init file instead of the init ;; -user USER file belonging to the user starting Emacs. ;; --user USER ;; ------------------------- ;; -debug-init Don't catch errors in init files; let the ;; --debug-init debugger run. ;; ------------------------- ;; -i ICONTYPE Set type of icon using when Emacs is ;; -itype ICONTYPE iconified under X-windows. ;; --icon-type ICONTYPE This option is passed on to term/x-win.el ;; ;; -iconic Start Emacs iconified under X-windows. ;; --iconic This option is passed on to term/x-win.el ;; ------------------------- ;; Various X-windows options for colors/fonts/geometry/title etc. ;; These options are passed on to term/x-win.el which see. Certain ;; of these are also found in term/pc-win.el ;; ------------------------- ;; FILE Visit FILE. ;; ;; -L DIRNAME Add DIRNAME to load-path ;; -directory DIRNAME ;; --directory DIRNAME ;; ;; -l FILE Load and execute the Emacs lisp code ;; -load FILE in FILE. ;; --load FILE ;; ;; -f FUNC Execute Emacs lisp function FUNC with ;; -funcall FUNC no arguments. The "-e" form is outdated ;; --funcall FUNC and should not be used. (It's a typo ;; -e FUNC promoted to a feature.) ;; ;; -eval FORM Execute Emacs lisp form FORM. ;; --eval FORM ;; ;; -insert FILE Insert the contents of FILE into buffer. ;; --insert FILE ;; ------------------------- ;; -kill Kill (exit) Emacs right away. ;; --kill ;; ------------------------- ;;; Code: (setq top-level '(normal-top-level)) (defvar command-line-processed nil "t once command line has been processed") (defconst inhibit-startup-message nil "*Non-nil inhibits the initial startup message. This is for use in your personal init file, once you are familiar with the contents of the startup message.") (defconst inhibit-startup-echo-area-message nil "*Non-nil inhibits the initial startup echo area message. Inhibition takes effect only if your `.emacs' file contains a line of this form: (setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\") If your `.emacs' file is byte-compiled, use the following form instead: (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")) Thus, someone else using a copy of your `.emacs' file will see the startup message unless he personally acts to inhibit it.") (defconst inhibit-default-init nil "*Non-nil inhibits loading the `default' library.") (defconst command-switch-alist nil "Alist of command-line switches. Elements look like (SWITCH-STRING . HANDLER-FUNCTION). HANDLER-FUNCTION receives switch name as sole arg; remaining command-line args are in the variable `command-line-args-left'.") (defvar command-line-args-left nil "List of command-line args not yet processed.") (defvar command-line-functions nil ;; lrs 7/31/89 "List of functions to process unrecognized command-line arguments. Each function should access the dynamically bound variables `argi' (the current argument) and `command-line-args-left' (the remaining arguments). The function should return non-nil only if it recognizes and processes `argi'. If it does so, it may consume successive arguments by altering `command-line-args-left' to remove them.") (defvar command-line-default-directory nil "Default directory to use for command line arguments. This is normally copied from `default-directory' when Emacs starts.") (defvar before-init-hook nil "Functions to call after handling urgent options but before init files. The frame system uses this to open frames to display messages while Emacs loads the user's initialization file.") (defvar after-init-hook nil "Functions to call after loading the init file (`~/.emacs'). The call is not protected by a condition-case, so you can set `debug-on-error' in `.emacs', and put all the actual code on `after-init-hook'.") (defvar term-setup-hook nil "Functions to be called after loading terminal-specific Lisp code. See `run-hooks'. This variable exists for users to set, so as to override the definitions made by the terminal-specific file. Emacs never sets this variable itself.") (defvar keyboard-type nil "The brand of keyboard you are using. This variable is used to define the proper function and keypad keys for use under X. It is used in a fashion analogous to the environment value TERM.") (defvar window-setup-hook nil "Normal hook run to initialize window system display. Emacs runs this hook after processing the command line arguments and loading the user's init file.") (defconst initial-major-mode 'lisp-interaction-mode "Major mode command symbol to use for the initial *scratch* buffer.") (defvar init-file-user nil "Identity of user whose `.emacs' file is or was read. The value is nil if no init file is being used; otherwise, it may be either the null string, meaning that the init file was taken from the user that originally logged in, or it may be a string containing a user's name. In either of the latter cases, `(concat \"~\" init-file-user \"/\")' evaluates to the name of the directory where the `.emacs' file was looked for. Setting `init-file-user' does not prevent Emacs from loading `site-start.el'. The only way to do that is to use `--no-site-file'.") (defvar site-run-file "site-start" "File containing site-wide run-time initializations. This file is loaded at run-time before `~/.emacs'. It contains inits that need to be in place for the entire site, but which, due to their higher incidence of change, don't make sense to load into emacs' dumped image. Thus, the run-time load order is: 1. file described in this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'. Don't use the `site-start.el' file for things some users may not like. Put them in `default.el' instead, so that users can more easily override them. Users can prevent loading `default.el' with the `-q' option or by setting `inhibit-default-init' in their own init files, but inhibiting `site-start.el' requires `--no-site-file', which is less convenient.") (defconst iso-8859-1-locale-regexp "8859[-_]?1" "Regexp that specifies when to enable the ISO 8859-1 character set. We do that if this regexp matches the locale name specified by the LC_ALL, LC_CTYPE and LANG environment variables.") (defvar mail-host-address nil "*Name of this machine, for purposes of naming users.") (defvar user-mail-address nil "*Full mailing address of this user. This is initialized based on `mail-host-address', after your init file is read, in case it sets `mail-host-address'.") (defvar auto-save-list-file-prefix "~/.saves-" "Prefix for generating auto-save-list-file-name. Emacs's pid and the system name will be appended to this prefix to create a unique file name.") (defvar init-file-debug nil) (defvar init-file-had-error nil) ;; This function is called from the subdirs.el file. (defun normal-top-level-add-to-load-path (dirs) (let ((tail (member default-directory load-path))) (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))) (defun normal-top-level () (if command-line-processed (message "Back to top level.") (setq command-line-processed t) ;; Give *Messages* the same default-directory as *scratch*, ;; just to keep things predictable. (let ((dir default-directory)) (save-excursion (set-buffer (get-buffer "*Messages*")) (setq default-directory dir))) ;; Look in each dir in load-path for a subdirs.el file. ;; If we find one, load it, which will add the appropriate subdirs ;; of that dir into load-path, (let ((tail load-path) new) (while tail (setq new (cons (car tail) new)) (let ((default-directory (car tail))) (load (expand-file-name "subdirs.el" (car tail)) t t t)) (setq tail (cdr tail)))) (if (not (eq system-type 'vax-vms)) (progn ;; If the PWD environment variable isn't accurate, delete it. (let ((pwd (getenv "PWD"))) (and (stringp pwd) ;; Use FOO/., so that if FOO is a symlink, file-attributes ;; describes the directory linked to, not FOO itself. (or (equal (file-attributes (concat (file-name-as-directory pwd) ".")) (file-attributes (concat (file-name-as-directory default-directory) "."))) (setq process-environment (delete (concat "PWD=" pwd) process-environment))))))) (setq default-directory (abbreviate-file-name default-directory)) (let ((menubar-bindings-done nil)) (unwind-protect (command-line) ;; Do this again, in case .emacs defined more abbreviations. (setq default-directory (abbreviate-file-name default-directory)) ;; Specify the file for recording all the auto save files of this session. ;; This is used by recover-session. (setq auto-save-list-file-name (expand-file-name (format "%s%d-%s" auto-save-list-file-prefix (emacs-pid) (system-name)))) (run-hooks 'emacs-startup-hook) (and term-setup-hook (run-hooks 'term-setup-hook)) ;; Modify the initial frame based on what .emacs puts into ;; ...-frame-alist. (if (fboundp 'frame-notice-user-settings) (frame-notice-user-settings)) ;; Now we know the user's default font, so add it to the menu. (if (fboundp 'font-menu-add-default) (font-menu-add-default)) (and window-setup-hook (run-hooks 'window-setup-hook)) (or menubar-bindings-done (if (or (eq window-system 'x) (eq window-system 'win32)) (precompute-menubar-bindings))))))) ;; Precompute the keyboard equivalents in the menu bar items. (defun precompute-menubar-bindings () (let ((submap (lookup-key global-map [menu-bar]))) (while submap (and (consp (car submap)) (symbolp (car (car submap))) (stringp (car-safe (cdr (car submap)))) (keymapp (cdr (cdr (car submap)))) (progn (x-popup-menu nil (cdr (cdr (car submap)))) (if purify-flag (garbage-collect)))) (setq submap (cdr submap)))) (setq define-key-rebound-commands t)) (defun command-line () (setq command-line-default-directory default-directory) ;; See if we should import version-control from the environment variable. (let ((vc (getenv "VERSION_CONTROL"))) (cond ((eq vc nil)) ;don't do anything if not set ((or (string= vc "t") (string= vc "numbered")) (setq version-control t)) ((or (string= vc "nil") (string= vc "existing")) (setq version-control nil)) ((or (string= vc "never") (string= vc "simple")) (setq version-control 'never)))) (if (let ((ctype ;; Use the first of these three envvars that has a nonempty value. (or (let ((string (getenv "LC_ALL"))) (and (not (equal string "")) string)) (let ((string (getenv "LC_CTYPE"))) (and (not (equal string "")) string)) (let ((string (getenv "LANG"))) (and (not (equal string "")) string))))) (and ctype (string-match iso-8859-1-locale-regexp ctype))) (progn (require 'disp-table) (standard-display-european t) (require 'iso-syntax))) ;;! This has been commented out; I currently find the behavior when ;;! split-window-keep-point is nil disturbing, but if I can get used ;;! to it, then it would be better to eliminate the option. ;;! ;; Choose a good default value for split-window-keep-point. ;;! (setq split-window-keep-point (> baud-rate 2400)) ;; Read window system's init file if using a window system. (condition-case error (if (and window-system (not noninteractive)) (load (concat term-file-prefix (symbol-name window-system) "-win") ;; Every window system should have a startup file; ;; barf if we can't find it. nil t)) ;; If we can't read it, print the error message and exit. (error (princ (if (eq (car error) 'error) (apply 'concat (cdr error)) (if (memq 'file-error (get (car error) 'error-conditions)) (format "%s: %s" (nth 1 error) (mapconcat '(lambda (obj) (prin1-to-string obj t)) (cdr (cdr error)) ", ")) (format "%s: %s" (get (car error) 'error-message) (mapconcat '(lambda (obj) (prin1-to-string obj t)) (cdr error) ", ")))) 'external-debugging-output) (setq window-system nil) (kill-emacs))) (let ((done nil) (args (cdr command-line-args))) ;; Figure out which user's init file to load, ;; either from the environment or from the options. (setq init-file-user (if noninteractive nil (user-login-name))) ;; If user has not done su, use current $HOME to find .emacs. (and init-file-user (string= init-file-user (user-real-login-name)) (setq init-file-user "")) ;; Process the command-line args, and delete the arguments ;; processed. This is consistent with the way main in emacs.c ;; does things. (while (and (not done) args) (let ((longopts '(("--no-init-file") ("--no-site-file") ("--user") ("--debug-init") ("--iconic") ("--icon-type"))) (argi (car args)) (argval nil)) ;; Handle --OPTION=VALUE format. (if (and (string-match "\\`--" argi) (string-match "=" argi)) (setq argval (substring argi (match-end 0)) argi (substring argi 0 (match-beginning 0)))) (let ((completion (try-completion argi longopts))) (if (eq completion t) (setq argi (substring argi 1)) (if (stringp completion) (let ((elt (assoc completion longopts))) (or elt (error "Option `%s' is ambiguous" argi)) (setq argi (substring (car elt) 1))) (setq argval nil)))) (cond ((or (string-equal argi "-q") (string-equal argi "-no-init-file")) (setq init-file-user nil args (cdr args))) ((or (string-equal argi "-u") (string-equal argi "-user")) (or argval (setq args (cdr args) argval (car args))) (setq init-file-user argval argval nil args (cdr args))) ((string-equal argi "-no-site-file") (setq site-run-file nil args (cdr args))) ((string-equal argi "-debug-init") (setq init-file-debug t args (cdr args))) ((string-equal argi "-iconic") (setq initial-frame-alist (cons '(visibility . icon) initial-frame-alist)) (setq args (cdr args))) ((or (string-equal argi "-icon-type") (string-equal argi "-i") (string-equal argi "-itype")) (setq default-frame-alist (cons '(icon-type . t) default-frame-alist)) (setq args (cdr args))) (t (setq done t))) ;; Was argval set but not used? (and argval (error "Option `%s' doesn't allow an argument" argi)))) ;; Re-attach the program name to the front of the arg list. (and command-line-args (setcdr command-line-args args))) ;; Under X Windows, this creates the X frame and deletes the terminal frame. (if (fboundp 'face-initialize) (face-initialize)) (if (fboundp 'frame-initialize) (frame-initialize)) ;; If frame was created with a menu bar, set menu-bar-mode on. (if (or (not (or (eq window-system 'x) (eq window-system 'win32))) (> (cdr (assq 'menu-bar-lines (frame-parameters))) 0)) (menu-bar-mode t)) (run-hooks 'before-init-hook) ;; Run the site-start library if it exists. The point of this file is ;; that it is run before .emacs. There is no point in doing this after ;; .emacs; that is useless. (if site-run-file (load site-run-file t t)) ;; Sites should not disable this. Only individuals should disable ;; the startup message. (setq inhibit-startup-message nil) ;; Load that user's init file, or the default one, or none. (let (debug-on-error-from-init-file debug-on-error-should-be-set (debug-on-error-initial (if (eq init-file-debug t) 'startup init-file-debug))) (let ((debug-on-error debug-on-error-initial) ;; This function actually reads the init files. (inner (function (lambda () (if init-file-user (progn (setq user-init-file (cond ((eq system-type 'ms-dos) (concat "~" init-file-user "/_emacs")) ((eq system-type 'windows-nt) "~/_emacs") ((eq system-type 'vax-vms) "sys$login:.emacs") (t (concat "~" init-file-user "/.emacs")))) (load user-init-file t t t) (or inhibit-default-init (let ((inhibit-startup-message nil)) ;; Users are supposed to be told their rights. ;; (Plus how to get help and how to undo.) ;; Don't you dare turn this off for anyone ;; except yourself. (load "default" t t))))))))) (if init-file-debug ;; Do this without a condition-case if the user wants to debug. (funcall inner) (condition-case error (progn (funcall inner) (setq init-file-had-error nil)) (error (message "Error in init file: %s%s%s" (get (car error) 'error-message) (if (cdr error) ": " "") (mapconcat 'prin1-to-string (cdr error) ", ")) (setq init-file-had-error t)))) ;; If we can tell that the init file altered debug-on-error, ;; arrange to preserve the value that it set up. (or (eq debug-on-error debug-on-error-initial) (setq debug-on-error-should-be-set t debug-on-error-from-init-file debug-on-error))) (if debug-on-error-should-be-set (setq debug-on-error debug-on-error-from-init-file))) ;; Do this here in case the init file sets mail-host-address. (or user-mail-address (setq user-mail-address (concat (user-login-name) "@" (or mail-host-address (system-name))))) (run-hooks 'after-init-hook) ;; If *scratch* exists and init file didn't change its mode, initialize it. (if (get-buffer "*scratch*") (save-excursion (set-buffer "*scratch*") (if (eq major-mode 'fundamental-mode) (funcall initial-major-mode)))) ;; Load library for our terminal type. ;; User init file can set term-file-prefix to nil to prevent this. (and term-file-prefix (not noninteractive) (not window-system) (let ((term (getenv "TERM")) hyphend) (while (and term (not (load (concat term-file-prefix term) t t))) ;; Strip off last hyphen and what follows, then try again (if (setq hyphend (string-match "[-_][^-_]+$" term)) (setq term (substring term 0 hyphend)) (setq term nil))))) ;; Process the remaining args. (command-line-1 (cdr command-line-args)) ;; If -batch, terminate after processing the command options. (if noninteractive (kill-emacs t))) (defun command-line-1 (command-line-args-left) (or noninteractive (input-pending-p) init-file-had-error (and inhibit-startup-echo-area-message (let ((buffer (get-buffer-create " *temp*"))) (prog1 (condition-case nil (save-excursion (set-buffer buffer) (insert-file-contents user-init-file) (re-search-forward (concat "([ \t\n]*setq[ \t\n]+" "inhibit-startup-echo-area-message[ \t\n]+" (regexp-quote (prin1-to-string (if (string= init-file-user "") (user-login-name) init-file-user))) "[ \t\n]*)") nil t)) (error nil)) (kill-buffer buffer)))) (message (if (eq (key-binding "\C-h\C-p") 'describe-project) "For information about the GNU Project and its goals, type C-h C-p." (substitute-command-keys "For information about the GNU Project and its goals, type \\[describe-project].")))) (if (null command-line-args-left) (cond ((and (not inhibit-startup-message) (not noninteractive) ;; Don't clobber a non-scratch buffer if init file ;; has selected it. (string= (buffer-name) "*scratch*") (not (input-pending-p))) ;; If there are no switches to process, we might as well ;; run this hook now, and there may be some need to do it ;; before doing any output. (and term-setup-hook (run-hooks 'term-setup-hook)) ;; Don't let the hook be run twice. (setq term-setup-hook nil) ;; It's important to notice the user settings before we ;; display the startup message; otherwise, the settings ;; won't take effect until the user gives the first ;; keystroke, and that's distracting. (if (fboundp 'frame-notice-user-settings) (frame-notice-user-settings)) (and window-setup-hook (run-hooks 'window-setup-hook)) (setq window-setup-hook nil) ;; Do this now to avoid an annoying delay if the user ;; clicks the menu bar during the sit-for. (if (or (eq window-system 'x) (eq window-system 'win32)) (precompute-menubar-bindings)) (setq menubar-bindings-done t) (unwind-protect (progn ;; The convention for this piece of code is that ;; each piece of output starts with one or two newlines ;; and does not end with any newlines. (insert (emacs-version) " Copyright (C) 1995 Free Software Foundation, Inc.") ;; If keys have their default meanings, ;; use precomputed string to save lots of time. (if (and (eq (key-binding "\C-h") 'help-command) (eq (key-binding "\C-xu") 'advertised-undo) (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs) (eq (key-binding "\C-ht") 'help-with-tutorial) (eq (key-binding "\C-hi") 'info)) (insert "\n Type C-h for help; C-x u to undo changes. (`C-' means use CTRL key.) To kill the Emacs job, type C-x C-c. Type C-h t for a tutorial on using Emacs. Type C-h i to enter Info, which you can use to read GNU documentation.") (insert (substitute-command-keys (format "\n Type %s for help; \\[advertised-undo] to undo changes. (`C-' means use CTRL key.) To kill the Emacs job, type \\[save-buffers-kill-emacs]. Type \\[help-with-tutorial] for a tutorial on using Emacs. Type \\[info] to enter Info, which you can use to read GNU documentation." (let ((where (where-is-internal 'help-command nil t))) (if where (key-description where) "M-x help")))))) ;; Say how to use the menu bar ;; if that is not with the mouse. (if (not (assq 'display (frame-parameters))) (if (eq (key-binding "\M-`") 'tmm-menubar) (insert "\n\nType F10, ESC ` or Meta-` to use the menu bar.") (insert (substitute-command-keys "\n\nType \\[tmm-menubar] to use the menu bar.")))) ;; Windows and MSDOS (currently) do not count as ;; window systems, but do have mouse support. (if (or (memq system-type '(msdos windowsnt)) window-system) (insert "\n C-mouse-3 (third mouse button, with Control) gets a mode-specific menu.")) (if (directory-files "~/" nil "\\`\\.saves-" t) (insert "\n\nIf an Emacs session crashed recently,\n" "type M-x recover-session RET to recover" " the files you were editing.")) (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) (eq (key-binding "\C-h\C-d") 'describe-distribution) (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) (insert "\n GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details. You may give out copies of Emacs; type C-h C-c to see the conditions. Type C-h C-d for information on getting the latest version.") (insert (substitute-command-keys "\n GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details. You may give out copies of Emacs; type \\[describe-copying] to see the conditions. Type \\[describe-distribution] for information on getting the latest version."))) (set-buffer-modified-p nil) (sit-for 120)) (save-excursion ;; In case the Emacs server has already selected ;; another buffer, erase the one our message is in. (set-buffer (get-buffer "*scratch*")) (erase-buffer) (set-buffer-modified-p nil))))) ;; Delay 2 seconds after the init file error message ;; was displayed, so user can read it. (if init-file-had-error (sit-for 2)) (let ((dir command-line-default-directory) (file-count 0) first-file-buffer (line 0)) (while command-line-args-left (let* ((argi (car command-line-args-left)) (orig-argi argi) ;; This includes our standard options' long versions ;; and long versions of what's on command-switch-alist. (longopts (append '(("--funcall") ("--load") ("--insert") ("--kill") ("--directory") ("--eval")) (mapcar '(lambda (elt) (list (concat "-" (car elt)))) command-switch-alist))) tem argval completion ;; List of directories specified in -L/--directory, ;; in reverse of the order specified. extra-load-path (initial-load-path load-path)) (setq command-line-args-left (cdr command-line-args-left)) ;; Convert long options to ordinary options ;; and separate out an attached option argument into argval. (if (string-match "^--[^=]*=" argi) (setq argval (substring argi (match-end 0)) argi (substring argi 0 (1- (match-end 0))))) (setq completion (try-completion argi longopts)) (if (eq completion t) (setq argi (substring argi 1)) (if (stringp completion) (let ((elt (assoc completion longopts))) (or elt (error "Option `%s' is ambiguous" argi)) (setq argi (substring (car elt) 1))) (setq argval nil argi orig-argi))) ;; Execute the option. (cond ((setq tem (assoc argi command-switch-alist)) (if argval (let ((command-line-args-left (cons argval command-line-args-left))) (funcall (cdr tem) argi)) (funcall (cdr tem) argi))) ((or (string-equal argi "-f") ;what the manual claims (string-equal argi "-funcall") (string-equal argi "-e")) ; what the source used to say (if argval (setq tem (intern argval)) (setq tem (intern (car command-line-args-left))) (setq command-line-args-left (cdr command-line-args-left))) (if (arrayp (symbol-function tem)) (command-execute tem) (funcall tem))) ((string-equal argi "-eval") (if argval (setq tem argval) (setq tem (car command-line-args-left)) (setq command-line-args-left (cdr command-line-args-left))) (eval (read tem))) ;; Set the default directory as specified in -L. ((or (string-equal argi "-L") (string-equal argi "-directory")) (if argval (setq tem argval) (setq tem (car command-line-args-left) command-line-args-left (cdr command-line-args-left))) (setq extra-load-path (cons (expand-file-name tem) extra-load-path)) (setq load-path (append (nreverse extra-load-path) initial-load-path))) ((or (string-equal argi "-l") (string-equal argi "-load")) (if argval (setq tem argval) (setq tem (car command-line-args-left) command-line-args-left (cdr command-line-args-left))) (let ((file tem)) ;; Take file from default dir if it exists there; ;; otherwise let `load' search for it. (if (file-exists-p (expand-file-name file)) (setq file (expand-file-name file))) (load file nil t))) ((string-equal argi "-insert") (if argval (setq tem argval) (setq tem (car command-line-args-left) command-line-args-left (cdr command-line-args-left))) (or (stringp tem) (error "File name omitted from `-insert' option")) (insert-file-contents tem)) ((string-equal argi "-kill") (kill-emacs t)) ((string-match "^\\+[0-9]+\\'" argi) (setq line (string-to-int argi))) (t ;; We have almost exhausted our options. See if the ;; user has made any other command-line options available (let ((hooks command-line-functions);; lrs 7/31/89 (did-hook nil)) (while (and hooks (not (setq did-hook (funcall (car hooks))))) (setq hooks (cdr hooks))) (if (not did-hook) ;; Ok, presume that the argument is a file name (progn (if (string-match "\\`-" argi) (error "Unknown option `%s'" argi)) (setq file-count (1+ file-count)) (cond ((= file-count 1) (setq first-file-buffer (find-file (expand-file-name argi dir)))) (t (find-file-other-window (expand-file-name argi dir)))) (or (zerop line) (goto-line line)) (setq line 0)))))))) ;; If 3 or more files visited, and not all visible, ;; show user what they all are. (if (> file-count 2) (or (get-buffer-window first-file-buffer) (progn (other-window 1) (buffer-menu))))))) ;;; startup.el ends here emacs-19.30/lisp/studly.el100444 13437 1 3275 5354240752 14066 0ustar jimbdaemon;;; studly.el --- StudlyCaps (tm)(r)(c)(xxx) ;;; This is in the public domain, since it was distributed ;;; by its author without a copyright notice in 1986. ;; Keywords: games ;;; Commentary: ;; Functions to studlycapsify a region, word, or buffer. Possibly the ;; esoteric significance of studlycapsification escapes you; that is, ;; you suffer from autostudlycapsifibogotification. Too bad. ;;; Code: (defun studlify-region (begin end) "Studlify-case the region" (interactive "*r") (save-excursion (goto-char begin) (setq begin (point)) (while (and (<= (point) end) (not (looking-at "\\W*\\'"))) (forward-word 1) (backward-word 1) (setq begin (max (point) begin)) (forward-word 1) (let ((offset 0) (word-end (min (point) end)) c) (goto-char begin) (while (< (point) word-end) (setq offset (+ offset (following-char))) (forward-char 1)) (setq offset (+ offset (following-char))) (goto-char begin) (while (< (point) word-end) (setq c (following-char)) (if (and (= (% (+ c offset) 4) 2) (let ((ch (following-char))) (or (and (>= ch ?a) (<= ch ?z)) (and (>= ch ?A) (<= ch ?Z))))) (progn (delete-char 1) (insert (logxor c ? )))) (forward-char 1)) (setq begin (point)))))) (defun studlify-word (count) "Studlify-case the current word, or COUNT words if given an argument" (interactive "*p") (let ((begin (point)) end rb re) (forward-word count) (setq end (point)) (setq rb (min begin end) re (max begin end)) (studlify-region rb re))) (defun studlify-buffer () "Studlify-case the current buffer" (interactive "*") (studlify-region (point-min) (point-max))) ;;; studly.el ends here emacs-19.30/lisp/subr.el100444 12120 1 100511 6035376167 13417 0ustar rmsdaemon;;; subr.el --- basic lisp subroutines for Emacs ;;; Copyright (C) 1985, 1986, 1992, 1994, 1995 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. ;;; Code: ;;;; Lisp language features. (defmacro lambda (&rest cdr) "Return a lambda expression. A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is self-quoting; the result of evaluating the lambda expression is the expression itself. The lambda expression may then be treated as a function, i.e., stored as the function value of a symbol, passed to funcall or mapcar, etc. ARGS should take the same form as an argument list for a `defun'. DOCSTRING is an optional documentation string. If present, it should describe how to call the function. But documentation strings are usually not useful in nameless functions. INTERACTIVE should be a call to the function `interactive', which see. It may also be omitted. BODY should be a list of lisp expressions." ;; Note that this definition should not use backquotes; subr.el should not ;; depend on backquote.el. (list 'function (cons 'lambda cdr))) ;;(defmacro defun-inline (name args &rest body) ;; "Create an \"inline defun\" (actually a macro). ;;Use just like `defun'." ;; (nconc (list 'defmacro name '(&rest args)) ;; (if (stringp (car body)) ;; (prog1 (list (car body)) ;; (setq body (or (cdr body) body)))) ;; (list (list 'cons (list 'quote ;; (cons 'lambda (cons args body))) ;; 'args)))) ;;;; Keymap support. (defun undefined () (interactive) (ding)) ;Prevent the \{...} documentation construct ;from mentioning keys that run this command. (put 'undefined 'suppress-keymap t) (defun suppress-keymap (map &optional nodigits) "Make MAP override all normally self-inserting keys to be undefined. Normally, as an exception, digits and minus-sign are set to make prefix args, but optional second arg NODIGITS non-nil treats them like other chars." (substitute-key-definition 'self-insert-command 'undefined map global-map) (or nodigits (let (loop) (define-key map "-" 'negative-argument) ;; Make plain numbers do numeric args. (setq loop ?0) (while (<= loop ?9) (define-key map (char-to-string loop) 'digit-argument) (setq loop (1+ loop)))))) ;Moved to keymap.c ;(defun copy-keymap (keymap) ; "Return a copy of KEYMAP" ; (while (not (keymapp keymap)) ; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap)))) ; (if (vectorp keymap) ; (copy-sequence keymap) ; (copy-alist keymap))) (defvar key-substitution-in-progress nil "Used internally by substitute-key-definition.") (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix) "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. In other words, OLDDEF is replaced with NEWDEF where ever it appears. If optional fourth argument OLDMAP is specified, we redefine in KEYMAP as NEWDEF those chars which are defined as OLDDEF in OLDMAP." (or prefix (setq prefix "")) (let* ((scan (or oldmap keymap)) (vec1 (vector nil)) (prefix1 (vconcat prefix vec1)) (key-substitution-in-progress (cons scan key-substitution-in-progress))) ;; Scan OLDMAP, finding each char or event-symbol that ;; has any definition, and act on it with hack-key. (while (consp scan) (if (consp (car scan)) (let ((char (car (car scan))) (defn (cdr (car scan)))) ;; The inside of this let duplicates exactly ;; the inside of the following let that handles array elements. (aset vec1 0 char) (aset prefix1 (length prefix) char) (let (inner-def skipped) ;; Skip past menu-prompt. (while (stringp (car-safe defn)) (setq skipped (cons (car defn) skipped)) (setq defn (cdr defn))) ;; Skip past cached key-equivalence data for menu items. (and (consp defn) (consp (car defn)) (setq defn (cdr defn))) (setq inner-def defn) ;; Look past a symbol that names a keymap. (while (and (symbolp inner-def) (fboundp inner-def)) (setq inner-def (symbol-function inner-def))) (if (eq defn olddef) (define-key keymap prefix1 (nconc (nreverse skipped) newdef)) (if (and (keymapp defn) ;; Avoid recursively scanning ;; where KEYMAP does not have a submap. (let ((elt (lookup-key keymap prefix1))) (or (null elt) (keymapp elt))) ;; Avoid recursively rescanning keymap being scanned. (not (memq inner-def key-substitution-in-progress))) ;; If this one isn't being scanned already, ;; scan it now. (substitute-key-definition olddef newdef keymap inner-def prefix1))))) (if (arrayp (car scan)) (let* ((array (car scan)) (len (length array)) (i 0)) (while (< i len) (let ((char i) (defn (aref array i))) ;; The inside of this let duplicates exactly ;; the inside of the previous let. (aset vec1 0 char) (aset prefix1 (length prefix) char) (let (inner-def skipped) ;; Skip past menu-prompt. (while (stringp (car-safe defn)) (setq skipped (cons (car defn) skipped)) (setq defn (cdr defn))) (and (consp defn) (consp (car defn)) (setq defn (cdr defn))) (setq inner-def defn) (while (and (symbolp inner-def) (fboundp inner-def)) (setq inner-def (symbol-function inner-def))) (if (eq defn olddef) (define-key keymap prefix1 (nconc (nreverse skipped) newdef)) (if (and (keymapp defn) (let ((elt (lookup-key keymap prefix1))) (or (null elt) (keymapp elt))) (not (memq inner-def key-substitution-in-progress))) (substitute-key-definition olddef newdef keymap inner-def prefix1))))) (setq i (1+ i)))))) (setq scan (cdr scan))))) (defun define-key-after (keymap key definition after) "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding. This is like `define-key' except that the binding for KEY is placed 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--that is to say, it must be a string or vector of length 1." (or (keymapp keymap) (signal 'wrong-type-argument (list 'keymapp keymap))) (if (> (length key) 1) (error "multi-event key specified in `define-key-after'")) (let ((tail keymap) done inserted (first (aref key 0))) (while (and (not done) tail) ;; Delete any earlier bindings for the same key. (if (eq (car-safe (car (cdr tail))) first) (setcdr tail (cdr (cdr tail)))) ;; When we reach AFTER's binding, insert the new binding after. ;; If we reach an inherited keymap, insert just before that. ;; If we reach the end of this keymap, insert at the end. (if (or (eq (car-safe (car tail)) after) (eq (car (cdr tail)) 'keymap) (null (cdr tail))) (progn ;; Stop the scan only if we find a parent keymap. ;; Keep going past the inserted element ;; so we can delete any duplications that come later. (if (eq (car (cdr tail)) 'keymap) (setq done t)) ;; Don't insert more than once. (or inserted (setcdr tail (cons (cons (aref key 0) definition) (cdr tail)))) (setq inserted t))) (setq tail (cdr tail))))) (defun keyboard-translate (from to) "Translate character FROM to TO at a low level. This function creates a `keyboard-translate-table' if necessary and then modifies one entry in it." (or (arrayp keyboard-translate-table) (setq keyboard-translate-table "")) (if (or (> from (length keyboard-translate-table)) (> to (length keyboard-translate-table))) (progn (let* ((i (length keyboard-translate-table)) (table (concat keyboard-translate-table (make-string (- 256 i) 0)))) (while (< i 256) (aset table i i) (setq i (1+ i))) (setq keyboard-translate-table table)))) (aset keyboard-translate-table from to)) ;;;; The global keymap tree. ;;; global-map, esc-map, and ctl-x-map have their values set up in ;;; keymap.c; we just give them docstrings here. (defvar global-map nil "Default global keymap mapping Emacs keyboard input into commands. The value is a keymap which is usually (but not necessarily) Emacs's global map.") (defvar esc-map nil "Default keymap for ESC (meta) commands. The normal global definition of the character ESC indirects to this keymap.") (defvar ctl-x-map nil "Default keymap for C-x commands. The normal global definition of the character C-x indirects to this keymap.") (defvar ctl-x-4-map (make-sparse-keymap) "Keymap for subcommands of C-x 4") (defalias 'ctl-x-4-prefix ctl-x-4-map) (define-key ctl-x-map "4" 'ctl-x-4-prefix) (defvar ctl-x-5-map (make-sparse-keymap) "Keymap for frame commands.") (defalias 'ctl-x-5-prefix ctl-x-5-map) (define-key ctl-x-map "5" 'ctl-x-5-prefix) ;;;; Event manipulation functions. ;; The call to `read' is to ensure that the value is computed at load time ;; and not compiled into the .elc file. The value is negative on most ;; machines, but not on all! (defconst listify-key-sequence-1 (logior 128 (read "?\\M-\\^@"))) (defun listify-key-sequence (key) "Convert a key sequence to a list of events." (if (vectorp key) (append key nil) (mapcar (function (lambda (c) (if (> c 127) (logxor c listify-key-sequence-1) c))) (append key nil)))) (defsubst eventp (obj) "True if the argument is an event object." (or (integerp obj) (and (symbolp obj) (get obj 'event-symbol-elements)) (and (consp obj) (symbolp (car obj)) (get (car obj) 'event-symbol-elements)))) (defun event-modifiers (event) "Returns a list of symbols representing the modifier keys in event EVENT. The elements of the list may include `meta', `control', `shift', `hyper', `super', `alt', `click', `double', `triple', `drag', and `down'." (let ((type event)) (if (listp type) (setq type (car type))) (if (symbolp type) (cdr (get type 'event-symbol-elements)) (let ((list nil)) (or (zerop (logand type ?\M-\^@)) (setq list (cons 'meta list))) (or (and (zerop (logand type ?\C-\^@)) (>= (logand type 127) 32)) (setq list (cons 'control list))) (or (and (zerop (logand type ?\S-\^@)) (= (logand type 255) (downcase (logand type 255)))) (setq list (cons 'shift list))) (or (zerop (logand type ?\H-\^@)) (setq list (cons 'hyper list))) (or (zerop (logand type ?\s-\^@)) (setq list (cons 'super list))) (or (zerop (logand type ?\A-\^@)) (setq list (cons 'alt list))) list)))) (defun event-basic-type (event) "Returns the basic type of the given event (all modifiers removed). The value is an ASCII printing character (not upper case) or a symbol." (if (consp event) (setq event (car event))) (if (symbolp event) (car (get event 'event-symbol-elements)) (let ((base (logand event (1- (lsh 1 18))))) (downcase (if (< base 32) (logior base 64) base))))) (defsubst mouse-movement-p (object) "Return non-nil if OBJECT is a mouse movement event." (and (consp object) (eq (car object) 'mouse-movement))) (defsubst event-start (event) "Return the starting position of EVENT. If EVENT is a mouse press or a mouse click, this returns the location of the event. If EVENT is a drag, this returns the drag's starting position. The return value is of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) The `posn-' functions access elements of such lists." (nth 1 event)) (defsubst event-end (event) "Return the ending location of EVENT. EVENT should be a click or drag event. If EVENT is a click event, this function is the same as `event-start'. The return value is of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) The `posn-' functions access elements of such lists." (nth (if (consp (nth 2 event)) 2 1) event)) (defsubst event-click-count (event) "Return the multi-click count of EVENT, a click or drag event. The return value is a positive integer." (if (integerp (nth 2 event)) (nth 2 event) 1)) (defsubst posn-window (position) "Return the window in POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) as returned by the `event-start' and `event-end' functions." (nth 0 position)) (defsubst posn-point (position) "Return the buffer location in POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) as returned by the `event-start' and `event-end' functions." (if (consp (nth 1 position)) (car (nth 1 position)) (nth 1 position))) (defsubst posn-x-y (position) "Return the x and y coordinates in POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) as returned by the `event-start' and `event-end' functions." (nth 2 position)) (defun posn-col-row (position) "Return the column and row in POSITION, measured in characters. POSITION should be a list of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) as returned by the `event-start' and `event-end' functions. For a scroll-bar event, the result column is 0, and the row corresponds to the vertical position of the click in the scroll bar." (let ((pair (nth 2 position)) (window (posn-window position))) (if (eq (if (consp (nth 1 position)) (car (nth 1 position)) (nth 1 position)) 'vertical-scroll-bar) (cons 0 (scroll-bar-scale pair (1- (window-height window)))) (if (eq (if (consp (nth 1 position)) (car (nth 1 position)) (nth 1 position)) 'horizontal-scroll-bar) (cons (scroll-bar-scale pair (window-width window)) 0) (let* ((frame (if (framep window) window (window-frame window))) (x (/ (car pair) (frame-char-width frame))) (y (/ (cdr pair) (frame-char-height frame)))) (cons x y)))))) (defsubst posn-timestamp (position) "Return the timestamp of POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) as returned by the `event-start' and `event-end' functions." (nth 3 position)) ;;;; Obsolescent names for functions. (defalias 'dot 'point) (defalias 'dot-marker 'point-marker) (defalias 'dot-min 'point-min) (defalias 'dot-max 'point-max) (defalias 'window-dot 'window-point) (defalias 'set-window-dot 'set-window-point) (defalias 'read-input 'read-string) (defalias 'send-string 'process-send-string) (defalias 'send-region 'process-send-region) (defalias 'show-buffer 'set-window-buffer) (defalias 'buffer-flush-undo 'buffer-disable-undo) (defalias 'eval-current-buffer 'eval-buffer) (defalias 'compiled-function-p 'byte-code-function-p) ;; Some programs still use this as a function. (defun baud-rate () "Obsolete function returning the value of the `baud-rate' variable. Please convert your programs to use the variable `baud-rate' directly." baud-rate) ;;;; Alternate names for functions - these are not being phased out. (defalias 'string= 'string-equal) (defalias 'string< 'string-lessp) (defalias 'move-marker 'set-marker) (defalias 'eql 'eq) (defalias 'not 'null) (defalias 'rplaca 'setcar) (defalias 'rplacd 'setcdr) (defalias 'beep 'ding) ;preserve lingual purity (defalias 'indent-to-column 'indent-to) (defalias 'backward-delete-char 'delete-backward-char) (defalias 'search-forward-regexp (symbol-function 're-search-forward)) (defalias 'search-backward-regexp (symbol-function 're-search-backward)) (defalias 'int-to-string 'number-to-string) (defalias 'set-match-data 'store-match-data) ;;; Should this be an obsolete name? If you decide it should, you get ;;; to go through all the sources and change them. (defalias 'string-to-int 'string-to-number) ;;;; Hook manipulation functions. ;; We used to have this variable so that C code knew how to run hooks. That ;; calling convention is made obsolete now the hook running functions are in C. (defconst run-hooks 'run-hooks "Variable by which C primitives find the function `run-hooks'. Don't change it. Don't use it either; use the hook running C primitives.") (defun make-local-hook (hook) "Make the hook HOOK local to the current buffer. When a hook is local, its local and global values work in concert: running the hook actually runs all the hook functions listed in *either* the local value *or* the global value of the hook variable. This function works by making `t' a member of the buffer-local value, which acts as a flag to run the hook functions in the default value as well. This works for all normal hooks, but does not work for most non-normal hooks yet. We will be changing the callers of non-normal hooks so that they can handle localness; this has to be done one by one. This function does nothing if HOOK is already local in the current buffer. Do not use `make-local-variable' to make a hook variable buffer-local." (if (local-variable-p hook) nil (or (boundp hook) (set hook nil)) (make-local-variable hook) (set hook (list t)))) (defun add-hook (hook function &optional append local) "Add to the value of HOOK the function FUNCTION. FUNCTION is not added if already present. FUNCTION is added (if necessary) at the beginning of the hook list unless the optional argument APPEND is non-nil, in which case FUNCTION is added at the end. The optional fourth argument, LOCAL, if non-nil, says to modify the hook's buffer-local value rather than its default value. This makes no difference if the hook is not buffer-local. To make a hook variable buffer-local, always use `make-local-hook', not `make-local-variable'. HOOK should be a symbol, and FUNCTION may be any valid function. If HOOK is void, it is first set to nil. If HOOK's value is a single function, it is changed to a list of functions." (or (boundp hook) (set hook nil)) (or (default-boundp hook) (set-default hook nil)) ;; If the hook value is a single function, turn it into a list. (let ((old (symbol-value hook))) (if (or (not (listp old)) (eq (car old) 'lambda)) (set hook (list old)))) (if (or local ;; Detect the case where make-local-variable was used on a hook ;; and do what we used to do. (and (local-variable-if-set-p hook) (not (memq t (symbol-value hook))))) ;; Alter the local value only. (or (if (consp function) (member function (symbol-value hook)) (memq function (symbol-value hook))) (set hook (if append (append (symbol-value hook) (list function)) (cons function (symbol-value hook))))) ;; Alter the global value (which is also the only value, ;; if the hook doesn't have a local value). (or (if (consp function) (member function (default-value hook)) (memq function (default-value hook))) (set-default hook (if append (append (default-value hook) (list function)) (cons function (default-value hook))))))) (defun remove-hook (hook function &optional local) "Remove from the value of HOOK the function FUNCTION. HOOK should be a symbol, and FUNCTION may be any valid function. If FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the list of hooks to run in HOOK, then nothing is done. See `add-hook'. The optional third argument, LOCAL, if non-nil, says to modify the hook's buffer-local value rather than its default value. This makes no difference if the hook is not buffer-local. To make a hook variable buffer-local, always use `make-local-hook', not `make-local-variable'." (if (or (not (boundp hook)) ;unbound symbol, or (not (default-boundp 'hook)) (null (symbol-value hook)) ;value is nil, or (null function)) ;function is nil, then nil ;Do nothing. (if (or local ;; Detect the case where make-local-variable was used on a hook ;; and do what we used to do. (and (local-variable-p hook) (not (memq t (symbol-value hook))))) (let ((hook-value (symbol-value hook))) (if (consp hook-value) (if (member function hook-value) (setq hook-value (delete function (copy-sequence hook-value)))) (if (equal hook-value function) (setq hook-value nil))) (set hook hook-value)) (let ((hook-value (default-value hook))) (if (consp hook-value) (if (member function hook-value) (setq hook-value (delete function (copy-sequence hook-value)))) (if (equal hook-value function) (setq hook-value nil))) (set-default hook hook-value))))) (defun add-to-list (list-var element) "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. If you want to use `add-to-list' on a variable that is not defined until a certain package is loaded, you should put the call to `add-to-list' into a hook function that will be run only after loading the package. `eval-after-load' provides one way to do this. In some cases other hooks, such as major mode hooks, can do the job." (or (member element (symbol-value list-var)) (set list-var (cons element (symbol-value list-var))))) ;;;; Specifying things to do after certain files are loaded. (defun eval-after-load (file form) "Arrange that, if FILE is ever loaded, FORM will be run at that time. This makes or adds to an entry on `after-load-alist'. If FILE is already loaded, evaluate FORM right now. It does nothing if FORM is already on the list for FILE. FILE should be the name of a library, with no directory name." ;; Make sure there is an element for FILE. (or (assoc file after-load-alist) (setq after-load-alist (cons (list file) after-load-alist))) ;; Add FORM to the element if it isn't there. (let ((elt (assoc file after-load-alist))) (or (member form (cdr elt)) (progn (nconc elt (list form)) ;; If the file has been loaded already, run FORM right away. (and (assoc file load-history) (eval form))))) form) (defun eval-next-after-load (file) "Read the following input sexp, and run it whenever FILE is loaded. This makes or adds to an entry on `after-load-alist'. FILE should be the name of a library, with no directory name." (eval-after-load file (read))) ;;;; Input and display facilities. (defun read-quoted-char (&optional prompt) "Like `read-char', except that if the first character read is an octal digit, we read up to two more octal digits and return the character represented by the octal number consisting of those digits. Optional argument PROMPT specifies a string to use to prompt the user." (let ((message-log-max nil) (count 0) (code 0) char) (while (< count 3) (let ((inhibit-quit (zerop count)) ;; Don't let C-h get the help message--only help function keys. (help-char nil) (help-form "Type the special character you want to use, or three octal digits representing its character code.")) (and prompt (message "%s-" prompt)) (setq char (read-char)) (if inhibit-quit (setq quit-flag nil))) (cond ((null char)) ((and (<= ?0 char) (<= char ?7)) (setq code (+ (* code 8) (- char ?0)) count (1+ count)) (and prompt (message (setq prompt (format "%s %c" prompt char))))) ((> count 0) (setq unread-command-events (list char) count 259)) (t (setq code char count 259)))) ;; Turn a meta-character into a character with the 0200 bit set. (logior (if (/= (logand code ?\M-\^@) 0) 128 0) (logand 255 code)))) (defun force-mode-line-update (&optional all) "Force the mode-line of the current buffer to be redisplayed. With optional non-nil ALL, force redisplay of all mode-lines." (if all (save-excursion (set-buffer (other-buffer)))) (set-buffer-modified-p (buffer-modified-p))) (defun momentary-string-display (string pos &optional exit-char message) "Momentarily display STRING in the buffer at POS. Display remains until next character is typed. If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed; otherwise it is then available as input (as a command if nothing else). Display MESSAGE (optional fourth arg) in the echo area. If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there." (or exit-char (setq exit-char ?\ )) (let ((buffer-read-only nil) ;; Don't modify the undo list at all. (buffer-undo-list t) (modified (buffer-modified-p)) (name buffer-file-name) insert-end) (unwind-protect (progn (save-excursion (goto-char pos) ;; defeat file locking... don't try this at home, kids! (setq buffer-file-name nil) (insert-before-markers string) (setq insert-end (point)) ;; If the message end is off screen, recenter now. (if (> (window-end) insert-end) (recenter (/ (window-height) 2))) ;; If that pushed message start off the screen, ;; scroll to start it at the top of the screen. (move-to-window-line 0) (if (> (point) pos) (progn (goto-char pos) (recenter 0)))) (message (or message "Type %s to continue editing.") (single-key-description exit-char)) (let ((char (read-event))) (or (eq char exit-char) (setq unread-command-events (list char))))) (if insert-end (save-excursion (delete-region pos insert-end))) (setq buffer-file-name name) (set-buffer-modified-p modified)))) ;;;; Miscellanea. ;; A number of major modes set this locally. ;; Give it a global value to avoid compiler warnings. (defvar font-lock-defaults nil) ;; Avoid compiler warnings about this variable, ;; which has a special meaning on certain system types. (defvar buffer-file-type nil "Non-nil if the visited file is a binary file. This variable is meaningful on MS-DOG and Windows NT. On those systems, it is automatically local in every buffer. On other systems, this variable is normally always nil.") (defun ignore (&rest ignore) "Do nothing and return nil. This function accepts any number of arguments, but ignores them." (interactive) nil) (defun error (&rest args) "Signal an error, making error message by passing all args to `format'." (while t (signal 'error (list (apply 'format args))))) (defalias 'user-original-login-name 'user-login-name) (defun start-process-shell-command (name buffer &rest args) "Start a program in a subprocess. Return the process object for it. Args are NAME BUFFER COMMAND &rest COMMAND-ARGS. NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer or (buffer-name) to associate with the process. Process output goes at end of that buffer, unless you specify an output stream or filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated with any buffer Third arg is command name, the name of a shell command. Remaining arguments are the arguments for the command. Wildcards and redirection are handled as usual in the shell." (cond ((eq system-type 'vax-vms) (apply 'start-process name buffer args)) ;; We used to use `exec' to replace the shell with the command, ;; but that failed to handle (...) and semicolon, etc. (t (start-process name buffer shell-file-name shell-command-switch (mapconcat 'identity args " "))))) (defmacro save-match-data (&rest body) "Execute the BODY forms, restoring the global value of the match data." (let ((original (make-symbol "match-data"))) (list 'let (list (list original '(match-data))) (list 'unwind-protect (cons 'progn body) (list 'store-match-data original))))) (defun match-string (num &optional string) "Return string of text matched by last search. NUM specifies which parenthesized expression in the last regexp. Value is nil if NUMth pair didn't match, or there were less than NUM pairs. Zero means the entire text matched by the whole regexp or whole string. STRING should be given if the last search was by `string-match' on STRING." (if (match-beginning num) (if string (substring string (match-beginning num) (match-end num)) (buffer-substring (match-beginning num) (match-end num))))) (defun buffer-substring-no-properties (beg end) "Return the text from BEG to END, without text properties, as a string." (let ((string (buffer-substring beg end))) (set-text-properties 0 (length string) nil string) string)) (defun shell-quote-argument (argument) "Quote an argument for passing as argument to an inferior shell." (if (eq system-type 'ms-dos) ;; MS-DOS shells don't have quoting, so don't do any. argument (if (eq system-type 'windows-nt) (concat "\"" argument "\"") ;; Quote everything except POSIX filename characters. ;; This should be safe enough even for really weird shells. (let ((result "") (start 0) end) (while (string-match "[^-0-9a-zA-Z_./]" argument start) (setq end (match-beginning 0) result (concat result (substring argument start end) "\\" (substring argument end (1+ end))) start (1+ end))) (concat result (substring argument start)))))) (defun make-syntax-table (&optional oldtable) "Return a new syntax table. It inherits all letters and control characters from the standard syntax table; other characters are copied from the standard syntax table." (if oldtable (copy-syntax-table oldtable) (let ((table (copy-syntax-table)) i) (setq i 0) (while (<= i 31) (aset table i nil) (setq i (1+ i))) (setq i ?A) (while (<= i ?Z) (aset table i nil) (setq i (1+ i))) (setq i ?a) (while (<= i ?z) (aset table i nil) (setq i (1+ i))) (setq i 128) (while (<= i 255) (aset table i nil) (setq i (1+ i))) table))) (defun global-set-key (key command) "Give KEY a global binding as COMMAND. COMMAND is a symbol naming an interactively-callable function. KEY is a key sequence (a string or vector of characters or event types). Non-ASCII characters with codes above 127 (such as ISO Latin-1) can be included if you use a vector. Note that if KEY has a local binding in the current buffer that local binding will continue to shadow any global binding." (interactive "KSet key globally: \nCSet key %s to command: ") (or (vectorp key) (stringp key) (signal 'wrong-type-argument (list 'arrayp key))) (define-key (current-global-map) key command) nil) (defun local-set-key (key command) "Give KEY a local binding as COMMAND. COMMAND is a symbol naming an interactively-callable function. KEY is a key sequence (a string or vector of characters or event types). Non-ASCII characters with codes above 127 (such as ISO Latin-1) can be included if you use a vector. The binding goes in the current buffer's local map, which in most cases is shared with all other buffers in the same major mode." (interactive "KSet key locally: \nCSet key %s locally to command: ") (let ((map (current-local-map))) (or map (use-local-map (setq map (make-sparse-keymap)))) (or (vectorp key) (stringp key) (signal 'wrong-type-argument (list 'arrayp key))) (define-key map key command)) nil) (defun global-unset-key (key) "Remove global binding of KEY. KEY is a string representing a sequence of keystrokes." (interactive "kUnset key globally: ") (global-set-key key nil)) (defun local-unset-key (key) "Remove local binding of KEY. KEY is a string representing a sequence of keystrokes." (interactive "kUnset key locally: ") (if (current-local-map) (local-set-key key nil)) nil) ;; We put this here instead of in frame.el so that it's defined even on ;; systems where frame.el isn't loaded. (defun frame-configuration-p (object) "Return non-nil if OBJECT seems to be a frame configuration. Any list whose car is `frame-configuration' is assumed to be a frame configuration." (and (consp object) (eq (car object) 'frame-configuration))) ;; now in fns.c ;(defun nth (n list) ; "Returns the Nth element of LIST. ;N counts from zero. If LIST is not that long, nil is returned." ; (car (nthcdr n list))) ; ;(defun copy-alist (alist) ; "Return a copy of ALIST. ;This is a new alist which represents the same mapping ;from objects to objects, but does not share the alist structure with ALIST. ;The objects mapped (cars and cdrs of elements of the alist) ;are shared, however." ; (setq alist (copy-sequence alist)) ; (let ((tail alist)) ; (while tail ; (if (consp (car tail)) ; (setcar tail (cons (car (car tail)) (cdr (car tail))))) ; (setq tail (cdr tail)))) ; alist) ;;; subr.el ends here emacs-19.30/lisp/sun-curs.el100444 12241 12 15345 5444575256 14564 0ustar rolandstaff;;; sun-curs.el --- cursor definitions for Sun windows ;; Copyright (C) 1987 Free Software Foundation, Inc. ;; Author: Jeff Peck ;; Keywords: hardware ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;;; ;;; Added some more cursors and moved the hot spots ;;; Cursor defined by 16 pairs of 16-bit numbers ;;; ;;; 9-dec-86 Jeff Peck, Sun Microsystems Inc. (require 'cl) (defvar sc::cursors nil "List of known cursors") (defmacro defcursor (name x y string) (if (not (memq name sc::cursors)) (setq sc::cursors (cons name sc::cursors))) (list 'defconst name (list 'vector x y string))) ;;; push should be defined in common lisp, but if not use this: ;(defmacro push (v l) ; "The ITEM is evaluated and consed onto LIST, a list-valued atom" ; (list 'setq l (list 'cons v l))) ;;; ;;; The standard default cursor ;;; (defcursor sc:right-arrow 15 0 (concat '(0 1 0 3 0 7 0 15 0 31 0 63 0 127 0 15 0 27 0 25 0 48 0 48 0 96 0 96 0 192 0 192))) ;;(sc:set-cursor sc:right-arrow) (defcursor sc:fat-left-arrow 0 8 (concat '(1 0 3 0 7 0 15 0 31 0 63 255 127 255 255 255 255 255 127 255 63 255 31 0 15 0 7 0 3 0 1 0))) (defcursor sc:box 8 8 (concat '(15 252 8 4 8 4 8 4 8 4 8 4 8 4 8 4 8 132 8 4 8 4 8 4 8 4 8 4 8 4 15 252))) (defcursor sc:hourglass 8 8 (concat "\177\376\100\002\040\014\032\070" "\017\360\007\340\003\300\001\200" "\001\200\002\100\005\040\010\020" "\021\210\043\304\107\342\177\376")) (defun sc:set-cursor (icon) "Change the Sun mouse cursor to ICON. If ICON is nil, switch to the system default cursor, Otherwise, ICON should be a vector or the name of a vector of [x y 32-chars]" (interactive "XIcon Name: ") (if (symbolp icon) (setq icon (symbol-value icon))) (sun-change-cursor-icon icon)) (make-local-variable '*edit-icon*) (make-variable-buffer-local 'icon-edit) (setq-default icon-edit nil) (or (assq 'icon-edit minor-mode-alist) (push '(icon-edit " IconEdit") minor-mode-alist)) (defun sc:edit-cursor (icon) "convert icon to rectangle, edit, and repack" (interactive "XIcon Name: ") (if (not icon) (setq icon (sc::menu-choose-cursor (selected-window) 1 1))) (if (symbolp icon) (setq icon (symbol-value icon))) (if (get-buffer "icon-edit") (kill-buffer "icon-edit")) (switch-to-buffer "icon-edit") (local-set-mouse '(text right) 'sc::menu-function) (local-set-mouse '(text left) '(sc::pic-ins-at-mouse 32)) (local-set-mouse '(text middle) '(sc::pic-ins-at-mouse 64)) (local-set-mouse '(text left middle) 'sc::hotspot) (sc::display-icon icon) (picture-mode) (setq icon-edit t) ; for mode line display ) (defun sc::pic-ins-at-mouse (char) "Picture insert char at mouse location" (mouse-move-point *mouse-window* (min 15 *mouse-x*) (min 15 *mouse-y*)) (move-to-column (1+ (min 15 (current-column))) t) (delete-char -1) (insert char) (sc::goto-hotspot)) (defun sc::menu-function (window x y) (sun-menu-evaluate window (1+ x) y sc::menu)) (defmenu sc::menu ("Cursor Menu") ("Pack & Use" sc::pack-buffer-to-cursor) ("Pack to Icon" sc::pack-buffer-to-icon (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) ("New Icon" call-interactively 'sc::make-cursor) ("Edit Icon" sc:edit-cursor (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) ("Set Cursor" sc:set-cursor (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) ("Reset Cursor" sc:set-cursor nil) ("Help". sc::edit-icon-help-menu) ("Quit" sc::quit-edit) ) (defun sc::quit-edit () (interactive) (bury-buffer (current-buffer)) (switch-to-buffer (other-buffer) 'no-record)) (defun sc::make-cursor (symbol) (interactive "SIcon Name: ") (eval (list 'defcursor symbol 0 0 "")) (sc::pack-buffer-to-icon (symbol-value symbol))) (defmenu sc::edit-icon-help-menu ("Simple Icon Editor") ("Left => CLEAR") ("Middle => SET") ("L & M => HOTSPOT") ("Right => MENU")) (defun sc::edit-icon-help () (message "Left=> CLEAR Middle=> SET Left+Middle=> HOTSPOT Right=> MENU")) (defun sc::pack-buffer-to-cursor () (sc::pack-buffer-to-icon *edit-icon*) (sc:set-cursor *edit-icon*)) (defun sc::menu-choose-cursor (window x y) "Presents a menu of cursor names, and returns one or nil" (let ((curs sc::cursors) (items)) (while curs (push (sc::menu-item-for-cursor (car curs)) items) (setq curs (cdr curs))) (push (list "Choose Cursor") items) (setq menu (menu-create items)) (sun-menu-evaluate window x y menu))) (defun sc::menu-item-for-cursor (cursor) "apply function to selected cursor" (list (symbol-name cursor) 'quote cursor)) (defun sc::hotspot (window x y) (aset *edit-icon* 0 x) (aset *edit-icon* 1 y) (sc::goto-hotspot)) (defun sc::goto-hotspot () (goto-line (1+ (aref *edit-icon* 1))) (move-to-column (aref *edit-icon* 0))) (defun sc::display-icon (icon) (setq *edit-icon* (copy-sequence icon)) (let ((string (aref *edit-icon* 2)) (index 0)) (while (< index 32) (let ((char (aref string index)) (bit 128)) (while (> bit 0) (insert (sc::char-at-bit char bit)) (setq bit (lsh bit -1)))) (if (eq 1 (% index 2)) (newline)) (setq index (1+ index)))) (sc::goto-hotspot)) (defun sc::char-at-bit (char bit) (if (> (logand char bit) 0) "@" " ")) (defun sc::pack-buffer-to-icon (icon) "Pack 16 x 16 field into icon string" (goto-char (point-min)) (aset icon 0 (aref *edit-icon* 0)) (aset icon 1 (aref *edit-icon* 1)) (aset icon 2 (mapconcat 'sc::pack-one-line "1234567890123456" "")) (sc::goto-hotspot) ) (defun sc::pack-one-line (dummy) (let* (char chr1 chr2) (setq char 0 chr1 (mapconcat 'sc::pack-one-char "12345678" "") chr1 char) (setq char 0 chr2 (mapconcat 'sc::pack-one-char "12345678" "") chr2 char) (forward-line 1) (concat (char-to-string chr1) (char-to-string chr2)) )) (defun sc::pack-one-char (dummy) "pack following char into char, unless eolp" (if (or (eolp) (char-equal (following-char) 32)) (setq char (lsh char 1)) (setq char (1+ (lsh char 1)))) (if (not (eolp))(forward-char))) (provide 'sm-cursors) ;;; sun-curs.el ends here emacs-19.30/lisp/sun-fns.el100444 12241 12 54537 5444575257 14405 0ustar rolandstaff;;; sun-fns.el --- subroutines of Mouse handling for Sun windows ;; Copyright (C) 1987 Free Software Foundation, Inc. ;; Author: Jeff Peck ;; Keywords: hardware ;; 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: ;;; Submitted Mar. 1987, Jeff Peck ;;; Sun Microsystems Inc. ;;; Conceived Nov. 1986, Stan Jefferson, ;;; Computer Science Lab, SRI International. ;;; GoodIdeas Feb. 1987, Steve Greenbaum ;;; & UpClicks Reasoning Systems, Inc. ;;; ;;; ;;; Functions for manipulating via the mouse and mouse-map definitions ;;; for accessing them. Also definitions of mouse menus. ;;; This file you should freely modify to reflect you personal tastes. ;;; ;;; First half of file defines functions to implement mouse commands, ;;; Don't delete any of those, just add what ever else you need. ;;; Second half of file defines mouse bindings, do whatever you want there. ;;; ;;; Mouse Functions. ;;; ;;; These functions follow the sun-mouse-handler convention of being called ;;; with three arguments: (window x-pos y-pos) ;;; This makes it easy for a mouse executed command to know where the mouse is. ;;; Use the macro "eval-in-window" to execute a function ;;; in a temporarily selected window. ;;; ;;; If you have a function that must be called with other arguments ;;; bind the mouse button to an s-exp that contains the necessary parameters. ;;; See "minibuffer" bindings for examples. ;;; ;;; Code: (require 'sun-mouse) (defconst cursor-pause-milliseconds 300 "*Number of milliseconds to display alternate cursor (usually the mark)") (defun indicate-region (&optional pause) "Bounce cursor to mark for cursor-pause-milliseconds and back again" (or pause (setq pause cursor-pause-milliseconds)) (let ((point (point))) (goto-char (mark)) (sit-for-millisecs pause) ;(update-display) ;(sleep-for-millisecs pause) (goto-char point))) ;;; ;;; Text buffer operations ;;; (defun mouse-move-point (window x y) "Move point to mouse cursor." (select-window window) (move-to-loc x y) (if (memq last-command ; support the mouse-copy/delete/yank '(mouse-copy mouse-delete mouse-yank-move)) (setq this-command 'mouse-yank-move)) ) (defun mouse-set-mark (window x y) "Set mark at mouse cursor." (eval-in-window window ;; use this to get the unwind protect (let ((point (point))) (move-to-loc x y) (set-mark (point)) (goto-char point) (indicate-region))) ) (defun mouse-set-mark-and-select (window x y) "Set mark at mouse cursor, and select that window." (select-window window) (mouse-set-mark window x y) ) (defun mouse-set-mark-and-stuff (w x y) "Set mark at mouse cursor, and put region in stuff buffer." (mouse-set-mark-and-select w x y) (sun-select-region (region-beginning) (region-end))) ;;; ;;; Simple mouse dragging stuff: marking with button up ;;; (defvar *mouse-drag-window* nil) (defvar *mouse-drag-x* -1) (defvar *mouse-drag-y* -1) (defun mouse-drag-move-point (window x y) "Move point to mouse cursor, and allow dragging." (mouse-move-point window x y) (setq *mouse-drag-window* window *mouse-drag-x* x *mouse-drag-y* y)) (defun mouse-drag-set-mark-stuff (window x y) "The up click handler that goes with mouse-drag-move-point. If mouse is in same WINDOW but at different X or Y than when mouse-drag-move-point was last executed, set the mark at mouse and put the region in the stuff buffer." (if (and (eq *mouse-drag-window* window) (not (and (equal *mouse-drag-x* x) (equal *mouse-drag-y* y)))) (mouse-set-mark-and-stuff window x y) (setq this-command last-command)) ; this was just an upclick no-op. ) (defun mouse-select-or-drag-move-point (window x y) "Select window if not selected, otherwise do mouse-drag-move-point." (if (eq (selected-window) window) (mouse-drag-move-point window x y) (mouse-select-window window x y))) ;;; ;;; esoterica: ;;; (defun mouse-exch-pt-and-mark (window x y) "Exchange point and mark." (select-window window) (exchange-point-and-mark) ) (defun mouse-call-kbd-macro (window x y) "Invokes last keyboard macro at mouse cursor." (mouse-move-point window x y) (call-last-kbd-macro) ) (defun mouse-mark-thing (window x y) "Set point and mark to text object using syntax table. The resulting region is put in the sun-window stuff buffer. Left or right Paren syntax marks an s-expression. Clicking at the end of a line marks the line including a trailing newline. If it doesn't recognize one of these it marks the character at point." (mouse-move-point window x y) (if (eobp) (open-line 1)) (let* ((char (char-after (point))) (syntax (char-syntax char))) (cond ((eq syntax ?w) ; word. (forward-word 1) (set-mark (point)) (forward-word -1)) ;; try to include a single following whitespace (is this a good idea?) ;; No, not a good idea since inconsistent. ;;(if (eq (char-syntax (char-after (mark))) ?\ ) ;; (set-mark (1+ (mark)))) ((eq syntax ?\( ) ; open paren. (mark-sexp 1)) ((eq syntax ?\) ) ; close paren. (forward-char 1) (mark-sexp -1) (exchange-point-and-mark)) ((eolp) ; mark line if at end. (set-mark (1+ (point))) (beginning-of-line 1)) (t ; mark character (set-mark (1+ (point))))) (indicate-region)) ; display region boundary. (sun-select-region (region-beginning) (region-end)) ) (defun mouse-kill-thing (window x y) "Kill thing at mouse, and put point there." (mouse-mark-thing window x y) (kill-region-and-unmark (region-beginning) (region-end)) ) (defun mouse-kill-thing-there (window x y) "Kill thing at mouse, leave point where it was. See mouse-mark-thing for a description of the objects recognized." (eval-in-window window (save-excursion (mouse-mark-thing window x y) (kill-region (region-beginning) (region-end)))) ) (defun mouse-save-thing (window x y &optional quiet) "Put thing at mouse in kill ring. See mouse-mark-thing for a description of the objects recognized." (mouse-mark-thing window x y) (copy-region-as-kill (region-beginning) (region-end)) (if (not quiet) (message "Thing saved")) ) (defun mouse-save-thing-there (window x y &optional quiet) "Put thing at mouse in kill ring, leave point as is. See mouse-mark-thing for a description of the objects recognized." (eval-in-window window (save-excursion (mouse-save-thing window x y quiet)))) ;;; ;;; Mouse yanking... ;;; (defun mouse-copy-thing (window x y) "Put thing at mouse in kill ring, yank to point. See mouse-mark-thing for a description of the objects recognized." (setq last-command 'not-kill) ;Avoids appending to previous kills. (mouse-save-thing-there window x y t) (yank) (setq this-command 'yank)) (defun mouse-move-thing (window x y) "Kill thing at mouse, yank it to point. See mouse-mark-thing for a description of the objects recognized." (setq last-command 'not-kill) ;Avoids appending to previous kills. (mouse-kill-thing-there window x y) (yank) (setq this-command 'yank)) (defun mouse-yank-at-point (&optional window x y) "Yank from kill-ring at point; then cycle thru kill ring." (if (eq last-command 'yank) (let ((before (< (point) (mark)))) (delete-region (point) (mark)) (insert (current-kill 1)) (if before (exchange-point-and-mark))) (yank)) (setq this-command 'yank)) (defun mouse-yank-at-mouse (window x y) "Yank from kill-ring at mouse; then cycle thru kill ring." (mouse-move-point window x y) (mouse-yank-at-point window x y)) (defun mouse-save/delete/yank (&optional window x y) "Context sensitive save/delete/yank. Consecutive clicks perform as follows: * first click saves region to kill ring, * second click kills region, * third click yanks from kill ring, * subsequent clicks cycle thru kill ring. If mouse-move-point is performed after the first or second click, the next click will do a yank, etc. Except for a possible mouse-move-point, this command is insensitive to mouse location." (cond ((memq last-command '(mouse-delete yank mouse-yank-move)) ; third+ click (mouse-yank-at-point)) ((eq last-command 'mouse-copy) ; second click (kill-region (region-beginning) (region-end)) (setq this-command 'mouse-delete)) (t ; first click (copy-region-as-kill (region-beginning) (region-end)) (message "Region saved") (setq this-command 'mouse-copy)) )) (defun mouse-split-horizontally (window x y) "Splits the window horizontally at mouse cursor." (eval-in-window window (split-window-horizontally (1+ x)))) (defun mouse-split-vertically (window x y) "Split the window vertically at the mouse cursor." (eval-in-window window (split-window-vertically (1+ y)))) (defun mouse-select-window (window x y) "Selects the window, restoring point." (select-window window)) (defun mouse-delete-other-windows (window x y) "Deletes all windows except the one mouse is in." (delete-other-windows window)) (defun mouse-delete-window (window x y) "Deletes the window mouse is in." (delete-window window)) (defun mouse-undo (window x y) "Invokes undo in the window mouse is in." (eval-in-window window (undo))) ;;; ;;; Scroll operations ;;; ;;; The move-to-window-line is used below because otherwise ;;; scrolling a non-selected process window with the mouse, after ;;; the process has written text past the bottom of the window, ;;; gives an "End of buffer" error, and then scrolls. The ;;; move-to-window-line seems to force recomputing where things are. (defun mouse-scroll-up (window x y) "Scrolls the window upward." (eval-in-window window (move-to-window-line 1) (scroll-up nil))) (defun mouse-scroll-down (window x y) "Scrolls the window downward." (eval-in-window window (scroll-down nil))) (defun mouse-scroll-proportional (window x y) "Scrolls the window proportionally corresponding to window relative X divided by window width." (eval-in-window window (if (>= x (1- (window-width))) ;; When x is maximun (equal to or 1 less than window width), ;; goto end of buffer. We check for this special case ;; because the calculated goto-char often goes short of the ;; end due to roundoff error, and we often really want to go ;; to the end. (goto-char (point-max)) (progn (goto-char (+ (point-min) ; For narrowed regions. (* x (/ (- (point-max) (point-min)) (1- (window-width)))))) (beginning-of-line)) ) (what-cursor-position) ; Report position. )) (defun mouse-line-to-top (window x y) "Scrolls the line at the mouse cursor up to the top." (eval-in-window window (scroll-up y))) (defun mouse-top-to-line (window x y) "Scrolls the top line down to the mouse cursor." (eval-in-window window (scroll-down y))) (defun mouse-line-to-bottom (window x y) "Scrolls the line at the mouse cursor to the bottom." (eval-in-window window (scroll-up (+ y (- 2 (window-height)))))) (defun mouse-bottom-to-line (window x y) "Scrolls the bottom line up to the mouse cursor." (eval-in-window window (scroll-down (+ y (- 2 (window-height)))))) (defun mouse-line-to-middle (window x y) "Scrolls the line at the mouse cursor to the middle." (eval-in-window window (scroll-up (- y -1 (/ (window-height) 2))))) (defun mouse-middle-to-line (window x y) "Scrolls the line at the middle to the mouse cursor." (eval-in-window window (scroll-up (- (/ (window-height) 2) y 1)))) ;;; ;;; main emacs menu. ;;; (defmenu expand-menu ("Vertically" mouse-expand-vertically *menu-window*) ("Horizontally" mouse-expand-horizontally *menu-window*)) (defmenu delete-window-menu ("This One" delete-window *menu-window*) ("All Others" delete-other-windows *menu-window*)) (defmenu mouse-help-menu ("Text Region" mouse-help-region *menu-window* *menu-x* *menu-y* 'text) ("Scrollbar" mouse-help-region *menu-window* *menu-x* *menu-y* 'scrollbar) ("Modeline" mouse-help-region *menu-window* *menu-x* *menu-y* 'modeline) ("Minibuffer" mouse-help-region *menu-window* *menu-x* *menu-y* 'minibuffer) ) (defmenu emacs-quit-menu ("Suspend" suspend-emacstool) ("Quit" save-buffers-kill-emacs)) (defmenu emacs-menu ("Emacs Menu") ("Stuff Selection" sun-yank-selection) ("Expand" . expand-menu) ("Delete Window" . delete-window-menu) ("Previous Buffer" mouse-select-previous-buffer *menu-window*) ("Save Buffers" save-some-buffers) ("List Directory" list-directory nil) ("Dired" dired nil) ("Mouse Help" . mouse-help-menu) ("Quit" . emacs-quit-menu)) (defun emacs-menu-eval (window x y) "Pop-up menu of editor commands." (sun-menu-evaluate window (1+ x) (1- y) 'emacs-menu)) (defun mouse-expand-horizontally (window) (eval-in-window window (enlarge-window 4 t) (update-display) ; Try to redisplay, since can get confused. )) (defun mouse-expand-vertically (window) (eval-in-window window (enlarge-window 4))) (defun mouse-select-previous-buffer (window) "Switch buffer in mouse window to most recently selected buffer." (eval-in-window window (switch-to-buffer (other-buffer)))) ;;; ;;; minibuffer menu ;;; (defmenu minibuffer-menu ("Minibuffer" message "Just some miscellaneous minibuffer commands") ("Stuff" sun-yank-selection) ("Do-It" exit-minibuffer) ("Abort" abort-recursive-edit) ("Suspend" suspend-emacs)) (defun minibuffer-menu-eval (window x y) "Pop-up menu of commands." (sun-menu-evaluate window x (1- y) 'minibuffer-menu)) (defun mini-move-point (window x y) ;; -6 is good for most common cases (mouse-move-point window (- x 6) 0)) (defun mini-set-mark-and-stuff (window x y) ;; -6 is good for most common cases (mouse-set-mark-and-stuff window (- x 6) 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Buffer-mode Mouse commands ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun Buffer-at-mouse (w x y) "Calls Buffer-menu-buffer from mouse click." (save-window-excursion (mouse-move-point w x y) (beginning-of-line) (Buffer-menu-buffer t))) (defun mouse-buffer-bury (w x y) "Bury the indicated buffer." (bury-buffer (Buffer-at-mouse w x y)) ) (defun mouse-buffer-select (w x y) "Put the indicated buffer in selected window." (switch-to-buffer (Buffer-at-mouse w x y)) (list-buffers) ) (defun mouse-buffer-delete (w x y) "mark indicated buffer for delete" (save-window-excursion (mouse-move-point w x y) (Buffer-menu-delete) )) (defun mouse-buffer-execute (w x y) "execute buffer-menu selections" (save-window-excursion (mouse-move-point w x y) (Buffer-menu-execute) )) (defun enable-mouse-in-buffer-list () "Call this to enable mouse selections in *Buffer List* LEFT puts the indicated buffer in the selected window. MIDDLE buries the indicated buffer. RIGHT marks the indicated buffer for deletion. MIDDLE-RIGHT deletes the marked buffers. To unmark a buffer marked for deletion, select it with LEFT." (save-window-excursion (list-buffers) ; Initialize *Buffer List* (set-buffer "*Buffer List*") (local-set-mouse '(text middle) 'mouse-buffer-bury) (local-set-mouse '(text left) 'mouse-buffer-select) (local-set-mouse '(text right) 'mouse-buffer-delete) (local-set-mouse '(text middle right) 'mouse-buffer-execute) ) ) ;;;******************************************************************* ;;; ;;; Global Mouse Bindings. ;;; ;;; There is some sense to this mouse binding madness: ;;; LEFT and RIGHT scrolls are inverses. ;;; SHIFT makes an opposite meaning in the scroll bar. ;;; SHIFT is an alternative to DOUBLE (but double chords do not exist). ;;; META makes the scrollbar functions work in the text region. ;;; MIDDLE operates the mark ;;; LEFT operates at point ;;; META commands are generally non-destructive, ;;; SHIFT is a little more dangerous. ;;; CONTROL is for the really complicated ones. ;;; CONTROL-META-SHIFT-RIGHT gives help on that region. ;;; ;;; Text Region mousemap ;;; ;; The basics: Point, Mark, Menu, Sun-Select: (global-set-mouse '(text left) 'mouse-drag-move-point) (global-set-mouse '(text up left) 'mouse-drag-set-mark-stuff) (global-set-mouse '(text shift left) 'mouse-exch-pt-and-mark) (global-set-mouse '(text double left) 'mouse-exch-pt-and-mark) (global-set-mouse '(text middle) 'mouse-set-mark-and-stuff) (global-set-mouse '(text right) 'emacs-menu-eval) (global-set-mouse '(text shift right) '(sun-yank-selection)) (global-set-mouse '(text double right) '(sun-yank-selection)) ;; The Slymoblics multi-command for Save, Kill, Copy, Move: (global-set-mouse '(text shift middle) 'mouse-save/delete/yank) (global-set-mouse '(text double middle) 'mouse-save/delete/yank) ;; Save, Kill, Copy, Move Things: ;; control-left composes with control middle/right to produce copy/move (global-set-mouse '(text control middle ) 'mouse-save-thing-there) (global-set-mouse '(text control right ) 'mouse-kill-thing-there) (global-set-mouse '(text control left) 'mouse-yank-at-point) (global-set-mouse '(text control middle left) 'mouse-copy-thing) (global-set-mouse '(text control right left) 'mouse-move-thing) (global-set-mouse '(text control right middle) 'mouse-mark-thing) ;; The Universal mouse help command (press all buttons): (global-set-mouse '(text shift control meta right) 'mouse-help-region) (global-set-mouse '(text double control meta right) 'mouse-help-region) ;;; Meta in Text Region is like meta version in scrollbar: (global-set-mouse '(text meta left) 'mouse-line-to-top) (global-set-mouse '(text meta shift left) 'mouse-line-to-bottom) (global-set-mouse '(text meta double left) 'mouse-line-to-bottom) (global-set-mouse '(text meta middle) 'mouse-line-to-middle) (global-set-mouse '(text meta shift middle) 'mouse-middle-to-line) (global-set-mouse '(text meta double middle) 'mouse-middle-to-line) (global-set-mouse '(text meta control middle) 'mouse-split-vertically) (global-set-mouse '(text meta right) 'mouse-top-to-line) (global-set-mouse '(text meta shift right) 'mouse-bottom-to-line) (global-set-mouse '(text meta double right) 'mouse-bottom-to-line) ;; Miscellaneous: (global-set-mouse '(text meta control left) 'mouse-call-kbd-macro) (global-set-mouse '(text meta control right) 'mouse-undo) ;;; ;;; Scrollbar mousemap. ;;; Are available in the Scrollbar Region, or with Meta Text (or Meta Scrollbar) ;;; (global-set-mouse '(scrollbar left) 'mouse-line-to-top) (global-set-mouse '(scrollbar shift left) 'mouse-line-to-bottom) (global-set-mouse '(scrollbar double left) 'mouse-line-to-bottom) (global-set-mouse '(scrollbar middle) 'mouse-line-to-middle) (global-set-mouse '(scrollbar shift middle) 'mouse-middle-to-line) (global-set-mouse '(scrollbar double middle) 'mouse-middle-to-line) (global-set-mouse '(scrollbar control middle) 'mouse-split-vertically) (global-set-mouse '(scrollbar right) 'mouse-top-to-line) (global-set-mouse '(scrollbar shift right) 'mouse-bottom-to-line) (global-set-mouse '(scrollbar double right) 'mouse-bottom-to-line) (global-set-mouse '(scrollbar meta left) 'mouse-line-to-top) (global-set-mouse '(scrollbar meta shift left) 'mouse-line-to-bottom) (global-set-mouse '(scrollbar meta double left) 'mouse-line-to-bottom) (global-set-mouse '(scrollbar meta middle) 'mouse-line-to-middle) (global-set-mouse '(scrollbar meta shift middle) 'mouse-middle-to-line) (global-set-mouse '(scrollbar meta double middle) 'mouse-middle-to-line) (global-set-mouse '(scrollbar meta control middle) 'mouse-split-vertically) (global-set-mouse '(scrollbar meta right) 'mouse-top-to-line) (global-set-mouse '(scrollbar meta shift right) 'mouse-bottom-to-line) (global-set-mouse '(scrollbar meta double right) 'mouse-bottom-to-line) ;; And the help menu: (global-set-mouse '(scrollbar shift control meta right) 'mouse-help-region) (global-set-mouse '(scrollbar double control meta right) 'mouse-help-region) ;;; ;;; Modeline mousemap. ;;; ;;; Note: meta of any single button selects window. (global-set-mouse '(modeline left) 'mouse-scroll-up) (global-set-mouse '(modeline meta left) 'mouse-select-window) (global-set-mouse '(modeline middle) 'mouse-scroll-proportional) (global-set-mouse '(modeline meta middle) 'mouse-select-window) (global-set-mouse '(modeline control middle) 'mouse-split-horizontally) (global-set-mouse '(modeline right) 'mouse-scroll-down) (global-set-mouse '(modeline meta right) 'mouse-select-window) ;;; control-left selects this window, control-right deletes it. (global-set-mouse '(modeline control left) 'mouse-delete-other-windows) (global-set-mouse '(modeline control right) 'mouse-delete-window) ;; in case of confusion, just select it: (global-set-mouse '(modeline control left right)'mouse-select-window) ;; even without confusion (and without the keyboard) select it: (global-set-mouse '(modeline left right) 'mouse-select-window) ;; And the help menu: (global-set-mouse '(modeline shift control meta right) 'mouse-help-region) (global-set-mouse '(modeline double control meta right) 'mouse-help-region) ;;; ;;; Minibuffer Mousemap ;;; Demonstrating some variety: ;;; (global-set-mouse '(minibuffer left) 'mini-move-point) (global-set-mouse '(minibuffer middle) 'mini-set-mark-and-stuff) (global-set-mouse '(minibuffer shift middle) '(select-previous-complex-command)) (global-set-mouse '(minibuffer double middle) '(select-previous-complex-command)) (global-set-mouse '(minibuffer control middle) '(next-complex-command 1)) (global-set-mouse '(minibuffer meta middle) '(previous-complex-command 1)) (global-set-mouse '(minibuffer right) 'minibuffer-menu-eval) (global-set-mouse '(minibuffer shift control meta right) 'mouse-help-region) (global-set-mouse '(minibuffer double control meta right) 'mouse-help-region) (provide 'sun-fns) ;;; sun-fns.el ends here emacs-19.30/lisp/supercite.el100444 12120 1 212742 6014111453 14437 0ustar rmsdaemon;;; supercite.el --- minor mode for citing mail and news replies ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. ;; Maintainer: supercite-help@anthem.nlm.nih.gov ;; Created: February 1993 ;; Version: 3.1 ;; Last Modified: 1993/09/22 18:58:46 ;; Keywords: mail, news ;; supercite.el revision: 3.54 ;; 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. ;; LCD Archive Entry ;; supercite|Barry A. Warsaw|supercite-help@anthem.nlm.nih.gov ;; |Mail and news reply citation package ;; |1993/09/22 18:58:46|3.1| ;; Code: (require 'regi) ;; start user configuration variables ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv (defvar sc-auto-fill-region-p t "*If non-nil, automatically fill each paragraph after it has been cited.") (defvar sc-blank-lines-after-headers 1 "*Number of blank lines to leave after mail headers have been nuked. Set to nil, to use whatever blank lines happen to occur naturally.") (defvar sc-citation-leader " " "*String comprising first part of a citation.") (defvar sc-citation-delimiter ">" "*String comprising third part of a citation. This string is used in both nested and non-nested citations.") (defvar sc-citation-separator " " "*String comprising fourth and last part of a citation.") (defvar sc-citation-leader-regexp "[ \t]*" "*Regexp describing citation leader for a cited line. This should NOT have a leading `^' character.") ;; Nemacs and Mule users note: please see the texinfo manual for ;; suggestions on setting these variables. (defvar sc-citation-root-regexp "[-._a-zA-Z0-9]*" "*Regexp describing variable root part of a citation for a cited line. This should NOT have a leading `^' character. See also `sc-citation-nonnested-root-regexp'.") (defvar sc-citation-nonnested-root-regexp "[-._a-zA-Z0-9]+" "*Regexp describing the variable root part of a nested citation. This should NOT have a leading `^' character. This variable is related to `sc-citation-root-regexp' but where as that varariable describes both nested and non-nested citation roots, this variable describes only nested citation roots.") (defvar sc-citation-delimiter-regexp "[>]+" "*Regexp describing citation delimiter for a cited line. This should NOT have a leading `^' character.") (defvar sc-citation-separator-regexp "[ \t]*" "*Regexp describing citation separator for a cited line. This should NOT have a leading `^' character.") (defvar sc-cite-blank-lines-p nil "*If non-nil, put a citation on blank lines.") (defvar sc-cite-frame-alist '() "*Alist for frame selection during citing. Each element of this list has the following form: (INFOKEY ((REGEXP . FRAME) (REGEXP . FRAME) (...))) Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular expression to match against the INFOKEY's value. FRAME is a citation frame, or a variable containing a citation frame.") (defvar sc-uncite-frame-alist '() "*Alist for frame selection during unciting. See the variable `sc-cite-frame-alist' for details.") (defvar sc-recite-frame-alist '() "*Alist for frame selection during reciting. See the variable `sc-cite-frame-alist' for details.") (defvar sc-default-cite-frame '(;; initialize fill state and temporary variables when entering ;; frame. this makes things run much faster (begin (progn (sc-fill-if-different) (setq sc-tmp-nested-regexp (sc-cite-regexp "") sc-tmp-nonnested-regexp (sc-cite-regexp) sc-tmp-dumb-regexp (concat "\\(" (sc-cite-regexp "") "\\)" (sc-cite-regexp sc-citation-nonnested-root-regexp)) ))) ;; blank lines mean paragraph separators, so fill the last cited ;; paragraph, unless sc-cite-blank-lines-p is non-nil, in which ;; case we treat blank lines just like any other line. ("^[ \t]*$" (if sc-cite-blank-lines-p (sc-cite-line) (sc-fill-if-different ""))) ;; do nothing if looking at a reference tag. make sure that the ;; tag string isn't the empty string since this will match every ;; line. it cannot be nil. (sc-reference-tag-string (if (string= sc-reference-tag-string "") (list 'continue) nil)) ;; this regexp catches nested citations in which the author cited ;; a non-nested citation with a dumb citer. (sc-tmp-dumb-regexp (sc-cite-coerce-dumb-citer)) ;; if we are looking at a nested citation then add a citation level (sc-tmp-nested-regexp (sc-add-citation-level)) ;; if we're looking at a non-nested citation, coerce it to our style (sc-tmp-nonnested-regexp (sc-cite-coerce-cited-line)) ;; we must be looking at an uncited line. if we are in nested ;; citations, just add a citation level (sc-nested-citation-p (sc-add-citation-level)) ;; we're looking at an uncited line and we are in non-nested ;; citations, so cite it with a non-nested citation (t (sc-cite-line)) ;; be sure when we're done that we fill the last cited paragraph. (end (sc-fill-if-different "")) ) "*Default REGI frame for citing a region.") (defvar sc-default-uncite-frame '(;; do nothing on a blank line ("^[ \t]*$" nil) ;; if the line is cited, uncite it ((sc-cite-regexp) (sc-uncite-line)) ) "*Default REGI frame for unciting a region.") (defvar sc-default-recite-frame '(;; initialize fill state when entering frame (begin (sc-fill-if-different)) ;; do nothing on a blank line ("^[ \t]*$" nil) ;; if we're looking at a cited line, recite it ((sc-cite-regexp) (sc-recite-line (sc-cite-regexp))) ;; otherwise, the line is uncited, so just cite it (t (sc-cite-line)) ;; be sure when we're done that we fill the last cited paragraph. (end (sc-fill-if-different "")) ) "*Default REGI frame for reciting a region.") (defvar sc-cite-region-limit t "*This variable controls automatic citation of yanked text. Legal values are: non-nil -- cite the entire region, regardless of its size nil -- do not cite the region at all -- a number indicating the threshold for citation. When the number of lines in the region is greater than this value, a warning message will be printed and the region will not be cited. Lines in region are counted with `count-lines'. The gathering of attribution information is not affected by the value of this variable. The number of lines in the region is calculated *after* all mail headers are removed. This variable is only consulted during the initial citing via `sc-cite-original'.") (defvar sc-confirm-always-p t "*If non-nil, always confirm attribution string before citing text body.") (defvar sc-default-attribution "Anon" "*String used when author's attribution cannot be determined.") (defvar sc-default-author-name "Anonymous" "*String used when author's name cannot be determined.") (defvar sc-downcase-p nil "*Non-nil means downcase the attribution and citation strings.") (defvar sc-electric-circular-p t "*If non-nil, treat electric references as circular.") (defvar sc-electric-mode-hook nil "*Hook for `sc-electric-mode' electric references mode.") (defvar sc-electric-references-p nil "*Use electric references if non-nil.") (defvar sc-fixup-whitespace-p nil "*If non-nil, delete all leading white space before citing.") (defvar sc-load-hook nil "*Hook which gets run once after Supercite loads.") (defvar sc-pre-hook nil "*Hook which gets run before each invocation of `sc-cite-original'.") (defvar sc-post-hook nil "*Hook which gets run after each invocation of `sc-cite-original'.") (defvar sc-mail-warn-if-non-rfc822-p t "*Warn if mail headers don't conform to RFC822.") (defvar sc-mumble "" "*Value returned by `sc-mail-field' if field isn't in mail headers.") (defvar sc-name-filter-alist '(("^\\(Mr\\|Mrs\\|Ms\\|Dr\\)[.]?$" . 0) ("^\\(Jr\\|Sr\\)[.]?$" . last) ("^ASTS$" . 0) ("^[I]+$" . last)) "*Name list components which are filtered out as noise. This variable contains an association list where each element is of the form: (REGEXP . POSITION). REGEXP is a regular expression which matches the name list component. Match is performed using `string-match'. POSITION is the position in the name list which can match the regular expression, starting at zero for the first element. Use `last' to match the last element in the list and `any' to match all elements.") (defvar sc-nested-citation-p nil "*Controls whether to use nested or non-nested citation style. Non-nil uses nested citations, nil uses non-nested citations.") (defvar sc-nuke-mail-headers 'all "*Controls mail header nuking. Used in conjunction with `sc-nuke-mail-header-list'. Legal values are: `all' -- nuke all mail headers `none' -- don't nuke any mail headers `specified' -- nuke headers specified in `sc-nuke-mail-header-list' `keep' -- keep headers specified in `sc-nuke-mail-header-list'") (defvar sc-nuke-mail-header-list nil "*List of mail header regexps to remove or keep in body of reply. This list contains regular expressions describing the mail headers to keep or nuke, depending on the value of `sc-nuke-mail-headers'.") (defvar sc-preferred-attribution-list '("sc-lastchoice" "x-attribution" "firstname" "initials" "lastname") "*Specifies what to use as the attribution string. Supercite creates a list of possible attributions when it scans the mail headers from the original message. Each attribution choice is associated with a key in an attribution alist. Supercite tries to pick a \"preferred\" attribution by matching the attribution alist keys against the elements in `sc-preferred-attribution-list' in order. The first non-empty string value found is used as the preferred attribution. Note that Supercite now honors the X-Attribution: mail field. If present in the original message, the value of this field should always be used to select the most preferred attribution since it reflects how the original author would like to be distinguished. It should be considered bad taste to put any attribution preference key before \"x-attribution\" in this list, except perhaps for \"sc-lastchoice\" \(see below). Supercite remembers the last attribution used when reciting an already cited paragraph. This attribution will always be saved with the \"sc-lastchoice\" key, which can be used in this list. Note that the last choice is always reset after every call of `sc-cite-original'. Barring error conditions, the following preferences are always present in the attribution alist: \"emailname\" -- email terminus name \"initials\" -- initials of author \"firstname\" -- first name of author \"lastname\" -- last name of author \"middlename-1\" -- first middle name of author \"middlename-2\" -- second middle name of author ... Middle name indexes can be any positive integer greater than 0, although it is unlikely that many authors will supply more than one middle name, if that many. The string of all middle names is associated with the key \"middlenames\".") (defvar sc-attrib-selection-list nil "*An alist for selecting preferred attribution based on mail headers. Each element of this list has the following form: (INFOKEY ((REGEXP . ATTRIBUTION) (REGEXP . ATTRIBUTION) (...))) Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular expression to match against the INFOKEY's value. ATTRIBUTION can be a string or a list. If its a string, then it is the attribution that is selected by `sc-select-attribution'. If it is a list, it is `eval'd and the return value must be a string, which is used as the selected attribution. Note that the variable `sc-preferred-attribution-list' must contain an element of the string \"sc-consult\" for this variable to be consulted during attribution selection.") (defvar sc-attribs-preselect-hook nil "*Hook to run before selecting an attribution.") (defvar sc-attribs-postselect-hook nil "*Hook to run after selecting an attribution, but before confirmation.") (defvar sc-pre-cite-hook nil "*Hook to run before citing a region of text.") (defvar sc-pre-uncite-hook nil "*Hook to run before unciting a region of text.") (defvar sc-pre-recite-hook nil "*Hook to run before reciting a region of text.") (defvar sc-preferred-header-style 4 "*Index into `sc-rewrite-header-list' specifying preferred header style. Index zero accesses the first function in the list.") (defvar sc-reference-tag-string ">>>>> " "*String used at the beginning of built-in reference headers.") (defvar sc-rewrite-header-list '((sc-no-header) (sc-header-on-said) (sc-header-inarticle-writes) (sc-header-regarding-adds) (sc-header-attributed-writes) (sc-header-author-writes) (sc-header-verbose) (sc-no-blank-line-or-header) ) "*List of reference header rewrite functions. The variable `sc-preferred-header-style' controls which function in this list is chosen for automatic reference header insertions. Electric reference mode will cycle through this list of functions.") (defvar sc-titlecue-regexp "\\s +-+\\s +" "*Regular expression describing the separator between names and titles. Set to nil to treat entire field as a name.") (defvar sc-use-only-preference-p nil "*Controls what happens when the preferred attribution cannot be found. If non-nil, then `sc-default-attribution' will be used. If nil, then some secondary scheme will be employed to find a suitable attribution string.") ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; end user configuration variables (defconst sc-version "3.1" "Supercite version number.") (defconst sc-help-address "supercite-help@anthem.nlm.nih.gov" "Address accepting submissions of bug reports.") (defvar sc-mail-info nil "Alist of mail header information gleaned from reply buffer.") (defvar sc-attributions nil "Alist of attributions for use when citing.") (defconst sc-emacs-features (let ((version 'v18) (flavor 'GNU)) (if (string= (substring emacs-version 0 2) "19") (setq version 'v19)) (if (string-match "Lucid" emacs-version) (setq flavor 'Lucid)) ;; cobble up list (list version flavor)) "A list describing what version of Emacs we're running on. Known flavors are: All GNU18's: (v18 GNU) FSF19.x : (v19 GNU) Lucid19.x : (v19 Lucid)") (defvar sc-tmp-nested-regexp nil "Temporary regepx describing nested citations.") (defvar sc-tmp-nonnested-regexp nil "Temporary regexp describing non-nested citations.") (defvar sc-tmp-dumb-regexp nil "Temp regexp describing non-nested citation cited with a nesting citer.") (defvar sc-minor-mode nil "Supercite minor mode on flag.") (defvar sc-mode-string " SC" "Supercite minor mode string.") (make-variable-buffer-local 'sc-mail-info) (make-variable-buffer-local 'sc-attributions) (make-variable-buffer-local 'sc-minor-mode) ;; ====================================================================== ;; supercite keymaps (defvar sc-mode-map-prefix "\C-c\C-p" "*Key binding to install Supercite keymap. If this is nil, Supercite keymap is not installed.") (defvar sc-T-keymap () "Keymap for sub-keymap of setting and toggling functions.") (if sc-T-keymap () (setq sc-T-keymap (make-sparse-keymap)) (define-key sc-T-keymap "a" 'sc-S-preferred-attribution-list) (define-key sc-T-keymap "b" 'sc-T-mail-nuke-blank-lines) (define-key sc-T-keymap "c" 'sc-T-confirm-always) (define-key sc-T-keymap "d" 'sc-T-downcase) (define-key sc-T-keymap "e" 'sc-T-electric-references) (define-key sc-T-keymap "f" 'sc-T-auto-fill-region) (define-key sc-T-keymap "h" 'sc-T-describe) (define-key sc-T-keymap "l" 'sc-S-cite-region-limit) (define-key sc-T-keymap "n" 'sc-S-mail-nuke-mail-headers) (define-key sc-T-keymap "N" 'sc-S-mail-header-nuke-list) (define-key sc-T-keymap "o" 'sc-T-electric-circular) (define-key sc-T-keymap "p" 'sc-S-preferred-header-style) (define-key sc-T-keymap "s" 'sc-T-nested-citation) (define-key sc-T-keymap "u" 'sc-T-use-only-preferences) (define-key sc-T-keymap "w" 'sc-T-fixup-whitespace) (define-key sc-T-keymap "?" 'sc-T-describe) ) (defvar sc-mode-map () "Keymap for Supercite quasi-mode.") (if sc-mode-map () (setq sc-mode-map (make-sparse-keymap)) (define-key sc-mode-map "c" 'sc-cite-region) (define-key sc-mode-map "f" 'sc-mail-field-query) (define-key sc-mode-map "g" 'sc-mail-process-headers) (define-key sc-mode-map "h" 'sc-describe) (define-key sc-mode-map "i" 'sc-insert-citation) (define-key sc-mode-map "o" 'sc-open-line) (define-key sc-mode-map "r" 'sc-recite-region) (define-key sc-mode-map "\C-p" 'sc-raw-mode-toggle) (define-key sc-mode-map "u" 'sc-uncite-region) (define-key sc-mode-map "v" 'sc-version) (define-key sc-mode-map "w" 'sc-insert-reference) (define-key sc-mode-map "\C-t" sc-T-keymap) (define-key sc-mode-map "\C-b" 'sc-submit-bug-report) (define-key sc-mode-map "?" 'sc-describe) ) (defvar sc-electric-mode-map () "Keymap for `sc-electric-mode' electric references mode.") (if sc-electric-mode-map nil (setq sc-electric-mode-map (make-sparse-keymap)) (define-key sc-electric-mode-map "p" 'sc-eref-prev) (define-key sc-electric-mode-map "n" 'sc-eref-next) (define-key sc-electric-mode-map "s" 'sc-eref-setn) (define-key sc-electric-mode-map "j" 'sc-eref-jump) (define-key sc-electric-mode-map "x" 'sc-eref-abort) (define-key sc-electric-mode-map "q" 'sc-eref-abort) (define-key sc-electric-mode-map "\r" 'sc-eref-exit) (define-key sc-electric-mode-map "\n" 'sc-eref-exit) (define-key sc-electric-mode-map "g" 'sc-eref-goto) (define-key sc-electric-mode-map "?" 'describe-mode) (define-key sc-electric-mode-map "\C-h" 'describe-mode) (define-key sc-electric-mode-map [f1] 'describe-mode) (define-key sc-electric-mode-map [help] 'describe-mode) ) (defvar sc-minibuffer-local-completion-map nil "Keymap for minibuffer confirmation of attribution strings.") (if sc-minibuffer-local-completion-map () (setq sc-minibuffer-local-completion-map (copy-keymap minibuffer-local-completion-map)) (define-key sc-minibuffer-local-completion-map "\C-t" 'sc-toggle-fn) (define-key sc-minibuffer-local-completion-map " " 'self-insert-command)) (defvar sc-minibuffer-local-map nil "Keymap for minibuffer confirmation of attribution strings.") (if sc-minibuffer-local-map () (setq sc-minibuffer-local-map (copy-keymap minibuffer-local-map)) (define-key sc-minibuffer-local-map "\C-t" 'sc-toggle-fn)) ;; ====================================================================== ;; utility functions (defun sc-completing-read (prompt table &optional predicate require-match initial-contents history) "Compatibility between Emacs 18 and 19 `completing-read'. In version 18, the HISTORY argument is ignored." (if (memq 'v19 sc-emacs-features) (funcall 'completing-read prompt table predicate require-match initial-contents history) (funcall 'completing-read prompt table predicate require-match (or (car-safe initial-contents) initial-contents)))) (defun sc-read-string (prompt &optional initial-contents history) "Compatibility between Emacs 18 and 19 `read-string'. In version 18, the HISTORY argument is ignored." (if (memq 'v19 sc-emacs-features) ;; maybe future versions will take a `history' argument: (read-string prompt initial-contents) (read-string prompt initial-contents))) (if (fboundp 'match-string) (defalias 'sc-submatch 'match-string) (defun sc-submatch (matchnum &optional string) "Returns `match-beginning' and `match-end' sub-expression for MATCHNUM. If optional STRING is provided, take sub-expression using `substring' of argument, otherwise use `buffer-substring' on current buffer. Note that `match-data' must have already been generated and no error checking is performed by this function." (if string (substring string (match-beginning matchnum) (match-end matchnum)) (buffer-substring (match-beginning matchnum) (match-end matchnum))))) (if (fboundp 'member) (defalias 'sc-member 'member) (defun sc-member (elt list) "Like `memq', but uses `equal' instead of `eq'. Emacs19 has a builtin function `member' which does exactly this." (catch 'elt-is-member (while list (if (equal elt (car list)) (throw 'elt-is-member list)) (setq list (cdr list)))))) ;; One day maybe Emacs will have this... (if (fboundp 'string-text) (defalias 'sc-string-text 'string-text) (defun sc-string-text (string) "Return STRING with all text properties removed." (let ((string (copy-sequence string))) (set-text-properties 0 (length string) nil string) string))) (defun sc-ask (alist) "Ask a question in the minibuffer requiring a single character answer. This function is kind of an extension of `y-or-n-p' where a single letter is used to answer a question. Question is formed from ALIST which has members of the form: (WORD . LETTER). WORD is the long word form, while LETTER is the letter for selecting that answer. The selected letter is returned, or nil if the question was not answered. Note that WORD is a string and LETTER is a character. All LETTERs in the list should be unique." (let* ((prompt (concat (mapconcat (function (lambda (elt) (car elt))) alist ", ") "? (" (mapconcat (function (lambda (elt) (char-to-string (cdr elt)))) alist "/") ") ")) (p prompt) (event (if (memq 'Lucid sc-emacs-features) (allocate-event) nil))) (while (stringp p) (if (let ((cursor-in-echo-area t) (inhibit-quit t)) (message "%s" p) ;; lets be good neighbors and be compatible with all emacsen (cond ((memq 'v18 sc-emacs-features) (setq event (read-char))) ((memq 'Lucid sc-emacs-features) (next-command-event event)) (t ; must be FSF19 (setq event (read-event)))) (prog1 quit-flag (setq quit-flag nil))) (progn (message "%s%s" p (single-key-description event)) (and (memq 'Lucid sc-emacs-features) (deallocate-event event)) (setq quit-flag nil) (signal 'quit '()))) (let ((char (if (memq 'Lucid sc-emacs-features) (let* ((key (and (key-press-event-p event) (event-key event))) (char (and key (event-to-character event)))) char) event)) elt) (if char (setq char (downcase char))) (cond ((setq elt (rassq char alist)) (message "%s%s" p (car elt)) (setq p (cdr elt))) ((and (memq 'Lucid sc-emacs-features) (button-release-event-p event)) ; ignore them nil) (t (message "%s%s" p (single-key-description event)) (if (memq 'Lucid sc-emacs-features) (ding nil 'y-or-n-p) (ding)) (discard-input) (if (eq p prompt) (setq p (concat "Try again. " prompt))))))) (and (memq 'Lucid sc-emacs-features) (deallocate-event event)) p)) (defun sc-scan-info-alist (alist) "Find a match in the info alist that matches a regexp in ALIST." (let ((sc-mumble "") rtnvalue) (while alist (let* ((elem (car alist)) (infokey (car elem)) (infoval (sc-mail-field infokey)) (mlist (car (cdr elem)))) (while mlist (let* ((ml-elem (car mlist)) (regexp (car ml-elem)) (thing (cdr ml-elem))) (if (string-match regexp infoval) ;; we found a match, time to return (setq rtnvalue thing mlist nil alist nil) ;; else we didn't find a match (setq mlist (cdr mlist)) ))) ;end of mlist loop (setq alist (cdr alist)) )) ;end of alist loop rtnvalue)) ;; ====================================================================== ;; extract mail field information from headers in reply buffer ;; holder variables for bc happiness (defvar sc-mail-headers-start nil "Start of header fields.") (defvar sc-mail-headers-end nil "End of header fields.") (defvar sc-mail-field-history nil "For minibuffer completion on mail field queries.") (defvar sc-mail-field-modification-history nil "For minibuffer completion on mail field modifications.") (defvar sc-mail-glom-frame '((begin (setq sc-mail-headers-start (point))) ("^x-attribution:[ \t]+.*$" (sc-mail-fetch-field t) nil t) ("^\\S +:.*$" (sc-mail-fetch-field) nil t) ("^$" (list 'abort '(step . 0))) ("^[ \t]+" (sc-mail-append-field)) (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field)) (end (setq sc-mail-headers-end (point)))) "Regi frame for glomming mail header information.") ;; regi functions (defun sc-mail-fetch-field (&optional attribs-p) "Insert a key and value into `sc-mail-info' alist. If optional ATTRIBS-P is non-nil, the key/value pair is placed in `sc-attributions' too." (if (string-match "^\\(\\S *\\)\\s *:\\s +\\(.*\\)$" curline) (let* ((key (downcase (sc-string-text (sc-submatch 1 curline)))) (val (sc-string-text (sc-submatch 2 curline))) (keyval (cons key val))) (setq sc-mail-info (cons keyval sc-mail-info)) (if attribs-p (setq sc-attributions (cons keyval sc-attributions))) )) nil) (defun sc-mail-append-field () "Append a continuation line onto the last fetched mail field's info." (let ((keyval (car sc-mail-info))) (if (and keyval (string-match "^\\s *\\(.*\\)$" curline)) (setcdr keyval (concat (cdr keyval) " " (sc-string-text (sc-submatch 1 curline)))))) nil) (defun sc-mail-error-in-mail-field () "Issue warning that mail headers don't conform to RFC 822." (let* ((len (min (length curline) 10)) (ellipsis (if (< len (length curline)) "..." "")) (msg "Mail header \"%s%s\" doesn't conform to RFC 822. skipping...")) (message msg (substring curline 0 len) ellipsis)) (beep) (sit-for 2) nil) ;; mail header nuking (defvar sc-mail-last-header-nuked-p nil "True if the last header was nuked.") (defun sc-mail-nuke-line () "Nuke the current mail header line." (delete-region (regi-pos 'bol) (regi-pos 'bonl)) '((step . -1))) (defun sc-mail-nuke-header-line () "Delete current-line and set up for possible continuation." (setq sc-mail-last-header-nuked-p t) (sc-mail-nuke-line)) (defun sc-mail-nuke-continuation-line () "Delete a continuation line if the last header line was deleted." (if sc-mail-last-header-nuked-p (sc-mail-nuke-line))) (defun sc-mail-cleanup-blank-lines () "Leave some blank lines after original mail headers are nuked. The number of lines left is specified by `sc-blank-lines-after-headers'." (if sc-blank-lines-after-headers (save-restriction (widen) (skip-chars-backward " \t\n") (forward-line 1) (delete-blank-lines) (beginning-of-line) (if (looking-at "[ \t]*$") (delete-region (regi-pos 'bol) (regi-pos 'bonl))) (insert-char ?\n sc-blank-lines-after-headers))) nil) (defun sc-mail-build-nuke-frame () "Build the regiframe for nuking mail headers." (let (every-func entry-func nonentry-func) (cond ((eq sc-nuke-mail-headers 'all) (setq every-func '(progn (forward-line -1) (sc-mail-nuke-line)))) ((eq sc-nuke-mail-headers 'specified) (setq entry-func '(sc-mail-nuke-header-line) nonentry-func '(setq sc-mail-last-header-nuked-p nil))) ((eq sc-nuke-mail-headers 'keep) (setq entry-func '(setq sc-mail-last-header-nuked-p nil) nonentry-func '(sc-mail-nuke-header-line))) ;; we never get far enough to interpret a frame if s-n-m-h == 'none ((eq sc-nuke-mail-headers 'none)) (t (error "Illegal value for sc-nuke-mail-headers: %s" sc-nuke-mail-headers)) ) ; end-cond (append (and entry-func (regi-mapcar sc-nuke-mail-header-list entry-func nil t)) (and nonentry-func (list (list "^\\S +:.*$" nonentry-func))) (and (not every-func) '(("^[ \t]+" (sc-mail-nuke-continuation-line)))) '((begin (setq sc-mail-last-header-zapped-p nil))) '((end (sc-mail-cleanup-blank-lines))) (and every-func (list (list 'every every-func))) ))) ;; mail processing and zapping. this is the top level entry defun to ;; all header processing. (defun sc-mail-process-headers (start end) "Process original mail message's mail headers. After processing, mail headers may be nuked. Header information is stored in `sc-mail-info', and any old information is lost unless an error occurs." (interactive "r") (let ((info (copy-alist sc-mail-info)) (attribs (copy-alist sc-attributions))) (setq sc-mail-info nil sc-attributions nil) (regi-interpret sc-mail-glom-frame start end) (if (null sc-mail-info) (progn (message "No mail headers found! Restoring old information.") (setq sc-mail-info info sc-attributions attribs)) (regi-interpret (sc-mail-build-nuke-frame) sc-mail-headers-start sc-mail-headers-end) ))) ;; let the user change mail field information (defun sc-mail-field (field) "Return the mail header field value associated with FIELD. If there was no mail header with FIELD as its key, return the value of `sc-mumble'. FIELD is case insensitive." (or (cdr (assoc (downcase field) sc-mail-info)) sc-mumble)) (defun sc-mail-field-query (arg) "View the value of a mail field. With `\\[universal-argument]', prompts for action on mail field. Action can be one of: View, Modify, Add, or Delete." (interactive "P") (let* ((alist '(("view" . ?v) ("modify" . ?m) ("add" . ?a) ("delete" . ?d))) (action (if (not arg) ?v (sc-ask alist))) key) (if (not action) () (setq key (sc-completing-read (concat (car (rassq action alist)) " information key: ") sc-mail-info nil (if (eq action ?a) nil 'noexit) nil 'sc-mail-field-history)) (cond ((eq action ?v) (message "%s: %s" key (cdr (assoc key sc-mail-info)))) ((eq action ?d) (setq sc-mail-info (delq (assoc key sc-mail-info) sc-mail-info))) ((eq action ?m) (let ((keyval (assoc key sc-mail-info))) ;; first put initial value onto list if not already there (if (not (sc-member (cdr keyval) sc-mail-field-modification-history)) (setq sc-mail-field-modification-history (cons (cdr keyval) sc-mail-field-modification-history))) (setcdr keyval (sc-read-string (concat key ": ") (cdr keyval) 'sc-mail-field-modification-history)))) ((eq action ?a) (setq sc-mail-info (cons (cons key (sc-read-string (concat key ": "))) sc-mail-info))) )))) ;; ====================================================================== ;; attributions (defvar sc-attribution-confirmation-history nil "History for confirmation of attribution strings.") (defvar sc-citation-confirmation-history nil "History for confirmation of attribution prefixes.") (defun sc-attribs-%@-addresses (from &optional delim) "Extract the author's email terminus from email address FROM. Match addresses of the style ``name%[stuff].'' when called with DELIM of \"%\" and addresses of the style ``[stuff]name@[stuff]'' when called with DELIM \"@\". If DELIM is nil or not provided, matches addresses of the style ``name''." (and (string-match (concat "[-a-zA-Z0-9_.]+" delim) from 0) (substring from (match-beginning 0) (- (match-end 0) (if (null delim) 0 1))))) (defun sc-attribs-!-addresses (from) "Extract the author's email terminus from email address FROM. Match addresses of the style ``[stuff]![stuff]...!name[stuff].''" (let ((eos (length from)) (mstart (string-match "![-a-zA-Z0-9_.]+\\([^-!a-zA-Z0-9_.]\\|$\\)" from 0)) (mend (match-end 0))) (and mstart (substring from (1+ mstart) (- mend (if (= mend eos) 0 1))) ))) (defun sc-attribs-<>-addresses (from) "Extract the author's email terminus from email address FROM. Match addresses of the style ``.''" (and (string-match "<\\(.*\\)>" from) (sc-submatch 1 from))) (defun sc-get-address (from author) "Get the full email address path from FROM. AUTHOR is the author's name (which is removed from the address)." (let ((eos (length from))) (if (string-match (concat "\\(^\\|^\"\\)" author "\\(\\s +\\|\"\\s +\\)") from 0) (let ((address (substring from (match-end 0) eos))) (if (and (= (aref address 0) ?<) (= (aref address (1- (length address))) ?>)) (substring address 1 (1- (length address))) address)) (if (string-match "[-a-zA-Z0-9!@%._]+" from 0) (sc-submatch 0 from) "") ))) (defun sc-attribs-emailname (from) "Get the email terminus name from FROM." (or (sc-attribs-%@-addresses from "%") (sc-attribs-%@-addresses from "@") (sc-attribs-!-addresses from) (sc-attribs-<>-addresses from) (sc-attribs-%@-addresses from) (substring from 0 10))) (defun sc-name-substring (string start end extend) "Extract the specified substring of STRING from START to END. EXTEND is the number of characters on each side to extend the substring." (and start (let ((sos (+ start extend)) (eos (- end extend))) (substring string sos (or (string-match sc-titlecue-regexp string sos) eos) )))) (defun sc-attribs-extract-namestring (from) "Extract the name string from FROM. This should be the author's full name minus an optional title." (let ((namestring (or ;; If there is a <...> in the name, ;; treat everything before that as the full name. ;; Even if it contains parens, use the whole thing. (and (string-match " *<.*>" from 0) (sc-name-substring from 0 (match-beginning 0) 0)) (sc-name-substring from (string-match "(.*)" from 0) (match-end 0) 1) (sc-name-substring from (string-match "\".*\"" from 0) (match-end 0) 1) (sc-name-substring from (string-match "\\([-.a-zA-Z0-9_]+\\s +\\)+<" from 0) (match-end 1) 0) (sc-attribs-emailname from)))) ;; strip off any leading or trailing whitespace (if namestring (let ((bos 0) (eos (1- (length namestring)))) (while (and (<= bos eos) (memq (aref namestring bos) '(32 ?\t))) (setq bos (1+ bos))) (while (and (> eos bos) (memq (aref namestring eos) '(32 ?\t))) (setq eos (1- eos))) (substring namestring bos (1+ eos)))))) (defun sc-attribs-chop-namestring (namestring) "Convert NAMESTRING to a list of names. example: (sc-namestring-to-list \"John Xavier Doe\") => (\"John\" \"Xavier\" \"Doe\")" (if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring) (cons (sc-submatch 2 namestring) (sc-attribs-chop-namestring (substring namestring (match-end 3))) ))) (defun sc-attribs-strip-initials (namelist) "Extract the author's initials from the NAMELIST." (mapconcat (function (lambda (name) (if (< 0 (length name)) (substring name 0 1)))) namelist "")) (defun sc-guess-attribution (&optional string) "Guess attribution string on current line. If attribution cannot be guessed, nil is returned. Optional STRING if supplied, is used instead of the line point is on in the current buffer." (let ((start 0) (string (or string (buffer-substring (regi-pos 'bol) (regi-pos 'eol)))) attribution) (and (= start (or (string-match sc-citation-leader-regexp string start) -1)) (setq start (match-end 0)) (= start (or (string-match sc-citation-root-regexp string start) 1)) (setq attribution (sc-submatch 0 string) start (match-end 0)) (= start (or (string-match sc-citation-delimiter-regexp string start) -1)) (setq start (match-end 0)) (= start (or (string-match sc-citation-separator-regexp string start) -1)) attribution))) (defun sc-attribs-filter-namelist (namelist) "Filter out noise in NAMELIST according to `sc-name-filter-alist'." (let ((elements (length namelist)) (position -1) keepers filtered-list) (mapcar (function (lambda (name) (setq position (1+ position)) (let ((keep-p t)) (mapcar (function (lambda (filter) (let ((regexp (car filter)) (pos (cdr filter))) (if (and (string-match regexp name) (or (and (numberp pos) (= pos position)) (and (eq pos 'last) (= position (1- elements))) (eq pos 'any))) (setq keep-p nil)) ))) sc-name-filter-alist) (if keep-p (setq keepers (cons position keepers))) ))) namelist) (mapcar (function (lambda (position) (setq filtered-list (cons (nth position namelist) filtered-list)) )) keepers) filtered-list)) (defun sc-attribs-chop-address (from) "Extract attribution information from FROM. This populates the `sc-attributions' with the list of possible attributions." (if (and (stringp from) (< 0 (length from))) (let* ((sc-mumble "") (namestring (sc-attribs-extract-namestring from)) (namelist (sc-attribs-filter-namelist (sc-attribs-chop-namestring namestring))) (revnames (reverse (cdr namelist))) (firstname (car namelist)) (midnames (reverse (cdr revnames))) (lastname (car revnames)) (initials (sc-attribs-strip-initials namelist)) (emailname (sc-attribs-emailname from)) (n 1) author middlenames) ;; put basic information (setq ;; put middle names and build sc-author entry middlenames (mapconcat (function (lambda (midname) (let ((key-attribs (format "middlename-%d" n)) (key-mail (format "sc-middlename-%d" n))) (setq sc-attributions (cons (cons key-attribs midname) sc-attributions) sc-mail-info (cons (cons key-mail midname) sc-mail-info) n (1+ n)) midname))) midnames " ") author (concat firstname " " middlenames (and midnames " ") lastname) sc-attributions (append (list (cons "firstname" firstname) (cons "lastname" lastname) (cons "emailname" emailname) (cons "initials" initials)) sc-attributions) sc-mail-info (append (list (cons "sc-firstname" firstname) (cons "sc-middlenames" middlenames) (cons "sc-lastname" lastname) (cons "sc-emailname" emailname) (cons "sc-initials" initials) (cons "sc-author" author) (cons "sc-from-address" (sc-get-address (sc-mail-field "from") namestring)) (cons "sc-reply-address" (sc-get-address (sc-mail-field "reply-to") namestring)) (cons "sc-sender-address" (sc-get-address (sc-mail-field "sender") namestring)) ) sc-mail-info) )) ;; from string is empty (setq sc-mail-info (cons (cons "sc-author" sc-default-author-name) sc-mail-info)))) (defvar sc-attrib-or-cite nil "Used to toggle between attribution input or citation input.") (defun sc-toggle-fn () "Toggle between attribution selection and citation selection. Only used during confirmation." (interactive) (setq sc-attrib-or-cite (not sc-attrib-or-cite)) (throw 'sc-reconfirm t)) (defun sc-select-attribution () "Select an attribution from `sc-attributions'. Variables involved in selection process include: `sc-preferred-attribution-list' `sc-use-only-preference-p' `sc-confirm-always-p' `sc-default-attribution' `sc-attrib-selection-list'. Runs the hook `sc-attribs-preselect-hook' before selecting an attribution and the hook `sc-attribs-postselect-hook' after making the selection but before querying is performed. During `sc-attribs-postselect-hook' the variable `citation' is bound to the auto-selected citation string and the variable `attribution' is bound to the auto-selected attribution string." (run-hooks 'sc-attribs-preselect-hook) (let ((query-p sc-confirm-always-p) attribution citation (attriblist sc-preferred-attribution-list)) ;; first cruise through sc-preferred-attribution-list looking for ;; a match in either sc-attributions or sc-mail-info. if the ;; element is "sc-consult", then we have to do the alist ;; consultation phase (while attriblist (let* ((preferred (car attriblist))) (cond ((string= preferred "sc-consult") ;; we've been told to consult the attribution vs. mail ;; header key alist. we do this until we find a match in ;; the sc-attrib-selection-list. if we do not find a match, ;; we continue scanning attriblist (let ((attrib (sc-scan-info-alist sc-attrib-selection-list))) (cond ((not attrib) (setq attriblist (cdr attriblist))) ((stringp attrib) (setq attribution attrib attriblist nil)) ((listp attrib) (setq attribution (eval attrib) attriblist nil)) (t (error "%s did not evaluate to a string or list!" "sc-attrib-selection-list")) ))) ((setq attribution (cdr (assoc preferred sc-attributions))) (setq attriblist nil)) (t (setq attriblist (cdr attriblist))) ))) ;; if preference was not found, we may use a secondary method to ;; find a valid attribution (if (and (not attribution) (not sc-use-only-preference-p)) ;; secondary method tries to find a preference in this order ;; 1. sc-lastchoice ;; 2. x-attribution ;; 3. firstname ;; 4. lastname ;; 5. initials ;; 6. first non-empty attribution in alist (setq attribution (or (cdr (assoc "sc-lastchoice" sc-attributions)) (cdr (assoc "x-attribution" sc-attributions)) (cdr (assoc "firstname" sc-attributions)) (cdr (assoc "lastname" sc-attributions)) (cdr (assoc "initials" sc-attributions)) (cdr (car sc-attributions))))) ;; still couldn't find an attribution. we're now limited to using ;; the default attribution, but we'll force a query when this happens (if (not attribution) (setq attribution sc-default-attribution query-p t)) ;; create the attribution prefix (setq citation (sc-make-citation attribution)) ;; run the post selection hook before querying the user (run-hooks 'sc-attribs-postselect-hook) ;; query for confirmation (if query-p (let* ((query-alist (mapcar (function (lambda (entry) (list (cdr entry)))) sc-attributions)) (minibuffer-local-completion-map sc-minibuffer-local-completion-map) (minibuffer-local-map sc-minibuffer-local-map) (initial attribution) (completer-disable t) ; in case completer.el is used choice) (setq sc-attrib-or-cite nil) ; nil==attribution, t==citation (while (catch 'sc-reconfirm (string= "" (setq choice (if sc-attrib-or-cite (sc-read-string "Enter citation prefix: " citation 'sc-citation-confirmation-history) (sc-completing-read "Complete attribution name: " query-alist nil nil (cons initial 0) 'sc-attribution-confirmation-history) ))))) (if sc-attrib-or-cite ;; since the citation was chosen, we have to guess at ;; the attribution (setq citation choice attribution (or (sc-guess-attribution citation) citation)) (setq citation (sc-make-citation choice) attribution choice)) )) ;; its possible that the user wants to downcase the citation and ;; attribution (if sc-downcase-p (setq citation (downcase citation) attribution (downcase attribution))) ;; set up mail info alist (let* ((ckey "sc-citation") (akey "sc-attribution") (ckeyval (assoc ckey sc-mail-info)) (akeyval (assoc akey sc-mail-info))) (if ckeyval (setcdr ckeyval citation) (setq sc-mail-info (append (list (cons ckey citation)) sc-mail-info))) (if akeyval (setcdr akeyval attribution) (setq sc-mail-info (append (list (cons akey attribution)) sc-mail-info)))) ;; set the sc-lastchoice attribution (let* ((lkey "sc-lastchoice") (lastchoice (assoc lkey sc-attributions))) (if lastchoice (setcdr lastchoice attribution) (setq sc-attributions (cons (cons lkey attribution) sc-attributions)))) )) ;; ====================================================================== ;; filladapt hooks for supercite 3.1. you shouldn't need anything ;; extra to make gin-mode understand supercited lines. Even this ;; stuff might not be entirely necessary... (defun sc-cite-regexp (&optional root-regexp) "Return a regexp describing a Supercited line. The regexp is the concatenation of `sc-citation-leader-regexp', `sc-citation-root-regexp', `sc-citation-delimiter-regexp', and `sc-citation-separator-regexp'. If optional ROOT-REGEXP is supplied, use it instead of `sc-citation-root-regexp'." (concat sc-citation-leader-regexp (or root-regexp sc-citation-root-regexp) sc-citation-delimiter-regexp sc-citation-separator-regexp)) (defun sc-make-citation (attribution) "Make a non-nested citation from ATTRIBUTION." (concat sc-citation-leader attribution sc-citation-delimiter sc-citation-separator)) (defun sc-setup-filladapt () "Setup `filladapt-prefix-table' to handle Supercited paragraphs." (let* ((fa-sc-elt 'filladapt-supercite-included-text) (elt (rassq fa-sc-elt filladapt-prefix-table))) (if elt (setcar elt (sc-cite-regexp)) (message "Filladapt doesn't seem to know about Supercite.") (beep)))) ;; ====================================================================== ;; citing and unciting regions of text (defvar sc-fill-begin 1 "Buffer position to begin filling.") (defvar sc-fill-line-prefix "" "Fill prefix of previous line") ;; filling (defun sc-fill-if-different (&optional prefix) "Fill the region bounded by `sc-fill-begin' and point. Only fill if optional PREFIX is different than `sc-fill-line-prefix'. If `sc-auto-fill-region-p' is nil, do not fill region. If PREFIX is not supplied, initialize fill variables. This is useful for a regi `begin' frame-entry." (if (not prefix) (setq sc-fill-line-prefix "" sc-fill-begin (regi-pos 'bol)) (if (and sc-auto-fill-region-p (not (string= prefix sc-fill-line-prefix))) (let ((fill-prefix sc-fill-line-prefix)) (if (not (string= fill-prefix "")) (fill-region sc-fill-begin (regi-pos 'bol))) (setq sc-fill-line-prefix prefix sc-fill-begin (regi-pos 'bol)))) ) nil) (defun sc-cite-coerce-cited-line () "Coerce a Supercited line to look like our style." (let* ((attribution (sc-guess-attribution)) (regexp (sc-cite-regexp attribution)) (prefix (sc-make-citation attribution))) (if (and attribution (looking-at regexp)) (progn (delete-region (match-beginning 0) (save-excursion (goto-char (match-end 0)) (if (bolp) (forward-char -1)) (point))) (insert prefix) (sc-fill-if-different prefix))) nil)) (defun sc-cite-coerce-dumb-citer () "Coerce a non-nested citation that's been cited with a dumb nesting citer." (delete-region (match-beginning 1) (match-end 1)) (beginning-of-line) (sc-cite-coerce-cited-line)) (defun sc-guess-nesting (&optional string) "Guess the citation nesting on the current line. If nesting cannot be guessed, nil is returned. Optional STRING if supplied, is used instead of the line point is on in the current buffer." (let ((start 0) (string (or string (buffer-substring (regi-pos 'bol) (regi-pos 'eol)))) nesting) (and (= start (or (string-match sc-citation-leader-regexp string start) -1)) (setq start (match-end 0)) (= start (or (string-match sc-citation-delimiter-regexp string start) -1)) (setq nesting (sc-submatch 0 string) start (match-end 0)) (= start (or (string-match sc-citation-separator-regexp string start) -1)) nesting))) (defun sc-add-citation-level () "Add a citation level for nested citation style w/ coersion." (let* ((nesting (sc-guess-nesting)) (citation (make-string (1+ (length nesting)) (string-to-char sc-citation-delimiter))) (prefix (concat sc-citation-leader citation sc-citation-separator))) (if (looking-at (sc-cite-regexp "")) (delete-region (match-beginning 0) (match-end 0))) (insert prefix) (sc-fill-if-different prefix))) (defun sc-cite-line (&optional citation) "Cite a single line of uncited text. Optional CITATION overrides any citation automatically selected." (if sc-fixup-whitespace-p (fixup-whitespace)) (let ((prefix (or citation (cdr (assoc "sc-citation" sc-mail-info)) sc-default-attribution))) (insert prefix) (sc-fill-if-different prefix)) nil) (defun sc-uncite-line () "Remove citation from current line." (let ((cited (looking-at (sc-cite-regexp)))) (if cited (delete-region (match-beginning 0) (match-end 0)))) nil) (defun sc-recite-line (regexp) "Remove citation matching REGEXP from current line and recite line." (let ((cited (looking-at (concat "^" regexp))) (prefix (cdr (assoc "sc-citation" sc-mail-info)))) (if cited (delete-region (match-beginning 0) (match-end 0))) (insert (or prefix sc-default-attribution)) (sc-fill-if-different prefix)) nil) ;; interactive functions (defun sc-cite-region (start end &optional confirm-p) "Cite a region delineated by START and END. If optional CONFIRM-P is non-nil, the attribution is confirmed before its use in the citation string. This function first runs `sc-pre-cite-hook'." (interactive "r\nP") (undo-boundary) (let ((frame (or (sc-scan-info-alist sc-cite-frame-alist) sc-default-cite-frame)) (sc-confirm-always-p (if confirm-p t sc-confirm-always-p))) (run-hooks 'sc-pre-cite-hook) (if (interactive-p) (sc-select-attribution)) (regi-interpret frame start end))) (defun sc-uncite-region (start end) "Uncite a region delineated by START and END. First runs `sc-pre-uncite-hook'." (interactive "r") (undo-boundary) (let ((frame (or (sc-scan-info-alist sc-uncite-frame-alist) sc-default-uncite-frame))) (run-hooks 'sc-pre-uncite-hook) (regi-interpret frame start end))) (defun sc-recite-region (start end) "Recite a region delineated by START and END. First runs `sc-pre-recite-hook'." (interactive "r") (let ((sc-confirm-always-p t)) (sc-select-attribution)) (undo-boundary) (let ((frame (or (sc-scan-info-alist sc-recite-frame-alist) sc-default-recite-frame))) (run-hooks 'sc-pre-recite-hook) (regi-interpret frame start end))) ;; ====================================================================== ;; building headers (defun sc-hdr (prefix field &optional sep return-nil-p) "Returns a concatenation of PREFIX and FIELD. If FIELD is not a string or is the empty string, the empty string will be returned. Optional third argument SEP is concatenated on the end if it is a string. Returns empty string, unless optional RETURN-NIL-P is non-nil." (if (and (stringp field) (not (string= field ""))) (concat prefix field (or sep "")) (and (not return-nil-p) ""))) (defun sc-whofrom () "Return the value of (sc-mail-field \"from\") or nil." (let ((sc-mumble nil)) (sc-mail-field "from"))) (defun sc-no-header () "Does nothing. Use this instead of nil to get a blank header." ()) (defun sc-no-blank-line-or-header() "Similar to `sc-no-header' except it removes the preceeding blank line." (if (not (bobp)) (if (and (eolp) (progn (forward-line -1) (or (looking-at (concat "^" (regexp-quote mail-header-separator) "$")) (and (eq major-mode 'mh-letter-mode) (mh-in-header-p))))) (progn (forward-line) (let ((kill-lines-magic t)) (kill-line)))))) (defun sc-header-on-said () "\"On , said:\" unless: 1. the \"from\" field cannot be found, in which case nothing is inserted; 2. the \"date\" field is missing in which case only the from part is printed." (let ((sc-mumble "") (whofrom (sc-whofrom))) (if whofrom (insert sc-reference-tag-string (sc-hdr "On " (sc-mail-field "date") ", ") whofrom " said:\n")))) (defun sc-header-inarticle-writes () "\"In article , writes:\" Treats \"message-id\" and \"from\" fields similar to `sc-header-on-said'." (let ((sc-mumble "") (whofrom (sc-mail-field "from"))) (if whofrom (insert sc-reference-tag-string (sc-hdr "In article " (sc-mail-field "message-id") ", ") whofrom " writes:\n")))) (defun sc-header-regarding-adds () "\"Regarding ; adds:\" Treats \"subject\" and \"from\" fields similar to `sc-header-on-said'." (let ((sc-mumble "") (whofrom (sc-whofrom))) (if whofrom (insert sc-reference-tag-string (sc-hdr "Regarding " (sc-mail-field "subject") "; ") whofrom " adds:\n")))) (defun sc-header-attributed-writes () "\"\" ==
writes: Treats these fields in a similar manner to `sc-header-on-said'." (let ((sc-mumble "") (whofrom (sc-whofrom))) (if whofrom (insert sc-reference-tag-string (sc-hdr "\"" (sc-mail-field "sc-attribution") "\" == ") (sc-hdr "" (sc-mail-field "sc-author") " ") (or (sc-hdr "<" (sc-mail-field "sc-from-address") ">" t) (sc-hdr "<" (sc-mail-field "sc-reply-address") ">" t) "") " writes:\n")))) (defun sc-header-author-writes () " writes:" (let ((sc-mumble "") (whofrom (sc-whofrom))) (if whofrom (insert sc-reference-tag-string (sc-hdr "" (sc-mail-field "sc-author")) " writes:\n")))) (defun sc-header-verbose () "Very verbose, some say gross." (let ((sc-mumble "") (whofrom (sc-whofrom)) (tag sc-reference-tag-string)) (if whofrom (insert (sc-hdr (concat tag "On ") (sc-mail-field "date") ",\n") (or (sc-hdr tag (sc-mail-field "sc-author") "\n" t) (concat tag whofrom "\n")) (sc-hdr (concat tag "from the organization of ") (sc-mail-field "organization") "\n") (let ((rtag (concat tag "who can be reached at: "))) (or (sc-hdr rtag (sc-mail-field "sc-from-address") "\n" t) (sc-hdr rtag (sc-mail-field "sc-reply-address") "\n" t) "")) (sc-hdr (concat tag "(whose comments are cited below with \"") (sc-mail-field "sc-citation") "\"),\n") (sc-hdr (concat tag "had this to say in article ") (sc-mail-field "message-id") "\n") (sc-hdr (concat tag "in newsgroups ") (sc-mail-field "newsgroups") "\n") (sc-hdr (concat tag "concerning the subject of ") (sc-mail-field "subject") "\n") (sc-hdr (concat tag "(see ") (sc-mail-field "references") " for more details)\n") )))) ;; ====================================================================== ;; header rewrites (defconst sc-electric-bufname " *sc-erefs* " "Supercite electric reference mode's buffer name.") (defvar sc-eref-style 0 "Current electric reference style.") (defun sc-valid-index-p (index) "Returns INDEX if it is a valid index into `sc-rewrite-header-list'. Otherwise returns nil." ;; a number, and greater than or equal to zero ;; less than or equal to the last index (and (natnump index) (< index (length sc-rewrite-header-list)) index)) (defun sc-eref-insert-selected (&optional nomsg) "Insert the selected reference header in the current buffer. Optional NOMSG, if non-nil, inhibits printing messages, unless an error occurs." (let ((ref (nth sc-eref-style sc-rewrite-header-list))) (condition-case err (progn (eval ref) (let ((lines (count-lines (point-min) (point-max)))) (or nomsg (message "Ref header %d [%d line%s]: %s" sc-eref-style lines (if (= lines 1) "" "s") ref)))) (void-function (progn (message "Symbol's function definition is void: %s (Header %d)" (car (cdr err)) sc-eref-style) (beep) )) ))) (defun sc-electric-mode (&optional arg) " Mode for viewing Supercite reference headers. Commands are: \n\\{sc-electric-mode-map} `sc-electric-mode' is not intended to be run interactively, but rather accessed through Supercite's electric reference feature. See `sc-insert-reference' for more details. Optional ARG is the initial header style to use, unless not supplied or invalid, in which case `sc-preferred-header-style' is used." (let ((info sc-mail-info)) (setq sc-eref-style (or (sc-valid-index-p arg) (sc-valid-index-p sc-preferred-header-style) 0)) (get-buffer-create sc-electric-bufname) ;; set up buffer and enter command loop (save-excursion (save-window-excursion (pop-to-buffer sc-electric-bufname) (kill-all-local-variables) (let ((sc-mail-info info) (buffer-read-only t) (mode-name "SC Electric Refs") (major-mode 'sc-electric-mode)) (use-local-map sc-electric-mode-map) (sc-eref-show sc-eref-style) (run-hooks 'sc-electric-mode-hook) (recursive-edit) ))) (and sc-eref-style (sc-eref-insert-selected)) (kill-buffer sc-electric-bufname) )) ;; functions for electric reference mode (defun sc-eref-show (index) "Show reference INDEX in `sc-rewrite-header-list'." (let ((msg "No %ing reference headers in list.") (last (length sc-rewrite-header-list))) (setq sc-eref-style (cond ((sc-valid-index-p index) index) ((< index 0) (if sc-electric-circular-p (1- last) (progn (error msg "preced") 0))) ((>= index last) (if sc-electric-circular-p 0 (progn (error msg "follow") (1- last)))) )) (save-excursion (set-buffer sc-electric-bufname) (let ((buffer-read-only nil)) (erase-buffer) (goto-char (point-min)) (sc-eref-insert-selected) ;; now shrink the window to just contain the electric reference ;; header. (let ((hdrlines (count-lines (point-min) (point-max))) (winlines (1- (window-height)))) (if (/= hdrlines winlines) (if (> hdrlines winlines) ;; we have to enlarge the window (enlarge-window (- hdrlines winlines)) ;; we have to shrink the window (shrink-window (- winlines (max hdrlines window-min-height))) ))) )))) (defun sc-eref-next () "Display next reference in other buffer." (interactive) (sc-eref-show (1+ sc-eref-style))) (defun sc-eref-prev () "Display previous reference in other buffer." (interactive) (sc-eref-show (1- sc-eref-style))) (defun sc-eref-setn () "Set reference header selected as preferred." (interactive) (setq sc-preferred-header-style sc-eref-style) (message "Preferred reference style set to header %d." sc-eref-style)) (defun sc-eref-goto (refnum) "Show reference style indexed by REFNUM. If REFNUM is an invalid index, don't go to that reference and return nil." (interactive "NGoto Reference: ") (if (sc-valid-index-p refnum) (sc-eref-show refnum) (error "Invalid reference: %d. (Range: [%d .. %d])" refnum 0 (1- (length sc-rewrite-header-list))) )) (defun sc-eref-jump () "Set reference header to preferred header." (interactive) (sc-eref-show sc-preferred-header-style)) (defun sc-eref-abort () "Exit from electric reference mode without inserting reference." (interactive) (setq sc-eref-style nil) (exit-recursive-edit)) (defun sc-eref-exit () "Exit from electric reference mode and insert selected reference." (interactive) (exit-recursive-edit)) (defun sc-insert-reference (arg) "Insert, at point, a reference header in the body of the reply. Numeric ARG indicates which header style from `sc-rewrite-header-list' to use when rewriting the header. No supplied ARG indicates use of `sc-preferred-header-style'. With just `\\[universal-argument]', electric reference insert mode is entered, regardless of the value of `sc-electric-references-p'. See `sc-electric-mode' for more information." (interactive "P") (if (consp arg) (sc-electric-mode) (let ((preference (or (sc-valid-index-p arg) (sc-valid-index-p sc-preferred-header-style) sc-preferred-header-style 0))) (if sc-electric-references-p (sc-electric-mode preference) (sc-eref-insert-selected t) )))) ;; ====================================================================== ;; variable toggling (defun sc-raw-mode-toggle () "Toggle, in one fell swoop, two important SC variables: `sc-fixup-whitespace-p' and `sc-auto-fill-region-p'" (interactive) (setq sc-fixup-whitespace-p (not sc-fixup-whitespace-p) sc-auto-fill-region-p (not sc-auto-fill-region-p)) (sc-set-mode-string) (force-mode-line-update)) (defun sc-toggle-var (variable) "Boolean toggle VARIABLE's value. VARIABLE must be a bound symbol. Nil values change to t, non-nil values are changed to nil." (message "%s changed from %s to %s" variable (symbol-value variable) (set-variable variable (not (eval-expression variable)))) (sc-set-mode-string)) (defun sc-set-variable (var) "Set the Supercite VARIABLE. This function mimics `set-variable', except that the variable to set is determined non-interactively. The value is queried for in the minibuffer exactly the same way that `set-variable' does it. You can see the current value of the variable when the minibuffer is querying you by typing `C-h'. Note that the format is changed slightly from that used by `set-variable' -- the current value is printed just after the variable's name instead of at the bottom of the help window." (let* ((minibuffer-help-form '(funcall myhelp)) (myhelp (function (lambda () (with-output-to-temp-buffer "*Help*" (prin1 var) (if (boundp var) (let ((print-length 20)) (princ "\t(Current value: ") (prin1 (symbol-value var)) (princ ")"))) (princ "\n\nDocumentation:\n") (princ (substring (documentation-property var 'variable-documentation) 1)) (save-excursion (set-buffer standard-output) (help-mode)) nil))))) (set var (eval-minibuffer (format "Set %s to value: " var)))) (sc-set-mode-string)) (defmacro sc-toggle-symbol (rootname) (list 'defun (intern (concat "sc-T-" rootname)) '() (list 'interactive) (list 'sc-toggle-var (list 'quote (intern (concat "sc-" rootname "-p")))))) (defmacro sc-setvar-symbol (rootname) (list 'defun (intern (concat "sc-S-" rootname)) '() (list 'interactive) (list 'sc-set-variable (list 'quote (intern (concat "sc-" rootname)))))) (sc-toggle-symbol "confirm-always") (sc-toggle-symbol "downcase") (sc-toggle-symbol "electric-references") (sc-toggle-symbol "auto-fill-region") (sc-toggle-symbol "mail-nuke-blank-lines") (sc-toggle-symbol "nested-citation") (sc-toggle-symbol "electric-circular") (sc-toggle-symbol "use-only-preferences") (sc-toggle-symbol "fixup-whitespace") (sc-setvar-symbol "preferred-attribution-list") (sc-setvar-symbol "preferred-header-style") (sc-setvar-symbol "mail-nuke-mail-headers") (sc-setvar-symbol "mail-header-nuke-list") (sc-setvar-symbol "cite-region-limit") (defun sc-T-describe () " Supercite provides a number of key bindings which simplify the process of setting or toggling certain variables controlling its operation. Note on function names in this list: all functions of the form `sc-S-' actually call `sc-set-variable' on the corresponding `sc-' variable. All functions of the form `sc-T-' call `sc-toggle-var' on the corresponding `sc--p' variable. \\{sc-T-keymap}" (interactive) (describe-function 'sc-T-describe)) (defun sc-set-mode-string () "Update the minor mode string to show state of Supercite." (setq sc-mode-string (concat " SC" (if (or sc-auto-fill-region-p sc-fixup-whitespace-p) ":" "") (if sc-auto-fill-region-p "f" "") (if sc-fixup-whitespace-p "w" "") ))) ;; ====================================================================== ;; published interface to mail and news readers ;;;###autoload (defun sc-cite-original () "Workhorse citing function which performs the initial citation. This is callable from the various mail and news readers' reply function according to the agreed upon standard. See `\\[sc-describe]' for more details. `sc-cite-original' does not do any yanking of the original message but it does require a few things: 1) The reply buffer is the current buffer. 2) The original message has been yanked and inserted into the reply buffer. 3) Verbose mail headers from the original message have been inserted into the reply buffer directly before the text of the original message. 4) Point is at the beginning of the verbose headers. 5) Mark is at the end of the body of text to be cited. For Emacs 19's, the region need not be active (and typically isn't when this function is called. Also, the hook `sc-pre-hook' is run before, and `sc-post-hook' is run after the guts of this function." (run-hooks 'sc-pre-hook) ;; before we do anything, we want to insert the supercite keymap so ;; we can proceed from here (and sc-mode-map-prefix (local-set-key sc-mode-map-prefix sc-mode-map)) ;; hack onto the minor mode alist, if it hasn't been done before, ;; then turn on the minor mode. also, set the minor mode string with ;; the values of fill and fixup whitespace variables (if (not (get 'minor-mode-alist 'sc-minor-mode)) (progn (put 'minor-mode-alist 'sc-minor-mode 'sc-minor-mode) (setq minor-mode-alist (cons '(sc-minor-mode sc-mode-string) minor-mode-alist)) )) (setq sc-minor-mode t) (sc-set-mode-string) (undo-boundary) ;; grab point and mark since the region is probably not active when ;; this function gets automatically called. we want point to be a ;; mark so any deleting before point works properly (let* ((zmacs-regions nil) ; for Lemacs (mark-active t) ; for FSFmacs (point (point-marker)) (mark (copy-marker (mark-marker)))) ;; make sure point comes before mark, not all functions are ;; interactive "r" (if (< mark point) (let ((tmp point)) (setq point mark mark tmp))) ;; first process mail headers, and populate sc-mail-info (sc-mail-process-headers point mark) ;; now get possible attributions (sc-attribs-chop-address (or (sc-mail-field "from") (sc-mail-field "reply") (sc-mail-field "reply-to") (sc-mail-field "sender"))) ;; select the attribution (sc-select-attribution) ;; cite the region, but first check the value of sc-cite-region-limit (let ((linecnt (count-lines point mark))) (and sc-cite-region-limit (if (or (not (numberp sc-cite-region-limit)) (<= linecnt sc-cite-region-limit)) (progn ;; cite the region and insert the header rewrite (sc-cite-region point mark) (goto-char point) (let ((sc-eref-style (or sc-preferred-header-style 0))) (if sc-electric-references-p (sc-electric-mode sc-eref-style) (sc-eref-insert-selected t)))) (beep) (message "Region not cited. %d lines exceeds sc-cite-region-limit: %d" linecnt sc-cite-region-limit)))) ;; finally, free the point-marker (set-marker point nil) (set-marker mark nil) ) (run-hooks 'sc-post-hook) ;; post hook could have changed the variables (sc-set-mode-string)) ;; ====================================================================== ;; bug reporting and miscellaneous commands (defun sc-open-line (arg) "Like `open-line', but insert the citation prefix at the front of the line. With numeric ARG, inserts that many new lines." (interactive "p") (save-excursion (let ((start (point)) (prefix (or (progn (beginning-of-line) (if (looking-at (sc-cite-regexp)) (sc-submatch 0))) ""))) (goto-char start) (open-line arg) (forward-line 1) (while (< 0 arg) (insert prefix) (forward-line 1) (setq arg (1- arg)) )))) (defun sc-insert-citation (arg) "Insert citation string at beginning of current line if not already cited. With `\\[universal-argument]' insert citation even if line is already cited." (interactive "P") (save-excursion (beginning-of-line) (if (or (not (looking-at (sc-cite-regexp))) (looking-at "^[ \t]*$") (consp arg)) (insert (sc-mail-field "sc-citation")) (error "Line is already cited.")))) (defun sc-version (arg) "Echo the current version of Supercite in the minibuffer. With \\[universal-argument] (universal-argument), or if run non-interactively, inserts the version string in the current buffer instead." (interactive "P") (let ((verstr (format "Using Supercite.el %s" sc-version))) (if (or (consp arg) (not (interactive-p))) (insert "`sc-version' says: " verstr) (message verstr)))) (defun sc-describe () " Supercite is a package which provides a flexible mechanism for citing email and news replies. Please see the associated texinfo file for more information." (interactive) (describe-function 'sc-describe)) (defun sc-submit-bug-report () "Submit a bug report on Supercite via mail." (interactive) (require 'reporter) (and (y-or-n-p "Do you want to submit a report on Supercite? ") (reporter-submit-bug-report sc-help-address (concat "Supercite version " sc-version) (list 'sc-attrib-selection-list 'sc-auto-fill-region-p 'sc-blank-lines-after-headers 'sc-citation-leader 'sc-citation-delimiter 'sc-citation-separator 'sc-citation-leader-regexp 'sc-citation-root-regexp 'sc-citation-nonnested-root-regexp 'sc-citation-delimiter-regexp 'sc-citation-separator-regexp 'sc-cite-region-limit 'sc-confirm-always-p 'sc-default-attribution 'sc-default-author-name 'sc-downcase-p 'sc-electric-circular-p 'sc-electric-references-p 'sc-fixup-whitespace-p 'sc-mail-warn-if-non-rfc822-p 'sc-mumble 'sc-name-filter-alist 'sc-nested-citation-p 'sc-nuke-mail-headers 'sc-nuke-mail-header-list 'sc-preferred-attribution-list 'sc-preferred-header-style 'sc-reference-tag-string 'sc-rewrite-header-list 'sc-titlecue-regexp 'sc-use-only-preference-p )))) ;; useful stuff (provide 'supercite) (run-hooks 'sc-load-hook) ;;; supercite.el ends here emacs-19.30/lisp/swedish.el100444 13437 1 12051 5400077412 14211 0ustar jimbdaemon;;; swedish.el --- miscellaneous functions for dealing with Swedish. ;; Copyright (C) 1988 Free Software Foundation, Inc. ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;; Written by Howard Gayle. See case-table.el for details. ;; See iso-swed.el for a description of the character set. (require 'iso-syntax) (defvar swedish-re "[ \t\n]\\(och\\|att\\|en\\|{r\\|\\[R\\|p}\\|P\\]\\|som\\|det\\|av\\|den\\|f|r\\|F\\\\R\\)[ \t\n.,?!:;'\")}]" "Regular expression for common Swedish words.") (defvar swascii-to-8859-trans (let ((string (make-string 256 ? )) (i 0)) (while (< i 256) (aset string i i) (setq i (1+ i))) (aset string ?\[ 196) (aset string ?\] 197) (aset string ?\\ 214) (aset string ?^ 220) (aset string ?\{ 228) (aset string ?\} 229) (aset string ?\` 233) (aset string ?\| 246) (aset string ?~ 252) string) "Trans table from SWASCII to 8859.") ; $ is not converted because it almost always means US ; dollars, not general currency sign. @ is not converted ; because it is more likely to be an at sign in a mail address ; than an E with acute accent. (defun swascii-to-8859-buffer () "Convert characters in buffer from Swedish/Finnish-ascii to ISO 8859/1. Works even on read-only buffers. `$' and `@' are not converted." (interactive) (let ((buffer-read-only nil)) (translate-region (point-min) (point-max) swascii-to-8859-trans))) (defun swascii-to-8859-buffer-maybe () "Call swascii-to-8859-buffer if the buffer looks like Swedish-ascii. Leaves point just after the word that looks Swedish." (interactive) (let ((case-fold-search t)) (if (re-search-forward swedish-re nil t) (swascii-to-8859-buffer)))) (setq rmail-show-message-hook 'swascii-to-8859-buffer-maybe) (or (boundp 'news-group-hook-alist) (setq news-group-hook-alist nil)) (setq news-group-hook-alist (append '(("^swnet." . swascii-to-8859-buffer-maybe)) news-group-hook-alist)) (defvar 8859-to-swascii-trans (let ((string (make-string 256 ? )) (i 0)) (while (< i 256) (aset string i i) (setq i (1+ i))) (aset string 164 ?$) (aset string 196 ?\[) (aset string 197 ?\]) (aset string 201 ?@) (aset string 214 ?\\) (aset string 220 ?^) (aset string 228 ?\{) (aset string 229 ?\}) (aset string 233 ?\`) (aset string 246 ?\|) (aset string 252 ?~) string) "8859 to SWASCII trans table.") (defun 8859-to-swascii-buffer () "Convert characters in buffer from ISO 8859/1 to Swedish/Finnish-ascii." (interactive "*") (translate-region (point-min) (point-max) 8859-to-swascii-trans)) (setq mail-send-hook '8859-to-swascii-buffer) (setq news-inews-hook '8859-to-swascii-buffer) ;; It's not clear what purpose is served by a separate ;; Swedish mode that differs from Text mode only in having ;; a separate abbrev table. Nothing says that the abbrevs you ;; define in Text mode have to be English! ;(defvar swedish-mode-abbrev-table nil ; "Abbrev table used while in swedish mode.") ;(define-abbrev-table 'swedish-mode-abbrev-table ()) ;(defun swedish-mode () ; "Major mode for editing Swedish text intended for humans to ;read. Special commands:\\{text-mode-map} ;Turning on swedish-mode calls the value of the variable ;text-mode-hook, if that value is non-nil." ; (interactive) ; (kill-all-local-variables) ; (use-local-map text-mode-map) ; (setq mode-name "Swedish") ; (setq major-mode 'swedish-mode) ; (setq local-abbrev-table swedish-mode-abbrev-table) ; (set-syntax-table text-mode-syntax-table) ; (run-hooks 'text-mode-hook)) ;(defun indented-swedish-mode () ; "Major mode for editing indented Swedish text intended for ;humans to read.\\{indented-text-mode-map} ;Turning on indented-swedish-mode calls the value of the ;variable text-mode-hook, if that value is non-nil." ; (interactive) ; (kill-all-local-variables) ; (use-local-map text-mode-map) ; (define-abbrev-table 'swedish-mode-abbrev-table ()) ; (setq local-abbrev-table swedish-mode-abbrev-table) ; (set-syntax-table text-mode-syntax-table) ; (make-local-variable 'indent-line-function) ; (setq indent-line-function 'indent-relative-maybe) ; (use-local-map indented-text-mode-map) ; (setq mode-name "Indented Swedish") ; (setq major-mode 'indented-swedish-mode) ; (run-hooks 'text-mode-hook)) (provide 'swedish) ;;; swedish.el ends here emacs-19.30/lisp/tabify.el100444 12120 1 5114 5742416126 13657 0ustar rmsdaemon;;; tabify.el --- tab conversion commands for Emacs ;; Copyright (C) 1985, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; 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: ;; Commands to optimize spaces to tabs or expand tabs to spaces in a region ;; (`tabify' and `untabify'). The variable tab-width does the obvious. ;;; Code: ;;;###autoload (defun untabify (start end) "Convert all tabs in region to multiple spaces, preserving columns. Called non-interactively, the region is specified by arguments START and END, rather than by the position of point and mark. The variable `tab-width' controls the spacing of tab stops." (interactive "r") (save-excursion (save-restriction (narrow-to-region (point-min) end) (goto-char start) (while (search-forward "\t" nil t) ; faster than re-search (let ((tab-beg (point)) (column (current-column)) (indent-tabs-mode nil)) (skip-chars-backward "\t" start) (delete-region tab-beg (point)) (indent-to column)))))) ;;;###autoload (defun tabify (start end) "Convert multiple spaces in region to tabs when possible. A group of spaces is partially replaced by tabs when this can be done without changing the column they end at. Called non-interactively, the region is specified by arguments START and END, rather than by the position of point and mark. The variable `tab-width' controls the spacing of tab stops." (interactive "r") (save-excursion (save-restriction ;; Include the beginning of the line in the narrowing ;; since otherwise it will throw off current-column. (goto-char start) (beginning-of-line) (narrow-to-region (point) end) (goto-char start) (while (re-search-forward "[ \t][ \t][ \t]*" nil t) (let ((column (current-column)) (indent-tabs-mode t)) (delete-region (match-beginning 0) (point)) (indent-to column)))))) (provide 'tabify) ;;; tabify.el ends here emacs-19.30/lisp/talk.el100444 12120 1 7164 5775322152 13344 0ustar rmsdaemon;;; talk.el --- Allow several users to talk to each other through Emacs. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Keywords: comm, frames ;; 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 is a multi-user talk package that runs in Emacs. ;;; Use talk-connect to bring a new person into the conversation. ;;; Code: (defvar talk-display-alist nil "Alist of displays on which Emacs talk is now running. Each element has the form (DISPLAY FRAME BUFFER).") ;;;###autoload (defun talk-connect (display) "Connect to display DISPLAY for the Emacs talk group." (interactive "sTalk to display: ") ;; Make sure we have an entry for the current display. (let ((mydisp (cdr (assq 'display (frame-parameters (selected-frame)))))) (talk-add-display mydisp)) ;; Make sure we have an entry for the specified display. (talk-add-display display) ;; Add the new buffers to all talk frames. (talk-update-buffers)) (defun talk-add-display (display) (let* ((elt (assoc display talk-display-alist)) (name (concat "*talk-" display "*")) buffer frame) (if (not (and elt (frame-live-p (setq frame (nth 1 elt))))) (setq frame (make-frame-on-display display (list (cons 'name name))))) (if (not (and elt (buffer-name (get-buffer (setq buffer (nth 2 elt)))))) (setq buffer (get-buffer-create name))) (setq talk-display-alist (cons (list display frame buffer) (delq elt talk-display-alist))))) (defun talk-disconnect () "Disconnect this display from the Emacs talk group." (interactive) (let* ((mydisp (cdr (assq 'display (frame-parameters (selected-frame))))) (elt (assoc mydisp talk-display-alist))) (delete-frame (nth 1 elt)) (kill-buffer (nth 2 elt)) (setq talk-display-alist (delq elt talk-display-alist)) (talk-update-buffers))) (defun talk-update-buffers () "Update all the talk frames so that each shows all the talk buffers." (let ((tail talk-display-alist)) (while tail (let ((frame (nth 1 (car tail))) (this-buffer (nth 2 (car tail))) (buffers (mapcar (function (lambda (elt) (nth 2 elt))) talk-display-alist))) ;; Put this display's own talk buffer ;; at the front of the list. (setq buffers (cons this-buffer (delq this-buffer buffers))) (talk-split-up-frame frame buffers)) (setq tail (cdr tail))))) (defun talk-split-up-frame (frame buffers) "Split FRAME into equal-sized windows displaying the buffers in BUFFERS. Select the first of these windows, displaying the first of the buffers." (let ((lines-per-buffer (/ (frame-height frame) (length buffers))) (old-frame (selected-frame))) (unwind-protect (progn (select-frame frame) (select-window (frame-first-window frame)) (delete-other-windows) (while (progn (switch-to-buffer (car buffers)) (setq buffers (cdr buffers))) (split-window-vertically lines-per-buffer) (other-window 1)) (select-window (frame-first-window frame))) (select-frame old-frame)))) ;;; talk.el ends here emacs-19.30/lisp/tar-mode.el100444 12120 1 132014 6004266145 14145 0ustar rmsdaemon;;; tar-mode.el --- simple editing of tar files from GNU emacs ;;; Copyright (C) 1990, 1991, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Jamie Zawinski ;; Created: 04 Apr 1990 ;; Keywords: unix ;;; 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 package attempts to make dealing with Unix 'tar' archives easier. ;;; When this code is loaded, visiting a file whose name ends in '.tar' will ;;; cause the contents of that archive file to be displayed in a Dired-like ;;; listing. It is then possible to use the customary Dired keybindings to ;;; extract sub-files from that archive, either by reading them into their own ;;; editor buffers, or by copying them directly to arbitrary files on disk. ;;; It is also possible to delete sub-files from within the tar file and write ;;; the modified archive back to disk, or to edit sub-files within the archive ;;; and re-insert the modified files into the archive. See the documentation ;;; string of tar-mode for more info. ;;; This code now understands the extra fields that GNU tar adds to tar files. ;;; This interacts correctly with "uncompress.el" in the Emacs library, ;;; which you get with ;;; ;;; (autoload 'uncompress-while-visiting "uncompress") ;;; (setq auto-mode-alist (cons '("\\.Z$" . uncompress-while-visiting) ;;; auto-mode-alist)) ;;; ;;; Do not attempt to use tar-mode.el with crypt.el, you will lose. ;;; *************** TO DO *************** ;;; ;;; o chmod should understand "a+x,og-w". ;;; ;;; o It's not possible to add a NEW file to a tar archive; not that ;;; important, but still... ;;; ;;; o The code is less efficient that it could be - in a lot of places, I ;;; pull a 512-character string out of the buffer and parse it, when I could ;;; be parsing it in place, not garbaging a string. Should redo that. ;;; ;;; o I'd like a command that searches for a string/regexp in every subfile ;;; of an archive, where would leave you in a subfile-edit buffer. ;;; (Like the Meta-R command of the Zmacs mail reader.) ;;; ;;; o Sometimes (but not always) reverting the tar-file buffer does not ;;; re-grind the listing, and you are staring at the binary tar data. ;;; Typing 'g' again immediately after that will always revert and re-grind ;;; it, though. I have no idea why this happens. ;;; ;;; o Tar-mode interacts poorly with crypt.el and zcat.el because the tar ;;; write-file-hook actually writes the file. Instead it should remove the ;;; header (and conspire to put it back afterwards) so that other write-file ;;; hooks which frob the buffer have a chance to do their dirty work. There ;;; might be a problem if the tar write-file-hook does not come *first* on ;;; the list. ;;; ;;; o Block files, sparse files, continuation files, and the various header ;;; types aren't editable. Actually I don't know that they work at all. ;;; Rationale: ;;; Why does tar-mode edit the file itself instead of using tar? ;;; That means that you can edit tar files which you don't have room for ;;; on your local disk. ;;; I don't know about recent features in gnu tar, but old versions of tar ;;; can't replace a file in the middle of a tar file with a new version. ;;; Tar-mode can. I don't think tar can do things like chmod the subfiles. ;;; An implementation which involved unpacking and repacking the file into ;;; some scratch directory would be very wasteful, and wouldn't be able to ;;; preserve the file owners. ;;; Code: (defvar tar-anal-blocksize 20 "*The blocksize of tar files written by Emacs, or nil, meaning don't care. The blocksize of a tar file is not really the size of the blocks; rather, it is the number of blocks written with one system call. When tarring to a tape, this is the size of the *tape* blocks, but when writing to a file, it doesn't matter much. The only noticeable difference is that if a tar file does not have a blocksize of 20, tar will tell you that; all this really controls is how many null padding bytes go on the end of the tar file.") (defvar tar-update-datestamp nil "*Non-nil means tar-mode should play fast and loose with sub-file datestamps. If this is true, then editing and saving a tar file entry back into its tar file will update its datestamp. If false, the datestamp is unchanged. You may or may not want this - it is good in that you can tell when a file in a tar archive has been changed, but it is bad for the same reason that editing a file in the tar archive at all is bad - the changed version of the file never exists on disk.") (defvar tar-mode-show-date nil "*Non-nil means Tar mode should show the date/time of each subfile. This information is useful, but it takes screen space away from file names.") (defvar tar-parse-info nil) (defvar tar-header-offset nil) (defvar tar-superior-buffer nil) (defvar tar-superior-descriptor nil) (defvar tar-subfile-mode nil) (put 'tar-parse-info 'permanent-local t) (put 'tar-header-offset 'permanent-local t) (put 'tar-superior-buffer 'permanent-local t) (put 'tar-superior-descriptor 'permanent-local t) ;;; First, duplicate some Common Lisp functions; I used to just (require 'cl) ;;; but "cl.el" was messing some people up (also it's really big). (defmacro tar-setf (form val) "A mind-numbingly simple implementation of setf." (let ((mform (macroexpand form (and (boundp 'byte-compile-macro-environment) byte-compile-macro-environment)))) (cond ((symbolp mform) (list 'setq mform val)) ((not (consp mform)) (error "can't setf %s" form)) ((eq (car mform) 'aref) (list 'aset (nth 1 mform) (nth 2 mform) val)) ((eq (car mform) 'car) (list 'setcar (nth 1 mform) val)) ((eq (car mform) 'cdr) (list 'setcdr (nth 1 mform) val)) (t (error "don't know how to setf %s" form))))) (defmacro tar-dolist (control &rest body) "syntax: (dolist (var-name list-expr &optional return-value) &body body)" (let ((var (car control)) (init (car (cdr control))) (val (car (cdr (cdr control))))) (list 'let (list (list '_dolist_iterator_ init)) (list 'while '_dolist_iterator_ (cons 'let (cons (list (list var '(car _dolist_iterator_))) (append body (list (list 'setq '_dolist_iterator_ (list 'cdr '_dolist_iterator_))))))) val))) (defmacro tar-dotimes (control &rest body) "syntax: (dolist (var-name count-expr &optional return-value) &body body)" (let ((var (car control)) (n (car (cdr control))) (val (car (cdr (cdr control))))) (list 'let (list (list '_dotimes_end_ n) (list var 0)) (cons 'while (cons (list '< var '_dotimes_end_) (append body (list (list 'setq var (list '1+ var)))))) val))) ;;; down to business. (defmacro make-tar-header (name mode uid git size date ck lt ln magic uname gname devmaj devmin) (list 'vector name mode uid git size date ck lt ln magic uname gname devmaj devmin)) (defmacro tar-header-name (x) (list 'aref x 0)) (defmacro tar-header-mode (x) (list 'aref x 1)) (defmacro tar-header-uid (x) (list 'aref x 2)) (defmacro tar-header-gid (x) (list 'aref x 3)) (defmacro tar-header-size (x) (list 'aref x 4)) (defmacro tar-header-date (x) (list 'aref x 5)) (defmacro tar-header-checksum (x) (list 'aref x 6)) (defmacro tar-header-link-type (x) (list 'aref x 7)) (defmacro tar-header-link-name (x) (list 'aref x 8)) (defmacro tar-header-magic (x) (list 'aref x 9)) (defmacro tar-header-uname (x) (list 'aref x 10)) (defmacro tar-header-gname (x) (list 'aref x 11)) (defmacro tar-header-dmaj (x) (list 'aref x 12)) (defmacro tar-header-dmin (x) (list 'aref x 13)) (defmacro make-tar-desc (data-start tokens) (list 'cons data-start tokens)) (defmacro tar-desc-data-start (x) (list 'car x)) (defmacro tar-desc-tokens (x) (list 'cdr x)) (defconst tar-name-offset 0) (defconst tar-mode-offset (+ tar-name-offset 100)) (defconst tar-uid-offset (+ tar-mode-offset 8)) (defconst tar-gid-offset (+ tar-uid-offset 8)) (defconst tar-size-offset (+ tar-gid-offset 8)) (defconst tar-time-offset (+ tar-size-offset 12)) (defconst tar-chk-offset (+ tar-time-offset 12)) (defconst tar-linkp-offset (+ tar-chk-offset 8)) (defconst tar-link-offset (+ tar-linkp-offset 1)) ;;; GNU-tar specific slots. (defconst tar-magic-offset (+ tar-link-offset 100)) (defconst tar-uname-offset (+ tar-magic-offset 8)) (defconst tar-gname-offset (+ tar-uname-offset 32)) (defconst tar-dmaj-offset (+ tar-gname-offset 32)) (defconst tar-dmin-offset (+ tar-dmaj-offset 8)) (defconst tar-end-offset (+ tar-dmin-offset 8)) (defun tar-header-block-tokenize (string) "Return a `tar-header' structure. This is a list of name, mode, uid, gid, size, write-date, checksum, link-type, and link-name." (cond ((< (length string) 512) nil) (;(some 'plusp string) ; <-- oops, massive cycle hog! (or (not (= 0 (aref string 0))) ; This will do. (not (= 0 (aref string 101)))) (let* ((name-end (1- tar-mode-offset)) (link-end (1- tar-magic-offset)) (uname-end (1- tar-gname-offset)) (gname-end (1- tar-dmaj-offset)) (link-p (aref string tar-linkp-offset)) (magic-str (substring string tar-magic-offset (1- tar-uname-offset))) (uname-valid-p (or (string= "ustar " magic-str) (string= "GNUtar " magic-str))) name (nulsexp "[^\000]*\000")) (and (string-match nulsexp string tar-name-offset) (setq name-end (min name-end (1- (match-end 0))))) (and (string-match nulsexp string tar-link-offset) (setq link-end (min link-end (1- (match-end 0))))) (and (string-match nulsexp string tar-uname-offset) (setq uname-end (min uname-end (1- (match-end 0))))) (and (string-match nulsexp string tar-gname-offset) (setq gname-end (min gname-end (1- (match-end 0))))) (setq name (substring string tar-name-offset name-end) link-p (if (or (= link-p 0) (= link-p ?0)) nil (- link-p ?0))) (if (and (null link-p) (string-match "/$" name)) (setq link-p 5)) ; directory (make-tar-header name (tar-parse-octal-integer string tar-mode-offset (1- tar-uid-offset)) (tar-parse-octal-integer string tar-uid-offset (1- tar-gid-offset)) (tar-parse-octal-integer string tar-gid-offset (1- tar-size-offset)) (tar-parse-octal-integer string tar-size-offset (1- tar-time-offset)) (tar-parse-octal-long-integer string tar-time-offset (1- tar-chk-offset)) (tar-parse-octal-integer string tar-chk-offset (1- tar-linkp-offset)) link-p (substring string tar-link-offset link-end) uname-valid-p (and uname-valid-p (substring string tar-uname-offset uname-end)) (and uname-valid-p (substring string tar-gname-offset gname-end)) (tar-parse-octal-integer string tar-dmaj-offset (1- tar-dmin-offset)) (tar-parse-octal-integer string tar-dmin-offset (1- tar-end-offset)) ))) (t 'empty-tar-block))) (defun tar-parse-octal-integer (string &optional start end) (if (null start) (setq start 0)) (if (null end) (setq end (length string))) (if (= (aref string start) 0) 0 (let ((n 0)) (while (< start end) (setq n (if (< (aref string start) ?0) n (+ (* n 8) (- (aref string start) ?0))) start (1+ start))) n))) (defun tar-parse-octal-long-integer (string &optional start end) (if (null start) (setq start 0)) (if (null end) (setq end (length string))) (if (= (aref string start) 0) (list 0 0) (let ((lo 0) (hi 0)) (while (< start end) (if (>= (aref string start) ?0) (setq lo (+ (* lo 8) (- (aref string start) ?0)) hi (+ (* hi 8) (ash lo -16)) lo (logand lo 65535))) (setq start (1+ start))) (list hi lo)))) (defun tar-parse-octal-integer-safe (string) (let ((L (length string))) (if (= L 0) (error "empty string")) (tar-dotimes (i L) (if (or (< (aref string i) ?0) (> (aref string i) ?7)) (error "'%c' is not an octal digit")))) (tar-parse-octal-integer string)) (defun tar-header-block-checksum (string) "Compute and return a tar-acceptable checksum for this block." (let* ((chk-field-start tar-chk-offset) (chk-field-end (+ chk-field-start 8)) (sum 0) (i 0)) ;; Add up all of the characters except the ones in the checksum field. ;; Add that field as if it were filled with spaces. (while (< i chk-field-start) (setq sum (+ sum (aref string i)) i (1+ i))) (setq i chk-field-end) (while (< i 512) (setq sum (+ sum (aref string i)) i (1+ i))) (+ sum (* 32 8)))) (defun tar-header-block-check-checksum (hblock desired-checksum file-name) "Beep and print a warning if the checksum doesn't match." (if (not (= desired-checksum (tar-header-block-checksum hblock))) (progn (beep) (message "Invalid checksum for file %s!" file-name)))) (defun tar-header-block-recompute-checksum (hblock) "Modifies the given string to have a valid checksum field." (let* ((chk (tar-header-block-checksum hblock)) (chk-string (format "%6o" chk)) (l (length chk-string))) (aset hblock 154 0) (aset hblock 155 32) (tar-dotimes (i l) (aset hblock (- 153 i) (aref chk-string (- l i 1))))) hblock) (defun tar-clip-time-string (time) (let ((str (current-time-string time))) (concat (substring str 4 16) (substring str 19 24)))) (defun tar-grind-file-mode (mode string start) "Store `-rw--r--r--' indicating MODE into STRING beginning at START. MODE should be an integer which is a file mode value." (aset string start (if (zerop (logand 256 mode)) ?- ?r)) (aset string (+ start 1) (if (zerop (logand 128 mode)) ?- ?w)) (aset string (+ start 2) (if (zerop (logand 64 mode)) ?- ?x)) (aset string (+ start 3) (if (zerop (logand 32 mode)) ?- ?r)) (aset string (+ start 4) (if (zerop (logand 16 mode)) ?- ?w)) (aset string (+ start 5) (if (zerop (logand 8 mode)) ?- ?x)) (aset string (+ start 6) (if (zerop (logand 4 mode)) ?- ?r)) (aset string (+ start 7) (if (zerop (logand 2 mode)) ?- ?w)) (aset string (+ start 8) (if (zerop (logand 1 mode)) ?- ?x)) (if (zerop (logand 1024 mode)) nil (aset string (+ start 2) ?s)) (if (zerop (logand 2048 mode)) nil (aset string (+ start 5) ?s)) string) (defun tar-header-block-summarize (tar-hblock &optional mod-p) "Returns a line similar to the output of `tar -vtf'." (let ((name (tar-header-name tar-hblock)) (mode (tar-header-mode tar-hblock)) (uid (tar-header-uid tar-hblock)) (gid (tar-header-gid tar-hblock)) (uname (tar-header-uname tar-hblock)) (gname (tar-header-gname tar-hblock)) (size (tar-header-size tar-hblock)) (time (tar-header-date tar-hblock)) (ck (tar-header-checksum tar-hblock)) (link-p (tar-header-link-type tar-hblock)) (link-name (tar-header-link-name tar-hblock)) ) (let* ((left 11) (namew 8) (groupw 8) (sizew 8) (datew (if tar-mode-show-date 18 0)) (slash (1- (+ left namew))) (lastdigit (+ slash groupw sizew)) (datestart (+ lastdigit 2)) (namestart (+ datestart datew)) (string (make-string (+ namestart (length name) (if link-p (+ 5 (length link-name)) 0)) 32)) (type (tar-header-link-type tar-hblock))) (aset string 0 (if mod-p ?* ? )) (aset string 1 (cond ((or (eq type nil) (eq type 0)) ?-) ((eq type 1) ?l) ; link ((eq type 2) ?s) ; symlink ((eq type 3) ?c) ; char special ((eq type 4) ?b) ; block special ((eq type 5) ?d) ; directory ((eq type 6) ?p) ; FIFO/pipe ((eq type 20) ?*) ; directory listing ((eq type 29) ?M) ; multivolume continuation ((eq type 35) ?S) ; sparse ((eq type 38) ?V) ; volume header )) (tar-grind-file-mode mode string 2) (setq uid (if (= 0 (length uname)) (int-to-string uid) uname)) (setq gid (if (= 0 (length gname)) (int-to-string gid) gname)) (setq size (int-to-string size)) (setq time (tar-clip-time-string time)) (tar-dotimes (i (min (1- namew) (length uid))) (aset string (- slash i) (aref uid (- (length uid) i 1)))) (aset string (1+ slash) ?/) (tar-dotimes (i (min (1- groupw) (length gid))) (aset string (+ (+ slash 2) i) (aref gid i))) (tar-dotimes (i (min sizew (length size))) (aset string (- lastdigit i) (aref size (- (length size) i 1)))) (if tar-mode-show-date (tar-dotimes (i (length time)) (aset string (+ datestart i) (aref time i)))) (tar-dotimes (i (length name)) (aset string (+ namestart i) (aref name i))) (if (or (eq link-p 1) (eq link-p 2)) (progn (tar-dotimes (i 3) (aset string (+ namestart 1 (length name) i) (aref (if (= link-p 1) "==>" "-->") i))) (tar-dotimes (i (length link-name)) (aset string (+ namestart 5 (length name) i) (aref link-name i))))) (put-text-property namestart (length string) 'mouse-face 'highlight string) string))) (defun tar-summarize-buffer () "Parse the contents of the tar file in the current buffer. Place a dired-like listing on the front; then narrow to it, so that only that listing is visible (and the real data of the buffer is hidden)." (message "Parsing tar file...") (let* ((result '()) (pos 1) (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end. (bs100 (max 1 (/ bs 100))) tokens) (while (and (<= (+ pos 512) (point-max)) (not (eq 'empty-tar-block (setq tokens (tar-header-block-tokenize (buffer-substring pos (+ pos 512))))))) (setq pos (+ pos 512)) (message "Parsing tar file...%d%%" ;(/ (* pos 100) bs) ; this gets round-off lossage (/ pos bs100) ; this doesn't ) (if (eq (tar-header-link-type tokens) 20) ;; Foo. There's an extra empty block after these. (setq pos (+ pos 512))) (let ((size (tar-header-size tokens))) (if (< size 0) (error "%s has size %s - corrupted" (tar-header-name tokens) size)) ; ; This is just too slow. Don't really need it anyway.... ;(tar-header-block-check-checksum ; hblock (tar-header-block-checksum hblock) ; (tar-header-name tokens)) (setq result (cons (make-tar-desc pos tokens) result)) (and (null (tar-header-link-type tokens)) (> size 0) (setq pos (+ pos 512 (ash (ash (1- size) -9) 9)) ; this works ;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't )))) (make-local-variable 'tar-parse-info) (setq tar-parse-info (nreverse result)) ;; A tar file should end with a block or two of nulls, ;; but let's not get a fatal error if it doesn't. (if (eq tokens 'empty-tar-block) (message "Parsing tar file...done.") (message "Warning: premature EOF parsing tar file"))) (save-excursion (goto-char (point-min)) (let ((buffer-read-only nil)) (tar-dolist (tar-desc tar-parse-info) (insert-string (tar-header-block-summarize (tar-desc-tokens tar-desc))) (insert-string "\n")) (make-local-variable 'tar-header-offset) (setq tar-header-offset (point)) (narrow-to-region 1 tar-header-offset) (set-buffer-modified-p nil)))) (defvar tar-mode-map nil "*Local keymap for Tar mode listings.") (if tar-mode-map nil (setq tar-mode-map (make-keymap)) (suppress-keymap tar-mode-map) (define-key tar-mode-map " " 'tar-next-line) (define-key tar-mode-map "c" 'tar-copy) (define-key tar-mode-map "d" 'tar-flag-deleted) (define-key tar-mode-map "\^D" 'tar-flag-deleted) (define-key tar-mode-map "e" 'tar-extract) (define-key tar-mode-map "f" 'tar-extract) (define-key tar-mode-map "\C-m" 'tar-extract) (define-key tar-mode-map [mouse-2] 'tar-mouse-extract) (define-key tar-mode-map "g" 'revert-buffer) (define-key tar-mode-map "h" 'describe-mode) (define-key tar-mode-map "n" 'tar-next-line) (define-key tar-mode-map "\^N" 'tar-next-line) (define-key tar-mode-map "o" 'tar-extract-other-window) (define-key tar-mode-map "p" 'tar-previous-line) (define-key tar-mode-map "\^P" 'tar-previous-line) (define-key tar-mode-map "r" 'tar-rename-entry) (define-key tar-mode-map "u" 'tar-unflag) (define-key tar-mode-map "v" 'tar-view) (define-key tar-mode-map "x" 'tar-expunge) (define-key tar-mode-map "\177" 'tar-unflag-backwards) (define-key tar-mode-map "E" 'tar-extract-other-window) (define-key tar-mode-map "M" 'tar-chmod-entry) (define-key tar-mode-map "G" 'tar-chgrp-entry) (define-key tar-mode-map "O" 'tar-chown-entry) ) ;; Make menu bar items. ;; Get rid of the Edit menu bar item to save space. (define-key tar-mode-map [menu-bar edit] 'undefined) (define-key tar-mode-map [menu-bar immediate] (cons "Immediate" (make-sparse-keymap "Immediate"))) (define-key tar-mode-map [menu-bar immediate view] '("View This File" . tar-view)) (define-key tar-mode-map [menu-bar immediate display] '("Display in Other Window" . tar-display-other-file)) (define-key tar-mode-map [menu-bar immediate find-file-other-window] '("Find in Other Window" . tar-extract-other-window)) (define-key tar-mode-map [menu-bar immediate find-file] '("Find This File" . tar-extract)) (define-key tar-mode-map [menu-bar mark] (cons "Mark" (make-sparse-keymap "Mark"))) (define-key tar-mode-map [menu-bar mark unmark-all] '("Unmark All" . tar-clear-modification-flags)) (define-key tar-mode-map [menu-bar mark deletion] '("Flag" . tar-flag-deleted)) (define-key tar-mode-map [menu-bar mark unmark] '("Unflag" . tar-unflag)) (define-key tar-mode-map [menu-bar operate] (cons "Operate" (make-sparse-keymap "Operate"))) (define-key tar-mode-map [menu-bar operate chown] '("Change Owner..." . tar-chown-entry)) (define-key tar-mode-map [menu-bar operate chgrp] '("Change Group..." . tar-chgrp-entry)) (define-key tar-mode-map [menu-bar operate chmod] '("Change Mode..." . tar-chmod-entry)) (define-key tar-mode-map [menu-bar operate rename] '("Rename to..." . tar-rename-entry)) (define-key tar-mode-map [menu-bar operate copy] '("Copy to..." . tar-copy)) (define-key tar-mode-map [menu-bar operate expunge] '("Expunge Marked Files" . tar-expunge)) ;; tar mode is suitable only for specially formatted data. (put 'tar-mode 'mode-class 'special) (put 'tar-subfile-mode 'mode-class 'special) ;;;###autoload (defun tar-mode () "Major mode for viewing a tar file as a dired-like listing of its contents. You can move around using the usual cursor motion commands. Letters no longer insert themselves. Type `e' to pull a file out of the tar file and into its own buffer; or click mouse-2 on the file's line in the Tar mode buffer. Type `c' to copy an entry from the tar file into another file on disk. If you edit a sub-file of this archive (as with the `e' command) and save it with Control-x Control-s, the contents of that buffer will be saved back into the tar-file buffer; in this way you can edit a file inside of a tar archive without extracting it and re-archiving it. See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. \\{tar-mode-map}" ;; this is not interactive because you shouldn't be turning this ;; mode on and off. You can corrupt things that way. ;; rms: with permanent locals, it should now be possible to make this work ;; interactively in some reasonable fashion. (kill-all-local-variables) (make-local-variable 'tar-header-offset) (make-local-variable 'tar-parse-info) (make-local-variable 'require-final-newline) (setq require-final-newline nil) ; binary data, dude... (make-local-variable 'revert-buffer-function) (setq revert-buffer-function 'tar-mode-revert) (make-local-variable 'enable-local-variables) (setq enable-local-variables nil) (make-local-variable 'next-line-add-newlines) (setq next-line-add-newlines nil) (setq major-mode 'tar-mode) (setq mode-name "Tar") (use-local-map tar-mode-map) (auto-save-mode 0) (make-local-variable 'write-contents-hooks) (setq write-contents-hooks '(tar-mode-write-file)) (widen) (if (and (boundp 'tar-header-offset) tar-header-offset) (narrow-to-region 1 tar-header-offset) (tar-summarize-buffer)) (run-hooks 'tar-mode-hook) ) (defun tar-subfile-mode (p) "Minor mode for editing an element of a tar-file. This mode redefines the save-buffer command to save the current buffer back into its associated tar-file buffer. You must save that buffer to actually save your changes to disk." (interactive "P") (or (and (boundp 'tar-superior-buffer) tar-superior-buffer) (error "This buffer is not an element of a tar file")) ;;; Don't do this, because it is redundant and wastes mode line space. ;;; (or (assq 'tar-subfile-mode minor-mode-alist) ;;; (setq minor-mode-alist (append minor-mode-alist ;;; (list '(tar-subfile-mode " TarFile"))))) (make-local-variable 'tar-subfile-mode) (setq tar-subfile-mode (if (null p) (not tar-subfile-mode) (> (prefix-numeric-value p) 0))) (cond (tar-subfile-mode (make-local-variable 'local-write-file-hooks) (setq local-write-file-hooks '(tar-subfile-save-buffer)) ;; turn off auto-save. (auto-save-mode nil) (setq buffer-auto-save-file-name nil) (run-hooks 'tar-subfile-mode-hook)) (t (kill-local-variable 'local-write-file-hooks)))) ;; Revert the buffer and recompute the dired-like listing. (defun tar-mode-revert (&optional no-autosave no-confirm) (setq tar-header-offset nil) (let ((revert-buffer-function nil)) (revert-buffer t no-confirm) (widen)) (tar-mode)) (defun tar-next-line (p) (interactive "p") (forward-line p) (if (eobp) nil (forward-char (if tar-mode-show-date 54 36)))) (defun tar-previous-line (p) (interactive "p") (tar-next-line (- p))) (defun tar-current-descriptor (&optional noerror) "Return the tar-descriptor of the current line, or signals an error." ;; I wish lines had plists, like in ZMACS... (or (nth (count-lines (point-min) (save-excursion (beginning-of-line) (point))) tar-parse-info) (if noerror nil (error "This line does not describe a tar-file entry")))) (defun tar-get-descriptor () (let* ((descriptor (tar-current-descriptor)) (tokens (tar-desc-tokens descriptor)) (size (tar-header-size tokens)) (link-p (tar-header-link-type tokens))) (if link-p (error "This is a %s, not a real file" (cond ((eq link-p 5) "directory") ((eq link-p 20) "tar directory header") ((eq link-p 29) "multivolume-continuation") ((eq link-p 35) "sparse entry") ((eq link-p 38) "volume header") (t "link")))) (if (zerop size) (error "This is a zero-length file")) descriptor)) (defun tar-mouse-extract (event) "Extract a file whose tar directory line you click on." (interactive "e") (save-excursion (set-buffer (window-buffer (posn-window (event-end event)))) (save-excursion (goto-char (posn-point (event-end event))) ;; Just make sure this doesn't get an error. (tar-get-descriptor))) (select-window (posn-window (event-end event))) (goto-char (posn-point (event-end event))) (tar-extract)) (defun tar-extract (&optional other-window-p) "In Tar mode, extract this entry of the tar file into its own buffer." (interactive) (let* ((view-p (eq other-window-p 'view)) (descriptor (tar-get-descriptor)) (tokens (tar-desc-tokens descriptor)) (name (tar-header-name tokens)) (size (tar-header-size tokens)) (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) (end (+ start size))) (let* ((tar-buffer (current-buffer)) (tarname (file-name-nondirectory (buffer-file-name))) (bufname (concat (file-name-nondirectory name) " (" tarname ")")) (read-only-p (or buffer-read-only view-p)) (buffer (get-buffer bufname)) (just-created nil)) (if buffer nil (setq buffer (get-buffer-create bufname)) (setq just-created t) (unwind-protect (progn (widen) (save-excursion (set-buffer buffer) (insert-buffer-substring tar-buffer start end) (goto-char 0) (setq buffer-file-name (expand-file-name (concat tarname ":" name))) (setq buffer-file-truename (abbreviate-file-name buffer-file-name)) ;; Set the default-directory to the dir of the ;; superior buffer. (setq default-directory (save-excursion (set-buffer tar-buffer) default-directory)) (normal-mode) ; pick a mode. (rename-buffer bufname) (make-local-variable 'tar-superior-buffer) (make-local-variable 'tar-superior-descriptor) (setq tar-superior-buffer tar-buffer) (setq tar-superior-descriptor descriptor) (tar-subfile-mode 1) (setq buffer-read-only read-only-p) (set-buffer-modified-p nil)) (set-buffer tar-buffer)) (narrow-to-region 1 tar-header-offset))) (if view-p (progn (view-buffer buffer) (and just-created ;; This will be created by view.el (setq view-exit-action 'kill-buffer))) (if (eq other-window-p 'display) (display-buffer buffer) (if other-window-p (switch-to-buffer-other-window buffer) (switch-to-buffer buffer))))))) (defun tar-extract-other-window () "*In Tar mode, find this entry of the tar file in another window." (interactive) (tar-extract t)) (defun tar-display-other-window () "*In Tar mode, display this entry of the tar file in another window." (interactive) (tar-extract 'display)) (defun tar-view () "*In Tar mode, view the tar file entry on this line." (interactive) (tar-extract 'view)) (defun tar-read-file-name (&optional prompt) "Read a file name with this line's entry as the default." (or prompt (setq prompt "Copy to: ")) (let* ((default-file (expand-file-name (tar-header-name (tar-desc-tokens (tar-current-descriptor))))) (target (expand-file-name (read-file-name prompt (file-name-directory default-file) default-file nil)))) (if (or (string= "" (file-name-nondirectory target)) (file-directory-p target)) (setq target (concat (if (string-match "/$" target) (substring target 0 (1- (match-end 0))) target) "/" (file-name-nondirectory default-file)))) target)) (defun tar-copy (&optional to-file) "*In Tar mode, extract this entry of the tar file into a file on disk. If TO-FILE is not supplied, it is prompted for, defaulting to the name of the current tar-entry." (interactive (list (tar-read-file-name))) (let* ((descriptor (tar-get-descriptor)) (tokens (tar-desc-tokens descriptor)) (name (tar-header-name tokens)) (size (tar-header-size tokens)) (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) (end (+ start size)) (inhibit-file-name-handlers inhibit-file-name-handlers) (inhibit-file-name-operation inhibit-file-name-operation)) (save-restriction (widen) ;; Inhibit compressing a subfile again if *both* name and ;; to-file are handled by jka-compr (if (and (eq (find-file-name-handler name 'write-region) 'jka-compr-handler) (eq (find-file-name-handler to-file 'write-region) 'jka-compr-handler)) (setq inhibit-file-name-handlers (cons 'jka-compr-handler (and (eq inhibit-file-name-operation 'write-region) inhibit-file-name-handlers)) inhibit-file-name-operation 'write-region)) (write-region start end to-file)) (message "Copied tar entry %s to %s" name to-file))) (defun tar-flag-deleted (p &optional unflag) "*In Tar mode, mark this sub-file to be deleted from the tar file. With a prefix argument, mark that many files." (interactive "p") (beginning-of-line) (tar-dotimes (i (if (< p 0) (- p) p)) (if (tar-current-descriptor unflag) ; barf if we're not on an entry-line. (progn (delete-char 1) (insert (if unflag " " "D")))) (forward-line (if (< p 0) -1 1))) (if (eobp) nil (forward-char 36))) (defun tar-unflag (p) "*In Tar mode, un-mark this sub-file if it is marked to be deleted. With a prefix argument, un-mark that many files forward." (interactive "p") (tar-flag-deleted p t)) (defun tar-unflag-backwards (p) "*In Tar mode, un-mark this sub-file if it is marked to be deleted. With a prefix argument, un-mark that many files backward." (interactive "p") (tar-flag-deleted (- p) t)) (defun tar-expunge-internal () "Expunge the tar-entry specified by the current line." (let* ((descriptor (tar-current-descriptor)) (tokens (tar-desc-tokens descriptor)) (line (tar-desc-data-start descriptor)) (name (tar-header-name tokens)) (size (tar-header-size tokens)) (link-p (tar-header-link-type tokens)) (start (tar-desc-data-start descriptor)) (following-descs (cdr (memq descriptor tar-parse-info)))) (if link-p (setq size 0)) ; size lies for hard-links. ;; ;; delete the current line... (beginning-of-line) (let ((line-start (point))) (end-of-line) (forward-char) (let ((line-len (- (point) line-start))) (delete-region line-start (point)) ;; ;; decrement the header-pointer to be in synch... (setq tar-header-offset (- tar-header-offset line-len)))) ;; ;; delete the data pointer... (setq tar-parse-info (delq descriptor tar-parse-info)) ;; ;; delete the data from inside the file... (widen) (let* ((data-start (+ start tar-header-offset -513)) (data-end (+ data-start 512 (ash (ash (+ size 511) -9) 9)))) (delete-region data-start data-end) ;; ;; and finally, decrement the start-pointers of all following ;; entries in the archive. This is a pig when deleting a bunch ;; of files at once - we could optimize this to only do the ;; iteration over the files that remain, or only iterate up to ;; the next file to be deleted. (let ((data-length (- data-end data-start))) (tar-dolist (desc following-descs) (tar-setf (tar-desc-data-start desc) (- (tar-desc-data-start desc) data-length)))) )) (narrow-to-region 1 tar-header-offset)) (defun tar-expunge (&optional noconfirm) "*In Tar mode, delete all the archived files flagged for deletion. This does not modify the disk image; you must save the tar file itself for this to be permanent." (interactive) (if (or noconfirm (y-or-n-p "Expunge files marked for deletion? ")) (let ((n 0)) (save-excursion (goto-char 0) (while (not (eobp)) (if (looking-at "D") (progn (tar-expunge-internal) (setq n (1+ n))) (forward-line 1))) ;; after doing the deletions, add any padding that may be necessary. (tar-pad-to-blocksize) (narrow-to-region 1 tar-header-offset) ) (if (zerop n) (message "Nothing to expunge.") (message "%s files expunged. Be sure to save this buffer." n))))) (defun tar-clear-modification-flags () "Remove the stars at the beginning of each line." (interactive) (save-excursion (goto-char 1) (while (< (point) tar-header-offset) (if (not (eq (following-char) ?\ )) (progn (delete-char 1) (insert " "))) (forward-line 1)))) (defun tar-chown-entry (new-uid) "*Change the user-id associated with this entry in the tar file. If this tar file was written by GNU tar, then you will be able to edit the user id as a string; otherwise, you must edit it as a number. You can force editing as a number by calling this with a prefix arg. This does not modify the disk image; you must save the tar file itself for this to be permanent." (interactive (list (let ((tokens (tar-desc-tokens (tar-current-descriptor)))) (if (or current-prefix-arg (not (tar-header-magic tokens))) (let (n) (while (not (numberp (setq n (read-minibuffer "New UID number: " (format "%s" (tar-header-uid tokens))))))) n) (read-string "New UID string: " (tar-header-uname tokens)))))) (cond ((stringp new-uid) (tar-setf (tar-header-uname (tar-desc-tokens (tar-current-descriptor))) new-uid) (tar-alter-one-field tar-uname-offset (concat new-uid "\000"))) (t (tar-setf (tar-header-uid (tar-desc-tokens (tar-current-descriptor))) new-uid) (tar-alter-one-field tar-uid-offset (concat (substring (format "%6o" new-uid) 0 6) "\000 "))))) (defun tar-chgrp-entry (new-gid) "*Change the group-id associated with this entry in the tar file. If this tar file was written by GNU tar, then you will be able to edit the group id as a string; otherwise, you must edit it as a number. You can force editing as a number by calling this with a prefix arg. This does not modify the disk image; you must save the tar file itself for this to be permanent." (interactive (list (let ((tokens (tar-desc-tokens (tar-current-descriptor)))) (if (or current-prefix-arg (not (tar-header-magic tokens))) (let (n) (while (not (numberp (setq n (read-minibuffer "New GID number: " (format "%s" (tar-header-gid tokens))))))) n) (read-string "New GID string: " (tar-header-gname tokens)))))) (cond ((stringp new-gid) (tar-setf (tar-header-gname (tar-desc-tokens (tar-current-descriptor))) new-gid) (tar-alter-one-field tar-gname-offset (concat new-gid "\000"))) (t (tar-setf (tar-header-gid (tar-desc-tokens (tar-current-descriptor))) new-gid) (tar-alter-one-field tar-gid-offset (concat (substring (format "%6o" new-gid) 0 6) "\000 "))))) (defun tar-rename-entry (new-name) "*Change the name associated with this entry in the tar file. This does not modify the disk image; you must save the tar file itself for this to be permanent." (interactive (list (read-string "New name: " (tar-header-name (tar-desc-tokens (tar-current-descriptor)))))) (if (string= "" new-name) (error "zero length name")) (if (> (length new-name) 98) (error "name too long")) (tar-setf (tar-header-name (tar-desc-tokens (tar-current-descriptor))) new-name) (tar-alter-one-field 0 (substring (concat new-name (make-string 99 0)) 0 99))) (defun tar-chmod-entry (new-mode) "*Change the protection bits associated with this entry in the tar file. This does not modify the disk image; you must save the tar file itself for this to be permanent." (interactive (list (tar-parse-octal-integer-safe (read-string "New protection (octal): ")))) (tar-setf (tar-header-mode (tar-desc-tokens (tar-current-descriptor))) new-mode) (tar-alter-one-field tar-mode-offset (concat (substring (format "%6o" new-mode) 0 6) "\000 "))) (defun tar-alter-one-field (data-position new-data-string) (let* ((descriptor (tar-current-descriptor)) (tokens (tar-desc-tokens descriptor))) (unwind-protect (save-excursion ;; ;; update the header-line. (beginning-of-line) (let ((p (point))) (forward-line 1) (delete-region p (point)) (insert (tar-header-block-summarize tokens) "\n") (setq tar-header-offset (point-max))) (widen) (let* ((start (+ (tar-desc-data-start descriptor) tar-header-offset -513))) ;; ;; delete the old field and insert a new one. (goto-char (+ start data-position)) (delete-region (point) (+ (point) (length new-data-string))) ; <-- (insert new-data-string) ; <-- ;; ;; compute a new checksum and insert it. (let ((chk (tar-header-block-checksum (buffer-substring start (+ start 512))))) (goto-char (+ start tar-chk-offset)) (delete-region (point) (+ (point) 8)) (insert (format "%6o" chk)) (insert 0) (insert ? ) (tar-setf (tar-header-checksum tokens) chk) ;; ;; ok, make sure we didn't botch it. (tar-header-block-check-checksum (buffer-substring start (+ start 512)) chk (tar-header-name tokens)) ))) (narrow-to-region 1 tar-header-offset)))) (defun tar-octal-time (timeval) ;; Format a timestamp as 11 octal digits. Ghod, I hope this works... (let ((hibits (car timeval)) (lobits (car (cdr timeval)))) (insert (format "%05o%01o%05o" (lsh hibits -2) (logior (lsh (logand 3 hibits) 1) (> (logand lobits 32768) 0)) (logand 32767 lobits) )))) (defun tar-subfile-save-buffer () "In tar subfile mode, save this buffer into its parent tar-file buffer. This doesn't write anything to disk; you must save the parent tar-file buffer to make your changes permanent." (interactive) (if (not (and (boundp 'tar-superior-buffer) tar-superior-buffer)) (error "This buffer has no superior tar file buffer")) (if (not (and (boundp 'tar-superior-descriptor) tar-superior-descriptor)) (error "This buffer doesn't have an index into its superior tar file!")) (save-excursion (let ((subfile (current-buffer)) (subfile-size (buffer-size)) (descriptor tar-superior-descriptor)) (set-buffer tar-superior-buffer) (let* ((tokens (tar-desc-tokens descriptor)) (start (tar-desc-data-start descriptor)) (name (tar-header-name tokens)) (size (tar-header-size tokens)) (size-pad (ash (ash (+ size 511) -9) 9)) (head (memq descriptor tar-parse-info)) (following-descs (cdr head))) (if (not head) (error "Can't find this tar file entry in its parent tar file!")) (unwind-protect (save-excursion (widen) ;; delete the old data... (let* ((data-start (+ start tar-header-offset -1)) (data-end (+ data-start (ash (ash (+ size 511) -9) 9)))) (delete-region data-start data-end) ;; insert the new data... (goto-char data-start) (insert-buffer subfile) ;; ;; pad the new data out to a multiple of 512... (let ((subfile-size-pad (ash (ash (+ subfile-size 511) -9) 9))) (goto-char (+ data-start subfile-size)) (insert (make-string (- subfile-size-pad subfile-size) 0)) ;; ;; update the data pointer of this and all following files... (tar-setf (tar-header-size tokens) subfile-size) (let ((difference (- subfile-size-pad size-pad))) (tar-dolist (desc following-descs) (tar-setf (tar-desc-data-start desc) (+ (tar-desc-data-start desc) difference)))) ;; ;; Update the size field in the header block. (let ((header-start (- data-start 512))) (goto-char (+ header-start tar-size-offset)) (delete-region (point) (+ (point) 12)) (insert (format "%11o" subfile-size)) (insert ? ) ;; ;; Maybe update the datestamp. (if (not tar-update-datestamp) nil (goto-char (+ header-start tar-time-offset)) (delete-region (point) (+ (point) 12)) (insert (tar-octal-time (current-time))) (insert ? )) ;; ;; compute a new checksum and insert it. (let ((chk (tar-header-block-checksum (buffer-substring header-start data-start)))) (goto-char (+ header-start tar-chk-offset)) (delete-region (point) (+ (point) 8)) (insert (format "%6o" chk)) (insert 0) (insert ? ) (tar-setf (tar-header-checksum tokens) chk))) ;; ;; alter the descriptor-line... ;; (let ((position (- (length tar-parse-info) (length head)))) (goto-char 1) (next-line position) (beginning-of-line) (let ((p (point)) after (m (set-marker (make-marker) tar-header-offset))) (forward-line 1) (setq after (point)) ;; Insert the new text after the old, before deleting, ;; to preserve the window start. (insert-before-markers (tar-header-block-summarize tokens t) "\n") (delete-region p after) (setq tar-header-offset (marker-position m))) ))) ;; after doing the insertion, add any final padding that may be necessary. (tar-pad-to-blocksize)) (narrow-to-region 1 tar-header-offset))) (set-buffer-modified-p t) ; mark the tar file as modified (set-buffer subfile) (set-buffer-modified-p nil) ; mark the tar subfile as unmodified (message "Saved into tar-buffer `%s'. Be sure to save that buffer!" (buffer-name tar-superior-buffer)) ;; Prevent ordinary saving from happening. t))) (defun tar-pad-to-blocksize () "If we are being anal about tar file blocksizes, fix up the current buffer. Leaves the region wide." (if (null tar-anal-blocksize) nil (widen) (let* ((last-desc (nth (1- (length tar-parse-info)) tar-parse-info)) (start (tar-desc-data-start last-desc)) (tokens (tar-desc-tokens last-desc)) (link-p (tar-header-link-type tokens)) (size (if link-p 0 (tar-header-size tokens))) (data-end (+ start size)) (bbytes (ash tar-anal-blocksize 9)) (pad-to (+ bbytes (* bbytes (/ (1- data-end) bbytes)))) (inhibit-read-only t) ; ## ) ;; If the padding after the last data is too long, delete some; ;; else insert some until we are padded out to the right number of blocks. ;; (goto-char (+ (or tar-header-offset 0) data-end)) (if (> (1+ (buffer-size)) (+ (or tar-header-offset 0) pad-to)) (delete-region (+ (or tar-header-offset 0) pad-to) (1+ (buffer-size))) (insert (make-string (- (+ (or tar-header-offset 0) pad-to) (1+ (buffer-size))) 0))) ))) ;; Used in write-file-hook to write tar-files out correctly. (defun tar-mode-write-file () (unwind-protect (save-excursion (widen) ;; Doing this here confuses things - the region gets left too wide! ;; I suppose this is run in a context where changing the buffer is bad. ;; (tar-pad-to-blocksize) (write-region tar-header-offset (point-max) buffer-file-name nil t) (tar-clear-modification-flags)) (narrow-to-region 1 tar-header-offset)) ;; return T because we've written the file. t) (provide 'tar-mode) ;;; tar-mode.el ends here emacs-19.30/lisp/tcl-mode.el100444 12120 1 46407 6045205153 14130 0ustar rmsdaemon;;; tcl-mode.el --- a major-mode for editing tcl/tk scripts ;; Author: Gregor Schmid ;; Keywords: languages, processes, tools ;; Copyright (C) 1993, 1994, 1995 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. ;; Please send bug-reports, suggestions etc. to ;; ;; schmid@fb3-s7.math.tu-berlin.de ;; ;; Special Thanks to Simon Marshall for ;; font-lock patches. ;; This file was written with emacs using Jamie Lokier's folding mode ;; That's what the funny ;;{{{ marks are there for ;;{{{ Usage ;; Tcl-mode supports c-mode style formatting and sending of ;; lines/regions/files to a tcl interpreter. An interpreter (see ;; variable `tcl-default-application') will be started if you try to ;; send some code and none is running. You can use the process-buffer ;; (named after the application you chose) as if it were an ;; interactive shell. See the documentation for `comint.el' for ;; details. ;;}}} ;;{{{ Key-bindings ;; To see all the keybindings for folding mode, look at `tcl-setup-keymap' ;; or start `tcl-mode' and type `\C-h m'. ;; The keybindings may seem strange, since I prefer to use them with ;; tcl-prefix-key set to nil, but since those keybindings are already used ;; the default for `tcl-prefix-key' is `\C-c', which is the conventional ;; prefix for major-mode commands. ;; You can customise the keybindings either by setting `tcl-prefix-key' ;; or by putting the following in your .emacs ;; (setq tcl-mode-map (make-sparse-keymap)) ;; and ;; (define-key tcl-mode-map ) ;; for all the functions you need. ;;}}} ;;{{{ Variables ;; You may want to customize the following variables: ;; tcl-indent-level ;; tcl-always-show ;; tcl-mode-map ;; tcl-prefix-key ;; tcl-mode-hook ;; tcl-default-application ;; tcl-default-command-switches ;;}}} ;;; Code: ;; We need that ! (require 'comint) ;;{{{ variables (defvar tcl-default-application "wish" "Default tcl/tk application to run in tcl subprocess.") (defvar tcl-default-command-switches nil "Command switches for `tcl-default-application'. Should be a list of strings.") (defvar tcl-process nil "The active tcl subprocess corresponding to current buffer.") (defvar tcl-process-buffer nil "Buffer used for communication with tcl subprocess for current buffer.") (defvar tcl-always-show t "*Non-nil means display tcl-process-buffer after sending a command.") (defvar tcl-mode-map nil "Keymap used with tcl mode.") (defvar tcl-prefix-key "\C-c" "Prefix for all tcl-mode commands.") (defvar tcl-mode-hook nil "Hooks called when tcl mode fires up.") (defvar tcl-region-start (make-marker) "Start of special region for tcl communication.") (defvar tcl-region-end (make-marker) "End of special region for tcl communication.") (defvar tcl-indent-level 4 "Amount by which tcl subexpressions are indented.") (defvar tcl-default-eval "eval" "Default command used when sending regions.") (defvar tcl-mode-menu (make-sparse-keymap "Tcl-Mode") "Keymap for tcl-mode's menu.") (defvar tcl-font-lock-keywords (eval-when-compile (list ;; ;; Function name declarations. '("\\<\\(itcl_class\\|method\\|proc\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) ;; ;; Keywords. ;(make-regexp '("if" "then" "else" "elseif" "for" "foreach" "break" ; "continue" "while" "eval" "case" "in" "switch" "default" ; "exit" "error" "proc" "return" "uplevel" "constructor" ; "destructor" "itcl_class" "loop" "for_array_keys" ; "for_recursive_glob" "for_file")) (concat "\\<\\(" "break\\|c\\(ase\\|on\\(structor\\|tinue\\)\\)\\|" "de\\(fault\\|structor\\)\\|" "e\\(lse\\(\\|if\\)\\|rror\\|val\\|xit\\)\\|" "for\\(\\|_\\(array_keys\\|file\\|recursive_glob\\)\\|each\\)\\|" "i\\([fn]\\|tcl_class\\)\\|loop\\|proc\\|return\\|switch\\|" "then\\|uplevel\\|while" "\\)\\>") ;; ;; Types. ; (make-regexp '("global" "upvar" "inherit" "public" "protected" "common")) (cons (concat "\\<\\(common\\|global\\|inherit\\|" "p\\(rotected\\|ublic\\)\\|upvar\\)\\>") 'font-lock-type-face) )) "Default expressions to highlight in TCL modes.") (defvar tcl-imenu-generic-expression '("^[ \t]*proc[ \t]+\\(\\(\\s_\\|\\sw\\)+\\)" 1) "Imenu generic expression for tcl-mode. See `imenu-generic-expression'.") ;;}}} ;;{{{ tcl-mode ;;;###autoload (defun tcl-mode () "Major mode for editing tcl scripts. The following keys are bound: \\{tcl-mode-map} " (interactive) (let ((switches nil) s) (kill-all-local-variables) (setq major-mode 'tcl-mode) (setq mode-name "TCL") (set (make-local-variable 'tcl-process) nil) (set (make-local-variable 'tcl-process-buffer) nil) (make-local-variable 'tcl-default-command-switches) (set (make-local-variable 'indent-line-function) 'tcl-indent-line) (set (make-local-variable 'comment-start) "# ") (set (make-local-variable 'comment-start-skip) "# *") (set (make-local-variable 'font-lock-defaults) '(tcl-font-lock-keywords nil nil ((?_ . "w")))) (set (make-local-variable 'imenu-generic-expression) tcl-imenu-generic-expression) (make-local-variable 'tcl-default-eval) (or tcl-mode-map (tcl-setup-keymap)) (use-local-map tcl-mode-map) (set-syntax-table (copy-syntax-table)) (modify-syntax-entry ?# "<") (modify-syntax-entry ?\n ">") ;; look for a #!.../wish -f line at bob (save-excursion (goto-char (point-min)) (if (looking-at "#![ \t]*\\([^ \t]*\\)[ \t]\\(.*[ \t]\\)-f") (progn (set (make-local-variable 'tcl-default-application) (buffer-substring (match-beginning 1) (match-end 1))) (if (match-beginning 2) (progn (goto-char (match-beginning 2)) (set (make-local-variable 'tcl-default-command-switches) nil) (while (< (point) (match-end 2)) (setq s (read (current-buffer))) (if (<= (point) (match-end 2)) (setq tcl-default-command-switches (append tcl-default-command-switches (list (prin1-to-string s))))))))) ;; if this fails, look for the #!/bin/csh ... exec hack (while (eq (following-char) ?#) (forward-line 1)) (or (bobp) (forward-char -1)) (if (eq (preceding-char) ?\\) (progn (forward-char 1) (if (looking-at "exec[ \t]+\\([^ \t]*\\)[ \t]\\(.*[ \t]\\)*-f") (progn (set (make-local-variable 'tcl-default-application) (buffer-substring (match-beginning 1) (match-end 1))) (if (match-beginning 2) (progn (goto-char (match-beginning 2)) (set (make-local-variable 'tcl-default-command-switches) nil) (while (< (point) (match-end 2)) (setq s (read (current-buffer))) (if (<= (point) (match-end 2)) (setq tcl-default-command-switches (append tcl-default-command-switches (list (prin1-to-string s))))))))) ))))) (run-hooks 'tcl-mode-hook))) ;;}}} ;;{{{ tcl-setup-keymap (defun tcl-setup-keymap () "Set up keymap for tcl mode. If the variable `tcl-prefix-key' is nil, the bindings go directly to `tcl-mode-map', otherwise they are prefixed with `tcl-prefix-key'." (setq tcl-mode-map (make-sparse-keymap)) (define-key tcl-mode-map [menu-bar tcl-mode] (cons "Tcl-Mode" tcl-mode-menu)) (let ((map (if tcl-prefix-key (make-sparse-keymap) tcl-mode-map))) ;; indentation (define-key tcl-mode-map [?}] 'tcl-electric-brace) ;; communication (define-key map "\M-e" 'tcl-send-current-line) (define-key map "\M-r" 'tcl-send-region) (define-key map "\M-w" 'tcl-send-proc) (define-key map "\M-a" 'tcl-send-buffer) (define-key map "\M-q" 'tcl-kill-process) (define-key map "\M-u" 'tcl-restart-with-whole-file) (define-key map "\M-s" 'tcl-show-process-buffer) (define-key map "\M-h" 'tcl-hide-process-buffer) (define-key map "\M-i" 'tcl-get-error-info) (define-key map "\M-[" 'tcl-beginning-of-proc) (define-key map "\M-]" 'tcl-end-of-proc) (define-key map "\C-\M-s" 'tcl-set-tcl-region-start) (define-key map "\C-\M-e" 'tcl-set-tcl-region-end) (define-key map "\C-\M-r" 'tcl-send-tcl-region) (if tcl-prefix-key (define-key tcl-mode-map tcl-prefix-key map)) )) ;;}}} ;;{{{ indentation ;;{{{ tcl-indent-line (defun tcl-indent-line () "Indent current line as tcl code. Return the amount the indentation changed by." (let ((indent (tcl-calculate-indentation nil)) beg shift-amt (case-fold-search nil) (pos (- (point-max) (point)))) (beginning-of-line) (setq beg (point)) (skip-chars-forward " \t") (save-excursion (while (eq (following-char) ?}) (setq indent (max (- indent tcl-indent-level) 0)) (forward-char 1) (if (looking-at "\\([ \t]*\\)}") (progn (delete-region (match-beginning 1) (match-end 1)) (insert-char ? (1- tcl-indent-level)))))) (setq shift-amt (- indent (current-column))) (if (zerop shift-amt) (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) (delete-region beg (point)) (indent-to indent) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos)))) shift-amt)) ;;}}} ;;{{{ tcl-calculate-indentation (defun tcl-calculate-indentation (&optional parse-start) "Return appropriate indentation for current line as tcl code. In usual case returns an integer: the column to indent to." (let ((pos (point))) (save-excursion (if parse-start (setq pos (goto-char parse-start))) (beginning-of-line) (if (bobp) (current-indentation) (forward-char -1) (if (eq (preceding-char) ?\\) (+ (current-indentation) (progn (beginning-of-line) (if (bobp) (* 2 tcl-indent-level) (forward-char -1) (if (not (eq (preceding-char) ?\\)) (* 2 tcl-indent-level) 0)))) (forward-char 1) (if (re-search-backward "\\(^[^ \t\n\r#]\\)\\|\\({\\s *[#\n]\\)\\|\\(}\\s *\n\\)" nil t) (+ (- (current-indentation) (if (save-excursion (beginning-of-line) (and (not (bobp)) (progn (forward-char -1) (eq (preceding-char) ?\\)))) (* 2 tcl-indent-level) 0)) (if (eq (following-char) ?{) tcl-indent-level 0)) (goto-char pos) (beginning-of-line) (forward-line -1) (current-indentation))))))) ;;}}} ;;{{{ tcl-electric-brace (defun tcl-electric-brace (arg) "Insert `}' and indent line for tcl." (interactive "P") (insert-char ?} (prefix-numeric-value arg)) (tcl-indent-line) (blink-matching-open)) ;;}}} ;;}}} ;;{{{ searching ;;{{{ tcl-beginning-of-proc (defun tcl-beginning-of-proc (&optional arg) "Move backward to the beginning of a tcl proc (or similar). With argument, do it that many times. Negative arg -N means move forward to Nth following beginning of proc. Returns t unless search stops due to beginning or end of buffer." (interactive "P") (or arg (setq arg 1)) (let ((found nil) (ret t)) (if (and (< arg 0) (looking-at "^[^ \t\n#][^\n]*{[ \t]*$")) (forward-char 1)) (while (< arg 0) (if (re-search-forward "^[^ \t\n#][^\n]*{[ \t]*$" nil t) (setq arg (1+ arg) found t) (setq ret nil arg 0))) (if found (beginning-of-line)) (while (> arg 0) (if (re-search-backward "^[^ \t\n#][^\n]*{[ \t]*$" nil t) (setq arg (1- arg)) (setq ret nil arg 0))) ret)) ;;}}} ;;{{{ tcl-end-of-proc (defun tcl-end-of-proc (&optional arg) "Move forward to next end of tcl proc (or similar). With argument, do it that many times. Negative argument -N means move back to Nth preceding end of proc. This function just searches for a `}' at the beginning of a line." (interactive "P") (or arg (setq arg 1)) (let ((found nil) (ret t)) (if (and (< arg 0) (not (bolp)) (save-excursion (beginning-of-line) (eq (following-char) ?}))) (forward-char -1)) (while (> arg 0) (if (re-search-forward "^}" nil t) (setq arg (1- arg) found t) (setq ret nil arg 0))) (while (< arg 0) (if (re-search-backward "^}" nil t) (setq arg (1+ arg) found t) (setq ret nil arg 0))) (if found (end-of-line)) ret)) ;;}}} ;;}}} ;;{{{ communication with a inferior process via comint ;;{{{ tcl-start-process (defun tcl-start-process (name program &optional startfile &rest switches) "Start a tcl process named NAME, running PROGRAM." (or switches (setq switches tcl-default-command-switches)) (setq tcl-process-buffer (apply 'make-comint name program startfile switches)) (setq tcl-process (get-buffer-process tcl-process-buffer)) (save-excursion (set-buffer tcl-process-buffer) (setq comint-prompt-regexp "^[^% ]*%\\( %\\)* *")) ) ;;}}} ;;{{{ tcl-kill-process (defun tcl-kill-process () "Kill tcl subprocess and its buffer." (interactive) (if tcl-process-buffer (kill-buffer tcl-process-buffer))) ;;}}} ;;{{{ tcl-set-tcl-region-start (defun tcl-set-tcl-region-start (&optional arg) "Set start of region for use with `tcl-send-tcl-region'." (interactive) (set-marker tcl-region-start (or arg (point)))) ;;}}} ;;{{{ tcl-set-tcl-region-end (defun tcl-set-tcl-region-end (&optional arg) "Set end of region for use with `tcl-send-tcl-region'." (interactive) (set-marker tcl-region-end (or arg (point)))) ;;}}} ;;{{{ send line/region/buffer to tcl-process ;;{{{ tcl-send-current-line (defun tcl-send-current-line () "Send current line to tcl subprocess, found in `tcl-process'. If `tcl-process' is nil or dead, start a new process first." (interactive) (let ((start (save-excursion (beginning-of-line) (point))) (end (save-excursion (end-of-line) (point)))) (or (and tcl-process (eq (process-status tcl-process) 'run)) (tcl-start-process tcl-default-application tcl-default-application)) (comint-simple-send tcl-process (buffer-substring start end)) (forward-line 1) (if tcl-always-show (display-buffer tcl-process-buffer)))) ;;}}} ;;{{{ tcl-send-region (defun tcl-send-region (start end) "Send region to tcl subprocess, wrapped in `eval { ... }'." (interactive "r") (or (and tcl-process (comint-check-proc tcl-process-buffer)) (tcl-start-process tcl-default-application tcl-default-application)) (comint-simple-send tcl-process (concat tcl-default-eval " {\n"(buffer-substring start end) "\n}")) (if tcl-always-show (display-buffer tcl-process-buffer))) ;;}}} ;;{{{ tcl-send-tcl-region (defun tcl-send-tcl-region () "Send preset tcl region to tcl subprocess, wrapped in `eval { ... }'." (interactive) (or (and tcl-region-start tcl-region-end) (error "tcl-region not set")) (or (and tcl-process (comint-check-proc tcl-process-buffer)) (tcl-start-process tcl-default-application tcl-default-application)) (comint-simple-send tcl-process (concat tcl-default-eval " {\n" (buffer-substring tcl-region-start tcl-region-end) "\n}")) (if tcl-always-show (display-buffer tcl-process-buffer))) ;;}}} ;;{{{ tcl-send-proc (defun tcl-send-proc () "Send proc around point to tcl subprocess, wrapped in `eval { ... }'." (interactive) (let (beg end) (save-excursion (tcl-beginning-of-proc) (setq beg (point)) (tcl-end-of-proc) (setq end (point))) (or (and tcl-process (comint-check-proc tcl-process-buffer)) (tcl-start-process tcl-default-application tcl-default-application)) (comint-simple-send tcl-process (concat tcl-default-eval " {\n" (buffer-substring beg end) "\n}")) (if tcl-always-show (display-buffer tcl-process-buffer)))) ;;}}} ;;{{{ tcl-send-buffer (defun tcl-send-buffer () "Send whole buffer to tcl subprocess, wrapped in `eval { ... }'." (interactive) (or (and tcl-process (comint-check-proc tcl-process-buffer)) (tcl-start-process tcl-default-application tcl-default-application)) (if (buffer-modified-p) (comint-simple-send tcl-process (concat tcl-default-eval " {\n" (buffer-substring (point-min) (point-max)) "\n}")) (comint-simple-send tcl-process (concat "source " (buffer-file-name) "\n"))) (if tcl-always-show (display-buffer tcl-process-buffer))) ;;}}} ;;}}} ;;{{{ tcl-get-error-info (defun tcl-get-error-info () "Send string `set errorInfo' to tcl subprocess and display the tcl buffer." (interactive) (or (and tcl-process (comint-check-proc tcl-process-buffer)) (tcl-start-process tcl-default-application tcl-default-application)) (comint-simple-send tcl-process "set errorInfo\n") (display-buffer tcl-process-buffer)) ;;}}} ;;{{{ tcl-restart-with-whole-file (defun tcl-restart-with-whole-file () "Restart tcl subprocess and send whole file as input." (interactive) (tcl-kill-process) (tcl-start-process tcl-default-application tcl-default-application) (tcl-send-buffer)) ;;}}} ;;{{{ tcl-show-process-buffer (defun tcl-show-process-buffer () "Make sure `tcl-process-buffer' is being displayed." (interactive) (display-buffer tcl-process-buffer)) ;;}}} ;;{{{ tcl-hide-process-buffer (defun tcl-hide-process-buffer () "Delete all windows that display `tcl-process-buffer'." (interactive) (delete-windows-on tcl-process-buffer)) ;;}}} ;;}}} ;;{{{ menu bar (define-key tcl-mode-menu [restart-with-whole-file] '("Restart With Whole File" . tcl-restart-with-whole-file)) (define-key tcl-mode-menu [kill-process] '("Kill Process" . tcl-kill-process)) (define-key tcl-mode-menu [hide-process-buffer] '("Hide Process Buffer" . tcl-hide-process-buffer)) (define-key tcl-mode-menu [get-error-info] '("Get Error Info" . tcl-get-error-info)) (define-key tcl-mode-menu [show-process-buffer] '("Show Process Buffer" . tcl-show-process-buffer)) (define-key tcl-mode-menu [end-of-proc] '("End Of Proc" . tcl-end-of-proc)) (define-key tcl-mode-menu [beginning-of-proc] '("Beginning Of Proc" . tcl-beginning-of-proc)) (define-key tcl-mode-menu [send-tcl-region] '("Send Tcl-Region" . tcl-send-tcl-region)) (define-key tcl-mode-menu [set-tcl-regio-end] '("Set Tcl-Region End" . tcl-set-tcl-region-end)) (define-key tcl-mode-menu [set-tcl-region-start] '("Set Tcl-Region Start" . tcl-set-tcl-region-start)) (define-key tcl-mode-menu [send-current-line] '("Send Current Line" . tcl-send-current-line)) (define-key tcl-mode-menu [send-region] '("Send Region" . tcl-send-region)) (define-key tcl-mode-menu [send-proc] '("Send Proc" . tcl-send-proc)) (define-key tcl-mode-menu [send-buffer] '("Send Buffer" . tcl-send-buffer)) ;;}}} (provide 'tcl-mode) ;;{{{ Emacs local variables ;; Local Variables: ;; folded-file: t ;; End: ;;}}} ;;; tcl-mode.el ends here emacs-19.30/lisp/tcp.el100444 12120 1 5366 5433337121 13172 0ustar rmsdaemon;;; TCP/IP stream emulation for GNU Emacs ;; Copyright (C) 1988, 1989, 1993 Free Software Foundation, Inc. ;;; Author: Masanobu Umeda ;;; Maintainer: umerin@mse.kyutech.ac.jp ;; 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: ;; Notes on TCP package: ;; ;; This package provides a TCP/IP stream emulation for GNU Emacs. If ;; the function `open-network-stream' is not defined in Emacs, but ;; your operating system has a capability of network stream ;; connection, this tcp package can be used for communicating with ;; NNTP server. ;; ;; The tcp package runs inferior process which actually does the role ;; of `open-network-stream'. The program `tcp' provided with this ;; package can be used for such purpose. Before loading the package, ;; compile `tcp.c' and install it as `tcp' in a directory in the emacs ;; search path. If you modify `tcp.c', please send diffs to the author ;; of GNUS. I'll include some of them in the next releases. ;;; Code: (provide 'tcp) (defvar tcp-program-name "tcp" "*The name of the program emulating open-network-stream function.") (defun open-network-stream (name buffer host service) "Open a TCP connection for a service to a host. Returns a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. Args are NAME BUFFER HOST SERVICE. NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer (or buffer-name) to associate with the process. Process output goes at end of that buffer, unless you specify an output stream or filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated with any buffer Third arg is name of the host to connect to. Fourth arg SERVICE is name of the service desired, or an integer specifying a port number to connect to." (let ((proc (start-process name buffer tcp-program-name host (if (stringp service) service (int-to-string service)) ))) (process-kill-without-query proc) ;; Return process proc )) ;;; tcp.el ends here emacs-19.30/lisp/telnet.el100444 12120 1 21310 5730753766 13723 0ustar rmsdaemon;;; telnet.el --- run a telnet session from within an Emacs buffer ;;; Copyright (C) 1985, 1988, 1992, 1994 Free Software Foundation, Inc. ;; Author: William F. Schelter ;; Maintainer: FSF ;; 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 mode is intended to be used for telnet or rsh to a remode host; ;; `telnet' and `rsh' are the two entry points. Multiple telnet or rsh ;; sessions are supported. ;; ;; Normally, input is sent to the remote telnet/rsh line-by-line, as you ;; type RET or LFD. C-c C-c sends a C-c to the remote immediately; ;; C-c C-z sends C-z immediately. C-c C-q followed by any character ;; sends that character immediately. ;; ;; All RET characters are filtered out of the output coming back from the ;; remote system. The mode tries to do other useful translations based ;; on what it sees coming back from the other system before the password ;; query. It knows about UNIX, ITS, TOPS-20 and Explorer systems. ;;; Code: ;; to do fix software types for lispm: ;; to eval current expression. Also to try to send escape keys correctly. ;; essentially we'll want the rubout-handler off. ;; filter is simplistic but should be okay for typical shell usage. ;; needs hacking if it is going to deal with asynchronous output in a sane ;; manner (require 'comint) (defvar telnet-new-line "\r") (defvar telnet-mode-map nil) (defvar telnet-prompt-pattern "^[^#$%>\n]*[#$%>] *") (defvar telnet-replace-c-g nil) (make-variable-buffer-local (defvar telnet-remote-echoes t "True if the telnet process will echo input.")) (make-variable-buffer-local (defvar telnet-interrupt-string "\C-c" "String sent by C-c.")) (defvar telnet-count 0 "Number of output strings from telnet process while looking for password.") (make-variable-buffer-local 'telnet-count) (defvar telnet-program "telnet" "Program to run to open a telnet connection.") (defvar telnet-initial-count -50 "Initial value of `telnet-count'. Should be set to the negative of the number of terminal writes telnet will make setting up the host connection.") (defvar telnet-maximum-count 4 "Maximum value `telnet-count' can have. After this many passes, we stop looking for initial setup data. Should be set to the number of terminal writes telnet will make rejecting one login and prompting again for a username and password.") (defun telnet-interrupt-subjob () (interactive) "Interrupt the program running through telnet on the remote host." (send-string nil telnet-interrupt-string)) (defun telnet-c-z () (interactive) (send-string nil "\C-z")) (defun send-process-next-char () (interactive) (send-string nil (char-to-string (let ((inhibit-quit t)) (prog1 (read-char) (setq quit-flag nil)))))) ; initialization on first load. (if telnet-mode-map nil (setq telnet-mode-map (nconc (make-sparse-keymap) comint-mode-map)) (define-key telnet-mode-map "\C-m" 'telnet-send-input) ; (define-key telnet-mode-map "\C-j" 'telnet-send-input) (define-key telnet-mode-map "\C-c\C-q" 'send-process-next-char) (define-key telnet-mode-map "\C-c\C-c" 'telnet-interrupt-subjob) (define-key telnet-mode-map "\C-c\C-z" 'telnet-c-z)) ;;maybe should have a flag for when have found type (defun telnet-check-software-type-initialize (string) "Tries to put correct initializations in. Needs work." (let ((case-fold-search t)) (cond ((string-match "unix" string) (setq telnet-prompt-pattern comint-prompt-regexp) (setq telnet-new-line "\n")) ((string-match "tops-20" string) ;;maybe add telnet-replace-c-g (setq telnet-prompt-pattern "[@>]*")) ((string-match "its" string) (setq telnet-prompt-pattern "^[^*>\n]*[*>] *")) ((string-match "explorer" string) ;;explorer telnet needs work (setq telnet-replace-c-g ?\n)))) (setq comint-prompt-regexp telnet-prompt-pattern)) (defun telnet-initial-filter (proc string) ;For reading up to and including password; also will get machine type. (cond ((string-match "No such host" string) (kill-buffer (process-buffer proc)) (error "No such host.")) ((string-match "passw" string) (telnet-filter proc string) (setq telnet-count 0) (send-string proc (concat (comint-read-noecho "Password: " t) telnet-new-line))) (t (telnet-check-software-type-initialize string) (telnet-filter proc string) (cond ((> telnet-count telnet-maximum-count) (set-process-filter proc 'telnet-filter)) (t (setq telnet-count (1+ telnet-count))))))) ;; Identical to comint-simple-send, except that it sends telnet-new-line ;; instead of "\n". (defun telnet-simple-send (proc string) (comint-send-string proc string) (comint-send-string proc telnet-new-line)) (defun telnet-filter (proc string) (save-excursion (set-buffer (process-buffer proc)) (let* ((last-insertion (marker-position (process-mark proc))) (delta (- (point) last-insertion)) (ie (and comint-last-input-end (marker-position comint-last-input-end))) (w (get-buffer-window (current-buffer))) (ws (and w (window-start w)))) (goto-char last-insertion) (insert-before-markers string) (set-marker (process-mark proc) (point)) (if ws (set-window-start w ws t)) (if ie (set-marker comint-last-input-end ie)) (while (progn (skip-chars-backward "^\C-m" last-insertion) (> (point) last-insertion)) (delete-region (1- (point)) (point))) (goto-char (process-mark proc)) (and telnet-replace-c-g (subst-char-in-region last-insertion (point) ?\C-g telnet-replace-c-g t)) ;; If point is after the insertion place, move it ;; along with the text. (if (> delta 0) (goto-char (+ (process-mark proc) delta)))))) (defun telnet-send-input () (interactive) ; (comint-send-input telnet-new-line telnet-remote-echoes) (comint-send-input) (if telnet-remote-echoes (delete-region comint-last-input-start comint-last-input-end))) ;;;###autoload (add-hook 'same-window-regexps "\\*telnet-.*\\*\\(\\|<[0-9]+>\\)") ;;;###autoload (defun telnet (host) "Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer `*telnet-HOST*'. Normally input is edited in Emacs and sent a line at a time." (interactive "sOpen telnet connection to host: ") (let* ((comint-delimiter-argument-list '(?\ ?\t)) (name (concat "telnet-" (comint-arguments host 0 nil) )) (buffer (get-buffer (concat "*" name "*"))) process) (if (and buffer (get-buffer-process buffer)) (pop-to-buffer (concat "*" name "*")) (pop-to-buffer (make-comint name telnet-program)) (setq process (get-buffer-process (current-buffer))) (set-process-filter process 'telnet-initial-filter) ;; Don't send the `open' cmd till telnet is ready for it. (accept-process-output process) (erase-buffer) (send-string process (concat "open " host "\n")) (telnet-mode) (setq comint-input-sender 'telnet-simple-send) (setq telnet-count telnet-initial-count)))) (defun telnet-mode () "This mode is for using telnet (or rsh) from a buffer to another host. It has most of the same commands as comint-mode. There is a variable ``telnet-interrupt-string'' which is the character sent to try to stop execution of a job on the remote host. Data is sent to the remote host when RET is typed. \\{telnet-mode-map} " (interactive) (comint-mode) (setq major-mode 'telnet-mode mode-name "Telnet" comint-prompt-regexp telnet-prompt-pattern) (use-local-map telnet-mode-map) (run-hooks 'telnet-mode-hook)) ;;;###autoload (add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)") ;;;###autoload (defun rsh (host) "Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer `*rsh-HOST*'. Normally input is edited in Emacs and sent a line at a time." (interactive "sOpen rsh connection to host: ") (require 'shell) (let ((name (concat "rsh-" host ))) (pop-to-buffer (make-comint name remote-shell-program nil host)) (set-process-filter (get-process name) 'telnet-initial-filter) (telnet-mode) (setq telnet-count -16))) (provide 'telnet) ;;; telnet.el ends here emacs-19.30/lisp/tempo.el100444 12120 1 63664 5771550164 13566 0ustar rmsdaemon;;; tempo.el --- Flexible template insertion ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: David K}gedal ;; Created: 16 Feb 1994 ;; K}gedal's last version number: 1.2.4 ;; Keywords: extensions, languages, tools ;; 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 file provides a simple way to define powerful templates, or ;; macros, if you wish. It is mainly intended for, but not limited to, ;; other programmers to be used for creating shortcuts for editing ;; certain kind of documents. It was originally written to be used by ;; a HTML editing mode written by Nelson Minar , ;; and his html-helper-mode.el is probably the best example of how to ;; use this program. ;; A template is defined as a list of items to be inserted in the ;; current buffer at point. Some of the items can be simple strings, ;; while other can control formatting or define special points of ;; interest in the inserted text. ;; If a template defines a "point of interest" that point is inserted ;; in a buffer-local list of "points of interest" that the user can ;; jump between with the commands `tempo-backward-mark' and ;; `tempo-forward-mark'. If the template definer provides a prompt for ;; the point, and the variable `tempo-interactive' is non-nil, the ;; user will be prompted for a string to be inserted in the buffer, ;; using the minibuffer. ;; The template can also define one point to be replaced with the ;; current region if the template command is called with a prefix (or ;; a non-nil argument). ;; More flexible templates can be created by including lisp symbols, ;; which will be evaluated as variables, or lists, which will will be ;; evaluated as lisp expressions. ;; See the documentation for tempo-define-template for the different ;; items that can be used to define a tempo template. ;; One of the more powerful features of tempo templates are automatic ;; completion. With every template can be assigned a special tag that ;; should be recognized by `tempo-complete-tag' and expanded to the ;; complete template. By default the tags are added to a global list ;; of template tags, and are matched against the last word before ;; point. But if you assign your tags to a specific list, you can also ;; specify another method for matching text in the buffer against the ;; tags. In the HTML mode, for instance, the tags are matched against ;; the text between the last `<' and point. ;; When defining a template named `foo', a symbol named ;; `tempo-template-foo' will be created whose value as a variable will ;; be the template definition, and its function value will be an ;; interactive function that inserts the template at the point. ;; The latest tempo.el distribution can be fetched from ;; ftp.lysator.liu.se in the directory /pub/emacs ;; There is also a WWW page at ;; http://www.lysator.liu.se/~davidk/elisp/ which has some information ;;; Known bugs: ;; If the 'o is the first element in a template, strange things can ;; happen when the template is inserted at the beginning of a ;; line. This is due to strange behaviour in open-line. But it should ;; be easily avoided. ;; The 'o tag is also a problem when including the region. This will ;; be looked into. ;; Clicking mouse-2 in the completion buffer gives strange results. ;; There is a bug in some emacs versions that prevents completion from ;; working. If it doesn't work for you, send me a note indicating your ;; emacs version and your problems. ;;; Contributors: ;; These people have given me importand feedback and new ideas for ;; tempo.el. Thanks. ;; Nelson Minar ;; Richard Stallman ;; Lars Lindberg ;; Glen Whitney ;;; Code: ;; (provide 'tempo) ;;; User options (defvar tempo-interactive nil "*Prompt user for strings in templates. If this variable is non-nil, `tempo-insert' prompts the user for text to insert in the templates") (defvar tempo-insert-region nil "*Automatically insert current region when there is a `r' in the template If this variable is NIL, `r' elements will be treated just like `p' elements, unless the template function is given a prefix (or a non-nil argument). If this variable is non-NIL, the behaviour is reversed. In Transient Mark mode, this option is unused.") (defvar tempo-show-completion-buffer t "*If non-NIL, show a buffer with possible completions, when only a partial completion can be found") (defvar tempo-leave-completion-buffer nil "*If NIL, a completion buffer generated by \\[tempo-complete-tag] disappears at the next keypress; otherwise, it remains forever.") ;;; Internal variables (defvar tempo-insert-string-functions nil "List of functions to run when inserting a string. Each function is called with a single arg, STRING and should return another string. This could be used for making all strings upcase by setting it to '(upcase), for example.") (defvar tempo-tags nil "An association list with tags and corresponding templates") (defvar tempo-local-tags '((tempo-tags . nil)) "A list of locally installed tag completion lists. It is a association list where the car of every element is a symbol whose varable value is a template list. The cdr part, if non-nil, is a function or a regexp that defines the string to match. See the documentation for the function `tempo-complete-tag' for more info. `tempo-tags' is always in the last position in this list.") (defvar tempo-collection nil "A collection of all the tags defined for the current buffer.") (defvar tempo-dirty-collection t "Indicates if the tag collection needs to be rebuilt.") (defvar tempo-marks nil "A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.") (defvar tempo-match-finder "\\b\\([^\\b]+\\)\\=" "The regexp or function used to find the string to match against tags. If `tempo-match-finder is a string, it should contain a regular expression with at least one \\( \\) pair. When searching for tags, `tempo-complete-tag' calls `re-search-backward' with this string, and the string between the first \\( and \\) is used for matching against each string in the tag list. If one is found, the whole text between the first \\( and the point is replaced with the inserted template. You will probably want to include \\ \= at the end of the regexp to make sure that the string is matched only against text adjacent to the point. If `tempo-match-finder' is a symbol, it should be a function that returns a pair of the form (STRING . POS), where STRING is the string used for matching and POS is the buffer position after which text should be replaced with a template.") (defvar tempo-user-elements nil "Element handlers for user-defined elements. A list of symbols which are bound to functions that take one argument. This function should return somthing to be sent to `tempo-insert' if it recognizes the argument, and NIL otherwise") (defvar tempo-named-insertions nil "Temporary storage for named insertions") (defvar tempo-region-start (make-marker) "Region start when inserting around the region") (defvar tempo-region-stop (make-marker) "Region stop when inserting around the region") ;; Make some variables local to every buffer (make-variable-buffer-local 'tempo-marks) (make-variable-buffer-local 'tempo-local-tags) (make-variable-buffer-local 'tempo-match-finder) (make-variable-buffer-local 'tempo-collection) (make-variable-buffer-local 'tempo-dirty-collection) ;;; Functions ;;; First some useful functions and macros (defun tempo-mapc (fun lst) (if (null lst) nil (funcall fun (car lst)) (tempo-mapc fun (cdr lst)))) (defmacro tempo-dolist (il &rest forms) (let ((i (car il)) (l (car (cdr il)))) (list 'tempo-mapc (list 'function (append (list 'lambda (list i)) forms)) l))) (put 'tempo-dolist 'lisp-indent-function 1) ;; ;; tempo-define-template (defun tempo-define-template (name elements &optional tag documentation taglist) "Define a template. This function creates a template variable `tempo-template-NAME' and an interactive function `tempo-template-NAME' that inserts the template at the point. The created function is returned. NAME is a string that contains the name of the template, ELEMENTS is a list of elements in the template, TAG is the tag used for completion, DOCUMENTATION is the documentation string for the insertion command created, and TAGLIST (a symbol) is the tag list that TAG (if provided) should be added to). If TAGLIST is nil and TAG is non-nil, TAG is added to `tempo-tags' The elements in ELEMENTS can be of several types: - A string. It is sent to the hooks in `tempo-insert-string-functions', and the result is inserted. - The symbol 'p. This position is saved in `tempo-marks'. - The symbol 'r. If `tempo-insert' is called with ON-REGION non-nil the current region is placed here. Otherwise it works like 'p. - (p PROMPT ) If `tempo-interactive' is non-nil, the user is prompted in the minbuffer with PROMPT for a string to be inserted. If the optional parameter NAME is non-nil, the text is saved for later insertion with the `s' tag. If there already is something saved under NAME that value is used instead and no prompting is made. If NOINSERT is provided and non-nil, nothing is inserted, but text is still saved when a NAME is provided. For clarity, the symbol 'noinsert should be used as argument. - (P PROMPT ) Works just like the previous tag, but forces tempo-interactive to be true. - (r PROMPT ) like the previous, but if `tempo-interactive' is nil and `tempo-insert' is called with ON-REGION non-nil, the current region is placed here. This usually happens when you call the template function with a prefix argument. - (s NAME) Inserts text previously read with the (p ..) construct. Finds the insertion saved under NAME and inserts it. Acts like 'p if tempo-interactive is nil. - '& If there is only whitespace between the line start and point, nothing happens. Otherwise a newline is inserted. - '% If there is only whitespace between point and end-of-line nothing happens. Otherwise a newline is inserted. - 'n inserts a newline. - '> The line is indented using `indent-according-to-mode'. Note that you often should place this item after the text you want on the line. - 'r> Like r, but it also indents the region. - 'n> Inserts a newline and indents line. - 'o Like '% but leaves the point before the newline. - nil. It is ignored. - Anything else. It is evaluated and the result is treated as an element to be inserted. One additional tag is useful for these cases. If an expression returns a list '(l foo bar), the elements after 'l will be inserted according to the usual rules. This makes it possible to return several elements from one expression." (let* ((template-name (intern (concat "tempo-template-" name))) (command-name template-name)) (set template-name elements) (fset command-name (list 'lambda (list '&optional 'arg) (or documentation (concat "Insert a " name ".")) (list 'interactive "*P") (list 'tempo-insert-template (list 'quote template-name) (list 'if 'tempo-insert-region (list 'not 'arg) 'arg)))) (and tag (tempo-add-tag tag template-name taglist)) command-name)) ;;; ;;; tempo-insert-template (defun tempo-insert-template (template on-region) "Insert a template. TEMPLATE is the template to be inserted. If ON-REGION is non-nil the `r' elements are replaced with the current region. In Transient Mark mode, ON-REGION is ignored and assumed true if the region is active." (unwind-protect (progn (if (or (and (boundp 'transient-mark-mode) ; For Emacs transient-mark-mode mark-active) (and (boundp 'zmacs-regions) ; For XEmacs zmacs-regions (mark))) (setq on-region t)) (and on-region (set-marker tempo-region-start (min (mark) (point))) (set-marker tempo-region-stop (max (mark) (point)))) (if on-region (goto-char tempo-region-start)) (save-excursion (tempo-insert-mark (point-marker)) (mapcar (function (lambda (elt) (tempo-insert elt on-region))) (symbol-value template)) (tempo-insert-mark (point-marker))) (tempo-forward-mark)) (tempo-forget-insertions) ;; Should I check for zmacs here too??? (and (boundp 'transient-mark-mode) transient-mark-mode (deactivate-mark)))) ;;; ;;; tempo-insert (defun tempo-insert (element on-region) "Insert a template element. Insert one element from a template. If ON-REGION is non-nil the `r' elements are replaced with the current region. See documentation for `tempo-define-template' for the kind of elements possible." (cond ((stringp element) (tempo-process-and-insert-string element)) ((and (consp element) (eq (car element) 'p)) (tempo-insert-prompt-compat (cdr element))) ((and (consp element) (eq (car element) 'P)) (let ((tempo-interactive t)) (tempo-insert-prompt-compat (cdr element)))) ;;; ((and (consp element) ;;; (eq (car element) 'v)) (tempo-save-named ;;; (nth 1 element) ;;; nil ;;; (nth 2 element))) ((and (consp element) (eq (car element) 'r)) (if on-region (goto-char tempo-region-stop) (tempo-insert-prompt-compat (cdr element)))) ((and (consp element) (eq (car element) 's)) (tempo-insert-named (car (cdr element)))) ((and (consp element) (eq (car element) 'l)) (mapcar (function (lambda (elt) (tempo-insert elt on-region))) (cdr element))) ((eq element 'p) (tempo-insert-mark (point-marker))) ((eq element 'r) (if on-region (goto-char tempo-region-stop) (tempo-insert-mark (point-marker)))) ((eq element 'r>) (if on-region (progn (goto-char tempo-region-stop) (indent-region (mark) (point) nil)) (tempo-insert-mark (point-marker)))) ((eq element '>) (indent-according-to-mode)) ((eq element '&) (if (not (or (= (current-column) 0) (save-excursion (re-search-backward "^\\s-*\\=" nil t)))) (insert "\n"))) ((eq element '%) (if (not (or (eolp) (save-excursion (re-search-forward "\\=\\s-*$" nil t)))) (insert "\n"))) ((eq element 'n) (insert "\n")) ((eq element 'n>) (insert "\n") (indent-according-to-mode)) ;; Bug: If the 'o is the first element in a template, strange ;; things can happen when the template is inserted at the ;; beginning of a line. ((eq element 'o) (if (not (or on-region (eolp) (save-excursion (re-search-forward "\\=\\s-*$" nil t)))) (open-line 1))) ((null element)) (t (tempo-insert (or (tempo-is-user-element element) (eval element)) on-region)))) ;;; ;;; tempo-insert-prompt (defun tempo-insert-prompt-compat (prompt) "Compatibility hack for tempo-insert-prompt. PROMPT can be either a prompt string, or a list of arguments to tempo-insert-prompt, or nil." (if (consp prompt) ; not NIL either (apply 'tempo-insert-prompt prompt) (tempo-insert-prompt prompt))) (defun tempo-insert-prompt (prompt &optional save-name no-insert) "Prompt for a text string and insert it in the current buffer. If the variable `tempo-interactive' is non-nil the user is prompted for a string in the minibuffer, which is then inserted in the current buffer. If `tempo-interactive' is nil, the current point is placed on `tempo-mark'. PROMPT is the prompt string, SAVE-NAME is a name to save the inserted text under. If the optional argument NO-INSERT is non-nil, no text i inserted. This can be useful when there is a SAVE-NAME. If there already is a value for SAVE-NAME, it is used and the user is never prompted." (let (insertion (previous (and save-name (tempo-lookup-named save-name)))) (cond ;; Insert previous value, unless no-insert is non-nil ((and previous (not no-insert)) (tempo-insert-named save-name)) ; A double lookup here, but who ; cares ;; If no-insert is non-nil, don't insert the previous value. Just ;; keep it (previous nil) ;; No previous value. Prompt or insert mark (tempo-interactive (if (not (stringp prompt)) (error "tempo: The prompt (%s) is not a string" prompt)) (setq insertion (read-string prompt)) (or no-insert (insert insertion)) (if save-name (tempo-save-named save-name insertion))) (t (tempo-insert-mark (point-marker)))))) ;;; ;;; tempo-is-user-element (defun tempo-is-user-element (element) "Tries all the user-defined element handlers in `tempo-user-elements'" ;; Sigh... I need (some list) (catch 'found (mapcar (function (lambda (handler) (let ((result (funcall handler element))) (if result (throw 'found result))))) tempo-user-elements) (throw 'found nil))) ;;; ;;; tempo-forget-insertions (defun tempo-forget-insertions () "Forget all the saved named insertions." (setq tempo-named-insertions nil)) ;;; ;;; tempo-save-named (defun tempo-save-named (name data) ; Had an optional prompt for 'v "Save some data for later insertion The contents of DATA is saved under the name NAME. The data can later be retrieved with `tempo-lookup-named'. This function returns nil, so it can be used in a template without inserting anything." (setq tempo-named-insertions (cons (cons name data) tempo-named-insertions)) nil) ;;; ;;; tempo-lookup-named (defun tempo-lookup-named (name) "Lookup some saved data under the name NAME. Returns the data if NAME was found, and nil otherwise." (cdr (assq name tempo-named-insertions))) ;;; ;;; tempo-insert-named (defun tempo-insert-named (name) "Insert the previous insertion saved under a named specified in NAME. If there is no such name saved, a tempo mark is inserted. Note that if the data is a string, it will not be run through the string processor." (let* ((insertion (tempo-lookup-named name))) (cond ((null insertion) (tempo-insert-mark (point-marker))) ((stringp insertion) (insert insertion)) (t (tempo-insert insertion nil))))) ;;; ;;; tempo-process-and-insert-string (defun tempo-process-and-insert-string (string) "Insert a string from a template. Run a string through the preprocessors in `tempo-insert-string-functions' and insert the results." (cond ((null tempo-insert-string-functions) nil) ((symbolp tempo-insert-string-functions) (setq string (funcall tempo-insert-string-functions string))) ((listp tempo-insert-string-functions) (tempo-dolist (fn tempo-insert-string-functions) (setq string (funcall fn string)))) (t (error "Bogus value in tempo-insert-string-functions: %s" tempo-insert-string-functions))) (insert string)) ;;; ;;; tempo-insert-mark (defun tempo-insert-mark (mark) "Insert a mark `tempo-marks' while keeping it sorted" (cond ((null tempo-marks) (setq tempo-marks (list mark))) ((< mark (car tempo-marks)) (setq tempo-marks (cons mark tempo-marks))) (t (let ((lp tempo-marks)) (while (and (cdr lp) (<= (car (cdr lp)) mark)) (setq lp (cdr lp))) (if (not (= mark (car lp))) (setcdr lp (cons mark (cdr lp)))))))) ;;; ;;; tempo-forward-mark (defun tempo-forward-mark () "Jump to the next mark in `tempo-forward-mark-list'." (interactive) (let ((next-mark (catch 'found (mapcar (function (lambda (mark) (if (< (point) mark) (throw 'found mark)))) tempo-marks) ;; return nil if not found nil))) (if next-mark (goto-char next-mark)))) ;;; ;;; tempo-backward-mark (defun tempo-backward-mark () "Jump to the previous mark in `tempo-back-mark-list'." (interactive) (let ((prev-mark (catch 'found (let (last) (mapcar (function (lambda (mark) (if (<= (point) mark) (throw 'found last)) (setq last mark))) tempo-marks) last)))) (if prev-mark (goto-char prev-mark)))) ;;; ;;; tempo-add-tag (defun tempo-add-tag (tag template &optional tag-list) "Add a template tag. Add the TAG, that should complete to TEMPLATE to the list in TAG-LIST, or to `tempo-tags' if TAG-LIST is nil." (interactive "sTag: \nCTemplate: ") (if (null tag-list) (setq tag-list 'tempo-tags)) (if (not (assoc tag (symbol-value tag-list))) (set tag-list (cons (cons tag template) (symbol-value tag-list)))) (tempo-invalidate-collection)) ;;; ;;; tempo-use-tag-list (defun tempo-use-tag-list (tag-list &optional completion-function) "Install TAG-LIST to be used for template completion in the current buffer. TAG-LIST is a symbol whose variable value is a tag list created with `tempo-add-tag'. COMPLETION-FUNCTION is an obsolete option for specifyingis an optional function or string that is used by `\\[tempo-complete-tag]' to find a string to match the tag against. It has the same definition as the variable `tempo-match-finder'. In this version, supplying a COMPLETION-FUNCTION just sets `tempo-match-finder' locally." (let ((old (assq tag-list tempo-local-tags))) (if old (setcdr old completion-function) (setq tempo-local-tags (cons (cons tag-list completion-function) tempo-local-tags)))) (if completion-function (setq tempo-match-finder completion-function)) (tempo-invalidate-collection)) ;;; ;;; tempo-invalidate-collection (defun tempo-invalidate-collection () "Marks the tag collection as obsolete. Whenever it is needed again it will be rebuilt." (setq tempo-dirty-collection t)) ;;; ;;; tempo-build-collection (defun tempo-build-collection () "Build a collection of all the tags and return it. If `tempo-dirty-collection' is NIL, the old collection is reused." (prog1 (or (and (not tempo-dirty-collection) tempo-collection) (setq tempo-collection (apply (function append) (mapcar (function (lambda (tag-list) ; If the format for ; tempo-local-tags changes, ; change this (eval (car tag-list)))) tempo-local-tags)))) (setq tempo-dirty-collection nil))) ;;; ;;; tempo-find-match-string (defun tempo-find-match-string (finder) "Find a string to be matched against a tag list. FINDER is a function or a string. Returns (STRING . POS), or nil if no reasonable string is found." (cond ((stringp finder) (let (successful) (save-excursion (or (setq successful (re-search-backward finder nil t)) 0)) (if successful (cons (buffer-substring (match-beginning 1) (match-end 1)) ; This seems to be a ; bug in emacs (match-beginning 1)) nil))) (t (funcall finder)))) ;;; ;;; tempo-complete-tag (defun tempo-complete-tag (&optional silent) "Look for a tag and expand it. All the tags in the tag lists in `tempo-local-tags' \(this includes `tempo-tags') are searched for a match for the text before the point. The way the string to match for is determined can be altered with the variable `tempo-match-finder'. If `tempo-match-finder' returns nil, then the results are the same as no match at all. If a single match is found, the corresponding template is expanded in place of the matching string. If a partial completion or no match at all is found, and SILENT is non-NIL, the function will give a signal. If a partial completion is found and `tempo-show-completion-buffer' is non-NIL, a buffer containing possible completions is displayed." ;; This function may look like a hack, but this is how I want it to ;; work. (interactive "*") (let* ((collection (tempo-build-collection)) (match-info (tempo-find-match-string tempo-match-finder)) (match-string (car match-info)) (match-start (cdr match-info)) (exact (assoc match-string collection)) (compl (or (car exact) (and match-info (try-completion match-string collection))))) (if compl (delete-region match-start (point))) (cond ((null match-info) (or silent (ding))) ((null compl) (or silent (ding))) ((eq compl t) (tempo-insert-template (cdr (assoc match-string collection)) nil)) (t (if (setq exact (assoc compl collection)) (tempo-insert-template (cdr exact) nil) (insert compl) (or silent (ding)) (if tempo-show-completion-buffer (tempo-display-completions match-string collection))))))) ;;; ;;; tempo-display-completions (defun tempo-display-completions (string tag-list) "Show a buffer containing possible completions for STRING." (if tempo-leave-completion-buffer (with-output-to-temp-buffer "*Completions*" (display-completion-list (all-completions string tag-list))) (save-window-excursion (with-output-to-temp-buffer "*Completions*" (display-completion-list (all-completions string tag-list))) (sit-for 32767)))) ;;; ;;; tempo-expand-if-complete (defun tempo-expand-if-complete () "Expand the tag before point if it is complete. Returns non-nil if an expansion was made and nil otherwise. This could as an example be used in a command that is bound to the space bar, and looks something like this: (defun tempo-space () (interactive \"*\") (or (tempo-expand-if-complete) (insert \" \")))" (interactive "*") (let* ((collection (tempo-build-collection)) (match-info (tempo-find-match-string tempo-match-finder)) (match-string (car match-info)) (match-start (cdr match-info)) (exact (assoc match-string collection))) (if exact (progn (delete-region match-start (point)) (tempo-insert-template (cdr exact) nil) t) nil))) (provide 'tempo) ;;; tempo.el ends here emacs-19.30/lisp/term-nasty.el100444 12120 1 1723 5235605662 14510 0ustar rmsdaemon;;; term-nasty.el --- Damned Things from terminfo.el ;;; This file is in the public domain, and was written by Stallman and Mlynarik ;;; Commentary: ;; Some people used to be bothered by the following comments that were ;; found in terminal.el. We decided they were distracting, and that it ;; was better not to have them there. On the other hand, we didn't want ;; to appear to be giving in to the pressure to censor obscenity that ;; currently threatens freedom of speech and of the press in the US. ;; So we decided to put the comments here. ;;; Code: These comments were removed from te-losing-unix. ;(what lossage) ;(message "fucking-unix: %d" char) This was before te-process-output. ;; fucking unix has -such- braindamaged lack of tty control... And about the need to handle output characters such as C-m, C-g, C-h and C-i even though the termcap doesn't say they may be used: ;fuck me harder ;again and again! ;wa12id!! ;(spiked) ;;; term-nasty.el ends here emacs-19.30/lisp/term.el100444 12120 1 376707 6045205224 13423 0ustar rmsdaemon;;; term.el --- general command interpreter in a window stuff ;; Copyright (C) 1988, 1990, 1992, 1994, 1995 Free Software Foundation, Inc. ;; Author: Per Bothner ;; Based on comint mode written by: Olin Shivers ;; Keyword: processes ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; The changelog is at the end of this file. ;;; Please send me bug reports, bug fixes, and extensions, so that I can ;;; merge them into the master source. ;;; - Per Bothner (bothner@cygnus.com) ;;; This file defines a general command-interpreter-in-a-buffer package ;;; (term mode). The idea is that you can build specific process-in-a-buffer ;;; modes on top of term mode -- e.g., lisp, shell, scheme, T, soar, .... ;;; This way, all these specific packages share a common base functionality, ;;; and a common set of bindings, which makes them easier to use (and ;;; saves code, implementation time, etc., etc.). ;;; For hints on converting existing process modes (e.g., tex-mode, ;;; background, dbx, gdb, kermit, prolog, telnet) to use term-mode ;;; instead of shell-mode, see the notes at the end of this file. ;;; Brief Command Documentation: ;;;============================================================================ ;;; Term Mode Commands: (common to all derived modes, like cmushell & cmulisp ;;; mode) ;;; ;;; m-p term-previous-input Cycle backwards in input history ;;; m-n term-next-input Cycle forwards ;;; m-r term-previous-matching-input Previous input matching a regexp ;;; m-s comint-next-matching-input Next input that matches ;;; return term-send-input ;;; c-c c-a term-bol Beginning of line; skip prompt. ;;; c-d term-delchar-or-maybe-eof Delete char unless at end of buff. ;;; c-c c-u term-kill-input ^u ;;; c-c c-w backward-kill-word ^w ;;; c-c c-c term-interrupt-subjob ^c ;;; c-c c-z term-stop-subjob ^z ;;; c-c c-\ term-quit-subjob ^\ ;;; c-c c-o term-kill-output Delete last batch of process output ;;; c-c c-r term-show-output Show last batch of process output ;;; c-c c-h term-dynamic-list-input-ring List input history ;;; ;;; Not bound by default in term-mode ;;; term-send-invisible Read a line w/o echo, and send to proc ;;; (These are bound in shell-mode) ;;; term-dynamic-complete Complete filename at point. ;;; term-dynamic-list-completions List completions in help buffer. ;;; term-replace-by-expanded-filename Expand and complete filename at point; ;;; replace with expanded/completed name. ;;; term-kill-subjob No mercy. ;;; term-show-maximum-output Show as much output as possible. ;;; term-continue-subjob Send CONT signal to buffer's process ;;; group. Useful if you accidentally ;;; suspend your process (with C-c C-z). ;;; term-mode-hook is the term mode hook. Basically for your keybindings. ;;; term-load-hook is run after loading in this package. ;;; Code: ;;; This is passed to the inferior in the EMACS environment variable, ;;; so it is important to increase it if there are protocol-relevant changes. (defconst term-protocol-version "0.95") (require 'ring) (require 'ehelp) ;;; Buffer Local Variables: ;;;============================================================================ ;;; Term mode buffer local variables: ;;; term-prompt-regexp - string term-bol uses to match prompt. ;;; term-delimiter-argument-list - list For delimiters and arguments ;;; term-last-input-start - marker Handy if inferior always echoes ;;; term-last-input-end - marker For term-kill-output command ;; For the input history mechanism: (defvar term-input-ring-size 32 "Size of input history ring.") ;;; term-input-ring-size - integer ;;; term-input-ring - ring ;;; term-input-ring-index - number ... ;;; term-input-autoexpand - symbol ... ;;; term-input-ignoredups - boolean ... ;;; term-last-input-match - string ... ;;; term-dynamic-complete-functions - hook For the completion mechanism ;;; term-completion-fignore - list ... ;;; term-get-old-input - function Hooks for specific ;;; term-input-filter-functions - hook process-in-a-buffer ;;; term-input-filter - function modes. ;;; term-input-send - function ;;; term-scroll-to-bottom-on-output - symbol ... ;;; term-scroll-show-maximum-output - boolean... (defvar term-height) ;; Number of lines in window. (defvar term-width) ;; Number of columns in window. (defvar term-home-marker) ;; Marks the "home" position for cursor addressing. (defvar term-saved-home-marker nil) ;; When using alternate sub-buffer, ;; contains saved term-home-marker from original sub-buffer . (defvar term-start-line-column 0) ;; (current-column) at start of screen line, ;; or nil if unknown. (defvar term-current-column 0) ;; If non-nil, is cache for (current-column). (defvar term-current-row 0) ;; Current vertical row (relative to home-marker) ;; or nil if unknown. (defvar term-insert-mode nil) (defvar term-vertical-motion) (defvar term-terminal-state 0) ;; State of the terminal emulator: ;; state 0: Normal state ;; state 1: Last character was a graphic in the last column. ;; If next char is graphic, first move one column right ;; (and line warp) before displaying it. ;; This emulates (more or less) the behavior of xterm. ;; state 2: seen ESC ;; state 3: seen ESC [ (or ESC [ ?) ;; state 4: term-terminal-parameter contains pending output. (defvar term-kill-echo-list nil) ;; A queue of strings whose echo ;; we want suppressed. (defvar term-terminal-parameter) (defvar term-terminal-previous-parameter) (defvar term-current-face 'default) (defvar term-scroll-start 0) ;; Top-most line (inclusive) of scrolling region. (defvar term-scroll-end) ;; Number of line (zero-based) after scrolling region. (defvar term-pager-count nil) ;; If nil, paging is disabled. ;; Otherwise, number of lines before we need to page. (defvar term-saved-cursor nil) (defvar term-command-hook) (defvar term-log-buffer nil) (defvar term-scroll-with-delete nil) ;; term-scroll-with-delete is t if ;; forward scrolling should be implemented by delete to ;; top-most line(s); and nil if scrolling should be implemented ;; by moving term-home-marker. It is set to t iff there is a ;; (non-default) scroll-region OR the alternate buffer is used. (defvar term-pending-delete-marker) ;; New user input in line mode needs to ;; be deleted, because it gets echoed by the inferior. ;; To reduce flicker, we defer the delete until the next output. (defvar term-old-mode-map nil) ;; Saves the old keymap when in char mode. (defvar term-old-mode-line-format) ;; Saves old mode-line-format while paging. (defvar term-pager-old-local-map nil) ;; Saves old keymap while paging. (defvar term-pager-old-filter) ;; Saved process-filter while paging. (defvar explicit-shell-file-name nil "*If non-nil, is file name to use for explicitly requested inferior shell.") (defvar term-prompt-regexp "^" "Regexp to recognise prompts in the inferior process. Defaults to \"^\", the null string at BOL. Good choices: Canonical Lisp: \"^[^> \\n]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp) Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\" franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\" kcl: \"^>+ *\" shell: \"^[^#$%>\\n]*[#$%>] *\" T: \"^>+ *\" This is a good thing to set in mode hooks.") (defvar term-delimiter-argument-list () "List of characters to recognise as separate arguments in input. Strings comprising a character in this list will separate the arguments surrounding them, and also be regarded as arguments in their own right (unlike whitespace). See `term-arguments'. Defaults to the empty list. For shells, a good value is (?\\| ?& ?< ?> ?\\( ?\\) ?;). This is a good thing to set in mode hooks.") (defvar term-input-autoexpand nil "*If non-nil, expand input command history references on completion. This mirrors the optional behavior of tcsh (its autoexpand and histlit). If the value is `input', then the expansion is seen on input. If the value is `history', then the expansion is only when inserting into the buffer's input ring. See also `term-magic-space' and `term-dynamic-complete'. This variable is buffer-local.") (defvar term-input-ignoredups nil "*If non-nil, don't add input matching the last on the input ring. This mirrors the optional behavior of bash. This variable is buffer-local.") (defvar term-input-ring-file-name nil "*If non-nil, name of the file to read/write input history. See also `term-read-input-ring' and `term-write-input-ring'. This variable is buffer-local, and is a good thing to set in mode hooks.") (defvar term-scroll-to-bottom-on-output nil "*Controls whether interpreter output causes window to scroll. If nil, then do not scroll. If t or `all', scroll all windows showing buffer. If `this', scroll only the selected window. If `others', scroll only those that are not the selected window. The default is nil. See variable `term-scroll-show-maximum-output'. This variable is buffer-local.") (defvar term-scroll-show-maximum-output nil "*Controls how interpreter output causes window to scroll. If non-nil, then show the maximum output when the window is scrolled. See variable `term-scroll-to-bottom-on-output'. This variable is buffer-local.") ;; Where gud-display-frame should put the debugging arrow. This is ;; set by the marker-filter, which scans the debugger's output for ;; indications of the current pc. (defvar term-pending-frame nil) ;;; Here are the per-interpreter hooks. (defvar term-get-old-input (function term-get-old-input-default) "Function that submits old text in term mode. This function is called when return is typed while the point is in old text. It returns the text to be submitted as process input. The default is term-get-old-input-default, which grabs the current line, and strips off leading text matching term-prompt-regexp") (defvar term-dynamic-complete-functions '(term-replace-by-expanded-history term-dynamic-complete-filename) "List of functions called to perform completion. Functions should return non-nil if completion was performed. See also `term-dynamic-complete'. This is a good thing to set in mode hooks.") (defvar term-input-filter (function (lambda (str) (not (string-match "\\`\\s *\\'" str)))) "Predicate for filtering additions to input history. Only inputs answering true to this function are saved on the input history list. Default is to save anything that isn't all whitespace") (defvar term-input-filter-functions '() "Functions to call before input is sent to the process. These functions get one argument, a string containing the text to send. This variable is buffer-local.") (defvar term-input-sender (function term-simple-send) "Function to actually send to PROCESS the STRING submitted by user. Usually this is just 'term-simple-send, but if your mode needs to massage the input string, this is your hook. This is called from the user command term-send-input. term-simple-send just sends the string plus a newline.") (defvar term-eol-on-send t "*Non-nil means go to the end of the line before sending input. See `term-send-input'.") (defvar term-mode-hook '() "Called upon entry into term-mode This is run before the process is cranked up.") (defvar term-exec-hook '() "Called each time a process is exec'd by term-exec. This is called after the process is cranked up. It is useful for things that must be done each time a process is executed in a term-mode buffer (e.g., (process-kill-without-query)). In contrast, the term-mode-hook is only executed once when the buffer is created.") (defvar term-mode-map nil) (defvar term-raw-map nil "Keyboard map for sending characters directly to the inferior process.") (defvar term-escape-char nil "Escape character for char-sub-mode of term mode. Do not change it directly; use term-set-escape-char instead.") (defvar term-raw-escape-map nil) (defvar term-pager-break-map nil) (defvar term-ptyp t "True if communications via pty; false if by pipe. Buffer local. This is to work around a bug in emacs process signalling.") (defvar term-last-input-match "" "Last string searched for by term input history search, for defaulting. Buffer local variable.") (defvar term-input-ring nil) (defvar term-last-input-start) (defvar term-last-input-end) (defvar term-input-ring-index nil "Index of last matched history element.") (defvar term-matching-input-from-input-string "" "Input previously used to match input history.") ; This argument to set-process-filter disables reading from the process, ; assuming this is emacs-19.20 or newer. (defvar term-pager-filter t) (put 'term-replace-by-expanded-history 'menu-enable 'term-input-autoexpand) (put 'term-input-ring 'permanent-local t) (put 'term-input-ring-index 'permanent-local t) (put 'term-input-autoexpand 'permanent-local t) (put 'term-input-filter-functions 'permanent-local t) (put 'term-scroll-to-bottom-on-output 'permanent-local t) (put 'term-scroll-show-maximum-output 'permanent-local t) (put 'term-ptyp 'permanent-local t) ;; Do FORMS if running under Emacs-19. (defmacro term-if-emacs19 (&rest forms) (if (string-match "^19" emacs-version) (cons 'progn forms))) ;; True if running under XEmacs (previously Lucid emacs). (defmacro term-is-xemacs () '(string-match "Lucid" emacs-version)) ;; Do FORM if running under XEmacs (previously Lucid emacs). (defmacro term-if-xemacs (&rest forms) (if (term-is-xemacs) (cons 'progn forms))) ;; Do FORM if NOT running under XEmacs (previously Lucid emacs). (defmacro term-ifnot-xemacs (&rest forms) (if (not (term-is-xemacs)) (cons 'progn forms))) (defmacro term-in-char-mode () '(eq (current-local-map) term-raw-map)) (defmacro term-in-line-mode () '(not (term-in-char-mode))) ;; True if currently doing PAGER handling. (defmacro term-pager-enabled () 'term-pager-count) (defmacro term-handling-pager () 'term-pager-old-local-map) (defmacro term-using-alternate-sub-buffer () 'term-saved-home-marker) (defvar term-signals-menu) (defvar term-terminal-menu) (term-if-xemacs (defvar term-terminal-menu '("Terminal" [ "Character mode" term-char-mode (term-in-line-mode)] [ "Line mode" term-line-mode (term-in-char-mode)] [ "Enable paging" term-pager-toggle (not term-pager-count)] [ "Disable paging" term-pager-toggle term-pager-count]))) (defun term-mode () "Major mode for interacting with an inferior interpreter. Interpreter name is same as buffer name, sans the asterisks. In line sub-mode, return at end of buffer sends line as input, while return not at end copies rest of line to end and sends it. In char sub-mode, each character (except `term-escape-char`) is set immediately. This mode is typically customised to create inferior-lisp-mode, shell-mode, etc.. This can be done by setting the hooks term-input-filter-functions, term-input-filter, term-input-sender and term-get-old-input to appropriate functions, and the variable term-prompt-regexp to the appropriate regular expression. An input history is maintained of size `term-input-ring-size', and can be accessed with the commands \\[term-next-input], \\[term-previous-input], and \\[term-dynamic-list-input-ring]. Input ring history expansion can be achieved with the commands \\[term-replace-by-expanded-history] or \\[term-magic-space]. Input ring expansion is controlled by the variable `term-input-autoexpand', and addition is controlled by the variable `term-input-ignoredups'. Input to, and output from, the subprocess can cause the window to scroll to the end of the buffer. See variables `term-scroll-to-bottom-on-input', and `term-scroll-to-bottom-on-output'. If you accidentally suspend your process, use \\[term-continue-subjob] to continue it. \\{term-mode-map} Entry to this mode runs the hooks on term-mode-hook" (interactive) ;; Do not remove this. All major modes must do this. (kill-all-local-variables) (setq major-mode 'term-mode) (setq mode-name "Term") (use-local-map term-mode-map) (make-local-variable 'term-home-marker) (setq term-home-marker (copy-marker 0)) (make-local-variable 'term-saved-home-marker) (make-local-variable 'term-height) (make-local-variable 'term-width) (setq term-width (1- (window-width))) (setq term-height (1- (window-height))) (make-local-variable 'term-terminal-parameter) (make-local-variable 'term-saved-cursor) (make-local-variable 'term-last-input-start) (setq term-last-input-start (make-marker)) (make-local-variable 'term-last-input-end) (setq term-last-input-end (make-marker)) (make-local-variable 'term-last-input-match) (setq term-last-input-match "") (make-local-variable 'term-prompt-regexp) ; Don't set; default (make-local-variable 'term-input-ring-size) ; ...to global val. (make-local-variable 'term-input-ring) (make-local-variable 'term-input-ring-file-name) (or (and (boundp 'term-input-ring) term-input-ring) (setq term-input-ring (make-ring term-input-ring-size))) (make-local-variable 'term-input-ring-index) (or (and (boundp 'term-input-ring-index) term-input-ring-index) (setq term-input-ring-index nil)) (make-local-variable 'term-command-hook) (setq term-command-hook (symbol-function 'term-command-hook)) (make-local-variable 'term-terminal-state) (make-local-variable 'term-kill-echo-list) (make-local-variable 'term-start-line-column) (make-local-variable 'term-current-column) (make-local-variable 'term-current-row) (make-local-variable 'term-log-buffer) (make-local-variable 'term-scroll-start) (make-local-variable 'term-scroll-end) (setq term-scroll-end term-height) (make-local-variable 'term-scroll-with-delete) (make-local-variable 'term-pager-count) (make-local-variable 'term-pager-old-local-map) (make-local-variable 'term-old-mode-map) (make-local-variable 'term-insert-mode) (make-local-variable 'term-dynamic-complete-functions) (make-local-variable 'term-completion-fignore) (make-local-variable 'term-get-old-input) (make-local-variable 'term-matching-input-from-input-string) (make-local-variable 'term-input-autoexpand) (make-local-variable 'term-input-ignoredups) (make-local-variable 'term-delimiter-argument-list) (make-local-variable 'term-input-filter-functions) (make-local-variable 'term-input-filter) (make-local-variable 'term-input-sender) (make-local-variable 'term-eol-on-send) (make-local-variable 'term-scroll-to-bottom-on-output) (make-local-variable 'term-scroll-show-maximum-output) (make-local-variable 'term-ptyp) (make-local-variable 'term-exec-hook) (make-local-variable 'term-vertical-motion) (make-local-variable 'term-pending-delete-marker) (setq term-pending-delete-marker (make-marker)) (make-local-variable 'term-current-face) (make-local-variable 'term-pending-frame) (setq term-pending-frame nil) (run-hooks 'term-mode-hook) (term-if-xemacs (set-buffer-menubar (append current-menubar (list term-terminal-menu)))) (or term-input-ring (setq term-input-ring (make-ring term-input-ring-size))) (term-update-mode-line)) (if term-mode-map nil (setq term-mode-map (make-sparse-keymap)) (define-key term-mode-map "\ep" 'term-previous-input) (define-key term-mode-map "\en" 'term-next-input) (define-key term-mode-map "\er" 'term-previous-matching-input) (define-key term-mode-map "\es" 'term-next-matching-input) (term-ifnot-xemacs (define-key term-mode-map [?\A-\M-r] 'term-previous-matching-input-from-input) (define-key term-mode-map [?\A-\M-s] 'term-next-matching-input-from-input)) (define-key term-mode-map "\e\C-l" 'term-show-output) (define-key term-mode-map "\C-m" 'term-send-input) (define-key term-mode-map "\C-d" 'term-delchar-or-maybe-eof) (define-key term-mode-map "\C-c\C-a" 'term-bol) (define-key term-mode-map "\C-c\C-u" 'term-kill-input) (define-key term-mode-map "\C-c\C-w" 'backward-kill-word) (define-key term-mode-map "\C-c\C-c" 'term-interrupt-subjob) (define-key term-mode-map "\C-c\C-z" 'term-stop-subjob) (define-key term-mode-map "\C-c\C-\\" 'term-quit-subjob) (define-key term-mode-map "\C-c\C-m" 'term-copy-old-input) (define-key term-mode-map "\C-c\C-o" 'term-kill-output) (define-key term-mode-map "\C-c\C-r" 'term-show-output) (define-key term-mode-map "\C-c\C-e" 'term-show-maximum-output) (define-key term-mode-map "\C-c\C-l" 'term-dynamic-list-input-ring) (define-key term-mode-map "\C-c\C-n" 'term-next-prompt) (define-key term-mode-map "\C-c\C-p" 'term-previous-prompt) (define-key term-mode-map "\C-c\C-d" 'term-send-eof) (define-key term-mode-map "\C-c\C-k" 'term-char-mode) (define-key term-mode-map "\C-c\C-j" 'term-line-mode) (define-key term-mode-map "\C-c\C-q" 'term-pager-toggle) (copy-face 'default 'term-underline-face) (set-face-underline-p 'term-underline-face t) ; ;; completion: ; (define-key term-mode-map [menu-bar completion] ; (cons "Complete" (make-sparse-keymap "Complete"))) ; (define-key term-mode-map [menu-bar completion complete-expand] ; '("Expand File Name" . term-replace-by-expanded-filename)) ; (define-key term-mode-map [menu-bar completion complete-listing] ; '("File Completion Listing" . term-dynamic-list-filename-completions)) ; (define-key term-mode-map [menu-bar completion complete-file] ; '("Complete File Name" . term-dynamic-complete-filename)) ; (define-key term-mode-map [menu-bar completion complete] ; '("Complete Before Point" . term-dynamic-complete)) ; ;; Put them in the menu bar: ; (setq menu-bar-final-items (append '(terminal completion inout signals) ; menu-bar-final-items)) ) ;; Menu bars: (term-ifnot-xemacs (term-if-emacs19 ;; terminal: (let (newmap) (setq newmap (make-sparse-keymap "Terminal")) (define-key newmap [terminal-pager-enable] '("Enable paging" . term-fake-pager-enable)) (define-key newmap [terminal-pager-disable] '("Disable paging" . term-fake-pager-disable)) (define-key newmap [terminal-char-mode] '("Character mode" . term-char-mode)) (define-key newmap [terminal-line-mode] '("Line mode" . term-line-mode)) (define-key newmap [menu-bar terminal] (setq term-terminal-menu (cons "Terminal" newmap))) ;; completion: (line mode only) (defvar term-completion-menu (make-sparse-keymap "Complete")) (define-key term-mode-map [menu-bar completion] (cons "Complete" term-completion-menu)) (define-key term-completion-menu [complete-expand] '("Expand File Name" . term-replace-by-expanded-filename)) (define-key term-completion-menu [complete-listing] '("File Completion Listing" . term-dynamic-list-filename-completions)) (define-key term-completion-menu [menu-bar completion complete-file] '("Complete File Name" . term-dynamic-complete-filename)) (define-key term-completion-menu [menu-bar completion complete] '("Complete Before Point" . term-dynamic-complete)) ;; Input history: (line mode only) (defvar term-inout-menu (make-sparse-keymap "In/Out")) (define-key term-mode-map [menu-bar inout] (cons "In/Out" term-inout-menu)) (define-key term-inout-menu [kill-output] '("Kill Current Output Group" . term-kill-output)) (define-key term-inout-menu [next-prompt] '("Forward Output Group" . term-next-prompt)) (define-key term-inout-menu [previous-prompt] '("Backward Output Group" . term-previous-prompt)) (define-key term-inout-menu [show-maximum-output] '("Show Maximum Output" . term-show-maximum-output)) (define-key term-inout-menu [show-output] '("Show Current Output Group" . term-show-output)) (define-key term-inout-menu [kill-input] '("Kill Current Input" . term-kill-input)) (define-key term-inout-menu [copy-input] '("Copy Old Input" . term-copy-old-input)) (define-key term-inout-menu [forward-matching-history] '("Forward Matching Input..." . term-forward-matching-input)) (define-key term-inout-menu [backward-matching-history] '("Backward Matching Input..." . term-backward-matching-input)) (define-key term-inout-menu [next-matching-history] '("Next Matching Input..." . term-next-matching-input)) (define-key term-inout-menu [previous-matching-history] '("Previous Matching Input..." . term-previous-matching-input)) (define-key term-inout-menu [next-matching-history-from-input] '("Next Matching Current Input" . term-next-matching-input-from-input)) (define-key term-inout-menu [previous-matching-history-from-input] '("Previous Matching Current Input" . term-previous-matching-input-from-input)) (define-key term-inout-menu [next-history] '("Next Input" . term-next-input)) (define-key term-inout-menu [previous-history] '("Previous Input" . term-previous-input)) (define-key term-inout-menu [list-history] '("List Input History" . term-dynamic-list-input-ring)) (define-key term-inout-menu [expand-history] '("Expand History Before Point" . term-replace-by-expanded-history)) ;; Signals (setq newmap (make-sparse-keymap "Signals")) (define-key newmap [eof] '("EOF" . term-send-eof)) (define-key newmap [kill] '("KILL" . term-kill-subjob)) (define-key newmap [quit] '("QUIT" . term-quit-subjob)) (define-key newmap [cont] '("CONT" . term-continue-subjob)) (define-key newmap [stop] '("STOP" . term-stop-subjob)) (define-key newmap [] '("BREAK" . term-interrupt-subjob)) (define-key term-mode-map [menu-bar signals] (setq term-signals-menu (cons "Signals" newmap))) ))) (defun term-reset-size (height width) (setq term-height height) (setq term-width width) (setq term-start-line-column nil) (setq term-current-row nil) (setq term-current-column nil) (term-scroll-region 0 height)) ;; Recursive routine used to check if any string in term-kill-echo-list ;; matches part of the buffer before point. ;; If so, delete that matched part of the buffer - this suppresses echo. ;; Also, remove that string from the term-kill-echo-list. ;; We *also* remove any older string on the list, as a sanity measure, ;; in case something gets out of sync. (Except for type-ahead, there ;; should only be one element in the list.) (defun term-check-kill-echo-list () (let ((cur term-kill-echo-list) (found nil) (save-point (point))) (unwind-protect (progn (end-of-line) (while cur (let* ((str (car cur)) (len (length str)) (start (- (point) len))) (if (and (>= start (point-min)) (string= str (buffer-substring start (point)))) (progn (delete-backward-char len) (setq term-kill-echo-list (cdr cur)) (setq term-current-column nil) (setq term-current-row nil) (setq term-start-line-column nil) (setq cur nil found t)) (setq cur (cdr cur)))))) (if (not found) (goto-char save-point))) found)) (defun term-check-size (process) (if (or (/= term-height (1- (window-height))) (/= term-width (1- (window-width)))) (progn (term-reset-size (1- (window-height)) (1- (window-width))) (set-process-window-size process term-height term-width)))) (defun term-send-raw-string (chars) (let ((proc (get-buffer-process (current-buffer)))) (if (not proc) (error "Current buffer has no process") ;; Note that (term-current-row) must be called *after* ;; (point) has been updated to (process-mark proc). (goto-char (process-mark proc)) (if (term-pager-enabled) (setq term-pager-count (term-current-row))) (send-string proc chars)))) (defun term-send-raw () "Send the last character typed through the terminal-emulator without any interpretation." (interactive) ;; Convert `return' to C-m, etc. (if (and (symbolp last-input-char) (get last-input-char 'ascii-character)) (setq last-input-char (get last-input-char 'ascii-character))) (term-send-raw-string (make-string 1 last-input-char))) (defun term-send-raw-meta () (interactive) (if (symbolp last-input-char) ;; Convert `return' to C-m, etc. (let ((tmp (get last-input-char 'event-symbol-elements))) (if tmp (setq last-input-char (car tmp))) (if (symbolp last-input-char) (progn (setq tmp (get last-input-char 'ascii-character)) (if tmp (setq last-input-char tmp)))))) (term-send-raw-string (if (and (numberp last-input-char) (> last-input-char 127) (< last-input-char 256)) (make-string 1 last-input-char) (format "\e%c" last-input-char)))) (defun term-mouse-paste (click arg) "Insert the last stretch of killed text at the position clicked on." (interactive "e\nP") (term-if-xemacs (term-send-raw-string (or (condition-case () (x-get-selection) (error ())) (x-get-cutbuffer) (error "No selection or cut buffer available")))) (term-ifnot-xemacs ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (setq this-command 'yank) (term-send-raw-string (current-kill (cond ((listp arg) 0) ((eq arg '-) -1) (t (1- arg))))))) ;; Which would be better: "\e[A" or "\eOA"? readline accepts either. (defun term-send-up () (interactive) (term-send-raw-string "\e[A")) (defun term-send-down () (interactive) (term-send-raw-string "\e[B")) (defun term-send-right () (interactive) (term-send-raw-string "\e[C")) (defun term-send-left () (interactive) (term-send-raw-string "\e[D")) (defun term-set-escape-char (c) "Change term-escape-char and keymaps that depend on it." (if term-escape-char (define-key term-raw-map term-escape-char 'term-send-raw)) (setq c (make-string 1 c)) (define-key term-raw-map c term-raw-escape-map) ;; Define standard binings in term-raw-escape-map (define-key term-raw-escape-map "\C-x" (lookup-key (current-global-map) "\C-x")) (define-key term-raw-escape-map "\C-v" (lookup-key (current-global-map) "\C-v")) (define-key term-raw-escape-map "\C-u" (lookup-key (current-global-map) "\C-u")) (define-key term-raw-escape-map c 'term-send-raw) (define-key term-raw-escape-map "\C-q" 'term-pager-toggle) ;; The keybinding for term-char-mode is needed by the menubar code. (define-key term-raw-escape-map "\C-k" 'term-char-mode) (define-key term-raw-escape-map "\C-j" 'term-line-mode)) (defun term-char-mode () "Switch to char (\"raw\") sub-mode of term mode. Each character you type is sent directly to the inferior without intervention from emacs, except for the escape character (usually C-c)." (interactive) (if (not term-raw-map) (let* ((map (make-keymap)) (esc-map (make-keymap)) (i 0)) (while (< i 128) (define-key map (make-string 1 i) 'term-send-raw) (define-key esc-map (make-string 1 i) 'term-send-raw-meta) (setq i (1+ i))) (define-key map "\e" esc-map) (setq term-raw-map map) (setq term-raw-escape-map (copy-keymap (lookup-key (current-global-map) "\C-x"))) (term-if-emacs19 (term-if-xemacs (define-key term-raw-map [button2] 'term-mouse-paste)) (term-ifnot-xemacs (define-key term-raw-map [mouse-2] 'term-mouse-paste) (define-key term-raw-map [menu-bar terminal] term-terminal-menu) (define-key term-raw-map [menu-bar signals] term-signals-menu)) (define-key term-raw-map [up] 'term-send-up) (define-key term-raw-map [down] 'term-send-down) (define-key term-raw-map [right] 'term-send-right) (define-key term-raw-map [left] 'term-send-left)) (term-set-escape-char ?\C-c))) ;; FIXME: Emit message? Cfr ilisp-raw-message (if (term-in-line-mode) (progn (setq term-old-mode-map (current-local-map)) (use-local-map term-raw-map) ;; Send existing partial line to inferior (without newline). (let ((pmark (process-mark (get-buffer-process (current-buffer)))) (save-input-sender term-input-sender)) (if (> (point) pmark) (unwind-protect (progn (setq term-input-sender (symbol-function 'term-send-string)) (end-of-line) (term-send-input)) (setq term-input-sender save-input-sender)))) (term-update-mode-line)))) (defun term-line-mode () "Switch to line (\"cooked\") sub-mode of term mode. This means that emacs editing commands work as normally, until you type \\[term-send-input] which sends the current line to the inferior." (interactive) (if (term-in-char-mode) (progn (use-local-map term-old-mode-map) (term-update-mode-line)))) (defun term-update-mode-line () (setq mode-line-process (if (term-in-char-mode) (if (term-pager-enabled) '(": char page %s") '(": char %s")) (if (term-pager-enabled) '(": line page %s") '(": line %s")))) (force-mode-line-update)) (defun term-check-proc (buffer) "True if there is a process associated w/buffer BUFFER, and it is alive (status RUN or STOP). BUFFER can be either a buffer or the name of one" (let ((proc (get-buffer-process buffer))) (and proc (memq (process-status proc) '(run stop))))) ;;; Note that this guy, unlike shell.el's make-shell, barfs if you pass it () ;;; for the second argument (program). ;;;###autoload (defun make-term (name program &optional startfile &rest switches) "Make a term process NAME in a buffer, running PROGRAM. The name of the buffer is made by surrounding NAME with `*'s. If there is already a running process in that buffer, it is not restarted. Optional third arg STARTFILE is the name of a file to send the contents of to the process. Any more args are arguments to PROGRAM." (let ((buffer (get-buffer-create (concat "*" name "*")))) ;; If no process, or nuked process, crank up a new one and put buffer in ;; term mode. Otherwise, leave buffer and existing process alone. (cond ((not (term-check-proc buffer)) (save-excursion (set-buffer buffer) (term-mode)) ; Install local vars, mode, keymap, ... (term-exec buffer name program startfile switches))) buffer)) ;;;###autoload (defun term (program) "Start a terminal-emulator in a new buffer." (interactive (list (read-from-minibuffer "Run program: " (or explicit-shell-file-name (getenv "ESHELL") (getenv "SHELL") "/bin/sh")))) (set-buffer (make-term "terminal" program)) (term-mode) (term-char-mode) (switch-to-buffer "*terminal*")) (defun term-exec (buffer name command startfile switches) "Start up a process in buffer for term modes. Blasts any old process running in the buffer. Doesn't set the buffer mode. You can use this to cheaply run a series of processes in the same term buffer. The hook term-exec-hook is run after each exec." (save-excursion (set-buffer buffer) (let ((proc (get-buffer-process buffer))) ; Blast any old process. (if proc (delete-process proc))) ;; Crank up a new process (let ((proc (term-exec-1 name buffer command switches))) (make-local-variable 'term-ptyp) (setq term-ptyp process-connection-type) ; T if pty, NIL if pipe. ;; Jump to the end, and set the process mark. (goto-char (point-max)) (set-marker (process-mark proc) (point)) (set-process-filter proc 'term-emulate-terminal) ;; Feed it the startfile. (cond (startfile ;;This is guaranteed to wait long enough ;;but has bad results if the term does not prompt at all ;; (while (= size (buffer-size)) ;; (sleep-for 1)) ;;I hope 1 second is enough! (sleep-for 1) (goto-char (point-max)) (insert-file-contents startfile) (setq startfile (buffer-substring (point) (point-max))) (delete-region (point) (point-max)) (term-send-string proc startfile))) (run-hooks 'term-exec-hook) buffer))) ;;; Name to use for TERM. ;;; Using "emacs" loses, because bash disables editing if TERM == emacs. (defvar term-term-name "eterm") ; Format string, usage: (format term-termcap-string emacs-term-name "TERMCAP=" 24 80) (defvar term-termcap-format "%s%s:li#%d:co#%d:cl=\\E[H\\E[J:cd=\\E[J:bs:am:xn:cm=\\E[%%i%%d;%%dH\ :nd=\\E[C:up=\\E[A:ce=\\E[K:ho=\\E[H:pt\ :al=\\E[L:dl=\\E[M:DL=\\E[%%dM:AL=\\E[%%dL:cs=\\E[%%i%%d;%%dr:sf=\\n\ :te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\ :dc=\\E[P:DC=\\E[%%dP:IC=\\E[%%d@:im=\\E[4h:ei=\\E[4l:mi:\ :so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\ :UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC" ;;; : -undefine ic "termcap capabilties supported") ;;; This auxiliary function cranks up the process for term-exec in ;;; the appropriate environment. (defun term-exec-1 (name buffer command switches) ;; We need to do an extra (fork-less) exec to run stty. ;; (This would not be needed if we had suitable emacs primitives.) ;; The 'if ...; then shift; fi' hack is because Bourne shell ;; loses one arg when called with -c, and newer shells (bash, ksh) don't. ;; Thus we add an extra dummy argument "..", and then remove it. (let ((process-environment (nconc (list (format "TERM=%s" term-term-name) (if (and (boundp 'system-uses-terminfo) system-uses-terminfo) (format "TERMINFO=%s" data-directory) (format term-termcap-format "TERMCAP=" term-term-name term-height term-width)) (format "EMACS=%s (term:%s)" emacs-version term-protocol-version) (format "LINES=%d" term-height) (format "COLUMNS=%d" term-width)) process-environment))) (apply 'start-process name buffer "/bin/sh" "-c" (format "stty -nl echo rows %d columns %d sane 2>/dev/null;\ if [ $1 = .. ]; then shift; fi; exec \"$@\"" term-height term-width) ".." command switches))) ;;; This should be in emacs, but it isn't. (defun term-mem (item list &optional elt=) "Test to see if ITEM is equal to an item in LIST. Option comparison function ELT= defaults to equal." (let ((elt= (or elt= (function equal))) (done nil)) (while (and list (not done)) (if (funcall elt= item (car list)) (setq done list) (setq list (cdr list)))) done)) ;;; Input history processing in a buffer ;;; =========================================================================== ;;; Useful input history functions, courtesy of the Ergo group. ;;; Eleven commands: ;;; term-dynamic-list-input-ring List history in help buffer. ;;; term-previous-input Previous input... ;;; term-previous-matching-input ...matching a string. ;;; term-previous-matching-input-from-input ... matching the current input. ;;; term-next-input Next input... ;;; term-next-matching-input ...matching a string. ;;; term-next-matching-input-from-input ... matching the current input. ;;; term-backward-matching-input Backwards input... ;;; term-forward-matching-input ...matching a string. ;;; term-replace-by-expanded-history Expand history at point; ;;; replace with expanded history. ;;; term-magic-space Expand history and insert space. ;;; ;;; Three functions: ;;; term-read-input-ring Read into term-input-ring... ;;; term-write-input-ring Write to term-input-ring-file-name. ;;; term-replace-by-expanded-history-before-point Workhorse function. (defun term-read-input-ring (&optional silent) "Sets the buffer's `term-input-ring' from a history file. The name of the file is given by the variable `term-input-ring-file-name'. The history ring is of size `term-input-ring-size', regardless of file size. If `term-input-ring-file-name' is nil this function does nothing. If the optional argument SILENT is non-nil, we say nothing about a failure to read the history file. This function is useful for major mode commands and mode hooks. The structure of the history file should be one input command per line, with the most recent command last. See also `term-input-ignoredups' and `term-write-input-ring'." (cond ((or (null term-input-ring-file-name) (equal term-input-ring-file-name "")) nil) ((not (file-readable-p term-input-ring-file-name)) (or silent (message "Cannot read history file %s" term-input-ring-file-name))) (t (let ((history-buf (get-buffer-create " *temp*")) (file term-input-ring-file-name) (count 0) (ring (make-ring term-input-ring-size))) (unwind-protect (save-excursion (set-buffer history-buf) (widen) (erase-buffer) (insert-file-contents file) ;; Save restriction in case file is already visited... ;; Watch for those date stamps in history files! (goto-char (point-max)) (while (and (< count term-input-ring-size) (re-search-backward "^[ \t]*\\([^#\n].*\\)[ \t]*$" nil t)) (let ((history (buffer-substring (match-beginning 1) (match-end 1)))) (if (or (null term-input-ignoredups) (ring-empty-p ring) (not (string-equal (ring-ref ring 0) history))) (ring-insert-at-beginning ring history))) (setq count (1+ count)))) (kill-buffer history-buf)) (setq term-input-ring ring term-input-ring-index nil))))) (defun term-write-input-ring () "Writes the buffer's `term-input-ring' to a history file. The name of the file is given by the variable `term-input-ring-file-name'. The original contents of the file are lost if `term-input-ring' is not empty. If `term-input-ring-file-name' is nil this function does nothing. Useful within process sentinels. See also `term-read-input-ring'." (cond ((or (null term-input-ring-file-name) (equal term-input-ring-file-name "") (null term-input-ring) (ring-empty-p term-input-ring)) nil) ((not (file-writable-p term-input-ring-file-name)) (message "Cannot write history file %s" term-input-ring-file-name)) (t (let* ((history-buf (get-buffer-create " *Temp Input History*")) (ring term-input-ring) (file term-input-ring-file-name) (index (ring-length ring))) ;; Write it all out into a buffer first. Much faster, but messier, ;; than writing it one line at a time. (save-excursion (set-buffer history-buf) (erase-buffer) (while (> index 0) (setq index (1- index)) (insert (ring-ref ring index) ?\n)) (write-region (buffer-string) nil file nil 'no-message) (kill-buffer nil)))))) (defun term-dynamic-list-input-ring () "List in help buffer the buffer's input history." (interactive) (if (or (not (ring-p term-input-ring)) (ring-empty-p term-input-ring)) (message "No history") (let ((history nil) (history-buffer " *Input History*") (index (1- (ring-length term-input-ring))) (conf (current-window-configuration))) ;; We have to build up a list ourselves from the ring vector. (while (>= index 0) (setq history (cons (ring-ref term-input-ring index) history) index (1- index))) ;; Change "completion" to "history reference" ;; to make the display accurate. (with-output-to-temp-buffer history-buffer (display-completion-list history) (set-buffer history-buffer) (forward-line 3) (while (search-backward "completion" nil 'move) (replace-match "history reference"))) (sit-for 0) (message "Hit space to flush") (let ((ch (read-event))) (if (eq ch ?\ ) (set-window-configuration conf) (setq unread-command-events (list ch))))))) (defun term-regexp-arg (prompt) ;; Return list of regexp and prefix arg using PROMPT. (let* ((minibuffer-history-sexp-flag nil) ;; Don't clobber this. (last-command last-command) (regexp (read-from-minibuffer prompt nil nil nil 'minibuffer-history-search-history))) (list (if (string-equal regexp "") (setcar minibuffer-history-search-history (nth 1 minibuffer-history-search-history)) regexp) (prefix-numeric-value current-prefix-arg)))) (defun term-search-arg (arg) ;; First make sure there is a ring and that we are after the process mark (cond ((not (term-after-pmark-p)) (error "Not at command line")) ((or (null term-input-ring) (ring-empty-p term-input-ring)) (error "Empty input ring")) ((zerop arg) ;; arg of zero resets search from beginning, and uses arg of 1 (setq term-input-ring-index nil) 1) (t arg))) (defun term-search-start (arg) ;; Index to start a directional search, starting at term-input-ring-index (if term-input-ring-index ;; If a search is running, offset by 1 in direction of arg (mod (+ term-input-ring-index (if (> arg 0) 1 -1)) (ring-length term-input-ring)) ;; For a new search, start from beginning or end, as appropriate (if (>= arg 0) 0 ; First elt for forward search (1- (ring-length term-input-ring))))) ; Last elt for backward search (defun term-previous-input-string (arg) "Return the string ARG places along the input ring. Moves relative to `term-input-ring-index'." (ring-ref term-input-ring (if term-input-ring-index (mod (+ arg term-input-ring-index) (ring-length term-input-ring)) arg))) (defun term-previous-input (arg) "Cycle backwards through input history." (interactive "*p") (term-previous-matching-input "." arg)) (defun term-next-input (arg) "Cycle forwards through input history." (interactive "*p") (term-previous-input (- arg))) (defun term-previous-matching-input-string (regexp arg) "Return the string matching REGEXP ARG places along the input ring. Moves relative to `term-input-ring-index'." (let* ((pos (term-previous-matching-input-string-position regexp arg))) (if pos (ring-ref term-input-ring pos)))) (defun term-previous-matching-input-string-position (regexp arg &optional start) "Return the index matching REGEXP ARG places along the input ring. Moves relative to START, or `term-input-ring-index'." (if (or (not (ring-p term-input-ring)) (ring-empty-p term-input-ring)) (error "No history")) (let* ((len (ring-length term-input-ring)) (motion (if (> arg 0) 1 -1)) (n (mod (- (or start (term-search-start arg)) motion) len)) (tried-each-ring-item nil) (prev nil)) ;; Do the whole search as many times as the argument says. (while (and (/= arg 0) (not tried-each-ring-item)) ;; Step once. (setq prev n n (mod (+ n motion) len)) ;; If we haven't reached a match, step some more. (while (and (< n len) (not tried-each-ring-item) (not (string-match regexp (ring-ref term-input-ring n)))) (setq n (mod (+ n motion) len) ;; If we have gone all the way around in this search. tried-each-ring-item (= n prev))) (setq arg (if (> arg 0) (1- arg) (1+ arg)))) ;; Now that we know which ring element to use, if we found it, return that. (if (string-match regexp (ring-ref term-input-ring n)) n))) (defun term-previous-matching-input (regexp arg) "Search backwards through input history for match for REGEXP. \(Previous history elements are earlier commands.) With prefix argument N, search for Nth previous match. If N is negative, find the next or Nth next match." (interactive (term-regexp-arg "Previous input matching (regexp): ")) (setq arg (term-search-arg arg)) (let ((pos (term-previous-matching-input-string-position regexp arg))) ;; Has a match been found? (if (null pos) (error "Not found") (setq term-input-ring-index pos) (message "History item: %d" (1+ pos)) (delete-region ;; Can't use kill-region as it sets this-command (process-mark (get-buffer-process (current-buffer))) (point)) (insert (ring-ref term-input-ring pos))))) (defun term-next-matching-input (regexp arg) "Search forwards through input history for match for REGEXP. \(Later history elements are more recent commands.) With prefix argument N, search for Nth following match. If N is negative, find the previous or Nth previous match." (interactive (term-regexp-arg "Next input matching (regexp): ")) (term-previous-matching-input regexp (- arg))) (defun term-previous-matching-input-from-input (arg) "Search backwards through input history for match for current input. \(Previous history elements are earlier commands.) With prefix argument N, search for Nth previous match. If N is negative, search forwards for the -Nth following match." (interactive "p") (if (not (memq last-command '(term-previous-matching-input-from-input term-next-matching-input-from-input))) ;; Starting a new search (setq term-matching-input-from-input-string (buffer-substring (process-mark (get-buffer-process (current-buffer))) (point)) term-input-ring-index nil)) (term-previous-matching-input (concat "^" (regexp-quote term-matching-input-from-input-string)) arg)) (defun term-next-matching-input-from-input (arg) "Search forwards through input history for match for current input. \(Following history elements are more recent commands.) With prefix argument N, search for Nth following match. If N is negative, search backwards for the -Nth previous match." (interactive "p") (term-previous-matching-input-from-input (- arg))) (defun term-replace-by-expanded-history (&optional silent) "Expand input command history references before point. Expansion is dependent on the value of `term-input-autoexpand'. This function depends on the buffer's idea of the input history, which may not match the command interpreter's idea, assuming it has one. Assumes history syntax is like typical Un*x shells'. However, since emacs cannot know the interpreter's idea of input line numbers, assuming it has one, it cannot expand absolute input line number references. If the optional argument SILENT is non-nil, never complain even if history reference seems erroneous. See `term-magic-space' and `term-replace-by-expanded-history-before-point'. Returns t if successful." (interactive) (if (and term-input-autoexpand (string-match "[!^]" (funcall term-get-old-input)) (save-excursion (beginning-of-line) (looking-at term-prompt-regexp))) ;; Looks like there might be history references in the command. (let ((previous-modified-tick (buffer-modified-tick))) (message "Expanding history references...") (term-replace-by-expanded-history-before-point silent) (/= previous-modified-tick (buffer-modified-tick))))) (defun term-replace-by-expanded-history-before-point (silent) "Expand directory stack reference before point. See `term-replace-by-expanded-history'. Returns t if successful." (save-excursion (let ((toend (- (save-excursion (end-of-line nil) (point)) (point))) (start (progn (term-bol nil) (point)))) (while (progn (skip-chars-forward "^!^" (save-excursion (end-of-line nil) (- (point) toend))) (< (point) (save-excursion (end-of-line nil) (- (point) toend)))) ;; This seems a bit complex. We look for references such as !!, !-num, ;; !foo, !?foo, !{bar}, !?{bar}, ^oh, ^my^, ^god^it, ^never^ends^. ;; If that wasn't enough, the plings can be suffixed with argument ;; range specifiers. ;; Argument ranges are complex too, so we hive off the input line, ;; referenced with plings, with the range string to `term-args'. (setq term-input-ring-index nil) (cond ((or (= (preceding-char) ?\\) (term-within-quotes start (point))) ;; The history is quoted, or we're in quotes. (goto-char (1+ (point)))) ((looking-at "![0-9]+\\($\\|[^-]\\)") ;; We cannot know the interpreter's idea of input line numbers. (goto-char (match-end 0)) (message "Absolute reference cannot be expanded")) ((looking-at "!-\\([0-9]+\\)\\(:?[0-9^$*-]+\\)?") ;; Just a number of args from `number' lines backward. (let ((number (1- (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))))) (if (<= number (ring-length term-input-ring)) (progn (replace-match (term-args (term-previous-input-string number) (match-beginning 2) (match-end 2)) t t) (setq term-input-ring-index number) (message "History item: %d" (1+ number))) (goto-char (match-end 0)) (message "Relative reference exceeds input history size")))) ((or (looking-at "!!?:?\\([0-9^$*-]+\\)") (looking-at "!!")) ;; Just a number of args from the previous input line. (replace-match (term-args (term-previous-input-string 0) (match-beginning 1) (match-end 1)) t t) (message "History item: previous")) ((looking-at "!\\??\\({\\(.+\\)}\\|\\(\\sw+\\)\\)\\(:?[0-9^$*-]+\\)?") ;; Most recent input starting with or containing (possibly ;; protected) string, maybe just a number of args. Phew. (let* ((mb1 (match-beginning 1)) (me1 (match-end 1)) (mb2 (match-beginning 2)) (me2 (match-end 2)) (exp (buffer-substring (or mb2 mb1) (or me2 me1))) (pref (if (save-match-data (looking-at "!\\?")) "" "^")) (pos (save-match-data (term-previous-matching-input-string-position (concat pref (regexp-quote exp)) 1)))) (if (null pos) (progn (goto-char (match-end 0)) (or silent (progn (message "Not found") (ding)))) (setq term-input-ring-index pos) (replace-match (term-args (ring-ref term-input-ring pos) (match-beginning 4) (match-end 4)) t t) (message "History item: %d" (1+ pos))))) ((looking-at "\\^\\([^^]+\\)\\^?\\([^^]*\\)\\^?") ;; Quick substitution on the previous input line. (let ((old (buffer-substring (match-beginning 1) (match-end 1))) (new (buffer-substring (match-beginning 2) (match-end 2))) (pos nil)) (replace-match (term-previous-input-string 0) t t) (setq pos (point)) (goto-char (match-beginning 0)) (if (not (search-forward old pos t)) (or silent (error "Not found")) (replace-match new t t) (message "History item: substituted")))) (t (goto-char (match-end 0)))))))) (defun term-magic-space (arg) "Expand input history references before point and insert ARG spaces. A useful command to bind to SPC. See `term-replace-by-expanded-history'." (interactive "p") (term-replace-by-expanded-history) (self-insert-command arg)) (defun term-within-quotes (beg end) "Return t if the number of quotes between BEG and END is odd. Quotes are single and double." (let ((countsq (term-how-many-region "\\(^\\|[^\\\\]\\)\'" beg end)) (countdq (term-how-many-region "\\(^\\|[^\\\\]\\)\"" beg end))) (or (= (mod countsq 2) 1) (= (mod countdq 2) 1)))) (defun term-how-many-region (regexp beg end) "Return number of matches for REGEXP from BEG to END." (let ((count 0)) (save-excursion (save-match-data (goto-char beg) (while (re-search-forward regexp end t) (setq count (1+ count))))) count)) (defun term-args (string begin end) ;; From STRING, return the args depending on the range specified in the text ;; from BEGIN to END. If BEGIN is nil, assume all args. Ignore leading `:'. ;; Range can be x-y, x-, -y, where x/y can be [0-9], *, ^, $. (save-match-data (if (null begin) (term-arguments string 0 nil) (let* ((range (buffer-substring (if (eq (char-after begin) ?:) (1+ begin) begin) end)) (nth (cond ((string-match "^[*^]" range) 1) ((string-match "^-" range) 0) ((string-equal range "$") nil) (t (string-to-number range)))) (mth (cond ((string-match "[-*$]$" range) nil) ((string-match "-" range) (string-to-number (substring range (match-end 0)))) (t nth)))) (term-arguments string nth mth))))) ;; Return a list of arguments from ARG. Break it up at the ;; delimiters in term-delimiter-argument-list. Returned list is backwards. (defun term-delim-arg (arg) (if (null term-delimiter-argument-list) (list arg) (let ((args nil) (pos 0) (len (length arg))) (while (< pos len) (let ((char (aref arg pos)) (start pos)) (if (memq char term-delimiter-argument-list) (while (and (< pos len) (eq (aref arg pos) char)) (setq pos (1+ pos))) (while (and (< pos len) (not (memq (aref arg pos) term-delimiter-argument-list))) (setq pos (1+ pos)))) (setq args (cons (substring arg start pos) args)))) args))) (defun term-arguments (string nth mth) "Return from STRING the NTH to MTH arguments. NTH and/or MTH can be nil, which means the last argument. Returned arguments are separated by single spaces. We assume whitespace separates arguments, except within quotes. Also, a run of one or more of a single character in `term-delimiter-argument-list' is a separate argument. Argument 0 is the command name." (let ((argpart "[^ \n\t\"'`]+\\|\\(\"[^\"]*\"\\|'[^']*'\\|`[^`]*`\\)") (args ()) (pos 0) (count 0) beg str value quotes) ;; Build a list of all the args until we have as many as we want. (while (and (or (null mth) (<= count mth)) (string-match argpart string pos)) (if (and beg (= pos (match-beginning 0))) ;; It's contiguous, part of the same arg. (setq pos (match-end 0) quotes (or quotes (match-beginning 1))) ;; It's a new separate arg. (if beg ;; Put the previous arg, if there was one, onto ARGS. (setq str (substring string beg pos) args (if quotes (cons str args) (nconc (term-delim-arg str) args)) count (1+ count))) (setq quotes (match-beginning 1)) (setq beg (match-beginning 0)) (setq pos (match-end 0)))) (if beg (setq str (substring string beg pos) args (if quotes (cons str args) (nconc (term-delim-arg str) args)) count (1+ count))) (let ((n (or nth (1- count))) (m (if mth (1- (- count mth)) 0))) (mapconcat (function (lambda (a) a)) (nthcdr n (nreverse (nthcdr m args))) " ")))) ;;; ;;; Input processing stuff [line mode] ;;; (defun term-send-input () "Send input to process. After the process output mark, sends all text from the process mark to point as input to the process. Before the process output mark, calls value of variable term-get-old-input to retrieve old input, copies it to the process mark, and sends it. A terminal newline is also inserted into the buffer and sent to the process. The list of function names contained in the value of `term-input-filter-functions' is called on the input before sending it. The input is entered into the input history ring, if the value of variable term-input-filter returns non-nil when called on the input. Any history reference may be expanded depending on the value of the variable `term-input-autoexpand'. The list of function names contained in the value of `term-input-filter-functions' is called on the input before sending it. The input is entered into the input history ring, if the value of variable `term-input-filter' returns non-nil when called on the input. If variable `term-eol-on-send' is non-nil, then point is moved to the end of line before sending the input. The values of `term-get-old-input', `term-input-filter-functions', and `term-input-filter' are chosen according to the command interpreter running in the buffer. E.g., If the interpreter is the csh, term-get-old-input is the default: take the current line, discard any initial string matching regexp term-prompt-regexp. term-input-filter-functions monitors input for \"cd\", \"pushd\", and \"popd\" commands. When it sees one, it cd's the buffer. term-input-filter is the default: returns T if the input isn't all white space. If the term is Lucid Common Lisp, term-get-old-input snarfs the sexp ending at point. term-input-filter-functions does nothing. term-input-filter returns NIL if the input matches input-filter-regexp, which matches (1) all whitespace (2) :a, :c, etc. Similarly for Soar, Scheme, etc." (interactive) ;; Note that the input string does not include its terminal newline. (let ((proc (get-buffer-process (current-buffer)))) (if (not proc) (error "Current buffer has no process") (let* ((pmark (process-mark proc)) (pmark-val (marker-position pmark)) (input-is-new (>= (point) pmark-val)) (intxt (if input-is-new (progn (if term-eol-on-send (end-of-line)) (buffer-substring pmark (point))) (funcall term-get-old-input))) (input (if (not (eq term-input-autoexpand 'input)) ;; Just whatever's already there intxt ;; Expand and leave it visible in buffer (term-replace-by-expanded-history t) (buffer-substring pmark (point)))) (history (if (not (eq term-input-autoexpand 'history)) input ;; This is messy 'cos ultimately the original ;; functions used do insertion, rather than return ;; strings. We have to expand, then insert back. (term-replace-by-expanded-history t) (let ((copy (buffer-substring pmark (point)))) (delete-region pmark (point)) (insert input) copy)))) (if (term-pager-enabled) (save-excursion (goto-char (process-mark proc)) (setq term-pager-count (term-current-row)))) (if (and (funcall term-input-filter history) (or (null term-input-ignoredups) (not (ring-p term-input-ring)) (ring-empty-p term-input-ring) (not (string-equal (ring-ref term-input-ring 0) history)))) (ring-insert term-input-ring history)) (let ((functions term-input-filter-functions)) (while functions (funcall (car functions) (concat input "\n")) (setq functions (cdr functions)))) (setq term-input-ring-index nil) ;; Update the markers before we send the input ;; in case we get output amidst sending the input. (set-marker term-last-input-start pmark) (set-marker term-last-input-end (point)) (if input-is-new (progn ;; Set up to delete, because inferior should echo. (if (marker-buffer term-pending-delete-marker) (delete-region term-pending-delete-marker pmark)) (set-marker term-pending-delete-marker pmark-val) (set-marker (process-mark proc) (point)))) (goto-char pmark) (funcall term-input-sender proc input))))) (defun term-get-old-input-default () "Default for term-get-old-input. Take the current line, and discard any initial text matching term-prompt-regexp." (save-excursion (beginning-of-line) (term-skip-prompt) (let ((beg (point))) (end-of-line) (buffer-substring beg (point))))) (defun term-copy-old-input () "Insert after prompt old input at point as new input to be edited. Calls `term-get-old-input' to get old input." (interactive) (let ((input (funcall term-get-old-input)) (process (get-buffer-process (current-buffer)))) (if (not process) (error "Current buffer has no process") (goto-char (process-mark process)) (insert input)))) (defun term-skip-prompt () "Skip past the text matching regexp term-prompt-regexp. If this takes us past the end of the current line, don't skip at all." (let ((eol (save-excursion (end-of-line) (point)))) (if (and (looking-at term-prompt-regexp) (<= (match-end 0) eol)) (goto-char (match-end 0))))) (defun term-after-pmark-p () "Is point after the process output marker?" ;; Since output could come into the buffer after we looked at the point ;; but before we looked at the process marker's value, we explicitly ;; serialise. This is just because I don't know whether or not emacs ;; services input during execution of lisp commands. (let ((proc-pos (marker-position (process-mark (get-buffer-process (current-buffer)))))) (<= proc-pos (point)))) (defun term-simple-send (proc string) "Default function for sending to PROC input STRING. This just sends STRING plus a newline. To override this, set the hook TERM-INPUT-SENDER." (term-send-string proc string) (term-send-string proc "\n")) (defun term-bol (arg) "Goes to the beginning of line, then skips past the prompt, if any. If a prefix argument is given (\\[universal-argument]), then no prompt skip -- go straight to column 0. The prompt skip is done by skipping text matching the regular expression term-prompt-regexp, a buffer local variable." (interactive "P") (beginning-of-line) (if (null arg) (term-skip-prompt))) ;;; These two functions are for entering text you don't want echoed or ;;; saved -- typically passwords to ftp, telnet, or somesuch. ;;; Just enter m-x term-send-invisible and type in your line. (defun term-read-noecho (prompt &optional stars) "Read a single line of text from user without echoing, and return it. Prompt with argument PROMPT, a string. Optional argument STARS causes input to be echoed with '*' characters on the prompt line. Input ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. C-g aborts (if `inhibit-quit' is set because e.g. this function was called from a process filter and C-g is pressed, this function returns nil rather than a string). Note that the keystrokes comprising the text can still be recovered \(temporarily) with \\[view-lossage]. This may be a security bug for some applications." (let ((ans "") (c 0) (echo-keystrokes 0) (cursor-in-echo-area t) (done nil)) (while (not done) (if stars (message "%s%s" prompt (make-string (length ans) ?*)) (message prompt)) (setq c (read-char)) (cond ((= c ?\C-g) ;; This function may get called from a process filter, where ;; inhibit-quit is set. In later versions of emacs read-char ;; may clear quit-flag itself and return C-g. That would make ;; it impossible to quit this loop in a simple way, so ;; re-enable it here (for backward-compatibility the check for ;; quit-flag below would still be necessary, so this seems ;; like the simplest way to do things). (setq quit-flag t done t)) ((or (= c ?\r) (= c ?\n) (= c ?\e)) (setq done t)) ((= c ?\C-u) (setq ans "")) ((and (/= c ?\b) (/= c ?\177)) (setq ans (concat ans (char-to-string c)))) ((> (length ans) 0) (setq ans (substring ans 0 -1))))) (if quit-flag ;; Emulate a true quit, except that we have to return a value. (prog1 (setq quit-flag nil) (message "Quit") (beep t)) (message "") ans))) (defun term-send-invisible (str &optional proc) "Read a string without echoing. Then send it to the process running in the current buffer. A new-line is additionally sent. String is not saved on term input history list. Security bug: your string can still be temporarily recovered with \\[view-lossage]." (interactive "P") ; Defeat snooping via C-x esc (if (not (stringp str)) (setq str (term-read-noecho "Non-echoed text: " t))) (if (not proc) (setq proc (get-buffer-process (current-buffer)))) (if (not proc) (error "Current buffer has no process") (setq term-kill-echo-list (nconc term-kill-echo-list (cons str nil))) (term-send-string proc str) (term-send-string proc "\n"))) ;;; Low-level process communication (defvar term-input-chunk-size 512 "*Long inputs send to term processes are broken up into chunks of this size. If your process is choking on big inputs, try lowering the value.") (defun term-send-string (proc str) "Send PROCESS the contents of STRING as input. This is equivalent to process-send-string, except that long input strings are broken up into chunks of size term-input-chunk-size. Processes are given a chance to output between chunks. This can help prevent processes from hanging when you send them long inputs on some OS's." (let* ((len (length str)) (i (min len term-input-chunk-size))) (process-send-string proc (substring str 0 i)) (while (< i len) (let ((next-i (+ i term-input-chunk-size))) (accept-process-output) (process-send-string proc (substring str i (min len next-i))) (setq i next-i))))) (defun term-send-region (proc start end) "Sends to PROC the region delimited by START and END. This is a replacement for process-send-region that tries to keep your process from hanging on long inputs. See term-send-string." (term-send-string proc (buffer-substring start end))) ;;; Random input hackage (defun term-kill-output () "Kill all output from interpreter since last input." (interactive) (let ((pmark (process-mark (get-buffer-process (current-buffer))))) (kill-region term-last-input-end pmark) (goto-char pmark) (insert "*** output flushed ***\n") (set-marker pmark (point)))) (defun term-show-output () "Display start of this batch of interpreter output at top of window. Sets mark to the value of point when this command is run." (interactive) (goto-char term-last-input-end) (backward-char) (beginning-of-line) (set-window-start (selected-window) (point)) (end-of-line)) (defun term-interrupt-subjob () "Interrupt the current subjob." (interactive) (interrupt-process nil term-ptyp)) (defun term-kill-subjob () "Send kill signal to the current subjob." (interactive) (kill-process nil term-ptyp)) (defun term-quit-subjob () "Send quit signal to the current subjob." (interactive) (quit-process nil term-ptyp)) (defun term-stop-subjob () "Stop the current subjob. WARNING: if there is no current subjob, you can end up suspending the top-level process running in the buffer. If you accidentally do this, use \\[term-continue-subjob] to resume the process. (This is not a problem with most shells, since they ignore this signal.)" (interactive) (stop-process nil term-ptyp)) (defun term-continue-subjob () "Send CONT signal to process buffer's process group. Useful if you accidentally suspend the top-level process." (interactive) (continue-process nil term-ptyp)) (defun term-kill-input () "Kill all text from last stuff output by interpreter to point." (interactive) (let* ((pmark (process-mark (get-buffer-process (current-buffer)))) (p-pos (marker-position pmark))) (if (> (point) p-pos) (kill-region pmark (point))))) (defun term-delchar-or-maybe-eof (arg) "Delete ARG characters forward, or send an EOF to process if at end of buffer." (interactive "p") (if (eobp) (process-send-eof) (delete-char arg))) (defun term-send-eof () "Send an EOF to the current buffer's process." (interactive) (process-send-eof)) (defun term-backward-matching-input (regexp arg) "Search backward through buffer for match for REGEXP. Matches are searched for on lines that match `term-prompt-regexp'. With prefix argument N, search for Nth previous match. If N is negative, find the next or Nth next match." (interactive (term-regexp-arg "Backward input matching (regexp): ")) (let* ((re (concat term-prompt-regexp ".*" regexp)) (pos (save-excursion (end-of-line (if (> arg 0) 0 1)) (if (re-search-backward re nil t arg) (point))))) (if (null pos) (progn (message "Not found") (ding)) (goto-char pos) (term-bol nil)))) (defun term-forward-matching-input (regexp arg) "Search forward through buffer for match for REGEXP. Matches are searched for on lines that match `term-prompt-regexp'. With prefix argument N, search for Nth following match. If N is negative, find the previous or Nth previous match." (interactive (term-regexp-arg "Forward input matching (regexp): ")) (term-backward-matching-input regexp (- arg))) (defun term-next-prompt (n) "Move to end of Nth next prompt in the buffer. See `term-prompt-regexp'." (interactive "p") (let ((paragraph-start term-prompt-regexp)) (end-of-line (if (> n 0) 1 0)) (forward-paragraph n) (term-skip-prompt))) (defun term-previous-prompt (n) "Move to end of Nth previous prompt in the buffer. See `term-prompt-regexp'." (interactive "p") (term-next-prompt (- n))) ;;; Support for source-file processing commands. ;;;============================================================================ ;;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have ;;; commands that process files of source text (e.g. loading or compiling ;;; files). So the corresponding process-in-a-buffer modes have commands ;;; for doing this (e.g., lisp-load-file). The functions below are useful ;;; for defining these commands. ;;; ;;; Alas, these guys don't do exactly the right thing for Lisp, Scheme ;;; and Soar, in that they don't know anything about file extensions. ;;; So the compile/load interface gets the wrong default occasionally. ;;; The load-file/compile-file default mechanism could be smarter -- it ;;; doesn't know about the relationship between filename extensions and ;;; whether the file is source or executable. If you compile foo.lisp ;;; with compile-file, then the next load-file should use foo.bin for ;;; the default, not foo.lisp. This is tricky to do right, particularly ;;; because the extension for executable files varies so much (.o, .bin, ;;; .lbin, .mo, .vo, .ao, ...). ;;; TERM-SOURCE-DEFAULT -- determines defaults for source-file processing ;;; commands. ;;; ;;; TERM-CHECK-SOURCE -- if FNAME is in a modified buffer, asks you if you ;;; want to save the buffer before issuing any process requests to the command ;;; interpreter. ;;; ;;; TERM-GET-SOURCE -- used by the source-file processing commands to prompt ;;; for the file to process. ;;; (TERM-SOURCE-DEFAULT previous-dir/file source-modes) ;;;============================================================================ ;;; This function computes the defaults for the load-file and compile-file ;;; commands for tea, soar, cmulisp, and cmuscheme modes. ;;; ;;; - PREVIOUS-DIR/FILE is a pair (directory . filename) from the last ;;; source-file processing command. NIL if there hasn't been one yet. ;;; - SOURCE-MODES is a list used to determine what buffers contain source ;;; files: if the major mode of the buffer is in SOURCE-MODES, it's source. ;;; Typically, (lisp-mode) or (scheme-mode). ;;; ;;; If the command is given while the cursor is inside a string, *and* ;;; the string is an existing filename, *and* the filename is not a directory, ;;; then the string is taken as default. This allows you to just position ;;; your cursor over a string that's a filename and have it taken as default. ;;; ;;; If the command is given in a file buffer whose major mode is in ;;; SOURCE-MODES, then the the filename is the default file, and the ;;; file's directory is the default directory. ;;; ;;; If the buffer isn't a source file buffer (e.g., it's the process buffer), ;;; then the default directory & file are what was used in the last source-file ;;; processing command (i.e., PREVIOUS-DIR/FILE). If this is the first time ;;; the command has been run (PREVIOUS-DIR/FILE is nil), the default directory ;;; is the cwd, with no default file. (\"no default file\" = nil) ;;; ;;; SOURCE-REGEXP is typically going to be something like (tea-mode) ;;; for T programs, (lisp-mode) for Lisp programs, (soar-mode lisp-mode) ;;; for Soar programs, etc. ;;; ;;; The function returns a pair: (default-directory . default-file). (defun term-source-default (previous-dir/file source-modes) (cond ((and buffer-file-name (memq major-mode source-modes)) (cons (file-name-directory buffer-file-name) (file-name-nondirectory buffer-file-name))) (previous-dir/file) (t (cons default-directory nil)))) ;;; (TERM-CHECK-SOURCE fname) ;;;============================================================================ ;;; Prior to loading or compiling (or otherwise processing) a file (in the CMU ;;; process-in-a-buffer modes), this function can be called on the filename. ;;; If the file is loaded into a buffer, and the buffer is modified, the user ;;; is queried to see if he wants to save the buffer before proceeding with ;;; the load or compile. (defun term-check-source (fname) (let ((buff (get-file-buffer fname))) (if (and buff (buffer-modified-p buff) (y-or-n-p (format "Save buffer %s first? " (buffer-name buff)))) ;; save BUFF. (let ((old-buffer (current-buffer))) (set-buffer buff) (save-buffer) (set-buffer old-buffer))))) ;;; (TERM-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p) ;;;============================================================================ ;;; TERM-GET-SOURCE is used to prompt for filenames in command-interpreter ;;; commands that process source files (like loading or compiling a file). ;;; It prompts for the filename, provides a default, if there is one, ;;; and returns the result filename. ;;; ;;; See TERM-SOURCE-DEFAULT for more on determining defaults. ;;; ;;; PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair ;;; from the last source processing command. SOURCE-MODES is a list of major ;;; modes used to determine what file buffers contain source files. (These ;;; two arguments are used for determining defaults). If MUSTMATCH-P is true, ;;; then the filename reader will only accept a file that exists. ;;; ;;; A typical use: ;;; (interactive (term-get-source "Compile file: " prev-lisp-dir/file ;;; '(lisp-mode) t)) ;;; This is pretty stupid about strings. It decides we're in a string ;;; if there's a quote on both sides of point on the current line. (defun term-extract-string () "Returns string around POINT that starts the current line or nil." (save-excursion (let* ((point (point)) (bol (progn (beginning-of-line) (point))) (eol (progn (end-of-line) (point))) (start (progn (goto-char point) (and (search-backward "\"" bol t) (1+ (point))))) (end (progn (goto-char point) (and (search-forward "\"" eol t) (1- (point)))))) (and start end (buffer-substring start end))))) (defun term-get-source (prompt prev-dir/file source-modes mustmatch-p) (let* ((def (term-source-default prev-dir/file source-modes)) (stringfile (term-extract-string)) (sfile-p (and stringfile (condition-case () (file-exists-p stringfile) (error nil)) (not (file-directory-p stringfile)))) (defdir (if sfile-p (file-name-directory stringfile) (car def))) (deffile (if sfile-p (file-name-nondirectory stringfile) (cdr def))) (ans (read-file-name (if deffile (format "%s(default %s) " prompt deffile) prompt) defdir (concat defdir deffile) mustmatch-p))) (list (expand-file-name (substitute-in-file-name ans))))) ;;; I am somewhat divided on this string-default feature. It seems ;;; to violate the principle-of-least-astonishment, in that it makes ;;; the default harder to predict, so you actually have to look and see ;;; what the default really is before choosing it. This can trip you up. ;;; On the other hand, it can be useful, I guess. I would appreciate feedback ;;; on this. ;;; -Olin ;;; Simple process query facility. ;;; =========================================================================== ;;; This function is for commands that want to send a query to the process ;;; and show the response to the user. For example, a command to get the ;;; arglist for a Common Lisp function might send a "(arglist 'foo)" query ;;; to an inferior Common Lisp process. ;;; ;;; This simple facility just sends strings to the inferior process and pops ;;; up a window for the process buffer so you can see what the process ;;; responds with. We don't do anything fancy like try to intercept what the ;;; process responds with and put it in a pop-up window or on the message ;;; line. We just display the buffer. Low tech. Simple. Works good. ;;; Send to the inferior process PROC the string STR. Pop-up but do not select ;;; a window for the inferior process so that its response can be seen. (defun term-proc-query (proc str) (let* ((proc-buf (process-buffer proc)) (proc-mark (process-mark proc))) (display-buffer proc-buf) (set-buffer proc-buf) ; but it's not the selected *window* (let ((proc-win (get-buffer-window proc-buf)) (proc-pt (marker-position proc-mark))) (term-send-string proc str) ; send the query (accept-process-output proc) ; wait for some output ;; Try to position the proc window so you can see the answer. ;; This is bogus code. If you delete the (sit-for 0), it breaks. ;; I don't know why. Wizards invited to improve it. (if (not (pos-visible-in-window-p proc-pt proc-win)) (let ((opoint (window-point proc-win))) (set-window-point proc-win proc-mark) (sit-for 0) (if (not (pos-visible-in-window-p opoint proc-win)) (push-mark opoint) (set-window-point proc-win opoint))))))) ;;; Returns the current column in the current screen line. ;;; Note: (current-column) yields column in buffer line. (defun term-horizontal-column () (- (term-current-column) (term-start-line-column))) ;; Calls either vertical-motion or buffer-vertical-motion (defmacro term-vertical-motion (count) (list 'funcall 'term-vertical-motion count)) ;; An emulation of vertical-motion that is independent of having a window. ;; Instead, it uses the term-width variable as the logical window width. (defun buffer-vertical-motion (count) (cond ((= count 0) (move-to-column (* term-width (/ (current-column) term-width))) 0) ((> count 0) (let ((H) (todo (+ count (/ (current-column) term-width)))) (end-of-line) ;; The loop interates over buffer lines; ;; H is the number of screen lines in the current line, i.e. ;; the ceiling of dividing the buffer line width by term-width. (while (and (<= (setq H (max (/ (+ (current-column) term-width -1) term-width) 1)) todo) (not (eobp))) (setq todo (- todo H)) (forward-char) ;; Move past the ?\n (end-of-line)) ;; and on to the end of the next line. (if (and (>= todo H) (> todo 0)) (+ (- count todo) H -1) ;; Hit end of buffer. (move-to-column (* todo term-width)) count))) (t ;; (< count 0) ;; Similar algorithm, but for upward motion. (let ((H) (todo (- count))) (while (and (<= (setq H (max (/ (+ (current-column) term-width -1) term-width) 1)) todo) (progn (beginning-of-line) (not (bobp)))) (setq todo (- todo H)) (backward-char)) ;; Move to end of previos line (if (and (>= todo H) (> todo 0)) (+ count todo (- 1 H)) ;; Hit beginning of buffer. (move-to-column (* (- H todo 1) term-width)) count))))) ;;; The term-start-line-column variable is used as a cache. (defun term-start-line-column () (cond (term-start-line-column) ((let ((save-pos (point))) (term-vertical-motion 0) (setq term-start-line-column (current-column)) (goto-char save-pos) term-start-line-column)))) ;;; Same as (current-column), but uses term-current-column as a cache. (defun term-current-column () (cond (term-current-column) ((setq term-current-column (current-column))))) ;;; Move DELTA column right (or left if delta < 0). (defun term-move-columns (delta) (setq term-current-column (+ (term-current-column) delta)) (move-to-column term-current-column t)) ;; Insert COUNT copies of CHAR in the default face. (defun term-insert-char (char count) (let ((old-point (point))) (insert-char char count) (put-text-property old-point (point) 'face 'default))) (defun term-current-row () (cond (term-current-row) ((setq term-current-row (save-restriction (save-excursion (narrow-to-region term-home-marker (point-max)) (- (term-vertical-motion -9999)))))))) (defun term-adjust-current-row-cache (delta) (if term-current-row (setq term-current-row (+ term-current-row delta)))) (defun term-terminal-pos () (save-excursion ; save-restriction (let ((save-col (term-current-column)) x y) (term-vertical-motion 0) (setq x (- save-col (current-column))) (setq y (term-vertical-motion term-height)) (cons x y)))) ;;; Terminal emulation ;;; This is the standard process filter for term buffers. ;;; It emulates (most of the features of) a VT100/ANSI-style terminal. (defun term-emulate-terminal (proc str) (let* ((previous-buffer (current-buffer)) (i 0) char funny count save-point save-marker old-point temp win (selected (selected-window)) (str-length (length str))) (unwind-protect (progn (set-buffer (process-buffer proc)) (if (marker-buffer term-pending-delete-marker) (progn ;; Delete text following term-pending-delete-marker. (delete-region term-pending-delete-marker (process-mark proc)) (set-marker term-pending-delete-marker nil))) (if (eq (window-buffer) (current-buffer)) (progn (setq term-vertical-motion (symbol-function 'vertical-motion)) (term-check-size proc)) (setq term-vertical-motion (symbol-function 'buffer-vertical-motion))) (setq save-marker (copy-marker (process-mark proc))) (if (/= (point) (process-mark proc)) (progn (setq save-point (point-marker)) (goto-char (process-mark proc)))) (save-restriction ;; If the buffer is in line mode, and there is a partial ;; input line, save the line (by narrowing to leave it ;; outside the restriction ) until we're done with output. (if (and (> (point-max) (process-mark proc)) (term-in-line-mode)) (narrow-to-region (point-min) (process-mark proc))) (if term-log-buffer (princ str term-log-buffer)) (cond ((eq term-terminal-state 4) ;; Have saved pending output. (setq str (concat term-terminal-parameter str)) (setq term-terminal-parameter nil) (setq str-length (length str)) (setq term-terminal-state 0))) (while (< i str-length) (setq char (aref str i)) (cond ((< term-terminal-state 2) ;; Look for prefix of regular chars (setq funny (string-match "[\r\n\000\007\033\t\b\032\016\017]" str i)) (if (not funny) (setq funny str-length)) (cond ((> funny i) (cond ((eq term-terminal-state 1) (term-move-columns 1) (setq term-terminal-state 0))) (setq count (- funny i)) (setq temp (- (+ (term-horizontal-column) count) term-width)) (cond ((<= temp 0)) ;; All count chars fit in line. ((> count temp) ;; Some chars fit. ;; This iteration, handle only what fits. (setq count (- count temp)) (setq funny (+ count i))) ((or (not (or term-pager-count term-scroll-with-delete)) (> (term-handle-scroll 1) 0)) (term-adjust-current-row-cache 1) (setq count (min count term-width)) (setq funny (+ count i)) (setq term-start-line-column term-current-column)) (t ;; Doing PAGER processing. (setq count 0 funny i) (setq term-current-column nil) (setq term-start-line-column nil))) (setq old-point (point)) ;; In the common case that we're at the end of ;; the buffer, we can save a little work. (cond ((/= (point) (point-max)) (if term-insert-mode ;; Inserting spaces, then deleting them, ;; then inserting the actual text is ;; inefficient, but it is simple, and ;; the actual overhead is miniscule. (term-insert-spaces count)) (term-move-columns count) (delete-region old-point (point))) (t (setq term-current-column (+ (term-current-column) count)))) (insert (substring str i funny)) (put-text-property old-point (point) 'face term-current-face) ;; If the last char was written in last column, ;; back up one column, but remember we did so. ;; Thus we emulate xterm/vt100-style line-wrapping. (cond ((eq temp 0) (term-move-columns -1) (setq term-terminal-state 1))) (setq i (1- funny))) ((and (setq term-terminal-state 0) (eq char ?\^I)) ; TAB ;; FIXME: Does not handle line wrap! (setq count (term-current-column)) (setq count (+ count 8 (- (mod count 8)))) (if (< (move-to-column count nil) count) (term-insert-char char 1)) (setq term-current-column count)) ((eq char ?\r) ;; Optimize CRLF at end of buffer: (cond ((and (< (setq temp (1+ i)) str-length) (eq (aref str temp) ?\n) (= (point) (point-max)) (not (or term-pager-count term-kill-echo-list term-scroll-with-delete))) (insert ?\n) (term-adjust-current-row-cache 1) (setq term-start-line-column 0) (setq term-current-column 0) (setq i temp)) (t ;; Not followed by LF or can't optimize: (term-vertical-motion 0) (setq term-current-column 0)))) ((eq char ?\n) (if (not (and term-kill-echo-list (term-check-kill-echo-list))) (term-down 1 t))) ((eq char ?\b) (term-move-columns -1)) ((eq char ?\033) ; Escape (setq term-terminal-state 2)) ((eq char 0)) ; NUL: Do nothing ((eq char ?\016)) ; Shift Out - ignored ((eq char ?\017)) ; Shift In - ignored ((eq char ?\^G) (beep t)) ; Bell ((eq char ?\032) (let ((end (string-match "\n" str i))) (if end (progn (funcall term-command-hook (substring str (1+ i) (1- end))) (setq i end)) (setq term-terminal-parameter (substring str i)) (setq term-terminal-state 4) (setq i str-length)))) (t ; insert char FIXME: Should never happen (term-move-columns 1) (backward-delete-char 1) (insert char)))) ((eq term-terminal-state 2) ; Seen Esc (cond ((eq char ?\133) ;; ?\133 = ?[ (make-local-variable 'term-terminal-parameter) (make-local-variable 'term-terminal-previous-parameter) (setq term-terminal-parameter 0) (setq term-terminal-previous-parameter 0) (setq term-terminal-state 3)) ((eq char ?D) ;; scroll forward (term-handle-deferred-scroll) (term-down 1 t) (setq term-terminal-state 0)) ((eq char ?M) ;; scroll reversed (term-insert-lines 1) (setq term-terminal-state 0)) ((eq char ?7) ;; Save cursor (term-handle-deferred-scroll) (setq term-saved-cursor (cons (term-current-row) (term-horizontal-column))) (setq term-terminal-state 0)) ((eq char ?8) ;; Restore cursor (if term-saved-cursor (term-goto (car term-saved-cursor) (cdr term-saved-cursor))) (setq term-terminal-state 0)) ((setq term-terminal-state 0)))) ((eq term-terminal-state 3) ; Seen Esc [ (cond ((and (>= char ?0) (<= char ?9)) (setq term-terminal-parameter (+ (* 10 term-terminal-parameter) (- char ?0)))) ((eq char ?\073 ) ; ?; (setq term-terminal-previous-parameter term-terminal-parameter) (setq term-terminal-parameter 0)) ((eq char ??)) ; Ignore ? (t (term-handle-ansi-escape proc char) (setq term-terminal-state 0))))) (if (term-handling-pager) ;; Finish stuff to get ready to handle PAGER. (progn (if (> (% (current-column) term-width) 0) (setq term-terminal-parameter (substring str i)) ;; We're at column 0. Goto end of buffer; to compensate, ;; prepend a ?\r for later. This looks more consistent. (if (zerop i) (setq term-terminal-parameter (concat "\r" (substring str i))) (setq term-terminal-parameter (substring str (1- i))) (aset term-terminal-parameter 0 ?\r)) (goto-char (point-max))) (setq term-terminal-state 4) (make-local-variable 'term-pager-old-filter) (setq term-pager-old-filter (process-filter proc)) (set-process-filter proc term-pager-filter) (setq i str-length))) (setq i (1+ i)))) (if (>= (term-current-row) term-height) (term-handle-deferred-scroll)) (set-marker (process-mark proc) (point)) (if save-point (progn (goto-char save-point) (set-marker save-point nil))) ;; Check for a pending filename-and-line number to display. ;; We do this before scrolling, because we might create a new window. (if (and term-pending-frame (eq (window-buffer selected) (current-buffer))) (progn (term-display-line (car term-pending-frame) (cdr term-pending-frame)) (setq term-pending-frame nil) ;; We have created a new window, so check the window size. (term-check-size proc))) ;; Scroll each window displaying the buffer but (by default) ;; only if the point matches the process-mark we started with. (setq win selected) (while (progn (setq win (next-window win nil t)) (if (eq (window-buffer win) (process-buffer proc)) (let ((scroll term-scroll-to-bottom-on-output)) (select-window win) (if (or (= (point) save-marker) (eq scroll t) (eq scroll 'all) ;; Maybe user wants point to jump to the end. (and (eq selected win) (or (eq scroll 'this) (not save-point))) (and (eq scroll 'others) (not (eq selected win)))) (progn (goto-char term-home-marker) (recenter 0) (goto-char (process-mark proc)) (if (not (pos-visible-in-window-p (point) win)) (recenter -1)))) ;; Optionally scroll so that the text ;; ends at the bottom of the window. (if (and term-scroll-show-maximum-output (>= (point) (process-mark proc))) (save-excursion (goto-char (point-max)) (recenter -1))))) (not (eq win selected)))) (set-marker save-marker nil)) ;; unwind-protect cleanup-forms follow: (set-buffer previous-buffer) (select-window selected)))) (defun term-handle-deferred-scroll () (let ((count (- (term-current-row) term-height))) (if (> count 0) (save-excursion (goto-char term-home-marker) (term-vertical-motion count) (set-marker term-home-marker (point)) (setq term-current-row (1- term-height)))))) ;;; Handle a character assuming (eq terminal-state 2) - ;;; i.e. we have previousely seen Escape followed by ?[. (defun term-handle-ansi-escape (proc char) (cond ((eq char ?H) ; cursor motion (if (<= term-terminal-parameter 0) (setq term-terminal-parameter 1)) (if (<= term-terminal-previous-parameter 0) (setq term-terminal-previous-parameter 1)) (if (> term-terminal-previous-parameter term-height) (setq term-terminal-previous-parameter term-height)) (if (> term-terminal-parameter term-width) (setq term-terminal-parameter term-width)) (term-goto (1- term-terminal-previous-parameter) (1- term-terminal-parameter))) ;; \E[A - cursor up ((eq char ?A) (term-handle-deferred-scroll) (term-down (- (max 1 term-terminal-parameter)) t)) ;; \E[B - cursor down ((eq char ?B) (term-down (max 1 term-terminal-parameter) t)) ;; \E[C - cursor right ((eq char ?C) (term-move-columns (max 1 term-terminal-parameter))) ;; \E[D - cursor left ((eq char ?D) (term-move-columns (- (max 1 term-terminal-parameter)))) ;; \E[J - clear to end of screen ((eq char ?J) (term-erase-in-display term-terminal-parameter)) ;; \E[K - clear to end of line ((eq char ?K) (term-erase-in-line term-terminal-parameter)) ;; \E[L - insert lines ((eq char ?L) (term-insert-lines (max 1 term-terminal-parameter))) ;; \E[M - delete lines ((eq char ?M) (term-delete-lines (max 1 term-terminal-parameter))) ;; \E[P - delete chars ((eq char ?P) (term-delete-chars (max 1 term-terminal-parameter))) ;; \E[@ - insert spaces ((eq char ?@) (term-insert-spaces (max 1 term-terminal-parameter))) ;; \E[?h - DEC Private Mode Set ((eq char ?h) (cond ((eq term-terminal-parameter 4) (setq term-insert-mode t)) ((eq term-terminal-parameter 47) (term-switch-to-alternate-sub-buffer t)))) ;; \E[?l - DEC Private Mode Reset ((eq char ?l) (cond ((eq term-terminal-parameter 4) (setq term-insert-mode nil)) ((eq term-terminal-parameter 47) (term-switch-to-alternate-sub-buffer nil)))) ;; \E[m - Set/reset standard mode ((eq char ?m) (cond ((eq term-terminal-parameter 7) (setq term-current-face 'highlight)) ((eq term-terminal-parameter 4) (setq term-current-face 'term-underline-face)) ((eq term-terminal-parameter 1) (setq term-current-face 'bold)) (t (setq term-current-face 'default)))) ;; \E[6n - Report cursor position ((eq char ?n) (term-handle-deferred-scroll) (process-send-string proc (format "\e[%s;%sR" (1+ (term-current-row)) (1+ (term-horizontal-column))))) ;; \E[r - Set scrolling region ((eq char ?r) (term-scroll-region (1- term-terminal-previous-parameter) term-terminal-parameter)) (t))) (defun term-scroll-region (top bottom) "Set scrolling region. TOP is the top-most line (inclusive) of the new scrolling region, while BOTTOM is the line folling the new scrolling region (e.g. exclusive). The top-most line is line 0." (setq term-scroll-start (if (or (< top 0) (>= top term-height)) 0 top)) (setq term-scroll-end (if (or (<= bottom term-scroll-start) (> bottom term-height)) term-height bottom)) (setq term-scroll-with-delete (or (term-using-alternate-sub-buffer) (not (and (= term-scroll-start 0) (= term-scroll-end term-height)))))) (defun term-switch-to-alternate-sub-buffer (set) ;; If asked to switch to (from) the alternate sub-buffer, and already (not) ;; using it, do nothing. This test is needed for some programs (including ;; emacs) that emit the ti termcap string twice, for unknown reason. (term-handle-deferred-scroll) (if (eq set (not (term-using-alternate-sub-buffer))) (let ((row (term-current-row)) (col (term-horizontal-column))) (cond (set (goto-char (point-max)) (if (not (eq (preceding-char) ?\n)) (term-insert-char ?\n 1)) (setq term-scroll-with-delete t) (setq term-saved-home-marker (copy-marker term-home-marker)) (set-marker term-home-marker (point))) (t (setq term-scroll-with-delete (not (and (= term-scroll-start 0) (= term-scroll-end term-height)))) (set-marker term-home-marker term-saved-home-marker) (set-marker term-saved-home-marker nil) (setq term-saved-home-marker nil) (goto-char term-home-marker))) (setq term-current-column nil) (setq term-current-row 0) (term-goto row col)))) ;; Default value for the symbol term-command-hook. (defun term-command-hook (string) (cond ((= (aref string 0) ?\032) ;; gdb (when invoked with -fullname) prints: ;; \032\032FULLFILENAME:LINENUMBER:CHARPOS:BEG_OR_MIDDLE:PC\n (let* ((first-colon (string-match ":" string 1)) (second-colon (string-match ":" string (1+ first-colon))) (filename (substring string 1 first-colon)) (fileline (string-to-int (substring string (1+ first-colon) second-colon)))) (setq term-pending-frame (cons filename fileline)))) ((= (aref string 0) ?/) (cd (substring string 1))) ;; Allowing the inferior to call functions in emacs is ;; probably too big a security hole. ;; ((= (aref string 0) ?!) ;; (eval (car (read-from-string string 1)))) (t)));; Otherwise ignore it ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen ;; and that its line LINE is visible. ;; Put the overlay-arrow on the line LINE in that buffer. ;; This is mainly used by gdb. (defun term-display-line (true-file line) (term-display-buffer-line (find-file-noselect true-file) line)) (defun term-display-buffer-line (buffer line) (let* ((window (display-buffer buffer t)) (pos)) (save-excursion (set-buffer buffer) (save-restriction (widen) (goto-line line) (setq pos (point)) (setq overlay-arrow-string "=>") (or overlay-arrow-position (setq overlay-arrow-position (make-marker))) (set-marker overlay-arrow-position (point) (current-buffer))) (cond ((or (< pos (point-min)) (> pos (point-max))) (widen) (goto-char pos)))) (set-window-point window overlay-arrow-position))) ;;; The buffer-local marker term-home-marker defines the "home position" ;;; (in terms of cursor motion). However, we move the term-home-marker ;;; "down" as needed so that is no more that a window-full above (point-max). (defun term-goto-home () (term-handle-deferred-scroll) (goto-char term-home-marker) (setq term-current-row 0) (setq term-current-column (current-column)) (setq term-start-line-column term-current-column)) (defun term-goto (row col) (term-handle-deferred-scroll) (cond ((and term-current-row (>= row term-current-row)) ;; I assume this is a worthwhile optimization. (term-vertical-motion 0) (setq term-current-column term-start-line-column) (setq row (- row term-current-row))) (t (term-goto-home))) (term-down row) (term-move-columns col)) ; The page is full, so enter "pager" mode, and wait for input. (defun term-process-pager () (if (not term-pager-break-map) (let* ((map (make-keymap)) (i 0) tmp) ; (while (< i 128) ; (define-key map (make-string 1 i) 'term-send-raw) ; (setq i (1+ i))) (define-key map "\e" (lookup-key (current-global-map) "\e")) (define-key map "\C-x" (lookup-key (current-global-map) "\C-x")) (define-key map "\C-u" (lookup-key (current-global-map) "\C-u")) (define-key map " " 'term-pager-page) (define-key map "\r" 'term-pager-line) (define-key map "?" 'term-pager-help) (define-key map "h" 'term-pager-help) (define-key map "b" 'term-pager-back-page) (define-key map "\177" 'term-pager-back-line) (define-key map "q" 'term-pager-discard) (define-key map "D" 'term-pager-disable) (define-key map "<" 'term-pager-bob) (define-key map ">" 'term-pager-eob) ;; Add menu bar. (term-if-emacs19 (term-ifnot-xemacs (define-key map [menu-bar terminal] term-terminal-menu) (define-key map [menu-bar signals] term-signals-menu) (setq tmp (make-sparse-keymap "More pages?")) (define-key tmp [help] '("Help" . term-pager-help)) (define-key tmp [disable] '("Diable paging" . term-fake-pager-disable)) (define-key tmp [discard] '("Discard remaining output" . term-pager-discard)) (define-key tmp [eob] '("Goto to end" . term-pager-eob)) (define-key tmp [bob] '("Goto to beginning" . term-pager-bob)) (define-key tmp [line] '("1 line forwards" . term-pager-line)) (define-key tmp [bline] '("1 line backwards" . term-pager-back-line)) (define-key tmp [back] '("1 page backwards" . term-pager-back-page)) (define-key tmp [page] '("1 page forwards" . term-pager-page)) (define-key map [menu-bar page] (cons "More pages?" tmp)) )) (setq term-pager-break-map map))) ; (let ((process (get-buffer-process (current-buffer)))) ; (stop-process process)) (setq term-pager-old-local-map (current-local-map)) (use-local-map term-pager-break-map) (make-local-variable 'term-old-mode-line-format) (setq term-old-mode-line-format mode-line-format) (setq mode-line-format (list "-- **MORE** " mode-line-buffer-identification " [Type ? for help] " "%-")) (force-mode-line-update)) (defun term-pager-line (lines) (interactive "p") (let* ((moved (vertical-motion (1+ lines))) (deficit (- lines moved))) (if (> moved lines) (backward-char)) (cond ((<= deficit 0) ;; OK, had enough in the buffer for request. (recenter (1- term-height))) ((term-pager-continue deficit))))) (defun term-pager-page (arg) "Proceed past the **MORE** break, allowing the next page of output to appear" (interactive "p") (term-pager-line (* arg term-height))) ; Pager mode command to go to beginning of buffer (defun term-pager-bob () (interactive) (goto-char (point-min)) (if (= (vertical-motion term-height) term-height) (backward-char)) (recenter (1- term-height))) ; pager mode command to go to end of buffer (defun term-pager-eob () (interactive) (goto-char term-home-marker) (recenter 0) (goto-char (process-mark (get-buffer-process (current-buffer))))) (defun term-pager-back-line (lines) (interactive "p") (vertical-motion (- 1 lines)) (if (not (bobp)) (backward-char) (beep) ;; Move cursor to end of window. (vertical-motion term-height) (backward-char)) (recenter (1- term-height))) (defun term-pager-back-page (arg) (interactive "p") (term-pager-back-line (* arg term-height))) (defun term-pager-discard () (interactive) (setq term-terminal-parameter "") (interrupt-process nil t) (term-pager-continue term-height)) ; Disable pager processing. ; Only callable while in pager mode. (Contrast term-disable-pager.) (defun term-pager-disable () (interactive) (if (term-handling-pager) (term-pager-continue nil) (setq term-pager-count nil)) (term-update-mode-line)) ; Enable pager processing. (defun term-pager-enable () (interactive) (or (term-pager-enabled) (setq term-pager-count 0)) ;; Or maybe set to (term-current-row) ?? (term-update-mode-line)) (defun term-pager-toggle () (interactive) (if (term-pager-enabled) (term-pager-disable) (term-pager-enable))) (term-ifnot-xemacs (defalias 'term-fake-pager-enable 'term-pager-toggle) (defalias 'term-fake-pager-disable 'term-pager-toggle) (put 'term-char-mode 'menu-enable '(term-in-line-mode)) (put 'term-line-mode 'menu-enable '(term-in-char-mode)) (put 'term-fake-pager-enable 'menu-enable '(not term-pager-count)) (put 'term-fake-pager-disable 'menu-enable 'term-pager-count)) (defun term-pager-help () "Provide help on commands available in a terminal-emulator **MORE** break" (interactive) (message "Terminal-emulator pager break help...") (sit-for 0) (with-electric-help (function (lambda () (princ (substitute-command-keys "\\\ Terminal-emulator MORE break.\n\ Type one of the following keys:\n\n\ \\[term-pager-page]\t\tMove forward one page.\n\ \\[term-pager-line]\t\tMove forward one line.\n\ \\[universal-argument] N \\[term-pager-page]\tMove N pages forward.\n\ \\[universal-argument] N \\[term-pager-line]\tMove N lines forward.\n\ \\[universal-argument] N \\[term-pager-back-line]\tMove N lines back.\n\ \\[universal-argument] N \\[term-pager-back-page]\t\tMove N pages back.\n\ \\[term-pager-bob]\t\tMove to the beginning of the buffer.\n\ \\[term-pager-eob]\t\tMove to the end of the buffer.\n\ \\[term-pager-discard]\t\tKill pending output and kill process.\n\ \\[term-pager-disable]\t\tDisable PAGER handling.\n\n\ \\{term-pager-break-map}\n\ Any other key is passed through to the program running under the terminal emulator and disables pager processing until all pending output has been dealt with.")) nil)))) (defun term-pager-continue (new-count) (let ((process (get-buffer-process (current-buffer)))) (use-local-map term-pager-old-local-map) (setq term-pager-old-local-map nil) (setq mode-line-format term-old-mode-line-format) (force-mode-line-update) (setq term-pager-count new-count) (set-process-filter process term-pager-old-filter) (funcall term-pager-old-filter process "") (continue-process process))) ;; Make sure there are DOWN blank lines below the current one. ;; Return 0 if we're unable (because of PAGER handling), else return DOWN. (defun term-handle-scroll (down) (let ((scroll-needed (- (+ (term-current-row) down 1) term-scroll-end))) (if (> scroll-needed 0) (let ((save-point (copy-marker (point))) (save-top)) (goto-char term-home-marker) (cond (term-scroll-with-delete ;; delete scroll-needed lines at term-scroll-start (term-vertical-motion term-scroll-start) (setq save-top (point)) (term-vertical-motion scroll-needed) (delete-region save-top (point)) (goto-char save-point) (term-vertical-motion down) (term-adjust-current-row-cache (- scroll-needed)) (setq term-current-column nil) (term-insert-char ?\n scroll-needed)) ((and (numberp term-pager-count) (< (setq term-pager-count (- term-pager-count down)) 0)) (setq down 0) (term-process-pager)) (t (term-adjust-current-row-cache (- scroll-needed)) (term-vertical-motion scroll-needed) (set-marker term-home-marker (point)))) (goto-char save-point) (set-marker save-point nil)))) down) (defun term-down (down &optional check-for-scroll) "Move down DOWN screen lines vertically." (let ((start-column (term-horizontal-column))) (if (and check-for-scroll (or term-scroll-with-delete term-pager-count)) (setq down (term-handle-scroll down))) (term-adjust-current-row-cache down) (if (/= (point) (point-max)) (setq down (- down (term-vertical-motion down)))) ;; Extend buffer with extra blank lines if needed. (cond ((> down 0) (term-insert-char ?\n down) (setq term-current-column 0) (setq term-start-line-column 0)) (t (setq term-current-column nil) (setq term-start-line-column (current-column)))) (if start-column (term-move-columns start-column)))) ;; Assuming point is at the beginning of a screen line, ;; if the line above point wraps around, add a ?\n to undo the wrapping. ;; FIXME: Probably should be called more than it is. (defun term-unwrap-line () (if (not (bolp)) (insert-before-markers ?\n))) (defun term-erase-in-line (kind) (if (> kind 1) ;; erase left of point (let ((cols (term-horizontal-column)) (saved-point (point))) (term-vertical-motion 0) (delete-region (point) saved-point) (term-insert-char ?\n cols))) (if (not (eq kind 1)) ;; erase right of point (let ((saved-point (point)) (wrapped (and (zerop (term-horizontal-column)) (not (zerop (term-current-column)))))) (term-vertical-motion 1) (delete-region saved-point (point)) ;; wrapped is true if we're at the beginning of screen line, ;; but not a buffer line. If we delete the current screen line ;; that will make the previous line no longer wrap, and (because ;; of the way emacs display works) point will be at the end of ;; the previous screen line rather then the beginning of the ;; current one. To avoid that, we make sure that current line ;; contain a space, to force the previous line to continue to wrap. ;; We could do this always, but it seems preferable to not add the ;; extra space when wrapped is false. (if wrapped (insert ? )) (insert ?\n) (put-text-property saved-point (point) 'face 'default) (goto-char saved-point)))) (defun term-erase-in-display (kind) "Erases (that is blanks out) part of the window. If KIND is 0, erase from (point) to (point-max); if KIND is 1, erase from home to point; else erase from home to point-max. Should only be called when point is at the start of a screen line." (term-handle-deferred-scroll) (cond ((eq term-terminal-parameter 0) (delete-region (point) (point-max)) (term-unwrap-line)) ((let ((row (term-current-row)) (col (term-horizontal-column)) (start-region term-home-marker) (end-region (if (eq kind 1) (point) (point-max)))) (delete-region start-region end-region) (term-unwrap-line) (if (eq kind 1) (term-insert-char ?\n row)) (setq term-current-column nil) (setq term-current-row nil) (term-goto row col))))) (defun term-delete-chars (count) (let ((save-point (point))) (term-vertical-motion 1) (term-unwrap-line) (goto-char save-point) (move-to-column (+ (term-current-column) count) t) (delete-region save-point (point)))) ;;; Insert COUNT spaces after point, but do not change any of ;;; following screen lines. Hence we may have to delete characters ;;; at teh end of this screen line to make room. (defun term-insert-spaces (count) (let ((save-point (point)) (save-eol)) (term-vertical-motion 1) (if (bolp) (backward-char)) (setq save-eol (point)) (move-to-column (+ (term-start-line-column) (- term-width count)) t) (if (> save-eol (point)) (delete-region (point) save-eol)) (goto-char save-point) (term-insert-char ? count) (goto-char save-point))) (defun term-delete-lines (lines) (let ((start (point)) (save-current-column term-current-column) (save-start-line-column term-start-line-column) (save-current-row (term-current-row))) (term-down lines) (delete-region start (point)) (term-down (- term-scroll-end save-current-row lines)) (term-insert-char ?\n lines) (setq term-current-column save-current-column) (setq term-start-line-column save-start-line-column) (setq term-current-row save-current-row) (goto-char start))) (defun term-insert-lines (lines) (let ((start (point)) (start-deleted) (save-current-column term-current-column) (save-start-line-column term-start-line-column) (save-current-row (term-current-row))) (term-down (- term-scroll-end save-current-row lines)) (setq start-deleted (point)) (term-down lines) (delete-region start-deleted (point)) (goto-char start) (setq term-current-column save-current-column) (setq term-start-line-column save-start-line-column) (setq term-current-row save-current-row) (term-insert-char ?\n lines) (goto-char start))) (defun term-set-output-log (name) "Record raw inferior process output in a buffer." (interactive (list (if term-log-buffer nil (read-buffer "Record output in buffer: " (format "%s output-log" (buffer-name (current-buffer))) nil)))) (if (or (null name) (equal name "")) (progn (setq term-log-buffer nil) (message "Output logging off.")) (if (get-buffer name) nil (save-excursion (set-buffer (get-buffer-create name)) (fundamental-mode) (buffer-disable-undo (current-buffer)) (erase-buffer))) (setq term-log-buffer (get-buffer name)) (message "Recording terminal emulator output into buffer \"%s\"" (buffer-name term-log-buffer)))) (defun term-stop-photo () "Discontinue raw inferior process logging." (interactive) (term-set-output-log nil)) (defun term-show-maximum-output () "Put the end of the buffer at the bottom of the window." (interactive) (goto-char (point-max)) (recenter -1)) ;;; Do the user's customisation... (defvar term-load-hook nil "This hook is run when term is loaded in. This is a good place to put keybindings.") (run-hooks 'term-load-hook) ;;; Filename/command/history completion in a buffer ;;; =========================================================================== ;;; Useful completion functions, courtesy of the Ergo group. ;;; Six commands: ;;; term-dynamic-complete Complete or expand command, filename, ;;; history at point. ;;; term-dynamic-complete-filename Complete filename at point. ;;; term-dynamic-list-filename-completions List completions in help buffer. ;;; term-replace-by-expanded-filename Expand and complete filename at point; ;;; replace with expanded/completed name. ;;; term-dynamic-simple-complete Complete stub given candidates. ;;; These are not installed in the term-mode keymap. But they are ;;; available for people who want them. Shell-mode installs them: ;;; (define-key shell-mode-map "\t" 'term-dynamic-complete) ;;; (define-key shell-mode-map "\M-?" ;;; 'term-dynamic-list-filename-completions))) ;;; ;;; Commands like this are fine things to put in load hooks if you ;;; want them present in specific modes. (defvar term-completion-autolist nil "*If non-nil, automatically list possiblities on partial completion. This mirrors the optional behavior of tcsh.") (defvar term-completion-addsuffix t "*If non-nil, add a `/' to completed directories, ` ' to file names. This mirrors the optional behavior of tcsh.") (defvar term-completion-recexact nil "*If non-nil, use shortest completion if characters cannot be added. This mirrors the optional behavior of tcsh. A non-nil value is useful if `term-completion-autolist' is non-nil too.") (defvar term-completion-fignore nil "*List of suffixes to be disregarded during file completion. This mirrors the optional behavior of bash and tcsh. Note that this applies to `term-dynamic-complete-filename' only.") (defvar term-file-name-prefix "" "Prefix prepended to absolute file names taken from process input. This is used by term's and shell's completion functions, and by shell's directory tracking functions.") (defun term-directory (directory) ;; Return expanded DIRECTORY, with `term-file-name-prefix' if absolute. (expand-file-name (if (file-name-absolute-p directory) (concat term-file-name-prefix directory) directory))) (defun term-word (word-chars) "Return the word of WORD-CHARS at point, or nil if non is found. Word constituents are considered to be those in WORD-CHARS, which is like the inside of a \"[...]\" (see `skip-chars-forward')." (save-excursion (let ((limit (point)) (word (concat "[" word-chars "]")) (non-word (concat "[^" word-chars "]"))) (if (re-search-backward non-word nil 'move) (forward-char 1)) ;; Anchor the search forwards. (if (or (eolp) (looking-at non-word)) nil (re-search-forward (concat word "+") limit) (buffer-substring (match-beginning 0) (match-end 0)))))) (defun term-match-partial-filename () "Return the filename at point, or nil if non is found. Environment variables are substituted. See `term-word'." (let ((filename (term-word "~/A-Za-z0-9+@:_.$#,={}-"))) (and filename (substitute-in-file-name filename)))) (defun term-dynamic-complete () "Dynamically perform completion at point. Calls the functions in `term-dynamic-complete-functions' to perform completion until a function returns non-nil, at which point completion is assumed to have occurred." (interactive) (let ((functions term-dynamic-complete-functions)) (while (and functions (null (funcall (car functions)))) (setq functions (cdr functions))))) (defun term-dynamic-complete-filename () "Dynamically complete the filename at point. Completes if after a filename. See `term-match-partial-filename' and `term-dynamic-complete-as-filename'. This function is similar to `term-replace-by-expanded-filename', except that it won't change parts of the filename already entered in the buffer; it just adds completion characters to the end of the filename. A completions listing may be shown in a help buffer if completion is ambiguous. Completion is dependent on the value of `term-completion-addsuffix', `term-completion-recexact' and `term-completion-fignore', and the timing of completions listing is dependent on the value of `term-completion-autolist'. Returns t if successful." (interactive) (if (term-match-partial-filename) (prog2 (or (eq (selected-window) (minibuffer-window)) (message "Completing file name...")) (term-dynamic-complete-as-filename)))) (defun term-dynamic-complete-as-filename () "Dynamically complete at point as a filename. See `term-dynamic-complete-filename'. Returns t if successful." (let* ((completion-ignore-case nil) (completion-ignored-extensions term-completion-fignore) (success t) (filename (or (term-match-partial-filename) "")) (pathdir (file-name-directory filename)) (pathnondir (file-name-nondirectory filename)) (directory (if pathdir (term-directory pathdir) default-directory)) (completion (file-name-completion pathnondir directory)) (mini-flag (eq (selected-window) (minibuffer-window)))) (cond ((null completion) (message "No completions of %s" filename) (setq success nil)) ((eq completion t) ; Means already completed "file". (if term-completion-addsuffix (insert " ")) (or mini-flag (message "Sole completion"))) ((string-equal completion "") ; Means completion on "directory/". (term-dynamic-list-filename-completions)) (t ; Completion string returned. (let ((file (concat (file-name-as-directory directory) completion))) (insert (substring (directory-file-name completion) (length pathnondir))) (cond ((symbolp (file-name-completion completion directory)) ;; We inserted a unique completion. (if term-completion-addsuffix (insert (if (file-directory-p file) "/" " "))) (or mini-flag (message "Completed"))) ((and term-completion-recexact term-completion-addsuffix (string-equal pathnondir completion) (file-exists-p file)) ;; It's not unique, but user wants shortest match. (insert (if (file-directory-p file) "/" " ")) (or mini-flag (message "Completed shortest"))) ((or term-completion-autolist (string-equal pathnondir completion)) ;; It's not unique, list possible completions. (term-dynamic-list-filename-completions)) (t (or mini-flag (message "Partially completed"))))))) success)) (defun term-replace-by-expanded-filename () "Dynamically expand and complete the filename at point. Replace the filename with an expanded, canonicalised and completed replacement. \"Expanded\" means environment variables (e.g., $HOME) and `~'s are replaced with the corresponding directories. \"Canonicalised\" means `..' and `.' are removed, and the filename is made absolute instead of relative. For expansion see `expand-file-name' and `substitute-in-file-name'. For completion see `term-dynamic-complete-filename'." (interactive) (replace-match (expand-file-name (term-match-partial-filename)) t t) (term-dynamic-complete-filename)) (defun term-dynamic-simple-complete (stub candidates) "Dynamically complete STUB from CANDIDATES list. This function inserts completion characters at point by completing STUB from the strings in CANDIDATES. A completions listing may be shown in a help buffer if completion is ambiguous. Returns nil if no completion was inserted. Returns `sole' if completed with the only completion match. Returns `shortest' if completed with the shortest of the completion matches. Returns `partial' if completed as far as possible with the completion matches. Returns `listed' if a completion listing was shown. See also `term-dynamic-complete-filename'." (let* ((completion-ignore-case nil) (candidates (mapcar (function (lambda (x) (list x))) candidates)) (completions (all-completions stub candidates))) (cond ((null completions) (message "No completions of %s" stub) nil) ((= 1 (length completions)) ; Gotcha! (let ((completion (car completions))) (if (string-equal completion stub) (message "Sole completion") (insert (substring completion (length stub))) (message "Completed")) (if term-completion-addsuffix (insert " ")) 'sole)) (t ; There's no unique completion. (let ((completion (try-completion stub candidates))) ;; Insert the longest substring. (insert (substring completion (length stub))) (cond ((and term-completion-recexact term-completion-addsuffix (string-equal stub completion) (member completion completions)) ;; It's not unique, but user wants shortest match. (insert " ") (message "Completed shortest") 'shortest) ((or term-completion-autolist (string-equal stub completion)) ;; It's not unique, list possible completions. (term-dynamic-list-completions completions) 'listed) (t (message "Partially completed") 'partial))))))) (defun term-dynamic-list-filename-completions () "List in help buffer possible completions of the filename at point." (interactive) (let* ((completion-ignore-case nil) (filename (or (term-match-partial-filename) "")) (pathdir (file-name-directory filename)) (pathnondir (file-name-nondirectory filename)) (directory (if pathdir (term-directory pathdir) default-directory)) (completions (file-name-all-completions pathnondir directory))) (if completions (term-dynamic-list-completions completions) (message "No completions of %s" filename)))) (defun term-dynamic-list-completions (completions) "List in help buffer sorted COMPLETIONS. Typing SPC flushes the help buffer." (let ((conf (current-window-configuration))) (with-output-to-temp-buffer "*Completions*" (display-completion-list (sort completions 'string-lessp))) (message "Hit space to flush") (let (key first) (if (save-excursion (set-buffer (get-buffer "*Completions*")) (setq key (read-key-sequence nil) first (aref key 0)) (and (consp first) (eq (window-buffer (posn-window (event-start first))) (get-buffer "*Completions*")) (eq (key-binding key) 'mouse-choose-completion))) ;; If the user does mouse-choose-completion with the mouse, ;; execute the command, then delete the completion window. (progn (mouse-choose-completion first) (set-window-configuration conf)) (if (eq first ?\ ) (set-window-configuration conf) (setq unread-command-events (listify-key-sequence key))))))) ;;; Converting process modes to use term mode ;;; =========================================================================== ;;; Renaming variables ;;; Most of the work is renaming variables and functions. These are the common ;;; ones: ;;; Local variables: ;;; last-input-start term-last-input-start ;;; last-input-end term-last-input-end ;;; shell-prompt-pattern term-prompt-regexp ;;; shell-set-directory-error-hook ;;; Miscellaneous: ;;; shell-set-directory ;;; shell-mode-map term-mode-map ;;; Commands: ;;; shell-send-input term-send-input ;;; shell-send-eof term-delchar-or-maybe-eof ;;; kill-shell-input term-kill-input ;;; interrupt-shell-subjob term-interrupt-subjob ;;; stop-shell-subjob term-stop-subjob ;;; quit-shell-subjob term-quit-subjob ;;; kill-shell-subjob term-kill-subjob ;;; kill-output-from-shell term-kill-output ;;; show-output-from-shell term-show-output ;;; copy-last-shell-input Use term-previous-input/term-next-input ;;; ;;; SHELL-SET-DIRECTORY is gone, its functionality taken over by ;;; SHELL-DIRECTORY-TRACKER, the shell mode's term-input-filter-functions. ;;; Term mode does not provide functionality equivalent to ;;; shell-set-directory-error-hook; it is gone. ;;; ;;; term-last-input-start is provided for modes which want to munge ;;; the buffer after input is sent, perhaps because the inferior ;;; insists on echoing the input. The LAST-INPUT-START variable in ;;; the old shell package was used to implement a history mechanism, ;;; but you should think twice before using term-last-input-start ;;; for this; the input history ring often does the job better. ;;; ;;; If you are implementing some process-in-a-buffer mode, called foo-mode, do ;;; *not* create the term-mode local variables in your foo-mode function. ;;; This is not modular. Instead, call term-mode, and let *it* create the ;;; necessary term-specific local variables. Then create the ;;; foo-mode-specific local variables in foo-mode. Set the buffer's keymap to ;;; be foo-mode-map, and its mode to be foo-mode. Set the term-mode hooks ;;; (term-{prompt-regexp, input-filter, input-filter-functions, ;;; get-old-input) that need to be different from the defaults. Call ;;; foo-mode-hook, and you're done. Don't run the term-mode hook yourself; ;;; term-mode will take care of it. The following example, from shell.el, ;;; is typical: ;;; ;;; (defvar shell-mode-map '()) ;;; (cond ((not shell-mode-map) ;;; (setq shell-mode-map (copy-keymap term-mode-map)) ;;; (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command) ;;; (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command) ;;; (define-key shell-mode-map "\t" 'term-dynamic-complete) ;;; (define-key shell-mode-map "\M-?" ;;; 'term-dynamic-list-filename-completions))) ;;; ;;; (defun shell-mode () ;;; (interactive) ;;; (term-mode) ;;; (setq term-prompt-regexp shell-prompt-pattern) ;;; (setq major-mode 'shell-mode) ;;; (setq mode-name "Shell") ;;; (use-local-map shell-mode-map) ;;; (make-local-variable 'shell-directory-stack) ;;; (setq shell-directory-stack nil) ;;; (add-hook 'term-input-filter-functions 'shell-directory-tracker) ;;; (run-hooks 'shell-mode-hook)) ;;; ;;; ;;; Note that make-term is different from make-shell in that it ;;; doesn't have a default program argument. If you give make-shell ;;; a program name of NIL, it cleverly chooses one of explicit-shell-name, ;;; $ESHELL, $SHELL, or /bin/sh. If you give make-term a program argument ;;; of NIL, it barfs. Adjust your code accordingly... ;;; ;;; Completion for term-mode users ;;; ;;; For modes that use term-mode, term-dynamic-complete-functions is the ;;; hook to add completion functions to. Functions on this list should return ;;; non-nil if completion occurs (i.e., further completion should not occur). ;;; You could use term-dynamic-simple-complete to do the bulk of the ;;; completion job. (provide 'term) ;;; term.el ends here emacs-19.30/lisp/terminal.el100444 21641 1 126047 6033604236 15254 0ustar friedmandaemon;;; terminal.el --- terminal emulator for GNU Emacs. ;; Copyright (C) 1986,87,88,89,93,94 Free Software Foundation, Inc. ;; Author: Richard Mlynarik ;; Maintainer: FSF ;; Keywords: comm, terminals ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;;>>TODO ;;>> ** Nothing can be done about emacs' meta-lossage ** ;;>> (without redoing keymaps `sanely' -- ask Mly for details) ;;>> One probably wants to do setenv MORE -c when running with ;;>> more-processing enabled. (require 'ehelp) (defvar terminal-escape-char ?\C-^ "*All characters except for this are passed verbatim through the terminal-emulator. This character acts as a prefix for commands to the emulator program itself. Type this character twice to send it through the emulator. Type ? after typing it for a list of possible commands. This variable is local to each terminal-emulator buffer.") (defvar terminal-scrolling t ;;>> Setting this to T sort-of defeats my whole aim in writing this package... "*If non-nil, the terminal-emulator will losingly `scroll' when output occurs past the bottom of the screen. If nil, output will win and `wrap' to the top of the screen. This variable is local to each terminal-emulator buffer.") (defvar terminal-more-processing t "*If non-nil, do more-processing. This variable is local to each terminal-emulator buffer.") ;; If you are the sort of loser who uses scrolling without more breaks ;; and expects to actually see anything, you should probably set this to ;; around 400 (defvar terminal-redisplay-interval 5000 "*Maximum number of characters which will be processed by the terminal-emulator before a screen redisplay is forced. Set this to a large value for greater throughput, set it smaller for more frequent updates but overall slower performance.") (defvar terminal-more-break-insertion "*** More break -- Press space to continue ***") (defvar terminal-meta-map nil) (if terminal-meta-map nil (let ((map (make-sparse-keymap))) (define-key map [t] 'te-pass-through) (setq terminal-meta-map map))) (defvar terminal-map nil) (if terminal-map nil (let ((map (make-sparse-keymap))) (define-key map [t] 'te-pass-through) (define-key map [switch-frame] 'handle-switch-frame) (define-key map "\e" terminal-meta-map) ;(define-key map "\C-l" ; '(lambda () (interactive) (te-pass-through) (redraw-display))) (setq terminal-map map))) (defvar terminal-escape-map nil) (if terminal-escape-map nil (let ((map (make-sparse-keymap))) (define-key map [t] 'undefined) (let ((s "0")) (while (<= (aref s 0) ?9) (define-key map s 'digit-argument) (aset s 0 (1+ (aref s 0))))) (define-key map "b" 'switch-to-buffer) (define-key map "o" 'other-window) (define-key map "e" 'te-set-escape-char) (define-key map "\C-l" 'redraw-display) (define-key map "\C-o" 'te-flush-pending-output) (define-key map "m" 'te-toggle-more-processing) (define-key map "x" 'te-escape-extended-command) ;;>> What use is this? Why is it in the default terminal-emulator map? (define-key map "w" 'te-edit) (define-key map "?" 'te-escape-help) (define-key map (char-to-string help-char) 'te-escape-help) (setq terminal-escape-map map))) (defvar te-escape-command-alist nil) (if te-escape-command-alist nil (setq te-escape-command-alist '(("Set Escape Character" . te-set-escape-char) ;;>> What use is this? Why is it in the default terminal-emulator map? ("Edit" . te-edit) ("Refresh" . redraw-display) ("Record Output" . te-set-output-log) ("Photo" . te-set-output-log) ("Tofu" . te-tofu) ;; confuse the uninitiated ("Stuff Input" . te-stuff-string) ("Flush Pending Output" . te-flush-pending-output) ("Enable More Processing" . te-enable-more-processing) ("Disable More Processing" . te-disable-more-processing) ("Scroll at end of page" . te-do-scrolling) ("Wrap at end of page" . te-do-wrapping) ("Switch To Buffer" . switch-to-buffer) ("Other Window" . other-window) ("Kill Buffer" . kill-buffer) ("Help" . te-escape-help) ("Set Redisplay Interval" . te-set-redisplay-interval) ))) (defvar terminal-more-break-map nil) (if terminal-more-break-map nil (let ((map (make-sparse-keymap))) (define-key map [t] 'te-more-break-unread) (define-key map (char-to-string help-char) 'te-more-break-help) (define-key map " " 'te-more-break-resume) (define-key map "\C-l" 'redraw-display) (define-key map "\C-o" 'te-more-break-flush-pending-output) ;;>>> this isn't right ;(define-key map "\^?" 'te-more-break-flush-pending-output) ;DEL (define-key map "\r" 'te-more-break-advance-one-line) (setq terminal-more-break-map map))) ;;; Pacify the byte compiler (defvar te-process nil) (defvar te-log-buffer nil) (defvar te-height nil) (defvar te-width nil) (defvar te-more-count nil) (defvar te-redisplay-count nil) (defvar te-pending-output nil) (defvar te-saved-point) (defvar te-more-old-point nil) (defvar te-more-old-local-map nil) (defvar te-more-old-filter nil) (defvar te-more-old-mode-line-format nil) (defvar te-pending-output-info nil) ;; Required to support terminfo systems (defconst te-terminal-name-prefix "emacs-virtual") (defvar te-terminal-name nil) ;;;; escape map (defun te-escape () (interactive) (let (s (local (current-local-map)) (global (current-global-map))) (unwind-protect (progn (use-global-map terminal-escape-map) (use-local-map terminal-escape-map) (setq s (read-key-sequence (if current-prefix-arg (format "Emacs Terminal escape> %d " (prefix-numeric-value current-prefix-arg)) "Emacs Terminal escape> ")))) (use-global-map global) (use-local-map local)) (message "") (cond ;; Certain keys give vector notation, like [escape] when ;; you hit esc key... ((and (stringp s) (string= s (make-string 1 terminal-escape-char))) (setq last-command-char terminal-escape-char) (let ((terminal-escape-char -259)) (te-pass-through))) ((setq s (lookup-key terminal-escape-map s)) (call-interactively s))) )) (defun te-escape-help () "Provide help on commands available after terminal-escape-char is typed." (interactive) (message "Terminal emulator escape help...") (let ((char (single-key-description terminal-escape-char))) (with-electric-help (function (lambda () (princ (format "Terminal-emulator escape, invoked by \"%s\" Type \"%s\" twice to send a single \"%s\" through. Other chars following \"%s\" are interpreted as follows:\n" char char char char)) (princ (substitute-command-keys "\\{terminal-escape-map}\n")) (princ (format "\nSubcommands of \"%s\" (%s)\n" (where-is-internal 'te-escape-extended-command terminal-escape-map t) 'te-escape-extended-command)) (let ((l (if (fboundp 'sortcar) (sortcar (copy-sequence te-escape-command-alist) 'string<) (sort (copy-sequence te-escape-command-alist) (function (lambda (a b) (string< (car a) (car b)))))))) (while l (let ((doc (or (documentation (cdr (car l))) "Not documented"))) (if (string-match "\n" doc) ;; just use first line of documentation (setq doc (substring doc 0 (match-beginning 0)))) (princ " \"") (princ (car (car l))) (princ "\":\n ") (princ doc) (write-char ?\n)) (setq l (cdr l)))) nil))))) (defun te-escape-extended-command () (interactive) (let ((c (let ((completion-ignore-case t)) (completing-read "terminal command: " te-escape-command-alist nil t)))) (if c (catch 'foo (setq c (downcase c)) (let ((l te-escape-command-alist)) (while l (if (string= c (downcase (car (car l)))) (throw 'foo (call-interactively (cdr (car l)))) (setq l (cdr l))))))))) ;; not used. (defun te-escape-extended-command-unread () (interactive) (setq unread-command-events (listify-key-sequence (this-command-keys))) (te-escape-extended-command)) (defun te-set-escape-char (c) "Change the terminal-emulator escape character." (interactive "cSet escape character to: ") (let ((o terminal-escape-char)) (message (if (= o c) "\"%s\" is the escape char" "\"%s\" is now the escape; \"%s\" passes through") (single-key-description c) (single-key-description o)) (setq terminal-escape-char c))) (defun te-stuff-string (string) "Read a string to send to through the terminal emulator as though that string had been typed on the keyboard. Very poor man's file transfer protocol." (interactive "sStuff string: ") (process-send-string te-process string)) (defun te-set-output-log (name) "Record output from the terminal emulator in a buffer." (interactive (list (if te-log-buffer nil (read-buffer "Record output in buffer: " (format "%s output-log" (buffer-name (current-buffer))) nil)))) (if (or (null name) (equal name "")) (progn (setq te-log-buffer nil) (message "Output logging off.")) (if (get-buffer name) nil (save-excursion (set-buffer (get-buffer-create name)) (fundamental-mode) (buffer-disable-undo (current-buffer)) (erase-buffer))) (setq te-log-buffer (get-buffer name)) (message "Recording terminal emulator output into buffer \"%s\"" (buffer-name te-log-buffer)))) (defun te-tofu () "Discontinue output log." (interactive) (te-set-output-log nil)) (defun te-toggle (sym arg) (set sym (cond ((not (numberp arg)) arg) ((= arg 1) (not (symbol-value sym))) ((< arg 0) nil) (t t)))) (defun te-toggle-more-processing (arg) (interactive "p") (message (if (te-toggle 'terminal-more-processing arg) "More processing on" "More processing off")) (if terminal-more-processing (setq te-more-count -1))) (defun te-toggle-scrolling (arg) (interactive "p") (message (if (te-toggle 'terminal-scrolling arg) "Scroll at end of page" "Wrap at end of page"))) (defun te-enable-more-processing () "Enable ** MORE ** processing" (interactive) (te-toggle-more-processing t)) (defun te-disable-more-processing () "Disable ** MORE ** processing" (interactive) (te-toggle-more-processing nil)) (defun te-do-scrolling () "Scroll at end of page (yuck)" (interactive) (te-toggle-scrolling t)) (defun te-do-wrapping () "Wrap to top of window at end of page" (interactive) (te-toggle-scrolling nil)) (defun te-set-redisplay-interval (arg) "Set the maximum interval (in output characters) between screen updates. Set this number to large value for greater throughput, set it smaller for more frequent updates (but overall slower performance." (interactive "NMax number of output chars between redisplay updates: ") (setq arg (max arg 1)) (setq terminal-redisplay-interval arg te-redisplay-count 0)) ;;;; more map ;; every command -must- call te-more-break-unwind ;; or grave lossage will result (put 'te-more-break-unread 'suppress-keymap t) (defun te-more-break-unread () (interactive) (if (eq last-input-char terminal-escape-char) (call-interactively 'te-escape) (message "Continuing from more break (\"%s\" typed, %d chars output pending...)" (single-key-description last-input-char) (te-pending-output-length)) (setq te-more-count 259259) (te-more-break-unwind) (let ((terminal-more-processing nil)) (te-pass-through)))) (defun te-more-break-resume () "Proceed past the **MORE** break, allowing the next page of output to appear" (interactive) (message "Continuing from more break") (te-more-break-unwind)) (defun te-more-break-help () "Provide help on commands available in a terminal-emulator **MORE** break" (interactive) (message "Terminal-emulator more break help...") (sit-for 0) (with-electric-help (function (lambda () (princ "Terminal-emulator more break.\n\n") (princ (format "Type \"%s\" (te-more-break-resume)\n%s\n" (where-is-internal 'te-more-break-resume terminal-more-break-map t) (documentation 'te-more-break-resume))) (princ (substitute-command-keys "\\{terminal-more-break-map}\n")) (princ "Any other key is passed through to the program running under the terminal emulator and disables more processing until all pending output has been dealt with.") nil)))) (defun te-more-break-advance-one-line () "Allow one more line of text to be output before doing another more break." (interactive) (setq te-more-count 1) (te-more-break-unwind)) (defun te-more-break-flush-pending-output () "Discard any output which has been received by the terminal emulator but not yet processed and then proceed from the more break." (interactive) (te-more-break-unwind) (te-flush-pending-output)) (defun te-flush-pending-output () "Discard any as-yet-unprocessed output which has been received by the terminal emulator." (interactive) ;; this could conceivably be confusing in the presence of ;; escape-sequences spanning process-output chunks (if (null (cdr te-pending-output)) (message "(There is no output pending)") (let ((length (te-pending-output-length))) (message "Flushing %d chars of pending output" length) (setq te-pending-output (list 0 (format "\n*** %d chars of pending output flushed ***\n" length))) (te-update-pending-output-display) (te-process-output nil) (sit-for 0)))) (defun te-pass-through () "Character is passed to the program running under the terminal emulator. One characters is treated specially: the terminal escape character (normally C-^) lets you type a terminal emulator command." (interactive) (cond ((eq last-input-char terminal-escape-char) (call-interactively 'te-escape)) (t ;; Convert `return' to C-m, etc. (if (and (symbolp last-input-char) (get last-input-char 'ascii-character)) (setq last-input-char (get last-input-char 'ascii-character))) ;; Convert meta characters to 8-bit form for transmission. (if (and (integerp last-input-char) (not (zerop (logand last-input-char ?\M-\^@)))) (setq last-input-char (+ 128 (logand last-input-char 127)))) ;; Now ignore all but actual characters. ;; (It ought to be possible to send through function ;; keys as character sequences if we add a description ;; to our termcap entry of what they should look like.) (if (integerp last-input-char) (progn (and terminal-more-processing (null (cdr te-pending-output)) (te-set-more-count nil)) (send-string te-process (make-string 1 last-input-char)) (te-process-output t)) (message "Function key `%s' ignored" (single-key-description last-input-char)))))) (defun te-set-window-start () (let* ((w (get-buffer-window (current-buffer))) (h (if w (window-height w)))) (cond ((not w)) ; buffer not displayed ((>= h (/ (- (point) (point-min)) (1+ te-width))) ;; this is the normal case (set-window-start w (point-min))) ;; this happens if some vandal shrinks our window. ((>= h (/ (- (point-max) (point)) (1+ te-width))) (set-window-start w (- (point-max) (* h (1+ te-width)) -1))) ;; I give up. (t nil)))) (defun te-pending-output-length () (let ((length (car te-pending-output)) (tem (cdr te-pending-output))) (while tem (setq length (+ length (length (car tem))) tem (cdr tem))) length)) ;;>> What use is this terminal-edit stuff anyway? ;;>> If nothing else, it was written by somebody who didn't ;;>> competently understand the terminal-emulator... (defvar terminal-edit-map nil) (if terminal-edit-map nil (setq terminal-edit-map (make-sparse-keymap)) (define-key terminal-edit-map "\C-c\C-c" 'terminal-cease-edit)) ;; Terminal Edit mode is suitable only for specially formatted data. (put 'terminal-edit-mode 'mode-class 'special) (defun terminal-edit-mode () "Major mode for editing the contents of a terminal-emulator buffer. The editing commands are the same as in Fundamental mode, together with a command \\to return to terminal emulation: \\[terminal-cease-edit]." (use-local-map terminal-edit-map) (setq major-mode 'terminal-edit-mode) (setq mode-name "Terminal Edit") (setq mode-line-modified (default-value 'mode-line-modified)) (setq mode-line-process nil) (run-hooks 'terminal-edit-mode-hook)) (defun te-edit () "Start editing the terminal emulator buffer with ordinary Emacs commands." (interactive) (terminal-edit-mode) (force-mode-line-update) ;; Make mode line update. (if (eq (key-binding "\C-c\C-c") 'terminal-cease-edit) (message "Editing: Type C-c C-c to return to Terminal") (message (substitute-command-keys "Editing: Type \\[terminal-cease-edit] to return to Terminal")))) (defun terminal-cease-edit () "Finish editing message; switch back to Terminal proper." (interactive) ;;>> emulator will blow out if buffer isn't exactly te-width x te-height (let ((buffer-read-only nil)) (widen) (let ((opoint (point-marker)) (width te-width) (h (1- te-height))) (goto-char (point-min)) (while (>= h 0) (let ((p (point))) (cond ((search-forward "\n" (+ p width) 'move) (forward-char -1) (insert-char ?\ (- width (- (point) p))) (forward-char 1)) ((eobp) (insert-char ?\ (- width (- (point) p)))) ((= (following-char) ?\n) (forward-char 1)) (t (setq p (point)) (if (search-forward "\n" nil t) (delete-region p (1- (point))) (delete-region p (point-max)))))) (if (= h 0) (if (not (eobp)) (delete-region (point) (point-max))) (if (eobp) (insert ?\n))) (setq h (1- h))) (goto-char opoint) (set-marker opoint nil nil) (setq te-saved-point (point)) (setq te-redisplay-count 0) (setq te-more-count -1))) (setq mode-line-modified (default-value 'mode-line-modified)) (use-local-map terminal-map) (setq major-mode 'terminal-mode) (setq mode-name "terminal") (setq mode-line-process '(":%s"))) ;;;; more break hair (defun te-more-break () (te-set-more-count t) (make-local-variable 'te-more-old-point) (setq te-more-old-point (point)) (make-local-variable 'te-more-old-local-map) (setq te-more-old-local-map (current-local-map)) (use-local-map terminal-more-break-map) (make-local-variable 'te-more-old-filter) (setq te-more-old-filter (process-filter te-process)) (make-local-variable 'te-more-old-mode-line-format) (setq te-more-old-mode-line-format mode-line-format mode-line-format (list "-- **MORE** " mode-line-buffer-identification "%-")) (set-process-filter te-process (function (lambda (process string) (save-excursion (set-buffer (process-buffer process)) (setq te-pending-output (nconc te-pending-output (list string)))) (te-update-pending-output-display)))) (te-update-pending-output-display) (if (eq (window-buffer (selected-window)) (current-buffer)) (message "More break ")) (or (eobp) (null terminal-more-break-insertion) (save-excursion (forward-char 1) (delete-region (point) (+ (point) te-width)) (insert terminal-more-break-insertion))) (run-hooks 'terminal-more-break-hook) (sit-for 0) ;get display to update (throw 'te-process-output t)) (defun te-more-break-unwind () (use-local-map te-more-old-local-map) (set-process-filter te-process te-more-old-filter) (goto-char te-more-old-point) (setq mode-line-format te-more-old-mode-line-format) (force-mode-line-update) (let ((buffer-read-only nil)) (cond ((eobp)) (terminal-more-break-insertion (forward-char 1) (delete-region (point) (+ (point) (length terminal-more-break-insertion))) (insert-char ?\ te-width) (goto-char te-more-old-point))) (setq te-more-old-point nil) (let ((te-more-count 259259)) (te-newline))) ;(sit-for 0) (te-process-output t)) (defun te-set-more-count (newline) (let ((line (/ (- (point) (point-min)) (1+ te-width)))) (if newline (setq line (1+ line))) (cond ((= line te-height) (setq te-more-count te-height)) ;>>>> something is strange. Investigate this! ((= line (1- te-height)) (setq te-more-count te-height)) ((or (< line (/ te-height 2)) (> (- te-height line) 10)) ;; break at end of this page (setq te-more-count (- te-height line))) (t ;; migrate back towards top (ie bottom) of screen. (setq te-more-count (- te-height (if (> te-height 10) 2 1))))))) ;;;; More or less straight-forward terminal escapes ;; ^j, meaning `newline' to non-display programs. ;; (Who would think of ever writing a system which doesn't understand ;; display terminals natively? Un*x: The Operating System of the Future.) (defun te-newline () "Move down a line, optionally do more processing, perhaps wrap/scroll, move to start of new line, clear to end of line." (end-of-line) (cond ((not terminal-more-processing)) ((< (setq te-more-count (1- te-more-count)) 0) (te-set-more-count t)) ((eql te-more-count 0) ;; this doesn't return (te-more-break))) (if (eobp) (progn (delete-region (point-min) (+ (point-min) te-width)) (goto-char (point-min)) (if terminal-scrolling (progn (delete-char 1) (goto-char (point-max)) (insert ?\n)))) (forward-char 1) (delete-region (point) (+ (point) te-width))) (insert-char ?\ te-width) (beginning-of-line) (te-set-window-start)) ; ^p = x+32 y+32 (defun te-move-to-position () ;; must offset by #o40 since cretinous unix won't send a 004 char through (let ((y (- (te-get-char) 32)) (x (- (te-get-char) 32))) (if (or (> x te-width) (> y te-height)) () (goto-char (+ (point-min) x (* y (1+ te-width)))) ;(te-set-window-start?) )) (setq te-more-count -1)) ;; ^p c (defun te-clear-rest-of-line () (save-excursion (let ((n (- (point) (progn (end-of-line) (point))))) (delete-region (point) (+ (point) n)) (insert-char ?\ (- n))))) ;; ^p C (defun te-clear-rest-of-screen () (save-excursion (te-clear-rest-of-line) (while (progn (end-of-line) (not (eobp))) (forward-char 1) (end-of-line) (delete-region (- (point) te-width) (point)) (insert-char ?\ te-width)))) ;; ^p ^l (defun te-clear-screen () ;; regenerate buffer to compensate for (nonexistent!!) bugs. (erase-buffer) (let ((i 0)) (while (< i te-height) (setq i (1+ i)) (insert-char ?\ te-width) (insert ?\n))) (delete-region (1- (point-max)) (point-max)) (goto-char (point-min)) (setq te-more-count -1)) ;; ^p ^o count+32 (defun te-insert-lines () (if (not (bolp)) ();(error "fooI") (save-excursion (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1)) (n (min (- (te-get-char) ?\ ) line)) (i 0)) (delete-region (- (point-max) (* n (1+ te-width))) (point-max)) (if (eql (point) (point-max)) (insert ?\n)) (while (< i n) (setq i (1+ i)) (insert-char ?\ te-width) (or (eql i line) (insert ?\n)))))) (setq te-more-count -1)) ;; ^p ^k count+32 (defun te-delete-lines () (if (not (bolp)) ();(error "fooD") (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1)) (n (min (- (te-get-char) ?\ ) line)) (i 0)) (delete-region (point) (min (+ (point) (* n (1+ te-width))) (point-max))) (save-excursion (goto-char (point-max)) (while (< i n) (setq i (1+ i)) (insert-char ?\ te-width) (or (eql i line) (insert ?\n)))))) (setq te-more-count -1)) ;; ^p ^a (defun te-beginning-of-line () (beginning-of-line)) ;; ^p ^b (defun te-backward-char () (if (not (bolp)) (backward-char 1))) ;; ^p ^f (defun te-forward-char () (if (not (eolp)) (forward-char 1))) ;; 0177 (defun te-delete () (if (bolp) () (delete-region (1- (point)) (point)) (insert ?\ ) (forward-char -1))) ;; ^p ^g (defun te-beep () (beep)) ;; ^p _ count+32 (defun te-insert-spaces () (let* ((p (point)) (n (min (- (te-get-char) 32) (- (progn (end-of-line) (point)) p)))) (if (<= n 0) nil (delete-char (- n)) (goto-char p) (insert-char ?\ n)) (goto-char p))) ;; ^p d count+32 (should be ^p ^d but cretinous un*x won't send ^d chars!!!) (defun te-delete-char () (let* ((p (point)) (n (min (- (te-get-char) 32) (- (progn (end-of-line) (point)) p)))) (if (<= n 0) nil (insert-char ?\ n) (goto-char p) (delete-char n)) (goto-char p))) ;; disgusting unix-required shit ;; Are we living twenty years in the past yet? (defun te-losing-unix () nil) ;; ^i (defun te-output-tab () (let* ((p (point)) (x (- p (progn (beginning-of-line) (point)))) (l (min (- 8 (logand x 7)) (progn (end-of-line) (- (point) p))))) (goto-char (+ p l)))) ;; ^p ^j ;; Handle the `do' or `nl' termcap capability. ;;>> I am not sure why this broken, obsolete, capability is here. ;;>> Perhaps it is for VIle. No comment was made about why it ;;>> was added (in "Sun Dec 6 01:22:27 1987 Richard Stallman") (defun te-down-vertically-or-scroll () "Move down a line vertically, or scroll at bottom." (let ((column (current-column))) (end-of-line) (if (eobp) (progn (delete-region (point-min) (+ (point-min) te-width)) (goto-char (point-min)) (delete-char 1) (goto-char (point-max)) (insert ?\n) (insert-char ?\ te-width) (beginning-of-line)) (forward-line 1)) (move-to-column column)) (te-set-window-start)) ;; Also: ;; ^m => beginning-of-line (for which it -should- be using ^p ^a, right?!!) ;; ^g => te-beep (for which it should use ^p ^g) ;; ^h => te-backward-char (for which it should use ^p ^b) (defun te-filter (process string) (let* ((obuf (current-buffer))) ;; can't use save-excursion, as that preserves point, which we don't want (unwind-protect (progn (set-buffer (process-buffer process)) (goto-char te-saved-point) (and (bufferp te-log-buffer) (if (null (buffer-name te-log-buffer)) ;; killed (setq te-log-buffer nil) (set-buffer te-log-buffer) (goto-char (point-max)) (insert-before-markers string) (set-buffer (process-buffer process)))) (setq te-pending-output (nconc te-pending-output (list string))) (te-update-pending-output-display) (te-process-output (eq (current-buffer) (window-buffer (selected-window)))) (set-buffer (process-buffer process)) (setq te-saved-point (point))) (set-buffer obuf)))) ;; (A version of the following comment which might be distractingly offensive ;; to some readers has been moved to term-nasty.el.) ;; unix lacks ITS-style tty control... (defun te-process-output (preemptable) ;;>> There seems no good reason to ever disallow preemption (setq preemptable t) (catch 'te-process-output (let ((buffer-read-only nil) (string nil) ostring start char (matchpos nil)) (while (cdr te-pending-output) (setq ostring string start (car te-pending-output) string (car (cdr te-pending-output)) char (aref string start)) (if (eql (setq start (1+ start)) (length string)) (progn (setq te-pending-output (cons 0 (cdr (cdr te-pending-output))) start 0 string (car (cdr te-pending-output))) (te-update-pending-output-display)) (setcar te-pending-output start)) (if (and (> char ?\037) (< char ?\377)) (cond ((eolp) ;; unread char (if (eql start 0) (setq te-pending-output (cons 0 (cons (make-string 1 char) (cdr te-pending-output)))) (setcar te-pending-output (1- start))) (te-newline)) ((null string) (delete-char 1) (insert char) (te-redisplay-if-necessary 1)) (t (let ((end (or (and (eq ostring string) matchpos) (setq matchpos (string-match "[\000-\037\177-\377]" string start)) (length string)))) (delete-char 1) (insert char) (setq char (point)) (end-of-line) (setq end (min end (+ start (- (point) char)))) (goto-char char) (if (eql end matchpos) (setq matchpos nil)) (delete-region (point) (+ (point) (- end start))) (insert (if (and (eql start 0) (eql end (length string))) string (substring string start end))) (if (eql end (length string)) (setq te-pending-output (cons 0 (cdr (cdr te-pending-output)))) (setcar te-pending-output end)) (te-redisplay-if-necessary (1+ (- end start)))))) ;; I suppose if I split the guts of this out into a separate ;; function we could trivially emulate different terminals ;; Who cares in any case? (Apart from stupid losers using rlogin) (funcall (if (eql char ?\^p) (or (cdr (assq (te-get-char) '((?= . te-move-to-position) (?c . te-clear-rest-of-line) (?C . te-clear-rest-of-screen) (?\C-o . te-insert-lines) (?\C-k . te-delete-lines) ;; not necessary, but help sometimes. (?\C-a . te-beginning-of-line) (?\C-b . te-backward-char) ;; should be C-d, but un*x ;; pty's won't send \004 through! ;; Can you believe this? (?d . te-delete-char) (?_ . te-insert-spaces) ;; random (?\C-f . te-forward-char) (?\C-g . te-beep) (?\C-j . te-down-vertically-or-scroll) (?\C-l . te-clear-screen) ))) 'te-losing-unix) (or (cdr (assq char '((?\C-j . te-newline) (?\177 . te-delete) ;; Did I ask to be sent these characters? ;; I don't remember doing so, either. ;; (Perhaps some operating system or ;; other is completely incompetent...) (?\C-m . te-beginning-of-line) (?\C-g . te-beep) (?\C-h . te-backward-char) (?\C-i . te-output-tab)))) 'te-losing-unix))) (te-redisplay-if-necessary 1)) (and preemptable (input-pending-p) ;; preemptable output! Oh my!! (throw 'te-process-output t))))) ;; We must update window-point in every window displaying our buffer (let* ((s (selected-window)) (w s)) (while (not (eq s (setq w (next-window w)))) (if (eq (window-buffer w) (current-buffer)) (set-window-point w (point)))))) (defun te-get-char () (if (cdr te-pending-output) (let ((start (car te-pending-output)) (string (car (cdr te-pending-output)))) (prog1 (aref string start) (if (eql (setq start (1+ start)) (length string)) (setq te-pending-output (cons 0 (cdr (cdr te-pending-output)))) (setcar te-pending-output start)))) (catch 'char (let ((filter (process-filter te-process))) (unwind-protect (progn (set-process-filter te-process (function (lambda (p s) (or (eql (length s) 1) (setq te-pending-output (list 1 s))) (throw 'char (aref s 0))))) (accept-process-output te-process)) (set-process-filter te-process filter)))))) (defun te-redisplay-if-necessary (length) (and (<= (setq te-redisplay-count (- te-redisplay-count length)) 0) (eq (current-buffer) (window-buffer (selected-window))) (waiting-for-user-input-p) (progn (te-update-pending-output-display) (sit-for 0) (setq te-redisplay-count terminal-redisplay-interval)))) (defun te-update-pending-output-display () (if (null (cdr te-pending-output)) (setq te-pending-output-info "") (let ((length (te-pending-output-length))) (if (< length 1500) (setq te-pending-output-info "") (setq te-pending-output-info (format "(%dK chars output pending) " (/ (+ length 512) 1024)))))) (force-mode-line-update)) (defun te-sentinel (process message) (cond ((eq (process-status process) 'run)) ((null (buffer-name (process-buffer process)))) ;deleted (t (let ((b (current-buffer))) (save-excursion (set-buffer (process-buffer process)) (setq buffer-read-only nil) (fundamental-mode) (goto-char (point-max)) (delete-blank-lines) (delete-horizontal-space) (insert "\n*******\n" message "*******\n")) (if (and (eq b (process-buffer process)) (waiting-for-user-input-p)) (progn (goto-char (point-max)) (recenter -1))))))) (defvar te-stty-string "stty -nl erase '^?' kill '^u' intr '^c' echo pass8" "Shell command to set terminal modes for terminal emulator.") ;; This used to have `new' in it, but that loses outside BSD ;; and it's apparently not needed in BSD. (defvar explicit-shell-file-name nil "*If non-nil, is file name to use for explicitly requested inferior shell.") ;;;###autoload (defun terminal-emulator (buffer program args &optional width height) "Under a display-terminal emulator in BUFFER, run PROGRAM on arguments ARGS. ARGS is a list of argument-strings. Remaining arguments are WIDTH and HEIGHT. BUFFER's contents are made an image of the display generated by that program, and any input typed when BUFFER is the current Emacs buffer is sent to that program an keyboard input. Interactively, BUFFER defaults to \"*terminal*\" and PROGRAM and ARGS are parsed from an input-string using your usual shell. WIDTH and HEIGHT are determined from the size of the current window -- WIDTH will be one less than the window's width, HEIGHT will be its height. To switch buffers and leave the emulator, or to give commands to the emulator itself (as opposed to the program running under it), type Control-^. The following character is an emulator command. Type Control-^ twice to send it to the subprogram. This escape character may be changed using the variable `terminal-escape-char'. `Meta' characters may not currently be sent through the terminal emulator. Here is a list of some of the variables which control the behaviour of the emulator -- see their documentation for more information: terminal-escape-char, terminal-scrolling, terminal-more-processing, terminal-redisplay-interval. This function calls the value of terminal-mode-hook if that exists and is non-nil after the terminal buffer has been set up and the subprocess started." (interactive (cons (save-excursion (set-buffer (get-buffer-create "*terminal*")) (buffer-name (if (or (not (boundp 'te-process)) (null te-process) (not (eq (process-status te-process) 'run))) (current-buffer) (generate-new-buffer "*terminal*")))) (append (let* ((default-s ;; Default shell is same thing M-x shell uses. (or explicit-shell-file-name (getenv "ESHELL") (getenv "SHELL") "/bin/sh")) (s (read-string (format "Run program in emulator: (default %s) " default-s)))) (if (equal s "") (list default-s '()) (te-parse-program-and-args s)))))) (switch-to-buffer buffer) (if (null width) (setq width (- (window-width (selected-window)) 1))) (if (null height) (setq height (- (window-height (selected-window)) 1))) (terminal-mode) (setq te-width width te-height height) (setq te-terminal-name (concat te-terminal-name-prefix "-" te-width te-height)) (setq mode-line-buffer-identification (list (format "Emacs terminal %dx%d: %%b " te-width te-height) 'te-pending-output-info)) (let ((buffer-read-only nil)) (te-clear-screen)) (let (process) (while (setq process (get-buffer-process (current-buffer))) (if (y-or-n-p (format "Kill process %s? " (process-name process))) (delete-process process) (error "Process %s not killed" (process-name process))))) (condition-case err (let ((process-environment (cons (concat "TERM=" te-terminal-name) (cons (concat "TERMCAP=" (te-create-termcap)) (cons (concat "TERMINFO=" (te-create-terminfo)) process-environment))))) (setq te-process (start-process "terminal-emulator" (current-buffer) "/bin/sh" "-c" ;; Yuck!!! Start a shell to set some terminal ;; control characteristics. Then start the ;; "env" program to setup the terminal type ;; Then finally start the program we wanted. (format "%s; exec %s" te-stty-string (mapconcat 'te-quote-arg-for-sh (cons program args) " ")))) (set-process-filter te-process 'te-filter) (set-process-sentinel te-process 'te-sentinel)) (error (fundamental-mode) (signal (car err) (cdr err)))) (setq inhibit-quit t) ;sport death (use-local-map terminal-map) (run-hooks 'terminal-mode-hook) (message "Entering emacs terminal-emulator... Type %s %s for help" (single-key-description terminal-escape-char) (mapconcat 'single-key-description (where-is-internal 'te-escape-help terminal-escape-map t) " "))) (defun te-parse-program-and-args (s) (cond ((string-match "\\`\\([-a-zA-Z0-9+=_.@/:]+[ \t]*\\)+\\'" s) (let ((l ()) (p 0)) (while p (setq l (cons (if (string-match "\\([-a-zA-Z0-9+=_.@/:]+\\)\\([ \t]+\\)*" s p) (prog1 (substring s p (match-end 1)) (setq p (match-end 0)) (if (eql p (length s)) (setq p nil))) (prog1 (substring s p) (setq p nil))) l))) (setq l (nreverse l)) (list (car l) (cdr l)))) ((and (string-match "[ \t]" s) (not (file-exists-p s))) (list shell-file-name (list "-c" (concat "exec " s)))) (t (list s ())))) (put 'terminal-mode 'mode-class 'special) ;; This is only separated out from function terminal-emulator ;; to keep the latter a little more manageable. (defun terminal-mode () "Set up variables for use with the terminal-emulator. One should not call this -- it is an internal function of the terminal-emulator" (kill-all-local-variables) (buffer-disable-undo (current-buffer)) (setq major-mode 'terminal-mode) (setq mode-name "terminal") ; (make-local-variable 'Helper-return-blurb) ; (setq Helper-return-blurb "return to terminal simulator") (setq mode-line-process '(":%s")) (setq buffer-read-only t) (setq truncate-lines t) (make-local-variable 'terminal-escape-char) (setq terminal-escape-char (default-value 'terminal-escape-char)) (make-local-variable 'terminal-scrolling) (setq terminal-scrolling (default-value 'terminal-scrolling)) (make-local-variable 'terminal-more-processing) (setq terminal-more-processing (default-value 'terminal-more-processing)) (make-local-variable 'terminal-redisplay-interval) (setq terminal-redisplay-interval (default-value 'terminal-redisplay-interval)) (make-local-variable 'te-width) (make-local-variable 'te-height) (make-local-variable 'te-process) (make-local-variable 'te-pending-output) (setq te-pending-output (list 0)) (make-local-variable 'te-saved-point) (setq te-saved-point (point-min)) (make-local-variable 'te-pending-output-info) ;for the mode line (setq te-pending-output-info "") (make-local-variable 'inhibit-quit) ;(setq inhibit-quit t) (make-local-variable 'te-log-buffer) (setq te-log-buffer nil) (make-local-variable 'te-more-count) (setq te-more-count -1) (make-local-variable 'te-redisplay-count) (setq te-redisplay-count terminal-redisplay-interval) ;(use-local-map terminal-mode-map) ;; terminal-mode-hook is called above in function terminal-emulator ) ;;;; what a complete loss (defun te-quote-arg-for-sh (string) (cond ((string-match "\\`[-a-zA-Z0-9+=_.@/:]+\\'" string) string) ((not (string-match "[$]" string)) ;; "[\"\\]" are special to sh and the lisp reader in the same way (prin1-to-string string)) (t (let ((harder "") (start 0) (end 0)) (while (cond ((>= start (length string)) nil) ;; this is the set of chars magic with "..." in `sh' ((setq end (string-match "[\"\\$]" string start)) t) (t (setq harder (concat harder (substring string start))) nil)) (setq harder (concat harder (substring string start end) ;; Can't use ?\\ since `concat' ;; unfortunately does prin1-to-string ;; on fixna. Amazing. "\\" (substring string end (1+ end))) start (1+ end))) (concat "\"" harder "\""))))) (defun te-create-terminfo () "Create and compile a terminfo entry for the virtual terminal. This is kept in the /tmp directory" (if (and system-uses-terminfo (not (file-exists-p (concat "/tmp/" (substring te-terminal-name-prefix 0 1) "/" te-terminal-name)))) (let ( (terminfo (concat (format "%s,mir, xon,cols#%d, lines#%d," te-terminal-name te-width te-height) "bel=^P^G, clear=^P\\f, cr=^P^A, cub1=^P^B, cud1=^P\\n," "cuf1=^P^F, cup=^P=%p1%'\\s'%+%c%p2%'\\s'%+%c," "dch=^Pd%p1%'\\s'%+%c, dch1=^Pd!, dl=^P^K%p1%'\\s'%+%c," "dl1=^P^K!, ed=^PC, el=^Pc, home=^P=\\s\\s," "ich=^P_%p1%'\\s'%+%c, ich1=^P_!, il=^P^O%p1%'\\s'%+%c," "il1=^P^O!, ind=^P\\n, nel=\\n,")) (file-name (concat "/tmp/" te-terminal-name ".tif")) ) (save-excursion (set-buffer (create-file-buffer file-name)) (insert terminfo) (write-file file-name) (kill-buffer nil) ) (let ( (process-environment (cons (concat "TERMINFO=" "/tmp") process-environment)) ) (set-process-sentinel (start-process "tic" nil "tic" file-name) 'te-tic-sentinel)))) "/tmp" ) (defun te-create-termcap () "Create a termcap entry for the virtual terminal" ;; Because of Unix Brain Death(tm), we can't change ;; the terminal type of a running process, and so ;; terminal size and scrollability are wired-down ;; at this point. ("Detach? What's that?") (concat (format "%s:co#%d:li#%d:%s" ;; Sigh. These can't be dynamically changed. te-terminal-name te-width te-height (if terminal-scrolling "" "ns:")) ;;-- Basic things ;; cursor-motion, bol, forward/backward char "cm=^p=%+ %+ :cr=^p^a:le=^p^b:nd=^p^f:" ;; newline, clear eof/eof, audible bell "nw=^j:ce=^pc:cd=^pC:cl=^p^l:bl=^p^g:" ;; insert/delete char/line "IC=^p_%+ :DC=^pd%+ :AL=^p^o%+ :DL=^p^k%+ :" ;;-- Not-widely-known (ie nonstandard) flags, which mean ;; o writing in the last column of the last line ;; doesn't cause idiotic scrolling, and ;; o don't use idiotische c-s/c-q sogenannte ;; ``flow control'' auf keinen Fall. "LP:NF:" ;;-- For stupid or obsolete programs "ic=^p_!:dc=^pd!:al=^p^o!:dl=^p^k!:ho=^p= :" ;;-- For disgusting programs. ;; (VI? What losers need these, I wonder?) "im=:ei=:dm=:ed=:mi:do=^p^j:nl=^p^j:bs:") ) (defun te-tic-sentinel (proc state-change) "If tic has finished, delete the .tif file" (if (equal state-change "finished ") (delete-file (concat "/tmp/" te-terminal-name ".tif")))) (provide 'terminal) ;;; terminal.el ends here emacs-19.30/lisp/tex-mode.el100444 75424 13 127261 6046520570 14130 0ustar kwzhuser;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands. ;; Copyright (C) 1985, 86, 89, 92, 94, 95 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: tex ;; Contributions over the years by William F. Schelter, Dick King, ;; Stephen Gildea, Michael Prange, Jacob Gore, and Edward M. Reingold. ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (require 'shell) (require 'compile) ;;;###autoload (defvar tex-shell-file-name nil "*If non-nil, the shell file name to run in the subshell used to run TeX.") ;;;###autoload (defvar tex-directory "." "*Directory in which temporary files are left. You can make this `/tmp' if your TEXINPUTS has no relative directories in it and you don't try to apply \\[tex-region] or \\[tex-buffer] when there are `\\input' commands with relative directories.") ;;;###autoload (defvar tex-offer-save t "*If non-nil, ask about saving modified buffers before \\[tex-file] is run.") ;;;###autoload (defvar tex-run-command "tex" "*Command used to run TeX subjob. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end.") ;;;###autoload (defvar latex-run-command "latex" "*Command used to run LaTeX subjob. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end.") (defvar standard-latex-block-names '("abstract" "array" "center" "description" "displaymath" "document" "enumerate" "eqnarray" "eqnarray*" "equation" "figure" "figure*" "flushleft" "flushright" "itemize" "letter" "list" "minipage" "picture" "quotation" "quote" "slide" "sloppypar" "tabbing" "table" "table*" "tabular" "tabular*" "thebibliography" "theindex*" "titlepage" "trivlist" "verbatim" "verbatim*" "verse") "Standard LaTeX block names.") ;;;###autoload (defvar latex-block-names nil "*User defined LaTeX block names. Combined with `standard-latex-block-names' for minibuffer completion.") ;;;###autoload (defvar slitex-run-command "slitex" "*Command used to run SliTeX subjob. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end.") ;;;###autoload (defvar tex-bibtex-command "bibtex" "*Command used by `tex-bibtex-file' to gather bibliographic data. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end.") ;;;###autoload (defvar tex-dvi-print-command "lpr -d" "*Command used by \\[tex-print] to print a .dvi file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end.") ;;;###autoload (defvar tex-alt-dvi-print-command "lpr -d" "*Command used by \\[tex-print] with a prefix arg to print a .dvi file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end. If two printers are not enough of a choice, you can set the variable `tex-alt-dvi-print-command' to an expression that asks what you want; for example, (setq tex-alt-dvi-print-command '(format \"lpr -P%s\" (read-string \"Use printer: \"))) would tell \\[tex-print] with a prefix argument to ask you which printer to use.") ;;;###autoload (defvar tex-dvi-view-command nil "*Command used by \\[tex-view] to display a `.dvi' file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end. This can be set conditionally so that the previewer used is suitable for the window system being used. For example, (setq tex-dvi-view-command (if (eq window-system 'x) \"xdvi\" \"dvi2tty * | cat -s\")) would tell \\[tex-view] to use xdvi under X windows and to use dvi2tty otherwise.") ;;;###autoload (defvar tex-show-queue-command "lpq" "*Command used by \\[tex-show-print-queue] to show the print queue. Should show the queue(s) that \\[tex-print] puts jobs on.") ;;;###autoload (defvar tex-default-mode 'plain-tex-mode "*Mode to enter for a new file that might be either TeX or LaTeX. This variable is used when it can't be determined whether the file is plain TeX or LaTeX or what because the file contains no commands. Normally set to either `plain-tex-mode' or `latex-mode'.") ;;;###autoload (defvar tex-open-quote "``" "*String inserted by typing \\[tex-insert-quote] to open a quotation.") ;;;###autoload (defvar tex-close-quote "''" "*String inserted by typing \\[tex-insert-quote] to close a quotation.") (defvar tex-last-temp-file nil "Latest temporary file generated by \\[tex-region] and \\[tex-buffer]. Deleted when the \\[tex-region] or \\[tex-buffer] is next run, or when the tex shell terminates.") (defvar tex-command nil "Command to run TeX. The name of the file, preceded by a blank, will be added to this string.") (defvar tex-trailer nil "String appended after the end of a region sent to TeX by \\[tex-region].") (defvar tex-start-of-header nil "Regular expression used by \\[tex-region] to find start of file's header.") (defvar tex-end-of-header nil "Regular expression used by \\[tex-region] to find end of file's header.") (defvar tex-shell-cd-command "cd" "Command to give to shell running TeX to change directory. The value of `tex-directory' is appended to this, separated by a space.") (defvar tex-zap-file nil "Temporary file name used for text being sent as input to TeX. Should be a simple file name with no extension or directory specification.") (defvar tex-last-buffer-texed nil "Buffer which was last TeXed.") (defvar tex-print-file nil "File name that \\[tex-print] prints. Set by \\[tex-region], \\[tex-buffer], and \\[tex-file].") (defvar tex-mode-syntax-table nil "Syntax table used while in TeX mode.") ;; Written by Wolfgang Bangerth (defvar latex-imenu-generic-expression '( ("Part" "\\\\part{\\([^}]*\\)}" 1) ("Chapter" "\\\\chapter{\\([^}]*\\)}" 1) ("Section" "\\\\[a-zA-Z]*section{\\([^}]*\\)}" 1) ;; i put numbers like 3.15 before my ;; \begin{equation}'s which tell me ;; the number the equation will get when ;; being printed. ("Equations" "%[ \t]*\\([0-9]+\\.[0-9]+\\)[,;]?[ \t]?" 1)) "Imenu generic expression for LaTex mode. See `imenu-generic-expression'.") (defun tex-define-common-keys (keymap) "Define the keys that we want defined both in TeX mode and in the TeX shell." (define-key keymap "\C-c\C-k" 'tex-kill-job) (define-key keymap "\C-c\C-l" 'tex-recenter-output-buffer) (define-key keymap "\C-c\C-q" 'tex-show-print-queue) (define-key keymap "\C-c\C-p" 'tex-print) (define-key keymap "\C-c\C-v" 'tex-view) (define-key keymap [menu-bar tex] (cons "TeX" (make-sparse-keymap "TeX"))) (define-key keymap [menu-bar tex tex-kill-job] '("Tex Kill" . tex-kill-job)) (define-key keymap [menu-bar tex tex-recenter-output-buffer] '("Tex Recenter" . tex-recenter-output-buffer)) (define-key keymap [menu-bar tex tex-show-print-queue] '("Show Print Queue" . tex-show-print-queue)) (define-key keymap [menu-bar tex tex-alt-print] '("Tex Print (alt printer)" . tex-alt-print)) (define-key keymap [menu-bar tex tex-print] '("Tex Print" . tex-print)) (define-key keymap [menu-bar tex tex-view] '("Tex View" . tex-view)) ) (defvar tex-mode-map nil "Keymap for TeX mode.") (if tex-mode-map nil (setq tex-mode-map (make-sparse-keymap)) (tex-define-common-keys tex-mode-map) (define-key tex-mode-map "\"" 'tex-insert-quote) (define-key tex-mode-map "\n" 'tex-terminate-paragraph) (define-key tex-mode-map "\C-c}" 'up-list) (define-key tex-mode-map "\C-c{" 'tex-insert-braces) (define-key tex-mode-map "\C-c\C-r" 'tex-region) (define-key tex-mode-map "\C-c\C-b" 'tex-buffer) (define-key tex-mode-map "\C-c\C-f" 'tex-file) (define-key tex-mode-map "\C-c\C-i" 'tex-bibtex-file) (define-key tex-mode-map "\C-c\C-o" 'tex-latex-block) (define-key tex-mode-map "\C-c\C-e" 'tex-close-latex-block) (define-key tex-mode-map "\C-c\C-u" 'tex-goto-last-unclosed-latex-block) (define-key tex-mode-map [menu-bar tex tex-bibtex-file] '("BibTeX File" . tex-bibtex-file)) (define-key tex-mode-map [menu-bar tex tex-validate-region] '("Validate Region" . tex-validate-region)) (define-key tex-mode-map [menu-bar tex validate-tex-buffer] '("Validate Buffer" . validate-tex-buffer)) (define-key tex-mode-map [menu-bar tex tex-region] '("TeX Region" . tex-region)) (define-key tex-mode-map [menu-bar tex tex-buffer] '("TeX Buffer" . tex-buffer)) (define-key tex-mode-map [menu-bar tex tex-file] '("TeX File" . tex-file))) (put 'tex-region 'menu-enable 'mark-active) (put 'tex-validate-region 'menu-enable 'mark-active) (put 'tex-print 'menu-enable '(stringp tex-print-file)) (put 'tex-alt-print 'menu-enable '(stringp tex-print-file)) (put 'tex-view 'menu-enable '(stringp tex-print-file)) (put 'tex-recenter-output-buffer 'menu-enable '(get-buffer "*tex-shell*")) (put 'tex-kill-job 'menu-enable '(tex-shell-running)) (defvar tex-shell-map nil "Keymap for the TeX shell. Inherits `shell-mode-map' with a few additions.") (defvar compare-windows-whitespace) ; Pacify the byte-compiler ;;; This would be a lot simpler if we just used a regexp search, ;;; but then it would be too slow. ;;;###autoload (defun tex-mode () "Major mode for editing files of input for TeX, LaTeX, or SliTeX. Tries to determine (by looking at the beginning of the file) whether this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode', `latex-mode', or `slitex-mode', respectively. If it cannot be determined, such as if there are no commands in the file, the value of `tex-default-mode' says which mode to use." (interactive) (let (mode slash comment) (save-excursion (goto-char (point-min)) (while (and (setq slash (search-forward "\\" nil t)) (setq comment (let ((search-end (point))) (save-excursion (beginning-of-line) (search-forward "%" search-end t)))))) (if (and slash (not comment)) (setq mode (if (looking-at "documentstyle\\|documentclass\\|begin\\b\\|NeedsTeXFormat{LaTeX") (if (looking-at "document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}") 'slitex-mode 'latex-mode) 'plain-tex-mode)))) (if mode (funcall mode) (funcall tex-default-mode)))) ;;;###autoload (defalias 'TeX-mode 'tex-mode) ;;;###autoload (defalias 'LaTeX-mode 'latex-mode) ;;;###autoload (defun plain-tex-mode () "Major mode for editing files of input for plain TeX. Makes $ and } display the characters they match. Makes \" insert `` when it seems to be the beginning of a quotation, and '' when it appears to be the end; it inserts \" only after a \\. Use \\[tex-region] to run TeX on the current region, plus a \"header\" copied from the top of the file (containing macro definitions, etc.), running TeX under a special subshell. \\[tex-buffer] does the whole buffer. \\[tex-file] saves the buffer and then processes the file. \\[tex-print] prints the .dvi file made by any of these. \\[tex-view] previews the .dvi file made by any of these. \\[tex-bibtex-file] runs bibtex on the file of the current buffer. Use \\[validate-tex-buffer] to check buffer for paragraphs containing mismatched $'s or braces. Special commands: \\{tex-mode-map} Mode variables: tex-run-command Command string used by \\[tex-region] or \\[tex-buffer]. tex-directory Directory in which to create temporary files for TeX jobs run by \\[tex-region] or \\[tex-buffer]. tex-dvi-print-command Command string used by \\[tex-print] to print a .dvi file. tex-alt-dvi-print-command Alternative command string used by \\[tex-print] (when given a prefix argument) to print a .dvi file. tex-dvi-view-command Command string used by \\[tex-view] to preview a .dvi file. tex-show-queue-command Command string used by \\[tex-show-print-queue] to show the print queue that \\[tex-print] put your job on. Entering Plain-tex mode runs the hook `text-mode-hook', then the hook `tex-mode-hook', and finally the hook `plain-tex-mode-hook'. When the special subshell is initiated, the hook `tex-shell-hook' is run." (interactive) (tex-common-initialization) (setq mode-name "TeX") (setq major-mode 'plain-tex-mode) (setq tex-command tex-run-command) (setq tex-start-of-header "%\\*\\*start of header") (setq tex-end-of-header "%\\*\\*end of header") (setq tex-trailer "\\bye\n") (run-hooks 'text-mode-hook 'tex-mode-hook 'plain-tex-mode-hook)) ;;;###autoload (defalias 'plain-TeX-mode 'plain-tex-mode) ;;;###autoload (defun latex-mode () "Major mode for editing files of input for LaTeX. Makes $ and } display the characters they match. Makes \" insert `` when it seems to be the beginning of a quotation, and '' when it appears to be the end; it inserts \" only after a \\. Use \\[tex-region] to run LaTeX on the current region, plus the preamble copied from the top of the file (containing \\documentstyle, etc.), running LaTeX under a special subshell. \\[tex-buffer] does the whole buffer. \\[tex-file] saves the buffer and then processes the file. \\[tex-print] prints the .dvi file made by any of these. \\[tex-view] previews the .dvi file made by any of these. \\[tex-bibtex-file] runs bibtex on the file of the current buffer. Use \\[validate-tex-buffer] to check buffer for paragraphs containing mismatched $'s or braces. Special commands: \\{tex-mode-map} Mode variables: latex-run-command Command string used by \\[tex-region] or \\[tex-buffer]. tex-directory Directory in which to create temporary files for LaTeX jobs run by \\[tex-region] or \\[tex-buffer]. tex-dvi-print-command Command string used by \\[tex-print] to print a .dvi file. tex-alt-dvi-print-command Alternative command string used by \\[tex-print] (when given a prefix argument) to print a .dvi file. tex-dvi-view-command Command string used by \\[tex-view] to preview a .dvi file. tex-show-queue-command Command string used by \\[tex-show-print-queue] to show the print queue that \\[tex-print] put your job on. Entering Latex mode runs the hook `text-mode-hook', then `tex-mode-hook', and finally `latex-mode-hook'. When the special subshell is initiated, `tex-shell-hook' is run." (interactive) (tex-common-initialization) (setq mode-name "LaTeX") (setq major-mode 'latex-mode) (setq tex-command latex-run-command) (setq tex-start-of-header "\\\\documentstyle\\|\\\\documentclass") (setq tex-end-of-header "\\\\begin{document}") (setq tex-trailer "\\end{document}\n") ;; A line containing just $$ is treated as a paragraph separator. ;; A line starting with $$ starts a paragraph, ;; but does not separate paragraphs if it has more stuff on it. (setq paragraph-start "[ \t]*$\\|[\f%]\\|[ \t]*\\$\\$\\|\ \\\\begin\\>\\|\\\\label\\>\\|\\\\end\\>\\|\\\\\\[\\|\\\\\\]\\|\ \\\\chapter\\>\\|\\\\section\\>\\|\ \\\\subsection\\>\\|\\\\subsubsection\\>\\|\ \\\\paragraph\\>\\|\\\\subparagraph\\>\\|\ \\\\item\\>\\|\\\\bibitem\\>\\|\\\\newline\\>\\|\\\\noindent\\>\\|\ \\\\[a-z]*space\\>\\|\\\\[a-z]*skip\\>\\|\ \\\\newpage\\>\\|\\\\[a-z]*page\\|\\\\footnote\\>\\|\ \\\\marginpar\\>\\|\\\\parbox\\>\\|\\\\caption\\>") (setq paragraph-separate "[ \t]*$\\|[\f%]\\|[ \t]*\\$\\$[ \t]*$\\|\ \\\\begin\\>\\|\\\\label\\>\\|\\\\end\\>\\|\\\\\\[\\|\\\\\\]\\|\ \\\\chapter\\>\\|\\\\section\\>\\|\ \\\\subsection\\>\\|\\\\subsubsection\\>\\|\ \\\\paragraph\\>\\|\\\\subparagraph\\>\\|\ \\(\\\\item\\|\\\\bibitem\\|\\\\newline\\|\\\\noindent\\|\ \\\\[a-z]*space\\|\\\\[a-z]*skip\\|\ \\\\newpage\\|\\\\[a-z]*page[a-z]*\\|\\\\footnote\\|\ \\\\marginpar\\|\\\\parbox\\|\\\\caption\\)[ \t]*\\($\\|%\\)") (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression latex-imenu-generic-expression) (run-hooks 'text-mode-hook 'tex-mode-hook 'latex-mode-hook)) ;;;###autoload (defun slitex-mode () "Major mode for editing files of input for SliTeX. Makes $ and } display the characters they match. Makes \" insert `` when it seems to be the beginning of a quotation, and '' when it appears to be the end; it inserts \" only after a \\. Use \\[tex-region] to run SliTeX on the current region, plus the preamble copied from the top of the file (containing \\documentstyle, etc.), running SliTeX under a special subshell. \\[tex-buffer] does the whole buffer. \\[tex-file] saves the buffer and then processes the file. \\[tex-print] prints the .dvi file made by any of these. \\[tex-view] previews the .dvi file made by any of these. \\[tex-bibtex-file] runs bibtex on the file of the current buffer. Use \\[validate-tex-buffer] to check buffer for paragraphs containing mismatched $'s or braces. Special commands: \\{tex-mode-map} Mode variables: slitex-run-command Command string used by \\[tex-region] or \\[tex-buffer]. tex-directory Directory in which to create temporary files for SliTeX jobs run by \\[tex-region] or \\[tex-buffer]. tex-dvi-print-command Command string used by \\[tex-print] to print a .dvi file. tex-alt-dvi-print-command Alternative command string used by \\[tex-print] (when given a prefix argument) to print a .dvi file. tex-dvi-view-command Command string used by \\[tex-view] to preview a .dvi file. tex-show-queue-command Command string used by \\[tex-show-print-queue] to show the print queue that \\[tex-print] put your job on. Entering SliTeX mode runs the hook `text-mode-hook', then the hook `tex-mode-hook', then the hook `latex-mode-hook', and finally the hook `slitex-mode-hook'. When the special subshell is initiated, the hook `tex-shell-hook' is run." (interactive) (tex-common-initialization) (setq mode-name "SliTeX") (setq major-mode 'slitex-mode) (setq tex-command slitex-run-command) (setq tex-start-of-header "\\\\documentstyle{slides}\\|\\\\docuentclass{slides}") (setq tex-end-of-header "\\\\begin{document}") (setq tex-trailer "\\end{document}\n") ;; A line containing just $$ is treated as a paragraph separator. ;; A line starting with $$ starts a paragraph, ;; but does not separate paragraphs if it has more stuff on it. (setq paragraph-start "[ \t]*$\\|[\f%]\\|[ \t]*\\$\\$\\|\ \\\\begin\\>\\|\\\\label\\>\\|\\\\end\\>\\|\\\\\\[\\|\\\\\\]\\|\ \\\\chapter\\>\\|\\\\section\\>\\|\ \\\\subsection\\>\\|\\\\subsubsection\\>\\|\ \\\\paragraph\\>\\|\\\\subparagraph\\>\\|\ \\\\item\\>\\|\\\\bibitem\\>\\|\\\\newline\\>\\|\\\\noindent\\>\\|\ \\\\[a-z]*space\\>\\|\\\\[a-z]*skip\\>\\|\ \\\\newpage\\>\\|\\\\[a-z]*page\\|\\\\footnote\\>\\|\ \\\\marginpar\\>\\|\\\\parbox\\>\\|\\\\caption\\>") (setq paragraph-separate "[ \t]*$\\|[\f%]\\|[ \t]*\\$\\$[ \t]*$\\|\ \\\\begin\\>\\|\\\\label\\>\\|\\\\end\\>\\|\\\\\\[\\|\\\\\\]\\|\ \\\\chapter\\>\\|\\\\section\\>\\|\ \\\\subsection\\>\\|\\\\subsubsection\\>\\|\ \\\\paragraph\\>\\|\\\\subparagraph\\>\\|\ \\\\item[ \t]*$\\|\\\\bibitem[ \t]*$\\|\\\\newline[ \t]*$\\|\\\\noindent[ \t]*$\\|\ \\\\[a-z]*space[ \t]*$\\|\\\\[a-z]*skip[ \t]*$\\|\ \\\\newpage[ \t]*$\\|\\\\[a-z]*page[a-z]*[ \t]*$\\|\\\\footnote[ \t]*$\\|\ \\\\marginpar[ \t]*$\\|\\\\parbox[ \t]*$\\|\\\\caption[ \t]*$") (run-hooks 'text-mode-hook 'tex-mode-hook 'latex-mode-hook 'slitex-mode-hook)) (defun tex-common-initialization () (kill-all-local-variables) (use-local-map tex-mode-map) (setq local-abbrev-table text-mode-abbrev-table) (if (null tex-mode-syntax-table) (let ((char 0)) (setq tex-mode-syntax-table (make-syntax-table)) (set-syntax-table tex-mode-syntax-table) (while (< char ? ) (modify-syntax-entry char ".") (setq char (1+ char))) (modify-syntax-entry ?\C-@ "w") (modify-syntax-entry ?\t " ") (modify-syntax-entry ?\n ">") (modify-syntax-entry ?\f ">") (modify-syntax-entry ?$ "$$") (modify-syntax-entry ?% "<") (modify-syntax-entry ?\\ "/") (modify-syntax-entry ?\" ".") (modify-syntax-entry ?& ".") (modify-syntax-entry ?_ ".") (modify-syntax-entry ?@ "_") (modify-syntax-entry ?~ " ") (modify-syntax-entry ?' "w")) (set-syntax-table tex-mode-syntax-table)) (make-local-variable 'paragraph-start) ;; A line containing just $$ is treated as a paragraph separator. (setq paragraph-start "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$") (make-local-variable 'paragraph-separate) ;; A line starting with $$ starts a paragraph, ;; but does not separate paragraphs if it has more stuff on it. (setq paragraph-separate "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$[ \t]*$") (make-local-variable 'comment-start) (setq comment-start "%") (make-local-variable 'comment-start-skip) (setq comment-start-skip "\\(\\(^\\|[^\\]\\)\\(\\\\\\\\\\)*\\)\\(%+ *\\)") (make-local-variable 'comment-indent-function) (setq comment-indent-function 'tex-comment-indent) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (make-local-variable 'compare-windows-whitespace) (setq compare-windows-whitespace 'tex-categorize-whitespace) (make-local-variable 'tex-command) (make-local-variable 'tex-start-of-header) (make-local-variable 'tex-end-of-header) (make-local-variable 'tex-trailer)) (defun tex-comment-indent () (if (looking-at "%%%") (current-column) (skip-chars-backward " \t") (max (if (bolp) 0 (1+ (current-column))) comment-column))) (defun tex-categorize-whitespace (backward-limit) ;; compare-windows-whitespace is set to this. ;; This is basically a finite-state machine. ;; Returns a symbol telling how TeX would treat ;; the whitespace we are looking at: null, space, or par. (let ((category 'null) (not-finished t)) (skip-chars-backward " \t\n\f" backward-limit) (while not-finished (cond ((looking-at "[ \t]+") (goto-char (match-end 0)) (if (eql category 'null) (setq category 'space))) ((looking-at "\n") (cond ((eql category 'newline) (setq category 'par) (setq not-finished nil)) (t (setq category 'newline) ;a strictly internal state (goto-char (match-end 0))))) ((looking-at "\f+") (setq category 'par) (setq not-finished nil)) (t (setq not-finished nil)))) (skip-chars-forward " \t\n\f") (if (eql category 'newline) 'space ;TeX doesn't distinguish category))) (defun tex-insert-quote (arg) "Insert the appropriate quote marks for TeX. Inserts the value of `tex-open-quote' (normally ``) or `tex-close-quote' \(normally '') depending on the context. With prefix argument, always inserts \" characters." (interactive "*P") (if arg (self-insert-command (prefix-numeric-value arg)) (insert (cond ((or (bobp) (save-excursion (forward-char -1) (looking-at "\\s(\\|\\s \\|\\s>"))) tex-open-quote) ((= (preceding-char) ?\\) ?\") (t tex-close-quote))))) (defun validate-tex-buffer () "Check current buffer for paragraphs containing mismatched $s. Their positions are recorded in the buffer `*Occur*'. To find a particular invalidity from `*Occur*', switch to to that buffer and type C-c C-c on the line for the invalidity you want to see." (interactive) (let ((buffer (current-buffer)) (prevpos (point-min)) (linenum nil)) (with-output-to-temp-buffer "*Occur*" (princ "Mismatches:\n") (save-excursion (set-buffer standard-output) (occur-mode) (setq occur-buffer buffer) (setq occur-nlines 0) (setq occur-pos-list nil)) (save-excursion (goto-char (point-max)) (while (and (not (input-pending-p)) (not (bobp))) (let ((end (point))) ;; Scan the previous paragraph for invalidities. (search-backward "\n\n" nil 'move) (or (tex-validate-region (point) end) (let* ((end (save-excursion (forward-line 1) (point))) start tem) (beginning-of-line) (setq start (point)) ;; Keep track of line number as we scan, ;; in a cumulative fashion. (if linenum (setq linenum (- linenum (count-lines prevpos (point)))) (setq linenum (1+ (count-lines 1 start)))) (setq prevpos (point)) ;; Mention this mismatch in *Occur*. ;; Since we scan from end of buffer to beginning, ;; add each mismatch at the beginning of *Occur* ;; and at the beginning of occur-pos-list. (save-excursion (setq tem (point-marker)) (set-buffer standard-output) (goto-char (point-min)) ;; Skip "Mismatches:" header line. (forward-line 1) (setq occur-pos-list (cons tem occur-pos-list)) (insert-buffer-substring buffer start end) (forward-char (- start end)) (insert (format "%3d: " linenum)))))))) (save-excursion (set-buffer standard-output) (if (null occur-pos-list) (insert "None!\n")) (if (interactive-p) (message "%d mismatches found" (length occur-pos-list))))))) (defun tex-validate-region (start end) "Check for mismatched braces or $'s in region. Returns t if no mismatches. Returns nil and moves point to suspect area if a mismatch is found." (interactive "r") (let ((failure-point nil) (max-possible-sexps (- end start))) (save-excursion (condition-case () (save-restriction (narrow-to-region start end) (goto-char start) (while (< 0 (setq max-possible-sexps (1- max-possible-sexps))) (forward-sexp 1))) (error (setq failure-point (point))))) (if failure-point (progn (goto-char failure-point) nil) t))) (defun tex-terminate-paragraph (inhibit-validation) "Insert two newlines, breaking a paragraph for TeX. Check for mismatched braces or $s in paragraph being terminated. A prefix arg inhibits the checking." (interactive "*P") (or inhibit-validation (save-excursion (tex-validate-region (save-excursion (search-backward "\n\n" nil 'move) (point)) (point))) (message "Paragraph being closed appears to contain a mismatch")) (insert "\n\n")) (defun tex-insert-braces () "Make a pair of braces and be poised to type inside of them." (interactive "*") (insert ?\{) (save-excursion (insert ?}))) ;;; Like tex-insert-braces, but for LaTeX. (defun tex-latex-block (name) "Creates a matching pair of lines `\\begin{NAME}' and `\\end{NAME}' at point. Puts point on a blank line between them." (interactive (prog2 (barf-if-buffer-read-only) (list (completing-read "LaTeX block name: " (mapcar 'list (append standard-latex-block-names latex-block-names)))))) (let ((col (current-column))) (insert (format "\\begin{%s}\n" name)) (indent-to col) (save-excursion (insert ?\n) (indent-to col) (insert-string (format "\\end{%s}" name)) (if (eobp) (insert ?\n))))) (defun tex-last-unended-begin () "Leave point at the beginning of the last `\\begin{...}' that is unended." (while (and (re-search-backward "\\(\\\\begin\\s *{\\)\\|\\(\\\\end\\s *{\\)") (looking-at "\\\\end{")) (tex-last-unended-begin))) (defun tex-goto-last-unclosed-latex-block () "Move point to the last unclosed \\begin{...}. Mark is left at original location." (interactive) (let ((spot)) (save-excursion (condition-case nil (tex-last-unended-begin) (error (error "Couldn't find unended \\begin"))) (setq spot (point))) (push-mark) (goto-char spot))) (defun tex-close-latex-block () "Creates an \\end{...} to match the last unclosed \\begin{...}." (interactive "*") (let ((new-line-needed (bolp)) text indentation) (save-excursion (condition-case nil (tex-last-unended-begin) (error (error "Couldn't find unended \\begin"))) (setq indentation (current-column)) (re-search-forward "\\\\begin\\(\\s *{[^}\n]*}\\)") (setq text (buffer-substring (match-beginning 1) (match-end 1)))) (indent-to indentation) (insert "\\end" text) (if new-line-needed (insert ?\n)))) (defun tex-compilation-parse-errors () "Parse the current buffer as error messages. This makes a list of error descriptors, compilation-error-list. For each source-file, line-number pair in the buffer, the source file is read in, and the text location is saved in compilation-error-list. The function `next-error', assigned to \\[next-error], takes the next error off the list and visits its location. This function works on TeX compilations only. It is necessary for that purpose, since TeX does not put file names on the same line as line numbers for the errors." (setq compilation-error-list nil) (message "Parsing error messages...") (modify-syntax-entry ?\{ "_") (modify-syntax-entry ?\} "_") (modify-syntax-entry ?\[ "_") (modify-syntax-entry ?\] "_") (let (text-buffer last-filename last-linenum) ;; Don't reparse messages already seen at last parse. (goto-char compilation-parsing-end) ;; Don't parse the first two lines as error messages. ;; This matters for grep. (if (bobp) (forward-line 2)) (while (re-search-forward "^l\.[0-9]+ " nil t) (let (linenum filename error-marker text-marker) ;; Extract file name and line number from error message. ;; Line number is 2 away from beginning of line: "l.23" (beginning-of-line) (goto-char (+ (point) 2)) (setq linenum (read (current-buffer))) ;; The file is the one that was opened last and is still open. ;; We need to find the last open parenthesis. (insert ?\)) (backward-sexp) (forward-char) (setq filename (current-word)) ;; Locate the erring file and line. (if (and (equal filename last-filename) (= linenum last-linenum)) nil (skip-chars-backward "^(") (backward-char) (forward-sexp) (backward-delete-char 1) (setq error-marker (point-marker)) ;; text-buffer gets the buffer containing this error's file. (if (not (equal filename last-filename)) (setq text-buffer (and (file-exists-p (setq last-filename filename)) (find-file-noselect filename)) last-linenum 0)) (if text-buffer ;; Go to that buffer and find the erring line. (save-excursion (set-buffer text-buffer) (if (zerop last-linenum) (progn (goto-char 1) (setq last-linenum 1))) (forward-line (- linenum last-linenum)) (setq last-linenum linenum) (setq text-marker (point-marker)) (setq compilation-error-list (cons (list error-marker text-marker) compilation-error-list))))) (forward-line 1))) (setq compilation-parsing-end (point-max))) (message "Parsing error messages...done") (setq compilation-error-list (nreverse compilation-error-list))) ;;; Invoking TeX in an inferior shell. ;;; Why use a shell instead of running TeX directly? Because if TeX ;;; gets stuck, the user can switch to the shell window and type at it. ;;; The utility functions: ;;;###autoload (defun tex-start-shell () (save-excursion (set-buffer (make-comint "tex-shell" (or tex-shell-file-name (getenv "ESHELL") (getenv "SHELL") "/bin/sh") nil)) (let ((proc (get-process "tex-shell"))) (set-process-sentinel proc 'tex-shell-sentinel) (process-kill-without-query proc) (setq comint-prompt-regexp shell-prompt-pattern) (setq tex-shell-map (nconc (make-sparse-keymap) shell-mode-map)) (tex-define-common-keys tex-shell-map) (use-local-map tex-shell-map) (run-hooks 'tex-shell-hook) (while (zerop (buffer-size)) (sleep-for 1))))) (defun tex-display-shell () "Make the TeX shell buffer visible in a window." (display-buffer (process-buffer (get-process "tex-shell"))) (tex-recenter-output-buffer nil)) (defun tex-shell-sentinel (proc msg) (cond ((null (buffer-name (process-buffer proc))) ;; buffer killed (set-process-buffer proc nil) (tex-delete-last-temp-files)) ((memq (process-status proc) '(signal exit)) (tex-delete-last-temp-files)))) (defun tex-set-buffer-directory (buffer directory) "Set BUFFER's default directory to be DIRECTORY." (setq directory (file-name-as-directory (expand-file-name directory))) (if (not (file-directory-p directory)) (error "%s is not a directory" directory) (save-excursion (set-buffer buffer) (setq default-directory directory)))) (defvar tex-send-command-modified-tick 0) (make-variable-buffer-local 'tex-send-command-modified-tick) (defun tex-send-command (command &optional file background) "Send COMMAND to TeX shell process, substituting optional FILE for *. Do this in background if optional BACKGROUND is t. If COMMAND has no *, FILE will be appended, preceded by a blank, to COMMAND. If FILE is nil, no substitution will be made in COMMAND. COMMAND can be any expression that evaluates to a command string." (save-excursion (let* ((cmd (eval command)) (proc (or (get-process "tex-shell") (error "No TeX subprocess"))) (buf (process-buffer proc)) (star (string-match "\\*" cmd)) (string (concat (if file (if star (concat (substring cmd 0 star) file (substring cmd (1+ star))) (concat cmd " " file)) cmd) (if background "&" "")))) ;; Switch to buffer before checking for subproc output in it. (set-buffer buf) ;; If text is unchanged since previous tex-send-command, ;; we haven't got any output. So wait for output now. (if (= (buffer-modified-tick buf) tex-send-command-modified-tick) (accept-process-output proc)) (goto-char (process-mark proc)) (insert string) (comint-send-input) (setq tex-send-command-modified-tick (buffer-modified-tick buf))))) (defun tex-delete-last-temp-files (&optional not-all) "Delete any junk files from last temp file. If NOT-ALL is non-nil, save the `.dvi' file." (if tex-last-temp-file (let* ((dir (file-name-directory tex-last-temp-file)) (list (and (file-directory-p dir) (file-name-all-completions (file-name-nondirectory tex-last-temp-file) dir)))) (while list (if not-all (and ;; If arg is non-nil, don't delete the .dvi file. (not (string-match "\\.dvi$" (car list))) (delete-file (concat dir (car list)))) (delete-file (concat dir (car list)))) (setq list (cdr list)))))) (add-hook 'kill-emacs-hook 'tex-delete-last-temp-files) ;;; The commands: (defun tex-region (beg end) "Run TeX on the current region, via a temporary file. The file's name comes from the variable `tex-zap-file' and the variable `tex-directory' says where to put it. If the buffer has a header, the header is given to TeX before the region itself. The buffer's header is all lines between the strings defined by `tex-start-of-header' and `tex-end-of-header' inclusive. The header must start in the first 100 lines of the buffer. The value of `tex-trailer' is given to TeX as input after the region. The value of `tex-command' specifies the command to use to run TeX." (interactive "r") (if (tex-shell-running) (tex-kill-job) (tex-start-shell)) (or tex-zap-file (setq tex-zap-file (tex-generate-zap-file-name))) (let* ((temp-buffer (get-buffer-create " TeX-Output-Buffer")) ; Temp file will be written and TeX will be run in zap-directory. ; If the TEXINPUTS file has relative directories or if the region has ; \input of files, this must be the same directory as the file for ; TeX to access the correct inputs. That's why it's safest if ; tex-directory is ".". (zap-directory (file-name-as-directory (expand-file-name tex-directory))) (tex-out-file (concat zap-directory tex-zap-file))) ;; Don't delete temp files if we do the same buffer twice in a row. (or (eq (current-buffer) tex-last-buffer-texed) (tex-delete-last-temp-files t)) ;; Write the new temp file. (save-excursion (save-restriction (widen) (goto-char (point-min)) (forward-line 100) (let ((search-end (point)) (hbeg (point-min)) (hend (point-min)) (default-directory zap-directory)) (goto-char (point-min)) ;; Initialize the temp file with either the header or nothing (if (re-search-forward tex-start-of-header search-end t) (progn (beginning-of-line) (setq hbeg (point)) ;mark beginning of header (if (re-search-forward tex-end-of-header nil t) (progn (forward-line 1) (setq hend (point))) ;mark end of header (setq hbeg (point-min))))) ;no header (write-region (min hbeg beg) hend (concat tex-out-file ".tex") nil nil) (write-region (max beg hend) end (concat tex-out-file ".tex") t nil)) (let ((local-tex-trailer tex-trailer)) (set-buffer temp-buffer) (erase-buffer) ;; make sure trailer isn't hidden by a comment (insert-string "\n") (if local-tex-trailer (insert-string local-tex-trailer)) (tex-set-buffer-directory temp-buffer zap-directory) (write-region (point-min) (point-max) (concat tex-out-file ".tex") t nil)))) ;; Record the file name to be deleted afterward. (setq tex-last-temp-file tex-out-file) (tex-send-command tex-shell-cd-command zap-directory) (tex-send-command tex-command tex-out-file) (tex-display-shell) (setq tex-print-file tex-out-file) (setq tex-last-buffer-texed (current-buffer)))) (defun tex-buffer () "Run TeX on current buffer. See \\[tex-region] for more information. Does not save the buffer, so it's useful for trying experimental versions. See \\[tex-file] for an alternative." (interactive) (tex-region (point-min) (point-max))) (defun tex-file () "Prompt to save all buffers and run TeX (or LaTeX) on current buffer's file. This function is more useful than \\[tex-buffer] when you need the `.aux' file of LaTeX to have the correct name." (interactive) (let ((tex-out-file (if (buffer-file-name) (file-name-nondirectory (buffer-file-name)) (error "Buffer does not seem to be associated with any file"))) (file-dir (file-name-directory (buffer-file-name)))) (if tex-offer-save (save-some-buffers)) (if (tex-shell-running) (tex-kill-job) (tex-start-shell)) (tex-send-command tex-shell-cd-command file-dir) (tex-send-command tex-command tex-out-file)) (tex-display-shell) (setq tex-last-buffer-texed (current-buffer)) (setq tex-print-file (buffer-file-name))) (defun tex-generate-zap-file-name () "Generate a unique name suitable for use as a file name." ;; Include the shell process number and host name ;; in case there are multiple shells (for same or different user). (format "#tz%d%s" (process-id (get-buffer-process "*tex-shell*")) (tex-strip-dots (system-name)))) (defun tex-strip-dots (s) (setq s (copy-sequence s)) (while (string-match "\\." s) (aset s (match-beginning 0) ?-)) s) ;; This will perhaps be useful for modifying TEXINPUTS. ;; Expand each file name, separated by colons, in the string S. (defun tex-expand-files (s) (let (elts (start 0)) (while (string-match ":" s start) (setq elts (cons (substring s start (match-beginning 0)) elts)) (setq start (match-end 0))) (or (= start 0) (setq elts (cons (substring s start) elts))) (mapconcat 'expand-file-name (nreverse elts) ":"))) (defun tex-shell-running () (and (get-process "tex-shell") (eq (process-status (get-process "tex-shell")) 'run))) (defun tex-kill-job () "Kill the currently running TeX job." (interactive) (quit-process (get-process "tex-shell") t)) (defun tex-recenter-output-buffer (linenum) "Redisplay buffer of TeX job output so that most recent output can be seen. The last line of the buffer is displayed on line LINE of the window, or centered if LINE is nil." (interactive "P") (let ((tex-shell (get-buffer "*tex-shell*")) (old-buffer (current-buffer))) (if (null tex-shell) (message "No TeX output buffer") (pop-to-buffer tex-shell) (bury-buffer tex-shell) (goto-char (point-max)) (recenter (if linenum (prefix-numeric-value linenum) (/ (window-height) 2))) (pop-to-buffer old-buffer)))) (defun tex-print (&optional alt) "Print the .dvi file made by \\[tex-region], \\[tex-buffer] or \\[tex-file]. Runs the shell command defined by `tex-dvi-print-command'. If prefix argument is provided, use the alternative command, `tex-alt-dvi-print-command'." (interactive "P") (let ((print-file-name-dvi (tex-append tex-print-file ".dvi")) test-name) (if (and (not (equal (current-buffer) tex-last-buffer-texed)) (buffer-file-name) ;; Check that this buffer's printed file is up to date. (file-newer-than-file-p (setq test-name (tex-append (buffer-file-name) ".dvi")) (buffer-file-name))) (setq print-file-name-dvi test-name)) (if (not (file-exists-p print-file-name-dvi)) (error "No appropriate `.dvi' file could be found") (tex-send-command (if alt tex-alt-dvi-print-command tex-dvi-print-command) print-file-name-dvi t)))) (defun tex-alt-print () "Print the .dvi file made by \\[tex-region], \\[tex-buffer] or \\[tex-file]. Runs the shell command defined by `tex-alt-dvi-print-command'." (interactive) (tex-print t)) (defun tex-view () "Preview the last `.dvi' file made by running TeX under Emacs. This means, made using \\[tex-region], \\[tex-buffer] or \\[tex-file]. The variable `tex-dvi-view-command' specifies the shell command for preview. You must set that variable yourself before using this command, because there is no standard value that would generally work." (interactive) (or tex-dvi-view-command (error "You must set `tex-dvi-view-command'")) (let ((tex-dvi-print-command tex-dvi-view-command)) (tex-print))) (defun tex-append (file-name suffix) "Append to FILENAME the suffix SUFFIX, using same algorithm TeX uses. Pascal-based TeX scans for the first period, C TeX uses the last. No period is retained immediately before SUFFIX, so normally SUFFIX starts with one." (if (stringp file-name) (let ((file (file-name-nondirectory file-name)) trial-name) ;; Try spliting on last period. ;; The first-period split can get fooled when two files ;; named a.tex and a.b.tex are both tex'd; ;; the last-period split must be right if it matches at all. (setq trial-name (concat (file-name-directory file-name) (substring file 0 (string-match "\\.[^.]*$" file)) suffix)) (if (or (file-exists-p trial-name) (file-exists-p (concat trial-name ".aux"))) ;for BibTeX files trial-name ;; Not found, so split on first period. (concat (file-name-directory file-name) (substring file 0 (string-match "\\." file)) suffix))) " ")) (defun tex-show-print-queue () "Show the print queue that \\[tex-print] put your job on. Runs the shell command defined by `tex-show-queue-command'." (interactive) (if (tex-shell-running) (tex-kill-job) (tex-start-shell)) (tex-send-command tex-show-queue-command) (tex-display-shell)) (defun tex-bibtex-file () "Run BibTeX on the current buffer's file." (interactive) (if (tex-shell-running) (tex-kill-job) (tex-start-shell)) (let ((tex-out-file (tex-append (file-name-nondirectory (buffer-file-name)) "")) (file-dir (file-name-directory (buffer-file-name)))) (tex-send-command tex-shell-cd-command file-dir) (tex-send-command tex-bibtex-command tex-out-file)) (tex-display-shell)) (run-hooks 'tex-mode-load-hook) (provide 'tex-mode) ;;; tex-mode.el ends here emacs-19.30/lisp/texinfmt.el100444 12120 1 341537 6045205360 14304 0ustar rmsdaemon;;; texinfmt.el --- format Texinfo files into Info files. ;; Copyright (C) 1985, 1986, 1988, ;; 1990, 1991, 1992, 1993 Free Software Foundation, Inc. ;; Maintainer: Robert J. Chassell ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;;; Emacs lisp functions to convert Texinfo files to Info files. (defvar texinfmt-version "2.32 of 19 November 1993") ;;; Variable definitions (require 'texinfo) ; So `texinfo-footnote-style' is defined. (require 'texnfo-upd) ; So `texinfo-section-types-regexp' is defined. (defvar texinfo-format-syntax-table nil) (defvar texinfo-vindex) (defvar texinfo-findex) (defvar texinfo-cindex) (defvar texinfo-pindex) (defvar texinfo-tindex) (defvar texinfo-kindex) (defvar texinfo-last-node) (defvar texinfo-node-names) (defvar texinfo-enclosure-list) (defvar texinfo-alias-list) (defvar texinfo-command-start) (defvar texinfo-command-end) (defvar texinfo-command-name) (defvar texinfo-defun-type) (defvar texinfo-last-node-pos) (defvar texinfo-stack) (defvar texinfo-short-index-cmds-alist) (defvar texinfo-short-index-format-cmds-alist) (defvar texinfo-format-filename) (defvar texinfo-footnote-number) (defvar texinfo-start-of-header) (defvar texinfo-end-of-header) (defvar texinfo-raisesections-alist) (defvar texinfo-lowersections-alist) ;;; Syntax table (if texinfo-format-syntax-table nil (setq texinfo-format-syntax-table (make-syntax-table)) (modify-syntax-entry ?\" " " texinfo-format-syntax-table) (modify-syntax-entry ?\\ " " texinfo-format-syntax-table) (modify-syntax-entry ?@ "\\" texinfo-format-syntax-table) (modify-syntax-entry ?\^q "\\" texinfo-format-syntax-table) (modify-syntax-entry ?\[ "." texinfo-format-syntax-table) (modify-syntax-entry ?\] "." texinfo-format-syntax-table) (modify-syntax-entry ?\( "." texinfo-format-syntax-table) (modify-syntax-entry ?\) "." texinfo-format-syntax-table) (modify-syntax-entry ?{ "(}" texinfo-format-syntax-table) (modify-syntax-entry ?} "){" texinfo-format-syntax-table) (modify-syntax-entry ?\' "." texinfo-format-syntax-table)) ;;; Top level buffer and region formatting functions ;;;###autoload (defun texinfo-format-buffer (&optional notagify) "Process the current buffer as texinfo code, into an Info file. The Info file output is generated in a buffer visiting the Info file names specified in the @setfilename command. Non-nil argument (prefix, if interactive) means don't make tag table and don't split the file if large. You can use Info-tagify and Info-split to do these manually." (interactive "P") (let ((lastmessage "Formatting Info file...")) (message lastmessage) (texinfo-format-buffer-1) (if notagify nil (if (> (buffer-size) 30000) (progn (message (setq lastmessage "Making tags table for Info file...")) (Info-tagify))) (if (> (buffer-size) 100000) (progn (message (setq lastmessage "Splitting Info file...")) (Info-split)))) (message (concat lastmessage (if (interactive-p) "done. Now save it." "done."))))) (defvar texinfo-region-buffer-name "*Info Region*" "*Name of the temporary buffer used by \\[texinfo-format-region].") ;;;###autoload (defun texinfo-format-region (region-beginning region-end) "Convert the current region of the Texinfo file to Info format. This lets you see what that part of the file will look like in Info. The command is bound to \\[texinfo-format-region]. The text that is converted to Info is stored in a temporary buffer." (interactive "r") (message "Converting region to Info format...") (let (texinfo-command-start texinfo-command-end texinfo-command-name texinfo-vindex texinfo-findex texinfo-cindex texinfo-pindex texinfo-tindex texinfo-kindex texinfo-stack (texinfo-format-filename "") texinfo-example-start texinfo-last-node-pos texinfo-last-node texinfo-node-names (texinfo-footnote-number 0) last-input-buffer (fill-column-for-info fill-column) (input-buffer (current-buffer)) (input-directory default-directory) (header-text "") (header-beginning 1) (header-end 1)) ;;; Copy lines between beginning and end of header lines, ;;; if any, or else copy the `@setfilename' line, if any. (save-excursion (save-restriction (widen) (goto-char (point-min)) (let ((search-end (save-excursion (forward-line 100) (point)))) (if (or ;; Either copy header text. (and (prog1 (search-forward tex-start-of-header search-end t) (forward-line 1) ;; Mark beginning of header. (setq header-beginning (point))) (prog1 (search-forward tex-end-of-header nil t) (beginning-of-line) ;; Mark end of header (setq header-end (point)))) ;; Or copy @filename line. (prog2 (goto-char (point-min)) (search-forward "@setfilename" search-end t) (beginning-of-line) (setq header-beginning (point)) (forward-line 1) (setq header-end (point)))) ;; Copy header (setq header-text (buffer-substring (min header-beginning region-beginning) header-end)))))) ;;; Find a buffer to use. (switch-to-buffer (get-buffer-create texinfo-region-buffer-name)) (erase-buffer) ;; Insert the header into the buffer. (insert header-text) ;; Insert the region into the buffer. (insert-buffer-substring input-buffer (max region-beginning header-end) region-end) ;; Make sure region ends in a newline. (or (= (preceding-char) ?\n) (insert "\n")) (goto-char (point-min)) (texinfo-mode) (message "Converting region to Info format...") (setq fill-column fill-column-for-info) ;; Install a syntax table useful for scanning command operands. (set-syntax-table texinfo-format-syntax-table) ;; Insert @include files so `texinfo-raise-lower-sections' can ;; work on them without losing track of multiple ;; @raise/@lowersections commands. (while (re-search-forward "^@include" nil t) (setq texinfo-command-end (point)) (let ((filename (concat input-directory (texinfo-parse-line-arg)))) (re-search-backward "^@include") (delete-region (point) (save-excursion (forward-line 1) (point))) (message "Reading included file: %s" filename) (save-excursion (save-restriction (narrow-to-region (point) (+ (point) (car (cdr (insert-file-contents filename))))) (goto-char (point-min)) ;; Remove `@setfilename' line from included file, if any, ;; so @setfilename command not duplicated. (if (re-search-forward "^@setfilename" (save-excursion (forward-line 100) (point)) t) (progn (beginning-of-line) (delete-region (point) (save-excursion (forward-line 1) (point))))))))) ;; Raise or lower level of each section, if necessary. (goto-char (point-min)) (texinfo-raise-lower-sections) ;; Append @refill to appropriate paragraphs for filling. (goto-char (point-min)) (texinfo-append-refill) ;; If the region includes the effective end of the data, ;; discard everything after that. (goto-char (point-max)) (if (re-search-backward "^@bye" nil t) (delete-region (point) (point-max))) ;; Make sure buffer ends in a newline. (or (= (preceding-char) ?\n) (insert "\n")) ;; Don't use a previous value of texinfo-enclosure-list. (setq texinfo-enclosure-list nil) (setq texinfo-alias-list nil) (goto-char (point-min)) (if (looking-at "\\\\input[ \t]+texinfo") (delete-region (point) (save-excursion (forward-line 1) (point)))) ;; Insert Info region title text. (goto-char (point-min)) (if (search-forward "@setfilename" (save-excursion (forward-line 100) (point)) t) (progn (setq texinfo-command-end (point)) (beginning-of-line) (setq texinfo-command-start (point)) (let ((arg (texinfo-parse-arg-discard))) (insert " " texinfo-region-buffer-name " buffer for: `") (insert (file-name-nondirectory (expand-file-name arg))) (insert "', -*-Text-*-\n"))) ;; Else no `@setfilename' line (insert " " texinfo-region-buffer-name " buffer -*-Text-*-\n")) (insert "produced by `texinfo-format-region'\n" "from a region in: " (if (buffer-file-name input-buffer) (concat "`" (file-name-sans-versions (file-name-nondirectory (buffer-file-name input-buffer))) "'") (concat "buffer `" (buffer-name input-buffer) "'")) "\nusing `texinfmt.el' version " texinfmt-version ".\n\n") ;; Now convert for real. (goto-char (point-min)) (texinfo-format-scan) (goto-char (point-min)) (message "Done."))) ;;; Primary internal formatting function for the whole buffer. (defun texinfo-format-buffer-1 () (let (texinfo-format-filename texinfo-example-start texinfo-command-start texinfo-command-end texinfo-command-name texinfo-last-node texinfo-last-node-pos texinfo-vindex texinfo-findex texinfo-cindex texinfo-pindex texinfo-tindex texinfo-kindex texinfo-stack texinfo-node-names (texinfo-footnote-number 0) last-input-buffer outfile (fill-column-for-info fill-column) (input-buffer (current-buffer)) (input-directory default-directory)) (setq texinfo-enclosure-list nil) (setq texinfo-alias-list nil) (save-excursion (goto-char (point-min)) (or (search-forward "@setfilename" nil t) (error "Texinfo file needs an `@setfilename FILENAME' line.")) (setq texinfo-command-end (point)) (setq outfile (texinfo-parse-line-arg))) (find-file outfile) (texinfo-mode) (setq fill-column fill-column-for-info) (set-syntax-table texinfo-format-syntax-table) (erase-buffer) (insert-buffer-substring input-buffer) (message "Converting %s to Info format..." (buffer-name input-buffer)) ;; Insert @include files so `texinfo-raise-lower-sections' can ;; work on them without losing track of multiple ;; @raise/@lowersections commands. (goto-char (point-min)) (while (re-search-forward "^@include" nil t) (setq texinfo-command-end (point)) (let ((filename (concat input-directory (texinfo-parse-line-arg)))) (re-search-backward "^@include") (delete-region (point) (save-excursion (forward-line 1) (point))) (message "Reading included file: %s" filename) (save-excursion (save-restriction (narrow-to-region (point) (+ (point) (car (cdr (insert-file-contents filename))))) (goto-char (point-min)) ;; Remove `@setfilename' line from included file, if any, ;; so @setfilename command not duplicated. (if (re-search-forward "^@setfilename" (save-excursion (forward-line 100) (point)) t) (progn (beginning-of-line) (delete-region (point) (save-excursion (forward-line 1) (point))))))))) ;; Raise or lower level of each section, if necessary. (goto-char (point-min)) (texinfo-raise-lower-sections) ;; Append @refill to appropriate paragraphs (goto-char (point-min)) (texinfo-append-refill) (goto-char (point-min)) (search-forward "@setfilename") (beginning-of-line) (delete-region (point-min) (point)) ;; Remove @bye at end of file, if it is there. (goto-char (point-max)) (if (search-backward "@bye" nil t) (delete-region (point) (point-max))) ;; Make sure buffer ends in a newline. (or (= (preceding-char) ?\n) (insert "\n")) ;; Scan the whole buffer, converting to Info format. (texinfo-format-scan) ;; Return data for indices. (goto-char (point-min)) (list outfile texinfo-vindex texinfo-findex texinfo-cindex texinfo-pindex texinfo-tindex texinfo-kindex))) ;;; Perform non-@-command file conversions: quotes and hyphens (defun texinfo-format-convert (min max) ;; Convert left and right quotes to typewriter font quotes. (goto-char min) (while (search-forward "``" max t) (replace-match "\"")) (goto-char min) (while (search-forward "''" max t) (replace-match "\"")) ;; Convert three hyphens in a row to two. (goto-char min) (while (re-search-forward "\\( \\|\\w\\)\\(---\\)\\( \\|\\w\\)" max t) (delete-region (1+ (match-beginning 2)) (+ 2 (match-beginning 2))))) ;;; Handle paragraph filling (defvar texinfo-no-refill-regexp "^@\\(example\\|smallexample\\|lisp\\|smalllisp\\|display\\|format\\|flushleft\\|flushright\\|menu\\|titlepage\\|iftex\\|ifhtml\\|tex\\|html\\)" "Regexp specifying environments in which paragraphs are not filled.") (defvar texinfo-part-of-para-regexp "^@\\(b{\\|bullet{\\|cite{\\|code{\\|emph{\\|equiv{\\|error{\\|expansion{\\|file{\\|i{\\|inforef{\\|kbd{\\|key{\\|lisp{\\|minus{\\|point{\\|print{\\|pxref{\\|r{\\|ref{\\|result{\\|samp{\\|sc{\\|t{\\|TeX{\\|today{\\|var{\\|w{\\|xref{\\)" "Regexp specifying @-commands found within paragraphs.") (defun texinfo-append-refill () "Append @refill at end of each paragraph that should be filled. Do not append @refill to paragraphs within @example and similar environments. Do not append @refill to paragraphs containing @w{TEXT} or @*." ;; It is necessary to append @refill before other processing because ;; the other processing removes information that tells Texinfo ;; whether the text should or should not be filled. (while (< (point) (point-max)) (let ((refill-blank-lines "^[ \t\n]*$") (case-fold-search nil)) ; Don't confuse @TeX and @tex.... (beginning-of-line) ;; 1. Skip over blank lines; ;; skip over lines beginning with @-commands, ;; but do not skip over lines ;; that are no-refill environments such as @example or ;; that begin with within-paragraph @-commands such as @code. (while (and (looking-at (concat "^@\\|^\\\\\\|" refill-blank-lines)) (not (looking-at (concat "\\(" texinfo-no-refill-regexp "\\|" texinfo-part-of-para-regexp "\\)"))) (< (point) (point-max))) (forward-line 1)) ;; 2. Skip over @example and similar no-refill environments. (if (looking-at texinfo-no-refill-regexp) (let ((environment (buffer-substring (match-beginning 1) (match-end 1)))) (progn (re-search-forward (concat "^@end " environment) nil t) (forward-line 1))) ;; 3. Do not refill a paragraph containing @w or @* (if (or (>= (point) (point-max)) (re-search-forward "@w{\\|@\\*" (save-excursion (forward-paragraph) (point)) t)) ;; Go to end of paragraph and do nothing. (forward-paragraph) ;; 4. Else go to end of paragraph and insert @refill (forward-paragraph) (forward-line -1) (end-of-line) (delete-region (point) (save-excursion (skip-chars-backward " \t") (point))) ;; `looking-at-backward' not available in v. 18.57 ;; (if (not (looking-at-backward "@refill\\|@bye")) ;) (if (not (re-search-backward "@refill\\|@bye" (save-excursion (beginning-of-line) (point)) t)) (insert "@refill")) (forward-line 1)))))) ;;; Handle `@raisesections' and `@lowersections' commands ;; These commands change the hierarchical level of chapter structuring ;; commands. ;; ;; @raisesections changes @subsection to @section, ;; @section to @chapter, ;; etc. ;; ;; @lowersections changes @chapter to @section ;; @subsection to @subsubsection, ;; etc. ;; ;; An @raisesections/@lowersections command changes only those ;; structuring commands that follow the @raisesections/@lowersections ;; command. ;; ;; Repeated @raisesections/@lowersections continue to raise or lower ;; the heading level. ;; ;; An @lowersections command cancels an @raisesections command, and ;; vice versa. ;; ;; You cannot raise or lower "beyond" chapters or subsubsections, but ;; trying to do so does not elicit an error---you just get more ;; headings that mean the same thing as you keep raising or lowering ;; (for example, after a single @raisesections, both @chapter and ;; @section produce chapter headings). (defun texinfo-raise-lower-sections () "Raise or lower the hierarchical level of chapters, sections, etc. This function acts according to `@raisesections' and `@lowersections' commands in the Texinfo file. For example, an `@lowersections' command is useful if you wish to include what is written as an outer or standalone Texinfo file in another Texinfo file as an inner, included file. The `@lowersections' command changes chapters to sections, sections to subsections and so on. @raisesections changes @subsection to @section, @section to @chapter, @heading to @chapheading, etc. @lowersections changes @chapter to @section, @subsection to @subsubsection, @heading to @subheading, etc. An `@raisesections' or `@lowersections' command changes only those structuring commands that follow the `@raisesections' or `@lowersections' command. An `@lowersections' command cancels an `@raisesections' command, and vice versa. Repeated use of the commands continue to raise or lower the hierarchical level a step at a time. An attempt to raise above `chapters' reproduces chapter commands; an attempt to lower below subsubsections reproduces subsubsection commands." ;; `texinfo-section-types-regexp' is defined in `texnfo-upd.el'; ;; it is a regexp matching chapter, section, other headings ;; (but not the top node). (let (type (level 0)) (while (re-search-forward (concat "\\(\\(^@\\(raise\\|lower\\)sections\\)\\|\\(" texinfo-section-types-regexp "\\)\\)") nil t) (beginning-of-line) (save-excursion (setq type (read (current-buffer)))) (cond ;; 1. Increment level ((eq type '@raisesections) (setq level (1+ level)) (delete-region (point) (save-excursion (forward-line 1) (point)))) ;; 2. Decrement level ((eq type '@lowersections) (setq level (1- level)) (delete-region (point) (save-excursion (forward-line 1) (point)))) ;; Now handle structuring commands ((cond ;; 3. Raise level when positive ((> level 0) (let ((count level) (new-level type)) (while (> count 0) (setq new-level (cdr (assq new-level texinfo-raisesections-alist))) (setq count (1- count))) (kill-word 1) (insert (symbol-name new-level)))) ;; 4. Do nothing except move point when level is zero ((= level 0) (forward-line 1)) ;; 5. Lower level when positive ((< level 0) (let ((count level) (new-level type)) (while (< count 0) (setq new-level (cdr (assq new-level texinfo-lowersections-alist))) (setq count (1+ count))) (kill-word 1) (insert (symbol-name new-level)))))))))) (defvar texinfo-raisesections-alist '((@chapter . @chapter) ; Cannot go higher (@unnumbered . @unnumbered) (@majorheading . @majorheading) (@chapheading . @chapheading) (@appendix . @appendix) (@section . @chapter) (@unnumberedsec . @unnumbered) (@heading . @chapheading) (@appendixsec . @appendix) (@subsection . @section) (@unnumberedsubsec . @unnumberedsec) (@subheading . @heading) (@appendixsubsec . @appendixsec) (@subsubsection . @subsection) (@unnumberedsubsubsec . @unnumberedsubsec) (@subsubheading . @subheading) (@appendixsubsubsec . @appendixsubsec)) "*An alist of next higher levels for chapters, sections. etc. For example, section to chapter, subsection to section. Used by `texinfo-raise-lower-sections'. The keys specify types of section; the values correspond to the next higher types.") (defvar texinfo-lowersections-alist '((@chapter . @section) (@unnumbered . @unnumberedsec) (@majorheading . @heading) (@chapheading . @heading) (@appendix . @appendixsec) (@section . @subsection) (@unnumberedsec . @unnumberedsubsec) (@heading . @subheading) (@appendixsec . @appendixsubsec) (@subsection . @subsubsection) (@unnumberedsubsec . @unnumberedsubsubsec) (@subheading . @subsubheading) (@appendixsubsec . @appendixsubsubsec) (@subsubsection . @subsubsection) ; Cannot go lower. (@unnumberedsubsubsec . @unnumberedsubsubsec) (@subsubheading . @subsubheading) (@appendixsubsubsec . @appendixsubsubsec)) "*An alist of next lower levels for chapters, sections. etc. For example, chapter to section, section to subsection. Used by `texinfo-raise-lower-sections'. The keys specify types of section; the values correspond to the next lower types.") ;;; Perform those texinfo-to-info conversions that apply to the whole input ;;; uniformly. (defun texinfo-format-scan () (texinfo-format-convert (point-min) (point-max)) ;; Scan for @-commands. (goto-char (point-min)) (while (search-forward "@" nil t) (if (looking-at "[@{}^'` *\"?!]") ;; Handle a few special @-followed-by-one-char commands. (if (= (following-char) ?*) (progn ;; remove command (delete-region (1- (point)) (1+ (point))) ;; insert return if not at end of line; ;; else line is already broken. (if (not (= (following-char) ?\n)) (insert ?\n))) ;; The other characters are simply quoted. Delete the @. (delete-char -1) (forward-char 1)) ;; @ is followed by a command-word; find the end of the word. (setq texinfo-command-start (1- (point))) (if (= (char-syntax (following-char)) ?w) (forward-word 1) (forward-char 1)) (setq texinfo-command-end (point)) ;; Handle let aliasing (setq texinfo-command-name (let (trial (cmdname (buffer-substring (1+ texinfo-command-start) texinfo-command-end))) (while (setq trial (assoc cmdname texinfo-alias-list)) (setq cmdname (cdr trial))) (intern cmdname))) ;; Call the handler for this command. (let ((enclosure-type (assoc (symbol-name texinfo-command-name) texinfo-enclosure-list))) (if enclosure-type (progn (insert (car (car (cdr enclosure-type))) (texinfo-parse-arg-discard) (car (cdr (car (cdr enclosure-type))))) (goto-char texinfo-command-start)) (let ((cmd (get texinfo-command-name 'texinfo-format))) (if cmd (funcall cmd) (texinfo-unsupported))))))) (cond (texinfo-stack (goto-char (nth 2 (car texinfo-stack))) (error "Unterminated @%s" (car (car texinfo-stack)))))) (put 'begin 'texinfo-format 'texinfo-format-begin) (defun texinfo-format-begin () (texinfo-format-begin-end 'texinfo-format)) (put 'end 'texinfo-format 'texinfo-format-end) (defun texinfo-format-end () (texinfo-format-begin-end 'texinfo-end)) (defun texinfo-format-begin-end (prop) (setq texinfo-command-name (intern (texinfo-parse-line-arg))) (let ((cmd (get texinfo-command-name prop))) (if cmd (funcall cmd) (texinfo-unsupported)))) ;;; Parsing functions (defun texinfo-parse-line-arg () (goto-char texinfo-command-end) (let ((start (point))) (cond ((looking-at " ") (skip-chars-forward " ") (setq start (point)) (end-of-line) (skip-chars-backward " ") (delete-region (point) (progn (end-of-line) (point))) (setq texinfo-command-end (1+ (point)))) ((looking-at "{") (setq start (1+ (point))) (forward-list 1) (setq texinfo-command-end (point)) (forward-char -1)) (t (error "Invalid texinfo command arg format"))) (prog1 (buffer-substring start (point)) (if (eolp) (forward-char 1))))) (defun texinfo-parse-expanded-arg () (goto-char texinfo-command-end) (let ((start (point)) marker) (cond ((looking-at " ") (skip-chars-forward " ") (setq start (point)) (end-of-line) (setq texinfo-command-end (1+ (point)))) ((looking-at "{") (setq start (1+ (point))) (forward-list 1) (setq texinfo-command-end (point)) (forward-char -1)) (t (error "Invalid texinfo command arg format"))) (setq marker (move-marker (make-marker) texinfo-command-end)) (texinfo-format-expand-region start (point)) (setq texinfo-command-end (marker-position marker)) (move-marker marker nil) (prog1 (buffer-substring start (point)) (if (eolp) (forward-char 1))))) (defun texinfo-format-expand-region (start end) (save-restriction (narrow-to-region start end) (let (texinfo-command-start texinfo-command-end texinfo-command-name texinfo-stack) (texinfo-format-scan)) (goto-char (point-max)))) (defun texinfo-parse-arg-discard () (prog1 (texinfo-parse-line-arg) (texinfo-discard-command))) (defun texinfo-discard-command () (delete-region texinfo-command-start texinfo-command-end)) (defun texinfo-optional-braces-discard () "Discard braces following command, if any." (goto-char texinfo-command-end) (let ((start (point))) (cond ((looking-at "[ \t]*\n")) ; do nothing ((looking-at "{") ; remove braces, if any (forward-list 1) (setq texinfo-command-end (point))) (t (error "Invalid `texinfo-optional-braces-discard' format \(need braces?\)"))) (delete-region texinfo-command-start texinfo-command-end))) (defun texinfo-format-parse-line-args () (let ((start (1- (point))) next beg end args) (skip-chars-forward " ") (while (not (eolp)) (setq beg (point)) (re-search-forward "[\n,]") (setq next (point)) (if (bolp) (setq next (1- next))) (forward-char -1) (skip-chars-backward " ") (setq end (point)) (setq args (cons (if (> end beg) (buffer-substring beg end)) args)) (goto-char next) (skip-chars-forward " ")) (if (eolp) (forward-char 1)) (setq texinfo-command-end (point)) (nreverse args))) (defun texinfo-format-parse-args () (let ((start (1- (point))) next beg end args) (search-forward "{") (save-excursion (texinfo-format-expand-region (point) (save-excursion (up-list 1) (1- (point))))) ;; The following does not handle cross references of the form: ;; `@xref{bullet, , @code{@@bullet}@{@}}.' because the ;; re-search-forward finds the first right brace after the second ;; comma. (while (/= (preceding-char) ?\}) (skip-chars-forward " \t\n") (setq beg (point)) (re-search-forward "[},]") (setq next (point)) (forward-char -1) (skip-chars-backward " \t\n") (setq end (point)) (cond ((< beg end) (goto-char beg) (while (search-forward "\n" end t) (replace-match " ")))) (setq args (cons (if (> end beg) (buffer-substring beg end)) args)) (goto-char next)) (if (eolp) (forward-char 1)) (setq texinfo-command-end (point)) (nreverse args))) (defun texinfo-format-parse-defun-args () (goto-char texinfo-command-end) (let ((start (point))) (end-of-line) (setq texinfo-command-end (1+ (point))) (let ((marker (move-marker (make-marker) texinfo-command-end))) (texinfo-format-expand-region start (point)) (setq texinfo-command-end (marker-position marker)) (move-marker marker nil)) (goto-char start) (let ((args '()) beg end) (skip-chars-forward " ") (while (not (eolp)) (cond ((looking-at "{") (setq beg (1+ (point))) (forward-list 1) (setq end (1- (point)))) (t (setq beg (point)) (re-search-forward "[\n ]") (forward-char -1) (setq end (point)))) (setq args (cons (buffer-substring beg end) args)) (skip-chars-forward " ")) (forward-char 1) (nreverse args)))) (defun texinfo-discard-line () (goto-char texinfo-command-end) (skip-chars-forward " \t") (or (eolp) (error "Extraneous text at end of command line.")) (goto-char texinfo-command-start) (or (bolp) (error "Extraneous text at beginning of command line.")) (delete-region (point) (progn (forward-line 1) (point)))) (defun texinfo-discard-line-with-args () (goto-char texinfo-command-start) (delete-region (point) (progn (forward-line 1) (point)))) ;;; @setfilename ;; Only `texinfo-format-buffer' handles @setfilename with this ;; definition; `texinfo-format-region' handles @setfilename, if any, ;; specially. (put 'setfilename 'texinfo-format 'texinfo-format-setfilename) (defun texinfo-format-setfilename () (let ((arg (texinfo-parse-arg-discard))) (message "Formatting Info file: %s" arg) (setq texinfo-format-filename (file-name-nondirectory (expand-file-name arg))) (insert "Info file: " texinfo-format-filename ", -*-Text-*-\n" ;; Date string removed so that regression testing is easier. ;; "produced on " ;; (substring (current-time-string) 8 10) " " ;; (substring (current-time-string) 4 7) " " ;; (substring (current-time-string) -4) " " "produced by `texinfo-format-buffer'\n" "from file" (if (buffer-file-name input-buffer) (concat " `" (file-name-sans-versions (file-name-nondirectory (buffer-file-name input-buffer))) "'") (concat "buffer `" (buffer-name input-buffer) "'")) "\nusing `texinfmt.el' version " texinfmt-version ".\n\n"))) ;;; @node, @menu (put 'node 'texinfo-format 'texinfo-format-node) (put 'nwnode 'texinfo-format 'texinfo-format-node) (defun texinfo-format-node () (let* ((args (texinfo-format-parse-line-args)) (name (nth 0 args)) (next (nth 1 args)) (prev (nth 2 args)) (up (nth 3 args))) (texinfo-discard-command) (setq texinfo-last-node name) (let ((tem (downcase name))) (if (assoc tem texinfo-node-names) (error "Duplicate node name: %s" name) (setq texinfo-node-names (cons (list tem) texinfo-node-names)))) (setq texinfo-footnote-number 0) ;; insert "\n\^_" unconditionally since this is what info is looking for (insert "\n\^_\nFile: " texinfo-format-filename ", Node: " name) (if next (insert ", Next: " next)) (if prev (insert ", Prev: " prev)) (if up (insert ", Up: " up)) (insert ?\n) (setq texinfo-last-node-pos (point)))) (put 'menu 'texinfo-format 'texinfo-format-menu) (defun texinfo-format-menu () (texinfo-discard-line) (insert "* Menu:\n\n")) (put 'menu 'texinfo-end 'texinfo-discard-command) ;;; Cross references ; @xref {NODE, FNAME, NAME, FILE, DOCUMENT} ; -> *Note FNAME: (FILE)NODE ; If FILE is missing, ; *Note FNAME: NODE ; If FNAME is empty and NAME is present ; *Note NAME: Node ; If both NAME and FNAME are missing ; *Note NODE:: ; texinfo ignores the DOCUMENT argument. ; -> See section [NAME, else NODE], page ; If FILE is specified, (FILE)NODE is used for xrefs. ; If fifth argument DOCUMENT is specified, produces ; See section [NAME, else NODE], page ; of DOCUMENT ; @ref a reference that does not put `See' or `see' in ; the hardcopy and is the same as @xref in Info (put 'ref 'texinfo-format 'texinfo-format-xref) (put 'xref 'texinfo-format 'texinfo-format-xref) (defun texinfo-format-xref () (let ((args (texinfo-format-parse-args))) (texinfo-discard-command) (insert "*Note ") (let ((fname (or (nth 1 args) (nth 2 args)))) (if (null (or fname (nth 3 args))) (insert (car args) "::") (insert (or fname (car args)) ": ") (if (nth 3 args) (insert "(" (nth 3 args) ")")) (insert (car args)))))) (put 'pxref 'texinfo-format 'texinfo-format-pxref) (defun texinfo-format-pxref () (texinfo-format-xref) (or (save-excursion (forward-char -2) (looking-at "::")) (insert "."))) ;@inforef{NODE, FNAME, FILE} ;Like @xref{NODE, FNAME,,FILE} in texinfo. ;In Tex, generates "See Info file FILE, node NODE" (put 'inforef 'texinfo-format 'texinfo-format-inforef) (defun texinfo-format-inforef () (let ((args (texinfo-format-parse-args))) (texinfo-discard-command) (if (nth 1 args) (insert "*Note " (nth 1 args) ": (" (nth 2 args) ")" (car args)) (insert "*Note " "(" (nth 2 args) ")" (car args) "::")))) ;;; Section headings (put 'majorheading 'texinfo-format 'texinfo-format-chapter) (put 'chapheading 'texinfo-format 'texinfo-format-chapter) (put 'ichapter 'texinfo-format 'texinfo-format-chapter) (put 'chapter 'texinfo-format 'texinfo-format-chapter) (put 'iappendix 'texinfo-format 'texinfo-format-chapter) (put 'appendix 'texinfo-format 'texinfo-format-chapter) (put 'iunnumbered 'texinfo-format 'texinfo-format-chapter) (put 'top 'texinfo-format 'texinfo-format-chapter) (put 'unnumbered 'texinfo-format 'texinfo-format-chapter) (defun texinfo-format-chapter () (texinfo-format-chapter-1 ?*)) (put 'heading 'texinfo-format 'texinfo-format-section) (put 'isection 'texinfo-format 'texinfo-format-section) (put 'section 'texinfo-format 'texinfo-format-section) (put 'iappendixsection 'texinfo-format 'texinfo-format-section) (put 'appendixsection 'texinfo-format 'texinfo-format-section) (put 'iappendixsec 'texinfo-format 'texinfo-format-section) (put 'appendixsec 'texinfo-format 'texinfo-format-section) (put 'iunnumberedsec 'texinfo-format 'texinfo-format-section) (put 'unnumberedsec 'texinfo-format 'texinfo-format-section) (defun texinfo-format-section () (texinfo-format-chapter-1 ?=)) (put 'subheading 'texinfo-format 'texinfo-format-subsection) (put 'isubsection 'texinfo-format 'texinfo-format-subsection) (put 'subsection 'texinfo-format 'texinfo-format-subsection) (put 'iappendixsubsec 'texinfo-format 'texinfo-format-subsection) (put 'appendixsubsec 'texinfo-format 'texinfo-format-subsection) (put 'iunnumberedsubsec 'texinfo-format 'texinfo-format-subsection) (put 'unnumberedsubsec 'texinfo-format 'texinfo-format-subsection) (defun texinfo-format-subsection () (texinfo-format-chapter-1 ?-)) (put 'subsubheading 'texinfo-format 'texinfo-format-subsubsection) (put 'isubsubsection 'texinfo-format 'texinfo-format-subsubsection) (put 'subsubsection 'texinfo-format 'texinfo-format-subsubsection) (put 'iappendixsubsubsec 'texinfo-format 'texinfo-format-subsubsection) (put 'appendixsubsubsec 'texinfo-format 'texinfo-format-subsubsection) (put 'iunnumberedsubsubsec 'texinfo-format 'texinfo-format-subsubsection) (put 'unnumberedsubsubsec 'texinfo-format 'texinfo-format-subsubsection) (defun texinfo-format-subsubsection () (texinfo-format-chapter-1 ?.)) (defun texinfo-format-chapter-1 (belowchar) (let ((arg (texinfo-parse-arg-discard))) (message "Formatting: %s ... " arg) ; So we can see where we are. (insert ?\n arg ?\n "@SectionPAD " belowchar ?\n) (forward-line -2))) (put 'SectionPAD 'texinfo-format 'texinfo-format-sectionpad) (defun texinfo-format-sectionpad () (let ((str (texinfo-parse-arg-discard))) (forward-char -1) (let ((column (current-column))) (forward-char 1) (while (> column 0) (insert str) (setq column (1- column)))) (insert ?\n))) ;;; Space controlling commands: @. and @:, and the soft hyphen. (put '\. 'texinfo-format 'texinfo-format-\.) (defun texinfo-format-\. () (texinfo-discard-command) (insert ".")) (put '\: 'texinfo-format 'texinfo-format-\:) (defun texinfo-format-\: () (texinfo-discard-command)) (put '\- 'texinfo-format 'texinfo-format-soft-hyphen) (defun texinfo-format-soft-hyphen () (texinfo-discard-command)) ;;; @center, @sp, and @br (put 'center 'texinfo-format 'texinfo-format-center) (defun texinfo-format-center () (let ((arg (texinfo-parse-expanded-arg))) (texinfo-discard-command) (insert arg) (insert ?\n) (save-restriction (goto-char (1- (point))) (let ((indent-tabs-mode nil)) (center-line))))) (put 'sp 'texinfo-format 'texinfo-format-sp) (defun texinfo-format-sp () (let* ((arg (texinfo-parse-arg-discard)) (num (read arg))) (insert-char ?\n num))) (put 'br 'texinfo-format 'texinfo-format-paragraph-break) (defun texinfo-format-paragraph-break () "Force a paragraph break. If used within a line, follow `@br' with braces." (texinfo-optional-braces-discard) ;; insert one return if at end of line; ;; else insert two returns, to generate a blank line. (if (= (following-char) ?\n) (insert ?\n) (insert-char ?\n 2))) ;;; @footnote and @footnotestyle ; In Texinfo, footnotes are created with the `@footnote' command. ; This command is followed immediately by a left brace, then by the text of ; the footnote, and then by a terminating right brace. The ; template for a footnote is: ; ; @footnote{TEXT} ; ; Info has two footnote styles: ; ; * In the End of node style, all the footnotes for a single node ; are placed at the end of that node. The footnotes are ; separated from the rest of the node by a line of dashes with ; the word `Footnotes' within it. ; ; * In the Separate node style, all the footnotes for a single node ; are placed in an automatically constructed node of their own. ; Footnote style is specified by the @footnotestyle command, either ; @footnotestyle separate ; or ; @footnotestyle end ; ; The default is separate (defvar texinfo-footnote-style "separate" "Footnote style, either separate or end.") (put 'footnotestyle 'texinfo-format 'texinfo-footnotestyle) (defun texinfo-footnotestyle () "Specify whether footnotes are at end of node or in separate nodes. Argument is either end or separate." (setq texinfo-footnote-style (texinfo-parse-arg-discard))) (defvar texinfo-footnote-number) (put 'footnote 'texinfo-format 'texinfo-format-footnote) (defun texinfo-format-footnote () "Format a footnote in either end of node or separate node style. The texinfo-footnote-style variable controls which style is used." (setq texinfo-footnote-number (1+ texinfo-footnote-number)) (cond ((string= texinfo-footnote-style "end") (texinfo-format-end-node)) ((string= texinfo-footnote-style "separate") (texinfo-format-separate-node)))) (defun texinfo-format-separate-node () "Format footnote in Separate node style, with notes in own node. The node is constructed automatically." (let* (start (arg (texinfo-parse-line-arg)) (node-name-beginning (save-excursion (re-search-backward "^File: \\w+\\(\\w\\|\\s_\\|\\.\\|,\\)*[ \t]+Node:") (match-end 0))) (node-name (save-excursion (buffer-substring (progn (goto-char node-name-beginning) ; skip over node command (skip-chars-forward " \t") ; and over spaces (point)) (if (search-forward "," (save-excursion (end-of-line) (point)) t) ; bound search (1- (point)) (end-of-line) (point)))))) (texinfo-discard-command) ; remove or insert whitespace, as needed (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point)) (insert (format " (%d) (*Note %s-Footnotes::)" texinfo-footnote-number node-name)) (fill-paragraph nil) (save-excursion (if (re-search-forward "^@node" nil 'move) (forward-line -1)) ;; two cases: for the first footnote, we must insert a node header; ;; for the second and subsequent footnotes, we need only insert ;; the text of the footnote. (if (save-excursion (re-search-backward (concat node-name "-Footnotes, Up: ") node-name-beginning t)) (progn ; already at least one footnote (setq start (point)) (insert (format "\n(%d) %s\n" texinfo-footnote-number arg)) (fill-region start (point))) ;; else not yet a footnote (insert "\n\^_\nFile: " texinfo-format-filename " Node: " node-name "-Footnotes, Up: " node-name "\n") (setq start (point)) (insert (format "\n(%d) %s\n" texinfo-footnote-number arg)) (fill-region start (point)))))) (defun texinfo-format-end-node () "Format footnote in the End of node style, with notes at end of node." (let (start (arg (texinfo-parse-line-arg))) (texinfo-discard-command) ; remove or insert whitespace, as needed (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point)) (insert (format " (%d) " texinfo-footnote-number)) (fill-paragraph nil) (save-excursion (if (search-forward "\n--------- Footnotes ---------\n" nil t) (progn ; already have footnote, put new one before end of node (if (re-search-forward "^@node" nil 'move) (forward-line -1)) (setq start (point)) (insert (format "\n(%d) %s\n" texinfo-footnote-number arg)) (fill-region start (point))) ;; else no prior footnote (if (re-search-forward "^@node" nil 'move) (forward-line -1)) (insert "\n--------- Footnotes ---------\n") (setq start (point)) (insert (format "\n(%d) %s\n" texinfo-footnote-number arg)))))) ;;; @itemize, @enumerate, and similar commands ;; @itemize pushes (itemize "COMMANDS" STARTPOS) on texinfo-stack. ;; @enumerate pushes (enumerate 0 STARTPOS). ;; @item dispatches to the texinfo-item prop of the first elt of the list. ;; For itemize, this puts in and rescans the COMMANDS. ;; For enumerate, this increments the number and puts it in. ;; In either case, it puts a Backspace at the front of the line ;; which marks it not to be indented later. ;; All other lines get indented by 5 when the @end is reached. (defvar texinfo-stack-depth 0 "Count of number of unpopped texinfo-push-stack calls. Used by @refill indenting command to avoid indenting within lists, etc.") (defun texinfo-push-stack (check arg) (setq texinfo-stack-depth (1+ texinfo-stack-depth)) (setq texinfo-stack (cons (list check arg texinfo-command-start) texinfo-stack))) (defun texinfo-pop-stack (check) (setq texinfo-stack-depth (1- texinfo-stack-depth)) (if (null texinfo-stack) (error "Unmatched @end %s" check)) (if (not (eq (car (car texinfo-stack)) check)) (error "@end %s matches @%s" check (car (car texinfo-stack)))) (prog1 (cdr (car texinfo-stack)) (setq texinfo-stack (cdr texinfo-stack)))) (put 'itemize 'texinfo-format 'texinfo-itemize) (defun texinfo-itemize () (texinfo-push-stack 'itemize (progn (skip-chars-forward " \t") (if (eolp) "@bullet" (texinfo-parse-line-arg)))) (texinfo-discard-line-with-args) (setq fill-column (- fill-column 5))) (put 'itemize 'texinfo-end 'texinfo-end-itemize) (defun texinfo-end-itemize () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'itemize))) (texinfo-do-itemize (nth 1 stacktop)))) (put 'enumerate 'texinfo-format 'texinfo-enumerate) (defun texinfo-enumerate () (texinfo-push-stack 'enumerate (progn (skip-chars-forward " \t") (if (eolp) 1 (read (current-buffer))))) (if (and (symbolp (car (cdr (car texinfo-stack)))) (> 1 (length (symbol-name (car (cdr (car texinfo-stack))))))) (error "@enumerate: Use a number or letter, eg: 1, A, a, 3, B, or d." )) (texinfo-discard-line-with-args) (setq fill-column (- fill-column 5))) (put 'enumerate 'texinfo-end 'texinfo-end-enumerate) (defun texinfo-end-enumerate () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'enumerate))) (texinfo-do-itemize (nth 1 stacktop)))) ;; @alphaenumerate never became a standard part of Texinfo (put 'alphaenumerate 'texinfo-format 'texinfo-alphaenumerate) (defun texinfo-alphaenumerate () (texinfo-push-stack 'alphaenumerate (1- ?a)) (setq fill-column (- fill-column 5)) (texinfo-discard-line)) (put 'alphaenumerate 'texinfo-end 'texinfo-end-alphaenumerate) (defun texinfo-end-alphaenumerate () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'alphaenumerate))) (texinfo-do-itemize (nth 1 stacktop)))) ;; @capsenumerate never became a standard part of Texinfo (put 'capsenumerate 'texinfo-format 'texinfo-capsenumerate) (defun texinfo-capsenumerate () (texinfo-push-stack 'capsenumerate (1- ?A)) (setq fill-column (- fill-column 5)) (texinfo-discard-line)) (put 'capsenumerate 'texinfo-end 'texinfo-end-capsenumerate) (defun texinfo-end-capsenumerate () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'capsenumerate))) (texinfo-do-itemize (nth 1 stacktop)))) ;; At the @end, indent all the lines within the construct ;; except those marked with backspace. FROM says where ;; construct started. (defun texinfo-do-itemize (from) (save-excursion (while (progn (forward-line -1) (>= (point) from)) (if (= (following-char) ?\b) (save-excursion (delete-char 1) (end-of-line) (delete-char 6)) (if (not (looking-at "[ \t]*$")) (save-excursion (insert " "))))))) (put 'item 'texinfo-format 'texinfo-item) (put 'itemx 'texinfo-format 'texinfo-item) (defun texinfo-item () (funcall (get (car (car texinfo-stack)) 'texinfo-item))) (put 'itemize 'texinfo-item 'texinfo-itemize-item) (defun texinfo-itemize-item () ;; (texinfo-discard-line) ; Did not handle text on same line as @item. (delete-region (1+ (point)) (save-excursion (beginning-of-line) (point))) (if (looking-at "[ \t]*[^ \t\n]+") ;; Text on same line as @item command. (insert "\b " (nth 1 (car texinfo-stack)) " \n") ;; Else text on next line. (insert "\b " (nth 1 (car texinfo-stack)) " ")) (forward-line -1)) (put 'enumerate 'texinfo-item 'texinfo-enumerate-item) (defun texinfo-enumerate-item () (texinfo-discard-line) (let (enumerating-symbol) (cond ((integerp (car (cdr (car texinfo-stack)))) (setq enumerating-symbol (car (cdr (car texinfo-stack)))) (insert ?\b (format "%3d. " enumerating-symbol) ?\n) (setcar (cdr (car texinfo-stack)) (1+ enumerating-symbol))) ((symbolp (car (cdr (car texinfo-stack)))) (setq enumerating-symbol (symbol-name (car (cdr (car texinfo-stack))))) (if (or (equal ?\[ (string-to-char enumerating-symbol)) (equal ?\{ (string-to-char enumerating-symbol))) (error "Too many items in enumerated list; alphabet ends at Z.")) (insert ?\b (format "%3s. " enumerating-symbol) ?\n) (setcar (cdr (car texinfo-stack)) (make-symbol (char-to-string (1+ (string-to-char enumerating-symbol)))))) (t (error "@enumerate: Use a number or letter, eg: 1, A, a, 3, B or d." ))) (forward-line -1))) (put 'alphaenumerate 'texinfo-item 'texinfo-alphaenumerate-item) (defun texinfo-alphaenumerate-item () (texinfo-discard-line) (let ((next (1+ (car (cdr (car texinfo-stack)))))) (if (> next ?z) (error "More than 26 items in @alphaenumerate; get a bigger alphabet.")) (setcar (cdr (car texinfo-stack)) next) (insert "\b " next ". \n")) (forward-line -1)) (put 'capsenumerate 'texinfo-item 'texinfo-capsenumerate-item) (defun texinfo-capsenumerate-item () (texinfo-discard-line) (let ((next (1+ (car (cdr (car texinfo-stack)))))) (if (> next ?Z) (error "More than 26 items in @capsenumerate; get a bigger alphabet.")) (setcar (cdr (car texinfo-stack)) next) (insert "\b " next ". \n")) (forward-line -1)) ;;; @table ; The `@table' command produces two-column tables. (put 'table 'texinfo-format 'texinfo-table) (defun texinfo-table () (texinfo-push-stack 'table (progn (skip-chars-forward " \t") (if (eolp) "@asis" (texinfo-parse-line-arg)))) (texinfo-discard-line-with-args) (setq fill-column (- fill-column 5))) (put 'table 'texinfo-item 'texinfo-table-item) (defun texinfo-table-item () (let ((arg (texinfo-parse-arg-discard)) (itemfont (car (cdr (car texinfo-stack))))) (insert ?\b itemfont ?\{ arg "}\n \n")) (forward-line -2)) (put 'table 'texinfo-end 'texinfo-end-table) (defun texinfo-end-table () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'table))) (texinfo-do-itemize (nth 1 stacktop)))) ;; @description appears to be an undocumented variant on @table that ;; does not require an arg. It fails in texinfo.tex 2.58 and is not ;; part of makeinfo.c The command appears to be a relic of the past. (put 'description 'texinfo-end 'texinfo-end-table) (put 'description 'texinfo-format 'texinfo-description) (defun texinfo-description () (texinfo-push-stack 'table "@asis") (setq fill-column (- fill-column 5)) (texinfo-discard-line)) ;;; @ftable, @vtable ; The `@ftable' and `@vtable' commands are like the `@table' command ; but they also insert each entry in the first column of the table ; into the function or variable index. ;; Handle the @ftable and @vtable commands: (put 'ftable 'texinfo-format 'texinfo-ftable) (put 'vtable 'texinfo-format 'texinfo-vtable) (defun texinfo-ftable () (texinfo-indextable 'ftable)) (defun texinfo-vtable () (texinfo-indextable 'vtable)) (defun texinfo-indextable (table-type) (texinfo-push-stack table-type (texinfo-parse-arg-discard)) (setq fill-column (- fill-column 5))) ;; Handle the @item commands within ftable and vtable: (put 'ftable 'texinfo-item 'texinfo-ftable-item) (put 'vtable 'texinfo-item 'texinfo-vtable-item) (defun texinfo-ftable-item () (texinfo-indextable-item 'texinfo-findex)) (defun texinfo-vtable-item () (texinfo-indextable-item 'texinfo-vindex)) (defun texinfo-indextable-item (index-type) (let ((item (texinfo-parse-arg-discard)) (itemfont (car (cdr (car texinfo-stack)))) (indexvar index-type)) (insert ?\b itemfont ?\{ item "}\n \n") (set indexvar (cons (list item texinfo-last-node) (symbol-value indexvar))) (forward-line -2))) ;; Handle @end ftable, @end vtable (put 'ftable 'texinfo-end 'texinfo-end-ftable) (put 'vtable 'texinfo-end 'texinfo-end-vtable) (defun texinfo-end-ftable () (texinfo-end-indextable 'ftable)) (defun texinfo-end-vtable () (texinfo-end-indextable 'vtable)) (defun texinfo-end-indextable (table-type) (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack table-type))) (texinfo-do-itemize (nth 1 stacktop)))) ;;; @ifinfo, @iftex, @tex, @ifhtml, @html (put 'ifinfo 'texinfo-format 'texinfo-discard-line) (put 'ifinfo 'texinfo-end 'texinfo-discard-command) (put 'iftex 'texinfo-format 'texinfo-format-iftex) (defun texinfo-format-iftex () (delete-region texinfo-command-start (progn (re-search-forward "@end iftex[ \t]*\n") (point)))) (put 'ifhtml 'texinfo-format 'texinfo-format-ifhtml) (defun texinfo-format-ifhtml () (delete-region texinfo-command-start (progn (re-search-forward "@end ifhtml[ \t]*\n") (point)))) (put 'tex 'texinfo-format 'texinfo-format-tex) (defun texinfo-format-tex () (delete-region texinfo-command-start (progn (re-search-forward "@end tex[ \t]*\n") (point)))) (put 'html 'texinfo-format 'texinfo-format-html) (defun texinfo-format-html () (delete-region texinfo-command-start (progn (re-search-forward "@end html[ \t]*\n") (point)))) ;;; @titlepage (put 'titlepage 'texinfo-format 'texinfo-format-titlepage) (defun texinfo-format-titlepage () (delete-region texinfo-command-start (progn (re-search-forward "@end titlepage[ \t]*\n") (point)))) (put 'endtitlepage 'texinfo-format 'texinfo-discard-line) ; @titlespec an alternative titling command; ignored by Info (put 'titlespec 'texinfo-format 'texinfo-format-titlespec) (defun texinfo-format-titlespec () (delete-region texinfo-command-start (progn (re-search-forward "@end titlespec[ \t]*\n") (point)))) (put 'endtitlespec 'texinfo-format 'texinfo-discard-line) ;;; @today (put 'today 'texinfo-format 'texinfo-format-today) ; Produces Day Month Year style of output. eg `1 Jan 1900' ; The `@today{}' command requires a pair of braces, like `@dots{}'. (defun texinfo-format-today () (texinfo-parse-arg-discard) (insert (format "%s %s %s" (substring (current-time-string) 8 10) (substring (current-time-string) 4 7) (substring (current-time-string) -4)))) ;;; @ignore (put 'ignore 'texinfo-format 'texinfo-format-ignore) (defun texinfo-format-ignore () (delete-region texinfo-command-start (progn (re-search-forward "@end ignore[ \t]*\n") (point)))) (put 'endignore 'texinfo-format 'texinfo-discard-line) ;;; Define the Info enclosure command: @definfoenclose ; A `@definfoenclose' command may be used to define a highlighting ; command for Info, but not for TeX. A command defined using ; `@definfoenclose' marks text by enclosing it in strings that precede ; and follow the text. ; ; Presumably, if you define a command with `@definfoenclose` for Info, ; you will also define the same command in the TeX definitions file, ; `texinfo.tex' in a manner appropriate for typesetting. ; ; Write a `@definfoenclose' command on a line and follow it with three ; arguments separated by commas (commas are used as separators in an ; `@node' line in the same way). The first argument to ; `@definfoenclose' is the @-command name \(without the `@'\); the ; second argument is the Info start delimiter string; and the third ; argument is the Info end delimiter string. The latter two arguments ; enclose the highlighted text in the Info file. A delimiter string ; may contain spaces. Neither the start nor end delimiter is ; required. However, if you do not provide a start delimiter, you ; must follow the command name with two commas in a row; otherwise, ; the Info formatting commands will misinterpret the end delimiter ; string as a start delimiter string. ; ; If you do a @definfoenclose{} on the name of a pre-defined macro (such ; as @emph{}, @strong{}, @tt{}, or @i{}) the enclosure definition will ; override the built-in definition. ; ; An enclosure command defined this way takes one argument in braces. ; ; For example, you can write: ; ; @ifinfo ; @definfoenclose phoo, //, \\ ; @end ifinfo ; ; near the beginning of a Texinfo file at the beginning of the lines ; to define `@phoo' as an Info formatting command that inserts `//' ; before and `\\' after the argument to `@phoo'. You can then write ; `@phoo{bar}' wherever you want `//bar\\' highlighted in Info. ; ; Also, for TeX formatting, you could write ; ; @iftex ; @global@let@phoo=@i ; @end iftex ; ; to define `@phoo' as a command that causes TeX to typeset ; the argument to `@phoo' in italics. ; ; Note that each definition applies to its own formatter: one for TeX, ; the other for texinfo-format-buffer or texinfo-format-region. ; ; Here is another example: write ; ; @definfoenclose headword, , : ; ; near the beginning of the file, to define `@headword' as an Info ; formatting command that inserts nothing before and a colon after the ; argument to `@headword'. (put 'definfoenclose 'texinfo-format 'texinfo-define-info-enclosure) (defun texinfo-define-info-enclosure () (let* ((args (texinfo-format-parse-line-args)) (command-name (nth 0 args)) (beginning-delimiter (or (nth 1 args) "")) (end-delimiter (or (nth 2 args) ""))) (texinfo-discard-command) (setq texinfo-enclosure-list (cons (list command-name (list beginning-delimiter end-delimiter)) texinfo-enclosure-list)))) ;;; @var, @code and the like (put 'var 'texinfo-format 'texinfo-format-var) ; @sc a small caps font for TeX; formatted as `var' in Info (put 'sc 'texinfo-format 'texinfo-format-var) (defun texinfo-format-var () (insert (upcase (texinfo-parse-arg-discard))) (goto-char texinfo-command-start)) ; various noops (put 'b 'texinfo-format 'texinfo-format-noop) (put 'i 'texinfo-format 'texinfo-format-noop) (put 'r 'texinfo-format 'texinfo-format-noop) (put 't 'texinfo-format 'texinfo-format-noop) (put 'w 'texinfo-format 'texinfo-format-noop) (put 'asis 'texinfo-format 'texinfo-format-noop) (put 'dmn 'texinfo-format 'texinfo-format-noop) (put 'key 'texinfo-format 'texinfo-format-noop) (put 'math 'texinfo-format 'texinfo-format-noop) (put 'titlefont 'texinfo-format 'texinfo-format-noop) (defun texinfo-format-noop () (insert (texinfo-parse-arg-discard)) (goto-char texinfo-command-start)) (put 'cite 'texinfo-format 'texinfo-format-code) (put 'code 'texinfo-format 'texinfo-format-code) (put 'file 'texinfo-format 'texinfo-format-code) (put 'kbd 'texinfo-format 'texinfo-format-code) (put 'samp 'texinfo-format 'texinfo-format-code) (defun texinfo-format-code () (insert "`" (texinfo-parse-arg-discard) "'") (goto-char texinfo-command-start)) (put 'emph 'texinfo-format 'texinfo-format-emph) (put 'strong 'texinfo-format 'texinfo-format-emph) (defun texinfo-format-emph () (insert "*" (texinfo-parse-arg-discard) "*") (goto-char texinfo-command-start)) (put 'dfn 'texinfo-format 'texinfo-format-defn) (put 'defn 'texinfo-format 'texinfo-format-defn) (defun texinfo-format-defn () (insert "\"" (texinfo-parse-arg-discard) "\"") (goto-char texinfo-command-start)) (put 'bullet 'texinfo-format 'texinfo-format-bullet) (defun texinfo-format-bullet () "Insert an asterisk. If used within a line, follow `@bullet' with braces." (texinfo-optional-braces-discard) (insert "*")) ;;; @example, @lisp, @quotation, @display, @smalllisp, @smallexample (put 'display 'texinfo-format 'texinfo-format-example) (put 'example 'texinfo-format 'texinfo-format-example) (put 'lisp 'texinfo-format 'texinfo-format-example) (put 'quotation 'texinfo-format 'texinfo-format-example) (put 'smallexample 'texinfo-format 'texinfo-format-example) (put 'smalllisp 'texinfo-format 'texinfo-format-example) (defun texinfo-format-example () (texinfo-push-stack 'example nil) (setq fill-column (- fill-column 5)) (texinfo-discard-line)) (put 'example 'texinfo-end 'texinfo-end-example) (put 'display 'texinfo-end 'texinfo-end-example) (put 'lisp 'texinfo-end 'texinfo-end-example) (put 'quotation 'texinfo-end 'texinfo-end-example) (put 'smallexample 'texinfo-end 'texinfo-end-example) (put 'smalllisp 'texinfo-end 'texinfo-end-example) (defun texinfo-end-example () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'example))) (texinfo-do-itemize (nth 1 stacktop)))) (put 'exdent 'texinfo-format 'texinfo-format-exdent) (defun texinfo-format-exdent () (texinfo-discard-command) (delete-region (point) (progn (skip-chars-forward " ") (point))) (insert ?\b) ;; Cancel out the deletion that texinfo-do-itemize ;; is going to do at the end of this line. (save-excursion (end-of-line) (insert "\n "))) ;;; @cartouche ; The @cartouche command is a noop in Info; in a printed manual, ; it makes a box with rounded corners. (put 'cartouche 'texinfo-format 'texinfo-discard-line) (put 'cartouche 'texinfo-end 'texinfo-discard-command) ;;; @flushleft and @format ; The @flushleft command left justifies every line but leaves the ; right end ragged. As far as Info is concerned, @flushleft is a ; `do-nothing' command ; The @format command is similar to @example except that it does not ; indent; this means that in Info, @format is similar to @flushleft. (put 'format 'texinfo-format 'texinfo-format-flushleft) (put 'flushleft 'texinfo-format 'texinfo-format-flushleft) (defun texinfo-format-flushleft () (texinfo-discard-line)) (put 'format 'texinfo-end 'texinfo-end-flushleft) (put 'flushleft 'texinfo-end 'texinfo-end-flushleft) (defun texinfo-end-flushleft () (texinfo-discard-command)) ;;; @flushright ; The @flushright command right justifies every line but leaves the ; left end ragged. Spaces and tabs at the right ends of lines are ; removed so that visible text lines up on the right side. (put 'flushright 'texinfo-format 'texinfo-format-flushright) (defun texinfo-format-flushright () (texinfo-push-stack 'flushright nil) (texinfo-discard-line)) (put 'flushright 'texinfo-end 'texinfo-end-flushright) (defun texinfo-end-flushright () (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'flushright))) (texinfo-do-flushright (nth 1 stacktop)))) (defun texinfo-do-flushright (from) (save-excursion (while (progn (forward-line -1) (>= (point) from)) (beginning-of-line) (insert (make-string (- fill-column (save-excursion (end-of-line) (skip-chars-backward " \t") (delete-region (point) (progn (end-of-line) (point))) (current-column))) ? ))))) ;;; @ctrl, @TeX, @copyright, @minus, @dots (put 'ctrl 'texinfo-format 'texinfo-format-ctrl) (defun texinfo-format-ctrl () (let ((str (texinfo-parse-arg-discard))) (insert (logand 31 (aref str 0))))) (put 'TeX 'texinfo-format 'texinfo-format-TeX) (defun texinfo-format-TeX () (texinfo-parse-arg-discard) (insert "TeX")) (put 'copyright 'texinfo-format 'texinfo-format-copyright) (defun texinfo-format-copyright () (texinfo-parse-arg-discard) (insert "(C)")) (put 'minus 'texinfo-format 'texinfo-format-minus) (defun texinfo-format-minus () "Insert a minus sign. If used within a line, follow `@minus' with braces." (texinfo-optional-braces-discard) (insert "-")) (put 'dots 'texinfo-format 'texinfo-format-dots) (defun texinfo-format-dots () (texinfo-parse-arg-discard) (insert "...")) (put 'enddots 'texinfo-format 'texinfo-format-enddots) (defun texinfo-format-enddots () (texinfo-parse-arg-discard) (insert "....")) ;;; Refilling and indenting: @refill, @paragraphindent, @noindent ;;; Indent only those paragraphs that are refilled as a result of an ;;; @refill command. ; * If the value is `asis', do not change the existing indentation at ; the starts of paragraphs. ; * If the value zero, delete any existing indentation. ; * If the value is greater than zero, indent each paragraph by that ; number of spaces. ;;; But do not refill paragraphs with an @refill command that are ;;; preceded by @noindent or are part of a table, list, or deffn. (defvar texinfo-paragraph-indent "asis" "Number of spaces for @refill to indent a paragraph; else to leave as is.") (put 'paragraphindent 'texinfo-format 'texinfo-paragraphindent) (defun texinfo-paragraphindent () "Specify the number of spaces for @refill to indent a paragraph. Default is to leave the number of spaces as is." (let ((arg (texinfo-parse-arg-discard))) (if (string= "asis" arg) (setq texinfo-paragraph-indent "asis") (setq texinfo-paragraph-indent (string-to-int arg))))) (put 'refill 'texinfo-format 'texinfo-format-refill) (defun texinfo-format-refill () "Refill paragraph. Also, indent first line as set by @paragraphindent. Default is to leave paragraph indentation as is." (texinfo-discard-command) (forward-paragraph -1) (if (looking-at "[ \t\n]*$") (forward-line 1)) ;; Do not indent if an entry in a list, table, or deffn, ;; or if paragraph is preceded by @noindent. ;; Otherwise, indent (cond ;; delete a @noindent line and do not indent paragraph ((save-excursion (forward-line -1) (looking-at "^@noindent")) (forward-line -1) (delete-region (point) (progn (forward-line 1) (point)))) ;; do nothing if "asis" ((equal texinfo-paragraph-indent "asis")) ;; do no indenting in list, etc. ((> texinfo-stack-depth 0)) ;; otherwise delete existing whitespace and indent (t (delete-region (point) (progn (skip-chars-forward " \t") (point))) (insert (make-string texinfo-paragraph-indent ? )))) (forward-paragraph 1) (forward-line -1) (end-of-line) ;; Do not fill a section title line with asterisks, hyphens, etc. that ;; are used to underline it. This could occur if the line following ;; the underlining is not an index entry and has text within it. (let* ((previous-paragraph-separate paragraph-separate) (paragraph-separate (concat paragraph-separate "\\|[-=*.]+")) (previous-paragraph-start paragraph-start) (paragraph-start (concat paragraph-start "\\|[-=*.]+"))) (unwind-protect (fill-paragraph nil) (setq paragraph-separate previous-paragraph-separate) (setq paragraph-start previous-paragraph-start)))) (put 'noindent 'texinfo-format 'texinfo-noindent) (defun texinfo-noindent () (save-excursion (forward-paragraph 1) (if (search-backward "@refill" (save-excursion (forward-line -1) (point)) t) () ; leave @noindent command so @refill command knows not to indent ;; else (texinfo-discard-line)))) ;;; Index generation (put 'vindex 'texinfo-format 'texinfo-format-vindex) (defun texinfo-format-vindex () (texinfo-index 'texinfo-vindex)) (put 'cindex 'texinfo-format 'texinfo-format-cindex) (defun texinfo-format-cindex () (texinfo-index 'texinfo-cindex)) (put 'findex 'texinfo-format 'texinfo-format-findex) (defun texinfo-format-findex () (texinfo-index 'texinfo-findex)) (put 'pindex 'texinfo-format 'texinfo-format-pindex) (defun texinfo-format-pindex () (texinfo-index 'texinfo-pindex)) (put 'tindex 'texinfo-format 'texinfo-format-tindex) (defun texinfo-format-tindex () (texinfo-index 'texinfo-tindex)) (put 'kindex 'texinfo-format 'texinfo-format-kindex) (defun texinfo-format-kindex () (texinfo-index 'texinfo-kindex)) (defun texinfo-index (indexvar) (let ((arg (texinfo-parse-expanded-arg))) (texinfo-discard-command) (set indexvar (cons (list arg texinfo-last-node ;; Region formatting may not provide last node position. (if texinfo-last-node-pos (1+ (count-lines texinfo-last-node-pos (point))) 1)) (symbol-value indexvar))))) (defconst texinfo-indexvar-alist '(("cp" . texinfo-cindex) ("fn" . texinfo-findex) ("vr" . texinfo-vindex) ("tp" . texinfo-tindex) ("pg" . texinfo-pindex) ("ky" . texinfo-kindex))) ;;; @defindex @defcodeindex (put 'defindex 'texinfo-format 'texinfo-format-defindex) (put 'defcodeindex 'texinfo-format 'texinfo-format-defindex) (defun texinfo-format-defindex () (let* ((index-name (texinfo-parse-arg-discard)) ; eg: `aa' (indexing-command (intern (concat index-name "index"))) (index-formatting-command ; eg: `texinfo-format-aaindex' (intern (concat "texinfo-format-" index-name "index"))) (index-alist-name ; eg: `texinfo-aaindex' (intern (concat "texinfo-" index-name "index")))) (set index-alist-name nil) (put indexing-command ; eg, aaindex 'texinfo-format index-formatting-command) ; eg, texinfo-format-aaindex ;; eg: "aa" . texinfo-aaindex (or (assoc index-name texinfo-indexvar-alist) (setq texinfo-indexvar-alist (cons (cons index-name index-alist-name) texinfo-indexvar-alist))) (fset index-formatting-command (list 'lambda 'nil (list 'texinfo-index (list 'quote index-alist-name)))))) ;;; @synindex @syncodeindex (put 'synindex 'texinfo-format 'texinfo-format-synindex) (put 'syncodeindex 'texinfo-format 'texinfo-format-synindex) (defun texinfo-format-synindex () (let* ((args (texinfo-parse-arg-discard)) (second (cdr (read-from-string args))) (joiner (symbol-name (car (read-from-string args)))) (joined (symbol-name (car (read-from-string args second))))) (if (assoc joiner texinfo-short-index-cmds-alist) (put (cdr (assoc joiner texinfo-short-index-cmds-alist)) 'texinfo-format (or (cdr (assoc joined texinfo-short-index-format-cmds-alist)) (intern (concat "texinfo-format-" joined "index")))) (put (intern (concat joiner "index")) 'texinfo-format (or (cdr(assoc joined texinfo-short-index-format-cmds-alist)) (intern (concat "texinfo-format-" joined "index"))))))) (defconst texinfo-short-index-cmds-alist '(("cp" . cindex) ("fn" . findex) ("vr" . vindex) ("tp" . tindex) ("pg" . pindex) ("ky" . kindex))) (defconst texinfo-short-index-format-cmds-alist '(("cp" . texinfo-format-cindex) ("fn" . texinfo-format-findex) ("vr" . texinfo-format-vindex) ("tp" . texinfo-format-tindex) ("pg" . texinfo-format-pindex) ("ky" . texinfo-format-kindex))) ;;; Sort and index (for VMS) ;; Sort an index which is in the current buffer between START and END. ;; Used on VMS, where the `sort' utility is not available. (defun texinfo-sort-region (start end) (require 'sort) (save-restriction (narrow-to-region start end) (sort-subr nil 'forward-line 'end-of-line 'texinfo-sort-startkeyfun))) ;; Subroutine for sorting an index. ;; At start of a line, return a string to sort the line under. (defun texinfo-sort-startkeyfun () (let ((line (buffer-substring (point) (save-excursion (end-of-line) (point))))) ;; Canonicalize whitespace and eliminate funny chars. (while (string-match "[ \t][ \t]+\\|[^a-z0-9 ]+" line) (setq line (concat (substring line 0 (match-beginning 0)) " " (substring line (match-end 0) (length line))))) line)) ;;; @printindex (put 'printindex 'texinfo-format 'texinfo-format-printindex) (defun texinfo-format-printindex () (let ((indexelts (symbol-value (cdr (assoc (texinfo-parse-arg-discard) texinfo-indexvar-alist)))) opoint) (insert "\n* Menu:\n\n") (setq opoint (point)) (texinfo-print-index nil indexelts) (if (eq system-type 'vax-vms) (texinfo-sort-region opoint (point)) (shell-command-on-region opoint (point) "sort -fd" 1)))) (defun texinfo-print-index (file indexelts) (while indexelts (if (stringp (car (car indexelts))) (progn (insert "* " (car (car indexelts)) ": " ) (indent-to 32) (insert (if file (concat "(" file ")") "") (nth 1 (car indexelts)) ".") (indent-to 54) (insert (if (nth 2 (car indexelts)) (format " %d." (nth 2 (car indexelts))) "") "\n")) ;; index entries from @include'd file (texinfo-print-index (nth 1 (car indexelts)) (nth 2 (car indexelts)))) (setq indexelts (cdr indexelts)))) ;;; Glyphs: @equiv, @error, etc ;; @equiv to show that two expressions are equivalent ;; @error to show an error message ;; @expansion to show what a macro expands to ;; @point to show the location of point in an example ;; @print to show what an evaluated expression prints ;; @result to indicate the value returned by an expression (put 'equiv 'texinfo-format 'texinfo-format-equiv) (defun texinfo-format-equiv () (texinfo-parse-arg-discard) (insert "==")) (put 'error 'texinfo-format 'texinfo-format-error) (defun texinfo-format-error () (texinfo-parse-arg-discard) (insert "error-->")) (put 'expansion 'texinfo-format 'texinfo-format-expansion) (defun texinfo-format-expansion () (texinfo-parse-arg-discard) (insert "==>")) (put 'point 'texinfo-format 'texinfo-format-point) (defun texinfo-format-point () (texinfo-parse-arg-discard) (insert "-!-")) (put 'print 'texinfo-format 'texinfo-format-print) (defun texinfo-format-print () (texinfo-parse-arg-discard) (insert "-|")) (put 'result 'texinfo-format 'texinfo-format-result) (defun texinfo-format-result () (texinfo-parse-arg-discard) (insert "=>")) ;;; Definition formatting: @deffn, @defun, etc ;; What definition formatting produces: ;; ;; @deffn category name args... ;; In Info, `Category: name ARGS' ;; In index: name: node. line#. ;; ;; @defvr category name ;; In Info, `Category: name' ;; In index: name: node. line#. ;; ;; @deftp category name attributes... ;; `category name attributes...' Note: @deftp args in lower case. ;; In index: name: node. line#. ;; ;; Specialized function-like or variable-like entity: ;; ;; @defun, @defmac, @defspec, @defvar, @defopt ;; ;; @defun name args In Info, `Function: name ARGS' ;; @defmac name args In Info, `Macro: name ARGS' ;; @defvar name In Info, `Variable: name' ;; etc. ;; In index: name: node. line#. ;; ;; Generalized typed-function-like or typed-variable-like entity: ;; @deftypefn category data-type name args... ;; In Info, `Category: data-type name args...' ;; @deftypevr category data-type name ;; In Info, `Category: data-type name' ;; In index: name: node. line#. ;; ;; Specialized typed-function-like or typed-variable-like entity: ;; @deftypefun data-type name args... ;; In Info, `Function: data-type name ARGS' ;; In index: name: node. line#. ;; ;; @deftypevar data-type name ;; In Info, `Variable: data-type name' ;; In index: name: node. line#. but include args after name!? ;; ;; Generalized object oriented entity: ;; @defop category class name args... ;; In Info, `Category on class: name ARG' ;; In index: name on class: node. line#. ;; ;; @defcv category class name ;; In Info, `Category of class: name' ;; In index: name of class: node. line#. ;; ;; Specialized object oriented entity: ;; @defmethod class name args... ;; In Info, `Method on class: name ARGS' ;; In index: name on class: node. line#. ;; ;; @defivar class name ;; In Info, `Instance variable of class: name' ;; In index: name of class: node. line#. ;;; The definition formatting functions (defun texinfo-format-defun () (texinfo-push-stack 'defun nil) (setq fill-column (- fill-column 5)) (texinfo-format-defun-1 t)) (defun texinfo-end-defun () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((start (nth 1 (texinfo-pop-stack 'defun)))) (texinfo-do-itemize start) ;; Delete extra newline inserted after header. (save-excursion (goto-char start) (delete-char -1)))) (defun texinfo-format-defunx () (texinfo-format-defun-1 nil)) (defun texinfo-format-defun-1 (first-p) (let ((parse-args (texinfo-format-parse-defun-args)) (texinfo-defun-type (get texinfo-command-name 'texinfo-defun-type))) (texinfo-discard-command) ;; Delete extra newline inserted after previous header line. (if (not first-p) (delete-char -1)) (funcall (get texinfo-command-name 'texinfo-deffn-formatting-property) parse-args) ;; Insert extra newline so that paragraph filling does not mess ;; with header line. (insert "\n\n") (rplaca (cdr (cdr (car texinfo-stack))) (point)) (funcall (get texinfo-command-name 'texinfo-defun-indexing-property) parse-args))) ;;; Formatting the first line of a definition ;; @deffn, @defvr, @deftp (put 'deffn 'texinfo-deffn-formatting-property 'texinfo-format-deffn) (put 'deffnx 'texinfo-deffn-formatting-property 'texinfo-format-deffn) (put 'defvr 'texinfo-deffn-formatting-property 'texinfo-format-deffn) (put 'defvrx 'texinfo-deffn-formatting-property 'texinfo-format-deffn) (put 'deftp 'texinfo-deffn-formatting-property 'texinfo-format-deffn) (put 'deftpx 'texinfo-deffn-formatting-property 'texinfo-format-deffn) (defun texinfo-format-deffn (parsed-args) ;; Generalized function-like, variable-like, or generic data-type entity: ;; @deffn category name args... ;; In Info, `Category: name ARGS' ;; @deftp category name attributes... ;; `category name attributes...' Note: @deftp args in lower case. (let ((category (car parsed-args)) (name (car (cdr parsed-args))) (args (cdr (cdr parsed-args)))) (insert " -- " category ": " name) (while args (insert " " (if (or (= ?& (aref (car args) 0)) (eq (eval (car texinfo-defun-type)) 'deftp-type)) (car args) (upcase (car args)))) (setq args (cdr args))))) ;; @defun, @defmac, @defspec, @defvar, @defopt: Specialized, simple (put 'defun 'texinfo-deffn-formatting-property 'texinfo-format-specialized-defun) (put 'defunx 'texinfo-deffn-formatting-property 'texinfo-format-specialized-defun) (put 'defmac 'texinfo-deffn-formatting-property 'texinfo-format-specialized-defun) (put 'defmacx 'texinfo-deffn-formatting-property 'texinfo-format-specialized-defun) (put 'defspec 'texinfo-deffn-formatting-property 'texinfo-format-specialized-defun) (put 'defspecx 'texinfo-deffn-formatting-property 'texinfo-format-specialized-defun) (put 'defvar 'texinfo-deffn-formatting-property 'texinfo-format-specialized-defun) (put 'defvarx 'texinfo-deffn-formatting-property 'texinfo-format-specialized-defun) (put 'defopt 'texinfo-deffn-formatting-property 'texinfo-format-specialized-defun) (put 'defoptx 'texinfo-deffn-formatting-property 'texinfo-format-specialized-defun) (defun texinfo-format-specialized-defun (parsed-args) ;; Specialized function-like or variable-like entity: ;; @defun name args In Info, `Function: Name ARGS' ;; @defmac name args In Info, `Macro: Name ARGS' ;; @defvar name In Info, `Variable: Name' ;; Use cdr of texinfo-defun-type to determine category: (let ((category (car (cdr texinfo-defun-type))) (name (car parsed-args)) (args (cdr parsed-args))) (insert " -- " category ": " name) (while args (insert " " (if (= ?& (aref (car args) 0)) (car args) (upcase (car args)))) (setq args (cdr args))))) ;; @deftypefn, @deftypevr: Generalized typed (put 'deftypefn 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn) (put 'deftypefnx 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn) (put 'deftypevr 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn) (put 'deftypevrx 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn) (defun texinfo-format-deftypefn (parsed-args) ;; Generalized typed-function-like or typed-variable-like entity: ;; @deftypefn category data-type name args... ;; In Info, `Category: data-type name args...' ;; @deftypevr category data-type name ;; In Info, `Category: data-type name' ;; Note: args in lower case, unless modified in command line. (let ((category (car parsed-args)) (data-type (car (cdr parsed-args))) (name (car (cdr (cdr parsed-args)))) (args (cdr (cdr (cdr parsed-args))))) (insert " -- " category ": " data-type " " name) (while args (insert " " (car args)) (setq args (cdr args))))) ;; @deftypefun, @deftypevar: Specialized typed (put 'deftypefun 'texinfo-deffn-formatting-property 'texinfo-format-deftypefun) (put 'deftypefunx 'texinfo-deffn-formatting-property 'texinfo-format-deftypefun) (put 'deftypevar 'texinfo-deffn-formatting-property 'texinfo-format-deftypefun) (put 'deftypevarx 'texinfo-deffn-formatting-property 'texinfo-format-deftypefun) (defun texinfo-format-deftypefun (parsed-args) ;; Specialized typed-function-like or typed-variable-like entity: ;; @deftypefun data-type name args... ;; In Info, `Function: data-type name ARGS' ;; @deftypevar data-type name ;; In Info, `Variable: data-type name' ;; Note: args in lower case, unless modified in command line. ;; Use cdr of texinfo-defun-type to determine category: (let ((category (car (cdr texinfo-defun-type))) (data-type (car parsed-args)) (name (car (cdr parsed-args))) (args (cdr (cdr parsed-args)))) (insert " -- " category ": " data-type " " name) (while args (insert " " (car args)) (setq args (cdr args))))) ;; @defop: Generalized object-oriented (put 'defop 'texinfo-deffn-formatting-property 'texinfo-format-defop) (put 'defopx 'texinfo-deffn-formatting-property 'texinfo-format-defop) (defun texinfo-format-defop (parsed-args) ;; Generalized object oriented entity: ;; @defop category class name args... ;; In Info, `Category on class: name ARG' ;; Note: args in upper case; use of `on' (let ((category (car parsed-args)) (class (car (cdr parsed-args))) (name (car (cdr (cdr parsed-args)))) (args (cdr (cdr (cdr parsed-args))))) (insert " -- " category " on " class ": " name) (while args (insert " " (upcase (car args))) (setq args (cdr args))))) ;; @defcv: Generalized object-oriented (put 'defcv 'texinfo-deffn-formatting-property 'texinfo-format-defcv) (put 'defcvx 'texinfo-deffn-formatting-property 'texinfo-format-defcv) (defun texinfo-format-defcv (parsed-args) ;; Generalized object oriented entity: ;; @defcv category class name ;; In Info, `Category of class: name' ;; Note: args in upper case; use of `of' (let ((category (car parsed-args)) (class (car (cdr parsed-args))) (name (car (cdr (cdr parsed-args)))) (args (cdr (cdr (cdr parsed-args))))) (insert " -- " category " of " class ": " name) (while args (insert " " (upcase (car args))) (setq args (cdr args))))) ;; @defmethod: Specialized object-oriented (put 'defmethod 'texinfo-deffn-formatting-property 'texinfo-format-defmethod) (put 'defmethodx 'texinfo-deffn-formatting-property 'texinfo-format-defmethod) (defun texinfo-format-defmethod (parsed-args) ;; Specialized object oriented entity: ;; @defmethod class name args... ;; In Info, `Method on class: name ARGS' ;; Note: args in upper case; use of `on' ;; Use cdr of texinfo-defun-type to determine category: (let ((category (car (cdr texinfo-defun-type))) (class (car parsed-args)) (name (car (cdr parsed-args))) (args (cdr (cdr parsed-args)))) (insert " -- " category " on " class ": " name) (while args (insert " " (upcase (car args))) (setq args (cdr args))))) ;; @defivar: Specialized object-oriented (put 'defivar 'texinfo-deffn-formatting-property 'texinfo-format-defivar) (put 'defivarx 'texinfo-deffn-formatting-property 'texinfo-format-defivar) (defun texinfo-format-defivar (parsed-args) ;; Specialized object oriented entity: ;; @defivar class name ;; In Info, `Instance variable of class: name' ;; Note: args in upper case; use of `of' ;; Use cdr of texinfo-defun-type to determine category: (let ((category (car (cdr texinfo-defun-type))) (class (car parsed-args)) (name (car (cdr parsed-args))) (args (cdr (cdr parsed-args)))) (insert " -- " category " of " class ": " name) (while args (insert " " (upcase (car args))) (setq args (cdr args))))) ;;; Indexing for definitions ;; An index entry has three parts: the `entry proper', the node name, and the ;; line number. Depending on the which command is used, the entry is ;; formatted differently: ;; ;; @defun, ;; @defmac, ;; @defspec, ;; @defvar, ;; @defopt all use their 1st argument as the entry-proper ;; ;; @deffn, ;; @defvr, ;; @deftp ;; @deftypefun ;; @deftypevar all use their 2nd argument as the entry-proper ;; ;; @deftypefn, ;; @deftypevr both use their 3rd argument as the entry-proper ;; ;; @defmethod uses its 2nd and 1st arguments as an entry-proper ;; formatted: NAME on CLASS ;; @defop uses its 3rd and 2nd arguments as an entry-proper ;; formatted: NAME on CLASS ;; ;; @defivar uses its 2nd and 1st arguments as an entry-proper ;; formatted: NAME of CLASS ;; ;; @defcv uses its 3rd and 2nd argument as an entry-proper ;; formatted: NAME of CLASS (put 'defun 'texinfo-defun-indexing-property 'texinfo-index-defun) (put 'defunx 'texinfo-defun-indexing-property 'texinfo-index-defun) (put 'defmac 'texinfo-defun-indexing-property 'texinfo-index-defun) (put 'defmacx 'texinfo-defun-indexing-property 'texinfo-index-defun) (put 'defspec 'texinfo-defun-indexing-property 'texinfo-index-defun) (put 'defspecx 'texinfo-defun-indexing-property 'texinfo-index-defun) (put 'defvar 'texinfo-defun-indexing-property 'texinfo-index-defun) (put 'defvarx 'texinfo-defun-indexing-property 'texinfo-index-defun) (put 'defopt 'texinfo-defun-indexing-property 'texinfo-index-defun) (put 'defoptx 'texinfo-defun-indexing-property 'texinfo-index-defun) (defun texinfo-index-defun (parsed-args) ;; use 1st parsed-arg as entry-proper ;; `index-list' will be texinfo-findex or the like (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) (set index-list (cons ;; Three elements: entry-proper, node-name, line-number (list (car parsed-args) texinfo-last-node ;; Region formatting may not provide last node position. (if texinfo-last-node-pos (1+ (count-lines texinfo-last-node-pos (point))) 1)) (symbol-value index-list))))) (put 'deffn 'texinfo-defun-indexing-property 'texinfo-index-deffn) (put 'deffnx 'texinfo-defun-indexing-property 'texinfo-index-deffn) (put 'defvr 'texinfo-defun-indexing-property 'texinfo-index-deffn) (put 'defvrx 'texinfo-defun-indexing-property 'texinfo-index-deffn) (put 'deftp 'texinfo-defun-indexing-property 'texinfo-index-deffn) (put 'deftpx 'texinfo-defun-indexing-property 'texinfo-index-deffn) (put 'deftypefun 'texinfo-defun-indexing-property 'texinfo-index-deffn) (put 'deftypefunx 'texinfo-defun-indexing-property 'texinfo-index-deffn) (put 'deftypevar 'texinfo-defun-indexing-property 'texinfo-index-deffn) (put 'deftypevarx 'texinfo-defun-indexing-property 'texinfo-index-deffn) (defun texinfo-index-deffn (parsed-args) ;; use 2nd parsed-arg as entry-proper ;; `index-list' will be texinfo-findex or the like (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) (set index-list (cons ;; Three elements: entry-proper, node-name, line-number (list (car (cdr parsed-args)) texinfo-last-node ;; Region formatting may not provide last node position. (if texinfo-last-node-pos (1+ (count-lines texinfo-last-node-pos (point))) 1)) (symbol-value index-list))))) (put 'deftypefn 'texinfo-defun-indexing-property 'texinfo-index-deftypefn) (put 'deftypefnx 'texinfo-defun-indexing-property 'texinfo-index-deftypefn) (put 'deftypevr 'texinfo-defun-indexing-property 'texinfo-index-deftypefn) (put 'deftypevrx 'texinfo-defun-indexing-property 'texinfo-index-deftypefn) (defun texinfo-index-deftypefn (parsed-args) ;; use 3rd parsed-arg as entry-proper ;; `index-list' will be texinfo-findex or the like (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) (set index-list (cons ;; Three elements: entry-proper, node-name, line-number (list (car (cdr (cdr parsed-args))) texinfo-last-node ;; Region formatting may not provide last node position. (if texinfo-last-node-pos (1+ (count-lines texinfo-last-node-pos (point))) 1)) (symbol-value index-list))))) (put 'defmethod 'texinfo-defun-indexing-property 'texinfo-index-defmethod) (put 'defmethodx 'texinfo-defun-indexing-property 'texinfo-index-defmethod) (defun texinfo-index-defmethod (parsed-args) ;; use 2nd on 1st parsed-arg as entry-proper ;; `index-list' will be texinfo-findex or the like (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) (set index-list (cons ;; Three elements: entry-proper, node-name, line-number (list (format "%s on %s" (car (cdr parsed-args)) (car parsed-args)) texinfo-last-node ;; Region formatting may not provide last node position. (if texinfo-last-node-pos (1+ (count-lines texinfo-last-node-pos (point))) 1)) (symbol-value index-list))))) (put 'defop 'texinfo-defun-indexing-property 'texinfo-index-defop) (put 'defopx 'texinfo-defun-indexing-property 'texinfo-index-defop) (defun texinfo-index-defop (parsed-args) ;; use 3rd on 2nd parsed-arg as entry-proper ;; `index-list' will be texinfo-findex or the like (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) (set index-list (cons ;; Three elements: entry-proper, node-name, line-number (list (format "%s on %s" (car (cdr (cdr parsed-args))) (car (cdr parsed-args))) texinfo-last-node ;; Region formatting may not provide last node position. (if texinfo-last-node-pos (1+ (count-lines texinfo-last-node-pos (point))) 1)) (symbol-value index-list))))) (put 'defivar 'texinfo-defun-indexing-property 'texinfo-index-defivar) (put 'defivarx 'texinfo-defun-indexing-property 'texinfo-index-defivar) (defun texinfo-index-defivar (parsed-args) ;; use 2nd of 1st parsed-arg as entry-proper ;; `index-list' will be texinfo-findex or the like (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) (set index-list (cons ;; Three elements: entry-proper, node-name, line-number (list (format "%s of %s" (car (cdr parsed-args)) (car parsed-args)) texinfo-last-node ;; Region formatting may not provide last node position. (if texinfo-last-node-pos (1+ (count-lines texinfo-last-node-pos (point))) 1)) (symbol-value index-list))))) (put 'defcv 'texinfo-defun-indexing-property 'texinfo-index-defcv) (put 'defcvx 'texinfo-defun-indexing-property 'texinfo-index-defcv) (defun texinfo-index-defcv (parsed-args) ;; use 3rd of 2nd parsed-arg as entry-proper ;; `index-list' will be texinfo-findex or the like (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) (set index-list (cons ;; Three elements: entry-proper, node-name, line-number (list (format "%s of %s" (car (cdr (cdr parsed-args))) (car (cdr parsed-args))) texinfo-last-node ;; Region formatting may not provide last node position. (if texinfo-last-node-pos (1+ (count-lines texinfo-last-node-pos (point))) 1)) (symbol-value index-list))))) ;;; Properties for definitions ;; Each definition command has six properties: ;; ;; 1. texinfo-deffn-formatting-property to format definition line ;; 2. texinfo-defun-indexing-property to create index entry ;; 3. texinfo-format formatting command ;; 4. texinfo-end end formatting command ;; 5. texinfo-defun-type type of deffn to format ;; 6. texinfo-defun-index type of index to use ;; ;; The `x' forms of each definition command are used for the second ;; and subsequent header lines. ;; The texinfo-deffn-formatting-property and texinfo-defun-indexing-property ;; are listed just before the appropriate formatting and indexing commands. (put 'deffn 'texinfo-format 'texinfo-format-defun) (put 'deffnx 'texinfo-format 'texinfo-format-defunx) (put 'deffn 'texinfo-end 'texinfo-end-defun) (put 'deffn 'texinfo-defun-type '('deffn-type nil)) (put 'deffnx 'texinfo-defun-type '('deffn-type nil)) (put 'deffn 'texinfo-defun-index 'texinfo-findex) (put 'deffnx 'texinfo-defun-index 'texinfo-findex) (put 'defun 'texinfo-format 'texinfo-format-defun) (put 'defunx 'texinfo-format 'texinfo-format-defunx) (put 'defun 'texinfo-end 'texinfo-end-defun) (put 'defun 'texinfo-defun-type '('defun-type "Function")) (put 'defunx 'texinfo-defun-type '('defun-type "Function")) (put 'defun 'texinfo-defun-index 'texinfo-findex) (put 'defunx 'texinfo-defun-index 'texinfo-findex) (put 'defmac 'texinfo-format 'texinfo-format-defun) (put 'defmacx 'texinfo-format 'texinfo-format-defunx) (put 'defmac 'texinfo-end 'texinfo-end-defun) (put 'defmac 'texinfo-defun-type '('defun-type "Macro")) (put 'defmacx 'texinfo-defun-type '('defun-type "Macro")) (put 'defmac 'texinfo-defun-index 'texinfo-findex) (put 'defmacx 'texinfo-defun-index 'texinfo-findex) (put 'defspec 'texinfo-format 'texinfo-format-defun) (put 'defspecx 'texinfo-format 'texinfo-format-defunx) (put 'defspec 'texinfo-end 'texinfo-end-defun) (put 'defspec 'texinfo-defun-type '('defun-type "Special form")) (put 'defspecx 'texinfo-defun-type '('defun-type "Special form")) (put 'defspec 'texinfo-defun-index 'texinfo-findex) (put 'defspecx 'texinfo-defun-index 'texinfo-findex) (put 'defvr 'texinfo-format 'texinfo-format-defun) (put 'defvrx 'texinfo-format 'texinfo-format-defunx) (put 'defvr 'texinfo-end 'texinfo-end-defun) (put 'defvr 'texinfo-defun-type '('deffn-type nil)) (put 'defvrx 'texinfo-defun-type '('deffn-type nil)) (put 'defvr 'texinfo-defun-index 'texinfo-vindex) (put 'defvrx 'texinfo-defun-index 'texinfo-vindex) (put 'defvar 'texinfo-format 'texinfo-format-defun) (put 'defvarx 'texinfo-format 'texinfo-format-defunx) (put 'defvar 'texinfo-end 'texinfo-end-defun) (put 'defvar 'texinfo-defun-type '('defun-type "Variable")) (put 'defvarx 'texinfo-defun-type '('defun-type "Variable")) (put 'defvar 'texinfo-defun-index 'texinfo-vindex) (put 'defvarx 'texinfo-defun-index 'texinfo-vindex) (put 'defconst 'texinfo-format 'texinfo-format-defun) (put 'defconstx 'texinfo-format 'texinfo-format-defunx) (put 'defconst 'texinfo-end 'texinfo-end-defun) (put 'defconst 'texinfo-defun-type '('defun-type "Constant")) (put 'defconstx 'texinfo-defun-type '('defun-type "Constant")) (put 'defconst 'texinfo-defun-index 'texinfo-vindex) (put 'defconstx 'texinfo-defun-index 'texinfo-vindex) (put 'defcmd 'texinfo-format 'texinfo-format-defun) (put 'defcmdx 'texinfo-format 'texinfo-format-defunx) (put 'defcmd 'texinfo-end 'texinfo-end-defun) (put 'defcmd 'texinfo-defun-type '('defun-type "Command")) (put 'defcmdx 'texinfo-defun-type '('defun-type "Command")) (put 'defcmd 'texinfo-defun-index 'texinfo-findex) (put 'defcmdx 'texinfo-defun-index 'texinfo-findex) (put 'defopt 'texinfo-format 'texinfo-format-defun) (put 'defoptx 'texinfo-format 'texinfo-format-defunx) (put 'defopt 'texinfo-end 'texinfo-end-defun) (put 'defopt 'texinfo-defun-type '('defun-type "User Option")) (put 'defoptx 'texinfo-defun-type '('defun-type "User Option")) (put 'defopt 'texinfo-defun-index 'texinfo-vindex) (put 'defoptx 'texinfo-defun-index 'texinfo-vindex) (put 'deftp 'texinfo-format 'texinfo-format-defun) (put 'deftpx 'texinfo-format 'texinfo-format-defunx) (put 'deftp 'texinfo-end 'texinfo-end-defun) (put 'deftp 'texinfo-defun-type '('deftp-type nil)) (put 'deftpx 'texinfo-defun-type '('deftp-type nil)) (put 'deftp 'texinfo-defun-index 'texinfo-tindex) (put 'deftpx 'texinfo-defun-index 'texinfo-tindex) ;;; Object-oriented stuff is a little hairier. (put 'defop 'texinfo-format 'texinfo-format-defun) (put 'defopx 'texinfo-format 'texinfo-format-defunx) (put 'defop 'texinfo-end 'texinfo-end-defun) (put 'defop 'texinfo-defun-type '('defop-type nil)) (put 'defopx 'texinfo-defun-type '('defop-type nil)) (put 'defop 'texinfo-defun-index 'texinfo-findex) (put 'defopx 'texinfo-defun-index 'texinfo-findex) (put 'defmethod 'texinfo-format 'texinfo-format-defun) (put 'defmethodx 'texinfo-format 'texinfo-format-defunx) (put 'defmethod 'texinfo-end 'texinfo-end-defun) (put 'defmethod 'texinfo-defun-type '('defmethod-type "Method")) (put 'defmethodx 'texinfo-defun-type '('defmethod-type "Method")) (put 'defmethod 'texinfo-defun-index 'texinfo-findex) (put 'defmethodx 'texinfo-defun-index 'texinfo-findex) (put 'defcv 'texinfo-format 'texinfo-format-defun) (put 'defcvx 'texinfo-format 'texinfo-format-defunx) (put 'defcv 'texinfo-end 'texinfo-end-defun) (put 'defcv 'texinfo-defun-type '('defop-type nil)) (put 'defcvx 'texinfo-defun-type '('defop-type nil)) (put 'defcv 'texinfo-defun-index 'texinfo-vindex) (put 'defcvx 'texinfo-defun-index 'texinfo-vindex) (put 'defivar 'texinfo-format 'texinfo-format-defun) (put 'defivarx 'texinfo-format 'texinfo-format-defunx) (put 'defivar 'texinfo-end 'texinfo-end-defun) (put 'defivar 'texinfo-defun-type '('defmethod-type "Instance variable")) (put 'defivarx 'texinfo-defun-type '('defmethod-type "Instance variable")) (put 'defivar 'texinfo-defun-index 'texinfo-vindex) (put 'defivarx 'texinfo-defun-index 'texinfo-vindex) ;;; Typed functions and variables (put 'deftypefn 'texinfo-format 'texinfo-format-defun) (put 'deftypefnx 'texinfo-format 'texinfo-format-defunx) (put 'deftypefn 'texinfo-end 'texinfo-end-defun) (put 'deftypefn 'texinfo-defun-type '('deftypefn-type nil)) (put 'deftypefnx 'texinfo-defun-type '('deftypefn-type nil)) (put 'deftypefn 'texinfo-defun-index 'texinfo-findex) (put 'deftypefnx 'texinfo-defun-index 'texinfo-findex) (put 'deftypefun 'texinfo-format 'texinfo-format-defun) (put 'deftypefunx 'texinfo-format 'texinfo-format-defunx) (put 'deftypefun 'texinfo-end 'texinfo-end-defun) (put 'deftypefun 'texinfo-defun-type '('deftypefun-type "Function")) (put 'deftypefunx 'texinfo-defun-type '('deftypefun-type "Function")) (put 'deftypefun 'texinfo-defun-index 'texinfo-findex) (put 'deftypefunx 'texinfo-defun-index 'texinfo-findex) (put 'deftypevr 'texinfo-format 'texinfo-format-defun) (put 'deftypevrx 'texinfo-format 'texinfo-format-defunx) (put 'deftypevr 'texinfo-end 'texinfo-end-defun) (put 'deftypevr 'texinfo-defun-type '('deftypefn-type nil)) (put 'deftypevrx 'texinfo-defun-type '('deftypefn-type nil)) (put 'deftypevr 'texinfo-defun-index 'texinfo-vindex) (put 'deftypevrx 'texinfo-defun-index 'texinfo-vindex) (put 'deftypevar 'texinfo-format 'texinfo-format-defun) (put 'deftypevarx 'texinfo-format 'texinfo-format-defunx) (put 'deftypevar 'texinfo-end 'texinfo-end-defun) (put 'deftypevar 'texinfo-defun-type '('deftypevar-type "Variable")) (put 'deftypevarx 'texinfo-defun-type '('deftypevar-type "Variable")) (put 'deftypevar 'texinfo-defun-index 'texinfo-vindex) (put 'deftypevarx 'texinfo-defun-index 'texinfo-vindex) ;;; @set, @clear, @ifset, @ifclear ;; If a flag is set with @set FLAG, then text between @ifset and @end ;; ifset is formatted normally, but if the flag is is cleared with ;; @clear FLAG, then the text is not formatted; it is ignored. ;; If a flag is cleared with @clear FLAG, then text between @ifclear ;; and @end ifclear is formatted normally, but if the flag is is set with ;; @set FLAG, then the text is not formatted; it is ignored. @ifclear ;; is the opposite of @ifset. ;; If a flag is set to a string with @set FLAG, ;; replace @value{FLAG} with the string. ;; If a flag with a value is cleared, ;; @value{FLAG} is invalid, ;; as if there had never been any @set FLAG previously. (put 'clear 'texinfo-format 'texinfo-clear) (defun texinfo-clear () "Clear the value of the flag." (let* ((arg (texinfo-parse-arg-discard)) (flag (car (read-from-string arg))) (value (substring arg (cdr (read-from-string arg))))) (put flag 'texinfo-whether-setp 'flag-cleared) (put flag 'texinfo-set-value ""))) (put 'set 'texinfo-format 'texinfo-set) (defun texinfo-set () "Set the value of the flag, optionally to a string. The command `@set foo This is a string.' sets flag foo to the value: `This is a string.' The command `@value{foo}' expands to the value." (let* ((arg (texinfo-parse-arg-discard)) (flag (car (read-from-string arg))) (value (substring arg (cdr (read-from-string arg))))) (put flag 'texinfo-whether-setp 'flag-set) (put flag 'texinfo-set-value value))) (put 'value 'texinfo-format 'texinfo-value) (defun texinfo-value () "Insert the string to which the flag is set. The command `@set foo This is a string.' sets flag foo to the value: `This is a string.' The command `@value{foo}' expands to the value." (let ((arg (texinfo-parse-arg-discard))) (cond ((and (eq (get (car (read-from-string arg)) 'texinfo-whether-setp) 'flag-set) (get (car (read-from-string arg)) 'texinfo-set-value)) (insert (get (car (read-from-string arg)) 'texinfo-set-value))) ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) 'flag-cleared) (insert (format "{No value for \"%s\"}" arg))) ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) nil) (insert (format "{No value for \"%s\"}" arg)))))) (put 'ifset 'texinfo-end 'texinfo-discard-command) (put 'ifset 'texinfo-format 'texinfo-if-set) (defun texinfo-if-set () "If set, continue formatting; else do not format region up to @end ifset" (let ((arg (texinfo-parse-arg-discard))) (cond ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) 'flag-set) ;; Format the text (i.e., do not remove it); do nothing here. ()) ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) 'flag-cleared) ;; Clear region (i.e., cause the text to be ignored). (delete-region texinfo-command-start (progn (re-search-forward "@end ifset[ \t]*\n") (point)))) ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) nil) ;; In this case flag is neither set nor cleared. ;; Act as if set, i.e. do nothing. ())))) (put 'ifclear 'texinfo-end 'texinfo-discard-command) (put 'ifclear 'texinfo-format 'texinfo-if-clear) (defun texinfo-if-clear () "If clear, continue formatting; if set, do not format up to @end ifset" (let ((arg (texinfo-parse-arg-discard))) (cond ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) 'flag-set) ;; Clear region (i.e., cause the text to be ignored). (delete-region texinfo-command-start (progn (re-search-forward "@end ifclear[ \t]*\n") (point)))) ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) 'flag-cleared) ;; Format the text (i.e., do not remove it); do nothing here. ()) ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) nil) ;; In this case flag is neither set nor cleared. ;; Act as if clear, i.e. do nothing. ())))) ;;; Process included files: `@include' command ;; Updated 19 October 1990 ;; In the original version, include files were ignored by Info but ;; incorporated in to the printed manual. To make references to the ;; included file, the Texinfo source file has to refer to the included ;; files using the `(filename)nodename' format for refering to other ;; Info files. Also, the included files had to be formatted on their ;; own. It was just like they were another file. ;; Currently, include files are inserted into the buffer that is ;; formatted for Info. If large, the resulting info file is split and ;; tagified. For current include files to work, the master menu must ;; refer to all the nodes, and the highest level nodes in the include ;; files must have the correct next, prev, and up pointers. ;; The included file may have an @setfilename and even an @settitle, ;; but not an `\input texinfo' line. ;; Updated 24 March 1993 ;; In order for @raisesections and @lowersections to work, included ;; files must be inserted into the buffer holding the outer file ;; before other Info formatting takes place. So @include is no longer ;; is treated like other @-commands. (put 'include 'texinfo-format 'texinfo-format-noop) ; Original definition: ; (defun texinfo-format-include () ; (let ((filename (texinfo-parse-arg-discard)) ; (default-directory input-directory) ; subindex) ; (setq subindex ; (save-excursion ; (progn (find-file ; (cond ((file-readable-p (concat filename ".texinfo")) ; (concat filename ".texinfo")) ; ((file-readable-p (concat filename ".texi")) ; (concat filename ".texi")) ; ((file-readable-p (concat filename ".tex")) ; (concat filename ".tex")) ; ((file-readable-p filename) ; filename) ; (t (error "@include'd file %s not found" ; filename)))) ; (texinfo-format-buffer-1)))) ; (texinfo-subindex 'texinfo-vindex (car subindex) (nth 1 subindex)) ; (texinfo-subindex 'texinfo-findex (car subindex) (nth 2 subindex)) ; (texinfo-subindex 'texinfo-cindex (car subindex) (nth 3 subindex)) ; (texinfo-subindex 'texinfo-pindex (car subindex) (nth 4 subindex)) ; (texinfo-subindex 'texinfo-tindex (car subindex) (nth 5 subindex)) ; (texinfo-subindex 'texinfo-kindex (car subindex) (nth 6 subindex)))) ; ;(defun texinfo-subindex (indexvar file content) ; (set indexvar (cons (list 'recurse file content) ; (symbol-value indexvar)))) ; Second definition: ; (put 'include 'texinfo-format 'texinfo-format-include) ; (defun texinfo-format-include () ; (let ((filename (concat input-directory ; (texinfo-parse-arg-discard))) ; (default-directory input-directory)) ; (message "Reading: %s" filename) ; (save-excursion ; (save-restriction ; (narrow-to-region ; (point) ; (+ (point) (car (cdr (insert-file-contents filename))))) ; (goto-char (point-min)) ; (texinfo-append-refill) ; (texinfo-format-convert (point-min) (point-max)))) ; (setq last-input-buffer input-buffer) ; to bypass setfilename ; )) ;;; Numerous commands do nothing in Texinfo ;; These commands are defined in texinfo.tex for printed output. (put 'bye 'texinfo-format 'texinfo-discard-line) (put 'c 'texinfo-format 'texinfo-discard-line-with-args) (put 'comment 'texinfo-format 'texinfo-discard-line-with-args) (put 'contents 'texinfo-format 'texinfo-discard-line-with-args) (put 'finalout 'texinfo-format 'texinfo-discard-line) (put 'group 'texinfo-end 'texinfo-discard-line-with-args) (put 'group 'texinfo-format 'texinfo-discard-line-with-args) (put 'headings 'texinfo-format 'texinfo-discard-line-with-args) (put 'hsize 'texinfo-format 'texinfo-discard-line-with-args) (put 'itemindent 'texinfo-format 'texinfo-discard-line-with-args) (put 'lispnarrowing 'texinfo-format 'texinfo-discard-line-with-args) (put 'need 'texinfo-format 'texinfo-discard-line-with-args) (put 'nopara 'texinfo-format 'texinfo-discard-line-with-args) (put 'page 'texinfo-format 'texinfo-discard-line-with-args) (put 'parindent 'texinfo-format 'texinfo-discard-line-with-args) (put 'setchapternewpage 'texinfo-format 'texinfo-discard-line-with-args) (put 'setq 'texinfo-format 'texinfo-discard-line-with-args) (put 'settitle 'texinfo-format 'texinfo-discard-line-with-args) (put 'setx 'texinfo-format 'texinfo-discard-line-with-args) (put 'shortcontents 'texinfo-format 'texinfo-discard-line-with-args) (put 'smallbook 'texinfo-format 'texinfo-discard-line) (put 'summarycontents 'texinfo-format 'texinfo-discard-line-with-args) ;;; Some commands cannot be handled (defun texinfo-unsupported () (error "%s is not handled by texinfo" (buffer-substring texinfo-command-start texinfo-command-end))) ;;; Batch formatting (defun batch-texinfo-format () "Runs texinfo-format-buffer on the files remaining on the command line. Must be used only with -batch, and kills emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke \"emacs -batch -funcall batch-texinfo-format $docs/ ~/*.texinfo\"." (if (not noninteractive) (error "batch-texinfo-format may only be used -batch.")) (let ((version-control t) (auto-save-default nil) (find-file-run-dired nil) (kept-old-versions 259259) (kept-new-versions 259259)) (let ((error 0) file (files ())) (while command-line-args-left (setq file (expand-file-name (car command-line-args-left))) (cond ((not (file-exists-p file)) (message ">> %s does not exist!" file) (setq error 1 command-line-args-left (cdr command-line-args-left))) ((file-directory-p file) (setq command-line-args-left (nconc (directory-files file) (cdr command-line-args-left)))) (t (setq files (cons file files) command-line-args-left (cdr command-line-args-left))))) (while files (setq file (car files) files (cdr files)) (condition-case err (progn (if buffer-file-name (kill-buffer (current-buffer))) (find-file file) (buffer-disable-undo (current-buffer)) (set-buffer-modified-p nil) (texinfo-mode) (message "texinfo formatting %s..." file) (texinfo-format-buffer nil) (if (buffer-modified-p) (progn (message "Saving modified %s" (buffer-file-name)) (save-buffer)))) (error (message ">> Error: %s" (prin1-to-string err)) (message ">> point at") (let ((s (buffer-substring (point) (min (+ (point) 100) (point-max)))) (tem 0)) (while (setq tem (string-match "\n+" s tem)) (setq s (concat (substring s 0 (match-beginning 0)) "\n>> " (substring s (match-end 0))) tem (1+ tem))) (message ">> %s" s)) (setq error 1)))) (kill-emacs error)))) ;;; Place `provide' at end of file. (provide 'texinfmt) ;;; texinfmt.el ends here. emacs-19.30/lisp/texinfo.el100444 12120 1 72417 6045205454 14104 0ustar rmsdaemon;;; texinfo.el --- major mode for editing Texinfo files ;; Copyright (C) 1985, '88, '89, ;; '90, '91, '92, '93 Free Software Foundation, Inc. ;; Author: Robert J. Chassell ;; Maintainer: FSF ;; 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. ;;; Autoloads: (autoload 'makeinfo-region "makeinfo" "Make Info file from region of current Texinfo file, and switch to it. This command does not offer the `next-error' feature since it would apply to a temporary file, not the original; use the `makeinfo-buffer' command to gain use of `next-error'." t nil) (autoload 'makeinfo-buffer "makeinfo" "Make Info file from current buffer. Use the \\[next-error] command to move to the next error \(if there are errors\)." t nil) (autoload 'kill-compilation "compile" "Kill the process made by the \\[compile] command." t nil) (autoload 'makeinfo-recenter-compilation-buffer "makeinfo" "Redisplay `*compilation*' buffer so most recent output can be seen. The last line of the buffer is displayed on line LINE of the window, or centered if LINE is nil." t nil) (autoload 'texinfo-make-menu "texnfo-upd" "Without any prefix argument, make or update a menu. Make the menu for the section enclosing the node found following point. Non-nil argument (prefix, if interactive) means make or update menus for nodes within or part of the marked region. Whenever a menu exists, and is being updated, the descriptions that are associated with node names in the pre-existing menu are incorporated into the new menu. Otherwise, the nodes' section titles are inserted as descriptions." t nil) (autoload 'texinfo-all-menus-update "texnfo-upd" "Update every regular menu in a Texinfo file. Remove 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." t nil) (autoload 'texinfo-master-menu "texnfo-upd" "Make a master menu for a whole Texinfo file. Non-nil argument (prefix, if interactive) means first update all existing nodes and menus. Remove pre-existing master menu, if there is one. This function creates a master menu that follows the top node. The master menu includes every entry from all the other menus. It replaces any existing ordinary menu that follows the top node. If called with a non-nil argument, this function first updates all the menus in the buffer (incorporating descriptions from pre-existing menus) before it constructs the master menu. 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'. The master menu has the following format, which is adapted from the recommendation in the Texinfo Manual: * The first part contains the major nodes in the Texinfo file: the nodes for the chapters, chapter-like sections, and the major appendices. This includes the indices, so long as they are in chapter-like sections, such as unnumbered sections. * The second and subsequent parts contain a listing of the other, lower level menus, in order. This way, an inquirer can go directly to a particular node if he or she is searching for specific information. Each of the menus in the detailed node listing is introduced by the title of the section containing the menu." t nil) (autoload 'texinfo-indent-menu-description "texnfo-upd" "Indent every description in menu following point to COLUMN. Non-nil argument (prefix, if interactive) means indent every description in every menu in the region. Does not indent second and subsequent lines of a multi-line description." t nil) (autoload 'texinfo-insert-node-lines "texnfo-upd" "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." t nil) (autoload 'texinfo-start-menu-description "texnfo-upd" "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." t nil) (autoload 'texinfo-multiple-files-update "texnfo-upd" "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: * this command does NOT save any files--you must save the outer file and any modified, included files. * except for the `Top' node, this command does NOT handle any pre-existing nodes in the outer file; hence, indices must be enclosed in an included file. Requirements: * each of the included files must contain exactly one highest hierarchical level node, * this highest node must be the first node in the included file, * each highest hierarchical level node must be of the same type. Thus, normally, each included file contains one, and only one, chapter." t nil) ;;; Code: ;;; Don't you dare insert any `require' calls at top level in this file--rms. ;;; Syntax table (defvar texinfo-mode-syntax-table nil) (if texinfo-mode-syntax-table nil (setq texinfo-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?\" " " texinfo-mode-syntax-table) (modify-syntax-entry ?\\ " " texinfo-mode-syntax-table) (modify-syntax-entry ?@ "\\" texinfo-mode-syntax-table) (modify-syntax-entry ?\^q "\\" texinfo-mode-syntax-table) (modify-syntax-entry ?\[ "(]" texinfo-mode-syntax-table) (modify-syntax-entry ?\] ")[" texinfo-mode-syntax-table) (modify-syntax-entry ?{ "(}" texinfo-mode-syntax-table) (modify-syntax-entry ?} "){" texinfo-mode-syntax-table) (modify-syntax-entry ?\' "w" texinfo-mode-syntax-table)) ;; Written by Wolfgang Bangerth ;; To overide this example, set either `imenu-generic-expression' ;; or `imenu-create-index-function'. (defvar texinfo-imenu-generic-expression '((nil "^@node[ \t]+\\([^,\n]*\\)" 1) ("Chapters" "^@chapter[ \t]+\\(.*\\)$" 1)) "Imenu generic expression for TexInfo mode. See `imenu-generic-expression'.") (defvar texinfo-font-lock-keywords (list ;; All but the first 2 had an OVERRIDE of t. ;; It didn't seem to be any better, and it's slower--simon. '("^\\(@c\\|@comment\\)\\>.*" . font-lock-comment-face) ;comments ;; Robert J. Chassell says remove this line. ;'("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) "@\\(@\\|[^}\t \n{]+\\)" ;commands '("^\\(*.*\\)[\t ]*$" 1 font-lock-function-name-face t) ;menu items '("@\\(emph\\|strong\\|b\\|i\\){\\([^}]+\\)" 2 font-lock-comment-face) '("@\\(file\\|kbd\\|key\\){\\([^}]+\\)" 2 font-lock-string-face) '("@\\(samp\\|code\\|var\\|math\\){\\([^}]+\\)" 2 font-lock-variable-name-face) '("@\\(cite\\|xref\\|pxref\\){\\([^}]+\\)" 2 font-lock-reference-face) '("@\\(end\\|item\\) *\\(.+\\)" 2 font-lock-function-name-face keep) ) "Additional expressions to highlight in TeXinfo mode.") ;;; Keybindings (defvar texinfo-mode-map nil) ;;; Keys common both to Texinfo mode and to TeX shell. (defun texinfo-define-common-keys (keymap) "Define the keys both in Texinfo mode and in the texinfo-tex-shell." (define-key keymap "\C-c\C-t\C-k" 'tex-kill-job) (define-key keymap "\C-c\C-t\C-x" 'texinfo-quit-job) (define-key keymap "\C-c\C-t\C-l" 'tex-recenter-output-buffer) (define-key keymap "\C-c\C-t\C-d" 'texinfo-delete-from-print-queue) (define-key keymap "\C-c\C-t\C-q" 'tex-show-print-queue) (define-key keymap "\C-c\C-t\C-p" 'texinfo-tex-print) (define-key keymap "\C-c\C-t\C-i" 'texinfo-texindex) (define-key keymap "\C-c\C-t\C-r" 'texinfo-tex-region) (define-key keymap "\C-c\C-t\C-b" 'texinfo-tex-buffer)) ;; Mode documentation displays commands in reverse order ;; from how they are listed in the texinfo-mode-map. (if texinfo-mode-map nil (setq texinfo-mode-map (make-sparse-keymap)) ;; bindings for `texnfo-tex.el' (texinfo-define-common-keys texinfo-mode-map) ;; bindings for `makeinfo.el' (define-key texinfo-mode-map "\C-c\C-m\C-k" 'kill-compilation) (define-key texinfo-mode-map "\C-c\C-m\C-l" 'makeinfo-recenter-compilation-buffer) (define-key texinfo-mode-map "\C-c\C-m\C-r" 'makeinfo-region) (define-key texinfo-mode-map "\C-c\C-m\C-b" 'makeinfo-buffer) ; Bindings for texinfmt.el. (define-key texinfo-mode-map "\C-c\C-e\C-r" 'texinfo-format-region) (define-key texinfo-mode-map "\C-c\C-e\C-b" 'texinfo-format-buffer) ;; bindings for updating nodes and menus (define-key texinfo-mode-map "\C-c\C-um" 'texinfo-master-menu) (define-key texinfo-mode-map "\C-c\C-u\C-m" 'texinfo-make-menu) (define-key texinfo-mode-map "\C-c\C-u\C-n" 'texinfo-update-node) (define-key texinfo-mode-map "\C-c\C-u\C-e" 'texinfo-every-node-update) (define-key texinfo-mode-map "\C-c\C-u\C-a" 'texinfo-all-menus-update) (define-key texinfo-mode-map "\C-c\C-s" 'texinfo-show-structure) (define-key texinfo-mode-map "\C-c}" 'up-list) (define-key texinfo-mode-map "\C-c{" 'texinfo-insert-braces) ;; bindings for inserting strings (define-key texinfo-mode-map "\C-c\C-c\C-d" 'texinfo-start-menu-description) (define-key texinfo-mode-map "\C-c\C-cv" 'texinfo-insert-@var) (define-key texinfo-mode-map "\C-c\C-ct" 'texinfo-insert-@table) (define-key texinfo-mode-map "\C-c\C-cs" 'texinfo-insert-@samp) (define-key texinfo-mode-map "\C-c\C-co" 'texinfo-insert-@noindent) (define-key texinfo-mode-map "\C-c\C-cn" 'texinfo-insert-@node) (define-key texinfo-mode-map "\C-c\C-ck" 'texinfo-insert-@kbd) (define-key texinfo-mode-map "\C-c\C-ci" 'texinfo-insert-@item) (define-key texinfo-mode-map "\C-c\C-cf" 'texinfo-insert-@file) (define-key texinfo-mode-map "\C-c\C-cx" 'texinfo-insert-@example) (define-key texinfo-mode-map "\C-c\C-ce" 'texinfo-insert-@end) (define-key texinfo-mode-map "\C-c\C-cd" 'texinfo-insert-@dfn) (define-key texinfo-mode-map "\C-c\C-cc" 'texinfo-insert-@code)) ;;; Texinfo mode (defvar texinfo-chapter-level-regexp "chapter\\|unnumbered \\|appendix \\|majorheading\\|chapheading" "Regular expression matching Texinfo chapter-level headings. This does not match `@node' and does not match the `@top' command.") ;;;###autoload (defun texinfo-mode () "Major mode for editing Texinfo files. It has these extra commands: \\{texinfo-mode-map} 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. Editing commands are like text-mode except that the syntax table is 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]. This command shows the structure of a Texinfo file by listing the lines with the @-sign commands for @chapter, @section, and the like. These lines are displayed in another window called the *Occur* window. In that window, you can position the cursor over one of the lines and use \\[occur-mode-goto-occurrence], to jump to the corresponding spot in the Texinfo file. In addition, Texinfo mode provides commands that insert various frequently used @-sign commands into the buffer. You can use these commands to save keystrokes. And you can insert balanced braces with \\[texinfo-insert-braces] and later use the command \\[up-list] to move forward past the closing brace. Also, Texinfo mode provides functions for automatically creating or updating menus and node pointers. These functions * insert the `Next', `Previous' and `Up' pointers of a node, * insert or update the menu for a section, and * create a master menu for a Texinfo source file. Here are the functions: texinfo-update-node \\[texinfo-update-node] texinfo-every-node-update \\[texinfo-every-node-update] texinfo-sequential-node-update texinfo-make-menu \\[texinfo-make-menu] texinfo-all-menus-update \\[texinfo-all-menus-update] texinfo-master-menu texinfo-indent-menu-description (column &optional region-p) The `texinfo-column-for-description' variable specifies the column to which menu descriptions are indented. Passed an argument (a prefix argument, if interactive), the `texinfo-update-node' and `texinfo-make-menu' functions do their jobs in the region. To use the updating commands, you must structure your Texinfo file hierarchically, such that each `@node' line, with the exception of the Top node, is accompanied by some kind of section line, such as an `@chapter' or `@section' line. If the file has a `top' node, it must be called `top' or `Top' and be the first node in the file. Entering Texinfo mode calls the value of text-mode-hook, and then the value of texinfo-mode-hook." (interactive) (text-mode) (setq mode-name "Texinfo") (setq major-mode 'texinfo-mode) (use-local-map texinfo-mode-map) (set-syntax-table texinfo-mode-syntax-table) (make-local-variable 'page-delimiter) (setq page-delimiter (concat "^@node [ \t]*[Tt]op\\|^@\\(" texinfo-chapter-level-regexp "\\)")) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'indent-tabs-mode) (setq indent-tabs-mode nil) (make-local-variable 'paragraph-separate) (setq paragraph-separate (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-separate)) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-start)) (make-local-variable 'fill-column) (setq fill-column 72) (make-local-variable 'comment-start) (setq comment-start "@c ") (make-local-variable 'comment-start-skip) (setq comment-start-skip "@c +") (make-local-variable 'words-include-escapes) (setq words-include-escapes t) (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression texinfo-imenu-generic-expression) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(texinfo-font-lock-keywords 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)) ;;; Insert string commands (defconst texinfo-environment-regexp "^[ \t]*@\\(f?table\\|enumerate\\|itemize\ \\|ifhtml\\|ifinfo\\|iftex\\|ifset\\|ifclear\ \\|example\\|quotation\\|lisp\\|smallexample\\|smalllisp\\|display\\|format\ \\|flushleft\\|flushright\\|ignore\\|group\\|tex\\|html\\|cartouche\\|menu\ \\|titlepage\\|end\\|def[a-z]*[a-wyz]\\>\\)" "Regexp for environment-like Texinfo list commands. Subexpression 1 is what goes into the corresponding `@end' statement.") (defun texinfo-insert-@end () "Insert the matching `@end' for the last Texinfo command that needs one." (interactive) (let ((depth 1) string) (save-excursion (while (and (> depth 0) (re-search-backward texinfo-environment-regexp nil t) (if (looking-at "@end") (setq depth (1+ depth)) (setq depth (1- depth))))) (looking-at texinfo-environment-regexp) (if (zerop depth) (setq string (buffer-substring (match-beginning 1) (match-end 1))))) (insert "@end ") (if string (insert string "\n")))) ;; The following insert commands accept a prefix arg N, which is the ;; number of words (actually s-exprs) that should be surrounded by ;; braces. Thus you can first paste a variable name into a .texinfo ;; buffer, then say C-u 1 C-c C-c v at the beginning of the just ;; pasted variable name to put @var{...} *around* the variable name. ;; Operate on previous word or words with negative arg. ;; These commands use texinfo-insert-@-with-arg (defun texinfo-insert-@-with-arg (string &optional arg) (if arg (progn (setq arg (prefix-numeric-value arg)) (if (< arg 0) (progn (skip-chars-backward " \t\n\r\f") (save-excursion (forward-sexp arg) (insert "@" string "{")) (insert "}")) (skip-chars-forward " \t\n\r\f") (insert "@" string "{") (forward-sexp arg) (insert "}"))) (insert "@" string "{}") (backward-char))) (defun texinfo-insert-braces () "Make a pair of braces and be poised to type inside of them. Use \\[up-list] to move forward out of the braces." (interactive) (insert "{}") (backward-char)) (defun texinfo-insert-@code (&optional arg) "Insert a `@code{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." (interactive "P") (texinfo-insert-@-with-arg "code" arg)) (defun texinfo-insert-@dfn (&optional arg) "Insert a `@dfn{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." (interactive "P") (texinfo-insert-@-with-arg "dfn" arg)) (defun texinfo-insert-@example () "Insert the string `@example' in a Texinfo buffer." (interactive) (insert "@example\n")) (defun texinfo-insert-@file (&optional arg) "Insert a `@file{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." (interactive "P") (texinfo-insert-@-with-arg "file" arg)) (defun texinfo-insert-@item () "Insert the string `@item' in a Texinfo buffer." (interactive) (insert "@item") (newline)) (defun texinfo-insert-@kbd (&optional arg) "Insert a `@kbd{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." (interactive "P") (texinfo-insert-@-with-arg "kbd" arg)) (defun texinfo-insert-@node () "Insert the string `@node' in a Texinfo buffer. This also inserts on the following line a comment indicating the order of arguments to @node." (interactive) (insert "@node \n@comment node-name, next, previous, up") (forward-line -1) (forward-char 6)) (defun texinfo-insert-@noindent () "Insert the string `@noindent' in a Texinfo buffer." (interactive) (insert "@noindent\n")) (defun texinfo-insert-@samp (&optional arg) "Insert a `@samp{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." (interactive "P") (texinfo-insert-@-with-arg "samp" arg)) (defun texinfo-insert-@table (&optional arg) "Insert the string `@table' in a Texinfo buffer." (interactive "P") (insert "@table ")) (defun texinfo-insert-@var (&optional arg) "Insert a `@var{}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." (interactive "P") (texinfo-insert-@-with-arg "var" arg)) ;;; Texinfo file structure (defun texinfo-show-structure (&optional nodes-too) "Show the structure of a Texinfo file. List the lines in the file that begin with the @-sign commands for @chapter, @section, and the like. With optional argument (prefix if interactive), list both the lines with @-sign commands for @chapter, @section, and the like, and list @node lines. Lines with structuring commands beginning in them are displayed in another buffer named `*Occur*'. In that buffer, you can move point to one of those lines and then use \\\\[occur-mode-goto-occurrence], to jump to the corresponding spot in the Texinfo source file." (interactive "P") (require 'texnfo-upd) (save-excursion (goto-char (point-min)) (if nodes-too (occur (concat "\\(^@node\\)\\|" texinfo-section-types-regexp)) (occur texinfo-section-types-regexp))) (pop-to-buffer "*Occur*") (goto-char (point-min)) (flush-lines "-----") ;; Now format the "*Occur*" buffer to show the structure. ;; Thanks to ceder@signum.se (Per Cederqvist) (goto-char (point-max)) (let ((margin 5)) (while (re-search-backward "^ *[0-9]*:" nil 0) (re-search-forward ":") (setq margin (cond ((looking-at (concat "@\\(" texinfo-chapter-level-regexp "\\)")) 5) ;; ((looking-at "@chapter ") 5) ;; ((looking-at "@unnumbered ") 5) ;; ((looking-at "@appendix ") 5) ;; ((looking-at "@majorheading ") 5) ;; ((looking-at "@chapheading ") 5) ((looking-at (concat "@\\(" texinfo-section-level-regexp "\\)")) 9) ;; ((looking-at "@section ") 9) ;; ((looking-at "@unnumberedsec ") 9) ;; ((looking-at "@appendixsec ") 9) ;; ((looking-at "@heading ") 9) ((looking-at (concat "@\\(" texinfo-subsection-level-regexp "\\)")) 13) ;; ((looking-at "@subsection ") 13) ;; ((looking-at "@unnumberedsubsec ") 13) ;; ((looking-at "@appendixsubsec ") 13) ;; ((looking-at "@subheading ") 13) ((looking-at (concat "@\\(" texinfo-subsubsection-level-regexp "\\)")) 17) ;; ((looking-at "@subsubsection ") 17) ;; ((looking-at "@unnumberedsubsubsec ") 17) ;; ((looking-at "@appendixsubsubsec ") 17) ;; ((looking-at "@subsubheading ") 17) (t margin))) (indent-to-column margin) (beginning-of-line)))) ;;; The tex and print function definitions: (defvar texinfo-texi2dvi-command "texi2dvi" "*Command used by `texinfo-tex-buffer' to run TeX and texindex on a buffer.") (defvar texinfo-tex-command "tex" "*Command used by `texinfo-tex-region' to run TeX on a region.") (defvar texinfo-texindex-command "texindex" "*Command used by `texinfo-texindex' to sort unsorted index files.") (defvar texinfo-delete-from-print-queue-command "lprm" "*Command string used to delete a job from the line printer queue. Command is used by \\[texinfo-delete-from-print-queue] based on number provided by a previous \\[tex-show-print-queue] command.") (defvar texinfo-tex-trailer "@bye" "String appended after a region sent to TeX by `texinfo-tex-region'.") (defun texinfo-tex-region (beg end) "Run TeX on the current region. This works by writing a temporary file (`tex-zap-file') in the directory that is the value of `tex-directory', then running TeX on that file. The first line of the buffer is copied to the temporary file; and if the buffer has a header, it is written to the temporary file before the region itself. The buffer's header is all lines between the strings defined by `tex-start-of-header' and `tex-end-of-header' inclusive. The header must start in the first 100 lines. The value of `texinfo-tex-trailer' is appended to the temporary file after the region." (interactive "r") (require 'tex-mode) (if (get-buffer "*tex-shell*") (tex-kill-job) (tex-start-shell)) (or tex-zap-file (setq tex-zap-file (make-temp-name "#tz"))) (let ((tex-out-file (concat tex-zap-file ".tex")) (temp-buffer (get-buffer-create " tex-Output-Buffer")) (zap-directory (file-name-as-directory (expand-file-name tex-directory)))) (save-excursion (save-restriction (widen) (goto-char (point-min)) (forward-line 100) (let ((search-end (point)) (hbeg (point-min)) (hend (point-min)) (default-directory zap-directory)) (goto-char (point-min)) ;; Copy first line, the `\input texinfo' line, to temp file (write-region (point) (save-excursion (end-of-line) (point)) tex-out-file nil nil) ;; Don't copy first line twice if region includes it. (forward-line 1) (if (< beg (point)) (setq beg (point))) ;; Initialize the temp file with either the header or nothing (if (search-forward tex-start-of-header search-end t) (progn (beginning-of-line) (setq hbeg (point)) ; Mark beginning of header. (if (search-forward tex-end-of-header nil t) (progn (beginning-of-line) (setq hend (point))) ; Mark end of header. (setq hbeg (point-min))))) ; Else no header. ;; Copy header to temp file. (write-region (min hbeg beg) hend tex-out-file t nil) ;; Copy region to temp file. (write-region (max beg hend) end tex-out-file t nil)) ;; This is a kludge to insert the tex-trailer into the tex-out-file. ;; We have to create a special buffer in which to insert ;; the tex-trailer first because there is no function with ;; which to append a literal string directly to a file. (let ((local-tex-trailer texinfo-tex-trailer)) (set-buffer temp-buffer) (erase-buffer) ;; make sure trailer isn't hidden by a comment (insert-string "\n") (if local-tex-trailer (insert-string local-tex-trailer)) (tex-set-buffer-directory temp-buffer zap-directory) (write-region (point-min) (point-max) tex-out-file t nil)) ;;; The following is sufficient in Emacs 19. ;;; (write-region (concat "\n" texinfo-tex-trailer) nil ;;; tex-out-file t nil) )) (tex-set-buffer-directory "*tex-shell*" zap-directory) (tex-send-command tex-shell-cd-command zap-directory) (tex-send-command texinfo-tex-command tex-out-file)) (tex-recenter-output-buffer 0)) (defun texinfo-tex-buffer () "Run TeX on visited file, once or twice, to make a correct `.dvi' file." (interactive) ;; Make sure TeX shell is running. (require 'tex-mode) (if (get-buffer "*tex-shell*") (quit-process (get-process "tex-shell") t) (tex-start-shell)) (cond ((null buffer-file-name) (error "Buffer not visiting any file!")) ((buffer-modified-p) (error "Buffer has been modified since last saved!"))) (setq tex-zap-file buffer-file-name) (tex-send-command tex-shell-cd-command (file-name-directory tex-zap-file)) (tex-send-command texinfo-texi2dvi-command tex-zap-file) (tex-recenter-output-buffer 0)) (defun texinfo-texindex () "Run `texindex' on unsorted index files. The index files are made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer]. This runs the shell command defined by `texinfo-texindex-command'." (interactive) (require 'tex-mode) (tex-send-command texinfo-texindex-command (concat tex-zap-file ".??")) (tex-recenter-output-buffer nil)) (defun texinfo-tex-print () "Print `.dvi' file made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer]. This runs the shell command defined by `tex-dvi-print-command'." (interactive) (require 'tex-mode) (tex-send-command tex-dvi-print-command (concat tex-zap-file ".dvi")) (tex-recenter-output-buffer nil)) (defun texinfo-quit-job () "Quit currently running TeX job, by sending an `x' to it." (interactive) (if (not (get-process "tex-shell")) (error "No TeX shell running")) (tex-send-command "x")) (defun texinfo-delete-from-print-queue (job-number) "Delete job from the line printer spooling queue. You are prompted for the job number (use a number shown by a previous \\[texinfo-show-print-queue] command)." (interactive "nPrinter job number for deletion: ") (require 'tex-mode) (if (tex-shell-running) (tex-kill-job) (tex-start-shell)) (tex-send-command texinfo-delete-from-print-queue-command job-number) (tex-recenter-output-buffer nil)) (provide 'texinfo) ;;; texinfo.el ends here emacs-19.30/lisp/texnfo-upd.el100444 22556 1 232235 6045247020 14677 0ustar erikdaemon;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files ;; Copyright (C) 1989, 1990, 1991, 1992 Free Software Foundation, Inc. ;; Author: Robert J. Chassell ;; Maintainer: bug-texinfo@prep.ai.mit.edu ;; Keywords: maint, tex, docs ;; 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: ;;; Known bug: update commands fail to ignore @ignore. ;;; Summary: how to use the updating commands ; The node and menu updating functions automatically ; * insert missing `@node' lines, ; * insert the `Next', `Previous' and `Up' pointers of a node, ; * 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: ; ; texinfo-update-node (&optional region-p) ; texinfo-every-node-update () ; texinfo-sequential-node-update (&optional region-p) ; ; texinfo-make-menu (&optional region-p) ; texinfo-all-menus-update () ; texinfo-master-menu () ; ; texinfo-insert-node-lines (&optional title-p) ; ; texinfo-indent-menu-description (column &optional region-p) ; The `texinfo-column-for-description' variable specifies the column to ; which menu descriptions are indented. ; Texinfo file structure ; ---------------------- ; To use the updating commands, you must structure your Texinfo file ; hierarchically. Each `@node' line, with the exception of the top ; node, must be accompanied by some kind of section line, such as an ; `@chapter' or `@section' line. Each node-line/section-line ; combination must look like this: ; @node Lists and Tables, Cross References, Structuring, Top ; @comment node-name, next, previous, up ; @chapter Making Lists and Tables ; or like this (without the `@comment' line): ; @node Lists and Tables, Cross References, Structuring, Top ; @chapter Making Lists and Tables ; If the file has a `top' node, it must be called `top' or `Top' and ; be the first node in the file. ;;; The update node functions described in detail ; The `texinfo-update-node' function without an argument inserts ; the correct next, previous and up pointers for the node in which ; point is located (i.e., for the node preceding point). ; With an argument, the `texinfo-update-node' function inserts the ; correct next, previous and up pointers for the nodes inside the ; region. ; It does not matter whether the `@node' line has pre-existing ; `Next', `Previous', or `Up' pointers in it. They are removed. ; The `texinfo-every-node-update' function runs `texinfo-update-node' ; 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 ; point. With an argument, it makes or updates menus for the nodes ; within or part of the marked region. ; Whenever an existing menu is updated, the descriptions from ; that menu are incorporated into the new menu. This is done by copying ; descriptions from the existing menu to the entries in the new menu ; that have the same node names. If the node names are different, the ; descriptions are not copied to the new menu. ; Menu entries that refer to other Info files are removed since they ; are not a node within current buffer. This is a deficiency. ; The `texinfo-all-menus-update' function runs `texinfo-make-menu' ; on the whole buffer. ; The `texinfo-master-menu' function creates an extended menu located ; after the top node. (The file must have a top node.) The function ; first updates all the regular menus in the buffer (incorporating the ; descriptions from pre-existing menus), and then constructs a master ; menu that includes every entry from every other menu. (However, the ; function cannot update an already existing master menu; if one ; exists, it must be removed before calling the function.) ; The `texinfo-indent-menu-description' function indents every ; description in the menu following point, to the specified column. ; Non-nil argument (prefix, if interactive) means indent every ; description in every menu in the region. This function does not ; indent second and subsequent lines of a multi-line description. ; The `texinfo-insert-node-lines' function inserts `@node' before the ; `@chapter', `@section', and such like lines of a region in a Texinfo ; file where the `@node' lines are missing. ; ; With a non-nil argument (prefix, if interactive), the function not ; only inserts `@node' lines but also inserts the chapter or section ; titles as the names of the corresponding nodes; and inserts titles ; as node names in pre-existing `@node' lines that lack names. ; ; Since node names should be more concise than section or chapter ; 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. Make the menu for the section enclosing the node found following point. Non-nil argument (prefix, if interactive) means make or update menus for nodes within or part of the marked region. Whenever a menu exists, and is being updated, the descriptions that are associated with node names in the pre-existing menu are incorporated into the new menu. Otherwise, the nodes' section titles are inserted as descriptions." (interactive "P") (if (not region-p) (let ((level (texinfo-hierarchic-level))) (texinfo-make-one-menu level) (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)) (level (progn ; find section type following point (goto-char (region-beginning)) (texinfo-hierarchic-level)))) (if (= region-end beginning) (error "Please mark a region!")) (save-excursion (save-restriction (widen) (while (texinfo-find-lower-level-node level region-end) (setq level (texinfo-hierarchic-level)) ; new, lower level (texinfo-make-one-menu level)) (while (and (< (point) region-end) (texinfo-find-higher-level-node level region-end)) (setq level (texinfo-hierarchic-level)) (while (texinfo-find-lower-level-node level region-end) (setq level (texinfo-hierarchic-level)) ; new, lower level (texinfo-make-one-menu level)))))) (message "Done...updated menus. You may save the buffer."))) (defun texinfo-make-one-menu (level) "Make a menu of all the appropriate nodes in this section. `Appropriate nodes' are those associated with sections that are at the level specified by LEVEL. Point is left at the end of menu." (let* ((case-fold-search t) (beginning (save-excursion (goto-char (texinfo-update-menu-region-beginning level)) (end-of-line) (point))) (end (texinfo-update-menu-region-end level)) (first (texinfo-menu-first-node beginning end)) (node-name (progn (goto-char beginning) (beginning-of-line) (texinfo-copy-node-name))) (new-menu-list (texinfo-make-menu-list beginning end level))) (if (texinfo-old-menu-p beginning first) (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))) (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)) ;; Using the mark to pass bounds this way ;; is kludgy, but it's not worth fixing. -- rms. (let ((mark-active t)) (texinfo-update-node t)))) (message "Updating all menus in %s ... " (buffer-name)) (sleep-for 2) (push-mark (point-max) t) (goto-char (point-min)) ;; Using the mark to pass bounds this way ;; is kludgy, but it's not worth fixing. -- rms. (let ((mark-active t)) (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."))) (defun texinfo-find-lower-level-node (level region-end) "Search forward from point for node at any level lower than LEVEL. Search is limited to the end of the marked region, REGION-END, and to the end of the menu region for the level. 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) "Search forward from point for node at any higher level than argument LEVEL. Search is limited to the end of the marked region, REGION-END. 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) "Make a list of node names and their descriptions. Point is left at the end of the menu region, but the menu is not inserted. First argument is position from which to start making menu list; second argument is end of region in which to try to locate entries; third argument is the level of the nodes that are the entries. Node names and descriptions are dotted pairs of strings. Each pair is an element of the list. If the description does not exist, the element consists only of the node name." (goto-char beginning) (let (new-menu-list) (while (texinfo-menu-locate-entry-p level end) (setq new-menu-list (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))) (defun texinfo-menu-locate-entry-p (level search-end) "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. The function returns t if the node is found, else nil. It searches forward from point, and leaves point at the beginning of the node. 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 () "Return the node name as a string. Start with point at the beginning of the node line; copy the text after the node command up to the first comma on the line, if any, and return the text as a string. Leaves point at the beginning of the line. If there is no node name, returns an empty string." (save-excursion (buffer-substring (progn (forward-word 1) ; skip over node command (skip-chars-forward " \t") ; and over spaces (point)) (if (search-forward "," (save-excursion (end-of-line) (point)) t) ; bound search (1- (point)) (end-of-line) (point))))) (defun texinfo-copy-section-title () "Return the title of the section as a string. The title is used as a description line in the menu when one does not already exist. Move point to the beginning of the appropriate section line by going to the start of the text matched by last regexp searched for, which must have been done by `texinfo-menu-locate-entry-p'." ;; could use the same re-search as in `texinfo-menu-locate-entry-p' ;; instead of using `match-beginning'; such a variation would be ;; more general, but would waste information already collected (goto-char (match-beginning 7)) ; match section name (buffer-substring (progn (forward-word 1) ; skip over section type (skip-chars-forward " \t") ; and over spaces (point)) (progn (end-of-line) (point)))) ;;; Handling the old menu (defun texinfo-old-menu-p (beginning first) "Move point to the beginning of the menu for this section, if any. Otherwise move point to the end of the first node of this section. Return t if a menu is found, nil otherwise. First argument is the position of the beginning of the section in which the menu will be located; second argument is the position of the first node within the section. If no menu is found, the function inserts two newlines just before the end of the section, and leaves point there where a menu ought to be." (goto-char beginning) (if (not (re-search-forward "^@menu" first 'goto-end)) (progn (insert "\n\n") (forward-line -2) nil) t)) (defun texinfo-incorporate-descriptions (new-menu-list) "Copy the old menu line descriptions that exist to the new menu. 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." (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. ;; ;; 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) (setcdr (car new-menu-list) (texinfo-menu-copy-old-description end-of-menu)))) (setq new-menu-list (cdr new-menu-list))) (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. Point must be located just after the node name. Point left before description. Single argument, END-OF-MENU, is position limiting search." (skip-chars-forward "[:.,\t\n ]+") ;; 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\\)"))) (buffer-substring (point) (save-excursion (re-search-forward "\\(^\\* \\|^@end menu\\)" end-of-menu t) (forward-line -1) (end-of-line) ; go to end of last description line (point))) "")) (defun texinfo-menu-end () "Return position of end of menu. Does not change location of point. Signal an error if not end of menu." (save-excursion (if (re-search-forward "^@end menu" nil t) (point) (error "Menu does not have an end.")))) (defun texinfo-delete-old-menu (beginning first) "Delete the old menu. Point must be in or after menu. First argument is position of the beginning of the section in which the menu will be located; second argument is the position of the first node within the section." ;; No third arg to search, so error if search fails. (re-search-backward "^@menu" beginning) (delete-region (point) (save-excursion (re-search-forward "^@end menu" first) (point)))) ;;; Inserting new menu ;; try 32, but perhaps 24 is better (defvar texinfo-column-for-description 32 "*Column at which descriptions start in a Texinfo menu.") (defun texinfo-insert-menu (menu-list node-name) "Insert formatted menu at point. Indents the first line of the description, if any, to the value of texinfo-column-for-description. MENU-LIST has form: \(\(\"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 ; are useful primarily for indenting a single menu specially. (defun texinfo-indent-menu-description (column &optional region-p) "Indent every description in menu following point to COLUMN. Non-nil argument (prefix, if interactive) means indent every description in every menu in the region. Does not indent second and subsequent lines of a multi-line description." (interactive "nIndent menu descriptions to (column number): \nP") (save-excursion (save-restriction (widen) (if (not region-p) (progn (re-search-forward "^@menu") (texinfo-menu-indent-description column) (message "Indented descriptions in menu. You may save the buffer.")) ;;else (message "Indenting every menu description in region... ") (goto-char (region-beginning)) (while (and (< (point) (region-end)) (texinfo-locate-menu-p)) (forward-line 1) (texinfo-menu-indent-description column)) (message "Indenting done. You may save the buffer."))))) (defun texinfo-menu-indent-description (to-column-number) "Indent the Texinfo file menu description to TO-COLUMN-NUMBER. Start with point just after the word `menu' in the `@menu' line and leave point on the line before the `@end menu' line. Does not indent second and subsequent lines of a multi-line description." (let* ((beginning-of-next-line (point))) (while (< beginning-of-next-line (save-excursion ; beginning of end menu line (goto-char (texinfo-menu-end)) (beginning-of-line) (point))) (if (re-search-forward "\\* \\(.*::\\|.*: [^.,\t\n]+[.,\t]\\)" (texinfo-menu-end) t) (progn (let ((beginning-white-space (point))) (skip-chars-forward " \t") ; skip over spaces (if (looking-at "\\(@\\|\\w\\)+") ; if there is text (progn ;; remove pre-existing indentation (delete-region beginning-white-space (point)) (indent-to-column to-column-number)))))) ;; position point at beginning of next line (forward-line 1) (setq beginning-of-next-line (point))))) ;;; Making the master menu (defun texinfo-master-menu (update-all-nodes-menus-p) "Make a master menu for a whole Texinfo file. Non-nil argument (prefix, if interactive) means first update all existing nodes and menus. Remove pre-existing master menu, if there is one. This function creates a master menu that follows the top node. The master menu includes every entry from all the other menus. It replaces any existing ordinary menu that follows the top node. If called with a non-nil argument, this function first updates all the menus in the buffer (incorporating descriptions from pre-existing menus) before it constructs the master menu. 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'. The master menu has the following format, which is adapted from the recommendation in the Texinfo Manual: * The first part contains the major nodes in the Texinfo file: the nodes for the chapters, chapter-like sections, and the major appendices. This includes the indices, so long as they are in chapter-like sections, such as unnumbered sections. * The second and subsequent parts contain a listing of the other, lower level menus, in order. This way, an inquirer can go directly to a particular node if he or she is searching for specific information. 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 () "Return a list of menu entries and header lines for the master menu. Start with the menu for chapters and indices and then find each following menu and the title of the node preceding that menu. The master menu list has this form: \(\(\(... \"entry-1-2\" \"entry-1\"\) \"title-1\"\) \(\(... \"entry-2-2\" \"entry-2-1\"\) \"title-2\"\) ...\) However, there does not need to be a title field." (let (master-menu-list) (while (texinfo-locate-menu-p) (setq master-menu-list (cons (list (texinfo-copy-menu) (texinfo-copy-menu-title)) master-menu-list))) (reverse master-menu-list))) (defun texinfo-insert-master-menu-list (master-menu-list) "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 "\n --- The Detailed Node Listing ---\n" "String inserted before lower level entries in Texinfo master menu. It comes after the chapter-level menu entries.") (defun texinfo-locate-menu-p () "Find the next menu in the texinfo file. If found, leave point after word `menu' on the `@menu' line, and return t. If a menu is not found, do not move point and return nil." (re-search-forward "\\(^@menu\\)" nil t)) (defun texinfo-copy-menu-title () "Return the title of the section preceding the menu as a string. 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 () "Return the entries of an existing menu as a list. Start with point just after the word `menu' in the `@menu' line and leave point on the line before the `@end menu' line." (let* (this-menu-list (end-of-menu (texinfo-menu-end)) ; position of end of `@end menu' (last-entry (save-excursion ; position of beginning of ; 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) (if (re-search-forward "^\* " end-of-menu t) (progn (setq this-menu-list (cons (buffer-substring (point) ;; copy multi-line descriptions (save-excursion (re-search-forward "\\(^\* \\|^@e\\)" nil t) (- (point) 3))) this-menu-list))))) this-menu-list)) ;;; Determining the hierarchical level in the texinfo file (defun texinfo-specific-section-type () "Return the specific type of next section, as a string. For example, \"unnumberedsubsec\". Return \"top\" for top node. Searches forward for a section. Hence, point must be before the 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-no-properties (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) "Locate beginning of higher level section this section is within. Return position of the beginning of the node line; do not move point. 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) "Locate end of higher level section this section is within. Return position; do not move point. Thus, if this level is a subsection, find the node for the section this subsection is within. 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) "Locate first node of the section the menu will be placed in. Return position; do not move point. The menu will be located just before this position. First argument is the position of the beginning of the section in which the menu will be located; second argument is the position of the end of that region; it limits the search." (save-excursion (goto-char beginning) (forward-line 1) (re-search-forward "^@node" end t) (beginning-of-line) (point))) ;;; Alists and regular expressions for defining hierarchical levels (defvar texinfo-section-to-generic-alist '(("top" . "top") ("chapter" . "chapter") ("unnumbered" . "chapter") ("majorheading" . "chapter") ("chapheading" . "chapter") ("appendix" . "chapter") ("section" . "section") ("unnumberedsec" . "section") ("heading" . "section") ("appendixsec" . "section") ("subsection" . "subsection") ("unnumberedsubsec" . "subsection") ("subheading" . "subsection") ("appendixsubsec" . "subsection") ("subsubsection" . "subsubsection") ("unnumberedsubsubsec" . "subsubsection") ("subsubheading" . "subsubsection") ("appendixsubsubsec" . "subsubsection")) "*An alist of specific and corresponding generic Texinfo section types. The keys are strings specifying specific types of section; the values 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).") (defvar texinfo-chapter-level-regexp "chapter\\|unnumbered \\|appendix \\|majorheading\\|chapheading" "Regular expression matching just the Texinfo chapter level headings.") (defvar texinfo-section-level-regexp "section\\|unnumberedsec\\|heading \\|appendixsec" "Regular expression matching just the Texinfo section level headings.") (defvar texinfo-subsection-level-regexp "subsection\\|unnumberedsubsec\\|subheading\\|appendixsubsec" "Regular expression matching just the Texinfo subsection level headings.") (defvar texinfo-subsubsection-level-regexp "subsubsection\\|unnumberedsubsubsec\\|subsubheading\\|appendixsubsubsec" "Regular expression matching just the Texinfo subsubsection level headings.") (defvar texinfo-update-menu-same-level-regexps '(("top" . "top[ \t]+") ("chapter" . (concat "\\(^@\\)\\(" texinfo-chapter-level-regexp "\\)[ \t]*")) ("section" . (concat "\\(^@\\)\\(" texinfo-section-level-regexp "\\)[ \t]*")) ("subsection" . (concat "\\(^@\\)\\(" texinfo-subsection-level-regexp "\\)[ \t]+")) ("subsubsection" . (concat "\\(^@\\)\\(" texinfo-subsubsection-level-regexp "\\)[ \t]+"))) "*Regexps for searching for same level sections in a Texinfo file. The keys are strings specifying the general hierarchical level in the document; the values are regular expressions.") (defvar texinfo-update-menu-higher-regexps '(("top" . "^@node [ \t]*DIR") ("chapter" . "^@node [ \t]*top[ \t]*\\(,\\|$\\)") ("section" . (concat "\\(^@\\(" texinfo-chapter-level-regexp "\\)[ \t]*\\)")) ("subsection" . (concat "\\(^@\\(" texinfo-section-level-regexp "\\|" texinfo-chapter-level-regexp "\\)[ \t]*\\)")) ("subsubsection" . (concat "\\(^@\\(" texinfo-subsection-level-regexp "\\|" texinfo-section-level-regexp "\\|" texinfo-chapter-level-regexp "\\)[ \t]*\\)"))) "*Regexps for searching for higher level sections in a Texinfo file. The keys are strings specifying the general hierarchical level in the document; the values are regular expressions.") (defvar texinfo-update-menu-lower-regexps '(("top" . (concat "\\(^@\\(" texinfo-chapter-level-regexp "\\|" texinfo-section-level-regexp "\\|" texinfo-subsection-level-regexp "\\|" texinfo-subsubsection-level-regexp "\\)[ \t]*\\)")) ("chapter" . (concat "\\(^@\\(" texinfo-section-level-regexp "\\|" texinfo-subsection-level-regexp "\\|" texinfo-subsubsection-level-regexp "\\)[ \t]*\\)")) ("section" . (concat "\\(^@\\(" texinfo-subsection-level-regexp "\\|" texinfo-subsubsection-level-regexp "\\)[ \t]+\\)")) ("subsection" . (concat "\\(^@\\(" texinfo-subsubsection-level-regexp "\\)[ \t]+\\)")) ("subsubsection" . "nothing lower")) "*Regexps for searching for lower level sections in a Texinfo file. The keys are strings specifying the general hierarchical level in the document; the values are regular expressions.") ;;; Updating a node ;;;###autoload (defun texinfo-update-node (&optional region-p) "Without any prefix argument, update the node in which point is located. Non-nil argument (prefix, if interactive) means update the nodes in the marked region. The functions for creating or updating nodes and menus, and their keybindings, are: texinfo-update-node (&optional region-p) \\[texinfo-update-node] texinfo-every-node-update () \\[texinfo-every-node-update] texinfo-sequential-node-update (&optional region-p) texinfo-make-menu (&optional region-p) \\[texinfo-make-menu] texinfo-all-menus-update () \\[texinfo-all-menus-update] texinfo-master-menu () texinfo-indent-menu-description (column &optional region-p) 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.")) (texinfo-update-the-node) (message "Done...updated the node. You may save the buffer.")) ;; else (let ((auto-fill-function nil) (auto-fill-hook nil) (beginning (region-beginning)) (end (region-end))) (if (= end beginning) (error "Please mark a region!")) (save-restriction (narrow-to-region beginning end) (goto-char beginning) (push-mark (point) t) (while (re-search-forward "^@node" (point-max) t) (beginning-of-line) (texinfo-update-the-node)) (message "Done...updated nodes in region. You may save the buffer."))))) ;;;###autoload (defun texinfo-every-node-update () "Update every node in a Texinfo file." (interactive) (save-excursion (push-mark (point-max) t) (goto-char (point-min)) ;; Using the mark to pass bounds this way ;; is kludgy, but it's not worth fixing. -- rms. (let ((mark-active t)) (texinfo-update-node t)) (message "Done...updated every node. You may save the buffer."))) (defun texinfo-update-the-node () "Update one node. Point must be at the beginning of node line. Leave point at the end of the node line." (texinfo-check-for-node-name) (texinfo-delete-existing-pointers) (message "Updating node: %s ... " (texinfo-copy-node-name)) (save-restriction (widen) (let* ((case-fold-search t) (level (texinfo-hierarchic-level)) (beginning (texinfo-update-menu-region-beginning level)) (end (texinfo-update-menu-region-end level))) (if (string-equal level "top") (texinfo-top-pointer-case) ;; else (texinfo-insert-pointer beginning end level 'next) (texinfo-insert-pointer beginning end level 'previous) (texinfo-insert-pointer beginning end level 'up) (texinfo-clean-up-node-line))))) (defun texinfo-top-pointer-case () "Insert pointers in the Top node. This is a special case. The `Next' pointer is a pointer to a chapter or section at a lower hierarchical level in the file. The `Previous' and `Up' pointers are to `(dir)'. Point must be at the beginning of the node line, and is left at the end of the node line." (texinfo-clean-up-node-line) (insert ", " (save-excursion ;; There may be an @chapter or other such command between ;; the top node line and the next node line, as a title ;; for an `ifinfo' section. This @chapter command must ;; must be skipped. So the procedure is to search for ;; the next `@node' line, and then copy its name. (if (re-search-forward "^@node" nil t) (progn (beginning-of-line) (texinfo-copy-node-name)) " ")) ", (dir), (dir)")) (defun texinfo-check-for-node-name () "Determine whether the node has a node name. Prompt for one if not. 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 () "Delete `Next', `Previous', and `Up' pointers. Starts from the current position of the cursor, and searches forward on the line for a comma and if one is found, deletes the rest of the line, including the comma. Leaves point at beginning of line." (let ((eol-point (save-excursion (end-of-line) (point)))) (if (search-forward "," eol-point t) (delete-region (1- (point)) eol-point))) (beginning-of-line)) (defun texinfo-find-pointer (beginning end level direction) "Move point to section associated with next, previous, or up pointer. Return type of pointer (either 'normal or 'no-pointer). The first and second arguments bound the search for a pointer to the beginning and end, respectively, of the enclosing higher level section. The third argument is a string specifying the general kind of section such as \"chapter\ or \"section\". When looking for the `Next' pointer, the section found will be at the same hierarchical level in the Texinfo file; when looking for the `Previous' pointer, the section found will be at the same or higher hierarchical level in the Texinfo file; when looking for the `Up' pointer, the section found will be at some level higher in the Texinfo file. The fourth argument \(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) "Return the node name preceding the section command. The argument is the kind of section, either normal or no-pointer." (let (name) (cond ((eq kind 'normal) (end-of-line) ; this handles prev node top case (re-search-backward ; when point is already "^@node" ; at the beginning of @node line (save-excursion (forward-line -3)) t) (setq name (texinfo-copy-node-name))) ((eq kind 'no-pointer) (setq name " "))) ; put a blank in the pointer slot name)) (defun texinfo-insert-pointer (beginning end level direction) "Insert the `Next', `Previous' or `Up' node name at point. Move point forward. The first and second arguments bound the search for a pointer to the beginning and end, respectively, of the enclosing higher level section. The third argument is the hierarchical level of the Texinfo file, a string such as \"section\". The fourth argument is direction towards which the pointer is directed, one of `next, `previous, or 'up." (end-of-line) (insert ", " (save-excursion (texinfo-pointer-name (texinfo-find-pointer beginning end level direction))))) (defun texinfo-clean-up-node-line () "Remove extra commas, if any, at end of node line." (end-of-line) (skip-chars-backward ", ") (delete-region (point) (save-excursion (end-of-line) (point)))) ;;; Updating nodes sequentially ; These sequential update functions insert `Next' or `Previous' ; pointers that point to the following or preceding nodes even if they ; are at higher or lower hierarchical levels. This means that if a ; section contains one or more subsections, the section's `Next' ; pointer will point to the subsection and not the following section. ; (The subsection to which `Next' points will most likely be the first ; item on the section's menu.) ;;;###autoload (defun texinfo-sequential-node-update (&optional region-p) "Update one node (or many) in a Texinfo file with sequential pointers. This function causes the `Next' or `Previous' pointer to point to the immediately preceding or following node, even if it is at a higher or lower hierarchical level in the document. Continually pressing `n' or `p' takes you straight through the file. Without any prefix argument, update the node in which point is located. Non-nil argument (prefix, if interactive) means update the nodes in the marked region. This command makes it awkward to navigate among sections and subsections; it should be used only for those documents that are meant to be read like a novel rather than a reference, and for which the Info `g*' command is inadequate." (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.")) (texinfo-sequentially-update-the-node) (message "Done...sequentially updated the node . You may save the buffer.")) ;; else (let ((auto-fill-function nil) (auto-fill-hook nil) (beginning (region-beginning)) (end (region-end))) (if (= end beginning) (error "Please mark a region!")) (save-restriction (narrow-to-region beginning end) (goto-char beginning) (push-mark (point) t) (while (re-search-forward "^@node" (point-max) t) (beginning-of-line) (texinfo-sequentially-update-the-node)) (message "Done...updated the nodes in sequence. You may save the buffer."))))) (defun texinfo-sequentially-update-the-node () "Update one node such that the pointers are sequential. A `Next' or `Previous' pointer points to any preceding or following node, regardless of its hierarchical level." (texinfo-check-for-node-name) (texinfo-delete-existing-pointers) (message "Sequentially updating node: %s ... " (texinfo-copy-node-name)) (save-restriction (widen) (let* ((case-fold-search t) (level (texinfo-hierarchic-level))) (if (string-equal level "top") (texinfo-top-pointer-case) ;; else (texinfo-sequentially-insert-pointer level 'next) (texinfo-sequentially-insert-pointer level 'previous) (texinfo-sequentially-insert-pointer level 'up) (texinfo-clean-up-node-line))))) (defun texinfo-sequentially-find-pointer (level direction) "Find next or previous pointer sequentially in Texinfo file, or up pointer. Move point to section associated with the pointer. Find point even if it is in a different section. Return type of pointer (either 'normal or 'no-pointer). The first argument is a string specifying the general kind of section such as \"chapter\ or \"section\". The section found will be at the same hierarchical level in the Texinfo file, or, in the case of the up pointer, some level higher. The second argument (one of 'next, '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) "Insert the `Next', `Previous' or `Up' node name at point. Move point forward. The first argument is the hierarchical level of the Texinfo file, a string such as \"section\". The second argument is direction, one of `next, `previous, or 'up." (end-of-line) (insert ", " (save-excursion (texinfo-pointer-name (texinfo-sequentially-find-pointer level direction))))) ;;; 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 ;; ;; Read the include file list of an outer Texinfo file and ;; update all highest level nodes in the files listed and insert a ;; main menu in the outer file after its top node. ;; 2. C-u M-x texinfo-multiple-files-update ;; ;; Same as 1, but insert a master menu. (Saves reupdating lower ;; level menus and nodes.) This command simply reads every menu, ;; so if the menus are wrong, the master menu will be wrong. ;; Similarly, if the lower level node pointers are wrong, they ;; will stay wrong. ;; 3. C-u 2 M-x texinfo-multiple-files-update ;; ;; Read the include file list of an outer Texinfo file and ;; update all nodes and menus in the files listed and insert a ;; master menu in the outer file after its top node. ;;; Note: these functions: ;;; ;;; * Do not save or delete any buffers. You may fill up your memory. ;;; * Do not handle any pre-existing nodes in outer file. ;;; Hence, you may need a file for indices. ;;; Auxiliary functions for multiple file updating (defun texinfo-multi-file-included-list (outer-file) "Return a list of the included files in OUTER-FILE." (let ((included-file-list (list outer-file)) start) (save-excursion (switch-to-buffer (find-file-noselect outer-file)) (widen) (goto-char (point-min)) (while (re-search-forward "^@include" nil t) (skip-chars-forward " \t") (setq start (point)) (end-of-line) (skip-chars-backward " \t") (setq included-file-list (cons (buffer-substring start (point)) included-file-list))) (nreverse included-file-list)))) (defun texinfo-copy-next-section-title () "Return the name of the immediately following section as a string. Start with point at the beginning of the node line. Leave point at the same place. If there is no title, returns an empty string." (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 files included in the outer file with `@include' commands. If optional arg UPDATE-EVERYTHING non-nil, update every menu and pointer in each of the included files. Also update the `Top' level node pointers of the outer file. Requirements: * the first file in the FILES list must be the outer file, * each of the included files must contain exactly one highest hierarchical level node, * this node must be the first node in the included file, * each highest hierarchical level node must be of the same type. 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. (switch-to-buffer (find-file-noselect (car (cdr files)))) (widen) (goto-char (point-min)) (if (not (re-search-forward "^@node" nil t)) (error "No `@node' line found in %s !" (buffer-name))) (beginning-of-line) (texinfo-check-for-node-name) (setq next-node-name (texinfo-copy-node-name)) (setq menu-list (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))) (goto-char (point-min)) (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t)) (error "This buffer needs a Top node!")) (beginning-of-line) (texinfo-delete-existing-pointers) (end-of-line) (insert ", " next-node-name ", (dir), (dir)") (beginning-of-line) (setq previous-node-name "Top") (setq files (cdr files)) (while files (if (not (cdr files)) ;; No next file (setq next-node-name "") ;; Else, ;; find the name of the first node in the next file. (switch-to-buffer (find-file-noselect (car (cdr files)))) (widen) (goto-char (point-min)) (if (not (re-search-forward "^@node" nil t)) (error "No `@node' line found in %s !" (buffer-name))) (beginning-of-line) (texinfo-check-for-node-name) (setq next-node-name (texinfo-copy-node-name)) (setq menu-list (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 node to be updated. (switch-to-buffer (find-file-noselect (car files))) (goto-char (point-min)) (if (not (re-search-forward "^@node" nil t)) (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) (insert ", " next-node-name ", " previous-node-name ", " up-node-name) (beginning-of-line) (setq previous-node-name (texinfo-copy-node-name)) (setq files (cdr files))) (nreverse menu-list))) (defun texinfo-multi-files-insert-main-menu (menu-list) "Insert formatted main menu at point. Indents the first line of the description, if any, to the value of texinfo-column-for-description." (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. Menu entries in each file collected using `texinfo-master-menu-list'. The first file in FILES-LIST must be the outer file; the others must be the files included within it. A main menu must already exist." (save-excursion (let (master-menu-list) (while files-list (switch-to-buffer (find-file-noselect (car files-list))) (message "Working on: %s " (current-buffer)) (goto-char (point-min)) (setq master-menu-list (append master-menu-list (texinfo-master-menu-list))) (setq files-list (cdr files-list))) master-menu-list))) ;;; 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: * this command does NOT save any files--you must save the outer file and any modified, included files. * except for the `Top' node, this command does NOT handle any pre-existing nodes in the outer file; hence, indices must be enclosed in an included file. Requirements: * each of the included files must contain exactly one highest hierarchical level node, * this highest node must be the first node in the included file, * each highest hierarchical level node must be of the same type. 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)) (files included-file-list) main-menu-list next-node-name previous-node-name (up-node-name "Top")) ;;; Update the pointers ;;; and collect the names of the nodes and titles (setq main-menu-list (texinfo-multi-file-update files update-everything)) ;;; Insert main menu ;; Go to outer file (switch-to-buffer (find-file-noselect (car included-file-list))) (if (texinfo-old-menu-p (point-min) (save-excursion (re-search-forward "^@include") (beginning-of-line) (point))) ;; If found, leave point after word `menu' on the `@menu' line. (progn (texinfo-incorporate-descriptions main-menu-list) ;; Delete existing menu. (beginning-of-line) (delete-region (point) (save-excursion (re-search-forward "^@end menu") (point))) ;; Insert main menu (texinfo-multi-files-insert-main-menu main-menu-list)) ;; Else no current menu; insert it before `@include' (texinfo-multi-files-insert-main-menu main-menu-list)) ;;; Insert master menu (if make-master-menu (progn ;; First, removing detailed part of any pre-existing master menu (goto-char (point-min)) (if (re-search-forward texinfo-master-menu-header nil 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)))) ;; 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) ;;; texnfo-upd.el ends here emacs-19.30/lisp/text-mode.el100444 12120 1 13151 6023701740 14317 0ustar rmsdaemon;;; text-mode.el --- text mode, and its idiosyncratic commands. ;; Copyright (C) 1985, 1992, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; 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 package provides the fundamental text mode documented in the ;; Emacs user's manual. ;;; Code: (defvar text-mode-syntax-table nil "Syntax table used while in text mode.") (defvar text-mode-abbrev-table nil "Abbrev table used while in text mode.") (define-abbrev-table 'text-mode-abbrev-table ()) (if text-mode-syntax-table () (setq text-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?\" ". " text-mode-syntax-table) (modify-syntax-entry ?\\ ". " text-mode-syntax-table) (modify-syntax-entry ?' "w " text-mode-syntax-table)) (defvar text-mode-map nil "Keymap for Text mode. Many other modes, such as Mail mode, Outline mode and Indented Text mode, inherit all the commands defined in this map.") (if text-mode-map () (setq text-mode-map (make-sparse-keymap)) (define-key text-mode-map "\e\t" 'ispell-complete-word) (define-key text-mode-map "\t" 'tab-to-tab-stop) (define-key text-mode-map "\es" 'center-line) (define-key text-mode-map "\eS" 'center-paragraph)) ;(defun non-saved-text-mode () ; "Like text-mode, but delete auto save file when file is saved for real." ; (text-mode) ; (make-local-variable 'delete-auto-save-files) ; (setq delete-auto-save-files t)) (defun text-mode () "Major mode for editing text intended for humans to read. Special commands: \\{text-mode-map} Turning on Text mode calls the value of the variable `text-mode-hook', if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map text-mode-map) (setq mode-name "Text") (setq major-mode 'text-mode) (setq local-abbrev-table text-mode-abbrev-table) (set-syntax-table text-mode-syntax-table) (run-hooks 'text-mode-hook)) (defvar indented-text-mode-map () "Keymap for Indented Text mode. All the commands defined in Text mode are inherited unless overridden.") (if indented-text-mode-map () ;; Make different definition for TAB before the one in text-mode-map, but ;; share the rest. (let ((newmap (make-sparse-keymap))) (define-key newmap "\t" 'indent-relative) (setq indented-text-mode-map (nconc newmap text-mode-map)))) (defun indented-text-mode () "Major mode for editing text with indented paragraphs. In this mode, paragraphs are delimited only by blank lines. You can thus get the benefit of adaptive filling (see the variable `adaptive-fill-mode'). \\{indented-text-mode-map} Turning on `indented-text-mode' calls the value of the variable `text-mode-hook', if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map text-mode-map) (define-abbrev-table 'text-mode-abbrev-table ()) (setq local-abbrev-table text-mode-abbrev-table) (set-syntax-table text-mode-syntax-table) (make-local-variable 'indent-line-function) (setq indent-line-function 'indent-relative-maybe) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (use-local-map indented-text-mode-map) (setq mode-name "Indented Text") (setq major-mode 'indented-text-mode) (run-hooks 'text-mode-hook 'indented-text-mode-hook)) (defun center-paragraph () "Center each nonblank line in the paragraph at or after point. See `center-line' for more info." (interactive) (save-excursion (forward-paragraph) (or (bolp) (newline 1)) (let ((end (point))) (backward-paragraph) (center-region (point) end)))) (defun center-region (from to) "Center each nonblank line starting in the region. See `center-line' for more info." (interactive "r") (if (> from to) (let ((tem to)) (setq to from from tem))) (save-excursion (save-restriction (narrow-to-region from to) (goto-char from) (while (not (eobp)) (or (save-excursion (skip-chars-forward " \t") (eolp)) (center-line)) (forward-line 1))))) (defun center-line (&optional nlines) "Center the line point is on, within the width specified by `fill-column'. This means adjusting the indentation so that it equals the distance between the end of the text and `fill-column'. The argument NLINES says how many lines to center." (interactive "P") (if nlines (setq nlines (prefix-numeric-value nlines))) (while (not (eq nlines 0)) (save-excursion (let ((lm (current-left-margin)) line-length) (beginning-of-line) (delete-horizontal-space) (end-of-line) (delete-horizontal-space) (setq line-length (current-column)) (if (> (- fill-column lm line-length) 0) (indent-line-to (+ lm (/ (- fill-column lm line-length) 2)))))) (cond ((null nlines) (setq nlines 0)) ((> nlines 0) (setq nlines (1- nlines)) (forward-line 1)) ((< nlines 0) (setq nlines (1+ nlines)) (forward-line -1))))) ;;; text-mode.el ends here emacs-19.30/lisp/thingatpt.el100444 12120 1 15712 6003024447 14420 0ustar rmsdaemon;;; thingatpt.el --- Get the `thing' at point ;; Copyright (C) 1991,1992,1993,1994,1995 Free Software Foundation, Inc. ;; Author: Mike Williams ;; Keywords: extensions, matching, mouse ;; Created: Thu Mar 28 13:48:23 1991 ;; 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. ;;; Commentary: ;; ;; This file provides routines for getting the `thing' at the location of ;; point, whatever that `thing' happens to be. The `thing' is defined by ;; it's beginning and end positions in the buffer. ;; ;; The function bounds-of-thing-at-point finds the beginning and end ;; positions by moving first forward to the end of the `thing', and then ;; backwards to the beginning. By default, it uses the corresponding ;; forward-`thing' operator (eg. forward-word, forward-line). ;; ;; Special cases are allowed for using properties associated with the named ;; `thing': ;; ;; forward-op Function to call to skip forward over a `thing' (or ;; with a negative argument, backward). ;; ;; beginning-op Function to call to skip to the beginning of a `thing'. ;; end-op Function to call to skip to the end of a `thing'. ;; ;; Reliance on existing operators means that many `things' can be accessed ;; without further code: eg. ;; (thing-at-point 'line) ;; (thing-at-point 'page) ;;; Code: ================================================================= (provide 'thingatpt) ;;=== Basic movement ====================================================== ;;;###autoload (defun forward-thing (THING &optional N) "Move forward to the end of the next THING." (let ((forward-op (or (get THING 'forward-op) (intern-soft (format "forward-%s" THING))))) (if (fboundp forward-op) (funcall forward-op (or N 1)) (error "Can't determine how to move over %ss" THING)))) ;;=== General routines ==================================================== ;;;###autoload (defun bounds-of-thing-at-point (THING) "Determine the start and end buffer locations for the THING at point, where THING is an entity for which there is a either a corresponding forward-THING operation, or corresponding beginning-of-THING and end-of-THING operations, eg. 'word, 'sentence, 'defun. Return a cons cell '(start . end) giving the start and end positions." (let ((orig (point))) (condition-case nil (save-excursion (let ((end (progn (funcall (or (get THING 'end-op) (function (lambda () (forward-thing THING 1))))) (point))) (beg (progn (funcall (or (get THING 'beginning-op) (function (lambda () (forward-thing THING -1))))) (point)))) (if (and beg end (<= beg orig) (< orig end)) (cons beg end)))) (error nil)))) ;;;###autoload (defun thing-at-point (THING) "Return the THING at point, where THING is an entity defined by bounds-of-thing-at-point." (let ((bounds (bounds-of-thing-at-point THING))) (if bounds (buffer-substring (car bounds) (cdr bounds))))) ;;=== Go to beginning/end ================================================= (defun beginning-of-thing (THING) (let ((bounds (bounds-of-thing-at-point THING))) (or bounds (error "No %s here" THING)) (goto-char (car bounds)))) (defun end-of-thing (THING) (let ((bounds (bounds-of-thing-at-point THING))) (or bounds (error "No %s here" THING)) (goto-char (cdr bounds)))) ;;=== Special cases ======================================================= ;;--- Lines --- ;; bolp will be false when you click on the last line in the buffer ;; and it has no final newline. (put 'line 'beginning-op (function (lambda () (if (bolp) (forward-line -1) (beginning-of-line))))) ;;--- Sexps --- (defun in-string-p () (let ((orig (point))) (save-excursion (beginning-of-defun) (nth 3 (parse-partial-sexp (point) orig))))) (defun end-of-sexp () (let ((char-syntax (char-syntax (char-after (point))))) (if (or (eq char-syntax ?\)) (and (eq char-syntax ?\") (in-string-p))) (forward-char 1) (forward-sexp 1)))) (put 'sexp 'end-op 'end-of-sexp) ;;--- Lists --- (put 'list 'end-op (function (lambda () (up-list 1)))) (put 'list 'beginning-op 'backward-sexp) ;;--- Filenames --- (defvar file-name-chars "~/A-Za-z0-9---_.${}#%," "Characters allowable in filenames.") (put 'filename 'end-op (function (lambda () (skip-chars-forward file-name-chars)))) (put 'filename 'beginning-op (function (lambda () (skip-chars-backward file-name-chars (point-min))))) ;;--- Whitespace --- (defun forward-whitespace (ARG) (interactive "p") (if (natnump ARG) (re-search-forward "[ \t]+\\|\n" nil nil ARG) (while (< ARG 0) (if (re-search-backward "[ \t]+\\|\n" nil nil) (or (eq (char-after (match-beginning 0)) 10) (skip-chars-backward " \t"))) (setq ARG (1+ ARG))))) ;;--- Buffer --- (put 'buffer 'end-op 'end-of-buffer) (put 'buffer 'beginning-op 'beginning-of-buffer) ;;--- Symbols --- (defun forward-symbol (ARG) (interactive "p") (if (natnump ARG) (re-search-forward "\\(\\sw\\|\\s_\\)+" nil nil ARG) (while (< ARG 0) (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil nil) (skip-syntax-backward "w_")) (setq ARG (1+ ARG))))) ;;--- Syntax blocks --- (defun forward-same-syntax (&optional arg) (interactive "p") (while (< arg 0) (skip-syntax-backward (char-to-string (char-syntax (char-after (1- (point)))))) (setq arg (1+ arg))) (while (> arg 0) (skip-syntax-forward (char-to-string (char-syntax (char-after (point))))) (setq arg (1- arg)))) ;;=== Aliases ============================================================= (defun word-at-point () (thing-at-point 'word)) (defun sentence-at-point () (thing-at-point 'sentence)) (defun read-from-whole-string (STR) "Read a lisp expression from STR, signalling an error if the entire string was not used." (let* ((read-data (read-from-string STR)) (more-left (condition-case nil (progn (read-from-string (substring STR (cdr read-data))) t) (end-of-file nil)))) (if more-left (error "Can't read whole string") (car read-data)))) (defun form-at-point (&optional THING PRED) (let ((sexp (condition-case nil (read-from-whole-string (thing-at-point (or THING 'sexp))) (error nil)))) (if (or (not PRED) (funcall PRED sexp)) sexp))) (defun sexp-at-point () (form-at-point 'sexp)) (defun symbol-at-point () (form-at-point 'sexp 'symbolp)) (defun number-at-point () (form-at-point 'sexp 'numberp)) (defun list-at-point () (form-at-point 'list 'listp)) ;; thingatpt.el ends here. emacs-19.30/lisp/time-stamp.el100444 75424 1 43247 6045263521 14710 0ustar kwzhdaemon;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs ;;; Copyright 1989, 1993, 1994, 1995 Free Software Foundation, Inc. ;;; Maintainer's Time-stamp: <95/09/21 12:32:56 gildea> ;; Maintainer: Stephen Gildea ;; Keywords: tools ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; This file 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: ;;; If you put a time stamp template anywhere in the first 8 lines of a file, ;;; it can be updated every time you save the file. See the top of ;;; time-stamp.el for a sample. The template looks like one of the following: ;;; Time-stamp: <> ;;; Time-stamp: " " ;;; The time stamp is written between the brackets or quotes, resulting in ;;; Time-stamp: <95/01/18 10:20:51 gildea> ;;; Here is an example which puts the file name and time stamp in the binary: ;;; static char *time_stamp = "sdmain.c Time-stamp: <>"; ;;; To activate automatic time stamping in GNU Emacs 19, add this code ;;; to your .emacs file: ;;; (add-hook 'write-file-hooks 'time-stamp) ;;; ;;; In Emacs 18 you will need to do this instead: ;;; (if (not (memq 'time-stamp write-file-hooks)) ;;; (setq write-file-hooks ;;; (cons 'time-stamp write-file-hooks))) ;;; (autoload 'time-stamp "time-stamp" "Update the time stamp in a buffer." t) ;;; See the documentation for the function `time-stamp' for more details. ;;; Change Log: ;;; Originally based on the 19 Dec 88 version of ;;; date.el by John Sturdy ;;; version 2, January 1995: replaced functions with %-escapes ;;; $Id: time-stamp.el,v 1.15 1995/10/31 00:01:15 kwzh Exp $ ;;; Code: (defvar time-stamp-active t "*Non-nil to enable time-stamping of buffers by \\[time-stamp]. Can be toggled by \\[time-stamp-toggle-active]. See also the variable time-stamp-warn-inactive.") (defvar time-stamp-warn-inactive t "*Non-nil to have \\[time-stamp] warn if a buffer did not get time-stamped. A warning is printed if time-stamp-active is nil and the buffer contains a time stamp template that would otherwise have been updated.") (defvar time-stamp-format "%02y/%02m/%02d %02H:%02M:%02S %u" "*Template for the string inserted by \\[time-stamp]. Value may be a string or a list. (Lists are supported only for backward compatibility.) A string is used verbatim except for character sequences beginning with %: %a weekday name: `Monday'. %A gives uppercase: `MONDAY' %b month name: `January'. %B gives uppercase: `JANUARY' %d day of month %H 24-hour clock hour %I 12-hour clock hour %m month number %M minute %p `am' or `pm'. %P gives uppercase: `AM' or `PM' %S seconds %w day number of week, Sunday is 0 %y year: `1995' %z time zone name: `est'. %Z gives uppercase: `EST' Non-date items: %% a literal percent character: `%' %f file name without directory %F gives absolute pathname %s system name %u user's login name %h mail host name Decimal digits between the % and the type character specify the field width. Strings are truncated on the right; numbers on the left. A leading zero causes numbers to be zero-filled. For example, to get the format used by the `date' command, use \"%3a %3b %2d %02H:%02M:%02S %Z %y\"") ;;; Do not change time-stamp-line-limit, time-stamp-start, or ;;; time-stamp-end in your .emacs or you will be incompatible ;;; with other people's files! If you must change them, ;;; do so only in the local variables section of the file itself. (defvar time-stamp-line-limit 8 ;Do not change! "Number of lines at the beginning of a file that are searched. The patterns `time-stamp-start' and `time-stamp-end' must be found on one of the first `time-stamp-line-limit' lines of the file for the file to be time-stamped by \\[time-stamp]. Do not change `time-stamp-line-limit', `time-stamp-start', or `time-stamp-end' for yourself or you will be incompatible with other people's files! If you must change them for some application, do so in the local variables section of the time-stamped file itself.") (defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+" ;Do not change! "Regexp after which the time stamp is written by \\[time-stamp]. See also the variables `time-stamp-end' and `time-stamp-line-limit'. Do not change `time-stamp-line-limit', `time-stamp-start', or `time-stamp-end' for yourself or you will be incompatible with other people's files! If you must change them for some application, do so in the local variables section of the time-stamped file itself.") (defvar time-stamp-end "\\\\?[\">]" ;Do not change! "Regexp marking the text after the time stamp. \\[time-stamp] deletes the text between the first match of `time-stamp-start' and the following match of `time-stamp-end' on the same line, then writes the time stamp specified by `time-stamp-format' between them. Do not change `time-stamp-line-limit', `time-stamp-start', or `time-stamp-end' for yourself or you will be incompatible with other people's files! If you must change them for some application, do so in the local variables section of the time-stamped file itself.") ;;;###autoload (defun time-stamp () "Update the time stamp string in the buffer. If you put a time stamp template anywhere in the first 8 lines of a file, it can be updated every time you save the file. See the top of `time-stamp.el' for a sample. The template looks like one of the following: Time-stamp: <> Time-stamp: \" \" The time stamp is written between the brackets or quotes, resulting in Time-stamp: <95/01/18 10:20:51 gildea> Only does its thing if the variable time-stamp-active is non-nil. Typically used on write-file-hooks for automatic time-stamping. The format of the time stamp is determined by the variable time-stamp-format. The variables time-stamp-line-limit, time-stamp-start, and time-stamp-end control finding the template." (interactive) (let ((case-fold-search nil) (need-to-warn nil)) (if (and (stringp time-stamp-start) (stringp time-stamp-end)) (save-excursion (save-restriction (widen) (goto-char (point-min)) (forward-line time-stamp-line-limit) (let ((start (point-min)) (search-end (point))) (goto-char start) (while (and (< (point) search-end) (re-search-forward time-stamp-start search-end 'move)) (setq start (point)) (end-of-line) (let ((line-end (point))) (goto-char start) (if (re-search-forward time-stamp-end line-end 'move) (progn (if time-stamp-active (let ((end (match-beginning 0))) (delete-region start end) (goto-char start) (insert (time-stamp-string)) (setq end (point)) ;; remove any tabs used to format time stamp (goto-char start) (if (search-forward "\t" end t) (untabify start end))) (if time-stamp-warn-inactive ;; do warning outside save-excursion (setq need-to-warn t))) (setq search-end (point))))))))) ;; don't signal an error in a write-file-hook (message "time-stamp-start or time-stamp-end is not a string") (sit-for 1)) (if need-to-warn (progn (message "Warning: time-stamp-active is off; did not time-stamp buffer.") (sit-for 1)))) ;; be sure to return nil so can be used on write-file-hooks nil) ;;;###autoload (defun time-stamp-toggle-active (&optional arg) "Toggle time-stamp-active, setting whether \\[time-stamp] updates a buffer. With arg, turn time stamping on if and only if arg is positive." (interactive "P") (setq time-stamp-active (if (null arg) (not time-stamp-active) (> (prefix-numeric-value arg) 0))) (message "time-stamp is now %s." (if time-stamp-active "active" "off"))) (defun time-stamp-string () "Generate the new string to be inserted by \\[time-stamp]." (if (stringp time-stamp-format) (time-stamp-strftime time-stamp-format) (time-stamp-fconcat time-stamp-format " "))) ;version 1 compatibility (defconst time-stamp-month-numbers '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6) ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)) "Alist of months and their number.") (defconst time-stamp-month-full-names ["(zero)" "January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December"]) (defconst time-stamp-weekday-numbers '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3) ("Thu" . 4) ("Fri" . 5) ("Sat" . 6)) "Alist of weekdays and their number.") (defconst time-stamp-weekday-full-names ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]) (defun time-stamp-strftime (format &optional time) "Uses a FORMAT to format date, time, file, and user information. Optional second argument TIME will be used instead of the current time. See the description of the variable `time-stamp-format' for a description of the format string." (let ((time-string (cond ((stringp time) time) (time (current-time-string time)) (t (current-time-string)))) (fmt-len (length format)) (ind 0) cur-char (prev-char nil) (result "") field-index field-width field-result (paren-level 0)) (while (< ind fmt-len) (setq cur-char (aref format ind)) (setq result (concat result (cond ((eq cur-char ?%) (setq field-index (1+ ind)) (while (progn (setq ind (1+ ind)) (setq cur-char (if (< ind fmt-len) (aref format ind) ?\0)) (and (<= ?0 cur-char) (>= ?9 cur-char)))) (setq field-width (substring format field-index ind)) ;; eat any additional args to allow for future expansion (while (or (and (<= ?0 cur-char) (>= ?9 cur-char)) (eq ?. cur-char) (eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char) (eq ?- cur-char) (eq ?+ cur-char) (eq ?\ cur-char) (eq ?# cur-char) (and (eq ?\( cur-char) (not (eq prev-char ?\\)) (setq paren-level (1+ paren-level))) (if (and (eq ?\) cur-char) (not (eq prev-char ?\\)) (> paren-level 0)) (setq paren-level (1- paren-level)) (and (> paren-level 0) (< ind fmt-len)))) (setq ind (1+ ind)) (setq prev-char cur-char) (setq cur-char (if (< ind fmt-len) (aref format ind) ?\0))) (setq field-result (cond ((eq cur-char ?%) "%") ((or (eq cur-char ?a) ;weekday name (eq cur-char ?A)) (let ((name (aref time-stamp-weekday-full-names (cdr (assoc (substring time-string 0 3) time-stamp-weekday-numbers))))) (if (eq cur-char ?a) name (upcase name)))) ((or (eq cur-char ?b) ;month name (eq cur-char ?B)) (let ((name (aref time-stamp-month-full-names (cdr (assoc (substring time-string 4 7) time-stamp-month-numbers))))) (if (eq cur-char ?b) name (upcase name)))) ((eq cur-char ?d) ;day of month, 1-31 (string-to-int (substring time-string 8 10))) ((eq cur-char ?H) ;hour, 0-23 (string-to-int (substring time-string 11 13))) ((eq cur-char ?I) ;hour, 1-12 (let ((hour (string-to-int (substring time-string 11 13)))) (cond ((< hour 1) (+ hour 12)) ((> hour 12) (- hour 12)) (t hour)))) ((eq cur-char ?m) ;month number, 1-12 (cdr (assoc (substring time-string 4 7) time-stamp-month-numbers))) ((eq cur-char ?M) ;minute, 0-59 (string-to-int (substring time-string 14 16))) ((or (eq cur-char ?p) ;am or pm (eq cur-char ?P)) (let ((name (if (> 12 (string-to-int (substring time-string 11 13))) "am" "pm"))) (if (eq cur-char ?p) name (upcase name)))) ((eq cur-char ?S) ;seconds, 00-60 (string-to-int (substring time-string 17 19))) ((eq cur-char ?w) ;weekday number, Sunday is 0 (cdr (assoc (substring time-string 0 3) time-stamp-weekday-numbers))) ((eq cur-char ?y) ;year (string-to-int (substring time-string -4))) ((or (eq cur-char ?z) ;time zone (eq cur-char ?Z)) (let ((name (if (fboundp 'current-time-zone) (car (cdr (current-time-zone time)))))) (or name (setq name "")) (if (eq cur-char ?z) (downcase name) (upcase name)))) ((eq cur-char ?f) ;buffer-file-name, base name only (if buffer-file-name (file-name-nondirectory buffer-file-name) "(no file)")) ((eq cur-char ?F) ;buffer-file-name, full path (or buffer-file-name "(no file)")) ((eq cur-char ?s) ;system name (system-name)) ((eq cur-char ?u) ;user name (user-login-name)) ((eq cur-char ?h) ;mail host name (time-stamp-mail-host-name)) )) (if (string-equal field-width "") field-result (let ((padded-result (format (format "%%%s%c" field-width (if (numberp field-result) ?d ?s)) (or field-result "")))) (let ((initial-length (length padded-result)) (desired-length (string-to-int field-width))) (if (> initial-length desired-length) ;; truncate strings on right, numbers on left (if (stringp field-result) (substring padded-result 0 desired-length) (substring padded-result (- desired-length))) padded-result))))) (t (char-to-string cur-char))))) (setq ind (1+ ind))) result)) (defun time-stamp-mail-host-name () "Return the name of the host where the user receives mail. This is the value of `mail-host-address' if bound and a string, otherwise the value of `time-stamp-mail-host' (for versions of Emacs before 19.29) otherwise the value of the function system-name. This function may be usefully referenced by `time-stamp-format'." (or (and (boundp 'mail-host-address) (stringp mail-host-address) mail-host-address) (and (boundp 'time-stamp-mail-host) ;for backward compatibility (stringp time-stamp-mail-host) time-stamp-mail-host) (system-name))) ;;; the rest of this file is for version 1 compatibility (defun time-stamp-fconcat (list sep) "Similar to (mapconcat 'funcall LIST SEP) but LIST allows literals. If an element of LIST is a symbol, it is funcalled to get the string to use; the separator SEP is used between two strings obtained by funcalling a symbol. Otherwise the element itself is inserted; no separator is used around literals." (let ((return-string "") (insert-sep-p nil)) (while list (cond ((symbolp (car list)) (if insert-sep-p (setq return-string (concat return-string sep))) (setq return-string (concat return-string (funcall (car list)))) (setq insert-sep-p t)) (t (setq return-string (concat return-string (car list))) (setq insert-sep-p nil))) (setq list (cdr list))) return-string)) ;;; Some useful functions to use in time-stamp-format ;;; Could generate most of a message-id with ;;; '(time-stamp-yymmdd "" time-stamp-hhmm "@" time-stamp-mail-host-name) ;;; pretty form, suitable for a title page (defun time-stamp-month-dd-yyyy () "Return the current date as a string in \"Month DD, YYYY\" form." (let ((date (current-time-string))) (format "%s %d, %s" (aref time-stamp-month-full-names (cdr (assoc (substring date 4 7) time-stamp-month-numbers))) (string-to-int (substring date 8 10)) (substring date -4)))) ;;; same as __DATE__ in ANSI C (defun time-stamp-mon-dd-yyyy () "Return the current date as a string in \"Mon DD YYYY\" form. The first character of DD is space if the value is less than 10." (let ((date (current-time-string))) (format "%s %2d %s" (substring date 4 7) (string-to-int (substring date 8 10)) (substring date -4)))) ;;; RFC 822 date (defun time-stamp-dd-mon-yy () "Return the current date as a string in \"DD Mon YY\" form." (let ((date (current-time-string))) (format "%02d %s %s" (string-to-int (substring date 8 10)) (substring date 4 7) (substring date -2)))) ;;; RCS 3 date (defun time-stamp-yy/mm/dd () "Return the current date as a string in \"YY/MM/DD\" form." (let ((date (current-time-string))) (format "%s/%02d/%02d" (substring date -2) (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) (string-to-int (substring date 8 10))))) ;;; RCS 5 date (defun time-stamp-yyyy/mm/dd () "Return the current date as a string in \"YYYY/MM/DD\" form." (let ((date (current-time-string))) (format "%s/%02d/%02d" (substring date -4) (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) (string-to-int (substring date 8 10))))) ;;; ISO 8601 date (defun time-stamp-yyyy-mm-dd () "Return the current date as a string in \"YYYY-MM-DD\" form." (let ((date (current-time-string))) (format "%s-%02d-%02d" (substring date -4) (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) (string-to-int (substring date 8 10))))) (defun time-stamp-yymmdd () "Return the current date as a string in \"YYMMDD\" form." (let ((date (current-time-string))) (format "%s%02d%02d" (substring date -2) (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) (string-to-int (substring date 8 10))))) (defun time-stamp-hh:mm:ss () "Return the current time as a string in \"HH:MM:SS\" form." (substring (current-time-string) 11 19)) (defun time-stamp-hhmm () "Return the current time as a string in \"HHMM\" form." (let ((date (current-time-string))) (concat (substring date 11 13) (substring date 14 16)))) (provide 'time-stamp) ;;; time-stamp.el ends here emacs-19.30/lisp/time.el100444 12120 1 15417 6044251367 13366 0ustar rmsdaemon;;; time.el --- display time and load in mode line of Emacs. ;; Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; 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: ;;; Facilities to display current time/date and a new-mail indicator ;;; in the Emacs mode line. The single entry point is `display-time'. ;;; Code: (defvar display-time-mail-file nil "*File name of mail inbox file, for indicating existence of new mail. Non-nil and not a string means don't check for mail. nil means use default, which is system-dependent, and is the same as used by Rmail.") ;;;###autoload (defvar display-time-day-and-date nil "\ *Non-nil means \\[display-time] should display day and date as well as time.") (defvar display-time-process nil) (defvar display-time-interval 60 "*Seconds between updates of time in the mode line.") (defvar display-time-24hr-format nil "*Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23. Nil means 1 <= hh <= 12, and an AM/PM suffix is used.") (defvar display-time-string nil) (defvar display-time-hook nil "* List of functions to be called when the time is updated on the mode line.") (defvar display-time-server-down-time nil "Time when mail file's file system was recorded to be down. If that file system seems to be up, the value is nil.") ;;;###autoload (defun display-time () "Display current time, load level, and mail flag in mode line of each buffer. Updates automatically every minute. If `display-time-day-and-date' is non-nil, the current day and date are displayed as well. After each update, `display-time-hook' is run with `run-hooks'." (interactive) (let ((live (and display-time-process (eq (process-status display-time-process) 'run)))) (if (not live) (progn (if display-time-process (delete-process display-time-process)) (or global-mode-string (setq global-mode-string '(""))) (or (memq 'display-time-string global-mode-string) (setq global-mode-string (append global-mode-string '(display-time-string)))) (setq display-time-string "") ;; Using a pty is wasteful, and the separate session causes ;; annoyance sometimes (some systems kill idle sessions). (let ((process-connection-type nil)) (setq display-time-process (start-process "display-time" nil (expand-file-name "wakeup" exec-directory) (int-to-string display-time-interval)))) (process-kill-without-query display-time-process) (set-process-sentinel display-time-process 'display-time-sentinel) (set-process-filter display-time-process 'display-time-filter))))) (defun display-time-sentinel (proc reason) (or (eq (process-status proc) 'run) (setq display-time-string "")) ;; Force mode-line updates (force-mode-line-update t) (sit-for 0)) (defvar display-time-string-forms '((if display-time-day-and-date (format "%s %s %s " dayname monthname day) "") (format "%s:%s%s" (if display-time-24hr-format 24-hours 12-hours) minutes (if display-time-24hr-format "" am-pm)) load (if mail " Mail" "")) "*A list of expressions governing display of the time in the mode line. This expression is a list of expressions that can involve the keywords `load', `day', `month', and `year', `12-hours', `24-hours', `minutes', `seconds', all numbers in string form, and `monthname', `dayname', `am-pm', and `time-zone' all alphabetic strings, and `mail' a true/nil value. For example, the form '((substring year -2) \"/\" month \"/\" day \" \" 24-hours \":\" minutes \":\" seconds (if time-zone \" (\") time-zone (if time-zone \")\") (if mail \" Mail\" \"\")) would give mode line times like `94/12/30 21:07:48 (UTC)'.") (defun display-time-filter (proc string) (let* ((now (current-time)) (time (current-time-string now)) (load (condition-case () (if (zerop (car (load-average))) "" (let ((str (format " %03d" (car (load-average))))) (concat (substring str 0 -2) "." (substring str -2)))) (error ""))) (mail-spool-file (or display-time-mail-file (getenv "MAIL") (concat rmail-spool-directory (user-login-name)))) (mail (and (stringp mail-spool-file) (or (null display-time-server-down-time) ;; If have been down for 20 min, try again. (> (- (nth 1 (current-time)) display-time-server-down-time) 1200)) (let ((start-time (current-time))) (prog1 (display-time-file-nonempty-p mail-spool-file) (if (> (- (nth 1 (current-time)) (nth 1 start-time)) 20) ;; Record that mail file is not accessible. (setq display-time-server-down-time (nth 1 (current-time))) ;; Record that mail file is accessible. (setq display-time-server-down-time nil)))))) (24-hours (substring time 11 13)) (hour (string-to-int 24-hours)) (12-hours (int-to-string (1+ (% (+ hour 11) 12)))) (am-pm (if (>= hour 12) "pm" "am")) (minutes (substring time 14 16)) (seconds (substring time 17 19)) (time-zone (car (cdr (current-time-zone now)))) (day (substring time 8 10)) (year (substring time 20 24)) (monthname (substring time 4 7)) (month (cdr (assoc monthname '(("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4") ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8") ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12"))))) (dayname (substring time 0 3))) (setq display-time-string (mapconcat 'eval display-time-string-forms "")) ;; This is inside the let binding, but we are not going to document ;; what variables are available. (run-hooks 'display-time-hook)) (force-mode-line-update) ;; Do redisplay right now, if no input pending. (sit-for 0)) (defun display-time-file-nonempty-p (file) (and (file-exists-p file) (< 0 (nth 7 (file-attributes (file-chase-links file)))))) ;;; time.el ends here emacs-19.30/lisp/timer.el100444 12120 1 15754 5664272703 13560 0ustar rmsdaemon;;; timer.el --- run a function with args at some time in future ;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; 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 package gives you the capability to run Emacs Lisp commands at ;; specified times in the future, either as one-shots or periodically. ;; The single entry point is `run-at-time'. ;;; Code: (defvar timer-program (expand-file-name "timer" exec-directory) "The name of the program to run as the timer subprocess. It should normally be in the exec-directory.") (defvar timer-process nil) (defvar timer-alist ()) (defvar timer-out "") (defvar timer-dont-exit nil ;; this is useful for functions which will be doing their own erratic ;; rescheduling or people who otherwise expect to use the process frequently "If non-nil, don't exit the timer process when no more events are pending.") ;; Error symbols for timers (put 'timer-error 'error-conditions '(error timer-error)) (put 'timer-error 'error-message "Timer error") (put 'timer-abnormal-termination 'error-conditions '(error timer-error timer-abnormal-termination)) (put 'timer-abnormal-termination 'error-message "Timer exited abnormally--all events cancelled") (put 'timer-filter-error 'error-conditions '(error timer-error timer-filter-error)) (put 'timer-filter-error 'error-message "Error in timer process filter") ;; This should not be necessary, but on some systems, we get ;; unkillable processes without this. ;; It may be a kernel bug, but that's not certain. (defun timer-kill-emacs-hook () (if timer-process (progn (set-process-sentinel timer-process nil) (set-process-filter timer-process nil) (delete-process timer-process)))) (add-hook 'kill-emacs-hook 'timer-kill-emacs-hook) ;;;###autoload (defun run-at-time (time repeat function &rest args) "Run a function at a time, and optionally on a regular interval. Arguments are TIME, REPEAT, FUNCTION &rest ARGS. TIME, a string, can be specified absolutely or relative to now. TIME can also be an integer, a number of seconds. REPEAT, an integer number of seconds, is the interval on which to repeat the call to the function. If REPEAT is nil or 0, call it just once. Absolute times may be specified in a wide variety of formats; Something of the form `HOUR:MIN:SEC TIMEZONE MONTH/DAY/YEAR', where all fields are numbers, works; the format used by the Unix `date' command works too. Relative times may be specified as a series of numbers followed by units: 1 min denotes one minute from now. min does too. 1 min 5 sec denotes 65 seconds from now. 1 min 2 sec 3 hour 4 day 5 week 6 fortnight 7 month 8 year denotes the sum of all the given durations from now." (interactive "sRun at time: \nNRepeat interval: \naFunction: ") (if (equal repeat 0) (setq repeat nil)) ;; Make TIME a string. (if (integerp time) (setq time (format "%d sec" time))) (cond ((or (not timer-process) (memq (process-status timer-process) '(exit signal nil))) (if timer-process (delete-process timer-process)) (setq timer-process (let ((process-connection-type nil)) (start-process "timer" nil timer-program)) timer-alist nil) (set-process-filter timer-process 'timer-process-filter) (set-process-sentinel timer-process 'timer-process-sentinel) (process-kill-without-query timer-process)) ((eq (process-status timer-process) 'stop) (continue-process timer-process))) ;; There should be a living, breathing timer process now (let* ((token (concat (current-time-string) "-" (length timer-alist))) (elt (list token repeat function args))) (process-send-string timer-process (concat time "@" token "\n")) (setq timer-alist (cons elt timer-alist)) elt)) (defun cancel-timer (elt) "Cancel a timer previously made with `run-at-time'. The argument should be a value previously returned by `run-at-time'. Cancelling the timer means that nothing special will happen at the specified time." (setcar (cdr elt) nil) (setcar (cdr (cdr elt)) 'ignore)) (defun timer-process-filter (proc str) (setq timer-out (concat timer-out str)) (let (do token error) (while (string-match "\n" timer-out) (setq token (substring timer-out 0 (match-beginning 0)) do (assoc token timer-alist) timer-out (substring timer-out (match-end 0))) (cond (do (apply (nth 2 do) (nth 3 do)) ; do it (if (natnump (nth 1 do)) ; reschedule it (send-string proc (concat (nth 1 do) " sec@" (car do) "\n")) (setq timer-alist (delq do timer-alist)))) ((string-match "timer: \\([^:]+\\): \\([^@]*\\)@\\(.*\\)$" token) (setq error (substring token (match-beginning 1) (match-end 1)) do (substring token (match-beginning 2) (match-end 2)) token (assoc (substring token (match-beginning 3) (match-end 3)) timer-alist) timer-alist (delq token timer-alist)) (or timer-alist timer-dont-exit (process-send-eof proc)) ;; Update error message for this particular instance (put 'timer-filter-error 'error-message (format "%s for %s; couldn't set at \"%s\"" error (nth 2 token) do)) (signal 'timer-filter-error (list proc str))))) (or timer-alist timer-dont-exit (process-send-eof proc)))) (defun timer-process-sentinel (proc str) (let ((stat (process-status proc))) (if (eq stat 'stop) (continue-process proc) ;; if it exited normally, presumably it was intentional. ;; if there were no pending events, who cares that it exited? (or (null timer-alist) (eq stat 'exit) (let ((alist timer-alist)) (setq timer-process nil timer-alist nil) (signal 'timer-abnormal-termination (list proc stat str alist)))) ;; Used to set timer-scratch to "", but nothing uses that var. (setq timer-process nil timer-alist nil)))) (defun cancel-function-timers (function) "Cancel all events scheduled by `run-at-time' which would run FUNCTION." (interactive "aCancel timers of function: ") (let ((alist timer-alist)) (while alist (if (eq (nth 2 (car alist)) function) (setq timer-alist (delq (car alist) timer-alist))) (setq alist (cdr alist)))) (or timer-alist timer-dont-exit (process-send-eof timer-process))) (provide 'timer) ;;; timer.el ends here emacs-19.30/lisp/timezone.el100444 12120 1 33344 6045205675 14263 0ustar rmsdaemon;;; timezone.el --- time zone package for GNU Emacs ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. ;; Author: Masanobu Umeda ;; Maintainer: umerin@mse.kyutech.ac.jp ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (provide 'timezone) (defvar timezone-world-timezones '(("PST" . -800) ("PDT" . -700) ("MST" . -700) ("MDT" . -600) ("CST" . -600) ("CDT" . -500) ("EST" . -500) ("EDT" . -400) ("AST" . -400) ;by ("NST" . -330) ;by ("UT" . +000) ("GMT" . +000) ("BST" . +100) ("MET" . +100) ("EET" . +200) ("JST" . +900) ("GMT+1" . +100) ("GMT+2" . +200) ("GMT+3" . +300) ("GMT+4" . +400) ("GMT+5" . +500) ("GMT+6" . +600) ("GMT+7" . +700) ("GMT+8" . +800) ("GMT+9" . +900) ("GMT+10" . +1000) ("GMT+11" . +1100) ("GMT+12" . +1200) ("GMT+13" . +1300) ("GMT-1" . -100) ("GMT-2" . -200) ("GMT-3" . -300) ("GMT-4" . -400) ("GMT-5" . -500) ("GMT-6" . -600) ("GMT-7" . -700) ("GMT-8" . -800) ("GMT-9" . -900) ("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200)) "*Time differentials of timezone from GMT in +-HHMM form. This list is obsolescent, and is present only for backwards compatibility, because time zone names are ambiguous in practice. Use `current-time-zone' instead.") (defvar timezone-months-assoc '(("JAN" . 1)("FEB" . 2)("MAR" . 3) ("APR" . 4)("MAY" . 5)("JUN" . 6) ("JUL" . 7)("AUG" . 8)("SEP" . 9) ("OCT" . 10)("NOV" . 11)("DEC" . 12)) "Alist of first three letters of a month and its numerical representation.") (defun timezone-make-date-arpa-standard (date &optional local timezone) "Convert DATE to an arpanet standard date. Optional 1st argument LOCAL specifies the default local timezone of the DATE; if nil, GMT is assumed. Optional 2nd argument TIMEZONE specifies a time zone to be represented in; if nil, the local time zone is assumed." (let ((new (timezone-fix-time date local timezone))) (timezone-make-arpa-date (aref new 0) (aref new 1) (aref new 2) (timezone-make-time-string (aref new 3) (aref new 4) (aref new 5)) (aref new 6)) )) (defun timezone-make-date-sortable (date &optional local timezone) "Convert DATE to a sortable date string. Optional 1st argument LOCAL specifies the default local timezone of the DATE; if nil, GMT is assumed. Optional 2nd argument TIMEZONE specifies a timezone to be represented in; if nil, the local time zone is assumed." (let ((new (timezone-fix-time date local timezone))) (timezone-make-sortable-date (aref new 0) (aref new 1) (aref new 2) (timezone-make-time-string (aref new 3) (aref new 4) (aref new 5))) )) ;; ;; Parsers and Constructors of Date and Time ;; (defun timezone-make-arpa-date (year month day time &optional timezone) "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME. Optional argument TIMEZONE specifies a time zone." (let ((zone (if (listp timezone) (let* ((m (timezone-zone-to-minute timezone)) (absm (if (< m 0) (- m) m))) (format "%c%02d%02d" (if (< m 0) ?- ?+) (/ absm 60) (% absm 60))) timezone))) (format "%02d %s %04d %s %s" day (capitalize (car (rassq month timezone-months-assoc))) year time zone))) (defun timezone-make-sortable-date (year month day time) "Make sortable date string from YEAR, MONTH, DAY, and TIME." (format "%4d%02d%02d%s" year month day time)) (defun timezone-make-time-string (hour minute second) "Make time string from HOUR, MINUTE, and SECOND." (format "%02d:%02d:%02d" hour minute second)) (defun timezone-parse-date (date) "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE]. 19 is prepended to year if necessary. Timezone may be nil if nothing. Understands the following styles: (1) 14 Apr 89 03:20[:12] [GMT] (2) Fri, 17 Mar 89 4:01[:33] [GMT] (3) Mon Jan 16 16:12[:37] [GMT] 1989 (4) 6 May 1992 1641-JST (Wednesday) (5) 22-AUG-1993 10:59:12.82 (6) Thu, 11 Apr 16:17:12 91 [MET] (7) Mon, 6 Jul 16:47:20 T 1992 [MET]" ;; Get rid of any text properties. (and (stringp date) (or (text-properties-at 0 date) (next-property-change 0 date)) (setq date (copy-sequence date)) (set-text-properties 0 (length date) nil date)) (let ((date (or date "")) (year nil) (month nil) (day nil) (time nil) (zone nil)) ;This may be nil. (cond ((string-match "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\'" date) ;; Styles: (6) and (7) without timezone (setq year 6 month 3 day 2 time 4 zone nil)) ((string-match "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) ;; Styles: (6) and (7) with timezone and buggy timezone (setq year 6 month 3 day 2 time 4 zone 7)) ((string-match "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date) ;; Styles: (1) and (2) without timezone (setq year 3 month 2 day 1 time 4 zone nil)) ((string-match "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) ;; Styles: (1) and (2) with timezone and buggy timezone (setq year 3 month 2 day 1 time 4 zone 5)) ((string-match "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date) ;; Styles: (3) without timezone (setq year 4 month 1 day 2 time 3 zone nil)) ((string-match "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date) ;; Styles: (3) with timezone (setq year 5 month 1 day 2 time 3 zone 4)) ((string-match "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) ;; Styles: (4) with timezone (setq year 3 month 2 day 1 time 4 zone 5)) ((string-match "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\.[0-9]+" date) ;; Styles: (5) without timezone. (setq year 3 month 2 day 1 time 4 zone nil)) ) (if year (progn (setq year (substring date (match-beginning year) (match-end year))) ;; It is now Dec 1992. 8 years before the end of the World. (if (< (length year) 4) (setq year (concat "19" (substring year -2 nil)))) (let ((string (substring date (match-beginning month) (+ (match-beginning month) 3)))) (setq month (int-to-string (cdr (assoc (upcase string) timezone-months-assoc))))) (setq day (substring date (match-beginning day) (match-end day))) (setq time (substring date (match-beginning time) (match-end time))))) (if zone (setq zone (substring date (match-beginning zone) (match-end zone)))) ;; Return a vector. (if year (vector year month day time zone) (vector "0" "0" "0" "0" nil)) )) (defun timezone-parse-time (time) "Parse TIME (HH:MM:SS) and return a vector [hour minute second]. Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM." (let ((time (or time "")) (hour nil) (minute nil) (second nil)) (cond ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" time) ;; HH:MM:SS (setq hour 1 minute 2 second 3)) ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\'" time) ;; HH:MM (setq hour 1 minute 2 second nil)) ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time) ;; HHMMSS (setq hour 1 minute 2 second 3)) ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time) ;; HHMM (setq hour 1 minute 2 second nil)) ) ;; Return [hour minute second] (vector (if hour (substring time (match-beginning hour) (match-end hour)) "0") (if minute (substring time (match-beginning minute) (match-end minute)) "0") (if second (substring time (match-beginning second) (match-end second)) "0")) )) ;; Miscellaneous (defun timezone-zone-to-minute (timezone) "Translate TIMEZONE to an integer minute offset from GMT. TIMEZONE can be a cons cell containing the output of current-time-zone, or an integer of the form +-HHMM, or a time zone name." (cond ((consp timezone) (/ (car timezone) 60)) (timezone (progn (setq timezone (or (cdr (assoc (upcase timezone) timezone-world-timezones)) ;; +900 timezone)) (if (stringp timezone) (setq timezone (string-to-int timezone))) ;; Taking account of minute in timezone. ;; HHMM -> MM (let* ((abszone (abs timezone)) (minutes (+ (* 60 (/ abszone 100)) (% abszone 100)))) (if (< timezone 0) (- minutes) minutes)))) (t 0))) (defun timezone-time-from-absolute (date seconds) "Compute the UTC time equivalent to DATE at time SECONDS after midnight. Return a list suitable as an argument to current-time-zone, or nil if the date cannot be thus represented. DATE is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (let* ((current-time-origin 719162) ;; (timezone-absolute-from-gregorian 1 1 1970) (days (- date current-time-origin)) (seconds-per-day (float 86400)) (seconds (+ seconds (* days seconds-per-day))) (current-time-arithmetic-base (float 65536)) (hi (floor (/ seconds current-time-arithmetic-base))) (hibase (* hi current-time-arithmetic-base)) (lo (floor (- seconds hibase)))) (and (< (abs (- seconds (+ hibase lo))) 2) ;; Check for integer overflow. (cons hi lo)))) (defun timezone-time-zone-from-absolute (date seconds) "Compute the local time zone for DATE at time SECONDS after midnight. Return a list in the same format as current-time-zone's result, or nil if the local time zone could not be computed. DATE is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (and (fboundp 'current-time-zone) (let ((utc-time (timezone-time-from-absolute date seconds))) (and utc-time (let ((zone (current-time-zone utc-time))) (and (car zone) zone)))))) (defun timezone-fix-time (date local timezone) "Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector. If LOCAL is nil, it is assumed to be GMT. If TIMEZONE is nil, use the local time zone." (let* ((date (timezone-parse-date date)) (year (string-to-int (aref date 0))) (year (cond ((< year 50) (+ year 2000)) ((< year 100) (+ year 1900)) (t year))) (month (string-to-int (aref date 1))) (day (string-to-int (aref date 2))) (time (timezone-parse-time (aref date 3))) (hour (string-to-int (aref time 0))) (minute (string-to-int (aref time 1))) (second (string-to-int (aref time 2))) (local (or (aref date 4) local)) ;Use original if defined (timezone (or timezone (timezone-time-zone-from-absolute (timezone-absolute-from-gregorian month day year) (+ second (* 60 (+ minute (* 60 hour))))))) (diff (- (timezone-zone-to-minute timezone) (timezone-zone-to-minute local))) (minute (+ minute diff)) (hour-fix (floor minute 60))) (setq hour (+ hour hour-fix)) (setq minute (- minute (* 60 hour-fix))) ;; HOUR may be larger than 24 or smaller than 0. (cond ((<= 24 hour) ;24 -> 00 (setq hour (- hour 24)) (setq day (1+ day)) (if (< (timezone-last-day-of-month month year) day) (progn (setq month (1+ month)) (setq day 1) (if (< 12 month) (progn (setq month 1) (setq year (1+ year)) )) ))) ((> 0 hour) (setq hour (+ hour 24)) (setq day (1- day)) (if (> 1 day) (progn (setq month (1- month)) (if (> 1 month) (progn (setq month 12) (setq year (1- year)) )) (setq day (timezone-last-day-of-month month year)) ))) ) (vector year month day hour minute second timezone))) ;; Partly copied from Calendar program by Edward M. Reingold. ;; Thanks a lot. (defun timezone-last-day-of-month (month year) "The last day in MONTH during YEAR." (if (and (= month 2) (timezone-leap-year-p year)) 29 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month)))) (defun timezone-leap-year-p (year) "Returns t if YEAR is a Gregorian leap year." (or (and (zerop (% year 4)) (not (zerop (% year 100)))) (zerop (% year 400)))) (defun timezone-day-number (month day year) "Return the day number within the year of the date month/day/year." (let ((day-of-year (+ day (* 31 (1- month))))) (if (> month 2) (progn (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10))) (if (timezone-leap-year-p year) (setq day-of-year (1+ day-of-year))))) day-of-year)) (defun timezone-absolute-from-gregorian (month day year) "The number of days between the Gregorian date 12/31/1 BC and month/day/year. The Gregorian date Sunday, December 31, 1 BC is imaginary." (+ (timezone-day-number month day year);; Days this year (* 365 (1- year));; + Days in prior years (/ (1- year) 4);; + Julian leap years (- (/ (1- year) 100));; - century years (/ (1- year) 400)));; + Gregorian leap years ;;; timezone.el ends here emacs-19.30/lisp/tmm.el100444 12120 1 31044 6052473621 13215 0ustar rmsdaemon;;; tmm.el --- text mode access to menu-bar ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Ilya Zakharevich ;; Maintainer: FSF ;; 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 ============================================================ ;;; To use this package add ;;; (autoload 'tmm-menubar 'tmm "Text mode substitute for menubar" t) ;;; (global-set-key [f10] 'tmm-menubar) ;;; to your .emacs file. You can also add your own access to different ;;; menus available in Window System Emacs modelling definition after ;;; tmm-menubar. (require 'electric) ;;; The following will be localized, added only to pacify the compiler. (defvar tmm-short-cuts) (defvar tmm-old-mb-map nil) (defvar tmm-old-comp-map) (defvar tmm-c-prompt) (defvar tmm-km-list) (defvar tmm-table-undef) ;;;###autoload (define-key global-map "\M-`" 'tmm-menubar) ;;;###autoload (define-key global-map [f10] 'tmm-menubar) ;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar) ;;;###autoload (defun tmm-menubar () "Text-mode emulation of looking and choosing from a menubar. See the documentation for `tmm-prompt'." (interactive) (run-hooks 'menu-bar-update-hook) ;; Obey menu-bar-final-items; put those items last. (let ((menu-bar (tmm-get-keybind [menu-bar]))) (let ((list menu-bar-final-items)) (while list (let ((item (car list))) ;; ITEM is the name of an item that we want to put last. ;; Find it in MENU-BAR and move it to the end. (let ((this-one (assq item menu-bar))) (setq menu-bar (append (delq this-one menu-bar) (list this-one))))) (setq list (cdr list)))) (tmm-prompt menu-bar))) (defvar tmm-mid-prompt "==>" "String to insert between shortcut and menu item or nil.") (defvar tmm-mb-map nil "A place to store minibuffer map.") (defvar tmm-completion-prompt "Press PageUp Key to reach this buffer from the minibuffer. Alternatively, you can use Up/Down keys (or your History keys) to change the item in the minibuffer, and press RET when you are done, or press the marked letters to pick up your choice. Type C-g or ESC ESC ESC to cancel. " "What insert on top of completion buffer.") ;;;###autoload (defun tmm-prompt (bind &optional in-popup) "Text-mode emulation of calling the bindings in keymap. Creates a text-mode menu of possible choices. You can access the elements in the menu: *) Either via history mechanism from minibuffer; *) Or via completion-buffer that is automatically shown. The last alternative is currently a hack, you cannot use mouse reliably. If the optional argument IN-POPUP is set, is argument-compatible with `x-popup-menu', otherwise the argument BIND should be a cdr of sparse keymap." (if in-popup (if bind (setq bind in-popup) (x-popup-menu nil in-popup))) (let (gl-str tmm-km-list out history history-len tmm-table-undef tmm-c-prompt tmm-old-mb-map tmm-old-comp-map tmm-short-cuts) (run-hooks 'activate-menubar-hook) (mapcar (function (lambda (elt) (if (stringp elt) (setq gl-str elt) (and (listp elt) (tmm-get-keymap elt in-popup))))) bind) (and tmm-km-list (progn (if tmm-mid-prompt (setq tmm-km-list (tmm-add-shortcuts tmm-km-list)) t) (setq history (reverse (mapcar 'car tmm-km-list))) (setq history-len (length history)) (setq history (append history history history history)) (setq tmm-c-prompt (nth (1- history-len) history)) (add-hook 'minibuffer-setup-hook 'tmm-add-prompt) (unwind-protect (setq out (completing-read (concat gl-str " (up/down to change, PgUp to menu): ") tmm-km-list nil t nil (cons 'history (* 2 history-len)))) (save-excursion (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt) (if (get-buffer "*Completions*") (progn (set-buffer "*Completions*") (use-local-map tmm-old-comp-map) (bury-buffer (current-buffer))))) ))) (setq bind (cdr (assoc out tmm-km-list))) (and (null bind) (> (length out) (length tmm-c-prompt)) (string= (substring out 0 (length tmm-c-prompt)) tmm-c-prompt) (setq out (substring out (length tmm-c-prompt)) bind (cdr (assoc out tmm-km-list)))) (and (null bind) (setq out (try-completion out tmm-km-list) bind (cdr (assoc out tmm-km-list)))) (setq last-command-event (car bind)) (setq bind (cdr bind)) (if bind (if in-popup (tmm-prompt t bind) (if (keymapp bind) (if (listp bind) (progn (condition-case nil (require 'mouse) (error nil)) (condition-case nil (x-popup-menu nil bind) ; Get the shortcuts (error nil)) (tmm-prompt bind)) (tmm-prompt (symbol-value bind)) ) (if last-command-event (call-interactively bind) bind))) gl-str))) (defun tmm-add-shortcuts (list) "Adds shortcuts to cars of elements of the list. Takes a list of lists with a string as car, returns list with shortcuts added to these cars. Stores a list of all the shortcuts in the free variable `tmm-short-cuts'." (let ((next-shortcut-number 0)) (mapcar (lambda (elt) (let ((str (car elt)) f b) (setq f (upcase (substring str 0 1))) ;; If does not work, try beginning of the other word (if (and (member f tmm-short-cuts) (string-match " \\([^ ]\\)" str)) (setq f (upcase (substring str (setq b (match-beginning 1)) (1+ b))))) ;; If we don't have an unique letter shortcut, ;; pick a digit as a shortcut instead. (if (member f tmm-short-cuts) (if (< next-shortcut-number 10) (setq f (format "%d" next-shortcut-number) next-shortcut-number (1+ next-shortcut-number)) (setq f nil))) (if (null f) elt (setq tmm-short-cuts (cons f tmm-short-cuts)) (cons (concat f tmm-mid-prompt str) (cdr elt))))) (reverse list)))) (defun tmm-define-keys () (mapcar (lambda (str) (define-key (current-local-map) str 'tmm-shortcut) (define-key (current-local-map) (downcase str) 'tmm-shortcut)) tmm-short-cuts) (define-key (current-local-map) [pageup] 'tmm-goto-completions) (define-key (current-local-map) [prior] 'tmm-goto-completions) (define-key (current-local-map) "\ev" 'tmm-goto-completions) (define-key (current-local-map) "\C-n" 'next-history-element) (define-key (current-local-map) "\C-p" 'previous-history-element)) (defun tmm-add-prompt () (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt) (make-local-hook 'minibuffer-exit-hook) (add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t) (let ((win (selected-window))) (setq tmm-old-mb-map (current-local-map)) (use-local-map (append (make-sparse-keymap) tmm-old-mb-map)) (tmm-define-keys) ;; Get window and hide it for electric mode to get correct size (save-window-excursion (let ((completions (mapcar 'car minibuffer-completion-table))) (with-output-to-temp-buffer "*Completions*" (display-completion-list completions))) (set-buffer "*Completions*") (goto-char 1) (insert tmm-completion-prompt) ) (save-excursion (other-window 1) ; Electric-pop-up-window does ; not work in minibuffer (set-buffer (window-buffer (Electric-pop-up-window "*Completions*"))) (setq tmm-old-comp-map (current-local-map)) (use-local-map (append (make-sparse-keymap) tmm-old-comp-map)) (tmm-define-keys) (select-window win) ; Cannot use ; save-window-excursion, since ; it restores the size ) (insert tmm-c-prompt))) (defun tmm-delete-map () (remove-hook 'minibuffer-exit-hook 'tmm-delete-map t) (if tmm-old-mb-map (use-local-map tmm-old-mb-map))) (defun tmm-shortcut () "Choose the shortcut that the user typed." (interactive) (let ((c (upcase (char-to-string last-command-char))) s) (if (member c tmm-short-cuts) (if (equal (buffer-name) "*Completions*") (progn (beginning-of-buffer) (re-search-forward (concat "\\(^\\|[ \t]\\)" c tmm-mid-prompt)) (choose-completion)) (erase-buffer) ; In minibuffer (mapcar (lambda (elt) (if (string= (substring (car elt) 0 (min (1+ (length tmm-mid-prompt)) (length (car elt)))) (concat c tmm-mid-prompt)) (setq s (car elt)))) tmm-km-list) (insert s) (exit-minibuffer))))) (defun tmm-goto-completions () (interactive) (setq tmm-c-prompt (buffer-string)) (erase-buffer) (switch-to-buffer-other-window "*Completions*") (search-forward tmm-c-prompt) (search-backward tmm-c-prompt)) (defun tmm-get-keymap (elt &optional in-x-menu) "Prepends (DOCSTRING EVENT BINDING) to free variable `tmm-km-list'. The values are deduced from the argument ELT, that should be an element of keymap, an `x-popup-menu' argument, or an element of `x-popup-menu' argument (when IN-X-MENU is not-nil). Does it only if it is not already there. Uses free variable `tmm-table-undef' to keep undefined keys." (let (km str cache (event (car elt))) (setq elt (cdr elt)) (if (eq elt 'undefined) (setq tmm-table-undef (cons (cons event nil) tmm-table-undef)) (or (assoc event tmm-table-undef) (and (if (listp elt) (keymapp elt) (fboundp elt)) (setq km elt)) (and (if (listp (cdr-safe elt)) (keymapp (cdr-safe elt)) (fboundp (cdr-safe elt))) (setq km (cdr elt)) (and (stringp (car elt)) (setq str (car elt)))) (and (if (listp (cdr-safe (cdr-safe elt))) (keymapp (cdr-safe (cdr-safe elt))) (fboundp (cdr-safe (cdr-safe elt)))) (setq km (cdr (cdr elt))) (and (stringp (car elt)) (setq str (car elt))) (or (and str (stringp (cdr (car (cdr elt)))) ; keyseq cache (setq cache (cdr (car (cdr elt)))) cache (setq str (concat str cache))) str)) (and (if (listp (cdr-safe (cdr-safe (cdr-safe elt)))) (keymapp (cdr-safe (cdr-safe (cdr-safe elt)))) (fboundp (cdr-safe (cdr-safe (cdr-safe elt))))) ; New style of easy-menu (setq km (cdr (cdr (cdr elt)))) (and (stringp (car elt)) (setq str (car elt))) (or (and str (stringp (cdr (car (cdr (cdr elt))))) ; keyseq cache (setq cache (cdr (car (cdr (cdr elt))))) cache (setq str (concat str cache))) str)) (and (stringp event) ; x-popup or x-popup element (if (or in-x-menu (stringp (car-safe elt))) (setq str event event nil km elt) (setq str event event nil km (cons 'keymap elt)) ))) (and km (stringp km) (setq str km)) (and km str (or (assoc str tmm-km-list) (setq tmm-km-list (cons (cons str (cons event km)) tmm-km-list))) )))) (defun tmm-get-keybind (keyseq) "Return the current binding of KEYSEQ, merging prefix definitions. If KEYSEQ is a prefix key that has local and gloibal bindings, we merge them into a single keymap which shows the proper order of the menu. However, for the menu bar itself, the value does not take account of `menu-bar-final-items'." (let (allbind bind) (setq bind (key-binding keyseq)) ;; If KEYSEQ is a prefix key, then BIND is either nil ;; or a symbol defined as a keymap (which satisfies keymapp). (if (keymapp bind) (setq bind nil)) ;; If we have a non-keymap definition, return that. (or bind (progn ;; Otherwise, it is a prefix, so make a list of the subcommands. ;; Make a list of all the bindings in all the keymaps. (setq allbind (mapcar 'cdr (minor-mode-key-binding keyseq))) (setq allbind (cons (local-key-binding keyseq) allbind)) (setq allbind (cons (global-key-binding keyseq) allbind)) ;; Merge all the elements of ALLBIND into one keymap. (mapcar (lambda (in) (if (and (symbolp in) (keymapp in)) (setq in (symbol-function in))) (and in (keymapp in) (if (keymapp bind) (setq bind (nconc bind (copy-sequence (cdr in)))) (setq bind (copy-sequence in))))) allbind) ;; Return that keymap. bind)))) (add-hook 'calendar-load-hook (lambda () (require 'cal-menu))) (provide 'tmm) ;;; tmm.el ends here emacs-19.30/lisp/tpu-edt.el100444 75424 13 264061 6046045536 13774 0ustar kwzhuser;;; tpu-edt.el --- Emacs emulating TPU emulating EDT ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Rob Riepel ;; Maintainer: Rob Riepel ;; Version: 4.2 ;; Keywords: emulations ;; 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. ;; TPU-edt is based on tpu.el by Jeff Kowalski and Bob Covey. ;;; Commentary: ;; %% TPU-edt -- Emacs emulating TPU emulating EDT ;; %% Contents ;; % Introduction ;; % Differences Between TPU-edt and DEC TPU/edt ;; % Starting TPU-edt ;; % Customizing TPU-edt using the Emacs Initialization File ;; % Regular Expressions in TPU-edt ;; %% Introduction ;; TPU-edt emulates the popular DEC VMS editor EDT (actually, it emulates ;; DEC TPU's EDT emulation, hence the name TPU-edt). TPU-edt features the ;; following TPU/edt functionality: ;; . EDT keypad ;; . On-line help ;; . Repeat counts ;; . Scroll margins ;; . Learn sequences ;; . Free cursor mode ;; . Rectangular cut and paste ;; . Multiple windows and buffers ;; . TPU line-mode REPLACE command ;; . Wild card search and substitution ;; . Configurable through an initialization file ;; . History recall of search strings, file names, and commands ;; Please note that TPU-edt does NOT emulate TPU. It emulates TPU's EDT ;; emulation. Very few TPU line-mode commands are supported. ;; TPU-edt, like it's VMS cousin, works on VT-series terminals with DEC ;; style keyboards. VT terminal emulators, including xterm with the ;; appropriate key translations, work just fine too. ;; TPU-edt works with X-windows. This is accomplished through a TPU-edt X ;; key map. The TPU-edt module tpu-mapper creates this map and stores it ;; in a file. Tpu-mapper will be run automatically the first time you ;; invoke the X-windows version of emacs, or you can run it by hand. See ;; the commentary in tpu-mapper.el for details. ;; %% Differences Between TPU-edt and DEC TPU/edt ;; In some cases, Emacs doesn't support text highlighting, so selected ;; regions are not shown in inverse video. Emacs uses the concept of "the ;; mark". The mark is set at one end of a selected region; the cursor is ;; at the other. The letter "M" appears in the mode line when the mark is ;; set. The native emacs command ^X^X (Control-X twice) exchanges the ;; cursor with the mark; this provides a handy way to find the location of ;; the mark. ;; In TPU the cursor can be either bound or free. Bound means the cursor ;; cannot wander outside the text of the file being edited. Free means ;; the arrow keys can move the cursor past the ends of lines. Free is the ;; default mode in TPU; bound is the only mode in EDT. Bound is the only ;; mode in the base version of TPU-edt; optional extensions add an ;; approximation of free mode, see the commentary in tpu-extras.el for ;; details. ;; Like TPU, emacs uses multiple buffers. Some buffers are used to hold ;; files you are editing; other "internal" buffers are used for emacs' own ;; purposes (like showing you help). Here are some commands for dealing ;; with buffers. ;; Gold-B moves to next buffer, including internal buffers ;; Gold-N moves to next buffer containing a file ;; Gold-M brings up a buffer menu (like TPU "show buffers") ;; Emacs is very fond of throwing up new windows. Dealing with all these ;; windows can be a little confusing at first, so here are a few commands ;; to that may help: ;; Gold-Next_Scr moves to the next window on the screen ;; Gold-Prev_Scr moves to the previous window on the screen ;; Gold-TAB also moves to the next window on the screen ;; Control-x 1 deletes all but the current window ;; Control-x 0 deletes the current window ;; Note that the buffers associated with deleted windows still exist! ;; Like TPU, TPU-edt has a "command" function, invoked with Gold-KP7 or ;; Do. Most of the commands available are emacs commands. Some TPU ;; commands are available, they are: replace, exit, quit, include, and ;; Get (unfortunately, "get" is an internal emacs function, so we are ;; stuck with "Get" - to make life easier, Get is available as Gold-g). ;; TPU-edt supports the recall of commands, file names, and search ;; strings. The history of strings recalled differs slightly from ;; TPU/edt, but it is still very convenient. ;; Help is available! The traditional help keys (Help and PF2) display ;; a small help file showing the default keypad layout, control key ;; functions, and Gold key functions. Pressing any key inside of help ;; splits the screen and prints a description of the function of the ;; pressed key. Gold-PF2 invokes the native emacs help, with it's ;; zillions of options. ;; Thanks to emacs, TPU-edt has some extensions that may make your life ;; easier, or at least more interesting. For example, Gold-r toggles ;; TPU-edt rectangular mode. In rectangular mode, Remove and Insert work ;; on rectangles. Likewise, Gold-* toggles TPU-edt regular expression ;; mode. In regular expression mode Find, Find Next, and the line-mode ;; replace command work with regular expressions. [A regular expression ;; is a pattern that denotes a set of strings; like VMS wildcards.] ;; Emacs also gives TPU-edt the undo and occur functions. Undo does ;; what it says; it undoes the last change. Multiple undos in a row ;; undo multiple changes. For your convenience, undo is available on ;; Gold-u. Occur shows all the lines containing a specific string in ;; another window. Moving to that window, and typing ^C^C (Control-C ;; twice) on a particular line moves you back to the original window ;; at that line. Occur is on Gold-o. ;; Finally, as you edit, remember that all the power of emacs is at ;; your disposal. It really is a fantastic tool. You may even want to ;; take some time and read the emacs tutorial; perhaps not to learn the ;; native emacs key bindings, but to get a feel for all the things ;; emacs can do for you. The emacs tutorial is available from the ;; emacs help function: "Gold-PF2 t" ;; %% Starting TPU-edt ;; All you have to do to start TPU-edt, is turn it on. This can be ;; done from the command line when running emacs. ;; prompt> emacs -f tpu-edt ;; If you've already started emacs, turn on TPU-edt using the tpu-edt ;; command. First press `M-x' (that's usually `ESC' followed by `x') ;; and type `tpu-edt' followed by a carriage return. ;; If you like TPU-edt and want to use it all the time, you can start ;; TPU-edt using the emacs initialization file, .emacs. Simply create ;; a .emacs file in your home directory containing the line: ;; (tpu-edt) ;; That's all you need to do to start TPU-edt. ;; %% Customizing TPU-edt using the Emacs Initialization File ;; The following is a sample emacs initialization file. It shows how to ;; invoke TPU-edt, and how to customize it. ;; ; .emacs - a sample emacs initialization file ;; ; Turn on TPU-edt ;; (tpu-edt) ;; ; Set scroll margins 10% (top) and 15% (bottom). ;; (tpu-set-scroll-margins "10%" "15%") ;; ; Load the vtxxx terminal control functions. ;; (load "vt-control" t) ;; ; TPU-edt treats words like EDT; here's how to add word separators. ;; ; Note that backslash (\) and double quote (") are quoted with '\'. ;; (tpu-add-word-separators "]\\[-_,.\"=+()'/*#:!&;$") ;; ; Emacs is happy to save files without a final newline; other Unix ;; ; programs hate that! Here we make sure that files end with newlines. ;; (setq require-final-newline t) ;; ; Emacs uses Control-s and Control-q. Problems can occur when using ;; ; emacs on terminals that use these codes for flow control (Xon/Xoff ;; ; flow control). These lines disable emacs' use of these characters. ;; (global-unset-key "\C-s") ;; (global-unset-key "\C-q") ;; ; The emacs universal-argument function is very useful. ;; ; This line maps universal-argument to Gold-PF1. ;; (define-key GOLD-SS3-map "P" 'universal-argument) ; Gold-PF1 ;; ; Make KP7 move by paragraphs, instead of pages. ;; (define-key SS3-map "w" 'tpu-paragraph) ; KP7 ;; ; Repeat the preceding mappings for X-windows. ;; (cond ;; (window-system ;; (global-set-key [kp_7] 'tpu-paragraph) ; KP7 ;; (define-key GOLD-map [kp_f1] 'universal-argument))) ; GOLD-PF1 ;; ; Display the TPU-edt version. ;; (tpu-version) ;; %% Regular Expressions in TPU-edt ;; Gold-* toggles TPU-edt regular expression mode. In regular expression ;; mode, find, find next, replace, and substitute accept emacs regular ;; expressions. A complete list of emacs regular expressions can be found ;; using the emacs "info" command (it's somewhat like the VMS help ;; command). Try the following sequence of commands: ;; DO info ;; m emacs ;; Type "q" to quit out of info mode. ;; There is a problem in regular expression mode when searching for empty ;; strings, like beginning-of-line (^) and end-of-line ($). When searching ;; for these strings, find-next may find the current string, instead of the ;; next one. This can cause global replace and substitute commands to loop ;; forever in the same location. For this reason, commands like ;; replace "^" "> " " to beginning of line> ;; replace "$" "00711" ;; may not work properly. ;; Commands like those above are very useful for adding text to the ;; beginning or end of lines. They might work on a line-by-line basis, but ;; go into an infinite loop if the "all" response is specified. If the ;; goal is to add a string to the beginning or end of a particular set of ;; lines TPU-edt provides functions to do this. ;; Gold-^ Add a string at BOL in region or buffer ;; Gold-$ Add a string at EOL in region or buffer ;; There is also a TPU-edt interface to the native emacs string replacement ;; commands. Gold-/ invokes this command. It accepts regular expressions ;; if TPU-edt is in regular expression mode. Given a repeat count, it will ;; perform the replacement without prompting for confirmation. ;; This command replaces empty strings correctly, however, it has its ;; drawbacks. As a native emacs command, it has a different interface ;; than the emulated TPU commands. Also, it works only in the forward ;; direction, regardless of the current TPU-edt direction. ;;; Code: ;;; ;;; Version Information ;;; (defconst tpu-version "4.2" "TPU-edt version number.") ;;; ;;; User Configurable Variables ;;; (defconst tpu-have-ispell t "*If non-nil (default), TPU-edt uses ispell for spell checking.") (defconst tpu-kill-buffers-silently nil "*If non-nil, TPU-edt kills modified buffers without asking.") (defvar tpu-percent-scroll 75 "*Percentage of the screen to scroll for next/previous screen commands.") (defvar tpu-pan-columns 16 "*Number of columns the tpu-pan functions scroll left or right.") ;;; ;;; Emacs version identifiers - currently referenced by ;;; ;;; o tpu-mark o tpu-set-mark ;;; o tpu-string-prompt o tpu-regexp-prompt ;;; o tpu-edt-on o tpu-load-xkeys ;;; o tpu-update-mode-line o mode line section ;;; (defconst tpu-emacs19-p (not (string-lessp emacs-version "19")) "Non-nil if we are running Lucid Emacs or version 19.") (defconst tpu-lucid-emacs19-p (and tpu-emacs19-p (string-match "Lucid" emacs-version)) "Non-nil if we are running Lucid Emacs version 19.") ;;; ;;; Global Keymaps ;;; (defvar CSI-map (make-sparse-keymap) "Maps the CSI function keys on the VT100 keyboard. CSI is DEC's name for the sequence [.") (defvar SS3-map (make-sparse-keymap) "Maps the SS3 function keys on the VT100 keyboard. SS3 is DEC's name for the sequence O.") (defvar GOLD-map (make-keymap) "Maps the function keys on the VT100 keyboard preceeded by PF1. GOLD is the ASCII 7-bit escape sequence OP.") (defvar GOLD-CSI-map (make-sparse-keymap) "Maps the function keys on the VT100 keyboard preceeded by GOLD-CSI.") (defvar GOLD-SS3-map (make-sparse-keymap) "Maps the function keys on the VT100 keyboard preceeded by GOLD-SS3.") (defvar tpu-global-map nil "TPU-edt global keymap.") (defvar tpu-original-global-map (copy-keymap global-map) "Original global keymap.") (and tpu-lucid-emacs19-p (defvar minibuffer-local-ns-map (make-sparse-keymap) "Hack to give Lucid Emacs the same maps as ordinary Emacs.")) ;;; ;;; Global Variables ;;; (defvar tpu-edt-mode nil "If non-nil, TPU-edt mode is active.") (defvar tpu-last-replaced-text "" "Last text deleted by a TPU-edt replace command.") (defvar tpu-last-deleted-region "" "Last text deleted by a TPU-edt remove command.") (defvar tpu-last-deleted-lines "" "Last text deleted by a TPU-edt line-delete command.") (defvar tpu-last-deleted-words "" "Last text deleted by a TPU-edt word-delete command.") (defvar tpu-last-deleted-char "" "Last character deleted by a TPU-edt character-delete command.") (defvar tpu-searching-forward t "If non-nil, TPU-edt is searching in the forward direction.") (defvar tpu-search-last-string "" "Last text searched for by the TPU-edt search commands.") (defvar tpu-regexp-p nil "If non-nil, TPU-edt uses regexp search and replace routines.") (defvar tpu-rectangular-p nil "If non-nil, TPU-edt removes and inserts rectangles.") (defvar tpu-advance t "True when TPU-edt is operating in the forward direction.") (defvar tpu-reverse nil "True when TPU-edt is operating in the backward direction.") (defvar tpu-control-keys nil "If non-nil, control keys are set to perform TPU functions.") (defvar tpu-xkeys-file nil "File containing TPU-edt X key map.") (defvar tpu-rectangle-string nil "Mode line string to identify rectangular mode.") (defvar tpu-direction-string nil "Mode line string to identify current direction.") (defvar tpu-add-at-bol-hist nil "History variable for tpu-edt-add-at-bol function.") (defvar tpu-add-at-eol-hist nil "History variable for tpu-edt-add-at-eol function.") (defvar tpu-regexp-prompt-hist nil "History variable for search and replace functions.") ;;; ;;; Buffer Local Variables ;;; (defvar tpu-newline-and-indent-p nil "If non-nil, Return produces a newline and indents.") (make-variable-buffer-local 'tpu-newline-and-indent-p) (defvar tpu-newline-and-indent-string nil "Mode line string to identify AutoIndent mode.") (make-variable-buffer-local 'tpu-newline-and-indent-string) (defvar tpu-saved-delete-func nil "Saved value of the delete key.") (make-variable-buffer-local 'tpu-saved-delete-func) (defvar tpu-buffer-local-map nil "TPU-edt buffer local key map.") (make-variable-buffer-local 'tpu-buffer-local-map) ;;; ;;; Mode Line - Modify the mode line to show the following ;;; ;;; o If the mark is set. ;;; o Direction of motion. ;;; o Active rectangle mode. ;;; (defvar tpu-original-mode-line mode-line-format) (defvar tpu-original-mm-alist minor-mode-alist) (defvar tpu-mark-flag " ") (make-variable-buffer-local 'tpu-mark-flag) (defun tpu-set-mode-line (for-tpu) "Set the mode for TPU-edt, or reset it to default Emacs." (cond ((not for-tpu) (setq mode-line-format tpu-original-mode-line) (setq minor-mode-alist tpu-original-mm-alist)) (t (setq-default mode-line-format (list (purecopy "") 'mode-line-modified 'mode-line-buffer-identification (purecopy " ") 'global-mode-string (purecopy " ") 'tpu-mark-flag (purecopy " %[(") 'mode-name 'mode-line-process 'minor-mode-alist (purecopy "%n") (purecopy ")%]--") (purecopy '(line-number-mode "L%l--")) (purecopy '(column-number-mode "C%c--")) (purecopy '(-3 . "%p")) (purecopy "-%-"))) (or (assq 'tpu-newline-and-indent-p minor-mode-alist) (setq minor-mode-alist (cons '(tpu-newline-and-indent-p tpu-newline-and-indent-string) minor-mode-alist))) (or (assq 'tpu-rectangular-p minor-mode-alist) (setq minor-mode-alist (cons '(tpu-rectangular-p tpu-rectangle-string) minor-mode-alist))) (or (assq 'tpu-direction-string minor-mode-alist) (setq minor-mode-alist (cons '(tpu-direction-string tpu-direction-string) minor-mode-alist)))))) (defun tpu-update-mode-line nil "Make sure mode-line in the current buffer reflects all changes." (setq tpu-mark-flag (if (tpu-mark) "M" " ")) (cond (tpu-emacs19-p (force-mode-line-update)) (t (set-buffer-modified-p (buffer-modified-p)) (sit-for 0)))) (cond (tpu-lucid-emacs19-p (add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line) (add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line)) (tpu-emacs19-p (add-hook 'activate-mark-hook 'tpu-update-mode-line) (add-hook 'deactivate-mark-hook 'tpu-update-mode-line))) ;;; ;;; Match Markers - ;;; ;;; Set in: Search ;;; ;;; Used in: Replace, Substitute, Store-Text, Cut/Remove, ;;; Append, and Change-Case ;;; (defvar tpu-match-beginning-mark (make-marker)) (defvar tpu-match-end-mark (make-marker)) (defun tpu-set-match nil "Set markers at match beginning and end." ;; Add one to beginning mark so it stays with the first character of ;; the string even if characters are added just before the string. (setq tpu-match-beginning-mark (copy-marker (1+ (match-beginning 0)))) (setq tpu-match-end-mark (copy-marker (match-end 0)))) (defun tpu-unset-match nil "Unset match beginning and end markers." (set-marker tpu-match-beginning-mark nil) (set-marker tpu-match-end-mark nil)) (defun tpu-match-beginning nil "Returns the location of the last match beginning." (1- (marker-position tpu-match-beginning-mark))) (defun tpu-match-end nil "Returns the location of the last match end." (marker-position tpu-match-end-mark)) (defun tpu-check-match nil "Returns t if point is between tpu-match markers. Otherwise sets the tpu-match markers to nil and returns nil." ;; make sure 1- marker is in this buffer ;; 2- point is at or after beginning marker ;; 3- point is before ending marker, or in the case of ;; zero length regions (like bol, or eol) that the ;; beginning, end, and point are equal. (cond ((and (equal (marker-buffer tpu-match-beginning-mark) (current-buffer)) (>= (point) (1- (marker-position tpu-match-beginning-mark))) (or (< (point) (marker-position tpu-match-end-mark)) (and (= (1- (marker-position tpu-match-beginning-mark)) (marker-position tpu-match-end-mark)) (= (marker-position tpu-match-end-mark) (point))))) t) (t (tpu-unset-match) nil))) (defun tpu-show-match-markers nil "Show the values of the match markers." (interactive) (if (markerp tpu-match-beginning-mark) (let ((beg (marker-position tpu-match-beginning-mark))) (message "(%s, %s) in %s -- current %s in %s" (if beg (1- beg) nil) (marker-position tpu-match-end-mark) (marker-buffer tpu-match-end-mark) (point) (current-buffer))))) ;;; ;;; Utilities ;;; (defun tpu-caar (thingy) (car (car thingy))) (defun tpu-cadr (thingy) (car (cdr thingy))) (defun tpu-mark nil "TPU-edt version of the mark function. Return the appropriate value of the mark for the current version of Emacs." (cond (tpu-lucid-emacs19-p (mark (not zmacs-regions))) (tpu-emacs19-p (and mark-active (mark (not transient-mark-mode)))) (t (mark)))) (defun tpu-set-mark (pos) "TPU-edt verion of the `set-mark' function. Sets the mark at POS and activates the region acording to the current version of Emacs." (set-mark pos) (and tpu-lucid-emacs19-p pos (zmacs-activate-region))) (defun tpu-string-prompt (prompt history-symbol) "Read a string with PROMPT." (if tpu-emacs19-p (read-from-minibuffer prompt nil nil nil history-symbol) (read-string prompt))) (defvar tpu-last-answer nil "Most recent response to tpu-y-or-n-p.") (defun tpu-y-or-n-p (prompt &optional not-yes) "Prompt for a y or n answer with positive default. Optional second argument NOT-YES changes default to negative. Like Emacs `y-or-n-p', but also accepts space as y and DEL as n." (message (format "%s[%s]" prompt (if not-yes "n" "y"))) (let ((doit t)) (while doit (setq doit nil) (let ((ans (read-char))) (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\ )) (setq tpu-last-answer t)) ((or (= ans ?n) (= ans ?N) (= ans ?\C-?)) (setq tpu-last-answer nil)) ((= ans ?\r) (setq tpu-last-answer (not not-yes))) (t (setq doit t) (beep) (message (format "Please answer y or n. %s[%s]" prompt (if not-yes "n" "y")))))))) tpu-last-answer) (defun tpu-local-set-key (key func) "Replace a key in the TPU-edt local key map. Create the key map if necessary." (cond ((not (keymapp tpu-buffer-local-map)) (setq tpu-buffer-local-map (if (current-local-map) (copy-keymap (current-local-map)) (make-sparse-keymap))) (use-local-map tpu-buffer-local-map))) (local-set-key key func)) (defun tpu-current-line nil "Return the vertical position of point in the selected window. Top line is 0. Counts each text line only once, even if it wraps." (+ (count-lines (window-start) (point)) (if (= (current-column) 0) 1 0) -1)) ;;; ;;; Breadcrumbs ;;; (defvar tpu-breadcrumb-plist nil "The set of user-defined markers (breadcrumbs), as a plist.") (defun tpu-drop-breadcrumb (num) "Drops a breadcrumb that can be returned to later with goto-breadcrumb." (interactive "p") (put tpu-breadcrumb-plist num (list (current-buffer) (point))) (message "Mark %d set." num)) (defun tpu-goto-breadcrumb (num) "Returns to a breadcrumb set with drop-breadcrumb." (interactive "p") (cond ((get tpu-breadcrumb-plist num) (switch-to-buffer (car (get tpu-breadcrumb-plist num))) (goto-char (tpu-cadr (get tpu-breadcrumb-plist num))) (message "mark %d found." num)) (t (message "mark %d not found." num)))) ;;; ;;; Miscellaneous ;;; (defun tpu-change-case (num) "Change the case of the character under the cursor or region. Accepts a prefix argument of the number of characters to invert." (interactive "p") (cond ((tpu-mark) (let ((beg (region-beginning)) (end (region-end))) (while (> end beg) (funcall (if (= (downcase (char-after beg)) (char-after beg)) 'upcase-region 'downcase-region) beg (1+ beg)) (setq beg (1+ beg))) (tpu-unselect t))) ((tpu-check-match) (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) (while (> end beg) (funcall (if (= (downcase (char-after beg)) (char-after beg)) 'upcase-region 'downcase-region) beg (1+ beg)) (setq beg (1+ beg))) (tpu-unset-match))) (t (while (> num 0) (funcall (if (= (downcase (following-char)) (following-char)) 'upcase-region 'downcase-region) (point) (1+ (point))) (forward-char (if tpu-reverse -1 1)) (setq num (1- num)))))) (defun tpu-fill (num) "Fill paragraph or marked region. With argument, fill and justify." (interactive "P") (cond ((tpu-mark) (fill-region (point) (tpu-mark) num) (tpu-unselect t)) (t (fill-paragraph num)))) (defun tpu-version nil "Print the TPU-edt version number." (interactive) (message "TPU-edt version %s by Rob Riepel (riepel@networking.stanford.edu)" tpu-version)) (defun tpu-reset-screen-size (height width) "Sets the screen size." (interactive "nnew screen height: \nnnew screen width: ") (set-screen-height height) (set-screen-width width)) (defun tpu-toggle-newline-and-indent nil "Toggle between 'newline and indent' and 'simple newline'." (interactive) (cond (tpu-newline-and-indent-p (setq tpu-newline-and-indent-string "") (setq tpu-newline-and-indent-p nil) (tpu-local-set-key "\C-m" 'newline)) (t (setq tpu-newline-and-indent-string " AutoIndent") (setq tpu-newline-and-indent-p t) (tpu-local-set-key "\C-m" 'newline-and-indent))) (tpu-update-mode-line) (and (interactive-p) (message "Carriage return inserts a newline%s" (if tpu-newline-and-indent-p " and indents." ".")))) (defun tpu-spell-check nil "Checks the spelling of the region, or of the entire buffer if no region is selected." (interactive) (cond (tpu-have-ispell (if (tpu-mark) (ispell-region (tpu-mark) (point)) (ispell-buffer))) (t (if (tpu-mark) (spell-region (tpu-mark) (point)) (spell-buffer)))) (if (tpu-mark) (tpu-unselect t))) (defun tpu-toggle-overwrite-mode nil "Switches in and out of overwrite mode" (interactive) (cond (overwrite-mode (tpu-local-set-key "\177" tpu-saved-delete-func) (overwrite-mode 0)) (t (setq tpu-saved-delete-func (local-key-binding "\177")) (tpu-local-set-key "\177" 'picture-backward-clear-column) (overwrite-mode 1)))) (defun tpu-special-insert (num) "Insert a character or control code according to its ASCII decimal value." (interactive "P") (if overwrite-mode (delete-char 1)) (insert (if num num 0))) (defun tpu-quoted-insert (num) "Read next input character and insert it. This is useful for inserting control characters." (interactive "*p") (let ((char (read-char)) ) (if overwrite-mode (delete-char num)) (insert-char char num))) ;;; ;;; TPU line-mode commands ;;; (defun tpu-include (file) "TPU-like include file" (interactive "fInclude file: ") (save-excursion (insert-file file) (message ""))) (defun tpu-get (file) "TPU-like get file" (interactive "FFile to get: ") (find-file file)) (defun tpu-what-line nil "Tells what line the point is on, and the total number of lines in the buffer." (interactive) (if (eobp) (message "You are at the End of Buffer. The last line is %d." (count-lines 1 (point-max))) (message "Line %d of %d" (count-lines 1 (1+ (point))) (count-lines 1 (point-max))))) (defun tpu-exit nil "Exit the way TPU does, save current buffer and ask about others." (interactive) (if (not (eq (recursion-depth) 0)) (exit-recursive-edit) (progn (save-buffer) (save-buffers-kill-emacs)))) (defun tpu-quit nil "Quit the way TPU does, ask to make sure changes should be abandoned." (interactive) (let ((list (buffer-list)) (working t)) (while (and list working) (let ((buffer (car list))) (if (and (buffer-file-name buffer) (buffer-modified-p buffer)) (if (tpu-y-or-n-p "Modifications will not be saved, continue quitting? ") (kill-emacs t) (setq working nil))) (setq list (cdr list)))) (if working (kill-emacs t)))) ;;; ;;; Command and Function Aliases ;;; ;;;###autoload (fset 'tpu-edt-mode 'tpu-edt-on) (fset 'TPU-EDT-MODE 'tpu-edt-on) ;;;###autoload (fset 'tpu-edt 'tpu-edt-on) (fset 'TPU-EDT 'tpu-edt-on) (fset 'exit 'tpu-exit) (fset 'EXIT 'tpu-exit) (fset 'Get 'tpu-get) (fset 'GET 'tpu-get) (fset 'include 'tpu-include) (fset 'INCLUDE 'tpu-include) (fset 'quit 'tpu-quit) (fset 'QUIT 'tpu-quit) (fset 'spell 'tpu-spell-check) (fset 'SPELL 'tpu-spell-check) (fset 'what\ line 'tpu-what-line) (fset 'WHAT\ LINE 'tpu-what-line) (fset 'replace 'tpu-lm-replace) (fset 'REPLACE 'tpu-lm-replace) (fset 'help 'tpu-help) (fset 'HELP 'tpu-help) (fset 'set\ cursor\ free 'tpu-set-cursor-free) (fset 'SET\ CURSOR\ FREE 'tpu-set-cursor-free) (fset 'set\ cursor\ bound 'tpu-set-cursor-bound) (fset 'SET\ CURSOR\ BOUND 'tpu-set-cursor-bound) (fset 'set\ scroll\ margins 'tpu-set-scroll-margins) (fset 'SET\ SCROLL\ MARGINS 'tpu-set-scroll-margins) ;; Around emacs version 18.57, function line-move was renamed to ;; next-line-internal. If we're running under an older emacs, ;; make next-line-internal equivalent to line-move. (if (not (fboundp 'next-line-internal)) (fset 'next-line-internal 'line-move)) ;;; ;;; Help ;;; (defconst tpu-help-keypad-map "\f _______________________ _______________________________ | HELP | Do | | | | | | |KeyDefs| | | | | | | |_______|_______________| |_______|_______|_______|_______| _______________________ _______________________________ | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L | | | |Sto Tex| | key |E-Help | Find |Undel L| |_______|_______|_______| |_______|_______|_______|_______| |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W | | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W| |_______|_______|_______| |_______|_______|_______|_______| |Move up| |Forward|Reverse|Remove | Del C | | Top | |Bottom | Top |Insert |Undel C| _______|_______|_______ |_______|_______|_______|_______| |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | | |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter | |_______|_______|_______| |_______|_______|_______| | | Line |Select | Subs | | Open Line | Reset | | |_______________|_______|_______| ") (defconst tpu-help-text " \n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f Control Characters ^A toggle insert and overwrite ^B recall ^E end of line ^G Cancel current operation ^H beginning of line ^J delete previous word ^K learn ^L insert page break ^R remember (during learn), re-center ^U delete to beginning of line ^V quote ^W refresh ^Z exit ^X^X exchange point and mark - useful for checking region boundaries \n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f Gold- Functions B Next Buffer - display the next buffer (all buffers) C Recall - edit and possibly repeat previous commands E Exit - save current buffer and ask about others G Get - load a file into a new edit buffer I Include - include a file in this buffer K Kill Buffer - abandon edits and delete buffer M Buffer Menu - display a list of all buffers N Next File Buffer - display next buffer containing a file O Occur - show following lines containing REGEXP Q Quit - exit without saving anything R Toggle rectangular mode for remove and insert S Search and substitute - line mode REPLACE command ^T Toggle control key bindings between TPU and emacs U Undo - undo the last edit W Write - save current buffer X Exit - save all modified buffers and exit \n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f More extensive documentation on TPU-edt can be found in the `Commentary' section of tpu-edt.el. This section can be accessed through the standard Emacs help facility using the `p' option. Once you exit TPU-edt Help, one of the following key sequences is sure to get you there. ^h p if you're not yet using TPU-edt Gold-PF2 p if you're using TPU-edt Alternatively, fire up Emacs help from the command prompt, with M-x help-for-help p Where `M-x' might be any of `Gold-KP7', 'Do', or 'ESC-x'. When you successfully invoke this part of the Emacs help facility, you will see a buffer named `*Finder*' listing a number of topics. Look for tpu-edt under `emulations'. \n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f *** No more help, use P to view previous screen") (defvar tpu-help-enter (format "%s" "\eOM")) ; tpu-help enter key symbol (defvar tpu-help-return (format "%s" "\r")) ; tpu-help enter key symbol (defvar tpu-help-N "N") ; tpu-help "N" symbol (defvar tpu-help-n "n") ; tpu-help "n" symbol (defvar tpu-help-P "P") ; tpu-help "P" symbol (defvar tpu-help-p "p") ; tpu-help "p" symbol (defun tpu-help nil "Display TPU-edt help." (interactive) ;; Save current window configuration (save-window-excursion ;; Create and fill help buffer if necessary (if (not (get-buffer "*TPU-edt Help*")) (progn (generate-new-buffer "*TPU-edt Help*") (switch-to-buffer "*TPU-edt Help*") (insert tpu-help-keypad-map) (insert tpu-help-text) (setq buffer-read-only t))) ;; Display the help buffer (switch-to-buffer "*TPU-edt Help*") (delete-other-windows) (tpu-move-to-beginning) (forward-line 1) (tpu-line-to-top-of-window) ;; Prompt for keys to describe, based on screen state (split/not split) (let ((key nil) (fkey nil) (split nil)) (while (not (equal tpu-help-return fkey)) (if split (setq key (read-key-sequence "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, P=prev): ")) (setq key (read-key-sequence "Press the key you want help on (RET to exit, N next screen, P prev screen): "))) ;; Process the read key ;; ;; ENTER - Display just the help window ;; N or n - Next help or describe-key screen ;; P or p - Previous help or describe-key screen ;; RETURN - Exit from TPU-help ;; default - describe the key ;; (setq fkey (format "%s" key)) (cond ((equal tpu-help-enter fkey) (setq split nil) (delete-other-windows)) ((or (equal tpu-help-N fkey) (equal tpu-help-n fkey)) (cond (split (condition-case nil (scroll-other-window 8) (error nil))) (t (forward-page) (forward-line 1) (tpu-line-to-top-of-window)))) ((or (equal tpu-help-P fkey) (equal tpu-help-p fkey)) (cond (split (condition-case nil (scroll-other-window -8) (error nil))) (t (backward-page) (forward-line 1) (tpu-line-to-top-of-window)))) ((not (equal tpu-help-return fkey)) (setq split t) (describe-key key) ;; If the key is undefined, leave the ;; message in the mini-buffer for 3 seconds (if (not (key-binding key)) (sit-for 3)))))))) ;;; ;;; Auto-insert ;;; (defun tpu-insert-escape nil "Inserts an escape character, and so becomes the escape-key alias." (interactive) (insert "\e")) (defun tpu-insert-formfeed nil "Inserts a formfeed character." (interactive) (insert "\C-L")) ;;; ;;; Define key ;;; (defvar tpu-saved-control-r nil "Saved value of Control-r.") (defun tpu-end-define-macro-key (key) "Ends the current macro definition" (interactive "kPress the key you want to use to do what was just learned: ") (end-kbd-macro nil) (global-set-key key last-kbd-macro) (global-set-key "\C-r" tpu-saved-control-r)) (defun tpu-define-macro-key nil "Bind a set of keystrokes to a single key, or key combination." (interactive) (setq tpu-saved-control-r (global-key-binding "\C-r")) (global-set-key "\C-r" 'tpu-end-define-macro-key) (start-kbd-macro nil)) ;;; ;;; Buffers and Windows ;;; (defun tpu-kill-buffer nil "Kills the current buffer. If tpu-kill-buffers-silently is non-nil, kills modified buffers without asking." (interactive) (if tpu-kill-buffers-silently (set-buffer-modified-p nil)) (kill-buffer (current-buffer))) (defun tpu-save-all-buffers-kill-emacs nil "Save all buffers and exit emacs." (interactive) (let ((delete-old-versions t)) (save-buffers-kill-emacs t))) (defun tpu-write-current-buffers nil "Save all modified buffers without exiting." (interactive) (save-some-buffers t)) (defun tpu-next-buffer nil "Go to next buffer in ring." (interactive) (switch-to-buffer (car (reverse (buffer-list))))) (defun tpu-next-file-buffer nil "Go to next buffer in ring that is visiting a file or directory." (interactive) (let ((list (tpu-make-file-buffer-list (buffer-list)))) (setq list (delq (current-buffer) list)) (if (not list) (error "No other buffers.")) (switch-to-buffer (car (reverse list))))) (defun tpu-make-file-buffer-list (buffer-list) "Returns names from BUFFER-LIST excluding those beginning with a space or star." (delq nil (mapcar '(lambda (b) (if (or (= (aref (buffer-name b) 0) ? ) (= (aref (buffer-name b) 0) ?*)) nil b)) buffer-list))) (defun tpu-next-window nil "Move to the next window." (interactive) (if (one-window-p) (message "There is only one window on screen.") (other-window 1))) (defun tpu-previous-window nil "Move to the previous window." (interactive) (if (one-window-p) (message "There is only one window on screen.") (select-window (previous-window)))) ;;; ;;; Search ;;; (defun tpu-toggle-regexp nil "Switches in and out of regular expression search and replace mode." (interactive) (setq tpu-regexp-p (not tpu-regexp-p)) (tpu-set-search) (and (interactive-p) (message "Regular expression search and substitute %sabled." (if tpu-regexp-p "en" "dis")))) (defun tpu-regexp-prompt (prompt) "Read a string, adding 'RE' to the prompt if tpu-regexp-p is set." (let ((re-prompt (concat (if tpu-regexp-p "RE ") prompt))) (if tpu-emacs19-p (read-from-minibuffer re-prompt nil nil nil 'tpu-regexp-prompt-hist) (read-string re-prompt)))) (defun tpu-search nil "Search for a string or regular expression. The search is performed in the current direction." (interactive) (tpu-set-search) (tpu-search-internal "")) (defun tpu-search-forward nil "Search for a string or regular expression. The search is begins in the forward direction." (interactive) (setq tpu-searching-forward t) (tpu-set-search t) (tpu-search-internal "")) (defun tpu-search-reverse nil "Search for a string or regular expression. The search is begins in the reverse direction." (interactive) (setq tpu-searching-forward nil) (tpu-set-search t) (tpu-search-internal "")) (defun tpu-search-again nil "Search for the same string or regular expression as last time. The search is performed in the current direction." (interactive) (tpu-search-internal tpu-search-last-string)) ;; tpu-set-search defines the search functions used by the TPU-edt internal ;; search function. It should be called whenever the direction changes, or ;; the regular expression mode is turned on or off. It can also be called ;; to ensure that the next search will be in the current direction. It is ;; called from: ;; tpu-advance tpu-backup ;; tpu-toggle-regexp tpu-toggle-search-direction (t) ;; tpu-search tpu-lm-replace ;; tpu-search-forward (t) tpu-search-reverse (t) ;; tpu-search-forward-exit (t) tpu-search-backward-exit (t) (defun tpu-set-search (&optional arg) "Set the search functions and set the search direction to the current direction. If an argument is specified, don't set the search direction." (if (not arg) (setq tpu-searching-forward (if tpu-advance t nil))) (cond (tpu-searching-forward (cond (tpu-regexp-p (fset 'tpu-emacs-search 're-search-forward) (fset 'tpu-emacs-rev-search 're-search-backward)) (t (fset 'tpu-emacs-search 'search-forward) (fset 'tpu-emacs-rev-search 'search-backward)))) (t (cond (tpu-regexp-p (fset 'tpu-emacs-search 're-search-backward) (fset 'tpu-emacs-rev-search 're-search-forward)) (t (fset 'tpu-emacs-search 'search-backward) (fset 'tpu-emacs-rev-search 'search-forward)))))) (defun tpu-search-internal (pat &optional quiet) "Search for a string or regular expression." (setq tpu-search-last-string (if (not (string= "" pat)) pat (tpu-regexp-prompt "Search: "))) (tpu-unset-match) (tpu-adjust-search) (let ((case-fold-search (and case-fold-search (tpu-check-search-case tpu-search-last-string)))) (cond ((tpu-emacs-search tpu-search-last-string nil t) (tpu-set-match) (goto-char (tpu-match-beginning))) (t (tpu-adjust-search t) (let ((found nil) (pos nil)) (save-excursion (let ((tpu-searching-forward (not tpu-searching-forward))) (tpu-adjust-search) (setq found (tpu-emacs-rev-search tpu-search-last-string nil t)) (setq pos (match-beginning 0)))) (cond (found (cond ((tpu-y-or-n-p (format "Found in %s direction. Go there? " (if tpu-searching-forward "reverse" "forward"))) (goto-char pos) (tpu-set-match) (tpu-toggle-search-direction)))) (t (if (not quiet) (message "%sSearch failed: \"%s\"" (if tpu-regexp-p "RE " "") tpu-search-last-string))))))))) (fset 'tpu-search-internal-core (symbol-function 'tpu-search-internal)) (defun tpu-check-search-case (string) "Returns t if string contains upper case." ;; if using regexp, elimiate upper case forms (\B \W \S.) (if tpu-regexp-p (let ((pat (copy-sequence string)) (case-fold-search nil) (pos 0)) (while (setq pos (string-match "\\\\\\\\" pat)) (aset pat (+ 1 pos) ?.)) (while (setq pos (string-match "\\\\B" pat)) (aset pat (+ 1 pos) ?.)) (while (setq pos (string-match "\\\\W" pat)) (aset pat (+ 1 pos) ?.)) (while (setq pos (string-match "\\\\S." pat)) (aset pat (+ 1 pos) ?.) (aset pat (+ 2 pos) ?.)) (string-equal pat (downcase pat))) (string-equal string (downcase string)))) (defun tpu-adjust-search (&optional arg) "For forward searches, move forward a character before searching, and backward a character after a failed search. Arg means end of search." (if tpu-searching-forward (cond (arg (if (not (bobp)) (forward-char -1))) (t (if (not (eobp)) (forward-char 1)))))) (defun tpu-toggle-search-direction nil "Toggle the TPU-edt search direction. Used for reversing a search in progress." (interactive) (setq tpu-searching-forward (not tpu-searching-forward)) (tpu-set-search t) (and (interactive-p) (message "Searching %sward." (if tpu-searching-forward "for" "back")))) (defun tpu-search-forward-exit nil "Set search direction forward and exit minibuffer." (interactive) (setq tpu-searching-forward t) (tpu-set-search t) (exit-minibuffer)) (defun tpu-search-backward-exit nil "Set search direction backward and exit minibuffer." (interactive) (setq tpu-searching-forward nil) (tpu-set-search t) (exit-minibuffer)) ;;; ;;; Select / Unselect ;;; (defun tpu-select (&optional quiet) "Sets the mark to define one end of a region." (interactive "P") (cond ((tpu-mark) (tpu-unselect quiet)) (t (tpu-set-mark (point)) (tpu-update-mode-line) (if (not quiet) (message "Move the text cursor to select text."))))) (defun tpu-unselect (&optional quiet) "Removes the mark to unselect the current region." (interactive "P") (setq mark-ring nil) (tpu-set-mark nil) (tpu-update-mode-line) (if (not quiet) (message "Selection canceled."))) ;;; ;;; Delete / Cut ;;; (defun tpu-toggle-rectangle nil "Toggle rectangular mode for remove and insert." (interactive) (setq tpu-rectangular-p (not tpu-rectangular-p)) (setq tpu-rectangle-string (if tpu-rectangular-p " Rect" "")) (tpu-update-mode-line) (and (interactive-p) (message "Rectangular cut and paste %sabled." (if tpu-rectangular-p "en" "dis")))) (defun tpu-arrange-rectangle nil "Adjust point and mark to mark upper left and lower right corners of a rectangle." (let ((mc (current-column)) (pc (progn (exchange-point-and-mark) (current-column)))) (cond ((> (point) (tpu-mark)) ; point on lower line (cond ((> pc mc) ; point @ lower-right (exchange-point-and-mark)) ; point -> upper-left (t ; point @ lower-left (move-to-column-force mc) ; point -> lower-right (exchange-point-and-mark) ; point -> upper-right (move-to-column-force pc)))) ; point -> upper-left (t ; point on upper line (cond ((> pc mc) ; point @ upper-right (move-to-column-force mc) ; point -> upper-left (exchange-point-and-mark) ; point -> lower-left (move-to-column-force pc) ; point -> lower-right (exchange-point-and-mark))))))) ; point -> upper-left (defun tpu-cut-text nil "Delete the selected region. The text is saved for the tpu-paste command." (interactive) (cond ((tpu-mark) (cond (tpu-rectangular-p (tpu-arrange-rectangle) (picture-clear-rectangle (point) (tpu-mark) (not overwrite-mode)) (tpu-unselect t)) (t (setq tpu-last-deleted-region (buffer-substring (tpu-mark) (point))) (delete-region (tpu-mark) (point)) (tpu-unselect t)))) ((tpu-check-match) (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) (setq tpu-last-deleted-region (buffer-substring beg end)) (delete-region beg end) (tpu-unset-match))) (t (error "No selection active.")))) (defun tpu-store-text nil "Copy the selected region to the cut buffer without deleting it. The text is saved for the tpu-paste command." (interactive) (cond ((tpu-mark) (cond (tpu-rectangular-p (save-excursion (tpu-arrange-rectangle) (setq picture-killed-rectangle (extract-rectangle (point) (tpu-mark)))) (tpu-unselect t)) (t (setq tpu-last-deleted-region (buffer-substring (tpu-mark) (point))) (tpu-unselect t)))) ((tpu-check-match) (setq tpu-last-deleted-region (buffer-substring (tpu-match-beginning) (tpu-match-end))) (tpu-unset-match)) (t (error "No selection active.")))) (defun tpu-cut (arg) "Copy selected region to the cut buffer. In the absence of an argument, delete the selected region too." (interactive "P") (if arg (tpu-store-text) (tpu-cut-text))) (defun tpu-append-region (arg) "Append selected region to the tpu-cut buffer. In the absence of an argument, delete the selected region too." (interactive "P") (cond ((tpu-mark) (let ((beg (region-beginning)) (end (region-end))) (setq tpu-last-deleted-region (concat tpu-last-deleted-region (buffer-substring beg end))) (if (not arg) (delete-region beg end)) (tpu-unselect t))) ((tpu-check-match) (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) (setq tpu-last-deleted-region (concat tpu-last-deleted-region (buffer-substring beg end))) (if (not arg) (delete-region beg end)) (tpu-unset-match))) (t (error "No selection active.")))) (defun tpu-delete-current-line (num) "Delete one or specified number of lines after point. This includes the newline character at the end of each line. They are saved for the TPU-edt undelete-lines command." (interactive "p") (let ((beg (point))) (forward-line num) (if (not (eq (preceding-char) ?\n)) (insert "\n")) (setq tpu-last-deleted-lines (buffer-substring beg (point))) (delete-region beg (point)))) (defun tpu-delete-to-eol (num) "Delete text up to end of line. With argument, delete up to to Nth line-end past point. They are saved for the TPU-edt undelete-lines command." (interactive "p") (let ((beg (point))) (forward-char 1) (end-of-line num) (setq tpu-last-deleted-lines (buffer-substring beg (point))) (delete-region beg (point)))) (defun tpu-delete-to-bol (num) "Delete text back to beginning of line. With argument, delete up to to Nth line-end past point. They are saved for the TPU-edt undelete-lines command." (interactive "p") (let ((beg (point))) (tpu-next-beginning-of-line num) (setq tpu-last-deleted-lines (buffer-substring (point) beg)) (delete-region (point) beg))) (defun tpu-delete-current-word (num) "Delete one or specified number of words after point. They are saved for the TPU-edt undelete-words command." (interactive "p") (let ((beg (point))) (tpu-forward-to-word num) (setq tpu-last-deleted-words (buffer-substring beg (point))) (delete-region beg (point)))) (defun tpu-delete-previous-word (num) "Delete one or specified number of words before point. They are saved for the TPU-edt undelete-words command." (interactive "p") (let ((beg (point))) (tpu-backward-to-word num) (setq tpu-last-deleted-words (buffer-substring (point) beg)) (delete-region beg (point)))) (defun tpu-delete-current-char (num) "Delete one or specified number of characters after point. The last character deleted is saved for the TPU-edt undelete-char command." (interactive "p") (while (and (> num 0) (not (eobp))) (setq tpu-last-deleted-char (char-after (point))) (cond (overwrite-mode (picture-clear-column 1) (forward-char 1)) (t (delete-char 1))) (setq num (1- num)))) ;;; ;;; Undelete / Paste ;;; (defun tpu-paste (num) "Insert the last region or rectangle of killed text. With argument reinserts the text that many times." (interactive "p") (while (> num 0) (cond (tpu-rectangular-p (let ((beg (point))) (save-excursion (picture-yank-rectangle (not overwrite-mode)) (message "")) (goto-char beg))) (t (insert tpu-last-deleted-region))) (setq num (1- num)))) (defun tpu-undelete-lines (num) "Insert lines deleted by last TPU-edt line-deletion command. With argument reinserts lines that many times." (interactive "p") (let ((beg (point))) (while (> num 0) (insert tpu-last-deleted-lines) (setq num (1- num))) (goto-char beg))) (defun tpu-undelete-words (num) "Insert words deleted by last TPU-edt word-deletion command. With argument reinserts words that many times." (interactive "p") (let ((beg (point))) (while (> num 0) (insert tpu-last-deleted-words) (setq num (1- num))) (goto-char beg))) (defun tpu-undelete-char (num) "Insert character deleted by last TPU-edt character-deletion command. With argument reinserts the character that many times." (interactive "p") (while (> num 0) (if overwrite-mode (prog1 (forward-char -1) (delete-char 1))) (insert tpu-last-deleted-char) (forward-char -1) (setq num (1- num)))) ;;; ;;; Replace and Substitute ;;; (defun tpu-replace nil "Replace the selected region with the contents of the cut buffer." (interactive) (cond ((tpu-mark) (let ((beg (region-beginning)) (end (region-end))) (setq tpu-last-replaced-text (buffer-substring beg end)) (delete-region beg end) (insert tpu-last-deleted-region) (tpu-unselect t))) ((tpu-check-match) (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) (setq tpu-last-replaced-text (buffer-substring beg end)) (replace-match tpu-last-deleted-region (not case-replace) (not tpu-regexp-p)) (tpu-unset-match))) (t (error "No selection active.")))) (defun tpu-substitute (num) "Replace the selected region with the contents of the cut buffer, and repeat most recent search. A numeric argument serves as a repeat count. A negative argument means replace all occurrences of the search string." (interactive "p") (cond ((or (tpu-mark) (tpu-check-match)) (while (and (not (= num 0)) (or (tpu-mark) (tpu-check-match))) (let ((beg (point))) (tpu-replace) (if tpu-searching-forward (forward-char -1) (goto-char beg)) (if (= num 1) (tpu-search-internal tpu-search-last-string) (tpu-search-internal-core tpu-search-last-string))) (setq num (1- num)))) (t (error "No selection active.")))) (defun tpu-lm-replace (from to) "Interactively search for OLD-string and substitute NEW-string." (interactive (list (tpu-regexp-prompt "Old String: ") (tpu-regexp-prompt "New String: "))) (let ((doit t) (strings 0)) ;; Can't replace null strings (if (string= "" from) (error "No string to replace.")) ;; Find the first occurrence (tpu-set-search) (tpu-search-internal from t) ;; Loop on replace question - yes, no, all, last, or quit. (while doit (if (not (tpu-check-match)) (setq doit nil) (progn (message "Replace? Type Yes, No, All, Last, or Quit: ") (let ((ans (read-char))) (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\r) (= ans ?\ )) (let ((beg (point))) (replace-match to (not case-replace) (not tpu-regexp-p)) (setq strings (1+ strings)) (if tpu-searching-forward (forward-char -1) (goto-char beg))) (tpu-search-internal from t)) ((or (= ans ?n) (= ans ?N) (= ans ?\C-?)) (tpu-search-internal from t)) ((or (= ans ?a) (= ans ?A)) (save-excursion (let ((beg (point))) (replace-match to (not case-replace) (not tpu-regexp-p)) (setq strings (1+ strings)) (if tpu-searching-forward (forward-char -1) (goto-char beg))) (tpu-search-internal-core from t) (while (tpu-check-match) (let ((beg (point))) (replace-match to (not case-replace) (not tpu-regexp-p)) (setq strings (1+ strings)) (if tpu-searching-forward (forward-char -1) (goto-char beg))) (tpu-search-internal-core from t))) (setq doit nil)) ((or (= ans ?l) (= ans ?L)) (let ((beg (point))) (replace-match to (not case-replace) (not tpu-regexp-p)) (setq strings (1+ strings)) (if tpu-searching-forward (forward-char -1) (goto-char beg))) (setq doit nil)) ((or (= ans ?q) (= ans ?Q)) (setq doit nil))))))) (message "Replaced %s occurrence%s." strings (if (not (= 1 strings)) "s" "")))) (defun tpu-emacs-replace (&optional dont-ask) "A TPU-edt interface to the emacs replace functions. If TPU-edt is currently in regular expression mode, the emacs regular expression replace functions are used. If an argument is supplied, replacements are performed without asking. Only works in forward direction." (interactive "P") (cond (dont-ask (setq current-prefix-arg nil) (call-interactively (if tpu-regexp-p 'replace-regexp 'replace-string))) (t (call-interactively (if tpu-regexp-p 'query-replace-regexp 'query-replace))))) (defun tpu-add-at-bol (text) "Add text to the beginning of each line in a region, or each line in the entire buffer if no region is selected." (interactive (list (tpu-string-prompt "String to add: " 'tpu-add-at-bol-hist))) (if (string= "" text) (error "No string specified.")) (cond ((tpu-mark) (save-excursion (if (> (point) (tpu-mark)) (exchange-point-and-mark)) (while (and (< (point) (tpu-mark)) (re-search-forward "^" (tpu-mark) t)) (if (< (point) (tpu-mark)) (replace-match text)))) (tpu-unselect t)) (t (save-excursion (goto-char (point-min)) (while (and (re-search-forward "^" nil t) (not (eobp))) (replace-match text)))))) (defun tpu-add-at-eol (text) "Add text to the end of each line in a region, or each line of the entire buffer if no region is selected." (interactive (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist))) (if (string= "" text) (error "No string specified.")) (cond ((tpu-mark) (save-excursion (if (> (point) (tpu-mark)) (exchange-point-and-mark)) (while (< (point) (tpu-mark)) (end-of-line) (if (<= (point) (tpu-mark)) (insert text)) (forward-line))) (tpu-unselect t)) (t (save-excursion (goto-char (point-min)) (while (not (eobp)) (end-of-line) (insert text) (forward-line)))))) (defun tpu-trim-line-ends nil "Removes trailing whitespace from every line in the buffer." (interactive) (picture-clean)) ;;; ;;; Movement by character ;;; (defun tpu-char (num) "Move to the next character in the current direction. A repeat count means move that many characters." (interactive "p") (if tpu-advance (tpu-forward-char num) (tpu-backward-char num))) (defun tpu-forward-char (num) "Move right ARG characters (left if ARG is negative)." (interactive "p") (forward-char num)) (defun tpu-backward-char (num) "Move left ARG characters (right if ARG is negative)." (interactive "p") (backward-char num)) ;;; ;;; Movement by word ;;; (defconst tpu-word-separator-list '() "List of additional word separators.") (defconst tpu-skip-chars "^ \t" "Characters to skip when moving by word. Additional word separators are added to this string.") (defun tpu-word (num) "Move to the beginning of the next word in the current direction. A repeat count means move that many words." (interactive "p") (if tpu-advance (tpu-forward-to-word num) (tpu-backward-to-word num))) (defun tpu-forward-to-word (num) "Move forward until encountering the beginning of a word. With argument, do this that many times." (interactive "p") (while (and (> num 0) (not (eobp))) (let* ((beg (point)) (end (prog2 (end-of-line) (point) (goto-char beg)))) (cond ((eolp) (forward-char 1)) ((memq (char-after (point)) tpu-word-separator-list) (forward-char 1) (skip-chars-forward " \t" end)) (t (skip-chars-forward tpu-skip-chars end) (skip-chars-forward " \t" end)))) (setq num (1- num)))) (defun tpu-backward-to-word (num) "Move backward until encountering the beginning of a word. With argument, do this that many times." (interactive "p") (while (and (> num 0) (not (bobp))) (let* ((beg (point)) (end (prog2 (beginning-of-line) (point) (goto-char beg)))) (cond ((bolp) ( forward-char -1)) ((memq (char-after (1- (point))) tpu-word-separator-list) (forward-char -1)) (t (skip-chars-backward " \t" end) (skip-chars-backward tpu-skip-chars end) (if (and (not (bolp)) (= ? (char-syntax (char-after (point))))) (forward-char -1))))) (setq num (1- num)))) (defun tpu-add-word-separators (separators) "Add new word separators for TPU-edt word commands." (interactive "sSeparators: ") (let* ((n 0) (length (length separators))) (while (< n length) (let ((char (aref separators n)) (ss (substring separators n (1+ n)))) (cond ((not (memq char tpu-word-separator-list)) (setq tpu-word-separator-list (append ss tpu-word-separator-list)) (cond ((= char ?-) (setq tpu-skip-chars (concat tpu-skip-chars "\\-"))) ((= char ?\\) (setq tpu-skip-chars (concat tpu-skip-chars "\\\\"))) ((= char ?^) (setq tpu-skip-chars (concat tpu-skip-chars "\\^"))) (t (setq tpu-skip-chars (concat tpu-skip-chars ss)))))) (setq n (1+ n)))))) (defun tpu-reset-word-separators nil "Reset word separators to default value." (interactive) (setq tpu-word-separator-list nil) (setq tpu-skip-chars "^ \t")) (defun tpu-set-word-separators (separators) "Set new word separators for TPU-edt word commands." (interactive "sSeparators: ") (tpu-reset-word-separators) (tpu-add-word-separators separators)) ;;; ;;; Movement by line ;;; (defun tpu-next-line (num) "Move to next line. Prefix argument serves as a repeat count." (interactive "p") (next-line-internal num) (setq this-command 'next-line)) (defun tpu-previous-line (num) "Move to previous line. Prefix argument serves as a repeat count." (interactive "p") (next-line-internal (- num)) (setq this-command 'previous-line)) (defun tpu-next-beginning-of-line (num) "Move to beginning of line; if at beginning, move to beginning of next line. Accepts a prefix argument for the number of lines to move." (interactive "p") (backward-char 1) (forward-line (- 1 num))) (defun tpu-end-of-line (num) "Move to the next end of line in the current direction. A repeat count means move that many lines." (interactive "p") (if tpu-advance (tpu-next-end-of-line num) (tpu-previous-end-of-line num))) (defun tpu-next-end-of-line (num) "Move to end of line; if at end, move to end of next line. Accepts a prefix argument for the number of lines to move." (interactive "p") (forward-char 1) (end-of-line num)) (defun tpu-previous-end-of-line (num) "Move EOL upward. Accepts a prefix argument for the number of lines to move." (interactive "p") (end-of-line (- 1 num))) (defun tpu-current-end-of-line nil "Move point to end of current line." (interactive) (let ((beg (point))) (end-of-line) (if (= beg (point)) (message "You are already at the end of a line.")))) (defun tpu-line (num) "Move to the beginning of the next line in the current direction. A repeat count means move that many lines." (interactive "p") (if tpu-advance (tpu-forward-line num) (tpu-backward-line num))) (defun tpu-forward-line (num) "Move to beginning of next line. Prefix argument serves as a repeat count." (interactive "p") (forward-line num)) (defun tpu-backward-line (num) "Move to beginning of previous line. Prefix argument serves as repeat count." (interactive "p") (or (bolp) (>= 0 num) (setq num (- num 1))) (forward-line (- num))) ;;; ;;; Movement by paragraph ;;; (defun tpu-paragraph (num) "Move to the next paragraph in the current direction. A repeat count means move that many paragraphs." (interactive "p") (if tpu-advance (tpu-next-paragraph num) (tpu-previous-paragraph num))) (defun tpu-next-paragraph (num) "Move to beginning of the next paragraph. Accepts a prefix argument for the number of paragraphs." (interactive "p") (beginning-of-line) (while (and (not (eobp)) (> num 0)) (if (re-search-forward "^[ \t]*$" nil t) (if (re-search-forward "[^ \t\n]" nil t) (goto-char (match-beginning 0)) (goto-char (point-max)))) (setq num (1- num))) (beginning-of-line)) (defun tpu-previous-paragraph (num) "Move to beginning of previous paragraph. Accepts a prefix argument for the number of paragraphs." (interactive "p") (end-of-line) (while (and (not (bobp)) (> num 0)) (if (not (and (re-search-backward "^[ \t]*$" nil t) (re-search-backward "[^ \t\n]" nil t) (re-search-backward "^[ \t]*$" nil t) (progn (re-search-forward "[^ \t\n]" nil t) (goto-char (match-beginning 0))))) (goto-char (point-min))) (setq num (1- num))) (beginning-of-line)) ;;; ;;; Movement by page ;;; (defun tpu-page (num) "Move to the next page in the current direction. A repeat count means move that many pages." (interactive "p") (if tpu-advance (forward-page num) (backward-page num)) (if (eobp) (recenter -1))) ;;; ;;; Scrolling and movement within the buffer ;;; (defun tpu-scroll-window (num) "Scroll the display to the next section in the current direction. A repeat count means scroll that many sections." (interactive "p") (if tpu-advance (tpu-scroll-window-up num) (tpu-scroll-window-down num))) (defun tpu-scroll-window-down (num) "Scroll the display down to the next section. A repeat count means scroll that many sections." (interactive "p") (let* ((beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) (next-line-internal (- lines)) (if (> lines beg) (recenter 0)))) (defun tpu-scroll-window-up (num) "Scroll the display up to the next section. A repeat count means scroll that many sections." (interactive "p") (let* ((beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) (next-line-internal lines) (if (>= (+ lines beg) height) (recenter -1)))) (defun tpu-pan-right (num) "Pan right tpu-pan-columns (16 by default). Accepts a prefix argument for the number of tpu-pan-columns to scroll." (interactive "p") (scroll-left (* tpu-pan-columns num))) (defun tpu-pan-left (num) "Pan left tpu-pan-columns (16 by default). Accepts a prefix argument for the number of tpu-pan-columns to scroll." (interactive "p") (scroll-right (* tpu-pan-columns num))) (defun tpu-move-to-beginning nil "Move cursor to the beginning of buffer, but don't set the mark." (interactive) (goto-char (point-min))) (defun tpu-move-to-end nil "Move cursor to the end of buffer, but don't set the mark." (interactive) (goto-char (point-max)) (recenter -1)) (defun tpu-goto-percent (perc) "Move point to ARG percentage of the buffer." (interactive "NGoto-percentage: ") (if (or (> perc 100) (< perc 0)) (error "Percentage %d out of range 0 < percent < 100" perc) (goto-char (/ (* (point-max) perc) 100)))) (defun tpu-beginning-of-window nil "Move cursor to top of window." (interactive) (move-to-window-line 0)) (defun tpu-end-of-window nil "Move cursor to bottom of window." (interactive) (move-to-window-line -1)) (defun tpu-line-to-bottom-of-window nil "Move the current line to the bottom of the window." (interactive) (recenter -1)) (defun tpu-line-to-top-of-window nil "Move the current line to the top of the window." (interactive) (recenter 0)) ;;; ;;; Direction ;;; (defun tpu-advance-direction nil "Set TPU Advance mode so keypad commands move forward." (interactive) (setq tpu-direction-string " Advance") (setq tpu-advance t) (setq tpu-reverse nil) (tpu-set-search) (tpu-update-mode-line)) (defun tpu-backup-direction nil "Set TPU Backup mode so keypad commands move backward." (interactive) (setq tpu-direction-string " Reverse") (setq tpu-advance nil) (setq tpu-reverse t) (tpu-set-search) (tpu-update-mode-line)) ;;; ;;; Define keymaps ;;; (define-key global-map "\e[" CSI-map) ; CSI map (define-key global-map "\eO" SS3-map) ; SS3 map (define-key SS3-map "P" GOLD-map) ; GOLD map (define-key GOLD-map "\e[" GOLD-CSI-map) ; GOLD-CSI map (define-key GOLD-map "\eO" GOLD-SS3-map) ; GOLD-SS3 map ;;; ;;; CSI-map key definitions ;;; (define-key CSI-map "A" 'tpu-previous-line) ; up (define-key CSI-map "B" 'tpu-next-line) ; down (define-key CSI-map "D" 'tpu-backward-char) ; left (define-key CSI-map "C" 'tpu-forward-char) ; right (define-key CSI-map "1~" 'tpu-search) ; Find (define-key CSI-map "2~" 'tpu-paste) ; Insert Here (define-key CSI-map "3~" 'tpu-cut) ; Remove (define-key CSI-map "4~" 'tpu-select) ; Select (define-key CSI-map "5~" 'tpu-scroll-window-down) ; Prev Screen (define-key CSI-map "6~" 'tpu-scroll-window-up) ; Next Screen (define-key CSI-map "11~" 'nil) ; F1 (define-key CSI-map "12~" 'nil) ; F2 (define-key CSI-map "13~" 'nil) ; F3 (define-key CSI-map "14~" 'nil) ; F4 (define-key CSI-map "15~" 'nil) ; F5 (define-key CSI-map "17~" 'nil) ; F6 (define-key CSI-map "18~" 'nil) ; F7 (define-key CSI-map "19~" 'nil) ; F8 (define-key CSI-map "20~" 'nil) ; F9 (define-key CSI-map "21~" 'tpu-exit) ; F10 (define-key CSI-map "23~" 'tpu-insert-escape) ; F11 (ESC) (define-key CSI-map "24~" 'tpu-next-beginning-of-line) ; F12 (BS) (define-key CSI-map "25~" 'tpu-delete-previous-word) ; F13 (LF) (define-key CSI-map "26~" 'tpu-toggle-overwrite-mode) ; F14 (define-key CSI-map "28~" 'tpu-help) ; HELP (define-key CSI-map "29~" 'execute-extended-command) ; DO (define-key CSI-map "31~" 'tpu-goto-breadcrumb) ; F17 (define-key CSI-map "32~" 'nil) ; F18 (define-key CSI-map "33~" 'nil) ; F19 (define-key CSI-map "34~" 'nil) ; F20 ;;; ;;; SS3-map key definitions ;;; (define-key SS3-map "A" 'tpu-previous-line) ; up (define-key SS3-map "B" 'tpu-next-line) ; down (define-key SS3-map "C" 'tpu-forward-char) ; right (define-key SS3-map "D" 'tpu-backward-char) ; left (define-key SS3-map "Q" 'tpu-help) ; PF2 (define-key SS3-map "R" 'tpu-search-again) ; PF3 (define-key SS3-map "S" 'tpu-delete-current-line) ; PF4 (define-key SS3-map "p" 'tpu-line) ; KP0 (define-key SS3-map "q" 'tpu-word) ; KP1 (define-key SS3-map "r" 'tpu-end-of-line) ; KP2 (define-key SS3-map "s" 'tpu-char) ; KP3 (define-key SS3-map "t" 'tpu-advance-direction) ; KP4 (define-key SS3-map "u" 'tpu-backup-direction) ; KP5 (define-key SS3-map "v" 'tpu-cut) ; KP6 (define-key SS3-map "w" 'tpu-page) ; KP7 (define-key SS3-map "x" 'tpu-scroll-window) ; KP8 (define-key SS3-map "y" 'tpu-append-region) ; KP9 (define-key SS3-map "m" 'tpu-delete-current-word) ; KP- (define-key SS3-map "l" 'tpu-delete-current-char) ; KP, (define-key SS3-map "n" 'tpu-select) ; KP. (define-key SS3-map "M" 'newline) ; KPenter ;;; ;;; GOLD-map key definitions ;;; (define-key GOLD-map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A (define-key GOLD-map "\C-B" 'nil) ; ^B (define-key GOLD-map "\C-C" 'nil) ; ^C (define-key GOLD-map "\C-D" 'nil) ; ^D (define-key GOLD-map "\C-E" 'nil) ; ^E (define-key GOLD-map "\C-F" 'set-visited-file-name) ; ^F (define-key GOLD-map "\C-g" 'keyboard-quit) ; safety first (define-key GOLD-map "\C-h" 'delete-other-windows) ; BS (define-key GOLD-map "\C-i" 'other-window) ; TAB (define-key GOLD-map "\C-J" 'nil) ; ^J (define-key GOLD-map "\C-K" 'tpu-define-macro-key) ; ^K (define-key GOLD-map "\C-l" 'downcase-region) ; ^L (define-key GOLD-map "\C-M" 'nil) ; ^M (define-key GOLD-map "\C-N" 'nil) ; ^N (define-key GOLD-map "\C-O" 'nil) ; ^O (define-key GOLD-map "\C-P" 'nil) ; ^P (define-key GOLD-map "\C-Q" 'nil) ; ^Q (define-key GOLD-map "\C-R" 'nil) ; ^R (define-key GOLD-map "\C-S" 'nil) ; ^S (define-key GOLD-map "\C-T" 'tpu-toggle-control-keys) ; ^T (define-key GOLD-map "\C-u" 'upcase-region) ; ^U (define-key GOLD-map "\C-V" 'nil) ; ^V (define-key GOLD-map "\C-w" 'tpu-write-current-buffers) ; ^W (define-key GOLD-map "\C-X" 'nil) ; ^X (define-key GOLD-map "\C-Y" 'nil) ; ^Y (define-key GOLD-map "\C-Z" 'nil) ; ^Z (define-key GOLD-map " " 'undo) ; SPC (define-key GOLD-map "!" 'nil) ; ! (define-key GOLD-map "#" 'nil) ; # (define-key GOLD-map "$" 'tpu-add-at-eol) ; $ (define-key GOLD-map "%" 'tpu-goto-percent) ; % (define-key GOLD-map "&" 'nil) ; & (define-key GOLD-map "(" 'nil) ; ( (define-key GOLD-map ")" 'nil) ; ) (define-key GOLD-map "*" 'tpu-toggle-regexp) ; * (define-key GOLD-map "+" 'nil) ; + (define-key GOLD-map "," 'tpu-goto-breadcrumb) ; , (define-key GOLD-map "-" 'negative-argument) ; - (define-key GOLD-map "." 'tpu-drop-breadcrumb) ; . (define-key GOLD-map "/" 'tpu-emacs-replace) ; / (define-key GOLD-map "0" 'digit-argument) ; 0 (define-key GOLD-map "1" 'digit-argument) ; 1 (define-key GOLD-map "2" 'digit-argument) ; 2 (define-key GOLD-map "3" 'digit-argument) ; 3 (define-key GOLD-map "4" 'digit-argument) ; 4 (define-key GOLD-map "5" 'digit-argument) ; 5 (define-key GOLD-map "6" 'digit-argument) ; 6 (define-key GOLD-map "7" 'digit-argument) ; 7 (define-key GOLD-map "8" 'digit-argument) ; 8 (define-key GOLD-map "9" 'digit-argument) ; 9 (define-key GOLD-map ":" 'nil) ; : (define-key GOLD-map ";" 'tpu-trim-line-ends) ; ; (define-key GOLD-map "<" 'nil) ; < (define-key GOLD-map "=" 'nil) ; = (define-key GOLD-map ">" 'nil) ; > (define-key GOLD-map "?" 'tpu-spell-check) ; ? (define-key GOLD-map "A" 'tpu-toggle-newline-and-indent) ; A (define-key GOLD-map "B" 'tpu-next-buffer) ; B (define-key GOLD-map "C" 'repeat-complex-command) ; C (define-key GOLD-map "D" 'shell-command) ; D (define-key GOLD-map "E" 'tpu-exit) ; E (define-key GOLD-map "F" 'tpu-set-cursor-free) ; F (define-key GOLD-map "G" 'tpu-get) ; G (define-key GOLD-map "H" 'nil) ; H (define-key GOLD-map "I" 'tpu-include) ; I (define-key GOLD-map "K" 'tpu-kill-buffer) ; K (define-key GOLD-map "L" 'tpu-what-line) ; L (define-key GOLD-map "M" 'buffer-menu) ; M (define-key GOLD-map "N" 'tpu-next-file-buffer) ; N (define-key GOLD-map "O" 'occur) ; O (define-key GOLD-map "P" 'lpr-buffer) ; P (define-key GOLD-map "Q" 'tpu-quit) ; Q (define-key GOLD-map "R" 'tpu-toggle-rectangle) ; R (define-key GOLD-map "S" 'replace) ; S (define-key GOLD-map "T" 'tpu-line-to-top-of-window) ; T (define-key GOLD-map "U" 'undo) ; U (define-key GOLD-map "V" 'tpu-version) ; V (define-key GOLD-map "W" 'save-buffer) ; W (define-key GOLD-map "X" 'tpu-save-all-buffers-kill-emacs) ; X (define-key GOLD-map "Y" 'copy-region-as-kill) ; Y (define-key GOLD-map "Z" 'suspend-emacs) ; Z (define-key GOLD-map "[" 'blink-matching-open) ; [ (define-key GOLD-map "\\" 'nil) ; \ (define-key GOLD-map "]" 'blink-matching-open) ; ] (define-key GOLD-map "^" 'tpu-add-at-bol) ; ^ (define-key GOLD-map "_" 'split-window-vertically) ; - (define-key GOLD-map "`" 'what-line) ; ` (define-key GOLD-map "a" 'tpu-toggle-newline-and-indent) ; a (define-key GOLD-map "b" 'tpu-next-buffer) ; b (define-key GOLD-map "c" 'repeat-complex-command) ; c (define-key GOLD-map "d" 'shell-command) ; d (define-key GOLD-map "e" 'tpu-exit) ; e (define-key GOLD-map "f" 'tpu-set-cursor-free) ; f (define-key GOLD-map "g" 'tpu-get) ; g (define-key GOLD-map "h" 'nil) ; h (define-key GOLD-map "i" 'tpu-include) ; i (define-key GOLD-map "k" 'tpu-kill-buffer) ; k (define-key GOLD-map "l" 'goto-line) ; l (define-key GOLD-map "m" 'buffer-menu) ; m (define-key GOLD-map "n" 'tpu-next-file-buffer) ; n (define-key GOLD-map "o" 'occur) ; o (define-key GOLD-map "p" 'lpr-region) ; p (define-key GOLD-map "q" 'tpu-quit) ; q (define-key GOLD-map "r" 'tpu-toggle-rectangle) ; r (define-key GOLD-map "s" 'replace) ; s (define-key GOLD-map "t" 'tpu-line-to-top-of-window) ; t (define-key GOLD-map "u" 'undo) ; u (define-key GOLD-map "v" 'tpu-version) ; v (define-key GOLD-map "w" 'save-buffer) ; w (define-key GOLD-map "x" 'tpu-save-all-buffers-kill-emacs) ; x (define-key GOLD-map "y" 'copy-region-as-kill) ; y (define-key GOLD-map "z" 'suspend-emacs) ; z (define-key GOLD-map "{" 'nil) ; { (define-key GOLD-map "|" 'split-window-horizontally) ; | (define-key GOLD-map "}" 'nil) ; } (define-key GOLD-map "~" 'exchange-point-and-mark) ; ~ (define-key GOLD-map "\177" 'delete-window) ; ;; Maintainer: Rob Riepel ;; Keywords: emulations ;; 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: ;; Use the functions defined here to customize TPU-edt to your tastes by ;; setting scroll margins and/or turning on free cursor mode. Here's an ;; example for your .emacs file. ;; (tpu-set-cursor-free) ; Set cursor free. ;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins. ;; Scroll margins and cursor binding can be changed from within emacs using ;; the following commands: ;; tpu-set-scroll-margins or set scroll margins ;; tpu-set-cursor-bound or set cursor bound ;; tpu-set-cursor-free or set cursor free ;; Additionally, Gold-F toggles between bound and free cursor modes. ;; Note that switching out of free cursor mode or exiting TPU-edt while in ;; free cursor mode strips trailing whitespace from every line in the file. ;;; Details: ;; The functions contained in this file implement scroll margins and free ;; cursor mode. The following keys and commands are affected. ;; key/command function scroll cursor ;; Up-Arrow previous line x x ;; Down-Arrow next line x x ;; Right-Arrow next character x ;; Left-Arrow previous character x ;; KP0 next or previous line x ;; KP7 next or previous page x ;; KP8 next or previous screen x ;; KP2 next or previous end-of-line x x ;; Control-e current end-of-line x ;; Control-h previous beginning-of-line x ;; Next Scr next screen x ;; Prev Scr previous screen x ;; Search find a string x ;; Replace find and replace a string x ;; Newline insert a newline x ;; Paragraph next or previous paragraph x ;; Auto-Fill break lines on spaces x ;; These functions are not part of the base TPU-edt for the following ;; reasons: ;; Free cursor mode is implemented with the emacs picture-mode functions. ;; These functions support moving the cursor all over the screen, however, ;; when the cursor is moved past the end of a line, spaces or tabs are ;; appended to the line - even if no text is entered in that area. In ;; order for a free cursor mode to work exactly like TPU/edt, this trailing ;; whitespace needs to be dealt with in every function that might encounter ;; it. Such global changes are impractical, however, free cursor mode is ;; too valuable to abandon completely, so it has been implemented in those ;; functions where it serves best. ;; The implementation of scroll margins adds overhead to previously ;; simple and often used commands. These commands are now responsible ;; for their normal operation and part of the display function. There ;; is a possibility that this display overhead could adversely affect the ;; performance of TPU-edt on slower computers. In order to support the ;; widest range of computers, scroll margin support is optional. ;; It's actually not known whether the overhead associated with scroll ;; margin support is significant. If you find that it is, please send ;; a note describing the extent of the performance degradation. Be sure ;; to include a description of the platform where you're running TPU-edt. ;; Send your note to the address provided by Gold-V. ;; Even with these differences and limitations, these functions implement ;; important aspects of the real TPU/edt. Those who miss free cursor mode ;; and/or scroll margins will appreciate these implementations. ;;; Code: ;;; Gotta have tpu-edt (require 'tpu-edt) ;;; Customization variables (defconst tpu-top-scroll-margin 0 "*Scroll margin at the top of the screen. Interpreted as a percent of the current window size.") (defconst tpu-bottom-scroll-margin 0 "*Scroll margin at the bottom of the screen. Interpreted as a percent of the current window size.") (defvar tpu-backward-char-like-tpu t "*If non-nil, in free cursor mode backward-char (left-arrow) works just like TPU/edt. Otherwise, backward-char will move to the end of the previous line when starting from a line beginning.") ;;; Global variables (defvar tpu-cursor-free nil "If non-nil, let the cursor roam free.") ;;; Hooks -- Set cursor free in picture mode. ;;; Clean up when writing a file from cursor free mode. (add-hook 'picture-mode-hook 'tpu-set-cursor-free) (defun tpu-write-file-hook nil "Eliminate whitespace at ends of lines, if the cursor is free." (if (and (buffer-modified-p) tpu-cursor-free) (picture-clean))) (or (memq 'tpu-write-file-hook write-file-hooks) (setq write-file-hooks (cons 'tpu-write-file-hook write-file-hooks))) ;;; Utility routines for implementing scroll margins (defun tpu-top-check (beg lines) "Enforce scroll margin at the top of screen." (let ((margin (/ (* (window-height) tpu-top-scroll-margin) 100))) (cond ((< beg margin) (recenter beg)) ((< (- beg lines) margin) (recenter margin))))) (defun tpu-bottom-check (beg lines) "Enforce scroll margin at the bottom of screen." (let* ((height (window-height)) (margin (+ 1 (/ (* height tpu-bottom-scroll-margin) 100))) ;; subtract 1 from height because it includes mode line (difference (- height margin 1))) (cond ((> beg difference) (recenter beg)) ((> (+ beg lines) difference) (recenter (- margin)))))) ;;; Movement by character (defun tpu-forward-char (num) "Move right ARG characters (left if ARG is negative)." (interactive "p") (if tpu-cursor-free (picture-forward-column num) (forward-char num))) (defun tpu-backward-char (num) "Move left ARG characters (right if ARG is negative)." (interactive "p") (cond ((not tpu-cursor-free) (backward-char num)) (tpu-backward-char-like-tpu (picture-backward-column num)) ((bolp) (backward-char 1) (picture-end-of-line) (picture-backward-column (1- num))) (t (picture-backward-column num)))) ;;; Movement by line (defun tpu-next-line (num) "Move to next line. Prefix argument serves as a repeat count." (interactive "p") (let ((beg (tpu-current-line))) (if tpu-cursor-free (or (eobp) (picture-move-down num)) (next-line-internal num)) (tpu-bottom-check beg num) (setq this-command 'next-line))) (defun tpu-previous-line (num) "Move to previous line. Prefix argument serves as a repeat count." (interactive "p") (let ((beg (tpu-current-line))) (if tpu-cursor-free (picture-move-up num) (next-line-internal (- num))) (tpu-top-check beg num) (setq this-command 'previous-line))) (defun tpu-next-beginning-of-line (num) "Move to beginning of line; if at beginning, move to beginning of next line. Accepts a prefix argument for the number of lines to move." (interactive "p") (let ((beg (tpu-current-line))) (backward-char 1) (forward-line (- 1 num)) (tpu-top-check beg num))) (defun tpu-next-end-of-line (num) "Move to end of line; if at end, move to end of next line. Accepts a prefix argument for the number of lines to move." (interactive "p") (let ((beg (tpu-current-line))) (cond (tpu-cursor-free (let ((beg (point))) (if (< 1 num) (forward-line num)) (picture-end-of-line) (if (<= (point) beg) (progn (forward-line) (picture-end-of-line))))) (t (forward-char) (end-of-line num))) (tpu-bottom-check beg num))) (defun tpu-previous-end-of-line (num) "Move EOL upward. Accepts a prefix argument for the number of lines to move." (interactive "p") (let ((beg (tpu-current-line))) (cond (tpu-cursor-free (picture-end-of-line (- 1 num))) (t (end-of-line (- 1 num)))) (tpu-top-check beg num))) (defun tpu-current-end-of-line nil "Move point to end of current line." (interactive) (let ((beg (point))) (if tpu-cursor-free (picture-end-of-line) (end-of-line)) (if (= beg (point)) (message "You are already at the end of a line.")))) (defun tpu-forward-line (num) "Move to beginning of next line. Prefix argument serves as a repeat count." (interactive "p") (let ((beg (tpu-current-line))) (next-line-internal num) (tpu-bottom-check beg num) (beginning-of-line))) (defun tpu-backward-line (num) "Move to beginning of previous line. Prefix argument serves as repeat count." (interactive "p") (let ((beg (tpu-current-line))) (or (bolp) (>= 0 num) (setq num (- num 1))) (next-line-internal (- num)) (tpu-top-check beg num) (beginning-of-line))) ;;; Movement by paragraph (defun tpu-paragraph (num) "Move to the next paragraph in the current direction. A repeat count means move that many paragraphs." (interactive "p") (let* ((left nil) (beg (tpu-current-line)) (height (window-height)) (top-percent (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) (bottom-percent (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) (top-margin (/ (* height top-percent) 100)) (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) (bottom-margin (max beg (- height bottom-up-margin 1))) (top (save-excursion (move-to-window-line top-margin) (point))) (bottom (save-excursion (move-to-window-line bottom-margin) (point))) (far (save-excursion (goto-char bottom) (forward-line (- height 2)) (point)))) (cond (tpu-advance (tpu-next-paragraph num) (cond((> (point) far) (setq left (save-excursion (forward-line height))) (if (= 0 left) (recenter top-margin) (recenter (- left bottom-up-margin)))) (t (and (> (point) bottom) (recenter bottom-margin))))) (t (tpu-previous-paragraph num) (and (< (point) top) (recenter (min beg top-margin))))))) ;;; Movement by page (defun tpu-page (num) "Move to the next page in the current direction. A repeat count means move that many pages." (interactive "p") (let* ((left nil) (beg (tpu-current-line)) (height (window-height)) (top-percent (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) (bottom-percent (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) (top-margin (/ (* height top-percent) 100)) (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) (bottom-margin (max beg (- height bottom-up-margin 1))) (top (save-excursion (move-to-window-line top-margin) (point))) (bottom (save-excursion (move-to-window-line bottom-margin) (point))) (far (save-excursion (goto-char bottom) (forward-line (- height 2)) (point)))) (cond (tpu-advance (forward-page num) (cond((> (point) far) (setq left (save-excursion (forward-line height))) (if (= 0 left) (recenter top-margin) (recenter (- left bottom-up-margin)))) (t (and (> (point) bottom) (recenter bottom-margin))))) (t (backward-page num) (and (< (point) top) (recenter (min beg top-margin))))))) ;;; Scrolling (defun tpu-scroll-window-down (num) "Scroll the display down to the next section. A repeat count means scroll that many sections." (interactive "p") (let* ((beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) (next-line-internal (- lines)) (tpu-top-check beg lines))) (defun tpu-scroll-window-up (num) "Scroll the display up to the next section. A repeat count means scroll that many sections." (interactive "p") (let* ((beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) (next-line-internal lines) (tpu-bottom-check beg lines))) ;;; Replace the TPU-edt internal search function (defun tpu-search-internal (pat &optional quiet) "Search for a string or regular expression." (let* ((left nil) (beg (tpu-current-line)) (height (window-height)) (top-percent (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) (bottom-percent (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) (top-margin (/ (* height top-percent) 100)) (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) (bottom-margin (max beg (- height bottom-up-margin 1))) (top (save-excursion (move-to-window-line top-margin) (point))) (bottom (save-excursion (move-to-window-line bottom-margin) (point))) (far (save-excursion (goto-char bottom) (forward-line (- height 2)) (point)))) (tpu-search-internal-core pat quiet) (if tpu-searching-forward (cond((> (point) far) (setq left (save-excursion (forward-line height))) (if (= 0 left) (recenter top-margin) (recenter (- left bottom-up-margin)))) (t (and (> (point) bottom) (recenter bottom-margin)))) (and (< (point) top) (recenter (min beg top-margin)))))) ;;; Replace the newline, newline-and-indent, and do-auto-fill functions (or (fboundp 'tpu-old-newline) (fset 'tpu-old-newline (symbol-function 'newline))) (or (fboundp 'tpu-old-do-auto-fill) (fset 'tpu-old-do-auto-fill (symbol-function 'do-auto-fill))) (or (fboundp 'tpu-old-newline-and-indent) (fset 'tpu-old-newline-and-indent (symbol-function 'newline-and-indent))) (defun newline (&optional num) "Insert a newline. With arg, insert that many newlines. In Auto Fill mode, can break the preceding line if no numeric arg. This is the TPU-edt version that respects the bottom scroll margin." (interactive "p") (let ((beg (tpu-current-line))) (or num (setq num 1)) (tpu-old-newline num) (tpu-bottom-check beg num))) (defun newline-and-indent nil "Insert a newline, then indent according to major mode. Indentation is done using the current indent-line-function. In programming language modes, this is the same as TAB. In some text modes, where TAB inserts a tab, this indents to the specified left-margin column. This is the TPU-edt version that respects the bottom scroll margin." (interactive) (let ((beg (tpu-current-line))) (tpu-old-newline-and-indent) (tpu-bottom-check beg 1))) (defun do-auto-fill nil "TPU-edt version that respects the bottom scroll margin." (let ((beg (tpu-current-line))) (tpu-old-do-auto-fill) (tpu-bottom-check beg 1))) ;;; Function to set scroll margins ;;;###autoload (defun tpu-set-scroll-margins (top bottom) "Set scroll margins." (interactive "sEnter top scroll margin (N lines or N%% or RETURN for current value): \ \nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ") ;; set top scroll margin (or (string= top "") (if (string= "%" (substring top -1)) (setq tpu-top-scroll-margin (string-to-int top)) (setq tpu-top-scroll-margin (/ (1- (+ (* (string-to-int top) 100) (window-height))) (window-height))))) ;; set bottom scroll margin (or (string= bottom "") (if (string= "%" (substring bottom -1)) (setq tpu-bottom-scroll-margin (string-to-int bottom)) (setq tpu-bottom-scroll-margin (/ (1- (+ (* (string-to-int bottom) 100) (window-height))) (window-height))))) ;; report scroll margin settings if running interactively (and (interactive-p) (message "Scroll margins set. Top = %s%%, Bottom = %s%%" tpu-top-scroll-margin tpu-bottom-scroll-margin))) ;;; Functions to set cursor bound or free ;;;###autoload (defun tpu-set-cursor-free nil "Allow the cursor to move freely about the screen." (interactive) (setq tpu-cursor-free t) (substitute-key-definition 'tpu-set-cursor-free 'tpu-set-cursor-bound GOLD-map) (message "The cursor will now move freely about the screen.")) ;;;###autoload (defun tpu-set-cursor-bound nil "Constrain the cursor to the flow of the text." (interactive) (picture-clean) (setq tpu-cursor-free nil) (substitute-key-definition 'tpu-set-cursor-bound 'tpu-set-cursor-free GOLD-map) (message "The cursor is now bound to the flow of your text.")) ;;; tpu-extras.el ends here emacs-19.30/lisp/tpu-mapper.el100444 12120 1 35102 6005640173 14505 0ustar rmsdaemon;;; tpu-mapper.el --- Create a TPU-edt X-windows keymap file ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Rob Riepel ;; Maintainer: Rob Riepel ;; Keywords: emulations ;; 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 emacs lisp program can be used to create an emacs lisp file that ;; defines the TPU-edt keypad for emacs running on x-windows. Please read ;; the "Usage" AND "Known Problems" sections before attempting to run this ;; program. ;;; Usage: ;; Simply load this file into the X-windows version of emacs using the ;; following command. ;; emacs -q -l tpu-mapper ;; The "-q" option prevents loading of your .emacs file (commands therein ;; might confuse this program). ;; An instruction screen showing the TPU-edt keypad will be displayed, and ;; you will be prompted to press the TPU-edt editing keys. Tpu-mapper uses ;; the keys you press to create an Emacs Lisp file that will define a ;; TPU-edt keypad for your X server. You can even re-arrange the standard ;; EDT keypad to suit your tastes (or to cope with those silly Sun and PC ;; keypads). ;; Finally, you will be prompted for the name of the file to store the key ;; definitions. If you chose the default, TPU-edt will find it and load it ;; automatically. If you specify a different file name, you will need to ;; set the variable "tpu-xkeys-file" before starting TPU-edt. Here's how ;; you might go about doing that in your .emacs file. ;; (setq tpu-xkeys-file (expand-file-name "~/.my-emacs-x-keys")) ;; (tpu-edt) ;;; Known Problems: ;; Sometimes, tpu-mapper will ignore a key you press, and just continue to ;; prompt for the same key. This can happen when your window manager sucks ;; up the key and doesn't pass it on to Emacs, or it could be an Emacs bug. ;; Either way, there's nothing that tpu-mapper can do about it. You must ;; press RETURN, to skip the current key and continue. Later, you and/or ;; your local X guru can try to figure out why the key is being ignored. ;;; Code: ;;; ;;; Make sure we're running X-windows and Emacs version 19 ;;; (cond ((not (and window-system (not (string-lessp emacs-version "19")))) (error "tpu-mapper requires running in Emacs 19, with an X display"))) ;;; ;;; Decide whether we're running Lucid Emacs or Emacs itself. ;;; (defconst tpu-lucid-emacs19-p (string-match "Lucid" emacs-version) "Non-NIL if we are running Lucid Emacs version 19.") ;;; ;;; Key variables ;;; (defvar tpu-kp4 nil) (defvar tpu-kp5 nil) (defvar tpu-key nil) (defvar tpu-enter nil) (defvar tpu-return nil) (defvar tpu-key-seq nil) (defvar tpu-enter-seq nil) (defvar tpu-return-seq nil) ;;; ;;; Make sure the window is big enough to display the instructions ;;; (if tpu-lucid-emacs19-p (set-screen-size (selected-screen) 80 36) (set-frame-size (selected-frame) 80 36)) ;;; ;;; Create buffers - Directions, Keys, Gold-Keys ;;; (if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) (if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) (if (not (get-buffer "Gold-Keys")) (generate-new-buffer "Gold-Keys")) ;;; ;;; Put headers in the Keys buffer ;;; (set-buffer "Keys") (insert "\ ;; Key definitions for TPU-edt ;; ") ;;; ;;; Display directions ;;; (switch-to-buffer "Directions") (insert " This program prompts you to press keys to create a custom keymap file for use with the x-windows version of Emacs and TPU-edt. Start by pressing the RETURN key, and continue by pressing the keys specified in the mini-buffer. You can re-arrange the TPU-edt keypad by pressing any key you want at any prompt. If you want to entirely omit a key, just press RETURN at the prompt. Here's a picture of the standard TPU/edt keypad for reference: _______________________ _______________________________ | HELP | Do | | | | | | |KeyDefs| | | | | | | |_______|_______________| |_______|_______|_______|_______| _______________________ _______________________________ | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L | | | |Sto Tex| | key |E-Help | Find |Undel L| |_______|_______|_______| |_______|_______|_______|_______| |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W | | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W| |_______|_______|_______| |_______|_______|_______|_______| |Move up| |Forward|Reverse|Remove | Del C | | Top | |Bottom | Top |Insert |Undel C| _______|_______|_______ |_______|_______|_______|_______| |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | | |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter | |_______|_______|_______| |_______|_______|_______| | | Line |Select | Subs | | Open Line | Reset | | |_______________|_______|_______| ") (delete-other-windows) (goto-char (point-min)) ;;; ;;; Save for future reference ;;; (cond (tpu-lucid-emacs19-p (setq tpu-return-seq (read-key-sequence "Hit carriage-return to continue ")) (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]"))) (t (message "Hit carriage-return to continue ") (setq tpu-return-seq (read-event)) (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]")))) ;;; ;;; Key mapping functions ;;; (defun tpu-lucid-map-key (ident descrip func gold-func) (interactive) (setq tpu-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) (setq tpu-key (concat "[" (format "%s" (event-key (aref tpu-key-seq 0))) "]")) (cond ((not (equal tpu-key tpu-return)) (set-buffer "Keys") (insert (format"(global-set-key %s %s)\n" tpu-key func)) (set-buffer "Gold-Keys") (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)) (set-buffer "Directions")) ;; bogosity to get next prompt to come up, if the user hits ! ;; check periodically to see if this is still needed... (t (format "%s" tpu-key))) tpu-key) (defun tpu-emacs-map-key (ident descrip func gold-func) (interactive) (message "Press %s%s: " ident descrip) (setq tpu-key-seq (read-event)) (setq tpu-key (concat "[" (format "%s" tpu-key-seq) "]")) (cond ((not (equal tpu-key tpu-return)) (set-buffer "Keys") (insert (format"(global-set-key %s %s)\n" tpu-key func)) (set-buffer "Gold-Keys") (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)) (set-buffer "Directions")) ;; bogosity to get next prompt to come up, if the user hits ! ;; check periodically to see if this is still needed... (t (format "%s" tpu-key))) tpu-key) (fset 'tpu-map-key (if tpu-lucid-emacs19-p 'tpu-lucid-map-key 'tpu-emacs-map-key)) (set-buffer "Keys") (insert " ;; Arrows ;; ") (set-buffer "Gold-Keys") (insert " ;; GOLD Arrows ;; ") (set-buffer "Directions") (tpu-map-key "Up-Arrow" "" "'tpu-previous-line" "'tpu-move-to-beginning") (tpu-map-key "Down-arrow" "" "'tpu-next-line" "'tpu-move-to-end") (tpu-map-key "Right-arrow" "" "'tpu-forward-char" "'end-of-line") (tpu-map-key "Left-arrow" "" "'tpu-backward-char" "'beginning-of-line") (set-buffer "Keys") (insert " ;; PF keys ;; ") (set-buffer "Gold-Keys") (insert " ;; GOLD PF keys ;; ") (set-buffer "Directions") (tpu-map-key "PF1" " - The GOLD key" "GOLD-map" "'keyboard-quit") (tpu-map-key "PF2" " - The Keypad Help key" "'tpu-help" "'help-for-help") (tpu-map-key "PF3" " - The Find/Find-Next key" "'tpu-search-again" "'tpu-search") (tpu-map-key "PF4" " - The Del/Undelete Line key" "'tpu-delete-current-line" "'tpu-undelete-lines") (set-buffer "Keys") (insert " ;; KP0-9 KP- KP, KP. and KPenter ;; ") (set-buffer "Gold-Keys") (insert " ;; GOLD KP0-9 KP- KP, and KPenter ;; ") (set-buffer "Directions") (tpu-map-key "KP-0" " - The Line/Open-Line key" "'tpu-line" "'open-line") (tpu-map-key "KP-1" " - The Word/Change-Case key" "'tpu-word" "'tpu-change-case") (tpu-map-key "KP-2" " - The EOL/Delete-EOL key" "'tpu-end-of-line" "'tpu-delete-to-eol") (tpu-map-key "KP-3" " - The Character/Special-Insert key" "'tpu-char" "'tpu-special-insert") (setq tpu-kp4 (tpu-map-key "KP-4" " - The Forward/Bottom key" "'tpu-advance-direction" "'tpu-move-to-end")) (setq tpu-kp5 (tpu-map-key "KP-5" " - The Reverse/Top key" "'tpu-backup-direction" "'tpu-move-to-beginning")) (tpu-map-key "KP-6" " - The Remove/Insert key" "'tpu-cut" "'tpu-paste") (tpu-map-key "KP-7" " - The Page/Do key" "'tpu-page" "'execute-extended-command") (tpu-map-key "KP-8" " - The Section/Fill key" "'tpu-scroll-window" "'tpu-fill") (tpu-map-key "KP-9" " - The Append/Replace key" "'tpu-append-region" "'tpu-replace") (tpu-map-key "KP--" " - The Delete/Undelete Word key" "'tpu-delete-current-word" "'tpu-undelete-words") (tpu-map-key "KP-," " - The Delete/Undelete Character key" "'tpu-delete-current-char" "'tpu-undelete-char") (tpu-map-key "KP-." " - The Select/Reset key" "'tpu-select" "'tpu-unselect") (tpu-map-key "KP-Enter" " - The Enter key on the numeric keypad" "'newline" "'tpu-substitute") ;; Save the enter key (setq tpu-enter tpu-key) (setq tpu-enter-seq tpu-key-seq) (set-buffer "Keys") (insert " ;; Editing keypad (find, insert, remove) ;; (select, prev, next) ;; ") (set-buffer "Gold-Keys") (insert " ;; GOLD Editing keypad (find, insert, remove) ;; (select, prev, next) ;; ") (set-buffer "Directions") (tpu-map-key "Find" " - The Find key on the editing keypad" "'tpu-search" "'nil") (tpu-map-key "Insert" " - The Insert key on the editing keypad" "'tpu-paste" "'nil") (tpu-map-key "Remove" " - The Remove key on the editing keypad" "'tpu-cut" "'tpu-store-text") (tpu-map-key "Select" " - The Select key on the editing keypad" "'tpu-select" "'tpu-unselect") (tpu-map-key "Prev Scr" " - The Prev Scr key on the editing keypad" "'tpu-scroll-window-down" "'tpu-previous-window") (tpu-map-key "Next Scr" " - The Next Scr key on the editing keypad" "'tpu-scroll-window-up" "'tpu-next-window") (set-buffer "Keys") (insert " ;; F10-14 Help Do F17 ;; ") (set-buffer "Gold-Keys") (insert " ;; GOLD F10-14 Help Do F17 ;; ") (set-buffer "Directions") (tpu-map-key "F10" " - Invokes the Exit function on VT200+ terminals" "'tpu-exit" "'nil") (tpu-map-key "F11" " - Inserts an Escape character into the text" "'tpu-insert-escape" "'nil") (tpu-map-key "Backspace" " - Not Delete nor ^H! Sometimes on the F12 key" "'tpu-next-beginning-of-line" "'nil") (tpu-map-key "F13" " - Invokes the delete previous word function" "'tpu-delete-previous-word" "'nil") (tpu-map-key "F14" " - Toggles insert/overstrike modes" "'tpu-toggle-overwrite-mode" "'nil") (tpu-map-key "Help" " - Brings up the help screen, same as PF2" "'tpu-help" "'describe-bindings") (tpu-map-key "Do" " - Invokes the COMMAND function" "'execute-extended-command" "'nil") (tpu-map-key "F17" "" "'tpu-goto-breadcrumb" "'tpu-drop-breadcrumb") (set-buffer "Gold-Keys") (cond ((not (equal tpu-enter tpu-return)) (insert " ;; Minibuffer map additions to make KP_enter = RET ;; ") (insert (format "(define-key minibuffer-local-map %s 'exit-minibuffer)\n" tpu-enter)) (insert (format "(define-key minibuffer-local-ns-map %s 'exit-minibuffer)\n" tpu-enter)) (insert (format "(define-key minibuffer-local-completion-map %s 'exit-minibuffer)\n" tpu-enter)) (insert (format "(define-key minibuffer-local-must-match-map %s 'minibuffer-complete-and-exit)\n" tpu-enter)))) (cond ((not (or (equal tpu-kp4 tpu-return) (equal tpu-kp5 tpu-return))) (insert " ;; Minibuffer map additions to allow KP-4/5 termination of search strings. ;; ") (insert (format "(define-key minibuffer-local-map %s 'tpu-search-forward-exit)\n" tpu-kp4)) (insert (format "(define-key minibuffer-local-map %s 'tpu-search-backward-exit)\n" tpu-kp5)))) (insert " ;; Define the tpu-help-enter/return symbols ;; ") (cond (tpu-lucid-emacs19-p (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq)) (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq)) (insert "(setq tpu-help-N \"[#]\")\n") (insert "(setq tpu-help-n \"[#]\")\n") (insert "(setq tpu-help-P \"[#]\")\n") (insert "(setq tpu-help-p \"[#]\")\n")) (t (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter)))) (append-to-buffer "Keys" 1 (point)) (set-buffer "Keys") ;;; ;;; Save the key mapping program ;;; (let ((file (if tpu-lucid-emacs19-p "~/.tpu-lucid-keys" "~/.tpu-keys"))) (set-visited-file-name (read-file-name (format "Save key mapping to file (default %s): " file) "" file))) (save-buffer) ;;; ;;; Load the newly defined keys and clean up ;;; (eval-current-buffer) (kill-buffer (current-buffer)) (kill-buffer "*scratch*") (kill-buffer "Gold-Keys") ;;; ;;; Let them know it worked. ;;; (switch-to-buffer "Directions") (erase-buffer) (insert " A custom TPU-edt keymap file has been created. Press GOLD-k to remove this buffer and continue editing. ") (goto-char (point-min)) ;;; tpu-mapper.el ends here emacs-19.30/lisp/tq.el100444 75424 1 10132 5755746212 13251 0ustar kwzhdaemon;;; tq.el --- utility to maintain a transaction queue ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. ;; Author: Scott Draves ;; Adapted-By: ESR ;; Keywords: extensions ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 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: ;;; manages receiving a stream asynchronously, ;;; parsing it into transactions, and then calling ;;; handler functions ;;; Our basic structure is the queue/process/buffer triple. Each entry ;;; of the queue is a regexp/closure/function triple. We buffer ;;; bytes from the process until we see the regexp at the head of the ;;; queue. Then we call the function with the closure and the ;;; collected bytes. ;;; Code: ;;;###autoload (defun tq-create (process) "Create and return a transaction queue communicating with PROCESS. PROCESS should be a subprocess capable of sending and receiving streams of bytes. It may be a local process, or it may be connected to a tcp server on another machine." (let ((tq (cons nil (cons process (generate-new-buffer (concat " tq-temp-" (process-name process))))))) (set-process-filter process (`(lambda (proc string) (tq-filter '(, tq) string)))) tq)) ;;; accessors (defun tq-queue (tq) (car tq)) (defun tq-process (tq) (car (cdr tq))) (defun tq-buffer (tq) (cdr (cdr tq))) (defun tq-queue-add (tq re closure fn) (setcar tq (nconc (tq-queue tq) (cons (cons re (cons closure fn)) nil))) 'ok) (defun tq-queue-head-regexp (tq) (car (car (tq-queue tq)))) (defun tq-queue-head-fn (tq) (cdr (cdr (car (tq-queue tq))))) (defun tq-queue-head-closure (tq) (car (cdr (car (tq-queue tq))))) (defun tq-queue-empty (tq) (not (tq-queue tq))) (defun tq-queue-pop (tq) (setcar tq (cdr (car tq))) (null (car tq))) ;;; must add to queue before sending! (defun tq-enqueue (tq question regexp closure fn) "Add a transaction to transaction queue TQ. This sends the string QUESTION to the process that TQ communicates with. When the corresponding answer comes back, we call FN with two arguments: CLOSURE, and the answer to the question. REGEXP is a regular expression to match the entire answer; that's how we tell where the answer ends." (tq-queue-add tq regexp closure fn) (process-send-string (tq-process tq) question)) (defun tq-close (tq) "Shut down transaction queue TQ, terminating the process." (delete-process (tq-process tq)) (kill-buffer (tq-buffer tq))) (defun tq-filter (tq string) "Append STRING to the TQ's buffer; then process the new data." (set-buffer (tq-buffer tq)) (goto-char (point-max)) (insert string) (tq-process-buffer tq)) (defun tq-process-buffer (tq) "Check TQ's buffer for the regexp at the head of the queue." (set-buffer (tq-buffer tq)) (if (= 0 (buffer-size)) () (if (tq-queue-empty tq) (let ((buf (generate-new-buffer "*spurious*"))) (copy-to-buffer buf (point-min) (point-max)) (delete-region (point-min) (point)) (pop-to-buffer buf nil) (error (concat "Spurious communication from process " (process-name (tq-process tq)) ", see buffer " (buffer-name buf) "."))) (goto-char (point-min)) (if (re-search-forward (tq-queue-head-regexp tq) nil t) (let ((answer (buffer-substring (point-min) (point)))) (delete-region (point-min) (point)) (funcall (tq-queue-head-fn tq) (tq-queue-head-closure tq) answer) (tq-queue-pop tq) (tq-process-buffer tq)))))) (provide 'tq) ;;; tq.el ends here emacs-19.30/lisp/trace.el100444 12120 1 24474 5752277643 13543 0ustar rmsdaemon;;; trace.el --- tracing facility for Emacs Lisp functions ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Hans Chalupsky ;; Created: 15 Dec 1992 ;; Keywords: tools, lisp ;; 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. ;; LCD Archive Entry: ;; trace|Hans Chalupsky|hans@cs.buffalo.edu| ;; Tracing facility for Emacs Lisp functions| ;; 1993/05/18 00:41:16|2.0|~/packages/trace.el.Z| ;;; Commentary: ;; Introduction: ;; ============= ;; A simple trace package that utilizes advice.el. It generates trace ;; information in a Lisp-style fashion and inserts it into a trace output ;; buffer. Tracing can be done in the background (or silently) so that ;; generation of trace output won't interfere with what you are currently ;; doing. ;; How to get the latest trace.el: ;; =============================== ;; You can get the latest version of this file either via anonymous ftp from ;; ftp.cs.buffalo.edu (128.205.32.9) with pathname /pub/Emacs/trace.el, ;; or send email to hans@cs.buffalo.edu and I'll mail it to you. ;; Requirement: ;; ============ ;; trace.el needs advice.el version 2.0 or later which you can get from the ;; same place from where you got trace.el. ;; Restrictions: ;; ============= ;; - Traced subrs when called interactively will always show nil as the ;; value of their arguments. ;; - Only functions/macros/subrs that are called via their function cell will ;; generate trace output, hence, you won't get trace output for: ;; + Subrs called directly from other subrs/C-code ;; + Compiled calls to subrs that have special byte-codes associated ;; with them (e.g., car, cdr, ...) ;; + Macros that were expanded during compilation ;; - All the restrictions that apply to advice.el ;; Installation: ;; ============= ;; Put this file together with advice.el (version 2.0 or later) somewhere ;; into your Emacs `load-path', byte-compile it/them for efficiency, and ;; put the following autoload declarations into your .emacs ;; ;; (autoload 'trace-function "trace" "Trace a function" t) ;; (autoload 'trace-function-background "trace" "Trace a function" t) ;; ;; or explicitly load it with (require 'trace) or (load "trace"). ;; Comments, suggestions, bug reports ;; ================================== ;; are strongly appreciated, please email them to hans@cs.buffalo.edu. ;; Usage: ;; ====== ;; - To trace a function say `M-x trace-function' which will ask you for the ;; name of the function/subr/macro to trace, as well as for the buffer ;; into which trace output should go. ;; - If you want to trace a function that switches buffers or does other ;; display oriented stuff use `M-x trace-function-background' which will ;; generate the trace output silently in the background without popping ;; up windows and doing other irritating stuff. ;; - To untrace a function say `M-x untrace-function'. ;; - To untrace all currently traced functions say `M-x untrace-all'. ;; Examples: ;; ========= ;; ;; (defun fact (n) ;; (if (= n 0) 1 ;; (* n (fact (1- n))))) ;; fact ;; ;; (trace-function 'fact) ;; fact ;; ;; Now, evaluating this... ;; ;; (fact 4) ;; 24 ;; ;; ...will generate the following in *trace-buffer*: ;; ;; 1 -> fact: n=4 ;; | 2 -> fact: n=3 ;; | | 3 -> fact: n=2 ;; | | | 4 -> fact: n=1 ;; | | | | 5 -> fact: n=0 ;; | | | | 5 <- fact: 1 ;; | | | 4 <- fact: 1 ;; | | 3 <- fact: 2 ;; | 2 <- fact: 6 ;; 1 <- fact: 24 ;; ;; ;; (defun ack (x y z) ;; (if (= x 0) ;; (+ y z) ;; (if (and (<= x 2) (= z 0)) ;; (1- x) ;; (if (and (> x 2) (= z 0)) ;; y ;; (ack (1- x) y (ack x y (1- z))))))) ;; ack ;; ;; (trace-function 'ack) ;; ack ;; ;; Try this for some interesting trace output: ;; ;; (ack 3 3 1) ;; 27 ;; ;; ;; The following does something similar to the functionality of the package ;; log-message.el by Robert Potter, which is giving you a chance to look at ;; messages that might have whizzed by too quickly (you won't see subr ;; generated messages though): ;; ;; (trace-function-background 'message "*Message Log*") ;;; Change Log: ;; Revision 2.0 1993/05/18 00:41:16 hans ;; * Adapted for advice.el 2.0; it now also works ;; for GNU Emacs-19 and Lemacs ;; * Separate function `trace-function-background' ;; * Separate pieces of advice for foreground and background tracing ;; * Less insane handling of interactive trace buffer specification ;; * String arguments and values are now printed properly ;; ;; Revision 1.1 1992/12/15 22:45:15 hans ;; * Created, first public release ;;; Code: (require 'advice) ;;;###autoload (defvar trace-buffer "*trace-output*" "*Trace output will by default go to that buffer.") ;; Current level of traced function invocation: (defvar trace-level 0) ;; Semi-cryptic name used for a piece of trace advice: (defvar trace-advice-name 'trace-function\ ) ;; Used to separate new trace output from previous traced runs: (defvar trace-separator (format "%s\n" (make-string 70 ?=))) (defun trace-entry-message (function level argument-bindings) ;; Generates a string that describes that FUNCTION has been entered at ;; trace LEVEL with ARGUMENT-BINDINGS. (format "%s%s%d -> %s: %s\n" (mapconcat 'char-to-string (make-string (1- level) ?|) " ") (if (> level 1) " " "") level function (mapconcat (function (lambda (binding) (concat (symbol-name (ad-arg-binding-field binding 'name)) "=" ;; do this so we'll see strings: (prin1-to-string (ad-arg-binding-field binding 'value))))) argument-bindings " "))) (defun trace-exit-message (function level value) ;; Generates a string that describes that FUNCTION has been exited at ;; trace LEVEL and that it returned VALUE. (format "%s%s%d <- %s: %s\n" (mapconcat 'char-to-string (make-string (1- level) ?|) " ") (if (> level 1) " " "") level function ;; do this so we'll see strings: (prin1-to-string value))) (defun trace-make-advice (function buffer background) ;; Builds the piece of advice to be added to FUNCTION's advice info ;; so that it will generate the proper trace output in BUFFER ;; (quietly if BACKGROUND is t). (ad-make-advice trace-advice-name nil t (cond (background (` (advice lambda () (let ((trace-level (1+ trace-level)) (trace-buffer (get-buffer-create (, buffer)))) (save-excursion (set-buffer trace-buffer) (goto-char (point-max)) ;; Insert a separator from previous trace output: (if (= trace-level 1) (insert trace-separator)) (insert (trace-entry-message '(, function) trace-level ad-arg-bindings))) ad-do-it (save-excursion (set-buffer trace-buffer) (goto-char (point-max)) (insert (trace-exit-message '(, function) trace-level ad-return-value))))))) (t (` (advice lambda () (let ((trace-level (1+ trace-level)) (trace-buffer (get-buffer-create (, buffer)))) (pop-to-buffer trace-buffer) (goto-char (point-max)) ;; Insert a separator from previous trace output: (if (= trace-level 1) (insert trace-separator)) (insert (trace-entry-message '(, function) trace-level ad-arg-bindings)) ad-do-it (pop-to-buffer trace-buffer) (goto-char (point-max)) (insert (trace-exit-message '(, function) trace-level ad-return-value))))))))) (defun trace-function-internal (function buffer background) ;; Adds trace advice for FUNCTION and activates it. (ad-add-advice function (trace-make-advice function (or buffer trace-buffer) background) 'around 'last) (ad-activate function nil)) (defun trace-is-traced (function) (ad-find-advice function 'around trace-advice-name)) ;;;###autoload (defun trace-function (function &optional buffer) "Traces FUNCTION with trace output going to BUFFER. For every call of FUNCTION Lisp-style trace messages that display argument and return values will be inserted into BUFFER. This function generates the trace advice for FUNCTION and activates it together with any other advice there might be!! The trace BUFFER will popup whenever FUNCTION is called. Do not use this to trace functions that switch buffers or do any other display oriented stuff, use `trace-function-background' instead." (interactive (list (intern (completing-read "Trace function: " obarray 'fboundp t)) (read-buffer "Output to buffer: " trace-buffer))) (trace-function-internal function buffer nil)) ;;;###autoload (defun trace-function-background (function &optional buffer) "Traces FUNCTION with trace output going quietly to BUFFER. For every call of FUNCTION Lisp-style trace messages that display argument and return values will be inserted into BUFFER. This function generates the trace advice for FUNCTION and activates it together with any other advice there might be!! Trace output will quietly go to BUFFER without changing the window or buffer configuration at all." (interactive (list (intern (completing-read "Trace function in background: " obarray 'fboundp t)) (read-buffer "Output to buffer: " trace-buffer))) (trace-function-internal function buffer t)) (defun untrace-function (function) "Untraces FUNCTION and possibly activates all remaining advice. Activation is performed with `ad-update', hence remaining advice will get activated only if the advice of FUNCTION is currently active. If FUNCTION was not traced this is a noop." (interactive (list (ad-read-advised-function "Untrace function: " 'trace-is-traced))) (cond ((trace-is-traced function) (ad-remove-advice function 'around trace-advice-name) (ad-update function)))) (defun untrace-all () "Untraces all currently traced functions." (interactive) (ad-do-advised-functions (function) (untrace-function function))) (provide 'trace) ;;; trace.el ends here emacs-19.30/lisp/two-column.el100444 75424 1 54671 6046303421 14732 0ustar kwzhdaemon;;; two-column.el --- minor mode for editing of two-column text ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 ;; Adapted-By: ESR, Daniel Pfeiffer ;; Esperanto: English: ;; ^Ci dosiero estas ero de GNU Emacs. This file is part of GNU Emacs. ;; GNU Emacs estas libera programaro; GNU Emacs is free software; you can ;; vi povas disdoni ^gin kaj/a^u modifi redistribute it and/or modify it ;; ^gin sub la kondi^coj de la GNU under the terms of the GNU General ;; ^Generala Publika Licenco kiel pub- Public License as published by the ;; likigita far la Liberprogramara Fon- Free Software Foundation; either ;; da^jo; a^u eldono 2a, a^u (la^u via version 2, or (at your option) any ;; elekto) ajna posta eldono. later version. ;; GNU Emacs estas disdonata en la GNU Emacs is distributed in the hope ;; espero ke ^gi estos utila, sed SEN that it will be useful, but WITHOUT ;; IA GARANTIO; sen e^c la implicita ANY WARRANTY; without even the ;; garantio de VENDEBLECO a^u PRETECO implied warranty of MERCHANTABILITY ;; POR DETERMINITA CELO. Vidu la GNU or FITNESS FOR A PARTICULAR PURPOSE. ;; ^Generala Publika Licenco por plenaj See the GNU General Public License ;; detaloj. for more details. ;; Vi devus ricevinti kopion de la GNU You should have received a copy of ;; ^Generala Publika Licenco kune kun the GNU General Public License along ;; GNU Emacs; vidu la dosieron COPYING. with GNU Emacs; see the file ;; Alikaze skribu al la COPYING. If not, write to the ;; Free Software Foundation, 59 Temple Place - Suite 330 ;; Boston, MA 02111-1307, USA. ;;; Komentario: Commentary: ;; Tiu programaro ebligas vin redakti This package gives you the ability ;; dukolumnan tekston. to edit text in a two-column format. ;; Vi havas tri eblecojn por eki tiun You have three ways to start up this ;; mal^cefan modalon. ^Ciu donas al vi minor mode. Each gives you a ;; horizontale disigatan fenestron, si- horizontally split window similar to ;; milan al fina apareco de via teksto: the final outcome of your text: ;; f2 2 asocias novan bufron nomatan associates a new buffer called ;; C-x 6 2 same, sed kun 2C/ anta^u. the same, but with 2C/ ;; prepended. ;; f2 b asocias alian bufron. Vi povas associates another buffer. ;; C-x 6 b anka^u asocii dataron, se vi This can be used to associate a ;; ^jus anta^ue faris C-x C-f. file if you just did C-x C-f. ;; f2 s disigas jam dukolumnan tekston splits a two-column text into ;; C-x 6 s en du bufroj ekde la nuna two buffers from the current ;; linio, kaj je la nuna kolumno. line and at the current column. ;; La anta^uaj signoj (ofte The preceding characters (often ;; tabeligilo a^u |) estas la tab or |) are the column ;; kolumna disiganto. Linioj kiuj separator. Lines that don't ;; ne enhavas ilin ne estas have them won't be separated. ;; disigitaj. Kiel la kvara kaj Like the fourth and fifth line ;; la kvina linio se vi disigas if you split this file from ;; ^ci dataron ekde la unua angla the first english word. ;; vorto. ;; Se vi volas meti longajn liniojn If you include long lines, i.e which ;; (ekz. programerojn) en la kunigotan will span both columns (eg. source ;; tekston, ili devas esti en la code), they should be in what will ;; estonte unua kolumno. La alia devas be the first column, with the ;; havi vakajn linion apud ili. associated buffer having empty lines ;; next to them. ;; Averto: en Emacs kiam vi ^san^gas la Attention: in Emacs when you change ;; ^cefan modalon, la mal^cefaj modaloj the major mode, the minor modes are ;; estas anka^u elmemorigitaj. Tiu- also purged from memory. In that ;; okaze vi devas religi la du bufrojn case you must reassociate the two ;; per iu C-x 6-ordono, ekz. C-x 6 b. buffers with any C-x 6-command, e.g. ;; C-x 6 b. ;; Kiam vi estos kontenta de la When you have edited both buffers to ;; rezulto, vi kunmetos la du kolumnojn your content, you merge them with ;; per C-x 6 1. Se vi poste vidas C-x 6 1. If you then see a problem, ;; problemon, vi neniigu la kunmeton you undo the merge with C-x u and ;; per C-x u kaj plue modifu la du continue to edit the two buffers. ;; bufrojn. Kiam vi ne plu volas tajpi When you no longer want to edit in ;; dukolumne, vi eliru el la mal^cefa two columns, you turn off the minor ;; modalo per C-x 6 d. mode with C-x 6 d. ;; Aldone al dukolumna redaktado, ek- In addition to two-column editing of ;; zemple por skribi dulingvan tekston text, for example for writing a ;; flank-al-flanke kiel ^ci tiu, aliaj bilingual text side-by-side as shown ;; interesaj uzoj trovitas por tiu mal- here, other interesting uses have ;; ^cefa modalo: been found for this minor mode: ;; Vi povas disigi la kolumnojn per {+} You can separate the columns with ;; ajna pla^ca ^ceno starigante {+} any string that pleases you, by ;; `2C-separator'. Ekzemple "{+} " {+} setting `2C-separator'. For example ;; por amuzi^gi. f2 s a^u C-x 6 s {+} "{+} " if you'd like to have fun. ;; traktas tiujn kun prefiksa {+} f2 s or C-x 6 s handles these with a ;; argumento kiu signifas la longon {+} prefix argument that means the ;; de tia ^ceno. {+} desired length of such a string. ;; Programistoj eble ^satus la eblecon Programmers might like the ability ;; forspliti la komentarian kolumnon de to split off the comment column of a ;; dosiero kiel la sekvanta. Vi povas file that looks like the following. ;; rearan^gigi la paragrafon. La pro- You can fill-paragraph the comment. ;; blemo estas ke koda^jo tuj lar- The problem is, code quickly gets ;; ^gi^gas, tiel ke vi bezonas pli rather wide, so you need to use a ;; mallar^gan komentarian kolumnon. narrower comment column. Code lines ;; Koda^jaj linioj tra `comment-column' that reach beyond `comment-column' ;; ne problemas, krom ke vi ne vidos are no problem, except that you ;; iliajn finojn dum redaktado. won't see their end during editing. ;; BEGIN -- This is just some meaningless ;; FOR i IN 1..10 LOOP -- code in Ada, that runs foobar ;; foobar( i ); -- once for each argument from one ;; END LOOP; -- to ten, and then we're already ;; END; -- through with it. ;; Pli bone ankora^u, vi povas pozici- Better yet, you can put the point ;; i^gi anta^u "This", tajpi M-3 f2 s before "This", type M-3 f2 s ;; kiu igas "-- " la separigilon inter which makes "-- " the separator ;; senkomentaria Ada bufro kaj nur- between a no-comments Ada buffer, ;; teksta komentaria bufro. Kiam vi and a plain text comment buffer. ;; denove kuni^gos ilin, ^ciu nevaka When you put them back together, ;; linio de l' dua kolumno denove every non-empty line of the 2nd ;; anta^uhavos "-- ". column will again be preceded by ;; "-- ". ;;; Code: ;; Lucid patch (or (fboundp 'frame-width) (fset 'frame-width 'screen-width)) ;;;;; Set up keymap ;;;;; (defvar 2C-mode-map (let ((map (make-sparse-keymap))) (define-key map "2" '2C-two-columns) (define-key map [f2] '2C-two-columns) (define-key map "b" '2C-associate-buffer) (define-key map "s" '2C-split) map) "Keymap for commands for setting up two-column mode.") ;;;###autoload (autoload '2C-command "two-column" () t 'keymap) (fset '2C-command 2C-mode-map) ;;;###autoload ;; This one is for historical reasons and simple keyboards, it is not ;; at all mnemonic. All usual sequences containing 2 were used, and ;; f2 could not be set up in a standard way under Emacs 18. (global-set-key "\C-x6" '2C-command) ;;;###autoload (global-set-key [f2] '2C-command) (defvar 2C-minor-mode-map (let ((map (make-sparse-keymap))) (define-key map "1" '2C-merge) (define-key map "d" '2C-dissociate) (define-key map "o" '2C-associated-buffer) (define-key map "\^m" '2C-newline) (define-key map "|" '2C-toggle-autoscroll) (define-key map "{" '2C-shrink-window-horizontally) (define-key map "}" '2C-enlarge-window-horizontally) map) "Keymap for commands for use in two-column mode.") (setq minor-mode-map-alist (cons (cons '2C-mode (let ((map (make-sparse-keymap))) (substitute-key-definition '2C-command 2C-minor-mode-map map (current-global-map)) (substitute-key-definition 'enlarge-window-horizontally '2C-enlarge-window-horizontally map (current-global-map)) (substitute-key-definition 'shrink-window-horizontally '2C-shrink-window-horizontally map (current-global-map)) map)) minor-mode-map-alist)) ;;;;; variable declarations ;;;;; ;; Markers seem to be the only buffer-id not affected by renaming a buffer. ;; This nevertheless loses when a buffer is killed. The variable-name is ;; required by `describe-mode'. (defvar 2C-mode nil "Marker to the associated buffer, if non-nil.") (make-variable-buffer-local '2C-mode) (put '2C-mode 'permanent-local t) (setq minor-mode-alist (cons '(2C-mode " 2C") minor-mode-alist)) ;; rearranged, so that the pertinent info will show in 40 columns (defvar 2C-mode-line-format '("-%*- %15b --" (-3 . "%p") "--%[(" mode-name minor-mode-alist "%n" mode-line-process ")%]%-") "*Value of mode-line-format for a buffer in two-column minor mode.") (defvar 2C-other-buffer-hook 'text-mode "*Hook run in new buffer when it is associated with current one.") (defvar 2C-separator "" "*A string inserted between the two columns when merging. This gets set locally by \\[2C-split].") (put '2C-separator 'permanent-local t) (defvar 2C-window-width 40 "*The width of the first column. (Must be at least `window-min-width') This value is local for every buffer that sets it.") (make-variable-buffer-local '2C-window-width) (put '2C-window-width 'permanent-local t) (defvar 2C-beyond-fill-column 4 "*Base for calculating `fill-column' for a buffer in two-column minor mode. The value of `fill-column' becomes `2C-window-width' for this buffer minus this value.") (defvar 2C-autoscroll t "If non-nil, Emacs attempts to keep the two column's buffers aligned.") (defvar 2C-autoscroll-start nil) (make-variable-buffer-local '2C-autoscroll-start) ;;;;; base functions ;;;;; ;; The access method for the other buffer. This tries to remedy against ;; lost local variables and lost buffers. (defun 2C-other (&optional req) (or (if 2C-mode (or (prog1 (marker-buffer 2C-mode) (setq mode-line-format 2C-mode-line-format)) ;; The associated buffer somehow got killed. (progn ;; The other variables may later be useful if the user ;; reestablishes the association. (kill-local-variable '2C-mode) (kill-local-variable 'mode-line-format) nil))) (if req (error "You must first set two-column minor mode.")))) ;; function for setting up two-column minor mode in a buffer associated ;; with the buffer pointed to by the marker other. (defun 2C-mode (other) "Minor mode for independently editing two columns. This is set up for two associated buffers by the three commands bound to \\[2C-two-columns] , \\[2C-associate-buffer] and \\[2C-split]. Turning on two-column mode calls the value of the variable `2C-mode-hook', if that value is non-nil. These buffers can be edited separately, for example with `fill-paragraph'. If you want to disable parallel scrolling temporarily, use \\[2C-toggle-autoscroll] . If you include long lines, i.e which will span both columns (eg. source code), they should be in what will be the first column, with the associated buffer having empty lines next to them. Potential uses are writing bilingual texts, or editing the comments of a source code. See the file lisp/two-column.el for detailed examples. You have the following commands at your disposal: \\[2C-two-columns] Rearrange screen with current buffer first \\[2C-associate-buffer] Reassociate buffer after changing major mode \\[shrink-window-horizontally], \\[enlarge-window-horizontally] Shrink, enlarge current column \\[2C-associated-buffer] Switch to associated buffer at same point \\[2C-newline] Insert newline(s) in both buffers at same point \\[2C-merge] Merge both buffers \\[2C-dissociate] Dissociate the two buffers These keybindings can be customized in your ~/.emacs by `2C-mode-map', `2C-minor-mode-map' and by binding `2C-command' to some prefix. The appearance of the screen can be customized by the variables `2C-window-width', `2C-beyond-fill-column', `2C-mode-line-format' and `truncate-partial-width-windows'." (make-local-hook 'post-command-hook) (add-hook 'post-command-hook '2C-autoscroll nil t) (setq fill-column (- 2C-window-width 2C-beyond-fill-column) mode-line-format 2C-mode-line-format 2C-mode other) (run-hooks '2C-mode-hook)) ;;;###autoload (defun 2C-two-columns (&optional buffer) "Split current window vertically for two-column editing. When called the first time, associates a buffer with the current buffer in two-column minor mode (see \\[describe-mode] ). Runs `2C-other-buffer-hook' in the new buffer. When called again, restores the screen layout with the current buffer first and the associated buffer to it's right." (interactive "P") ;; first go to full width, so that we can certainly split into two windows (if (< (window-width) (frame-width)) (enlarge-window 99999 t)) (split-window-horizontally (max window-min-width (min 2C-window-width (- (frame-width) window-min-width)))) (if (2C-other) (progn (other-window 1) (switch-to-buffer (2C-other)) (other-window -1) (if 2C-autoscroll (2C-toggle-autoscroll t))) (2C-mode (prog1 (point-marker) (other-window 1) (switch-to-buffer (or buffer (generate-new-buffer (concat "2C/" (buffer-name))))) (or buffer (run-hooks '2C-other-buffer-hook)))) (2C-mode (prog1 (point-marker) (other-window -1))))) ;;;###autoload (defun 2C-associate-buffer () "Associate another buffer with this one in two-column minor mode. Can also be used to associate a just previously visited file, by accepting the proposed default buffer. \(See \\[describe-mode] .)" (interactive) (let ((b1 (current-buffer)) (b2 (or (2C-other) (read-buffer "Associate buffer: " (other-buffer))))) (save-excursion (setq 2C-mode nil) (set-buffer b2) (and (2C-other) (not (eq b1 (2C-other))) (error "Buffer already associated with buffer `%s'." (buffer-name (2C-other)))) (setq b1 (and (assq '2C-window-width (buffer-local-variables)) 2C-window-width))) ; if other buffer has a local width, adjust here too (if b1 (setq 2C-window-width (- (frame-width) b1))) (2C-two-columns b2))) ;;;###autoload (defun 2C-split (arg) "Split a two-column text at point, into two buffers in two-column minor mode. Point becomes the local value of `2C-window-width'. Only lines that have the ARG same preceding characters at that column get split. The ARG preceding characters without any leading whitespace become the local value for `2C-separator'. This way lines that continue across both columns remain untouched in the first buffer. This function can be used with a prototype line, to set up things. You write the first line of each column and then split that line. E.g.: First column's text sSs Second column's text \\___/\\ / \\ 5 character Separator You type M-5 \\[2C-split] with the point here. \(See \\[describe-mode] .)" (interactive "*p") (and (2C-other) (if (y-or-n-p (concat "Overwrite associated buffer `" (buffer-name (2C-other)) "'? ")) (save-excursion (set-buffer (2C-other)) (erase-buffer)) (signal 'quit nil))) (let ((point (point)) ; make next-line always come back to same column (goal-column (current-column)) ; a counter for empty lines in other buffer (n (1- (count-lines (point-min) (point)))) chars other) (save-excursion (backward-char arg) (setq chars (buffer-substring (point) point)) (skip-chars-forward " \t" point) (make-local-variable '2C-separator) (setq 2C-separator (buffer-substring (point) point) 2C-window-width (current-column))) (2C-two-columns) (setq other (2C-other)) ; now we're ready to actually split (save-excursion (while (not (eobp)) (if (not (and (= (current-column) goal-column) (string= chars (buffer-substring (point) (save-excursion (backward-char arg) (point)))))) (setq n (1+ n)) (setq point (point)) (backward-char arg) (skip-chars-backward " \t") (delete-region point (point)) (setq point (point)) (insert-char ?\n n) (append-to-buffer other point (progn (end-of-line) (if (eobp) (point) (1+ (point))))) (delete-region point (point)) (setq n 0)) (next-line 1))))) (defun 2C-dissociate () "Turn off two-column minor mode in current and associated buffer. If the associated buffer is unmodified and empty, it is killed." (interactive) (let ((buffer (current-buffer))) (save-excursion (and (2C-other) (set-buffer (2C-other)) (or (not (2C-other)) (eq buffer (2C-other))) (if (and (not (buffer-modified-p)) (eobp) (bobp)) (kill-buffer nil) (kill-local-variable '2C-mode) (kill-local-variable '2C-window-width) (kill-local-variable '2C-separator) (kill-local-variable 'mode-line-format) (kill-local-variable 'fill-column)))) (kill-local-variable '2C-mode) (kill-local-variable '2C-window-width) (kill-local-variable '2C-separator) (kill-local-variable 'mode-line-format) (kill-local-variable 'fill-column))) ;; this doesn't use yank-rectangle, so that the first column can ;; contain long lines (defun 2C-merge () "Merges the associated buffer with the current buffer. They get merged at the column, which is the value of `2C-window-width', i.e. usually at the vertical window separator. This separator gets replaced with white space. Beyond that the value of `2C-separator' gets inserted on merged lines. The two columns are thus pasted side by side, in a single text. If the other buffer is not displayed to the left of this one, then this one becomes the left column. If you want `2C-separator' on empty lines in the second column, you should put just one space in them. In the final result, you can strip off trailing spaces with \\[beginning-of-buffer] \\[replace-regexp] [ SPC TAB ] + $ RET RET" (interactive) (and (> (car (window-edges)) 0) ; not touching left edge of screen (eq (window-buffer (previous-window)) (2C-other t)) (other-window -1)) (save-excursion (let ((b1 (current-buffer)) (b2 (2C-other t)) string) (goto-char (point-min)) (set-buffer b2) (goto-char (point-min)) (while (not (eobp)) (setq string (buffer-substring (point) (progn (end-of-line) (point)))) (or (eobp) (forward-char)) ; next line (set-buffer b1) (if (string= string "") () (end-of-line) (indent-to-column 2C-window-width) (insert 2C-separator string)) (next-line 1) ; add one if necessary (set-buffer b2)))) (if (< (window-width) (frame-width)) (enlarge-window 99999 t))) ;;;;; utility functions ;;;;; (defun 2C-associated-buffer () "Switch to associated buffer." (interactive) (let ((line (+ (count-lines (point-min) (point)) (if (bolp) 1 0))) (col (if (eolp) (if (bolp) 0) (current-column)))) (if (get-buffer-window (2C-other t)) (select-window (get-buffer-window (2C-other))) (switch-to-buffer (2C-other))) (newline (goto-line line)) (if col (move-to-column col) (end-of-line 1)))) (defun 2C-newline (arg) "Insert ARG newlines in both buffers." (interactive "P") (save-window-excursion (2C-associated-buffer) (newline arg)) (newline arg)) (defun 2C-toggle-autoscroll (arg) "Toggle autoscrolling, or set it iff prefix ARG is non-nil and positive. When autoscrolling is turned on, this also realigns the two buffers." (interactive "P") ;(sit-for 0) (setq 2C-autoscroll-start (window-start)) (if (setq 2C-autoscroll (if arg (>= (prefix-numeric-value arg) 0) (not 2C-autoscroll))) (select-window (prog1 (selected-window) (message "Autoscrolling is on.") (setq arg (count-lines (point-min) (window-start))) (if (get-buffer-window (2C-other t)) (progn (select-window (get-buffer-window (2C-other))) (setq arg (- arg (count-lines (point-min) (window-start)))) ;; make sure that other buffer has enough lines (save-excursion (insert-char ?\n (- arg (count-lines (window-start) (goto-char (point-max))) -1))) (scroll-up arg))))) (message "Autoscrolling is off."))) (defun 2C-autoscroll () (if 2C-autoscroll ;; catch a mouse scroll on non-selected scrollbar (select-window (prog1 (selected-window) (and (consp last-command-char) (not (eq (selected-window) (car (car (cdr last-command-char))))) (select-window (car (car (cdr last-command-char))))) ;; In some cases scrolling causes an error, but post-command-hook ;; shouldn't, and should always stay in the original window (condition-case () (and (or 2C-autoscroll-start (2C-toggle-autoscroll t) nil) (/= (window-start) 2C-autoscroll-start) (2C-other) (get-buffer-window (2C-other)) (let ((lines (count-lines (window-start) 2C-autoscroll-start))) (if (< (window-start) 2C-autoscroll-start) (setq lines (- lines))) (setq 2C-autoscroll-start (window-start)) (select-window (get-buffer-window (2C-other))) ;; make sure that other buffer has enough lines (save-excursion (insert-char ?\n (- lines (count-lines (window-start) (goto-char (point-max))) -1))) (scroll-up lines) (setq 2C-autoscroll-start (window-start)))) (error)))))) (defun 2C-enlarge-window-horizontally (arg) "Make current window ARG columns wider." (interactive "p") (enlarge-window arg t) (and (2C-other) (setq 2C-window-width (+ 2C-window-width arg)) (set-buffer (2C-other)) (setq 2C-window-width (- 2C-window-width arg)))) (defun 2C-shrink-window-horizontally (arg) "Make current window ARG columns narrower." (interactive "p") (2C-enlarge-window-horizontally (- arg))) (provide 'two-column) ;;; two-column.el ends here emacs-19.30/lisp/type-break.el100644 21641 13 103523 5670630625 15245 0ustar friedmanuser;;; type-break.el --- encourage rests from typing at appropriate intervals ;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Author: Noah Friedman ;; Maintainer: friedman@prep.ai.mit.edu ;; Keywords: extensions, timers ;; Status: Works in GNU Emacs 19.25 or later ;; Created: 1994-07-13 ;; $Id: type-break.el,v 1.10 1994/10/06 19:12:46 friedman Exp friedman $ ;; 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: ;; The docstring for the function `type-break-mode' summarizes most of the ;; details of the interface. ;; This package relies on the assumption that you live entirely in emacs, ;; as the author does. If that's not the case for you (e.g. you often ;; suspend emacs or work in other windows) then this won't help very much; ;; it will depend on just how often you switch back to emacs. At the very ;; least, you will want to turn off the keystroke thresholds and rest ;; interval tracking. ;; This program has no hope of working in Emacs 18, and it doesn't ;; presently work in Lucid Emacs/XEmacs because the timer.el package is ;; entirely different. ;; This program can truly cons up a storm because of all the calls to ;; `current-time' (which always returns 3 fresh conses). I'm dismayed by ;; this, but I think the health of my hands is far more important than a ;; few pages of virtual memory. ;; This package was inspired by Roland McGrath's hanoi-break.el. ;; Several people contributed feedback and ideas, including ;; Roland McGrath ;; Kleanthes Koniaris ;; Mark Ashton ;; Matt Wilding ;;; Code: (require 'timer) ;; Make this nil initially so that the call to type-break-mode at the end ;; will cause scheduling and so forth to happen. ;;;###autoload (defvar type-break-mode nil "*Non-`nil' means typing break mode is enabled. See the docstring for the `type-break-mode' command for more information.") (defvar type-break-warning-message-mode t "*Non-`nil' means warn about imminent typing breaks in echo area. See the docstring for the `type-break-warning-message-mode' command for more information.") ;;;###autoload (defvar type-break-interval (* 60 60) "*Number of seconds between scheduled typing breaks.") ;;;###autoload (defvar type-break-good-rest-interval (/ type-break-interval 6) "*Number of seconds of idle time considered to be an adequate typing rest. When this variable is non-`nil', emacs checks the idle time between keystrokes. If this idle time is long enough to be considered a \"good\" rest from typing, then the next typing break is simply rescheduled for later. If a break is interrupted before this much time elapses, the user will be asked whether or not really to interrupt the break.") ;;;###autoload (defvar type-break-keystroke-threshold ;; Assuming typing speed is 35wpm (on the average, do you really ;; type more than that in a minute? I spend a lot of time reading mail ;; and simply studying code in buffers) and average word length is ;; about 5 letters, default upper threshold to the average number of ;; keystrokes one is likely to type in a break interval. That way if the ;; user goes through a furious burst of typing activity, cause a typing ;; break to be required sooner than originally scheduled. ;; Conversely, the minimum threshold should be about a fifth of this. (let* ((wpm 35) (avg-word-length 5) (upper (* wpm avg-word-length (/ type-break-interval 60))) (lower (/ upper 5))) (cons lower upper)) "*Upper and lower bound on number of keystrokes for considering typing break. This structure is a pair of numbers. The first number is the minimum number of keystrokes that must have been entered since the last typing break before considering another one, even if the scheduled time has elapsed; the break is simply rescheduled until later if the minimum threshold hasn't been reached. If this first value is nil, then there is no minimum threshold; as soon as the scheduled time has elapsed, the user will always be queried. The second number is the maximum number of keystrokes that can be entered before a typing break is requested immediately, pre-empting the originally scheduled break. If this second value is nil, then no pre-emptive breaks will occur; only scheduled ones will. Keys with bucky bits (shift, control, meta, etc) are counted as only one keystroke even though they really require multiple keys to generate them. The command `type-break-guestimate-keystroke-threshold' can be used to guess a reasonably good pair of values for this variable.") (defvar type-break-query-function 'yes-or-no-p "Function to use for making query for a typing break. It should take a string as an argument, the prompt. Usually this should be set to `yes-or-no-p' or `y-or-n-p'. Some people prefer a less intrusive way of being reminded to take a typing break. One possibility is simply to beep a couple of times. To accomplish this, one could do: (defun my-type-break-query (&optional ignored-args) (beep t) (message \"You should take a typing break now. Do `M-x type-break'.\") (sit-for 1) (beep t) ;; return nil so query caller knows to reset reminder, as if user ;; said \"no\" in response to yes-or-no-p. nil) (setq type-break-query-function 'my-type-break-query)") (defvar type-break-query-interval 60 "*Number of seconds between queries to take a break, if put off. The user will continue to be prompted at this interval until he or she finally submits to taking a typing break.") (defvar type-break-time-warning-intervals '(300 120 60 30) "*List of time intervals for warnings about upcoming typing break. At each of the intervals (specified in seconds) away from a scheduled typing break, print a warning in the echo area.") (defvar type-break-keystroke-warning-intervals '(300 200 100 50) "*List of keystroke measurements for warnings about upcoming typing break. At each of the intervals (specified in keystrokes) away from the upper keystroke threshold, print a warning in the echo area. If either this variable or the upper threshold is set, then no warnings Will occur.") (defvar type-break-warning-repeat 40 "*Number of keystrokes for which warnings should be repeated. That is, for each of this many keystrokes the warning is redisplayed in the echo area to make sure it's really seen.") (defvar type-break-warning-countdown-string nil "If non-nil, this is a countdown for the next typing break. This variable, in conjunction with `type-break-warning-countdown-string-type' (which indicates whether this value is a number of keystrokes or seconds) can be installed by the user somewhere in mode-line-format to notify of imminent typing breaks there. For example, you could do (defvar type-break-mode-line-string '(type-break-warning-countdown-string (\" ***Break in \" type-break-warning-countdown-string \" \" type-break-warning-countdown-string-type \"***\"))) (setq global-mode-string (append global-mode-string '(type-break-mode-line-string))) If you do this, you may also wish to disable the warning messages in the minibuffer. To do this, either set the variable `type-break-warning-message-mode' to `nil' or call the function of the same name with a negative argument.") (defvar type-break-warning-countdown-string-type nil "Indicates the unit type of `type-break-warning-countdown-string'. It will be either \"seconds\" or \"keystrokes\".") (defvar type-break-demo-functions '(type-break-demo-boring type-break-demo-life type-break-demo-hanoi) "*List of functions to consider running as demos during typing breaks. When a typing break begins, one of these functions is selected randomly to have emacs do something interesting. Any function in this list should start a demo which ceases as soon as a key is pressed.") (defvar type-break-post-command-hook nil "Hook run indirectly by post-command-hook for typing break functions. This is not really intended to be set by the user, but it's probably harmless to do so. Mainly it is used by various parts of the typing break program to delay actions until after the user has completed some command. It exists because `post-command-hook' itself is inaccessible while its functions are being run, and some type-break--related functions want to remove themselves after running.") ;; These are internal variables. Do not set them yourself. (defvar type-break-alarm-p nil) (defvar type-break-keystroke-count 0) (defvar type-break-time-last-break nil) (defvar type-break-time-next-break nil) (defvar type-break-time-last-command (current-time)) (defvar type-break-current-time-warning-interval nil) (defvar type-break-current-keystroke-warning-interval nil) (defvar type-break-time-warning-count 0) (defvar type-break-keystroke-warning-count 0) ;;;###autoload (defun type-break-mode (&optional prefix) "Enable or disable typing-break mode. This is a minor mode, but it is global to all buffers by default. When this mode is enabled, the user is encouraged to take typing breaks at appropriate intervals; either after a specified amount of time or when the user has exceeded a keystroke threshold. When the time arrives, the user is asked to take a break. If the user refuses at that time, emacs will ask again in a short period of time. The idea is to give the user enough time to find a good breaking point in his or her work, but be sufficiently annoying to discourage putting typing breaks off indefinitely. A negative prefix argument disables this mode. No argument or any non-negative argument enables it. The user may enable or disable this mode by setting the variable of the same name, though setting it in that way doesn't reschedule a break or reset the keystroke counter. If the mode was previously disabled and is enabled as a consequence of calling this function, it schedules a break with `type-break-schedule' to make sure one occurs (the user can call that command to reschedule the break at any time). It also initializes the keystroke counter. The variable `type-break-interval' specifies the number of seconds to schedule between regular typing breaks. This variable doesn't directly affect the time schedule; it simply provides a default for the `type-break-schedule' command. If set, the variable `type-break-good-rest-interval' specifies the minimum amount of time which is considered a reasonable typing break. Whenever that time has elapsed, typing breaks are automatically rescheduled for later even if emacs didn't prompt you to take one first. Also, if a break is ended before this much time has elapsed, the user will be asked whether or not to continue. The variable `type-break-keystroke-threshold' is used to determine the thresholds at which typing breaks should be considered. You can use the command `type-break-guestimate-keystroke-threshold' to try to approximate good values for this. There are several variables that affect how or when warning messages about imminent typing breaks are displayed. They include: type-break-warning-message-mode type-break-time-warning-intervals type-break-keystroke-warning-intervals type-break-warning-repeat type-break-warning-countdown-string type-break-warning-countdown-string-type There are several variables that affect how and when queries to begin a typing break occur. They include: type-break-query-function type-break-query-interval Finally, the command `type-break-statistics' prints interesting things." (interactive "P") ;; make sure it's there. (add-hook 'post-command-hook 'type-break-run-tb-post-command-hook 'append) (add-hook 'type-break-post-command-hook 'type-break-check) (let ((already-enabled type-break-mode)) (setq type-break-mode (>= (prefix-numeric-value prefix) 0)) (cond ((and already-enabled type-break-mode) (and (interactive-p) (message "type-break-mode is enabled"))) (type-break-mode (type-break-keystroke-reset) (type-break-schedule) (and (interactive-p) (message "type-break-mode is enabled and reset"))) ((interactive-p) (message "type-break-mode is disabled")))) type-break-mode) (defun type-break-warning-message-mode (&optional prefix) "Enable or disable warnings in the echo area about imminent typing breaks. A negative prefix argument disables this mode. No argument or any non-negative argument enables it. The user may also enable or disable this mode simply by setting the variable of the same name." (interactive "P") (setq type-break-warning-message-mode (>= (prefix-numeric-value prefix) 0)) (cond ((not (interactive-p))) (type-break-warning-message-mode (message "type-break-warning-message-mode is enabled")) (t (message "type-break-warning-message-mode is disabled"))) type-break-warning-message-mode) ;;;###autoload (defun type-break () "Take a typing break. During the break, a demo selected from the functions listed in `type-break-demo-functions' is run. After the typing break is finished, the next break is scheduled as per the function `type-break-schedule'." (interactive) (type-break-cancel-schedule) (let ((continue t) (start-time (current-time))) (setq type-break-time-last-break start-time) (while continue (save-window-excursion ;; Eat the screen. (and (eq (selected-window) (minibuffer-window)) (other-window 1)) (delete-other-windows) (scroll-right (window-width)) (message "Press any key to resume from typing break.") (random t) (let* ((len (length type-break-demo-functions)) (idx (random len)) (fn (nth idx type-break-demo-functions))) (condition-case () (funcall fn) (error nil)))) (cond (type-break-good-rest-interval (let ((break-secs (type-break-time-difference start-time (current-time)))) (cond ((>= break-secs type-break-good-rest-interval) (setq continue nil)) ;; 60 seconds may be too much leeway if the break is only 3 ;; minutes to begin with. You can just say "no" to the query ;; below if you're in that much of a hurry. ;((> 60 (abs (- break-secs type-break-good-rest-interval))) ; (setq continue nil)) ((funcall type-break-query-function (format "You really ought to rest %s more. Continue break? " (type-break-format-time (- type-break-good-rest-interval break-secs))))) (t (setq continue nil))))) (t (setq continue nil))))) (type-break-keystroke-reset) (type-break-schedule)) (defun type-break-schedule (&optional time) "Schedule a typing break for TIME seconds from now. If time is not specified, default to `type-break-interval'." (interactive (list (and current-prefix-arg (prefix-numeric-value current-prefix-arg)))) (or time (setq time type-break-interval)) (let ((type-break-mode t)) (type-break-mode 1)) (type-break-cancel-schedule) (type-break-time-warning-schedule time 'reset) (run-at-time (max 1 time) nil 'type-break-alarm) (setq type-break-time-next-break (type-break-time-sum (current-time) time))) (defun type-break-cancel-schedule () (type-break-cancel-time-warning-schedule) (let ((timer-dont-exit t)) (cancel-function-timers 'type-break-alarm)) (setq type-break-alarm-p nil) (setq type-break-time-next-break nil)) (defun type-break-time-warning-schedule (&optional time resetp) (let ((type-break-current-time-warning-interval nil)) (type-break-cancel-time-warning-schedule)) (cond (type-break-time-warning-intervals (and resetp (setq type-break-current-time-warning-interval type-break-time-warning-intervals)) (or time (setq time (type-break-time-difference (current-time) type-break-time-next-break))) (while (and type-break-current-time-warning-interval (> (car type-break-current-time-warning-interval) time)) (setq type-break-current-time-warning-interval (cdr type-break-current-time-warning-interval))) (cond (type-break-current-time-warning-interval (setq time (- time (car type-break-current-time-warning-interval))) (setq type-break-current-time-warning-interval (cdr type-break-current-time-warning-interval)) ;(let (type-break-current-time-warning-interval) ; (type-break-cancel-time-warning-schedule)) (run-at-time (max 1 time) nil 'type-break-time-warning-alarm) (cond (resetp (setq type-break-warning-countdown-string nil)) (t (setq type-break-warning-countdown-string (number-to-string time)) (setq type-break-warning-countdown-string-type "seconds")))))))) (defun type-break-cancel-time-warning-schedule () (let ((timer-dont-exit t)) (cancel-function-timers 'type-break-time-warning-alarm)) (remove-hook 'type-break-post-command-hook 'type-break-time-warning) (setq type-break-current-time-warning-interval type-break-time-warning-intervals) (setq type-break-warning-countdown-string nil)) (defun type-break-alarm () (let ((type-break-mode t)) (type-break-mode 1)) (setq type-break-alarm-p t)) (defun type-break-time-warning-alarm () (let ((type-break-mode t)) (type-break-mode 1)) (type-break-time-warning-schedule) (setq type-break-time-warning-count type-break-warning-repeat) (add-hook 'type-break-post-command-hook 'type-break-time-warning 'append)) (defun type-break-run-tb-post-command-hook () (and type-break-mode (run-hooks 'type-break-post-command-hook))) (defun type-break-check () "Ask to take a typing break if appropriate. This may be the case either because the scheduled time has come \(and the minimum keystroke threshold has been reached\) or because the maximum keystroke threshold has been exceeded." (let* ((min-threshold (car type-break-keystroke-threshold)) (max-threshold (cdr type-break-keystroke-threshold))) (and type-break-good-rest-interval (progn (and (> (type-break-time-difference type-break-time-last-command (current-time)) type-break-good-rest-interval) (progn (type-break-keystroke-reset) (setq type-break-time-last-break (current-time)) (type-break-schedule))) (setq type-break-time-last-command (current-time)))) (and type-break-keystroke-threshold (let ((keys (this-command-keys))) (cond ;; Ignore mouse motion ((and (vectorp keys) (consp (aref keys 0)) (memq (car (aref keys 0)) '(mouse-movement)))) (t (setq type-break-keystroke-count (+ type-break-keystroke-count (length keys))))))) (cond (type-break-alarm-p (cond ((input-pending-p)) ((eq (selected-window) (minibuffer-window))) ((and min-threshold (< type-break-keystroke-count min-threshold)) (type-break-schedule)) (t ;; If keystroke count is within min-threshold of ;; max-threshold, lower it to reduce the liklihood of an ;; immediate subsequent query. (and max-threshold min-threshold (< (- max-threshold type-break-keystroke-count) min-threshold) (progn (type-break-keystroke-reset) (setq type-break-keystroke-count min-threshold))) (type-break-query)))) ((and type-break-keystroke-warning-intervals max-threshold (= type-break-keystroke-warning-count 0) (type-break-check-keystroke-warning))) ((and max-threshold (> type-break-keystroke-count max-threshold) (not (input-pending-p)) (not (eq (selected-window) (minibuffer-window)))) (type-break-keystroke-reset) (setq type-break-keystroke-count (or min-threshold 0)) (type-break-query))))) ;; This should return t if warnings were enabled, nil otherwise. (defsubst type-break-check-keystroke-warning () ;; This is safe because the caller should have checked that the cdr was ;; non-nil already. (let ((left (- (cdr type-break-keystroke-threshold) type-break-keystroke-count))) (cond ((null (car type-break-current-keystroke-warning-interval)) nil) ((> left (car type-break-current-keystroke-warning-interval)) nil) (t (while (and (car type-break-current-keystroke-warning-interval) (< left (car type-break-current-keystroke-warning-interval))) (setq type-break-current-keystroke-warning-interval (cdr type-break-current-keystroke-warning-interval))) (setq type-break-keystroke-warning-count type-break-warning-repeat) (add-hook 'type-break-post-command-hook 'type-break-keystroke-warning) (setq type-break-warning-countdown-string (number-to-string left)) (setq type-break-warning-countdown-string-type "keystrokes") t)))) ;; Arrange for a break query to be made, when the user stops typing furiously. (defun type-break-query () (add-hook 'type-break-post-command-hook 'type-break-do-query)) ;; Ask to take a break, but only after the user stops typing continuously ;; for at least a second. Renaming the minibuffer because you did M-x ;; rename-buffer just as type-break popped the question is... annoying. (defun type-break-do-query () (cond ((sit-for 1) (condition-case () (cond ((let ((type-break-mode nil) ;; yes-or-no-p sets this-command to exit-minibuffer, ;; which hoses undo or yank-pop (if you happened to be ;; yanking just when the query occured). (this-command this-command)) (funcall type-break-query-function "Take a break from typing now? ")) (type-break)) (t (type-break-schedule type-break-query-interval))) (quit (type-break-schedule type-break-query-interval))) (remove-hook 'type-break-post-command-hook 'type-break-do-query)))) (defun type-break-time-warning () (cond ((and (car type-break-keystroke-threshold) (< type-break-keystroke-count (car type-break-keystroke-threshold)))) ((> type-break-time-warning-count 0) (let ((timeleft (type-break-time-difference (current-time) type-break-time-next-break))) (setq type-break-warning-countdown-string (number-to-string timeleft)) (cond ((eq (selected-window) (minibuffer-window))) ;; Do nothing if the command was just a prefix arg, since that will ;; immediately be followed by some other interactive command. ((memq this-command '(digit-argument universal-argument))) (type-break-warning-message-mode ;; Pause for a moment so any previous message can be seen. (sit-for 2) (message "Warning: typing break due in %s." (type-break-format-time timeleft)) (setq type-break-time-warning-count (1- type-break-time-warning-count)))))) (t (remove-hook 'type-break-post-command-hook 'type-break-time-warning) (setq type-break-warning-countdown-string nil)))) (defun type-break-keystroke-warning () (cond ((> type-break-keystroke-warning-count 0) (setq type-break-warning-countdown-string (number-to-string (- (cdr type-break-keystroke-threshold) type-break-keystroke-count))) (cond ((eq (selected-window) (minibuffer-window))) (type-break-warning-message-mode (sit-for 2) (message "Warning: typing break due in %s keystrokes." (- (cdr type-break-keystroke-threshold) type-break-keystroke-count)) (setq type-break-keystroke-warning-count (1- type-break-keystroke-warning-count))))) (t (remove-hook 'type-break-post-command-hook 'type-break-keystroke-warning) (setq type-break-warning-countdown-string nil)))) ;;;###autoload (defun type-break-statistics () "Print statistics about typing breaks in a temporary buffer. This includes the last time a typing break was taken, when the next one is scheduled, the keystroke thresholds and the current keystroke count, etc." (interactive) (with-output-to-temp-buffer "*Typing Break Statistics*" (princ (format "Typing break statistics\n-----------------------\n Typing break mode is currently %s. Warnings of imminent typing breaks in echo area is %s. Last typing break ended : %s Next scheduled typing break : %s\n Minimum keystroke threshold : %s Maximum keystroke threshold : %s Current keystroke count : %s" (if type-break-mode "enabled" "disabled") (if type-break-warning-message-mode "enabled" "disabled") (if type-break-time-last-break (current-time-string type-break-time-last-break) "never") (if (and type-break-mode type-break-time-next-break) (format "%s\t(%s from now)" (current-time-string type-break-time-next-break) (type-break-format-time (type-break-time-difference (current-time) type-break-time-next-break))) "none scheduled") (or (car type-break-keystroke-threshold) "none") (or (cdr type-break-keystroke-threshold) "none") type-break-keystroke-count)))) ;;;###autoload (defun type-break-guestimate-keystroke-threshold (wpm &optional wordlen frac) "Guess values for the minimum/maximum keystroke threshold for typing breaks. If called interactively, the user is prompted for their guess as to how many words per minute they usually type. This value should not be your maximum WPM, but your average. Of course, this is harder to gauge since it can vary considerably depending on what you are doing. For example, one tends actually to type less when debugging a program, as opposed to writing documentation. (Perhaps a separate program should be written to estimate average typing speed.) From that, this command sets the values in `type-break-keystroke-threshold' based on a fairly simple algorithm involving assumptions about the average length of words (5). For the minimum threshold, it uses about a fifth of the computed maximum threshold. When called from lisp programs, the optional args WORDLEN and FRAC can be used to override the default assumption about average word length and the fraction of the maximum threshold to which to set the minimum threshold. FRAC should be the inverse of the fractional value; for example, a value of 2 would mean to use one half, a value of 4 would mean to use one quarter, etc." (interactive "NOn average, how many words per minute do you type? ") (let* ((upper (* wpm (or wordlen 5) (/ type-break-interval 60))) (lower (/ upper (or frac 5)))) (or type-break-keystroke-threshold (setq type-break-keystroke-threshold (cons nil nil))) (setcar type-break-keystroke-threshold lower) (setcdr type-break-keystroke-threshold upper) (if (interactive-p) (message "min threshold: %d\tmax threshold: %d" lower upper) type-break-keystroke-threshold))) ;;; misc functions ;; Compute the difference, in seconds, between a and b, two structures ;; similar to those returned by `current-time'. ;; Use addition rather than logand since that is more robust; the low 16 ;; bits of the seconds might have been incremented, making it more than 16 ;; bits wide. (defsubst type-break-time-difference (a b) (+ (lsh (- (car b) (car a)) 16) (- (car (cdr b)) (car (cdr a))))) ;; Return (in a new list the same in structure to that returned by ;; `current-time') the sum of the arguments. Each argument may be a time ;; list or a single integer, a number of seconds. ;; This function keeps the high and low 16 bits of the seconds properly ;; balanced so that the lower value never exceeds 16 bits. Otherwise, when ;; the result is passed to `current-time-string' it will toss some of the ;; "low" bits and return the wrong value. (defun type-break-time-sum (&rest tmlist) (let ((high 0) (low 0) (micro 0) tem) (while tmlist (setq tem (car tmlist)) (setq tmlist (cdr tmlist)) (cond ((numberp tem) (setq low (+ low tem))) (t (setq high (+ high (or (car tem) 0))) (setq low (+ low (or (car (cdr tem)) 0))) (setq micro (+ micro (or (car (cdr (cdr tem))) 0)))))) (and (>= micro 1000000) (progn (setq tem (/ micro 1000000)) (setq low (+ low tem)) (setq micro (- micro (* tem 1000000))))) (setq tem (lsh low -16)) (and (> tem 0) (progn (setq low (logand low 65535)) (setq high (+ high tem)))) (list high low micro))) (defsubst type-break-format-time (secs) (let ((mins (/ secs 60))) (cond ((= mins 1) (format "%d minute" mins)) ((> mins 0) (format "%d minutes" mins)) ((= secs 1) (format "%d second" secs)) (t (format "%d seconds" secs))))) (defun type-break-keystroke-reset () (setq type-break-keystroke-count 0) (setq type-break-keystroke-warning-count 0) (setq type-break-current-keystroke-warning-interval type-break-keystroke-warning-intervals) (remove-hook 'type-break-post-command-hook 'type-break-keystroke-warning)) ;;; Demo wrappers ;; This is a wrapper around hanoi that calls it with an arg large enough to ;; make the largest discs possible that will fit in the window. ;; Also, clean up the *Hanoi* buffer after we're done. (defun type-break-demo-hanoi () "Take a hanoiing typing break." (and (get-buffer "*Hanoi*") (kill-buffer "*Hanoi*")) (condition-case () (progn (hanoi (/ (window-width) 8)) ;; Wait for user to come back. (read-char) (kill-buffer "*Hanoi*")) (quit ;; eat char (read-char) (and (get-buffer "*Hanoi*") (kill-buffer "*Hanoi*"))))) ;; This is a wrapper around life that calls it with a `sleep' arg to make ;; it run a little more leisurely. ;; Also, clean up the *Life* buffer after we're done. (defun type-break-demo-life () "Take a typing break and get a life." (let ((continue t)) (while continue (setq continue nil) (and (get-buffer "*Life*") (kill-buffer "*Life*")) (condition-case () (progn (life 3) ;; wait for user to return (read-char) (kill-buffer "*Life*")) (life-extinct (message (get 'life-extinct 'error-message)) (sit-for 3) ;; restart demo (setq continue t)) (quit (and (get-buffer "*Life*") (kill-buffer "*Life*"))))))) ;; Boring demo, but doesn't use many cycles (defun type-break-demo-boring () "Boring typing break demo." (let ((rmsg "Press any key to resume from typing break") (buffer-name "*Typing Break Buffer*") line col pos elapsed timeleft tmsg) (condition-case () (progn (switch-to-buffer (get-buffer-create buffer-name)) (buffer-disable-undo (current-buffer)) (erase-buffer) (setq line (1+ (/ (window-height) 2))) (setq col (/ (- (window-width) (length rmsg)) 2)) (insert (make-string line ?\C-j) (make-string col ?\ ) rmsg) (forward-line -1) (beginning-of-line) (setq pos (point)) (while (not (input-pending-p)) (delete-region pos (progn (goto-char pos) (end-of-line) (point))) (setq elapsed (type-break-time-difference type-break-time-last-break (current-time))) (cond (type-break-good-rest-interval (setq timeleft (- type-break-good-rest-interval elapsed)) (if (> timeleft 0) (setq tmsg (format "You should rest for %s more" (type-break-format-time timeleft))) (setq tmsg (format "Typing break has lasted %s" (type-break-format-time elapsed))))) (t (setq tmsg (format "Typing break has lasted %s" (type-break-format-time elapsed))))) (setq col (/ (- (window-width) (length tmsg)) 2)) (insert (make-string col ?\ ) tmsg) (goto-char (point-min)) (sit-for 60)) (read-char) (kill-buffer buffer-name)) (quit (and (get-buffer buffer-name) (kill-buffer buffer-name)))))) (provide 'type-break) ;; Do not do this at load time because it makes it impossible to load this ;; file into temacs and then dump it. ;(type-break-mode t) ;; local variables: ;; vc-make-backup-files: t ;; end: ;;; type-break.el ends here emacs-19.30/lisp/uncompress.el100444 75424 13 6763 5561553517 14557 0ustar kwzhuser;;; uncompress.el --- auto-decompression hook for visiting .Z files ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; 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 package can be used to arrange for automatic uncompress of ;; files packed with the UNIX compress(1) utility when they are visited. ;; All that's necessary is to load it. This can conveniently be done from ;; your .emacs file. ;;; Code: ;; When we are about to make a backup file, ;; uncompress the file we visited ;; so that making the backup can work properly. ;; This is used as a write-file-hook. (defvar uncompress-program "gunzip" "Program to use for uncompression.") (defun uncompress-backup-file () (and buffer-file-name make-backup-files (not buffer-backed-up) (not (file-exists-p buffer-file-name)) (call-process uncompress-program nil nil nil buffer-file-name)) nil) (or (assoc "\\.Z$" auto-mode-alist) (setq auto-mode-alist (cons '("\\.Z$" . uncompress-while-visiting) auto-mode-alist))) (or (assoc "\\.gz$" auto-mode-alist) (setq auto-mode-alist (cons '("\\.gz$" . uncompress-while-visiting) auto-mode-alist))) (defun uncompress-while-visiting () "Temporary \"major mode\" used for .Z and .gz files, to uncompress them. It then selects a major mode from the uncompressed file name and contents." (if (and (not (null buffer-file-name)) (string-match "\\.Z$" buffer-file-name)) (set-visited-file-name (substring buffer-file-name 0 (match-beginning 0))) (if (and (not (null buffer-file-name)) (string-match "\\.gz$" buffer-file-name)) (set-visited-file-name (substring buffer-file-name 0 (match-beginning 0))))) (message "Uncompressing...") (let ((buffer-read-only nil)) (shell-command-on-region (point-min) (point-max) uncompress-program t)) (message "Uncompressing...done") (set-buffer-modified-p nil) (make-local-variable 'write-file-hooks) (or (memq 'uncompress-backup-file write-file-hooks) (setq write-file-hooks (cons 'uncompress-backup-file write-file-hooks))) (normal-mode)) (or (memq 'find-compressed-version find-file-not-found-hooks) (setq find-file-not-found-hooks (cons 'find-compressed-version find-file-not-found-hooks))) (defun find-compressed-version () "Hook to read and uncompress the compressed version of a file." ;; Just pretend we had visited the compressed file, ;; and uncompress-while-visiting will do the rest. (let (name) (if (file-exists-p (setq name (concat buffer-file-name ".Z"))) (setq buffer-file-name name) (if (file-exists-p (setq name (concat buffer-file-name ".gz"))) (setq buffer-file-name name))) (if (eq name buffer-file-name) (progn (insert-file-contents buffer-file-name t) (goto-char (point-min)) (setq error nil) t)))) (provide 'uncompress) ;;; uncompress.el ends here emacs-19.30/lisp/underline.el100444 75424 13 4110 5541152540 14313 0ustar kwzhuser;;; underline.el --- insert/remove underlining (done by overstriking) in Emacs. ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: wp ;; 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 package deals with the primitive form of underlining ;; consisting of prefixing each character with "_\^h". The entry ;; point `underline-region' performs such underlining on a region. ;; The entry point `ununderline-region' removes it. ;;; Code: ;;;###autoload (defun underline-region (start end) "Underline all nonblank characters in the region. Works by overstriking underscores. Called from program, takes two arguments START and END which specify the range to operate on." (interactive "r") (save-excursion (let ((end1 (make-marker))) (move-marker end1 (max start end)) (goto-char (min start end)) (while (< (point) end1) (or (looking-at "[_\^@- ]") (insert "_\b")) (forward-char 1))))) ;;;###autoload (defun ununderline-region (start end) "Remove all underlining (overstruck underscores) in the region. Called from program, takes two arguments START and END which specify the range to operate on." (interactive "r") (save-excursion (let ((end1 (make-marker))) (move-marker end1 (max start end)) (goto-char (min start end)) (while (re-search-forward "_\b\\|\b_" end1 t) (delete-char -2))))) ;;; underline.el ends here emacs-19.30/lisp/undigest.el100444 12120 1 10440 6032266337 14241 0ustar rmsdaemon;;; undigest.el --- digest-cracking support for the RMAIL mail reader ;; Copyright (C) 1985, 1986, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; See Internet RFC 934 ;;; Code: (require 'rmail) (defun undigestify-rmail-message () "Break up a digest message into its constituent messages. Leaves original message, deleted, before the undigestified messages." (interactive) (widen) (let ((buffer-read-only nil) (msg-string (buffer-substring (rmail-msgbeg rmail-current-message) (rmail-msgend rmail-current-message)))) (goto-char (rmail-msgend rmail-current-message)) (narrow-to-region (point) (point)) (insert msg-string) (narrow-to-region (point-min) (1- (point-max)))) (let ((error t) (buffer-read-only nil)) (unwind-protect (progn (save-restriction (goto-char (point-min)) (delete-region (point-min) (progn (search-forward "\n*** EOOH ***\n") (point))) (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n") (narrow-to-region (point) (point-max)) (let* ((fill-prefix "") (case-fold-search t) start (digest-name (mail-strip-quoted-names (or (save-restriction (search-forward "\n\n") (setq start (point)) (narrow-to-region (point-min) (point)) (goto-char (point-max)) (or (mail-fetch-field "Reply-To") (mail-fetch-field "To") (mail-fetch-field "Apparently-To") (mail-fetch-field "From"))) (error "Message is not a digest--bad header"))))) (save-excursion (goto-char (point-max)) (skip-chars-backward " \t\n") (let (found) ;; compensate for broken un*x digestifiers. Sigh Sigh. (while (and (> (point) start) (not found)) (forward-line -1) (if (looking-at (concat "End of.*Digest.*\n" (regexp-quote "*********") "*" "\\(\n------*\\)*")) (setq found t))) (if (not found) (error "Message is not a digest--no end line")))) (re-search-forward (concat "^" (make-string 55 ?-) "-*\n*")) (replace-match "\^_\^L\n0, unseen,,\n*** EOOH ***\n") (save-restriction (narrow-to-region (point) (progn (search-forward "\n\n") (point))) (if (mail-fetch-field "To") nil (goto-char (point-min)) (insert "To: " digest-name "\n"))) (while (re-search-forward (concat "\n\n" (make-string 27 ?-) "-*\n*") nil t) (replace-match "\n\n\^_\^L\n0, unseen,,\n*** EOOH ***\n") (save-restriction (if (looking-at "End ") (insert "To: " digest-name "\n\n") (narrow-to-region (point) (progn (search-forward "\n\n" nil 'move) (point)))) (if (mail-fetch-field "To") nil (goto-char (point-min)) (insert "To: " digest-name "\n"))) ;; Digestifiers may insert `- ' on lines that start with `-'. ;; Undo that. (save-excursion (goto-char (point-min)) (if (re-search-forward "\n\n----------------------------*\n*" nil t) (let ((end (point-marker))) (goto-char (point-min)) (while (re-search-forward "^- " end t) (delete-char -2))))) ))) (setq error nil) (message "Message successfully undigestified") (let ((n rmail-current-message)) (rmail-forget-messages) (rmail-show-message n) (rmail-delete-forward) (if (rmail-summary-exists) (rmail-select-summary (rmail-update-summary))))) (cond (error (narrow-to-region (point-min) (1+ (point-max))) (delete-region (point-min) (point-max)) (rmail-show-message rmail-current-message)))))) ;;; undigest.el ends here emacs-19.30/lisp/uniquify.el100666 12120 1 35565 6017647442 14320 0ustar rmsdaemon;;; uniquify.el --- unique buffer names dependent on pathname ;; Copyright (c) 1989, 1995 Free Software Foundation, Inc. ;; Author: Dick King ;; Maintainer: Michael Ernst ;; Created: 15 May 86 ;; Time-stamp: <95/08/26 11:01:44 mernst> ;; 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: ;; Emacs's standard method for making buffer names unique adds <2>, <3>, ;; etc. to the end of (all but one of) the buffers. This file replaces ;; that behavior, for buffers visiting files and dired buffers, with a ;; uniquification that adds parts of the pathname until the buffer names ;; are unique. For instance, buffers visiting /u/mernst/tmp/Makefile and ;; /usr/projects/zaphod/Makefile would be named Makefile|tmp and ;; Makefile|zaphod, respectively (instead of Makefile and Makefile<2>). ;; Other buffer name styles are also available. ;; To use this file, just load it. ;; To disable it after loading, set variable uniquify-buffer-name-style to nil. ;; For other options, see "User-visible variables", below. ;; uniquify.el works under Emacs, XEmacs, and InfoDock. ;; Doesn't correctly handle buffer names created by M-x write-file in Emacs 18. ;;; Change Log: ;; Originally by Dick King 15 May 86 ;; Converted for Emacs 18 by Stephen Gildea ;; Make uniquify-min-dir-content 0 truly non-invasive. gildea 23 May 89 ;; Some cleanup. uniquify-min-dir-content default 0. gildea 01 Jun 89 ;; Don't rename to "". Michael Ernst 15 Jun 94 ;; Add kill-buffer-hook. Kenneth Manheimer 09 May 95 ;; Add advice for rename-buffer and create-file-buffer, handle dired buffers, ;; kill-buffer-rationalize-buffer-names-p, documentation. mernst 24 May 95 ;; Remove free variables, fix typos. mernst 5 Jun 95 ;; Efficiently support Emacs 19.27 & earlier. ken.manheimer, mernst 10 Jun 95 ;; Rename user options to "uniquify-...", add uniquify-reverse-dir-content-p, ;; add uniquify-ask-about-buffer-names-p. king, mernst 13 Jun 95 ;; Prefix functions by "uniquify-..."; rename mnemonic-buffer-names to ;; uniquify-buffer-name-style; add 'forward and 'post-forward-angle-brackets ;; styles; remove uniquify-reverse-dir-content-p; add ;; uniquify-trailing-separator-p. mernst 4 Aug 95 ;; Valuable feedback was provided by ;; Paul Smith , ;; Alastair Burt , ;; Bob Weiner , ;; Albert L. Ting , ;; gyro@reasoning.com. ;;; Code: (provide 'uniquify) ;;; User-visible variables (defvar uniquify-buffer-name-style 'post-forward "*If non-nil, buffer names are uniquified with parts of directory name. The value determines the buffer name style and is one of 'forward, 'reverse, 'post-forward (the default), or 'post-forward-angle-brackets. For example, files /foo/bar/mumble/name and /baz/quux/mumble/name would be in the following buffers: forward bar/mumble/name quux/mumble/name reverse name\\mumble\\bar name\\mumble\\quux post-forward name|bar/mumble name|quux/mumble post-forward-angle-brackets name name nil name name<2>") (defvar uniquify-after-kill-buffer-p nil "*If non-nil, rerationalize buffer names after a buffer has been killed. This can be dangerous if Emacs Lisp code is keeping track of buffers by their names (rather than keeping pointers to the buffers themselves).") (defconst uniquify-ask-about-buffer-names-p nil "*If non-nil, permit user to choose names for buffers with same base file. If the user chooses to name a buffer, uniquification is preempted and no other buffer names are changed.") (defvar uniquify-min-dir-content 0 "*Minimum parts of directory pathname included in buffer name.") (defvar uniquify-separator nil "*String separator for buffer name components. When `uniquify-buffer-name-style' is 'post-forward, separates base file name from directory part in buffer names (default \"|\"). When `uniquify-buffer-name-style' is 'reverse, separates all pathname components (default \"\\\").") (defvar uniquify-trailing-separator-p nil "*If non-nil, add a pathname separator to dired buffer names. If `uniquify-buffer-name-style' is 'forward, add the separator at the end; if it's is 'reverse, add the separator at the beginning; otherwise, this variable is ignored.") ;;; Utilities (defmacro uniquify-push (item list) (` (setq (, list) (cons (, item) (, list))))) (defmacro uniquify-fix-list-base (a) (` (car (, a)))) (defmacro uniquify-fix-list-filename (a) (` (car (cdr (, a))))) (defmacro uniquify-fix-list-buffer (a) (` (car (cdr (cdr (, a)))))) (defmacro uniquify-cadddr (a) (` (car (cdr (cdr (cdr (, a))))))) ;; Internal variables used free (defvar uniquify-non-file-buffer-names nil) (defvar uniquify-possibly-resolvable nil) ;;; Main entry point. (defun uniquify-rationalize-file-buffer-names (&optional newbuffile newbuf) "Makes file buffer names unique by adding segments from pathname. If `uniquify-min-dir-content' > 0, always pulls that many pathname elements. Arguments cause only a subset of buffers to be renamed." (interactive) (let (fix-list uniquify-non-file-buffer-names (depth uniquify-min-dir-content)) (let ((buffers (buffer-list))) (while buffers (let* ((buffer (car buffers)) (bfn (if (eq buffer newbuf) (expand-file-name newbuffile) (uniquify-buffer-file-name buffer))) (rawname (and bfn (file-name-nondirectory bfn))) (deserving (and rawname (or (not newbuffile) (equal rawname (file-name-nondirectory newbuffile)))))) (if deserving (uniquify-push (list rawname bfn buffer nil) fix-list) (uniquify-push (list (buffer-name buffer)) uniquify-non-file-buffer-names))) (setq buffers (cdr buffers)))) ;; selects buffers whose names may need changing, and others that ;; may conflict. (setq fix-list (sort fix-list 'uniquify-filename-sort)) ;; bringing conflicting names together (uniquify-rationalize-a-list fix-list depth) (mapcar 'uniquify-unrationalized-buffer fix-list))) (defun uniquify-buffer-file-name (buffer) "Return name of file BUFFER is visiting, or nil if none. Works on dired buffers as well as ordinary file-visiting buffers." (or (buffer-file-name buffer) (save-excursion (set-buffer buffer) list-buffers-directory))) (defun uniquify-filename-sort (s1 s2) (uniquify-filename-lessp (uniquify-fix-list-filename s1) (uniquify-fix-list-filename s2))) (defun uniquify-filename-lessp (s1 s2) (let ((s1f (file-name-nondirectory s1)) (s2f (file-name-nondirectory s2))) (and (not (equal s2f "")) (or (string-lessp s1f s2f) (and (equal s1f s2f) (let ((s1d (file-name-directory s1)) (s2d (file-name-directory s2))) (and (not (<= (length s2d) 1)) (or (<= (length s1d) 1) (uniquify-filename-lessp (substring s1d 0 -1) (substring s2d 0 -1)))))))))) ;; Was named do-the-buffers-you-couldnt-rationalize (defun uniquify-unrationalized-buffer (item) (or (uniquify-cadddr item) nil)) ;maybe better in the future (defun uniquify-rationalize-a-list (fix-list depth) (let (conflicting-sublist (old-name "") proposed-name uniquify-possibly-resolvable) (while fix-list (let ((item (car fix-list))) (setq proposed-name (uniquify-get-proposed-name item depth)) (if (not (equal proposed-name old-name)) (progn (uniquify-rationalize-conflicting-sublist conflicting-sublist old-name depth) (setq conflicting-sublist nil))) (uniquify-push item conflicting-sublist) (setq old-name proposed-name)) (setq fix-list (cdr fix-list))) (uniquify-rationalize-conflicting-sublist conflicting-sublist old-name depth))) (defun uniquify-get-proposed-name (item depth) (let (index (extra-string "") (n depth) (base (uniquify-fix-list-base item)) (fn (uniquify-fix-list-filename item))) (while (and (> n 0) (setq index (string-match (concat "\\(^\\|/[^/]*\\)/" (regexp-quote extra-string) (regexp-quote base) "\\'") fn))) (setq extra-string (substring fn (if (zerop index) 0 (1+ index)) ;; (- (length base)) fails for base = "". ;; Equivalently, we could have used ;; (apply 'substring ... ;; (and (not (string= "" base)) ;; (list (- (length base))))) (- (length fn) (length base))) n (1- n))) (if (zerop n) (setq uniquify-possibly-resolvable t)) ;; Distinguish directories by adding extra separator. (if (and uniquify-trailing-separator-p (file-directory-p fn) (not (string-equal base ""))) (cond ((eq uniquify-buffer-name-style 'forward) (setq base (concat base "/"))) ((eq uniquify-buffer-name-style 'reverse) (setq base (concat (or uniquify-separator "\\") base))))) ;; Trim trailing separator on directory part (if (and (not (string-equal extra-string "")) (or (eq uniquify-buffer-name-style 'post-forward) (eq uniquify-buffer-name-style 'post-forward-angle-brackets))) (setq extra-string (substring extra-string 0 (- (length extra-string) 1)))) (cond ((string-equal extra-string "") base) ((string-equal base "") extra-string) ((eq uniquify-buffer-name-style 'forward) (concat extra-string base)) ((eq uniquify-buffer-name-style 'reverse) (concat base (uniquify-reverse-components extra-string))) ((eq uniquify-buffer-name-style 'post-forward) (concat base (or uniquify-separator "|") extra-string)) ((eq uniquify-buffer-name-style 'post-forward-angle-brackets) (concat base "<" extra-string ">")) (t (error "Bad value for uniquify-buffer-name-style: %s" uniquify-buffer-name-style))))) ;; Deal with conflicting-sublist, which is set by uniquify-rationalize-a-list. ;; This is only called by uniquify-rationalize-a-list. (defun uniquify-rationalize-conflicting-sublist (conflicting-sublist old-name depth) (or (null conflicting-sublist) (and (null (cdr conflicting-sublist)) (not (assoc old-name uniquify-non-file-buffer-names)) (or (and (not (string= old-name "")) (uniquify-rename-buffer (car conflicting-sublist) old-name)) t)) (if uniquify-possibly-resolvable (uniquify-rationalize-a-list conflicting-sublist (1+ depth))))) (defun uniquify-rename-buffer (item newname) (let ((buffer (uniquify-fix-list-buffer item))) (if (not (equal newname (buffer-name buffer))) (let ((unset (current-buffer)) ;; avoid hooks on rename-buffer (uniquify-buffer-name-style nil)) (set-buffer buffer) (rename-buffer newname) (set-buffer unset)))) (rplaca (nthcdr 3 item) t)) (defun uniquify-reverse-components (instring) (let ((sofar '()) (cursor 0) (len (length instring)) (sep (or uniquify-separator "\\"))) (while (< cursor len) (if (= (aref instring cursor) ?/) (setq sofar (cons sep sofar) cursor (1+ cursor)) (let ((first-slash (or (string-match "/" instring cursor) len))) (setq sofar (cons (substring instring cursor first-slash) sofar) cursor first-slash)))) (apply (function concat) sofar))) ;;; Hooks from the rest of Emacs ;; Emacs 19 (GNU Emacs or XEmacs) ;; The logical place to put all this code is in generate-new-buffer-name. ;; It's written in C, so we would add a generate-new-buffer-name-function ;; which, if non-nil, would be called instead of the C. One problem with ;; that is that generate-new-buffer-name takes a potential buffer name as ;; its argument -- not other information, such as what file the buffer will ;; visit. ;; The below solution works because generate-new-buffer-name is called ;; only by rename-buffer (which, as of 19.29, is never called from C) and ;; generate-new-buffer, which is called only by Lisp functions ;; create-file-buffer and rename-uniquely. Rename-uniquely generally ;; isn't used for buffers visiting files, so it's sufficient to hook ;; rename-buffer and create-file-buffer. (Setting find-file-hooks isn't ;; sufficient.) (defadvice rename-buffer (after rename-buffer-uniquify activate) "Uniquify buffer names with parts of directory name." (if (and uniquify-buffer-name-style ;; UNIQUE argument (ad-get-arg 1)) (progn (if uniquify-after-kill-buffer-p ;; call with no argument; rationalize vs. old name as well as new (uniquify-rationalize-file-buffer-names) ;; call with argument: rationalize vs. new name only (uniquify-rationalize-file-buffer-names (uniquify-buffer-file-name (current-buffer)) (current-buffer))) (setq ad-return-value (buffer-name (current-buffer)))))) (defadvice create-file-buffer (after create-file-buffer-uniquify activate) "Uniquify buffer names with parts of directory name." (if uniquify-buffer-name-style (uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value))) ;; Buffer deletion ;; Rerationalize after a buffer is killed, to reduce coinciding buffer names. ;; This mechanism uses `kill-buffer-hook', which runs *before* deletion. ;; That means that the kill-buffer-hook function cannot just delete the ;; buffer -- it has to set something to do the rationalization *later*. ;; It actually puts another function on `post-command-hook'. This other ;; function runs the rationalization and then removes itself from the hook. ;; Is there a better way to accomplish this? ;; (This ought to set some global variables so the work is done only for ;; buffers with names similar to the deleted buffer. -MDE) (defun delay-uniquify-rationalize-file-buffer-names () "Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'. For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion." (if (and uniquify-buffer-name-style uniquify-after-kill-buffer-p) (add-hook 'post-command-hook 'delayed-uniquify-rationalize-file-buffer-names))) (defun delayed-uniquify-rationalize-file-buffer-names () "Rerationalize buffer names and remove self from `post-command-hook'. See also `delay-rationalize-file-buffer-names' for hook setter." (uniquify-rationalize-file-buffer-names) (remove-hook 'post-command-hook 'delayed-uniquify-rationalize-file-buffer-names)) (add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names) ;;; uniquify.el ends here emacs-19.30/lisp/unrmail.el100444 12120 1 4513 6034530462 14045 0ustar rmsdaemon;;; unrmail.el --- convert Rmail files to mailbox files. ;;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Keywords: mail ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (defvar command-line-args-left) ;Avoid 'free variable' warning ;;;###autoload (defun batch-unrmail () "Convert Rmail files to system inbox format. Specify the input Rmail file names as command line arguments. For each Rmail file, the corresponding output file name is made by adding `.mail' at the end. For example, invoke `emacs -batch -f batch-unrmail RMAIL'." ;; command-line-args-left is what is left of the command line (from startup.el) (if (not noninteractive) (error "`batch-unrmail' is to be used only with -batch")) (let ((error nil)) (while command-line-args-left (or (unrmail (car command-line-args-left) (concat (car command-line-args-left) ".mail")) (setq error t)) (setq command-line-args-left (cdr command-line-args-left))) (message "Done") (kill-emacs (if error 1 0)))) ;;;###autoload (defun unrmail (file to-file) "Convert Rmail file FILE to system inbox format file TO-FILE." (interactive "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): ") (let ((message-count 0) ;; Prevent rmail from making, or switching to, a summary buffer. (rmail-display-summary nil) (rmail-delete-after-output nil)) (rmail file) (message "Writing messages to %s..." to-file) (while (< message-count rmail-total-messages) (rmail-show-message (setq message-count (1+ message-count))) (rmail-toggle-header) (rmail-output to-file 1 t)) (message "Writing messages to %s...done" to-file))) ;;; unrmail.el ends here emacs-19.30/lisp/unused.el100444 12120 1 2453 5235430330 13675 0ustar rmsdaemon;;; unused.el --- editing commands in GNU Emacs that turned out not to be used. ;;; This file is in the public domain, as it was distributed in ;;; 1985 or 1986 without a copyright notice. Written by RMS. ;; Maintainer: FSF ;; Keywords: emulations ;;; Commentary: ;; These were added with an eye to making possible a more CCA-compatible ;; command set; but that turned out not to be interesting. ;;; Code: (defun mark-beginning-of-buffer () "Set mark at the beginning of the buffer." (interactive) (push-mark (point-min))) (defun mark-end-of-buffer () "Set mark at the end of the buffer." (interactive) (push-mark (point-max))) (defun upcase-char (arg) "Uppercasify ARG chars starting from point. Point doesn't move" (interactive "p") (save-excursion (upcase-region (point) (progn (forward-char arg) (point))))) (defun forward-to-word (arg) "Move forward until encountering the beginning of a word. With argument, do this that many times." (interactive "p") (or (re-search-forward (if (> arg 0) "\\W\\b" "\\b\\W") nil t arg) (goto-char (if (> arg 0) (point-max) (point-min))))) (defun backward-to-word (arg) "Move backward until encountering the end of a word. With argument, do this that many times." (interactive "p") (forward-to-word (- arg))) ;;; unused.el ends here emacs-19.30/lisp/userlock.el100444 75424 12 11556 5660055600 14336 0ustar kwzhstaff;;; userlock.el --- handle file access contention between multiple users ;; Copyright (C) 1985, 1986 Free Software Foundation, inc. ;; Maintainer: FSF ;; Keywords: internal ;; 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 file is autoloaded to handle certain conditions ;; detected by the file-locking code within Emacs. ;; The two entry points are `ask-user-about-lock' and ;; `ask-user-about-supersession-threat'. ;;; Code: (put 'file-locked 'error-conditions '(file-locked file-error error)) ;;;###autoload (defun ask-user-about-lock (fn opponent) "Ask user what to do when he wants to edit FILE but it is locked by USER. This function has a choice of three things to do: do (signal 'buffer-file-locked (list FILE USER)) to refrain from editing the file return t (grab the lock on the file) return nil (edit the file even though it is locked). You can rewrite it to use any criterion you like to choose which one to do." (discard-input) (save-window-excursion (let (answer) (while (null answer) (message "%s is locking %s: action (s, q, p, ?)? " opponent fn) (let ((tem (let ((inhibit-quit t) (cursor-in-echo-area t)) (prog1 (downcase (read-char)) (setq quit-flag nil))))) (if (= tem help-char) (ask-user-about-lock-help) (setq answer (assoc tem '((?s . t) (?q . yield) (?\C-g . yield) (?p . nil) (?? . help)))) (cond ((null answer) (beep) (message "Please type q, s, or p; or ? for help") (sit-for 3)) ((eq (cdr answer) 'help) (ask-user-about-lock-help) (setq answer nil)) ((eq (cdr answer) 'yield) (signal 'file-locked (list "File is locked" fn opponent))))))) (cdr answer)))) (defun ask-user-about-lock-help () (with-output-to-temp-buffer "*Help*" (princ "It has been detected that you want to modify a file that someone else has already started modifying in EMACS. You can teal the file; The other user becomes the intruder if (s)he ever unmodifies the file and then changes it again. You can

roceed; you edit at your own (and the other user's) risk. You can uit; don't modify this file.") (save-excursion (set-buffer standard-output) (help-mode)))) (put 'file-supersession 'error-conditions '(file-supersession file-error error)) ;;;###autoload (defun ask-user-about-supersession-threat (fn) "Ask a user who is about to modify an obsolete buffer what to do. This function has two choices: it can return, in which case the modification of the buffer will proceed, or it can (signal 'file-supersession (file)), in which case the proposed buffer modification will not be made. You can rewrite this to use any criterion you like to choose which one to do. The buffer in question is current when this function is called." (discard-input) (save-window-excursion (let (answer) (while (null answer) (message "%s changed on disk; really edit the buffer? (y, n or C-h) " (file-name-nondirectory fn)) (let ((tem (downcase (let ((cursor-in-echo-area t)) (read-char))))) (setq answer (if (= tem help-char) 'help (cdr (assoc tem '((?n . yield) (?\C-g . yield) (?y . proceed) (?? . help)))))) (cond ((null answer) (beep) (message "Please type y or n; or ? for help") (sit-for 3)) ((eq answer 'help) (ask-user-about-supersession-help) (setq answer nil)) ((eq answer 'yield) (signal 'file-supersession (list "File changed on disk" fn)))))) (message "File on disk now will become a backup file if you save these changes.") (setq buffer-backed-up nil)))) (defun ask-user-about-supersession-help () (with-output-to-temp-buffer "*Help*" (princ "You want to modify a buffer whose disk file has changed since you last read it in or saved it with this buffer. If you say `y' to go ahead and modify this buffer, you risk ruining the work of whoever rewrote the file. If you say `n', the change you started to make will be aborted. Usually, you should type `n' and then `M-x revert-buffer', to get the latest version of the file, then make the change again.") (save-excursion (set-buffer standard-output) (help-mode)))) ;;; userlock.el ends here emacs-19.30/lisp/vc-hooks.el100444 12120 1 117445 6051755107 14204 0ustar rmsdaemon;;; vc-hooks.el --- resident support for version-control ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Modified by: ;; Per Cederqvist ;; Andre Spiegel ;; 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 is the always-loaded portion of VC. ;; It takes care VC-related activities that are done when you visit a file, ;; so that vc.el itself is loaded only when you use a VC command. ;; See the commentary of vc.el. ;;; Code: ;; Customization Variables (the rest is in vc.el) (defvar vc-default-back-end nil "*Back-end actually used by this interface; may be SCCS or RCS. The value is only computed when needed to avoid an expensive search.") (defvar vc-handle-cvs t "*If non-nil, use VC for files managed with CVS. If it is nil, don't use VC for those files.") (defvar vc-rcsdiff-knows-brief nil "*Indicates whether rcsdiff understands the --brief option. The value is either `yes', `no', or nil. If it is nil, VC tries to use --brief and sets this variable to remember whether it worked.") (defvar vc-path (if (file-directory-p "/usr/sccs") '("/usr/sccs") nil) "*List of extra directories to search for version control commands.") (defvar vc-master-templates '(("%sRCS/%s,v" . RCS) ("%s%s,v" . RCS) ("%sRCS/%s" . RCS) ("%sSCCS/s.%s" . SCCS) ("%ss.%s". SCCS) vc-find-cvs-master) "*Where to look for version-control master files. The first pair corresponding to a given back end is used as a template when creating new masters.") (defvar vc-make-backup-files nil "*If non-nil, backups of registered files are made as with other files. If nil (the default), files covered by version control don't get backups.") (defvar vc-display-status t "*If non-nil, display revision number and lock status in modeline. Otherwise, not displayed.") (defvar vc-consult-headers t "*Identify work files by searching for version headers.") (defvar vc-keep-workfiles t "*If non-nil, don't delete working files after registering changes. If the back-end is CVS, workfiles are always kept, regardless of the value of this flag.") (defvar vc-mistrust-permissions nil "*Don't assume that permissions and ownership track version-control status.") (defun vc-mistrust-permissions (file) ;; Access function to the above. (or (eq vc-mistrust-permissions 't) (and vc-mistrust-permissions (funcall vc-mistrust-permissions (vc-backend-subdirectory-name file))))) ;; Tell Emacs about this new kind of minor mode (if (not (assoc 'vc-mode minor-mode-alist)) (setq minor-mode-alist (cons '(vc-mode vc-mode) minor-mode-alist))) (make-variable-buffer-local 'vc-mode) (put 'vc-mode 'permanent-local t) ;; We need a notion of per-file properties because the version ;; control state of a file is expensive to derive --- we compute ;; them when the file is initially found, keep them up to date ;; during any subsequent VC operations, and forget them when ;; the buffer is killed. (defmacro vc-error-occurred (&rest body) (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t))) (defvar vc-file-prop-obarray [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] "Obarray for per-file properties.") (defvar vc-buffer-backend t) (make-variable-buffer-local 'vc-buffer-backend) (defun vc-file-setprop (file property value) ;; set per-file property (put (intern file vc-file-prop-obarray) property value)) (defun vc-file-getprop (file property) ;; get per-file property (get (intern file vc-file-prop-obarray) property)) (defun vc-file-clearprops (file) ;; clear all properties of a given file (setplist (intern file vc-file-prop-obarray) nil)) ;;; Functions that determine property values, by examining the ;;; working file, the master file, or log program output (defun vc-match-substring (bn) (buffer-substring (match-beginning bn) (match-end bn))) (defun vc-lock-file (file) ;; Generate lock file name corresponding to FILE (let ((master (vc-name file))) (and master (string-match "\\(.*/\\)s\\.\\(.*\\)" master) (concat (substring master (match-beginning 1) (match-end 1)) "p." (substring master (match-beginning 2) (match-end 2)))))) (defun vc-parse-buffer (patterns &optional file properties) ;; Use PATTERNS to parse information out of the current buffer. ;; Each element of PATTERNS is a list of 2 to 3 elements. The first element ;; is the pattern to be matched, and the second (an integer) is the ;; number of the subexpression that should be returned. If there's ;; a third element (also the number of a subexpression), that ;; subexpression is assumed to be a date field and we want the most ;; recent entry matching the template. ;; If FILE and PROPERTIES are given, the latter must be a list of ;; properties of the same length as PATTERNS; each property is assigned ;; the corresponding value. (mapcar (function (lambda (p) (goto-char (point-min)) (cond ((eq (length p) 2) ;; search for first entry (let ((value nil)) (if (re-search-forward (car p) nil t) (setq value (vc-match-substring (elt p 1)))) (if file (progn (vc-file-setprop file (car properties) value) (setq properties (cdr properties)))) value)) ((eq (length p) 3) ;; search for latest entry (let ((latest-date "") (latest-val)) (while (re-search-forward (car p) nil t) (let ((date (vc-match-substring (elt p 2)))) (if (string< latest-date date) (progn (setq latest-date date) (setq latest-val (vc-match-substring (elt p 1))))))) (if file (progn (vc-file-setprop file (car properties) latest-val) (setq properties (cdr properties)))) latest-val))))) patterns) ) (defun vc-insert-file (file &optional limit blocksize) ;; Insert the contents of FILE into the current buffer. ;; Optional argument LIMIT is a regexp. If present, ;; the file is inserted in chunks of size BLOCKSIZE ;; (default 8 kByte), until the first occurence of ;; LIMIT is found. The function returns nil if FILE ;; doesn't exist. (erase-buffer) (cond ((file-exists-p file) (cond (limit (if (not blocksize) (setq blocksize 8192)) (let (found s) (while (not found) (setq s (buffer-size)) (goto-char (1+ s)) (setq found (or (zerop (car (cdr (insert-file-contents file nil s (+ s blocksize))))) (progn (beginning-of-line) (re-search-forward limit nil t))))))) (t (insert-file-contents file))) (set-buffer-modified-p nil) (auto-save-mode nil) t) (t nil))) (defun vc-parse-locks (file locks) ;; Parse RCS or SCCS locks. ;; The result is a list of the form ((VERSION USER) (VERSION USER) ...), ;; which is returned and stored into the property `vc-master-locks'. (if (not locks) (vc-file-setprop file 'vc-master-locks 'none) (let ((found t) (index 0) master-locks version user) (cond ((eq (vc-backend file) 'SCCS) (while (string-match "^\\([0-9.]+\\) [0-9.]+ \\([^ ]+\\) .*\n?" locks index) (setq version (substring locks (match-beginning 1) (match-end 1))) (setq user (substring locks (match-beginning 2) (match-end 2))) (setq master-locks (append master-locks (list (cons version user)))) (setq index (match-end 0)))) ((eq (vc-backend file) 'RCS) (while (string-match "[ \t\n]*\\([^:]+\\):\\([0-9.]+\\)" locks index) (setq version (substring locks (match-beginning 2) (match-end 2))) (setq user (substring locks (match-beginning 1) (match-end 1))) (setq master-locks (append master-locks (list (cons version user)))) (setq index (match-end 0))) (if (string-match ";[ \t\n]+strict;" locks index) (vc-file-setprop file 'vc-checkout-model 'manual) (vc-file-setprop file 'vc-checkout-model 'implicit)))) (vc-file-setprop file 'vc-master-locks (or master-locks 'none))))) (defun vc-simple-command (okstatus command file &rest args) ;; Simple version of vc-do-command, for use in vc-hooks only. ;; Don't switch to the *vc-info* buffer before running the ;; command, because that would change its default directory (save-excursion (set-buffer (get-buffer-create "*vc-info*")) (erase-buffer)) (let ((exec-path (append vc-path exec-path)) exec-status ;; Add vc-path to PATH for the execution of this command. (process-environment (cons (concat "PATH=" (getenv "PATH") path-separator (mapconcat 'identity vc-path path-separator)) process-environment))) (setq exec-status (apply 'call-process command nil "*vc-info*" nil (append args (list file)))) (cond ((> exec-status okstatus) (switch-to-buffer (get-file-buffer file)) (shrink-window-if-larger-than-buffer (display-buffer "*vc-info*")) (error "Couldn't find version control information"))) exec-status)) (defun vc-fetch-master-properties (file) ;; Fetch those properties of FILE that are stored in the master file. ;; For an RCS file, we don't get vc-latest-version vc-your-latest-version ;; here because that is slow. ;; That gets done if/when the functions vc-latest-version ;; and vc-your-latest-version get called. (save-excursion (cond ((eq (vc-backend file) 'SCCS) (set-buffer (get-buffer-create "*vc-info*")) (if (vc-insert-file (vc-lock-file file)) (vc-parse-locks file (buffer-string)) (vc-file-setprop file 'vc-master-locks 'none)) (vc-insert-file (vc-name file) "^\001e") (vc-parse-buffer (list '("^\001d D \\([^ ]+\\)" 1) (list (concat "^\001d D \\([^ ]+\\) .* " (regexp-quote (user-login-name)) " ") 1)) file '(vc-latest-version vc-your-latest-version))) ((eq (vc-backend file) 'RCS) (set-buffer (get-buffer-create "*vc-info*")) (vc-insert-file (vc-name file) "^[0-9]") (vc-parse-buffer (list '("^head[ \t\n]+\\([^;]+\\);" 1) '("^branch[ \t\n]+\\([^;]+\\);" 1) '("^locks[ \t\n]*\\([^;]*;\\([ \t\n]*strict;\\)?\\)" 1)) file '(vc-head-version vc-default-branch vc-master-locks)) ;; determine vc-master-workfile-version: it is either the head ;; of the trunk, the head of the default branch, or the ;; "default branch" itself, if that is a full revision number. (let ((default-branch (vc-file-getprop file 'vc-default-branch))) (cond ;; no default branch ((or (not default-branch) (string= "" default-branch)) (vc-file-setprop file 'vc-master-workfile-version (vc-file-getprop file 'vc-head-version))) ;; default branch is actually a revision ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$" default-branch) (vc-file-setprop file 'vc-master-workfile-version default-branch)) ;; else, search for the head of the default branch (t (vc-insert-file (vc-name file) "^desc") (vc-parse-buffer (list (list (concat "^\\(" (regexp-quote default-branch) "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2)) file '(vc-master-workfile-version))))) ;; translate the locks (vc-parse-locks file (vc-file-getprop file 'vc-master-locks))) ((eq (vc-backend file) 'CVS) (save-excursion ;; Call "cvs status" in the right directory, passing only the ;; nondirectory part of the file name -- otherwise CVS might ;; silently give a wrong result. (let ((default-directory (file-name-directory file))) (vc-simple-command 0 "cvs" (file-name-nondirectory file) "status")) (set-buffer (get-buffer "*vc-info*")) (vc-parse-buffer ;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:", ;; and CVS 1.4a1 says "Repository revision:". '(("\\(RCS Version\\|RCS Revision\\|Repository revision\\):[\t ]+\\([0-9.]+\\)" 2) ("^File: [^ \t]+[ \t]+Status: \\(.*\\)" 1)) file '(vc-latest-version vc-cvs-status)) ;; Translate those status values that we understand into symbols. ;; Any other value is converted to nil. (let ((status (vc-file-getprop file 'vc-cvs-status))) (cond ((string-match "Up-to-date" status) (vc-file-setprop file 'vc-cvs-status 'up-to-date) (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))) ((vc-file-setprop file 'vc-cvs-status (cond ((string-match "Locally Modified" status) 'locally-modified) ((string-match "Needs Merge" status) 'needs-merge) ((string-match "Needs \\(Checkout\\|Patch\\)" status) 'needs-checkout) ((string-match "Unresolved Conflict" status) 'unresolved-conflict) ((string-match "Locally Added" status) 'locally-added) (t 'unknown) )))))))) (if (get-buffer "*vc-info*") (kill-buffer (get-buffer "*vc-info*"))))) ;;; Functions that determine property values, by examining the ;;; working file, the master file, or log program output (defun vc-consult-rcs-headers (file) ;; Search for RCS headers in FILE, and set properties ;; accordingly. This function can be disabled by setting ;; vc-consult-headers to nil. ;; Returns: nil if no headers were found ;; (or if the feature is disabled, ;; or if there is currently no buffer ;; visiting FILE) ;; 'rev if a workfile revision was found ;; 'rev-and-lock if revision and lock info was found (cond ((or (not vc-consult-headers) (not (get-file-buffer file))) nil) ((let (status version locking-user) (save-excursion (set-buffer (get-file-buffer file)) (goto-char (point-min)) (cond ;; search for $Id or $Header ;; ------------------------- ((or (and (search-forward "$Id: " nil t) (looking-at "[^ ]+ \\([0-9.]+\\) ")) (and (progn (goto-char (point-min)) (search-forward "$Header: " nil t)) (looking-at "[^ ]+ \\([0-9.]+\\) "))) (goto-char (match-end 0)) ;; if found, store the revision number ... (setq version (buffer-substring (match-beginning 1) (match-end 1))) ;; ... and check for the locking state (cond ((looking-at (concat "[0-9]+[/-][01][0-9][/-][0-3][0-9] " ; date "[0-2][0-9]:[0-5][0-9]+:[0-6][0-9]+\\([+-][0-9:]+\\)? " ; time "[^ ]+ [^ ]+ ")) ; author & state (goto-char (match-end 0)) ; [0-6] in regexp handles leap seconds (cond ;; unlocked revision ((looking-at "\\$") (setq locking-user 'none) (setq status 'rev-and-lock)) ;; revision is locked by some user ((looking-at "\\([^ ]+\\) \\$") (setq locking-user (buffer-substring (match-beginning 1) (match-end 1))) (setq status 'rev-and-lock)) ;; everything else: false (nil))) ;; unexpected information in ;; keyword string --> quit (nil))) ;; search for $Revision ;; -------------------- ((re-search-forward (concat "\\$" "Revision: \\([0-9.]+\\) \\$") nil t) ;; if found, store the revision number ... (setq version (buffer-substring (match-beginning 1) (match-end 1))) ;; and see if there's any lock information (goto-char (point-min)) (if (re-search-forward (concat "\\$" "Locker:") nil t) (cond ((looking-at " \\([^ ]+\\) \\$") (setq locking-user (buffer-substring (match-beginning 1) (match-end 1))) (setq status 'rev-and-lock)) ((looking-at " *\\$") (setq locking-user 'none) (setq status 'rev-and-lock)) (t (setq locking-user 'none) (setq status 'rev-and-lock))) (setq status 'rev))) ;; else: nothing found ;; ------------------- (t nil))) (if status (vc-file-setprop file 'vc-workfile-version version)) (and (eq status 'rev-and-lock) (eq (vc-backend file) 'RCS) (vc-file-setprop file 'vc-locking-user locking-user) ;; If the file has headers, we don't want to query the master file, ;; because that would eliminate all the performance gain the headers ;; brought us. We therefore use a heuristic for the checkout model ;; now: If we trust the file permissions, and the file is not ;; locked, then if the file is read-only the checkout model is ;; `manual', otherwise `implicit'. (not (vc-mistrust-permissions file)) (not (vc-locking-user file)) (if (string-match ".r-..-..-." (nth 8 (file-attributes file))) (vc-file-setprop file 'vc-checkout-model 'manual) (vc-file-setprop file 'vc-checkout-model 'implicit))) status)))) ;;; Access functions to file properties ;;; (Properties should be _set_ using vc-file-setprop, but ;;; _retrieved_ only through these functions, which decide ;;; if the property is already known or not. A property should ;;; only be retrieved by vc-file-getprop if there is no ;;; access function.) ;;; properties indicating the backend ;;; being used for FILE (defun vc-backend-subdirectory-name (&optional file) ;; Where the master and lock files for the current directory are kept (symbol-name (or (and file (vc-backend file)) vc-default-back-end (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS))))) (defun vc-name (file) "Return the master name of a file, nil if it is not registered. For CVS, the full name of CVS/Entries is returned." (or (vc-file-getprop file 'vc-name) (let ((name-and-type (vc-registered file))) (if name-and-type (progn (vc-file-setprop file 'vc-backend (cdr name-and-type)) (vc-file-setprop file 'vc-name (car name-and-type))))))) (defun vc-backend (file) "Return the version-control type of a file, nil if it is not registered." (and file (or (vc-file-getprop file 'vc-backend) (let ((name-and-type (vc-registered file))) (if name-and-type (progn (vc-file-setprop file 'vc-name (car name-and-type)) (vc-file-setprop file 'vc-backend (cdr name-and-type)))))))) (defun vc-checkout-model (file) ;; Return `manual' if the user has to type C-x C-q to check out FILE. ;; Return `implicit' if the file can be modified without locking it first. (or (vc-file-getprop file 'vc-checkout-model) (cond ((eq (vc-backend file) 'SCCS) (vc-file-setprop file 'vc-checkout-model 'manual)) ((eq (vc-backend file) 'RCS) (vc-consult-rcs-headers file) (or (vc-file-getprop file 'vc-checkout-model) (progn (vc-fetch-master-properties file) (vc-file-getprop file 'vc-checkout-model)))) ((eq (vc-backend file) 'CVS) (vc-file-setprop file 'vc-checkout-model (if (getenv "CVSREAD") 'manual 'implicit)))))) ;;; properties indicating the locking state (defun vc-cvs-status (file) ;; Return the cvs status of FILE ;; (Status field in output of "cvs status") (cond ((vc-file-getprop file 'vc-cvs-status)) (t (vc-fetch-master-properties file) (vc-file-getprop file 'vc-cvs-status)))) (defun vc-master-locks (file) ;; Return the lock entries in the master of FILE. ;; Return 'none if there are no such entries, and a list ;; of the form ((VERSION USER) (VERSION USER) ...) otherwise. (cond ((vc-file-getprop file 'vc-master-locks)) (t (vc-fetch-master-properties file) (vc-file-getprop file 'vc-master-locks)))) (defun vc-master-locking-user (file) ;; Return the master file's idea of who is locking ;; the current workfile version of FILE. ;; Return 'none if it is not locked. (let ((master-locks (vc-master-locks file)) lock) (if (eq master-locks 'none) 'none ;; search for a lock on the current workfile version (setq lock (assoc (vc-workfile-version file) master-locks)) (cond (lock (cdr lock)) ('none))))) (defun vc-lock-from-permissions (file) ;; If the permissions can be trusted for this file, determine the ;; locking state from them. Returns (user-login-name), `none', or nil. ;; This implementation assumes that any file which is under version ;; control and has -rw-r--r-- is locked by its owner. This is true ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--. ;; We have to be careful not to exclude files with execute bits on; ;; scripts can be under version control too. Also, we must ignore the ;; group-read and other-read bits, since paranoid users turn them off. ;; This hack wins because calls to the somewhat expensive ;; `vc-fetch-master-properties' function only have to be made if ;; (a) the file is locked by someone other than the current user, ;; or (b) some untoward manipulation behind vc's back has changed ;; the owner or the `group' or `other' write bits. (let ((attributes (file-attributes file))) (if (not (vc-mistrust-permissions file)) (cond ((string-match ".r-..-..-." (nth 8 attributes)) (vc-file-setprop file 'vc-locking-user 'none)) ((and (= (nth 2 attributes) (user-uid)) (string-match ".rw..-..-." (nth 8 attributes))) (vc-file-setprop file 'vc-locking-user (user-login-name))) (nil))))) (defun vc-file-owner (file) ;; The expression below should return the username of the owner ;; of the file. It doesn't. It returns the username if it is ;; you, or otherwise the UID of the owner of the file. The ;; return value from this function is only used by ;; vc-dired-reformat-line, and it does the proper thing if a UID ;; is returned. ;; The *proper* way to fix this would be to implement a built-in ;; function in Emacs, say, (username UID), that returns the ;; username of a given UID. ;; The result of this hack is that vc-directory will print the ;; name of the owner of the file for any files that are ;; modified. (let ((uid (nth 2 (file-attributes file)))) (if (= uid (user-uid)) (user-login-name) uid))) (defun vc-rcs-lock-from-diff (file) ;; Diff the file against the master version. If differences are found, ;; mark the file locked. This is only used for RCS with non-strict ;; locking. (If "rcsdiff" doesn't understand --brief, we do a double-take ;; and remember the fact for the future.) (let* ((version (concat "-r" (vc-workfile-version file))) (status (if (eq vc-rcsdiff-knows-brief 'no) (vc-simple-command 1 "rcsdiff" file version) (vc-simple-command 2 "rcsdiff" file "--brief" version)))) (if (eq status 2) (if (not vc-rcsdiff-knows-brief) (setq vc-rcsdiff-knows-brief 'no status (vc-simple-command 1 "rcsdiff" file version)) (error "rcsdiff failed.")) (if (not vc-rcsdiff-knows-brief) (setq vc-rcsdiff-knows-brief 'yes))) (if (zerop status) (vc-file-setprop file 'vc-locking-user 'none) (vc-file-setprop file 'vc-locking-user (vc-file-owner file))))) (defun vc-locking-user (file) ;; Return the name of the person currently holding a lock on FILE. ;; Return nil if there is no such person. (Sometimes, not the name ;; of the locking user but his uid will be returned.) ;; Under CVS, a file is considered locked if it has been modified since ;; it was checked out. ;; The property is cached. It is only looked up if it is currently nil. ;; Note that, for a file that is not locked, the actual property value ;; is `none', to distinguish it from an unknown locking state. That value ;; is converted to nil by this function, and returned to the caller. (let ((locking-user (vc-file-getprop file 'vc-locking-user))) (if locking-user ;; if we already know the property, return it (if (eq locking-user 'none) nil locking-user) ;; otherwise, infer the property... (cond ((eq (vc-backend file) 'CVS) (or (and (eq (vc-checkout-model file) 'manual) (vc-lock-from-permissions file)) (and (equal (vc-file-getprop file 'vc-checkout-time) (nth 5 (file-attributes file))) (vc-file-setprop file 'vc-locking-user 'none)) (let ((locker (vc-file-owner file))) (vc-file-setprop file 'vc-locking-user (if (stringp locker) locker (format "%d" locker)))))) ((eq (vc-backend file) 'RCS) (let (p-lock) ;; Check for RCS headers first (or (eq (vc-consult-rcs-headers file) 'rev-and-lock) ;; If there are no headers, try to learn it ;; from the permissions. (and (setq p-lock (vc-lock-from-permissions file)) (if (eq p-lock 'none) ;; If the permissions say "not locked", we know ;; that the checkout model must be `manual'. (vc-file-setprop file 'vc-checkout-model 'manual) ;; If the permissions say "locked", we can only trust ;; this *if* the checkout model is `manual'. (eq (vc-checkout-model file) 'manual))) ;; Otherwise, use lock information from the master file. (vc-file-setprop file 'vc-locking-user (vc-master-locking-user file))) ;; Finally, if the file is not explicitly locked ;; it might still be locked implicitly. (and (eq (vc-file-getprop file 'vc-locking-user) 'none) (eq (vc-checkout-model file) 'implicit) (vc-rcs-lock-from-diff file)))) ((eq (vc-backend file) 'SCCS) (or (vc-lock-from-permissions file) (vc-file-setprop file 'vc-locking-user (vc-master-locking-user file))))) ;; convert a possible 'none value (setq locking-user (vc-file-getprop file 'vc-locking-user)) (if (eq locking-user 'none) nil locking-user)))) ;;; properties to store current and recent version numbers (defun vc-latest-version (file) ;; Return version level of the latest version of FILE (cond ((vc-file-getprop file 'vc-latest-version)) (t (vc-fetch-properties file) (vc-file-getprop file 'vc-latest-version)))) (defun vc-your-latest-version (file) ;; Return version level of the latest version of FILE checked in by you (cond ((vc-file-getprop file 'vc-your-latest-version)) (t (vc-fetch-properties file) (vc-file-getprop file 'vc-your-latest-version)))) (defun vc-master-workfile-version (file) ;; Return the master file's idea of what is the current workfile version. ;; This property is defined for RCS only. (cond ((vc-file-getprop file 'vc-master-workfile-version)) (t (vc-fetch-master-properties file) (vc-file-getprop file 'vc-master-workfile-version)))) (defun vc-fetch-properties (file) ;; Fetch vc-latest-version and vc-your-latest-version ;; if that wasn't already done. (cond ((eq (vc-backend file) 'RCS) (save-excursion (set-buffer (get-buffer-create "*vc-info*")) (vc-insert-file (vc-name file) "^desc") (vc-parse-buffer (list '("^\\([0-9]+\\.[0-9.]+\\)\ndate[ \t]+\\([0-9.]+\\);" 1 2) (list (concat "^\\([0-9]+\\.[0-9.]+\\)\n" "date[ \t]+\\([0-9.]+\\);[ \t]+" "author[ \t]+" (regexp-quote (user-login-name)) ";") 1 2)) file '(vc-latest-version vc-your-latest-version)) (if (get-buffer "*vc-info*") (kill-buffer (get-buffer "*vc-info*"))))) (t (vc-fetch-master-properties file)) )) (defun vc-workfile-version (file) ;; Return version level of the current workfile FILE ;; This is attempted by first looking at the RCS keywords. ;; If there are no keywords in the working file, ;; vc-master-workfile-version is taken. ;; Note that this property is cached, that is, it is only ;; looked up if it is nil. ;; For SCCS, this property is equivalent to vc-latest-version. (cond ((vc-file-getprop file 'vc-workfile-version)) ((eq (vc-backend file) 'SCCS) (vc-latest-version file)) ((eq (vc-backend file) 'RCS) (if (vc-consult-rcs-headers file) (vc-file-getprop file 'vc-workfile-version) (let ((rev (cond ((vc-master-workfile-version file)) ((vc-latest-version file))))) (vc-file-setprop file 'vc-workfile-version rev) rev))) ((eq (vc-backend file) 'CVS) (if (vc-consult-rcs-headers file) ;; CVS (vc-file-getprop file 'vc-workfile-version) (catch 'found (vc-find-cvs-master (file-name-directory file) (file-name-nondirectory file))) (vc-file-getprop file 'vc-workfile-version))))) ;;; actual version-control code starts here (defun vc-registered (file) (let (handler handlers) (if (boundp 'file-name-handler-alist) (setq handler (find-file-name-handler file 'vc-registered))) (if handler (funcall handler 'vc-registered file) ;; Search for a master corresponding to the given file (let ((dirname (or (file-name-directory file) "")) (basename (file-name-nondirectory file))) (catch 'found (mapcar (function (lambda (s) (if (atom s) (funcall s dirname basename) (let ((trial (format (car s) dirname basename))) (if (and (file-exists-p trial) ;; Make sure the file we found with name ;; TRIAL is not the source file itself. ;; That can happen with RCS-style names ;; if the file name is truncated ;; (e.g. to 14 chars). See if either ;; directory or attributes differ. (or (not (string= dirname (file-name-directory trial))) (not (equal (file-attributes file) (file-attributes trial))))) (throw 'found (cons trial (cdr s)))))))) vc-master-templates) nil))))) (defun vc-utc-string (timeval) ;; Convert a time value into universal time, and return it as a ;; human-readable string. This is for comparing CVS checkout times ;; with file modification times. (let (utc (high (car timeval)) (low (nth 1 timeval)) (offset (car (current-time-zone timeval)))) (setq low (- low offset)) (setq utc (if (> low 65535) (list (1+ high) (- low 65536)) (if (< low 0) (list (1- high) (+ 65536 low)) (list high low)))) (current-time-string utc))) (defun vc-find-cvs-master (dirname basename) ;; Check if DIRNAME/BASENAME is handled by CVS. ;; If it is, do a (throw 'found (cons MASTER 'CVS)). ;; Note: This function throws the name of CVS/Entries ;; NOT that of the RCS master file (because we wouldn't be able ;; to access it under remote CVS). ;; The function returns nil if DIRNAME/BASENAME is not handled by CVS. (if (and vc-handle-cvs (file-directory-p (concat dirname "CVS/")) (file-readable-p (concat dirname "CVS/Entries"))) (let (buffer time (fold case-fold-search) (file (concat dirname basename))) (unwind-protect (save-excursion (setq buffer (set-buffer (get-buffer-create "*vc-info*"))) (vc-insert-file (concat dirname "CVS/Entries")) (goto-char (point-min)) ;; make sure the file name is searched ;; case-sensitively (setq case-fold-search nil) (cond ((re-search-forward (concat "^/" (regexp-quote basename) "/\\([^/]*\\)/\\([^/]*\\)/") nil t) (setq case-fold-search fold) ;; restore the old value ;; We found it. Store away version number now that we ;; are anyhow so close to finding it. (vc-file-setprop file 'vc-workfile-version (match-string 1)) ;; If the file hasn't been modified since checkout, ;; store the checkout-time. (let ((mtime (nth 5 (file-attributes file)))) (if (string= (match-string 2) (vc-utc-string mtime)) (vc-file-setprop file 'vc-checkout-time mtime) (vc-file-setprop file 'vc-checkout-time 0))) (throw 'found (cons (concat dirname "CVS/Entries") 'CVS))) (t (setq case-fold-search fold) ;; restore the old value nil))) (kill-buffer buffer))))) (defun vc-buffer-backend () "Return the version-control type of the visited file, or nil if none." (if (eq vc-buffer-backend t) (setq vc-buffer-backend (vc-backend (buffer-file-name))) vc-buffer-backend)) (defun vc-toggle-read-only (&optional verbose) "Change read-only status of current buffer, perhaps via version control. If the buffer is visiting a file registered with version control, then check the file in or out. Otherwise, just change the read-only flag of the buffer. With prefix argument, ask for version number." (interactive "P") (if (vc-backend (buffer-file-name)) (vc-next-action verbose) (toggle-read-only))) (define-key global-map "\C-x\C-q" 'vc-toggle-read-only) (defun vc-after-save () ;; Function to be called by basic-save-buffer (in files.el). ;; If the file in the current buffer is under version control, ;; not locked, and the checkout model for it is `implicit', ;; mark it "locked" and redisplay the mode line. (let ((file (buffer-file-name))) (and (vc-file-getprop file 'vc-backend) ;; ...check the property directly, not through the function of the ;; same name. Otherwise Emacs would check for a master file ;; each time a non-version-controlled buffer is saved. ;; The property is computed when the file is visited, so if it ;; is `nil' now, it is certain that the file is NOT ;; version-controlled. (or (and (equal (vc-file-getprop file 'vc-checkout-time) (nth 5 (file-attributes file))) ;; File has been saved in the same second in which ;; it was checked out. Clear the checkout-time ;; to avoid confusion. (vc-file-setprop file 'vc-checkout-time nil)) t) (not (vc-locking-user file)) (eq (vc-checkout-model file) 'implicit) (vc-file-setprop file 'vc-locking-user (user-login-name)) (or (and (eq (vc-backend file) 'CVS) (vc-file-setprop file 'vc-cvs-status nil)) t) (vc-mode-line file)))) (defun vc-mode-line (file &optional label) "Set `vc-mode' to display type of version control for FILE. The value is set in the current buffer, which should be the buffer visiting FILE. Second optional arg LABEL is put in place of version control system name." (interactive (list buffer-file-name nil)) (let ((vc-type (vc-backend file))) (setq vc-mode (and vc-type (concat " " (or label (symbol-name vc-type)) (and vc-display-status (vc-status file))))) (and vc-type (equal file (buffer-file-name)) (vc-locking-user file) ;; If the file is locked by some other user, make ;; the buffer read-only. Like this, even root ;; cannot modify a file without locking it first. (not (string= (user-login-name) (vc-locking-user file))) (setq buffer-read-only t)) (force-mode-line-update) ;;(set-buffer-modified-p (buffer-modified-p)) ;;use this if Emacs 18 vc-type)) (defun vc-status (file) ;; Return string for placement in modeline by `vc-mode-line'. ;; Format: ;; ;; "-REV" if the revision is not locked ;; ":REV" if the revision is locked by the user ;; ":LOCKER:REV" if the revision is locked by somebody else ;; " @@" for a CVS file that is added, but not yet committed ;; ;; In the CVS case, a "locked" working file is a ;; working file that is modified with respect to the master. ;; The file is "locked" from the moment when the user saves ;; the modified buffer. ;; ;; This function assumes that the file is registered. (let ((locker (vc-locking-user file)) (rev (vc-workfile-version file))) (cond ((string= "0" rev) " @@") ((not locker) (concat "-" rev)) ((if (stringp locker) (string= locker (user-login-name)) (= locker (user-uid))) (concat ":" rev)) (t (concat ":" locker ":" rev))))) ;;; install a call to the above as a find-file hook (defun vc-find-file-hook () ;; Recompute whether file is version controlled, ;; if user has killed the buffer and revisited. (cond (buffer-file-name (vc-file-clearprops buffer-file-name) (cond ((vc-backend buffer-file-name) (vc-mode-line buffer-file-name) (cond ((not vc-make-backup-files) ;; Use this variable, not make-backup-files, ;; because this is for things that depend on the file name. (make-local-variable 'backup-inhibited) (setq backup-inhibited t)))) ((let* ((link (file-symlink-p buffer-file-name)) (link-type (and link (vc-backend link)))) (if link-type (message "Warning: symbolic link to %s-controlled source file" link-type)))))))) (add-hook 'find-file-hooks 'vc-find-file-hook) ;;; more hooks, this time for file-not-found (defun vc-file-not-found-hook () "When file is not found, try to check it out from RCS or SCCS. Returns t if checkout was successful, nil otherwise." (if (vc-backend buffer-file-name) (save-excursion (require 'vc) (setq default-directory (file-name-directory (buffer-file-name))) (not (vc-error-occurred (vc-checkout buffer-file-name)))))) (add-hook 'find-file-not-found-hooks 'vc-file-not-found-hook) ;; Discard info about a file when we kill its buffer. (defun vc-kill-buffer-hook () (if (stringp (buffer-file-name)) (progn (vc-file-clearprops (buffer-file-name)) (kill-local-variable 'vc-buffer-backend)))) ;;;(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook) ;;; Now arrange for bindings and autoloading of the main package. ;;; Bindings for this have to go in the global map, as we'll often ;;; want to call them from random buffers. (setq vc-prefix-map (lookup-key global-map "\C-xv")) (if (not (keymapp vc-prefix-map)) (progn (setq vc-prefix-map (make-sparse-keymap)) (define-key global-map "\C-xv" vc-prefix-map) (define-key vc-prefix-map "a" 'vc-update-change-log) (define-key vc-prefix-map "c" 'vc-cancel-version) (define-key vc-prefix-map "d" 'vc-directory) (define-key vc-prefix-map "h" 'vc-insert-headers) (define-key vc-prefix-map "i" 'vc-register) (define-key vc-prefix-map "l" 'vc-print-log) (define-key vc-prefix-map "r" 'vc-retrieve-snapshot) (define-key vc-prefix-map "s" 'vc-create-snapshot) (define-key vc-prefix-map "u" 'vc-revert-buffer) (define-key vc-prefix-map "v" 'vc-next-action) (define-key vc-prefix-map "=" 'vc-diff) (define-key vc-prefix-map "~" 'vc-version-other-window))) (if (not (boundp 'vc-menu-map)) ;; Don't do the menu bindings if menu-bar.el wasn't loaded to defvar ;; vc-menu-map. () ;;(define-key vc-menu-map [show-files] ;; '("Show Files under VC" . (vc-directory t))) (define-key vc-menu-map [vc-directory] '("Show Locked Files" . vc-directory)) (define-key vc-menu-map [separator1] '("----")) (define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file)) (define-key vc-menu-map [vc-version-other-window] '("Show Other Version" . vc-version-other-window)) (define-key vc-menu-map [vc-diff] '("Compare with Last Version" . vc-diff)) (define-key vc-menu-map [vc-update-change-log] '("Update ChangeLog" . vc-update-change-log)) (define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log)) (define-key vc-menu-map [separator2] '("----")) (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version)) (define-key vc-menu-map [vc-revert-buffer] '("Revert to Last Version" . vc-revert-buffer)) (define-key vc-menu-map [vc-insert-header] '("Insert Header" . vc-insert-headers)) (define-key vc-menu-map [vc-menu-check-in] '("Check In" . vc-next-action)) (define-key vc-menu-map [vc-check-out] '("Check Out" . vc-toggle-read-only)) (define-key vc-menu-map [vc-register] '("Register" . vc-register)) (put 'vc-rename-file 'menu-enable 'vc-mode) (put 'vc-version-other-window 'menu-enable 'vc-mode) (put 'vc-diff 'menu-enable 'vc-mode) (put 'vc-update-change-log 'menu-enable '(eq (vc-buffer-backend) 'RCS)) (put 'vc-print-log 'menu-enable 'vc-mode) (put 'vc-cancel-version 'menu-enable 'vc-mode) (put 'vc-revert-buffer 'menu-enable 'vc-mode) (put 'vc-insert-headers 'menu-enable 'vc-mode) (put 'vc-next-action 'menu-enable '(and vc-mode (not buffer-read-only))) (put 'vc-toggle-read-only 'menu-enable '(and vc-mode buffer-read-only)) (put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode))) ) (provide 'vc-hooks) ;;; vc-hooks.el ends here emacs-19.30/lisp/vc.el100444 12120 1 307073 6051724566 13066 0ustar rmsdaemon;;; vc.el --- drive a version-control system from within Emacs ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Modified by: ;; ttn@netcom.com ;; Per Cederqvist ;; Andre Spiegel ;; 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 mode is fully documented in the Emacs user's manual. ;; ;; This was designed and implemented by Eric Raymond . ;; Paul Eggert , Sebastian Kremer , ;; and Richard Stallman contributed valuable criticism, support, and testing. ;; CVS support was added by Per Cederqvist ;; in Jan-Feb 1994. ;; ;; Supported version-control systems presently include SCCS, RCS, and CVS. ;; ;; Some features will not work with old RCS versions. Where ;; appropriate, VC finds out which version you have, and allows or ;; disallows those features (stealing locks, for example, works only ;; from 5.6.2 onwards). ;; Even initial checkins will fail if your RCS version is so old that ci ;; doesn't understand -t-; this has been known to happen to people running ;; NExTSTEP 3.0. ;; ;; You can support the RCS -x option by adding pairs to the ;; vc-master-templates list. ;; ;; Proper function of the SCCS diff commands requires the shellscript vcdiff ;; to be installed somewhere on Emacs's path for executables. ;; ;; If your site uses the ChangeLog convention supported by Emacs, the ;; function vc-comment-to-change-log should prove a useful checkin hook. ;; ;; This code depends on call-process passing back the subprocess exit ;; status. Thus, you need Emacs 18.58 or later to run it. For the ;; vc-directory command to work properly as documented, you need 19. ;; You also need Emacs 19's ring.el. ;; ;; The vc code maintains some internal state in order to reduce expensive ;; version-control operations to a minimum. Some names are only computed ;; once. If you perform version control operations with RCS/SCCS/CVS while ;; vc's back is turned, or move/rename master files while vc is running, ;; vc may get seriously confused. Don't do these things! ;; ;; Developer's notes on some concurrency issues are included at the end of ;; the file. ;;; Code: (require 'vc-hooks) (require 'ring) (eval-when-compile (require 'dired)) ; for dired-map-over-marks macro (if (not (assoc 'vc-parent-buffer minor-mode-alist)) (setq minor-mode-alist (cons '(vc-parent-buffer vc-parent-buffer-name) minor-mode-alist))) ;; To implement support for a new version-control system, add another ;; branch to the vc-backend-dispatch macro and fill it in in each ;; call. The variable vc-master-templates in vc-hooks.el will also ;; have to change. (defmacro vc-backend-dispatch (f s r c) "Execute FORM1, FORM2 or FORM3 for SCCS, RCS or CVS respectively. If FORM3 is `RCS', use FORM2 for CVS as well as RCS. \(CVS shares some code with RCS)." (list 'let (list (list 'type (list 'vc-backend f))) (list 'cond (list (list 'eq 'type (quote 'SCCS)) s) ;; SCCS (list (list 'eq 'type (quote 'RCS)) r) ;; RCS (list (list 'eq 'type (quote 'CVS)) ;; CVS (if (eq c 'RCS) r c)) ))) ;; General customization (defvar vc-suppress-confirm nil "*If non-nil, treat user as expert; suppress yes-no prompts on some things.") (defvar vc-initial-comment nil "*Prompt for initial comment when a file is registered.") (defvar vc-command-messages nil "*Display run messages from back-end commands.") (defvar vc-checkin-switches nil "*Extra switches passed to the checkin program by \\[vc-checkin].") (defvar vc-checkout-switches nil "*Extra switches passed to the checkout program by \\[vc-checkout].") (defvar vc-directory-exclusion-list '("SCCS" "RCS" "CVS") "*Directory names ignored by functions that recursively walk file trees.") (defconst vc-maximum-comment-ring-size 32 "Maximum number of saved comments in the comment ring.") ;;; This is duplicated in diff.el. (defvar diff-switches "-c" "*A string or list of strings specifying switches to be be passed to diff.") ;;;###autoload (defvar vc-checkin-hook nil "*List of functions called after a checkin is done. See `run-hooks'.") (defvar vc-make-buffer-writable-hook nil "*List of functions called when a buffer is made writable. See `run-hooks.' This hook is only used when the version control system is CVS. It might be useful for sites who uses locking with CVS, or who uses link farms to gold trees.") ;; Header-insertion hair (defvar vc-header-alist '((SCCS "\%W\%") (RCS "\$Id\$") (CVS "\$Id\$")) "*Header keywords to be inserted when `vc-insert-headers' is executed.") (defvar vc-static-header-alist '(("\\.c$" . "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n")) "*Associate static header string templates with file types. A \%s in the template is replaced with the first string associated with the file's version-control type in `vc-header-alist'.") (defvar vc-comment-alist '((nroff-mode ".\\\"" "")) "*Special comment delimiters to be used in generating vc headers only. Add an entry in this list if you need to override the normal comment-start and comment-end variables. This will only be necessary if the mode language is sensitive to blank lines.") ;; Default is to be extra careful for super-user. (defvar vc-checkout-carefully (= (user-uid) 0) "*Non-nil means be extra-careful in checkout. Verify that the file really is not locked and that its contents match what the master file says.") (defvar vc-rcs-release nil "*The release number of your RCS installation, as a string. If nil, VC itself computes this value when it is first needed.") (defvar vc-sccs-release nil "*The release number of your SCCS installation, as a string. If nil, VC itself computes this value when it is first needed.") (defvar vc-cvs-release nil "*The release number of your SCCS installation, as a string. If nil, VC itself computes this value when it is first needed.") ;; Variables the user doesn't need to know about. (defvar vc-log-entry-mode nil) (defvar vc-log-operation nil) (defvar vc-log-after-operation-hook nil) (defvar vc-checkout-writable-buffer-hook 'vc-checkout-writable-buffer) ;; In a log entry buffer, this is a local variable ;; that points to the buffer for which it was made ;; (either a file, or a VC dired buffer). (defvar vc-parent-buffer nil) (defvar vc-parent-buffer-name nil) (defvar vc-log-file) (defvar vc-log-version) (defconst vc-name-assoc-file "VC-names") (defvar vc-dired-mode nil) (make-variable-buffer-local 'vc-dired-mode) (defvar vc-comment-ring nil) (defvar vc-comment-ring-index nil) (defvar vc-last-comment-match nil) ;; Back-portability to Emacs 18 (defun file-executable-p-18 (f) (let ((modes (file-modes f))) (and modes (not (zerop (logand 292)))))) (defun file-regular-p-18 (f) (let ((attributes (file-attributes f))) (and attributes (not (car attributes))))) ; Conditionally rebind some things for Emacs 18 compatibility (if (not (boundp 'minor-mode-map-alist)) (progn (setq compilation-old-error-list nil) (fset 'file-executable-p 'file-executable-p-18) (fset 'shrink-window-if-larger-than-buffer 'beginning-of-buffer) )) (if (not (fboundp 'file-regular-p)) (fset 'file-regular-p 'file-regular-p-18)) ;;; Find and compare backend releases (defun vc-backend-release (backend) ;; Returns which backend release is installed on this system. (cond ((eq backend 'RCS) (or vc-rcs-release (and (zerop (vc-do-command nil 2 "rcs" nil nil "-V")) (save-excursion (set-buffer (get-buffer "*vc*")) (setq vc-rcs-release (car (vc-parse-buffer '(("^RCS version \\([0-9.]+ *.*\\)" 1))))))) (setq vc-rcs-release 'unknown))) ((eq backend 'CVS) (or vc-cvs-release (and (zerop (vc-do-command nil 1 "cvs" nil nil "-v")) (save-excursion (set-buffer (get-buffer "*vc*")) (setq vc-cvs-release (car (vc-parse-buffer '(("^Concurrent Versions System (CVS) \\([0-9.]+\\)" 1))))))) (setq vc-cvs-release 'unknown))) ((eq backend 'SCCS) vc-sccs-release))) (defun vc-release-greater-or-equal (r1 r2) ;; Compare release numbers, represented as strings. ;; Release components are assumed cardinal numbers, not decimal ;; fractions (5.10 is a higher release than 5.9). Omitted fields ;; are considered lower (5.6.7 is earlier than 5.6.7.1). ;; Comparison runs till the end of the string is found, or a ;; non-numeric component shows up (5.6.7 is earlier than "5.6.7 beta", ;; which is probably not what you want in some cases). ;; This code is suitable for existing RCS release numbers. ;; CVS releases are handled reasonably, too (1.3 < 1.4* < 1.5). (let (v1 v2 i1 i2) (catch 'done (or (and (string-match "^\\.?\\([0-9]+\\)" r1) (setq i1 (match-end 0)) (setq v1 (string-to-number (match-string 1 r1))) (or (and (string-match "^\\.?\\([0-9]+\\)" r2) (setq i2 (match-end 0)) (setq v2 (string-to-number (match-string 1 r2))) (if (> v1 v2) (throw 'done t) (if (< v1 v2) (throw 'done nil) (throw 'done (vc-release-greater-or-equal (substring r1 i1) (substring r2 i2))))))) (throw 'done t))) (or (and (string-match "^\\.?\\([0-9]+\\)" r2) (throw 'done nil)) (throw 'done t))))) (defun vc-backend-release-p (backend release) ;; Return t if we have RELEASE of BACKEND or better (let (i r (ri 0) (ii 0) is rs (installation (vc-backend-release backend))) (if (not (eq installation 'unknown)) (cond ((or (eq backend 'RCS) (eq backend 'CVS)) (vc-release-greater-or-equal installation release)))))) ;;; functions that operate on RCS revision numbers (defun vc-trunk-p (rev) ;; return t if REV is a revision on the trunk (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev)))) (defun vc-branch-part (rev) ;; return the branch part of a revision number REV (substring rev 0 (string-match "\\.[0-9]+\\'" rev))) ;; File property caching (defun vc-clear-context () "Clear all cached file properties and the comment ring." (interactive) (fillarray vc-file-prop-obarray nil) ;; Note: there is potential for minor lossage here if there is an open ;; log buffer with a nonzero local value of vc-comment-ring-index. (setq vc-comment-ring nil)) (defun vc-file-clear-masterprops (file) ;; clear all properties of FILE that were retrieved ;; from the master file (vc-file-setprop file 'vc-latest-version nil) (vc-file-setprop file 'vc-your-latest-version nil) (vc-backend-dispatch file (progn ;; SCCS (vc-file-setprop file 'vc-master-locks nil)) (progn ;; RCS (vc-file-setprop file 'vc-default-branch nil) (vc-file-setprop file 'vc-head-version nil) (vc-file-setprop file 'vc-master-workfile-version nil) (vc-file-setprop file 'vc-master-locks nil)) (progn (vc-file-setprop file 'vc-cvs-status nil)))) (defun vc-head-version (file) ;; Return the RCS head version of FILE (cond ((vc-file-getprop file 'vc-head-version)) (t (vc-fetch-master-properties file) (vc-file-getprop file 'vc-head-version)))) ;; Random helper functions (defun vc-latest-on-branch-p (file) ;; return t iff the current workfile version of FILE is ;; the latest on its branch. (vc-backend-dispatch file ;; SCCS (string= (vc-workfile-version file) (vc-latest-version file)) ;; RCS (let ((workfile-version (vc-workfile-version file)) tip-version) (if (vc-trunk-p workfile-version) (progn ;; Re-fetch the head version number. This is to make ;; sure that no-one has checked in a new version behind ;; our back. (vc-fetch-master-properties file) (string= (vc-file-getprop file 'vc-head-version) workfile-version)) ;; If we are not on the trunk, we need to examine the ;; whole current branch. (vc-master-workfile-version ;; is not what we need.) (save-excursion (set-buffer (get-buffer-create "*vc-info*")) (vc-insert-file (vc-name file) "^desc") (setq tip-version (car (vc-parse-buffer (list (list (concat "^\\(" (regexp-quote (vc-branch-part workfile-version)) "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2))))) (if (get-buffer "*vc-info*") (kill-buffer (get-buffer "*vc-info*"))) (string= tip-version workfile-version)))) ;; CVS t)) (defun vc-registration-error (file) (if file (error "File %s is not under version control" file) (error "Buffer %s is not associated with a file" (buffer-name)))) (defvar vc-binary-assoc nil) (defun vc-find-binary (name) "Look for a command anywhere on the subprocess-command search path." (or (cdr (assoc name vc-binary-assoc)) (catch 'found (mapcar (function (lambda (s) (if s (let ((full (concat s "/" name))) (if (file-executable-p full) (progn (setq vc-binary-assoc (cons (cons name full) vc-binary-assoc)) (throw 'found full))))))) exec-path) nil))) (defun vc-do-command (buffer okstatus command file last &rest flags) "Execute a version-control command, notifying user and checking for errors. Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil. The command is successful if its exit status does not exceed OKSTATUS. The last argument of the command is the master name of FILE if LAST is `MASTER', or the workfile of FILE if LAST is `WORKFILE'; this is appended to an optional list of FLAGS." (and file (setq file (expand-file-name file))) (if (not buffer) (setq buffer "*vc*")) (if vc-command-messages (message "Running %s on %s..." command file)) (let ((obuf (current-buffer)) (camefrom (current-buffer)) (squeezed nil) (vc-file (and file (vc-name file))) (olddir default-directory) status) (set-buffer (get-buffer-create buffer)) (set (make-local-variable 'vc-parent-buffer) camefrom) (set (make-local-variable 'vc-parent-buffer-name) (concat " from " (buffer-name camefrom))) (setq default-directory olddir) (erase-buffer) (mapcar (function (lambda (s) (and s (setq squeezed (append squeezed (list s)))))) flags) (if (and vc-file (eq last 'MASTER)) (setq squeezed (append squeezed (list vc-file)))) (if (eq last 'WORKFILE) (progn (let* ((pwd (expand-file-name default-directory)) (preflen (length pwd))) (if (string= (substring file 0 preflen) pwd) (setq file (substring file preflen)))) (setq squeezed (append squeezed (list file))))) (let ((exec-path (append vc-path exec-path)) ;; Add vc-path to PATH for the execution of this command. (process-environment (cons (concat "PATH=" (getenv "PATH") path-separator (mapconcat 'identity vc-path path-separator)) process-environment))) (setq status (apply 'call-process command nil t nil squeezed))) (goto-char (point-max)) (set-buffer-modified-p nil) (forward-line -1) (if (or (not (integerp status)) (< okstatus status)) (progn (pop-to-buffer buffer) (goto-char (point-min)) (shrink-window-if-larger-than-buffer) (error "Running %s...FAILED (%s)" command (if (integerp status) (format "status %d" status) status)) ) (if vc-command-messages (message "Running %s...OK" command)) ) (set-buffer obuf) status) ) ;;; Save a bit of the text around POSN in the current buffer, to help ;;; us find the corresponding position again later. This works even ;;; if all markers are destroyed or corrupted. ;;; A lot of this was shamelessly lifted from Sebastian Kremer's rcs.el mode. (defun vc-position-context (posn) (list posn (buffer-size) (buffer-substring posn (min (point-max) (+ posn 100))))) ;;; Return the position of CONTEXT in the current buffer, or nil if we ;;; couldn't find it. (defun vc-find-position-by-context (context) (let ((context-string (nth 2 context))) (if (equal "" context-string) (point-max) (save-excursion (let ((diff (- (nth 1 context) (buffer-size)))) (if (< diff 0) (setq diff (- diff))) (goto-char (nth 0 context)) (if (or (search-forward context-string nil t) ;; Can't use search-backward since the match may continue ;; after point. (progn (goto-char (- (point) diff (length context-string))) ;; goto-char doesn't signal an error at ;; beginning of buffer like backward-char would (search-forward context-string nil t))) ;; to beginning of OSTRING (- (point) (length context-string)))))))) (defun vc-buffer-context () ;; Return a list '(point-context mark-context reparse); from which ;; vc-restore-buffer-context can later restore the context. (let ((point-context (vc-position-context (point))) ;; Use mark-marker to avoid confusion in transient-mark-mode. (mark-context (if (eq (marker-buffer (mark-marker)) (current-buffer)) (vc-position-context (mark-marker)))) ;; Make the right thing happen in transient-mark-mode. (mark-active nil) ;; We may want to reparse the compilation buffer after revert (reparse (and (boundp 'compilation-error-list) ;compile loaded (let ((curbuf (current-buffer))) ;; Construct a list; each elt is nil or a buffer ;; iff that buffer is a compilation output buffer ;; that contains markers into the current buffer. (save-excursion (mapcar (function (lambda (buffer) (set-buffer buffer) (let ((errors (or compilation-old-error-list compilation-error-list)) (buffer-error-marked-p nil)) (while (and (consp errors) (not buffer-error-marked-p)) (and (markerp (cdr (car errors))) (eq buffer (marker-buffer (cdr (car errors)))) (setq buffer-error-marked-p t)) (setq errors (cdr errors))) (if buffer-error-marked-p buffer)))) (buffer-list))))))) (list point-context mark-context reparse))) (defun vc-restore-buffer-context (context) ;; Restore point/mark, and reparse any affected compilation buffers. ;; CONTEXT is that which vc-buffer-context returns. (let ((point-context (nth 0 context)) (mark-context (nth 1 context)) (reparse (nth 2 context))) ;; Reparse affected compilation buffers. (while reparse (if (car reparse) (save-excursion (set-buffer (car reparse)) (let ((compilation-last-buffer (current-buffer)) ;select buffer ;; Record the position in the compilation buffer of ;; the last error next-error went to. (error-pos (marker-position (car (car-safe compilation-error-list))))) ;; Reparse the error messages as far as they were parsed before. (compile-reinitialize-errors '(4) compilation-parsing-end) ;; Move the pointer up to find the error we were at before ;; reparsing. Now next-error should properly go to the next one. (while (and compilation-error-list (/= error-pos (car (car compilation-error-list)))) (setq compilation-error-list (cdr compilation-error-list)))))) (setq reparse (cdr reparse))) ;; Restore point and mark (let ((new-point (vc-find-position-by-context point-context))) (if new-point (goto-char new-point))) (if mark-context (let ((new-mark (vc-find-position-by-context mark-context))) (if new-mark (set-mark new-mark)))))) (defun vc-revert-buffer1 (&optional arg no-confirm) ;; Revert buffer, try to keep point and mark where user expects them in spite ;; of changes because of expanded version-control key words. ;; This is quite important since otherwise typeahead won't work as expected. (interactive "P") (widen) (let ((context (vc-buffer-context))) (revert-buffer arg no-confirm) (vc-restore-buffer-context context))) (defun vc-buffer-sync (&optional not-urgent) ;; Make sure the current buffer and its working file are in sync ;; NOT-URGENT means it is ok to continue if the user says not to save. (if (buffer-modified-p) (if (or vc-suppress-confirm (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name)))) (save-buffer) (if not-urgent nil (error "Aborted"))))) (defun vc-workfile-unchanged-p (file &optional want-differences-if-changed) ;; Has the given workfile changed since last checkout? (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) (lastmod (nth 5 (file-attributes file)))) (or (equal checkout-time lastmod) (and (or (not checkout-time) want-differences-if-changed) (let ((unchanged (zerop (vc-backend-diff file nil nil (not want-differences-if-changed))))) ;; 0 stands for an unknown time; it can't match any mod time. (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) unchanged))))) (defun vc-next-action-on-file (file verbose &optional comment) ;;; If comment is specified, it will be used as an admin or checkin comment. (let ((vc-file (vc-name file)) (vc-type (vc-backend file)) owner version buffer) (cond ;; if there is no master file corresponding, create one ((not vc-file) (vc-register verbose comment) (if vc-initial-comment (setq vc-log-after-operation-hook 'vc-checkout-writable-buffer-hook) (vc-checkout-writable-buffer file))) ;; CVS: changes to the master file need to be ;; merged back into the working file ((and (eq vc-type 'CVS) (or (eq (vc-cvs-status file) 'needs-checkout) (eq (vc-cvs-status file) 'needs-merge))) (if (or vc-dired-mode (yes-or-no-p (format "%s is not up-to-date. Merge in changes now? " (buffer-name)))) (progn (if vc-dired-mode (and (setq buffer (get-file-buffer file)) (buffer-modified-p buffer) (switch-to-buffer-other-window buffer) (vc-buffer-sync t)) (setq buffer (current-buffer)) (vc-buffer-sync t)) (if (and buffer (buffer-modified-p buffer) (not (yes-or-no-p (format "Buffer %s modified; merge file on disc anyhow? " (buffer-name buffer))))) (error "Merge aborted")) (if (not (zerop (vc-backend-merge-news file))) ;; Overlaps detected - what now? Should use some ;; fancy RCS conflict resolving package, or maybe ;; emerge, but for now, simply warn the user with a ;; message. (message "Conflicts detected!")) (and buffer (vc-resynch-buffer file t (not (buffer-modified-p buffer))))) (error "%s needs update" (buffer-name)))) ;; if there is no lock on the file, assert one and get it ((not (setq owner (vc-locking-user file))) (if (and vc-checkout-carefully (not (vc-workfile-unchanged-p file t))) (if (save-window-excursion (pop-to-buffer "*vc-diff*") (goto-char (point-min)) (insert-string (format "Changes to %s since last lock:\n\n" file)) (not (beep)) (yes-or-no-p (concat "File has unlocked changes, " "claim lock retaining changes? "))) (progn (vc-backend-steal file) (vc-mode-line file)) (if (not (yes-or-no-p "Revert to checked-in version, instead? ")) (error "Checkout aborted.") (vc-revert-buffer1 t t) (vc-checkout-writable-buffer file)) ) (if verbose (if (not (eq vc-type 'SCCS)) (vc-checkout file nil (read-string "Branch or version to move to: ")) (error "Sorry, this is not implemented for SCCS.")) (if (vc-latest-on-branch-p file) (vc-checkout-writable-buffer file) (if (yes-or-no-p "This is not the latest version. Really lock it? ") (vc-checkout-writable-buffer file) (if (yes-or-no-p "Lock the latest version instead? ") (vc-checkout-writable-buffer file (if (vc-trunk-p (vc-workfile-version file)) "" ;; this means check out latest on trunk (vc-branch-part (vc-workfile-version file))))))) ))) ;; a checked-out version exists, but the user may not own the lock ((and (not (eq vc-type 'CVS)) (not (string-equal owner (user-login-name)))) (if comment (error "Sorry, you can't steal the lock on %s this way" file)) (and (eq vc-type 'RCS) (not (vc-backend-release-p 'RCS "5.6.2")) (error "File is locked by %s." owner)) (vc-steal-lock file (if verbose (read-string "Version to steal: ") (vc-workfile-version file)) owner)) ;; OK, user owns the lock on the file (t (if vc-dired-mode (find-file-other-window file) (find-file file)) ;; give luser a chance to save before checking in. (vc-buffer-sync) ;; Revert if file is unchanged and buffer is too. ;; If buffer is modified, that means the user just said no ;; to saving it; in that case, don't revert, ;; because the user might intend to save ;; after finishing the log entry. (if (and (vc-workfile-unchanged-p file) (not (buffer-modified-p))) ;; DO NOT revert the file without asking the user! (cond ((yes-or-no-p "Revert to master version? ") (vc-backend-revert file) (vc-resynch-window file t t))) ;; user may want to set nonstandard parameters (if verbose (setq version (read-string "New version level: "))) ;; OK, let's do the checkin (vc-checkin file version comment) ))))) (defun vc-next-action-dired (file rev comment) ;; Do a vc-next-action-on-file on all the marked files, possibly ;; passing on the log comment we've just entered. (let ((configuration (current-window-configuration)) (dired-buffer (current-buffer)) (dired-dir default-directory)) (dired-map-over-marks (let ((file (dired-get-filename)) p) (message "Processing %s..." file) ;; Adjust the default directory so that checkouts ;; go to the right place. (setq default-directory (file-name-directory file)) (vc-next-action-on-file file nil comment) (set-buffer dired-buffer) (setq default-directory dired-dir) (vc-dired-update-line file) (set-window-configuration configuration) (message "Processing %s...done" file)) nil t))) ;; Here's the major entry point. ;;;###autoload (defun vc-next-action (verbose) "Do the next logical checkin or checkout operation on the current file. If you call this from within a VC dired buffer with no files marked, it will operate on the file in the current line. If you call this from within a VC dired buffer, and one or more files are marked, it will accept a log message and then operate on each one. The log message will be used as a comment for any register or checkin operations, but ignored when doing checkouts. Attempted lock steals will raise an error. A prefix argument lets you specify the version number to use. For RCS and SCCS files: If the file is not already registered, this registers it for version control and then retrieves a writable, locked copy for editing. If the file is registered and not locked by anyone, this checks out a writable and locked file ready for editing. If the file is checked out and locked by the calling user, this first checks to see if the file has changed since checkout. If not, it performs a revert. If the file has been changed, this pops up a buffer for entry of a log message; when the message has been entered, it checks in the resulting changes along with the log message as change commentary. If the variable `vc-keep-workfiles' is non-nil (which is its default), a read-only copy of the changed file is left in place afterwards. If the file is registered and locked by someone else, you are given the option to steal the lock. For CVS files: If the file is not already registered, this registers it for version control. This does a \"cvs add\", but no \"cvs commit\". If the file is added but not committed, it is committed. If your working file is changed, but the repository file is unchanged, this pops up a buffer for entry of a log message; when the message has been entered, it checks in the resulting changes along with the logmessage as change commentary. A writable file is retained. If the repository file is changed, you are asked if you want to merge in the changes into your working copy." (interactive "P") (catch 'nogo (if vc-dired-mode (let ((files (dired-get-marked-files))) (if (string= "" (mapconcat (function (lambda (f) (if (eq (vc-backend f) 'CVS) (if (or (eq (vc-cvs-status f) 'locally-modified) (eq (vc-cvs-status f) 'locally-added)) "@" "") (if (vc-locking-user f) "@" "")))) files "")) (vc-next-action-dired nil nil "dummy") (vc-start-entry nil nil nil "Enter a change comment for the marked files." 'vc-next-action-dired)) (throw 'nogo nil))) (while vc-parent-buffer (pop-to-buffer vc-parent-buffer)) (if buffer-file-name (vc-next-action-on-file buffer-file-name verbose) (vc-registration-error nil)))) ;;; These functions help the vc-next-action entry point (defun vc-checkout-writable-buffer (&optional file rev) "Retrieve a writable copy of the latest version of the current buffer's file." (vc-checkout (or file (buffer-file-name)) t rev) ) ;;;###autoload (defun vc-register (&optional override comment) "Register the current file into your version-control system." (interactive "P") (or buffer-file-name (error "No visited file")) (let ((master (vc-name buffer-file-name))) (and master (file-exists-p master) (error "This file is already registered")) (and master (not (y-or-n-p "Previous master file has vanished. Make a new one? ")) (error "This file is already registered"))) ;; Watch out for new buffers of size 0: the corresponding file ;; does not exist yet, even though buffer-modified-p is nil. (if (and (not (buffer-modified-p)) (zerop (buffer-size)) (not (file-exists-p buffer-file-name))) (set-buffer-modified-p t)) (vc-buffer-sync) (cond ((not vc-make-backup-files) ;; inhibit backup for this buffer (make-local-variable 'backup-inhibited) (setq backup-inhibited t))) (vc-admin buffer-file-name (and override (read-string (format "Initial version level for %s: " buffer-file-name)))) ) (defun vc-resynch-window (file &optional keep noquery) ;; If the given file is in the current buffer, ;; either revert on it so we see expanded keyworks, ;; or unvisit it (depending on vc-keep-workfiles) ;; NOQUERY if non-nil inhibits confirmation for reverting. ;; NOQUERY should be t *only* if it is known the only difference ;; between the buffer and the file is due to RCS rather than user editing! (and (string= buffer-file-name file) (if keep (progn ;; temporarily remove vc-find-file-hook, so that ;; we don't lose the properties (remove-hook 'find-file-hooks 'vc-find-file-hook) (vc-revert-buffer1 t noquery) (add-hook 'find-file-hooks 'vc-find-file-hook) (vc-mode-line buffer-file-name)) (kill-buffer (current-buffer))))) (defun vc-resynch-buffer (file &optional keep noquery) ;; if FILE is currently visited, resynch its buffer (let ((buffer (get-file-buffer file))) (if buffer (save-excursion (set-buffer buffer) (vc-resynch-window file keep noquery))))) (defun vc-start-entry (file rev comment msg action &optional after-hook) ;; Accept a comment for an operation on FILE revision REV. If COMMENT ;; is nil, pop up a VC-log buffer, emit MSG, and set the ;; action on close to ACTION; otherwise, do action immediately. ;; Remember the file's buffer in vc-parent-buffer (current one if no file). ;; AFTER-HOOK specifies the local value for vc-log-operation-hook. (let ((parent (if file (find-file-noselect file) (current-buffer)))) (if comment (set-buffer (get-buffer-create "*VC-log*")) (pop-to-buffer (get-buffer-create "*VC-log*"))) (set (make-local-variable 'vc-parent-buffer) parent) (set (make-local-variable 'vc-parent-buffer-name) (concat " from " (buffer-name vc-parent-buffer))) (if file (vc-mode-line file)) (vc-log-mode) (make-local-variable 'vc-log-after-operation-hook) (if after-hook (setq vc-log-after-operation-hook after-hook)) (setq vc-log-operation action) (setq vc-log-file file) (setq vc-log-version rev) (if comment (progn (erase-buffer) (if (eq comment t) (vc-finish-logentry t) (insert comment) (vc-finish-logentry nil))) (message "%s Type C-c C-c when done." msg)))) (defun vc-admin (file rev &optional comment) "Check a file into your version-control system. FILE is the unmodified name of the file. REV should be the base version level to check it in under. COMMENT, if specified, is the checkin comment." (vc-start-entry file rev (or comment (not vc-initial-comment)) "Enter initial comment." 'vc-backend-admin nil)) (defun vc-checkout (file &optional writable rev) "Retrieve a copy of the latest version of the given file." ;; If ftp is on this system and the name matches the ange-ftp format ;; for a remote file, the user is trying something that won't work. (if (and (string-match "^/[^/:]+:" file) (vc-find-binary "ftp")) (error "Sorry, you can't check out files over FTP")) (vc-backend-checkout file writable rev) (vc-resynch-buffer file t t)) (defun vc-steal-lock (file rev &optional owner) "Steal the lock on the current workfile." (let (file-description) (if (not owner) (setq owner (vc-locking-user file))) (if rev (setq file-description (format "%s:%s" file rev)) (setq file-description file)) (if (not (y-or-n-p (format "Take the lock on %s from %s? " file-description owner))) (error "Steal cancelled")) (pop-to-buffer (get-buffer-create "*VC-mail*")) (setq default-directory (expand-file-name "~/")) (auto-save-mode auto-save-default) (mail-mode) (erase-buffer) (mail-setup owner (format "Stolen lock on %s" file-description) nil nil nil (list (list 'vc-finish-steal file rev))) (goto-char (point-max)) (insert (format "I stole the lock on %s, " file-description) (current-time-string) ".\n") (message "Please explain why you stole the lock. Type C-c C-c when done."))) ;; This is called when the notification has been sent. (defun vc-finish-steal (file version) (vc-backend-steal file version) (if (get-file-buffer file) (save-excursion (set-buffer (get-file-buffer file)) (vc-resynch-window file t t)))) (defun vc-checkin (file &optional rev comment) "Check in the file specified by FILE. The optional argument REV may be a string specifying the new version level \(if nil increment the current level). The file is either retained with write permissions zeroed, or deleted (according to the value of `vc-keep-workfiles'). If the back-end is CVS, a writable workfile is always kept. COMMENT is a comment string; if omitted, a buffer is popped up to accept a comment." (vc-start-entry file rev comment "Enter a change comment." 'vc-backend-checkin 'vc-checkin-hook)) ;;; Here is a checkin hook that may prove useful to sites using the ;;; ChangeLog facility supported by Emacs. (defun vc-comment-to-change-log (&optional whoami file-name) "Enter last VC comment into change log file for current buffer's file. Optional arg (interactive prefix) non-nil means prompt for user name and site. Second arg is file name of change log. \ If nil, uses `change-log-default-name'." (interactive (if current-prefix-arg (list current-prefix-arg (prompt-for-change-log-name)))) ;; Make sure the defvar for add-log-current-defun-function has been executed ;; before binding it. (require 'add-log) (let (;; Extract the comment first so we get any error before doing anything. (comment (ring-ref vc-comment-ring 0)) ;; Don't let add-change-log-entry insert a defun name. (add-log-current-defun-function 'ignore) end) ;; Call add-log to do half the work. (add-change-log-entry whoami file-name t t) ;; Insert the VC comment, leaving point before it. (setq end (save-excursion (insert comment) (point-marker))) (if (looking-at "\\s *\\s(") ;; It starts with an open-paren, as in "(foo): Frobbed." ;; So remove the ": " add-log inserted. (delete-char -2)) ;; Canonicalize the white space between the file name and comment. (just-one-space) ;; Indent rest of the text the same way add-log indented the first line. (let ((indentation (current-indentation))) (save-excursion (while (< (point) end) (forward-line 1) (indent-to indentation)) (setq end (point)))) ;; Fill the inserted text, preserving open-parens at bol. (let ((paragraph-separate (concat paragraph-separate "\\|\\s *\\s(")) (paragraph-start (concat paragraph-start "\\|\\s *\\s("))) (beginning-of-line) (fill-region (point) end)) ;; Canonicalize the white space at the end of the entry so it is ;; separated from the next entry by a single blank line. (skip-syntax-forward " " end) (delete-char (- (skip-syntax-backward " "))) (or (eobp) (looking-at "\n\n") (insert "\n")))) (defun vc-finish-logentry (&optional nocomment) "Complete the operation implied by the current log entry." (interactive) ;; Check and record the comment, if any. (if (not nocomment) (progn (goto-char (point-max)) (if (not (bolp)) (newline)) ;; Comment too long? (vc-backend-logentry-check vc-log-file) ;; Record the comment in the comment ring (if (null vc-comment-ring) (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size))) (ring-insert vc-comment-ring (buffer-string)) )) ;; Sync parent buffer in case the user modified it while editing the comment. ;; But not if it is a vc-dired buffer. (save-excursion (set-buffer vc-parent-buffer) (or vc-dired-mode (vc-buffer-sync))) (if (not vc-log-operation) (error "No log operation is pending")) ;; save the parameters held in buffer-local variables (let ((log-operation vc-log-operation) (log-file vc-log-file) (log-version vc-log-version) (log-entry (buffer-string)) (after-hook vc-log-after-operation-hook)) ;; Return to "parent" buffer of this checkin and remove checkin window (pop-to-buffer vc-parent-buffer) (let ((logbuf (get-buffer "*VC-log*"))) (delete-windows-on logbuf) (kill-buffer logbuf)) ;; OK, do it to it (save-excursion (funcall log-operation log-file log-version log-entry)) ;; Now make sure we see the expanded headers (if buffer-file-name (vc-resynch-window buffer-file-name vc-keep-workfiles t)) (run-hooks after-hook))) ;; Code for access to the comment ring (defun vc-previous-comment (arg) "Cycle backwards through comment history." (interactive "*p") (let ((len (ring-length vc-comment-ring))) (cond ((<= len 0) (message "Empty comment ring") (ding)) (t (erase-buffer) ;; Initialize the index on the first use of this command ;; so that the first M-p gets index 0, and the first M-n gets ;; index -1. (if (null vc-comment-ring-index) (setq vc-comment-ring-index (if (> arg 0) -1 (if (< arg 0) 1 0)))) (setq vc-comment-ring-index (mod (+ vc-comment-ring-index arg) len)) (message "%d" (1+ vc-comment-ring-index)) (insert (ring-ref vc-comment-ring vc-comment-ring-index)))))) (defun vc-next-comment (arg) "Cycle forwards through comment history." (interactive "*p") (vc-previous-comment (- arg))) (defun vc-comment-search-reverse (str) "Searches backwards through comment history for substring match." (interactive "sComment substring: ") (if (string= str "") (setq str vc-last-comment-match) (setq vc-last-comment-match str)) (if (null vc-comment-ring-index) (setq vc-comment-ring-index -1)) (let ((str (regexp-quote str)) (len (ring-length vc-comment-ring)) (n (1+ vc-comment-ring-index))) (while (and (< n len) (not (string-match str (ring-ref vc-comment-ring n)))) (setq n (+ n 1))) (cond ((< n len) (vc-previous-comment (- n vc-comment-ring-index))) (t (error "Not found"))))) (defun vc-comment-search-forward (str) "Searches forwards through comment history for substring match." (interactive "sComment substring: ") (if (string= str "") (setq str vc-last-comment-match) (setq vc-last-comment-match str)) (if (null vc-comment-ring-index) (setq vc-comment-ring-index 0)) (let ((str (regexp-quote str)) (len (ring-length vc-comment-ring)) (n vc-comment-ring-index)) (while (and (>= n 0) (not (string-match str (ring-ref vc-comment-ring n)))) (setq n (- n 1))) (cond ((>= n 0) (vc-next-comment (- n vc-comment-ring-index))) (t (error "Not found"))))) ;; Additional entry points for examining version histories ;;;###autoload (defun vc-diff (historic &optional not-urgent) "Display diffs between file versions. Normally this compares the current file and buffer with the most recent checked in version of that file. This uses no arguments. With a prefix argument, it reads the file name to use and two version designators specifying which versions to compare." (interactive "P") (if vc-dired-mode (set-buffer (find-file-noselect (dired-get-filename)))) (while vc-parent-buffer (pop-to-buffer vc-parent-buffer)) (if historic (call-interactively 'vc-version-diff) (if (or (null buffer-file-name) (null (vc-name buffer-file-name))) (error "There is no version-control master associated with this buffer")) (let ((file buffer-file-name) unchanged) (or (and file (vc-name file)) (vc-registration-error file)) (vc-buffer-sync not-urgent) (setq unchanged (vc-workfile-unchanged-p buffer-file-name)) (if unchanged (message "No changes to %s since latest version." file) (vc-backend-diff file) ;; Ideally, we'd like at this point to parse the diff so that ;; the buffer effectively goes into compilation mode and we ;; can visit the old and new change locations via next-error. ;; Unfortunately, this is just too painful to do. The basic ;; problem is that the `old' file doesn't exist to be ;; visited. This plays hell with numerous assumptions in ;; the diff.el and compile.el machinery. (pop-to-buffer "*vc-diff*") (setq default-directory (file-name-directory file)) (if (= 0 (buffer-size)) (progn (setq unchanged t) (message "No changes to %s since latest version." file)) (goto-char (point-min)) (shrink-window-if-larger-than-buffer))) (not unchanged)))) (defun vc-version-diff (file rel1 rel2) "For FILE, report diffs between two stored versions REL1 and REL2 of it. If FILE is a directory, generate diffs between versions for all registered files in or below it." (interactive "FFile or directory to diff: \nsOlder version: \nsNewer version: ") (if (string-equal rel1 "") (setq rel1 nil)) (if (string-equal rel2 "") (setq rel2 nil)) (if (file-directory-p file) (let ((camefrom (current-buffer))) (set-buffer (get-buffer-create "*vc-status*")) (set (make-local-variable 'vc-parent-buffer) camefrom) (set (make-local-variable 'vc-parent-buffer-name) (concat " from " (buffer-name camefrom))) (erase-buffer) (insert "Diffs between " (or rel1 "last version checked in") " and " (or rel2 "current workfile(s)") ":\n\n") (set-buffer (get-buffer-create "*vc-diff*")) (cd file) (vc-file-tree-walk default-directory (function (lambda (f) (message "Looking at %s" f) (and (not (file-directory-p f)) (vc-registered f) (vc-backend-diff f rel1 rel2) (append-to-buffer "*vc-status*" (point-min) (point-max))) ))) (pop-to-buffer "*vc-status*") (insert "\nEnd of diffs.\n") (goto-char (point-min)) (set-buffer-modified-p nil) ) (if (zerop (vc-backend-diff file rel1 rel2)) (message "No changes to %s between %s and %s." file rel1 rel2) (pop-to-buffer "*vc-diff*")))) ;;;###autoload (defun vc-version-other-window (rev) "Visit version REV of the current buffer in another window. If the current buffer is named `F', the version is named `F.~REV~'. If `F.~REV~' already exists, it is used instead of being re-created." (interactive "sVersion to visit (default is latest version): ") (if vc-dired-mode (set-buffer (find-file-noselect (dired-get-filename)))) (while vc-parent-buffer (pop-to-buffer vc-parent-buffer)) (if (and buffer-file-name (vc-name buffer-file-name)) (let* ((version (if (string-equal rev "") (vc-latest-version buffer-file-name) rev)) (filename (concat buffer-file-name ".~" version "~"))) (or (file-exists-p filename) (vc-backend-checkout buffer-file-name nil version filename)) (find-file-other-window filename)) (vc-registration-error buffer-file-name))) ;; Header-insertion code ;;;###autoload (defun vc-insert-headers () "Insert headers in a file for use with your version-control system. Headers desired are inserted at the start of the buffer, and are pulled from the variable `vc-header-alist'." (interactive) (if vc-dired-mode (find-file-other-window (dired-get-filename))) (while vc-parent-buffer (pop-to-buffer vc-parent-buffer)) (save-excursion (save-restriction (widen) (if (or (not (vc-check-headers)) (y-or-n-p "Version headers already exist. Insert another set? ")) (progn (let* ((delims (cdr (assq major-mode vc-comment-alist))) (comment-start-vc (or (car delims) comment-start "#")) (comment-end-vc (or (car (cdr delims)) comment-end "")) (hdstrings (cdr (assoc (vc-backend (buffer-file-name)) vc-header-alist)))) (mapcar (function (lambda (s) (insert comment-start-vc "\t" s "\t" comment-end-vc "\n"))) hdstrings) (if vc-static-header-alist (mapcar (function (lambda (f) (if (string-match (car f) buffer-file-name) (insert (format (cdr f) (car hdstrings)))))) vc-static-header-alist)) ) ))))) (defun vc-clear-headers () ;; Clear all version headers in the current buffer, i.e. reset them ;; to the nonexpanded form. Only implemented for RCS, yet. ;; Don't lose point and mark during this. (let ((context (vc-buffer-context))) (goto-char (point-min)) (while (re-search-forward "\\$\\([A-Za-z]+\\): [^\\$]+\\$" nil t) (replace-match "$\\1$")) (vc-restore-buffer-context context))) ;; The VC directory major mode. Coopt Dired for this. ;; All VC commands get mapped into logical equivalents. (define-derived-mode vc-dired-mode dired-mode "Dired under VC" "The major mode used in VC directory buffers. It is derived from Dired. All Dired commands operate normally. Users currently locking listed files are listed in place of the file's owner and group. Keystrokes bound to VC commands will execute as though they had been called on a buffer attached to the file named in the current Dired buffer line." (setq vc-dired-mode t)) (define-key vc-dired-mode-map "\C-xv" vc-prefix-map) (define-key vc-dired-mode-map "g" 'vc-dired-update) (define-key vc-dired-mode-map "=" 'vc-diff) (defun vc-dired-state-info (file) ;; Return the string that indicates the version control status ;; on a VC dired line. (let ((cvs-state (and (eq (vc-backend file) 'CVS) (vc-cvs-status file)))) (if cvs-state (cond ((eq cvs-state 'up-to-date) nil) ((eq cvs-state 'needs-checkout) "patch") ((eq cvs-state 'locally-modified) "modified") ((eq cvs-state 'needs-merge) "merge") ((eq cvs-state 'unresolved-conflict) "conflict") ((eq cvs-state 'locally-added) "added")) (vc-locking-user file)))) (defun vc-dired-reformat-line (x) ;; Hack a directory-listing line, plugging in locking-user info in ;; place of the user and group info. Should have the beneficial ;; side-effect of shortening the listing line. Each call starts with ;; point immediately following the dired mark area on the line to be ;; hacked. ;; ;; Simplest possible one: ;; (insert (concat x "\t"))) ;; ;; This code, like dired, assumes UNIX -l format. (let ((pos (point)) limit perm owner date-and-file) (end-of-line) (setq limit (point)) (goto-char pos) (cond ((or (re-search-forward ;; owner and group "\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[^ ]+ +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" limit t) (re-search-forward ;; only owner displayed "\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" limit t)) (setq perm (match-string 1) owner (match-string 2) date-and-file (match-string 3))) ((re-search-forward ;; OS/2 -l format, no links, owner, group "\\([drwxlts-]+ \\) *[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" limit t) (setq perm (match-string 1) date-and-file (match-string 2)))) (if (numberp x) (setq x (or owner (number-to-string x)))) (if x (setq x (concat "(" x ")"))) (let ((rep (substring (concat x " ") 0 10))) (replace-match (concat perm rep date-and-file))))) (defun vc-dired-update-line (file) ;; Update the vc-dired listing line of file -- it is assumed ;; that point is already on this line. Don't use dired-do-redisplay ;; for this, because it cannot handle the way vc-dired deals with ;; subdirectories. (beginning-of-line) (forward-char 2) (let ((start (point))) (forward-line 1) (beginning-of-line) (delete-region start (point)) (insert-directory file dired-listing-switches) (forward-line -1) (end-of-line) (delete-char (- (length file))) (insert (substring file (length (expand-file-name default-directory)))) (goto-char start)) (vc-dired-reformat-line (vc-dired-state-info file))) (defun vc-dired-update (verbose) (interactive "P") (vc-directory default-directory verbose)) ;;; Note in Emacs 18 the following defun gets overridden ;;; with the symbol 'vc-directory-18. See below. ;;;###autoload (defun vc-directory (dirname verbose) "Show version-control status of the current directory and subdirectories. Normally it creates a Dired buffer that lists only the locked files in all these directories. With a prefix argument, it lists all files." (interactive "DDired under VC (directory): \nP") (require 'dired) (setq dirname (expand-file-name dirname)) ;; force a trailing slash (if (not (eq (elt dirname (1- (length dirname))) ?/)) (setq dirname (concat dirname "/"))) (let (nonempty (dl (length dirname)) (filelist nil) (statelist nil) (old-dir default-directory) dired-buf dired-buf-mod-count) (vc-file-tree-walk dirname (function (lambda (f) (if (vc-registered f) (let ((state (vc-dired-state-info f))) (and (or verbose state) (setq filelist (cons (substring f dl) filelist)) (setq statelist (cons state statelist)))))))) (save-window-excursion (save-excursion ;; This uses a semi-documented feature of dired; giving a switch ;; argument forces the buffer to refresh each time. (setq dired-buf (dired-internal-noselect (cons dirname (nreverse filelist)) dired-listing-switches 'vc-dired-mode)) (setq nonempty (not (eq 0 (length filelist)))))) (switch-to-buffer dired-buf) ;; Make a few modifications to the header (setq buffer-read-only nil) (goto-char (point-min)) (forward-line 1) ;; Skip header line (let ((start (point))) ;; Erase (but don't remove) the (end-of-line) ;; "wildcard" line. (delete-region start (point))) (beginning-of-line) (if nonempty (progn ;; Plug the version information into the individual lines (mapcar (function (lambda (x) (forward-char 2) ;; skip dired's mark area (vc-dired-reformat-line x) (forward-line 1))) ;; go to next line (nreverse statelist)) (setq buffer-read-only t) (goto-char (point-min)) (dired-next-line 2) ) (dired-next-line 1) (insert " ") (setq buffer-read-only t) (message "No files are currently %s under %s" (if verbose "registered" "locked") dirname)) )) ;; Emacs 18 version (defun vc-directory-18 (verbose) "Show version-control status of all files under the current directory." (interactive "P") (let (nonempty (dir default-directory)) (save-excursion (set-buffer (get-buffer-create "*vc-status*")) (erase-buffer) (cd dir) (vc-file-tree-walk default-directory (function (lambda (f) (if (vc-registered f) (let ((user (vc-locking-user f))) (if (or user verbose) (insert (format "%s %s\n" (concat user) f)))))))) (setq nonempty (not (zerop (buffer-size))))) (if nonempty (progn (pop-to-buffer "*vc-status*" t) (goto-char (point-min)) (shrink-window-if-larger-than-buffer))) (message "No files are currently %s under %s" (if verbose "registered" "locked") default-directory)) ) (or (boundp 'minor-mode-map-alist) (fset 'vc-directory 'vc-directory-18)) ;; Named-configuration support for SCCS (defun vc-add-triple (name file rev) (save-excursion (find-file (expand-file-name vc-name-assoc-file (file-name-as-directory (expand-file-name (vc-backend-subdirectory-name file) (file-name-directory file))))) (goto-char (point-max)) (insert name "\t:\t" file "\t" rev "\n") (basic-save-buffer) (kill-buffer (current-buffer)) )) (defun vc-record-rename (file newname) (save-excursion (find-file (expand-file-name vc-name-assoc-file (file-name-as-directory (expand-file-name (vc-backend-subdirectory-name file) (file-name-directory file))))) (goto-char (point-min)) ;; (replace-regexp (concat ":" (regexp-quote file) "$") (concat ":" newname)) (while (re-search-forward (concat ":" (regexp-quote file) "$") nil t) (replace-match (concat ":" newname) nil nil)) (basic-save-buffer) (kill-buffer (current-buffer)) )) (defun vc-lookup-triple (file name) ;; Return the numeric version corresponding to a named snapshot of file ;; If name is nil or a version number string it's just passed through (cond ((null name) name) ((let ((firstchar (aref name 0))) (and (>= firstchar ?0) (<= firstchar ?9))) name) (t (save-excursion (set-buffer (get-buffer-create "*vc-info*")) (vc-insert-file (expand-file-name vc-name-assoc-file (file-name-as-directory (expand-file-name (vc-backend-subdirectory-name file) (file-name-directory file))))) (prog1 (car (vc-parse-buffer (list (list (concat name "\t:\t" file "\t\\(.+\\)") 1)))) (kill-buffer "*vc-info*")))) )) ;; Named-configuration entry points (defun vc-snapshot-precondition () ;; Scan the tree below the current directory. ;; If any files are locked, return the name of the first such file. ;; (This means, neither snapshot creation nor retrieval is allowed.) ;; If one or more of the files are currently visited, return `visited'. ;; Otherwise, return nil. (let ((status nil)) (catch 'vc-locked-example (vc-file-tree-walk default-directory (function (lambda (f) (and (vc-registered f) (if (vc-locking-user f) (throw 'vc-locked-example f) (if (get-file-buffer f) (setq status 'visited))))))) status))) ;;;###autoload (defun vc-create-snapshot (name) "Make a snapshot called NAME. The snapshot is made from all registered files at or below the current directory. For each file, the version level of its latest version becomes part of the named configuration." (interactive "sNew snapshot name: ") (let ((result (vc-snapshot-precondition))) (if (stringp result) (error "File %s is locked" result) (vc-file-tree-walk default-directory (function (lambda (f) (and (vc-name f) (vc-backend-assign-name f name))))) ))) ;;;###autoload (defun vc-retrieve-snapshot (name) "Retrieve the snapshot called NAME. This function fails if any files are locked at or below the current directory Otherwise, all registered files are checked out (unlocked) at their version levels in the snapshot." (interactive "sSnapshot name to retrieve: ") (let ((result (vc-snapshot-precondition)) (update nil)) (if (stringp result) (error "File %s is locked" result) (if (eq result 'visited) (setq update (yes-or-no-p "Update the affected buffers? "))) (vc-file-tree-walk default-directory (function (lambda (f) (and (vc-name f) (vc-error-occurred (vc-backend-checkout f nil name) (if update (vc-resynch-buffer f t t))))))) ))) ;; Miscellaneous other entry points ;;;###autoload (defun vc-print-log () "List the change log of the current buffer in a window." (interactive) (if vc-dired-mode (set-buffer (find-file-noselect (dired-get-filename)))) (while vc-parent-buffer (pop-to-buffer vc-parent-buffer)) (if (and buffer-file-name (vc-name buffer-file-name)) (let ((file buffer-file-name)) (vc-backend-print-log file) (pop-to-buffer (get-buffer-create "*vc*")) (setq default-directory (file-name-directory file)) (while (looking-at "=*\n") (delete-char (- (match-end 0) (match-beginning 0))) (forward-line -1)) (goto-char (point-min)) (if (looking-at "[\b\t\n\v\f\r ]+") (delete-char (- (match-end 0) (match-beginning 0)))) (shrink-window-if-larger-than-buffer) ) (vc-registration-error buffer-file-name) ) ) ;;;###autoload (defun vc-revert-buffer () "Revert the current buffer's file back to the latest checked-in version. This asks for confirmation if the buffer contents are not identical to that version. If the back-end is CVS, this will give you the most recent revision of the file on the branch you are editing." (interactive) (if vc-dired-mode (find-file-other-window (dired-get-filename))) (while vc-parent-buffer (pop-to-buffer vc-parent-buffer)) (let ((file buffer-file-name) ;; This operation should always ask for confirmation. (vc-suppress-confirm nil) (obuf (current-buffer)) (changed (vc-diff nil t))) (if (and changed (not (yes-or-no-p "Discard changes? "))) (progn (if (and (window-dedicated-p (selected-window)) (one-window-p t 'selected-frame)) (make-frame-invisible (selected-frame)) (delete-window)) (error "Revert cancelled")) (set-buffer obuf)) (if changed (if (and (window-dedicated-p (selected-window)) (one-window-p t 'selected-frame)) (make-frame-invisible (selected-frame)) (delete-window))) (vc-backend-revert file) (vc-resynch-window file t t) ) ) ;;;###autoload (defun vc-cancel-version (norevert) "Get rid of most recently checked in version of this file. A prefix argument means do not revert the buffer afterwards." (interactive "P") (if vc-dired-mode (find-file-other-window (dired-get-filename))) (while vc-parent-buffer (pop-to-buffer vc-parent-buffer)) (cond ((eq (vc-backend (buffer-file-name)) 'CVS) (error "Unchecking files under CVS is dangerous and not supported in VC")) ((vc-locking-user (buffer-file-name)) (error "This version is locked. Use vc-revert-buffer to discard changes.")) ((not (vc-latest-on-branch-p (buffer-file-name))) (error "This is not the latest version. VC cannot cancel it."))) (let ((target (vc-workfile-version (buffer-file-name)))) (if (null (yes-or-no-p "Remove this version from master? ")) nil (setq norevert (or norevert (not (yes-or-no-p "Revert buffer to most recent remaining version? ")))) (vc-backend-uncheck (buffer-file-name) target) (if (not norevert) (vc-checkout (buffer-file-name) nil) ;; If norevert, lock the most recent remaining version, ;; and mark the buffer modified. (if (eq (vc-backend (buffer-file-name)) 'RCS) (progn (setq buffer-read-only nil) (vc-clear-headers))) (vc-backend-checkout (buffer-file-name) t (vc-branch-part target)) (set-visited-file-name (buffer-file-name)) (vc-mode-line (buffer-file-name))) (message "Version %s has been removed from the master." target) ))) ;;;###autoload (defun vc-rename-file (old new) "Rename file OLD to NEW, and rename its master file likewise." (interactive "fVC rename file: \nFRename to: ") ;; There are several ways of renaming files under CVS 1.3, but they all ;; have serious disadvantages. See the FAQ (available from think.com in ;; pub/cvs/). I'd rather send the user an error, than do something he might ;; consider to be wrong. When the famous, long-awaited rename database is ;; implemented things might change for the better. This is unlikely to occur ;; until CVS 2.0 is released. --ceder 1994-01-23 21:27:51 (if (eq (vc-backend old) 'CVS) (error "Renaming files under CVS is dangerous and not supported in VC.")) (let ((oldbuf (get-file-buffer old))) (if (and oldbuf (buffer-modified-p oldbuf)) (error "Please save files before moving them")) (if (get-file-buffer new) (error "Already editing new file name")) (if (file-exists-p new) (error "New file already exists")) (let ((oldmaster (vc-name old))) (if oldmaster (progn (if (vc-locking-user old) (error "Please check in files before moving them")) (if (or (file-symlink-p oldmaster) ;; This had FILE, I changed it to OLD. -- rms. (file-symlink-p (vc-backend-subdirectory-name old))) (error "This is not a safe thing to do in the presence of symbolic links")) (rename-file oldmaster (let ((backend (vc-backend old)) (newdir (or (file-name-directory new) "")) (newbase (file-name-nondirectory new))) (catch 'found (mapcar (function (lambda (s) (if (eq backend (cdr s)) (let* ((newmaster (format (car s) newdir newbase)) (newmasterdir (file-name-directory newmaster))) (if (or (not newmasterdir) (file-directory-p newmasterdir)) (throw 'found newmaster)))))) vc-master-templates) (error "New file lacks a version control directory")))))) (if (or (not oldmaster) (file-exists-p old)) (rename-file old new))) ; ?? Renaming a file might change its contents due to keyword expansion. ; We should really check out a new copy if the old copy was precisely equal ; to some checked in version. However, testing for this is tricky.... (if oldbuf (save-excursion (set-buffer oldbuf) (set-visited-file-name new) (set-buffer-modified-p nil)))) ;; This had FILE, I changed it to OLD. -- rms. (vc-backend-dispatch old (vc-record-rename old new) ;SCCS nil ;RCS nil ;CVS ) ) ;;;###autoload (defun vc-update-change-log (&rest args) "Find change log file and add entries from recent RCS logs. The mark is left at the end of the text prepended to the change log. 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." (interactive (cond ((consp current-prefix-arg) ;C-u (list buffer-file-name)) (current-prefix-arg ;Numeric argument. (let ((files nil) (buffers (buffer-list)) file) (while buffers (setq file (buffer-file-name (car buffers))) (and file (vc-backend file) (setq files (cons file files))) (setq buffers (cdr buffers))) files)) (t (let ((RCS (concat default-directory "RCS"))) (and (file-directory-p RCS) (mapcar (function (lambda (f) (if (string-match "\\(.*\\),v$" f) (substring f 0 (match-end 1)) f))) (directory-files RCS nil "...\\|^[^.]\\|^.[^.]"))))))) (let ((odefault default-directory)) (find-file-other-window (find-change-log)) (barf-if-buffer-read-only) (vc-buffer-sync) (undo-boundary) (goto-char (point-min)) (push-mark) (message "Computing change log entries...") (message "Computing change log entries... %s" (if (or (null args) (eq 0 (apply 'call-process "rcs2log" nil t nil "-u" (concat (user-login-name) "\t" (user-full-name) "\t" user-mail-address) (mapcar (function (lambda (f) (file-relative-name (if (file-name-absolute-p f) f (concat odefault f))))) args)))) "done" "failed")))) ;; Collect back-end-dependent stuff here (defun vc-backend-admin (file &optional rev comment) ;; Register a file into the version-control system ;; Automatically retrieves a read-only version of the file with ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise ;; it deletes the workfile. (vc-file-clearprops file) (or vc-default-back-end (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS))) (message "Registering %s..." file) (let ((backend (cond ((file-exists-p (vc-backend-subdirectory-name)) vc-default-back-end) ((file-exists-p "RCS") 'RCS) ((file-exists-p "SCCS") 'SCCS) ((file-exists-p "CVS") 'CVS) (t vc-default-back-end)))) (cond ((eq backend 'SCCS) (vc-do-command nil 0 "admin" file 'MASTER ;; SCCS (and rev (concat "-r" rev)) "-fb" (concat "-i" file) (and comment (concat "-y" comment)) (format (car (rassq 'SCCS vc-master-templates)) (or (file-name-directory file) "") (file-name-nondirectory file))) (delete-file file) (if vc-keep-workfiles (vc-do-command nil 0 "get" file 'MASTER))) ((eq backend 'RCS) (vc-do-command nil 0 "ci" file 'MASTER ;; RCS ;; if available, use the secure registering option (and (vc-backend-release-p 'RCS "5.6.4") "-i") (concat (if vc-keep-workfiles "-u" "-r") rev) (and comment (concat "-t-" comment)) file)) ((eq backend 'CVS) (vc-do-command nil 0 "cvs" file 'WORKFILE ;; CVS "add" (and comment (string-match "[^\t\n ]" comment) (concat "-m" comment))) ))) (message "Registering %s...done" file) ) (defun vc-backend-checkout (file &optional writable rev workfile) ;; Retrieve a copy of a saved version into a workfile (let ((filename (or workfile file)) (file-buffer (get-file-buffer file)) (old-default-dir default-directory)) (message "Checking out %s..." filename) (save-excursion ;; Change buffers to get local value of vc-checkin-switches. (if file-buffer (set-buffer file-buffer)) ;; Adjust the default-directory so that the check-out creates ;; the file in the right place. The old value is restored below. (setq default-directory (file-name-directory filename)) (vc-backend-dispatch file (if workfile;; SCCS ;; Some SCCS implementations allow checking out directly to a ;; file using the -G option, but then some don't so use the ;; least common denominator approach and use the -p option ;; ala RCS. (let ((vc-modes (logior (file-modes (vc-name file)) (if writable 128 0))) (failed t)) (unwind-protect (progn (apply 'vc-do-command nil 0 "/bin/sh" file 'MASTER "-c" ;; Some shells make the "" dummy argument into $0 ;; while others use the shell's name as $0 and ;; use the "" as $1. The if-statement ;; converts the latter case to the former. (format "if [ x\"$1\" = x ]; then shift; fi; \ umask %o; exec >\"$1\" || exit; \ shift; umask %o; exec get \"$@\"" (logand 511 (lognot vc-modes)) (logand 511 (lognot (default-file-modes)))) "" ; dummy argument for shell's $0 filename (if writable "-e") "-p" (and rev (concat "-r" (vc-lookup-triple file rev))) vc-checkout-switches) (setq failed nil)) (and failed (file-exists-p filename) (delete-file filename)))) (apply 'vc-do-command nil 0 "get" file 'MASTER ;; SCCS (if writable "-e") (and rev (concat "-r" (vc-lookup-triple file rev))) vc-checkout-switches) (vc-file-setprop file 'vc-workfile-version nil)) (if workfile ;; RCS ;; RCS doesn't let us check out into arbitrary file names directly. ;; Use `co -p' and make stdout point to the correct file. (let ((vc-modes (logior (file-modes (vc-name file)) (if writable 128 0))) (failed t)) (unwind-protect (progn (apply 'vc-do-command nil 0 "/bin/sh" file 'MASTER "-c" ;; See the SCCS case, above, regarding the ;; if-statement. (format "if [ x\"$1\" = x ]; then shift; fi; \ umask %o; exec >\"$1\" || exit; \ shift; umask %o; exec co \"$@\"" (logand 511 (lognot vc-modes)) (logand 511 (lognot (default-file-modes)))) "" ; dummy argument for shell's $0 filename (if writable "-l") (concat "-p" rev) vc-checkout-switches) (setq failed nil)) (and failed (file-exists-p filename) (delete-file filename)))) (let (new-version) ;; if we should go to the head of the trunk, ;; clear the default branch first (and rev (string= rev "") (vc-do-command nil 0 "rcs" file 'MASTER "-b")) ;; now do the checkout (apply 'vc-do-command nil 0 "co" file 'MASTER ;; If locking is not strict, force to overwrite ;; the writable workfile. (if (eq (vc-checkout-model file) 'implicit) "-f") (if writable "-l") (if rev (concat "-r" rev) ;; if no explicit revision was specified, ;; check out that of the working file (let ((workrev (vc-workfile-version file))) (if workrev (concat "-r" workrev) nil))) vc-checkout-switches) ;; determine the new workfile version (save-excursion (set-buffer "*vc*") (goto-char (point-min)) (setq new-version (if (re-search-forward "^revision \\([0-9.]+\\).*\n" nil t) (buffer-substring (match-beginning 1) (match-end 1))))) (vc-file-setprop file 'vc-workfile-version new-version) ;; if necessary, adjust the default branch (and rev (not (string= rev "")) (vc-do-command nil 0 "rcs" file 'MASTER (concat "-b" (if (vc-latest-on-branch-p file) (if (vc-trunk-p new-version) nil (vc-branch-part new-version)) new-version)))))) (if workfile ;; CVS ;; CVS is much like RCS (let ((failed t)) (unwind-protect (progn (apply 'vc-do-command nil 0 "/bin/sh" file 'WORKFILE "-c" "exec >\"$1\" || exit; shift; exec cvs update \"$@\"" "" ; dummy argument for shell's $0 workfile (concat "-r" rev) "-p" vc-checkout-switches) (setq failed nil)) (and failed (file-exists-p filename) (delete-file filename)))) ;; default for verbose checkout: clear the sticky tag ;; so that the actual update will get the head of the trunk (and rev (string= rev "") (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A")) ;; If a revision was specified, check that out. (if rev (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE (and writable (eq (vc-checkout-model file) 'manual) "-w") "update" (and rev (not (string= rev "")) (concat "-r" rev)) vc-checkout-switches) ;; If no revision was specified, simply make the file writable. (and writable (or (eq (vc-checkout-model file) 'manual) (zerop (logand 128 (file-modes file)))) (set-file-modes file (logior 128 (file-modes file))))) (if rev (vc-file-setprop file 'vc-workfile-version nil)))) (setq default-directory old-default-dir) (cond ((not workfile) (vc-file-clear-masterprops file) (if writable (vc-file-setprop file 'vc-locking-user (user-login-name))) (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))))) (message "Checking out %s...done" filename)))) (defun vc-backend-logentry-check (file) (vc-backend-dispatch file (if (>= (buffer-size) 512) ;; SCCS (progn (goto-char 512) (error "Log must be less than 512 characters; point is now at pos 512"))) nil ;; RCS nil) ;; CVS ) (defun vc-backend-checkin (file rev comment) ;; Register changes to FILE as level REV with explanatory COMMENT. ;; Automatically retrieves a read-only version of the file with ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise ;; it deletes the workfile. ;; Adaption for RCS branch support: if this is an explicit checkin, ;; or if the checkin creates a new branch, set the master file branch ;; accordingly. (message "Checking in %s..." file) ;; "This log message intentionally left almost blank". ;; RCS 5.7 gripes about white-space-only comments too. (or (and comment (string-match "[^\t\n ]" comment)) (setq comment "*** empty log message ***")) (save-excursion ;; Change buffers to get local value of vc-checkin-switches. (set-buffer (or (get-file-buffer file) (current-buffer))) ;; Clear the master-properties. Do that here, not at the ;; end, because if the check-in fails we want them to get ;; re-computed before the next try. (vc-file-clear-masterprops file) (vc-backend-dispatch file ;; SCCS (progn (apply 'vc-do-command nil 0 "delta" file 'MASTER (if rev (concat "-r" rev)) (concat "-y" comment) vc-checkin-switches) (vc-file-setprop file 'vc-locking-user 'none) (vc-file-setprop file 'vc-workfile-version nil) (if vc-keep-workfiles (vc-do-command nil 0 "get" file 'MASTER)) ) ;; RCS (let ((old-version (vc-workfile-version file)) new-version) (apply 'vc-do-command nil 0 "ci" file 'MASTER ;; if available, use the secure check-in option (and (vc-backend-release-p 'RCS "5.6.4") "-j") (concat (if vc-keep-workfiles "-u" "-r") rev) (concat "-m" comment) vc-checkin-switches) (vc-file-setprop file 'vc-locking-user 'none) (vc-file-setprop file 'vc-workfile-version nil) ;; determine the new workfile version (set-buffer "*vc*") (goto-char (point-min)) (if (or (re-search-forward "new revision: \\([0-9.]+\\);" nil t) (re-search-forward "reverting to previous revision \\([0-9.]+\\)" nil t)) (progn (setq new-version (buffer-substring (match-beginning 1) (match-end 1))) (vc-file-setprop file 'vc-workfile-version new-version))) ;; if we got to a different branch, adjust the default ;; branch accordingly (cond ((and old-version new-version (not (string= (vc-branch-part old-version) (vc-branch-part new-version)))) (vc-do-command nil 0 "rcs" file 'MASTER (if (vc-trunk-p new-version) "-b" (concat "-b" (vc-branch-part new-version)))) ;; If this is an old RCS release, we might have ;; to remove a remaining lock. (if (not (vc-backend-release-p 'RCS "5.6.2")) ;; exit status of 1 is also accepted. ;; It means that the lock was removed before. (vc-do-command nil 1 "rcs" file 'MASTER (concat "-u" old-version)))))) ;; CVS (progn ;; explicit check-in to the trunk requires a ;; double check-in (first unexplicit) (CVS-1.3) (condition-case nil (progn (if (and rev (vc-trunk-p rev)) (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE "ci" "-m" "intermediate" vc-checkin-switches)) (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE "ci" (if rev (concat "-r" rev)) (concat "-m" comment) vc-checkin-switches)) (error (if (eq (vc-cvs-status file) 'needs-merge) ;; The CVS output will be on top of this message. (error "Type C-x 0 C-x C-q to merge in changes.") (error "Check in FAILED.")))) ;; determine and store the new workfile version (set-buffer "*vc*") (goto-char (point-min)) (if (re-search-forward "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" nil t) (vc-file-setprop file 'vc-workfile-version (buffer-substring (match-beginning 2) (match-end 2))) (vc-file-setprop file 'vc-workfile-version nil)) ;; if this was an explicit check-in, remove the sticky tag (if rev (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A")) (vc-file-setprop file 'vc-locking-user 'none) (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))))) (message "Checking in %s...done" file)) (defun vc-backend-revert (file) ;; Revert file to latest checked-in version. ;; (for RCS, to workfile version) (message "Reverting %s..." file) (vc-file-clear-masterprops file) (vc-backend-dispatch file ;; SCCS (progn (vc-do-command nil 0 "unget" file 'MASTER nil) (vc-do-command nil 0 "get" file 'MASTER nil)) ;; RCS (vc-do-command nil 0 "co" file 'MASTER "-f" (concat "-u" (vc-workfile-version file))) ;; CVS (progn (delete-file file) (vc-do-command nil 0 "cvs" file 'WORKFILE "update"))) (vc-file-setprop file 'vc-locking-user 'none) (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) (message "Reverting %s...done" file) ) (defun vc-backend-steal (file &optional rev) ;; Steal the lock on the current workfile. Needs RCS 5.6.2 or later for -M. (message "Stealing lock on %s..." file) (vc-backend-dispatch file (progn ;SCCS (vc-do-command nil 0 "unget" file 'MASTER "-n" (if rev (concat "-r" rev))) (vc-do-command nil 0 "get" file 'MASTER "-g" (if rev (concat "-r" rev))) ) (vc-do-command nil 0 "rcs" file 'MASTER ;RCS "-M" (concat "-u" rev) (concat "-l" rev)) (error "You cannot steal a CVS lock; there are no CVS locks to steal.") ;CVS ) (vc-file-setprop file 'vc-locking-user (user-login-name)) (message "Stealing lock on %s...done" file) ) (defun vc-backend-uncheck (file target) ;; Undo the latest checkin. (message "Removing last change from %s..." file) (vc-backend-dispatch file (vc-do-command nil 0 "rmdel" file 'MASTER (concat "-r" target)) (vc-do-command nil 0 "rcs" file 'MASTER (concat "-o" target)) nil ;; this is never reached under CVS ) (message "Removing last change from %s...done" file) ) (defun vc-backend-print-log (file) ;; Get change log associated with FILE. (vc-backend-dispatch file (vc-do-command nil 0 "prs" file 'MASTER) (vc-do-command nil 0 "rlog" file 'MASTER) (vc-do-command nil 0 "cvs" file 'WORKFILE "rlog"))) (defun vc-backend-assign-name (file name) ;; Assign to a FILE's latest version a given NAME. (vc-backend-dispatch file (vc-add-triple name file (vc-latest-version file)) ;; SCCS (vc-do-command nil 0 "rcs" file 'MASTER (concat "-n" name ":")) ;; RCS (vc-do-command nil 0 "cvs" file 'WORKFILE "tag" name) ;; CVS ) ) (defun vc-backend-diff (file &optional oldvers newvers cmp) ;; Get a difference report between two versions of FILE. ;; Get only a brief comparison report if CMP, a difference report otherwise. (let ((backend (vc-backend file))) (cond ((eq backend 'SCCS) (setq oldvers (vc-lookup-triple file oldvers)) (setq newvers (vc-lookup-triple file newvers))) ((eq backend 'RCS) (if (not oldvers) (setq oldvers (vc-workfile-version file))) ;; If we know that --brief is not supported, don't try it. (setq cmp (and cmp (not (eq vc-rcsdiff-knows-brief 'no)))))) ;; SCCS and RCS shares a lot of code. (cond ((or (eq backend 'SCCS) (eq backend 'RCS)) (let* ((command (if (eq backend 'SCCS) "vcdiff" "rcsdiff")) (mode (if (eq backend 'RCS) 'WORKFILE 'MASTER)) (options (append (list (and cmp "--brief") "-q" (and oldvers (concat "-r" oldvers)) (and newvers (concat "-r" newvers))) (and (not cmp) (if (listp diff-switches) diff-switches (list diff-switches))))) (status (apply 'vc-do-command "*vc-diff*" 2 command file mode options))) ;; If --brief didn't work, do a double-take and remember it ;; for the future. (if (eq status 2) (prog1 (apply 'vc-do-command "*vc-diff*" 1 command file 'WORKFILE (if cmp (cdr options) options)) (if cmp (setq vc-rcsdiff-knows-brief 'no))) ;; If --brief DID work, remember that, too. (and cmp (not vc-rcsdiff-knows-brief) (setq vc-rcsdiff-knows-brief 'yes)) status))) ;; CVS is different. ((eq backend 'CVS) (if (string= (vc-workfile-version file) "0") ;CVS ;; This file is added but not yet committed; there is no master file. (if (or oldvers newvers) (error "No revisions of %s exist" file) (if cmp 1 ;; file is added but not committed, ;; we regard this as "changed". ;; diff it against /dev/null. (apply 'vc-do-command "*vc-diff*" 1 "diff" file 'WORKFILE (append (if (listp diff-switches) diff-switches (list diff-switches)) '("/dev/null"))))) ;; cmp is not yet implemented -- we always do a full diff. (apply 'vc-do-command "*vc-diff*" 1 "cvs" file 'WORKFILE "diff" (and oldvers (concat "-r" oldvers)) (and newvers (concat "-r" newvers)) (if (listp diff-switches) diff-switches (list diff-switches))))) (t (vc-registration-error file))))) (defun vc-backend-merge-news (file) ;; Merge in any new changes made to FILE. (message "Merging changes into %s..." file) (prog1 (vc-backend-dispatch file (error "vc-backend-merge-news not meaningful for SCCS files") ;SCCS (error "vc-backend-merge-news not meaningful for RCS files") ;RCS (save-excursion ; CVS (vc-file-clear-masterprops file) (vc-file-setprop file 'vc-workfile-version nil) (vc-file-setprop file 'vc-locking-user nil) (vc-do-command nil 0 "cvs" file 'WORKFILE "update") ;; CVS doesn't return an error code if conflicts are detected. ;; Since we want to warn the user about it (and possibly start ;; emerge later), scan the output and see if this occurred. (set-buffer (get-buffer "*vc*")) (goto-char (point-min)) (if (re-search-forward "^cvs update: conflicts found in .*" nil t) 1 ;; error code for caller 0 ;; no conflict detected ))) (message "Merging changes into %s...done" file))) (defun vc-check-headers () "Check if the current file has any headers in it." (interactive) (save-excursion (goto-char (point-min)) (vc-backend-dispatch buffer-file-name (re-search-forward "%[MIRLBSDHTEGUYFPQCZWA]%" nil t) ;; SCCS (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t) ;; RCS 'RCS ;; CVS works like RCS in this regard. ) )) ;; Back-end-dependent stuff ends here. ;; Set up key bindings for use while editing log messages (defun vc-log-mode () "Minor mode for driving version-control tools. These bindings are added to the global keymap when you enter this mode: \\[vc-next-action] perform next logical version-control operation on current file \\[vc-register] register current file \\[vc-toggle-read-only] like next-action, but won't register files \\[vc-insert-headers] insert version-control headers in current file \\[vc-print-log] display change history of current file \\[vc-revert-buffer] revert buffer to latest version \\[vc-cancel-version] undo latest checkin \\[vc-diff] show diffs between file versions \\[vc-version-other-window] visit old version in another window \\[vc-directory] show all files locked by any user in or below . \\[vc-update-change-log] add change log entry from recent checkins While you are entering a change log message for a version, the following additional bindings will be in effect. \\[vc-finish-logentry] proceed with check in, ending log message entry Whenever you do a checkin, your log comment is added to a ring of saved comments. These can be recalled as follows: \\[vc-next-comment] replace region with next message in comment ring \\[vc-previous-comment] replace region with previous message in comment ring \\[vc-comment-search-reverse] search backward for regexp in the comment ring \\[vc-comment-search-forward] search backward for regexp in the comment ring Entry to the change-log submode calls the value of text-mode-hook, then the value of vc-log-mode-hook. Global user options: vc-initial-comment If non-nil, require user to enter a change comment upon first checkin of the file. vc-keep-workfiles Non-nil value prevents workfiles from being deleted when changes are checked in vc-suppress-confirm Suppresses some confirmation prompts, notably for reversions. vc-header-alist Which keywords to insert when adding headers with \\[vc-insert-headers]. Defaults to '(\"\%\W\%\") under SCCS, '(\"\$Id\$\") under RCS and CVS. vc-static-header-alist By default, version headers inserted in C files get stuffed in a static string area so that ident(RCS/CVS) or what(SCCS) can see them in the compiled object code. You can override this by setting this variable to nil, or change the header template by changing it. vc-command-messages if non-nil, display run messages from the actual version-control utilities (this is intended primarily for people hacking vc itself). " (interactive) (set-syntax-table text-mode-syntax-table) (use-local-map vc-log-entry-mode) (setq local-abbrev-table text-mode-abbrev-table) (setq major-mode 'vc-log-mode) (setq mode-name "VC-Log") (make-local-variable 'vc-log-file) (make-local-variable 'vc-log-version) (make-local-variable 'vc-comment-ring-index) (set-buffer-modified-p nil) (setq buffer-file-name nil) (run-hooks 'text-mode-hook 'vc-log-mode-hook) ) ;; Initialization code, to be done just once at load-time (if vc-log-entry-mode nil (setq vc-log-entry-mode (make-sparse-keymap)) (define-key vc-log-entry-mode "\M-n" 'vc-next-comment) (define-key vc-log-entry-mode "\M-p" 'vc-previous-comment) (define-key vc-log-entry-mode "\M-r" 'vc-comment-search-reverse) (define-key vc-log-entry-mode "\M-s" 'vc-comment-search-forward) (define-key vc-log-entry-mode "\C-c\C-c" 'vc-finish-logentry) ) ;;; These things should probably be generally available (defun vc-file-tree-walk (dirname func &rest args) "Walk recursively through DIRNAME. Invoke FUNC f ARGS on each non-directory file f underneath it." (vc-file-tree-walk-internal (expand-file-name dirname) func args) (message "Traversing directory %s...done" dirname)) (defun vc-file-tree-walk-internal (file func args) (if (not (file-directory-p file)) (apply func file args) (message "Traversing directory %s..." (abbreviate-file-name file)) (let ((dir (file-name-as-directory file))) (mapcar (function (lambda (f) (or (string-equal f ".") (string-equal f "..") (member f vc-directory-exclusion-list) (let ((dirf (concat dir f))) (or (file-symlink-p dirf) ;; Avoid possible loops (vc-file-tree-walk-internal dirf func args)))))) (directory-files dir))))) (provide 'vc) ;;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE ;;; ;;; These may be useful to anyone who has to debug or extend the package. ;;; (Note that this information corresponds to versions 5.x. Some of it ;;; might have been invalidated by the additions to support branching ;;; and RCS keyword lookup. AS, 1995/03/24) ;;; ;;; A fundamental problem in VC is that there are time windows between ;;; vc-next-action's computations of the file's version-control state and ;;; the actions that change it. This is a window open to lossage in a ;;; multi-user environment; someone else could nip in and change the state ;;; of the master during it. ;;; ;;; The performance problem is that rlog/prs calls are very expensive; we want ;;; to avoid them as much as possible. ;;; ;;; ANALYSIS: ;;; ;;; The performance problem, it turns out, simplifies in practice to the ;;; problem of making vc-locking-user fast. The two other functions that call ;;; prs/rlog will not be so commonly used that the slowdown is a problem; one ;;; makes snapshots, the other deletes the calling user's last change in the ;;; master. ;;; ;;; The race condition implies that we have to either (a) lock the master ;;; during the entire execution of vc-next-action, or (b) detect and ;;; recover from errors resulting from dispatch on an out-of-date state. ;;; ;;; Alternative (a) appears to be unfeasible. The problem is that we can't ;;; guarantee that the lock will ever be removed. Suppose a user starts a ;;; checkin, the change message buffer pops up, and the user, having wandered ;;; off to do something else, simply forgets about it? ;;; ;;; Alternative (b), on the other hand, works well with a cheap way to speed up ;;; vc-locking-user. Usually, if a file is registered, we can read its locked/ ;;; unlocked state and its current owner from its permissions. ;;; ;;; This shortcut will fail if someone has manually changed the workfile's ;;; permissions; also if developers are munging the workfile in several ;;; directories, with symlinks to a master (in this latter case, the ;;; permissions shortcut will fail to detect a lock asserted from another ;;; directory). ;;; ;;; Note that these cases correspond exactly to the errors which could happen ;;; because of a competing checkin/checkout race in between two instances of ;;; vc-next-action. ;;; ;;; For VC's purposes, a workfile/master pair may have the following states: ;;; ;;; A. Unregistered. There is a workfile, there is no master. ;;; ;;; B. Registered and not locked by anyone. ;;; ;;; C. Locked by calling user and unchanged. ;;; ;;; D. Locked by the calling user and changed. ;;; ;;; E. Locked by someone other than the calling user. ;;; ;;; This makes for 25 states and 20 error conditions. Here's the matrix: ;;; ;;; VC's idea of state ;;; | ;;; V Actual state RCS action SCCS action Effect ;;; A B C D E ;;; A . 1 2 3 4 ci -u -t- admin -fb -i initial admin ;;; B 5 . 6 7 8 co -l get -e checkout ;;; C 9 10 . 11 12 co -u unget; get revert ;;; D 13 14 15 . 16 ci -u -m delta -y; get checkin ;;; E 17 18 19 20 . rcs -u -M -l unget -n ; get -g steal lock ;;; ;;; All commands take the master file name as a last argument (not shown). ;;; ;;; In the discussion below, a "self-race" is a pathological situation in ;;; which VC operations are being attempted simultaneously by two or more ;;; Emacsen running under the same username. ;;; ;;; The vc-next-action code has the following windows: ;;; ;;; Window P: ;;; Between the check for existence of a master file and the call to ;;; admin/checkin in vc-buffer-admin (apparent state A). This window may ;;; never close if the initial-comment feature is on. ;;; ;;; Window Q: ;;; Between the call to vc-workfile-unchanged-p in and the immediately ;;; following revert (apparent state C). ;;; ;;; Window R: ;;; Between the call to vc-workfile-unchanged-p in and the following ;;; checkin (apparent state D). This window may never close. ;;; ;;; Window S: ;;; Between the unlock and the immediately following checkout during a ;;; revert operation (apparent state C). Included in window Q. ;;; ;;; Window T: ;;; Between vc-locking-user and the following checkout (apparent state B). ;;; ;;; Window U: ;;; Between vc-locking-user and the following revert (apparent state C). ;;; Includes windows Q and S. ;;; ;;; Window V: ;;; Between vc-locking-user and the following checkin (apparent state ;;; D). This window may never be closed if the user fails to complete the ;;; checkin message. Includes window R. ;;; ;;; Window W: ;;; Between vc-locking-user and the following steal-lock (apparent ;;; state E). This window may never close if the user fails to complete ;;; the steal-lock message. Includes window X. ;;; ;;; Window X: ;;; Between the unlock and the immediately following re-lock during a ;;; steal-lock operation (apparent state E). This window may never cloce ;;; if the user fails to complete the steal-lock message. ;;; ;;; Errors: ;;; ;;; Apparent state A --- ;;; ;;; 1. File looked unregistered but is actually registered and not locked. ;;; ;;; Potential cause: someone else's admin during window P, with ;;; caller's admin happening before their checkout. ;;; ;;; RCS: Prior to version 5.6.4, ci fails with message ;;; "no lock set by ". From 5.6.4 onwards, VC uses the new ;;; ci -i option and the message is ",v: already exists". ;;; SCCS: admin will fail with error (ad19). ;;; ;;; We can let these errors be passed up to the user. ;;; ;;; 2. File looked unregistered but is actually locked by caller, unchanged. ;;; ;;; Potential cause: self-race during window P. ;;; ;;; RCS: Prior to version 5.6.4, reverts the file to the last saved ;;; version and unlocks it. From 5.6.4 onwards, VC uses the new ;;; ci -i option, failing with message ",v: already exists". ;;; SCCS: will fail with error (ad19). ;;; ;;; Either of these consequences is acceptable. ;;; ;;; 3. File looked unregistered but is actually locked by caller, changed. ;;; ;;; Potential cause: self-race during window P. ;;; ;;; RCS: Prior to version 5.6.4, VC registers the caller's workfile as ;;; a delta with a null change comment (the -t- switch will be ;;; ignored). From 5.6.4 onwards, VC uses the new ci -i option, ;;; failing with message ",v: already exists". ;;; SCCS: will fail with error (ad19). ;;; ;;; 4. File looked unregistered but is locked by someone else. ;;; ;;; Potential cause: someone else's admin during window P, with ;;; caller's admin happening *after* their checkout. ;;; ;;; RCS: Prior to version 5.6.4, ci fails with a ;;; "no lock set by " message. From 5.6.4 onwards, ;;; VC uses the new ci -i option, failing with message ;;; ",v: already exists". ;;; SCCS: will fail with error (ad19). ;;; ;;; We can let these errors be passed up to the user. ;;; ;;; Apparent state B --- ;;; ;;; 5. File looked registered and not locked, but is actually unregistered. ;;; ;;; Potential cause: master file got nuked during window P. ;;; ;;; RCS: will fail with "RCS/: No such file or directory" ;;; SCCS: will fail with error ut4. ;;; ;;; We can let these errors be passed up to the user. ;;; ;;; 6. File looked registered and not locked, but is actually locked by the ;;; calling user and unchanged. ;;; ;;; Potential cause: self-race during window T. ;;; ;;; RCS: in the same directory as the previous workfile, co -l will fail ;;; with "co error: writable foo exists; checkout aborted". In any other ;;; directory, checkout will succeed. ;;; SCCS: will fail with ge17. ;;; ;;; Either of these consequences is acceptable. ;;; ;;; 7. File looked registered and not locked, but is actually locked by the ;;; calling user and changed. ;;; ;;; As case 6. ;;; ;;; 8. File looked registered and not locked, but is actually locked by another ;;; user. ;;; ;;; Potential cause: someone else checks it out during window T. ;;; ;;; RCS: co error: revision 1.3 already locked by ;;; SCCS: fails with ge4 (in directory) or ut7 (outside it). ;;; ;;; We can let these errors be passed up to the user. ;;; ;;; Apparent state C --- ;;; ;;; 9. File looks locked by calling user and unchanged, but is unregistered. ;;; ;;; As case 5. ;;; ;;; 10. File looks locked by calling user and unchanged, but is actually not ;;; locked. ;;; ;;; Potential cause: a self-race in window U, or by the revert's ;;; landing during window X of some other user's steal-lock or window S ;;; of another user's revert. ;;; ;;; RCS: succeeds, refreshing the file from the identical version in ;;; the master. ;;; SCCS: fails with error ut4 (p file nonexistent). ;;; ;;; Either of these consequences is acceptable. ;;; ;;; 11. File is locked by calling user. It looks unchanged, but is actually ;;; changed. ;;; ;;; Potential cause: the file would have to be touched by a self-race ;;; during window Q. ;;; ;;; The revert will succeed, removing whatever changes came with ;;; the touch. It is theoretically possible that work could be lost. ;;; ;;; 12. File looks like it's locked by the calling user and unchanged, but ;;; it's actually locked by someone else. ;;; ;;; Potential cause: a steal-lock in window V. ;;; ;;; RCS: co error: revision locked by ; use co -r or rcs -u ;;; SCCS: fails with error un2 ;;; ;;; We can pass these errors up to the user. ;;; ;;; Apparent state D --- ;;; ;;; 13. File looks like it's locked by the calling user and changed, but it's ;;; actually unregistered. ;;; ;;; Potential cause: master file got nuked during window P. ;;; ;;; RCS: Prior to version 5.6.4, checks in the user's version as an ;;; initial delta. From 5.6.4 onwards, VC uses the new ci -j ;;; option, failing with message "no such file or directory". ;;; SCCS: will fail with error ut4. ;;; ;;; This case is kind of nasty. Under RCS prior to version 5.6.4, ;;; VC may fail to detect the loss of previous version information. ;;; ;;; 14. File looks like it's locked by the calling user and changed, but it's ;;; actually unlocked. ;;; ;;; Potential cause: self-race in window V, or the checkin happening ;;; during the window X of someone else's steal-lock or window S of ;;; someone else's revert. ;;; ;;; RCS: ci will fail with "no lock set by ". ;;; SCCS: delta will fail with error ut4. ;;; ;;; 15. File looks like it's locked by the calling user and changed, but it's ;;; actually locked by the calling user and unchanged. ;;; ;;; Potential cause: another self-race --- a whole checkin/checkout ;;; sequence by the calling user would have to land in window R. ;;; ;;; SCCS: checks in a redundant delta and leaves the file unlocked as usual. ;;; RCS: reverts to the file state as of the second user's checkin, leaving ;;; the file unlocked. ;;; ;;; It is theoretically possible that work could be lost under RCS. ;;; ;;; 16. File looks like it's locked by the calling user and changed, but it's ;;; actually locked by a different user. ;;; ;;; RCS: ci error: no lock set by ;;; SCCS: unget will fail with error un2 ;;; ;;; We can pass these errors up to the user. ;;; ;;; Apparent state E --- ;;; ;;; 17. File looks like it's locked by some other user, but it's actually ;;; unregistered. ;;; ;;; As case 13. ;;; ;;; 18. File looks like it's locked by some other user, but it's actually ;;; unlocked. ;;; ;;; Potential cause: someone released a lock during window W. ;;; ;;; RCS: The calling user will get the lock on the file. ;;; SCCS: unget -n will fail with cm4. ;;; ;;; Either of these consequences will be OK. ;;; ;;; 19. File looks like it's locked by some other user, but it's actually ;;; locked by the calling user and unchanged. ;;; ;;; Potential cause: the other user relinquishing a lock followed by ;;; a self-race, both in window W. ;;; ;;; Under both RCS and SCCS, both unlock and lock will succeed, making ;;; the sequence a no-op. ;;; ;;; 20. File looks like it's locked by some other user, but it's actually ;;; locked by the calling user and changed. ;;; ;;; As case 19. ;;; ;;; PROBLEM CASES: ;;; ;;; In order of decreasing severity: ;;; ;;; Cases 11 and 15 are the only ones that potentially lose work. ;;; They would require a self-race for this to happen. ;;; ;;; Case 13 in RCS loses information about previous deltas, retaining ;;; only the information in the current workfile. This can only happen ;;; if the master file gets nuked in window P. ;;; ;;; Case 3 in RCS and case 15 under SCCS insert a redundant delta with ;;; no change comment in the master. This would require a self-race in ;;; window P or R respectively. ;;; ;;; Cases 2, 10, 19 and 20 do extra work, but make no changes. ;;; ;;; Unfortunately, it appears to me that no recovery is possible in these ;;; cases. They don't yield error messages, so there's no way to tell that ;;; a race condition has occurred. ;;; ;;; All other cases don't change either the workfile or the master, and ;;; trigger command errors which the user will see. ;;; ;;; Thus, there is no explicit recovery code. ;;; vc.el ends here emacs-19.30/lisp/version.el100666 12120 1 5547 6054641636 14111 0ustar rmsdaemon;;; version.el --- record version number of Emacs. ;;; Copyright (C) 1985, 1992, 1994, 1995 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (defconst emacs-version "19.30" "\ Version numbers of this version of Emacs.") (defconst emacs-major-version (progn (string-match "^[0-9]+" emacs-version) (string-to-int (match-string 0 emacs-version))) "Major version number of this version of Emacs. This variable first existed in version 19.23.") (defconst emacs-minor-version (progn (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version) (string-to-int (match-string 1 emacs-version))) "Minor version number of this version of Emacs. This variable first existed in version 19.23.") (defconst emacs-build-time (current-time-string) "\ Time at which Emacs was dumped out.") (defconst emacs-build-system (system-name)) (defun emacs-version (&optional here) "\ Return string describing the version of Emacs that is running. If optional argument HERE is non-nil, insert string at point. Don't use this function in programs to choose actions according to the system configuration; look at `system-configuration' instead." (interactive "P") (let ((version-string (format "GNU Emacs %s (%s%s) of %s %s on %s" emacs-version system-configuration (cond ((featurep 'motif) ", Motif") ((featurep 'x-toolkit) ", X toolkit") (t "")) (substring emacs-build-time 0 (string-match " *[0-9]*:" emacs-build-time)) (substring emacs-build-time (string-match "[0-9]*$" emacs-build-time)) emacs-build-system))) (if here (insert version-string) (if (interactive-p) (message "%s" version-string) version-string)))) ;;; We hope that this alias is easier for people to find. (defalias 'version 'emacs-version) ;;; We put version info into the executable in the form that UNIX what(1) uses. (or (memq system-type '(vax-vms windows-nt ms-dos)) (purecopy (concat "\n@(#)" (emacs-version) "\n"))) ;;Local variables: ;;version-control: never ;;End: ;;; version.el ends here emacs-19.30/lisp/vi.el100444 12120 1 160752 6007235257 13070 0ustar rmsdaemon;;; vi.el --- major mode for emulating "vi" editor under GNU Emacs. ; This file is in the public domain because the authors distributed it ; without a copyright noticed before the US signed the Bern Convention. ;; Author: Neal Ziring ;; Felix S. T. Wu ;; Keywords: emulations ;;; Commentary: ; Originally written by : seismo!wucs!nz@rsch.wisc.edu (Neal Ziring) ; Extensively redesigned and rewritten by wu@crys.wisc.edu (Felix S.T. Wu) ; Last revision: 01/07/87 Wed (for GNU Emacs 18.33) ; INSTALLATION PROCEDURE: ; 1) Add a global key binding for command "vi-mode" (I use ESC ESC instead of ; the single ESC used in real "vi", so I can access other ESC prefixed emacs ; commands while I'm in "vi"), say, by putting the following line in your ; ".emacs" file: ; (define-key global-map "\e\e" 'vi-mode) ;quick switch into vi-mode ; 2) If you wish you can define "find-file-hooks" to enter "vi" automatically ; after a file is loaded into the buffer. For example, I defined it as: ; (setq find-file-hooks (list ; (function (lambda () ; (if (not (or (eq major-mode 'Info-mode) ; (eq major-mode 'vi-mode))) ; (vi-mode)))))) ; 3) In your .emacs file you can define the command "vi-mode" to be "autoload" ; or you can execute the "load" command to load "vi" directly. ; 4) Read the comments for command "vi-mode" before you start using it. ; ; COULD DO ; 1). A general 'define-operator' function to replace current hack ; 2). In operator handling, should allow other point moving Emacs commands ; (such as ESC <, ESC >) to be used as arguments. ; ;;; Code: (defun vi-switch-mode (arg mode-char) "Switch the major mode of current buffer as specified by the following char \\{vi-tilde-map}" (interactive "P\nc") (let ((mode-cmd (lookup-key vi-tilde-map (char-to-string mode-char)))) (if (null mode-cmd) (with-output-to-temp-buffer "*Help*" (princ (substitute-command-keys "Possible major modes to switch to: \\{vi-tilde-map}")) (save-excursion (set-buffer standard-output) (help-mode))) (setq prefix-arg arg) ; prefix arg will be passed down (command-execute mode-cmd nil) ; may need to save mode-line-format etc (force-mode-line-update)))) ; just in case (if (null (where-is-internal 'vi-switch-mode (current-local-map))) (define-key ctl-x-map "~" 'vi-switch-mode)) (defvar vi-tilde-map nil "Keymap used for \\[vi-switch-mode] prefix key. Link to various major modes.") (if vi-tilde-map nil (setq vi-tilde-map (make-keymap)) (define-key vi-tilde-map "a" 'abbrev-mode) (define-key vi-tilde-map "c" 'c-mode) (define-key vi-tilde-map "d" 'vi-debugging) (define-key vi-tilde-map "e" 'emacs-lisp-mode) (define-key vi-tilde-map "f" 'auto-fill-mode) (define-key vi-tilde-map "g" 'prolog-mode) (define-key vi-tilde-map "h" 'hanoi) (define-key vi-tilde-map "i" 'info-mode) (define-key vi-tilde-map "l" 'lisp-mode) (define-key vi-tilde-map "n" 'nroff-mode) (define-key vi-tilde-map "o" 'overwrite-mode) (define-key vi-tilde-map "O" 'outline-mode) (define-key vi-tilde-map "P" 'picture-mode) (define-key vi-tilde-map "r" 'vi-readonly-mode) (define-key vi-tilde-map "t" 'text-mode) (define-key vi-tilde-map "v" 'vi-mode) (define-key vi-tilde-map "x" 'tex-mode) (define-key vi-tilde-map "~" 'vi-back-to-old-mode)) (defun vi-debugging (arg) "Toggle debug-on-error flag. If prefix arg is given, set t." (interactive "P") (if arg (setq debug-on-error t) (setq debug-on-error (not debug-on-error))) (if debug-on-error (message "Debug-on-error ...") (message "NO more debug-on-error"))) (defun vi-back-to-old-mode () "Go back to the previous mode without setting up for insertion." (interactive) (if vi-mode-old-major-mode (progn (setq mode-name vi-mode-old-mode-name) (use-local-map vi-mode-old-local-map) (setq major-mode vi-mode-old-major-mode) (setq case-fold-search vi-mode-old-case-fold) (force-mode-line-update)))) (defun vi-readonly-mode () "Toggle current buffer's readonly flag." (interactive) (setq buffer-read-only (not buffer-read-only))) (defvar vi-com-map nil "Keymap used in Evi's command state Command state includes most of the vi editing commands, with some Emacs command extensions.") (put 'vi-undefined 'suppress-keymap t) (if vi-com-map nil (setq vi-com-map (make-keymap)) ;;(fillarray vi-com-map 'vi-undefined) (define-key vi-com-map "\C-@" 'vi-mark-region) ; extension (define-key vi-com-map "\C-a" 'vi-ask-for-info) ; extension (define-key vi-com-map "\C-b" 'vi-backward-windowfull) (define-key vi-com-map "\C-c" 'vi-do-old-mode-C-c-command) ; extension (define-key vi-com-map "\C-d" 'vi-scroll-down-window) (define-key vi-com-map "\C-e" 'vi-expose-line-below) (define-key vi-com-map "\C-f" 'vi-forward-windowfull) (define-key vi-com-map "\C-g" 'keyboard-quit) (define-key vi-com-map "\C-i" 'indent-relative-maybe) ; TAB (define-key vi-com-map "\C-j" 'vi-next-line) ; LFD (define-key vi-com-map "\C-k" 'vi-kill-line) ; extension (define-key vi-com-map "\C-l" 'recenter) (define-key vi-com-map "\C-m" 'vi-next-line-first-nonwhite) ; RET (define-key vi-com-map "\C-n" 'vi-next-line) (define-key vi-com-map "\C-o" 'vi-split-open-line) (define-key vi-com-map "\C-p" 'previous-line) (define-key vi-com-map "\C-q" 'vi-query-replace) ; extension (define-key vi-com-map "\C-r" 'vi-isearch-backward) ; modification (define-key vi-com-map "\C-s" 'vi-isearch-forward) ; extension (define-key vi-com-map "\C-t" 'vi-transpose-objects) ; extension (define-key vi-com-map "\C-u" 'vi-scroll-up-window) (define-key vi-com-map "\C-v" 'scroll-up) ; extension (define-key vi-com-map "\C-w" 'vi-kill-region) ; extension (define-key vi-com-map "\C-x" 'Control-X-prefix) ; extension (define-key vi-com-map "\C-y" 'vi-expose-line-above) (define-key vi-com-map "\C-z" 'suspend-emacs) (define-key vi-com-map "\e" 'ESC-prefix); C-[ (ESC) (define-key vi-com-map "\C-\\" 'vi-unimplemented) (define-key vi-com-map "\C-]" 'find-tag) (define-key vi-com-map "\C-^" 'vi-locate-def) ; extension (define-key vi-com-map "\C-_" 'vi-undefined) (define-key vi-com-map " " 'forward-char) (define-key vi-com-map "!" 'vi-operator) (define-key vi-com-map "\"" 'vi-char-argument) (define-key vi-com-map "#" 'universal-argument) ; extension (define-key vi-com-map "$" 'end-of-line) (define-key vi-com-map "%" 'vi-find-matching-paren) (define-key vi-com-map "&" 'vi-unimplemented) (define-key vi-com-map "'" 'vi-goto-line-mark) (define-key vi-com-map "(" 'backward-sexp) (define-key vi-com-map ")" 'forward-sexp) (define-key vi-com-map "*" 'vi-name-last-change-or-macro) ; extension (define-key vi-com-map "+" 'vi-next-line-first-nonwhite) (define-key vi-com-map "," 'vi-reverse-last-find-char) (define-key vi-com-map "-" 'vi-previous-line-first-nonwhite) (define-key vi-com-map "." 'vi-redo-last-change-command) (define-key vi-com-map "/" 'vi-search-forward) (define-key vi-com-map "0" 'beginning-of-line) (define-key vi-com-map "1" 'vi-digit-argument) (define-key vi-com-map "2" 'vi-digit-argument) (define-key vi-com-map "3" 'vi-digit-argument) (define-key vi-com-map "4" 'vi-digit-argument) (define-key vi-com-map "5" 'vi-digit-argument) (define-key vi-com-map "6" 'vi-digit-argument) (define-key vi-com-map "7" 'vi-digit-argument) (define-key vi-com-map "8" 'vi-digit-argument) (define-key vi-com-map "9" 'vi-digit-argument) (define-key vi-com-map ":" 'vi-ex-cmd) (define-key vi-com-map ";" 'vi-repeat-last-find-char) (define-key vi-com-map "<" 'vi-operator) (define-key vi-com-map "=" 'vi-operator) (define-key vi-com-map ">" 'vi-operator) (define-key vi-com-map "?" 'vi-search-backward) (define-key vi-com-map "@" 'vi-call-named-change-or-macro) ; extension (define-key vi-com-map "A" 'vi-append-at-end-of-line) (define-key vi-com-map "B" 'vi-backward-blank-delimited-word) (define-key vi-com-map "C" 'vi-change-rest-of-line) (define-key vi-com-map "D" 'vi-kill-line) (define-key vi-com-map "E" 'vi-end-of-blank-delimited-word) (define-key vi-com-map "F" 'vi-backward-find-char) (define-key vi-com-map "G" 'vi-goto-line) (define-key vi-com-map "H" 'vi-home-window-line) (define-key vi-com-map "I" 'vi-insert-before-first-nonwhite) (define-key vi-com-map "J" 'vi-join-lines) (define-key vi-com-map "K" 'vi-undefined) (define-key vi-com-map "L" 'vi-last-window-line) (define-key vi-com-map "M" 'vi-middle-window-line) (define-key vi-com-map "N" 'vi-reverse-last-search) (define-key vi-com-map "O" 'vi-open-above) (define-key vi-com-map "P" 'vi-put-before) (define-key vi-com-map "Q" 'vi-quote-words) ; extension (define-key vi-com-map "R" 'vi-replace-chars) (define-key vi-com-map "S" 'vi-substitute-lines) (define-key vi-com-map "T" 'vi-backward-upto-char) (define-key vi-com-map "U" 'vi-unimplemented) (define-key vi-com-map "V" 'vi-undefined) (define-key vi-com-map "W" 'vi-forward-blank-delimited-word) (define-key vi-com-map "X" 'call-last-kbd-macro) ; modification/extension (define-key vi-com-map "Y" 'vi-yank-line) (define-key vi-com-map "Z" (make-sparse-keymap)) ;allow below prefix command (define-key vi-com-map "ZZ" 'vi-save-all-and-exit) (define-key vi-com-map "[" 'vi-unimplemented) (define-key vi-com-map "\\" 'vi-operator) ; extension for vi-narrow-op (define-key vi-com-map "]" 'vi-unimplemented) (define-key vi-com-map "^" 'back-to-indentation) (define-key vi-com-map "_" 'vi-undefined) (define-key vi-com-map "`" 'vi-goto-char-mark) (define-key vi-com-map "a" 'vi-insert-after) (define-key vi-com-map "b" 'backward-word) (define-key vi-com-map "c" 'vi-operator) (define-key vi-com-map "d" 'vi-operator) (define-key vi-com-map "e" 'vi-end-of-word) (define-key vi-com-map "f" 'vi-forward-find-char) (define-key vi-com-map "g" 'vi-beginning-of-buffer) ; extension (define-key vi-com-map "h" 'backward-char) (define-key vi-com-map "i" 'vi-insert-before) (define-key vi-com-map "j" 'vi-next-line) (define-key vi-com-map "k" 'previous-line) (define-key vi-com-map "l" 'forward-char) (define-key vi-com-map "m" 'vi-set-mark) (define-key vi-com-map "n" 'vi-repeat-last-search) (define-key vi-com-map "o" 'vi-open-below) (define-key vi-com-map "p" 'vi-put-after) (define-key vi-com-map "q" 'vi-replace) (define-key vi-com-map "r" 'vi-replace-1-char) (define-key vi-com-map "s" 'vi-substitute-chars) (define-key vi-com-map "t" 'vi-forward-upto-char) (define-key vi-com-map "u" 'undo) (define-key vi-com-map "v" 'vi-verify-spelling) (define-key vi-com-map "w" 'vi-forward-word) (define-key vi-com-map "x" 'vi-kill-char) (define-key vi-com-map "y" 'vi-operator) (define-key vi-com-map "z" 'vi-adjust-window) (define-key vi-com-map "{" 'backward-paragraph) (define-key vi-com-map "|" 'vi-goto-column) (define-key vi-com-map "}" 'forward-paragraph) (define-key vi-com-map "~" 'vi-change-case) (define-key vi-com-map "\177" 'delete-backward-char)) (put 'backward-char 'point-moving-unit 'char) (put 'vi-next-line 'point-moving-unit 'line) (put 'next-line 'point-moving-unit 'line) (put 'forward-line 'point-moving-unit 'line) (put 'previous-line 'point-moving-unit 'line) (put 'vi-isearch-backward 'point-moving-unit 'search) (put 'vi-search-backward 'point-moving-unit 'search) (put 'vi-isearch-forward 'point-moving-unit 'search) (put 'vi-search-forward 'point-moving-unit 'search) (put 'forward-char 'point-moving-unit 'char) (put 'end-of-line 'point-moving-unit 'char) (put 'vi-find-matching-paren 'point-moving-unit 'match) (put 'vi-goto-line-mark 'point-moving-unit 'line) (put 'backward-sexp 'point-moving-unit 'sexp) (put 'forward-sexp 'point-moving-unit 'sexp) (put 'vi-next-line-first-nonwhite 'point-moving-unit 'line) (put 'vi-previous-line-first-nonwhite 'point-moving-unit 'line) (put 'vi-reverse-last-find-char 'point-moving-unit 'rev-find) (put 'vi-re-search-forward 'point-moving-unit 'search) (put 'beginning-of-line 'point-moving-unit 'char) (put 'vi-beginning-of-buffer 'point-moving-unit 'char) (put 'vi-repeat-last-find-char 'point-moving-unit 'find) (put 'vi-re-search-backward 'point-moving-unit 'search) (put 'vi-backward-blank-delimited-word 'point-moving-unit 'WORD) (put 'vi-end-of-blank-delimited-word 'point-moving-unit 'match) (put 'vi-backward-find-char 'point-moving-unit 'find) (put 'vi-goto-line 'point-moving-unit 'line) (put 'vi-home-window-line 'point-moving-unit 'line) (put 'vi-last-window-line 'point-moving-unit 'line) (put 'vi-middle-window-line 'point-moving-unit 'line) (put 'vi-reverse-last-search 'point-moving-unit 'rev-search) (put 'vi-backward-upto-char 'point-moving-unit 'find) (put 'vi-forward-blank-delimited-word 'point-moving-unit 'WORD) (put 'back-to-indentation 'point-moving-unit 'char) (put 'vi-goto-char-mark 'point-moving-unit 'char) (put 'backward-word 'point-moving-unit 'word) (put 'vi-end-of-word 'point-moving-unit 'match) (put 'vi-forward-find-char 'point-moving-unit 'find) (put 'backward-char 'point-moving-unit 'char) (put 'vi-forward-char 'point-moving-unit 'char) (put 'vi-repeat-last-search 'point-moving-unit 'search) (put 'vi-forward-upto-char 'point-moving-unit 'find) (put 'vi-forward-word 'point-moving-unit 'word) (put 'vi-goto-column 'point-moving-unit 'match) (put 'forward-paragraph 'point-moving-unit 'paragraph) (put 'backward-paragraph 'point-moving-unit 'paragraph) ;;; region mark commands (put 'mark-page 'point-moving-unit 'region) (put 'mark-paragraph 'point-moving-unit 'region) (put 'mark-word 'point-moving-unit 'region) (put 'mark-sexp 'point-moving-unit 'region) (put 'mark-defun 'point-moving-unit 'region) (put 'mark-whole-buffer 'point-moving-unit 'region) (put 'mark-end-of-sentence 'point-moving-unit 'region) (put 'mark-c-function 'point-moving-unit 'region) ;;; (defvar vi-mark-alist nil "Alist of (NAME . MARK), marks are local to each buffer.") (defvar vi-scroll-amount (/ (window-height) 2) "Default amount of lines for scrolling (used by \"^D\"/\"^U\").") (defvar vi-shift-width 4 "Shift amount for \"<\"/\">\" operators.") (defvar vi-ins-point nil ; integer "Last insertion point. Should use `mark' instead.") (defvar vi-ins-length nil ; integer "Length of last insertion.") (defvar vi-ins-repetition nil ; integer "The repetition required for last insertion.") (defvar vi-ins-overwrt-p nil ; boolean "T if last insertion was a replace actually.") (defvar vi-ins-prefix-code nil ; ready-to-eval sexp "Code to be eval'ed before (redo-)insertion begins.") (defvar vi-last-find-char nil ; cons cell "Save last direction, char and upto-flag used for char finding.") (defvar vi-last-change-command nil ; cons cell "Save commands for redoing last changes. Each command is in (FUNC . ARGS) form that is ready to be `apply'ed.") (defvar vi-last-shell-command nil ; last shell op command line "Save last shell command given for \"!\" operator.") (defvar vi-insert-state nil ; boolean "Non-nil if it is in insert state.") ; in "loaddefs.el" ;(defvar search-last-string "" ; "Last string search for by a search command.") (defvar vi-search-last-command nil ; (re-)search-forward(backward) "Save last search command for possible redo.") (defvar vi-mode-old-local-map nil "Save the local-map used before entering vi-mode.") (defvar vi-mode-old-mode-name nil "Save the mode-name before entering vi-mode.") (defvar vi-mode-old-major-mode nil "Save the major-mode before entering vi-mode.") (defvar vi-mode-old-case-fold nil) ;(defconst vi-add-to-mode-line-1 ; '(overwrite-mode nil " Insert")) ;; Value is same as vi-add-to-mode-line-1 when in vi mode, ;; but nil in other buffers. ;(defvar vi-add-to-mode-line nil) (defun vi-mode-setup () "Setup a buffer for vi-mode by creating necessary buffer-local variables." ; (make-local-variable 'vi-add-to-mode-line) ; (setq vi-add-to-mode-line vi-add-to-mode-line-1) ; (or (memq vi-add-to-mode-line minor-mode-alist) ; (setq minor-mode-alist (cons vi-add-to-mode-line minor-mode-alist))) (make-local-variable 'vi-scroll-amount) (setq vi-scroll-amount (/ (window-height) 2)) (make-local-variable 'vi-shift-width) (setq vi-shift-width 4) (make-local-variable 'vi-ins-point) (make-local-variable 'vi-ins-length) (make-local-variable 'vi-ins-repetition) (make-local-variable 'vi-ins-overwrt-p) (make-local-variable 'vi-ins-prefix-code) (make-local-variable 'vi-last-change-command) (make-local-variable 'vi-last-shell-command) (make-local-variable 'vi-last-find-char) (make-local-variable 'vi-mark-alist) (make-local-variable 'vi-insert-state) (make-local-variable 'vi-mode-old-local-map) (make-local-variable 'vi-mode-old-mode-name) (make-local-variable 'vi-mode-old-major-mode) (make-local-variable 'vi-mode-old-case-fold) (run-hooks 'vi-mode-hook)) ;;;###autoload (defun vi-mode () "Major mode that acts like the `vi' editor. The purpose of this mode is to provide you the combined power of vi (namely, the \"cross product\" effect of commands and repeat last changes) and Emacs. This command redefines nearly all keys to look like vi commands. It records the previous major mode, and any vi command for input \(`i', `a', `s', etc.) switches back to that mode. Thus, ordinary Emacs (in whatever major mode you had been using) is \"input\" mode as far as vi is concerned. To get back into vi from \"input\" mode, you must issue this command again. Therefore, it is recommended that you assign it to a key. Major differences between this mode and real vi : * Limitations and unsupported features - Search patterns with line offset (e.g. /pat/+3 or /pat/z.) are not supported. - Ex commands are not implemented; try ':' to get some hints. - No line undo (i.e. the 'U' command), but multi-undo is a standard feature. * Modifications - The stopping positions for some point motion commands (word boundary, pattern search) are slightly different from standard 'vi'. Also, no automatic wrap around at end of buffer for pattern searching. - Since changes are done in two steps (deletion then insertion), you need to undo twice to completely undo a change command. But this is not needed for undoing a repeated change command. - No need to set/unset 'magic', to search for a string with regular expr in it just put a prefix arg for the search commands. Replace cmds too. - ^R is bound to incremental backward search, so use ^L to redraw screen. * Extensions - Some standard (or modified) Emacs commands were integrated, such as incremental search, query replace, transpose objects, and keyboard macros. - In command state, ^X links to the 'ctl-x-map', and ESC can be linked to esc-map or set undefined. These can give you the full power of Emacs. - See vi-com-map for those keys that are extensions to standard vi, e.g. `vi-name-last-change-or-macro', `vi-verify-spelling', `vi-locate-def', `vi-mark-region', and 'vi-quote-words'. Some of them are quite handy. - Use \\[vi-switch-mode] to switch among different modes quickly. Syntax table and abbrevs while in vi mode remain as they were in Emacs." (interactive) (if (null vi-mode-old-major-mode) ; very first call for current buffer (vi-mode-setup)) (if (eq major-mode 'vi-mode) (message "Already in vi-mode." (ding)) (setq vi-mode-old-local-map (current-local-map)) (setq vi-mode-old-mode-name mode-name) (setq vi-mode-old-major-mode major-mode) (setq vi-mode-old-case-fold case-fold-search) ; this is needed !! (setq case-fold-search nil) ; exact case match in searching (use-local-map vi-com-map) (setq major-mode 'vi-mode) (setq mode-name "VI") (force-mode-line-update) ; force mode line update (if vi-insert-state ; this is a return from insertion (vi-end-of-insert-state)))) (defun vi-ding() "Ding !" (interactive) (ding)) (defun vi-save-all-and-exit () "Save all modified buffers without asking, then exits emacs." (interactive) (save-some-buffers t) (kill-emacs)) ;; to be used by "ex" commands (defvar vi-replaced-string nil) (defvar vi-replacing-string nil) (defun vi-ex-cmd () "Ex commands are not implemented in Evi mode. For some commonly used ex commands, you can use the following alternatives for similar effect : w C-x C-s (save-buffer) wq C-x C-c (save-buffers-kill-emacs) w fname C-x C-w (write-file) e fname C-x C-f (find-file) r fname C-x i (insert-file) s/old/new use q (vi-replace) to do unconditional replace use C-q (vi-query-replace) to do query replace set sw=n M-x set-variable vi-shift-width n " (interactive) ;; (let ((cmd (read-string ":")) (lines 1)) ;; (cond ((string-match "s")))) (with-output-to-temp-buffer "*Help*" (princ (documentation 'vi-ex-cmd)) (save-excursion (set-buffer standard-output) (help-mode)))) (defun vi-undefined () (interactive) (message "Command key \"%s\" is undefined in Evi." (single-key-description last-command-char)) (ding)) (defun vi-unimplemented () (interactive) (message "Command key \"%s\" is not implemented in Evi." (single-key-description last-command-char)) (ding)) ;;;;; (defun vi-goto-insert-state (repetition &optional prefix-code do-it-now-p) "Go into insert state, the text entered will be repeated if REPETITION > 1. If PREFIX-CODE is given, do it before insertion begins if DO-IT-NOW-P is T. In any case, the prefix-code will be done before each 'redo-insert'. This function expects 'overwrite-mode' being set properly beforehand." (if do-it-now-p (apply (car prefix-code) (cdr prefix-code))) (setq vi-ins-point (point)) (setq vi-ins-repetition repetition) (setq vi-ins-prefix-code prefix-code) (setq mode-name vi-mode-old-mode-name) (setq case-fold-search vi-mode-old-case-fold) (use-local-map vi-mode-old-local-map) (setq major-mode vi-mode-old-major-mode) (force-mode-line-update) (setq vi-insert-state t)) (defun vi-end-of-insert-state () "Terminate insertion and set up last change command." (if (or (< (point) vi-ins-point) ;Check if there is any effective change (and (= (point) vi-ins-point) (null vi-ins-prefix-code)) (<= vi-ins-repetition 0)) (vi-goto-command-state t) (if (> vi-ins-repetition 1) (progn (let ((str (buffer-substring vi-ins-point (point)))) (while (> vi-ins-repetition 1) (insert str) (setq vi-ins-repetition (1- vi-ins-repetition)))))) (vi-set-last-change-command 'vi-first-redo-insertion vi-ins-point (point) overwrite-mode vi-ins-prefix-code) (vi-goto-command-state t))) (defun vi-first-redo-insertion (begin end &optional overwrite-p prefix-code) "Redo last insertion the first time. Extract the string and save it for future redoes. Do prefix-code if it's given, use overwrite mode if asked." (let ((str (buffer-substring begin end))) (if prefix-code (apply (car prefix-code) (cdr prefix-code))) (if overwrite-p (delete-region (point) (+ (point) (length str)))) (insert str) (vi-set-last-change-command 'vi-more-redo-insertion str overwrite-p prefix-code))) (defun vi-more-redo-insertion (str &optional overwrite-p prefix-code) "Redo more insertion : copy string from STR to point, use overwrite mode if overwrite-p is T; apply prefix-code first if it's non-nil." (if prefix-code (apply (car prefix-code) (cdr prefix-code))) (if overwrite-p (delete-region (point) (+ (point) (length str)))) (insert str)) (defun vi-goto-command-state (&optional from-insert-state-p) "Go to vi-mode command state. If optional arg exists, means return from insert state." (use-local-map vi-com-map) (setq vi-insert-state nil) (if from-insert-state-p (if overwrite-mode (overwrite-mode 0) ; (set-minor-mode 'ins "Insert" nil) ))) (defun vi-kill-line (arg) "kill specified number of lines (=d$), text saved in the kill ring." (interactive "*P") (kill-line arg) (vi-set-last-change-command 'kill-line arg)) (defun vi-kill-region (start end) (interactive "*r") (kill-region start end) (vi-set-last-change-command 'kill-region)) (defun vi-append-at-end-of-line (arg) "go to end of line and then go into vi insert state." (interactive "*p") (vi-goto-insert-state arg '(end-of-line) t)) (defun vi-change-rest-of-line (arg) "Change the rest of (ARG) lines (= c$ in vi)." (interactive "*P") (vi-goto-insert-state 1 (list 'kill-line arg) t)) (defun vi-insert-before-first-nonwhite (arg) "(= ^i in vi)" (interactive "*p") (vi-goto-insert-state arg '(back-to-indentation) t)) (defun vi-open-above (arg) "open new line(s) above current line and enter insert state." (interactive "*p") (vi-goto-insert-state 1 (list (function (lambda (x) (or (beginning-of-line) (open-line x)))) arg) t)) (defun vi-open-below (arg) "open new line(s) and go into insert mode on the last line." (interactive "*p") (vi-goto-insert-state 1 (list (function (lambda (x) (or (end-of-line) (open-line x) (forward-line x)))) arg) t)) (defun vi-insert-after (arg) "start vi insert state after cursor." (interactive "*p") (vi-goto-insert-state arg (list (function (lambda () (if (not (eolp)) (forward-char))))) t)) (defun vi-insert-before (arg) "enter insert state before the cursor." (interactive "*p") (vi-goto-insert-state arg)) (defun vi-goto-line (arg) "Go to ARGth line." (interactive "P") (if (null (vi-raw-numeric-prefix arg)) (end-of-buffer) (goto-line (vi-prefix-numeric-value arg)))) (defun vi-beginning-of-buffer () "Move point to the beginning of current buffer." (interactive) (goto-char (point-min))) ;;;;; not used now ;;(defvar regexp-search t ; string ;; "*T if search string can contain regular expressions. (= set magic in vi)") ;;;;; (defun vi-isearch-forward (arg) "Incremental search forward. Use regexp version if ARG is non-nil." (interactive "P") (let ((scmd (if arg 'isearch-forward-regexp 'isearch-forward)) (opoint (point))) (call-interactively scmd) (if (= opoint (point)) nil (setq vi-search-last-command (if arg 're-search-forward 'search-forward))))) (defun vi-isearch-backward (arg) "Incremental search backward. Use regexp version if ARG is non-nil." (interactive "P") (let ((scmd (if arg 'isearch-backward-regexp 'isearch-backward)) (opoint (point))) (call-interactively scmd) (if (= opoint (point)) nil (setq vi-search-last-command (if arg 're-search-backward 'search-backward))))) (defun vi-search-forward (arg string) "Nonincremental search forward. Use regexp version if ARG is non-nil." (interactive (if current-prefix-arg (list t (read-string "regexp/" nil)) (list nil (read-string "/" nil)))) (setq vi-search-last-command (if arg 're-search-forward 'search-forward)) (if (> (length string) 0) (setq search-last-string string)) (funcall vi-search-last-command search-last-string nil nil 1)) (defun vi-search-backward (arg string) "Nonincremental search backward. Use regexp version if ARG is non-nil." (interactive (if current-prefix-arg (list t (read-string "regexp?" nil)) (list nil (read-string "?" nil)))) (setq vi-search-last-command (if arg 're-search-backward 'search-backward)) (if (> (length string) 0) (setq search-last-string string)) (funcall vi-search-last-command search-last-string nil nil 1)) (defun vi-repeat-last-search (arg &optional search-command search-string) "Repeat last search command. If optional search-command/string are given, use those instead of the ones saved." (interactive "p") (if (null search-command) (setq search-command vi-search-last-command)) (if (null search-string) (setq search-string search-last-string)) (if (null search-command) (message "No last search command to repeat." (ding)) (funcall search-command search-string nil nil arg))) (defun vi-reverse-last-search (arg &optional search-command search-string) "Redo last search command in reverse direction. If the optional search args are given, use those instead of the ones saved." (interactive "p") (if (null search-command) (setq search-command vi-search-last-command)) (if (null search-string) (setq search-string search-last-string)) (if (null search-command) (message "No last search command to repeat." (ding)) (funcall (cond ((eq search-command 're-search-forward) 're-search-backward) ((eq search-command 're-search-backward) 're-search-forward) ((eq search-command 'search-forward) 'search-backward) ((eq search-command 'search-backward) 'search-forward)) search-string nil nil arg))) (defun vi-join-lines (arg) "join ARG lines from current line (default 2), cleaning up white space." (interactive "P") (if (null (vi-raw-numeric-prefix arg)) (delete-indentation t) (setq count (vi-prefix-numeric-value arg)) (while (>= count 2) (delete-indentation t) (setq count (1- count)))) (vi-set-last-change-command 'vi-join-lines arg)) (defun vi-backward-kill-line () "kill the current line. Only works in insert state." (interactive) (if (not vi-insert-state) nil (beginning-of-line 1) (kill-line nil))) (defun vi-abort-ins () "abort insert state, kill inserted text and go back to command state." (interactive) (if (not vi-insert-state) nil (if (> (point) vi-ins-point) (kill-region vi-ins-point (point))) (vi-goto-command-state t))) (defun vi-backward-windowfull (count) "Backward COUNT windowfulls. Default is one." (interactive "p") ; (set-mark-command nil) (while (> count 0) (scroll-down nil) (setq count (1- count)))) (defun vi-scroll-down-window (count) "Scrolls down window COUNT lines. If COUNT is nil (actually, non-integer), scrolls default amount. The given COUNT is remembered for future scrollings." (interactive "P") (if (integerp count) (setq vi-scroll-amount count)) (scroll-up vi-scroll-amount)) (defun vi-expose-line-below (count) "Expose COUNT more lines below the current window. Default COUNT is 1." (interactive "p") (scroll-up count)) (defun vi-forward-windowfull (count) "Forward COUNT windowfulls. Default is one." (interactive "p") ; (set-mark-command nil) (while (> count 0) (scroll-up nil) (setq count (1- count)))) (defun vi-next-line (count) "Go down count lines, try to keep at the same column." (interactive "p") (setq this-command 'next-line) ; this is a needed trick (if (= (point) (or (line-move count) (point))) (ding) ; no moving, already at end of buffer (setq last-command 'next-line))) (defun vi-next-line-first-nonwhite (count) "Go down COUNT lines. Stop at first non-white." (interactive "p") (if (= (point) (progn (forward-line count) (back-to-indentation) (point))) (ding))) ; no moving, already at end of buffer (defun vi-previous-line-first-nonwhite (count) "Go up COUNT lines. Stop at first non-white." (interactive "p") (previous-line count) (back-to-indentation)) (defun vi-scroll-up-window (count) "Scrolls up window COUNT lines. If COUNT is nil (actually, non-integer), scrolls default amount. The given COUNT is remembered for future scrollings." (interactive "P") (if (integerp count) (setq vi-scroll-amount count)) (scroll-down vi-scroll-amount)) (defun vi-expose-line-above (count) "Expose COUNT more lines above the current window. Default COUNT is 1." (interactive "p") (scroll-down count)) (defun vi-char-argument (arg) "Get following character (could be any CHAR) as part of the prefix argument. Possible prefix-arg cases are NIL, INTEGER, (NIL . CHAR) or (INTEGER . CHAR)." (interactive "P") (let ((char (read-char))) (cond ((null arg) (setq prefix-arg (cons nil char))) ((integerp arg) (setq prefix-arg (cons arg char))) ; This can happen only if the user changed his/her mind for CHAR, ; Or there are some leading "universal-argument"s (t (setq prefix-arg (cons (car arg) char)))))) (defun vi-goto-mark (mark-char &optional line-flag) "Go to marked position or line (if line-flag is given). Goto mark '@' means jump into and pop the top mark on the mark ring." (cond ((char-equal mark-char last-command-char) ; `` or '' (exchange-point-and-mark) (if line-flag (back-to-indentation))) ((char-equal mark-char ?@) ; jump and pop mark (set-mark-command t) (if line-flag (back-to-indentation))) (t (let ((mark (vi-get-mark mark-char))) (if (null mark) (message "Mark register undefined." (vi-ding)) (set-mark-command nil) (goto-char mark) (if line-flag (back-to-indentation))))))) (defun vi-goto-line-mark (char) "Go to the line (at first non-white) marked by next char." (interactive "c") (vi-goto-mark char t)) (defun vi-goto-char-mark (char) "Go to the char position marked by next mark-char." (interactive "c") (vi-goto-mark char)) (defun vi-digit-argument (arg) "Set numeric prefix argument." (interactive "P") (cond ((null arg) (digit-argument arg)) ((integerp arg) (digit-argument nil) (setq prefix-arg (* prefix-arg arg))) (t (digit-argument nil) ; in (NIL . CHAR) or (NUM . CHAR) form (setq prefix-arg (cons (* prefix-arg (if (null (car arg)) 1 (car arg))) (cdr arg)))))) (defun vi-raw-numeric-prefix (arg) "Return the raw value of numeric part prefix argument." (if (consp arg) (car arg) arg)) (defun vi-prefix-numeric-value (arg) "Return numeric meaning of the raw prefix argument. This is a modification to the standard one provided in `callint.c' to handle (_ . CHAR) cases." (cond ((null arg) 1) ((integerp arg) arg) ((consp arg) (if (car arg) (car arg) 1)))) (defun vi-reverse-last-find-char (count &optional find-arg) "Reverse last f F t T operation COUNT times. If the optional FIND-ARG is given, it is used instead of the saved one." (interactive "p") (if (null find-arg) (setq find-arg vi-last-find-char)) (if (null find-arg) (message "No last find char to repeat." (ding)) (vi-find-char (cons (* (car find-arg) -1) (cdr find-arg)) count))) ;6/13/86 (defun vi-find-char (arg count) "Find in DIRECTION (1/-1) for CHAR of COUNT'th times on current line. If UPTO-FLAG is T, stop before the char. ARG = (DIRECTION.CHAR.UPTO-FLAG." (let* ((direction (car arg)) (char (car (cdr arg))) (upto-flag (cdr (cdr arg))) (pos (+ (point) direction))) (if (catch 'exit-find-char (while t (cond ((null (char-after pos)) (throw 'exit-find-char nil)) ((char-equal (char-after pos) ?\n) (throw 'exit-find-char nil)) ((char-equal char (char-after pos)) (setq count (1- count)) (if (= count 0) (throw 'exit-find-char (if upto-flag (setq pos (- pos direction)) pos))))) (setq pos (+ pos direction)))) (goto-char pos) (ding)))) (defun vi-repeat-last-find-char (count &optional find-arg) "Repeat last f F t T operation COUNT times. If optional FIND-ARG is given, it is used instead of the saved one." (interactive "p") (if (null find-arg) (setq find-arg vi-last-find-char)) (if (null find-arg) (message "No last find char to repeat." (ding)) (vi-find-char find-arg count))) (defun vi-backward-find-char (count char) "Find the COUNT'th CHAR backward on current line." (interactive "p\nc") (setq vi-last-find-char (cons -1 (cons char nil))) (vi-repeat-last-find-char count)) (defun vi-forward-find-char (count char) "Find the COUNT'th CHAR forward on current line." (interactive "p\nc") (setq vi-last-find-char (cons 1 (cons char nil))) (vi-repeat-last-find-char count)) (defun vi-backward-upto-char (count char) "Find upto the COUNT'th CHAR backward on current line." (interactive "p\nc") (setq vi-last-find-char (cons -1 (cons char t))) (vi-repeat-last-find-char count)) (defun vi-forward-upto-char (count char) "Find upto the COUNT'th CHAR forward on current line." (interactive "p\nc") (setq vi-last-find-char (cons 1 (cons char t))) (vi-repeat-last-find-char count)) (defun vi-end-of-word (count) "Move forward until encountering the end of a word. With argument, do this that many times." (interactive "p") (if (not (eobp)) (forward-char)) (if (re-search-forward "\\W*\\w+\\>" nil t count) (backward-char))) (defun vi-replace-1-char (count char) "Replace char after point by CHAR. Repeat COUNT times." (interactive "p\nc") (delete-char count nil) ; don't save in kill ring (setq last-command-char char) (self-insert-command count) (vi-set-last-change-command 'vi-replace-1-char count char)) (defun vi-replace-chars (arg) "Replace chars over old ones." (interactive "*p") (overwrite-mode 1) (vi-goto-insert-state arg)) (defun vi-substitute-chars (count) "Substitute COUNT chars by the input chars, enter insert state." (interactive "*p") (vi-goto-insert-state 1 (list (function (lambda (c) ; this is a bit tricky (delete-region (point) (+ (point) c)))) count) t)) (defun vi-substitute-lines (count) "Substitute COUNT lines by the input chars. (=cc in vi)" (interactive "*p") (vi-goto-insert-state 1 (list 'vi-delete-op 'next-line (1- count)) t)) (defun vi-prefix-char-value (arg) "Get the char part of the current prefix argument." (cond ((null arg) nil) ((integerp arg) nil) ((consp arg) (cdr arg)) (t nil))) (defun vi-operator (arg) "Handling vi operators (d/c//!/=/y). Current implementation requires the key bindings of the operators being fixed." (interactive "P") (catch 'vi-exit-op (let ((this-op-char last-command-char)) (setq last-command-char (read-char)) (setq this-command (lookup-key vi-com-map (char-to-string last-command-char))) (if (not (eq this-command 'vi-digit-argument)) (setq prefix-arg arg) (vi-digit-argument arg) (setq last-command-char (read-char)) (setq this-command (lookup-key vi-com-map (char-to-string last-command-char)))) (cond ((char-equal this-op-char last-command-char) ; line op (vi-execute-op this-op-char 'next-line (cons (1- (vi-prefix-numeric-value prefix-arg)) (vi-prefix-char-value prefix-arg)))) ;; We assume any command that has no property 'point-moving-unit' ;; as having that property with the value 'CHAR'. 3/12/86 (t ;; (get this-command 'point-moving-unit) (vi-execute-op this-op-char this-command prefix-arg)))))) ;; (t (throw 'vi-exit-op (ding))))))) (defun vi-execute-op (op-char motion-command arg) "Execute vi edit operator as specified by OP-CHAR, the operand is the region determined by the MOTION-COMMAND with ARG." (cond ((= op-char ?d) (if (vi-delete-op motion-command arg) (vi-set-last-change-command 'vi-delete-op (vi-repeat-command-of motion-command) arg))) ((= op-char ?c) (if (vi-delete-op motion-command arg) (vi-goto-insert-state 1 (list 'vi-delete-op (vi-repeat-command-of motion-command) arg) nil))) ((= op-char ?y) (if (vi-yank-op motion-command arg) (vi-set-last-change-command 'vi-yank-op (vi-repeat-command-of motion-command) arg))) ((= op-char ?!) (if (vi-shell-op motion-command arg) (vi-set-last-change-command 'vi-shell-op (vi-repeat-command-of motion-command) arg vi-last-shell-command))) ((= op-char ?<) (if (vi-shift-op motion-command arg (- vi-shift-width)) (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg (- vi-shift-width)))) ((= op-char ?>) (if (vi-shift-op motion-command arg vi-shift-width) (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg vi-shift-width))) ((= op-char ?=) (if (vi-indent-op motion-command arg) (vi-set-last-change-command 'vi-indent-op (vi-repeat-command-of motion-command) arg))) ((= op-char ?\\) (vi-narrow-op motion-command arg)))) (defun vi-repeat-command-of (command) "Return the command for redo the given command." (let ((cmd-type (get command 'point-moving-unit))) (cond ((eq cmd-type 'search) 'vi-repeat-last-search) ((eq cmd-type 'find) 'vi-repeat-last-find-char) (t command)))) (defun vi-effective-range (motion-command arg) "Return (begin . end) of the range spanned by executing the given MOTION-COMMAND with ARG. MOTION-COMMAND in ready-to-eval list form is not yet supported." (save-excursion (let ((begin (point)) end opoint (moving-unit (get motion-command 'point-moving-unit))) (setq prefix-arg arg) (setq opoint (point)) (command-execute motion-command nil) ;; Check if there is any effective motion. Note that for single line operation ;; the motion-command causes no effective point movement (since it moves up or ;; down zero lines), but it should be counted as effectively moved. (if (and (= (point) opoint) (not (eq moving-unit 'line))) (cons opoint opoint) ; no effective motion (if (eq moving-unit 'region) (setq begin (or (mark) (point)))) (if (<= begin (point)) (setq end (point)) (setq end begin) (setq begin (point))) (cond ((or (eq moving-unit 'match) (eq moving-unit 'find)) (setq end (1+ end))) ((eq moving-unit 'line) (goto-char begin) (beginning-of-line) (setq begin (point)) (goto-char end) (next-line 1) (beginning-of-line) (setq end (point)))) (if (> end (point-max)) (setq end (point-max))) ; force in buffer region (cons begin end))))) (defun vi-delete-op (motion-command arg) "Delete range specified by MOTION-COMMAND with ARG." (let* ((range (vi-effective-range motion-command arg)) (begin (car range)) (end (cdr range)) reg) (if (= begin end) nil ; point not moved, abort op (setq reg (vi-prefix-char-value arg)) (if (null reg) (kill-region begin end) ; kill ring as unnamed registers (if (and (>= reg ?A) (<= reg ?Z)) (append-to-register (downcase reg) begin end t) (copy-to-register reg begin end t))) t))) (defun vi-yank-op (motion-command arg) "Yank (in vi sense) range specified by MOTION-COMMAND with ARG." (let* ((range (vi-effective-range motion-command arg)) (begin (car range)) (end (cdr range)) reg) (if (= begin end) nil ; point not moved, abort op (setq reg (vi-prefix-char-value arg)) (if (null reg) (copy-region-as-kill begin end); kill ring as unnamed registers (if (and (>= reg ?A) (<= reg ?Z)) (append-to-register (downcase reg) begin end nil) (copy-to-register reg begin end nil))) t))) (defun vi-yank-line (arg) "Yank (in vi sense) lines (= `yy' command)." (interactive "*P") (setq arg (cons (1- (vi-prefix-numeric-value arg)) (vi-prefix-char-value arg))) (if (vi-yank-op 'next-line arg) (vi-set-last-change-command 'vi-yank-op 'next-line arg))) (defun vi-string-end-with-nl-p (string) "See if STRING ends with a newline char. Used in checking whether the yanked text should be put back as lines or not." (= (aref string (1- (length string))) ?\n)) (defun vi-put-before (arg &optional after-p) "Put yanked (in vi sense) text back before/above cursor. If a numeric prefix value (currently it should be >1) is given, put back text as lines. If the optional after-p is given, put after/below the cursor." (interactive "P") (let ((reg (vi-prefix-char-value arg)) put-text) (if (and reg (or (< reg ?1) (> reg ?9)) (null (get-register reg))) (error "Nothing in register %c" reg) (if (null reg) (setq reg ?1)) ; the default is the last text killed (setq put-text (cond ((and (>= reg ?1) (<= reg ?9)) (setq this-command 'yank) ; So we may yank-pop !! (current-kill (- reg ?0 1) 'do-not-rotate)) ((stringp (get-register reg)) (get-register reg)) (t (error "Register %c is not containing text string" reg)))) (if (vi-string-end-with-nl-p put-text) ; put back text as lines (if after-p (progn (next-line 1) (beginning-of-line)) (beginning-of-line)) (if after-p (forward-char 1))) (push-mark (point)) (insert put-text) (exchange-point-and-mark) ;; (back-to-indentation) ; this is not allowed if we allow yank-pop (vi-set-last-change-command 'vi-put-before arg after-p)))) (defun vi-put-after (arg) "Put yanked (in vi sense) text back after/below cursor." (interactive "P") (vi-put-before arg t)) (defun vi-shell-op (motion-command arg &optional shell-command) "Perform shell command (as filter). Performs command on range specified by MOTION-COMMAND with ARG. If SHELL-COMMAND is not given, ask for one from minibuffer. If char argument is given, it directs the output to a *temp* buffer." (let* ((range (vi-effective-range motion-command arg)) (begin (car range)) (end (cdr range))) (if (= begin end) nil ; point not moved, abort op (cond ((null shell-command) (setq shell-command (read-string "!" nil)) (setq vi-last-shell-command shell-command))) (shell-command-on-region begin end shell-command (not (vi-prefix-char-value arg))) t))) (defun vi-shift-op (motion-command arg amount) "Perform shift command on range specified by MOTION-COMMAND with ARG for AMOUNT on each line. Negative amount means shift left. SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)." (let* ((range (vi-effective-range motion-command arg)) (begin (car range)) (end (cdr range))) (if (= begin end) nil ; point not moved, abort op (if (vi-prefix-char-value arg) (setq amount (if (> amount 0) (- (vi-prefix-char-value arg) ?0) (- ?0 (vi-prefix-char-value arg))))) (indent-rigidly begin end amount) t))) (defun vi-indent-op (motion-command arg) "Perform indent command on range specified by MOTION-COMMAND with ARG." (let* ((range (vi-effective-range motion-command arg)) (begin (car range)) (end (cdr range))) (if (= begin end) nil ; point not moved, abort op (indent-region begin end nil) ; insert TAB as indent command t))) (defun vi-narrow-op (motion-command arg) "Narrow to region specified by MOTION-COMMAND with ARG." (let* ((range (vi-effective-range motion-command arg)) (begin (car range)) (end (cdr range)) reg) (if (= begin end) nil ; point not moved, abort op (narrow-to-region begin end)))) (defun vi-get-mark (char) "Return contents of vi mark register named CHAR, or nil if undefined." (cdr (assq char vi-mark-alist))) (defun vi-set-mark (char) "Set contents of vi mark register named CHAR to current point. '@' is the special anonymous mark register." (interactive "c") (if (char-equal char ?@) (set-mark-command nil) (let ((aelt (assq char vi-mark-alist))) (if aelt (move-marker (cdr aelt) (point)) ; fixed 6/12/86 (setq aelt (cons char (copy-marker (point)))) (setq vi-mark-alist (cons aelt vi-mark-alist)))))) (defun vi-find-matching-paren () "Locate the matching paren. It's a hack right now." (interactive) (cond ((looking-at "[[({]") (forward-sexp 1) (backward-char 1)) ((looking-at "[])}]") (forward-char 1) (backward-sexp 1)) (t (ding)))) (defun vi-backward-blank-delimited-word (count) "Backward COUNT blank-delimited words." (interactive "p") (if (re-search-backward "[ \t\n\`][^ \t\n\`]+" nil t count) (if (not (bobp)) (forward-char 1)))) (defun vi-forward-blank-delimited-word (count) "Forward COUNT blank-delimited words." (interactive "p") (if (re-search-forward "[^ \t\n]*[ \t\n]+[^ \t\n]" nil t count) (if (not (eobp)) (backward-char 1)))) (defun vi-end-of-blank-delimited-word (count) "Forward to the end of the COUNT'th blank-delimited word." (interactive "p") (if (re-search-forward "[^ \t\n\']+[ \t\n\']" nil t count) (if (not (eobp)) (backward-char 2)))) (defun vi-home-window-line (arg) "To window home or arg'th line from the top of the window." (interactive "p") (move-to-window-line (1- arg)) (back-to-indentation)) (defun vi-last-window-line (arg) "To window last line or arg'th line from the bottom of the window." (interactive "p") (move-to-window-line (- arg)) (back-to-indentation)) (defun vi-middle-window-line () "To the middle line of the window." (interactive) (move-to-window-line nil) (back-to-indentation)) (defun vi-forward-word (count) "Stop at the beginning of the COUNT'th words from point." (interactive "p") (if (re-search-forward "\\w*\\W+\\<" nil t count) t (vi-ding))) (defun vi-set-last-change-command (fun &rest args) "Set (FUN . ARGS) as the `last-change-command'." (setq vi-last-change-command (cons fun args))) (defun vi-redo-last-change-command (count &optional command) "Redo last change command COUNT times. If the optional COMMAND is given, it is used instead of the current `last-change-command'." (interactive "p") (if (null command) (setq command vi-last-change-command)) (if (null command) (message "No last change command available.") (while (> count 0) (apply (car command) (cdr command)) (setq count (1- count))))) (defun vi-kill-char (count) "Kill COUNT chars from current point." (interactive "*p") (delete-char count t) ; save in kill ring (vi-set-last-change-command 'delete-char count t)) (defun vi-transpose-objects (arg unit) "Transpose objects. The following char specifies unit of objects to be transposed -- \"c\" for chars, \"l\" for lines, \"w\" for words, \"s\" for sexp, \"p\" for paragraph. For the use of the prefix-arg, refer to individual functions called." (interactive "*P\nc") (if (char-equal unit ??) (progn (message "Transpose: c(har), l(ine), p(aragraph), s(-exp), w(ord),") (setq unit (read-char)))) (vi-set-last-change-command 'vi-transpose-objects arg unit) (cond ((char-equal unit ?c) (transpose-chars arg)) ((char-equal unit ?l) (transpose-lines (vi-prefix-numeric-value arg))) ((char-equal unit ?p) (transpose-paragraphs (vi-prefix-numeric-value arg))) ((char-equal unit ?s) (transpose-sexps (vi-prefix-numeric-value arg))) ((char-equal unit ?w) (transpose-words (vi-prefix-numeric-value arg))) (t (vi-transpose-objects arg ??)))) (defun vi-query-replace (arg) "Query replace, use regexp version if ARG is non-nil." (interactive "*P") (let ((rcmd (if arg 'query-replace-regexp 'query-replace))) (call-interactively rcmd nil))) (defun vi-replace (arg) "Replace strings, use regexp version if ARG is non-nil." (interactive "*P") (let ((rcmd (if arg 'replace-regexp 'replace-string))) (call-interactively rcmd nil))) (defun vi-adjust-window (arg position) "Move current line to the top/center/bottom of the window." (interactive "p\nc") (cond ((char-equal position ?\r) (recenter 0)) ((char-equal position ?-) (recenter -1)) ((char-equal position ?.) (recenter (/ (window-height) 2))) (t (message "Move current line to: \\r(top) -(bottom) .(middle)") (setq position (read-char)) (vi-adjust-window arg position)))) (defun vi-goto-column (col) "Go to given column of the current line." (interactive "p") (let ((opoint (point))) (beginning-of-line) (while (> col 1) (if (eolp) (setq col 0) (forward-char 1) (setq col (1- col)))) (if (= col 1) t (goto-char opoint) (ding)))) (defun vi-name-last-change-or-macro (arg char) "Give name to the last change command or just defined kbd macro. If prefix ARG is given, name last macro, otherwise name last change command. The following CHAR will be the name for the command or macro." (interactive "P\nc") (if arg (name-last-kbd-macro (intern (char-to-string char))) (if (eq (car vi-last-change-command) 'vi-first-redo-insertion) (let* ((args (cdr vi-last-change-command)) ; save the insertion text (str (buffer-substring (nth 0 args) (nth 1 args))) (overwrite-p (nth 2 args)) (prefix-code (nth 3 args))) (vi-set-last-change-command 'vi-more-redo-insertion str overwrite-p prefix-code))) (fset (intern (char-to-string char)) vi-last-change-command))) (defun vi-call-named-change-or-macro (count char) "Execute COUNT times the keyboard macro definition named by the following CHAR." (interactive "p\nc") (if (stringp (symbol-function (intern (char-to-string char)))) (execute-kbd-macro (intern (char-to-string char)) count) (vi-redo-last-change-command count (symbol-function (intern (char-to-string char)))))) (defun vi-change-case (arg) ; could be made as an operator ? "Change the case of the char after point." (interactive "*p") (catch 'exit (if (looking-at "[a-z]") (upcase-region (point) (+ (point) arg)) (if (looking-at "[A-Z]") (downcase-region (point) (+ (point) arg)) (ding) (throw 'exit nil))) (vi-set-last-change-command 'vi-change-case arg) ;should avoid redundant save (forward-char arg))) (defun vi-ask-for-info (char) "Inquire status info. The next CHAR will specify the particular info requested." (interactive "c") (cond ((char-equal char ?l) (what-line)) ((char-equal char ?c) (what-cursor-position)) ((char-equal char ?p) (what-page)) (t (message "Ask for: l(ine number), c(ursor position), p(age number)") (setq char (read-char)) (vi-ask-for-info char)))) (defun vi-mark-region (arg region) "Mark region appropriately. The next char REGION is d(efun),s(-exp),b(uffer), p(aragraph), P(age), f(unction in C/Pascal etc.), w(ord), e(nd of sentence), l(ines)." (interactive "p\nc") (cond ((char-equal region ?d) (mark-defun)) ((char-equal region ?s) (mark-sexp arg)) ((char-equal region ?b) (mark-whole-buffer)) ((char-equal region ?p) (mark-paragraph)) ((char-equal region ?P) (mark-page arg)) ((char-equal region ?f) (mark-c-function)) ((char-equal region ?w) (mark-word arg)) ((char-equal region ?e) (mark-end-of-sentence arg)) ((char-equal region ?l) (vi-mark-lines arg)) (t (message "Mark: d(efun),s(-exp),b(uf),p(arag),P(age),f(unct),w(ord),e(os),l(ines)") (setq region (read-char)) (vi-mark-region arg region)))) (defun vi-mark-lines (num) "Mark NUM of lines from current line as current region." (beginning-of-line 1) (push-mark) (end-of-line num)) (defun vi-verify-spelling (arg unit) "Verify spelling for the objects specified by char UNIT : [b(uffer), r(egion), s(tring), w(ord) ]." (interactive "P\nc") (setq prefix-arg arg) ; seems not needed (cond ((char-equal unit ?b) (call-interactively 'spell-buffer)) ((char-equal unit ?r) (call-interactively 'spell-region)) ((char-equal unit ?s) (call-interactively 'spell-string)) ((char-equal unit ?w) (call-interactively 'spell-word)) (t (message "Spell check: b(uffer), r(egion), s(tring), w(ord)") (setq unit (read-char)) (vi-verify-spelling arg unit)))) (defun vi-do-old-mode-C-c-command (arg) "This is a hack for accessing mode specific C-c commands in vi-mode." (interactive "P") (let ((cmd (lookup-key vi-mode-old-local-map (concat "\C-c" (char-to-string (read-char)))))) (if (catch 'exit-vi-mode ; kludge hack due to dynamic binding ; of case-fold-search (if (null cmd) (progn (ding) nil) (let ((case-fold-search vi-mode-old-case-fold)) ; a hack (setq prefix-arg arg) (command-execute cmd nil) nil))) (progn (vi-back-to-old-mode) (setq prefix-arg arg) (command-execute cmd nil))))) (defun vi-quote-words (arg char) "Quote ARG words from the word point is on with pattern specified by CHAR. Currently, CHAR could be [,{,(,\",',`,<,*, etc." (interactive "*p\nc") (while (not (string-match "[[({<\"'`*]" (char-to-string char))) (message "Enter any of [,{,(,<,\",',`,* as quoting character.") (setq char (read-char))) (vi-set-last-change-command 'vi-quote-words arg char) (if (not (looking-at "\\<")) (forward-word -1)) (insert char) (cond ((char-equal char ?[) (setq char ?])) ((char-equal char ?{) (setq char ?})) ((char-equal char ?<) (setq char ?>)) ((char-equal char ?() (setq char ?))) ((char-equal char ?`) (setq char ?'))) (vi-end-of-word arg) (forward-char 1) (insert char)) (defun vi-locate-def () "Locate definition in current file for the name before the point. It assumes a `(def..' always starts at the beginning of a line." (interactive) (let (name) (save-excursion (setq name (buffer-substring (progn (vi-backward-blank-delimited-word 1) (skip-chars-forward "^a-zA-Z") (point)) (progn (vi-end-of-blank-delimited-word 1) (forward-char) (skip-chars-backward "^a-zA-Z") (point))))) (set-mark-command nil) (goto-char (point-min)) (if (re-search-forward (concat "^(def[unvarconst ]*" name) nil t) nil (message "No definition for \"%s\" in current file." name (ding)) (set-mark-command t)))) (defun vi-split-open-line (arg) "Insert a newline and leave point before it. With ARG, inserts that many newlines." (interactive "*p") (vi-goto-insert-state 1 (list (function (lambda (arg) (let ((flag (and (bolp) (not (bobp))))) (if flag (forward-char -1)) (while (> arg 0) (save-excursion (insert ?\n) (if fill-prefix (insert fill-prefix))) (setq arg (1- arg))) (if flag (forward-char 1))))) arg) t)) ;;; vi.el ends here emacs-19.30/lisp/view.el100444 12120 1 41633 6055450137 13377 0ustar rmsdaemon;;; view.el --- peruse file or buffer without editing. ;; Copyright (C) 1985, 1989, 1994, 1995 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF ;; 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 package provides the `view' minor mode documented in the Emacs ;; user's manual. ;;; Code: ;;;###autoload (defvar view-highlight-face 'highlight "*The overlay face used for highlighting the match found by View mode search.") (defvar view-mode nil "Non-nil if View mode is enabled.") (make-variable-buffer-local 'view-mode) (defvar view-mode-auto-exit nil "Non-nil means scrolling past the end of buffer exits View mode.") (make-variable-buffer-local 'view-mode-auto-exit) (defvar view-old-buffer-read-only nil) (make-variable-buffer-local 'view-old-buffer-read-only) (defvar view-old-Helper-return-blurb) (make-variable-buffer-local 'view-old-Helper-return-blurb) (defvar view-scroll-size nil) (make-variable-buffer-local 'view-scroll-size) (defvar view-last-regexp nil) (make-variable-buffer-local 'view-last-regexp) (defvar view-exit-action nil) (make-variable-buffer-local 'view-exit-action) (defvar view-return-here nil) (make-variable-buffer-local 'view-return-here) (defvar view-exit-position nil) (make-variable-buffer-local 'view-exit-position) (defvar view-overlay nil "Overlay used to display where a search operation found its match. This is local in each buffer, once it is used.") (make-variable-buffer-local 'view-overlay) (or (assq 'view-mode minor-mode-alist) (setq minor-mode-alist (cons '(view-mode " View") minor-mode-alist))) (defvar view-mode-map nil) (if view-mode-map nil (setq view-mode-map (make-keymap)) (suppress-keymap view-mode-map) (define-key view-mode-map "q" 'view-exit) (define-key view-mode-map "<" 'beginning-of-buffer) (define-key view-mode-map ">" 'end-of-buffer) (define-key view-mode-map "\ev" 'View-scroll-lines-backward) (define-key view-mode-map "\C-v" 'View-scroll-lines-forward) (define-key view-mode-map " " 'View-scroll-lines-forward) (define-key view-mode-map "\C-?" 'View-scroll-lines-backward) (define-key view-mode-map "\n" 'View-scroll-one-more-line) (define-key view-mode-map "\r" 'View-scroll-one-more-line) (define-key view-mode-map "z" 'View-scroll-lines-forward-set-scroll-size) (define-key view-mode-map "g" 'View-goto-line) (define-key view-mode-map "=" 'what-line) (define-key view-mode-map "." 'set-mark-command) (define-key view-mode-map "'" 'View-back-to-mark) (define-key view-mode-map "@" 'View-back-to-mark) (define-key view-mode-map "x" 'exchange-point-and-mark) (define-key view-mode-map "h" 'describe-mode) (define-key view-mode-map "?" 'describe-mode) (define-key view-mode-map "s" 'isearch-forward) (define-key view-mode-map "r" 'isearch-backward) (define-key view-mode-map "/" 'View-search-regexp-forward) (define-key view-mode-map "\\" 'View-search-regexp-backward) ;; This conflicts with the standard binding of isearch-regexp-forward (define-key view-mode-map "\e\C-s" 'View-search-regexp-forward) (define-key view-mode-map "\e\C-r" 'View-search-regexp-backward) (define-key view-mode-map "n" 'View-search-last-regexp-forward) (define-key view-mode-map "p" 'View-search-last-regexp-backward) ) (or (assq 'view-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'view-mode view-mode-map) minor-mode-map-alist))) ;;;###autoload (defun view-file (file-name) "View FILE in View mode, returning to previous buffer when done. 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. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-mode-hook'." (interactive "fView file: ") (let ((old-buf (current-buffer)) (had-a-buf (get-file-buffer file-name)) (buf-to-view (find-file-noselect file-name))) ;; This used to pass t as second argument, ;; but then the buffer did not show up in the Buffers menu. (switch-to-buffer buf-to-view had-a-buf) (view-mode-enter old-buf (and (not had-a-buf) (not (buffer-modified-p buf-to-view)) 'kill-buffer)))) ;;;###autoload (defun view-file-other-window (file-name) "View FILE in View mode in other window. Return to previous buffer when done. 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. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-mode-hook'." (interactive "fView file: ") (let ((old-arrangement (current-window-configuration)) (had-a-buf (get-file-buffer file-name)) (buf-to-view (find-file-noselect file-name))) (switch-to-buffer-other-window buf-to-view) (view-mode-enter old-arrangement (and (not had-a-buf) (not (buffer-modified-p buf-to-view)) 'kill-buffer)))) ;;;###autoload (defun view-buffer (buffer-name) "View BUFFER in View mode, returning to previous buffer when done. 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. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-mode-hook'." (interactive "bView buffer: ") (let ((old-buf (current-buffer))) (switch-to-buffer buffer-name t) (view-mode-enter old-buf nil))) ;;;###autoload (defun view-buffer-other-window (buffer-name not-return) "View BUFFER in View mode in another window. Return to previous buffer when done, unless NOT-RETURN is non-nil. 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. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-mode-hook'." (interactive "bView buffer:\nP") (let ((return-to (and not-return (current-window-configuration)))) (switch-to-buffer-other-window buffer-name) (view-mode-enter return-to))) ;;;###autoload (defun view-mode (&optional arg) "Toggle View mode. If you use this function to turn on View mode, \"exiting\" View mode does nothing except turn View mode off. The other way to turn View mode on is by calling `view-mode-enter'. Letters do not insert themselves. Instead these commands are provided. Most commands take prefix arguments. Commands dealing with lines default to \"scroll size\" lines (initially size of window). Search commands default to a repeat count of one. M-< or < move to beginning of buffer. M-> or > move to end of buffer. C-v or Space scroll forward lines. M-v or DEL scroll backward lines. CR or LF scroll forward one line (backward with prefix argument). z like Space except set number of lines for further scrolling commands to scroll by. C-u and Digits provide prefix arguments. `-' denotes negative argument. = prints the current line number. g goes to line given by prefix argument. / or M-C-s searches forward for regular expression \\ or M-C-r searches backward for regular expression. n searches forward for last regular expression. p searches backward for last regular expression. C-@ or . set the mark. x exchanges point and mark. C-s or s do forward incremental search. C-r or r do reverse incremental search. @ or ' return to mark and pops mark ring. Mark ring is pushed at start of every successful search and when jump to line to occurs. The mark is set on jump to buffer start or end. ? or h provide help message (list of commands). \\[help-command] provides help (list of commands or description of a command). C-n moves down lines vertically. C-p moves upward lines vertically. C-l recenters the screen. q exit view-mode and return to previous buffer." (interactive "P") (setq view-mode (if (null arg) (not view-mode) (> (prefix-numeric-value arg) 0))) (force-mode-line-update)) (defun view-mode-enter (&optional prev-buffer action) "Enter View mode, a Minor mode for viewing text but not editing it. See the function `view-mode' for more details. This function runs the normal hook `view-mode-hook'. \\{view-mode-map}" ; Not interactive because dangerous things happen ; if you call it without passing a buffer as argument ; and they are not easy to fix. ; (interactive) (setq view-old-buffer-read-only buffer-read-only) (setq view-old-Helper-return-blurb (and (boundp 'Helper-return-blurb) Helper-return-blurb)) ;; Enable view-exit to make use of the data we just saved ;; and to perform the exit action. (setq view-mode-auto-exit t) (setq buffer-read-only t) (setq view-mode t) (setq Helper-return-blurb (format "continue viewing %s" (if (buffer-file-name) (file-name-nondirectory (buffer-file-name)) (buffer-name)))) (setq view-exit-action action) (setq view-return-here prev-buffer) (setq view-exit-position (point-marker)) (beginning-of-line) (setq goal-column nil) (run-hooks 'view-mode-hook) (message (substitute-command-keys "Type \\[help-command] for help, \\[describe-mode] for commands, \\[view-exit] to quit."))) (defun view-exit () "Exit from view-mode. If you viewed an existing buffer, that buffer returns to its previous mode. If you viewed a file that was not present in Emacs, its buffer is killed." (interactive) (setq view-mode nil) (and view-overlay (delete-overlay view-overlay)) (force-mode-line-update) (cond (view-mode-auto-exit (setq buffer-read-only view-old-buffer-read-only) (setq view-mode-auto-exit nil) (goto-char view-exit-position) (set-marker view-exit-position nil) ;; Now do something to the buffer that we were viewing ;; (such as kill it). (let ((viewed-buffer (current-buffer)) (action view-exit-action)) (cond ((bufferp view-return-here) (switch-to-buffer view-return-here)) ((window-configuration-p view-return-here) (set-window-configuration view-return-here))) (if action (funcall action viewed-buffer)))))) (defun view-window-size () (1- (window-height))) (defun view-scroll-size () (min (view-window-size) (or view-scroll-size (view-window-size)))) (defvar view-mode-hook nil "Normal hook run when starting to view a buffer or file.") ;(defun view-last-command (&optional who what) ; (setq view-last-command-entry this-command) ; (setq view-last-command who) ; (setq view-last-command-argument what)) ;(defun View-repeat-last-command () ; "Repeat last command issued in View mode." ; (interactive) ; (if (and view-last-command ; (eq view-last-command-entry last-command)) ; (funcall view-last-command view-last-command-argument)) ; (setq this-command view-last-command-entry)) (defun View-goto-line (line) "Move to line LINE in View mode. Display is centered at LINE. Sets mark at starting position and pushes mark ring." (interactive "p") (push-mark) (goto-line line) (recenter (/ (view-window-size) 2))) (defun View-scroll-lines-forward (&optional lines) "Scroll forward in View mode, or exit if end of text is visible. No arg means whole window full, or number of lines set by \\[View-scroll-lines-forward-set-scroll-size]. Arg is number of lines to scroll." (interactive "P") (setq lines (if lines (prefix-numeric-value lines) (view-scroll-size))) (if (and (pos-visible-in-window-p (point-max)) ;; Allow scrolling backward at the end of the buffer. (> lines 0) view-mode-auto-exit) (view-exit) ;; (view-last-command 'View-scroll-lines-forward lines) (if (>= lines (view-window-size)) (scroll-up nil) (if (>= (- lines) (view-window-size)) (scroll-down nil) (scroll-up lines))) (cond ((pos-visible-in-window-p (point-max)) (goto-char (point-max)) (message (substitute-command-keys "End. Type \\[view-exit] to quit viewing.")))) (move-to-window-line -1) (beginning-of-line))) (defun View-scroll-lines-forward-set-scroll-size (&optional lines) "Scroll forward LINES lines in View mode, setting the \"scroll size\". This is the number of lines which \\[View-scroll-lines-forward] and \\[View-scroll-lines-backward] scroll by default. The absolute value of LINES is used, so this command can be used to scroll backwards (but \"scroll size\" is always positive). If LINES is greater than window height or omitted, then window height is assumed. If LINES is less than window height then scrolling context is provided from previous screen." (interactive "P") (if (not lines) (setq view-scroll-size (view-window-size)) (setq lines (prefix-numeric-value lines)) (setq view-scroll-size (min (if (> lines 0) lines (- lines)) (view-window-size)))) (View-scroll-lines-forward lines)) (defun View-scroll-one-more-line (&optional arg) "Scroll one more line up in View mode. With ARG scroll one line down." (interactive "P") (View-scroll-lines-forward (if (not arg) 1 -1))) (defun View-scroll-lines-backward (&optional lines) "Scroll backward in View mode. No arg means whole window full, or number of lines set by \\[View-scroll-lines-forward-set-scroll-size]. Arg is number of lines to scroll." (interactive "P") (View-scroll-lines-forward (if lines (- (prefix-numeric-value lines)) (- (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. The variable `view-highlight-face' controls the face that is used for highlighting the match that is found." (interactive "p\nsSearch forward (regexp): ") ;;;(view-last-command 'View-search-last-regexp-forward n) (view-search n (if (equal regexp "") view-last-regexp 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. The variable `view-highlight-face' controls the face that is used for highlighting the match that is found." (interactive "p\nsSearch backward (regexp): ") (View-search-regexp-forward (- n) (if (equal regexp "") view-last-regexp 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. The variable `view-highlight-face' controls the face that is used for highlighting the match that is found." (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. The variable `view-highlight-face' controls the face that is used for highlighting the match that is found." (interactive "p") (View-search-regexp-backward n view-last-regexp)) (defun View-back-to-mark (&optional ignore) "Return to last mark set in View mode, else beginning of file. Displays line at center of window. Pops mark ring so successive invocations return to earlier marks." (interactive) (goto-char (or (mark t) (point-min))) (pop-mark) (recenter (/ (view-window-size) 2))) (defun view-search (times regexp) (setq view-last-regexp regexp) (let (where) (save-excursion (move-to-window-line (if (< times 0) 0 -1)) (if (re-search-forward regexp nil t times) (setq where (point)))) (if where (progn (push-mark) (goto-char where) (if view-overlay (move-overlay view-overlay (match-beginning 0) (match-end 0)) (setq view-overlay (make-overlay (match-beginning 0) (match-end 0)))) (overlay-put view-overlay 'face view-highlight-face) (beginning-of-line) (recenter (/ (view-window-size) 2))) (message "Can't find occurrence %d of %s" times regexp) (sit-for 4)))) (provide 'view) ;;; view.el ends here emacs-19.30/lisp/vip.el100444 12120 1 272030 5772175515 13251 0ustar rmsdaemon;;; vip.el --- a VI Package for GNU Emacs ;; Author: Masahiko Sato ;; Version: 3.5 ;; Keywords: emulations ;;; Commentary: ;; A full-featured vi(1) emulator. ;; ;; In Japan, the author's address is: masahiko@sato.riec.tohoku.junet ;; ;; Send suggestions and bug reports to one of the above addresses. ;; When you report a bug, be sure to include the version number of VIP and ;; Emacs you are using. ;; Execute info command by typing "M-x info" to get information on VIP. ;;; Code: ;; external variables (defvar vip-emacs-local-map nil "Local map used in emacs mode. \(buffer specific\)") (defvar vip-insert-local-map nil "Local map used in insert command mode. \(buffer specific\)") (make-variable-buffer-local 'vip-emacs-local-map) (make-variable-buffer-local 'vip-insert-local-map) (defvar vip-insert-point nil "Remember insert point as a marker. \(buffer specific\)") (set-default 'vip-insert-point (make-marker)) (make-variable-buffer-local 'vip-insert-point) (defvar vip-com-point nil "Remember com point as a marker. \(buffer specific\)") (set-default 'vip-com-point (make-marker)) (make-variable-buffer-local 'vip-com-point) (defvar vip-current-mode nil "Current mode. One of emacs-mode, vi-mode, insert-mode.") (make-variable-buffer-local 'vip-current-mode) (setq-default vip-current-mode 'emacs-mode) (defvar vip-emacs-mode-line-buffer-identification nil "value of mode-line-buffer-identification in emacs-mode.") (make-variable-buffer-local 'vip-emacs-mode-line-buffer-identification) (setq-default vip-emacs-mode-line-buffer-identification '("Emacs: %17b")) (defvar vip-current-major-mode nil "vip-current-major-mode is the major-mode vi considers it is now. \(buffer specific\)") (make-variable-buffer-local 'vip-current-major-mode) (defvar vip-last-shell-com nil "last shell command executed by ! command") (defvar vip-use-register nil "name of register to store deleted or yanked strings.") (defvar vip-d-com nil "If non-nil, it's value is a list (M-COM VAL COM), and is used to re-execute last destructive command") (defconst vip-shift-width 8 "*The number of colums shifted by > and < command.") (defconst vip-re-replace nil "*If t then do regexp replace, if nil then do string replace.") (defvar vip-d-char nil "The character remembered by the vi \"r\" command") (defvar vip-f-char nil "for use by \";\" command") (defvar vip-F-char nil "for use by \".\" command") (defvar vip-f-forward nil "for use by \";\" command") (defvar vip-f-offset nil "for use by \";\" command") (defconst vip-search-wrap-around t "*if t, search wraps around") (defconst vip-re-search nil "*if t, search is reg-exp search, otherwise vanilla search.") (defvar vip-s-string nil "last search string") (defvar vip-s-forward nil "if t, search is forward.") (defconst vip-case-fold-search nil "*if t, search ignores cases.") (defconst vip-re-query-replace nil "*If t then do regexp replace, if nil then do string replace.") (defconst vip-open-with-indent nil "*if t, indent when open a new line.") (defconst vip-help-in-insert-mode nil "*if t then C-h is bound to help-command in insert mode, if nil then it is bound to delete-backward-char.") (defvar vip-quote-string "> " "string inserted at the beginning of region") (defvar vip-tags-file-name "TAGS") (defvar vip-inhibit-startup-message nil) ;; basic set up (global-set-key "\C-z" 'vip-change-mode-to-vi) (defmacro vip-loop (count body) "(COUNT BODY) Execute BODY COUNT times." (list 'let (list (list 'count count)) (list 'while (list '> 'count 0) body (list 'setq 'count (list '1- 'count))))) (defun vip-push-mark-silent (&optional location) "Set mark at LOCATION (point, by default) and push old mark on mark ring. No message." (if (null (mark t)) nil (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) (if (> (length mark-ring) mark-ring-max) (progn (move-marker (car (nthcdr mark-ring-max mark-ring)) nil) (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))) (set-mark (or location (point)))) (defun vip-goto-col (arg) "Go to ARG's column." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (save-excursion (end-of-line) (if (> val (1+ (current-column))) (error ""))) (if com (move-marker vip-com-point (point))) (beginning-of-line) (forward-char (1- val)) (if com (vip-execute-com 'vip-goto-col val com)))) (defun vip-copy-keymap (map) (if (null map) (make-sparse-keymap) (copy-keymap map))) ;; changing mode (defun vip-change-mode (new-mode) "Change mode to NEW-MODE---either emacs-mode, vi-mode, or insert-mode." (or (eq new-mode vip-current-mode) (progn (cond ((eq new-mode 'vi-mode) (if (eq vip-current-mode 'insert-mode) (progn (vip-copy-region-as-kill (point) vip-insert-point) (vip-repeat-insert-command)) (setq vip-emacs-local-map (current-local-map) vip-emacs-mode-line-buffer-identification mode-line-buffer-identification vip-insert-local-map (vip-copy-keymap (current-local-map)))) (vip-change-mode-line "Vi: ") (use-local-map vip-mode-map)) ((eq new-mode 'insert-mode) (move-marker vip-insert-point (point)) (if (eq vip-current-mode 'emacs-mode) (setq vip-emacs-local-map (current-local-map) vip-emacs-mode-line-buffer-identification mode-line-buffer-identification vip-insert-local-map (vip-copy-keymap (current-local-map))) (setq vip-insert-local-map (vip-copy-keymap vip-emacs-local-map))) (vip-change-mode-line "Insert") (use-local-map vip-insert-local-map) (define-key vip-insert-local-map "\e" 'vip-change-mode-to-vi) (define-key vip-insert-local-map "\C-z" 'vip-ESC) (define-key vip-insert-local-map "\C-h" (if vip-help-in-insert-mode 'help-command 'delete-backward-char)) (define-key vip-insert-local-map "\C-w" 'vip-delete-backward-word)) ((eq new-mode 'emacs-mode) (vip-change-mode-line "Emacs:") (use-local-map vip-emacs-local-map))) (setq vip-current-mode new-mode) (force-mode-line-update)))) (defun vip-copy-region-as-kill (beg end) "If BEG and END do not belong to the same buffer, it copies empty region." (condition-case nil (copy-region-as-kill beg end) (error (copy-region-as-kill beg beg)))) (defun vip-change-mode-line (string) "Assuming that the mode line format contains the string \"Emacs:\", this function replaces the string by \"Vi: \" etc." (setq mode-line-buffer-identification (if (string= string "Emacs:") vip-emacs-mode-line-buffer-identification (list (concat string " %17b"))))) ;;;###autoload (defun vip-mode () "Turn on VIP emulation of VI." (interactive) (if (not vip-inhibit-startup-message) (progn (switch-to-buffer "VIP Startup Message") (erase-buffer) (insert "VIP is a Vi emulation package for GNU Emacs. VIP provides most Vi commands including Ex commands. VIP is however different from Vi in several points. You can get more information on VIP by: 1. Typing `M-x info' and selecting menu item \"vip\". 2. Typing `C-h k' followed by a key whose description you want. 3. Printing VIP manual which can be found as GNU/man/vip.texinfo 4. Printing VIP Reference Card which can be found as GNU/etc/vipcard.tex This startup message appears whenever you load VIP unless you type `y' now. Type `n' to quit this window for now.\n") (goto-char (point-min)) (if (y-or-n-p "Inhibit VIP startup message? ") (progn (save-excursion (set-buffer (find-file-noselect (substitute-in-file-name "~/.vip"))) (goto-char (point-max)) (insert "\n(setq vip-inhibit-startup-message t)\n") (save-buffer) (kill-buffer (current-buffer))) (message "VIP startup message inhibited.") (sit-for 2))) (kill-buffer (current-buffer)) (message "") (setq vip-inhibit-startup-message t))) (vip-change-mode-to-vi)) (defun vip-change-mode-to-vi () "Change mode to vi mode." (interactive) (vip-change-mode 'vi-mode)) (defun vip-change-mode-to-insert () "Change mode to insert mode." (interactive) (vip-change-mode 'insert-mode)) (defun vip-change-mode-to-emacs () "Change mode to emacs mode." (interactive) (vip-change-mode 'emacs-mode)) ;; escape to emacs mode temporarily (defun vip-escape-to-emacs (arg &optional events) "Escape to Emacs mode for one Emacs command. ARG is used as the prefix value for the executed command. If EVENTS is a list of events, which become the beginning of the command." (interactive "P") (let (com key (old-map (current-local-map))) (if events (setq unread-command-events events)) (setq prefix-arg arg) (use-local-map vip-emacs-local-map) (unwind-protect (setq com (key-binding (setq key (read-key-sequence nil)))) (use-local-map old-map)) (command-execute com prefix-arg) (setq prefix-arg nil) ;; reset prefix arg )) (defun vip-message-conditions (conditions) "Print CONDITIONS as a message." (let ((case (car conditions)) (msg (cdr conditions))) (if (null msg) (message "%s" case) (message "%s %s" case (prin1-to-string msg))) (ding))) (defun vip-ESC (arg) "Emulate ESC key in Emacs mode." (interactive "P") (vip-escape-to-emacs arg '(?\e))) (defun vip-ctl-c (arg) "Emulate C-c key in Emacs mode." (interactive "P") (vip-escape-to-emacs arg '(?\C-c))) (defun vip-ctl-x (arg) "Emulate C-x key in Emacs mode." (interactive "P") (vip-escape-to-emacs arg '(?\C-x))) (defun vip-ctl-h (arg) "Emulate C-h key in Emacs mode." (interactive "P") (vip-escape-to-emacs arg '(?\C-h))) ;; prefix argument for vi mode ;; In vi mode, prefix argument is a dotted pair (NUM . COM) where NUM ;; represents the numeric value of the prefix argument and COM represents ;; command prefix such as "c", "d", "m" and "y". (defun vip-prefix-arg-value (char value com) "Compute numeric prefix arg value. Invoked by CHAR. VALUE is the value obtained so far, and COM is the command part obtained so far." (while (and (>= char ?0) (<= char ?9)) (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0))) (setq char (read-char))) (setq prefix-arg value) (if com (setq prefix-arg (cons prefix-arg com))) (while (= char ?U) (vip-describe-arg prefix-arg) (setq char (read-char))) (setq unread-command-events (list char))) (defun vip-prefix-arg-com (char value com) "Vi operator as prefix argument." (let ((cont t)) (while (and cont (or (= char ?c) (= char ?d) (= char ?y) (= char ?!) (= char ?<) (= char ?>) (= char ?=) (= char ?#) (= char ?r) (= char ?R) (= char ?\"))) (if com ;; this means that we already have a command character, so we ;; construct a com list and exit while. however, if char is " ;; it is an error. (progn ;; new com is (CHAR . OLDCOM) (if (or (= char ?#) (= char ?\")) (error "")) (setq com (cons char com)) (setq cont nil)) ;; if com is nil we set com as char, and read more. again, if char ;; is ", we read the name of register and store it in vip-use-register. ;; if char is !, =, or #, a complete com is formed so we exit while. (cond ((or (= char ?!) (= char ?=)) (setq com char) (setq char (read-char)) (setq cont nil)) ((= char ?#) ;; read a char and encode it as com (setq com (+ 128 (read-char))) (setq char (read-char)) (setq cont nil)) ((or (= char ?<) (= char ?>)) (setq com char) (setq char (read-char)) (if (= com char) (setq com (cons char com))) (setq cont nil)) ((= char ?\") (let ((reg (read-char))) (if (or (and (<= ?A reg) (<= reg ?z)) (and (<= ?1 reg) (<= reg ?9))) (setq vip-use-register reg) (error "")) (setq char (read-char)))) (t (setq com char) (setq char (read-char))))))) (if (atom com) ;; com is a single char, so we construct prefix-arg ;; and if char is ?, describe prefix arg, otherwise exit by ;; pushing the char back (progn (setq prefix-arg (cons value com)) (while (= char ?U) (vip-describe-arg prefix-arg) (setq char (read-char))) (setq unread-command-events (list char))) ;; as com is non-nil, this means that we have a command to execute (if (or (= (car com) ?r) (= (car com) ?R)) ;; execute apropriate region command. (let ((char (car com)) (com (cdr com))) (setq prefix-arg (cons value com)) (if (= char ?r) (vip-region prefix-arg) (vip-Region prefix-arg)) ;; reset prefix-arg (setq prefix-arg nil)) ;; otherwise, reset prefix arg and call appropriate command (setq value (if (null value) 1 value)) (setq prefix-arg nil) (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C))) ((equal com '(?d . ?d)) (vip-line (cons value ?D))) ((equal com '(?d . ?y)) (vip-yank-defun)) ((equal com '(?y . ?y)) (vip-line (cons value ?Y))) ((equal com '(?< . ?<)) (vip-line (cons value ?<))) ((equal com '(?> . ?>)) (vip-line (cons value ?>))) ((equal com '(?! . ?!)) (vip-line (cons value ?!))) ((equal com '(?= . ?=)) (vip-line (cons value ?=))) (t (error "")))))) (defun vip-describe-arg (arg) (let (val com) (setq val (vip-P-val arg) com (vip-getcom arg)) (if (null val) (if (null com) (message "Value is nil, and command is nil.") (message "Value is nil, and command is %c." com)) (if (null com) (message "Value is %d, and command is nil." val) (message "Value is %d, and command is %c." val com))))) (defun vip-digit-argument (arg) "Begin numeric argument for the next command." (interactive "P") (vip-prefix-arg-value last-command-char nil (if (consp arg) (cdr arg) nil))) (defun vip-command-argument (arg) "Accept a motion command as an argument." (interactive "P") (condition-case conditions (vip-prefix-arg-com last-command-char (cond ((null arg) nil) ((consp arg) (car arg)) ((numberp arg) arg) (t (error "strange arg"))) (cond ((null arg) nil) ((consp arg) (cdr arg)) ((numberp arg) nil) (t (error "strange arg")))) (quit (setq vip-use-register nil) (signal 'quit nil)))) (defun vip-p-val (arg) "Get value part of prefix-argument ARG." (cond ((null arg) 1) ((consp arg) (if (null (car arg)) 1 (car arg))) (t arg))) (defun vip-P-val (arg) "Get value part of prefix-argument ARG." (cond ((consp arg) (car arg)) (t arg))) (defun vip-getcom (arg) "Get com part of prefix-argument ARG." (cond ((null arg) nil) ((consp arg) (cdr arg)) (t nil))) (defun vip-getCom (arg) "Get com part of prefix-argument ARG and modify it." (let ((com (vip-getcom arg))) (cond ((equal com ?c) ?C) ((equal com ?d) ?D) ((equal com ?y) ?Y) (t com)))) ;; repeat last destructive command (defun vip-append-to-register (reg start end) "Append region to text in register REG. START and END are buffer positions indicating what to append." (set-register reg (concat (or (get-register reg) "") (buffer-substring start end)))) (defun vip-execute-com (m-com val com) "(M-COM VAL COM) Execute command COM. The list (M-COM VAL COM) is set to vip-d-com for later use by vip-repeat" (let ((reg vip-use-register)) (if com (cond ((= com ?c) (vip-change vip-com-point (point))) ((= com (- ?c)) (vip-change-subr vip-com-point (point))) ((or (= com ?C) (= com (- ?C))) (save-excursion (set-mark vip-com-point) (vip-enlarge-region (mark) (point)) (if vip-use-register (progn (cond ((and (<= ?a vip-use-register) (<= vip-use-register ?z)) (copy-to-register vip-use-register (mark) (point) nil)) ((and (<= ?A vip-use-register) (<= vip-use-register ?Z)) (vip-append-to-register (+ vip-use-register 32) (mark) (point))) (t (setq vip-use-register nil) (error ""))) (setq vip-use-register nil))) (delete-region (mark) (point))) (open-line 1) (if (= com ?C) (vip-change-mode-to-insert) (yank))) ((= com ?d) (if vip-use-register (progn (cond ((and (<= ?a vip-use-register) (<= vip-use-register ?z)) (copy-to-register vip-use-register vip-com-point (point) nil)) ((and (<= ?A vip-use-register) (<= vip-use-register ?Z)) (vip-append-to-register (+ vip-use-register 32) vip-com-point (point))) (t (setq vip-use-register nil) (error ""))) (setq vip-use-register nil))) (setq last-command (if (eq last-command 'd-command) 'kill-region nil)) (kill-region vip-com-point (point)) (setq this-command 'd-command)) ((= com ?D) (save-excursion (set-mark vip-com-point) (vip-enlarge-region (mark) (point)) (if vip-use-register (progn (cond ((and (<= ?a vip-use-register) (<= vip-use-register ?z)) (copy-to-register vip-use-register (mark) (point) nil)) ((and (<= ?A vip-use-register) (<= vip-use-register ?Z)) (vip-append-to-register (+ vip-use-register 32) (mark) (point))) (t (setq vip-use-register nil) (error ""))) (setq vip-use-register nil))) (setq last-command (if (eq last-command 'D-command) 'kill-region nil)) (kill-region (mark) (point)) (if (eq m-com 'vip-line) (setq this-command 'D-command))) (back-to-indentation)) ((= com ?y) (if vip-use-register (progn (cond ((and (<= ?a vip-use-register) (<= vip-use-register ?z)) (copy-to-register vip-use-register vip-com-point (point) nil)) ((and (<= ?A vip-use-register) (<= vip-use-register ?Z)) (vip-append-to-register (+ vip-use-register 32) vip-com-point (point))) (t (setq vip-use-register nil) (error ""))) (setq vip-use-register nil))) (setq last-command nil) (copy-region-as-kill vip-com-point (point)) (goto-char vip-com-point)) ((= com ?Y) (save-excursion (set-mark vip-com-point) (vip-enlarge-region (mark) (point)) (if vip-use-register (progn (cond ((and (<= ?a vip-use-register) (<= vip-use-register ?z)) (copy-to-register vip-use-register (mark) (point) nil)) ((and (<= ?A vip-use-register) (<= vip-use-register ?Z)) (vip-append-to-register (+ vip-use-register 32) (mark) (point))) (t (setq vip-use-register nil) (error ""))) (setq vip-use-register nil))) (setq last-command nil) (copy-region-as-kill (mark) (point))) (goto-char vip-com-point)) ((or (= com ?!) (= com (- ?!))) (save-excursion (set-mark vip-com-point) (vip-enlarge-region (mark) (point)) (shell-command-on-region (mark) (point) (if (= com ?!) (setq vip-last-shell-com (vip-read-string "!")) vip-last-shell-com) t))) ((= com ?=) (save-excursion (set-mark vip-com-point) (vip-enlarge-region (mark) (point)) (if (> (mark) (point)) (exchange-point-and-mark)) (indent-region (mark) (point) nil))) ((= com ?<) (save-excursion (set-mark vip-com-point) (vip-enlarge-region (mark) (point)) (indent-rigidly (mark) (point) (- vip-shift-width))) (goto-char vip-com-point)) ((= com ?>) (save-excursion (set-mark vip-com-point) (vip-enlarge-region (mark) (point)) (indent-rigidly (mark) (point) vip-shift-width)) (goto-char vip-com-point)) ((>= com 128) ;; this is special command # (vip-special-prefix-com (- com 128))))) (setq vip-d-com (list m-com val (if (or (= com ?c) (= com ?C) (= com ?!)) (- com) com) reg)))) (defun vip-repeat (arg) "(ARG) Re-execute last destructive command. vip-d-com has the form \(COM ARG CH REG), where COM is the command to be re-executed, ARG is the argument for COM, CH is a flag for repeat, and REG is optional and if exists is the name of the register for COM." (interactive "P") (if (eq last-command 'vip-undo) ;; if the last command was vip-undo, then undo-more (vip-undo-more) ;; otherwise execute the command stored in vip-d-com. if arg is non-nil ;; its prefix value is used as new prefix value for the command. (let ((m-com (car vip-d-com)) (val (vip-P-val arg)) (com (car (cdr (cdr vip-d-com)))) (reg (nth 3 vip-d-com))) (if (null val) (setq val (car (cdr vip-d-com)))) (if (null m-com) (error "No previous command to repeat.")) (setq vip-use-register reg) (funcall m-com (cons val com))))) (defun vip-special-prefix-com (char) "This command is invoked interactively by the key sequence #" (cond ((= char ?c) (downcase-region (min vip-com-point (point)) (max vip-com-point (point)))) ((= char ?C) (upcase-region (min vip-com-point (point)) (max vip-com-point (point)))) ((= char ?g) (set-mark vip-com-point) (vip-global-execute)) ((= char ?q) (set-mark vip-com-point) (vip-quote-region)) ((= char ?s) (spell-region vip-com-point (point))))) ;; undoing (defun vip-undo () "Undo previous change." (interactive) (message "undo!") (undo-start) (undo-more 2) (setq this-command 'vip-undo)) (defun vip-undo-more () "Continue undoing previous changes." (message "undo more!") (undo-more 1) (setq this-command 'vip-undo)) ;; utilities (defun vip-string-tail (str) (if (or (null str) (string= str "")) nil (substring str 1))) (defun vip-yank-defun () (mark-defun) (copy-region-as-kill (point) (mark))) (defun vip-enlarge-region (beg end) "Enlarge region between BEG and END." (if (< beg end) (progn (goto-char beg) (set-mark end)) (goto-char end) (set-mark beg)) (beginning-of-line) (exchange-point-and-mark) (if (or (not (eobp)) (not (bolp))) (next-line 1)) (beginning-of-line) (if (> beg end) (exchange-point-and-mark))) (defun vip-global-execute () "Call last keyboad macro for each line in the region." (if (> (point) (mark)) (exchange-point-and-mark)) (beginning-of-line) (call-last-kbd-macro) (while (< (point) (mark)) (forward-line 1) (beginning-of-line) (call-last-kbd-macro))) (defun vip-quote-region () "Quote region by inserting the user supplied string at the beginning of each line in the region." (setq vip-quote-string (let ((str (vip-read-string (format "quote string \(default \"%s\"\): " vip-quote-string)))) (if (string= str "") vip-quote-string str))) (vip-enlarge-region (point) (mark)) (if (> (point) (mark)) (exchange-point-and-mark)) (insert vip-quote-string) (beginning-of-line) (forward-line 1) (while (and (< (point) (mark)) (bolp)) (insert vip-quote-string) (beginning-of-line) (forward-line 1))) (defun vip-end-with-a-newline-p (string) "Check if the string ends with a newline." (or (string= text "") (= (aref string (1- (length string))) ?\n))) (defun vip-read-string (prompt &optional init) (setq save-minibuffer-local-map (copy-keymap minibuffer-local-map)) (define-key minibuffer-local-map "\C-h" 'backward-char) (define-key minibuffer-local-map "\C-w" 'backward-word) (define-key minibuffer-local-map "\e" 'exit-minibuffer) (let (str) (condition-case conditions (setq str (read-string prompt init)) (quit (setq minibuffer-local-map save-minibuffer-local-map) (signal 'quit nil))) (setq minibuffer-local-map save-minibuffer-local-map) str)) ;; insertion commands (defun vip-repeat-insert-command () "This function is called when mode changes from insertion mode to vi command mode. It will repeat the insertion command if original insertion command was invoked with argument > 1." (let ((i-com (car vip-d-com)) (val (car (cdr vip-d-com)))) (if (and val (> val 1)) ;; first check that val is non-nil (progn (setq vip-d-com (list i-com (1- val) ?r)) (vip-repeat nil) (setq vip-d-com (list i-com val ?r)))))) (defun vip-insert (arg) "" (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (setq vip-d-com (list 'vip-insert val ?r)) (if com (vip-loop val (yank)) (vip-change-mode-to-insert)))) (defun vip-append (arg) "Append after point." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (setq vip-d-com (list 'vip-append val ?r)) (if (not (eolp)) (forward-char)) (if (equal com ?r) (vip-loop val (yank)) (vip-change-mode-to-insert)))) (defun vip-Append (arg) "Append at end of line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (setq vip-d-com (list 'vip-Append val ?r)) (end-of-line) (if (equal com ?r) (vip-loop val (yank)) (vip-change-mode-to-insert)))) (defun vip-Insert (arg) "Insert before first non-white." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (setq vip-d-com (list 'vip-Insert val ?r)) (back-to-indentation) (if (equal com ?r) (vip-loop val (yank)) (vip-change-mode-to-insert)))) (defun vip-open-line (arg) "Open line below." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (setq vip-d-com (list 'vip-open-line val ?r)) (let ((col (current-indentation))) (if (equal com ?r) (vip-loop val (progn (end-of-line) (newline 1) (if vip-open-with-indent (indent-to col)) (yank))) (end-of-line) (newline 1) (if vip-open-with-indent (indent-to col)) (vip-change-mode-to-insert))))) (defun vip-Open-line (arg) "Open line above." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (setq vip-d-com (list 'vip-Open-line val ?r)) (let ((col (current-indentation))) (if (equal com ?r) (vip-loop val (progn (beginning-of-line) (open-line 1) (if vip-open-with-indent (indent-to col)) (yank))) (beginning-of-line) (open-line 1) (if vip-open-with-indent (indent-to col)) (vip-change-mode-to-insert))))) (defun vip-open-line-at-point (arg) "Open line at point." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (setq vip-d-com (list 'vip-open-line-at-point val ?r)) (if (equal com ?r) (vip-loop val (progn (open-line 1) (yank))) (open-line 1) (vip-change-mode-to-insert)))) (defun vip-substitute (arg) "Substitute characters." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (save-excursion (set-mark (point)) (forward-char val) (if (equal com ?r) (vip-change-subr (mark) (point)) (vip-change (mark) (point)))) (setq vip-d-com (list 'vip-substitute val ?r)))) (defun vip-substitute-line (arg) "Substitute lines." (interactive "p") (vip-line (cons arg ?C))) ;; line command (defun vip-line (arg) (let ((val (car arg)) (com (cdr arg))) (move-marker vip-com-point (point)) (next-line (1- val)) (vip-execute-com 'vip-line val com))) (defun vip-yank-line (arg) "Yank ARG lines (in vi's sense)" (interactive "P") (let ((val (vip-p-val arg))) (vip-line (cons val ?Y)))) ;; region command (defun vip-region (arg) (interactive "P") (let ((val (vip-P-val arg)) (com (vip-getcom arg))) (move-marker vip-com-point (point)) (exchange-point-and-mark) (vip-execute-com 'vip-region val com))) (defun vip-Region (arg) (interactive "P") (let ((val (vip-P-val arg)) (com (vip-getCom arg))) (move-marker vip-com-point (point)) (exchange-point-and-mark) (vip-execute-com 'vip-Region val com))) (defun vip-replace-char (arg) "Replace the following ARG chars by the character read." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (setq vip-d-com (list 'vip-replace-char val ?r)) (vip-replace-char-subr (if (equal com ?r) vip-d-char (read-char)) val))) (defun vip-replace-char-subr (char arg) (delete-char arg t) (setq vip-d-char char) (vip-loop (if (> arg 0) arg (- arg)) (insert char)) (backward-char arg)) (defun vip-replace-string () "Replace string. If you supply null string as the string to be replaced, the query replace mode will toggle between string replace and regexp replace." (interactive) (let (str) (setq str (vip-read-string (if vip-re-replace "Replace regexp: " "Replace string: "))) (if (string= str "") (progn (setq vip-re-replace (not vip-re-replace)) (message (format "Replace mode changed to %s." (if vip-re-replace "regexp replace" "string replace")))) (if vip-re-replace ;; (replace-regexp ;; str ;; (vip-read-string (format "Replace regexp \"%s\" with: " str))) (while (re-search-forward str nil t) (replace-match (vip-read-string (format "Replace regexp \"%s\" with: " str)) nil nil)) (replace-string str (vip-read-string (format "Replace \"%s\" with: " str))))))) ;; basic cursor movement. j, k, l, m commands. (defun vip-forward-char (arg) "Move point right ARG characters (left if ARG negative).On reaching end of buffer, stop and signal error." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (forward-char val) (if com (vip-execute-com 'vip-forward-char val com)))) (defun vip-backward-char (arg) "Move point left ARG characters (right if ARG negative). On reaching beginning of buffer, stop and signal error." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (backward-char val) (if com (vip-execute-com 'vip-backward-char val com)))) ;; word command (defun vip-forward-word (arg) "Forward word." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (forward-word val) (skip-chars-forward " \t\n") (if com (progn (if (or (= com ?c) (= com (- ?c))) (progn (backward-word 1) (forward-word 1))) (if (or (= com ?d) (= com ?y)) (progn (backward-word 1) (forward-word 1) (skip-chars-forward " \t"))) (vip-execute-com 'vip-forward-word val com))))) (defun vip-end-of-word (arg) "Move point to end of current word." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (forward-char) (forward-word val) (backward-char) (if com (progn (forward-char) (vip-execute-com 'vip-end-of-word val com))))) (defun vip-backward-word (arg) "Backward word." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (backward-word val) (if com (vip-execute-com 'vip-backward-word val com)))) (defun vip-forward-Word (arg) "Forward word delimited by white character." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (re-search-forward "[^ \t\n]*[ \t\n]+" nil t val) (if com (progn (if (or (= com ?c) (= com (- ?c))) (progn (backward-word 1) (forward-word 1))) (if (or (= com ?d) (= com ?y)) (progn (backward-word 1) (forward-word 1) (skip-chars-forward " \t"))) (vip-execute-com 'vip-forward-Word val com))))) (defun vip-end-of-Word (arg) "Move forward to end of word delimited by white character." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (forward-char) (if (re-search-forward "[^ \t\n]+" nil t val) (backward-char)) (if com (progn (forward-char) (vip-execute-com 'vip-end-of-Word val com))))) (defun vip-backward-Word (arg) "Backward word delimited by white character." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (if (re-search-backward "[ \t\n]+[^ \t\n]+" nil t val) (forward-char) (goto-char (point-min))) (if com (vip-execute-com 'vip-backward-Word val com)))) (defun vip-beginning-of-line (arg) "Go to beginning of line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (beginning-of-line val) (if com (vip-execute-com 'vip-beginning-of-line val com)))) (defun vip-bol-and-skip-white (arg) "Beginning of line at first non-white character." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (back-to-indentation) (if com (vip-execute-com 'vip-bol-and-skip-white val com)))) (defun vip-goto-eol (arg) "Go to end of line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (end-of-line val) (if com (vip-execute-com 'vip-goto-eol val com)))) (defun vip-next-line (arg) "Go to next line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (move-marker vip-com-point (point))) (line-move val) (setq this-command 'next-line) (if com (vip-execute-com 'vip-next-line val com)))) (defun vip-next-line-at-bol (arg) "Next line at beginning of line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (move-marker vip-com-point (point))) (next-line val) (back-to-indentation) (if com (vip-execute-com 'vip-next-line-at-bol val com)))) (defun vip-previous-line (arg) "Go to previous line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (move-marker vip-com-point (point))) (next-line (- val)) (setq this-command 'previous-line) (if com (vip-execute-com 'vip-previous-line val com)))) (defun vip-previous-line-at-bol (arg) "Previous line at beginning of line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (move-marker vip-com-point (point))) (next-line (- val)) (back-to-indentation) (if com (vip-execute-com 'vip-previous-line val com)))) (defun vip-change-to-eol (arg) "Change to end of line." (interactive "P") (vip-goto-eol (cons arg ?c))) (defun vip-kill-line (arg) "Delete line." (interactive "P") (vip-goto-eol (cons arg ?d))) ;; moving around (defun vip-goto-line (arg) "Go to ARG's line. Without ARG go to end of buffer." (interactive "P") (let ((val (vip-P-val arg)) (com (vip-getCom arg))) (move-marker vip-com-point (point)) (set-mark (point)) (if (null val) (goto-char (point-max)) (goto-char (point-min)) (forward-line (1- val))) (back-to-indentation) (if com (vip-execute-com 'vip-goto-line val com)))) (defun vip-find-char (arg char forward offset) "Find ARG's occurrence of CHAR on the current line. If FORWARD then search is forward, otherwise backward. OFFSET is used to adjust point after search." (let ((arg (if forward arg (- arg))) point) (save-excursion (save-restriction (if (> arg 0) (narrow-to-region ;; forward search begins here (if (eolp) (error "") (point)) ;; forward search ends here (progn (next-line 1) (beginning-of-line) (point))) (narrow-to-region ;; backward search begins from here (if (bolp) (error "") (point)) ;; backward search ends here (progn (beginning-of-line) (point)))) ;; if arg > 0, point is forwarded before search. (if (> arg 0) (goto-char (1+ (point-min))) (goto-char (point-max))) (let ((case-fold-search nil)) (search-forward (char-to-string char) nil 0 arg)) (setq point (point)) (if (or (and (> arg 0) (= point (point-max))) (and (< arg 0) (= point (point-min)))) (error "")))) (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0)))))) (defun vip-find-char-forward (arg) "Find char on the line. If called interactively read the char to find from the terminal, and if called from vip-repeat, the char last used is used. This behaviour is controlled by the sign of prefix numeric value." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if (> val 0) ;; this means that the function was called interactively (setq vip-f-char (read-char) vip-f-forward t vip-f-offset nil) (setq val (- val))) (if com (move-marker vip-com-point (point))) (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil) (setq val (- val)) (if com (progn (setq vip-F-char vip-f-char);; set new vip-F-char (forward-char) (vip-execute-com 'vip-find-char-forward val com))))) (defun vip-goto-char-forward (arg) "Go up to char ARG forward on line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if (> val 0) ;; this means that the function was called interactively (setq vip-f-char (read-char) vip-f-forward t vip-f-offset t) (setq val (- val))) (if com (move-marker vip-com-point (point))) (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t) (setq val (- val)) (if com (progn (setq vip-F-char vip-f-char);; set new vip-F-char (forward-char) (vip-execute-com 'vip-goto-char-forward val com))))) (defun vip-find-char-backward (arg) "Find char ARG on line backward." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if (> val 0) ;; this means that the function was called interactively (setq vip-f-char (read-char) vip-f-forward nil vip-f-offset nil) (setq val (- val))) (if com (move-marker vip-com-point (point))) (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil) (setq val (- val)) (if com (progn (setq vip-F-char vip-f-char);; set new vip-F-char (vip-execute-com 'vip-find-char-backward val com))))) (defun vip-goto-char-backward (arg) "Go up to char ARG backward on line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if (> val 0) ;; this means that the function was called interactively (setq vip-f-char (read-char) vip-f-forward nil vip-f-offset t) (setq val (- val))) (if com (move-marker vip-com-point (point))) (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t) (setq val (- val)) (if com (progn (setq vip-F-char vip-f-char);; set new vip-F-char (vip-execute-com 'vip-goto-char-backward val com))))) (defun vip-repeat-find (arg) "Repeat previous find command." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (vip-find-char val vip-f-char vip-f-forward vip-f-offset) (if com (progn (if vip-f-forward (forward-char)) (vip-execute-com 'vip-repeat-find val com))))) (defun vip-repeat-find-opposite (arg) "Repeat previous find command in the opposite direction." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset) (if com (progn (if vip-f-forward (forward-char)) (vip-execute-com 'vip-repeat-find-opposite val com))))) ;; window scrolling etc. (defun vip-other-window (arg) "Switch to other window." (interactive "p") (other-window arg) (or (not (eq vip-current-mode 'emacs-mode)) (string= (buffer-name (current-buffer)) " *Minibuf-1*") (vip-change-mode-to-vi))) (defun vip-window-top (arg) "Go to home window line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (move-marker vip-com-point (point))) (move-to-window-line (1- val)) (if com (vip-execute-com 'vip-window-top val com)))) (defun vip-window-middle (arg) "Go to middle window line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (move-marker vip-com-point (point))) (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val))) (if com (vip-execute-com 'vip-window-middle val com)))) (defun vip-window-bottom (arg) "Go to last window line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (move-marker vip-com-point (point))) (move-to-window-line (- val)) (if com (vip-execute-com 'vip-window-bottom val com)))) (defun vip-line-to-top (arg) "Put current line on the home line." (interactive "p") (recenter (1- arg))) (defun vip-line-to-middle (arg) "Put current line on the middle line." (interactive "p") (recenter (+ (1- arg) (/ (1- (window-height)) 2)))) (defun vip-line-to-bottom (arg) "Put current line on the last line." (interactive "p") (recenter (- (window-height) (1+ arg)))) ;; paren match (defun vip-paren-match (arg) "Go to the matching parenthesis." (interactive "P") (let ((com (vip-getcom arg))) (if (numberp arg) (if (or (> arg 99) (< arg 1)) (error "Prefix must be between 1 and 99.") (goto-char (if (> (point-max) 80000) (* (/ (point-max) 100) arg) (/ (* (point-max) arg) 100))) (back-to-indentation)) (cond ((looking-at "[\(\[{]") (if com (move-marker vip-com-point (point))) (forward-sexp 1) (if com (vip-execute-com 'vip-paren-match nil com) (backward-char))) ((looking-at "[])}]") (forward-char) (if com (move-marker vip-com-point (point))) (backward-sexp 1) (if com (vip-execute-com 'vip-paren-match nil com))) (t (error "")))))) ;; sentence and paragraph (defun vip-forward-sentence (arg) "Forward sentence." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (forward-sentence val) (if com (vip-execute-com 'vip-forward-sentence nil com)))) (defun vip-backward-sentence (arg) "Backward sentence." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (move-marker vip-com-point (point))) (backward-sentence val) (if com (vip-execute-com 'vip-backward-sentence nil com)))) (defun vip-forward-paragraph (arg) "Forward paragraph." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (move-marker vip-com-point (point))) (forward-paragraph val) (if com (vip-execute-com 'vip-forward-paragraph nil com)))) (defun vip-backward-paragraph (arg) "Backward paragraph." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (move-marker vip-com-point (point))) (backward-paragraph val) (if com (vip-execute-com 'vip-backward-paragraph nil com)))) ;; scrolling (defun vip-scroll (arg) "Scroll to next screen." (interactive "p") (if (> arg 0) (while (> arg 0) (scroll-up) (setq arg (1- arg))) (while (> 0 arg) (scroll-down) (setq arg (1+ arg))))) (defun vip-scroll-back (arg) "Scroll to previous screen." (interactive "p") (vip-scroll (- arg))) (defun vip-scroll-down (arg) "Scroll up half screen." (interactive "P") (if (null arg) (scroll-down (/ (window-height) 2)) (scroll-down arg))) (defun vip-scroll-down-one (arg) "Scroll up one line." (interactive "p") (scroll-down arg)) (defun vip-scroll-up (arg) "Scroll down half screen." (interactive "P") (if (null arg) (scroll-up (/ (window-height) 2)) (scroll-up arg))) (defun vip-scroll-up-one (arg) "Scroll down one line." (interactive "p") (scroll-up arg)) ;; splitting window (defun vip-buffer-in-two-windows () "Show current buffer in two windows." (interactive) (delete-other-windows) (split-window-vertically nil)) ;; searching (defun vip-search-forward (arg) "Search a string forward. ARG is used to find the ARG's occurrence of the string. Default is vanilla search. Search mode can be toggled by giving null search string." (interactive "P") (let ((val (vip-P-val arg)) (com (vip-getcom arg))) (setq vip-s-forward t vip-s-string (vip-read-string (if vip-re-search "RE-/" "/"))) (if (string= vip-s-string "") (progn (setq vip-re-search (not vip-re-search)) (message (format "Search mode changed to %s search." (if vip-re-search "regular expression" "vanilla")))) (vip-search vip-s-string t val) (if com (progn (move-marker vip-com-point (mark)) (vip-execute-com 'vip-search-next val com)))))) (defun vip-search-backward (arg) "Search a string backward. ARG is used to find the ARG's occurrence of the string. Default is vanilla search. Search mode can be toggled by giving null search string." (interactive "P") (let ((val (vip-P-val arg)) (com (vip-getcom arg))) (setq vip-s-forward nil vip-s-string (vip-read-string (if vip-re-search "RE-?" "?"))) (if (string= vip-s-string "") (progn (setq vip-re-search (not vip-re-search)) (message (format "Search mode changed to %s search." (if vip-re-search "regular expression" "vanilla")))) (vip-search vip-s-string nil val) (if com (progn (move-marker vip-com-point (mark)) (vip-execute-com 'vip-search-next val com)))))) (defun vip-search (string forward arg &optional no-offset init-point) "(STRING FORWARD COUNT &optional NO-OFFSET) Search COUNT's occurrence of STRING. Search will be forward if FORWARD, otherwise backward." (let ((val (vip-p-val arg)) (com (vip-getcom arg)) (null-arg (null (vip-P-val arg))) (offset (not no-offset)) (case-fold-search vip-case-fold-search) (start-point (or init-point (point)))) (if forward (condition-case conditions (progn (if (and offset (not (eobp))) (forward-char)) (if vip-re-search (progn (re-search-forward string nil nil val) (re-search-backward string)) (search-forward string nil nil val) (search-backward string)) (push-mark start-point)) (search-failed (if (and null-arg vip-search-wrap-around) (progn (goto-char (point-min)) (vip-search string forward (cons 1 com) t start-point)) (goto-char start-point) (signal 'search-failed (cdr conditions))))) (condition-case conditions (progn (if vip-re-search (re-search-backward string nil nil val) (search-backward string nil nil val)) (push-mark start-point)) (search-failed (if (and null-arg vip-search-wrap-around) (progn (goto-char (point-max)) (vip-search string forward (cons 1 com) t start-point)) (goto-char start-point) (signal 'search-failed (cdr conditions)))))))) (defun vip-search-next (arg) "Repeat previous search." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if (null vip-s-string) (error "No previous search string.")) (vip-search vip-s-string vip-s-forward arg) (if com (vip-execute-com 'vip-search-next val com)))) (defun vip-search-Next (arg) "Repeat previous search in the reverse direction." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if (null vip-s-string) (error "No previous search string.")) (vip-search vip-s-string (not vip-s-forward) arg) (if com (vip-execute-com 'vip-search-Next val com)))) ;; visiting and killing files, buffers (defun vip-switch-to-buffer () "Switch to buffer in the current window." (interactive) (let (buffer) (setq buffer (read-buffer (format "switch to buffer \(%s\): " (buffer-name (other-buffer (current-buffer)))))) (switch-to-buffer buffer) (vip-change-mode-to-vi))) (defun vip-switch-to-buffer-other-window () "Switch to buffer in another window." (interactive) (let (buffer) (setq buffer (read-buffer (format "Switch to buffer \(%s\): " (buffer-name (other-buffer (current-buffer)))))) (switch-to-buffer-other-window buffer) (vip-change-mode-to-vi))) (defun vip-kill-buffer () "Kill a buffer." (interactive) (let (buffer buffer-name) (setq buffer-name (read-buffer (format "Kill buffer \(%s\): " (buffer-name (current-buffer))))) (setq buffer (if (null buffer-name) (current-buffer) (get-buffer buffer-name))) (if (null buffer) (error "Buffer %s nonexistent." buffer-name)) (if (or (not (buffer-modified-p buffer)) (y-or-n-p "Buffer is modified, are you sure? ")) (kill-buffer buffer) (error "Buffer not killed.")))) (defun vip-find-file () "Visit file in the current window." (interactive) (let (file) (setq file (read-file-name "visit file: ")) (switch-to-buffer (find-file-noselect file)) (vip-change-mode-to-vi))) (defun vip-find-file-other-window () "Visit file in another window." (interactive) (let (file) (setq file (read-file-name "Visit file: ")) (switch-to-buffer-other-window (find-file-noselect file)) (vip-change-mode-to-vi))) (defun vip-info-on-file () "Give information of the file associated to the current buffer." (interactive) (message "\"%s\" line %d of %d" (if (buffer-file-name) (buffer-file-name) "") (1+ (count-lines (point-min) (point))) (1+ (count-lines (point-min) (point-max))))) ;; yank and pop (defun vip-yank (text) "yank TEXT silently." (save-excursion (vip-push-mark-silent (point)) (insert text) (exchange-point-and-mark)) (skip-chars-forward " \t")) (defun vip-put-back (arg) "Put back after point/below line." (interactive "P") (let ((val (vip-p-val arg)) (text (if vip-use-register (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9)) (current-kill (- vip-use-register ?1) 'do-not-rotate) (get-register vip-use-register)) (current-kill 0)))) (if (null text) (if vip-use-register (let ((reg vip-use-register)) (setq vip-use-register nil) (error "Nothing in register %c" reg)) (error ""))) (setq vip-use-register nil) (if (vip-end-with-a-newline-p text) (progn (next-line 1) (beginning-of-line)) (if (and (not (eolp)) (not (eobp))) (forward-char))) (setq vip-d-com (list 'vip-put-back val nil vip-use-register)) (vip-loop val (vip-yank text)))) (defun vip-Put-back (arg) "Put back at point/above line." (interactive "P") (let ((val (vip-p-val arg)) (text (if vip-use-register (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9)) (current-kill (- vip-use-register ?1) 'do-not-rotate) (get-register vip-use-register)) (current-kill 0)))) (if (null text) (if vip-use-register (let ((reg vip-use-register)) (setq vip-use-register nil) (error "Nothing in register %c" reg)) (error ""))) (setq vip-use-register nil) (if (vip-end-with-a-newline-p text) (beginning-of-line)) (setq vip-d-com (list 'vip-Put-back val nil vip-use-register)) (vip-loop val (vip-yank text)))) (defun vip-delete-char (arg) "Delete character." (interactive "P") (let ((val (vip-p-val arg))) (setq vip-d-com (list 'vip-delete-char val nil)) (if vip-use-register (progn (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z)) (vip-append-to-register (+ vip-use-register 32) (point) (- (point) val)) (copy-to-register vip-use-register (point) (- (point) val) nil)) (setq vip-use-register nil))) (delete-char val t))) (defun vip-delete-backward-char (arg) "Delete previous character." (interactive "P") (let ((val (vip-p-val arg))) (setq vip-d-com (list 'vip-delete-backward-char val nil)) (if vip-use-register (progn (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z)) (vip-append-to-register (+ vip-use-register 32) (point) (+ (point) val)) (copy-to-register vip-use-register (point) (+ (point) val) nil)) (setq vip-use-register nil))) (delete-backward-char val t))) ;; join lines. (defun vip-join-lines (arg) "Join this line to next, if ARG is nil. Otherwise, join ARG lines" (interactive "*P") (let ((val (vip-P-val arg))) (setq vip-d-com (list 'vip-join-lines val nil)) (vip-loop (if (null val) 1 (1- val)) (progn (end-of-line) (if (not (eobp)) (progn (forward-line 1) (delete-region (point) (1- (point))) (fixup-whitespace))))))) ;; making small changes (defun vip-change (beg end) (setq c-string (vip-read-string (format "%s => " (buffer-substring beg end)))) (vip-change-subr beg end)) (defun vip-change-subr (beg end) (if vip-use-register (progn (copy-to-register vip-use-register beg end nil) (setq vip-use-register nil))) (kill-region beg end) (setq this-command 'vip-change) (insert c-string)) ;; query replace (defun vip-query-replace () "Query replace. If you supply null string as the string to be replaced, the query replace mode will toggle between string replace and regexp replace." (interactive) (let (str) (setq str (vip-read-string (if vip-re-query-replace "Query replace regexp: " "Query replace: "))) (if (string= str "") (progn (setq vip-re-query-replace (not vip-re-query-replace)) (message "Query replace mode changed to %s." (if vip-re-query-replace "regexp replace" "string replace"))) (if vip-re-query-replace (query-replace-regexp str (vip-read-string (format "Query replace regexp \"%s\" with: " str))) (query-replace str (vip-read-string (format "Query replace \"%s\" with: " str))))))) ;; marking (defun vip-mark-beginning-of-buffer () (interactive) (set-mark (point)) (goto-char (point-min)) (exchange-point-and-mark) (message "mark set at the beginning of buffer")) (defun vip-mark-end-of-buffer () (interactive) (set-mark (point)) (goto-char (point-max)) (exchange-point-and-mark) (message "mark set at the end of buffer")) (defun vip-mark-point (char) (interactive "c") (cond ((and (<= ?a char) (<= char ?z)) (point-to-register (- char (- ?a ?\C-a)) nil)) ((= char ?<) (vip-mark-beginning-of-buffer)) ((= char ?>) (vip-mark-end-of-buffer)) ((= char ?.) (push-mark)) ((= char ?,) (set-mark-command 1)) ((= char ?D) (mark-defun)) (t (error "")))) (defun vip-goto-mark (arg) "Go to mark." (interactive "P") (let ((char (read-char)) (com (vip-getcom arg))) (vip-goto-mark-subr char com nil))) (defun vip-goto-mark-and-skip-white (arg) "Go to mark and skip to first non-white on line." (interactive "P") (let ((char (read-char)) (com (vip-getCom arg))) (vip-goto-mark-subr char com t))) (defun vip-goto-mark-subr (char com skip-white) (cond ((and (<= ?a char) (<= char ?z)) (let ((buff (current-buffer))) (if com (move-marker vip-com-point (point))) (goto-char (register-to-point (- char (- ?a ?\C-a)))) (if skip-white (back-to-indentation)) (vip-change-mode-to-vi) (if com (if (equal buff (current-buffer)) (vip-execute-com (if skip-white 'vip-goto-mark-and-skip-white 'vip-goto-mark) nil com) (switch-to-buffer buff) (goto-char vip-com-point) (vip-change-mode-to-vi) (error ""))))) ((and (not skip-white) (= char ?`)) (if com (move-marker vip-com-point (point))) (exchange-point-and-mark) (if com (vip-execute-com 'vip-goto-mark nil com))) ((and skip-white (= char ?')) (if com (move-marker vip-com-point (point))) (exchange-point-and-mark) (back-to-indentation) (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com))) (t (error "")))) (defun vip-exchange-point-and-mark () (interactive) (exchange-point-and-mark) (back-to-indentation)) (defun vip-keyboard-quit () "Abort partially formed or running command." (interactive) (setq vip-use-register nil) (keyboard-quit)) (defun vip-ctl-c-equivalent (arg) "Emulate C-c in Emacs mode." (interactive "P") (vip-ctl-key-equivalent "\C-c" arg)) (defun vip-ctl-x-equivalent (arg) "Emulate C-x in Emacs mode." (interactive "P") (vip-ctl-key-equivalent "\C-x" arg)) (defun vip-ctl-key-equivalent (key arg) (let ((char (read-char))) (if (and (<= ?A char) (<= char ?Z)) (setq char (- char (- ?A ?\C-a)))) (vip-escape-to-emacs arg (list (aref key 0) char)))) ;; commands in insertion mode (defun vip-delete-backward-word (arg) "Delete previous word." (interactive "p") (save-excursion (set-mark (point)) (backward-word arg) (delete-region (point) (mark)))) ;; key bindings (set 'vip-mode-map (make-keymap)) (define-key vip-mode-map "\C-a" 'beginning-of-line) (define-key vip-mode-map "\C-b" 'vip-scroll-back) (define-key vip-mode-map "\C-c" 'vip-ctl-c) (define-key vip-mode-map "\C-d" 'vip-scroll-up) (define-key vip-mode-map "\C-e" 'vip-scroll-up-one) (define-key vip-mode-map "\C-f" 'vip-scroll) (define-key vip-mode-map "\C-g" 'vip-keyboard-quit) (define-key vip-mode-map "\C-h" 'help-command) (define-key vip-mode-map "\C-m" 'vip-scroll-back) (define-key vip-mode-map "\C-n" 'vip-other-window) (define-key vip-mode-map "\C-o" 'vip-open-line-at-point) (define-key vip-mode-map "\C-u" 'vip-scroll-down) (define-key vip-mode-map "\C-x" 'vip-ctl-x) (define-key vip-mode-map "\C-y" 'vip-scroll-down-one) (define-key vip-mode-map "\C-z" 'vip-change-mode-to-emacs) (define-key vip-mode-map "\e" 'vip-ESC) (define-key vip-mode-map " " 'vip-scroll) (define-key vip-mode-map "!" 'vip-command-argument) (define-key vip-mode-map "\"" 'vip-command-argument) (define-key vip-mode-map "#" 'vip-command-argument) (define-key vip-mode-map "$" 'vip-goto-eol) (define-key vip-mode-map "%" 'vip-paren-match) (define-key vip-mode-map "&" 'vip-nil) (define-key vip-mode-map "'" 'vip-goto-mark-and-skip-white) (define-key vip-mode-map "(" 'vip-backward-sentence) (define-key vip-mode-map ")" 'vip-forward-sentence) (define-key vip-mode-map "*" 'call-last-kbd-macro) (define-key vip-mode-map "+" 'vip-next-line-at-bol) (define-key vip-mode-map "," 'vip-repeat-find-opposite) (define-key vip-mode-map "-" 'vip-previous-line-at-bol) (define-key vip-mode-map "." 'vip-repeat) (define-key vip-mode-map "/" 'vip-search-forward) (define-key vip-mode-map "0" 'vip-beginning-of-line) (define-key vip-mode-map "1" 'vip-digit-argument) (define-key vip-mode-map "2" 'vip-digit-argument) (define-key vip-mode-map "3" 'vip-digit-argument) (define-key vip-mode-map "4" 'vip-digit-argument) (define-key vip-mode-map "5" 'vip-digit-argument) (define-key vip-mode-map "6" 'vip-digit-argument) (define-key vip-mode-map "7" 'vip-digit-argument) (define-key vip-mode-map "8" 'vip-digit-argument) (define-key vip-mode-map "9" 'vip-digit-argument) (define-key vip-mode-map ":" 'vip-ex) (define-key vip-mode-map ";" 'vip-repeat-find) (define-key vip-mode-map "<" 'vip-command-argument) (define-key vip-mode-map "=" 'vip-command-argument) (define-key vip-mode-map ">" 'vip-command-argument) (define-key vip-mode-map "?" 'vip-search-backward) (define-key vip-mode-map "@" 'vip-nil) (define-key vip-mode-map "A" 'vip-Append) (define-key vip-mode-map "B" 'vip-backward-Word) (define-key vip-mode-map "C" 'vip-ctl-c-equivalent) (define-key vip-mode-map "D" 'vip-kill-line) (define-key vip-mode-map "E" 'vip-end-of-Word) (define-key vip-mode-map "F" 'vip-find-char-backward) (define-key vip-mode-map "G" 'vip-goto-line) (define-key vip-mode-map "H" 'vip-window-top) (define-key vip-mode-map "I" 'vip-Insert) (define-key vip-mode-map "J" 'vip-join-lines) (define-key vip-mode-map "K" 'vip-kill-buffer) (define-key vip-mode-map "L" 'vip-window-bottom) (define-key vip-mode-map "M" 'vip-window-middle) (define-key vip-mode-map "N" 'vip-search-Next) (define-key vip-mode-map "O" 'vip-Open-line) (define-key vip-mode-map "P" 'vip-Put-back) (define-key vip-mode-map "Q" 'vip-query-replace) (define-key vip-mode-map "R" 'vip-replace-string) (define-key vip-mode-map "S" 'vip-switch-to-buffer-other-window) (define-key vip-mode-map "T" 'vip-goto-char-backward) (define-key vip-mode-map "U" 'vip-nil) (define-key vip-mode-map "V" 'vip-find-file-other-window) (define-key vip-mode-map "W" 'vip-forward-Word) (define-key vip-mode-map "X" 'vip-ctl-x-equivalent) (define-key vip-mode-map "Y" 'vip-yank-line) (define-key vip-mode-map "ZZ" 'save-buffers-kill-emacs) (define-key vip-mode-map "[" 'vip-nil) (define-key vip-mode-map "\\" 'vip-escape-to-emacs) (define-key vip-mode-map "]" 'vip-nil) (define-key vip-mode-map "^" 'vip-bol-and-skip-white) (define-key vip-mode-map "_" 'vip-nil) (define-key vip-mode-map "`" 'vip-goto-mark) (define-key vip-mode-map "a" 'vip-append) (define-key vip-mode-map "b" 'vip-backward-word) (define-key vip-mode-map "c" 'vip-command-argument) (define-key vip-mode-map "d" 'vip-command-argument) (define-key vip-mode-map "e" 'vip-end-of-word) (define-key vip-mode-map "f" 'vip-find-char-forward) (define-key vip-mode-map "g" 'vip-info-on-file) (define-key vip-mode-map "h" 'vip-backward-char) (define-key vip-mode-map "i" 'vip-insert) (define-key vip-mode-map "j" 'vip-next-line) (define-key vip-mode-map "k" 'vip-previous-line) (define-key vip-mode-map "l" 'vip-forward-char) (define-key vip-mode-map "m" 'vip-mark-point) (define-key vip-mode-map "n" 'vip-search-next) (define-key vip-mode-map "o" 'vip-open-line) (define-key vip-mode-map "p" 'vip-put-back) (define-key vip-mode-map "q" 'vip-nil) (define-key vip-mode-map "r" 'vip-replace-char) (define-key vip-mode-map "s" 'vip-switch-to-buffer) (define-key vip-mode-map "t" 'vip-goto-char-forward) (define-key vip-mode-map "u" 'vip-undo) (define-key vip-mode-map "v" 'vip-find-file) (define-key vip-mode-map "w" 'vip-forward-word) (define-key vip-mode-map "x" 'vip-delete-char) (define-key vip-mode-map "y" 'vip-command-argument) (define-key vip-mode-map "zH" 'vip-line-to-top) (define-key vip-mode-map "zM" 'vip-line-to-middle) (define-key vip-mode-map "zL" 'vip-line-to-bottom) (define-key vip-mode-map "z\C-m" 'vip-line-to-top) (define-key vip-mode-map "z." 'vip-line-to-middle) (define-key vip-mode-map "z-" 'vip-line-to-bottom) (define-key vip-mode-map "{" 'vip-backward-paragraph) (define-key vip-mode-map "|" 'vip-goto-col) (define-key vip-mode-map "}" 'vip-forward-paragraph) (define-key vip-mode-map "~" 'vip-nil) (define-key vip-mode-map "\177" 'vip-delete-backward-char) (define-key ctl-x-map "3" 'vip-buffer-in-two-windows) (define-key ctl-x-map "\C-i" 'insert-file) (defun vip-version () (interactive) (message "VIP version 3.5 of September 15, 1987")) ;; implement ex commands (defvar ex-token-type nil "type of token. if non-nil, gives type of address. if nil, it is a command.") (defvar ex-token nil "value of token.") (defvar ex-addresses nil "list of ex addresses") (defvar ex-flag nil "flag for ex flag") (defvar ex-buffer nil "name of ex buffer") (defvar ex-count nil "value of ex count") (defvar ex-g-flag nil "flag for global command") (defvar ex-g-variant nil "if t global command is executed on lines not matching ex-g-pat") (defvar ex-reg-exp nil "save reg-exp used in substitute") (defvar ex-repl nil "replace pattern for substitute") (defvar ex-g-pat nil "pattern for global command") (defvar ex-map (make-sparse-keymap) "save commands for mapped keys") (defvar ex-tag nil "save ex tag") (defvar ex-file nil) (defvar ex-variant nil) (defvar ex-offset nil) (defvar ex-append nil) (defun vip-nil () (interactive) (error "")) (defun vip-looking-back (str) "returns t if looking back reg-exp STR before point." (and (save-excursion (re-search-backward str nil t)) (= (point) (match-end 0)))) (defun vip-check-sub (str) "check if ex-token is an initial segment of STR" (let ((length (length ex-token))) (if (and (<= length (length str)) (string= ex-token (substring str 0 length))) (setq ex-token str) (setq ex-token-type "non-command")))) (defun vip-get-ex-com-subr () "get a complete ex command" (set-mark (point)) (re-search-forward "[a-z][a-z]*") (setq ex-token-type "command") (setq ex-token (buffer-substring (point) (mark))) (exchange-point-and-mark) (cond ((looking-at "a") (cond ((looking-at "ab") (vip-check-sub "abbreviate")) ((looking-at "ar") (vip-check-sub "args")) (t (vip-check-sub "append")))) ((looking-at "[bh]") (setq ex-token-type "non-command")) ((looking-at "c") (if (looking-at "co") (vip-check-sub "copy") (vip-check-sub "change"))) ((looking-at "d") (vip-check-sub "delete")) ((looking-at "e") (if (looking-at "ex") (vip-check-sub "ex") (vip-check-sub "edit"))) ((looking-at "f") (vip-check-sub "file")) ((looking-at "g") (vip-check-sub "global")) ((looking-at "i") (vip-check-sub "insert")) ((looking-at "j") (vip-check-sub "join")) ((looking-at "l") (vip-check-sub "list")) ((looking-at "m") (cond ((looking-at "map") (vip-check-sub "map")) ((looking-at "mar") (vip-check-sub "mark")) (t (vip-check-sub "move")))) ((looking-at "n") (if (looking-at "nu") (vip-check-sub "number") (vip-check-sub "next"))) ((looking-at "o") (vip-check-sub "open")) ((looking-at "p") (cond ((looking-at "pre") (vip-check-sub "preserve")) ((looking-at "pu") (vip-check-sub "put")) (t (vip-check-sub "print")))) ((looking-at "q") (vip-check-sub "quit")) ((looking-at "r") (cond ((looking-at "rec") (vip-check-sub "recover")) ((looking-at "rew") (vip-check-sub "rewind")) (t (vip-check-sub "read")))) ((looking-at "s") (cond ((looking-at "se") (vip-check-sub "set")) ((looking-at "sh") (vip-check-sub "shell")) ((looking-at "so") (vip-check-sub "source")) ((looking-at "st") (vip-check-sub "stop")) (t (vip-check-sub "substitute")))) ((looking-at "t") (if (looking-at "ta") (vip-check-sub "tag") (vip-check-sub "t"))) ((looking-at "u") (cond ((looking-at "una") (vip-check-sub "unabbreviate")) ((looking-at "unm") (vip-check-sub "unmap")) (t (vip-check-sub "undo")))) ((looking-at "v") (cond ((looking-at "ve") (vip-check-sub "version")) ((looking-at "vi") (vip-check-sub "visual")) (t (vip-check-sub "v")))) ((looking-at "w") (if (looking-at "wq") (vip-check-sub "wq") (vip-check-sub "write"))) ((looking-at "x") (vip-check-sub "xit")) ((looking-at "y") (vip-check-sub "yank")) ((looking-at "z") (vip-check-sub "z"))) (exchange-point-and-mark)) (defun vip-get-ex-token () "get an ex-token which is either an address or a command. a token has type \(command, address, end-mark\) and value." (save-window-excursion (set-buffer " *ex-working-space*") (skip-chars-forward " \t") (cond ((looking-at "[k#]") (setq ex-token-type "command") (setq ex-token (char-to-string (following-char))) (forward-char 1)) ((looking-at "[a-z]") (vip-get-ex-com-subr)) ((looking-at "\\.") (forward-char 1) (setq ex-token-type "dot")) ((looking-at "[0-9]") (set-mark (point)) (re-search-forward "[0-9]*") (setq ex-token-type (cond ((string= ex-token-type "plus") "add-number") ((string= ex-token-type "minus") "sub-number") (t "abs-number"))) (setq ex-token (string-to-int (buffer-substring (point) (mark))))) ((looking-at "\\$") (forward-char 1) (setq ex-token-type "end")) ((looking-at "%") (forward-char 1) (setq ex-token-type "whole")) ((looking-at "+") (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]")) (forward-char 1) (insert "1") (backward-char 1) (setq ex-token-type "plus")) ((looking-at "+[0-9]") (forward-char 1) (setq ex-token-type "plus")) (t (error "Badly formed address")))) ((looking-at "-") (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]")) (forward-char 1) (insert "1") (backward-char 1) (setq ex-token-type "minus")) ((looking-at "-[0-9]") (forward-char 1) (setq ex-token-type "minus")) (t (error "Badly formed address")))) ((looking-at "/") (forward-char 1) (set-mark (point)) (let ((cont t)) (while (and (not (eolp)) cont) ;;(re-search-forward "[^/]*/") (re-search-forward "[^/]*\\(/\\|\n\\)") (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) (setq cont nil)))) (backward-char 1) (setq ex-token (buffer-substring (point) (mark))) (if (looking-at "/") (forward-char 1)) (setq ex-token-type "search-forward")) ((looking-at "\\?") (forward-char 1) (set-mark (point)) (let ((cont t)) (while (and (not (eolp)) cont) ;;(re-search-forward "[^\\?]*\\?") (re-search-forward "[^\\?]*\\(\\?\\|\n\\)") (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?")) (setq cont nil)) (backward-char 1) (if (not (looking-at "\n")) (forward-char 1)))) (setq ex-token-type "search-backward") (setq ex-token (buffer-substring (1- (point)) (mark)))) ((looking-at ",") (forward-char 1) (setq ex-token-type "comma")) ((looking-at ";") (forward-char 1) (setq ex-token-type "semi-colon")) ((looking-at "[!=><&~]") (setq ex-token-type "command") (setq ex-token (char-to-string (following-char))) (forward-char 1)) ((looking-at "'") (setq ex-token-type "goto-mark") (forward-char 1) (cond ((looking-at "'") (setq ex-token nil)) ((looking-at "[a-z]") (setq ex-token (following-char))) (t (error "Marks are ' and a-z"))) (forward-char 1)) ((looking-at "\n") (setq ex-token-type "end-mark") (setq ex-token "goto")) (t (error "illegal token"))))) (defun vip-ex (&optional string) "ex commands within VIP." (interactive) (or string (setq ex-g-flag nil ex-g-variant nil)) (let ((com-str (or string (vip-read-string ":"))) (address nil) (cont t) (dot (point))) (save-window-excursion (set-buffer (get-buffer-create " *ex-working-space*")) (delete-region (point-min) (point-max)) (insert com-str "\n") (goto-char (point-min))) (setq ex-token-type "") (setq ex-addresses nil) (while cont (vip-get-ex-token) (cond ((or (string= ex-token-type "command") (string= ex-token-type "end-mark")) (if address (setq ex-addresses (cons address ex-addresses))) (cond ((string= ex-token "global") (ex-global nil) (setq cont nil)) ((string= ex-token "v") (ex-global t) (setq cont nil)) (t (vip-execute-ex-command) (save-window-excursion (set-buffer " *ex-working-space*") (skip-chars-forward " \t") (cond ((looking-at "|") (forward-char 1)) ((looking-at "\n") (setq cont nil)) (t (error "Extra character at end of a command"))))))) ((string= ex-token-type "non-command") (error (format "%s: Not an editor command" ex-token))) ((string= ex-token-type "whole") (setq ex-addresses (cons (point-max) (cons (point-min) ex-addresses)))) ((string= ex-token-type "comma") (setq ex-addresses (cons (if (null address) (point) address) ex-addresses))) ((string= ex-token-type "semi-colon") (if address (setq dot address)) (setq ex-addresses (cons (if (null address) (point) address) ex-addresses))) (t (let ((ans (vip-get-ex-address-subr address dot))) (if ans (setq address ans)))))))) (defun vip-get-ex-pat () "get a regular expression and set ex-variant if found" (save-window-excursion (set-buffer " *ex-working-space*") (skip-chars-forward " \t") (if (looking-at "!") (progn (setq ex-g-variant (not ex-g-variant) ex-g-flag (not ex-g-flag)) (forward-char 1) (skip-chars-forward " \t"))) (if (looking-at "/") (progn (forward-char 1) (set-mark (point)) (let ((cont t)) (while (and (not (eolp)) cont) (re-search-forward "[^/]*\\(/\\|\n\\)") ;;(re-search-forward "[^/]*/") (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) (setq cont nil)))) (setq ex-token (if (= (mark) (point)) "" (buffer-substring (1- (point)) (mark)))) (backward-char 1)) (setq ex-token nil)))) (defun vip-get-ex-command () "get an ex command" (save-window-excursion (set-buffer " *ex-working-space*") (if (looking-at "/") (forward-char 1)) (skip-chars-forward " \t") (cond ((looking-at "[a-z]") (vip-get-ex-com-subr) (if (string= ex-token-type "non-command") (error "%s: not an editor command" ex-token))) ((looking-at "[!=><&~]") (setq ex-token (char-to-string (following-char))) (forward-char 1)) (t (error "Could not find an ex command"))))) (defun vip-get-ex-opt-gc () "get an ex option g or c" (save-window-excursion (set-buffer " *ex-working-space*") (if (looking-at "/") (forward-char 1)) (skip-chars-forward " \t") (cond ((looking-at "g") (setq ex-token "g") (forward-char 1) t) ((looking-at "c") (setq ex-token "c") (forward-char 1) t) (t nil)))) (defun vip-default-ex-addresses (&optional whole-flag) "compute default addresses. whole-flag means whole buffer." (cond ((null ex-addresses) (setq ex-addresses (if whole-flag (cons (point-max) (cons (point-min) nil)) (cons (point) (cons (point) nil))))) ((null (cdr ex-addresses)) (setq ex-addresses (cons (car ex-addresses) ex-addresses))))) (defun vip-get-ex-address () "get an ex-address as a marker and set ex-flag if a flag is found" (let ((address (point-marker)) (cont t)) (setq ex-token "") (setq ex-flag nil) (while cont (vip-get-ex-token) (cond ((string= ex-token-type "command") (if (or (string= ex-token "print") (string= ex-token "list") (string= ex-token "#")) (progn (setq ex-flag t) (setq cont nil)) (error "address expected"))) ((string= ex-token-type "end-mark") (setq cont nil)) ((string= ex-token-type "whole") (error "a trailing address is expected")) ((string= ex-token-type "comma") (error "Extra characters after an address")) (t (let ((ans (vip-get-ex-address-subr address (point-marker)))) (if ans (setq address ans)))))) address)) (defun vip-get-ex-address-subr (old-address dot) "returns an address as a point" (let ((address nil)) (if (null old-address) (setq old-address dot)) (cond ((string= ex-token-type "dot") (setq address dot)) ((string= ex-token-type "add-number") (save-excursion (goto-char old-address) (forward-line (if (= old-address 0) (1- ex-token) ex-token)) (setq address (point-marker)))) ((string= ex-token-type "sub-number") (save-excursion (goto-char old-address) (forward-line (- ex-token)) (setq address (point-marker)))) ((string= ex-token-type "abs-number") (save-excursion (goto-char (point-min)) (if (= ex-token 0) (setq address 0) (forward-line (1- ex-token)) (setq address (point-marker))))) ((string= ex-token-type "end") (setq address (point-max-marker))) ((string= ex-token-type "plus") t);; do nothing ((string= ex-token-type "minus") t);; do nothing ((string= ex-token-type "search-forward") (save-excursion (ex-search-address t) (setq address (point-marker)))) ((string= ex-token-type "search-backward") (save-excursion (ex-search-address nil) (setq address (point-marker)))) ((string= ex-token-type "goto-mark") (save-excursion (if (null ex-token) (exchange-point-and-mark) (goto-char (register-to-point (- ex-token (- ?a ?\C-a))))) (setq address (point-marker))))) address)) (defun ex-search-address (forward) "search pattern and set address" (if (string= ex-token "") (if (null vip-s-string) (error "No previous search string") (setq ex-token vip-s-string)) (setq vip-s-string ex-token)) (if forward (progn (forward-line 1) (re-search-forward ex-token)) (forward-line -1) (re-search-backward ex-token))) (defun vip-get-ex-buffer () "get a buffer name and set ex-count and ex-flag if found" (setq ex-buffer nil) (setq ex-count nil) (setq ex-flag nil) (save-window-excursion (set-buffer " *ex-working-space*") (skip-chars-forward " \t") (if (looking-at "[a-zA-Z]") (progn (setq ex-buffer (following-char)) (forward-char 1) (skip-chars-forward " \t"))) (if (looking-at "[0-9]") (progn (set-mark (point)) (re-search-forward "[0-9][0-9]*") (setq ex-count (string-to-int (buffer-substring (point) (mark)))) (skip-chars-forward " \t"))) (if (looking-at "[pl#]") (progn (setq ex-flag t) (forward-char 1))) (if (not (looking-at "[\n|]")) (error "Illegal extra characters")))) (defun vip-get-ex-count () (setq ex-variant nil ex-count nil ex-flag nil) (save-window-excursion (set-buffer " *ex-working-space*") (skip-chars-forward " \t") (if (looking-at "!") (progn (setq ex-variant t) (forward-char 1))) (skip-chars-forward " \t") (if (looking-at "[0-9]") (progn (set-mark (point)) (re-search-forward "[0-9][0-9]*") (setq ex-count (string-to-int (buffer-substring (point) (mark)))) (skip-chars-forward " \t"))) (if (looking-at "[pl#]") (progn (setq ex-flag t) (forward-char 1))) (if (not (looking-at "[\n|]")) (error "Illegal extra characters")))) (defun vip-get-ex-file () "get a file name and set ex-variant, ex-append and ex-offset if found" (setq ex-file nil ex-variant nil ex-append nil ex-offset nil) (save-window-excursion (set-buffer " *ex-working-space*") (skip-chars-forward " \t") (if (looking-at "!") (progn (setq ex-variant t) (forward-char 1) (skip-chars-forward " \t"))) (if (looking-at ">>") (progn (setq ex-append t ex-variant t) (forward-char 2) (skip-chars-forward " \t"))) (if (looking-at "+") (progn (forward-char 1) (set-mark (point)) (re-search-forward "[ \t\n]") (backward-char 1) (setq ex-offset (buffer-substring (point) (mark))) (forward-char 1) (skip-chars-forward " \t"))) (set-mark (point)) (re-search-forward "[ \t\n]") (backward-char 1) (setq ex-file (buffer-substring (point) (mark))))) (defun vip-execute-ex-command () "execute ex command using the value of addresses." (cond ((string= ex-token "goto") (ex-goto)) ((string= ex-token "copy") (ex-copy nil)) ((string= ex-token "delete") (ex-delete)) ((string= ex-token "edit") (ex-edit)) ((string= ex-token "file") (vip-info-on-file)) ;((string= ex-token "global") (ex-global nil)) ((string= ex-token "join") (ex-line "join")) ((string= ex-token "k") (ex-mark)) ((string= ex-token "mark") (ex-mark)) ((string= ex-token "map") (ex-map)) ((string= ex-token "move") (ex-copy t)) ((string= ex-token "put") (ex-put)) ((string= ex-token "quit") (ex-quit)) ((string= ex-token "read") (ex-read)) ((string= ex-token "set") (ex-set)) ((string= ex-token "shell") (ex-shell)) ((string= ex-token "substitute") (ex-substitute)) ((string= ex-token "stop") (suspend-emacs)) ((string= ex-token "t") (ex-copy nil)) ((string= ex-token "tag") (ex-tag)) ((string= ex-token "undo") (vip-undo)) ((string= ex-token "unmap") (ex-unmap)) ;((string= ex-token "v") (ex-global t)) ((string= ex-token "version") (vip-version)) ((string= ex-token "visual") (ex-edit)) ((string= ex-token "write") (ex-write nil)) ((string= ex-token "wq") (ex-write t)) ((string= ex-token "yank") (ex-yank)) ((string= ex-token "!") (ex-command)) ((string= ex-token "=") (ex-line-no)) ((string= ex-token ">") (ex-line "right")) ((string= ex-token "<") (ex-line "left")) ((string= ex-token "&") (ex-substitute t)) ((string= ex-token "~") (ex-substitute t t)) ((or (string= ex-token "append") (string= ex-token "args") (string= ex-token "change") (string= ex-token "insert") (string= ex-token "open") ) (error (format "%s: no such command from VIP" ex-token))) ((or (string= ex-token "abbreviate") (string= ex-token "list") (string= ex-token "next") (string= ex-token "print") (string= ex-token "preserve") (string= ex-token "recover") (string= ex-token "rewind") (string= ex-token "source") (string= ex-token "unabbreviate") (string= ex-token "xit") (string= ex-token "z") ) (error (format "%s: not implemented in VIP" ex-token))) (t (error (format "%s: Not an editor command" ex-token))))) (defun ex-goto () "ex goto command" (if (null ex-addresses) (setq ex-addresses (cons (point) nil))) (push-mark (point)) (goto-char (car ex-addresses)) (beginning-of-line)) (defun ex-copy (del-flag) "ex copy and move command. DEL-FLAG means delete." (vip-default-ex-addresses) (let ((address (vip-get-ex-address)) (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) (goto-char end) (save-excursion (set-mark beg) (vip-enlarge-region (mark) (point)) (if del-flag (kill-region (point) (mark)) (copy-region-as-kill (point) (mark))) (if ex-flag (progn (with-output-to-temp-buffer "*copy text*" (princ (if (or del-flag ex-g-flag ex-g-variant) (current-kill 0) (buffer-substring (point) (mark))))) (condition-case nil (progn (vip-read-string "[Hit return to continue] ") (save-excursion (kill-buffer "*copy text*"))) (quit (save-excursion (kill-buffer "*copy text*")) (signal 'quit nil)))))) (if (= address 0) (goto-char (point-min)) (goto-char address) (forward-line 1)) (insert (current-kill 0)))) (defun ex-delete () "ex delete" (vip-default-ex-addresses) (vip-get-ex-buffer) (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) (if (> beg end) (error "First address exceeds second")) (save-excursion (vip-enlarge-region beg end) (exchange-point-and-mark) (if ex-count (progn (set-mark (point)) (forward-line (1- ex-count))) (set-mark end)) (vip-enlarge-region (point) (mark)) (if ex-flag ;; show text to be deleted and ask for confirmation (progn (with-output-to-temp-buffer " *delete text*" (princ (buffer-substring (point) (mark)))) (condition-case conditions (vip-read-string "[Hit return to continue] ") (quit (save-excursion (kill-buffer " *delete text*")) (error ""))) (save-excursion (kill-buffer " *delete text*"))) (if ex-buffer (if (and (<= ?A ex-buffer) (<= ex-buffer ?Z)) (vip-append-to-register (+ ex-buffer 32) (point) (mark)) (copy-to-register ex-buffer (point) (mark) nil))) (delete-region (point) (mark)))))) (defun ex-edit () "ex-edit" (vip-get-ex-file) (if (and (not ex-variant) (buffer-modified-p) buffer-file-name) (error "No write since last change \(:e! overrides\)")) (vip-change-mode-to-emacs) (set-buffer (find-file-noselect (concat default-directory ex-file))) (vip-change-mode-to-vi) (goto-char (point-min)) (if ex-offset (progn (save-window-excursion (set-buffer " *ex-working-space*") (delete-region (point-min) (point-max)) (insert ex-offset "\n") (goto-char (point-min))) (goto-char (vip-get-ex-address)) (beginning-of-line)))) (defun ex-global (variant) "ex global command" (if (or ex-g-flag ex-g-variant) (error "Global within global not allowed") (if variant (setq ex-g-flag nil ex-g-variant t) (setq ex-g-flag t ex-g-variant nil))) (vip-get-ex-pat) (if (null ex-token) (error "Missing regular expression for global command")) (if (string= ex-token "") (if (null vip-s-string) (error "No previous search string") (setq ex-g-pat vip-s-string)) (setq ex-g-pat ex-token vip-s-string ex-token)) (if (null ex-addresses) (setq ex-addresses (list (point-max) (point-min)))) (let ((marks nil) (mark-count 0) com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) (if (> beg end) (error "First address exceeds second")) (save-excursion (vip-enlarge-region beg end) (exchange-point-and-mark) (let ((cont t) (limit (point-marker))) (exchange-point-and-mark) ;; skip the last line if empty (beginning-of-line) (if (and (eobp) (not (bobp))) (backward-char 1)) (while (and cont (not (bobp)) (>= (point) limit)) (beginning-of-line) (set-mark (point)) (end-of-line) (let ((found (re-search-backward ex-g-pat (mark) t))) (if (or (and ex-g-flag found) (and ex-g-variant (not found))) (progn (end-of-line) (setq mark-count (1+ mark-count)) (setq marks (cons (point-marker) marks))))) (beginning-of-line) (if (bobp) (setq cont nil) (forward-line -1) (end-of-line))))) (save-window-excursion (set-buffer " *ex-working-space*") (setq com-str (buffer-substring (1+ (point)) (1- (point-max))))) (while marks (goto-char (car marks)) ; report progress of execution on a slow machine. ;(message "Executing global command...") ;(if (zerop (% mark-count 10)) ;(message "Executing global command...%d" mark-count)) (vip-ex com-str) (setq mark-count (1- mark-count)) (setq marks (cdr marks))))) ;(message "Executing global command...done"))) (defun ex-line (com) "ex line commands. COM is join, shift-right or shift-left." (vip-default-ex-addresses) (vip-get-ex-count) (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point) (if (> beg end) (error "First address exceeds second")) (save-excursion (vip-enlarge-region beg end) (exchange-point-and-mark) (if ex-count (progn (set-mark (point)) (forward-line ex-count))) (if ex-flag ;; show text to be joined and ask for confirmation (progn (with-output-to-temp-buffer " *text*" (princ (buffer-substring (point) (mark)))) (condition-case conditions (progn (vip-read-string "[Hit return to continue] ") (ex-line-subr com (point) (mark))) (quit (ding))) (save-excursion (kill-buffer " *text*"))) (ex-line-subr com (point) (mark))) (setq point (point))) (goto-char (1- point)) (beginning-of-line))) (defun ex-line-subr (com beg end) (cond ((string= com "join") (goto-char (min beg end)) (while (and (not (eobp)) (< (point) (max beg end))) (end-of-line) (if (and (<= (point) (max beg end)) (not (eobp))) (progn (forward-line 1) (delete-region (point) (1- (point))) (if (not ex-variant) (fixup-whitespace)))))) ((or (string= com "right") (string= com "left")) (indent-rigidly (min beg end) (max beg end) (if (string= com "right") vip-shift-width (- vip-shift-width))) (goto-char (max beg end)) (end-of-line) (forward-char 1)))) (defun ex-mark () "ex mark" (let (char) (if (null ex-addresses) (setq ex-addresses (cons (point) nil))) (save-window-excursion (set-buffer " *ex-working-space*") (skip-chars-forward " \t") (if (looking-at "[a-z]") (progn (setq char (following-char)) (forward-char 1) (skip-chars-forward " \t") (if (not (looking-at "[\n|]")) (error "Extra characters at end of \"k\" command"))) (if (looking-at "[\n|]") (error "\"k\" requires a following letter") (error "Mark must specify a letter")))) (save-excursion (goto-char (car ex-addresses)) (point-to-register (- char (- ?a ?\C-a)) nil)))) (defun ex-map () "ex map" (let (char string) (save-window-excursion (set-buffer " *ex-working-space*") (skip-chars-forward " \t") (setq char (char-to-string (following-char))) (forward-char 1) (skip-chars-forward " \t") (if (looking-at "[\n|]") (error "Missing rhs")) (set-mark (point)) (end-of-buffer) (backward-char 1) (setq string (buffer-substring (mark) (point)))) (if (not (lookup-key ex-map char)) (define-key ex-map char (or (lookup-key vip-mode-map char) 'vip-nil))) (define-key vip-mode-map char (eval (list 'quote (cons 'lambda (list '(count) '(interactive "p") (list 'execute-kbd-macro string 'count)))))))) (defun ex-unmap () "ex unmap" (let (char) (save-window-excursion (set-buffer " *ex-working-space*") (skip-chars-forward " \t") (setq char (char-to-string (following-char))) (forward-char 1) (skip-chars-forward " \t") (if (not (looking-at "[\n|]")) (error "Macro must be a character"))) (if (not (lookup-key ex-map char)) (error "That macro wasn't mapped")) (define-key vip-mode-map char (lookup-key ex-map char)) (define-key ex-map char nil))) (defun ex-put () "ex put" (let ((point (if (null ex-addresses) (point) (car ex-addresses)))) (vip-get-ex-buffer) (setq vip-use-register ex-buffer) (goto-char point) (if (= point 0) (vip-Put-back 1) (vip-put-back 1)))) (defun ex-quit () "ex quit" (let (char) (save-window-excursion (set-buffer " *ex-working-space*") (skip-chars-forward " \t") (setq char (following-char))) (if (= char ?!) (kill-emacs t) (save-buffers-kill-emacs)))) (defun ex-read () "ex read" (let ((point (if (null ex-addresses) (point) (car ex-addresses))) (variant nil) command file) (goto-char point) (if (not (= point 0)) (next-line 1)) (beginning-of-line) (save-window-excursion (set-buffer " *ex-working-space*") (skip-chars-forward " \t") (if (looking-at "!") (progn (setq variant t) (forward-char 1) (skip-chars-forward " \t") (set-mark (point)) (end-of-line) (setq command (buffer-substring (mark) (point)))) (set-mark (point)) (re-search-forward "[ \t\n]") (backward-char 1) (setq file (buffer-substring (point) (mark))))) (if variant (shell-command command t) (insert-file file)))) (defun ex-set () (eval (list 'setq (read-variable "Variable: ") (eval (read-minibuffer "Value: "))))) (defun ex-shell () "ex shell" (vip-change-mode-to-emacs) (shell)) (defun ex-substitute (&optional repeat r-flag) "ex substitute. If REPEAT use previous reg-exp which is ex-reg-exp or vip-s-string" (let (pat repl (opt-g nil) (opt-c nil) (matched-pos nil)) (if repeat (setq ex-token nil) (vip-get-ex-pat)) (if (null ex-token) (setq pat (if r-flag vip-s-string ex-reg-exp) repl ex-repl) (setq pat (if (string= ex-token "") vip-s-string ex-token)) (setq vip-s-string pat ex-reg-exp pat) (vip-get-ex-pat) (if (null ex-token) (setq ex-token "" ex-repl "") (setq repl ex-token ex-repl ex-token))) (while (vip-get-ex-opt-gc) (if (string= ex-token "g") (setq opt-g t) (setq opt-c t))) (vip-get-ex-count) (if ex-count (save-excursion (if ex-addresses (goto-char (car ex-addresses))) (set-mark (point)) (forward-line (1- ex-count)) (setq ex-addresses (cons (point) (cons (mark) nil)))) (if (null ex-addresses) (setq ex-addresses (cons (point) (cons (point) nil))) (if (null (cdr ex-addresses)) (setq ex-addresses (cons (car ex-addresses) ex-addresses))))) ;(setq G opt-g) (let ((beg (car ex-addresses)) (end (car (cdr ex-addresses))) (cont t) eol-mark) (save-excursion (vip-enlarge-region beg end) (let ((limit (save-excursion (goto-char (max (point) (mark))) (point-marker)))) (goto-char (min (point) (mark))) (while (< (point) limit) (end-of-line) (setq eol-mark (point-marker)) (beginning-of-line) (if opt-g (progn (while (and (not (eolp)) (re-search-forward pat eol-mark t)) (if (or (not opt-c) (y-or-n-p "Replace? ")) (progn (setq matched-pos (point)) (replace-match repl)))) (end-of-line) (forward-char)) (if (and (re-search-forward pat eol-mark t) (or (not opt-c) (y-or-n-p "Replace? "))) (progn (setq matched-pos (point)) (replace-match repl))) (end-of-line) (forward-char)))))) (if matched-pos (goto-char matched-pos)) (beginning-of-line) (if opt-c (message "done")))) (defun ex-tag () "ex tag" (let (tag) (save-window-excursion (set-buffer " *ex-working-space*") (skip-chars-forward " \t") (set-mark (point)) (skip-chars-forward "^ |\t\n") (setq tag (buffer-substring (mark) (point)))) (if (not (string= tag "")) (setq ex-tag tag)) (vip-change-mode-to-emacs) (condition-case conditions (progn (if (string= tag "") (find-tag ex-tag t) (find-tag-other-window ex-tag)) (vip-change-mode-to-vi)) (error (vip-change-mode-to-vi) (vip-message-conditions conditions))))) (defun ex-write (q-flag) "ex write" (vip-default-ex-addresses t) (vip-get-ex-file) (if (string= ex-file "") (progn (if (null buffer-file-name) (error "No file associated with this buffer")) (setq ex-file buffer-file-name)) (setq ex-file (expand-file-name ex-file))) (if (and (not (string= ex-file (buffer-file-name))) (file-exists-p ex-file) (not ex-variant)) (error (format "\"%s\" File exists - use w! to override" ex-file))) (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) (if (> beg end) (error "First address exceeds second")) (save-excursion (vip-enlarge-region beg end) (write-region (point) (mark) ex-file ex-append t))) (if (null buffer-file-name) (setq buffer-file-name ex-file)) (if q-flag (save-buffers-kill-emacs))) (defun ex-yank () "ex yank" (vip-default-ex-addresses) (vip-get-ex-buffer) (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) (if (> beg end) (error "First address exceeds second")) (save-excursion (vip-enlarge-region beg end) (exchange-point-and-mark) (if (or ex-g-flag ex-g-variant) (error "Can't yank within global")) (if ex-count (progn (set-mark (point)) (forward-line (1- ex-count))) (set-mark end)) (vip-enlarge-region (point) (mark)) (if ex-flag (error "Extra characters at end of command")) (if ex-buffer (copy-to-register ex-buffer (point) (mark) nil)) (copy-region-as-kill (point) (mark))))) (defun ex-command () "execute shell command" (let (command) (save-window-excursion (set-buffer " *ex-working-space*") (skip-chars-forward " \t") (set-mark (point)) (end-of-line) (setq command (buffer-substring (mark) (point)))) (if (null ex-addresses) (shell-command command) (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) (if (null beg) (setq beg end)) (save-excursion (goto-char beg) (set-mark end) (vip-enlarge-region (point) (mark)) (shell-command-on-region (point) (mark) command t)) (goto-char beg))))) (defun ex-line-no () "print line number" (message "%d" (1+ (count-lines (point-min) (if (null ex-addresses) (point-max) (car ex-addresses)))))) (if (file-exists-p "~/.vip") (load "~/.vip")) ;;; vip.el ends here emacs-19.30/lisp/viper-ex.el100444 12120 1 172525 6045206053 14204 0ustar rmsdaemon;;; viper-ex.el --- functions implementing the Ex commands for Viper ;; Copyright (C) 1994, 1995 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. (require 'viper-util) ;;; Variables (defconst vip-ex-work-buf-name " *ex-working-space*") (defconst vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (defconst vip-ex-tmp-buf-name " *ex-tmp*") ;;; Variable completion in :set command ;; The list of Ex commands. Used for completing command names. (defconst ex-token-alist '(("!") ("=") (">") ("&") ("~") ("yank") ("xit") ("WWrite") ("Write") ("write") ("wq") ("visual") ("version") ("vglobal") ("unmap") ("undo") ("tag") ("transfer") ("suspend") ("substitute") ("submitReport") ("stop") ("sr") ("source") ("shell") ("set") ("rewind") ("recover") ("read") ("quit") ("pwd") ("put") ("preserve") ("PreviousRelatedFile") ("RelatedFile") ("next") ("Next") ("move") ("mark") ("map") ("kmark") ("join") ("help") ("goto") ("global") ("file") ("edit") ("delete") ("copy") ("chdir") ("cd") ("Buffer") ("buffer") ("args")) ) ;; A-list of Ex variables that can be set using the :set command. (defconst ex-variable-alist '(("wrapscan") ("ws") ("wrapmargin") ("wm") ("tab-stop-local") ("tsl") ("tabstop") ("ts") ("showmatch") ("sm") ("shiftwidth") ("sw") ("shell") ("sh") ("readonly") ("ro") ("nowrapscan") ("nows") ("noshowmatch") ("nosm") ("noreadonly") ("noro") ("nomagic") ("noma") ("noignorecase") ("noic") ("noautoindent") ("noai") ("magic") ("ma") ("ignorecase") ("ic") ("autoindent") ("ai") )) ;; Token recognized during parsing of Ex commands (e.g., "read", "comma") (defvar ex-token nil) ;; Type of token. ;; If non-nil, gives type of address; if nil, it is a command. (defvar ex-token-type nil) ;; List of addresses passed to Ex command (defvar ex-addresses nil) ;; It seems that this flag is used only for `#', `print', and `list', which ;; aren't implemented. Check later. (defvar ex-flag nil) ;; "buffer" where Ex commands keep deleted data. ;; In Emacs terms, this is a register. (defvar ex-buffer nil) ;; Value of ex count. (defvar ex-count nil) ;; Flag for global command. (defvar ex-g-flag nil) ;; If t, global command is executed on lines not matching ex-g-pat. (defvar ex-g-variant nil) ;; Save reg-exp used in substitute. (defvar ex-reg-exp nil) ;; Replace pattern for substitute. (defvar ex-repl nil) ;; Pattern for global command. (defvar ex-g-pat nil) ;; `sh' doesn't seem to expand wildcards, like `*' (defconst ex-find-file-shell "csh" "Shell in which to interpret wildcards. Must be csh, tcsh, or similar. Bourne shell doesn't seem to work here.") (defvar ex-find-file-shell-options "-f" "*Options to pass to `ex-find-file-shell'.") ;; Remembers the previous Ex tag. (defvar ex-tag nil) ;; file used by Ex commands like :r, :w, :n (defvar ex-file nil) ;; If t, tells Ex that this is a variant-command, i.e., w>>, r!, etc. (defvar ex-variant nil) ;; Specified the offset of an Ex command, such as :read. (defvar ex-offset nil) ;; Tells Ex that this is a w>> command. (defvar ex-append nil) ;; File containing the shell command to be executed at Ex prompt, ;; e.g., :r !date (defvar ex-cmdfile nil) ;; flag used in vip-ex-read-file-name to indicate that we may be reading ;; multiple file names. Used for :edit and :next (defvar vip-keep-reading-filename nil) (defconst ex-cycle-other-window t "*If t, :n and :b cycles through files and buffers in other window. Then :N and :B cycles in the current window. If nil, this behavior is reversed.") (defconst ex-cycle-through-non-files nil "*Cycle through *scratch* and other buffers that don't visit any file.") ;; Last shell command executed with :! command. (defvar vip-ex-last-shell-com nil) ;; Indicates if Minibuffer was exited temporarily in Ex-command. (defvar vip-incomplete-ex-cmd nil) ;; Remembers the last ex-command prompt. (defvar vip-last-ex-prompt "") ;;; Code ;; Check if ex-token is an initial segment of STR (defun vip-check-sub (str) (let ((length (length ex-token))) (if (and (<= length (length str)) (string= ex-token (substring str 0 length))) (setq ex-token str) (setq ex-token-type 'non-command)))) ;; Get a complete ex command (defun vip-get-ex-com-subr () (let (case-fold-search) (set-mark (point)) (re-search-forward "[a-zA-Z][a-zA-Z]*") (setq ex-token-type 'command) (setq ex-token (buffer-substring (point) (mark t))) (exchange-point-and-mark) (cond ((looking-at "a") (cond ((looking-at "ab") (vip-check-sub "abbreviate")) ((looking-at "ar") (vip-check-sub "args")) (t (vip-check-sub "append")))) ((looking-at "h") (vip-check-sub "help")) ((looking-at "c") (cond ((looking-at "cd") (vip-check-sub "cd")) ((looking-at "ch") (vip-check-sub "chdir")) ((looking-at "co") (vip-check-sub "copy")) (t (vip-check-sub "change")))) ((looking-at "d") (vip-check-sub "delete")) ((looking-at "b") (vip-check-sub "buffer")) ((looking-at "B") (vip-check-sub "Buffer")) ((looking-at "e") (if (looking-at "ex") (vip-check-sub "ex") (vip-check-sub "edit"))) ((looking-at "f") (vip-check-sub "file")) ((looking-at "g") (vip-check-sub "global")) ((looking-at "i") (vip-check-sub "insert")) ((looking-at "j") (vip-check-sub "join")) ((looking-at "l") (vip-check-sub "list")) ((looking-at "m") (cond ((looking-at "map") (vip-check-sub "map")) ((looking-at "mar") (vip-check-sub "mark")) (t (vip-check-sub "move")))) ((looking-at "k[a-z][^a-z]") (setq ex-token "kmark") (forward-char 1) (exchange-point-and-mark)) ; this is canceled out by another ; exchange-point-and-mark at the end ((looking-at "k") (vip-check-sub "kmark")) ((looking-at "n") (if (looking-at "nu") (vip-check-sub "number") (vip-check-sub "next"))) ((looking-at "N") (vip-check-sub "Next")) ((looking-at "o") (vip-check-sub "open")) ((looking-at "p") (cond ((looking-at "pre") (vip-check-sub "preserve")) ((looking-at "pu") (vip-check-sub "put")) ((looking-at "pw") (vip-check-sub "pwd")) (t (vip-check-sub "print")))) ((looking-at "P") (vip-check-sub "PreviousRelatedFile")) ((looking-at "R") (vip-check-sub "RelatedFile")) ((looking-at "q") (vip-check-sub "quit")) ((looking-at "r") (cond ((looking-at "rec") (vip-check-sub "recover")) ((looking-at "rew") (vip-check-sub "rewind")) (t (vip-check-sub "read")))) ((looking-at "s") (cond ((looking-at "se") (vip-check-sub "set")) ((looking-at "sh") (vip-check-sub "shell")) ((looking-at "so") (vip-check-sub "source")) ((looking-at "sr") (vip-check-sub "sr")) ((looking-at "st") (vip-check-sub "stop")) ((looking-at "sus") (vip-check-sub "suspend")) ((looking-at "subm") (vip-check-sub "submitReport")) (t (vip-check-sub "substitute")))) ((looking-at "t") (if (looking-at "ta") (vip-check-sub "tag") (vip-check-sub "transfer"))) ((looking-at "u") (cond ((looking-at "una") (vip-check-sub "unabbreviate")) ((looking-at "unm") (vip-check-sub "unmap")) (t (vip-check-sub "undo")))) ((looking-at "v") (cond ((looking-at "ve") (vip-check-sub "version")) ((looking-at "vi") (vip-check-sub "visual")) (t (vip-check-sub "vglobal")))) ((looking-at "w") (if (looking-at "wq") (vip-check-sub "wq") (vip-check-sub "write"))) ((looking-at "W") (if (looking-at "WW") (vip-check-sub "WWrite") (vip-check-sub "Write"))) ((looking-at "x") (vip-check-sub "xit")) ((looking-at "y") (vip-check-sub "yank")) ((looking-at "z") (vip-check-sub "z"))) (exchange-point-and-mark) )) ;; Get an ex-token which is either an address or a command. ;; A token has a type, \(command, address, end-mark\), and a value (defun vip-get-ex-token () (save-window-excursion (set-buffer vip-ex-work-buf) (skip-chars-forward " \t|") (cond ((looking-at "#") (setq ex-token-type 'command) (setq ex-token (char-to-string (following-char))) (forward-char 1)) ((looking-at "[a-z]") (vip-get-ex-com-subr)) ((looking-at "\\.") (forward-char 1) (setq ex-token-type 'dot)) ((looking-at "[0-9]") (set-mark (point)) (re-search-forward "[0-9]*") (setq ex-token-type (cond ((eq ex-token-type 'plus) 'add-number) ((eq ex-token-type 'minus) 'sub-number) (t 'abs-number))) (setq ex-token (string-to-int (buffer-substring (point) (mark t))))) ((looking-at "\\$") (forward-char 1) (setq ex-token-type 'end)) ((looking-at "%") (forward-char 1) (setq ex-token-type 'whole)) ((looking-at "+") (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]")) (forward-char 1) (insert "1") (backward-char 1) (setq ex-token-type 'plus)) ((looking-at "+[0-9]") (forward-char 1) (setq ex-token-type 'plus)) (t (error vip-BadAddress)))) ((looking-at "-") (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]")) (forward-char 1) (insert "1") (backward-char 1) (setq ex-token-type 'minus)) ((looking-at "-[0-9]") (forward-char 1) (setq ex-token-type 'minus)) (t (error vip-BadAddress)))) ((looking-at "/") (forward-char 1) (set-mark (point)) (let ((cont t)) (while (and (not (eolp)) cont) ;;(re-search-forward "[^/]*/") (re-search-forward "[^/]*\\(/\\|\n\\)") (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) (setq cont nil)))) (backward-char 1) (setq ex-token (buffer-substring (point) (mark t))) (if (looking-at "/") (forward-char 1)) (setq ex-token-type 'search-forward)) ((looking-at "\\?") (forward-char 1) (set-mark (point)) (let ((cont t)) (while (and (not (eolp)) cont) ;;(re-search-forward "[^\\?]*\\?") (re-search-forward "[^\\?]*\\(\\?\\|\n\\)") (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?")) (setq cont nil)) (backward-char 1) (if (not (looking-at "\n")) (forward-char 1)))) (setq ex-token-type 'search-backward) (setq ex-token (buffer-substring (1- (point)) (mark t)))) ((looking-at ",") (forward-char 1) (setq ex-token-type 'comma)) ((looking-at ";") (forward-char 1) (setq ex-token-type 'semi-colon)) ((looking-at "[!=><&~]") (setq ex-token-type 'command) (setq ex-token (char-to-string (following-char))) (forward-char 1)) ((looking-at "'") (setq ex-token-type 'goto-mark) (forward-char 1) (cond ((looking-at "'") (setq ex-token nil)) ((looking-at "[a-z]") (setq ex-token (following-char))) (t (error "Marks are ' and a-z"))) (forward-char 1)) ((looking-at "\n") (setq ex-token-type 'end-mark) (setq ex-token "goto")) (t (error vip-BadExCommand))))) ;; Reads Ex command. Tries to determine if it has to exit because command ;; is complete or invalid. If not, keeps reading command. (defun ex-cmd-read-exit () (interactive) (setq vip-incomplete-ex-cmd t) (let ((quit-regex1 (concat "\\(" "set[ \t]*" "\\|" "edit[ \t]*" "\\|" "[nN]ext[ \t]*" "\\|" "unm[ \t]*" "\\|" "^[ \t]*rep" "\\)")) (quit-regex2 (concat "[a-zA-Z][ \t]*" "\\(" "!" "\\|" ">>" "\\|" "\\+[0-9]+" "\\)" "*[ \t]*$")) (stay-regex (concat "\\(" "^[ \t]*$" "\\|" "[ktgjmsz][ \t]*$" "\\|" "^[ \t]*ab.*" "\\|" "tr[ansfer \t]*" "\\|" "sr[ \t]*" "\\|" "mo.*" "\\|" "^[ \t]*k?ma[^p]*" "\\|" "^[ \t]*fi.*" "\\|" "v?gl.*" "\\|" "[vg][ \t]*$" "\\|" "jo.*" "\\|" "^[ \t]*ta.*" "\\|" "^[ \t]*una.*" "\\|" "^[ \t]*su.*" "\\|['`][a-z][ \t]*" "\\|" "![ \t]*[a-zA-Z].*" "\\)" "!*"))) (save-window-excursion ;; put cursor at the end of the Ex working buffer (set-buffer vip-ex-work-buf) (goto-char (point-max))) (cond ((vip-looking-back quit-regex1) (exit-minibuffer)) ((vip-looking-back stay-regex) (insert " ")) ((vip-looking-back quit-regex2) (exit-minibuffer)) (t (insert " "))))) ;; complete Ex command (defun ex-cmd-complete () (interactive) (let (save-pos dist compl-list string-to-complete completion-result) (save-excursion (setq dist (skip-chars-backward "[a-zA-Z!=>&~]") save-pos (point))) (if (or (= dist 0) (vip-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)") (vip-looking-back "^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*+[ \t]+[a-zA-Z!=>&~]+")) ;; Preceding characters are not the ones allowed in an Ex command ;; or we have typed past command name. ;; Note: we didn't do parsing, so there may be surprises. (if (or (vip-looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*") (vip-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)") (looking-at "[^ \t\n\C-m]")) nil (with-output-to-temp-buffer "*Completions*" (display-completion-list (vip-alist-to-list ex-token-alist)))) ;; Preceding chars may be part of a command name (setq string-to-complete (buffer-substring save-pos (point))) (setq completion-result (try-completion string-to-complete ex-token-alist)) (cond ((eq completion-result t) ; exact match--do nothing (vip-tmp-insert-at-eob " (Sole completion)")) ((eq completion-result nil) (vip-tmp-insert-at-eob " (No match)")) (t ;; partial completion (goto-char save-pos) (delete-region (point) (point-max)) (insert completion-result) (let (case-fold-search) (setq compl-list (vip-filter-alist (concat "^" completion-result) ex-token-alist))) (if (> (length compl-list) 1) (with-output-to-temp-buffer "*Completions*" (display-completion-list (vip-alist-to-list (reverse compl-list))))))) ))) ;; Read Ex commands ;; Ex commands themselves are implemented in viper-ex.el (defun vip-ex (&optional string) (interactive) (or string (setq ex-g-flag nil ex-g-variant nil)) (let* ((map (copy-keymap minibuffer-local-map)) (address nil) (cont t) (dot (point)) prev-token-type com-str) (vip-add-keymap vip-ex-cmd-map map) (setq com-str (or string (vip-read-string-with-history ":" nil 'vip-ex-history (car vip-ex-history) map))) (save-window-excursion ;; just a precaution (or (vip-buffer-live-p vip-ex-work-buf) (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))) (set-buffer vip-ex-work-buf) (delete-region (point-min) (point-max)) (insert com-str "\n") (goto-char (point-min))) (setq ex-token-type nil ex-addresses nil) (while cont (vip-get-ex-token) (cond ((memq ex-token-type '(command end-mark)) (if address (setq ex-addresses (cons address ex-addresses))) (cond ((string= ex-token "global") (ex-global nil) (setq cont nil)) ((string= ex-token "vglobal") (ex-global t) (setq cont nil)) (t (vip-execute-ex-command) (save-window-excursion (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (cond ((looking-at "|") (forward-char 1)) ((looking-at "\n") (setq cont nil)) (t (error "`%s': %s" ex-token vip-SpuriousText))) )) )) ((eq ex-token-type 'non-command) (error (format "`%s': %s" ex-token vip-BadExCommand))) ((eq ex-token-type 'whole) (setq address nil) (setq ex-addresses (if ex-addresses (cons (point-max) ex-addresses) (cons (point-max) (cons (point-min) ex-addresses))))) ((eq ex-token-type 'comma) (if (eq prev-token-type 'whole) (setq address (point-min))) (setq ex-addresses (cons (if (null address) (point) address) ex-addresses))) ((eq ex-token-type 'semi-colon) (if (eq prev-token-type 'whole) (setq address (point-min))) (if address (setq dot address)) (setq ex-addresses (cons (if (null address) (point) address) ex-addresses))) (t (let ((ans (vip-get-ex-address-subr address dot))) (if ans (setq address ans))))) (setq prev-token-type ex-token-type)))) ;; Get a regular expression and set `ex-variant', if found (defun vip-get-ex-pat () (save-window-excursion (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (if (looking-at "!") (progn (setq ex-g-variant (not ex-g-variant) ex-g-flag (not ex-g-flag)) (forward-char 1) (skip-chars-forward " \t"))) (let ((c (following-char))) (if (string-match "[0-9A-Za-z]" (format "%c" c)) (error "Global regexp must be inside matching non-alphanumeric chars")) (if (looking-at "[^\\\\\n]") (progn (forward-char 1) (set-mark (point)) (let ((cont t)) (while (and (not (eolp)) cont) (if (not (re-search-forward (format "[^%c]*%c" c c) nil t)) (if (member ex-token '("global" "vglobal")) (error "Missing closing delimiter for global regexp") (goto-char (point-max)))) (if (not (vip-looking-back (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c))) (setq cont nil)))) (setq ex-token (if (= (mark t) (point)) "" (buffer-substring (1- (point)) (mark t)))) (backward-char 1)) (setq ex-token nil)) c))) ;; get an ex command (defun vip-get-ex-command () (save-window-excursion (set-buffer vip-ex-work-buf) (if (looking-at "/") (forward-char 1)) (skip-chars-forward " \t") (cond ((looking-at "[a-z]") (vip-get-ex-com-subr) (if (eq ex-token-type 'non-command) (error "`%s': %s" ex-token vip-BadExCommand))) ((looking-at "[!=><&~]") (setq ex-token (char-to-string (following-char))) (forward-char 1)) (t (error vip-BadExCommand))))) ;; Get an Ex option g or c (defun vip-get-ex-opt-gc (c) (save-window-excursion (set-buffer vip-ex-work-buf) (if (looking-at (format "%c" c)) (forward-char 1)) (skip-chars-forward " \t") (cond ((looking-at "g") (setq ex-token "g") (forward-char 1) t) ((looking-at "c") (setq ex-token "c") (forward-char 1) t) (t nil)))) ;; Compute default addresses. WHOLE-FLAG means use the whole buffer (defun vip-default-ex-addresses (&optional whole-flag) (cond ((null ex-addresses) (setq ex-addresses (if whole-flag (cons (point-max) (cons (point-min) nil)) (cons (point) (cons (point) nil))))) ((null (cdr ex-addresses)) (setq ex-addresses (cons (car ex-addresses) ex-addresses))))) ;; Get an ex-address as a marker and set ex-flag if a flag is found (defun vip-get-ex-address () (let ((address (point-marker)) (cont t)) (setq ex-token "") (setq ex-flag nil) (while cont (vip-get-ex-token) (cond ((eq ex-token-type 'command) (if (member ex-token '("print" "list" "#")) (progn (setq ex-flag t cont nil)) (error "Address expected in this Ex command"))) ((eq ex-token-type 'end-mark) (setq cont nil)) ((eq ex-token-type 'whole) (error "Trailing address expected")) ((eq ex-token-type 'comma) (error "`%s': %s" ex-token vip-SpuriousText)) (t (let ((ans (vip-get-ex-address-subr address (point-marker)))) (if ans (setq address ans)))))) address)) ;; Returns an address as a point (defun vip-get-ex-address-subr (old-address dot) (let ((address nil)) (if (null old-address) (setq old-address dot)) (cond ((eq ex-token-type 'dot) (setq address dot)) ((eq ex-token-type 'add-number) (save-excursion (goto-char old-address) (forward-line (if (= old-address 0) (1- ex-token) ex-token)) (setq address (point-marker)))) ((eq ex-token-type 'sub-number) (save-excursion (goto-char old-address) (forward-line (- ex-token)) (setq address (point-marker)))) ((eq ex-token-type 'abs-number) (save-excursion (goto-char (point-min)) (if (= ex-token 0) (setq address 0) (forward-line (1- ex-token)) (setq address (point-marker))))) ((eq ex-token-type 'end) (setq address (point-max-marker))) ((eq ex-token-type 'plus) t) ; do nothing ((eq ex-token-type 'minus) t) ; do nothing ((eq ex-token-type 'search-forward) (save-excursion (ex-search-address t) (setq address (point-marker)))) ((eq ex-token-type 'search-backward) (save-excursion (ex-search-address nil) (setq address (point-marker)))) ((eq ex-token-type 'goto-mark) (save-excursion (if (null ex-token) (exchange-point-and-mark) (goto-char (vip-register-to-point (1+ (- ex-token ?a)) 'enforce-buffer))) (setq address (point-marker))))) address)) ;; Search pattern and set address (defun ex-search-address (forward) (if (string= ex-token "") (if (null vip-s-string) (error vip-NoPrevSearch) (setq ex-token vip-s-string)) (setq vip-s-string ex-token)) (if forward (progn (forward-line 1) (re-search-forward ex-token)) (forward-line -1) (re-search-backward ex-token))) ;; Get a buffer name and set `ex-count' and `ex-flag' if found (defun vip-get-ex-buffer () (setq ex-buffer nil) (setq ex-count nil) (setq ex-flag nil) (save-window-excursion (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (if (looking-at "[a-zA-Z]") (progn (setq ex-buffer (following-char)) (forward-char 1) (skip-chars-forward " \t"))) (if (looking-at "[0-9]") (progn (set-mark (point)) (re-search-forward "[0-9][0-9]*") (setq ex-count (string-to-int (buffer-substring (point) (mark t)))) (skip-chars-forward " \t"))) (if (looking-at "[pl#]") (progn (setq ex-flag t) (forward-char 1))) (if (not (looking-at "[\n|]")) (error "`%s': %s" ex-token vip-SpuriousText)))) (defun vip-get-ex-count () (setq ex-variant nil ex-count nil ex-flag nil) (save-window-excursion (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (if (looking-at "!") (progn (setq ex-variant t) (forward-char 1))) (skip-chars-forward " \t") (if (looking-at "[0-9]") (progn (set-mark (point)) (re-search-forward "[0-9][0-9]*") (setq ex-count (string-to-int (buffer-substring (point) (mark t)))) (skip-chars-forward " \t"))) (if (looking-at "[pl#]") (progn (setq ex-flag t) (forward-char 1))) (if (not (looking-at "[\n|]")) (error "`%s': %s" (buffer-substring (point-min) (1- (point-max))) vip-BadExCommand)))) ;; Expand \% and \# in ex command (defun ex-expand-filsyms (cmd buf) (let (cf pf ret) (save-excursion (set-buffer buf) (setq cf buffer-file-name) (setq pf (ex-next nil t))) ; this finds alternative file name (if (and (null cf) (string-match "[^\\]%\\|\\`%" cmd)) (error "No current file to substitute for `\%'")) (if (and (null pf) (string-match "[^\\]#\\|\\`#" cmd)) (error "No alternate file to substitute for `#'")) (save-excursion (set-buffer (get-buffer-create vip-ex-tmp-buf-name)) (erase-buffer) (insert cmd) (goto-char (point-min)) (while (re-search-forward "%\\|#" nil t) (let ((data (match-data)) (char (buffer-substring (match-beginning 0) (match-end 0)))) (if (vip-looking-back (concat "\\\\" char)) (replace-match char) (store-match-data data) (if (string= char "%") (replace-match cf) (replace-match pf))))) (end-of-line) (setq ret (buffer-substring (point-min) (point))) (message "%s" ret)) ret)) ;; Get a file name and set ex-variant, `ex-append' and `ex-offset' if found (defun vip-get-ex-file () (let (prompt) (setq ex-file nil ex-variant nil ex-append nil ex-offset nil ex-cmdfile nil) (save-excursion (save-window-excursion (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (if (looking-at "!") (if (and (not (vip-looking-back "[ \t]")) ;; read doesn't have a corresponding :r! form, so ! is ;; immediately interpreted as a shell command. (not (string= ex-token "read"))) (progn (setq ex-variant t) (forward-char 1) (skip-chars-forward " \t")) (setq ex-cmdfile t) (forward-char 1) (skip-chars-forward " \t"))) (if (looking-at ">>") (progn (setq ex-append t ex-variant t) (forward-char 2) (skip-chars-forward " \t"))) (if (looking-at "+") (progn (forward-char 1) (set-mark (point)) (re-search-forward "[ \t\n]") (backward-char 1) (setq ex-offset (buffer-substring (point) (mark t))) (forward-char 1) (skip-chars-forward " \t"))) ;; this takes care of :r, :w, etc., when they get file names ;; from the history list (if (member ex-token '("read" "write" "edit" "visual" "next")) (progn (setq ex-file (buffer-substring (point) (1- (point-max)))) (setq ex-file ;; For :e, match multiple non-white strings separated ;; by white. For others, find the first non-white string (if (string-match (if (string= ex-token "edit") "[^ \t\n]+\\([ \t]+[^ \t\n]+\\)*" "[^ \t\n]+") ex-file) (progn ;; if file name comes from history, don't leave ;; minibuffer when the user types space (setq vip-incomplete-ex-cmd nil) ;; this must be the last clause in this progn (substring ex-file (match-beginning 0) (match-end 0)) ) "")) ;; this leaves only the command name in the work area ;; file names are gone (delete-region (point) (1- (point-max))) )) (goto-char (point-max)) (skip-chars-backward " \t\n") (setq prompt (buffer-substring (point-min) (point))) )) (setq vip-last-ex-prompt prompt) ;; If we just finished reading command, redisplay prompt (if vip-incomplete-ex-cmd (setq ex-file (vip-ex-read-file-name (format ":%s " prompt))) ;; file was typed in-line (setq ex-file (or ex-file ""))) )) ;; Completes file name or exits minibuffer. If Ex command accepts multiple ;; file names, arranges to re-enter the minibuffer. (defun vip-complete-filename-or-exit () (interactive) (setq vip-keep-reading-filename t) ;; don't exit if directory---ex-commands don't (cond ((ex-cmd-accepts-multiple-files-p ex-token) (exit-minibuffer)) (t (minibuffer-complete-word)))) (defun ex-cmd-accepts-multiple-files-p (token) (member token '("edit" "next" "Next"))) ;; If user doesn't enter anything, then "" is returned, i.e., the ;; prompt-directory is not returned. (defun vip-ex-read-file-name (prompt) (let* ((str "") (minibuffer-local-completion-map (copy-keymap minibuffer-local-completion-map)) beg end cont val) (vip-add-keymap ex-read-filename-map minibuffer-local-completion-map) (setq cont (setq vip-keep-reading-filename t)) (while cont (setq vip-keep-reading-filename nil val (read-file-name (concat prompt str) nil default-directory) str (concat str (if (equal val "") "" " ") val (if (equal val "") "" " "))) ;; Only edit, next, and Next commands accept multiple files. ;; vip-keep-reading-filename is set in the anonymous function that is ;; bound to " " in ex-read-filename-map. (setq cont (and vip-keep-reading-filename (ex-cmd-accepts-multiple-files-p ex-token))) ) (setq beg (string-match "[^ \t]" str) ; delete leading blanks end (string-match "[ \t]*$" str)) ; delete trailing blanks (if (member ex-token '("read" "write")) (if (string-match "[\t ]*!" str) ;; this is actually a shell command (progn (setq ex-cmdfile t) (setq beg (1+ beg)) (setq vip-last-ex-prompt (concat vip-last-ex-prompt " !"))))) (substring str (or beg 0) end))) ;; Execute ex command using the value of addresses (defun vip-execute-ex-command () (vip-deactivate-mark) (cond ((string= ex-token "args") (ex-args)) ((string= ex-token "copy") (ex-copy nil)) ((string= ex-token "cd") (ex-cd)) ((string= ex-token "chdir") (ex-cd)) ((string= ex-token "delete") (ex-delete)) ((string= ex-token "edit") (ex-edit)) ((string= ex-token "file") (vip-info-on-file)) ((string= ex-token "goto") (ex-goto)) ((string= ex-token "help") (ex-help)) ((string= ex-token "join") (ex-line "join")) ((string= ex-token "kmark") (ex-mark)) ((string= ex-token "mark") (ex-mark)) ((string= ex-token "map") (ex-map)) ((string= ex-token "move") (ex-copy t)) ((string= ex-token "next") (ex-next ex-cycle-other-window)) ((string= ex-token "Next") (ex-next (not ex-cycle-other-window))) ((string= ex-token "RelatedFile") (ex-next-related-buffer 1)) ((string= ex-token "put") (ex-put)) ((string= ex-token "pwd") (ex-pwd)) ((string= ex-token "preserve") (ex-preserve)) ((string= ex-token "PreviousRelatedFile") (ex-next-related-buffer -1)) ((string= ex-token "quit") (ex-quit)) ((string= ex-token "read") (ex-read)) ((string= ex-token "recover") (ex-recover)) ((string= ex-token "rewind") (ex-rewind)) ((string= ex-token "submitReport") (vip-submit-report)) ((string= ex-token "set") (ex-set)) ((string= ex-token "shell") (ex-shell)) ((string= ex-token "source") (ex-source)) ((string= ex-token "sr") (ex-substitute t t)) ((string= ex-token "substitute") (ex-substitute)) ((string= ex-token "suspend") (suspend-emacs)) ((string= ex-token "stop") (suspend-emacs)) ((string= ex-token "transfer") (ex-copy nil)) ((string= ex-token "buffer") (if ex-cycle-other-window (vip-switch-to-buffer-other-window) (vip-switch-to-buffer))) ((string= ex-token "Buffer") (if ex-cycle-other-window (vip-switch-to-buffer) (vip-switch-to-buffer-other-window))) ((string= ex-token "tag") (ex-tag)) ((string= ex-token "undo") (vip-undo)) ((string= ex-token "unmap") (ex-unmap)) ((string= ex-token "version") (vip-version)) ((string= ex-token "visual") (ex-edit)) ((string= ex-token "write") (ex-write nil)) ((string= ex-token "Write") (save-some-buffers)) ((string= ex-token "wq") (ex-write t)) ((string= ex-token "WWrite") (save-some-buffers t)) ; don't ask ((string= ex-token "xit") (ex-write t)) ((string= ex-token "yank") (ex-yank)) ((string= ex-token "!") (ex-command)) ((string= ex-token "=") (ex-line-no)) ((string= ex-token ">") (ex-line "right")) ((string= ex-token "<") (ex-line "left")) ((string= ex-token "&") (ex-substitute t)) ((string= ex-token "~") (ex-substitute t t)) ((or (string= ex-token "append") (string= ex-token "change") (string= ex-token "insert") (string= ex-token "open")) (error (format "`%s': Obsolete command, not supported by Viper" ex-token))) ((or (string= ex-token "abbreviate") (string= ex-token "unabbreviate")) (error (format "`%s': Vi-style abbrevs are obsolete. Use the more powerful Emacs abbrevs" ex-token))) ((or (string= ex-token "list") (string= ex-token "print") (string= ex-token "z") (string= ex-token "#")) (error (format "`%s': Command not implemented in Viper" ex-token))) (t (error (format "`%s': %s" ex-token vip-BadExCommand))))) (defun vip-undisplayed-files () (mapcar (function (lambda (b) (if (null (get-buffer-window b)) (let ((f (buffer-file-name b))) (if f f (if ex-cycle-through-non-files (let ((s (buffer-name b))) (if (string= " " (substring s 0 1)) nil s)) nil))) nil))) (buffer-list))) (defun ex-args () (let ((l (vip-undisplayed-files)) (args "") (file-count 1)) (while (not (null l)) (if (car l) (setq args (format "%s %d) %s\n" args file-count (car l)) file-count (1+ file-count))) (setq l (cdr l))) (if (string= args "") (message "All files are already displayed") (save-excursion (save-window-excursion (with-output-to-temp-buffer " *vip-info*" (princ "\n\nThese files are not displayed in any window.\n") (princ "\n=============\n") (princ args) (princ "\n=============\n") (princ "\nThe numbers can be given as counts to :next. ") (princ "\n\nPress any key to continue...\n\n")) (vip-read-event)))))) ;; Ex cd command. Default directory of this buffer changes (defun ex-cd () (vip-get-ex-file) (if (string= ex-file "") (setq ex-file "~")) (setq default-directory (file-name-as-directory (expand-file-name ex-file)))) ;; Ex copy and move command. DEL-FLAG means delete (defun ex-copy (del-flag) (vip-default-ex-addresses) (let ((address (vip-get-ex-address)) (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) (goto-char end) (save-excursion (push-mark beg t) (vip-enlarge-region (mark t) (point)) (if del-flag (kill-region (point) (mark t)) (copy-region-as-kill (point) (mark t))) (if ex-flag (progn (with-output-to-temp-buffer "*copy text*" (princ (if (or del-flag ex-g-flag ex-g-variant) (current-kill 0) (buffer-substring (point) (mark t))))) (condition-case nil (progn (read-string "[Hit return to continue] ") (save-excursion (kill-buffer "*copy text*"))) (quit (save-excursion (kill-buffer "*copy text*")) (signal 'quit nil)))))) (if (= address 0) (goto-char (point-min)) (goto-char address) (forward-line 1)) (insert (current-kill 0)))) ;; Ex delete command (defun ex-delete () (vip-default-ex-addresses) (vip-get-ex-buffer) (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) (if (> beg end) (error vip-FirstAddrExceedsSecond)) (save-excursion (vip-enlarge-region beg end) (exchange-point-and-mark) (if ex-count (progn (set-mark (point)) (forward-line (1- ex-count))) (set-mark end)) (vip-enlarge-region (point) (mark t)) (if ex-flag ;; show text to be deleted and ask for confirmation (progn (with-output-to-temp-buffer " *delete text*" (princ (buffer-substring (point) (mark t)))) (condition-case nil (read-string "[Hit return to continue] ") (quit (save-excursion (kill-buffer " *delete text*")) (error ""))) (save-excursion (kill-buffer " *delete text*"))) (if ex-buffer (cond ((vip-valid-register ex-buffer '(Letter)) (vip-append-to-register (downcase ex-buffer) (point) (mark t))) ((vip-valid-register ex-buffer) (copy-to-register ex-buffer (point) (mark t) nil)) (t (error vip-InvalidRegister ex-buffer)))) (kill-region (point) (mark t)))))) ;; Ex edit command ;; In Viper, `e' and `e!' behave identically. In both cases, the user is ;; asked if current buffer should really be discarded. ;; This command can take multiple file names. It replaces the current buffer ;; with the first file in its argument list (defun ex-edit (&optional file) (if (not file) (vip-get-ex-file)) (cond ((and (string= ex-file "") buffer-file-name) (setq ex-file (abbreviate-file-name (buffer-file-name)))) ((string= ex-file "") (error vip-NoFileSpecified))) (let (msg do-edit) (if buffer-file-name (cond ((buffer-modified-p) (setq msg (format "Buffer %s is modified. Discard changes? " (buffer-name)) do-edit t)) ((not (verify-visited-file-modtime (current-buffer))) (setq msg (format "File %s changed on disk. Reread from disk? " buffer-file-name) do-edit t)) (t (setq do-edit nil)))) (if do-edit (if (yes-or-no-p msg) (progn (set-buffer-modified-p nil) (kill-buffer (current-buffer))) (message "Buffer %s was left intact" (buffer-name)))) ) ; let (if (null (setq file (get-file-buffer ex-file))) (progn (ex-find-file ex-file) (vip-change-state-to-vi) (goto-char (point-min))) (switch-to-buffer file)) (if ex-offset (progn (save-window-excursion (set-buffer vip-ex-work-buf) (delete-region (point-min) (point-max)) (insert ex-offset "\n") (goto-char (point-min))) (goto-char (vip-get-ex-address)) (beginning-of-line))) (ex-fixup-history vip-last-ex-prompt ex-file)) ;; splits the string FILESPEC into substrings separated by newlines `\012' ;; each line assumed to be a file name. find-file's each file thus obtained. (defun ex-find-file (filespec) (let (f filebuf tmp-buf status) (if (string-match "[^a-zA-Z0-9_.-/]" filespec) (progn (save-excursion (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name))) (erase-buffer) (setq status (call-process ex-find-file-shell nil t nil ex-find-file-shell-options "-c" (format "echo %s | tr ' ' '\\012'" filespec))) (goto-char (point-min)) ;; Issue an error, if no match. (if (> status 0) (save-excursion (skip-chars-forward " \t\n\j") (if (looking-at "echo:") (vip-forward-word 1)) (error "%S%s" filespec (buffer-substring (point) (vip-line-pos 'end))) )) (reverse-region (point-min) (point-max)) (goto-char (point-min)) (while (not (eobp)) (setq f (buffer-substring (point) (vip-line-pos 'end))) (setq filebuf (find-file f)) (set-buffer tmp-buf) ; otherwise it'll be in f. (forward-to-indentation 1)) )) (setq filebuf (find-file-noselect (setq f filespec)))) (switch-to-buffer filebuf) )) ;; Ex global command (defun ex-global (variant) (let ((gcommand ex-token)) (if (or ex-g-flag ex-g-variant) (error "`%s' within `global' is not allowed" gcommand) (if variant (setq ex-g-flag nil ex-g-variant t) (setq ex-g-flag t ex-g-variant nil))) (vip-get-ex-pat) (if (null ex-token) (error "`%s': Missing regular expression" gcommand))) (if (string= ex-token "") (if (null vip-s-string) (error vip-NoPrevSearch) (setq ex-g-pat vip-s-string)) (setq ex-g-pat ex-token vip-s-string ex-token)) (if (null ex-addresses) (setq ex-addresses (list (point-max) (point-min))) (vip-default-ex-addresses)) (let ((marks nil) (mark-count 0) com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) (if (> beg end) (error vip-FirstAddrExceedsSecond)) (save-excursion (vip-enlarge-region beg end) (exchange-point-and-mark) (let ((cont t) (limit (point-marker))) (exchange-point-and-mark) ;; skip the last line if empty (beginning-of-line) (if (eobp) (vip-backward-char-carefully)) (while (and cont (not (bobp)) (>= (point) limit)) (beginning-of-line) (set-mark (point)) (end-of-line) (let ((found (re-search-backward ex-g-pat (mark t) t))) (if (or (and ex-g-flag found) (and ex-g-variant (not found))) (progn (end-of-line) (setq mark-count (1+ mark-count)) (setq marks (cons (point-marker) marks))))) (beginning-of-line) (if (bobp) (setq cont nil) (forward-line -1) (end-of-line))))) (save-window-excursion (set-buffer vip-ex-work-buf) (setq com-str (buffer-substring (1+ (point)) (1- (point-max))))) (while marks (goto-char (car marks)) (vip-ex com-str) (setq mark-count (1- mark-count)) (setq marks (cdr marks))))) ;; Ex goto command (defun ex-goto () (if (null ex-addresses) (setq ex-addresses (cons (point) nil))) (push-mark (point) t) (goto-char (car ex-addresses)) (beginning-of-line)) ;; Ex line commands. COM is join, shift-right or shift-left (defun ex-line (com) (vip-default-ex-addresses) (vip-get-ex-count) (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point) (if (> beg end) (error vip-FirstAddrExceedsSecond)) (save-excursion (vip-enlarge-region beg end) (exchange-point-and-mark) (if ex-count (progn (set-mark (point)) (forward-line ex-count))) (if ex-flag ;; show text to be joined and ask for confirmation (progn (with-output-to-temp-buffer " *text*" (princ (buffer-substring (point) (mark t)))) (condition-case nil (progn (read-string "[Hit return to continue] ") (ex-line-subr com (point) (mark t))) (quit (ding))) (save-excursion (kill-buffer " *text*"))) (ex-line-subr com (point) (mark t))) (setq point (point))) (goto-char (1- point)) (beginning-of-line))) (defun ex-line-subr (com beg end) (cond ((string= com "join") (goto-char (min beg end)) (while (and (not (eobp)) (< (point) (max beg end))) (end-of-line) (if (and (<= (point) (max beg end)) (not (eobp))) (progn (forward-line 1) (delete-region (point) (1- (point))) (if (not ex-variant) (fixup-whitespace)))))) ((or (string= com "right") (string= com "left")) (indent-rigidly (min beg end) (max beg end) (if (string= com "right") vip-shift-width (- vip-shift-width))) (goto-char (max beg end)) (end-of-line) (vip-forward-char-carefully)))) ;; Ex mark command (defun ex-mark () (let (char) (if (null ex-addresses) (setq ex-addresses (cons (point) nil))) (save-window-excursion (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (if (looking-at "[a-z]") (progn (setq char (following-char)) (forward-char 1) (skip-chars-forward " \t") (if (not (looking-at "[\n|]")) (error "`%s': %s" ex-token vip-SpuriousText))) (error "`%s' requires a following letter" ex-token))) (save-excursion (goto-char (car ex-addresses)) (point-to-register (1+ (- char ?a)))))) ;; Alternate file is the file next to the first one in the buffer ring (defun ex-next (cycle-other-window &optional find-alt-file) (catch 'ex-edit (let (count l) (if (not find-alt-file) (progn (vip-get-ex-file) (if (or (char-or-string-p ex-offset) (and (not (string= "" ex-file)) (not (string-match "^[0-9]+$" ex-file)))) (progn (ex-edit t) (throw 'ex-edit nil)) (setq count (string-to-int ex-file)) (if (= count 0) (setq count 1)) (if (< count 0) (error "Usage: `next ' (count >= 0)")))) (setq count 1)) (setq l (vip-undisplayed-files)) (while (> count 0) (while (and (not (null l)) (null (car l))) (setq l (cdr l))) (setq count (1- count)) (if (> count 0) (setq l (cdr l)))) (if find-alt-file (car l) (progn (if (car l) (let* ((w (if cycle-other-window (get-lru-window) (selected-window))) (b (window-buffer w))) (set-window-buffer w (get-file-buffer (car l))) (bury-buffer b) ;; this puts "next " in the ex-command history (ex-fixup-history vip-last-ex-prompt ex-file)) (error "Not that many undisplayed files"))))))) (defun ex-next-related-buffer (direction &optional no-recursion) (vip-ring-rotate1 vip-related-files-and-buffers-ring direction) (let ((file-or-buffer-name (vip-current-ring-item vip-related-files-and-buffers-ring)) (old-ring vip-related-files-and-buffers-ring) (old-win (selected-window)) skip-rest buf wind) (or (and (ring-p vip-related-files-and-buffers-ring) (> (ring-length vip-related-files-and-buffers-ring) 0)) (error "This buffer has no related files or buffers")) (or (stringp file-or-buffer-name) (error "File and buffer names must be strings, %S" file-or-buffer-name)) (setq buf (cond ((get-buffer file-or-buffer-name)) ((file-exists-p file-or-buffer-name) (find-file-noselect file-or-buffer-name)) )) (if (not (vip-buffer-live-p buf)) (error "Didn't find buffer %S or file %S" file-or-buffer-name (abbreviate-file-name (expand-file-name file-or-buffer-name)))) (if (equal buf (current-buffer)) (or no-recursion ;; try again (setq skip-rest t) (ex-next-related-buffer direction 'norecursion))) (if skip-rest () ;; setup buffer (if (setq wind (vip-get-visible-buffer-window buf)) () (setq wind (get-lru-window (if vip-xemacs-p nil 'visible))) (set-window-buffer wind buf)) (if (vip-window-display-p) (progn (raise-frame (window-frame wind)) (if (equal (window-frame wind) (window-frame old-win)) (save-window-excursion (select-window wind) (sit-for 1)) (select-window wind))) (save-window-excursion (select-window wind) (sit-for 1))) (save-excursion (set-buffer buf) (setq vip-related-files-and-buffers-ring old-ring)) (setq vip-local-search-start-marker (point-marker)) ))) ;; Force auto save (defun ex-preserve () (message "Autosaving all buffers that need to be saved...") (do-auto-save t)) ;; Ex put (defun ex-put () (let ((point (if (null ex-addresses) (point) (car ex-addresses)))) (vip-get-ex-buffer) (setq vip-use-register ex-buffer) (goto-char point) (if (bobp) (vip-Put-back 1) (vip-put-back 1)))) ;; Ex print working directory (defun ex-pwd () (message default-directory)) ;; Ex quit command (defun ex-quit () ;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc. (save-excursion (set-buffer vip-ex-work-buf) (if (looking-at "!") (forward-char 1))) (if (< vip-expert-level 3) (save-buffers-kill-emacs) (kill-buffer (current-buffer)))) ;; Ex read command (defun ex-read () (vip-get-ex-file) (let ((point (if (null ex-addresses) (point) (car ex-addresses)))) (goto-char point) (vip-add-newline-at-eob-if-necessary) (if (not (or (bobp) (eobp))) (forward-line 1)) (if (and (not ex-variant) (string= ex-file "")) (progn (if (null buffer-file-name) (error vip-NoFileSpecified)) (setq ex-file buffer-file-name))) (if ex-cmdfile (shell-command ex-file t) (insert-file-contents ex-file))) (ex-fixup-history vip-last-ex-prompt ex-file)) ;; this function fixes ex-history for some commands like ex-read, ex-edit (defun ex-fixup-history (&rest args) (setq vip-ex-history (cons (mapconcat 'identity args " ") (cdr vip-ex-history)))) ;; Ex recover from emacs \#file\# (defun ex-recover () (vip-get-ex-file) (if (or ex-append ex-offset) (error "`recover': %s" vip-SpuriousText)) (if (string= ex-file "") (progn (if (null buffer-file-name) (error "This buffer isn't visiting any file")) (setq ex-file buffer-file-name)) (setq ex-file (expand-file-name ex-file))) (if (and (not (string= ex-file (buffer-file-name))) (buffer-modified-p) (not ex-variant)) (error "No write since last change \(:rec! overrides\)")) (recover-file ex-file)) ;; Tell that `rewind' is obsolete and to use `:next count' instead (defun ex-rewind () (message "Use `:n ' instead. Counts are obtained from the `:args' command")) ;; read variable name for ex-set (defun ex-set-read-variable () (let ((minibuffer-local-completion-map (copy-keymap minibuffer-local-completion-map)) (cursor-in-echo-area t) str batch) (define-key minibuffer-local-completion-map " " 'minibuffer-complete-and-exit) (define-key minibuffer-local-completion-map "=" 'exit-minibuffer) (if (vip-set-unread-command-events (ex-get-inline-cmd-args "[ \t]*[a-zA-Z]*[ \t]*" nil "\C-m")) (progn (setq batch t) (vip-set-unread-command-events ?\C-m))) (message ":set [= ]") (or batch (sit-for 2)) (while (string-match "^[ \\t\\n]*$" (setq str (completing-read ":set " ex-variable-alist))) (message ":set ") ;; if there are unread events, don't wait (or (vip-set-unread-command-events "") (sit-for 2)) ) ; while str)) (defun ex-set () (let ((var (ex-set-read-variable)) (val 0) (set-cmd "setq") (ask-if-save t) (auto-cmd-label "; don't touch or else...") (delete-turn-on-auto-fill-pattern "([ \t]*add-hook[ \t]+'vip-insert-state-hooks[ \t]+'turn-on-auto-fill.*)") actual-lisp-cmd lisp-cmd-del-pattern val2 orig-var) (setq orig-var var) (cond ((member var '("ai" "autoindent")) (setq var "vip-auto-indent" val "t")) ((member var '("noai" "noautoindent")) (setq var "vip-auto-indent" val "nil")) ((member var '("ic" "ignorecase")) (setq var "vip-case-fold-search" val "t")) ((member var '("noic" "noignorecase")) (setq var "vip-case-fold-search" val "nil")) ((member var '("ma" "magic")) (setq var "vip-re-search" val "t")) ((member var '("noma" "nomagic")) (setq var "vip-re-search" val "nil")) ((member var '("ro" "readonly")) (setq var "buffer-read-only" val "t")) ((member var '("noro" "noreadonly")) (setq var "buffer-read-only" val "nil")) ((member var '("sm" "showmatch")) (setq var "blink-matching-paren" val "t")) ((member var '("nosm" "noshowmatch")) (setq var "blink-matching-paren" val "nil")) ((member var '("ws" "wrapscan")) (setq var "vip-search-wrap-around-t" val "t")) ((member var '("nows" "nowrapscan")) (setq var "vip-search-wrap-around-t" val "nil"))) (if (eq val 0) ; value must be set by the user (let ((cursor-in-echo-area t)) (message (format ":set %s = " var)) ;; if there are unread events, don't wait (or (vip-set-unread-command-events "") (sit-for 2)) (setq val (read-string (format ":set %s = " var))) (ex-fixup-history "set" orig-var val) ;; check numerical values (if (member var '("sw" "shiftwidth" "ts" "tabstop" "wm" "wrapmargin")) (condition-case nil (or (numberp (setq val2 (car (read-from-string val)))) (error "%s: Invalid value, numberp, %S" var val)) (error (error "%s: Invalid value, numberp, %S" var val)))) (cond ((member var '("sw" "shiftwidth")) (setq var "vip-shift-width")) ((member var '("ts" "tabstop")) ;; make it take effect in curr buff and new bufs (kill-local-variable 'tab-width) (setq var "tab-width" set-cmd "setq-default")) ((member var '("tsl" "tab-stop-local")) (setq var "tab-width" set-cmd "setq" ask-if-save nil)) ((member var '("wm" "wrapmargin")) ;; make it take effect in curr buff and new bufs (kill-local-variable 'fill-column) (setq var "fill-column" val (format "(- (window-width) %s)" val) set-cmd "setq-default")) ((member var '("sh" "shell")) (setq var "explicit-shell-file-name" val (format "\"%s\"" val))))) (ex-fixup-history "set" orig-var)) (setq actual-lisp-cmd (format "\n(%s %s %s) %s" set-cmd var val auto-cmd-label)) (setq lisp-cmd-del-pattern (format "^\n?[ \t]*([ \t]*%s[ \t]+%s[ \t].*)[ \t]*%s" set-cmd var auto-cmd-label)) (if (and ask-if-save (y-or-n-p (format "Do you want to save this setting in %s " vip-custom-file-name))) (progn (vip-save-string-in-file actual-lisp-cmd vip-custom-file-name ;; del pattern lisp-cmd-del-pattern) (if (string= var "fill-column") (if (> val2 0) (vip-save-string-in-file (concat "(add-hook 'vip-insert-state-hooks 'turn-on-auto-fill) " auto-cmd-label) vip-custom-file-name delete-turn-on-auto-fill-pattern) (vip-save-string-in-file nil vip-custom-file-name delete-turn-on-auto-fill-pattern) (vip-save-string-in-file nil vip-custom-file-name ;; del pattern lisp-cmd-del-pattern) )) )) (message (format "%s %s %s" set-cmd var (if (string-match "^[ \t]*$" val) (format "%S" val) val))) (eval (car (read-from-string actual-lisp-cmd))) (if (string= var "fill-column") (if (> val2 0) (auto-fill-mode 1) (auto-fill-mode -1))) )) ;; In inline args, skip regex-forw and (optionally) chars-back. ;; Optional 3d arg is a string that should replace ' ' to prevent its ;; special meaning (defun ex-get-inline-cmd-args (regex-forw &optional chars-back replace-str) (save-excursion (set-buffer vip-ex-work-buf) (goto-char (point-min)) (re-search-forward regex-forw nil t) (let ((beg (point)) end) (goto-char (point-max)) (if chars-back (skip-chars-backward chars-back) (skip-chars-backward " \t\n\C-m")) (setq end (point)) ;; replace SPC with `=' to suppress the special meaning SPC has ;; in Ex commands (goto-char beg) (if replace-str (while (re-search-forward " +" nil t) (replace-match replace-str nil t) (vip-forward-char-carefully))) (goto-char end) (buffer-substring beg end)))) ;; Ex shell command (defun ex-shell () (shell)) ;; Viper help. Invokes Info (defun ex-help () (condition-case nil (progn (pop-to-buffer (get-buffer-create "*info*")) (info "viper.info") (message "Type `i' to search for a specific topic")) (error (beep 1) (with-output-to-temp-buffer " *vip-info*" (princ (format " The Info file for Viper does not seem to be installed. This file is part of the standard distribution of %sEmacs. Please contact your system administrator. " (if vip-xemacs-p "X" "") )))))) ;; Ex source command. Loads the file specified as argument or `~/.vip' (defun ex-source () (vip-get-ex-file) (if (string= ex-file "") (load vip-custom-file-name) (load ex-file))) ;; Ex substitute command ;; If REPEAT use previous regexp which is ex-reg-exp or vip-s-string (defun ex-substitute (&optional repeat r-flag) (let ((opt-g nil) (opt-c nil) (matched-pos nil) (case-fold-search vip-case-fold-search) delim pat repl) (if repeat (setq ex-token nil) (setq delim (vip-get-ex-pat))) (if (null ex-token) (progn (setq pat (if r-flag vip-s-string ex-reg-exp)) (or (stringp pat) (error "No previous pattern to use in substitution")) (setq repl ex-repl delim (string-to-char pat))) (setq pat (if (string= ex-token "") vip-s-string ex-token)) (setq vip-s-string pat ex-reg-exp pat) (setq delim (vip-get-ex-pat)) (if (null ex-token) (setq ex-token "" ex-repl "") (setq repl ex-token ex-repl ex-token))) (while (vip-get-ex-opt-gc delim) (if (string= ex-token "g") (setq opt-g t) (setq opt-c t))) (vip-get-ex-count) (if ex-count (save-excursion (if ex-addresses (goto-char (car ex-addresses))) (set-mark (point)) (forward-line (1- ex-count)) (setq ex-addresses (cons (point) (cons (mark t) nil)))) (if (null ex-addresses) (setq ex-addresses (cons (point) (cons (point) nil))) (if (null (cdr ex-addresses)) (setq ex-addresses (cons (car ex-addresses) ex-addresses))))) ;(setq G opt-g) (let ((beg (car ex-addresses)) (end (car (cdr ex-addresses))) eol-mark) (save-excursion (vip-enlarge-region beg end) (let ((limit (save-excursion (goto-char (max (point) (mark t))) (point-marker)))) (goto-char (min (point) (mark t))) (while (< (point) limit) (end-of-line) (setq eol-mark (point-marker)) (beginning-of-line) (if opt-g (progn (while (and (not (eolp)) (re-search-forward pat eol-mark t)) (if (or (not opt-c) (y-or-n-p "Replace? ")) (progn (setq matched-pos (point)) (if (not (stringp repl)) (error "Can't perform Ex substitution: No previous replacement pattern")) (replace-match repl t t)))) (end-of-line) (vip-forward-char-carefully)) (if (null pat) (error "Can't repeat Ex substitution: No previous regular expression")) (if (and (re-search-forward pat eol-mark t) (or (not opt-c) (y-or-n-p "Replace? "))) (progn (setq matched-pos (point)) (if (not (stringp repl)) (error "Can't perform Ex substitution: No previous replacement pattern")) (replace-match repl t t))) (end-of-line) (vip-forward-char-carefully)))))) (if matched-pos (goto-char matched-pos)) (beginning-of-line) (if opt-c (message "done")))) ;; Ex tag command (defun ex-tag () (let (tag) (save-window-excursion (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (set-mark (point)) (skip-chars-forward "^ |\t\n") (setq tag (buffer-substring (mark t) (point)))) (if (not (string= tag "")) (setq ex-tag tag)) (vip-change-state-to-emacs) (condition-case conds (progn (if (string= tag "") (find-tag ex-tag t) (find-tag-other-window ex-tag)) (vip-change-state-to-vi)) (error (vip-change-state-to-vi) (vip-message-conditions conds))))) ;; Ex write command (defun ex-write (q-flag) (vip-default-ex-addresses t) (vip-get-ex-file) (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) temp-buf writing-same-file region file-exists writing-whole-file) (if (> beg end) (error vip-FirstAddrExceedsSecond)) (if ex-cmdfile (progn (vip-enlarge-region beg end) (shell-command-on-region (point) (mark t) ex-file)) (if (and (string= ex-file "") (not (buffer-file-name))) (setq ex-file (read-file-name (format "Buffer %s isn't visiting any file. File to save in: " (buffer-name))))) (setq writing-whole-file (and (= (point-min) beg) (= (point-max) end)) ex-file (if (string= ex-file "") (buffer-file-name) (expand-file-name ex-file))) ;; if ex-file is a directory use the file portion of the buffer file name (if (and (file-directory-p ex-file) buffer-file-name (not (file-directory-p buffer-file-name))) (setq ex-file (concat ex-file (file-name-nondirectory buffer-file-name)))) (setq file-exists (file-exists-p ex-file) writing-same-file (string= ex-file (buffer-file-name))) (if (and writing-whole-file writing-same-file) (if (not (buffer-modified-p)) (message "(No changes need to be saved)") (save-buffer) (ex-write-info file-exists ex-file beg end)) ;; writing some other file or portion of the currents ;; file---create temp buffer for it ;; disable undo in that buffer, for efficiency (buffer-disable-undo (setq temp-buf (create-file-buffer ex-file))) (unwind-protect (save-excursion (if (and file-exists (not writing-same-file) (not (yes-or-no-p (format "File %s exists. Overwrite? " ex-file)))) (error "Quit") (vip-enlarge-region beg end) (setq region (buffer-substring (point) (mark t))) (set-buffer temp-buf) (set-visited-file-name ex-file) (erase-buffer) (if (and file-exists ex-append) (insert-file-contents ex-file)) (goto-char (point-max)) (insert region) (save-buffer) (ex-write-info file-exists ex-file (point-min) (point-max)) ) (set-buffer temp-buf) (set-buffer-modified-p nil) (kill-buffer temp-buf) )) ) ;; this prevents the loss of data if writing part of the buffer (if (and (buffer-file-name) writing-same-file) (set-visited-file-modtime)) (or writing-whole-file (not writing-same-file) (set-buffer-modified-p t)) (if q-flag (if (< vip-expert-level 2) (save-buffers-kill-emacs) (kill-buffer (current-buffer)))) ))) (defun ex-write-info (exists file-name beg end) (message "`%s'%s %d lines, %d characters" (abbreviate-file-name file-name) (if exists "" " [New file]") (count-lines beg (min (1+ end) (point-max))) (- end beg))) ;; Ex yank command (defun ex-yank () (vip-default-ex-addresses) (vip-get-ex-buffer) (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) (if (> beg end) (error vip-FirstAddrExceedsSecond)) (save-excursion (vip-enlarge-region beg end) (exchange-point-and-mark) (if (or ex-g-flag ex-g-variant) (error "Can't execute `yank' within `global'")) (if ex-count (progn (set-mark (point)) (forward-line (1- ex-count))) (set-mark end)) (vip-enlarge-region (point) (mark t)) (if ex-flag (error "`yank': %s" vip-SpuriousText)) (if ex-buffer (cond ((vip-valid-register ex-buffer '(Letter)) (vip-append-to-register (downcase ex-buffer) (point) (mark t))) ((vip-valid-register ex-buffer) (copy-to-register ex-buffer (point) (mark t) nil)) (t (error vip-InvalidRegister ex-buffer)))) (copy-region-as-kill (point) (mark t))))) ;; Execute shell command (defun ex-command () (let (command) (save-window-excursion (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (setq command (buffer-substring (point) (point-max))) (end-of-line)) (setq command (ex-expand-filsyms command (current-buffer))) (if (and (> (length command) 0) (string= "!" (substring command 0 1))) (if vip-ex-last-shell-com (setq command (concat vip-ex-last-shell-com (substring command 1))) (error "No previous shell command"))) (setq vip-ex-last-shell-com command) (if (null ex-addresses) (shell-command command) (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) (if (null beg) (setq beg end)) (save-excursion (goto-char beg) (set-mark end) (vip-enlarge-region (point) (mark t)) (shell-command-on-region (point) (mark t) command t)) (goto-char beg))))) ;; Print line number (defun ex-line-no () (message "%d" (1+ (count-lines (point-min) (if (null ex-addresses) (point-max) (car ex-addresses)))))) ;; Give information on the file visited by the current buffer (defun vip-info-on-file () (interactive) (let (file info) (setq file (if (buffer-file-name) (concat (abbreviate-file-name (buffer-file-name)) ":") (concat (buffer-name) " [Not visiting any file]:")) info (format "line=%d/%d pos=%d/%d col=%d %s" (count-lines (point-min) (vip-line-pos 'end)) (count-lines (point-min) (point-max)) (point) (1- (point-max)) (1+ (current-column)) (if (buffer-modified-p) "[Modified]" "[Unchanged]"))) (if (< (+ 1 (length info) (length file)) (window-width (minibuffer-window))) (message (concat file " " info)) (save-window-excursion (with-output-to-temp-buffer " *vip-info*" (princ (concat "\n" file "\n\n\t" info "\n\n\nPress any key to continue...\n\n"))) (vip-read-event))) )) (provide 'viper-ex) ;;; viper-ex.el ends here emacs-19.30/lisp/viper-keym.el100444 12120 1 54272 6045206115 14512 0ustar rmsdaemon;;; viper-keym.el --- main Viper keymaps ;; Copyright (C) 1994, 1995 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. (require 'viper-util) ;;; Variables ;;; Keymaps ;; Keymaps for vital things like \e and C-z. ;; Not for users (defvar vip-vi-intercept-map (make-sparse-keymap)) (defvar vip-insert-intercept-map (make-sparse-keymap)) (defvar vip-emacs-intercept-map (make-sparse-keymap)) ;; keymap used to zap all keymaps other than function-key-map, ;; devide-function-key-map, etc. (defvar vip-overriding-map (make-sparse-keymap)) (vip-deflocalvar vip-vi-local-user-map (make-sparse-keymap) "Keymap for user-defined local bindings. Useful for changing bindings such as ZZ in certain major modes. For instance, in letter-mode, one may want to bind ZZ to mh-send-letter. In a newsreader such as gnus, tin, or rn, ZZ could be bound to save-buffers-kill-emacs then post article, etc.") (put 'vip-vi-local-user-map 'permanent-local t) (defvar vip-vi-global-user-map (make-sparse-keymap) "Keymap for user-defined global bindings. These bindings are seen in all Viper buffers.") (defvar vip-vi-basic-map (make-keymap) "This is the main keymap in effect in Viper's Vi state. This map is global, shared by all buffers.") (defvar vip-vi-kbd-map (make-sparse-keymap) "This keymap keeps keyboard macros defined via the :map command.") (defvar vip-vi-diehard-map (make-sparse-keymap) "This keymap is in use when the user asks Viper to simulate Vi very closely. This happens when vip-expert-level is 1 or 2. See vip-set-expert-level.") (vip-deflocalvar vip-insert-local-user-map (make-sparse-keymap) "Auxiliary map for per-buffer user-defined keybindings in Insert state.") (put 'vip-insert-local-user-map 'permanent-local t) (defvar vip-insert-global-user-map (make-sparse-keymap) "Auxiliary map for global user-defined bindings in Insert state.") (defvar vip-insert-basic-map (make-sparse-keymap) "The basic insert-mode keymap.") (defvar vip-insert-diehard-map (make-keymap) "Map used when user wants vi-style keys in insert mode. Most of the Emacs keys are suppressed. This map overshadows vip-insert-basic-map. Not recommended, except for novice users.") (defvar vip-insert-kbd-map (make-sparse-keymap) "This keymap keeps VI-style kbd macros for insert mode.") (defvar vip-replace-map (make-sparse-keymap) "Map used in Viper's replace state.") (defvar vip-emacs-global-user-map (make-sparse-keymap) "Auxiliary map for global user-defined bindings in Emacs state.") (defvar vip-emacs-kbd-map (make-sparse-keymap) "This keymap keeps Vi-style kbd macros for emacs mode.") (vip-deflocalvar vip-emacs-local-user-map (make-sparse-keymap) "Auxiliary map for local user-defined bindings in Emacs state.") (put 'vip-emacs-local-user-map 'permanent-local t) ;; This keymap should stay empty (defvar vip-empty-keymap (make-sparse-keymap)) ;; This was the main Vi mode in old versions of VIP which may have been ;; extensively used by VIP users. We declare it as a global var ;; and, after .vip is loaded, we add this keymap to vip-vi-basic-map. (defvar vip-mode-map (make-sparse-keymap)) ;;; Variables used by minor modes ;; Association list of the form ;; ((major-mode . keymap) (major-mode . keymap) ...) ;; Viper uses these keymaps to make user-requested adjustments ;; to its Vi state in various major modes.") (defvar vip-vi-state-modifier-alist nil) ;; Association list of the form ;; ((major-mode . keymap) (major-mode . keymap) ...) ;; Viper uses these keymaps to make user-requested adjustments ;; to its Insert state in various major modes.") (defvar vip-insert-state-modifier-alist nil) ;; Association list of the form ;; ((major-mode . keymap) (major-mode . keymap) ...) ;; Viper uses these keymaps to make user-requested adjustments ;; to its Emacs state in various major modes. (defvar vip-emacs-state-modifier-alist nil) ;; Tells vip-add-local-keys to create a new vip-vi-local-user-map for new ;; buffers. Not a user option. (vip-deflocalvar vip-need-new-vi-local-map t "") (put 'vip-need-new-vi-local-map 'permanent-local t) ;; Tells vip-add-local-keys to create a new vip-insert-local-user-map for new ;; buffers. Not a user option. (vip-deflocalvar vip-need-new-insert-local-map t "") (put 'vip-need-new-insert-local-map 'permanent-local t) ;; Tells vip-add-local-keys to create a new vip-emacs-local-user-map for new ;; buffers. Not a user option. (vip-deflocalvar vip-need-new-emacs-local-map t "") (put 'vip-need-new-emacs-local-map 'permanent-local t) ;; Insert mode keymap ;; for novice users, pretend you are the real vi. (define-key vip-insert-diehard-map "\t" 'vip-insert-tab) (define-key vip-insert-diehard-map "\C-a" 'self-insert-command) (define-key vip-insert-diehard-map "\C-b" 'self-insert-command) (define-key vip-insert-diehard-map "\C-c" 'vip-change-state-to-vi) (define-key vip-insert-diehard-map "\C-e" 'self-insert-command) (define-key vip-insert-diehard-map "\C-f" 'self-insert-command) (define-key vip-insert-diehard-map "\C-g" 'self-insert-command) (define-key vip-insert-diehard-map "\C-i" 'self-insert-command) (define-key vip-insert-diehard-map "\C-k" 'self-insert-command) (define-key vip-insert-diehard-map "\C-l" 'self-insert-command) (define-key vip-insert-diehard-map "\C-n" 'self-insert-command) (define-key vip-insert-diehard-map "\C-o" 'self-insert-command) (define-key vip-insert-diehard-map "\C-p" 'self-insert-command) (define-key vip-insert-diehard-map "\C-q" 'self-insert-command) (define-key vip-insert-diehard-map "\C-r" 'self-insert-command) (define-key vip-insert-diehard-map "\C-s" 'self-insert-command) (define-key vip-insert-diehard-map "\C-u" 'vip-erase-line) (define-key vip-insert-diehard-map "\C-x" 'self-insert-command) (define-key vip-insert-diehard-map "\C-y" 'self-insert-command) (define-key vip-insert-diehard-map "\C-z" 'self-insert-command) (define-key vip-insert-diehard-map "\C-]" 'self-insert-command) (define-key vip-insert-diehard-map "\C-_" 'self-insert-command) (let ((i ?\ )) (while (<= i ?~) (define-key vip-insert-diehard-map (make-string 1 i) 'self-insert-command) (setq i (1+ i)))) ;; Insert mode map when user wants emacs style (define-key vip-insert-basic-map "\C-d" 'vip-backward-indent) (define-key vip-insert-basic-map "\C-w" 'vip-delete-backward-word) (define-key vip-insert-basic-map "\C-t" 'vip-forward-indent) (define-key vip-insert-basic-map (if vip-xemacs-p [(shift tab)] [S-tab]) 'vip-insert-tab) (define-key vip-insert-basic-map "\C-v" 'quoted-insert) (define-key vip-insert-basic-map "\C-?" 'vip-del-backward-char-in-insert) (define-key vip-insert-basic-map "\C-c\M-p" 'vip-insert-prev-from-insertion-ring) (define-key vip-insert-basic-map "\C-c\M-n" 'vip-insert-next-from-insertion-ring) ;; Replace keymap (define-key vip-replace-map "\C-t" 'vip-forward-indent) (define-key vip-replace-map "\C-j" 'vip-replace-state-exit-cmd) (define-key vip-replace-map "\C-m" 'vip-replace-state-exit-cmd) (define-key vip-replace-map "\C-?" 'vip-del-backward-char-in-replace) ;; Vi keymaps (define-key vip-vi-basic-map "\C-^" (function (lambda () (interactive) (vip-ex "e#")))) (define-key vip-vi-basic-map "\C-b" 'vip-scroll-back) (define-key vip-vi-basic-map "\C-d" 'vip-scroll-up) (define-key vip-vi-basic-map "\C-e" 'vip-scroll-up-one) (define-key vip-vi-basic-map "\C-f" 'vip-scroll) (define-key vip-vi-basic-map "\C-m" 'vip-next-line-at-bol) (define-key vip-vi-basic-map "\C-u" 'vip-scroll-down) (define-key vip-vi-basic-map "\C-y" 'vip-scroll-down-one) (define-key vip-vi-basic-map "\C-s" 'vip-isearch-forward) (define-key vip-vi-basic-map "\C-r" 'vip-isearch-backward) ;(define-key vip-vi-basic-map "\C-\\" 'universal-argument) (define-key vip-vi-basic-map "\C-c/" 'vip-toggle-search-style) (define-key vip-vi-basic-map "\C-cg" 'vip-info-on-file) (define-key vip-vi-basic-map "\C-c\M-p" 'vip-prev-destructive-command) (define-key vip-vi-basic-map "\C-c\M-n" 'vip-next-destructive-command) (define-key vip-vi-basic-map " " 'vip-forward-char) (define-key vip-vi-basic-map "!" 'vip-command-argument) (define-key vip-vi-basic-map "\"" 'vip-command-argument) (define-key vip-vi-basic-map "#" 'vip-command-argument) (define-key vip-vi-basic-map "$" 'vip-goto-eol) (define-key vip-vi-basic-map "%" 'vip-paren-match) (define-key vip-vi-basic-map "&" (function (lambda () (interactive) (vip-ex "&")))) (define-key vip-vi-basic-map "'" 'vip-goto-mark-and-skip-white) (define-key vip-vi-basic-map "(" 'vip-backward-sentence) (define-key vip-vi-basic-map ")" 'vip-forward-sentence) (define-key vip-vi-basic-map "*" 'call-last-kbd-macro) (define-key vip-vi-basic-map "+" 'vip-next-line-at-bol) (define-key vip-vi-basic-map "," 'vip-repeat-find-opposite) (define-key vip-vi-basic-map "-" 'vip-previous-line-at-bol) (define-key vip-vi-basic-map "." 'vip-repeat) (define-key vip-vi-basic-map "/" 'vip-search-forward) (define-key vip-vi-basic-map "0" 'vip-beginning-of-line) (define-key vip-vi-basic-map "1" 'vip-digit-argument) (define-key vip-vi-basic-map "2" 'vip-digit-argument) (define-key vip-vi-basic-map "3" 'vip-digit-argument) (define-key vip-vi-basic-map "4" 'vip-digit-argument) (define-key vip-vi-basic-map "5" 'vip-digit-argument) (define-key vip-vi-basic-map "6" 'vip-digit-argument) (define-key vip-vi-basic-map "7" 'vip-digit-argument) (define-key vip-vi-basic-map "8" 'vip-digit-argument) (define-key vip-vi-basic-map "9" 'vip-digit-argument) (define-key vip-vi-basic-map ":" 'vip-ex) (define-key vip-vi-basic-map ";" 'vip-repeat-find) (define-key vip-vi-basic-map "<" 'vip-command-argument) (define-key vip-vi-basic-map "=" 'vip-command-argument) (define-key vip-vi-basic-map ">" 'vip-command-argument) (define-key vip-vi-basic-map "?" 'vip-search-backward) (define-key vip-vi-basic-map "@" 'vip-register-macro) (define-key vip-vi-basic-map "A" 'vip-Append) (define-key vip-vi-basic-map "B" 'vip-backward-Word) (define-key vip-vi-basic-map "C" 'vip-change-to-eol) (define-key vip-vi-basic-map "D" 'vip-kill-line) (define-key vip-vi-basic-map "E" 'vip-end-of-Word) (define-key vip-vi-basic-map "F" 'vip-find-char-backward) (define-key vip-vi-basic-map "G" 'vip-goto-line) (define-key vip-vi-basic-map "H" 'vip-window-top) (define-key vip-vi-basic-map "I" 'vip-Insert) (define-key vip-vi-basic-map "J" 'vip-join-lines) (define-key vip-vi-basic-map "K" 'vip-nil) (define-key vip-vi-basic-map "L" 'vip-window-bottom) (define-key vip-vi-basic-map "M" 'vip-window-middle) (define-key vip-vi-basic-map "N" 'vip-search-Next) (define-key vip-vi-basic-map "O" 'vip-Open-line) (define-key vip-vi-basic-map "P" 'vip-Put-back) (define-key vip-vi-basic-map "Q" 'vip-query-replace) (define-key vip-vi-basic-map "R" 'vip-overwrite) (define-key vip-vi-basic-map "S" 'vip-substitute-line) (define-key vip-vi-basic-map "T" 'vip-goto-char-backward) (define-key vip-vi-basic-map "U" 'vip-undo) (define-key vip-vi-basic-map "V" 'find-file-other-window) (define-key vip-vi-basic-map "W" 'vip-forward-Word) (define-key vip-vi-basic-map "X" 'vip-delete-backward-char) (define-key vip-vi-basic-map "Y" 'vip-yank-line) (define-key vip-vi-basic-map "ZZ" 'vip-save-kill-buffer) (define-key vip-vi-basic-map "\\" 'vip-escape-to-emacs) (define-key vip-vi-basic-map "[" 'vip-brac-function) (define-key vip-vi-basic-map "]" 'vip-ket-function) (define-key vip-vi-basic-map "_" 'vip-alternate-ESC) (define-key vip-vi-basic-map "^" 'vip-bol-and-skip-white) (define-key vip-vi-basic-map "`" 'vip-goto-mark) (define-key vip-vi-basic-map "a" 'vip-append) (define-key vip-vi-basic-map "b" 'vip-backward-word) (define-key vip-vi-basic-map "c" 'vip-command-argument) (define-key vip-vi-basic-map "d" 'vip-command-argument) (define-key vip-vi-basic-map "e" 'vip-end-of-word) (define-key vip-vi-basic-map "f" 'vip-find-char-forward) (define-key vip-vi-basic-map "g" 'vip-nil) (define-key vip-vi-basic-map "h" 'vip-backward-char) (define-key vip-vi-basic-map "i" 'vip-insert) (define-key vip-vi-basic-map "j" 'vip-next-line) (define-key vip-vi-basic-map "k" 'vip-previous-line) (define-key vip-vi-basic-map "l" 'vip-forward-char) (define-key vip-vi-basic-map "m" 'vip-mark-point) (define-key vip-vi-basic-map "n" 'vip-search-next) (define-key vip-vi-basic-map "o" 'vip-open-line) (define-key vip-vi-basic-map "p" 'vip-put-back) (define-key vip-vi-basic-map "q" 'vip-nil) (define-key vip-vi-basic-map "r" 'vip-replace-char) (define-key vip-vi-basic-map "s" 'vip-substitute) (define-key vip-vi-basic-map "t" 'vip-goto-char-forward) (define-key vip-vi-basic-map "u" 'vip-undo) (define-key vip-vi-basic-map "v" 'find-file) (define-key vip-vi-basic-map "\C-v" 'find-file-other-frame) (define-key vip-vi-basic-map "w" 'vip-forward-word) (define-key vip-vi-basic-map "x" 'vip-delete-char) (define-key vip-vi-basic-map "y" 'vip-command-argument) (define-key vip-vi-basic-map "zH" 'vip-line-to-top) (define-key vip-vi-basic-map "zM" 'vip-line-to-middle) (define-key vip-vi-basic-map "zL" 'vip-line-to-bottom) (define-key vip-vi-basic-map "z\C-m" 'vip-line-to-top) (define-key vip-vi-basic-map "z." 'vip-line-to-middle) (define-key vip-vi-basic-map "z-" 'vip-line-to-bottom) (define-key vip-vi-basic-map "{" 'vip-backward-paragraph) (define-key vip-vi-basic-map "|" 'vip-goto-col) (define-key vip-vi-basic-map "}" 'vip-forward-paragraph) (define-key vip-vi-basic-map "~" 'vip-toggle-case) (define-key vip-vi-basic-map "\C-?" 'vip-backward-char) ;;; Escape from Emacs to Vi for one command (global-set-key "\M-\C-z" 'vip-escape-to-vi) ;; in emacs-state ;;; This is vip-vi-diehard-map. Used when vip-vi-diehard-minor-mode is on. (define-key vip-vi-diehard-map "\C-a" 'vip-nil) (define-key vip-vi-diehard-map "\C-c" 'vip-nil) (define-key vip-vi-diehard-map "\C-g" 'vip-info-on-file) (define-key vip-vi-diehard-map "\C-i" 'vip-nil) (define-key vip-vi-diehard-map "\C-k" 'vip-nil) (define-key vip-vi-diehard-map "\C-l" 'redraw-display) (define-key vip-vi-diehard-map "\C-n" 'vip-next-line) (define-key vip-vi-diehard-map "\C-o" 'vip-nil) (define-key vip-vi-diehard-map "\C-p" 'vip-previous-line) (define-key vip-vi-diehard-map "\C-q" 'vip-nil) (define-key vip-vi-diehard-map "\C-r" 'redraw-display) (define-key vip-vi-diehard-map "\C-s" 'vip-nil) (define-key vip-vi-diehard-map "\C-t" 'vip-nil) (define-key vip-vi-diehard-map "\C-v" 'vip-nil) (define-key vip-vi-diehard-map "\C-w" 'vip-nil) (define-key vip-vi-diehard-map "@" 'vip-nil) (define-key vip-vi-diehard-map "*" 'vip-nil) (define-key vip-vi-diehard-map "#" 'vip-nil) (define-key vip-vi-diehard-map "\C-_" 'vip-nil) (define-key vip-vi-diehard-map "\C-]" 'vip-nil);; This is actually tags. ;;; Minibuffer keymap (defvar vip-minibuffer-map (make-sparse-keymap) "Keymap used to modify keys when Minibuffer is in Insert state.") (define-key vip-minibuffer-map "\C-m" 'vip-exit-minibuffer) (define-key vip-minibuffer-map "\C-j" 'vip-exit-minibuffer) ;; Map used to read Ex-style commands. (defvar vip-ex-cmd-map (make-sparse-keymap)) (define-key vip-ex-cmd-map " " 'ex-cmd-read-exit) (define-key vip-ex-cmd-map "\t" 'ex-cmd-complete) ;; Keymap for reading file names in Ex-style commands. (defvar ex-read-filename-map (make-sparse-keymap)) (define-key ex-read-filename-map " " 'vip-complete-filename-or-exit) ;;; Code (defun vip-add-local-keys (state alist) "Override some vi-state or insert-state bindings in the current buffer. The effect is seen in the current buffer only. Useful for customizing mailer buffers, gnus, etc. STATE is 'vi-state, 'insert-state, or 'emacs-state ALIST is of the form ((key . func) (key . func) ...) Normally, this would be called from a hook to a major mode or on a per buffer basis. Usage: (vip-add-local-keys state '((key-str . func) (key-str . func)...)) " (let (map) (cond ((eq state 'vi-state) (if vip-need-new-vi-local-map (setq vip-vi-local-user-map (make-sparse-keymap))) (setq vip-need-new-vi-local-map nil map vip-vi-local-user-map)) ((eq state 'insert-state) (if vip-need-new-insert-local-map (setq vip-insert-local-user-map (make-sparse-keymap))) (setq vip-need-new-insert-local-map nil map vip-insert-local-user-map)) ((eq state 'emacs-state) (if vip-need-new-emacs-local-map (setq vip-emacs-local-user-map (make-sparse-keymap))) (setq vip-need-new-emacs-local-map nil map vip-emacs-local-user-map)) (t (error "Invalid state in vip-add-local-keys: %S. Valid states: vi-state, insert-state or emacs-state" state))) (vip-modify-keymap map alist) (vip-normalize-minor-mode-map-alist) (vip-set-mode-vars-for vip-current-state))) (defun vip-modify-major-mode (mode state keymap) "Modify key bindings in a major-mode in a Viper state using a keymap. If the default for a major mode is emacs-state, then modifications to this major mode may not take effect until the buffer switches state to Vi, Insert or Emacs. If this happens, add vip-change-state-to-emacs to this major mode's hook. If no such hook exists, you may have to put an advice on the function that invokes the major mode. See vip-set-hooks for hints. The above needs not to be done for major modes that come up in Vi or Insert state by default. Arguments: (major-mode vip-state keymap)" (let ((alist (cond ((eq state 'vi-state) 'vip-vi-state-modifier-alist) ((eq state 'insert-state) 'vip-insert-state-modifier-alist) ((eq state 'emacs-state) 'vip-emacs-state-modifier-alist))) elt) (if (setq elt (assoc mode (eval alist))) (set alist (delq elt (eval alist)))) (set alist (cons (cons mode keymap) (eval alist))) ;; Normalization usually doesn't help here, since one needs to ;; normalize in the actual buffer where changes to the keymap are ;; to take place. However, it doesn't hurt, and it helps whenever this ;; function is actually called from within the right buffer. (vip-normalize-minor-mode-map-alist) (vip-set-mode-vars-for vip-current-state))) ;; Displays variables that control Viper's keymaps (defun vip-debug-keymaps () (interactive) (with-output-to-temp-buffer " *vip-debug*" (princ (format "Buffer name: %s\n\n" (buffer-name))) (princ "Variables: \n") (princ (format "major-mode: %S\n" major-mode)) (princ (format "vip-current-state: %S\n" vip-current-state)) (princ (format "vip-mode-string: %S\n\n" vip-mode-string)) (princ (format "vip-vi-intercept-minor-mode: %S\n" vip-vi-intercept-minor-mode)) (princ (format "vip-insert-intercept-minor-mode: %S\n" vip-insert-intercept-minor-mode)) (princ (format "vip-emacs-intercept-minor-mode: %S\n" vip-emacs-intercept-minor-mode)) (princ (format "vip-vi-minibuffer-minor-mode: %S\n" vip-vi-minibuffer-minor-mode)) (princ (format "vip-insert-minibuffer-minor-mode: %S\n\n" vip-insert-minibuffer-minor-mode)) (princ (format "vip-vi-local-user-minor-mode: %S\n" vip-vi-local-user-minor-mode)) (princ (format "vip-vi-global-user-minor-mode: %S\n" vip-vi-global-user-minor-mode)) (princ (format "vip-vi-kbd-minor-mode: %S\n" vip-vi-kbd-minor-mode)) (princ (format "vip-vi-state-modifier-minor-mode: %S\n" vip-vi-state-modifier-minor-mode)) (princ (format "vip-vi-diehard-minor-mode: %S\n" vip-vi-diehard-minor-mode)) (princ (format "vip-vi-basic-minor-mode: %S\n" vip-vi-basic-minor-mode)) (princ (format "vip-replace-minor-mode: %S\n" vip-replace-minor-mode)) (princ (format "vip-insert-local-user-minor-mode: %S\n" vip-insert-local-user-minor-mode)) (princ (format "vip-insert-global-user-minor-mode: %S\n" vip-insert-global-user-minor-mode)) (princ (format "vip-insert-kbd-minor-mode: %S\n" vip-insert-kbd-minor-mode)) (princ (format "vip-insert-state-modifier-minor-mode: %S\n" vip-insert-state-modifier-minor-mode)) (princ (format "vip-insert-diehard-minor-mode: %S\n" vip-insert-diehard-minor-mode)) (princ (format "vip-insert-basic-minor-mode: %S\n" vip-insert-basic-minor-mode)) (princ (format "vip-emacs-local-user-minor-mode: %S\n" vip-emacs-local-user-minor-mode)) (princ (format "vip-emacs-kbd-minor-mode: %S\n" vip-emacs-kbd-minor-mode)) (princ (format "vip-emacs-global-user-minor-mode: %S\n" vip-emacs-global-user-minor-mode)) (princ (format "vip-emacs-state-modifier-minor-mode: %S\n" vip-emacs-state-modifier-minor-mode)) (princ (format "\nvip-expert-level %S\n" vip-expert-level)) (princ (format "vip-no-multiple-ESC %S\n" vip-no-multiple-ESC)) (princ (format "vip-always %S\n" vip-always)) (princ (format "vip-ex-style-motion %S\n" vip-ex-style-motion)) (princ (format "vip-ex-style-editing-in-insert %S\n" vip-ex-style-editing-in-insert)) (princ (format "vip-want-emacs-keys-in-vi %S\n" vip-want-emacs-keys-in-vi)) (princ (format "vip-want-emacs-keys-in-insert %S\n" vip-want-emacs-keys-in-insert)) (princ (format "vip-want-ctl-h-help %S\n" vip-want-ctl-h-help)) (princ "\n\n\n") (princ (format "Default value for minor-mode-map-alist: \n%S\n\n" (default-value 'minor-mode-map-alist))) (princ (format "Actual value for minor-mode-map-alist: \n%S\n" minor-mode-map-alist)) )) ;;; Keymap utils (defun vip-add-keymap (mapsrc mapdst) "Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse." (if vip-xemacs-p (map-keymap (function (lambda (key binding) (define-key mapdst key binding))) mapsrc) (mapcar (function (lambda (p) (define-key mapdst (vector (car p)) (cdr p)) )) (cdr mapsrc)))) (defun vip-modify-keymap (map alist) "Modifies MAP with bindings specified in the ALIST. The alist has the form ((key . function) (key . function) ... )." (mapcar (function (lambda (p) (define-key map (eval (car p)) (cdr p)))) alist)) (provide 'viper-keym) ;;; viper-keym.el ends here emacs-19.30/lisp/viper-macs.el100444 12120 1 73505 6045206151 14470 0ustar rmsdaemon;;; viper-macs.el --- functions implementing keyboard macros for Viper ;; Copyright (C) 1994, 1995 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. (require 'viper-util) ;;; Variables ;; Register holding last macro. (defvar vip-last-macro-reg nil) ;; format of the elements of kbd alists: ;; (name ((buf . macr)...(buf . macr)) ((maj-mode . macr)...) (t . macr)) ;; kbd macro alist for Vi state (defvar vip-vi-kbd-macro-alist nil) ;; same for insert/replace state (defvar vip-insert-kbd-macro-alist nil) ;; same for emacs state (defvar vip-emacs-kbd-macro-alist nil) ;; Internal var that passes info between start-kbd-macro and end-kbd-macro ;; in :map and :map! (defvar vip-kbd-macro-parameters nil) (defvar vip-this-kbd-macro nil "Vector of keys representing the name of currently running Viper kbd macro.") (defvar vip-last-kbd-macro nil "Vector of keys representing the name of last Viper keyboard macro.") (defconst vip-fast-keyseq-timeout 200 "*Key sequence separated by no more than this many milliseconds is viewed as a macro, if such a macro is defined. This also controls ESC-keysequences generated by keyboard function keys.") (defvar vip-repeat-from-history-key 'f12 "Prefix key for invocation of vip-repeat-from-history function, which repeats previous destructive commands from the history of such commands. This function can then be invoked as 1 or 2. The notation for these keys is borrowed from XEmacs. Basically, a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g., `(meta control f1)'.") ;;; Code ;; Ex map command (defun ex-map () (let ((mod-char "") macro-name macro-body map-args ins) (save-window-excursion (set-buffer vip-ex-work-buf) (if (looking-at "!") (progn (setq ins t mod-char "!") (forward-char 1)))) (setq map-args (ex-map-read-args mod-char) macro-name (car map-args) macro-body (cdr map-args)) (setq vip-kbd-macro-parameters (list ins mod-char macro-name macro-body)) (if macro-body (vip-end-mapping-kbd-macro 'ignore) (ex-fixup-history (format "map%s %S" mod-char (vip-display-macro macro-name))) ;; if defining macro for insert, switch there for authentic WYSIWYG (if ins (vip-change-state-to-insert)) (start-kbd-macro nil) (define-key vip-vi-intercept-map "\C-x)" 'vip-end-mapping-kbd-macro) (define-key vip-insert-intercept-map "\C-x)" 'vip-end-mapping-kbd-macro) (define-key vip-emacs-intercept-map "\C-x)" 'vip-end-mapping-kbd-macro) (message "Mapping %S in %s state. Hit `C-x )' to complete the mapping" (vip-display-macro macro-name) (if ins "Insert" "Vi"))) )) ;; Ex unmap (defun ex-unmap () (let ((mod-char "") temp macro-name ins) (save-window-excursion (set-buffer vip-ex-work-buf) (if (looking-at "!") (progn (setq ins t mod-char "!") (forward-char 1)))) (setq macro-name (ex-unmap-read-args mod-char)) (setq temp (vip-fixup-macro (vconcat macro-name))) ;; copy and fixup (ex-fixup-history (format "unmap%s %S" mod-char (vip-display-macro temp))) (vip-unrecord-kbd-macro macro-name (if ins 'insert-state 'vi-state)) )) ;; read arguments for ex-map (defun ex-map-read-args (variant) (let ((cursor-in-echo-area t) (key-seq []) temp key event message macro-name macro-body args) (condition-case nil (setq args (concat (ex-get-inline-cmd-args ".*map[!]*[ \t]?" "\n\C-m") " nil nil ") temp (read-from-string args) macro-name (car temp) macro-body (car (read-from-string args (cdr temp)))) (error (signal 'error '("map: Macro name and body must be a quoted string or a vector")))) ;; We expect macro-name to be a vector, a string, or a quoted string. ;; In the second case, it will emerge as a symbol when read from ;; the above read-from-string. So we need to convert it into a string (if macro-name (cond ((vectorp macro-name) nil) ((stringp macro-name) (setq macro-name (vconcat macro-name))) (t (setq macro-name (vconcat (prin1-to-string macro-name))))) (message ":map%s " variant)(sit-for 2) (while (not (member key '(?\C-m ?\n (control m) (control j) return linefeed))) (setq key-seq (vconcat key-seq (if key (vector key) []))) ;; the only keys available for editing are these-- no help while there (if (member key '(?\b ?\d '^? '^H (control h) (control \?) backspace delete)) (setq key-seq (subseq key-seq 0 (- (length key-seq) 2)))) (setq message (format ":map%s %s" variant (if (> (length key-seq) 0) (prin1-to-string (vip-display-macro key-seq)) ""))) (message message) (setq event (vip-read-key)) ;;(setq event (vip-read-event)) (setq key (if (vip-mouse-event-p event) (progn (message "%s (No mouse---only keyboard keys, please)" message) (sit-for 2) nil) (vip-event-key event))) ) (setq macro-name key-seq)) (if (= (length macro-name) 0) (error "Can't map an empty macro name")) (setq macro-name (vip-fixup-macro macro-name)) (if (vip-char-array-p macro-name) (setq macro-name (vip-char-array-to-macro macro-name))) (if macro-body (cond ((vip-char-array-p macro-body) (setq macro-body (vip-char-array-to-macro macro-body))) ((vectorp macro-body) nil) (t (error "map: Invalid syntax in macro definition")))) (setq cursor-in-echo-area nil)(sit-for 0) ; this overcomes xemacs tty bug (cons macro-name macro-body))) ;; read arguments for ex-unmap (defun ex-unmap-read-args (variant) (let ((cursor-in-echo-area t) (macro-alist (if (string= variant "!") vip-insert-kbd-macro-alist vip-vi-kbd-macro-alist)) ;; these are disabled just in case, to avoid surprises when doing ;; completing-read vip-vi-kbd-minor-mode vip-insert-kbd-minor-mode vip-emacs-kbd-minor-mode vip-vi-intercept-minor-mode vip-insert-intercept-minor-mode vip-emacs-intercept-minor-mode event message key key-seq macro-name) (setq macro-name (ex-get-inline-cmd-args ".*unma?p?[!]*[ \t]*")) (if (> (length macro-name) 0) () (message ":unmap%s " variant) (sit-for 2) (while (not (member key '(?\C-m ?\n (control m) (control j) return linefeed))) (setq key-seq (vconcat key-seq (if key (vector key) []))) ;; the only keys available for editing are these-- no help while there (cond ((member key '(?\b ?\d '^? '^H (control h) (control \?) backspace delete)) (setq key-seq (subseq key-seq 0 (- (length key-seq) 2)))) ((member key '(tab (control i) ?\t)) (setq key-seq (subseq key-seq 0 (1- (length key-seq)))) (setq message (format ":unmap%s %s" variant (if (> (length key-seq) 0) (prin1-to-string (vip-display-macro key-seq)) ""))) (setq key-seq (vip-do-sequence-completion key-seq macro-alist message)) )) (setq message (format ":unmap%s %s" variant (if (> (length key-seq) 0) (prin1-to-string (vip-display-macro key-seq)) ""))) (message message) (setq event (vip-read-key)) ;;(setq event (vip-read-event)) (setq key (if (vip-mouse-event-p event) (progn (message "%s (No mouse---only keyboard keys, please)" message) (sit-for 2) nil) (vip-event-key event))) ) (setq macro-name key-seq)) (if (= (length macro-name) 0) (error "Can't unmap an empty macro name")) ;; convert macro names into vector, if starts with a `[' (if (memq (elt macro-name 0) '(?\[ ?\")) (car (read-from-string macro-name)) (vconcat macro-name)) )) (defun vip-end-mapping-kbd-macro (&optional ignore) "Terminate kbd macro." (interactive) (define-key vip-vi-intercept-map "\C-x)" nil) (define-key vip-insert-intercept-map "\C-x)" nil) (define-key vip-emacs-intercept-map "\C-x)" nil) (if (and (not ignore) (or (not vip-kbd-macro-parameters) (not defining-kbd-macro))) (error "Not mapping a kbd-macro")) (let ((mod-char (nth 1 vip-kbd-macro-parameters)) (ins (nth 0 vip-kbd-macro-parameters)) (macro-name (nth 2 vip-kbd-macro-parameters)) (macro-body (nth 3 vip-kbd-macro-parameters))) (setq vip-kbd-macro-parameters nil) (or ignore (progn (end-kbd-macro nil) (setq macro-body (vip-events-to-macro last-kbd-macro)) ;; always go back to Vi, since this is where we started ;; defining macro (vip-change-state-to-vi))) (vip-record-kbd-macro macro-name (if ins 'insert-state 'vi-state) (vip-display-macro macro-body)) (ex-fixup-history (format "map%s %S %S" mod-char (vip-display-macro macro-name) (vip-display-macro macro-body))) )) (defadvice start-kbd-macro (after vip-kbd-advice activate) "Remove Viper's intercepting bindings for C-x ). This may be needed if the previous `:map' command terminated abnormally." (define-key vip-vi-intercept-map "\C-x)" nil) (define-key vip-insert-intercept-map "\C-x)" nil) (define-key vip-emacs-intercept-map "\C-x)" nil)) ;;; Recording, unrecording, executing ;; accepts as macro names: strings and vectors. ;; strings must be strings of characters; vectors must be vectors of keys ;; in canonic form. the canonic form is essentially the form used in XEmacs (defun vip-record-kbd-macro (macro-name state macro-body &optional scope) "Record a Vi macro. Can be used in `.vip' file to define permanent macros. MACRO-NAME is a string of characters or a vector of keys. STATE is either `vi-state' or `insert-state'. It specifies the Viper state in which to define the macro. MACRO-BODY is a string that represents the keyboard macro. Optional SCOPE says whether the macro should be global \(t\), mode-specific \(a major-mode symbol\), or buffer-specific \(buffer name, a string\). If SCOPE is nil, the user is asked to specify the scope." (let* (state-name keymap (macro-alist-var (cond ((eq state 'vi-state) (setq state-name "Vi state" keymap vip-vi-kbd-map) 'vip-vi-kbd-macro-alist) ((memq state '(insert-state replace-state)) (setq state-name "Insert state" keymap vip-insert-kbd-map) 'vip-insert-kbd-macro-alist) (t (setq state-name "Emacs state" keymap vip-emacs-kbd-map) 'vip-emacs-kbd-macro-alist) )) new-elt old-elt old-sub-elt msg temp lis lis2) (if (= (length macro-name) 0) (error "Can't map an empty macro name")) ;; Macro-name is usually a vector. However, command history or macros ;; recorded in ~/.vip may be recorded as strings. So, convert to vectors. (setq macro-name (vip-fixup-macro macro-name)) (if (vip-char-array-p macro-name) (setq macro-name (vip-char-array-to-macro macro-name))) (setq macro-body (vip-fixup-macro macro-body)) (if (vip-char-array-p macro-body) (setq macro-body (vip-char-array-to-macro macro-body))) ;; don't ask if scope is given and is of the right type (or (eq scope t) (stringp scope) (and scope (symbolp scope)) (progn (setq scope (cond ((y-or-n-p (format "Map this macro for buffer `%s' only? " (buffer-name))) (setq msg (format "%S is mapped to %s for %s in `%s'" (vip-display-macro macro-name) (vip-abbreviate-string (format "%S" (setq temp (vip-display-macro macro-body))) 14 "" "" (if (stringp temp) " ....\"" " ....]")) state-name (buffer-name))) (buffer-name)) ((y-or-n-p (format "Map this macro for the major mode `%S' only? " major-mode)) (setq msg (format "%S is mapped to %s for %s in `%S'" (vip-display-macro macro-name) (vip-abbreviate-string (format "%S" (setq temp (vip-display-macro macro-body))) 14 "" "" (if (stringp macro-body) " ....\"" " ....]")) state-name major-mode)) major-mode) (t (setq msg (format "%S is globally mapped to %s in %s" (vip-display-macro macro-name) (vip-abbreviate-string (format "%S" (setq temp (vip-display-macro macro-body))) 14 "" "" (if (stringp macro-body) " ....\"" " ....]")) state-name)) t))) (if (y-or-n-p (format "Save this macro in %s? " (abbreviate-file-name vip-custom-file-name))) (vip-save-string-in-file (format "\n(vip-record-kbd-macro %S '%S %s '%S)" (vip-display-macro macro-name) state ;; if we don't let vector macro-body through %S, ;; the symbols `\.' `\[' etc will be converted into ;; characters, causing invalid read error on recorded ;; macros in .vip. ;; I am not sure is macro-body can still be a string at ;; this point, but I am preserving this option anyway. (if (vectorp macro-body) (format "%S" macro-body) macro-body) scope) vip-custom-file-name)) (message msg) )) (setq new-elt (cons macro-name (cond ((eq scope t) (list nil nil (cons t nil))) ((symbolp scope) (list nil (list (cons scope nil)) (cons t nil))) ((stringp scope) (list (list (cons scope nil)) nil (cons t nil)))))) (setq old-elt (assoc macro-name (eval macro-alist-var))) (if (null old-elt) (progn ;; insert new-elt in macro-alist-var and keep the list sorted (define-key keymap (vector (vip-key-to-emacs-key (aref macro-name 0))) 'vip-exec-mapped-kbd-macro) (setq lis (eval macro-alist-var)) (while (and lis (string< (vip-array-to-string (car (car lis))) (vip-array-to-string macro-name))) (setq lis2 (cons (car lis) lis2)) (setq lis (cdr lis))) (setq lis2 (reverse lis2)) (set macro-alist-var (append lis2 (cons new-elt lis))) (setq old-elt new-elt))) (setq old-sub-elt (cond ((eq scope t) (vip-kbd-global-pair old-elt)) ((symbolp scope) (assoc scope (vip-kbd-mode-alist old-elt))) ((stringp scope) (assoc scope (vip-kbd-buf-alist old-elt))))) (if old-sub-elt (setcdr old-sub-elt macro-body) (cond ((symbolp scope) (setcar (cdr (cdr old-elt)) (cons (cons scope macro-body) (vip-kbd-mode-alist old-elt)))) ((stringp scope) (setcar (cdr old-elt) (cons (cons scope macro-body) (vip-kbd-buf-alist old-elt)))))) )) ;; macro name must be a vector of vip-style keys (defun vip-unrecord-kbd-macro (macro-name state) "Delete macro MACRO-NAME from Viper STATE. MACRO-NAME must be a vector of vip-style keys. This command is used by Viper internally, but the user can also use it in ~/.vip to delete pre-defined macros supplied with Viper. The best way to avoid mistakes in macro names to be passed to this function is to use vip-describe-kbd-macros and copy the name from there." (let* (state-name keymap (macro-alist-var (cond ((eq state 'vi-state) (setq state-name "Vi state" keymap vip-vi-kbd-map) 'vip-vi-kbd-macro-alist) ((memq state '(insert-state replace-state)) (setq state-name "Insert state" keymap vip-insert-kbd-map) 'vip-insert-kbd-macro-alist) (t (setq state-name "Emacs state" keymap vip-emacs-kbd-map) 'vip-emacs-kbd-macro-alist) )) buf-mapping mode-mapping global-mapping macro-pair macro-entry) ;; Macro-name is usually a vector. However, command history or macros ;; recorded in ~/.vip may appear as strings. So, convert to vectors. (setq macro-name (vip-fixup-macro macro-name)) (if (vip-char-array-p macro-name) (setq macro-name (vip-char-array-to-macro macro-name))) (setq macro-entry (assoc macro-name (eval macro-alist-var))) (if (= (length macro-name) 0) (error "Can't unmap an empty macro name")) (if (null macro-entry) (error "%S is not mapped to a macro for %s in `%s'" (vip-display-macro macro-name) state-name (buffer-name))) (setq buf-mapping (vip-kbd-buf-pair macro-entry) mode-mapping (vip-kbd-mode-pair macro-entry) global-mapping (vip-kbd-global-pair macro-entry)) (cond ((and (cdr buf-mapping) (or (and (not (cdr mode-mapping)) (not (cdr global-mapping))) (y-or-n-p (format "Unmap %S for `%s' only? " (vip-display-macro macro-name) (buffer-name))))) (setq macro-pair buf-mapping) (message "%S is unmapped for %s in `%s'" (vip-display-macro macro-name) state-name (buffer-name))) ((and (cdr mode-mapping) (or (not (cdr global-mapping)) (y-or-n-p (format "Unmap %S for the major mode `%S' only? " (vip-display-macro macro-name) major-mode)))) (setq macro-pair mode-mapping) (message "%S is unmapped for %s in %S" (vip-display-macro macro-name) state-name major-mode)) ((cdr (setq macro-pair (vip-kbd-global-pair macro-entry))) (message "Global mapping of %S for %s is removed" (vip-display-macro macro-name) state-name)) (t (error "%S is not mapped to a macro for %s in `%s'" (vip-display-macro macro-name) state-name (buffer-name)))) (setcdr macro-pair nil) (or (cdr buf-mapping) (cdr mode-mapping) (cdr global-mapping) (progn (set macro-alist-var (delq macro-entry (eval macro-alist-var))) (if (vip-can-release-key (aref macro-name 0) (eval macro-alist-var)) (define-key keymap (vector (vip-key-to-emacs-key (aref macro-name 0))) nil)) )) )) ;; Check if MACRO-ALIST has an entry for a macro name starting with ;; CHAR. If not, this indicates that the binding for this char ;; in vip-vi/insert-kbd-map can be released. (defun vip-can-release-key (char macro-alist) (let ((lis macro-alist) (can-release t) macro-name) (while (and lis can-release) (setq macro-name (car (car lis))) (if (eq char (aref macro-name 0)) (setq can-release nil)) (setq lis (cdr lis))) can-release)) (defun vip-exec-mapped-kbd-macro (count) "Dispatch kbd macro." (interactive "P") (let* ((macro-alist (cond ((eq vip-current-state 'vi-state) vip-vi-kbd-macro-alist) ((memq vip-current-state '(insert-state replace-state)) vip-insert-kbd-macro-alist) (t vip-emacs-kbd-macro-alist))) (unmatched-suffix "") ;; Macros and keys are executed with other macros turned off ;; For macros, this is done to avoid macro recursion vip-vi-kbd-minor-mode vip-insert-kbd-minor-mode vip-emacs-kbd-minor-mode next-best-match keyseq event-seq macro-first-char macro-alist-elt macro-body command) (setq macro-first-char last-command-event event-seq (vip-read-fast-keysequence macro-first-char macro-alist) keyseq (vip-events-to-macro event-seq) macro-alist-elt (assoc keyseq macro-alist) next-best-match (vip-find-best-matching-macro macro-alist keyseq)) (if (null macro-alist-elt) (setq macro-alist-elt (car next-best-match) unmatched-suffix (subseq event-seq (cdr next-best-match)))) (cond ((null macro-alist-elt)) ((setq macro-body (vip-kbd-buf-definition macro-alist-elt))) ((setq macro-body (vip-kbd-mode-definition macro-alist-elt))) ((setq macro-body (vip-kbd-global-definition macro-alist-elt)))) ;; when defining keyboard macro, don't use the macro mappings (if (and macro-body (not defining-kbd-macro)) ;; block cmd executed as part of a macro from entering command history (let ((command-history command-history)) (setq vip-this-kbd-macro (car macro-alist-elt)) (execute-kbd-macro (vip-macro-to-events macro-body) count) (setq vip-this-kbd-macro nil vip-last-kbd-macro (car macro-alist-elt)) (vip-set-unread-command-events unmatched-suffix)) ;; If not a macro, or the macro is suppressed while defining another ;; macro, put keyseq back on the event queue (vip-set-unread-command-events event-seq) ;; if the user typed arg, then use it if prefix arg is not set by ;; some other command (setting prefix arg can happen if we do, say, ;; 2dw and there is a macro starting with 2. Then control will go to ;; this routine (or prefix-arg (setq prefix-arg count)) (setq command (key-binding (read-key-sequence nil))) (if (commandp command) (command-execute command) (beep 1))) )) ;;; Displaying and completing macros (defun vip-describe-kbd-macros () "Show currently defined keyboard macros." (interactive) (with-output-to-temp-buffer " *vip-info*" (princ "Macros in Vi state:\n===================\n") (mapcar 'vip-describe-one-macro vip-vi-kbd-macro-alist) (princ "\n\nMacros in Insert and Replace states:\n====================================\n") (mapcar 'vip-describe-one-macro vip-insert-kbd-macro-alist) (princ "\n\nMacros in Emacs state:\n======================\n") (mapcar 'vip-describe-one-macro vip-emacs-kbd-macro-alist) )) (defun vip-describe-one-macro (macro) (princ (format "\n *** Mappings for %S:\n ------------\n" (vip-display-macro (car macro)))) (princ " ** Buffer-specific:") (if (vip-kbd-buf-alist macro) (mapcar 'vip-describe-one-macro-elt (vip-kbd-buf-alist macro)) (princ " none\n")) (princ "\n ** Mode-specific:") (if (vip-kbd-mode-alist macro) (mapcar 'vip-describe-one-macro-elt (vip-kbd-mode-alist macro)) (princ " none\n")) (princ "\n ** Global:") (if (vip-kbd-global-definition macro) (princ (format "\n %S" (cdr (vip-kbd-global-pair macro)))) (princ " none")) (princ "\n")) (defun vip-describe-one-macro-elt (elt) (let ((name (car elt)) (defn (cdr elt))) (princ (format "\n * %S:\n %S\n" name defn)))) ;; check if SEQ is a prefix of some car of an element in ALIST (defun vip-keyseq-is-a-possible-macro (seq alist) (let ((converted-seq (vip-events-to-macro seq))) (eval (cons 'or (mapcar (function (lambda (elt) (vip-prefix-subseq-p converted-seq elt))) (vip-this-buffer-macros alist)))))) ;; whether SEQ1 is a prefix of SEQ2 (defun vip-prefix-subseq-p (seq1 seq2) (let ((len1 (length seq1)) (len2 (length seq2))) (if (<= len1 len2) (equal seq1 (subseq seq2 0 len1))))) ;; find the longest common prefix (defun vip-common-seq-prefix (&rest seqs) (let* ((first (car seqs)) (rest (cdr seqs)) (pref []) (idx 0) len) (if (= (length seqs) 0) (setq len 0) (setq len (apply 'min (mapcar 'length seqs)))) (while (< idx len) (if (eval (cons 'and (mapcar (function (lambda (s) (equal (elt first idx) (elt s idx)))) rest))) (setq pref (vconcat pref (vector (elt first idx))))) (setq idx (1+ idx))) pref)) ;; get all sequences that match PREFIX from a given A-LIST (defun vip-extract-matching-alist-members (pref alist) (delq nil (mapcar (function (lambda (elt) (if (vip-prefix-subseq-p pref elt) elt))) (vip-this-buffer-macros alist)))) (defun vip-do-sequence-completion (seq alist compl-message) (let* ((matches (vip-extract-matching-alist-members seq alist)) (new-seq (apply 'vip-common-seq-prefix matches)) ) (cond ((and (equal seq new-seq) (= (length matches) 1)) (message "%s (Sole completion)" compl-message) (sit-for 2)) ((null matches) (message "%s (No match)" compl-message) (sit-for 2) (setq new-seq seq)) ((member seq matches) (message "%s (Complete, but not unique)" compl-message) (sit-for 2) (vip-display-vector-completions matches)) ((equal seq new-seq) (vip-display-vector-completions matches))) new-seq)) (defun vip-display-vector-completions (list) (with-output-to-temp-buffer "*Completions*" (display-completion-list (mapcar 'prin1-to-string (mapcar 'vip-display-macro list))))) ;; alist is the alist of macros ;; str is the fast key sequence entered ;; returns: (matching-macro-def . unmatched-suffix-start-index) (defun vip-find-best-matching-macro (alist str) (let ((lis alist) (def-len 0) (str-len (length str)) match unmatched-start-idx found macro-def) (while (and (not found) lis) (setq macro-def (car lis) def-len (length (car macro-def))) (if (and (>= str-len def-len) (equal (car macro-def) (subseq str 0 def-len))) (if (or (vip-kbd-buf-definition macro-def) (vip-kbd-mode-definition macro-def) (vip-kbd-global-definition macro-def)) (setq found t)) ) (setq lis (cdr lis))) (if found (setq match macro-def unmatched-start-idx def-len) (setq match nil unmatched-start-idx 0)) (cons match unmatched-start-idx))) ;; returns a list of names of macros defined for the current buffer (defun vip-this-buffer-macros (macro-alist) (let (candidates) (setq candidates (mapcar (function (lambda (elt) (if (or (vip-kbd-buf-definition elt) (vip-kbd-mode-definition elt) (vip-kbd-global-definition elt)) (car elt)))) macro-alist)) (setq candidates (delq nil candidates)))) ;; if seq of Viper key symbols (representing a macro) can be converted to a ;; string--do so. Otherwise, do nothing. (defun vip-display-macro (macro-name) (cond ((vip-char-symbol-sequence-p macro-name) (mapconcat 'symbol-name macro-name "")) ((vip-char-array-p macro-name) (mapconcat 'char-to-string macro-name "")) (t macro-name))) (defun vip-events-to-macro (event-seq) (vconcat (mapcar 'vip-event-key event-seq))) ;; convert strings or arrays of characters to Viper macro form (defun vip-char-array-to-macro (array) (let ((vec (vconcat array)) macro) (if vip-xemacs-p (setq macro (mapcar 'character-to-event vec)) (setq macro vec)) (vconcat (mapcar 'vip-event-key macro)))) ;; For macros bodies and names, goes over and checks if all members are ;; names of keys (actually, it only checks if they are symbols or lists ;; if a digit is found, it is converted into a symbol (0 -> \0, etc). ;; If not list or vector, doesn't change its argument (defun vip-fixup-macro (macro) (let ((len (length macro)) (idx 0) elt break) (if (or (vectorp macro) (listp macro)) (while (and (< idx len) (not break)) (setq elt (elt macro idx)) (cond ((numberp elt) ;; fix number (if (and (<= 0 elt) (<= elt 9)) (cond ((arrayp macro) (aset macro idx (intern (char-to-string (+ ?0 elt))))) ((listp macro) (setcar (nthcdr idx macro) (intern (char-to-string (+ ?0 elt))))) ))) ;;(setq break t))) ((listp elt) (vip-fixup-macro elt)) ((symbolp elt) nil) (t (setq break t))) (setq idx (1+ idx)))) (if break (error "Wrong type macro component, symbol-or-listp, %S" elt) macro))) (defun vip-char-array-p (array) (eval (cons 'and (mapcar 'numberp array)))) (defun vip-macro-to-events (macro-body) (vconcat (mapcar 'vip-key-to-emacs-key macro-body))) ;; check if vec is a vector of character symbols (defun vip-char-symbol-sequence-p (vec) (and (sequencep vec) (eval (cons 'and (mapcar (function (lambda (elt) (and (symbolp elt) (= (length (symbol-name elt)) 1)))) vec))))) ;; Check if vec is a vector of key-press events representing characters ;; XEmacs only (defun vip-event-vector-p (vec) (and (vectorp vec) (eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec))))) ;;; Reading fast key sequences ;; Assuming that CHAR was the first character in a fast succession of key ;; strokes, read the rest. Return the vector of keys that was entered in ;; this fast succession of key strokes. ;; A fast keysequence is one that is terminated by a pause longer than ;; vip-fast-keyseq-timeout. (defun vip-read-fast-keysequence (event macro-alist) (let ((lis (vector event)) next-event) (while (and (vip-fast-keysequence-p) (vip-keyseq-is-a-possible-macro lis macro-alist)) (setq next-event (vip-read-key)) ;;(setq next-event (vip-read-event)) (or (vip-mouse-event-p next-event) (setq lis (vconcat lis (vector next-event))))) lis)) ;;; Keyboard macros in registers ;; sets register to last-kbd-macro carefully. (defun vip-set-register-macro (reg) (if (get-register reg) (if (y-or-n-p "Register contains data. Overwrite? ") () (error "Macro not saved in register. Can still be invoked via `C-x e'"))) (set-register reg last-kbd-macro)) (defun vip-register-macro (count) "Keyboard macros in registers - a modified \@ command." (interactive "P") (let ((reg (downcase (read-char)))) (cond ((or (and (<= ?a reg) (<= reg ?z))) (setq vip-last-macro-reg reg) (if defining-kbd-macro (progn (end-kbd-macro) (vip-set-register-macro reg)) (execute-kbd-macro (get-register reg) count))) ((or (= ?@ reg) (= ?\^j reg) (= ?\^m reg)) (if vip-last-macro-reg nil (error "No previous kbd macro")) (execute-kbd-macro (get-register vip-last-macro-reg) count)) ((= ?\# reg) (start-kbd-macro count)) ((= ?! reg) (setq reg (downcase (read-char))) (if (or (and (<= ?a reg) (<= reg ?z))) (progn (setq vip-last-macro-reg reg) (vip-set-register-macro reg)))) (t (error (format "`%c': Unknown register" reg)))))) (defun vip-global-execute () "Call last keyboad macro for each line in the region." (if (> (point) (mark t)) (exchange-point-and-mark)) (beginning-of-line) (call-last-kbd-macro) (while (< (point) (mark t)) (forward-line 1) (beginning-of-line) (call-last-kbd-macro))) (provide 'viper-macs) ;;; viper-macs.el ends here emacs-19.30/lisp/viper-mous.el100444 12120 1 40646 6045206203 14526 0ustar rmsdaemon;;; viper-mous.el --- mouse support for Viper ;; Copyright (C) 1994, 1995 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. (require 'viper-util) ;;; Variables ;; Variable used for catching the switch-frame event. ;; If non-nil, indicates that previous-frame should be the selected ;; one. Used by vip-mouse-click-get-word. Not a user option. (defvar vip-frame-of-focus nil) ;; Frame that was selected before the switch-frame event. (defconst vip-current-frame-saved (selected-frame)) (defvar vip-surrounding-word-function 'vip-surrounding-word "*Function that determines what constitutes a word for clicking events. Takes two parameters: a COUNT, indicating how many words to return, and CLICK-COUNT, telling whether this is the first click, a double-click, or a tripple-click.") ;; time interval in millisecond within which successive clicks are ;; considered related (defconst vip-multiclick-timeout (if vip-xemacs-p mouse-track-multi-click-time double-click-time) "*Time interval in millisecond within which successive clicks are considered related.") ;; current event click count; XEmacs only (defvar vip-current-click-count 0) ;; time stamp of the last click event; XEmacs only (defvar vip-last-click-event-timestamp 0) ;; Local variable used to toggle wraparound search on click. (vip-deflocalvar vip-mouse-click-search-noerror t) ;; Local variable used to delimit search after wraparound. (vip-deflocalvar vip-mouse-click-search-limit nil) ;; remembers prefix argument to pass along to commands invoked by second ;; click. ;; This is needed because in Emacs (not XEmacs), assigning to preix-arg ;; causes Emacs to count the second click as if it was a single click (defvar vip-global-prefix-argument nil) ;;; Code (defsubst vip-multiclick-p () (not (vip-sit-for-short vip-multiclick-timeout t))) (defun vip-surrounding-word (count click-count) "Returns word surrounding point according to a heuristic. COUNT indicates how many regions to return. If CLICK-COUNT is 1, `word' is a word in Vi sense. If CLICK-COUNT is 2,then `word' is a Word in Vi sense. If the character clicked on is a non-separator and is non-alphanumeric but is adjacent to an alphanumeric symbol, then it is considered alphanumeric for the purpose of this command. If this character has a matching character, such as `\(' is a match for `\)', then the matching character is also considered alphanumeric. For convenience, in Lisp modes, `-' is considered alphanumeric. If CLICK-COUNT is 3 or more, returns the line clicked on with leading and trailing space and tabs removed. In that case, the first argument, COUNT, is ignored." (let ((modifiers "") beg skip-flag result word-beg) (if (> click-count 2) (save-excursion (beginning-of-line) (vip-skip-all-separators-forward 'within-line) (setq beg (point)) (end-of-line) (setq result (buffer-substring beg (point)))) (if (and (not (vip-looking-at-alphasep)) (or (save-excursion (vip-backward-char-carefully) (vip-looking-at-alpha)) (save-excursion (vip-forward-char-carefully) (vip-looking-at-alpha)))) (setq modifiers (cond ((looking-at "\\\\") "\\\\") ((looking-at "-") "C-C-") ((looking-at "[][]") "][") ((looking-at "[()]") ")(") ((looking-at "[{}]") "{}") ((looking-at "[<>]") "<>") ((looking-at "[`']") "`'") ((looking-at "\\^") "\\^") ((vip-looking-at-separator) "") (t (char-to-string (following-char)))) )) ;; Add `-' to alphanum, if it wasn't added and if we are in Lisp (or (looking-at "-") (not (string-match "lisp" (symbol-name major-mode))) (setq modifiers (concat modifiers "C-C-"))) (save-excursion (cond ((> click-count 1) (vip-skip-nonseparators 'backward)) ((vip-looking-at-alpha modifiers) (vip-skip-alpha-backward modifiers)) ((not (vip-looking-at-alphasep modifiers)) (vip-skip-nonalphasep-backward)) (t (if (> click-count 1) (vip-skip-nonseparators 'backward) (vip-skip-alpha-backward modifiers)))) (setq word-beg (point)) (setq skip-flag nil) ; don't move 1 char forw the first time (while (> count 0) (if skip-flag (vip-forward-char-carefully 1)) (setq skip-flag t) ; now always move 1 char forward (if (> click-count 1) (vip-skip-nonseparators 'forward) (vip-skip-alpha-forward modifiers)) (setq count (1- count))) (setq result (buffer-substring word-beg (point)))) ) ; if ;; XEmacs doesn't have set-text-properties, but there buffer-substring ;; doesn't return properties together with the string, so it's not needed. (if vip-emacs-p (set-text-properties 0 (length result) nil result)) result )) (defun vip-mouse-click-get-word (click count click-count) "Returns word surrounding the position of a mouse click. Click may be in another window. Current window and buffer isn't changed. On single or double click, returns the word as determined by `vip-surrounding-word-function'." (let ((click-word "") (click-pos (vip-mouse-click-posn click)) (click-buf (vip-mouse-click-window-buffer click))) (or (numberp count) (setq count 1)) (or (numberp click-count) (setq click-count 1)) (save-excursion (save-window-excursion (if click-pos (progn (set-buffer click-buf) (goto-char click-pos) (setq click-word (funcall vip-surrounding-word-function count click-count))) (error "Click must be over a window.")) click-word)))) ;; Returns window where click occurs (defsubst vip-mouse-click-frame (click) (window-frame (vip-mouse-click-window click))) ;; Returns window where click occurs (defsubst vip-mouse-click-window (click) (if vip-xemacs-p (event-window click) (posn-window (event-start click)))) ;; Returns the buffer of the window where click occurs (defsubst vip-mouse-click-window-buffer (click) (window-buffer (vip-mouse-click-window click))) ;; Returns the name of the buffer in the window where click occurs (defsubst vip-mouse-click-window-buffer-name (click) (buffer-name (vip-mouse-click-window-buffer click))) ;; Returns position of a click (defsubst vip-mouse-click-posn (click) (if vip-xemacs-p (event-point click) (posn-point (event-start click)))) (defun vip-mouse-click-insert-word (click arg) "Insert word clicked or double-clicked on. With prefix argument, N, insert that many words. This command must be bound to a mouse click. The double-click action of the same mouse button must not be bound \(or it must be bound to the same function\). See `vip-surrounding-word' for the definition of a word in this case." (interactive "e\nP") (if vip-frame-of-focus ;; to handle clicks in another frame (select-frame vip-frame-of-focus)) ;; turn arg into a number (cond ((numberp arg) nil) ;; prefix arg is a list when one hits C-u then command ((and (listp arg) (numberp (car arg))) (setq arg (car arg))) (t (setq arg 1))) (let (click-count interrupting-event) (if (and (vip-multiclick-p) ;; This trick checks if there is a pending mouse event ;; if so, we use this latter event and discard the current mouse click ;; If the next panding event is not a mouse event, we execute ;; the current mouse event (progn (setq interrupting-event (vip-read-event)) (vip-mouse-event-p last-input-event))) (progn ;; interrupted wait (setq vip-global-prefix-argument arg) ;; count this click for XEmacs (vip-event-click-count click)) ;; uninterrupted wait or the interrupting event wasn't a mouse event (setq click-count (vip-event-click-count click)) (if (> click-count 1) (setq arg vip-global-prefix-argument vip-global-prefix-argument nil)) (insert (vip-mouse-click-get-word click arg click-count)) (if (and interrupting-event (eventp interrupting-event) (not (vip-mouse-event-p interrupting-event))) (vip-set-unread-command-events interrupting-event)) ))) ;; arg is an event. accepts symbols and numbers, too (defun vip-mouse-event-p (event) (if (eventp event) (string-match "\\(mouse-\\|frame\\|screen\\|track\\)" (prin1-to-string (vip-event-key event))))) ;; XEmacs has no double-click events. So, we must simulate. ;; So, we have to simulate event-click-count. (defun vip-event-click-count (click) (if vip-xemacs-p (progn ;; if more than 1 second (if (> (- (event-timestamp click) vip-last-click-event-timestamp) vip-multiclick-timeout) (setq vip-current-click-count 0)) (setq vip-last-click-event-timestamp (event-timestamp click) vip-current-click-count (1+ vip-current-click-count))) (event-click-count click))) (defun vip-mouse-click-search-word (click arg) "Find the word clicked or double-clicked on. Word may be in another window. With prefix argument, N, search for N-th occurrence. This command must be bound to a mouse click. The double-click action of the same button must not be bound \(or it must be bound to the same function\). See `vip-surrounding-word' for the details on what constitutes a word for this command." (interactive "e\nP") (if vip-frame-of-focus ;; to handle clicks in another frame (select-frame vip-frame-of-focus)) (let (click-word click-count (previous-search-string vip-s-string)) (if (and (vip-multiclick-p) ;; This trick checks if there is a pending mouse event ;; if so, we use this latter event and discard the current mouse click ;; If the next pending event is not a mouse event, we execute ;; the current mouse event (progn (vip-read-event) (vip-mouse-event-p last-input-event))) (progn ;; interrupted wait (setq vip-global-prefix-argument (or vip-global-prefix-argument arg)) ;; remember command that was before the multiclick (setq this-command last-command) ;; make sure we counted this event---needed for XEmacs only (vip-event-click-count click)) ;; uninterrupted wait (setq click-count (vip-event-click-count click)) (setq click-word (vip-mouse-click-get-word click nil click-count)) (if (> click-count 1) (setq arg vip-global-prefix-argument vip-global-prefix-argument nil)) (setq arg (or arg 1)) (vip-deactivate-mark) (if (or (not (string= click-word vip-s-string)) (not (markerp vip-search-start-marker)) (not (equal (marker-buffer vip-search-start-marker) (current-buffer))) (not (eq last-command 'vip-mouse-click-search-word))) (progn (setq vip-search-start-marker (point-marker) vip-local-search-start-marker vip-search-start-marker vip-mouse-click-search-noerror t vip-mouse-click-search-limit nil) ;; make search string known to Viper (setq vip-s-string (if vip-re-search (regexp-quote click-word) click-word)) (if (not (string= vip-s-string (car vip-search-history))) (setq vip-search-history (cons vip-s-string vip-search-history))) )) (push-mark nil t) (while (> arg 0) (vip-forward-word 1) (condition-case nil (progn (if (not (search-forward click-word vip-mouse-click-search-limit vip-mouse-click-search-noerror)) (progn (setq vip-mouse-click-search-noerror nil) (setq vip-mouse-click-search-limit (save-excursion (if (and (markerp vip-local-search-start-marker) (marker-buffer vip-local-search-start-marker)) (goto-char vip-local-search-start-marker)) (vip-line-pos 'end))) (goto-char (point-min)) (search-forward click-word vip-mouse-click-search-limit nil))) (goto-char (match-beginning 0)) (message "Searching for: %s" vip-s-string) (if (<= arg 1) (vip-flash-search-pattern)) ) (error (beep 1) (if (or (not (string= click-word previous-search-string)) (not (eq last-command 'vip-mouse-click-search-word))) (message "`%s': String not found in %s" vip-s-string (buffer-name (current-buffer))) (message "`%s': Last occurrence in %s. Back to beginning of search" click-word (buffer-name (current-buffer))) (setq arg 1) ;; to terminate the loop (sit-for 2)) (setq vip-mouse-click-search-noerror t) (setq vip-mouse-click-search-limit nil) (if (and (markerp vip-local-search-start-marker) (marker-buffer vip-local-search-start-marker)) (goto-char vip-local-search-start-marker)))) (setq arg (1- arg))) ))) (defun vip-mouse-catch-frame-switch (event arg) "Catch the event of switching frame. Usually is bound to a 'down-mouse' event to work properly. See sample bindings in viper.el and in the Viper manual." (interactive "e\nP") (setq vip-frame-of-focus nil) ;; pass prefix arg along to vip-mouse-click-search/insert-word (setq prefix-arg arg) (if (eq last-command 'handle-switch-frame) (setq vip-frame-of-focus vip-current-frame-saved)) ;; make Emacs forget that it executed vip-mouse-catch-frame-switch (setq this-command last-command)) ;; Called just before switching frames. Saves the old selected frame. ;; Sets last-command to handle-switch-frame (this is done automatically in ;; Emacs. ;; The semantics of switching frames is different in Emacs and XEmacs. ;; In Emacs, if you select-frame A while mouse is over frame B and then ;; start typing, input goes to frame B, which becomes selected. ;; In XEmacs, input will go to frame A. This may be a bug in one of the ;; Emacsen, but also may be a design decision. ;; Also, in Emacs sending input to frame B generates handle-switch-frame ;; event, while in XEmacs it doesn't. ;; All this accounts for the difference in the behavior of ;; vip-mouse-click-* commands when you click in a frame other than the one ;; that was the last to receive input. In Emacs, focus will be in frame A ;; until you do something other than vip-mouse-click-* command. ;; In XEmacs, you have to manually select frame B (with the mouse click) in ;; order to shift focus to frame B. (defsubst vip-remember-current-frame (frame) (setq last-command 'handle-switch-frame vip-current-frame-saved (selected-frame))) (cond ((vip-window-display-p) (let* ((search-key (if vip-xemacs-p [(meta shift button1up)] [S-mouse-1])) (search-key-catch (if vip-xemacs-p [(meta shift button1)] [S-down-mouse-1])) (insert-key (if vip-xemacs-p [(meta shift button2up)] [S-mouse-2])) (insert-key-catch (if vip-xemacs-p [(meta shift button2)] [S-down-mouse-2])) (search-key-unbound (and (not (key-binding search-key)) (not (key-binding search-key-catch)))) (insert-key-unbound (and (not (key-binding insert-key)) (not (key-binding insert-key-catch)))) ) (if search-key-unbound (global-set-key search-key 'vip-mouse-click-search-word)) (if insert-key-unbound (global-set-key insert-key 'vip-mouse-click-insert-word)) ;; The following would be needed if you want to use the above two ;; while clicking in another frame. If you only want to use them ;; by clicking in another window, not frame, the bindings below ;; aren't necessary. ;; These must be bound to mouse-down event for the same mouse ;; buttons as 'vip-mouse-click-search-word and ;; 'vip-mouse-click-insert-word (if search-key-unbound (global-set-key search-key-catch 'vip-mouse-catch-frame-switch)) (if insert-key-unbound (global-set-key insert-key-catch 'vip-mouse-catch-frame-switch)) (if vip-xemacs-p (add-hook 'mouse-leave-frame-hook 'vip-remember-current-frame) (defadvice handle-switch-frame (before vip-frame-advice activate) "Remember the selected frame before the switch-frame event." (vip-remember-current-frame (selected-frame)))) ))) (provide 'viper-mous) ;;; viper-mous.el ends here emacs-19.30/lisp/viper-util.el100444 23123 1 106541 6037616746 15063 0ustar kiferdaemon;;; viper-util.el --- Utilities used by viper.el ;; Copyright (C) 1994, 1995 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. (require 'ring) ;; Whether it is XEmacs or not (defconst vip-xemacs-p (string-match "\\(Lucid\\|XEmacs\\)" emacs-version)) ;; Whether it is Emacs or not (defconst vip-emacs-p (not vip-xemacs-p)) ;; Tell whether we are running as a window application or on a TTY (defsubst vip-device-type () (if vip-emacs-p window-system (device-type (selected-device)))) ;; in XEmacs: device-type is tty on tty and stream in batch. (defsubst vip-window-display-p () (and (vip-device-type) (not (memq (vip-device-type) '(tty stream))))) ;;; Macros (defmacro vip-deflocalvar (var default-value &optional documentation) (` (progn (defvar (, var) (, default-value) (, (format "%s\n\(buffer local\)" documentation))) (make-variable-buffer-local '(, var)) ))) (defmacro vip-loop (count body) "(vip-loop COUNT BODY) Execute BODY COUNT times." (list 'let (list (list 'count count)) (list 'while '(> count 0) body '(setq count (1- count)) ))) (defmacro vip-buffer-live-p (buf) (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf)))))) ;; return buffer-specific macro definition, given a full macro definition (defmacro vip-kbd-buf-alist (macro-elt) (` (nth 1 (, macro-elt)))) ;; get a pair: (curr-buffer . macro-definition) (defmacro vip-kbd-buf-pair (macro-elt) (` (assoc (buffer-name) (vip-kbd-buf-alist (, macro-elt))))) ;; get macro definition for current buffer (defmacro vip-kbd-buf-definition (macro-elt) (` (cdr (vip-kbd-buf-pair (, macro-elt))))) ;; return mode-specific macro definitions, given a full macro definition (defmacro vip-kbd-mode-alist (macro-elt) (` (nth 2 (, macro-elt)))) ;; get a pair: (major-mode . macro-definition) (defmacro vip-kbd-mode-pair (macro-elt) (` (assoc major-mode (vip-kbd-mode-alist (, macro-elt))))) ;; get macro definition for the current major mode (defmacro vip-kbd-mode-definition (macro-elt) (` (cdr (vip-kbd-mode-pair (, macro-elt))))) ;; return global macro definition, given a full macro definition (defmacro vip-kbd-global-pair (macro-elt) (` (nth 3 (, macro-elt)))) ;; get global macro definition from an elt of macro-alist (defmacro vip-kbd-global-definition (macro-elt) (` (cdr (vip-kbd-global-pair (, macro-elt))))) ;; last elt of a sequence (defsubst vip-seq-last-elt (seq) (elt seq (1- (length seq)))) ;; Check if arg is a valid character for register ;; TYPE is a list that can contain `letter', `Letter', and `digit'. ;; Letter means lowercase letters, Letter means uppercase letters, and ;; digit means digits from 1 to 9. ;; If TYPE is nil, then down/uppercase letters and digits are allowed. (defun vip-valid-register (reg &optional type) (or type (setq type '(letter Letter digit))) (or (if (memq 'letter type) (and (<= ?a reg) (<= reg ?z))) (if (memq 'digit type) (and (<= ?1 reg) (<= reg ?9))) (if (memq 'Letter type) (and (<= ?A reg) (<= reg ?Z))) )) ;; checks if object is a marker, has a buffer, and points to within that buffer (defun vip-valid-marker (marker) (if (and (markerp marker) (marker-buffer marker)) (let ((buf (marker-buffer marker)) (pos (marker-position marker))) (save-excursion (set-buffer buf) (and (<= pos (point-max)) (<= (point-min) pos)))))) (defvar vip-minibuffer-overlay-priority 300) (defvar vip-replace-overlay-priority 400) (defvar vip-search-overlay-priority 500) ;;; XEmacs support (if vip-xemacs-p (progn (fset 'vip-read-event (symbol-function 'next-command-event)) (fset 'vip-make-overlay (symbol-function 'make-extent)) (fset 'vip-overlay-start (symbol-function 'extent-start-position)) (fset 'vip-overlay-end (symbol-function 'extent-end-position)) (fset 'vip-overlay-put (symbol-function 'set-extent-property)) (fset 'vip-overlay-p (symbol-function 'extentp)) (fset 'vip-overlay-get (symbol-function 'extent-property)) (fset 'vip-move-overlay (symbol-function 'set-extent-endpoints)) (if (vip-window-display-p) (fset 'vip-iconify (symbol-function 'iconify-frame))) (cond ((vip-window-display-p) (fset 'vip-get-face (symbol-function 'get-face)) (fset 'vip-color-defined-p (symbol-function 'valid-color-name-p)) ))) (fset 'vip-read-event (symbol-function 'read-event)) (fset 'vip-make-overlay (symbol-function 'make-overlay)) (fset 'vip-overlay-start (symbol-function 'overlay-start)) (fset 'vip-overlay-end (symbol-function 'overlay-end)) (fset 'vip-overlay-put (symbol-function 'overlay-put)) (fset 'vip-overlay-p (symbol-function 'overlayp)) (fset 'vip-overlay-get (symbol-function 'overlay-get)) (fset 'vip-move-overlay (symbol-function 'move-overlay)) (if (vip-window-display-p) (fset 'vip-iconify (symbol-function 'iconify-or-deiconify-frame))) (cond ((vip-window-display-p) (fset 'vip-get-face (symbol-function 'internal-get-face)) (fset 'vip-color-defined-p (symbol-function 'x-color-defined-p)) ))) (defsubst vip-color-display-p () (if vip-emacs-p (x-display-color-p) (eq (device-class (selected-device)) 'color))) ;; OS/2 (cond ((eq (vip-device-type) 'pm) (fset 'vip-color-defined-p (function (lambda (color) (assoc color pm-color-alist)))))) ;; needed to smooth out the difference between Emacs and XEmacs (defsubst vip-italicize-face (face) (if vip-xemacs-p (make-face-italic face) (make-face-italic face nil 'noerror))) ;; test if display is color and the colors are defined (defsubst vip-can-use-colors (&rest colors) (if (vip-color-display-p) (not (memq nil (mapcar 'vip-color-defined-p colors))) )) ;; currently doesn't work for XEmacs (defun vip-change-cursor-color (new-color) (if (and (vip-window-display-p) (vip-color-display-p) (stringp new-color) (vip-color-defined-p new-color) (not (string= new-color (vip-get-cursor-color)))) (modify-frame-parameters (selected-frame) (list (cons 'cursor-color new-color))))) (defsubst vip-save-cursor-color () (if (and (vip-window-display-p) (vip-color-display-p)) (let ((color (vip-get-cursor-color))) (if (and (stringp color) (vip-color-defined-p color) (not (string= color vip-replace-overlay-cursor-color))) (vip-overlay-put vip-replace-overlay 'vip-cursor-color color))))) (defsubst vip-restore-cursor-color () (vip-change-cursor-color (vip-overlay-get vip-replace-overlay 'vip-cursor-color))) (defsubst vip-get-cursor-color () (cdr (assoc 'cursor-color (frame-parameters)))) ;; Check the current version against the major and minor version numbers ;; using op: cur-vers op major.minor If emacs-major-version or ;; emacs-minor-version are not defined, we assume that the current version ;; is hopelessly outdated. We assume that emacs-major-version and ;; emacs-minor-version are defined. Otherwise, for Emacs/XEmacs 19, if the ;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value ;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be ;; incorrect. However, this gives correct result in our cases, since we are ;; testing for sufficiently high Emacs versions. (defun vip-check-version (op major minor &optional type-of-emacs) (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version)) (and (cond ((eq type-of-emacs 'xemacs) vip-xemacs-p) ((eq type-of-emacs 'emacs) vip-emacs-p) (t t)) (cond ((eq op '=) (and (= emacs-minor-version minor) (= emacs-major-version major))) ((memq op '(> >= < <=)) (and (or (funcall op emacs-major-version major) (= emacs-major-version major)) (if (= emacs-major-version major) (funcall op emacs-minor-version minor) t))) (t (error "%S: Invalid op in vip-check-version" op)))) (cond ((memq op '(= > >=)) nil) ((memq op '(< <=)) t)))) ;;;; warn if it is a wrong version of emacs ;;(if (or (vip-check-version '< 19 29 'emacs) ;; (vip-check-version '< 19 12 'xemacs)) ;; (progn ;; (with-output-to-temp-buffer " *vip-info*" ;; (switch-to-buffer " *vip-info*") ;; (insert ;; (format " ;; ;;This version of Viper requires ;; ;;\t Emacs 19.29 and higher ;;\t OR ;;\t XEmacs 19.12 and higher ;; ;;It is unlikely to work under Emacs version %s ;;that you are using... " emacs-version)) ;; ;; (if noninteractive ;; () ;; (beep 1) ;; (beep 1) ;; (insert "\n\nType any key to continue... ") ;; (vip-read-event))) ;; (kill-buffer " *vip-info*"))) (defun vip-get-visible-buffer-window (wind) (if vip-xemacs-p (get-buffer-window wind t) (get-buffer-window wind 'visible))) ;; Return line position. ;; If pos is 'start then returns position of line start. ;; If pos is 'end, returns line end. If pos is 'mid, returns line center. ;; Pos = 'indent returns beginning of indentation. ;; Otherwise, returns point. Current point is not moved in any case." (defun vip-line-pos (pos) (let ((cur-pos (point)) (result)) (cond ((equal pos 'start) (beginning-of-line)) ((equal pos 'end) (end-of-line)) ((equal pos 'mid) (goto-char (+ (vip-line-pos 'start) (vip-line-pos 'end) 2))) ((equal pos 'indent) (back-to-indentation)) (t nil)) (setq result (point)) (goto-char cur-pos) result)) ;; Like move-marker but creates a virgin marker if arg isn't already a marker. ;; The first argument must eval to a variable name. ;; Arguments: (var-name position &optional buffer). ;; ;; This is useful for moving markers that are supposed to be local. ;; For this, VAR-NAME should be made buffer-local with nil as a default. ;; Then, each time this var is used in `vip-move-marker-locally' in a new ;; buffer, a new marker will be created. (defun vip-move-marker-locally (var pos &optional buffer) (if (markerp (eval var)) () (set var (make-marker))) (move-marker (eval var) pos buffer)) ;; Print CONDITIONS as a message. (defun vip-message-conditions (conditions) (let ((case (car conditions)) (msg (cdr conditions))) (if (null msg) (message "%s" case) (message "%s: %s" case (mapconcat 'prin1-to-string msg " "))) (beep 1))) ;;; List/alist utilities ;; Convert LIST to an alist (defun vip-list-to-alist (lst) (let ((alist)) (while lst (setq alist (cons (list (car lst)) alist)) (setq lst (cdr lst))) alist)) ;; Convert ALIST to a list. (defun vip-alist-to-list (alst) (let ((lst)) (while alst (setq lst (cons (car (car alst)) lst)) (setq alst (cdr alst))) lst)) ;; Filter ALIST using REGEXP. Return alist whose elements match the regexp. (defun vip-filter-alist (regexp alst) (interactive "s x") (let ((outalst) (inalst alst)) (while (car inalst) (if (string-match regexp (car (car inalst))) (setq outalst (cons (car inalst) outalst))) (setq inalst (cdr inalst))) outalst)) ;; Filter LIST using REGEXP. Return list whose elements match the regexp. (defun vip-filter-list (regexp lst) (interactive "s x") (let ((outlst) (inlst lst)) (while (car inlst) (if (string-match regexp (car inlst)) (setq outlst (cons (car inlst) outlst))) (setq inlst (cdr inlst))) outlst)) ;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1 ;; LIS2 is modified by filtering it: deleting its members of the form ;; \(car elt\) such that (car elt') is in LIS1. (defun vip-append-filter-alist (lis1 lis2) (let ((temp lis1) elt) ;;filter-append the second list (while temp ;; delete all occurrences (while (setq elt (assoc (car (car temp)) lis2)) (setq lis2 (delq elt lis2))) (setq temp (cdr temp))) (nconc lis1 lis2))) ;;; Insertion ring ;; Rotate RING's index. DIRection can be positive or negative. (defun vip-ring-rotate1 (ring dir) (if (and (ring-p ring) (> (ring-length ring) 0)) (progn (setcar ring (cond ((> dir 0) (ring-plus1 (car ring) (ring-length ring))) ((< dir 0) (ring-minus1 (car ring) (ring-length ring))) ;; don't rotate if dir = 0 (t (car ring)))) (vip-current-ring-item ring) ))) (defun vip-special-ring-rotate1 (ring dir) (if (memq vip-intermediate-command '(repeating-display-destructive-command repeating-insertion-from-ring)) (vip-ring-rotate1 ring dir) ;; don't rotate otherwise (vip-ring-rotate1 ring 0))) ;; current ring item; if N is given, then so many items back from the ;; current (defun vip-current-ring-item (ring &optional n) (setq n (or n 0)) (if (and (ring-p ring) (> (ring-length ring) 0)) (aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring))))) ;; push item onto ring. the second argument is a ring-variable, not value. (defun vip-push-onto-ring (item ring-var) (or (ring-p (eval ring-var)) (set ring-var (make-ring (eval (intern (format "%S-size" ring-var)))))) (or (null item) ; don't push nil (and (stringp item) (string= item "")) ; or empty strings (equal item (vip-current-ring-item (eval ring-var))) ; or old stuff ;; Since vip-set-destructive-command checks if we are inside vip-repeat, ;; we don't check whether this-command-keys is a `.'. ;; The cmd vip-repeat makes a call to the current function only if ;; `.' is executing a command from the command history. It doesn't ;; call the push-onto-ring function if `.' is simply repeating the ;; last destructive command. ;; We only check for ESC (which happens when we do insert with a ;; prefix argument, or if this-command-keys doesn't give anything ;; meaningful (in that case we don't know what to show to the user). (and (eq ring-var 'vip-command-ring) (string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)" (vip-array-to-string (this-command-keys)))) (vip-ring-insert (eval ring-var) item)) ) ;; removing elts from ring seems to break it (defun vip-cleanup-ring (ring) (or (< (ring-length ring) 2) (null (vip-current-ring-item ring)) ;; last and previous equal (if (equal (vip-current-ring-item ring) (vip-current-ring-item ring 1)) (vip-ring-pop ring)))) ;; ring-remove seems to be buggy, so we concocted this for our purposes. (defun vip-ring-pop (ring) (let* ((ln (ring-length ring)) (vec (cdr (cdr ring))) (veclen (length vec)) (hd (car ring)) (idx (max 0 (ring-minus1 hd ln))) (top-elt (aref vec idx))) ;; shift elements (while (< (1+ idx) veclen) (aset vec idx (aref vec (1+ idx))) (setq idx (1+ idx))) (aset vec idx nil) (setq hd (max 0 (ring-minus1 hd ln))) (if (= hd (1- ln)) (setq hd 0)) (setcar ring hd) ; move head (setcar (cdr ring) (max 0 (1- ln))) ; adjust length top-elt )) (defun vip-ring-insert (ring item) (let* ((ln (ring-length ring)) (vec (cdr (cdr ring))) (veclen (length vec)) (hd (car ring)) (vecpos-after-hd (if (= hd 0) ln hd)) (idx ln)) (if (= ln veclen) (progn (aset vec hd item) ; hd is always 1+ the actual head index in vec (setcar ring (ring-plus1 hd ln))) (setcar (cdr ring) (1+ ln)) (setcar ring (ring-plus1 vecpos-after-hd (1+ ln))) (while (and (>= idx vecpos-after-hd) (> ln 0)) (aset vec idx (aref vec (1- idx))) (setq idx (1- idx))) (aset vec vecpos-after-hd item)) item)) ;;; String utilities ;; If STRING is longer than MAX-LEN, truncate it and print ...... instead ;; PRE-STRING is a string to prepend to the abbrev string. ;; POST-STRING is a string to append to the abbrev string. ;; ABBREV_SIGN is a string to be inserted before POST-STRING ;; if the orig string was truncated. (defun vip-abbreviate-string (string max-len pre-string post-string abbrev-sign) (let (truncated-str) (setq truncated-str (if (stringp string) (substring string 0 (min max-len (length string))))) (cond ((null truncated-str) "") ((> (length string) max-len) (format "%s%s%s%s" pre-string truncated-str abbrev-sign post-string)) (t (format "%s%s%s" pre-string truncated-str post-string))))) ;; tells if we are over a whitespace-only line (defsubst vip-over-whitespace-line () (save-excursion (beginning-of-line) (looking-at "^[ \t]*$"))) ;;; Saving settings in custom file ;; Save the current setting of VAR in CUSTOM-FILE. ;; If given, MESSAGE is a message to be displayed after that. ;; This message is erased after 2 secs, if erase-msg is non-nil. ;; Arguments: var message custom-file &optional erase-message (defun vip-save-setting (var message custom-file &optional erase-msg) (let* ((var-name (symbol-name var)) (var-val (if (boundp var) (eval var))) (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z---_']*[ \t\n)]" var-name)) (buf (find-file-noselect (substitute-in-file-name custom-file))) ) (message message) (save-excursion (set-buffer buf) (goto-char (point-min)) (if (re-search-forward regexp nil t) (let ((reg-end (1- (match-end 0)))) (search-backward var-name) (delete-region (match-beginning 0) reg-end) (goto-char (match-beginning 0)) (insert (format "%s '%S" var-name var-val))) (goto-char (point-max)) (if (not (bolp)) (insert "\n")) (insert (format "(setq %s '%S)\n" var-name var-val))) (save-buffer)) (kill-buffer buf) (if erase-msg (progn (sit-for 2) (message ""))) )) ;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that ;; match this pattern. (defun vip-save-string-in-file (string custom-file &optional pattern) (let ((buf (find-file-noselect (substitute-in-file-name custom-file)))) (save-excursion (set-buffer buf) (goto-char (point-min)) (if pattern (delete-matching-lines pattern)) (goto-char (point-max)) (if string (insert string)) (save-buffer)) (kill-buffer buf) )) ;;; Overlays ;; Search (defun vip-flash-search-pattern () (if (vip-overlay-p vip-search-overlay) (vip-move-overlay vip-search-overlay (match-beginning 0) (match-end 0)) (setq vip-search-overlay (vip-make-overlay (match-beginning 0) (match-end 0) (current-buffer)))) (vip-overlay-put vip-search-overlay 'priority vip-search-overlay-priority) (if (vip-window-display-p) (progn (vip-overlay-put vip-search-overlay 'face vip-search-face) (sit-for 2) (vip-overlay-put vip-search-overlay 'face nil)))) ;; Replace state (defun vip-set-replace-overlay (beg end) (if (vip-overlay-p vip-replace-overlay) (vip-move-replace-overlay beg end) (setq vip-replace-overlay (vip-make-overlay beg end (current-buffer))) (vip-overlay-put vip-replace-overlay 'vip-start (move-marker (make-marker) (vip-overlay-start vip-replace-overlay))) (vip-overlay-put vip-replace-overlay 'vip-end (move-marker (make-marker) (vip-overlay-end vip-replace-overlay))) (vip-overlay-put vip-replace-overlay 'priority vip-replace-overlay-priority)) (if (vip-window-display-p) (vip-overlay-put vip-replace-overlay 'face vip-replace-overlay-face)) (vip-save-cursor-color) (vip-change-cursor-color vip-replace-overlay-cursor-color) ) (defsubst vip-hide-replace-overlay () (vip-set-replace-overlay-glyphs nil nil) (vip-restore-cursor-color) (if (vip-window-display-p) (vip-overlay-put vip-replace-overlay 'face nil))) (defsubst vip-set-replace-overlay-glyphs (before-glyph after-glyph) (if (or (not (vip-window-display-p)) vip-use-replace-region-delimiters) (let ((before-name (if vip-xemacs-p 'begin-glyph 'before-string)) (after-name (if vip-xemacs-p 'end-glyph 'after-string))) (vip-overlay-put vip-replace-overlay before-name before-glyph) (vip-overlay-put vip-replace-overlay after-name after-glyph)))) (defsubst vip-replace-start () (vip-overlay-get vip-replace-overlay 'vip-start)) (defsubst vip-replace-end () (vip-overlay-get vip-replace-overlay 'vip-end)) (defsubst vip-move-replace-overlay (beg end) (vip-move-overlay vip-replace-overlay beg end) (move-marker (vip-replace-start) (vip-overlay-start vip-replace-overlay)) (move-marker (vip-replace-end) (vip-overlay-end vip-replace-overlay))) ;; Minibuffer (defun vip-set-minibuffer-overlay () (vip-check-minibuffer-overlay) ;; We always move the minibuffer overlay, since in XEmacs ;; this overlay may get detached. Moving will reattach it. ;; This overlay is also moved via the vip-post-command-hook, ;; to insure that it covers the whole minibuffer. (vip-move-minibuffer-overlay) (if (vip-window-display-p) (progn (vip-overlay-put vip-minibuffer-overlay 'face vip-minibuffer-current-face) (vip-overlay-put vip-minibuffer-overlay 'priority vip-minibuffer-overlay-priority)) )) (defun vip-check-minibuffer-overlay () (if (vip-overlay-p vip-minibuffer-overlay) () (setq vip-minibuffer-overlay (vip-make-overlay 1 (1+ (buffer-size)) (current-buffer))))) ;; arguments to this function are dummies. they are needed just because ;; it is used as a insert-in-front-hook to vip-minibuffer-overlay, and such ;; hooks require 3 arguments. (defun vip-move-minibuffer-overlay (&optional overl beg end) (if (vip-is-in-minibuffer) (progn (vip-check-minibuffer-overlay) (vip-move-overlay vip-minibuffer-overlay 1 (1+ (buffer-size)))))) (defsubst vip-is-in-minibuffer () (string-match "\*Minibuf-" (buffer-name))) ;;; XEmacs compatibility ;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg ;; in sit-for, so this function smoothes out the differences. (defsubst vip-sit-for-short (val &optional nodisp) (if vip-xemacs-p (sit-for (/ val 1000.0) nodisp) (sit-for 0 val nodisp))) ;; EVENT may be a single event of a sequence of events (defsubst vip-ESC-event-p (event) (let ((ESC-keys '(?\e (control \[) escape)) (key (vip-event-key event))) (member key ESC-keys))) ;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring) ;; is the same as (mark t). (defsubst vip-set-mark-if-necessary () (setq mark-ring (delete (vip-mark-marker) mark-ring)) (set-mark-command nil)) (defsubst vip-mark-marker () (if vip-xemacs-p (mark-marker t) (mark-marker))) ;; In transient mark mode (zmacs mode), it is annoying when regions become ;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless ;; the user explicitly wants highlighting, e.g., by hitting '' or `` (defun vip-deactivate-mark () (if vip-xemacs-p (zmacs-deactivate-region) (deactivate-mark))) (defsubst vip-leave-region-active () (if vip-xemacs-p (setq zmacs-region-stays t))) (defsubst vip-events-to-keys (events) (cond (vip-xemacs-p (events-to-keys events)) (t events))) (defun vip-eval-after-load (file form) (if vip-emacs-p (eval-after-load file form) (or (assoc file after-load-alist) (setq after-load-alist (cons (list file) after-load-alist))) (let ((elt (assoc file after-load-alist))) (or (member form (cdr elt)) (setq elt (nconc elt (list form))))) form )) ;; This is here because Emacs changed the way local hooks work. ;; ;;Add to the value of HOOK the function FUNCTION. ;;FUNCTION is not added if already present. ;;FUNCTION is added (if necessary) at the beginning of the hook list ;;unless the optional argument APPEND is non-nil, in which case ;;FUNCTION is added at the end. ;; ;;HOOK should be a symbol, and FUNCTION may be any valid function. If ;;HOOK is void, it is first set to nil. If HOOK's value is a single ;;function, it is changed to a list of functions." (defun vip-add-hook (hook function &optional append) (if (not (boundp hook)) (set hook nil)) ;; If the hook value is a single function, turn it into a list. (let ((old (symbol-value hook))) (if (or (not (listp old)) (eq (car old) 'lambda)) (setq old (list old))) (if (member function old) nil (set hook (if append (append old (list function)) ; don't nconc (cons function old)))))) ;; This is here because of Emacs's changes in the semantics of add/remove-hooks ;; and due to the bugs they introduced. ;; ;; Remove from the value of HOOK the function FUNCTION. ;; HOOK should be a symbol, and FUNCTION may be any valid function. If ;; FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the ;; list of hooks to run in HOOK, then nothing is done. See `vip-add-hook'." (defun vip-remove-hook (hook function) (if (or (not (boundp hook)) ;unbound symbol, or (null (symbol-value hook)) ;value is nil, or (null function)) ;function is nil, then nil ;Do nothing. (let ((hook-value (symbol-value hook))) (if (consp hook-value) ;; don't side-effect the list (setq hook-value (delete function (copy-sequence hook-value))) (if (equal hook-value function) (setq hook-value nil))) (set hook hook-value)))) ;; like read-event, but in XEmacs also try to convert to char, if possible (defun vip-read-event-convert-to-char () (let (event) (if vip-emacs-p (read-event) (setq event (next-command-event)) (or (event-to-character event) event)) )) ;; This function lets function-key-map convert key sequences into logical ;; keys. This does a better job than vip-read-event when it comes to kbd ;; macros, since it enables certain macros to be shared between X and TTY ;; modes. (defun vip-read-key () (let ((overriding-local-map vip-overriding-map) key) (use-global-map vip-overriding-map) (setq key (elt (read-key-sequence nil) 0)) (use-global-map global-map) key)) ;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil) ;; instead of nil, if '(nil) was previously inadvertantly assigned to ;; unread-command-events (defun vip-event-key (event) (or (and event (eventp event)) (error "vip-event-key: Wrong type argument, eventp, %S" event)) (let ((mod (event-modifiers event)) basis) (setq basis (cond (vip-xemacs-p (cond ((key-press-event-p event) (event-key event)) ((button-event-p event) (concat "mouse-" (prin1-to-string (event-button event)))) (t (error "vip-event-key: Unknown event, %S" event)))) (t ;; Emacs doesn't handle capital letters correctly, since ;; \S-a isn't considered the same as A (it behaves as ;; plain `a' instead). So we take care of this here (cond ((and (numberp event) (<= ?A event) (<= event ?Z)) (setq mod nil event event)) ;; Emacs has the oddity whereby characters 128+char ;; represent M-char *if* this appears inside a string. ;; So, we convert them manually into (mata char). ((and (numberp event) (< ?\C-? event) (<= event 255)) (setq mod '(meta) event (- event ?\C-? 1))) (t (event-basic-type event))) ))) (if (numberp basis) (setq basis (if (= basis ?\C-?) (list 'control '\?) ; taking care of an emacs bug (intern (char-to-string basis))))) (if mod (append mod (list basis)) basis) )) (defun vip-key-to-emacs-key (key) (let (key-name char-p modifiers mod-char-list base-key base-key-name) (cond (vip-xemacs-p key) ((symbolp key) (setq key-name (symbol-name key)) (if (= (length key-name) 1) ; character event (string-to-char key-name) key)) ((listp key) (setq modifiers (subseq key 0 (1- (length key))) base-key (vip-seq-last-elt key) base-key-name (symbol-name base-key) char-p (= (length base-key-name) 1)) (setq mod-char-list (mapcar '(lambda (elt) (upcase (substring (symbol-name elt) 0 1))) modifiers)) (if char-p (setq key-name (car (read-from-string (concat "?\\" (mapconcat 'identity mod-char-list "-\\") "-" base-key-name)))) (setq key-name (intern (concat (mapconcat 'identity mod-char-list "-") "-" base-key-name)))))) )) ;; Args can be a sequence of events, a string, or a Viper macro. Will try to ;; convert events to keys and, if all keys are regular printable ;; characters, will return a string. Otherwise, will return a string ;; representing a vector of converted events. If the input was a Viper macro, ;; will return a string that represents this macro as a vector. (defun vip-array-to-string (event-seq &optional representation) (let (temp) (cond ((stringp event-seq) event-seq) ((vip-event-vector-p event-seq) (setq temp (mapcar 'vip-event-key event-seq)) (if (vip-char-symbol-sequence-p temp) (mapconcat 'symbol-name temp "") (prin1-to-string (vconcat temp)))) ((vip-char-symbol-sequence-p event-seq) (mapconcat 'symbol-name event-seq "")) (t (prin1-to-string event-seq))))) (defun vip-key-press-events-to-chars (events) (mapconcat (if vip-emacs-p 'char-to-string (function (lambda (elt) (char-to-string (event-to-character elt))))) events "")) (defsubst vip-fast-keysequence-p () (not (vip-sit-for-short vip-fast-keyseq-timeout t))) (defun vip-read-char-exclusive () (let (char (echo-keystrokes 1)) (while (null char) (condition-case nil (setq char (read-char)) (error ;; skip event if not char (vip-read-event)))) char)) (defun vip-setup-master-buffer (&rest other-files-or-buffers) "Set up the current buffer as a master buffer. Arguments become related buffers. This function should normally be used in the `Local variables' section of a file." (setq vip-related-files-and-buffers-ring (make-ring (1+ (length other-files-or-buffers)))) (mapcar '(lambda (elt) (vip-ring-insert vip-related-files-and-buffers-ring elt)) other-files-or-buffers) (vip-ring-insert vip-related-files-and-buffers-ring (buffer-name)) ) ;;; Movement utilities (defvar vip-syntax-preference 'strict-vi "*Syntax type characterizing Viper's alphanumeric symbols. `emacs' means only word constituents are considered to be alphanumeric. Word constituents are symbols specified as word constituents by the current syntax table. `extended' means word and symbol constituents. `reformed-vi' means Vi-ish behavior: word constituents and the symbol `_'. However, word constituents are determined according to Emacs syntax tables, which may be different from Vi in some major modes. `strict-vi' means Viper words are exactly as in Vi.") (vip-deflocalvar vip-ALPHA-char-class "w" "String of syntax classes characterizing Viper's alphanumeric symbols. In addition, the symbol `_' may be considered alphanumeric if `vip-syntax-preference'is `reformed-vi'.") (vip-deflocalvar vip-strict-ALPHA-chars "a-zA-Z0-9_" "Regexp matching the set of alphanumeric characters acceptable to strict Vi.") (vip-deflocalvar vip-strict-SEP-chars " \t\n" "Regexp matching the set of alphanumeric characters acceptable to strict Vi.") (vip-deflocalvar vip-SEP-char-class " -" "String of syntax classes for Vi separators. Usually contains ` ', linefeed, TAB or formfeed.") (defun vip-update-alphanumeric-class () "Set the syntactic class of Viper alphanumeric symbols according to the variable `vip-ALPHA-char-class'. Should be called in order for changes to `vip-ALPHA-char-class' to take effect." (interactive) (setq-default vip-ALPHA-char-class (cond ((eq vip-syntax-preference 'emacs) "w") ; only word constituents ((eq vip-syntax-preference 'extended) "w_") ; word & symbol chars (t "w")))) ; vi syntax: word constituents and the symbol `_' ;; addl-chars are characters to be temporarily considered as alphanumerical (defun vip-looking-at-alpha (&optional addl-chars) (or (stringp addl-chars) (setq addl-chars "")) (if (eq vip-syntax-preference 'reformed-vi) (setq addl-chars (concat addl-chars "_"))) (let ((char (char-after (point)))) (if char (if (eq vip-syntax-preference 'strict-vi) (looking-at (concat "[" vip-strict-ALPHA-chars addl-chars "]")) (or (memq char ;; convert string to list (append (vconcat addl-chars) nil)) (memq (char-syntax char) (append (vconcat vip-ALPHA-char-class) nil))))) )) (defsubst vip-looking-at-separator () (let ((char (char-after (point)))) (if char (or (eq char ?\n) ; RET is always a separator in Vi (memq (char-syntax char) (append (vconcat vip-SEP-char-class) nil)))))) (defsubst vip-looking-at-alphasep (&optional addl-chars) (or (vip-looking-at-separator) (vip-looking-at-alpha addl-chars))) (defsubst vip-skip-alpha-forward (&optional addl-chars) (or (stringp addl-chars) (setq addl-chars "")) (vip-skip-syntax 'forward (cond ((eq vip-syntax-preference 'strict-vi) "") (t vip-ALPHA-char-class )) (cond ((eq vip-syntax-preference 'strict-vi) (concat vip-strict-ALPHA-chars addl-chars)) (t addl-chars)))) (defsubst vip-skip-alpha-backward (&optional addl-chars) (or (stringp addl-chars) (setq addl-chars "")) (vip-skip-syntax 'backward (cond ((eq vip-syntax-preference 'strict-vi) "") (t vip-ALPHA-char-class )) (cond ((eq vip-syntax-preference 'strict-vi) (concat vip-strict-ALPHA-chars addl-chars)) (t addl-chars)))) ;; weird syntax tables may confuse strict-vi style (defsubst vip-skip-all-separators-forward (&optional within-line) (vip-skip-syntax 'forward vip-SEP-char-class (or within-line "\n") (if within-line (vip-line-pos 'end)))) (defsubst vip-skip-all-separators-backward (&optional within-line) (vip-skip-syntax 'backward vip-SEP-char-class (or within-line "\n") (if within-line (vip-line-pos 'start)))) (defun vip-skip-nonseparators (direction) (let ((func (intern (format "skip-syntax-%S" direction)))) (funcall func (concat "^" vip-SEP-char-class) (vip-line-pos (if (eq direction 'forward) 'end 'start))))) (defsubst vip-skip-nonalphasep-forward () (if (eq vip-syntax-preference 'strict-vi) (skip-chars-forward (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars)) (skip-syntax-forward (concat "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'end)))) (defsubst vip-skip-nonalphasep-backward () (if (eq vip-syntax-preference 'strict-vi) (skip-chars-backward (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars)) (skip-syntax-backward (concat "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'start)))) ;; Skip SYNTAX like skip-syntax-* and ADDL-CHARS like skip-chars-* ;; Return the number of chars traveled. ;; Either SYNTAX or ADDL-CHARS can be nil, in which case they are interpreted ;; as an empty string. (defun vip-skip-syntax (direction syntax addl-chars &optional limit) (let ((total 0) (local 1) (skip-chars-func (intern (format "skip-chars-%S" direction))) (skip-syntax-func (intern (format "skip-syntax-%S" direction)))) (or (stringp addl-chars) (setq addl-chars "")) (or (stringp syntax) (setq syntax "")) (while (and (not (= local 0)) (not (eobp))) (setq local (+ (funcall skip-syntax-func syntax limit) (funcall skip-chars-func addl-chars limit))) (setq total (+ total local))) total )) (provide 'viper-util) ;;; viper-util.el ends here emacs-19.30/lisp/viper.el100444 75424 1 566152 6050716415 14003 0ustar kwzhdaemon;;; viper.el --- A full-featured Vi emulator. ;; a VI Plan for Emacs Rescue, ;; and a venomous VI PERil. ;; Viper Is also a Package for Emacs Rebels. ;; ;; Keywords: emulations ;; Author: Michael Kifer (defconst viper-version "2.82 of October 12, 1995" "The current version of Viper") ;; Copyright (C) 1994, 1995 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: ;; Viper is a full-featured Vi emulator for Emacs 19. It emulates and ;; improves upon the standard features of Vi and, at the same time, allows ;; full access to all Emacs facilities. Viper supports multiple undo, ;; file name completion, command, file, and search history and it extends ;; Vi in many other ways. Viper is highly customizable through the various ;; hooks, user variables, and keymaps. It is implemented as a collection ;; of minor modes and it is designed to provide full access to all Emacs ;; major and minor modes. ;; ;;; History ;; ;; Viper is a new name for a package formerly known as VIP-19, ;; which was a successor of VIP version 3.5 by Masahiko Sato ;; and VIP version 4.2 by Aamod Sane ;; . Some ideas from vip 4.4.2 by Aamod Sane ;; were also shamelessly plagiarized. ;; ;; Viper maintains some degree of compatibility with these older ;; packages. See the documentation for customization. ;; ;; The main difference between Viper and these older packages are: ;; ;; 1. Viper emulates Vi at several levels, from almost complete conformity ;; to a rather loose Vi-compliance. ;; ;; 2. Viper provides full access to all major and minor modes of Emacs ;; without the need to type extra keys. ;; The older versions of VIP (and other Vi emulators) do not work with ;; some major and minor modes. ;; ;; 3. Viper supports vi-style undo. ;; ;; 4. Viper fully emulates (and improves upon) vi's replacement mode. ;; ;; 5. Viper has a better interface to ex, including command, variable, and ;; file name completion. ;; ;; 6. Viper uses native Emacs history and completion features; it doesn't ;; rely on other packages (such as gmhist.el and completer.el) to provide ;; these features. ;; ;; 7. Viper supports Vi-style editing in the minibuffer, by allowing the ;; user to switch from Insert state to Vi state to Replace state, etc. ;; ;; 8. Viper keeps history of recently inserted pieces of text and recently ;; executed Vi-style destructive commands, such as `i', `d', etc. ;; These pieces of text can be inserted in later insertion commands; ;; the previous destructive commands can be re-executed. ;; ;; 9. Viper has Vi-style keyboard macros, which enhances the similar ;; facility in the original Vi. ;; First, one can execute any Emacs command while defining a ;; macro, not just the Vi commands. Second, macros are defined in a ;; WYSYWYG mode, using an interface to Emacs' WYSIWYG style of defining ;; macros. Third, in Viper, one can define macros that are specific to ;; a given buffer, a given major mode, or macros defined for all buffers. ;; The same macro name can have several different definitions: ;; one global, several definitions for various major modes, and ;; definitions for specific buffers. ;; Bffer-specific definitions override mode-specific ;; definitions, which, in turn, override global definitions. ;; ;; ;;; Installation: ;; ------------- ;; ;; (require 'viper) ;; ;;; Acknowledgements: ;; ----------------- ;; Bug reports and ideas contributed by the following users ;; have helped improve Viper and the various versions of VIP. ;; See the on-line manual for a complete list of contributors. ;; ;; ;;; Notes: ;; ;; 1. Major modes. ;; In most cases, Viper handles major modes correctly, i.e., they come up ;; in the right state (either vi-state or emacs-state). For instance, text ;; files come up in vi-state, while, say, Dired appears in emacs-state by ;; default. ;; However, some modes do not appear in the right mode in the beginning, ;; usually because they neglect to follow Emacs conventions (e.g., they don't ;; use kill-all-local-variables when they start). Some major modes ;; may fail to come up in emacs-state if they call hooks, such as ;; text-hook, for no good reason. ;; ;; As an immediate solution, you can hit C-z to bring about the right mode. ;; An interim solution is to add an appropriate hook to the mode like this: ;; ;; (add-hook 'your-favorite-mode 'viper-mode) ;; or ;; (add-hook 'your-favorite-mode 'vip-change-state-to-emacs) ;; ;; whichever applies. The right thing to do, however, is to complain to the ;; author of the respective package. (Sometimes they also neglect to equip ;; their modes with hooks, which is one more reason for complaining.) ;; ;; 2. Keymap handling ;; Because Emacs 19 has an elegant mechanism for turning minor mode keymaps ;; on and off, implementation of Viper has been greatly simplified. Viper ;; has several minor modes. ;; ;; Viper's Vi state consists of seven minor modes: ;; ;; vip-vi-intercept-minor-mode ;; vip-vi-local-user-minor-mode ;; vip-vi-global-user-minor-mode ;; vip-vi-kbd-minor-mode ;; vip-vi-state-modifier-minor-mode ;; vip-vi-diehard-minor-mode ;; vip-vi-basic-minor-mode ;; ;; Bindings done to the keymap of the first mode overshadow those done to ;; the second, which, in turn, overshadows those done to the third, etc. ;; ;; The last vip-vi-basic-minor-mode contains most of the usual Vi bindings ;; in its edit mode. This mode provides access to all Emacs facilities. ;; Novice users, however, may want to set their vip-expert-level to 1 ;; in their .vip file. This will enable vip-vi-diehard-minor-mode. This ;; minor mode's bindings make Viper simulate the usual Vi very closely. ;; For instance, C-c will not have its standard Emacs binding ;; and so many of the goodies of Emacs are not available. ;; ;; An skilled user, should set vip-expert-level to at least 3. This will ;; enable ;; C-c and many Emacs facilities will become available. ;; In this case, vip-vi-diehard-minor-mode is inactive. ;; ;; Viper gurus should have at least ;; (setq vip-expert-level 4) ;; in their ~/.vip files. This will unsuppress all Emacs keys that are not ;; essential for VI-style editing. ;; Pick-and-choose users may want to put ;; (setq vip-expert-level 5) ;; in ~/.vip. Viper will then leave it up to the user to set the variables ;; vip-want-* See vip-set-expert-level for details. ;; ;; The very first minor mode, vip-vi-intercept-minor-mode, is of no ;; concern for the user. It is needed to bind Viper's vital keys, such as ;; ESC and C-z. ;; ;; The second mode, vip-vi-local-user-minor-mode, usually has an ;; empty keymap. However, the user can set bindings in this keymap, which ;; will overshadow the corresponding bindings in the other two minor ;; modes. This is useful, for example, for setting up ZZ in gnus, ;; rmail, mh-e, etc., to send message instead of saving it in a file. ;; Likewise, in Dired mode, you may want to bind ZN and ZP to commands ;; that would visit the next or the previous file in the Dired buffer. ;; Setting local keys is tricky, so don't do it directly. Instead, use ;; vip-add-local-keys function (see its doc). ;; ;; The third minor mode, vip-vi-global-user-minor-mode, is also intended ;; for the users but, unlike vip-vi-local-user-minor-mode, its key ;; bindings are seen in all Viper buffers. This mode keys can be done ;; with define-key command. ;; ;; The fourth minor mode, vip-vi-kbd-minor-mode, is used by keyboard ;; macros. Users are NOT supposed to modify this keymap directly. ;; ;; The fifth mode, vip-vi-state-modifier-minor-mode, can be used to set ;; key bindings that are visible in some major modes but not in others. ;; ;; Users are allowed to modify keymaps that belong to ;; vip-vi-local-user-minor-mode, vip-vi-global-user-minor-mode, ;; and vip-vi-state-modifier-minor-mode only. ;; ;; Viper's Insert state also has seven minor modes: ;; ;; vip-insert-intercept-minor-mode ;; vip-insert-local-user-minor-mode ;; vip-insert-global-user-minor-mode ;; vip-insert-kbd-minor-mode ;; vip-insert-state-modifier-minor-mode ;; vip-insert-diehard-minor-mode ;; vip-insert-basic-minor-mode ;; ;; As with VI's editing modes, the first mode, vip-insert-intercept-minor-mode ;; is used to bind vital keys that are not to be changed by the user. ;; ;; The next mode, vip-insert-local-user-minor-mode, is used to customize ;; bindings in the insert state of Viper. The third mode, ;; vip-insert-global-user-minor-mode is like ;; vip-insert-local-user-minor-mode, except that its bindings are seen in ;; all Viper buffers. As with vip-vi-local-user-minor-mode, its bindings ;; should be done via the function vip-add-local-keys. Bindings for ;; vip-insert-global-user-minor-mode can be set with the define-key command. ;; ;; The next minor mode, vip-insert-kbd-minor-mode, ;; is used for keyboard VI-style macros defined with :map!. ;; ;; The fifth minor mode, vip-insert-state-modifier-minor-mode, is like ;; vip-vi-state-modifier-minor-mode, except that it is used in the Insert ;; state; it can be used to modify keys in a mode-specific fashion. ;; ;; The minor mode vip-insert-diehard-minor-mode is in effect when ;; the user wants a high degree of Vi compatibility (a bad idea, really!). ;; The last minor mode, vip-insert-basic-minor-mode, is always in effect ;; when Viper is in insert state. It binds a small number of keys needed for ;; Viper's operation. ;; ;; Finally, Viper provides minor modes for overriding bindings set by Emacs ;; modes when Viper is in Emacs state: ;; ;; vip-emacs-local-user-minor-mode ;; vip-emacs-global-user-minor-mode ;; vip-emacs-kbd-minor-mode ;; vip-emacs-state-modifier-minor-mode ;; ;; These minor modes are in effect when Viper is in Emacs state. The keymap ;; associated with vip-emacs-global-user-minor-mode, ;; vip-emacs-global-user-map, overrides the global and local keymaps as ;; well as the minor mode keymaps set by other modes. The keymap of ;; vip-emacs-local-user-minor-mode, vip-emacs-local-user-map, overrides ;; everything, but it is used on a per buffer basis. ;; The keymap associated with vip-emacs-state-modifier-minor-mode ;; overrides keys on a per-major-mode basis. The mode ;; vip-emacs-kbd-minor-mode is used to define Vi-style macros in Emacs ;; state. ;; ;; 3. There is also one minor mode that is used when Viper is in its ;; replace-state (used for commands like cw, C, etc.). This mode is ;; called ;; ;; vip-replace-minor-mode ;; ;; and its keymap is vip-replace-map. Replace minor mode is always ;; used in conjunction with the minor modes for insert-state, and its ;; keymap overshadows the keymaps for insert minor modes. ;; ;; 4. Defining buffer-local bindings in Vi and Insert modes. ;; As mentioned before, sometimes, it is convenient to have ;; buffer-specific of mode-specific key bindings in Vi and insert modes. ;; Viper provides a special function, vip-add-local-keys, to do precisely ;; this. For instance, is you need to add couple of mode-specific bindings ;; to Insert mode, you can put ;; ;; (vip-add-local-keys 'insert-state '((key1 . func1) (key2 .func2))) ;; ;; somewhere in a hook of this major mode. If you put something like this ;; in your own elisp function, this will define bindings specific to the ;; buffer that was current at the time of the call to vip-add-local-keys. ;; The only thing to make sure here is that the major mode of this buffer ;; is written according to Emacs conventions, which includes a call to ;; (kill-all-local-variables). See vip-add-local-keys for more details. ;; ;; ;; TO DO (volunteers?): ;; ;; 1. Some of the code that is inherited from VIP-3.5 is rather ;; convoluted. Instead of vip-command-argument, keymaps should bind the ;; actual commands. E.g., "dw" should be bound to a generic command ;; vip-delete that will delete things based on the value of ;; last-command-char. This would greatly simplify the logic and the code. ;; ;; 2. Somebody should venture to write a customization package a la ;; options.el that would allow the user to change values of variables ;; that meet certain specs (e.g., match a regexp) and whose doc string ;; starts with a '*'. Then, the user should be offered to save ;; variables that were changed. This will make user's customization job ;; much easier. ;; (require 'advice) (require 'cl) (require 'ring) (require 'viper-util) ;;; Variables ;; Is t until viper-mode executes for the very first time. ;; Prevents recursive descend into startup messages. (defvar vip-first-time t) (defvar vip-expert-level 0 "User's expert level. The minor mode vip-vi-diehard-minor-mode is in effect when vip-expert-level is 1 or 2 or when vip-want-emacs-keys-in-vi is t. The minor mode vip-insert-diehard-minor-mode is in effect when vip-expert-level is 1 or 2 or if vip-want-emacs-keys-in-insert is t. Use `M-x vip-set-expert-level' to change this.") ;; Max expert level supported by Viper. This is NOT a user option. ;; It is here to make it hard for the user from resetting it. (defconst vip-max-expert-level 5) ;; Contains user settings for vars affected by vip-set-expert-level function. ;; Not a user option. (defvar vip-saved-user-settings nil) ;;; Viper minor modes ;; This is not local in Emacs, so we make it local. (make-variable-buffer-local 'minor-mode-map-alist) ;; Mode for vital things like \e, C-z. (vip-deflocalvar vip-vi-intercept-minor-mode nil) (vip-deflocalvar vip-vi-basic-minor-mode nil "Viper's minor mode for Vi bindings.") (vip-deflocalvar vip-vi-local-user-minor-mode nil "Auxiliary minor mode for user-defined local bindings in Vi state.") (vip-deflocalvar vip-vi-global-user-minor-mode nil "Auxiliary minor mode for user-defined global bindings in Vi state.") (vip-deflocalvar vip-vi-state-modifier-minor-mode nil "Minor mode used to make major-mode-specific modification to Vi state.") (vip-deflocalvar vip-vi-diehard-minor-mode nil "This minor mode is in effect when the user wants Viper to be Vi.") (vip-deflocalvar vip-vi-kbd-minor-mode nil "Minor mode for Ex command macros in Vi state. The corresponding keymap stores key bindings of Vi macros defined with the Ex command :map.") ;; Mode for vital things like \e, C-z. (vip-deflocalvar vip-insert-intercept-minor-mode nil) (vip-deflocalvar vip-insert-basic-minor-mode nil "Viper's minor mode for bindings in Insert mode.") (vip-deflocalvar vip-insert-local-user-minor-mode nil "Auxiliary minor mode for buffer-local user-defined bindings in Insert state. This is a way to overshadow normal Insert mode bindings locally to certain designated buffers.") (vip-deflocalvar vip-insert-global-user-minor-mode nil "Auxiliary minor mode for global user-defined bindings in Insert state.") (vip-deflocalvar vip-insert-state-modifier-minor-mode nil "Minor mode used to make major-mode-specific modification to Insert state.") (vip-deflocalvar vip-insert-diehard-minor-mode nil "Minor mode that simulates Vi very closely. Not recommened, except for the novice user.") (vip-deflocalvar vip-insert-kbd-minor-mode nil "Minor mode for Ex command macros Insert state. The corresponding keymap stores key bindings of Vi macros defined with the Ex command :map!.") (vip-deflocalvar vip-replace-minor-mode nil "Minor mode in effect in replace state (cw, C, and the like commands).") ;; Mode for vital things like \C-z and \C-x) ;; This is t, by default. So, any new buffer will have C-z defined as ;; switch to Vi, unless we switched states in this buffer (vip-deflocalvar vip-emacs-intercept-minor-mode t) (vip-deflocalvar vip-emacs-local-user-minor-mode t "Minor mode for local user bindings effective in Emacs state. Users can use it to override Emacs bindings when Viper is in its Emacs state.") (vip-deflocalvar vip-emacs-global-user-minor-mode t "Minor mode for global user bindings in effect in Emacs state. Users can use it to override Emacs bindings when Viper is in its Emacs state.") (vip-deflocalvar vip-emacs-kbd-minor-mode t "Minor mode for Vi style macros in Emacs state. The corresponding keymap stores key bindings of Vi macros defined with `vip-record-kbd-macro' command. There is no Ex-level command to do this interactively.") (vip-deflocalvar vip-emacs-state-modifier-minor-mode t "Minor mode used to make major-mode-specific modification to Emacs state. For instance, a Vi purist may want to bind `dd' in Dired mode to a function that deletes a file.") ;;; ISO characters (vip-deflocalvar vip-automatic-iso-accents nil "*If non-nil, ISO accents will be turned on in insert/replace emacs states and turned off in vi-state. For some users, this behavior may be too primitive. In this case, use insert/emacs/vi state hooks.") ;;; Emacs keys in other states. (defvar vip-want-emacs-keys-in-insert t "*Set to nil if you want complete Vi compatibility in insert mode. Complete compatibility with Vi is not recommended for power use of Viper.") (defvar vip-want-emacs-keys-in-vi t "*Set to nil if you want complete Vi compatibility in Vi mode. Full Vi compatibility is not recommended for power use of Viper.") ;; VI-style Undo ;; Used to 'undo' complex commands, such as replace and insert commands. (vip-deflocalvar vip-undo-needs-adjustment nil) (put 'vip-undo-needs-adjustment 'permanent-local t) ;; A mark that Viper puts on buffer-undo-list. Marks the beginning of a ;; complex command that must be undone atomically. If inserted, it is ;; erased by vip-change-state-to-vi and vip-repeat. (defconst vip-buffer-undo-list-mark 'viper) (defvar vip-keep-point-on-undo nil "*Non-nil means not to move point while undoing commands. This style is different from Emacs and Vi. Try it to see if it better fits your working style.") ;; Replace mode and changing text ;; Viper's own after/before change functions, which get vip-add-hook'ed to ;; Emacs's (vip-deflocalvar vip-after-change-functions nil "") (vip-deflocalvar vip-before-change-functions nil "") (vip-deflocalvar vip-post-command-hooks nil "") (vip-deflocalvar vip-pre-command-hooks nil "") ;; Can be used to pass global states around for short period of time (vip-deflocalvar vip-intermediate-command nil "") ;; Indicates that the current destructive command has started in replace mode. (vip-deflocalvar vip-began-as-replace nil "") (defvar vip-replace-overlay-cursor-color "Red" "*Cursor color to use in Replace state") (vip-deflocalvar vip-replace-overlay nil "") (put 'vip-replace-overlay 'permanent-local t) (if (vip-window-display-p) (progn (add-to-list 'facemenu-unlisted-faces 'vip-replace-overlay-face) (make-face 'vip-replace-overlay-face) (or (face-differs-from-default-p 'vip-replace-overlay-face) (progn (if (vip-can-use-colors "darkseagreen2" "Black") (progn (set-face-background 'vip-replace-overlay-face "darkseagreen2") (set-face-foreground 'vip-replace-overlay-face "Black"))) (set-face-underline-p 'vip-replace-overlay-face t)) ))) (defvar vip-replace-overlay-face 'vip-replace-overlay-face "*Face for highlighting replace regions on a window display.") (defvar vip-replace-region-end-delimiter "$" "A string marking the end of replacement regions. It is used only with TTYs or if `vip-use-replace-region-delimiters' is non-nil.") (defvar vip-replace-region-start-delimiter "" "A string marking the beginning of replacement regions. It is used only with TTYs or if `vip-use-replace-region-delimiters' is non-nil.") (defvar vip-use-replace-region-delimiters (or (not (vip-window-display-p)) (not (vip-color-display-p))) "*If non-nil, Viper will always use `vip-replace-region-end-delimiter' and `vip-replace-region-start-delimiter' to delimit replacement regions, even on color displays. By default, the delimiters are used only on TTYs or monochrome displays.") ;; XEmacs requires glyphs (if vip-xemacs-p (progn (or (glyphp vip-replace-region-end-delimiter) (setq vip-replace-region-end-delimiter (make-glyph vip-replace-region-end-delimiter))) (or (glyphp vip-replace-region-start-delimiter) (setq vip-replace-region-start-delimiter (make-glyph vip-replace-region-start-delimiter))) )) ;; These are local marker that must be initialized to nil and moved with ;; `vip-move-marker-locally' ;; ;; Remember the last position inside the replace region. (vip-deflocalvar vip-last-posn-in-replace-region nil) ;; Remember the last position while inserting (vip-deflocalvar vip-last-posn-while-in-insert-state nil) (put 'vip-last-posn-in-replace-region 'permanent-local t) (put 'vip-last-posn-while-in-insert-state 'permanent-local t) (vip-deflocalvar vip-sitting-in-replace nil "") (put 'vip-sitting-in-replace 'permanent-local t) ;; Remember the number of characters that have to be deleted in replace ;; mode to compensate for the inserted characters. (vip-deflocalvar vip-replace-chars-to-delete 0 "") (vip-deflocalvar vip-replace-chars-deleted 0 "") ;; Insertion ring and command ring (defvar vip-insertion-ring-size 14 "The size of the insertion ring.") ;; The insertion ring. (defvar vip-insertion-ring nil) ;; This is temp insertion ring. Used to do rotation for display purposes. ;; When rotation just started, it is initialized to vip-insertion-ring. (defvar vip-temp-insertion-ring nil) (defvar vip-last-inserted-string-from-insertion-ring "") (defvar vip-command-ring-size 14 "The size of the command ring.") ;; The command ring. (defvar vip-command-ring nil) ;; This is temp command ring. Used to do rotation for display purposes. ;; When rotation just started, it is initialized to vip-command-ring. (defvar vip-temp-command-ring nil) ;; Modes and related variables ;; Current mode. One of: `emacs-state', `vi-state', `insert-state' (vip-deflocalvar vip-current-state 'emacs-state) (defvar vip-toggle-key "\C-z" "The key used to change states from emacs to Vi and back. In insert mode, this key also functions as Meta. Must be set in .vip file or prior to loading Viper. This setting cannot be changed interactively.") (defvar vip-ESC-key "\e" "Key used to ESC. Must be set in .vip file or prior to loading Viper. This setting cannot be changed interactively.") (defvar vip-no-multiple-ESC t "*If true, multiple ESC in Vi mode will cause bell to ring. \_ is then mapped to Meta. This is set to t on a windowing terminal and to 'twice on a dumb terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this enables cursor keys and is generally more convenient, as terminals usually don't have a convenient Meta key. Setting vip-no-multiple-ESC to nil will allow as many multiple ESC, as is allowed by the major mode in effect.") (defvar vip-want-ctl-h-help nil "*If t then C-h is bound to help-command in insert mode, if nil then it is bound to delete-backward-char.") ;; Autoindent in insert ;; Variable that keeps track of whether C-t has been pressed. (vip-deflocalvar vip-cted nil "") ;; Preserve the indent value, used by C-d in insert mode. (vip-deflocalvar vip-current-indent 0) ;; Whether to preserve the indent, used by C-d in insert mode. (vip-deflocalvar vip-preserve-indent nil) (defconst vip-auto-indent nil "*Autoindent if t.") (defconst vip-shift-width 8 "*The shiftwidth variable.") ;; Variables for repeating destructive commands (defconst vip-keep-point-on-repeat t "*If t, don't move point when repeating previous command. This is useful for doing repeated changes with the '.' key. The user can change this to nil, if she likes when the cursor moves to a new place after repeating previous Vi command.") ;; Remember insert point as a marker. This is a local marker that must be ;; initialized to nil and moved with `vip-move-marker-locally'. (vip-deflocalvar vip-insert-point nil) (put 'vip-insert-point 'permanent-local t) ;; This remembers the point before dabbrev-expand was called. ;; If vip-insert-point turns out to be bigger than that, it is reset ;; back to vip-pre-command-point. ;; The reason this is needed is because dabbrev-expand (and possibly ;; others) may jump to before the insertion point, delete something and ;; then reinsert a bigger piece. For instance: bla^blo ;; If dabbrev-expand is called after `blo' and ^ undicates vip-insert-point, ;; then point jumps to the beginning of `blo'. If expansion is found, `blablo' ;; is deleted, and we have |^, where | denotes point. Next, dabbrev-expand ;; will insert the expansion, and we get: blablo^ ;; Whatever we insert next goes before the ^, i.e., before the ;; vip-insert-point marker. So, Viper will think that nothing was ;; inserted. Remembering the orig position of the marker circumvents the ;; problem. ;; We don't know of any command, except dabbrev-expand, that has the same ;; problem. However, the same trick can be used if such a command is ;; discovered later. ;; (vip-deflocalvar vip-pre-command-point nil) (put 'vip-pre-command-point 'permanent-local t) ; this is probably an overkill ;; This is used for saving inserted text. (defvar vip-last-insertion nil) ;; Remembers the last replaced region. (defvar vip-last-replace-region "") ;; Remember com point as a marker. ;; This is a local marker. Should be moved with `vip-move-marker-locally' (vip-deflocalvar vip-com-point nil) ;; If non-nil, the value is a list (M-COM VAL COM REG inserted-text cmd-keys) ;; It is used to re-execute last destructive command. ;; M-COM is a Lisp symbol representing the function to be executed. ;; VAL is the prefix argument that was used with that command. ;; COM is an internal descriptor, such as ?r, ?c, ?C, which contains ;; additional information on how the function in M-COM is to be handled. ;; REG is the register used by command ;; INSERTED-TEXT is text inserted by that command (in case of o, c, C, i, r ;; commands). ;; COMMAND-KEYS are the keys that were typed to invoke the command. (defvar vip-d-com nil) ;; The character remembered by the Vi `r' command. (defvar vip-d-char nil) ;; Name of register to store deleted or yanked strings (defvar vip-use-register nil) ;; Variables for Moves and Searches ;; For use by `;' command. (defvar vip-f-char nil) ;; For use by `.' command. (defvar vip-F-char nil) ;; For use by `;' command. (defvar vip-f-forward nil) ;; For use by `;' command. (defvar vip-f-offset nil) ;; Last search string (defvar vip-s-string "") (defvar vip-quote-string "> " "String inserted at the beginning of quoted region.") ;; If t, search is forward. (defvar vip-s-forward nil) (defconst vip-case-fold-search nil "*If t, search ignores cases.") (defconst vip-re-search t "*If t, search is reg-exp search, otherwise vanilla search.") (defconst vip-re-query-replace t "*If t then do regexp replace, if nil then do string replace.") (defconst vip-re-replace t "*If t, do regexp replace. nil means do string replace.") (vip-deflocalvar vip-ex-style-motion t "*Ex-style: the commands l,h do not cross lines, etc.") (vip-deflocalvar vip-ex-style-editing-in-insert t "*The keys ^H, ^? don't jump lines in insert, ESC moves cursor back, etc. Note: this doesn't preclude ^H and ^? from deleting characters by moving past the insertion point. This is a feature, not a bug. ") (vip-deflocalvar vip-delete-backwards-in-replace nil "*If t, DEL key will delete characters while moving the cursor backwards. If nil, the cursor will move backwards without deleting anything.") (defconst vip-buffer-search-char nil "*Key bound for buffer-searching.") (defconst vip-search-wrap-around-t t "*If t, search wraps around.") (vip-deflocalvar vip-related-files-and-buffers-ring nil "*Ring of file and buffer names that are considered to be related to the current buffer. These buffers can be cycled through via :R and :P commands.") (put 'vip-related-files-and-buffers-ring 'permanent-local t) ;; Used to find out if we are done with searching the current buffer. (vip-deflocalvar vip-local-search-start-marker nil) ;; As above, but global (defvar vip-search-start-marker (make-marker)) ;; the search overlay (vip-deflocalvar vip-search-overlay nil) (defvar vip-heading-start (concat "^\\s-*(\\s-*defun\\s-\\|" ; lisp "^{\\s-*$\\|^[_a-zA-Z][^()]*[()].*{\\s-*$\\|" ; C/C++ "^\\s-*class.*{\\|^\\s-*struct.*{\\|^\\s-*enum.*{\\|" "^\\\\[sb][a-z]*{.*}\\s-*$\\|" ; latex "^@node\\|@table\\|^@m?enu\\|^@itemize\\|^@if\\|" ; texinfo "^.+:-") ; prolog "*Regexps for Headings. Used by \[\[ and \]\].") (defvar vip-heading-end (concat "^}\\|" ; C/C++ "^\\\\end{\\|" ; latex "^@end \\|" ; texinfo ")\n\n[ \t\n]*\\|" ; lisp "\\.\\s-*$") ; prolog "*Regexps to end Headings/Sections. Used by \[\].") ;; These two vars control the interaction of jumps performed by ' and `. ;; In this new version, '' doesn't erase the marks set by ``, so one can ;; use both kinds of jumps interchangeably and without loosing positions ;; inside the lines. ;; Remembers position of the last jump done using ``'. (vip-deflocalvar vip-last-jump nil) ;; Remembers position of the last jump done using `''. (vip-deflocalvar vip-last-jump-ignore 0) ;; Some common error messages (defconst vip-SpuriousText "Spurious text after command" "") (defconst vip-BadExCommand "Not an editor command" "") (defconst vip-InvalidCommandArgument "Invalid command argument" "") (defconst vip-NoPrevSearch "No previous search string" "") (defconst vip-EmptyRegister "`%c': Nothing in this register" "") (defconst vip-InvalidRegister "`%c': Invalid register" "") (defconst vip-EmptyTextmarker "`%c': Text marker doesn't point anywhere" "") (defconst vip-InvalidTextmarker "`%c': Invalid text marker" "") (defconst vip-InvalidViCommand "Invalid command" "") (defconst vip-BadAddress "Ill-formed address" "") (defconst vip-FirstAddrExceedsSecond "First address exceeds second" "") (defconst vip-NoFileSpecified "No file specified" "") ;; History variables ;; History of search strings. (defvar vip-search-history (list "")) ;; History of query-replace strings used as a source. (defvar vip-replace1-history nil) ;; History of query-replace strings used as replacement. (defvar vip-replace2-history nil) ;; History of region quoting strings. (defvar vip-quote-region-history (list vip-quote-string)) ;; History of Ex-style commands. (defvar vip-ex-history nil) ;; History of shell commands. (defvar vip-shell-history nil) ;; Last shell command. There are two of these, one for Ex (in viper-ex) ;; and one for Vi. ;; Last shell command executed with ! command. (defvar vip-last-shell-com nil) ;;; Miscellaneous ;; don't bark when mark is inactive (setq mark-even-if-inactive t) (defvar vip-inhibit-startup-message nil "Whether Viper startup message should be inhibited.") (defvar vip-always t "t means, arrange that vi-state will be a default.") (defvar vip-custom-file-name "~/.vip" "Viper customisation file. This variable must be set _before_ loading Viper.") (defvar vip-spell-function 'ispell-region "Spell function used by #s command to spell.") (defvar vip-tags-file-name "TAGS" "The tags file used by Viper.") ;; Minibuffer (defvar vip-vi-style-in-minibuffer t "If t, use vi-style editing in minibuffer. Should be set in `~/.vip' file.") ;; overlay used in the minibuffer to indicate which state it is in (vip-deflocalvar vip-minibuffer-overlay nil) ;; Hook, specific to Viper, which is run just *before* exiting the minibuffer. ;; Beginning with Emacs 19.26, the standard `minibuffer-exit-hook' is run ;; *after* exiting the minibuffer (defvar vip-minibuffer-exit-hook nil) (vip-deflocalvar vip-vi-minibuffer-minor-mode nil "Minor mode that forces Vi-style when the Minibuffer is in Vi state.") (vip-deflocalvar vip-insert-minibuffer-minor-mode nil "Minor mode that forces Vi-style when the Minibuffer is in Insert state.") ;; setup emacs-supported vi-style feel (setq next-line-add-newlines nil require-final-newline t) (make-variable-buffer-local 'require-final-newline) ;; Mode line (defconst vip-vi-state-id " " "Mode line tag identifying the Vi mode of Viper.") (defconst vip-emacs-state-id " " "Mode line tag identifying the Emacs mode of Viper.") (defconst vip-insert-state-id " " "Mode line tag identifying the Insert mode of Viper.") (defconst vip-replace-state-id " " "Mode line tag identifying the Replace mode of Viper.") ;; Viper changes the default mode-line-buffer-identification (setq-default mode-line-buffer-identification '(" %b")) ;; Variable displaying the current Viper state in the mode line. (vip-deflocalvar vip-mode-string vip-emacs-state-id) (or (memq 'vip-mode-string global-mode-string) (setq global-mode-string (append '("" vip-mode-string) (cdr global-mode-string)))) (defvar vip-vi-state-hook nil "*Hooks run just before the switch to Vi mode is completed.") (defvar vip-insert-state-hook nil "*Hooks run just before the switch to Insert mode is completed.") (defvar vip-replace-state-hook nil "*Hooks run just before the switch to Replace mode is completed.") (defvar vip-emacs-state-hook nil "*Hooks run just before the switch to Emacs mode is completed.") (defvar vip-load-hook nil "Hooks run just after loading Viper.") ;; Generic predicates ;; These test functions are shamelessly lifted from vip 4.4.2 by Aamod Sane ;; generate test functions ;; given symbol foo, foo-p is the test function, foos is the set of ;; Viper command keys ;; (macroexpand '(vip-test-com-defun foo)) ;; (defun foo-p (com) (consp (memq (if (< com 0) (- com) com) foos))) (defmacro vip-test-com-defun (name) (let* ((snm (symbol-name name)) (nm-p (intern (concat snm "-p"))) (nms (intern (concat snm "s")))) (` (defun (, nm-p) (com) (consp (memq (if (< com 0) (- com) com) (, nms))))))) ;; Variables for defining VI commands ;; Modifying commands that can be prefixes to movement commands (defconst vip-prefix-commands '(?c ?d ?y ?! ?= ?# ?< ?> ?\")) (vip-test-com-defun vip-prefix-command) ;; Commands that are pairs eg. dd. r and R here are a hack (defconst vip-charpair-commands '(?c ?d ?y ?! ?= ?< ?> ?r ?R)) (vip-test-com-defun vip-charpair-command) (defconst vip-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?H ?j ?k ?l ?H ?M ?n ?t ?T ?w ?W ?$ ?% ?^ ?( ?) ?- ?+ ?| ?{ ?} ?[ ?] ?' ?` ?; ?, ?0 ?? ?/ ) "Movement commands") (vip-test-com-defun vip-movement-command) ;; Commands that can be repeated by .(dotted) (defconst vip-dotable-commands '(?c ?d ?C ?D ?> ?<)) (vip-test-com-defun vip-dotable-command) ;; Commands that can follow a # (defconst vip-hash-cmds '(?c ?C ?g ?q ?S)) (vip-test-com-defun vip-hash-cmd) ;; Commands that may have registers as prefix (defconst vip-regsuffix-commands '(?d ?y ?Y ?D ?p ?P ?x ?X)) (vip-test-com-defun vip-regsuffix-command) ;;; Arrange the keymaps (require 'viper-keym) ;;;; CODE ;; changing mode ;; Change state to NEW-STATE---either emacs-state, vi-state, or insert-state. (defun vip-change-state (new-state) ;; Keep vip-post/pre-command-hooks fresh. ;; We remove then add vip-post/pre-command-sentinel since it is very ;; desirable that noone gets in-between (remove-hook 'post-command-hook 'vip-post-command-sentinel) (add-hook 'post-command-hook 'vip-post-command-sentinel) (remove-hook 'pre-command-hook 'vip-pre-command-sentinel) (add-hook 'pre-command-hook 'vip-pre-command-sentinel t) ;; These hooks will be added back if switching to insert/replace mode (vip-remove-hook 'vip-post-command-hooks 'vip-insert-state-post-command-sentinel) (vip-remove-hook 'vip-pre-command-hooks 'vip-insert-state-pre-command-sentinel) (cond ((eq new-state 'vi-state) (cond ((member vip-current-state '(insert-state replace-state)) ;; move vip-last-posn-while-in-insert-state ;; This is a normal hook that is executed in insert/replace ;; states after each command. In Vi/Emacs state, it does ;; nothing. We need to execute it here to make sure that ;; the last posn was recorded when we hit ESC. ;; It may be left unrecorded if the last thing done in ;; insert/repl state was dabbrev-expansion or abbrev ;; expansion caused by hitting ESC (vip-insert-state-post-command-sentinel) (condition-case conds (progn (vip-save-last-insertion vip-insert-point vip-last-posn-while-in-insert-state) (if vip-began-as-replace (setq vip-began-as-replace nil) ;; repeat insert commands if numerical arg > 1 (save-excursion (vip-repeat-insert-command)))) (error (vip-message-conditions conds))) (if (> (length vip-last-insertion) 0) (vip-push-onto-ring vip-last-insertion 'vip-insertion-ring)) (if vip-ex-style-editing-in-insert (or (bolp) (backward-char 1)))) )) ;; insert or replace ((memq new-state '(insert-state replace-state)) (if (memq vip-current-state '(emacs-state vi-state)) (vip-move-marker-locally 'vip-insert-point (point))) (vip-move-marker-locally 'vip-last-posn-while-in-insert-state (point)) (vip-add-hook 'vip-post-command-hooks 'vip-insert-state-post-command-sentinel t) (vip-add-hook 'vip-pre-command-hooks 'vip-insert-state-pre-command-sentinel t)) ) ; outermost cond ;; Nothing needs to be done to switch to emacs mode! Just set some ;; variables, which is already done in vip-change-state-to-emacs! (setq vip-current-state new-state) (vip-normalize-minor-mode-map-alist) (vip-adjust-keys-for new-state) (vip-set-mode-vars-for new-state) (vip-refresh-mode-line) ) (defun vip-adjust-keys-for (state) "Make necessary adjustments to keymaps before entering STATE." (cond ((memq state '(insert-state replace-state)) (if vip-auto-indent (progn (define-key vip-insert-basic-map "\C-m" 'vip-autoindent) (if vip-want-emacs-keys-in-insert ;; expert (define-key vip-insert-basic-map "\C-j" nil) ;; novice (define-key vip-insert-basic-map "\C-j" 'vip-autoindent)))) (setq vip-insert-diehard-minor-mode (not vip-want-emacs-keys-in-insert)) (if vip-want-ctl-h-help (progn (define-key vip-insert-basic-map "\C-h" 'help-command) (define-key vip-replace-map "\C-h" 'help-command)) (define-key vip-insert-basic-map "\C-h" 'vip-del-backward-char-in-insert) (define-key vip-replace-map "\C-h" 'vip-del-backward-char-in-replace))) (t (setq vip-vi-diehard-minor-mode (not vip-want-emacs-keys-in-vi)) (if vip-want-ctl-h-help (define-key vip-vi-basic-map "\C-h" 'help-command) (define-key vip-vi-basic-map "\C-h" 'vip-backward-char))) )) ;; Normalizes minor-mode-map-alist by putting Viper keymaps first. ;; This ensures that Viper bindings are in effect, regardless of which minor ;; modes were turned on by the user or by other packages. (defun vip-normalize-minor-mode-map-alist () (setq minor-mode-map-alist (vip-append-filter-alist (list (cons 'vip-vi-intercept-minor-mode vip-vi-intercept-map) (cons 'vip-vi-minibuffer-minor-mode vip-minibuffer-map) (cons 'vip-vi-local-user-minor-mode vip-vi-local-user-map) (cons 'vip-vi-kbd-minor-mode vip-vi-kbd-map) (cons 'vip-vi-global-user-minor-mode vip-vi-global-user-map) (cons 'vip-vi-state-modifier-minor-mode (if (keymapp (cdr (assoc major-mode vip-vi-state-modifier-alist))) (cdr (assoc major-mode vip-vi-state-modifier-alist)) vip-empty-keymap)) (cons 'vip-vi-diehard-minor-mode vip-vi-diehard-map) (cons 'vip-vi-basic-minor-mode vip-vi-basic-map) (cons 'vip-insert-intercept-minor-mode vip-insert-intercept-map) (cons 'vip-replace-minor-mode vip-replace-map) ;; vip-insert-minibuffer-minor-mode must come after ;; vip-replace-minor-mode (cons 'vip-insert-minibuffer-minor-mode vip-minibuffer-map) (cons 'vip-insert-local-user-minor-mode vip-insert-local-user-map) (cons 'vip-insert-kbd-minor-mode vip-insert-kbd-map) (cons 'vip-insert-global-user-minor-mode vip-insert-global-user-map) (cons 'vip-insert-state-modifier-minor-mode (if (keymapp (cdr (assoc major-mode vip-insert-state-modifier-alist))) (cdr (assoc major-mode vip-insert-state-modifier-alist)) vip-empty-keymap)) (cons 'vip-insert-diehard-minor-mode vip-insert-diehard-map) (cons 'vip-insert-basic-minor-mode vip-insert-basic-map) (cons 'vip-emacs-intercept-minor-mode vip-emacs-intercept-map) (cons 'vip-emacs-local-user-minor-mode vip-emacs-local-user-map) (cons 'vip-emacs-kbd-minor-mode vip-emacs-kbd-map) (cons 'vip-emacs-global-user-minor-mode vip-emacs-global-user-map) (cons 'vip-emacs-state-modifier-minor-mode (if (keymapp (cdr (assoc major-mode vip-emacs-state-modifier-alist))) (cdr (assoc major-mode vip-emacs-state-modifier-alist)) vip-empty-keymap)) ) minor-mode-map-alist))) ;; Viper mode-changing commands and utilities ;; Modifies mode-line-buffer-identification. (defun vip-refresh-mode-line () (setq vip-mode-string (cond ((eq vip-current-state 'emacs-state) vip-emacs-state-id) ((eq vip-current-state 'vi-state) vip-vi-state-id) ((eq vip-current-state 'replace-state) vip-replace-state-id) ((eq vip-current-state 'insert-state) vip-insert-state-id))) ;; Sets Viper mode string in global-mode-string (force-mode-line-update)) ;;;###autoload (defun viper-mode () "Turn on Viper emulation of Vi." (interactive) (if (not noninteractive) (progn (if vip-first-time ; This check is important. Without it, startup and (progn ; expert-level msgs mix up when viper-mode recurses (setq vip-first-time nil) (if (not vip-inhibit-startup-message) (save-window-excursion (setq vip-inhibit-startup-message t) (delete-other-windows) (switch-to-buffer "Viper Startup Message") (erase-buffer) (insert (substitute-command-keys "Viper Is a Package for Emacs Rebels. It is also a VI Plan for Emacs Rescue and a venomous VI PERil. Technically speaking, Viper is a Vi emulation package for GNU Emacs 19 and XEmacs 19. It supports virtually all of Vi and Ex functionality, extending and improving upon much of it. 1. Viper supports Vi at several levels. Level 1 is the closest to Vi, level 5 provides the most flexibility to depart from many Vi conventions. You will be asked to specify your user level in a following screen. If you select user level 1 then the keys ^X, ^C, ^Z, and ^G will behave as in VI, to smooth transition to Viper for the beginners. However, to use Emacs productively, you are advised to reach user level 3 or higher. If your user level is 2 or higher, ^X and ^C will invoke Emacs functions,as usual in Emacs; ^Z will toggle vi/emacs modes, and ^G will be the usual Emacs's keyboard-quit (something like ^C in VI). 2. Vi exit functions (e.g., :wq, ZZ) work on INDIVIDUAL files -- they do not cause Emacs to quit, except at user level 1 (a novice). 3. ^X^C EXITS EMACS. 4. Viper supports multiple undo: `u' will undo. Typing `.' will repeat undo. Another `u' changes direction. 6. Emacs Meta functions are invoked by typing `_' or `\\ ESC'. On a window system, the best way is to use the Meta-key. 7. Try \\[keyboard-quit] and \\[abort-recursive-edit] repeatedly, if something funny happens. This would abort the current editing command. You can get more information on Viper by: a. Typing `:help' in Vi state b. Printing Viper manual, found in ./etc/viper.dvi c. Printing ViperCard, the Quick Reference, found in ./etc/viperCard.dvi This startup message appears whenever you load Viper, unless you type `y' now." )) (goto-char (point-min)) (if (y-or-n-p "Inhibit Viper startup message? ") (vip-save-setting 'vip-inhibit-startup-message "Viper startup message inhibited" vip-custom-file-name t)) (kill-buffer (current-buffer)))) (message " ") (vip-set-expert-level 'dont-change-unless))) (vip-change-state-to-vi)))) ;;;###autoload (defalias 'vip-mode 'viper-mode) ;; Switch from Insert state to Vi state. (defun vip-exit-insert-state () (interactive) (vip-change-state-to-vi)) (defun vip-set-mode-vars-for (state) "Sets Viper minor mode variables to put Viper's state STATE in effect." ;; Emacs state (setq vip-vi-minibuffer-minor-mode nil vip-insert-minibuffer-minor-mode nil vip-vi-intercept-minor-mode nil vip-insert-intercept-minor-mode nil vip-vi-local-user-minor-mode nil vip-vi-kbd-minor-mode nil vip-vi-global-user-minor-mode nil vip-vi-state-modifier-minor-mode nil vip-vi-diehard-minor-mode nil vip-vi-basic-minor-mode nil vip-replace-minor-mode nil vip-insert-local-user-minor-mode nil vip-insert-kbd-minor-mode nil vip-insert-global-user-minor-mode nil vip-insert-state-modifier-minor-mode nil vip-insert-diehard-minor-mode nil vip-insert-basic-minor-mode nil vip-emacs-intercept-minor-mode t vip-emacs-local-user-minor-mode t vip-emacs-kbd-minor-mode (not (vip-is-in-minibuffer)) vip-emacs-global-user-minor-mode t vip-emacs-state-modifier-minor-mode t ) ;; Vi state (if (eq state 'vi-state) ; adjust for vi-state (setq vip-vi-intercept-minor-mode t vip-vi-minibuffer-minor-mode (vip-is-in-minibuffer) vip-vi-local-user-minor-mode t vip-vi-kbd-minor-mode (not (vip-is-in-minibuffer)) vip-vi-global-user-minor-mode t vip-vi-state-modifier-minor-mode t ;; don't let the diehard keymap block command completion ;; and other things in the minibuffer vip-vi-diehard-minor-mode (not (or vip-want-emacs-keys-in-vi (vip-is-in-minibuffer))) vip-vi-basic-minor-mode t vip-emacs-intercept-minor-mode nil vip-emacs-local-user-minor-mode nil vip-emacs-kbd-minor-mode nil vip-emacs-global-user-minor-mode nil vip-emacs-state-modifier-minor-mode nil )) ;; Insert and Replace states (if (member state '(insert-state replace-state)) (setq vip-insert-intercept-minor-mode t vip-replace-minor-mode (eq state 'replace-state) vip-insert-minibuffer-minor-mode (vip-is-in-minibuffer) vip-insert-local-user-minor-mode t vip-insert-kbd-minor-mode (not (vip-is-in-minibuffer)) vip-insert-global-user-minor-mode t vip-insert-state-modifier-minor-mode t ;; don't let the diehard keymap block command completion ;; and other things in the minibuffer vip-insert-diehard-minor-mode (not (or vip-want-emacs-keys-in-insert (vip-is-in-minibuffer))) vip-insert-basic-minor-mode t vip-emacs-intercept-minor-mode nil vip-emacs-local-user-minor-mode nil vip-emacs-kbd-minor-mode nil vip-emacs-global-user-minor-mode nil vip-emacs-state-modifier-minor-mode nil )) ;; minibuffer faces (if (vip-window-display-p) (setq vip-minibuffer-current-face (cond ((eq state 'emacs-state) vip-minibuffer-emacs-face) ((eq state 'vi-state) vip-minibuffer-vi-face) ((memq state '(insert-state replace-state)) vip-minibuffer-insert-face)))) (if (vip-is-in-minibuffer) (vip-set-minibuffer-overlay)) ) ;; This also takes care of the annoying incomplete lines in files. ;; Also, this fixes `undo' to work vi-style for complex commands. (defun vip-change-state-to-vi () "Change Viper state to Vi." (interactive) (if (and vip-first-time (not (vip-is-in-minibuffer))) (viper-mode) (if overwrite-mode (overwrite-mode nil)) (if abbrev-mode (expand-abbrev)) (if (and auto-fill-function (> (current-column) fill-column)) (funcall auto-fill-function)) ;; don't leave whitespace lines around (if (and (memq last-command '(vip-autoindent vip-open-line vip-Open-line vip-replace-state-exit-cmd)) (vip-over-whitespace-line)) (indent-to-left-margin)) (vip-add-newline-at-eob-if-necessary) (if vip-undo-needs-adjustment (vip-adjust-undo)) (vip-change-state 'vi-state) ;; always turn off iso-accents-mode, or else we won't be able to use the ;; keys `,',^ in Vi state, as they will do accents instead of Vi actions. (if (and (boundp 'iso-accents-mode) iso-accents-mode) (iso-accents-mode -1)) ;; Protection against user errors in hooks (condition-case conds (run-hooks 'vip-vi-state-hook) (error (vip-message-conditions conds))))) (defun vip-change-state-to-insert () "Change Viper state to Insert." (interactive) (vip-change-state 'insert-state) (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode)) (iso-accents-mode 1)) ; turn iso accents on ;; Protection against user errors in hooks (condition-case conds (run-hooks 'vip-insert-state-hook) (error (vip-message-conditions conds)))) (defsubst vip-downgrade-to-insert () (setq vip-current-state 'insert-state vip-replace-minor-mode nil) ) ;; Change to replace state. When the end of replacement region is reached, ;; replace state changes to insert state. (defun vip-change-state-to-replace (&optional non-R-cmd) (vip-change-state 'replace-state) (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode)) (iso-accents-mode 1)) ; turn iso accents on ;; Run insert-state-hook (condition-case conds (run-hooks 'vip-insert-state-hook 'vip-replace-state-hook) (error (vip-message-conditions conds))) (if non-R-cmd (vip-start-replace) ;; 'R' is implemented using Emacs's overwrite-mode (vip-start-R-mode)) ) (defun vip-change-state-to-emacs () "Change Viper state to Emacs." (interactive) (vip-change-state 'emacs-state) (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode)) (iso-accents-mode 1)) ; turn iso accents on ;; Protection agains user errors in hooks (condition-case conds (run-hooks 'vip-emacs-state-hook) (error (vip-message-conditions conds)))) ;; escape to emacs mode termporarily (defun vip-escape-to-emacs (arg &optional events) "Escape to Emacs state from Vi state for one Emacs command. ARG is used as the prefix value for the executed command. If EVENTS is a list of events, which become the beginning of the command." (interactive "P") (vip-escape-to-state arg events 'emacs-state)) ;; escape to Vi mode termporarily (defun vip-escape-to-vi () "Escape from Emacs state to Vi state for one Vi 1-character command. This doesn't work with prefix arguments or most complex commands like cw, dw, etc. But it does work with some 2-character commands, like dd or dr." (interactive) (vip-escape-to-state nil nil 'vi-state)) ;; Escape to STATE mode for one Emacs command. (defun vip-escape-to-state (arg events state) (let (com key prefix-arg) ;; this temporarily turns off Viper's minor mode keymaps (vip-set-mode-vars-for state) (vip-normalize-minor-mode-map-alist) (if events (vip-set-unread-command-events events)) ;; protect against keyboard quit and other errors (condition-case nil (progn (unwind-protect (progn (setq com (key-binding (setq key (if vip-xemacs-p (read-key-sequence nil) (read-key-sequence nil t))))) ;; In case of indirection--chase definitions. ;; Have to do it here because we execute this command under ;; different keymaps, so command-execute may not do the ;; right thing there (while (vectorp com) (setq com (key-binding com)))) nil) ;; exec command in the right Viper state ;; otherwise, if we switch buffers in the escaped command, ;; Viper's mode vars will remain those of `state'. When we return ;; to the orig buffer, the bindings will be screwed up. (vip-set-mode-vars-for vip-current-state) ;; this-command, last-command-char, last-command-event (setq this-command com) (if vip-xemacs-p ; XEmacs represents key sequences as vectors (setq last-command-event (vip-seq-last-elt key) last-command-char (event-to-character last-command-event)) ;; Emacs represents them as sequences (str or vec) (setq last-command-event (vip-seq-last-elt key) last-command-char last-command-event)) (if (commandp com) (progn (setq prefix-arg arg) (command-execute com))) ) (quit (ding)) (error (beep 1)))) (vip-set-mode-vars-for vip-current-state)) ; set state in new buffer (defun vip-exec-form-in-emacs (form) "Execute FORM in Emacs, temporarily disabling Viper's minor modes. Similar to vip-escape-to-emacs, but accepts forms rather than keystrokes." (let ((buff (current-buffer)) result) (vip-set-mode-vars-for 'emacs-state) (setq result (eval form)) (if (not (equal buff (current-buffer))) ; cmd switched buffer (save-excursion (set-buffer buff) (vip-set-mode-vars-for vip-current-state))) (vip-set-mode-vars-for vip-current-state) result)) ;; This is needed because minor modes sometimes override essential Viper ;; bindings. By letting Viper know which files these modes are in, it will ;; arrange to reorganize minor-mode-map-alist so that things will work right. (defun vip-harness-minor-mode (load-file) "Familiarize Viper with a minor mode defined in LOAD_FILE. Minor modes that have their own keymaps may overshadow Viper keymaps. This function is designed to make Viper aware of the packages that define such minor modes. Usage: (vip-harness-minor-mode load-file) LOAD-FILE is a name of the file where the specific minor mode is defined. Suffixes such as .el or .elc should be stripped." (interactive "sEnter name of the load file: ") (vip-eval-after-load load-file '(vip-normalize-minor-mode-map-alist)) ;; Change the default for minor-mode-map-alist each time a harnessed minor ;; mode adds its own keymap to the a-list. (vip-eval-after-load load-file '(setq-default minor-mode-map-alist minor-mode-map-alist)) ) (defun vip-ESC (arg) "Emulate ESC key in Emacs. Prevents multiple escape keystrokes if vip-no-multiple-ESC is true. In that case \@ will be bound to ESC. If vip-no-multiple-ESC is 'twice double ESC would dings in vi-state. Other ESC sequences are emulated via the current Emacs's major mode keymap. This is more convenient on dumb terminals and in Emacs -nw, since this won't block functional keys such as up,down, etc. Meta key also will work. When vip-no-multiple-ESC is nil, ESC key behaves as in Emacs, any number of multiple escapes is allowed." (interactive "P") (let (char) (cond ((and (not vip-no-multiple-ESC) (eq vip-current-state 'vi-state)) (setq char (vip-read-char-exclusive)) (vip-escape-to-emacs arg (list ?\e char) )) ((and (eq vip-no-multiple-ESC 'twice) (eq vip-current-state 'vi-state)) (setq char (vip-read-char-exclusive)) (if (= char (string-to-char vip-ESC-key)) (ding) (vip-escape-to-emacs arg (list ?\e char) ))) (t (ding))) )) (defun vip-alternate-ESC (arg) "ESC key without checking for multiple keystrokes." (interactive "P") (vip-escape-to-emacs arg '(?\e))) ;; Intercept ESC sequences on dumb terminals. ;; Based on the idea contributed by Marcelino Veiga Tuimil ;; Check if last key was ESC and if so try to reread it as a function key. ;; But only if there are characters to read during a very short time. ;; Returns the last event, if any. (defun vip-envelop-ESC-key () (let ((event last-input-event) (keyseq [nil]) inhibit-quit) (if (vip-ESC-event-p event) (progn (if (vip-fast-keysequence-p) (progn (let (minor-mode-map-alist) (vip-set-unread-command-events event) (setq keyseq (funcall (ad-get-orig-definition 'read-key-sequence) nil)) ) ; let ;; If keyseq translates into something that still has ESC ;; at the beginning, separate ESC from the rest of the seq. ;; In XEmacs we check for events that are keypress meta-key ;; and convert them into [escape key] ;; ;; This is needed for the following reason: ;; If ESC is the first symbol, we interpret it as if the ;; user typed ESC and then quickly some other symbols. ;; If ESC is not the first one, then the key sequence ;; entered was apparently translated into a function key or ;; something (e.g., one may have ;; (define-key function-key-map "\e[192z" [f11]) ;; which would translate the escape-sequence generated by ;; f11 in an xterm window into the symbolic key f11. ;; ;; If `first-key' is not an ESC event, we make it into the ;; last-command-event in order to pretend that this key was ;; pressed. This is needed to allow arrow keys to be bound to ;; macros. Otherwise, vip-exec-mapped-kbd-macro will think that ;; the last event was ESC and so it'll execute whatever is ;; bound to ESC. (Viper macros can't be bound to ;; ESC-sequences). (let* ((first-key (elt keyseq 0)) (key-mod (event-modifiers first-key))) (cond ((vip-ESC-event-p first-key) ;; put keys following ESC on the unread list ;; and return ESC as the key-sequence (vip-set-unread-command-events (subseq keyseq 1)) (setq last-input-event event keyseq (if vip-emacs-p "\e" (vector (character-to-event ?\e))))) ((and vip-xemacs-p (key-press-event-p first-key) (equal '(meta) key-mod)) (vip-set-unread-command-events (vconcat (vector (character-to-event (event-key first-key))) (subseq keyseq 1))) (setq last-input-event event keyseq (vector (character-to-event ?\e)))) ((eventp first-key) (setq last-command-event first-key)) )) ) ; end progn ;; this is escape event with nothing after it ;; put in unread-command-event and then re-read (vip-set-unread-command-events event) (setq keyseq (funcall (ad-get-orig-definition 'read-key-sequence) nil)) )) ;; not an escape event (setq keyseq (vector event))) keyseq)) (defadvice read-key-sequence (around vip-read-keyseq-ad activate) "Harness to work for Viper. This advice is harmless---don't worry!" (let (inhibit-quit event keyseq) (setq keyseq ad-do-it) (setq event (if vip-xemacs-p (elt keyseq 0) ; XEmacs returns vector of events (elt (listify-key-sequence keyseq) 0))) (if (vip-ESC-event-p event) (let (unread-command-events) (vip-set-unread-command-events keyseq) (if (vip-fast-keysequence-p) (let ((vip-vi-global-user-minor-mode nil) (vip-vi-local-user-minor-mode nil) (vip-replace-minor-mode nil) ; actually unnecessary (vip-insert-global-user-minor-mode nil) (vip-insert-local-user-minor-mode nil)) (setq keyseq ad-do-it)) (setq keyseq ad-do-it)))) keyseq)) (defadvice describe-key (before vip-read-keyseq-ad protect activate) "Force to read key via `read-key-sequence'." (interactive (list (vip-events-to-keys (read-key-sequence "Describe key: "))))) (defadvice describe-key-briefly (before vip-read-keyseq-ad protect activate) "Force to read key via `read-key-sequence'." (interactive (list (vip-events-to-keys (read-key-sequence "Describe key briefly: "))))) ;; Listen to ESC key. ;; If a sequence of keys starting with ESC is issued with very short delays, ;; interpret these keys in Emacs mode, so ESC won't be interpreted as a Vi key. (defun vip-intercept-ESC-key () "Function that implements ESC key in Viper emulation of Vi." (interactive) (let ((cmd (or (key-binding (vip-envelop-ESC-key)) '(lambda () (interactive) (error ""))))) ;; call the actual function to execute ESC (if no other symbols followed) ;; or the key bound to the ESC sequence (if the sequence was issued ;; with very short delay between characters. (if (eq cmd 'vip-intercept-ESC-key) (setq cmd (cond ((eq vip-current-state 'vi-state) 'vip-ESC) ((eq vip-current-state 'insert-state) 'vip-exit-insert-state) ((eq vip-current-state 'replace-state) 'vip-replace-state-exit-cmd) (t 'vip-change-state-to-vi) ))) (call-interactively cmd))) ;; prefix argument for Vi mode ;; In Vi mode, prefix argument is a dotted pair (NUM . COM) where NUM ;; represents the numeric value of the prefix argument and COM represents ;; command prefix such as "c", "d", "m" and "y". ;; Compute numeric prefix arg value. ;; Invoked by CHAR. COM is the command part obtained so far. (defun vip-prefix-arg-value (event com) (let (value) ;; read while number (while (and (numberp event) (>= event ?0) (<= event ?9)) (setq value (+ (* (if (numberp value) value 0) 10) (- event ?0))) (setq event (vip-read-event-convert-to-char))) (setq prefix-arg value) (if com (setq prefix-arg (cons prefix-arg com))) (while (eq event ?U) (vip-describe-arg prefix-arg) (setq event (vip-read-event-convert-to-char))) (vip-set-unread-command-events event))) ;; Vi operator as prefix argument." (defun vip-prefix-arg-com (char value com) (let ((cont t)) (while (and cont (memq char (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\" vip-buffer-search-char))) (if com ;; this means that we already have a command character, so we ;; construct a com list and exit while. however, if char is " ;; it is an error. (progn ;; new com is (CHAR . OLDCOM) (if (memq char '(?# ?\")) (error "")) (setq com (cons char com)) (setq cont nil)) ;; If com is nil we set com as char, and read more. Again, if char ;; is ", we read the name of register and store it in vip-use-register. ;; if char is !, =, or #, a complete com is formed so we exit the ;; while loop. (cond ((memq char '(?! ?=)) (setq com char) (setq char (read-char)) (setq cont nil)) ((= char ?#) ;; read a char and encode it as com (setq com (+ 128 (read-char))) (setq char (read-char))) ((= char ?\") (let ((reg (read-char))) (if (vip-valid-register reg) (setq vip-use-register reg) (error "")) (setq char (read-char)))) (t (setq com char) (setq char (vip-read-char-exclusive))))))) (if (atom com) ;; com is a single char, so we construct prefix-arg ;; and if char is ?, describe prefix arg, otherwise exit by ;; pushing the char back (progn (setq prefix-arg (cons value com)) (while (= char ?U) (vip-describe-arg prefix-arg) (setq char (read-char))) (vip-set-unread-command-events char) ) ;; as com is non-nil, this means that we have a command to execute (if (memq (car com) '(?r ?R)) ;; execute apropriate region command. (let ((char (car com)) (com (cdr com))) (setq prefix-arg (cons value com)) (if (= char ?r) (vip-region prefix-arg) (vip-Region prefix-arg)) ;; reset prefix-arg (setq prefix-arg nil)) ;; otherwise, reset prefix arg and call appropriate command (setq value (if (null value) 1 value)) (setq prefix-arg nil) (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C))) ((equal com '(?d . ?d)) (vip-line (cons value ?D))) ((equal com '(?d . ?y)) (vip-yank-defun)) ((equal com '(?y . ?y)) (vip-line (cons value ?Y))) ((equal com '(?< . ?<)) (vip-line (cons value ?<))) ((equal com '(?> . ?>)) (vip-line (cons value ?>))) ((equal com '(?! . ?!)) (vip-line (cons value ?!))) ((equal com '(?= . ?=)) (vip-line (cons value ?=))) (t (error "")))))) (defun vip-describe-arg (arg) (let (val com) (setq val (vip-P-val arg) com (vip-getcom arg)) (if (null val) (if (null com) (message "Value is nil, and command is nil") (message "Value is nil, and command is `%c'" com)) (if (null com) (message "Value is `%d', and command is nil" val) (message "Value is `%d', and command is `%c'" val com))))) (defun vip-digit-argument (arg) "Begin numeric argument for the next command." (interactive "P") (vip-leave-region-active) (vip-prefix-arg-value last-command-char (if (consp arg) (cdr arg) nil))) (defun vip-command-argument (arg) "Accept a motion command as an argument." (interactive "P") (condition-case nil (vip-prefix-arg-com last-command-char (cond ((null arg) nil) ((consp arg) (car arg)) ((numberp arg) arg) (t (error vip-InvalidCommandArgument))) (cond ((null arg) nil) ((consp arg) (cdr arg)) ((numberp arg) nil) (t (error vip-InvalidCommandArgument)))) (quit (setq vip-use-register nil) (signal 'quit nil))) (vip-deactivate-mark)) ;; Get value part of prefix-argument ARG. (defsubst vip-p-val (arg) (cond ((null arg) 1) ((consp arg) (if (or (null (car arg)) (equal (car arg) '(nil))) 1 (car arg))) (t arg))) ;; Get raw value part of prefix-argument ARG. (defsubst vip-P-val (arg) (cond ((consp arg) (car arg)) (t arg))) ;; Get com part of prefix-argument ARG. (defsubst vip-getcom (arg) (cond ((null arg) nil) ((consp arg) (cdr arg)) (t nil))) ;; Get com part of prefix-argument ARG and modify it. (defun vip-getCom (arg) (let ((com (vip-getcom arg))) (cond ((equal com ?c) ?C) ((equal com ?d) ?D) ((equal com ?y) ?Y) (t com)))) ;; repeat last destructive command ;; Append region to text in register REG. ;; START and END are buffer positions indicating what to append. (defsubst vip-append-to-register (reg start end) (set-register reg (concat (if (stringp (get-register reg)) (get-register reg) "") (buffer-substring start end)))) ;; define functions to be executed ;; invoked by C command (defun vip-exec-change (m-com com) ;; handle C cmd at the eol and at eob. (if (or (and (eolp) (= vip-com-point (point))) (= vip-com-point (point-max))) (progn (insert " ")(backward-char 1))) (if (= vip-com-point (point)) (vip-forward-char-carefully)) (if (= com ?c) (vip-change vip-com-point (point)) (vip-change-subr vip-com-point (point)))) ;; this is invoked by vip-substitute-line (defun vip-exec-Change (m-com com) (save-excursion (set-mark vip-com-point) (vip-enlarge-region (mark t) (point)) (if vip-use-register (progn (cond ((vip-valid-register vip-use-register '(letter digit)) ;;(vip-valid-register vip-use-register '(letter) (copy-to-register vip-use-register (mark t) (point) nil)) ((vip-valid-register vip-use-register '(Letter)) (vip-append-to-register (downcase vip-use-register) (mark t) (point))) (t (setq vip-use-register nil) (error vip-InvalidRegister vip-use-register))) (setq vip-use-register nil))) (delete-region (mark t) (point))) (open-line 1) (if (= com ?C) (vip-change-mode-to-insert) (vip-yank-last-insertion))) (defun vip-exec-delete (m-com com) (if vip-use-register (progn (cond ((vip-valid-register vip-use-register '(letter digit)) ;;(vip-valid-register vip-use-register '(letter)) (copy-to-register vip-use-register vip-com-point (point) nil)) ((vip-valid-register vip-use-register '(Letter)) (vip-append-to-register (downcase vip-use-register) vip-com-point (point))) (t (setq vip-use-register nil) (error vip-InvalidRegister vip-use-register))) (setq vip-use-register nil))) (setq last-command (if (eq last-command 'd-command) 'kill-region nil)) (kill-region vip-com-point (point)) (setq this-command 'd-command) (if vip-ex-style-motion (if (and (eolp) (not (bolp))) (backward-char 1)))) (defun vip-exec-Delete (m-com com) (save-excursion (set-mark vip-com-point) (vip-enlarge-region (mark t) (point)) (if vip-use-register (progn (cond ((vip-valid-register vip-use-register '(letter digit)) ;;(vip-valid-register vip-use-register '(letter)) (copy-to-register vip-use-register (mark t) (point) nil)) ((vip-valid-register vip-use-register '(Letter)) (vip-append-to-register (downcase vip-use-register) (mark t) (point))) (t (setq vip-use-register nil) (error vip-InvalidRegister vip-use-register))) (setq vip-use-register nil))) (setq last-command (if (eq last-command 'D-command) 'kill-region nil)) (kill-region (mark t) (point)) (if (eq m-com 'vip-line) (setq this-command 'D-command))) (back-to-indentation)) (defun vip-exec-yank (m-com com) (if vip-use-register (progn (cond ((vip-valid-register vip-use-register '(letter digit)) ;; (vip-valid-register vip-use-register '(letter)) (copy-to-register vip-use-register vip-com-point (point) nil)) ((vip-valid-register vip-use-register '(Letter)) (vip-append-to-register (downcase vip-use-register) vip-com-point (point))) (t (setq vip-use-register nil) (error vip-InvalidRegister vip-use-register))) (setq vip-use-register nil))) (setq last-command nil) (copy-region-as-kill vip-com-point (point)) (goto-char vip-com-point)) (defun vip-exec-Yank (m-com com) (save-excursion (set-mark vip-com-point) (vip-enlarge-region (mark t) (point)) (if vip-use-register (progn (cond ((vip-valid-register vip-use-register '(letter digit)) (copy-to-register vip-use-register (mark t) (point) nil)) ((vip-valid-register vip-use-register '(Letter)) (vip-append-to-register (downcase vip-use-register) (mark t) (point))) (t (setq vip-use-register nil) (error vip-InvalidRegister vip-use-register))) (setq vip-use-register nil))) (setq last-command nil) (copy-region-as-kill (mark t) (point))) (vip-deactivate-mark) (goto-char vip-com-point)) (defun vip-exec-bang (m-com com) (save-excursion (set-mark vip-com-point) (vip-enlarge-region (mark t) (point)) (shell-command-on-region (mark t) (point) (if (= com ?!) (setq vip-last-shell-com (vip-read-string-with-history "!" nil 'vip-shell-history (car vip-shell-history) )) vip-last-shell-com) t))) (defun vip-exec-equals (m-com com) (save-excursion (set-mark vip-com-point) (vip-enlarge-region (mark t) (point)) (if (> (mark t) (point)) (exchange-point-and-mark)) (indent-region (mark t) (point) nil))) (defun vip-exec-shift (m-com com) (save-excursion (set-mark vip-com-point) (vip-enlarge-region (mark t) (point)) (if (> (mark t) (point)) (exchange-point-and-mark)) (indent-rigidly (mark t) (point) (if (= com ?>) vip-shift-width (- vip-shift-width)))) ;; return point to where it was before shift (goto-char vip-com-point)) ;; this is needed because some commands fake com by setting it to ?r, which ;; denotes repeated insert command. (defsubst vip-exec-dummy (m-com com) nil) (defun vip-exec-buffer-search (m-com com) (setq vip-s-string (buffer-substring (point) vip-com-point)) (setq vip-s-forward t) (setq vip-search-history (cons vip-s-string vip-search-history)) (vip-search vip-s-string vip-s-forward 1)) (defvar vip-exec-array (make-vector 128 nil)) ;; Using a dispatch array allows adding functions like buffer search ;; without affecting other functions. Buffer search can now be bound ;; to any character. (aset vip-exec-array ?c 'vip-exec-change) (aset vip-exec-array ?C 'vip-exec-Change) (aset vip-exec-array ?d 'vip-exec-delete) (aset vip-exec-array ?D 'vip-exec-Delete) (aset vip-exec-array ?y 'vip-exec-yank) (aset vip-exec-array ?Y 'vip-exec-Yank) (aset vip-exec-array ?r 'vip-exec-dummy) (aset vip-exec-array ?! 'vip-exec-bang) (aset vip-exec-array ?< 'vip-exec-shift) (aset vip-exec-array ?> 'vip-exec-shift) (aset vip-exec-array ?= 'vip-exec-equals) ;; This function is called by various movement commands to execute a ;; destructive command on the region specified by the movement command. For ;; instance, if the user types cw, then the command vip-forward-word will ;; call vip-execute-com to execute vip-exec-change, which eventually will ;; call vip-change to invoke the replace mode on the region. ;; ;; The list (M-COM VAL COM REG INSETED-TEXT COMMAND-KEYS) is set to ;; vip-d-com for later use by vip-repeat. (defun vip-execute-com (m-com val com) (let ((reg vip-use-register)) ;; this is the special command `#' (if (> com 128) (vip-special-prefix-com (- com 128)) (let ((fn (aref vip-exec-array (if (< com 0) (- com) com)))) (if (null fn) (error "%c: %s" com vip-InvalidViCommand) (funcall fn m-com com)))) (if (vip-dotable-command-p com) (vip-set-destructive-command (list m-com val (if (memq com (list ?c ?C ?!)) (- com) com) reg nil nil))) )) (defun vip-repeat (arg) "Re-execute last destructive command. Use the info in vip-d-com, which has the form \(com val ch reg inserted-text command-keys\), where `com' is the command to be re-executed, `val' is the argument to `com', `ch' is a flag for repeat, and `reg' is optional; if it exists, it is the name of the register for `com'. If the prefix argument, ARG, is non-nil, it is used instead of `val'." (interactive "P") (let ((save-point (point)) ; save point before repeating prev cmd ;; Pass along that we are repeating a destructive command ;; This tells vip-set-destructive-command not to update ;; vip-command-ring (vip-intermediate-command 'vip-repeat)) (if (eq last-command 'vip-undo) ;; if the last command was vip-undo, then undo-more (vip-undo-more) ;; otherwise execute the command stored in vip-d-com. if arg is non-nil ;; its prefix value is used as new prefix value for the command. (let ((m-com (car vip-d-com)) (val (vip-P-val arg)) (com (nth 2 vip-d-com)) (reg (nth 3 vip-d-com))) (if (null val) (setq val (nth 1 vip-d-com))) (if (null m-com) (error "No previous command to repeat.")) (setq vip-use-register reg) (if (nth 4 vip-d-com) ; text inserted by command (setq vip-last-insertion (nth 4 vip-d-com) vip-d-char (nth 4 vip-d-com))) (funcall m-com (cons val com)) (if (and vip-keep-point-on-repeat (< save-point (point))) (goto-char save-point)) ; go back to before repeat. (if (and (eolp) (not (bolp))) (backward-char 1)) )) (if vip-undo-needs-adjustment (vip-adjust-undo)) ; take care of undo ;; If the prev cmd was rotating the command ring, this means that `.' has ;; just executed a command from that ring. So, push it on the ring again. ;; If we are just executing previous command , then don't push vip-d-com ;; because vip-d-com is not fully constructed in this case (its keys and ;; the inserted text may be nil). Besides, in this case, the command ;; executed by `.' is already on the ring. (if (eq last-command 'vip-display-current-destructive-command) (vip-push-onto-ring vip-d-com 'vip-command-ring)) (vip-deactivate-mark) )) (defun vip-repeat-from-history () "Repeat a destructive command from history. Doesn't change vip-command-ring in any way, so `.' will work as before executing this command. This command is supposed to be bound to a two-character Vi macro where the second character is a digit 0 to 9. The digit indicates which history command to execute. `0' is equivalent to `.', `1' invokes the command before that, etc." (interactive) (let* ((vip-intermediate-command 'repeating-display-destructive-command) (idx (cond (vip-this-kbd-macro (string-to-number (symbol-name (elt vip-this-kbd-macro 1)))) (t 0))) (num idx) (vip-d-com vip-d-com)) (or (and (numberp num) (<= 0 num) (<= num 9)) (setq idx 0 num 0) (message "`vip-repeat-from-history' must be invoked as a Vi macro bound to `'")) (while (< 0 num) (setq vip-d-com (vip-special-ring-rotate1 vip-command-ring -1)) (setq num (1- num))) (vip-repeat nil) (while (> idx num) (vip-special-ring-rotate1 vip-command-ring 1) (setq num (1+ num))) )) ;; This command is invoked interactively by the key sequence # (defun vip-special-prefix-com (char) (cond ((= char ?c) (downcase-region (min vip-com-point (point)) (max vip-com-point (point)))) ((= char ?C) (upcase-region (min vip-com-point (point)) (max vip-com-point (point)))) ((= char ?g) (push-mark vip-com-point t) (vip-global-execute)) ((= char ?q) (push-mark vip-com-point t) (vip-quote-region)) ((= char ?s) (funcall vip-spell-function vip-com-point (point))) (t (error "#%c: %s" char vip-InvalidViCommand)))) ;; undoing (defun vip-undo () "Undo previous change." (interactive) (message "undo!") (let ((modified (buffer-modified-p)) (before-undo-pt (point-marker)) (after-change-functions after-change-functions) undo-beg-posn undo-end-posn) ;; no need to remove this hook, since this var has scope inside a let. (add-hook 'after-change-functions '(lambda (beg end len) (setq undo-beg-posn beg undo-end-posn (or end beg)))) (undo-start) (undo-more 2) (setq undo-beg-posn (or undo-beg-posn before-undo-pt) undo-end-posn (or undo-end-posn undo-beg-posn)) (goto-char undo-beg-posn) (sit-for 0) (if (and vip-keep-point-on-undo (pos-visible-in-window-p before-undo-pt)) (progn (push-mark (point-marker) t) (vip-sit-for-short 300) (goto-char undo-end-posn) (vip-sit-for-short 300) (if (and (> (abs (- undo-beg-posn before-undo-pt)) 1) (> (abs (- undo-end-posn before-undo-pt)) 1)) (goto-char before-undo-pt) (goto-char undo-beg-posn))) (push-mark before-undo-pt t)) (if (and (eolp) (not (bolp))) (backward-char 1)) (if (not modified) (set-buffer-modified-p t))) (setq this-command 'vip-undo)) ;; Continue undoing previous changes. (defun vip-undo-more () (message "undo more!") (condition-case nil (undo-more 1) (error (beep) (message "No further undo information in this buffer"))) (if (and (eolp) (not (bolp))) (backward-char 1)) (setq this-command 'vip-undo)) ;; The following two functions are used to set up undo properly. ;; In VI, unlike Emacs, if you open a line, say, and add a bunch of lines, ;; they are undone all at once. (defun vip-adjust-undo () (let ((inhibit-quit t) tmp tmp2) (setq vip-undo-needs-adjustment nil) (if (listp buffer-undo-list) (if (setq tmp (memq vip-buffer-undo-list-mark buffer-undo-list)) (progn (setq tmp2 (cdr tmp)) ; the part after mark ;; cut tail from buffer-undo-list temporarily by direct ;; manipulation with pointers in buffer-undo-list (setcdr tmp nil) (setq buffer-undo-list (delq nil buffer-undo-list)) (setq buffer-undo-list (delq vip-buffer-undo-list-mark buffer-undo-list)) ;; restore tail of buffer-undo-list (setq buffer-undo-list (nconc buffer-undo-list tmp2))) (setq buffer-undo-list (delq nil buffer-undo-list)))))) (defun vip-set-complex-command-for-undo () (if (listp buffer-undo-list) (if (not vip-undo-needs-adjustment) (let ((inhibit-quit t)) (setq buffer-undo-list (cons vip-buffer-undo-list-mark buffer-undo-list)) (setq vip-undo-needs-adjustment t))))) (defun vip-display-current-destructive-command () (let ((text (nth 4 vip-d-com)) (keys (nth 5 vip-d-com)) (max-text-len 30)) (setq this-command 'vip-display-current-destructive-command) (message " `.' runs %s%s" (concat "`" (vip-array-to-string keys) "'") (vip-abbreviate-string text max-text-len " inserting `" "'" " .......")) )) ;; don't change vip-d-com if it was vip-repeat command invoked with `.' ;; or in some other way (non-interactively). (defun vip-set-destructive-command (list) (or (eq vip-intermediate-command 'vip-repeat) (progn (setq vip-d-com list) (setcar (nthcdr 5 vip-d-com) (vip-array-to-string (this-command-keys))) (vip-push-onto-ring vip-d-com 'vip-command-ring)))) (defun vip-prev-destructive-command (next) "Find previous destructive command in the history of destructive commands. With prefix argument, find next destructive command." (interactive "P") (let (cmd vip-intermediate-command) (if (eq last-command 'vip-display-current-destructive-command) ;; repeated search through command history (setq vip-intermediate-command 'repeating-display-destructive-command) ;; first search through command history--set temp ring (setq vip-temp-command-ring (copy-list vip-command-ring))) (setq cmd (if next (vip-special-ring-rotate1 vip-temp-command-ring 1) (vip-special-ring-rotate1 vip-temp-command-ring -1))) (if (null cmd) () (setq vip-d-com cmd)) (vip-display-current-destructive-command))) (defun vip-next-destructive-command () "Find next destructive command in the history of destructive commands." (interactive) (vip-prev-destructive-command 'next)) (defun vip-insert-prev-from-insertion-ring (arg) "Cycle through insertion ring in the direction of older insertions. Undoes previous insertion and inserts new. With prefix argument, cycles in the direction of newer elements. In minibuffer, this command executes whatever the invocation key is bound to in the global map, instead of cycling through the insertion ring." (interactive "P") (let (vip-intermediate-command) (if (eq last-command 'vip-insert-from-insertion-ring) (progn ; repeated search through insertion history (setq vip-intermediate-command 'repeating-insertion-from-ring) (if (eq vip-current-state 'replace-state) (undo 1) (if vip-last-inserted-string-from-insertion-ring (backward-delete-char (length vip-last-inserted-string-from-insertion-ring)))) ) ;;first search through insertion history (setq vip-temp-insertion-ring (copy-list vip-insertion-ring))) (setq this-command 'vip-insert-from-insertion-ring) ;; so that things will be undone properly (setq buffer-undo-list (cons nil buffer-undo-list)) (setq vip-last-inserted-string-from-insertion-ring (vip-special-ring-rotate1 vip-temp-insertion-ring (if arg 1 -1))) ;; this change of vip-intermediate-command must come after ;; vip-special-ring-rotate1, so that the ring will rotate, but before the ;; insertion. (setq vip-intermediate-command nil) (if vip-last-inserted-string-from-insertion-ring (insert vip-last-inserted-string-from-insertion-ring)) )) (defun vip-insert-next-from-insertion-ring () "Cycle through insertion ring in the direction of older insertions. Undo previous insertion and inserts new." (interactive) (vip-insert-prev-from-insertion-ring 'next)) ;; some region utilities ;; If at the last line of buffer, add \\n before eob, if newline is missing. (defun vip-add-newline-at-eob-if-necessary () (save-excursion (end-of-line) ;; make sure all lines end with newline, unless in the minibuffer or ;; when requested otherwise (require-final-newline is nil) (if (and (eobp) (not (bolp)) require-final-newline (not (vip-is-in-minibuffer))) (insert "\n")))) (defun vip-yank-defun () (mark-defun) (copy-region-as-kill (point) (mark t))) ;; Enlarge region between BEG and END. (defun vip-enlarge-region (beg end) (or beg (setq beg end)) ; if beg is nil, set to end (or end (setq end beg)) ; if end is nil, set to beg (if (< beg end) (progn (goto-char beg) (set-mark end)) (goto-char end) (set-mark beg)) (beginning-of-line) (exchange-point-and-mark) (if (or (not (eobp)) (not (bolp))) (forward-line 1)) (if (not (eobp)) (beginning-of-line)) (if (> beg end) (exchange-point-and-mark))) ;; Quote region by each line with a user supplied string. (defun vip-quote-region () (setq vip-quote-string (vip-read-string-with-history "Quote string: " nil 'vip-quote-region-history vip-quote-string)) (vip-enlarge-region (point) (mark t)) (if (> (point) (mark t)) (exchange-point-and-mark)) (insert vip-quote-string) (beginning-of-line) (forward-line 1) (while (and (< (point) (mark t)) (bolp)) (insert vip-quote-string) (beginning-of-line) (forward-line 1))) ;; Tells whether BEG is on the same line as END. ;; If one of the args is nil, it'll return nil. (defun vip-same-line (beg end) (let ((selective-display nil)) (cond ((and beg end) ;; This 'if' is needed because Emacs treats the next empty line ;; as part of the previous line. (if (or (> beg (point-max)) (> end (point-max))) ; out of range () (if (and (> end beg) (= (vip-line-pos 'start) end)) (setq end (min (1+ end) (point-max)))) (if (and (> beg end) (= (vip-line-pos 'start) beg)) (setq beg (min (1+ beg) (point-max)))) (<= (count-lines beg end) 1) )) (t nil)) )) ;; Check if the string ends with a newline. (defun vip-end-with-a-newline-p (string) (or (string= string "") (= (vip-seq-last-elt string) ?\n))) (defun vip-tmp-insert-at-eob (msg) (let ((savemax (point-max))) (goto-char savemax) (insert msg) (sit-for 2) (goto-char savemax) (delete-region (point) (point-max)) )) ;;; Minibuffer business (defsubst vip-set-minibuffer-style () (add-hook 'minibuffer-setup-hook 'vip-minibuffer-setup-sentinel)) (defun vip-minibuffer-setup-sentinel () (let ((hook (if vip-vi-style-in-minibuffer 'vip-change-state-to-insert 'vip-change-state-to-emacs))) (funcall hook) ;; Make sure the minibufer overlay is kept up-to-date. In XEmacs also ;; guards against the possibility of detaching this overlay. (vip-add-hook 'vip-post-command-hooks 'vip-move-minibuffer-overlay) )) ;; Interpret last event in the local map (defun vip-exit-minibuffer () (interactive) (let (command) (setq command (local-key-binding (char-to-string last-command-char))) (if command (command-execute command) (exit-minibuffer)))) (defun vip-set-search-face () (if (not (vip-window-display-p)) () (defvar vip-search-face (progn (add-to-list 'facemenu-unlisted-faces 'vip-search-face) (make-face 'vip-search-face) (or (face-differs-from-default-p 'vip-search-face) ;; face wasn't set in .vip or .Xdefaults (if (vip-can-use-colors "Black" "khaki") (progn (set-face-background 'vip-search-face "khaki") (set-face-foreground 'vip-search-face "Black")) (copy-face 'italic 'vip-search-face) (set-face-underline-p 'vip-search-face t))) 'vip-search-face) "*Face used to flash out the search pattern.") )) (defun vip-set-minibuffer-faces () (if (not (vip-window-display-p)) () (defvar vip-minibuffer-emacs-face (progn (add-to-list 'facemenu-unlisted-faces 'vip-minibuffer-emacs-face) (make-face 'vip-minibuffer-emacs-face) (or (face-differs-from-default-p 'vip-minibuffer-emacs-face) ;; face wasn't set in .vip or .Xdefaults (if vip-vi-style-in-minibuffer ;; emacs state is an exception in the minibuffer (if (vip-can-use-colors "darkseagreen2" "Black") (progn (set-face-background 'vip-minibuffer-emacs-face "darkseagreen2") (set-face-foreground 'vip-minibuffer-emacs-face "Black")) (copy-face 'highlight 'vip-minibuffer-emacs-face)) ;; emacs state is the main state in the minibuffer (if (vip-can-use-colors "Black" "pink") (progn (set-face-background 'vip-minibuffer-emacs-face "pink") (set-face-foreground 'vip-minibuffer-emacs-face "Black")) (copy-face 'italic 'vip-minibuffer-emacs-face)) )) 'vip-minibuffer-emacs-face) "Face used in the Minibuffer when it is in Emacs state.") (defvar vip-minibuffer-insert-face (progn (add-to-list 'facemenu-unlisted-faces 'vip-minibuffer-insert-face) (make-face 'vip-minibuffer-insert-face) (or (face-differs-from-default-p 'vip-minibuffer-insert-face) (if vip-vi-style-in-minibuffer (if (vip-can-use-colors "Black" "pink") (progn (set-face-background 'vip-minibuffer-insert-face "pink") (set-face-foreground 'vip-minibuffer-insert-face "Black")) (copy-face 'italic 'vip-minibuffer-insert-face)) ;; If Insert state is an exception (if (vip-can-use-colors "darkseagreen2" "Black") (progn (set-face-background 'vip-minibuffer-insert-face "darkseagreen2") (set-face-foreground 'vip-minibuffer-insert-face "Black")) (copy-face 'highlight 'vip-minibuffer-insert-face)) (vip-italicize-face 'vip-minibuffer-insert-face))) 'vip-minibuffer-insert-face) "Face used in the Minibuffer when it is in Insert state.") (defvar vip-minibuffer-vi-face (progn (add-to-list 'facemenu-unlisted-faces 'vip-minibuffer-vi-face) (make-face 'vip-minibuffer-vi-face) (or (face-differs-from-default-p 'vip-minibuffer-vi-face) (if vip-vi-style-in-minibuffer (if (vip-can-use-colors "Black" "grey") (progn (set-face-background 'vip-minibuffer-vi-face "grey") (set-face-foreground 'vip-minibuffer-vi-face "Black")) (copy-face 'bold 'vip-minibuffer-vi-face)) (copy-face 'bold 'vip-minibuffer-vi-face) (invert-face 'vip-minibuffer-vi-face))) 'vip-minibuffer-vi-face) "Face used in the Minibuffer when it is in Vi state.") ;; the current face used in the minibuffer (vip-deflocalvar vip-minibuffer-current-face vip-minibuffer-emacs-face "") )) ;;; Reading string with history (defun vip-read-string-with-history (prompt &optional initial history-var default keymap) ;; Reads string, prompting with PROMPT and inserting the INITIAL ;; value. Uses HISTORY-VAR. DEFAULT is the default value to accept if the ;; input is an empty string. Uses KEYMAP, if given, or the ;; minibuffer-local-map. ;; Default value is displayed until the user types something in the ;; minibuffer. (let ((minibuffer-setup-hook '(lambda () (if (stringp initial) (progn ;; don't wait if we have unread events or in kbd macro (or unread-command-events executing-kbd-macro (sit-for 840)) (erase-buffer) (insert initial))) (vip-minibuffer-setup-sentinel))) (val "") (padding "") temp-msg) (setq keymap (or keymap minibuffer-local-map) initial (or initial "") temp-msg (if default (format "(default: %s) " default) "")) (setq vip-incomplete-ex-cmd nil) (setq val (read-from-minibuffer prompt (concat temp-msg initial val padding) keymap nil history-var)) (setq minibuffer-setup-hook nil padding (vip-array-to-string (this-command-keys)) temp-msg "") ;; the following tries to be smart about what to put in history (if (not (string= val (car (eval history-var)))) (set history-var (cons val (eval history-var)))) (if (or (string= (nth 0 (eval history-var)) (nth 1 (eval history-var))) (string= (nth 0 (eval history-var)) "")) (set history-var (cdr (eval history-var)))) ;; if the user enters nothing but the prev cmd wasn't vip-ex or ;; vip-command-argument, this means that the user typed something then ;; erased. Return "" in this case, not the default---default is too ;; confusing in this case (cond ((and (string= val "") (not (memq last-command (list 'vip-ex 'vip-command-argument t)))) "") ((string= val "") (or default "")) (t val)) )) ;; insertion commands ;; Called when state changes from Insert Vi command mode. ;; Repeats the insertion command if Insert state was entered with prefix ;; argument > 1. (defun vip-repeat-insert-command () (let ((i-com (car vip-d-com)) (val (nth 1 vip-d-com)) (char (nth 2 vip-d-com))) (if (and val (> val 1)) ; first check that val is non-nil (progn (setq vip-d-com (list i-com (1- val) ?r nil nil nil)) (vip-repeat nil) (setq vip-d-com (list i-com val char nil nil nil)) )))) (defun vip-insert (arg) "Insert before point." (interactive "P") (vip-set-complex-command-for-undo) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (vip-set-destructive-command (list 'vip-insert val ?r nil nil nil)) (if com (vip-loop val (vip-yank-last-insertion)) (vip-change-state-to-insert)))) (defun vip-append (arg) "Append after point." (interactive "P") (vip-set-complex-command-for-undo) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (vip-set-destructive-command (list 'vip-append val ?r nil nil nil)) (if (not (eolp)) (forward-char)) (if (equal com ?r) (vip-loop val (vip-yank-last-insertion)) (vip-change-state-to-insert)))) (defun vip-Append (arg) "Append at end of line." (interactive "P") (vip-set-complex-command-for-undo) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (vip-set-destructive-command (list 'vip-Append val ?r nil nil nil)) (end-of-line) (if (equal com ?r) (vip-loop val (vip-yank-last-insertion)) (vip-change-state-to-insert)))) (defun vip-Insert (arg) "Insert before first non-white." (interactive "P") (vip-set-complex-command-for-undo) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (vip-set-destructive-command (list 'vip-Insert val ?r nil nil nil)) (back-to-indentation) (if (equal com ?r) (vip-loop val (vip-yank-last-insertion)) (vip-change-state-to-insert)))) (defun vip-open-line (arg) "Open line below." (interactive "P") (vip-set-complex-command-for-undo) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (vip-set-destructive-command (list 'vip-open-line val ?r nil nil nil)) (let ((col (current-indentation))) (if (equal com ?r) (vip-loop val (progn (end-of-line) (newline 1) (if vip-auto-indent (progn (setq vip-cted t) (indent-to col))) (vip-yank-last-insertion))) (end-of-line) (newline 1) (if vip-auto-indent (progn (setq vip-cted t) (indent-to col))) (vip-change-state-to-insert) )))) (defun vip-Open-line (arg) "Open line above." (interactive "P") (vip-set-complex-command-for-undo) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (vip-set-destructive-command (list 'vip-Open-line val ?r nil nil nil)) (let ((col (current-indentation))) (if (equal com ?r) (vip-loop val (progn (beginning-of-line) (open-line 1) (if vip-auto-indent (progn (setq vip-cted t) (indent-to col))) (vip-yank-last-insertion))) (beginning-of-line) (open-line 1) (if vip-auto-indent (progn (setq vip-cted t) (indent-to col))) (vip-change-state-to-insert))))) (defun vip-open-line-at-point (arg) "Open line at point." (interactive "P") (vip-set-complex-command-for-undo) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (vip-set-destructive-command (list 'vip-open-line-at-point val ?r nil nil nil)) (if (equal com ?r) (vip-loop val (progn (open-line 1) (vip-yank-last-insertion))) (open-line 1) (vip-change-state-to-insert)))) (defun vip-substitute (arg) "Substitute characters." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (push-mark nil t) (forward-char val) (if (equal com ?r) (vip-change-subr (mark t) (point)) (vip-change (mark t) (point))) (vip-set-destructive-command (list 'vip-substitute val ?r nil nil nil)) )) (defun vip-substitute-line (arg) "Substitute lines." (interactive "p") (vip-set-complex-command-for-undo) (vip-line (cons arg ?C))) ;; Prepare for replace (defun vip-start-replace () (setq vip-began-as-replace t vip-sitting-in-replace t vip-replace-chars-to-delete 0 vip-replace-chars-deleted 0) (vip-add-hook 'vip-after-change-functions 'vip-replace-mode-spy-after t) (vip-add-hook 'vip-before-change-functions 'vip-replace-mode-spy-before t) ;; this will get added repeatedly, but no harm (add-hook 'after-change-functions 'vip-after-change-sentinel t) (add-hook 'before-change-functions 'vip-before-change-sentinel t) (vip-move-marker-locally 'vip-last-posn-in-replace-region (vip-replace-start)) (vip-add-hook 'vip-post-command-hooks 'vip-replace-state-post-command-sentinel t) (vip-add-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t) ) ;; Runs vip-after-change-functions inside after-change-functions (defun vip-after-change-sentinel (beg end len) (let ((list vip-after-change-functions)) (while list (funcall (car list) beg end len) (setq list (cdr list))))) ;; Runs vip-before-change-functions inside before-change-functions (defun vip-before-change-sentinel (beg end) (let ((list vip-before-change-functions)) (while list (funcall (car list) beg end) (setq list (cdr list))))) (defsubst vip-post-command-sentinel () (run-hooks 'vip-post-command-hooks)) (defsubst vip-pre-command-sentinel () (run-hooks 'vip-pre-command-hooks)) ;; Needed so that Viper will be able to figure the last inserted ;; chunk of text with reasonable accuracy. (defsubst vip-insert-state-post-command-sentinel () (if (and (memq vip-current-state '(insert-state replace-state)) vip-insert-point (>= (point) vip-insert-point)) (setq vip-last-posn-while-in-insert-state (point-marker))) (if (and (eq this-command 'dabbrev-expand) (integerp vip-pre-command-point) (> vip-insert-point vip-pre-command-point)) (move-marker vip-insert-point vip-pre-command-point)) ) (defsubst vip-insert-state-pre-command-sentinel () (if (and (eq this-command 'dabbrev-expand) (markerp vip-insert-point) (marker-position vip-insert-point)) (setq vip-pre-command-point (marker-position vip-insert-point)))) (defsubst vip-R-state-post-command-sentinel () ;; Restoring cursor color is needed despite ;; vip-replace-state-pre-command-sentinel: When you jump to another buffer in ;; another frame, the pre-command hook won't change cursor color to default ;; in that other frame. So, if the second frame cursor was red and we set ;; the point outside the replacement region, then the cursor color will ;; remain red. Restoring the default, below, prevents this. (if (and (<= (vip-replace-start) (point)) (<= (point) (vip-replace-end))) (vip-change-cursor-color vip-replace-overlay-cursor-color) (vip-restore-cursor-color) )) ;; to speed up, don't change cursor color before self-insert ;; and common move commands (defsubst vip-replace-state-pre-command-sentinel () (or (memq this-command '(self-insert-command)) (memq (vip-event-key last-command-event) '(up down left right (meta f) (meta b) (control n) (control p) (control f) (control b))) (vip-restore-cursor-color))) (defun vip-replace-state-post-command-sentinel () ;; Restoring cursor color is needed despite ;; vip-replace-state-pre-command-sentinel: When one jumps to another buffer ;; in another frame, the pre-command hook won't change cursor color to ;; default in that other frame. So, if the second frame cursor was red and ;; we set the point outside the replacement region, then the cursor color ;; will remain red. Restoring the default, below, fixes this problem. ;; ;; We optimize for self-insert-command's here, since they either don't change ;; cursor color or, if they terminate replace mode, the color will be changed ;; in vip-finish-change (or (memq this-command '(self-insert-command)) (vip-restore-cursor-color)) (cond ((eq vip-current-state 'replace-state) ;; delete characters to compensate for inserted chars. (let ((replace-boundary (vip-replace-end))) (save-excursion (goto-char vip-last-posn-in-replace-region) (delete-char vip-replace-chars-to-delete) (setq vip-replace-chars-to-delete 0 vip-replace-chars-deleted 0) ;; terminate replace mode if reached replace limit (if (= vip-last-posn-in-replace-region (vip-replace-end)) (vip-finish-change vip-last-posn-in-replace-region))) (if (and (<= (vip-replace-start) (point)) (<= (point) replace-boundary)) (progn ;; the state may have changed in vip-finish-change above (if (eq vip-current-state 'replace-state) (vip-change-cursor-color vip-replace-overlay-cursor-color)) (setq vip-last-posn-in-replace-region (point-marker)))) )) (t ;; terminate replace mode if changed Viper states. (vip-finish-change vip-last-posn-in-replace-region)))) ;; checks how many chars were deleted by the last change (defun vip-replace-mode-spy-before (beg end) (setq vip-replace-chars-deleted (- end beg (max 0 (- end (vip-replace-end))) (max 0 (- (vip-replace-start) beg)) ))) ;; Invoked as an after-change-function to set up parameters of the last change (defun vip-replace-mode-spy-after (beg end length) (if (memq vip-intermediate-command '(repeating-insertion-from-ring)) (progn (setq vip-replace-chars-to-delete 0) (vip-move-marker-locally 'vip-last-posn-in-replace-region (point))) (let (beg-col end-col real-end chars-to-delete) (setq real-end (min end (vip-replace-end))) (save-excursion (goto-char beg) (setq beg-col (current-column)) (goto-char real-end) (setq end-col (current-column))) ;; If beg of change is outside the replacement region, then don't ;; delete anything in the repl region (set chars-to-delete to 0). ;; ;; This works fine except that we have to take special care of ;; dabbrev-expand. The problem stems from new-dabbrev.el, which ;; sometimes simply shifts the repl region rightwards, without ;; deleting an equal amount of characters. ;; ;; The reason why new-dabbrev.el causes this are this: ;; if one dinamically completes a partial word that starts before the ;; replacement region (but ends inside)then new-dabbrev.el first ;; moves cursor backwards, to the beginning of the word to be ;; completed (say, pt A). Then it inserts the ;; completed word and then deletes the old, incomplete part. ;; Since the complete word is inserted at position before the repl ;; region, the next If-statement would have set chars-to-delete to 0 ;; unless we check for the current command, which must be ;; dabbrev-expand. ;; ;; We should be able deal with these problems in a better way ;; when emacs will have overlays with sticky back ends. ;; In fact, it would be also useful to add overlays for insert ;; regions as well, since this will let us capture the situation when ;; dabbrev-expand goes back past the insertion point to find the ;; beginning of the word to be expanded. (if (or (and (<= (vip-replace-start) beg) (<= beg (vip-replace-end))) (and (= length 0) (eq this-command 'dabbrev-expand))) (setq chars-to-delete (max (- end-col beg-col) (- real-end beg) 0)) (setq chars-to-delete 0)) ;; if beg = last change position, it means that we are within the ;; same command that does multiple changes. Moreover, it means ;; that we have two subsequent changes (insert/delete) that ;; complement each other. (if (= beg (marker-position vip-last-posn-in-replace-region)) (setq vip-replace-chars-to-delete (- (+ chars-to-delete vip-replace-chars-to-delete) vip-replace-chars-deleted)) (setq vip-replace-chars-to-delete chars-to-delete)) (vip-move-marker-locally 'vip-last-posn-in-replace-region (max (if (> end (vip-replace-end)) (vip-replace-start) end) (or (marker-position vip-last-posn-in-replace-region) (vip-replace-start)) )) (setq vip-replace-chars-to-delete (max 0 (min vip-replace-chars-to-delete (- (vip-replace-end) vip-last-posn-in-replace-region)))) ))) ;; Delete stuff between posn and the end of vip-replace-overlay-marker, if ;; posn is within the overlay. (defun vip-finish-change (posn) (vip-remove-hook 'vip-after-change-functions 'vip-replace-mode-spy-after) (vip-remove-hook 'vip-before-change-functions 'vip-replace-mode-spy-before) (vip-remove-hook 'vip-post-command-hooks 'vip-replace-state-post-command-sentinel) (vip-remove-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel) (vip-restore-cursor-color) (setq vip-sitting-in-replace nil) ; just in case we'll need to know it (save-excursion (if (and vip-replace-overlay (>= posn (vip-replace-start)) (< posn (vip-replace-end))) (delete-region posn (vip-replace-end))) ) (if (eq vip-current-state 'replace-state) (vip-downgrade-to-insert)) ;; replace mode ended => nullify vip-last-posn-in-replace-region (vip-move-marker-locally 'vip-last-posn-in-replace-region nil) (vip-hide-replace-overlay) (vip-refresh-mode-line) (vip-put-string-on-kill-ring vip-last-replace-region) ) ;; Make STRING be the first element of the kill ring. (defun vip-put-string-on-kill-ring (string) (setq kill-ring (cons string kill-ring)) (if (> (length kill-ring) kill-ring-max) (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)) (setq kill-ring-yank-pointer kill-ring)) (defun vip-finish-R-mode () (vip-remove-hook 'vip-post-command-hooks 'vip-R-state-post-command-sentinel) (vip-remove-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel) (vip-downgrade-to-insert)) (defun vip-start-R-mode () ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number (overwrite-mode 1) (vip-add-hook 'vip-post-command-hooks 'vip-R-state-post-command-sentinel t) (vip-add-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t) ) (defun vip-replace-state-exit-cmd () "Binding for keys that cause Replace state to switch to Vi or to Insert. These keys are ESC, RET, and LineFeed" (interactive) (if overwrite-mode ;; If you are in replace mode invoked via 'R' (vip-finish-R-mode) (vip-finish-change vip-last-posn-in-replace-region)) (let (com) (if (eq this-command 'vip-intercept-ESC-key) (setq com 'vip-exit-insert-state) (vip-set-unread-command-events last-input-char) (setq com (key-binding (read-key-sequence nil)))) (condition-case conds (command-execute com) (error (vip-message-conditions conds))) ) (vip-hide-replace-overlay)) ;; This is the function bound to 'R'---unlimited replace. ;; Similar to Emacs's own overwrite-mode. (defun vip-overwrite (arg) "Begin overwrite mode." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg)) (len)) (vip-set-destructive-command (list 'vip-overwrite val ?r nil nil nil)) (if com (progn ;; Viper saves inserted text in vip-last-insertion (setq len (length vip-last-insertion)) (delete-char len) (vip-loop val (vip-yank-last-insertion))) (setq last-command 'vip-overwrite) (vip-set-complex-command-for-undo) (vip-set-replace-overlay (point) (vip-line-pos 'end)) (vip-change-state-to-replace) ))) ;; line commands (defun vip-line (arg) (let ((val (car arg)) (com (cdr arg))) (vip-move-marker-locally 'vip-com-point (point)) (if (not (eobp)) (vip-next-line-carefully (1- val))) ;; this ensures that dd, cc, D, yy will do the right thing on the last ;; line of buffer when this line has no \n. (vip-add-newline-at-eob-if-necessary) (vip-execute-com 'vip-line val com)) (if (and (eobp) (not (bobp))) (forward-line -1)) ) (defun vip-yank-line (arg) "Yank ARG lines (in Vi's sense)." (interactive "P") (let ((val (vip-p-val arg))) (vip-line (cons val ?Y)))) ;; region commands (defun vip-region (arg) "Execute command on a region." (interactive "P") (let ((val (vip-P-val arg)) (com (vip-getcom arg))) (vip-move-marker-locally 'vip-com-point (point)) (exchange-point-and-mark) (vip-execute-com 'vip-region val com))) (defun vip-Region (arg) "Execute command on a Region." (interactive "P") (let ((val (vip-P-val arg)) (com (vip-getCom arg))) (vip-move-marker-locally 'vip-com-point (point)) (exchange-point-and-mark) (vip-execute-com 'vip-Region val com))) (defun vip-replace-char (arg) "Replace the following ARG chars by the character read." (interactive "P") (if (and (eolp) (bolp)) (error "No character to replace here")) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (vip-replace-char-subr com val) (if (and (eolp) (not (bolp))) (forward-char 1)) (vip-set-destructive-command (list 'vip-replace-char val ?r nil vip-d-char nil)) )) (defun vip-replace-char-subr (com arg) (let ((take-care-of-iso-accents (and (boundp 'iso-accents-mode) vip-automatic-iso-accents)) char) (setq char (if (equal com ?r) vip-d-char (read-char))) (if (and take-care-of-iso-accents (memq char '(?' ?\" ?^ ?~))) ;; get European characters (progn (iso-accents-mode 1) (vip-set-unread-command-events char) (setq char (aref (read-key-sequence nil) 0)) (iso-accents-mode -1))) (delete-char arg t) (setq vip-d-char char) (vip-loop (if (> arg 0) arg (- arg)) (if (eq char ?\C-m) (insert "\n") (insert char))) (backward-char arg))) ;; basic cursor movement. j, k, l, h commands. (defun vip-forward-char (arg) "Move point right ARG characters (left if ARG negative). On reaching end of line, stop and signal error." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (if vip-ex-style-motion (progn ;; the boundary condition check gets weird here because ;; forward-char may be the parameter of a delete, and 'dl' works ;; just like 'x' for the last char on a line, so we have to allow ;; the forward motion before the 'vip-execute-com', but, of ;; course, 'dl' doesn't work on an empty line, so we have to ;; catch that condition before 'vip-execute-com' (if (and (eolp) (bolp)) (error "") (forward-char val)) (if com (vip-execute-com 'vip-forward-char val com)) (if (eolp) (progn (backward-char 1) (error "")))) (forward-char val) (if com (vip-execute-com 'vip-forward-char val com))))) (defun vip-backward-char (arg) "Move point left ARG characters (right if ARG negative). On reaching beginning of line, stop and signal error." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (if vip-ex-style-motion (progn (if (bolp) (error "") (backward-char val)) (if com (vip-execute-com 'vip-backward-char val com))) (backward-char val) (if com (vip-execute-com 'vip-backward-char val com))))) ;; Like forward-char, but doesn't move at end of buffer. (defun vip-forward-char-carefully (&optional arg) (setq arg (or arg 1)) (if (>= (point-max) (+ (point) arg)) (forward-char arg) (goto-char (point-max)))) ;; Like backward-char, but doesn't move at end of buffer. (defun vip-backward-char-carefully (&optional arg) (setq arg (or arg 1)) (if (<= (point-min) (- (point) arg)) (backward-char arg) (goto-char (point-min)))) (defun vip-next-line-carefully (arg) (condition-case nil (next-line arg) (error nil))) ;;; Word command ;; Words are formed from alpha's and nonalphas - ,\t\n are separators ;; for word movement. When executed with a destructive command, \n is ;; usually left untouched for the last word. ;; Viper uses syntax table to determine what is a word and what is a ;; separator. However, \n is always a separator. Also, if vip-syntax-preference ;; is 'vi, then `_' is part of the word. ;; skip only one \n (defun vip-skip-separators (forward) (if forward (progn (vip-skip-all-separators-forward 'within-line) (if (looking-at "\n") (progn (forward-char) (vip-skip-all-separators-forward 'within-line)))) (vip-skip-all-separators-backward 'within-line) (backward-char) (if (looking-at "\n") (vip-skip-all-separators-backward 'within-line) (forward-char)))) (defun vip-forward-word-kernel (val) (while (> val 0) (cond ((vip-looking-at-alpha) (vip-skip-alpha-forward "_") (vip-skip-separators t)) ((vip-looking-at-separator) (vip-skip-separators t)) ((not (vip-looking-at-alphasep)) (vip-skip-nonalphasep-forward) (vip-skip-separators t))) (setq val (1- val)))) ;; first search backward for pat. Then skip chars backwards using aux-pat (defun vip-fwd-skip (pat aux-pat lim) (if (and (save-excursion (re-search-backward pat lim t)) (= (point) (match-end 0))) (goto-char (match-beginning 0))) (skip-chars-backward aux-pat lim) (if (= (point) lim) (vip-forward-char-carefully)) ) (defun vip-forward-word (arg) "Forward word." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (vip-forward-word-kernel val) (if com (progn (cond ((memq com (list ?c (- ?c))) (vip-fwd-skip "\n[ \t]*" " \t" vip-com-point)) ;; Yank words including the whitespace, but not newline ((memq com (list ?y (- ?y))) (vip-fwd-skip "\n[ \t]*" "" vip-com-point)) ((vip-dotable-command-p com) (vip-fwd-skip "\n[ \t]*" "" vip-com-point))) (vip-execute-com 'vip-forward-word val com))))) (defun vip-forward-Word (arg) "Forward word delimited by white characters." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (vip-loop val (progn (vip-skip-nonseparators 'forward) (vip-skip-separators t))) (if com (progn (cond ((memq com (list ?c (- ?c))) (vip-fwd-skip "\n[ \t]*" " \t" vip-com-point)) ;; Yank words including the whitespace, but not newline ((memq com (list ?y (- ?y))) (vip-fwd-skip "\n[ \t]*" "" vip-com-point)) ((vip-dotable-command-p com) (vip-fwd-skip "\n[ \t]*" "" vip-com-point))) (vip-execute-com 'vip-forward-Word val com))))) ;; this is a bit different from Vi, but Vi's end of word ;; makes no sense whatsoever (defun vip-end-of-word-kernel () (if (vip-end-of-word-p) (forward-char)) (if (vip-looking-at-separator) (vip-skip-all-separators-forward)) (cond ((vip-looking-at-alpha) (vip-skip-alpha-forward "_")) ((not (vip-looking-at-alphasep)) (vip-skip-nonalphasep-forward))) (vip-backward-char-carefully)) (defun vip-end-of-word-p () (or (eobp) (save-excursion (cond ((vip-looking-at-alpha) (forward-char) (not (vip-looking-at-alpha))) ((not (vip-looking-at-alphasep)) (forward-char) (vip-looking-at-alphasep)))))) (defun vip-end-of-word (arg &optional careful) "Move point to end of current word." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (vip-loop val (vip-end-of-word-kernel)) (if com (progn (forward-char) (vip-execute-com 'vip-end-of-word val com))))) (defun vip-end-of-Word (arg) "Forward to end of word delimited by white character." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (vip-loop val (progn (vip-end-of-word-kernel) (vip-skip-nonseparators 'forward) (backward-char))) (if com (progn (forward-char) (vip-execute-com 'vip-end-of-Word val com))))) (defun vip-backward-word-kernel (val) (while (> val 0) (backward-char) (cond ((vip-looking-at-alpha) (vip-skip-alpha-backward "_")) ((vip-looking-at-separator) (forward-char) (vip-skip-separators nil) (backward-char) (cond ((vip-looking-at-alpha) (vip-skip-alpha-backward "_")) ((not (vip-looking-at-alphasep)) (vip-skip-nonalphasep-backward)) (t (forward-char)))) ((not (vip-looking-at-alphasep)) (vip-skip-nonalphasep-backward))) (setq val (1- val)))) (defun vip-backward-word (arg) "Backward word." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (let (i) (if (setq i (save-excursion (backward-char) (looking-at "\n"))) (backward-char)) (vip-move-marker-locally 'vip-com-point (point)) (if i (forward-char)))) (vip-backward-word-kernel val) (if com (vip-execute-com 'vip-backward-word val com)))) (defun vip-backward-Word (arg) "Backward word delimited by white character." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (let (i) (if (setq i (save-excursion (backward-char) (looking-at "\n"))) (backward-char)) (vip-move-marker-locally 'vip-com-point (point)) (if i (forward-char)))) (vip-loop val (progn (vip-skip-separators nil) (vip-skip-nonseparators 'backward))) (if com (vip-execute-com 'vip-backward-Word val com)))) ;; line commands (defun vip-beginning-of-line (arg) "Go to beginning of line." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (beginning-of-line val) (if com (vip-execute-com 'vip-beginning-of-line val com)))) (defun vip-bol-and-skip-white (arg) "Beginning of line at first non-white character." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (forward-to-indentation (1- val)) (if com (vip-execute-com 'vip-bol-and-skip-white val com)))) (defun vip-goto-eol (arg) "Go to end of line." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (end-of-line val) (if com (vip-execute-com 'vip-goto-eol val com)) (if vip-ex-style-motion (if (and (eolp) (not (bolp)) ;; a fix for vip-change-to-eol (not (equal vip-current-state 'insert-state))) (backward-char 1) )))) (defun vip-goto-col (arg) "Go to ARG's column." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (save-excursion (end-of-line) (if (> val (1+ (current-column))) (error ""))) (if com (vip-move-marker-locally 'vip-com-point (point))) (beginning-of-line) (forward-char (1- val)) (if com (vip-execute-com 'vip-goto-col val com)))) (defun vip-next-line (arg) "Go to next line." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (next-line val) (if vip-ex-style-motion (if (and (eolp) (not (bolp))) (backward-char 1))) (setq this-command 'next-line) (if com (vip-execute-com 'vip-next-line val com)))) (defun vip-next-line-at-bol (arg) "Next line at beginning of line." (interactive "P") (vip-leave-region-active) (save-excursion (end-of-line) (if (eobp) (error "Last line in buffer"))) (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (forward-line val) (back-to-indentation) (if com (vip-execute-com 'vip-next-line-at-bol val com)))) (defun vip-previous-line (arg) "Go to previous line." (interactive "P") (vip-leave-region-active) (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (previous-line val) (if vip-ex-style-motion (if (and (eolp) (not (bolp))) (backward-char 1))) (setq this-command 'previous-line) (if com (vip-execute-com 'vip-previous-line val com)))) (defun vip-previous-line-at-bol (arg) "Previous line at beginning of line." (interactive "P") (vip-leave-region-active) (save-excursion (beginning-of-line) (if (bobp) (error "First line in buffer"))) (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (forward-line (- val)) (back-to-indentation) (if com (vip-execute-com 'vip-previous-line val com)))) (defun vip-change-to-eol (arg) "Change to end of line." (interactive "P") (vip-goto-eol (cons arg ?c))) (defun vip-kill-line (arg) "Delete line." (interactive "P") (vip-goto-eol (cons arg ?d))) (defun vip-erase-line (arg) "Erase line." (interactive "P") (vip-beginning-of-line (cons arg ?d))) ;;; Moving around (defun vip-goto-line (arg) "Go to ARG's line. Without ARG go to end of buffer." (interactive "P") (let ((val (vip-P-val arg)) (com (vip-getCom arg))) (vip-move-marker-locally 'vip-com-point (point)) (vip-deactivate-mark) (push-mark nil t) (if (null val) (goto-char (point-max)) (goto-char (point-min)) (forward-line (1- val))) ;; positioning is done twice: before and after command execution (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) (back-to-indentation) (if com (vip-execute-com 'vip-goto-line val com)) (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) (back-to-indentation) )) ;; Find ARG's occurrence of CHAR on the current line. ;; If FORWARD then search is forward, otherwise backward. OFFSET is used to ;; adjust point after search. (defun vip-find-char (arg char forward offset) (or (char-or-string-p char) (error "")) (let ((arg (if forward arg (- arg))) (cmd (if (eq vip-intermediate-command 'vip-repeat) (nth 5 vip-d-com) (vip-array-to-string (this-command-keys)))) point) (save-excursion (save-restriction (if (> arg 0) (narrow-to-region ;; forward search begins here (if (eolp) (error "Command `%s': At end of line" cmd) (point)) ;; forward search ends here (progn (end-of-line) (point))) (narrow-to-region ;; backward search begins from here (if (bolp) (error "Command `%s': At beginning of line" cmd) (point)) ;; backward search ends here (progn (beginning-of-line) (point)))) ;; if arg > 0, point is forwarded before search. (if (> arg 0) (goto-char (1+ (point-min))) (goto-char (point-max))) (if (let ((case-fold-search nil)) (search-forward (char-to-string char) nil 0 arg)) (setq point (point)) (error "Command `%s': `%c' not found" cmd char)))) (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0)))))) (defun vip-find-char-forward (arg) "Find char on the line. If called interactively read the char to find from the terminal, and if called from vip-repeat, the char last used is used. This behaviour is controlled by the sign of prefix numeric value." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if (> val 0) ;; this means that the function was called interactively (setq vip-f-char (read-char) vip-f-forward t vip-f-offset nil) ;; vip-repeat --- set vip-F-char from command-keys (setq vip-F-char (if (stringp (nth 5 vip-d-com)) (vip-seq-last-elt (nth 5 vip-d-com)) vip-F-char) vip-f-char vip-F-char) (setq val (- val))) (if com (vip-move-marker-locally 'vip-com-point (point))) (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil) (setq val (- val)) (if com (progn (setq vip-F-char vip-f-char) ; set new vip-F-char (forward-char) (vip-execute-com 'vip-find-char-forward val com))))) (defun vip-goto-char-forward (arg) "Go up to char ARG forward on line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if (> val 0) ;; this means that the function was called interactively (setq vip-f-char (read-char) vip-f-forward t vip-f-offset t) ;; vip-repeat --- set vip-F-char from command-keys (setq vip-F-char (if (stringp (nth 5 vip-d-com)) (vip-seq-last-elt (nth 5 vip-d-com)) vip-F-char) vip-f-char vip-F-char) (setq val (- val))) (if com (vip-move-marker-locally 'vip-com-point (point))) (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t) (setq val (- val)) (if com (progn (setq vip-F-char vip-f-char) ; set new vip-F-char (forward-char) (vip-execute-com 'vip-goto-char-forward val com))))) (defun vip-find-char-backward (arg) "Find char ARG on line backward." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if (> val 0) ;; this means that the function was called interactively (setq vip-f-char (read-char) vip-f-forward nil vip-f-offset nil) ;; vip-repeat --- set vip-F-char from command-keys (setq vip-F-char (if (stringp (nth 5 vip-d-com)) (vip-seq-last-elt (nth 5 vip-d-com)) vip-F-char) vip-f-char vip-F-char) (setq val (- val))) (if com (vip-move-marker-locally 'vip-com-point (point))) (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil) (setq val (- val)) (if com (progn (setq vip-F-char vip-f-char) ; set new vip-F-char (vip-execute-com 'vip-find-char-backward val com))))) (defun vip-goto-char-backward (arg) "Go up to char ARG backward on line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if (> val 0) ;; this means that the function was called interactively (setq vip-f-char (read-char) vip-f-forward nil vip-f-offset t) ;; vip-repeat --- set vip-F-char from command-keys (setq vip-F-char (if (stringp (nth 5 vip-d-com)) (vip-seq-last-elt (nth 5 vip-d-com)) vip-F-char) vip-f-char vip-F-char) (setq val (- val))) (if com (vip-move-marker-locally 'vip-com-point (point))) (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t) (setq val (- val)) (if com (progn (setq vip-F-char vip-f-char) ; set new vip-F-char (vip-execute-com 'vip-goto-char-backward val com))))) (defun vip-repeat-find (arg) "Repeat previous find command." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (vip-deactivate-mark) (if com (vip-move-marker-locally 'vip-com-point (point))) (vip-find-char val vip-f-char vip-f-forward vip-f-offset) (if com (progn (if vip-f-forward (forward-char)) (vip-execute-com 'vip-repeat-find val com))))) (defun vip-repeat-find-opposite (arg) "Repeat previous find command in the opposite direction." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (vip-deactivate-mark) (if com (vip-move-marker-locally 'vip-com-point (point))) (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset) (if com (progn (if vip-f-forward (forward-char)) (vip-execute-com 'vip-repeat-find-opposite val com))))) ;; window scrolling etc. (defun vip-other-window (arg) "Switch to other window." (interactive "p") (other-window arg) (or (not (eq vip-current-state 'emacs-state)) (string= (buffer-name (current-buffer)) " *Minibuf-1*") (vip-change-state-to-vi))) (defun vip-window-top (arg) "Go to home window line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (push-mark nil t) (move-to-window-line (1- val)) ;; positioning is done twice: before and after command execution (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) (back-to-indentation) (if com (vip-execute-com 'vip-window-top val com)) (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) (back-to-indentation) )) (defun vip-window-middle (arg) "Go to middle window line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg)) lines) (if com (vip-move-marker-locally 'vip-com-point (point))) (push-mark nil t) (if (not (pos-visible-in-window-p (point-max))) (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val))) (setq lines (count-lines (window-start) (point-max))) (move-to-window-line (+ (/ lines 2) (1- val)))) ;; positioning is done twice: before and after command execution (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) (back-to-indentation) (if com (vip-execute-com 'vip-window-middle val com)) (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) (back-to-indentation) )) (defun vip-window-bottom (arg) "Go to last window line." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (push-mark nil t) (move-to-window-line (- val)) ;; positioning is done twice: before and after command execution (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) (back-to-indentation) (if com (vip-execute-com 'vip-window-bottom val com)) (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) (back-to-indentation) )) (defun vip-line-to-top (arg) "Put current line on the home line." (interactive "p") (recenter (1- arg))) (defun vip-line-to-middle (arg) "Put current line on the middle line." (interactive "p") (recenter (+ (1- arg) (/ (1- (window-height)) 2)))) (defun vip-line-to-bottom (arg) "Put current line on the last line." (interactive "p") (recenter (- (window-height) (1+ arg)))) ;; paren match ;; must correct this to only match ( to ) etc. On the other hand ;; it is good that paren match gets confused, because that way you ;; catch _all_ imbalances. (defun vip-paren-match (arg) "Go to the matching parenthesis." (interactive "P") (let ((com (vip-getcom arg))) (if (numberp arg) (if (or (> arg 99) (< arg 1)) (error "Prefix must be between 1 and 99") (goto-char (if (> (point-max) 80000) (* (/ (point-max) 100) arg) (/ (* (point-max) arg) 100))) (back-to-indentation)) (let (lim) (if (and (eolp) (not (bolp))) (forward-char -1)) (save-excursion (end-of-line) (setq lim (point))) (if (re-search-forward "[][(){}]" lim t) (backward-char) (error "No matching character on line"))) (cond ((looking-at "[\(\[{]") (if com (vip-move-marker-locally 'vip-com-point (point))) (forward-sexp 1) (if com (vip-execute-com 'vip-paren-match nil com) (backward-char))) ((looking-at "[])}]") (forward-char) (if com (vip-move-marker-locally 'vip-com-point (point))) (backward-sexp 1) (if com (vip-execute-com 'vip-paren-match nil com))) (t (error "")))))) ;; sentence ,paragraph and heading (defun vip-forward-sentence (arg) "Forward sentence." (interactive "P") (push-mark nil t) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (forward-sentence val) (if com (vip-execute-com 'vip-forward-sentence nil com)))) (defun vip-backward-sentence (arg) "Backward sentence." (interactive "P") (push-mark nil t) (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (backward-sentence val) (if com (vip-execute-com 'vip-backward-sentence nil com)))) (defun vip-forward-paragraph (arg) "Forward paragraph." (interactive "P") (push-mark nil t) (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (forward-paragraph val) (if com (vip-execute-com 'vip-forward-paragraph nil com)))) (defun vip-backward-paragraph (arg) "Backward paragraph." (interactive "P") (push-mark nil t) (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (backward-paragraph val) (if com (vip-execute-com 'vip-backward-paragraph nil com)))) ;; should be mode-specific etc. (defun vip-prev-heading (arg) (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (re-search-backward vip-heading-start nil t val) (goto-char (match-beginning 0)) (if com (vip-execute-com 'vip-prev-heading nil com)))) (defun vip-heading-end (arg) (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (re-search-forward vip-heading-end nil t val) (goto-char (match-beginning 0)) (if com (vip-execute-com 'vip-heading-end nil com)))) (defun vip-next-heading (arg) (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (end-of-line) (re-search-forward vip-heading-start nil t val) (goto-char (match-beginning 0)) (if com (vip-execute-com 'vip-next-heading nil com)))) ;; scrolling (setq scroll-step 1) (defun vip-scroll (arg) "Scroll to next screen." (interactive "p") (if (> arg 0) (while (> arg 0) (scroll-up) (setq arg (1- arg))) (while (> 0 arg) (scroll-down) (setq arg (1+ arg))))) (defun vip-scroll-back (arg) "Scroll to previous screen." (interactive "p") (vip-scroll (- arg))) (defun vip-scroll-down (arg) "Pull down half screen." (interactive "P") (condition-case nil (if (null arg) (scroll-down (/ (window-height) 2)) (scroll-down arg)) (error (beep 1) (message "Beginning of buffer") (goto-char (point-min))))) (defun vip-scroll-down-one (arg) "Scroll up one line." (interactive "p") (scroll-down arg)) (defun vip-scroll-up (arg) "Pull up half screen." (interactive "P") (condition-case nil (if (null arg) (scroll-up (/ (window-height) 2)) (scroll-up arg)) (error (beep 1) (message "End of buffer") (goto-char (point-max))))) (defun vip-scroll-up-one (arg) "Scroll down one line." (interactive "p") (scroll-up arg)) ;; searching (defun vip-if-string (prompt) (let ((s (vip-read-string-with-history prompt nil ; no initial 'vip-search-history (car vip-search-history)))) (if (not (string= s "")) (setq vip-s-string s)))) (defun vip-toggle-search-style (arg) "Toggle the value of vip-case-fold-search/vip-re-search. Without prefix argument, will ask which search style to toggle. With prefix arg 1,toggles vip-case-fold-search; with arg 2 toggles vip-re-search. Although this function is bound to \\[vip-toggle-search-style], the most convenient way to use it is to bind `//' to the macro `1 M-x vip-toggle-search-style' and `///' to `2 M-x vip-toggle-search-style'. In this way, hitting `//' quickly will toggle case-fold-search and hitting `/' three times witth toggle regexp search. Macros are more convenient in this case because they don't affect the Emacs binding of `/'." (interactive "P") (let (msg) (cond ((or (eq arg 1) (and (null arg) (y-or-n-p (format "Search style: '%s'. Want '%s'? " (if vip-case-fold-search "case-insensitive" "case-sensitive") (if vip-case-fold-search "case-sensitive" "case-insensitive"))))) (setq vip-case-fold-search (null vip-case-fold-search)) (if vip-case-fold-search (setq msg "Search becomes case-insensitive") (setq msg "Search becomes case-sensitive"))) ((or (eq arg 2) (and (null arg) (y-or-n-p (format "Search style: '%s'. Want '%s'? " (if vip-re-search "regexp-search" "vanilla-search") (if vip-re-search "vanilla-search" "regexp-search"))))) (setq vip-re-search (null vip-re-search)) (if vip-re-search (setq msg "Search becomes regexp-style") (setq msg "Search becomes vanilla-style"))) (t (setq msg "Search style remains unchanged"))) (prin1 msg t))) (defun vip-search-forward (arg) "Search a string forward. ARG is used to find the ARG's occurrence of the string. Null string will repeat previous search." (interactive "P") (let ((val (vip-P-val arg)) (com (vip-getcom arg)) (old-str vip-s-string)) (setq vip-s-forward t) (vip-if-string "/") ;; this is not used at present, but may be used later (if (or (not (equal old-str vip-s-string)) (not (markerp vip-local-search-start-marker)) (not (marker-buffer vip-local-search-start-marker))) (setq vip-local-search-start-marker (point-marker))) (vip-search vip-s-string t val) (if com (progn (vip-move-marker-locally 'vip-com-point (mark t)) (vip-execute-com 'vip-search-next val com))))) (defun vip-search-backward (arg) "Search a string backward. ARG is used to find the ARG's occurrence of the string. Null string will repeat previous search." (interactive "P") (let ((val (vip-P-val arg)) (com (vip-getcom arg)) (old-str vip-s-string)) (setq vip-s-forward nil) (vip-if-string "?") ;; this is not used at present, but may be used later (if (or (not (equal old-str vip-s-string)) (not (markerp vip-local-search-start-marker)) (not (marker-buffer vip-local-search-start-marker))) (setq vip-local-search-start-marker (point-marker))) (vip-search vip-s-string nil val) (if com (progn (vip-move-marker-locally 'vip-com-point (mark t)) (vip-execute-com 'vip-search-next val com))))) ;; Search for COUNT's occurrence of STRING. ;; Search is forward if FORWARD is non-nil, otherwise backward. ;; INIT-POINT is the position where search is to start. ;; Arguments: ;; (STRING FORW COUNT &optional NO-OFFSET INIT-POINT LIMIT FAIL-IF-NOT-FOUND) (defun vip-search (string forward arg &optional no-offset init-point fail-if-not-found) (if (not (equal string "")) (let ((val (vip-p-val arg)) (com (vip-getcom arg)) (offset (not no-offset)) (case-fold-search vip-case-fold-search) (start-point (or init-point (point)))) (vip-deactivate-mark) (if forward (condition-case nil (progn (if offset (vip-forward-char-carefully)) (if vip-re-search (progn (re-search-forward string nil nil val) (re-search-backward string)) (search-forward string nil nil val) (search-backward string)) ;; don't wait and don't flash in macros (or executing-kbd-macro (vip-flash-search-pattern)) (if (not (equal start-point (point))) (push-mark start-point t))) (search-failed (if (and (not fail-if-not-found) vip-search-wrap-around-t) (progn (message "Search wrapped around end of buffer") (goto-char (point-min)) (vip-search string forward (cons 1 com) t start-point 'fail) ;; don't wait in macros (or executing-kbd-macro (sit-for 2)) ;; delete the wrap-around message (message "") ) (goto-char start-point) (error "`%s': %s not found" string (if vip-re-search "Pattern" "String")) ))) ;; backward (condition-case nil (progn (if vip-re-search (re-search-backward string nil nil val) (search-backward string nil nil val)) ;; don't wait and don't flash in macros (or executing-kbd-macro (vip-flash-search-pattern)) (if (not (equal start-point (point))) (push-mark start-point t))) (search-failed (if (and (not fail-if-not-found) vip-search-wrap-around-t) (progn (message "Search wrapped around beginning of buffer") (goto-char (point-max)) (vip-search string forward (cons 1 com) t start-point 'fail) ;; don't wait in macros (or executing-kbd-macro (sit-for 2)) ;; delete the wrap-around message (message "") ) (goto-char start-point) (error "`%s': %s not found" string (if vip-re-search "Pattern" "String")) ))))))) (defun vip-search-next (arg) "Repeat previous search." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if (null vip-s-string) (error vip-NoPrevSearch)) (vip-search vip-s-string vip-s-forward arg) (if com (progn (vip-move-marker-locally 'vip-com-point (mark t)) (vip-execute-com 'vip-search-next val com))))) (defun vip-search-Next (arg) "Repeat previous search in the reverse direction." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if (null vip-s-string) (error vip-NoPrevSearch)) (vip-search vip-s-string (not vip-s-forward) arg) (if com (progn (vip-move-marker-locally 'vip-com-point (mark t)) (vip-execute-com 'vip-search-Next val com))))) ;; Search contents of buffer defined by one of Viper's motion commands. ;; Repeatable via `n' and `N'. (defun vip-buffer-search-enable (&optional c) (cond (c (setq vip-buffer-search-char c)) ((null vip-buffer-search-char) (setq vip-buffer-search-char ?g))) (define-key vip-vi-basic-map (char-to-string vip-buffer-search-char) 'vip-command-argument) (aset vip-exec-array vip-buffer-search-char 'vip-exec-buffer-search) (setq vip-prefix-commands (cons vip-buffer-search-char vip-prefix-commands))) ;; This is a Viper wraper for isearch-forward. (defun vip-isearch-forward (arg) "Do incremental search forward." (interactive "P") ;; emacs bug workaround (if (listp arg) (setq arg (car arg))) (vip-exec-form-in-emacs (list 'isearch-forward arg))) ;; This is a Viper wraper for isearch-backward." (defun vip-isearch-backward (arg) "Do incremental search backward." (interactive "P") ;; emacs bug workaround (if (listp arg) (setq arg (car arg))) (vip-exec-form-in-emacs (list 'isearch-backward arg))) ;; visiting and killing files, buffers (defun vip-switch-to-buffer () "Switch to buffer in the current window." (interactive) (let (buffer) (setq buffer (read-buffer (format "Switch to buffer in this window \(%s\): " (buffer-name (other-buffer (current-buffer)))))) (switch-to-buffer buffer) )) (defun vip-switch-to-buffer-other-window () "Switch to buffer in another window." (interactive) (let (buffer) (setq buffer (read-buffer (format "Switch to buffer in another window \(%s\): " (buffer-name (other-buffer (current-buffer)))))) (switch-to-buffer-other-window buffer) )) (defun vip-kill-buffer () "Kill a buffer." (interactive) (let (buffer buffer-name) (setq buffer-name (read-buffer (format "Kill buffer \(%s\): " (buffer-name (current-buffer))))) (setq buffer (if (null buffer-name) (current-buffer) (get-buffer buffer-name))) (if (null buffer) (error "`%s': No such buffer" buffer-name)) (if (or (not (buffer-modified-p buffer)) (y-or-n-p (format "Buffer `%s' is modified, are you sure you want to kill it? " buffer-name))) (kill-buffer buffer) (error "Buffer not killed")))) (defvar vip-smart-suffix-list '("" "tex" "c" "cc" "el" "p") "*List of suffixes that Viper automatically tries to append to filenames ending with a `.'. This is useful when you the current directory contains files with the same prefix and many different suffixes. Usually, only one of the suffixes represents an editable file. However, file completion will stop at the `.' The smart suffix feature lets you hit RET in such a case, and Viper will select the appropriate suffix. Suffixes are tried in the order given and the first suffix for which a corresponding file exists is selected. If no file exists for any of the suffixes, the user is asked to confirm. To turn this feature off, set this variable to nil.") ;; Try to add suffix to files ending with a `.' ;; Useful when the user hits RET on a non-completed file name. (defun vip-file-add-suffix () (let ((count 0) (len (length vip-smart-suffix-list)) (file (buffer-string)) found key cmd suff) (goto-char (point-max)) (if (and vip-smart-suffix-list (string-match "\\.$" file)) (progn (while (and (not found) (< count len)) (setq suff (nth count vip-smart-suffix-list) count (1+ count)) (if (file-exists-p (format "%s%s" file suff)) (progn (setq found t) (insert suff)))) (if found () (vip-tmp-insert-at-eob " [Please complete file name]") (unwind-protect (while (not (memq cmd '(exit-minibuffer vip-exit-minibuffer))) (setq cmd (key-binding (setq key (read-key-sequence nil)))) (cond ((eq cmd 'self-insert-command) (if vip-xemacs-p (insert (events-to-keys key)) (insert key))) ((memq cmd '(exit-minibuffer vip-exit-minibuffer)) nil) (t (command-execute cmd))) ))) )) )) ;; Advice for use in find-file and read-file-name commands. (defadvice exit-minibuffer (before vip-exit-minibuffer-advice activate) "Run `vip-minibuffer-exit-hook' just before exiting the minibuffer." (run-hooks 'vip-minibuffer-exit-hook)) (defadvice find-file (before vip-add-suffix-advice activate) "Use `read-file-name' for reading arguments." (interactive (list (read-file-name "Find file: " nil default-directory)))) (defadvice find-file-other-window (before vip-add-suffix-advice activate) "Use `read-file-name' for reading arguments." (interactive (list (read-file-name "Find file in other window: " nil default-directory)))) (defadvice find-file-other-frame (before vip-add-suffix-advice activate) "Use `read-file-name' for reading arguments." (interactive (list (read-file-name "Find file in other frame: " nil default-directory)))) (defadvice read-file-name (around vip-suffix-advice activate) "Tell `exit-minibuffer' to run `vip-file-add-suffix' as a hook." (let ((vip-minibuffer-exit-hook 'vip-file-add-suffix)) ad-do-it)) ;; yank and pop (defsubst vip-yank (text) "Yank TEXT silently. This works correctly with Emacs's yank-pop command." (insert text) (setq this-command 'yank)) (defun vip-put-back (arg) "Put back after point/below line." (interactive "P") (let ((val (vip-p-val arg)) (text (if vip-use-register (cond ((vip-valid-register vip-use-register '(digit)) (current-kill (- vip-use-register ?1) 'do-not-rotate)) ((vip-valid-register vip-use-register) (get-register (downcase vip-use-register))) (t (error vip-InvalidRegister vip-use-register))) (current-kill 0)))) (if (null text) (if vip-use-register (let ((reg vip-use-register)) (setq vip-use-register nil) (error vip-EmptyRegister reg)) (error ""))) (setq vip-use-register nil) (if (vip-end-with-a-newline-p text) (progn (if (eobp) (insert "\n") (forward-line 1)) (beginning-of-line)) (if (not (eolp)) (vip-forward-char-carefully))) (set-marker (vip-mark-marker) (point) (current-buffer)) (vip-set-destructive-command (list 'vip-put-back val nil vip-use-register nil nil)) (vip-loop val (vip-yank text))) ;; Vi puts cursor on the last char when the yanked text doesn't contain a ;; newline; it leaves the cursor at the beginning when the text contains ;; a newline (if (vip-same-line (point) (mark)) (or (= (point) (mark)) (vip-backward-char-carefully)) (exchange-point-and-mark) (if (bolp) (back-to-indentation))) (vip-deactivate-mark)) (defun vip-Put-back (arg) "Put back at point/above line." (interactive "P") (let ((val (vip-p-val arg)) (text (if vip-use-register (cond ((vip-valid-register vip-use-register '(digit)) (current-kill (- vip-use-register ?1) 'do-not-rotate)) ((vip-valid-register vip-use-register) (get-register (downcase vip-use-register))) (t (error vip-InvalidRegister vip-use-register))) (current-kill 0)))) (if (null text) (if vip-use-register (let ((reg vip-use-register)) (setq vip-use-register nil) (error vip-EmptyRegister reg)) (error ""))) (setq vip-use-register nil) (if (vip-end-with-a-newline-p text) (beginning-of-line)) (vip-set-destructive-command (list 'vip-Put-back val nil vip-use-register nil nil)) (set-marker (vip-mark-marker) (point) (current-buffer)) (vip-loop val (vip-yank text))) ;; Vi puts cursor on the last char when the yanked text doesn't contain a ;; newline; it leaves the cursor at the beginning when the text contains ;; a newline (if (vip-same-line (point) (mark)) (or (= (point) (mark)) (vip-backward-char-carefully)) (exchange-point-and-mark) (if (bolp) (back-to-indentation))) (vip-deactivate-mark)) ;; Copy region to kill-ring. ;; If BEG and END do not belong to the same buffer, copy empty region. (defun vip-copy-region-as-kill (beg end) (condition-case nil (copy-region-as-kill beg end) (error (copy-region-as-kill beg beg)))) ;; Saves last inserted text for possible use by vip-repeat command. (defun vip-save-last-insertion (beg end) (setq vip-last-insertion (buffer-substring beg end)) (or (< (length vip-d-com) 5) (setcar (nthcdr 4 vip-d-com) vip-last-insertion)) (or (null vip-command-ring) (ring-empty-p vip-command-ring) (progn (setcar (nthcdr 4 (vip-current-ring-item vip-command-ring)) vip-last-insertion) ;; del most recent elt, if identical to the second most-recent (vip-cleanup-ring vip-command-ring))) ) (defsubst vip-yank-last-insertion () "Inserts the text saved by the previous vip-save-last-insertion command." (condition-case nil (insert vip-last-insertion) (error nil))) (defun vip-delete-char (arg) "Delete character." (interactive "P") (let ((val (vip-p-val arg))) (vip-set-destructive-command (list 'vip-delete-char val nil nil nil nil)) (if (> val 1) (save-excursion (let ((here (point))) (end-of-line) (if (> val (- (point) here)) (setq val (- (point) here)))))) (if (and (eq val 0) (not vip-ex-style-motion)) (setq val 1)) (if (and vip-ex-style-motion (eolp)) (if (bolp) (error "") (setq val 0))) ; not bol---simply back 1 ch (if vip-use-register (progn (cond ((vip-valid-register vip-use-register '((Letter))) (vip-append-to-register (downcase vip-use-register) (point) (- (point) val))) ((vip-valid-register vip-use-register) (copy-to-register vip-use-register (point) (- (point) val) nil)) (t (error vip-InvalidRegister vip-use-register))) (setq vip-use-register nil))) (if vip-ex-style-motion (progn (delete-char val t) (if (and (eolp) (not (bolp))) (backward-char 1))) (if (eolp) (delete-backward-char val t) (delete-char val t))))) (defun vip-delete-backward-char (arg) "Delete previous character. On reaching beginning of line, stop and beep." (interactive "P") (let ((val (vip-p-val arg))) (vip-set-destructive-command (list 'vip-delete-backward-char val nil nil nil nil)) (if (> val 1) (save-excursion (let ((here (point))) (beginning-of-line) (if (> val (- here (point))) (setq val (- here (point))))))) (if vip-use-register (progn (cond ((vip-valid-register vip-use-register '(Letter)) (vip-append-to-register (downcase vip-use-register) (point) (+ (point) val))) ((vip-valid-register vip-use-register) (copy-to-register vip-use-register (point) (+ (point) val) nil)) (t (error vip-InvalidRegister vip-use-register))) (setq vip-use-register nil))) (if (bolp) (ding) (delete-backward-char val t)))) (defun vip-del-backward-char-in-insert () "Delete 1 char backwards while in insert mode." (interactive) (if (and vip-ex-style-editing-in-insert (bolp)) (beep 1) (delete-backward-char 1 t))) (defun vip-del-backward-char-in-replace () "Delete one character in replace mode. If `vip-delete-backwards-in-replace' is t, then DEL key actually deletes charecters. If it is nil, then the cursor just moves backwards, similarly to Vi. The variable `vip-ex-style-editing-in-insert', if t, doesn't let the cursor move past the beginning of line." (interactive) (cond (vip-delete-backwards-in-replace (cond ((not (bolp)) (delete-backward-char 1 t)) (vip-ex-style-editing-in-insert (beep 1)) ((bobp) (beep 1)) (t (delete-backward-char 1 t)))) (vip-ex-style-editing-in-insert (if (bolp) (beep 1) (backward-char 1))) (t (backward-char 1)))) ;; join lines. (defun vip-join-lines (arg) "Join this line to next, if ARG is nil. Otherwise, join ARG lines." (interactive "*P") (let ((val (vip-P-val arg))) (vip-set-destructive-command (list 'vip-join-lines val nil nil nil nil)) (vip-loop (if (null val) 1 (1- val)) (progn (end-of-line) (if (not (eobp)) (progn (forward-line 1) (delete-region (point) (1- (point))) (fixup-whitespace))))))) ;; Replace state (defun vip-change (beg end) (if (markerp beg) (setq beg (marker-position beg))) (if (markerp end) (setq end (marker-position end))) ;; beg is sometimes (mark t), which may be nil (or beg (setq beg end)) (vip-set-complex-command-for-undo) (if vip-use-register (progn (copy-to-register vip-use-register beg end nil) (setq vip-use-register nil))) (vip-set-replace-overlay beg end) (setq last-command nil) ; separate repl text from prev kills (if (= (vip-replace-start) (point-max)) (error "End of buffer")) (setq vip-last-replace-region (buffer-substring (vip-replace-start) (vip-replace-end))) ;; protect against error while inserting "@" and other disasters ;; (e.g., read-only buff) (condition-case conds (if (vip-same-line (vip-replace-start) (vip-replace-end)) (progn ;; tabs cause problems in replace, so untabify (goto-char (vip-replace-end)) (insert-before-markers "@") ; put placeholder after the TAB (untabify (vip-replace-start) (point)) ;; del @, don't put on kill ring (delete-backward-char 1) (vip-set-replace-overlay-glyphs vip-replace-region-start-delimiter vip-replace-region-end-delimiter) ;; this move takes care of the last posn in the overlay, which ;; has to be shifted because of insert. We can't simply insert ;; "$" before-markers because then overlay-start will shift the ;; beginning of the overlay in case we are replacing a single ;; character. This fixes the bug with `s' and `cl' commands. (vip-move-replace-overlay (vip-replace-start) (point)) (goto-char (vip-replace-start)) (vip-change-state-to-replace t)) (kill-region (vip-replace-start) (vip-replace-end)) (vip-restore-cursor-color) (vip-change-state-to-insert)) (error ;; make sure that the overlay doesn't stay. ;; go back to the original point (goto-char (vip-replace-start)) (vip-hide-replace-overlay) (vip-message-conditions conds)))) (defun vip-change-subr (beg end) ;; beg is sometimes (mark t), which may be nil (or beg (setq beg end)) (if vip-use-register (progn (copy-to-register vip-use-register beg end nil) (setq vip-use-register nil))) (kill-region beg end) (setq this-command 'vip-change) (vip-yank-last-insertion)) (defun vip-toggle-case (arg) "Toggle character case." (interactive "P") (let ((val (vip-p-val arg)) (c)) (vip-set-destructive-command (list 'vip-toggle-case val nil nil nil nil)) (while (> val 0) (setq c (following-char)) (delete-char 1 nil) (if (eq c (upcase c)) (insert-char (downcase c) 1) (insert-char (upcase c) 1)) (if (eolp) (backward-char 1)) (setq val (1- val))))) ;; query replace (defun vip-query-replace () "Query replace. If a null string is suplied as the string to be replaced, the query replace mode will toggle between string replace and regexp replace." (interactive) (let (str) (setq str (vip-read-string-with-history (if vip-re-query-replace "Query replace regexp: " "Query replace: ") nil ; no initial 'vip-replace1-history (car vip-replace1-history) ; default )) (if (string= str "") (progn (setq vip-re-query-replace (not vip-re-query-replace)) (message "Query replace mode changed to %s" (if vip-re-query-replace "regexp replace" "string replace"))) (if vip-re-query-replace (query-replace-regexp str (vip-read-string-with-history (format "Query replace regexp `%s' with: " str) nil ; no initial 'vip-replace1-history (car vip-replace1-history) ; default )) (query-replace str (vip-read-string-with-history (format "Query replace `%s' with: " str) nil ; no initial 'vip-replace1-history (car vip-replace1-history) ; default )))))) ;; marking (defun vip-mark-beginning-of-buffer () "Mark beginning of buffer." (interactive) (push-mark (point)) (goto-char (point-min)) (exchange-point-and-mark) (message "Mark set at the beginning of buffer")) (defun vip-mark-end-of-buffer () "Mark end of buffer." (interactive) (push-mark (point)) (goto-char (point-max)) (exchange-point-and-mark) (message "Mark set at the end of buffer")) (defun vip-mark-point () "Set mark at point of buffer." (interactive) (let ((char (vip-read-char-exclusive))) (cond ((and (<= ?a char) (<= char ?z)) (point-to-register (1+ (- char ?a)))) ((= char ?<) (vip-mark-beginning-of-buffer)) ((= char ?>) (vip-mark-end-of-buffer)) ((= char ?.) (vip-set-mark-if-necessary)) ((= char ?,) (vip-cycle-through-mark-ring)) ((= char ?D) (mark-defun)) (t (error "")) ))) ;; Algorithm: If first invocation of this command save mark on ring, goto ;; mark, M0, and pop the most recent elt from the mark ring into mark, ;; making it into the new mark, M1. ;; Push this mark back and set mark to the original point position, p1. ;; So, if you hit '' or `` then you can return to p1. ;; ;; If repeated command, pop top elt from the ring into mark and ;; jump there. This forgets the position, p1, and puts M1 back into mark. ;; Then we save the current pos, which is M0, jump to M1 and pop M2 from ;; the ring into mark. Push M2 back on the ring and set mark to M0. ;; etc. (defun vip-cycle-through-mark-ring () "Visit previous locations on the mark ring. One can use `` and '' to temporarily jump 1 step back." (let* ((sv-pt (point))) ;; if repeated `m,' command, pop the previously saved mark. ;; Prev saved mark is actually prev saved point. It is used if the ;; user types `` or '' and is discarded ;; from the mark ring by the next `m,' command. ;; In any case, go to the previous or previously saved mark. ;; Then push the current mark (popped off the ring) and set current ;; point to be the mark. Current pt as mark is discarded by the next ;; m, command. (if (eq last-command 'vip-cycle-through-mark-ring) () ;; save current mark if the first iteration (setq mark-ring (delete (vip-mark-marker) mark-ring)) (if (mark t) (push-mark (mark t) t)) ) (pop-mark) (set-mark-command 1) ;; don't duplicate mark on the ring (setq mark-ring (delete (vip-mark-marker) mark-ring)) (push-mark sv-pt t) (vip-deactivate-mark) (setq this-command 'vip-cycle-through-mark-ring) )) (defun vip-goto-mark (arg) "Go to mark." (interactive "P") (let ((char (read-char)) (com (vip-getcom arg))) (vip-goto-mark-subr char com nil))) (defun vip-goto-mark-and-skip-white (arg) "Go to mark and skip to first non-white character on line." (interactive "P") (let ((char (read-char)) (com (vip-getCom arg))) (vip-goto-mark-subr char com t))) (defun vip-goto-mark-subr (char com skip-white) (if (eobp) (if (bobp) (error "Empty buffer") (backward-char 1))) (cond ((vip-valid-register char '(letter)) (let* ((buff (current-buffer)) (reg (1+ (- char ?a))) (text-marker (get-register reg))) (if com (vip-move-marker-locally 'vip-com-point (point))) (if (not (vip-valid-marker text-marker)) (error (format vip-EmptyTextmarker char))) (if (and (vip-same-line (point) vip-last-jump) (= (point) vip-last-jump-ignore)) (push-mark vip-last-jump t) (push-mark nil t)) ; no msg (vip-register-to-point reg) (setq vip-last-jump (point-marker)) (cond (skip-white (back-to-indentation) (setq vip-last-jump-ignore (point)))) (if com (if (equal buff (current-buffer)) (vip-execute-com (if skip-white 'vip-goto-mark-and-skip-white 'vip-goto-mark) nil com) (switch-to-buffer buff) (goto-char vip-com-point) (vip-change-state-to-vi) (error ""))))) ((and (not skip-white) (= char ?`)) (if com (vip-move-marker-locally 'vip-com-point (point))) (if (and (vip-same-line (point) vip-last-jump) (= (point) vip-last-jump-ignore)) (goto-char vip-last-jump)) (if (= (point) (mark t)) (pop-mark)) (exchange-point-and-mark) (setq vip-last-jump (point-marker) vip-last-jump-ignore 0) (if com (vip-execute-com 'vip-goto-mark nil com))) ((and skip-white (= char ?')) (if com (vip-move-marker-locally 'vip-com-point (point))) (if (and (vip-same-line (point) vip-last-jump) (= (point) vip-last-jump-ignore)) (goto-char vip-last-jump)) (if (= (point) (mark t)) (pop-mark)) (exchange-point-and-mark) (setq vip-last-jump (point)) (back-to-indentation) (setq vip-last-jump-ignore (point)) (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com))) (t (error vip-InvalidTextmarker char)))) (defun vip-insert-tab () (interactive) (insert-tab)) (defun vip-exchange-point-and-mark () (interactive) (exchange-point-and-mark) (back-to-indentation)) ;; Input Mode Indentation (defun vip-forward-indent () "Indent forward -- `C-t' in Vi." (interactive) (setq vip-cted t) (indent-to (+ (current-column) vip-shift-width))) (defun vip-backward-indent () "Backtab, C-d in VI" (interactive) (if vip-cted (let ((p (point)) (c (current-column)) bol (indent t)) (if (vip-looking-back "[0^]") (progn (if (= ?^ (preceding-char)) (setq vip-preserve-indent t)) (delete-backward-char 1) (setq p (point)) (setq indent nil))) (save-excursion (beginning-of-line) (setq bol (point))) (if (re-search-backward "[^ \t]" bol 1) (forward-char)) (delete-region (point) p) (if indent (indent-to (- c vip-shift-width))) (if (or (bolp) (vip-looking-back "[^ \t]")) (setq vip-cted nil))))) (defun vip-autoindent () "Auto Indentation, Vi-style." (interactive) (let ((col (current-indentation))) (if (not vip-preserve-indent) (setq vip-current-indent col) (setq vip-preserve-indent nil)) ;; don't leave whitespace lines around (if (memq last-command '(vip-autoindent vip-open-line vip-Open-line vip-replace-state-exit-cmd)) (indent-to-left-margin)) (newline 1) (if vip-auto-indent (progn (setq vip-cted t) (indent-to vip-current-indent))))) ;; Viewing registers (defun vip-ket-function (arg) "Function called by \], the ket. View registers and call \]\]." (interactive "P") (let ((reg (read-char))) (cond ((vip-valid-register reg '(letter Letter)) (view-register (downcase reg))) ((vip-valid-register reg '(digit)) (let ((text (current-kill (- reg ?1) 'do-not-rotate))) (save-excursion (set-buffer (get-buffer-create "*Output*")) (delete-region (point-min) (point-max)) (insert (format "Register %c contains the string:\n" reg)) (insert text) (goto-char (point-min))) (display-buffer "*Output*"))) ((= ?\] reg) (vip-next-heading arg)) (t (error vip-InvalidRegister reg))))) (defun vip-brac-function (arg) "Function called by \[, the brac. View textmarkers and call \[\[" (interactive "P") (let ((reg (read-char))) (cond ((= ?\[ reg) (vip-prev-heading arg)) ((= ?\] reg) (vip-heading-end arg)) ((vip-valid-register reg '(letter)) (let* ((val (get-register (1+ (- reg ?a)))) (buf (if (not val) (error (format vip-EmptyTextmarker reg)) (marker-buffer val))) (pos (marker-position val)) line-no text (s pos) (e pos)) (save-excursion (set-buffer (get-buffer-create "*Output*")) (delete-region (point-min) (point-max)) (if (and buf pos) (progn (save-excursion (set-buffer buf) (setq line-no (1+ (count-lines (point-min) val))) (goto-char pos) (beginning-of-line) (if (re-search-backward "[^ \t]" nil t) (progn (beginning-of-line) (setq s (point)))) (goto-char pos) (forward-line 1) (if (re-search-forward "[^ \t]" nil t) (progn (end-of-line) (setq e (point)))) (setq text (buffer-substring s e)) (setq text (format "%s<%c>%s" (substring text 0 (- pos s)) reg (substring text (- pos s))))) (insert (format "Textmarker `%c' is in buffer `%s' at line %d.\n" reg (buffer-name buf) line-no)) (insert (format "Here is some text around %c:\n\n %s" reg text))) (insert (format vip-EmptyTextmarker reg))) (goto-char (point-min))) (display-buffer "*Output*"))) (t (error vip-InvalidTextmarker reg))))) ;; commands in insertion mode (defun vip-delete-backward-word (arg) "Delete previous word." (interactive "p") (save-excursion (push-mark nil t) (backward-word arg) (delete-region (point) (mark t)) (pop-mark))) (defun vip-set-expert-level (&optional dont-change-unless) "Sets the expert level for a Viper user. Can be called interactively to change (temporarily or permanently) the current expert level. The optional argument DONT-CHANGE-UNLESS if not nil, says that the level should not be changed, unless its current value is meaningless (i.e., not one of 1,2,3,4,5). User level determines the setting of Viper variables that are most sensitive for VI-style look-and-feel." (interactive) (if (not (numberp vip-expert-level)) (setq vip-expert-level 0)) (save-window-excursion (delete-other-windows) ;; if 0 < vip-expert-level < vip-max-expert-level ;; & dont-change-unless = t -- use it; else ask (vip-ask-level dont-change-unless)) (setq vip-always t vip-ex-style-motion t vip-ex-style-editing-in-insert t vip-want-ctl-h-help nil) (cond ;; a novice or a beginner ((eq vip-expert-level 1) (global-set-key vip-toggle-key ;; in emacs-state (if (vip-window-display-p) 'vip-iconify 'suspend-emacs)) (setq vip-no-multiple-ESC t vip-re-search t vip-vi-style-in-minibuffer t vip-search-wrap-around-t t vip-want-emacs-keys-in-vi nil vip-want-emacs-keys-in-insert nil)) ;; an intermediate to guru ((and (> vip-expert-level 1) (< vip-expert-level 5)) (setq vip-no-multiple-ESC (if (vip-window-display-p) t 'twice) vip-want-emacs-keys-in-vi t vip-want-emacs-keys-in-insert (> vip-expert-level 2)) (if (eq vip-expert-level 4) ; respect user's ex-style motions ; and vip-no-multiple-ESC (progn (setq-default vip-ex-style-editing-in-insert (cdr (assoc 'vip-ex-style-editing-in-insert vip-saved-user-settings)) vip-ex-style-motion (cdr (assoc 'vip-ex-style-motion vip-saved-user-settings))) (setq vip-ex-style-motion (cdr (assoc 'vip-ex-style-motion vip-saved-user-settings)) vip-ex-style-editing-in-insert (cdr (assoc 'vip-ex-style-editing-in-insert vip-saved-user-settings)) vip-re-search (cdr (assoc 'vip-re-search vip-saved-user-settings)) vip-no-multiple-ESC (cdr (assoc 'vip-no-multiple-ESC vip-saved-user-settings)))))) ;; A wizard ;; Ideally, if 5 is selected, a buffer should pop up to let the ;; user toggle variable values. (t (setq-default vip-ex-style-editing-in-insert (cdr (assoc 'vip-ex-style-editing-in-insert vip-saved-user-settings)) vip-ex-style-motion (cdr (assoc 'vip-ex-style-motion vip-saved-user-settings))) (setq vip-want-ctl-h-help (cdr (assoc 'vip-want-ctl-h-help vip-saved-user-settings)) vip-always (cdr (assoc 'vip-always vip-saved-user-settings)) vip-no-multiple-ESC (cdr (assoc 'vip-no-multiple-ESC vip-saved-user-settings)) vip-ex-style-motion (cdr (assoc 'vip-ex-style-motion vip-saved-user-settings)) vip-ex-style-editing-in-insert (cdr (assoc 'vip-ex-style-editing-in-insert vip-saved-user-settings)) vip-re-search (cdr (assoc 'vip-re-search vip-saved-user-settings)) vip-want-emacs-keys-in-vi (cdr (assoc 'vip-want-emacs-keys-in-vi vip-saved-user-settings)) vip-want-emacs-keys-in-insert (cdr (assoc 'vip-want-emacs-keys-in-insert vip-saved-user-settings))))) (vip-set-mode-vars-for vip-current-state) (if (or vip-always (and (> vip-expert-level 0) (> 5 vip-expert-level))) (vip-set-hooks))) ;; Ask user expert level. (defun vip-ask-level (dont-change-unless) (let ((ask-buffer " *vip-ask-level*") level-changed repeated) (save-window-excursion (switch-to-buffer ask-buffer) (or (eq this-command 'vip-set-expert-level) (and (<= vip-expert-level vip-max-expert-level) (>= vip-expert-level 1)) (progn (insert " *** Important Notice for VIP users*** This is VIPER @joke Viper Is a Package for Emacs Rebels, a VI Plan for Emacs Rescue, and a venomous VI PERil. @end joke Technically speaking, Viper is a new Vi emulator that replaces the old VIP package. Viper emulates Vi much better than VIP. It also significantly extends and improves upon Vi in many useful ways. Although many VIP settings in your ~/.vip are compatible with Viper, you may have to change some of them. Please refer to the documentation, which can be obtained by executing :help when Viper is in Vi state. If you will be so lucky as to find a bug, report it via the command :submitReport Type any key to continue... ") (read-char) (erase-buffer))) (while (or (> vip-expert-level vip-max-expert-level) (< vip-expert-level 1) (null dont-change-unless)) (erase-buffer) (if repeated (progn (message "Invalid user level") (beep 1)) (setq repeated t)) (setq dont-change-unless t level-changed t) (insert " Please specify your level of familiarity with the venomous VI PERil (and the VI Plan for Emacs Rescue). You can change it at any time by typing `M-x vip-set-expert-level RET' 1 -- BEGINNER: Almost all Emacs features are suppressed. Feels almost like straight Vi. File name completion and command history in the minibuffer are thrown in as a bonus. To use Emacs productively, you must reach level 3 or higher. 2 -- MASTER: C-c now has its standard Emacs meaning in Vi command state, so most Emacs commands can be used when Viper is in Vi state. Good progress---you are well on the way to level 3! 3 -- GRAND MASTER: Like 3, but most Emacs commands are available also in Viper's insert state. 4 -- GURU: Like 3, but user settings are respected for vip-no-multiple-ESC, vip-re-search, vip-ex-style-motion, & vip-ex-style-editing-in-insert variables. Adjust these settings to your taste. 5 -- WIZARD: Like 4, but user settings are also respected for vip-always, vip-want-ctl-h-help, vip-want-emacs-keys-in-vi, and vip-want-emacs-keys-in-insert. Adjust these to your taste. Please, specify your level now: ") (setq vip-expert-level (- (vip-read-char-exclusive) ?0)) ) ; end while ;; tell the user if level was changed (and level-changed (progn (insert (format "\n\n\n\n\n\t\tYou have selected user level %d" vip-expert-level)) (if (y-or-n-p "Do you wish to make this change permanent? ") ;; save the setting for vip-expert-level (vip-save-setting 'vip-expert-level (format "Saving user level %d ..." vip-expert-level) vip-custom-file-name)) )) (bury-buffer) ; remove ask-buffer from screen (message "") ))) (defun viper-version () (interactive) (message "Viper version is %s" viper-version)) (defalias 'vip-version 'viper-version) (defun vip-nil () (interactive) (beep 1)) ;; Returns t, if the string before point matches the regexp STR. (defsubst vip-looking-back (str) (and (save-excursion (re-search-backward str nil t)) (= (point) (match-end 0)))) ;; if ENFORCE-BUFFER is not nil, error if CHAR is a marker in another buffer (defun vip-register-to-point (char &optional enforce-buffer) "Like jump-to-register, but switches to another buffer in another window." (interactive "cViper register to point: ") (let ((val (get-register char))) (cond ((and (fboundp 'frame-configuration-p) (frame-configuration-p val)) (set-frame-configuration val)) ((window-configuration-p val) (set-window-configuration val)) ((vip-valid-marker val) (if (and enforce-buffer (not (equal (current-buffer) (marker-buffer val)))) (error (concat vip-EmptyTextmarker " in this buffer") (1- (+ char ?a)))) (pop-to-buffer (marker-buffer val)) (goto-char val)) ((and (consp val) (eq (car val) 'file)) (find-file (cdr val))) (t (error vip-EmptyTextmarker (1- (+ char ?a))))))) (defun vip-save-kill-buffer () "Save then kill current buffer. " (interactive) (if (< vip-expert-level 2) (save-buffers-kill-emacs) (save-buffer) (kill-buffer (current-buffer)))) ;;; Bug Report (defun vip-submit-report () "Submit bug report on Viper." (interactive) (let ((reporter-prompt-for-summary-p t) (vip-device-type (vip-device-type)) color-display-p frame-parameters minibuffer-emacs-face minibuffer-vi-face minibuffer-insert-face varlist salutation window-config) ;; If mode info is needed, add variable to `let' and then set it below, ;; like we did with color-display-p. (setq color-display-p (if (vip-window-display-p) (vip-color-display-p) 'non-x) minibuffer-vi-face (if (vip-window-display-p) (vip-get-face vip-minibuffer-vi-face) 'non-x) minibuffer-insert-face (if (vip-window-display-p) (vip-get-face vip-minibuffer-insert-face) 'non-x) minibuffer-emacs-face (if (vip-window-display-p) (vip-get-face vip-minibuffer-emacs-face) 'non-x) frame-parameters (if (fboundp 'frame-parameters) (frame-parameters (selected-frame)))) (setq varlist (list 'vip-vi-minibuffer-minor-mode 'vip-insert-minibuffer-minor-mode 'vip-vi-intercept-minor-mode 'vip-vi-local-user-minor-mode 'vip-vi-kbd-minor-mode 'vip-vi-global-user-minor-mode 'vip-vi-state-modifier-minor-mode 'vip-vi-diehard-minor-mode 'vip-vi-basic-minor-mode 'vip-replace-minor-mode 'vip-insert-intercept-minor-mode 'vip-insert-local-user-minor-mode 'vip-insert-kbd-minor-mode 'vip-insert-global-user-minor-mode 'vip-insert-state-modifier-minor-mode 'vip-insert-diehard-minor-mode 'vip-insert-basic-minor-mode 'vip-emacs-intercept-minor-mode 'vip-emacs-local-user-minor-mode 'vip-emacs-kbd-minor-mode 'vip-emacs-global-user-minor-mode 'vip-emacs-state-modifier-minor-mode 'vip-automatic-iso-accents 'vip-want-emacs-keys-in-insert 'vip-want-emacs-keys-in-vi 'vip-keep-point-on-undo 'vip-no-multiple-ESC 'vip-ESC-key 'vip-want-ctl-h-help 'vip-ex-style-editing-in-insert 'vip-delete-backwards-in-replace 'vip-vi-style-in-minibuffer 'vip-vi-state-hook 'vip-insert-state-hook 'vip-replace-state-hook 'vip-emacs-state-hook 'ex-cycle-other-window 'ex-cycle-through-non-files 'vip-expert-level 'major-mode 'vip-device-type 'color-display-p 'frame-parameters 'minibuffer-vi-face 'minibuffer-insert-face 'minibuffer-emacs-face )) (setq salutation " Congratulations! You may have unearthed a bug in Viper! Please mail a concise, accurate summary of the problem to the address above. -------------------------------------------------------------------") (setq window-config (current-window-configuration)) (with-output-to-temp-buffer " *vip-info*" (switch-to-buffer " *vip-info*") (delete-other-windows) (princ " PLEASE FOLLOW THESE PROCEDURES ------------------------------ Before reporting a bug, please verify that it is related to Viper, and is not cause by other packages you are using. Don't report compilation warnings, unless you are certain that there is a problem. These warnings are normal and unavoidable. Please note that users should not modify variables and keymaps other than those advertised in the manual. Such `customization' is likely to crash Viper, as it would any other improperly customized Emacs package. If you are reporting an error message received while executing one of the Viper commands, type: M-x set-variable debug-on-error t Then reproduce the error. The above command will cause Emacs to produce a back trace of the execution that leads to the error. Please include this trace in your bug report. If you believe that one of Viper's commands goes into an infinite loop \(e.g., Emacs freezes\), type: M-x set-variable debug-on-quit t Then reproduce the problem. Wait for a few seconds, then type C-g to abort the current command. Include the resulting back trace in the bug report. Mail anyway (y or n)? ") (if (y-or-n-p "Mail anyway? ") () (set-window-configuration window-config) (error "Bug report aborted"))) (require 'reporter) (set-window-configuration window-config) (reporter-submit-bug-report "kifer@cs.sunysb.edu" (vip-version) varlist nil 'delete-other-windows salutation) )) ;; Smoothes out the difference between Emacs' unread-command-events ;; and XEmacs unread-command-event. Arg is a character, an event, a list of ;; events or a sequence of keys. ;; ;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event ;; symbol in unread-command-events list may cause Emacs to turn this symbol ;; into an event. Below, we delete nil from event lists, since nil is the most ;; common symbol that might appear in this wrong context. (defun vip-set-unread-command-events (arg) (if vip-emacs-p (setq unread-command-events (let ((new-events (cond ((eventp arg) (list arg)) ((listp arg) arg) ((sequencep arg) (listify-key-sequence arg)) (t (error "vip-set-unread-command-events: Invalid argument, %S" arg))))) (if (not (eventp nil)) (setq new-events (delq nil new-events))) (append new-events unread-command-events))) ;; XEmacs (setq unread-command-events (append (cond ((numberp arg) (list (character-to-event arg))) ((eventp arg) (list arg)) ((stringp arg) (mapcar 'character-to-event arg)) ((vectorp arg) (append arg nil)) ; turn into list ((listp arg) (vip-eventify-list-xemacs arg)) (t (error "vip-set-unread-command-events: Invalid argument, %S" arg))) unread-command-events)))) ;; list is assumed to be a list of events of characters (defun vip-eventify-list-xemacs (lis) (mapcar (function (lambda (elt) (cond ((numberp elt) (character-to-event elt)) ((eventp elt) elt) (t (error "vip-eventify-list-xemacs: can't convert to event, %S" elt))))) lis)) ;;; Bring in the rest of the files (require 'viper-mous) (require 'viper-macs) (require 'viper-ex) ;; The following is provided for compatibility with older VIP's (defalias 'vip-change-mode-to-vi 'vip-change-state-to-vi) (defalias 'vip-change-mode-to-insert 'vip-change-state-to-insert) (defalias 'vip-change-mode-to-emacs 'vip-change-state-to-emacs) ;;; Load .vip and set up hooks ;; This hook designed to enable Vi-style editing in comint-based modes." (defun vip-comint-mode-hook () (setq require-final-newline nil) (setq vip-ex-style-editing-in-insert nil vip-ex-style-motion nil) (vip-add-local-keys 'vi-state '(("\C-m" . comint-send-input) ; return ("\C-d" . comint-delchar-or-maybe-eof))) ; \C-d (vip-add-local-keys 'insert-state '(("\C-m" . comint-send-input) ; return ("\C-d" . comint-delchar-or-maybe-eof))) ; \C-d ) ;; This sets major mode hooks to make them come up in vi-state. (defun vip-set-hooks () ;; It is of course a misnomer to call viper-mode a `major mode'. ;; However, this has the effect that if the user didn't specify the ;; default mode, new buffers that fall back on the default will come up ;; in Fundamental Mode and Vi state. (setq default-major-mode 'viper-mode) ;; The following major modes should come up in vi-state (defadvice fundamental-mode (after vip-fundamental-mode-ad activate) "Run `vip-change-state-to-vi' on entry." (vip-change-state-to-vi)) (defvar help-mode-hook nil) (add-hook 'help-mode-hook 'viper-mode) (defvar emacs-lisp-mode-hook nil) (add-hook 'emacs-lisp-mode-hook 'viper-mode) (defvar html-mode-hook nil) (add-hook 'html-mode-hook 'viper-mode) (defvar lisp-mode-hook nil) (add-hook 'lisp-mode-hook 'viper-mode) (defvar bibtex-mode-hook nil) (add-hook 'bibtex-mode-hook 'viper-mode) (defvar cc-mode-hook nil) (add-hook 'cc-mode-hook 'viper-mode) (defvar c-mode-hook nil) (add-hook 'c-mode-hook 'viper-mode) (defvar c++-mode-hook nil) (add-hook 'c++-mode-hook 'viper-mode) (defvar lisp-interaction-mode-hook nil) (add-hook 'lisp-interaction-mode-hook 'viper-mode) (defvar text-mode-hook nil) (add-hook 'text-mode-hook 'viper-mode) (add-hook 'completion-list-mode-hook 'viper-mode) (add-hook 'compilation-mode-hook 'viper-mode) (defvar emerge-startup-hook nil) (add-hook 'emerge-startup-hook 'vip-change-state-to-emacs) ;; Run vip-change-state-to-vi after quitting emerge. (vip-eval-after-load "emerge" '(defadvice emerge-quit (after vip-emerge-advice activate) "Run `vip-change-state-to-vi' after quitting emerge." (vip-change-state-to-vi))) ;; In case Emerge was loaded before Viper. (defadvice emerge-quit (after vip-emerge-advice activate) "Run `vip-change-state-to-vi' after quitting emerge." (vip-change-state-to-vi)) (vip-eval-after-load "asm-mode" '(defadvice asm-mode (after vip-asm-mode-ad activate) "Run `vip-change-state-to-vi' on entry." (vip-change-state-to-vi))) ;; passwd.el sets up its own buffer, which turns up in Vi mode, ;; thus overriding the local map. We don't need Vi mode here. (vip-eval-after-load "passwd" '(defadvice read-passwd-1 (before vip-passwd-ad activate) "Switch to emacs state while reading password." (vip-change-state-to-emacs))) ;; Emacs shell, ange-ftp, and comint-based modes (defvar comint-mode-hook nil) (add-hook 'comint-mode-hook 'vip-change-state-to-insert) (add-hook 'comint-mode-hook 'vip-comint-mode-hook) ;; Shell scripts (defvar sh-mode-hook nil) (add-hook 'sh-mode-hook 'viper-mode) ;; Dired ;; This is only necessary when the user uses vip-modify-major-mode (add-hook 'dired-mode-hook 'vip-change-state-to-emacs) (if vip-emacs-p (progn (defvar view-mode-hook nil "View hook. Run after view mode.") (add-hook 'view-mode-hook 'vip-change-state-to-emacs)) (defadvice view-minor-mode (after vip-view-ad activate) "Switch to Emacs state in View mode." (vip-change-state-to-emacs)) (defvar view-hook nil "View hook. Run after view mode.") (add-hook 'view-hook 'vip-change-state-to-emacs)) ;; For VM users. ;; Put summary and other VM buffers in Emacs state. (defvar vm-mode-hooks nil "This hook is run after vm is started.") (defvar vm-summary-mode-hooks nil "This hook is run after vm switches to summary mode.") (add-hook 'vm-mode-hooks 'vip-change-state-to-emacs) (add-hook 'vm-summary-mode-hooks 'vip-change-state-to-emacs) ;; For RMAIL users. ;; Put buf in Emacs state after edit. (vip-eval-after-load "rmailedit" '(defadvice rmail-cease-edit (after vip-rmail-advice activate) "Switch to emacs state when done editing message." (vip-change-state-to-emacs))) ;; In case RMAIL was loaded before Viper. (defadvice rmail-cease-edit (after vip-rmail-advice activate) "Switch to emacs state when done editing message." (vip-change-state-to-emacs)) ) ; vip-set-hooks ;; Set some useful macros ;; These must be before we load .vip, so the user can unrecord them. ;; repeat the 2nd previous command without rotating the command history (vip-record-kbd-macro (vector vip-repeat-from-history-key '\1) 'vi-state [(meta x) v i p - r e p e a t - f r o m - h i s t o r y return] 't) ;; repeat the 3d previous command without rotating the command history (vip-record-kbd-macro (vector vip-repeat-from-history-key '\2) 'vi-state [(meta x) v i p - r e p e a t - f r o m - h i s t o r y return] 't) ;; toggle case sensitivity in search (vip-record-kbd-macro "//" 'vi-state [1 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] 't) ;; toggle regexp/vanila search (vip-record-kbd-macro "///" 'vi-state [2 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] 't) ;; ~/.vip is loaded if it exists (if (and (file-exists-p vip-custom-file-name) (not noninteractive)) (load vip-custom-file-name)) ;; VIP compatibility: merge whatever the user has in vip-mode-map into ;; Viper's basic map. (vip-add-keymap vip-mode-map vip-vi-global-user-map) ;; Applying Viper customization -- runs after (load .vip) ;; Save user settings or Viper defaults for vars controled by vip-expert-level (setq vip-saved-user-settings (list (cons 'vip-want-ctl-h-help vip-want-ctl-h-help) (cons 'vip-always vip-always) (cons 'vip-no-multiple-ESC vip-no-multiple-ESC) (cons 'vip-ex-style-motion vip-ex-style-motion) (cons 'vip-ex-style-editing-in-insert vip-ex-style-editing-in-insert) (cons 'vip-want-emacs-keys-in-vi vip-want-emacs-keys-in-vi) (cons 'vip-want-emacs-keys-in-insert vip-want-emacs-keys-in-insert) (cons 'vip-re-search vip-re-search))) (vip-set-minibuffer-style) (vip-set-minibuffer-faces) (vip-set-search-face) (if vip-buffer-search-char (vip-buffer-search-enable)) (vip-update-alphanumeric-class) ;;; Familiarize Viper with some minor modes that have their own keymaps (vip-harness-minor-mode "compile") (vip-harness-minor-mode "outline") (vip-harness-minor-mode "allout") (vip-harness-minor-mode "xref") (vip-harness-minor-mode "lmenu") (vip-harness-minor-mode "vc") (vip-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX (vip-harness-minor-mode "latex") ; which is in one of these two files (vip-harness-minor-mode "cyrillic") (vip-harness-minor-mode "russian") (vip-harness-minor-mode "view-less") ;; Intercept maps could go in viper-keym.el ;; We keep them here in case someone redefines them in ~/.vip (define-key vip-vi-intercept-map vip-ESC-key 'vip-intercept-ESC-key) (define-key vip-insert-intercept-map vip-ESC-key 'vip-intercept-ESC-key) ;; This is taken care of by vip-insert-global-user-map. ;;(define-key vip-replace-map vip-ESC-key 'vip-intercept-ESC-key) (define-key vip-insert-intercept-map vip-toggle-key 'vip-alternate-ESC) ;; The default vip-toggle-key is \C-z; for the novice, it suspends or ;; iconifies Emacs (define-key vip-vi-intercept-map vip-toggle-key '(lambda () (interactive) (if (and (< vip-expert-level 2) (equal vip-toggle-key "\C-z")) (if (vip-window-display-p) (vip-iconify) (suspend-emacs)) (vip-change-state-to-emacs)))) (define-key vip-emacs-intercept-map vip-toggle-key 'vip-change-state-to-vi) (if (or vip-always (and (< vip-expert-level 5) (> vip-expert-level 0))) (vip-set-hooks)) ;; Let all minor modes take effect after loading ;; this may not be enough, so we also set default minor-mode-alist. ;; Without setting the default, new buffers that come up in emacs mode have ;; minor-mode-map-alist = nil, unless we call vip-change-state-* (if (eq vip-current-state 'emacs-state) (progn (vip-change-state-to-emacs) (setq-default minor-mode-map-alist minor-mode-map-alist) )) (run-hooks 'vip-load-hook) ; the last chance to change something (provide 'viper) (provide 'vip19) (provide 'vip) ;;; viper.el ends here emacs-19.30/lisp/vms-patch.el100444 12120 1 15157 5732144571 14334 0ustar rmsdaemon;;; vms-patch.el --- override parts of files.el for VMS. ;; Copyright (C) 1986, 1992 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: vms ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;;; Functions that need redefinition ;;; VMS file names are upper case, but buffer names are more ;;; convenient in lower case. (defun create-file-buffer (filename) "Create a suitably named buffer for visiting FILENAME, and return it. FILENAME (sans directory) is used unchanged if that name is free; otherwise a string <2> or <3> or ... is appended to get an unused name." (generate-new-buffer (downcase (file-name-nondirectory filename)))) ;;; Given a string FN, return a similar name which is a legal VMS filename. ;;; This is used to avoid invalid auto save file names. (defun make-legal-file-name (fn) (setq fn (copy-sequence fn)) (let ((dot nil) (indx 0) (len (length fn)) chr) (while (< indx len) (setq chr (aref fn indx)) (cond ((eq chr ?.) (if dot (aset fn indx ?_) (setq dot t))) ((not (or (and (>= chr ?a) (<= chr ?z)) (and (>= chr ?A) (<= chr ?Z)) (and (>= chr ?0) (<= chr ?9)) (eq chr ?$) (eq chr ?_) (and (eq chr ?-) (> indx 0)))) (aset fn indx ?_))) (setq indx (1+ indx)))) fn) ;;; Auto save filesnames start with _$ and end with $. (defun make-auto-save-file-name () "Return file name to use for auto-saves of current buffer. This function does not consider `auto-save-visited-file-name'; the caller should check that before calling this function. This is a separate function so that your `.emacs' file or the site's `site-init.el' can redefine it. See also `auto-save-file-name-p'." (if buffer-file-name (concat (file-name-directory buffer-file-name) "_$" (file-name-nondirectory buffer-file-name) "$") (expand-file-name (concat "_$_" (make-legal-file-name (buffer-name)) "$")))) (defun auto-save-file-name-p (filename) "Return t if FILENAME can be yielded by `make-auto-save-file-name'. FILENAME should lack slashes. This is a separate function so that your `.emacs' file or the site's `site-init.el' can redefine it." (string-match "^_\\$.*\\$" filename)) ;;; ;;; This goes along with kepteditor.com which defines these logicals ;;; If EMACS_COMMAND_ARGS is defined, it supersedes EMACS_FILE_NAME, ;;; which is probably set up incorrectly anyway. ;;; The function command-line-again is a kludge, but it does the job. ;;; (defun vms-suspend-resume-hook () "When resuming suspended Emacs, check for file to be found. If the logical name `EMACS_FILE_NAME' is defined, `find-file' that file." (let ((file (vms-system-info "LOGICAL" "EMACS_FILE_NAME")) (args (vms-system-info "LOGICAL" "EMACS_COMMAND_ARGS")) (line (vms-system-info "LOGICAL" "EMACS_FILE_LINE"))) (if (not args) (if file (progn (find-file file) (if line (goto-line (string-to-int line))))) (cd (file-name-directory file)) (vms-command-line-again)))) (setq suspend-resume-hook 'vms-suspend-resume-hook) (defun vms-suspend-hook () "Don't allow suspending if logical name `DONT_SUSPEND_EMACS' is defined." (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS") (error "Can't suspend this emacs")) nil) (setq suspend-hook 'vms-suspend-hook) ;;; ;;; A kludge that allows reprocessing of the command line. This is mostly ;;; to allow a spawned VMS mail process to do something reasonable when ;;; used in conjunction with the modifications to sysdep.c that allow ;;; Emacs to attach to a "foster" parent. ;;; (defun vms-command-line-again () "Reprocess command line arguments. VMS specific. Command line arguments are initialized from the logical EMACS_COMMAND_ARGS which is defined by kepteditor.com. On VMS this allows attaching to a spawned Emacs and doing things like \"emacs -l myfile.el -f doit\"" (let* ((args (downcase (vms-system-info "LOGICAL" "EMACS_COMMAND_ARGS"))) (command-line-args (list "emacs")) (beg 0) (end 0) (len (length args)) this-char) (if args (progn ;;; replace non-printable stuff with spaces (while (< beg (length args)) (if (or (> 33 (setq this-char (aref args beg))) (< 127 this-char)) (aset args beg 32)) (setq beg (1+ beg))) (setq beg (1- (length args))) (while (= 32 (aref args beg)) (setq beg (1- beg))) (setq args (substring args 0 (1+ beg))) (setq beg 0) ;;; now start parsing args (while (< beg (length args)) (while (and (< beg (length args)) (or (> 33 (setq this-char (aref args beg))) (< 127 this-char)) (setq beg (1+ beg)))) (setq end (1+ beg)) (while (and (< end (length args)) (< 32 (setq this-char (aref args end))) (> 127 this-char)) (setq end (1+ end))) (setq command-line-args (append command-line-args (list (substring args beg end)))) (setq beg (1+ end))) (command-line))))) (defun vms-read-directory (dirname switches buffer) (save-excursion (set-buffer buffer) (subprocess-command-to-buffer (concat "DIRECTORY " switches " " dirname) buffer) (goto-char (point-min)) ;; Remove all the trailing blanks. (while (search-forward " \n") (forward-char -1) (delete-horizontal-space)) (goto-char (point-min)))) (setq dired-listing-switches "/SIZE/DATE/OWNER/WIDTH=(FILENAME=32,SIZE=5)") (setq print-region-function '(lambda (start end command ign1 ign2 ign3 &rest switches) (write-region start end "sys$login:delete-me.txt") (send-command-to-subprocess 1 (concat command " sys$login:delete-me.txt/name=\"GNUprintbuffer\" " (mapconcat 'identity switches " ")) nil nil nil))) ;;; ;;; Fuctions for using Emacs as a VMS Mail editor ;;; (autoload 'vms-pmail-setup "vms-pmail" "Set up file assuming use by VMS Mail utility. The buffer is put into text-mode, auto-save is turned off and the following bindings are established. \\[vms-pmail-save-and-exit] vms-pmail-save-and-exit \\[vms-pmail-abort] vms-pmail-abort All other Emacs commands are still available." t) ;;; vms-patch.el ends here emacs-19.30/lisp/vms-pmail.el100444 74777 1 10362 5352167712 14352 0ustar esrdaemon;;; vms-pmail.el --- use Emacs as the editor within VMS mail. ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Roland B Roberts ;; Keywords: vms ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;;; ;;; Quick hack to use emacs as mail editor. There are a *bunch* of ;;; changes scattered throughout emacs to make this work, namely: ;;; (1) mod to sysdep.c to allow emacs to attach to a process other ;;; than the one that originally spawned it. ;;; (2) mod to kepteditor.com to define the logical emacs_parent_pid ;;; which is what sysdep.c looks for, and define the logical ;;; emacs_command_args which contains the command line ;;; (3) mod to re-parse command line arguments from emacs_command_args ;;; then execute them as though emacs were just starting up. ;;; (defun vms-pmail-save-and-exit () "Save current buffer and exit emacs. If this emacs cannot be suspended, you will be prompted about modified buffers other than the mail buffer. BEWARE --- suspending emacs without saving your mail buffer causes mail to abort the send (potentially useful since the mail buffer is still here)." (interactive) (basic-save-buffer) (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS") (progn (save-some-buffers) (kill-emacs 1)) (kill-buffer (current-buffer)) (suspend-emacs))) (defun vms-pmail-abort () "Mark buffer as unmodified and exit emacs. When the editor is exited without saving its buffer, VMS mail does not send a message. If you have other modified buffers you will be prompted for what to do with them." (interactive) (if (not (yes-or-no-p "Really abort mail? ")) (ding) (not-modified) (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS") (progn (save-some-buffers) (kill-emacs 1)) (kill-buffer (current-buffer)) (suspend-emacs)))) (defun vms-pmail-setup () "Set up file assuming use by VMS MAIL utility. The buffer is put into text-mode, auto-save is turned off and the following bindings are established. \\[vms-pmail-save-and-exit] vms-pmail-save-and-exit \\[vms-pmail-abort] vms-pmail-abort All other emacs commands are still available." (interactive) (auto-save-mode -1) (text-mode) (let ((default (vms-system-info "LOGICAL" "SYS$SCRATCH")) (directory (file-name-directory (buffer-file-name))) (filename (file-name-nondirectory (buffer-file-name)))) (if (string= directory "SYS$SCRATCH:") (progn (cd default) (setq buffer-file-name (concat default filename)))) (use-local-map (copy-keymap (current-local-map))) (local-set-key "\C-c\C-c" 'vms-pmail-save-and-exit) (local-set-key "\C-c\C-g" 'vms-pmail-abort))) (defun indicate-mail-reply-text () "Prepares received mail for re-sending by placing >'s on each line." (interactive) (goto-char (point-min)) (while (not (eobp)) (insert ">") (beginning-of-line) (forward-line 1)) (set-buffer-modified-p nil) (goto-char (point-min))) (defun insert-signature () "Moves to the end of the buffer and inserts a \"signature\" file. First try the file indicated by environment variable MAIL$TRAILER. If that fails, try the file \"~/.signature\". If neither file exists, fails quietly." (interactive) (end-of-buffer) (newline) (if (vms-system-info "LOGICAL" "MAIL$TRAILER") (if (file-attributes (vms-system-info "LOGICAL" "MAIL$TRAILER")) (insert-file-contents (vms-system-info "LOGICAL" "MAIL$TRAILER")) (if (file-attributes "~/.signature") (insert-file-contents "~/.signature"))))) ;;; vms-pmail.el ends here emacs-19.30/lisp/vmsproc.el100444 12120 1 11673 5257335337 14126 0ustar rmsdaemon;;; vmsproc.el --- run asynchronous VMS subprocesses under Emacs ;; Copyright (C) 1986 Free Software Foundation, Inc. ;; Author: Mukesh Prasad ;; Maintainer: FSF ;; Keywords: vms ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (defvar display-subprocess-window nil "If non-nil, the suprocess window is displayed whenever input is received.") (defvar command-prefix-string "$ " "String to insert to distinguish commands entered by user.") (defvar subprocess-running nil) (defvar command-mode-map nil) (if command-mode-map nil (setq command-mode-map (make-sparse-keymap)) (define-key command-mode-map "\C-m" 'command-send-input) (define-key command-mode-map "\C-u" 'command-kill-line)) (defun subprocess-input (name str) "Handles input from a subprocess. Called by Emacs." (if display-subprocess-window (display-buffer subprocess-buf)) (let ((old-buffer (current-buffer))) (set-buffer subprocess-buf) (goto-char (point-max)) (insert str) (insert ?\n) (set-buffer old-buffer))) (defun subprocess-exit (name) "Called by Emacs upon subprocess exit." (setq subprocess-running nil)) (defun start-subprocess () "Spawns an asynchronous subprocess with output redirected to the buffer *COMMAND*. Within this buffer, use C-m to send the last line to the subprocess or to bring another line to the end." (if subprocess-running (return t)) (setq subprocess-buf (get-buffer-create "*COMMAND*")) (save-excursion (set-buffer subprocess-buf) (use-local-map command-mode-map)) (setq subprocess-running (spawn-subprocess 1 'subprocess-input 'subprocess-exit)) ;; Initialize subprocess so it doesn't panic and die upon ;; encountering the first error. (and subprocess-running (send-command-to-subprocess 1 "ON SEVERE_ERROR THEN CONTINUE"))) (defun subprocess-command-to-buffer (command buffer) "Execute COMMAND and redirect output into BUFFER." (let (cmd args) (setq cmd (substring command 0 (string-match " " command))) (setq args (substring command (string-match " " command))) (call-process cmd nil buffer nil "*dcl*" args))) ;BUGS: only the output up to the end of the first image activation is trapped. ; (if (not subprocess-running) ; (start-subprocess)) ; (save-excursion ; (set-buffer buffer) ; (let ((output-filename (concat "SYS$SCRATCH:OUTPUT-FOR-" ; (getenv "USER") ".LISTING"))) ; (while (file-exists-p output-filename) ; (delete-file output-filename)) ; (define-logical-name "SYS$OUTPUT" (concat output-filename "-NEW")) ; (send-command-to-subprocess 1 command) ; (send-command-to-subprocess 1 (concat ; "RENAME " output-filename ; "-NEW " output-filename)) ; (while (not (file-exists-p output-filename)) ; (sleep-for 1)) ; (define-logical-name "SYS$OUTPUT" nil) ; (insert-file output-filename) ; (delete-file output-filename)))) (defun subprocess-command () "Starts asynchronous subprocess if not running and switches to its window." (interactive) (if (not subprocess-running) (start-subprocess)) (and subprocess-running (progn (pop-to-buffer subprocess-buf) (goto-char (point-max))))) (defun command-send-input () "If at last line of buffer, sends the current line to the spawned subprocess. Otherwise brings back current line to the last line for resubmission." (interactive) (beginning-of-line) (let ((current-line (buffer-substring (point) (progn (end-of-line) (point))))) (if (eobp) (progn (if (not subprocess-running) (start-subprocess)) (if subprocess-running (progn (beginning-of-line) (send-command-to-subprocess 1 current-line) (if command-prefix-string (progn (beginning-of-line) (insert command-prefix-string))) (next-line 1)))) ;; else -- if not at last line in buffer (end-of-buffer) (backward-char) (next-line 1) (if (string-equal command-prefix-string (substring current-line 0 (length command-prefix-string))) (insert (substring current-line (length command-prefix-string))) (insert current-line))))) (defun command-kill-line() "Kills the current line. Used in command mode." (interactive) (beginning-of-line) (kill-line)) (define-key esc-map "$" 'subprocess-command) ;;; vmsproc.el ends here emacs-19.30/lisp/vt-control.el100444 12120 1 6372 5772351117 14520 0ustar rmsdaemon;;; vt-control.el --- Common VTxxx control functions ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Author: Rob Riepel ;; Maintainer: Rob Riepel ;; Keywords: terminals ;; 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: ;; The functions contained in this file send various VT control codes ;; to the terminal where emacs is running. The following functions are ;; available. ;; Function Action ;; vt-wide set wide screen (132 characters) ;; vt-narrow set narrow screen (80 characters) ;; vt-toggle-screen toggle wide/narrow screen ;; vt-keypad-on set applications keypad on ;; vt-keypad-off set applications keypad off ;; vt-numlock toggle applications keypad on/off ;;; Usage: ;; To use enable these functions, simply load this file. ;; Note: vt-control makes no effort to determine how the terminal is ;; initially set. It assumes the terminal starts with a width ;; of 80 characters and the applications keypad enabled. Nor ;; does vt-control try to restore the terminal when emacs is ;; killed or suspended. ;;; Code: ;;; Global variables (defvar vt-applications-keypad-p t "If non-nil, keypad is in applications mode.") (defvar vt-wide-p nil "If non-nil, the screen is 132 characters wide.") ;;; Screen width functions. (defun vt-wide nil "Set the screen 132 characters wide." (interactive) (send-string-to-terminal "\e[?3h") (set-screen-width 132) (setq vt-wide-p t)) (defun vt-narrow nil "Set the screen 80 characters wide." (interactive) (send-string-to-terminal "\e[?3l") (set-screen-width 80) (setq vt-wide-p nil)) (defun vt-toggle-screen nil "Toggle between 80 and 132 character screen width." (interactive) (if vt-wide-p (vt-narrow) (vt-wide))) ;;; Applications keypad functions. (defun vt-keypad-on (&optional tell) "Turn on the VT applications keypad." (interactive) (send-string-to-terminal "\e=") (setq vt-applications-keypad-p t) (if (or tell (interactive-p)) (message "Applications keypad enabled."))) (defun vt-keypad-off (&optional tell) "Turn off the VT applications keypad." (interactive "p") (send-string-to-terminal "\e>") (setq vt-applications-keypad-p nil) (if (or tell (interactive-p)) (message "Applications keypad disabled."))) (defun vt-numlock nil "Toggle VT application keypad on and off." (interactive) (if vt-applications-keypad-p (vt-keypad-off (interactive-p)) (vt-keypad-on (interactive-p)))) ;;; vt-control.el ends here emacs-19.30/lisp/vt100-led.el100444 13437 1 3654 5354241226 14154 0ustar jimbdaemon;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones. ;; Copyright (C) 1988 Free Software Foundation, Inc. ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: hardware ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (defvar led-state (make-vector 5 nil) "The internal state of the LEDs. Choices are nil, t, `flash. Element 0 is not used.") (defun led-flash (l) "Flash LED l." (aset led-state l 'flash) (led-update)) (defun led-off (&optional l) "Turn off vt100 led number L. With no argument, turn them all off." (interactive "P") (if l (aset led-state (prefix-numeric-value l) nil) (fillarray led-state nil)) (led-update)) (defun led-on (l) "Turn on LED l." (aset led-state l t) (led-update)) (defun led-update () "Update the terminal's LEDs to reflect the internal state." (let ((f "\e[?0") ; String to flash. (o "\e[0") ; String for steady on. (l 1)) ; Current LED number. (while (/= l 5) (let ((s (aref led-state l))) (cond ((eq s 'flash) (setq f (concat f ";" (int-to-string l)))) (s (setq o (concat o ";" (int-to-string l)))))) (setq l (1+ l))) (setq o (concat o "q" f "t")) (send-string-to-terminal o))) (provide 'vt100-led) ;;; vt100-led.el ends here emacs-19.30/lisp/window.el100444 12120 1 25147 6050772432 13736 0ustar rmsdaemon;;; window.el --- GNU Emacs window commands aside from those written in C. ;;; Copyright (C) 1985, 1989, 1992, 1993, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;;;; Window tree functions. (defun one-window-p (&optional nomini all-frames) "Returns non-nil if the selected window is the only window (in its frame). Optional arg NOMINI non-nil means don't count the minibuffer even if it is active. The optional arg ALL-FRAMES t means count windows on all frames. If it is `visible', count windows on all visible frames. ALL-FRAMES nil or omitted means count only the selected frame, plus the minibuffer it uses (which may be on another frame). If ALL-FRAMES is neither nil nor t, count only the selected frame." (let ((base-window (selected-window))) (if (and nomini (eq base-window (minibuffer-window))) (setq base-window (next-window base-window))) (eq base-window (next-window base-window (if nomini 'arg) all-frames)))) (defun walk-windows (proc &optional minibuf all-frames) "Cycle through all visible windows, calling PROC for each one. PROC is called with a window as argument. Optional second arg MINIBUF t means count the minibuffer window even if not active. MINIBUF nil or omitted means count the minibuffer iff it is active. MINIBUF neither t nor nil means not to count the minibuffer even if it is active. Several frames may share a single minibuffer; if the minibuffer counts, all windows on all frames that share that minibuffer count too. Therefore, when a separate minibuffer frame is active, `walk-windows' includes the windows in the frame from which you entered the minibuffer, as well as the minibuffer window. But if the minibuffer does not count, only windows from WINDOW's frame count. ALL-FRAMES is the optional third argument. ALL-FRAMES nil or omitted means cycle within the frames as specified above. ALL-FRAMES = `visible' means include windows on all visible frames. ALL-FRAMES = 0 means include windows on all visible and iconified frames. ALL-FRAMES = t means include windows on all frames including invisible frames. Anything else means restrict to WINDOW's frame." ;; If we start from the minibuffer window, don't fail to come back to it. (if (window-minibuffer-p (selected-window)) (setq minibuf t)) (let* ((walk-windows-start (selected-window)) (walk-windows-current walk-windows-start)) (while (progn (setq walk-windows-current (next-window walk-windows-current minibuf all-frames)) (funcall proc walk-windows-current) (not (eq walk-windows-current walk-windows-start)))))) (defun minibuffer-window-active-p (window) "Return t if WINDOW (a minibuffer window) is now active." (eq window (active-minibuffer-window))) (defmacro save-selected-window (&rest body) "Execute BODY, then select the window that was selected before BODY." (list 'let '((save-selected-window-window (selected-window))) (list 'unwind-protect (cons 'progn body) (list 'select-window 'save-selected-window-window)))) (defun count-windows (&optional minibuf) "Returns the number of visible windows. Optional arg NO-MINI non-nil means don't count the minibuffer even if it is active." (let ((count 0)) (walk-windows (function (lambda (w) (setq count (+ count 1)))) minibuf) count)) (defun balance-windows () "Makes all visible windows the same height (approximately)." (interactive) (let ((count -1) levels newsizes size ;; Don't count the lines that are above the uppermost windows. ;; (These are the menu bar lines, if any.) (mbl (nth 1 (window-edges (frame-first-window (selected-frame)))))) ;; Find all the different vpos's at which windows start, ;; then count them. But ignore levels that differ by only 1. (save-window-excursion (let (tops (prev-top -2)) (walk-windows (function (lambda (w) (setq tops (cons (nth 1 (window-edges w)) tops)))) 'nomini) (setq tops (sort tops '<)) (while tops (if (> (car tops) (1+ prev-top)) (setq prev-top (car tops) count (1+ count))) (setq levels (cons (cons (car tops) count) levels)) (setq tops (cdr tops))) (setq count (1+ count)))) ;; Subdivide the frame into that many vertical levels. (setq size (/ (- (frame-height) mbl) count)) (walk-windows (function (lambda (w) (select-window w) (let ((newtop (cdr (assq (nth 1 (window-edges)) levels))) (newbot (or (cdr (assq (+ (window-height) (nth 1 (window-edges))) levels)) count))) (setq newsizes (cons (cons w (* size (- newbot newtop))) newsizes))))) 'nomini) (walk-windows (function (lambda (w) (select-window w) (let ((newsize (cdr (assq w newsizes)))) (enlarge-window (- newsize (window-height)))))) 'nomini))) ;;; I think this should be the default; I think people will prefer it--rms. (defvar split-window-keep-point t "*If non-nil, split windows keeps the original point in both children. This is often more convenient for editing. If nil, adjust point in each of the two windows to minimize redisplay. This is convenient on slow terminals, but point can move strangely.") (defun split-window-vertically (&optional arg) "Split current window into two windows, one above the other. The uppermost window gets ARG lines and the other gets the rest. Negative arg means select the size of the lowermost window instead. With no argument, split equally or close to it. Both windows display the same buffer now current. If the variable split-window-keep-point is non-nil, both new windows will get the same value of point as the current window. This is often more convenient for editing. Otherwise, we chose window starts so as to minimize the amount of redisplay; this is convenient on slow terminals. The new selected window is the one that the current value of point appears in. The value of point can change if the text around point is hidden by the new mode line." (interactive "P") (let ((old-w (selected-window)) (old-point (point)) (size (and arg (prefix-numeric-value arg))) new-w bottom switch) (and size (< size 0) (setq size (+ (window-height) size))) (setq new-w (split-window nil size)) (or split-window-keep-point (progn (save-excursion (set-buffer (window-buffer)) (goto-char (window-start)) (vertical-motion (window-height)) (set-window-start new-w (point)) (if (> (point) (window-point new-w)) (set-window-point new-w (point))) (vertical-motion -1) (setq bottom (point))) (if (<= bottom (point)) (set-window-point old-w (1- bottom))) (if (< (window-start new-w) old-point) (progn (set-window-point new-w old-point) (select-window new-w))))) new-w)) (defun split-window-horizontally (&optional arg) "Split current window into two windows side by side. This window becomes the leftmost of the two, and gets ARG columns. Negative arg means select the size of the rightmost window instead. No arg means split equally." (interactive "P") (let ((size (and arg (prefix-numeric-value arg)))) (and size (< size 0) (setq size (+ (window-width) size))) (split-window nil size t))) (defun enlarge-window-horizontally (arg) "Make current window ARG columns wider." (interactive "p") (enlarge-window arg t)) (defun shrink-window-horizontally (arg) "Make current window ARG columns narrower." (interactive "p") (shrink-window arg t)) (defun shrink-window-if-larger-than-buffer (&optional window) "Shrink the WINDOW to be as small as possible to display its contents. Do not shrink to less than `window-min-height' lines. Do nothing if the buffer contains more lines than the present window height, or if some of the window's contents are scrolled out of view, or if the window is not the full width of the frame, or if the window is the only window of its frame." (interactive) (or window (setq window (selected-window))) (save-excursion (set-buffer (window-buffer window)) (let* ((w (selected-window)) ;save-window-excursion can't win (buffer-file-name buffer-file-name) (p (point)) (n 0) (ignore-final-newline ;; If buffer ends with a newline, ignore it when counting height ;; unless point is after it. (and (not (eobp)) (eq ?\n (char-after (1- (point-max)))))) (buffer-read-only nil) (modified (buffer-modified-p)) (buffer (current-buffer)) (params (frame-parameters (window-frame window))) (mini (cdr (assq 'minibuffer params))) (edges (window-edges (selected-window)))) (if (and (< 1 (let ((frame (selected-frame))) (select-frame (window-frame window)) (unwind-protect (count-windows) (select-frame frame)))) (= (window-width window) (frame-width (window-frame window))) (pos-visible-in-window-p (point-min) window) (not (eq mini 'only)) (or (not mini) (< (nth 3 edges) (nth 1 (window-edges mini))) (> (nth 1 edges) (cdr (assq 'menu-bar-lines params))))) (unwind-protect (progn (select-window (or window w)) (goto-char (point-min)) (while (pos-visible-in-window-p (- (point-max) (if ignore-final-newline 1 0))) ;; defeat file locking... don't try this at home, kids! (setq buffer-file-name nil) (insert ?\n) (setq n (1+ n))) (if (> n 0) (shrink-window (min (1- n) (- (window-height) window-min-height))))) (delete-region (point-min) (point)) (set-buffer-modified-p modified) (goto-char p) (select-window w) ;; Make sure we unbind buffer-read-only ;; with the proper current buffer. (set-buffer buffer)))))) (define-key ctl-x-map "2" 'split-window-vertically) (define-key ctl-x-map "3" 'split-window-horizontally) (define-key ctl-x-map "}" 'enlarge-window-horizontally) (define-key ctl-x-map "{" 'shrink-window-horizontally) (define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer) (define-key ctl-x-map "+" 'balance-windows) ;;; windows.el ends here emacs-19.30/lisp/winnt.el100444 12120 1 12455 5770156524 13572 0ustar rmsdaemon;; winnt.el --- Lisp routines for Windows NT. ;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Author: Geoff Voelker (voelker@cs.washington.edu) ;; 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: ;; (August 12, 1993) ;; Created. ;; (November 21, 1994) ;; [C-M-backspace] defined. ;; mode-line-format defined to show buffer file type. ;; audio bell initialized. ;;; Code: ;; Map delete and backspace (define-key function-key-map [backspace] "\177") (define-key function-key-map [delete] "\C-d") (define-key function-key-map [M-backspace] [?\M-\177]) (define-key function-key-map [C-M-backspace] [\C-\M-delete]) ;; Show file type (text or binary) on modeline (setq-default mode-line-format (list (purecopy "") 'mode-line-modified 'mode-line-buffer-identification (purecopy " ") 'global-mode-string (purecopy " %[(") (purecopy "%t:") 'mode-name 'mode-line-process 'minor-mode-alist (purecopy "%n") (purecopy ")%]--") (purecopy '(line-number-mode "L%l--")) (purecopy '(-3 . "%p")) (purecopy "-%-"))) ;; Ignore case on file-name completion (setq completion-ignore-case t) ;; The cmd.exe shell uses the "/c" switch instead of the "-c" switch ;; for executing its command line argument (from simple.el). (setq shell-command-switch "/c") ;; Use ";" instead of ":" as a path separator (from files.el). (setq path-separator ";") ;; Set the null device (for compile.el). (setq grep-null-device "NUL") ;; Set the grep regexp to match entries with drive letters. (setq grep-regexp-alist '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3))) ;; Taken from dos-fn.el ... don't want all that's in the file, maybe ;; separate it out someday. (defvar file-name-buffer-file-type-alist '( ("[:/].*config.sys$" . nil) ; config.sys text ("\\.elc$" . t) ; emacs stuff ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t) ; MS-Dos stuff ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t) ; Packers ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t) ; Unix stuff ("\\.tp[ulpw]$" . t) ; Borland Pascal stuff ("[:/]tags$" . t) ; Emacs TAGS file ) "*Alist for distinguishing text files from binary files. Each element has the form (REGEXP . TYPE), where REGEXP is matched against the file name, and TYPE is nil for text, t for binary.") (defun find-buffer-file-type (filename) (let ((alist file-name-buffer-file-type-alist) (found nil) (code nil)) (let ((case-fold-search t)) (setq filename (file-name-sans-versions filename)) (while (and (not found) alist) (if (string-match (car (car alist)) filename) (setq code (cdr (car alist)) found t)) (setq alist (cdr alist)))) (if found (cond((memq code '(nil t)) code) ((and (symbolp code) (fboundp code)) (funcall code filename))) default-buffer-file-type))) (defun find-file-binary (filename) "Visit file FILENAME and treat it as binary." (interactive "FFind file binary: ") (let ((file-name-buffer-file-type-alist '(("" . t)))) (find-file filename))) (defun find-file-text (filename) "Visit file FILENAME and treat it as a text file." (interactive "FFind file text: ") (let ((file-name-buffer-file-type-alist '(("" . nil)))) (find-file filename))) (defun find-file-not-found-set-buffer-file-type () (save-excursion (set-buffer (current-buffer)) (setq buffer-file-type (find-buffer-file-type (buffer-file-name)))) nil) ;;; To set the default file type on new files. (add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type) ;;; For using attached Unix filesystems. (defun save-to-unix-hook () (save-excursion (setq buffer-file-type t)) nil) (defun revert-from-unix-hook () (save-excursion (setq buffer-file-type (find-buffer-file-type (buffer-file-name)))) nil) ;; Really should provide this capability at the drive letter granularity. (defun using-unix-filesystems (flag) (if flag (progn (add-hook 'write-file-hooks 'save-to-unix-hook) (add-hook 'write-contents-hooks 'save-to-unix-hook) (add-hook 'after-save-hook 'revert-from-unix-hook)) (progn (remove-hook 'write-file-hooks 'save-to-unix-hook) (remove-hook 'write-contents-hooks 'save-to-unix-hook) (remove-hook 'after-save-hook 'revert-from-unix-hook)))) ;;; Fix interface to (X-specific) mouse.el (defalias 'x-set-selection 'ignore) (fset 'x-get-selection '(lambda (&rest rest) "")) (fmakunbound 'font-menu-add-default) (global-unset-key [C-down-mouse-1]) (global-unset-key [C-down-mouse-2]) (global-unset-key [C-down-mouse-3]) ;;; Set to a system sound if you want a fancy bell. (set-message-beep nil) ;;; winnt.el ends here emacs-19.30/lisp/ws-mode.el100444 12120 1 57671 6017705062 14007 0ustar rmsdaemon;;; ws-mode.el --- WordStar emulation mode for GNU Emacs ;; Copyright (C) 1991 Free Software Foundation, Inc. ;; Author: Juergen Nickelsen ;; Version: 0.7 ;; Keywords: emulations ;; 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 emulates WordStar, with a major mode. ;;; Code: (defvar wordstar-mode-map nil "") (defvar wordstar-C-j-map nil "") (defvar wordstar-C-k-map nil "") (defvar wordstar-C-o-map nil "") (defvar wordstar-C-q-map nil "") (if wordstar-mode-map () (setq wordstar-mode-map (make-keymap)) ;; (setq wordstar-C-j-map (make-keymap)) ; later, perhaps (setq wordstar-C-k-map (make-keymap)) (setq wordstar-C-o-map (make-keymap)) (setq wordstar-C-q-map (make-keymap)) (define-key wordstar-mode-map "\C-a" 'backward-word) (define-key wordstar-mode-map "\C-b" 'fill-paragraph) (define-key wordstar-mode-map "\C-c" 'scroll-up) (define-key wordstar-mode-map "\C-d" 'forward-char) (define-key wordstar-mode-map "\C-e" 'previous-line) (define-key wordstar-mode-map "\C-f" 'forward-word) (define-key wordstar-mode-map "\C-g" 'delete-char) (define-key wordstar-mode-map "\C-h" 'backward-char) (define-key wordstar-mode-map "\C-i" 'indent-for-tab-command) (define-key wordstar-mode-map "\C-j" 'help-for-help) (define-key wordstar-mode-map "\C-k" wordstar-C-k-map) (define-key wordstar-mode-map "\C-l" 'ws-repeat-search) (define-key wordstar-mode-map "\C-n" 'open-line) (define-key wordstar-mode-map "\C-o" wordstar-C-o-map) (define-key wordstar-mode-map "\C-p" 'quoted-insert) (define-key wordstar-mode-map "\C-q" wordstar-C-q-map) (define-key wordstar-mode-map "\C-r" 'scroll-down) (define-key wordstar-mode-map "\C-s" 'backward-char) (define-key wordstar-mode-map "\C-t" 'kill-word) (define-key wordstar-mode-map "\C-u" 'keyboard-quit) (define-key wordstar-mode-map "\C-v" 'overwrite-mode) (define-key wordstar-mode-map "\C-w" 'scroll-down-line) (define-key wordstar-mode-map "\C-x" 'next-line) (define-key wordstar-mode-map "\C-y" 'kill-complete-line) (define-key wordstar-mode-map "\C-z" 'scroll-up-line) ;; wordstar-C-k-map (define-key wordstar-C-k-map " " ()) (define-key wordstar-C-k-map "0" 'ws-set-marker-0) (define-key wordstar-C-k-map "1" 'ws-set-marker-1) (define-key wordstar-C-k-map "2" 'ws-set-marker-2) (define-key wordstar-C-k-map "3" 'ws-set-marker-3) (define-key wordstar-C-k-map "4" 'ws-set-marker-4) (define-key wordstar-C-k-map "5" 'ws-set-marker-5) (define-key wordstar-C-k-map "6" 'ws-set-marker-6) (define-key wordstar-C-k-map "7" 'ws-set-marker-7) (define-key wordstar-C-k-map "8" 'ws-set-marker-8) (define-key wordstar-C-k-map "9" 'ws-set-marker-9) (define-key wordstar-C-k-map "b" 'ws-begin-block) (define-key wordstar-C-k-map "\C-b" 'ws-begin-block) (define-key wordstar-C-k-map "c" 'ws-copy-block) (define-key wordstar-C-k-map "\C-c" 'ws-copy-block) (define-key wordstar-C-k-map "d" 'save-buffers-kill-emacs) (define-key wordstar-C-k-map "\C-d" 'save-buffers-kill-emacs) (define-key wordstar-C-k-map "f" 'find-file) (define-key wordstar-C-k-map "\C-f" 'find-file) (define-key wordstar-C-k-map "h" 'ws-show-markers) (define-key wordstar-C-k-map "\C-h" 'ws-show-markers) (define-key wordstar-C-k-map "i" 'ws-indent-block) (define-key wordstar-C-k-map "\C-i" 'ws-indent-block) (define-key wordstar-C-k-map "k" 'ws-end-block) (define-key wordstar-C-k-map "\C-k" 'ws-end-block) (define-key wordstar-C-k-map "p" 'ws-print-block) (define-key wordstar-C-k-map "\C-p" 'ws-print-block) (define-key wordstar-C-k-map "q" 'kill-emacs) (define-key wordstar-C-k-map "\C-q" 'kill-emacs) (define-key wordstar-C-k-map "r" 'insert-file) (define-key wordstar-C-k-map "\C-r" 'insert-file) (define-key wordstar-C-k-map "s" 'save-some-buffers) (define-key wordstar-C-k-map "\C-s" 'save-some-buffers) (define-key wordstar-C-k-map "t" 'ws-mark-word) (define-key wordstar-C-k-map "\C-t" 'ws-mark-word) (define-key wordstar-C-k-map "u" 'ws-exdent-block) (define-key wordstar-C-k-map "\C-u" 'keyboard-quit) (define-key wordstar-C-k-map "v" 'ws-move-block) (define-key wordstar-C-k-map "\C-v" 'ws-move-block) (define-key wordstar-C-k-map "w" 'ws-write-block) (define-key wordstar-C-k-map "\C-w" 'ws-write-block) (define-key wordstar-C-k-map "x" 'save-buffers-kill-emacs) (define-key wordstar-C-k-map "\C-x" 'save-buffers-kill-emacs) (define-key wordstar-C-k-map "y" 'ws-delete-block) (define-key wordstar-C-k-map "\C-y" 'ws-delete-block) ;; wordstar-C-j-map not yet implemented ;; wordstar-C-o-map (define-key wordstar-C-o-map " " ()) (define-key wordstar-C-o-map "c" 'wordstar-center-line) (define-key wordstar-C-o-map "\C-c" 'wordstar-center-line) (define-key wordstar-C-o-map "b" 'switch-to-buffer) (define-key wordstar-C-o-map "\C-b" 'switch-to-buffer) (define-key wordstar-C-o-map "j" 'justify-current-line) (define-key wordstar-C-o-map "\C-j" 'justify-current-line) (define-key wordstar-C-o-map "k" 'kill-buffer) (define-key wordstar-C-o-map "\C-k" 'kill-buffer) (define-key wordstar-C-o-map "l" 'list-buffers) (define-key wordstar-C-o-map "\C-l" 'list-buffers) (define-key wordstar-C-o-map "m" 'auto-fill-mode) (define-key wordstar-C-o-map "\C-m" 'auto-fill-mode) (define-key wordstar-C-o-map "r" 'set-fill-column) (define-key wordstar-C-o-map "\C-r" 'set-fill-column) (define-key wordstar-C-o-map "\C-u" 'keyboard-quit) (define-key wordstar-C-o-map "wd" 'delete-other-windows) (define-key wordstar-C-o-map "wh" 'split-window-horizontally) (define-key wordstar-C-o-map "wo" 'other-window) (define-key wordstar-C-o-map "wv" 'split-window-vertically) ;; wordstar-C-q-map (define-key wordstar-C-q-map " " ()) (define-key wordstar-C-q-map "0" 'ws-find-marker-0) (define-key wordstar-C-q-map "1" 'ws-find-marker-1) (define-key wordstar-C-q-map "2" 'ws-find-marker-2) (define-key wordstar-C-q-map "3" 'ws-find-marker-3) (define-key wordstar-C-q-map "4" 'ws-find-marker-4) (define-key wordstar-C-q-map "5" 'ws-find-marker-5) (define-key wordstar-C-q-map "6" 'ws-find-marker-6) (define-key wordstar-C-q-map "7" 'ws-find-marker-7) (define-key wordstar-C-q-map "8" 'ws-find-marker-8) (define-key wordstar-C-q-map "9" 'ws-find-marker-9) (define-key wordstar-C-q-map "a" 'ws-query-replace) (define-key wordstar-C-q-map "\C-a" 'ws-query-replace) (define-key wordstar-C-q-map "b" 'ws-goto-block-begin) (define-key wordstar-C-q-map "\C-b" 'ws-goto-block-begin) (define-key wordstar-C-q-map "c" 'end-of-buffer) (define-key wordstar-C-q-map "\C-c" 'end-of-buffer) (define-key wordstar-C-q-map "d" 'end-of-line) (define-key wordstar-C-q-map "\C-d" 'end-of-line) (define-key wordstar-C-q-map "f" 'ws-search) (define-key wordstar-C-q-map "\C-f" 'ws-search) (define-key wordstar-C-q-map "k" 'ws-goto-block-end) (define-key wordstar-C-q-map "\C-k" 'ws-goto-block-end) (define-key wordstar-C-q-map "l" 'ws-undo) (define-key wordstar-C-q-map "\C-l" 'ws-undo) (define-key wordstar-C-q-map "p" 'ws-last-cursorp) (define-key wordstar-C-q-map "\C-p" 'ws-last-cursorp) (define-key wordstar-C-q-map "r" 'beginning-of-buffer) (define-key wordstar-C-q-map "\C-r" 'beginning-of-buffer) (define-key wordstar-C-q-map "s" 'beginning-of-line) (define-key wordstar-C-q-map "\C-s" 'beginning-of-line) (define-key wordstar-C-q-map "\C-u" 'keyboard-quit) (define-key wordstar-C-q-map "w" 'ws-last-error) (define-key wordstar-C-q-map "\C-w" 'ws-last-error) (define-key wordstar-C-q-map "y" 'ws-kill-eol) (define-key wordstar-C-q-map "\C-y" 'ws-kill-eol) (define-key wordstar-C-q-map "\177" 'ws-kill-bol)) ;;;###autoload (defun wordstar-mode () "Major mode with WordStar-like key bindings. BUGS: - Help menus with WordStar commands (C-j just calls help-for-help) are not implemented - Options for search and replace - Show markers (C-k h) is somewhat strange - Search and replace (C-q a) is only available in forward direction No key bindings beginning with ESC are installed, they will work Emacs-like. The key bindings are: C-a backward-word C-b fill-paragraph C-c scroll-up-line C-d forward-char C-e previous-line C-f forward-word C-g delete-char C-h backward-char C-i indent-for-tab-command C-j help-for-help C-k ordstar-C-k-map C-l ws-repeat-search C-n open-line C-p quoted-insert C-r scroll-down-line C-s backward-char C-t kill-word C-u keyboard-quit C-v overwrite-mode C-w scroll-down C-x next-line C-y kill-complete-line C-z scroll-up C-k 0 ws-set-marker-0 C-k 1 ws-set-marker-1 C-k 2 ws-set-marker-2 C-k 3 ws-set-marker-3 C-k 4 ws-set-marker-4 C-k 5 ws-set-marker-5 C-k 6 ws-set-marker-6 C-k 7 ws-set-marker-7 C-k 8 ws-set-marker-8 C-k 9 ws-set-marker-9 C-k b ws-begin-block C-k c ws-copy-block C-k d save-buffers-kill-emacs C-k f find-file C-k h ws-show-markers C-k i ws-indent-block C-k k ws-end-block C-k p ws-print-block C-k q kill-emacs C-k r insert-file C-k s save-some-buffers C-k t ws-mark-word C-k u ws-exdent-block C-k C-u keyboard-quit C-k v ws-move-block C-k w ws-write-block C-k x kill-emacs C-k y ws-delete-block C-o c wordstar-center-line C-o b switch-to-buffer C-o j justify-current-line C-o k kill-buffer C-o l list-buffers C-o m auto-fill-mode C-o r set-fill-column C-o C-u keyboard-quit C-o wd delete-other-windows C-o wh split-window-horizontally C-o wo other-window C-o wv split-window-vertically C-q 0 ws-find-marker-0 C-q 1 ws-find-marker-1 C-q 2 ws-find-marker-2 C-q 3 ws-find-marker-3 C-q 4 ws-find-marker-4 C-q 5 ws-find-marker-5 C-q 6 ws-find-marker-6 C-q 7 ws-find-marker-7 C-q 8 ws-find-marker-8 C-q 9 ws-find-marker-9 C-q a ws-query-replace C-q b ws-to-block-begin C-q c end-of-buffer C-q d end-of-line C-q f ws-search C-q k ws-to-block-end C-q l ws-undo C-q p ws-last-cursorp C-q r beginning-of-buffer C-q C-u keyboard-quit C-q w ws-last-error C-q y ws-kill-eol C-q DEL ws-kill-bol " (interactive) (kill-all-local-variables) (use-local-map wordstar-mode-map) (setq mode-name "WordStar") (setq major-mode 'wordstar-mode)) (defun wordstar-center-paragraph () "Center each line in the paragraph at or after point. See `wordstar-center-line' for more info." (interactive) (save-excursion (forward-paragraph) (or (bolp) (newline 1)) (let ((end (point))) (backward-paragraph) (wordstar-center-region (point) end)))) (defun wordstar-center-region (from to) "Center each line starting in the region. See `wordstar-center-line' for more info." (interactive "r") (if (> from to) (let ((tem to)) (setq to from from tem))) (save-excursion (save-restriction (narrow-to-region from to) (goto-char from) (while (not (eobp)) (wordstar-center-line) (forward-line 1))))) (defun wordstar-center-line () "Center the line point is on, within the width specified by `fill-column'. This means adjusting the indentation to match the distance between the end of the text and `fill-column'." (interactive) (save-excursion (let (line-length) (beginning-of-line) (delete-horizontal-space) (end-of-line) (delete-horizontal-space) (setq line-length (current-column)) (beginning-of-line) (indent-to (+ left-margin (/ (- fill-column left-margin line-length) 2)))))) (defun scroll-down-line () "Scroll one line down." (interactive) (scroll-down 1)) (defun scroll-up-line () "Scroll one line up." (interactive) (scroll-up 1)) ;;;;;;;;;;; ;; wordstar special variables: (defvar ws-marker-0 nil "Position marker 0 in WordStar mode.") (defvar ws-marker-1 nil "Position marker 1 in WordStar mode.") (defvar ws-marker-2 nil "Position marker 2 in WordStar mode.") (defvar ws-marker-3 nil "Position marker 3 in WordStar mode.") (defvar ws-marker-4 nil "Position marker 4 in WordStar mode.") (defvar ws-marker-5 nil "Position marker 5 in WordStar mode.") (defvar ws-marker-6 nil "Position marker 6 in WordStar mode.") (defvar ws-marker-7 nil "Position marker 7 in WordStar mode.") (defvar ws-marker-8 nil "Position marker 8 in WordStar mode.") (defvar ws-marker-9 nil "Position marker 9 in WordStar mode.") (defvar ws-block-begin-marker nil "Beginning of \"Block\" in WordStar mode.") (defvar ws-block-end-marker nil "End of \"Block\" in WordStar mode.") (defvar ws-search-string nil "String of last search in WordStar mode.") (defvar ws-search-direction t "Direction of last search in WordStar mode. T if forward, NIL if backward.") (defvar ws-last-cursorposition nil "Position before last search etc. in WordStar mode.") (defvar ws-last-errormessage nil "Last error message issued by a WordStar mode function.") ;;;;;;;;;;; ;; wordstar special functions: (defun ws-error (string) "Report error of a WordStar special function. Error message is saved in ws-last-errormessage for recovery with C-q w." (setq ws-last-errormessage string) (error string)) (defun ws-set-marker-0 () "In WordStar mode: Set marker 0 to current cursor position." (interactive) (setq ws-marker-0 (point-marker)) (message "Marker 0 set")) (defun ws-set-marker-1 () "In WordStar mode: Set marker 1 to current cursor position." (interactive) (setq ws-marker-1 (point-marker)) (message "Marker 1 set")) (defun ws-set-marker-2 () "In WordStar mode: Set marker 2 to current cursor position." (interactive) (setq ws-marker-2 (point-marker)) (message "Marker 2 set")) (defun ws-set-marker-3 () "In WordStar mode: Set marker 3 to current cursor position." (interactive) (setq ws-marker-3 (point-marker)) (message "Marker 3 set")) (defun ws-set-marker-4 () "In WordStar mode: Set marker 4 to current cursor position." (interactive) (setq ws-marker-4 (point-marker)) (message "Marker 4 set")) (defun ws-set-marker-5 () "In WordStar mode: Set marker 5 to current cursor position." (interactive) (setq ws-marker-5 (point-marker)) (message "Marker 5 set")) (defun ws-set-marker-6 () "In WordStar mode: Set marker 6 to current cursor position." (interactive) (setq ws-marker-6 (point-marker)) (message "Marker 6 set")) (defun ws-set-marker-7 () "In WordStar mode: Set marker 7 to current cursor position." (interactive) (setq ws-marker-7 (point-marker)) (message "Marker 7 set")) (defun ws-set-marker-8 () "In WordStar mode: Set marker 8 to current cursor position." (interactive) (setq ws-marker-8 (point-marker)) (message "Marker 8 set")) (defun ws-set-marker-9 () "In WordStar mode: Set marker 9 to current cursor position." (interactive) (setq ws-marker-9 (point-marker)) (message "Marker 9 set")) (defun ws-begin-block () "In WordStar mode: Set block begin marker to current cursor position." (interactive) (setq ws-block-begin-marker (point-marker)) (message "Block begin marker set")) (defun ws-show-markers () "In WordStar mode: Show block markers." (interactive) (if (or ws-block-begin-marker ws-block-end-marker) (save-excursion (if ws-block-begin-marker (let () (goto-char ws-block-begin-marker) (message "Block begin marker") (sit-for 2)) (message "Block begin marker not set") (sit-for 2)) (if ws-block-end-marker (let () (goto-char ws-block-end-marker) (message "Block end marker") (sit-for 2)) (message "Block end marker not set")) (message "")) (message "Block markers not set"))) (defun ws-indent-block () "In WordStar mode: Indent block (not yet implemented)." (interactive) (ws-error "Indent block not yet implemented")) (defun ws-end-block () "In WordStar mode: Set block end marker to current cursor position." (interactive) (setq ws-block-end-marker (point-marker)) (message "Block end marker set")) (defun ws-print-block () "In WordStar mode: Print block." (interactive) (message "Don't do this. Write block to a file (C-k w) and print this file.")) (defun ws-mark-word () "In WordStar mode: Mark current word as block." (interactive) (save-excursion (forward-word 1) (sit-for 1) (ws-end-block) (forward-word -1) (sit-for 1) (ws-begin-block))) (defun ws-exdent-block () "I don't know what this (C-k u) should do." (interactive) (ws-error "This won't be done -- not yet implemented.")) (defun ws-move-block () "In WordStar mode: Move block to current cursor position." (interactive) (if (and ws-block-begin-marker ws-block-end-marker) (let () (kill-region ws-block-begin-marker ws-block-end-marker) (yank) (save-excursion (goto-char (region-beginning)) (setq ws-block-begin-marker (point-marker)) (goto-char (region-end)) (setq ws-block-end-marker (point-marker)))) (ws-error (cond (ws-block-begin-marker "Block end marker not set") (ws-block-end-marker "Block begin marker not set") (t "Block markers not set"))))) (defun ws-write-block () "In WordStar mode: Write block to file." (interactive) (if (and ws-block-begin-marker ws-block-end-marker) (let ((filename (read-file-name "Write block to file: "))) (write-region ws-block-begin-marker ws-block-end-marker filename)) (ws-error (cond (ws-block-begin-marker "Block end marker not set") (ws-block-end-marker "Block begin marker not set") (t "Block markers not set"))))) (defun ws-delete-block () "In WordStar mode: Delete block." (interactive) (if (and ws-block-begin-marker ws-block-end-marker) (let () (kill-region ws-block-begin-marker ws-block-end-marker) (setq ws-block-end-marker nil) (setq ws-block-begin-marker nil)) (ws-error (cond (ws-block-begin-marker "Block end marker not set") (ws-block-end-marker "Block begin marker not set") (t "Block markers not set"))))) (defun ws-find-marker-0 () "In WordStar mode: Go to marker 0." (interactive) (if ws-marker-0 (let () (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-0)) (ws-error "Marker 0 not set"))) (defun ws-find-marker-1 () "In WordStar mode: Go to marker 1." (interactive) (if ws-marker-1 (let () (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-1)) (ws-error "Marker 1 not set"))) (defun ws-find-marker-2 () "In WordStar mode: Go to marker 2." (interactive) (if ws-marker-2 (let () (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-2)) (ws-error "Marker 2 not set"))) (defun ws-find-marker-3 () "In WordStar mode: Go to marker 3." (interactive) (if ws-marker-3 (let () (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-3)) (ws-error "Marker 3 not set"))) (defun ws-find-marker-4 () "In WordStar mode: Go to marker 4." (interactive) (if ws-marker-4 (let () (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-4)) (ws-error "Marker 4 not set"))) (defun ws-find-marker-5 () "In WordStar mode: Go to marker 5." (interactive) (if ws-marker-5 (let () (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-5)) (ws-error "Marker 5 not set"))) (defun ws-find-marker-6 () "In WordStar mode: Go to marker 6." (interactive) (if ws-marker-6 (let () (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-6)) (ws-error "Marker 6 not set"))) (defun ws-find-marker-7 () "In WordStar mode: Go to marker 7." (interactive) (if ws-marker-7 (let () (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-7)) (ws-error "Marker 7 not set"))) (defun ws-find-marker-8 () "In WordStar mode: Go to marker 8." (interactive) (if ws-marker-8 (let () (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-8)) (ws-error "Marker 8 not set"))) (defun ws-find-marker-9 () "In WordStar mode: Go to marker 9." (interactive) (if ws-marker-9 (let () (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-9)) (ws-error "Marker 9 not set"))) (defun ws-goto-block-begin () "In WordStar mode: Go to block begin marker." (interactive) (if ws-block-begin-marker (let () (setq ws-last-cursorposition (point-marker)) (goto-char ws-block-begin-marker)) (ws-error "Block begin marker not set"))) (defun ws-search (string) "In WordStar mode: Search string, remember string for repetition." (interactive "sSearch for: ") (message "Forward (f) or backward (b)") (let ((direction (read-char))) (cond ((equal (upcase direction) ?F) (setq ws-search-string string) (setq ws-search-direction t) (setq ws-last-cursorposition (point-marker)) (search-forward string)) ((equal (upcase direction) ?B) (setq ws-search-string string) (setq ws-search-direction nil) (setq ws-last-cursorposition (point-marker)) (search-backward string)) (t (keyboard-quit))))) (defun ws-goto-block-end () "In WordStar mode: Go to block end marker." (interactive) (if ws-block-end-marker (let () (setq ws-last-cursorposition (point-marker)) (goto-char ws-block-end-marker)) (ws-error "Block end marker not set"))) (defun ws-undo () "In WordStar mode: Undo and give message about undoing more changes." (interactive) (undo) (message "Repeat C-q l to undo more changes.")) (defun ws-goto-last-cursorposition () "In WordStar mode: " (interactive) (if ws-last-cursorposition (let () (setq ws-last-cursorposition (point-marker)) (goto-char ws-last-cursorposition)) (ws-error "No last cursor position available."))) (defun ws-last-error () "In WordStar mode: repeat last error message. This will only work for errors raised by WordStar mode functions." (interactive) (if ws-last-errormessage (message ws-last-errormessage) (message "No WordStar error yet."))) (defun ws-kill-eol () "In WordStar mode: Kill to end of line (like WordStar, not like Emacs)." (interactive) (let ((p (point))) (end-of-line) (kill-region p (point)))) (defun ws-kill-bol () "In WordStar mode: Kill to beginning of line \(like WordStar, not like Emacs)." (interactive) (let ((p (point))) (beginning-of-line) (kill-region (point) p))) (defun kill-complete-line () "Kill the complete line." (interactive) (beginning-of-line) (if (eobp) (error "End of buffer")) (let ((beg (point))) (forward-line 1) (kill-region beg (point)))) (defun ws-repeat-search () "In WordStar mode: Repeat last search." (interactive) (setq ws-last-cursorposition (point-marker)) (if ws-search-string (if ws-search-direction (search-forward ws-search-string) (search-backward ws-search-string)) (ws-error "No search to repeat"))) (defun ws-query-replace (from to) "In WordStar mode: Search string, remember string for repetition." (interactive "sReplace: sWith: " ) (setq ws-search-string from) (setq ws-search-direction t) (setq ws-last-cursorposition (point-marker)) (query-replace from to)) (defun ws-copy-block () "In WordStar mode: Copy block to current cursor position." (interactive) (if (and ws-block-begin-marker ws-block-end-marker) (let () (copy-region-as-kill ws-block-begin-marker ws-block-end-marker) (yank) (save-excursion (goto-char (region-beginning)) (setq ws-block-begin-marker (point-marker)) (goto-char (region-end)) (setq ws-block-end-marker (point-marker)))) (ws-error (cond (ws-block-begin-marker "Block end marker not set") (ws-block-end-marker "Block begin marker not set") (t "Block markers not set"))))) ;;; ws-mode.el ends here emacs-19.30/lisp/x-apollo.el100444 75424 12 7156 5754776554 14251 0ustar kwzhstaff;;; x-apollo.el --- Apollo support functions ;; Copyright (C) 1995 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. ;;; Code: (defun apollo-kill-entire-line () "Kill the entire line containing point." (interactive) (beginning-of-line) (kill-line 1)) (defun apollo-scroll-window-right () "Scroll window to right ten columns." (interactive) (scroll-left 10)) (defun apollo-scroll-window-left () "Scroll window to left ten columns." (interactive) (scroll-right 10)) (defun apollo-scroll-window-forward-line () "Move window forward one line leaving cursor at position in window." (interactive) (scroll-up 1)) (defun apollo-scroll-window-backward-line () "Move window backward one line leaving cursor at position in window." (interactive) (scroll-down 1)) ;;; Define and Enable the Function Key Bindings. (global-set-key [S-tab] "\C-i") ;Shift TAB (global-set-key [C-tab] "\C-i") ;Control TAB (global-set-key [S-return] "\C-m") ;Shift RET (global-set-key [C-return] "\C-m") ;Control RET (global-set-key [linedel] 'apollo-kill-entire-line) ;LINE DEL (global-set-key [chardel] 'delete-char) ;CHAR DEL (global-set-key [leftbar] 'beginning-of-line) ;LEFT BAR ARROW (global-set-key [rightbar] 'end-of-line) ;RIGHT BAR ARROW (global-set-key [leftbox] 'apollo-scroll-window-left) ;LEFT BOX ARROW (global-set-key [rightbox] 'apollo-scroll-window-right) ;RIGHT BOX ARROW (global-set-key [S-up] 'apollo-scroll-window-backward-line) ;Shift UP ARROW (global-set-key [S-down] 'apollo-scroll-window-forward-line) ;Shift DOWN ARROW (global-set-key [select] 'set-mark-command) ;MARK (global-set-key [S-insert] 'overwrite-mode) ;INS MODE (global-set-key [S-linedel] 'yank) ;Shift LINE DEL (global-set-key [S-chardel] 'delete-char) ;Shift CHAR DEL (global-set-key [copy] 'copy-region-as-kill) ;COPY (global-set-key [S-cut] 'kill-region) ;CUT (global-set-key [paste] 'yank) ;PASTE (global-set-key [S-undo] 'undo) ;UNDO (global-set-key [S-left] 'backward-word) ;Shift LEFT ARROW (global-set-key [S-right] 'forward-word) ;Shift RIGHT ARROW (global-set-key [upbox] 'scroll-down) ;UP BOX ARROW (global-set-key [S-upbox] 'beginning-of-buffer) ;Shift UP BOX ARROW (global-set-key [downbox] 'scroll-up) ;DOWN BOX ARROW (global-set-key [S-downbox] 'end-of-buffer) ;Shift DOWN BOX ARROW (global-set-key [S-redo] 'toggle-read-only) ;Shift AGAIN (global-set-key [exit] 'save-buffer) ;EXIT (global-set-key [S-cancel] 'kill-buffer) ;ABORT (global-set-key [S-save] 'save-buffer) ;SAVE (global-set-key [S-leftbar] 'beginning-of-buffer) ;Shift LEFT BAR ARROW (global-set-key [cmd] 'execute-extended-command) ;CMD (global-set-key [S-rightbar] 'end-of-buffer) ;Shift RIGHT BAR ARROW (global-set-key [next] 'other-window) ;NEXT WNDW (global-set-key [S-next] 'delete-window) ;Shift NEXT WNDW (global-set-key [read] 'find-file-read-only) ;READ (global-set-key [edit] 'find-file) ;EDIT (global-set-key [S-shell] 'shell) ;SHELL (global-set-key [S-help] 'manual-entry) ;HELP emacs-19.30/lisp/x-menu.el100444 12120 1 11742 6017704673 13641 0ustar rmsdaemon;;; x-menu.el --- menu support for X ;; Copyright (C) 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 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: (defun x-menu-mode () "Major mode for creating permanent menus for use with X. These menus are implemented entirely in Lisp; popup menus, implemented with x-popup-menu, are implemented using XMenu primitives." (make-local-variable 'x-menu-items-per-line) (make-local-variable 'x-menu-item-width) (make-local-variable 'x-menu-items-alist) (make-local-variable 'x-process-mouse-hook) (make-local-variable 'x-menu-assoc-buffer) (setq buffer-read-only t) (setq truncate-lines t) (setq x-process-mouse-hook 'x-menu-pick-entry) (setq mode-line-buffer-identification '("MENU: %32b"))) (defvar x-menu-max-width 0) (defvar x-menu-items-per-line 0) (defvar x-menu-item-width 0) (defvar x-menu-items-alist nil) (defvar x-menu-assoc-buffer nil) (defvar x-menu-item-spacing 1 "*Minimum horizontal spacing between objects in a permanent X menu.") (defun x-menu-create-menu (name) "Create a permanent X menu. Returns an item which should be used as a menu object whenever referring to the menu." (let ((old (current-buffer)) (buf (get-buffer-create name))) (set-buffer buf) (x-menu-mode) (setq x-menu-assoc-buffer old) (set-buffer old) buf)) (defun x-menu-change-associated-buffer (menu buffer) "Change associated buffer of MENU to BUFFER. BUFFER should be a buffer object." (let ((old (current-buffer))) (set-buffer menu) (setq x-menu-assoc-buffer buffer) (set-buffer old))) (defun x-menu-add-item (menu item binding) "Add to MENU an item with name ITEM, associated with BINDING. Following a sequence of calls to x-menu-add-item, a call to x-menu-compute should be performed before the menu will be made available to the user. BINDING should be a function of one argument, which is the numerical button/key code as defined in x-menu.el." (let ((old (current-buffer)) elt) (set-buffer menu) (if (setq elt (assoc item x-menu-items-alist)) (rplacd elt binding) (setq x-menu-items-alist (append x-menu-items-alist (list (cons item binding))))) (set-buffer old) item)) (defun x-menu-delete-item (menu item) "Delete from MENU the item named ITEM. Call `x-menu-compute' before making the menu available to the user." (let ((old (current-buffer)) elt) (set-buffer menu) (if (setq elt (assoc item x-menu-items-alist)) (rplaca elt nil)) (set-buffer old) item)) (defun x-menu-activate (menu) "Compute all necessary parameters for MENU. This must be called whenever a menu is modified before it is made available to the user. This also creates the menu itself." (let ((buf (current-buffer))) (pop-to-buffer menu) (let (buffer-read-only) (setq x-menu-max-width (1- (frame-width))) (setq x-menu-item-width 0) (let (items-head (items-tail x-menu-items-alist)) (while items-tail (if (car (car items-tail)) (progn (setq items-head (cons (car items-tail) items-head)) (setq x-menu-item-width (max x-menu-item-width (length (car (car items-tail))))))) (setq items-tail (cdr items-tail))) (setq x-menu-items-alist (reverse items-head))) (setq x-menu-item-width (+ x-menu-item-spacing x-menu-item-width)) (setq x-menu-items-per-line (max 1 (/ x-menu-max-width x-menu-item-width))) (erase-buffer) (let ((items-head x-menu-items-alist)) (while items-head (let ((items 0)) (while (and items-head (<= (setq items (1+ items)) x-menu-items-per-line)) (insert (format (concat "%" (int-to-string x-menu-item-width) "s") (car (car items-head)))) (setq items-head (cdr items-head)))) (insert ?\n))) (shrink-window (max 0 (- (window-height) (1+ (count-lines (point-min) (point-max)))))) (goto-char (point-min))) (pop-to-buffer buf))) (defun x-menu-pick-entry (position event) "Internal function for dispatching on mouse/menu events" (let* ((x (min (1- x-menu-items-per-line) (/ (current-column) x-menu-item-width))) (y (- (count-lines (point-min) (point)) (if (zerop (current-column)) 0 1))) (item (+ x (* y x-menu-items-per-line))) (litem (cdr (nth item x-menu-items-alist)))) (and litem (funcall litem event))) (pop-to-buffer x-menu-assoc-buffer)) ;;; x-menu.el ends here emacs-19.30/lisp/xscheme.el100444 12120 1 74526 6014401415 14056 0ustar rmsdaemon;;; xscheme.el --- run Scheme under Emacs ;; Copyright (C) 1986, 1987, 1989, 1990 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: languages, lisp ;; 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: ;; A major mode for editing Scheme and interacting with MIT's C-Scheme. ;; ;; Requires C-Scheme release 5 or later ;; Changes to Control-G handler require runtime version 13.85 or later ;;; Code: (require 'scheme) (defvar scheme-program-name "scheme" "*Program invoked by the `run-scheme' command.") (defvar scheme-band-name nil "*Band loaded by the `run-scheme' command.") (defvar scheme-program-arguments nil "*Arguments passed to the Scheme program by the `run-scheme' command.") (defvar xscheme-allow-pipelined-evaluation t "If non-nil, an expression may be transmitted while another is evaluating. Otherwise, attempting to evaluate an expression before the previous expression has finished evaluating will signal an error.") (defvar xscheme-startup-message "This is the Scheme process buffer. Type \\[advertised-xscheme-send-previous-expression] to evaluate the expression before point. Type \\[xscheme-send-control-g-interrupt] to abort evaluation. Type \\[describe-mode] for more information. " "String to insert into Scheme process buffer first time it is started. Is processed with `substitute-command-keys' first.") (defvar xscheme-signal-death-message nil "If non-nil, causes a message to be generated when the Scheme process dies.") (defun xscheme-evaluation-commands (keymap) (define-key keymap "\e\C-x" 'xscheme-send-definition) (define-key keymap "\C-x\C-e" 'advertised-xscheme-send-previous-expression) (define-key keymap "\eo" 'xscheme-send-buffer) (define-key keymap "\ez" 'xscheme-send-definition) (define-key keymap "\e\C-m" 'xscheme-send-previous-expression) (define-key keymap "\e\C-z" 'xscheme-send-region)) (defun xscheme-interrupt-commands (keymap) (define-key keymap "\C-c\C-s" 'xscheme-select-process-buffer) (define-key keymap "\C-c\C-b" 'xscheme-send-breakpoint-interrupt) (define-key keymap "\C-c\C-c" 'xscheme-send-control-g-interrupt) (define-key keymap "\C-c\C-u" 'xscheme-send-control-u-interrupt) (define-key keymap "\C-c\C-x" 'xscheme-send-control-x-interrupt)) (xscheme-evaluation-commands scheme-mode-map) (xscheme-interrupt-commands scheme-mode-map) (defun run-scheme (command-line) "Run MIT Scheme in an inferior process. Output goes to the buffer `*scheme*'. With argument, asks for a command line." (interactive (list (let ((default (or xscheme-process-command-line (xscheme-default-command-line)))) (if current-prefix-arg (read-string "Run Scheme: " default) default)))) (setq xscheme-process-command-line command-line) (pop-to-buffer (xscheme-start-process command-line))) (defun reset-scheme () "Reset the Scheme process." (interactive) (let ((process (get-process "scheme"))) (cond ((or (not process) (not (eq (process-status process) 'run)) (yes-or-no-p "The Scheme process is running, are you SURE you want to reset it? ")) (message "Resetting Scheme process...") (if process (kill-process process t)) (xscheme-start-process xscheme-process-command-line) (message "Resetting Scheme process...done"))))) (defun xscheme-default-command-line () (concat scheme-program-name " -emacs" (if scheme-program-arguments (concat " " scheme-program-arguments) "") (if scheme-band-name (concat " -band " scheme-band-name) ""))) ;;;; Interaction Mode (defun scheme-interaction-mode () "Major mode for interacting with the inferior Scheme process. Like scheme-mode except that: \\[advertised-xscheme-send-previous-expression] sends the expression before point to the Scheme process as input \\[xscheme-yank-previous-send] yanks the expression most recently sent to Scheme All output from the Scheme process is written in the Scheme process buffer, which is initially named \"*scheme*\". The result of evaluating a Scheme expression is also printed in the process buffer, preceded by the string \";Value: \" to highlight it. If the process buffer is not visible at that time, the value will also be displayed in the minibuffer. If an error occurs, the process buffer will automatically pop up to show you the error message. While the Scheme process is running, the modelines of all buffers in scheme-mode are modified to show the state of the process. The possible states and their meanings are: input waiting for input run evaluating gc garbage collecting The process buffer's modeline contains additional information where the buffer's name is normally displayed: the command interpreter level and type. Scheme maintains a stack of command interpreters. Every time an error or breakpoint occurs, the current command interpreter is pushed on the command interpreter stack, and a new command interpreter is started. One example of why this is done is so that an error that occurs while you are debugging another error will not destroy the state of the initial error, allowing you to return to it after the second error has been fixed. The command interpreter level indicates how many interpreters are in the command interpreter stack. It is initially set to one, and it is incremented every time that stack is pushed, and decremented every time it is popped. The following commands are useful for manipulating the command interpreter stack: \\[xscheme-send-breakpoint-interrupt] pushes the stack once \\[xscheme-send-control-u-interrupt] pops the stack once \\[xscheme-send-control-g-interrupt] pops everything off \\[xscheme-send-control-x-interrupt] aborts evaluation, doesn't affect stack Some possible command interpreter types and their meanings are: [Evaluator] read-eval-print loop for evaluating expressions [Debugger] single character commands for debugging errors [Where] single character commands for examining environments Starting with release 6.2 of Scheme, the latter two types of command interpreters will change the major mode of the Scheme process buffer to scheme-debugger-mode , in which the evaluation commands are disabled, and the keys which normally self insert instead send themselves to the Scheme process. The command character ? will list the available commands. For older releases of Scheme, the major mode will be be scheme-interaction-mode , and the command characters must be sent as if they were expressions. Commands: Delete converts tabs to spaces as it moves back. Blank lines separate paragraphs. Semicolons start comments. \\{scheme-interaction-mode-map} Entry to this mode calls the value of scheme-interaction-mode-hook with no args, if that value is non-nil. Likewise with the value of scheme-mode-hook. scheme-interaction-mode-hook is called after scheme-mode-hook." (interactive) (kill-all-local-variables) (scheme-interaction-mode-initialize) (scheme-mode-variables) (make-local-variable 'xscheme-previous-send) (run-hooks 'scheme-mode-hook 'scheme-interaction-mode-hook)) (defun scheme-interaction-mode-initialize () (use-local-map scheme-interaction-mode-map) (setq major-mode 'scheme-interaction-mode) (setq mode-name "Scheme Interaction")) (defun scheme-interaction-mode-commands (keymap) (define-key keymap "\C-c\C-m" 'xscheme-send-current-line) (define-key keymap "\C-c\C-p" 'xscheme-send-proceed) (define-key keymap "\C-c\C-y" 'xscheme-yank-previous-send)) (defvar scheme-interaction-mode-map nil) (if (not scheme-interaction-mode-map) (progn (setq scheme-interaction-mode-map (make-keymap)) (scheme-mode-commands scheme-interaction-mode-map) (xscheme-interrupt-commands scheme-interaction-mode-map) (xscheme-evaluation-commands scheme-interaction-mode-map) (scheme-interaction-mode-commands scheme-interaction-mode-map))) (defun xscheme-enter-interaction-mode () (save-excursion (set-buffer (xscheme-process-buffer)) (if (not (eq major-mode 'scheme-interaction-mode)) (if (eq major-mode 'scheme-debugger-mode) (scheme-interaction-mode-initialize) (scheme-interaction-mode))))) (fset 'advertised-xscheme-send-previous-expression 'xscheme-send-previous-expression) ;;;; Debugger Mode (defun scheme-debugger-mode () "Major mode for executing the Scheme debugger. Like scheme-mode except that the evaluation commands are disabled, and characters that would normally be self inserting are sent to the Scheme process instead. Typing ? will show you which characters perform useful functions. Commands: \\{scheme-debugger-mode-map}" (error "Illegal entry to scheme-debugger-mode")) (defun scheme-debugger-mode-initialize () (use-local-map scheme-debugger-mode-map) (setq major-mode 'scheme-debugger-mode) (setq mode-name "Scheme Debugger")) (defun scheme-debugger-mode-commands (keymap) (let ((char ? )) (while (< char 127) (define-key keymap (char-to-string char) 'scheme-debugger-self-insert) (setq char (1+ char))))) (defvar scheme-debugger-mode-map nil) (if (not scheme-debugger-mode-map) (progn (setq scheme-debugger-mode-map (make-keymap)) (scheme-mode-commands scheme-debugger-mode-map) (xscheme-interrupt-commands scheme-debugger-mode-map) (scheme-debugger-mode-commands scheme-debugger-mode-map))) (defun scheme-debugger-self-insert () "Transmit this character to the Scheme process." (interactive) (xscheme-send-char last-command-char)) (defun xscheme-enter-debugger-mode (prompt-string) (save-excursion (set-buffer (xscheme-process-buffer)) (if (not (eq major-mode 'scheme-debugger-mode)) (progn (if (not (eq major-mode 'scheme-interaction-mode)) (scheme-interaction-mode)) (scheme-debugger-mode-initialize))))) (defun xscheme-debugger-mode-p () (let ((buffer (xscheme-process-buffer))) (and buffer (save-excursion (set-buffer buffer) (eq major-mode 'scheme-debugger-mode))))) ;;;; Evaluation Commands (defun xscheme-send-string (&rest strings) "Send the string arguments to the Scheme process. The strings are concatenated and terminated by a newline." (cond ((not (xscheme-process-running-p)) (if (yes-or-no-p "The Scheme process has died. Reset it? ") (progn (reset-scheme) (xscheme-wait-for-process) (goto-char (point-max)) (apply 'insert-before-markers strings) (xscheme-send-string-1 strings)))) ((xscheme-debugger-mode-p) (error "No sends allowed in debugger mode")) ((and (not xscheme-allow-pipelined-evaluation) xscheme-running-p) (error "No sends allowed while Scheme running")) (t (xscheme-send-string-1 strings)))) (defun xscheme-send-string-1 (strings) (let ((string (apply 'concat strings))) (xscheme-send-string-2 string) (if (eq major-mode 'scheme-interaction-mode) (setq xscheme-previous-send string)))) (defun xscheme-send-string-2 (string) (let ((process (get-process "scheme"))) (send-string process (concat string "\n")) (if (xscheme-process-buffer-current-p) (set-marker (process-mark process) (point))))) (defun xscheme-yank-previous-send () "Insert the most recent expression at point." (interactive) (push-mark) (insert xscheme-previous-send)) (defun xscheme-select-process-buffer () "Select the Scheme process buffer and move to its output point." (interactive) (let ((process (or (get-process "scheme") (error "No scheme process")))) (let ((buffer (or (process-buffer process) (error "No process buffer")))) (let ((window (get-buffer-window buffer))) (if window (select-window window) (switch-to-buffer buffer)) (goto-char (process-mark process)))))) (defun xscheme-send-region (start end) "Send the current region to the Scheme process. The region is sent terminated by a newline." (interactive "r") (if (xscheme-process-buffer-current-p) (progn (goto-char end) (set-marker (process-mark (get-process "scheme")) end))) (xscheme-send-string (buffer-substring start end))) (defun xscheme-send-definition () "Send the current definition to the Scheme process. If the current line begins with a non-whitespace character, parse an expression from the beginning of the line and send that instead." (interactive) (let ((start nil) (end nil)) (save-excursion (end-of-defun) (setq end (point)) (if (re-search-backward "^\\s(" nil t) (setq start (point)) (error "Can't find definition"))) (xscheme-send-region start end))) (defun xscheme-send-next-expression () "Send the expression to the right of `point' to the Scheme process." (interactive) (let ((start (point))) (xscheme-send-region start (save-excursion (forward-sexp) (point))))) (defun xscheme-send-previous-expression () "Send the expression to the left of `point' to the Scheme process." (interactive) (let ((end (point))) (xscheme-send-region (save-excursion (backward-sexp) (point)) end))) (defun xscheme-send-current-line () "Send the current line to the Scheme process. Useful for working with debugging Scheme under adb." (interactive) (let ((line (save-excursion (beginning-of-line) (let ((start (point))) (end-of-line) (buffer-substring start (point)))))) (end-of-line) (insert ?\n) (xscheme-send-string-2 line))) (defun xscheme-send-buffer () "Send the current buffer to the Scheme process." (interactive) (if (xscheme-process-buffer-current-p) (error "Not allowed to send this buffer's contents to Scheme")) (xscheme-send-region (point-min) (point-max))) (defun xscheme-send-char (char) "Prompt for a character and send it to the Scheme process." (interactive "cCharacter to send: ") (send-string "scheme" (char-to-string char))) ;;;; Interrupts (defun xscheme-send-breakpoint-interrupt () "Cause the Scheme process to enter a breakpoint." (interactive) (xscheme-send-interrupt ?b nil)) (defun xscheme-send-proceed () "Cause the Scheme process to proceed from a breakpoint." (interactive) (send-string "scheme" "(proceed)\n")) (defun xscheme-send-control-g-interrupt () "Cause the Scheme processor to halt and flush input. Control returns to the top level rep loop." (interactive) (let ((inhibit-quit t)) (cond ((not xscheme-control-g-synchronization-p) (interrupt-process "scheme")) (xscheme-control-g-disabled-p (message "Relax...")) (t (setq xscheme-control-g-disabled-p t) (message "Sending C-G interrupt to Scheme...") (interrupt-process "scheme") (send-string "scheme" (char-to-string 0)))))) (defun xscheme-send-control-u-interrupt () "Cause the Scheme process to halt, returning to previous rep loop." (interactive) (xscheme-send-interrupt ?u t)) (defun xscheme-send-control-x-interrupt () "Cause the Scheme process to halt, returning to current rep loop." (interactive) (xscheme-send-interrupt ?x t)) ;;; This doesn't really work right -- Scheme just gobbles the first ;;; character in the input. There is no way for us to guarantee that ;;; the argument to this procedure is the first char unless we put ;;; some kind of marker in the input stream. (defun xscheme-send-interrupt (char mark-p) "Send a ^A type interrupt to the Scheme process." (interactive "cInterrupt character to send: ") (quit-process "scheme") (send-string "scheme" (char-to-string char)) (if (and mark-p xscheme-control-g-synchronization-p) (send-string "scheme" (char-to-string 0)))) ;;;; Internal Variables (defvar xscheme-process-command-line nil "Command used to start the most recent Scheme process.") (defvar xscheme-previous-send "" "Most recent expression transmitted to the Scheme process.") (defvar xscheme-process-filter-state 'idle "State of scheme process escape reader state machine: idle waiting for an escape sequence reading-type received an altmode but nothing else reading-string reading prompt string") (defvar xscheme-running-p nil "This variable, if nil, indicates that the scheme process is waiting for input. Otherwise, it is busy evaluating something.") (defconst xscheme-control-g-synchronization-p t "If non-nil, insert markers in the scheme input stream to indicate when control-g interrupts were signalled. Do not allow more control-g's to be signalled until the scheme process acknowledges receipt.") (defvar xscheme-control-g-disabled-p nil "This variable, if non-nil, indicates that a control-g is being processed by the scheme process, so additional control-g's are to be ignored.") (defvar xscheme-allow-output-p t "This variable, if nil, prevents output from the scheme process from being inserted into the process-buffer.") (defvar xscheme-prompt "" "The current scheme prompt string.") (defvar xscheme-string-accumulator "" "Accumulator for the string being received from the scheme process.") (defvar xscheme-string-receiver nil "Procedure to send the string argument from the scheme process.") (defvar xscheme-start-hook nil "If non-nil, a procedure to call when the Scheme process is started. When called, the current buffer will be the Scheme process-buffer.") (defvar xscheme-runlight-string nil) (defvar xscheme-mode-string nil) (defvar xscheme-filter-input nil) ;;;; Basic Process Control (defun xscheme-start-process (command-line) (let ((buffer (get-buffer-create "*scheme*"))) (let ((process (get-buffer-process buffer))) (save-excursion (set-buffer buffer) (if (and process (memq (process-status process) '(run stop))) (set-marker (process-mark process) (point-max)) (progn (if process (delete-process process)) (goto-char (point-max)) (scheme-interaction-mode) (if (bobp) (insert-before-markers (substitute-command-keys xscheme-startup-message))) (setq process (let ((process-connection-type nil)) (apply 'start-process (cons "scheme" (cons buffer (xscheme-parse-command-line command-line)))))) (set-marker (process-mark process) (point-max)) (xscheme-process-filter-initialize t) (xscheme-modeline-initialize) (set-process-sentinel process 'xscheme-process-sentinel) (set-process-filter process 'xscheme-process-filter) (run-hooks 'xscheme-start-hook))))) buffer)) (defun xscheme-parse-command-line (string) (setq string (substitute-in-file-name string)) (let ((start 0) (result '())) (while start (let ((index (string-match "[ \t]" string start))) (setq start (cond ((not index) (setq result (cons (substring string start) result)) nil) ((= index start) (string-match "[^ \t]" string start)) (t (setq result (cons (substring string start index) result)) (1+ index)))))) (nreverse result))) (defun xscheme-wait-for-process () (sleep-for 2) (while xscheme-running-p (sleep-for 1))) (defun xscheme-process-running-p () "True iff there is a Scheme process whose status is `run'." (let ((process (get-process "scheme"))) (and process (eq (process-status process) 'run)))) (defun xscheme-process-buffer () (let ((process (get-process "scheme"))) (and process (process-buffer process)))) (defun xscheme-process-buffer-window () (let ((buffer (xscheme-process-buffer))) (and buffer (get-buffer-window buffer)))) (defun xscheme-process-buffer-current-p () "True iff the current buffer is the Scheme process buffer." (eq (xscheme-process-buffer) (current-buffer))) ;;;; Process Filter (defun xscheme-process-sentinel (proc reason) (xscheme-process-filter-initialize (eq reason 'run)) (if (eq reason 'run) (xscheme-modeline-initialize) (progn (setq scheme-mode-line-process "") (setq xscheme-mode-string "no process"))) (if (and (not (memq reason '(run stop))) xscheme-signal-death-message) (progn (beep) (message "The Scheme process has died! Do M-x reset-scheme to restart it")))) (defun xscheme-process-filter-initialize (running-p) (setq xscheme-process-filter-state 'idle) (setq xscheme-running-p running-p) (setq xscheme-control-g-disabled-p nil) (setq xscheme-allow-output-p t) (setq xscheme-prompt "") (setq scheme-mode-line-process '(": " xscheme-runlight-string))) (defun xscheme-process-filter (proc string) (let ((xscheme-filter-input string)) (while xscheme-filter-input (cond ((eq xscheme-process-filter-state 'idle) (let ((start (string-match "\e" xscheme-filter-input))) (if start (progn (xscheme-process-filter-output (substring xscheme-filter-input 0 start)) (setq xscheme-filter-input (substring xscheme-filter-input (1+ start))) (setq xscheme-process-filter-state 'reading-type)) (let ((string xscheme-filter-input)) (setq xscheme-filter-input nil) (xscheme-process-filter-output string))))) ((eq xscheme-process-filter-state 'reading-type) (if (zerop (length xscheme-filter-input)) (setq xscheme-filter-input nil) (let ((char (aref xscheme-filter-input 0))) (setq xscheme-filter-input (substring xscheme-filter-input 1)) (let ((entry (assoc char xscheme-process-filter-alist))) (if entry (funcall (nth 2 entry) (nth 1 entry)) (progn (xscheme-process-filter-output ?\e char) (setq xscheme-process-filter-state 'idle))))))) ((eq xscheme-process-filter-state 'reading-string) (let ((start (string-match "\e" xscheme-filter-input))) (if start (let ((string (concat xscheme-string-accumulator (substring xscheme-filter-input 0 start)))) (setq xscheme-filter-input (substring xscheme-filter-input (1+ start))) (setq xscheme-process-filter-state 'idle) (funcall xscheme-string-receiver string)) (progn (setq xscheme-string-accumulator (concat xscheme-string-accumulator xscheme-filter-input)) (setq xscheme-filter-input nil))))) (t (error "Scheme process filter -- bad state")))))) ;;;; Process Filter Output (defun xscheme-process-filter-output (&rest args) (if xscheme-allow-output-p (let ((string (apply 'concat args))) (save-excursion (xscheme-goto-output-point) (while (string-match "\\(\007\\|\f\\)" string) (let ((start (match-beginning 0)) (end (match-end 0))) (insert-before-markers (substring string 0 start)) (if (= ?\f (aref string start)) (progn (if (not (bolp)) (insert-before-markers ?\n)) (insert-before-markers ?\f)) (beep)) (setq string (substring string (1+ start))))) (insert-before-markers string))))) (defun xscheme-guarantee-newlines (n) (if xscheme-allow-output-p (save-excursion (xscheme-goto-output-point) (let ((stop nil)) (while (and (not stop) (bolp)) (setq n (1- n)) (if (bobp) (setq stop t) (backward-char)))) (xscheme-goto-output-point) (while (> n 0) (insert-before-markers ?\n) (setq n (1- n)))))) (defun xscheme-goto-output-point () (let ((process (get-process "scheme"))) (set-buffer (process-buffer process)) (goto-char (process-mark process)))) (defun xscheme-modeline-initialize () (setq xscheme-runlight-string "") (setq xscheme-mode-string "") (setq mode-line-buffer-identification '("Scheme: " xscheme-mode-string))) (defun xscheme-set-runlight (runlight) (setq xscheme-runlight-string runlight) (force-mode-line-update t)) ;;;; Process Filter Operations (defvar xscheme-process-filter-alist '((?D xscheme-enter-debugger-mode xscheme-process-filter:string-action) (?E xscheme-eval xscheme-process-filter:string-action) (?P xscheme-set-prompt-variable xscheme-process-filter:string-action) (?R xscheme-enter-interaction-mode xscheme-process-filter:simple-action) (?b xscheme-start-gc xscheme-process-filter:simple-action) (?e xscheme-finish-gc xscheme-process-filter:simple-action) (?f xscheme-exit-input-wait xscheme-process-filter:simple-action) (?g xscheme-enable-control-g xscheme-process-filter:simple-action) (?i xscheme-prompt-for-expression xscheme-process-filter:string-action) (?m xscheme-message xscheme-process-filter:string-action) (?n xscheme-prompt-for-confirmation xscheme-process-filter:string-action) (?o xscheme-output-goto xscheme-process-filter:simple-action) (?p xscheme-set-prompt xscheme-process-filter:string-action) (?s xscheme-enter-input-wait xscheme-process-filter:simple-action) (?v xscheme-write-value xscheme-process-filter:string-action) (?w xscheme-cd xscheme-process-filter:string-action) (?z xscheme-display-process-buffer xscheme-process-filter:simple-action) (?c xscheme-unsolicited-read-char xscheme-process-filter:simple-action)) "Table used to decide how to handle process filter commands. Value is a list of entries, each entry is a list of three items. The first item is the character that the process filter dispatches on. The second item is the action to be taken, a function. The third item is the handler for the entry, a function. When the process filter sees a command whose character matches a particular entry, it calls the handler with two arguments: the action and the string containing the rest of the process filter's input stream. It is the responsibility of the handler to invoke the action with the appropriate arguments, and to reenter the process filter with the remaining input.") (defun xscheme-process-filter:simple-action (action) (setq xscheme-process-filter-state 'idle) (funcall action)) (defun xscheme-process-filter:string-action (action) (setq xscheme-string-receiver action) (setq xscheme-string-accumulator "") (setq xscheme-process-filter-state 'reading-string)) (defconst xscheme-runlight:running "run" "The character displayed when the Scheme process is running.") (defconst xscheme-runlight:input "input" "The character displayed when the Scheme process is waiting for input.") (defconst xscheme-runlight:gc "gc" "The character displayed when the Scheme process is garbage collecting.") (defun xscheme-start-gc () (xscheme-set-runlight xscheme-runlight:gc)) (defun xscheme-finish-gc () (xscheme-set-runlight (if xscheme-running-p xscheme-runlight:running xscheme-runlight:input))) (defun xscheme-enter-input-wait () (xscheme-set-runlight xscheme-runlight:input) (setq xscheme-running-p nil)) (defun xscheme-exit-input-wait () (xscheme-set-runlight xscheme-runlight:running) (setq xscheme-running-p t)) (defun xscheme-enable-control-g () (setq xscheme-control-g-disabled-p nil)) (defun xscheme-display-process-buffer () (let ((window (or (xscheme-process-buffer-window) (display-buffer (xscheme-process-buffer))))) (save-window-excursion (select-window window) (xscheme-goto-output-point) (if (xscheme-debugger-mode-p) (xscheme-enter-interaction-mode))))) (defun xscheme-unsolicited-read-char () nil) (defun xscheme-eval (string) (eval (car (read-from-string string)))) (defun xscheme-message (string) (if (not (zerop (length string))) (xscheme-write-message-1 string (format ";%s" string)))) (defun xscheme-write-value (string) (if (zerop (length string)) (xscheme-write-message-1 "(no value)" ";No value") (xscheme-write-message-1 string (format ";Value: %s" string)))) (defun xscheme-write-message-1 (message-string output-string) (let* ((process (get-process "scheme")) (window (get-buffer-window (process-buffer process)))) (if (or (not window) (not (pos-visible-in-window-p (process-mark process) window))) (message "%s" message-string))) (xscheme-guarantee-newlines 1) (xscheme-process-filter-output output-string)) (defun xscheme-set-prompt-variable (string) (setq xscheme-prompt string)) (defun xscheme-set-prompt (string) (setq xscheme-prompt string) (xscheme-guarantee-newlines 2) (setq xscheme-mode-string (xscheme-coerce-prompt string)) (force-mode-line-update t)) (defun xscheme-output-goto () (xscheme-goto-output-point) (xscheme-guarantee-newlines 2)) (defun xscheme-coerce-prompt (string) (if (string-match "^[0-9]+ " string) (let ((end (match-end 0))) (concat (substring string 0 end) (let ((prompt (substring string end))) (let ((entry (assoc prompt xscheme-prompt-alist))) (if entry (cdr entry) prompt))))) string)) (defvar xscheme-prompt-alist '(("[Normal REPL]" . "[Evaluator]") ("[Error REPL]" . "[Evaluator]") ("[Breakpoint REPL]" . "[Evaluator]") ("[Debugger REPL]" . "[Evaluator]") ("[Visiting environment]" . "[Evaluator]") ("[Environment Inspector]" . "[Where]")) "An alist which maps the Scheme command interpreter type to a print string.") (defun xscheme-cd (directory-string) (save-excursion (set-buffer (xscheme-process-buffer)) (cd directory-string))) (defun xscheme-prompt-for-confirmation (prompt-string) (xscheme-send-char (if (y-or-n-p prompt-string) ?y ?n))) (defun xscheme-prompt-for-expression (prompt-string) (xscheme-send-string-2 (read-from-minibuffer prompt-string nil xscheme-prompt-for-expression-map))) (defvar xscheme-prompt-for-expression-map nil) (if (not xscheme-prompt-for-expression-map) (progn (setq xscheme-prompt-for-expression-map (copy-keymap minibuffer-local-map)) (substitute-key-definition 'exit-minibuffer 'xscheme-prompt-for-expression-exit xscheme-prompt-for-expression-map))) (defun xscheme-prompt-for-expression-exit () (interactive) (if (eq (xscheme-region-expression-p (point-min) (point-max)) 'one) (exit-minibuffer) (error "input must be a single, complete expression"))) (defun xscheme-region-expression-p (start end) (save-excursion (let ((old-syntax-table (syntax-table))) (unwind-protect (progn (set-syntax-table scheme-mode-syntax-table) (let ((state (parse-partial-sexp start end))) (and (zerop (car state)) ;depth = 0 (nth 2 state) ;last-sexp exists, i.e. >= 1 sexps (let ((state (parse-partial-sexp start (nth 2 state)))) (if (nth 2 state) 'many 'one))))) (set-syntax-table old-syntax-table))))) (provide 'xscheme) ;;; xscheme.el ends here emacs-19.30/lisp/xt-mouse.el100444 12120 1 12677 6051020071 14176 0ustar rmsdaemon;;; xt-mouse.el --- Support the mouse when emacs run in an xterm. ;; Copyright (C) 1994 Free Software Foundation ;; Author: Per Abrahamsen ;; Keywords: mouse, terminals ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Comments: ;; Enable mouse support when running inside an xterm. ;; This is actually useful when you are running X11 locally, but is ;; working on remote machine over a modem line or through a gateway. ;; It works by translating xterm escape codes into generic emacs mouse ;; events so it should work with any package that uses the mouse. ;;; Todo: ;; Support multi-click -- somehow. ;; Clicking on the mode-line does not work, although it should. ;;; Code: (define-key function-key-map "\e[M" 'xterm-mouse-translate) (defun xterm-mouse-translate (event) ;; Read a click and release event from XTerm. (save-excursion (save-window-excursion (deactivate-mark) (let* ((last) (down (xterm-mouse-event)) (down-command (nth 0 down)) (down-data (nth 1 down)) (down-where (nth 1 down-data)) (down-binding (key-binding (if (symbolp down-where) (vector down-where down-command) (vector down-command))))) (or (and (eq (read-char) ?\e) (eq (read-char) ?\[) (eq (read-char) ?M)) (error "Unexpected escape sequence from XTerm")) (let* ((click (xterm-mouse-event)) (click-command (nth 0 click)) (click-data (nth 1 click)) (click-where (nth 1 click-data))) (if (memq down-binding '(nil ignore)) (if (and (symbolp click-where) (not (eq 'menu-bar click-where))) (vector (list click-where click-data) click) (vector click)) (setq unread-command-events (if (eq down-where click-where) (list click) (list ;; Cheat `mouse-drag-region' with move event. (list 'mouse-movement click-data) ;; Generate a drag event. (if (symbolp down-where) 0 (list (intern (concat "drag-mouse-" (+ 1 last))) down-data click-data)) ))) (if (and (symbolp down-where) (not (eq 'menu-bar down-where))) (vector (list down-where down-data) down) (vector down)))))))) (defvar xterm-mouse-x 0 "Position of last xterm mouse event relative to the frame.") (defvar xterm-mouse-y 0 "Position of last xterm mouse event relative to the frame.") (defadvice mouse-position (around xterm-mouse activate) "Use last key from xterm-mouse-mode if available." (let ((answer ad-do-it)) (setq ad-return-value (if xterm-mouse-mode (cons (car answer) (cons xterm-mouse-x xterm-mouse-y)) answer)))) (defun xterm-mouse-event () ;; Convert XTerm mouse event to Emacs mouse event. (let* ((type (- (read-char) ? )) (x (- (read-char) ? 1)) (y (- (read-char) ? 1)) (point (cons x y)) (window (window-at x y)) (where (if window (coordinates-in-window-p point window) 'menu-bar)) (pos (if (consp where) (progn (select-window window) (goto-char (window-start window)) (move-to-window-line (cdr where)) (move-to-column (+ (car where) (current-column) (max 0 (1- (window-hscroll))))) (point)) where)) (mouse (intern (if (eq type 3) (concat "mouse-" (+ 1 last)) (setq last type) (concat "down-mouse-" (+ 1 type)))))) (setq xterm-mouse-x x xterm-mouse-y y) (list mouse (list window pos point (/ (nth 2 (current-time)) 1000))))) ;; Indicator for the xterm-mouse mode. (defvar xterm-mouse-mode nil) (or (assq 'xterm-mouse-mode minor-mode-alist) (setq minor-mode-alist (cons '(xterm-mouse-mode (" Mouse")) minor-mode-alist))) ;;;###autoload (defun xterm-mouse-mode (arg) "Toggle XTerm mouse mode. With prefix arg, turn XTerm mouse mode on iff arg is positive. Turn it on to use emacs mouse commands, and off to use xterm mouse commands." (interactive "P") (if (or (and (null arg) xterm-mouse-mode) (<= (prefix-numeric-value arg) 0)) ;; Turn it off (if xterm-mouse-mode (progn (turn-off-xterm-mouse-tracking) (setq xterm-mouse-mode nil) (set-buffer-modified-p (buffer-modified-p)))) ;;Turn it on (if xterm-mouse-mode () (setq xterm-mouse-mode t) (turn-on-xterm-mouse-tracking) (set-buffer-modified-p (buffer-modified-p))))) (defun turn-on-xterm-mouse-tracking () ;; Enable emacs mouse tracking in xterm. (if xterm-mouse-mode (send-string-to-terminal "\e[?1000h"))) (defun turn-off-xterm-mouse-tracking () ;; Disable disable emacs mouse tracking in xterm. (if xterm-mouse-mode (send-string-to-terminal "\e[?1000l"))) ;; Restore normal mouse behaviour outside Emacs. (add-hook 'suspend-hook 'turn-off-xterm-mouse-tracking) (add-hook 'suspend-resume-hook 'turn-on-xterm-mouse-tracking) (add-hook 'kill-emacs-hook 'turn-off-xterm-mouse-tracking) (provide 'xt-mouse) ;;; xt-mouse.el ends here emacs-19.30/lisp/yow.el100444 75424 12 5502 5660055717 13310 0ustar kwzhstaff;;; yow.el --- quote random zippyisms ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Author: Richard Mlynarik ;; Keywords: games ;; 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: ;; Important pinheadery for GNU Emacs. ;; ;; See cookie1.el for implementation. Note --- the `n' argument of yow ;; from the 18.xx implementation is no longer; we only support *random* ;; random access now. ;;; Code: (require 'cookie1) (defvar yow-file (concat data-directory "yow.lines") "File containing pertinent pinhead phrases.") ;;;###autoload (defun yow (&optional insert) "Return or display a random Zippy quotation. With prefix arg, insert it." (interactive "P") (let ((yow (cookie yow-file "Am I CONSING yet?..." "I have SEEN the CONSING!!"))) (cond (insert (insert yow)) ((not (interactive-p)) yow) ((not (string-match "\n" yow)) (delete-windows-on (get-buffer-create "*Help*")) (message "%s" yow)) (t (message "Yow!") (with-output-to-temp-buffer "*Help*" (princ yow) (save-excursion (set-buffer standard-output) (help-mode))))))) (defsubst read-zippyism (prompt &optional require-match) "Read a Zippyism from the minibuffer with completion, prompting with PROMPT. If optional second arg is non-nil, require input to match a completion." (read-cookie prompt yow-file "Am I CONSING yet?..." "I have SEEN the CONSING!!" require-match)) ;;;###autoload (defun insert-zippyism (&optional zippyism) "Prompt with completion for a known Zippy quotation, and insert it at point." (interactive (list (read-zippyism "Pinhead wisdom: " t))) (insert zippyism)) ; Yowza!! Feed zippy quotes to the doctor. Watch results. ; fun, fun, fun. Entertainment for hours... ; ; written by Kayvan Aghaiepour ;;;###autoload (defun psychoanalyze-pinhead () "Zippy goes to the analyst." (interactive) (doctor) ; start the psychotherapy (message "") (switch-to-buffer "*doctor*") (sit-for 0) (while (not (input-pending-p)) (insert-string (yow)) (sit-for 0) (doctor-ret-or-read 1) (doctor-ret-or-read 1))) (provide 'yow) ;;; yow.el ends here emacs-19.30/lisp/abbrev.elc100666 13437 1 20414 5751545002 14163 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:10:40 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/abbrev.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/abbrev.el' was compiled for Emacs 19")) #@128 *t means user plans to use global abbrevs only. Makes the commands to define mode-specific abbrevs define global ones instead. (defconst only-global-abbrevs nil (#$ . -482)) #@177 Toggle abbrev mode. With argument ARG, turn abbrev mode on iff ARG is positive. In abbrev mode, inserting an abbreviation causes it to expand and be replaced by its expansion. (defalias 'abbrev-mode #[(arg) "„ ?‚Â!ÃVÄ ‡" [arg abbrev-mode prefix-numeric-value 0 force-mode-line-update] 2 (#$ . 663) "P"]) #@30 Keymap used in edit-abbrevs. (defvar edit-abbrevs-map nil (#$ . 980)) (byte-code "„Á ÂÃÄ#ˆÂÅÄ#ˆÁ‡" [edit-abbrevs-map make-sparse-keymap define-key "" edit-abbrevs-redefine ""] 4) #@31 Undefine all defined abbrevs. (defalias 'kill-all-abbrevs #[nil "‰… @J!ˆ A‰„Ã)‡" [abbrev-table-name-list tables clear-abbrev-table nil] 3 (#$ . 1175) nil]) #@95 Insert after point a description of all defined abbrevs. Mark is set after the inserted text. (defalias 'insert-abbrevs #[nil "ÀŠ ‰ƒÃ\n@Ä\"ˆ\nA‰„)`)!‡" [push-mark abbrev-table-name-list tables insert-abbrev-table-description t] 5 (#$ . 1345) nil]) #@40 Display a list of all defined abbrevs. (defalias 'list-abbrevs #[nil "ÀÁ !‡" [display-buffer prepare-abbrev-list-buffer] 2 (#$ . 1605) nil]) (defalias 'prepare-abbrev-list-buffer #[nil "ŠÀÁ!qˆÂ ˆ ‰ƒÅ\f@Æ\"ˆ\fA‰„)ebˆÇÈ!ˆÉ ˆ)ÀÁ!‡" [get-buffer-create "*Abbrevs*" erase-buffer abbrev-table-name-list tables insert-abbrev-table-description t set-buffer-modified-p nil edit-abbrevs-mode] 4]) #@76 Major mode for editing the list of abbrev definitions. \{edit-abbrevs-map} (defalias 'edit-abbrevs-mode #[nil "ÀÂÄ !‡" [edit-abbrevs-mode major-mode "Edit-Abbrevs" mode-name use-local-map edit-abbrevs-map] 2 (#$ . 2003) nil]) #@568 Alter abbrev definitions by editing a list of them. Selects a buffer containing a list of abbrev definitions. You can edit them and type \\[edit-abbrevs-redefine] to redefine abbrevs according to your editing. Buffer contains a header line for each abbrev table, which is the abbrev table name in parentheses. This is followed by one line per abbrev in that table: NAME USECOUNT EXPANSION HOOK where NAME and EXPANSION are strings with quotes, USECOUNT is an integer, and HOOK is any valid function or may be omitted (it is usually omitted). (defalias 'edit-abbrevs #[nil "ÀÁ !‡" [switch-to-buffer prepare-abbrev-list-buffer] 2 (#$ . 2238) nil]) #@56 Redefine abbrevs according to current buffer contents. (defalias 'edit-abbrevs-redefine #[nil "ÀÁ!ˆÂÃ!‡" [define-abbrevs t set-buffer-modified-p nil] 2 (#$ . 2915) nil]) #@255 Define abbrevs according to current visible buffer contents. See documentation of `edit-abbrevs' for info on the format of the text you must have in the buffer. With argument, eliminate all abbrev definitions except the ones defined from the buffer now. (defalias 'define-abbrevs #[(&optional arg) "ƒÁ ˆŠebˆm?…|ÂÃÄÅ#…|pÇ!Ä Ä\nÄ Ä\fÄ ÎyˆÎyˆl„pÇ!\nÇ! Ç!\fÏÄxˆl?…YÇ! ÏÄxˆ\n\f  F B ‚3Ð \"ˆ.‚ )‡" [arg kill-all-abbrevs re-search-forward "^(" nil t buf read table abbrevs name hook exp count 1 " \n\f" define-abbrev-table] 4 (#$ . 3092) "P"]) #@242 Read abbrev definitions from file written with `write-abbrev-file'. Optional argument FILE is the name of the file to read; it defaults to the value of `abbrev-file-name'. Optional second argument QUIETLY non-nil means don't print anything. (defalias 'read-abbrev-file #[(&optional file quietly) "À ƒ GÂVƒ ‚ Ä #ˆÆĉ‡" [load file 0 abbrev-file-name nil quietly t save-abbrevs abbrevs-changed] 4 (#$ . 3679) "fRead abbrev file: "]) #@196 Read abbrev definitions from file written with write-abbrev-file. Optional argument FILE is the name of the file to read; it defaults to the value of `abbrev-file-name'. Does not print anything. (defalias 'quietly-read-abbrev-file #[(&optional file) "À Â\"‡" [read-abbrev-file file t] 3 (#$ . 4126)]) #@177 Write all abbrev definitions to a file of Lisp code. The file written can be loaded in another session to define the same abbrevs. The argument FILE is the file name to write. (defalias 'write-abbrev-file #[(file) "ƒ GÁV„ \nŠÃÄ!qˆÅ ˆ‰ƒ.È@É\"ˆA‰„)ÊËd#ˆÅ )‡" [file 0 abbrev-file-name get-buffer-create " write-abbrev-file" erase-buffer abbrev-table-name-list tables insert-abbrev-table-description nil write-region 1] 5 (#$ . 4434) (list (read-file-name "Write abbrev file: " (file-name-directory (expand-file-name abbrev-file-name)) abbrev-file-name))]) #@338 Define mode-specific abbrev for last word(s) before point. Argument is how many words before point form the expansion; or zero means the region is the expansion. A negative argument means to undefine the specified abbrev. Reads the abbreviation in the minibuffer. Don't use this function in a Lisp program; use `define-abbrev' instead. (defalias 'add-mode-abbrev #[(arg) "À ƒ \n‚ †ÄÅ!Æ#‡" [add-abbrev only-global-abbrevs global-abbrev-table local-abbrev-table error "No per-mode abbrev table" "Mode" arg] 4 (#$ . 5013) "p"]) #@388 Define global (all modes) abbrev for last word(s) before point. The prefix argument specifies the number of words before point that form the expansion; or zero means the region is the expansion. A negative argument means to undefine the specified abbrev. This command uses the minibuffer to read the abbreviation. Don't use this function in a Lisp program; use `define-abbrev' instead. (defalias 'add-global-abbrev #[(arg) "À  #‡" [add-abbrev global-abbrev-table "Global" arg] 4 (#$ . 5553) "p"]) (defalias 'add-abbrev #[(table type arg) "ÁY…`ÁUƒ ‚Š[vˆ`){ÃÆÇ ƒ'È‚(É\n #!ËÁ\fGÃ\f$ˆ ƒPÌ\f \"ƒPÎÇÏ\fÌ\f \"#!…WÐ \f— #*‡" [arg 0 mark nil name exp read-string format "%s abbrev for \"%s\": " "Undefine %s abbrev: " type set-text-properties abbrev-expansion table y-or-n-p "%s expands to \"%s\"; redefine? " define-abbrev] 7]) #@217 Define last word before point as a mode-specific abbrev. With prefix argument N, defines the Nth word before point. This command uses the minibuffer to read the expansion. Expands the abbreviation after defining it. (defalias 'inverse-add-mode-abbrev #[(arg) "À ƒ \n‚ †ÄÅ!Æ#‡" [inverse-add-abbrev only-global-abbrevs global-abbrev-table local-abbrev-table error "No per-mode abbrev table" "Mode" arg] 4 (#$ . 6404) "p"]) #@229 Define last word before point as a global (mode-independent) abbrev. With prefix argument N, defines the Nth word before point. This command uses the minibuffer to read the expansion. Expands the abbreviation after defining it. (defalias 'inverse-add-global-abbrev #[(arg) "À  #‡" [inverse-add-abbrev global-abbrev-table "Global" arg] 4 (#$ . 6839) "p"]) (defalias 'inverse-add-abbrev #[(table type arg) "À‰‰Š\f[vˆ`Åvˆ`‰{)ÆÇ GÀ $ˆÈÉÊ #!Ì  \"ƒ<ÎÉÏ Ì  \"#!…KÐ — #ˆŠ\nbˆÑ )+‡" [nil exp nameloc name arg 1 set-text-properties 0 read-string format "%s expansion for \"%s\": " type abbrev-expansion table y-or-n-p "%s expands to \"%s\"; redefine? " define-abbrev expand-abbrev] 7]) #@230 Mark current point as the beginning of an abbrev. Abbrev to be expanded starts here rather than at beginning of word. This way, you can expand an abbrev with a prefix: insert the prefix, use this command, then insert the abbrev. (defalias 'abbrev-prefix-mark #[(&optional arg) "„Á ˆÂ pÅc‡" [arg expand-abbrev point-marker abbrev-start-location abbrev-start-location-buffer "-"] 1 (#$ . 7537) "P"]) #@243 For abbrev occurrence in the region, offer to expand it. The user is asked to type y or n for each occurrence. A prefix argument means don't query; expand all abbrevs. If called from a Lisp program, arguments are START END &optional NOQUERY. (defalias 'expand-region-abbrevs #[(start end &optional noquery) "Šbˆd Z‰m?…AÆvˆ`‰d ZX…AÇŠÈvˆ`)\f{‰!ƒ\f „;ÊËÌ \"!ƒ\fÍ ˆ‚\f,‡" [start end nil string pnt lim 1 abbrev-expansion -1 noquery y-or-n-p format "Expand `%s'? " expand-abbrev] 4 (#$ . 7947) "r\nP"]) emacs-19.30/lisp/abbrevlist.elc100666 12120 1 1646 5751545002 14711 0ustar rmsdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:10:42 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/abbrevlist.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/abbrevlist.el' was compiled for Emacs 19")) #@71 Display alphabetical listing of ABBREV-TABLE in buffer OUTPUT-BUFFER. (defalias 'list-one-abbrev-table #[(abbrev-table output-buffer) "ŠÁ qˆÆÇ\"ˆÉ\fÊ\"‰…F Ë\\Ì Vƒ'ÍcˆÂ jˆÎ\f@!cˆ Ï\\jˆ\f@Jcˆ Ë\\\fA‰„Á+‘‡" [output-buffer nil 0 first-column abbrev-list standard-output mapatoms #[(abbrev) " B‰‡" [abbrev abbrev-list] 2] abbrev-table sort string-lessp 40 frame-width "\n" symbol-name 8] 5 (#$ . 489)]) (provide (quote abbrevlist)) emacs-19.30/lisp/ada-mode.elc100666 75424 12 133745 6045211526 14353 0ustar kwzhstaff;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:02:04 1995 ;;; from file /home/fsf/rms/e19/lisp/ada-mode.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`ada-mode.el' was compiled for Emacs 19.29 or later")) #@39 *Defines the size of Ada indentation. (defvar ada-indent 3 (#$ . -476)) #@60 *# of columns to indent the continuation of a broken line. (defvar ada-broken-indent 2 (#$ . -554)) #@34 *# of columns to indent a label. (defvar ada-label-indent -4 (#$ . -660)) #@110 *# of columns to indent a statement end keyword in a separate line. Examples are 'is', 'loop', 'record', ... (defvar ada-stmt-end-indent 0 (#$ . -741)) #@72 *Defines the indentation for 'when' relative to 'exception' or 'case'. (defvar ada-when-indent 3 (#$ . -899)) #@68 *Defines the indentation for 'record' relative to 'type' or 'use'. (defvar ada-indent-record-rel-type 3 (#$ . -1015)) #@54 *If non-nil, comment-lines get indented as Ada code. (defvar ada-indent-comment-as-code t (#$ . -1139)) #@76 *If non-nil, 'is separate' or 'is abstract' on a single line are indented. (defvar ada-indent-is-separate t (#$ . -1249)) #@66 *If non-nil, indent according to the innermost open parenthesis. (defvar ada-indent-to-open-paren t (#$ . -1377)) #@55 *Search that many characters for an open parenthesis. (defvar ada-search-paren-char-count-limit 3000 (#$ . -1497)) #@418 *Control behaviour of the TAB key. Must be one of `indent-rigidly', `indent-auto', `gei', `indent-af' or `always-tab'. `indent-rigidly' : always adds ada-indent blanks at the beginning of the line. `indent-auto' : use indentation functions in this file. `gei' : use David Kågedal's Generic Indentation Engine. `indent-af' : use Gary E. Barnes' ada-format.el `always-tab' : do indent-relative. (defvar ada-tab-policy (quote indent-auto) (#$ . -1619)) #@90 *If non-nil, `ada-move-to-start' moves point to the subprog declaration, not to 'begin'. (defvar ada-move-to-declaration nil (#$ . -2099)) #@37 *Suffix of Ada specification files. (defvar ada-spec-suffix ".ads" (#$ . -2244)) #@28 *Suffix of Ada body files. (defvar ada-body-suffix ".adb" (#$ . -2331)) #@39 *Do we program in `ada83' or `ada95'? (defvar ada-language-version (quote ada95) (#$ . -2409)) #@143 *Function to call to adjust the case of Ada keyworrds. It may be `downcase-word', `upcase-word', `ada-loose-case-word' or `capitalize-word'. (defvar ada-case-keyword (quote downcase-word) (#$ . -2511)) #@147 *Function to call to adjust the case of an Ada identifier. It may be `downcase-word', `upcase-word', `ada-loose-case-word' or `capitalize-word'. (defvar ada-case-identifier (quote ada-loose-case-word) (#$ . -2721)) #@144 *Function to call to adjust the case of Ada attributes. It may be `downcase-word', `upcase-word', `ada-loose-case-word' or `capitalize-word'. (defvar ada-case-attribute (quote capitalize-word) (#$ . -2944)) #@169 *Non-nil automatically changes casing of preceeding word while typing. Casing is done according to `ada-case-keyword', `ada-case-identifier' and `ada-cacse-attribute'. (defvar ada-auto-case t (#$ . -3159)) #@76 *If non-nil, `remove-trailing-spaces' and `untabify' buffer before saving. (defvar ada-clean-buffer-before-saving nil (#$ . -3371)) #@117 *List of functions to call when Ada Mode is invoked. This is a good place to add Ada environment specific bindings. (defvar ada-mode-hook nil (#$ . -3510)) #@56 *External pretty printer to call from within Ada Mode. (defvar ada-external-pretty-print-program "aimap" (#$ . -3672)) #@68 *Directory to store the temporary file for the Ada pretty printer. (defvar ada-tmp-directory "/tmp/" (#$ . -3797)) #@74 *This is inserted in the first columns when filling a comment paragraph. (defvar ada-fill-comment-prefix "-- " (#$ . -3918)) #@120 *This is inserted at the end of each line when filling a comment paragraph. with `ada-fill-comment-paragraph-postfix'. (defvar ada-fill-comment-postfix " --" (#$ . -4050)) #@118 *Argument of gnatk8, a string containing the max number of characters. Set to 0, if you dont use crunched filenames. (defvar ada-krunch-args "0" (#$ . -4229)) #@32 Abbrev table used in Ada mode. (defvar ada-mode-abbrev-table nil (#$ . 4394)) (define-abbrev-table (quote ada-mode-abbrev-table) nil) #@33 Local keymap used for Ada Mode. (defvar ada-mode-map nil (#$ . 4534)) #@54 Syntax table to be used for editing Ada source code. (defvar ada-mode-syntax-table nil (#$ . 4610)) #@56 Syntax table for Ada, where `_' is a word constituent. (defvar ada-mode-symbol-syntax-table nil (#$ . 4716)) #@51 regular expression for looking at Ada83 keywords. (defconst ada-83-keywords "\\<\\(abort\\|abs\\|accept\\|access\\|all\\|and\\|array\\|at\\|begin\\|body\\|case\\|constant\\|declare\\|delay\\|delta\\|digits\\|do\\|else\\|elsif\\|end\\|entry\\|exception\\|exit\\|for\\|function\\|generic\\|goto\\|if\\|in\\|is\\|limited\\|loop\\|mod\\|new\\|not\\|null\\|of\\|or\\|others\\|out\\|package\\|pragma\\|private\\|procedure\\|raise\\|range\\|record\\|rem\\|renames\\|return\\|reverse\\|select\\|separate\\|subtype\\|task\\|terminate\\|then\\|type\\|use\\|when\\|while\\|with\\|xor\\)\\>" (#$ . 4831)) #@51 regular expression for looking at Ada95 keywords. (defconst ada-95-keywords "\\<\\(abort\\|abs\\|abstract\\|accept\\|access\\|aliased\\|all\\|and\\|array\\|at\\|begin\\|body\\|case\\|constant\\|declare\\|delay\\|delta\\|digits\\|do\\|else\\|elsif\\|end\\|entry\\|exception\\|exit\\|for\\|function\\|generic\\|goto\\|if\\|in\\|is\\|limited\\|loop\\|mod\\|new\\|not\\|null\\|of\\|or\\|others\\|out\\|package\\|pragma\\|private\\|procedure\\|protected\\|raise\\|range\\|record\\|rem\\|renames\\|requeue\\|return\\|reverse\\|select\\|separate\\|subtype\\|tagged\\|task\\|terminate\\|then\\|type\\|until\\|use\\|when\\|while\\|with\\|xor\\)\\>" (#$ . 5430)) #@49 Regular expression for looking at Ada keywords. (defvar ada-keywords ada-95-keywords (#$ . 6089)) #@63 Variable to save key binding of RET when casing is activated. (defvar ada-ret-binding nil (#$ . 6193)) #@63 Variable to save key binding of LFD when casing is activated. (defvar ada-lfd-binding nil (#$ . 6302)) #@46 Regexp matching Ada (qualified) identifiers. (defconst ada-ident-re "[a-zA-Z0-9_\\.]+" (#$ . 6411)) #@47 Regexp used to find Ada procedures/functions. (defvar ada-procedure-start-regexp "^[ ]*\\(procedure\\|function\\|task\\)[ \n]+\\([a-zA-Z0-9_\\.]+\\)" (#$ . 6517)) #@34 Regexp used to find Ada packages (defvar ada-package-start-regexp "^[ ]*\\(package\\)" (#$ . 6688)) #@42 Regexp for keywords starting Ada blocks. (defvar ada-block-start-re "\\<\\(begin\\|select\\|declare\\|private\\|or\\|generic\\|exception\\|loop\\|else\\|\\(\\(limited\\|abstract\\|tagged\\)[ ]+\\)*record\\)\\>" (#$ . 6795)) #@89 Regexp of possible ends for a non-broken statement. A new statement starts after these. (defvar ada-end-stmt-re "\\(;\\|=>\\|^[ ]*separate[ ]+([a-zA-Z0-9_\\.]+)\\|\\<\\(begin\\|else\\|record\\|loop\\|select\\|do\\|declare\\|generic\\|private\\)\\>\\|^[ ]*\\(package\\|procedure\\|function\\)[ a-zA-Z0-9_\\.]+is\\|^[ ]*exception\\>\\)" (#$ . 7026)) #@33 Regexp for the start of a loop. (defvar ada-loop-start-re "\\<\\(for\\|while\\|loop\\)\\>" (#$ . 7385)) #@39 Regexp for the start of a subprogram. (defvar ada-subprog-start-re "\\<\\(procedure\\|protected\\|package\\|function\\|task\\|accept\\|entry\\)\\>" (#$ . 7495)) #@73 Imenu generic expression for Ada mode. See `imenu-generic-expression'. (defvar ada-imenu-generic-expression (quote ((nil "^\\s-*\\(procedure\\|function\\)\\s-+\\([A-Za-z0-9_]+\\)" 2) ("Type Defs" "^\\s-*\\(sub\\)?type\\s-+\\([A-Za-z0-9_]+\\)" 2))) (#$ . 7662)) (defalias 'ada-xemacs #[nil "ÀÁ\n\"† ÀÃ\n\"‡" [string-match "Lucid" emacs-version "XEmacs"] 3]) #@39 Create the syntax table for Ada Mode. (defalias 'ada-create-syntax-table #[nil "À  !ˆÃÄÅ #ˆÃÆÅ #ˆÃÇÈ #ˆÃÉÊ #ˆÃËÊ #ˆÃÌÊ #ˆÃÍÊ #ˆÃÎÊ #ˆÃÏÊ #ˆÃÐÊ #ˆÃÑÊ #ˆÃÒÊ #ˆÃÓÊ #ˆÃÔÊ #ˆÃÕÊ #ˆÃÖÊ #ˆÃ×Ê #ˆÃØÊ #ˆÃÙÊ #ˆÃÚÊ #ˆÃÛÊ #ˆÃÜÝ #ˆÃÞß #ˆÃàß #ˆÃáâ #ˆÃãä #ˆÃåæ #ˆç !(Ãáé(#‡" [make-syntax-table ada-mode-syntax-table set-syntax-table modify-syntax-entry 37 "\"" 34 35 "$" 58 "." 59 38 124 43 42 47 61 60 62 36 91 93 123 125 46 92 39 45 ". 12" 12 "> " 10 95 "_" 40 "()" 41 ")(" copy-syntax-table ada-mode-symbol-syntax-table "w"] 4 (#$ . 8027)]) #@2580 Ada Mode is the major mode for editing Ada code. Bindings are as follows: (Note: 'LFD' is control-j.) Indent line '\[ada-tab]' Indent line, insert newline and indent the new line. '\[newline-and-indent]' Re-format the parameter-list point is in '\[ada-format-paramlist]' Indent all lines in region '\[ada-indent-region]' Call external pretty printer program '\[ada-call-pretty-printer]' Adjust case of identifiers and keywords in region '\[ada-adjust-case-region]' Adjust case of identifiers and keywords in buffer '\[ada-adjust-case-buffer]' Call EXTERNAL pretty printer (if you have one) '\[ada-call-pretty-printer]' Fill comment paragraph '\[ada-fill-comment-paragraph]' Fill comment paragraph and justify each line '\[ada-fill-comment-paragraph-justify]' Fill comment paragraph, justify and append postfix '\[ada-fill-comment-paragraph-postfix]' Next func/proc/task '\[ada-next-procedure]' Previous func/proc/task '\[ada-previous-procedure]' Next package '\[ada-next-package]' Previous package '\[ada-previous-package]' Goto matching start of current 'end ...;' '\[ada-move-to-start]' Goto end of current block '\[ada-move-to-end]' Comments are handled using standard GNU Emacs conventions, including: Start a comment '\[indent-for-comment]' Comment region '\[comment-region]' Uncomment region '\[ada-uncomment-region]' Continue comment on next line '\[indent-new-comment-line]' If you use imenu.el: Display index-menu of functions & procedures '\[imenu]' If you use find-file.el: Switch to other file (Body <-> Spec) '\[ff-find-other-file]' or '\[ff-mouse-find-other-file] Switch to other file in other window '\[ada-ff-other-window]' or '\[ff-mouse-find-other-file-other-window] If you use this function in a spec and no body is available, it gets created with body stubs. If you use ada-xref.el: Goto declaration: '\[ada-point-and-xref]' on the identifier or '\[ada-goto-declaration]' with point on the identifier Complete identifier: '\[ada-complete-identifier]' Execute Gnatf: '\[ada-gnatf-current]' (defalias 'ada-mode #[nil "À ˆÁÂ!ˆÃÁÄ!ˆÅÁÆ!ˆÇÁÈ!ˆÉÁÊ!ˆË\nÁÌ!ˆÍ\fÁÎ!ˆÏÁÐ!ˆÃÁÑ!ˆÃÁÒ!ˆÓÁÔ!ˆÁÖ!ˆ×ØÚÃÝ!ˆƒqà!ˆ‚tá ˆ\"ƒƒãäå\"ˆãäæ\"ˆç ˆèé!ˆ*ë=ƒ˜,-‚£*î=ƒ£/-0…ªñ ‡" [kill-all-local-variables make-local-variable require-final-newline t comment-start "-- " comment-end "" comment-start-skip "--+[ ]*" indent-line-function ada-indent-current-function fill-column 75 comment-column 40 parse-sexp-ignore-comments case-fold-search fill-paragraph-function ada-fill-comment-paragraph imenu-generic-expression ada-imenu-generic-expression font-lock-defaults ((ada-font-lock-keywords ada-font-lock-keywords-1 ada-font-lock-keywords-2) nil t ((95 . "w")) beginning-of-line) ada-mode major-mode "Ada" mode-name blink-matching-paren use-local-map ada-mode-map ada-mode-syntax-table set-syntax-table ada-create-syntax-table ada-clean-buffer-before-saving add-hook local-write-file-hooks ada-remove-trailing-spaces ada-untabify-buffer ada-add-ada-menu run-hooks ada-mode-hook ada-language-version ada83 ada-83-keywords ada-keywords ada95 ada-95-keywords ada-auto-case ada-activate-keys-for-case] 3 (#$ . 8569) nil]) #@66 Fills current comment paragraph and justifies each line as well. (defalias 'ada-fill-comment-paragraph-justify #[nil "ÀÁ!‡" [ada-fill-comment-paragraph t] 2 (#$ . 12296) nil]) #@117 Fills current comment paragraph and justifies each line as well. Prompts for a postfix to be appended to each line. (defalias 'ada-fill-comment-paragraph-postfix #[nil "ÀÁ‰\"‡" [ada-fill-comment-paragraph t] 3 (#$ . 12479) nil]) #@274 Fills the current comment paragraph. If JUSTIFY is non-nil, each line is justified as well. If POSTFIX and JUSTIFY are non-nil, `ada-fill-comment-postfix' is appended to each filled and justified line. If `ada-indent-comment-as-code' is non-nil, the paragraph is idented. (defalias 'ada-fill-comment-paragraph #[(&optional justify postfix) "À Á‰‰‰ÂÁ Ê „ËÌ!ˆ ƒ-ƒ-ÏÐ\" ƒ=ƒ=ÏÒ\"ÓÔ!ˆŠÕ ˆÖ×!ƒZÖØ!„ZÙyˆÕ ˆ‚EÚyˆÀ  bˆÕ ˆÖ×!ƒ}ÖØ!„}ÛyˆÕ ˆ‚hÙyˆÜ ˆÕ ˆiÀ ) ƒ¯ƒ¯ŠbˆÝ\fÞPß#ƒ®àÞ!ˆ‚œ)ŠbˆÚyˆÝáß#ƒÇàÂ!ˆ‚·)\" Z#GZƒÛG‚ÜÚZ\"äS #ˆ\" #GƒúG‚ûÚ\\\\\\\"ŠbˆåyˆÁˆÀ )Šbˆ jˆ#cˆÝÞSß#ƒ6àÞ#P!ˆÚyˆ jˆ‚) ƒsƒsƒsŠbˆÝÞSß#ƒ_àÞP!ˆ‚KÁˆæç\"iZGZ\"ˆcˆ)ŠSbˆÁˆèÙ!ˆ)Óé!ˆ bˆ.߇" [point-marker nil "" fill-prefix ada-fill-comment-old-postfix indent end-2 end begin opos ada-in-comment-p error "not inside comment" justify postfix read-from-minibuffer "enter new postfix string: " ada-fill-comment-postfix "enter already existing postfix string: " message "filling comment paragraph ..." back-to-indentation looking-at "--.*$" "--[ ]*$" 1 0 -1 ada-indent-current re-search-forward "\n" t replace-match "^[ ]*--[ ]*" fill-column ada-fill-comment-prefix fill-region -2 insert-char 10 delete-char "filling comment paragraph ... done"] 7 (#$ . 12715) "P"]) #@321 Calls the external Pretty Printer. The name is specified in `ada-external-pretty-print-program'. Saves the current buffer in a directory specified by `ada-tmp-directory', starts the pretty printer as external process on that file and then reloads the beautyfied program in the buffer and cleans up `ada-tmp-directory'. (defalias 'ada-call-pretty-printer #[nil "p`ÁÂ!Ã!\fÃ!P \n ÌÍ!ˆÎ !ˆÏÁ!ˆÌÐ!ˆÌÑ!ˆÒÓ!ÔÁÖ %ˆ×!ƒOØÖ\"ˆ‚TÙ!ˆÌÚ!ˆÛÜ!ƒnÝÁ!ˆÙ\n!ˆÞ !ˆ‚rÌß!ˆà !ˆá !ˆÏÖ!ˆ b.‡" [buffer-file-name nil file-name-directory file-name-nondirectory ada-tmp-directory tmp-file-with-directory filename-without-path file-path mesgbuf orgpos curbuf filename-with-path message "saving current buffer to temporary file ..." write-file auto-save-mode "saving current buffer to temporary file ... done" "running external pretty printer ..." get-buffer-create "Pretty Printer Messages" call-process ada-external-pretty-print-program t buffer-modified-p display-buffer kill-buffer "running external pretty printer ... done" y-or-n-p "Really replace current buffer with pretty printer output ? " set-buffer-modified-p find-file "old buffer contents restored" delete-file set-visited-file-name] 9 (#$ . 14050) nil]) (defalias 'ada-after-keyword-p #[nil "ŠÀvˆŠ`eU„ÁÂ!ˆÃÄ!)?…à ÆP!)‡" [-1 backward-char 1 looking-at "_" ada-keywords "[^_]"] 3]) (defalias 'ada-after-char-p #[nil "Š`ÀV… ÁuˆÂÃ!)‡" [2 -2 looking-at "'"] 2]) #@219 Adjust the case of the word before the just typed character. Respect options `ada-case-keyword', `ada-case-identifier', and `ada-case-attribute'. If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier. (defalias 'ada-adjust-case #[(&optional force-identifier) "Àuˆ`ÁVƒU „Uà „UÄ „U`SfzÅ=ƒUŠÀvˆ`eU„/ÆÁ!ˆÇÈ!)ƒ> À!ˆ‚U\n„PË ƒP\fÀ!ˆ‚U À!ˆÁu‡" [-1 1 ada-in-string-p ada-in-comment-p ada-after-char-p 119 backward-char looking-at "'" ada-case-attribute force-identifier ada-after-keyword-p ada-case-keyword ada-case-identifier] 2 (#$ . 15486)]) (defalias 'ada-adjust-case-interactive #[(arg) "‰Â=„ Ã=ƒ2ÄcˆÅ ˆÆÇ!ˆ Â=ƒ% ˆ‚E Ã=ƒE ˆ‚E Ê=ƒ>Ë ˆ‚EÌÍ!!ˆ Ï=ƒQÅÐ!‚SÅ )‡" [last-command-char lastk 10 13 " " ada-adjust-case delete-backward-char 1 ada-lfd-binding ada-ret-binding 9 ada-tab self-insert-command prefix-numeric-value arg 95 t] 4 nil "P"]) (defalias 'ada-activate-keys-for-case #[nil "„ÁÂ! „ÁÄ!ÅÆÇ\"‡" [ada-ret-binding key-binding " " ada-lfd-binding "\n" mapcar #[(key) "À  !Ä#‡" [define-key ada-mode-map char-to-string key ada-adjust-case-interactive] 4] (96 126 33 64 35 36 37 94 38 42 40 41 45 61 43 91 123 93 125 95 92 124 59 58 39 34 60 44 46 62 63 47 10 32 13)] 3]) #@133 Capitalizes the first letter and the letters following `_'. ARG is ignored, it's there to fit the standard casing functions' style. (defalias 'ada-loose-case-word #[(&optional arg) "`ÀÃÄxˆ „ÅÆ\nÀ#ƒ' ƒÄÇg–È\"ˆÉÈ!ˆ‚\nb*‡" [t first pos "a-zA-Z0-9_" nil search-forward "_" insert-char 1 delete-char] 4 (#$ . 16717)]) #@110 Adjusts the case of all words in the region. Attention: This function might take very long for big regions ! (defalias 'ada-adjust-case-region #[(from to) "À‰‰‰ÅŽŠÆ!ˆbˆÉÊ Ì#ƒX` ZÍÎÏ` Z\"!ˆÐuˆÑ „`ÒÔP!ÕÀwˆ\nƒM×!ˆ‚R×!ˆ\fbˆ‚ÍÙ!.‡" [nil reldiff keywordp end begin ((set-syntax-table ada-mode-syntax-table)) set-syntax-table ada-mode-symbol-syntax-table to re-search-backward "[^a-zA-Z0-9_]\\([a-zA-Z0-9_]+\\)[^a-zA-Z0-9_]" from t message format "adjusting case ... %5d characters left" 1 ada-in-string-or-comment-p looking-at ada-keywords "[^_]" "a-zA-Z0-9_" ada-case-keyword -1 ada-case-identifier "adjusting case ... done"] 5 (#$ . 17047) "*r"]) #@116 Adjusts the case of all words in the whole buffer. ATTENTION: This function might take very long for big buffers ! (defalias 'ada-adjust-case-buffer #[nil "Àed\"‡" [ada-adjust-case-region] 3 (#$ . 17725) "*"]) #@280 Reformats a parameter list. ATTENTION: 1) Comments inside the list are killed ! 2) If the syntax is not correct (especially, if there are semicolons missing), it can get totally confused ! In such a case, use `undo', correct the syntax and try again. (defalias 'ada-format-paramlist #[nil "À‰‰‰ÅŽÆ!ˆÈ „ÉÊ!ˆË\fÍPÎÀ#ˆËÏÀ‰Î$ˆÐÑ!ˆ`ÒÑ!ˆ`ÓÔ!ˆËÕÎÀÎ$ˆÑuˆ`Ö\fT \"\f\nS|ˆ\fbˆ× !-‡" [nil paramlist delend end begin ((set-syntax-table ada-mode-syntax-table)) set-syntax-table ada-mode-symbol-syntax-table ada-in-paramlist-p error "not in parameter list" ada-search-ignore-string-comment ada-subprog-start-re "\\|\\" t "(" backward-char 1 forward-sexp delete-char -1 "[^ \n]" ada-scan-paramlist ada-insert-paramlist] 5 (#$ . 17942) nil]) (defalias 'ada-scan-paramlist #[(begin end) "À‰ÁÀ‰‰‰ bˆƒÝÊ ˆ`ËÌÀ Á$‰ƒ4\n@\nA‚7  bˆÎÏ!ˆÐ”Е{CËÑÀ\fÁ$ˆ`ÒËÓÀ\fÁ$:C\" bˆÒËÔÀ\fÁ$:C\" bˆÒËÕÀ\fÁ$:C\" bˆÊ ˆÎÖ!ƒ”ÐvˆÊ ˆ‚…Î×!ˆÒؔؕ{C\"Ø•‰bˆÒËÙÀ\fÁ$‰…¼\n@\f{C\"ÒC\"\f =ƒ×À‰‚ bˆ‚Ú!.‡" [nil t match-cons semipos epos apos notend param paramlist begin ada-goto-next-non-ws ada-search-ignore-string-comment "[ \n]*;" end looking-at "\\([a-zA-Z0-9_, \n]*[a-zA-Z0-9_]\\)[ \n]*:[^=]" 1 ":" append "\\" "\\" "\\" "\\<\\(in\\|out\\|access\\)\\>" "\\<[a-zA-Z0-9_\\.]+\\>" 0 ":=" reverse] 8]) (defalias 'ada-insert-paramlist #[(paramlist) "GÁ‰‰Â‰‰‰Á \n \f\fÁU„ƒ\fS\f \f8@G‰ Xƒ< ‚>  \nÍ\f88G‰ XƒU ‚W\n\n†d\f8A@†qÎ\f88†~Ï\f88‚ŠÐÑÂÒ#ˆÓÔ!)ƒ—Õ ˆ‚¬Õ ˆÖ ˆ× ˆ`ŠØ \f!)‰jˆÙcˆiG\f\fÁU„i\fS\f \f8@cˆ  Ú\\\\jˆÛcˆi\f8A@ƒæÜcˆ‚ü„ðƒüÏ\f88„üÝcˆÎ\f88ƒ Þcˆ‚!„ƒ!Ï\f88„!ßcˆÏ\f88ƒ-àcˆiÍ\f88cˆá\f88ƒP \nÚ\\\\jˆá\f88cˆ\fÁU„câcˆÖ ˆ jˆ‚µãcˆ‚µÓä!?…rå .\n‡" [paramlist 0 nil firstcol orgpoint column accessp outp inp temp typlen parlen i 4 2 3 re-search-backward "^.\\|[^ ]" t looking-at "^." ada-indent-current newline delete-horizontal-space ada-indent-function "(" 1 ": " "in " " " "out " " " "access " 5 ";" ")" "[ ]*[;\n]" ada-indent-newline-indent] 11]) #@65 Moves point to the matching start of the current Ada structure. (defalias 'ada-move-to-start #[nil "`ÁŽÂ !ˆÄÅ!ˆŠÆ „PÇÈ!„ÉÊ!ˆÇÈ!„&ÉÊ!ˆÇÈ!„2ËÌ!ƒPÍÊ!ƒP`‰ƒPƒPÇÏ!ƒPÐ ƒP`)bˆÄÑ!*‡" [pos ((set-syntax-table ada-mode-syntax-table)) set-syntax-table ada-mode-symbol-syntax-table message "searching for block start ..." ada-in-string-or-comment-p looking-at "[ ]*\\" backward-word 1 error "not on end ...;" ada-goto-matching-start ada-move-to-declaration "\\" ada-goto-matching-decl-start "searching for block start ... done"] 2 (#$ . 20103) nil]) #@111 Moves point to the matching end of the current block around point. Moves to 'begin' if in a declarative part. (defalias 'ada-move-to-end #[nil "`À‰ÄŽÅ!ˆÇÈ!ˆŠÉuˆŠÊ ˆËÌ!)ƒ'ÍÉ!ˆ‚£ŠÎ …0ËÏ!)ƒ;ÐÌ!ˆ‚£ŠÎ …\\ËÑ!…\\Év…\\ÐÒ!…\\ÓÉ!?…\\ËÔ!)ƒgÐÌ!ˆ‚£ŠÎ …pËÕ!)ƒ{ÍÖ!ˆ‚£Š×Ø!……ËÙ!)ƒÍÉ!ˆ‚£Š×Ø!)ƒŸÐÌ!ˆ‚£ÍÉ!ˆ`) bˆÇÚ!,‡" [nil packdecl decstart pos ((set-syntax-table ada-mode-syntax-table)) set-syntax-table ada-mode-symbol-syntax-table message "searching for block end ..." 1 ada-goto-previous-word looking-at "\\" ada-goto-matching-end ada-goto-stmt-start "\\\\|\\" ada-search-ignore-string-comment "\\" "[^ \n ]" backward-char "\\" "\\" 0 ada-goto-matching-decl-start t "\\" "searching for block end ... done"] 3 (#$ . 20680) nil]) #@61 Indents the region using `ada-indent-current' on each line. (defalias 'ada-indent-region #[(beg end) "bˆÁ \"ÄÅ \"\"Æ ! \nËÌ͈ÎÏ!,‡" [beg 0 count-lines end format "indenting %4d lines %%4d lines remaining ..." copy-marker endmark msg lines-remaining block-done err (byte-code "`Wƒ- ÂVƒÃÄ \"!ˆÇÈÉ!„Ê ˆËyˆ TS‚‡" [endmark block-done 9 message format msg lines-remaining 0 looking-at "^$" ada-indent-current 1] 4) ((error (byte-code "ÀÁÂÃe`\"T\f#Å\"‡" [error format "line %d: %s" count-lines err nil] 6))) message "indenting ... done"] 7 (#$ . 21496) "*r"]) #@76 Indents the current line, inserts a newline and then indents the new line. (defalias 'ada-indent-newline-indent #[nil "À‰à ˆÄ ˆÅ ˆ`ÆŽÇ!ˆŠÉ !))\njˆÊË!?…*à *‡" [nil orgpoint column ada-indent-current newline delete-horizontal-space ((set-syntax-table ada-mode-syntax-table)) set-syntax-table ada-mode-symbol-syntax-table ada-indent-function looking-at "[ ]*$"] 2 (#$ . 22084) "*"]) #@465 Indents current line as Ada code. This works by two steps: 1) It moves point to the end of the previous code line. Then it calls the function to calculate the indentation for the following line as if a newline would be inserted there. The calculated column # is saved and the old position of point is restored. 2) Then another function is called to calculate the indentation for the current line, based on the previously calculated column #. (defalias 'ada-indent-current #[nil "ÀŽÁ\n!ˆÃÄ Ã‰Å \nŠËÅ!ƒ/Ìyˆ`\nŠÍ \n!)‚8ÎyˆÏ ˆÃ)…bÐ ˆÑ!iU„UÏ ˆjˆ bˆiÒ W…bÐ .‡" [((set-syntax-table ada-mode-syntax-table)) set-syntax-table ada-mode-symbol-syntax-table nil point-marker t prevline prev-indent cur-indent orgpoint line-end ada-goto-prev-nonblank-line 1 ada-indent-function 0 delete-horizontal-space back-to-indentation ada-get-current-indent current-indentation] 5 (#$ . 22480) nil]) (defalias 'ada-get-current-indent #[(prev-indent) "À‰‰\fƒ=Å „=Æ ‰ƒ=ŠÇÈÉÀ#ƒ8ÊË!ƒ8ÇÌÉÀ#ƒ8ÊÍ!ƒ8 \\) ‚¦ÊÏ!ƒwŠÐÑ!ˆÊÒ!ƒqŠÓ ˆÊÒ!)„qŠÇÉÀ#‰…iÊÒ!?)ƒq @bˆÕ )‚¦ÊÖ!ƒˆŠÐÑ!ˆÕ )‚¦Ê×!ƒœŠÐÑ!ˆÕ \\)‚¦ÊÙ!ƒ¿ŠÚ ˆÊÛ!)ƒ²‚¦ŠÐÑÀÉ#ˆÕ )‚¦ÊÝ!ƒÒŠÐÑÀÉ#ˆÕ )‚¦ÊÞ!ƒøŠÚ ˆÊß!)ƒè‚¦ŠÇàÉÀ#ˆÕ !\\)‚¦ÊÒ!ƒ5`Šâ•bˆã ˆÊä!ƒ‚1Ê!„!ÇÀ\n#ˆÊÒ!ƒ,‚1Õ !\\)‚¦Êå!ƒQŠæÉ!ƒGÕ ‚Mçè!ˆ)‚¦Êé!ƒ‹*ƒ~Šâ•bˆëŠÀˆ`)!ˆÊì!)ƒ~Šã ˆÕ -\\)‚¦Šã ˆÕ !\\)‚¦Êî!ƒ­ŠÇïÉÀ#ˆÊð!ƒ¤ÇñÉÀ#ˆÕ 2\\)‚¦ó ƒ½ŠÐÑ!ˆÕ )‚¦ô ƒÌŠæ ˆÕ )‚¦Êõ!ƒÞ-Z[Z‚¦Êö!ƒŠ÷ø!ˆÊù!ƒŠúû!ˆÊü!)ƒiT‚)‚¦Êý!ƒŠã ˆÕ !\\)‚¦Êþ!ƒDŠÑuˆã ˆÊþ!)ƒDŠæÉ!ƒ>Êÿ!ƒ>i‚@)‚¦Ê@!ƒ`A ƒX‚¦B\\‚¦ÊC!ƒm‚¦Êù!ƒx‚¦ÊD!ƒŠÑuˆúÑ!ˆi)‚¦ÊE!ƒ¤FƒŸ‚¦Õ ‚¦+‡" [nil match-cons pos column ada-indent-to-open-paren ada-in-paramlist-p ada-in-open-paren-p ada-search-ignore-string-comment "[^ ]" t looking-at "\n" "[^ \n]" ">" ada-broken-indent "\\" ada-goto-matching-start 1 "\\" back-to-indentation ada-loop-start-re current-indentation "\\" "\\" ada-when-indent "\\" ada-goto-previous-word "\\" prev-indent "\\" "\\" "\\" "\\\\|\\" ada-stmt-end-indent 0 ada-goto-stmt-start "\\\\|\\" "\\" ada-goto-matching-decl-start message "no matching declaration start" "\\" ada-indent-is-separate ada-goto-next-non-ws "\\\\|\\" ada-indent "\\" "\\<\\(type\\|use\\)\\>" "\\" "\\" ada-indent-record-rel-type ada-looking-at-semi-or ada-looking-at-semi-private "\\<\\(new\\|abstract\\|separate\\)\\>" "\\" forward-sexp -1 "(" backward-sexp 2 "\\" "\\" "\\<\\(package\\|function\\|procedure\\)\\>" "generic" "\\<[a-zA-Z0-9_]+[ \n]*:[^=]" ada-in-decl-p ada-label-indent "\\<[a-zA-Z0-9_]+[ \n]*" ")" "--" ada-indent-comment-as-code] 4]) (defalias 'ada-indent-function #[(&optional nomove) "`À‰Ä ƒÅ‚À„Ç  `=ƒ(„(È‚À ƒ7Ê ƒ7Ë‚ÀÌÍ!ƒB΂ÀÌ!ƒNЂÀÌ!ƒZÒ‚ÀÌÓ!ƒeÒ‚ÀÌ!ƒqÕ‚ÀÌÖ!ƒ|ׂÀÌØ!ƒ‡Ù‚ÀÌÚ!ƒ’Û‚ÀÌÜ!ƒÝ‚ÀÌÞ!ƒ¨ß‚ÀÌà!ƒ³á‚ÀÌâ!ƒ¾È‚Àã\n+‡" [nil stmt-start func orgpoint ada-in-paramlist-p ada-get-indent-paramlist nomove ada-goto-stmt-start ada-get-indent-nochange ada-indent-to-open-paren ada-in-open-paren-p ada-get-indent-open-paren looking-at "\\" ada-get-indent-end ada-loop-start-re ada-get-indent-loop ada-subprog-start-re ada-get-indent-subprog "\\" ada-block-start-re ada-get-indent-block-start "\\" ada-get-indent-type "\\<\\(els\\)?if\\>" ada-get-indent-if "\\" ada-get-indent-case "\\" ada-get-indent-when "--" ada-get-indent-comment "[a-zA-Z0-9_]+[ \n]*:[^=]" ada-get-indent-label "\\" ada-get-indent-noindent] 3]) (defalias 'ada-get-indent-open-paren #[(orgpoint) "À ‡" [ada-in-open-paren-p] 1]) (defalias 'ada-get-indent-nochange #[(orgpoint) "ŠÀyˆÁ )‡" [-1 current-indentation] 1]) (defalias 'ada-get-indent-paramlist #[(orgpoint) "ŠÀÁÂÃÂ$ˆÄÅ!ƒÆ•bˆi‚<ÄÇ!ƒ,ÀÈÂÃÂ$AbˆÉ ˆi‚<ÀÈÂÃÂ$AbˆÉ ˆi\n\\)‡" [ada-search-ignore-string-comment "[^ \n]" t nil looking-at "(" 0 ";" "(\\|;" ada-goto-next-non-ws ada-broken-indent] 5]) (defalias 'ada-get-indent-end #[(orgpoint) "À‰ŠÃÄÀ #)ƒŸÆvˆÇ ˆÈÉ!ƒXŠÊ˔˕{!ˆÈÌ!ƒ/ÆvˆÍ ˆÈÎ!ƒ<Ë•bˆÇ ˆÈÏÐÑQ!„RÃÏÐÑQ!„RÒÆ!ˆÓ )‚¤È!ƒt˔˕{ŠÕË!ˆÖ\n!ˆÓ )‚¤ÈÄ!ƒ—ŠÕË!ˆÈ×!…“iØÙ!ƒ’Ó ‚“ )‚¤Ó \\‚¤Ó \\*‡" [nil indent defun-name ada-search-ignore-string-comment ";" orgpoint 1 ada-goto-next-non-ws looking-at "\\<\\(loop\\|select\\|if\\|case\\|record\\)\\>" ada-check-matching-start 0 "\\<\\(loop\\|record\\)\\>" ada-goto-stmt-start "[a-zA-Z0-9_]+[ \n ]+:" "\\<\\(" "loop\\|select\\|if\\|case\\|" "record\\|while\\|type\\)\\>" backward-word current-indentation ada-ident-re ada-goto-matching-start ada-check-defun-name "\\" ada-goto-matching-decl-start t ada-broken-indent] 4]) (defalias 'ada-get-indent-case #[(orgpoint) "À Á`ŠÅÆÁ#‰)ƒ.Š @bˆÅÈÉ\n#„%ÊË!ˆÀ \f\\)‚aŠÅÈÁ#‰)ƒG AbˆÀ  \\‚aŠÅÎÁ#‰)ƒ\\À \\‚aÀ  \\+‡" [current-indentation nil opos match-cons cur-indent ada-search-ignore-string-comment "[ \n]+=>" orgpoint "\\" t error "missing 'when' between 'case' and '=>'" ada-indent ada-broken-indent "\\" ada-when-indent] 4]) (defalias 'ada-get-indent-when #[(orgpoint) "À ÂÃÄ #ƒ \\‚ \\)‡" [current-indentation cur-indent ada-search-ignore-string-comment "[ \n]+=>" nil orgpoint ada-indent ada-broken-indent] 4]) (defalias 'ada-get-indent-if #[(orgpoint) "À ÁÄÅÆÁ$ƒGŠÈ ˆÉÅ!)ƒÀ ÊvˆËÌÁ#‰ƒ@\n@bˆ À ZÎÏ!!\\\\‚K  \\‚K \\*‡" [current-indentation nil match-cons cur-indent ada-search-but-not "\\" "\\[ \n]+\\" orgpoint back-to-indentation looking-at 1 ada-search-ignore-string-comment "[^ \n]" ada-indent ada-indent-function t ada-broken-indent] 5]) (defalias 'ada-get-indent-block-start #[(orgpoint) "À ÁŠÄvˆÅÆÁ#@‰)ƒ$\nbˆŠÈÉ!!)‚)À \n\\*‡" [current-indentation nil pos cur-indent 1 ada-search-ignore-string-comment "[^ \n]" orgpoint ada-indent-function t ada-indent] 4]) (defalias 'ada-get-indent-subprog #[(orgpoint) "ÀÁ ÀÂ`ŠÈÉÀ\n#‰)ƒ%ËAbˆ‚8ÈÌÀ\n#ƒ4Í ˆ‚8\nbˆ ƒPŠÈÌÀ\nË$)„P\\‚¦ ƒtŠÈÏÀ\n#‰)ƒt@bˆÈË\"ˆÑ\n!‚¦ ƒ‘ŠÈÌÀ\n#)ƒ‘Í ƒ‘ÒË!\n!†¦ŠÈÓÀ\n#)ƒ¡‚¦\\-‡" [nil current-indentation 0 fstart addind foundis cur-indent match-cons ada-search-ignore-string-comment "\\\\|\\" orgpoint t "[^ \n]" ada-goto-next-non-ws ada-indent "\\<\\(separate\\|new\\|abstract\\)\\>" ada-subprog-start-re ada-get-indent-noindent ada-indent-function ";" ada-broken-indent] 5]) (defalias 'ada-get-indent-noindent #[(orgpoint) "ŠÀÁ #)ƒ Ä ‡Ä \\‡" [ada-search-ignore-string-comment ";" nil orgpoint current-indentation ada-broken-indent] 4]) (defalias 'ada-get-indent-label #[(orgpoint) "ÀÁ ÄÅ!AbˆŠÄÀ#‰)ƒ$ @bˆÈ!‚ŒŠÄÉÀ#‰)ƒ?Š @bˆÁ \n\\)‚ŒŠÄËÀ#)ƒZÌ ƒS\n‚Œ\n Z‚ŒŠÄÎÀ#)ƒ|Ì ƒq\n\\‚Œ\n [\\\\‚ŒÌ ƒˆ\n\\‚Œ\n Z*‡" [nil current-indentation cur-indent match-cons ada-search-ignore-string-comment ":" ada-loop-start-re orgpoint ada-get-indent-loop "\\" ada-indent ";" ada-in-decl-p ada-label-indent "[^ \n]" ada-broken-indent] 4]) (defalias 'ada-get-indent-loop #[(orgpoint) "À`ŠÃÄÀ #)ƒÆ ‚ÓÇÈ!ƒÉ !‚ÓÇÊ!ƒ¢ŠË•b…`ÃÌÀ #…`ÍÎ!?…`ÏÀwËU?…`ÃÌÀ #…`ÍÎ!?…`ÇÐ!…`ÃÑÀ #Ò)ƒt\nƒl\n@bˆÆ \\‚ÓŠÃÔÀ #‰)ƒš\n@bˆŠÕ ˆÇÔ!)„’ bˆÆ \\‚ÓÆ \\‚ÓÇ×!…ÓŠÃÔÀ #‰)ƒÎ\n@bˆŠÕ ˆÇÔ!)„Æ bˆÆ \\‚ÓÆ \\*‡" [nil pos match-cons ada-search-ignore-string-comment ";" orgpoint current-indentation looking-at "loop\\>" ada-get-indent-block-start "for\\>" 0 "[^ /n/t]" backward-char 1 "_a-zA-Z0-9'" "\\" "\\" t ada-indent "\\" back-to-indentation ada-broken-indent "while\\>"] 4]) (defalias 'ada-get-indent-type #[(orgpoint) "ÀŠÂÃÀ\f#‰…%Å …%ÆÇ!…%Èv…%Å …%ÆÉ!)ƒ2 @bˆÊ ‚yŠÂÇÀ\f#‰)ƒJ @bˆÊ  \\‚yŠÂÉÀ\f#)ƒYÊ ‚yŠÂÌÀ\f#…hÂÍÀ\f#?)ƒtÊ  \\‚yÊ \\)‡" [nil match-dat ada-search-ignore-string-comment "\\" orgpoint ada-goto-next-non-ws looking-at "\\" 1 ";" current-indentation ada-indent "\\" "[^ \n]" ada-broken-indent] 4]) (defalias 'ada-goto-stmt-start #[(&optional limit) "À`Ã\f!‰ƒ,Š\nAbˆÅÆÀ #)„Ã\f!\nƒ&\nAbˆÇ ˆ‚CebˆÅÆÀ #‰ƒ@\n@bˆ‚C bˆ`*‡" [nil orgpoint match-dat ada-search-prev-end-stmt limit ada-search-ignore-string-comment "[^ \n]" ada-goto-next-non-ws] 5]) (defalias 'ada-search-prev-end-stmt #[(&optional limit) "À‰‰ „;Ä Æ#‰ƒ; @bˆÈ „ÉÊ!ƒ/ŠË ˆÉÌ!)„5Ɖ‚Ívˆ‚ …@ +‡" [nil found pos match-dat ada-search-ignore-string-comment ada-end-stmt-re t limit ada-in-open-paren-p looking-at "\\<\\(record\\|loop\\|select\\)\\>" ada-goto-previous-word "\\" -1] 5 nil nil]) (defalias 'ada-goto-next-non-ws #[(&optional limit) "ÀÂÃÀ\fÅ$‰ƒ @b‚\f?…ÆÇ!)‡" [nil match-cons ada-search-ignore-string-comment "[^ \n]" limit t error "no more non-ws"] 6]) (defalias 'ada-goto-stmt-end #[(&optional limit) "À  #… `‡" [ada-search-ignore-string-comment ada-end-stmt-re nil limit] 4]) (defalias 'ada-goto-previous-word #[nil "À`ÃÄÅÀÅ$‰ƒ\nAbˆÆÀxˆ`‚ bˆÀ*‡" [nil orgpoint match-cons ada-search-ignore-string-comment "[^ \n]" t "_a-zA-Z0-9"] 5]) (defalias 'ada-check-matching-start #[(keyword) "ÀÁ!ˆÂÃ\fÅQ!?…ÆÇ\fÈQ!‡" [ada-goto-matching-start 0 looking-at "\\<" keyword "\\>" error "matching start is not '" "'"] 4]) (defalias 'ada-check-defun-name #[(defun-name) "ÀÁ!„  ˆŠÀÃ!ƒÄ ˆ‚.ÅvˆÆÇ!ˆÀÈ!ƒ&ÇvˆÉÇ!ˆÊÇ!ˆÀË\fÍQ!?…DÎÏ`ÉÇ!ˆ`{P!)‡" [looking-at "\\<\\(accept\\|package\\|task\\|protected\\)\\>" ada-goto-matching-decl-start "\\" ada-goto-stmt-start 2 backward-word 1 "\\<\\(body\\|type\\)\\>" forward-sexp backward-sexp "\\<" defun-name "\\>" error "matching defun has different name: "] 5]) (defalias 'ada-goto-matching-decl-start #[(&optional noerror nogeneric) "ÀÁÂÁÇU„ÊÈÉÊËQÂ\"ƒÊÌÍ!ƒ5ÎÀ\"ˆÌÐ!ƒ T‰‚ ÌÑ!ƒESÁ‚ ÌÒ!ƒ–ŠÓ ˆÔÁxˆŠÕÀ!ˆÌÖ!)ƒjÀuˆ×À!ˆÔÁxˆÓ ˆÌØ!…Ù ÛŽÓ ˆÌÜ!*?)ƒŒÇ”bˆ‚ SÁ‚ ÌÝ!ƒ®ŠÓ ˆÌÒ!)ƒ Ç”bˆ‚ \fƒÀÌÐ!ƒÀÇ‚ TÁ‚ ÇUƒé „éÌÒ!ƒãÈÂ\"‚æÌÑ!„õ?…ößà!‚öÂ,‡" [1 nil t flag first pos nest-count 0 ada-search-ignore-string-comment "\\<\\(" "is\\|separate\\|end\\|declare\\|new\\|begin\\|generic" "\\)\\>" looking-at "end" ada-goto-matching-start noerror "begin" "declare\\|generic" "is" ada-goto-previous-word "a-zA-Z0-9_.'" backward-char ")" backward-sexp "\\" match-data match-data ((store-match-data match-data)) "\\" "new" ada-subprog-start-re error "no matching proc/func/task/declare/package/protected"] 5 nil nil]) (defalias 'ada-goto-matching-start #[(&optional nest-level noerror gotothen) "ƒ‚ Á‰\f„ŒÆÇÈÉQÊ\"ƒŒËÌ!ƒ( T‚„ËÍ!ƒL`ŠÎ ˆËÏ!ƒB T`‚E S) bˆ‚„ËÐ!ƒgŠÆÑ!ˆÒ ˆËÓ!„c S)‚„ËÔ!ƒŠÕvˆÒ ˆËÖ!„} S)‚„ S ÁU‰ƒ\fƒÉƒ³ËØ!ƒ³ŠÆÙ‰#ˆÚ ˆËÙ!)ƒ³Á”bˆ‚ÅËÛ!ƒÅÆÜÊÂ#„ÅÝÞ!ˆ`‚Ò?…ÒÝà!+‡" [nest-level 0 nil pos found nest-count ada-search-ignore-string-comment "\\<\\(" "end\\|loop\\|select\\|begin\\|case\\|do\\|" "if\\|task\\|package\\|record\\|protected\\)\\>" t looking-at "end" "loop\\|select\\|record\\|case\\|if" ada-goto-previous-word "\\" "package" "\\" ada-goto-next-non-ws "\\" "task" 1 "\\" gotothen "if" "\\" back-to-indentation "do" "\\" error "missing 'accept' in front of 'do'" noerror "no matching start"] 5]) (defalias 'ada-goto-matching-end #[(&optional nest-level noerror) "ƒ‚ Á „fÅÆÇP!ƒfÈÉ!ˆÊË!ƒ8\fSÌÂwˆÍ ˆÊÎ!ƒ^Évˆ‚^ÊÏ!ƒXÅÐ!ˆÍ ˆÊÑ!„Q\fT‚^ÒÂwˆ‚^\fTÉvˆ\fÁU‰ƒ „v?…wÔÕ!‚wÖ*‡" [nest-level 0 nil found nest-count ada-search-ignore-string-comment "\\<\\(end\\|loop\\|select\\|begin\\|case\\|" "if\\|task\\|package\\|record\\|do\\)\\>" backward-word 1 looking-at "\\" "end" ada-goto-next-non-ws "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>" "\\" "\\" "\\" "new" noerror error "no matching end" t] 4]) (defalias 'ada-forward-sexp-ignore-comment #[nil "ÀÁ!ƒÂÃwˆÃˆ‚ÄÅ!‡" [looking-at "[ \n]*--" "[ \n]" nil forward-sexp 1] 2]) (defalias 'ada-search-ignore-string-comment #[(search-re &optional backward limit paramlists) "À‰‰‰ ƒ\f‚ ÄÂ\f \nË#ƒÂÌ”Ì•Í ƒK ƒBÂÎÀË#ˆÌ”bˆ‚ËyˆÌyˆ‚Ï ƒg ƒ^ÂÐÀË#ˆÌ”bˆÃÐÀË#ˆ‚Š` ƒqË‚rÑZ‰f…† fÒU…† Ñ\\fÒU)„„¢Ô ƒ¢ ƒÕÖ×À×$ˆ‚ŠbˆØÎ!)ƒ» „ËyˆÌyˆ‚׉ƒ…ÌB-‡" [nil backward re-search-backward re-search-forward search-func pos end begin found search-re limit 1 0 ada-in-comment-p "--" ada-in-string-p "\"" 2 39 paramlists ada-in-paramlist-p ada-search-ignore-string-comment "(" t looking-at] 6]) (defalias 'ada-search-but-not #[(search-re not-search-re &optional backward limit) "À‰‰‰‰‰‰ „nŠÈ \n #‰:…,\n@\nAÌ)ƒnŠÈ \nÀ#‰:…E\n@\nAÌ)ƒW X„W Yƒ]̉‚\nƒg‚ibˆ‚ …{bˆB.‡" [nil found ret-cons end-not begin-end begin-not end begin ada-search-ignore-string-comment search-re backward limit t not-search-re] 8]) (defalias 'ada-goto-prev-nonblank-line #[(&optional ignore-comment) "ÀÁŠÄyÅUƒ1Åyˆ`ÆÇ!†ÆÈ!… ‰ƒ1Ê „1Äyˆ`‚) ?…;\nbˆÀ*‡" [t nil newpoint notfound -1 0 looking-at "[ ]*$" "[ ]*--" ignore-comment ada-in-limit-line-p] 2]) (defalias 'ada-goto-next-nonblank-line #[(&optional ignore-comment) "ÀÁŠÄyÅUƒ4Åyˆ`ÆÇ!†ÆÈ!… ‰ƒ4Ê „4ÄyˆÅyˆ`‚) ?…>\nbˆÀ*‡" [t nil newpoint notfound 1 0 looking-at "[ ]*$" "[ ]*--" ignore-comment ada-in-limit-line-p] 2]) (defalias 'ada-in-decl-p #[nil "À †\nŠÁÂ!)‡" [ada-in-paramlist-p ada-goto-matching-decl-start t] 2]) (defalias 'ada-looking-at-semi-or #[nil "ŠÀÁ!…ÂvˆÃ ˆÀÁ!)‡" [looking-at "\\" 1 ada-goto-stmt-start] 2]) (defalias 'ada-looking-at-semi-private #[nil "ŠÀÁ!…ÂvˆÃ ˆÀÁ!)‡" [looking-at "\\" 1 ada-goto-stmt-start] 2]) (defalias 'ada-in-limit-line-p #[nil "ŠÀyˆe`U)†ŠÁˆd`U)‡" [0 nil] 2]) (defalias 'ada-in-comment-p #[nil "ÀÁŠÂyˆ`)`\"8‡" [4 parse-partial-sexp 0] 4]) (defalias 'ada-in-string-p #[nil "ŠÀÁŠÂyˆ`)`\"8…ÃÄÅÆ#ˆ`SfÇU?)‡" [3 parse-partial-sexp 0 re-search-backward "\"" nil t 39] 4]) (defalias 'ada-in-string-or-comment-p #[nil "À †Á ‡" [ada-in-comment-p ada-in-string-p] 1]) (defalias 'ada-in-paramlist-p #[nil "ŠÀÁÂÃ#…0ÄÅ!…0ÆÇ!…0ÄÈÉÊQ!…0ËÌÂÃ#…0ÍÎ!?…0ÄÏ!)‡" [re-search-backward "(\\|)" nil t looking-at "(" backward-word 2 "\\<\\(" "procedure\\|function\\|body\\|package\\|" "task\\|entry\\|accept\\)\\>" re-search-forward ")\\|:" backward-char 1 ":"] 4]) (defalias 'ada-in-open-paren-p #[nil "`Wƒ\nÁ‚ `Z‰Æ `\"‰A@…CŠ\fA@TbˆŠÇÈÂÁ#ˆÉÁ!ˆÊË!?…9i‰)ƒA ‚Bi)+‡" [ada-search-paren-char-count-limit 1 nil col parse-result start parse-partial-sexp re-search-forward "[^ ]" backward-char looking-at "\n"] 5]) #@56 Do indenting or tabbing according to `ada-tab-policy'. (defalias 'ada-tab #[nil "Á=ƒ\nÂÃ!‡Ä=ƒÅ ‡Æ=ƒÇ ‡È=ƒ%É ‡Ê=ƒ.Ë ‡Ì=…7ÂÃ!‡" [ada-tab-policy indent-and-tab error "not implemented" indent-rigidly ada-tab-hard indent-auto ada-indent-current gei ada-tab-gei indent-af af-indent-line always-tab] 2 (#$ . 37069) nil]) #@57 Delete leading indenting according to `ada-tab-policy'. (defalias 'ada-untab #[(arg) "Á=ƒ  ‡Ã=ƒÄÅ!\"‡Ç=ƒ\"ÈÉ!‡Ê=…+ÈÉ!‡" [ada-tab-policy indent-rigidly ada-untab-hard indent-af backward-delete-char-untabify prefix-numeric-value arg indent-auto error "not implemented" always-tab] 3 (#$ . 37403) "P"]) #@47 Ada Mode version of the indent-line-function. (defalias 'ada-indent-current-function #[nil "À  ˆÃ ˆ` Wƒ bˆ ĉ“)‡" [point-marker starting-point ada-beginning-of-line ada-tab nil] 3 (#$ . 37723) "*"]) #@39 Indent current line to next tab stop. (defalias 'ada-tab-hard #[nil "ŠÀyˆÁ \"ˆ)Š`Àyˆ`U)… u‡" [0 insert-char 32 ada-indent] 3 (#$ . 37932) nil]) #@43 indent current line to previous tab stop. (defalias 'ada-untab-hard #[nil "ŠÀyˆ`)ŠÁˆ`)Ä \n [#*‡" [0 nil eol bol indent-rigidly ada-indent] 4 (#$ . 38085) nil]) #@45 remove trailing spaces in the whole buffer. (defalias 'ada-remove-trailing-spaces #[nil "À ÂŽŠŒ~ˆebˆÃÄdÅ#…ÆÇȉ#ˆ‚\f,‡" [match-data match-data ((store-match-data match-data)) re-search-forward "[ ]+$" t replace-match "" nil] 4 (#$ . 38254) nil]) (defalias 'ada-untabify-buffer #[nil "ŠÀed\")‡" [untabify] 3]) #@66 delete `comment-start' at the beginning of a line in the region. (defalias 'ada-uncomment-region #[(beg end) "À \nÃ#‡" [comment-region beg end -1] 4 (#$ . 38573) "r"]) #@61 Find other file in other window using `ff-find-other-file'. (defalias 'ada-ff-other-window #[nil "ÀÁ!… ÁÂ!‡" [fboundp ff-find-other-file t] 2 (#$ . 38747) nil]) #@32 Moves point to next procedure. (defalias 'ada-next-procedure #[nil "ÀˆÁ\nÀÃ#ƒÄ”b‡ÅÆ!‡" [nil re-search-forward ada-procedure-start-regexp t 1 error "No more functions/procedures/tasks"] 4 (#$ . 38915) nil]) #@36 Moves point to previous procedure. (defalias 'ada-previous-procedure #[nil "ÀyˆÁ\nÃÄ#ƒÅ”b‡ÆÇ!‡" [0 re-search-backward ada-procedure-start-regexp nil t 1 error "No more functions/procedures/tasks"] 4 (#$ . 39130) nil]) #@30 Moves point to next package. (defalias 'ada-next-package #[nil "ÀˆÁ\nÀÃ#ƒÄ”b‡ÅÆ!‡" [nil re-search-forward ada-package-start-regexp t 1 error "No more packages"] 4 (#$ . 39356) nil]) #@34 Moves point to previous package. (defalias 'ada-previous-package #[nil "ÀyˆÁ\nÃÄ#ƒÅ”b‡ÆÇ!‡" [0 re-search-backward ada-package-start-regexp nil t 1 error "No more packages"] 4 (#$ . 39547) nil]) (byte-code "„€Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÉ ƒ'ÂÊË#ˆ‚-ÂÌË#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆÂáâ#ˆÂãä#ˆÂåæ#ˆçèé\"ˆêë!‡" [ada-mode-map make-sparse-keymap define-key "\n" ada-indent-newline-indent " " ada-tab "\f" ada-indent-region ada-xemacs (shift tab) ada-untab [S-tab] "" ada-format-paramlist "" ada-call-pretty-printer "‘" ada-fill-comment-paragraph-postfix "…" ada-next-procedure "" ada-previous-procedure "" ada-move-to-start "" ada-move-to-end "" compile "" ada-adjust-case-region "" ada-adjust-case-buffer "" backward-delete-char-untabify ";" comment-region ":" ada-uncomment-region mapcar #[(pair) "À @ A\n#‡" [substitute-key-definition pair ada-mode-map] 4] ((beginning-of-line . ada-beginning-of-line) (end-of-line . ada-end-of-line) (forward-to-indentation . ada-forward-to-indentation)) require easymenu] 4) #@50 Adds the menu 'Ada' to the menu bar in Ada Mode. (defalias 'ada-add-ada-menu #[nil "ÀÁ!„ÂÁ BÄÁÅÆ#ˆÇÁÆÉ$ˆÊ …)Ë !ˆÌ B‰ ‡" [boundp ada-mode-menu nil current-load-list put variable-documentation "Menu keymap for Ada mode." easy-menu-do-define ada-mode-map ("Ada" ["Next Package" ada-next-package t] ["Previous Package" ada-previous-package t] ["Next Procedure" ada-next-procedure t] ["Previous Procedure" ada-previous-procedure t] ["Goto Start" ada-move-to-start t] ["Goto End" ada-move-to-end t] ["------------------" nil nil] ["Indent Current Line (TAB)" ada-indent-current-function t] ["Indent Lines in Region" ada-indent-region t] ["Format Parameter List" ada-format-paramlist t] ["Pretty Print Buffer" ada-call-pretty-printer t] ["------------" nil nil] ["Fill Comment Paragraph" ada-fill-comment-paragraph t] ["Justify Comment Paragraph" ada-fill-comment-paragraph-justify t] ["Postfix Comment Paragraph" ada-fill-comment-paragraph-postfix t] ["------------" nil nil] ["Adjust Case Region" ada-adjust-case-region t] ["Adjust Case Buffer" ada-adjust-case-buffer t] ["----------" nil nil] ["Comment Region" comment-region t] ["Uncomment Region" ada-uncomment-region t] ["----------------" nil nil] ["Compile" compile (fboundp (quote compile))] ["Next Error" next-error (fboundp (quote next-error))] ["---------------" nil nil] ["Index" imenu (fboundp (quote imenu))] ["--------------" nil nil] ["Other File Other Window" ada-ff-other-window (fboundp (quote ff-find-other-file))] ["Other File" ff-find-other-file (fboundp (quote ff-find-other-file))]) ada-xemacs easy-menu-add "Ada Mode" mode-popup-menu] 5 (#$ . 40615)]) (defalias 'ada-beginning-of-line #[(&optional arg) "Á=ƒ\n !‡Ä !‡" [ada-tab-policy indent-af af-beginning-of-line arg beginning-of-line] 2 nil "P"]) (defalias 'ada-end-of-line #[(&optional arg) "Á=ƒ\n !‡ ‡" [ada-tab-policy indent-af af-end-of-line arg] 2 nil "P"]) (defalias 'ada-current-column #[nil "Á=ƒ  ‡i‡" [ada-tab-policy indent-af af-current-column] 2]) (defalias 'ada-forward-to-indentation #[(&optional arg) "Á=ƒ\n !‡Ä !‡" [ada-tab-policy indent-af af-forward-to-indentation arg forward-to-indentation] 2 nil "P"]) #@70 Determine the filename of a package/procedure from its own Ada name. (defalias 'ada-make-filename-from-adaname #[(adaname) "ÀÂÃ!Š qˆÄÅÀ À&ˆeebˆÀˆ`{È !ˆ*‰‡" [nil krunch-buf generate-new-buffer "*gkrunch*" call-process "gnatk8" adaname ada-krunch-args kill-buffer] 7 (#$ . 42788) "s"]) #@120 Determine whether we are on a function definition/declaration. If that is the case remember the name of that function. (defalias 'ada-which-function-are-we-in #[nil "ÀŠÂ ÀÄ#ƒŔŕ{‰‚%ÂÀÄ#…%Ŕŕ{‰)‡" [nil ff-function-name re-search-backward ada-procedure-start-regexp t 0 ada-package-start-regexp] 4 (#$ . 43093)]) #@35 Create index alist for Ada files. (defalias 'imenu-create-ada-index #[(&optional regexp) "À‰‰ebˆÄ Ǝdž ÀÊ#ƒ+Ä  ÌŽÍ B*‚* Ÿ+‡" [nil char prev-pos index-alist match-data match-data ((store-match-data match-data)) re-search-forward regexp ada-procedure-start-regexp t match-data ((store-match-data match-data)) imenu-example--name-and-position] 4 (#$ . 43421)]) #@42 Subdued level highlighting for Ada mode. (defconst ada-font-lock-keywords-1 (byte-code "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏ°ÐÑEC‡" ["\\<\\(" "accept\\|" "entry\\|" "function\\|" "package[ ]+body\\|" "package\\|" "pragma\\|" "procedure\\|" "protected[ ]+body\\|" "protected[ ]+type\\|" "protected\\|" "task\\|" "task[ ]+body\\|" "task[ ]+type" "\\)\\>[ ]*" "\\(\\sw+\\(\\.\\sw*\\)*\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)] 16) (#$ . 43800)) #@40 Gaudy level highlighting for Ada mode. (defconst ada-font-lock-keywords-2 (byte-code "À ÂÃÄÅÆÇÈÉÊËÌÍ°\fÎÏÐÑQÒÓEÂÔÕQÖ×EØÙPÚÛEܯ\"‡" [append ada-font-lock-keywords-1 "\\<\\(" "a\\(b\\(ort\\|s\\(\\|tract\\)\\)\\|cce\\(pt\\|ss\\)\\|" "l\\(iased\\|l\\)\\|nd\\|rray\\|t\\)\\|begin\\|case\\|" "d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|" "e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|for\\|" "generic\\|i[fns]\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ot\\|ull\\)\\|" "o\\(r\\|thers\\|ut\\)\\|pr\\(ivate\\|otected\\)\\|" "r\\(ange\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|" "se\\(lect\\|parate\\)\\|" "t\\(agged\\|erminate\\|hen\\)\\|until\\|" "wh\\(ile\\|en\\)\\|xor" "\\)\\>" ("\\<\\(end\\)\\>[ ]+\\([a-zA-Z0-9_\\.]+\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) "\\<\\(access\\|constant\\|in\\|in[ ]+out\\|out\\)\\>" "[ ]*" "\\(\\sw+\\)?" (1 font-lock-keyword-face nil t) (2 font-lock-type-face nil t) "new\\|of\\|subtype\\|type" "\\)\\>[ ]*\\(\\sw+\\)?[ ]*\\((\\)?" (1 font-lock-keyword-face) (2 (if (match-beginning 4) font-lock-function-name-face font-lock-type-face) nil t) "\\<\\(goto\\|raise\\|use\\|with\\)\\>" "[ ]*\\([a-zA-Z0-9_\\.\\|, ]+\\)\\W" (1 font-lock-keyword-face) (2 font-lock-reference-face nil t) ("<<\\(\\sw+\\)>>" 1 font-lock-reference-face)] 14) (#$ . 44265)) #@117 Default Expressions to highlight in Ada mode. See the doc to `font-lock-maximum-decoration' for user configuration. (defvar ada-font-lock-keywords ada-font-lock-keywords-2 (#$ . 45606)) (defalias 'ada-gen-comment-until-proc #[nil "ÀyˆÁ`!ˆÂ ÄÅ#ƒÀ”bˆÆÇ `\"‡ÈÉ!‡" [1 set-mark-command re-search-forward ada-procedure-start-regexp nil t comment-region mark error "No more functions/procedures"] 4]) (defalias 'ada-gen-treat-proc #[(match) "@bˆÁ‰‰‰ÆÇ!‰„ÆÈ!‰…œÉvˆÊvˆ`A{AbˆË ˆ\fƒAÌvˆÍÁwˆ`ÎÁwˆ`{ÆÏ!ƒÐ”Е|ˆÑ ˆÒcˆÑ ˆ\fƒfÓcˆ\ncˆÔcˆÑ ˆÕcˆ cˆÑ ˆÖcˆÑ ˆ\fƒ×cˆÑ ˆØcˆ cˆÔcˆÑ ‚œÆÙ!†œÆÚ!†œÛÜ!,‡" [match nil functype procname func-found proc-found looking-at "^[ ]*procedure" "^[ ]*function" 2 -1 forward-sexp 1 " \n" "a-zA-Z0-9_." "[ ]*;" 0 ada-indent-newline-indent " is" "Result : " ";" "begin -- " "null;" "return Result;" "end " "[ \n]*is" "[ \n]*rename" message "unknown syntax"] 4]) #@244 Create an Ada package body in the current buffer. The potential old buffer contents is deleted first, then we copy the spec buffer in here and modify it to make it a body. This function typically is to be hooked into `ff-file-created-hooks'. (defalias 'ada-make-body #[nil "ed|ˆÀÁ A@!ˆÂ ˆÃÅ!‰ƒ#\fAbˆÇcˆ‚'ÈÉ!ˆÅ\n!‰…7Ë\f!ˆ‚')‡" [insert-buffer buffer-list ada-mode nil found ada-search-ignore-string-comment ada-package-start-regexp " body" error "No package" ada-procedure-start-regexp ada-gen-treat-proc] 2 (#$ . 46513) nil]) (provide (quote ada-mode)) emacs-19.30/lisp/add-log.elc100666 13437 13 22573 6055511574 14004 0ustar jimbuser;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 24 22:54:25 1995 ;;; from file /home/fsf/rms/e19/lisp/add-log.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`add-log.el' was compiled for Emacs 19.29 or later")) #@57 *Name of a change log file for \[add-change-log-entry]. (defvar change-log-default-name nil (#$ . -472)) #@233 *If non-nil, function to guess name of current function from surrounding text. \[add-change-log-entry] calls this function (if nil, `add-log-current-defun' instead) with no arguments. It returns a string or nil if it cannot guess. (defvar add-log-current-defun-function nil (#$ . -584)) #@133 *Full name of user, for inclusion in ChangeLog daily headers. This defaults to the value returned by the `user-full-name' function. (defvar add-log-full-name nil (#$ . -879)) #@128 *Electronic mail address of user, for inclusion in ChangeLog daily headers. This defaults to the value of `user-mail-address'. (defvar add-log-mailing-address nil (#$ . -1061)) #@57 Additional expressions to highlight in Change Log mode. (defvar change-log-font-lock-keywords (quote (("^[SMTWF].+" . font-lock-function-name-face) ("^ \\* \\([^ :\n]+\\)" 1 font-lock-comment-face) ("(\\([^)\n]+\\))" 1 font-lock-keyword-face))) (#$ . 1244)) #@35 Keymap for Change Log major mode. (defvar change-log-mode-map nil (#$ . 1508)) (byte-code "„ Á ÂÃÄ#ˆÁ‡" [change-log-mode-map make-sparse-keymap define-key "ñ" change-log-fill-paragraph] 4) (defalias 'change-log-name #[nil "† Â=ƒ\fÇ Ä=„ Å=ƒƇLJ" [change-log-default-name system-type vax-vms "$CHANGE_LOG$.TXT" ms-dos windows-nt "changelo" "ChangeLog"] 2]) #@31 Prompt for a change log name. (defalias 'prompt-for-change-log-name #[nil "À ÂÃÄÅ \"Æ #!È!ɘƒ\"ÂÈ !\"‚7Ê!ƒ5ÂÈ !Ë!\"‚7*‡" [change-log-name default expand-file-name read-file-name format "Log file (default %s): " nil name file-name-nondirectory "" file-directory-p file-name-as-directory] 5 (#$ . 1882)]) #@632 Find a change log file for \[add-change-log-entry] and return the name. Optional arg FILE-NAME specifies the file to use. If FILE-NAME is nil, use the value of `change-log-default-name'. If 'change-log-default-name' is nil, behave as though it were 'ChangeLog' (or whatever we use on this operating system). If 'change-log-default-name' contains a leading directory component, then simply find it in the current directory. Otherwise, search in the current directory and its successive parents for a file so named. Once a file is found, `change-log-default-name' is set locally in the current buffer to the complete file name. (defalias 'find-change-log #[(&optional file-name) "„} … !… ‰„} ƒ ÂÄ !!†! Æ!ƒ.ÇÈ \"Ä!Ç!‰É\n Ì !„kÍ !„kÂΠ!!!\n !\n˜„kÇÏÈ !\n\" ‚<Ì !„yÍ !ƒ| *ÐÁ!Lˆ‡" [file-name change-log-default-name file-name-directory buffer-file-name file-chase-links default-directory file-directory-p expand-file-name change-log-name nil parent-dir file1 get-file-buffer file-exists-p directory-file-name file-name-nondirectory make-local-variable] 5 (#$ . 2209)]) #@379 Find change log file and add an entry for today. Optional arg (interactive prefix) non-nil means prompt for user name and site. Second arg is file name of change log. If nil, uses `change-log-default-name'. Third arg OTHER-WINDOW non-nil means visit in other window. Fourth arg NEW-ENTRY non-nil means always create a new entry at the front; never append to an existing entry. (defalias 'add-change-log-entry #[(&optional whoami file-name other-window new-entry) "„Á \n„ \fƒÅÆ\"ÅÇ\n\"†!É Ê‰ \f ÎÏ!!ƒ]˜„]ÒÓÔÕ!!P\"ƒWÖ•ÊO‚[×! ƒrš„rÙ!ˆ‚wÚ!ˆÜ=„Ü ˆÝ ˆebˆÞÔß ÖàO!áÔ!âÔ\n!°!ƒ£ãyˆ‚­ß äâ\n屈Þæ!ƒºçÊwˆ‚¾èã!ˆ`\febˆéê\fë#ƒÙ ƒU cˆ‚U,„Ê-éÔî P!ïP\fë#)ƒéð!ˆÖ”bˆm„Þñ!ƒ`Šãyˆ`)|ˆ‚úòcˆóyˆô ˆ‚UãyˆÞõ!ƒ+ãyˆ‚m„AÞñ!ƒA`Šãyˆ`)|ˆ‚+öcˆóyˆ7jˆî †Rø±ˆ ƒvÝ ˆŠÖyˆÞù!)ƒlø‚múû ü±‚„ŠÖyˆÞý!)?…„þc+‡" [add-log-full-name user-full-name add-log-mailing-address user-mail-address whoami read-input "Full name: " "Mailing address: " add-log-current-defun-function add-log-current-defun nil entry paragraph-end defun expand-file-name find-change-log file-name buffer-file-name string-match "^" regexp-quote file-name-directory 0 file-name-nondirectory other-window find-file-other-window find-file major-mode change-log-mode undo-boundary looking-at current-time-string 10 ".* " " <" 1 " " ">\n\n" "\n*[^\n* ]" "\n" forward-paragraph re-search-forward "^\\s *\\*\\s *$" t new-entry case-fold-search "* " "\\(\\s \\|[(),:]\\)" "^\\s *$\\|^\\s \\*" "^\\s *$" "\n\n" -2 indent-relative-maybe "\\sW" "\n\n\n" left-margin "" "\\s *$" " " "(" "): " "\\s *\\(\\*\\s *\\)?$" ": "] 7 (#$ . 3328) (list current-prefix-arg (prompt-for-change-log-name))]) #@225 Find change log file in other window and add an entry for today. Optional arg (interactive prefix) non-nil means prompt for user name and site. Second arg is file name of change log. If nil, uses `change-log-default-name'. (defalias 'add-change-log-entry-other-window #[(&optional whoami file-name) "À \nÃ#‡" [add-change-log-entry whoami file-name t] 4 (#$ . 5045) (byte-code "…Á D‡" [current-prefix-arg prompt-for-change-log-name] 2)]) #@346 Major mode for editing change logs; like Indented Text Mode. Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74. New log entries are usually made with \[add-change-log-entry] or \[add-change-log-entry-other-window]. Each entry behaves as a paragraph, and the entries for one day as a page. Runs `change-log-mode-hook'. (defalias 'change-log-mode #[nil "À ˆÁ ˆÂÄÆÈ Ê !ˆÌÍ!ÎLˆÌÏ!ÎLˆÌÐ!ÑLˆÌÒ!ÓLˆÌÔ!ÕLˆÌÖ!×LˆØÙ!‡" [kill-all-local-variables indented-text-mode change-log-mode major-mode "Change Log" mode-name 8 left-margin 74 fill-column use-local-map change-log-mode-map make-local-variable paragraph-start "\\s *$\\|\f\\|^\\sw" paragraph-separate page-delimiter "^\\<\\|^\f" version-control never adaptive-fill-regexp "\\s *" font-lock-defaults (change-log-font-lock-keywords t) run-hooks change-log-mode-hook] 2 (#$ . 5494) nil]) #@108 Fill the paragraph, but preserve open parentheses at beginning of lines. Prefix arg means justify as well. (defalias 'change-log-fill-paragraph #[(&optional justify) "ŠÀ ˆ`)ŠÁ ˆ`)\nÃPÆ\f #+‡" [forward-paragraph backward-paragraph paragraph-start "\\|\\s *\\s(" beg end fill-region justify] 4 (#$ . 6362) "P"]) #@76 *Heuristic regexp used by `add-log-current-defun' for unknown major modes. (defvar add-log-current-defun-header-regexp "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[-_a-zA-Z]+\\)[ ]*[:=]" (#$ . -6683)) #@429 Return name of function definition point is in, or nil. Understands C, Lisp, LaTeX ("functions" are chapters, sections, ...), Texinfo (@node titles), Perl, and Fortran. Other modes are handled by a heuristic that looks in the 10K before point for uppercase headings starting in the first column or identifiers followed by `:' or `=', see variable `add-log-current-defun-header-regexp'. Has a preference of looking backwards. (defalias 'add-log-current-defun #[nil "ÀÁ‡" [nil (byte-code "Š` Â>ƒAm„ÃuˆÄ ˆÅ ˆ`W…ÆÇ!ˆ`Y…ÈÉ!ƒ/ÃuˆÆÃ!ˆÊËwˆ`ÆÃ!ˆ`{‚ Ì>ƒ…ŠÍyˆ`ÎZfÏ=ƒZÇyˆ‚KÈÐ!)ƒ…Íyˆ`ÎZfÏ=ƒsÇyˆ‚dÑÒ!ˆÓËwˆ`ÆÃ!ˆ`{‚ Ô>ƒ|ÍyˆÈÕ!„šÃyˆ‚Žm„¡ÃuˆÄ ˆÅ ˆ`W…ÖÃ!ˆË‰Çyˆo„ÊÈÙ!ƒÊÇyˆ‚ºËÚÛƒòbˆÜÃ!ˆ`fÝUƒèÆÃ!ˆÞËwˆ`ÆÃ!ˆ`{‚xÈß!ƒýà ‚x`Ëáâ…xŠbˆo„!ŠÇyˆÈã!)ƒ!Çyˆ‚\f`Y)…x`V…xˉ$%hæUƒ>Çuˆ`%ÖÃ!ˆ`$ÇvˆÈç!ƒeèËxˆ`%ÖÃ!ˆ`$Çvˆ‚KnƒrÈé!ƒr`$$%{**‚ ê>ƒ˜ëìËí#…Í”bˆ`Tˈ`{‚ î=ƒ®ëïËí#…ÔÕ{‚ ð=ƒÄëñËí#…ÔÕ{‚ ò=ƒøó ˆí4õöËí#…ôõ÷Ëí#ƒêÇuˆÓËxˆ‚íˈ`ÆÇ!ˆ`{)‚Ë4ˈë8`ùZí#…ÔÕ{)*‡" [location major-mode (emacs-lisp-mode lisp-mode scheme-mode lisp-interaction-mode) 1 beginning-of-defun end-of-defun forward-sexp -1 looking-at "\\s(" " '" nil (c-mode c++-mode c++-c-mode objc-mode) 0 2 92 "[ ]*#[ ]*define[ ]" search-forward "define" " " (c-mode c++-mode c++-c-mode objc-mode) "{\\|\\(\\s *$\\)" backward-sexp tem beg "[ \n]" (byte-code "ŠÀˆhÁUƒÂˆ‚ÃÄ!ˆÅyˆ`ÇÈ!)…& Y‡" [nil 92 2 backward-sexp 1 0 tem looking-at "DEFUN\\b" location] 2) ((error)) down-list 34 " ," "^[+-]" get-method-definition (byte-code "ÀÁ!ˆÂÁ!ˆÃÄxˆÅ‡" [down-list 1 backward-up-list " " nil t] 2) ((error)) "[^\n\f]" middle end 10 "public \\|private " " :" "struct \\|union \\|class " (TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode) re-search-backward "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" t texinfo-mode "^@node[ ]+\\([^,\n]+\\)" perl-mode "^sub[ ]+\\([^ \n]+\\)" fortran-mode beginning-of-fortran-subprogram case-fold-search re-search-forward "^[ ]*\\(program\\|subroutine\\|function\\|[ a-z0-9*]*[ ]+function\\)" "[(\n]" add-log-current-defun-header-regexp 10000] 4) ((error))] 3 (#$ . 6875)]) (byte-code "À BÀ‡" [get-method-definition-md current-load-list] 2) (defalias 'get-method-definition-1 #[(end) "Á”Á•{\nQÕb‡" [get-method-definition-md 1 end 0] 3]) (defalias 'get-method-definition #[nil "ÀŠÂÃÄÅ#ƒÆÇ!ˆ)ŠÈÉÄÅ#…1ÆÊ!ˆËÌ!„.ËÍ!ˆÆÊ!ˆ‚ ÎP*‡" ["[" get-method-definition-md re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t get-method-definition-1 " " re-search-forward "^\\([-+]\\)[ \n\f ]*\\(([^)]*)\\)?\\s-*" "" looking-at "[{;]" "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \n\f ]*" "]"] 4]) (provide (quote add-log)) emacs-19.30/lisp/cdl.elc100666 12120 1 2043 6045212117 13301 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:07:11 1995 ;;; from file /home/fsf/rms/e19/lisp/cdl.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cdl.el' was compiled for Emacs 19.29 or later")) #@68 Run file through ncdump and insert result into buffer after point. (defalias 'cdl-get-file #[(filename) "ÀÁ!ˆ`ÃÄÅÆÅÇ!%ˆ\nbˆ)ÀÉ!‡" [message "ncdump in progress..." start call-process "ncdump" nil t expand-file-name filename "ncdump in progress...done"] 7 (#$ . 466) "fCDF file: "]) #@57 Run region through ncgen and write results into a file. (defalias 'cdl-put-region #[(filename start end) "ÀÁ!ˆÂ \fÅƉ‰ÇÈ !&ˆÀÊ!‡" [message "ncgen in progress..." call-process-region start end "ncgen" nil "-o" expand-file-name filename "ncgen in progress...done"] 10 (#$ . 756) "FNew CDF file: \nr"]) emacs-19.30/lisp/advice.elc100666 12120 1 132345 5751545061 14055 0ustar rmsdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:11:06 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/advice.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/advice.el' was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÁÃ\"‡" [provide advice-preload require "advice.el"] 3) (defalias 'ad-lemacs-p '(macro . #[nil "ÀÁ\n\"‡" [string-match "Lucid" emacs-version] 3])) (byte-code "ÀÁ\nBÁ‡" ["2.14" ad-version current-load-list] 2) #@615 *Defines what to do with redefinitions during Advice de/activation. Redefinition occurs if a previously activated function that already has an original definition associated with it gets redefined and then de/activated. In such a case we can either accept the current definition as the new original definition, discard the current definition and replace it with the old original, or keep it and raise an error. The values `accept', `discard', `error' or `warn' govern what will be done. `warn' is just like `accept' but it additionally prints a warning message. All other values will be interpreted as `error'. (defvar ad-redefinition-action (quote warn) (#$ . -709)) #@501 *Defines whether to compile advised definitions during activation. A value of `always' will result in unconditional compilation, `never' will always avoid compilation, `maybe' will compile if the byte-compiler is already loaded, and `like-original' will compile if the original definition of the advised function is compiled or a built-in function. Every other value will be interpreted as `maybe'. This variable will only be considered if the COMPILE argument of `ad-activate' was supplied as nil. (defvar ad-default-compilation-action (quote maybe) (#$ . -1387)) (defalias 'ad-substitute-tree #[(sUbTrEe-TeSt fUnCtIoN tReE) ":ƒ, @!ƒ\n@!‚$@:ƒ\"à \n@#‚$@à \nA#B‡ !ƒ6\n!‡‡" [tReE sUbTrEe-TeSt fUnCtIoN ad-substitute-tree] 5]) (defalias 'ad-copy-tree #[(tree) ":ƒÁ@!ÁA!B‡‡" [tree ad-copy-tree] 3]) #@409 A Common-Lisp-style dolist iterator with the following syntax: (ad-dolist (VAR INIT-FORM [RESULT-FORM]) BODY-FORM...) which will iterate over the list yielded by INIT-FORM binding VAR to the current head at every iteration. If RESULT-FORM is supplied its value will be returned at the end of the iteration, nil otherwise. The iteration can be exited prematurely with `(ad-do-return [VALUE])'. (defalias 'ad-dolist '(macro . #[(varform &rest body) "ÀÁ\nA@D\n@DÃÁÄ\n@ÅBBÆÈC\"BBB\nAA@F Ê˃/ÌÍ E‚1 )‡" [let ad-dO-vAr varform while setq ((car ad-dO-vAr)) append body (setq ad-dO-vAr (cdr ad-dO-vAr)) expansion contains-return (byte-code "ÀÁ #ˆÄ‡" [ad-substitute-tree #[(subtree) "¢Á=†¢Â=…ÃÄÅ\"‡" [subtree ad-dolist ad-do-return throw contains-return t] 3] identity body nil] 4) catch (quote ad-dO-eXiT)] 8 (#$ . 2214)])) (defalias 'ad-do-return '(macro . #[(value) "ÀÁ\nE‡" [throw (quote ad-dO-eXiT) value] 3])) (byte-code "ÀÁN„\fÂÀÁÃ#ˆÀ‡" [ad-dolist lisp-indent-hook put 1] 4) (defalias 'ad-save-real-definition '(macro . #[(function) "ÀÁ \"!ÅÆÇ\"ˆÈÉÊË\fDDDÌÍË\fDÎË DDEÏ ÆN…2ÐË\fDÑË ÆNDFC ÒN…DÐË\fDÓË ÒNDFC\"BBE)‡" [intern format "ad-real-%s" function saved-function require byte-compile "bytecomp" if not fboundp quote progn fset symbol-function append put (quote byte-compile) byte-opcode (quote byte-opcode)] 12])) (defalias 'ad-save-real-definitions #[nil "ÀÁ!„ÁÂKMˆÃÁÄÅ#ˆÃÁÆÇ#ˆÀÈ!?…\"ÈÉKM‡" [fboundp ad-real-fset fset put byte-compile byte-compile-fset byte-opcode byte-fset ad-real-documentation documentation] 4]) (byte-code "À ˆÁÂ!„ ÃÂ\fBÇ" [ad-save-real-definitions boundp ad-advised-functions nil current-load-list] 2) (defalias 'ad-pushnew-advised-function '(macro . #[(function) "ÀÁÂÃ\fDÅBBDÆÇÈÉÃ\fDDÊBBEE‡" [if not assoc symbol-name function (ad-advised-functions) setq ad-advised-functions cons list (ad-advised-functions)] 8])) (defalias 'ad-pop-advised-function '(macro . #[(function) "ÀÁÂÃÄ DÆBBÇBBE‡" [setq ad-advised-functions delq assoc symbol-name function (ad-advised-functions) (ad-advised-functions)] 6])) (defalias 'ad-do-advised-functions '(macro . #[(varform &rest body) "À @ A@Eà @ÄÅ @DDEBBB‡" [ad-dolist varform ad-advised-functions setq intern car body] 7])) (byte-code "ÀÁN„\fÂÀÁÃ#ˆÀ‡" [ad-do-advised-functions lisp-indent-hook put 1] 4) (defalias 'ad-get-advice-info '(macro . #[(function) "À ÂBB‡" [get function ((quote ad-advice-info))] 3])) (defalias 'ad-set-advice-info '(macro . #[(function advice-info) "À  F‡" [put function (quote ad-advice-info) advice-info] 4])) (defalias 'ad-copy-advice-info '(macro . #[(function) "ÀÁ\nÃBBD‡" [ad-copy-tree get function ((quote ad-advice-info))] 4])) (defalias 'ad-is-advised '(macro . #[(function) "À D‡" [ad-get-advice-info function] 2])) (defalias 'ad-initialize-advice-info #[(function) "ÀÁ\n! \"„Á\n!C BÄ\nÅÆÇBC#‡" [assoc symbol-name function ad-advised-functions put ad-advice-info active nil] 5]) (defalias 'ad-get-advice-info-field '(macro . #[(function field) "ÀÁ\nÃ\fDED‡" [cdr assq field ad-get-advice-info function] 5])) (defalias 'ad-set-advice-info-field #[(function field value) "ÁN…\nÁNžƒ\nÁNž ¡‡ÁN\n BC¤‡" [function ad-advice-info field value] 3]) (defalias 'ad-is-active #[(function) "À ÂNžA‡" [active function ad-advice-info] 3]) #@263 Constructs single piece of advice to be stored in some advice-info. NAME should be a non-nil symbol, PROTECT and ENABLE should each be either t or nil, and DEFINITION should be a list of the form `(advice lambda ARGLIST [DOCSTRING] [INTERACTIVE-FORM] BODY...)'. (defalias 'ad-make-advice #[(name protect enable definition) " \n F‡" [name protect enable definition] 4 (#$ . 5501)]) (defalias 'ad-advice-name '(macro . #[(advice) "À D‡" [car advice] 2])) (defalias 'ad-advice-protected '(macro . #[(advice) "ÀÁ\nE‡" [nth 1 advice] 3])) (defalias 'ad-advice-enabled '(macro . #[(advice) "ÀÁ\nE‡" [nth 2 advice] 3])) (defalias 'ad-advice-definition '(macro . #[(advice) "ÀÁ\nE‡" [nth 3 advice] 3])) (defalias 'ad-advice-set-enabled #[(advice flag) "AA  ‡" [advice flag] 2]) (defalias 'ad-class-p #[(thing) " >‡" [thing ad-advice-classes] 2]) (defalias 'ad-name-p #[(thing) "…9‡" [thing] 1]) (defalias 'ad-position-p #[(thing) "À !† Â>‡" [natnump thing (first last)] 2]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp ad-advice-classes (before around after activation deactivation) current-load-list] 2) (defalias 'ad-has-enabled-advice #[(function class) "ÀÁ‡" [ad-dO-eXiT (byte-code " ÂNžAɃ\" @Æ\f8ƒÇÈÉ\"ˆ A‰„ *Ç" [class function ad-advice-info nil advice ad-dO-vAr 2 throw ad-dO-eXiT t] 4)] 2]) (defalias 'ad-has-redefining-advice #[(function) "ÁN…ÂÃ\"†ÂÄ\"†ÂÅ\"‡" [function ad-advice-info ad-has-enabled-advice before around after] 3]) (defalias 'ad-has-any-advice #[(function) "ÁN… ÂÇ" [function ad-advice-info ad-dO-eXiT (byte-code "Á‰ƒ @‰\fÅNžAƒÆÇÈ\"ˆ A‰„*Á‡" [ad-advice-classes nil class ad-dO-vAr function ad-advice-info throw ad-dO-eXiT t] 4)] 2]) (defalias 'ad-get-enabled-advices #[(function class) "À\n ÄNžAÀ‰ƒ'@Ç 8ƒ BA‰„*È !)‡" [nil enabled-advices class function ad-advice-info advice ad-dO-vAr 2 reverse] 4]) #@72 Automatic advice activation is disabled. `ad-start-advice' enables it. (defalias 'ad-activate #[(function &optional compile) "À‡" [nil] 1 (#$ . 7381)]) #@72 Automatic advice activation is disabled. `ad-start-advice' enables it. (defalias 'ad-activate-off #[(function &optional compile) "À‡" [nil] 1 (#$ . 7539)]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp ad-activate-on-top-level t current-load-list] 2) (defalias 'ad-with-auto-activation-disabled '(macro . #[(&rest body) "ÀÁ\nBB‡" [let ((ad-activate-on-top-level nil)) body] 3])) (defalias 'ad-safe-fset #[(symbol definition) "À\n M)‡" [nil ad-activate-on-top-level symbol definition] 2]) (defalias 'ad-make-origname #[(function) "ÀÁ \"!‡" [intern format "ad-Orig-%s" function] 4]) (defalias 'ad-get-orig-definition '(macro . #[(function) "ÀÁ ÄBBDCÅBB‡" [let origname ad-get-advice-info-field function ((quote origname)) ((if (fboundp origname) (symbol-function origname)))] 5])) (defalias 'ad-set-orig-definition '(macro . #[(function definition) "ÀÁ\nE‡" [ad-safe-fset (ad-get-advice-info-field function (quote origname)) definition] 3])) (defalias 'ad-clear-orig-definition '(macro . #[(function) "ÀÁ\nÃBBD‡" [fmakunbound ad-get-advice-info-field function ((quote origname))] 4])) (defalias 'ad-read-advised-function #[(&optional prompt predicate default) "„ÁÂ!ˆ †ÄņÁÆÇ\" ÊËÌ †$Î #…-ÏÐ$‰ÒšƒH ÓNƒA ‚LÁÔ \"‚LÕ!*‡" [ad-advised-functions error "ad-read-advised-function: There are no advised functions" default ad-dO-eXiT (byte-code "Á‰ƒ& @Ä\n@! ƒ \n!ƒÆÇ\n\"ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern predicate throw ad-dO-eXiT] 4) "ad-read-advised-function: %s" "There are no qualifying advised functions" predicate ad-pReDiCaTe completing-read format "%s(default %s) " prompt "Function: " #[(function) "Á\n@!!‡" [ad-pReDiCaTe intern function] 3] t function "" ad-advice-info "ad-read-advised-function: `%s' is not advised" intern] 6]) (byte-code "ÀÁ!„ ÂÃ\f\"Á BÀ‡" [boundp ad-advice-class-completion-table mapcar #[(class) "À !C‡" [symbol-name class] 2] ad-advice-classes current-load-list] 3) (defalias 'ad-read-advice-class #[(function &optional prompt default) "†Á†ÃÄ \"ÆÇÈ †Ê# ÌÍ$‰Ïšƒ+‚/Ð!)‡" [default ad-dO-eXiT (byte-code "Á‰ƒ @‰\fÅNžAƒÆÇ\n\"ˆ A‰„*Á‡" [ad-advice-classes nil class ad-dO-vAr function ad-advice-info throw ad-dO-eXiT] 4) error "ad-read-advice-class: `%s' has no advices" function completing-read format "%s(default %s) " prompt "Class: " ad-advice-class-completion-table nil t class "" intern] 6]) (defalias 'ad-read-advice-name #[(function class &optional prompt) "ÀÁ\n ÄNžA\"‰„ÆÇ \n#‚ @@ÉÊ †#Ì# Í ÎÏ$‰Ñšƒ>Ò!‚BÒ!,‡" [mapcar #[(advice) "À @!C‡" [symbol-name advice] 2] class function ad-advice-info name-completion-table error "ad-read-advice-name: `%s' has no %s advice" default format "%s(default %s) " prompt "Name: " completing-read nil t name "" intern] 6]) (defalias 'ad-read-advice-specification #[(&optional prompt) "À !Ã\n!Å\n\f\"\n\fE+‡" [ad-read-advised-function prompt function ad-read-advice-class class ad-read-advice-name name] 3]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp ad-last-regexp "" current-load-list] 2) (defalias 'ad-read-regexp #[(&optional prompt) "À † ĚƒÄ‚ÅÆ \"P!‰Äšƒ\" ‚$‰)‡" [read-from-minibuffer prompt "Regular expression: " ad-last-regexp "" format "(default \"%s\") " regexp] 6]) (defalias 'ad-find-advice '(macro . #[(function class name) "À  \fEE‡" [assq name ad-get-advice-info-field function class] 5])) (defalias 'ad-advice-position #[(function class name) " \nÃNžAž \nÃNžA\f… G\f >GZ*‡" [name class function ad-advice-info found-advice advices] 4]) #@201 Finds the first of FUNCTION's advices in CLASS matching NAME. NAME can be a symbol or a regular expression matching part of an advice name. If CLASS is `any' all legal advice classes will be checked. (defalias 'ad-find-some-advice #[(function class name) "ÁN…\fÂÄÅ)‡" [function ad-advice-info nil found-advice ad-dO-eXiT (byte-code "Á‰ƒ. @\fÅ=„\n\f=ƒÆǃ'ÉÆ\"ˆ A‰„*Á‡" [ad-advice-classes nil advice-class ad-dO-vAr class any ad-dO-eXiT (byte-code " ÂNžAɃ5 @;ƒ!ÇÈ\f@!\"„)\f@=ƒ.ÉÊ\f\"ˆ A‰„ *Ç" [advice-class function ad-advice-info nil advice ad-dO-vAr name string-match symbol-name throw ad-dO-eXiT] 5) found-advice throw] 4)] 2 (#$ . 11087)]) (defalias 'ad-enable-advice-internal #[(function class name flag) "ÁN…vÂ\fʼnƒs@É=„&=ƒjÁNžAÅ\n‰ƒi@\n ;ƒMÌ Í\n@!\"„V \n@=ƒ` TÎ\n\"ˆA‰„6*A‰„* )‡" [function ad-advice-info 0 matched-advices ad-advice-classes nil advice-class ad-dO-vAr class any advice name string-match symbol-name ad-advice-set-enabled flag] 5]) #@53 Enables the advice of FUNCTION with CLASS and NAME. (defalias 'ad-enable-advice #[(function class name) "ÁNƒÂ \fÅ$Æ=…ÇÈ \f$‡ÇÉ\"‡" [function ad-advice-info ad-enable-advice-internal class name t 0 error "ad-enable-advice: `%s' has no %s advice matching `%s'" "ad-enable-advice: `%s' is not advised"] 5 (#$ . 12141) (ad-read-advice-specification "Enable advice of: ")]) #@54 Disables the advice of FUNCTION with CLASS and NAME. (defalias 'ad-disable-advice #[(function class name) "ÁNƒÂ \fÅ$Æ=…ÇÈ \f$‡ÇÉ\"‡" [function ad-advice-info ad-enable-advice-internal class name nil 0 error "ad-disable-advice: `%s' has no %s advice matching `%s'" "ad-disable-advice: `%s' is not advised"] 5 (#$ . 12524) (ad-read-advice-specification "Disable advice of: ")]) (defalias 'ad-enable-regexp-internal #[(regexp class flag) "À\nɃ) @Æ\f@! Ç\f \n$† À\\ A‰„\n* )‡" [0 matched-advices ad-advised-functions nil advised-function ad-dO-vAr intern ad-enable-advice-internal class regexp flag] 7]) #@117 Enables all advices with names that contain a match for REGEXP. All currently advised functions will be considered. (defalias 'ad-enable-regexp #[(regexp) "À ÂÃ#tƒÅÆ\f\"ˆ\f)‡" [ad-enable-regexp-internal regexp any t matched-advices message "%d matching advices enabled"] 4 (#$ . 13155) (list (ad-read-regexp "Enable advices via regexp: "))]) #@118 Disables all advices with names that contain a match for REGEXP. All currently advised functions will be considered. (defalias 'ad-disable-regexp #[(regexp) "À ÂÃ#tƒÅÆ\f\"ˆ\f)‡" [ad-enable-regexp-internal regexp any nil matched-advices message "%d matching advices disabled"] 4 (#$ . 13507) (list (ad-read-regexp "Disable advices via regexp: "))]) #@151 Removes FUNCTION's advice with NAME from its advices in CLASS. If such an advice was found it will be removed from the list of advices in that CLASS. (defalias 'ad-remove-advice #[(function class name) "ÁNƒ+\n ÁNžAž‰ƒ#Å Æ\f ÁNžA\"#‚)ÇÈ \n$)‡ÇÉ\"‡" [function ad-advice-info name class advice-to-remove ad-set-advice-info-field delq error "ad-remove-advice: `%s' has no %s advice `%s'" "ad-remove-advice: `%s' is not advised"] 9 (#$ . 13865) (ad-read-advice-specification "Remove advice of: ")]) #@701 Adds a piece of ADVICE to FUNCTION's list of advices in CLASS. If FUNCTION already has one or more pieces of advice of the specified CLASS then POSITION determines where the new piece will go. The value of POSITION can either be `first', `last' or a number where 0 corresponds to `first'. Numbers outside the range will be mapped to the closest extreme position. If there was already a piece of ADVICE with the same name, then the position argument will be ignored and the old advice will be overwritten with the new one. If the FUNCTION was not advised already, then its advice info will be initialized. Redefining a piece of advice whose name is part of the cache-id will clear the cache. (defalias 'ad-add-advice #[(function advice class position) "ÁN„Â!ˆÃÄÅ!#ˆÆ@# ÁNžA\n †T Ì=ƒ5Í‚T Î=ƒB\nG‚T §ƒSÍ \nG^]‚TÍ @Ï\">ƒfÐ!ˆ ƒv \n› ‚™ ÍUƒŠÃ\nB#‚™ S\n› \n›B¡+‡" [function ad-advice-info ad-initialize-advice-info ad-set-advice-info-field origname ad-make-origname ad-advice-position class advice previous-position advices position first 0 last ad-get-cache-class-id ad-clear-cache] 5 (#$ . 14376)]) (defalias 'ad-macrofy '(macro . #[(definition) "ÀÁ\nE‡" [cons (quote macro) definition] 3])) (defalias 'ad-lambdafy '(macro . #[(definition) "À D‡" [cdr definition] 2])) (byte-code "ÀÁ!„ ÂÃÄ\"Á BÀ‡" [boundp ad-special-forms mapcar symbol-function (and catch cond condition-case defconst defmacro defun defvar function if interactive let let* or prog1 prog2 progn quote save-excursion save-restriction save-window-excursion setq setq-default unwind-protect while with-output-to-temp-buffer) current-load-list] 3) (defalias 'ad-special-form-p '(macro . #[(definition) "À ÂE‡" [memq definition ad-special-forms] 3])) (defalias 'ad-interactive-p '(macro . #[(definition) "À D‡" [commandp definition] 2])) (defalias 'ad-subr-p '(macro . #[(definition) "À D‡" [subrp definition] 2])) (defalias 'ad-macro-p '(macro . #[(definition) "ÀÁ\nDÃBB‡" [eq car-safe definition ((quote macro))] 3])) (defalias 'ad-lambda-p '(macro . #[(definition) "ÀÁ\nDÃBB‡" [eq car-safe definition ((quote lambda))] 3])) (defalias 'ad-advice-p '(macro . #[(definition) "ÀÁ\nDÃBB‡" [eq car-safe definition ((quote advice))] 3])) (byte-code "ÀÁ!„ÀÂ!ƒÃÁÂ\"ˆÀ‡" [fboundp byte-code-function-p compiled-function-p ad-safe-fset] 3) (defalias 'ad-compiled-p '(macro . #[(definition) "ÀÁ\nDÃÄ\nDÁÅ\nDDEE‡" [or byte-code-function-p definition and ad-macro-p ad-lambdafy] 7])) (defalias 'ad-compiled-code '(macro . #[(compiled-definition) "ÀÁ\nDÃ\nD\nF‡" [if ad-macro-p compiled-definition ad-lambdafy] 4])) (defalias 'ad-lambda-expression #[(definition) "¢Á=ƒ ‡¢Â=ƒA‡¢Ã=ƒA‡Ä‡" [definition lambda macro advice nil] 2]) (defalias 'ad-arglist #[(definition &optional name) "À !„ ¢Â=ƒ$À A!ƒ$ ¢Â=ƒ A‚! ÃH‡ :ƒ/Ä !A@‡Å !…Vƒ?Ç!‡ÈÉ \"ÊË\"ˆÇÌ͔͕O!!‡" [byte-code-function-p definition macro 0 ad-lambda-expression subrp name ad-subr-arglist format "%s" string-match "^#]+\\)>$" intern 1] 5]) (defalias 'ad-define-subr-args '(macro . #[(subr arglist) "À ÂÃ\fDF‡" [put subr (quote ad-subr-arglist) list arglist] 5])) (defalias 'ad-undefine-subr-args '(macro . #[(subr) "À ÂBB‡" [put subr ((quote ad-subr-arglist) nil)] 3])) (defalias 'ad-subr-args-defined-p '(macro . #[(subr) "À ÂBB‡" [get subr ((quote ad-subr-arglist))] 3])) (defalias 'ad-get-subr-args '(macro . #[(subr) "ÀÁ\nÃBBD‡" [car get subr ((quote ad-subr-arglist))] 4])) (defalias 'ad-subr-arglist #[(subr-name) "ÁNƒ ÁN@‡ÂÃ\"†ÄÆÇ \"ƒ3ÈÁÉ Ê”Ê•O—!@AC#ˆÁN@‚PÆË \"ƒOÈÁÉ Ê”Ê•#@C#ˆÁN@‚PÌ)‡" [subr-name ad-subr-arglist ad-real-documentation t "" doc string-match "^\\(([^)]+)\\)\n?\\'" put read-from-string 1 "[\n ]*\narguments: ?\\((.*)\\)\n?\\'" (&rest ad-subr-args)] 7]) (defalias 'ad-docstring #[(definition) "À !„ ¢Â=ƒÀ A!ƒà Ä\"‚!Å !AA@‰;„/Ç!…1)‡" [byte-code-function-p definition macro ad-real-documentation t ad-lambda-expression docstring natnump] 4]) (defalias 'ad-interactive-form #[(definition) "À !„ ¢Â=ƒ,À A!ƒ,à !…?Ä ¢Â=ƒ' A‚( ÅHD‡ ¢Æ=„: ¢Ç=…?ÃÈ !!‡" [byte-code-function-p definition macro commandp interactive 5 advice lambda ad-lambda-expression] 3]) (defalias 'ad-body-forms #[(definition) "À !„ ¢Â=ƒÀ A!ƒÇ :…8Ä !ƒ%Å‚&ÆÇ !ƒ0Å‚1Æ\\È !AA›‡" [byte-code-function-p definition macro nil ad-docstring 1 0 ad-interactive-form ad-lambda-expression] 3]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp ad-advised-definition-docstring-regexp "^\\$ad-doc: \\(.+\\)\\$$" current-load-list] 2) (defalias 'ad-make-advised-definition-docstring #[(function) "ÀÁ !\"‡" [format "$ad-doc: %s$" prin1-to-string function] 4]) (defalias 'ad-advised-definition-p #[(definition) "¢Á=„\"¢Â=„\"Ã!„\"¢Â=…1ÃA!…1Ä!‰;…0Æ \")‡" [definition lambda macro byte-code-function-p ad-docstring docstring string-match ad-advised-definition-docstring-regexp] 4]) (defalias 'ad-definition-type #[(definition) "¢Á=ƒ Á‡Â!ƒ >ƒćŇ¢Æ=„4Ç!„4¢Á=ƒ6ÇA!ƒ6ȇ¢É=…>ɇ" [definition macro subrp ad-special-forms special-form subr lambda byte-code-function-p function advice] 2]) (defalias 'ad-has-proper-definition #[(function) "9…Á!…K¢Â=?‡" [function fboundp autoload] 2]) (defalias 'ad-real-definition #[(function) "À !… K‰9ƒÃ\n!‚\n)‡" [ad-has-proper-definition function definition ad-real-definition] 3]) (defalias 'ad-real-orig-definition #[(function) "ÁN…ÂÃÁNžA!‡" [function ad-advice-info ad-real-definition origname] 4]) (defalias 'ad-is-compilable #[(function) "À !…+ K¢Â=„ K¢Ã=…+Ä K!†* K¢Ã=…*Ä KA!?‡" [ad-has-proper-definition function lambda macro byte-code-function-p] 2]) #@62 Byte-compiles FUNCTION (or macro) if it is not yet compiled. (defalias 'ad-compile-function #[(function) "À !…\fÂÄ !)‡" [ad-is-compilable function nil ad-activate-on-top-level byte-compile] 2 (#$ . 20040) "aByte-compile function: "]) (defalias 'ad-prognify #[(forms) "GÁXƒ\n@‡ÂB‡" [forms 1 progn] 2]) (defalias 'ad-parse-arglist #[(arglist) "ÀÀÀÄ >A@‰ƒÆÄÆ !>A!Ç >A‰ƒ.ÆÇÆ !>A!‚0  \n E+‡" [nil required optional rest &rest arglist reverse &optional] 5]) (defalias 'ad-retrieve-args-form #[(arglist) "À !Ã\n8ÅÆÇÈ\n@\"ÇÉ\nA@\"\f…#ÅÊ\fD\fËBBBC#*B‡" [ad-parse-arglist arglist parsed-arglist 2 rest list append mapcar #[(req) "ÀÁ\nD\nÃBBB‡" [list quote req ((quote required))] 4] #[(opt) "ÀÁ\nD\nÃBBB‡" [list quote opt ((quote optional))] 4] quote ((quote rest))] 8]) (defalias 'ad-arg-binding-field #[(binding field) "Á=ƒ \n@‡Ã=ƒ\nA@‡Ä=…\nAA@‡" [field name binding value type] 2]) (defalias 'ad-list-access #[(position list) "ÁUƒ\n‡ÃUƒÄ\nD‡Å\nE‡" [position 0 list 1 cdr nthcdr] 3]) (defalias 'ad-element-access #[(position list) "ÁUƒ\n D‡ÄUƒÂÅ DD‡Æ E‡" [position 0 car list 1 cdr nth] 3]) (defalias 'ad-access-argument #[(arglist index) "À !Ã\n@\nA@\"Å\n8\fGWƒ \f8‚-…-\fGZD+‡" [ad-parse-arglist arglist parsed-arglist append reqopt-args 2 rest-arg index] 3]) (defalias 'ad-get-argument #[(arglist index) "À \n\"‰:ƒÄ @ A@\"‚ )‡" [ad-access-argument arglist index argument-access ad-element-access] 4]) (defalias 'ad-set-argument #[(arglist index value-form) "À \n\"‰:ƒÄÅ @ A@\"E‚) ƒ$Ç E‚)ÈÉ\n #)‡" [ad-access-argument arglist index argument-access setcar ad-list-access value-form setq error "ad-set-argument: No argument at position %d of `%s'"] 5]) (defalias 'ad-get-arguments #[(arglist index) "À !Ã\n@\nA@\"Å\n8Ç \fGWƒ$Ê \f›BƒDƒ9ËE‚DÌ \fGZ\",‡" [ad-parse-arglist arglist parsed-arglist append reqopt-args 2 rest-arg nil args-form index list nconc ad-list-access] 3]) (defalias 'ad-set-arguments #[(arglist index values-form) "ÀÁ‰Å\"‰ƒX 9ƒ&ÈÉ\fÊ\"#\nB‚M @ÀUƒ9Ë A@Ì\fÊ\"E‚GÍÌ @S A@\"Ì\fÊ\"E\nBÁT\fT‚\n„fÎÏ#‚…\nGÐUƒvÑÒÓ\n@#‚…ÔÊDCÖ×\n!ÊC\"BB+‡" [0 nil set-forms argument-access values-index ad-access-argument arglist index ad-set-argument ad-element-access ad-vAlUeS setq ad-list-access setcdr error "ad-set-arguments: No argument at position %d of `%s'" 1 ad-substitute-tree #[(form) "Á=‡" [form ad-vAlUeS] 2] #[(form) "‡" [values-form] 1] let values-form append reverse] 6]) (defalias 'ad-insert-argument-access-forms #[(definition arglist) "ÀÁ #‡" [ad-substitute-tree #[(form) "Á=†¢Â>…A¢¨‡" [form ad-arg-bindings (ad-get-arg ad-get-args ad-set-arg ad-set-args)] 2] #[(form) "Á=ƒ\n !‡@A@ÄA \"A@‰È=ƒ)É \"‚UÊ=ƒ9Ë  #‚UÌ=ƒHÍ \"‚UÎ=…UÏ  #+‡" [form ad-arg-bindings ad-retrieve-args-form arglist ad-insert-argument-access-forms val index accessor ad-get-arg ad-get-argument ad-set-arg ad-set-argument ad-get-args ad-get-arguments ad-set-args ad-set-arguments] 6] definition] 4]) #@594 Makes `funcall/apply' form to map SOURCE-ARGLIST to TARGET-ARGLIST. The arguments supplied to TARGET-ARGLIST will be taken from SOURCE-ARGLIST just as if they had been supplied to a function with TARGET-ARGLIST directly. Excess source arguments will be neglected, missing source arguments will be supplied as nil. Returns a `funcall' or `apply' form with the second element being `function' which has to be replaced by an actual function argument. Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return `(funcall function a (car args) (car (cdr args)) (nth 2 args))'. (defalias 'ad-map-arglists #[(source-arglist target-arglist) "À !Ã\n@\nA@\"Å\n8À!Ã@A@\" Å8\n…/\n Ì Ã ƒ>΂?ÏÐD ƒOÃ\fC\"‚`ÑÒà \n…^ G\f›\"\"\".‡" [ad-parse-arglist source-arglist parsed-source-arglist append source-reqopt-args 2 source-rest-arg target-arglist parsed-target-arglist target-reqopt-args target-rest-arg need-apply -1 target-arg-index apply funcall function mapcar #[(arg) "TÁ\n\"‡" [target-arg-index ad-get-argument source-arglist] 3]] 8 (#$ . 23101)]) (defalias 'ad-make-mapped-call #[(source-arglist target-arglist target-function) "À \n\"‰@Ä=ƒ AAB‚ ‰AÆ D ˆ)‡" [ad-map-arglists source-arglist target-arglist mapped-form funcall target-function quote] 5]) (defalias 'ad-make-single-advice-docstring #[(advice class &optional style) "ÀÁ\n8!\fÅ=ƒ ‚G\fÆ=ƒ.ÇÈ \n@ ƒ$Ê‚%Ë †*Ë%‚GÇÌÍÎ !!\n@ ƒ@Ê‚AË †FË%)‡" [ad-docstring 3 advice advice-docstring style plain freeze format "Permanent %s-advice `%s':%s%s" class "\n" "" "%s-advice `%s':%s%s" capitalize symbol-name] 6]) (defalias 'ad-make-advised-docstring #[(function &optional style) "À !ÃÄ\n!!Æ\nÇ\"É\nÉ ƒ C\n\fÍ=„0Î ÏQ\nB\nɉƒ{@Ó \"ɉƒq@Õ\f#‰ ƒh \nB\nA‰„N*A‰„;*\n…ˆÖ×\nŸØ#-‡" [ad-real-orig-definition function origdef symbol-name ad-definition-type origtype ad-real-documentation t origdoc nil paragraphs advice-docstring style plain "This " " is advised." ad-advice-classes class ad-dO-vAr ad-get-enabled-advices advice ad-make-single-advice-docstring mapconcat identity "\n\n"] 5]) (defalias 'ad-make-plain-docstring #[(function) "À Â\"‡" [ad-make-advised-docstring function plain] 3]) (defalias 'ad-make-freeze-docstring #[(function) "À Â\"‡" [ad-make-advised-docstring function freeze] 3]) (defalias 'ad-advised-arglist #[(function) "ÀÁ‡" [ad-dO-eXiT (byte-code "ÀÁ\nÃ\"Á\nÄ\"Á\nÅ\"#Ɖƒ8@ÉÊ8!‰ ƒ.ÌÍ \"ˆ)A‰„*Ƈ" [append ad-get-enabled-advices function before around after nil advice ad-dO-vAr ad-arglist 3 arglist throw ad-dO-eXiT] 7)] 2]) (defalias 'ad-advised-interactive-form #[(function) "ÀÁ‡" [ad-dO-eXiT (byte-code "ÀÁ\nÃ\"Á\nÄ\"Á\nÅ\"#Ɖƒ8@ÉÊ8!‰ ƒ.ÌÍ \"ˆ)A‰„*Ƈ" [append ad-get-enabled-advices function before around after nil advice ad-dO-vAr ad-interactive-form 3 interactive-form throw ad-dO-eXiT] 7)] 2]) (defalias 'ad-make-advised-definition #[(function) "ÁN…ðÂ!…ðÃ!ÅÁNžAÆ\f!È\f! \f\n> \f¢Ì= Î\f\"Ð!†;Ò! ƒKÔ‚u†uÕ\f!†u…uÖ!@‰ƒsØÙÚGÔ\"DD‚tÛ) „ ƒ™ ƒŠÝ‚‹ÞßÙ Dàá\"ED‚Á ƒºƒº„ºâãäÙ DDå #F‚Áå #&ç ƒÍÌ‚× ƒÖè‚×Àé!&êë\"êì\"êí\"&. ‡" [function ad-advice-info ad-has-redefining-advice ad-real-orig-definition origdef origname commandp orig-interactive-p subrp orig-subr-p ad-special-forms orig-special-form-p macro orig-macro-p ad-arglist orig-arglist ad-advised-arglist advised-arglist ad-advised-interactive-form advised-interactive-form nil ad-interactive-form ad-parse-arglist reqargs interactive quote make-list (interactive) interactive-form macroexpand eval cons ad-get-arguments 0 if (interactive-p) call-interactively ad-make-mapped-call orig-form ad-assemble-advised-definition special-form ad-make-advised-definition-docstring ad-get-enabled-advices before around after] 12]) (defalias 'ad-assemble-advised-definition #[(type args docstring interactive orig &optional befores arounds afters) "À‰‰‰‰À‰ƒH@‰A@ƒ5 ƒ5ÉÊ !ËÌ8!BBC‚?Í ËÌ8!\"A‰„*ÎÏEÑ!À‰ƒ@‰A@ƒiÓÔÕÖÊËÌ8!!#A‰„\\* ƒ’ ƒ’ÉÊ !\fEC‚—Í \fC\"À‰ƒÖ@‰A@ƒÃ\nƒÃÉÊ\n!ËÌ8!BBC‚ÍÍ\nËÌ8!\"A‰„£*ÍÙ>…àÚÛD…ìC…ôCßàÍ\ná=ƒâ‚ÏC\"BBC%ã \"-‡" [nil definition after-forms around-form-protected around-form before-forms befores advice ad-dO-vAr unwind-protect ad-prognify ad-body-forms 3 append setq ad-return-value orig reverse arounds t ad-substitute-tree #[(form) "Á=‡" [form ad-do-it] 2] #[(form) "‡" [around-form] 1] afters type (macro special-form) (macro) lambda args docstring interactive let (ad-return-value) special-form (list (quote quote) ad-return-value) ad-insert-argument-access-forms] 12]) (defalias 'ad-make-hook-form #[(function hook-name) "ÀÁ \f\"\"‰…ÆÇÈ \"!)‡" [mapcar #[(advice) "ÀÁ\n8!‡" [ad-body-forms 3 advice] 3] ad-get-enabled-advices function hook-name hook-forms ad-prognify apply append] 6]) (defalias 'ad-get-cache-definition '(macro . #[(function) "ÀÁ\nÃBBD‡" [car ad-get-advice-info-field function ((quote cache))] 4])) (defalias 'ad-get-cache-id '(macro . #[(function) "ÀÁ\nÃBBD‡" [cdr ad-get-advice-info-field function ((quote cache))] 4])) (defalias 'ad-set-cache '(macro . #[(function definition id) "À ÂÃ\f EF‡" [ad-set-advice-info-field function (quote cache) cons definition id] 6])) #@163 Clears a previously cached advised definition of FUNCTION. Clear the cache if you want to force `ad-activate' to construct a new advised definition from scratch. (defalias 'ad-clear-cache #[(function) "À ÂÃ#‡" [ad-set-advice-info-field function cache nil] 4 (#$ . 28488) (list (ad-read-advised-function "Clear cached definition of: "))]) (defalias 'ad-make-cache-id #[(function) "À ! ÃNžA@ÆÇÈ É\"\"ÆÊÈ Ë\"\"ÆÌÈ Í\"\"Î !Ï \"Ï\f!šƒ3Ђ7Ï \"Î !Á=…FÑ !Ñ\f!š¯*‡" [ad-real-orig-definition function cache ad-advice-info cached-definition original-definition mapcar #[(advice) "@‡" [advice] 1] ad-get-enabled-advices before #[(advice) "@‡" [advice] 1] around #[(advice) "@‡" [advice] 1] after ad-definition-type ad-arglist t ad-interactive-form] 8]) (defalias 'ad-get-cache-class-id #[(function class) "À ÂNžAA\fÅ=ƒ @‚\"\fÆ=ƒ A@‚\"Ç 8)‡" [cache function ad-advice-info cache-id class before around 2] 3]) (defalias 'ad-verify-cache-class-id #[(cache-class-id advices) "ÀÁ‡" [ad-dO-eXiT (byte-code "Á‰ƒ+ @Ä\n8ƒ$ @\n@=ƒ A‚$ÆÇÁ\"ˆ A‰„ *?‡" [advices nil advice ad-dO-vAr 2 cache-class-id throw ad-dO-eXiT] 4)] 2]) (defalias 'ad-cache-id-verification-code #[(function) "À ÂNžAAÃÆ @Ç ÂNžA\"ƒšÈ‰ƒšÆÉ 8Ê ÂNžA\"ƒšË‰ƒšÆÌ 8Í ÂNžA\"ƒšÎ‰ƒšÏ !À ÂNžA@Ò 8Ó!=ƒ™Ô‰ƒ™Õ 8Ö=ƒt× \"‚wÕ 8×!šƒ™Ø‰ƒ™Ù 8ƒ—Ú!Ú!šƒ™Û*\f*‡" [cache function ad-advice-info before-advice-mismatch code cache-id ad-verify-cache-class-id before around-advice-mismatch 1 around after-advice-mismatch 2 after definition-type-mismatch ad-real-orig-definition cached-definition original-definition 3 ad-definition-type arglist-mismatch 4 t ad-arglist interactive-form-mismatch 5 ad-interactive-form verified] 5]) (defalias 'ad-verify-cache-id #[(function) "À !Â=‡" [ad-cache-id-verification-code function verified] 2]) (defalias 'ad-preactivate-advice #[(function advice class position) "À !‰…\n KÄ ÅN!ÈŽÉ \n \f$ˆÍ  \n@#ˆÎ !ˆÏ Ð\"ˆÑ !…SÒ ÅNžA@…SÒ ÅNžA@Ò ÅNžAAD-‡" [fboundp function function-defined-p old-definition ad-copy-tree ad-advice-info old-advice-info ad-advised-functions ((byte-code "À  #ˆ\fƒÅ \"ˆ‚Ç !ˆÀ‡" [put function ad-advice-info old-advice-info function-defined-p ad-safe-fset old-definition fmakunbound] 4)) ad-add-advice advice class position ad-enable-advice ad-clear-cache ad-activate-on -1 ad-is-active cache] 6]) (defalias 'ad-make-freeze-definition #[(function advice class position) "À !„ Âà \"ˆ\f@ÆÇÈÉ !\n $! Ì ÍNžA\fÎ\f!…-\fK)†3 K ÍN…@Ð ÍN!ÒKÉKÕŽÖÒ×\"ˆÖÉØ\"ˆÙ ÍÚ#ˆÛ \f\n$ˆÖÌ ÍNžA\"ˆÝ !)‰…¾¢ß=‰ ƒ‹A‚A!âãäÎå DDDæå Dçèå DDéå DDEEE ƒ¶ê‚·ë !BBE*.‡" [ad-has-proper-definition function error "ad-make-freeze-definition: `%s' is not yet defined" advice name intern format "%s-%s-%s" ad-make-origname class unique-origname origname ad-advice-info fboundp orig-definition ad-copy-tree old-advice-info ad-make-advised-definition-docstring real-docstring-fn real-origname-fn ((byte-code "À  #ˆÄÅ\"ˆÄÇ\"‡" [put function ad-advice-info old-advice-info ad-safe-fset ad-make-advised-definition-docstring real-docstring-fn ad-make-origname real-origname-fn] 4)) ad-safe-fset ad-make-freeze-docstring (lambda (x) unique-origname) put nil ad-add-advice position ad-make-advised-definition frozen-definition macro macro-p body progn if not quote fset or ad-get-orig-definition symbol-function defmacro defun] 11]) (defalias 'ad-should-compile #[(function compile) "¨ƒ ÁY‡ƒ‡\nÃ=ƒć\nÅ=ƒƇ\nÇ=ƒ‰ÈÉ\nËNžA Ì !…9 K)!†ŒÍÉ\nËNžA Ì !…R K)!†ŒÉ\nËNžA Ì !…j K)¢Î=…ŒÍÉ\nËNžA Ì !…… K)A!‡ÏÐ!‡" [compile 0 ad-default-compilation-action never nil always t like-original subrp origname function ad-advice-info fboundp byte-code-function-p macro featurep byte-compile] 4]) (defalias 'ad-activate-advised-definition #[(function compile) "À !…  ÃNžA@Å \f†Æ !\"ˆÇ \"ƒ%É !ˆ\fƒB\f K=?…YÊ Â K ÃNžAAB#‚YË !ˆÊ  KÌB#ˆÊ  KÍ !B#)‡" [ad-verify-cache-id function cache ad-advice-info verified-cached-definition ad-safe-fset ad-make-advised-definition ad-should-compile compile ad-compile-function ad-set-advice-info-field ad-clear-cache nil ad-make-cache-id] 7]) #@708 Handles re/definition of an advised FUNCTION during de/activation. If FUNCTION does not have an original definition associated with it and the current definition is usable, then it will be stored as FUNCTION's original definition. If no current definition is available (even in the case of undefinition) nothing will be done. In the case of redefinition the action taken depends on the value of `ad-redefinition-action' (which see). Redefinition occurs when FUNCTION already has an original definition associated with it but got redefined with a new definition and then de/activated. If you do not like the current redefinition action change the value of `ad-redefinition-action' and de/activate again. (defalias 'ad-handle-definition #[(function) "À ÂNžAÃ!…K)Ä !… K‰ƒh …u =?…uÇ !?…uÉ>„AÊË Ì#‚uÍ=ƒPÎ \"‚uÎÀ ÂNžA \"ˆÏ=…uÐÑ \"‚u …uÎÀ ÂNžA \"*‡" [origname function ad-advice-info fboundp ad-real-definition current-definition original-definition ad-advised-definition-p ad-redefinition-action (accept discard warn) error "ad-handle-definition (see its doc): `%s' %s" "illegally redefined" discard ad-safe-fset warn message "ad-handle-definition: `%s' got redefined"] 5 (#$ . 32658)]) #@1007 Activates all the advice information of an advised FUNCTION. If FUNCTION has a proper original definition then an advised definition will be generated from FUNCTION's advice info and the definition of FUNCTION will be replaced with it. If a previously cached advised definition was available, it will be used. The optional COMPILE argument determines whether the resulting function or a compilable cached definition will be compiled. If it is negative no compilation will be performed, if it is positive or otherwise non-nil the resulting function will be compiled, if it is nil the behavior depends on the value of `ad-default-compilation-action' (which see). Activation of an advised function that has an advice info but no actual pieces of advice is equivalent to a call to `ad-unadvise'. Activation of an advised function that has actual pieces of advice but none of them are enabled is equivalent to a call to `ad-deactivate'. The current advised definition will always be cached for later usage. (defalias 'ad-activate-on #[(function &optional compile) "…ZÁ\nÃN„ÄÅ\n\"‚YÆ\n!ˆÇ\nÃNžAÈ!…)K)…YÉ\n!„9Ê\n!‚YË\n!ƒVÌ\n \"ˆÎ\nÏÐ#ˆÑÒ\nÓ\"!ˆ\n‚YÔ\n!)‡" [ad-activate-on-top-level nil function ad-advice-info error "ad-activate: `%s' is not advised" ad-handle-definition origname fboundp ad-has-any-advice ad-unadvise ad-has-redefining-advice ad-activate-advised-definition compile ad-set-advice-info-field active t eval ad-make-hook-form activation ad-deactivate] 4 (#$ . 33882) (list (ad-read-advised-function "Activate advice of: ") current-prefix-arg)]) #@280 Deactivates the advice of an actively advised FUNCTION. If FUNCTION has a proper original definition, then the current definition of FUNCTION will be replaced with it. All the advice information will still be available so it can be activated again with a call to `ad-activate'. (defalias 'ad-deactivate #[(function) "ÁN„ ÂÃ\"‡Ä!…UÅ!ˆÆÁNžAÇ!…'K)„0ÂÈ\"‡ÉÆÁNžAÇ!…DK)\"ˆÊËÌ#ˆÍÎÏ\"!ˆ‡" [function ad-advice-info error "ad-deactivate: `%s' is not advised" ad-is-active ad-handle-definition origname fboundp "ad-deactivate: `%s' has no original definition" ad-safe-fset ad-set-advice-info-field active nil eval ad-make-hook-form deactivation] 5 (#$ . 35464) (list (ad-read-advised-function "Deactivate advice of: " (quote ad-is-active)))]) #@141 Update the advised definition of FUNCTION if its advice is active. See `ad-activate-on' for documentation on the optional COMPILE argument. (defalias 'ad-update #[(function &optional compile) "À !…\n \"‡" [ad-is-active function ad-activate-on compile] 3 (#$ . 36232) (list (ad-read-advised-function "Update advised definition of: " (quote ad-is-active)))]) #@117 Deactivates FUNCTION and then removes all its advice information. If FUNCTION was not advised this will be a noop. (defalias 'ad-unadvise #[(function) "ÁN…-Â!ƒÃ!ˆÄÅÁNžA!ˆÆÁÇ#ˆÈÉÊ! \" \"‰ ‡" [function ad-advice-info ad-is-active ad-deactivate fmakunbound origname put nil delq assoc symbol-name ad-advised-functions] 4 (#$ . 36599) (list (ad-read-advised-function "Unadvise function: "))]) #@219 Tries to recover FUNCTION's original definition and unadvises it. This is more low-level than `ad-unadvise' because it does not do any deactivation which might run hooks and get into other trouble. Use in emergencies. (defalias 'ad-recover #[(function) "ÁN…JÂÁNžAÃ\n!…\nK)ƒ6ÄÂÁNžAÃ\n!…*\nK)\"ˆÅÂÁNžA!ˆÆÁÇ#ˆÈÉÊ! \" \"‰ ‡" [function ad-advice-info origname fboundp ad-safe-fset fmakunbound put nil delq assoc symbol-name ad-advised-functions] 5 (#$ . 37008) (list (intern (completing-read "Recover advised function: " obarray nil t)))]) #@141 Activates functions with an advice name containing a REGEXP match. See `ad-activate-on' for documentation on the optional COMPILE argument. (defalias 'ad-activate-regexp #[(regexp &optional compile) "Á‰ƒ& @Ä\n@!Å\nÆ#ƒÈ\n \"ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern ad-find-some-advice any regexp ad-activate-on compile] 5 (#$ . 37567) (list (ad-read-regexp "Activate via advice regexp: ") current-prefix-arg)]) #@68 Deactivates functions with an advice name containing REGEXP match. (defalias 'ad-deactivate-regexp #[(regexp) "Á‰ƒ$ @Ä\n@!Å\nÆ#ƒÈ\n!ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern ad-find-some-advice any regexp ad-deactivate] 5 (#$ . 38018) (list (ad-read-regexp "Deactivate via advice regexp: "))]) #@139 Updates functions with an advice name containing a REGEXP match. See `ad-activate-on' for documentation on the optional COMPILE argument. (defalias 'ad-update-regexp #[(regexp &optional compile) "Á‰ƒ& @Ä\n@!Å\nÆ#ƒÈ\n \"ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern ad-find-some-advice any regexp ad-update compile] 5 (#$ . 38352) (list (ad-read-regexp "Update via advice regexp: ") current-prefix-arg)]) #@117 Activates all currently advised functions. See `ad-activate-on' for documentation on the optional COMPILE argument. (defalias 'ad-activate-all #[(&optional compile) "Á‰ƒ @Ä\n@!Å\n\"ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern ad-activate-on compile] 4 (#$ . 38793) "P"]) #@46 Deactivates all currently advised functions. (defalias 'ad-deactivate-all #[nil "Á‰ƒ @Ä\n@!Å\n!ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern ad-deactivate] 3 (#$ . 39099) nil]) #@103 Updates all currently advised functions. With prefix argument compiles resulting advised definitions. (defalias 'ad-update-all #[(&optional compile) "Á‰ƒ @Ä\n@!Å\n\"ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern ad-update compile] 4 (#$ . 39309) "P"]) #@44 Unadvises all currently advised functions. (defalias 'ad-unadvise-all #[nil "Á‰ƒ @Ä\n@!Å\n!ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern ad-unadvise] 3 (#$ . 39594) nil]) #@64 Recovers all currently advised functions. Use in emergencies. (defalias 'ad-recover-all #[nil "Á‰ƒ @Ä\n@!ÁÅƈ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern (ad-recover function) ((error))] 4 (#$ . 39797) nil]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp ad-defadvice-flags (("protect") ("disable") ("activate") ("compile") ("preactivate") ("freeze")) current-load-list] 2) #@2445 Defines a piece of advice for FUNCTION (a symbol). The syntax of `defadvice' is as follows: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) [DOCSTRING] [INTERACTIVE-FORM] BODY... ) FUNCTION ::= Name of the function to be advised. CLASS ::= `before' | `around' | `after' | `activation' | `deactivation'. NAME ::= Non-nil symbol that names this piece of advice. POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first', see also `ad-add-advice'. ARGLIST ::= An optional argument list to be used for the advised function instead of the argument list of the original. The first one found in before/around/after-advices will be used. FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'. All flags can be specified with unambiguous initial substrings. DOCSTRING ::= Optional documentation for this piece of advice. INTERACTIVE-FORM ::= Optional interactive form to be used for the advised function. The first one found in before/around/after-advices will be used. BODY ::= Any s-expression. Semantics of the various flags: `protect': The piece of advice will be protected against non-local exits in any code that precedes it. If any around-advice of a function is protected then automatically all around-advices will be protected (the complete onion). `activate': All advice of FUNCTION will be activated immediately if FUNCTION has been properly defined prior to this application of `defadvice'. `compile': In conjunction with `activate' specifies that the resulting advised function should be compiled. `disable': The defined advice will be disabled, hence, it will not be used during activation until somebody enables it. `preactivate': Preactivates the advised FUNCTION at macro-expansion/compile time. This generates a compiled advised definition according to the current advice state that will be used during activation if appropriate. Only use this if the `defadvice' gets actually compiled. `freeze': Expands the `defadvice' into a redefining `defun/defmacro' according to this particular single advice. No other advice information will be saved. Frozen advices cannot be undone, they behave like a hard redefinition of the advised function. `freeze' implies `activate' and `preactivate'. The documentation of the advised function can be dumped onto the `DOC' file during preloading. Look at the file `advice.el' for comprehensive documentation. (defalias 'defadvice '(macro . #[(function args &rest body) "À !„ Âà \"ˆ\f@Æ !„ÂÇ \"‚\fA@À!„/ÂÉ\"‚?\fAAÊ\f@!…?\f@\fA \f@<…L\f@\fA\fÍÎ\f\"ÐÑ>Ò>?ÓÔ\fBBB$Ö>…{×   $Ù>ƒÚ   $‚èÛÜÝ DÝDÝ DÝ D¯Þ…ÌßÝ D@¢à=ƒ¿áÁ@ADD‚ÄÁ@DÝA@DFCâ>…áãÝ Dä>…ßåECÝ DC#BB.‡" [ad-name-p function error "defadvice: Illegal function name: %s" args class ad-class-p "defadvice: Illegal advice class: %s" name "defadvice: Illegal advice name: %s" ad-position-p position arglist mapcar #[(flag) "ÀÁ\n! \"‰Å=ƒ\n‚\"Æ\f \"ƒÇ\f!‚\"ÈÉ\n\")‡" [try-completion symbol-name flag ad-defadvice-flags completion t assoc intern error "defadvice: Illegal or ambiguous flag: %s"] 4] flags ad-make-advice protect disable advice lambda body preactivate ad-preactivate-advice preactivation freeze ad-make-freeze-definition progn ad-add-advice quote append ad-set-cache macro ad-macrofy activate ad-activate-on compile t] 8 (#$ . 40196)])) #@250 Binds FUNCTIONS to their original definitions and executes BODY. For any members of FUNCTIONS that are not currently advised the rebinding will be a noop. Any modifications done to the definitions of FUNCTIONS will be undone on exit of this macro. (defalias 'ad-with-originals '(macro . #[(functions &rest body) "ÀÂÃ\f\"Æ ÇÈÉÀÂÊ\f\" \"BÀÂÌ\f\"BBE*‡" [-1 index mapcar #[(function) "TÁÂÃ\"!ÄÅDDD‡" [index intern format "ad-oRiGdEf-%d" symbol-function quote function] 4] functions current-bindings let unwind-protect progn append #[(function) "TÁ DÄÅ DD8@EE‡" [index ad-safe-fset quote function or ad-get-orig-definition current-bindings] 6] body #[(function) "TÁ D\f8@E‡" [index ad-safe-fset quote function current-bindings] 4]] 8 (#$ . 43608)])) (byte-code "ÀÁN„\fÂÀÁÃ#ˆÄÅÆÇÈ$ˆÉÅÊËÌB#‡" [ad-with-originals lisp-indent-hook put 1 ad-add-advice documentation (ad-advised-docstring nil t (advice lambda nil "Builds an advised docstring if FUNCTION is advised." (if (and (stringp ad-return-value) (string-match ad-advised-definition-docstring-regexp ad-return-value)) (let ((function (car (read-from-string ad-return-value (match-beginning 1) (match-end 1))))) (cond ((ad-is-advised function) (setq ad-return-value (ad-make-advised-docstring function)) (if (not (ad-get-arg 1)) (setq ad-return-value (substitute-command-keys ad-return-value))))))))) after first ad-set-advice-info-field cache #[(function &optional raw) "À \f\"‰;ƒ0Å \"ƒ0Ç È”È•#@‰ÉNƒ/Ê !\f„/Ë !) )‡" [nil ad-return-value ad-Orig-documentation function raw string-match ad-advised-definition-docstring-regexp read-from-string 1 ad-advice-info ad-make-advised-docstring substitute-command-keys] 5 "$ad-doc: documentation$"] (nil nil (ad-advised-docstring) subr t nil)] 5) #@45 Starts the automatic advice handling magic. (defalias 'ad-start-advice #[nil "ÀÁÂÃ#ˆÄÁÅ\"ˆÆÇÈÉ#ˆÅÇÊ\"‡" [put ad-activate ad-advice-info nil ad-safe-fset ad-activate-on ad-enable-advice documentation after ad-advised-docstring compile] 4 (#$ . 45380) nil]) #@109 Stops the automatic advice handling magic. You should only need this in case of Advice-related emergencies. (defalias 'ad-stop-advice #[nil "ÀÁÂÃ#ˆÄÅÆÇ#ˆÈÅ!ˆÉÁÊ\"‡" [put ad-activate ad-advice-info nil ad-disable-advice documentation after ad-advised-docstring ad-update ad-safe-fset ad-activate-off] 4 (#$ . 45643) nil]) #@98 Undoes all advice related redefinitions and unadvises everything. Use only in REAL emergencies. (defalias 'ad-recover-normality #[nil "ÀÁÂÃ#ˆÄÁÅ\"ˆÆ ˆÃ‰‡" [put ad-activate ad-advice-info nil ad-safe-fset ad-activate-off ad-recover-all ad-advised-functions] 4 (#$ . 45970) nil]) (byte-code "À ˆÁÂ!‡" [ad-start-advice provide advice] 2) emacs-19.30/lisp/allout.elc100666 13437 1 321531 6045211666 14251 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:03:04 1995 ;;; from file /home/fsf/rms/e19/lisp/allout.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`allout.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [provide outline allout] 2) #@904 *Regulates auto-activation modality of allout outlines - see `outline-init'. Setq-default by `outline-init' to regulate whether or not allout outline mode is automatically activated when the buffer-specific variable `outline-layout' is non-nil, and whether or not the layout dictated by `outline-layout' should be imposed on mode activation. With value `t', auto-mode-activation and auto-layout are enabled. (This also depends on `outline-find-file-hooks' being installed in `find-file-hooks', which is also done by `outline-init'.) With value `ask', auto-mode-activation is enabled, and endorsement for performing auto-layout is asked of the user each time. With value `activate', only auto-mode-activation is enabled, auto- layout is not. With value `nil', neither auto-mode-activation nor auto-layout are enabled. See the docstring for `outline-init' for the proper interface to this variable. (defvar outline-auto-activation nil (#$ . -523)) #@1185 *Layout specification and provisional mode trigger for allout outlines. Buffer-specific. A list value specifies a default layout for the current buffer, to be applied upon activation of allout outline-mode. Any non-nil value will automatically trigger allout outline-mode, provided `outline- init' has been called to enable it. See the docstring for `outline-init' for details on setting up for auto-mode-activation, and for `outline-expose-topic' for the format of the layout specification. You can associate a particular outline layout with a file by setting this var via the file's local variables. For example, the following lines at the bottom of an Emacs Lisp file: ;;;Local variables: ;;;outline-layout: (0 : -1 -1 0) ;;;End: will, modulo the above-mentioned conditions, cause the mode to be activated when the file is visited, followed by the equivalent of `(outline-expose-topic 0 : -1 -1 0)'. (This is the layout used for the allout.el, itself.) Also, allout's mode-specific provisions will make topic prefixes default to the comment-start string, if any, of the language of the file. This is modulo the setting of `outline-use-mode-specific- leader', which see. (defvar outline-layout nil (#$ . -1483)) (make-variable-buffer-local (quote outline-layout)) #@376 *Leading string which helps distinguish topic headers. Outline topic header lines are identified by a leading topic header prefix, which mostly have the value of this var at their front. (Level 1 topics are exceptions. They consist of only a single character, which is typically set to the outline-primary-bullet. Many outlines start at level 2 to avoid this discrepancy. (defvar outline-header-prefix "." (#$ . -2767)) (make-variable-buffer-local (quote outline-header-prefix)) #@452 Bullet used for top-level outline topics. Outline topic header lines are identified by a leading topic header prefix, which is concluded by bullets that includes the value of this var and the respective outline-*-bullets-string vars. The value of an asterisk ('*') provides for backwards compatability with the original emacs outline mode. See outline-plain-bullets-string and outline-distinctive-bullets-string for the range of available bullets. (defvar outline-primary-bullet "*" (#$ . 3256)) (make-variable-buffer-local (quote outline-primary-bullet)) #@286 *The bullets normally used in outline topic prefixes. See 'outline-distinctive-bullets-string' for the other kind of bullets. DO NOT include the close-square-bracket, ']', as a bullet. Outline mode has to be reactivated in order for changes to the value of this var to take effect. (defvar outline-plain-bullets-string (concat outline-primary-bullet "+-:.;,") (#$ . -3822)) (make-variable-buffer-local (quote outline-plain-bullets-string)) #@505 *Persistent outline header bullets used to distinguish special topics. These bullets are not offered among the regular, level-specific rotation, and are not altered by automatic rebulleting, as when shifting the level of a topic. See `outline-plain-bullets-string' for the selection of alternating bullets. You must run 'set-outline-regexp' in order for changes to the value of this var to effect outline-mode operation. DO NOT include the close-square-bracket, ']', on either of the bullet strings. (defvar outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~\\" (#$ . -4272)) (make-variable-buffer-local (quote outline-distinctive-bullets-string)) #@1083 *When non-nil, use mode-specific topic-header prefixes. Allout outline mode will use the mode-specific `outline-mode-leaders' and/or comment-start string, if any, to lead the topic prefix string, so topic headers look like comments in the programming language. String values are used as they stand. Value `t' means to first check for assoc value in `outline-mode-leaders' alist, then use comment-start string, if any, then use default (`.'). (See note about use of comment-start strings, below.) Set to the symbol for either of `outline-mode-leaders' or `comment-start' to use only one of them, respectively. Value `nil' means to always use the default (`.'). comment-start strings that do not end in spaces are tripled, and an '_' underscore is tacked on the end, to distinguish them from regular comment strings. comment-start strings that do end in spaces are not tripled, but an underscore is substituted for the space. [This presumes that the space is for appearance, not comment syntax. You can use `outline-mode-leaders' to override this behavior, when incorrect.] (defvar outline-use-mode-specific-leader t (#$ . -4935)) #@426 Specific outline-prefix leading strings per major modes. Entries will be used in the stead (or lieu) of mode-specific comment-start strings. See also `outline-use-mode-specific-leader'. If you're constructing a string that will comment-out outline structuring so it can be included in program code, append an extra character, like an "_" underscore, to distinguish the lead string from regular comments that start at bol. (defvar outline-mode-leaders nil (#$ . 6081)) #@364 *When non-nil, use only old-and-crusty outline-mode '*' topic prefixes. Non-nil restricts the topic creation and modification functions to asterix-padded prefixes, so they look exactly like the original emacs-outline style prefixes. Whatever the setting of this variable, both old and new style prefixes are always respected by the topic maneuvering functions. (defvar outline-old-style-prefixes nil (#$ . -6559)) (make-variable-buffer-local (quote outline-old-style-prefixes)) #@1433 *Do fancy stuff with topic prefix bullets according to level, etc. Non-nil enables topic creation, modification, and repositioning functions to vary the topic bullet char (the char that marks the topic depth) just preceding the start of the topic text) according to level. Otherwise, only asterisks ('*') and distinctive bullets are used. This is how an outline can look (but sans indentation) with stylish prefixes: * Top level .* A topic . + One level 3 subtopic . . One level 4 subtopic . . A second 4 subtopic . + Another level 3 subtopic . #1 A numbered level 4 subtopic . #2 Another . ! Another level 4 subtopic with a different distinctive bullet . #4 And another numbered level 4 subtopic This would be an outline with stylish prefixes inhibited (but the numbered and other distinctive bullets retained): * Top level .* A topic . * One level 3 subtopic . * One level 4 subtopic . * A second 4 subtopic . * Another level 3 subtopic . #1 A numbered level 4 subtopic . #2 Another . ! Another level 4 subtopic with a different distinctive bullet . #4 And another numbered level 4 subtopic Stylish and constant prefixes (as well as old-style prefixes) are always respected by the topic maneuvering functions, regardless of this variable setting. The setting of this var is not relevant when outline-old-style-prefixes is non-nil. (defvar outline-stylish-prefixes t (#$ . -7047)) (make-variable-buffer-local (quote outline-stylish-prefixes)) #@313 *String designating bullet of topics that have auto-numbering; nil for none. Topics having this bullet have automatic maintainence of a sibling sequence-number tacked on, just after the bullet. Conventionally set to "#", you can set it to a bullet of your choice. A nil value disables numbering maintainence. (defvar outline-numbered-bullet "#" (#$ . -8597)) (make-variable-buffer-local (quote outline-numbered-bullet)) #@195 *Bullet signifying file cross-references, for `outline-resolve-xref'. Set this var to the bullet you want to use for file cross-references. Set it 'nil' if you want to inhibit this capability. (defvar outline-file-xref-bullet "@" (#$ . -9027)) #@70 *Non-nil turns on page numbering for LaTeX formatting of an outline. (defvar outline-number-pages nil (#$ . -9278)) #@62 *Font and size of labels for LaTeX formatting of an outline. (defvar outline-label-style "\\large\\bf" (#$ . -9400)) #@63 *Font and size of entries for LaTeX formatting of an outline. (defvar outline-head-line-style "\\large\\sl " (#$ . -9523)) #@63 *Font and size of entries for LaTeX formatting of an outline. (defvar outline-body-line-style " " (#$ . -9652)) #@62 *Font and size of titles for LaTeX formatting of an outline. (defvar outline-title-style "\\Large\\bf" (#$ . -9770)) #@78 *Expression to be evaluated to determine the title for LaTeX formatted copy. (defvar outline-title (quote (or buffer-file-name (current-buffer-name))) (#$ . -9893)) #@58 *Space between lines for LaTeX formatting of an outline. (defvar outline-line-skip ".05cm" (#$ . -10064)) #@40 *LaTeX formatted depth-indent spacing. (defvar outline-indent ".3cm" (#$ . -10176)) #@268 *List of outline-mode key / function bindings. These bindings will be locally bound on the outline-mode-map. The keys will be prefixed by outline-command-prefix, unless the cell contains a third, no-nil element, in which case the initial string will be used as is. (defvar outline-keybindings-list nil (#$ . -10267)) (byte-code "À‡" [(("?t" outline-latexify-exposed) ("" outline-next-visible-heading) ("" outline-previous-visible-heading) ("" outline-up-current-level) ("" outline-forward-current-level) ("" outline-backward-current-level) ("" outline-beginning-of-current-entry) ("" outline-end-of-current-entry) (" " outline-show-children) ("" outline-show-current-subtree) ("" outline-hide-current-subtree) ("" outline-show-current-entry) ("!" outline-show-all) (" " outline-open-sibtopic) ("." outline-open-subtopic) ("," outline-open-supertopic) ("'" outline-shift-in) (">" outline-shift-in) ("<" outline-shift-out) (" " outline-rebullet-topic) ("*" outline-rebullet-current-heading) ("#" outline-number-siblings) (" " outline-kill-line t) ("" outline-yank t) ("ù" outline-yank-pop t) (" " outline-kill-topic) ("" outline-mark-topic) ("@" outline-resolve-xref) ("?c" outline-copy-exposed)) outline-keybindings-list nil] 1) #@75 *Key sequence to be used as prefix for outline mode command key bindings. (defvar outline-command-prefix "" (#$ . -11517)) #@213 *Set non-nil to enable automatic exposure of concealed isearch targets. If non-nil, isearch will expose hidden text encountered in the course of a search, and to reconceal it if the search is continued past it. (defvar outline-enwrap-isearch-mode t (#$ . -11648)) #@321 *If non-nil, topic body text auto-indent defaults to indent of the header. Ie, it is indented to be just past the header prefix. This is relevant mostly for use with indented-text-mode, or other situations where auto-fill occurs. [This feature no longer depends in any way on the 'filladapt.el' lisp-archive package.] (defvar outline-use-hanging-indents t (#$ . -11920)) (make-variable-buffer-local (quote outline-use-hanging-indents)) #@430 *Non-nil enables auto-adjust of topic body hanging indent with depth shifts. When active, topic body lines that are indented even with or beyond their topic header are reindented to correspond with depth shifts of the header. A value of `t' enables reindent in non-programming-code buffers, ie those that do not have the variable `comment-start' set. A value of `force' enables reindent whether or not `comment-start' is set. (defvar outline-reindent-bodies (byte-code "…Á‡" [outline-use-hanging-indents text] 1) (#$ . -12365)) (make-variable-buffer-local (quote outline-reindent-bodies)) #@428 *Non-nil disables warnings and confirmation-checks for concealed-text edits. Outline mode uses emacs change-triggered functions to detect unruly changes to concealed regions. Set this var non-nil to disable the protection, potentially increasing text-entry responsiveness a bit. This var takes effect at outline-mode activation, so you may have to deactivate and then reactivate the mode if you want to toggle the behavior. (defvar outline-inhibit-protection nil (#$ . -12967)) #@67 Revision number of currently loaded outline package. (allout.el) (defvar outline-version (byte-code "ÀÂÃÄ)‡" ["Revision: 4.3" rcs-rev err (byte-code "À ÂŽÃÄ \"ˆ ƔƕO*‡" [match-data match-data ((store-match-data match-data)) string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev 1] 3) ((error rcs-rev))] 3) (#$ . 13454)) #@54 Return string describing the loaded outline version. (defalias 'outline-version #[(&optional here) "À P ƒ\fÄ\n!ˆÅÆ\n\"ˆ\n)‡" ["Allout Outline Mode v " outline-version msg here insert-string message "%s"] 3 (#$ . 13786) "P"]) #@215 *Regular expression to match the beginning of a heading line. Any line whose beginning matches this regexp is considered a heading. This var is set according to the user configuration vars by set-outline-regexp. (defvar outline-regexp "" (#$ . -14020)) (make-variable-buffer-local (quote outline-regexp)) #@249 A string dictating the valid set of outline topic bullets. This var should *not* be set by the user - it is set by 'set-outline-regexp', and is produced from the elements of 'outline-plain-bullets-string' and 'outline-distinctive-bullets-string'. (defvar outline-bullets-string "" (#$ . 14334)) (make-variable-buffer-local (quote outline-bullets-string)) #@58 Length of current buffers' outline-plain-bullets-string. (defvar outline-bullets-string-len 0 (#$ . 14696)) (make-variable-buffer-local (quote outline-bullets-string-len)) #@259 Outline-regexp with outline-style beginning-of-line anchor. (Ie, C-j, *or* C-m, for prefixes of hidden topics). This is properly set when outline-regexp is produced by 'set-outline-regexp', so that (match-beginning 2) and (match-end 2) delimit the prefix. (defvar outline-line-boundary-regexp nil (#$ . 14875)) (make-variable-buffer-local (quote outline-line-boundary-regexp)) #@130 Like outline-line-boundary-regexp, for headers at beginning of buffer. (match-beginning 2) and (match-end 2) delimit the prefix. (defvar outline-bob-regexp nil (#$ . 15261)) (make-variable-buffer-local (quote outline-bob-regexp)) #@70 Outline-header prefix length to subtract when computing topic depth. (defvar outline-header-subtraction (byte-code "GS‡" [outline-header-prefix] 1) (#$ . 15497)) (make-variable-buffer-local (quote outline-header-subtraction)) #@72 Length of outline-plain-bullets-string, updated by set-outline-regexp. (defvar outline-plain-bullets-string-len (length outline-plain-bullets-string) (#$ . 15730)) (make-variable-buffer-local (quote outline-plain-bullets-string-len)) #@59 *Reset the leading string used to identify topic headers. (defalias 'outline-reset-header-lead #[(header-lead) "‰GSà ‡" [header-lead outline-header-prefix outline-header-subtraction set-outline-regexp] 2 (#$ . -15970) "sNew lead string: "]) #@171 *Set the topic-header leading string to specified string. Useful when for encapsulating outline structure in programming language comments. Returns the leading string. (defalias 'outline-lead-with-comment-string #[(&optional header-lead) ";„ ÁÂ!ÃÅ!ˆ‡" [header-lead read-string "String prefix for topic headers: " nil outline-reindent-bodies outline-reset-header-lead] 2 (#$ . -16221) "P"]) #@303 Determine appropriate `outline-header-prefix'. Works according to settings of: `comment-start' `outline-header-prefix' (default) `outline-use-mode-specific-leader' and `outline-mode-leaders'. Apply this via (re)activation of `outline-mode', rather than invoking it directly. (defalias 'outline-infer-header-lead #[nil "ÀÁ!… ;„ Â>ƒ ‚É„Å‚]\f;ƒ(\f‚]\fÆ>ƒ7žA†]\fÉ>…]\n…]\n‰GSÅO˘ƒV\nÌÍO‚[\n‰‰QÎP‰??…s˜?…s‰*‡" [boundp outline-use-mode-specific-leader (outline-mode-leaders comment-start t) t use-leader nil (t outline-mode-leaders) major-mode outline-mode-leaders (t comment-start) comment-start " " 0 -1 "_" leader outline-header-prefix] 4 (#$ . 16626)]) #@217 Determine proper setting for `outline-reindent-bodies'. Depends on default setting of `outline-reindent-bodies' (which see) and presence of setting for `comment-start', to tell whether the file is programming code. (defalias 'outline-infer-body-reindent #[nil "… …Â=?…ɇ" [outline-reindent-bodies comment-start force nil] 2 (#$ . 17352)]) #@161 Generate proper topic-header regexp form for outline functions. Works with respect to `outline-plain-bullets-string' and `outline-distinctive-bullets-string'. (defalias 'set-outline-regexp #[nil "ÀÂÃDĉ‰‰‰‰ \n‰ ƒkÀÌ @J‰\nG  Wƒb\nH Í=ƒF΂WÏ=ƒQÀ‚WÐÑ!!PT‰‚- A‰ „.\nGGSÕÖ ×Ù°ÛÜQÞÜQ‰‡" ["" outline-bullets-string outline-plain-bullets-string outline-distinctive-bullets-string nil new-string index cur-char-string cur-char cur-len cur-string strings 0 45 "--" 93 regexp-quote char-to-string outline-plain-bullets-string-len outline-header-prefix outline-header-subtraction "\\(\\" "[ ]*[" "]\\)\\|\\" outline-primary-bullet "+\\|\f" outline-regexp "\\([\n ]\\)\\(" "\\)" outline-line-boundary-regexp "\\(\\`\\)\\(" outline-bob-regexp] 8 (#$ . 17709) nil]) #@46 Keybindings for (allout) outline minor mode. (defvar outline-mode-map nil (#$ . 18537)) #@210 Produce keymap for use as outline-mode-map, from keymap-list. Built on top of optional BASE-MAP, or empty sparse map if none specified. See doc string for outline-keybindings-list for format of binding list. (defalias 'produce-outline-mode-map #[(keymap-list &optional base-map) "†Á ÃÄ \"ˆ\n)‡" [base-map make-sparse-keymap map mapcar #[(cell) "ÀÁ\n AA„\f @P AB‚ @ A@D#‡" [apply define-key map cell outline-command-prefix] 5] keymap-list] 3 (#$ . 18632)]) #@155 Variable for use in V18, with outline-added-bindings, for resurrecting, on mode deactivation, bindings that existed before activation. Being deprecated. (defvar outline-prior-bindings nil (#$ . 19104)) #@155 Variable for use in V18, with outline-prior-bindings, for resurrecting, on mode deactivation, bindings that existed before activation. Being deprecated. (defvar outline-added-bindings nil (#$ . 19314)) #@73 Internal outline mode use; settings to be resumed on mode deactivation. (defvar outline-mode-prior-settings nil (#$ . 19523)) (make-variable-buffer-local (quote outline-mode-prior-settings)) #@483 Registers or resumes settings over outline-mode activation/deactivation. First arg is NAME of variable affected. Optional second arg is list containing outline-mode-specific VALUE to be imposed on named variable, and to be registered. (It's a list so you can specify registrations of null values.) If no value is specified, the registered value is returned (encapsulated in the list, so the caller can distinguish nil vs no value), and the registration is popped from the list. (defalias 'outline-resumptions #[(name &optional value) " žÂ ƒ'\f„Æ!…JCD BÇ!ˆ @L‚b\f??…b\fA@‰ƒ= @Lˆ‚AÈ!ˆÂ ƒ] @\f=„V @ B A‰„H ‰)*‡" [name outline-mode-prior-settings nil prior-capsule on-list value boundp make-local-variable makunbound rebuild] 4 (#$ . 19721)]) #@212 Used to inhibit outline change-protection during file write. See also `outline-post-command-business', `outline-write-file-hook', `outline-before-change-protect', and `outline-post-command-business' functions. (defvar outline-during-write-cue nil (#$ . 20503)) #@347 Used in outline-mode for regulate of concealed-text protection mechanism. Allout outline mode regulates alteration of concealed text to protect against inadvertant, unnoticed changes. This is for use by specific, native outline functions to temporarily override that protection. It's automatically reset to nil after every buffer modification. (defvar outline-override-protect nil (#$ . 20772)) (make-variable-buffer-local (quote outline-override-protect)) #@68 Evaluate EXPRESSION with `outline-override-protect' let-bound 't'. (defalias 'outline-unprotected '(macro . #[(expr) "ÀÁ\nE‡" [let ((outline-override-protect t)) expr] 3 (#$ . 21237)])) #@201 Amount of successive self-insert actions to bunch together per undo. This is purely a kludge variable, regulating the compensation for a bug in the way that before-change-function and undo interact. (defvar outline-undo-aggregation 30 (#$ . 21430)) (make-variable-buffer-local (quote outline-undo-aggregation)) #@160 Horrible hack used to prevent invalid multiple triggering of outline mode from prop-line file-var activation. Used by outline-mode function to track repeats. (defvar outline-v18/9-file-var-hack nil (#$ . 21749)) #@181 In outline mode, run as a local-write-file-hooks activity. Currently just sets 'outline-during-write-cue', so outline-change- protection knows to keep inactive during file write. (defalias 'outline-write-file-hook #[nil "À‡" [t outline-during-write-cue nil] 1 (#$ . 21969)]) #@38 Allout outline mode minor-mode flag. (defvar outline-mode nil (#$ . 22253)) (make-variable-buffer-local (quote outline-mode)) #@55 Return t if outline-mode is active in current buffer. (defalias 'outline-mode-p '(macro . #[nil "À‡" [outline-mode] 1 (#$ . 22385)])) #@108 Outline-mode was last deliberately deactived. So outline-post-command-business should not reactivate it... (defvar outline-explicitly-deactivated nil (#$ . 22526)) (make-variable-buffer-local (quote outline-explicitly-deactivated)) #@1085 Prime outline-mode to enable/disable auto-activation, wrt `outline-layout'. MODE is one of the following symbols: - nil (or no argument) deactivate auto-activation/layou; - 'activate', enable auto-activation only; - 'ask', enable auto-activation, and enable auto-layout but with confirmation for layout operation solicitated from user each time; - 'report', just report and return the current auto-activation state; - anything else (eg, t) for auto-activation and auto-layout, without any confirmation check. Use this function to setup your emacs session for automatic activation of allout outline mode, contingent to the buffer-specific setting of the `outline-layout' variable. (See `outline-layout' and `outline-expose-topic' docstrings for more details on auto layout). `outline-init' works by setting up (or removing) the outline-mode find-file-hook, and giving `outline-auto-activation' a suitable setting. To prime your emacs session for full auto-outline operation, include the following two lines in your emacs init file: (require 'allout) (outline-init t) (defalias 'outline-init #[(&optional mode) "tƒ ÀÁÂPÃÄÅ$‰ǘƒÈ‚ É!ÊË\f „=Î \"t…˜ÐÑ!‚˜È=ƒZ >„RÒÄ!‚˜Ò\fJ!‚˜ÓÏ \"ˆ\fÔ=ƒqÐÕ!ˆÔ‚—È=ƒÒ!‚—Ö=ƒÐ×ØP!ˆÖ‚—ÐÙ!…—ÚL*‡" [completing-read "Select outline auto setup mode " "(empty for report, ? for options) " (("nil") ("full") ("activate") ("deactivate") ("ask") ("report") ("")) nil t mode "" report intern-soft outline-find-file-hook outline-auto-activation curr-mode hook delq find-file-hooks message "Allout outline mode auto-activation inhibited." outline-init add-hook activate "Outline mode auto-activation enabled." ask "Outline mode auto-activation and " "-layout (upon confirmation) enabled." "Outline mode auto-activation and -layout enabled." full] 6 (#$ . 22766) nil]) #@7383 Toggle minor mode for controlling exposure and editing of text outlines. Optional arg forces mode reactivation iff arg is positive num or symbol. Allout outline mode provides extensive outline formatting and manipulation capabilities. It is specifically aimed at supporting outline structuring and manipulation of syntax-sensitive text, eg programming languages. (For an example, see the allout code itself, which is organized in outline structure.) It also includes such things as topic-oriented repositioning, cut, and paste; integral outline exposure-layout; incremental search with dynamic exposure/conceament of concealed text; automatic topic-number maintenance; and many other features. See the docstring of the variable `outline-init' for instructions on priming your emacs session for automatic activation of outline-mode, according to file-var settings of the `outline-layout' variable. Below is a description of the bindings, and then explanation of special outline-mode features and terminology. The bindings themselves are established according to the values of variables `outline-keybindings-list' and `outline-command-prefix', each time the mode is invoked. Prior bindings are resurrected when the mode is revoked. Navigation: Exposure Control: ---------- ---------------- C-c C-n outline-next-visible-heading | C-c C-h outline-hide-current-subtree C-c C-p outline-previous-visible-heading | C-c C-i outline-show-children C-c C-u outline-up-current-level | C-c C-s outline-show-current-subtree C-c C-f outline-forward-current-level | C-c C-o outline-show-current-entry C-c C-b outline-backward-current-level | ^U C-c C-s outline-show-all C-c C-e outline-end-of-current-entry | outline-hide-current-leaves C-c C-a outline-beginning-of-current-entry, alternately, goes to hot-spot Topic Header Production: ----------------------- C-c outline-open-sibtopic Create a new sibling after current topic. C-c . outline-open-subtopic ... an offspring of current topic. C-c , outline-open-supertopic ... a sibling of the current topic's parent. Topic Level and Prefix Adjustment: --------------------------------- C-c > outline-shift-in Shift current topic and all offspring deeper. C-c < outline-shift-out ... less deep. C-c outline-rebullet-topic Reconcile bullets of topic and its' offspring - distinctive bullets are not changed, others alternated according to nesting depth. C-c * outline-rebullet-current-heading Prompt for alternate bullet for current topic. C-c # outline-number-siblings Number bullets of topic and siblings - the offspring are not affected. With repeat count, revoke numbering. Topic-oriented Killing and Yanking: ---------------------------------- C-c C-k outline-kill-topic Kill current topic, including offspring. C-k outline-kill-line Like kill-line, but reconciles numbering, etc. C-y outline-yank Yank, adjusting depth of yanked topic to depth of heading if yanking into bare topic heading (ie, prefix sans text). M-y outline-yank-pop Is to outline-yank as yank-pop is to yank Misc commands: ------------- C-c @ outline-resolve-xref pop-to-buffer named by xref (cf outline-file-xref-bullet) C-c c outline-copy-exposed Copy current topic outline sans concealed text, to buffer with name derived from current buffer - "XXX exposed" M-x outlineify-sticky Activate outline mode for current buffer, and establish a default file-var setting for `outline-layout'. ESC ESC (outline-init t) Setup emacs session for outline mode auto-activation. HOT-SPOT Operation Hot-spot operation provides a means for easy, single-keystroke outline navigation and exposure control. \ When the text cursor is positioned directly on the bullet character of a topic, regular characters (a to z) invoke the commands of the corresponding outline-mode keymap control chars. For example, "f" would invoke the command typically bound to "C-c C-f" (\[outline-forward-current-level] `outline-forward-current-level'). Thus, by positioning the cursor on a topic bullet, you can execute the outline navigation and manipulation commands with a single keystroke. Non-literal chars never get this special translation, so you can use them to get away from the hot-spot, and back to normal operation. Note that the command `outline-beginning-of-current-entry' (\[outline-beginning-of-current-entry]) will move to the hot-spot when the cursor is already located at the beginning of the current entry, so you can simply hit \[outline-beginning-of-current-entry] twice in a row to get to the hot-spot. Terminology Topic hierarchy constituents - TOPICS and SUBTOPICS: TOPIC: A basic, coherent component of an emacs outline. It can contain other topics, and it can be subsumed by other topics, CURRENT topic: The visible topic most immediately containing the cursor. DEPTH: The degree of nesting of a topic; it increases with containment. Also called the: LEVEL: The same as DEPTH. ANCESTORS: The topics that contain a topic. PARENT: A topic's immediate ancestor. It has a depth one less than the topic. OFFSPRING: The topics contained by a topic; SUBTOPIC: An immediate offspring of a topic; CHILDREN: The immediate offspring of a topic. SIBLINGS: Topics having the same parent and depth. Topic text constituents: HEADER: The first line of a topic, include the topic PREFIX and header text. PREFIX: The leading text of a topic which which distinguishes it from normal text. It has a strict form, which consists of a prefix-lead string, padding, and a bullet. The bullet may be followed by a number, indicating the ordinal number of the topic among its siblings, a space, and then the header text. The relative length of the PREFIX determines the nesting depth of the topic. PREFIX-LEAD: The string at the beginning of a topic prefix, normally a '.'. It can be customized by changing the setting of `outline-header-prefix' and then reinitializing outline-mode. By setting the prefix-lead to the comment-string of a programming language, you can embed outline-structuring in program code without interfering with the language processing of that code. See `outline-use-mode-specific-leader' docstring for more detail. PREFIX-PADDING: Spaces or asterisks which separate the prefix-lead and the bullet, according to the depth of the topic. BULLET: A character at the end of the topic prefix, it must be one of the characters listed on 'outline-plain-bullets-string' or 'outline-distinctive-bullets-string'. (See the documentation for these variables for more details.) The default choice of bullet when generating varies in a cycle with the depth of the topic. ENTRY: The text contained in a topic before any offspring. BODY: Same as ENTRY. EXPOSURE: The state of a topic which determines the on-screen visibility of its' offspring and contained text. CONCEALED: Topics and entry text whose display is inhibited. Contiguous units of concealed text is represented by '...' ellipses. (Ref the 'selective-display' var.) Concealed topics are effectively collapsed within an ancestor. CLOSED: A topic whose immediate offspring and body-text is concealed. OPEN: A topic that is not closed, though its' offspring or body may be. (defalias 'outline-mode #[(&optional toggle) "Áš?…\n\f…\f<ƒ\f@†\f‰…,\f9†,Å\f!…,\fÆU? @=\nË\f @\nƒT ƒT„TÍÎ\"„¶„Î „a\fƒÎÐÍÒ\"ƒÓ ÕÖ\"ˆØ×!ˆØÙ!ˆ)ƒŒØÛ!ˆØÚ!ˆØÜ!ˆÝÞ!ƒŸƒŸØÞ!ˆßà!\"!ßâ#\"#Øä!ˆØå!ˆØÍæ\"ƒÂç‚Ãè!ˆØé!ˆË‚¶ „¬ËƒäØÛê\"ˆØÚë\"ˆì ˆí ˆî ˆÝï!ƒð1!2ò2Mˆó/„%ô/B/‚%Ø×1C\"ˆØÙÓ C\"ˆõð1Ó \"!ˆØÜö\"ˆ7„4ØÞø\"ˆùãâ\"ˆÍæ\"ƒEç‚Fè‰:J;Øé;C\"ˆØ:ü\"ˆ*ýä!ˆØä$þ?@RC\"ˆýå!ˆØå%þ?@RC\"ˆÂAž„BABACƒ•Ð\fDƒŸE ˆFG!ˆÐ‚¶Љ\fƒ¶í ˆ\fƒHƒC<ƒHI=„HJ=ƒûKLMN C#!„ûOPN \"ˆ‚ŠOQN \"ˆÆbˆR ˆSTUˆ)\n-‡" [major-mode outline outline-mode active toggle natnump 0 explicit-activation outline-v18/9-file-var-hack command-history same-complex-command nil do-layout string-match "^19.1[89]" emacs-version t outline-explicitly-deactivated "^18." current-local-map curr-loc mapcar #[(cell) "À \n@\"\nA@=…à \n@\n@\fž#‡" [lookup-key curr-loc cell define-key outline-prior-bindings] 5] outline-added-bindings outline-resumptions outline-prior-bindings outline-old-style-prefixes outline-primary-bullet selective-display boundp before-change-function delq outline-pre-command-business pre-command-hook outline-write-file-hook local-write-file-hooks paragraph-start paragraph-separate "^18" auto-fill-hook auto-fill-function outline-former-auto-filler ("*") (nil) outline-infer-header-lead outline-infer-body-reindent set-outline-regexp minor-mode-map-alist produce-outline-mode-map outline-keybindings-list outline-mode-map (outline-mode . outline-mode-map) (outline-mode . outline-mode-map) use-local-map (t) outline-inhibit-protection (outline-before-change-protect) add-hook fill-func-var fill-func (outline-auto-fill) make-local-variable "\\|\\(" outline-regexp "\\)" minor-mode-alist (outline-mode " Outl") outline-layout outline-enwrap-isearch-mode outline-enwrap-isearch run-hooks outline-mode-hook outline-auto-activation activate ask y-or-n-p format "Expose %s with layout '%s'? " buffer-name message "Skipped %s layout." "Adjusting '%s' exposure..." outline-this-or-next-heading err (byte-code "ÀÁ\nC\"ˆÃÄÅ \"‡" [apply outline-expose-topic outline-layout message "Adjusting '%s' exposure... done." buffer-name] 3) ((error (byte-code "ÀÁ\nA@\"ˆÃÄ!‡" [message "%s" err sit-for 1] 3)))] 7 (#$ . 24624) "P"]) #@65 Buffer point of the start of the last topic prefix encountered. (defvar outline-recent-prefix-beginning 0 (#$ . 34341)) (make-variable-buffer-local (quote outline-recent-prefix-beginning)) #@63 Buffer point of the end of the last topic prefix encountered. (defvar outline-recent-prefix-end 0 (#$ . 34536)) (make-variable-buffer-local (quote outline-recent-prefix-end)) #@63 Buffer point last returned by outline-end-of-current-subtree. (defvar outline-recent-end-of-subtree 0 (#$ . 34717)) (make-variable-buffer-local (quote outline-recent-end-of-subtree)) #@129 Register outline-prefix state data - BEGINNING and END of prefix. For reference by 'outline-recent' funcs. Returns BEGINNING. (defalias 'outline-prefix-data '(macro . #[(beg end) "ÀÁ\nÃ\f¯‡" [setq outline-recent-prefix-end end outline-recent-prefix-beginning beg] 5 (#$ . 34907)])) #@312 Return depth of last heading encountered by an outline maneuvering function. All outline functions which directly do string matches to assess headings set the variables outline-recent-prefix-beginning and outline-recent-prefix-end if successful. This function uses those settings to return the current depth. (defalias 'outline-recent-depth '(macro . #[nil "À‡" [(max 1 (- outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction))] 1 (#$ . 35199)])) #@307 Like outline-recent-depth, but returns text of last encountered prefix. All outline functions which directly do string matches to assess headings set the variables outline-recent-prefix-beginning and outline-recent-prefix-end if successful. This function uses those settings to return the current depth. (defalias 'outline-recent-prefix '(macro . #[nil "À‡" [(buffer-substring outline-recent-prefix-beginning outline-recent-prefix-end)] 1 (#$ . 35687)])) #@345 Like outline-recent-prefix, but returns bullet of last encountered prefix. All outline functions which directly do string matches to assess headings set the variables outline-recent-prefix-beginning and outline-recent-prefix-end if successful. This function uses those settings to return the current depth of the most recently matched topic. (defalias 'outline-recent-bullet '(macro . #[nil "À‡" [(buffer-substring (1- outline-recent-prefix-end) outline-recent-prefix-end)] 1 (#$ . 36151)])) #@111 Return non-nil if point is on current visible topics' header line. Actually, returns prefix beginning point. (defalias 'outline-on-current-heading-p #[nil "ŠÀyˆÁ\n!…À•À”‰)‡" [0 looking-at outline-regexp outline-recent-prefix-end outline-recent-prefix-beginning] 2 (#$ . 36652)]) #@75 True if point is located where current topic prefix ends, heading begins. (defalias 'outline-e-o-prefix-p #[nil "ŠÀyˆÁ\n!)…`ŠÃ ˆ`)U‡" [0 looking-at outline-regexp outline-end-of-prefix] 2 (#$ . 36942)]) #@34 True if point is in hidden text. (defalias 'outline-hidden-p '(macro . #[nil "À‡" [(save-excursion (and (re-search-backward "[\n ]" nil t) (= 13 (following-char))))] 1 (#$ . 37153)])) #@38 True if point is not in hidden text. (defalias 'outline-visible-p '(macro . #[nil "À‡" [(not (outline-hidden-p))] 1 (#$ . 37343) nil])) #@76 Like outline-current-depth, but respects hidden as well as visible topics. (defalias 'outline-depth '(macro . #[nil "À‡" [(save-excursion (if (outline-goto-prefix) (outline-recent-depth) (progn (outline-prefix-data (point) (point)) 0)))] 1 (#$ . 37485)])) #@74 Return nesting depth of visible topic most immediately containing point. (defalias 'outline-current-depth '(macro . #[nil "À‡" [(save-excursion (if (outline-back-to-current-heading) (max 1 (- outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction)) 0))] 1 (#$ . 37747)])) #@36 Topic prefix of the current topic. (defalias 'outline-get-current-prefix #[nil "ŠÀ … \n{)‡" [outline-goto-prefix outline-recent-prefix-beginning outline-recent-prefix-end] 2 (#$ . 38055)]) #@53 Return bullet of containing topic (visible or not). (defalias 'outline-get-bullet #[nil "ŠÀ …\n S {)‡" [outline-goto-prefix outline-recent-prefix-end] 2 (#$ . 38252)]) #@74 Return bullet of current (visible) topic heading, or none if none found. (defalias 'outline-current-bullet #[nil "ÀÁ‡" [err (byte-code "ŠÀ ˆ ÂZ {)‡" [outline-back-to-current-heading outline-recent-prefix-end 1] 2) ((args-out-of-range))] 3 (#$ . 38427)]) #@55 Return the bullet of the header prefix string PREFIX. (defalias 'outline-get-prefix-bullet #[(prefix) "À \n\"…\nÕSÕO‡" [string-match outline-regexp prefix 0] 3 (#$ . 38689)]) #@133 Move to the heading for the topic (possibly invisible) before this one. Returns the location of the heading, or nil if none found. (defalias 'outline-next-heading '(macro . #[nil "À‡" [(if (re-search-forward outline-line-boundary-regexp nil 0) (progn (outline-prefix-data (goto-char (or (match-beginning 2) outline-recent-prefix-beginning)) (or (match-end 2) outline-recent-prefix-end))))] 1 (#$ . 38875)])) #@45 Position cursor on current or next heading. (defalias 'outline-this-or-next-heading #[nil "À ?…\"Á\nÃÄ#…\"Å•†Å”†b‰‡" [outline-goto-prefix re-search-forward outline-line-boundary-regexp nil 0 2 outline-recent-prefix-end outline-recent-prefix-beginning] 4 (#$ . 39290)]) #@129 Move to the prior (possibly invisible) heading line. Return the location of the beginning of the heading, or nil if not found. (defalias 'outline-previous-heading '(macro . #[nil "À‡" [(if (bobp) nil (outline-goto-prefix) (if (or (re-search-backward outline-line-boundary-regexp nil 0) (looking-at outline-bob-regexp)) (progn (outline-prefix-data (goto-char (or (match-beginning 2) outline-recent-prefix-beginning)) (or (match-end 2) outline-recent-prefix-end)))))] 1 (#$ . 39580)])) #@923 Produce a location "chart" of subtopics of the containing topic. Optional argument LEVELS specifies the depth (releative to start depth) for the chart. Subsequent optional args are not for public use. Charts are used to capture outline structure, so that outline-altering routines need assess the structure only once, and then use the chart for their elaborate manipulations. Topics are entered in the chart so the last one is at the car. The entry for each topic consists of an integer indicating the point at the beginning of the topic. Charts for offspring consists of a list containing, recursively, the charts for the respective subtopics. The chart for a topics' offspring precedes the entry for the topic itself. The other function parameters are for internal recursion, and should not be specified by external callers. ORIG-DEPTH is depth of topic at starting point, and PREV-DEPTH is depth of prior topic. (defalias 'outline-chart-subtree #[(&optional levels orig-depth prev-depth) "?Á‰‰ƒLŠÅ ƒÆZ Z]‚%``Ê) „0T Ì ÁÊ#ƒLΕ†@Δ†Ibm„öÆZ Z]‰Wƒö \nUƒÐ` Bƒ°ÆXƒ°Ð\n!„L\nÆZ Z]XƒöÌ ÁÊ#ƒöΕ†Δ†¦b‰ƒö‚~Ì ÁÊ#ƒöΕ†ÀΔ†Éb‰‚ó \nWƒöƒãÊVƒöÑ…ìS\n# B‰„L\fƒm„ÒuˆhÓ>ƒÆ`ÔZ]`{ÆHÕ>ƒÒuˆ` +‡" [orig-depth nil curr-depth chart original outline-goto-prefix 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction 0 prev-depth re-search-forward outline-line-boundary-regexp 2 levels outline-next-sibling outline-chart-subtree -1 (10 13) 3 (10 13) outline-recent-end-of-subtree] 5 (#$ . 40072)]) #@170 Produce a list of locations of this and succeeding sibling topics. Effectively a top-level chart of siblings. See 'outline-chart-subtree' for an explanation of charts. (defalias 'outline-chart-siblings #[(&optional start end) "ŠÀ …`C ƒ` B‚ … Ÿ‰))‡" [outline-goto-prefix chart outline-next-sibling] 2 (#$ . 41702)]) #@151 Return a flat list of hidden points in subtree CHART, up to DEPTH. Note that point can be left at any of the points on chart, or at the start point. (defalias 'outline-chart-to-reveal #[(chart depth) "À‰ Ä=„ ÅVƒSƒS@‰<ƒ>Ç Ä=†( S\"‰ƒ5É\n\"A)‚ bˆhÊUƒK \nBA‚\n*‡" [nil here result depth t 0 chart outline-chart-to-reveal further append 13] 5 (#$ . 42037)]) #@998 Not yet (if ever) implemented. Produce exposure directives given topic/subtree CHART and an exposure SPEC. Exposure spec indicates the locations to be exposed and the prescribed exposure status. Optional arg EXPOSING is an integer, with 0 indicating pending concealment, anything higher indicating depth to which subtopic headers should be exposed, and negative numbers indicating (negative of) the depth to which subtopic headers and bodies should be exposed. The produced list can have two types of entries. Bare numbers indicate points in the buffer where topic headers that should be exposed reside. - bare negative numbers indicates that the topic starting at the point which is the negative of the number should be opened, including their entries. - bare positive values indicate that this topic header should be openned. - Lists signify the beginning and end points of regions that should be flagged, and the flag to employ. (For concealment: '(?r)', and exposure: (defalias 'outline-chart-spec #[(chart spec &optional exposing) "…\fA‰„Á‡" [spec nil] 2 (#$ . 42432)]) #@245 Put point at beginning of outline prefix for immediately containing topic. Goes to first subsequent topic if none immediately containing. Not sensitive to topic visibility. Returns a the point at the beginning of the prefix, or nil if none. (defalias 'outline-goto-prefix #[nil "À „,ÂÃÀÄ#ƒ,ÄuˆÅ!ƒ&Ç•Ç”‰ ‰‚Êuˆ‚oƒsÅ!ƒCÇ•Ç”‰ ‚tË\fÀÇ#ƒoÍ•†SÍ”†\\ b‰ ƒoÇ•Ç”‰ ‚t ‚t )‡" [nil done re-search-backward "[\n ]" 1 looking-at outline-regexp 0 outline-recent-prefix-end outline-recent-prefix-beginning -1 re-search-forward outline-line-boundary-regexp 2] 5 (#$ . 43545)]) #@173 Position cursor at beginning of header text. If optional IGNORE-DECORATIONS is non-nil, put just after bullet, otherwise skip white space between bullet and ensuing text. (defalias 'outline-end-of-prefix #[(&optional ignore-decorations) "À ??…EÁ •bˆ „+ÄÅ!ƒÆuˆ‚l„+ÄÇ!ƒ+ÆuˆÈ !ˆ)ŠÉ ƒCÆ\n Z\fZ]‚DÂ)‡" [outline-goto-prefix match-data 0 ignore-decorations looking-at "[0-9]" 1 "\\s-" store-match-data outline-back-to-current-heading outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction] 3 (#$ . 44151)]) #@54 Return position of current (visible) topic's bullet. (defalias 'outline-current-bullet-pos #[nil "ŠÀ ƒÁ\n Z\fZ]‚Å)??…Å•S‡" [outline-back-to-current-heading 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction 0] 3 (#$ . 44703)]) #@77 Move to heading line of current topic, or beginning if already on the line. (defalias 'outline-back-to-current-heading #[nil "ÀyˆÁ †ÂÃ\fÅQÆÇ#…È• È”‰\ntƒ#Ë ˆ‡" [0 outline-on-current-heading-p re-search-backward "^\\(" outline-regexp "\\)" nil move 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-end-of-prefix] 4 (#$ . 44978)]) #@86 Skip forward to just before the next heading line. Returns that character position. (defalias 'outline-pre-next-preface #[nil "À ÂÃ#…Ä”bÅ•Å”‡" [re-search-forward outline-line-boundary-regexp nil move 0 2 outline-recent-prefix-end outline-recent-prefix-beginning] 4 (#$ . 45338)]) #@71 Put point at the end of the last leaf in the currently visible topic. (defalias 'outline-end-of-current-subtree #[nil "À ˆÁ\n Z\fZ]ÆÈÉ#ƒ#Ê•†\nÊ”†! bm„NÁ\n Z\fZ] VƒNÆÈÉ#ƒ#Ê•†B\nÊ”†I b‚#m„UËuˆhÌ>ƒlÁ`ÍZ]`{ÁHÎ>ƒlËuˆ`‰)‡" [outline-back-to-current-heading 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction level re-search-forward outline-line-boundary-regexp nil 0 2 -1 (10 13) 3 (10 13) outline-recent-end-of-subtree] 4 (#$ . 45631) nil]) #@208 When not already there, position point at beginning of current topic's body. If already there, move cursor to bullet for hot-spot operation. (See outline-mode doc string for details on hot-spot operation.) (defalias 'outline-beginning-of-current-entry #[nil "`Á ˆt…`U… b)‡" [start-point outline-end-of-prefix outline-current-bullet-pos] 2 (#$ . 46133) nil]) #@61 Position the point at the end of the current topics' entry. (defalias 'outline-end-of-current-entry #[nil "À ˆÁ o„ÂÃ!ƒÄuˆ‡" [outline-show-entry outline-pre-next-preface looking-at "^$" -1] 3 (#$ . 46505) nil]) #@67 Ascend to depth DEPTH, returning depth if successful, nil if not. (defalias 'outline-ascend-to-depth #[(depth) "ÁVƒ’ŠÂ ƒÃ\f ZZ]‚``Á)Xƒ’`ŠÂ ƒ7Ã\f ZZ]‚<``Á)Wƒw`‰ƒwÈ ƒwo„w ˆÉ\nËÁ#„dÌ !ƒwΕ†j\fΔ†q b‰„%Ã\f ZZ]Uƒ‹ bˆ‚bˆË)‡t…˜Ï ‡" [depth 0 outline-goto-prefix 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction last-good outline-beginning-of-level re-search-backward outline-line-boundary-regexp nil looking-at outline-bob-regexp 2 outline-end-of-prefix] 4 (#$ . 46725)]) #@90 Descend to depth DEPTH within current topic. Returning depth if successful, nil if not. (defalias 'outline-descend-to-depth #[(depth) "`ŠÀ ƒÁ\n Z\fZ]‚``Å)ŠÀ ƒ+Á\n Z\fZ]‚0``Å)ÅVƒlÁ\n Z\fZ]U„lÉ\nËÅ#ƒlÌ•†R\nÌ”†Y b‰ƒlÁ\n Z\fZ]W„ŠÀ ƒ|Á\n Z\fZ]‚``Å)ÅVƒ™Á\n Z\fZ]Uƒ™‚žbˆË*‡" [outline-goto-prefix 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction 0 start-depth start-point depth re-search-forward outline-line-boundary-regexp nil 2] 4 (#$ . 47280)]) #@204 Move out ARG levels from current visible topic. Positions on heading line of containing topic. Error if unable to ascend that far, or nil if unable to ascend but optional arg DONT-COMPLAIN is non-nil. (defalias 'outline-up-current-level #[(arg &optional dont-complain) "À ˆÁ\n Z\fZ]`ʼn Á\n Z\fZ]ÁVƒl\nËVƒlo„l„l`Á\n Z\fZ] W„OÌÁ!„4 ‰ƒ4ŠÀ ƒ_Á\n Z\fZ]‚`Ë) \nÁZ\n‚„x\nËVƒ™bˆtƒƒÍ ˆ„ŽÏÐ!‚¡tƒ•Í ˆÅ‚¡tƒ Í ˆ ,‡" [outline-back-to-current-heading 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction nil return failed last-good present-level arg 0 outline-previous-visible-heading outline-end-of-prefix dont-complain error "Can't ascend past outermost level."] 4 (#$ . 47810) "p"]) #@227 Like outline-forward-current-level, but respects invisible topics. Traverse at optional DEPTH, or current depth if none specified. Go backward if optional arg BACKWARD is non-nil. Return depth if successful, nil otherwise. (defalias 'outline-next-sibling #[(&optional depth backward) "…o?…ß †$ŠÂ ƒÃ\f ZZ]‚#``Ç)`È \n ƒ4o‚5m„“ƒfo„“ ˆÌ ÈÇ#„SÎ!ƒ“Е†Y\fД†` b‰‚Ñ ÈÇ#ƒ“Е†u\fД†| b‰ƒ“Ã\f ZZ]‰  V„,m„Ê †³ŠÂ ƒ­Ã\f ZZ]‚²``Ç)ÇVƒÊÃ\f ZZ] UƒÊ ‚Þ\nbˆ ƒÝŠÂ „Ü``)È+‡" [backward depth outline-goto-prefix 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction 0 nil last-depth start-point start-depth re-search-backward outline-line-boundary-regexp looking-at outline-bob-regexp 2 re-search-forward] 4 (#$ . 48568)]) #@229 Like outline-forward-current-level,but backwards & respect invisible topics. Optional DEPTH specifies depth to traverse, default current depth. Optional BACKWARD reverses direction. Return depth if successful, nil otherwise. (defalias 'outline-previous-sibling #[(&optional depth backward) "À \n?\"‡" [outline-next-sibling depth backward] 3 (#$ . 49377)]) #@93 Position cursor at end of previous topic Presumes point is at the start of a topic prefix. (defalias 'outline-snug-back #[nil "o„ m„ Àuˆo„%hÁ>ƒ%Àuˆo„\"hÂ>„%Àuˆ`‡" [-1 (10 13) (10 13)] 2 (#$ . 49742)]) #@61 Go back to the first sibling at this level, visible or not. (defalias 'outline-beginning-of-level #[nil "ÀÁ!‡" [outline-end-of-level backward] 2 (#$ . 49956)]) #@55 Go to the last sibling at this level, visible or not. (defalias 'outline-end-of-level #[(&optional backward) "ŠÀ ƒÁ\n Z\fZ]‚``Å)ÇÈ\"„Á\n Z\fZ]tƒ.É ˆ)‡" [outline-goto-prefix 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction 0 depth outline-previous-sibling nil outline-end-of-prefix] 3 (#$ . 50122)]) #@180 Move to the next ARG'th visible heading line, backward if arg is negative. Move as far as possible in indicated direction (beginning or end of buffer) if headings are exhausted. (defalias 'outline-next-visible-heading #[(arg) "ÁW…\n[‰‰ƒÂÄ`ÇÇ ÁVƒQ\nƒ,o‚-m„Aà yWƒAÊ !‰ ƒ$ ƒJ S‰‚ ƒcÁ•\fÁ” Î ‚}ƒtÁ•\fÁ”‰ ‚}\n?…}LjÇ-‡" [arg 0 backward -1 1 step start-point nil prev got looking-at outline-regexp outline-recent-prefix-end outline-recent-prefix-beginning outline-end-of-prefix] 3 (#$ . 50479) "p"]) #@172 Move to the previous heading line. With argument, repeats or can move forward if negative. A heading line is one that starts with a `*' (or that outline-regexp matches). (defalias 'outline-previous-visible-heading #[(arg) "À [!‡" [outline-next-visible-heading arg] 2 (#$ . 51027) "p"]) #@174 Position point at the next heading of the same level. Takes optional repeat-count, goes backward if count is negative. Returns resulting position, else nil if none found. (defalias 'outline-forward-current-level #[(arg) "ŠÀ ƒÁ\n Z\fZ]‚Å)`ÅVÇ`Ç \n \f ‰ÅUƒ4ÏÐ!ˆ ƒ>[ÅU„¤„¤ ƒSo‚Tm„x ƒbÑÁ!‚eÒÁ!ƒxÁ\n Z\fZ]‰\nV„J\nƒž\nUƒž ƒŽo‚m„ž` S‰‚@Ó‚>m„àÅUƒà\n†ÊŠÔ ƒÄÁ\n Z\fZ]‚É``Å)ÅVƒàÁ\n Z\fZ]Uƒà ‚\f bˆt??…\fÕ ˆÏÖ ƒøׂùØÁ\n Z\fZ]Ù\f!ZÙ\f!%.‡" [outline-back-to-current-heading 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction 0 arg nil at-boundary last-good last-depth backward start-arg start-point start-depth error "No siblings, not in a topic..." outline-previous-visible-heading outline-next-visible-heading t outline-goto-prefix outline-end-of-prefix "Hit %s level %d topic, traversed %d of %d requested." "first" "last" abs] 8 (#$ . 51321) "p"]) #@45 Inverse of `outline-forward-current-level'. (defalias 'outline-backward-current-level #[(arg) "tƒ\f[ÂÃ!)‡Ã[!‡" [arg current-prefix-arg call-interactively outline-forward-current-level] 2 (#$ . 52290) "p"]) #@1067 Outline before-change hook, regulates changes to concealed text. Reveal concealed text that would be changed by current command, and offer user choice to commit or forego the change. Unchanged text is reconcealed. User has option to have changed text reconcealed. Undo commands are specially treated - the user is not prompted for choice, the undoes are always committed (based on presumption that the things being undone were already subject to this regulation routine), and undoes always leave the changed stuff exposed. Changes to concealed regions are ignored while file is being written. (This is for the sake of functions that do change the file during writes, like crypt and zip modes.) Locally bound in outline buffers to 'before-change-function', which in emacs 19 is run before any change to the buffer. (Has no effect in Emacs 18, which doesn't support before-change-function.) Any functions which set ['this-command' to 'undo', or which set] 'outline-override-protect' non-nil (as does, eg, outline-flag-chars) are exempt from this restriction. (defalias 'outline-before-change-protect #[(beg end) "…ÿ ?…ÿ\n?…ÿà ÅŽŠÇ>ƒ%T T bˆŠÊËÌÍ#…5gÎU)†U U?…U b…UŠÊËÌÍ#…TgÎU)+…ÿà ÐŽÑšƒƒÒÓ!ˆŠÊËÌÍ#…vgÎU)ƒ}Ô ˆÒÕ!‚þÌŠÖ ˆŠÊËÌÍ#…”gÎU*ÌŠÚÛ܃ßÝ=ƒÅŠƒµbˆƒ¿Þ ‚Áß )‚ýàá\"#Z$Z]S!ƒÚÔ ‚ýå ‚ýƒõŠƒîbˆÞ ˆ)‚øß ˆæç°!,*‡" [outline-mode outline-override-protect outline-during-write-cue match-data match-data ((store-match-data match-data)) this-command (newline open-line) beg end re-search-backward "[\n ]" nil t 13 match-data ((store-match-data match-data)) undo message "Undo! - exposing concealed target..." outline-show-children "Undo!" outline-goto-prefix rehide-place rehide-completely response err (byte-code "ŠlƒÀ  ˆ)ÃÄÅÆQ!ˆÇ ‰É>ƒ$ʉ‚VË>ƒ2̉‚VÍ>ƒ?΂YÏ=ƒMÃÐ!ˆ‚\fÃÑ!ˆÒÓ!ˆÎƒ\f‡" [outline-goto-prefix rehide-place outline-show-entry message "Change inside concealed" " region - do it? " "(n or 'y'/'r'eclose)" read-char response (114 82) reclose (121 89 32) t (110 78 127) nil 63 "'r' means 'yes, then reclose" "Please answer y, n, or r" sit-for 1] 5) ((quit)) reclose outline-hide-current-entry-completely outline-hide-current-entry outline-ascend-to-depth 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction outline-show-to-offshoot error "Change within concealed region prevented."] 5 (#$ . 52508)]) #@371 Outline internal var, for `outline-pre-command-business' hot-spot operation. When set, tells post-processing to reposition on topic bullet, and then unset it. Set by outline-pre-command-business when implementing hot-spot operation, where literal characters typed over a topic bullet are mapped to the command of the corresponding control-key on the outline-mode-map. (defvar outline-post-goto-bullet nil (#$ . 54945)) (make-variable-buffer-local (quote outline-post-goto-bullet)) #@362 Outline post-command-hook function. - Null outline-override-protect, so it's not left open. - Implement (and clear) outline-post-goto-bullet, for hot-spot outline commands. - Massages buffer-undo-list so successive, standard character self-inserts are aggregated. This kludge compensates for lack of undo bunching when before-change-function is used. (defalias 'outline-post-command-business #[nil "??…ºÁ ƒÁ\f<ƒ¨ Æšƒ¨Æšƒ¨\fA‰AA Á\nÁ Á\fÁ ÁÁ ƒ¦@„¦ @„¦A@‰ ƒ¦\f@‰\nƒ¦\n@‰ §ƒ¦\nA‰\f§ƒ¦\f ZÐUƒ¦ @‰§ƒ¦ A‰§ƒ¦ZVƒ¦\fB\fAAAB.…ºÓ …ºÓ bˆÁ‰‡" [outline-mode nil outline-override-protect outline-during-write-cue buffer-undo-list this-command self-insert-command last-command prev-stuff before-prev-stuff cur-cell cur-from cur-to prev-cell prev-from prev-to 1 outline-undo-aggregation outline-post-goto-bullet outline-current-bullet-pos] 4 (#$ . 55435)]) #@661 Outline pre-command-hook function for outline buffers. Implements special behavior when cursor is on bullet char. Self-insert characters are reinterpreted control-character references into the outline-mode-map. The outline-mode post-command hook will position a cursor that has moved as a result of such reinterpretation, on the destination topic's bullet, when the cursor wound up in the The upshot is that you can get easy, single (unmodified) key outline maneuvering and general operations by positioning the cursor on the bullet char, and it continues until you deliberately some non-outline motion command to relocate the cursor off of a bullet char. (defalias 'outline-pre-command-business #[nil "ÀÁ!…X …X\nÃ=…X`Ä =…X §… ÇÉXƒ/ÊZËXƒKÉYƒKÌÍÏËZ!P\"…WЉ*‡" [boundp outline-mode this-command self-insert-command outline-current-bullet-pos last-command-event this-key-num nil mapped-binding 96 32 64 lookup-key outline-mode-map outline-command-prefix char-to-string t outline-post-goto-bullet] 6 (#$ . 56362)]) #@130 Activate outline-mode when `outline-auto-activation' & `outline-layout' are non-nil. See `outline-init' for setup instructions. (defalias 'outline-find-file-hook #[nil "… ?…\n…ÁÃ!‡" [outline-auto-activation outline-mode outline-layout t] 2 (#$ . 57421)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [add-hook post-command-hook outline-post-command-business pre-command-hook outline-pre-command-business] 3) #@131 Prompt for and return a bullet char as an alternative to the current one. Offer one suitable for current depth DEPTH as default. (defalias 'outline-solicit-alternate-bullet #[(depth &optional current-bullet) "†Á\n!Ä !ÇÈÉ #Ê#‰ ̘ƒ$ ‚& +‡" [current-bullet outline-bullet-for-depth depth default-bullet regexp-sans-escapes outline-bullets-string sans-escapes solicit-char-in-string format "Select bullet: %s ('%s' default): " t choice ""] 6 (#$ . 57825)]) #@219 Item number of this prospective topic among its siblings. If optional arg depth is greater than current depth, then we're opening a new level, and return 0. If less than this depth, ascend to that depth and count... (defalias 'outline-sibling-index #[(&optional depth) "ŠƒÁXƒÁ‚eƒ/ŠÂ ƒ%Ã\f ZZ]‚*``Á)UƒNÃÈÃ\f ZZ]É\"ƒHT‚2)‚eÃ\f ZZ]WƒdÊ!ˆË ‚eÁ)‡" [depth 0 outline-goto-prefix 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction index outline-previous-sibling nil outline-ascend-to-depth outline-sibling-index] 4 (#$ . 58300)]) #@71 True if bullet is one of those on outline-distinctive-bullets-string. (defalias 'outline-distinctive-bullet #[(bullet) "ÀÁ\n! \"‡" [string-match regexp-quote bullet outline-distinctive-bullets-string] 3 (#$ . 58902)]) #@58 True if current header prefix bullet is numbered bullet. (defalias 'outline-numbered-type-prefix #[(&optional prefix) "… ƒ !‚à ˜‡" [outline-numbered-bullet prefix outline-get-prefix-bullet outline-get-bullet] 3 (#$ . 59126)]) #@73 Return outline topic bullet suited to optional DEPTH, or current depth. (defalias 'outline-bullet-for-depth #[(&optional depth) "ƒÁ\nÃ\fÅZ]¦H!‡‡" [outline-stylish-prefixes char-to-string outline-plain-bullets-string 0 depth 2 outline-plain-bullets-string-len outline-primary-bullet] 5 (#$ . 59367)]) #@1859 Generate a topic prefix suitable for optional arg DEPTH, or current depth. All the arguments are optional. PRIOR-BULLET indicates the bullet of the prefix being changed, or nil if none. This bullet may be preserved (other options notwithstanding) if it is on the outline-distinctive-bullets-string, for instance. Second arg NEW indicates that a new topic is being opened after the topic at point, if non-nil. Default bullet for new topics, eg, may be set (contingent to other args) to numbered bullets if previous sibling is one. The implication otherwise is that the current topic is being adjusted - shifted or rebulleted - and we don't consider bullet or previous sibling. Third arg DEPTH forces the topic prefix to that depth, regardless of the current topics' depth. Fourth arg SOLICIT non-nil provokes solicitation from the user of a choice among the valid bullets. (This overrides other all the options, including, eg, a distinctive PRIOR-BULLET.) Fifth arg, NUMBER-CONTROL, matters only if 'outline-numbered-bullet' is non-nil *and* soliciting was not explicitly invoked. Then NUMBER-CONTROL non-nil forces prefix to either numbered or denumbered format, depending on the value of the sixth arg, INDEX. (Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...) If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then the prefix of the topic is forced to be numbered. Non-nil NUMBER-CONTROL and nil INDEX forces non-numbered format on the bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means that the index for the numbered prefix will be derived, by counting siblings back to start of level. If INDEX is a number, then that number is used as the index for the numbered prefix (allowing, eg, sequential renumbering to not requre this function counting back the index for each successive sibling). (defalias 'outline-make-topic-prefix #[(&optional prior-bullet new depth solicit number-control index) "ÀÀÀ\f†%ŠÅ ƒÆZ Z]‚$``Ê) \f\fÆXƒ8Í\f‚@ƒLÐ\fÑ!\"Í\fÍ‚@Ð\fÒZÓ\"ƒzÕ\f!…s…j??…s˜)‚@ƒ¬ƒ¬?‰?‰ƒ”‚@ƒ¦˜„¦‚@Û\f!‚@ƒ\fŠÅ ƒÅÆZ Z]‚Ì``Ê)Xƒƒ „Š\fŠÅ ƒïÆZ Z]‚ö``Ê)Y„ÿÝ\f!ˆÞ )‰…˜…‰)†@ƒ=à!ƒ=ƒ8˜ƒ8 ?‰ƒ=†@Û\f!!\f !\n…lâãƒ]§ƒ]‚kƒiä\f!T‚kä \"R.‡" [nil body numbering denumbering depth outline-goto-prefix 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction 0 outline-header-prefix header-lead "" outline-primary-bullet outline-old-style-prefixes make-string string-to-char 2 32 solicit outline-solicit-alternate-bullet got outline-numbered-bullet number-control index prior-bullet outline-bullet-for-depth new outline-ascend-to-depth outline-get-bullet sibling-bullet outline-distinctive-bullet bullet-char format "%d" outline-sibling-index] 8 (#$ . 59682)]) #@1153 Open a new topic at depth DEPTH. New topic is situated after current one, unless optional flag BEFORE is non-nil, or unless current line is complete empty (not even whitespace), in which case open is done on current line. Nuances: - Creation of new topics is with respect to the visible topic containing the cursor, regardless of intervening concealed ones. - New headers are generally created after/before the body of a topic. However, they are created right at cursor location if the cursor is on a blank line, even if that breaks the current topic body. This is intentional, to provide a simple means for deliberately dividing topic bodies. - Double spacing of topic lists is preserved. Also, the first level two topic is created double-spaced (and so would be subsequent siblings, if that's left intact). Otherwise, single-spacing is used. - Creation of sibling or nested topics is with respect to the topic you're starting from, even when creating backwards. This way you can easily create a sibling in front of the current topic without having to go to its preceeding sibling, and then open forward from there. (defalias 'outline-open-topic #[(relative-depth &optional before) "ŠÀ ƒÁ\n Z\fZ]‚Å)\\ÈÉ!…\"ʉ ?\fÊ ÊŠÅWƒ:Ï!ˆ‚DÁY„DÀ ˆÁ\n Z\fZ]Š…hÅX„aÑ!…hÒ …h) `)ÊÊ\f„ bˆÅXƒ¡ŠÅÖyV†”È×!†”o)ƒ¡ŠØ ˆn)†¹ÁU…¹ †¹ÁU†¹ŠÙ )? ƒúÅYƒúÀ ˆoo„ o„ Ú ˆÛÊÅ#„èÈ!ƒ Þ•†î\nÞ”†õ b‚  ƒ oƒ ß áÁ!ˆ)ÅXƒYƒ+ß áƒ$Þ‚%Á!ˆ)‚§ ƒSʈ٠ˆgâUƒBÁuˆ‚6ÈÉ!„§ß áÁ!ˆ)‚§Ø ˆ‚§ÊˆÙ ˆnƒiÛãÊß#ˆŠäÊÅ#ƒ‚Þ•†y\nÞ”†€ bÁ\n Z\fZ]V…•ÖyˆÈ×!)ƒ¤Áyˆß áÁ!ˆ)ʈo„ V„à „Ãß áÁ!ˆ)‚óVƒÖß åÁ!ˆ)‚óƒæß áÁ!ˆ)‚ó „óß åÁ!ˆ)ƒß åÁ!ˆ)m„ n„ Áuˆæç ß#èP!ˆéÊʉß%ˆÊ.‡" [outline-back-to-current-heading 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction 0 relative-depth depth looking-at "^$" nil before opening-on-blank opening-numbered ref-depth outline-ascend-to-depth outline-numbered-bullet outline-descend-to-depth outline-numbered-type-prefix ref-topic dbl-space doing-beginning -1 "^\\s-*$" outline-end-of-current-subtree outline-pre-next-preface outline-goto-prefix re-search-backward outline-line-boundary-regexp outline-bob-regexp 2 t outline-override-protect open-line 13 "[^ \n]" re-search-forward newline insert-string outline-make-topic-prefix " " outline-rebullet-heading] 6 (#$ . 62588)]) #@157 Open new topic header at deeper level than the current one. Negative universal arg means to open deeper, but place the new topic prior to the current one. (defalias 'outline-open-subtopic #[(arg) "ÀÁ V\"‡" [outline-open-topic 1 0 arg] 4 (#$ . 65050) "p"]) #@136 Open new topic header at same level as the current one. Negative universal arg means to place the new topic prior to the current one. (defalias 'outline-open-sibtopic #[(arg) "ÀÁ‰\nV\"‡" [outline-open-topic 0 arg] 4 (#$ . 65315) "p"]) #@163 Open new topic header at shallower level than the current one. Negative universal arg means to open shallower, but place the new topic prior to the current one. (defalias 'outline-open-supertopic #[(arg) "ÀÁ V\"‡" [outline-open-topic -1 0 arg] 4 (#$ . 65558) "p"]) #@65 Name of modal fill function being wrapped by outline-auto-fill. (defvar outline-former-auto-filler nil (#$ . 65831)) #@119 Outline-mode autofill function. Maintains outline hanging topic indentation if `outline-use-hanging-indents' is set. (defalias 'outline-auto-fill #[nil "…ŠÁyˆÂ !…ÄÅ ˆiÆ\")„!…#É )‡" [outline-use-hanging-indents 0 looking-at outline-regexp make-string outline-end-of-prefix 32 fill-prefix outline-former-auto-filler do-auto-fill] 3 (#$ . 65955)]) #@207 Reindent body lines which were indented at old-depth to new-depth. Optional arg NUMBER indicates numbering is being added, and it must be accomodated. Note that refill of indented paragraphs is not done. (defalias 'outline-reindent-body #[(old-depth new-depth &optional number) "ŠÀ ˆi Z\\ Ê Ì  ÎŽÏÐÂÊ#…Rєѕ‰…RÒ!?…RÔi Z‰V„!\f |ˆ \\jˆ‚!.\n‡" [outline-end-of-prefix new-margin nil excess old-indent-begin old-indent-end curr-ind old-depth new-depth old-margin t outline-override-protect match-data match-data ((store-match-data match-data)) re-search-forward "[\n ]\\(\\s-*\\)" 1 looking-at outline-regexp 0] 4 (#$ . 66320)]) #@152 Like non-interactive version 'outline-rebullet-heading'. But (only) affects visible heading containing point. With repeat count, solicit for bullet. (defalias 'outline-rebullet-current-heading #[(arg) "ŠÀ ˆÁ ˆÂ ?ĉ‰Å%)‡" [outline-back-to-current-heading outline-end-of-prefix outline-rebullet-heading arg nil t] 6 (#$ . 66982) "P"]) #@1268 Adjust bullet of current topic prefix. All args are optional. If SOLICIT is non-nil then the choice of bullet is solicited from user. Otherwise the distinctiveness of the bullet or the topic depth determines it. Second arg DEPTH forces the topic prefix to that depth, regardless of the topics current depth. Third arg NUMBER-CONTROL can force the prefix to or away from numbered form. It has effect only if 'outline-numbered-bullet' is non-nil and soliciting was not explicitly invoked (via first arg). Its effect, numbering or denumbering, then depends on the setting of the forth arg, INDEX. If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the prefix of the topic is forced to be non-numbered. Null index and non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil INDEX is a number, then that number is used for the numbered prefix. Non-nil and non-number means that the index for the numbered prefix will be derived by outline-make-topic-prefix. Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding siblings. Cf vars 'outline-stylish-prefixes', 'outline-old-style-prefixes', and 'outline-numbered-bullet', which all affect the behavior of this function. (defalias 'outline-rebullet-heading #[(&optional solicit new-depth number-control index do-successors) "ŠÀ ƒÁ\n Z\fZ]‚``Å)† \n‰ ÁZ {\nË\nÌ &UƒX\n‰GSÌO˜ƒXÑ‚ØÑ |ˆ)bˆƒƒ\n˜ƒƒÔÕ!ƒƒÑŔŕ|ˆ)ÑÖ!ˆ)ƒ U„ Ø\"ˆ…ØŠÚÌ\"…קƒºT‚Â?…ÂÛ Ü ƒ¦ÝÌÌ%ˆ‚¦).‡" [outline-goto-prefix 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction 0 current-depth new-depth mb me current-bullet outline-make-topic-prefix nil solicit number-control index new-prefix t outline-override-protect outline-numbered-bullet looking-at "[0-9]+" insert-string outline-reindent-bodies outline-reindent-body do-successors outline-next-sibling outline-sibling-index outline-numbered-type-prefix outline-rebullet-heading] 8 (#$ . 67325)]) #@190 Like outline-rebullet-topic-grunt, but start from topic visible at point. Descends into invisible as well as visible topics, however. With repeat count, shift topic depth by that amount. (defalias 'outline-rebullet-topic #[(arg) "ilŠ\n„Â\n<ƒ\n@\nÃU„ ÄÅ!ˆÆ ˆÇ Z\nZ]\n\\ÃXƒ8ËÌ!ˆÍ\n!ˆ\nÃU„FÄÎ!ˆ)Ïà \n\\]!*‡" [was-eol start-col arg 0 message "Shifting..." outline-back-to-current-heading 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction error "Attempt to shift topic below level 1" outline-rebullet-topic-grunt "Shifting... done." move-to-column] 4 (#$ . 69418) "P"]) #@379 Rebullet the topic at point, visible or invisible, and all contained subtopics. See outline-rebullet-heading for rebulleting behavior. All arguments are optional. First arg RELATIVE-DEPTH means to shift the depth of the entire topic that amount. The rest of the args are for internal recursive use by the function itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX. (defalias 'outline-rebullet-topic-grunt #[(&optional relative-depth starting-depth starting-point index do-successors) "†ÁŠÂ ƒÃ\f ZZ]‚``Á)†& ?\n †@ÁU„>\n?…@Ì  ÁW  †M` \nƒf ƒfÁ\\VƒfÎÏ!ˆUƒºÐÑ\\Ñ Ñ%ˆÁ ÒÑÁ#ƒ•Ô•†Œ\fÔ”†“ bm„ÌÃ\f ZZ]WƒÌ T ÕT  $ˆ‚•WƒÌÕ  $ˆ\n…„úÁU„Ã\f ZZ]U„úÃ\f ZZ]\\UƒÐщ‰‰×%ˆ bˆÁU?…Ðщ‰‰×%.‡" [relative-depth 0 outline-goto-prefix 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction new-depth starting-depth starting-point on-starting-call index outline-sibling-index moving-outwards error "Attempt to shift topic out beyond level 1." outline-rebullet-heading nil re-search-forward outline-line-boundary-regexp 2 outline-rebullet-topic-grunt do-successors t] 6 (#$ . 70047)]) #@134 Renumber siblings at current depth. Affects superior topics if optional arg DEPTH is less than current depth. Returns final depth. (defalias 'outline-renumber-to-depth #[(&optional depth) "ŠÀ ƒÁ\n Z\fZ]‚``Å)m„˜ŠÀ ƒ,Á\n Z\fZ]‚1``Å)ƒ˜Á\n Z\fZ]Yƒ˜Yƒ˜m„vÁ\n Z\fZ]VƒvÈ ÊÅ#ƒJË•†j\nË”†q b‚JÁ\n Z\fZ]SÁ\n Z\fZ]YƒÌʉ‰‰Í%ˆ‚)Á\n Z\fZ]‡" [outline-goto-prefix 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction 0 ascender depth re-search-forward outline-line-boundary-regexp nil 2 outline-rebullet-heading t] 6 (#$ . 71263)]) #@259 Assign numbered topic prefix to this topic and its siblings. With universal argument, denumber - assign default bullet to this topic and its siblings. With repeated universal argument (`^U^U'), solicit bullet for each rebulleting each topic at this level. (defalias 'outline-number-siblings #[(&optional denumber) "ŠÀ ˆÁ ˆÂ \fZ Z]?…ÂÇšÈ \n \f …HÍ\n\fÈ Î%ˆ ƒ< T Ï\fÎ\"‰ „'Î-‡" [outline-back-to-current-heading outline-beginning-of-level 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction denumber (16) t more use-bullet index depth outline-rebullet-heading nil outline-next-sibling] 7 (#$ . 71862) "P"]) #@71 Increase depth of current heading and any topics collapsed within it. (defalias 'outline-shift-in #[(arg) "À !‡" [outline-rebullet-topic arg] 2 (#$ . 72531) "p"]) #@71 Decrease depth of current heading and any topics collapsed within it. (defalias 'outline-shift-out #[(arg) "À [!‡" [outline-rebullet-topic arg] 2 (#$ . 72700) "p"]) #@66 Kill line, adjusting subsequent lines suitably for outline mode. (defalias 'outline-kill-line #[(&optional arg) "ƒ ƒnƒ !„Ä !‡ŠÆ ƒ)Ç Z\nZ]‚0`` Ë)\fÄ !ˆÍË!ˆŠÂ !„^ÎÐË#ƒ^Ñ•†RÑ”†[ b Ò\f!*‡" [outline-mode outline-numbered-bullet looking-at outline-regexp kill-line arg outline-goto-prefix 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction 0 depth sit-for re-search-forward outline-line-boundary-regexp nil 2 outline-renumber-to-depth] 4 (#$ . 72871) "*P"]) #@99 Kill topic together with subtopics. Leaves primary topic's trailing vertical whitespace, if any. (defalias 'outline-kill-topic #[nil "À ÁyˆÃ\f ZZ]È ˆm„LÉÊ!ƒIŠË\fÍÁ#…EΕ†-\fΔ†4 b‰…EÃ\f ZZ]Y)ƒLÃuˆÏ\n`\"ˆÐÁ!ˆŠÑ!+‡" [outline-back-to-current-heading 0 beg 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction depth outline-end-of-current-subtree looking-at "^$" re-search-forward outline-line-boundary-regexp nil 2 kill-region sit-for outline-renumber-to-depth] 4 (#$ . 73398) nil]) #@721 Incidental outline-specific business to be done just after text yanks. Does depth adjustment of yanked topics, when: 1 the stuff being yanked starts with a valid outline header prefix, and 2 it is being yanked at the end of a line which consists of only a valid topic prefix. Also, adjusts numbering of subsequent siblings when appropropriate. Depth adjustment alters the depth of all the topics being yanked the amount it takes to make the first topic have the depth of the header into which it's being yanked. The point is left in front of yanked, adjusted topics, rather than at the end (and vice-versa with the mark). Non-adjusted yanks, however, are left exactly like normal, non-outline-specific yanks. (defalias 'outline-yank-processing #[(&optional arg) "À `Wƒ\nÁ ˆ`À Ä …'ÅÆÈQ!…'É•\nÉ”‰ ‰\f†5n…5Å! \fƒhÉ•\nZÉ\n ZZ]\nS\n{Š b…“l…“\nb…“Å!…“Òyˆ`\nU?…“Å!…“Ò•\nÒ”‰ …“É\n ZZ])ÔÖ ƒcÙÚ!ˆÛÒ!ˆŒ\n }ˆdbˆÅÜ!ƒÃÖÞß!ˆ)ƒà ˆáŠâ ƒßÉ\n ZZ]‚æ`\n` Ò)S!„ËŠãZ!ˆŠâ „`\n` *o?‰ƒÃ~ˆßuˆ\n`}ˆ‚Ã)Ùä!ˆåæ!'\"ƒ<Òyˆ`\n|ˆÀ Ô“ˆ\nbˆè ˆ‚f``Z\\\\|ˆÅé!ƒVÞÉ!ˆ‚IÅê!ƒfÞÉ!ˆ‚fÁ ˆ. ƒ¥ŠÙë!ˆÛÒ!ˆ\nbˆâ ƒ ìÔŠâ ƒ“É\n ZZ]‚š`\n` Ò)Ô‰Ö%ˆÙä!ˆ)\f?…­Á ,‡" [mark-marker exchange-point-and-mark subj-beg subj-end outline-e-o-prefix-p looking-at "\\(" outline-regexp "\\)" 1 outline-recent-prefix-end outline-recent-prefix-beginning resituate rectify-numbering prefix-len outline-header-subtraction subj-depth prefix-bullet 0 adjust-to-depth nil done t more outline-numbered-bullet message "... yanking" sit-for "^$" outline-override-protect delete-char -1 outline-back-to-current-heading outline-ascend-to-depth outline-goto-prefix outline-rebullet-topic-grunt "" string-match regexp-quote outline-distinctive-bullets-string outline-end-of-prefix "[0-9]" " " "... reconciling numbers" outline-rebullet-heading] 7 (#$ . 73940) "*P"]) #@1100 Outline-mode yank, with depth and numbering adjustment of yanked topics. Non-topic yanks work no differntly than normal yanks. If a topic is being yanked into a bare topic prefix, the depth of the yanked topic is adjusted to the depth of the topic prefix. 1 we're yanking in an outline-mode buffer 2 the stuff being yanked starts with a valid outline header prefix, and 3 it is being yanked at the end of a line which consists of only a valid topic prefix. If these conditions hold then the depth of the yanked topics are all adjusted the amount it takes to make the first one at the depth of the header into which it's being yanked. The point is left in front of yanked, adjusted topics, rather than at the end (and vice-versa with the mark). Non-adjusted yanks, however, (ones that don't qualify for adjustment) are handled exactly like normal yanks. Numbering of yanked topics, and the succesive siblings at the depth into which they're being yanked, is adjusted. Outline-yank-pop works with outline-yank just like normal yank-pop works with normal yank in non-outline buffers. (defalias 'outline-yank #[(&optional arg) "ÀÀ\n!ˆ …\fÄ ‡" [yank this-command arg outline-mode outline-yank-processing] 2 (#$ . 75856) "*P"]) #@236 Yank-pop like outline-yank when popping to bare outline prefixes. Adapts level of popped topics to level of fresh prefix. Note - prefix changes to distinctive bullets will stick, if followed by pops to non-distinctive yanks. Bug... (defalias 'outline-yank-pop #[(&optional arg) "À !ˆ\f…\fÅ ‡" [yank this-command yank-pop arg outline-mode outline-yank-processing] 2 (#$ . 77105) "*p"]) #@133 Pop to file associated with current heading, if it has an xref bullet. (Works according to setting of `outline-file-xref-bullet'). (defalias 'outline-resolve-xref #[nil "„ÁÂ!‡Ã ˜„ÁÄ\"‡ÅŠÉ ˆ`\nbˆËÌ\nÍ#…4ΔΕ{+ÏHÐU„GÑ!‚[ÒÎÅOÅÍ#‰…ZA@)Ô!„}Õ!ƒuÖ×Ø\"!‚zÁÙ\"ƒ„ÚÛÜ‚‰ÁÝ\")‡" [outline-file-xref-bullet error "outline cross references disabled - no 'outline-file-xref-bullet'" outline-current-bullet "current heading lacks cross-reference bullet '%s'" nil file-name outline-recent-prefix-end text-start outline-pre-next-preface heading-end re-search-forward "\\s-\\(\\S-*\\)" t 1 0 58 expand-file-name reference-registered-file reg-ref file-exists-p file-writable-p y-or-n-p format "%s not there, create one? " "%s not found and can't be created" failure (find-file-other-window file-name) ((error failure)) "%s not found"] 5 (#$ . 77503) nil]) #@204 Hide or show lines from FROM to TO, via emacs selective-display FLAG char. Ie, text following flag C-m (carriage-return) is hidden until the next C-j (newline) char. Returns the endpoint of the region. (defalias 'outline-flag-region '(macro . #[(from to flag) "ÀÁ \fÅÆÈBBÉBBÊBBBBBE‡" [let ((buffer-read-only nil) (outline-override-protect t)) subst-char-in-region from to if = flag (10) (13 10) (t)] 9 (#$ . 78396)])) #@95 Hide or show subtree of currently-visible topic. See `outline-flag-region' for more details. (defalias 'outline-flag-current-subtree #[(flag) "ŠÀ ˆÁÂÅ`Æ ˆ`SÈUƒÉ‚ÈÂ%+‡" [outline-back-to-current-heading nil t outline-override-protect buffer-read-only subst-char-in-region outline-end-of-current-subtree flag 10 13] 6 (#$ . 78826)]) #@559 Produce a list representing exposed topics in current region. This list can then be used by 'outline-process-exposed' to manipulate the subject region. List is composed of elements that may themselves be lists representing exposed components in subtopic. Each component list contains: - a number representing the depth of the topic, - a string representing the header-prefix (ref. 'outline-header-prefix'), - a string representing the bullet character, - and a series of strings, each containing one line of the exposed portion of the topic entry. (defalias 'outline-listify-exposed #[(&optional start end) "ŠÀÀÀÀÀÀÀÀ bˆÊyˆË „$ÌÍ!ˆ„¢m„¢`V„¢ÍZZ]S{ÒÓ!ˆ`ÌÍ!?Êyˆ`bˆÀ`Vƒ“ÔÕŠÀˆ`)Í#ˆhÖUƒ~`S‚`{ B`WƒÍyˆ`‚_×\f E Ÿ\" B‚$ Ÿ. ‡" [nil strings pad result depth bullet beg next done start 0 outline-goto-prefix outline-next-visible-heading 1 end outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction outline-end-of-prefix t search-forward " " 13 append outline-header-prefix] 5 (#$ . 79174) "r"]) #@511 Map function on exposed parts of current topic; results to another buffer. Apply FUNCTION (default 'outline-insert-listified) to exposed portions FROM position TO position (default region, or the entire buffer if no region active) in buffer FROMBUF (default current buffer) to buffer TOBUF (default is buffer named like frombuf but with "*" prepended and " exposed*" appended). The function must as its arguments the elements of the list representations of topic entries produced by outline-listify-exposed. (defalias 'outline-process-exposed #[(&optional func from to frombuf tobuf) "„Á\nƒ „\fƒÅ Æ ‚edƒHÈ!„KÉ!‰\n„@ËÌÍQ!ˆ‚D\n)‚Kpƒ`È!„iÏ!‚iÐÑ!ÒQqˆÓ\n \"×qˆƒ¦@AÙ@A@AA@AAAF\"ˆ‚~Ú!+‡" [func outline-insert-listified from to mark-active region-beginning region-end frombuf bufferp get-buffer got error "outline-process-exposed: source buffer " " not found." tobuf get-buffer-create "*" buffer-name " exposed*" outline-listify-exposed listified outline-header-prefix prefix nil curr apply pop-to-buffer] 7 (#$ . 80266)]) #@354 Like `outline-show-current-entry', reveals entries nested in hidden topics. This is a way to give restricted peek at a concealed locality without the expense of exposing its context, but can leave the outline with aberrant exposure. outline-hide-current-entry-completely or outline-show-offshoot should be used after the peek to rectify the exposure. (defalias 'outline-show-entry #[nil "ŠÀ ˆÁÂÅoƒ`‚`SÆ †`ÇÈÂ%+‡" [outline-goto-prefix nil t outline-override-protect buffer-read-only subst-char-in-region outline-pre-next-preface 13 10] 6 (#$ . 81375) nil]) #@562 If point is visible, show all direct subheadings of this heading. Otherwise, do outline-show-to-offshoot, and then show subheadings. Optional LEVEL specifies how many levels below the current level should be shown, or all levels if t. Default is 1. Optional STRICT means don't resort to -show-to-offshoot, no matter what. This is basically so -show-to-offshoot, which is called by this function, can employ the pure offspring-revealing capabilities of it. Returns point at end of subtree that was opened, if any. (May get a point of non-opened subtree?) (defalias 'outline-show-children #[(&optional level strict) "À\n„#ŠÃÄÀÅ#…gÆU)ƒ#Ç ˆÈ Å\"‰‚ŠŒ`\nË †/Ì! Î  †;Ì\"\nbˆ\nƒ\\hÆUƒ\\ÀÅÒ`Ó ÆÔÅ%ˆ*…€@bˆÀÅÒ`Ó ÆÔÅ%ˆ*A‰„aÀ-)‡" [nil max-pos strict re-search-backward "[\n ]" t 13 outline-show-to-offshoot outline-show-children level start-pt outline-chart-subtree 1 chart outline-chart-to-reveal to-reveal outline-override-protect buffer-read-only subst-char-in-region outline-snug-back 10] 7 (#$ . 81948) "p"]) #@400 This command was misnamed, use `outline-show-children' instead. (The "current" in the name is supposed to imply that it works on the visible topic containing point, while it really works with respect to the most immediate topic, concealed or not. I'll leave this old name around for a bit, but i'll soon activate an annoying message to warn people about the change, and then deprecate this alias. (defalias 'outline-show-current-children #[(&optional level strict) "À \n\"‡" [outline-show-children level strict] 3 (#$ . 83002) "p"]) #@228 Like `outline-hide-current-entry'; hides completely if within hidden region. Specifically intended for aberrant exposure states, like entries that were exposed by outline-show-entry but are within otherwise concealed regions. (defalias 'outline-hide-reconcile #[nil "ŠÀ ˆÁÂÅo„`S‚`Æ ˆgÇUƒ `‚\"`SÈÇÂ%+‡" [outline-goto-prefix nil t outline-override-protect buffer-read-only subst-char-in-region outline-pre-next-preface 13 10] 6 (#$ . 83544) nil]) #@205 Like outline-show-entry, but reveals opens all concealed ancestors, as well. As with outline-hide-current-entry-completely, useful for rectifying aberrant exposure states produced by outline-show-entry. (defalias 'outline-show-to-offshoot #[nil "Š`À `Á\n„hÆUƒ<Çyˆ `‰Uƒ3ÇyˆÈ ˆ bˆÉÊ ˆËÌÍÎ#ˆÏ ˆ\fbˆ‚\n bˆ-ŠÐÑÁÉ#…LgÆU)…RÒ ‡" [outline-goto-prefix nil bag-it last-at orig-pref orig-pt 13 0 outline-show-current-subtree t beep message "%s: %s" "outline-show-to-offshoot: " "Aberrant nesting encountered." outline-show-children re-search-backward "[\n ]" outline-show-entry] 4 (#$ . 84005) nil]) #@48 Hide the body directly following this heading. (defalias 'outline-hide-current-entry #[nil "À ˆŠÁÂÅ`Æ ˆ`ÇÈÂ%+‡" [outline-back-to-current-heading nil t outline-override-protect buffer-read-only subst-char-in-region outline-end-of-current-entry 10 13] 6 (#$ . 84613) nil]) #@73 Show body following current heading, or hide the entry if repeat count. (defalias 'outline-show-current-entry #[(&optional arg) "ƒÁ ‡ŠÂÃÆ`Ç ˆ`ÈÉÃ%+‡" [arg outline-hide-current-entry nil t outline-override-protect buffer-read-only subst-char-in-region outline-end-of-current-entry 13 10] 6 (#$ . 84892) "P"]) #@214 Like outline-hide-current-entry, but conceal topic completely. Specifically intended for aberrant exposure states, like entries that were exposed by outline-show-entry but are within otherwise concealed regions. (defalias 'outline-hide-current-entry-completely #[nil "ŠÀ ˆÁÂÅo„`S‚`Æ ˆgÇUƒ `‚\"`SÈÇÂ%+‡" [outline-goto-prefix nil t outline-override-protect buffer-read-only subst-char-in-region outline-pre-next-preface 13 10] 6 (#$ . 85212) nil]) #@102 Show everything within the current topic. With a repeat-count, expose this topic and its' siblings. (defalias 'outline-show-current-subtree #[(&optional arg) "ŠŠÀ ƒÁ\n Z\fZ]‚Å)ÅXƒOÆÈÅ#ƒ4É•†'\nÉ”†. b‰„:ÊË!‚`ÌÍ!ˆÈÎÑedÒÓÎ%*‚`„ZÕÓ!‚`Ö ˆ×Ø!)‡" [outline-back-to-current-heading 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction 0 re-search-forward outline-line-boundary-regexp nil 2 error "No topics." message "Above outermost topic - exposing all." t outline-override-protect buffer-read-only subst-char-in-region 13 10 arg outline-flag-current-subtree outline-beginning-of-level outline-expose-topic (* :)] 6 (#$ . 85674) "P"]) #@287 Close the current topic, or containing topic if this one is already closed. If this topic is closed and it's a top level topic, close this topic and its' siblings. If optional arg JUST-CLOSE is non-nil, do not treat the parent or siblings, even if the target topic is already closed. (defalias 'outline-hide-current-subtree #[(&optional just-close) "`ÀˆÁ „ÂÃ!‚Àˆ`ÆÇ!ˆ bˆ\f‰bˆÀˆ`Uƒe„e bƒeÉÊË\"„SÌbˆÍÏ!ˆÐÑ!ˆÏÒP!ˆ)‚eÊZZ]ÌU„eÖ ˆ b*‡" [nil outline-goto-prefix error "No topics found." orig-eol from outline-flag-current-subtree 13 just-close outline-up-current-level 1 t 0 "Top-level topic already closed - closing siblings..." msg message outline-expose-topic (0 :) " Done." outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction outline-hide-current-subtree] 3 (#$ . 86366) nil]) #@61 Show all subheadings of this heading, but not their bodies. (defalias 'outline-show-current-branches #[nil "ÀyˆÁÂ!‡" [0 outline-show-children t] 2 (#$ . 87211) nil]) #@62 Hide the bodies of the current topic and all its' offspring. (defalias 'outline-hide-current-leaves #[nil "À ˆÁ` ˆ`\"‡" [outline-back-to-current-heading outline-hide-region-body outline-end-of-current-subtree] 3 (#$ . 87383) nil]) #@37 Show all of the text in the buffer. (defalias 'outline-show-all #[nil "ÀÁ!ˆÂÃÆedÇÈÃ%ˆ*ÀÉ!‡" [message "Exposing entire buffer..." nil t outline-override-protect buffer-read-only subst-char-in-region 13 10 "Exposing entire buffer... Done."] 6 (#$ . 87621) nil]) #@37 Hide all of buffer except headings. (defalias 'outline-hide-bodies #[nil "Àed\"‡" [outline-hide-region-body] 3 (#$ . 87890) nil]) #@54 Hide all body lines in the region, but not headings. (defalias 'outline-hide-region-body #[(start end) "ŠŒ }ˆebˆm?…2ÂÃÆ`Ç ˆ`ÈÉÃ%ˆ*m„ ÊË!ƒ,Ì‚-Íuˆ‚ *‡" [start end nil t outline-override-protect buffer-read-only subst-char-in-region outline-pre-next-preface 10 13 looking-at "[\n ][\n ]" 2 1] 6 (#$ . 88026)]) #@2449 Apply exposure specs to successive outline topic items. Use the more convenient frontend, `outline-new-exposure', if you don't need evaluation of the arguments, or even better, the `outline-layout' variable-keyed mode-activation/auto-exposure feature of allout outline mode. See the respective documentation strings for more details. Cursor is left at start position. SPEC is either a number or a list. Successive specs on a list are applied to successive sibling topics. A simple spec (either a number, one of a few symbols, or the null list) dictates the exposure for the corresponding topic. Non-null lists recursively designate exposure specs for respective subtopics of the current topic. The ':' repeat spec is used to specify exposure for any number of successive siblings, up to the trailing ones for which there are explicit specs following the ':'. Simple (numeric and null-list) specs are interpreted as follows: Numbers indicate the relative depth to open the corresponding topic. - negative numbers force the topic to be closed before opening to the absolute value of the number, so all siblings are open only to that level. - positive numbers open to the relative depth indicated by the number, but do not force already opened subtopics to be closed. - 0 means to close topic - hide all offspring. : - 'repeat' apply prior element to all siblings at current level, *up to* those siblings that would be covered by specs following the ':' on the list. Ie, apply to all topics at level but the last ones. (Only first of multiple colons at same level is respected - subsequent ones are discarded.) * - completely opens the topic, including bodies. + - shows all the sub headers, but not the bodies - - exposes the body of the corresponding topic. Examples: (outline-expose-topic '(-1 : 0)) Close this and all following topics at current level, exposing only their immediate children, but close down the last topic at this current level completely. (outline-expose-topic '(-1 () : 1 0)) Close current topic so only the immediate subtopics are shown; show the children in the second to last topic, and completely close the last one. (outline-expose-topic '(-2 : -1 *)) Expose children and grandchildren of all topics at current level except the last two; expose children of the second to last and completely open the last one. (defalias 'outline-expose-topic #[(spec) "ŠÁÂÃÄ#…gÅU)…;ŠÁÃÇ#ƒ!ÇuˆŠÁÂÃÄ#…-gÅU)ƒ5`‚7`CÈ ˆ)‰ ‡" [outline-mode re-search-backward "[\n ]" nil t 13 outline-line-boundary-regexp 1 outline-show-entry outline-search-reconceal] 4 (#$ . 97179)]) #@116 Do outline business like deexposing current point, if necessary. Works according to reconceal state registration. (defalias 'outline-isearch-advancing-business #[nil "… …Š <ƒ @bˆÂ ‚ bˆÃ )‡" [outline-mode outline-search-reconceal outline-hide-current-entry outline-hide-current-entry-completely] 1 (#$ . 97938)]) (defalias 'isearch-terminate/outline-provisions #[nil "ƒ ƒ  ˆÃÄÇ *‡" [outline-mode outline-enwrap-isearch-mode outline-isearch-advancing-business t nil outline-search-reconceal outline-search-quitting real-isearch-terminate] 2 nil nil]) (defalias 'isearch-done/outline-provisions #[(&optional nopush) "ƒ` ƒ`\nƒO\n<„OŠÃÄ!ˆÅÆ!ˆÇ ˆo„=ÈuˆhÉ=ƒ:ÊË\f Î`S`ÉÏË%ˆ*ÐuˆÑÐZZ]S!ˆÕ ˆ)Ö×!ƒZ„`Ø ˆÕ ˆƒjÚ!‡Ú ‡" [outline-mode outline-enwrap-isearch-mode outline-search-reconceal message "(exposing destination)" sit-for 0 outline-goto-prefix -1 13 nil t outline-override-protect buffer-read-only subst-char-in-region 10 1 outline-ascend-to-depth outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction outline-show-children boundp outline-search-quitting outline-isearch-arrival-business nopush real-isearch-done] 6 nil nil]) #@159 Wrapper dynamically adjusts isearch target exposure. Appropriately exposes and reconceals hidden outline portions, as necessary, in the course of searching. (defalias 'isearch-update/outline-provisions #[nil "ƒ „  ‡Ã ˆÂ ˆ\fƒÅ ‡\f?…à ‡" [outline-mode outline-enwrap-isearch-mode real-isearch-update outline-isearch-advancing-business isearch-success outline-isearch-arrival-business] 1 (#$ . 99134)]) #@65 Insert contents of listified outline portion in current buffer. (defalias 'outline-insert-listified #[(depth prefix bullet text) "À ÂVƒ ‚\fÄÅ SÆ\"Q!ˆƒ1À@!ˆA‰ƒÀÉ!ˆ‚ÀÉ!‡" [insert-string depth 1 prefix "" make-string 32 bullet text "\n"] 5 (#$ . 99550)]) #@200 Duplicate exposed portions of current topic to another buffer. Other buffer has current buffers' name with " exposed" appended to it. With repeat count, copy the exposed portions of entire buffer. (defalias 'outline-copy-exposed #[(arg &optional tobuf) "„\fÁÂà ÄQ!`ƒe‚Ç ƒ$d‚&É \np ŠqˆÌ ˆ)ÍÎ\np%ˆebˆÏ !ˆ b,‡" [tobuf get-buffer-create "*" buffer-name " exposed*" start-pt arg outline-back-to-current-heading beg outline-end-of-current-subtree end buf erase-buffer outline-process-exposed outline-insert-listified pop-to-buffer] 6 (#$ . 99827) "P"]) #@175 Return copy of STRING for literal reproduction across latex processing. Expresses the original characters (including carriage returns) of the string across latex processing. (defalias 'outline-latex-verb-quote #[(str &optional flow) "ÀÁ\nÃ#‡" [mapconcat #[(char) "Á>ƒ ÂÃ!ÄQ‡ÅUƒƇÇ!‡" [char (92 36 37 35 38 123 125 95 94 45 42) "\\char" number-to-string "{}" 10 "\\\\" char-to-string] 3] str ""] 4 (#$ . 100407)]) #@251 Express line for exact (literal) representation across latex processing. Adjust line contents so it is unaltered (from the original line) across latex processing, within the context of a 'verbatim' environment. Leaves point at the end of the line. (defalias 'outline-latex-verbatim-quote-curr-line #[nil "Àyˆ`Áˆ`‰bˆÄÅ\nÆ#…(À”bˆÇÈ!ˆ\nTÀ•Tbˆ‚ *‡" [0 nil end beg re-search-forward "\\\\" 1 insert-string "\\"] 5 (#$ . 100834)]) #@51 Insert initial latex commands at point in BUFFER. (defalias 'outline-insert-latex-header #[(buf) "qˆÁÂÃ\"\fƒÅ‚ÆÇÈÉÊËÌÍ°ÁÎ\"ÁÐ\"ÁÒ\"ÁÔ\"ÁÖ×ØÚ%ÁÛÜÝÞßà!â&ÁãäÝåæ!â&çÁÖèé*ƒ]ëìí‚^î!Úï%ðñò3456789:;<=>?@‰A@>=<;:9876543°c.‡" [buf format "\n\\documentstyle{%s}\n" "report" outline-number-pages "\\pagestyle{empty}\n" "" "\\def\\beginlines{" "\\par\\begingroup\\nobreak\\medskip" "\\parindent=0pt\n" " \\kern1pt\\nobreak \\obeylines \\obeyspaces " "\\everypar{\\strut}}\n" "\\def\\endlines{" "\\kern1pt\\endgroup\\medbreak\\noindent}\n" "\\newcommand{\\titlecmd}[1]{{%s #1}}\n" outline-title-style "\\newcommand{\\labelcmd}[1]{{%s #1}}\n" outline-label-style "\\newcommand{\\headlinecmd}[1]{{%s #1}}\n" outline-head-line-style "\\newcommand{\\bodylinecmd}[1]{{%s #1}}\n" outline-body-line-style "%s%s%s%s" "\\newlength{\\stepsize}\n" "\\setlength{\\stepsize}{" outline-indent "}\n" "%s%s%s%s%s%s%s" "\\newcommand{\\OneHeadLine}[3]{%\n" "\\noindent%\n" "\\hspace*{#2\\stepsize}%\n" "\\labelcmd{#1}\\hspace*{.2cm}" "\\headlinecmd{#3}\\\\[" outline-line-skip "]\n}\n" "%s%s%s%s%s%s" "\\newcommand{\\OneBodyLine}[2]{%\n" "\\hspace*{#1\\stepsize}%\n" "\\bodylinecmd{#2}\\\\[" "\\begin{document}\n\\begin{center}\n" "\\titlecmd{" outline-latex-verb-quote outline-title err (eval outline-title) ((error "")) "Unnamed Outline" "\\end{center}\n\n" "\\hsize = 7.5 true in\n" "\\hoffset = -1.5 true in\n" "\\vspace{.1cm}\n\n" vspace hoffset hsize title begindoc onebodyline oneheadline setlength bodylinecmd headlinecmd labelcmd titlecmd linesdef page-numbering doc-style] 19 (#$ . 101273)]) #@54 Insert concluding latex commands at point in BUFFER. (defalias 'outline-insert-latex-trailer #[(buf) "qˆÁc‡" [buf "\n\\end{document}\n"] 1 (#$ . 102919)]) #@184 Insert LaTeX commands for formatting one outline item. Args are the topics' numeric DEPTH, the header PREFIX lead string, the BULLET string, and a list of TEXT strings for the body. (defalias 'outline-latexify-one-item #[(depth prefix bullet text) "…@AÃÃÃÇÈÉ\n!Ë\fÍ ƒ%É !‚&ÎÏ°!ˆ\n??…ŒÇÐ!ˆ\nƒv\n@ „IÑÒ\f\"„IÓ ƒdÑÔ\f\"‰ƒd\fÕOÖ\fÃOQÇ\f!ˆ× ˆÇØ!ˆ\nA‰„9 ƒÃ‚‰ÙuˆÇÚ!ˆÛuˆÇÜ!-‡" [text head-line body-lines nil curr-line body-content bop insert-string "\\OneHeadLine{\\verb " outline-latex-verb-quote bullet "}{" depth "}{\\verb " "" "}\n" "\\begin{verbatim}\n" string-match "^\\s-*$" t "\\end{verbatim}" 0 ">" outline-latex-verbatim-quote-curr-line "\n" -1 "\\ " 1 "\\end{verbatim}\n"] 9 (#$ . 103082)]) #@255 Format current topic's exposed portions to TOBUF for latex processing. TOBUF defaults to a buffer named the same as the current buffer, but with "*" prepended and " latex-formed*" appended. With repeat count, copy the exposed portions of entire buffer. (defalias 'outline-latexify-exposed #[(arg &optional tobuf) "„\fÁÂà ÄQ!`ƒe‚Ç ƒ$d‚&É \np qˆÌ ˆÍ!ˆdbˆÎÏ\n %ˆdbˆÐ!ˆebˆÑ !ˆ b,‡" [tobuf get-buffer-create "*" buffer-name " latexified*" start-pt arg outline-back-to-current-heading beg outline-end-of-current-subtree end buf erase-buffer outline-insert-latex-header outline-process-exposed outline-latexify-one-item outline-insert-latex-trailer pop-to-buffer] 6 (#$ . 103825) "P"]) #@57 Put the region around topic currently containing point. (defalias 'outline-mark-topic #[nil "ÀyˆÁ ˆÂ`!ˆÃ ˆÄ ‡" [0 outline-goto-prefix push-mark outline-end-of-current-subtree exchange-point-and-mark] 2 (#$ . 104538) nil]) (defalias (quote outlinify-sticky) (quote outlineify-sticky)) #@171 Activate outline mode and establish file var so it is started subseqently. See doc-string for `outline-layout' and `outline-init' for details on setup for auto-startup. (defalias 'outlineify-sticky #[(&optional arg) "ÀÁ!ˆŠebˆÂ !ƒÁ‚VÄÅ!ˆÆÇÈP!ˆÉÊ!ˆdbˆÉÊ!ˆÄË!ˆÆÌ!ˆÄÊ!ˆÆÍ!ˆÄË!ˆÆÎ!ˆÄË!ˆÆÏІLÒ\"!ˆÄË!ˆÆÓ!)‡" [outline-mode t looking-at outline-regexp outline-open-topic 2 insert-string "Dummy outline topic header - see" "`outline-mode' docstring for info." next-line 1 0 "Local emacs vars.\n" "(`outline-layout' is for allout.el outline-mode)\n" "Local variables:\n" format "outline-layout: %s\n" outline-layout (1 : 0) "End:\n"] 4 (#$ . 104829) "P"]) #@141 Solicit (with first arg PROMPT) choice of a character from string STRING. Optional arg DO-DEFAULTING indicates to accept empty input (CR). (defalias 'solicit-char-in-string #[(prompt string &optional do-defaulting) "Á\n„GÄÅ \"ˆÆÁÈ )!ÉÊ\n! \"„@\fƒ1\n͘ƒ1Ή‚\nÏ ΰÁ‰‚ÄÎ!ˆ‚\n*‡" [prompt nil got new-prompt message "%s" char-to-string cursor-in-echo-area read-char string-match regexp-quote string do-defaulting " " "" " ...pick from: "] 6 (#$ . 105489)]) #@219 Return a copy of REGEXP with all character escapes stripped out. Representations of actual backslashes - '\\\\' - are left as a single backslash. Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion. (defalias 'regexp-sans-escapes #[(regexp &optional successive-backslashes) "Á˜ƒÁ‡ÂHÃU…\fƒ\fT‚ʼnƒ%\fÆUƒ1ÂÅOÇÅÈO!P‡ÇÅÈO\f\"‡" [regexp "" 0 92 successive-backslashes 1 2 regexp-sans-escapes nil] 6 (#$ . 105973)]) (byte-code "ÀÁ!„\nÁÂMˆÀ‡" [fboundp add-hook #[(hook function &optional append) "À !„\n ÂLˆ :ƒÄ A J\" )š‚! J>†7 ƒ2 J C¤‚6 JBL‡" [boundp hook nil function assoc tail append] 3 "Add to the value of HOOK the function FUNCTION unless already present.\n(It becomes the first hook on the list unless optional APPEND is non-nil, in \nwhich case it becomes the last). HOOK should be a symbol, and FUNCTION may be\nany valid function. HOOK's value should be a list of functions, not a single\nfunction. If HOOK is void, it is first set to nil."]] 2) #@48 Isearch (regexp) for topic with bullet BULLET. (defalias 'outline-bullet-isearch #[(&optional bullet) "„ ÁÂÃ\f!\"ÅÆÈR \nËÌ!ˆÍÅ!*‡" [bullet solicit-char-in-string "ISearch for topic with bullet: " regexp-sans-escapes outline-bullets-string t "^" outline-header-prefix "[ ]*" isearch-string isearch-regexp isearch-repeat forward isearch-mode] 5 (#$ . 106980) nil]) emacs-19.30/lisp/ange-ftp.elc100666 12120 1 255651 6053156516 14330 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 17 14:04:38 1995 ;;; from file /home/fsf/rms/e19/lisp/ange-ftp.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`ange-ftp.el' was compiled for Emacs 19.29 or later")) (require (quote comint)) #@283 *Format of a fully expanded remote file name. This is a list of the form (REGEXP HOST USER NAME), where REGEXP is a regular expression matching the full remote name, and HOST, USER, and NAME are the numbers of parenthesized expressions in REGEXP for the components (in that order). (defvar ange-ftp-name-format (quote ("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*\\):\\(.*\\)" 3 2 4)) (#$ . -500)) #@66 *Regular expression matching the start of a multiline ftp reply. (defvar ange-ftp-multi-msgs "^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^331-\\|^4[25]1-\\|^530-" (#$ . -894)) #@54 *Regular expression matching ftp "success" messages. (defvar ange-ftp-good-msgs "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark" (#$ . -1080)) #@64 *Regular expression matching ftp messages that can be ignored. (defvar ange-ftp-skip-msgs (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|" "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|" "^Data connection \\|" "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye") (#$ . -1244)) #@142 *Regular expression matching ftp messages that indicate serious errors. These mean that the FTP process should (or already has) been killed. (defvar ange-ftp-fatal-msgs (concat "^ftp: \\|^Not connected\\|^530 \\|^4[25]1 \\|rcmd: \\|" "^No control connection\\|unknown host\\|^lost connection") (#$ . -1574)) #@73 *Regular expression matching login failure messages from rlogin/telnet. (defvar ange-ftp-gateway-fatal-msgs "No route to host\\|Connection closed\\|No such host\\|Login incorrect" (#$ . -1888)) #@78 *Regular expression used to determine the number of bytes in a FTP transfer. (defvar ange-ftp-xfer-size-msgs "^150 .* connection for .* (\\([0-9]+\\) bytes)" (#$ . -2088)) #@43 *Template used to create temporary files. (defvar ange-ftp-tmp-name-template "/tmp/ange-ftp" (#$ . -2266)) #@311 *Template used to create temporary files when ftp-ing through a gateway. Files starting with this prefix need to be accessible from BOTH the local machine and the gateway machine, and need to have the SAME name on both machines, that is, /tmp is probably NOT what you want, since that is rarely cross-mounted. (defvar ange-ftp-gateway-tmp-name-template "/tmp/ange-ftp" (#$ . -2380)) #@49 *File in .netrc format to search for passwords. (defvar ange-ftp-netrc-filename "~/.netrc" (#$ . -2769)) #@60 *If non-nil avoid checking permissions on the .netrc file. (defvar ange-ftp-disable-netrc-security-check nil (#$ . -2880)) #@185 *User name to use when none is specied in a file name. If nil, then the name under which the user is logged in is used. If non-nil but not a string, the user is prompted for the name. (defvar ange-ftp-default-user nil (#$ . -3010)) #@70 *Password to use when the user is the same as ange-ftp-default-user. (defvar ange-ftp-default-password nil (#$ . -3248)) #@78 *Account password to use when the user is the same as ange-ftp-default-user. (defvar ange-ftp-default-account nil (#$ . -3375)) #@163 *If t, use value of `user-mail-address' as password for anonymous ftp. If a string, then use that string as the password. If nil, prompt the user for a password. (defvar ange-ftp-generate-anonymous-password t (#$ . -3510)) #@76 *If non-nil, regexp matching hosts on which `dir' command lists directory. (defvar ange-ftp-dumb-unix-host-regexp nil (#$ . -3739)) #@71 *If a file matches this regexp then it is transferred in binary mode. (defvar ange-ftp-binary-file-name-regexp (concat "\\.[zZ]$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|" "\\.dvi$\\|\\.ps$\\|\\.elc$\\|TAGS$\\|\\.gif$\\|" "\\.EXE\\(;[0-9]+\\)?$\\|\\.[zZ]-part-..$\\|\\.gz$\\|" "\\.taz$\\|\\.tgz$") (#$ . -3877)) #@72 *Name of host to use as gateway machine when local FTP isn't possible. (defvar ange-ftp-gateway-host nil (#$ . -4206)) #@200 *Regexp selecting hosts which can be reached directly with ftp. For other hosts the FTP process is started on `ange-ftp-gateway-host' instead, and/or reached via `ange-ftp-gateway-ftp-program-name'. (defvar ange-ftp-local-host-regexp ".*" (#$ . -4332)) #@114 *If non-nil then the gateway program should give a shell prompt. Both telnet and rlogin do something like this. (defvar ange-ftp-gateway-program-interactive nil (#$ . -4592)) #@166 *Name of program to spawn a shell on the gateway machine. Valid candidates are rsh (remsh on some systems), telnet and rlogin. See also the gateway variable above. (defvar ange-ftp-gateway-program remote-shell-program (#$ . -4775)) #@325 *Regexp matching prompt after complete login sequence on gateway machine. A match for this means the shell is now awaiting input. Make this regexp as strict as possible; it shouldn't match *anything* at all except the user's initial prompt. The above string will fail under most SUN-3's since it matches the login banner. (defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;\n]*[#$%>;] *" (#$ . -5015)) #@173 *Set up terminal after logging in to the gateway machine. This command should stop the terminal from echoing each command, and arrange to strip out trailing ^M characters. (defvar ange-ftp-gateway-setup-term-command (byte-code "Á=ƒ‡Ç" [system-type hpux "stty -onlcr -echo\n" "stty -echo nl\n"] 2) (#$ . -5424)) #@231 *Non-nil means the ftp gateway and/or the gateway ftp program is smart. Don't bother telnetting, etc., already connected to desired host transparently, or just issue a user@host command in case `ange-ftp-gateway-host' is non-nil. (defvar ange-ftp-smart-gateway nil (#$ . -5747)) #@69 *Port on gateway machine to use when smart gateway is in operation. (defvar ange-ftp-smart-gateway-port "21" (#$ . -6032)) #@55 *If non-nil, send the HASH command to the FTP client. (defvar ange-ftp-send-hash t (#$ . -6161)) #@261 *Default size, in bytes, between hash-marks when transferring a binary file. If NIL, this variable will be locally overridden if the FTP client outputs a suitable response to the HASH command. If non-NIL then this value takes precedence over the local value. (defvar ange-ftp-binary-hash-mark-size nil (#$ . -6265)) #@206 *Default size, in bytes, between hash-marks when transferring an ASCII file. This variable is buffer-local and will be locally overridden if the FTP client outputs a suitable response to the HASH command. (defvar ange-ftp-ascii-hash-mark-size 1024 (#$ . -6589)) #@68 *If non-NIL then be chatty about interaction with the FTP process. (defvar ange-ftp-process-verbose t (#$ . -6857)) #@30 *Name of FTP program to run. (defvar ange-ftp-ftp-program-name "ftp" (#$ . -6979)) #@120 *Name of FTP program to run when accessing non-local hosts. Some AT&T folks claim to use something called `pftp' here. (defvar ange-ftp-gateway-ftp-program-name "ftp" (#$ . -7069)) #@62 *A list of arguments passed to the FTP program when started. (defvar ange-ftp-ftp-program-args (quote ("-i" "-n" "-g" "-v")) (#$ . -7256)) #@52 *If non-NIL then a string naming nslookup program. (defvar ange-ftp-nslookup-program nil (#$ . -7401)) #@60 *Non-nil means make backup files for "magic" remote files. (defvar ange-ftp-make-backup-files nil (#$ . -7510)) #@135 *Number of seconds to wait before retry if file or listing doesn't arrive. This might need to be increased for very slow connections. (defvar ange-ftp-retry-time 5 (#$ . -7629)) #@122 If 1, allows ange-ftp files to be auto-saved. If 0, suppresses auto-saving of ange-ftp files. Don't use any other value. (defvar ange-ftp-auto-save 0 (#$ . 7814)) (require (quote backquote)) #@95 Make an obarray suitable for use as a hashtable. SIZE, if supplied, should be a prime number. (defalias 'ange-ftp-make-hashtable #[(&optional size) "À †ÂÃ\"‡" [make-vector size 31 0] 3 (#$ . 8011)]) #@51 Call FUNCTION on each key and value in HASHTABLE. (defalias 'ange-ftp-map-hashtable #[(fun tbl) "ÀÁ\n\"‡" [mapatoms #[(sym) " ÂN ÃN\"‡" [fun sym key val] 4] tbl] 3 (#$ . 8218)]) #@50 Convert KEY into a suitable key for a hashtable. (defalias 'ange-ftp-make-hash-key '(macro . #[(key) "ÀÁ\nD\nÃ\nDF‡" [if stringp key prin1-to-string] 5 (#$ . 8403)])) #@52 Return the value associated with KEY in HASHTABLE. (defalias 'ange-ftp-get-hash-entry #[(key tbl) "À ;ƒ\n ‚  ! \"‰…\fÅN)‡" [intern-soft key prin1-to-string tbl sym val] 4 (#$ . 8576)]) #@59 Record an association between KEY and VALUE in HASHTABLE. (defalias 'ange-ftp-put-hash-entry #[(key val tbl) "À ;ƒ\n ‚  ! \"Å\fÆ#ˆÅ\fÁ #)‡" [intern key prin1-to-string tbl sym put val] 4 (#$ . 8773)]) #@73 Copy all symbols except KEY in HASHTABLE and return modified hashtable. (defalias 'ange-ftp-del-hash-entry #[(key tbl) "G ! SÅÆ\"ˆ\fÇYƒ#\f \fHIˆ\fS‰‚+‡" [tbl len ange-ftp-make-hashtable new-tbl i ange-ftp-map-hashtable #[(k v) " š†  \f#‡" [k key ange-ftp-put-hash-entry v new-tbl] 4] 0] 5 (#$ . 8986)]) #@58 Return whether there is an association for KEY in TABLE. (defalias 'ange-ftp-hash-entry-exists-p #[(key tbl) "À ;ƒ\n ‚  ! \"‡" [intern-soft key prin1-to-string tbl] 3 (#$ . 9311)]) #@67 Return a sorted list of all the active keys in TABLE, as strings. (defalias 'ange-ftp-hash-table-keys #[(tbl) "ÀÁ \"Ä\"‡" [sort all-completions "" tbl string-lessp] 4 (#$ . 9501)]) #@71 Buffer name to hold directory listing data received from ftp process. (defvar ange-ftp-data-buffer-name " *ftp data*" (#$ . 9689)) #@60 Last modified time of the netrc file from file-attributes. (defvar ange-ftp-netrc-modtime nil (#$ . 9826)) #@59 Hash table holding associations between HOST, USER pairs. (defvar ange-ftp-user-hashtable (ange-ftp-make-hashtable) (#$ . 9939)) #@60 Mapping between a HOST, USER pair and a PASSWORD for them. (defvar ange-ftp-passwd-hashtable (ange-ftp-make-hashtable) (#$ . 10074)) #@68 Mapping between a HOST, USER pair and a ACCOUNT password for them. (defvar ange-ftp-account-hashtable (ange-ftp-make-hashtable) (#$ . 10213)) #@64 Hash table for storing directories and their respective files. (defvar ange-ftp-files-hashtable (ange-ftp-make-hashtable 97) (#$ . 10361)) #@39 Last set of args used by ange-ftp-ls. (defvar ange-ftp-ls-cache-lsargs nil (#$ . 10506)) #@34 Last file passed to ange-ftp-ls. (defvar ange-ftp-ls-cache-file nil (#$ . 10601)) #@40 Last result returned from ange-ftp-ls. (defvar ange-ftp-ls-cache-res nil (#$ . 10689)) (byte-code "À Á\nBÃÄ\nBÅÆ!„ÇÆ\nBÅÈ!„#ÇÈ\nBÅÉ!„0Ç É\nBÅÊ!„=Ç\nÊ\nBÅË!„JÇ Ë\nBÅÌ!„WÇ\fÌ\nBÅÍ!„dÇ Í\nBÅÎ!„qÇÎ\nBÅÏ!„~ÇÏ\nBÅÐ!„‹ÇÐ\nBÅÑ!„˜ÇÑ\nBÒ\nBÓ\nBÔ\nBÕ\nBÖ\nB×\nBØ\nBÙÚÛÜ#‡" [ange-ftp-make-hashtable ange-ftp-expand-dir-hashtable current-load-list "^5.0 \\([^: ]+\\):" ange-ftp-expand-dir-regexp boundp ange-ftp-hash-mark-unit nil ange-ftp-hash-mark-count ange-ftp-xfer-size ange-ftp-process-string ange-ftp-process-result-line ange-ftp-process-busy ange-ftp-process-result ange-ftp-process-multi-skip ange-ftp-process-msg ange-ftp-process-continue ange-ftp-last-percent ange-ftp-this-file ange-ftp-this-dir ange-ftp-this-user ange-ftp-this-host ange-ftp-this-msg ange-ftp-completion-ignored-pattern ange-ftp-trample-marker put ftp-error error-conditions (ftp-error file-error error)] 4) #@133 Display message in echo area, but indicate if truncated. Args are as in `message': a format string, plus arguments to be formatted. (defalias 'ange-ftp-message #[(fmt &rest args) "ÀÁ\n #ÄÅ !ƒ‚1GYƒ,ÉÊZËOPÌÍ\"*‡" [apply format fmt args window-width minibuffer-window max msg noninteractive "> " 3 nil message "%s"] 4 (#$ . 11622)]) #@180 Abbreviate the file name FILE relative to the default-directory. If the optional parameter NEW is given and the non-directory parts match, only return the directory part of FILE. (defalias 'ange-ftp-abbreviate-filename #[(file &optional new) "À ÂŽ ƒÄÅÆ !ÇQ\"ƒÉ•SÊO ƒ6Ì!Ì !˜ƒ6Í!†<Î*‡" [match-data match-data ((store-match-data match-data)) default-directory string-match "^" regexp-quote "." file 0 nil new file-name-nondirectory file-name-directory "./"] 4 (#$ . 11983)]) #@51 For a given HOST, set or change the default USER. (defalias 'ange-ftp-set-user #[(host user) "À \n #‡" [ange-ftp-put-hash-entry host user ange-ftp-user-hashtable] 4 (#$ . 12485) "sHost: \nsUser: "]) #@40 Given a HOST, return the default USER. (defalias 'ange-ftp-get-user #[(host) "À ˆÁ\n \"‰†1 ;ƒ ‚* ƒ(ÆÈÉÊ\n\"Ë \")‚*Ë ‰Ì\n\f\"ˆ)‡" [ange-ftp-parse-netrc ange-ftp-get-hash-entry host ange-ftp-user-hashtable user ange-ftp-default-user t enable-recursive-minibuffers read-string format "User for %s: " user-login-name ange-ftp-set-user] 5 (#$ . 12690)]) #@166 Read a password, echoing `.' for each character typed. End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. Optional DEFAULT is password to start with. (defalias 'ange-ftp-read-passwd #[(prompt &optional default) "ƒ‚ Á‰ÃÈÉ\nËGÌ\"#ˆÍ ‰ÎU„oÏU„oÐU„oÑUƒCÁ‚ÒU„]ÓU„]Ô!P‚GÂVƒÂÕO‚ÈÁ!ˆÖ ˆ,‡" [default "" 0 t cursor-in-echo-area echo-keystrokes c pass message "%s%s" prompt make-string 46 read-char 13 10 27 21 8 127 char-to-string -1 ange-ftp-repaint-minibuffer] 7 (#$ . 13056)]) (defalias 'ange-ftp-generate-passwd-key '(macro . #[(host user) "À  F‡" [concat host "/" user] 4])) (defalias 'ange-ftp-lookup-passwd '(macro . #[(host user) "ÀÁ\n EÄBB‡" [ange-ftp-get-hash-entry ange-ftp-generate-passwd-key host user (ange-ftp-passwd-hashtable)] 4])) #@67 For a given HOST and USER, set or change the associated PASSWORD. (defalias 'ange-ftp-set-passwd #[(host user passwd) "À  Q\f #‡" [ange-ftp-put-hash-entry host "/" user passwd ange-ftp-passwd-hashtable] 4 (#$ . 13873) (list (read-string "Host: ") (read-string "User: ") (ange-ftp-read-passwd "Password: "))]) #@55 Given a USER, return a host we know the password for. (defalias 'ange-ftp-get-host-with-passwd #[(user) "À ˆÁ‡" [ange-ftp-parse-netrc found-one (byte-code "ÀÁ\n\"ˆÃ ÅŽÀÆ\"ˆ*ȇ" [ange-ftp-map-hashtable #[(host val) "À  Q\f\"…ÅÆ \"‡" [ange-ftp-get-hash-entry host "/" user ange-ftp-passwd-hashtable throw found-one] 4] ange-ftp-user-hashtable match-data match-data ((store-match-data match-data)) #[(key value) "ÀÁ\n\"…\"\nÃÄ”O\nÄ•ÇO˜…!…!ÉÊ \")‡" [string-match "^[^/]*\\(/\\).*$" key 0 1 host user nil value throw found-one] 4] ange-ftp-passwd-hashtable nil] 3)] 2 (#$ . 14189)]) #@76 Return the password for specified HOST and USER, asking user if necessary. (defalias 'ange-ftp-get-passwd #[(host user) "À ˆÁ\nÃ\fQ \"†p;ƒ\"ƒ\"\f˜ƒ\"‡\fȘ„.\fɘƒ?\nƒ?\n;ƒ<\n‡ ‡Ì\f!‰ ƒ]ÎÏÐ\f\n\f %Á Ã\fQ \"\"‚dÎÏÑ\f\n#!Ó\n\f#ˆ*‡" [ange-ftp-parse-netrc ange-ftp-get-hash-entry host "/" user ange-ftp-passwd-hashtable ange-ftp-default-user ange-ftp-default-password "anonymous" "ftp" ange-ftp-generate-anonymous-password user-mail-address ange-ftp-get-host-with-passwd other ange-ftp-read-passwd format "passwd for %s@%s (same as %s@%s): " "Password for %s@%s: " passwd ange-ftp-set-passwd] 8 (#$ . 14789)]) #@75 For a given HOST and USER, set or change the associated ACCOUNT password. (defalias 'ange-ftp-set-account #[(host user account) "À  Q\f #‡" [ange-ftp-put-hash-entry host "/" user account ange-ftp-account-hashtable] 4 (#$ . 15430) (list (read-string "Host: ") (read-string "User: ") (ange-ftp-read-passwd "Account password: "))]) #@48 Given a HOST and USER, return the FTP account. (defalias 'ange-ftp-get-account #[(host user) "À ˆÁ\nÃ\fQ \"†;…\f˜…‡" [ange-ftp-parse-netrc ange-ftp-get-hash-entry host "/" user ange-ftp-account-hashtable ange-ftp-default-user ange-ftp-default-account] 4 (#$ . 15766)]) #@73 Return the filename that FILE references, following all symbolic links. (defalias 'ange-ftp-chase-symlinks #[(file) "À !‰ƒÄ !ƒ ‚Å ! P‚) ‡" [nil temp ange-ftp-real-file-symlink-p file file-name-absolute-p file-name-directory] 2 (#$ . 16053)]) (defalias 'ange-ftp-parse-netrc-token #[(token limit) "À \nÃ#…1ÄÆ\nwˆgÇ=ƒ'Èuˆ`É\nwˆÈuˆ `S{‚0`Ê\nwˆ `{)‡" [search-forward token limit t nil beg ", \n" 34 1 "^\"" "^, \n"] 4]) (defalias 'ange-ftp-parse-netrc-group #[nil "`ŠÀÁ!ƒÂÃwˆÄÃwˆÂÃwˆ‚ÂÃwˆÅÆÃÇ#ƒ(È”‚)d)ɉ‰ \n \f ÏÐ \"\fÏÑ \" ÏÒ \"\nÏÓ \" \fƒ ƒÔ\f \"ˆÕ\f \n#ˆ ƒ¾Ö\f  #ˆ‚¾bˆ×Ø Ç#ƒ¾ÏÑ \" ÏÒ \"\nÏÓ \"  ƒ¬ \nƒµ\n ƒ¾  b.‡" [looking-at "machine\\>" "^ \n" nil " \n" re-search-forward "machine\\>\\|default\\>" t 0 account password login machine end start ange-ftp-parse-netrc-token "machine" "login" "password" "account" ange-ftp-set-user ange-ftp-set-passwd ange-ftp-set-account search-forward "default" ange-ftp-default-user ange-ftp-default-password ange-ftp-default-account] 6]) (defalias 'ange-ftp-parse-netrc #[nil "À‰ÃÅÆ!!È\n!) ……É 8\nš?……Ë \fÍŽ„=Ï 8Ð =ƒtÑÒÓ 8\"ƒtŠÔÕ!qˆÖ\n!ˆ\nØ\n!ÙÚ!ˆÛÜ\"ˆÀebˆÞÀwˆm„lß ˆ‚bàp!ˆ)‚~áâ\"ˆãä!ˆÉ 8‰\n**‡" [nil attr file "/" default-directory ange-ftp-chase-symlinks ange-ftp-real-expand-file-name ange-ftp-netrc-filename ange-ftp-real-file-attributes 5 ange-ftp-netrc-modtime match-data match-data ((store-match-data match-data)) ange-ftp-disable-netrc-security-check 2 user-uid string-match ".r..------" 8 generate-new-buffer "*ftp-.netrc*" ange-ftp-real-insert-file-contents buffer-file-name file-name-directory normal-mode t mapcar funcall find-file-hooks " \n" ange-ftp-parse-netrc-group kill-buffer ange-ftp-message "%s either not owned by you or badly protected." sit-for 1] 4 nil nil]) (defalias 'ange-ftp-generate-root-prefixes #[nil "À ˆÁ ÃŽÄÆÇ\"ˆÆÉ\n\"ˆ †ÄC+‡" [ange-ftp-parse-netrc match-data match-data ((store-match-data match-data)) nil res ange-ftp-map-hashtable #[(key value) "ÀÁ\n\"…$\nÃÄ”O\nÄ•ÅOÈÉRC\nB‰\n*‡" [string-match "^[^/]*\\(/\\).*$" key 0 1 nil user host "@" ":" res] 4] ange-ftp-passwd-hashtable #[(host user) "ÁPC\nB‰‡" [host ":" res] 2] ange-ftp-user-hashtable] 3]) #@50 Extract the Nth ftp file name component from NS. (defalias 'ange-ftp-ftp-name-component '(macro . #[(n ns name) "ÀÁ \fEDCÅÆÇÉBBEE‡" [let elt nth n ns if (match-beginning elt) substring name ((match-beginning elt) (match-end elt))] 7 (#$ . 18319)])) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BŇ" [boundp ange-ftp-ftp-name-arg "" current-load-list ange-ftp-ftp-name-res nil] 2) (defalias 'ange-ftp-ftp-name #[(name) " ˜ƒ\n‡à ÅŽÆ@\"…qA‰@‰ ”…. ” •O)\nA@‰ ”…D ” •O) Ì8‰ ”…Z ” •O) GÍUƒjÎ\n! \n E,*‰‡" [name ange-ftp-ftp-name-arg ange-ftp-ftp-name-res match-data match-data ((store-match-data match-data)) posix-string-match ange-ftp-name-format ns elt host user 2 0 ange-ftp-get-user] 4]) (defalias 'ange-ftp-replace-name-component #[(fullname name) "À ÂŽÃ\f@ \"…'\fAÇ8 É”O\n •ËOQ**‡" [match-data match-data ((store-match-data match-data)) posix-string-match ange-ftp-name-format fullname ns 2 elt 0 name nil] 5]) #@74 Clear any existing minibuffer message; let the minibuffer contents show. (defalias 'ange-ftp-repaint-minibuffer #[nil "ÀÁ!‡" [message nil] 2 (#$ . 19287)]) (defalias 'ange-ftp-ftp-process-buffer #[(host user) "À  İ‡" ["*ftp " user "@" host "*"] 5]) (defalias 'ange-ftp-error #[(host user msg) "À ÁÄÅÆ\"!!ˆdbˆÉ !ˆ*ÊËÌÍ\"C\"‡" [selected-window t pop-up-windows cur pop-to-buffer get-buffer-create ange-ftp-ftp-process-buffer host user select-window signal ftp-error format "FTP Error: %s" msg] 5]) #@69 Set correct modes for the current buffer if visiting a remote file. (defalias 'ange-ftp-set-buffer-mode #[nil ";…Á!… !‡" [buffer-file-name ange-ftp-ftp-name auto-save-mode ange-ftp-auto-save] 2 (#$ . 19800)]) #@154 Kill the FTP process associated with BUFFER. If the BUFFER's visited filename or default-directory is an ftp filename then kill the related ftp process. (defalias 'ange-ftp-kill-ftp-process #[(buffer) "„pÁ †\f\n‰…1ÄÅ !!‰…0@A@ÉÊ\"!*))‡" [buffer buffer-file-name default-directory file ange-ftp-ftp-name expand-file-name parsed user host kill-buffer ange-ftp-ftp-process-buffer] 5 (#$ . 20023) "bKill FTP process associated with buffer: "]) #@66 Quote any characters in STRING that may confuse the ftp process. (defalias 'ange-ftp-quote-string #[(string) "ÀÁÂÃ\f\"\"‡" [apply concat mapcar #[(char) "ÁX„ÂV„ÃU„ÄUƒÅÄ\"‡Å!‡" [char 32 126 34 92 vector] 3] string] 5 (#$ . 20490)]) (defalias 'ange-ftp-barf-if-not-directory #[(directory) "À !†ÂÃÄÅ !ƒÆ‚Ç E\"‡" [file-directory-p directory signal file-error "Opening directory" file-exists-p "not a directory" "no such file or directory"] 5]) #@132 Look at the given LINE from the ftp process PROC. Try to categorize it into one of four categories: good, skip, fatal, or unknown. (defalias 'ange-ftp-process-handle-line #[(line proc) "À \n\"ƒÃÄ\nŔŕO!Æ\"‰‡À\n\"ƒ ɇÀ\n\n\"ƒ3Ë\fÉ \n‰‡À\n\"ƒ@ɉ‡À\n\"ƒUÒ!ˆË\f\n‰‡ƒ\\ɇË\f\n‰‡" [string-match ange-ftp-xfer-size-msgs line ash string-to-int 1 -10 ange-ftp-xfer-size ange-ftp-skip-msgs t ange-ftp-good-msgs nil ange-ftp-process-busy ange-ftp-process-result ange-ftp-process-result-line ange-ftp-multi-msgs ange-ftp-process-multi-skip ange-ftp-fatal-msgs delete-process proc] 5 (#$ . 20957)]) #@49 Set the size of the next FTP transfer in bytes. (defalias 'ange-ftp-set-xfer-size #[(host user bytes) "À \n\"‰…Ä !‰…Š qˆÆÈ\"‰ )))‡" [ange-ftp-get-process host user proc process-buffer buf ash bytes -10 ange-ftp-xfer-size] 4 (#$ . 21582)]) #@57 Remove hash marks from STRING and display count so far. (defalias 'ange-ftp-process-handle-hash #[(str) "Á‰”OÁ•ÂOPÁ•Á”Z \\\fƒj ƒjƒjÇ È =„jÉÊ!„j „jÌ\f _Í\"ÁUƒMÐÑ #ˆ‚iÒ_¥‰=„hÐÕ #ˆ))‡" [str 0 nil ange-ftp-hash-mark-count ange-ftp-hash-mark-unit ange-ftp-process-msg ange-ftp-process-verbose selected-window minibuffer-window boundp search-message cursor-in-echo-area ash -6 kbytes ange-ftp-xfer-size ange-ftp-message "%s...%dk" 100 percent ange-ftp-last-percent "%s...%d%%"] 5 (#$ . 21836)]) (defalias 'ange-ftp-call-cont #[(cont result line) "…<ƒ@Á=„Â@ \fA$‡ \f\"‡" [cont lambda apply result line] 5]) (defalias 'ange-ftp-process-filter #[(proc str) "À !pÄ !…ÁÅŽÀ !qˆƒ&ÇÈ \"ƒ&Ê ! Ë  \"ˆ\fÍ !{ ƒM PÇÏ\"ƒMÐ Ñ\"ˆƒ‡ÇÑ\"ƒ‡Ò‰”OÒ•ÔOÇÕ\"ƒ}Ò•ÔO‚jÖ \"ˆ)‚M?…ÀÒƒ«ƒ«ƒ«ÛÜ\"ˆÝ ˆÔ…ÀÔà!#))*‡" [process-buffer proc old-buffer buffer buffer-name ((set-buffer old-buffer)) ange-ftp-process-busy string-match "^#+$" str ange-ftp-process-handle-hash comint-output-filter comint-last-output-start process-mark ange-ftp-process-string "Password: *$" send-string "\n" 0 line nil "^ftp> *" ange-ftp-process-handle-line ange-ftp-xfer-size ange-ftp-process-msg ange-ftp-process-verbose ange-ftp-process-result ange-ftp-message "%s...done" ange-ftp-repaint-minibuffer ange-ftp-process-continue cont ange-ftp-call-cont ange-ftp-process-result-line] 4]) #@65 When ftp process changes state, nuke all file-entries in cache. (defalias 'ange-ftp-process-sentinel #[(proc str) "À !ÃÄ\n\"ƒ#\nŔŕO\nƔƕOÉ\"ˆ*)ʉ ‡" [process-name proc name string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)\\*" 1 2 host user ange-ftp-wipe-file-entries nil ange-ftp-ls-cache-file] 4 (#$ . 23293)]) #@71 Returns whether to access this host via a normal (non-smart) gateway. (defalias 'ange-ftp-use-gateway-p #[(host) "?…Á ÃŽÄ \"*?‡" [ange-ftp-smart-gateway match-data match-data ((store-match-data match-data)) string-match ange-ftp-local-host-regexp host] 3 (#$ . 23621)]) #@58 Returns whether to access this host via a smart gateway. (defalias 'ange-ftp-use-smart-gateway-p #[(host) "…Á ÃŽÄ \"*?‡" [ange-ftp-smart-gateway match-data match-data ((store-match-data match-data)) string-match ange-ftp-local-host-regexp host] 3 (#$ . 23903)]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÆ!Ä BÀÇ!„#ÂÇ B‡" [boundp ange-ftp-tmp-name-files nil current-load-list ange-ftp-tmp-name-hashtable ange-ftp-make-hashtable 10 ange-ftp-pid] 2) #@55 Half-hearted attempt to get the current process's id. (defalias 'ange-ftp-get-pid #[nil "ÀÁ!ÂÃO‰‡" [make-temp-name "" 1 nil ange-ftp-pid] 3 (#$ . 24358)]) #@50 This routine will return the name of a new file. (defalias 'ange-ftp-make-tmp-name #[(host) "À !ƒ\n\n‚  †Æ È Ê Ê\fÍÎ\f $ Ï \"‰\f>„=Ò !ƒR T‰ ÓVƒ\fÔPÈ ‚\fB -‡" [ange-ftp-use-gateway-p host ange-ftp-gateway-tmp-name-template ange-ftp-tmp-name-template template ange-ftp-pid ange-ftp-get-pid pid 97 start nil file entry format "%s%c%s" intern ange-ftp-tmp-name-hashtable ange-ftp-tmp-name-files ange-ftp-real-file-exists-p 122 "X"] 6 (#$ . 24520)]) (defalias 'ange-ftp-del-tmp-name #[(temp) "ÀÁ\n \"\f\"ÅÆLJ" [delq intern temp ange-ftp-tmp-name-hashtable ange-ftp-tmp-name-files nil (ange-ftp-real-delete-file temp) ((error))] 4]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BŇ" [boundp ange-ftp-gwp-running t current-load-list ange-ftp-gwp-status nil] 2) (defalias 'ange-ftp-gwp-sentinel #[(proc str) "À‰‡" [nil ange-ftp-gwp-running] 2]) (defalias 'ange-ftp-gwp-filter #[(proc str) "À \n\"ˆŠÃ !qˆ\fÅ !{)ÆÇ\n\"ƒ'È É\nË\f!)ÍP\"‡ÆÎ\n\"ƒ<È Ï\fË\f!\"ÍP\"‡Æ\n\"ƒMÑ !ˆÒ‰‡Æ\n\"…\\Òɉ‡" [comint-output-filter proc str process-buffer comint-last-output-start process-mark string-match "login: *$" send-string t ange-ftp-default-user ange-ftp-get-user ange-ftp-gateway-host "\n" "Password: *$" ange-ftp-get-passwd ange-ftp-gateway-fatal-msgs delete-process nil ange-ftp-gwp-running ange-ftp-gateway-prompt-pattern ange-ftp-gwp-status] 6]) #@58 Login to the gateway machine and fire up an ftp process. (defalias 'ange-ftp-gwp-start #[(host user name args) "À !Ãʼn $)ÉÊ Ì# Î!ˆÏÐ\"ˆÑÒ\"ˆŠÓ!qˆÔ ˆÕ!`Ö“ˆ)ÃÖÙÚ \"ˆƒUÛ!ˆ‚H„bÜß#ˆÙà \"ˆÃÖá\"\"ˆƒÛ!ˆ‚t„ŽÜã#ˆÃÖáä åQ\"ˆ+‡" [ange-ftp-get-user ange-ftp-gateway-host gw-user t process-connection-type start-process name ange-ftp-gateway-program proc mapconcat identity args " " ftp process-kill-without-query set-process-sentinel ange-ftp-gwp-sentinel set-process-filter ange-ftp-gwp-filter process-buffer internal-ange-ftp-mode process-mark nil ange-ftp-gwp-running ange-ftp-gwp-status ange-ftp-message "Connecting to gateway %s..." accept-process-output ange-ftp-error host user "unable to login to gateway" "Connecting to gateway %s...done" process-send-string ange-ftp-gateway-setup-term-command "unable to set terminal modes on gateway" "exec " "\n"] 5 (#$ . 25903)]) #@622 Low-level routine to send the given ftp CMD to the ftp PROCESS. MSG is an optional message to output before and after the command. If CONT is non-NIL then it is either a function or a list of function and some arguments. The function will be called when the ftp command has completed. If CONT is NIL then this routine will return ( RESULT . LINE ) where RESULT is whether the command was successful, and LINE is the line from the FTP process that caused the command to complete. If NOWAIT is given then the routine will return immediately the command has been queued with no result. CONT will still be called, however. (defalias 'ange-ftp-raw-send-cmd #[(proc cmd &optional msg cont nowait) "À !Â>…±ŠÃ !qˆ\fƒʼnÈ ˆ*‚É\nÉ ÌÅ ÅÓÕØPƒQƒQÚÛ\"ˆdbˆ`Å“ˆÝ ߎàá\"ƒuÓ‰•Oⱈ‚ycˆ*#`Å“ˆä \"ˆå !`Å“ˆ&?…°\fƒ¥Å‰È !ˆ*‚“?…°  B)‡" [process-status proc (run open) process-buffer ange-ftp-process-busy nil inhibit-quit quit-flag accept-process-output "" ange-ftp-process-string ange-ftp-process-result-line t ange-ftp-process-result ange-ftp-process-multi-skip msg ange-ftp-process-msg cont ange-ftp-process-continue 0 ange-ftp-hash-mark-count -1 ange-ftp-last-percent cmd "\n" ange-ftp-process-verbose ange-ftp-message "%s..." comint-last-input-start match-data match-data ((store-match-data match-data)) string-match "^user \"[^\"]*\"" " Turtle Power!\n" comint-last-input-end send-string process-mark nowait] 3 (#$ . 26840)]) #@67 Attempt to resolve the given HOSTNAME using nslookup if possible. (defalias 'ange-ftp-nslookup-host #[(host) "ƒXÁ\n!ƒ\n‚ ÄÆlj$) \nË\n!ˆŠÌ\n!qˆÍ\n!Î>ƒ=Ï\n!ˆ‚,ebˆÐÑÒÄ#ƒOÓ”Ó•{ Ôp!ˆ) +‡‡" [ange-ftp-nslookup-program file-accessible-directory-p default-directory exec-directory t process-connection-type start-process " *nslookup*" host res proc process-kill-without-query process-buffer process-status (run open) accept-process-output re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil 1 kill-buffer] 6 (#$ . 28322) "sHost: "]) #@192 Spawn a new ftp process ready to connect to machine HOST and give it NAME. If HOST is only ftp-able through a gateway machine then spawn a shell on the gateway machine to do the ftp instead. (defalias 'ange-ftp-start-process #[(host user name) "À ! ?…\fÄ !\n„ ƒ‚ÉC\n\" Ì Î!ƒ6‚8ÌÒ\nƒjƒWÕ  $‚tØÙ‰É D \"$‚tØÙ‰ $)Û!ˆŠÜ!qˆÝ ˆ)Þß\"ˆàá\"ˆâ!ˆ.‡" [ange-ftp-use-gateway-p host use-gateway ange-ftp-gateway-host ange-ftp-use-smart-gateway-p use-smart-ftp ange-ftp-gateway-ftp-program-name ange-ftp-ftp-program-name ftp-prog append ange-ftp-ftp-program-args args nil file-name-handler-alist file-accessible-directory-p default-directory exec-directory proc t process-connection-type ange-ftp-gateway-program-interactive ange-ftp-gwp-start user name apply start-process ange-ftp-gateway-program process-kill-without-query process-buffer internal-ange-ftp-mode set-process-sentinel ange-ftp-process-sentinel set-process-filter ange-ftp-process-filter accept-process-output] 7 (#$ . 28881)]) #@70 Major mode for interacting with the FTP process. \{comint-mode-map} (defalias 'internal-ange-ftp-mode #[nil "À ˆÁÃÅp!dbˆÇ!`È“ˆÉÊ!ˆË\nÉÌ!ˆÉÍ!ˆÉÎ!ˆÉÏ!ˆÉÐ!ˆÉÑ!ˆÉÒ!ˆÉÓ!ˆÉÔ!ˆÉÕ!ˆÉÖ!ˆÉ×!ˆØØËÙÉÛ!ˆÜÉÝ!ˆ‰)‡" [comint-mode internal-ange-ftp-mode major-mode "Internal Ange-ftp" mode-name get-buffer-process proc process-mark nil make-local-variable ange-ftp-process-string "" ange-ftp-process-busy ange-ftp-process-result ange-ftp-process-msg ange-ftp-process-multi-skip ange-ftp-process-result-line ange-ftp-process-continue ange-ftp-hash-mark-count ange-ftp-binary-hash-mark-size ange-ftp-ascii-hash-mark-size ange-ftp-hash-mark-unit ange-ftp-xfer-size ange-ftp-last-percent 0 "^ftp> " comint-prompt-regexp comint-password-prompt-regexp "^a\\'z" paragraph-start] 3 (#$ . 29936) nil]) #@187 Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT. PROC is the FTP-client's process. This routine uses the smart-gateway host specified in ``ange-ftp-gateway-host''. (defalias 'ange-ftp-smart-login #[(host user pass account proc) "À ÂÃÄ !#ÂÇ ##‰ @„$Ê Ì AP#ˆÀ ÂÍ Ä!%ÂÐ ##‰ @†]Ñ Ò#ˆÓ Ò#ˆÊ Ô AP#)‡" [ange-ftp-raw-send-cmd proc format "open %s %s" ange-ftp-nslookup-host ange-ftp-gateway-host ange-ftp-smart-gateway-port "Opening FTP connection to %s via %s" host result ange-ftp-error user "OPEN request failed: " "user \"%s\"@%s %s %s" pass account "Logging in as user %s@%s" ange-ftp-set-passwd nil ange-ftp-set-account "USER request failed: "] 9 (#$ . 30739)]) #@110 Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT. PROC is the process to the FTP-client. (defalias 'ange-ftp-normal-login #[(host user pass account proc) "À !Ã\fÅÆ\n\"ÅÇ \"#‰@„!É \nËAP#ˆÃ\fÌ !ƒ6ÅÍ\n\n%‚?ÅÐ\n$ÅÑ\n ##‰@†eÒ \nÓ#ˆÔ \nÓ#ˆÉ \nÕAP#*‡" [ange-ftp-nslookup-host host nshost ange-ftp-raw-send-cmd proc format "open %s" "Opening FTP connection to %s" result ange-ftp-error user "OPEN request failed: " ange-ftp-use-smart-gateway-p "user \"%s\"@%s %s %s" pass account "user \"%s\" %s %s" "Logging in as user %s@%s" ange-ftp-set-passwd nil ange-ftp-set-account "USER request failed: "] 9 (#$ . 31459)]) #@69 *Regexp matching the FTP client's output upon doing a HASH command. (defvar ange-ftp-hash-mark-msgs "[hH]ash mark [^0-9]*\\([0-9]+\\)" (#$ . -32119)) (defalias 'ange-ftp-guess-hash-mark-size #[(proc) "…HŠÁ\n!qˆÃ\nÄ\"‰@ AÈ  ÊŽË\f\"…FÍΔΕO!‰ÑÒ\"†E‰).‡" [ange-ftp-send-hash process-buffer proc ange-ftp-raw-send-cmd "hash" status result line match-data match-data ((store-match-data match-data)) string-match ange-ftp-hash-mark-msgs string-to-int 1 size ange-ftp-ascii-hash-mark-size ash -4 ange-ftp-hash-mark-unit ange-ftp-binary-hash-mark-size] 5]) #@99 Return an FTP subprocess connected to HOST and logged in as USER. Create a new process if needed. (defalias 'ange-ftp-get-process #[(host user) "À \n\"Ä !‰ƒÆ !Ç>ƒ ‚`ÈÉ \n\"!ÈÊ \n\"! \fÍ \n #Î !ƒGƒGÐ \n\f %ˆ‚QÑ \n\f %ˆÒ !ˆÓ \n\"ˆÔÕ!ˆ* *‡" [ange-ftp-ftp-process-buffer host user name get-process proc process-status (run open) ange-ftp-quote-string ange-ftp-get-passwd ange-ftp-get-account account pass ange-ftp-start-process ange-ftp-use-smart-gateway-p ange-ftp-gateway-host ange-ftp-smart-login ange-ftp-normal-login ange-ftp-guess-hash-mark-size ange-ftp-guess-host-type run-hooks ange-ftp-process-startup-hook] 7 (#$ . 32704)]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp ange-ftp-host-cache nil current-load-list ange-ftp-host-type-cache] 2) #@157 Return a symbol which represents the type of the HOST given. If the optional argument USER is given, attempts to guess the host-type by logging in as USER. (defalias 'ange-ftp-host-type #[(host &optional user) " =ƒ\n‡ ƒÄ \"ƒ =ƒ\n‡Å!ƒ'Æ‚XÇÈ!ƒ7È!ƒ7É‚XÇÊ!ƒGÊ!ƒGË‚XÇÌ!ƒWÌ!ƒWÍ‚XΉ‡" [host ange-ftp-host-cache ange-ftp-host-type-cache user ange-ftp-get-process ange-ftp-dumb-unix-host dumb-unix fboundp ange-ftp-vms-host vms ange-ftp-mts-host mts ange-ftp-cms-host cms unix] 3 (#$ . 33482)]) #@213 Alist saying how to convert file name to the host's syntax. Association list of ( TYPE . FUNC ) pairs, where FUNC is a routine which can change a UNIX file name into a name more suitable for a host of type TYPE. (defvar ange-ftp-fix-name-func-alist nil (#$ . 34004)) #@231 Alist saying how to convert directory name to the host's syntax. Association list of ( TYPE . FUNC ) pairs, where FUNC is a routine which can change UNIX directory name into a directory name more suitable for a host of type TYPE. (defvar ange-ftp-fix-dir-name-func-alist nil (#$ . 34278)) #@67 List of host types that can't take UNIX ls-style listing options. (defvar ange-ftp-dumb-host-types (quote (dumb-unix)) (#$ . 34573)) #@245 Find an ftp process connected to HOST logged in as USER and send it CMD. MSG is an optional status message to be output before and after issuing the command. See the documentation for ange-ftp-raw-send-cmd for a description of CONT and NOWAIT. (defalias 'ange-ftp-send-cmd #[(host user cmd &optional msg cont nowait) "@A@ \n ĉ‰‰ \n \f \fƒºÎ8Ï\n \" Ð=ƒ|žA†>Ò\f!\fÓ8Ô=ƒeÕÖ\f\"ƒeÕ×\"„e\fØP\f>„ºÚ ÛÜ\f#\f‚ºžA††Ò Þ>ƒ— \f!\f‚º ß>ƒ§ !‚º à=ƒº \f!\f !á !‰ \f…Êâ\fP…ÓâPQĉ#$åæ\n \" ç\n  ()¯)%ˆ)?…(?…$#B. ‡" [cmd user host msg nil fix-name-func host-type cmd3 cmd2 ange-ftp-this-msg ange-ftp-this-host ange-ftp-this-user cmd1 cmd0 2 ange-ftp-host-type dir ange-ftp-fix-dir-name-func-alist identity 3 unix string-match "/$" "R" "." ange-ftp-dumb-host-types ls format "\"%s %s\"" ange-ftp-fix-name-func-alist (get delete mkdir rmdir cd) (append put chmod) rename symbol-name " " afsc-line afsc-result ange-ftp-raw-send-cmd ange-ftp-get-process #[(result line host user cmd msg cont nowait) "„   ƒÅ #‡ÆÇ \"\n ÌD %‡" [cont result afsc-result line afsc-line ange-ftp-call-cont ange-ftp-raw-send-cmd ange-ftp-get-process host user cmd msg #[(result line cont) "„  Å #‡" [cont result afsc-result line afsc-line ange-ftp-call-cont] 4] nowait] 6] cont nowait] 12 (#$ . 34713)]) (byte-code "ÀÁP BÄÅ BÆÇ B‡" ["^[-A-Z0-9$*][-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?" "[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?\\.[0-9][0-9][0-9A-Z]$" ange-ftp-cms-name-template current-load-list "^[-A-Z0-9_$]+:\\[[-A-Z0-9_$]+\\(\\.[-A-Z0-9_$]+\\)*\\]$" ange-ftp-vms-name-template "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$" ange-ftp-mts-name-template] 2) #@94 Guess at the the host type of HOST. Works by doing a pwd and examining the directory syntax. (defalias 'ange-ftp-guess-host-type #[(host user) "À !  ÄR‰Ç=ƒ³È  ÊŽË \"‰\f@ Î „GÐÑ!ˆÒÓ!ˆÔÕ\fA\"ƒÖ !ˆ Ø‚Ô \"ƒ]Û !ˆ Ü‚Ô \"ƒsÞ !ˆ ß‚Ô  \"ƒ‰Ö !ˆ Ø‚ Ç !\"#žA‰ƒ© ä\" *å  &#ˆ-Ø=…âç &\"?…âË \"@‰ ƒÚå  P&#‚áÐÑ!ˆÒÓ!)*‡" [ange-ftp-host-type host "/" user "/~" key host-type unix match-data match-data ((store-match-data match-data)) ange-ftp-get-pwd result dir nil fix-name-func message "Warning! Unable to get home directory" sit-for 1 string-match "^450 No current working directory defined$" ange-ftp-add-cms-host ange-ftp-host-cache cms ange-ftp-host-type-cache ange-ftp-vms-name-template ange-ftp-add-vms-host vms ange-ftp-mts-name-template ange-ftp-add-mts-host mts ange-ftp-cms-name-template ange-ftp-this-host ange-ftp-this-user ange-ftp-fix-name-func-alist reverse ange-ftp-put-hash-entry ange-ftp-expand-dir-hashtable ange-ftp-hash-entry-exists-p] 6 (#$ . 36477)]) (defalias 'ange-ftp-dumb-unix-host #[(host) "… … ÄŽÅ \"*‡" [host ange-ftp-dumb-unix-host-regexp match-data match-data ((store-match-data match-data)) string-match] 3]) #@68 Interactively adds a given HOST to ange-ftp-dumb-unix-host-regexp. (defalias 'ange-ftp-add-dumb-unix-host #[(host) "À !?…Âà !Ä …Æ °lj‡" [ange-ftp-dumb-unix-host host "^" regexp-quote "$" ange-ftp-dumb-unix-host-regexp "\\|" nil ange-ftp-host-cache] 5 (#$ . 37698) (list (read-string "Host: " (let ((name (or (buffer-file-name) default-directory))) (and name (car (ange-ftp-ftp-name name))))))]) #@205 Alist saying how to parse directory listings for certain OS types. Association list of ( TYPE . FUNC ) pairs. The FUNC is a routine which can parse the output from a DIR listing for a host of type TYPE. (defvar ange-ftp-parse-list-func-alist nil (#$ . 38108)) #@244 Return the output of an `DIR' or `ls' command done over ftp. FILE is the full name of the remote file, LSARGS is any args to pass to the `ls' command, and PARSE specifies that the output should be parsed and stored away in the internal cache. (defalias 'ange-ftp-ls #[(file lsargs parse &optional no-error wildcard) "À !Ã\n!‰ƒ'\f@\fA@ÇÈ\f8! Ê\n! Ì \"‰ >ÐÐÐÐ Õ˜ƒJÖ× Ø#! ƒi ˜ƒi„d˜ƒi‚\"Ý !ƒ‰ß à !#ˆá F‚“á FâŽã äåæ\n!\"$‰@ƒŠç(!qˆé ˆê!ƒÂë!ˆ‚áì-!ˆê!ƒÖë!ˆ‚áî äï\"#ˆ0ƒñ\n 2žA‰ƒú ‚þó!\"ˆ ô ‰)‚!5?…!î öAP#).\n‚*÷ø!*‡" [ange-ftp-expand-file-name file ange-ftp-this-file ange-ftp-ftp-name parsed host user ange-ftp-quote-string 2 name directory-file-name key ange-ftp-host-type host-type ange-ftp-dumb-host-types dumb nil result temp lscmd parse-func "" ange-ftp-real-file-name-as-directory ange-ftp-expand-dir "~" ange-ftp-ls-cache-file lsargs ange-ftp-ls-cache-lsargs ange-ftp-ls-cache-res ange-ftp-make-tmp-name wildcard ange-ftp-cd file-name-directory dir ((ange-ftp-del-tmp-name temp)) ange-ftp-send-cmd format "Listing %s" ange-ftp-abbreviate-filename get-buffer-create ange-ftp-data-buffer-name erase-buffer ange-ftp-real-file-readable-p ange-ftp-real-insert-file-contents sleep-for ange-ftp-retry-time ange-ftp-error "list data file %s not readable" parse ange-ftp-set-files ange-ftp-parse-list-func-alist ange-ftp-parse-dired-listing buffer-string no-error "DIR failed: " error "Should never happen. Please report. Bug ref. no.: 1"] 9 (#$ . 38376)]) (byte-code "ÀÁP B‡" [" \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct" "\\|Nov\\|Dec\\) +[0-3]?[0-9] " ange-ftp-date-regexp current-load-list] 2) #@244 Alist saying how to add file entries on certain OS types. Association list of pairs ( TYPE . FUNC ), where FUNC is a function to be used to add a file entry for the OS TYPE. The main reason for this alist is to deal with file versions in VMS. (defvar ange-ftp-add-file-entry-alist nil (#$ . 40118)) #@243 Alist saying how to delete files on certain OS types. Association list of pairs ( TYPE . FUNC ), where FUNC is a function to be used to delete a file entry for the OS TYPE. The main reason for this alist is to deal with file versions in VMS. (defvar ange-ftp-delete-file-entry-alist nil (#$ . 40424)) #@63 Add a file entry for file NAME, if its directory info exists. (defalias 'ange-ftp-add-file-entry #[(name &optional dir-p) "ÀÁ\n!@! žA† Ä\n \"ˆÆ‰‡" [ange-ftp-host-type ange-ftp-ftp-name name ange-ftp-add-file-entry-alist ange-ftp-internal-add-file-entry dir-p nil ange-ftp-ls-cache-file] 3 (#$ . 40731)]) #@68 Delete the file entry for file NAME, if its directory info exists. (defalias 'ange-ftp-delete-file-entry #[(name &optional dir-p) "ÀÁ\n!@! žA† Ä\n \"ˆÆ‰‡" [ange-ftp-host-type ange-ftp-ftp-name name ange-ftp-delete-file-entry-alist ange-ftp-internal-delete-file-entry dir-p nil ange-ftp-ls-cache-file] 3 (#$ . 41044)]) (defalias 'ange-ftp-parse-filename '(macro . #[nil "À‡" [(let ((eol (progn (end-of-line) (point)))) (beginning-of-line) (if (re-search-forward ange-ftp-date-regexp eol t) (progn (skip-chars-forward " ") (skip-chars-forward "^ " eol) (skip-chars-forward " " eol) (buffer-substring (point) eol))))] 1])) (defalias 'ange-ftp-ls-parser '(macro . #[nil "À‡" [(let ((tbl (ange-ftp-make-hashtable)) (used-F (and (stringp switches) (string-match "F" switches))) file-type symlink directory file) (while (setq file (ange-ftp-parse-filename)) (beginning-of-line) (skip-chars-forward " 0-9") (setq file-type (following-char) directory (eq file-type 100)) (if (eq file-type 108) (if (string-match " -> " file) (setq symlink (substring file (match-end 0)) file (substring file 0 (match-beginning 0))) (setq symlink "")) (setq symlink nil)) (if (and used-F (not (string-equal file "")) (looking-at ".[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)")) (let ((socket (eq file-type 115)) (executable (and (not symlink) (string-match "[xst]" (concat (buffer-substring (match-beginning 1) (match-end 1)) (buffer-substring (match-beginning 2) (match-end 2)) (buffer-substring (match-beginning 3) (match-end 3))))))) (if (or (and symlink (string-match "@$" file)) (and directory (string-match "/$" file)) (and executable (string-match "*$" file)) (and socket (string-match "=$" file))) (setq file (substring file 0 -1))))) (ange-ftp-put-hash-entry file (or symlink directory) tbl) (forward-line 1)) (ange-ftp-put-hash-entry "." t tbl) (ange-ftp-put-hash-entry ".." t tbl) tbl)] 1])) #@164 Regexp matching directories which are listed in dl format. This regexp should not be anchored with a trailing `$', because it should match subdirectories as well. (defvar ange-ftp-dl-dir-regexp nil (#$ . 42942)) #@53 Interactively adds a DIR to ange-ftp-dl-dir-regexp. (defalias 'ange-ftp-add-dl-dir #[(dir) "…Á\n\"?…ÃÄ\n!…ÅR‰‡" [ange-ftp-dl-dir-regexp string-match dir "^" regexp-quote "\\|"] 4 (#$ . 43160) (list (read-string "Directory: " (let ((name (or (buffer-file-name) default-directory))) (and name (ange-ftp-ftp-name name) (file-name-directory name)))))]) (defalias 'ange-ftp-dl-parser '(macro . #[nil "À‡" [(let ((tbl (ange-ftp-make-hashtable))) (while (not (eobp)) (ange-ftp-put-hash-entry (buffer-substring (point) (progn (skip-chars-forward "^ /\n") (point))) (eq (following-char) 47) tbl) (forward-line 1)) (ange-ftp-put-hash-entry "." t tbl) (ange-ftp-put-hash-entry ".." t tbl) tbl)] 1])) (defalias 'ange-ftp-parse-dired-listing #[(&optional switches) "À ÂŽÃÄ!ƒ0ÅyˆlƒÅyˆÆ ;…\"ÈÉ\"ʉ‰‰ \f ʈ`ÒyˆÓÕ#…WÖÊwˆ×wˆÖwˆ`{)‰ ƒÒyˆØÊwˆg‰Ù=\fÚ=ƒ•ÈÛ \"ƒ Ò•ÊO  Ò‰”O ‚˜Ü ‚˜Ê ƒ ܘ„ÃÝ!ƒÞ= ?…ÇÈßŔŕ{à”à•{á”á•{Q\"\"# ƒØÈä \"„ÿ\fƒåÈå \"„ÿ\"ƒòÈæ \"„ÿ#ƒÈç \"ƒ ÒèO *é  †\f#ˆÅyˆ‚2éêÕ#ˆéëÕ#ˆ.‚«Ãì!ƒ:Ê‚«mƒBÊ‚«ÓÊÕ#ƒiÒyˆÆ ;…[ÈÉ\"ʉ‰‰ \f ʈ`ÒyˆÓÕ#…ÖÊwˆ×wˆÖwˆ`{)‰ ƒTÒyˆØÊwˆg‰Ù=\fÚ=ƒÎÈÛ \"ƒÈ Ò•ÊO  Ò‰”O ‚ÑÜ ‚ÑÊ ƒ@ ܘ„@ÃÝ!ƒ@Þ= ?…ÈßŔŕ{à”à•{á”á•{Q\"\"# ƒÈä \"„8\fƒÈå \"„8\"ƒ+Èæ \"„8#ƒ?Èç \"ƒ? ÒèO *é  †J\f#ˆÅyˆ‚kéêÕ#ˆéëÕ#ˆ.‚«ÓíÊÕ#ƒªî/!ˆÒyˆÆ m„–é`ðÊwˆ`{gñ=#ˆÅyˆ‚}éêÕ#ˆéëÕ#ˆ)‚«Ê*‡" [match-data match-data ((store-match-data match-data)) looking-at "^total [0-9]+$" 1 ange-ftp-make-hashtable switches string-match "F" nil file directory symlink file-type used-F tbl eol 0 re-search-forward ange-ftp-date-regexp t " " "^ " " 0-9" 100 108 " -> " "" ".[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)" 115 "[xst]" 2 3 executable socket "@$" "/$" "*$" "=$" -1 ange-ftp-put-hash-entry "." ".." "[^\n]+\\( not found\\|: Not a directory\\)\n\\'" "^[^ \n ]+ +\\([0-9]+\\|-\\|=\\) " ange-ftp-add-dl-dir ange-ftp-this-file "^ /\n" 47] 8]) #@70 For a given DIRECTORY, set or change the associated FILES hashtable. (defalias 'ange-ftp-set-files #[(directory files) "… Á !\f#‡" [files ange-ftp-put-hash-entry file-name-as-directory directory ange-ftp-files-hashtable] 4 (#$ . 45197)]) #@184 Given a given DIRECTORY, return a hashtable of file entries. This will give an error or return nil, depending on the value of NO-ERROR, if a listing for DIRECTORY cannot be obtained. (defalias 'ange-ftp-get-files #[(directory &optional no-error) "À ! \"†qÄ ÆŽÇ ÈÉ!ƒ; ;ƒ;ÊË \"ƒ;ÊÌ \"ƒ;ÊÍ \"„; ‚eÈÎ!ƒd;ƒdÊË\"ƒdÊÌ\"ƒdÊÍ\"„d‚eÏÐ$…p \"*‡" [file-name-as-directory directory ange-ftp-get-hash-entry ange-ftp-files-hashtable match-data match-data ((store-match-data match-data)) ange-ftp-ls boundp dired-actual-switches string-match "[aA]" "l" "R" dired-listing-switches "-al" t no-error] 5 (#$ . 45446)]) (defalias 'ange-ftp-get-file-part '(macro . #[(name) "ÀÁ DDCÄBB‡" [let file file-name-nondirectory name ((if (string-equal file "") "." file))] 4])) (defalias 'ange-ftp-allow-child-lookup '(macro . #[(dir file) "ÀÁ DÄ DÆBBÇBBD‡" [not let* efile file edir dir ((parsed (ange-ftp-ftp-name edir)) (host-type (ange-ftp-host-type (car parsed)))) ((or (and (eq host-type (quote vms)) (string-match "\\." efile)) (and (memq host-type (quote (mts cms))) (not (string-equal "/" (nth 2 parsed))))))] 5])) #@58 Given NAME, return whether there is a file entry for it. (defalias 'ange-ftp-file-entry-p #[(name) "À ! !Ä \"Ç !‰ɘƒÊ‚)ƒ0Ë\"‚}\f  Î !Ð@!‰Ò=ƒRÓÔ\f\"†`Õ>…`Ö8ט?,„vØ Ù\"‰ƒvÄÊ\"†}ËØ !\",‡" [directory-file-name name file-name-directory dir ange-ftp-get-hash-entry ange-ftp-files-hashtable ent file-name-nondirectory file "" "." ange-ftp-hash-entry-exists-p efile edir ange-ftp-ftp-name parsed ange-ftp-host-type host-type vms string-match "\\." (mts cms) 2 "/" ange-ftp-get-files t] 5 (#$ . 46584)]) #@195 Given NAME, return the given file entry. The entry will be either t for a directory, nil for a normal file, or a string for a symlink. If the file isn't in the hashtable, this also returns nil. (defalias 'ange-ftp-get-file-entry #[(name) "À ! !Ä \"Ç !‰ɘƒÊ‚)ƒ0Ä\"‚} \fÍ\f!Ï@!‰Ñ=ƒRÒÓ \"†`Ô>…`Õ8Ö˜?,„v× Ø\"‰ƒvÄÊ\"†}Ä× !\",‡" [directory-file-name name file-name-directory dir ange-ftp-get-hash-entry ange-ftp-files-hashtable ent file-name-nondirectory file "" "." efile edir ange-ftp-ftp-name parsed ange-ftp-host-type host-type vms string-match "\\." (mts cms) 2 "/" ange-ftp-get-files t] 5 (#$ . 47138)]) (defalias 'ange-ftp-internal-delete-file-entry #[(name &optional dir-p) "ƒÁ\n!Ã\n\f\"ˆÅ\n!ÆÇ\n!\f\"‰…3ÃÉ\n!‰\n˘ƒ-Ì‚/\n)\")‡" [dir-p file-name-as-directory name ange-ftp-del-hash-entry ange-ftp-files-hashtable directory-file-name ange-ftp-get-hash-entry file-name-directory files file-name-nondirectory file "" "."] 4]) (defalias 'ange-ftp-internal-add-file-entry #[(name &optional dir-p) "ƒÁ\n!ÃÄ\n! \"‰…+ÇÈ\n!‰ ʘƒ$Ë‚& )#)‡" [dir-p directory-file-name name ange-ftp-get-hash-entry file-name-directory ange-ftp-files-hashtable files ange-ftp-put-hash-entry file-name-nondirectory file "" "."] 5]) #@77 Get rid of entry for HOST, USER pair from file entry information hashtable. (defalias 'ange-ftp-wipe-file-entries #[(host user) "À G!ÃÄ \"ˆ\n‰)‡" [ange-ftp-make-hashtable ange-ftp-files-hashtable new-tbl ange-ftp-map-hashtable #[(key val) "À !‰…$\n@\nA@ \fšƒ š†#Ç  #*)‡" [ange-ftp-ftp-name key parsed u h host user ange-ftp-put-hash-entry val new-tbl] 5]] 3 (#$ . 48427)]) #@74 Tell the ftp process for the given HOST & USER to switch to binary mode. (defalias 'ange-ftp-set-binary-mode #[(host user) "À \nÃ#‰@„Å \nÆ\fAP#‚-ŠÇÈ \n\"!qˆ …,Ê Ë\"‰\f))‡" [ange-ftp-send-cmd host user (type "binary") result ange-ftp-error "BINARY failed: " process-buffer ange-ftp-get-process ange-ftp-binary-hash-mark-size ash -4 ange-ftp-hash-mark-unit] 6 (#$ . 48820)]) #@73 Tell the ftp process for the given HOST & USER to switch to ascii mode. (defalias 'ange-ftp-set-ascii-mode #[(host user) "À \nÃ#‰@„Å \nÆ\fAP#‚-ŠÇÈ \n\"!qˆ …,Ê Ë\"‰\f))‡" [ange-ftp-send-cmd host user (type "ascii") result ange-ftp-error "ASCII failed: " process-buffer ange-ftp-get-process ange-ftp-ascii-hash-mark-size ash -4 ange-ftp-hash-mark-unit] 6 (#$ . 49207)]) (defalias 'ange-ftp-cd #[(host user dir) "À \nÃ\fDÅ$‰@†Ç \nÈAP#)‡" [ange-ftp-send-cmd host user cd dir "Doing CD" result ange-ftp-error "CD failed: "] 6]) #@222 Attempts to get the current working directory for the given HOST/USER pair. Returns ( DIR . LINE ) where DIR is either the directory or NIL if not found, and LINE is the relevant success or fail line from the FTP-client. (defalias 'ange-ftp-get-pwd #[(host user) "À \nÃÄ$‰AÇ @ƒ3É \nËŽÌÍ\"„)ÌÎ\"ƒ2ϔϕO*+B‡" [ange-ftp-send-cmd host user (pwd) "Getting PWD" result line nil dir match-data match-data ((store-match-data match-data)) string-match "\"\\([^\"]*\\)\"" " \\([^ ]+\\) " 1] 6 (#$ . 49751)]) #@147 Return the result of doing a PWD in the current FTP session. Use the connection to machine HOST logged in as user USER and cd'd to directory DIR. (defalias 'ange-ftp-expand-dir #[(host user dir) "À \n\"‰\fžA Æ\nÆ°É\n\"‰ †³\n̘„a\n͘„a Î=ƒaÐQÒ \nÓÔEÕÖ\"$‰AÙ\"…^Ú”Ú•O + „‘Û˜ƒwÜ \n\"@ ‚‘Ý \nÛ#ߎà \n#ƒÜ \n\"@ * ƒ±\n !\" ƒ§  ã\" ä \n#ˆ* ,‡" [ange-ftp-host-type host user host-type ange-ftp-fix-name-func-alist fix-name-func "/" dir key ange-ftp-get-hash-entry ange-ftp-expand-dir-hashtable res "anonymous" "ftp" unix ange-ftp-expand-dir-regexp "\\|" ange-ftp-good-msgs ange-ftp-send-cmd get "/dev/null" format "expanding %s" result line string-match 1 "~" ange-ftp-get-pwd ange-ftp-expand-dir home ((ange-ftp-cd host user home)) ange-ftp-cd ange-ftp-this-host ange-ftp-this-user reverse ange-ftp-put-hash-entry] 8 (#$ . 50277)]) #@48 Take a string and short-circuit //, /. and /.. (defalias 'ange-ftp-canonize-filename #[(n) "ÀÁ\n\"ƒ\nÕSÄOÅ\n!‰ƒ²@A@Ç8 \nÀË\"„ŒÀÌ\"ƒnÔÕO ÕÄOÏ\n  #‰ƒaP‚jÑÒ ÓÄO\"ˆ+‚ŒÏ\n Ô#‰ƒ‡Õ!P‚‹ÑÖ!ˆ)À×\"„©Ø!À×\"ƒ©ÓÄOÙ\n\"+‚ÈÚ\n!Û=ƒÀØ\n!‚ÈØÜ\n!Ý\n!\")‡" [string-match "[^:]+//" n 0 nil ange-ftp-ftp-name parsed 2 name user host "^/" "^~[^/]*" tilda rest ange-ftp-expand-dir dir error "User \"%s\" is not known" 1 "~" ange-ftp-real-file-name-as-directory "Unable to obtain CWD" "^//" ange-ftp-real-expand-file-name ange-ftp-replace-name-component string-to-char 47 ange-ftp-real-file-name-nondirectory ange-ftp-real-file-name-directory] 6 (#$ . 51171)]) #@25 Documented as original. (defalias 'ange-ftp-expand-file-name #[(name &optional default) "À ÂŽÃ\f!Å=ƒ1ÆÇ\f\"ƒ\fÈ•SÉO‰‚.ÆÊ\f\"ƒ1\fÈ•SÉO‰„ Ã\f!Ë=ƒ?Ì\f!‚mÃ\f!Å=ƒMÍ\f!‚m\fGÈUƒ`͆\\!‚mÍІi!\fP!*‡" [match-data match-data ((store-match-data match-data)) string-to-char name 47 string-match "[^:]+//" 0 nil "/~" 126 ange-ftp-real-expand-file-name ange-ftp-canonize-filename default default-directory file-name-as-directory] 3 (#$ . 51891)]) #@120 Association list of ( TYPE . FUNC ) pairs. FUNC converts a filename to a directory name for the operating system TYPE. (defvar ange-ftp-file-name-as-directory-alist nil (#$ . 52355)) #@25 Documented as original. (defalias 'ange-ftp-file-name-as-directory #[(name) "À !‰ƒ%Ã\n8Ęƒ ‚(Å\n@!žA† Ç !‚(Ç !)‡" [ange-ftp-ftp-name name parsed 2 "" ange-ftp-host-type ange-ftp-file-name-as-directory-alist ange-ftp-real-file-name-as-directory] 3 (#$ . 52544)]) #@25 Documented as original. (defalias 'ange-ftp-file-name-directory #[(name) "À !‰ƒ(Ã\n8Å ÇŽÈÉ\f\"*ƒ ‚$Ê Ë\f!\")‚+Ë !)‡" [ange-ftp-ftp-name name parsed 2 filename match-data match-data ((store-match-data match-data)) string-match "^~[^/]*$" ange-ftp-replace-name-component ange-ftp-real-file-name-directory] 5 (#$ . 52821)]) #@25 Documented as original. (defalias 'ange-ftp-file-name-nondirectory #[(name) "À !‰ƒ%Ã\n8Å ÇŽÈÉ\f\"*ƒÊ‚!Ë !)‚(Ë !)‡" [ange-ftp-ftp-name name parsed 2 filename match-data match-data ((store-match-data match-data)) string-match "^~[^/]*$" "" ange-ftp-real-file-name-nondirectory] 4 (#$ . 53157)]) #@25 Documented as original. (defalias 'ange-ftp-directory-file-name #[(dir) "À !‰ƒà ÄÅ\n8!\"‚Ä !)‡" [ange-ftp-ftp-name dir parsed ange-ftp-replace-name-component ange-ftp-real-directory-file-name 2] 6 (#$ . 53465)]) (defalias 'ange-ftp-binary-file #[(file) "À ÂŽÃ\f \"*‡" [match-data match-data ((store-match-data match-data)) string-match ange-ftp-binary-file-name-regexp file] 3]) (defalias 'ange-ftp-write-region #[(start end filename &optional append visit) "À ! !‰ƒ¿ @ A@ÆÇ 8!É\f!\nË !†+Ì\f \"Í=ƒ6Ï‚7ÐÒ !ÔŽÕÖ × ÚŽÛ\nÞ%ˆ,ƒcà\f \"ˆá\n!‰\"ƒvã\f ä\"8#ˆ)å\f \nEæç\"$‰(@„›éêëæì(A\" E\"ˆ*Õ=ƒ±íî!ˆï ˆ ðÞ!ˆñò\"ˆó !.‚ÊÛ %)‡" [expand-file-name filename ange-ftp-ftp-name parsed host user ange-ftp-quote-string 2 name ange-ftp-make-tmp-name temp ange-ftp-binary-file ange-ftp-host-type unix binary append put cmd ange-ftp-abbreviate-filename abbr ((byte-code "À !ˆ\nƒ Ã\f \"ˆÀ‡" [ange-ftp-del-tmp-name temp binary ange-ftp-set-ascii-mode host user] 3)) t buffer-file-name buffer-modified-p mod-p executing-macro ((byte-code " !‡" [filename buffer-file-name set-buffer-modified-p mod-p] 2)) ange-ftp-real-write-region start end nil visit ange-ftp-set-binary-mode file-attributes attr ange-ftp-set-xfer-size 7 ange-ftp-send-cmd format "Writing %s" result signal ftp-error "Opening output file" "FTP Error: \"%s\"" set-visited-file-modtime (0 0) ange-ftp-set-buffer-mode set-buffer-modified-p ange-ftp-message "Wrote %s" ange-ftp-add-file-entry] 8]) (defalias 'ange-ftp-insert-file-contents #[(filename &optional visit beg end replace) "À ˆÁ\n!Ã\n!‰ƒÞ ƒ\nÇ\n!„-È ÊË\n!\f\"ˆÇ\n!ƒÕ\f@ \fA@ÏÐ\f8!Ò !Ô\n!†QÕ \"Ö=Ø\n!ÈÛŽƒiÜ \"ˆÝ ÞEßà\"$‰!@„Žâãäßå!A\"\nE\"ˆ)æ!„¤ç(!„¤æ!ƒ¶é *+,%A@‚Àâãíßî\n\"D\"ˆ) ƒÌïð!ˆ\n\n.D‚èâñä\nD\"‚èé\n *+,%)‡" [barf-if-buffer-read-only expand-file-name filename ange-ftp-ftp-name parsed visit buffer-file-name file-exists-p nil ange-ftp-ls-cache-file ange-ftp-del-hash-entry file-name-directory ange-ftp-files-hashtable host user ange-ftp-quote-string 2 name ange-ftp-make-tmp-name temp ange-ftp-binary-file ange-ftp-host-type unix binary ange-ftp-abbreviate-filename abbr size ((byte-code "ƒ Á\n \"ˆÄ !‡" [binary ange-ftp-set-ascii-mode host user ange-ftp-del-tmp-name temp] 3)) ange-ftp-set-binary-mode ange-ftp-send-cmd get format "Retrieving %s" result signal ftp-error "Opening input file" "FTP Error: \"%s\"" ange-ftp-real-file-readable-p sleep-for ange-ftp-retry-time ange-ftp-real-insert-file-contents beg end replace "Opening input file:" "FTP Error: %s not arrived or readable" set-visited-file-modtime (0 0) file-error] 8]) (defalias 'ange-ftp-expand-symlink #[(file dir) "À !ƒ  \"‡Ä \"‡" [file-name-absolute-p file ange-ftp-replace-name-component dir expand-file-name] 3]) (defalias 'ange-ftp-file-symlink-p #[(file) "À ! !ƒ=ÃÄ !‰ŘƒÆ‚ )ÇÈ !!\"‰ ;…;Ê !ƒ9ËÈ ! \"‚; )‡Ì !‡" [ange-ftp-expand-file-name file ange-ftp-ftp-name ange-ftp-get-hash-entry file-name-nondirectory "" "." ange-ftp-get-files file-name-directory file-ent file-name-absolute-p ange-ftp-replace-name-component ange-ftp-real-file-symlink-p] 6]) (defalias 'ange-ftp-file-exists-p #[(name) "À ! !ƒ)à !…,Ä !‰;ƒ&ÆÇ ÈÉ !!\"!‚'Ê)‡Ë !‡" [expand-file-name name ange-ftp-ftp-name ange-ftp-file-entry-p ange-ftp-get-file-entry file-ent file-exists-p ange-ftp-expand-symlink file-name-directory directory-file-name t ange-ftp-real-file-exists-p] 7]) (defalias 'ange-ftp-file-directory-p #[(name) "À ! !ƒ%ÃÄ !!‰;ƒ\"ÆÇ ÈÉ !!\"!‚# )‡Ê !‡" [expand-file-name name ange-ftp-ftp-name ange-ftp-get-file-entry ange-ftp-file-name-as-directory file-ent file-directory-p ange-ftp-expand-symlink file-name-directory directory-file-name ange-ftp-real-file-directory-p] 7]) (defalias 'ange-ftp-directory-files #[(directory &optional full match &rest v19-args) "À ! !ƒ^à !ˆÄÅ !!Ɖ Ê !Ë \fÍŽ ƒX @ A ƒBÏ\"ƒ%ƒN P‚PB‚%*Ÿ+‡ÑÒ %‡" [expand-file-name directory ange-ftp-ftp-name ange-ftp-barf-if-not-directory ange-ftp-hash-table-keys ange-ftp-get-files nil f files tail file-name-as-directory match-data match-data ((store-match-data match-data)) match string-match full apply ange-ftp-real-directory-files v19-args] 6]) (defalias 'ange-ftp-file-attributes #[(file) "À ! !‰ƒ™Ä !‰ŘƒÆ‚ )ÇÈ !! \nË\n \"…• @ A@Ì 8Í\n \";ƒ[Ò!ƒ[ÓÈ !\"‚]Ô‰‰ÕÖ×Ô;ƒnØ‚xƒwÙ‚xÚÛPÜÝÞßà\"ßà\"¤ßàá!\"¤\"Ô¯\f,*‚œâ !)‡" [expand-file-name file ange-ftp-ftp-name parsed file-name-nondirectory "" "." ange-ftp-get-files file-name-directory files part ange-ftp-hash-entry-exists-p 2 ange-ftp-get-hash-entry dirp name user host file-name-absolute-p ange-ftp-expand-symlink -1 (0 0) (0 0) (0 0) "l" "d" "-" "?????????" nil apply + mapcar identity directory-file-name ange-ftp-real-file-attributes] 18]) (defalias 'ange-ftp-file-writable-p #[(file) "À ! !ƒà !†ÄÅ !!‡Æ !‡" [expand-file-name file ange-ftp-ftp-name file-exists-p file-directory-p file-name-directory ange-ftp-real-file-writable-p] 3]) (defalias 'ange-ftp-file-readable-p #[(file) "À ! !ƒà !‡Ä !‡" [expand-file-name file ange-ftp-ftp-name file-exists-p ange-ftp-real-file-readable-p] 2]) (defalias 'ange-ftp-file-executable-p #[(file) "À ! !ƒà !‡Ä !‡" [expand-file-name file ange-ftp-ftp-name file-exists-p ange-ftp-real-file-executable-p] 2]) (defalias 'ange-ftp-delete-file #[(file) "À ! !‰ƒG @ A@ÆÇ 8!É !\nË\f ÌDÍÎ\n\"$‰@„@ÐÑÒÍÓA\" E\"ˆÔ !-‚JÕ !)‡" [expand-file-name file ange-ftp-ftp-name parsed host user ange-ftp-quote-string 2 name ange-ftp-abbreviate-filename abbr ange-ftp-send-cmd delete format "Deleting %s" result signal ftp-error "Removing old name" "FTP Error: \"%s\"" ange-ftp-delete-file-entry ange-ftp-real-delete-file] 8 nil "fDelete file: "]) (defalias 'ange-ftp-verify-visited-file-modtime #[(buf) "À !‰;ƒÃ\n!ƒÄ‚Å !)‡" [buffer-file-name buf name ange-ftp-ftp-name t ange-ftp-real-verify-visited-file-modtime] 3]) (defalias 'ange-ftp-barf-or-query-if-file-exists #[(absname querystring interactive) "À !…!\n„ÃÄ C\"‡ÅÆÇ #!?…!ÃÄ C\"‡" [file-exists-p absname interactive signal file-already-exists yes-or-no-p format "File %s already exists; %s anyway? " querystring] 5]) (defalias 'ange-ftp-copy-file-internal #[(filename newname ok-if-already-exists keep-date &optional msg cont nowait) "À !À\n!Ã\n!ƒÀÄ !\n\"Å !Å\n!‰„?„?È \n \n$ˆ …kÌ ÍÎ#‚k…G@…RA@…_ÑÒ8!Ô !…n@…yA@…†ÑÒ8!Ô\n \"Ú !†­Ú\n!†­Û\"Ü=…­Û\"Ü=ÞÞ  ƒÀ §ƒÈá\nâ §#ˆƒDã!„Ùƒßä!ƒëå\"ˆæç†ù\nE(†ƒƒéê\"‚éë#ì \n(  -¯-&‚iìÍÞ \n(Þ‰ -&. *‡" [expand-file-name filename newname file-directory-p file-name-nondirectory ange-ftp-ftp-name t-parsed f-parsed ange-ftp-real-copy-file ok-if-already-exists keep-date cont ange-ftp-call-cont t "Copied locally" f-host f-user ange-ftp-quote-string 2 f-name ange-ftp-abbreviate-filename f-abbr t-host t-user t-name t-abbr ange-ftp-binary-file ange-ftp-host-type unix binary nil temp1 temp2 ange-ftp-barf-or-query-if-file-exists "copy to it" ange-ftp-use-gateway-p ange-ftp-make-tmp-name ange-ftp-set-binary-mode ange-ftp-send-cmd get msg format "Getting %s" "Copying %s to %s" ange-ftp-cf1 nowait] 25]) (defalias 'ange-ftp-cf1 #[(result line filename newname binary msg f-parsed f-host f-user f-name f-abbr t-parsed t-host t-user t-name t-abbr temp1 temp2 cont nowait) "ƒ#ÁŽ\n„\" ƒÄ !ˆ „\"ÆÇÈÉÊ\" E\"ˆ)\nƒè\fƒÖÍ!ƒ9Ï! ƒ`ƒX ˜ƒNÑ‚mÒ Ó#ˆ‚m Ñ‚mƒmÒ Ó#ˆƒyÕ\"ˆ×† !‰ƒ“ÙÚ8#ˆ)Û܆¡ E†Âƒ»ƒ»Éà!\"‚ÂÉâ#$#å!  ¯&&‡åÓÑ!  & ‡ç \n#‡" [line ((byte-code "ƒ Á\n \"ˆÁ‡" [binary ange-ftp-set-ascii-mode f-host f-user] 3)) result temp1 ange-ftp-del-tmp-name cont signal ftp-error "Opening input file" format "FTP Error: \"%s\"" filename t-parsed ange-ftp-use-gateway-p t-host ange-ftp-make-tmp-name temp2 nil ange-ftp-real-copy-file t binary ange-ftp-set-binary-mode t-user file-attributes attr ange-ftp-set-xfer-size 7 ange-ftp-send-cmd put t-name msg f-parsed "Putting %s" newname "Copying %s to %s" f-abbr t-abbr ange-ftp-cf2 nowait ange-ftp-call-cont] 14]) (defalias 'ange-ftp-cf2 #[(result line newname t-host t-user binary temp1 temp2 cont) "ÀŽ ƒ$ÂŽ „\f„ÅÆÇÈÉ \"\nE\"ˆË\n!)‚0\f…0Í\f\nÎ#)‡" [((byte-code "ƒÁ!ˆ\nƒÁ\n!ˆÃ\f #‡" [temp1 ange-ftp-del-tmp-name temp2 ange-ftp-call-cont cont result line] 4)) line ((byte-code "ƒ Á\n \"ˆÁ‡" [binary ange-ftp-set-ascii-mode t-host t-user] 3)) result cont signal ftp-error "Opening output file" format "FTP Error: \"%s\"" newname ange-ftp-add-file-entry temp1 ange-ftp-real-copy-file t] 6]) (defalias 'ange-ftp-copy-file #[(filename newname &optional ok-if-already-exists keep-date) "À \n \fʼnt&‡" [ange-ftp-copy-file-internal filename newname ok-if-already-exists keep-date nil] 8 nil "fCopy file: \nFCopy %s to file: \np"]) #@49 Rename remote file FILE to remote file NEWNAME. (defalias 'ange-ftp-rename-remote-to-remote #[(filename newname f-parsed t-parsed) "@A@ @ A@‰ ˜ƒp\f\n˜ƒpÆÇ8!ÆÇ 8! Ê E Ì !Ì \"Ñ \f ÒÓ#$‰@„bÕÖ×ÒØA\" F\"ˆÙ!ˆÚ !.‚}Û ÜÝ$ˆÞ !,‡" [f-parsed t-parsed t-user t-host f-user f-host ange-ftp-quote-string 2 f-name t-name rename cmd ange-ftp-abbreviate-filename filename fabbr newname nabbr ange-ftp-send-cmd format "Renaming %s to %s" result signal ftp-error "Renaming" "FTP Error: \"%s\"" ange-ftp-add-file-entry ange-ftp-delete-file-entry ange-ftp-copy-file-internal t nil delete-file] 9 (#$ . 62528)]) #@47 Rename local FILENAME to remote file NEWNAME. (defalias 'ange-ftp-rename-local-to-remote #[(filename newname) "À !À \"ÅÆ\n\f#È ÉÊ%ˆÊ Ì !,‡" [ange-ftp-abbreviate-filename filename fabbr newname nabbr format "Renaming %s to %s" msg ange-ftp-copy-file-internal t nil ange-ftp-process-verbose delete-file] 6 (#$ . 63170)]) #@52 Rename remote file FILENAME to local file NEWNAME. (defalias 'ange-ftp-rename-remote-to-local #[(filename newname) "À !À \"ÅÆ\n\f#È ÉÊ%ˆÊ Ì !,‡" [ange-ftp-abbreviate-filename filename fabbr newname nabbr format "Renaming %s to %s" msg ange-ftp-copy-file-internal t nil ange-ftp-process-verbose delete-file] 6 (#$ . 63504)]) (defalias 'ange-ftp-rename-file #[(filename newname &optional ok-if-already-exists) "À !À\n!à !Ã\n!\f„ ƒ+ƒ#§ƒ+Ç\nȧ#ˆ\fƒC ƒ<É \n\f $‚TÊ \n\"‚T ƒNË \n\"‚TÌ \n#*‡" [expand-file-name filename newname ange-ftp-ftp-name f-parsed t-parsed ok-if-already-exists ange-ftp-barf-or-query-if-file-exists "rename to it" ange-ftp-rename-remote-to-remote ange-ftp-rename-remote-to-local ange-ftp-rename-local-to-remote ange-ftp-real-rename-file] 5 nil "fRename file: \nFRename %s to file: \np"]) (defalias 'ange-ftp-file-entry-active-p #[(sym) "ÁN‰;?†Âà \f\"!)‡" [sym val file-exists-p ange-ftp-expand-symlink ange-ftp-this-dir] 5]) (defalias 'ange-ftp-file-entry-not-ignored-p #[(sym) "ÁNÂ!‰;ƒ+Ä \"Ç!†'È!…'É\n \"?)‚5 †5É\n \"?*‡" [sym val symbol-name symname ange-ftp-expand-symlink ange-ftp-this-dir file file-directory-p file-exists-p string-match ange-ftp-completion-ignored-pattern] 4]) (defalias 'ange-ftp-file-name-all-completions #[(file dir) "À !Ã\n!ƒ)Ä\n!ˆÅ\n!Æ\n!È Ê# ÌÍ \"*‚C\nΘƒ>È Ï \"Ð \n\"¤‚CÐ \n\")‡" [expand-file-name dir ange-ftp-this-dir ange-ftp-ftp-name ange-ftp-barf-if-not-directory ange-ftp-real-file-name-as-directory ange-ftp-get-files tbl all-completions file ange-ftp-file-entry-active-p completions mapcar #[(file) "À \n\"‰ƒ ;ƒÄÅ \"!ƒ ÇP‚ )‡" [ange-ftp-get-hash-entry file tbl ent file-directory-p ange-ftp-expand-symlink ange-ftp-this-dir "/"] 5] "/" ange-ftp-generate-root-prefixes ange-ftp-real-file-name-all-completions] 4]) (defalias 'ange-ftp-file-name-completion #[(file dir) "À !Ã\n!ƒDÄ\n!ˆ ÆšƒÆ‚^Ç\n!È\n! ÊË\fÍ#Ï ÑŽÒ  \nÓ$†@Ò  \nÔ$,‚^\nÕ˜ƒZÖ × ØÙÚ Õ\"\"¤\"‚^Û \n\")‡" [expand-file-name dir ange-ftp-this-dir ange-ftp-ftp-name ange-ftp-barf-if-not-directory file "" ange-ftp-real-file-name-as-directory ange-ftp-get-files tbl mapconcat #[(s) ";ƒ Á!ÂP‡Ã‡" [s regexp-quote "$" "/"] 2] completion-ignored-extensions "\\|" ange-ftp-completion-ignored-pattern match-data match-data ((store-match-data match-data)) ange-ftp-file-name-completion-1 ange-ftp-file-entry-not-ignored-p ange-ftp-file-entry-active-p "/" try-completion ange-ftp-generate-root-prefixes mapcar list ange-ftp-real-file-name-all-completions ange-ftp-real-file-name-completion] 8]) (defalias 'ange-ftp-file-name-completion-1 #[(file tbl dir predicate) "À \n #‰…?\fÅ=ƒ$ÆÇ \"!ƒ ÉP‚?Å‚?À\f\n #Å=ƒ>ÆÇ\f\"!ƒ>\fÉP‚?\f)‡" [try-completion file tbl predicate bestmatch t file-directory-p expand-file-name dir "/"] 5]) (defalias 'ange-ftp-re-read-dir #[(&optional dir) "ƒ Á!‚ÂÁà !!Ä!…%ÅÇ\"ˆÉÊ\"‡" [dir expand-file-name file-name-directory buffer-string ange-ftp-ftp-name nil ange-ftp-ls-cache-file ange-ftp-del-hash-entry ange-ftp-files-hashtable ange-ftp-get-files t] 3 nil nil]) (defalias 'ange-ftp-make-directory #[(dir &optional parents) "ƒÁ !!Å\f!„Æ\f\"ˆ)Å !ƒ!ÇÈ \"‡É !‰\nƒ‚\n@ \nA@\fÍÎ !Ï=ƒHÐÑ\n8!‚NÒÑ\n8!!Ô !Ö \f×DØÙ\"$‰@„zÛ \fØÜ A##ˆÝ Þ\"-‚…ß !)‡" [parents file-name-directory directory-file-name dir parent file-exists-p ange-ftp-make-directory error "Cannot make directory %s: file already exists" ange-ftp-ftp-name parsed host user ange-ftp-quote-string ange-ftp-host-type unix ange-ftp-real-directory-file-name 2 ange-ftp-real-file-name-as-directory name ange-ftp-abbreviate-filename abbr ange-ftp-send-cmd mkdir format "Making directory %s" result ange-ftp-error "Could not make directory %s: %s" ange-ftp-add-file-entry t ange-ftp-real-make-directory] 8 nil (list (expand-file-name (read-file-name "Make directory: ")))]) (defalias 'ange-ftp-delete-directory #[(dir) "À !ƒ` !‰ƒ[ @ A@ÆÇ\f!È=ƒ&ÉÊ 8!‚+ËÊ 8!!\fÍ !Ï\f Ð\fDÑÒ\"$‰@„SÔ\f ÑÕ A##ˆÖ ×\"-‚^Ø !)‡ÙÚ \"‡" [file-directory-p dir ange-ftp-ftp-name parsed host user ange-ftp-quote-string ange-ftp-host-type unix ange-ftp-real-directory-file-name 2 ange-ftp-real-file-name-as-directory name ange-ftp-abbreviate-filename abbr ange-ftp-send-cmd rmdir format "Removing directory %s" result ange-ftp-error "Could not remove directory %s: %s" ange-ftp-delete-file-entry t ange-ftp-real-delete-directory error "Not a directory: %s"] 8]) (defalias 'ange-ftp-file-local-copy #[(file) "À !Ã\n!‰…!Å\f@!Ç\nÈÉÊË\n\"%ˆ)*‡" [expand-file-name file fn1 ange-ftp-ftp-name pa1 ange-ftp-make-tmp-name tmp1 ange-ftp-copy-file-internal t nil format "Getting %s"] 9]) (defalias 'ange-ftp-load #[(file &optional noerror nomessage nosuffix) "À !ƒO\nƒ C‚ ÃP ÄP EŃ.„.ÈÉʈ‚ƒBËŽÌ \n$)‚M †MÏÐÑ D\"*‡Ò  \n$‡" [ange-ftp-ftp-name file nosuffix ".elc" ".el" nil copy tryfiles error (byte-code "À @!À‡" [ange-ftp-file-local-copy tryfiles copy] 2) ((ftp-error)) ((delete-file copy)) load noerror nomessage signal file-error "Cannot open load file" ange-ftp-real-load] 5]) (defalias 'ange-ftp-unhandled-file-name-directory #[(filename) "À !‡" [file-name-directory ange-ftp-tmp-name-template] 2]) #@437 Alist of host-type-specific functions to process file names for compression. Each element has the form (TYPE . FUNC). FUNC should take one argument, a file name, and return a list of the form (COMPRESSING NEWNAME). COMPRESSING should be t if the specified file should be compressed, and nil if it should be uncompressed (that is, if it is a compressed file). NEWNAME should be the name to give the new compressed or uncompressed file. (defvar ange-ftp-make-compressed-filename-alist nil (#$ . 68768)) (defalias 'ange-ftp-dired-compress-file #[(name) "À !‰ƒCÅ\f@!žA‰ƒCÇ ÉŽ !*‰\n@ \nA@\f ƒ:Í \f\"‚?Î \f\"+‚JÂÐ !)*‡" [ange-ftp-ftp-name name nil conversion-func parsed ange-ftp-host-type ange-ftp-make-compressed-filename-alist match-data match-data ((store-match-data match-data)) decision compressing newfile ange-ftp-compress ange-ftp-uncompress file-name-handler-alist dired-compress-file] 4]) (defalias 'ange-ftp-compress #[(file nfile) "À !Ã\n@!Ã\n@!Æ !Æ! ÊË\"\fÊÍ \"ÏŽÐ \fÑÒ\f%ˆƒ=ÔÕ\"ˆÖ``ÒÑÒØÊÙ\f #&ˆƒYÔÚ\"ˆÛ ÜU…qÒÝ !ˆ)Ð ÑÒ%.‡" [ange-ftp-ftp-name file parsed ange-ftp-make-tmp-name tmp1 tmp2 ange-ftp-abbreviate-filename abbr nfile nabbr format "Getting %s" msg1 "Putting %s" msg2 ((byte-code "À !ˆÀ\n!‡" [ange-ftp-del-tmp-name tmp1 tmp2] 2)) ange-ftp-copy-file-internal t nil ange-ftp-process-verbose ange-ftp-message "Compressing %s..." call-process-region shell-file-name "-c" "compress -f -c < %s > %s" "Compressing %s...done" buffer-size 0 delete-file] 12]) (defalias 'ange-ftp-uncompress #[(file nfile) "À !Ã\n@!Ã\n@!Æ !Æ! ÊË\"\fÊÍ \"ÏŽÐ \fÑÒ\f%ˆƒ=ÔÕ\"ˆÖ``ÒÑÒØÊÙ\f #&ˆƒYÔÚ\"ˆÛ ÜU…qÒÝ !ˆ)Ð ÑÒ%.‡" [ange-ftp-ftp-name file parsed ange-ftp-make-tmp-name tmp1 tmp2 ange-ftp-abbreviate-filename abbr nfile nabbr format "Getting %s" msg1 "Putting %s" msg2 ((byte-code "À !ˆÀ\n!‡" [ange-ftp-del-tmp-name tmp1 tmp2] 2)) ange-ftp-copy-file-internal t nil ange-ftp-process-verbose ange-ftp-message "Uncompressing %s..." call-process-region shell-file-name "-c" "uncompress -c < %s > %s" "Uncompressing %s...done" buffer-size 0 delete-file] 12]) (defalias 'ange-ftp-find-backup-file-name #[(fn) "…Á\n!‡" [ange-ftp-make-backup-files ange-ftp-real-find-backup-file-name fn] 2]) (defalias 'ange-ftp-hook-function #[(operation &rest args) "ÁN‰ƒÃ\n\f\"‚Å\f\")‡" [operation ange-ftp fn apply args ange-ftp-run-real-handler] 4]) (byte-code "ÀÁ\n\"„ Ã\nBÀÄ\n\"„Å\nBÆ>„#ÆBÈÉÊË#ˆÈÌÊÍ#ˆÈÎÊÏ#ˆÈÐÊÑ#ˆÈÒÊÓ#ˆÈÔÊÕ#ˆÈÖÊ×#ˆÈØÊÙ#ˆÈÚÊÛ#ˆÈÜÊÝ#ˆÈÞÊß#ˆÈàÊá#ˆÈâÊã#ˆÈäÊå#ˆÈæÊç#ˆÈèÊé#ˆÈêÊë#ˆÈìÊí#ˆÈîÊï#ˆÈðÊñ#ˆÈòÊó#ˆÈôÊõ#ˆÈöÊ÷#ˆÈøÊù#ˆÈúÊû#ˆÈüÊý#ˆÈþÊÿ#ˆÈ@ÊA#ˆÈBÊC#ˆÈDÊE#ˆÈFÊG#ˆÈHÊI#ˆÈJÊK#ˆÈLÊM#ˆÈNÊO#‡" [assoc "^/[^/:]*[^/:.]:" file-name-handler-alist ("^/[^/:]*[^/:.]:" . ange-ftp-hook-function) "^/[^/:]*\\'" ("^/[^/:]*\\'" . ange-ftp-completion-hook-function) ange-ftp-set-buffer-mode find-file-hooks put file-name-directory ange-ftp ange-ftp-file-name-directory file-name-nondirectory ange-ftp-file-name-nondirectory file-name-as-directory ange-ftp-file-name-as-directory directory-file-name ange-ftp-directory-file-name expand-file-name ange-ftp-expand-file-name make-directory ange-ftp-make-directory delete-directory ange-ftp-delete-directory insert-file-contents ange-ftp-insert-file-contents directory-files ange-ftp-directory-files file-directory-p ange-ftp-file-directory-p file-writable-p ange-ftp-file-writable-p file-readable-p ange-ftp-file-readable-p file-executable-p ange-ftp-file-executable-p file-symlink-p ange-ftp-file-symlink-p delete-file ange-ftp-delete-file read-file-name-internal ange-ftp-read-file-name-internal verify-visited-file-modtime ange-ftp-verify-visited-file-modtime file-exists-p ange-ftp-file-exists-p write-region ange-ftp-write-region backup-buffer ange-ftp-backup-buffer copy-file ange-ftp-copy-file rename-file ange-ftp-rename-file file-attributes ange-ftp-file-attributes file-name-all-completions ange-ftp-file-name-all-completions file-name-completion ange-ftp-file-name-completion insert-directory ange-ftp-insert-directory file-local-copy ange-ftp-file-local-copy unhandled-file-name-directory ange-ftp-unhandled-file-name-directory file-name-sans-versions ange-ftp-file-name-sans-versions dired-uncache ange-ftp-dired-uncache dired-compress-file ange-ftp-dired-compress-file load ange-ftp-load find-backup-file-name ange-ftp-find-backup-file-name file-truename identity vc-registered null] 4) (defalias 'ange-ftp-run-real-handler #[(operation args) "ÀÁ\n =… \fBB Å \"*‡" [ange-ftp-hook-function ange-ftp-completion-hook-function inhibit-file-name-operation operation inhibit-file-name-handlers apply args] 4]) (defalias 'ange-ftp-real-file-name-directory #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler file-name-directory args] 3]) (defalias 'ange-ftp-real-file-name-nondirectory #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler file-name-nondirectory args] 3]) (defalias 'ange-ftp-real-file-name-as-directory #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler file-name-as-directory args] 3]) (defalias 'ange-ftp-real-directory-file-name #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler directory-file-name args] 3]) (defalias 'ange-ftp-real-expand-file-name #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler expand-file-name args] 3]) (defalias 'ange-ftp-real-make-directory #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler make-directory args] 3]) (defalias 'ange-ftp-real-delete-directory #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler delete-directory args] 3]) (defalias 'ange-ftp-real-insert-file-contents #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler insert-file-contents args] 3]) (defalias 'ange-ftp-real-directory-files #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler directory-files args] 3]) (defalias 'ange-ftp-real-file-directory-p #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler file-directory-p args] 3]) (defalias 'ange-ftp-real-file-writable-p #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler file-writable-p args] 3]) (defalias 'ange-ftp-real-file-readable-p #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler file-readable-p args] 3]) (defalias 'ange-ftp-real-file-executable-p #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler file-executable-p args] 3]) (defalias 'ange-ftp-real-file-symlink-p #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler file-symlink-p args] 3]) (defalias 'ange-ftp-real-delete-file #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler delete-file args] 3]) (defalias 'ange-ftp-real-read-file-name-internal #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler read-file-name-internal args] 3]) (defalias 'ange-ftp-real-verify-visited-file-modtime #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler verify-visited-file-modtime args] 3]) (defalias 'ange-ftp-real-file-exists-p #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler file-exists-p args] 3]) (defalias 'ange-ftp-real-write-region #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler write-region args] 3]) (defalias 'ange-ftp-real-backup-buffer #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler backup-buffer args] 3]) (defalias 'ange-ftp-real-copy-file #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler copy-file args] 3]) (defalias 'ange-ftp-real-rename-file #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler rename-file args] 3]) (defalias 'ange-ftp-real-file-attributes #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler file-attributes args] 3]) (defalias 'ange-ftp-real-file-name-all-completions #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler file-name-all-completions args] 3]) (defalias 'ange-ftp-real-file-name-completion #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler file-name-completion args] 3]) (defalias 'ange-ftp-real-insert-directory #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler insert-directory args] 3]) (defalias 'ange-ftp-real-file-name-sans-versions #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler file-name-sans-versions args] 3]) (defalias 'ange-ftp-real-shell-command #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler shell-command args] 3]) (defalias 'ange-ftp-real-load #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler load args] 3]) (defalias 'ange-ftp-real-find-backup-file-name #[(&rest args) "ÀÁ\n\"‡" [ange-ftp-run-real-handler find-backup-file-name args] 3]) (defalias 'ange-ftp-insert-directory #[(file switches &optional wildcard full) "À !Âà !!\fƒ1ƒ&Ç !ÉÊ ! ̉Í%)‚-É  #c‚:Ï  $*‡" [ange-ftp-abbreviate-filename file ange-ftp-ftp-name expand-file-name parsed short wildcard file-name-directory default-directory ange-ftp-ls file-name-nondirectory switches nil t full ange-ftp-real-insert-directory] 6]) (defalias 'ange-ftp-dired-uncache #[(dir) "ÀÁ\n!!… ɇ" [ange-ftp-ftp-name expand-file-name dir nil ange-ftp-ls-cache-file] 3]) #@74 Alist of mapping host type into function to remove file version numbers. (defvar ange-ftp-sans-version-alist nil (#$ . 77615)) (defalias 'ange-ftp-file-name-sans-versions #[(file keep-backup-version) "À ! !ɉƒ!Ç@!Ç@!žA\fƒ-\f  \"‚2Ê  \"+‡" [ange-ftp-abbreviate-filename file ange-ftp-ftp-name nil func host-type parsed ange-ftp-host-type ange-ftp-sans-version-alist keep-backup-version ange-ftp-real-file-name-sans-versions] 4]) (defalias 'ange-ftp-shell-command #[(command) "À !‰@\nA@Å\n8\n„Ç!‚@GÉVƒ,ÊËRÌÍ $ÏÐ\"ˆÇ!,‡" [ange-ftp-ftp-name default-directory parsed host user 2 name ange-ftp-real-shell-command command 0 "cd " "; " format "%s %s \"%s\"" remote-shell-program ange-ftp-message "Remote command '%s' ..."] 6]) (defalias 'ange-ftp-dired-call-process #[(program discard &rest arguments) "À !ƒ ÂÃćÅÆÈ ?È\n&‡" [ange-ftp-ftp-name default-directory oops (byte-code "Ášƒ\n !‡ÄÅ\"‡" [program "chmod" ange-ftp-call-chmod arguments error "Unknown remote command: %s"] 3) ((ftp-error (byte-code "ÀÁ\nA@Ã\n8Ä\n8$c‡" [format "%s: %s, %s\n" oops 2 3] 6)) (error (byte-code "ÀÁ\nA@\"c‡" [format "%s\n" oops] 3))) apply call-process program nil discard arguments] 7]) (defalias 'ange-ftp-call-chmod #[(args) "GÁWƒ\fÂÃ\"ˆ@ÅÆA\"ˆ)lj‡" [args 2 error "ange-ftp-call-chmod: missing mode and/or filename: %s" mode mapcar #[(file) "À ! !‰…A @ A@ÆÇ 8!É !\nË\f Ì EÎÏ\n\"$‰@†@Ñ\f ÎÒ A##-)‡" [expand-file-name file ange-ftp-ftp-name parsed host user ange-ftp-quote-string 2 name ange-ftp-abbreviate-filename abbr ange-ftp-send-cmd chmod mode format "doing chmod %s" result ange-ftp-error "chmod: %s: \"%s\""] 8] nil ange-ftp-ls-cache-file] 3]) (defalias 'ange-ftp-fix-name-for-vms #[(name &optional reverse) "À ÂŽ ƒvÄÅ\"ƒnlj‰ \nË”ƒ(˔˕O\nÌ”ƒ6̔̕O Í”ƒD͔͕O ƒVÎÏÐÑ ËÒO\"\" \n…`Ó\nÓQ ‰…gÓR+‚ÏÔÕ\"‚Ïlj‰‰ \nÄ×\"ƒ›ËØ•SO\nØ•ÇOÙ!‰ƒ²ÎÏÐÚØÒO\"\" Û!\n …ËÜ\n?…ÇÝ ÞRQ,*‡" [match-data match-data ((store-match-data match-data)) reverse string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name nil file dir drive 1 2 3 apply concat mapcar #[(char) "ÁUƒ\nÂÃ!‡Â!‡" [char 46 vector 47] 2] -1 "/" error "name %s didn't match" tmp "^/[^:]+:/" 0 file-name-directory #[(char) "ÁUƒ\nÂÃ!‡Â!‡" [char 47 vector 46] 2] file-name-nondirectory "[" "." "]"] 8]) (byte-code "À ž„\n BÀ >„À BÀ‡" [vms ange-ftp-fix-name-func-alist (vms . ange-ftp-fix-name-for-vms) ange-ftp-dumb-host-types] 2) (defalias 'ange-ftp-fix-dir-name-for-vms #[(dir-name) "Á˜ƒ\nÂÃ!‡ÄÅ\"ƒÂÆ!‡Ç!‡" [dir-name "/" error "Cannot get listing for fictitious \"/\" directory." string-match "^/[-A-Z0-9_$]+:/$" "Cannot get listing for device." ange-ftp-fix-name-for-vms] 3]) (byte-code "À ž„\n BÃÄ!„ÅÄBŇ" [vms ange-ftp-fix-dir-name-func-alist (vms . ange-ftp-fix-dir-name-for-vms) boundp ange-ftp-vms-host-regexp nil current-load-list] 2) (defalias 'ange-ftp-vms-host #[(host) "…Á ÃŽÄ \"*‡" [ange-ftp-vms-host-regexp match-data match-data ((store-match-data match-data)) string-match host] 3]) #@271 Regular expression to match for a valid VMS file name in Dired buffer. Stupid freaking bug! Position of _ and $ shouldn't matter but they do. Having [A-Z0-9$_] bombs on filename _$$CHANGE_LOG$.TXT$ and $CHANGE_LOG$.TX Other orders of $ and _ seem to all work just fine. (defconst ange-ftp-vms-filename-regexp (concat "\\(\\([_A-Za-z0-9$]?\\|[_A-Za-z0-9$][-_A-Za-z0-9$]*\\)\\." "[-_A-Za-z0-9$]*;+[0-9]*\\)") (#$ . 80734)) (defalias 'ange-ftp-parse-vms-filename #[nil "À ÂÃ#… Ĕĕ{‡" [re-search-forward ange-ftp-vms-filename-regexp nil t 0] 4]) (defalias 'ange-ftp-parse-vms-listing #[nil "À ÁebˆÄ ÆŽÇ ‰ƒEÈÉ\n\"ƒ(Ê\nˉ”OÌ #ˆ‚?Ê\nÁ #ˆÈÍ\n\"ƒ?Ê\nˉ”OÁ #ˆÎyˆ‚ ÊÏÌ #ˆÊÐÌ #ˆ* *‡" [ange-ftp-make-hashtable nil file tbl match-data match-data ((store-match-data match-data)) ange-ftp-parse-vms-filename string-match "\\.\\(DIR\\|dir\\);[0-9]+" ange-ftp-put-hash-entry 0 t ";[0-9]+$" 1 "." ".."] 4]) (byte-code "À ž„\n BÀ‡" [vms ange-ftp-parse-list-func-alist (vms . ange-ftp-parse-vms-listing)] 2) (defalias 'ange-ftp-vms-delete-file-entry #[(name &optional dir-p) "ƒ Á\nÃ\"‡Ä ÆŽÇ\n!‰ɘƒÊ‚)ËÌ\"…eÍÎ\n!\"‰…dщ”OÓÔ!ÌQÖØ\"ˆÙÚ\"ˆ†cØ\"+)+‡" [dir-p ange-ftp-internal-delete-file-entry name t match-data match-data ((store-match-data match-data)) file-name-nondirectory file "" "." string-match ";[0-9]+$" ange-ftp-get-hash-entry file-name-directory ange-ftp-files-hashtable files 0 root "^" regexp-quote regexp nil versions ange-ftp-del-hash-entry mapatoms #[(sym) "À \nÃN\"…\fĉ‡" [string-match regexp sym key t versions] 4]] 4]) (byte-code "À ž„\n BÀ‡" [vms ange-ftp-delete-file-entry-alist (vms . ange-ftp-vms-delete-file-entry)] 2) (defalias 'ange-ftp-vms-add-file-entry #[(name &optional dir-p) "ƒ Á\nÃ\"‡ÄÅ\n!\"‰…vÈ\n!‰ ʘƒ%Ë‚' ) Ì  ÎŽÏÐ \"ƒGÑ Ò‰”OÓ#ˆ‚mÔÕ !ÖQÒÙÚ\"ˆTÑ ÛÜ!QÓ#ˆ**Ñ Ó#))‡" [dir-p ange-ftp-internal-add-file-entry name t ange-ftp-get-hash-entry file-name-directory ange-ftp-files-hashtable files file-name-nondirectory file "" "." match-data match-data ((store-match-data match-data)) string-match ";[0-9]+$" ange-ftp-put-hash-entry 0 nil "^" regexp-quote ";\\([0-9]+\\)$" version regexp mapatoms #[(sym) "ÁNÃ\f\n\"… Æ\nǔǕO!]‰)‡" [sym key name string-match regexp version string-to-int 1] 5] ";" int-to-string] 6]) (byte-code "À ž„\n BÀ‡" [vms ange-ftp-add-file-entry-alist (vms . ange-ftp-vms-add-file-entry)] 2) #@49 Mark HOST as the name of a machine running VMS. (defalias 'ange-ftp-add-vms-host #[(host) "À !?…Âà !Ä …Æ °lj‡" [ange-ftp-vms-host host "^" regexp-quote "$" ange-ftp-vms-host-regexp "\\|" nil ange-ftp-host-cache] 5 (#$ . 83166) (list (read-string "Host: " (let ((name (or (buffer-file-name) default-directory))) (and name (car (ange-ftp-ftp-name name))))))]) (defalias 'ange-ftp-vms-file-name-as-directory #[(name) "À ÂŽÃÄ \"ƒ Ɖ”OÇ !*‡" [match-data match-data ((store-match-data match-data)) string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?$" name 0 ange-ftp-real-file-name-as-directory] 3]) (byte-code "À ž„\n BÀ‡" [vms ange-ftp-file-name-as-directory-alist (vms . ange-ftp-vms-file-name-as-directory)] 2) (defalias 'ange-ftp-vms-make-compressed-filename #[(name &optional reverse) "ÀÁ\n\"ƒÃ\nĉ”OD‡ÀÅ\n\"ƒÃ\nĉ”OD‡ÀÆ\n\"ƒ,Ã\nÄÇOD‡ÈÀÅ\n\"ƒ>\nĉ”OÉP‚A\nÉPD‡" [string-match "-Z;[0-9]+$" name nil 0 ";[0-9]+$" "-Z$" -2 t "-Z"] 4]) (byte-code "À ž„\n BÀ‡" [vms ange-ftp-make-compressed-filename-alist (vms . ange-ftp-vms-make-compressed-filename)] 2) (defalias 'ange-ftp-vms-sans-version #[(name &rest args) "À ÂŽÃÄ \"ƒ Ɖ”O‚ *‡" [match-data match-data ((store-match-data match-data)) string-match ";[0-9]+$" name 0] 3]) (byte-code "À ž„\n BÀ‡" [vms ange-ftp-sans-version-alist (vms . ange-ftp-vms-sans-version)] 2) (defalias 'ange-ftp-fix-name-for-mts #[(name &optional reverse) "À ÂŽ ƒKÄÅ\"ƒClj Ê”ƒ$ËÊ•O Ì”ƒ2̔̕O …<Í ÍQP*‚fÎÏ\"‚fÄÐ\"ƒdʉ•O̔̕OP‚f*‡" [match-data match-data ((store-match-data match-data)) reverse string-match "^\\([^:]+:\\)?\\(.*\\)$" name nil file acct 1 0 2 "/" error "name %s didn't match" "^/\\([^:]+:\\)/\\(.*\\)$"] 4]) (byte-code "À ž„\n BÀ‡" [mts ange-ftp-fix-name-func-alist (mts . ange-ftp-fix-name-for-mts)] 2) (defalias 'ange-ftp-fix-dir-name-for-mts #[(dir-name) "Á˜ƒ\nÂÃ!‡Ä!‰ŘƒÆ‚&ÇÈ\"ƒ%ÆP‚&)‡" [dir-name "/" error "Cannot get listing for fictitious \"/\" directory." ange-ftp-fix-name-for-mts "" "?" string-match ":$"] 4]) (byte-code "À ž„\n BÀ >„À BÄÅ!„ÆÅBƇ" [mts ange-ftp-fix-dir-name-func-alist (mts . ange-ftp-fix-dir-name-for-mts) ange-ftp-dumb-host-types boundp ange-ftp-mts-host-regexp nil current-load-list] 2) (defalias 'ange-ftp-mts-host #[(host) "…Á ÃŽÄ \"*‡" [ange-ftp-mts-host-regexp match-data match-data ((store-match-data match-data)) string-match host] 3]) (defalias 'ange-ftp-parse-mts-listing #[nil "À ebˆÂ ÄŽÅÇÈ#ƒ2LjÉÇxˆ`\nËÇxˆÌ`\n{Ç #ˆ)Íyˆ‚ *ÌÎÈ #ˆ )‡" [ange-ftp-make-hashtable tbl match-data match-data ((store-match-data match-data)) re-search-forward ange-ftp-date-regexp nil t " " end "-A-Z0-9_.!" ange-ftp-put-hash-entry 1 "."] 4]) (byte-code "À ž„\n BÀ‡" [mts ange-ftp-parse-list-func-alist (mts . ange-ftp-parse-mts-listing)] 2) #@49 Mark HOST as the name of a machine running MTS. (defalias 'ange-ftp-add-mts-host #[(host) "À !?…Âà !Ä …Æ °lj‡" [ange-ftp-mts-host host "^" regexp-quote "$" ange-ftp-mts-host-regexp "\\|" nil ange-ftp-host-cache] 5 (#$ . 85974) (list (read-string "Host: " (let ((name (or (buffer-file-name) default-directory))) (and name (car (ange-ftp-ftp-name name))))))]) (defalias 'ange-ftp-fix-name-for-cms #[(name &optional reverse) "À ÂŽ ƒÄ P‚ÆÇ \"ƒ~ ȉ•O Ê”ƒx ʔʕOË PÌ \"Ò#@ƒI‚tÌ \"Ò#‰@ƒe‚sÕ Ö× A##)+‚z )‚ØÙ!*‡" [match-data match-data ((store-match-data match-data)) reverse "/" name string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" 1 minidisk 2 "cd " ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user proc cmd file ange-ftp-raw-send-cmd ange-ftp-this-msg result ange-ftp-error format "cd to minidisk %s failed: %s" error "Invalid CMS filename"] 8]) (byte-code "À ž„\n BÀ >„À BÀ‡" [cms ange-ftp-fix-name-func-alist (cms . ange-ftp-fix-name-for-cms) ange-ftp-dumb-host-types] 2) (defalias 'ange-ftp-fix-dir-name-for-cms #[(dir-name) "Á˜ƒ\nÂÃ!‡ÄÅ\"ƒrƔƕOÈ \n\" ÌP Δƒ5ΔΕO‚6ÏÑ  \"@ƒG‚pÈ \n\" Ñ  \"‰@ƒa‚oÓ \nÔÕA##),‡ÂÖ!‡" [dir-name "/" error "Cannot get listing for fictitious \"/\" directory." string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" 1 minidisk ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user proc "cd " cmd 2 "*" file ange-ftp-raw-send-cmd result ange-ftp-error format "cd to minidisk %s failed: " "Invalid CMS file name"] 8]) (byte-code "À ž„\n BÀ‡" [cms ange-ftp-fix-dir-name-func-alist (cms . ange-ftp-fix-dir-name-for-cms)] 2) #@69 Regular expression to match hosts running the CMS operating system. (defvar ange-ftp-cms-host-regexp nil (#$ . 87668)) (defalias 'ange-ftp-cms-host #[(host) "…Á ÃŽÄ \"*‡" [ange-ftp-cms-host-regexp match-data match-data ((store-match-data match-data)) string-match host] 3]) #@38 Mark HOST as the name of a CMS host. (defalias 'ange-ftp-add-cms-host #[(host) "À !?…Âà !Ä …Æ °lj‡" [ange-ftp-cms-host host "^" regexp-quote "$" ange-ftp-cms-host-regexp "\\|" nil ange-ftp-host-cache] 5 (#$ . 87953) (list (read-string "Host: " (let ((name (or (buffer-file-name) default-directory))) (and name (car (ange-ftp-ftp-name name))))))]) (defalias 'ange-ftp-parse-cms-listing #[nil "À ebˆÂ ÄŽÅÆÇÈ#ƒ*Éʔʕ{Ë̔̕{QÇ #ˆÊyˆ‚ ÉËÈ #ˆ* )‡" [ange-ftp-make-hashtable tbl match-data match-data ((store-match-data match-data)) re-search-forward "^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t ange-ftp-put-hash-entry 1 "." 2] 5]) (byte-code "À ž„\n BÀ‡" [cms ange-ftp-parse-list-func-alist (cms . ange-ftp-parse-cms-listing)] 2) (defalias 'ange-ftp-cms-make-compressed-filename #[(name &optional reverse) "ÀÁ\n\"ƒÃ\nÄÅOD‡Æ\nÇPD‡" [string-match "-Z$" name nil 0 -2 t "-Z"] 4]) (byte-code "À ž„\n BÃÄ!‡" [cms ange-ftp-make-compressed-filename-alist (cms . ange-ftp-cms-make-compressed-filename) provide ange-ftp] 2) emacs-19.30/lisp/appt.elc100666 74777 1 21207 6040603565 13556 0ustar esrdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Mon Oct 16 21:30:55 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/appt.el ;;; emacs version 19.29.14. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`appt.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!‡" [require calendar provide appt] 2) #@141 *Non-nil means check for appointments in the diary buffer. To be detected, the diary entry must have the time as the first thing on a line. (defvar appt-issue-message t (#$ . -532)) #@65 *Time in minutes before an appointment that the warning begins. (defvar appt-message-warning-time 12 (#$ . -720)) #@46 *Non-nil means beep to indicate appointment. (defvar appt-audible t (#$ . -840)) #@58 *Non-nil means display appointment message in echo area. (defvar appt-visible t (#$ . -927)) #@74 *Non-nil means display minutes to appointment and time on the mode line. (defvar appt-display-mode-line t (#$ . -1026)) #@63 *Non-nil means display appointment message in another window. (defvar appt-msg-window t (#$ . -1152)) #@61 *The number of seconds an appointment message is displayed. (defvar appt-display-duration 10 (#$ . -1260)) #@129 *Non-nil means to display the next days diary on the screen. This will occur at midnight when the appointment list is updated. (defvar appt-display-diary t (#$ . -1374)) #@256 The list of appointments for today. Use `appt-add' and `appt-delete' to add and delete appointments from list. The original list is generated from the today's `diary-entries-list'. The number before each time/message is the time in minutes from midnight. (defvar appt-time-msg-list nil (#$ . 1552)) #@58 11:59pm in minutes - number of minutes in a day minus 1. (defconst max-time 1439 (#$ . 1857)) #@67 *Number of minutes to wait between checking the appointment list. (defvar appt-display-interval 3 (#$ . -1957)) #@34 Name of the appointments buffer. (defvar appt-buffer-name " *appt-buf*" (#$ . 2075)) #@48 Function called to display appointment window. (defvar appt-disp-window-function (quote appt-disp-window) (#$ . 2166)) #@58 Function called to remove appointment window and buffer. (defvar appt-delete-window-function (quote appt-delete-window) (#$ . 2291)) #@1671 Check for an appointment and update the mode line. Note: the time must be the first thing in the line in the diary for a warning to be issued. The format of the time can be either 24 hour or am/pm. Example: 02/23/89 18:00 Dinner Thursday 11:45am Lunch meeting. The following variables control the action of the notification: appt-issue-message If T, the diary buffer is checked for appointments. appt-message-warning-time Variable used to determine if appointment message should be displayed. appt-audible Variable used to determine if appointment is audible. Default is t. appt-visible Variable used to determine if appointment message should be displayed in the mini-buffer. Default is t. appt-msg-window Variable used to determine if appointment message should temporarily appear in another window. Mutually exclusive to appt-visible. appt-display-duration The number of seconds an appointment message is displayed in another window. appt-display-interval The number of minutes to wait between checking the appointments list. appt-disp-window-function Function called to display appointment window. You can customize appt.el by setting this variable to a function different from the one provided with this package. appt-delete-window-function Function called to remove appointment window and buffer. You can customize appt.el by setting this variable to a function different from the one provided with this package. This function is run from the loadst process for display time. Therefore, you need to have `(display-time)' in your .emacs file. (defalias 'appt-check #[nil "ÁU„Âà A@Ä¥\"ÅU…;ÆÇ ŠÊË ÌÍO!ÊË ÏÐO!Ä_\\‰ÁYƒZXƒZƒSƒSÕ ˆ‚ZÖÕ ˆ)…9…9@@@‰Z ƒ‘Wƒ‘A‰ƒq@@@‚qWƒ¯\\Vƒ¯TZ Ý X…8 ÅY…8ƒíßà!\"ˆ!ŔŕO\" @A@#ˆãäå&\"Ý'#ˆ‚(ƒûéê@A@\"ˆ+ƒìÁ!ˆ-ƒ+ßà!\"ˆ!ŔŕOî ïð°!ñò!ˆóÅ!ˆ ÅU…8A‰).‡" [appt-display-interval 1 mod current-time 60 0 -1 "" new-time min-to-app string-to-int current-time-string 11 13 cur-hour 14 16 cur-min cur-comp-time view-diary-entries-initially appt-display-diary diary appt-make-list diary-display-hook appt-issue-message appt-time-msg-list appt-comp-time appt-message-warning-time max-time nil appt-msg-window string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" display-time-string appt-disp-window-function run-at-time format "%d sec" appt-display-duration appt-delete-window-function appt-visible message "%s" appt-audible beep appt-display-mode-line "App't in " " min. " " " force-mode-line-update t sit-for] 6 (#$ . 2432)]) (defalias 'appt-disp-window #[(min-to-app new-time appt-msg) "ÀÁ!ˆÂ à šƒ&ÄÅ!ƒÆÄÅ!!ˆ‚&ƒ&ÈÉÅ!!ˆp\n  Ì !qÏ ˆÐÑ žAƒGÒ!ˆ‚OÓ ˆÔ!ˆÕ×Ù°Û!ˆÝÞß\"!ˆàá!ˆâã !ˆÆ !ˆ$…}åÅ!+‡" [require electric selected-window minibuffer-window other-window 1 select-window window-system select-frame other-frame this-buffer this-window get-buffer-create appt-buffer-name appt-disp-buf appt-select-lowest-window unsplittable frame-parameters display-buffer split-window pop-to-buffer "-------------------- Appointment in " min-to-app " minutes. " new-time " %-" mode-line-format insert-string appt-msg shrink-window-if-larger-than-buffer get-buffer-window t set-buffer-modified-p nil raise-frame selected-frame appt-audible beep] 5]) #@97 Function called to undisplay appointment messages. Usually just deletes the appointment buffer. (defalias 'appt-delete-window #[nil "À Â\"‰ƒÄÅ!ƒ ÅÆ !!=„Ç !ˆ)È !ˆ …*ÊË!‡" [get-buffer-window appt-buffer-name t window fboundp frame-root-window window-frame delete-window kill-buffer appt-audible beep 1] 5 (#$ . 5861)]) (defalias 'appt-select-lowest-window #[nil "À  AAA@Ä Æ…GÈ   !AAA@\n \nWƒ0\n Ë !ˆ  =ƒCË !ˆÌ*‚,‡" [selected-window lowest-window window-edges bottom-edge previous-window last-window t window-search next-window this-window next-bottom-edge select-window nil] 2]) #@120 Add an appointment for the day at TIME and issue MESSAGE. The time should be in either 24 hour format or am/pm format. (defalias 'appt-add #[(new-appt-time new-appt-msg) "ÀÁ\n\"„ ÃÄ!ˆ\nÅQÈ\n!C‰ CB\nË\f\nC\"\fÍ\f!‰\f+‡" [string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time error "Unacceptable time-string" " " new-appt-msg appt-time-string appt-convert-time appt-time time-msg append appt-time-msg-list appt-sort-list] 4 (#$ . 6480) "sTime (hh:mm[am/pm]): \nsMessage: "]) #@54 Delete an appointment from the list of appointments. (defalias 'appt-delete #[nil " ƒ* @ÃÄ\nA@!ÅQÇ! Aƒ&É\n\"+‚ÊË!)‡" [appt-time-msg-list tmp-msg-list element "Delete " prin1-to-string " from list? " prompt-string y-or-n-p test-input delq message ""] 3 (#$ . 6985) nil]) (defalias 'appt-make-list #[nil "ÀÁ C\nC\"?…ÀÁ CÃ\n‰‰AA@)S\f‰‰@)\f‰A@)\f‰AA@)SÉ_\\\nËVƒx\nÌ_Í\\Î¥Z\n‰̦ÏU…oЦÏU?†oѦÏU)ƒx\nT\n\n- Ò_ Ì¥ Ð¥[ Ñ¥\\\\\\\\*\\!C\"…ŠÔƒ8׉ƒ¾À@Á C\"ƒ¾A‰„ªƒ7ÚÁ @@\"ƒ7Û@A!ËÜOÞß\"ƒ-ϔϕO Ï•GWƒÏ•á\\ÔO‚×Þâ\"ˆãϔϕO!C‰$ CB%æ%C\"+‚Ù)A‰„Ã*ç!èé êëO!,èé íîO!/,ð_/\\1@@@2…€21W…€A‰ƒ`@@@2‚`-‡" [calendar-date-compare calendar-current-date original-date calendar-gregorian-from-absolute date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 number nil appt-time-msg-list diary-entries-list "" new-time-string entry-list calendar-date-equal prin1-to-string -2 time-string string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?.*" appt-time-string 1 "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" appt-convert-time appt-time time-msg append appt-sort-list string-to-int current-time-string 11 13 cur-hour 14 16 cur-min 60 cur-comp-time appt-comp-time] 11]) (defalias 'appt-sort-list #[(appt-list) "À\nƒ:\n@‰@@\nA‰ƒ+\f @@@W„$ @‰@@ A‰„Æ C\"Ç \n\"+‚ )‡" [nil order-list appt-list element element-time tmp-list append delq] 4]) #@58 Convert hour:min[am/pm] format to minutes from midnight. (defalias 'appt-convert-time #[(time2conv) "À‰‰ÄÅ\"ˆÇÀ”È\\À•O!ÄÉ\"ˆÇÀ”À•O!ÄÊ\"ƒ@\nËWƒ@ÄÉ\"ˆ\nË\\\nÌ_ \\‰+‡" [0 min hr conv-time string-match ":[0-9][0-9]" time2conv string-to-int 1 "[0-9]?[0-9]:" "[p][m]" 12 60] 5 (#$ . 8476)]) (add-hook (quote display-time-hook) (quote appt-check)) emacs-19.30/lisp/apropos.elc100666 74777 1 25647 6054600354 14307 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 22 05:52:10 1995 ;;; from file /home/fsf/rms/e19/lisp/apropos.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`apropos.el' was compiled for Emacs 19.29 or later")) #@123 *Whether the apropos commands should do more. Slows them down more or less. Set this non-nil if you have a fast machine. (defvar apropos-do-all nil (#$ . -473)) #@113 *Face for symbol name in apropos output or `nil'. This looks good, but slows down the commands several times. (defvar apropos-symbol-face (byte-code "…Á‡" [window-system bold] 1) (#$ . -642)) #@120 *Face for keybinding display in apropos output or `nil'. This looks good, but slows down the commands several times. (defvar apropos-keybinding-face (byte-code "…Á‡" [window-system underline] 1) (#$ . -846)) #@282 *Face for label (Command, Variable ...) in apropos output or `nil'. If this is `nil' no mouse highlighting occurs. This looks good, but slows down the commands several times. When this is a face name, as it is initially, it gets transformed to a text-property list for efficiency. (defvar apropos-label-face (byte-code "…Á‡" [window-system italic] 1) (#$ . -1066)) #@115 *Face for property name in apropos output or `nil'. This looks good, but slows down the commands several times. (defvar apropos-property-face (byte-code "…Á‡" [window-system bold-italic] 1) (#$ . -1441)) #@135 *Face for matching part in apropos-documentation/value output or `nil'. This looks good, but slows down the commands several times. (defvar apropos-match-face (byte-code "…Á‡" [window-system highlight] 1) (#$ . -1657)) #@50 Local map active when displaying apropos output. (defvar apropos-local-map (byte-code "À  ÃÄ#ˆÂ ÅÆ#ˆÂ ÇÈ#ˆ )‡" [make-sparse-keymap map define-key " " apropos-follow [mouse-2] apropos-mouse-follow [down-mouse-2] nil] 4) (#$ . 1887)) #@37 Regexp used in current apropos run. (defvar apropos-regexp nil (#$ . 2127)) #@77 List of elc files already scanned in current run of `apropos-documentaion'. (defvar apropos-files-scanned nil (#$ . 2209)) #@56 Alist of symbols already found in current apropos run. (defvar apropos-accumulator nil (#$ . 2338)) #@45 Current item in or for apropos-accumulator. (defvar apropos-item nil (#$ . 2444)) (fset (quote command-apropos) (quote apropos-command)) #@151 Shows commands (interactively callable functions) that match REGEXP. With optional prefix ARG or if `apropos-do-all' is non-nil, also show variables. (defalias 'apropos-command #[(apropos-regexp &optional do-all) "ÀÁ!ÃÄ!)„È ƒÊ‚Ë\"\fÍÎÏÐ#…1 …1Å !)‡" [get-buffer-create "*Help*" standard-output print-help-return-message identity message do-all apropos-do-all apropos-internal apropos-regexp #[(symbol) "À !†  !‡" [commandp symbol user-variable-p] 2] commandp apropos-accumulator apropos-print t #[(p) "À‰ …N ‰@‰Ä !…'Å Æ\"‰ƒ&\nÇÈÉ\n\"O‚'Ê …CÌ !…CÍ ÎÆ#‰…C\nÇÈÉ\n\"OE ˆ A‰„À*‡" [nil symbol doc p commandp documentation t 0 string-match "\n" "(not documented)" do-all user-variable-p documentation-property variable-documentation] 9] nil] 4 (#$ . 2588) (list (read-string (concat "Apropos command " (if (or current-prefix-arg apropos-do-all) "or variable ") "(regexp): ")) current-prefix-arg)]) #@242 Show all bound symbols whose names match REGEXP. With optional prefix ARG or if `apropos-do-all' is non-nil, also show unbound symbols and key bindings, which is a little more time-consuming. Returns list of symbols and documentation found. (defalias 'apropos #[(apropos-regexp &optional do-all) "À \n?… ?… Ä\"Æ\n† ÇÈ#‡" [apropos-internal apropos-regexp do-all apropos-do-all #[(symbol) "À !† !†à !‡" [fboundp symbol boundp symbol-plist] 2] apropos-accumulator apropos-print #[(p) "À‰ …g ‰@‰Ä\n!…'Å\nÆ\"‰ƒ& ÇÈÉ \"O‚'ÊË\n!…BÌ\nÍÆ#‰ƒA ÇÈÉ \"O‚BÊÎ\n!‰…\\ GÏ¥‰Ð=ƒYÑ‚\\ ÒPF ˆ A‰„À*‡" [nil doc symbol p fboundp documentation t 0 string-match "\n" "(not documented)" boundp documentation-property variable-documentation symbol-plist 2 1 "1 property" " properties"] 9] nil] 4 (#$ . 3523) "sApropos symbol (regexp): \nP"]) #@234 Show all symbols whose value's printed image matches REGEXP. With optional prefix ARG or if `apropos-do-all' is non-nil, also looks at the function and at the names and values of properties. Returns list of symbols and values found. (defalias 'apropos-value #[(apropos-regexp &optional do-all) "„ ‰‰ÇÈ!ˆ+ɉÊ#‡" [do-all apropos-do-all nil apropos-accumulator p v f mapatoms #[(symbol) "ÀÀÀ\fÅ>„ÆÇ\fÈ# ƒ#ÆÊ\fË#Ì\fÍÎ# „/\n„/ …:\f \n FB‰‡" [nil f v p symbol (apropos-regexp do-all apropos-accumulator symbol f v p) apropos-value-internal boundp symbol-value do-all fboundp symbol-function apropos-format-plist "\n " t apropos-accumulator] 4] apropos-print t] 4 (#$ . 4375) "sApropos value (regexp): \nP"]) #@271 Show symbols whose names or documentation contain matches for REGEXP. With optional prefix ARG or if `apropos-do-all' is non-nil, also use documentation that is not stored in the documentation file and show key bindings. Returns list of symbols and documentation found. (defalias 'apropos-documentation #[(apropos-regexp &optional do-all) "„ ÂÂÅÆ!‰ ÊŽŠ qˆË ˆƒ'ÌÍ!ˆÎÂÏ#-‡" [do-all apropos-do-all nil apropos-accumulator apropos-files-scanned get-buffer-create " apropos-temp" v f standard-input ((kill-buffer standard-input)) apropos-documentation-check-doc-file mapatoms #[(symbol) "À ! ÃN‰¨?…\fÅÇ !\"„\"È\n!È\f!\n„*\f…R  žA‰\nƒH\nƒ>\n\n ˆ\f…R\nA\f ‡ \n\fE B‰ ‡" [apropos-safe-documentation symbol f variable-documentation v string-match apropos-regexp symbol-name apropos-documentation-internal apropos-accumulator apropos-item] 5] apropos-print t] 4 (#$ . 5116) "sApropos documentation (regexp): \nP"]) (defalias 'apropos-value-internal #[(predicate symbol function) " !…$ !!Ä \"…$ƒ#ÇȔȕÉ %ˆ ‡" [predicate symbol prin1-to-string function string-match apropos-regexp apropos-match-face put-text-property 0 face] 6]) (defalias 'apropos-documentation-internal #[(doc) ":ƒ\nÁ@!‡…( \"…(\fƒ'ÅƔƕÇ\fÈ!‰%ˆ‡" [doc apropos-documentation-check-elc-file string-match apropos-regexp apropos-match-face put-text-property 0 face copy-sequence] 7]) (defalias 'apropos-format-plist #[(pl sep &optional compare) "À !‰ ƒdÅÆ @ A@#ƒ\"È \f\"ƒ7\nƒ9ËÌÍ @!GÎ\n\f%ˆ‚9Â\fƒ\\ƒRƒRË̔̕Î\f%ˆ ‰…Y\fQ AA‰„\f *‡" [symbol-plist pl nil p-out p format "%s %S" compare string-match apropos-regexp apropos-property-face put-text-property 0 symbol-name face apropos-match-face sep] 7]) (defalias 'apropos-documentation-check-doc-file #[nil "À‰‰‰ÅP!ˆÈ ÀÊ#…‘Ë”`ÌÍ!ˆ`\nV„Î`Tf=ƒ4Ï‚5ÐÐuˆÑ \n`ZÏZ `ZÏZ`TÒÍÀÓ#ƒW`S‚X`{ ž‰„q À‰E‰Bƒ†\nËYƒ†Ø\n Ù%ˆ\f› ˆ‚,‡" [nil end beg symbol type insert-file-contents doc-directory internal-doc-file-name re-search-forward apropos-regexp t 0 search-backward "" 70 1 2 read search-forward move doc apropos-accumulator apropos-item apropos-match-face put-text-property face] 7]) (defalias 'apropos-documentation-check-elc-file #[(file) " ?…Ó‰‰‰‰‰ BÉ ˆÊ!ˆËÌÂÍ#…ÑÎ `` \\Ï\\Ð Í#ƒË bˆT ÒZ{Ó•ZÏZÓ”ZÏZÔÕ!ÖÂwˆÏuˆÎ ‰:ƒvA@‚x ƒ…×N‚Ø!ƒËÙ!ƒËž‰„«‰E‰Bƒ»Ý\fÞ%ˆ ƒÃÒ‚ÄÏ› ˆ bˆ‚!.‡" [file apropos-files-scanned nil this-is-a-variable end1 end beg doc symbol erase-buffer insert-file-contents search-forward "\n#@" t read 1 re-search-forward apropos-regexp 2 0 looking-at "(defvar\\|(defconst" "(a-z" variable-documentation fboundp apropos-safe-documentation apropos-accumulator apropos-item apropos-match-face put-text-property face] 7]) #@89 Like documentation, except it avoids calling `get_doc_string'. Will return nil instead. (defalias 'apropos-safe-documentation #[(function) "ƒ9ƒÁ!…K‰„¢Â=ƒ AÃ!ƒ3GÄV…^ÄH‚^¢Å=ƒ@Æ8‚^¢Ç=…^Æ8;ƒTÆ8‚^È8;…^È8‰¨?…f‡" [function fboundp macro byte-code-function-p 4 autoload 2 lambda 3] 3 (#$ . 7960)]) #@289 Output result of various apropos commands with `apropos-regexp'. APROPOS-ACCUMULATOR is a list. Optional DOC-FN is called for each element of apropos-accumulator and may modify it resulting in (symbol fn-doc var-doc [plist-doc]). Returns sorted list of symbols and documentation found. (defalias 'apropos-print #[(do-keys doc-fn spacing) "„\fÁ \"ˆ‚\fƒ\f!ˆÅÆ\"ƒ,9ƒ,ÈÉBBÊpˉ‰‰\f ŠqˆƒOÔÕ!cˆÔÖ!cˆ×!ˆ:…ƒko„kÚ ˆ@‰@A` Ü!ˆ`\fƒ¼Þ!ƒ¼ßàá\"ƒ¼Šqˆâ!)‰ƒ¹ã$ƒ±å‚²æç#‚ºècˆÚ ˆé \fÎêëAB!ƒÕ@‚×$ˆ,ƒèé \fÈ,$ˆíîáÞ!ƒöï‚ð!ƒñ‚ò$ˆíóôõ$ˆíö÷øË$ˆ‚Y.‘ˆË‡" [apropos-accumulator message "No apropos matches for `%s'" apropos-regexp doc-fn sort #[(a b) "@ @™‡" [a b] 2] apropos-label-face face (mouse-face highlight) "*Apropos*" nil point2 point1 item symbol old-buffer p standard-output window-system substitute-command-keys "Click \\\\[apropos-mouse-follow] to get full documentation.\n" "In this buffer, type \\\\[apropos-follow] to get full documentation.\n\n" use-local-map apropos-local-map spacing terpri apropos-item princ do-keys commandp indent-to 30 1 where-is-internal mapconcat apropos-keybinding-face #[(key) "À !Âà GÄ %ˆ ‡" [key-description key put-text-property 0 face apropos-keybinding-face] 6] key-description ", " "(not bound to any keys)" put-text-property eval or apropos-symbol-face apropos-print-doc describe-function "Command" apropos-macrop "Macro" "Function" describe-variable 2 "Variable" apropos-describe-plist 3 "Plist"] 9 (#$ . 8296)]) #@30 T if SYMBOL is a Lisp macro. (defalias 'apropos-macrop #[(symbol) "À !…! K‰:…! @Â=†! @Ã=…!Ä 8Å>‡" [fboundp symbol macro autoload 4 (macro t)] 2 (#$ . 9892)]) (defalias 'apropos-print-doc #[(action i str do-keys) " 8‰;…CÂcˆÃ`ÄZ`SÅ $ˆDZˆƒ/É`GZÄZ`S#ˆ\nƒ:Ë!‚;cˆn†CÌ ‡" [i apropos-item " " put-text-property 2 action str ": " apropos-label-face add-text-properties do-keys substitute-command-keys terpri] 5]) (defalias 'apropos-mouse-follow #[(event) "pÀÁ!=?…\npÃ\f‰A@)‰@)!qˆ\f‰A@)‰A@:ƒ. A@@‚1 A@)bˆÆ ˆÇ\n!)‡" [get-buffer "*Help*" other window-buffer event position undo-boundary apropos-follow] 4 nil "e"]) (defalias 'apropos-follow #[(&optional other) "`m„\fÀ`Á\"†o?…À`SÁ\"‰ „$ÆÇ!ˆ :ƒ/ÆÈ @\"ˆÉ`Ä\"‰ƒG XƒG Tbˆ ‚/À\f†Q †Q`Ä\"\nƒ\\\nqˆ !,‡" [get-text-property item nil action-point action point error "There is nothing to follow here" "There is nothing to follow in `%s'" next-single-property-change other] 4 nil nil]) #@45 Display a pretty listing of SYMBOL's plist. (defalias 'apropos-describe-plist #[(symbol) "À qˆÂÃ!ˆÄ !ˆÂÆ!ˆƒ ÈÉ`ÊZË$ˆÌ Í\"cˆÂÎ!‘‡" ["*Help*" standard-output princ "Symbol " prin1 symbol "'s plist is\n (" apropos-symbol-face put-text-property 8 14 face apropos-format-plist "\n " ")"] 6 (#$ . 10867)]) emacs-19.30/lisp/arc-mode.elc100666 75424 12 103247 6052010576 14365 0ustar kwzhstaff;ELC ;;; compiled by roland@snoopy.gnu.ai.mit.edu on Mon Nov 13 23:49:52 1995 ;;; from file /usr/src/emacs-build/lisp/arc-mode.el ;;; emacs version 19.29.91.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`arc-mode.el' was compiled for Emacs 19.29 or later")) #@72 *If non-nil then recognize member files using ^M^J as line terminator. (defvar archive-dos-members t (#$ . -482)) #@52 *Directory for temporary files made by arc-mode.el (defvar archive-tmpdir (byte-code "ÀÁ\nÃ=ƒ\fÄ‚ Å!ÆÇ!†ÆÈ!†É\"‡" [expand-file-name make-temp-name system-type ms-dos "ar" "archive.tmp" getenv "TMPDIR" "TMP" "/tmp"] 4) (#$ . -602)) #@186 *Regexp recognizing archive files names that are not local. A non-local file is one whose file name is not proper outside Emacs. A local copy of the archive will be used when updating. (defvar archive-remote-regexp "^/[^/:]*[^/:.]:" (#$ . -846)) #@58 *Hooks to run when an archive member has been extracted. (defvar archive-extract-hooks nil (#$ . -1098)) #@164 *Program and its options to run in order to extract an arc file member. Extraction should happen to the current directory. Archive and member name will be added. (defvar archive-arc-extract (quote ("arc" "x")) (#$ . -1210)) #@110 *Program and its options to run in order to delete arc file members. Archive and member names will be added. (defvar archive-arc-expunge (quote ("arc" "d")) (#$ . -1442)) #@111 *Program and its options to run in order to update an arc file member. Archive and member name will be added. (defvar archive-arc-write-file-member (quote ("arc" "u")) (#$ . -1620)) #@158 *Program and its options to run in order to extract an lzh file member. Extraction should happen to standard output. Archive and member name will be added. (defvar archive-lzh-extract (quote ("lha" "pq")) (#$ . -1809)) #@110 *Program and its options to run in order to delete lzh file members. Archive and member names will be added. (defvar archive-lzh-expunge (quote ("lha" "d")) (#$ . -2036)) #@111 *Program and its options to run in order to update an lzh file member. Archive and member name will be added. (defvar archive-lzh-write-file-member (quote ("lha" "a")) (#$ . -2214)) #@100 *If non-nil then pkzip option are used instead of zip options. Only set to true for msdog systems! (defvar archive-zip-use-pkzip (memq system-type (quote (ms-dos windows-nt))) (#$ . -2403)) #@287 *Program and its options to run in order to extract a zip file member. Extraction should happen to standard output. Archive and member name will be added. If `archive-zip-use-pkzip' is non-nil then this program is expected to extract to a file junking the directory part of the name. (defvar archive-zip-extract (byte-code "ƒÁ‡Â‡" [archive-zip-use-pkzip ("pkunzip" "-e") ("unzip" "-qq" "-c")] 1) (#$ . -2600)) #@110 *Program and its options to run in order to delete zip file members. Archive and member names will be added. (defvar archive-zip-expunge (byte-code "ƒÁ‡Â‡" [archive-zip-use-pkzip ("pkzip" "-d") ("zip" "-d" "-q")] 1) (#$ . -3022)) #@189 *Program and its options to run in order to update a zip file member. Options should ensure that specified directory will be put into the zip file. Archive and member name will be added. (defvar archive-zip-update (byte-code "ƒÁ‡Â‡" [archive-zip-use-pkzip ("pkzip" "-u") ("zip" "-q")] 1) (#$ . -3262)) #@196 *Program and its options to run in order to update a case fiddled zip member. Options should ensure that specified directory will be put into the zip file. Archive and member name will be added. (defvar archive-zip-update-case (byte-code "ƒ ‡Â‡" [archive-zip-use-pkzip archive-zip-update ("zip" "-q" "-k")] 1) (#$ . -3575)) #@147 *If non-nil then zip file members are case fiddled. Case fiddling will only happen for members created by a system that uses caseless file names. (defvar archive-zip-case-fiddle t (#$ . -3909)) #@157 *Program and its options to run in order to extract a zoo file member. Extraction should happen to standard output. Archive and member name will be added. (defvar archive-zoo-extract (quote ("zoo" "xpq")) (#$ . -4110)) #@110 *Program and its options to run in order to delete zoo file members. Archive and member names will be added. (defvar archive-zoo-expunge (quote ("zoo" "DqPP")) (#$ . -4337)) #@110 *Program and its options to run in order to update a zoo file member. Archive and member name will be added. (defvar archive-zoo-write-file-member (quote ("zoo" "a")) (#$ . -4518)) #@34 *Symbol describing archive type. (defvar archive-subtype nil (#$ . -4705)) #@35 *Position of first contents line. (defvar archive-file-list-start nil (#$ . -4786)) #@42 *Position just after last contents line. (defvar archive-file-list-end nil (#$ . -4876)) #@36 *Position of real archive's start. (defvar archive-proper-file-start nil (#$ . -4971)) #@47 *Non-nil if the archive is read-only on disk. (defvar archive-read-only nil (#$ . -5064)) #@49 *Non-nil if the archive is outside file system. (defvar archive-remote nil (#$ . -5160)) #@40 *Name of local copy of remote archive. (defvar archive-local-name nil (#$ . -5255)) #@42 *Local keymap for archive mode listings. (defvar archive-mode-map nil (#$ . -5345)) #@33 *Column where file names start. (defvar archive-file-name-indent nil (#$ . -5435)) #@47 *Non-nil when alternate information is shown. (defvar archive-alternate-display nil (#$ . -5524)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local archive-alternate-display put permanent-local t] 4) #@41 *In archive members, points to archive. (defvar archive-superior-buffer nil (#$ . -5732)) (put (quote archive-superior-buffer) (quote permanent-local) t) #@37 *Non-nil in archive member buffers. (defvar archive-subfile-mode nil (#$ . -5892)) (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅÆ!„4ÅÆ!„ÇÆBÂÆÉÊ#ˆÀÆ!ˆÂÆÃÄ#ˆËÆÇ\"ˆÇ‡" [make-variable-buffer-local archive-subfile-mode put permanent-local t boundp buffer-file-type nil current-load-list variable-documentation "*Nil for dos-style text file, non-nil otherwise." set-default] 4) #@43 Negation of `buffer-file-type' which see. (defvar archive-subfile-dos nil (#$ . 6257)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local archive-subfile-dos put permanent-local t] 4) #@113 Vector of file descriptors. Each descriptor is a vector of [ext-file-name int-file-name case-fiddled mode ...] (defvar archive-files nil (#$ . 6449)) (make-variable-buffer-local (quote archive-files)) #@58 *Non-nil when running under under Lucid Emacs or Xemacs. (defvar archive-lemacs (string-match "\\(Lucid\\|Xemacs\\)" emacs-version) (#$ . -6657)) (defalias 'archive-name #[(suffix) "ÀÁ !Ä R!‡" [intern "archive-" symbol-name archive-subtype "-" suffix] 5]) (put (quote archive-name) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@187 Convert little endian string/vector to integer. Alternatively, first argument may be a buffer position in the current buffer in which case a second argument, length, should be supplied. (defalias 'archive-l-e #[(str &optional len) ";ƒ G‚‰ \\{‰ Wƒ, TÅ\fÆ\" ZH\\‚\f*‡" [str len 0 i result ash 8] 4 (#$ . 7006)]) #@74 Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------ (defalias 'archive-int-to-mode #[(mode) "ÀÁÂ\"ÄÅÆ\"!„ ÈÉIˆÄÅÊ\"!„# ÈËIˆÄÅÌ\"!„2 ÍÎIˆÄÅÏ\"!„A ÐÑIˆÄÅÒ\"!„P ÓÔIˆÄÅÕ\"!„_ ÖÎIˆÄÅ×\"!„n ØÑIˆÄÅÙ\"!„} ÚÔIˆÄÅÖ\"!„Œ ÛÎIˆÄÅÐ\"!„› ÙÑIˆÄÅÍ\"!„ª ÜÔIˆÄÅÝ\"!„Ç ÓÅÒ\"ÈUƒÄÞ‚ÅßIˆÄÅà\"!„ä ÚÅÙ\"ÈUƒáÞ‚âßIˆ )‡" [make-string 10 45 str zerop logand 16384 mode 0 100 8192 99 256 1 114 128 2 119 64 3 120 32 4 16 5 8 6 7 9 1024 83 115 2048] 5 (#$ . 7341)]) #@461 From the integer OLDMODE and the string NEWMODE calculate a new file mode. NEWMODE may be an octal number including a leading zero in which case it will become the new mode. NEWMODE may also be a relative specification like "og-rwx" in which case OLDMODE will be modified accordingly just like chmod(2) would have done. If optional third argument ERROR is non-nil an error will be signaled if the mode is invalid. If ERROR is nil then nil will be returned. (defalias 'archive-calc-mode #[(oldmode newmode &optional error) "ÀÁ\n\"ƒ6Ã\nGÄ Wƒ+ÈÉ\"\n H\\Ê\\ T‰‚ËÌ Î\"\"+‡ÀÏ\n\"ƒÃ \nДHÃÉ” É•Wƒ\n HËÕUƒjÖ‚“×UƒuØ‚“ÙUƒ€Ú‚“ÛUƒ‹Ü‚“ÝU…“Þ\" T)‚PÄ•Wƒ\nH‰àUƒµá‚ÓâUƒÀã‚ÓäUƒËå‚ÓæU…Óç(éUƒæÌê(!\"ëUƒþÌêÌ(\"!\"‚\nËÌ(\"\"*T‰‚Ÿ-‡,…!ìí\n\"‡" [string-match "^0[0-7]*$" newmode 0 1 i len result lsh 3 -48 logior logand oldmode 65024 "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" 2 bits op who rwx 114 292 119 146 120 73 115 3072 116 512 whoc 97 4095 117 1472 103 2104 111 7 whomask 61 lognot 45 error "Invalid mode specification: %s"] 7 (#$ . 7853)]) #@35 Stringify dos packed DATE record. (defalias 'archive-dosdate #[(date) "ÀÁ\nÃ\"Ä\"Å\\ÀÁ\nÆ\"Ç\"À\nÈ\" \n \nÌV„(\nÍWƒ,΂8ÏÐ Ñ\nSH $+‡" [logand ash date -9 127 1980 -5 15 31 day month year 12 1 "" format "%2d-%s-%d" ["Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]] 5 (#$ . 9006)]) #@35 Stringify dos packed TIME record. (defalias 'archive-dostime #[(time) "ÀÁ\nÃ\"Ä\"ÀÁ\nÅ\"Æ\"À\nÄ\"Ç_ \nËÌ\n $+‡" [logand ash time -11 31 -5 53 2 second minute hour format "%02d:%02d:%02d"] 5 (#$ . 9327)]) (defalias 'archive-get-lineno #[nil "`YƒÁŠÂyˆ`)\"‡Â‡" [archive-file-list-start count-lines 0] 3]) #@122 Return the descriptor vector for file at point. Does not signal an error if optional second argument NOERROR is non-nil. (defalias 'archive-get-descr #[(&optional noerror) "À `\nYƒ+ GWƒ+ HÅ\f!ƒ\f‚'?…'ÇÈ!)‚4?…4ÇÉ!)‡" [archive-get-lineno no archive-file-list-start archive-files item vectorp noerror error "Entry is not a regular member of the archive" "Line does not describe a member of the archive"] 2 (#$ . 9648)]) #@455 Major mode for viewing an archive file in a dired-like way. You can move around using the usual cursor motion commands. Letters no longer insert themselves. Type `e' to pull a file out of the archive and into its own buffer; or click mouse-2 on the file's line in the archive mode buffer. If you edit a sub-file of this archive (as with the `e' command) and save it, the contents of that buffer will be saved back into the archive. \{archive-mode-map} (defalias 'archive-mode #[(&optional force) "À ÁUƒ\n\n ‡ ?…\f?…­Å ÇÈ!!‰ Á ÁH–IˆÊ ˆËÌ!ˆ\fËÍ!ˆÎ ÏÁ!ˆËÐ!ˆÑÐÒ\"ˆËÓ!ˆÔËÕ!ˆÔÖËØ!ˆÙÚ !?ËÛ!ˆËÜ!ˆÝÚ \"ß  áP\"ãä%æçÈ\f!è%R!)é\"ˆê+!ˆ*Ëì!ˆËí!ˆËî!ˆËï!ˆð ˆÖ‰1‡" [buffer-size 0 default-major-mode force archive-files archive-find-type type copy-sequence symbol-name typename kill-all-local-variables make-local-variable archive-subtype revert-buffer-function archive-mode-revert auto-save-mode local-write-file-hooks add-hook archive-write-file require-final-newline nil enable-local-variables t buffer-file-type archive-read-only file-writable-p buffer-file-name archive-local-name archive-remote string-match archive-remote-regexp archive-mode major-mode "-Archive" mode-name run-hooks "mode-hook" suffix intern "archive-" "-" archive-mode-hook use-local-map archive-mode-map archive-proper-file-start archive-file-list-start archive-file-list-end archive-file-name-indent archive-summarize buffer-read-only] 7 (#$ . 10088)]) (byte-code "ÀÁÂÃ#ˆ\f„ßÅ Æ\f!ˆÇ\fÈÉ#ˆÇ\fÊË#ˆÇ\fÌÍ#ˆÇ\fÎÍ#ˆÇ\fÏÐ#ˆÇ\fÑÐ#ˆÇ\fÒÐ#ˆÇ\fÓÔ#ˆÇ\fÕÖ#ˆÇ\f×Ø#ˆÇ\fÙÉ#ˆÇ\fÚÉ#ˆÇ\fÛÉ#ˆÇ\fÜÝ#ˆÇ\fÞß#ˆÇ\fàß#ˆÇ\fáß#ˆÇ\fâã#ˆÇ\fäå#ˆÇ\fæç#ˆÇ\fèé#ˆÇ\fêë#ˆÇ\fìí#ˆÇ\fîÝ#ˆÇ\fïð#ˆÇ\fñò#ˆÇ\fóô#ˆ5ƒÇÇ\fö÷#ˆÇ\fø÷#ˆ‚Ïùú÷\f;$ˆÇ\f5ƒÚü‚Ûýþ#ˆ5„ßÇ\fÿ@#ˆÇ\fABCB!B#ˆÇ\fDE#ˆÀËFG#ˆÇ\fHI#ˆÇ\fJK#ˆÇ\fLM#ˆÇ\fNO#ˆÇ\fPQCQ!B#ˆÇ\fRS#ˆÇ\fTU#ˆÇ\fVW#ˆÇ\fXY#ˆÇ\fZ[C[!B#ˆÇ\f\\]#ˆÀôF^#ˆÇ\f_`#ˆÀòFa#ˆÇ\fbc#ˆÀðFd#ˆÇ\fef#ˆÀãFg#ˆÇ\fhi#ˆjklmno>ƒøkC‚ýkmDpkq„rpq\"q+À‡" [put archive-mode mode-class special archive-mode-map make-keymap suppress-keymap define-key " " archive-next-line "a" archive-alternate-display "d" archive-flag-deleted "" "e" archive-extract "f" " " "g" revert-buffer "h" describe-mode "m" archive-mark "n" "" [down] "o" archive-extract-other-window "p" archive-previous-line "" [up] "r" archive-rename-entry "u" archive-unflag "ÿ" archive-unmark-all-files "v" archive-view "x" archive-expunge "" archive-unflag-backwards "E" "M" archive-chmod-entry "G" archive-chgrp-entry "O" archive-chown-entry archive-lemacs "u" archive-undo "" substitute-key-definition undo global-map button2 [mouse-2] archive-mouse-extract [menu-bar edit] undefined [menu-bar immediate] "Immediate" make-sparse-keymap [menu-bar immediate alternate] ("Alternate Display" . archive-alternate-display) menu-enable (boundp (archive-name "alternate-display")) [menu-bar immediate view] ("View This File" . archive-view) [menu-bar immediate display] ("Display in Other Window" . archive-display-other-window) [menu-bar immediate find-file-other-window] ("Find in Other Window" . archive-extract-other-window) [menu-bar immediate find-file] ("Find This File" . archive-extract) [menu-bar mark] "Mark" [menu-bar mark unmark-all] ("Unmark All" . archive-unmark-all-files) [menu-bar mark deletion] ("Flag" . archive-flag-deleted) [menu-bar mark unmark] ("Unflag" . archive-unflag) [menu-bar mark mark] ("Mark" . archive-mark) [menu-bar operate] "Operate" [menu-bar operate chown] ("Change Owner..." . archive-chown-entry) (fboundp (archive-name "chown-entry")) [menu-bar operate chgrp] ("Change Group..." . archive-chgrp-entry) (fboundp (archive-name "chgrp-entry")) [menu-bar operate chmod] ("Change Mode..." . archive-chmod-entry) (fboundp (archive-name "chmod-entry")) [menu-bar operate rename] ("Rename to..." . archive-rename-entry) (fboundp (archive-name "rename-entry")) [menu-bar operate expunge] ("Expunge Marked Files" . archive-expunge) (archive-subfile-mode " Archive") item1 (archive-subfile-dos " Dos") item2 system-type (ms-dos windows-nt) items minor-mode-alist append] 6) (defalias 'archive-find-type #[nil "~ˆebˆÀÂÃ!ƒÄ‚?ÂÅ!ƒÆ‚?ÂÇ!ƒ%È‚?ÂÉ!ƒ<ÊË\f†4Í \"ƒ<΂?ÏÐ!)‡" [nil case-fold-search looking-at "[P]K" zip "..-l[hz][0-9]-" lzh "....................[Ü]§Äý" zoo "" string-match "\\.[aA][rR][cC]$" buffer-file-name buffer-name arc error "Buffer format not recognized."] 3]) #@205 Parse the contents of the archive file in the current buffer. Place a dired-like listing on the front; then narrow to it, so that only that listing is visible (and the real data of the buffer is hidden). (defalias 'archive-summarize #[nil "~ˆÀÂÃ!ˆÄp!ˆÅÇÈÉ\n!ËR!) \fÂÍ!ˆÎ e`}ˆÐÀ!ˆÑ ˆ)bˆÓÔ!‡" [nil buffer-read-only message "Parsing archive file..." buffer-disable-undo "summarize" suffix intern "archive-" symbol-name archive-subtype "-" archive-files "Parsing archive file...done." point-marker archive-proper-file-start set-buffer-modified-p buffer-enable-undo archive-file-list-start archive-next-line 0] 5 (#$ . 14571)]) #@46 Recreate the contents listing of an archive. (defalias 'archive-resummarize #[nil "À Á Â~ˆe|ˆÇ ˆÈ !ˆ bˆÊ\f!+‡" [buffer-modified-p archive-get-lineno nil buffer-read-only no modified archive-proper-file-start archive-summarize set-buffer-modified-p archive-file-list-start archive-next-line] 3 (#$ . 15211)]) #@73 Insert a desciption of a list of files annotated with proper mouse face (defalias 'archive-summarize-files #[(files) "À \nƒ\n@ÃH‚ÄÆÇÈÉ\n\"\"cˆÀ ‰\n‡" [point-marker archive-file-list-start files 1 0 archive-file-name-indent apply concat mapcar #[(fil) "ÁHÂP\f„ÅÆHÇHÈÉ %ˆ )‡" [fil 0 "\n" text archive-lemacs put-text-property 1 2 mouse-face highlight] 6] archive-file-list-end] 5 (#$ . 15531)]) #@167 Toggle alternative display. To avoid very long lines some archive mode don't show all information. This function changes the set of information shown for each files. (defalias 'archive-alternate-display #[nil "?Á ‡" [archive-alternate-display archive-resummarize] 1 (#$ . 15944) nil]) (defalias 'archive-maybe-copy #[(archive) "ƒ$dÂÃ\f! \"Ç È\"ˆŒ~ˆÉ dÊË%ˆ))‡Ì ƒ,Í ˆ\f‡" [archive-remote start expand-file-name file-name-nondirectory archive archive-tmpdir archive-local-name make-directory t write-region nil nomessage buffer-modified-p save-buffer] 6]) (defalias 'archive-maybe-update #[(unchanged) "…5  Ã„È ˆÉ!ˆÊË!ˆÌ!ˆ„+ÍÎ!ˆÏ †3?!+‡" [archive-remote archive-local-name buffer-modified-p nil buffer-read-only modified name unchanged erase-buffer insert-file-contents archive-mode t archive-delete-local message "Archive file must be saved for changes to take effect" set-buffer-modified-p] 3]) #@72 Delete file NAME and its parents up to and including `archive-tmpdir'. (defalias 'archive-delete-local #[(name) "ÀÁ !!ÆÇȈ …,ÁÉ\n!!\nÆË̈\n\f˜ƒ Ɖ„Æ*‡" [t directory-file-name file-name-as-directory archive-tmpdir top again nil (delete-file name) ((error)) file-name-directory name (delete-directory name) ((error))] 5 (#$ . 16877)]) #@41 Extract a file whose name you click on. (defalias 'archive-mouse-extract #[(event) "À !ˆÂŠÃ ˆp)!‡" [mouse-set-point event switch-to-buffer archive-extract] 2 (#$ . 17229) "e"]) #@73 In archive mode, extract this entry of the archive into its own buffer. (defalias 'archive-extract #[(&optional other-window-p) "Á=à ‰ÅH\fÇHp \n Ì  Î !Î!ÐÑRÓÕÖ×!ÙR!)†D\nÝ!ß „éá ! â!ã ŠqˆäåQ!\fæ\f!' \nèé!ˆ )èê!ˆëêì\"ˆ\f-ß.ã/ð!ƒ¨ \"ˆ‚²ñ J#ˆ2ƒºó ˆebˆô!ˆ5ß6÷ß!ˆø 9ú ˆ;ü=ƒÞã=þÿ!ˆ)@ã!ˆ\nƒA!ˆ …&B‰C‚&D=ƒE!‚&ƒ F!‚&G!. ‡" [other-window-p view view-p archive-get-descr descr 0 ename 1 iname archive-buffer default-directory arcdir buffer-file-name archive file-name-nondirectory arcname " (" ")" bufname "extract" suffix intern "archive-" symbol-name archive-subtype "-" extractor archive-read-only read-only-p get-buffer buffer nil just-created archive-maybe-copy get-buffer-create t expand-file-name ":" abbreviate-file-name buffer-file-truename make-local-variable archive-superior-buffer local-write-file-hooks add-hook archive-write-file-member archive-subfile-mode archive-subfile-dos buffer-file-type fboundp archive-*-extract archive-dos-members archive-check-dos rename-buffer buffer-read-only buffer-undo-list set-buffer-modified-p buffer-size buffer-saved-size normal-mode major-mode archive-mode archive-remote run-hooks archive-extract-hooks archive-maybe-update view-buffer kill-buffer view-exit-action display display-buffer switch-to-buffer-other-window switch-to-buffer] 6 (#$ . 17412) nil]) (defalias 'archive-*-extract #[(archive name command) "À !ÃÄ !\n\"ÇÈ\n!É\"ˆÊË\f@͉‰Î\fA D\"&ˆÐ!ˆÑ!*‡" [file-name-as-directory archive-tmpdir default-directory expand-file-name file-name-nondirectory name tmpfile make-directory directory-file-name t apply call-process command nil append archive insert-file-contents archive-delete-local] 10]) (defalias 'archive-extract-by-stdout #[(archive name command) "ÀÂÃ\f@ÅÀÅÆ\fAD\"&)‡" [t binary-process-output apply call-process command nil append archive name] 10]) #@54 In archive mode, find this member in another window. (defalias 'archive-extract-other-window #[nil "ÀÁ!‡" [archive-extract t] 2 (#$ . 19369) nil]) #@57 In archive mode, display this member in another window. (defalias 'archive-display-other-window #[nil "ÀÁ!‡" [archive-extract display] 2 (#$ . 19522) nil]) #@48 In archive mode, view the member on this line. (defalias 'archive-view #[nil "ÀÁ!‡" [archive-extract view] 2 (#$ . 19684) nil]) #@61 Add current buffer to the archive in ARCBUF naming it NAME. (defalias 'archive-add-new-member #[(arcbuf name) "Šqˆ Â=„ÃÄ!ˆ ƒÃÆ!ˆ)p=ƒ!ÃÇ!ˆɘƒ,ÃÊ!ˆŠqˆË\fÍÎÏ!Ñ\fR!*pÔ!ƒ\\Šqˆ#)‚_ÃÖ!*‡" [arcbuf major-mode archive-mode error "Buffer is not an archive buffer" archive-read-only "Archive is read-only" "An archive buffer cannot be added to itself" name "" "Archive members may not be given empty names" "add-new-member" suffix intern "archive-" symbol-name archive-subtype "-" membuf func fboundp buffer-file-name "Adding a new member is not supported for this archive type"] 5 (#$ . 19818) (list (get-buffer (read-buffer "Buffer containing archive: " (let ((bufs (buffer-list))) (while (and bufs (not (eq (save-excursion (set-buffer (car bufs)) major-mode) (quote archive-mode)))) (setq bufs (cdr bufs))) (if bufs (car bufs) (error "There are no archive buffers"))) t)) (read-string "File name in archive: " (if buffer-file-name (file-name-nondirectory buffer-file-name) "")))]) #@55 *Possibly handle a buffer with ^M^J terminated lines. (defalias 'archive-check-dos #[(&optional force) "Œ~ˆŠebˆ†ÁÂÃÄ#?‰? …<Ç Ép!ˆebˆÊËÃÄ#ƒ4ÌÍ!ˆ‚%Î ˆÏ!)*‡" [force search-forward-regexp "[^ ]\n" nil t archive-subfile-dos buffer-file-type buffer-modified-p modified buffer-disable-undo search-forward " \n" replace-match "\n" buffer-enable-undo set-buffer-modified-p] 5 (#$ . -20828)]) (defalias 'archive-write-file-member #[nil "ƒ+Œ~ˆŠebˆ ÃŽÄÅÆÇÄ#ƒ ÈÉ!ˆ‚ÇÄ\nË ˆ,ćŠŒÌÍ!ˆ~ˆŠqˆÏÑÒÓ!ÕR!*ŠqˆÖ )Ù!ƒe\"ˆ‚oÛJ#ˆ*ÜÇ!ˆÌÝ!ˆqˆÞ ˆ*ć" [archive-subfile-dos buffer-undo-list undo-list ((byte-code "ÀÁ!ˆ\nÀ‡" [archive-check-dos t undo-list buffer-undo-list] 2)) t search-forward "\n" nil replace-match " \n" buffer-file-type archive-write-file-member message "Updating archive..." archive-superior-buffer "write-file-member" suffix intern "archive-" symbol-name archive-subtype "-" buffer-file-name archive writer fboundp archive-subfile-mode archive-*-write-file-member set-buffer-modified-p "Updating archive...done" revert-buffer] 5]) (defalias 'archive-*-write-file-member #[(archive descr command) "ÁHÃ\n\f\"ÆÇ\f!!Ç! ÊŽËÌ !Í\"ˆÎed ÏÐ%ˆÑHƒ7Ò ÓÑHÔ\"\"ˆÕÖ@ω‰ØA\nD\"&‰Áš?…XÛÜ\".‡" [descr 0 ename expand-file-name archive-tmpdir tmpfile directory-file-name file-name-as-directory top default-directory ((archive-delete-local tmpfile)) make-directory file-name-directory t write-region nil nomessage 3 set-file-modes logior 256 apply call-process command append archive exitcode error "Updating was unsuccessful (%S)"] 11]) (defalias 'archive-write-file #[nil "ŠÀ d\nÃÄ%ˆÅÃ!ˆ)ć" [write-region archive-proper-file-start buffer-file-name nil t set-buffer-modified-p] 6]) #@113 In archive mode, mark this member to be deleted from the archive. With a prefix argument, mark that many files. (defalias 'archive-flag-deleted #[(p &optional type) "„ÁÂyˆ ÂYƒÄ‚ÅÆ Ç \n ÂU„=ËÌ!ƒ0ÍÄ!ˆcˆ\nyˆ \nZ‰‚Î !ˆ+ÏÂ!‡" [type 68 0 p 1 -1 buffer-modified-p nil buffer-read-only modified sign archive-get-descr t delete-char set-buffer-modified-p archive-next-line] 4 (#$ . 22566) "p"]) #@126 In archive mode, un-mark this member if it is marked to be deleted. With a prefix argument, un-mark that many files forward. (defalias 'archive-unflag #[(p) "À Â\"‡" [archive-flag-deleted p 32] 3 (#$ . 22980) "p"]) #@129 In archive mode, un-mark this member if it is marked to be deleted. With a prefix argument, un-mark that many members backward. (defalias 'archive-unflag-backwards #[(p) "À [Â\"‡" [archive-flag-deleted p 32] 3 (#$ . 23202) "p"]) #@19 Remove all marks. (defalias 'archive-unmark-all-files #[nil "À ÁŠ\fbˆ` Wƒ\"gÆU„ÇÈ!ˆÆcˆÈyˆ‚ )É !*‡" [buffer-modified-p nil buffer-read-only modified archive-file-list-start archive-file-list-end 32 delete-char 1 set-buffer-modified-p] 2 (#$ . 23437) nil]) #@158 In archive mode, mark this member for group operations. With a prefix argument, mark that many members. Use \[archive-unmark-all-files] to remove all marks. (defalias 'archive-mark #[(p) "À Â\"‡" [archive-flag-deleted p 42] 3 (#$ . 23705) "p"]) (defalias 'archive-get-marked #[(mark &optional default) "ÀŠ\nbˆ` Wƒg\fUƒÅ BÆyˆ‚) Ÿ†+…+Å C)‡" [nil files archive-file-list-start archive-file-list-end mark archive-get-descr 1 default] 2]) (defalias 'archive-next-line #[(p) "yˆm† u‡" [p archive-file-name-indent] 1 nil "p"]) (defalias 'archive-previous-line #[(p) "À [!‡" [archive-next-line p] 2 nil "p"]) #@190 Change the protection bits associated with all marked or this member. The new protection bits can either be specified as an octal number or as a relative change like "g+rw" as for chmod(2) (defalias 'archive-chmod-entry #[(new-mode) "ƒÁÂ!ˆÃÅÆÇ!É\fR!)\nË\n!ƒ-\n\fÍÎÏ\"\"ˆÐ ‚0ÁÑ!)‡" [archive-read-only error "Archive is read-only" "chmod-entry" suffix intern "archive-" symbol-name archive-subtype "-" func fboundp new-mode archive-get-marked 42 t archive-resummarize "Setting mode bits is not supported for this archive type"] 5 (#$ . 24329) "sNew mode (octal or relative): "]) #@48 Change the owner of all marked or this member. (defalias 'archive-chown-entry #[(new-uid) "ƒÁÂ!ˆÃÅÆÇ!É\fR!)\nË\n!ƒ-\n\fÍÎÏ\"\"ˆÐ ‚0ÁÑ!)‡" [archive-read-only error "Archive is read-only" "chown-entry" suffix intern "archive-" symbol-name archive-subtype "-" func fboundp new-uid archive-get-marked 42 t archive-resummarize "Setting owner is not supported for this archive type"] 5 (#$ . 24924) "nNew uid: "]) #@48 Change the group of all marked or this member. (defalias 'archive-chgrp-entry #[(new-gid) "ƒÁÂ!ˆÃÅÆÇ!É\fR!)\nË\n!ƒ-\n\fÍÎÏ\"\"ˆÐ ‚0ÁÑ!)‡" [archive-read-only error "Archive is read-only" "chgrp-entry" suffix intern "archive-" symbol-name archive-subtype "-" func fboundp new-gid archive-get-marked 42 t archive-resummarize "Setting group is not supported for this archive type"] 5 (#$ . 25350) "nNew gid: "]) #@27 Do the flagged deletions. (defalias 'archive-expunge #[nil "ÀŠ\nbˆ` WƒgÄUƒÅ ÆH BÇyˆ‚) Ÿ‰…Žƒ2ÉÊ!…ŽËÌÍ G A„@΂AÏ#!„LÉÐ!…ŽÑÒ !ÓÕÖ×!ÙR!)Ü!ƒt \"ˆ‚}Ý J#ˆÞÀ!ˆƒ‹à ‚á *)‡" [nil files archive-file-list-start archive-file-list-end 68 archive-get-descr 0 1 archive-read-only error "Archive is read-only" yes-or-no-p format "Really delete %d member%s? " "" "s" "Operation aborted" archive-maybe-copy buffer-file-name "expunge" suffix intern "archive-" symbol-name archive-subtype "-" expunger archive fboundp archive-*-expunge archive-maybe-update archive-remote archive-resummarize revert-buffer] 7 (#$ . 25776) nil]) (defalias 'archive-*-expunge #[(archive files command) "ÀÁ\n@ɉÄ\nA B\"&‡" [apply call-process command nil append archive files] 10]) #@61 Change the name associated with this entry in the tar file. (defalias 'archive-rename-entry #[(newname) "ƒÁÂ!ˆ ĘƒÁÅ!ˆÆÈÉÊ !ÌR!)Í Ð!ƒ<Ñ #ˆÒ ‚?ÁÓ!*‡" [archive-read-only error "Archive is read-only" newname "" "Archive members may not be given empty names" "rename-entry" suffix intern "archive-" symbol-name archive-subtype "-" archive-get-descr descr func fboundp buffer-file-name archive-resummarize "Renaming is not supported for this archive type"] 5 (#$ . 26571) "sNew name: "]) (defalias 'archive-mode-revert #[(&optional no-autosave no-confirm) "À ÂÂÅƉ\"ˆ)Ç ˆbˆÉ !)‡" [archive-get-lineno no nil archive-files revert-buffer-function revert-buffer t archive-mode archive-file-list-start archive-next-line] 3]) #@106 Undo in an archive buffer. This doesn't recover lost files, it just undoes changes in the buffer itself. (defalias 'archive-undo #[nil "À )‡" [nil buffer-read-only undo] 1 (#$ . 27321) nil]) (defalias 'archive-arc-summarize #[nil "ÀÁÂÉÉ\\dWƒÊfÊUƒÊTfÁVƒÊË\\Ì\\{ ÎÏ \"†;Ð ÁOÓÌ\\Ô\"ÓÖ\\Ë\"ÓØ\\Ë\"ÓÚ\\Ô\"‰–˜‰ƒz—‚|Þßà!á!%\"]\\ã\"‰GGZ\"G#\fBãÃS% B\\É\\.\n‚ ebˆäåæ\"çQ(é(±ˆê\fŸ!ˆ(Þë G GÀUƒõì‚öí$籈)îã Ÿ\"-‡" [1 0 8 nil visual files maxlen totalsize p 29 26 2 15 namefld string-match "" 13 fnlen efnname archive-l-e 4 csize 19 moddate 21 modtime 25 ucsize fiddle ifnname format " %8d %-11s %-8s %s" archive-dosdate archive-dostime text vector "- -------- ----------- -------- " make-string 45 "\n" dash "M Length Date Time File\n" archive-summarize-files " %8d %d file%s" "" "s" apply] 8]) (defalias 'archive-arc-rename-entry #[(archive newname descr) "ÀÁ\n\"ƒ ÃÄ!ˆ\nGÅVƒÃÆ!ˆ\nÇ\nGÈOPÈ \nŒŠ~ˆ \fÍH\\Î\\bˆÏÐ!ˆ\nc,‡" [string-match "[:\\\\/]" newname error "File names in arc files may not contain a path" 12 "File names in arc files are limited to 12 characters" "" nil buffer-read-only name archive-proper-file-start descr 4 2 delete-char 13] 4]) (defalias 'archive-lzh-summarize #[nil "ÀÁÂÉbˆÉÊ!ƒ6f ÌÍ\\Î\"ÌÐ\\Î\"ÌÒ\\Ó\"ÌÕ\\Ó\"×\\fÙ\\\\Ù\\{‰‰–˜‰ƒe—‚g\\Ù\\ ZÞYƒ„Ó\\f‚…Á‰àUƒ—ÌÂ\\Ó\"‚˜á‰\"ƒ¥ã\"!‚¦ä%àU…¶Ìæ\\Ó\"'àU…ÆÌè\\Ó\")*ƒãëì'†×í)†Ýí%‚õëî%ï!ð!&1]\\ò1‰GGZ1G#\fBò\"S% B \\\\Ó\\.‚ ebˆ*ƒBó‚Côõö\"÷Q*ƒSø‚Tù*ƒ]ú‚^û<=>=>±ˆÿ\fŸ!ˆ>ë< G GÀUƒ†@‚‰A$÷±ˆ+Bò Ÿ\"-‡" [1 0 8 nil visual files maxlen totalsize p looking-at "..-l[hz][0-9]-" hsize archive-l-e 7 4 csize 11 ucsize 15 2 modtime 17 moddate 21 fnlen 22 efnname fiddle ifnname p2 24 creator 85 438 mode archive-int-to-mode "??????????" modestr 10 uid 12 gid archive-alternate-display format " %8d %5S %5S %s" "?" " %10s %8d %-11s %-8s %s" archive-dosdate archive-dostime text vector "- -------- ----- ----- " "- ---------- -------- ----------- -------- " make-string 45 "\n" "M Length Uid Gid File\n" "M Filemode Length Date Time File\n" " %8d %d file%s" " %8d %d file%s" sumline header dash archive-summarize-files "" "s" apply] 8]) (byte-code "ÀÁ\nBÀ‡" [t archive-lzh-alternate-display current-load-list] 2) (defalias 'archive-lzh-extract #[(archive name) "À \n #‡" [archive-extract-by-stdout archive name archive-lzh-extract] 4]) (defalias 'archive-lzh-resum #[(p count) "À\nÀVƒ\nS f\\ T‚Ä Å\")‡" [0 sum count p logand 255] 3]) (defalias 'archive-lzh-rename-entry #[(archive newname descr) "ŒŠ~ˆ ÂH\\‰f Å\\fG\f\\[\\ Ê  ÌVƒ0ÍÎ!ˆ Å\\bˆÏT!ˆ±ˆ bˆÏÐ!ˆ Ñ  \"±.‡" [archive-proper-file-start descr 4 p oldhsize 21 oldfnlen newname newfnlen newhsize nil buffer-read-only 255 error "The file name is too long" delete-char 2 archive-lzh-resum] 5]) (defalias 'archive-lzh-ogm #[(newval files errtxt ofs) "ŒŠ~ˆ…@\n ÃH\\‰f\fÆ\\f\f\\È\\ ZÊYƒ3 Ë\\f‚4Ì Î ÐUƒ}§„SÒ \\Ë\"! \\bˆÔË!ˆÕÖ\"×Ø\"±ˆ\fTbˆÔÙ!ˆÚ\fT \"cˆ‚†ÛÜ ÙH#ˆ.A‰„Î*‡" [files fil archive-proper-file-start 4 p hsize 21 fnlen 22 p2 24 2 0 creator nil buffer-read-only 85 newval archive-l-e ofs delete-char logand 255 lsh -8 1 archive-lzh-resum message "Member %s does not have %s field" errtxt] 5]) (defalias 'archive-lzh-chown-entry #[(newuid files) "À \nÃÄ$‡" [archive-lzh-ogm newuid files "an uid" 10] 5]) (defalias 'archive-lzh-chgrp-entry #[(newgid files) "À \nÃÄ$‡" [archive-lzh-ogm newgid files "a gid" 12] 5]) (defalias 'archive-lzh-chmod-entry #[(newmode files) "ÀÁ\nÃÄ$‡" [archive-lzh-ogm #[(old) "À \nÃ#‡" [archive-calc-mode old newmode t] 4] files "a unix-style mode" 8] 5]) (defalias 'archive-zip-summarize #[nil "dÀZbˆÁÂ!ˆÃ`Ä\\À\"TÅÆlj \n \f\f‰À\\{͘ƒ^\fÎ\\fÃ\fÐ\\Ñ\"Ã\fÓ\\Ñ\"Ã\fÕ\\Ñ\"Ã\f×\\À\"Ã\fÙ\\Ñ\"Ã\fÛ\\Ñ\"Ã\fÝ\\Ñ\"Ã\fß\\À\" \fá\\\f\\á\\{\"ÆU…“ã\"!ä˜%æ>ƒ¦Ã\fç\\Ñ\"‚Ðè>ƒÏé%ƒ·ê‚¸Æë\fì\\fí\"ÆUƒÉî‚ÊÆï#‚Ðlj0ƒÝñ0!‚Þò34…ëõ>??‰6ƒ÷\"—‚ù\"7øù3ú!û!7&< ] \n\\\ný<‰G7GZƒI\fÐ\\bˆÑÒ!ˆÓ\fÔ\"Õ\fÖ\"±ˆ‚t×>ƒp\fØ\\bˆÙÓ`fÚ\"ÓÛÕ\fÜ\"Ý\"Ý\"\"cˆÑÝ!ˆ‚tÞß!ˆ.A‰„Í*‡" [files fil archive-proper-file-start 4 p 5 creator 3 oldmode archive-calc-mode newmode t newval nil buffer-read-only (2 3) 40 delete-char 2 logand 255 lsh -8 (0 5 6 7 10 11) 38 logior 254 logxor -7 1 message "Don't know how to change mode for this member"] 8]) (defalias 'archive-zoo-summarize #[nil "ÀÁÂ\"TÃÄʼn \n\n‰Â\\{˘ƒCÀ\nÌ\\Â\"ÄVƒCÀ\nÌ\\Â\"T À\nÎ\\Ï\"À\nÑ\\Ï\"À\nÓ\\Â\"\nÕ\\\nÖ\\{\nÂ\\f‰ÏUƒo\nÙ\\f‚pÄÏUƒ\nÛ\\f‚‚ĉÄVƒ’S‚›ÝÞ\"†›ß\\ ÄVƒ¼\n\\á\\\n\\\\Û\\{âP‚½ãÄVƒÓ\ná\\\n\\Û\\{‚ÙÄ OP$ÄU…è$‰–˜‰%ƒô$—‚ö$&çèé!ê!&%+  ] \\ì+‰G&GZ+G#Bì$&%Å\nS%B \n. ‚ebˆíî ï\"ðQ1ò1±ˆóŸ!ˆ1çôGGõUƒqã‚rö$ð±ˆ)÷ìŸ\"-‡" [archive-l-e 25 4 8 0 nil visual files totalsize maxlen p "ܧÄý" 6 next 14 2 moddate 16 modtime 20 ucsize 38 51 namefld dirtype 56 lfnlen 57 ldirlen string-match "" 13 fnlen 58 "/" "" efnname fiddle ifnname format " %8d %-11s %-8s %s" archive-dosdate archive-dostime text vector "- -------- ----------- -------- " make-string 45 "\n" dash "M Length Date Time File\n" archive-summarize-files " %8d %d file%s" 1 "s" apply] 8]) (defalias 'archive-zoo-extract #[(archive name) "À \n #‡" [archive-extract-by-stdout archive name archive-zoo-extract] 4]) (provide (quote archive-mode)) emacs-19.30/lisp/array.elc100666 74777 1 55317 6054600422 13733 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 22 05:52:29 1995 ;;; from file /home/fsf/rms/e19/lisp/array.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`array.el' was compiled for Emacs 19.29 or later")) #@86 Returns t if the cursor is in a valid array cell. Its ok to be on a row number line. (defalias 'array-cursor-in-array-range #[nil " ¦ \fY†+ _Y†+ T¦ÈU…+\nÈU?…+ \n _Y)?‡" [max-column columns-per-line columns-last-line buffer-column line-length buffer-line lines-per-row max-row 0 field-width] 3 (#$ . 468)]) #@67 Return the array row of the field in which the cursor is located. (defalias 'array-current-row #[nil "À …\nÁ\n \"T‡" [array-cursor-in-array-range floor buffer-line lines-per-row] 3 (#$ . 793)]) #@70 Return the array column of the field in which the cursor is located. (defalias 'array-current-column #[nil "À …* …\n ¦ÄU?…* ƒ\n ¦S‚!\n ¦_Æ\"T\\‡" [array-cursor-in-array-range rows-numbered buffer-line lines-per-row 0 columns-per-line floor buffer-column field-width] 4 (#$ . 994)]) #@109 Set `array-row' and `array-column' to their current values or to the optional arguments A-ROW and A-COLUMN. (defalias 'array-update-array-position #[(&optional a-row a-column) "†Á  † Ä ‰‡" [a-row array-current-row array-row a-column array-current-column array-column] 2 (#$ . 1295)]) #@60 Set buffer-line and buffer-column to their current values. (defalias 'array-update-buffer-position #[nil "À i‰‡" [current-line buffer-line buffer-column] 2 (#$ . 1591)]) #@63 Display the row and column in which the cursor is positioned. (defalias 'array-what-position #[nil "À iÃÄÅÆÇ !ÆÈ !#!*‡" [current-line buffer-column buffer-line message format "Array row: %s Array column: %s" prin1-to-string array-current-row array-current-column] 6 (#$ . 1769) nil]) #@69 Display the current state of the local variables in the minibuffer. (defalias 'array-display-local-variables #[nil "Àp!ÂÃ\f!ˆÅ ˆÆÇÈ \"!ˆÆÇÉÊ !\"!ˆÆÇÌÊ !\"!ˆÆÇÎÊ!\"!ˆÆÇÐÊ!\"!ˆÆÇÒÊ!\"!ˆÆÇÔÊ!\"!ˆÆÇÖÊ!\"!‘)‡" [buffer-name buf "*Local Variables*" buffer-disable-undo standard-output terpri princ format " Buffer: %s\n\n" " max-row: %s\n" prin1-to-string max-row " max-column: %s\n" max-column " columns-per-line: %s\n" columns-per-line " field-width: %s\n" field-width " rows-numbered: %s\n" rows-numbered " lines-per-row: %s\n" lines-per-row " line-length: %s\n" line-length] 6 (#$ . 2062) nil]) #@118 Return the column of the beginning of the current field. Optional argument GO-THERE, if non-nil, means go there too. (defalias 'array-beginning-of-field #[(&optional go-there) "‰ ¦Z ƒÄ\n!‚\n)‡" [buffer-column field-width goal-column go-there move-to-column-untabify] 3 (#$ . 2732)]) #@114 Return the column of the end of the current array field. If optional argument GO-THERE is non-nil, go there too. (defalias 'array-end-of-field #[(&optional go-there) "‰ ¦Z \\ ƒÄ\n!‚\n)‡" [buffer-column field-width goal-column go-there move-to-column-untabify] 3 (#$ . 3028)]) #@130 Move to array row A-ROW and array column A-COLUMN. Leave point at the beginning of the field and return the new buffer column. (defalias 'array-move-to-cell #[(a-row a-column) " S_\nƒ\f Ä\\ÅS\"\\S¦_ \nebˆ\nyˆË !*‡" [lines-per-row a-row rows-numbered 1 0 floor a-column columns-per-line field-width goal-column goal-line move-to-column-untabify] 4 (#$ . 3317)]) #@134 Move to array row A-ROW preserving the current array column. Leave point at the beginning of the field and return the new array row. (defalias 'array-move-to-row #[(a-row) " S_\n¦\\ ‰\f¦Z‰\nZyˆÇ !ˆ *‡" [lines-per-row a-row buffer-line buffer-column field-width goal-column goal-line move-to-column-untabify] 5 (#$ . 3706)]) #@140 Move to array column A-COLUMN preserving the current array row. Leave point at the beginning of the field and return the new array column. (defalias 'array-move-to-column #[(a-column) "‰ ¦Z\nƒ ÂÄ\\ÅS\"\\S¦_ ‰\nZyˆË !ˆ*‡" [buffer-line lines-per-row rows-numbered 1 0 floor a-column columns-per-line field-width goal-column goal-line move-to-column-untabify] 5 (#$ . 4042)]) #@184 Move one array row in direction SIGN (1 or -1). Leave point at the beginning of the field and return the new array row. If requested to move beyond the array bounds, signal an error. (defalias 'array-move-one-row #[(sign) "À Á †\nÂÃ!\fUƒ ÈUƒ ÂÉ!‚B\fÈUƒ3ÊUƒ3ÂË!‚B\f_yˆÍ !ˆ\f\\*‡" [array-beginning-of-field array-current-row error "Cursor is not in a valid array cell." array-row goal-column max-row sign 1 "End of array." -1 "Beginning of array." lines-per-row move-to-column-untabify] 3 (#$ . 4443)]) #@190 Move one array column in direction SIGN (1 or -1). Leave point at the beginning of the field and return the new array column. If requested to move beyond the array bounds, signal an error. (defalias 'array-move-one-column #[(sign) "À †ÁÂ!‰\fUƒ ÆUƒÁÇ!‚m ÆUƒ- ÈUƒ-ÁÉ!‚m ÈUƒK \n¦ÆUƒKÈyˆË\f\nS_!ˆ‚j ÆUƒ` \n¦ÍUƒ`Æyˆ‚jËÎ \f _\\!ˆ \\)‡" [array-current-column error "Cursor is not in a valid array cell." array-column max-column sign 1 "End of array." -1 "Beginning of array." columns-per-line move-to-column-untabify field-width 0 array-beginning-of-field] 5 (#$ . 4971)]) #@135 Move the cursor to the first non-whitespace character in the field and, if necessary, scroll horizontally to keep the cursor in view. (defalias 'array-normalize-cursor #[nil "iÁŠÂÃ!ˆ`)SwˆÄ )‡" [buffer-column " " array-end-of-field t array-maybe-scroll-horizontally] 3 (#$ . 5567)]) #@63 If necessary, scroll horizontally to keep the cursor in view. (defalias 'array-maybe-scroll-horizontally #[nil "À Á \f Yƒ\f \n\\XƒÅ‚5\f \n\\Vƒ,Æ\f Z\nÇ¥Z!‚5È \fZ\nÇ¥\\!*‡" [window-hscroll window-width w-width w-hscroll buffer-column nil scroll-left 2 scroll-right] 4 (#$ . 5857)]) #@115 Move down one array row, staying in the current array column. If optional ARG is given, move down ARG array rows. (defalias 'array-next-row #[(&optional arg) "À iÃ\f!ÅUƒÆ\f!ˆ‚%ÇÈÉ †ÊË!\f\\\f\"!ˆ*Í ‡" [current-line buffer-column buffer-line abs arg 1 array-move-one-row array-move-to-row limit-index array-current-row error "Cursor is not in an array cell." max-row array-normalize-cursor] 4 (#$ . 6154) "p"]) #@111 Move up one array row, staying in the current array column. If optional ARG is given, move up ARG array rows. (defalias 'array-previous-row #[(&optional arg) "À [!‡" [array-next-row arg] 2 (#$ . 6578) "p"]) #@189 Move forward one field, staying in the current array row. If optional ARG is given, move forward ARG array columns. If necessary, keep the cursor in the window by scrolling right or left. (defalias 'array-forward-column #[(&optional arg) "À iÃ\f!ÅUƒÆ\f!ˆ‚%ÇÈÉ †ÊË!\f\\\f\"!ˆ*Í ‡" [current-line buffer-column buffer-line abs arg 1 array-move-one-column array-move-to-column limit-index array-current-column error "Cursor is not in an array cell." max-column array-normalize-cursor] 4 (#$ . 6792) "p"]) #@191 Move backward one field, staying in the current array row. If optional ARG is given, move backward ARG array columns. If necessary, keep the cursor in the window by scrolling right or left. (defalias 'array-backward-column #[(&optional arg) "À [!‡" [array-forward-column arg] 2 (#$ . 7308) "p"]) #@50 Go to array row A-ROW and array column A-COLUMN. (defalias 'array-goto-cell #[(a-row a-column) "ÀÁ\n \"Á\f \"\"ˆÆ ‡" [array-move-to-cell limit-index a-row max-row a-column max-column array-normalize-cursor] 5 (#$ . 7610) "nArray row: \nnArray column: "]) #@57 Return the field string at the current cursor location. (defalias 'array-field-string #[nil "ŠÀÁ!ˆ`)ŠÂÁ!ˆ`){‡" [array-beginning-of-field t array-end-of-field] 3 (#$ . 7871)]) #@207 Copy the current field into one array row in direction SIGN (1 or -1). Leave point at the beginning of the field and return the new array row. If requested to move beyond the array bounds, signal an error. (defalias 'array-copy-once-vertically #[(sign) "À !Ã`ŠÅÃ!ˆ`)|ˆcˆ)Ç!ˆ\n)‡" [array-move-one-row sign a-row t inhibit-quit array-end-of-field copy-string move-to-column buffer-column] 3 (#$ . 8053)]) #@213 Copy the current field into one array column in direction SIGN (1 or -1). Leave point at the beginning of the field and return the new array column. If requested to move beyond the array bounds, signal an error. (defalias 'array-copy-once-horizontally #[(sign) "À !à ˆÄ`ŠÆÄ!ˆ`)|ˆcˆ)È !ˆ\n)‡" [array-move-one-column sign a-column array-update-buffer-position t inhibit-quit array-end-of-field copy-string move-to-column buffer-column] 3 (#$ . 8469)]) #@121 Copy the current field vertically into every cell up to and including A-ROW. Leave point at the beginning of the field. (defalias 'array-copy-to-row #[(a-row) " ZÃ\n!‰ÅU?…\n\f¥\fÅV…@Ç!ˆÈ ˆÉ\n`ŠËÉ!ˆ`)|ˆ\fcˆ)Í!ˆ\fS‰‚+‡" [a-row array-row num abs count 0 sign array-move-one-row array-update-buffer-position t inhibit-quit array-end-of-field copy-string move-to-column buffer-column] 4 (#$ . 8931)]) #@127 Copy the current field horizontally into every cell up to and including A-COLUMN. Leave point at the beginning of the field. (defalias 'array-copy-to-column #[(a-column) " ZÃ\n!‰ÅU?…\n\f¥\fÅV…@Ç!ˆÈ ˆÉ\n`ŠËÉ!ˆ`)|ˆ\fcˆ)Í!ˆ\fS‰‚+‡" [a-column array-column num abs count 0 sign array-move-one-column array-update-buffer-position t inhibit-quit array-end-of-field copy-string move-to-column buffer-column] 4 (#$ . 9351)]) #@101 Copy the current field into the cell at A-ROW, A-COLUMN. Leave point at the beginning of the field. (defalias 'array-copy-to-cell #[(a-row a-column) "À \n\"ˆÃ ˆ`ŠÄÅ!ˆ`)|ˆcˆÇ!‡" [array-move-to-cell a-row a-column array-update-buffer-position array-end-of-field t copy-string move-to-column buffer-column] 3 (#$ . 9792)]) #@104 Copy the current field one array row down. If optional ARG is given, copy down through ARG array rows. (defalias 'array-copy-down #[(&optional arg) "À ià † ÄÅ!Ç É\n!ËUƒ$Ì\n!ˆ‚0ÍÎ\n\\\"!ˆ,Ð ‡" [current-line buffer-line buffer-column array-current-row error "Cursor is not in a valid array cell." array-row array-field-string copy-string abs arg 1 array-copy-once-vertically array-copy-to-row limit-index max-row array-normalize-cursor] 4 (#$ . 10123) "p"]) #@100 Copy the current field one array row up. If optional ARG is given, copy up through ARG array rows. (defalias 'array-copy-up #[(&optional arg) "À [!‡" [array-copy-down arg] 2 (#$ . 10602) "p"]) #@126 Copy the current field one array column to the right. If optional ARG is given, copy through ARG array columns to the right. (defalias 'array-copy-forward #[(&optional arg) "À ià † ÄÅ!Ç É\n!ËUƒ$Ì\n!ˆ‚0ÍÎ\n\\\"!ˆ,Ð ‡" [current-line buffer-line buffer-column array-current-column error "Cursor is not in a valid array cell." array-column array-field-string copy-string abs arg 1 array-copy-once-horizontally array-copy-to-column limit-index max-column array-normalize-cursor] 4 (#$ . 10802) "p"]) #@124 Copy the current field one array column to the left. If optional ARG is given, copy through ARG array columns to the left. (defalias 'array-copy-backward #[(&optional arg) "À [!‡" [array-copy-forward arg] 2 (#$ . 11320) "p"]) #@134 Copy the entire current column in to the column to the right. If optional ARG is given, copy through ARG array columns to the right. (defalias 'array-copy-column-forward #[(&optional arg) "À ˆÁ ˆ\n„ÃÄ!ˆÅÆ!ˆÇ WƒOTÊ\n\"ˆÀ ˆË \fÍ!ÏUƒ@Ð!ˆ‚KÑÒ\n\\\"!ˆ)‚)ÅÔ!ˆÕ!ˆ× ‡" [array-update-buffer-position array-update-array-position array-column error "Cursor is not in a valid array cell." message "Working..." 0 this-row max-row array-move-to-cell array-field-string copy-string abs arg 1 array-copy-once-horizontally array-copy-to-column limit-index max-column "Working...done" array-move-to-row array-row array-normalize-cursor] 4 (#$ . 11553) "p"]) #@120 Copy the entire current column one column to the left. If optional ARG is given, copy through ARG columns to the left. (defalias 'array-copy-column-backward #[(&optional arg) "À [!‡" [array-copy-column-forward arg] 2 (#$ . 12229) "p"]) #@97 Copy the entire current row one row down. If optional ARG is given, copy through ARG rows down. (defalias 'array-copy-row-down #[(&optional arg) "À ˆÁ ˆ\n„ÃÄ!ˆ\nÅUƒ\"ÇUƒ\"ÃÈ!ˆ‚¸\n Uƒ7ÅUƒ7ÃÊ!ˆ‚¸ŠË\nÅ\"ˆ`)ŠË\n\f\"ˆÅyˆ`){ \nÏ\\ \"‰ZÒ!‰ÔU?…t¥ÔVƒ«\\ËÅ\"ˆÖ`ŠË\f\"ˆÅyˆ`)|ˆ cˆ)S‰‚xˆ´Å\"ˆ.Ù ‡" [array-update-buffer-position array-update-array-position array-row error "Cursor is not in a valid array cell." 1 arg -1 "Beginning of array." max-row "End of array." array-move-to-cell max-column copy-string this-row limit-index goal-row num abs count 0 sign t inhibit-quit array-column array-normalize-cursor] 5 (#$ . 12471) "p"]) #@107 Copy the entire current array row into the row above. If optional ARG is given, copy through ARG rows up. (defalias 'array-copy-row-up #[(&optional arg) "À [!‡" [array-copy-row-down arg] 2 (#$ . 13165) "p"]) #@64 Copy the field at mark into every cell between mark and point. (defalias 'array-fill-rectangle #[nil "À ˆÁ † ÂÃ!Ä †ÂÃ!ŠÅ ˆÀ ˆÁ †\"ÂÆ!)ŠÅ ˆÀ ˆÄ †2ÂÆ!) \nËÌ!ˆ\n^\n] ^ ] ŠÑ\"ˆÀ ˆÒ )Ô\"ˆÕ\"ˆÀ ˆÖ !ˆ)Ñ\"ˆ`ŠÑ \"ˆiØÙ!ˆ`){U„ÕTÑ\"ˆÙ`ŠÑ \"ˆiØÙ!ˆ`)|ˆcˆ)‚¢.ËÜ!ˆÝ\n \",‡" [array-update-buffer-position array-current-row error "Cursor is not in a valid array cell." array-current-column exchange-point-and-mark "Mark is not in a valid array cell." m-column m-row p-column p-row message "Working..." right-column left-column bottom-row top-row array-move-to-cell array-field-string copy-string array-copy-to-cell array-update-array-position array-copy-to-column buffer-column array-end-of-field t this-row inhibit-quit "Working...done" array-goto-cell] 5 (#$ . 13379) nil]) #@34 Create the template of an array. (defalias 'array-make-template #[nil "ÀÁ ƒ/ÄÅ!‰G‰U„)ÈÉÊ\n\"!ƒ\nÁ‰‚Á‰„*ebˆËÌ!ˆÍXƒ†ƒNÉÑ\"cˆÍÍXƒzcˆ¦ÕUƒqU„qÖ ˆT‰‚R)TÖ ˆ‚:)Ë×!ˆØ͉\"‡" [t nil len check read-input "Initial field value: " init-field field-width y-or-n-p format "Change field width to %d? " message "Working..." 1 this-row max-row rows-numbered "%d:\n" this-column max-column columns-per-line 0 newline "Working...done" array-goto-cell] 5 (#$ . 14229) nil]) #@222 Reconfigure the state of `rows-numbered' and `columns-per-line'. NEW-COLUMNS-PER-LINE is the desired value of `columns-per-line' and NEW-ROWS-NUMBERED (a character, either ?y or ?n) is the desired value of rows-numbered. (defalias 'array-reconfigure-rows #[(new-columns-per-line new-rows-numbered) "À ƒ$\nÃYƒ\n\fXƒʼn‚ÆÇÈÉ\f\"!!‚)\nË=ƒ2À\n‚D\nÌ=ƒ?Å\n‚DÍÎ!\nÏÐ!ˆÑ ˆÒp!ÔÕ!\f !\"#Ã$å ˆæed#ˆqˆebˆ$Xƒ2ƒ–\n„¹„ \nƒ¹ƒ±\n„±çÃ!ˆ‚¹èÈé$\"!ˆ\nUƒÒƒËÂÌêZyˆ‚)ëS\"êëS\n\"ê,-././Wƒð.T#_!ˆçÃ!ˆ.T‰.‚ëêyˆ,-Wƒ%ð!\n_!ˆñ ˆ,T‰,‚\fÃyˆ,$T‰$‚†À2qˆó ˆô!ˆ\n\n!\n_\"ëS\n\"\nƒ]õ‚^Ã\\ö7†hÃ8†nÃ\"ˆ)ù!ˆ.\nÏú!‡" [t check new-columns-per-line 1 max-column nil string-to-int read-input format "Columns per line (1 - %d): " new-rows-numbered 121 110 y-or-n-p "Rows numbered? " message "Working..." array-update-buffer-position buffer-name main-buffer make-temp-name "Array" temp-buffer max-row temp-max-row temp-max-column rows-numbered old-rows-numbered columns-per-line old-columns-per-line lines-per-row old-lines-per-row field-width old-field-width line-length old-line-length this-row array-update-array-position copy-to-buffer kill-line insert-string "%d:\n" 0 floor newlines-added newlines-to-be-added newlines-removed newlines-to-be-removed move-to-column-untabify newline inhibit-quit erase-buffer insert-buffer 2 array-goto-cell array-row array-column kill-buffer "Working...done"] 6 (#$ . 14745) "nColumns per line: \ncRows numbered? (y or n) "]) #@66 Expand the rows so each fits on one line and remove row numbers. (defalias 'array-expand-rows #[nil "À Â\"‡" [array-reconfigure-rows max-column 110] 3 (#$ . 16307) nil]) (defalias 'limit-index #[(index limit) "ÁWƒÁ‡\nVƒ\n‡‡" [index 1 limit] 2]) #@65 Returns the logical exclusive or of predicates PRED1 and PRED2. (defalias 'xor #[(pred1 pred2) "„ …… ?‡" [pred1 pred2] 1 (#$ . 16565)]) #@64 Return the current buffer line at point. The first line is 0. (defalias 'current-line #[nil "ŠÀyˆÁe`\")‡" [0 count-lines] 3 (#$ . 16715)]) #@78 Move to COLUMN on the current line, untabifying if necessary. Return COLUMN. (defalias 'move-to-column-untabify #[(column) "Á!Uƒ\f†\nƒÃÄ!‡Å ˆÁ!‡" [column move-to-column respect-tabs error "There is a TAB character in the way." untabify-backward] 3 (#$ . 16861)]) #@29 Untabify the preceding tab. (defalias 'untabify-backward #[nil "Š`ÁÂ!ˆÃ`\"*‡" [start backward-char 1 untabify] 3 (#$ . 17139)]) #@28 Keymap used in array mode. (defvar array-mode-map nil (#$ . 17275)) (byte-code "„yÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆÂáâ#ˆÂãä#ˆÂåæ#ˆÂçè#ˆéêëì#‡" [array-mode-map make-keymap define-key "ád" array-display-local-variables "ám" array-make-template "áe" array-expand-rows "ár" array-reconfigure-rows "á=" array-what-position "ág" array-goto-cell "áf" array-fill-rectangle "" array-next-row "" array-previous-row "" array-forward-column "" array-backward-column "î" array-copy-down "ð" array-copy-up "æ" array-copy-forward "â" array-copy-backward "Ž" array-copy-row-down "" array-copy-row-up "†" array-copy-column-forward "‚" array-copy-column-backward put array-mode mode-class special] 4) #@2974 Major mode for editing arrays. Array mode is a specialized mode for editing arrays. An array is considered to be a two-dimensional set of strings. The strings are NOT recognized as integers or real numbers. The array MUST reside at the top of the buffer. TABs are not respected, and may be converted into spaces at any time. Setting the variable 'respect-tabs to non-nil will prevent TAB conversion, but will cause many functions to give errors if they encounter one. Upon entering array mode, you will be prompted for the values of several variables. Others will be calculated based on the values you supply. These variables are all local the the buffer. Other buffer in array mode may have different values assigned to the variables. The variables are: Variables you assign: max-row: The number of rows in the array. max-column: The number of columns in the array. columns-per-line: The number of columns in the array per line of buffer. field-width: The width of each field, in characters. rows-numbered: A logical variable describing whether to ignore row numbers in the buffer. Variables which are calculated: line-length: The number of characters in a buffer line. lines-per-row: The number of buffer lines used to display each row. The following commands are available (an asterisk indicates it may take a numeric prefix argument): * \\[array-forward-column] Move forward one column. * \[array-backward-column] Move backward one column. * \[array-next-row] Move down one row. * \[array-previous-row] Move up one row. * \[array-copy-forward] Copy the current field into the column to the right. * \[array-copy-backward] Copy the current field into the column to the left. * \[array-copy-down] Copy the current field into the row below. * \[array-copy-up] Copy the current field into the row above. * \[array-copy-column-forward] Copy the current column into the column to the right. * \[array-copy-column-backward] Copy the current column into the column to the left. * \[array-copy-row-down] Copy the current row into the row below. * \[array-copy-row-up] Copy the current row into the row above. \[array-fill-rectangle] Copy the field at mark into every cell with row and column between that of point and mark. \[array-what-position] Display the current array row and column. \[array-goto-cell] Go to a particular array cell. \[array-make-template] Make a template for a new array. \[array-reconfigure-rows] Reconfigure the array. \[array-expand-rows] Expand the array (remove row numbers and newlines inside rows) \[array-display-local-variables] Display the current values of local variables. Entering array mode calls the function `array-mode-hook'. (defalias 'array-mode #[nil "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÀÅ!ˆÀÆ!ˆÀÇ!ˆÀÈ!ˆÀÉ!ˆÀÊ!ˆÀË!ˆÀÌ!ˆÀÍ!ˆÎ Ï ˆÐÒÔ ˆÕÖ!ˆ×ØÚ!ˆÜÝ!‡" [make-local-variable max-row max-column columns-per-line field-width rows-numbered line-length lines-per-row buffer-line buffer-column array-row array-column copy-string respect-tabs nil array-init-local-variables array-mode major-mode "Array" mode-name force-mode-line-update make-variable-buffer-local truncate-lines t overwrite-mode-textual overwrite-mode use-local-map array-mode-map run-hooks array-mode-hook] 2 (#$ . 18037) nil]) #@68 Initialize the variables associated with the array in this buffer. (defalias 'array-init-local-variables #[nil "À ˆÁ ˆÂ ˆÃ ˆÄ ˆÅ ˆÆ ˆÇÈ!‡" [array-init-max-row array-init-max-column array-init-columns-per-line array-init-field-width array-init-rows-numbered array-init-line-length array-init-lines-per-row message ""] 2 (#$ . 21569)]) #@34 Initialize the value of max-row. (defalias 'array-init-max-row #[(&optional arg) "† ÁÂÃ!!‰‡" [arg string-to-int read-input "Number of array rows: " max-row] 3 (#$ . 21909)]) #@37 Initialize the value of max-column. (defalias 'array-init-max-column #[(&optional arg) "† ÁÂÃ!!‰‡" [arg string-to-int read-input "Number of array columns: " max-column] 3 (#$ . 22092)]) #@43 Initialize the value of columns-per-line. (defalias 'array-init-columns-per-line #[(&optional arg) "† ÁÂÃ!!‰‡" [arg string-to-int read-input "Array columns per line: " columns-per-line] 3 (#$ . 22287)]) #@38 Initialize the value of field-width. (defalias 'array-init-field-width #[(&optional arg) "† ÁÂÃ!!‰‡" [arg string-to-int read-input "Field width: " field-width] 3 (#$ . 22499)]) #@40 Initialize the value of rows-numbered. (defalias 'array-init-rows-numbered #[(&optional arg) "†ÁÂ!‰‡" [arg y-or-n-p "Rows numbered? " rows-numbered] 2 (#$ . 22685)]) #@38 Initialize the value of line-length. (defalias 'array-init-line-length #[(&optional arg) "† \n_‰‡" [arg field-width columns-per-line line-length] 2 (#$ . 22861)]) #@40 Initialize the value of lines-per-row. (defalias 'array-init-lines-per-row #[(&optional arg) "†Á\nS \"\fƒÅ‚Æ\\‰‡" [arg floor max-column columns-per-line rows-numbered 2 1 lines-per-row] 3 (#$ . 23034)]) emacs-19.30/lisp/asm-mode.elc100666 12120 1 10755 5751545230 14302 0ustar rmsdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:13:11 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/asm-mode.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/asm-mode.el' was compiled for Emacs 19")) #@51 *The comment-start character assumed by Asm mode. (defvar asm-comment-char 59 (#$ . -485)) #@38 Syntax table used while in Asm mode. (defvar asm-mode-syntax-table nil (#$ . 582)) #@38 Abbrev table used while in Asm mode. (defvar asm-mode-abbrev-table nil (#$ . 671)) (define-abbrev-table (quote asm-mode-abbrev-table) nil) #@22 Keymap for Asm mode. (defvar asm-mode-map nil (#$ . 816)) (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÈ#ˆÁ‡" [asm-mode-map make-sparse-keymap define-key ":" asm-colon " " tab-to-tab-stop "\n" asm-newline " "] 4) #@56 Additional expressions to highlight in Assembler mode. (defconst asm-font-lock-keywords (quote (("^\\(\\(\\sw\\|\\s_\\)+\\)\\>:?[ ]*\\(\\sw+\\)?" (1 font-lock-function-name-face) (3 font-lock-keyword-face nil t)) ("^\\s +\\(\\(\\sw\\|\\s_\\)+\\)" 1 font-lock-keyword-face))) (#$ . 1030)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ B‡" [boundp asm-code-level-empty-comment-pattern nil current-load-list asm-flush-left-empty-comment-pattern asm-inline-empty-comment-pattern] 2) #@675 Major mode for editing typical assembler code. Features a private abbrev table and the following bindings: \[asm-colon] outdent a preceding label, tab to next tab stop. \[tab-to-tab-stop] tab to next tab stop. \[asm-newline] newline, then tab to next tab stop. \[asm-comment] smart placement of assembler comments. The character used for making comments is set by the variable `asm-comment-char' (which defaults to `?;'). Alternatively, you may set this variable in `asm-mode-set-comment-hook', which is called near the beginning of mode initialization. Turning on Asm mode runs the hook `asm-mode-hook' at the end of initialization. Special commands: \{asm-mode-map}  (defalias 'asm-mode #[nil "À ˆÁà ÇÈ!ˆÉÇÊ!ˆË \nÌ\n!ˆÍÎ!ˆÏÐ ¤!ˆÒÓ!Õ\"ˆÖ×\n#ˆÖØÙ\n#ˆÚÛ!!ÇÝ!ˆÞPÇß!ˆàPáâQ#ä‰åR&牉å°()Çé!ˆê)Çë!ˆì+í.Íï!‡" [kill-all-local-variables "Assembler" mode-name asm-mode major-mode asm-mode-abbrev-table local-abbrev-table make-local-variable font-lock-defaults (asm-font-lock-keywords) asm-mode-syntax-table make-syntax-table set-syntax-table run-hooks asm-mode-set-comment-hook use-local-map make-sparse-keymap asm-mode-map local-set-key vector asm-comment-char asm-comment modify-syntax-entry "<" 10 ">" regexp-quote char-to-string cs comment-start " " comment-start-skip "+[ ]*" "^.+" "+ *$" asm-inline-empty-comment-pattern "^[ ]+" " *$" asm-code-level-empty-comment-pattern "^" asm-flush-left-empty-comment-pattern comment-end "" comment-column 32 " " fill-prefix asm-mode-hook] 5 (#$ . 1519) nil]) #@72 Insert a colon; if it follows a label, delete the label's indentation. (defalias 'asm-colon #[nil "ŠÀyˆÁÂ!ƒ à ˆ)ÄcˆÅ ‡" [0 looking-at "[ ]+\\(\\sw\\|\\s_\\)+$" delete-horizontal-space ":" tab-to-tab-stop] 2 (#$ . 3066) nil]) #@66 Insert LFD + fill-prefix, to bring us back to code-indent level. (defalias 'asm-newline #[nil "lƒÀ ˆÁcˆÂ ‡" [delete-horizontal-space "\n" tab-to-tab-stop] 1 (#$ . 3299) nil]) (defalias 'asm-line-matches #[(pattern &optional withcomment) "ŠÀyˆÁ\n!)‡" [0 looking-at pattern] 2]) (defalias 'asm-pop-comment-level #[nil "ÀˆÁ ˆh\nUƒÃÄ!ˆ‚Á ˆn?…!ÅyˆÆÄ!‡" [nil delete-horizontal-space asm-comment-char delete-backward-char 1 0 open-line] 2]) #@414 Convert an empty comment to a `larger' kind, or start a new one. These are the known comment classes: 1 -- comment to the right of the code (at the comment-column) 2 -- comment on its own line, indented like code 3 -- comment on its own line, beginning at the left-most column. Suggested usage: while writing your code, trigger asm-comment repeatedly until you are satisfied with the kind of comment. (defalias 'asm-comment #[nil "ÀÁ!ƒ ˆÃ ˆ\f ±ˆ‚[ÀÆÇ\f\"!ƒ#È ˆ‚[À !ƒ0\fcˆ‚[À\n!ƒCË ˆ\f‰ ±ˆ‚[À\f!ƒXË ˆÃ ˆ\f ±ˆ‚[\fcˆÍ‡" [asm-line-matches "^[ ]*$" delete-horizontal-space tab-to-tab-stop asm-comment-char comment-start format "^[^%c\n]+$" indent-for-comment asm-flush-left-empty-comment-pattern asm-code-level-empty-comment-pattern asm-pop-comment-level asm-inline-empty-comment-pattern nil] 4 (#$ . 3748) nil]) emacs-19.30/lisp/assoc.elc100666 74777 1 10065 5751545231 13725 0ustar esrdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:13:12 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/assoc.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/assoc.el' was compiled for Emacs 19")) #@278 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 head is one matching KEY. Returns the sorted list and doesn't affect the order of any other key-value pair. Side effect sets alist to new sorted list. (defalias 'asort #[(alist-symbol key) "ÁÂÃ!!Ä\"L‡" [alist-symbol sort copy-alist eval #[(a b) "@ š‡" [a key] 2]] 5 (#$ . 480)]) #@126 Makes a list of a cons cell containing car of KEY and cdr of VALUE. The returned list is suitable as an element of an alist. (defalias 'aelement #[(key value) " BC‡" [key value] 2 (#$ . 895)]) #@45 Return the key symbol at the head of ALIST. (defalias 'aheadsym #[(alist) "@@‡" [alist] 1 (#$ . 1095)]) #@335 Find out if a specified key-value pair is not at the head of an alist. The alist to check is specified by ALIST and the key-value pair is the one matching the supplied KEY. Returns nil if ALIST is nil, or if key-value pair is at the head of the alist. Returns t if key-value pair is not at the head of alist. ALIST is not altered. (defalias 'anot-head-p #[(alist key) "À !\nš?‡" [aheadsym alist key] 2 (#$ . 1207)]) #@605 Inserts a key-value pair into an alist. The alist is referenced by ALIST-SYMBOL. The key-value pair is made from KEY and optionally, VALUE. Returns the altered alist or nil if ALIST is nil. If the key-value pair referenced by KEY can be found in the alist, and VALUE is supplied non-nil, then the value of KEY will be set to VALUE. If VALUE is not supplied, or is nil, the key-value pair will not be modified, but will be moved to the head of the alist. If the key-value pair cannot be found in the alist, it will be inserted into the head of the alist (with value nil if VALUE is nil or not supplied). (defalias 'aput #[(alist-symbol key &optional value) "À \n\"ÃÆ \"ˆÈ!‰„ L‚9É\f \"ƒ- \f¤L‚9\nƒ8\f @ ‚9\f*‡" [aelement key value nil alist elem asort alist-symbol eval anot-head-p] 4 (#$ . 1633)]) #@160 Delete a key-value pair from the alist. Alist is referenced by ALIST-SYMBOL and the key-value pair to remove is pair matching KEY. Returns the altered alist. (defalias 'adelete #[(alist-symbol key) "À \n\"ˆÃ !‰„Å‚ Æ\f\n\"ƒ\f‚ \fAL)‡" [asort alist-symbol key eval alist nil anot-head-p] 4 (#$ . 2456)]) #@394 Returns the value in ALIST that is associated with KEY. Optional KEYNIL-P describes what to do if the value associated with KEY is nil. If KEYNIL-P is not supplied or is nil, and the value is nil, then KEY is returned. If KEYNIL-P is non-nil, then nil would be returned. If no key-value pair matching KEY could be found in ALIST, or ALIST is nil then nil is returned. ALIST is not altered. (defalias 'aget #[(alist key &optional keynil-p) "À ! „\fÂ2Ä \"ˆÆ\n \"ƒÂ2\n@A†2ƒ+Â2\n@@†2Ã)‡" [copy-alist alist copy nil asort key anot-head-p keynil-p] 3 (#$ . 2774)]) #@559 Make an association list. The association list is attached to the alist referenced by ALIST-SYMBOL. Each element in the KEYLIST becomes a key and is associated with the value in VALUELIST with the same index. If VALUELIST is not supplied or is nil, then each key in KEYLIST is associated with nil. KEYLIST and VALUELIST should have the same number of elements, but this isn't enforced. If VALUELIST is smaller than KEYLIST, remaining keys are associated with nil. If VALUELIST is larger than KEYLIST, extra values are ignored. Returns the created alist. (defalias 'amake #[(alist-symbol keylist &optional valuelist) "@A @ A\f„Æ #ˆ‚(È\f\n#ˆÆ #ˆ,É!‡" [keylist valuelist valcdr valcar keycdr keycar aput alist-symbol amake eval] 4 (#$ . 3359)]) (provide (quote assoc)) emacs-19.30/lisp/auto-show.elc100666 12120 1 4626 6045211671 14502 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:04:39 1995 ;;; from file /home/fsf/rms/e19/lisp/auto-show.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`auto-show.el' was compiled for Emacs 19.29 or later")) #@267 *Non-nil enables automatic horizontal scrolling, when lines are truncated. The default value is t. To change the default, do this: (set-default 'auto-show-mode nil) See also command `auto-show-mode'. This variable has no effect when lines are not being truncated. (defvar auto-show-mode t (#$ . -479)) (make-variable-buffer-local (quote auto-show-mode)) #@63 *Extra columns to scroll. for automatic horizontal scrolling. (defvar auto-show-shift-amount 8 (#$ . -841)) #@192 *Threshold column for automatic horizontal scrolling to the right. If point is before this column, we try to scroll to make the left margin visible. Setting this to 0 disables this feature. (defvar auto-show-show-left-margin-threshold 50 (#$ . -956)) #@61 True if line truncation is enabled for the selected window. (defalias 'auto-show-truncationp #[nil "† …  à W‡" [truncate-lines truncate-partial-width-windows window-width frame-width] 2 (#$ . 1214)]) #@118 Turn automatic horizontal scroll mode on or off. With arg, turn auto scrolling on if arg is positive, off otherwise. (defalias 'auto-show-mode #[(arg) "„ ?‚Â!ÃV‰‡" [arg auto-show-mode prefix-numeric-value 0] 2 (#$ . 1426) "P"]) #@228 Scroll horizontally to make point visible, if that is enabled. This function only does something if `auto-show-mode' is non-nil and longlines are being truncated in the selected window. See also the command `auto-show-toggle'. (defalias 'auto-show-make-point-visible #[(&optional ignore-arg) "…uÁ …u pš…uiÄ Æ ÇVƒ!È‚\"ÉZ\n \n\\ \fWƒE Æ WƒE ÇVƒEÍ !‚t WƒVÍ Z\\!‚t  V„i  U…tl?…tÏ \n\\Z\\!,‡" [auto-show-mode auto-show-truncationp window-buffer col window-hscroll scroll window-width 0 2 1 w-width right-col auto-show-show-left-margin-threshold scroll-right auto-show-shift-amount scroll-left] 5 (#$ . 1668) nil]) (byte-code "ÀÁÂ\"ˆÀÃÂÄ#ˆÅÆ!‡" [add-hook post-command-hook auto-show-make-point-visible comint-output-filter-functions t provide auto-show] 4) emacs-19.30/lisp/autoinsert.elc100666 74777 1 14355 5777325275 15034 0ustar esrdaemon;ELC ;;; compiled by kwzh@kropotkin.gnu.ai.mit.edu on Fri Jul 7 17:44:24 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/autoinsert.el ;;; emacs version 19.29.4. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`autoinsert.el' was compiled for Emacs 19.29 or later")) #@506 *Controls automatic insertion into newly found empty files: nil do nothing t insert if possible other insert if possible, but mark as unmodified. Insertion is possible when something appropriate is found in `auto-insert-alist'. When the insertion is marked as unmodified, you can save it with \[write-file] RET. This variable is used when `auto-insert' is called as a function, e.g. when you do (add-hook 'find-file-hooks 'auto-insert). With \[auto-insert], this is always treated as if it were `t'. (defvar auto-insert (quote not-modified) (#$ . -486)) #@113 *If non-`nil', ask user before auto-inserting. When this is `function', only ask when called non-interactively. (defvar auto-insert-query (quote function) (#$ . -1052)) #@121 *Prompt to use when querying whether to auto-insert. If this contains a %s, that will be replaced by the matching rule. (defvar auto-insert-prompt "Perform %s auto-insertion? " (#$ . -1228)) #@686 A list specifying text to insert by default into a new file. Elements look like (CONDITION . ACTION) or ((CONDITION . DESCRIPTION) . ACTION). CONDITION maybe a regexp that must match the new file's name, or it may be a symbol that must match the major mode for this element to apply. Only the first matching element is effective. Optional DESCRIPTION is a string for filling `auto-insert-prompt'. ACTION may be a skeleton to insert (see `skeleton-insert'), an absolute file-name or one relative to `auto-insert-directory' or a function to call. ACTION may also be a vector containing several successive single actions as described above, e.g. ["header.insert" date-and-author-update]. (defvar auto-insert-alist (quote ((("\\.\\([Hh]\\|hh\\|hpp\\)\\'" . "C / C++ header") (upcase (concat (file-name-nondirectory (substring buffer-file-name 0 (match-beginning 0))) "_" (substring buffer-file-name (1+ (match-beginning 0))))) "#ifndef " str n "#define " str "\n\n" _ "\n\n#endif") (("\\.\\([Cc]\\|cc\\|cpp\\)\\'" . "C / C++ program") nil "#include \"" (and (fboundp (quote c-companion-file)) (file-name-nondirectory (c-companion-file (quote name)))) & 34 | -10) ("[Mm]akefile\\'" . "makefile.inc") ("\\.html\\'" nil "\n" "\n" "" _ "\n" "\n" "\n\n" "\n" "") (plain-tex-mode . "tex-insert.tex") (bibtex-mode . "tex-insert.tex") (latex-mode "options, RET: " "\\documentstyle[" str & 93 | -1 123 (read-string "class: ") "}\n" ("package, %s: " "\\usepackage[" (read-string "options, RET: ") & 93 | -1 123 str "}\n") _ "\n\\begin{document}\n" _ "\n\\end{document}") (("/bin/.*[^/]\\'" . "Shell-Script mode magic number") lambda nil (if (eq major-mode default-major-mode) (sh-mode))) (ada-mode . ada-header) (("\\.el\\'" . "Emacs Lisp header") "Short description: " ";;; " (file-name-nondirectory (buffer-file-name)) " --- " str "\n\n;; Copyright (C) " (substring (current-time-string) -4) " by " (getenv "ORGANIZATION") | "Free Software Foundation, Inc." "\n\n;; Author: " (user-full-name) (quote (if (search-backward "&" (save-excursion (beginning-of-line 1) (point)) t) (replace-match (capitalize (user-login-name)) t t))) (quote (end-of-line 1)) " <" (user-login-name) 64 (system-name) ">\n;; Keywords: " (quote (require (quote finder))) (quote (setq v1 (mapcar (lambda (x) (list (symbol-name (car x)))) finder-known-keywords) v2 (mapconcat (lambda (x) (format "%10.0s: %s" (car x) (cdr x))) finder-known-keywords "\n"))) ((let ((minibuffer-help-form v2)) (completing-read "Keyword, C-h: " v1 nil t)) str ", ") & -2 "\n\n;; This file is part of GNU Emacs.\n\n;; GNU Emacs is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 2, or (at your option)\n;; any later version.\n\n;; GNU Emacs is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.\n\n;;; Commentary:\n\n;; " _ "\n\n;;; Code:\n\n\n\n;;; " (file-name-nondirectory (buffer-file-name)) " ends here"))) (#$ . 1426)) #@54 *Directory from which auto-inserted files are taken. (defvar auto-insert-directory "~/insert/" (#$ . -4868)) #@145 Insert default contents into a new file if `auto-insert' is non-nil. Matches the visited file name against the elements of `auto-insert-alist'. (defalias 'auto-insert #[nil "?…Ï Â=„\n…Ïo…Ïm…Ï Ä‰‰‰ Êbˆ ƒu @@‰:„?‚IA@9ƒW =‚]Ì \"ƒl @Aĉ ‚* A‰ „- ƒ½ ;ƒ‡Î P!‚ˆÐƒ½ƒ¨Ò=ƒ Â=„¬ÓÔ\"!‚©Ðƒ½Ö×Ø !ƒ¸ ‚»Ù !\"ˆÚ …Î Â=?…ÎÛ\nÐ=!-‡" [buffer-read-only this-command auto-insert auto-insert-alist nil action desc cond case-fold-search alist 1 major-mode string-match buffer-file-name file-readable-p auto-insert-directory t auto-insert-query function y-or-n-p format auto-insert-prompt mapcar #[(action) ";ƒÁ\nP‰!…Ã!‡Ä‹‡" [action file-readable-p auto-insert-directory insert-file-contents ((byte-code "Àp!ˆ :ƒ @Â=„à !‡ ‡" [switch-to-buffer action lambda skeleton-insert] 2))] 3] vectorp vector buffer-modified-p set-buffer-modified-p] 6 (#$ . 4984) nil]) #@210 Associate CONDITION with (additional) ACTION in `auto-insert-alist'. Optional AFTER means to insert action after all existing actions for CONDITION, or if CONDITION had no actions, after all other CONDITIONs. (defalias 'define-auto-insert #[(key action &optional after) "À \n\"‰ƒM Ä A!ƒ5Å… AÄ!ƒ%‚)È!?…1 A#‚IƒCÈ A\"‚IÈ A\"¡‚dƒ\\\n BC¤‚d B\nB‰)‡" [assoc key auto-insert-alist elt vectorp vconcat after action vector] 6 (#$ . 5912)]) emacs-19.30/lisp/autoload.elc100666 74777 1 16167 5777325307 14446 0ustar esrdaemon;ELC ;;; compiled by kwzh@kropotkin.gnu.ai.mit.edu on Fri Jul 7 17:44:30 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/autoload.el ;;; emacs version 19.29.4. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`autoload.el' was compiled for Emacs 19.29 or later")) #@137 Turn FORM, a defun or defmacro, into an autoload for source file FILE. Returns nil if FORM is not a defun, define-skeleton or defmacro. (defalias 'make-autoload #[(form file) "¢‰Â>…V Ã=ĉA‰@ È=ƒ$‚&AA‰@‰;ƒ6A‚8ÄÉÊD È=†K@¢Ì=…SÊÍD¯+)‡" [form car (defun define-skeleton defmacro) defmacro nil doc name macrop define-skeleton autoload quote file interactive macro] 8 (#$ . 482)]) (put (quote define-skeleton) (quote doc-string-elt) 3) #@447 Magic comment indicating the following form should be autoloaded. Used by \[update-file-autoloads]. This string should be meaningless to Lisp (e.g., a comment). This string is used: ;;;###autoload (defun function-to-be-autoloaded () ...) If this string appears alone on a line, the following form will be read and an autoload made for it. If there is further text on the line, that text will be copied verbatim to `generated-autoload-file'. (defconst generate-autoload-cookie ";;;###autoload" (#$ . 952)) #@82 String inserted before the form identifying the section of autoloads for a file. (defconst generate-autoload-section-header "\f\n;;;### " (#$ . 1468)) #@72 String which indicates the end of the section of autoloads for a file. (defconst generate-autoload-section-trailer "\n;;;***\n" (#$ . 1625)) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#‡" [put autoload doc-string-elt 3 defun defvar defconst defmacro] 4) (defalias 'autoload-trim-file-name #[(file) "À ! Ã\f!\"‡" [expand-file-name file file-relative-name file-name-directory generated-autoload-file] 4]) #@237 Insert at point a loaddefs autoload section for FILE. autoloads are generated for defuns and defmacros in FILE marked by `generate-autoload-cookie' (which see). If FILE is being visited in a buffer, the contents of the buffer are used. (defalias 'generate-file-autoloads #[(file) "pÀÁ\n!ÄÅ \"ƒ Ɖ”O‚ )ÀÇÀ‰È\n!À \n \f Ò\n!Ó\n!ÕÓ!!‰G‰GWƒaÆO˜ƒaÀO+ÙÚ\n\"ˆŠÛŽÜ\n!qˆŠŒ~ˆebˆm„ŽÝÀwˆÞß !!ƒxá !ˆâÀwˆÇ lƒeãp!n„¡äyˆ%æ%\"'%¢èN('ƒÃ%A@B‚Ç%'(ƒV('8;ƒV(S'›‰)A*)À¡ˆëì\"ˆÇ-îï'\"ˆ)ëð\"ˆŠqˆ`)1ëò*@!äÀO\"ˆŠqˆŠóì1Ç#ƒ*äuˆôcˆ‚**A„:ëõ\"ˆ‚Mëö\"ˆëò*A!äÀO\"ˆ÷!ˆ+‚aÇ-ø'\"ˆ)+‚v`1äyˆë1`{\"ˆ)‚vÞù!ƒ„äyˆ‚vúä!ˆäyˆ‚v, ƒø;cˆüýþ\n!ÿ@\n!8¯\"ˆ÷!ˆAþ\n!B±ˆ` Wƒð`CÀˆ`CZDVƒéÙE!ˆFG!ˆ bˆ)äyˆ‚¿ bˆHcˆÙI\n\". ‡" [nil file-name-nondirectory file name string-match "\\.elc?$" 0 t get-file-buffer output-end visited done-any float-output-format print-readably print-length load-name autoloads-done outbuf expand-file-name file-truename source-truename file-name-as-directory default-directory dir-truename len message "Generating autoloads for %s..." ((byte-code "„Áp!ˆ\nqˆÃ Á‡" [visited kill-buffer outbuf point-marker output-end] 2)) find-file-noselect " \n\f" looking-at regexp-quote generate-autoload-cookie search-forward " " read 1 form make-autoload autoload doc-string-elt p elt princ "\n(" print-escape-newlines mapcar #[(elt) "À \n\"ˆÃÄ\n\"‡" [prin1 elt outbuf princ " "] 3] "\"\\\n" begin prin1-to-string search-backward "\\" ")" " " terpri print ";" forward-sexp generate-autoload-section-header prin1 autoloads autoload-trim-file-name 5 file-attributes ";;; Generated autoloads from " "\n" beg 900 "A line is too long--over 900 characters" sleep-for 2 generate-autoload-section-trailer "Generating autoloads for %s...done"] 10 (#$ . 2034) "fGenerate autoloads for file: "]) #@149 *File \[update-file-autoloads] puts autoloads into. A .el file can set this in its local variables section to make its autoloads go somewhere else. (defconst generated-autoload-file "loaddefs.el" (#$ . -3941)) #@108 Update the autoloads for FILE in `generated-autoload-file' (which FILE might bind in its local variables). (defalias 'update-file-autoloads #[(file) "À !ÃÄ\n\"ƒ\nʼn”O‚\n)ÆÇ ! \nŠË !qˆË\f!qˆŠŒ~ˆebˆ „ÌÍÆÏ#ƒÌÆÐÑÓ8\n˜ƒ·Å”Ô8ÕÖ !8ƒmÚ!„¦<ƒ¦GÓUƒ¦@@V„›@@Uƒ¦A@A@Yƒ¦ÛÜ \"ˆÝ ‚³Í!ˆ`|ˆÏ +‚È\nÓ8™ƒÈÅ”bˆß )‚2 Ý=„ ß=ƒŠË !qˆŠ~ˆebˆÍà!PÆÏ#ƒõÆ‚ÿtƒþÛ â\"ˆÏ*„ã !ˆ*tƒä ˆ?…\"Ç !‰…\"å!,‡" [file-name-nondirectory file name string-match "\\.elc?$" 0 nil get-file-buffer existing-buffer found load-name find-file-noselect generated-autoload-file search-forward generate-autoload-section-header t (byte-code "Àp!‡" [read] 2) ((end-of-file)) form 2 4 5 file-attributes file-time last-time begin buffer-modified-p message "Autoload section for %s is up to date." up-to-date generate-autoload-section-trailer new "\n" generate-autoload-cookie " has no autoloads" generate-file-autoloads save-buffer kill-buffer] 5 (#$ . 4158) "fUpdate autoloads for file: "]) #@78 Update sections of the current buffer generated by \[update-file-autoloads]. (defalias 'update-autoloads-here #[nil "À ŠebˆÂ ÄÅ#…iÄÆÇÉ8‰\n;ƒ.Ë\n!„FÌ\n!„FÍÎÏÐ8\n#!ƒ@Å‚DÄÑÒ\n\nƒZÓ”Â!ˆ`|ˆ)\n;ƒeÖ\n!ˆ*‚*‡" [buffer-file-name generated-autoload-file search-forward generate-autoload-section-header nil t (byte-code "Àp!‡" [read] 2) ((end-of-file)) form 3 file get-file-buffer file-exists-p y-or-n-p format "Can't find library `%s'; remove its autoloads? " 2 (byte-code "ÀÁÂÃ\f8\"ʼnÆ$‡" [read-file-name format "Find `%s' load file: " 2 form nil t] 5) ((quit)) 0 begin generate-autoload-section-trailer generate-file-autoloads] 6 (#$ . 5184) nil]) #@55 Run \[update-file-autoloads] on each .el file in DIR. (defalias 'update-directory-autoloads #[(dir) "ÀÂÃÄ ÆÇ#\"ˆ)t…ŠÈ !qˆÊ )‡" [nil enable-local-eval mapcar update-file-autoloads directory-files dir t "^[^=].*\\.el$" find-file-noselect generated-autoload-file save-buffer] 6 (#$ . 5862) "DUpdate autoloads for directory: "]) #@357 Update the autoloads for the files or directories on the command line. Runs \[update-file-autoloads] on files and \[update-directory-autoloads] on directories. Must be used only with -batch, and kills Emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke `emacs -batch -f batch-update-autoloads *.el'. (defalias 'batch-update-autoloads #[nil "„ÁÂ!ˆÃ\fÃÈÉ\n\"ˆË\fƒYÍÎ@!!ƒIÏ@ÐÑ#‰ƒE\f@!ˆA‰„5)‚P\f@!ˆA‰„)ÓÐ!ˆÈÔ!ˆÕƒlÖ‚m×!+‡" [noninteractive error "batch-update-autoloads is to be used only with -batch" nil command-line-args-left enable-local-eval args lost message "Updating autoloads in %s..." generated-autoload-file #[(file) "ÀÁ‡" [lossage (update-file-autoloads file) ((error (byte-code "ÀÁ!ˆÀ\n!ˆÀÃ!ˆÄÅ!ƒÅÇ\"ˆ‚ È!ˆÀÉ!ˆÊ‰ ‡" [princ ">>Error processing " file ": " fboundp display-error lossage nil prin1 "\n" t lost] 3)))] 3] frob file-directory-p expand-file-name directory-files t "\\.el$" rest save-some-buffers "Done" kill-emacs 1 0] 5 (#$ . 6198)]) (provide (quote autoload)) emacs-19.30/lisp/avoid.elc100666 12120 1 17426 6045211702 13673 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:04:42 1995 ;;; from file /home/fsf/rms/e19/lisp/avoid.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`avoid.el' was compiled for Emacs 19.29 or later")) (provide (quote avoid)) #@223 Value is t or a symbol if the mouse pointer should avoid the cursor. See function `mouse-avoidance-mode' for possible values. Changing this variable is NOT the recommended way to change modes; use that function instead. (defvar mouse-avoidance-mode nil (#$ . 495)) #@204 *Average distance that mouse will be moved when approached by cursor. Only applies in mouse-avoidance-mode `jump' and its derivatives. For best results make this larger than `mouse-avoidance-threshold'. (defvar mouse-avoidance-nudge-dist 15 (#$ . -769)) #@59 *Variability of `mouse-avoidance-nudge-dist' (which see). (defvar mouse-avoidance-nudge-var 10 (#$ . -1029)) #@44 Delay between animation steps, in seconds. (defvar mouse-avoidance-animation-delay .01 (#$ . 1144)) #@166 *Mouse-pointer's flight distance. If the cursor gets closer than this, the mouse pointer will move away. Only applies in mouse-avoidance-modes `animate' and `jump'. (defvar mouse-avoidance-threshold 5 (#$ . -1251)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÆÅ B‡" [boundp mouse-avoidance-state nil current-load-list mouse-avoidance-pointer-shapes mouse-avoidance-n-pointer-shapes 0] 2) #@46 Set the shape of the mouse pointer to SHAPE. (defalias 'mouse-avoidance-set-pointer-shape #[(shape) "ÂÃ!‡" [shape x-pointer-shape set-mouse-color nil] 2 (#$ . 1646)]) (put (quote mouse-avoidance-set-pointer-shape) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@77 Return the position of point as (FRAME X . Y). Analogous to mouse-position. (defalias 'mouse-avoidance-point-position #[nil "À  !ÄÅ !e]Æ`Ç È BÇ SÉ !ÊBÀ & Ì @ A@\\ A@ AA@\\+BB‡" [selected-window w window-edges edges compute-motion window-start (0 . 0) window-width window-height window-hscroll 0 list selected-frame] 8 (#$ . 1927)]) (defalias 'mouse-avoidance-set-mouse-position #[(pos) "À  !ˆÃ \f@\fA#ˆ)Ň" [selected-frame f raise-frame set-mouse-position pos t] 4]) (defalias 'mouse-avoidance-too-close-p #[(mouse) "À \n@ @=…*\nA@…*Ã\nA@ A@Z!\fW…*Ã\nAA AAZ!\fW)‡" [mouse-avoidance-point-position point mouse abs mouse-avoidance-threshold] 3]) #@146 The position to which mouse-avoidance-mode `banish' moves the mouse. You can redefine this if you want the mouse banished to a different corner. (defalias 'mouse-avoidance-banish-destination #[nil "À SÁB‡" [frame-width 0] 2 (#$ . 2592)]) (defalias 'mouse-avoidance-banish-mouse #[nil "ÀÁ !‡" [mouse-avoidance-set-mouse-position mouse-avoidance-banish-destination] 2]) (defalias 'mouse-avoidance-delta #[(cur delta dist var min max) " Z\n[ [\\]\n[ \\\n [\\\f Z\n \\^ ZWƒ.ÉÉ\f ZVƒ<ÉɃN\nWƒN‚¢ƒ`\nWƒ`\n‚¢ƒq\nËWƒq‚¢ƒƒ\nWƒƒ‚¢ ƒ“\n Wƒ“\n‚¢ †¢†¢†¢Ë,‡" [min cur dist var max R2 L2 R1 L1 nil delta 0] 6]) (put (quote mouse-avoidance-delta) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'mouse-avoidance-nudge-mouse #[nil "À ‰@ A‰@Ä !@Z ÈÉ \n \f  Z [\f[\\] [\f\\ \f[\\\n Z \f\\^ ZWƒ]ÓÓ\n ZVƒmÓÓƒWƒ‚Öƒ‘Wƒ‘‚Öƒ¢ÈWƒ¢‚Öƒ´Wƒ´‚ÖƒÆWƒÆ‚Ö†Ö†Ö†ÖÈ.\n AÄ !AZ ÈÕ \n \f  Z [\f[\\] [\f\\ \f[\\\n Z \f\\^ ZWƒ.ÓÓ\n ZVƒ>ÓÓƒPWƒP‚§ƒbWƒb‚§ƒsÈWƒs‚§ƒ…Wƒ…‚§ƒ—Wƒ—‚§†§†§†§È.\n@\\A\\BØ=„ÈÙ=ƒÚÜX…Ý @Þ_!\\ AÞ_!\\B!ˆßà¥]\\Ù=ƒá ‰\"#äÓ!ˆ)å&!ˆ‚Ë)‚#Ý A@\\ AA\\B!-‡" [mouse-position cur cur-frame cur-pos random mouse-avoidance-nudge-var mouse-avoidance-state mouse-avoidance-nudge-dist 0 frame-width max min var dist delta R2 L2 R1 L1 nil deltax frame-height deltay mouse-avoidance-mode animate proteus 0.0 i 1 mouse-avoidance-set-mouse-position round .1 1.0 mouse-avoidance-random-shape shape x-pointer-shape set-mouse-color sit-for mouse-avoidance-animation-delay] 7]) #@213 Return a random cursor shape. This assumes that any variable whose name begins with x-pointer- and has an integer value is a valid cursor shape. You might want to redefine this function to suit your own tastes. (defalias 'mouse-avoidance-random-shape #[nil "„ÁÂÃÄ Æ#\"‰GÈ!8‡" [mouse-avoidance-pointer-shapes mapcar #[(x) "À !J‡" [intern x] 2] all-completions "x-pointer-" obarray (lambda (x) (and (boundp x) (integerp (symbol-value x)))) mouse-avoidance-n-pointer-shapes random] 7 (#$ . 4396)]) (defalias 'mouse-avoidance-banish-hook #[nil "?…Á !…à ‡" [executing-kbd-macro mouse-avoidance-kbd-command this-command-keys mouse-avoidance-banish-mouse] 2]) (defalias 'mouse-avoidance-exile-hook #[nil "?…DÁ !…Dà  „ Æ\f!ƒ \fÇ ‚C …CÆ !?…C\f@È =ƒ@\fAÉ šƒ@Ê A!ˆË‰)‡" [executing-kbd-macro mouse-avoidance-kbd-command this-command-keys mouse-position mp mouse-avoidance-state mouse-avoidance-too-close-p mouse-avoidance-banish-mouse selected-frame mouse-avoidance-banish-destination mouse-avoidance-set-mouse-position nil] 2]) (defalias 'mouse-avoidance-fancy-hook #[nil "?…'Á !…'ÃÄ !…'Ä Æ ˆÇ @=?…&ÈÉ \")‡" [executing-kbd-macro mouse-avoidance-kbd-command this-command-keys mouse-avoidance-too-close-p mouse-position old-pos mouse-avoidance-nudge-mouse selected-frame apply set-mouse-position] 3]) #@120 Return t if the KEYSEQENCE is composed of keyboard events only. Return nil if there are any lists in the key sequence. (defalias 'mouse-avoidance-kbd-command #[(key) "„Á‡Â!„ÇÄŇ" [key nil vectorp t done (byte-code "À G‰\nWƒ H<ƒÄÅÆ\"ˆ T‰‚*LJ" [0 key l i throw done nil t] 4)] 2 (#$ . 5729)]) #@1122 Set cursor avoidance mode to MODE. MODE should be one of the symbols `banish', `exile', `jump', `animate', `cat-and-mouse', `proteus', or `none'. If MODE is nil, toggle mouse avoidance between `none` and `banish' modes. Positive numbers and symbols other than the above are treated as equivalent to `banish'; negative numbers and `-' are equivalent to `none'. Effects of the different modes: * banish: Move the mouse to the upper-right corner on any keypress. * exile: Move the mouse to the corner only if the cursor gets too close, and allow it to return once the cursor is out of the way. * jump: If the cursor gets too close to the mouse, displace the mouse a random distance & direction. * animate: As `jump', but shows steps along the way for illusion of motion. * cat-and-mouse: Same as `animate'. * proteus: As `animate', but changes the shape of the mouse pointer too. Whenever the mouse is moved, the frame is also raised. (see `mouse-avoidance-threshold' for definition of "too close", and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for definition of "random distance".) (defalias 'mouse-avoidance-mode #[(&optional mode) "Á=ƒÂÃÄÅ\"ˆÃÄÆ\"ˆÃÄÇ\"ˆÈ=ƒ#É\n‚ˆË=„5Â=„5Ì=ƒEÍÄÇ\"ˆ\nΉB‚ˆÐ=ƒYÍÄÆ\"ˆ\nÉ‚ˆÑ=„zÒ=„z„n\nƒzƒ…Ó!ÎVƒ…ÍÄÅ\"ˆÑ\n‚ˆÉ\nÔ ‡" [mode cat-and-mouse animate remove-hook post-command-idle-hook mouse-avoidance-banish-hook mouse-avoidance-exile-hook mouse-avoidance-fancy-hook none nil mouse-avoidance-mode jump proteus add-hook 0 mouse-avoidance-state exile banish t prefix-numeric-value force-mode-line-update] 3 (#$ . 6046) (list (intern (completing-read "Select cursor avoidance technique (SPACE for list): " (quote (("banish") ("exile") ("jump") ("animate") ("cat-and-mouse") ("proteus") ("none"))) nil t)))]) (byte-code "À ž„\n BÀ‡" [mouse-avoidance-mode minor-mode-alist (mouse-avoidance-mode " Avoid")] 2) emacs-19.30/lisp/awk-mode.elc100666 74777 1 3657 6051026073 14302 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 10 23:53:13 1995 ;;; from file /home/fsf/rms/e19/lisp/awk-mode.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`awk-mode.el' was compiled for Emacs 19.29 or later")) #@42 Syntax table in use in Awk-mode buffers. (defvar awk-mode-syntax-table nil (#$ . 476)) (byte-code "„aÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÆ#ˆÂÈÉ#ˆÂÊË#ˆÂÌË#ˆÂÍË#ˆÂÎË#ˆÂÏË#ˆÂÐË#ˆÂÑË#ˆÂÒË#ˆÂÓË#ˆÂÔË#ˆÂÕÖ#ˆÁ‡" [awk-mode-syntax-table make-syntax-table modify-syntax-entry 92 "\\" 10 "> " 12 35 "< " 47 "." 42 43 45 61 37 60 62 38 124 39 "\""] 4) #@42 Abbrev table in use in Awk-mode buffers. (defvar awk-mode-abbrev-table nil (#$ . 821)) (define-abbrev-table (quote awk-mode-abbrev-table) nil) #@349 Major mode for editing AWK code. This is much like C mode except for the syntax of comments. It uses the same keymap as C mode and has the same variables for customizing indentation. It has its own abbrev table and its own syntax table. Turning on AWK mode calls the value of the variable `awk-mode-hook' with no args, if that value is non-nil. (defalias 'awk-mode #[nil "À ˆÁÂ!ˆÃ\f!ˆÅÇ \nË\f!ˆÍÎ!ˆÏPÍÑ!ˆÍÒ!ˆÓÍÔ!ˆÕÍÖ!ˆÓÍ×!ˆØÍÙ!ˆÚÍÛ!ˆÜÍÝ!ˆÞÍß!ˆàáâ!‡" [kill-all-local-variables require cc-mode use-local-map c-mode-map awk-mode major-mode "AWK" mode-name awk-mode-abbrev-table local-abbrev-table set-syntax-table awk-mode-syntax-table make-local-variable paragraph-start "$\\|" page-delimiter paragraph-separate paragraph-ignore-fill-prefix t indent-line-function c-indent-line require-final-newline comment-start "# " comment-end "" comment-column 32 comment-start-skip "#+ *" comment-indent-function c-comment-indent run-hooks awk-mode-hook] 2 (#$ . 971) nil]) emacs-19.30/lisp/backquote.elc100666 13437 1 6114 6045211710 14652 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:04:51 1995 ;;; from file /home/fsf/rms/e19/lisp/backquote.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`backquote.el' was compiled for Emacs 19.29 or later")) (provide (quote backquote)) #@117 Like `list' but the last argument is the tail of the new list. For example (backquote-list* 'a 'b 'c) => (a b . c) (defalias 'backquote-list*-function #[(first &rest list) "ƒ*\nÃB‰ Aƒ\" @ÃB¡ˆ A A‰‚ @¡ˆ\f+‡\n‡" [list rest first nil newlist last] 4 (#$ . 507)]) #@117 Like `list' but the last argument is the tail of the new list. For example (backquote-list* 'a 'b 'c) => (a b . c) (defalias 'backquote-list*-macro '(macro . #[(first &rest list) "À \nB!‰@\nA‰ƒ3\n@\nAÅ E\fƒ/Å\f@E\fA‰„ +‡ ‡" [reverse first list second rest cons newlist] 4 (#$ . 788)])) (byte-code "ÀÁÂK\"‡" [defalias backquote-list* backquote-list*-macro] 3) #@69 *Symbol used to represent a backquote or nested backquote (e.g. `). (defvar backquote-backquote-symbol (quote \`) (#$ . -1172)) #@69 *Symbol used to represent an unquote (e.g. `,') inside a backquote. (defvar backquote-unquote-symbol (quote \,) (#$ . -1306)) #@68 *Symbol used to represent a splice (e.g. `,@') inside a backquote. (defvar backquote-splice-symbol (quote \,@) (#$ . -1438)) #@494 Argument STRUCTURE describes a template to build. The whole structure acts as if it were quoted except for certain places where expressions are evaluated and inserted or spliced in. For example: b => (ba bb bc) ; assume b has this value `(a b c) => (a b c) ; backquote acts like quote `(a ,b c) => (a (ba bb bc) c) ; insert the value of b `(a ,@b c) => (a ba bb bc c) ; splice in the value of b Vectors work just like lists. Nested backquotes are permitted. (defalias 'backquote '(macro . #[(arg) "À !A‡" [backquote-process arg] 2 (#$ . 1570)])) (byte-code "ÀÁÂK\"‡" [defalias \` backquote] 3) (defalias 'backquote-process #[(s) "À !ƒCÂà Ä\"!‰@ÆUƒÆ B‚AÇ A@È=ƒ+É AAB‚@ A@Ã=ƒ;Ê AAB‚@ËÌ AEB)‡ :„aÆ ƒX Í=„X 9„\\ ‚_Î DB‡ @=ƒoÇ A@B‡ @=ƒ}Ñ A@B‡ @=ƒŽÂ‰ A@!A!‡ ĉ‰‰‰‰:ƒÿ@=ƒ¸A@DCÂ@!‰@ÑUƒï„ÒăáØÙ\"BABÄ‚öBA‰‚¡„ ƒØÂ!\"BA„&@¢=ƒ.ßB‚1@ƒBØÇB\"¢Î=ƒRÆÎ DB‚VÇB.‡" [vectorp s backquote-process append nil n 0 1 list vector vconcat apply (function vector) t quote backquote-unquote-symbol backquote-splice-symbol 2 backquote-backquote-symbol expression lists firstlist item rest backquote-listify (0)] 7]) (defalias 'backquote-listify #[(list old-tail) "À A\nÀ @ÇUƒÈ !À\f:ƒF\f@\fA„2 „2 @ÇU„< AB‚È A! B‚ ƒ… „RÉ DƒA†k@:…k@@\n=‰ ƒuÌ‚vÍÎ C\")B‚‰ ‚‰ÂB,‡" [nil old-tail list item list-tail tail heads 0 eval quote backquote-splice-symbol use-list* backquote-list* cons append] 5]) emacs-19.30/lisp/bib-mode.elc100666 74777 1 12637 5751545255 14310 0ustar esrdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:13:31 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/bib-mode.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/bib-mode.el' was compiled for Emacs 19")) #@40 Default name of file used by `addbib'. (defvar bib-file "~/my-bibliography.bib" (#$ . 485)) #@56 Default name of file used by `unread-bib' in Bib mode. (defvar unread-bib-file "~/to-be-read.bib" (#$ . 583)) (byte-code "ÀÁ!„\n !Á\fBÅ ÆÇ#ˆÅ ÈÉ#ˆÅ ÊË#ˆÅ ÌÍ#‡" [boundp bib-mode-map copy-keymap text-mode-map current-load-list define-key " " return-key-bib "" unread-bib "" mark-bib "`" abbrev-mode] 4) #@31 Abbrev table used in Bib mode (defvar bib-mode-abbrev-table nil (#$ . 899)) #@123 Set up editor to add to troff bibliography file specified by global variable `bib-file'. See description of `bib-mode'. (defalias 'addbib #[nil "À !ˆdbˆÂ ‡" [find-file bib-file bib-mode] 2 (#$ . 982) nil]) #@1144 Mode for editing `lookbib' style bibliographies. Hit RETURN to get next % field key. If you want to ignore this field, just hit RETURN again. Use `text-mode' to turn this feature off. journal papers: A* T D J V N P K W X articles in books & proceedings: A* T D B E* I C P K W X tech reports: A* T D R I C K W X books: A* T D I C K W X Fields: A uthor T itle D ate J ournal V olume N umber P age K eywords B in book or proceedings E ditor C ity & state I nstitution, school, or publisher R eport number or 'phd thesis' or 'masters thesis' or 'draft' or 'unnumbered' or 'unpublished' W here can be found locally (login name, or ailib, etc.) X comments (not used in indexing) \[unread-bib] appends current entry to a different file (for example, a file of papers to be read in the future), given by the value of the variable `unread-bib-file'. \[mark-bib] marks current or previous entry. Abbreviations are saved in `bib-mode-abbrev-table'. Hook can be stored in `bib-mode-hook'. Field keys given by variable `bib-assoc'. Commands: \{bib-mode-map}  (defalias 'bib-mode #[nil "À ˆÁ\n!ˆÃÅÇÈÉ\"ˆ\nËÌ!ˆÍÎ!‡" [text-mode use-local-map bib-mode-map "Bib" mode-name bib-mode major-mode define-abbrev-table bib-mode-abbrev-table nil local-abbrev-table abbrev-mode 1 run-hooks bib-mode-hook] 3 (#$ . 1198) nil]) #@129 Describes bibliographic database format. A line beginning with the car of an entry is followed by one beginning with the cdr.  (defconst bib-assoc (quote ((" *$" . "%A ") ("%A ." . "%A ") ("%A $" . "%T ") ("%T " . "%D ") ("%D " . "%J ") ("%J ." . "%V ") ("%V " . "%N ") ("%N " . "%P ") ("%P " . "%K ") ("%K " . "%W ") ("%W " . "%X ") ("%X " . "") ("%J $" . "%B ") ("%B ." . "%E ") ("%E ." . "%E ") ("%E $" . "%I ") ("%I " . "%C ") ("%C " . "%P ") ("%B $" . "%R ") ("%R " . "%I "))) (#$ . 2607)) (defalias 'bib-find-key #[(slots) "„oƒ\nÁ‡ÂÃ!ˆÄ !‡Æ@@!ƒ@A‡ÄA!‡" [slots "" previous-line 1 bib-find-key bib-assoc looking-at] 2]) #@67 *True to automatically capitalize appropriate fields in Bib mode. (defvar bib-auto-capitalize t (#$ . -3247)) (byte-code "ÀÁ\nBÁ‡" ["%[AETCBIJR]" bib-capitalized-fields current-load-list] 2) #@50 Magic when user hits return, used by `bib-mode'. (defalias 'return-key-bib #[nil "lƒ^À‰‰‰ÅyˆÆÇ!‰„ ÀˆÈ ˆÉyˆÀˆ`Åyˆ`Ê !\f„H\fƒHÆ !ƒHŠÎ`Ï\\ \"ˆ)\nbˆ\fƒVÐÀ!ˆ‚YÑyˆÒ !,‡È ‡" [nil end-current beg-current new-key empty 0 looking-at "%. $" newline -1 bib-find-key bib-assoc bib-auto-capitalize bib-capitalized-fields capitalize-title-region 3 kill-line 1 insert-string] 5 (#$ . 3446) nil]) #@71 Set mark at beginning of current or previous bib entry, point at end. (defalias 'mark-bib #[nil "ÀyˆÁÂ!ƒÃÄÅÆ#ˆÃÂÅÆ#ˆÇÈ!ˆÀyˆÉ`!ˆÇÂÅÆ#ˆÊË!ˆÀyˆÅ‡" [0 looking-at "^ *$" re-search-backward "[^ \n]" nil 2 re-search-forward "^%" push-mark next-line 1] 4 (#$ . 3852) nil]) #@96 Append current or previous entry to file of unread papers named by variable `unread-bib-file'. (defalias 'unread-bib #[nil "À ˆÁ\n!ƒÃÁ\n!Ä `#‡ÅÄ `\n#‡" [mark-bib get-file-buffer unread-bib-file append-to-buffer mark append-to-file] 4 (#$ . 4125) nil]) #@87 Words not to be capitialized in a title (unless they're the first word in the title). (defvar capitalize-title-stop-words (concat "the\\|and\\|of\\|is\\|a\\|an\\|of\\|for\\|in\\|to\\|in\\|on\\|at\\|" "by\\|with\\|that\\|its") (#$ . 4385)) (byte-code "ÀÁ!„  ÄQÁ BÀ‡" [boundp capitalize-title-stop-regexp "\\(" capitalize-title-stop-words "\\)\\(\\b\\|'\\)" current-load-list] 3) #@78 Like `capitalize-region', but don't capitalize stop words, except the first. (defalias 'capitalize-title-region #[(begin end) "ÀÁ ÄŽŒÅ!ˆ}ˆebˆÉÊ!ƒ\"Ëvˆ‚&ÌË!ˆÍÎÀÏ#…RÉÊ!ƒ:Ëvˆ‚&ÏÉ!)ƒKÑË!ˆ‚&ÌË!ˆ‚&,‡" [nil syntax-table orig-syntax-table case-fold-search ((set-syntax-table orig-syntax-table)) set-syntax-table text-mode-syntax-table begin end looking-at "[A-Z][a-z]*[A-Z]" 1 capitalize-word re-search-forward "\\<" t capitalize-title-stop-regexp downcase-word] 4 (#$ . 4773) "r"]) #@71 Like `capitalize', but don't capitalize stop words, except the first. (defalias 'capitalize-title #[(s) "ŠÀÁ!qˆÂ ˆ cˆÄed\"ˆÅ )‡" [get-buffer-create "$$$Scratch$$$" erase-buffer s capitalize-title-region buffer-string] 3 (#$ . 5273)]) (provide (quote bib-mode)) emacs-19.30/lisp/bibtex.elc100666 74777 1 141130 6011351636 14102 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Aug 7 04:48:54 1995 ;;; from file /home/fsf/rms/e19/lisp/bibtex.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`bibtex.el' was compiled for Emacs 19.29 or later")) #@92 *Set this to { or " according to your personal preferences. This variable is buffer local. (defvar bibtex-field-left-delimiter "{" (#$ . -470)) (make-variable-buffer-local (quote bibtex-field-left-delimiter)) #@92 *Set this to } or " according to your personal preferences. This variable is buffer local. (defvar bibtex-field-right-delimiter "}" (#$ . -685)) (make-variable-buffer-local (quote bibtex-field-right-delimiter)) #@58 *All entries listed here will have an OPTcrossref field. (defvar bibtex-include-OPTcrossref (quote ("InProceedings" "InCollection")) (#$ . -902)) #@53 *If non-nil, all entries will have an OPTkey field. (defvar bibtex-include-OPTkey t (#$ . -1054)) #@56 *If non-nil, all entries will have an OPTannote field. (defvar bibtex-include-OPTannote t (#$ . -1158)) #@208 *List of optional fields the user wants to have always present. Entries should be lists of strings with two elements (first element = name of the field, second element = comment to appear in the echo area). (defvar bibtex-mode-user-optional-fields nil (#$ . -1269)) #@72 *If non-nil, bibtex-clean-entry will delete all empty optional fields. (defvar bibtex-clean-entry-zap-empty-opts t (#$ . -1541)) #@198 *If true, BibTeX @STRING entries are not sort-significant. That means they are ignored when determining ordering of the buffer (e.g. sorting, locating alphabetical position for new entries, etc.). (defvar bibtex-sort-ignore-string-entries t (#$ . -1677)) #@185 *If true, bibtex-mode maintains all BibTeX entries in sorted order. Setting this variable to nil will strip off some comfort (e.g. TAB completion for reference keys) from bibtex-mode. (defvar bibtex-maintain-sorted-entries nil (#$ . -1939)) #@561 Defines reference types and their associated fields. List of (entry-name (required optional) (crossref-required crossref-optional)) triples. If the third element is nil, the first pair is always to be used. If not, the second pair is to be used in the case of presence of a crossref field and the third in the case of absence. Required , optional, crossref-required and crossref-optional are lists. Each element of these lists is a list of strings with two elements (first element = name of the field, second element = comment to appear in the echo area). (defvar bibtex-entry-field-alist (quote (("Article" ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the article (will be converted to lowercase)") ("journal" "Name of the journal (use string, remove braces)") ("year" "Year of publication")) (("volume" "Volume of the journal") ("number" "Number of the journal") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the journal") ("note" "Remarks to be put at the end of the \\bibitem"))) ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the article (will be converted to lowercase)")) (("journal" "Name of the journal (use string, remove braces)") ("year" "Year of publication") ("volume" "Volume of the journal") ("number" "Number of the journal") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the journal") ("note" "Remarks to be put at the end of the \\bibitem")))) ("Book" ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the book") ("publisher" "Publishing company") ("year" "Year of publication")) (("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the book in the series") ("number" "Number of the book in a small series (overwritten by volume)") ("series" "Series in which the book appeared") ("address" "Address of the publisher") ("edition" "Edition of the book as a capitalized English word") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem")))) ("Booklet" ((("title" "Title of the booklet (will be converted to lowercase)")) (("author" "Author1 [and Author2 ...] [and others]") ("howpublished" "The way in which the booklet was published") ("address" "Address of the publisher") ("year" "Year of publication") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem")))) ("InBook" ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the book") ("chapter" "Chapter in the book") ("publisher" "Publishing company") ("year" "Year of publication")) (("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the book in the series") ("number" "Number of the book in a small series (overwritten by volume)") ("series" "Series in which the book appeared") ("address" "Address of the publisher") ("edition" "Edition of the book as a capitalized English word") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the book") ("type" "Word to use instead of \"chapter\"") ("note" "Remarks to be put at the end of the \\bibitem"))) ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the book") ("chapter" "Chapter in the book")) (("publisher" "Publishing company") ("year" "Year of publication") ("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the book in the series") ("number" "Number of the book in a small series (overwritten by volume)") ("series" "Series in which the book appeared") ("address" "Address of the publisher") ("edition" "Edition of the book as a capitalized English word") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the book") ("type" "Word to use instead of \"chapter\"") ("note" "Remarks to be put at the end of the \\bibitem")))) ("InCollection" ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the article in book (will be converted to lowercase)") ("booktitle" "Name of the book") ("publisher" "Publishing company") ("year" "Year of publication")) (("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the book in the series") ("number" "Number of the book in a small series (overwritten by volume)") ("series" "Series in which the book appeared") ("chapter" "Chapter in the book") ("type" "Word to use instead of \"chapter\"") ("address" "Address of the publisher") ("edition" "Edition of the book as a capitalized English word") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the book") ("note" "Remarks to be put at the end of the \\bibitem"))) ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the article in book (will be converted to lowercase)") ("booktitle" "Name of the book")) (("publisher" "Publishing company") ("year" "Year of publication") ("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the book in the series") ("number" "Number of the book in a small series (overwritten by volume)") ("series" "Series in which the book appeared") ("chapter" "Chapter in the book") ("type" "Word to use instead of \"chapter\"") ("address" "Address of the publisher") ("edition" "Edition of the book as a capitalized English word") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the book") ("note" "Remarks to be put at the end of the \\bibitem")))) ("InProceedings" ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the article in proceedings (will be converted to lowercase)") ("booktitle" "Name of the conference proceedings") ("year" "Year of publication")) (("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the conference proceedings in the series") ("number" "Number of the conference proceedings in a small series (overwritten by volume)") ("series" "Series in which the conference proceedings appeared") ("organization" "Sponsoring organization of the conference") ("publisher" "Publishing company, its location") ("address" "Location of the Proceedings") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the conference proceedings") ("note" "Remarks to be put at the end of the \\bibitem"))) ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the article in proceedings (will be converted to lowercase)") ("booktitle" "Name of the conference proceedings")) (("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the conference proceedings in the series") ("number" "Number of the conference proceedings in a small series (overwritten by volume)") ("series" "Series in which the conference proceedings appeared") ("year" "Year of publication") ("organization" "Sponsoring organization of the conference") ("publisher" "Publishing company, its location") ("address" "Location of the Proceedings") ("month" "Month of the publication as a string (remove braces)") ("pages" "Pages in the conference proceedings") ("note" "Remarks to be put at the end of the \\bibitem")))) ("Manual" ((("title" "Title of the manual")) (("author" "Author1 [and Author2 ...] [and others]") ("organization" "Publishing organization of the manual") ("address" "Address of the organization") ("edition" "Edition of the manual as a capitalized English word") ("year" "Year of publication") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem")))) ("MastersThesis" ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the master's thesis (will be converted to lowercase)") ("school" "School where the master's thesis was written") ("year" "Year of publication")) (("address" "Address of the school (if not part of field \"school\") or country") ("type" "Type of the master's thesis") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem")))) ("Misc" (nil (("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the reference (will be converted to lowercase)") ("howpublished" "The way in which the reference was published") ("year" "Year of publication") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem")))) ("PhdThesis" ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the PhD. thesis") ("school" "School where the PhD. thesis was written") ("year" "Year of publication")) (("address" "Address of the school (if not part of field \"school\") or country") ("type" "Type of the PhD. thesis") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem")))) ("Proceedings" ((("title" "Title of the conference proceedings") ("year" "Year of publication")) (("editor" "Editor1 [and Editor2 ...] [and others]") ("volume" "Volume of the conference proceedings in the series") ("number" "Number of the conference proceedings in a small series (overwritten by volume)") ("series" "Series in which the conference proceedings appeared") ("publisher" "Publishing company, its location") ("organization" "Sponsoring organization of the conference") ("address" "Location of the Proceedings") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem")))) ("TechReport" ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the technical report (will be converted to lowercase)") ("institution" "Sponsoring institution of the report") ("year" "Year of publication")) (("type" "Type of the report (if other than \"technical report\")") ("number" "Number of the technical report") ("address" "Address of the institution (if not part of field \"institution\") or country") ("month" "Month of the publication as a string (remove braces)") ("note" "Remarks to be put at the end of the \\bibitem")))) ("Unpublished" ((("author" "Author1 [and Author2 ...] [and others]") ("title" "Title of the unpublished reference (will be converted to lowercase)") ("note" "Remarks to be put at the end of the \\bibitem")) (("year" "Year of publication") ("month" "Month of the publication as a string (remove braces)")))))) (#$ . 2187)) #@150 Alist of string definitions. Should contain the strings defined in the BibTeX style files. Each element is a list with just one element: the string. (defvar bibtex-predefined-strings (quote (("jan") ("feb") ("mar") ("apr") ("may") ("jun") ("jul") ("aug") ("sep") ("oct") ("nov") ("dec") ("acmcs") ("acta") ("cacm") ("ibmjrd") ("ibmsj") ("ieeese") ("ieeetc") ("ieeetcad") ("ipl") ("jacm") ("jcss") ("scp") ("sicomp") ("tcs") ("tocs") ("tods") ("tog") ("toms") ("toois") ("toplas"))) (#$ . 12566)) #@251 *List of BibTeX files containing string definitions. Those files must be specified using pathnames relative to the directories specified in $BIBINPUTS. This variable is only evaluated when bibtex-mode is entered (i. e. when loading the BibTeX file). (defvar bibtex-string-files nil (#$ . -13069)) #@75 *If not nil print help messages in the echo area on entering a new field. (defvar bibtex-help-message t (#$ . -13372)) #@211 *Number of names to use for the automatically generated reference key. If this is set to anything but a number, all names are used. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-names 1 (#$ . -13498)) #@329 Alist of (old-regexp new-string) pairs. Any part of name matching a old-regexp is replaced by new-string. Case of the old-regexp is significant. All regexps are tried in the order in which they appear in the list, so be sure to avoid recursion here. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-name-change-strings (quote (("\\\\\\\"a" "ae") ("\\\\\\\"o" "oe") ("\\\\\\\"u" "ue") ("\\\\\\\"s" "ss") ("\\\\\\\"A" "Ae") ("\\\\\\\"O" "Oe") ("\\\\\\\"U" "Ue") ("{" "") ("}" ""))) (#$ . 13761)) #@202 *Number of characters from name to incorporate into key. If this is set to anything but a number, all characters are used. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-name-length (quote infty) (#$ . -14314)) #@132 *String that comes between any two names in the key. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-name-separator "" (#$ . -14586)) #@152 *Number of rightmost digits from the year field yo incorporate into key. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-year-length 2 (#$ . -14780)) #@223 *Number of title words to use for the automatically generated reference key. If this is set to anything but a number, all title words are used. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-titlewords 5 (#$ . -14990)) #@180 *Regexp list defining the termination of the main part of the title. Case of the regexps is ignored. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-title-terminators (quote ("\\." "!" "\\?" ":" ";" "---")) (#$ . -15270)) #@217 *Number of words that can additionally be used from the title. These words are used only, if a sentence from the title can be ended then. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-titlewords-stretch 2 (#$ . -15552)) #@296 *Determines words that may begin a title but are not to be used in the key. Each item of the list is a regexp. If the first word of the title matchs a regexp from that list, it is not included in the title, even if it is capitalized. Regexps in the list must be entered using lowercase letters. (defvar bibtex-autokey-titleword-first-ignore (quote ("a" "an" "on" "the" "eine?" "der" "die" "das")) (#$ . -15834)) #@223 *Determines exceptions to the usual abbreviation mechanism. A list of (old-regexp new-string) pairs. Use all lowercase letters for old-regexp. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-titleword-abbrevs nil (#$ . -16253)) #@230 Alist of (old-regexp new-string) pairs. Any part of title word matching a old-regexp is replaced by new-string. Case of the old-regexp is significant. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-titleword-change-strings (quote (("\\\\\\\"a" "ae") ("\\\\\\\"o" "oe") ("\\\\\\\"u" "ue") ("\\\\\\\"s" "ss") ("\\\\\\\"A" "Ae") ("\\\\\\\"O" "Oe") ("\\\\\\\"U" "Ue") ("{" "") ("}" ""))) (#$ . 16542)) #@209 *Number of characters from title words to incorporate into key. If this is set to anything but a number, all characters are used. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-titleword-length 5 (#$ . -17001)) #@122 *String to be put between the title words. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-titleword-separator "_" (#$ . -17273)) #@137 *String to be put between name part and year part of key. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-name-year-separator "" (#$ . -17463)) #@137 *String to be put between name part and year part of key. See the documentation of function bibtex-generate-autokey for further detail. (defvar bibtex-autokey-year-title-separator ":_" (#$ . -17667)) #@75 *If non-nil, user is allowed to edit the generated key before it is used. (defvar bibtex-autokey-edit-before-use t (#$ . -17873)) (byte-code "ÀÁ!„B ÄÅÆ #ˆÄÇÈ #ˆÄÉÊ #ˆÄËÌ #ˆÄÍÌ #ˆÄÎÏ #ˆÄÐÑ #ˆÄÒÑ #ˆÄÓÔ #ˆ )ÁBÀÖ!„´× ÙÚÛ#ˆÙÜÝ#ˆÙÞß#ˆÙàá#ˆÙâá#ˆÙãá#ˆÙäå#ˆÙæç#ˆÙèé#ˆÙêë#ˆÙìí#ˆÙîï#ˆÙðñ#ˆÙòó#ˆÙôõ#ˆÙö÷#ˆÙøù#ˆÙúû#ˆÙüý#ˆÙþÿ#ˆÙ@A#ˆÙBC#ˆÙDE#ˆÙFG#ˆÙHI#ˆÙJG#ˆÙKL#ˆÙMN#ˆÙOE#ˆÙPQ#ˆÙRS#ˆÙTU#ˆÙVC#ˆÙWX#ˆÙYZ#ˆÙ[\\#ˆÙ]^#ˆÙ_`#ˆÙab#ˆ)ÖBÙcd×d!B#ˆÙef#ˆÙgh#ˆÙij#ˆÙkl#ˆÙmn#ˆÙop#ˆÙqr#ˆÙst#ˆÙuv#ˆÙwx#ˆÙyz#ˆÙ{|×|!B#ˆÙ}~#ˆÙ€#ˆÙ‚#ˆÙƒ„#ˆÙ…†#ˆÙ‡ˆ#ˆÙ‰Š#ˆÙ‹Œ#ˆÙŽ#ˆÙ#ˆÙ‘’#ˆÙ“”#ˆÙ•–#ˆÙ—˜#ˆÙ™š#ˆÀ›!„œ››BÀ!„œBÀž!„1œžžBŸž!‡" [boundp bibtex-mode-syntax-table make-syntax-table st modify-syntax-entry 34 "\"" 36 "$$ " 37 "< " 39 "w " 64 92 "\\" 12 "> " 10 126 " " current-load-list bibtex-mode-map make-sparse-keymap km define-key " " bibtex-find-text "\n" bibtex-next-field "‰" bibtex-complete-string "\"" bibtex-remove-double-quotes-or-braces "{" "}" "" bibtex-clean-entry "?" bibtex-print-help-message "" bibtex-pop-previous "" bibtex-pop-next " " bibtex-kill-optional-field "" bibtex-empty-field "$" bibtex-ispell-entry "" bibtex-beginning-of-entry "…" bibtex-end-of-entry "" bibtex-entry "" bibtex-hide-entry-bodies "" show-all "n" bibtex-narrow-to-entry "w" widen "" bibtex-remove-OPT " " bibtex-InProceedings "i" bibtex-InCollection "I" bibtex-InBook "" bibtex-Article "" "b" bibtex-Book "B" bibtex-Booklet "" " " bibtex-Manual "m" bibtex-MastersThesis "M" bibtex-Misc "" "p" bibtex-Proceedings "P" bibtex-PhdThesis "ð" bibtex-preamble "" bibtex-string "" bibtex-TechReport "" bibtex-Unpublished [menu-bar move/edit] "BibTeX-Edit" [menu-bar move/edit bibtex-print-help-message] ("Help about Current Field" . bibtex-print-help-message) [menu-bar move/edit bibtex-complete-string] ("String Complete" . bibtex-complete-string) [menu-bar move/edit bibtex-next-field] ("Next Field" . bibtex-next-field) [menu-bar move/edit bibtex-find-text] ("End of Field" . bibtex-find-text) [menu-bar move/edit bibtex-pop-previous] ("Snatch from Similar Preceding Field" . bibtex-pop-previous) [menu-bar move/edit bibtex-pop-next] ("Snatch from Similar Following Field" . bibtex-pop-next) [menu-bar move/edit bibtex-remove-OPT] ("Remove OPT" . bibtex-remove-OPT) [menu-bar move/edit bibtex-remove-double-quotes-or-braces] ("Remove Quotes or Braces" . bibtex-remove-double-quotes-or-braces) [menu-bar move/edit bibtex-clean-entry] ("Clean Up Entry" . bibtex-clean-entry) [menu-bar move/edit bibtex-sort-entries] ("Sort Entries" . bibtex-sort-entries) [menu-bar move/edit bibtex-validate-buffer] ("Validate Entries" . bibtex-validate-buffer) [menu-bar entry-types] "Entry-Types" [menu-bar entry-types bibtex-preamble] ("Preamble" . bibtex-preamble) [menu-bar entry-types bibtex-string] ("String" . bibtex-string) [menu-bar entry-types bibtex-Misc] ("Miscellaneous" . bibtex-Misc) [menu-bar entry-types bibtex-Unpublished] ("Unpublished" . bibtex-Unpublished) [menu-bar entry-types bibtex-Manual] ("Technical Manual" . bibtex-Manual) [menu-bar entry-types bibtex-TechReport] ("Technical Report" . bibtex-TechReport) [menu-bar entry-types bibtex-MastersThesis] ("Master's Thesis" . bibtex-MastersThesis) [menu-bar entry-types bibtex-PhdThesis] ("PhD. Thesis" . bibtex-PhdThesis) [menu-bar entry-types bibtex-Booklet] ("Booklet (Bound, but no Publisher/Institution)" . bibtex-Booklet) [menu-bar entry-types bibtex-Book] ("Book" . bibtex-Book) [menu-bar entry-types bibtex-Proceedings] ("Conference Proceedings" . bibtex-Proceedings) [menu-bar entry-types bibtex-InBook] ("Chapter or Pages in a Book" . bibtex-InBook) [menu-bar entry-types bibtex-InCollection] ("Article in a Collection" . bibtex-InCollection) [menu-bar entry-types bibtex-InProceedings] ("Article in Conference Proceedings" . bibtex-InProceedings) [menu-bar entry-types bibtex-Article] ("Article in Journal" . bibtex-Article) bibtex-pop-previous-search-point nil bibtex-pop-next-search-point bibtex-completion-candidates make-variable-buffer-local] 6) (defalias 'bibtex-cfield #[(name text) "À  İ‡" [",[ \n]*\\(" name "\\)[ \n]*=[ \n]*\\(" text "\\)"] 5]) (byte-code "ÀÁ\nBÃÄ\nBÅÆ\nBÀ‡" [1 bibtex-name-in-cfield current-load-list 2 bibtex-text-in-cfield "[A-Za-z][]A-Za-z0-9.:;?!`'()/*@_+=-]*" bibtex-field-name] 2) #@36 Format of a bibtex field constant. (defconst bibtex-field-const "[0-9A-Za-z][A-Za-z0-9:_+-]*" (#$ . 22586)) (byte-code "ÀÁÂÃRÄ BÇ\fQÈ BÀÉÊËÌ° Í BÎ \"Ð BÒ BÔ BÕÖ B×ØÉ°Ù BÚÛ BÜÝ BÞßà°!á B\"â B#ã Bäå æ°'ç Bè)é BÚ*ê BÚ+ë BìG-í Bć" ["\\(" "{\\(\\({\\(\\({[^}]*}\\)\\|\\([^{}]\\)\\)*}\\)\\|\\([^{}]\\)\\)*}" "\\)\\|\\(" "\"[^\"]*[^\\\\]\"\\|\"\"\\)" bibtex-field-string current-load-list bibtex-field-const "\\|" bibtex-field-string-or-const "\\)" "\\([ \n]+#[ \n]+\\(" "\\)\\)*\\|" "{[^{}]*[^\\\\]}" bibtex-field-text bibtex-cfield bibtex-field-name bibtex-field bibtex-name-in-cfield bibtex-name-in-field bibtex-text-in-cfield bibtex-text-in-field "@[A-Za-z]+" bibtex-reference-type "^\\( \\| \\)*\\(" "\\)[ ]*[({]\\(" bibtex-reference-head 2 bibtex-type-in-head 3 bibtex-key-in-head "\\([ \n]*" "\\)*" "[ \n]*[})]" bibtex-reference bibtex-type-in-reference bibtex-key-in-reference "^[ ]*@[sS][tT][rR][iI][nN][gG][ \n]*[({][ \n]*\\(" "\\)[ \n]*=[ \n]*\\(" "\\)[ \n]*[})]" bibtex-string 1 bibtex-name-in-string bibtex-text-in-string bibtex-name-alignment " organization = " bibtex-text-alignment] 7) (defalias 'assoc-ignore-case #[(string alist) "À \n\"†\nƒ —\n@@—˜„\nA‰„ \n@‡" [assoc string alist] 4]) (defalias 'member-of-regexp #[(string list) "ƒÁÂ@ÃQ\f\"„A‰„‡" [list string-match "^" "$" string] 5]) (defalias 'assoc-of-regexp #[(string alist) "ƒÁÂ@@ÃQ\f\"„A‰„@‡" [alist string-match "^" "$" string] 5]) (defalias 'skip-whitespace-and-comments #[nil "À ÂŽÃÄ!ƒÅ•b‚ÃÆ!… ÇÈ!… ‚*‡" [match-data md ((store-match-data md)) looking-at "\\s>+\\|\\s +" 0 "\\s<" re-search-forward "\\s>"] 2]) (defalias 'map-bibtex-entries #[(fun) "À ˆÁÂÃÄ#…( ƒÆǔȔ\"—ɘ„\nÆȔȕ\"!ˆ‚‡" [bibtex-beginning-of-entry re-search-forward "^@[^{]*{[ ]*\\([^, ]*\\)" nil t bibtex-sort-ignore-string-entries buffer-substring-no-properties 0 1 "@string{" fun] 4]) (defalias 'bibtex-flash-head #[nil "À eÄ#ƒ ”bˆ•‚%ÀˆÇÀxˆ`ÈyˆÇÀwˆÉ`!ƒ1ÊË!‚7ÌÍ` {\")‡" [nil flash re-search-backward bibtex-reference-head t bibtex-type-in-head bibtex-key-in-reference " " 0 pos-visible-in-window-p sit-for 1 message "From: %s"] 4]) (defalias 'bibtex-move-outside-of-entry #[nil "`dU„`eU„ÀÁ!„ ˆÃ ˆÄÅdÆ#‡" [looking-at "[ \n]*@" backward-paragraph forward-paragraph re-search-forward "[ \n]*" t] 4]) (defalias 'beginning-of-first-bibtex-entry #[nil "ebˆÀÁÂÃ#ƒÄyˆÂ‡oƒmƒ‡ÅÆ!‡" [re-search-forward "^@" nil move 0 message "Warning: No BibTeX entries found!"] 4]) (defalias 'bibtex-inside-field #[nil "ÀˆÁÀxˆhÂUƒÃuˆh\fÅHU…Æu‡" [nil " " 44 -2 bibtex-field-right-delimiter 0 -1] 3]) (defalias 'bibtex-enclosing-field #[nil "`ÁÂÃ)‡" [old-point errname (bibtex-enclosing-regexp bibtex-field) ((search-failed (byte-code "bˆÁÂ!‡" [old-point error "Can't find enclosing BibTeX field."] 2)))] 3]) (defalias 'bibtex-enclosing-reference #[nil "`ÁÂeÃ#„ÄÅ!ˆbˆ`ÇÈdÃ#„%ÄÅ!ˆb‚(b*‡" [old-point re-search-backward "^@[A-Za-z]+[ \n]*[{(][^, \n]*[ \n]*," t error "Can't find enclosing BibTeX reference." pnt re-search-forward "^[)}]$"] 4]) (defalias 'bibtex-enclosing-regexp #[(regexp) "`Á\ndÃ#ƒÄ•‚dbˆÆ\neÃ#ƒ!Ä”‚\"e‰bˆÁ\n ÈÉ$ˆÄ”Vƒ;ÊË\nC\"ˆÄ•X…YÁ\n ÈÉ$ˆÄ”Vƒ;ÊË\nC\"ˆ‚;+‡" [initial re-search-forward regexp t 0 right re-search-backward left nil 1 signal search-failed] 6]) (defalias 'bibtex-autokey-change #[(string change-list) "Á GÁ WƒA œÉ\f@\"ƒ8‰”O\fÊœ•ÁOQ‚T‰‚-‡" [string nil 0 change-list change-item len index case-fold-search return-string string-match 1] 6]) (defalias 'bibtex-autokey-abbrev #[(string len) "G\n§ƒ\n ^‚\n‰§…Ã\nO\nÆ\n§ƒH WƒD\f‰GSœƒD\f ‰TOP T‰‚%\f‚I-‡" [string string-length len 0 return-string index (97 101 105 111 117 65 69 73 79 85) vowels] 5]) #@2654 Generates automatically a key from the author/editor and the title field. The generation algorithm works as follows: 1. If there is a non-empty author (preferred) or editor field, use it for the name part of the key. 2. Change any substring found in `bibtex-autokey-name-change-strings' to the corresponding new one (see documentation of this variable for further detail). 3. For every of the first `bibtex-autokey-names' names in the "name" field, determine the last name. 4. From every last name, take at least `bibtex-autokey-name-length' characters (abort only after a consonant or at a word end). 5. Build the name part of the key by concatenating all abbreviated last names with the string `bibtex-autokey-name-separator' between any two. 6. Build the year part of the key by truncating the contents of the "year" field to the rightmost `bibtex-autokey-year-length' digits (useful values are 2 and 4). 7. For the title part of the key change the contents of the "title" field of the reference according to `bibtex-autokey-titleword-change-strings' to the corresponding new one (see documentation of this variable for further detail). 8. Abbreviate the result to the string up to (but not including) the first occurence of a regexp matched by the items of `bibtex-autokey-title-terminators' and delete the first word if it appears in `bibtex-autokey-titleword-first-ignore'. Build the title part of the key by using at least the first `bibtex-autokey-titlewords' capitalized words from this abbreviated title. If the abbreviated title ends after maximal `bibtex-autokey-titlewords' + `bibtex-autokey-titlewords-stretch' capitalized words, all capitalized words from the abbreviated title are used. 9. For every used title word that appears in `bibtex-autokey-titleword-abbrevs' use the corresponding abbreviation (see documentation of this variable for further detail). 10. From every title word not generated by an abbreviation, take at least `bibtex-autokey-titleword-length' characters (abort only after a consonant or at a word end). 11. Build the title part of the key by concatenating all abbreviated title words with the string `bibtex-autokey-titleword-separator' between any two. 12. At least, to get the key, concatenate the name part, the year part and the title part with `bibtex-autokey-name-year-separator' between the name and the year if both are non-empty and `bibtex-autokey-year-title-separator' between the year and the title if both are non-empty. (defalias 'bibtex-generate-autokey #[nil "`Á ˆ`à ˆ`\nbˆÅÆ\fÇ#„ÅÈ\fÇ#ƒ>É\nËÇ!ˆ`\fËÉ!ˆ` ÎÏ\f \"\"+‚?ÑÓÔÉÕÑš„”§ƒ^Wƒ”ÙÚ\"ƒÛÕ‰”O—C\"Õ•ÉO‚ŒÛ—C\"ÑT‚I*\"ÝÞ# \nbˆÅá\fÇ#ƒ·Ïâ”â•\"‚¸Ñ‰#ÑšƒÄÑ‚Í#‰G$ZÉO%Ç\nbˆÅæ\fÇ#ƒúÉ\nËÇ!ˆ`\fËÉ!ˆ` ÎÏ\f \"'\"+‚ûÑÉÕ(G)*+,+*)Wƒ/Ù(*œ,\"ƒ&,Õ‰”O,*T‰*‚\f,--Óîɉ‰ÕÇ/+01-Ñš„Ä2§ƒ]23\\WƒÄÙô-\"ƒ¶Õ•5-Õ”5O—62§ƒ2Wƒ¡/ƒ•÷68\"ƒ•ù‚ªÛ16C\"1‚ªÛ06C\"0-5ÉO-*‚¹Ñ-É/T‚EÙú-\"ƒÑ1‚×Û10\"-\";Ýü;=#> ‰Ñš†ð%Ñš?…ö?% Ñšƒ%Ñš†\n>Ñš?…@>°AbˆA.\f‡" [pnt bibtex-beginning-of-entry min bibtex-end-of-entry max search-forward-regexp "^[ ]*author[ ]*=" t "^[ ]*editor[ ]*=" nil bibtex-help-message bibtex-find-text start end bibtex-autokey-change buffer-substring-no-properties bibtex-autokey-name-change-strings "" namefield mapcar #[(fullname) "ÀÁ \"ƒ ĉ”O‚!ÁÅ \"ƒ Ä”TÆO‚! \"‡" [bibtex-autokey-abbrev string-match "," fullname 0 " [^ ]*$" nil bibtex-autokey-name-length] 4] 0 counter names bibtex-autokey-names string-match " and " append namelist mapconcat #[(name) "‡" [name] 1] bibtex-autokey-name-separator namepart "^[ ]*year[ ]*=[ ]*\\([0-9]*\\)" 1 yearfield bibtex-autokey-year-length yearpart "^[ ]*title[ ]*=" bibtex-autokey-titleword-change-strings bibtex-autokey-title-terminators numberofitems index case-fold-search titlefield titlestring #[(titleword) "À \n\"‰ƒ Äœ‚Å \")‡" [assoc-of-regexp titleword bibtex-autokey-titleword-abbrevs abbrev 1 bibtex-autokey-abbrev bibtex-autokey-titleword-length] 4] first titlewords-extra titlewords bibtex-autokey-titlewords bibtex-autokey-titlewords-stretch "\\b[A-Z][A-Za-z0-9]*" end-match titleword member-of-regexp bibtex-autokey-titleword-first-ignore -1 "\\b[A-Z][^ ]*\\b" titlelist #[(name) "‡" [name] 1] bibtex-autokey-titleword-separator titlepart bibtex-autokey-name-year-separator bibtex-autokey-year-title-separator autokey] 8 (#$ . 26445)]) #@1886 Major mode for editing BibTeX files. \{bibtex-mode-map} A command such as \[bibtex-Book] will outline the fields for a BibTeX book entry. The optional fields start with the string OPT, and thus ignored by BibTeX. The OPT string may be removed from a field with \[bibtex-remove-OPT]. \[bibtex-kill-optional-field] kills the current optional field entirely. \[bibtex-remove-double-quotes-or-braces] removes the double-quotes or braces around the text of the current field. \[bibtex-empty-field] replaces the text of the current field with the default "" or {}. The command \[bibtex-clean-entry] cleans the current entry, i.e. (i) removes double-quotes or braces from entirely numerical fields, (ii) removes OPT from all non-empty optional fields, (iii) removes all empty optional fields, and (iv) checks that no non-optional fields are empty. Use \[bibtex-find-text] to position the cursor at the end of the current field. Use \[bibtex-next-field] to move to end of the next field. The following may be of interest as well: Functions: bibtex-entry bibtex-print-help-message bibtex-beginning-of-entry bibtex-end-of-entry bibtex-ispell-abstract bibtex-narrow-to-entry bibtex-hide-entry-bodies bibtex-sort-entries bibtex-validate-buffer bibtex-pop-previous bibtex-pop-next bibtex-complete-string Variables: bibtex-field-left-delimiter bibtex-field-right-delimiter bibtex-include-OPTcrossref bibtex-include-OPTkey bibtex-include-OPTannote bibtex-mode-user-optional-fields bibtex-clean-entry-zap-empty-opts bibtex-sort-ignore-string-entries bibtex-maintain-sorted-entries bibtex-entry-field-alist bibtex-predefined-strings bibtex-string-files --------------------------------------------------------- Entry to this mode calls the value of bibtex-mode-hook if that value is non-nil. (defalias 'bibtex-mode #[nil "À ˆÁ\n!ˆÃÅÇ!ˆ \nËÌ \"ˆÎÏ!ˆÐÎÑ!ˆÒÓÔ!ˆÔ\\×Ø!‡" [kill-all-local-variables use-local-map bibtex-mode-map bibtex-mode major-mode "BibTeX" mode-name set-syntax-table bibtex-mode-syntax-table bibtex-predefined-strings bibtex-completion-candidates mapcar #[(filename) "ÀÁ!‰ƒ\f\n‚ ÃÅÆÇÉÊ\f\"ƒ0Ë\f̉•SOC\"\fÌ•ÇO‚Ë\fC\")\" ÉÎ\"ƒG‚KÐPÇÌ GWƒzÔ œÕQ‰!„zT‰‚ZWƒÍpÖ×!Ü!ˆqˆÝ!ˆebˆÞÇà#ƒ»Ëá\"”\"•\"CC\"‚Ÿã!ˆqˆ‰+‚Òäå\".‡" [getenv "BIBINPUTS" bib "." path mapcar #[(dirname) "G SœÂšƒà SSO‚)‡" [dirname len "/" 0] 3] nil actdirs string-match ":" append 0 dirs ".bib$" filename ".bib" fullfilename item size file-readable-p "/" make-temp-name "" bibtex-completion-candidates compl bufname curbuf create-file-buffer insert-file-contents search-forward-regexp bibtex-string t buffer-substring-no-properties bibtex-name-in-string kill-buffer error "File %s not in $BIBINPUTS paths"] 8] bibtex-string-files make-local-variable paragraph-start "[ \f\n ]*$" comment-start "%" auto-fill-mode 1 bibtex-text-alignment left-margin run-hooks bibtex-mode-hook] 3 (#$ . 31105) nil]) (defalias 'bibtex-entry #[(entry-type &optional required optional) "„D „D \f\"‰Æœ Èœ „ ÊË \"ˆ \fƒ9 ƒ9 Íœ Æœ‚C͜Ɯ+ÎÎÑ…“ŠebˆÔÕÎÑ#ƒŠÈ”ƒnÖȔȕ\"‚vÖהו\"Ø\"„VCB‚V)ÙÚÛ \"\"‰ƒžÝ!ˆÞ ˆß ైƒ°cˆŠáâ\"ˆ \fƒÁãä!ˆ%ƒÊãæ!ˆáã \"ˆáã'\"ˆ(ƒÞãé!ˆêcˆ)ƒëëÑ!ˆìí!,‡" [required optional assoc-ignore-case entry-type bibtex-entry-field-alist e 1 r-n-o 2 c-ref error "Bibtex entry type %s not defined!" bibtex-include-OPTcrossref 0 nil labels label t case-fold-search bibtex-maintain-sorted-entries re-search-forward "\\(^@[a-z]+[ \n]*[{(][ \n]*\\([^ , \n]+\\)[ \n]*,\\)\\|\\(^[ \n]*crossref[ \n]*=[ \n]*[{\"]\\([^ , \n]*\\)[}\"],$\\)" buffer-substring-no-properties 4 assoc completing-read format "%s key: " key bibtex-find-entry-location bibtex-move-outside-of-entry "@" "{" mapcar bibtex-make-field bibtex-make-optional-field ("crossref") bibtex-include-OPTkey ("key") bibtex-mode-user-optional-fields bibtex-include-OPTannote ("annote") "\n}\n\n" bibtex-next-field run-hooks bibtex-add-entry-hook] 5 nil (byte-code "ÀÂÃ\fÅÀ$)C‡" [t completion-ignore-case completing-read "Entry Type: " bibtex-entry-field-alist nil] 6)]) #@73 Prints helpful information about current field in current BibTeX entry. (defalias 'bibtex-print-help-message #[nil "`ÁyˆÂÃĈÅÆÇÈ#ˆÉ”É•\n ÌÍÎ!ƒ& Ï\\‚( \n\"*ÅÑÇÈ#ˆÌɔɕ\"Ó\"‰Öœƒ[ƒ[‚_ÉœÚÁœÉœ…uÜ…{Þ…à&!bˆâ!\"ƒžãâ!\"Éœ!‚¡ãä!.‡" [pnt 0 errname (bibtex-enclosing-regexp bibtex-field) ((search-failed (byte-code "bˆÁÂ!‡" [pnt error "Not on BibTeX field"] 2))) re-search-backward "^[ ]*\\([A-Za-z]+\\)[ \n]*=" nil t 1 me mb buffer-substring-no-properties looking-at "^[ ]*OPT" 3 field-name "^@\\([A-Za-z]+\\)[ \n]*[{(][^, \n]*[ \n]*," reference-type assoc-ignore-case bibtex-entry-field-alist entry-list 2 c-r-list bibtex-include-OPTcrossref req-opt-list append bibtex-mode-user-optional-fields (("crossref" "Label of the crossreferenced entry")) bibtex-include-OPTannote (("annote" "Personal annotation (ignored)")) bibtex-include-OPTkey (("key" "Key used for label creation if author and editor fields are missing")) list-of-entries assoc message "NO COMMENT AVAILABLE"] 8 (#$ . 35373) nil]) #@50 Makes a field named E-T in current BibTeX entry. (defalias 'bibtex-make-field #[(e-t) ":ƒ Áœ‚\fÃÄ!ˆÅuˆÆcˆjˆ\nȱˆ jˆ\n ±)‡" [e-t 0 name bibtex-find-text nil 1 ",\n" bibtex-name-alignment " = " bibtex-text-alignment bibtex-field-left-delimiter bibtex-field-right-delimiter] 2 (#$ . 36438) "sBibTeX entry type: "]) #@60 Makes an optional field named E-T in current BibTeX entry. (defalias 'bibtex-make-optional-field #[(e-t) ":ƒÁ@PAB‚ÁPÂ!‡" [e-t "OPT" bibtex-make-field] 2 (#$ . 36769) "sOptional BibTeX entry type: "]) #@140 Move to beginning of BibTeX entry. If inside an entry, move to the beginning of it, otherwise move to the beginning of the previous entry. (defalias 'bibtex-beginning-of-entry #[nil "ÀÁ!ƒ ÂuˆÃÁÂÄ#‡" [looking-at "^@" nil re-search-backward move] 4 (#$ . 36987) nil]) #@122 Move to end of BibTeX entry. If inside an entry, move to the end of it, otherwise move to the end of the previous entry. (defalias 'bibtex-end-of-entry #[nil "À ˆÁÃÄ!)‡" [bibtex-beginning-of-entry t parse-sexp-ignore-comments forward-sexp 2] 2 (#$ . 37261) nil]) #@27 Spell whole BibTeX entry. (defalias 'bibtex-ispell-entry #[nil "ÀÁ ˆ` ˆ`\"‡" [ispell-region bibtex-beginning-of-entry bibtex-end-of-entry] 3 (#$ . 37531) nil]) #@33 Spell abstract of BibTeX entry. (defalias 'bibtex-ispell-abstract #[nil "À  ˆÃÄ \"„ÅÆ!ˆ)Ç`ŠÈ ˆ`)\"‡" [bibtex-end-of-entry pnt bibtex-beginning-of-entry re-search-forward "^[ ]*[OPT]*abstract[ ]*=" error "No abstract in entry." ispell-region forward-sexp] 3 (#$ . 37698) nil]) #@40 Narrow buffer to current BibTeX entry. (defalias 'bibtex-narrow-to-entry #[nil "ŠÀ ˆ`Á ˆ`})‡" [bibtex-beginning-of-entry bibtex-end-of-entry] 2 (#$ . 37986) nil]) #@106 Hide all lines between first and last BibTeX entries not beginning with @. With argument, show all text. (defalias 'bibtex-hide-entry-bodies #[(&optional arg) "ŠÀ ˆÁ  ƒÆ`dÇÈÉ%ˆ‚8ŠÊËdÉ#)ƒ8ŠÊÌÂÉ#ƒ4ÍΉ#ˆ‚#)‚ ?Ð\f!+‡" [beginning-of-first-bibtex-entry buffer-modified-p nil buffer-read-only modifiedp arg subst-char-in-region 13 10 t re-search-forward "\n[^@]" "\n\\([^@]\\)" replace-match " \\1" selective-display set-buffer-modified-p] 6 (#$ . 38156) "P"]) #@400 Sort BibTeX entries alphabetically by key. Text before the first BibTeX entry, and following the last is not affected. If bibtex-sort-ignore-string-entries is true, @string entries will be ignored. Bugs: 1. Text between the closing brace ending one BibTeX entry, and the @ starting the next, is considered part of the PRECEDING entry. Perhaps it should be part of the following entry. (defalias 'bibtex-sort-entries #[nil "ŒÀ ˆ`ŠdbˆÁ ˆ`)}ˆÂÃÄŃǂÈÉ%)‡" [beginning-of-first-bibtex-entry bibtex-end-of-entry sort-subr nil forward-line #[nil "ÀÁÂÃ#…\nÄu‡" [re-search-forward "}\\s-*\n[\n ]*@" nil move -2] 4] bibtex-sort-ignore-string-entries #[nil "ÀÁ!ƒÂÔÕ\"—Ę„Ň" [re-search-forward "^\\s-*\\([@a-zA-Z]*\\)\\s-*{\\s-*" buffer-substring-no-properties 1 "@string" nil] 3] #[nil "ÀÁ!‡" [re-search-forward "{\\s-*"] 2] #[nil "ÀÁ!‡" [search-forward ","] 2]] 6 (#$ . 38631) nil]) #@585 Looking for place to put the BibTeX entry named ENTRY-NAME. Searches from beginning of buffer. Buffer is assumed to be in sorted order, without duplicates (see \[bibtex-sort-entries]), if it is not, an error will be signalled. However, if optional argument IGNORE-ERRORS is non-nil, no error messages about duplicate entries or sort order violences are signalled, but the error handling is assumed to be made in the calling function. Nil is returned, if any error occured during search for location of the new entry, and t in all other cases. If an error occured, point is not moved. (defalias 'bibtex-find-entry-location #[(entry-name &optional ignore-errors) "ÀÁ`ÁÆ ˆÇÈ„dbˆ „ bˆ ,‡" [t nil point pnt previous noerr beginning-of-first-bibtex-entry done (map-bibtex-entries #[(current) " ˜ƒÂÄ ˆ ƒÆÇÈ\"‡ÉÊ!‡ ƒ$ ™ƒ]  `\f ™…Ä ˆÍÎ! \"‰¨ƒWÐUƒWÑš„WÒÓ #ˆÔÈ!ˆ)ÆÇÈ\"‡ ˜ƒs ƒoÆÇÈ\"‡ÉÕ!‡Â ƒ~ÆÇÈ\"‡ÉÖ!‡" [entry-name current nil noerr bibtex-beginning-of-entry ignore-errors throw done t error "Entry duplicates existing!" previous point string-match regexp-quote idx 0 "" message "Warning: Entry %s may be a duplicate of %s!" ding "Duplicate here with previous!" "Entries out of order here!"] 5])] 4 (#$ . 39540) "sBibtex entry key: "]) #@160 Validate if the current BibTeX buffer is syntactically correct. Any garbage (e.g. comments) before the first "@" is not tested (so you can put comments here). (defalias 'bibtex-validate-buffer #[nil "`debˆÂÃ!Wƒ;Äuˆ`ÆÇ!ƒ Èuˆ‚7 ÈÊ#ƒ0 Ë”š„7 bˆÌÍ!ˆ)‚ÎÏÐÑ\"!ˆ bˆÒÓ!*‡" [max pnt re-search-forward "@\\|\\'" -1 p looking-at "@string" nil bibtex-reference t 0 error "Bad entry begins here" bibtex-find-entry-location make-string 10 255 message "BibTeX buffer is syntactically correct"] 4 (#$ . 40814) nil]) #@69 Finds end of text of next BibTeX field; with arg, to its beginning. (defalias 'bibtex-next-field #[(arg) "À ˆ`ÂÃĈ)Å!‡" [bibtex-inside-field start nil (byte-code "À ˆÁ•bˆÂu‡" [bibtex-enclosing-field 0 2] 1) ((error (byte-code "bˆÁˆÂu‡" [start nil 1] 1))) bibtex-find-text arg] 3 (#$ . 41332) "P"]) #@64 Go to end of text of current field; with arg, go to beginning. (defalias 'bibtex-find-text #[(arg) "À ˆÁ ˆ\nƒ ”bˆÄÅ!ƒ-Æuˆ‚- •bˆhÇU„*hÈUƒ-Éuˆ\n…4Ë ‡" [bibtex-inside-field bibtex-enclosing-field arg bibtex-text-in-field looking-at "[{\"]" 1 125 34 -1 bibtex-help-message bibtex-print-help-message] 2 (#$ . 41642) "P"]) #@72 Removes the 'OPT' starting optional arguments and goes to end of text. (defalias 'bibtex-remove-OPT #[nil "À ˆÁ ˆŠ\n”bˆÃÄ!ƒ!ÅÄG!ˆÆÇ!ˆÈ ˆ jˆ)À ‡" [bibtex-inside-field bibtex-enclosing-field bibtex-name-in-field looking-at "OPT" delete-char search-forward "=" delete-horizontal-space bibtex-text-alignment] 2 (#$ . 41973) nil]) #@33 Removes "" or {} around string. (defalias 'bibtex-remove-double-quotes-or-braces #[nil "ŠÀ ˆÁ ˆ\n”\n• bˆÅuˆÆÇ!ƒÈÉ!ˆ\fbˆÆÊ!…)ÈÉ!+‡" [bibtex-inside-field bibtex-enclosing-field bibtex-text-in-field stop start -1 looking-at "[}\"]" delete-char 1 "[{\"]"] 2 (#$ . 42307) nil]) #@50 Kill the entire enclosing optional BibTeX field. (defalias 'bibtex-kill-optional-field #[nil "À ˆÁ ˆ\n”bˆÃ•Ã”ÆÇ!ƒ$ bˆÈÉwˆÊ\f \"‚'ËÌ!*‡" [bibtex-inside-field bibtex-enclosing-field bibtex-name-in-field 0 the-beginning the-end looking-at "OPT" " \n," nil kill-region error "Mandatory fields can't be killed"] 3 (#$ . 42591) nil]) #@69 Delete the text part of the current field, replace with empty text. (defalias 'bibtex-empty-field #[nil "À ˆÁ ˆ\n”bˆÃ`\n•\"ˆ\f PcˆÆÇ!‡" [bibtex-inside-field bibtex-enclosing-field bibtex-text-in-field kill-region bibtex-field-left-delimiter bibtex-field-right-delimiter bibtex-find-text t] 3 (#$ . 42930) nil]) #@206 Replace text of current field with the text of similar field in previous entry. With arg, go up ARG entries. Repeated, goes up so many times. May be intermixed with \[bibtex-pop-next] (bibtex-pop-next). (defalias 'bibtex-pop-previous #[(arg) "À ˆŠÁ ˆ\n”\n• ” •Ä bˆÊËÌÍ!ƒ,`ÍG\\‚-`\"\"Ñ=„MÒ=„MÓ ˆ`Õ•bˆ×eØ$ƒïË”•\"Üšƒ ÕHÝ=ƒ ‰GSHÝ=ƒ ÕÞIˆ ‰GSßIˆ‚Ôàšƒµ ÕHÞ=ƒµ ‰GSHß=ƒµ ÕÝIˆ ‰GSÝIˆ‚Ô ÕHÕH=ƒÍ ‰GSH!ÕH=„Ô !QՕՔ⠈bˆ |ˆ cˆ‚óãä!ˆ.щ%‡" [bibtex-inside-field bibtex-enclosing-field bibtex-text-in-field bibtex-name-in-field nil new-text stop-name start-name stop-old-text start-old-text bibtex-cfield buffer-substring-no-properties looking-at "OPT" bibtex-field-text matching-entry last-command bibtex-pop-previous bibtex-pop-next bibtex-enclosing-reference bibtex-pop-previous-search-point 0 bibtex-pop-next-search-point re-search-backward t arg bibtex-text-in-cfield bibtex-field-left-delimiter "{" 34 123 125 "\"" bibtex-field-right-delimiter bibtex-flash-head error "No previous matching BibTeX field." this-command] 5 (#$ . 43248) "p"]) #@210 Replace text of current field with the text of similar field in next entry. With arg, go up ARG entries. Repeated, goes up so many times. May be intermixed with \[bibtex-pop-previous] (bibtex-pop-previous). (defalias 'bibtex-pop-next #[(arg) "À ˆŠÁ ˆ\n”\n• ” •Ä bˆÊËÌÍ!ƒ,`ÍG\\‚-`\"\"Ñ=„MÒ=„MÓ ˆ`Õ•bˆ×dØ$ƒïË”•\"Üšƒ ÕHÝ=ƒ ‰GSHÝ=ƒ ÕÞIˆ ‰GSßIˆ‚Ôàšƒµ ÕHÞ=ƒµ ‰GSHß=ƒµ ÕÝIˆ ‰GSÝIˆ‚Ô ÕHÕH=ƒÍ ‰GSH!ÕH=„Ô !QՕՔ⠈bˆ |ˆ cˆ‚óãä!ˆ.щ%‡" [bibtex-inside-field bibtex-enclosing-field bibtex-text-in-field bibtex-name-in-field nil new-text stop-name start-name stop-old-text start-old-text bibtex-cfield buffer-substring-no-properties looking-at "OPT" bibtex-field-text matching-entry last-command bibtex-pop-next bibtex-pop-previous bibtex-enclosing-reference bibtex-pop-previous-search-point 0 bibtex-pop-next-search-point re-search-forward t arg bibtex-text-in-cfield bibtex-field-left-delimiter "{" 34 123 125 "\"" bibtex-field-right-delimiter bibtex-flash-head error "No next matching BibTeX field." this-command] 5 (#$ . 44362) "p"]) #@366 Finish editing the current BibTeX entry and clean it up. For all optional fields of current BibTeX entry: if empty, kill the whole field; otherwise, remove the "OPT" string in the name; if text numerical, remove double-quotes. For all mandatory fields: if empty, signal error. If label of entry is empty or a prefix argument was given, calculate a new entry label. (defalias 'bibtex-clean-entry #[(&optional arg) "À ˆ`ÁŒ ŠÄ ˆ`)}ˆÅdÇÈ$ƒF\n„F ”\n” ‰\fbˆÍÎ!ƒB bˆÍP!„BÇ*‚Ñ ˆÅ!ˆÓ”TÓ• bˆÅdÇÈ$ƒiÓ”Ó• ” •\n”\n• \f\fbˆÍÚ!ƒƒ bˆÍP!ƒê\n„áÜÝÚG\f\\\"—ÞÝ\"\"A@@\"ƒá\fbˆàÚG!ˆáâ!ˆã ˆ$jˆÁuˆåæÝ\f\"\"ˆ‚d|ˆ‚d\fbˆàÚG!ˆáâ!ˆã ˆ$jˆbˆ‚d bˆÍçQ!ƒ.bˆàè!ˆ bˆàÈ!ˆbˆéuˆ‚dÍP!ƒ`ÈuˆÝ\f‰ê\\\"Úš„dÝ\f‰ê\\\"ëš„dåæÝ\f\"\"ˆ‚dbˆ.‚Z+ bˆÄ ˆŠèyˆÁˆhì=ƒíÈ!ˆ+Ä ˆ`.À ˆï0.Ç#…Ý1”1•\"23„ª2?…4ƒ·õö÷ \"‚¹÷ 8À ˆïù!ˆÈ”È•|ˆ8cˆÀ ˆ`Ä ˆïúÁû#ˆÓyˆ`Á<=þ =\"ˆÿ8Ç\"@A ˆBAB@ƒÀ ˆ‚ bˆï0!ˆ@?…åC!-*‡" [bibtex-beginning-of-entry nil crossref-there start bibtex-end-of-entry re-search-forward bibtex-field t 1 bibtex-name-in-field bibtex-text-in-field begin-text begin-name looking-at "\\(OPTcrossref\\)\\|\\(crossref\\)" bibtex-field-left-delimiter bibtex-field-right-delimiter bibtex-enclosing-reference bibtex-reference-type 0 end-type begin-type end-text end-name end-field begin-field "OPT" bibtex-clean-entry-zap-empty-opts assoc buffer-substring-no-properties assoc-ignore-case bibtex-entry-field-alist delete-char search-forward "=" delete-horizontal-space bibtex-text-alignment error "Mandatory field ``%s'' is empty" "[0-9]+" -1 -2 3 "opt" 44 backward-delete-char eob search-forward-regexp bibtex-reference-head bibtex-key-in-head key arg bibtex-autokey-edit-before-use read-from-minibuffer "Key to use: " bibtex-generate-autokey autokey "^@[A-Za-z]+[ ]*[({]\\([^,]*\\)" "^@" move last-command end kill-region bibtex-find-entry-location success yank kill-ring "BibTeX buffer was or has become invalid (call `bibtex-validate-buffer')"] 7 (#$ . 45471) "P"]) #@142 Complete word fragment before point to longest prefix of a defined string. If point is not after the part of a word, all strings are listed. (defalias 'bibtex-complete-string #[nil "`ŠÁÂ!ˆÃuˆ`)Å\f\"Ç! Ê ŠÁÌeÊ#ƒMÍ•bˆ`Í”ÐÑdÊ#ˆÍ”bˆÅ`\"C B bˆ*‚Ò Ó\" Ô \")‰Ê=ƒhÖ ‚«„u×Ø\"‚«˜„“\f|ˆcˆÙ \"…«Ö ‚«ÚÛ!ˆÜ \"Þß!‘ˆ)Úà!.‡" [end re-search-backward "[ {\"]" 1 beg buffer-substring-no-properties part-of-word copy-sequence bibtex-completion-candidates string-list t case-fold-search "@string[ \n]*{" 0 strt pnt re-search-forward "[ \n]*=" sort #[(x y) "@ @™‡" [x y] 2] try-completion completion bibtex-remove-double-quotes-or-braces error "Can't find completion for \"%s\"" assoc message "Making completion list..." all-completions list "*Completions*" display-completion-list "Making completion list...done"] 5 (#$ . 47529) "*"]) (defalias 'bibtex-Article #[nil "ÀÁ!‡" [bibtex-entry "Article"] 2 nil nil]) (defalias 'bibtex-Book #[nil "ÀÁ!‡" [bibtex-entry "Book"] 2 nil nil]) (defalias 'bibtex-Booklet #[nil "ÀÁ!‡" [bibtex-entry "Booklet"] 2 nil nil]) (defalias 'bibtex-InBook #[nil "ÀÁ!‡" [bibtex-entry "InBook"] 2 nil nil]) (defalias 'bibtex-InCollection #[nil "ÀÁ!‡" [bibtex-entry "InCollection"] 2 nil nil]) (defalias 'bibtex-InProceedings #[nil "ÀÁ!‡" [bibtex-entry "InProceedings"] 2 nil nil]) (defalias 'bibtex-Manual #[nil "ÀÁ!‡" [bibtex-entry "Manual"] 2 nil nil]) (defalias 'bibtex-MastersThesis #[nil "ÀÁ!‡" [bibtex-entry "MastersThesis"] 2 nil nil]) (defalias 'bibtex-Misc #[nil "ÀÁ!‡" [bibtex-entry "Misc"] 2 nil nil]) (defalias 'bibtex-PhdThesis #[nil "ÀÁ!‡" [bibtex-entry "PhdThesis"] 2 nil nil]) (defalias 'bibtex-Proceedings #[nil "ÀÁ!‡" [bibtex-entry "Proceedings"] 2 nil nil]) (defalias 'bibtex-TechReport #[nil "ÀÁ!‡" [bibtex-entry "TechReport"] 2 nil nil]) (defalias 'bibtex-Unpublished #[nil "ÀÁ!‡" [bibtex-entry "Unpublished"] 2 nil nil]) (defalias 'bibtex-string #[nil "À ˆÁ\n ÄRcˆÅyˆÆu‡" [bibtex-move-outside-of-entry "@string{ = " bibtex-field-left-delimiter bibtex-field-right-delimiter "}\n" -1 8] 4 nil nil]) (defalias 'bibtex-preamble #[nil "À ˆÁcˆÂyˆÃu‡" [bibtex-move-outside-of-entry "@Preamble{}\n" -1 10] 1 nil nil]) (provide (quote bibtex)) emacs-19.30/lisp/blackbox.elc100666 74777 1 23071 5751545277 14415 0ustar esrdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:13:49 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/blackbox.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/blackbox.el' was compiled for Emacs 19")) #@2  (defvar blackbox-mode-map nil (#$ . 484)) (byte-code "„`Á ÂÃ\"ˆÄÅÆ#ˆÄÇÆ#ˆÄÈÉ#ˆÄÊÉ#ˆÄËÌ#ˆÄÍÌ#ˆÄÎÏ#ˆÄÐÏ#ˆÄÑÒ#ˆÄÓÔ#ˆÄÕÖ#ˆÄ×Ö#ˆÄØÙ#ˆÄÚÙ#ˆÛÜÝÞ#‡" [blackbox-mode-map make-keymap suppress-keymap t define-key "" bb-right [right] "" bb-left [left] "" bb-up [up] "" bb-down [down] "" bb-eol "" bb-bol " " bb-romp [insert] " " bb-done [kp-enter] put blackbox-mode mode-class special] 4) #@372 Major mode for playing blackbox. To learn how to play blackbox, see the documentation for function `blackbox'. The usual mnemonic keys move the cursor around the box. \\[bb-bol] and \[bb-eol] move to the beginning and end of line, respectively. \[bb-romp] -- send in a ray from point, or toggle a ball at point \[bb-done] -- end game and get score  (defalias 'blackbox-mode #[nil "À ˆÁ\n!ˆÃÅlj‡" [kill-all-local-variables use-local-map blackbox-mode-map t truncate-lines blackbox-mode major-mode "Blackbox" mode-name] 2 (#$ . 892) nil]) #@5066 Play blackbox. Optional prefix argument is the number of balls; the default is 4. What is blackbox? Blackbox is a game of hide and seek played on an 8 by 8 grid (the Blackbox). Your opponent (Emacs, in this case) has hidden several balls (usually 4) within this box. By shooting rays into the box and observing where they emerge it is possible to deduce the positions of the hidden balls. The fewer rays you use to find the balls, the lower your score. Overview of play: \To play blackbox, type \[blackbox]. An optional prefix argument specifies the number of balls to be hidden in the box; the default is four. The cursor can be moved around the box with the standard cursor movement keys. To shoot a ray, move the cursor to the edge of the box and press SPC. The result will be determined and the playfield updated. You may place or remove balls in the box by moving the cursor into the box and pressing \[bb-romp]. When you think the configuration of balls you have placed is correct, press \[bb-done]. You will be informed whether you are correct or not, and be given your score. Your score is the number of letters and numbers around the outside of the box plus five for each incorrectly placed ball. If you placed any balls incorrectly, they will be indicated with `x', and their actual positions indicated with `o'. Details: There are three possible outcomes for each ray you send into the box: Detour: the ray is deflected and emerges somewhere other than where you sent it in. On the playfield, detours are denoted by matching pairs of numbers -- one where the ray went in, and the other where it came out. Reflection: the ray is reflected and emerges in the same place it was sent in. On the playfield, reflections are denoted by the letter `R'. Hit: the ray strikes a ball directly and is absorbed. It does not emerge from the box. On the playfield, hits are denoted by the letter `H'. The rules for how balls deflect rays are simple and are best shown by example. As a ray approaches a ball it is deflected ninety degrees. Rays can be deflected multiple times. In the diagrams below, the dashes represent empty box locations and the letter `O' represents a ball. The entrance and exit points of each ray are marked with numbers as described under "Detour" above. Note that the entrance and exit points are always interchangeable. `*' denotes the path taken by the ray. Note carefully the relative positions of the ball and the ninety degree deflection it causes. 1 - * - - - - - - - - - - - - - - - - - - - - - - - * - - - - - - - - - - - - - - - - - - - - - - 1 * * - - - - - - - - - - - - - - - O - - - - O - - - O - - - - - - - O - - - - - - - * * * * - - - - - - - - - - - - - * * * * * 2 3 * * * - - * - - - - - - - - - - - - - * - - - - - - - O - * - - - - - - - - - - - - - * - - - - - - - - * * - - - - - - - - - - - - - * - - - - - - - - * - O - 2 3 As mentioned above, a reflection occurs when a ray emerges from the same point it was sent in. This can happen in several ways: - - - - - - - - - - - - - - - - - - - - - - - - - - - - O - - - - - O - O - - - - - - - - - - - R * * * * - - - - - - - * - - - - O - - - - - - - - - - - O - - - - - - * - - - - R - - - - - - - - - - - - - - - - - - - * - - - - - - - - - - - - - - - - - - - - - - - * - - - - - - - - - - - - - - - - - - - - R * * * * - - - - - - - - - - - - - - - - - - - - - - - - O - - - - - - - - - - - In the first example, the ray is deflected downwards by the upper ball, then left by the lower ball, and finally retraces its path to its point of origin. The second example is similar. The third example is a bit anomalous but can be rationalized by realizing the ray never gets a chance to get into the box. Alternatively, the ray can be thought of as being deflected downwards and immediately emerging from the box. A hit occurs when a ray runs straight into a ball: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - O - - - - - - - - - - - - - - - O - - - H * * * * - - - - - - - - - - - - H * * * * O - - - - - - * - - - - - - - - - - - - - - - - O - - - - - - O - - - - H * * * O - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Be sure to compare the second example of a hit with the first example of a reflection. (defalias 'blackbox #[(num) "ÀÁ!ˆÂ ˆÃÅp!ˆÆ†È! Ê Ì ÌÏÏÒ ˆÓ B!‡" [switch-to-buffer "*Blackbox*" blackbox-mode t buffer-read-only buffer-disable-undo bb-init-board num 4 bb-board nil bb-balls-placed -1 bb-x bb-y 0 bb-score bb-detour-count bb-insert-board bb-goto] 3 (#$ . 1464) "P"]) (defalias 'bb-init-board #[(num-balls) "ÀÁ!ˆÂ‰ S‰ÆYƒ'ÀÇ!ÀÇ!BÈ \f\"„ \fB‚\f*‡" [random t nil pos board num-balls 0 8 bb-member] 3]) (defalias 'bb-insert-board #[nil "À‰à ˆÄcˆÅ\nS‰ÆYƒÇcˆ‚\fÄcˆÈÉ\nG\"c*‡" [nil buffer-read-only i erase-buffer " \n" 8 0 " - - - - - - - - \n" format "\nThere are %d balls in the box" bb-board] 3]) (defalias 'bb-right #[nil "ÁU?…ÂuˆT‰‡" [bb-x 8 2] 2 nil nil]) (defalias 'bb-left #[nil "ÁU?…ÂÃ!ˆS‰‡" [bb-x -1 backward-char 2] 2 nil nil]) (defalias 'bb-up #[nil "ÁU?…ÂÃ!ˆS‰‡" [bb-y -1 previous-line 1] 2 nil nil]) (defalias 'bb-down #[nil "ÁU?…ÂÃ!ˆT‰‡" [bb-y 8 next-line 1] 2 nil nil]) (defalias 'bb-eol #[nil "À B!‡" [8 bb-x bb-goto bb-y] 3 nil nil]) (defalias 'bb-bol #[nil "À B!‡" [-1 bb-x bb-goto bb-y] 3 nil nil]) (defalias 'bb-romp #[nil "ÁU„\fÂUƒ ÁU†( ÂU†(Ä \"ƒ$Å \"‡Æ \"‡" [bb-x -1 8 bb-y bb-outside-box bb-trace-ray bb-place-ball] 3 nil nil]) (defalias 'bb-place-ball #[(x y) " BÃ\n\f\"ƒÅ\n\f\"ÆÇ!‚\n\fBÆÈ!)‡" [x y coord bb-member bb-balls-placed bb-delete bb-update-board "-" "O"] 3]) (defalias 'bb-trace-ray #[(x y) "ÀÁ\n‰ÃUƒ Ä‚\nÅUƒÂƉÃUƒ$Ä‚0ÅUƒ/Â0Æ%‰É=ƒFÊË!ˆ\fT‰\f‚€\nBšƒ]ÊÍ!ˆ\fT‰\f‚€TÊÏÐ\"!ˆŠÑ!ˆÊÏÐ\"!ˆ)\fÒ\\‰\f)‡" [bb-trace-ray-2 t x -1 1 8 0 y result hit bb-update-board "H" bb-score "R" bb-detour-count format "%d" bb-goto 2] 8]) (defalias 'bb-trace-ray-2 #[(first x dx y dy) "„Á\n \"ƒ\n B‡Ä\n \\ \\B\"ƒ ȇÄ\n \\\\  \\\\B\"ƒ?ÉÊ\n[ [%‡Ä\n [\\\\  [\\\\B\"ƒ^ÉÊ\n %‡ÉÊ\n \\ \\%‡" [first bb-outside-box x y bb-member dx dy bb-board hit bb-trace-ray-2 nil] 6]) #@35 Finish the game and report score. (defalias 'bb-done #[nil "À\nG GU„,ÄÅ GÆUƒÇ‚È G GÆUƒ%É‚&Ê\nG%‚YË\n \"‰ÌUƒ@ÄÍ\"ˆ‚VÄÏ ‰ÆUƒMÉ‚NÊ Ð_\\$ˆÑÒ!)‡" [nil bogus-balls bb-balls-placed bb-board message "There %s %d hidden ball%s; you have placed %d." 1 "is" "are" "" "s" bb-show-bogus-balls 0 "Right! Your score is %d." bb-score "Oops! You missed %d ball%s. Your score is %d." 5 bb-goto (-1 . -1)] 8 (#$ . 8496) nil]) (defalias 'bb-show-bogus-balls #[(balls-placed board) "À \nÃ#ˆÀ\n Ä#‡" [bb-show-bogus-balls-2 balls-placed board "x" "o"] 4]) (defalias 'bb-show-bogus-balls-2 #[(list-1 list-2 c) "„Á‡Â@ \"ƒÄA #‡Æ@!ˆÇ !ˆÄA #T‡" [list-1 0 bb-member list-2 bb-show-bogus-balls-2 c bb-goto bb-update-board] 4]) (defalias 'bb-outside-box #[(x y) "ÁU†ÂU† ÁU† ÂU‡" [x -1 8 y] 2]) (defalias 'bb-goto #[(pos) "@Á_AÂ_Ã\\\\b‡" [pos 2 22 26] 3]) (defalias 'bb-update-board #[(c) "À GS!ˆÄ G!ˆ cˆÂÅ!)‡" [nil buffer-read-only backward-char c delete-char 1] 2]) #@47 Returns non-nil if ELT is an element of LIST. (defalias 'bb-member #[(elt list) "ÀÁÂÃ\f\"B!‡" [eval or mapcar #[(x) " š‡" [x elt] 2] list] 5 (#$ . 9482)]) #@44 Deletes ITEM from LIST and returns a copy. (defalias 'bb-delete #[(item list) " @šƒ\n A‡ @ A\"B‡" [item list bb-delete] 4 (#$ . 9644)]) emacs-19.30/lisp/bookmark.elc100666 12120 1 140562 6016144655 14426 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Aug 21 13:59:33 1995 ;;; from file /home/fsf/rms/e19/lisp/bookmark.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`bookmark.el' was compiled for Emacs 19.29 or later")) (require (quote pp)) #@74 *If non-nil, saving a bookmark will query for an annotation in a buffer. (defvar bookmark-use-annotations nil (#$ . -492)) #@782 *Controls when Emacs saves bookmarks to a file. --> Nil means never save bookmarks, except when `bookmark-save' is explicitly called (\[bookmark-save]). --> t means save bookmarks when Emacs is killed. --> Otherise, it should be a number that is the frequency with which the bookmark list is saved (i.e.: the number of times which Emacs' bookmark list may be modified before it is automatically saved.). If it is a number, Emacs will also automatically save bookmarks when it is killed. Therefore, the way to get it to save every time you make or delete a bookmark is to set this variable to 1 (or 0, which produces the same behavior.) To specify the file in which to save them, modify the variable bookmark-default-file, which is `~/.emacs.bmk' by default. (defvar bookmark-save-flag t (#$ . -622)) #@46 *The .emacs.bmk file used to be called this. (defconst bookmark-old-default-file "~/.emacs-bkmrks" (#$ . -1451)) #@39 Old name for `bookmark-default-file'. (defvar bookmark-file nil (#$ . 1570)) #@46 *File in which to save bookmarks by default. (defvar bookmark-default-file (byte-code "ƒ‡ Â=ƒÇć" [bookmark-file system-type ms-dos "~/emacs.bmk" "~/.emacs.bmk"] 2) (#$ . -1653)) #@289 *Whether or not to make numbered backups of the bookmark file. It can have four values: t, nil, `never', and `nospecial'. The first three have the same meaning that they do for the variable `version-control', and the final value `nospecial' means just use the value of `version-control'. (defvar bookmark-version-control (quote nospecial) (#$ . -1846)) #@62 *Non-nil means bookmark functions ignore case in completion. (defvar bookmark-completion-ignore-case t (#$ . -2205)) #@191 *Non-nil means that bookmarks will be displayed sorted by bookmark name. Otherwise they will be displayed in LIFO order (that is, most recently set ones come first, oldest ones come last). (defvar bookmark-sort-flag t (#$ . -2329)) #@63 *Nil means don't show annotations when jumping to a bookmark. (defvar bookmark-automatically-show-annotations t (#$ . -2568)) #@176 *Column at which to display filenames in a buffer listing bookmarks. You can toggle whether files are shown with \\[bookmark-bmenu-toggle-filenames]. (defvar bookmark-bmenu-file-column 30 (#$ . -2701)) #@196 *Non-nil means show filenames when listing bookmarks. This may result in truncated bookmark names. To disable this, put the following in your .emacs: (setq bookmark-bmenu-toggle-filenames nil) (defvar bookmark-bmenu-toggle-filenames t (#$ . -2935)) #@63 *Maximum length of a bookmark name displayed on a popup menu. (defvar bookmark-menu-length 70 (#$ . -3192)) (byte-code "ÀÁ!„\nÁÂMˆÀÃ!„ÁÃÄ\"ˆÅÆ!9„1ÇÉÊ#ˆÇËÌ#ˆÇÍÎ#ˆÀ‡" [fboundp defalias fset frame-height screen-height key-binding "r" define-key ctl-x-map "rb" bookmark-jump "rm" bookmark-set "rl" bookmark-bmenu-list] 4) #@279 Keymap containing bindings to bookmark functions. It is not bound to any key by default: to bind it so that you have a bookmark prefix, just use `global-set-key' and bind a key of your choice to `bookmark-map'. All interactive bookmark functions have a binding in this keymap. (defvar bookmark-map nil (#$ . 3528)) (byte-code "ÀÁ!ˆÂ ÃÄ#ˆÂ ÅÄ#ˆÂ ÆÇ#ˆÂ ÈÇ#ˆÂ ÉÊ#ˆÂ ËÌ#ˆÂ ÍÎ#ˆÂ ÏÐ#ˆÂ ÑÒ#ˆÂ ÓÔ#ˆÂ ÕÖ#ˆÂ ×Ø#‡" [define-prefix-command bookmark-map define-key "x" bookmark-set "m" "j" bookmark-jump "g" "i" bookmark-insert "e" edit-bookmarks "f" bookmark-insert-location "r" bookmark-rename "d" bookmark-delete "l" bookmark-load "w" bookmark-write "s" bookmark-save] 4) #@52 Keymap for composing an annotation for a bookmark. (defvar bookmark-read-annotation-mode-map (copy-keymap text-mode-map) (#$ . 4197)) (define-key bookmark-read-annotation-mode-map "" (quote bookmark-send-annotation)) #@526 Association list of bookmarks and their records. You probably don't want to change the value of this alist yourself; instead, let the various bookmark functions do it for you. The format of the alist is (BOOKMARK1 BOOKMARK2 ...) where each BOOKMARK is of the form (NAME (filename . FILE) (front-context-string . FRONT-STR) (rear-context-string . REAR-STR) (position . POS) (info-node . POS) (annotation . ANNOTATION)) So the cdr of each bookmark is an alist too. `info-node' is optional, by the way. (defvar bookmark-alist nil (#$ . 4423)) (byte-code "ÀÁ!„ÂÁ BÄÅÆ\"‡" [boundp bookmarks-already-loaded nil current-load-list add-hook kill-emacs-hook #[nil "ÀÁ!…\n…ÃÄ!…Å ‡" [featurep bookmark bookmark-alist bookmark-time-to-save-p t bookmark-save] 2]] 3) #@140 Name of bookmark most recently used in the current file. It is buffer local, used to make moving a bookmark forward through a file easier. (defvar bookmark-current-bookmark nil (#$ . 5218)) (make-variable-buffer-local (quote bookmark-current-bookmark)) #@67 Number of modifications to bookmark list since it was last saved. (defvar bookmark-alist-modification-count 0 (#$ . 5477)) #@70 Length of the context strings recorded on either side of a bookmark. (defvar bookmark-search-size 16 (#$ . 5606)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÆÅ BƇ" [boundp bookmark-current-point 0 current-load-list bookmark-yank-point bookmark-current-buffer nil] 2) #@68 Return name of FULL-RECORD (an alist element instead of a string). (defalias 'bookmark-name-from-full-record #[(full-record) "@‡" [full-record] 1 (#$ . 5881)]) #@46 Return a list of all current bookmark names. (defalias 'bookmark-all-names #[nil "À ˆÁ \"‡" [bookmark-maybe-load-default-file mapcar #[(full-record) "À !‡" [bookmark-name-from-full-record full-record] 2] bookmark-alist] 3 (#$ . 6048)]) #@55 Return the full entry for BOOKMARK in bookmark-alist. (defalias 'bookmark-get-bookmark #[(bookmark) "À \n\"‡" [assoc bookmark bookmark-alist] 3 (#$ . 6291)]) #@101 Return the guts of the entry for BOOKMARK in bookmark-alist. That is, all information but the name. (defalias 'bookmark-get-bookmark-record #[(bookmark) "À !A@‡" [bookmark-get-bookmark bookmark] 2 (#$ . 6456)]) #@33 Set BOOKMARK's name to NEWNAME. (defalias 'bookmark-set-name #[(bookmark newname) "À !\n ‡" [bookmark-get-bookmark bookmark newname] 2 (#$ . 6673)]) #@52 Return the annotation of BOOKMARK, or nil if none. (defalias 'bookmark-get-annotation #[(bookmark) "ÀÁ\n!žA‡" [annotation bookmark-get-bookmark-record bookmark] 3 (#$ . 6828)]) #@40 Set the annotation of BOOKMARK to ANN. (defalias 'bookmark-set-annotation #[(bookmark ann) "ÀÁ\n!ž‰ƒ \f¡‚Á\n!À\fBC¤)‡" [annotation bookmark-get-bookmark-record bookmark cell ann] 4 (#$ . 7011)]) #@39 Return the full filename of BOOKMARK. (defalias 'bookmark-get-filename #[(bookmark) "ÀÁ\n!žA‡" [filename bookmark-get-bookmark-record bookmark] 3 (#$ . 7217)]) #@48 Set the full filename of BOOKMARK to FILENAME. (defalias 'bookmark-set-filename #[(bookmark filename) "ÀÁ\n!ž‰ƒ ¡‚Á\n!ÀBC¤)‡" [filename bookmark-get-bookmark-record bookmark cell] 4 (#$ . 7383)]) #@48 Return the position (i.e.: point) of BOOKMARK. (defalias 'bookmark-get-position #[(bookmark) "ÀÁ\n!žA‡" [position bookmark-get-bookmark-record bookmark] 3 (#$ . 7592)]) #@57 Set the position (i.e.: point) of BOOKMARK to POSITION. (defalias 'bookmark-set-position #[(bookmark position) "ÀÁ\n!ž‰ƒ ¡‚Á\n!ÀBC¤)‡" [position bookmark-get-bookmark-record bookmark cell] 4 (#$ . 7767)]) #@46 Return the front-context-string of BOOKMARK. (defalias 'bookmark-get-front-context-string #[(bookmark) "ÀÁ\n!žA‡" [front-context-string bookmark-get-bookmark-record bookmark] 3 (#$ . 7985)]) #@53 Set the front-context-string of BOOKMARK to STRING. (defalias 'bookmark-set-front-context-string #[(bookmark string) "ÀÁ\n!ž‰ƒ \f¡‚Á\n!À\fBC¤)‡" [front-context-string bookmark-get-bookmark-record bookmark cell string] 4 (#$ . 8182)]) #@45 Return the rear-context-string of BOOKMARK. (defalias 'bookmark-get-rear-context-string #[(bookmark) "ÀÁ\n!žA‡" [rear-context-string bookmark-get-bookmark-record bookmark] 3 (#$ . 8427)]) #@52 Set the rear-context-string of BOOKMARK to STRING. (defalias 'bookmark-set-rear-context-string #[(bookmark string) "ÀÁ\n!ž‰ƒ \f¡‚Á\n!À\fBC¤)‡" [rear-context-string bookmark-get-bookmark-record bookmark cell string] 4 (#$ . 8621)]) #@45 Get the info node associated with BOOKMARK. (defalias 'bookmark-get-info-node #[(bookmark) "ÀÁ\n!žA‡" [info-node bookmark-get-bookmark-record bookmark] 3 (#$ . 8863)]) #@40 Set the Info node of BOOKMARK to NODE. (defalias 'bookmark-set-info-node #[(bookmark node) "ÀÁ\n!ž‰ƒ \f¡‚Á\n!À\fBC¤)‡" [info-node bookmark-get-bookmark-record bookmark cell node] 4 (#$ . 9037)]) #@42 The history list for bookmark functions. (defvar bookmark-history nil (#$ . 9243)) #@255 Prompting with PROMPT, read a bookmark name in completion. PROMPT will get a ": " stuck on the end no matter what, so you probably don't want to include one yourself. Optional second arg DEFAULT is a string to return if the user enters the empty string. (defalias 'bookmark-completing-read #[(prompt &optional default) "À ˆ  ‰ƒ\fÅÆ \"P‚\fÇPÈ\f ÊËÊÌ&‰ Θƒ/ C‚2 C,‡" [bookmark-maybe-load-default-file bookmark-completion-ignore-case completion-ignore-case default prompt format " (%s): " ": " completing-read bookmark-alist nil 0 bookmark-history str ""] 8 (#$ . 9333)]) #@215 Put STRING into the bookmark prompt history, if caller non-interactive. We need this because sometimes bookmark functions are invoked from menus, so `completing-read' never gets a chance to set `bookmark-history'. (defalias 'bookmark-maybe-historicize-string '(macro . #[(string) "ÀÁÂÃÄ ÆBBEE‡" [or (interactive-p) setq bookmark-history cons string (bookmark-history)] 7 (#$ . 9922)])) #@166 Make a bookmark named NAME. Optional second arg ANNOTATION gives it an annotation. Optional third arg OVERWRITE means replace any existing bookmarks with this name. (defalias 'bookmark-make #[(name &optional annotation overwrite) "À ˆÁ\n!ÄÅ GÆ $ˆÇ !ƒ'„'Ç !É\n!C¡ˆ‚2 É\n!D B \f T Î …AÏ )‡" [bookmark-maybe-load-default-file copy-sequence name stripped-name set-text-properties 0 nil bookmark-get-bookmark overwrite bookmark-make-cell annotation bookmark-alist bookmark-current-bookmark bookmark-alist-modification-count bookmark-time-to-save-p bookmark-save] 5 (#$ . 10315)]) #@167 Return the record part of a new bookmark, given ANNOTATION. Must be at the correct position in the buffer in which the bookmark is being set. This will change soon. (defalias 'bookmark-make-cell #[(annotation) "ÀÁ BÂd`Z Y…Ä`` \\\"BÅ`eZ Y…#Ä`` Z\"BÆ`BÇB¯‡" [filename bookmark-buffer-file-name front-context-string bookmark-search-size buffer-substring-no-properties rear-context-string position annotation] 7 (#$ . 10912)]) #@97 The current version of the format used by bookmark files. You should never need to change this. (defconst bookmark-file-format-version 1 (#$ . 11348)) #@68 This string marks the end of the version stamp in a bookmark file. (defconst bookmark-end-of-version-stamp-marker "-*- End Of Bookmark File Format Version Stamp -*-\n" (#$ . 11505)) #@209 Return a bookmark-alist (in any format) from the current buffer. The buffer must of course contain bookmark format information. Does not care from where in the buffer it is called, and does not affect point. (defalias 'bookmark-alist-from-buffer #[nil "ŠebˆÀ ÂÃ#ƒÄp!‚&ÀÅÂÃ#ƒ#ÆuˆÄp!‚&ÇÈ!)‡" [search-forward bookmark-end-of-version-stamp-marker nil t read "(" -1 error "Not bookmark format."] 4 (#$ . 11694)]) #@60 Upgrade a version 0 alist OLD-LIST to the current version. (defalias 'bookmark-upgrade-version-0-alist #[(old-list) "ÀÁ\n\"‡" [mapcar #[(bookmark) "@A@‰@\nA@Å\n8Ç\n8É\n8\n à BË\f†'ÌB͆/ÌBÈBÎ\nB¯.D‡" [bookmark name record filename front-str 2 rear-str 3 position 4 ann front-context-string "" rear-context-string annotation] 8] old-list] 3 (#$ . 12113)]) #@133 Upgrade a bookmark file of format 0 (the original format) to format 1. This expects to be called from point-min in a bookmark file. (defalias 'bookmark-upgrade-file-format-from-0 #[nil "ÀÁ\n\"ˆÃ Å\f!ed|ˆÇ ˆÈp\"ˆÉ ˆ*ebˆÀÊ\n\"‡" [message "Upgrading bookmark format from 0 to %d..." bookmark-file-format-version bookmark-alist-from-buffer old-list bookmark-upgrade-version-0-alist new-list bookmark-insert-file-format-version-stamp pp save-buffer "Upgrading bookmark format from 0 to %d... done."] 3 (#$ . 12494)]) #@136 Return an integer which is the file-format version of this bookmark file. This expects to be called from point-min in a bookmark file. (defalias 'bookmark-grok-file-format-version #[nil "ÀÁ!ƒŠÂ ÄŽÅÆ!ˆÇuˆÈp!+‡É‡" [looking-at "^;;;;" match-data match-data ((store-match-data match-data)) re-search-forward "[0-9]" -1 read 0] 2 (#$ . 13018)]) #@175 Check the file-format version of this bookmark file. If the version is not up-to-date, upgrade it automatically. This expects to be called from point-min in a bookmark file. (defalias 'bookmark-maybe-upgrade-file-format #[nil "À ‰\nU† ÃUƒÄ ‚ÅÆ!)‡" [bookmark-grok-file-format-version version bookmark-file-format-version 0 bookmark-upgrade-file-format-from-0 error "Bookmark file format version strangeness."] 3 (#$ . 13368)]) #@65 Insert text indicating current version of bookmark file-format. (defalias 'bookmark-insert-file-format-version-stamp #[nil "ÀÁ\n\"cˆÃÄű‡" [format ";;;; Emacs Bookmark Format Version %d ;;;;\n" bookmark-file-format-version ";;; This format is meant to be slightly human-readable;\n" ";;; nevertheless, you probably don't want to edit it.\n" ";;; " bookmark-end-of-version-stamp-marker] 4 (#$ . 13807)]) #@1009 Set a bookmark named NAME inside a file. If name is nil, then the user will be prompted. With prefix arg, will not overwrite a bookmark that has the same name as NAME if such a bookmark already exists, but instead will "push" the new bookmark onto the bookmark alist. Thus the most recently set bookmark with name NAME would be the one in effect at any given time, but the others are still there, should you decide to delete the most recent one. To yank words from the text of the buffer and use them as part of the bookmark name, type C-w while setting a bookmark. Successive C-w's yank successive words. Typing C-u inserts the name of the last bookmark used in the buffer (as an aid in using a single bookmark name to track your progress through a large file). If no bookmark was used, then C-u inserts the name of the file being visited. Use \[bookmark-delete] to remove bookmarks (you give it a name, and it removes only the first instance of a bookmark with that name from the list of bookmarks.) (defalias 'bookmark-set #[(&optional name parg) "À „ ÁÂ!ˆÃ ˆ``p†È  \n†@ËÌÍ \"ÎÏ!ÒÓÔ#ˆÒÕÖ#ˆ)#ÎÙ˜ƒP ƒ^Û\"‚~Ý#ˆß=ƒuà!\"ˆâ ˆ\fb+‡" [bookmark-buffer-file-name error "Buffer not visiting a file or directory." bookmark-maybe-load-default-file bookmark-current-point bookmark-yank-point bookmark-current-buffer bookmark-current-bookmark bookmark-buffer-name default name read-from-minibuffer format "Set bookmark (%s): " nil copy-keymap minibuffer-local-map now-map define-key "" bookmark-yank-word "" bookmark-insert-current-bookmark str annotation "" bookmark-use-annotations bookmark-read-annotation parg bookmark-make major-mode Info-mode bookmark-set-info-node Info-current-node bookmark-bmenu-surreptitiously-rebuild-list] 7 (#$ . 14221) (list nil current-prefix-arg)]) #@128 Kill from point to end of line. If optional arg NEWLINE-TOO is non-nil, delete the newline too. Does not affect the kill-ring. (defalias 'bookmark-kill-line #[(&optional newline-too) "ŠÀˆ`)` |ˆ\n…ÃÄ!…ÅÆ!)‡" [nil eol newline-too looking-at "\n" delete-char 1] 2 (#$ . 16063)]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ B‡" [boundp bookmark-annotation-paragraph nil current-load-list bookmark-annotation-name bookmark-annotation-buffer bookmark-annotation-file bookmark-annotation-point] 2) #@217 After remove lines beginning with '#', use the contents of this buffer as the annotation for a bookmark, and store it in the bookmark list with the bookmark (and file, and point) specified in buffer local variables. (defalias 'bookmark-send-annotation #[nil "Á=„\nÂÃ!ˆebˆ`dWƒ&ÄÅ!ƒ ÆÇ!ˆ‚ Èyˆ‚ ed{ \n \f ŠÒ !ˆbˆÓ#ˆ)Õ ˆbˆ-×p!‡" [major-mode bookmark-read-annotation-mode error "Not in bookmark-read-annotation-mode." looking-at "^#" bookmark-kill-line t 1 bookmark-annotation-paragraph bookmark-annotation-name bookmark-annotation-point bookmark-annotation-buffer buf pt bookmark parg annotation pop-to-buffer bookmark-make bookmark-current-bookmark bookmark-bmenu-surreptitiously-rebuild-list bookmark-current-point kill-buffer] 5 (#$ . 16597) nil]) (defalias 'bookmark-default-annotation-text #[(bookmark) "À ÂÃÄÅÆ ÇÈ ÉÊ ËÌÍ Î°‡" ["# Type the annotation for bookmark '" bookmark "' here.\n" "# All lines which start with a '#' will be deleted.\n" "# Type C-c C-c when done.\n#\n" "# Author: " user-full-name " <" user-login-name "@" system-name ">\n" "# Date: " current-time-string "\n"] 15]) #@166 A variable containing a function which returns the text to insert into an annotation compisition buffer. It takes the name of the bookmark, as a string, as an arg. (defvar bookmark-read-annotation-text-func (quote bookmark-default-annotation-text) (#$ . 17738)) #@213 Mode for composing annotations for a bookmark. Wants BUF POINT PARG and BOOKMARK. When you have finished composing, type \[bookmark-send-annotation] to send the annotation. \{bookmark-read-annotation-mode-map}  (defalias 'bookmark-read-annotation-mode #[(buf point parg bookmark) "À ˆÁÂ!ˆÁÃ!ˆÁÄ!ˆÁÅ!ˆÁÆ!ˆ Ê ! Ì !ˆÎ!cˆÑÒ!‡" [kill-all-local-variables make-local-variable bookmark-annotation-paragraph bookmark-annotation-name bookmark-annotation-buffer bookmark-annotation-file bookmark-annotation-point parg bookmark buf buffer-file-name point use-local-map bookmark-read-annotation-mode-map bookmark-read-annotation-mode major-mode bookmark-read-annotation-text-func run-hooks text-mode-hook] 2 (#$ . 18008) nil]) #@124 Pop up a buffer for entering a bookmark annotation. Text surrounding the bookmark is PARG; the bookmark name is BOOKMARK. (defalias 'bookmark-read-annotation #[(parg bookmark) "p`ÂÃÄ!!ˆÅ $*‡" [point buf pop-to-buffer generate-new-buffer-name "*Bookmark Annotation Compose*" bookmark-read-annotation-mode parg bookmark] 5 (#$ . 18750)]) #@49 Keymap for editing an annotation of a bookmark. (defvar bookmark-edit-annotation-mode-map (copy-keymap text-mode-map) (#$ . 19100)) (define-key bookmark-edit-annotation-mode-map "" (quote bookmark-send-edited-annotation)) #@162 Mode for editing the annotation of bookmark BOOKMARK. When you have finished composing, type \[bookmark-send-annotation]. \{bookmark-edit-annotation-mode-map}  (defalias 'bookmark-edit-annotation-mode #[(bookmark) "À ˆÁÂ!ˆ Ä !ˆÆ !cˆÉ !‰\nË=„,\n̘„,\ncˆ)ÍÎ!‡" [kill-all-local-variables make-local-variable bookmark-annotation-name bookmark use-local-map bookmark-edit-annotation-mode-map bookmark-edit-annotation-mode major-mode bookmark-read-annotation-text-func bookmark-get-annotation annotation nil "" run-hooks text-mode-hook] 3 (#$ . 19331) nil]) #@110 After remove lines beginning with '#', use the contents of this buffer as the new annotation for a bookmark. (defalias 'bookmark-send-edited-annotation #[nil "Á=„\nÂÃ!ˆebˆ`dWƒ&ÄÅ!ƒ ÆÇ!ˆ‚ Èyˆ‚ ed{ \n Ì\n \"ˆÍ ˆbˆ*Ïp!‡" [major-mode bookmark-edit-annotation-mode error "Not in bookmark-edit-annotation-mode." looking-at "^#" bookmark-kill-line t 1 bookmark-annotation-name bookmark annotation bookmark-set-annotation bookmark-bmenu-surreptitiously-rebuild-list bookmark-current-point kill-buffer] 3 (#$ . 19901) nil]) #@61 Pop up a buffer for editing bookmark BOOKMARK's annotation. (defalias 'bookmark-edit-annotation #[(bookmark) "p`ÂÃÄ!!ˆÅ!*‡" [point buf pop-to-buffer generate-new-buffer-name "*Bookmark Annotation Compose*" bookmark-edit-annotation-mode bookmark] 3 (#$ . 20435)]) #@92 Insert this buffer's value of bookmark-current-bookmark, default to file name if it's nil. (defalias 'bookmark-insert-current-bookmark #[nil "Šqˆ )‰ƒ\nc‚à )‡" [bookmark-current-buffer bookmark-current-bookmark str bookmark-insert-buffer-name] 2 (#$ . 20708) nil]) #@91 Insert the name (sans path) of the current file into the bookmark name that is being set. (defalias 'bookmark-insert-buffer-name #[nil "ŠqˆÁ )‰c)‡" [bookmark-current-buffer bookmark-buffer-name str] 2 (#$ . 20984) nil]) #@96 Return the name of the current buffer's file, non-directory. In Info, return the current node. (defalias 'bookmark-buffer-name #[nil "Á˜ƒ\n‡ ƒÄ !‡ÅÆ!ƒJƒJ;ƒ&‚)@‰GSHÉUƒEÄÊO!‚HËp!*‡Ëp!‡" [mode-name "Info" Info-current-node buffer-file-name file-name-nondirectory boundp dired-directory dirname idx 47 0 buffer-name] 5 (#$ . 21212)]) (defalias 'bookmark-yank-word #[nil "Šqˆ bˆÂ`ŠÃvˆ`‰)\")‰c)‡" [bookmark-current-buffer bookmark-yank-point buffer-substring-no-properties 1 string] 5 nil nil]) #@133 Return the current buffer's file in a way useful for bookmarks. For example, if this is a Info buffer, return the Info file's name. (defalias 'bookmark-buffer-file-name #[nil "Á=ƒ\n‡ †ÄÅ!… … ;ƒ ‡ @‡" [major-mode Info-mode Info-current-file buffer-file-name boundp dired-directory] 2 (#$ . 21742)]) (defalias 'bookmark-maybe-load-default-file #[nil "?…4 ?…4ÂÃ\f!!ƒ#Âà !!„#ÆÃ\f!à !\"ˆÇà !!…4È É‰#ˆÉ‰‡" [bookmarks-already-loaded bookmark-alist file-exists-p expand-file-name bookmark-old-default-file bookmark-default-file rename-file file-readable-p bookmark-load t] 4]) (defalias 'bookmark-maybe-sort-alist #[nil "…\fÁ !Ä\"‰‡" [bookmark-sort-flag sort copy-alist bookmark-alist #[(x y) "@ @™‡" [x y] 2]] 3]) #@516 Jump to bookmark BOOKMARK (a point in some file). You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this. If the file pointed to by BOOKMARK no longer exists, you will be asked if you wish to give the bookmark a new location, and bookmark-jump will then jump to the new location, as well as recording it in place of the old one in the permanent bookmark record. (defalias 'bookmark-jump #[(bookmark) "t„ BÂ!‰…$Ä @!…$ Ab…$ …$Æ!)‡" [bookmark bookmark-history bookmark-jump-noselect cell switch-to-buffer bookmark-automatically-show-annotations bookmark-show-annotation] 3 (#$ . 22479) (bookmark-completing-read "Jump to bookmark" bookmark-current-bookmark)]) (defalias 'bookmark-jump-noselect #[(str) "À ˆÁ !!Å !Ç !É !\nË !\f\f Î\f!„^\fÏPÎ!…4)†Y\fÑPÎ!…F)†Y\fÒPÎ!…X)‰ƒ«Š\fƒqÓÔ!ˆÕ\f\f\"ˆ‚zÖ\f!qˆ\nbˆƒŽ×dØ#ƒŽÙG!ˆƒ¡ÚeØ#ƒ¡Guˆ p`)B‚ËÜ ˆÝÞ !ß àR!ƒÅá !ˆâ !‚Ëãä \"ˆå.‡" [bookmark-maybe-load-default-file expand-file-name bookmark-get-filename str file bookmark-get-front-context-string forward-str bookmark-get-rear-context-string behind-str bookmark-get-position place bookmark-get-info-node info-node orig-file file-exists-p ".Z" altname ".gz" ".z" require info Info-find-node find-file-noselect search-forward t backward-char search-backward bookmark-current-bookmark ding y-or-n-p file-name-nondirectory " nonexistent. Relocate \"" "\"? " bookmark-relocate bookmark-jump-noselect message "Bookmark not relocated; consider removing it (%s)." nil] 5]) #@214 Relocate BOOKMARK -- prompts for a filename, and makes an already existing bookmark point to that file, instead of the one it used to point at. Useful when a file has been renamed after a bookmark was set in it. (defalias 'bookmark-relocate #[(bookmark) "t„ B ˆÃ!ÅÆÇÈ\"É\f!\"!\nË\n\"*‡" [bookmark bookmark-history bookmark-maybe-load-default-file bookmark-get-filename bmrk-filename expand-file-name read-file-name format "Relocate %s to: " file-name-directory newloc bookmark-set-filename] 5 (#$ . 24157) (bookmark-completing-read "Bookmark to relocate")]) #@161 Insert the name of the file associated with BOOKMARK. Optional second arg NO-HISTORY means don't record this in the minibuffer history list `bookmark-history'. (defalias 'bookmark-insert-location #[(bookmark &optional no-history) "„\ft„\f \nBà !c‡" [no-history bookmark bookmark-history bookmark-location] 2 (#$ . 24734) (bookmark-completing-read "Insert bookmark location")]) #@55 Return the name of the file associated with BOOKMARK. (defalias 'bookmark-location #[(bookmark) "À ˆÁ\n!‡" [bookmark-maybe-load-default-file bookmark-get-filename bookmark] 2 (#$ . 25121)]) #@495 Change the name of OLD bookmark to NEW name. If called from keyboard, prompts for OLD and NEW. If called from menubar, OLD is selected from a menu, and prompts for NEW. If called from Lisp, prompts for NEW if only OLD was passed as an argument. If called with two strings, then no prompting is done. You must pass at least OLD when calling from Lisp. While you are entering the new name, consecutive C-w's insert consectutive words from the text of the buffer into the new bookmark name. (defalias 'bookmark-rename #[(old &optional new) "t„ B ˆ``p†,ÇÈÉÊ !\fÍ\fÎÏ#ˆ\f)ÉÁ%Ñ\"ˆÓ ˆTÕ …GÖ )‡" [old bookmark-history bookmark-maybe-load-default-file bookmark-current-point bookmark-yank-point bookmark-current-buffer new read-from-minibuffer "New name: " nil copy-keymap minibuffer-local-map now-map define-key "" bookmark-yank-word newname bookmark-set-name bookmark-current-bookmark bookmark-bmenu-surreptitiously-rebuild-list bookmark-alist-modification-count bookmark-time-to-save-p bookmark-save] 7 (#$ . 25318) (bookmark-completing-read "Old bookmark name")]) #@270 Insert the text of the file pointed to by bookmark BOOKMARK. You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this. (defalias 'bookmark-insert #[(bookmark) "t„ B ˆ`ŠÃ!@qˆed{)\fcˆÆ ˆ b*‡" [bookmark bookmark-history bookmark-maybe-load-default-file bookmark-jump-noselect str-to-insert orig-point push-mark] 3 (#$ . 26420) (bookmark-completing-read "Insert bookmark contents")]) #@404 Delete BOOKMARK from the bookmark list. Removes only the first instance of a bookmark with that name. If there are one or more other bookmarks with the same name, they will not be deleted. Defaults to the "current" bookmark (that is, the one most recently used in this file, if any). Optional second arg BATCH means don't update the bookmark list buffer, probably because we were called from there. (defalias 'bookmark-delete #[(bookmark &optional batch) "t„ B ˆÃ!Å\f\"Ã!„ È) ?…6Ê ˆ T Ì …6Í ‡" [bookmark bookmark-history bookmark-maybe-load-default-file bookmark-get-bookmark will-go delq bookmark-alist bookmark-current-bookmark nil batch bookmark-bmenu-surreptitiously-rebuild-list bookmark-alist-modification-count bookmark-time-to-save-p bookmark-save] 3 (#$ . 26965) (bookmark-completing-read "Delete bookmark" bookmark-current-bookmark)]) (defalias 'bookmark-time-to-save-p #[(&optional last-time) "ƒ\f ÂV… ‡ §ƒ Y‡Ä‡" [last-time bookmark-alist-modification-count 0 bookmark-save-flag nil] 2]) #@141 Write bookmarks to a file (for which the user will be prompted interactively). Don't use this in Lisp programs; use bookmark-save instead. (defalias 'bookmark-write #[nil "À ˆÁÂ!‡" [bookmark-maybe-load-default-file bookmark-save t] 2 (#$ . 28003) nil]) #@709 Save currently defined bookmarks. Saves by default in the file defined by the variable `bookmark-default-file'. With a prefix arg, save it in file FILE (second argument). If you are calling this from Lisp, the two arguments are PREFIX-ARG and FILE, and if you just want it to write to the default file, then pass no arguments. Or pass in nil and FILE, and it will save in FILE instead. If you pass in one argument, and it is non-nil, then the user will be interactively queried for a file to save in. When you want to load in the bookmarks from a file, use `bookmark-load', \[bookmark-load]. That function will prompt you for a file, defaulting to the file defined by variable `bookmark-default-file'. (defalias 'bookmark-save #[(&optional parg file) "À ˆ „\n„Ã\f!ˆ‚9 „!\nƒ!Ã\n!ˆ‚9 ƒ5\n„5ÅÆ!Ã\n!ˆ)‚9Ã\n!ˆÇ‰‡" [bookmark-maybe-load-default-file parg file bookmark-write-file bookmark-default-file read-file-name "File to save bookmarks in: " 0 bookmark-alist-modification-count] 2 (#$ . 28264) "P"]) (defalias 'bookmark-write-file #[(file) "ŠÀ‹)‡" [((byte-code "ÁYƒ ÂÃÄ \"!ˆÆÈ !)qˆebˆed|ˆÉ ˆÊ p\"ˆ\f„/Æ‚G\fÍ=ƒ:Í‚G\fÎ=ƒF‚GÐÑ !ˆÒp!ˆÁY…]ÂÃÓ \"!)‡" [baud-rate 9600 message format "Saving bookmarks to file %s..." file nil enable-local-variables find-file-noselect bookmark-insert-file-format-version-stamp pp bookmark-alist bookmark-version-control never nospecial version-control t write-file kill-buffer "Saving bookmarks to file %s... done."] 4))] 1]) #@627 Load bookmarks from FILE (which must be in bookmark format). Appends loaded bookmarks to the front of the list of bookmarks. If optional second argument REVERT is non-nil, existing bookmarks are destroyed. Optional third arg NO-MSG means don't display any messages while loading. If you load a file that doesn't contain a proper bookmark alist, you will corrupt Emacs's bookmark list. Generally, you should only load in files that were created with the bookmark functions in the first place. Your own personal bookmark file, `~/.emacs.bmk', is maintained automatically by Emacs; you shouldn't need to load it explicitly. (defalias 'bookmark-load #[(file &optional revert no-msg) "À ! !ƒ!ŠÃ‹ˆ\f?… ÆY…ÇÈÉ \"!)‡ÊÈË \"!‡" [expand-file-name file file-readable-p ((byte-code "„ ÂYƒÃÄÅ\"!ˆÇÉ!)qˆebˆÊ ˆË ‰\f<ƒO „8T‚;ÏÐ\f ?…F\"Ò ˆ‚WÓÄÔ\"!ˆ)Õp!‡" [no-msg baud-rate 9600 message format "Loading bookmarks from %s..." file nil enable-local-variables find-file-noselect bookmark-maybe-upgrade-file-format bookmark-alist-from-buffer blist revert bookmark-alist-modification-count 0 append bookmark-alist bookmark-bmenu-surreptitiously-rebuild-list error "Invalid bookmark list in %s." kill-buffer] 5)) no-msg baud-rate 9600 message format "Loading bookmarks from %s... done" error "Cannot read bookmark file %s."] 4 (#$ . 29760) (list (read-file-name (format "Load bookmarks from: (%s) " bookmark-default-file) "~/" bookmark-default-file (quote confirm)))]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ B „ØÆ Ç È\"ˆÉ ÊË#ˆÉ ÌÍ#ˆÉ ÎÏ#ˆÉ ÐÑ#ˆÉ ÒÓ#ˆÉ ÔÕ#ˆÉ ÖÕ#ˆÉ ×Ø#ˆÉ ÙÚ#ˆÉ ÛÜ#ˆÉ ÝÞ#ˆÉ ßà#ˆÉ áâ#ˆÉ ãÞ#ˆÉ äÞ#ˆÉ åæ#ˆÉ çæ#ˆÉ èé#ˆÉ êë#ˆÉ ìí#ˆÉ îï#ˆÉ ðñ#ˆÉ òó#ˆÉ ôõ#ˆÉ ö÷#ˆÉ øù#ˆÉ úû#ˆÉ üý#ˆþÿ@A#‡" [boundp bookmark-bmenu-bookmark-column nil current-load-list bookmark-bmenu-hidden-bookmarks bookmark-bmenu-mode-map make-keymap suppress-keymap t define-key "q" bookmark-bmenu-quit "v" bookmark-bmenu-select "w" bookmark-bmenu-locate "2" bookmark-bmenu-2-window "1" bookmark-bmenu-1-window "j" bookmark-bmenu-this-window "f" "o" bookmark-bmenu-other-window "" bookmark-bmenu-switch-other-window "s" bookmark-bmenu-save "k" bookmark-bmenu-delete "" bookmark-bmenu-delete-backwards "x" bookmark-bmenu-execute-deletions " " "d" " " next-line "n" "p" previous-line "" bookmark-bmenu-backup-unmark "?" describe-mode "u" bookmark-bmenu-unmark "m" bookmark-bmenu-mark "l" bookmark-bmenu-load "r" bookmark-bmenu-rename "t" bookmark-bmenu-toggle-filenames "a" bookmark-bmenu-show-annotation "A" bookmark-bmenu-show-all-annotations "e" bookmark-bmenu-edit-annotation put bookmark-bmenu-mode mode-class special] 4) #@77 Rebuild the Bookmark List if it exists. Don't affect the buffer ring order. (defalias 'bookmark-bmenu-surreptitiously-rebuild-list #[nil "ÀÁ!…\nŠÂ‹)‡" [get-buffer "*Bookmark List*" ((bookmark-bmenu-list))] 2 (#$ . 32402)]) #@210 Display a list of existing bookmarks. The list is displayed in a buffer named `*Bookmark List*'. The leftmost column displays a D if the bookmark is flagged for deletion, or > if it is flagged for displaying. (defalias 'bookmark-bmenu-list #[nil "À ˆtƒÁÂÃ!!ˆ‚ÂÃ!qˆÄde|ˆebˆÆcˆÇ ˆÈÉ\n\"ˆ)ebˆËyˆÌ ˆ …<ÍÎ!‡" [bookmark-maybe-load-default-file switch-to-buffer get-buffer-create "*Bookmark List*" nil buffer-read-only "% Bookmark\n- --------\n" bookmark-maybe-sort-alist mapcar #[(full-record) "ÀÁ\n!!‰Ä=„ Ř„Æcˆ‚ÇcˆÁ\n!ÈPc)‡" [bookmark-get-annotation bookmark-name-from-full-record full-record annotation nil "" " *" " " "\n"] 4] bookmark-alist 2 bookmark-bmenu-mode bookmark-bmenu-toggle-filenames t] 3 (#$ . 32633) nil]) (byte-code "ÀÁÂ\"ˆÀÃÂ\"‡" [defalias list-bookmarks bookmark-bmenu-list edit-bookmarks] 3) #@2117 Major mode for editing a list of bookmarks. Each line describes one of the bookmarks in Emacs. Letters do not insert themselves; instead, they are commands. Bookmark names preceeded by a "*" have annotations. \ \[bookmark-bmenu-mark] -- mark bookmark to be displayed. \[bookmark-bmenu-select] -- select bookmark of line point is on. Also show bookmarks marked using m in other windows. \[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names). \[bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark. \[bookmark-bmenu-1-window] -- select this bookmark in full-frame window. \[bookmark-bmenu-2-window] -- select this bookmark in one window, together with bookmark selected before this one in another window. \[bookmark-bmenu-this-window] -- select this bookmark in place of the bookmark menu buffer. \[bookmark-bmenu-other-window] -- select this bookmark in another window, so the bookmark menu bookmark remains visible in its window. \[bookmark-bmenu-switch-other-window] -- switch the other window to this bookmark. \[bookmark-bmenu-rename] -- rename this bookmark (prompts for new name). \[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down. \[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up. \[bookmark-bmenu-execute-deletions] -- delete marked bookmarks. \[bookmark-bmenu-save] -- save the current bookmark list in the default file. With a prefix arg, prompts for a file to save in. \[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.) \[bookmark-bmenu-unmark] -- remove all kinds of marks from current line. With prefix argument, also move up one line. \[bookmark-bmenu-backup-unmark] -- back up a line and remove marks. \[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark in another buffer. \[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer. \[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark. (defalias 'bookmark-bmenu-mode #[nil "À ˆÁ\n!ˆÃÃÆÈ ÊË!‡" [kill-all-local-variables use-local-map bookmark-bmenu-mode-map t truncate-lines buffer-read-only bookmark-bmenu-mode major-mode "Bookmark Menu" mode-name run-hooks bookmark-bmenu-mode-hook] 2 (#$ . 33465)]) #@114 Toggle whether filenames are shown in the bookmark list. Optional argument SHOW means show them unconditionally. (defalias 'bookmark-bmenu-toggle-filenames #[(&optional show) "ƒ Áà ˆÄ‰‡\nƒÅ ˆÁ‰‡Ã ˆÄ‰‡" [show nil bookmark-bmenu-toggle-filenames bookmark-bmenu-show-filenames t bookmark-bmenu-hide-filenames] 2 (#$ . 35858) nil]) (defalias 'bookmark-bmenu-show-filenames #[(&optional force) "?… ?…ŠÂ‹)‡" [force bookmark-bmenu-toggle-filenames ((byte-code "ebˆÀyˆÁÁ`dW…3Ä ‰\nBÆÈ\"ˆ`Áˆ`|ˆÉcˆÊ È\"ˆËyˆ)‚\n)‡" [2 nil bookmark-bmenu-hidden-bookmarks buffer-read-only bookmark-bmenu-bookmark bmrk move-to-column bookmark-bmenu-file-column t " " bookmark-insert-location 1] 4))] 1]) (defalias 'bookmark-bmenu-hide-filenames #[(&optional force) "?… … ŠÂ‹)‡" [force bookmark-bmenu-toggle-filenames ((byte-code "ebˆÀyˆ ŸŠebˆÂÃ!ˆÄÅ!ˆi)ŠÇ …7ÉÊ\"ˆË ˆ @cˆ AÅyˆ‚*‡" [2 bookmark-bmenu-hidden-bookmarks search-forward "Bookmark" backward-word 1 bookmark-bmenu-bookmark-column nil buffer-read-only move-to-column t bookmark-kill-line] 3))] 1]) (defalias 'bookmark-bmenu-check-position #[nil "Àe`\"ÁWƒebˆÁyˆÂ‡nƒmƒÃyˆÂ‡Â‡" [count-lines 2 t -1] 3]) (defalias 'bookmark-bmenu-bookmark #[nil "À ƒ\nŠÁ‹ˆ)\nƒà ˆŠÄ‹)‡" [bookmark-bmenu-check-position ((byte-code "ebˆÀÁ!ˆÂÃ!ˆiÀ‡" [search-forward "Bookmark" backward-word 1 bookmark-bmenu-bookmark-column] 2)) bookmark-bmenu-toggle-filenames bookmark-bmenu-hide-filenames ((byte-code "Àyˆ uˆ`ˆ`{ ƒÃÄ!ˆ‡" [0 bookmark-bmenu-bookmark-column nil bookmark-bmenu-toggle-filenames t] 3))] 1]) #@90 Display the annotation for bookmark named BOOKMARK in a buffer, if an annotation exists. (defalias 'bookmark-show-annotation #[(bookmark) "À !‰Ã=?…*\nĘ?…*ŠpÆÇÈ!É\"ˆed|ˆ\ncˆebˆÆ !*)‡" [bookmark-get-annotation bookmark annotation nil "" old-buf pop-to-buffer get-buffer-create "*Bookmark Annotation*" t] 4 (#$ . 37422)]) #@56 Display the annotations for all bookmarks in a buffer. (defalias 'bookmark-show-all-annotations #[nil "pÁÂÃ!Ä\"ˆed|ˆÅÆ\"ˆebˆÁ!)‡" [old-buf pop-to-buffer get-buffer-create "*Bookmark Annotation*" t mapcar #[(full-record) "À !Ã\n!\nÅPcˆ\fÆ=?…5\fǘ?…5Š\fcˆ)`dW…5ÈyˆÉcˆÆyˆÆˆ‚ *‡" [bookmark-name-from-full-record full-record name bookmark-get-annotation ann ":\n" nil "" 0 " "] 2] bookmark-alist] 3 (#$ . 37752)]) #@107 Mark bookmark on this line to be displayed by \\[bookmark-bmenu-select] command. (defalias 'bookmark-bmenu-mark #[nil "ÀyˆÁ …ÂÄÅ!ˆÆcˆÅy)‡" [0 bookmark-bmenu-check-position nil buffer-read-only delete-char 1 62] 2 (#$ . 38182) nil]) #@160 Select this line's bookmark; also display bookmarks marked with `>'. You can mark bookmarks with the \\[bookmark-bmenu-mark] command. (defalias 'bookmark-bmenu-select #[nil "À …tÁ p‰ebˆÇÈÂÉ#ƒ<Á Â\nËÌ!ˆÍcˆ) ˜„ \f„ \fB‚\fŸÎ S\fGT¥Ï ˆÐ!ˆÑ !ˆ\fƒp\f…sÒ \"ˆÓÔ!ˆÐ\f@!ˆ\fA‰‚XÓÔ!,‡" [bookmark-bmenu-check-position bookmark-bmenu-bookmark nil tem others menu bmrk re-search-forward "^>" t buffer-read-only delete-char -1 32 frame-height delete-other-windows bookmark-jump bury-buffer split-window other-window 1] 5 (#$ . 38449) nil]) #@100 Save the current list into a bookmark file. With a prefix arg, prompts for a file to save them in. (defalias 'bookmark-bmenu-save #[(parg) "ŠÀ‹)‡" [((bookmark-save parg))] 1 (#$ . 39034) "P"]) #@62 Load the bookmark file and rebuild the bookmark menu-buffer. (defalias 'bookmark-bmenu-load #[nil "À … ŠÁ‹)‡" [bookmark-bmenu-check-position ((byte-code "ÀÁ!‡" [call-interactively bookmark-load] 2))] 1 (#$ . 39233) nil]) #@52 Select this line's bookmark, alone, in full frame. (defalias 'bookmark-bmenu-1-window #[nil "À …Á !ˆÃÄ !ˆÅ ‡" [bookmark-bmenu-check-position bookmark-jump bookmark-bmenu-bookmark bury-buffer other-buffer delete-other-windows] 2 (#$ . 39461) nil]) #@69 Select this line's bookmark, with previous buffer in second window. (defalias 'bookmark-bmenu-2-window #[nil "À …0Á pÂÆ ˆÇÈ !ˆÉ !‰\n@ \nA\fÍ !ˆ\fbˆ+Î\f!+‡" [bookmark-bmenu-check-position bookmark-bmenu-bookmark t pop-up-windows menu bmrk delete-other-windows switch-to-buffer other-buffer bookmark-jump-noselect pair buff pos pop-to-buffer bury-buffer] 4 (#$ . 39717) nil]) #@45 Select this line's bookmark in this window. (defalias 'bookmark-bmenu-this-window #[nil "À … Á !‡" [bookmark-bmenu-check-position bookmark-jump bookmark-bmenu-bookmark] 2 (#$ . 40107) nil]) #@77 Select this line's bookmark in other window, leaving bookmark menu visible. (defalias 'bookmark-bmenu-other-window #[nil "À  …'à !‰@\fAÇ !ˆbˆÈÉ !\"ˆÊ !+)‡" [bookmark-bmenu-bookmark bookmark bookmark-bmenu-check-position bookmark-jump-noselect pair buff pos switch-to-buffer-other-window set-window-point get-buffer-window bookmark-show-annotation] 4 (#$ . 40305) nil]) #@89 Make the other window select this line's bookmark. The current window remains selected. (defalias 'bookmark-bmenu-switch-other-window #[nil "À  …2à !‰@\fAÇ !ˆp qˆbˆÉÊ !\"ˆqˆ)Ë !+)‡" [bookmark-bmenu-bookmark bookmark bookmark-bmenu-check-position bookmark-jump-noselect pair buff pos display-buffer o-buffer set-window-point get-buffer-window bookmark-show-annotation] 4 (#$ . 40691) nil]) #@65 Show the annotation for the current bookmark in another window. (defalias 'bookmark-bmenu-show-annotation #[nil "À  … à !)‡" [bookmark-bmenu-bookmark bookmark bookmark-bmenu-check-position bookmark-show-annotation] 2 (#$ . 41101) nil]) #@58 Show the annotation for all bookmarks in another window. (defalias 'bookmark-bmenu-show-all-annotations #[nil "À ‡" [bookmark-show-all-annotations] 1 (#$ . 41346) nil]) #@65 Edit the annotation for the current bookmark in another window. (defalias 'bookmark-bmenu-edit-annotation #[nil "À  … à !)‡" [bookmark-bmenu-bookmark bookmark bookmark-bmenu-check-position bookmark-edit-annotation] 2 (#$ . 41521) nil]) #@25 Quit the bookmark menu. (defalias 'bookmark-bmenu-quit #[nil "pÁ !ˆÃ!)‡" [buffer switch-to-buffer other-buffer bury-buffer] 2 (#$ . 41766) nil]) #@104 Cancel all requested operations on bookmark on this line and move down. Optional BACKUP means move up. (defalias 'bookmark-bmenu-unmark #[(&optional backup) "ÀyˆÁ …ÂÄÅ!ˆÆcˆ)ƒÈ‚Åy‡" [0 bookmark-bmenu-check-position nil buffer-read-only delete-char 1 " " backup -1] 2 (#$ . 41921) "P"]) #@72 Move up and cancel all requested operations on bookmark on line above. (defalias 'bookmark-bmenu-backup-unmark #[nil "ÀyˆÁ …  ˆÀy‡" [-1 bookmark-bmenu-check-position bookmark-bmenu-unmark] 1 (#$ . 42221) nil]) #@116 Mark bookmark on this line to be deleted by \\[bookmark-bmenu-execute-deletions] command. (defalias 'bookmark-bmenu-delete #[nil "ÀyˆÁ …ÂÄÅ!ˆÆcˆÅy)‡" [0 bookmark-bmenu-check-position nil buffer-read-only delete-char 1 68] 2 (#$ . 42440) nil]) #@141 Mark bookmark on this line to be deleted by \\[bookmark-bmenu-execute-deletions] command and then move up one line (defalias 'bookmark-bmenu-delete-backwards #[nil "À ˆÁyˆÂ … Ãy‡" [bookmark-bmenu-delete -2 bookmark-bmenu-check-position 1] 1 (#$ . 42718) nil]) #@85 Delete bookmarks marked with \\[Buffer-menu-delete] commands. (defalias 'bookmark-bmenu-execute-deletions #[nil "`ŠÁyˆÂÃ!?…`Ĉ`{)i‰ƒ#É ˆÄebˆÊyˆËÃdÌ#ƒ<ÍÎ Ì\"ˆ‚+Ï ˆ‰ƒJÀÌ!ˆƒ`ebˆÐ!ˆÁyˆ uˆ‚dbˆÁyˆTÒ …sÓ ,‡" [bookmark-bmenu-toggle-filenames 0 looking-at "^D" nil o-col o-str o-point hide-em bookmark-bmenu-hide-filenames 1 re-search-forward t bookmark-delete bookmark-bmenu-bookmark bookmark-bmenu-list search-forward bookmark-alist-modification-count bookmark-time-to-save-p bookmark-save] 5 (#$ . 43010) nil]) #@59 Rename bookmark on current line. Prompts for a new name. (defalias 'bookmark-bmenu-rename #[nil "À …Á `Ä !ˆÅ ˆ\nb*‡" [bookmark-bmenu-check-position bookmark-bmenu-bookmark thispoint bmrk bookmark-rename bookmark-bmenu-list] 2 (#$ . 43575) nil]) #@65 Display location of this bookmark. Displays in the minibuffer. (defalias 'bookmark-bmenu-locate #[nil "À …Á ÃÄ\n!!)‡" [bookmark-bmenu-check-position bookmark-bmenu-bookmark bmrk message bookmark-location] 3 (#$ . 43831) nil]) #@295 Build a multi-paned menu named NAME from the strings in ENTRIES. That is, ENTRIES is a list of strings which appear as the choices in the menu. The number of panes depends on the number of entries. The visible entries are truncated to `bookmark-menu-length', but the strings returned are not. (defalias 'bookmark-menu-build-paned-menu #[(name entries) "À Á¥ÃăeÃÄ \nWƒOƒO@‰\nG Vƒ7\nÄ O‚9\n\nB B AT)‚ TÌÍ # ŸBB*‚\nŸ*ÐÑQ*B‡" [frame-height 2 f-height nil 0 iter temp-pane-list entries count lst str bookmark-menu-length format "-*- %s (%d) -*-" name pane-list "-*- " " -*-"] 5 (#$ . 44068)]) #@203 Pop up multi-paned menu at EVENT, return string chosen from ENTRIES. That is, ENTRIES is a list of strings which appear as the choices in the menu. The number of panes depends on the number of entries. (defalias 'bookmark-menu-popup-paned-menu #[(event name entries) "À  \f\"\"‡" [x-popup-menu event bookmark-menu-build-paned-menu name entries] 5 (#$ . 44720) "e"]) #@145 Pop up menu of bookmarks, return chosen bookmark. Pop up at EVENT, menu's name is NAME. The number of panes depends on the number of bookmarks. (defalias 'bookmark-menu-popup-paned-bookmark-menu #[(event name) "À \nà #‡" [bookmark-menu-popup-paned-menu event name bookmark-all-names] 4 (#$ . 45094)]) (defalias 'bookmark-popup-menu-and-apply-function #[(func-sym menu-label event) "À \n\"‰…Ä C\")‡" [bookmark-menu-popup-paned-bookmark-menu event menu-label choice apply func-sym] 4]) #@422 Insert the text of the file pointed to by bookmark BOOKMARK. You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this. Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp (the one without the "-menu-" in its name). (defalias 'bookmark-menu-insert #[(event) "ÀÁ #‡" [bookmark-popup-menu-and-apply-function bookmark-insert "Insert Bookmark Contents" event] 4 (#$ . 45589) "e"]) #@411 Jump to bookmark BOOKMARK (a point in some file). You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this. Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp (the one without the "-menu-" in its name). (defalias 'bookmark-menu-jump #[(event) "ÀÁ #‡" [bookmark-popup-menu-and-apply-function bookmark-jump "Jump to Bookmark" event] 4 (#$ . 46179) "e"]) #@261 Insert the name of the file associated with BOOKMARK. (This is not the same as the contents of that file). Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp (the one without the "-menu-" in its name). (defalias 'bookmark-menu-locate #[(event) "ÀÁ #‡" [bookmark-popup-menu-and-apply-function bookmark-insert-location "Insert Bookmark Location" event] 4 (#$ . 46746) "e"]) #@694 Change the name of OLD-BOOKMARK to NEWNAME. If called from keyboard, prompts for OLD-BOOKMARK and NEWNAME. If called from menubar, OLD-BOOKMARK is selected from a menu, and prompts for NEWNAME. If called from Lisp, prompts for NEWNAME if only OLD-BOOKMARK was passed as an argument. If called with two strings, then no prompting is done. You must pass at least OLD-BOOKMARK when calling from Lisp. While you are entering the new name, consecutive C-w's insert consectutive words from the text of the buffer into the new bookmark name. Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp (the one without the "-menu-" in its name). (defalias 'bookmark-menu-rename #[(event) "ÀÁ #‡" [bookmark-popup-menu-and-apply-function bookmark-rename "Rename Bookmark" event] 4 (#$ . 47184) "e"]) #@456 Delete the bookmark named NAME from the bookmark list. Removes only the first instance of a bookmark with that name. If there are one or more other bookmarks with the same name, they will not be deleted. Defaults to the "current" bookmark (that is, the one most recently used in this file, if any). Warning: this function only takes an EVENT as argument. Use the corresponding bookmark function from Lisp (the one without the "-menu-" in its name). (defalias 'bookmark-menu-delete #[(event) "ÀÁ #‡" [bookmark-popup-menu-and-apply-function bookmark-delete "Delete Bookmark" event] 4 (#$ . 48037) "e"]) (byte-code "ÀÁ!„\nÂÃ!Á\fBÅÁ‰J\"ˆÆ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÌ#ˆÆ ÍÎ#ˆÆ ÏÐ#ˆÆ ÑÒ#ˆÆ ÓÔ#ˆÆ ÕÖ#ˆÆ ×Ø#ˆÆ ÙÚ#‡" [boundp menu-bar-bookmark-map make-sparse-keymap "Bookmark functions" current-load-list defalias define-key [load] ("Load a Bookmark File" . bookmark-load) [write] ("Write (to another file)" . bookmark-write) [save] ("Save (in default file)" . bookmark-save) [edit] ("Edit Bookmark List" . bookmark-bmenu-list) [delete] ("Delete Bookmark" . bookmark-menu-delete) [rename] ("Rename Bookmark" . bookmark-menu-rename) [locate] ("Insert Location" . bookmark-menu-locate) [insert] ("Insert Contents" . bookmark-menu-insert) [set] ("Set Bookmark" . bookmark-set) [jump] ("Jump to Bookmark" . bookmark-menu-jump)] 4) #@45 Hook to run at the end of loading bookmark. (defvar bookmark-load-hook nil (#$ . 49359)) (byte-code "ÀÁ!ˆÂÃ!‡" [run-hooks bookmark-load-hook provide bookmark] 2) emacs-19.30/lisp/browse-url.elc100666 12120 1 23543 6045235536 14702 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 15:53:43 1995 ;;; from file /home/fsf/rms/e19/lisp/browse-url.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`browse-url.el' was compiled for Emacs 19.29 or later")) #@47 A regular expression probably matching a URL. (defvar browse-url-regexp "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)[^] \n \"'()<>[^`{}]*[^] \n \"'()<>[^`{}.,;]+" (#$ . 480)) #@152 *Function to display the current buffer in a WWW browser. Used by the `browse-url-at-point', `browse-url-at-mouse', and `browse-url-of-file' commands. (defvar browse-url-browser-function (quote browse-url-netscape) (#$ . -706)) #@54 *A list of strings to pass to Netscape as arguments. (defvar browse-url-netscape-arguments nil (#$ . -940)) #@239 *If non-nil, always open a new browser window. Passing an interactive argument to \[browse-url-netscape] or \[browse-url-cci] reverses the effect of this variable. Requires Netscape version 1.1N or later or XMosaic version 2.5 or later. (defvar browse-url-new-window-p nil (#$ . -1055)) #@52 *A list of strings to pass to Mosaic as arguments. (defvar browse-url-mosaic-arguments nil (#$ . -1349)) #@220 An alist of (REGEXP . STRING) pairs. Any substring of a filename matching one of the REGEXPs is replaced by the corresponding STRING. All pairs are applied in the order given. Used by the `browse-url-of-file' command. (defvar browse-url-filename-alist (quote (("^/+" . "file:/"))) (#$ . 1461)) #@99 If non-nil, save the buffer before displaying its file. Used by the `browse-url-of-file' command. (defvar browse-url-save-file nil (#$ . 1762)) #@210 A hook to be run with run-hook after `browse-url-of-file' has asked a browser to load a file. Set this to `browse-url-netscape-reload' to force Netscape to load the file rather than displaying a cached copy. (defvar browse-url-of-file-hook nil (#$ . 1913)) #@182 The argument to `signal-process' for sending SIGUSR1 to XMosaic. Emacs 19.29 accepts 'sigusr1, earlier versions require an integer which is 30 on SunOS and 16 on HP-UX and Solaris. (defvar browse-url-usr1-signal (byte-code "ÀÁ!ƒ ÂV„ ÄYƒŇƇ" [boundp emacs-major-version 19 emacs-minor-version 29 sigusr1 30] 2) (#$ . 2178)) #@132 Port to access XMosaic via CCI. This can be any number between 1024 and 65535 but must correspond to the value set in the browser. (defvar browse-url-CCI-port 3003 (#$ . 2515)) #@129 Return the URL around or before point. Then search backwards for the start of a URL. If no URL found, return the empty string. (defalias 'browse-url-url-at-point #[nil "À !„\"ŠÂˆ`)Ä Å#ƒÆ”bˆÇ ÂÈ#)ƒ(Ɣƕ{‡É‡" [looking-at browse-url-regexp nil eol re-search-forward lim 0 re-search-backward t ""] 4 (#$ . 2699)]) #@225 Read a URL from the minibuffer, optionally prompting with PROMPT. Default to the URL at or before point. If bound to a mouse button, set point to the position clicked. Return the result as a list for use in `interactive'. (defalias 'browse-url-interactive-arg #[(&optional prompt) "À Áœ‰<ƒÃ\n!ˆ)Ä †ÆÇ \"C‡" [this-command-keys 0 event mouse-set-point read-string prompt "URL: " browse-url-url-at-point] 4 (#$ . 3024)]) #@130 Ask a WWW browser to load the URL at or before point. The URL is loaded according to the value of `browse-url-browser-function'. (defalias 'browse-url-at-point #[nil "Á !‡" [browse-url-browser-function browse-url-url-at-point] 2 (#$ . 3456) nil]) #@227 Ask a WWW browser to load a URL clicked with the mouse. The URL is the one around or before the position of the mouse click but point is not changed. The URL is loaded according to the value of `browse-url-browser-function'. (defalias 'browse-url-at-mouse #[(event) "Š‰A@) ‰@)!qˆ ‰A@:ƒ! A@@‚$ A@)bˆÄ ‰Ƙƒ4ÇÈ!ˆ !+‡" [event posn window-buffer position browse-url-url-at-point url "" error "No URL found" browse-url-browser-function] 3 (#$ . 3711) "e"]) #@325 Ask a WWW browser to display FILE. Display the current buffer's file if FILE is nil or if called interactively. Turn the filename into a URL by performing replacements given in variable `browse-url-filename-alist'. Pass the URL to a browser using variable `browse-url-browser-function' then run `browse-url-of-file-hook'. (defalias 'browse-url-of-file #[(&optional file) "†\fÁ †\fÂÃ!Ä!‰ƒ/Š qˆÆ ƒ.ƒ)È ˆ‚.ÉÊ\"ˆ)) Ì!!ˆÍÎ!‡" [file buffer-file-name error "Current buffer has no file" get-file-buffer buf buffer-modified-p browse-url-save-file save-buffer message "%s modified since last save" browse-url-browser-function browse-url-file-url run-hooks browse-url-of-file-hook] 4 (#$ . 4182) nil]) #@107 Return the URL corresponding to FILE. Uses variable `browse-url-filename-alist' to map filenames to URLs. (defalias 'browse-url-file-url #[(file) " ƒ. @‰@\nA AÅ \"ƒ*lj”O\fÇ•ÈOQ+‚)‡" [browse-url-filename-alist maps map from-re to-string string-match file 0 nil] 6 (#$ . 4897)]) (byte-code "ÀÁ!„ÂÁ BÄÁ!ˆÀÅ!„ÂÅ B‡" [boundp browse-url-temp-file-name nil current-load-list make-variable-buffer-local browse-url-temp-file-list] 2) #@83 Ask a WWW browser to display BUFFER. Display the current buffer if BUFFER is nil. (defalias 'browse-url-of-buffer #[(&optional buffer) "Š†pqˆ †ÂÃ!… ‰„8 „0ÆÇÈ ÉÊ!†'Ë\"!‰\fB\fÍed ÎÏ%ˆÐ\f†> !*‡" [buffer buffer-file-name boundp dired-directory file-name browse-url-temp-file-name make-temp-name expand-file-name buffer-name getenv "TMPDIR" "/tmp" browse-url-temp-file-list write-region nil no-message browse-url-of-file] 7 (#$ . 5357) nil]) (defalias 'browse-url-delete-temp-file #[(&optional temp-file-name) "† ‰…!Ã\n!…!Ä\n!ˆ?…!Å \"‰)‡" [temp-file-name browse-url-temp-file-name file-name file-exists-p delete-file delete browse-url-temp-file-list] 4]) (defalias 'browse-url-delete-temp-file-list #[nil "…Á@!ˆA‰„‡" [browse-url-temp-file-list browse-url-delete-temp-file nil] 3]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [add-hook kill-buffer-hook browse-url-delete-temp-file kill-emacs-hook browse-url-delete-temp-file-list] 3) #@69 In Dired, ask a WWW browser to display the file named on this line. (defalias 'browse-url-of-dired-file #[nil "ÀÁ !‡" [browse-url-of-file dired-get-filename] 2 (#$ . 6309) nil]) #@531 Ask the Netscape WWW browser to load URL. Default to the URL around or before point. The strings in variable `browse-url-netscape-arguments' are also passed to Netscape. When called interactively, if variable `browse-url-new-window-p' is non-nil, load the document in a new Netscape window, otherwise use a random existing one. A non-nil interactive prefix argument reverses the effect of browse-url-new-window-p. When called non-interactively, optional second argument NEW-WINDOW is used instead of browse-url-new-window-p. (defalias 'browse-url-netscape #[(url &optional new-window) "ÀÁÂÉ‰Ä …ÇÈÉ\n…ËÌRD#&ÍU†3ÎÏ!ˆÀÐÂÃÂÄ \nC\"%‡" [apply call-process "netscape" nil append browse-url-netscape-arguments new-window ("-noraise") "-remote" "openURL(" url ",new-window" ")" 0 message "Starting Netscape..." start-process] 14 (#$ . 6494) (byte-code "ÀÁÂ! ?\f?=?C\"‡" [append browse-url-interactive-arg "Netscape URL: " browse-url-new-window-p current-prefix-arg] 4)]) #@46 Ask Netscape to reload its current document. (defalias 'browse-url-netscape-reload #[nil "ÀÁ!‡" [browse-url-netscape-command "reload"] 2 (#$ . 7480) nil]) #@44 Send a remote control command to Netscape. (defalias 'browse-url-netscape-command #[(command) "ÀÁÂÃÂÄ ÆD\"%‡" [apply start-process "netscape" nil append browse-url-netscape-arguments "-remote" command] 9 (#$ . 7641)]) #@85 Ask the XMosaic WWW browser to load URL. Default to the URL around or before point. (defalias 'browse-url-mosaic #[(url) "ÀÁ!‰Æ !ƒŠÇ !ˆebˆÈp!ÉÂ!ˆ)\fƒRÊ\fË\"ËUƒRŠÇÌÍ\f\"!ˆÎ ˆÏѱˆÒ ˆÉÂ!ˆÓÔ!ˆÊ\f\")‚cÓÖ!ˆ×ØÙÂÙÚC\"%+‡" [expand-file-name "~/.mosaicpid" nil pidbuf pid pidfile file-readable-p find-file read kill-buffer signal-process 0 format "/tmp/Mosaic.%d" erase-buffer "goto\n" url "\n" save-buffer message "Signalling Mosaic..." browse-url-usr1-signal "Starting Mosaic..." apply start-process "xmosaic" append browse-url-mosaic-arguments] 8 (#$ . 7867) (browse-url-interactive-arg "Mosaic URL: ")]) #@654 Ask the XMosaic WWW browser to load URL. Default to the URL around or before point. This function only works for XMosaic version 2.5 or later. You must select `CCI' from XMosaic's File menu, set the CCI Port Address to the value of variable `browse-url-CCI-port', and enable `Accept requests'. When called interactively, if variable `browse-url-new-window-p' is non-nil, load the document in a new browser window, otherwise use a random existing one. A non-nil interactive prefix argument reverses the effect of browse-url-new-window-p. When called non-interactively, optional second argument NEW-WINDOW is used instead of browse-url-new-window-p. (defalias 'browse-url-cci #[(url &optional new-window) "ÀÁÂÃ\f$ˆÅÁÆÈ ƒÊ‚ËÌ°\"ˆÅÁÍ\"ˆÎÁ!‡" [open-network-stream "browse-url" " *browse-url*" "localhost" browse-url-CCI-port process-send-string "get url (" url ") output " new-window "new" "current" " \n" "disconnect \n" delete-process] 7 (#$ . 8491) (byte-code "ÀÁÂ! ?\f?=?C\"‡" [append browse-url-interactive-arg "Mosaic URL: " browse-url-new-window-p current-prefix-arg] 4)]) #@87 Ask the IXIMosaic WWW browser to load URL. Default to the URL around or before point. (defalias 'browse-url-iximosaic #[(url) "ÀÁÂÁÃ\f%‡" [start-process "tellw3b" nil "-service WWW_BROWSER ixi_showurl " url] 6 (#$ . 9585) (browse-url-interactive-arg "IXI Mosaic URL: ")]) #@80 Ask the w3 WWW browser to load URL. Default to the URL around or before point. (defalias 'browse-url-w3 #[(url) "À !‡" [w3-fetch url] 2 (#$ . 9863) (browse-url-interactive-arg "W3 URL: ")]) (provide (quote browse-url)) emacs-19.30/lisp/buff-menu.elc100666 74777 1 30015 6033656277 14505 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Oct 1 23:29:31 1995 ;;; from file /home/fsf/rms/e19/lisp/buff-menu.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`buff-menu.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!„ÂÁ B‡" [boundp Buffer-menu-buffer-column nil current-load-list] 2) #@2  (defvar Buffer-menu-mode-map nil (#$ . 563)) (byte-code "„¨Á ÂÃ\"ˆÄÅÆ#ˆÄÇÈ#ˆÄÉÊ#ˆÄËÌ#ˆÄÍÎ#ˆÄÏÎ#ˆÄÐÑ#ˆÄÒÓ#ˆÄÔÕ#ˆÄÖ×#ˆÄØ×#ˆÄÙÚ#ˆÄÛ×#ˆÄÜÝ#ˆÄÞß#ˆÄàß#ˆÄáâ#ˆÄãä#ˆÄåæ#ˆÄçè#ˆÄéê#ˆÄëì#ˆÄíî#ˆÄïð#ˆÄñò#ˆÄóô#ˆõö÷ø#‡" [Buffer-menu-mode-map make-keymap suppress-keymap t define-key "q" Buffer-menu-quit "v" Buffer-menu-select "2" Buffer-menu-2-window "1" Buffer-menu-1-window "f" Buffer-menu-this-window " " "o" Buffer-menu-other-window "" Buffer-menu-switch-other-window "s" Buffer-menu-save "d" Buffer-menu-delete "k" "" Buffer-menu-delete-backwards " " "x" Buffer-menu-execute " " next-line "n" "p" previous-line "" Buffer-menu-backup-unmark "~" Buffer-menu-not-modified "?" describe-mode "u" Buffer-menu-unmark "m" Buffer-menu-mark "t" Buffer-menu-visit-tags-table "%" Buffer-menu-toggle-read-only "g" revert-buffer [mouse-2] Buffer-menu-mouse-select put Buffer-menu-mode mode-class special] 4) #@1606 Major mode for editing a list of buffers. Each line describes one of the buffers in Emacs. Letters do not insert themselves; instead, they are commands. \ \[Buffer-menu-mouse-select] -- select buffer you click on, in place of the buffer menu. \[Buffer-menu-this-window] -- select current line's buffer in place of the buffer menu. \[Buffer-menu-other-window] -- select that buffer in another window, so the buffer menu buffer remains visible in its window. \[Buffer-menu-switch-other-window] -- make another window display that buffer. \[Buffer-menu-mark] -- mark current line's buffer to be displayed. \[Buffer-menu-select] -- select current line's buffer. Also show buffers marked with m, in other windows. \[Buffer-menu-1-window] -- select that buffer in full-frame window. \[Buffer-menu-2-window] -- select that buffer in one window, together with buffer selected before this one in another window. \[Buffer-menu-visit-tags-table] -- visit-tags-table this buffer. \[Buffer-menu-not-modified] -- clear modified-flag on that buffer. \[Buffer-menu-save] -- mark that buffer to be saved, and move down. \[Buffer-menu-delete] -- mark that buffer to be deleted, and move down. \[Buffer-menu-delete-backwards] -- mark that buffer to be deleted, and move up. \[Buffer-menu-execute] -- delete or save marked buffers. \[Buffer-menu-unmark] -- remove all kinds of marks from current line. With prefix argument, also move up one line. \[Buffer-menu-backup-unmark] -- back up a line and remove marks. \[Buffer-menu-toggle-read-only] -- toggle read-only status of buffer on this line. (defalias 'Buffer-menu-mode #[nil "À ˆÁ\n!ˆÃÅÇÈ!ˆÉÊ Ê\fÍÎ!‡" [kill-all-local-variables use-local-map Buffer-menu-mode-map Buffer-menu-mode major-mode "Buffer Menu" mode-name make-local-variable revert-buffer-function Buffer-menu-revert-function t truncate-lines buffer-read-only run-hooks buffer-menu-mode-hook] 2 (#$ . 1489)]) (defalias 'Buffer-menu-revert-function #[(ignore1 ignore2) "À ‡" [list-buffers] 1]) #@54 Return buffer described by this line of buffer menu. (defalias 'Buffer-menu-buffer #[(error-if-non-existent-p) "ŠÀyˆ` \\)m?…Ã\nÄ\"‰ƒ)Æ !†1…1ÈÉ \"‚1…1ÈÊ!*‡" [0 Buffer-menu-buffer-column where get-text-property buffer-name name get-buffer error-if-non-existent-p error "No buffer named `%s'" "No buffer on this line"] 4 (#$ . 3519)]) #@233 Make a menu of buffers so you can save, delete or select them. With argument, show only buffers that are visiting files. Type ? after invocation to get help on commands available. Type q immediately to make the buffer menu go away. (defalias 'buffer-menu #[(&optional arg) "ÀÁ\n!!ˆÃÄ!‡" [switch-to-buffer list-buffers-noselect arg message "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."] 3 (#$ . 3871) "P"]) #@288 Display a list of buffers in another window. With the buffer list buffer, you can save, delete or select the buffers. With argument, show only buffers that are visiting files. Type ? after invocation to get help on commands available. Type q immediately to make the buffer menu go away. (defalias 'buffer-menu-other-window #[(&optional arg) "ÀÁ\n!!ˆÃÄ!‡" [switch-to-buffer-other-window list-buffers-noselect arg message "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."] 3 (#$ . 4310) "P"]) #@23 Quit the buffer menu. (defalias 'Buffer-menu-quit #[nil "pÁ !ˆÃ!)‡" [buffer switch-to-buffer other-buffer bury-buffer] 2 (#$ . 4829) nil]) #@103 Mark buffer on this line for being displayed by \\[Buffer-menu-select] command. (defalias 'Buffer-menu-mark #[nil "ÀyˆÁÂ!ƒ\fà ‡ÄÆÇ!ˆÈcˆÇy)‡" [0 looking-at " [-M]" ding nil buffer-read-only delete-char 1 62] 2 (#$ . 4978) nil]) #@99 Cancel all requested operations on buffer on this line and move down. Optional ARG means move up. (defalias 'Buffer-menu-unmark #[(&optional backup) "ÀyˆÁÂ!ƒà ˆ‚JÄÅ!Ç!Šqˆ )\nË ÌÍ!ˆ\nƒ=ƒ9΂GÏ‚GƒFЂGÑcˆ,ƒSÓ‚TÔy‡" [0 looking-at " [-M]" ding Buffer-menu-buffer t buf buffer-modified-p mod buffer-read-only readonly nil delete-char 3 " *%" " %" " * " " " backup -1 1] 2 (#$ . 5235) "P"]) #@70 Move up and cancel all requested operations on buffer on line above. (defalias 'Buffer-menu-backup-unmark #[nil "ÀyˆÁ ˆÀy‡" [-1 Buffer-menu-unmark] 1 (#$ . 5656) nil]) #@177 Mark buffer on this line to be deleted by \\[Buffer-menu-execute] command. Prefix arg is how many buffers to delete. Negative arg means delete backwards. (defalias 'Buffer-menu-delete #[(&optional arg) "ÀyˆÁÂ!ƒ\fà ‡ÄƒÀUƒÇÀVƒ7ÈÇ!ˆÉcˆÇyˆS‰‚ÀW…QÈÇ!ˆÉcˆÊyˆT‰‚9)‡" [0 looking-at " [-M]" ding nil buffer-read-only arg 1 delete-char 68 -1] 3 (#$ . 5831) "p"]) #@164 Mark buffer on this line to be deleted by \\[Buffer-menu-execute] command and then move up one line. Prefix arg means move that many lines. (defalias 'Buffer-menu-delete-backwards #[(&optional arg) "À †Â[!ˆÃÄ!…Âyˆ‚ ‡" [Buffer-menu-delete arg 1 looking-at " [-M]"] 2 (#$ . 6242) "p"]) #@96 Mark buffer on this line to be saved by \\[Buffer-menu-execute] command. (defalias 'Buffer-menu-save #[nil "ÀyˆÁÂ!ƒ\fà ‡ÄÆuˆÇÆ!ˆÈcˆÆy)‡" [0 looking-at " [-M]" ding nil buffer-read-only 1 delete-char 83] 2 (#$ . 6560) nil]) #@62 Mark buffer on this line as unmodified (no changes to save). (defalias 'Buffer-menu-not-modified #[(&optional arg) "ŠÀÁ!qˆÂ !ˆ)ŠÄyˆÅuˆ`f ƒÆ‚ÇU…3È ÊÅ!ˆ ƒ0Ç‚1Æc))‡" [Buffer-menu-buffer t set-buffer-modified-p arg 0 1 32 42 nil buffer-read-only delete-char] 2 (#$ . 6813) "P"]) #@141 Save and/or delete buffers marked with \\[Buffer-menu-save] or \\[Buffer-menu-delete] commands. (defalias 'Buffer-menu-execute #[nil "ŠebˆÀyˆÁÂÃÄ#ƒ4ÊÆÄ!qˆÇ ˆÈ )à ÊË!ˆ ƒ-Ì‚.Ícˆ*‚)ŠebˆÀyˆpà ÏÐÃÄ#……ËuˆÆÃ!‰Ã=„g=„gŠÒ!ˆ))ÆÃ!ƒxÊÀ!ˆÍcˆ‚B`Àyˆ`|ˆËuˆ‚B+‡" [1 re-search-forward "^.S" nil t modp Buffer-menu-buffer save-buffer buffer-modified-p buffer-read-only delete-char -1 42 32 buff-menu-buffer search-forward "\nD" buf kill-buffer] 5 (#$ . 7103) nil]) #@241 Select this line's buffer; also display buffers marked with `>'. You can mark buffers with the \\[Buffer-menu-mark] command. This command deletes and replaces all the previously existing windows in the selected frame. (defalias 'Buffer-menu-select #[nil "ÀÁ!p‰ebˆÇÈÂÁ#ƒ9ÀÁ! ÊË!ˆÌcˆ) =„ \f>„ \fB‚\fŸÍ S\fGT¥Î ˆÏ!ˆ =„WÐ !ˆ\fGÑšƒeÏ!‚\fƒ~Ò \"ˆÓÔ!ˆÏ\f@!ˆ\fA‰„iÓÔ!,‡" [Buffer-menu-buffer t nil tem others menu buff search-forward "\n>" buffer-read-only delete-char -1 32 frame-height delete-other-windows switch-to-buffer bury-buffer 0 split-window other-window 1] 5 (#$ . 7625) nil]) #@75 Visit the tags table in the buffer on this line. See `visit-tags-table'. (defalias 'Buffer-menu-visit-tags-table #[nil "ÀÁÂ!!‰ƒÄ !‚ÅÆ!)‡" [buffer-file-name Buffer-menu-buffer t file visit-tags-table error "Specified buffer has no file"] 4 (#$ . 8267) nil]) #@50 Select this line's buffer, alone, in full frame. (defalias 'Buffer-menu-1-window #[nil "ÀÁÂ!!ˆÃÄ !ˆÅ ‡" [switch-to-buffer Buffer-menu-buffer t bury-buffer other-buffer delete-other-windows] 3 (#$ . 8536) nil]) #@44 Select the buffer whose line you click on. (defalias 'Buffer-menu-mouse-select #[(event) "ÀŠÂ Ä 8:ƒÄ‚Å 8)‰@)!qˆŠ Ä 8:ƒ+Ä‚,Å 8)‰A@:ƒ@A@@‚DA@)bˆÇÈ!*É Ä 8:ƒZÄ‚[Å 8)‰@)!ˆÊË !ƒzË Ì =ƒzÍ !‚}Î !)‡" [nil buffer window-buffer event 2 1 position Buffer-menu-buffer t select-window window-dedicated-p selected-window frame-root-window switch-to-buffer-other-frame switch-to-buffer] 4 (#$ . 8752) "e"]) #@43 Select this line's buffer in this window. (defalias 'Buffer-menu-this-window #[nil "ÀÁÂ!!‡" [switch-to-buffer Buffer-menu-buffer t] 3 (#$ . 9177) nil]) #@73 Select this line's buffer in other window, leaving buffer menu visible. (defalias 'Buffer-menu-other-window #[nil "ÀÁÂ!!‡" [switch-to-buffer-other-window Buffer-menu-buffer t] 3 (#$ . 9335) nil]) #@87 Make the other window select this line's buffer. The current window remains selected. (defalias 'Buffer-menu-switch-other-window #[nil "ÀÁÂ!!‡" [display-buffer Buffer-menu-buffer t] 3 (#$ . 9537) nil]) #@67 Select this line's buffer, with previous buffer in second window. (defalias 'Buffer-menu-2-window #[nil "ÀÁ!pÁÅ ˆÆÇ !ˆÈ\f!ˆÉ !+‡" [Buffer-menu-buffer t pop-up-windows menu buff delete-other-windows switch-to-buffer other-buffer pop-to-buffer bury-buffer] 3 (#$ . 9745) nil]) #@78 Toggle read-only status of buffer on this line, perhaps via version control. (defalias 'Buffer-menu-toggle-read-only #[nil "ÀŠÂÃ!qˆÄ ˆ ƒÆ‚Ç)ŠÈyˆÉuˆg U?…-ÀÊË!ˆ c)*‡" [nil char Buffer-menu-buffer t vc-toggle-read-only buffer-read-only 37 32 0 2 delete-char 1] 2 (#$ . 10029) nil]) (define-key ctl-x-map "" (quote list-buffers)) #@348 Display a list of names of existing buffers. The list is displayed in a buffer named `*Buffer List*'. Note that buffers with names starting with spaces are omitted. Non-null optional arg FILES-ONLY means mention only file buffers. The M column contains a * for buffers that are modified. The R column contains a % for buffers that are read-only. (defalias 'list-buffers #[(&optional files-only) "ÀÁ\n!!‡" [display-buffer list-buffers-noselect files-only] 3 (#$ . 10371) "P"]) #@352 Create and return a buffer with a list of names of existing buffers. The buffer is named `*Buffer List*'. Note that buffers with names starting with spaces are omitted. Non-null optional arg FILES-ONLY means mention only file buffers. The M column contains a * for buffers that are modified. The R column contains a % for buffers that are read-only. (defalias 'list-buffers-noselect #[(&optional files-only) "pÁŠÄÅ!qˆÁÇ ˆpÈÉ!ˆÊ Ì ‰ ƒW @Ï!Ñ!ÁÁÁÁÁŠqˆØ =ƒ[Ù‚]„sÛÜ!ƒsƒs)ÝÞOߘ„L ƒˆƒL` =ƒ›`Èá!ˆ‚ŸÈß!ˆÈâ!ƒ«ã‚¬ß!ˆÈ=„»ƒ¿ä‚Àå!ˆÈ!ˆ \\`&çèé\"ˆê&Ï$ˆê&ëì$ˆ)Á‰ièZ-./ðñ\"/.-ÝVƒ /ÝHòUƒ /ÞÁO/-S‰-‚È/!ˆçóÞ\"ˆÈ.!ˆ+çôÞ\"ˆ„>ƒHÈ!ˆÈõ!ˆ. A‰ „#)ö ˆ\nƒb\nbˆp,‡" [standard-output nil desired-point old-buffer get-buffer-create "*Buffer List*" buffer-read-only erase-buffer princ " MR Buffer Size Mode File\n -- ------ ---- ---- ----\n" 4 Buffer-menu-buffer-column buffer-list bl buffer buffer-name name buffer-file-name file this-buffer-line-start this-buffer-read-only this-buffer-size this-buffer-mode-name this-buffer-directory buffer-size "Buffer Menu" mode-name boundp list-buffers-directory 0 1 " " files-only "." buffer-modified-p "*" "% " " " name-end indent-to 17 2 put-text-property mouse-face highlight excess mode size format "%8d" 32 27 40 "\n" Buffer-menu-mode] 6 (#$ . 10855)]) emacs-19.30/lisp/byte-opt.elc100666 13437 1 57756 6030361026 14501 0ustar jimbdaemon;ELC ;;; compiled by erik@naggum.no on Thu Sep 21 18:05:08 1995 ;;; from file /home/gp/erik/emacs/lisp/byte-opt.el ;;; emacs version 19.29.12. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`byte-opt.el' was compiled for Emacs 19.29 or later")) (defalias 'byte-compile-log-lap-1 #[(format &rest args) "ÁHƒ\nÂÃ!ˆÄÅÆlj ÊË\f\"*#!‡" [byte-code-vector 0 error "The old version of the disassembler is loaded. Reload new-bytecomp as well." byte-compile-log-1 apply format nil a c mapcar #[(arg) ":„9ƒÁÂÃ!\"ƒÄÃ!ÅÆO!‡‡@‰¨ƒ-ÈÉ\"ˆÊ=ƒ:‚r >ƒIAA@‚Y\f>ƒWA@‚YA Ã!ÁÎ\"ƒrÄÅÆO!Ï=ƒ|ÐAÑ=ƒÒ>„‡ÓÔ #‡" [arg string-match "^byte-" symbol-name intern 5 nil c error "non-symbolic byte-op %s" TAG byte-goto-ops byte-constref-ops a "^byte-." constant const 0 (unbind call const) format "(%s %s)"] 4] args] 7]) (defalias 'byte-compile-log-lap '(macro . #[(format-string &rest args) "ÀÁ \fBBE‡" [and (memq byte-optimize-log (quote (t byte))) byte-compile-log-lap-1 format-string args] 5])) (put (quote inline) (quote byte-optimizer) (quote byte-optimize-inline-handler)) #@54 byte-optimize-handler for the `inline' special-form. (defalias 'byte-optimize-inline-handler #[(form) "ÀÁ A\"B‡" [progn mapcar #[(sexp) "¢‰9ƒ7 \nžA„1à !ƒ7 \fžA„7 K‰:ƒ+ @Å=„7Æ !„7Ç!‚8)‡" [sexp fn byte-compile-function-environment fboundp byte-compile-macro-environment macro subrp byte-compile-inline-expand] 3] form] 4 (#$ . 1338)]) (defalias 'byte-inline-lapcode #[(lap) "Ÿ ¤‰‡" [lap byte-compile-output] 2]) (defalias 'byte-compile-inline-expand #[(form) "@‰\nžA†à !… K‰„ ÅÆ \"ˆ‚„\f:ƒ2\f@Ç=ƒ2È\fA@!ˆ\f:ƒF\f@Ç=ƒFÉÊ\fA@ #ˆ\f9ƒTË\fAB!‚„Ì\f!ƒtÍ\f!ˆÎ\fÏHÐ\fÑH\fÒH\fÓHFEAB‚„\f@Î=„€ÉÔ \"ˆ\fAB*‡" [form name byte-compile-function-environment fboundp fn byte-compile-warn "attempt to inline %s before it was defined" autoload load error "file \"%s\" didn't define \"%s\"" byte-compile-inline-expand byte-code-function-p fetch-bytecode lambda 0 byte-code 1 2 3 "%s is not a lambda"] 8]) (defalias 'byte-compile-unfold-lambda #[(form &optional name) "„Á\n@\nAÅ\f!ƒ#Ä\fÆHÇ\fÈH\fÉH\fÊHFE\fA@\fAAˉ‰\f @;ƒHAƒHA@:ƒ]@@Ñ=ƒ]Aƒñ@Ò=ƒ… ƒtÓÔ\"ˆA„ÓÕ\"ˆÖ‚è@×=ƒªA„˜ÓØ\"ˆAAƒ¤ÓÙ\"ˆÖ ‚è ƒÄ@ …¹Ú BD\fB\fË‚è„Ú „ÚÛÜ\"ˆËÝ‚è@ @D\fB\f AA‰„b ƒ Ý=„ÛÞ\"ˆ\n‚@\fƒß\fŸBB‚àB!\"ƒ=#ä>ƒ=Öå‰&'(éêëì\n!ì!!#!ˆ+!).‡" [name "anonymous lambda" form values lambda byte-code-function-p 0 byte-code 1 2 3 nil bindings restp optionalp body arglist interactive &optional error "&optional found after &rest in %s" "nothing after &optional in %s" t &rest "nothing after &rest in %s" "multiple vars after &rest in %s" list byte-compile-warn "attempt to open-code %s with too few arguments" too-few "attempt to open-code %s with too many arguments" let progn newform byte-optimize byte-optimize-log (t source) 4 print-length print-level print-escape-newlines byte-compile-log-1 format " %s ==> %s" prin1-to-string] 8]) (defalias 'byte-optimize-form-code-walker #[(form for-effect) "¢Á:„#\f… †9?†Æ=?…e‚e Ç=ƒEAAƒ6ÈÉÊ!\"ˆA@…e\f?…e‚eË !„R ¢Ì=ƒXÍ!‚e Î>ƒp ÏÐA@\"ÑAA\f\"BB‚e Ò=ƒ€ ÏÓA\"B‚e Ô=ƒ«AAƒ¢ÑA\f\"‰AƒÔ\nB‚e\n@‚eÕA@\f\"‚e Ö=ƒÒAAƒÉÖÕA@\f\"ÑAAÆ\"BB‚eÕA@\f\"‚e ×=ƒò×ÕA@Æ\"ÕØ8\f\"ÑAAAÆ\"BBB‚e Ù>ƒ ÑA\f\"B‚e Ú=ƒ ÕA@Á\"ÑAA\f\"BB‚e Û=ƒ9 ÕA@Á\"ÕØ8\f\"ÑÜ›\f\"BBB‚e Ý>ƒ£\fƒ™ÞA!‰ƒbÕ@\f\" „bA‰„MAƒ‹„‹ ƒ‹!â>ƒ‹Æã‰$%&çèéÊ!\"!ˆ+…• ŸB)‚e ÏÕA\"B‚e ê=ƒ´ÈëÊ!\"ˆÁ‚e ì>ƒ¾‚e í=ƒÓ ÕA@\f\"AABB‚e î=ƒè ÕA@Á\"AABB‚eï0\"‰=„ûÕ\f\"‚e 9„ñ ¢=„ÈòÊ !\"ˆ‚e\fƒ^ óN‰ƒ^ „2\nô=„2ÈõÊ!\"ˆ‚^ ƒQ!â>ƒQÆã‰$%&çèöÊ !\"!ˆ+ÕÔ÷Aø\"BÆ\"‚e ÏÕA\"B*‡" [form nil tmp fn for-effect byte-compile-delete-errors t quote byte-compile-warn "malformed quote form: %s" prin1-to-string byte-code-function-p lambda byte-compile-unfold-lambda (let let*) mapcar #[(binding) "9ƒ‡AAƒÁÂÃ!\"ˆ@ÄA@Å\"D‡" [binding byte-compile-warn "malformed let binding: %s" prin1-to-string byte-optimize-form nil] 4] byte-optimize-body cond #[(clause) ":ƒÁ@Â\"ÃA\f\"B‡ÅÆÇ!\"ˆ‡" [clause byte-optimize-form nil byte-optimize-body for-effect byte-compile-warn "malformed cond form: %s" prin1-to-string] 4] progn byte-optimize-form prog1 prog2 2 (save-excursion save-restriction) with-output-to-temp-buffer if 3 (and or) reverse backwards byte-optimize byte-optimize-log (t source) 4 print-length print-level print-escape-newlines byte-compile-log-1 format " all subforms of %s called for effect; deleted" interactive "misplaced interactive spec: %s" (defun defmacro function condition-case save-window-excursion) unwind-protect catch macroexpand byte-compile-macro-environment mocklisp "%s is a malformed function" side-effect-free error-free "%s called for effect" " %s called for effect; deleted" append (nil)] 7]) #@41 The source-level pass of the optimizer. (defalias 'byte-optimize-form #[(form &optional for-effect) "À \n\"É :ƒ_ @9ƒ_\nƒ! @ÆN‰„* @ÇN‰ƒ_ !‰=„_ƒV Ê>ƒVË̉ ÐÑÒÓ !Ó\f!#!ˆ+Ô\f\n\"‰‚` *‡" [byte-optimize-form-code-walker form for-effect nil new opt byte-for-effect-optimizer byte-optimizer byte-optimize byte-optimize-log (t source) t 4 print-length print-level print-escape-newlines byte-compile-log-1 format " %s ==> %s" prin1-to-string byte-optimize-form] 7 (#$ . 5146)]) (defalias 'byte-optimize-body #[(forms all-for-effect) "Á‰‰‰ƒ2† A @…Ç @ \"‰„' „+\n\fB A‰„\f\fŸ,‡" [forms nil new fe result rest all-for-effect byte-optimize-form] 5]) (defalias 'byte-compile-trueconstp '(macro . #[(form) "ÀÁ\nDÃÄ\nDÅBBDÆÇ\nDDCÃ\nÈBBCF‡" [cond consp form eq car ((quote quote)) not symbolp (t)] 6])) (defalias 'byte-optimize-associative-math #[(form) "À‰ A\nƒ%\n@§ƒ\n@ B‚\n@\fB\nA‰„ AƒP\fƒH @Å @ \"\fAƒB @\fŸB‚D\f@E‚QÅ @ \"‚Q +‡" [nil form rest constants args apply] 5]) (defalias 'byte-optimize-nonassociative-math #[(form) "A@§ƒAA@§„‡A@AA @§ƒ-@\n @\" A‰‚ ƒ:@\n BB‚;\n*‡" [form rest constant] 4]) (defalias 'byte-optimize-approx-equal #[(x y) "À \nZ!Ã_À \n\\!W‡" [abs x y 100] 4]) (defalias 'byte-optimize-delay-constants-math #[(form start fun) "S › \nÃ>A‰Aƒx@¨ƒ\fÇÉ !S ›A‰ƒJ@¨ƒ*@BÇ ˆ‚*\fƒgÊË\nÌÍ\"\"ÍË\n\"!\"„g ‚tÎÇ \"Ë\nŸ\"C¤)‚\f +‡" [start form fun (+ *) overflow orig rest nil constants copy-sequence byte-optimize-approx-equal apply mapcar float delq] 6]) (defalias 'byte-optimize-plus #[(form) "À ÂÃ#Ä >ƒÅÄÆ !\" A„ÇÈɇ ‡" [byte-optimize-delay-constants-math form 1 + 0 delq copy-sequence nil (eval form) ((error form))] 4]) (defalias 'byte-optimize-minus #[(form) "À ÂÃ#ÄÅ ›!@‰Ç=ƒ&È !‰AAÉÇÅ ›\"¡ˆ‚I A@§ƒI§ƒIÊ A@Z 8EÉÈÅ ›!\"¤)Ë AAA„c A@Ç=ƒc @ AAB‚d !‡" [byte-optimize-delay-constants-math form 2 + reverse 3 last 0 copy-sequence delq - byte-optimize-predicate] 7]) (defalias 'byte-optimize-multiply #[(form) "À ÂÃ#‰A„ Â‡Ä !@‰Æ=ƒÇ AB‚m Â=ƒ.ÈÂÉ !\"‚m Ê=ƒ?ËÈÊÉ !\"D‚m Ì=ƒlÍÎÏ A\">ƒlÈÌÉ !\"‰ A‰@9ƒW Ð @ @E ˆ‚m )‡" [byte-optimize-delay-constants-math form 1 * reverse last 0 progn delq copy-sequence -1 - 2 t mapcar symbolp +] 6]) (defalias 'byte-compile-butlast #[(form) "À !AŸ‡" [reverse form] 2]) (put (quote byte-compile-butlast) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'byte-optimize-divide #[(form) "À ÂÃ#Ä AA!@‰§ƒg GÆUƒ8 A@§ƒg ÇU„gÈÉʃgË A@ ¥D‚g ÌUƒJ Ä !AŸ)‚g A@§ƒg @ A@ ¥ AAÄ !AŸ)BBÈ A@Ç=ƒyÍÎ AAÏ#‚™ Ð=ƒ˜ÑÆ ›ƒ‘ Ä !AŸ)‚” A@D‚™ )‡" [byte-optimize-delay-constants-math form 2 * reverse last 3 0 nil (byte-code "A@ ¥‡" [form last] 2) ((error)) progn 1 append (progn) (0) -1 -] 5]) (defalias 'byte-optimize-logmumble #[(form) "À  @#ÃÄ >ƒ' @Å=ƒÆ AB‚\"ÇÄÈ !\"‰‚< ¢É=ƒ;Ê >ƒ;Æ AB‚< !‡" [byte-optimize-delay-constants-math form 1 byte-optimize-predicate 0 logand progn delq copy-sequence logior -1] 5]) (defalias 'byte-optimize-binary-predicate #[(form) "A@:ƒA@@Á=‚A@9ƒA@Â>ƒMÃ8:ƒ/Ã8@Á=‚;Ã89ƒ>Ã8Â>ƒCÄÅƇ@Ã8A@E‡‡" [form quote (nil t) 2 nil (byte-code "ÀÁ\n!D‡" [quote eval form] 3) ((error form))] 3]) (defalias 'byte-optimize-predicate #[(form) "À A\nƒ. ƒ.\n@:ƒ\n@@Ä=‚&\n@9?†&\n@Å>\nA‰„ ƒ9ÆÇÈ‚: *‡" [t form rest ok quote (nil t) nil (byte-code "ÀÁ\n!D‡" [quote eval form] 3) ((error form))] 4]) (defalias 'byte-optimize-identity #[(form) "AƒAA„A@‡ÁÂAGAGÃUƒ Ä‚!Å#ˆ‡" [form byte-compile-warn "identity called with %d arg%s, but requires 1" 1 "" "s"] 5]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#ˆÀÈÂÉ#ˆÀÊÂË#ˆÀÌÂÍ#ˆÀÎÂÍ#ˆÀÏÂÐ#ˆÀÑÂÐ#ˆÀÒÂÐ#ˆÀÓÂÐ#ˆÀÔÂÐ#ˆÀÕÂÐ#ˆÀÖÂ×#ˆÀØÂ×#ˆÀÙÂ×#ˆÀÚÂ×#ˆÀÛÂ×#ˆÀÜÂ×#ˆÀÝÂ×#ˆÀÞÂ×#ˆÀßÂ×#ˆÀàÂ×#ˆÀáÂ×#ˆÀâÂ×#ˆÀãÂ×#ˆÀäÂ×#ˆÀåÂ×#ˆÀæÂç#ˆÀèÂç#ˆÀéÂç#ˆÀêÂ×#ˆÀëÂ×#ˆÀìÂ×#ˆÀíÂ×#ˆÀîÂ×#ˆÀïÂð#‡" [put identity byte-optimizer byte-optimize-identity + byte-optimize-plus * byte-optimize-multiply - byte-optimize-minus / byte-optimize-divide max byte-optimize-associative-math min = byte-optimize-binary-predicate eq eql equal string= string-equal < byte-optimize-predicate > <= >= 1+ 1- not null memq consp listp symbolp stringp string< string-lessp logand byte-optimize-logmumble logior logxor lognot car cdr car-safe cdr-safe quote byte-optimize-quote] 4) (defalias 'byte-optimize-quote #[(form) "A@:„A@9ƒA@Á>„‡A@‡" [form (nil t)] 2]) (defalias 'byte-optimize-zerop #[(form) "A@§ƒ Á!‡\nƒÃA@ÄE‡‡" [form eval byte-compile-delete-errors = 0] 3]) (put (quote zerop) (quote byte-optimizer) (quote byte-optimize-zerop)) (defalias 'byte-optimize-and #[(form) "A?†5Á>ƒ(ÂÃÄ!‰‰A@ƒ A‰‚Á¡ˆ!ÁE‡AA„2A@‡Å!‡" [form nil progn byte-optimize-and copy-sequence byte-optimize-predicate] 6]) (defalias 'byte-optimize-or #[(form) "À >ƒ ÂÀà !\" \fA‰AƒA\f@:ƒ%\f@@Å=‚/\f@9ƒ2\f@Æ=ƒà !\f@ >À¡‰‚ AAƒMÇ !‚P A@)‡" [nil form delq copy-sequence rest quote t byte-optimize-predicate] 5]) (defalias 'byte-optimize-cond #[(form) "ÀÀ\nAž‰ƒà Ä\n!\"‚À\nA>ƒ#ÃÀÄ\n!\"\n A‰ƒ‹ @¢:ƒ< @¢@Å=‚H @¢9ƒK @¢Æ=ƒ% \nA=ƒu @Aƒn @AAƒgÇ @AB‚q @A@‚q @@‚… Aƒ…Ä\n! @\n>À¡ˆÀ‰‚&)\n¢È=ƒ¸\nA‰ @:ƒµ @A„µÊ @@Ë\n@\nAAB!E‚¶\n)‡\n‡" [nil rest form delq copy-sequence quote t progn cond clauses or byte-optimize-cond] 6]) (defalias 'byte-optimize-if #[(form) "A@‰:ƒ @Â=‚ 9ƒ Ã=ƒ!Ä8‚– „9Å›ƒ3ÆÇ›B‚–Ç8‚–Ä8ƒTǛȚƒPÉ Ä8E‚–‚–Ç8„`Å›ƒ’É :ƒz @Ê>ƒz GÄUƒz A@‚}Ë DÅ›ƒ‹ÆÇ›B‚ŽÇ8E‚–Æ ÌE)‡" [form clause quote t 2 4 progn 3 (nil) if (not null) not nil] 6]) (defalias 'byte-optimize-while #[(form) "A@…‡" [form] 1]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#ˆÀÈÂÉ#ˆÀÊÂË#ˆÀÌÂÍ#ˆÀÎÂÍ#ˆÀÏÂÍ#‡" [put and byte-optimizer byte-optimize-and or byte-optimize-or cond byte-optimize-cond if byte-optimize-if while byte-optimize-while /= byte-compile-negation-optimizer atom nlistp] 4) (defalias 'byte-optimize-funcall #[(form) "A@‰¢Â>ƒ A@AAB‚)‡" [form fn (quote function)] 3]) (defalias 'byte-optimize-apply #[(form) "A@GS8 ƒ ¢Ã=ƒ? A@<ƒ4ÄAA!AŸÆ\nD ¤ÇÈ A@\"¤)‚<ÉÊË !\"ˆÌ†@*‡" [form last fn quote reverse butlast funcall mapcar #[(x) "À D‡" [quote x] 2] byte-compile-warn "last arg to apply can't be a literal atom: %s" prin1-to-string nil] 4]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#ˆÀÈÂÇ#‡" [put funcall byte-optimizer byte-optimize-funcall apply byte-optimize-apply let byte-optimize-letX let*] 4) (defalias 'byte-optimize-letX #[(form) "A@„\fÁAAB‡Â8„Ûƒ‡@Ä=ƒ/ÅÆÇÈÇÉA@\"\"Ê#‡ËA@!\fÍË\fA!\f@A@ÎF)‡" [form progn 2 3 let append (progn) mapcar car-safe cdr-safe (nil) reverse binds let* nil] 7]) (put (quote nth) (quote byte-optimizer) (quote byte-optimize-nth)) (defalias 'byte-optimize-nth #[(form) "À !ÂUƒ& A@Ã>ƒ&Ä A@ÅUƒÆ 8‚$ÇÆ 8DD‡È !‡" [safe-length form 3 (0 1) car 0 2 cdr byte-optimize-predicate] 4]) (put (quote nthcdr) (quote byte-optimizer) (quote byte-optimize-nthcdr)) (defalias 'byte-optimize-nthcdr #[(form) "À !ÂUƒ A@Ã>„Ä !‡ A@Æ 8 S‰ÇYƒ,È D‚ )‡" [safe-length form 3 (0 1 2) byte-optimize-predicate count 2 0 cdr] 2]) (byte-code "ÀÁ‰ƒÄ @ÅÆ#ˆ A‰„\nƒ(Ä\n@ÅÇ#ˆ\nA‰„*ć" [(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan assoc assq boundp buffer-file-name buffer-local-variables buffer-modified-p buffer-substring capitalize car-less-than-car car cdr ceiling concat coordinates-in-window-p copy-marker cos count-lines default-boundp default-value documentation downcase elt exp expt fboundp featurep file-directory-p file-exists-p file-locked-p file-name-absolute-p file-newer-than-file-p file-readable-p file-symlink-p file-writable-p float floor format get get-buffer get-buffer-window getenv get-file-buffer int-to-string length log log10 logand logb logior lognot logxor lsh marker-buffer max member memq min mod next-window nth nthcdr number-to-string parse-colon-path previous-window radians-to-degrees rassq regexp-quote reverse round sin sqrt string< string= string-equal string-lessp string-to-char string-to-int string-to-number substring symbol-plist tan upcase user-variable-p vconcat window-buffer window-dedicated-p window-edges window-height window-hscroll window-minibuffer-p window-width zerop) (arrayp atom bobp bolp buffer-end buffer-list buffer-size buffer-string bufferp car-safe case-table-p cdr-safe char-or-string-p commandp cons consp current-buffer dot dot-marker eobp eolp eq eql equal eventp floatp framep get-largest-window get-lru-window identity ignore integerp integer-or-marker-p interactive-p invocation-directory invocation-name keymapp list listp make-marker mark mark-marker markerp memory-limit minibuffer-window mouse-movement-p natnump nlistp not null number-or-marker-p numberp one-window-p overlayp point point-marker point-min point-max processp selected-window sequencep stringp subrp symbolp syntax-table-p user-full-name user-login-name user-original-login-name user-real-login-name user-real-uid user-uid vector vectorp window-configuration-p window-live-p windowp) side-effect-and-error-free-fns side-effect-free-fns put side-effect-free t error-free] 5) (defalias 'byte-compile-splice-in-already-compiled-code #[(form) "Á>„\n !‡ÄÅ A@Æ 8Ç#!ˆÉ 8\\\n]\nT‰‡" [byte-optimize (t lap) byte-compile-normal-call form byte-inline-lapcode byte-decompile-bytecode-1 2 t byte-compile-depth 3 byte-compile-maxdepth] 5]) (byte-code "ÀÁÂÃ#ˆÄÅBÀ‡" [put byte-code byte-compile byte-compile-splice-in-already-compiled-code (byte-constant byte-constant2 byte-varref byte-varset byte-varbind) byte-constref-ops current-load-list] 4) #@18 Don't call this! (defalias 'disassemble-offset #[nil "À B Bà B\fWƒKÅÆ\"ÅÈ\"É=ƒ-\nT \nH‚IÆ=ƒG\nT \nH\nTÊ \nHË\"\\‚I)‡\fYƒZ\fZ\f‡ YƒyXƒy\nT \nH\nTÊ \nHË\"\\‡Y…X…\nT \nH‡" [op current-load-list ptr bytes byte-nth logand 7 tem 248 6 lsh 8 byte-constant byte-constant2 byte-goto-if-not-nil-else-pop byte-listN byte-insertN] 4 (#$ . 14693)]) #@53 Turns BYTECODE into lapcode, referring to CONSTVEC. (defalias 'byte-decompile-bytecode #[(bytes constvec) "À‰ÁÅ\"+‡" [nil 0 byte-compile-tag-number byte-compile-variables byte-compile-constants byte-decompile-bytecode-1 bytes constvec] 3 (#$ . 15086)]) (defalias 'byte-decompile-bytecode-1 #[(bytes constvec &optional make-spliceable) "GÁ‰‰‰‰‰‰‰Á \n \f \f U„„3\fB\fH\f Ï H‰>ƒi ž†cÒ B B‰ @A‚èÓ=ƒvÔ‚~>ƒÀHÔ=ƒ« ;ƒ˜× \"‚œ ž†» CB‰@‚» ž†» CB‰@‚èƒèÚ=ƒè\f SUƒÛ‚è\f†ãÒ ‰Û †òÁBBB\fT‰\f‚!‰ƒ>@§„5@@ ž‰ƒ5 ABAB¡ˆÝ  \" AA‰„\n) ƒJÞß \"ˆ@A@„WA\fƒcÂ\fBBàáŸ\". ‡" [bytes 0 nil retcount endtag tmp lap offset op tags tag optr ptr length make-spliceable disassemble-offset byte-code-vector byte-goto-ops byte-compile-make-tag byte-constant2 byte-constant byte-constref-ops constvec assoc byte-compile-constants byte-compile-variables byte-return byte-goto rest delq error "optimizer error: missed tags %s" mapcar #[(elt) "§ƒ‡A‡" [elt] 1]] 12]) (byte-code "À B BÄÅ BÀ‡" [TAG byte-goto-ops byte-tagref-ops current-load-list (byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop byte-goto-if-not-nil-else-pop) byte-conditional-ops] 2) #@46 Byte-codes that can be moved past an unbind. (defconst byte-after-unbind-ops (quote (byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp byte-eq byte-equal byte-not byte-cons byte-list1 byte-list2 byte-interactive-p)) (#$ . 16405)) (byte-code "ÀÁ\nBà ¤Ä\nBÁ‡" [(byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max byte-point-min byte-following-char byte-preceding-char byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp byte-current-buffer byte-interactive-p) byte-compile-side-effect-and-error-free-ops current-load-list (byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1 byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax byte-buffer-substring byte-string= byte-string< byte-nthcdr byte-elt byte-member byte-assq byte-quo byte-rem) byte-compile-side-effect-free-ops] 2) #@174 DEFVAR_BOOL variables. Giving these any non-nil value sets them to t. If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer may generate incorrect code. (defconst byte-boolean-vars (quote (abbrev-all-caps abbrevs-changed byte-metering-on cannot-suspend completion-auto-help completion-ignore-case cursor-in-echo-area debug-on-next-call debug-on-quit delete-exited-processes enable-recursive-minibuffers highlight-nonselected-windows indent-tabs-mode inhibit-local-menu-bar-menus insert-default-directory inverse-video load-force-doc-strings load-in-progress menu-prompting minibuffer-auto-raise mode-line-inverse-video multiple-frames no-redraw-on-reenter noninteractive parse-sexp-ignore-comments pop-up-frames pop-up-windows print-escape-newlines system-uses-terminfo truncate-partial-width-windows visible-bell vms-stmlf-recfm words-include-escapes)) (#$ . 17588)) #@64 Simple peephole optimizer. LAP is both modified and returned. (defalias 'byte-optimize-lapcode #[(lap &optional for-effect) "À‰‰‰‰‰ÁÂÀ‰‰‰ ƒ\f‚  \n \f \fƒÕ \fÁ=„FÔ>ƒFÕÖ!ˆ\nÀ\f\nƒ/\n@\nA@Ø\n8@Ù=ƒï@>ƒïÚ\f@JH \nA\n ÜUƒ¨Ô>ƒ™ÕÝ\"ˆÞÞ\"\"‚Ì  ÂUƒÇÔ>ƒ¼Õß\"ˆÞ\"‚Ì  àUƒèÔ>ƒÛÕá\"ˆÙ ˆ¡ˆ‚Ì âã!ˆ‚Ì @$>ƒqA=ƒq@å=ƒÞ\"æ ‚8@'>ƒ0Ù‰  ˆ¡ˆ‚8âèØ8\"ˆé>ƒk*ƒkë>ƒkÚì‰-./ðñòA@A@ó !A@%!ˆ+Ú\f‚Ì @ô=ƒ%AA=ƒ%@õ>ƒ%A@6>‰ ƒ @÷=ƒÌ Ú\f@ø>ƒý ƒ¹A@ù>ƒ¿A‚ÏÚ:ž†ÏÚC:B‰:@ Ô>ƒíÕû@ B&ˆ@ ˆ ¡ˆ‚Ì Ô>ƒÕü$ˆ@ ˆý ˆ¡ˆÜ ‚Ì @ý=ƒb@Ù=ƒb@þ>ƒbÔ>ƒKÕÿ‰#ˆÚ\f\nA\nÞÞ\"\"‚Ì @@=ƒÉ@A=„€@B=ƒÉÔ>ƒ¥ÕC‰@A=ƒœB‚ŸAAB#ˆ‰@A=ƒ¶B‚¹A ˆÞ\"Ú\f‚Ì @A=„Ý@B=ƒ4@å=ƒ4A=ƒ4@A=ƒþB‚ADÔ>ƒÕEDAB&ˆÞ\"D ˆÚ\f)‚Ì @÷=ƒØ@F>ƒØ@A=„Y@G=ƒ`A@‚eA@?ƒÔ>ƒyÕH#ˆ\nA\nÞÞ\"\"‚Ò@'>ƒ·Ô>ƒ¬ÕIåAB$ˆÞ\"‚ÍÔ>ƒÍÕIåAB$ˆå ˆÚ\f‚Ì @ô=ƒc\nA‰ @@ý=ƒö A‰ ‚æA @A=ƒc @@ô=ƒcJ>ƒMKL\nA =„5ALMPL‚Ô>ƒLÕNL‰L&ˆ)Ú\f @ý ˆ @¡ˆ \n‚Ì @O=ƒ×@O=ƒ×P>ƒ¦*ƒ¦ë>ƒ¦Úì‰-./ðñQA@A@#!ˆ+R\"‰ƒÉ¡ˆ>A‚ªÞ\"Ú\f‚Ì @O=ƒ%R\"„%S>ƒ*ƒë>ƒÚì‰-./ðñTA@\"!ˆ+Þ\"Ú\f‚Ì @U>ƒ@V>„\n ÂW>À‰XLYZ A‰ ƒ @@O=„YƒN @XBXL[PLZTZ‚NYƒ÷ @@O=ƒœñ\\ @A@\"‚¥ @†¥K]Z^WƒÏ_Õ`LaQXŸ]]E¤$ˆ‚öÔ>ƒöÕbZ‰ÜUƒêK‚íc]]&ˆ)\n ¡ˆ,Ú\f‚Ì @d=ƒ>@e>ƒ>Ô>ƒ+Õf‰%ˆ\n ˆ\nA ˆÚ\f‚Ì @d=ƒÕ@g>ƒÕÂAWƒÕ‰AS¡ÂUƒlÞ\n\"ˆ@h=ƒ€\nÙÂB ˆ‚ˆÞ\"Ô>ƒÏÕf@ATB@h=ƒ­\n@‚±\nA@AÂU„Ê@h=ƒÊ\nA@‚ÍK%ˆÚ\f‚Ì @$>ƒ:A>A@‰ @i>ƒ: =„Ì @å=„  @å=ƒÌ Ô>ƒÕj@ ‰$ˆ @k=ƒ-k ˆ A¡ˆÚ\f‚Ì @l>ƒàA>A‰ @@m>ƒà @=„à @@nž@>ƒœ@ ˆA¡ˆÔ>ƒÚÕo@$ˆ‚ÚOÜ 8@=„´ p  AB¡ˆÔ>ƒÊÕq@A@$ˆA@ ˆ A@¡ˆÚ\f‚Ì @÷=ƒ’@å=ƒ’A>A‰ @@r>ƒ’ @=„’ @‰@A@„ s‚#t>ƒSÔ>ƒ<Õu%ˆ@ ˆA¡ˆÀ\nB\n‚ŒÔ>ƒdÕv#ˆOÜ 8@=„| p  AB¡ˆ A@¡ˆÞ\"Ú\f‚Ì @w=ƒ' @å=ƒ' A\n>„' A>A‰ @@ô=ƒ'  @AA=ƒ' A@6>„' p xÔ>ƒ ÕyAA@ @‰AA@ @xA@ýåxB& ˆ\nýÂB\nAB¡ˆ x¡ AB¡ˆ)Ü Ú\f‚Ì @å=ƒÌ @O=ƒÌ A>A‰ @A=ƒÌ  @@z>ƒÌ p xÔ>ƒˆ Õ{A@AA@ @ @@|žAxBxA@&ˆ x¡ AB¡ˆ @@G=ƒº \n÷À:ž†³ ÀC:B‰:@B\nAB¡ˆ @@}>A@ ˆ)Ú\f\nA‰\n‚OÀ:À~‰\nƒ& \n@\nA@@>ƒ$\nA÷=ƒ\nA~>„$\nA~B~‚$\nA:>„$\nA:B:@÷=ƒ~\nØ\n8@÷=ƒ~\nAØ\n8@=ƒ~\n@€>ƒ~\nÔ>ƒc\nÕ‰&ˆ\nAA@AB ˆ\nAýÂB ˆÜ ‚ @‚>ƒØ\n\n À A‰ @@ý=„\nA @A=ƒ¿\n@ @@=ƒ¿\n ýÂB ˆÚ‚\nƒ Ô>ƒ Õƒ‰‰$ˆ‚ @d=ƒ @d=ƒ Ô>ƒ ÕIdAA\\B$ˆÚ\fÞ\"‰AA\\¡ˆ\nA‰\n„ã „ \\„. ‡" [nil first-time 0 byte-compile-delete-errors byte-compile-side-effect-free-ops byte-compile-side-effect-and-error-free-ops side-effect-free tmp3 tmp2 tmp rest add-depth keep-going off2 lap2 off1 lap1 off0 lap0 byte-optimize-log (t byte) byte-compile-log-lap-1 " ---- next pass" lap 2 byte-discard t byte-stack+-info 1 " %s discard --> " delq " %s discard --> discard" -1 " %s discard --> discard discard" error "Optimizer error: too much on the stack" byte-goto-ops byte-goto "" byte-goto-always-pop-ops "Depth conflict at tag %d" (t byte) byte-optimize (t source) 4 print-length print-level print-escape-newlines byte-compile-log-1 format " (goto %s) %s: --> %s %s:" prin1-to-string byte-varref (byte-varset byte-varbind) byte-boolean-vars byte-constant (byte-constant byte-dup) (nil t) byte-compile-constants " %s %s %s --> %s %s %s" " %s %s --> dup %s" byte-dup (byte-varset byte-varbind) " dup %s discard --> %s" byte-not byte-goto-if-nil byte-goto-if-not-nil " not %s --> %s" inverse " %s %s %s: --> %s %s:" byte-conditional-ops byte-goto-if-nil-else-pop " %s %s --> " " %s %s --> %s" (t byte) "" str " dup" " %s%s %s --> %s%s dup" TAG (t byte) " adjacent tags %d and %d merged" rassq (t byte) " unused tag %d removed" (byte-goto byte-return) (TAG nil) (t lap) deleted opt-p i " %s" "%d:" tagstr 6 apply " %s" " %s --> %s %s" " %s <%d unreachable op%s> %s --> %s %s" "s" byte-unbind byte-after-unbind-ops " %s %s --> %s %s" (byte-varbind byte-save-excursion byte-save-restriction) byte-varbind (byte-goto byte-return) " %s [%s] --> %s" byte-return (byte-goto-if-nil-else-pop byte-goto-if-not-nil-else-pop) (byte-discard byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop byte-goto-if-not-nil-else-pop) ((byte-goto-if-nil-else-pop byte-goto-if-nil) (byte-goto-if-not-nil-else-pop byte-goto-if-not-nil)) " %s-else-pop [%s] --> %s" byte-compile-make-tag " %s [%s] --> %s " (byte-discard byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop byte-goto-if-not-nil-else-pop) (byte-goto-if-nil byte-goto-if-nil-else-pop) (byte-goto-if-not-nil byte-goto-if-not-nil-else-pop) " %s goto [%s] --> %s %s" " %s goto [%s] --> goto " byte-varset newtag " %s: %s ... %s %s --> %s: %s %s: ... %s %s %s" (byte-goto byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop) "%s %s: ... %s: %s --> %s ... %s:" ((byte-goto-if-nil . byte-goto-if-not-nil) (byte-goto-if-not-nil . byte-goto-if-nil) (byte-goto-if-nil-else-pop . byte-goto-if-not-nil-else-pop) (byte-goto-if-not-nil-else-pop . byte-goto-if-nil-else-pop)) (byte-goto-if-nil-else-pop byte-goto-if-not-nil byte-goto-if-nil byte-goto-if-not-nil byte-goto byte-goto) byte-compile-variables byte-constref-ops (byte-varbind byte-varset) " %s %s %s --> %s dup %s" (byte-constant byte-varref) " %s [dup/%s]... --> %s dup..." byte-compile-maxdepth] 14 (#$ . 18482)]) (provide (quote byte-optimize)) emacs-19.30/lisp/cl.elc100666 13437 1 45021 6045212657 13325 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:12:46 1995 ;;; from file /home/fsf/rms/e19/lisp/cl.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cl.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!„(ÂÃ!ƒÃJ„\fÅ™ƒÆ‚'ÇÈ\f\"ƒ&É‚'ÊÁ B ÂÌ!„8ÌÍMˆÀÎ!„AÏÎ B ÀÐ!„PÏÐ B ÑÑ B ÒÒ B ÓÓ B ÔÔ B ÕÕ B ÖÖ B ×× B ØØ B ÙÙ B ÚÚ B ÛÛ B ÜÜ B ÝÝ B ÞÞ B ßß B à à B À‡" [boundp cl-emacs-type fboundp epoch::version emacs-version "19" 18 string-match "Lucid" lucid 19 current-load-list defalias fset cl-optimize-speed 1 cl-optimize-safety :test :test-not :key :start :start1 :start2 :end :end1 :end2 :count :initial-value :size :from-end :rehash-size :rehash-threshold :allow-other-keys] 3) #@445 This is a list of functions that format user objects for printing. Each function is called in turn with three arguments: the object, the stream, and the print level (currently ignored). If it is able to print the object it returns true; otherwise it returns nil and the printer proceeds to the next function on the list. This variable is not used at present, but it is defined in hopes that a future Emacs interpreter will be able to use it. (defvar custom-print-functions nil (#$ . 1034)) #@120 T if the two args are the same Lisp object. Floating-point numbers of equal value are `eql', but they may not be `eq'. (defalias 'eql #[(a b) "§ƒ  š‡ =‡" [a b] 2 (#$ . 1533)]) #@178 (incf PLACE [X]): increment PLACE by X (1 by default). PLACE may be a symbol, or any generalized variable allowed by `setf'. The return value is the incremented value of PLACE. (defalias 'incf '(macro . #[(place &optional x) "9ƒÁ\nƒÃ\nE‚ÄDE‡ÅÃ\n†ÆF‡" [place setq x + 1+ callf 1] 5 (#$ . 1720)])) #@178 (decf PLACE [X]): decrement PLACE by X (1 by default). PLACE may be a symbol, or any generalized variable allowed by `setf'. The return value is the decremented value of PLACE. (defalias 'decf '(macro . #[(place &optional x) "9ƒÁ\nƒÃ\nE‚ÄDE‡ÅÃ\n†ÆF‡" [place setq x - 1- callf 1] 5 (#$ . 2036)])) #@284 (pop PLACE): remove and return the head of the list stored in PLACE. Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more careful about evaluating each argument only once and in the right order. PLACE may be a symbol, or any generalized variable allowed by `setf'. (defalias 'pop '(macro . #[(place) "9ƒÁÂÃÄDEED‡Å!‡" [place car prog1 setq cdr cl-do-pop] 7 (#$ . 2352)])) #@265 (push X PLACE): insert X at the head of the list stored in PLACE. Analogous to (setf PLACE (cons X PLACE)), though more careful about evaluating each argument only once and in the right order. PLACE may be a symbol, or any generalized variable allowed by `setf'. (defalias 'push '(macro . #[(x place) "9ƒ Á EE‡Ä F‡" [place setq cons x callf2] 5 (#$ . 2755)])) #@222 (pushnew X PLACE): insert X at the head of the list if not already there. Like (push X PLACE), except that the list is unmodified if X is `eql' to an element already on the list. Keywords supported: :test :test-not :key (defalias 'pushnew '(macro . #[(x place &rest keys) "9ƒÁÂÃ\f $E‡ÂÆÃ\f %‡" [place setq list* adjoin x keys callf2] 7 (#$ . 3130)])) (defalias 'cl-set-elt #[(seq n val) "<ƒ ›\n ‡ \nI‡" [seq n val] 3]) (defalias 'cl-set-nthcdr #[(n list x) "ÁXƒ\n‡S ›\n¡ˆ ‡" [n 0 x list] 2]) (defalias 'cl-set-buffer-substring #[(start end val) "Š |ˆbˆ\ncˆ\n)‡" [start end val] 2]) (defalias 'cl-set-substring #[(str start end val) "ƒÁWƒ\nG\\‚\nG ÁWƒ \n\\ ÁV…)\nÁ O\f\nGW…5\nÅOQ‡" [end 0 str start val nil] 5]) #@72 (when COND BODY...): if COND yields non-nil, do BODY, else return nil. (defalias 'when '(macro . #[(cond &rest body) "À  BE‡" [if cond progn body] 4 (#$ . 3883)])) #@70 (unless COND BODY...): if COND yields nil, do BODY, else return nil. (defalias 'unless '(macro . #[(cond &rest body) "À  BBB‡" [if cond nil body] 4 (#$ . 4054)])) (defalias 'cl-map-extents #[(&rest cl-args) "ÀÁ!ƒ ÂÃ\f\"‡ÀÅ!…ÂÅ\f\"‡" [fboundp next-overlay-at apply cl-map-overlays cl-args map-extents] 3]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÂ\"ˆÀÈÂ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÍÎ!„,ÏÎBÍÑ!„AÒKÀÒÓ\"ˆÑBχ" [defalias cl-block-wrapper identity cl-block-throw throw values list values-list multiple-value-list multiple-value-call apply nth-value nth boundp cl-macro-environment nil current-load-list cl-old-macroexpand macroexpand cl-macroexpand] 4) #@384 Return result of expanding macros at top level of FORM. If FORM is not a macro call, it is returned unchanged. Otherwise, the macro is expanded and the expansion is considered in place of FORM. When a non-macro-call results, it is returned. The second optional arg ENVIRONMENT species an environment of macro definitions to shadow the loaded ones for use in file byte-compilation. (defalias 'cl-macroexpand #[(cl-macro &optional cl-env) "\n \"‰9ƒ Ä !žAƒ ÅÄ !ž!‚ )‡" [cl-env cl-macro-environment cl-old-macroexpand cl-macro symbol-name cadr] 4 (#$ . 4706)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp cl-compiling-file nil current-load-list] 2) (defalias 'cl-compiling-file #[nil "†ÁÂ!…ÃÂJ!…ÄÂJ!Åš‡" [cl-compiling-file boundp outbuffer bufferp buffer-name " *Compiler Output*"] 2]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp cl-proclaims-deferred nil current-load-list] 2) (defalias 'proclaim #[(spec) "ÀÁ!ƒÁ\nÃ\"ˆ‚\n\fBŇ" [fboundp cl-do-proclaim spec t cl-proclaims-deferred nil] 3]) (defalias 'declaim '(macro . #[(&rest specs) "ÀÁ\n\"Ä ƒÅÆÇ #‚È B)‡" [mapcar #[(x) "ÀÁ\nDD‡" [proclaim quote x] 3] specs body cl-compiling-file list* eval-when (compile load eval) progn] 4])) (defalias 'cl-random-time #[nil "ÀÁ !‰GÄ S‰ÄYƒ Æ_\n H\\‚\n +‡" [copy-sequence current-time-string time i 0 v 3] 4]) (byte-code "ÀÁ!„Âà Ä\"Å_ÁBÀ‡" [boundp *gensym-counter* logand cl-random-time 1023 100 current-load-list] 3) #@127 T if OBJECT is a floating point number. On Emacs versions that lack floating-point support, this function always returns nil. (defalias 'floatp-safe #[(x) "§…¨?‡" [x] 1 (#$ . 6144)]) #@26 T if NUMBER is positive. (defalias 'plusp #[(x) "ÁV‡" [x 0] 2 (#$ . 6337)]) #@26 T if NUMBER is negative. (defalias 'minusp #[(x) "ÁW‡" [x 0] 2 (#$ . 6420)]) #@22 T if INTEGER is odd. (defalias 'oddp #[(x) "À Â\"Â=‡" [logand x 1] 3 (#$ . 6504)]) #@23 T if INTEGER is even. (defalias 'evenp #[(x) "À Â\"Ã=‡" [logand x 1 0] 3 (#$ . 6593)]) #@35 Return the absolute value of ARG. (defalias 'cl-abs #[(x) "ÁYƒ‡[‡" [x 0] 2 (#$ . 6686)]) (byte-code "ÀÁ!„ ÂÁÃ\"ˆÄÅ!„ÆÇÈÉÊ $Å B ÌÍ!Î B ÌÏ!Ð B ÑÒ B ÑÓ B ÑÔ B ÑÕ B ÑÖ B Ñ× B ÑØ B ÑÙ B ÂÚÛ\"‡" [fboundp abs defalias cl-abs boundp *random-state* vector cl-random-state-tag -1 30 cl-random-time current-load-list eval (lsh -1 -1) most-positive-fixnum (- -1 (lsh -1 -1)) most-negative-fixnum nil most-positive-float most-negative-float least-positive-float least-negative-float least-positive-normalized-float least-negative-normalized-float float-epsilon float-negative-epsilon copy-seq copy-sequence] 5) #@342 Apply FUNCTION to each element of SEQ, and make a list of the results. If there are several SEQs, FUNCTION is called with that many arguments, and mapping stops as soon as the shortest list runs out. With just one SEQ, this is like `mapcar'. With several, it is like the Common Lisp `mapcar' function extended to arbitrary sequence types. (defalias 'mapcar* #[(cl-func cl-x &rest cl-rest) "ƒBA„ <ƒ@<„ B\"‡Ä@ ƒ= ƒ= ‰A@ ‰A@\"B‚!Ÿ*‡Ç \"‡" [cl-rest cl-x cl-mapcar-many cl-func nil cl-y cl-res mapcar] 4 (#$ . 7342)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias first car rest cdr endp null] 3) #@45 Return the second element of the list LIST. (defalias 'second #[(x) "A@‡" [x] 1 (#$ . 7968)]) #@44 Return the third element of the list LIST. (defalias 'third #[(x) "AA@‡" [x] 1 (#$ . 8069)]) #@45 Return the fourth element of the list LIST. (defalias 'fourth #[(x) "À 8‡" [3 x] 2 (#$ . 8169)]) #@44 Return the fifth element of the list LIST. (defalias 'fifth #[(x) "À 8‡" [4 x] 2 (#$ . 8272)]) #@44 Return the sixth element of the list LIST. (defalias 'sixth #[(x) "À 8‡" [5 x] 2 (#$ . 8373)]) #@46 Return the seventh element of the list LIST. (defalias 'seventh #[(x) "À 8‡" [6 x] 2 (#$ . 8474)]) #@45 Return the eighth element of the list LIST. (defalias 'eighth #[(x) "À 8‡" [7 x] 2 (#$ . 8579)]) #@44 Return the ninth element of the list LIST. (defalias 'ninth #[(x) "À 8‡" [8 x] 2 (#$ . 8682)]) #@44 Return the tenth element of the list LIST. (defalias 'tenth #[(x) "À 8‡" [9 x] 2 (#$ . 8783)]) #@37 Return the `car' of the `car' of X. (defalias 'caar #[(x) "@@‡" [x] 1 (#$ . 8884)]) #@37 Return the `car' of the `cdr' of X. (defalias 'cadr #[(x) "A@‡" [x] 1 (#$ . 8975)]) #@37 Return the `cdr' of the `car' of X. (defalias 'cdar #[(x) "@A‡" [x] 1 (#$ . 9066)]) #@37 Return the `cdr' of the `cdr' of X. (defalias 'cddr #[(x) "AA‡" [x] 1 (#$ . 9157)]) #@50 Return the `car' of the `car' of the `car' of X. (defalias 'caaar #[(x) "@@@‡" [x] 1 (#$ . 9248)]) #@50 Return the `car' of the `car' of the `cdr' of X. (defalias 'caadr #[(x) "A@@‡" [x] 1 (#$ . 9354)]) #@50 Return the `car' of the `cdr' of the `car' of X. (defalias 'cadar #[(x) "@A@‡" [x] 1 (#$ . 9460)]) #@50 Return the `car' of the `cdr' of the `cdr' of X. (defalias 'caddr #[(x) "AA@‡" [x] 1 (#$ . 9566)]) #@50 Return the `cdr' of the `car' of the `car' of X. (defalias 'cdaar #[(x) "@@A‡" [x] 1 (#$ . 9672)]) #@50 Return the `cdr' of the `car' of the `cdr' of X. (defalias 'cdadr #[(x) "A@A‡" [x] 1 (#$ . 9778)]) #@50 Return the `cdr' of the `cdr' of the `car' of X. (defalias 'cddar #[(x) "@AA‡" [x] 1 (#$ . 9884)]) #@50 Return the `cdr' of the `cdr' of the `cdr' of X. (defalias 'cdddr #[(x) "AAA‡" [x] 1 (#$ . 9990)]) #@63 Return the `car' of the `car' of the `car' of the `car' of X. (defalias 'caaaar #[(x) "@@@@‡" [x] 1 (#$ . 10096)]) #@63 Return the `car' of the `car' of the `car' of the `cdr' of X. (defalias 'caaadr #[(x) "A@@@‡" [x] 1 (#$ . 10218)]) #@63 Return the `car' of the `car' of the `cdr' of the `car' of X. (defalias 'caadar #[(x) "@A@@‡" [x] 1 (#$ . 10340)]) #@63 Return the `car' of the `car' of the `cdr' of the `cdr' of X. (defalias 'caaddr #[(x) "AA@@‡" [x] 1 (#$ . 10462)]) #@63 Return the `car' of the `cdr' of the `car' of the `car' of X. (defalias 'cadaar #[(x) "@@A@‡" [x] 1 (#$ . 10584)]) #@63 Return the `car' of the `cdr' of the `car' of the `cdr' of X. (defalias 'cadadr #[(x) "A@A@‡" [x] 1 (#$ . 10706)]) #@63 Return the `car' of the `cdr' of the `cdr' of the `car' of X. (defalias 'caddar #[(x) "@AA@‡" [x] 1 (#$ . 10828)]) #@63 Return the `car' of the `cdr' of the `cdr' of the `cdr' of X. (defalias 'cadddr #[(x) "AAA@‡" [x] 1 (#$ . 10950)]) #@63 Return the `cdr' of the `car' of the `car' of the `car' of X. (defalias 'cdaaar #[(x) "@@@A‡" [x] 1 (#$ . 11072)]) #@63 Return the `cdr' of the `car' of the `car' of the `cdr' of X. (defalias 'cdaadr #[(x) "A@@A‡" [x] 1 (#$ . 11194)]) #@63 Return the `cdr' of the `car' of the `cdr' of the `car' of X. (defalias 'cdadar #[(x) "@A@A‡" [x] 1 (#$ . 11316)]) #@63 Return the `cdr' of the `car' of the `cdr' of the `cdr' of X. (defalias 'cdaddr #[(x) "AA@A‡" [x] 1 (#$ . 11438)]) #@63 Return the `cdr' of the `cdr' of the `car' of the `car' of X. (defalias 'cddaar #[(x) "@@AA‡" [x] 1 (#$ . 11560)]) #@63 Return the `cdr' of the `cdr' of the `car' of the `cdr' of X. (defalias 'cddadr #[(x) "A@AA‡" [x] 1 (#$ . 11682)]) #@63 Return the `cdr' of the `cdr' of the `cdr' of the `car' of X. (defalias 'cdddar #[(x) "@AAA‡" [x] 1 (#$ . 11804)]) #@63 Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X. (defalias 'cddddr #[(x) "AAAA‡" [x] 1 (#$ . 11926)]) #@105 Returns the last link in the list LIST. With optional argument N, returns Nth-to-last link (default 1). (defalias 'last #[(x &optional n) "ƒ3Á\n :ƒ\fT ‰Aˆ‚ÁXƒ\" ‚1\fWƒ0\fZ\n›‚1\n*‡\nA:ƒA\n‰Aˆ‚3\n‡" [n 0 x p m] 2 (#$ . 12049)]) #@58 Returns a copy of LIST with the last N elements removed. (defalias 'butlast #[(x &optional n) "ƒ\fÁXƒ\f\n‡ÃÄ\n!\"‡" [n 0 x nbutlast copy-sequence] 3 (#$ . 12302)]) #@46 Modifies LIST to remove the last N elements. (defalias 'nbutlast #[(x &optional n) "G\n„ Ã\n W…\nÄVƒ S\nZ›Å¡ˆ)‡" [x m n 1 0 nil] 2 (#$ . 12477)]) #@177 Return a new list with specified args as elements, cons'd to last arg. Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to `(cons A (cons B (cons C D)))'. (defalias 'list* #[(arg &rest rest) "„ ‡A„ @B‡GÃ!\nÅZ\f›‰‰A@¡ˆ \f+B‡" [rest arg n copy-sequence copy 2 last] 3 (#$ . 12640)]) #@54 Return a copy of LIST with the tail SUBLIST removed. (defalias 'ldiff #[(list sublist) "À\n:ƒ\n =„\n‰A@ B‚ Ÿ)‡" [nil res list sublist] 2 (#$ . 12961)]) #@127 Return a copy of a list, which may be a dotted list. The elements of the list are not copied, just the list structure itself. (defalias 'copy-list #[(list) ":ƒÁ:ƒ‰A@\nB‚\nŸ\n¡ˆ)‡@‡" [list nil res] 3 (#$ . 13129)]) (defalias 'cl-maclisp-member #[(item list) "ƒ @š„A‰„‡" [list item] 3]) (byte-code "ÀÁ!ƒ ÂÁK!„ÃÁÄ\"ˆÃÅÆ\"ˆÃÇÈ\"ˆÃÉÊ\"ˆÃËÌ\"ˆÃÍÎ\"ˆÃÏÐ\"‡" [fboundp member subrp defalias cl-maclisp-member cl-member memq cl-floor floor* cl-ceiling ceiling* cl-truncate truncate* cl-round round* cl-mod mod*] 3) #@152 Return ITEM consed onto the front of LIST only if it's not already there. Otherwise, return LIST unmodified. Keywords supported: :test :test-not :key (defalias 'adjoin #[(cl-item cl-list &rest cl-keys) "Áš„„\n§„\n >ƒ ‡\n B‡Äš„%„1\n ƒ- ‡\n B‡ÅÆ\n $‡" [cl-keys (:test eq) cl-item cl-list (:test equal) apply cl-adjoin] 5 (#$ . 13669)]) #@176 Substitute NEW for OLD everywhere in TREE (non-destructively). Return a copy of TREE with all elements `eql' to OLD replaced by NEW. Keywords supported: :test :test-not :key (defalias 'subst #[(cl-new cl-old cl-tree &rest cl-keys) "„ §ƒ ¨„Âà \fBC $‡Æ\f #‡" [cl-keys cl-old apply sublis cl-new cl-tree cl-do-subst] 5 (#$ . 14028)]) (defalias 'cl-do-subst #[(cl-new cl-old cl-tree) " =ƒ\n‡:ƒ2Ã\n @#Ã\n A#‰@=ƒ-\fA=ƒ-‚0 \fB*‡‡" [cl-tree cl-old cl-new cl-do-subst d a] 6]) (defalias 'acons #[(a b c) " B\nB‡" [a b c] 2]) (defalias 'pairlis #[(a b &optional c) "ÀÁ\n #\f¤‡" [mapcar* cons a b c] 4]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put cl-assertion-failed error-conditions (error) error-message "Assertion failed"] 4) #@114 Add to hook variable HOOK the function FUNC. FUNC is not added if it already appears on the list stored in HOOK. (defalias 'cl-add-hook #[(hook func &optional append) "À !… J‰<ƒ\n@Ã=„\nC\f\n?…/ ƒ+\n\fC¤‚.\f\nBL)‡" [boundp hook old lambda func append] 4 (#$ . 14768)]) (byte-code "ÀÁ!„ ÂÁÃ\"ˆÄÅÆ\"ˆÄÇÈ\"ˆÉÊ!ˆËÌ!„\"Í\fÌB͇" [fboundp add-hook defalias cl-add-hook mapcar #[(set) "ÀÁ !\"‡" [mapcar #[(func) "À \n@É\nA@%‡" [autoload func set nil] 6] cddr set] 4] (("cl-extra" nil coerce equalp cl-map-keymap maplist mapc mapl mapcan mapcon cl-map-keymap cl-map-keymap-recursively cl-map-intervals cl-map-overlays cl-set-frame-visible-p cl-float-limits gcd lcm isqrt expt floor* ceiling* truncate* round* mod* rem* signum random* make-random-state random-state-p subseq concatenate cl-mapcar-many map some every notany notevery revappend nreconc list-length tailp copy-tree get* getf cl-set-getf cl-do-remf remprop make-hash-table cl-hash-lookup gethash cl-puthash remhash clrhash maphash hash-table-p hash-table-count cl-progv-before cl-prettyexpand cl-macroexpand-all) ("cl-seq" nil reduce fill replace remq remove remove* remove-if remove-if-not delete delete* delete-if delete-if-not remove-duplicates delete-duplicates substitute substitute-if substitute-if-not nsubstitute nsubstitute-if nsubstitute-if-not find find-if find-if-not position position-if position-if-not count count-if count-if-not mismatch search sort* stable-sort merge member* member-if member-if-not cl-adjoin assoc* assoc-if assoc-if-not rassoc* rassoc rassoc-if rassoc-if-not union nunion intersection nintersection set-difference nset-difference set-exclusive-or nset-exclusive-or subsetp subst-if subst-if-not nsubst nsubst-if nsubst-if-not sublis nsublis tree-equal) ("cl-macs" nil gensym gentemp typep cl-do-pop get-setf-method cl-struct-setf-expander compiler-macroexpand cl-compile-time-init) ("cl-macs" t defun* defmacro* function* destructuring-bind eval-when eval-when-compile load-time-value case ecase typecase etypecase block return return-from loop do do* dolist dotimes do-symbols do-all-symbols psetq progv flet labels macrolet symbol-macrolet lexical-let lexical-let* multiple-value-bind multiple-value-setq locally the declare define-setf-method defsetf define-modify-macro setf psetf remf shiftf rotatef letf letf* callf callf2 defstruct check-type assert ignore-errors define-compiler-macro)) #[(entry) "ÀÁ\n@\"‡" [mapcar #[(func) "À  A@#ˆÀ Ä A@#ˆ ÅN†À ÅÆ 8#‡" [put func lisp-indent-function entry lisp-indent-hook edebug-form-spec 2] 5] entry] 3] (((defun* defmacro*) 2) ((function*) nil (&or symbolp ([&optional (quote macro)] (quote lambda) (&rest sexp) &rest form))) ((eval-when) 1 (sexp &rest form)) ((when unless) 1 (&rest form)) ((declare) nil (&rest sexp)) ((the) 1 (sexp &rest form)) ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form))) ((block return-from) 1 (sexp &rest form)) ((return) nil (&optional form)) ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form)) (form &rest form) &rest form)) ((dolist dotimes) 1 ((symbolp form &rest form) &rest form)) ((do-symbols) 1 ((symbolp form &optional form form) &rest form)) ((do-all-symbols) 1 ((symbolp form &optional form) &rest form)) ((psetq setf psetf) nil edebug-setq-form) ((progv) 2 (&rest form)) ((flet labels macrolet) 1 ((&rest (sexp sexp &rest form)) &rest form)) ((symbol-macrolet lexical-let lexical-let*) 1 ((&rest &or symbolp (symbolp form)) &rest form)) ((multiple-value-bind) 2 ((&rest symbolp) &rest form)) ((multiple-value-setq) 1 ((&rest symbolp) &rest form)) ((incf decf remf pop push pushnew shiftf rotatef) nil (&rest form)) ((letf letf*) 1 ((&rest (&rest form)) &rest form)) ((callf destructuring-bind) 2 (sexp form &rest form)) ((callf2) 3 (sexp form form &rest form)) ((loop) nil (&rest &or symbolp form)) ((ignore-errors) 0 (&rest form))) provide cl-19 boundp cl-hacked-flag nil current-load-list] 3) (defalias 'cl-hack-byte-compiler #[nil "?…ÁÂ!…à ˆÄ‰‡" [cl-hacked-flag fboundp byte-compile-file-form cl-compile-time-init t] 2]) (byte-code "À ˆÁÂÀ\"ˆÃÄ!ˆÃÅ!ˆÆÇ!‡" [cl-hack-byte-compiler add-hook emacs-lisp-mode-hook provide cl mini-cl run-hooks cl-load-hook] 3) emacs-19.30/lisp/byte-run.elc100666 13437 1 5052 5751545350 14456 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:14:31 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/byte-run.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/byte-run.el' was compiled for Emacs 19")) (byte-code "ÀÁMˆÂÀÃÄ#‡" [inline progn put lisp-indent-hook 0] 4) #@70 Define an inline function. The syntax is just like that of `defun'. (defalias 'defsubst '(macro . #[(name arglist &rest body) "ÁNÂ>„ ÃÄ\"ˆÅÆBBBÉÊËDÌÍFDE‡" [name byte-optimizer (nil byte-compile-inline-expand) error "`%s' is a primitive" prog1 defun arglist body eval-and-compile put quote (quote byte-optimizer) (quote byte-compile-inline-expand)] 7 (#$ . 550)])) #@165 Make the byte-compiler warn that FUNCTION is obsolete. The warning will say that NEW should be used instead. If NEW is a string, that is the `use instead' message. (defalias 'make-obsolete #[(fn new) "ÁN‰Ã=ƒÄN  ˆ‚!ÆÄ \nB#ˆÆÁÃ#ˆ)‡" [fn byte-compile handler byte-compile-obsolete byte-obsolete-info new put] 6 (#$ . 931) "aMake function obsolete: \nxObsoletion replacement: "]) #@149 Make the byte-compiler warn that VARIABLE is obsolete, and NEW should be used instead. If NEW is a string, then that is the `use instead' message. (defalias 'make-obsolete-variable #[(var new) "À  #ˆ ‡" [put var byte-obsolete-variable new] 4 (#$ . 1323) (list (let ((str (completing-read "Make variable obsolete: " obarray (quote boundp) t))) (if (equal str "") (error "")) (intern str)) (car (read-from-string (read-string "Obsoletion replacement: "))))]) (put (quote dont-compile) (quote lisp-indent-hook) 0) #@140 Like `progn', but the body always runs interpreted (not compiled). If you think you need this, you're probably making a mistake somewhere. (defalias 'dont-compile '(macro . #[(&rest body) "ÀÁ\nAƒ Ã\nB‚\n@DD‡" [eval quote body progn] 4 (#$ . 1843)])) (put (quote eval-when-compile) (quote lisp-indent-hook) 0) #@124 Like `progn', but evaluates the body at compile time. The result of the body appears to the compiler as a quoted constant. (defalias 'eval-when-compile '(macro . #[(&rest body) "À B‡" [progn body] 2 (#$ . 2162)])) (put (quote eval-and-compile) (quote lisp-indent-hook) 0) #@72 Like `progn', but evaluates the body at compile time and at load time. (defalias 'eval-and-compile '(macro . #[(&rest body) "À B‡" [progn body] 2 (#$ . 2440)])) emacs-19.30/lisp/bytecomp.elc100666 12120 1 217467 6051026261 14443 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 10 23:53:17 1995 ;;; from file /home/fsf/rms/e19/lisp/bytecomp.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`bytecomp.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ\nBÃÄ!ˆÅÆ!„ÇÈ!ˆÁ‡" ["FSF 2.10" byte-compile-version current-load-list require backquote fboundp defsubst load-library "byte-run"] 2) (defalias 'byte-compile-single-version '(macro . #[nil "À‡" [nil] 1])) (defalias 'byte-compile-version-cond '(macro . #[(cond) "‡" [cond] 1])) #@118 *Regexp which matches Emacs Lisp source files. You may want to redefine `byte-compile-dest-file' if you change this. (defvar emacs-lisp-file-regexp (byte-code "Á=ƒ‡Ç" [system-type vax-vms "\\.EL\\(;[0-9]+\\)?$" "\\.el$"] 2) (#$ . -772)) (defalias 'byte-compiler-base-file-name #[(filename) "À Â\"‰ƒ  \"‚ )‡" [find-file-name-handler filename byte-compiler-base-file-name handler] 4]) (byte-code "ÀÁ!„\nÁÂMˆÃÄÅ\"ˆÃÆÅ\"ˆÃÇÅ\"ˆÃÈÅ\"ˆÃÉÅ\"‡" [fboundp byte-compile-dest-file #[(filename) "À ! ! Ä=ƒ ÅÆÇ \"OÈP‡Æ \"ƒ( ʼn”OÊP‡ ÊP‡" [byte-compiler-base-file-name filename file-name-sans-versions system-type vax-vms 0 string-match ";" "c" emacs-lisp-file-regexp ".elc"] 5 "Convert an Emacs Lisp source file name to a compiled file name."] autoload byte-compile-inline-expand "byte-opt" byte-optimize-form byte-optimize-lapcode byte-compile-unfold-lambda byte-decompile-bytecode] 3) #@69 *Non-nil means print messages describing progress of byte-compiler. (defvar byte-compile-verbose (byte-code "?… \nV‡" [noninteractive baud-rate search-slow-speed] 2) (#$ . -1670)) #@58 *Non-nil means generate output that can run in Emacs 18. (defvar byte-compile-compatibility nil (#$ . -1859)) #@210 *Enables optimization in the byte compiler. nil means don't do any optimization. t means do all optimizations. `source' means do source-level optimizations only. `byte' means do code-level optimizations only. (defvar byte-optimize t (#$ . -1976)) #@143 *If non-nil, the optimizer may delete forms that may signal an error. This includes variable references and calls to functions such as `car'. (defvar byte-compile-delete-errors t (#$ . -2230)) #@448 *If non-nil, compile function bodies so they load lazily. They are hidden comments in the compiled file, and brought into core when the function is called. To enable this option, make it a file-local variable in the source file you want it to apply to. For example, add -*-byte-compile-dynamic: t;-*- on the first line. When this option is true, if you load the compiled file and then move it, the functions you loaded will not be able to run. (defvar byte-compile-dynamic nil (#$ . -2430)) #@632 *If non-nil, compile doc strings for lazy access. We bury the doc strings of functions and variables inside comments in the file, and bring them into core only when they are actually needed. When this option is true, if you load the compiled file and then move it, you won't be able to find the documentation of anything in that file. To disable this option for a certain file, make it a file-local variable in the source file. For example, add this to the first line: -*-byte-compile-dynamic-docstrings:nil;-*- You can also set the variable globally. This option is enabled by default because it reduces Emacs memory usage. (defvar byte-compile-dynamic-docstrings t (#$ . -2931)) #@216 *If true, the byte-compiler will log its optimizations into *Compile-Log*. If this is 'source, then only source-level optimizations will be logged. If it is 'byte, then only byte-level optimizations will be logged. (defvar byte-optimize-log nil (#$ . -3625)) #@60 *If true, the byte-compiler reports warnings with `error'. (defvar byte-compile-error-on-warn nil (#$ . -3890)) (byte-code "ÀÁ\nBÁ‡" [(redefine callargs free-vars unresolved obsolete) byte-compile-warning-types current-load-list] 2) #@526 *List of warnings that the byte-compiler should issue (t for all). Elements of the list may be be: free-vars references to variables not in the current lexical scope. unresolved calls to unknown functions. callargs lambda calls with args that don't match the definition. redefine function cell redefined from a macro to a lambda or vice versa, or redefined to take a different number of arguments. obsolete obsolete variables and functions. See also the macro `byte-compiler-options'. (defvar byte-compile-warnings t (#$ . -4132)) #@637 *Non-nil means collect call-graph information when compiling. This records functions were called and from where. If the value is t, compilation displays the call graph when it finishes. If the value is neither t nor nil, compilation asks you whether to display the graph. The call tree only lists functions called, not macros used. Those functions which the byte-code interpreter knows about directly (eq, cons, etc.) are not reported. The call tree also lists those functions which are not known to be called (that is, to which no calls have been compiled). Functions which can be invoked interactively are excluded from this list. (defvar byte-compile-generate-call-tree nil (#$ . -4710)) #@241 Alist of functions and their call tree. Each element looks like (FUNCTION CALLERS CALLS) where CALLERS is a list of functions that call FUNCTION, and CALLS is a list of functions for which calls were generated while compiling FUNCTION. (defconst byte-compile-call-tree nil (#$ . 5411)) #@126 *If non-nil, sort the call tree. The values `name', `callers', `calls', `calls+callers' specify different fields to sort on. (defvar byte-compile-call-tree-sort (quote name) (#$ . -5708)) #@67 list of all constants encountered during compilation of this form (defvar byte-compile-constants nil (#$ . 5902)) #@67 list of all variables encountered during compilation of this form (defvar byte-compile-variables nil (#$ . 6022)) #@98 list of variables bound in the context of the current form; this list lives partly on the stack. (defvar byte-compile-bound-variables nil (#$ . 6142)) (byte-code "À B Bà BÀ‡" [byte-compile-free-references current-load-list byte-compile-free-assignments byte-compiler-error-flag] 2) #@205 The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter. (defconst byte-compile-initial-macro-environment (quote ((eval-when-compile lambda (&rest body) (list (quote quote) (eval (byte-compile-top-level (cons (quote progn) body))))) (eval-and-compile lambda (&rest body) (eval (cons (quote progn) body)) (cons (quote progn) body)))) (#$ . 6435)) #@169 Alist of macros defined in the file being compiled. Each element looks like (MACRONAME . DEFINITION). It is (MACRONAME . nil) when a macro is redefined as a function. (defvar byte-compile-macro-environment byte-compile-initial-macro-environment (#$ . 6935)) #@224 Alist of functions defined in the file being compiled. This is so we can inline them when necessary. Each element looks like (FUNCTIONNAME . DEFINITION). It is (FUNCTIONNAME . nil) when a function is redefined as a macro. (defvar byte-compile-function-environment nil (#$ . 7201)) #@140 Alist of undefined functions to which calls have been compiled (used for warnings when the function is later defined with incorrect args). (defvar byte-compile-unresolved-functions nil (#$ . 7490)) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp byte-compile-tag-number 0 current-load-list] 2) #@87 Alist describing contents to put in byte code string. Each element is (INDEX . VALUE) (defvar byte-compile-output nil (#$ . 7778)) #@35 Current depth of execution stack. (defvar byte-compile-depth 0 (#$ . 7915)) #@35 Maximum depth of execution stack. (defvar byte-compile-maxdepth 0 (#$ . 7997)) #@66 An array containing byte-code names indexed by byte-code values. (defconst byte-code-vector nil (#$ . 8082)) #@56 An array with the stack adjustment for each byte-code. (defconst byte-stack+-info nil (#$ . 8197)) (defalias 'byte-defop '(macro . #[(opcode stack-adjust opname &optional docstring) "ÀÁN†ÂÀÁÃÄÅ\"#ÆÁN†ÂÆÁÃÄÅ\"#‰ \nIˆ  Iˆ*\fƒAÍ\n Î\fÏQF‡Í\n E‡" [byte-code-vector tmp-compile-time-value put make-vector 256 nil byte-stack+-info v2 v1 opcode opname stack-adjust docstring defconst "Byte code opcode " "."] 8])) (defalias 'byte-extrude-byte-code-vectors '(macro . #[nil "ÀÁ‰ÂNÉÂN¯ÄÁÂÅ#ˆÄÃÂÅ#ˆ‡" [setq byte-code-vector tmp-compile-time-value byte-stack+-info put nil] 6])) #@42 Byte code opcode for variable reference. (defconst byte-varref 8 (#$ . 8793)) #@42 Byte code opcode for setting a variable. (defconst byte-varset 16 (#$ . 8877)) #@42 Byte code opcode for binding a variable. (defconst byte-varbind 24 (#$ . 8962)) #@42 Byte code opcode for calling a function. (defconst byte-call 32 (#$ . 9048)) #@50 Byte code opcode for unbinding special bindings. (defconst byte-unbind 40 (#$ . 9131)) (byte-code "ÀÁ\nBÃÄ\nBÅÆ\nBÇÈ\nBÉ\nÊ\nBË\fÌ\nBÍÎ\nBÏÐ\nBÑÒ\nBÓÔ\nBÕÖ\nB×Ø\nBÙÚ\nBÛÜ\nBÝÞ\nBß à\nBá\"â\nBã$ä\nBå&æ\nBç(è\nBé*ê\nBë,ì\nBí.î\nBï0ð\nBñ2ò\nBó4ô\nBõ6ö\nB÷8ø\nBù:ú\nBû<ü\nBý>þ\nBÿ@@\nBABB\nBCDD\nBEFF\nBGHH\nBIJJ\nBKLL\nBMNN\nBOPP\nBQRR\nBSTT\nBUVV\nBWXX\nBYZZ\nB[\\\\\nB]^^\nB_``\nBabb\nBcdd\nBeff\nBghh\nBijj\nBkll\nBmnn\nBopp\nBqrr\nBstt\nBuvv\nBwxx\nByzz\nB{||\nB}~~\nB€€\nB‚‚\nBƒ„„\nB…††\nB‡ˆˆ\nB‰ŠŠ\nB‹ŒŒ\nBŽŽ\nB\nBÀ‡" [56 byte-nth current-load-list 57 byte-symbolp 58 byte-consp 59 byte-stringp 60 byte-listp 61 byte-eq 62 byte-memq 63 byte-not 64 byte-car 65 byte-cdr 66 byte-cons 67 byte-list1 68 byte-list2 69 byte-list3 70 byte-list4 71 byte-length 72 byte-aref 73 byte-aset 74 byte-symbol-value 75 byte-symbol-function 76 byte-set 77 byte-fset 78 byte-get 79 byte-substring 80 byte-concat2 81 byte-concat3 82 byte-concat4 83 byte-sub1 84 byte-add1 85 byte-eqlsign 86 byte-gtr 87 byte-lss 88 byte-leq 89 byte-geq 90 byte-diff 91 byte-negate 92 byte-plus 93 byte-max 94 byte-min 95 byte-mult 96 byte-point 97 byte-mark-OBSOLETE 98 byte-goto-char 99 byte-insert 100 byte-point-max 101 byte-point-min 102 byte-char-after 103 byte-following-char 104 byte-preceding-char 105 byte-current-column 106 byte-indent-to 107 byte-scan-buffer-OBSOLETE 108 byte-eolp 109 byte-eobp 110 byte-bolp 111 byte-bobp 112 byte-current-buffer 113 byte-set-buffer 114 byte-read-char-OBSOLETE 115 byte-set-mark-OBSOLETE 116 byte-interactive-p 117 byte-forward-char 118 byte-forward-word 119 byte-skip-chars-forward 120 byte-skip-chars-backward 121 byte-forward-line 122 byte-char-syntax 123 byte-buffer-substring 124 byte-delete-region 125 byte-narrow-to-region 126 byte-widen 127 byte-end-of-line] 2) #@88 Byte code opcode for reference to a constant with vector index >= byte-constant-limit. (defconst byte-constant2 129 (#$ . 11243)) #@42 Byte code opcode for unconditional jump. (defconst byte-goto 130 (#$ . 11379)) #@53 Byte code opcode to pop value and jump if it's nil. (defconst byte-goto-if-nil 131 (#$ . 11464)) #@57 Byte code opcode to pop value and jump if it's not nil. (defconst byte-goto-if-not-nil 132 (#$ . 11567)) #@97 Byte code opcode to examine top-of-stack, jump and don't pop it if it's nil, otherwise pop it. (defconst byte-goto-if-nil-else-pop 133 (#$ . 11678)) #@101 Byte code opcode to examine top-of-stack, jump and don't pop it if it's non nil, otherwise pop it. (defconst byte-goto-if-not-nil-else-pop 134 (#$ . 11835)) #@65 Byte code opcode to pop a value and return it from `byte-code'. (defconst byte-return 135 (#$ . 11999)) #@51 Byte code opcode to discard one value from stack. (defconst byte-discard 136 (#$ . 12109)) #@53 Byte code opcode to duplicate the top of the stack. (defconst byte-dup 137 (#$ . 12206)) #@74 Byte code opcode to make a binding to record the buffer, point and mark. (defconst byte-save-excursion 138 (#$ . 12301)) #@75 Byte code opcode to make a binding to record entire window configuration. (defconst byte-save-window-excursion 139 (#$ . 12428)) #@88 Byte code opcode to make a binding to record the current buffer clipping restrictions. (defconst byte-save-restriction 140 (#$ . 12563)) #@87 Byte code opcode for catch. Takes, on stack, the tag and an expression for the body. (defconst byte-catch 141 (#$ . 12706)) #@93 Byte code opcode for unwind-protect. Takes, on stack, an expression for the unwind-action. (defconst byte-unwind-protect 142 (#$ . 12837)) (byte-code "ÀÁ\nBÃÄ\nBÅÆ\nBÇÈ\nBÉ\nÊ\nBË\fÌ\nBÍÎ\nBÏÐ\nBÑÒ\nBÓÔ\nBÕÖ\nB×Ø\nBÙÚ\nBÛÜ\nBÝÞ\nBß à\nBá\"â\nBã$ä\nBå&æ\nBç(è\nBé*ê\nBë,ì\nBí.î\nBï0ð\nBñ2ò\nBó4ô\nBõ6ö\nB÷8ø\nBù:ú\nBÀ‡" [143 byte-condition-case current-load-list 144 byte-temp-output-buffer-setup 145 byte-temp-output-buffer-show 146 byte-unbind-all 147 byte-set-marker 148 byte-match-beginning 149 byte-match-end 150 byte-upcase 151 byte-downcase 152 byte-string= 153 byte-string< 154 byte-equal 155 byte-nthcdr 156 byte-elt 157 byte-member 158 byte-assq 159 byte-nreverse 160 byte-setcar 161 byte-setcdr 162 byte-car-safe 163 byte-cdr-safe 164 byte-nconc 165 byte-quo 166 byte-rem 167 byte-numberp 168 byte-integerp 175 byte-listN 176 byte-concatN 177 byte-insertN] 2) #@47 Byte code opcode for reference to a constant. (defconst byte-constant 192 (#$ . 13783)) #@63 Exclusive maximum index usable in the `byte-constant' opcode. (defconst byte-constant-limit 64 (#$ . 13877)) #@42 List of byte-codes whose offset is a pc. (defconst byte-goto-ops (quote (byte-goto byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop byte-goto-if-not-nil-else-pop)) (#$ . 13992)) (byte-code "ÀÁ\nBÃÅÁ‡" [(byte-goto-if-nil byte-goto-if-not-nil) byte-goto-always-pop-ops current-load-list [nil nil nil nil nil nil nil nil byte-varref nil nil nil nil nil nil nil byte-varset nil nil nil nil nil nil nil byte-varbind nil nil nil nil nil nil nil byte-call nil nil nil nil nil nil nil byte-unbind nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil byte-nth byte-symbolp byte-consp byte-stringp byte-listp byte-eq byte-memq byte-not byte-car byte-cdr byte-cons byte-list1 byte-list2 byte-list3 byte-list4 byte-length byte-aref byte-aset byte-symbol-value byte-symbol-function byte-set byte-fset byte-get byte-substring byte-concat2 byte-concat3 byte-concat4 byte-sub1 byte-add1 byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate byte-plus byte-max byte-min byte-mult byte-point byte-mark-OBSOLETE byte-goto-char byte-insert byte-point-max byte-point-min byte-char-after byte-following-char byte-preceding-char byte-current-column byte-indent-to byte-scan-buffer-OBSOLETE byte-eolp byte-eobp byte-bolp byte-bobp byte-current-buffer byte-set-buffer byte-read-char-OBSOLETE byte-set-mark-OBSOLETE byte-interactive-p byte-forward-char byte-forward-word byte-skip-chars-forward byte-skip-chars-backward byte-forward-line byte-char-syntax byte-buffer-substring byte-delete-region byte-narrow-to-region byte-widen byte-end-of-line nil byte-constant2 byte-goto byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop byte-goto-if-not-nil-else-pop byte-return byte-discard byte-dup byte-save-excursion byte-save-window-excursion byte-save-restriction byte-catch byte-unwind-protect byte-condition-case byte-temp-output-buffer-setup byte-temp-output-buffer-show byte-unbind-all byte-set-marker byte-match-beginning byte-match-end byte-upcase byte-downcase byte-string= byte-string< byte-equal byte-nthcdr byte-elt byte-member byte-assq byte-nreverse byte-setcar byte-setcdr byte-car-safe byte-cdr-safe byte-nconc byte-quo byte-rem byte-numberp byte-integerp nil nil nil nil nil nil byte-listN byte-concatN byte-insertN nil nil nil nil nil nil nil nil nil nil nil nil nil nil byte-constant 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 nil nil nil nil nil nil] byte-code-vector [nil nil nil nil nil nil nil nil 1 nil nil nil nil nil nil nil -1 nil nil nil nil nil nil nil -1 nil nil nil nil nil nil nil 0 nil nil nil nil nil nil nil 0 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil -1 0 0 0 0 -1 -1 0 0 0 -1 0 -1 -2 -3 0 -1 -2 0 0 -1 -1 -1 -2 -1 -2 -3 0 0 -1 -1 -1 -1 -1 -1 0 -1 -1 -1 -1 1 1 0 0 1 1 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 0 0 -1 -1 0 0 -1 -1 -1 1 0 nil 1 0 -1 -1 -1 -1 -1 -1 1 0 0 0 -1 -1 -2 0 -1 0 -2 0 0 0 0 -1 -1 -1 -1 -1 -1 -1 0 -1 -1 0 0 -1 -1 -1 0 0 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 1 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 nil nil nil nil nil nil] byte-stack+-info] 2) #@57 Turns lapcode into bytecode. The lapcode is destroyed. (defalias 'byte-compile-lapcode #[(lap) "ÀÁ‰‰‰‰‰‰ \nƒ%\n@@\n@A9„4ËÌ\"ˆ‚Í=ƒI  ˆ B‚>ƒn Ï\\‰ ABÁJBBB‰ B‚:ƒ²AÐ=ƒ²Wƒ˜ T \\B‚ Ï\\ ÒÓ\"ÔÕ\"BBB‚JXƒÍ Ø\\ JBB‚ÙWƒå T J\\B‚ÚWƒ Ø\\ JÙ\\BB‚ Ï\\ ÒÓ\"ÔÕ\"JÛ\\BBB\nA‰\n„Á ƒW @‰@:ƒP@A@ AÔ Õ\" ˆÒ Ó\" ˆ A‰„,)Ÿ°.‡" [0 nil tmp rel rest patchlist bytes off op pc lap error "Non-symbolic opcode `%s'" TAG byte-goto-ops 3 byte-constant byte-constant-limit lsh -8 logand 255 byte-constant2 byte-listN 2 6 256 7] 9 (#$ . 17462)]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ B‡" [boundp byte-compile-current-form nil current-load-list byte-compile-current-file byte-compile-dest-file] 2) (defalias 'byte-compile-log '(macro . #[(format-string &rest args) "ÀÁÂÃÄÅÆÈÉ\n\"BBDEF‡" [and byte-optimize (memq byte-optimize-log (quote (t source))) let ((print-escape-newlines t) (print-level 4) (print-length 4)) byte-compile-log-1 format format-string mapcar #[(x) "9ƒ ÁD‡‡" [x prin1-to-string] 2] args] 11])) (byte-code "ÀÁ\nBÀ‡" [nil byte-compile-last-warned-form current-load-list] 2) (defalias 'byte-compile-log-1 #[(string &optional fill) "ƒ> „\nƒ5 \n=„5ÄÅÆ †Ç ƒ1 ;ƒ)È P‚2ÉÊ !P‚2Ë#!ˆÄÌ \"ˆ‚«ŠÎÏ!qˆdbˆ „U\nƒ‹ \n=„‹ ƒ`ÐÑ Ò±ˆÓ ƒlÅÔ \"‚mDZˆ ƒˆ ;ƒÈ ±ˆ‚ˆÉÊ !±ˆÕcˆÖ Ò±ˆƒªØÒ \"„ªÙÚÝÞ!ˆ*)Þ ‰‡" [noninteractive byte-compile-current-file byte-compile-last-warned-form byte-compile-current-form message format "While compiling %s%s:" "toplevel forms" " in file " " in buffer " buffer-name "" " %s" string get-buffer-create "*Compile-Log*" "\n\f\n" current-time-string "\n" "While compiling " "%s" ":\n" " " fill string-match " " 78 fill-column fill-prefix fill-paragraph nil] 7]) (defalias 'byte-compile-log-file #[nil "…. ?….ŠÂÃ!qˆdbˆÄ;ƒÅP‚#ÆÇ!PÈÉ Ê±ˆË‰)‡" [byte-compile-current-file noninteractive get-buffer-create "*Compile-Log*" "\n\f\nCompiling " "file " "buffer " buffer-name " at " current-time-string "\n" nil] 5]) (defalias 'byte-compile-warn #[(format &rest args) "ÀÁ \n# ƒÄÅ \"‡ÆÇ PÈ\"‡" [apply format args byte-compile-error-on-warn error "%s" byte-compile-log-1 "** " t] 4]) (defalias 'byte-compile-report-error #[(error-info) "ÀÂÃÄ AƒÆ‚Ç @ÈNÉ A!#P!‡" [t byte-compiler-error-flag byte-compile-log-1 "!! " format error-info "%s (%s)" "%s" error-message prin1-to-string] 7]) (defalias 'byte-compile-obsolete #[(form) "@ÁNÃ\f>ƒ!ÅÆ@\n@;ƒ\n@‚ÇÈ\n@\"#ˆ\nA†'É!)‡" [form byte-obsolete-info new obsolete byte-compile-warnings byte-compile-warn "%s is an obsolete function; %s" format "use %s instead." byte-compile-normal-call] 6]) (defalias 'byte-compile-fdefinition #[(name macro-p) "ƒ ‚ \n\f žA‰†z\f‰9ƒEÇ!ƒEK9„<K:„<„EÈK!ƒEK‰‚„UÈ!ƒU‚y:…y@É=ƒiA‚y?…y@Ê=?…y)*‡" [macro-p byte-compile-macro-environment byte-compile-function-environment list name env fn fboundp byte-code-function-p macro autoload] 3]) (defalias 'byte-compile-arglist-signature #[(arglist) "ÀÁ‰ ƒA @Æ=ƒ „:À‚: @Ç=ƒ- Aƒ:ÈÁ‚: ƒ7 T‚:\fT A‰„\n\f\n?…R ƒQ\f \\‚R\f+B‡" [0 nil restp opts args arglist &optional &rest t] 4]) (defalias 'byte-compile-arglist-signatures-congruent-p #[(old new) "@ @V†! A„A†!A…! A…!A AW?‡" [new old] 2]) (defalias 'byte-compile-arglist-signature-string #[(signature) "A„ ÁÂ@\"‡@AUƒÁÃ@\"‡ÁÄ@A#‡" [signature format "%d+" "%d" "%d-%d"] 4]) (defalias 'byte-compile-callargs-warn #[(form) "À @Â\"† À @Ã\"‰….Å\f¢Æ=ƒ \fA@‚-Ç\f!ƒ,\fÈH‚-É!\n AG \nƒz \n@W„R\nA…º \nAV…ºÌÍ @ ‰ÎUƒbÏ‚cÐ \n@WƒpÑ‚qÒÓ\n!&‚ºÔ @!†º @=†º @ž AG‰ƒ®A>†¹AB¡‚¹ @DB‰*+‡" [byte-compile-fdefinition form nil t def byte-compile-arglist-signature lambda byte-code-function-p 0 (&rest def) sig ncall byte-compile-warn "%s called with %d argument%s, but %s %s" 1 "" "s" "requires" "accepts only" byte-compile-arglist-signature-string fboundp byte-compile-current-form byte-compile-unresolved-functions n cons] 9]) (defalias 'byte-compile-arglist-warn #[(form macrop) "À A@\n\"‰ƒdÄ ¢Å=ƒ A@‚&Æ !ƒ% ÇH‚&È!ÄÉ 8!\n Ì \n\"†`ÍÎ @Ï=ƒFЂGÑ A@Ò ! ÓšƒYÔ‚ZÕÒ\n!&*‚× A@ž×‰‰‰‰…ÖÄÉ 8!ÝÞA!ß\"‰@Ÿ@@W„¯AƒÍAVƒÍÍà A@Ò!ᚃÃâ‚ÄãÒB!%ˆä\"‰-)‡" [byte-compile-fdefinition form macrop old byte-compile-arglist-signature lambda byte-code-function-p 0 (&rest def) 2 sig2 sig1 byte-compile-arglist-signatures-congruent-p byte-compile-warn "%s %s used to take %s %s, now takes %s" defun "function" "macro" byte-compile-arglist-signature-string (1 . 1) "argument" "arguments" byte-compile-unresolved-functions nil max min sig nums calls sort copy-sequence < "%s being defined to take %s%s, but was previously called with %s" (1 . 1) " arg" " args" delq] 9]) (defalias 'byte-compile-warn-about-unresolved-functions #[nil "À >ƒ€Â\fAƒtÅÅGÈ\f! Ê  ƒjÌ @@!  GÍ\\\\ A SWƒRÏ  …LÐR‚Ñ  …]ÐR GÒ\\‚ÓÔ\"ˆ,‚\fƒÓÕ\f@@\"ˆ)ʇ" [unresolved byte-compile-warnings "the end of the data" byte-compile-current-form byte-compile-unresolved-functions "The following functions are not known to be defined: " str L reverse rest nil s symbol-name 2 fill-column " " "," "\n " 4 byte-compile-warn "%s" "the function %s is not known to be defined."] 4]) (defalias 'byte-compile-constp '(macro . #[(form) "ÀÁ\nDÃÄ\nDÅBBDÆÇ\nDDCÈ\nÉBBCF‡" [cond consp form eq car ((quote quote)) not symbolp memq ((quote (nil t)))] 6])) (defalias 'byte-compile-close-variables '(macro . #[(&rest body) "ÀÁ\nBB‡" [let ((byte-compile-macro-environment (copy-alist byte-compile-initial-macro-environment)) (byte-compile-function-environment nil) (byte-compile-bound-variables nil) (byte-compile-free-references nil) (byte-compile-free-assignments nil) (byte-compile-verbose byte-compile-verbose) (byte-optimize byte-optimize) (byte-compile-compatibility byte-compile-compatibility) (byte-compile-dynamic byte-compile-dynamic) (byte-compile-dynamic-docstrings byte-compile-dynamic-docstrings) (byte-compile-warnings (if (eq byte-compile-warnings t) byte-compile-warning-types byte-compile-warnings))) body] 3])) (byte-code "ÀÁ!„ÂÁ B‡" [boundp byte-compile-warnings-point-max nil current-load-list] 2) (defalias 'displaying-byte-compile-warnings '(macro . #[(&rest body) "ÀÁÂÃÄÅÆÇBÉFÊE¯‡" [let ((byte-compile-warnings-point-max byte-compile-warnings-point-max)) (byte-compile-log-file) (or byte-compile-warnings-point-max (save-excursion (set-buffer (get-buffer-create "*Compile-Log*")) (setq byte-compile-warnings-point-max (point-max)))) unwind-protect condition-case error-info progn body (error (byte-compile-report-error error-info)) (save-excursion (set-buffer "*Compile-Log*") (if (= byte-compile-warnings-point-max (point-max)) nil (select-window (prog1 (selected-window) (select-window (display-buffer (current-buffer))) (goto-char byte-compile-warnings-point-max) (recenter 1)))))] 9])) #@130 Recompile every `.el' file in DIRECTORY that already has a `.elc' file. Files in subdirectories of DIRECTORY are processed also. (defalias 'byte-force-recompile #[(directory) "À ÂÃ#‡" [byte-recompile-directory directory nil t] 4 (#$ . 24541) "DByte force recompile (directory): "]) #@609 Recompile every `.el' file in DIRECTORY that needs recompilation. This is if a `.elc' file exists but is older than the `.el' file. Files in subdirectories of DIRECTORY are processed also. If the `.elc' file does not exist, normally the `.el' file is *not* compiled. But a prefix argument (optional second arg) means ask user, for each such `.el' file, whether to compile it. Prefix argument 0 means don't ask and compile the file anyway. A nonzero prefix argument also means ask about each subdirectory. If the third argument FORCE is non-nil, recompile every `.el' file that already has a `.elc' file. (defalias 'byte-recompile-directory #[(directory &optional arg force) "ƒÁ!\n„à ˆÄ ˆÅ!CljÈ \n \f  Î ˆ „8ŠÏÐ!qˆd )ÑŽÒÓÔˆ*ÕÖ ‰×UƒNØ‚OÙ\n×Vƒ^ÚÛ\n\"‚_Ø$,‡" [arg prefix-numeric-value noninteractive save-some-buffers force-mode-line-update expand-file-name directory 0 nil last-dir dir-count file-count directories byte-compile-warnings-point-max byte-compile-log-file get-buffer-create "*Compile-Log*" ((byte-code "ŠÀqˆ dU„Âà ÂÄp!!ˆ bˆÅÆ!ˆ!ˆ)‡" ["*Compile-Log*" byte-compile-warnings-point-max select-window selected-window display-buffer recenter 1] 5)) error-info (byte-code "ƒã@\n„ÃÄ \"ˆÅ !Ɖ‰ ƒÛÊ @ \" @Ë„\\Ì!ƒ\\Í!„\\ƒSÏ=„SÐÑÒQ!ƒÒC¤‚ÒÓ\"ƒÒÕ!„ÒÖ!‰ƒÒ×!ƒ‹„¡Ù\"‚žƒÒÏ=„¡ÐÚÒQ!ƒÒ\nƒ°„°ÃÜ\"ˆÝ!ˆ\n„¾ÃÄ \"ˆT =„Ò  T  A‰ „+A‰„Ƈ" [directories directory noninteractive message "Checking %s..." directory-files nil dest source files expand-file-name ("." ".." "RCS" "CVS") file-directory-p file-symlink-p arg 0 y-or-n-p "Check " "? " string-match emacs-lisp-file-regexp auto-save-file-name-p byte-compile-dest-file file-exists-p force file-newer-than-file-p "Compile " byte-compile-verbose "Compiling %s..." byte-compile-file file-count last-dir dir-count] 5) ((error (byte-compile-report-error error-info))) message "Done (Total of %d file%s compiled%s)" 1 "" "s" format " in %d directories"] 7 (#$ . 24830) "DByte recompile directory: \nP"]) #@218 Compile a file of Lisp code named FILENAME into a file of byte code. The output file's name is made by appending `c' to the end of FILENAME. With prefix arg (noninteractively: 2nd arg), load the file after compiling. (defalias 'byte-compile-file #[(filename &optional load) "À !\n„,ÃÀ !!‰ƒ+Å\f!ƒ+ÆÇÈÉ\f!\"!ƒ+Š\fqˆÊ ˆ)) ƒ6ÌÍ \"ˆ Ή‰‰Ï !‰ŠÔÕ!‰qˆÖ ˆ× !ˆ ØÎÜ ˆ,ÎÞ \"?… ƒ‡Ìß \"ˆà!ˆŠqˆdbˆácˆâ#ä!ƒÀÎ%&ç=„²&è=ƒµâ)êëd#ˆ)‚Ôìíîï!ƒÎð‚ÏñE\"ˆ)àp!ˆ)2ƒõ2â=„ïÆÇó \"!ƒõŠô !ˆ)5ƒÿõ!ˆâ-‡" [expand-file-name filename noninteractive get-file-buffer b buffer-modified-p y-or-n-p format "save buffer %s first? " buffer-name save-buffer byte-compile-verbose message "Compiling %s..." nil byte-compile-dest-file output-buffer input-buffer target-file byte-compile-current-file get-buffer-create " *Compiler Input*" erase-buffer insert-file-contents emacs-lisp-mode enable-local-eval default-major-mode buffer-file-name normal-mode byte-compiler-error-flag byte-compile-from-buffer "Compiling %s...done" kill-buffer "\n" t vms-stmlf-recfm file-writable-p kanji-flag system-type ms-dos windows-nt buffer-file-type write-region 1 signal file-error "Opening output file" file-exists-p "cannot overwrite file" "directory not writable or nonexistent" byte-compile-generate-call-tree "Report call tree for %s? " display-call-tree load] 6 (#$ . 26901) (byte-code "Á‰‰ƒÅÆ žAÇ=ƒÈ\f!É\f!Ê ƒ&Ì‚'Í\n Á$ +D‡" [buffer-file-name nil file-dir file-name file major-mode buffer-local-variables emacs-lisp-mode file-name-nondirectory file-name-directory read-file-name current-prefix-arg "Byte compile and load file: " "Byte compile file: "] 6)]) #@148 Compile and evaluate the current top-level form. Print the result in the minibuffer. With argument, insert value in current buffer after the form. (defalias 'compile-defun #[(&optional arg) "ŠÀ ˆÁ ˆÂÄÆÈ ˆ„\"ŠÉÊ!qˆd)ËŽÌÍÎ*!ƒ@ÑÒ!ˆÓp\"ˆÔc‚GÑÕÖ!\",‡" [end-of-defun beginning-of-defun nil byte-compile-current-file nothing byte-compile-last-warned-form eval byte-compile-warnings-point-max byte-compile-log-file get-buffer-create "*Compile-Log*" ((byte-code "ŠÀqˆ dU„Âà ÂÄp!!ˆ bˆÅÆ!ˆ!ˆ)‡" ["*Compile-Log*" byte-compile-warnings-point-max select-window selected-window display-buffer recenter 1] 5)) error-info (byte-code "ÀÁp!!‡" [byte-compile-sexp read] 3) ((error (byte-compile-report-error error-info))) value arg message "Compiling from buffer... done." prin1 "\n" "%s" prin1-to-string] 4 (#$ . 28599) "P"]) (defalias 'byte-compile-from-buffer #[(inbuffer &optional filename) "À‰‰‰‰‰‰Á‰‰À \n \fÍ!À‰‰‰Õ=ƒ;‚=ŠÜÝ!q\fÞ ˆÀ\nƒnà!\f#ˆâ#)$$å ˆ$„ˆŠÜæ!qˆd$)çŽèéêˆ. \f. ‡" [nil 0 byte-compile-output byte-compile-maxdepth byte-compile-depth byte-compile-tag-number byte-compile-variables byte-compile-constants print-level print-length case-fold-search float-output-format outbuffer copy-alist byte-compile-initial-macro-environment byte-compile-verbose byte-optimize byte-compile-compatibility byte-compile-dynamic byte-compile-dynamic-docstrings byte-compile-warnings t byte-compile-warning-types byte-compile-free-assignments byte-compile-free-references byte-compile-bound-variables byte-compile-function-environment byte-compile-macro-environment get-buffer-create " *Compiler Output*" erase-buffer filename byte-compile-insert-header inbuffer overwrite-mode-binary overwrite-mode byte-compile-warnings-point-max byte-compile-log-file "*Compile-Log*" ((byte-code "ŠÀqˆ dU„Âà ÂÄp!!ˆ bˆÅÆ!ˆ!ˆ)‡" ["*Compile-Log*" byte-compile-warnings-point-max select-window selected-window display-buffer recenter 1] 5)) error-info (byte-code "ŠqˆÁbˆÂÃwˆÄÅ!ƒÁyˆ‚m„$ÆÇ!!ˆ‚È ˆÉ ˆÃ\n)Ç" [inbuffer 1 " \n\f" nil looking-at ";" byte-compile-file-form read byte-compile-flush-pending byte-compile-warn-about-unresolved-functions byte-compile-unresolved-functions] 3) ((error (byte-compile-report-error error-info)))] 12]) (defalias 'byte-compile-insert-header #[(filename inbuffer outbuffer) "qˆ  qˆÄbˆÅƒÇ‚ÈɱˆÊËÌ!ƒ&\f†,Í ÎÏ QÐÑ ÒÔ±ˆÕ×±ˆØÚÜ=ƒLÝ‚aÞ=ƒWß‚aƒ`à‚aáƒjâ‚k×±ˆ„—ãäå\nƒ~æ‚çèéê!!ÄëO\nƒ‘ì‚’í±‚›îÔ±)‡" [inbuffer byte-compile-dynamic-docstrings dynamic-docstrings outbuffer 1 ";ELC" byte-compile-compatibility 18 19 "\n" ";;; compiled by " boundp user-mail-address user-login-name "@" system-name " on " current-time-string "\n;;; from file " filename "\n" ";;; emacs version " emacs-version ".\n" ";;; bytecomp version " byte-compile-version "\n;;; " byte-optimize source "source-level optimization only" byte "byte-level optimization only" "optimization is on" "optimization is off" "; compiled with Emacs 18 compatibility.\n" ";;; this file uses opcodes which do not exist in Emacs 18.\n" "\n(if (and (boundp 'emacs-version)\n" " (or (and (boundp 'epoch::version) epoch::version)\n" " (string-lessp emacs-version \"19.29\")))\n" " (string-lessp emacs-version \"19\")))\n" " (error \"`" prin1-to-string file-name-nondirectory -1 "' was compiled for Emacs 19.29 or later\"))\n\n" "' was compiled for Emacs 19\"))\n\n" "(or (boundp 'current-load-list) (setq current-load-list nil))\n"] 8]) (defalias 'byte-compile-output-file-form #[(form) "¢Á>ƒÂ8;ƒÃĉÅÄ@Æ=&‡ÇĉÇÄ \n \fÍÎ\"ˆÐ\"ˆ-ć" [form (defun defmacro defvar defconst autoload) 3 byte-compile-output-docform nil ("\n(" 3 ")") autoload t print-gensym print-readably print-level print-length print-escape-newlines princ "\n" outbuffer prin1] 8]) #@495 Print a form with a doc string. INFO is (prefix doc-index postfix). If PREFACE and NAME are non-nil, print them too, before INFO and the FORM but after the doc string itself. If SPECINDEX is non-nil, it is the index in FORM of the function bytecode string. In that case, we output that argument and the following argument (the constants vector) together, for lazy loading. QUOTED says that we have to put a quote before the list that represents a doc string reference. `autoload' needs that. (defalias 'byte-compile-output-docform #[(preface name info form specindex quoted) "p\nqˆÃÅ8ÇYƒL ƒLÈcˆÉA@\n8Ã\"A@\n8;ƒLA@\n8GÇVƒLA@\n8ÇHË=ƒL\f[\fƒ[\fcˆÍ\n\"ˆ@cˆÏ‰ÃÇÍ\n@\n\"ˆ\nA‰\nƒøTÔcˆ§ƒ´Uƒ´É\n@\nA@BÏ\"Ö×Ø\f\"\n\"ˆ\nA\nT)‚sA@Uƒî\fƒÖÖ׃ÍÚ‚ÎÛ\f\"\n\"ˆ‚sÃ`TÍ\n@\n\"ˆbˆÜcˆdbˆ)‚sÍ\n@\n\"ˆ‚s,Ý8cˆ)qˆ)Ç" [byte-compile-dynamic-docstrings dynamic-docstrings outbuffer nil position 1 info 0 "\n" byte-compile-output-as-comment form 42 preface prin1 name t index print-gensym print-readably print-escape-newlines " " specindex princ format "(#$ . %d) nil" quoted "'(#$ . %d)" "(#$ . %d)" "\\\n" 2] 5 (#$ . 32476)]) (defalias 'byte-compile-keep-pending #[(form &optional handler) "Á>ƒ  Ä\" ƒ3Ä ¢Ç>ƒ#È ›ƒ#Ê ˆ !ˆƒ/Ë ˆ)‚8Ì Ä\"ˆÍ‡" [byte-optimize (t source) byte-optimize-form form t handler for-effect (fset defalias) 300 byte-compile-output byte-compile-flush-pending byte-compile-discard byte-compile-form nil] 3]) (defalias 'byte-compile-flush-pending #[nil "…1ÁÂÃ\"‰¢Å=ƒÆÇ\fA\"ˆ‚!\fƒ!Ç\f!ˆÈ È\nË\fË ȉ)‡" [byte-compile-output byte-compile-out-toplevel t file form progn mapcar byte-compile-output-file-form nil byte-compile-constants byte-compile-variables 0 byte-compile-depth byte-compile-maxdepth] 4]) (defalias 'byte-compile-file-form #[(form) "À‰ :„Ä !‚D @9ƒ/ @ÅN‰ƒ/ !‰…DÆ ˆÇ !‚D È  \"‰=ƒAÄ !‚DÊ !*‡" [nil handler byte-compile-current-form form byte-compile-keep-pending byte-hunk-handler byte-compile-flush-pending byte-compile-output-file-form macroexpand byte-compile-macro-environment byte-compile-file-form] 4]) (put (quote defsubst) (quote byte-hunk-handler) (quote byte-compile-file-form-defsubst)) (defalias 'byte-compile-file-form-defsubst #[(form) "A@ žƒA@ÃÄA@\"ˆÅÆ\"!ˆÈ‡" [form byte-compile-unresolved-functions byte-compile-current-form byte-compile-warn "defsubst %s was used before it was defined" byte-compile-file-form macroexpand byte-compile-macro-environment nil] 4]) (put (quote autoload) (quote byte-hunk-handler) (quote byte-compile-file-form-autoload)) (defalias 'byte-compile-file-form-autoload #[(form) "A‰ƒ$@:ƒ@@Á=‚!@9ƒ@Â>„)„5ÃÄ8!ƒ5Ã!ˆÅ8;ƒ>‡ÆÇ\"‡" [form quote (nil t) eval 5 3 byte-compile-keep-pending byte-compile-normal-call] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put defvar byte-hunk-handler byte-compile-file-form-defvar defconst] 4) (defalias 'byte-compile-file-form-defvar #[(form) "À 8„\n !‡Ã\f>ƒ A@ BÆ 8:ƒ-Ç !‰AAÈÆ 8ÉÊ# ˆ ‡" [3 form byte-compile-keep-pending free-vars byte-compile-warnings byte-compile-bound-variables 2 copy-sequence byte-compile-top-level nil file] 6]) (put (quote require) (quote byte-hunk-handler) (quote byte-compile-file-form-eval-boundary)) (defalias 'byte-compile-file-form-eval-boundary #[(form) "À !ˆÂ Ã\"‡" [eval form byte-compile-keep-pending byte-compile-normal-call] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#‡" [put progn byte-hunk-handler byte-compile-file-form-progn prog1 prog2] 4) (defalias 'byte-compile-file-form-progn #[(form) "ÀÁ\nA\"ˆÃ‡" [mapcar byte-compile-file-form form nil] 3]) (put (quote eval) (quote byte-hunk-handler) (quote byte-compile-file-form-eval)) (defalias 'byte-compile-file-form-eval #[(form) "A@¢Á=ƒA@A@‡Â!‡" [form quote byte-compile-keep-pending] 2]) (put (quote defun) (quote byte-hunk-handler) (quote byte-compile-file-form-defun)) (defalias 'byte-compile-file-form-defun #[(form) "À Â\"‡" [byte-compile-file-form-defmumble form nil] 3]) (put (quote defmacro) (quote byte-hunk-handler) (quote byte-compile-file-form-defmacro)) (defalias 'byte-compile-file-form-defmacro #[(form) "À Â\"‡" [byte-compile-file-form-defmumble form t] 3]) (defalias 'byte-compile-file-form-defmumble #[(form macrop) "A@\nƒ\f Ä\nƒÄ‚à Jž JžÉ\nÉ \fƒA  ž„A ɉE B Ï>ƒPÑ\n\"ˆƒbÓÔ†]ÖA@#ˆƒ†Ï>ƒ~A@ž„~ØÙA@\"ˆÉ¡ˆ‚탮Ï>ƒíA@ž„íØÚ\nƒ¥Û‚¦ÜA@#ˆ‚íÝ !ƒí K¢\nƒ¿Þ‚Àß=ƒíÏ>ƒäØà\nƒÕÜ‚ÖÛA@\nƒáÛ‚âÜ$ˆ ÉB JBLˆá›‰\"@;ƒ\"£¢9ƒ\"£¢ƒ\"££¢;ƒØãA@\"ˆ)äÞAAB!%æ%!'ƒ5%¡ˆ‚? %B JBLˆá8;ƒe'¢è=ƒe'A@¢Þ=ƒe@ 'A@ABB‚#é ˆá8;„Çê+ƒyì‚zí ':„\nƒ‰î‚®ï‚®'@è=ƒ¥%'\nƒ¡ð‚®ñ‚®\nƒ­ò‚®óô'É\"':?…À5…ÀöÉ&ˆ‚ê+ƒÑì‚Òí ':„å\nƒá÷‚ø‚'@è=ƒý%'\nƒùù‚ú‚\nƒû‚üô'É\"':?…5…öÉ&ˆýþ?\"ˆÉ. ‡" [form name macrop byte-compile-macro-environment byte-compile-function-environment this-kind that-kind this-one that-one nil byte-compile-free-references byte-compile-free-assignments byte-compile-generate-call-tree byte-compile-call-tree byte-compile-current-form redefine byte-compile-warnings byte-compile-arglist-warn byte-compile-verbose message "Compiling %s... (%s)" filename "" byte-compile-initial-macro-environment byte-compile-warn "%s defined multiple times, as both function and macro" "%s %s defined multiple times in this file" "macro" "function" fboundp lambda macro "%s %s being redefined as a %s" 3 body "Probable `\"' without `\\' in doc string of %s" byte-compile-lambda new-one byte-compile-byte-code-maker code quote byte-compile-flush-pending byte-compile-output-docform byte-compile-compatibility "\n(fset '" "\n(defalias '" (" '(macro . #[" -1 "])") (" #[" -1 "]") (" '(macro " -1 ")") (" '(" -1 ")") (" (cons 'macro (" -1 "))") (" (" -1 ")") append byte-compile-dynamic 1 (" '(macro . #[" 4 "])") (" #[" 4 "]") (" '(macro " 2 ")") (" '(" 2 ")") (" (cons 'macro (" 5 "))") (" (" 5 ")") princ ")" outbuffer] 8]) (defalias 'byte-compile-output-as-comment #[(exp quoted) "`p qˆÂcˆ ƒÄ \"ˆ‚Æ \"ˆbˆÇÈÉÊ#ƒ.ËÌʉ#ˆ‚bˆÇÍÉÊ#ƒBËÎʉ#ˆ‚1bˆÇÏÉÊ#ƒVËÐʉ#ˆ‚EdbˆÏcˆbˆÑÒÓdZ\"±ˆ`dbˆqˆ)‡" [position outbuffer " " quoted prin1 exp princ search-forward "" nil t replace-match "" "" "0" "" "_" "#@" format "%d"] 6]) #@123 If FORM is a symbol, byte-compile its function definition. If FORM is a lambda or a macro, byte-compile it as a function. (defalias 'byte-compile #[(form) "Á ˆ„ŠÂÃ!qˆd)ÄŽÅÆÇ*‡" [byte-compile-warnings-point-max byte-compile-log-file get-buffer-create "*Compile-Log*" ((byte-code "ŠÀqˆ dU„Âà ÂÄp!!ˆ bˆÅÆ!ˆ!ˆ)‡" ["*Compile-Log*" byte-compile-warnings-point-max select-window selected-window display-buffer recenter 1] 5)) error-info (byte-code "À !‰‰‰ \f É=ƒ\n‚ \f 9ƒBÑ!…DK‚D‰¢Ó=‰ƒUA¢Ô=…‚ƒkÓÕ!B‚oÕ!9ƒ€Ö\"‚‚. ‡" [copy-alist byte-compile-initial-macro-environment nil byte-compile-verbose byte-optimize byte-compile-compatibility byte-compile-dynamic byte-compile-dynamic-docstrings byte-compile-warnings t byte-compile-warning-types byte-compile-free-assignments byte-compile-free-references byte-compile-bound-variables byte-compile-function-environment byte-compile-macro-environment form fboundp fun macro lambda byte-compile-lambda defalias] 13) ((error (byte-compile-report-error error-info)))] 3 (#$ . 38748)]) #@26 Compile and return SEXP. (defalias 'byte-compile-sexp #[(sexp) "Á ˆ„ŠÂÃ!qˆd)ÄŽÅÆÇ*‡" [byte-compile-warnings-point-max byte-compile-log-file get-buffer-create "*Compile-Log*" ((byte-code "ŠÀqˆ dU„Âà ÂÄp!!ˆ bˆÅÆ!ˆ!ˆ)‡" ["*Compile-Log*" byte-compile-warnings-point-max select-window selected-window display-buffer recenter 1] 5)) error-info (byte-code "À !‰‰‰ \f É=ƒ\n‚ \f Ð!. ‡" [copy-alist byte-compile-initial-macro-environment nil byte-compile-verbose byte-optimize byte-compile-compatibility byte-compile-dynamic byte-compile-dynamic-docstrings byte-compile-warnings t byte-compile-warning-types byte-compile-free-assignments byte-compile-free-references byte-compile-bound-variables byte-compile-function-environment byte-compile-macro-environment byte-compile-top-level sexp] 12) ((error (byte-compile-report-error error-info)))] 3 (#$ . 39850)]) (defalias 'byte-compile-byte-code-maker #[(fun) "ƒ\nÁ !D‡ :„ ‡ÄÆ A£ž‰ƒy >A„yÇ AAžÈÁ A@D A@É 8Ê 8¯É 8;ƒJÉ 8C‚Q…QÄC¤…tA@ƒfA@;ƒmA@‚sÁA@DC¤)‚|Á D)‡" [byte-compile-compatibility quote byte-compile-byte-code-unmake fun nil tmp byte-code interactive make-byte-code 2 3] 6]) (defalias 'byte-compile-byte-code-unmake #[(function) ":ƒ‡ÁÂ\"Ã@DÄ8…Ä8C¤Å›…-ÆÅ8…+Å›BC¤ÇA@È8É8FC¤‡" [function append nil lambda 4 5 interactive byte-code 2 3] 6]) (defalias 'byte-compile-lambda #[(fun) "A@ >…ÄÅÄÆÇ !\"\"¤AA‰ @;…+ @ A \nË ž‰\fƒµ\f @=ƒE A \fA:ƒ§\fAAƒ[ÍÎÏ\f!\"ˆ\fA@‰¢Ñ=„x¢Ò=„x¢Ó=ƒ‘A:ƒˆA‰‚z@‰‚b¢Ô=„£ËÕ\fA@!D\f)‚µ\fAƒµÍÎÏ\f!\"ˆÕÖ B×Ø#‰¢Ú=ƒï„ïÜÝÞ CA\n„Ý\f…à\nC\f…ê\fA@C$\"‚4\f…÷\fC¢Ö=ƒA‚ … C¤Ø D\n„@;ƒ1\n†- …-×CB‚3¤.‡" [fun arglist free-vars byte-compile-warnings delq &rest &optional copy-sequence byte-compile-bound-variables body doc interactive int byte-compile-warn "malformed interactive spec: %s" prin1-to-string form let let* save-excursion list byte-compile-top-level progn nil lambda compiled byte-code byte-compile-compatibility apply make-byte-code append] 8]) (defalias 'byte-compile-constants-vector #[nil "À\nŸ\fŸÆÆÉ\nÆ „ ƒe\n@ ƒX  =„X @@ž‰ƒB @A¡ˆ‚Q @ T‰¡ˆ @B A‰„%\nA\n ‰‚ÌÍÎÏ\"Ÿ\".‡" [-1 i byte-compile-variables rest byte-compile-constants other nil ret tmp (5 63 255 65535) limits limit apply vector mapcar car] 6]) (defalias 'byte-compile-top-level #[(form &optional for-effect output-type) "À‰Á‰‰ÀÉ>ƒÊ \f\"  ¢Í=ƒ6 AA„6 A@‰ ‚ ¢Î=ƒdÏ>„d A@;ƒdÐÑ 8!ƒdÒÓ 8!ƒd ‚qÔ \f\"ˆÕ\f\".‡" [nil 0 byte-compile-output byte-compile-maxdepth byte-compile-depth byte-compile-tag-number byte-compile-variables byte-compile-constants byte-optimize (t source) byte-optimize-form form for-effect progn byte-code (t byte) vectorp 2 natnump 3 byte-compile-form byte-compile-out-toplevel output-type] 7]) (defalias 'byte-compile-out-toplevel #[(&optional for-effect output-type) "ƒC @@Â=ƒ A‚CÃÄ ž?…AÆ !‰ƒ<@@9„<@@§„<A‰„#@@)!ˆÈÉÊ\"ˆ Ÿ Ì>ƒWÍ \"ÄÏ=?ĉÏ=„jÓ=ƒyÔ‚zÕ ›„jÖ ž„jÉ ž‰ƒjÆ !>AŸ‰@@×>ƒà@A@@@Ø=ƒÕ:„Ã9ƒÕÙ>„ÕƒeÚDB‰‚YB‰‚YƒeÛ›„e@@ÜN‰ƒeAƒÝ>ƒeAAƒeA@@Â=ƒeAÄŸÞ=ƒ?@¢Ú=ƒ?@A@AB‚DBCÓ=„\\ßÄàá@A\"\"?ƒeA‰‚™ƒ{â #äå !#&F)‚ŒAƒ‰çŸB‚Œ@,‡" [for-effect byte-compile-output byte-discard byte-compile-push-constant nil byte-compile-constants reverse tmp byte-compile-out byte-return 0 byte-optimize (t byte) byte-optimize-lapcode output-type lambda body maycall rest file 50 8 TAG (byte-varref byte-constant) byte-constant (nil t) quote 3 byte-opcode-invert (file progn t) funcall delq mapcar consp byte-compile-constants-vector byte-compile-vector byte-code byte-compile-lapcode byte-compile-maxdepth progn] 6]) (defalias 'byte-compile-top-level-body #[(body &optional for-effect) "ÀÁ\nB Ä#‰¢Á=ƒ\nA‡\n…\nC‡" [byte-compile-top-level progn body for-effect t] 5]) (defalias 'byte-compile-form #[(form &optional for-effect) "À \n\"‰:„2 9ƒ Ã>ƒÄ !ˆ‚£ ƒ*ƒ*Ç‚£ÈÉ \"ˆ‚£ @9ƒ| @‰\nËN\f\nÍ>ƒNÎÏ\n\"ˆ\fƒiƒa\nÑNÒN„i\f !ˆ‚xÓ>ƒtÕ !ˆÖ !ˆ*‚£× @!„‹ @¢Ø=ƒŸ Ù !‰=„ŸÚ \"ˆÇ‚£Ö !ˆ …©Û ‡" [macroexpand form byte-compile-macro-environment (nil t) byte-compile-constant for-effect byte-compile-delete-errors nil byte-compile-variable-ref byte-varref fn byte-compile handler (t nil) byte-compile-warn "%s called as a function" byte-compile-compatibility byte-opcode emacs19-opcode callargs byte-compile-warnings byte-compile-callargs-warn byte-compile-normal-call byte-code-function-p lambda byte-compile-unfold-lambda byte-compile-form byte-compile-discard] 4]) (defalias 'byte-compile-normal-call #[(form) "ƒÁ\n!ˆÃ\n@!ˆÄÅ\nA\"ˆÆÇ\nAG\"‡" [byte-compile-generate-call-tree byte-compile-annotate-call-tree form byte-compile-push-constant mapcar byte-compile-form byte-compile-out byte-call] 3]) (defalias 'byte-compile-variable-ref #[(base-op var) "9ƒ Á>ƒ) Ä=ƒÅ‚Æ9ƒ Ç‚!ÈÉ!#ˆ‚¡ÊNƒQË\f>ƒQÊN ÂÎ ;ƒI ‚NÏÐ \"#ˆ)Ñ\f>ƒ¡ Ä=ƒgB‚¡Ó!„¡>„¡ Ô=ƒ>„¡ÂÖ\"ˆB‚¡>„¡ÂØ\"ˆBž‰„µC‰BÛ \")‡" [var (nil t) byte-compile-warn base-op byte-varbind "Attempt to let-bind %s %s" "Variable reference to %s %s" "constant" "nonvariable" prin1-to-string byte-obsolete-variable obsolete byte-compile-warnings ob "%s is an obsolete variable; %s" format "use %s instead." free-vars byte-compile-bound-variables boundp byte-varset byte-compile-free-assignments "assignment to free variable %s" byte-compile-free-references "reference to free variable %s" byte-compile-variables tmp byte-compile-out] 7]) (defalias 'byte-compile-get-constant '(macro . #[(const) "ÀÁ DÄ ÅBBÆ ÇBBFÈÉÊËÌ DÍBBEDE‡" [or if stringp const assoc (byte-compile-constants) assq (byte-compile-constants) car setq byte-compile-constants cons list (byte-compile-constants)] 8])) (defalias 'byte-compile-constant #[(const) "ƒÁ‰‡ÂÃ\f;ƒÅ\f\"‚\fž†'\fCB‰@\"‡" [for-effect nil byte-compile-out byte-constant const assoc byte-compile-constants] 5]) (defalias 'byte-compile-push-constant #[(const) "À\n ƒÀ‰‚.ÃÄ\n;ƒÅ\n\"‚!\nž†-\nCB‰@\"*‡" [nil for-effect const byte-compile-out byte-constant assoc byte-compile-constants] 5]) (defalias 'byte-defop-compiler '(macro . #[(function &optional compile-handler) "À\n9ƒÃÄÅ\n!P!‚\nA@\n@ÆÇ\nDÈÇ ÊžA†3 †3ÃËÅ\n!P!DF\f ƒTÍ\fÆÇ\nDÎÇ DFÆÇ DÏÇ\nDFF‚V\f*‡" [nil opcode function intern "byte-" symbol-name put quote (quote byte-compile) compile-handler ((0 . byte-compile-no-args) (1 . byte-compile-one-arg) (2 . byte-compile-two-args) (3 . byte-compile-three-args) (0-1 . byte-compile-zero-or-one-arg) (1-2 . byte-compile-one-or-two-args) (2-3 . byte-compile-two-or-three-args)) "byte-compile-" fnform progn (quote byte-opcode) (quote byte-opcode-invert)] 8])) (defalias 'byte-defop-compiler19 '(macro . #[(function &optional compile-handler) "ÀÁ £@†ÄÅÆ ¢† !P!DÇÈFÉ \nEE‡" [progn put quote function intern "byte-" symbol-name (quote emacs19-opcode) t byte-defop-compiler compile-handler] 7])) (defalias 'byte-defop-compiler-1 '(macro . #[(function &optional compile-handler) "À ÂD E‡" [byte-defop-compiler function nil compile-handler] 3])) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÅ#ˆÀÇÂÅ#ˆÀÈÂÅ#ˆÀÉÂÅ#ˆÀÊÂË#ˆÀÌÂË#ˆÀÍÂË#ˆÀÎÂË#ˆÀÏÂÐ#ˆÀÑÒÓ#ˆÀÑÔÕ#ˆÀÕÂÑ#ˆÀÖÒÓ#ˆÀÖÔ×#ˆÀ×ÂÖ#ˆÀØÒÓ#ˆÀØÔÙ#ˆÀÙÂØ#ˆÀÚÒÓ#ˆÀÚÔÕ#ˆÀÕÂÚ#ˆÀÛÒÓ#ˆÀÛÔ×#ˆÀ×ÂÛ#ˆÀÜÒÓ#ˆÀÜÔÙ#ˆÀÙÂÜ#ˆÀÝÒÓ#ˆÀÝÔÞ#ˆÀÞÂÝ#ˆÀßÒÓ#ˆÀßÔà#ˆÀàÂß#ˆÀáÒÓ#ˆÀáÔâ#ˆÀâÂá#ˆÀãÒÓ#ˆÀãÔä#ˆÀäÂã#ˆÀåÒÓ#ˆÀåÔæ#ˆÀæÂå#ˆÀçÒÓ#ˆÀçÔè#ˆÀèÂç#ˆÀéÒÓ#ˆÀéÔê#ˆÀêÂé#ˆÀëÒÓ#ˆÀëÔì#ˆÀìÂë#ˆÀíÒÓ#ˆÀíÔî#ˆÀîÂí#ˆÀïðñ#ˆÀòÒÓ#ˆÀòÔï#ˆÀïÂò#ˆÀóðñ#ˆÀôÒõ#ˆÀôÔó#ˆÀóÂô#ˆÀöðñ#ˆÀ÷Òõ#ˆÀ÷Ôö#ˆÀöÂ÷#ˆÀøðñ#ˆÀùÒõ#ˆÀùÔø#ˆÀøÂù#ˆÀúÒû#ˆÀúÔü#ˆÀüÂú#ˆÀýÒû#ˆÀýÔþ#ˆÀþÂý#ˆÀÿÒû#ˆÀÿÔ@#ˆÀ@Âÿ#ˆÀAÒû#ˆÀAÔB#ˆÀBÂA#ˆÀCÒû#ˆÀCÔD#ˆÀDÂC#ˆÀEÒû#ˆÀEÔD#ˆÀDÂE#ˆÀFÒû#ˆÀFÔG#ˆÀGÂF#ˆÀHÒû#ˆÀHÔI#ˆÀIÂH#ˆÀJÒû#ˆÀJÔK#ˆÀKÂJ#ˆÀLÒû#ˆÀLÔM#ˆÀMÂL#ˆÀNÒû#ˆÀNÔO#ˆÀOÂN#ˆÀPÒû#ˆÀPÔQ#ˆÀQÂP#ˆÀRÒû#ˆÀRÔS#ˆÀSÂR#ˆÀTÒû#ˆÀTÔU#ˆÀUÂT#ˆÀVÒû#ˆÀVÔW#ˆÀWÂV#ˆÀXÒû#ˆÀXÔY#ˆÀYÂX#ˆÀZðñ#ˆÀ[Òû#ˆÀ[ÔZ#ˆÀZÂ[#ˆÀ\\ðñ#ˆÀ]Òû#ˆÀ]Ô\\#ˆÀ\\Â]#ˆÀ^ðñ#ˆÀ_Òû#ˆÀ_Ô^#ˆÀ^Â_#ˆÀ`ðñ#ˆÀaÒû#ˆÀaÔ`#ˆÀ`Âa#ˆÀbðñ#ˆÀcÒû#ˆÀcÔb#ˆÀbÂc#ˆÀdðñ#ˆÀeÒû#ˆÀeÔd#ˆÀdÂe#ˆÀfðñ#ˆÀgÒû#ˆÀgÔf#ˆÀfÂg#ˆÀhðñ#ˆÀiÒj#ˆÀiÔh#ˆÀhÂi#ˆÀkðñ#ˆÀlÒj#ˆÀlÔk#ˆÀkÂl#ˆÀmÒn#ˆÀmÔo#ˆÀoÂm#ˆÀpÒn#ˆÀpÔo#ˆÀoÂp#ˆÀqÒn#ˆÀqÔr#ˆÀrÂq#ˆÀsÒn#ˆÀsÔt#ˆÀtÂs#ˆÀuÒn#ˆÀuÔv#ˆÀvÂu#ˆÀwÒn#ˆÀwÔx#ˆÀxÂw#ˆÀyÒn#ˆÀyÔz#ˆÀzÂy#ˆÀ{Òn#ˆÀ{Ô|#ˆÀ|Â{#ˆÀ}Òn#ˆÀ}Ô~#ˆÀ~Â}#ˆÀÒn#ˆÀÔ€#ˆÀ€Â#ˆÀÒn#ˆÀÔ‚#ˆÀ‚Â#ˆÀƒÒn#ˆÀƒÔ„#ˆÀ„ƒ#ˆÀ…Òn#ˆÀ…Ô†#ˆÀ†Â…#ˆÀ‡Òˆ#ˆÀ‡Ô‰#ˆÀ‰Â‡#ˆÀŠðñ#ˆÀ‹Òˆ#ˆÀ‹ÔŠ#ˆÀŠÂ‹#ˆÀŠðñ#ˆÀŒÒˆ#ˆÀŒÔŠ#ˆÀŠÂŒ#ˆÀðñ#ˆÀŽÒû#ˆÀŽÔ#ˆÀÂŽ#ˆÀðñ#ˆÀÒû#ˆÀÔ#ˆÀÂ#ˆÀ‘ðñ#ˆÀ’Òû#ˆÀ’Ô‘#ˆÀ‘Â’#ˆÀ“ðñ#ˆÀ”Òû#ˆÀ”Ô“#ˆÀ“”#ˆÀ•ðñ#ˆÀ–Òn#ˆÀ–Ô•#ˆÀ•Â–#ˆÀ—ðñ#ˆÀ˜Òn#ˆÀ˜Ô—#ˆÀ—˜#ˆÀ•ðñ#ˆÀ™Òn#ˆÀ™Ô•#ˆÀ•Â™#ˆÀ—ðñ#ˆÀšÒn#ˆÀšÔ—#ˆÀ—š#ˆÀ›ðñ#ˆÀœÒn#ˆÀœÔ›#ˆÀ›Âœ#ˆÀðñ#ˆÀžÒn#ˆÀžÔ#ˆÀž#ˆÀŸðñ#ˆÀ Òn#ˆÀ ÔŸ#ˆÀŸÂ #ˆÀ¡ðñ#ˆÀ¢Òn#ˆÀ¢Ô¡#ˆÀ¡Â¢#ˆÀ£ðñ#ˆÀ¤Òn#ˆÀ¤Ô£#ˆÀ£Â¤#ˆÀ¥ðñ#ˆÀ¦Òn#ˆÀ¦Ô¥#ˆÀ¥Â¦#ˆÀ§ðñ#ˆÀ¨Òn#ˆÀ¨Ô§#ˆÀ§Â¨#ˆÀ¥ðñ#ˆÀ©Òn#ˆÀ©Ô¥#ˆÀ¥Â©#ˆÀ§ðñ#ˆÀªÒn#ˆÀªÔ§#ˆÀ§Âª#ˆÀ«ðñ#ˆÀ¬Òn#ˆÀ¬Ô«#ˆÀ«Â¬#ˆÀ­ðñ#ˆÀ®Òn#ˆÀ®Ô­#ˆÀ­Â®#ˆÀ¯ðñ#ˆÀ°Òn#ˆÀ°Ô¯#ˆÀ¯Â°#ˆÀ±ðñ#ˆÀ²Òn#ˆÀ²Ô±#ˆÀ±Â²#ˆÀ³Ò´#ˆÀ³Ôµ#ˆÀµÂ³#ˆÀ¶Ò·#ˆÀ¶Ô¸#ˆÀ¸Â¶#ˆÀ¹Ò·#ˆÀ¹Ôº#ˆÀºÂ¹#ˆÀ»Ò·#ˆÀ»Ô¼#ˆÀ¼Â»#ˆÀ½ðñ#ˆÀ¾Ò·#ˆÀ¾Ô½#ˆÀ½Â¾#ˆÀ¿ÒÀ#‡" [put byte-call byte-opcode-invert funcall byte-list1 list byte-list2 byte-list3 byte-list4 byte-listN byte-concat2 concat byte-concat3 byte-concat4 byte-concatN byte-insertN insert dot byte-compile byte-compile-no-args byte-opcode byte-point dot-max byte-point-max dot-min byte-point-min point point-max point-min following-char byte-following-char preceding-char byte-preceding-char current-column byte-current-column eolp byte-eolp eobp byte-eobp bolp byte-bolp bobp byte-bobp current-buffer byte-current-buffer interactive-p byte-interactive-p byte-widen emacs19-opcode t widen byte-end-of-line end-of-line byte-compile-zero-or-one-arg byte-forward-char forward-char byte-forward-line forward-line symbolp byte-compile-one-arg byte-symbolp consp byte-consp stringp byte-stringp listp byte-listp not byte-not null car byte-car cdr byte-cdr length byte-length symbol-value byte-symbol-value symbol-function byte-symbol-function 1+ byte-add1 1- byte-sub1 goto-char byte-goto-char char-after byte-char-after set-buffer byte-set-buffer byte-forward-word forward-word byte-char-syntax char-syntax byte-nreverse nreverse byte-car-safe car-safe byte-cdr-safe cdr-safe byte-numberp numberp byte-integerp integerp byte-skip-chars-forward skip-chars-forward byte-compile-one-or-two-args byte-skip-chars-backward skip-chars-backward eql byte-compile-two-args byte-eq eq memq byte-memq cons byte-cons aref byte-aref set byte-set = byte-eqlsign < byte-lss > byte-gtr <= byte-leq >= byte-geq get byte-get nth byte-nth substring byte-compile-two-or-three-args byte-substring byte-set-marker move-marker set-marker byte-match-beginning match-beginning byte-match-end match-end byte-upcase upcase byte-downcase downcase byte-string= string= byte-string< string< string-equal string-lessp byte-equal equal byte-nthcdr nthcdr byte-elt elt byte-member member byte-assq assq byte-setcar rplaca byte-setcdr rplacd setcar setcdr byte-buffer-substring buffer-substring byte-delete-region delete-region byte-narrow-to-region narrow-to-region byte-rem % aset byte-compile-three-args byte-aset max byte-compile-associative byte-max min byte-min + byte-plus byte-mult * interactive byte-compile-noop] 4) (defalias 'byte-compile-subr-wrong-args #[(form n) "ÀÁ\n@\nAG\nAGÃUƒÄ‚Å%ˆÇ\n!‡" [byte-compile-warn "%s called with %d arg%s, but requires %s" form 1 "" "s" n byte-compile-normal-call] 6]) (defalias 'byte-compile-no-args #[(form) "GÁU„\fÂÃ\"‡Ä@ÅNÆ\"‡" [form 1 byte-compile-subr-wrong-args "none" byte-compile-out byte-opcode 0] 3]) (defalias 'byte-compile-one-arg #[(form) "GÁU„\fÂÃ\"‡ÄA@!ˆÅ@ÆNÇ\"‡" [form 2 byte-compile-subr-wrong-args 1 byte-compile-form byte-compile-out byte-opcode 0] 3]) (defalias 'byte-compile-two-args #[(form) "GÁU„\fÂÃ\"‡ÄA@!ˆÄÃ8!ˆÅ@ÆNÇ\"‡" [form 3 byte-compile-subr-wrong-args 2 byte-compile-form byte-compile-out byte-opcode 0] 3]) (defalias 'byte-compile-three-args #[(form) "GÁU„\fÂÃ\"‡ÄA@!ˆÄÅ8!ˆÄÃ8!ˆÆ@ÇNÈ\"‡" [form 4 byte-compile-subr-wrong-args 3 byte-compile-form 2 byte-compile-out byte-opcode 0] 3]) (defalias 'byte-compile-zero-or-one-arg #[(form) "G‰ÂUƒÃÄÅ\"!‚\" ÆUƒÃ!‚\"ÇÈ\")‡" [form len 1 byte-compile-one-arg append (nil) 2 byte-compile-subr-wrong-args "0-1"] 5]) (defalias 'byte-compile-one-or-two-args #[(form) "G‰ÂUƒÃÄÅ\"!‚\" ÆUƒÃ!‚\"ÇÈ\")‡" [form len 2 byte-compile-two-args append (nil) 3 byte-compile-subr-wrong-args "1-2"] 5]) (defalias 'byte-compile-two-or-three-args #[(form) "G‰ÂUƒÃÄÅ\"!‚\" ÆUƒÃ!‚\"ÇÈ\")‡" [form len 3 byte-compile-three-args append (nil) 4 byte-compile-subr-wrong-args "2-3"] 5]) (defalias 'byte-compile-noop #[(form) "ÀÁ!‡" [byte-compile-constant nil] 2]) (defalias 'byte-compile-discard #[nil "ÀÁÂ\"‡" [byte-compile-out byte-discard 0] 3]) (defalias 'byte-compile-associative #[(form) "Aƒ/@ÁNÂA!Å @!ˆ A‰…-Å @!ˆÆ\fÇ\"ˆ A‰„È*‡ÉÊ!!‡" [form byte-opcode copy-sequence args opcode byte-compile-form byte-compile-out 0 nil byte-compile-constant eval] 4]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#ˆÀÅÆÁ#ˆÀÇÂÈ#ˆÀÇÄÉ#ˆÀÉÆÇ#ˆÀÊÂË#ˆÀÊÄÌ#ˆÀÌÆÊ#ˆÀÍÂÎ#ˆÀÍÄÏ#ˆÀÏÆÍ#ˆÀÐÂÎ#ˆÀÐÄÏ#ˆÀÏÆÐ#ˆÀÑÂÒ#ˆÀÑÄÓ#ˆÀÓÆÑ#ˆÀÔÂÕ#ˆÀÖÂ×#ˆÀØÙÚ#ˆÀÛÂÜ#ˆÀÛÄØ#ˆÀØÆÛ#ˆÀÝÙÚ#ˆÀÞÂß#ˆÀÞÄÝ#ˆÀÝÆÞ#ˆÀàÂá#‡" [put list byte-compile byte-compile-list byte-opcode byte-list byte-opcode-invert concat byte-compile-concat byte-concat fset byte-compile-fset byte-fset indent-to-column byte-compile-indent-to byte-indent-to indent-to insert byte-compile-insert byte-insert function byte-compile-function-form - byte-compile-minus byte-quo emacs19-opcode t / byte-compile-quo byte-nconc nconc byte-compile-nconc beginning-of-line byte-compile-beginning-of-line] 4) (defalias 'byte-compile-list #[(form) "AG‰ÂUƒÃÄ!‚A ÅWƒ&ÆÇA\"ˆÈÉ SHÂ\"‚A ÊWƒ> „>ÆÇA\"ˆÈÌ \"‚AÍ!)‡" [form count 0 byte-compile-constant nil 5 mapcar byte-compile-form byte-compile-out [byte-list1 byte-list2 byte-list3 byte-list4] 256 byte-compile-compatibility byte-listN byte-compile-normal-call] 4]) (defalias 'byte-compile-concat #[(form) "AG Wƒ! ÃWƒ!ÄÅA\"ˆÆÇ ÈZHÉ\"‚H ÉUƒ-ÅÊ!‚H ËWƒE\f„EÄÅA\"ˆÆÍ \"‚HÎ!)‡" [form count 1 5 mapcar byte-compile-form byte-compile-out [byte-concat2 byte-concat3 byte-concat4] 2 0 "" 256 byte-compile-compatibility byte-concatN byte-compile-normal-call] 4]) (defalias 'byte-compile-minus #[(form) "A‰„ ÁÂ!‡Ã@!ˆAƒ)A‰…-Ã@!ˆÄÅÂ\"ˆ‚ÄÆÂ\"‡" [form byte-compile-constant 0 byte-compile-form byte-compile-out byte-diff byte-negate] 3]) (defalias 'byte-compile-quo #[(form) "G‰ÂXƒÃÄ\"‚,ÅA‰@!ˆA‰…,Å@!ˆÆÇÈ\"ˆ‚)‡" [form len 2 byte-compile-subr-wrong-args "2 or more" byte-compile-form byte-compile-out byte-quo 0] 4]) (defalias 'byte-compile-nconc #[(form) "G‰ÂUƒÃÄ!‚9 ÅUƒÆA@!‚9ÆA‰@!ˆA‰…9Æ@!ˆÇÈÉ\"ˆ‚%)‡" [form len 1 byte-compile-constant nil 2 byte-compile-form byte-compile-out byte-nconc 0] 4]) (defalias 'byte-compile-fset #[(form) "À 8‰¢Å=ƒB\fA@‰¢Æ=ƒB\fAA‰@;ƒ% A @¢Ç=ƒ0 A @:ƒB @@È=„BÉÊ!ˆ*Ë !‡" [2 form nil body fn quote lambda interactive byte-code byte-compile-warn "A quoted lambda form is the second argument of fset. This is probably\n not what you want, as that lambda cannot be compiled. Consider using\n the syntax (function (lambda (...) ...)) instead." byte-compile-two-args] 3]) (defalias 'byte-compile-funarg #[(form) "À A@‰¢Ã=ƒ#\nA@¢Ä=ƒ# @Å\nAB AABB‚$ )!‡" [byte-compile-normal-call form fn quote lambda function] 5]) (defalias 'byte-compile-function-form #[(form) "À A@9ƒ A@‚!\nƒÃÄ A@!!‚!Ä A@!!‡" [byte-compile-constant form byte-compile-compatibility byte-compile-byte-code-unmake byte-compile-lambda] 4]) (defalias 'byte-compile-indent-to #[(form) "G‰ÂUƒÃA@!ˆÄÅÆ\"‚& ÇUƒ\"È!‚&ÉÊ\")‡" [form len 2 byte-compile-form byte-compile-out byte-indent-to 0 3 byte-compile-normal-call byte-compile-subr-wrong-args "1-2"] 4]) (defalias 'byte-compile-insert #[(form) "A„ ÁÂ!‡ „,GÄXƒ,ÅÆA\"ˆAAƒ'ÇÈAG\"‡ÇÉÊ\"‡ËÅÌAA\">ƒ;Í!‡A‰…WÆ@!ˆÇÉÊ\"ˆAƒ;Î ˆ‚;‡" [form byte-compile-constant nil byte-compile-compatibility 256 mapcar byte-compile-form byte-compile-out byte-insertN byte-insert 0 t consp byte-compile-normal-call byte-compile-discard] 4]) (defalias 'byte-compile-beginning-of-line #[(form) "A@:ƒA@@Á=‚A@9ƒ#A@Â>„#Ã!‡ÄÅÆA@!†.lj¨ƒ9S‚CÈÉ\"ˆÊÁDDDË\"ˆÌÍ!‡" [form quote (nil t) byte-compile-normal-call byte-compile-form forward-line eval 1 byte-compile-warn "Non-numeric arg to beginning-of-line: %s" 1- t byte-compile-constant nil] 5]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#ˆÀÈÂÉ#‡" [put setq byte-compile byte-compile-setq setq-default byte-compile-setq-default quote byte-compile-quote quote-form byte-compile-quote-form] 4) (defalias 'byte-compile-setq #[(form) "A‰ƒ. ƒ3 A@!ˆ „ AA„ ÄÅÆ\"ˆÇÈ @\"ˆ AA‰‚ÂÉ \"ˆÉ‰)‡" [form args byte-compile-form for-effect byte-compile-out byte-dup 0 byte-compile-variable-ref byte-varset nil] 4]) (defalias 'byte-compile-setq-default #[(form) "AÁ‰ƒÄÅ @D A@E\nB AA‰„ ÆÇ\nŸB!*‡" [form nil setters args set-default quote byte-compile-form progn] 4]) (defalias 'byte-compile-quote #[(form) "À A@!‡" [byte-compile-constant form] 2]) (defalias 'byte-compile-quote-form #[(form) "ÀÁ\nA@!!‡" [byte-compile-constant byte-compile-top-level form] 3]) (defalias 'byte-compile-body #[(body &optional for-effect) "AƒÁ@Â\"ˆA‰‚Á@ \"‡" [body byte-compile-form t for-effect] 4]) (defalias 'byte-compile-body-do-effect #[(body) "À \n\"ˆÃ‰‡" [byte-compile-body body for-effect nil] 3]) (put (quote byte-compile-body-do-effect) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'byte-compile-form-do-effect #[(form) "À \n\"ˆÃ‰‡" [byte-compile-form form for-effect nil] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÅÆ#ˆÀÇÅÆ#ˆÀÈÅÉ#ˆÀÊÅË#ˆÀÌÅÍ#ˆÀÎÅÏ#ˆÀÐÅÑ#ˆÀÒÅÓ#ˆÀÔÅÕ#ˆÀÖÅ×#ˆÀØÅÙ#ˆÀÚÅÙ#ˆÀÛÅÙ#ˆÀÜÅÙ#ˆÀÝÅÞ#ˆÀßÅà#‡" [put byte-compile-form-do-effect byte-optimizer byte-compile-inline-expand inline byte-compile byte-compile-progn progn prog1 byte-compile-prog1 prog2 byte-compile-prog2 if byte-compile-if cond byte-compile-cond and byte-compile-and or byte-compile-or while byte-compile-while funcall byte-compile-funcall apply byte-compile-funarg mapcar mapatoms mapconcat let byte-compile-let let* byte-compile-let*] 4) (defalias 'byte-compile-progn #[(form) "A \"ˆÄ‰)‡" [form body byte-compile-body for-effect nil] 3]) (defalias 'byte-compile-prog1 #[(form) "A@Á\n\"ˆÃ)ÄAAÅ\"‡" [form byte-compile-form for-effect nil byte-compile-body t] 3]) (defalias 'byte-compile-prog2 #[(form) "À A@Â\"ˆÃ 8À \f\"ˆÅ)Æ AAAÂ\"‡" [byte-compile-form form t 2 for-effect nil byte-compile-body] 3]) (defalias 'byte-compile-goto-if '(macro . #[(cond discard tag) "ÀÁ\nÁ ÄBBÁ ÅBBFE‡" [byte-compile-goto if cond discard ((quote byte-goto-if-not-nil) (quote byte-goto-if-not-nil-else-pop)) ((quote byte-goto-if-nil) (quote byte-goto-if-nil-else-pop)) tag] 7])) (defalias 'byte-compile-if #[(form) "À A@!ˆÂ ›„-à ŃǂÈ\f\"ˆÀÉ 8\"ˆÊ\f!ˆ)‚Zà à  ÅÇ \"ˆÀÉ 8\"ˆÅÌ\f\"ˆÊ !ˆÍ AAA\"ˆÊ\f!ˆ*Ή‡" [byte-compile-form form 3 byte-compile-make-tag donetag byte-compile-goto for-effect byte-goto-if-nil byte-goto-if-nil-else-pop 2 byte-compile-out-tag elsetag byte-goto byte-compile-body nil] 3]) (defalias 'byte-compile-cond #[(clauses) "À Á‰ A‰ƒl @‰@Æ=„'\n@¢Ç=ƒ1\n@£¢ƒ1Æ\nBÁ‰‚ AƒÈ\n@!ˆ\nA„QÉ\nƒJË‚KÌ\f\"ˆ‚À ÉÍ \"ˆÎ\nA\n\"ˆÉÏ\f\"ˆÐ !ˆ‚\nAƒŽ\n@Æ=„ŽÈ\n@!ˆÉ\nƒ‡Í‚ˆÑ\f\"ˆ\nA\nÎ\n\"ˆÁ\n)Ð\f!+‡" [byte-compile-make-tag nil clause nexttag donetag clauses t quote byte-compile-form byte-compile-goto for-effect byte-goto-if-not-nil byte-goto-if-not-nil-else-pop byte-goto-if-nil byte-compile-body byte-goto byte-compile-out-tag byte-goto-if-nil-else-pop body] 4]) (defalias 'byte-compile-and #[(form) "À A\n„ÄÅ \"ˆÇ‰)‚I\nAƒ9Å\n@!ˆÈƒ.É‚/Ê \"ˆ\nA‰‚\n@Å \"ˆÇ)Ë !*‡" [byte-compile-make-tag form args failtag t byte-compile-form for-effect nil byte-compile-goto byte-goto-if-nil byte-goto-if-nil-else-pop byte-compile-out-tag] 4]) (defalias 'byte-compile-or #[(form) "À A\n„ÄÅ \"ˆÄ‰)‚I\nAƒ9Å\n@!ˆÇƒ.È‚/É \"ˆ\nA‰‚\n@Å \"ˆÄ)Ê !*‡" [byte-compile-make-tag form args wintag nil byte-compile-form for-effect byte-compile-goto byte-goto-if-not-nil byte-goto-if-not-nil-else-pop byte-compile-out-tag] 4]) (defalias 'byte-compile-while #[(form) "À À à !ˆÄ A@!ˆÆƒÈ‚É\n\"ˆÊ AAË\"ˆÆÌ \"ˆÃ\n!ˆÍ‰*‡" [byte-compile-make-tag looptag endtag byte-compile-out-tag byte-compile-form form byte-compile-goto for-effect byte-goto-if-nil byte-goto-if-nil-else-pop byte-compile-body t byte-goto nil] 3]) (defalias 'byte-compile-funcall #[(form) "ÀÁ\nA\"ˆÃÄ\nAAG\"‡" [mapcar byte-compile-form form byte-compile-out byte-call] 3]) (defalias 'byte-compile-let #[(form) "A@‰ƒ# @:ƒ @A@!ˆ‚ÃÄ!ˆ A‰„) ÆA@! ƒIÇÈ @:ƒ> @@‚@ @\"ˆ A‰„0AA Ê  \"ˆÄ )ÌÍA@G\"*‡" [form varlist byte-compile-form byte-compile-push-constant nil byte-compile-bound-variables reverse byte-compile-variable-ref byte-varbind body byte-compile-body for-effect byte-compile-out byte-unbind] 4]) (defalias 'byte-compile-let* #[(form) "Á\nA@! ƒ3 @:„ÄÅ!ˆ‚&Æ @A@!ˆ ‰@@ ˆÇÈ @\"ˆ A‰„\f\nAA Ê  \"ˆÅ )ÌÍ\nA@G\"*‡" [byte-compile-bound-variables copy-sequence form varlist byte-compile-push-constant nil byte-compile-form byte-compile-variable-ref byte-varbind body byte-compile-body for-effect byte-compile-out byte-unbind] 4]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÁÆÇ#ˆÀÄÆÈ#ˆÀÅÆÉ#‡" [put /= byte-compile byte-compile-negated atom nlistp byte-compile-negated-op = consp listp] 4) (defalias 'byte-compile-negated #[(form) "À ! \"ˆÄ‰)‡" [byte-compile-negation-optimizer form byte-compile-form for-effect nil] 3]) (defalias 'byte-compile-negation-optimizer #[(form) "À @ÂN† ÃÄ @\" ABD‡" [not form byte-compile-negated-op error "Compiler error: `%s' has no `byte-compile-negated-op' property"] 4]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#ˆÀÈÂÉ#ˆÀÊÂË#ˆÀÌÂÍ#ˆÀÎÂÏ#ˆÀÐÂÑ#‡" [put catch byte-compile byte-compile-catch unwind-protect byte-compile-unwind-protect condition-case byte-compile-condition-case save-excursion byte-compile-save-excursion save-restriction byte-compile-save-restriction save-window-excursion byte-compile-save-window-excursion with-output-to-temp-buffer byte-compile-with-output-to-temp-buffer track-mouse byte-compile-track-mouse] 4) (defalias 'byte-compile-catch #[(form) "À A@!ˆÂÃÄ AAB \"!ˆÆÇÈ\"‡" [byte-compile-form form byte-compile-push-constant byte-compile-top-level progn for-effect byte-compile-out byte-catch 0] 4]) (defalias 'byte-compile-unwind-protect #[(form) "ÀÁ\nAAÃ\"!ˆÄÅÆ\"ˆ\nA@Ç\n\"ˆÉ)ÄÊË\"‡" [byte-compile-push-constant byte-compile-top-level-body form t byte-compile-out byte-unwind-protect 0 byte-compile-form for-effect nil byte-unbind 1] 4]) (defalias 'byte-compile-track-mouse #[(form) "ÀÁÂÃÄÅÆA!BEDD!‡" [byte-compile-form funcall quote lambda nil track-mouse byte-compile-top-level-body form] 8]) (defalias 'byte-compile-condition-case #[(form) "A@‰ƒ \nB‚\n 9„ÃÄ \"ˆÅ !ˆÅÆÇ8\"!ˆAAAÉ\n‰ ƒŽ @‰\f@‰ 9„u <ƒm Ήƒg@9„^ÉA‰„T*„uÃÑÒ !\"ˆ Ó\fA\"B\nB\n* A‰ „5Å\nŸ!ˆ*ÔÕÖ\"*‡" [form var byte-compile-bound-variables byte-compile-warn "%s is not a variable-name or nil (in condition-case)" byte-compile-push-constant byte-compile-top-level 2 for-effect nil compiled-clauses clauses clause condition t ok syms "%s is not a condition name or list of such (in condition-case)" prin1-to-string byte-compile-top-level-body byte-compile-out byte-condition-case 0] 5]) (defalias 'byte-compile-save-excursion #[(form) "ÀÁÂ\"ˆ AÅ\f\"ˆÇ)ÀÈÉ\"‡" [byte-compile-out byte-save-excursion 0 form body byte-compile-body for-effect nil byte-unbind 1] 3]) (defalias 'byte-compile-save-restriction #[(form) "ÀÁÂ\"ˆ AÅ\f\"ˆÇ)ÀÈÉ\"‡" [byte-compile-out byte-save-restriction 0 form body byte-compile-body for-effect nil byte-unbind 1] 3]) (defalias 'byte-compile-save-window-excursion #[(form) "ÀÁ\nA \"!ˆÄÅÆ\"‡" [byte-compile-push-constant byte-compile-top-level-body form for-effect byte-compile-out byte-save-window-excursion 0] 4]) (defalias 'byte-compile-with-output-to-temp-buffer #[(form) "À A@!ˆÂÃÄ\"ˆÅ AA!ˆÂÆÄ\"‡" [byte-compile-form form byte-compile-out byte-temp-output-buffer-setup 0 byte-compile-body byte-temp-output-buffer-show] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#ˆÀÈÂÇ#ˆÀÉÂÊ#ˆÀËÂÌ#ˆÀÍÂÎ#‡" [put defun byte-compile byte-compile-defun defmacro byte-compile-defmacro defvar byte-compile-defvar defconst autoload byte-compile-autoload lambda byte-compile-lambda-form defalias byte-compile-defalias] 4) (defalias 'byte-compile-defun #[(form) "ÀÁ A@DÄÅÆ AAB!!E!ˆÇ ˆÈ A@!‡" [byte-compile-two-args fset quote form byte-compile-byte-code-maker byte-compile-lambda lambda byte-compile-discard byte-compile-constant] 7]) (defalias 'byte-compile-defmacro #[(form) "ÀÁ\nA@DÃÄÅ\nAAB!!‰¢Ç=ƒ ÈÉE‚(ÁÊË!BD)EÁ\nA@DD\fÍ\f\"ˆÏ‰)‡" [fset quote form byte-compile-byte-code-maker byte-compile-lambda lambda code make-byte-code cons (quote macro) macro eval body byte-compile-body for-effect nil] 7]) (defalias 'byte-compile-defvar #[(form) "A@Á8Â8Æ>ƒ BAA…8@É=ƒ-Ê \fE‚8ËÌÍ DDÊ \fEEÊÎÏÍ DÎEE …LÐÍ DÑ FÍ DFÓ\"ˆÕ‰,‡" [form 2 3 string value var free-vars byte-compile-warnings byte-compile-bound-variables defconst setq or boundp quote current-load-list cons put (quote variable-documentation) body byte-compile-body for-effect nil] 6]) (defalias 'byte-compile-autoload #[(form) "À 8:ƒÀ 8@Â=‚À 89ƒÀ 8Ã>ƒYÄ 8:ƒ/Ä 8@Â=‚;Ä 89ƒ>Ä 8Ã>ƒYÅÄ 8!ƒYÆÅÀ 8!!„YÇÈÅ A@!\"ˆÉ !‡" [1 form quote (nil t) 5 eval fboundp byte-compile-warn "The compiler ignores `autoload' except at top level. You should \n probably put the autoload of the macro `%s' at top-level." byte-compile-normal-call] 4]) (defalias 'byte-compile-lambda-form #[(form) "ÀÁ!‡" [error "`lambda' used as function name is invalid"] 2]) (defalias 'byte-compile-defalias #[(form) "A:ƒjA@:ƒjA@@Á=ƒjA@A:ƒjA@A@9ƒjAA:ƒjÂ8:ƒjÂ8@Á=ƒjÂ8A:ƒjÂ8A@9ƒjÃA@A@Â8A@\"ˆA@A@Â8A@B\fBÅ!‡" [form quote 2 byte-compile-defalias-warn byte-compile-function-environment byte-compile-normal-call] 4]) (defalias 'byte-compile-defalias-warn #[(new alias) " ž‰…Ã\n \"‰)‡" [new byte-compile-unresolved-functions calls delq] 4]) (defalias 'byte-compile-make-tag #[nil "À T‰D‡" [TAG byte-compile-tag-number] 3]) (defalias 'byte-compile-out-tag #[(tag) " BAAƒ#\nƒAA\nU„ÃÄA@\"ˆAA‰‡A\n¡‡" [tag byte-compile-output byte-compile-depth error "Compiler bug: depth conflict at tag %d"] 3]) (defalias 'byte-compile-goto #[(opcode tag) " B\nB A >ƒ\fS‚\f¡ˆÅ=?…\fS‰‡" [opcode tag byte-compile-output byte-goto-always-pop-ops byte-compile-depth byte-goto] 3]) (defalias 'byte-compile-out #[(opcode offset) " B\nBÃ=ƒ\f Z‰‡Å=ƒƉ‡\fJH†( S[\\‰]‰‡" [opcode offset byte-compile-output byte-call byte-compile-depth byte-return nil byte-stack+-info byte-compile-maxdepth] 4]) (defalias 'byte-compile-annotate-call-tree #[(form) "À\n@ ž‰ƒ\fÅ 8>„( A\f A@B ˆ‚(\n@\fCÀE B\f ž‰ƒF\n@Æ 8>†P AA\n@Æ 8B ‚P\fÀ\n@CE B‰)‡" [nil entry form byte-compile-call-tree byte-compile-current-form 1 2] 4]) #@601 Display a call graph of a specified file. This lists which functions have been called, what functions called them, and what functions they call. The list includes all functions whose definitions have been compiled in this Emacs session, as well as all functions called by those functions. The call graph does not include macros, inline functions, or primitives that the byte-code interpreter knows about directly (eq, cons, etc.). The call tree also lists those functions which are not known to be called (that is, to which no calls have been compiled), and which cannot be invoked interactively. (defalias 'display-call-tree #[(&optional filename) "ÀÁ!ˆÂÂqˆÃ ˆÀÄ \"ˆÆ„ †/É‚/;ƒ+‚/Ê!ËÌ !ͱˆ ƒmÎ Ð=ƒHÑ‚j Ò=ƒRÓ‚j Ô=ƒ\\Õ‚j Ö=ƒfׂjØÙ \"\"ÀÁ!ˆpÚ‰‰‰‰ƒß@@\"ˆ@A@à@8áâ@@‰!„¹„µã‚'ä‚'åK‰!ƒÈæ‚'9ƒÖçè\"‚'é!ƒáê‚':„ëë‚'@ì=ƒ éA!„íAAAžƒ î‚'ï‚'íAAžƒð‚'@ñ=ƒ&ò‚'ÉçóGGGG\\$ô±ˆƒdõcˆ`ö@ƒV÷øù#‚Wú±ˆö;ü`\"ˆ)ƒƒýcˆ`ö÷øù#±ˆö;ü`\"ˆ)ôcˆA‰„ˆÀþ!ˆÚ?ƒÛ@A@„Ò@@‰ƒÒ@A\"„ÒB@Ú\"!„Ò?B?A‰„Ÿ?ƒýC;Dcˆ`÷ø?Ÿù#cˆü`\"ˆ).ÀE!‘‡" [message "Generating call tree..." "*Call-Tree*" erase-buffer "Generating call tree... (sorting on %s)" byte-compile-call-tree-sort "Call tree for " byte-compile-current-file filename "???" buffer-name " sorted on " prin1-to-string ":\n\n" sort byte-compile-call-tree callers #[(x y) "A@G A@GW‡" [x y] 2] calls #[(x y) "À 8GÀ\n8GW‡" [2 x y] 3] calls+callers #[(x y) "A@GÁ8G\\\nA@GÁ\n8G\\W‡" [x 2 y] 4] name #[(x y) "@ @™‡" [x y] 2] error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" nil p f b rest prin1 2 " " fboundp " " " " subrp " " format " ==> %s" byte-code-function-p "" "" macro byte-code " " " " "" lambda "" " (%d callers + %d calls = %d)" "\n" " called by:\n" " " mapconcat symbol-name ", " "" fill-prefix fill-region-as-paragraph " calls:\n" "Generating call tree...(finding uncalled functions...)" uncalled byte-compile-fdefinition t commandp " " "Noninteractive functions not known to be called:\n " "Generating call tree...done."] 10 (#$ . 67828) nil]) #@288 Run `byte-compile-file' on the files remaining on the command line. Use this from the command line, with `-batch'; it won't work in an interactive Emacs. Each file is processed even if an error occurred previously. For example, invoke "emacs -batch -f batch-byte-compile $emacs/ ~/*.el" (defalias 'batch-byte-compile #[nil "À B\n„\fÃÄ!ˆÅƒŠÆÇ@!!ƒzÈ@!ʼn \n‰ ƒvÌ  @\"ƒmÎ @!„mÇ @@\"‰\nƒmÏ\n!‰ ƒmÐ !ƒmÑ\n \"ƒmÒ\n!„mÓ A‰ „++‚ƒÒ@!„ƒÓA‰„ÔÕ!ˆÖ ƒ—ׂ˜Ø!)‡" [command-line-args-left current-load-list noninteractive error "`batch-byte-compile' is to be used only with -batch" nil file-directory-p expand-file-name directory-files dest source files string-match emacs-lisp-file-regexp auto-save-file-name-p byte-compile-dest-file file-exists-p file-newer-than-file-p batch-byte-compile-file t message "Done" kill-emacs 1 0] 4 (#$ . 70141)]) (defalias 'batch-byte-compile-file #[(file) "ÀÁ‡" [err (byte-code "À !ˆÂ‡" [byte-compile-file file t] 2) ((error (byte-code "À Aƒ\n‚ Ã\f @ÅNÆ A!$ˆÇ‡" [message err ">>Error occurred processing %s: %s (%s)" ">>Error occurred processing %s: %s" file error-message prin1-to-string nil] 6)))] 3]) #@212 Runs `byte-recompile-directory' on the dirs remaining on the command line. Must be used only with `-batch', and kills Emacs on completion. For example, invoke `emacs -batch -f batch-byte-recompile-directory .'. (defalias 'batch-byte-recompile-directory #[nil "À B\n„\fÃÄ!ˆ„Ń\"Æ@!ˆA‰„ÇÈ!‡" [command-line-args-left current-load-list noninteractive error "batch-byte-recompile-directory is to be used only with -batch" (".") byte-recompile-directory kill-emacs 0] 3 (#$ . 71317)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÏÐÑ\"ˆÏÒÓ\"ˆÏÔÕ\"ˆÏÖ×\"ˆÏØÙ\"ˆÏÚÛ\"ˆÏÜÝ\"ˆÏÞß\"ˆÏàá\"ˆÏâã\"ˆÏäå\"ˆÏæç\"ˆÏèé\"ˆÏêë\"ˆìí!ˆìî!‡" [make-obsolete dot point dot-max point-max dot-min point-min dot-marker point-marker buffer-flush-undo buffer-disable-undo baud-rate "use the baud-rate variable instead" compiled-function-p byte-code-function-p make-obsolete-variable auto-fill-hook auto-fill-function blink-paren-hook blink-paren-function lisp-indent-hook lisp-indent-function temp-buffer-show-hook temp-buffer-show-function inhibit-local-variables "use enable-local-variables (with the reversed sense)." unread-command-char "use unread-command-events instead. That variable is a list of events to reread, so it now uses nil to mean `no event', instead of -1." unread-command-event "use unread-command-events; which is a list of events rather than a single event." suspend-hooks suspend-hook comment-indent-hook comment-indent-function meta-flag "Use the set-input-mode function instead." executing-macro executing-kbd-macro before-change-function "use before-change-functions; which is a list of functions rather than a single function." after-change-function "use after-change-functions; which is a list of functions rather than a single function." font-lock-doc-string-face font-lock-string-face provide byte-compile bytecomp] 3) (defalias 'byte-compile-report-ops #[nil "À BÂÂqˆÃĉ‰‰ÉW…ˆÃHHÄÄ\nWƒBËÌ\"ËÍ\"‚TYƒTZHÐÑ\"cˆÒ!cˆ ƒtÓÔ !Õ±ˆÖjˆÔ!×±ˆT‰‚,‘‡" [byte-code-meter current-load-list "*Meter*" 0 nil off op n i 256 byte-nth logand 7 248 byte-constant byte-code-vector format "%-4d" symbol-name " [" int-to-string "]" 40 "\n"] 6]) emacs-19.30/lisp/c-mode.elc100666 13437 1 60050 6006027514 14063 0ustar jimbdaemon;ELC ;;; compiled by kwzh@nutrimat.gnu.ai.mit.edu on Thu Jul 27 20:28:37 1995 ;;; from file /home/gd/gnu/emacs/19.0/lisp/c-mode.el ;;; emacs version 19.29.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`c-mode.el' was compiled for Emacs 19.29 or later")) #@32 Abbrev table in use in C mode. (defvar c-mode-abbrev-table nil (#$ . 481)) (define-abbrev-table (quote c-mode-abbrev-table) nil) #@24 Keymap used in C mode. (defvar c-mode-map (make-sparse-keymap) (#$ . 616)) (byte-code "À ÂÃ#ˆÀ ÄÃ#ˆÀ ÅÆ#ˆÀ ÇÈ#ˆÀ ÉÊ#ˆÀ ËÌ#ˆÀ ÍÎ#ˆÀ ÏÐ#ˆÀ ÑÒ#ˆÀ ÓÔ#ˆÀ ÕÖ#ˆÀ ×Ø#ˆÀ ÙÚ#ˆÀ ÛÜ#ˆÀ ÝÞ #ˆÀ ßàÞà!B#ˆÀ áâ#ˆÀ ãä#ˆÀ åæ#ˆÀ çè#ˆÀ éê#ˆÀ ëì#ˆÀ íî#ˆÀ ïð#ˆÀ ñò#ˆÀ óô#ˆÀ õö#ˆÀ ÷ø#ˆùúûü#ˆùýûü#ˆùþûü#‡" [define-key c-mode-map "{" electric-c-brace "}" ";" electric-c-semi "#" electric-c-sharp-sign ":" electric-c-terminator "" mark-c-function "" indent-c-exp "a" c-beginning-of-statement "e" c-end-of-statement "" c-forward-conditional "" c-backward-conditional "" c-up-conditional "" backward-delete-char-untabify " " c-indent-command [menu-bar] make-sparse-keymap [menu-bar c] "C-mode" [menu-bar c comment-region] ("Comment Out Region" . comment-region) [menu-bar c c-macro-expand] ("Macro Expand Region" . c-macro-expand) [menu-bar c c-backslash-region] ("Backslashify" . c-backslash-region) [menu-bar c indent-exp] ("Indent Expression" . indent-c-exp) [menu-bar c indent-line] ("Indent Line" . c-indent-command) [menu-bar c fill] ("Fill Comment Paragraph" . c-fill-paragraph) [menu-bar c cpp-highlight-buffer] ("Highlight Conditionals" . cpp-highlight-buffer) [menu-bar c up] ("Up Conditional" . c-up-conditional) [menu-bar c backward] ("Backward Conditional" . c-backward-conditional) [menu-bar c forward] ("Forward Conditional" . c-forward-conditional) [menu-bar c backward-stmt] ("Backward Statement" . c-beginning-of-statement) [menu-bar c forward-stmt] ("Forward Statement" . c-end-of-statement) put comment-region menu-enable mark-active c-macro-expand c-backslash-region] 6) #@141 Display the result of expanding all C macros occurring in the region. The expansion is entirely correct because it uses the C preprocessor. (autoload (quote c-macro-expand) "cmacexp" '(#$ . 2198) t) #@40 Syntax table in use in C-mode buffers. (defvar c-mode-syntax-table nil (#$ . 2403)) (byte-code "„OÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÊ#ˆÂÌÊ#ˆÂÍÊ#ˆÂÎÊ#ˆÂÏÊ#ˆÂÐÊ#ˆÂÑÊ#ˆÂÒÓ#ˆÁ‡" [c-mode-syntax-table make-syntax-table modify-syntax-entry 92 "\\" 47 ". 14" 42 ". 23" 43 "." 45 61 37 60 62 38 124 39 "\""] 4) #@64 *Indentation of C statements with respect to containing block. (defconst c-indent-level 2 (#$ . -2716)) #@76 *Imagined indentation of a C open brace that actually follows a statement. (defconst c-brace-imaginary-offset 0 (#$ . -2826)) #@74 *Extra indentation for braces, compared with other text in same context. (defconst c-brace-offset 0 (#$ . -2958)) #@61 *Indentation level of declarations of C function arguments. (defconst c-argdecl-indent 5 (#$ . -3078)) #@77 *Offset of C label lines and case statements relative to usual indentation. (defconst c-label-offset -2 (#$ . -3187)) #@54 *Extra indent for lines not starting new statements. (defconst c-continued-statement-offset 2 (#$ . -3311)) #@117 *Extra indent for substatements that start with open-braces. This is in addition to `c-continued-statement-offset'. (defconst c-continued-brace-offset 0 (#$ . -3426)) (byte-code "ÀÁ\nBÁ‡" [(("GNU" (c-indent-level . 2) (c-argdecl-indent . 5) (c-brace-offset . 0) (c-continued-brace-offset . 0) (c-label-offset . -2) (c-continued-statement-offset . 2)) ("K&R" (c-indent-level . 5) (c-argdecl-indent . 0) (c-brace-offset . 0) (c-continued-brace-offset . -5) (c-label-offset . -5) (c-continued-statement-offset . 5)) ("BSD" (c-indent-level . 4) (c-argdecl-indent . 4) (c-brace-offset . 0) (c-continued-brace-offset . -4) (c-label-offset . -4) (c-continued-statement-offset . 4)) ("C++" (c-indent-level . 4) (c-argdecl-indent . 0) (c-brace-offset . 0) (c-continued-brace-offset . -4) (c-label-offset . -4) (c-continued-statement-offset . 4) (c-auto-newline . t)) ("Whitesmith" (c-indent-level . 4) (c-argdecl-indent . 4) (c-brace-offset . 0) (c-continued-brace-offset . 0) (c-label-offset . -4) (c-continued-statement-offset . 4))) c-style-alist current-load-list] 2) #@224 *Non-nil means automatically newline before and after braces, and after colons and semicolons, inserted in C code. If you do not want a leading newline before braces then use: (define-key c-mode-map "{" 'electric-c-semi) (defconst c-auto-newline nil (#$ . -4498)) #@142 *Non-nil means TAB in C mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. (defconst c-tab-always-indent t (#$ . -4771)) (byte-code "ÀÁ\nBÁ‡" ["case[ '/(]\\|default[ ]*:" c-switch-label-regexp current-load-list] 2) #@71 Imenu generic expression for C mode. See `imenu-generic-expression'. (defvar c-imenu-generic-expression (byte-code "ÀÁÂÉÄÅÆÇÄÈÉÊËÌÍ°ÎBBÏÁÂÐÑÒ°ÓBBD‡" [nil "^" "\\(template[ ]*<[^>]+>[ ]*\\)?" "\\([a-zA-Z0-9_:]+[ ]+\\)?" "\\(" "[a-zA-Z0-9_:]+" "\\([ ]*[*&]+[ ]*\\|[ ]+\\)" "\\)?" "[a-zA-Z0-9_:~]+" "\\|" "\\([a-zA-Z0-9_:~]*::\\)?operator" "[^a-zA-Z1-9_][^(]*" " \\)" "[ ]*([^)]*)[ \n]*[^ ;]" (6) "Class" "class[ ]+" "\\([a-zA-Z0-9_]+\\)" "[ ]*[:{]" (2)] 16) (#$ . 5062)) #@1808 Major mode for editing C code. Expression and list commands understand all C brackets. Tab indents for C code. Comments are delimited with /* ... */. Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \{c-mode-map} Variables controlling indentation style: c-tab-always-indent Non-nil means TAB in C mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. c-auto-newline Non-nil means automatically newline before and after braces, and after colons and semicolons, inserted in C code. c-indent-level Indentation of C statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. c-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. c-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to c-continued-statement-offset. c-brace-offset Extra indentation for line if it starts with an open brace. c-brace-imaginary-offset An open brace following other text is treated as if it were this far to the right of the start of its line. c-argdecl-indent Indentation level of declarations of C function arguments. c-label-offset Extra indentation for line that is a label, or case or default. Settings for K&R and BSD indentation styles are c-indent-level 5 8 c-continued-statement-offset 5 8 c-brace-offset -5 -8 c-argdecl-indent 0 8 c-label-offset -5 -8 Turning on C mode calls the value of the variable c-mode-hook with no args, if that value is non-nil. (defalias 'c-mode #[nil "À ˆÁ\n!ˆÃÅÉ\n!ˆËÌ!ˆÍP\fËÏ!ˆ\fËÐ!ˆÑËÒ!ˆÓËÔ!ˆÕËÖ!ˆ×ËØ!ˆÑËÙ!ˆÚËÛ!ˆÜËÝ!ˆÞËß!ˆàËá!ˆâ!Ëã!ˆä#Ëå!ˆæ%Ëç!ˆÑ'Ëè!ˆÑ(Ëé!ˆ*)ëì!‡" [kill-all-local-variables use-local-map c-mode-map c-mode major-mode "C" mode-name c-mode-abbrev-table local-abbrev-table set-syntax-table c-mode-syntax-table make-local-variable paragraph-start "$\\|" page-delimiter paragraph-separate paragraph-ignore-fill-prefix t fill-paragraph-function c-fill-paragraph indent-line-function c-indent-line indent-region-function c-indent-region require-final-newline outline-regexp "[^#\n ]" outline-level c-outline-level comment-start "/* " comment-end " */" comment-column 32 comment-start-skip "/\\*+ *" comment-indent-function c-comment-indent comment-multi-line parse-sexp-ignore-comments imenu-generic-expression c-imenu-generic-expression run-hooks c-mode-hook] 2 (#$ . 5559) nil]) (defalias 'c-outline-level #[nil "ŠÀÁwˆi)‡" [" " nil] 2]) (defalias 'c-comment-indent #[nil "ÀÁ!ƒ‡`ŠÂyˆÀÄ!ƒÅÆ!ˆiT‚HÀÇ!„)ÀÈ!ƒ-É‚H bˆÊËxˆ\fÂUƒCnƒC‚HiT\f]*‡" [looking-at "^/\\*" 0 opoint "[ ]*}[ ]*\\($\\|/\\*\\)" search-forward "}" "^#[ ]*endif[ ]*" "^#[ ]*else[ ]*" 7 " " nil comment-column] 2]) #@231 Like \[fill-paragraph] but handle C comments. If any of the current line is a comment or within a comment, fill the comment or the paragraph of it that point is in, preserving the comment indentation or line-starting decorations. (defalias 'c-fill-paragraph #[(&optional arg) "ÀŠÂyˆÃÀwˆÄ !…`‰)È=ƒœŠÂyˆÄÉ!)ƒœÀ\nËP\fËP\f\n ŠÂyˆo„KÄÎ!ƒKÏyˆ‚;ÄÉ!„TÐyˆÑÒ!ˆiÔÀxˆÕiÖZ×\"ØÕiZ×\"Q )Œ`ŠÐyˆÄÎ!ƒƒÐyˆ‚w`)}ˆ cˆÙ!ˆee G\\|ˆ-‚·„¿Û Ü=„¿ŠÂyˆÑ ŠÀˆ`)Ü#`)‰ƒ²ŠÂyˆÄÝ!ƒÔÑ !ˆÕi×\"‚ƒÜÐyˆÀˆiÂyˆ`ßàÜ!Ü\"ˆ`!Âyˆâ!wˆgã=ƒhä=ƒåÐ!ˆ`){ß!ˆ`Àˆ`|ˆ))\nËP\fËPÂ&\f\n ŒŠ ƒ6 bˆ‚:çè!ˆi)`)&ê×)\"ˆ*Š ƒS Ö\\bˆëìÀí#ˆÐyˆ`)}ˆŠdbˆÏyˆÄî!ƒqe`}ˆ)Ù!ˆŠebˆ&ÂVƒ‰``&\\|ˆdbˆÏyˆëìÀí#ˆÂyˆÄî!ƒ­/ð\\/Ïyˆñ`d\"ˆ).‚·Ù!ˆ*܇" [nil comment-start-place 0 " \n" looking-at comment-start-skip first-line major-mode c++-mode ".*//" paragraph-start "\\|[ ]*/\\*[ ]*$\\|[ ]*\\*/[ ]*$\\|[ /*]*$" paragraph-separate fill-prefix "[ ]*//" -1 1 re-search-forward "[ ]*//[ ]*" endcol " " make-string 2 32 "//" fill-paragraph arg calculate-c-indent t "[ ]*/\\*.*\\*/" line-width move-to-column calculate-c-indent-within-comment max-prefix-end " *" 47 42 backward-char chars-to-delete search-backward "/*" column insert-char search-forward "*/" move "[ ]*\\*/" fill-column 9999 fill-region-as-paragraph] 5 (#$ . 8597) "P"]) #@50 Insert character and correct line's indentation. (defalias 'electric-c-brace #[(arg) "À\n„AlƒAŠÃÀxˆn)„\fƒAÅ ˆÆ ˆcˆÅ ˆ\fƒ3Æ ˆ`ÈZÅ ˆŠ ƒ< TbˆÉÊ!ˆ) ƒRŠ bˆËÌ\n!!)‚WËÌ\n!!)‡" [nil insertpos arg " " c-auto-newline c-indent-line newline last-command-char 2 delete-char -1 self-insert-command prefix-numeric-value] 3 (#$ . 9938) "P"]) #@50 Insert character and correct line's indentation. (defalias 'electric-c-sharp-sign #[(arg) "ŠÀÁxˆn)ƒÁÃ\f!)‡ÅÆ\f!!‡" [" " nil c-auto-newline electric-c-terminator arg self-insert-command prefix-numeric-value] 3 (#$ . 10284) "P"]) #@50 Insert character and correct line's indentation. (defalias 'electric-c-semi #[(arg) "ƒÁ\n!‡ÃÄ\n!!‡" [c-auto-newline electric-c-terminator arg self-insert-command prefix-numeric-value] 3 (#$ . 10522) "P"]) #@50 Insert character and correct line's indentation. (defalias 'electric-c-terminator #[(arg) "À` „lƒŠÄyˆÅÀwˆgÆU†TÈ=ƒ8É\n!„8ŠËÀwˆÅÀwˆ` W)†TÌ ˆÍ` \"Ï8†SÐ8†SÑ8))„cˆÒ ˆƒsÔ „sÕ ˆ`ÖZÒ ˆŠ\nƒ|\nTbˆ×Ø!ˆ)\nƒ’Š\nbˆÙÚ !!)‚—ÙÚ !!*‡" [nil end insertpos arg 0 " " 35 last-command-char 58 looking-at c-switch-label-regexp "a-zA-Z0-9_$" beginning-of-defun parse-partial-sexp pps 3 4 5 c-indent-line c-auto-newline c-inside-parens-p newline 2 delete-char -1 self-insert-command prefix-numeric-value] 3 (#$ . 10736) "P"]) (defalias 'c-inside-parens-p #[nil "ÀÁ‡" [nil (byte-code "ŠŒ`À ˆ`}ˆdbˆÁ`ÂÃ#†efÄU*‡" [beginning-of-defun scan-lists -1 1 40] 4) ((error))] 3]) #@517 Indent current line as C code, or in some cases insert a tab character. If `c-tab-always-indent' is non-nil (the default), always indent current line. Otherwise, indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. A numeric argument, regardless of its value, means indent rigidly all the lines of the expression starting after point so that this line becomes properly indented. The relative indentation among the lines of the expression are preserved. (defalias 'c-indent-command #[(&optional whole-exp) "ƒ=Á ‰ŠƒÇyˆŠÈyˆ`)`\fWƒ.ÉÈ!ˆ`ÊÂwˆ‚) \fV…;Ë\f Ì$+‡„OŠÍÂxˆn)„OÎ ‡Á ‡" [whole-exp c-indent-line nil end beg shift-amt c-tab-always-indent 0 1 forward-sexp " \n" indent-code-rigidly "#" " " insert-tab] 5 (#$ . 11425) "P"]) #@78 Indent current line as C code. Return the amount the indentation changed by. (defalias 'c-indent-line #[nil "ÀÁ!Á‰‰d`ZÇyˆ`Á=ƒ\"È ‚âÉ=ƒ0Ê ‚âËÌ!ƒ<Ç‚âÍÁwˆ<ƒK@Ë!„dËÏ!ƒpŠÐÑ!ˆËÒ!)ƒpÑ\\]‚âËÔ!ƒˆËÕ!„ˆŠÖ ˆÈ )‚âË×!ƒ¦ËØ!„¦ŠÁuˆÙ ˆÖ ˆÈ )‚âËÚ!ƒÅËÛ!„ÅŠÜ )ƒÅŠÜ ˆÈ )‚âgÝUƒÕZ‚âgßUƒâ \\ÍÁwˆiZ‰ÇUƒd\nZ`Vƒd\nZbˆ‚ `|ˆjˆd\nZ`Vƒd\nZbˆ\f-‡" [calculate-c-indent nil pos case-fold-search shift-amt beg indent 0 current-indentation t calculate-c-indent-within-comment looking-at "[ ]*#" " " c-switch-label-regexp "[A-Za-z]" forward-sexp 1 ":" c-label-offset "else\\b" "else\\s_" c-backward-to-start-of-if "}[ ]*else\\b" "}[ ]*else\\s_" backward-sexp "while\\b" "while\\s_" c-backward-to-start-of-do 125 c-indent-level 123 c-brace-offset] 7 (#$ . 12240)]) #@182 Return appropriate indentation for current line as C code. In usual case returns an integer: the column to indent to. Returns nil if line starts inside a string, t if in a comment. (defalias 'calculate-c-indent #[(&optional parse-start) "ŠÀyˆ`Á‰‰ƒbˆ‚Ç ˆ` Wƒ1`È` À#‰A@‚É 8„=Ê 8ƒCÊ 8‚*\n„ö bˆËÁwˆgÌUƒXÀ‚*͆_e!ˆŠÎÏÁÐ#ˆÁ‰Šm„ÓÔ!„Õyˆ‚oÁÖ׈ÀyˆÓØ!)ƒ“‚òÓÚ!ƒñÓÛ!ƒñÀ•SbˆgÜUƒ¹`ÁÝÞˆßÁwˆ‚¤` Wƒñgà>„ñbˆÀyˆ„çáâã#ƒçáäã#?‰ƒÑ„ñ‚òÀ+‚*\nfÌU„\nTbˆi‚* bˆÍ\n!ˆhå=„+hæ=ƒB`çZfè=„+`çZfzé>ƒBhå=ƒ8êuˆë\n!ˆÀyˆÍ\n!ˆ‚\f`Á,-,„…Àyˆoƒ^`-ã‰,‚JŠêuˆhîU)ƒoêuˆ‚HgïUƒ~êuˆ`-‚Hã‰,ƒM-bˆ*hð>„ÀŠ bˆËÁwˆgñU)„Àë\n!ˆ2iŠ bˆËÁwˆg)Ì=ƒº3‚»À\\\\‚*\nbˆŠÕuˆÀ4õÁwˆÓö!ƒgïUƒàÕyˆ‚Êg÷UƒòçuˆáäÁÐ#ˆ‚ÊŠÁˆ`4)áø!ˆ‚Ê` W…$4`Vƒù :Z‚igÌUƒ\";‚#ÀZ*†*ü -‡" [0 nil containing-sexp state case-fold-search indent-point parse-start beginning-of-defun parse-partial-sexp 3 4 " " 123 c-backward-to-noncomment re-search-backward "^[^ \f \n#]" move lim comment looking-at " *[({}#/]" 1 (backward-sexp 1) ((error)) "DEFUN\\b" c-argdecl-indent "\\sw\\|\\s_" "[^\"\n=(]*(" 40 (forward-sexp 1) ((error)) " \f" (44 59) search-forward "/*" t "*/" 44 58 2 39 (119 95) -1 c-backward-to-start-of-continued-exp stop found 92 35 (0 44 59 125 123) 125 c-continued-statement-offset c-continued-brace-offset colon-line-end " \n" "#\\|/\\*\\|case[ \n'/(].*:\\|[a-zA-Z0-9_$]*:" 47 ":" current-indentation c-label-offset c-brace-offset calculate-c-indent-after-brace] 5 (#$ . 13062)]) #@121 Return the proper C indent for the first line after an open-brace. This function is called with point before the brace. (defalias 'calculate-c-indent-after-brace #[nil "nƒÁUƒ\n \\‚ÄÅxˆnƒÁ‚hÇ=ƒ)ÈÉ!ˆÊ \\\\‡" [c-indent-level 0 c-brace-offset c-continued-statement-offset " " nil c-brace-imaginary-offset 41 forward-sexp -1 current-indentation] 4 (#$ . 14584)]) #@204 Return the indentation amount for line inside a block comment. Optional arg AFTER-STAR means, if lines in the comment have a leading star, return the indentation of the text that would follow this star. (defalias 'calculate-c-indent-within-comment #[(&optional after-star) "À‰ŠÃyˆÄÀwˆgÅUÆÀxˆ`ÃyˆÄÀwˆƒ,ÈÉ!ƒ,ÊË!ˆÊÌ\nÍ#ƒB ƒB„BÔTbˆÈÎ!ƒShÅUƒSiT‚Ti+‡" [nil star-start end 0 " " 42 " \n" after-star looking-at "\\*" re-search-forward "\\*[ ]*" "/\\*[ ]*" t "[ ]*$"] 4 (#$ . 14965)]) (defalias 'c-backward-to-noncomment #[(lim) "À‰ ?…IÃ\fxˆ``\fÅ\\Yƒ+ŠÆuˆÇÈ!)ƒ+ÉÊ\fË#ˆ‚`\fX†>ŠÌyˆÍÀwˆÇÎ!)?‰„Ìyˆ‚*‡" [nil stop opoint " \n\f" lim 2 -2 looking-at "\\*/" search-backward "/*" move 0 " " "#"] 5]) (defalias 'c-backward-to-start-of-continued-exp #[(lim) "hÀ>ƒ\nÁÂ!ˆÃyˆ`\fXƒ\fTbˆÅÆw‡" [(41 34) forward-sexp -1 0 lim " " nil] 2]) #@50 Move to the start of the last "unbalanced" `if'. (defalias 'c-backward-to-start-of-if #[(&optional limit) "„ ŠÁ ˆ`)ÂÃo?…Q ÆU?…QÇÂ!ˆÈÉ!ƒ1ÈÊ!„1 T‚ÈË!ƒCÈÌ!„C S‚`WƒÆbˆ‚*‡" [limit beginning-of-defun 1 nil case-fold-search if-level 0 backward-sexp looking-at "else\\b" "else\\s_" "if\\b" "if\\s_"] 2 (#$ . 15825)]) #@117 If point follows a `do' statement, move to beginning of it and return t. Otherwise return nil and don't move point. (defalias 'c-backward-to-start-of-do #[(&optional limit) "„ ŠÁ ˆ`)Â`Ã\f„k`ÃÈɈ\f„gÊË!ƒ-Ì‚gŠÍÎ!ˆ„=hÏU†SÐуQhÏU„QÒ‚RÎ$)ƒ\\Ó‚gÃ`WƒgÓ)‚\fÌ=ƒu‚y bˆÃ+‡" [limit beginning-of-defun t nil done startpos first next-start (backward-sexp 1) ((error (byte-code "ÀÀ‡" [fail done] 1))) looking-at "do\\b" succeed forward-sexp 1 125 search-forward ";" 2 fail] 6 (#$ . 16165)]) #@305 Go to the beginning of the innermost C statement. With prefix arg, go back N - 1 statements. If already at the beginning of a statement then go to the beginning of the preceding one. If within a string or comment, or next to a comment (only whitespace between), move by sentences instead of statements. (defalias 'c-beginning-of-statement #[(count) "`ÀŠÃ ˆÄ`\nÀ‰$)Å 8„6Æ 8„6ÇÈ P!„6ŠÊÀxˆ`ËZbˆÇÌ!)ƒ>Í[!‚dÏVƒQÐ ˆS‰‚@ÏW…dÑ ˆT‰‚S*‡" [nil state here beginning-of-defun parse-partial-sexp 3 4 looking-at "[ ]*" comment-start-skip " " 2 "\\*/" forward-sentence count 0 c-beginning-of-statement-1 c-end-of-statement-1] 6 (#$ . 16689) "p"]) #@224 Go to the end of the innermost C statement. With prefix arg, go forward N - 1 statements. Move forward to end of the next statement if already at end. If within a string or comment, move by sentences instead of statements. (defalias 'c-end-of-statement #[(count) "À [!‡" [c-beginning-of-statement count] 2 (#$ . 17357) "p"]) (defalias 'c-beginning-of-statement-1 #[nil "`ÀÃÄÅ*‡" [t first last-begin nil (byte-code "o„ÀÁ!ˆ\n„ÃÄ Æ#„`Ç‚ b‡" [backward-sexp 1 first re-search-forward "[;{}]" last-begin t nil] 4) ((error (byte-code "ƒÁÂ!‡ b‡" [first backward-up-list 1 last-begin] 2)))] 3]) (defalias 'c-end-of-statement-1 #[nil "ÀÁ‡" [nil (byte-code "m„`ÁÂ!ˆ`ŠbˆÄÅ Æ#+ƒÇÈ!ˆÂu‡" [beg forward-sexp 1 end re-search-forward "[;{}]" t re-search-backward "[;}]"] 4) ((error (byte-code "`ÁÂ!ˆ`bˆÄÅ Æ#*‡" [beg backward-up-list -1 end search-forward ";" move] 4)))] 3]) #@52 Put mark at end of C function, point at beginning. (defalias 'mark-c-function #[nil "À`!ˆÁ ˆÀ`ÂÃ#ˆÄ ˆÅ ‡" [push-mark end-of-defun nil t beginning-of-defun backward-paragraph] 4 (#$ . 18248) nil]) #@53 Indent each line of the C grouping following point. (defalias 'indent-c-exp #[(&optional endpos) "ÀC` ƒ$ÀŠÅuˆÆ ˆ`)\fŒ\f`}ˆÀÇÈ*‚%`C À\nÀ À\fÀ ÀÀÀÀÀÀÀÀÀ׊ÙÅ!ˆ)Š`ÛŠÀˆ`)Ý#ƒšŠ×”bˆÞÀxˆn)„šß`À‰% á 8?…â 8?)ƒšã ˆ×yˆ*ŠÀ\fm?…c ƒ®` W‚±\f?…cÀ  „,mƒË݉\f„,ß`Àˆ`À‰%‰@AA@ƒùAA@×YƒùAA@ä8„å8ƒ\næ ˆá8„ä8„å8ƒ%Åyˆ‚»Ý‰ ƒÀ ƒ]×Wƒ]ç ÀC\"ç ÀC\" TTè›è8T ˆ‚0 ?…f×X‰\f„Ÿè8Vƒ‡ A A S‰‚nU„’ÀWƒ­À BÀ B T‰‚” @„Å A@†ÃŠÙé!ˆ`) ˆÅyˆÞÀwˆl„Ÿ ƒÚ` Y„Ÿ @ƒæ @×Y„!À* @fëUƒŠ @bˆì *)‚í @ƒ\f @[‚ \n!**Ý=ƒî * * ˆ) @fëU„1 @‚¼Š`ïð!…?ïñ!?gëUïò!…Pïó!?gôUƒ_ @‚»õ\n!ˆhö>„„÷ @!ˆ8iƒ|9‚}×\\\\‚»ƒ”ú\n!ˆû ‚»ƒ¦ü\n!ƒ¦û ‚»hý=ƒ·bˆí ‚» @)ï>!„×ïÿ!ƒàŠÙÅ!ˆï@!)ƒàÅA\\]gôUƒíBZgëUƒi×UƒÿׂC\\lƒ ×iU„'gDU„'`×yˆ`|ˆjˆï!„ŸŠ`ÛŠÀˆ`)Ý#ƒ_ß`À‰% á 8?…Xâ 8?)ƒ_ã ˆ*‚Ÿ.‡" [nil indent-stack opoint endpos funbeg 1 beginning-of-defun (byte-code "ŠÀÁ!ˆ`)‡" [backward-up-list 1] 2) ((error (byte-code "`‡" [funbeg opoint] 1))) contain-stack case-fold-search restart outer-loop-done inner-loop-done state ostate this-indent last-sexp at-else at-brace at-while last-depth this-point 0 next-depth forward-sexp beg re-search-forward comment-start-skip t " " parse-partial-sexp new-state 3 5 indent-for-comment 4 7 c-indent-line append 6 -1 val 123 calculate-c-indent-after-brace calculate-c-indent calculate-c-indent-within-comment looking-at "else\\b" "else\\s_" "while\\b" "while\\s_" 125 c-backward-to-noncomment (0 44 59 125 58 123) c-backward-to-start-of-continued-exp c-continued-statement-offset c-continued-brace-offset c-backward-to-start-of-if current-indentation c-backward-to-start-of-do 44 c-switch-label-regexp "[A-Za-z]" ":" c-label-offset c-indent-level c-brace-offset 35] 7 (#$ . 18450) nil]) (defalias 'indent-c-find-real-comment #[nil "À „4 ŠÀˆ`)Ä#ƒ4ÅŠÆyˆ`)`À‰%É8?…/Ê8?)‚ )‡" [nil win re-search-forward comment-start-skip t parse-partial-sexp 0 state state-1 3 5] 6]) (defalias 'c-indent-region #[(start end) "ŠbˆÁÂwˆÃyˆÄ !Ænƒ¦m„¦`Wƒ¦É ‰‰\n \f ŠÃyˆÎÏ!)ƒ@Ðyˆ‚¢ŠŠÐyˆ`\f)Ãyˆ`\fWƒ_ÂÑÒˆÁÂwˆ‚L\nƒo\nbˆÓÐ!ˆ` )\nƒ”\n\fVƒ”\nXƒ” \fWƒ”Ô ˆ\nbˆ\nƒŸ\n‰“ˆÐyˆ,‚‰“+‡" [start " \n" nil 0 copy-marker end t c-tab-always-indent endmark c-indent-line sexpend sexpbeg nextline shift-amt looking-at "[ ]*#" 1 (byte-code "ÀÁ!ˆÂ À‡" [forward-sexp 1 point-marker sexpend] 2) ((error (byte-code "À\nb‡" [nil sexpend nextline] 1))) backward-sexp indent-c-exp] 4]) #@304 Set C-mode variables to use one of several different indentation styles. The arguments are a string representing the desired style and a flag which, if non-nil, means to set the style globally. (Interactively, the flag comes from the prefix argument.) Available styles are GNU, K&R, BSD and Whitesmith. (defalias 'set-c-style #[(style &optional global) "À \n\"A‰„ÄÅ \"ˆ ….„Ç @@!ˆ @@ @ALˆ A‰„È)‡" [assoc style c-style-alist vars error "Invalid C indentation style `%s'" global make-local-variable nil] 4 (#$ . 21094) (list (let ((completion-ignore-case t)) (completing-read "Use which C indentation style? " c-style-alist nil t)) current-prefix-arg)]) #@67 *Minimum column for end-of-line backslashes of macro definitions. (defvar c-backslash-column 48 (#$ . -21762)) #@468 Insert, align, or delete end-of-line backslashes on the lines in the region. With no argument, inserts backslashes and aligns existing backslashes. With an argument, deletes the backslashes. This function does not modify the last line of the region if the region ends right at the start of the following line; it does not modify blank lines at the start of the region. So you can put the region around an entire macro definition and conveniently use this command. (defalias 'c-backslash-region #[(from to delete-flag) "Šbˆ   Æ“ˆ„4` Wƒ4ƈhÈUƒ)ÉuˆÊÆxˆ\fiT]Ëyˆ‚\f\f¦ÍVƒV\f\fÉ\\\\\f¥\f_‰Ï WƒU)bˆ` WƒilƒiËyˆ‚Y` WƒŠËyˆ` W)ƒ„†Ð\f!ˆ‚‰Ñ ˆËyˆ‚i Ɖ“+‡" [from c-backslash-column make-marker endmark column to nil delete-flag 92 -1 " " 1 tab-width 0 adjusted window-width c-append-backslash c-delete-backslash] 4 (#$ . 21880) "r\nP"]) (defalias 'c-append-backslash #[(column) "ÀˆhÁUƒÂuˆÃ ˆ\fj‡\fjˆÅc‡" [nil 92 -1 delete-horizontal-space column "\\"] 2]) (defalias 'c-delete-backslash #[nil "Àˆn†ÁuˆÂÃ!…`TÄÀxˆ`|‡" [nil -1 looking-at "\\\\" " "] 3]) #@327 Move back to the containing preprocessor conditional, leaving mark behind. A prefix argument acts as a repeat count. With a negative argument, move forward to the end of the containing preprocessor conditional. When going backwards, `#elif' is treated like `#else' followed by `#if'. When going forwards, `#elif' is ignored. (defalias 'c-up-conditional #[(count) "À [Â\"‡" [c-forward-conditional count t] 3 (#$ . 22973) "p"]) #@184 Move back across a preprocessor conditional, leaving mark behind. A prefix argument acts as a repeat count. With a negative argument, move forward across a preprocessor conditional. (defalias 'c-backward-conditional #[(count &optional up-flag) "À [\n\"‡" [c-forward-conditional count up-flag] 3 (#$ . 23407) "p"]) #@188 Move forward across a preprocessor conditional, leaving mark behind. A prefix argument acts as a repeat count. With a negative argument, move backward across a preprocessor conditional. (defalias 'c-forward-conditional #[(count &optional up-flag) "ÁV‰ƒ\f Ä\nƒÆ‚Ç` Ê ŠÁU„Ô\fƒ/Á‚0ÃÊ Š „ºÏÊÐ#ƒºÁyˆÑÒ!ƒ°ÁyˆÑÔ!ƒc \\‚€ÑÕ!ƒz\nƒ€ÁUƒ€` ‚€ ZÁWƒ›Wƒ›Ö\nƒ˜×‚™Ø!ˆ\nƒ¢ÄyˆÁWƒ¬` )‚6\nƒ6ʈ‚6) „ÄÖÙ!ˆ ‰ bˆ* \\‰‚!)Ú ˆ b-‡" [count 0 forward -1 1 increment re-search-forward re-search-backward search-function opoint nil new up-flag found depth "#[ ]*\\(if\\|elif\\|endif\\)" t looking-at "^[ ]*#[ ]*\\(if\\|elif\\|endif\\)" prev "[ ]*#[ ]*endif" "[ ]*#[ ]*elif" error "No following conditional at this level" "No previous conditional at this level" "No containing preprocessor conditional" push-mark] 5 (#$ . 23729) "p"]) emacs-19.30/lisp/cal-dst.elc100666 13437 1 26123 6032173523 14252 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Sep 27 03:03:31 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/cal-dst.el ;;; emacs version 19.29.12. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cal-dst.el' was compiled for Emacs 19.29 or later")) (require (quote calendar)) #@49 Cache for result of calendar-current-time-zone. (defvar calendar-current-time-zone-cache nil (#$ . 507)) #@49 Absolute date of starting date of system clock. (defvar calendar-system-time-basis (byte-code "ÀÀ‰AA@)S ‰‰@) ‰A@) ‰AA@)\f SÆ_\\ ÈVƒ] É_Ê\\Ë¥Z ‰ɦÌU…T ͦÌU?†T ΦÌU)ƒ]T-\nÏ_\nÉ¥\nÍ¥[\nÎ¥\\\\\\\\*‡" [(1 1 1970) date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365] 7) (#$ . 618)) #@389 Absolute local date of time X; local time is UTC-DIFF seconds from UTC. X is (HIGH . LOW) or (HIGH LOW . IGNORED) where HIGH and LOW are the high and low 16 bits, respectively, of the number of seconds since 1970-01-01 00:00:00 UTC, ignoring leap seconds. Returns the pair (ABS-DATE . SECONDS) where SECONDS after local midnight on absolute date ABS-DATE is the equivalent moment to X. (defalias 'calendar-absolute-from-time #[(x utc-diff) "@A \n§ƒ\n‚\n@\\Å Æ\"Ç_È\fÉ\"\\\n È Æ\"Ç_È\nÆ\"\\\\Å\nÆ\"É_Å\fÉ\"\\,B‡" [x h xtail utc-diff l mod 675 512 floor 128 u calendar-system-time-basis] 5 (#$ . 947)]) #@315 Time of absolute date ABS-DATE, S seconds after midnight. Returns the pair (HIGH . LOW) where HIGH and LOW are the high and low 16 bits, respectively, of the number of seconds 1970-01-01 00:00:00 UTC, ignoring leap seconds, that is the equivalent moment to S seconds after midnight UTC on absolute date ABS-DATE. (defalias 'calendar-time-from-absolute #[(abs-date s) " ZÃ\nÄ\"Å_ÆÈ\"\\ \nÆ\nÄ\"Å_Æ Ä\"\\\\à Ä\"È_ÃÈ\"\\*B‡" [abs-date calendar-system-time-basis a mod 512 163 floor s 128 u] 5 (#$ . 1570)]) #@181 Return the time of the next time zone transition after TIME. Both TIME and the result are acceptable arguments to current-time-zone. Return nil if no such transition can be found. (defalias 'calendar-next-time-zone-transition #[(time) "ÀÂÄ !‰@È È\n Ì  =ƒA @ @ _\\ÎB Ä !‰\n@  A‰ „…Ç …Ç =?…Ç A @§ƒe‚h@BÈA A\\@ @ ¥\\\\ÔÕ\"Z×¥ _ ¦\\×¥B+š„ÄÄ!@ =ƒ¼ ‚n‰‚p +.‡" [65536 base 120 quarter-multiple current-time-zone time time-zone time-utc-diff nil hi hi-zone hi-utc-diff (2 1 3) quarters 0 tail lo probe lsum hsum logand 1 hsumodd 2] 5 (#$ . 2091)]) #@220 Return daylight transition rule for ABS-DATE, UTC-DIFF sec offset from UTC. ABS-DIFF must specify a day that contains a daylight savings transition. The result has the proper form for calendar-daylight-savings-starts'. (defalias 'calendar-time-zone-daylight-rules #[(abs-date utc-diff) "À ! æ\n‰@)\n‰A@)\n‰AA@) ‰ ÊUƒP‰˦ÌU…HͦÌU?†HΦÌU)ƒPÏ‚UÐ SH*ÒÓ ÈFCÔW…oÕÖ\f ȯCÃZV…Õ×\f ȯCØÊÚZ]SÔZ^T‰Yƒ¯ÕÖ\f ȯB‚))$×ZTØ  @‰!@Õ=ƒÞâã!AB!‚w!@À=ƒïâ!A@!‚wâ!!‰$‰‰AA@)S%\n‰‰@) \n‰A@)&\n‰AA@)& Sç_\\( ÊVƒ^( Ë_é\\ê¥Z(‰˦ÌU…UͦÌU?†UΦÌU)ƒ^(T((-%ë_%Ë¥%Í¥[%Î¥\\\\\\\\+ìí\n\"!ìí\nT\"!š„’!B A‰ *„ȃ§Ÿ‚«@CTA*„Á@. ‡" [calendar-gregorian-from-absolute abs-date date 7 weekday m d y year month 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] last append list 8 calendar-nth-named-day 1 -1 nil l 6 j candidate-rules utc-diff prevday-sec new-rules rules rule eval calendar-nth-named-absday g prior-years day 31 day-of-year 23 10 365 current-time-zone calendar-time-from-absolute] 11 (#$ . 2732)]) #@1367 Return UTC difference, dst offset, names and rules for current time zone. Returns (UTC-DIFF DST-OFFSET STD-ZONE DST-ZONE DST-STARTS DST-ENDS DST-STARTS-TIME DST-ENDS-TIME), based on a heuristic probing of what the system knows: UTC-DIFF is an integer specifying the number of minutes difference between standard time in the current time zone and Coordinated Universal Time (Greenwich Mean Time). A negative value means west of Greenwich. DST-OFFSET is an integer giving the daylight savings time offset in minutes. STD-ZONE is a string giving the name of the time zone when no seasonal time adjustment is in effect. DST-ZONE is a string giving the name of the time zone when there is a seasonal time adjustment in effect. DST-STARTS and DST-ENDS are sexps in the variable `year' giving the daylight savings time start and end rules, in the form expected by `calendar-daylight-savings-starts'. DST-STARTS-TIME and DST-ENDS-TIME are integers giving the number of minutes after midnight that daylight savings time starts and ends. If the local area does not use a seasonal time adjustment, STD-ZONE and DST-ZONE are equal, and all the DST-* integer variables are 0. Some operating systems cannot provide all this information to Emacs; in this case, `calendar-current-time-zone' returns a list containing nil for the data it can't find. (defalias 'calendar-current-time-zone #[nil "†ÂÁ Ã\n!‰@\fA@ „%lj‰Ç‰‰‰¯‚¿È\n!‰ …2È !‰\n„H ˥̉lj̉¯‚¾Ã !‰ @ A@Ð \"Ð\n\"Ó@ \"Ó@\"AË¥AË¥ ^贯 Z!Ë¥ Wƒ¬¯‚º¯. BB*,‰‡" [calendar-current-time-zone-cache current-time t0 current-time-zone t0-zone t0-utc-diff t0-name nil calendar-next-time-zone-transition t1 t2 60 0 t1-zone t1-utc-diff t1-name calendar-absolute-from-time t1-date-sec t2-date-sec calendar-time-zone-daylight-rules t1-rules t2-rules t1-time t2-time abs] 9 (#$ . 3878)]) (calendar-current-time-zone) #@191 *Number of minutes difference between local standard time at `calendar-location-name' and Coordinated Universal (Greenwich) Time. For example, -300 for New York City, -480 for Los Angeles. (defvar calendar-time-zone (byte-code "@†Á‡" [calendar-current-time-zone-cache -300] 1) (#$ . -5846)) #@141 *Number of minutes difference between daylight savings and standard time. If the locale never uses daylight savings time, set this to 0. (defvar calendar-daylight-time-offset (byte-code "A@†Á‡" [calendar-current-time-zone-cache 60] 1) (#$ . -6148)) #@130 *Abbreviated name of standard time zone at `calendar-location-name'. For example, "EST" in New York City, "PST" for Los Angeles. (defvar calendar-standard-time-zone-name (byte-code "AA@†Á‡" [calendar-current-time-zone-cache "EST"] 1) (#$ . -6410)) #@138 *Abbreviated name of daylight-savings time zone at `calendar-location-name'. For example, "EDT" in New York City, "PDT" for Los Angeles. (defvar calendar-daylight-time-zone-name (byte-code "À ›@†‡" [3 calendar-current-time-zone-cache "EDT"] 2) (#$ . -6668)) (put (quote calendar-daylight-savings-starts) (quote risky-local-variable) t) #@690 *Sexp giving the date on which daylight savings time starts. This is an expression in the variable `year' whose value gives the Gregorian date in the form (month day year) on which daylight savings time starts. It is used to determine the starting date of daylight savings time for the holiday list and for correcting times of day in the solar and lunar calculations. For example, if daylight savings time is mandated to start on October 1, you would set `calendar-daylight-savings-starts' to '(10 1 year) If it starts on the first Sunday in April, you would set it to '(calendar-nth-named-day 1 0 4 year) If the locale never uses daylight savings time, set this to nil. (defvar calendar-daylight-savings-starts (byte-code "À ›@†\nÃU?…ć" [4 calendar-current-time-zone-cache calendar-daylight-time-offset 0 (calendar-nth-named-day 1 0 4 year)] 2) (#$ . -7014)) (put (quote calendar-daylight-savings-ends) (quote risky-local-variable) t) #@553 *Sexp giving the date on which daylight savings time ends. This is an expression in the variable `year' whose value gives the Gregorian date in the form (month day year) on which daylight savings time ends. It is used to determine the starting date of daylight savings time for the holiday list and for correcting times of day in the solar and lunar calculations. For example, if daylight savings time ends on the last Sunday in October: '(calendar-nth-named-day -1 0 10 year) If the locale never uses daylight savings time, set this to nil. (defvar calendar-daylight-savings-ends (byte-code "À ›@†\nÃU?…ć" [5 calendar-current-time-zone-cache calendar-daylight-time-offset 0 (calendar-nth-named-day -1 0 10 year)] 2) (#$ . -7980)) #@70 *Number of minutes after midnight that daylight savings time starts. (defvar calendar-daylight-savings-starts-time (byte-code "À ›@†‡" [6 calendar-current-time-zone-cache 120] 2) (#$ . -8732)) #@68 *Number of minutes after midnight that daylight savings time ends. (defvar calendar-daylight-savings-ends-time (byte-code "À ›@†\n‡" [7 calendar-current-time-zone-cache calendar-daylight-savings-starts-time] 2) (#$ . -8934)) #@102 True if on absolute DATE daylight savings time is in effect. Fractional part of DATE is time of day. (defalias 'dst-in-effect #[(date) "ÀÁ\n!!‰AA@)Ä !…–Ä !‰‰AA@)S\n‰‰@)\n‰A@)\n‰AA@)SÉ_\\\nËVƒx\nÌ_Í\\Î¥Z\n ‰̦ÏU…o ЦÏU?†o ѦÏU)ƒx\nT\n\n-Ò_̥Х[Ñ¥\\\\\\\\*Ô¥\\Ä!…'Ä!‰‰AA@)S\n‰‰@)\n‰A@)\n‰AA@)SÉ_\\\nËVƒ\nÌ_Í\\Î¥Z\n ‰̦ÏU…ý ЦÏU?†ý ѦÏU)ƒ\nT\n\n-Ò_̥Х[Ñ¥\\\\\\\\*ZÙ¥\\……WƒI\nXƒI\nW†Wƒ_\nXƒ_\nW†ƒp„p\nX†…?…\nW+‡" [calendar-gregorian-from-absolute floor date year eval calendar-daylight-savings-starts prior-years month day 31 day-of-year 2 4 23 10 0 100 400 365 calendar-daylight-savings-starts-time 1440.0 dst-starts calendar-daylight-savings-ends calendar-daylight-savings-ends-time calendar-daylight-time-offset 1440.0 dst-ends] 8 (#$ . 9168)]) #@687 Adjust, to account for dst on DATE, decimal fraction standard TIME. Returns a list (date adj-time zone) where `date' and `adj-time' are the values adjusted for `zone'; here `date' is a list (month day year), `adj-time' is a decimal fraction time, and `zone' is a string. Optional parameter STYLE forces the result time to be standard time when its value is 'standard and daylight savings time (if available) when its value is 'daylight. Conversion to daylight savings time is done according to `calendar-daylight-savings-starts', `calendar-daylight-savings-ends', `calendar-daylight-savings-starts-time', `calendar-daylight-savings-ends-time', and `calendar-daylight-savings-offset'. (defalias 'dst-adjust-time #[(date time &optional style) "‰‰AA@)S‰‰@)‰A@)‰AA@) \nSÅ_\\\nÇVƒ]\nÈ_É\\Ê¥Z\f‰ȦËU…T\f̦ËU?†T\fͦËU)ƒ]T- Î_ È¥ Ì¥[ Í¥\\\\\\\\*ÏÑ_!Ò¥\\Ô!‰ƒŒ‚ŽƒžÚ¥‚ŸË\\ÛÜ!!Ü!ZÝ_E,‡" [date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 round time 60 1440.0 rounded-abs-date dst-in-effect dst calendar-daylight-time-zone-name calendar-standard-time-zone-name time-zone calendar-daylight-time-offset 1440.0 calendar-gregorian-from-absolute truncate 24.0] 8 (#$ . 10072)]) (provide (quote cal-dst)) emacs-19.30/lisp/cal-french.elc100666 13437 1 13534 6032173534 14731 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Sep 27 03:03:48 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/cal-french.el ;;; emacs version 19.29.12. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cal-french.el' was compiled for Emacs 19.29 or later")) (require (quote calendar)) #@79 Absolute date of start of French Revolutionary calendar = September 22, 1792. (defconst french-calendar-epoch (byte-code "ÀÀ‰AA@)S ‰‰@) ‰A@) ‰AA@)\f SÆ_\\ ÈVƒ] É_Ê\\Ë¥Z ‰ɦÌU…T ͦÌU?†T ΦÌU)ƒ]T-\nÏ_\nÉ¥\nÍ¥[\nÎ¥\\\\\\\\*‡" [(9 22 1792) date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365] 7) (#$ . 513)) (byte-code "ÀÁ\nBÃÄ\nBÅÆ\nBÁ‡" [["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"] french-calendar-month-name-array current-load-list ["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi" "Octidi" "Nonidi" "Decadi"] french-calendar-day-name-array ["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Re'compense" "de la Re'volution"] french-calendar-special-days-array] 2) #@464 True if YEAR is a leap year on the French Revolutionary calendar. For Gregorian years 1793 to 1805, the years of actual operation of the calendar, uses historical practice based on equinoxes is followed (years 3, 7, and 11 were leap years; 15 and 20 would have been leap years). For later years uses the proposed rule of Romme (never adopted)--leap years fall every four years except century years not divisible 400 and century years that are multiples of 4000. (defalias 'french-calendar-leap-year-p #[(year) "Á>†)Â>†)ÃV…)ĦÅU…)ƦÇ>?…)ȦÅU?‡" [year (3 7 11) (15 20) 20 4 0 400 (100 200 300) 4000] 2 (#$ . 1361)]) #@191 Return last day of MONTH, YEAR on the French Revolutionary calendar. The 13th month is not really a month, but the 5 (6 in leap years) day period of `sansculottides' at the end of the year. (defalias 'french-calendar-last-day-of-month #[(month year) "ÁWƒ‡Ã\f!ƒŇƇ" [month 13 30 french-calendar-leap-year-p year 6 5] 2 (#$ . 1994)]) #@172 Compute absolute date from French Revolutionary date DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC. (defalias 'calendar-absolute-from-french #[(date) "‰@)‰A@)‰AA@) SÄ_ ÅWƒ% Æ¥‚: SÆ¥ SÇ¥[ SÈ¥ SÉ¥[\\\\\\ SÊ_\n S\\\\\\\\+‡" [date year day month 365 20 4 100 400 4000 30 french-calendar-epoch] 7 (#$ . 2340)]) #@232 Compute the French Revolutionary equivalent for absolute date DATE. The result is a list of the form (MONTH DAY YEAR). The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC. (defalias 'calendar-french-from-absolute #[(date) " Wƒ ‰‰E‡ ZÃ¥‰‰ÂÇȉTE!Yƒ0 È\\T‚ *\\ ÈÂ\nÇ\nË\n \" E!VƒX È\\\nT\n‚: *T\fÇ\fÈ E!SZ \f  E,‡" [date french-calendar-epoch 0 366 approx sum y calendar-absolute-from-french 1 year m french-calendar-last-day-of-month month day] 7 (#$ . 2736)]) #@165 String of French Revolutionary date of Gregorian DATE. Returns the empty string if DATE is pre-French Revolutionary. Defaults to today's date if DATE is not given. (defalias 'calendar-french-date-string #[(&optional date) "À † ‰‰AA@)S ‰‰@) ‰A@) ‰AA@) \fSÇ_\\\fÉVƒh\fÊ_Ë\\Ì¥Z‰ʦÍU…_ΦÍU?†_ϦÍU)ƒhT- Ð_ Ê¥ Î¥[ Ï¥\\\\\\\\*!‰‰AA@)‰@)‰A@)ÕWƒ¥Ö‚Ö×UƒºØÙSH#‚ÖØÛÜSÌ¥TÝ\"ȘHSH%,‡" [calendar-french-from-absolute date calendar-current-date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 french-date y m d 1 "" 13 format "Jour %s de l'Anne'e %d de la Re'volution" french-calendar-special-days-array "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution" make-string 73 french-calendar-day-name-array french-calendar-month-name-array] 9 (#$ . 3301)]) #@73 Show the French Revolutionary calendar equivalent of the selected date. (defalias 'calendar-print-french-date #[nil "ÀÁÂ!!‰ĘƒÅÆ!‚Å !)‡" [calendar-french-date-string calendar-cursor-to-date t f "" message "Date is pre-French Revolution"] 4 (#$ . 4145) nil]) #@99 Move cursor to French Revolutionary date DATE. Echo French Revolutionary date unless NOECHO is t. (defalias 'calendar-goto-french-date #[(date &optional noecho) "ÀÁ !!!ˆ\f†Å ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-absolute-from-french date noecho calendar-print-french-date] 4 (#$ . 4414) (byte-code "ÀÁÂÃÄÅ ‰‰AA@)S‰‰@)‰A@) ‰AA@)\n SË_\\\fÍVƒx\fÎ_Ï\\Ð¥Z\f\n‰\nΦÑU…o\nÒ¦ÑU?†o\nÓ¦ÑU)ƒx\fT\f\f-Ô_Î¥Ò¥[Ó¥\\\\\\\\*!‰AA@)!#\nÕÖ×Ù\n!ƒ±ÕÚ\"‚»Ü‰ÕÝ\"!A!\"\"ß áâãäåß$!æçè#\"A‰éVƒàç‚äÀêë\",éVƒôéZ‚øÀíî\" éVƒï‚ ,SÐ_\\  \nE.C‡" [calendar-read "Anne'e de la Re'volution (>0): " (lambda (x) (> x 0)) int-to-string calendar-french-from-absolute calendar-current-date date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 mapcar list append french-calendar-month-name-array french-calendar-leap-year-p #[(x) "À P‡" ["Jour " x] 2] french-calendar-special-days-array reverse #[(x) "À P‡" ["Jour " x] 2] month-list t completion-ignore-case assoc capitalize completing-read "Mois ou Sansculottide: " nil calendar-make-alist 1 (lambda (x) (capitalize (car x))) 12 "De'cade (1-3): " (lambda (x) (memq x (quote (1 2 3)))) decade "Jour (1-10): " (lambda (x) (and (<= 1 x) (<= x 10))) 13] 13)]) #@49 French calendar equivalent of date diary entry. (defalias 'diary-french-date #[nil "ÀÁÂ!!‰ĘƒÅ‚ )‡" [calendar-french-date-string calendar-cursor-to-date t f "" "Date is pre-French Revolution"] 4 (#$ . 5736)]) (provide (quote cal-french)) emacs-19.30/lisp/cal-mayan.elc100666 13437 1 30536 6032173556 14576 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Sep 27 03:03:57 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/cal-mayan.el ;;; emacs version 19.29.12. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cal-mayan.el' was compiled for Emacs 19.29 or later")) (require (quote calendar)) #@332 Number of days of the Mayan calendar epoch before absolute day 0. According to the Goodman-Martinez-Thompson correlation. This correlation is not universally accepted, as it still a subject of astro-archeological research. Using 1232041 will give you Spinden's correlation; using 1142840 will give you Hochleitner's correlation. (defconst calendar-mayan-days-before-absolute-zero 1137140 (#$ . 512)) #@31 Mayan haab date at the epoch. (defconst calendar-mayan-haab-at-epoch (quote (8 . 18)) (#$ . 920)) (byte-code "ÀÁ\nBÁ‡" [["Pop" "Uo" "Zip" "Zotz" "Tzec" "Xul" "Yaxkin" "Mol" "Chen" "Yax" "Zac" "Ceh" "Mac" "Kankin" "Muan" "Pax" "Kayab" "Cumku"] calendar-mayan-haab-month-name-array current-load-list] 2) #@34 Mayan tzolkin date at the epoch. (defconst calendar-mayan-tzolkin-at-epoch (quote (4 . 20)) (#$ . 1230)) (byte-code "ÀÁ\nBÁ‡" [["Imix" "Ik" "Akbal" "Kan" "Chicchan" "Cimi" "Manik" "Lamat" "Muluc" "Oc" "Chuen" "Eb" "Ben" "Ix" "Men" "Cib" "Caban" "Etznab" "Cauac" "Ahau"] calendar-mayan-tzolkin-names-array current-load-list] 2) #@66 Compute the Mayan long count corresponding to the absolute DATE. (defalias 'calendar-mayan-long-count-from-absolute #[(date) " \\‰Ã¥\næ‰Æ¥ Ʀ‰È¥ Ȧ‰Ê¥ ʦ\f\f  \f¯. ‡" [date calendar-mayan-days-before-absolute-zero long-count 144000 baktun remainder 7200 katun 360 tun 20 uinal kin] 6 (#$ . 1565)]) #@57 Convert MAYAN-LONG-COUNT into traditional written form. (defalias 'calendar-mayan-long-count-to-string #[(mayan-long-count) "ÀÁ B\"‡" [apply format "%s.%s.%s.%s.%s" mayan-long-count] 4 (#$ . 1889)]) #@70 Given STR, a string of format "%d.%d.%d.%d.%d", return list of nums. (defalias 'calendar-string-to-mayan-long-count #[(str) "À GÂÆÇÈˆÉ !+‡" [nil str 0 cc c rlc condition (byte-code " Wƒ)ÂÃ\f#Æ•È Ê\f O!‰  B +‚ GÌU„6ÍÎÈ\"ˆÈ‡" [cc c string-match "[0-9]+" str start 0 end nil datum read rlc 5 signal invalid-read-syntax] 5) ((invalid-read-syntax)) reverse] 3 (#$ . 2095)]) #@56 Convert absolute DATE into a Mayan haab date (a pair). (defalias 'calendar-mayan-haab-from-absolute #[(date) " \\‰ @ ASÄ_\\\\Ŧ‰ĦÄ¥T,B‡" [date calendar-mayan-days-before-absolute-zero long-count calendar-mayan-haab-at-epoch 20 365 day-of-haab day month] 5 (#$ . 2493)]) #@77 Number of days from Mayan haab DATE1 to next occurrence of haab date DATE2. (defalias 'calendar-mayan-haab-difference #[(date1 date2) "À A\nAZÃ_ @\n@Z\\Ä\"‡" [mod date2 date1 20 365] 4 (#$ . 2784)]) #@63 Absolute date of latest HAAB-DATE on or before absolute DATE. (defalias 'calendar-mayan-haab-on-or-before #[(haab-date date) "‰ÁÂÃ!\f\"ZŦZ‡" [date calendar-mayan-haab-difference calendar-mayan-haab-from-absolute 0 haab-date 365] 5 (#$ . 2989)]) #@83 Move cursor to next instance of Mayan HAAB-DATE. Echo Mayan date if NOECHO is t. (defalias 'calendar-next-haab-date #[(haab-date &optional noecho) "ÀÁÂ Ä ‰‰AA@)S ‰‰@) ‰A@) ‰AA@) SÊ_\\ ÌVƒn Í_Î\\Ï¥Z  ‰ ͦÐU…e ѦÐU?†e Ò¦ÐU)ƒn T  -Ó_ͥѥ[Ò¥\\\\\\\\*Ó\\\"!!ˆ†”Õ ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-mayan-haab-on-or-before haab-date calendar-cursor-to-date date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 noecho calendar-print-mayan-date] 12 (#$ . 3242) (list (calendar-read-mayan-haab-date))]) #@87 Move cursor to previous instance of Mayan HAAB-DATE. Echo Mayan date if NOECHO is t. (defalias 'calendar-previous-haab-date #[(haab-date &optional noecho) "ÀÁÂ Ä ‰‰AA@)S ‰‰@) ‰A@) ‰AA@) SÊ_\\ ÌVƒn Í_Î\\Ï¥Z  ‰ ͦÐU…e ѦÐU?†e Ò¦ÐU)ƒn T  -Ó_ͥѥ[Ò¥\\\\\\\\*S\"!!ˆ†“Õ ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-mayan-haab-on-or-before haab-date calendar-cursor-to-date date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 noecho calendar-print-mayan-date] 12 (#$ . 3837) (list (calendar-read-mayan-haab-date))]) #@69 Convert Mayan haab date (a pair) into its traditional written form. (defalias 'calendar-mayan-haab-to-string #[(haab) "A@‰ÃUƒÄÅ \"‚ÄÆ \nSH#*‡" [haab day month 19 format "%d Uayeb" "%d %s" calendar-mayan-haab-month-name-array] 6 (#$ . 4438)]) #@59 Convert absolute DATE into a Mayan tzolkin date (a pair). (defalias 'calendar-mayan-tzolkin-from-absolute #[(date) " \\Ã\n\f@\\Å\"Ã\n\fA\\Ç\"+B‡" [date calendar-mayan-days-before-absolute-zero long-count calendar-mod calendar-mayan-tzolkin-at-epoch 13 day 20 name] 3 (#$ . 4696)]) #@78 Number of days from Mayan tzolkin DATE1 to next occurrence of tzolkin DATE2. (defalias 'calendar-mayan-tzolkin-difference #[(date1 date2) "@ @ZA AZÄ Ä \nZÅ_Æ\"Ç_\\È\"*‡" [date2 date1 name-difference number-difference mod 3 20 13 260] 5 (#$ . 4993)]) #@66 Absolute date of latest TZOLKIN-DATE on or before absolute DATE. (defalias 'calendar-mayan-tzolkin-on-or-before #[(tzolkin-date date) "‰ÁÂÃ!\f\"ZŦZ‡" [date calendar-mayan-tzolkin-difference calendar-mayan-tzolkin-from-absolute 0 tzolkin-date 260] 5 (#$ . 5253)]) #@86 Move cursor to next instance of Mayan TZOLKIN-DATE. Echo Mayan date if NOECHO is t. (defalias 'calendar-next-tzolkin-date #[(tzolkin-date &optional noecho) "ÀÁÂ Ä ‰‰AA@)S ‰‰@) ‰A@) ‰AA@) SÊ_\\ ÌVƒn Í_Î\\Ï¥Z  ‰ ͦÐU…e ѦÐU?†e Ò¦ÐU)ƒn T  -Ó_ͥѥ[Ò¥\\\\\\\\*Ô\\\"!!ˆ†”Ö ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-mayan-tzolkin-on-or-before tzolkin-date calendar-cursor-to-date date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 260 noecho calendar-print-mayan-date] 12 (#$ . 5524) (list (calendar-read-mayan-tzolkin-date))]) #@90 Move cursor to previous instance of Mayan TZOLKIN-DATE. Echo Mayan date if NOECHO is t. (defalias 'calendar-previous-tzolkin-date #[(tzolkin-date &optional noecho) "ÀÁÂ Ä ‰‰AA@)S ‰‰@) ‰A@) ‰AA@) SÊ_\\ ÌVƒn Í_Î\\Ï¥Z  ‰ ͦÐU…e ѦÐU?†e Ò¦ÐU)ƒn T  -Ó_ͥѥ[Ò¥\\\\\\\\*S\"!!ˆ†“Õ ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-mayan-tzolkin-on-or-before tzolkin-date calendar-cursor-to-date date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 noecho calendar-print-mayan-date] 12 (#$ . 6141) (list (calendar-read-mayan-tzolkin-date))]) #@72 Convert Mayan tzolkin date (a pair) into its traditional written form. (defalias 'calendar-mayan-tzolkin-to-string #[(tzolkin) "ÀÁ\n@ \nASH#‡" [format "%d %s" tzolkin calendar-mayan-tzolkin-names-array] 5 (#$ . 6760)]) #@155 Absolute date that is Mayan TZOLKIN-DATE and HAAB-DATE. Latest such date on or before DATE. Returns nil if such a tzolkin-haab combination is impossible. (defalias 'calendar-mayan-tzolkin-haab-on-or-before #[(tzolkin-date haab-date date) "ÀÁÂ! \"ÅÆÂ!\"‰\fZ‰ ʦÂU…, Ì \f Í_\\ZÎ\"Z+‡" [calendar-mayan-haab-difference calendar-mayan-haab-from-absolute 0 haab-date haab-difference calendar-mayan-tzolkin-difference calendar-mayan-tzolkin-from-absolute tzolkin-date tzolkin-difference difference 5 date mod 365 18980] 7 (#$ . 6986)]) #@30 Prompt for a Mayan haab date (defalias 'calendar-read-mayan-haab-date #[nil "ÀÂÃÄ\"Æ ÈW…É\"\nËÌÍÎÏÐ\n\"ÑÀ$!Ò\nÓÌ#\"A ,B‡" [t completion-ignore-case calendar-read "Haab kin (0-19): " (lambda (x) (and (>= x 0) (< x 20))) haab-day append calendar-mayan-haab-month-name-array 5 ("Uayeb") haab-month-list assoc capitalize completing-read "Haab uinal: " mapcar list nil calendar-make-alist 1 haab-month] 7 (#$ . 7531)]) #@33 Prompt for a Mayan tzolkin date (defalias 'calendar-read-mayan-tzolkin-date #[nil "ÀÂÃÄ\"ÆÈ\" ÊËÌÍÎÏ \"ÈÀ$!Ð ÑË#\"A ,B‡" [t completion-ignore-case calendar-read "Tzolkin kin (1-13): " (lambda (x) (and (> x 0) (< x 14))) tzolkin-count append calendar-mayan-tzolkin-names-array nil tzolkin-name-list assoc capitalize completing-read "Tzolkin uinal: " mapcar list calendar-make-alist 1 tzolkin-name] 7 (#$ . 7964)]) #@107 Move cursor to next instance of Mayan HAAB-DATE TZOKLIN-DATE combination. Echo Mayan date if NOECHO is t. (defalias 'calendar-next-calendar-round-date #[(tzolkin-date haab-date &optional noecho) "À \nà ‰‰AA@)S\f‰‰@)\f‰A@)\f‰AA@)SÉ_\\\nËVƒl\nÌ_Í\\Î¥Z\n‰̦ÏU…cЦÏU?†cѦÏU)ƒl\nT\n\n- Ò_ Ì¥ Ð¥[ Ñ¥\\\\\\\\*Ó\\#‰„•ÔÕÖ !×\n!#‚¢ØÙ\f!!ˆ†¢Û )‡" [calendar-mayan-tzolkin-haab-on-or-before tzolkin-date haab-date calendar-cursor-to-date date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 18980 error "%s, %s does not exist in the Mayan calendar round" calendar-mayan-tzolkin-to-string calendar-mayan-haab-to-string calendar-goto-date calendar-gregorian-from-absolute noecho calendar-print-mayan-date] 11 (#$ . 8395) (list (calendar-read-mayan-tzolkin-date) (calendar-read-mayan-haab-date))]) #@104 Move to previous instance of Mayan TZOKLIN-DATE HAAB-DATE combination. Echo Mayan date if NOECHO is t. (defalias 'calendar-previous-calendar-round-date #[(tzolkin-date haab-date &optional noecho) "À \nà ‰‰AA@)S\f‰‰@)\f‰A@)\f‰AA@)SÉ_\\\nËVƒl\nÌ_Í\\Î¥Z\n‰̦ÏU…cЦÏU?†cѦÏU)ƒl\nT\n\n- Ò_ Ì¥ Ð¥[ Ñ¥\\\\\\\\*S#‰„”ÓÔÕ !Ö\n!#‚¡×Ø\f!!ˆ†¡Ú )‡" [calendar-mayan-tzolkin-haab-on-or-before tzolkin-date haab-date calendar-cursor-to-date date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 error "%s, %s does not exist in the Mayan calendar round" calendar-mayan-tzolkin-to-string calendar-mayan-haab-to-string calendar-goto-date calendar-gregorian-from-absolute noecho calendar-print-mayan-date] 11 (#$ . 9247) (list (calendar-read-mayan-tzolkin-date) (calendar-read-mayan-haab-date))]) #@118 Compute the absolute date corresponding to the Mayan Long Count C. Long count is a list (baktun katun tun uinal kin) (defalias 'calendar-absolute-from-mayan-long-count #[(c) "@Á_A@Â_Ã8Ä_Å8Æ_Ç8[\\\\\\\\\\‡" [c 144000 7200 2 360 3 20 4 calendar-mayan-days-before-absolute-zero] 6 (#$ . 10092)]) #@88 String of Mayan date of Gregorian DATE. Defaults to today's date if DATE is not given. (defalias 'calendar-mayan-date-string #[(&optional date) "†Á ‰‰AA@)S‰‰@)‰A@)‰AA@)\f SÆ_\\ ÈVƒb É_Ê\\Ë¥Z ‰ɦÌU…Y ͦÌU?†Y ΦÌU)ƒbT-\nÏ_\nÉ¥\nÍ¥[\nÎ¥\\\\\\\\*Ñ!Ó!Õ!×ØÙ!Ú!Û!$,‡" [date calendar-current-date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 d calendar-mayan-tzolkin-from-absolute tzolkin calendar-mayan-haab-from-absolute haab calendar-mayan-long-count-from-absolute long-count format "Long count = %s; tzolkin = %s; haab = %s" calendar-mayan-long-count-to-string calendar-mayan-tzolkin-to-string calendar-mayan-haab-to-string] 8 (#$ . 10398)]) #@67 Show the Mayan long count, tzolkin, and haab equivalents of date. (defalias 'calendar-print-mayan-date #[nil "ÀÁÂÃÄ!!\"‡" [message "Mayan date: %s" calendar-mayan-date-string calendar-cursor-to-date t] 5 (#$ . 11116) nil]) #@76 Move cursor to Mayan long count DATE. Echo Mayan date unless NOECHO is t. (defalias 'calendar-goto-mayan-long-count-date #[(date &optional noecho) "ÀÁ !!!ˆ\f†Å ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-absolute-from-mayan-long-count date noecho calendar-print-mayan-date] 4 (#$ . 11345) (byte-code "À „«ÂÃÄÅÆÇ ‰‰AA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒ~\nÐ_Ñ\\Ò¥Z\f‰\fЦÓU…u\fÔ¦ÓU?†u\fÕ¦ÓU)ƒ~T- Ö_ Ð¥ Ô¥[ Õ¥\\\\\\\\*!!\"!Ø!ƒ§)‚ )C‡" [nil lc calendar-string-to-mayan-long-count read-string "Mayan long count (baktun.katun.tun.uinal.kin): " calendar-mayan-long-count-to-string calendar-mayan-long-count-from-absolute calendar-current-date date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 datum calendar-mayan-long-count-common-era] 13)]) #@52 T if long count represents date in the Common Era. (defalias 'calendar-mayan-long-count-common-era #[(lc) "ÀÁ!‰ƒ @\n@Uƒ A\nA‰„ ?†$ @\n@V)‡" [calendar-mayan-long-count-from-absolute 1 base lc] 3 (#$ . 12195)]) #@70 Show the Mayan long count, haab, and tzolkin dates as a diary entry. (defalias 'diary-mayan-date #[nil "ÀÁ !\"‡" [format "Mayan date: %s" calendar-mayan-date-string date] 4 (#$ . 12420)]) (provide (quote cal-mayan)) emacs-19.30/lisp/cal-menu.elc100666 75424 13 37456 6043463133 14244 0ustar kwzhuser;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:31:08 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/cal-menu.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cal-menu.el' was compiled for Emacs 19.29 or later")) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÈÉ!„ÊË! É\fB\fÀ Í #ˆÀ Î #ˆÀ ÏÐÊÐ!B#ˆÀ ÑÒ#ˆÀ ÓÔÊÔ!B#ˆÀ ÕÖ#ˆÀ ×Ø#ˆÀ ÙÚ#ˆÀ ÛÜ#ˆÀ ÝÞ#ˆÀ ßà#ˆÀ áâ#ˆÀ ãä#ˆÀ åæ#ˆÀ çè#ˆÀ éê#ˆÀ ëì#ˆÀ íî#ˆÀ ïðÊð!B#ˆÀ ñò#ˆÀ óô#ˆÀ õö#ˆÀ ÷ø#ˆÀ ùúÊú!B#ˆÀ ûü#ˆÀ ýþÊÿ!B#ˆÀ @A#ˆÀ BC#ˆÀ DE#ˆÀ FG#ˆÀ HI#ˆÀ JK#ˆÀ LM#ˆÀ NO#ˆÀ PQ#ˆÀ RS#ˆÀ TU#ˆÀ VW#ˆÀ XY#ˆÀ Z[#ˆÀ \\]#ˆÀ ^_#ˆÀ `a#ˆÀ bc#ˆÀ de#ˆÀ fg#ˆÀ hi#ˆÀ jk#ˆÀ lmÊm!B#ˆÀ no#ˆÀ pq#ˆÀ rs#ˆÀ tu#ˆÀ vw#ˆÀ xy#ˆz{|}#ˆz~|#ˆz€|#ˆz‚|ƒ#ˆz„|…#ˆz†|‡#ˆzˆ|‰#ˆzŠ|‹#ˆzŒ|#ˆzŽ|#ˆz|‘#ˆz’|“#ˆz”|•#ˆz–|—#ˆz˜|™#ˆzš|›#ˆzœ|#ˆzž|Ÿ#ˆz |¡#ˆz¢|£#ˆz¤|¥#ˆz¦|§#ˆz¨|©#ˆzª|«#ˆz¬|­#ˆz®|¯#ˆz°|±#ˆz²|³#ˆz´|µ#ˆz¶|·#ˆz¸|¹#ˆzº|»#ˆz¼|½#ˆz¾|¿#ˆzÀ|Á#ˆzÂ|Ã#ˆzÄ|Å#ˆzÆ|Ç#ˆzÈ|É#‡" [define-key calendar-mode-map [menu-bar edit] undefined [down-mouse-2] calendar-mouse-2-date-menu [mouse-2] ignore boundp calendar-mouse-3-map make-sparse-keymap "Calendar" current-load-list [down-mouse-3] [C-down-mouse-3] [menu-bar moon] "Moon" [menu-bar moon moon] ("Lunar Phases" . calendar-phases-of-moon) [menu-bar diary] "Diary" [menu-bar diary heb] ("Insert Hebrew" . calendar-mouse-insert-hebrew-diary-entry) [menu-bar diary isl] ("Insert Islamic" . calendar-mouse-insert-islamic-diary-entry) [menu-bar diary cyc] ("Insert Cyclic" . insert-cyclic-diary-entry) [menu-bar diary blk] ("Insert Block" . insert-block-diary-entry) [menu-bar diary ann] ("Insert Anniversary" . insert-anniversary-diary-entry) [menu-bar diary yr] ("Insert Yearly" . insert-yearly-diary-entry) [menu-bar diary mon] ("Insert Monthly" . insert-monthly-diary-entry) [menu-bar diary wk] ("Insert Weekly" . insert-weekly-diary-entry) [menu-bar diary ent] ("Insert Daily" . insert-diary-entry) [menu-bar diary all] ("Show All" . show-all-diary-entries) [menu-bar diary mark] ("Mark All" . mark-diary-entries) [menu-bar diary view] ("Cursor Date" . view-diary-entries) [menu-bar diary view] ("Other File" . view-other-diary-entries) [menu-bar holidays] "Holidays" [menu-bar holidays unmark] ("Unmark" . calendar-unmark) [menu-bar holidays mark] ("Mark" . mark-calendar-holidays) [menu-bar holidays 3-mon] ("3 Months" . list-calendar-holidays) [menu-bar holidays 1-day] ("One Day" . calendar-cursor-holidays) [menu-bar goto] "Goto" [menu-bar goto french] ("French Date" . calendar-goto-french-date) [menu-bar goto mayan] "Mayan Date" "Mayan" [menu-bar goto ethiopic] ("Ethiopic Date" . calendar-goto-ethiopic-date) [menu-bar goto coptic] ("Coptic Date" . calendar-goto-coptic-date) [menu-bar goto chinese] ("Chinese Date" . calendar-goto-chinese-date) [menu-bar goto julian] ("Julian Date" . calendar-goto-julian-date) [menu-bar goto islamic] ("Islamic Date" . calendar-goto-islamic-date) [menu-bar goto hebrew] ("Hebrew Date" . calendar-goto-hebrew-date) [menu-bar goto astro] ("Astronomical Date" . calendar-goto-astro-day-number) [menu-bar goto iso] ("ISO Date" . calendar-goto-iso-date) [menu-bar goto gregorian] ("Other Date" . calendar-goto-date) [menu-bar goto end-of-year] ("End of Year" . calendar-end-of-year) [menu-bar goto beginning-of-year] ("Beginning of Year" . calendar-beginning-of-year) [menu-bar goto end-of-month] ("End of Month" . calendar-end-of-month) [menu-bar goto beginning-of-month] ("Beginning of Month" . calendar-beginning-of-month) [menu-bar goto end-of-week] ("End of Week" . calendar-end-of-week) [menu-bar goto beginning-of-week] ("Beginning of Week" . calendar-beginning-of-week) [menu-bar goto today] ("Today" . calendar-goto-today) [menu-bar goto mayan prev-rnd] ("Previous Round" . calendar-previous-calendar-round-date) [menu-bar goto mayan nxt-rnd] ("Next Round" . calendar-next-calendar-round-date) [menu-bar goto mayan prev-haab] ("Previous Haab" . calendar-previous-haab-date) [menu-bar goto mayan next-haab] ("Next Haab" . calendar-next-haab-date) [menu-bar goto mayan prev-tzol] ("Previous Tzolkin" . calendar-previous-tzolkin-date) [menu-bar goto mayan next-tzol] ("Next Tzolkin" . calendar-next-tzolkin-date) [menu-bar scroll] "Scroll" [menu-bar scroll bk-12] ("Backward 1 Year" . "4v") [menu-bar scroll bk-3] ("Backward 3 Months" . scroll-calendar-right-three-months) [menu-bar scroll bk-1] ("Backward 1 Month" . scroll-calendar-right) [menu-bar scroll fwd-12] ("Forward 1 Year" . "4") [menu-bar scroll fwd-3] ("Forward 3 Months" . scroll-calendar-left-three-months) [menu-bar scroll fwd-1] ("Forward 1 Month" . scroll-calendar-left) put calendar-forward-day menu-enable (calendar-cursor-to-date) calendar-backward-day (calendar-cursor-to-date) calendar-forward-week (calendar-cursor-to-date) calendar-backward-week (calendar-cursor-to-date) calendar-forward-month (calendar-cursor-to-date) calendar-backward-month (calendar-cursor-to-date) calendar-forward-year (calendar-cursor-to-date) calendar-backward-year (calendar-cursor-to-date) calendar-beginning-of-year (calendar-cursor-to-date) calendar-end-of-year (calendar-cursor-to-date) calendar-beginning-of-month (calendar-cursor-to-date) calendar-end-of-month (calendar-cursor-to-date) calendar-end-of-week (calendar-cursor-to-date) calendar-beginning-of-week (calendar-cursor-to-date) calendar-mouse-print-dates (calendar-event-to-date) calendar-sunrise-sunset (calendar-event-to-date) calendar-cursor-holidays (calendar-cursor-to-date) view-diary-entries (calendar-cursor-to-date) view-other-diary-entries (calendar-cursor-to-date) calendar-mouse-insert-hebrew-diary-entry (calendar-cursor-to-date) calendar-mouse-insert-islamic-diary-entry (calendar-cursor-to-date) insert-cyclic-diary-entry (calendar-cursor-to-date) insert-block-diary-entry (calendar-cursor-to-date) insert-anniversary-diary-entry (calendar-cursor-to-date) insert-yearly-diary-entry (calendar-cursor-to-date) insert-monthly-diary-entry (calendar-cursor-to-date) insert-weekly-diary-entry (calendar-cursor-to-date) cal-tex-cursor-day (calendar-cursor-to-date) cal-tex-cursor-week (calendar-cursor-to-date) cal-tex-cursor-week2 (calendar-cursor-to-date) cal-tex-cursor-week3 (calendar-cursor-to-date) cal-tex-cursor-week4 (calendar-cursor-to-date) cal-tex-cursor-week5 (calendar-cursor-to-date) cal-tex-cursor-week6 (calendar-cursor-to-date) cal-tex-cursor-month (calendar-cursor-to-date) cal-tex-cursor-month-landscape (calendar-cursor-to-date) cal-tex-cursor-year (calendar-cursor-to-date) cal-tex-cursor-filofax-year (calendar-cursor-to-date) cal-tex-cursor-year-landscape (calendar-cursor-to-date)] 6) #@136 Date of last event. If event is not on a specific date, signals an error if optional parameter ERROR is t, otherwise just returns nil. (defalias 'calendar-event-to-date #[(&optional error) "Š‰A@)‰A@:ƒ\nA@@‚\nA@)bˆÃ\f!)‡" [last-input-event event position calendar-cursor-to-date error] 3 (#$ . 7210)]) #@50 Pop up menu to insert a Hebrew-date diary entry. (defalias 'calendar-mouse-insert-hebrew-diary-entry #[(event) "À ÂÃÄ !ÅÆÇFD\"‰…É!)‡" [x-popup-menu event "Hebrew insert menu" calendar-hebrew-date-string calendar-cursor-to-date ("One time" . insert-hebrew-diary-entry) ("Monthly" . insert-monthly-hebrew-diary-entry) ("Yearly" . insert-yearly-hebrew-diary-entry) hebrew-selection call-interactively] 8 (#$ . 7524) "e"]) #@52 Pop up menu to insert an Islamic-date diary entry. (defalias 'calendar-mouse-insert-islamic-diary-entry #[(event) "À ÂÃÄ !ÅÆÇFD\"‰…É!)‡" [x-popup-menu event "Islamic insert menu" calendar-islamic-date-string calendar-cursor-to-date ("One time" . insert-islamic-diary-entry) ("Monthly" . insert-monthly-islamic-diary-entry) ("Yearly" . insert-yearly-islamic-diary-entry) islamic-selection call-interactively] 8 (#$ . 7955) "e"]) #@52 Show sunrise/sunset times for mouse-selected date. (defalias 'calendar-mouse-sunrise/sunset #[nil "ŠÀÁ !ˆÂ )‡" [calendar-goto-date calendar-event-to-date calendar-sunrise-sunset] 2 (#$ . 8395) nil]) #@40 Show holidays for mouse-selected date. (defalias 'calendar-mouse-holidays #[nil "ŠÀÁ !ˆÂ )‡" [calendar-goto-date calendar-event-to-date calendar-cursor-holidays] 2 (#$ . 8600) nil]) #@44 View diary entries on mouse-selected date. (defalias 'calendar-mouse-view-diary-entries #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date view-diary-entries 1] 2 (#$ . 8788) nil]) #@66 View diary entries from alternative file on mouse-selected date. (defalias 'calendar-mouse-view-other-diary-entries #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date call-interactively view-other-diary-entries] 2 (#$ . 8987) nil]) #@45 Insert diary entry for mouse-selected date. (defalias 'calendar-mouse-insert-diary-entry #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date insert-diary-entry nil] 2 (#$ . 9237) nil]) #@33 Mark the date under the cursor. (defalias 'calendar-mouse-set-mark #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date calendar-set-mark nil] 2 (#$ . 9439) nil]) #@60 Make a buffer with LaTeX commands for the day mouse is on. (defalias 'cal-tex-mouse-day #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date cal-tex-cursor-day nil] 2 (#$ . 9618) nil]) #@99 One page calendar for week indicated by cursor. Holidays are included if `cal-tex-holidays' is t. (defalias 'cal-tex-mouse-week #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date cal-tex-cursor-week nil] 2 (#$ . 9819) nil]) #@103 Make a buffer with LaTeX commands for the week cursor is on. The printed output will be on two pages. (defalias 'cal-tex-mouse-week2 #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date cal-tex-cursor-week2 nil] 2 (#$ . 10062) nil]) #@99 One page calendar for week indicated by cursor. Holidays are included if `cal-tex-holidays' is t. (defalias 'cal-tex-mouse-week3 #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date cal-tex-cursor-week3 nil] 2 (#$ . 10311) nil]) #@49 One page calendar for week indicated by cursor. (defalias 'cal-tex-mouse-week4 #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date cal-tex-cursor-week4 nil] 2 (#$ . 10556) nil]) #@57 One page Filofax calendar for week indicated by cursor. (defalias 'cal-tex-mouse-week5 #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date cal-tex-cursor-week5 nil] 2 (#$ . 10751) nil]) #@57 Two page Filofax calendar for week indicated by cursor. (defalias 'cal-tex-mouse-week6 #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date cal-tex-cursor-week6 nil] 2 (#$ . 10954) nil]) #@100 Make a buffer with LaTeX commands for the month cursor is on. Calendar is condensed onto one page. (defalias 'cal-tex-mouse-month #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date cal-tex-cursor-month nil] 2 (#$ . 11158) nil]) #@119 Make a buffer with LaTeX commands for the month cursor is on. The output is in landscape format, one month to a page. (defalias 'cal-tex-mouse-month-landscape #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date cal-tex-cursor-month-landscape nil] 2 (#$ . 11405) nil]) #@62 Make a buffer with LaTeX commands for the year cursor is on. (defalias 'cal-tex-mouse-year #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date cal-tex-cursor-year nil] 2 (#$ . 11690) nil]) #@78 Make a buffer with LaTeX commands for Filofax calendar of year cursor is on. (defalias 'cal-tex-mouse-filofax-year #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date cal-tex-cursor-filofax-year nil] 2 (#$ . 11896) nil]) #@62 Make a buffer with LaTeX commands for the year cursor is on. (defalias 'cal-tex-mouse-year-landscape #[nil "ŠÀÁ !ˆÂÃ!)‡" [calendar-goto-date calendar-event-to-date cal-tex-cursor-year-landscape nil] 2 (#$ . 12134) nil]) #@57 Pop up menu of equivalent dates to mouse selected date. (defalias 'calendar-mouse-print-dates #[nil "À Á\nÃÄÅ!ÇPÈ!CÉÊË!\"CÉÌÍ!\"CÉÎÏ!\"CÉÐÑ!\"C¯Ò!‰Ô˜?…GÉÕ\"CC)ÉÖ×!\"CCØ!‰Ô˜?…eÉÚ\"CC)Û!‰Ô˜?…zÉÝ\"CC)Þ!‰Ô˜?…Éà\"CC)Éáâ!\"CC&D\"##…ªä#!*‡" [calendar-event-to-date x-popup-menu event "Date Menu" append calendar-date-string date " (Gregorian)" calendar-day-of-year-string format "ISO date: %s" calendar-iso-date-string "Julian date: %s" calendar-julian-date-string "Astronomical (Julian) day number (after noon UTC): %s" calendar-astro-date-string "Hebrew date (before sunset): %s" calendar-hebrew-date-string calendar-islamic-date-string i "" "Islamic date (before sunset): %s" "Chinese date: %s" calendar-chinese-date-string calendar-coptic-date-string c "Coptic date: %s" calendar-ethiopic-date-string e "Ethiopic date: %s" calendar-french-date-string f "French Revolutionary date: %s" "Mayan date: %s" calendar-mayan-date-string selection call-interactively] 16 (#$ . 12360) nil]) #@50 Show Chinese equivalent for mouse-selected date. (defalias 'calendar-mouse-chinese-date #[nil "ŠÀÁ !ˆÂ )‡" [calendar-goto-date calendar-event-to-date calendar-print-chinese-date] 2 (#$ . 13397) nil]) #@67 Pop up menu for Mouse-2 for selected date in the calendar window. (defalias 'calendar-mouse-2-date-menu #[(event) "ÀÁ!Ã\fÅÆ\nÁÇ#ÈÉÊËÌÍÎϯ D\"‰…\"Ñ!*‡" [calendar-event-to-date t date x-popup-menu event "Menu" calendar-date-string nil ("Holidays" . calendar-mouse-holidays) ("Mark date" . calendar-mouse-set-mark) ("Sunrise/sunset" . calendar-mouse-sunrise/sunset) ("Other calendars" . calendar-mouse-print-dates) ("Prepare LaTeX buffer" . calendar-mouse-cal-tex-menu) ("Diary entries" . calendar-mouse-view-diary-entries) ("Insert diary entry" . calendar-mouse-insert-diary-entry) ("Other diary file entries" . calendar-mouse-view-other-diary-entries) selection call-interactively] 13 (#$ . 13603) "e"]) #@91 Pop up submenu for Mouse-2 for cal-tex commands for selected date in the calendar window. (defalias 'calendar-mouse-cal-tex-menu #[(event) "À ÂÃ\fÅÆ#ÇÈÉÊËÌÍÎÏЯ D\"‰… Ò!)‡" [x-popup-menu event "Menu" calendar-date-string date t nil ("Daily (1 page)" . cal-tex-mouse-day) ("Weekly (1 page)" . cal-tex-mouse-week) ("Weekly (2 pages)" . cal-tex-mouse-week2) ("Weekly (other style; 1 page)" . cal-tex-mouse-week3) ("Weekly (yet another style; 1 page)" . cal-tex-mouse-week4) ("Monthly" . cal-tex-mouse-month) ("Monthly (landscape)" . cal-tex-mouse-month-landscape) ("Yearly" . cal-tex-mouse-year) ("Yearly (landscape)" . cal-tex-mouse-year-landscape) ("Filofax styles" . cal-tex-mouse-filofax) selection call-interactively] 15 (#$ . 14318) "e"]) #@80 Pop up sub-submenu for Mouse-2 for Filofax cal-tex commands for selected date. (defalias 'cal-tex-mouse-filofax #[(event) "À ÂÃ\fÅÆ#ÇÈÉFD\"‰\n…Ë\n!)‡" [x-popup-menu event "Menu" calendar-date-string date t nil ("Filofax Weekly (1 page)" . cal-tex-mouse-week5) ("Filofax Weekly (2 pages)" . cal-tex-mouse-week6) ("Filofax Yearly" . cal-tex-mouse-filofax-year) selection call-interactively] 8 (#$ . 15071) "e"]) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÔÕ!ˆÖ×!‡" [define-key calendar-mouse-3-map [exit-calendar] ("Exit calendar" . exit-calendar) [show-diary] ("Show diary" . show-all-diary-entries) [lunar-phases] ("Lunar phases" . calendar-phases-of-moon) [unmark] ("Unmark" . calendar-unmark) [mark-holidays] ("Mark holidays" . mark-calendar-holidays) [list-holidays] ("List holidays" . list-calendar-holidays) [mark-diary-entries] ("Mark diary entries" . mark-diary-entries) [scroll-backward] ("Scroll backward" . scroll-calendar-right-three-months) [scroll-forward] ("Scroll forward" . scroll-calendar-left-three-months) run-hooks cal-menu-load-hook provide cal-menu] 4) emacs-19.30/lisp/cal-tex.elc100666 12120 1 130276 6055525665 14166 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 25 00:36:46 1995 ;;; from file /home/fsf/rms/e19/lisp/cal-tex.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`cal-tex.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃÄÅÆ$ˆÂÇÈÅÆ$ˆÂÉÊÅÆ$‡" [require calendar autoload list-diary-entries "diary-lib" nil t calendar-holiday-list "holidays" calendar-iso-from-absolute "cal-iso"] 5) #@279 *The days of the week that are displayed on the portrait monthly calendar. Sunday is 0, Monday is 1, and so on. The default is to print from Sunday to Saturday. For example, use (setq cal-tex-which-days '(1 3 5)) to only print Monday, Wednesday, Friday. (defvar cal-tex-which-days (quote (0 1 2 3 4 5 6)) (#$ . -650)) #@108 *If t (default), then the holidays are also printed. If finding the holidays is too slow, set this to nil. (defvar cal-tex-holidays t (#$ . -999)) #@55 *If t, the diary entries are printed in the calendar. (defvar cal-tex-diary nil (#$ . -1152)) #@534 *An expression in the variable `date' whose value is placed on date. The string resulting from evaluating this expression is placed at the bottom center of `date' on the monthly calendar, next to the date in the weekly calendars, and in the top center of daily calendars. Default is ordinal day number of the year and the number of days remaining. As an example of what you do, setting this to '(progn (require 'cal-hebrew) (calendar-hebrew-date-string date)) will put the Hebrew date at the bottom of each day. (defvar cal-tex-daily-string (quote (let* ((year (extract-calendar-year date)) (day (calendar-day-number date)) (days-remaining (- (calendar-day-number (list 12 31 year)) day))) (format "%d/%d" day days-remaining))) (#$ . -1253)) #@36 *The name for the tex-ed calendar. (defvar cal-tex-buffer "calendar.tex" (#$ . -2022)) #@51 *If t, use a 24 hour clock in the daily calendar. (defvar cal-tex-24 nil (#$ . -2115)) #@45 *The first hour of the daily calendar page. (defvar cal-tex-daily-start 8 (#$ . -2208)) #@44 *The last hour of the daily calendar page. (defvar cal-tex-daily-end 20 (#$ . -2302)) #@102 The initial LaTeX code for a day. The holidays, diary entries, bottom string, and the text follow. (defvar cal-tex-day-prefix "\\caldate{%s}{%s}" (#$ . 2395)) #@94 The format for LaTeX code for a day name. The names are taken from calendar-day-name-array. (defvar cal-tex-day-name-format "\\myday{%s}%%" (#$ . 2562)) #@33 LaTeX code for the month header (defvar cal-tex-cal-one-month "\\def\\calmonth#1#2%\n{\\begin{center}%\n\\Huge\\bf\\uppercase{#1} #2 \\\\[1cm]%\n\\end{center}}% \n\\vspace*{-1.5cm}%\n%\n" (#$ . 2722)) #@33 LaTeX code for the month header (defvar cal-tex-cal-multi-month "\\def\\calmonth#1#2#3#4%\n{\\begin{center}%\n\\Huge\\bf #1 #2---#3 #4\\\\[1cm]%\n\\end{center}}% \n\\vspace*{-1.5cm}%\n%\n" (#$ . 2929)) #@30 LaTeX code for a day heading (defvar cal-tex-myday "\\renewcommand{\\myday}[1]%\n{\\makebox[\\cellwidth]{\\hfill\\large\\bf#1\\hfill}}\n%\n" (#$ . 3137)) #@104 LaTeX code to insert one box with date info in calendar. This definition is the heart of the calendar! (defvar cal-tex-caldate "\\fboxsep=0pt\n\\long\\def\\caldate#1#2#3#4#5#6{%\n \\fbox{\\hbox to\\cellwidth{%\n \\vbox to\\cellheight{%\n \\hbox to\\cellwidth{%\n {\\hspace*{1mm}\\Large \\bf \\strut #2}\\hspace{.05\\cellwidth}%\n \\raisebox{\\holidaymult\\cellheight}%\n {\\parbox[t]{.75\\cellwidth}{\\tiny \\raggedright #4}}}\n \\hbox to\\cellwidth{%\n \\hspace*{1mm}\\parbox{.95\\cellwidth}{\\tiny \\raggedright #3}}\n \\hspace*{1mm}%\n \\hbox to\\cellwidth{#6}%\n \\vfill%\n \\hbox to\\cellwidth{\\hfill \\tiny #5 \\hfill}%\n \\vskip 1.4pt}%\n \\hskip -0.4pt}}}\n" (#$ . 3298)) #@62 Generate a list of all holidays from absolute date D1 to D2. (defalias 'cal-tex-list-holidays #[(d1 d2) "À !‰‰@)\f‰AA@)‰È_\\É\\Ê\\‰ ȦT È¥)Â\f!‰ ‰@) ‰AA@) ‰A@)ÊUƒjÈ_\\Ð\\‰ ȦT È¥)ÊE‰‰AA@)S ‰‰@) ‰A@) ‰AA@)SÕ_\\×VƒØØ_Ù\\Ú¥Z‰ئÛU…ÏܦÛU?†ÏݦÛU)ƒØT-Þ_\\Ø¥\\Ü¥[\\Ý¥\\*ÊE‰‰AA@)S ‰‰@) ‰A@) ‰AA@)SÕ_\\×VƒaØ_Ù\\Ú¥Z‰ئÛU…XܦÛU?†XݦÛU)ƒaT-Þ_\\Ø¥\\Ü¥[\\Ý¥\\* !â#$%#„˜! XƒEæ ç \"À#%È_$\\×\\‰ ȦT$ È¥%)$Ê%E‰‰AA@)S ‰‰@) ‰A@) ‰AA@)SÕ_\\×Vƒ'Ø_Ù\\Ú¥Z‰ئÛU…ܦÛU?†ݦÛU)ƒ'T-Þ_\\Ø¥\\Ü¥[\\Ý¥\\*!‚‹. À ()(ƒ(@@ƒú(@@‰‰AA@)S ‰‰@) ‰A@) ‰AA@)SÕ_\\×VƒÅØ_Ù\\Ú¥Z‰ئÛU…¼ܦÛU?†¼ݦÛU)ƒÅT-Þ_\\Ø¥\\Ü¥[\\Ý¥\\** *X…ì*\fX)ƒúæ(@C)\")(A‰(„R).‡" [nil result calendar-gregorian-from-absolute d1 start date start-month start-year 12 -1 1 macro-y d2 end end-month end-year -2 prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 s e d t never displayed-month displayed-year append calendar-holiday-list p in-range a] 6 (#$ . 4084)]) #@67 Generate a list of all diary-entries from absolute date D1 to D2. (defalias 'cal-tex-list-diary-entries #[(d1 d2) "ÀÂÃ\f! \fZT\")‡" [nil diary-display-hook list-diary-entries calendar-gregorian-from-absolute d1 d2] 4 (#$ . 5306)]) #@122 Insert the LaTeX preamble. Preamble Includes initial definitions for various LaTeX commands. Optional ARGS are included. (defalias 'cal-tex-preamble #[(&optional args) "À !qˆÂ ˆÃcˆ\fƒÅ\fƱˆÇȱ‡" [get-buffer-create cal-tex-buffer erase-buffer "\\documentstyle" args "[" "]" "{article}\n" "\\hbadness 20000\n\\vbadness 20000\n\\marginparwidth 0pt\n\\oddsidemargin -2cm\n\\evensidemargin -2cm\n\\marginparsep 0pt\n\\topmargin 0pt\n\\textwidth 7.5in\n\\textheight 9.5in\n\\newlength{\\cellwidth}\n\\newlength{\\cellheight}\n\\newlength{\\boxwidth}\n\\newlength{\\boxheight}\n\\newlength{\\cellsize}\n\\newcommand{\\myday}[1]{}\n\\newcommand{\\caldate}[6]{}\n\\newcommand{\\nocaldate}[6]{}\n\\newcommand{\\calsmall}[6]{}\n%\n"] 3 (#$ . 5545)]) #@114 Make a buffer with LaTeX commands for the year cursor is on. Optional prefix argument specifies number of years. (defalias 'cal-tex-cursor-year #[(&optional arg) "ÀÁÂ!‰AA@)\fƒ\f‚Å\"‡" [cal-tex-year calendar-cursor-to-date t date arg 1] 4 (#$ . 6312) "P"]) #@114 Make a buffer with LaTeX commands for the year cursor is on. Optional prefix argument specifies number of years. (defalias 'cal-tex-cursor-year-landscape #[(&optional arg) "ÀÁÂ!‰AA@)\fƒ\f‚ÅÂ#‡" [cal-tex-year calendar-cursor-to-date t date arg 1] 5 (#$ . 6580) "P"]) #@229 Make a one page yearly calendar of YEAR; do this for N years. There are four rows of three months each, unless optional LANDSCAPE is t, in which case the calendar isprinted in landscape mode with three rows of four months each. (defalias 'cal-tex-year #[(year n &optional landscape) "ÀÁ\nÃ#ˆ\nƒÄÅ!ˆ‚ÄÆ!ˆÇ T‰Yƒ±ÊcˆË ˆÌÍ!!ˆÏ ˆÄÐ!ˆË ˆÑÒ\nƒEÓ‚FÔ\"ˆÕcˆÖ ˆ× ˆÇÙT‰YƒŠÚÛÜÝ%cˆÞcˆßà!ˆá\nƒ|â‚}ã\"ÇUƒT×à!ˆ‚T)ä ˆÏ ˆÊcˆT U„§å ˆ‚ªæ ˆçè!ˆ‚)çé!‡" [cal-tex-insert-preamble 1 landscape "12pt" cal-tex-vspace "-.6cm" "-3.1cm" 0 j n "\\vfill%\n" cal-tex-b-center cal-tex-Huge number-to-string year cal-tex-e-center "1cm" cal-tex-b-parbox "l" "5.9in" "4.3in" "\n" cal-tex-noindent cal-tex-nl i 12 cal-tex-mini-calendar "month" "1.1in" "1in" "\\month" cal-tex-hspace "0.5in" mod 4 3 cal-tex-e-parbox cal-tex-newpage cal-tex-end-document run-hooks cal-tex-year-hook cal-tex-hook] 6 (#$ . 6858)]) #@116 Make a Filofax one page yearly calendar of year indicated by cursor. Optional parameter specifies number of years. (defalias 'cal-tex-cursor-filofax-year #[(&optional arg) "ƒ‚ ÁÃÄ!‰AA@)ÇÈ!ˆÉÊ!ˆÉË!ˆÉÌ!ˆÉÍ!ˆÉÎ!ˆÉÏ!ˆÉÐ!ˆÑ ˆÒ\nT‰Yƒ¥ÔÕ\"cˆÖ ˆ×ØÙ\"ˆÚcˆÛ ˆÜ ˆÒÞT‰Yƒßà!áâã&cˆ‚a)äcˆå ˆæ ˆT\nU„›ç ˆ‚žè ˆéê!ˆ‚;)éë!*‡" [arg 1 n calendar-cursor-to-date t date year cal-tex-preamble "twoside" cal-tex-cmd "\\textwidth 3.25in" "\\textheight 6.5in" "\\oddsidemargin 1.6in" "\\evensidemargin 1.55in" "\\topmargin 0pt" "\\headheight -0.875in" "\\pagestyle{empty}" cal-tex-b-document 0 j format "\\hfil {\\Large \\bf %s} \\hfil\\\\\n" cal-tex-b-center cal-tex-b-parbox "l" "\\textwidth" "\n" cal-tex-noindent cal-tex-nl i 12 cal-tex-mini-calendar calendar-month-name "1.05in" ".8in" "tiny" "\\noindent\\fbox{\\January}\\fbox{\\February}\\fbox{\\March}\\\\\n\\noindent\\fbox{\\April}\\fbox{\\May}\\fbox{\\June}\\\\\n\\noindent\\fbox{\\July}\\fbox{\\August}\\fbox{\\September}\\\\\n\\noindent\\fbox{\\October}\\fbox{\\November}\\fbox{\\December}\n" cal-tex-e-parbox cal-tex-e-center cal-tex-newpage cal-tex-end-document run-hooks cal-tex-year-hook cal-tex-hook] 8 (#$ . 7781) "P"]) #@187 Make a buffer with LaTeX commands for the month cursor is on. Optional prefix argument specifies number of months to be produced. The output is in landscape format, one month to a page. (defalias 'cal-tex-cursor-month-landscape #[(&optional arg) "ƒ‚ ÁÃÄ!‰‰@) ‰AA@) Ê  Ì_\\\nS\\Í\\‰̦TÌ¥ )…ÐÁE‰‰AA@)S ‰‰@) ‰A@) ‰AA@)SÓ_\\ÕVƒ¸Ö_×\\Ø¥Z‰Ö¦ÙU…¯Ú¦ÙU?†¯Û¦ÙU)ƒ¸T-Ü_\\Ö¥\\Ú¥[\\Û¥\\*‰ ‰ÕUƒ‰Ö¦ÙU…üÚ¦ÙU?†üÛ¦ÙU)ƒÝ‚ ÞSH* E‰‰AA@)S ‰‰@) ‰A@) ‰AA@)SÓ_\\ÕVƒuÖ_×\\Ø¥Z‰Ö¦ÙU…lÚ¦ÙU?†lÛ¦ÙU)ƒuT-Ü_\\Ö¥\\Ú¥[\\Û¥\\*\"…ÚàÁE‰‰AA@)S ‰‰@) ‰A@) ‰AA@)SÓ_\\ÕVƒÖ_×\\Ø¥Z‰Ö¦ÙU…úÚ¦ÙU?†úÛ¦ÙU)ƒT-Ü_\\Ö¥\\Ú¥[\\Û¥\\*‰ ‰ÕUƒO‰Ö¦ÙU…GÚ¦ÙU?†GÛ¦ÙU)ƒOÝ‚TÞSH* E‰‰AA@)S ‰‰@) ‰A@) ‰AA@)SÓ_\\ÕVƒÀÖ_×\\Ø¥Z‰Ö¦ÙU…·Ú¦ÙU?†·Û¦ÙU)ƒÀT-Ü_\\Ö¥\\Ú¥[\\Û¥\\*\"቉\"#$%&çèÁ#Äé#ˆê+!ˆÙ,\n,T‰,Yƒ<$‰#Ì_$\\í\\‰̦T$Ì¥#)î$#ïðñ%cˆ#Ì_$\\Á\\‰̦T$Ì¥#)î$#òðñ%cˆóÁ%ˆô ˆõö!ˆÁ÷øÁE!9Zú\"W‰\"ƒûcˆü=#ˆþ&%=%ˆÿ=#ˆ\"„öÁ÷9Sø‰‰ÕUƒÜ‰Ö¦ÙU…ÔÚ¦ÙU?†ÔÛ¦ÙU)ƒÜÝ‚áÞSH*E!Zú\"Wƒö@A±ˆ,\nU„ûBC!ˆD ˆÌ_\\Í\\Á\\‰̦TÌ¥)EF!ˆçèÁ#ÄéÄ$ˆ‚û)G ˆBH!.\f‡" [arg 1 n calendar-cursor-to-date t date month year end-month end-year (0 1 2 3 4 5 6) cal-tex-which-days 12 -1 macro-y cal-tex-diary cal-tex-list-diary-entries prior-years day 31 day-of-year 2 4 23 10 0 100 400 365 29 [31 28 31 30 31 30 31 31 30 31 30 31] cal-tex-holidays cal-tex-list-holidays nil small-months-at-start other-year other-month holidays diary-list cal-tex-insert-preamble cal-tex-number-weeks "12pt" cal-tex-cmd cal-tex-cal-one-month i -2 cal-tex-mini-calendar "lastmonth" "\\cellwidth" "\\cellheight" "nextmonth" cal-tex-insert-month-header cal-tex-insert-day-names cal-tex-nl ".2cm" mod calendar-day-of-week calendar-week-start-day 7 "\\lastmonth\\nextmonth\\hspace*{-2\\cellwidth}" cal-tex-insert-blank-days cal-tex-day-prefix cal-tex-insert-days cal-tex-insert-blank-days-at-end "\\vspace*{-\\cellwidth}\\hspace*{-2\\cellwidth}" "\\lastmonth\\nextmonth" run-hooks cal-tex-month-hook cal-tex-newpage cal-tex-vspace "-2cm" cal-tex-end-document cal-tex-hook] 9 (#$ . 8992) "P"]) #@168 Make a buffer with LaTeX commands for the month cursor is on. Optional prefix argument specifies number of months to be produced. Calendar is condensed onto one page. (defalias 'cal-tex-cursor-month #[(arg) "ÀÁ!‰‰@)\n‰AA@) \fƒ!‚\"È Ê_ \\ S\\Ë\\‰\fʦT\fÊ¥) …mÎ È\fE‰‰AA@)S\n‰‰@)\n‰A@)\n‰AA@) SÑ_\\ ÓVƒ§ Ô_Õ\\Ö¥Z\f‰Ô¦×U…ž\fئ×U?†ž\fÙ¦×U)ƒ§T-Ú_\\Ô¥\\Ø¥[\\Ù¥\\* ‰‰ÓUƒì\f‰Ô¦×U…ä\fئ×U?†ä\fÙ¦×U)ƒìÛ‚ðÜ SH*E‰‰AA@)S\n‰‰@)\n‰A@)\n‰AA@) SÑ_\\ ÓVƒS Ô_Õ\\Ö¥Z\f‰Ô¦×U…J\fئ×U?†J\fÙ¦×U)ƒST-Ú_\\Ô¥\\Ø¥[\\Ù¥\\*\"…œÞ È\fE‰‰AA@)S\n‰‰@)\n‰A@)\n‰AA@) SÑ_\\ ÓVƒÖ Ô_Õ\\Ö¥Z\f‰Ô¦×U…Í\fئ×U?†Í\fÙ¦×U)ƒÖT-Ú_\\Ô¥\\Ø¥[\\Ù¥\\* ‰‰ÓUƒ\f‰Ô¦×U…\fئ×U?†\fÙ¦×U)ƒÛ‚Ü SH*E‰‰AA@)S\n‰‰@)\n‰A@)\n‰AA@) SÑ_\\ ÓVƒ‚ Ô_Õ\\Ö¥Z\f‰Ô¦×U…y\fئ×U?†y\fÙ¦×U)ƒ‚T-Ú_\\Ô¥\\Ø¥[\\Ù¥\\*\"߉ !\"#äå \f #ßæ#ˆ ÈVƒÀç(!ˆ‚Åç)!ˆê \f %ˆë ˆìí!ˆî \f/#ˆ×0 0T‰0Yƒ !\f ñ \f#\"/%ˆ\fÊ_ \\Ë\\È\\‰\fʦT\fÊ¥)‚à)ò /#ˆó ˆ.\nôõ!‡" [calendar-cursor-to-date t date month year end-month end-year arg 1 n 12 -1 macro-y cal-tex-diary cal-tex-list-diary-entries prior-years day 31 day-of-year 2 4 23 10 0 100 400 365 29 [31 28 31 30 31 30 31 31 30 31 30 31] cal-tex-holidays cal-tex-list-holidays nil other-year other-month holidays diary-list cal-tex-insert-preamble cal-tex-number-weeks "12pt" cal-tex-cmd cal-tex-cal-multi-month cal-tex-cal-one-month cal-tex-insert-month-header cal-tex-insert-day-names cal-tex-nl ".2cm" cal-tex-insert-blank-days cal-tex-day-prefix i cal-tex-insert-days cal-tex-insert-blank-days-at-end cal-tex-end-document run-hooks cal-tex-hook] 9 (#$ . 11389) "P"]) #@252 Insert LaTeX commands for a range of days in monthly calendars. LaTeX commands are inserted for the days of the MONTH in YEAR. Diary entries on DIARY-LIST are included. Holidays on HOLIDAYS are included. Each day is formatted using format DAY-FORMAT. (defalias 'cal-tex-insert-days #[(month year diary-list holidays day-format) "ÀÁ\nÃ\fE! ZÆ\"È \n\f‰ÊUƒ:\f‰˦ÌU…2\fͦÌU?†2\fΦÌU)ƒ:Ï‚>Ð\nSH*ÌT‰Y…©\n\fE Á !>ƒ‹ÔÖ\n!#cˆ×Ø \"!ˆ×Ø \"!ˆ×Û!!ˆ× ˆÝ ˆÀ\\Æ\"ÌUƒDU„DÞ ˆß ˆ‚D,‡" [mod calendar-day-of-week month 1 year calendar-week-start-day 7 blank-days nil date 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] last i cal-tex-which-days format day-format calendar-month-name cal-tex-arg cal-tex-latexify-list diary-list holidays eval cal-tex-daily-string cal-tex-comment cal-tex-hfill cal-tex-nl] 6 (#$ . 13148)]) #@60 Insert the names of the days at top of a monthly calendar. (defalias 'cal-tex-insert-day-names #[nil "À T‰Y…& >ƒ Ä Ç \\É\"H\"cˆÊ ˆ‚)‡" [-1 i 6 cal-tex-which-days format cal-tex-day-name-format calendar-day-name-array mod calendar-week-start-day 7 cal-tex-comment] 6 (#$ . 14015)]) #@143 Create a title for a calendar. A title is inserted for a calendar with N months starting with MONTH YEAR and ending with END-MONTH END-YEAR. (defalias 'cal-tex-insert-month-header #[(n month year end-month end-year) "À !À\n! ÆUƒÇÈ\f #cˆ‚$ÇÊ\f  %cˆ*Ì ‡" [calendar-month-name month end-month end-month-name month-name n 1 format "\\calmonth{%s}{%s}\n\\vspace*{-0.5cm}" year "\\calmonth{%s}{%s}{%s}{%s}\n\\vspace*{-0.5cm}" end-year cal-tex-comment] 6 (#$ . 14315)]) #@217 Insert code for initial days not in calendar. Insert LaTeX code for the blank days at the beginning of the MONTH in YEAR. The entry is formatted using DAY-FORMAT. If the entire week is blank, no days are inserted. (defalias 'cal-tex-insert-blank-days #[(month year day-format) "À \n\"…;ÃÄ Å\nE!ZÇ\"É\nS\nT‰\nY…:\n >ƒÌ Ή#ϱˆ‚*‡" [cal-tex-first-blank-p month year mod calendar-day-of-week 1 calendar-week-start-day 7 blank-days -1 i cal-tex-which-days format day-format " " "{}{}{}{}%\n"] 5 (#$ . 14795)]) #@156 Insert code for final days not in calendar. Insert LaTeX code for the blank days at the end of the MONTH in YEAR. The entry is formatted using DAY-FORMAT. (defalias 'cal-tex-insert-blank-days-at-end #[(month year day-format) "À \n\"…m \n‰ÃUƒ1\n‰ĦÅU…)\nƦÅU?†)\nǦÅU)ƒ1È‚5É SH*\nËÌ \n\nE! ZÎ\"‰TSÑT‰Y…l>ƒLÓÕ‰#Ö±ˆ‚L+‡" [cal-tex-last-blank-p month year 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] last-day mod calendar-day-of-week calendar-week-start-day 7 blank-days i 6 cal-tex-which-days format day-format "" "{}{}{}{}%\n"] 6 (#$ . 15328)]) #@165 Determine if any days of the first week will be printed. Return t if there will there be any days of the first week printed in the calendar starting in MONTH YEAR. (defalias 'cal-tex-first-blank-p #[(month year) "À‰ÃÅ\fT‰Yƒ!Æ\fE!ÉUƒ\f‚)à \fT‰Yƒ@Æ\fE!\n>ƒ$Ë‚$)\n*‡" [nil the-saturday any-days 0 i 7 calendar-day-of-week month year 6 cal-tex-which-days t] 4 (#$ . 15918)]) #@163 Determine if any days of the last week will be printed. Return t if there will there be any days of the last week printed in the calendar starting in MONTH YEAR. (defalias 'cal-tex-last-blank-p #[(month year) "À \n‰ÃUƒ+\n‰ĦÅU…#\nƦÅU?†#\nǦÅU)ƒ+È‚/É SH*À\n \f ÍZS T‰Yƒ]Ï \nE!ÅUƒ>\n‚>)\nS T‰Yƒ‚Ï \nE!>ƒcÑ\f‚c)\f+‡" [nil month year 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] the-sunday last-day any-days 6 i calendar-day-of-week cal-tex-which-days t] 5 (#$ . 16321)]) #@233 Determine the number of weeks in a range of dates. Compute the number of weeks in the calendar starting with MONTH and YEAR, and lasting N months, including only the days in WHICH-DAYS. As it stands, this is only an upper bound. (defalias 'cal-tex-number-weeks #[(month year n) "Á\nE\nÄ_\\ S\\Æ\\‰ĦTÄ¥)È ‰\n‰ÊUƒJ\n‰˦ÌU…B\nͦÌU?†B\nΦÌU)ƒJÏ‚NÐSH*\nE‰‰AA@)S‰‰@)‰A@)‰AA@)SÔ_\\ÊVƒ¹Ë_Ö\\×¥Z\n‰˦ÌU…°\nͦÌU?†°\nΦÌU)ƒ¹T-Ø_\\Ë¥\\Í¥[\\Î¥\\*Ù\\\"È ‰‰AA@)S‰‰@)‰A@)‰AA@)SÔ_\\ÊVƒAË_Ö\\×¥Z\n‰˦ÌU…8\nͦÌU?†8\nΦÌU)ƒAT-Ø_\\Ë¥\\Í¥[\\Î¥\\*\"ZÙ¥)‡" [month 1 year d 12 n -1 macro-y calendar-dayname-on-or-before calendar-week-start-day 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] date prior-years day 31 day-of-year 23 10 365 7] 9 (#$ . 16851)]) #@212 Make a buffer with LaTeX commands for a two-page one-week calendar. It applies to the week that point is in. Optional prefix argument specifies number of weeks. Holidays are included if `cal-tex-holidays' is t. (defalias 'cal-tex-cursor-week #[(&optional arg) "ƒ‚ ÁÃÄ ÆÇ!‰‰AA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒ\nÐ_Ñ\\Ò¥Z\f‰\fЦÓU…x\fÔ¦ÓU?†x\fÕ¦ÓU)ƒT- Ö_\\ Ð¥\\ Ô¥[\\ Õ¥\\*\"!‰‰@)\n‰AA@)\f…Ô؉‰AA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒ*\nÐ_Ñ\\Ò¥Z\f‰\fЦÓU…!\fÔ¦ÓU?†!\fÕ¦ÓU)ƒ*T- Ö_\\ Ð¥\\ Ô¥[\\ Õ¥\\*\nÙ_‰‰AA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒ¹\nÐ_Ñ\\Ò¥Z\f‰\fЦÓU…°\fÔ¦ÓU?†°\fÕ¦ÓU)ƒ¹T- Ö_\\ Ð¥\\ Ô¥[\\ Õ¥\\*\\\"ÛÜ!ˆÝÞ!ˆÝß!ˆÝà!ˆÝá!ˆ\"cˆã ˆÝä!ˆÓ%\n%T‰%Yƒwæç!ˆè ˆéêëì\n!\"!ˆíî!ˆéï\f!!ˆðñ!ˆò ˆíó!ˆôõö\"ˆÓ7Ù7T‰7YƒNøù#ˆú!‚2)û ˆ‰@)\n‰AA@)\f%\nU„øüý!ˆþ ˆ‚ø)ÿ ˆü@!-‡" [arg 1 n calendar-gregorian-from-absolute calendar-dayname-on-or-before calendar-week-start-day calendar-cursor-to-date t date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 cal-tex-holidays cal-tex-list-holidays 7 holidays cal-tex-preamble "11pt" cal-tex-cmd "\\textwidth 6.5in" "\\textheight 10.5in" "\\oddsidemargin 0in" "\\evensidemargin 0in" cal-tex-LaTeX-hourbox cal-tex-b-document "\\pagestyle{empty}" i cal-tex-vspace "-1.5in" cal-tex-b-center cal-tex-Huge-bf format "\\uppercase{%s}" calendar-month-name cal-tex-hspace "2em" number-to-string cal-tex-nl ".5cm" cal-tex-e-center "-.2in" cal-tex-b-parbox "l" "7in" j cal-tex-week-hours "3.1" cal-tex-incr-date cal-tex-e-parbox run-hooks cal-tex-week-hook cal-tex-newpage cal-tex-end-document cal-tex-hook] 9 (#$ . 17732) "P"]) #@212 Make a buffer with LaTeX commands for a two-page one-week calendar. It applies to the week that point is in. Optional prefix argument specifies number of weeks. Holidays are included if `cal-tex-holidays' is t. (defalias 'cal-tex-cursor-week2 #[(&optional arg) "ƒ‚ ÁÃÄ ÆÇ!‰‰AA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒ\nÐ_Ñ\\Ò¥Z\f‰\fЦÓU…x\fÔ¦ÓU?†x\fÕ¦ÓU)ƒT- Ö_\\ Ð¥\\ Ô¥[\\ Õ¥\\*\"!‰‰@)\n‰AA@)\f…ØÙ‰‰AA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒ.\nÐ_Ñ\\Ò¥Z\f‰\fЦÓU…%\fÔ¦ÓU?†%\fÕ¦ÓU)ƒ.T- Ö_\\ Ð¥\\ Ô¥[\\ Õ¥\\*\nÚ_‰‰AA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒ½\nÐ_Ñ\\Ò¥Z\f‰\fЦÓU…´\fÔ¦ÓU?†´\fÕ¦ÓU)ƒ½T- Ö_\\ Ð¥\\ Ô¥[\\ Õ¥\\*\\\"ÜÝ!ˆÞß!ˆÞà!ˆÞá!ˆÞâ!ˆ#cˆä ˆÞå!ˆÓ&\n&T‰&Yƒ?çè!ˆé ˆêëìí\n!\"!ˆîï!ˆêð\f!!ˆñò!ˆó ˆîô!ˆõö÷\"ˆÓ8ù8T‰8YƒRúû#ˆü!‚6)ý ˆñ ˆþÿ!‰@)ÿ!‰AA@)@AB%cˆþ‰@)‰AA@)CAB%cˆþD!‰@)D!‰AA@)EAB%cˆFcˆG ˆHcˆG ˆIcˆG ˆJcˆG ˆKcˆñ ˆõö÷\"ˆù8Ú8T‰8Yƒúû#ˆü!‚ô)ý ˆ‰@)\n‰AA@)\f&\nU„üLM!ˆN ˆ‚ü)O ˆLP!.‡" [arg 1 n calendar-gregorian-from-absolute calendar-dayname-on-or-before calendar-week-start-day calendar-cursor-to-date t date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 d cal-tex-holidays cal-tex-list-holidays 7 holidays cal-tex-preamble "12pt" cal-tex-cmd "\\textwidth 6.5in" "\\textheight 10.5in" "\\oddsidemargin 0in" "\\evensidemargin 0in" cal-tex-LaTeX-hourbox cal-tex-b-document "\\pagestyle{empty}" i cal-tex-vspace "-1.5in" cal-tex-b-center cal-tex-Huge-bf format "\\uppercase{%s}" calendar-month-name cal-tex-hspace "2em" number-to-string cal-tex-nl ".5cm" cal-tex-e-center "-.2in" cal-tex-b-parbox "l" "\\textwidth" j 3 cal-tex-week-hours "5" cal-tex-incr-date cal-tex-e-parbox cal-tex-mini-calendar cal-tex-previous-month "lastmonth" "1.1in" "1in" "thismonth" cal-tex-next-month "nextmonth" "\\hbox to \\textwidth{" cal-tex-hfill "\\lastmonth" "\\thismonth" "\\nextmonth" "}" run-hooks cal-tex-week-hook cal-tex-newpage cal-tex-end-document cal-tex-hook] 9 (#$ . 19508) "P"]) #@231 Make a buffer with LaTeX commands for a one page ISO-style weekly calendar. Optional prefix argument specifies number of weeks. Diary entries are included if `cal-tex-diary' is t. Holidays are included if `cal-tex-holidays' is t. (defalias 'cal-tex-cursor-week-iso #[(&optional arg) "ƒ‚ ÁÃÄÁÅÆ!‰‰AA@)S‰‰@) ‰A@)\n‰AA@) \n SÌ_\\  ÎVƒ  Ï_Ð\\Ñ¥Z  ‰ ϦÒU…x Ó¦ÒU?†x Ô¦ÒU)ƒ T  -Õ_\\Ï¥\\Ó¥[\\Ô¥\\*\"!‰‰@) ‰AA@) ‰A@)\n…Þ׉‰AA@)S‰‰@) ‰A@)\n‰AA@) \n SÌ_\\  ÎVƒ4  Ï_Ð\\Ñ¥Z  ‰ ϦÒU…+ Ó¦ÒU?†+ Ô¦ÒU)ƒ4 T  -Õ_\\Ï¥\\Ó¥[\\Ô¥\\*\nØ_‰‰AA@)S‰‰@) ‰A@)\n‰AA@) \n SÌ_\\  ÎVƒÃ  Ï_Ð\\Ñ¥Z  ‰ ϦÒU…º Ó¦ÒU?†º Ô¦ÒU)ƒÃ T  -Õ_\\Ï¥\\Ó¥[\\Ô¥\\*\\\"…Û Á E‰‰AA@)S‰‰@) ‰A@)\n‰AA@) \n SÌ_\\  ÎVƒ]  Ï_Ð\\Ñ¥Z  ‰ ϦÒU…T Ó¦ÒU?†T Ô¦ÒU)ƒ] T  -Õ_\\Ï¥\\Ó¥[\\Ô¥\\*\nØ_‰‰AA@)S‰‰@) ‰A@)\n‰AA@) \n SÌ_\\  ÎVƒì  Ï_Ð\\Ñ¥Z  ‰ ϦÒU…ã Ó¦ÒU?†ã Ô¦ÒU)ƒì T  -Õ_\\Ï¥\\Ó¥[\\Ô¥\\*\\\"ÝÞ!ˆßà!ˆßá!ˆßâ!ˆßã!ˆä ˆßå!ˆÒ&\n&T‰&Yƒúçè!ˆé ˆê뉉AA@)S‰‰@) ‰A@)\n‰AA@) \n SÌ_\\  ÎVƒ®  Ï_Ð\\Ñ¥Z  ‰ ϦÒU…¥ Ó¦ÒU?†¥ Ô¦ÒU)ƒ® T  -Õ_\\Ï¥\\Ó¥[\\Ô¥\\*!,íî,‰@),‰AA@)#)!ˆïð!ˆñ ˆòóô\"ˆÒ5Ø5T‰5YƒÝòöô\"ˆòöô\"ˆ÷øôù#ˆï ˆòöô\"ˆúû!!ˆücˆúý !!ˆþcˆúÿ\n!!ˆ@\"A˜„OBcˆú@C#!ˆD ˆþEF!±ˆG ˆï ˆH ˆòöô\"ˆ@\"A˜„”Icˆú@\"!ˆJcˆG ˆï ˆK!‰‰@) ‰A@)\nG ˆGL!ˆï ˆ‰@) ‰AA@) ‚ï)G ˆ&\nU„'MN!ˆO ˆ‚')P ˆMQ!.‡" [arg 1 n calendar-gregorian-from-absolute calendar-dayname-on-or-before calendar-cursor-to-date t date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 cal-tex-holidays cal-tex-list-holidays 7 holidays cal-tex-diary cal-tex-list-diary-entries diary-list cal-tex-preamble "11pt" cal-tex-cmd "\\textwidth 6.5in" "\\textheight 10.5in" "\\oddsidemargin 0in" "\\evensidemargin 0in" cal-tex-b-document "\\pagestyle{empty}" i cal-tex-vspace "-1.5in" cal-tex-b-center cal-tex-Huge-bf calendar-iso-from-absolute d format "Week %d of %d" cal-tex-nl ".5cm" cal-tex-e-center cal-tex-b-parbox "l" "\\textwidth" j "t" cal-tex-rule "0pt" ".2mm" cal-tex-large-bf calendar-day-name ", " calendar-month-name " " number-to-string cal-tex-latexify-list "" ": " "; " cal-tex-hfill eval cal-tex-daily-string cal-tex-e-parbox cal-tex-noindent "\\vbox to 0pt{" "}" cal-tex-incr-date "2cm" run-hooks cal-tex-week-hook cal-tex-newpage cal-tex-end-document cal-tex-hook] 9 (#$ . 21699) "P"]) #@35 One hour and a line on the right. (defvar cal-tex-LaTeX-hourbox "\\newcommand{\\hourbox}[2]%\n{\\makebox[2em]{\\rule{0cm}{#2ex}#1}\\rule{3in}{.15mm}}\n" (#$ . 24331)) #@72 Insert hourly entries for DATE with HOLIDAYS, with line height HEIGHT. (defalias 'cal-tex-week-hours #[(date holidays height) "‰@)‰A@)‰AA@)ÁÆÇ!ˆÈÉ!ˆÈÊ!ˆËÌÍ\"ˆÎÏ!!ˆÐcˆÎÑ !!ˆÒcˆÎÓ\f!!ˆÔ\"Ö˜„V×cˆÎÔØ#!ˆÙ ˆÒÚ!±ˆÜ ˆÝÞ!ˆßàÍá#ˆÝâ!ˆã$å$T‰$Y…µ&ƒ$ç\\‚’$ãZÈèÓ$!\"ˆé*!ˆëì!ˆÈèÓ\n!\"ˆé*!ˆÝ ˆ‚u-‡" [date nil afternoon year day month cal-tex-comment "begin cal-tex-week-hours" cal-tex-cmd "\\ \\\\[-.2cm]" "\\noindent" cal-tex-b-parbox "l" "6.8in" cal-tex-large-bf calendar-day-name ", " calendar-month-name " " number-to-string cal-tex-latexify-list holidays "" ": " "; " cal-tex-hfill eval cal-tex-daily-string cal-tex-e-parbox cal-tex-nl "-.3cm" cal-tex-rule "0pt" ".2mm" "-.1cm" 7 i 12 cal-tex-24 5 "\\hourbox" cal-tex-arg height cal-tex-hspace ".4cm"] 6 (#$ . 24504)]) #@234 Make a buffer with LaTeX commands for a two-page one-week calendar. It applies to the week that point is in, and starts on Monday. Optional prefix argument specifies number of weeks. Holidays are included if `cal-tex-holidays' is t. (defalias 'cal-tex-cursor-week-monday #[(&optional arg) "ƒ‚ ÁÃÄÅÆÇ!‰‰AA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒ\nÐ_Ñ\\Ò¥Z\f‰\fЦÅU…x\fÓ¦ÅU?†x\fÔ¦ÅU)ƒT- Õ_\\ Ð¥\\ Ó¥[\\ Ô¥\\*\"!Ö×!ˆØÙ!ˆØÚ!ˆØÛ!ˆØÜ!ˆÝ ˆÅ\nT‰Yƒßà!ˆácˆâã!ä\"ˆâãÐ\"ä\"ˆåæ!ˆâãÏ\"ä\"ˆâãç\"ä\"ˆåæ!ˆâãè\"ä\"ˆâãé\"Ç\"ˆ\nU„¸êë!ˆãì\"í ˆ‚¸)î ˆêï!*‡" [arg 1 n calendar-gregorian-from-absolute calendar-dayname-on-or-before 0 calendar-cursor-to-date t date prior-years month day year 31 day-of-year 2 4 23 10 100 400 365 cal-tex-preamble "11pt" cal-tex-cmd "\\textwidth 6.5in" "\\textheight 10.5in" "\\oddsidemargin 0in" "\\evensidemargin 0in" cal-tex-b-document i cal-tex-vspace "-1cm" "\\noindent " cal-tex-weekly4-box cal-tex-incr-date nil cal-tex-nl ".2cm" 5 3 6 run-hooks cal-tex-week-hook 7 cal-tex-newpage cal-tex-end-document cal-tex-hook] 9 (#$ . 25305) "P"]) #@46 Make one box for DATE, different if WEEKEND. (defalias 'cal-tex-weekly4-box #[(date weekend) "‰A@)‰@)‰AA@)Ä!Æ!‰‰A@)‰@) ‰AA@)\nÄ! ÌÍÎ\"ˆÏÐÑ\"ˆÒÓ \n %cˆÔÕÑÖ#ˆ× ˆ„‘ÙÛT‰YƒwÒÜ\"cˆ‚b)ÝÞT‰YƒÒÜ\"cˆ‚{)×ß!ˆƒ¼àá!ˆâcˆÒÓ  \n%cˆÔÕÑÖ#ˆ×ã!ˆàá!ˆä ˆå ˆæá!. ‡" [date day month year calendar-day-name dayname cal-tex-incr-date date1 day1 month1 year1 dayname1 cal-tex-b-framebox "8cm" "l" cal-tex-b-parbox "b" "7.5cm" format "{\\Large\\bf %s,} %s/%s/%s\\\\\n" cal-tex-rule "0pt" ".5mm" cal-tex-nl weekend 7 i 12 "{\\large\\sf %d}\\\\\n" 0 5 ".5cm" cal-tex-vspace "1cm" "\\ \\vfill" "1.5cm" cal-tex-e-parbox cal-tex-e-framebox cal-tex-hspace] 7 (#$ . 26448)]) #@230 Two-weeks-at-a-glance Filofax style calendar for week indicated by cursor. Optional prefix argument specifies number of weeks. Diary entries are included if `cal-tex-diary' is t. Holidays are included if `cal-tex-holidays' is t. (defalias 'cal-tex-cursor-filofax-2week #[(&optional arg) "ƒ‚ ÁÃÄ ÆÇ!‰‰AA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒ\nÐ_Ñ\\Ò¥Z\f‰\fЦÓU…x\fÔ¦ÓU?†x\fÕ¦ÓU)ƒT- Ö_\\ Ð¥\\ Ô¥[\\ Õ¥\\*\"!‰‰@)\n‰AA@)\f‰A@) …Þ؉‰AA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒ4\nÐ_Ñ\\Ò¥Z\f‰\fЦÓU…+\fÔ¦ÓU?†+\fÕ¦ÓU)ƒ4T- Ö_\\ Ð¥\\ Ô¥[\\ Õ¥\\*\nÙ_‰‰AA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒÃ\nÐ_Ñ\\Ò¥Z\f‰\fЦÓU…º\fÔ¦ÓU?†º\fÕ¦ÓU)ƒÃT- Ö_\\ Ð¥\\ Ô¥[\\ Õ¥\\*\\\"…Ü\nÁ\fE‰‰AA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒ]\nÐ_Ñ\\Ò¥Z\f‰\fЦÓU…T\fÔ¦ÓU?†T\fÕ¦ÓU)ƒ]T- Ö_\\ Ð¥\\ Ô¥[\\ Õ¥\\*\nÙ_‰‰AA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒì\nÐ_Ñ\\Ò¥Z\f‰\fЦÓU…ã\fÔ¦ÓU?†ã\fÕ¦ÓU)ƒìT- Ö_\\ Ð¥\\ Ô¥[\\ Õ¥\\*\\\"Þß!ˆàá!ˆàâ!ˆàã!ˆàä!ˆàå!ˆàæ!ˆàç!ˆàè!ˆécˆê ˆàë!ˆÓ,\n,T‰,Yƒbí,Ï\"ÁUƒUîcˆ‚Xïcˆðñò\"3‰@)3‰@)UƒŠôõö‰@)!‰AA@)#‚è‰AA@)3‰AA@)UƒÁô÷ö‰@)!ö3‰@)!‰AA@)$‚èôøö‰@)!‰AA@)ö3‰@)!3‰AA@)%)!ˆùcˆÓ:Ù:T‰:YƒJí,Ï\"ÁUƒ\fûcˆ‚ücˆðý!!ˆðþ‰A@)!!ˆðÿ\"!ˆðÿ\"!ˆð@A!!ˆùcˆñ!‚ñ),\nU„:BC!ˆD ˆ‚:)E ˆBF!.‡" [arg 1 n calendar-gregorian-from-absolute calendar-dayname-on-or-before calendar-week-start-day calendar-cursor-to-date t date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 cal-tex-holidays cal-tex-list-holidays 7 holidays cal-tex-diary cal-tex-list-diary-entries diary-list cal-tex-preamble "twoside" cal-tex-cmd "\\textwidth 3.25in" "\\textheight 6.5in" "\\oddsidemargin 1.75in" "\\evensidemargin 1.5in" "\\topmargin 0pt" "\\headheight -0.875in" "\\headsep 0.125in" "\\footskip .125in" "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}\n\\long\\def\\rightday#1#2#3#4#5{%\n \\rule{\\textwidth}{0.3pt}\\\\%\n \\hbox to \\textwidth{%\n \\vbox to 0.7in{%\n \\vspace*{2pt}%\n \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%\n \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%\n \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}\n\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}\n\\long\\def\\leftday#1#2#3#4#5{%\n \\rule{\\textwidth}{0.3pt}\\\\%\n \\hbox to \\textwidth{%\n \\vbox to 0.7in{%\n \\vspace*{2pt}%\n \\hbox to \\textwidth{\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}%\n \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize \\em #4}}%\n \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}\n" cal-tex-b-document "\\pagestyle{empty}" i mod "\\righthead" "\\lefthead" cal-tex-arg cal-tex-incr-date 6 d format "%s %s" calendar-month-name "%s---%s %s" "%s %s---%s %s" "%\n" j "\\rightday" "\\leftday" calendar-day-name int-to-string cal-tex-latexify-list eval cal-tex-daily-string run-hooks cal-tex-week-hook cal-tex-newpage cal-tex-end-document cal-tex-hook] 9 (#$ . 27155) "P"]) #@253 One-week-at-a-glance Filofax style calendar for week indicated by cursor. Optional prefix argument specifies number of weeks. Weeks start on Monday. Diary entries are included if `cal-tex-diary' is t. Holidays are included if `cal-tex-holidays' is t. (defalias 'cal-tex-cursor-filofax-week #[(&optional arg) "ƒ‚ ÁÃÄÁÅÆ!‰‰AA@)S‰‰@) ‰A@)\n‰AA@) \n SÌ_\\  ÎVƒ  Ï_Ð\\Ñ¥Z  ‰ ϦÒU…x Ó¦ÒU?†x Ô¦ÒU)ƒ T  -Õ_\\Ï¥\\Ó¥[\\Ô¥\\*\"!‰‰@) ‰AA@) ‰A@)\n…Þ׉‰AA@)S‰‰@) ‰A@)\n‰AA@) \n SÌ_\\  ÎVƒ4  Ï_Ð\\Ñ¥Z  ‰ ϦÒU…+ Ó¦ÒU?†+ Ô¦ÒU)ƒ4 T  -Õ_\\Ï¥\\Ó¥[\\Ô¥\\*\nØ_‰‰AA@)S‰‰@) ‰A@)\n‰AA@) \n SÌ_\\  ÎVƒÃ  Ï_Ð\\Ñ¥Z  ‰ ϦÒU…º Ó¦ÒU?†º Ô¦ÒU)ƒÃ T  -Õ_\\Ï¥\\Ó¥[\\Ô¥\\*\\\"…Û Á E‰‰AA@)S‰‰@) ‰A@)\n‰AA@) \n SÌ_\\  ÎVƒ]  Ï_Ð\\Ñ¥Z  ‰ ϦÒU…T Ó¦ÒU?†T Ô¦ÒU)ƒ] T  -Õ_\\Ï¥\\Ó¥[\\Ô¥\\*\nØ_‰‰AA@)S‰‰@) ‰A@)\n‰AA@) \n SÌ_\\  ÎVƒì  Ï_Ð\\Ñ¥Z  ‰ ϦÒU…ã Ó¦ÒU?†ã Ô¦ÒU)ƒì T  -Õ_\\Ï¥\\Ó¥[\\Ô¥\\*\\\"ÝÞ!ˆßà!ˆßá!ˆßâ!ˆßã!ˆßä!ˆßå!ˆßæ!ˆßç!ˆècˆé ˆßê!ˆë ˆÒ,\n,T‰,Yƒ|ícˆîïÎ\"0‰@)0‰@)Uƒ}ñòó‰@)!‰AA@)#‚Û‰AA@)0‰AA@)Uƒ´ñôó‰@)!ó0‰@)!‰AA@)$‚Ûñõó‰@)!‰AA@)ó0‰@)!0‰AA@)%)!ˆöcˆÒ7ø7T‰7Yƒ+ùcˆîú!!ˆîû‰A@)!!ˆîü\"!ˆîü\"!ˆîý>!!ˆöcˆï!‚ä)ÿcˆë ˆ@cˆîïø\"0‰@)0‰@)Uƒiñòó‰@)!‰AA@)#‚ljAA@)0‰AA@)Uƒ ñôó‰@)!ó0‰@)!‰AA@)$‚Çñõó‰@)!‰AA@)ó0‰@)!0‰AA@)%)!ˆöcˆÒ7Î7T‰7YƒAcˆîú!!ˆîû‰A@)!!ˆîü\"!ˆîü\"!ˆîý>!!ˆöcˆï!‚Ð)Ò7Î7T‰7YƒfBcˆîú!!ˆîû‰A@)!!ˆîü\"!ˆîü\"!ˆîý>!!ˆöcˆï!‚),\nU„=CD!ˆë ˆ‚=)E ˆCF!.‡" [arg 1 n calendar-gregorian-from-absolute calendar-dayname-on-or-before calendar-cursor-to-date t date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 cal-tex-holidays cal-tex-list-holidays 7 holidays cal-tex-diary cal-tex-list-diary-entries diary-list cal-tex-preamble "twoside" cal-tex-cmd "\\textwidth 3.25in" "\\textheight 6.5in" "\\oddsidemargin 1.75in" "\\evensidemargin 1.5in" "\\topmargin 0pt" "\\headheight -0.875in" "\\headsep 0.125in" "\\footskip .125in" "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}\n\\long\\def\\rightday#1#2#3#4#5{%\n \\rule{\\textwidth}{0.3pt}\\\\%\n \\hbox to \\textwidth{%\n \\vbox to 1.85in{%\n \\vspace*{2pt}%\n \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%\n \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%\n \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}\n\\long\\def\\weekend#1#2#3#4#5{%\n \\rule{\\textwidth}{0.3pt}\\\\%\n \\hbox to \\textwidth{%\n \\vbox to .8in{%\n \\vspace*{2pt}%\n \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%\n \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%\n \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}\n\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}\n\\long\\def\\leftday#1#2#3#4#5{%\n \\rule{\\textwidth}{0.3pt}\\\\%\n \\hbox to \\textwidth{%\n \\vbox to 1.85in{%\n \\vspace*{2pt}%\n \\hbox to \\textwidth{\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}%\n \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize \\em #4}}%\n \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}\n" cal-tex-b-document "\\pagestyle{empty}\\ " cal-tex-newpage i "\\lefthead" cal-tex-arg cal-tex-incr-date d format "%s %s" calendar-month-name "%s---%s %s" "%s %s---%s %s" "%\n" j 3 "\\leftday" calendar-day-name int-to-string cal-tex-latexify-list eval cal-tex-daily-string "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n" "\\righthead" "\\rightday" "\\weekend" run-hooks cal-tex-week-hook cal-tex-end-document cal-tex-hook] 9 (#$ . 30512) "P"]) #@112 Make a buffer with LaTeX commands for the day cursor is on. Optional prefix argument specifies number of days. (defalias 'cal-tex-cursor-day #[(&optional arg) "ƒ‚ ÁÂÃ!‰‰AA@)S\f‰‰@)\f‰A@)\f‰AA@)SÉ_\\\nËVƒs\nÌ_Í\\Î¥Z\n‰̦ÏU…jЦÏU?†jѦÏU)ƒs\nT\n\n- Ò_\\ Ì¥\\ Ð¥[\\ Ñ¥\\*ÔÕ!ˆÖ×!ˆÖØ!ˆÙ ˆÖÚ!ˆÏT‰YƒÌÜÝ!ˆÞß\f!!ˆ\fTU„¡à ˆáâ!ˆ‚¡)ã ˆáä!*‡" [arg 1 calendar-cursor-to-date t date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 n cal-tex-preamble "12pt" cal-tex-cmd "\\textwidth 6.5in" "\\textheight 10.5in" cal-tex-b-document "\\pagestyle{empty}" i cal-tex-vspace "-1.7in" cal-tex-daily-page calendar-gregorian-from-absolute cal-tex-newpage run-hooks cal-tex-daily-hook cal-tex-end-document cal-tex-hook] 7 (#$ . 34566) "P"]) #@61 Make a calendar page for Gregorian DATE on 8.5 by 11 paper. (defalias 'cal-tex-daily-page #[(date) "À ‰@)!ÅÆ!ˆÇÈÉ\"ˆÊËÌ\"ˆÍΉÏ#ˆÐÑ ‰A@)!!ˆÒÓ!ˆÔ\f!ˆÕ ˆÖ×!ˆØÙ!!ˆÖÛ!ˆÜ ˆÝ ˆÇÈÞ\"ˆÔß !!ˆÜ ˆÒ ˆÖà!ˆÍÎáâ#ˆÒã!ˆ$S%&%T‰%YƒÆçè!ˆ)ƒ‡%‚Œê%ë\"‰ìUƒ•ëÇ×í\"ˆîÑ !!ˆÜ ˆÍÎïð#ˆÒñ!ˆÇ×í\"ˆîò!ˆÜ ˆÍÎïð#ˆÒñ!ˆ‚m)Ý ˆóô !‰@)ô !‰AA@)õö÷%cˆó ‰@) ‰AA@)øö÷%cˆóù !‰@)ù !‰AA@)úö÷%cˆûcˆÝ ˆücˆÝ ˆýcˆÝ ˆþcˆÝ ˆÿcˆÅ@!*‡" [nil hour calendar-month-name date month-name cal-tex-banner "cal-tex-daily-page" cal-tex-b-makebox "4cm" "l" cal-tex-b-parbox "b" "3.8cm" cal-tex-rule "0mm" "2cm" cal-tex-Huge number-to-string cal-tex-nl ".5cm" cal-tex-bf cal-tex-e-parbox cal-tex-hspace "1cm" cal-tex-scriptsize eval cal-tex-daily-string "3.5cm" cal-tex-e-makebox cal-tex-hfill "r" calendar-day-name ".4cm" "16.1cm" "1mm" ".1cm" cal-tex-daily-start i cal-tex-daily-end cal-tex-cmd "\\noindent" cal-tex-24 mod 12 0 "c" cal-tex-arg "15.5cm" ".2mm" ".2cm" "$\\diamond$" cal-tex-mini-calendar cal-tex-previous-month "lastmonth" "1.1in" "1in" "thismonth" cal-tex-next-month "nextmonth" "\\hbox to \\textwidth{" "\\lastmonth" "\\thismonth" "\\nextmonth" "}" "end of cal-tex-daily-page"] 7 (#$ . 35373)]) #@139 Produce mini-calendar for MONTH, YEAR in macro NAME with WIDTH and HEIGHT. Optional SIZE gives the point size; scriptsize is the default, (defalias 'cal-tex-mini-calendar #[(month year name width height &optional size) "ÀÁ\nÃ\fE! ZÆ\"\n\f‰ÈUƒ7\f‰ɦÊU…/\f˦ÊU?†/\f̦ÊU)ƒ7Í‚;Î\nSH*ÐÒÔÕÔ×Ô؃X‚YÚÛÜÝÞß\n!àá\f!â°#ä%æ%T‰%Yƒ˜#'À %\\Æ\"HÊÈO%æU„‘è‚’éQ#‚l)Ê%%T‰%Yƒ±#èP#‚œ)Ê%%T‰%Yƒï#á%!P‰#À%\\Æ\"ÊUƒè%U„äé‚éê‚éèP#‚µ)#ëP‰#+‡" [mod calendar-day-of-week month 1 year calendar-week-start-day 7 blank-days 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] last "\\def\\" name "{\\hbox to" width "{%\n" "\\vbox to" height "\\vfil \\hbox to" "\\hfil\\" size "scriptsize" "\\begin{tabular}" "{@{\\hspace{1mm}}r@{\\hspace{1mm}}r@{\\hspace{1mm}}r@{\\hspace{1mm}}" "r@{\\hspace{1mm}}r@{\\hspace{1mm}}r@{\\hspace{1mm}}r@{\\hspace{1mm}}}%\n" "\\multicolumn{7}{c}{" calendar-month-name " " int-to-string "}\\\\[0.5mm]\n" str -1 i 6 calendar-day-name-array " & " "\\\\[0.5mm]\n" "" "\n\\end{tabular}\\hfil}\\vfil}}}%\n"] 22 (#$ . 36556)]) #@92 The date of the day following DATE. If optional N is given, the date of N days after DATE. (defalias 'cal-tex-incr-date #[(date &optional n) "À ƒ ‚\n ‰‰AA@)S ‰‰@) ‰A@) ‰AA@) SÈ_\\ ÊVƒn Ë_Ì\\Í¥Z ‰˦ÎU…eϦÎU?†eЦÎU)ƒn T  -\fÑ_\\\fË¥\\\fÏ¥[\\\fÐ¥\\*\\!‡" [calendar-gregorian-from-absolute n 1 date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365] 8 (#$ . 37653)]) #@148 Return string with concatenated, LaTeXified entries in DATE_LIST for DATE. Use double backslash as a separator unless optional SEPARATOR is given. (defalias 'cal-tex-latexify-list #[(date-list date &optional separator) "ÀÁ \fƒ(\f@@ƒ!Æ\f@@\"ƒ!È\f@A \"\fA‰„\n * ƒ4 ‚5Ê#‡" [mapconcat #[(x) "À !‡" [cal-tex-LaTeXify-string x] 2] nil date-list p result calendar-date-equal date append separator "\\\\"] 6 (#$ . 38077)]) #@65 Return the date of the first day in the month previous to DATE. (defalias 'cal-tex-previous-month #[(date) "‰@)‰AA@)‰Ã_ \\Ä\\‰æT Ã¥) Æ\nE*‡" [date month year 12 -2 macro-y 1] 4 (#$ . 38513)]) #@64 Return the date of the first day in the month following DATE. (defalias 'cal-tex-next-month #[(date) "‰@)‰AA@)‰Ã_ \\Ä\\Å\\‰æTÃ¥) Å\nE*‡" [date month year 12 -1 1 macro-y] 4 (#$ . 38721)]) #@126 Finish the LaTeX document. Insert the trailer to LaTeX document, pop to LaTeX buffer, add informative header, and run HOOK. (defalias 'cal-tex-end-document #[nil "À ˆÁ ˆÂ !ˆebˆÄÅ!ˆÄÆ!ˆÄÇ!ˆÄÈ!ˆeb‡" [cal-tex-e-document latex-mode pop-to-buffer cal-tex-buffer cal-tex-comment " This buffer was produced by cal-tex.el." " To print a calendar, type" " M-x tex-buffer RET" " M-x tex-print RET"] 2 (#$ . 38930)]) #@275 Initialize the output buffer. Select the output buffer, and insert the preamble for a calendar of WEEKS weeks. Insert code for landscape mode if LANDSCAPE is true. Use pointsize SIZE. Optional argument APPEND, if t, means add to end of without erasing current contents. (defalias 'cal-tex-insert-preamble #[(weeks landscape size &optional append) "ÀÁ\fƒ\fÁÀ „HÆ!ˆ\f„$ÈÉ!ˆÈÊ!ˆ‚7ÈË!ˆÈÌ!ˆÈÍ!ˆÎ ˆÈÏ!ˆÈ!ˆÈ!ˆÒ ˆÈÓ!ˆÈÔ \"ˆÕÖ×G¥\"cˆÈÙ\n\"ˆÕÚÛ¥\"cˆÈÝ!ˆÞß!*‡" ["18cm" "24cm" height width landscape append cal-tex-preamble size cal-tex-cmd "\\oddsidemargin -1.75cm" "\\def\\holidaymult{.06}" "\\special{landscape}" "\\textwidth 9.5in" "\\textheight 7in" cal-tex-comment "\\def\\holidaymult{.08}" cal-tex-caldate cal-tex-myday cal-tex-b-document "\\pagestyle{empty}" "\\setlength{\\cellwidth}" format "\\setlength{\\cellwidth}{%f\\cellwidth}\n" 1.1000000000000001 cal-tex-which-days "\\setlength{\\cellheight}" "\\setlength{\\cellheight}{%f\\cellheight}\n" 1.0 weeks "\\ \\par" cal-tex-vspace "-3cm"] 4 (#$ . 39375)]) #@41 List of symbols and their replacements. (defvar cal-tex-LaTeX-subst-list (quote (("\"" . "``") ("\"" . "''") ("@" . "\\verb|@|") ("&" . "\\&") ("%" . "\\%") ("$" . "\\$") ("#" . "\\#") ("_" . "\\_") ("{" . "\\{") ("}" . "\\}") ("<" . "$<$") (">" . "$>$") ("\n" . "\\ \\\\"))) (#$ . 40410)) #@50 Protect special characters in STRING from LaTeX. (defalias 'cal-tex-LaTeXify-string #[(string) "„Á‡Á\n\fÁ˜„G\fÆÇOÉ \"‰\nƒ.˘ƒ.Ì !\fÇÍO \nƒ?\nA‚AP*‚\f +‡" [string "" cal-tex-LaTeX-subst-list list tail head 0 1 ch assoc pair "\"" reverse nil] 4 (#$ . 40706)]) #@15 Insert hfill. (defalias 'cal-tex-hfill #[nil "Àc‡" ["\\hfill"] 1 (#$ . 40997)]) #@17 Insert newpage. (defalias 'cal-tex-newpage #[nil "Àc‡" ["\\newpage%\n"] 1 (#$ . 41083)]) #@18 Insert noindent. (defalias 'cal-tex-noindent #[nil "Àc‡" ["\\noindent"] 1 (#$ . 41178)]) #@49 Insert vspace command to move SPACE vertically. (defalias 'cal-tex-vspace #[(space) "À ±ˆÃ ‡" ["\\vspace*{" space "}" cal-tex-comment] 3 (#$ . 41273)]) #@51 Insert hspace command to move SPACE horizontally. (defalias 'cal-tex-hspace #[(space) "À ±ˆÃ ‡" ["\\hspace*{" space "}" cal-tex-comment] 3 (#$ . 41433)]) #@80 Insert % at end of line, include COMMENT if present, and move to next line. (defalias 'cal-tex-comment #[(&optional comment) "Àcˆ ƒ\n cˆÂc‡" ["% " comment "\n"] 1 (#$ . 41595)]) #@46 Insert the COMMENT separated by blank lines. (defalias 'cal-tex-banner #[(comment) "À ˆÀ ˆÀÁ\nP!ˆÀ ‡" [cal-tex-comment " " comment] 3 (#$ . 41783)]) #@84 End a line with \. If SKIP, then add that much spacing. Add COMMENT if present (defalias 'cal-tex-nl #[(&optional skip comment) "Àcˆ ƒ  ñˆÄ !‡" ["\\\\" skip "[" "]" cal-tex-comment comment] 3 (#$ . 41940)]) #@44 Insert optional TEXT surrounded by braces. (defalias 'cal-tex-arg #[(&optional text) "Àcˆ ƒ\n cˆÂc‡" ["{" text "}"] 1 (#$ . 42161)]) #@53 Insert LaTeX CMD, with optional ARG, and end with % (defalias 'cal-tex-cmd #[(cmd &optional arg) "cˆÁ\n!ˆÃ ‡" [cmd cal-tex-arg arg cal-tex-comment] 2 (#$ . 42301)]) #@31 Insert beginning of document. (defalias 'cal-tex-b-document #[nil "ÀÁ!‡" [cal-tex-cmd "\\begin{document}"] 2 (#$ . 42473)]) #@25 Insert end of document. (defalias 'cal-tex-e-document #[nil "ÀÁ!‡" [cal-tex-cmd "\\end{document}"] 2 (#$ . 42603)]) #@37 Insert beginning of centered block. (defalias 'cal-tex-b-center #[nil "ÀÁ!‡" [cal-tex-cmd "\\begin{center}"] 2 (#$ . 42725)]) #@31 Insert end of centered block. (defalias 'cal-tex-e-center #[nil "À ˆÁÂ!‡" [cal-tex-comment cal-tex-cmd "\\end{center}"] 2 (#$ . 42857)]) #@51 Insert parbox with parameters POSITION and WIDTH. (defalias 'cal-tex-b-parbox #[(position width) "À  ıˆÅ ‡" ["\\parbox[" position "]{" width "}{" cal-tex-comment] 5 (#$ . 43000)]) #@54 Insert end of parbox. Force it to be a given HEIGHT. (defalias 'cal-tex-e-parbox #[(&optional height) "À ˆ ƒ ÂÉ #ˆÄcˆÀÅ!‡" [cal-tex-comment height cal-tex-rule "0mm" "}" "end parbox"] 4 (#$ . 43189)]) #@60 Insert framebox with parameters WIDTH and POSITION (clr). (defalias 'cal-tex-b-framebox #[(width position) "À  ıˆÅ ‡" ["\\framebox[" width "][" position "]{" cal-tex-comment] 5 (#$ . 43398)]) #@25 Insert end of framebox. (defalias 'cal-tex-e-framebox #[nil "À ˆÁcˆÀÂ!‡" [cal-tex-comment "}" "end framebox"] 2 (#$ . 43600)]) #@59 Insert makebox with parameters WIDTH and POSITION (clr). (defalias 'cal-tex-b-makebox #[(width position) "À  ıˆÅ ‡" ["\\makebox[" width "][" position "]{" cal-tex-comment] 5 (#$ . 43733)]) #@24 Insert end of makebox. (defalias 'cal-tex-e-makebox #[nil "À ˆÁcˆÀÂ!‡" [cal-tex-comment "}" "end makebox"] 2 (#$ . 43932)]) #@51 Insert a rule with parameters LOWER WIDTH HEIGHT. (defalias 'cal-tex-rule #[(lower width height) "À Â Ä Æ±‡" ["\\rule[" lower "]{" width "}{" height "}"] 7 (#$ . 44062)]) #@27 Insert STRING in bf font. (defalias 'cal-tex-em #[(string) "À ±‡" ["{\\em " string "}"] 3 (#$ . 44240)]) #@27 Insert STRING in bf font. (defalias 'cal-tex-bf #[(string) "À ±‡" ["{\\bf " string "}"] 3 (#$ . 44353)]) #@35 Insert STRING in scriptsize font. (defalias 'cal-tex-scriptsize #[(string) "À ±‡" ["{\\scriptsize " string "}"] 3 (#$ . 44466)]) #@29 Insert STRING in huge size. (defalias 'cal-tex-huge #[(string) "À ±‡" ["{\\huge " string "}"] 3 (#$ . 44603)]) #@29 Insert STRING in Huge size. (defalias 'cal-tex-Huge #[(string) "À ±‡" ["{\\Huge " string "}"] 3 (#$ . 44722)]) #@32 Insert STRING in Huge bf size. (defalias 'cal-tex-Huge-bf #[(string) "À ±‡" ["{\\Huge\\bf " string "}"] 3 (#$ . 44841)]) #@30 Insert STRING in large size. (defalias 'cal-tex-large #[(string) "À ±‡" ["{\\large " string "}"] 3 (#$ . 44970)]) #@33 Insert STRING in large bf size. (defalias 'cal-tex-large-bf #[(string) "À ±‡" ["{\\large\\bf " string "}"] 3 (#$ . 45092)]) (provide (quote cal-tex)) emacs-19.30/lisp/cal-x.elc100666 75424 12 7365 6051026304 13641 0ustar kwzhstaff;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 10 23:55:16 1995 ;;; from file /home/fsf/rms/e19/lisp/cal-x.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cal-x.el' was compiled for Emacs 19.29 or later")) (require (quote calendar)) #@41 Frame in which to display the calendar. (defvar calendar-frame nil (#$ . 497)) #@38 Frame in which to display the diary. (defvar diary-frame nil (#$ . 582)) #@114 Parameters of the diary frame, if the diary is in its own frame. Location and color should be set in .Xdefaults. (defvar diary-frame-parameters (quote ((name . "Diary") (height . 10) (width . 80) (unsplittable . t) (font . "6x13") (auto-lower . t) (auto-raise . t) (minibuffer))) (#$ . 662)) #@123 Parameters of the calendar frame, if the calendar is in a separate frame. Location and color should be set in .Xdefaults. (defvar calendar-frame-parameters (quote ((name . "Calendar") (minibuffer) (height . 10) (width . 80) (auto-raise . t) (auto-lower . t) (font . "6x13") (unsplittable . t) (vertical-scroll-bars))) (#$ . 961)) #@120 Parameters of the frame that displays both the calendar and the diary. Location and color should be set in .Xdefaults. (defvar calendar-and-diary-frame-parameters (quote ((name . "Calendar") (height . 28) (width . 80) (minibuffer) (font . "6x13") (auto-raise . t) (auto-lower . t))) (#$ . 1298)) #@133 Hooks to be run just after setting up a calendar frame. Can be used to change frame parameters, such as font, color, location, etc. (defvar calendar-after-frame-setup-hooks nil (#$ . 1601)) #@77 Start calendar and display it in a dedicated frame together with the diary. (defalias 'calendar-one-frame-setup #[(&optional arg) "„Á\n!‡Ã\f!ƒÅ\f!ˆÃ!ƒÅ!ˆÇÈ \nË‹*‡" [window-system calendar-basic-setup arg frame-live-p calendar-frame delete-frame diary-frame nil t view-diary-entries-initially special-display-buffer-names ((byte-code "ŠÀ !ÃÄ!ˆÅ\n!ˆÆÇÈ\n!\"AÉ=ƒÊ ˆË\f!ˆÍÎ Ï\"ˆÍÐÑ>„7Ó!‚EÕÖ!!„CØ ˆ!Ù\")‡" [make-frame calendar-and-diary-frame-parameters calendar-frame run-hooks calendar-after-frame-setup-hooks select-frame assoc visibility frame-parameters icon iconify-or-deiconify-frame calendar-basic-setup arg set-window-dedicated-p selected-window calendar display-buffer fancy-diary-display diary-display-hook get-file-buffer diary-file bufferp get-buffer fancy-diary-buffer make-fancy-diary-buffer diary] 5))] 2 (#$ . 1797)]) #@57 Start calendar and diary in separate, dedicated frames. (defalias 'calendar-two-frame-setup #[(&optional arg) "„Á\n!‡Ã\f!ƒÅ\f!ˆÃ!ƒÅ!ˆÇ‰‰ \nË‹+‡" [window-system calendar-basic-setup arg frame-live-p calendar-frame delete-frame diary-frame nil special-display-buffer-names view-diary-entries-initially pop-up-windows ((byte-code "ŠÀ !ˆ) !ÅÆ!ˆÇ\f!ˆÈÉÊ\f!\"AË=ƒ!Ì ˆÍ!ˆÏÐ Ñ\"ˆÂ!ÅÆ!ˆÇ!ˆÈÉÊ!\"AË=ƒKÌ ˆŠÔ ˆ)ÏÍÕ>„`×!‚nÙÚ!!„lÜ ˆ!Ô\"‡" [calendar-basic-setup arg make-frame calendar-frame-parameters calendar-frame run-hooks calendar-after-frame-setup-hooks select-frame assoc visibility frame-parameters icon iconify-or-deiconify-frame display-buffer calendar-buffer set-window-dedicated-p selected-window calendar diary-frame-parameters diary-frame diary fancy-diary-display diary-display-hook get-file-buffer diary-file bufferp get-buffer fancy-diary-buffer make-fancy-diary-buffer] 5))] 3 (#$ . 2661)]) (byte-code "À  \f Æ!¯\"ÉÊ!ˆËÌ!‡" [append special-display-buffer-names "*Yahrzeits*" lunar-phases-buffer holiday-buffer fancy-diary-buffer get-file-buffer diary-file calendar-buffer run-hooks cal-x-load-hook provide cal-x] 8) emacs-19.30/lisp/calendar.elc100666 13437 1 233466 6055525754 14542 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 25 00:38:16 1995 ;;; from file /home/fsf/rms/e19/lisp/calendar.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`calendar.el' was compiled for Emacs 19.29 or later")) (defalias 'calendar-version #[nil #@52 ("ÀÁ!‡" . [message "Version 6, October 12, 1995"])(#$ . 508) nil 2 nil nil]) #@115 *The day of the week on which a week in the calendar begins. 0 means Sunday (default), 1 means Monday, and so on. (defvar calendar-week-start-day 0 (#$ . -592)) #@246 *The offset of the principal month from the center of the calendar window. 0 means the principal month is in the center (default), -1 means on the left, +1 means on the right. Larger (or smaller) values push the principal month off the screen. (defvar calendar-offset 0 (#$ . -760)) #@276 *Non-nil means display current date's diary entries on entry. The diary is displayed in another window when the calendar is first displayed, if the current date is visible. The number of days of diary entries displayed is governed by the variable `number-of-diary-entries'. (defvar view-diary-entries-initially nil (#$ . -1051)) #@907 *Specifies how many days of diary entries are to be displayed initially. This variable affects the diary display when the command M-x diary is used, or if the value of the variable `view-diary-entries-initially' is t. For example, if the default value 1 is used, then only the current day's diary entries will be displayed. If the value 2 is used, then both the current day's and the next day's entries will be displayed. The value can also be a vector such as [0 2 2 2 2 4 1]; this value says to display no diary entries on Sunday, the display the entries for the current date and the day after on Monday through Thursday, display Friday through Monday's entries on Friday, and display only Saturday's entries on Saturday. This variable does not affect the diary display with the `d' command from the calendar; in that case, the prefix argument controls the number of days of diary entries displayed. (defvar number-of-diary-entries 1 (#$ . -1388)) #@141 *Non-nil means mark dates with diary entries, in the calendar window. The marking symbol is specified by the variable `diary-entry-marker'. (defvar mark-diary-entries-in-calendar nil (#$ . -2349)) #@97 *Used to mark dates that have diary entries. Can be either a single-character string or a face. (defvar diary-entry-marker (byte-code "„Á‡ÂÃ!ˆÄÅÆ\"ˆÇÆ!ˆÈÆ!„+É ƒ&ÊÆË\"ˆ‚+ÌÍÆ\"ˆÆ‡" [window-system "+" require faces add-to-list facemenu-unlisted-faces diary-face make-face face-differs-from-default-p x-display-color-p set-face-foreground "red" copy-face bold] 3) (#$ . -2552)) #@80 *Used to mark today's date. Can be either a single-character string or a face. (defvar calendar-today-marker (byte-code "„Á‡ÂÃ!ˆÄÅÆ\"ˆÇÆ!ˆÈÆ!„ÉÆÊ\"ˆÆ‡" [window-system "=" require faces add-to-list facemenu-unlisted-faces calendar-today-face make-face face-differs-from-default-p set-face-underline-p t] 3) (#$ . -2938)) #@97 *Used to mark notable dates in the calendar. Can be either a single-character string or a face. (defvar calendar-holiday-marker (byte-code "„Á‡ÂÃ!ˆÄÅÆ\"ˆÇÆ!ˆÈÆ!„0É ƒ&ÊÆË\"ˆ‚0ÊÆÌ\"ˆÍÆÎ\"ˆÆ‡" [window-system "*" require faces add-to-list facemenu-unlisted-faces holiday-face make-face face-differs-from-default-p x-display-color-p set-face-background "pink" "black" set-face-foreground "white"] 3) (#$ . -3269)) #@157 *Non-nil means display holidays for current three month period on entry. The holidays are displayed in another window when the calendar is first displayed. (defvar view-calendar-holidays-initially nil (#$ . -3691)) #@138 *Non-nil means mark dates of holidays in the calendar window. The marking symbol is specified by the variable `calendar-holiday-marker'. (defvar mark-holidays-in-calendar nil (#$ . -3913)) #@211 *If nil, show only major holidays from the Hebrew calendar. This means only those Jewish holidays that appear on secular calendars. If t, show all the holidays that would appear in a complete Hebrew calendar. (defvar all-hebrew-calendar-holidays nil (#$ . -4109)) #@220 *If nil, show only major holidays from the Christian calendar. This means only those Christian holidays that appear on secular calendars. If t, show all the holidays that would appear in a complete Christian calendar. (defvar all-christian-calendar-holidays nil (#$ . -4381)) #@214 *If nil, show only major holidays from the Islamic calendar. This means only those Islamic holidays that appear on secular calendars. If t, show all the holidays that would appear in a complete Islamic calendar. (defvar all-islamic-calendar-holidays nil (#$ . -4665)) #@131 *List of functions to be called after the calendar is first loaded. This is the place to add key bindings to `calendar-mode-map'. (defvar calendar-load-hook nil (#$ . -4941)) #@292 *List of functions to be called when the calendar window is first opened. The functions invoked are called after the calendar window is opened, but once opened is never called again. Leaving the calendar with the `q' command and reentering it will cause these functions to be called again. (defvar initial-calendar-window-hook nil (#$ . -5123)) #@794 *List of functions called whenever the current date is visible. This can be used, for example, to replace today's date with asterisks; a function `calendar-star-date' is included for this purpose: (setq today-visible-calendar-hook 'calendar-star-date) It can also be used to mark the current date with `calendar-today-marker'; a function is also provided for this: (setq today-visible-calendar-hook 'calendar-mark-today) The corresponding variable `today-invisible-calendar-hook' is the list of functions called when the calendar function was called when the current date is not visible in the window. Other than the use of the provided functions, the changing of any characters in the calendar buffer by the hooks may cause the failure of the functions that move by days and weeks. (defvar today-visible-calendar-hook nil (#$ . -5476)) #@427 *List of functions called whenever the current date is not visible. The corresponding variable `today-visible-calendar-hook' is the list of functions called when the calendar function was called when the current date is visible in the window. Other than the use of the provided functions, the changing of any characters in the calendar buffer by the hooks may cause the failure of the functions that move by days and weeks. (defvar today-invisible-calendar-hook nil (#$ . -6330)) #@4079 *Name of the file in which one's personal diary of dates is kept. The file's entries are lines in any of the forms MONTH/DAY MONTH/DAY/YEAR MONTHNAME DAY MONTHNAME DAY, YEAR DAYNAME at the beginning of the line; the remainder of the line is the diary entry string for that date. MONTH and DAY are one or two digit numbers, YEAR is a number and may be written in full or abbreviated to the final two digits. If the date does not contain a year, it is generic and applies to any year. DAYNAME entries apply to any date on which is on that day of the week. MONTHNAME and DAYNAME can be spelled in full, abbreviated to three characters (with or without a period), capitalized or not. Any of DAY, MONTH, or MONTHNAME, YEAR can be `*' which matches any day, month, or year, respectively. The European style (in which the day precedes the month) can be used instead, if you execute `european-calendar' when in the calendar, or set `european-calendar-style' to t in your .emacs file. The European forms are DAY/MONTH DAY/MONTH/YEAR DAY MONTHNAME DAY MONTHNAME YEAR DAYNAME To revert to the default American style from the European style, execute `american-calendar' in the calendar. A diary entry can be preceded by the character `diary-nonmarking-symbol' (ordinarily `&') to make that entry nonmarking--that is, it will not be marked on dates in the calendar window but will appear in a diary window. Multiline diary entries are made by indenting lines after the first with either a TAB or one or more spaces. Lines not in one the above formats are ignored. Here are some sample diary entries (in the default American style): 12/22/1988 Twentieth wedding anniversary!! &1/1. Happy New Year! 10/22 Ruth's birthday. 21: Payday Tuesday--weekly meeting with grad students at 10am Supowit, Shen, Bitner, and Kapoor to attend. 1/13/89 Friday the thirteenth!! &thu 4pm squash game with Lloyd. mar 16 Dad's birthday April 15, 1989 Income tax due. &* 15 time cards due. If the first line of a diary entry consists only of the date or day name with no trailing blanks or punctuation, then that line is not displayed in the diary window; only the continuation lines is shown. For example, the single diary entry 02/11/1989 Bill Blattner visits Princeton today 2pm Cognitive Studies Committee meeting 2:30-5:30 Lizzie at Lawrenceville for `Group Initiative' 4:00pm Jamie Tappenden 7:30pm Dinner at George and Ed's for Alan Ryan 7:30-10:00pm dance at Stewart Country Day School will appear in the diary window without the date line at the beginning. This facility allows the diary window to look neater, but can cause confusion if used with more than one day's entries displayed. Diary entries can be based on Lisp sexps. For example, the diary entry %%(diary-block 11 1 1990 11 10 1990) Vacation causes the diary entry "Vacation" to appear from November 1 through November 10, 1990. Other functions available are `diary-float', `diary-anniversary', `diary-cyclic', `diary-day-of-year', `diary-iso-date', `diary-french-date', `diary-hebrew-date', `diary-islamic-date', `diary-mayan-date', `diary-chinese-date', `diary-coptic-date', `diary-ethiopic-date', `diary-yahrzeit', `diary-sunrise-sunset', `diary-phases-of-moon', `diary-parasha', `diary-omer', `diary-rosh-hodesh', and `diary-sabbath-candles'. See the documentation for the function `list-sexp-diary-entries' for more details. Diary entries based on the Hebrew and/or the Islamic calendar are also possible, but because these are somewhat slow, they are ignored unless you set the `nongregorian-diary-listing-hook' and the `nongregorian-diary-marking-hook' appropriately. See the documentation for these functions for details. Diary files can contain directives to include the contents of other files; for details, see the documentation for the variable `list-diary-entries-hook'. (defvar diary-file "~/diary" (#$ . -6820)) #@76 *Symbol indicating that a diary entry is not to be marked in the calendar. (defvar diary-nonmarking-symbol "&" (#$ . -10947)) #@68 *Symbol indicating a diary entry according to the Hebrew calendar. (defvar hebrew-diary-entry-symbol "H" (#$ . -11079)) #@69 *Symbol indicating a diary entry according to the Islamic calendar. (defvar islamic-diary-entry-symbol "I" (#$ . -11205)) #@136 *The string indicating inclusion of another file of diary entries. See the documentation for the function `include-other-diary-files'. (defvar diary-include-string "#include" (#$ . -11334)) #@130 *The string used to indicate a sexp diary entry in diary-file. See the documentation for the function `list-sexp-diary-entries'. (defvar sexp-diary-entry-symbol "%%" (#$ . -11531)) #@205 *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 abbreviated-calendar-year t (#$ . -11719)) #@427 *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 DAY/MONTH/YEAR DAY MONTHNAME DAY MONTHNAME YEAR DAYNAME Names can be capitalized or not, written in full, or abbreviated to three characters with or without a period. (defvar european-calendar-style nil (#$ . -11981)) #@137 *List of pseudo-patterns describing the American patterns of date used. See the documentation of `diary-date-forms' for an explanation. (defvar american-date-diary-pattern (quote ((month "/" day "[^/0-9]") (month "/" day "/" year "[^0-9]") (monthname " *" day "[^,0-9]") (monthname " *" day ", *" year "[^0-9]") (dayname "\\W"))) (#$ . -12465)) #@137 *List of pseudo-patterns describing the European patterns of date used. See the documentation of `diary-date-forms' for an explanation. (defvar european-date-diary-pattern (quote ((day "/" month "[^/0-9]") (day "/" month "/" year "[^0-9]") (backup day " *" monthname "\\W+\\<[^*0-9]") (day " *" monthname " *" year "[^0-9]") (dayname "\\W"))) (#$ . -12817)) #@1304 *List of pseudo-patterns describing the forms of date used in the diary. The patterns on the list must be MUTUALLY EXCLUSIVE and must should not match any portion of the diary entry itself, just the date component. A pseudo-pattern is a list of regular expressions and the keywords `month', `day', `year', `monthname', and `dayname'. The keyword `monthname' will match the name of the month, capitalized or not, or its three-letter abbreviation, followed by a period or not; it will also match `*'. Similarly, `dayname' will match the name of the day, capitalized or not, or its three-letter abbreviation, followed by a period or not. The keywords `month', `day', and `year' will match those numerical values, preceded by arbitrarily many zeros; they will also match `*'. The matching of the diary entries with the date forms is done with the standard syntax table from Fundamental mode, but with the `*' changed so that it is a word constituent. If, to be mutually exclusive, a pseudo-pattern must match a portion of the diary entry itself, the first element of the pattern MUST be `backup'. This directive causes the date recognizer to back up to the beginning of the current word of the diary entry, so in no case can the pattern match more than a portion of the first word of the diary entry. (defvar diary-date-forms (byte-code "ƒ ‡\n‡" [european-calendar-style european-date-diary-pattern american-date-diary-pattern] 1) (#$ . -13183)) #@145 *Pseudo-pattern governing the way a date appears in the European style. See the documentation of calendar-date-display-form for an explanation. (defvar european-calendar-display-form (quote ((if dayname (concat dayname ", ")) day " " monthname " " year)) (#$ . -14641)) #@147 *Pseudo-pattern governing the way a date appears in the American style. See the documentation of `calendar-date-display-form' for an explanation. (defvar american-calendar-display-form (quote ((if dayname (concat dayname ", ")) monthname " " day ", " year)) (#$ . -14918)) #@661 *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) while a typical American form would be '(month "/" day "/" (substring year -2)) and '((format "%9s, %9s %2s, %4s" dayname monthname day year)) would give the usual American style in fixed-length fields. See the documentation of the function `calendar-date-string'. (defvar calendar-date-display-form (byte-code "ƒ ‡\n‡" [european-calendar-style european-calendar-display-form american-calendar-display-form] 1) (#$ . -15198)) #@68 Set the interpretation and display of dates to the European style. (defalias 'european-calendar #[nil #@176 ("À\n\fÆ ‡" . [t european-calendar-style european-calendar-display-form calendar-date-display-form european-date-diary-pattern diary-date-forms update-calendar-mode-line])(#$ . 16137) nil 1 (#$ . 16028) nil]) #@68 Set the interpretation and display of dates to the American style. (defalias 'american-calendar #[nil #@178 ("À\n\fÆ ‡" . [nil european-calendar-style american-calendar-display-form calendar-date-display-form american-date-diary-pattern diary-date-forms update-calendar-mode-line])(#$ . 16464) nil 1 (#$ . 16355) nil]) #@369 *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 print-diary-entries-hook (quote lpr-buffer) (#$ . -16685)) #@1139 *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 this hook. This function enables you to use shared diary files together with your own. The files included are specified in the diary file by lines of the form #include "filename" This is recursive; that is, #include directives in files thus included are obeyed. You can change the "#include" to some other string by changing the variable `diary-include-string'. When you use `include-other-diary-files' as part of the list-diary-entries-hook, you will probably also want to use the function `mark-included-diary-files' as part of `mark-diary-entries-hook'. For example, you could use (setq list-diary-entries-hook '(include-other-diary-files sort-diary-entries)) (setq diary-display-hook 'fancy-diary-display) in your `.emacs' file to cause the fancy diary buffer to be displayed with diary entries from various included files, each day's entries sorted into lexicographic order. (defvar list-diary-entries-hook nil (#$ . -17128)) #@101 *List of functions called after the display of the diary. Can be used for appointment notification. (defvar diary-hook nil (#$ . -18324)) #@1203 *List of functions that handle the display of the diary. If nil (the default), `simple-diary-display' is used. Use `ignore' for no diary display. Ordinarily, this just displays the diary buffer (with holidays indicated in the mode line), if there are any relevant entries. At the time these functions are called, the variable `diary-entries-list' is a list, in order by date, of all relevant diary entries in the form of ((MONTH DAY YEAR) STRING), where string is the diary entry for the given date. This can be used, for example, a different buffer for display (perhaps combined with holidays), or produce hard copy output. A function `fancy-diary-display' is provided as an alternative choice for this hook; this function prepares a special noneditable diary buffer with the relevant diary entries that has neat day-by-day arrangement with headings. The fancy diary buffer will show the holidays unless the variable `holidays-in-diary-buffer' is set to nil. Ordinarily, the fancy diary buffer will not show days for which there are no diary entries, even if that day is a holiday; if you want such days to be shown in the fancy diary buffer, set the variable `diary-list-include-blanks' to t. (defvar diary-display-hook nil (#$ . -18470)) #@342 *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 nongregorian-diary-listing-hook nil (#$ . -19725)) #@715 *List of functions called after marking diary entries in the calendar. A function `mark-included-diary-files' is also provided for use as the mark-diary-entries-hook; it enables you to use shared diary files together with your own. The files included are specified in the diary file by lines of the form #include "filename" This is recursive; that is, #include directives in files thus included are obeyed. You can change the "#include" to some other string by changing the variable `diary-include-string'. When you use `mark-included-diary-files' as part of the mark-diary-entries-hook, you will probably also want to use the function `include-other-diary-files' as part of `list-diary-entries-hook'. (defvar mark-diary-entries-hook nil (#$ . -20132)) #@342 *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 nongregorian-diary-marking-hook nil (#$ . -20904)) #@171 *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 diary-list-include-blanks nil (#$ . -21311)) #@257 *Non-nil means include holidays in the diary display. The holidays appear 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 makes the diary display faster. (defvar holidays-in-diary-buffer t (#$ . -21541)) (byte-code "ÀÁ!„ÂÁ BÄÅÆÇ#‡" [boundp calendar-mark-ring nil current-load-list put general-holidays risky-local-variable t] 4) #@120 *General holidays. Default value is for the United States. See the documentation for `calendar-holidays' for details. (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"))) (#$ . -21983)) (put (quote oriental-holidays) (quote risky-local-variable) t) #@80 *Oriental holidays. See the documentation for `calendar-holidays' for details. (defvar oriental-holidays (quote ((if (fboundp (quote atan)) (holiday-chinese-new-year)))) (#$ . -22866)) (put (quote local-holidays) (quote risky-local-variable) t) #@77 *Local holidays. See the documentation for `calendar-holidays' for details. (defvar local-holidays nil (#$ . -23117)) (put (quote other-holidays) (quote risky-local-variable) t) #@84 *User defined holidays. See the documentation for `calendar-holidays' for details. (defvar other-holidays nil (#$ . -23301)) (byte-code "ÀÁÂÃ#ˆÄÁ!„ÅÁBÀÇÂÃ#ˆÄÇ!„#ÈÇBÀÉÂÃ#ˆÄÉ!„8Ê ÉBÀËÂÃ#ˆÄË!„MÌ ËBÀÍÂÃ#‡" [put hebrew-holidays-1 risky-local-variable t boundp ((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)"))) current-load-list hebrew-holidays-2 ((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"))) hebrew-holidays-3 ((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"))) hebrew-holidays-4 ((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))) hebrew-holidays] 4) #@78 *Jewish holidays. See the documentation for `calendar-holidays' for details. (defvar hebrew-holidays (append hebrew-holidays-1 hebrew-holidays-2 hebrew-holidays-3 hebrew-holidays-4) (#$ . -25496)) (put (quote christian-holidays) (quote risky-local-variable) t) #@81 *Christian 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")))) (#$ . -25763)) (put (quote islamic-holidays) (quote risky-local-variable) t) #@79 *Islamic 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")))) (#$ . -26369)) (put (quote solar-holidays) (quote risky-local-variable) t) #@83 *Sun-related holidays. See the documentation for `calendar-holidays' for details. (defvar solar-holidays (quote ((if (fboundp (quote atan)) (solar-equinoxes-solstices)) (if (progn (require (quote cal-dst)) t) (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-starts-time (float 60)) calendar-standard-time-zone-name) ""))))) (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-ends-time (float 60)) calendar-daylight-time-zone-name) "")))))) (#$ . -27375)) (put (quote calendar-holidays) (quote risky-local-variable) t) #@3930 *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', `oriental-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. Entries on the list are expressions that return (possibly empty) lists of items of the form ((month day year) string) of a holiday in the in the three-month period centered around `displayed-month' of `displayed-year'. Several basic functions are provided for this purpose: (holiday-fixed MONTH DAY STRING) is a fixed date on the Gregorian calendar (holiday-float MONTH DAYNAME K STRING &optional day) is the Kth DAYNAME in MONTH on the Gregorian calendar (0 for Sunday, etc.); K<0 means count back from the end of the month. An optional parameter DAY means the Kth DAYNAME after/before MONTH DAY. (holiday-hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar (holiday-julian MONTH DAY STRING) a fixed date on the Julian calendar (holiday-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. STRING is an expression in the variable `date'. For example, to add Bastille Day, celebrated in France on July 14, add (holiday-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 (holiday-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 (holiday-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 (holiday-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 (holiday-julian 4 2 "Jefferson's Birthday") To include a holiday conditionally, use the sexp form or a conditional. 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 (holiday-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)) (holiday-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 `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") ... ). (defvar calendar-holidays (append general-holidays local-holidays other-holidays christian-holidays hebrew-holidays islamic-holidays oriental-holidays solar-holidays) (#$ . -28171)) #@43 Name of the buffer used for the calendar. (defconst calendar-buffer "*Calendar*" (#$ . 32288)) #@58 Name of the buffer used for the displaying the holidays. (defconst holiday-buffer "*Holidays*" (#$ . 32389)) #@70 Name of the buffer used for the optional fancy display of the diary. (defconst fancy-diary-buffer "*Fancy Diary Entries*" (#$ . 32504)) #@47 Name of the buffer used for the lunar phases. (defconst lunar-phases-buffer "*Phases of Moon*" (#$ . 32646)) #@121 Move the variables MON and YR to the month and year by N months. Forward if N is positive or backward if N is negative. (defalias 'increment-calendar-month '(macro . #[(mon yr n) #@119 ("ÀÁÂÃ\fÅBBǯDCÉÊBBÉ\fËBBF‡" . [let macro-y + * yr (12) mon -1 n setq ((1+ (% macro-y 12))) ((/ macro-y 12))])(#$ . 32948) nil 7 (#$ . 32762)])) #@21 Execute a for loop. (defalias 'calendar-for-loop '(macro . #[(var from init to final do &rest body) #@78 ("À  DDCÄÅÇ È DEE BBE‡" . [let var 1- init while >= final setq 1+ body])(#$ . 33212) nil 9 (#$ . 33106)])) #@73 For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION. (defalias 'calendar-sum '(macro . #[(index initial condition expression) #@114 ("À \nDÃBÄ ÆÇÈÇ EEÆ Ê DEFËBBB‡" . [let index initial ((sum 0)) while condition setq sum + expression 1+ (sum)])(#$ . 33481) nil 9 (#$ . 33329)])) #@69 Extract the month part of DATE which has the form (month day year). (defalias 'extract-calendar-month #[(date) #@18 ("@‡" . [date])(#$ . 33751) nil 1 (#$ . 33634)]) (put (quote extract-calendar-month) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@67 Extract the day part of DATE which has the form (month day year). (defalias 'extract-calendar-day #[(date) #@19 ("A@‡" . [date])(#$ . 34015) nil 1 (#$ . 33902)]) (put (quote extract-calendar-day) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@68 Extract the year part of DATE which has the form (month day year). (defalias 'extract-calendar-year #[(date) #@20 ("AA@‡" . [date])(#$ . 34280) nil 1 (#$ . 34165)]) (put (quote extract-calendar-year) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@45 Returns t if YEAR is a Gregorian leap year. (defalias 'calendar-leap-year-p #[(year) #@52 ("Á¦ÂU…0æÂU?†0ĦÂU‡" . [year 4 0 100 400])(#$ . 34523) nil 2 (#$ . 34432)]) (put (quote calendar-leap-year-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@36 The last day in MONTH during YEAR. (defalias 'calendar-last-day-of-month #[(month year) #@124 ("ÁUƒ$0\n‰æÄU…0\nŦÄU?†0\nƦÄU)ƒ$0LJÈSH‡" . [month 2 year 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31]])(#$ . 34801) nil 3 (#$ . 34706)]) (put (quote calendar-last-day-of-month) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@180 Return the day number within the year of the date DATE. For example, (calendar-day-number '(1 1 1987)) returns the value 1, while (calendar-day-number '(12 31 1980)) returns 366. (defalias 'calendar-day-number #[(date) #@150 ("‰@)‰A@)‰AA@)\n SÄ_\\ ÆVƒK0 Ç_È\\É¥Z ‰ǦÊU…D0 ˦ÊU?†D0 ̦ÊU)ƒK0 T ,‡" . [date month day year 31 day-of-year 2 4 23 10 0 100 400])(#$ . 35289) nil 4 (#$ . 35063)]) (put (quote calendar-day-number) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@135 The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. The Gregorian date Sunday, December 31, 1 BC is imaginary. (defalias 'calendar-absolute-from-gregorian #[(date) #@210 ("‰AA@)S‰‰@)‰A@)‰AA@) \nSÅ_\\\nÇVƒ[0\nÈ_É\\Ê¥Z\f‰ȦËU…R0\f̦ËU?†R0\fͦËU)ƒ[0T- Î_\\ È¥\\ Ì¥[\\ Í¥\\)‡" . [date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365])(#$ . 35764) nil 5 (#$ . 35570)]) (put (quote calendar-absolute-from-gregorian) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@64 Reposition the calendar window so the current date is visible. (autoload (quote calendar-goto-today) "cal-move" '(#$ . 36117) t) #@37 Move the cursor forward ARG months. (autoload (quote calendar-forward-month) "cal-move" '(#$ . 36252) t) #@39 Move the cursor forward by ARG years. (autoload (quote calendar-forward-year) "cal-move" '(#$ . 36363) t) #@41 Move the cursor backward by ARG months. (autoload (quote calendar-backward-month) "cal-move" '(#$ . 36475) t) #@37 Move the cursor backward ARG years. (autoload (quote calendar-backward-year) "cal-move" '(#$ . 36591) t) #@51 Scroll the displayed calendar left by ARG months. (autoload (quote scroll-calendar-left) "cal-move" '(#$ . 36702) t) #@59 Scroll the displayed calendar window right by ARG months. (autoload (quote scroll-calendar-right) "cal-move" '(#$ . 36825) t) #@60 Scroll the displayed calendar window left by 3*ARG months. (autoload (quote scroll-calendar-left-three-months) "cal-move" '(#$ . 36957) t) #@61 Scroll the displayed calendar window right by 3*ARG months. (autoload (quote scroll-calendar-right-three-months) "cal-move" '(#$ . 37102) t) #@38 Move the cursor to the closest date. (autoload (quote calendar-cursor-to-nearest-date) "cal-move" '(#$ . 37249) t) #@35 Move the cursor forward ARG days. (autoload (quote calendar-forward-day) "cal-move" '(#$ . 37370) t) #@32 Move the cursor back ARG days. (autoload (quote calendar-backward-day) "cal-move" '(#$ . 37477) t) #@36 Move the cursor forward ARG weeks. (autoload (quote calendar-forward-week) "cal-move" '(#$ . 37582) t) #@33 Move the cursor back ARG weeks. (autoload (quote calendar-backward-week) "cal-move" '(#$ . 37691) t) #@53 Move the cursor back ARG calendar-week-start-day's. (autoload (quote calendar-beginning-of-week) "cal-move" '(#$ . 37798) t) #@58 Move the cursor forward ARG calendar-week-start-day+6's. (autoload (quote calendar-end-of-week) "cal-move" '(#$ . 37929) t) #@48 Move the cursor backward ARG month beginnings. (autoload (quote calendar-beginning-of-month) "cal-move" '(#$ . 38059) t) #@41 Move the cursor forward ARG month ends. (autoload (quote calendar-end-of-month) "cal-move" '(#$ . 38186) t) #@47 Move the cursor backward ARG year beginnings. (autoload (quote calendar-beginning-of-year) "cal-move" '(#$ . 38300) t) #@46 Move the cursor forward ARG year beginnings. (autoload (quote calendar-end-of-year) "cal-move" '(#$ . 38425) t) #@48 Move the cursor to DATE that is on the screen. (autoload (quote calendar-cursor-to-visible-date) "cal-move" '(#$ . 38543) t) #@22 Move cursor to DATE. (autoload (quote calendar-goto-date) "cal-move" '(#$ . 38674) t) #@77 Start calendar and display it in a dedicated frame together with the diary. (autoload (quote calendar-one-frame-setup) "cal-x" '(#$ . 38766)) #@57 Start calendar and diary in separate, dedicated frames. (autoload (quote calendar-two-frame-setup) "cal-x" '(#$ . 38914)) #@243 The frame set up of the calendar. The choices are `one-frame' (calendar and diary together in one separate, dediciated frame) or `two-frames' (calendar and diary in separate, dedicated frames); with any other value the current frame is used. (defvar calendar-setup nil (#$ . 39043)) #@144 Choose between the one frame, two frame, or basic calendar displays. The original function `calendar' has been renamed `calendar-basic-setup'. (defalias 'calendar #[(&optional arg) #@148 ("Ášƒ\n0 !‡Äšƒ0Å !‡Æ !‡" . [calendar-setup one-frame calendar-one-frame-setup arg two-frames calendar-two-frame-setup calendar-basic-setup])(#$ . 39521) nil 2 (#$ . 39333) "P"]) #@2260 Display a three-month calendar in another window. The three months appear side by side, with the current month in the middle surrounded by the previous and next months. The cursor is put on today's date. If called with an optional prefix argument, prompts for month and year. This function is suitable for execution in a .emacs file; appropriate setting of the variable `view-diary-entries-initially' will cause the diary entries for the current date to be displayed in another window. The value of the variable `number-of-diary-entries' controls the number of days of diary entries displayed upon initial display of the calendar. An optional prefix argument ARG causes the calendar displayed to be ARG months in the future if ARG is positive or in the past if ARG is negative; in this case the cursor goes on the first day of the month. Once in the calendar window, future or past months can be moved into view. Arbitrary months can be displayed, or the calendar can be scrolled forward or backward. The cursor can be moved forward or backward by one day, one week, one month, or one year. All of these commands take prefix arguments which, when negative, cause movement in the opposite direction. For convenience, the digit keys and the minus sign are automatically prefixes. The window is replotted as necessary to display the desired date. Diary entries can be marked on the calendar or displayed in another window. Use M-x describe-mode for details of the key bindings in the calendar window. The Gregorian calendar is assumed. After loading the calendar, the hooks given by the variable `calendar-load-hook' are run. This is the place to add key bindings to the calendar-mode-map. After preparing the calendar window initially, the hooks given by the variable `initial-calendar-window-hook' are run. The hooks given by the variable `today-visible-calendar-hook' are run everytime the calendar window gets scrolled, if the current date is visible in the window. If it is not visible, the hooks given by the variable `today-invisible-calendar-hook' are run. Thus, for example, setting `today-visible-calendar-hook' to 'calendar-star-date will cause today's date to be replaced by asterisks to highlight it whenever it is in the window. (defalias 'calendar-basic-setup #[(&optional arg) #@715 ("À !qˆÂ ˆÃŃ0ÈÃ!‚0É ‰\n‰\n@) \n‰\nAA@)\fÍ !ˆ\fÎ_ \\[\\Ð\\‰ΦT Î¥\f)Ò \f\"ˆƒx0Ô\n!ƒx0ÕÖ!ƒt0Ø\n!H‚v0!ˆ-Ù!‰…‡0Ü!‰ƒ‘0Þ‚’0Å_ƒœ0à ˆ+áâ!‡" . [get-buffer-create calendar-buffer calendar-mode t pop-up-windows 1000 split-height-threshold arg calendar-read-date calendar-current-date date month year pop-to-buffer 12 calendar-offset -1 macro-y generate-calendar-window view-diary-entries-initially calendar-date-is-visible-p view-diary-entries vectorp number-of-diary-entries calendar-day-of-week get-file-buffer diary-file diary-buffer get-buffer-window diary-window 2 view-calendar-holidays-initially list-calendar-holidays run-hooks initial-calendar-window-hook])(#$ . 42029) nil 5 (#$ . 39713) "P"]) #@202 Prepare and display a buffer with diary entries. Searches your diary file for entries that match ARG days starting with the date indicated by the cursor position in the displayed three-month calendar. (autoload (quote view-diary-entries) "diary-lib" '(#$ . 42787) t) #@57 Local time of sunrise and sunset for date under cursor. (autoload (quote calendar-sunrise-sunset) "solar" '(#$ . 43060) t) #@76 Create a buffer of the phases of the moon for the current calendar window. (autoload (quote calendar-phases-of-moon) "lunar" '(#$ . 43189) t) #@81 Show the French Revolutionary calendar equivalent of the date under the cursor. (autoload (quote calendar-print-french-date) "cal-french" '(#$ . 43337) t) #@43 Move cursor to French Revolutionary date. (autoload (quote calendar-goto-french-date) "cal-french" '(#$ . 43498) t) #@56 String of French Revolutionary date of Gregorian date. (autoload (quote calendar-french-date-string) "cal-french" '(#$ . 43620) t) #@41 String of Mayan date of Gregorian date. (autoload (quote calendar-mayan-date-string) "cal-mayan" '(#$ . 43757) t) #@88 Show the Mayan long count, Tzolkin, and Haab equivalents of the date under the cursor. (autoload (quote calendar-print-mayan-date) "cal-mayan" '(#$ . 43877) t) #@39 Move cursor to Mayan long count date. (autoload (quote calendar-goto-mayan-long-count-date) "cal-mayan" '(#$ . 44043) t) #@50 Move cursor to next instance of Mayan Haab date. (autoload (quote calendar-next-haab-date) "cal-mayan" '(#$ . 44170) t) #@54 Move cursor to previous instance of Mayan Haab date. (autoload (quote calendar-previous-haab-date) "cal-mayan" '(#$ . 44296) t) #@53 Move cursor to next instance of Mayan Tzolkin date. (autoload (quote calendar-next-tzolkin-date) "cal-mayan" '(#$ . 44430) t) #@57 Move cursor to previous instance of Mayan Tzolkin date. (autoload (quote calendar-previous-tzolkin-date) "cal-mayan" '(#$ . 44562) t) #@65 Move cursor to next instance of Mayan Haab/Tzoklin combination. (autoload (quote calendar-next-calendar-round-date) "cal-mayan" '(#$ . 44702) t) #@69 Move cursor to previous instance of Mayan Haab/Tzoklin combination. (autoload (quote calendar-previous-calendar-round-date) "cal-mayan" '(#$ . 44853) t) #@35 Move cursor to Chinese date date. (autoload (quote calendar-goto-chinese-date) "cal-chinese" '(#$ . 45012) t) #@44 Show the Chinese date equivalents of date. (autoload (quote calendar-print-chinese-date) "cal-chinese" '(#$ . 45128) t) #@43 String of Chinese date of Gregorian date. (autoload (quote calendar-chinese-date-string) "cal-chinese" '(#$ . 45254) t) #@185 Compute the Julian (month day year) corresponding to the absolute DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC. (autoload (quote calendar-julian-from-absolute) "cal-julian" '(#$ . 45381)) #@66 Move cursor to Julian DATE; echo Julian date unless NOECHO is t. (autoload (quote calendar-goto-julian-date) "cal-julian" '(#$ . 45647) t) #@142 String of Julian date of Gregorian DATE. Defaults to today's date if DATE is not given. Driven by the variable `calendar-date-display-form'. (autoload (quote calendar-julian-date-string) "cal-julian" '(#$ . 45793) t) #@26 Move cursor to ISO date. (autoload (quote calendar-goto-iso-date) "cal-iso" '(#$ . 46016) t) #@40 Show the ISO date equivalents of date. (autoload (quote calendar-print-iso-date) "cal-iso" '(#$ . 46115) t) #@39 String of ISO date of Gregorian date. (autoload (quote calendar-iso-date-string) "cal-iso" '(#$ . 46229) t) #@44 Show the Islamic date equivalents of date. (autoload (quote calendar-print-islamic-date) "cal-islamic" '(#$ . 46343) t) #@43 String of Islamic date of Gregorian date. (autoload (quote calendar-islamic-date-string) "cal-islamic" '(#$ . 46469) t) #@34 Move cursor to Hebrew date date. (autoload (quote calendar-goto-hebrew-date) "cal-hebrew" '(#$ . 46595) t) #@43 Show the Hebrew date equivalents of date. (autoload (quote calendar-print-hebrew-date) "cal-hebrew" '(#$ . 46708) t) #@42 String of Hebrew date of Gregorian date. (autoload (quote calendar-hebrew-date-string) "cal-hebrew" '(#$ . 46831) t) #@34 Move cursor to Coptic date date. (autoload (quote calendar-goto-coptic-date) "cal-coptic" '(#$ . 46954) t) #@43 Show the Coptic date equivalents of date. (autoload (quote calendar-print-coptic-date) "cal-coptic" '(#$ . 47067) t) #@42 String of Coptic date of Gregorian date. (autoload (quote calendar-coptic-date-string) "cal-coptic" '(#$ . 47190) t) #@36 Move cursor to Ethiopic date date. (autoload (quote calendar-goto-ethiopic-date) "cal-coptic" '(#$ . 47313) t) #@45 Show the Ethiopic date equivalents of date. (autoload (quote calendar-print-ethiopic-date) "cal-coptic" '(#$ . 47430) t) #@44 String of Ethiopic date of Gregorian date. (autoload (quote calendar-ethiopic-date-string) "cal-coptic" '(#$ . 47557) t) #@211 Show all of the diary entries in the diary file. This function gets rid of the selective display of the diary file so that all entries, not just some, are visible. If there is no diary buffer, one is created. (autoload (quote show-all-diary-entries) "diary-lib" '(#$ . 47685) t) #@126 Mark days in the calendar window that have diary entries. Each entry in diary file visible in the calendar window is marked. (autoload (quote mark-diary-entries) "diary-lib" '(#$ . 47972) t) #@62 Insert a diary entry STRING which may be NONMARKING in FILE. (autoload (quote make-diary-entry) "diary-lib" '(#$ . 48169) t) #@55 Insert a diary entry for the date indicated by point. (autoload (quote insert-diary-entry) "diary-lib" '(#$ . 48300) t) #@73 Insert a weekly diary entry for the day of the week indicated by point. (autoload (quote insert-weekly-diary-entry) "diary-lib" '(#$ . 48426) t) #@75 Insert a monthly diary entry for the day of the month indicated by point. (autoload (quote insert-monthly-diary-entry) "diary-lib" '(#$ . 48577) t) #@74 Insert an annual diary entry for the day of the year indicated by point. (autoload (quote insert-yearly-diary-entry) "diary-lib" '(#$ . 48731) t) #@68 Insert an anniversary diary entry for the date indicated by point. (autoload (quote insert-anniversary-diary-entry) "diary-lib" '(#$ . 48883) t) #@71 Insert a block diary entry for the dates indicated by point and mark. (autoload (quote insert-block-diary-entry) "diary-lib" '(#$ . 49034) t) #@70 Insert a cyclic diary entry starting at the date indicated by point. (autoload (quote insert-cyclic-diary-entry) "diary-lib" '(#$ . 49182) t) #@88 Insert a diary entry for the Hebrew date corresponding to the date indicated by point. (autoload (quote insert-hebrew-diary-entry) "cal-hebrew" '(#$ . 49330) t) #@108 Insert a monthly diary entry for the day of the Hebrew month corresponding to the date indicated by point. (autoload (quote insert-monthly-hebrew-diary-entry) "cal-hebrew" '(#$ . 49498) t) #@107 Insert an annual diary entry for the day of the Hebrew year corresponding to the date indicated by point. (autoload (quote insert-yearly-hebrew-diary-entry) "cal-hebrew" '(#$ . 49694) t) #@89 Insert a diary entry for the Islamic date corresponding to the date indicated by point. (autoload (quote insert-islamic-diary-entry) "cal-islamic" '(#$ . 49887) t) #@109 Insert a monthly diary entry for the day of the Islamic month corresponding to the date indicated by point. (autoload (quote insert-monthly-islamic-diary-entry) "cal-islamic" '(#$ . 50058) t) #@108 Insert an annual diary entry for the day of the Islamic year corresponding to the date indicated by point. (autoload (quote insert-yearly-islamic-diary-entry) "cal-islamic" '(#$ . 50257) t) #@184 Create a buffer containing the holidays for the current calendar window. The holidays are those in the list `calendar-notable-days'. Returns t if any holidays are found, nil if not. (autoload (quote list-calendar-holidays) "holidays" '(#$ . 50454) t) #@168 Make a buffer with LaTeX commands for the month cursor is on. Optional prefix argument specifies number of months to be produced. Calendar is condensed onto one page. (autoload (quote cal-tex-cursor-month) "cal-tex" '(#$ . 50713)) #@131 Make a buffer with LaTeX commands for the month cursor is on. Optional prefix argument specifies number of months to be produced. (autoload (quote cal-tex-cursor-month-landscape) "cal-tex" '(#$ . 50951)) #@61 Make a buffer with LaTeX commands for the day cursor is on. (autoload (quote cal-tex-cursor-day) "cal-tex" '(#$ . 51161)) #@212 Make a buffer with LaTeX commands for a two-page one-week calendar. It applies to the week that point is in. Optional prefix argument specifies number of weeks. Holidays are included if `cal-tex-holidays' is t. (autoload (quote cal-tex-cursor-week) "cal-tex" '(#$ . 51290)) #@212 Make a buffer with LaTeX commands for a two-page one-week calendar. It applies to the week that point is in. Optional prefix argument specifies number of weeks. Holidays are included if `cal-tex-holidays' is t. (autoload (quote cal-tex-cursor-week2) "cal-tex" '(#$ . 51571)) #@231 Make a buffer with LaTeX commands for a one page ISO-style weekly calendar. Optional prefix argument specifies number of weeks. Diary entries are included if `cal-tex-diary' is t. Holidays are included if `cal-tex-holidays' is t. (autoload (quote cal-tex-cursor-week-iso) "cal-tex" '(#$ . 51853)) #@234 Make a buffer with LaTeX commands for a two-page one-week calendar. It applies to the week that point is in, and starts on Monday. Optional prefix argument specifies number of weeks. Holidays are included if `cal-tex-holidays' is t. (autoload (quote cal-tex-cursor-week-monday) "cal-tex" '(#$ . 52157)) #@228 Two-weeks-at-a-glance Filofax style calendar for week indicated by cursor. Optional prefix argument specifies number of weeks. Diary entries are included if cal-tex-diary is t. Holidays are included if `cal-tex-holidays' is t. (autoload (quote cal-tex-cursor-filofax-2week) "cal-tex" '(#$ . 52467)) #@251 One-week-at-a-glance Filofax style calendar for week indicated by cursor. Optional prefix argument specifies number of weeks. Weeks start on Monday. Diary entries are included if cal-tex-diary is t. Holidays are included if `cal-tex-holidays' is t. (autoload (quote cal-tex-cursor-filofax-week) "cal-tex" '(#$ . 52773)) #@111 Make a buffer with LaTeX commands for a year's calendar. Optional prefix argument specifies numeber of years. (autoload (quote cal-tex-cursor-year) "cal-tex" '(#$ . 53101)) #@122 Make a buffer with LaTeX commands for a year's calendar (landscape). Optional prefix argument specifies number of years. (autoload (quote cal-tex-cursor-year-landscape) "cal-tex" '(#$ . 53281)) #@120 Make a buffer with LaTeX commands for a year's calendar (Filofax). Optional prefix argument specifies number of years. (autoload (quote cal-tex-cursor-filofax-year) "cal-tex" '(#$ . 53482)) #@43 Mark notable days in the calendar window. (autoload (quote mark-calendar-holidays) "holidays" '(#$ . 53678) t) #@76 Find holidays for the date specified by the cursor in the calendar window. (autoload (quote calendar-cursor-holidays) "holidays" '(#$ . 53795) t) #@78 Generate the calendar window for the current date. Or, for optional MON, YR. (defalias 'generate-calendar-window #[(&optional mon yr) #@768 ("À ‰‰@) ‰A@) ‰AA@)?†80É\n $‰ ÌX…70 ÍY)Ï !Ñ ˆƒQ0Ò\n\"ˆ‚W0Ò \"ˆÓƒa0 ‚g0ÌE!ˆÖÀ!ˆ×Ø!„‚0Ù Ú Uƒ‚0ÛÜ ÝZ!ˆÞß!ˆ ƒ”0á ƒ”0Þß!ˆâŽ#…0ä .‡" . [nil buffer-read-only calendar-current-date today date month day year mon calendar-interval yr offset 1 -1 today-visible calendar-day-of-week day-in-week update-calendar-mode-line generate-calendar calendar-cursor-to-visible-date displayed-month displayed-year set-buffer-modified-p one-window-p t frame-width window-width shrink-window window-height 9 sit-for 0 mark-holidays-in-calendar mark-calendar-holidays ((byte-code "ƒ 0ÁÂ!ˆ‚0ÁÃ!ˆÁ‡" [today-visible run-hooks today-visible-calendar-hook today-invisible-calendar-hook] 2)) mark-diary-entries-in-calendar mark-diary-entries])(#$ . 54088) nil 6 (#$ . 53947)]) #@72 Generate a three-month Gregorian calendar centered around MONTH, YEAR. (defalias 'generate-calendar #[(month year) #@287 (" SÂ_\\ÃWƒ0ÄÅ!ˆ È ˆ Â_\\É\\‰\n¦T\nÂ¥)Ë\fÃ\fT‰\fY…^0Í \fÎ_Ï\\#ˆ Â_\\Ë\\Ð\\‰\n¦T\nÂ¥)‚/0)‡" . [month year 12 2 error "Months before February, 1 AD are not available." displayed-month displayed-year erase-buffer -2 macro-y -1 i generate-calendar-month 25 5 1])(#$ . 55016) nil 6 (#$ . 54894)]) #@312 Produce a calendar for MONTH, YEAR on the Gregorian calendar. The calendar is inserted in the buffer starting at the line on which point is currently located, but indented INDENT spaces. The indentation is done from the first character on the line and does not disturb the first INDENT characters on the line. (defalias 'generate-calendar-month #[(month year indent) #@600 ("ÀÁ\nÃ\fE! ZÆ\"\n\f‰ÈUƒ70\f‰ɦÊU…/0\f˦ÊU?†/0\f̦ÊU)ƒ70Í‚;0Î\nSH*ebˆÐÑÒÓÔ\n!\f#CÕÖ#Ø#ˆÐÙ\"ˆÚÜT‰Yƒ|0À \\Æ\"HÊÈOcˆÞcˆ‚\\0)ÐÙÊØ#ˆÐÙ\"ˆÊT‰Yƒž0ßcˆ‚Œ0)ÊT‰Y…å0Òà\"cˆá`âZ`Sãä$ˆÀ\\Æ\"ÊUƒ¢0U„¢0ÐÙÊØ#ƒ¢0ÐÙ\"ˆ‚¢0+‡" . [mod calendar-day-of-week month 1 year calendar-week-start-day 7 blank-days 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] last calendar-insert-indented calendar-string-spread format "%s %d" calendar-month-name 32 20 indent t "" -1 i 6 calendar-day-name-array " " " " "%2d " put-text-property 3 mouse-face highlight])(#$ . 55717) nil 7 (#$ . 55342)]) #@223 Insert STRING at column INDENT. If the optional parameter NEWLINE is t, leave point at start of next line, inserting a newline if there was no next line; otherwise, leave point after the inserted text. Value is always t. (defalias 'calendar-insert-indented #[(string indent &optional newline) #@98 ("À !ˆi Wƒ 0 jˆ\ncˆ ƒ$0Ĉmƒ!0à ˆ‚$0ÅyˆÆ‡" . [move-to-column indent string newline nil 1 t])(#$ . 56656) nil 2 (#$ . 56356)]) #@30 Redraw the calendar display. (defalias 'redraw-calendar #[nil #@149 ("À  \f\"ˆÅ !)‡" . [calendar-cursor-to-date cursor-date generate-calendar-window displayed-month displayed-year calendar-cursor-to-visible-date])(#$ . 56861) nil 3 (#$ . 56792) nil]) #@73 *Turn debugging on when evaluating a sexp in the diary or holiday list. (defvar calendar-debug-sexp nil (#$ . -57052)) (byte-code "ÀÁ!„ÂÁ B „åÄ  ƒÆÇ!ˆÈ Ê T‰ Yƒ5Ë Ì !Í#ˆ‚)ÎÏÐÑÒÓÔÕÖ×ØÙÚ¯ ‰ƒ^Ü@Ý $ˆA‰„K)Ë ßà#ˆË áâ#ˆË ãä#ˆË åä#ˆË æç#ˆË èé#ˆË êé#ˆË ëì#ˆË íî#ˆË ïð#ˆË ñò#ˆË óô#ˆË õö#ˆË ÷ì#ˆË øî#ˆË ùô#ˆË úö#ˆË ûü#ˆË ýþ#ˆË ÿ@#ˆË AB#ˆË CD#ˆË EF#ˆË GH#ˆË IJ#ˆË KL#ˆË ML#ˆË NO#ˆË PQ#ˆË RS#ˆË TU#ˆË VW#ˆË XY#ˆË Z[#ˆË \\]#ˆË ^_#ˆË `a#ˆË bc#ˆË de#ˆË fg#ˆË hi#ˆË jk#ˆË lm#ˆË no#ˆË pq#ˆË rs#ˆË tu#ˆË vw#ˆË xy#ˆË z{#ˆË |}#ˆË ~#ˆË €#ˆË ‚ƒ#ˆË „…#ˆË †‡#ˆË ˆ‰#ˆË Š‹#ˆË Œ#ˆË Ž#ˆË ‘#ˆË ’“#ˆË ”•#ˆË –—#ˆË ˜™#ˆË š›#ˆË œ#ˆË žŸ#ˆË  ¡#ˆË ¢£#ˆË ¤¥#ˆË ¦§#ˆË ¨©#ˆË ª«#ˆË ¬­#ˆË ®¯#ˆË °±#ˆË ²³#ˆË ´µ#ˆË ¶·#ˆË ¸¹#ˆË º»#ˆË ¼½#ˆË ¾¿#ˆË ÀÁ#ˆË ÂÃ#ˆË ÄÅ#ˆË ÆÇ#ˆË ÈÉ#ˆË ÊË#ˆË ÌÍ#ˆË ÎÏ#ˆË ÐÑ#ˆË ÒÓ#ˆË ÔÕ#ˆË Ö×#ˆË ØÙ#ˆË ÚÛ#ˆÂ‡" [boundp calendar-mode-map nil current-load-list make-sparse-keymap window-system require cal-menu -1 i 9 define-key int-to-string digit-argument narrow-to-region mark-word mark-sexp mark-paragraph mark-defun mark-whole-buffer mark-page downcase-region upcase-region kill-region copy-region-as-kill capitalize-region write-region l substitute-key-definition calendar-not-implemented global-map "-" negative-argument ">" scroll-calendar-right [prior] scroll-calendar-right-three-months "v" "<" scroll-calendar-left [next] scroll-calendar-left-three-months "" "" calendar-backward-day "" calendar-backward-week "{" calendar-backward-month "[" calendar-backward-year "" calendar-forward-day "" calendar-forward-week [left] [up] [right] [down] "}" calendar-forward-month "]" calendar-forward-year "" calendar-beginning-of-week "" calendar-end-of-week "a" calendar-beginning-of-month "e" calendar-end-of-month "<" calendar-beginning-of-year ">" calendar-end-of-year "" calendar-set-mark [67108896] "" calendar-exchange-point-and-mark "=" calendar-count-days-region "gd" calendar-goto-date "gj" calendar-goto-julian-date "ga" calendar-goto-astro-day-number "gh" calendar-goto-hebrew-date "gi" calendar-goto-islamic-date "gC" calendar-goto-chinese-date "gk" calendar-goto-coptic-date "ge" calendar-goto-ethiopic-date "gc" calendar-goto-iso-date "gf" calendar-goto-french-date "gml" calendar-goto-mayan-long-count-date "gmpc" calendar-previous-calendar-round-date "gmnc" calendar-next-calendar-round-date "gmph" calendar-previous-haab-date "gmnh" calendar-next-haab-date "gmpt" calendar-previous-tzolkin-date "gmnt" calendar-next-tzolkin-date "S" calendar-sunrise-sunset "M" calendar-phases-of-moon " " scroll-other-window "\f" redraw-calendar "." calendar-goto-today "o" calendar-other-month "q" exit-calendar "a" list-calendar-holidays "h" calendar-cursor-holidays "x" mark-calendar-holidays "u" calendar-unmark "m" mark-diary-entries "d" view-diary-entries "D" view-other-diary-entries "s" show-all-diary-entries "pd" calendar-print-day-of-year "pC" calendar-print-chinese-date "pk" calendar-print-coptic-date "pe" calendar-print-ethiopic-date "pc" calendar-print-iso-date "pj" calendar-print-julian-date "pa" calendar-print-astro-day-number "ph" calendar-print-hebrew-date "pi" calendar-print-islamic-date "pf" calendar-print-french-date "pm" calendar-print-mayan-date "id" insert-diary-entry "iw" insert-weekly-diary-entry "im" insert-monthly-diary-entry "iy" insert-yearly-diary-entry "ia" insert-anniversary-diary-entry "ib" insert-block-diary-entry "ic" insert-cyclic-diary-entry "ihd" insert-hebrew-diary-entry "ihm" insert-monthly-hebrew-diary-entry "ihy" insert-yearly-hebrew-diary-entry "iid" insert-islamic-diary-entry "iim" insert-monthly-islamic-diary-entry "iiy" insert-yearly-islamic-diary-entry "?" calendar-goto-info-node "tm" cal-tex-cursor-month "tM" cal-tex-cursor-month-landscape "td" cal-tex-cursor-day "tw1" cal-tex-cursor-week "tw2" cal-tex-cursor-week2 "tw3" cal-tex-cursor-week-iso "tw4" cal-tex-cursor-week-monday "tfw" cal-tex-cursor-filofax-2week "tfW" cal-tex-cursor-filofax-week "tfy" cal-tex-cursor-filofax-year "ty" cal-tex-cursor-year "tY" cal-tex-cursor-year-landscape] 14) #@69 Create a help buffer with a brief description of the calendar-mode. (defalias 'describe-calendar-mode #[nil #@285 ("ÀÁÂÃÄÅ!ÄÆ!#!ˆŠqˆÈ ˆ)É ‘‡" . ["*Help*" princ format "Calendar Mode:\nFor a complete description, type %s\n%s\n" substitute-command-keys "\\\\[describe-mode] from within the calendar" "\\{calendar-mode-map}" standard-output help-mode print-help-return-message])(#$ . 61531) nil 7 (#$ . 61416) nil]) (put (quote calendar-mode) (quote mode-class) (quote special)) #@39 The mode line of the calendar buffer. (defvar calendar-mode-line-format (byte-code "ÀÁ!ÂÀÃ!ÄÀÅ!¯‡" [substitute-command-keys "\\\\[scroll-calendar-left]" "Calendar" "\\\\[calendar-goto-info-node] info/\\[calendar-other-month] other/\\[calendar-goto-today] today" (calendar-date-string (calendar-current-date) t) "\\\\[scroll-calendar-right]"] 6) (#$ . 61921)) #@39 Go to the info node for the calendar. (defalias 'calendar-goto-info-node #[nil #@229 ("ÀÁ!ˆÂ‹‰„0ÄÅ!‚!0ÆÁ ˆ)È @@ @A@\")‡" . [require info ((byte-code "ÀÁ!‡" [Info-find-emacs-command-nodes calendar] 2)) where error "Couldn't find documentation for the calendar." nil same-window-buffer-names Info-find-node])(#$ . 62430) nil 4 (#$ . 62344) nil]) #@188 A major mode for the calendar window. For a complete description, type \\[calendar-goto-info-node] from within the calendar. \\{calendar-mode-map} (defalias 'calendar-mode #[nil #@283 ("À ˆÁÃÅ!ˆÇÉ\nË ˆÌÍ!ˆÌÎ!ˆÌÏ!‡" . [kill-all-local-variables calendar-mode major-mode "Calendar" mode-name use-local-map calendar-mode-map t buffer-read-only nil indent-tabs-mode update-calendar-mode-line make-local-variable calendar-mark-ring displayed-month displayed-year])(#$ . 62927) nil 2 (#$ . 62702)]) #@364 Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH. The effect is like mapconcat but the separating pieces are as balanced as possible. Each item of STRINGS is evaluated before concatenation so it can actually be an expression that evaluates to a string. If LENGTH is too short, the STRINGS are just concatenated and the result truncated. (defalias 'calendar-string-spread #[(strings char length) #@202 ("ÀÁ\nGÃWƒ0ÄÅC\nÅC#‚0\n\"ÇÈ\n\"GZ \nGS\n\n@ \nAÌ \nƒT0 ÎÌ  \\\n¥]\"\n@Q  T \nA‰„30 ÌO.‡" . [mapcar eval strings 2 append "" length apply concat n m s 0 i make-string char])(#$ . 63677) nil 7 (#$ . 63249)]) #@69 Update the calendar mode line with the current date and date style. (defalias 'update-calendar-mode-line #[nil #@153 ("ÀÁ\n!!…0Š\nqˆÃ\fÅÆ #‰)‡" . [bufferp get-buffer calendar-buffer calendar-string-spread calendar-mode-line-format 32 frame-width mode-line-format])(#$ . 64035) nil 4 (#$ . 63917)]) #@39 List of all calendar-related windows. (defalias 'calendar-window-list #[nil #@173 ("À ÁÄÅÁÆ#ˆ\n*‡" . [calendar-buffer-list nil list calendar-buffers walk-windows (lambda (w) (if (memq (window-buffer w) calendar-buffers) (setq list (cons w list)))) t])(#$ . 64309) nil 4 (#$ . 64226)]) #@39 List of all calendar-related buffers. (defalias 'calendar-buffer-list #[nil #@275 ("À !Ã\f \n¯É\nÉ ƒO0@‰ ;ƒ,0Ì !‚90Í !ƒ80 ‚90ɉ ƒF0 \nB\nA‰„0\n,‡" . [get-file-buffer diary-file diary-buffer "*Yahrzeits*" lunar-phases-buffer holiday-buffer fancy-diary-buffer calendar-buffer buffers nil buffer-list b get-buffer bufferp])(#$ . 64603) nil 7 (#$ . 64520)]) #@65 Get out of the calendar window and hide it and related buffers. (defalias 'exit-calendar #[nil #@282 ("À !‰ƒ0Ã\n!ƒ0ÄÅ!„0Æ ‚0ÇÈÉ \")‡" . [get-file-buffer diary-file diary-buffer buffer-modified-p yes-or-no-p "Diary modified; do you really want to exit the calendar? " error mapcar #[(x) "ÀÁ \"‡" [mapcar calendar-hide-window calendar-window-list] 3] calendar-window-list])(#$ . 65018) nil 4 (#$ . 64916) nil]) #@40 Hide WINDOW if it is calendar-related. (defalias 'calendar-hide-window #[(window) #@323 ("À !… 0 !‰Ä >…P0 ƒ'0ÆÇÈÉ !!\"AÊ=ƒ'0Ë‚P0 ƒ90Ì !ƒ90ÍÉ !!‚P0Î !ƒE0Ï !„K0Ð !‚P0 qˆÑ )‡" . [window-live-p window window-buffer buffer calendar-buffer-list window-system assoc visibility frame-parameters window-frame icon nil window-dedicated-p iconify-frame select-window one-window-p delete-window bury-buffer])(#$ . 65431) nil 6 (#$ . 65342)]) #@54 Returns the current date in a list (month day year). (defalias 'calendar-current-date #[nil #@163 ("À ‰ÂÃOÄGÅ ÆÇO!Å ÈÉO!E)‡" . [current-time-string s 4 7 ("Dec" "Nov" "Oct" "Sep" "Aug" "Jul" "Jun" "May" "Apr" "Mar" "Feb" "Jan") string-to-number 8 10 20 24])(#$ . 65891) nil 7 (#$ . 65792)]) #@177 Returns a list (month day year) of current cursor position. If cursor is not on a specific date, signals an error if optional parameter ERROR is t, otherwise just returns nil. (defalias 'calendar-cursor-to-date #[(&optional error) #@414 ("iÀ¥\n \\Ã\\Ħ‰ÆUƒ0Ä‚0 ‰ÄUƒ*0 ÆUƒ*0S‚>0 ÈUƒ<0 ÉUƒ<0T‚>0\nËÌ!ƒj0ÉÍe`\"Wƒj0ŠËÎ!„Z0ÏÐ!ˆ Ñ`T`Ò\\{!\nE)‚˜0ËÓ!ƒ0ŠÏÔ!ˆËÕ!ƒ„0 \nE‚Œ0…Œ0×Ø!)‚˜0…˜0×Ø!,‡" . [25 segment displayed-month -1 12 month 0 displayed-year 1 2 year looking-at "[ 0-9]?[0-9][^0-9]" count-lines " " re-search-backward "[^0-9]" string-to-int 4 "\\*" "[^*]" ".\\*\\*" calendar-starred-day error "Not on a date!"])(#$ . 66331) nil 6 (#$ . 66093)]) #@183 Compute the list (month day year) corresponding to the absolute DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC. (defalias 'calendar-gregorian-from-absolute #[(date) #@359 ("S‰Â¥ ¦‰Å¥\fŦ‰È¥ Ȧ‰\nË¥\f\n˦T Î_Ï_\\ Ð_\\\f\\ÐU„L0\fÐUƒT0ÒÓE‚º0TÔ‰ÖUƒŽ0‰Ц×U…†0Ϧ×U?††0Φ×U)ƒŽ0Ø‚“0ÙSH*‰ W…¥0 Z‰ )ƒ²0T‰‚^0 E*.\n‡" . [date d0 146097 n400 d1 36524 n100 d2 1461 n4 d3 365 n1 day 400 100 4 year 12 31 1 month 2 0 29 [31 28 31 30 31 30 31 31 30 31 30 31] mdays])(#$ . 67026) nil 4 (#$ . 66784)]) #@64 Display a three-month calendar centered around MONTH and YEAR. (defalias 'calendar-other-month #[(month year) #@267 (" U… 0\n U?…90Ä Å È\n\"ˆÉÊ!ƒ'0‚70Ê!ƒ30‚70Ë\nE!*‡" . [month displayed-month year displayed-year calendar-cursor-to-date calendar-current-date today old-date generate-calendar-window calendar-cursor-to-visible-date calendar-date-is-visible-p 1])(#$ . 67540) nil 4 (#$ . 67423) (byte-code "ÀÁ!‡" [calendar-read-date noday] 2)]) #@190 Mark the date under the cursor, or jump to marked date. With no prefix argument, push current date onto marked date ring. With argument, jump to mark, pop it, and put point at end of ring. (defalias 'calendar-set-mark #[(arg) #@223 ("ÀÁ! „ 0\n\fB‰G TVƒ0 \f›Æ¡ˆÇÈ!‚60\f„*0ÉÊ!‚60Ë\f@!ˆ\f\nC¤A‰)‡" . [calendar-cursor-to-date t date arg calendar-mark-ring mark-ring-max nil message "Mark set" error "No mark set in this buffer" calendar-goto-date])(#$ . 68127) nil 3 (#$ . 67894) "P"]) #@60 Exchange the current cursor position with the marked date. (defalias 'calendar-exchange-point-and-mark #[nil #@149 ("@ÁÂ!‰„0ÅÆ!‚0 ABÇ\f!*‡" . [calendar-mark-ring calendar-cursor-to-date t date mark error "No mark set in this buffer" calendar-goto-date])(#$ . 68508) nil 4 (#$ . 68392) nil]) #@66 Count the number of days (inclusive) between point and the mark. (defalias 'calendar-count-days-region #[nil #@540 ("ÀÁ!‰‰AA@)S\n‰‰@)\n‰A@)\n‰AA@) \fSÇ_\\\fÉVƒd0\fÊ_Ë\\Ì¥Z‰ʦÍU…[0ΦÍU?†[0ϦÍU)ƒd0T- Ð_\\ Ê¥\\ Î¥[\\ Ï¥\\*@†‚0ÒÓ!‰‰AA@)S\n‰‰@)\n‰A@)\n‰AA@) \fSÇ_\\\fÉVƒã0\fÊ_Ë\\Ì¥Z‰ʦÍU…Ú0ΦÍU?†Ú0ϦÍU)ƒã0T- Ð_\\ Ê¥\\ Î¥[\\ Ï¥\\*Z‰ÍVƒ‚ [TÕÖ‰×VƒØ‚Ù#*‡" . [calendar-cursor-to-date t date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 calendar-mark-ring error "No mark set in this buffer" days message "Region has %d day%s (inclusive)" 1 "s" ""])(#$ . 68815) nil 7 (#$ . 68699) nil]) #@18 Not implemented. (defalias 'calendar-not-implemented #[nil #@97 ("ÀÁÂà !\"‡" . [error "%s not available in the calendar" global-key-binding this-command-keys])(#$ . 69462) nil 4 (#$ . 69397) nil]) #@252 Return an object read from the minibuffer. Prompt with the string PROMPT and use the function ACCEPTABLE to decide if entered item is acceptable. If non-nil, optional third arg INITIAL-CONTENTS is a string to insert in the minibuffer before reading. (defalias 'calendar-read #[(prompt acceptable &optional initial-contents) #@96 ("À \n\"\f !„0À \n\"‚0 )‡" . [read-minibuffer prompt initial-contents value acceptable])(#$ . 69933) nil 3 (#$ . 69602)]) #@215 Prompt for Gregorian date. Returns a list (month day year). If optional NODAY is t, does not ask for day, but just returns (month nil year); if NODAY is any other non-nil value the value returned is (month year)  (defalias 'calendar-read-date #[(&optional noday) #@559 ("ÀÁÂÃÄ ‰AA@)!#É\nËÌÍÎÏÐÑÒ\"\"ÒÉ$!ÓÔÌ#\"A‰‰ÖUƒb0‰צØU…Z0Ù¦ØU?†Z0Ú¦ØU)ƒb0Û‚g0ÜSH*ƒ‡0É=ƒ0ÒE‚”0D‚”0Àßà\"á\"E-‡" . [calendar-read "Year (>0): " (lambda (x) (> x 0)) int-to-string calendar-current-date date year calendar-month-name-array month-array t completion-ignore-case assoc capitalize completing-read "Month name: " mapcar list append nil calendar-make-alist 1 month 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] last noday format "Day (1-%d): " (lambda (x) (and (< 0 x) (<= x last)))])(#$ . 70339) nil 10 (#$ . 70068)]) #@66 The number of months difference between MON1, YR1 and MON2, YR2. (defalias 'calendar-interval #[(mon1 yr1 mon2 yr2) #@43 (" ZÂ_ \fZ\\‡" . [yr2 yr1 12 mon2 mon1])(#$ . 71059) nil 3 (#$ . 70937)]) #@64 Returns a string with the name of the day of the week of DATE. (defalias 'calendar-day-name #[(date) #@67 ("Á\n!H‡" . [calendar-day-name-array calendar-day-of-week date])(#$ . 71247) nil 3 (#$ . 71140)]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀ‡" [boundp calendar-day-name-array ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"] current-load-list calendar-month-name-array ["January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December"]] 2) #@164 Make an assoc list corresponding to SEQUENCE. Start at index 1, unless optional START-INDEX is provided. If FILTER is provided, apply it to each item in the list. (defalias 'calendar-make-alist #[(sequence &optional start-index filter) #@133 ("ƒ 0S‚\n0ÁÃÄÅÇ\"\")‡" . [start-index 0 index mapcar #[(x) "T ƒ 0 \n!‚0\nB‡" [index filter x] 2] append sequence nil])(#$ . 71901) nil 5 (#$ . 71658)]) #@20 The name of MONTH. (defalias 'calendar-month-name #[(month) #@47 (" SH‡" . [calendar-month-name-array month])(#$ . 72138) nil 2 (#$ . 72072)]) #@77 Returns the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc. (defalias 'calendar-day-of-week #[(date) #@216 ("‰‰AA@)S‰‰@)‰A@)‰AA@) \nSÅ_\\\nÇVƒ]0\nÈ_É\\Ê¥Z\f‰ȦËU…T0\f̦ËU?†T0\fͦËU)ƒ]0T- Î_\\ È¥\\ Ì¥[\\ Í¥\\*Ϧ‡" . [date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 7])(#$ . 72347) nil 6 (#$ . 72223)]) #@64 Delete all diary/holiday marks/highlighting from the calendar. (defalias 'calendar-unmark #[nil #@94 ("ÀÀà ‡" . [nil mark-holidays-in-calendar mark-diary-entries-in-calendar redraw-calendar])(#$ . 72703) nil 1 (#$ . 72601) nil]) #@67 Returns t if DATE is legal and is visible in the calendar window. (defalias 'calendar-date-is-visible-p #[(date) #@137 ("À \n ‰@) ‰AA@)$Å !… 0Æ\fV… 0Ç\fW)‡" . [calendar-interval displayed-month displayed-year date gap calendar-date-is-legal-p 2 -2])(#$ . 72959) nil 6 (#$ . 72839)]) #@36 Returns t if DATE is a legal date. (defalias 'calendar-date-is-legal-p #[(date) #@197 ("‰@)‰A@)‰AA@)Ä X…^0 ÅX…^0Ä\nX…^0\n ‰ÆUƒR0 ‰ǦÈU…J0 ɦÈU?†J0 ʦÈU)ƒR0Ë‚V0Ì SH*X…^0Ä X+‡" . [date year day month 1 12 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31]])(#$ . 73221) nil 5 (#$ . 73134)]) #@48 Returns t if the DATE1 and DATE2 are the same. (defalias 'calendar-date-equal #[(date1 date2) #@78 ("‰@)\n‰@)U…-0‰A@)\n‰A@)U…-0‰AA@)\n‰AA@)U‡" . [date1 date date2])(#$ . 73556) nil 3 (#$ . 73456)]) #@134 Mark DATE in the calendar window with MARK. MARK is either a single-character string or a face. MARK defaults to diary-entry-marker. (defalias 'mark-visible-calendar-date #[(date &optional mark) #@245 ("À !…70Š\nqˆÃ !ˆ\f†0 ‰;ƒ,0ÆÈuˆÉÈ!ˆ\fcˆÊu)‚60ËÌ`S`T\"Í\f#*‡" . [calendar-date-is-legal-p date calendar-buffer calendar-cursor-to-visible-date mark diary-entry-marker nil buffer-read-only 1 delete-char -2 overlay-put make-overlay face])(#$ . 73875) nil 5 (#$ . 73673)]) #@186 Replace the date under the cursor in the calendar window with asterisks. This function can be used with the today-visible-calendar-hook run after the calendar window has been prepared. (defalias 'calendar-star-date #[nil #@186 ("ÀÂÃ!ˆÄuˆÅ``ÆZ{!ÇÈ!ˆÉcˆÊÄ!ˆËÀ!)‡" . [nil buffer-read-only make-variable-buffer-local calendar-starred-day 1 string-to-int 2 delete-char -2 "**" backward-char set-buffer-modified-p])(#$ . 74387) nil 4 (#$ . 74159)]) #@216 Mark the date under the cursor in the calendar window. The date is marked with calendar-today-marker. This function can be used with the today-visible-calendar-hook run after the calendar window has been prepared. (defalias 'calendar-mark-today #[nil #@91 ("ÀÁ \n\"‡" . [mark-visible-calendar-date calendar-cursor-to-date calendar-today-marker])(#$ . 74870) nil 3 (#$ . 74612)]) #@104 Returns t if DATE1 is before DATE2, nil otherwise. The actual dates are in the car of DATE1 and DATE2. (defalias 'calendar-date-compare #[(date1 date2) #@356 ("@‰‰AA@)S ‰‰@) ‰A@) ‰AA@)\f SÆ_\\ ÈVƒ^0 É_Ê\\Ë¥Z ‰ɦÌU…U0 ͦÌU?†U0 ΦÌU)ƒ^0T-\nÏ_\\\nÉ¥\\\nÍ¥[\\\nÎ¥\\*@‰‰AA@)S ‰‰@) ‰A@) ‰AA@)\f SÆ_\\ ÈVƒÒ0 É_Ê\\Ë¥Z ‰ɦÌU…É0 ͦÌU?†É0 ΦÌU)ƒÒ0T-\nÏ_\\\nÉ¥\\\nÍ¥[\\\nÎ¥\\*W‡" . [date1 date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 date2])(#$ . 75159) nil 7 (#$ . 75000)]) #@270 A string form of DATE, driven by the variable `calendar-date-display-form'. An optional parameter ABBREVIATE, when t, causes the month and day names to be abbreviated to three characters. An optional parameter NODAYNAME, when t, omits the name of the day of the week. (defalias 'calendar-date-string #[(date &optional abbreviate nodayname) #@262 ("?…0 ƒ0 !ÄÅO‚0 ! ‰@) ƒ,0È!ÄÅO‚00È! Ê ‰A@)! Ê!Ê ‰AA@)!\fÍÎÐ#.‡" . [nodayname abbreviate calendar-day-name date 0 3 dayname month calendar-month-name monthname int-to-string day year mapconcat eval calendar-date-display-form ""])(#$ . 75902) nil 5 (#$ . 75554)]) #@429 Returns the absolute date of the DAYNAME on or before absolute DATE. DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on. Note: Applying this function to d+6 gives us the DAYNAME on or after an absolute day d. Similarly, applying it to d+3 gives the DAYNAME nearest to absolute date d, applying it to d-1 gives the DAYNAME previous to absolute date d, and applying it to d+7 gives the DAYNAME following absolute date d. (defalias 'calendar-dayname-on-or-before #[(dayname date) #@33 ("‰ Z¦Z‡" . [date dayname 7])(#$ . 76695) nil 3 (#$ . 76203)]) #@343 The absolute date of Nth DAYNAME in MONTH, YEAR before/after optional DAY. A DAYNAME of 0 means Sunday, 1 means Monday, and so on. If N<0, return the Nth DAYNAME before MONTH DAY, YEAR (inclusive). If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive). If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise. (defalias 'calendar-nth-named-absday #[(n dayname month year &optional day) #@591 ("ÁVƒ¡0SÂ_Ã\f †0ÇE‰ ‰ AA@)S\n ‰ ‰ @) ‰ A@) ‰ AA@) SË_\\\f ÍVƒƒ0\f Î_Ï\\Ð¥Z\f‰ΦÁU…z0ѦÁU?†z0Ò¦ÁU)ƒƒ0\fT\f\f-\nÓ_\\\nÎ¥\\\nÑ¥[\\\nÒ¥\\*Ô\\\"\\‡TÂ_Ã\f †â0 ‰ÍUƒÝ0‰ΦÁU…Õ0ѦÁU?†Õ0Ò¦ÁU)ƒÝ0Õ‚á0Ö SH*E‰ ‰ AA@)S\n ‰ ‰ @) ‰ A@) ‰ AA@) SË_\\\f ÍVƒR\f Î_Ï\\Ð¥Z\f‰ΦÁU…IѦÁU?†IÒ¦ÁU)ƒR\fT\f\f-\nÓ_\\\nÎ¥\\\nÑ¥[\\\nÒ¥\\*\"\\‡" . [n 0 7 calendar-dayname-on-or-before dayname month day 1 year date prior-years 31 day-of-year 2 4 23 10 100 400 365 6 29 [31 28 31 30 31 30 31 31 30 31 30 31]])(#$ . 77192) nil 9 (#$ . 76767)]) #@334 The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY. A DAYNAME of 0 means Sunday, 1 means Monday, and so on. If N<0, return the Nth DAYNAME before MONTH DAY, YEAR (inclusive). If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive). If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise. (defalias 'calendar-nth-named-day #[(n dayname month year &optional day) #@107 ("ÀÁ\n \f %!‡" . [calendar-gregorian-from-absolute calendar-nth-named-absday n dayname month year day])(#$ . 78235) nil 7 (#$ . 77822)]) #@96 String of day number of year of Gregorian DATE. Defaults to today's date if DATE is not given. (defalias 'calendar-day-of-year-string #[(&optional date) #@405 ("†0Á ‰‰AA@)\n‰‰@)‰A@)‰AA@) \fSÆ_\\\fÈVƒa0\fÉ_Ê\\Ë¥Z ‰ɦÌU…X0 ͦÌU?†X0 ΦÌU)ƒa0T-ÏÆ E‰‰@)‰A@)‰AA@) \fSÆ_\\\fÈVƒº0\fÉ_Ê\\Ë¥Z ‰ɦÌU…±0 ͦÌU?†±0 ΦÌU)ƒº0T- ZÑÒ ‰ÓUƒÑ0Ô‚Ò0Õ%,‡" . [date calendar-current-date d year month day 31 day-of-year 2 4 23 10 0 100 400 12 days-remaining format "Day %d of %d; %d day%s remaining in the year" 1 "" "s"])(#$ . 78540) nil 8 (#$ . 78380)]) #@75 Show day number in year/days remaining in year for date under the cursor. (defalias 'calendar-print-day-of-year #[nil #@80 ("ÀÁÂÃ!!!‡" . [message calendar-day-of-year-string calendar-cursor-to-date t])(#$ . 79107) nil 4 (#$ . 78983) nil]) #@55 Set mode line to STR, centered, surrounded by dashes. (defalias 'calendar-set-mode-line #[(str) #@79 ("À CÂà #‰‡" . [calendar-string-spread str 45 frame-width mode-line-format])(#$ . 79331) nil 4 (#$ . 79229)]) #@52 Non-negative remainder of M/N with N instead of 0. (defalias 'calendar-mod #[(m n) #@27 ("À S\n\"T‡" . [mod m n])(#$ . 79537) nil 3 (#$ . 79448)]) (byte-code "ÀÁ!ˆÂÃ!‡" [run-hooks calendar-load-hook provide calendar] 2) emacs-19.30/lisp/case-table.elc100666 74777 1 5032 6051234347 14570 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 18:59:33 1995 ;;; from file /home/fsf/rms/e19/lisp/case-table.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`case-table.el' was compiled for Emacs 19.29 or later")) #@48 Describe the case table of the current buffer. (defalias 'describe-buffer-case-table #[nil "ÀÁ!ÃÄÅ \"ˆŠÆqˆÈ\n!ˆÉ ‘*‡" [make-char-table case-table description map-char-table #[(key value) "À \n‰„ Â,\n‰—U„ÄÅ\n—!P‚,\n‰–U„+ÆÅ\n–!P‚,Ã#‡" [set-char-table-range description key "case-invariant" "uppercase, matches " char-to-string "lowercase, matches "] 6] current-case-table "*Help*" standard-output describe-vector help-mode] 3 (#$ . 480) nil]) (defalias 'copy-case-table #[(case-table) "À !Ã\nÄÅ#ˆÃ\nÆÅ#ˆÃ\nÇÅ#ˆ\n)‡" [copy-sequence case-table copy set-char-table-extra-slot 0 nil 1 2] 4]) #@274 Make characters L and R a matching pair of non-case-converting delimiters. This sets the entries for L and R in TABLE, which is a string that will be used as the downcase part of a case table. It also modifies `standard-syntax-table' to indicate left and right delimiters. (defalias 'set-case-syntax-delims #[(l r table) " ‰Iˆ\n‰IˆÃÄÅ#ˆÃÆÅ#ˆÃÇÅ#ˆÈ ÉÊ\n!ËQÌ #ˆÈ\nÍÊ !ËQÌ #‡" [table l r set-char-table-extra-slot 0 nil 1 2 modify-syntax-entry "(" char-to-string " " standard-syntax-table ")"] 5 (#$ . 1086)]) #@286 Make characters UC and LC a pair of inter-case-converting letters. This sets the entries for characters UC and LC in TABLE, which is a string that will be used as the downcase part of a case table. It also modifies `standard-syntax-table' to give them the syntax of word constituents. (defalias 'set-case-syntax-pair #[(uc lc table) " \nIˆ\n‰IˆÃÄÅ#ˆÃÆÅ#ˆÃÇÅ#ˆÈ\nÉÊ #ˆÈ ÉÊ #‡" [table uc lc set-char-table-extra-slot 0 nil 1 2 modify-syntax-entry "w " standard-syntax-table] 4 (#$ . 1606)]) #@257 Make characters C case-invariant with syntax SYNTAX. This sets the entries for character C in TABLE, which is a string that will be used as the downcase part of a case table. It also modifies `standard-syntax-table'. SYNTAX should be " ", "w", "." or "_". (defalias 'set-case-syntax #[(c syntax table) " ‰IˆÂÃÄ#ˆÂÅÄ#ˆÂÆÄ#ˆÇ É #‡" [table c set-char-table-extra-slot 0 nil 1 2 modify-syntax-entry syntax standard-syntax-table] 4 (#$ . 2109)]) (provide (quote case-table)) emacs-19.30/lisp/cc-mode.elc100666 12120 1 246056 6055504656 14141 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 24 22:10:56 1995 ;;; from file /home/fsf/rms/e19/lisp/cc-mode.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`cc-mode.el' was compiled for Emacs 19.29 or later")) #@56 *If non-nil, inhibits start up compatibility warnings. (defvar c-inhibit-startup-warnings-p nil (#$ . -472)) #@255 *If non-nil, all syntactic symbols must be found in `c-offsets-alist'. If the syntactic symbol for a particular line does not match a symbol in the offsets alist, an error is generated, otherwise no error is reported and the syntactic symbol is ignored. (defvar c-strict-syntax-p nil (#$ . -588)) #@66 *If non-nil, syntactic info is echoed when the line is indented. (defvar c-echo-syntactic-information-p nil (#$ . -891)) #@71 *Amount of basic offset used by + and - symbols in `c-offsets-alist'. (defvar c-basic-offset 4 (#$ . -1018)) #@5374 *Association list of syntactic element symbols and indentation offsets. As described below, each cons cell in this list has the form: (SYNTACTIC-SYMBOL . OFFSET) When a line is indented, cc-mode first determines the syntactic context of the line by generating a list of symbols called syntactic elements. This list can contain more than one syntactic element and the global variable `c-syntactic-context' contains the context list for the line being indented. Each element in this list is actually a cons cell of the syntactic symbol and a buffer position. This buffer position is called the relative indent point for the line. Some syntactic symbols may not have a relative indent point associated with them. After the syntactic context list for a line is generated, cc-mode calculates the absolute indentation for the line by looking at each syntactic element in the list. First, it compares the syntactic element against the SYNTACTIC-SYMBOL's in `c-offsets-alist'. When it finds a match, it adds the OFFSET to the column of the relative indent point. The sum of this calculation for each element in the syntactic list is the absolute offset for line being indented. If the syntactic element does not match any in the `c-offsets-alist', an error is generated if `c-strict-syntax-p' is non-nil, otherwise the element is ignored. Actually, OFFSET can be an integer, a function, a variable, or one of the following symbols: `+', `-', `++', `--', `*', or `/'. These latter designate positive or negative multiples of `c-basic-offset', respectively: *1, *-1, *2, *-2, *0.5, and *-0.5. If OFFSET is a function, it is called with a single argument containing the cons of the syntactic element symbol and the relative indent point. The function should return an integer offset. Here is the current list of valid syntactic element symbols: string -- inside multi-line string c -- inside a multi-line C style block comment defun-open -- brace that opens a function definition defun-close -- brace that closes a function definition defun-block-intro -- the first line in a top-level defun class-open -- brace that opens a class definition class-close -- brace that closes a class definition inline-open -- brace that opens an in-class inline method inline-close -- brace that closes an in-class inline method ansi-funcdecl-cont -- the nether region between an ANSI function declaration and the defun opening brace knr-argdecl-intro -- first line of a K&R C argument declaration knr-argdecl -- subsequent lines in a K&R C argument declaration topmost-intro -- the first line in a topmost construct definition topmost-intro-cont -- topmost definition continuation lines member-init-intro -- first line in a member initialization list member-init-cont -- subsequent member initialization list lines inher-intro -- first line of a multiple inheritance list inher-cont -- subsequent multiple inheritance lines block-open -- statement block open brace block-close -- statement block close brace brace-list-open -- open brace of an enum or static array list brace-list-close -- close brace of an enum or static array list brace-list-intro -- first line in an enum or static array list brace-list-entry -- subsequent lines in an enum or static array list statement -- a C/C++/ObjC statement statement-cont -- a continuation of a C/C++/ObjC statement statement-block-intro -- the first line in a new statement block statement-case-intro -- the first line in a case `block' statement-case-open -- the first line in a case block starting with brace substatement -- the first line after an if/while/for/do/else substatement-open -- the brace that opens a substatement block case-label -- a case or default label access-label -- C++ private/protected/public access label label -- any non-special C/C++/ObjC label do-while-closure -- the `while' that ends a do/while construct else-clause -- the `else' of an if/else construct comment-intro -- a line containing only a comment introduction arglist-intro -- the first line in an argument list arglist-cont -- subsequent argument list lines when no arguments follow on the same line as the the arglist opening paren arglist-cont-nonempty -- subsequent argument list lines when at least one argument follows on the same line as the arglist opening paren arglist-close -- the solo close paren of an argument list stream-op -- lines continuing a stream operator construct inclass -- the construct is nested inside a class definition cpp-macro -- the start of a cpp macro friend -- a C++ friend declaration objc-method-intro -- the first line of an Objective-C method definition objc-method-args-cont -- lines continuing an Objective-C method definition objc-method-call-cont -- lines continuing an Objective-C method call  (defvar c-offsets-alist (quote ((string . -1000) (c . c-lineup-C-comments) (defun-open . 0) (defun-close . 0) (defun-block-intro . +) (class-open . 0) (class-close . 0) (inline-open . +) (inline-close . 0) (ansi-funcdecl-cont . -) (knr-argdecl-intro . +) (knr-argdecl . 0) (topmost-intro . 0) (topmost-intro-cont . 0) (member-init-intro . +) (member-init-cont . 0) (inher-intro . +) (inher-cont . c-lineup-multi-inher) (block-open . 0) (block-close . 0) (brace-list-open . 0) (brace-list-close . 0) (brace-list-intro . +) (brace-list-entry . 0) (statement . 0) (statement-cont . +) (statement-block-intro . +) (statement-case-intro . +) (statement-case-open . 0) (substatement . +) (substatement-open . +) (case-label . 0) (access-label . -) (label . 2) (do-while-closure . 0) (else-clause . 0) (comment-intro . c-lineup-comment) (arglist-intro . +) (arglist-cont . 0) (arglist-cont-nonempty . c-lineup-arglist) (arglist-close . +) (stream-op . c-lineup-streamop) (inclass . +) (cpp-macro . -1000) (friend . 0) (objc-method-intro . -1000) (objc-method-args-cont . c-lineup-ObjC-method-args) (objc-method-call-cont . c-lineup-ObjC-method-call))) (#$ . -1135)) #@539 *Controls the operation of the TAB key. If t, hitting TAB always just indents the current line. If nil, hitting TAB indents the current line if point is at the left margin or in the line's indentation, otherwise it insert a real tab character. If other than nil or t, then tab is inserted only within literals -- defined as comments and strings -- and inside preprocessor directives, but line is always reindented. Note that indentation of lines containing only comments is also controlled by the `c-comment-only-line-offset' variable. (defvar c-tab-always-indent t (#$ . -7674)) #@418 *Extra offset for line which contains only the start of a comment. Can contain an integer or a cons cell of the form: (NON-ANCHORED-OFFSET . ANCHORED-OFFSET) Where NON-ANCHORED-OFFSET is the amount of offset given to non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is the amount of offset to give column-zero anchored comment-only lines. Just an integer as value is equivalent to ( . -1000). (defvar c-comment-only-line-offset 0 (#$ . -8263)) #@214 *Specifies how comment-only lines should be indented. When this variable is non-nil, comment-only lines are indented according to syntactic analysis via `c-offsets-alist', even when \[indent-for-comment] is used. (defvar c-indent-comments-syntactically-p nil (#$ . -8738)) #@854 *Specifies how to re-indent C style block comments. Examples of the supported styles of C block comment indentation are shown below. When this variable is nil, block comments are indented as shown in styles 1 through 4. If this variable is non-nil, block comments are indented as shown in style 5. Note that cc-mode does not automatically insert any stars or block comment delimiters. You must type these in manually. This variable only controls how the lines within the block comment are indented when you hit ``\[c-indent-command]''. style 1: style 2 (GNU): style 3: style 4: style 5: /* /* Blah /* /* /* blah blah. */ * blah ** blah blah blah * blah ** blah blah */ */ */ */ (defvar c-block-comments-indent-p nil (#$ . -9018)) #@1436 *List of various C/C++/ObjC constructs to "clean up". These clean ups only take place when the auto-newline feature is turned on, as evidenced by the `/a' or `/ah' appearing next to the mode name. Valid symbols are: brace-else-brace -- cleans up `} else {' constructs by placing entire construct on a single line. This clean up only takes place when there is nothing but white space between the braces and the `else'. Clean up occurs when the open-brace after the `else' is typed. empty-defun-braces -- cleans up empty defun braces by placing the braces on the same line. Clean up occurs when the defun closing brace is typed. defun-close-semi -- cleans up the terminating semi-colon on defuns by placing the semi-colon on the same line as the closing brace. Clean up occurs when the semi-colon is typed. list-close-comma -- cleans up commas following braces in array and aggregate initializers. Clean up occurs when the comma is typed. scope-operator -- cleans up double colons which may designate a C++ scope operator split across multiple lines. Note that certain C++ constructs can generate ambiguous situations. This clean up only takes place when there is nothing but whitespace between colons. Clean up occurs when the second colon is typed. (defvar c-cleanup-list (quote (scope-operator)) (#$ . -9931)) #@1332 *Controls the insertion of newlines before and after braces. This variable contains an association list with elements of the following form: (SYNTACTIC-SYMBOL . ACTION). When a brace (either opening or closing) is inserted, the syntactic context it defines is looked up in this list, and if found, the associated ACTION is used to determine where newlines are inserted. If the context is not found, the default is to insert a newline both before and after the brace. SYNTACTIC-SYMBOL can be any of: defun-open, defun-close, class-open, class-close, inline-open, inline-close, block-open, block-close, substatement-open, statement-case-open, brace-list-open, brace-list-close, brace-list-intro, or brace-list-entry. See `c-offsets-alist' for details. ACTION can be either a function symbol or a list containing any combination of the symbols `before' or `after'. If the list is empty, no newlines are inserted either before or after the brace. When ACTION is a function symbol, the function is called with a two arguments: the syntactic symbol for the brace and the buffer position at which the brace was inserted. The function must return a list as described in the preceding paragraph. Note that during the call to the function, the variable `c-syntactic-context' is set to the entire syntactic context for the brace line. (defvar c-hanging-braces-alist (quote ((brace-list-open) (substatement-open after) (block-close . c-snug-do-while))) (#$ . -11436)) #@355 *Controls the insertion of newlines before and after certain colons. This variable contains an association list with elements of the following form: (SYNTACTIC-SYMBOL . ACTION). See the variable `c-hanging-braces-alist' for the semantics of this variable. Note however that making ACTION a function symbol is currently not supported for this variable. (defvar c-hanging-colons-alist nil (#$ . -12906)) #@677 *List of functions that decide whether to insert a newline or not. The functions in this list are called, in order, whenever the auto-newline minor mode is activated (as evidenced by a `/a' or `/ah' string in the mode line), and a semicolon or comma is typed (see `c-electric-semi&comma'). Each function in this list is called with no arguments, and should return one of the following values: nil -- no determination made, continue checking 'stop -- do not insert a newline, and stop checking (anything else) -- insert a newline, and stop checking If every function in the list is called with no determination made, then no newline is inserted. (defvar c-hanging-semi&comma-criteria (quote (c-semi&comma-inside-parenlist)) (#$ . -13317)) #@206 *If nil, `c-fill-paragraph' leaves C block comment enders on their own line. Default value is t, which inhibits leaving block comment ending string `*/' on a line by itself. This is BOCM's sole behavior. (defvar c-hanging-comment-ender-p t (#$ . -14093)) #@57 *Column to insert backslashes when macroizing a region. (defvar c-backslash-column 48 (#$ . -14355)) #@117 *Hook for user defined special indentation adjustments. This hook gets called after a line is indented by the mode. (defvar c-special-indent-hook nil (#$ . -14463)) #@67 *Function called by `c-electric-delete' when deleting characters. (defvar c-delete-function (quote backward-delete-char-untabify) (#$ . -14634)) #@100 *List of behaviors for electric pound insertion. Only currently supported behavior is `alignleft'. (defvar c-electric-pound-behavior nil (#$ . -14786)) #@405 *If non-nil, `c-mode' and `objc-mode' will recognize K&R constructs. This variable is needed because of ambiguities in C syntax that make fast recognition of K&R constructs problematic, and slow. If you are coding with ANSI prototypes, set this variable to nil to speed up recognition of certain constructs. By setting this variable to nil, I have seen an increase of 20 times under some circumstance. (defvar c-recognize-knr-p t (#$ . -14945)) #@227 *Interval used to update progress status during long re-indentation. If a number, percentage complete gets updated after each interval of that many seconds. Set to nil to inhibit updating. This is only useful for Emacs 19. (defvar c-progress-interval 5 (#$ . -15399)) #@776 Styles of Indentation. Elements of this alist are of the form: (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) where STYLE-STRING is a short descriptive string used to select a style, VARIABLE is any cc-mode variable, and VALUE is the intended value for that variable when using the selected style. There is one special case when VARIABLE is `c-offsets-alist'. In this case, the VALUE is a list containing elements of the form: (SYNTACTIC-SYMBOL . VALUE) as described in `c-offsets-alist'. These are passed directly to `c-set-offset' so there is no need to set every syntactic symbol in your style, only those that are different from the default. Note that all styles inherit from the "CC-MODE" style, which is computed at the time the mode is loaded. (defvar c-style-alist (quote (("GNU" (c-basic-offset . 2) (c-comment-only-line-offset 0 . 0) (c-offsets-alist (statement-block-intro . +) (knr-argdecl-intro . 5) (substatement-open . +) (label . 0) (statement-case-open . +) (statement-cont . +) (arglist-intro . c-lineup-arglist-intro-after-paren) (arglist-close . c-lineup-arglist))) ("K&R" (c-basic-offset . 5) (c-comment-only-line-offset . 0) (c-offsets-alist (statement-block-intro . +) (knr-argdecl-intro . 0) (substatement-open . 0) (label . 0) (statement-cont . +))) ("BSD" (c-basic-offset . 4) (c-comment-only-line-offset . 0) (c-offsets-alist (statement-block-intro . +) (knr-argdecl-intro . +) (substatement-open . 0) (label . 0) (statement-cont . +))) ("Stroustrup" (c-basic-offset . 4) (c-comment-only-line-offset . 0) (c-offsets-alist (statement-block-intro . +) (substatement-open . 0) (label . 0) (statement-cont . +))) ("Whitesmith" (c-basic-offset . 4) (c-comment-only-line-offset . 0) (c-offsets-alist (statement-block-intro . +) (knr-argdecl-intro . +) (substatement-open . 0) (label . 0) (statement-cont . +))) ("Ellemtel" (c-basic-offset . 3) (c-comment-only-line-offset . 0) (c-hanging-braces-alist (substatement-open before after)) (c-offsets-alist (topmost-intro . 0) (topmost-intro-cont . 0) (substatement . 3) (substatement-open . 0) (statement-case-intro . 0) (case-label . +) (access-label . -3) (inclass . 6) (inline-open . 0))))) (#$ . 15677)) #@381 *Variable interface for setting style via File Local Variables. In a file's Local Variable section, you can set this variable to a string suitable for `c-set-style'. When the file is visited, cc-mode will set the style of the file to this value automatically. Note that file style settings are applied before file offset settings as designated in the variable `c-file-offsets'. (defvar c-file-style nil (#$ . -17883)) #@407 *Variable interface for setting offsets via File Local Variables. In a file's Local Variable section, you can set this variable to an association list similiar to the values allowed in `c-offsets-alist'. When the file is visited, cc-mode will institute these offset settings automatically. Note that file offset settings are applied after file style settings as designated in the variable `c-file-style'. (defvar c-file-offsets nil (#$ . -18310)) #@27 *Hook called by `c-mode'. (defvar c-mode-hook nil (#$ . -18764)) #@29 *Hook called by `c++-mode'. (defvar c++-mode-hook nil (#$ . -18835)) #@30 *Hook called by `objc-mode'. (defvar objc-mode-hook nil (#$ . -18910)) #@75 *Hook called by `c-mode', `c++-mode', and 'objc-mode' during common init. (defvar c-mode-common-hook nil (#$ . -18987)) #@55 XEmacs 19 (formerly Lucid) menu for C/C++/ObjC modes. (defvar c-mode-menu (quote (["Comment Out Region" comment-region (mark)] ["Macro Expand Region" c-macro-expand (mark)] ["Backslashify" c-backslash-region (mark)] ["Indent Expression" c-indent-exp (memq (following-char) (quote (40 91 123)))] ["Indent Line" c-indent-command t] ["Fill Comment Paragraph" c-fill-paragraph t] ["Up Conditional" c-up-conditional t] ["Backward Conditional" c-backward-conditional t] ["Forward Conditional" c-forward-conditional t] ["Backward Statement" c-beginning-of-statement t] ["Forward Statement" c-end-of-statement t])) (#$ . 19113)) #@417 A list of features extant in the Emacs you are using. There are many flavors of Emacs out there, each with different features supporting those needed by cc-mode. Here's the current supported list, along with the values for this variable: Vanilla Emacs 18/Epoch 4: (v18 no-dual-comments) Emacs 18/Epoch 4 (patch2): (v18 8-bit) XEmacs (formerly Lucid) 19: (v19 8-bit) Emacs 19: (v19 1-bit). (defconst c-emacs-features (byte-code "ÀÁ!… ÀÂ!…\nɉƒ„=ÈÉ\n\"ƒ=Ë\n̔̕O!Ë\n͔͕O!ƒG„KÎÏ!ˆÐUƒXÑ‚ŽÒUƒeÑ‚ŽÓUƒˆÔÈÕ\n\"„ÈÖ\n\"ƒƒ×‚„Ø‚ŽÎÙ\"ˆÔ=ƒÁÚ ÜÝÞ#ˆß!ƒ»àáÝHâ\"ã\"ãUƒ»ä‚½å)‚ÃæÔ=ƒ× ×=ƒ×çW„ëÔ=ƒû Ø=ƒûèWƒû)„ûêëìí\n\"!‘ˆÑ=ƒ\fæ=ƒ)„êëìî\n\"!‘ˆÑ=ƒ3\fæ=„3)„3êëìï!!‘ˆ\f,D‡" [boundp emacs-major-version emacs-minor-version nil comments flavor minor major string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version string-to-int 1 2 error "Cannot figure out the major and minor version numbers." 18 v18 4 19 v19 "Lucid" "XEmacs" XEmacs FSF "Cannot recognize major version number: %s" copy-syntax-table table modify-syntax-entry 97 ". 12345678" vectorp logand lsh -16 255 8-bit 1-bit no-dual-comments 6 21 c-inhibit-startup-warnings-p "*cc-mode warnings*" print format "The version of Emacs that you are running, %s,\nhas known bugs in its syntax.c parsing routines which will affect the\nperformance of cc-mode. You should strongly consider upgrading to the\nlatest available version. cc-mode may continue to work, after a\nfashion, but strange indentation errors could be encountered." "The version of Emacs 18 you are running, %s,\nhas known deficiencies in its ability to handle dual C++ comments,\ni.e. C++ line style comments and C block style comments. This will\nnot be much of a problem for you if you are only editing C code, but\nif you are doing much C++ editing, you should strongly consider\nupgrading to one of the latest Emacs 19's. In Emacs 18, you may also\nexperience performance degradations. Emacs 19 has some new built-in\nroutines which will speed things up for you.\n\nBecause of these inherent problems, cc-mode is no longer being\nactively maintained for Emacs 18, however, until you can upgrade to\nEmacs 19, you may want to look at cc-mode-18.el in the cc-mode\ndistribution. THIS FILE IS COMPLETELY UNSUPPORTED! If you use it,\nyou are on your own, although patch contributions will be folded into\nthe main release." "You are running a syntax patched Emacs 18 variant. While this should\nwork for you, you may want to consider upgrading to Emacs 19.\nThe syntax patches are no longer supported either for syntax.c or cc-mode."] 6) (#$ . 19741)) #@42 Abbrev table in use in c++-mode buffers. (defvar c++-mode-abbrev-table nil (#$ . 22436)) (define-abbrev-table (quote c++-mode-abbrev-table) nil) #@40 Abbrev table in use in c-mode buffers. (defvar c-mode-abbrev-table nil (#$ . 22587)) (define-abbrev-table (quote c-mode-abbrev-table) nil) #@43 Abbrev table in use in objc-mode buffers. (defvar objc-mode-abbrev-table nil (#$ . 22732)) (define-abbrev-table (quote objc-mode-abbrev-table) nil) (defalias 'c-mode-fsf-menu #[(name map) "ÀÁ‡" [nil (byte-code "À Âà #ˆÀ Ä Ã !B#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆÀ ØÙ#ˆÀ ÚÛ#ˆÜ‡" [define-key map [menu-bar] make-sparse-keymap [menu-bar c] name [menu-bar c comment-region] ("Comment Out Region" . comment-region) [menu-bar c c-macro-expand] ("Macro Expand Region" . c-macro-expand) [menu-bar c c-backslash-region] ("Backslashify" . c-backslash-region) [menu-bar c indent-exp] ("Indent Expression" . c-indent-exp) [menu-bar c indent-line] ("Indent Line" . c-indent-command) [menu-bar c fill] ("Fill Comment Paragraph" . c-fill-paragraph) [menu-bar c up] ("Up Conditional" . c-up-conditional) [menu-bar c backward] ("Backward Conditional" . c-backward-conditional) [menu-bar c forward] ("Forward Conditional" . c-forward-conditional) [menu-bar c backward-stmt] ("Backward Statement" . c-beginning-of-statement) [menu-bar c forward-stmt] ("Forward Statement" . c-end-of-statement) t] 6) ((error))] 3]) #@32 Keymap used in c-mode buffers. (defvar c-mode-map nil (#$ . 23856)) (byte-code "„ÈÁ ÂÃÄ#ˆÂÅÄ#ˆÂÆÇ#ˆÂÈÉ#ˆÂÊË#ˆÂÌÍ#ˆÂÎÏ#ˆÂÐÑ#ˆÂÒÓ#ˆÂÔÕ#ˆÂÖ×#ˆÂØÙ#ˆÂÚÛ#ˆÂÜÝ#ˆÂÞß#ˆÂàÇ#ˆÂáâ#ˆÂãä#ˆÂåæ#ˆÂçè#ˆÂéê#ˆÂëì#ˆÂíî#ˆÂïð#ˆÂñò#ˆÂóô#ˆÂõö#ˆÂ÷ø#ˆùú\"„Èûü!ƒÈûý!„ÈÂþÿ#ˆÁ‡" [c-mode-map make-sparse-keymap define-key "{" c-electric-brace "}" ";" c-electric-semi&comma "#" c-electric-pound ":" c-electric-colon "" c-mark-function "" c-indent-exp "a" c-beginning-of-statement "e" c-end-of-statement "q" c-fill-paragraph "" c-forward-conditional "" c-backward-conditional "" c-up-conditional " " c-indent-command "" c-electric-delete "," "/" c-electric-slash "*" c-electric-star "" c-indent-defun "" c-backslash-region "" c-toggle-auto-state "" c-submit-bug-report "" comment-region "" c-toggle-hungry-state "" c-macro-expand "" c-set-offset "" c-show-syntactic-information "" c-toggle-auto-hungry-state c-mode-fsf-menu "C" boundp current-menubar mode-popup-menu button3 c-popup-menu] 4) #@34 Keymap used in c++-mode buffers. (defvar c++-mode-map nil (#$ . 24891)) (byte-code "„5Á\n>ƒ$ÃÄ!„ÅB‚*Ç Ä\"ˆ‚*Ç ¤ÈÉÊ#ˆËÌ\"ˆÁ‡" [c++-mode-map v19 c-emacs-features fboundp set-keymap-parent keymap c-mode-map make-sparse-keymap define-key ":" c-scope-operator c-mode-fsf-menu "C++"] 4) #@35 Keymap used in objc-mode buffers. (defvar objc-mode-map nil (#$ . 25198)) (byte-code "„/Á\n>ƒ$ÃÄ!„ÅB‚*Ç Ä\"ˆ‚*Ç ¤ÈÉ\"ˆÁ‡" [objc-mode-map v19 c-emacs-features fboundp set-keymap-parent keymap c-mode-map make-sparse-keymap c-mode-fsf-menu "ObjC"] 3) (defalias 'c-populate-syntax-table #[(table) "ÀÁ #ˆÀÄÅ #ˆÀÆÇ #ˆÀÈÇ #ˆÀÉÇ #ˆÀÊÇ #ˆÀËÇ #ˆÀÌÇ #ˆÀÍÇ #ˆÀÎÇ #ˆÀÏÐ #‡" [modify-syntax-entry 95 "_" table 92 "\\" 43 "." 45 61 37 60 62 38 124 39 "\""] 4]) (defalias 'c-setup-dual-comments #[(table) "À >ƒÂÃÄ #ˆÂÆÇ #ˆÂÈÉ #ˆÂÊÉ #‡Ë >…;ÂÃÌ #ˆÂÆÇ #ˆÂÈÉ #ˆÂÊÉ #‡" [8-bit c-emacs-features modify-syntax-entry 47 ". 1456" table 42 ". 23" 10 "> b" 13 1-bit ". 124b"] 4]) #@38 Syntax table used in c-mode buffers. (defvar c-mode-syntax-table nil (#$ . 25878)) (byte-code "„Á Â!ˆÃÄÅ#ˆÃÆÇ#ˆÁ‡" [c-mode-syntax-table make-syntax-table c-populate-syntax-table modify-syntax-entry 47 ". 14" 42 ". 23"] 4) #@40 Syntax table used in c++-mode buffers. (defvar c++-mode-syntax-table nil (#$ . 26113)) (byte-code "„Á Â!ˆÃ!ˆÁ‡" [c++-mode-syntax-table make-syntax-table c-populate-syntax-table c-setup-dual-comments] 2) #@41 Syntax table used in objc-mode buffers. (defvar objc-mode-syntax-table nil (#$ . 26328)) (byte-code "„Á Â!ˆÃ!ˆÄÅÆ#ˆÁ‡" [objc-mode-syntax-table make-syntax-table c-populate-syntax-table c-setup-dual-comments modify-syntax-entry 64 "_"] 4) #@46 Internal state of hungry delete key feature. (defvar c-hungry-delete-key nil (#$ . 26579)) #@41 Internal state of auto newline feature. (defvar c-auto-newline nil (#$ . 26676)) #@71 Internal auto-newline/hungry-delete designation string for mode line. (defvar c-auto-hungry-string nil (#$ . 26763)) #@65 Variable containing syntactic analysis list during indentation. (defvar c-syntactic-context nil (#$ . 26886)) #@62 Buffer local variable describing how comment are introduced. (defvar c-comment-start-regexp nil (#$ . 27002)) #@60 Buffer local language-specific conditional keyword regexp. (defvar c-conditional-key nil (#$ . 27118)) #@51 Buffer local language-specific access key regexp. (defvar c-access-key nil (#$ . 27227)) #@50 Buffer local language-specific class key regexp. (defvar c-class-key nil (#$ . 27322)) #@40 Regexp describing protection keywords. (defconst c-protection-key "\\<\\(public\\|protected\\|private\\)\\>" (#$ . 27415)) #@216 Regexp describing a C/C++/ObjC symbol. We cannot use just `word' syntax class since `_' cannot be in word class. Putting underscore in word class breaks forward word movement behavior that users are familiar with. (defconst c-symbol-key "\\(\\w\\|\\s_\\)+" (#$ . 27545)) #@67 Regexp describing C++ base classes in a derived class definition. (defconst c-baseclass-key (concat ":?[ ]*\\(virtual[ ]+\\)?\\(" c-protection-key "[ ]+\\)" c-symbol-key) (#$ . 27823)) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÀÅ!ˆÀÆ!ˆÀÇ!ˆÀÈ!ˆÀÉ!‡" [make-variable-buffer-local c-auto-newline c-hungry-delete-key c-auto-hungry-string c-comment-start-regexp c-conditional-key c-access-key c-class-key c-baseclass-key c-recognize-knr-p] 2) #@141 Display the result of expanding all C macros occurring in the region. The expansion is entirely correct because it uses the C preprocessor. (autoload (quote c-macro-expand) "cmacexp" '(#$ . 28256) t) #@65 Regexp describing a C++ class declaration, including templates. (defconst c-C++-class-key "\\(class\\|struct\\|union\\)" (#$ . 28462)) #@43 Regexp describing a C struct declaration. (defconst c-C-class-key "\\(struct\\|union\\)" (#$ . 28603)) #@52 Regexp describing a class inheritance declaration. (defconst c-inher-key (concat "\\(\\\\s +\\)?" c-C++-class-key "[ ]+" c-symbol-key "\\([ ]*:[ ]*\\)?\\s *[^;]") (#$ . 28712)) #@52 Regexp describing a switch's case or default label (defconst c-switch-label-key "\\(\\(case[( ]+\\S .*\\)\\|default[ ]*\\):" (#$ . 28908)) #@54 Regexp describing C++ access specification keywords. (defconst c-C++-access-key (concat c-protection-key ":") (#$ . 29055)) #@30 Regexp describing any label. (defconst c-label-key (concat c-symbol-key ":\\([^:]\\|$\\)") (#$ . 29185)) #@42 Regexp describing a conditional control. (defconst c-C-conditional-key "\\b\\(for\\|if\\|do\\|else\\|while\\|switch\\)\\b[^_]" (#$ . 29296)) #@50 Regexp describing a conditional control for C++. (defconst c-C++-conditional-key "\\b\\(for\\|if\\|do\\|else\\|while\\|switch\\|try\\|catch\\)\\b[^_]" (#$ . 29443)) #@55 Regexp describing friend declarations in C++ classes. (defconst c-C++-friend-key "friend[ ]+\\|template[ ]*<.+>[ ]*friend[ ]+" (#$ . 29614)) #@50 Dual comment value for `c-comment-start-regexp'. (defconst c-C++-comment-start-regexp "//\\|/\\*" (#$ . 29765)) #@58 Single comment style value for `c-comment-start-regexp'. (defconst c-C-comment-start-regexp "/\\*" (#$ . 29883)) #@48 Regexp describing an Objective-C method intro. (defconst c-ObjC-method-key (concat "^\\s *[+-]\\s *" "\\(([^)]*)\\)?" "[ \n]*" c-symbol-key) (#$ . 30002)) #@66 Regexp describing access specification keywords for Objective-C. (defconst c-ObjC-access-key (concat "@" c-protection-key) (#$ . 30164)) #@68 Regexp describing a class or protocol declaration for Objective-C. (defconst c-ObjC-class-key (concat "@\\(interface\\|implementation\\)\\s +" c-symbol-key "\\(\\s *:\\s *" c-symbol-key "\\)?" "\\(\\s *<[^>]+>\\)?") (#$ . 30307)) (byte-code "ÀÁ\n\"ˆÀÃ\f\"ˆÀÅ\"ˆÇÈ B LJ" [set-default c-conditional-key c-C-conditional-key c-class-key c-C-class-key c-comment-start-regexp c-C-comment-start-regexp nil c-list-of-mode-names current-load-list] 3) #@614 Major mode for editing C++ code. To submit a problem report, enter `\[c-submit-bug-report]' from a c++-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the problem, including a reproducable test case and send the message. To see what version of cc-mode you are running, enter `\[c-version]'. The hook variable `c++-mode-hook' is run with no args, if that variable is bound and has a non-nil value. Also the common hook c-mode-common-hook is run first, by this defun, `c-mode', and `objc-mode'. Key bindings: \{c++-mode-map} (defalias 'c++-mode #[nil "À ˆÁ\n!ˆÃÅÉ\n!ˆË ˆÌ ÎÐÚÛ!ˆÚÜ!‡" [kill-all-local-variables set-syntax-table c++-mode-syntax-table c++-mode major-mode "C++" mode-name c++-mode-abbrev-table local-abbrev-table use-local-map c++-mode-map c-common-init "// " comment-start "" comment-end nil comment-multi-line c-C++-conditional-key c-conditional-key c-C++-comment-start-regexp c-comment-start-regexp c-C++-class-key c-class-key c-C++-access-key c-access-key run-hooks c-mode-common-hook c++-mode-hook] 2 (#$ . 30762) nil]) (byte-code "À B‡" ["C++" c-list-of-mode-names nil] 2) #@618 Major mode for editing K&R and ANSI C code. To submit a problem report, enter `\[c-submit-bug-report]' from a c-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the problem, including a reproducable test case and send the message. To see what version of cc-mode you are running, enter `\[c-version]'. The hook variable `c-mode-hook' is run with no args, if that value is bound and has a non-nil value. Also the common hook c-mode-common-hook is run first, by this defun, `c++-mode', and `objc-mode'. Key bindings: \{c-mode-map} (defalias 'c-mode #[nil "À ˆÁ\n!ˆÃÅÉ\n!ˆË ˆÌ ÎÐÖÚÛ!ˆÚÜ!‡" [kill-all-local-variables set-syntax-table c-mode-syntax-table c-mode major-mode "C" mode-name c-mode-abbrev-table local-abbrev-table use-local-map c-mode-map c-common-init "/* " comment-start " */" comment-end t comment-multi-line c-C-conditional-key c-conditional-key c-C-class-key c-class-key nil c-baseclass-key c-C-comment-start-regexp c-comment-start-regexp run-hooks c-mode-common-hook c-mode-hook] 2 (#$ . 31980) nil]) (byte-code "À B‡" ["C" c-list-of-mode-names nil] 2) #@622 Major mode for editing Objective C code. To submit a problem report, enter `\[c-submit-bug-report]' from an objc-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the problem, including a reproducable test case and send the message. To see what version of cc-mode you are running, enter `\[c-version]'. The hook variable `objc-mode-hook' is run with no args, if that value is bound and has a non-nil value. Also the common hook c-mode-common-hook is run first, by this defun, `c-mode', and `c++-mode'. Key bindings: \{objc-mode-map} (defalias 'objc-mode #[nil "À ˆÁ\n!ˆÃÅÉ\n!ˆË ˆÌ ÎÐÐÛÜ!ˆÛÝ!‡" [kill-all-local-variables set-syntax-table objc-mode-syntax-table objc-mode major-mode "ObjC" mode-name objc-mode-abbrev-table local-abbrev-table use-local-map objc-mode-map c-common-init "// " comment-start "" comment-end nil comment-multi-line c-C-conditional-key c-conditional-key c-C++-comment-start-regexp c-comment-start-regexp c-ObjC-class-key c-class-key c-baseclass-key c-ObjC-access-key c-access-key run-hooks c-mode-common-hook objc-mode-hook] 2 (#$ . 33170) nil]) (byte-code "À B‡" ["ObjC" c-list-of-mode-names nil] 2) (defalias 'c-common-init #[nil "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÀÅ!ˆÀÆ!ˆÀÇ!ˆÀÈ!ˆÀÉ!ˆÀÊ!ˆÀË!ˆÀÌ!ˆÀÍ!ˆÀÎ!ˆÐP‰ÑÑÑÒÓÔ\fÕ Ö\n× ØÙ!ÛÜ!ƒpÀÜ!ˆÝ‚wÀÞ!ˆÝÛß!ƒÛƒÛà!\"„Ûâ#!Ø$%æ'%\"%%ƒÆà%@\"„´%A‰%‚žè%@C!\"ˆØ%Ñ$‚œ$„Úéâ!!ˆêØ!+#ˆ*Ûì!ƒê!íP+B,î/ž†øð/B‰/‡" [make-local-variable paragraph-start paragraph-separate paragraph-ignore-fill-prefix require-final-newline parse-sexp-ignore-comments indent-line-function indent-region-function comment-start comment-end comment-column comment-start-skip outline-regexp outline-level adaptive-fill-regexp page-delimiter "\\|$" t c-indent-line c-indent-region "[^#\n ]" c-outline-level 32 "/\\*+ *\\|// *" nil copy-alist c-offsets-alist boundp comment-indent-function c-comment-indent comment-indent-hook current-menubar assoc mode-name copy-sequence c-list-of-mode-names changed-p modes delete major-mode relabel-menu-item set-buffer-menubar add-menu c-mode-menu mode-popup-menu " Mode Commands" c-auto-hungry-string minor-mode-alist (c-auto-hungry-string c-auto-hungry-string)] 5]) #@299 Function that post processes relevent file local variables. Currently, this function simply applies any style and offset settings found in the file's Local Variable list. It first applies any style setting found in `c-file-style', then it applies any offset settings it finds in `c-file-offsets'. (defalias 'c-postprocess-file-styles #[nil "ƒÁ!ˆ\n…ÃÄ\n\"‡" [c-file-style c-set-style c-file-offsets mapcar #[(langentry) "@AÃ\n \"*‡" [langentry offset langelem c-set-offset] 3]] 3 (#$ . 35478)]) (byte-code "ÀÁ!ƒ ÁÂÃ\"ˆÀ‡" [fboundp add-hook hack-local-variables-hook c-postprocess-file-styles] 3) #@297 Enables // as a comment delimiter in `c-mode'. ANSI C currently does *not* allow this, although many C compilers support optional C++ style comments. To use, call this function from your `.emacs' file before you visit any C files. The changes are global and affect all future `c-mode' buffers. (defalias 'c-enable-//-in-c-mode #[nil "À !ˆÂÃ\f\"‡" [c-setup-dual-comments c-mode-syntax-table set-default c-C-comment-start-regexp c-C++-comment-start-regexp] 3 (#$ . 36092)]) (defalias 'c-point '(macro . #[(position) "À ¢=ƒ AAƒÂà \"ˆ A@ÄÅÆ Ç=ƒ#È‚m É=ƒ-Ê‚m Ë=ƒ7Ì‚m Í=ƒA΂m Ï=ƒKЂm Ñ=ƒUÒ‚m Ó=ƒ_Ô‚m Õ=ƒiÖ‚mÂ× \"ØÙ#BB‡" [quote position error "bad buffer position requested: %s" let ((here (point))) append bol ((beginning-of-line)) eol ((end-of-line)) bod ((beginning-of-defun) (and (boundp (quote defun-prompt-regexp)) defun-prompt-regexp (looking-at defun-prompt-regexp) (goto-char (match-end 0)))) boi ((back-to-indentation)) bonl ((forward-line 1)) bopl ((forward-line -1)) iopl ((forward-line -1) (back-to-indentation)) ionl ((forward-line 1) (back-to-indentation)) "unknown buffer position requested: %s" ((prog1 (point) (goto-char here))) nil] 6])) (defalias 'c-auto-newline '(macro . #[nil "À‡" [(and c-auto-newline (not (c-in-literal)) (not (newline)))] 1])) (defalias 'c-safe '(macro . #[(&rest body) "ÀÁ BÄBBB‡" [condition-case nil progn body ((error nil))] 4])) (defalias 'c-insert-special-chars #[(arg) "ÀÁ\n!!‡" [self-insert-command prefix-numeric-value arg] 3]) (defalias 'c-intersect-lists #[(list alist) "À\nƒ\n@ ž‰„\nA‰„ )‡" [nil match list alist] 3]) (defalias 'c-lookup-lists #[(list alist1 alist2) "À \n\"@ ž‡" [c-intersect-lists list alist1 alist2] 3]) (defalias 'c-comment-indent #[nil "ÀÁ\nÃQ!ƒ ć`ÅŠÄyˆÀÈ\nÃQ!ƒ'ÉÊ!ˆiT‚ÌÀË!„3ÀÌ!ƒ7͂̃ƒŠÏÅwˆÀ!†Il)ƒƒÑ ŠÄyˆÏÅwˆl)ƒfÓÅBB:ƒq‚u‰BÕÖ×Ø\"\"*‚ÌŠÄyˆo„ŽÙyˆÏÅwˆÀ\n!`)ƒ°bˆiWƒ¬‚Ìi‚ÌbˆÏÅxˆÄUƒÇnƒÇÄ‚ÌiT]+‡" [looking-at "^\\(" c-comment-start-regexp "\\)" 0 nil placeholder opoint "[ ]*}[ ]*\\($\\|" search-forward "}" "^#[ ]*endif[ ]*" "^#[ ]*else[ ]*" 7 c-indent-comments-syntactically-p " " comment-start c-guess-basic-syntax syntax comment-intro c-comment-only-line-offset apply + mapcar c-get-offset -1 comment-column] 5]) (defalias 'c-outline-level #[nil "ŠÀÁwˆi)‡" [" " nil] 2]) (defalias 'c-keep-region-active #[nil "ÀÁ!… ‰‡" [boundp zmacs-region-stays t] 2]) (defalias 'c-update-modeline #[nil "ƒ ƒ\f‚ …ÄÆ>ƒ È ‡ÉÊ !‡" [c-auto-newline c-hungry-delete-key "/ah" "/a" "/h" c-auto-hungry-string v19 c-emacs-features force-mode-line-update set-buffer-modified-p buffer-modified-p] 2]) (defalias 'c-calculate-state #[(arg prevstate) "ƒÁ!‰ÂUƒ ?‡ÂV‡" [arg prefix-numeric-value 0 prevstate] 2]) #@380 Toggle auto-newline feature. Optional numeric ARG, if supplied turns on auto-newline when positive, turns it off when negative, and just toggles it when zero. When the auto-newline feature is enabled (as evidenced by the `/a' or `/ah' on the modeline after the mode name) newlines are automatically inserted after special characters such as brace, comma, semi-colon, and colon. (defalias 'c-toggle-auto-state #[(arg) "À \n\"à ˆÄ ‡" [c-calculate-state arg c-auto-newline c-update-modeline c-keep-region-active] 3 (#$ . 38871) "P"]) #@352 Toggle hungry-delete-key feature. Optional numeric ARG, if supplied turns on hungry-delete when positive, turns it off when negative, and just toggles it when zero. When the hungry-delete-key feature is enabled (as evidenced by the `/h' or `/ah' on the modeline after the mode name) the delete key gobbles all preceding whitespace in one fell swoop. (defalias 'c-toggle-hungry-state #[(arg) "À \n\"à ˆÄ ‡" [c-calculate-state arg c-hungry-delete-key c-update-modeline c-keep-region-active] 3 (#$ . 39411) "P"]) #@273 Toggle auto-newline and hungry-delete-key features. Optional numeric ARG, if supplied turns on auto-newline and hungry-delete when positive, turns them off when negative, and just toggles them when zero. See `c-toggle-auto-state' and `c-toggle-hungry-state' for details. (defalias 'c-toggle-auto-hungry-state #[(arg) "À \n\"À \"Ä ˆÅ ‡" [c-calculate-state arg c-auto-newline c-hungry-delete-key c-update-modeline c-keep-region-active] 3 (#$ . 39930) "P"]) #@342 Deletes preceding character or whitespace. If `c-hungry-delete-key' is non-nil, as evidenced by the "/h" or "/ah" string on the mode line, then all preceding whitespace is consumed. If however an ARG is supplied, or `c-hungry-delete-key' is nil, or point is inside a literal then the function in the variable `c-delete-function' is called. (defalias 'c-electric-delete #[(arg) "ƒ „  ƒ Ä !!‡`ÆÇxˆ` U„%` |‚( È!)‡" [c-hungry-delete-key arg c-in-literal c-delete-function prefix-numeric-value here " \n" nil 1] 3 (#$ . 40396) "P"]) #@211 Electric pound (`#') insertion. Inserts a `#' character specially depending on the variable `c-electric-pound-behavior'. If a numeric ARG is supplied, or if point is inside a literal, nothing special happens. (defalias 'c-electric-pound #[(arg) "À „ „ >„ÄÅ !!‡d`ZnÈyˆÉ ˆÊ Ì\"ˆ?…4dZb*‡" [c-in-literal arg alignleft c-electric-pound-behavior self-insert-command prefix-numeric-value bolp pos 0 delete-horizontal-space insert-char last-command-char 1] 3 (#$ . 40943) "P"]) #@394 Insert a brace. If the auto-newline feature is turned on, as evidenced by the "/a" or "/ah" string on the mode line, newlines are inserted before and after braces based on the value of `c-hanging-braces-alist'. Also, the line is re-indented unless a numeric ARG is supplied, there are non-whitespace characters present on the line after the brace, or the brace is inserted inside a literal. (defalias 'c-electric-brace #[(arg) "À Â` \"Ä !‰„„ÇÈ!„\"É!‚mÊ ÌÍ!ƒ0 ‚2Ð Ð`ÐhzÓUЊÖÐxˆn)„Y× ˆØÙÚ!!ˆÛ …uÞ #†uà‰!A:„•â!A!ƒ•#!A!@\"!)ä!>ƒd`Z` %&çyˆŠŒ%`}ˆÐèéƒÏhê>ƒÏ~ˆÐëìƒÏí`î #‚ä @ƒä @:„ä` @Xƒä A*`ï 0%ñ`%òyˆ`%bˆ)%0[ $*d&Zbˆ`%U„Û +‚cƒ-Šó ˆô ˆ„,õç!ˆ)Š`%òyˆ`%bˆ)6÷6`S\"@òUƒUø6 \"Û ‚bòyˆùÁ!ˆÀ Ð*`ï!0%ñ`%òyˆ`%bˆ)%0[ $*`d`ZЉ:;&%ƒËü=>ƒË>ÿUƒË@A\"ƒËçuˆBÐxˆhCUƒËÄ „Ë`%S|ˆƒ D=>ƒ >CUƒ EFÐØ#ƒ ò”;ò•‰:%Uƒ Ä „ ;:|ˆGcˆd&Zbˆ,H!>ƒE× ˆ`IZ‰JfCUƒ4î‚7KLíJL #ï ˆ+>ÿU…k…kŠM !ˆÌÍ!ƒd ‚jN!).\n+‡" [c-parse-state c-state-cache c-safe-position safepos c-in-literal literal arg looking-at "[ ]*$" c-insert-special-chars (class-open class-close defun-open defun-close inline-open inline-close brace-list-open brace-list-close brace-list-intro brace-list-entry block-open block-close substatement-open statement-case-open) syms boundp blink-paren-function blink-paren-hook old-blink-paren nil insertion-point delete-temp-newline 32 preserve-p c-echo-syntactic-information-p " " newline t self-insert-command prefix-numeric-value c-guess-basic-syntax syntax c-auto-newline c-lookup-lists c-hanging-braces-alist (ignore before after) newlines fboundp c-syntactic-context before here pos -1 (byte-code "ÀÁ!ˆÂ‡" [backward-up-list -1 t] 2) ((error)) (41 125) (byte-code "ÀÁ!ˆÂ‡" [forward-sexp -1 t] 2) ((error)) c-hack-state open c-indent-line shift c-adjust-state 0 delete-indentation just-one-space delete-char bol parse-partial-sexp c-whack-state makunbound mend mbeg empty-defun-braces c-cleanup-list last-command-char 125 c-intersect-lists (defun-close class-close inline-close) " \n" 123 brace-else-brace re-search-backward "}[ \n]*else[ \n]*{" "} else {" after 2 bufpos close which c-backward-syntactic-ws run-hooks] 6 (#$ . 41438) "P"]) #@247 Insert a slash character. If slash is second of a double-slash C++ style comment introducing construct, and we are on a comment-only-line, indent line as comment. If numeric ARG is supplied or point is inside a literal, indentation is inhibited. (defalias 'c-electric-slash #[(arg) "Á>…\n?…hÃU…\fÃU…Å ?ÆÉÊ\n!!ˆ…,Ë *‡" [major-mode (c++-mode objc-mode) arg 47 last-command-char c-in-literal nil c-echo-syntactic-information-p indentp self-insert-command prefix-numeric-value c-indent-line] 3 (#$ . 43750) "P"]) #@248 Insert a star character. If the star is the second character of a C style comment introducing construct, and we are on a comment-only-line, indent line as comment. If numeric ARG is supplied or point is inside a literal, indentation is inhibited. (defalias 'c-electric-star #[(arg) "ÀÁ\n!!ˆ\n?…8à Ä>…8hÅU…8ŠÆuˆÇÈxˆhÉUƒ)ÆuˆÊÈxˆn)…8È Ì )‡" [self-insert-command prefix-numeric-value arg c-in-literal (c) 42 -1 "*" nil 47 " " c-echo-syntactic-information-p c-indent-line] 3 (#$ . 44282) "P"]) #@443 Insert a comma or semicolon. When the auto-newline feature is turned on, as evidenced by the "/a" or "/ah" string on the mode line, a newline might be inserted. See the variable `c-hanging-semi&comma-criteria' for how newline insertion is determined. When semicolon is inserted, the line is re-indented unless a numeric arg is supplied, point is inside a literal, or there are non-whitespace characters on the line following the semicolon. (defalias 'c-electric-semi&comma #[(arg) "ÀÁ !Ã\n!`Æ\f„„ÉÊ!„$Ë!‚¬ÌÍ!!ˆ…¬d`ZÑUƒCÒ>„QÔUƒhÕ>ƒhÖuˆ×ÆxˆhØUƒhÃ\n!„h` |ˆdZbˆ)Ù ˆƉƒ¡@ ‰„”A‰‚~ÆÞ=?‚|…«ß ˆÙ +,‡" [c-most-enclosing-brace c-parse-state lim c-in-literal literal here nil c-echo-syntactic-information-p arg looking-at "[ ]*$" c-insert-special-chars self-insert-command prefix-numeric-value c-auto-newline pos last-command-char 44 list-close-comma c-cleanup-list 59 defun-close-semi -1 " \n" 125 c-indent-line c-hanging-semi&comma-criteria add-newline-p answer criteria stop newline] 4 (#$ . 44785) "P"]) #@313 Determine if a newline should be added after a semicolon. If a comma was inserted, no determination is made. If a semicolon was inserted inside a parenthesis list, no newline is added otherwise a newline is added. In either case, checking is stopped. This supports exactly the old newline insertion behavior. (defalias 'c-semi&comma-inside-parenlist #[nil "ÁU…ÂÃăŇƇ" [last-command-char 59 nil (byte-code "ŠÀÁ!ˆgÂU)?‡" [up-list -1 40] 2) ((error t)) t stop] 3 (#$ . 45861)]) #@488 Insert a colon. If the auto-newline feature is turned on, as evidenced by the "/a" or "/ah" string on the mode line, newlines are inserted before and after colons based on the value of `c-hanging-colons-alist'. Also, the line is re-indented unless a numeric ARG is supplied, there are non-whitespace characters present on the line after the colon, or the colon is inserted inside a literal. This function cleans up double colon scope operators based on the value of `c-cleanup-list'. (defalias 'c-electric-colon #[(arg) "`Á ˆÂÃ!ƒ ƒÄ !ƒÅ•bˆ`bˆ)Ç!É\nÉ É\f„? „?ÄÎ!„FÏ !‚èÐÑ !!ˆd`Z`ƒ†Ô>ƒ†hÖUƒ†×uˆØÉxˆhÖUƒ†Ç „†`ÙZfÖU„†`S|ˆdZbˆ*Ú \n…®ÛÜ\n#†®ÛÞßcˆÚ à×!ˆ# á\n!ˆâ >ƒÛŠãÉxˆn)„Ûd`Z×uˆä ˆá ˆdZbˆ)å £>…èä ˆá -‡" [here beginning-of-defun boundp defun-prompt-regexp looking-at 0 bod c-in-literal literal nil syntax newlines c-echo-syntactic-information-p arg "[ ]*$" c-insert-special-chars self-insert-command prefix-numeric-value pos c-auto-newline scope-operator c-cleanup-list 58 -1 " \n" 2 c-guess-basic-syntax c-lookup-lists (case-label label access-label) c-hanging-colons-alist (member-init-intro inher-intro) "\n" delete-char c-indent-line before ": " newline after] 5 (#$ . 46354) "P"]) (byte-code "ÀÁÂ\"ˆÃÄÅÆ#ˆÃÄÇÆ#‡" [mapcar #[(sym) "À ÂÃ#ˆÀ ÄÃ#‡" [put sym delete-selection t pending-delete] 4] (c-electric-pound c-electric-brace c-electric-slash c-electric-star c-electric-semi&comma c-electric-colon) put c-electric-delete delete-selection supersede pending-delete] 4) (defalias 'c-read-offset #[(langelem) " ž£ÃÄ\n\"ÆÇ QÉ P\nË\fË Ë\f„¯Ï\n!‰ Иƒ3\n‚© јƒ>Ò‚© Ó˜ƒIÔ‚© Õ˜ƒTÖ‚© טƒ_Ø‚© Ù˜ƒjÚ‚© Û˜ƒuÜ‚©ÝÞ \"ƒ„ß !‚©àá !‰!ƒ•‚©â!ƒ¡‚©ã ˆ\nˉ\fƒ#\f.‡" [langelem c-offsets-alist oldoff format "(default %s): " defstr "Offset must be int, func, var, " "or in [+,-,++,--,*,/] " errmsg "Offset " prompt nil offset input interned read-string "" "+" + "-" - "++" ++ "--" -- "*" * "/" / string-match "^-?[0-9]+$" string-to-int fboundp intern boundp ding] 4]) #@266 Change the value of a syntactic element symbol in `c-offsets-alist'. SYMBOL is the syntactic element symbol to change and OFFSET is the new offset for that syntactic element. Optional ADD says to add SYMBOL to `c-offsets-alist' if it doesn't already appear there. (defalias 'c-set-offset #[(symbol offset &optional add-p) "Á=„:Â=„:Ã=„:Ä=„:Å=„:Æ=„:¨„:Ç!„:È!„:ÉÊ\"ˆ \fž‰ ƒM ¡ˆ‚dƒ^ B\fB\f‚dÉÏ \"ˆ)Ð ‡" [offset + - ++ -- * / fboundp boundp error "Offset must be int, func, var, or in [+,-,++,--,*,/]: %s" symbol c-offsets-alist entry add-p "%s is not a valid syntactic symbol." c-keep-region-active] 4 (#$ . 48429) (let* ((langelem (intern (completing-read (concat "Syntactic symbol to change" (if current-prefix-arg " or add" "") ": ") (mapcar (function (lambda (langelem) (cons (format "%s" (car langelem)) nil))) c-offsets-alist) nil (not current-prefix-arg) (let* ((syntax (c-guess-basic-syntax)) (len (length syntax)) (ic (format "%s" (car (nth (1- len) syntax))))) (if (memq (quote v19) c-emacs-features) (cons ic 0) ic))))) (offset (c-read-offset langelem))) (list langelem offset current-prefix-arg))]) (defalias 'c-set-style-1 #[(stylevars) "ÀÁ\n\"‡" [mapcar #[(conscell) "@A‰Ã=„\n L‚ÄÅ \"*‡" [conscell val attr c-offsets-alist mapcar #[(langentry) "@AÃ\n \"*‡" [langentry offset langelem c-set-offset] 3]] 4] stylevars] 3]) #@248 Set cc-mode variables to use one of several different indentation styles. STYLENAME is a string representing the desired style from the list of styles described in the variable `c-style-alist'. See that variable for details of setting up styles. (defalias 'c-set-style #[(stylename) "À \n\"AÀÃ\n\"A‰„ÆÇ \"ˆ\f„ÆÈ!ˆÉ\f!ˆ Ø„+É !ˆ*Ê ‡" [assoc stylename c-style-alist "CC-MODE" default vars error "Invalid indentation style `%s'" "No \"CC-MODE\" style found!" c-set-style-1 c-keep-region-active] 5 (#$ . 49814) (list (let ((completion-ignore-case t) (prompt (format "Which %s indentation style? " mode-name))) (completing-read prompt c-style-alist nil t)))]) #@433 Adds a style to `c-style-alist', or updates an existing one. STYLE is a string identifying the style to add or update. DESCRIP is an association list describing the style and must be of the form: ((VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) See the variable `c-style-alist' for the semantics of VARIABLE and VALUE. This function also sets the current style to STYLE using `c-set-style' if the optional SET-P flag is non-nil. (defalias 'c-add-style #[(style descrip &optional set-p) "À \n\"‰ƒ Ä !¡ˆ‚ B\nB)…!Ç !‡" [assoc style c-style-alist s copy-alist descrip set-p c-set-style] 4 (#$ . 50484) (let ((stylename (completing-read "Style to add: " c-style-alist)) (description (eval-minibuffer "Style description: "))) (list stylename description (y-or-n-p "Set the style too? ")))]) #@300 Like \[fill-paragraph] but handles C and C++ style comments. If any of the current line is a comment or within a comment, fill the comment or the paragraph of it that point is in, preserving the comment indentation or line-starting decorations. Optional prefix ARG means justify paragraph as well. (defalias 'c-fill-paragraph #[(&optional arg) "ÀŠÂyˆÃÀwˆÄ !…`‰)È>ƒ‰ŠÂyˆÄÉ!)ƒ‰À\nËP\fËP\f\n ŠÂyˆo„KÄÎ!ƒKÏyˆ‚;ÄÉ!„TÐyˆÑÒ!ˆÂ”•{ Œ`Âyˆ`bˆ)ŠÐyˆÄ !ƒ}Ðyˆ‚p`)}ˆÔ!-‚„„¬Ö ×=„¬ŠÂyˆÑ ŠÀˆ`)Ø#`)‰ƒ€ŠÂyˆÄÙ!ƒÁÑ !ˆÚiÛ\"‚ôƒÉÐyˆÀˆiÂyˆ`ÂyˆÝ`Àˆ`bˆ)wˆ`{Þ!ˆ`Àˆ`|ˆ))\nËP\fËPÂ\f\n ŒŠ ƒ bˆ‚àá!ˆi\"`\"ãÛ\"\"ˆ*Š ƒ/ ä\\bˆåæÀç#ˆÐyˆ`)}ˆÔ!ˆŠebˆÂVƒS``\\|ˆdbˆÏyˆåæÀç#ˆÂyˆ(…{Äé!…{*ë\\*Ïyˆì`d\").‚„Ô!*‡" [nil comment-start-place 0 " \n" looking-at comment-start-skip first-line major-mode (c++-mode objc-mode) ".*//" paragraph-start "\\|[ ]*/\\*[ ]*$\\|[ ]*\\*/[ ]*$\\|[ /*]*$" paragraph-separate fill-prefix "[ ]*//" -1 1 re-search-forward "[ ]*//[ ]*" here fill-paragraph arg c-in-literal c t "[ ]*/\\*.*\\*/" make-string 32 line-width " *" move-to-column chars-to-delete search-backward "/*" column insert-char 2 search-forward "*/" move c-hanging-comment-ender-p "[ ]*\\*/" fill-column 9999 fill-region-as-paragraph] 5 (#$ . 51289) "P"]) #@83 Move forward to end of a nomenclature section or word. With arg, to it arg times. (defalias 'c-forward-into-nomenclature #[(&optional arg) "À\nÃVƒÄÅdÆ\n$ˆ‚*\nÃWƒ*ÇÈeÃ#ƒ*Éuˆ\nT‰‚)Ê ‡" [nil case-fold-search arg 0 re-search-forward "\\W*\\([A-Z]*[a-z0-9]*\\)" t re-search-backward "\\(\\(\\W\\|[a-z0-9]\\)[A-Z]+\\|\\W\\w+\\)" 1 c-keep-region-active] 6 (#$ . 52600) "p"]) #@139 Move backward to beginning of a nomenclature section or word. With optional ARG, move that many times. If ARG is negative, move forward. (defalias 'c-backward-into-nomenclature #[(&optional arg) "À [!ˆÂ ‡" [c-forward-into-nomenclature arg c-keep-region-active] 2 (#$ . 52984) "p"]) #@106 Insert a double colon scope operator at point. No indentation or other "electric" behavior is performed. (defalias 'c-scope-operator #[nil "Àc‡" ["::"] 1 (#$ . 53274) nil]) #@523 Go to the beginning of the innermost C statement. With prefix arg, go back N - 1 statements. If already at the beginning of a statement then go to the beginning of the preceding one. If within a string or comment, or next to a comment (only whitespace between), move by sentences instead of statements. When called from a program, this function takes 2 optional args: the repetition count, a buffer position limit which is the farthest back to search, and a flag saying whether to do sentence motion when in a comment. (defalias 'c-beginning-of-statement #[(&optional count lim sentence-flag) "`†Á\n†*`Ä ˆÅÆ!ƒ%ƒ%Ç!ƒ%È•bˆ` bˆ)É\nŠ\nbˆË` ɉ$\n)\fƒrÍ\n8„jÎ\n8„jÇÏP!„jŠÑÉxˆ`ÒZbˆÇÓ!)ƒrÔ[!ˆ‚“ÈVƒƒÕ\n!ˆS‰‚sÈWƒ“Ö ˆT‰‚„`\n]bˆ,× ‡" [count 1 lim here beginning-of-defun boundp defun-prompt-regexp looking-at 0 nil state parse-partial-sexp sentence-flag 3 4 "[ ]*" comment-start-skip " " 2 "\\*/" forward-sentence c-beginning-of-statement-1 c-end-of-statement-1 c-keep-region-active] 6 (#$ . 53454) (list (prefix-numeric-value current-prefix-arg) nil t)]) #@444 Go to the end of the innermost C statement. With prefix arg, go forward N - 1 statements. Move forward to end of the next statement if already at end. If within a string or comment, move by sentences instead of statements. When called from a program, this function takes 2 optional args: the repetition count, a buffer position limit which is the farthest back to search, and a flag saying whether to do sentence motion when in a comment. (defalias 'c-end-of-statement #[(&optional count lim sentence-flag) "À †Â[ \f#ˆÅ ‡" [c-beginning-of-statement count 1 lim sentence-flag c-keep-region-active] 4 (#$ . 54549) (list (prefix-numeric-value current-prefix-arg) nil t)]) (defalias 'c-beginning-of-statement-1 #[(&optional lim) "À‰Á‰‰` „‰oƒÀ‰‚ÁÈÉ„Lƒ/ÊË!ˆ‚2\nbˆŠÌ !ˆÎÁxˆhÏUƒD`)\nbˆ`ÀÁ „Ð !Ñ=ƒaÒyˆ‚Ð !„Ó!„ÅgÏUƒŠÕË!ˆÖ ˆg×U)„`Ì !ˆØvˆ …² `X…²Ð !?…²ŠÁÙÚƒ°gÏU?‚±À)„¿bˆ*ƒŠ?…ÞÁÝÞ…ÞÓß!…ÞÐ !?)ƒëÕØ!ˆà !ˆ„ûÓá!ƒûà !ˆÓâ!ƒ ã !ƒ Á`‰‚Ó$!„ƒ/Áå`\n\"?`‚å`\n\"ƒ<À‰‚ ƒp&ƒLÓ&!„`ÒyˆÖ ˆÓ'!ƒ`À‚ebˆÁ)„Ó$!„(é=ƒ„ê ‰ƒ„À‰‚`‚\nbˆë`ì ˆ`bˆ)x.‡" [t nil last-begin maybe-labelp c-in-literal-cache donep substmt-p firstp (byte-code "ÀÁ!ˆÂ‡" [backward-sexp 1 t] 2) ((error)) backward-up-list 1 c-backward-syntactic-ws lim "-+!*&:.~ \n" 40 c-in-literal pound 0 looking-at c-conditional-key forward-sexp c-forward-syntactic-ws 59 -1 (byte-code "ÀÁ!ˆÂ‡" [backward-up-list 1 t] 2) ((error)) foundp here (byte-code "ÀÁ!ˆÂ‡" [forward-sexp -1 t] 2) ((error)) "\\[ \n]+\\" c-backward-to-start-of-if "\\[^_]" "\\[^_]" c-backward-to-start-of-do c-label-key c-crosses-statement-barrier-p c-access-key c-switch-label-key major-mode objc-mode c-in-objc-method-def-p "-+!*&:.~" back-to-indentation] 7]) (defalias 'c-end-of-statement-1 #[nil "ÀÁ‡" [nil (byte-code "m„`ÁÂ!ˆ`ŠbˆÄÅ Æ#+ƒÇÈ!ˆÂu‡" [beg forward-sexp 1 end re-search-forward "[;{}]" t re-search-backward "[;}]"] 4) ((error (byte-code "`ÁÂ!ˆ`bˆÄÅ Æ#*‡" [beg backward-up-list -1 end search-forward ";" move] 4)))] 3]) (defalias 'c-crosses-statement-barrier-p #[(from to) "`ÁÁÅƈ\fbˆ\n+‡" [from nil crossedp lim here (byte-code "bˆ „9`\nWƒ9Ã\nwˆÄ !„3gÆ>ƒ\"Ç‚.gÈUƒ+Ç Êuˆ`‚Êuˆ‚ć" [from crossedp to "^;{}:" c-in-literal lim (59 123 125) t 58 maybe-labelp 1] 2) ((error (byte-code "ÀÀ‡" [nil crossedp] 1)))] 3]) #@328 Move back to the containing preprocessor conditional, leaving mark behind. A prefix argument acts as a repeat count. With a negative argument, move forward to the end of the containing preprocessor conditional. When going backwards, `#elif' is treated like `#else' followed by `#if'. When going forwards, `#elif' is ignored. (defalias 'c-up-conditional #[(count) "À [Â\"ˆÃ ‡" [c-forward-conditional count t c-keep-region-active] 3 (#$ . 56976) "p"]) #@184 Move back across a preprocessor conditional, leaving mark behind. A prefix argument acts as a repeat count. With a negative argument, move forward across a preprocessor conditional. (defalias 'c-backward-conditional #[(count &optional up-flag) "À [\n\"ˆÃ ‡" [c-forward-conditional count up-flag c-keep-region-active] 3 (#$ . 57435) "p"]) #@188 Move forward across a preprocessor conditional, leaving mark behind. A prefix argument acts as a repeat count. With a negative argument, move backward across a preprocessor conditional. (defalias 'c-forward-conditional #[(count &optional up-flag) "ÁV‰ƒ\f Ä\nƒÆ‚ÇÉ\nŠÁU„Ñ ƒ,Á‚-ÃÉ\f Š\f„·ÎÉÏ#ƒ·ÁyˆÐÑ!ƒ­ ÁyˆÐÓ!ƒ` \\ ‚}ÐÔ!ƒw\nƒ} ÁUƒ}`\f‚} Z ÁWƒ˜ Wƒ˜Õ\nƒ•Ö‚–×!ˆ\nƒŸÄyˆ ÁWƒ©`\f)‚3\nƒ3Äyˆ‚3)\f„ÁÕØ!ˆ\f‰\nbˆ* \\‰‚)Ù ˆ\nbˆ,Ú ‡" [count 0 forward -1 1 increment re-search-forward re-search-backward search-function nil new up-flag found depth "#[ ]*\\(if\\|elif\\|endif\\)" t looking-at "^[ ]*#[ ]*\\(if\\|elif\\|endif\\)" prev "[ ]*#[ ]*endif" "[ ]*#[ ]*elif" error "No following conditional at this level" "No previous conditional at this level" "No containing preprocessor conditional" push-mark c-keep-region-active] 5 (#$ . 57781) "p"]) #@663 Indent current line as C++ code, or in some cases insert a tab character. If `c-tab-always-indent' is t, always just indent the current line. If nil, indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. If other than nil or t, then tab is inserted only within literals (comments and strings) and inside preprocessor directives, but line is always reindented. A numeric argument, regardless of its value, means indent rigidly all the lines of the expression starting after point so that this line becomes properly indented. The relative indentation among the lines of the expression are preserved. (defalias 'c-indent-command #[(&optional whole-exp) "`Á ˆÂÃ!ƒ ƒÄ !ƒÅ•bˆ`bˆ)ƒeÈ É‰\n \fŠ Î=ƒ:Åyˆ` ÏÐ!ˆ`\n bˆÐyˆ` )\n V…aÑ \n\f[Ò$+‚– „~ŠÓÉxˆn)„yÔ ‚–È ‚– Î=ƒŠÈ ‚–Õ!ƒ”Ô ˆÈ )‡" [here beginning-of-defun boundp defun-prompt-regexp looking-at 0 bod whole-exp c-indent-line nil end beg shift-amt c-tab-always-indent t forward-sexp 1 indent-code-rigidly "#" " " insert-tab c-in-literal] 5 (#$ . 58696) "P"]) #@134 Indent each line in balanced expression following point. Optional SHUTUP-P if non-nil, inhibits message printing and error checking. (defalias 'c-indent-exp #[(&optional shutup-p) "`À‰ÄŽÀÅÀwˆgÆ>ƒ`‚<Ç``Àˆ` bˆ)\"‰A@…;A@b…;gÉ>…;`)\n ÀÌÍ…IÎ \n„X„XÐÑ!ˆ\n„e„eÐÒ!ˆÓ\n\nÔ#ˆÕ\nbˆÖyˆ`\nW…×Ø!„„Ù ˆÚ ˆÛyˆ‚u.‡" [nil progress-p end here ((byte-code "ƒ Á‰“ˆ\nƒÃÄ!ˆ b‡" [end nil progress-p c-progress-fini c-indent-exp here] 3)) " \n" (40 91 123) parse-partial-sexp state (40 91 123) start c-echo-syntactic-information-p (byte-code "ÀÁ!ˆÂ‡" [forward-sexp 1 t] 2) ((error)) point-marker shutup-p error "Cannot find start of balanced expression to indent." "Cannot find end of balanced expression to indent." c-progress-init c-indent-exp t 0 looking-at "[ ]*$" c-indent-line c-progress-update 1] 6 (#$ . 59805) "P"]) #@77 Re-indents the current top-level function def, struct or class declaration. (defalias 'c-indent-defun #[nil "À ÁÂà !\fƒ\fbˆ‚Ç ˆoƒ&gÈU„&bˆÉÊ!ƒ<\nƒ<Ë\n!ƒ<Ì•bˆÍŽÎ ,‡" [point-marker nil c-least-enclosing-brace c-parse-state brace c-echo-syntactic-information-p here beginning-of-defun 123 boundp defun-prompt-regexp looking-at 0 ((byte-code "bˆÁ‰“‡" [here nil] 3)) c-indent-exp] 4 (#$ . 60654) nil]) (defalias 'c-indent-region #[(start end) "ŠbˆÁÂwˆÃyˆÂÅŽÆÂÉ\nË#ˆÌ\n!n…Ím?…Í`\fW…ÍÍ ˆÂ‰‰ÁÂwˆÃyˆÑ ˆŠÃyˆÒÓ!)ƒWÔyˆ‚ÉŠ`Ôyˆ`bˆ)Ãyˆ`Wƒ{ÂÖ×ˆØ ˆ‚iƒbˆÙ ÂÚÛˆ`)ŠÔyˆÜÂwˆÒ!ƒ®`Ãyˆ`bˆ))ÂÞ߈ƒÆà!ƒÆ‰“ˆÔyˆ+‚!-‡" [start " \n" nil 0 endmark ((byte-code "Á‰“ˆÂÃ!‡" [endmark nil c-progress-fini c-indent-region] 3)) t c-echo-syntactic-information-p c-tab-always-indent c-progress-init end c-indent-region copy-marker c-progress-update sexpbeg sexpend nextline c-indent-line looking-at "[ ]*#" 1 here (byte-code "ÀÁ!ˆ`À‡" [forward-sexp 1 sexpend] 2) ((error (byte-code "À\nb‡" [nil sexpend nextline] 1))) c-forward-syntactic-ws point-marker (backward-sexp 1) ((error)) " " c-comment-start-regexp (byte-code "ƒ Vƒ\nXƒ bˆÄÅ!ˆÆ ˆbˆÄ‡" [sexpend nextline endmark sexpbeg c-indent-exp shutup c-progress-update] 2) ((error (byte-code "bˆÁ ‡" [sexpbeg c-indent-line] 1))) markerp] 4]) #@72 Put mark at end of a C, C++, or Objective-C defun, point at beginning. (defalias 'c-mark-function #[nil "`ŠÀ ˆ`)Á Â\fƒ,\f@‰:ƒ\" Abˆ‚% bˆ\fA‰„gÇUƒEÈyˆo„LÉÊ!„LÈyˆ‚5ËyˆÌÂwˆÍ!ˆÍ ÂÎ#,‡" [end-of-defun c-parse-state nil brace state eod here 123 -1 looking-at "[ ]*$" 1 " \n" push-mark t] 5 (#$ . 62006) nil]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp c-progress-info nil current-load-list] 2) (defalias 'c-progress-init #[(start end context) "ÀÁ!„\nÂÃ!‡\f?…%ÅŠbˆÈ )Á A@ $ÂÊ!‡" [fboundp current-time message "indenting region... (this may take a while)" c-progress-info vector start end point-marker context "indenting region..."] 5]) (defalias 'c-progress-update #[nil "…= …= A@ÃHÄHÅH  ZW…<ÊË`ZÌ_Z¥\"ˆÅ I,‡" [c-progress-info c-progress-interval current-time 0 1 2 lastsecs end start now message "indenting region... (%d%% complete)" 100] 5]) (defalias 'c-progress-fini #[(context) " ÂH=„Ã=… ÄHʼn“ˆÅÆÇ!‡" [context c-progress-info 3 t 1 nil message "indenting region... done."] 3]) (defalias 'c-forward-syntactic-ws #[(&optional lim) "Œ†d‰d`}ˆ `U?…7`Ã\n!ˆgÄUƒ`Å ˆ` bˆ)`UƒÆˆ‚,‡" [lim here hugenum forward-comment 35 back-to-indentation nil] 3]) (defalias 'c-backward-syntactic-ws #[(&optional lim) "Œ†#` ˆÃÄ!ƒ\fƒÅ\f!ƒÆ•bˆ` bˆ)‰d[`W…P`}ˆ `U?…P`È!ˆÉ!Ê=ƒ4Æyˆ‚4,‡" [lim here beginning-of-defun boundp defun-prompt-regexp looking-at 0 hugenum forward-comment c-in-literal pound] 3]) (defalias 'c-in-literal #[(&optional lim) "ÀÁ!ƒ ƒ` ÂHUƒ ÃH‡Š\f†;`Æ ˆÀÇ!ƒ6ƒ6È!ƒ6•bˆ` bˆ)`É\f`\"\nË\n8ƒOÌ‚vÍ\n8ƒeÎ\n8ƒaÏ‚vЂv bˆÂyˆÈÑ!ƒuÒ‚vÓ,ÀÁ!ƒ…Õ`\")‡" [boundp c-in-literal-cache 0 1 lim here beginning-of-defun defun-prompt-regexp looking-at parse-partial-sexp state 3 string 4 7 c++ c "[ ]*#" pound nil rtn vector] 3]) (defalias 'c-parse-state #[nil "ÀÁ!ƒ ‡ÂŠÄ „- ÆU„-Ç ˆgÈUƒ# Soƒ ɉƒ)`)\nŠ`) \n\f\n ÂÂÂÑÒ„H.‡" [boundp c-state-cache nil at-bob 2 cnt 0 beginning-of-defun 123 t pos here last-bod last-pos placeholder state sexp-end backup-bod (byte-code "À\nƒ¨\n Wƒ¨\nÀÅƉƒX\n XƒXÀÇȉ ƒP XƒP\nSfÊUƒI\nS B @:ƒF A‚G B ‰‚\nS B‚\n„ „ÀÌ͉ƒ XƒSfÏUƒÀÐщ„ÓÔS\"ˆ‚{eU fÊUƒ{ÕÖ×\"ˆ‚{À‡" [nil state pos here last-pos (scan-lists pos 1 -1) ((error)) (byte-code "À SÂ\"‡" [scan-sexps pos 1] 3) ((error)) sexp-end 123 at-bob (byte-code "À ‰#‡" [scan-lists last-pos 1] 4) ((error)) placeholder 125 (scan-lists last-bod -1 1) ((error)) last-bod error "unbalanced close brace at position %d" throw backup-bod t] 4)] 3]) (defalias 'c-whack-state #[(bufpos state) "À‰ ƒK @ A :ƒ8\f @X„\f AXƒ+Å\n @C\"‚Å\n C #À‰‚\f X„Å\n C #À‰„\n*‡" [nil car newstate state bufpos append] 5]) (defalias 'c-hack-state #[(bufpos which state) "Á=ƒ!\n@‰ƒ :„\f U„\f\nB‚\n)‡Å=„,ÆÇ\"ˆ\n@\nA‰:ƒA@A :ƒJ\n‚] \fB@:ƒZA‚\\B*‡" [which open state car bufpos close error "c-hack-state, bad argument: %s" cdr] 4]) (defalias 'c-adjust-state #[(from to shift state) "ÀÁ\n\"‡" [mapcar #[(e) ":ƒ3@A \nXƒ\n\fWƒ \n\\ ˆ Xƒ/ \fWƒ/ \\¡ˆ*‚C XƒC\fWƒC \\‡" [e cdr car from to shift] 3] state] 3]) (defalias 'c-beginning-of-inheritance-list #[(&optional lim) "†\"` ˆÃÄ!ƒ\fƒÅ\f!ƒÆ•bˆ` bˆ)Ç ˆ`É!ˆ`VƒQhÊ>ƒQÆyˆ`ËÌwˆÅ !„QÉ!ˆ‚-bˆÎ`̈` bˆ)w*‡" [lim here beginning-of-defun boundp defun-prompt-regexp looking-at 0 back-to-indentation placeholder c-backward-syntactic-ws (44 58) " " nil c-class-key "^:"] 3]) (defalias 'c-beginning-of-macro #[(&optional lim) "À ‡" [back-to-indentation] 1]) (defalias 'c-in-objc-method-def-p #[nil "ŠÀyˆÁ\n!… `)‡" [0 looking-at c-ObjC-method-key] 2]) (defalias 'c-just-after-func-arglist-p #[(&optional containing) "ŠÀ ˆ † `‰bˆhÃUƒ$Ävƒ$ÅÆ!ƒ$À ˆ‚<\nbˆhÇUƒ9ÄuˆÀ ˆÅÈ!„<\nbˆhÉU…i\nË=?†iÌÄ!ˆÄuˆÀ ˆhÍU†hhÎU†hÌÏ!ˆÅ!?*‡" [c-backward-syntactic-ws containing checkpoint 116 -1 looking-at "\\" 58 "[ \n]*:\\([^:]+\\|$\\)" 41 major-mode objc-mode forward-sexp 45 43 -2 c-class-key] 3]) (defalias 'c-backward-to-start-of-do #[(&optional lim) "ÀÁ\n†&`Ä ˆÅÆ!ƒ!ƒ!Ç!ƒ!È•bˆ` bˆ)`Á \n  ÈU„?ÁÌ͈‚0 „G bˆ -‡" [1 nil lim here beginning-of-defun boundp defun-prompt-regexp looking-at 0 foundp case-fold-search do-level (byte-code "ÀÁ!ˆÂ !Ä>„=ÅÆ!ƒT‚=ÅÈ!ƒ1S‰ÉUƒ=Ê ‚=` Wƒ=É bˆÀ‡" [backward-sexp 1 c-in-literal lim (c c++) looking-at "while\\b[^_]" do-level "do\\b[^_]" 0 t foundp] 2) ((error (byte-code "bˆÁÁ‡" [lim 0 do-level] 1)))] 5]) (defalias 'c-backward-to-start-of-if #[(&optional lim) "À`Âyˆ` bˆ)Ã\f†0`Å ˆÆÇ!ƒ+ƒ+È!ƒ+•bˆ` bˆ)ÈÉ!\n \fÍÎ-‡" [1 here 0 nil lim beginning-of-defun boundp defun-prompt-regexp looking-at "if\\b[^_]" at-if case-fold-search if-level orphan-if (byte-code "o„MÁU„M ˆÃÄňÆÇ!ƒT‚ÆÈ!ƒ=` ÃÊˈÆÌ!„9S bˆ)‚` WƒÁ bˆ‚·" [if-level 0 c-backward-syntactic-ws nil (backward-sexp 1) ((error (byte-code "ƒ\fÁÂÃ\"ˆ‚ÄÅÆÇ\"T\"ˆÃ‡" [at-if throw orphan-if nil error "No matching `if' found for `else' on line %d." count-lines 1 here] 5))) looking-at "else\\b[^_]" "if\\b[^_]" here (forward-sexp -1) ((error)) "\\[ ]+\\" lim t] 3)] 6]) (defalias 'c-skip-conditional #[nil "ÀÁÂ!ƒ ÂÁÄ!ƒÅ‚Æ!‡" [forward-sexp looking-at "\\[ ]+\\" 3 "\\<\\(do\\|else\\)\\>" 1 2] 3]) (defalias 'c-skip-case-statement-forward #[(state &optional lim) "†d`Á‰‰`\n@`Wƒf„f`É\nË#ƒÌ”‰ƒÍ\f!„ U„ :ƒZ @VƒZ AWƒZ Abˆ‚ bˆÎ΂„obˆ.‡" [lim nil state balanced safepos bufpos foundp donep here re-search-forward c-switch-label-key move 0 c-in-literal t] 7]) (defalias 'c-search-uplist-for-classkey #[(brace-state) "…þ@Á‰‰:ƒÅ8A@‚\"A@@\n:ƒ,ÆÇ\n\"ˆ\n?†<\neW†<\nfÈU??…ý „Ie‚Q :ƒQ AŠŒ bˆÁ‰‰ \n  „úÌ ˆ\n`VƒúÍ\nÏ#ƒúД\nЕ Ñ !„_\nbˆÒÁwˆÓ`Õ ˆ`bˆ)\n\" \nSf‰…¬z×>)ƒ» bˆÁ‰ ‚aÙ=ƒÒÍ\nÏ#ƒÒÁ‰ ‚aÛŠÝ xˆhÞUƒæßP)\nwˆ`\nU)„_Á‰ ƒd -+‡" [brace-state nil search-end search-start carcache 2 error "consp search-end: %s" 123 match-end class foundp c-forward-syntactic-ws re-search-forward c-class-key t 0 c-in-literal " \n" vector here back-to-indentation char (119 95) major-mode objc-mode c-ObjC-method-key "^;=)" skipchars "^<>" 60 ">"] 5]) (defalias 'c-inside-bracelist-p #[(containing-sexp brace-state) "ÀÁ†TŠÀ‰\f„R ƒR :ƒ%@A‚\f bˆÀÀÇȈ „9gÉU„E@A‚\fÊË!!ˆ`‰ƒ\f+‡" [nil (byte-code "ŠbˆÁÂ!ˆÃÄ!„ÁÂ!ˆÃÄ!…`)‡" [containing-sexp forward-sexp -1 looking-at "enum[ \n ]+"] 2) ((error)) failedp bufpos containing-sexp brace-state (byte-code "ÀÁ!ˆÀÂ!ˆÃ\f!‡" [forward-sexp -1 1 c-forward-syntactic-ws containing-sexp] 2) ((error (byte-code "ÀÀ‡" [t failedp] 1))) 61 c-beginning-of-statement-1 c-most-enclosing-brace] 4]) (defalias 'c-add-syntax '(macro . #[(symbol &optional relpos) "ÀÁ‰ \fEÅBBE‡" [setq syntax cons symbol relpos (syntax)] 6])) (defalias 'c-most-enclosing-brace #[(state) "À\nƒ( „(\n@\nA :ƒÀ‚e Vƒ\"ÀÀ‰„ )‡" [nil enclosingp state] 3]) (defalias 'c-least-enclosing-brace #[(state) "À Ÿ!‡" [c-most-enclosing-brace state] 2]) (defalias 'c-safe-position #[(bufpos state) "À\nƒ(\n@:ƒ\n@A‚\n@‰ Wƒ!À‰‚\nA‰„ )‡" [nil safepos state bufpos] 3]) (defalias 'c-narrow-out-enclosing-class #[(state lim) "À\nƒ?Ã\n!‰ƒ? ÄHTbˆÅwˆ` ÄHXƒ, ÄHTbˆÇ!ˆ`bˆ`Àˆ`bˆ)}ˆ )‡" [nil inclass-p state c-search-uplist-for-classkey 1 " \n" lim c-forward-syntactic-ws here] 3]) (defalias 'c-guess-basic-syntax #[nil "ŠŒÀyˆ`ÂÄ ‰È=…É\n! Â\f ÂÂÂÂÂÂÂÕ \"Š bˆ×ÂwˆØÂxˆƒŒ „Œ „Œ@ A :ƒ A`Uƒy @ ‚J ‚J eXƒJ ‚J) †Ÿ @:ƒž @A†Ÿe bˆØÂwˆgÙ!ˆh bˆØÂwˆÚ!‰\fÛ>ƒÜÜ`Þyˆ`bˆ)BB‚j \fß>ƒÞyÀUƒðÉà!„ã\f`Àyˆ`bˆ)BB‚j \fá=ƒ)â!ˆã`ä ˆ`bˆ)BB‚j  ƒDå`ä ˆ`bˆ)BB‚j  „!æUƒøŠ bˆçÂwˆèé!ƒr)*ëé!ˆìÄ !*))‚vìÄ !‰-…ƒ-ÀH‰*ƒ“îBB‚j Šï!ˆoƒ¡ð !ˆ`Éñ!„±òU…»Šó wˆgôU)?)ƒËõBB‚j ƒÞöÀHBB‚j bˆ÷`Àyˆ`bˆ)BB‚j ø ƒŸùU„ ùUƒHùUƒÞuˆÙ!ˆhùUƒ(ÞuˆÙ!ˆhúUƒ2ûü!ˆý`ä ˆ`bˆ)BB‚j >ƒuÿ`ä ˆ`bˆ)BBƒj @ÀHBB‚j A`ä ˆ`bˆ)BBƒj @ÀHBB‚j Bƒ«ÉB!„ÙùU„¹ùUƒBŠÙ!ˆùUƒÎÞuˆÙ!ˆä ˆÉC!)ƒBùUƒýÙ!ˆD`ä ˆ`bˆ)BB‚j ùUƒ.D`ä ˆ`bˆ)BBƒj @ÀHBB‚j E!ˆF`BB‚j GUƒ^ bˆÙ!ˆ`Wƒ‰hGUƒ‰ÞuˆÙ`Àyˆ`bˆ)!ˆhúUƒ~ûü!ˆÀyˆÙ!ˆ‚ShùUƒÄŠÞvˆÉH!)„Ä bˆÙ!ˆÂIJˆK`ä ˆ`bˆ)BB‚j ð !ˆgùUƒáLÂwˆK`BB‚j ÉM!ƒF`ä ˆ`bˆ)BB‚j ŠNxˆhOU…Ú!?)ƒ&P`BB‚j ï!ˆƒBHƒBÉH!ƒBüyˆ‚5ð !ˆQ`ä ˆ`bˆ)BB‚j ƒ”Hƒ”ÉH!ƒ”R`üyˆ`bˆ)BB@ÀHBB‚j ƒàSUƒàŠŒ~ˆüuˆÂTU…º`üHU*ƒàŒ~ˆÀHbˆV`ä ˆ`bˆ)BB)‚j >ƒeŠÙ!ˆhW>ƒÀyˆ`Ù!ˆ‚ëhúU…8È=?†8XÞ!ˆÞuˆÙ ˆhYU†7hZU†7X[!ˆÉC!?)ƒeŠï ˆÉ\\!)„ebˆ]`ä ˆ`bˆ)BB‚j Ù!ˆƒ–Hƒ–o„–ŠÂ^_ˆÉH!)ƒ–ûü!ˆÙ!ˆ‚jo„¢h`>ƒÞŒ~ˆa`Àyˆ`bˆ)BBƒÚüHbˆ@`ä ˆ`bˆ)BB)‚j È=ƒï!ˆÀyˆÉ\n!ƒb`BB‚j ï!ˆð ˆc`ä ˆ`bˆ)BB‚j  fæU„ªÙ !ˆGU„‚d>ƒ‚È=ƒf SbˆÙ!ˆÉe!„fQ BB‚j  bˆf`ä ˆ`bˆ)BB‚j g>ƒ§ bˆh`ä ˆ`bˆ)BB‚j Š bˆÂij…¼Ék!)ƒï Tbˆð !ˆï !ˆôUƒâl`BB‚j Q`BB‚j È=ƒG fmUƒGŠ SbˆÙ`n ˆèo!ƒ'oƒ'Éo!ƒ'À•bˆ`bˆ)!ˆÉe!?…Cp BB‰)„j Š TbˆØÂwˆl)„†Šï!ˆqÂxˆ` X)ƒ† bˆr`ä ˆ`bˆ)BB‚j ï !ˆüuˆð !ˆP`ä ˆ`bˆ)BB‚j BƒŠ bˆØÂwˆÉB!)ƒ bˆØÂwˆùUƒêÙ!ˆD`ä ˆ`bˆ)BB‚j ùUƒ D`ä ˆ`bˆ)BB‚j E!ˆF`BB‚j s \"‰ƒ´SUƒ^Âtuƒ^` Uƒ^v`ä ˆ`bˆ)BB‚j Š bˆÙ !ˆ` TU)ƒŒ bˆw`ä ˆ`bˆ)BB‚j  Tbˆð !ˆæUƒ§õ`BB‚j x`BB‚j y>„J\n`Šï !ˆ`‰)VƒJ\n U„J\n bˆØÂwˆŠbˆÉz!… Â{|ˆð ˆg}>ƒ üuˆð ˆ`)‰~ƒL ~ YƒL bˆæUƒ4 `ä ˆ`bˆ)BB‚F\n€`ä ˆ`bˆ)BB‚F\næUƒÃ Š bˆçÂwˆìÄ !‰-…l -ÀH‰*ƒ| îBB‚F\nŠbˆÉ!)„‘ òUƒ õBB‚F\nbˆQ`ä ˆ`bˆ)BB‚ÂBB‚F\nɃ!ƒ(\nbˆ~ƒØ ~bˆ„ƒ …#ƒí Ú!„Ø ` U„ \n†`ä ˆ`bˆ)BB‚F\nÙ!ˆQ`ä ˆ`bˆ)BB‚F\nï~!ˆ~ƒ9\n~`]†:\n`bˆQ`BB)‚j ɇ!ƒq\nˆ !ˆ‰`ä ˆ`bˆ)BB‚j bˆØÂwˆÉŠ!ƒ¢\nŠ‹ !ˆ`ÉŒ!)ƒ¢\nBB‚j ÉŽ!ƒÜ\n bˆ``ä ˆ`bˆ)U„Ä\nXÞ!ˆ`ä ˆ`bˆ)BB‚j É!ƒÿ\n bˆ‘`ä ˆ`bˆ)BB‚j SUƒ™ ’ \"Š bˆ``ä ˆ`bˆ)U„, ï!ˆ`ä ˆ`bˆ*“ bˆì!ƒS ”“BB‚• •!ƒj –“BB‚• Œe }ˆìÄ !‰-ƒ‰ V-ÀHBB‚” —“BB**‚j  bˆüuˆð !ˆ˜ \"„¹ ÉŽ!ƒÁ „Á ™‚¤ É!ƒÕ À•bƒÕ ð !ˆ‚Á ƒ\f bˆÙ !ˆä ˆ`ÉŽ!ƒ\f bˆØÂwˆgæUƒ\n\fšBB‚j ›BB‚j GUƒ9\fQ`ä ˆ`bˆ)BB‚j œ>ƒV\fŠ bˆÙ!ˆä ˆÉ!)ƒp\f>ƒˆ\fŠ bˆØÂwˆÉž!)„ˆ\fQ`ä ˆ`bˆ)BB‚j ` WƒÇ\f• !Ÿ bˆïŸ!ˆl`ä ˆ`bˆ)BBæUƒÃ\f‚ÂBB)‚j ŠŒ~ˆ bˆÕ \"ˆ•!*„  bˆ``ä ˆ`bˆ)U„ Ù ˆÂ ¡ˆ¢`ä ˆ`bˆ)BB‚j  bˆ``ä ˆ`bˆ)U„D ï`Uƒ@ ’`\"‚B !ˆ£`ä ˆ`bˆ)BBæUƒj ‚ÂBB bˆØÂwˆÉ¤!ƒ‚ ¥ÂBB¦=ƒœ ɧ!ƒœ ¨ÂBB.‡" [0 indent-point nil case-fold-search c-parse-state fullstate state major-mode objc-mode looking-at c-ObjC-method-key in-method-intro-p literal containing-sexp char-before-ip char-after-ip lim syntax placeholder c-in-literal-cache inswitch-p c-narrow-out-enclosing-class inclass-p " }" " " c-backward-syntactic-ws c-in-literal (string) string here -1 (c c++) "^[ ]*$" pound c-beginning-of-macro cpp-macro back-to-indentation objc-method-intro 123 " {" boundp c-state-cache old-cache makunbound c-search-uplist-for-classkey decl class-open c-beginning-of-statement-1 c-forward-syntactic-ws "enum[ \n]+" 61 "^;" 59 brace-list-open inline-open defun-open c-just-after-func-arglist-p 58 41 backward-sexp 1 member-init-intro c-recognize-knr-p knr-argdecl-intro inclass ansi-funcdecl-cont c-baseclass-key c-class-key inher-intro c-beginning-of-inheritance-list inher-cont 44 c-access-key (backward-sexp 1) ((error)) member-init-cont " :" c-inher-key "^<" 60 arglist-cont statement-cont access-label 125 (byte-code "ÀÁ!ˆÂ‡" [backward-sexp 1 t] 2) ((error)) class-close (59 44) forward-sexp 45 43 -2 "typedef[ \n]+" knr-argdecl (backward-sexp 1) ((error)) (59 125) topmost-intro objc-method-args-cont topmost-intro-cont (41 93) c-symbol-key arglist-close (40 91) arglist-intro (byte-code "ÀÁ!ˆÂ‡" [forward-sexp -1 t] 2) ((error)) "\\" statement 91 beginning-of-defun defun-prompt-regexp objc-method-call-cont " ([" arglist-cont-nonempty c-inside-bracelist-p (byte-code "ÀuˆÁÀ!ˆÂ‡" [1 backward-sexp t] 2) ((error)) brace-list-close brace-list-intro brace-list-entry (59 125 58) c-conditional-key (c-skip-conditional) ((error)) (59) after-cond-placeholder substatement-open substatement "\\" block-open "<<\\|>>" re-search-forward move stream-op "\\[^_]" c-backward-to-start-of-if else-clause "while\\b[^_]" c-backward-to-start-of-do "do\\b[^_]" do-while-closure c-switch-label-key case-label c-label-key label c-safe-position relpos inline-close c-most-enclosing-brace block-close defun-close c-skip-case-statement-forward t statement-case-open statement-case-intro (58 63) (58 63) "::" safepos (byte-code "ÀhÁUƒ ‚\fÃ!‡" [forward-sexp 41 -1 -2] 3) ((error)) defun-block-intro statement-block-intro c-comment-start-regexp comment-intro c++-mode c-C++-friend-key friend] 5]) (defalias 'c-get-offset #[(langelem) "@A ž‰£\f„%ƒÇÈ \"ˆ‚“ÉÉ‚“ Ê=ƒ1 ‚“ Ì=ƒ> [‚“ Í=ƒL ‰\\‚“ Î=ƒ[ [Ï_‚“ Ð=ƒi Ï¥‚“ Ñ=ƒx [Ï¥‚“ §„ŠÒ !ƒŠ !‚“ §„“Ó !\nƒ±\n`Éyˆ`bˆ)Wƒ±Š\nbˆi)‚²É \\,‡" [langelem symbol relpos c-offsets-alist match offset c-strict-syntax-p error "don't know how to indent a %s" 0 + c-basic-offset - ++ -- 2 * / fboundp eval here] 4]) (defalias 'c-indent-line #[(&optional syntax) "†Á d`ZÄÅÆÇ\n\"\"É Z\n ƒ'ÌÍ\n#ˆ\nÎU„O`Îyˆ`bˆ)`Ð ˆ`bˆ)|ˆÎyˆjˆ``Ð ˆ`bˆ)WƒfÐ ˆ‚sd Z`Vƒsd ZbˆÑÒ!ˆ\n,‡" [syntax c-guess-basic-syntax c-syntactic-context pos apply + mapcar c-get-offset indent current-indentation shift-amt c-echo-syntactic-information-p message "syntax: %s, indent= %d" 0 here back-to-indentation run-hooks c-special-indent-hook] 5]) #@46 Show syntactic information for current line. (defalias 'c-show-syntactic-information #[nil "ÀÁ \"ˆÃ ‡" [message "syntactic analysis: %s" c-guess-basic-syntax c-keep-region-active] 3 (#$ . 76196) nil]) (defalias 'c-lineup-arglist #[(langelem) "ŠŠ@Á>ƒ\"ÂyˆÃÄ!ˆÅ`Lj`bˆ)wˆ‚&Abˆ`)ŠAbˆi) ŠÂyˆÊË!)ƒS•bˆÌÍ!ˆÄuˆÎ ˆi Z‚Œbˆl„ˆgÏ>ƒˆ`Lj`bˆ)ÄuˆÅÇwˆ`Î ˆ`Wƒ‡bˆ*i Z+‡" [langelem (arglist-intro arglist-cont-nonempty) 0 backward-up-list 1 " " here nil containing-sexp cs-curcol looking-at "[ ]*)" forward-sexp -1 c-forward-syntactic-ws (123 40) eol] 3]) (defalias 'c-lineup-arglist-intro-after-paren #[(langelem) "ŠŠAbˆi)ŠÁyˆÂÃ!ˆÄ`ƈ` bˆ)wˆi)ZÉZ+‡" [langelem 0 backward-up-list 1 " " here nil ce-curcol cs-curcol -1] 4]) (defalias 'c-lineup-streamop #[(langelem) "ŠA‰bˆiÃÄ`ƈ` bˆ)Ç#ˆÈ”bˆi\nZ+‡" [langelem relpos curcol re-search-forward "<<\\|>>" here nil move 0] 5]) (defalias 'c-lineup-multi-inher #[(langelem) "ŠÀ`Àˆ` bˆ)`\fAbˆiÅ\nwˆÆ\nwˆl„)Ç!ƒ-É !ˆi Z,‡" [nil here eol cs-curcol langelem "^:" " :" looking-at c-comment-start-regexp c-forward-syntactic-ws] 3]) (defalias 'c-lineup-C-comments #[(langelem) "ŠÀyˆÁÂwˆÃÄ!ƒÀ•À”Z‚À AbˆiÈ ˆÉÊ` ˆ` bˆ)Ì#ƒ_À” ƒAÀ‚\\ÎUƒL΂\\ÏUƒWÀ‚\\À•À”Z\\bˆiZ+‡" [0 " " nil looking-at "\\*\\*?" langelem cs-curcol stars back-to-indentation re-search-forward "/\\*[ ]*" here t c-block-comments-indent-p 1 2] 4]) (defalias 'c-lineup-comment #[(langelem) "ŠÀ ˆn„ ¢† ‚ £† ¢†Â)‡" [back-to-indentation c-comment-only-line-offset -1000] 1]) (defalias 'c-lineup-runin-statements #[(langelem) "AfÁUƒŠAbˆiÃuˆÄÅwˆi\nZ*‡Æ‡" [langelem 123 curcol 1 " " nil 0] 2]) (defalias 'c-lineup-math #[(langelem) "ŠAŠ`à ˆ`\nbˆ)bˆÄ`ň`\nbˆ)wˆgÆU…0``à ˆ`\nbˆ)Z) bˆiÅ  „q``ň`\nbˆ)WƒqÄ`ň`\nbˆ)wˆÊA!ƒjËuˆ‚<̉ ƒAgÆU„| ‚’„‹ËuˆÎÅwˆÏiZZ-‡" [langelem relpos here back-to-indentation "^=" nil 61 equalp curcol donep c-in-literal 1 t c-basic-offset " " 0] 4]) (defalias 'c-lineup-ObjC-method-call #[(langelem) "ŠŠÀ ˆÁ\nA!ˆhÃUƒ\f[‚Å)\nA‰bˆiÉuˆÊ ˆËÉwˆlƒ8\f\\‚9i‰\fZZ-‡" [back-to-indentation c-backward-syntactic-ws langelem 58 c-basic-offset 0 extra open-bracket-pos open-bracket-col nil forward-sexp " " target-col] 3]) (defalias 'c-lineup-ObjC-method-args #[(langelem) "Š`Á ˆ`bˆ)‰bˆi`È`bˆ) A‰bˆÇ\fwˆgÈU….i‰ „9\n‚QbˆÇ\fwˆgÈUƒO\n iZ\\‚Q\n.‡" [here back-to-indentation curcol nil eol langelem relpos "^:" 58 first-col-column c-basic-offset] 4]) (defalias 'c-lineup-ObjC-method-args-2 #[(langelem) "Š`Á ˆ`bˆ)‰bˆi`È`bˆ) AÇxˆhÈU….iÉZ‰\n„9 ‚QbˆÇ\fwˆgÈUƒO\n\niZ\\‚Q .‡" [here back-to-indentation curcol nil eol langelem relpos "^:" 58 1 prev-col-column c-basic-offset] 4]) #@309 Dynamically calculate brace hanginess for do-while statements. Using this function, `while' clauses that end a `do-while' block will remain on the same line as the brace that closes that block. See `c-hanging-braces-alist' for how to utilize this function as an ACTION associated with `block-close' syntax. (defalias 'c-snug-do-while #[(syntax pos) "ŠÀ\nÃ=ƒ*Ã\fž‰ƒ* AbˆgÅUƒ ÀÆLjÈÉ!ƒ*Ê‚+Ë*‡" [nil langelem syntax block-close c-syntactic-context 123 (forward-sexp -1) ((error)) looking-at "\\[^_]" (before) (before after)] 3 (#$ . 78956)]) #@468 Insert, align, or delete end-of-line backslashes on the lines in the region. With no argument, inserts backslashes and aligns existing backslashes. With an argument, deletes the backslashes. This function does not modify the last line of the region if the region ends right at the start of the following line; it does not modify blank lines at the start of the region. So you can put the region around an entire macro definition and conveniently use this command. (defalias 'c-backslash-region #[(from to delete-flag) "Šbˆ   Æ“ˆ„4` Wƒ4ƈhÈUƒ)ÉuˆÊÆxˆ\fiT]Ëyˆ‚\f\f¦ÍVƒV\f\f\\É\\\f¥\f_‰Ï WƒU)bˆ` WƒilƒiËyˆ‚Y` WƒŠËyˆ` W)ƒ„†Ð\f!ˆ‚‰Ñ ˆËyˆ‚i Ɖ“+‡" [from c-backslash-column make-marker endmark column to nil delete-flag 92 -1 " " 1 tab-width 0 adjusted window-width c-append-backslash c-delete-backslash] 4 (#$ . 79516) "r\nP"]) (defalias 'c-append-backslash #[(column) "ÀˆhÁUƒÂuˆÃ ˆ\fj‡\fjˆÅc‡" [nil 92 -1 delete-horizontal-space column "\\"] 2]) (defalias 'c-delete-backslash #[nil "ÀˆÁuˆÂÃ!…`TÄÀxˆ`|‡" [nil -1 looking-at "\\\\" " "] 3]) (byte-code "ÀÁ\nQÃ\fBÇ" ["4.249" " as included in " emacs-version c-version current-load-list] 3) #@34 Address for CC mode bug reports. (defconst c-mode-help-address "cc-mode-help@merlin.cnri.reston.va.us, bug-gnu-emacs@prep.ai.mit.edu" (#$ . 80705)) #@56 Echo the current version of cc-mode in the minibuffer. (defalias 'c-version #[nil "ÀÁ\n\"ˆÃ ‡" [message "Using cc-mode version %s" c-version c-keep-region-active] 3 (#$ . 80859) nil]) #@42 Submit via mail a bug report on cc-mode. (defalias 'c-submit-bug-report #[nil "ÀÁÄÅ!„ÆÇ!ˆÈ‚iÉÊ!…iË\fÍÏÑ=ƒ*Ò‚=Ó=ƒ5Ô‚=Õ=…=Ö×°ØÙÚÛÜÝÞßàáâãäåæ¯'èå!„aéå'\"‚c')êÈë&*‡" [t (c-offsets-alist) reporter-dont-compact-list reporter-prompt-for-summary-p y-or-n-p "Do you want to submit a report on cc-mode? " message "" nil require reporter reporter-submit-bug-report c-mode-help-address "cc-mode " c-version " (" major-mode c++-mode "C++" c-mode "C" objc-mode "ObjC" ")" c-basic-offset c-offsets-alist c-block-comments-indent-p c-cleanup-list c-comment-only-line-offset c-backslash-column c-delete-function c-electric-pound-behavior c-hanging-braces-alist c-hanging-colons-alist c-hanging-comment-ender-p c-tab-always-indent c-recognize-knr-p defun-prompt-regexp tab-width vars boundp delq #[nil "ƒÁÂÃÄ\"ÅÆ°‚ÇÃÈ \"±‡" [c-special-indent-hook "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" "c-special-indent-hook is set to '" format "%s" ".\nPerhaps this is your problem?\n" "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n" "\n" "c-emacs-features: %s\n" c-emacs-features] 5] "Dear Barry,"] 18 (#$ . 81049) nil]) #@30 Pops up the C/C++/ObjC menu. (defalias 'c-popup-menu #[(e) "À ÂP B!ˆÄ ‡" [popup-menu mode-name " Mode Commands" c-mode-menu c-keep-region-active] 3 (#$ . 82173) "@e"]) (defalias 'c-copy-tree #[(tree) ":ƒÁ@!ÁA!B‡Â!ƒ6Ã!‰GS‰ÆYƒ3\f Á\f H!Iˆ S‰‚\f*‡‡" [tree c-copy-tree vectorp copy-sequence new i 0] 6]) (defalias 'c-mapcar-defun #[(var) "J :„ ‚ÂÃ!ƒà !‚Ä !)B‡" [var val fboundp copy-tree c-copy-tree] 3]) (byte-code "ÀÁ\n\"„ÃÁÄÅÆ\"\"„ÇÈ!ˆÉÊ!ˆÉË!ˆÉÌ!ˆÉÍ!ˆÉÎ!ˆÉÏ!ˆÉÐ!ˆÉÑ!ˆÉÒ!ˆÉÓ!ˆÉÔ!ˆÕÖMˆ×ØMˆÙÚMˆÛÜMˆÝÞMˆßÇMˆàáMˆâãMˆä%>ƒæ'èéBêëBì'BíÊBî'BïÊBðÊBñ'BòÊBóÊBôÎBõÏBöÐB÷ÑBøÒBùúBû'Bü'BýþBÿ@BABBCDBEFBG'BH'BIJBKLBMËBN'BOÊBPÊBQÊBRÊBSÊBTÔBUÔB¯$VÄWV\"ˆ*XY!‡" [assoc "CC-MODE" c-style-alist c-add-style mapcar c-mapcar-defun (c-backslash-column c-basic-offset c-block-comments-indent-p c-cleanup-list c-comment-only-line-offset c-echo-syntactic-information-p c-electric-pound-behavior c-hanging-braces-alist c-hanging-colons-alist c-hanging-comment-ender-p c-offsets-alist c-recognize-knr-p c-strict-syntax-p c-tab-always-indent c-inhibit-startup-warnings-p) c-set-style "GNU" make-variable-buffer-local c-offsets-alist c-basic-offset c-file-style c-file-offsets c-comment-only-line-offset c-block-comments-indent-p c-cleanup-list c-hanging-braces-alist c-hanging-colons-alist c-hanging-comment-ender-p c-backslash-column electric-c-brace c-electric-brace electric-c-semi c-electric-semi&comma electric-c-sharp-sign c-electric-pound mark-c-function c-mark-function indent-c-exp c-indent-exp set-c-style c++-beginning-of-defun beginning-of-defun c++-end-of-defun end-of-defun v19 c-emacs-features "Nothing appropriate." na c++-c-mode-syntax-table c-mode-syntaxt-table c++-tab-always-indent c-tab-always-indent c++-always-arglist-indent-p c++-block-close-brace-offset c++-paren-as-block-close-p c++-continued-member-init-offset c++-member-init-indent c++-friend-offset c++-access-specifier-offset c++-empty-arglist-indent c++-comment-only-line-offset c++-C-block-comments-indent-p c++-cleanup-list c++-hanging-braces c++-hanging-member-init-colon c++-auto-hungry-initial-state "Use `c-auto-newline' and `c-hungry-delete-key' instead." c++-auto-hungry-toggle c++-relative-offset-p c++-special-indent-hook c-special-indent-hook c++-delete-function c-delete-function c++-electric-pound-behavior c-electric-pound-behavior c++-hungry-delete-key c-hungry-delete-key c++-auto-newline c-auto-newline c++-match-header-strongly c++-defun-header-strong-struct-equivs c++-version c-version c++-mode-help-address c-mode-help-address c-indent-level c-brace-imaginary-offset c-brace-offset c-argdecl-indent c-label-offset c-continued-statement-offset c-continued-brace-offset c-default-macroize-column c++-default-macroize-column vars #[(elt) "À @ A\"‡" [make-obsolete-variable elt] 3] provide cc-mode] 37) emacs-19.30/lisp/chistory.elc100666 74777 1 11543 5751545566 14476 0ustar esrdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:16:53 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/chistory.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/chistory.el' was compiled for Emacs 19")) #@317 Edit and re-evaluate complex command with name matching PATTERN. Matching occurrences are displayed, most recent first, until you select a form for evaluation. If PATTERN is empty (or nil), every form in the command history is offered. The form is placed in the minibuffer for editing and the result is evaluated. (defalias 'repeat-matching-complex-command #[(&optional pattern) "ƒÁÂ\"ƒÔÄO‚Ä ĉƒX„X@ƒ=ÁÉ@!\"ƒOÊËÌ\"!ƒO@‚A‰„$„cÍÎ!‚s @@Ï=ƒn AÐÑ\"+‡" [pattern string-match "[^ ]" 0 nil command-history what temp history symbol-name y-or-n-p format "Redo %S? " error "Command history exhausted" repeat-matching-complex-command edit-and-eval-command "Redo: "] 5 (#$ . 486) "sRedo Command (regexp): "]) #@300 *A list of symbols to be ignored by `default-command-history-filter'. It that function is given a list whose car is an element of this list, then it will return non-nil (indicating the list should be discarded from the history). Initially, all commands related to the command history are discarded. (defvar default-command-history-filter-garbage (quote (command-history-mode list-command-history electric-command-history)) (#$ . -1248)) #@404 Predicate to test which commands should be excluded from the history listing. If non-nil, should be the name of a function of one argument. It is passed each element of the command history when \[list-command-history] is called. If the filter returns non-nil for some element, that element is excluded from the history listing. The default filter removes commands associated with the command-history. (defvar list-command-history-filter (quote default-command-history-filter) (#$ . 1692)) #@98 Filter commands matching `default-command-history-filter-garbage' list from the command history. (defalias 'default-command-history-filter #[(frob) ":?†\n@ >‡" [frob default-command-history-filter-garbage] 2 (#$ . 2189)]) #@80 *If non-nil, maximum length of the listing produced by `list-command-history'. (defvar list-command-history-max 32 (#$ . -2420)) #@308 List history of commands typed to minibuffer. The number of commands listed is controlled by `list-command-history-max'. Calls value of `list-command-history-filter' (if non-nil) on each history element to judge if that element should be excluded from the list. The buffer is left in Command History mode. (defalias 'list-command-history #[nil "À  † Ä ÈU„AƒAÉÊ!ƒ-\nƒ-\n@!„9 SË@!ˆÌ ˆA‚+ŠÀqˆebˆmƒSÍÎ!‚UÏ )‘‡" ["*Command History*" command-history nil list-command-history-max -1 count buffer-read-only history 0 boundp list-command-history-filter prin1 terpri error "No command history" Command-history-setup] 4 (#$ . 2556) nil]) (defalias 'Command-history-setup #[(&optional majormode modename keymap) "ÀqˆÁ\n† !ˆÄÅ!ˆÆ!ˆÈ Á\n† !ˆ\n†%Ë\f †-Ή‡" ["*Command History*" use-local-map keymap command-history-map lisp-mode-variables nil set-syntax-table emacs-lisp-mode-syntax-table t buffer-read-only majormode command-history-mode major-mode modename "Command History" mode-name] 2]) #@69 If non-nil, its value is called on entry to `command-history-mode'. (defvar command-history-hook nil (#$ . 3584)) (byte-code "ÀÁ!„ÂÁ B „1Ä ¤Æ !ˆÇ ÈÉ#ˆÇ ÊË#ˆÇ ÌË#ˆÇ ÍÎ#ˆÂ‡" [boundp command-history-map nil current-load-list make-sparse-keymap shared-lisp-mode-map suppress-keymap define-key "x" command-history-repeat "\n" next-line " " "" previous-line] 4) #@107 Repeat the command shown on the current line. The buffer for that command is the previous current buffer. (defalias 'command-history-repeat #[nil "ŠÀŠÁyˆÂp!)à A@qˆ!)‡" [eval 0 read buffer-list] 3 (#$ . 3955) nil]) #@600 Major mode for examining commands from `command-history'. The number of commands listed is controlled by `list-command-history-max'. The command history is filtered by `list-command-history-filter' if non-nil. Use \\[command-history-repeat] to repeat the command on the current line. Otherwise much like Emacs-Lisp Mode except that there is no self-insertion and digits provide prefix arguments. Tab does not indent. \{command-history-map} Calls the value of `command-history-hook' if that is non-nil. The Command History listing is recomputed each time this mode is invoked. (defalias 'command-history-mode #[nil "À ˆÁÂ!ˆÃÄ!‡" [list-command-history pop-to-buffer "*Command History*" run-hooks command-history-hook] 2 (#$ . 4176) nil]) (provide (quote chistory)) emacs-19.30/lisp/cl-compat.elc100666 12120 1 7373 6045212125 14430 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:07:12 1995 ;;; from file /home/fsf/rms/e19/lisp/cl-compat.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cl-compat.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!„\nÂÁ!ˆÀ‡" [featurep cl require] 2) (defalias 'defkeyword '(macro . #[(x &optional doc) "ÀÁ\nÃ\nD\f…\f\fC$‡" [list* defconst x quote doc] 5])) (defalias 'keywordp #[(sym) "9…Á!ÂHÃ=…‰L‡" [sym symbol-name 0 58] 2]) (defalias 'keyword-of #[(sym) "À !†ÀÂÃÄ \"!!‡" [keywordp sym intern format ":%s"] 5]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÆ#ˆÀÇÂÆ#ˆÈÉ!„!Ê É B ʇ" [put Multiple-value-bind lisp-indent-function 2 Multiple-value-setq Multiple-value-call 1 Multiple-value-prog1 boundp *mvalues-values* nil current-load-list] 4) (defalias 'Values #[(&rest val-forms) "@‡" [val-forms *mvalues-values*] 1]) (defalias 'Values-list #[(val-forms) "ÀÁ\n\"‡" [apply values val-forms] 3]) (defalias 'Multiple-value-list '(macro . #[(form) "ÀÁ DDÄE‡" [let* (*mvalues-values* nil) *mvalues-temp* form (or (and (eq *mvalues-temp* (car *mvalues-values*)) *mvalues-values*) (list *mvalues-temp*))] 4])) (defalias 'Multiple-value-call '(macro . #[(function &rest args) "À ÂÃÄ \"BE‡" [apply function append mapcar #[(x) "À D‡" [Multiple-value-list x] 2] args] 6])) (defalias 'Multiple-value-bind '(macro . #[(vars form &rest body) "ÀÁ\nÃ\fD $‡" [list* multiple-value-bind vars Multiple-value-list form body] 5])) (defalias 'Multiple-value-setq '(macro . #[(vars form) "À  DE‡" [multiple-value-setq vars Multiple-value-list form] 4])) (defalias 'Multiple-value-prog1 '(macro . #[(form &rest body) "À ÂÃÄ #E‡" [prog1 form list* let ((*mvalues-values* nil)) body] 6])) (defalias 'build-klist #[(arglist keys &optional allow-others) "ÀÁÂÃÅÅ\f@=ƒ\f†C*ÃÇ!‰\f@=ƒ*\f†-C*\"\" \n„OËÌÍ \"\"‰ƒNÐÑ#ˆ) )‡" [apply mapcar* append nil *mvalues-values* cons *mvalues-temp* unzip-lists arglist res allow-others set-difference mapcar car keys bad error "Bad keywords: %s not in %s"] 7]) (defalias 'extract-from-klist #[(klist key &optional def) " ž‰ƒ \nA‚ )‡" [key klist res def] 3]) (defalias 'keyword-argument-supplied-p #[(klist key) " ž‡" [key klist] 2]) (defalias 'elt-satisfies-test-p #[(item elt klist) "À žA žAà žA\fƒ\f!ƒ*\"?‚4 †/É\"+‡" [:test-not klist :test :key key test test-not elt item eql] 4]) (defalias 'cl-floor #[(a &optional b) "ÀÁ\n \"!‡" [Values-list floor* a b] 4]) (defalias 'cl-ceiling #[(a &optional b) "ÀÁ\n \"!‡" [Values-list ceiling* a b] 4]) (defalias 'cl-round #[(a &optional b) "ÀÁ\n \"!‡" [Values-list round* a b] 4]) (defalias 'cl-truncate #[(a &optional b) "ÀÁ\n \"!‡" [Values-list truncate* a b] 4]) (defalias 'safe-idiv #[(a b) "À !À\n!¥Ä !Ä\n!_Æ \n__Z #*‡" [abs a b q signum s Values] 6]) (defalias 'pair-with-newsyms #[(oldforms) "ÀÁ\n\"ÄÅÆ \n# \")‡" [mapcar #[(x) "À ‡" [gensym] 1] oldforms newsyms Values mapcar* list] 5]) (defalias 'zip-lists #[(evens odds) "ÀÁ\n #‡" [mapcan list evens odds] 4]) (defalias 'unzip-lists #[(list) "À‰ ƒ @\nBÄ ! BÅ !‰„Æ\nŸ Ÿ\"*‡" [nil o e list cadr cddr Values] 4]) (defalias 'reassemble-argslists #[(list) "ÀÁÂÃ\f\"\"ÅS‰ÈYƒ#ÂÉ\f\"B‚\f*‡" [apply min mapcar length list nil res n 0 #[(x) " œ‡" [x n] 2]] 5]) (defalias 'duplicate-symbols-p #[(list) "À\nƒ\n@\nA>ƒ\n@ B\nA‰„ )‡" [nil res list] 3]) (defalias 'setnth #[(n list x) " ›\n ‡" [n list x] 2]) (defalias 'setnthcdr #[(n list x) "S ›\n¡‡" [n list x] 2]) (defalias 'setelt #[(seq n x) ":ƒ ›\n ‡ \nI‡" [seq n x] 3]) (provide (quote cl-compat)) emacs-19.30/lisp/cl-extra.elc100666 12120 1 50510 6045212174 14303 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:07:17 1995 ;;; from file /home/fsf/rms/e19/lisp/cl-extra.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cl-extra.el' was compiled for Emacs 19.29 or later")) (byte-code "À >„\nÂÃ!ˆÀ‡" [cl-19 features error "Tried to load `cl-extra' before `cl'!"] 2) (defalias 'cl-push '(macro . #[(x place) "À  EE‡" [setq place cons x] 5])) (defalias 'cl-pop '(macro . #[(place) "ÀÁ\nÃ\nÄ\nDEED‡" [car prog1 place setq cdr] 7])) (byte-code "À BÀ‡" [cl-emacs-type current-load-list] 2) #@67 Coerce OBJECT to type TYPE. TYPE is a Common Lisp type specifier. (defalias 'coerce #[(x type) "Á=ƒ\n<ƒ \n‡Ã\nÄ\"‡Å=ƒ$Æ\n!ƒ \n‡Ç\n!‡È=ƒ5\n;ƒ1\n‡\n°‡É=ƒGÊ\n!ƒC\n‡Ç\n!‡Ë=ƒ]\n;ƒ]\nGÌUƒ]\nÍH‡Ë=ƒo\n9ƒoÎÏ\n!\"‡Ð=ƒyÐ\n!‡Ñ\n\"ƒ‚\n‡ÒÓ\n#‡" [type list x append nil vector vectorp vconcat string array arrayp character 1 0 coerce symbol-name float typep error "Can't coerce %s to type %s"] 4 (#$ . 791)]) #@218 T if two Lisp objects have similar structures and contents. This is like `equal', except that it accepts numerically equal numbers of different types (float vs. integer), and also compares strings case-insensitively. (defalias 'equalp #[(x y) " =ƒ‡;ƒ& ;…G GU… š†%— —š‡§ƒ4 §… U‡:ƒ]:ƒR :ƒRÉA@ ‰A@\"„9:?…à \"‡Ä!ƒÄ !…G GU…G S‰ÆYƒˆÃ H H\"„t ÆW)‡ š‡" [x y t equalp vectorp i 0] 4 (#$ . 1219)]) (defalias 'cl-mapcar-many #[(cl-func cl-seqs) "AAƒzÁÃÄÅÆ\"\"È Ê! Á\fÁ Ê! Wƒu\f  \fƒc \f@:ƒN\f@@\f‰@A ˆ‚T\f@ H ˆ\fA\f A ‚2à \"\nB T‰ ‚%\nŸ.‡Á@A@GG^Ñ  T‰ WƒÐ:ƒ¯‰A@‚´ H:ƒÄ‰A@‚É H\"\nB‚‘*\nŸ+‡" [cl-seqs nil cl-res apply min mapcar length cl-n 0 cl-i copy-sequence cl-args cl-p1 cl-p2 cl-func cl-y cl-x -1] 6]) #@164 Map a function across one or more sequences, returning a sequence. TYPE is the sequence type to return, FUNC is the function, and SEQS are the argument sequences. (defalias 'map #[(cl-type cl-func cl-seq &rest cl-rest) "ÀÁ\n \f$…Ç \")‡" [apply mapcar* cl-func cl-seq cl-rest cl-res cl-type coerce] 5 (#$ . 2058)]) #@139 Map FUNC to each sublist of LIST or LISTS. Like `mapcar', except applies to lists and their cdr's rather than to the elements themselves. (defalias 'maplist #[(cl-func cl-list &rest cl-rest) "ƒ6Á\nÃ!BÁÁ >„1Ç \"B \fƒ\f‰‰A@A ˆ‚!Ÿ+‡Á\nƒM\n!B\nA‰„=Ÿ)‡" [cl-rest nil cl-list copy-sequence cl-p cl-args cl-res apply cl-func] 5 (#$ . 2386)]) #@73 Like `mapcar', but does not accumulate values returned by the function. (defalias 'mapc #[(cl-func cl-seq &rest cl-rest) "ƒÁÂÃ\f %ˆ‚Æ\f \"ˆ ‡" [cl-rest apply map nil cl-func cl-seq mapcar] 6 (#$ . 2761)]) #@74 Like `maplist', but does not accumulate values returned by the function. (defalias 'mapl #[(cl-func cl-list &rest cl-rest) "ƒÁ \f$ˆ‚ \f‰ƒ !ˆ A‰„)\f‡" [cl-rest apply maplist cl-func cl-list cl-p] 6 (#$ . 2978)]) #@74 Like `mapcar', but nconc's together the values returned by the function. (defalias 'mapcan #[(cl-func cl-seq &rest cl-rest) "ÀÁÀ \f $\"‡" [apply nconc mapcar* cl-func cl-seq cl-rest] 7 (#$ . 3208)]) #@75 Like `maplist', but nconc's together the values returned by the function. (defalias 'mapcon #[(cl-func cl-list &rest cl-rest) "ÀÁÀ \f $\"‡" [apply nconc maplist cl-func cl-list cl-rest] 7 (#$ . 3414)]) #@127 Return true if PREDICATE is true of any element of SEQ or SEQs. If so, return the true (non-nil) value returned by PREDICATE. (defalias 'some #[(cl-pred cl-seq &rest cl-rest) "„ <„ ÂÇÄ ƒ  ‰A@!‰ƒ )‡" [cl-rest cl-seq cl-some (byte-code "ÀÁÂÃ\f %ˆÂ‡" [apply map nil #[(&rest cl-x) "À \n\"‰… ÄÅ \")‡" [apply cl-pred cl-x cl-res throw cl-some] 4] cl-seq cl-rest] 6) nil cl-x cl-pred] 3 (#$ . 3624)]) #@67 Return true if PREDICATE is true of every element of SEQ or SEQs. (defalias 'every #[(cl-pred cl-seq &rest cl-rest) "„ <„ ÂÇ ƒ\f @!ƒ A‰„ ?‡" [cl-rest cl-seq cl-every (byte-code "ÀÁÂÃ\f %ˆÆ‡" [apply map nil #[(&rest cl-x) "À \n\"† ÃÄÅ\"‡" [apply cl-pred cl-x throw cl-every nil] 3] cl-seq cl-rest t] 6) cl-pred] 3 (#$ . 4041)]) #@68 Return true if PREDICATE is false of every element of SEQ or SEQs. (defalias 'notany #[(cl-pred cl-seq &rest cl-rest) "ÀÁ\n \f$?‡" [apply some cl-pred cl-seq cl-rest] 5 (#$ . 4388)]) #@67 Return true if PREDICATE is false of some element of SEQ or SEQs. (defalias 'notevery #[(cl-pred cl-seq &rest cl-rest) "ÀÁ\n \f$?‡" [apply every cl-pred cl-seq cl-rest] 5 (#$ . 4577)]) (defalias 'cl-map-keymap #[(cl-func cl-map) "9ƒ\fK‰‚ Â=ƒÃ\f\"‡<ƒW A‰:…U @:ƒ8\f @@ @A\"ˆ‚Æ @!ƒHÇ\f @\"ˆ‚ @È=ƒɉ‚)‡Ê  T‰ GW…y HƒZ\f  H\"ˆ‚Z)‡" [cl-map cl-emacs-type lucid map-keymap cl-func cl-p vectorp cl-map-keymap keymap nil -1 cl-i] 5]) (defalias 'cl-map-keymap-recursively #[(cl-func-rec cl-map &optional cl-base) "„Á\nÃ=ƒÄ‚Å!ÆÇ\"‡" [cl-base copy-sequence cl-emacs-type 18 "0" [0] cl-map-keymap #[(cl-key cl-bind) "‰GS IˆÂ !ƒ\"Ä Ç=ƒÈ‚ÉÊC\"#‡  \"‡" [cl-base cl-key keymapp cl-bind cl-map-keymap-recursively cl-func-rec cl-emacs-type 18 concat vconcat 0] 6] cl-map] 3]) (defalias 'cl-map-intervals #[(cl-func &optional cl-what cl-prop cl-start cl-end) "„pÁ!ƒ—‰ÃŠqˆÈ †!e!\n…-È\n!) ƒ…ƒAWƒ…ËÌ!…[ ƒVÎ #‚[Ì\"‰†fŠqˆd)Ð!\f“ˆƒ\f^‚€\f\"ˆ‚0‰“ˆ…•‰“,‡ „ŸÑ \n„¨G\n \nW…áËÌ!ƒÍ ƒÅÎ  #‚ÊÌ \"†Ï\n \n^\"ˆ  )‚¨‡" [cl-what bufferp nil t cl-next2 cl-next cl-mark2 cl-mark copy-marker cl-start cl-end fboundp next-property-change cl-prop next-single-property-change cl-func marker-position 0] 6]) (defalias 'cl-map-overlays #[(cl-func &optional cl-buffer cl-start cl-end cl-arg) "„pÁÂ!ƒ|ÊqˆÂ  ƒÆ !ƒ(Æ!)\f@\fA¤‰ƒgÈ\f@!ƒ`ƒIÈ\f@!Y„` ƒVÉ\f@! X„`\n\f@ \"„g\fA‰„3 ƒp É“ˆ…zÉ“)‡ŠqˆÆ ††e!)…–ŠqˆÆ!)É\f ŠÏ!‰\f…Æ\f †²dW…ÆqˆÐ\f!Ñ\f!Ó)ƒô\fƒŸÈ\f@!\fUƒê\n\f@ \"ƒêÉ“„Ÿ\fA‰„΂ŸÉ“ˆ … É“,‡" [cl-buffer fboundp overlay-lists nil cl-ovl cl-start copy-marker cl-end overlay-start overlay-end cl-func cl-arg cl-pos cl-mark2 cl-mark marker-position overlays-at next-overlay-change] 5]) (defalias 'cl-set-frame-visible-p #[(frame val) "„ Á\n!ˆ‚Ã=ƒÄ\n!ˆ‚Å\n!ˆ‡" [val make-frame-invisible frame icon iconify-frame make-frame-visible] 2]) (byte-code "À BÀ‡" [cl-progv-save current-load-list] 2) (defalias 'cl-progv-before #[(syms values) "…7Á@!ƒ@@JB‚@\nB ƒ,‰A@ ‰A@Lˆ‚ĉA@!ˆ‚‡" [syms boundp cl-progv-save values makunbound] 3]) (defalias 'cl-progv-after #[nil "…\"@:ƒ@@@ALˆ‚Á@!ˆ‰Aˆ‚‡" [cl-progv-save makunbound] 2]) #@54 Return the greatest common divisor of the arguments. (defalias 'gcd #[(&rest args) "À ‰A@†\nÂ! ƒ,À ‰A@!‰ÂVƒ( \f‰¦‰‚)‚\f )‡" [abs args 0 a b] 4 (#$ . 6933)]) #@52 Return the least common multiple of the arguments. (defalias 'lcm #[(&rest args) "À >ƒÀ‡Â ‰A@†Ã! ƒ- ‰A@!\fÆ\f \"¥ _)‚\f)‡" [0 args abs 1 a b gcd] 4 (#$ . 7108)]) #@49 Return the integer square root of the argument. (defalias 'isqrt #[(a) "¨ƒLÁVƒLÂYƒÂ*ÃYƒÄ‚*ÅYƒ)Å‚*Ælj  ¥\\Ê¥‰ WƒH‰ ‚0 *‡Á=ƒTÁ‡ËÌÇ\"‡" [a 0 1000000 10000 1000 100 10 nil g2 g 2 signal arith-error] 4 (#$ . 7289)]) #@71 Return X raised to the power of Y. Works only for integer arguments. (defalias 'cl-expt #[(x y) "ÁXƒÁUƒ‡ Ä>ƒ ‡Á‡ŦÁUƒ$‚% Æ ‰_Å¥\"_‡" [y 0 1 x (-1 1) 2 cl-expt] 5 (#$ . 7538)]) (byte-code "ÀÁ!ƒ ÂÁK!„ÃÁÄ\"ˆÀ‡" [fboundp expt subrp defalias cl-expt] 3) #@129 Return a list of the floor of X and the fractional part of X. With two arguments, return floor and remainder of their quotient. (defalias 'floor* #[(x &optional y) "À \n\"‰ \nƒ\n _‚ Z)D‡" [floor x y q] 5 (#$ . 7812)]) #@133 Return a list of the ceiling of X and the fractional part of X. With two arguments, return ceiling and remainder of their quotient. (defalias 'ceiling* #[(x &optional y) "À \n\"‰A@ÄUƒ ‚ @T A@\n†ÅZD)‡" [floor* x y res 0 1] 4 (#$ . 8042)]) #@141 Return a list of the integer part of X and the fractional part of X. With two arguments, return truncation and remainder of their quotient. (defalias 'truncate* #[(x &optional y) "ÁY\n?† \nÁY=ƒÃ\n\"‡Ä\n\"‡" [x 0 y floor* ceiling*] 3 (#$ . 8294)]) #@139 Return a list of X rounded to the nearest integer and the remainder. With two arguments, return rounding and remainder of their quotient. (defalias 'round* #[(x &optional y) "ƒU ¨ƒD¨ƒD崀 \\\"‰A@ÆUƒ: ‰\\Uƒ: @¦ÆU„: @S D‚B @ A@ ZD*‡Ç ¥!‰ _Z)D‡ ¨ƒ^ ÆD‡Ç !‰ Z)D‡" [y x 2 hy floor* res 0 round q] 5 (#$ . 8554)]) #@59 The remainder of X divided by Y, with the same sign as Y. (defalias 'mod* #[(x y) "À \n\"A@‡" [floor* x y] 3 (#$ . 8895)]) #@59 The remainder of X divided by Y, with the same sign as X. (defalias 'rem* #[(x y) "À \n\"A@‡" [truncate* x y] 3 (#$ . 9024)]) #@55 Return 1 if A is positive, -1 if negative, 0 if zero. (defalias 'signum #[(a) "ÁVƒ‡ÁWƒÇÁ‡" [a 0 1 -1] 2 (#$ . 9156)]) (byte-code "À BÀ‡" [*random-state* current-load-list] 2) #@124 Return a random nonnegative number less than LIM, an integer or float. Optional second arg STATE is a random-state object. (defalias 'random* #[(lim &optional state) "„ ÂH‰¨ƒgÄÅÆ !ǦZÈÉ\n \f ÂÎÏÉ\"‰Iˆ Ä\fIˆ Ð\\Ϧ‰ ÄVƒS   \f Z ‰\fIˆ‚1 T‰ ÑWƒfÒÓ\"ˆ‚S,ÈÈHTϦI ÓÓHTϦI\fÔ   H \fHZIÕ\"¨ƒêØXƒ¤¦‚ñÕVƒ·ÙÚ\"ÒØ\"\\ÛÛSWƒÍ‰\\T‰‚»Ô\"‰Wƒá‚æÒ\")‚ñÝ¥_,‡" [state *random-state* 3 vec 0 1357335 abs 1357333 1 nil ii k j i make-vector 55 21 200 random* 2 logand 8388607 n lim 512 lsh 9 1023 mask 8388608.0] 7 (#$ . 9347)]) #@143 Return a copy of random-state STATE, or of `*random-state*' if omitted. If STATE is t, return a new state object seeded from the time of day. (defalias 'make-random-state #[(&optional state) "„Á\n!‡Ã!ƒÄÅ\"‡¨ƒÆÇÈÉ$‡ÁÊ !‡" [state make-random-state *random-state* vectorp cl-copy-tree t vector cl-random-state-tag -1 30 cl-random-time] 5 (#$ . 9948)]) #@46 Return t if OBJECT is a random-state object. (defalias 'random-state-p #[(object) "À !… GÂU… ÃHÄ=‡" [vectorp object 4 0 cl-random-state-tag] 2 (#$ . 10314)]) (defalias 'cl-finite-do #[(func a b) "ÀÁ‡" [err (byte-code " \n\"‰§… ‰Ä¥U?… )‡" [func a b res 2] 4) ((arith-error))] 3]) (byte-code "À B Bà BÄ BÅ BÆ BÇ BÈ BÀ‡" [most-positive-float current-load-list most-negative-float least-positive-float least-negative-float least-positive-normalized-float least-negative-normalized-float float-epsilon float-negative-epsilon] 2) (defalias 'cl-float-limits #[nil "„üÁ§ƒüÂÉÇȉ#ƒ\"‰_‚Çȉɥ#ƒ8‰É¥_‚\"Çʉ#ƒJ‰\\‚8É¥ÇÊ #ƒr \\U„r \\ É¥‚R[ \f¥Ì\f¥ _ÍÎσžÉ¥ É¥‚Š  [Ò\f¥‰ÍÓÔƒ¼É¥‚¬[××Ø\\ÙU„ÚÉ¥‰‚ɉ\\ÛÜZÝU„õÉ¥‚ã‰\\+Ç" [most-positive-float 20.0 2.0 nil z y x cl-finite-do * 2 + most-negative-float 16 err (byte-code "‰Á¥Á_U…\nÁ¥ÃV‡" [x 2 y 0] 3) ((arith-error)) least-positive-normalized-float least-negative-normalized-float 1 (byte-code "Á¥ÂV‡" [x 2 0] 2) ((arith-error)) least-positive-float least-negative-float 1.0 1.0 1.0 float-epsilon 1.0 1.0 1.0 float-negative-epsilon] 6]) #@165 Return the subsequence of SEQ from START to END. If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end. (defalias 'subseq #[(seq start &optional end) ";ƒ\n \nO‡Ã\nƒ\nÅWƒ\nG‰\\ ÅWƒ. \f†,G‰\\<ƒg ÅVƒ= ›\nƒaÃ\nS‰ YƒZ‰A@B‚DŸ)‚Ç!‚\n„r\f†qGÈ\n ZÅ]Ã\"Å  \nWƒš  HIˆ T T‰‚€*)‡" [seq start end nil len 0 res copy-sequence make-vector i] 5 (#$ . 11534)]) #@68 Concatenate, into a sequence of type TYPE, the argument SEQUENCES. (defalias 'concatenate #[(type &rest seqs) "Á=ƒ ÂÃ\f\"‡Å=ƒÂÆ\f\"‡Ç=ƒ$Âȉ\fÉ\"\"‡ÊË\"‡" [type vector apply vconcat seqs string concat list append (nil) error "Not a sequence type name: %s"] 5 (#$ . 12002)]) #@39 Equivalent to (append (reverse X) Y). (defalias 'revappend #[(x y) "À !\n¤‡" [reverse x y] 2 (#$ . 12289)]) #@39 Equivalent to (nconc (nreverse X) Y). (defalias 'nreconc #[(x y) "Ÿ ¤‡" [x y] 2 (#$ . 12403)]) #@63 Return the length of a list. Return nil if list is circular. (defalias 'list-length #[(x) "À ‰ Aƒ% \n=ƒ\fÀV„%\fÅ\\ AA\nA‚ ƒ4 A?…5\fT‚5\f+‡" [0 x slow fast n 2] 3 (#$ . 12505)]) #@43 Return true if SUBLIST is a tail of LIST. (defalias 'tailp #[(sublist list) ":ƒ =„A‰‚ §ƒ š‡ =‡" [list sublist] 3 (#$ . 12704)]) #@225 Make a copy of TREE. If TREE is a cons cell, this recursively copies both its car and its cdr. Constrast to copy-sequence, which copies only along the cdrs. With second argument VECP, this copies vectors as well as conses. (defalias 'cl-copy-tree #[(tree &optional vecp) ":ƒCÁ!‰\n:ƒ?\n@:„! ƒ)Ä\n@!ƒ)\nÅ\n@ \" ˆ\nA<„7\nÅ\nA \"¡ˆ\n‰Aˆ‚ )‚p ƒpÄ!ƒpÆ!‰GS‰ÈYƒoÅH \"Iˆ‚U)‡" [tree copy-list p vecp vectorp cl-copy-tree copy-sequence i 0] 5 (#$ . 12853)]) (byte-code "ÀÁ!ƒ ÂÁK!„ÃÁÄ\"ˆÀ‡" [fboundp copy-tree subrp defalias cl-copy-tree] 3) #@69 Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. (defalias 'get* #[(sym tag &optional def) " N†-\n…-Ã!‰ƒ!\f@ =„!\fAA‰„\fƒ+\fA@‚,\n)‡" [sym tag def symbol-plist plist] 3 (#$ . 13426)]) #@128 Search PROPLIST for property PROPNAME; return its value or DEFAULT. PROPLIST is a list of the sort returned by `symbol-plist'. (defalias 'getf #[(plist tag &optional def) "ÀÁ\n\"ˆÁ N†\f…ÅÁ \f#‡" [setplist --cl-getf-symbol-- plist tag def get*] 4 (#$ . 13648)]) (defalias 'cl-set-getf #[(plist tag val) "‰ƒ @\n=„ AA‰„ ƒ\" A  ˆ‚'Ä\n #)‡" [plist p tag val list*] 5]) (defalias 'cl-do-remf #[(plist tag) "A‰Aƒ A@\n=„ AA‰‚ A…% ‰AAA¡ˆÃ)‡" [plist p tag t] 3]) #@61 Remove from SYMBOL's plist the property PROP and its value. (defalias 'cl-remprop #[(sym tag) "À !‰ƒ \n@=ƒÄ \nAA\"ˆÅ‚Æ\n \")‡" [symbol-plist sym plist tag setplist t cl-do-remf] 4 (#$ . 14134)]) (byte-code "ÀÁ!ƒ ÂÁK!„ÃÁÄ\"ˆÀ‡" [fboundp remprop subrp defalias cl-remprop] 3) #@289 Make an empty Common Lisp-style hash-table. If :test is `eq', this can use Lucid Emacs built-in hash-tables. In non-Lucid Emacs, or with non-`eq' test, this internally uses a-lists. Keywords supported: :test :size The Common Lisp keywords :rehash-size and :rehash-threshold are ignored. (defalias 'make-hash-table #[(&rest cl-keys) "À >A@† Âà >A@†Ä‰Ç=ƒ'ÈÉ!ƒ'É !‚EÊ ËVƒ7Ì Í\"‚CÎÏ!‰ÑLˆ)ÍF*‡" [:test cl-keys eql :size 20 cl-size cl-test eq fboundp make-hashtable cl-hash-table-tag 1 make-vector 0 make-symbol "--hashsym--" sym nil] 6 (#$ . 14425)]) (byte-code "ÀÁ!„ ÂÃ!ƒÄÃÅ!!ƒÃÅ!ÆH‚ÇÈ!Á B À‡" [boundp cl-lucid-hash-tag fboundp make-hashtable vectorp 1 0 make-symbol "--cl-hash-tag--" current-load-list] 3) #@37 Return t if OBJECT is a hash table. (defalias 'hash-table-p #[(x) "¢Á=†%Â!ƒGÃUƒÄH =†%ÆÇ!…%Ç!‡" [x cl-hash-table-tag vectorp 4 0 cl-lucid-hash-tag fboundp hashtablep] 2 (#$ . 15162)]) (defalias 'cl-not-hash-table #[(x &optional y &rest z) "ÀÁ †\fD\"‡" [signal wrong-type-argument hash-table-p y x] 4]) (defalias 'cl-hash-lookup #[(key table) "¢Á=„ Â!ˆÃ8A@È \f9ƒ)È\fJ ‚¢:„>Ê!ƒHGËVƒHËœ‰‚+;ƒ\\ Ì=ƒš—‚š9ƒkÍ!‚š§ƒ—ÎVƒ—ÏWƒ—¨„‹Ð!ÑÒÓ\"H‚šÔÕ\f\"J  …Ø Ö=„¹ ×=ƒÁ§„Á ž‚Ø Ø>ƒÐÙ \"‚ØÚ Û $ E,‡" [table cl-hash-table-tag cl-not-hash-table 2 array test key str nil sym vectorp 0 equalp symbol-name -8000000 8000000 truncate ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15"] logand 15 "*" intern-soft eq eql (eql equal) assoc assoc* :test] 6]) (byte-code "ÀÁ!„ÂÃ!ƒÄÃK!ƒÃK‚ÅÁBÀÇ!„;ÂÈ!ƒ8ÄÈK!ƒ8ÈK‚9ÅÇBÀÉ!„\\ÂÊ!ƒYÄÊK!ƒYÊK‚ZÅ ÉBÀË!„}ÂÌ!ƒzÄÌK!ƒzÌK‚{Å ËBÀ‡" [boundp cl-builtin-gethash fboundp gethash subrp cl-not-hash-table current-load-list cl-builtin-remhash remhash cl-builtin-clrhash clrhash cl-builtin-maphash maphash] 2) #@68 Look up KEY in HASH-TABLE; return corresponding value, or DEFAULT. (defalias 'cl-gethash #[(key table &optional def) ":ƒÁ\n\"‰@ƒ @A‚\f)‡ \n\f#‡" [table cl-hash-lookup key found def cl-builtin-gethash] 5 (#$ . 16343)]) (defalias (quote gethash) (quote cl-gethash)) (defalias 'cl-puthash #[(key val table) ":ƒoÁ\n\"‰@ƒ @\f¡ˆ‚kÅ 8ƒUÆ8Å8GÆ_VƒAÇÆ8È\" ÊËÅ8\"ˆAA  ˆ)ÌÅ 8Å8\"\n\fB A@BLˆ‚aÅ8\n\fB A@BLˆAAAÆ8T ˆ)‚uÍ\n\f#ˆ\f‡" [table cl-hash-lookup key found val 2 3 make-vector 0 new-table mapatoms #[(sym) "ÀÁ\n! \"\nJL‡" [intern symbol-name sym new-table] 3] intern puthash] 5]) #@29 Remove KEY from HASH-TABLE. (defalias 'cl-remhash #[(key table) ":ƒ?Á\n\"‰@…=Ä @ A@\"AAAÆ8S ˆÇ 8ƒ5ÈÇ 8Ç8\" Lˆ‚;Ç8 Lˆ)É)‡\n\nË#Ë=?\f\n\"ˆ‡" [table cl-hash-lookup key found delq del 3 2 intern t cl-builtin-gethash --cl-- cl-builtin-remhash] 5 (#$ . 16953)]) (defalias (quote remhash) (quote cl-remhash)) #@19 Clear HASH-TABLE. (defalias 'cl-clrhash #[(table) ":ƒ5Á!„Â!ˆÃ89ƒÃ8ÄLˆ‚+AAÅÃ8GÆ\" ˆAAAÆ ˆ‚:!ˆÄ‡" [table hash-table-p cl-not-hash-table 2 nil make-vector 0 cl-builtin-clrhash] 4 (#$ . 17277)]) (defalias (quote clrhash) (quote cl-clrhash)) #@51 Call FUNCTION on keys and values from HASH-TABLE. (defalias 'cl-maphash #[(cl-func cl-table) "À !„\n !ˆ :ƒ%ÃÄÅ 89ƒ ÆÅ 8!‚#Å 8\"‡ \"‡" [hash-table-p cl-table cl-not-hash-table mapatoms #[(cl-x) "J‰… @@@A\"ˆA‰„‡" [cl-x cl-func nil] 4] 2 vector cl-builtin-maphash cl-func] 5 (#$ . 17538)]) (defalias (quote maphash) (quote cl-maphash)) #@45 Return the number of entries in HASH-TABLE. (defalias 'hash-table-count #[(table) "À !„\n !ˆ :ƒà 8‡Ä !‡" [hash-table-p table cl-not-hash-table 3 hashtable-fullness] 2 (#$ . 17897)]) #@69 Insert a pretty-printed rendition of a Lisp FORM in current buffer. (defalias 'cl-prettyprint #[(form) "`ÀÃÄ !ñˆ`\nTbˆÆÇ È#ƒ+ÉÊ!ˆËcˆÌ ˆÍÎ!ˆ‚\nTbˆÏ *‡" [nil last pt "\n" prin1-to-string form search-forward "(quote " t delete-backward-char 7 "'" forward-sexp delete-char 1 cl-do-prettyprint] 4 (#$ . 18089)]) (defalias 'cl-do-prettyprint #[nil "ÀÁwˆÂÃ!ƒ¢ÂÄ!†%ÂÅ!†%ÂÆ!†%ÂÇ!†%ÂÈ!ÂÉ!†.ÂÊ!ÂË!†7ÂÌ!ÂÍ!‰„W„WÒ ˆiÓY… Ô ˆÕ×uˆØ ˆ„nÂÙ!„nØ ˆƒ|ÂÙ!„|Ø ˆÂÙ!„ƒŒ?ƒ”ÚcˆÛ ˆØ ˆ‚|×u),‡Ò ‡" [" " nil looking-at "(" "((" "(prog" "(unwind-protect " "(function (" "(cl-block-wrapper " "(defun " "(defmacro " "(let\\*? " "(while " "(p?set[qf] " set let two skip forward-sexp 78 backward-sexp t nl 1 cl-do-prettyprint ")" "\n" lisp-indent-line] 6]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp cl-macroexpand-cmacs nil current-load-list cl-closure-vars] 2) #@114 Expand all macro calls through a Lisp FORM. This also does some trivial optimizations to make the form prettier. (defalias 'cl-macroexpand-all #[(form &optional env) "Á\n\"‰=ƒ ƒÄ!‰=ƒ:„ ‡@Å>ƒ·A@„6ÆÇÈ!B\n\"‡É‰Ê! \f  ƒ” @:ƒlÆÎ !\n\"‰9„^Ð ÑÒ !\n\")B‚†Æ @\n\"‰9ƒ~‚…Ð ÉD)\fB\f A‰ „FÓ ƒ©@Ô=ƒ¥Í‚«Õ‚«@\fŸÑÈ!\n\"#+‡@Ö=ƒÇ@×ØA\"B‡@Ù=ƒâÓ@A@ÆÚ8\n\"×ÛÜ!\"$‡@Ý>ƒA@¢Þ=ƒ‹Ñß!\n\" !ƒ~@â=ƒ~ã !\"ƒ~×ä!\"%æ!%\"'É( @;„1 @¢é=ƒBê ‰A @D(B(‚!ëì!!@íÐ#ˆîïðñEò'(Ÿ\"ÓïóïôâÓÞî%õ!\"ò' \"#DE×ö!\"÷¤$C#+‚‰@ÓÞõ! #D)‡‡@ø>ƒ¢Ó@A@ÑÈ!\n\"#‡@Ç=ƒ¶È!„¶ÆA@\n\"‡@ù=ƒðÑA\n\"‰:‰;ƒÜ;@9ƒÜÈ;!‰;„Ë;ƒêÆü:B!‚îù:B*‡@ÑA\n\"B‡" [form macroexpand env cl-macroexpand-cmacs compiler-macroexpand (let let*) cl-macroexpand-all progn cddr nil cadr lets res letf caar exp t cl-macroexpand-body cdar list* let letf* cond mapcar #[(x) "À \n\"‡" [cl-macroexpand-body x env] 3] condition-case 2 #[(x) "@ÁA\n\"B‡" [x cl-macroexpand-body env] 4] cdddr (quote function) lambda cddadr body cl-closure-vars function cl-expr-contains-any gensym new pairlis sub decls interactive quote put last used append list (quote lambda) (quote (&rest --cl-rest--)) sublis (quote apply) (quote quote) cadadr #[(x) "ÀÁ\nE‡" [list (quote quote) x] 3] ((quote --cl-rest--)) (defun defmacro) setq args p setf] 16 (#$ . 18978)]) (defalias 'cl-macroexpand-body #[(body &optional env) "ÀÁ\n\"‡" [mapcar #[(x) "À \n\"‡" [cl-macroexpand-all x env] 3] body] 3]) (defalias 'cl-prettyexpand #[(form &optional full) "ÀÁ!ˆ\n‰ÃÇ\n?…É\"ÀÊ!ˆË!ÀÌ!ˆ+‡" [message "Expanding..." full nil byte-compile-macro-environment cl-compiling-file cl-macroexpand-cmacs cl-macroexpand-all form ((block) (eval-when)) "Formatting..." cl-prettyprint ""] 3]) (run-hooks (quote cl-extra-load-hook)) emacs-19.30/lisp/cl-indent.elc100666 74777 1 13617 5751545606 14506 0ustar esrdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:17:07 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/cl-indent.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/cl-indent.el' was compiled for Emacs 19")) #@181 *Maximum depth to backtrack out from a sublist for structured indentation. If this variable is 0, no backtracking will occur and forms such as flet may not be correctly indented. (defvar lisp-indent-maximum-backtracking 3 (#$ . -488)) #@112 *Indentation of tags relative to containing list. This variable is used by the function `lisp-indent-tagbody'. (defvar lisp-tag-indentation 1 (#$ . -731)) #@478 *Indentation of non-tagged lines relative to containing list. This variable is used by the function `lisp-indent-tagbody' to indent normal lines (lines without tags). The indentation is relative to the indentation of the parenthesis enclosing the special form. If the value is t, the body of tags will be indented as a block at the same indentation as the first s-expression following the tag. In this case, any forms before the first tag are indented by `lisp-body-indent'. (defvar lisp-tag-body-indentation 3 (#$ . -893)) (defalias 'common-lisp-indent-function #[(indent-point state) "iÁ‰ \fŜ \n bˆi „« \fWƒ«` ÅuˆÎ` ÅÏ$ˆÂ‰‰ÓÔ!„O‚—`ÕÅ!ˆ`{—bˆÖ!‰×N‰„ŒØÙ\"ƒŒÁ”TÂOÖ!×N‚—„—ÚNÁ` Wƒ§ÂÜÝ„ \nB\n)ƒã„Ù\nA„ãØÞ\"ƒËß‚ÔØà\"…Ôá‚ãâ=ƒãã Sfä>ƒþ åZfæ=„þT ‚” Sfç=„ Sfè=ƒ  åZfç=ƒ  ‚” Sfæ=ƒ1T ‚”ƒ”¨ƒq\nAƒF‚l\n@XƒYé\\D‚l\n@TUƒk*\\‚l ‚”9ƒ†\n\f % ‚”ë\n\f & + bˆ  „§Âìíˆ)‚ .‡" [normal-indent 0 nil indent-point state 1 sexp-column containing-form-start last-point calculated path depth lisp-indent-maximum-backtracking containing-sexp parse-partial-sexp t method function tem looking-at "\\sw\\|\\s_" forward-sexp intern-soft common-lisp-indent-function string-match ":[^:]+" lisp-indent-function n (byte-code "ÀÁ!ˆ`\nY?…Ã`\nÁÄ$ˆ Tć" [forward-sexp 1 indent-point parse-partial-sexp t n] 5) ((error)) "\\`def" (4 (&whole 4 &rest 1) &body) "\\`\\(with\\|do\\)-" (4 &body) defun (4 (&whole 4 &rest 1) &body) (39 96) 2 35 44 64 4 lisp-body-indent lisp-indent-259 (byte-code "ÀÁ!ˆ\nTÀ‡" [backward-up-list 1 depth] 2) ((error (byte-code "‡" [lisp-indent-maximum-backtracking depth nil] 1)))] 8]) (defalias 'lisp-indent-report-bad-format #[(m) "ÀÁ\nÃ\f$‡" [error "%s has a badly-formed %s property: %s" function common-lisp-indent-function m] 5]) (defalias 'lisp-indent-259 #[(method path state indent-point sexp-column normal-indent) "ÀÁ‡" [exit (byte-code " σ‰…‡ :„Ê !ˆ@SAà @‰Ã=„Š Ë=ƒG AƒŠ Ì=ƒ[ A:ƒ[ AAƒŠ ¨„Š :ƒz @Í=ƒz A@9„Š A@¨„Š 9ƒ… AƒŠÊ !ˆ\fƒœ :„œÎÏ\"ˆ‚, Ë=ƒ¿ÎÏÑUƒ¸„¸\\‚º\"ˆ‚, Ì=ƒÕÑVÑ A ‚,ÑVƒöS A ÑWƒ,ÎÏ\"ˆ‚, Ã=ƒÎÏD\"ˆ‚, ¨ƒ%ÎÏ„ \\D‚ \"ˆ‚, 9ƒ;ÎÏ  %\"ˆ‚,ƒL AA É‚. A@ÎÏ\fƒ[‚‚ Ã=ƒiD‚‚ ¨ƒx \\D‚‚  %\"ˆ‚,-‡" [path state 1 nil tail tem n containing-form-start p method lisp-indent-report-bad-format &body &rest &whole throw exit normal-indent 0 sexp-column lisp-body-indent indent-point] 9)] 2]) (defalias 'lisp-indent-tagbody #[(path state indent-point sexp-column normal-indent) "Aƒ ‡Š\nbˆÃyˆÄÅwˆÆÇ!ƒ  \\‚A\n¨ƒ.\n\\‚A\nË=ƒ<ÅÌÍ‚A\\Ðœ)D‡" [path normal-indent indent-point 0 " " nil looking-at "\\sw\\|\\s_" sexp-column lisp-tag-indentation lisp-tag-body-indentation t (byte-code "ÀÁ!ˆi‡" [backward-sexp 1] 2) ((error (1+ sexp-column))) lisp-body-indent state 1] 3]) (defalias 'lisp-indent-do #[(path state indent-point sexp-column normal-indent) "@ÁYƒ\nÄ %)‡ÉÊ &‡" [path 3 lisp-body-indent lisp-tag-body-indentation lisp-indent-tagbody state indent-point sexp-column normal-indent lisp-indent-259 ((&whole nil &rest) (&whole nil &rest 1))] 7]) (defalias 'lisp-indent-function-lambda-hack #[(path state indent-point sexp-column normal-indent) "A„\f@ÁVƒ\n‡ÃÄŇ" [path 3 normal-indent nil (byte-code "ŠÀÁ!ˆÂuˆÃÄ!ƒ iÆ\\\\‚ \\)‡" [backward-up-list 2 1 looking-at "\\(lisp:+\\)?function\\(\\Sw\\|\\S_\\)" lisp-body-indent -1 sexp-column] 3) ((error (+ sexp-column lisp-body-indent)))] 3]) (byte-code "À @@à @A9ƒ @AÃN‚ @A@#ˆ A‰„)‡" [((block 1) (catch 1) (case (4 &rest (&whole 2 &rest 1))) (ccase . case) (ecase . case) (typecase . case) (etypecase . case) (ctypecase . case) (catch 1) (cond (&rest (&whole 2 &rest 1))) (block 1) (defvar (4 2 2)) (defconstant . defvar) (defparameter . defvar) (define-modify-macro (4 &body)) (define-setf-method (4 (&whole 4 &rest 1) &body)) (defsetf (4 (&whole 4 &rest 1) 4 &body)) (defun (4 (&whole 4 &rest 1) &body)) (defmacro . defun) (deftype . defun) (defstruct ((&whole 4 &rest (&whole 2 &rest 1)) &rest (&whole 2 &rest 1))) (destructuring-bind ((&whole 6 &rest 1) 4 &body)) (do lisp-indent-do) (do* . do) (dolist ((&whole 4 2 1) &body)) (dotimes . dolist) (eval-when 1) (flet ((&whole 4 &rest (&whole 1 (&whole 4 &rest 1) &body)) &body)) (labels . flet) (macrolet . flet) (if (nil nil &body)) (if (&rest nil)) (lambda ((&whole 4 &rest 1) &rest lisp-indent-function-lambda-hack)) (let ((&whole 4 &rest (&whole 1 1 2)) &body)) (let* . let) (compiler-let . let) (locally 1) (multiple-value-bind ((&whole 6 &rest 1) 4 &body)) (multiple-value-call (4 &body)) (multiple-value-list 1) (multiple-value-prog1 1) (multiple-value-setq (4 2)) (prog ((&whole 4 &rest 1) &rest lisp-indent-tagbody)) (prog* . prog) (prog1 1) (prog2 2) (progn 0) (progv (4 4 &body)) (return 0) (return-from (nil &body)) (tagbody lisp-indent-tagbody) (throw 1) (unless 1) (unwind-protect (5 &body)) (when 1)) l put common-lisp-indent-function] 6) emacs-19.30/lisp/cl-macs.elc100666 12120 1 225105 6045212471 14127 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:07:58 1995 ;;; from file /home/fsf/rms/e19/lisp/cl-macs.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cl-macs.el' was compiled for Emacs 19.29 or later")) (byte-code "À >„\nÂÃ!ˆÀ‡" [cl-19 features error "Tried to load `cl-macs' before `cl'!"] 2) (defalias 'cl-push '(macro . #[(x place) "À  EE‡" [setq place cons x] 5])) (defalias 'cl-pop '(macro . #[(place) "ÀÁ\nÃ\nÄ\nDEED‡" [car prog1 place setq cdr] 7])) (defalias 'cl-pop2 '(macro . #[(place) "ÀÁ DDÄ Â‰ DDEE‡" [prog1 car cdr place setq] 7])) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÆBÈBÉBÊËÌ!„/ÌÍMˆËÎ!„:ÌÎÏ\"ˆ†DÑC‰@!ˆÒÓ!„PÔÓBÔ‡" [put cl-push edebug-form-spec edebug-sexps cl-pop cl-pop2 cl-emacs-type current-load-list cl-optimize-safety cl-optimize-speed require fboundp defalias fset cl-transform-function-property #[(n p f) "ÀÁ\nDÁ DÄÅBDF‡" [put quote n p function lambda f] 6] features cl-kludge boundp cl-old-bc-file-form nil] 4) (defalias 'cl-compile-time-init #[nil "ÀKÂÃ!„ÄÀÅ\"ˆÆÇÈÉ#ˆÊË!‡" [byte-compile-file-form cl-old-bc-file-form fboundp byte-compile-flush-pending defalias #[(form) "À \n\"‰¢Ã=ƒÃÄÅ A\"B‡ !‡" [macroexpand form byte-compile-macro-environment progn mapcar byte-compile-file-form cl-old-bc-file-form] 5] put eql byte-compile cl-byte-compile-compiler-macro run-hooks cl-hack-bytecomp-hook] 4]) (byte-code "À BÀ‡" [*gensym-counter* current-load-list] 2) #@98 Generate a new uninterned symbol. The name is made by appending a number to PREFIX, default "G". (defalias 'gensym #[(&optional arg) ";ƒ ‚\nÁ¨ƒ‚\n‰TÅÆÇ\f #!*‡" [arg "G" *gensym-counter* num prefix make-symbol format "%s%d"] 5 (#$ . 1684)]) #@115 Generate a new interned symbol with a unique name. The name is made by appending a number to PREFIX, default "G". (defalias 'gentemp #[(&optional arg) ";ƒ ‚\nÁÂÅÆÇ\f#‰!ƒ\"T‚ É !*‡" [arg "G" nil name prefix intern-soft format "%s%d" *gensym-counter* intern] 5 (#$ . 1944)]) #@199 (defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. Like normal `defun', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...). (defalias 'defun* '(macro . #[(name args &rest body) "À \nB \"ÅÆ \fA#\f@ƒÈ\f@E‚*‡" [cl-transform-lambda args body name res list* defun form progn] 4 (#$ . 2239)])) #@202 (defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro. Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...). (defalias 'defmacro* '(macro . #[(name args &rest body) "À \nB \"ÅÆ \fA#\f@ƒÈ\f@E‚*‡" [cl-transform-lambda args body name res list* defmacro form progn] 4 (#$ . 2619)])) #@168 (function* SYMBOL-OR-LAMBDA): introduce a function. Like normal `function', except that if argument is a lambda form, its ARGLIST allows full Common Lisp conventions. (defalias 'function* '(macro . #[(func) "¢Á=ƒ'ÂAÃ\"ÅÁ\fABD\f@ƒ#Ç\f@E‚%*‡ÅD‡" [func lambda cl-transform-lambda cl-none res function form progn] 3 (#$ . 3008)])) (defalias 'cl-transform-function-property #[(func prop form) "À \n\"ÄÅ @AAÆÇ\nDÇDÉÊ ABDFC#)‡" [cl-transform-lambda form func res append (progn) put quote prop function lambda] 9]) (byte-code "ÀÁ\nBÃÄ!„ÅÄ\nBÆ\nBÇ\nBÈ\nBÉ\nBÊ\nBË\nBŇ" [(&optional &rest &key &allow-other-keys &aux &whole &body &environment) lambda-list-keywords current-load-list boundp cl-macro-environment nil bind-block bind-defs bind-enquote bind-inits bind-lets bind-forms] 2) (defalias 'cl-transform-lambda #[(form bind-block) "@AÃÃÃÃÃà Ã\n\n@;„'\n@¢Ë=ƒ4\n‰A@ B ‚ <ƒ?Ì !‚BÍ DÎ !‰AƒVÍAD¡ˆ)ÐÑ >!‰ƒmÒÑÒ\f \"\"Ð\f!Ó >‰ƒzÒÓ \"Ô >ƒ„ÕÖ!ˆ× >Ð!ƒ¦Ò@Ò \"\"ÙÚDD¤* ƒ× @9ƒ× @Û>„× @Ü=ƒÊ\f„×Ð !:„× ‰A@\nB\n‚§Þ=„æßà\n#C „øßÃ\nŸ Ÿ\n¤#‚HÜ\n>ƒÜ Bá Ã\nGÜ\n>ƒâ‚ãZ#ˆŸß…*ßäåŸ#\nŸÍ‰A@@D¤ ŸæDŸ¤\n¤C¤#. ‡" [form args body nil bind-defs bind-enquote bind-inits bind-lets bind-forms header simple-args interactive copy-list &rest last p cadr &cl-defs delq &cl-quote &whole error "&whole not currently implemented" &environment v &aux cl-macro-environment (nil &rest &body &key &aux) &optional bind-block cl-none list* block cl-do-arglist 1 0 eval-when (compile load eval) let*] 7]) (defalias 'cl-do-arglist #[(args expr &optional num) "<„ >„9„ÂÃ\"‡\fD B‰‡Æ!Ç!‰Aƒ4ÉAD¡ˆ)Ê>‰ƒCÉ ˆ)Ë>ƒNÂÌ!ˆÉ>Í ƒ\\‚]ÏЉ‰‰„wÙÚ!<ƒ‡ÛÜ!‚Ú!\fD B@Ý=ƒ¨A@AAD BƒÒ@ >„Ò=„ÉÞDA‰„´@ß>ƒïàáDâ\"GE=?)ƒO@ >„OA„„ ã‚\näD%æ‰A@„!ÙUƒ&%‚Aç%èéê+ì=?…:í+DáDEEF\"ˆ)Tî‚ð@ï=ƒà‰A@ƒàƒO@ >„O‰A@‰0:„z0C0ñ0!ƒæò08óîE\"ˆ0Aƒš0A@‚¨4@†¨0@4žA@ãD%‰5ƒ¿6ƒ¿í5D5æ0@5ƒÓç%5F‚Õ%\"ˆT+‚^@É=ƒA@AA‰0:ƒüæ0\"ˆ)‚5@÷=„5ÙU„5„5çèøê+ì=?…%í+DùáDEEEE:B:@÷=ƒf‰A@ƒfƒ5@ >„5‰A@‰0:„`0C00@:ƒnû0!‚vüýþ0@\"!?0@:ƒˆ@0!‚‹0@A0AƒšÚ0!‚§4@†§ÚA4ž!5Bí?DEC5ƒÅ6ƒÅí5D5ñ0!ƒò08†ÕÛ DäÞDDDEæDC\"ˆæAçDFEGDîEE5F\"ˆ*‚8æAäÞ5„C‚4HCI5!î=ƒ.íÐJ5!DD‚3êÐ5EEDD\"ˆ?BK?!ÙHLUƒb?‰LˆG?í?DEMBM-‚DŸ@N=ƒ|‰A@„öƒöÙU„öÛO!PQRSPTBäPDíUR\"DEGPÞ‰PDDEDäÞBíRBEDDGPÐEDîÂýV\"äPDEDFEWXPDCWE:B:+@Y=ƒS‰A@ƒSƒö@ >„ö@:ƒG6ƒ7@!ƒ7æû!íÚ‰A@!D\"ˆ‚æû!Ú‰A@!\"ˆ‚æ‰A@Ð\"ˆ‚…^ÂZ\".‡" [args lambda-list-keywords error "Invalid argument name: %s" expr bind-lets copy-list last p &rest &body &environment "&environment used incorrectly" cl-compiling-file cl-optimize-safety 3 nil minarg exactarg laterarg keys safety restarg save-args num 0 cadr gensym "--rest--" &whole cdr (nil &aux) = length ldiff pop car poparg cl-do-arglist if signal (quote wrong-number-of-arguments) list bind-block cl-none quote t &optional arg cddr 2 and bind-defs def bind-enquote &key (quote wrong-number-of-arguments) + bind-forms caar intern format ":%s" karg cadar varg memq look temp val prog1 setq or cl-const-expr-p cl-const-expr-val symbol-name 58 bind-inits &allow-other-keys "--keys--" var (:allow-other-keys) allow while cond append "Keyword argument %%s not one of %s" check let &aux "Malformed argument list %s"] 12]) (defalias 'cl-arglist-args #[(args) "<„C‡Á‰‰:ƒ[‰A@‰ >ƒ$\n‚\nÆ=ƒ2‰Aˆ‚\n:ƒ> ƒ>\n@\n:ƒR\nAƒR Ç=ƒRÈ\n!\fÉ\n!¤‚\f…bC¤+‡" [args nil arg kind res lambda-list-keywords &cl-defs &key cadr cl-arglist-args] 4]) (defalias 'destructuring-bind '(macro . #[(args expr &rest body) "ÀÀÀÀÅdžÉ\n\"ˆËÌ Í ŸD\nŸ¤¤C#-‡" [nil bind-lets bind-forms bind-inits bind-defs cl-none bind-block cl-do-arglist args (&aux) expr append (progn) let* body] 5])) (byte-code "ÀÁ!„ÂÁ B‡" [boundp cl-not-toplevel nil current-load-list] 2) #@290 (eval-when (WHEN...) BODY...): control when BODY is evaluated. If `compile' is in WHEN, BODY is evaluated when compiled at top-level. If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. (defalias 'eval-when '(macro . #[(when &rest body) "ÀÁ!ƒZÁ ƒZ\n„ZÃÄ!„ZÅ>† Ç>È Ê>„2Ë>ƒK ƒAÌÍÎ\"B‚XÐÑÒ‰$‚X ƒWÓÌB!ˆÒ*‡Ó>„hÔ>…lÌB‡" [fboundp cl-compiling-file cl-not-toplevel boundp for-effect compile when :compile-toplevel t comp load :load-toplevel progn mapcar cl-compile-time-too body list* if nil eval :execute] 5 (#$ . 7167)])) (defalias 'cl-compile-time-too #[(form) "¢9ƒ ¢ÁN„ÂÃ\fB\"¢Å=ƒ#ÅÆÇA\"B‡¢È=ƒMA@ Ê >„=Ë >ƒJÌÈÍ BÎ!#‚K)‡Ê!ˆ‡" [form byte-hunk-handler macroexpand (eval-when) byte-compile-macro-environment progn mapcar cl-compile-time-too eval-when when eval :execute list* compile cddr] 5]) (byte-code "ÀÁ!ƒÁK¢Â=ƒÃÄ!ˆÀ‡" [fboundp eval-when-compile autoload eval (defmacro eval-when-compile (&rest body) "Like `progn', but evaluates the body at compile time.\nThe result of the body appears to the compiler as a quoted constant." (list (quote quote) (eval (cons (quote progn) body))))] 2) #@121 Like `progn', but evaluates the body at load time. The result of the body appears to the compiler as a quoted constant. (defalias 'load-time-value '(macro . #[(form &optional read-only) "À ƒGÁÂ!ÄÅ DEÇÈ!ƒ:ÉÊ!ƒ:ÉË!ƒ:ÌÍÎÏÐÅÌKDEÌÅ\fDDѯMˆ‚@Ò\fÓJ\"ˆÔÅ *DD‡ÅÕ!D‡" [cl-compiling-file gentemp "--cl-load-time--" temp set quote form fboundp byte-compile-file-form-defmumble boundp this-kind that-one byte-compile-file-form lambda (form) fset (quote byte-compile-file-form) (byte-compile-file-form form) print outbuffer symbol-value eval] 7 (#$ . 8425)])) #@461 (case EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared against each key in each KEYLIST; the corresponding BODY is evaluated. If no clause succeeds, case returns nil. A single atom may be used in place of a KEYLIST of one atom. A KEYLIST of `t' or `otherwise' is allowed only in the final clause, and matches if no other keys match. Key values are compared by `eql'. (defalias 'case '(macro . #[(expr &rest clauses) "À Â\"ƒ ‚ à ÅÇÈÉ\n\"B \f =ƒ% ‚-Ì\f DC E+‡" [cl-simple-expr-p expr 3 gensym temp nil head-list cond mapcar #[(c) "@Á>ƒ ‚V@Ã=ƒ ÄÅÇÈ !DF‚V@<ƒ9Ê@ \" ËÇ@DE‚V@ >ƒGÄÌ@\"ˆ@ B ÍÇ@DEA†\\ÎB‡" [c (t otherwise) t ecase-error-flag error "ecase failed: %s, %s" temp quote reverse head-list append member* "Duplicate key in case: %s" eql (nil)] 6] clauses body let] 4 (#$ . 8990)])) #@103 (ecase EXPR CLAUSES...): like `case', but error if no case fits. `otherwise'-clauses are not allowed. (defalias 'ecase '(macro . #[(expr &rest clauses) "ÀÁ\nÃ\fÅ\"#‡" [list* case expr append clauses ((ecase-error-flag))] 6 (#$ . 9916)])) #@348 (typecase EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, typecase returns nil. A TYPE of `t' or `otherwise' is allowed only in the final clause, and matches if no other keys match. (defalias 'typecase '(macro . #[(expr &rest clauses) "À Â\"ƒ ‚ à ÅÇÈÉ\n\"B \f =ƒ% ‚-Ì\f DC E+‡" [cl-simple-expr-p expr 3 gensym temp nil type-list cond mapcar #[(c) "@Á=ƒ ‚-@Ã=ƒ ÄÅÇÈ !DF‚-@ B Ê@\"A†3ËB‡" [c otherwise t ecase-error-flag error "etypecase failed: %s, %s" temp quote reverse type-list cl-make-type-test (nil)] 6] clauses body let] 4 (#$ . 10161)])) #@111 (etypecase EXPR CLAUSES...): like `typecase', but error if no case fits. `otherwise'-clauses are not allowed. (defalias 'etypecase '(macro . #[(expr &rest clauses) "ÀÁ\nÃ\fÅ\"#‡" [list* typecase expr append clauses ((ecase-error-flag))] 6 (#$ . 10907)])) #@526 (block NAME BODY...): define a lexically-scoped block named NAME. NAME may be any symbol. Code inside the BODY forms can call `return-from' to jump prematurely out of the block. This differs from `catch' and `throw' in two respects: First, the NAME is an unevaluated symbol rather than a quoted symbol or other form; and second, NAME is lexically rather than dynamically scoped: Only references to it within BODY will work. These references may appear inside macro expansions, but not inside functions called from BODY. (defalias 'block '(macro . #[(name &rest body) "ÀÁ\nB!ƒ\fÁ\nB‡ÃÄÅÆÇÈÉ\n\"!D\n#D‡" [cl-safe-expr-p progn body cl-block-wrapper list* catch quote intern format "--cl-block-%s--" name] 8 (#$ . 11169)])) (byte-code "ÀÁ!„ÂÁ BÄÅÆÇ#‡" [boundp cl-active-block-names nil current-load-list put cl-block-wrapper byte-compile cl-byte-compile-block] 4) (defalias 'cl-byte-compile-block #[(cl-form) "ÀÁ!ƒ8\nA@A@A@ÃB‰ BÆÇÈ\nA@!B! \fAƒ2ÊË\nA@A@ E!‚6Ê !+‡Ê\nA@!‡" [fboundp byte-compile-form-do-effect cl-form nil cl-entry cl-active-block-names byte-compile-top-level progn cddr cl-body byte-compile-form catch] 5]) (put (quote cl-block-throw) (quote byte-compile) (quote cl-byte-compile-throw)) (defalias 'cl-byte-compile-throw #[(cl-form) "A@A@ ž‰ƒ\náˆ)ÄÅAB!‡" [cl-form cl-active-block-names cl-found t byte-compile-normal-call throw] 4]) #@103 (return [RESULT]): return from the block named nil. This is equivalent to `(return-from nil RESULT)'. (defalias 'return '(macro . #[(&optional res) "ÀÁ\nE‡" [return-from nil res] 3 (#$ . 12544)])) #@324 (return-from NAME [RESULT]): return from the block named NAME. This jump out to the innermost enclosing `(block NAME ...)' form, returning RESULT from that form (or nil if RESULT is omitted). This is compatible with Common Lisp, but note that `defun' and `defmacro' do not create implicit blocks as they do in Common Lisp. (defalias 'return-from '(macro . #[(name &optional res) "ÀÁ \"!ÅÆ\fDE)‡" [intern format "--cl-block-%s--" name name2 cl-block-throw quote res] 4 (#$ . 12748)])) (byte-code "À B Bà BÄ BÅ BÆ BÇ BÈ BÉ BÊ BË BÌ BÍ BÎ BÏ BÐ BÑ BÀ‡" [args current-load-list loop-accum-var loop-accum-vars loop-bindings loop-body loop-destr-temps loop-finally loop-finish-flag loop-first-flag loop-initially loop-map-form loop-name loop-result loop-result-explicit loop-result-var loop-steps loop-symbol-macs] 2) #@725 (loop CLAUSE...): The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND, always COND, never COND, thereis COND, collect EXPR into VAR, append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR, count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR, if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR, finally return EXPR, named NAME. (defalias 'loop '(macro . #[(&rest args) "ÀÁÂÃÄÃÀÅ!\"\"\">„ÇÄÈÉÀ#E‡Ä‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰\n \f ÚÛ\"@Ü=„aÝ ˆ‚SƒpÀDCB\fƒ‰\fÀDCBÞ\fÄEBŸ†“C¤àŸ!!â!!Ÿ¤#ÚŸ ƒÒÇäå!@À=ƒÁ#‚Êæ!@çE#Bè #E‚ÚÈÉ!@##Cƒû隃íC‚ýêëBFC‚ý#,ƒ CBƒXí!ƒ+î‰A@,À#C,‚ Ä/ƒJí!„J‰A@@/B/‚.î/,Ä#C,)‚ \nƒgÈð\n,#C,ÈÇ,#.‡" [t mapcar symbolp delq nil copy-list args block list* while loop-symbol-macs loop-destr-temps loop-first-flag loop-map-form loop-finally loop-initially loop-accum-vars loop-accum-var loop-finish-flag loop-result-var loop-result-explicit loop-result loop-steps loop-body loop-bindings loop-name append (cl-end-loop) cl-end-loop cl-parse-loop-clause setq epilogue cl-loop-build-ands ands cadr while-body --cl-finish-- subst or (return-from --cl-finish-- nil) --cl-map (nil) if progn body cdar cl-loop-let lets symbol-macrolet] 16 (#$ . 13589)])) (defalias 'cl-parse-loop-clause #[nil "‰A@Á„ÆÇ!ˆ‚Ì È=ƒ%‰A@ ‚Ì Ê=ƒR@Ë>ƒ5A@:„?ÆÌ!ˆ@:ƒÌ ‰A@ B ‚? Î=ƒ³@Ï=ƒoA@AA†jÐ‚Ì @Ò>ƒyA@:„ƒÆÓ!ˆÔ!Ï=ƒ  „ ‰A@A@†›Õ‚Ì @:ƒÌ ‰A@B‚  ×>ƒ ؉‰‰‰A@†ÏÝ ‰A@‰ß=ƒã‰A@ à>ƒï‰A@ á>ƒûâãB ä>ƒ B‰@å>ƒÆæ!ˆ@ç=†è!é>*@ë>†*è!ì>-@î>…:A@AA/@ð>…JA@AA1@ò=…ZA@AA3ô1!?…fÝ 5ô3!?…rÝ 63ƒŒ3§ƒŒ3÷XƒŒÆø3\"ˆ/†”÷DB5ƒ©51DB6ƒ¸63DB1ƒè*ƒÏ-ƒËù‚Ùú‚Ù-ƒØû‚Ùü5†â1E=B=*ƒóþ‚ôÿ6†3†@EDB.‚ A>ƒÓ B=‰Bƒ-9ƒ-‚/Ý ‰C‰A@DBDCD=B= E=ƒaFCDDGBG‚ŠC=„ŠØDBBƒ~C‚„FCDDBC@ò=ƒÃA@AA‰3¢H>ƒ·3A@9ƒ·3A@CD‚¿I3CE)‚ÉJCDDB*‚ K=ƒb‰A@/@L=ƒõA@AA‚÷/LØDB„@M=ƒ7NO†Ý ‰O/FDBLDB‚^/L=ƒF/‚XNO†SÝ ‰O/LFDB*‚ P>ƒÚÝ Ý Q‰R‰A@DBQSDBûTQUQDEVRDE=B= W=ƒ½XRQEDGBG‚ÖØDBXRQEDB*‚ Y>ƒç@Z>†ú@[>?…úÆ\\!A@AAÝ @]=ƒ;^!G_Uƒ3`!a=ƒ3^A@AA!‚=Æb!‚=Ý QcdecdDBQ÷DBeƒÝ ‰fVcDDBgcQEDGBGûQfE=B=)‚ÕØDBMchDcDûQVcDEEE=B=NDcDicDXcQEFDBQUQDDB,‚ \f>ƒx@j>„üÆ\\!ˆA@AAk@]=ƒE^!G_Uƒ=`!\f>ƒ=`! =„=^A@AA!‚GÆb!‚GÝ l m>ƒYllnopqlDr#DkEs*‚ t>ƒ¯@u>…A@AAvwopqCr#DvEs)‚ x>ƒ!؉‰yz{@|>ƒÿ@z=ƒÞA@AAz‚À@y=ƒóA@AAy‚ÀA@AA{‚À}oqÝ D~ØFD{zy¯s+‚ >ƒæ؉‰‰Ý Ý €yz‚{@ƒ>ƒ‘@z=ƒ[A@AAz‚=@y=ƒpA@AAy‚=@„=ƒ…A@AA‚‚=A@AA{‚=:ƒ²@9ƒ²A9ƒ²@A€‚Â…€EDB†oq€D‡ED{‚zy¯s.‚ >ƒ…@ˆ>„ûÆ\\!ˆA@AA‰@]=ƒB^!G_Uƒ:`! >ƒ:`! =„:^A@AA!‚DÆb!‚DÝ l‰ Š>ƒXll ‹>ƒfŒ‚iopqlDr#D‰Es*‚ Ž>ƒøÝ C=ƒ¢‘‚¥’DBCØDB“”•CEDhCTCEEE=B==ƒè–‚ë—DDB)‚ ˜>ƒ|@™>…A@AAÝ Cššƒ5=ƒ,›‚/œšD‚8DBCØDB“”•CEDhCTCEEE=B=žDDB*‚ 9…† ŸN‰ ƒ• !ˆ‚œÆ¡ \"ˆ)@)M=ƒ´¢‰Aˆ‚ŃɃɟ£B£‚פ¥\"£¤£ƒô¦§ŸT#¢E=B=ƒ ƒ ¨‚ T©ªŸ\"B«B«,‚Ì ¬=ƒL Ý ‰C‰A@DC£B£úTC­CDE÷E=B=)‚Ì ®=ƒ¦ ‰A@¯Ø°\"±²=ƒ„ ¦³±E¢E=B=‚¢ ¦T´¥±DEE¢E=B=*‚Ì µ>ƒ\n‰A@¯Ø°\"±¦T‰²=ƒë ´ ¶>ƒß °‚â ·±DE‚\n ¸>ƒù ´‚ü ª±EE¢E=B=*‚Ì ¹>ƒB\n‰A@¯º!±¦»¼±F¢E=B=*‚Ì ½>ƒu\n‰A@¯¾!±¦»¿±F¢E=B=*‚Ì À>ƒ£\n‰A@¯÷!±¦Á±E¢E=B=*‚Ì Â>ƒÕ\n‰A@¯÷!±¦N±ÁDE¢E=B=*‚Ì Ã>ƒM ‰A@±Ä±!ƒò\n±‚ô\nÝ C¯Ø!ÅÆ !÷ÇO!ÈTNÈCECFEɦC±=ƒ4 É‚@ ÊC±DCÉE¢E=B=-‚Ì Ë=ƒ Ø̉A@@K=…m A@AADÌBÌ@M=ƒ„ ‰Aˆ‚X ÌŸ£B£)‚Ì Í=ƒ¥ ‰A@=B=‚Ì Î=ƒ¾ ”‰A@D=B=‚Ì Ï=ƒç Ð„Ï Ý ÐTЉA@E=B=¢Ñ‚Ì Ò=ƒ\fЄø Ý ÐTД‰A@DE=B=¢Ñ‚Ì Ó=ƒK\fЄ%\fÝ ÐÔ„.\fÝ ÔTДTÔ‰A@EDE=B=‚Ì Õ>ƒC ‰A@ÖØ=× ˆØ=Ÿ!)LØ=@Ù=ƒ€\fA× ˆØ=Ÿ!)ÙL@¢=…›\fÙ@¢=Ú@ñ=ƒ§\fA Û=ƒ·\fÙLÙLÚƒÇ\f¦LA@B‚Í\f_L8ÚƒÙ\fÙA@‚à\f_Ù8CBÜÝÜÞ\"ƒ Ý ‰CC£B£pNTCÖEßCÞÜ##Ü)‚' pNÖÜ#ÜÚƒ8 ¦Ü¢E‚: Ü=B=-‚Ì à>ƒ Øá@:„Z Æâ!ˆ@:ƒm ‰A@áBá‚Z ¦¢áBŸB=B=)‚Ì Ï=ƒ° Є Ý ÐÔ„™ Ý ÔTÔ‰A@Ðد=B=‚Ì 9…º ãN‰ „Ç Æä \"ˆ  ˆ)@M=…Ü A× +‡" [args (hash-key hash-keys hash-value hash-values) (key-code key-codes key-seq key-seqs key-binding key-bindings) key-types hash-types word error "Malformed `loop' macro" named loop-name initially (do doing) "Syntax error on `initially' clause" loop-initially finally return (quote nil) loop-result-explicit (do doing) "Syntax error on `finally' clause" caar (quote nil) loop-finally (for as) nil ands loop-for-steps loop-for-sets loop-for-bindings gensym var being (the each) (buffer buffers) in (buffer-list) (from downfrom upfrom to downto upto above below by) (downto above) "Must specify `from' value for downward loop" downfrom caddr (downto above) down (above below) (above below) excl (from upfrom downfrom) start (to upto downto above below) end by step cl-const-expr-p end-var step-var 0 "Loop `by' value is not positive: %s" > >= < <= loop-body - + 1 (in in-ref on) on temp consp in-ref car loop-symbol-macs (quote function function*) funcall cdr = then and if loop-first-flag (across across-ref) temp-idx temp-vec -1 setq 1+ length across-ref aref (element elements) (in-ref of-ref) (in of) "Expected `of'" using cadr 2 caadr index "Bad `using' clause" temp-seq seq ref temp-len elt or pop (in of) table other (hash-value hash-values) maphash function list* lambda --cl-map loop-map-form (symbol present-symbol external-symbol symbols present-symbols external-symbols) (in of) ob mapatoms (overlay overlays extent extents) to from buf (in of from to) cl-map-extents (progn . --cl-map) (interval intervals) var2 var1 prop (in of property from to) property cons cl-map-intervals (progn . --cl-map) (in of) map (key-binding key-bindings) (key-seq key-seqs) cl-map-keymap-recursively cl-map-keymap (frame frames screen screens) cl-emacs-type lucid (selected-screen) (selected-frame) prog1 not eq next-screen next-frame (window windows) (in of) scr screen-selected-window frame-selected-window (selected-window) next-window cl-loop-for-handler handler "Expected a `for' preposition, found %s" t loop-bindings mapcar list progn cl-loop-let psetq apply append loop-steps repeat 1- collect cl-loop-handle-accum nreverse what loop-accum-var push nconc (nconc nconcing append appending) (nconc nconcing) reverse (nconc nconcing) (concat concating) "" callf concat (vconcat vconcating) [] vconcat (sum summing) incf (count counting) (minimize minimizing maximize maximizing) cl-simple-expr-p intern symbol-name 3 func set let with bindings while until always loop-finish-flag loop-result never thereis loop-result-var (if when unless) cond cl-parse-loop-clause cl-loop-build-ands else simple unless form cl-expr-contains it subst (do doing) body "Syntax error on `do' clause" cl-loop-handler "Expected a loop keyword, found %s"] 9]) (defalias 'cl-loop-let #[(specs body par) "Á‰‰ƒ\f@¢9„Å\f!„\fA‰„\nƒS\fƒSÁ‰ƒSÇÅ\f!!„LÈ ‰ Å\f!D BÊ\f!  ˆ)\fA‰„0ƒØ@:ƒÍË!<ƒÍË!\fÁ ΉA@!\fž†‘\fÑ\fÒ\"†‰È BB‰@A‰ D\nB\f:ƒÃ\f‰A\f@…º\fƒ¶Ó‚·Ô DD B ‚› Ÿ¤,‚S‰A@\nB‚SÖ=ƒƒèׂéÖØÙ\nŸ\"B ƒþÛ ŸE‚)‚ÜƒÝ‚Û Ÿ\nŸ¤#+‡" [specs nil new temps p cadar par cl-const-expr-p gensym temp cdar caar spec nspecs cadr expr loop-destr-temps last 0 pop car body setq psetq apply nconc set let* list* let] 5]) (defalias 'cl-loop-handle-accum #[(def &optional func) "@Á=ƒ#A@AA‰ >„ \n\fDC B\n B\n)‡†FÇ ‰\fDC Bƒ@D‚B ‡" [args into var loop-accum-vars def loop-bindings loop-accum-var gensym func loop-result] 3]) (defalias 'cl-loop-build-ands #[(clauses) "À‰ ƒW @¢Ä=ƒLÅ @!@Æ=ƒL Aƒ@Ç @!È !¢Ä=ƒ2É !‚6È !C¤Ê !B‰‚Ç ‰A@!A‚ ‰A@\nB‚\nŸ†^ÆC‰AƒjË\nB‚l\n@ ‰ƒ~Ì\nÄÌ Í\"BC\"‚\n‰AƒËB‚@)E*‡" [nil body ands clauses progn last t butlast cadr cdadr cddr and append (t) full] 9]) #@98 The Common Lisp `do' loop. Format is: (do ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...) (defalias 'do '(macro . #[(steps endtest &rest body) "À \n Ä$‡" [cl-expand-do-loop steps endtest body nil] 5 (#$ . 22683)])) #@100 The Common Lisp `do*' loop. Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...) (defalias 'do* '(macro . #[(steps endtest &rest body) "À \n Ä$‡" [cl-expand-do-loop steps endtest body t] 5 (#$ . 22912)])) (defalias 'cl-expand-do-loop #[(steps endtest body star) "ÀÁ ƒ Ä‚\fÅÆÇ\"ÂÉÊ @DÌ ÆÎ\"ÐÁ\"‰…C „7A„;Ñ‚<ÒÓÌ\"BC)\"# A†MÔ$E‡" [block nil list* star let* let mapcar #[(c) ":ƒ\f@A@D‡‡" [c] 2] steps while not endtest append body #[(c) ":…AA…@Á8D‡" [c 2] 3] sets delq setq psetq apply (nil)] 15]) #@175 (dolist (VAR LIST [RESULT]) BODY...): loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. Then evaluate RESULT to get return value, default nil. (defalias 'dolist '(macro . #[(spec &rest body) "ÀÁ!ÃÄÅÆ\nA@D@DÅÈ\nÉ@Ê\nDEË\fÉ\nÍ\nDEC\"$AAƒ>É@ÄEAAB‚?Î$E)‡" [gensym "--dolist-temp--" temp block nil list* let spec while setq car append body cdr (nil)] 15 (#$ . 23468)])) #@221 (dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times. Evaluate BODY with VAR bound to successive integers from 0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get return value, default nil. (defalias 'dotimes '(macro . #[(spec &rest body) "ÀÁ!ÃÄÅÆ\nA@D@ÈDDÅÉÊ@\nEË\fÍ@DC\"#AA†/Î$E)‡" [gensym "--dotimes-temp--" temp block nil list* let spec 0 while < append body incf (nil)] 12 (#$ . 23887)])) #@156 (dosymbols (VAR [OBARRAY [RESULT]]) BODY...): loop over all symbols. Evaluate BODY with VAR bound to each interned symbol, or to each symbol from OBARRAY. (defalias 'do-symbols '(macro . #[(spec &rest body) "ÀÁ @CÄÅÆÄÇ @C#DÉ !…É !C#Ê !FE‡" [block nil let spec list* mapatoms function lambda body cadr caddr] 11 (#$ . 24331)])) (defalias 'do-all-symbols '(macro . #[(spec &rest body) "ÀÁ\n@ÃÄ\n!E #‡" [list* do-symbols spec nil cadr body] 6])) #@205 (psetq SYM VAL SYM VAL ...): set SYMs to the values VALs in parallel. This is like `setq', except that all VAL forms are evaluated (in order) before assigning any symbols SYM to the corresponding values. (defalias 'psetq '(macro . #[(&rest args) "À B‡" [psetf args] 2 (#$ . 24786)])) #@444 (progv SYMBOLS VALUES BODY...): bind SYMBOLS to VALUES dynamically in BODY. The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. Each SYMBOL in the first list is bound to the corresponding VALUE in the second list (or made unbound if VALUES is shorter than SYMBOLS); then the BODY forms are executed and their result is returned. This is much like a `let' form, except that the list of symbols can be computed at run-time. (defalias 'progv '(macro . #[(symbols values &rest body) "ÀÁÂÃÄÅE#ÉEE‡" [let ((cl-progv-save nil)) unwind-protect list* progn cl-progv-before symbols values body (cl-progv-after)] 8 (#$ . 25077)])) #@352 (flet ((FUNC ARGLIST BODY...) ...) FORM...): make temporary function defns. This is an analogue of `let' that operates on the function cell of FUNC rather than its value cell. The FORMs are evaluated with the specified function definitions in place, then the definitions are undone (the FUNCs go back to their previous definitions, or lack thereof). (defalias 'flet '(macro . #[(bindings &rest body) "ÀÁÂÃ\f\" #‡" [list* letf* mapcar #[(x) "ÀÁ !ÄÅ @Æ !#EDÈ ƒ(ÉÊ!ƒ( @Ë!B\nB\nÌÍ @DD)D‡" [function* lambda cadr x list* block cddr func cl-compiling-file boundp byte-compile-function-environment eval symbol-function quote] 8] bindings body] 5 (#$ . 25731)])) (defalias 'labels '(macro . #[(&rest args) "À B‡" [flet args] 2])) #@136 (macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns. This is like `flet', but for macros instead of functions. (defalias 'macrolet '(macro . #[(bindings &rest body) "AƒÁ@CÂÁA #E‡„Ä B‡Å!ÇÈ!\" Ê @!ˆËÄ BÂÌ A# B\"*‡" [bindings macrolet list* body progn caar name cl-transform-lambda cdar res eval cl-macroexpand-all lambda cl-macro-environment] 6 (#$ . 26472)])) #@218 (symbol-macrolet ((NAME EXPANSION) ...) FORM...): make symbol macro defns. Within the body FORMs, references to the variable NAME will be replaced by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). (defalias 'symbol-macrolet '(macro . #[(bindings &rest body) "AƒÁ@CÂÁA #E‡„Ä B‡ÅÄ BÆÇ!!È!D B\"‡" [bindings symbol-macrolet list* body progn cl-macroexpand-all symbol-name caar cadar cl-macro-environment] 6 (#$ . 26882)])) (byte-code "ÀÁ!„ÂÁ B‡" [boundp cl-closure-vars nil current-load-list] 2) #@171 (lexical-let BINDINGS BODY...): like `let', but lexically scoped. The main visible difference is that lambdas inside BODY will create lexical closures as in Common Lisp. (defalias 'lexical-let '(macro . #[(bindings &rest body) "Á \"ÅÆBÁÈ\f\"ÉC¤\n¤\" Ì!@ÍN„3ÎÁÏ\f\"ÐÁÑ\f\" \"E‚CÎÁÒ\f\"ÓÔÕÁÖ\f\"# F+‡" [cl-closure-vars mapcar #[(x) ":„CÁÂÃ@\"!\fB@Å!\f@E‡" [x gensym format "--%s--" cl-closure-vars cadr] 4] bindings vars cl-macroexpand-all progn body #[(x) "À @!Âà !DÄE‡" [symbol-name x symbol-value caddr t] 4] (defun . cl-defun-expander) cl-macro-environment ebody last used let #[(x) "À ! !D‡" [caddr x cadr] 3] sublis #[(x) "À !ÂÀ !DB‡" [caddr x quote] 4] #[(x) "À !ÂÃÄ @\"DD‡" [caddr x make-symbol format "--%s--"] 5] apply append (setf) #[(x) "ÀÁ\n!DÃ\n!D‡" [symbol-value caddr x cadr] 3]] 8 (#$ . 27417)])) #@173 (lexical-let* BINDINGS BODY...): like `let*', but lexically scoped. The main visible difference is that lambdas inside BODY will create lexical closures as in Common Lisp. (defalias 'lexical-let* '(macro . #[(bindings &rest body) "„Á\nB‡Ã!ƒÄʼnA@C\n#C‚\f\n@‡" [bindings progn body reverse list* lexical-let] 4 (#$ . 28259)])) (defalias 'cl-defun-expander #[(func &rest rest) "ÀÁ DÄÅBDE DE‡" [progn defalias quote func function lambda rest] 6]) #@411 (multiple-value-bind (SYM SYM...) FORM BODY): collect multiple return values. FORM must return a list; the BODY is then executed with the first N elements of this list bound (`let'-style) to each of the symbols SYM in turn. This is analogous to the Common Lisp `multiple-value-bind' macro, using lists to simulate true multiple return values. For compatibility, (values A B C) is a synonym for (list A B C). (defalias 'multiple-value-bind '(macro . #[(vars form &rest body) "À ÁÄÅ DÇÈ \"B\n#*‡" [gensym -1 n temp list* let* form mapcar #[(v) "Á\nT‰ ED‡" [v nth n temp] 4] vars body] 6 (#$ . 28725)])) #@366 (multiple-value-setq (SYM SYM...) FORM): collect multiple return values. FORM must return a list; the first N elements of this list are stored in each of the symbols SYM in turn. This is analogous to the Common Lisp `multiple-value-setq' macro, using lists to simulate true multiple return values. For compatibility, (values A B C) is a synonym for (list A B C). (defalias 'multiple-value-setq '(macro . #[(vars form) "„ Á\nÃE‡A„Ä@Å\nDE‡Æ È Ê\nDCËĉA@ÅDEÄÌÍÎÏ\"\"BEE*‡" [vars progn form nil setq car gensym temp 0 n let prog1 apply nconc mapcar #[(v) "Á\nT‰ ED‡" [v nth n temp] 4]] 10 (#$ . 29343)])) (defalias 'locally '(macro . #[(&rest body) "À B‡" [progn body] 2])) (defalias 'the '(macro . #[(type form) "‡" [form] 1])) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀ‡" [boundp cl-proclaim-history t current-load-list cl-declare-stack] 2) (defalias 'cl-do-proclaim #[(spec hist) "ƒ <ƒ \n B\n¢Ã=ƒ#ÄÅ!ƒîÆ\nA \"‚î\n¢Ç=ƒJ\nA‰ƒî\n@ÈNÉ>„@ÊË\n@\"ˆÌ\n@ÈÍ#ˆ‚*\n¢Î=ƒk\nA‰ƒî\n@ÈNÍ=ƒQÌ\n@ÈÏ#ˆ‚Q\n¢Ð=ƒ©Ñ\nAžA@ÒžÓ\nAžA@Ôž‰ƒ•@A@ƒ¥@A@*‚î\n¢Ù=ƒîÄÚ!ƒîÛ=ƒÁ\nA‰ƒî\n@:ƒÁÝ\n!Þ=ƒâßà\n!\"‚Ááà\n!\"‚Áχ" [hist cl-proclaim-history spec special boundp byte-compile-bound-variables append inline byte-optimizer (nil byte-compile-inline-expand) error "%s already has a byte-optimizer, can't make it inline" put byte-compile-inline-expand notinline nil optimize speed ((0 nil) (1 t) (2 t) (3 t)) safety ((0 t) (1 t) (2 t) (3 nil)) cl-optimize-speed byte-optimize cl-optimize-safety byte-compile-delete-errors warn byte-compile-warnings t byte-compile-warning-types cadar 0 delq caar adjoin] 5]) (byte-code "À BÂ! ƒÄ ‰A@Å\"ˆ‚Æ)Ƈ" [cl-proclaims-deferred current-load-list reverse p cl-do-proclaim t nil] 3) (defalias 'declare '(macro . #[(&rest specs) "À ƒ ƒ\n<ƒ @\nBà ‰A@Ä\"ˆ‚ć" [cl-compiling-file specs cl-declare-stack cl-do-proclaim nil] 3])) #@510 (define-setf-method NAME ARGLIST BODY...): define a `setf' method. This method shows how to handle `setf's to places of the form (NAME ARGS...). The argument forms ARGS are bound according to ARGLIST, as if NAME were going to be expanded as a macro, then the BODY forms are executed and must return a list of five elements: a temporary-variables list, a value-forms list, a store-variables list (of length one), a store-form, and an access- form. See `defsetf' for a simpler way to define most setf-methods. (defalias 'define-setf-method '(macro . #[(func args &rest body) "ÀÁ\n@;…ÃÄ DÆ\n‰A@FCÇ È \nB#C#‡" [append (eval-when (compile load eval)) body put quote func (quote setf-documentation) cl-transform-function-property setf-method args] 8 (#$ . 31270)])) #@839 (defsetf NAME FUNC): define a `setf' method. This macro is an easy-to-use substitute for `define-setf-method' that works well for simple place forms. In the simple `defsetf' form, `setf's of the form (setf (NAME ARGS...) VAL) are transformed to function or macro calls of the form (FUNC ARGS... VAL). Example: (defsetf aref aset). Alternate form: (defsetf NAME ARGLIST (STORE) BODY...). Here, the above `setf' call is expanded by binding the argument forms ARGS according to ARGLIST, binding the value form VAL to STORE, then executing BODY, which must return a Lisp form that does the necessary `setf' operation. Actually, ARGLIST and STORE may be bound to temporary variables which are introduced automatically to preserve proper execution order of the arguments. Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v)). (defalias 'defsetf '(macro . #[(func arg1 &rest args) "<ƒxÁÁÁÁÁÁ@A@ ÊËÌ \"! ÁÁÁ@;ƒD@Aƒ”@Ò=„”@Ó=ƒeA‰@‚‹@Ô>„‹@:ƒ{@@‚~@\nBÊËÌ\n@\"!\fBA‰„I\nŸ\fŸƒ¹Õ\nC\"ÊËÌ\"!Õ\fC\"‚½\n\f\n\fƒò@ØËÙ@\"DDB@@DBAA‚Ã*ƒDBÕÚE…CÜ ØËÙ \"DDƒ0ÕÝÞEDC\"‚2BŸßƒ>à‚?ß BƒJà‚Kß Bß DÜ  DBŸBBƒhà‚ißáD BB¯EC#.\f‡âãäåáDæE'@ƒ”ßè'éF‚–')¯‡" [arg1 nil largs largsr temps tempsr restarg rest-temps args store-var intern format "--%s--temp--" store-temp lets1 lets2 docstr p &aux &rest (&optional &key &allow-other-keys) append p2 p1 gensym "--%s--" define-setf-method func let* mapcar (quote gensym) list list* quote defsetf (&rest args) (store) cons (append args (list store)) call (quote progn) store] 14 (#$ . 32042)])) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#ˆÀÈÂÉ#ˆÀÊÂË#ˆÀÌÂÍ#ˆÀÎÂÏ#ˆÀÐÂÑ#ˆÀÒÂÓ#ˆÀÔÂÕ#ˆÀÖÂ×#ˆÀØÂÙ#ˆÀÚÂÛ#ˆÀÜÂÝ#ˆÀÞÂß#ˆÀàÂá#ˆÀâÂã#ˆÀäÂå#ˆÀæÂç#ˆÀèÂé#ˆÀêÂë#ˆÀìÂí#ˆÀîÂï#ˆÀðÂñ#ˆÀòÂó#ˆÀôÂõ#ˆÀöÂ÷#ˆÀøÂù#ˆÀúÂû#ˆÀüÂý#ˆÀþÂÿ#ˆÀ@ÂA#ˆÀBÂC#ˆÀDÂE#ˆÀFÂG#ˆÀHÂI#ˆÀJÂK#ˆÀLÂM#ˆÀNÂO#ˆÀPÂQ#ˆÀRÂS#ˆÀTÂU#ˆÀVÂW#ˆÀXÂY#ˆÀZÂ[#ˆÀ\\Â]#ˆÀ^Â_#ˆÀ`Âa#ˆÀbÂc#ˆÀdÂe#ˆÀfÂg#ˆÀhÂi#ˆÀjÂk#ˆÀlÂm#ˆÀnÂo#ˆÀpÂq#ˆÀrÂs#ˆÀtÂu#ˆÀvÂw#ˆÀxÂy#ˆÀzÂ{#ˆÀ|Â}#ˆÀ~Â#ˆÀ€Â#ˆÀ‚ƒ#ˆÀ„Â…#ˆÀ†Â‡#ˆÀˆÂ‰#ˆÀŠÂ‹#ˆÀŒÂ#ˆÀŽÂ#ˆÀ‘#ˆÀ’“#ˆÀ”•#ˆÀ–—#ˆÀ˜Â™#ˆÀšÂ›#ˆÀœÂ#ˆÀžÂŸ#ˆÀ Â¡#ˆÀ¢Â£#ˆÀ¤Â¥#ˆÀ¦Â§#ˆÀ¨Â©#ˆÀªÂ«#ˆÀ¬Â­#ˆÀ®Â¯#ˆÀ°Â±#ˆÀ²Â³#ˆÀ´Âµ#ˆÀ¶Â·#ˆÀ¸Â¹#ˆÀºÂ»#ˆÀ¼Â½#ˆÀ¾Â¿#‡" [put aref setf-method #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store aset append aref] 7] car #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store setcar append car] 7] cdr #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store setcdr append cdr] 7] elt #[(seq n) "ÀÁ!ÀÃ!ÀÅ!\n\fDDC\n\f ÊËDÌÍE EÎ FF+Ï\n\fE¯+‡" [gensym "--seq--" --seq--temp-- "--n--" --n--temp-- "--store--" --store--temp-- seq n store if listp setcar nthcdr aset elt] 10] get #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store put append get] 7] get* #[(x y &optional d) "ÀÁ!ÀÃ!ÀÅ!ÀÇ!\n\fE \n EC\n \f\n \fÍ \n\fF,Î\n\fF¯,‡" [gensym "--x--" --x--temp-- "--y--" --y--temp-- "--d--" --d--temp-- "--store--" --store--temp-- x y d store put get*] 8] gethash #[(x h &optional d) "ÀÁ!ÀÃ!ÀÅ!ÀÇ!\n\fE \n EC\n \f\n \fÍ \f\nF,Î\n\fF¯,‡" [gensym "--x--" --x--temp-- "--h--" --h--temp-- "--d--" --d--temp-- "--store--" --store--temp-- x h d store cl-puthash gethash] 8] nth #[(n x) "ÀÁ!ÀÃ!ÀÅ!\n\fDDC\n\f ÊËE E+Ì\n\fE¯+‡" [gensym "--n--" --n--temp-- "--x--" --x--temp-- "--store--" --store--temp-- n x store setcar nthcdr nth] 7] subseq #[(seq start &optional end) "ÀÁ!ÀÃ!ÀÅ!ÀÇ!\n\fE \n EC\n \f\n \fÍÎ \fÏ\nÐ ¯\fE,Ñ\n\fF¯,‡" [gensym "--seq--" --seq--temp-- "--start--" --start--temp-- "--end--" --end--temp-- "--new--" --new--temp-- seq start end new progn replace :start1 :end1 subseq] 11] symbol-function #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store fset append symbol-function] 7] symbol-plist #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store setplist append symbol-plist] 7] symbol-value #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set append symbol-value] 7] first #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store setcar append first] 7] second #[(x) "ÀÁ!ÀÃ!\nC C\fC\n\fÇÈ DE*É\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar cdr second] 6] third #[(x) "ÀÁ!ÀÃ!\nC C\fC\n\fÇÈ DE*É\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar cddr third] 6] fourth #[(x) "ÀÁ!ÀÃ!\nC C\fC\n\fÇÈ DE*É\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar cdddr fourth] 6] fifth #[(x) "ÀÁ!ÀÃ!\nC C\fC\n\fÇÈÉ EE*Ê\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 4 fifth] 7] sixth #[(x) "ÀÁ!ÀÃ!\nC C\fC\n\fÇÈÉ EE*Ê\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 5 sixth] 7] seventh #[(x) "ÀÁ!ÀÃ!\nC C\fC\n\fÇÈÉ EE*Ê\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 6 seventh] 7] eighth #[(x) "ÀÁ!ÀÃ!\nC C\fC\n\fÇÈÉ EE*Ê\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 7 eighth] 7] ninth #[(x) "ÀÁ!ÀÃ!\nC C\fC\n\fÇÈÉ EE*Ê\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 8 ninth] 7] tenth #[(x) "ÀÁ!ÀÃ!\nC C\fC\n\fÇÈÉ EE*Ê\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 9 tenth] 7] rest #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store setcdr append rest] 7] buffer-file-name #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-visited-file-name append buffer-file-name] 8] buffer-modified-p #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-buffer-modified-p append buffer-modified-p] 8] buffer-name #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn rename-buffer append buffer-name] 8] buffer-string #[nil "ÀÁ!É\nC\nÅÆÇ\fDE)ÈC¯)‡" [gensym "--store--" --store--temp-- nil store progn (erase-buffer) insert buffer-string] 7] buffer-substring #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store cl-set-buffer-substring append buffer-substring] 7] current-buffer #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-buffer append current-buffer] 7] current-case-table #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-case-table append current-case-table] 7] current-column #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn move-to-column append current-column] 8] current-global-map #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn use-global-map append current-global-map] 8] current-input-mode #[nil "ÀÁ!É\nC\nÅÆÇ\fE\fE)ÈC¯)‡" [gensym "--store--" --store--temp-- nil store progn apply set-input-mode current-input-mode] 7] current-local-map #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn use-local-map append current-local-map] 8] current-window-configuration #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-window-configuration append current-window-configuration] 8] default-file-modes #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-default-file-modes append default-file-modes] 8] default-value #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-default append default-value] 7] documentation-property #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store put append documentation-property] 7] extent-data #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-extent-data append extent-data] 7] extent-face #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-extent-face append extent-face] 7] extent-priority #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-extent-priority append extent-priority] 7] extent-end-position #[(ext) "ÀÁ!ÀÃ!\nC C\fC\n\fÇÈÉ DEE*Ê\nD¯*‡" [gensym "--ext--" --ext--temp-- "--store--" --store--temp-- ext store progn set-extent-endpoints extent-start-position extent-end-position] 7] extent-start-position #[(ext) "ÀÁ!ÀÃ!\nC C\fC\n\fÇÈÉ DEE*Ê\nD¯*‡" [gensym "--ext--" --ext--temp-- "--store--" --store--temp-- ext store progn set-extent-endpoints extent-end-position extent-start-position] 8] face-background #[(f &optional s) "ÀÁ!ÀÃ!ÀÅ!\n\fDDC\n\f Ê F+Ë\n\fE¯+‡" [gensym "--f--" --f--temp-- "--s--" --s--temp-- "--x--" --x--temp-- f s x set-face-background face-background] 7] face-background-pixmap #[(f &optional s) "ÀÁ!ÀÃ!ÀÅ!\n\fDDC\n\f Ê F+Ë\n\fE¯+‡" [gensym "--f--" --f--temp-- "--s--" --s--temp-- "--x--" --x--temp-- f s x set-face-background-pixmap face-background-pixmap] 7] face-font #[(f &optional s) "ÀÁ!ÀÃ!ÀÅ!\n\fDDC\n\f Ê F+Ë\n\fE¯+‡" [gensym "--f--" --f--temp-- "--s--" --s--temp-- "--x--" --x--temp-- f s x set-face-font face-font] 7] face-foreground #[(f &optional s) "ÀÁ!ÀÃ!ÀÅ!\n\fDDC\n\f Ê F+Ë\n\fE¯+‡" [gensym "--f--" --f--temp-- "--s--" --s--temp-- "--x--" --x--temp-- f s x set-face-foreground face-foreground] 7] face-underline-p #[(f &optional s) "ÀÁ!ÀÃ!ÀÅ!\n\fDDC\n\f Ê F+Ë\n\fE¯+‡" [gensym "--f--" --f--temp-- "--s--" --s--temp-- "--x--" --x--temp-- f s x set-face-underline-p face-underline-p] 7] file-modes #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-file-modes append file-modes] 8] frame-height #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-screen-height append frame-height] 8] frame-parameters #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn modify-frame-parameters append frame-parameters] 8] frame-visible-p #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store cl-set-frame-visible-p append frame-visible-p] 7] frame-width #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-screen-width append frame-width] 8] getenv #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn setenv append getenv] 8] get-register #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-register append get-register] 7] global-key-binding #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store global-set-key append global-key-binding] 7] keymap-parent #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-keymap-parent append keymap-parent] 7] local-key-binding #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store local-set-key append local-key-binding] 7] mark #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-mark append mark] 8] mark-marker #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-mark append mark-marker] 8] marker-position #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-marker append marker-position] 8] match-data #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn store-match-data append match-data] 8] mouse-position #[(scr) "ÀÁ!ÀÃ!\nC C\fC\n\fÇ ÈDÉDÊD¯*Ë\nD¯*‡" [gensym "--scr--" --scr--temp-- "--store--" --store--temp-- scr store set-mouse-position car cadr cddr mouse-position] 9] overlay-get #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store overlay-put append overlay-get] 7] overlay-start #[(ov) "ÀÁ!ÀÃ!\nC C\fC\n\fÇÈ É DFE*Ê\nD¯*‡" [gensym "--ov--" --ov--temp-- "--store--" --store--temp-- ov store progn move-overlay overlay-end overlay-start] 9] overlay-end #[(ov) "ÀÁ!ÀÃ!\nC C\fC\n\fÇÈ É DFE*Ê\nD¯*‡" [gensym "--ov--" --ov--temp-- "--store--" --store--temp-- ov store progn move-overlay overlay-start overlay-end] 8] point #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store goto-char append point] 7] point-marker #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn goto-char append point-marker] 8] point-max #[nil "ÀÁ!É\nC\nÅÆÇ\fE\fE)ÈC¯)‡" [gensym "--store--" --store--temp-- nil store progn narrow-to-region (point-min) point-max] 7] point-min #[nil "ÀÁ!É\nC\nÅÆ\fÇE\fE)ÈC¯)‡" [gensym "--store--" --store--temp-- nil store progn narrow-to-region (point-max) point-min] 7] process-buffer #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-process-buffer append process-buffer] 7] process-filter #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-process-filter append process-filter] 7] process-sentinel #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-process-sentinel append process-sentinel] 7] read-mouse-position #[(scr) "ÀÁ!ÀÃ!\nC C\fC\n\fÇ ÈDÉDF*Ê\nD¯*‡" [gensym "--scr--" --scr--temp-- "--store--" --store--temp-- scr store set-mouse-position car cdr read-mouse-position] 8] screen-height #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-screen-height append screen-height] 8] screen-width #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-screen-width append screen-width] 8] selected-window #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store select-window append selected-window] 7] selected-screen #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store select-screen append selected-screen] 7] selected-frame #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store select-frame append selected-frame] 7] standard-case-table #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-standard-case-table append standard-case-table] 7] syntax-table #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-syntax-table append syntax-table] 7] visited-file-modtime #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-visited-file-modtime append visited-file-modtime] 8] window-buffer #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-window-buffer append window-buffer] 8] window-display-table #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-window-display-table append window-display-table] 8] window-dedicated-p #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn set-window-dedicated-p append window-dedicated-p] 8] window-height #[nil "ÀÁ!É\nC\nÅÆÇ\fÈED\fE)ÉC¯)‡" [gensym "--store--" --store--temp-- nil store progn enlarge-window - (window-height) window-height] 8] window-hscroll #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-window-hscroll append window-hscroll] 7] window-point #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-window-point append window-point] 7] window-start #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉ\nC\"*BÆÊ \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store set-window-start append window-start] 7] window-width #[nil "ÀÁ!É\nC\nÅÆÇ\fÈEÉE\fE)ÊC¯)‡" [gensym "--store--" --store--temp-- nil store progn enlarge-window - (window-width) t window-width] 8] x-get-cutbuffer #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn x-store-cutbuffer append x-get-cutbuffer] 8] x-get-cut-buffer #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn x-store-cut-buffer append x-get-cut-buffer] 8] x-get-secondary-selection #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn x-own-secondary-selection append x-get-secondary-selection] 8] x-get-selection #[(&rest args) "ÀÁ\n\"ÁÄ!Æ !Æ\n! C  ÈÉÊ\nC\"BE*ÆË \"¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- list* store progn x-own-selection append x-get-selection] 8] apply #[(func arg1 &rest rest) "¢Á>ƒ£¢9„ÂÃ\"ˆA@\f BBÇ\"‰ @ A@Ê 8ËÌ 8Í! @#ËÎ 8Í! @#¯*‡" [func (quote function function*) error "First arg to apply in setf is not (function SYM): %s" arg1 rest form get-setf-method cl-macro-environment method 2 cl-setf-make-apply 3 cadr 4] 9]] 4) (defalias 'cl-setf-make-apply #[(form func temps) "@Á=ƒÂÁÃÄ! #Ç!#‡È!È!š„&ÉÊ \"ˆÂËÌ@DA#‡" [form progn list* cl-setf-make-apply cadr func temps cddr last error "%s is not suitable for use with setf-of-apply" apply quote] 6]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#‡" [put nthcdr setf-method #[(n place) "À \n\"ÃÄ!ÃÅ!@B A@BCÊË8@ÌÍ8FDCÎ8FÏÍ8E¯+‡" [get-setf-method place cl-macro-environment gensym "--nthcdr-n--" "--nthcdr-store--" store-temp n-temp method n let 2 cl-set-nthcdr 4 3 nthcdr] 9] getf #[(place tag &optional def) "À \n\"ÃÄ!ÃÅ!ÃÆ! \nË\n@ D\"Ë\nA@\f D\"CÎÏ\n8@ÐÑ\n8 FDCÒ\n8FÓÑ\n8 F¯,‡" [get-setf-method place cl-macro-environment gensym "--getf-tag--" "--getf-def--" "--getf-store--" store-temp def-temp tag-temp method append tag def let 2 cl-set-getf 4 3 getf] 9] substring #[(place from &optional to) "À \n\"ÃÄ!ÃÅ!ÃÆ! \nË\n@ D\"Ë\nA@\f D\"CÎÏ\n8@ÐÑ\n8 ¯DCÒ\n8FÓÑ\n8 F¯,‡" [get-setf-method place cl-macro-environment gensym "--substring-from--" "--substring-to--" "--substring-store--" store-temp to-temp from-temp method append from to let 2 cl-set-substring 4 3 substring] 10]] 4) #@168 Return a list of five values describing the setf-method for PLACE. PLACE may be any Lisp form which can appear as the PLACE argument to a macro like `setf' or `incf'. (defalias 'get-setf-method #[(place &optional env) "9ƒÁÂ!ĉ CÅ E¯)‡@9ƒ‹@Ç!ÉN\nÄ \nƒ`\f Î\nA\"‰\n)ƒ`\n:ƒX\nGÏUƒX\n‚]ÐÑ\"†‡Ò ÔŽÕÖ\"*ƒw×Ø!!†‡Ù=…‡×GS8\f\",†ÁÚ\f\"‰=ƒ¼@9ƒ¶Û@!ƒ¶@K9ƒ¶×@KAB\f\"‡ÐÜ@\"‡×\f\"‡" [place gensym "--setf--" temp nil setq func symbol-name name setf-method method case-fold-search env cl-macro-environment apply 5 error "Setf-method for %s returns malformed method" match-data match-data ((store-match-data match-data)) string-match "\\`c[ad][ad][ad]?[ad]?r\\'" get-setf-method compiler-macroexpand edebug-after macroexpand fboundp "No setf-method known for %s"] 6 (#$ . 54127)]) (defalias 'cl-setf-do-modify #[(place opt-expr) "À \n\"‰@ A@ÆÆ Ê=?…1 Ë=„(Ì !†1ÍÎ 8@Ï 8\"‰…@ :…@Ñ A! ƒx„RÓ @!ƒe\f‰A@ ‰A@BB‚B\f‰A@ ‰A@DB‚BŸÎ 8@ÔÏ 8\"BÔÕ 8\"E.‡" [get-setf-method place cl-macro-environment method temps values nil lets subs opt-expr no-opt unsafe cl-safe-expr-p cl-setf-simple-store-p 2 3 optimize cl-simple-exprs-p simple cl-const-expr-p sublis 4] 7]) (defalias 'cl-setf-do-store #[(spec val) "@AÃ\f!„\"Å\f!ƒÆ \n\"Ç=„\"È\n \"ƒ*É\f\n #‚1Ê\n\fDC E*‡" [spec form sym cl-const-expr-p val cl-simple-expr-p cl-expr-contains 1 cl-setf-simple-store-p subst let] 4]) (defalias 'cl-setf-simple-store-p #[(sym form) ":…,Á\n\"Ã=…,GS8\n=…,@9…,Ä@!…,@K¢Å=?‡" [form cl-expr-contains sym 1 fboundp macro] 3]) #@325 (setf PLACE VAL PLACE VAL ...): set each PLACE to the value of its VAL. This is a generalized version of `setq'; the PLACEs may be symbolic references such as (car x) or (aref x i), as well as plain symbols. For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y). The return value is the last VAL in the list. (defalias 'setf '(macro . #[(&rest args) "AAƒ$ÁƒÃ‰A@‰A@E\nB‚Ä\nŸ)B‡@9ƒ2…YÅB‡Æ@A@\"ÈA@A@\" @ƒVÊ@ E‚X *‡" [args nil sets setf progn setq cl-setf-do-modify method cl-setf-do-store store let*] 4 (#$ . 55738)])) #@206 (psetf PLACE VAL PLACE VAL ...): set PLACEs to the values VALs in parallel. This is like `setf', except that all VAL forms are evaluated (in order) before assigning any PLACEs to the corresponding values. (defalias 'psetf '(macro . #[(&rest args) "Á ƒ@ @9ƒÆ A@ \"ƒÂ @ >ƒ(ÇÈ @\"ˆ ‰A@ B „8ÇÉ!ˆ ‰Aˆ‚\fƒMÊËBÂE‚xÌ!ËÍ!@EÏ!‰ƒrËÍ!Ð@EE‚ZÊÂE)+‡" [args t nil vars simple p cl-expr-depends-p error "Destination duplicated in psetf: %s" "Odd number of arguments to psetf" progn setf reverse cadr expr cddr prog1] 5 (#$ . 56310)])) (defalias 'cl-do-pop #[(place) "À !ƒÂà DÄ Å DEE‡Æ Ç\"ÉÊ! ÌÍ@ Î8DC\"Âà DÏA@Å D\"EE*‡" [cl-simple-expr-p place prog1 car setf cdr cl-setf-do-modify t method gensym "--pop--" temp let* append 2 cl-setf-do-store] 8]) #@193 (remf PLACE TAG): remove TAG from property list PLACE. PLACE may be a symbol, or any generalized variable allowed by `setf'. The form returns true if TAG was found and removed, nil otherwise. (defalias 'remf '(macro . #[(place tag) "À Â\"Ä !?…ÆÇ!É !?…ÆÊ! †# \f †-Í 8ÏÐ @ …? Í 8DC…I DC#ÑÒ\fÓDEÔÕ A@ÖD\"ÂE×\fEFE-‡" [cl-setf-do-modify place t method cl-const-expr-p tag gensym "--remf-tag--" tag-temp cl-simple-expr-p "--remf-place--" val-temp ttag 2 tval let* append if eq car progn cl-setf-do-store cddr cl-do-remf] 9 (#$ . 57101)])) #@198 (shiftf PLACE PLACE... VAL): shift left among PLACEs. Example: (shiftf A B C) sets A to B, B to C, and returns the old A. Each PLACE may be a symbol, or any generalized variable allowed by `setf'. (defalias 'shiftf '(macro . #[(place &rest args) "ÀÁÂÃ\f B!\">„0ÆÇ\fÀ ƒ*É\f @EB ‰A@‚Ÿ)#‡Ê\f B!‰ ‰A @\f ƒiÍ ‰A @Î\"Ð@ÇÑ8ÒA@\f\"EE\f)‚?\f*‡" [nil mapcar symbolp butlast place args list* prog1 sets setq reverse places form cl-setf-do-modify unsafe method let* 2 cl-setf-do-store] 8 (#$ . 57673)])) #@197 (rotatef PLACE...): rotate left among PLACEs. Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. Each PLACE may be a symbol, or any generalized variable allowed by `setf'. (defalias 'rotatef '(macro . #[(&rest args) "ÀÁ \">„1 A…ŠÀ @ Aƒ& ‰A@ @D¤‚ÆC ¤ @\fD¤*‡Ç !ÉÊ!‰ \fAƒi͉A@Î\"Ð@ÑÒ8ÓA@\f\"EE\f)‚>Í@Î\"ÐÔ@ Ò8DC\"ÓA@\f\"ÀF,‡" [nil mapcar symbolp args first sets psetf reverse places gensym "--rotatef--" temp form cl-setf-do-modify unsafe method let* prog1 2 cl-setf-do-store append] 8 (#$ . 58205)])) #@533 (letf ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. This is the analogue of `let', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding VALUE, then the BODY forms are executed. On exit, either normally or because of a `throw' or error, the PLACEs are set back to their original values. Note that this macro is *not* available in Common Lisp. As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', the PLACE is not modified before executing BODY. (defalias 'letf '(macro . #[(bindings &rest body) "A„Á!ƒÂ!9ƒÃÄ #‡Æ‰‰Ç! \n ƒÂ!9ƒ>ÌÍÂ!DD‚BÂ!Ï!ÑÒ\"ÔÕ!@×>…aÔØ!Ú!?…sA…sÔÛ!@ƒ£@Ì=ƒ‹Ý‚ŒÞß8A@DDàß8EDD‚«ß8DC¤…·DC¤ ¤ áâ@AƒØãA@†Ò\" B‚Ù BƒäãA@\"@Ì=ƒöå‚÷æß8A@DF‚\nãA@\"ECA.‚&Ãç #,‡" [bindings cdar caar list* let body nil reverse rev unsets sets lets symbol-value quote place cadar value cl-setf-do-modify no-opt method gensym "--letf-save--" save (symbol-value symbol-function) "--letf-bound--" bound cl-const-expr-p "--letf-val--" temp boundp fboundp 2 and unwind-protect progn cl-setf-do-store if makunbound fmakunbound let*] 8 (#$ . 58781)])) #@535 (letf* ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. This is the analogue of `let*', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding VALUE, then the BODY forms are executed. On exit, either normally or because of a `throw' or error, the PLACEs are set back to their original values. Note that this macro is *not* available in Common Lisp. As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', the PLACE is not modified before executing BODY. (defalias 'letf* '(macro . #[(bindings &rest body) "„Á\nB‡Ã!ƒÄʼnA@C\n#C‚\f\n@‡" [bindings progn body reverse list* letf] 4 (#$ . 60030)])) #@177 (callf FUNC PLACE ARGS...): set PLACE to (FUNC PLACE ARGS...). FUNC should be an unquoted function name. PLACE may be a symbol, or any generalized variable allowed by `setf'. (defalias 'callf '(macro . #[(func place &rest args) "À  B\"Å\f8 BÇ\f@È\fA@ 9ƒ# B‚,ÊËÌ D#\"E*‡" [cl-setf-do-modify place list args method 2 rargs let* cl-setf-do-store func list* funcall function] 8 (#$ . 60722)])) #@146 (callf2 FUNC ARG1 PLACE ARGS...): set PLACE to (FUNC ARG1 PLACE ARGS...). Like `callf', but PLACE is the second argument of FUNC, not the first. (defalias 'callf2 '(macro . #[(func arg1 place &rest args) "À !ƒ !ƒ\f9ƒÅ Æ\f $E‡È ÉB\"\nË !?…/ÌÍ!Ɔ8 Ï\n8#ÑÒ…M DC\n@\"Ó\nA@\f9ƒb\fB‚jÆÔÕ\fD#\"E+‡" [cl-safe-expr-p arg1 cl-simple-expr-p place func setf list* args cl-setf-do-modify list method cl-const-expr-p gensym "--arg1--" temp 2 rargs let* append cl-setf-do-store funcall function] 8 (#$ . 61133)])) #@224 (define-modify-macro NAME ARGLIST FUNC): define a `setf'-like modify macro. If NAME is called, it combines its PLACE argument with the other arguments from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +) (defalias 'define-modify-macro '(macro . #[(name arglist func &optional doc) "À >ƒ\nÂÃ!ˆÄÅ!Ç B ÊË >ƒ#Ê‚$ÌÍÎDÐ !%¯)‡" [&key arglist error "&key not allowed in define-modify-macro" gensym "--place--" place defmacro* name doc list* &rest list (quote callf) quote func cl-arglist-args] 11 (#$ . 61676)])) #@289 (defstruct (NAME OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type. This macro defines a new Lisp data type called NAME, which contains data stored in SLOTs. This defines a `make-NAME' constructor, a `copy-NAME' copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors. (defalias 'defstruct '(macro . #[(struct &rest descs) ":ƒ\n@‚ £ÃÃÆ !ÇPÉÊË \"!\fà ÉÊÎ \"!ÉÊÐ \"!ÃÃÔ ƒE‚FÖÃÉÊÙ \"!ÉÊÛ \"!ÃÃÃà Ã!Ã\"Ã#Ã$%@;ƒŒæç Dè%‰A%@F\"B\"éêë%\"B%\nƒ†\n@:ƒ¥ì\n!‚§\n@\n‰A@£-‰.ï=ƒÐ-ƒ‚-@ƒÊÆ-@!‚Ëð‚‚.ñ=ƒô-Aƒç- B ‚‚-ƒ‚-@\f‚‚.ò=ƒ-ƒ‚-@‚‚.ó=ƒ-ƒ‚-@‚‚.ô=ƒ<-@êõ-A\"ÉÊÛ\"!‚‚.ö=ƒK-@‚‚.÷=ƒZ-@ ‚‚.ø=ƒgù!‚‚.ú=ƒ|û-@ü\"%¤%‚‚ýþ.\"ˆ*‚•ƒ§ÿ@ADBCD¯ùE‚Þ „ÞƒºENƒÞù„Ç ƒÍ?…ÜÿFÊG \"CEDƒ€HNINJ‰K„ÿýL\"ˆ ƒK@ =„ýM \"ˆƒ=ì!Jž†.ýNì!#J>‰A@ ˆ‚OJPQ%ž%\"\"%K@ Q%ž!RK!ƒm ù!SçDE\"B\"*‚« ƒ¡ T>„–ýU \"ˆ!ƒ« ‚«V W!!„¾PQ%ž%\"%XD\"B\"!…6%GQ%ž%>GZY V=ƒ\nZ[\\]%GE^_BYEEF‚5Y`Uƒ^aE‚5Zb^cYBEEE)‰#…j`V…jd#!e=ƒhfUƒhZg#!B‚j#$`%hYhƒ©h‰Ah@‰i@‰jk>ƒ¦Ã\fBjQ=… çD B‚ jhžƒ·ýlj #ˆÉÊmj#!nj\fBiA@ BopnqO$…÷r$ýÊsn #BEEC V=ƒ\f_BYE‚$Y`Uƒt‚$cYBEC\"$\"B\"nùBBunvRwxi!>!ƒZýÊyn\"D‚tzBç DçnD$…pç$DY¯F\"B\"ƒŸFÊ{j\"CE|nBDCED¤ˆ)*YTY‚u*\fŸ Ÿƒð#ƒðp}#@Z=ƒØO#~\"‚ßZ#ùEF\"B\"BBƒ€‚F\"B\"ùBB\fƒ*\fƒPÄ\f!\"BD B  ƒŽì !R ‰A @!-…-!†‡ˆ\f #‰p oŠçÃ%BD-# ‰BF\"B\"‹ÿêŒ%\"B!ƒŠ ùBB,‚*ƒœùD¤ˆƒÀŽAZ#EED‘E\"B\"’“çDDE\"B\"o”•æç D–ç%DFæç D—ç !ù=DDFæç D˜Fê™\"&\"B\"ÿç D\"BŸ.B‡" [struct name opts nil slots defaults symbol-name "-" conc-name intern format "make-%s" constructor constrs "copy-%s" copier "%s-p" predicate print-func print-auto cl-compiling-file cl-optimize-safety 3 safety include "cl-struct-%s" tag "cl-struct-%s-tags" tag-symbol include-descs include-tag-symbol side-eff type named forms pred-form pred-check descs put quote (quote structure-documentation) (cl-tag-slot) mapcar #[(x) ":ƒ‡C‡" [x] 1] caar args opt :conc-name "" :constructor :copier :predicate :include #[(x) ":ƒ‡C‡" [x] 1] :print-function :type :named t :initial-offset make-list (cl-skip-slot) error "Slot option %s unrecognized" progn funcall function cl-x cl-s cl-n cl-struct-print princ "#S(%s" cl-struct-type cl-struct-slots old-descs inc-type "%s is not a struct name" ":type disagrees with :include for %s" "No slot %s in included struct %s" append delq cl-tag-slot cadr pushnew (vector list) "Illegal :type specifier: %s" vector true defvar pos and (vectorp cl-x) >= (length cl-x) memq aref 0 (car-safe cl-x) (consp cl-x) nth caadr vectorp 1 cdddr descp desc slot (cl-tag-slot cl-skip-slot) "Duplicate slots named %s in %s" "%s%s" accessor list* defsubst* (cl-x) or "%s accessing a non-%s" (car cl-x) define-setf-method (cl-x) :read-only cddr "%s is a read-only slot" cl-struct-setf-expander " %s" prin1 (cl-x) (t) error-free defun (x) (copy-sequence x) &key copy-sequence cl-arglist-args anames mapcar* #[(s d) " >ƒ‡\n‡" [s anames d] 2] make &cl-defs cl-safe-expr-p second (princ ")" cl-s) push lambda (cl-x cl-s cl-n) custom-print-functions setq list eval-when (compile load eval) (quote cl-struct-slots) (quote cl-struct-type) (quote cl-struct-print) #[(x) "ÀÁ\n@DÃÁ\nADF‡" [put quote x (quote side-effect-free)] 5]] 13 (#$ . 62222)])) (defalias 'cl-struct-setf-expander #[(x name accessor pred-form pos) "ÀÁ!ÀÃ!\nC C\fCÆÇ…(ÉÊ\nË#ÌÍÎ#\nEECÑN@Ò=ƒ;Ó\n\fF‚gÕÖXƒ`\nS‰ØYƒZÙD‚F)‚eÚ\nE\fEC#\nD¯*‡" [gensym "--x--" temp "--store--" store x append (progn) pred-form or subst cl-x error format "%s storing a non-%s" accessor name cl-struct-type vector aset pos setcar 5 xx 0 cdr nthcdr] 12]) #@130 (deftype NAME ARGLIST BODY...): define NAME as a new data type. The type name can then be used in `typecase', `check-type', etc. (defalias 'deftype '(macro . #[(name args &rest body) "ÀÁ ÄÅÆÇ# B#E‡" [eval-when (compile load eval) cl-transform-function-property name cl-deftype-handler list* &cl-defs (quote ((quote *))) args body] 9 (#$ . 66356)])) (defalias 'cl-make-type-test #[(val type) "Á>ƒÂ9ƒpÃNƒÄ ÃN \"‡Æ>ƒ#‡Ç=ƒ-Ç D‡È=ƒ7É D‡Ê=ƒAË D‡Ì=ƒKÍ D‡Î!ÐÑP!Ó!ƒf D‚nÐÔP! D*‡@ÃNƒƒÄ Õ@ÃNA\"\"‡¢Ö>ƒÙ×ØÙÄ @\"Ú!Û>ƒžØ‚´Ú!:ƒ®Ü Ý!E‚´Þ Ú!Eß!à>ƒÀØ‚Öß!:ƒÐá â!E‚Öã ß!EF\"‡¢ä>ƒé@åæA\"B‡¢ç>ƒûÙè éADEØE‡¢ê=ƒÚ! D‡ëì\"‡" [type (character string-char) (integer 0 255) cl-deftype-handler cl-make-type-test val (nil t) null float floatp-safe real numberp fixnum integerp symbol-name name intern "p" namep fboundp "-p" apply (integer float real number) delq t and cadr (* nil) > caadr >= caddr (* nil) < caaddr <= (and or not) mapcar #[(x) "À \n\"‡" [cl-make-type-test val x] 3] (member member*) member* quote satisfies error "Bad type spec: %s"] 9]) #@80 Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier. (defalias 'typep #[(val type) "ÀÁ \"!‡" [eval cl-make-type-test val type] 4 (#$ . 67462)]) #@114 Verify that FORM is of type TYPE; signal an error if not. STRING is an optional description of the desired type. (defalias 'check-type '(macro . #[(form type &optional string) "À ƒ ÂW„ ÂU…WÄ Â\"ƒ ‚Æ ÈÉ\n\"ËÌ͆3Ï\nDÏ DFEE =ƒLÑÒE‚VÓ DCÒF*‡" [cl-compiling-file cl-optimize-speed 3 cl-optimize-safety cl-simple-expr-p form gensym temp or cl-make-type-test type signal (quote wrong-type-argument) list string quote body progn nil let] 9 (#$ . 67640)])) #@317 Verify that FORM returns non-nil; signal an error if not. Second arg SHOW-ARGS means to include arguments of FORM in message. Other args STRING and ARGS... are arguments to be passed to `error'. They are not evaluated unless the assertion fails. If STRING is omitted, a default message listing FORM itself is used. (defalias 'assert '(macro . #[(form &optional show-args string &rest args) "À ƒ ÂW„ ÂU…G\f…ÅÆÇÈ A\"\"\nËÌ  ƒ7ÎÏ Ð\n\"#‚CÒÓÎÔÕ D\n#EEÆE)‡" [cl-compiling-file cl-optimize-speed 3 cl-optimize-safety show-args delq nil mapcar #[(x) "À !?… ‡" [cl-const-expr-p x] 2] form sargs progn or string list* error append args signal (quote cl-assertion-failed) list quote] 9 (#$ . 68127)])) #@87 Execute FORMS; if an error occurs, return nil. Otherwise, return result of last FORM. (defalias 'ignore-errors '(macro . #[(&rest body) "À  Ã\fBÅF)‡" [gensym err condition-case progn body (error nil)] 4 (#$ . 68847)])) (byte-code "ÀÁ\nBÃÄ\nBÁ‡" [(car cdr nth aref elt if and or + - 1+ 1- min max car-safe cdr-safe progn prog1 prog2) cl-simple-funcs current-load-list (* / % length memq list vector vectorp < > <= >= = error) cl-safe-funcs] 2) (defalias 'cl-simple-expr-p #[(x &optional size) "„Á\n:ƒG\n@Ã>„G\n@9…O\n@\f>„&\n@ÅN…OS\nA‰ƒ:Æ\n@\"‰„)\n?…FÇY…F‡ÇV…OS‡" [size 10 x (quote function function*) cl-simple-funcs side-effect-free cl-simple-expr-p 0] 3]) (defalias 'cl-simple-exprs-p #[(xs) "ƒÁ@!ƒA‰„?‡" [xs cl-simple-expr-p] 3]) (defalias 'cl-safe-expr-p #[(x) ":…\n@Á>??†9@9…9@\n>„)@ >„)@ÄN…9A‰ƒ7Å@!„)?‡" [x (quote function function*) cl-simple-funcs cl-safe-funcs side-effect-free cl-safe-expr-p] 2]) (defalias 'cl-const-expr-p #[(x) ":ƒ%@Á=†3@Â>…$A@9†$A@¢Ã=…$ć9ƒ2Å>…3ƇƇ" [x quote (function function*) lambda func (nil t) t] 2]) (defalias 'cl-const-exprs-p #[(xs) "ƒÁ@!ƒA‰„?‡" [xs cl-const-expr-p] 3]) (defalias 'cl-const-expr-val #[(x) "À !Â=… :ƒ A@‡ ‡" [cl-const-expr-p x t] 2]) (defalias 'cl-expr-access-order #[(x v) "À !ƒ\n‡ :ƒ A‰ƒà @\n\"‚ \n‡ \n@=ƒ)\nA‡Ä‡" [cl-const-expr-p x v cl-expr-access-order (t)] 3]) (defalias 'cl-expr-contains #[(x y) " šƒ‡ :ƒ5 ¢Ã>„5Ä ƒ, Æ ‰A@\"†'Ä\\‚ ÄV…3 )‡Ç‡" [y x 1 (quote function function*) 0 sum cl-expr-contains nil] 4]) (defalias 'cl-expr-contains-any #[(x y) "ƒÁ\n@\"„‰Aˆ‚‡" [y cl-expr-contains x] 3]) (defalias 'cl-expr-depends-p #[(x y) "À !?… !?†à \f\"‡" [cl-const-expr-p x cl-safe-expr-p cl-expr-contains-any y] 3]) #@684 (define-compiler-macro FUNC ARGLIST BODY...): Define a compiler-only macro. This is like `defmacro', but macro expansion occurs only if the call to FUNC is compiled (i.e., not interpreted). Compiler macros should be used for optimizing the way calls to FUNC are compiled; the form returned by BODY should do the same thing as a call to the normal function called FUNC, though possibly more efficiently. Note that, like regular macros, compiler macros are expanded repeatedly until no further expansions are possible. Unlike regular macros, BODY can decide to "punt" and leave the original function call alone by declaring an initial `&whole foo' parameter and then returning foo. (defalias 'define-compiler-macro '(macro . #[(func args &rest body) "<ƒ ‚\fÁDÂ\f:ƒ\f‰A@ B‚ Ÿ \f…*Á\fD¡ˆ*ÅÆÇÉÊ>ƒ@ËÊ\"‚CÌB B#ÎÏÐDÑEÒÐDÓÔFEF‡" [args &rest nil res p eval-when (compile load eval) cl-transform-function-property func cl-compiler-macro &whole delq --cl-whole-arg-- body or get quote (quote byte-compile) put (quote byte-compile) (quote cl-byte-compile-compiler-macro)] 9 (#$ . 70652)])) (defalias 'compiler-macroexpand #[(form) "¢Á‰9ƒ0 ÄN‰„0Å !ƒ0 K¢Æ=ƒ)Ç KA@!ƒ0 K‰‚\n…?È\n‰A#‰=?*„‡" [form nil handler func cl-compiler-macro fboundp autoload load apply] 6]) (defalias 'cl-byte-compile-compiler-macro #[(form) "Á!‰=ƒÂ!‡Ã!‡" [form compiler-macroexpand byte-compile-normal-call byte-compile-form] 3]) #@244 (defsubst* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. Like `defun', except the function is automatically declared `inline', ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...). (defalias 'defsubst* '(macro . #[(name args &rest body) "À !‰Ä BÇ!? ƒ(É @\"Ê=ƒ( ‰Aˆ‚Ä ?…\\Ë\fÍÎÏÐ $ÍÑÒ\nDÒÍÓ\f #D†NÔ\n\"?Õ >…VÏ\n&FÍÖ\f $E,‡" [cl-arglist-args args argns p progn body pbody cl-safe-expr-p unsafe cl-expr-contains 1 define-compiler-macro name list* &whole cl-whole &cl-quote cl-defsubst-expand quote block cl-expr-access-order &key defun*] 13 (#$ . 72102)])) (defalias 'cl-defsubst-expand #[(argns body simple whole unsafe &rest argvs) "ƒÁ B!„‡Ä !ƒÅÇÈÉÊ #\"‰\fƒ/Í\fE‚1)‡" [whole cl-safe-expr-p progn argvs cl-simple-exprs-p t simple delq nil mapcar* #[(argn argv) "„\nÁ\n!ƒÃ\n\f #…\f\nD‡\f\nD‡" [simple cl-const-expr-p argv subst argn body unsafe] 4] argns lets let body] 7]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#ˆÁÂN„ÀÁÂÆ#ˆÀÇÄÈ#ˆÇÂN„*ÀÇÂÆ#ˆÀÉÄÊ#ˆÉÂN„<ÀÉÂÆ#ˆÀËÄÌ#ˆËÂN„NÀËÂÆ#ˆÀÍÄÎ#ˆÍÂN„`ÀÍÂÆ#ˆÀÏÄÐ#ˆÏÂN„rÀÏÂÆ#ˆÀÑÄÒ#ˆÑÂN„„ÀÑÂÆ#ˆÓÔÕ\"ˆÖ×!ˆÓØÙ\"ˆÓÚÛ\"ˆÜÝ!‡" [put eql byte-compile nil cl-compiler-macro #[(form a b) "À !Â=ƒ%à !‰§ƒ\f¨„Å E‚#Ç E)‡À!Â=ƒLÃ!‰§ƒE\f¨„EÅ E‚JÇ E)‡È É\"ƒcÊË DÅ EÇ EF‡Ì !ƒ‚ÈÉ\"ƒ‚ÊËDÅ EÇ EF‡ ‡" [cl-const-expr-p a t cl-const-expr-val val equal b eq cl-simple-expr-p 5 if numberp cl-safe-expr-p form] 7] cl-byte-compile-compiler-macro member* #[(form a list &rest keys) "GÁU…@Â=…ÃA@!‰Å=ƒ#ÆE‚Ü\fÉ=ƒ2ÊE‚܃<\fË=ƒÚÌ!Í=ƒ[ÎÃ!!ƒRÊ‚SÆE‚ÜÌ!Í=ƒÕÃ!ω‰A„†…ÑËÓ@DE‚у³Î@!ƒ™Í‚ª@¨„ª@9„ªÍA‰„‹„ÁÆE‚Ñ„ÏÊE‚Ñ+‚Ü‚Ü)‡" [keys 2 :test cl-const-expr-val test eq memq a list equal member eql cl-const-expr-p t floatp-safe nil mq mb p quote form] 5] assoc* #[(form a list &rest keys) "GÁU…@Â=…ÃA@!‰Å=ƒ#ÆE‚b\fÉ=ƒ2ÊE‚bË!Ì=ƒ`ƒE\fÍ=ƒ`ÎÃ!!ƒWÊE‚bÆE‚b)‡" [keys 2 :test cl-const-expr-val test eq assq a list equal assoc cl-const-expr-p t eql floatp-safe form] 4] adjoin #[(form a list &rest keys) "À !ƒ À\n!ƒ Ã\f>„ ÅÆÇ \n\f$\nÈ \nEF‡ ‡" [cl-simple-expr-p a list :key keys if list* member* cons form] 6] list* #[(--cl-whole-arg-- arg &rest others) "À \nB!‰@ A‰ƒÅ @\fE‚ \f*‡" [reverse arg others args form cons] 4] get* #[(--cl-whole-arg-- sym prop &optional def) "ƒ\fÁ D\fF‡Å \fE‡" [def getf symbol-plist sym prop get] 4] typep #[(form val type) "À !ƒ4Â Ä !\"Æ \"Ç>„È !ƒ ‚2É \nË\n DCÌ\n #E))‡ ‡" [cl-const-expr-p type cl-make-type-test val cl-const-expr-val res cl-expr-contains (nil 1) cl-simple-expr-p gensym temp let subst form] 6] mapcar #[(y) "À @ÂÃ#ˆÀ @ÄÅ#ˆÀ @ÆÇÈÉ !9ƒ-ÊËÉ !DÊËÌ !DÍEE‚1Ê ABE#‡" [put y side-effect-free t byte-compile cl-byte-compile-compiler-macro cl-compiler-macro lambda (w x) cadr list quote caddr x] 11] ((first (quote car) x) (second (quote cadr) x) (third (quote caddr) x) (fourth (quote cadddr) x) (fifth (quote nth) 4 x) (sixth (quote nth) 5 x) (seventh (quote nth) 6 x) (eighth (quote nth) 7 x) (ninth (quote nth) 8 x) (tenth (quote nth) 9 x) (rest (quote cdr) x) (endp (quote null) x) (plusp (quote >) x 0) (minusp (quote <) x 0) (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr) (caaar car caar) (caadr car cadr) (cadar car cdar) (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr) (cddar cdr cdar) (cdddr cdr cddr) (caaaar car caaar) (caaadr car caadr) (caadar car cadar) (caaddr car caddr) (cadaar car cdaar) (cadadr car cdadr) (caddar car cddar) (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr) (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar) (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr)) proclaim (inline floatp-safe acons map concatenate notany notevery cl-set-elt revappend nreconc gethash) #[(x) "À ÂÃ#‡" [put x side-effect-free t] 4] (oddp evenp abs expt signum last butlast ldiff pairlis gcd lcm isqrt floor* ceiling* truncate* round* mod* rem* subseq list-length get* getf gethash hash-table-count) #[(x) "À ÂÃ#‡" [put x side-effect-free error-free] 4] (eql floatp-safe list* subst acons equalp random-state-p copy-tree sublis hash-table-p) run-hooks cl-macs-load-hook] 4) emacs-19.30/lisp/cl-seq.elc100666 12120 1 102716 6045212613 13774 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:11:06 1995 ;;; from file /home/fsf/rms/e19/lisp/cl-seq.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cl-seq.el' was compiled for Emacs 19.29 or later")) (byte-code "À >„\nÂÃ!ˆÀ‡" [cl-19 features error "Tried to load `cl-seq' before `cl'!"] 2) (defalias 'cl-push '(macro . #[(x place) "À  EE‡" [setq place cons x] 5])) (defalias 'cl-pop '(macro . #[(place) "ÀÁ\nÃ\nÄ\nDEED‡" [car prog1 place setq cdr] 7])) (defalias 'cl-parsing-keywords '(macro . #[(kwords other-keys &rest body) "ÀÁ \"Ä Æ=?…%ÇÈÉÊËÌÍÎÁÏÄ \"\"DEÐÑFÒFEC\"BB‡" [let* mapcar #[(x) ":ƒ\n@‚ ÂÃÄÅ DÆEDD È=ƒ*ÉÊËEÌF Í=ƒ<ÉÊÎEÌFÏÐÑÒ !ÓÔO\"!:ƒVÕA@E‚X*D‡" [x var car cdr memq quote cl-keys mem :test-not and setq cl-test t :if-not cl-if intern format "cl-%s" symbol-name 1 nil or] 6] kwords append other-keys t let ((cl-keys-temp cl-keys)) while cl-keys-temp or memq (car cl-keys-temp) quote #[(x) ":ƒ@‡‡" [x] 1] (car (cdr (memq (quote :allow-other-keys) cl-keys))) (error "Bad keyword argument %s" (car cl-keys-temp)) (setq cl-keys-temp (cdr (cdr cl-keys-temp))) body] 16])) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put cl-parsing-keywords lisp-indent-function 2 edebug-form-spec (sexp sexp &rest form)] 4) (defalias 'cl-check-key '(macro . #[(x) "ÀÁÂÁ E F‡" [if cl-key funcall x] 5])) (defalias 'cl-check-test-nokey '(macro . #[(item x) "ÀÁÂÃÄÁ FDÇEDÈÂÃÄÈEDÉEDÊËÌ DÍ E EFDF‡" [cond cl-test eq not funcall item x cl-test-not cl-if cl-if-not t if numberp equal] 10])) (defalias 'cl-check-test '(macro . #[(item x) "À  DE‡" [cl-check-test-nokey item cl-check-key x] 4])) (defalias 'cl-check-match '(macro . #[(x y) "À DÀ\nDÃÄÅÆÇÄ \nFDÈEÃÉ DÊ \nEÅ \nEFF‡" [cl-check-key x y if cl-test eq not funcall cl-test-not numberp equal] 9])) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÇBÉBÊBËBÌBÀ‡" [put cl-check-key edebug-form-spec edebug-forms cl-check-test cl-check-test-nokey cl-check-match cl-test current-load-list cl-test-not cl-if cl-if-not cl-key] 4) #@110 Reduce two-argument FUNCTION across SEQUENCE. Keywords supported: :start :end :from-end :initial-value :key (defalias 'reduce #[(cl-func cl-seq &rest cl-keys) "À >A@à >A@†ÄÆ >A@È >A@ Ê >A@ ‰\fƒM\f@Í>„CÎ >A@„CÏÐ\f@\"ˆ\fAA‰\f„,)<„[ÒÓ\"Ô #\nƒmŸÈ >ƒx ‚œƒ™ ƒ ‰A@!‚œ‰A@‚œ \nƒÊƒò ƒ» ‰A@!‚‰A@\"‚¢ƒò ƒå ‰A@!‚ì‰A@\"‚Ê.‡" [:from-end cl-keys cl-from-end :start 0 cl-start :end cl-end :initial-value cl-initial-value :key cl-key cl-keys-temp (:from-end :start :end :initial-value :key) :allow-other-keys error "Bad keyword argument %s" cl-seq append nil subseq cl-func cl-accum] 6 (#$ . 2277)]) #@70 Fill the elements of SEQ with ITEM. Keywords supported: :start :end (defalias 'fill #[(seq item &rest cl-keys) "À >A@† ÂÄ >A@ ‰ƒ8@Ç>„.È >A@„.ÉÊ@\"ˆAA‰„) <ƒt  › ƒM Z‚NÌ ‰ƒp S‰ ÂYƒp ˆA‰„V*‚¨ „| G ÂUƒ”  GUƒ”Ð \"ˆ‚¨ Wƒ¨ Iˆ T‰‚• *‡" [:start cl-keys 0 cl-start :end cl-end cl-keys-temp (:start :end) :allow-other-keys error "Bad keyword argument %s" seq 8000000 n p item fillarray] 4 (#$ . 2975)]) #@153 Replace the elements of SEQ1 with the elements of SEQ2. SEQ1 is destructively modified, then returned. Keywords supported: :start1 :end1 :start2 :end2 (defalias 'replace #[(cl-seq1 cl-seq2 &rest cl-keys) "À >A@† ÂÄ >A@Æ >A@†ÂÈ >A@ ‰\nƒJ\n@Ë>„@Ì >A@„@ÍÎ\n@\"ˆ\nAA‰\n„))=ƒž Xƒž U„˜G †l Z †uZ^S‰ÂYƒšÓ \\\\œ#ˆ‚{*‚˜<ƒ; › ƒ² Z‚³Ô<ƒ› ƒÑ Z‚ÒÔ^ƒƒS‰ÂYƒ@ ˆAA‚×*‚7 †\fG\\^ ƒ7 Wƒ7H ˆAT‚*‚˜ †BG  †KGZ\\^<ƒ|› Wƒx @IˆA T‰‚_)‚˜ Wƒ˜ HIˆT T‰‚},‡" [:start1 cl-keys 0 cl-start1 :end1 cl-end1 :start2 cl-start2 :end2 cl-end2 cl-keys-temp (:start1 :end1 :start2 :end2) :allow-other-keys error "Bad keyword argument %s" cl-seq1 cl-seq2 cl-len cl-n cl-set-elt 4000000 cl-n1 cl-p1 cl-p2] 7 (#$ . 3435)]) #@221 Remove all occurrences of ITEM in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :test :test-not :key :count :start :end :from-end (defalias 'remove* #[(cl-item cl-seq &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@…<Ê >A@‰ …<Ä Ì >A@ Î >A@Ð >A@†UÑÓ >A@ ‰ƒ†@Ö>„|× >A@„|ØÙ@\"ˆAA‰„e) †Ú‰ ÑXƒš‚¨<ƒ¬ƒ ÜWƒÝ%‰ƒþàáâã\"âƒÕÓTD‚ÙÐD \"$$<ƒé$‚ú;ƒö$°‚úå$!)‚)‚¨†\nÚZÑUƒ®ƒ®ÑVƒ®\nƒA\nƒ7@!‚:@\"? =‚’ ƒa ƒV@!‚Y@!? =‚’§ƒ~ƒw@!‚z@š‚’ƒŽ@!‚‘@=ƒ®SA‰ƒ® S‰ ÑV„ ÑVƒ¦ÑVƒ¦ÑVƒË›‚ÓSA&&ƒaÑVƒa\nƒ\nƒö&@!‚ù&@\"? =‚Q ƒ  ƒ&@!‚&@!? =‚Q§ƒ=ƒ6&@!‚9&@š‚QƒM&@!‚P&@=„a&A&S‚Õ&ƒ ÑVƒ ç&\" èUƒ€&A‚œ&A…œàáé&A!ÐÑÓSÌ S &\n¤‚¢)‚¨. ‡" [:test cl-keys cl-test :test-not t cl-test-not :key cl-key :if cl-if :if-not cl-if-not :count cl-count :from-end cl-from-end :start 0 cl-start :end cl-end cl-keys-temp (:test :test-not :key :if :if-not :count :from-end :start :end) :allow-other-keys error "Bad keyword argument %s" 8000000 cl-seq 4000000 cl-position cl-item cl-i apply delete* append nil cl-res vconcat cl-p ldiff 1 copy-sequence] 13 (#$ . 4323)]) #@212 Remove all items satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :key :count :start :end :from-end (defalias 'remove-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply remove* nil cl-list :if cl-pred cl-keys] 7 (#$ . 5715)]) #@216 Remove all items not satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :key :count :start :end :from-end (defalias 'remove-if-not #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply remove* nil cl-list :if-not cl-pred cl-keys] 7 (#$ . 6066)]) #@191 Remove all occurrences of ITEM in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :test :test-not :key :count :start :end :from-end (defalias 'delete* #[(cl-item cl-seq &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@…<Ê >A@‰ …<Ä Ì >A@ Î >A@Ð >A@†UÑÓ >A@ ‰ƒ†@Ö>„|× >A@„|ØÙ@\"ˆAA‰„e) †Ú‰ ÑXƒš‚~<ƒvƒ÷ ÜWƒ÷Ý S‰ ÑYƒñß %‰ƒñÑUƒÛA‚êS›‰!‰AA¡ˆ)‚¯)‚~†ýÚZÑUƒ©ƒ¡ÑVƒ¡\nƒ4\n ƒ*@!‚-@\"? =‚… ƒT ƒI@!‚L@!? =‚… §ƒq ƒj@!‚m@š‚… ƒ@!‚„@=ƒ¡SA‰ƒ¡ S‰ ÑV„ S‚®S ÑVƒqÑVƒq›\"\"AƒpÑVƒp\nƒñ\n ƒæ\"A@!‚ê\"A@\"? =‚H ƒ ƒ\"A@!‚ \"A@!? =‚H §ƒ2 ƒ*\"A@!‚.\"A@š‚H ƒC\"A@!‚G\"A@=ƒc\"‰AA¡ˆ S‰ ÑUƒhã‚h\"A\"S‚Ã)‚~äå  $. ‡" [:test cl-keys cl-test :test-not t cl-test-not :key cl-key :if cl-if :if-not cl-if-not :count cl-count :from-end cl-from-end :start 0 cl-start :end cl-end cl-keys-temp (:test :test-not :key :if :if-not :count :from-end :start :end) :allow-other-keys error "Bad keyword argument %s" 8000000 cl-seq 4000000 nil cl-i cl-position cl-item cl-tail cl-p 1 apply remove*] 7 (#$ . 6429)]) #@182 Remove all items satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :key :count :start :end :from-end (defalias 'delete-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply delete* nil cl-list :if cl-pred cl-keys] 7 (#$ . 7722)]) #@186 Remove all items not satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :key :count :start :end :from-end (defalias 'delete-if-not #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply delete* nil cl-list :if-not cl-pred cl-keys] 7 (#$ . 8043)]) (byte-code "ÀÁ!ƒ ÂÁK!„ÃÁÄ\"ˆÀ‡" [fboundp delete subrp defalias #[(x y) "À \nÃÄ$‡" [delete* x y :test equal] 5]] 3) (defalias 'remove #[(x y) "À \nÃÄ$‡" [remove* x y :test equal] 5]) (defalias 'remq #[(x y) " >ƒ Âà !\"‡ ‡" [x y delq copy-list] 4]) #@123 Return a copy of SEQ with all duplicate elements removed. Keywords supported: :test :test-not :key :start :end :from-end (defalias 'remove-duplicates #[(cl-seq &rest cl-keys) "À \nÃ#‡" [cl-delete-duplicates cl-seq cl-keys t] 4 (#$ . 8629)]) #@121 Remove all duplicate elements from SEQ (destructively). Keywords supported: :test :test-not :key :start :end :from-end (defalias 'delete-duplicates #[(cl-seq &rest cl-keys) "À \nÃ#‡" [cl-delete-duplicates cl-seq cl-keys nil] 4 (#$ . 8878)]) (defalias 'cl-delete-duplicates #[(cl-seq cl-keys cl-copy) "<ƒ´Á\n>A@Ä\n>A@…Ä\n>A@‰…ÅÇ\n>A@É\n>A@†0Ê Ì\n>A@ Î\n>A@Ð\n>A@\n‰ƒo@Ó>„eÔ\n>A@„eÕÖ@\"ˆAA‰„N)ƒô ›× †…G Z  ÚVƒïÊÛƒ£@!‚¦@A S$‰ƒÝƒÇÝ! ›×›‰‰AA¡ˆ) S ‚”A S  T ‚Š*‚± †ûG Z Aƒ8 ÊUƒ8 ÚVƒ8Ûƒ!@!‚#@AÊ S$ƒ8A S ‚ ÊVƒG S›‚P S Ú AAƒ¯ ÚVƒ¯ÛƒpA@!‚tA@AAÊ S$ƒƒ“Ý! S›×‰AA¡ˆ‚¢A S  T ‚R).‡ßà×\"\n×#!;ƒÊ!°‚Îâ!!)‡" [cl-seq :test cl-keys cl-test :test-not t cl-test-not :key cl-key :start 0 cl-start :end cl-end :from-end cl-from-end :if cl-if cl-keys-temp (:test :test-not :key :start :end :from-end :if) :allow-other-keys error "Bad keyword argument %s" nil cl-i cl-p 1 cl-position cl-copy copy-sequence cl-tail cl-delete-duplicates append cl-res vconcat] 6]) #@213 Substitute NEW for OLD in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :test :test-not :key :count :start :end :from-end (defalias 'substitute #[(cl-new cl-old cl-seq &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@…<Ê >A@‰ …<Ä Ì >A@ Î >A@†NÏÑ >A@Ó >A@ ‰ƒ†@Ö>„|× >A@„|ØÙ@\"ˆAA‰„e)=„  †›Ü݉ ÏXƒ¥‚êß$‰ „º‚éá!„Øâ #ˆ T  S ãäÌ Î & ). ‡" [:test cl-keys cl-test :test-not t cl-test-not :key cl-key :if cl-if :if-not cl-if-not :count cl-count :start 0 cl-start :end cl-end :from-end cl-from-end cl-keys-temp (:test :test-not :key :if :if-not :count :start :end :from-end) :allow-other-keys error "Bad keyword argument %s" cl-old cl-new nil 8000000 cl-seq cl-position cl-i copy-sequence cl-set-elt apply nsubstitute] 11 (#$ . 10012)]) #@224 Substitute NEW for all items satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :key :count :start :end :from-end (defalias 'substitute-if #[(cl-new cl-pred cl-list &rest cl-keys) "ÀÁ\nÃ\fÅ&‡" [apply substitute cl-new nil cl-list :if cl-pred cl-keys] 8 (#$ . 10927)]) #@228 Substitute NEW for all items not satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :key :count :start :end :from-end (defalias 'substitute-if-not #[(cl-new cl-pred cl-list &rest cl-keys) "ÀÁ\nÃ\fÅ&‡" [apply substitute cl-new nil cl-list :if-not cl-pred cl-keys] 8 (#$ . 11316)]) #@183 Substitute NEW for OLD in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :test :test-not :key :count :start :end :from-end (defalias 'nsubstitute #[(cl-new cl-old cl-seq &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@…<Ê >A@‰ …<Ä Ì >A@ Î >A@†NÏÑ >A@Ó >A@ ‰ƒ†@Ö>„|× >A@„|ØÙ@\"ˆAA‰„e)=„ †˜Ü‰ ÏX„Â<ƒcƒ¯ ÞVƒc›†¼ÜZƒ_ÏVƒ_ ÏVƒ_\nƒó\nƒé@!‚ì@\"? =‚D ƒ ƒ@!‚ @!? =‚D§ƒ0ƒ)@!‚,@š‚Dƒ@@!‚C@=ƒR ˆ S AS‚Á)‚„mGƒWƒÂ ÏVƒÂS\nƒ©\nƒœ!‚¢œ\"? =‚ ƒÍ ƒÀœ!‚Åœ!? =‚§ƒîƒåœ!‚ꜚ‚ƒœ!‚œ=ƒrà#ˆ S ‚rWƒÂ ÏVƒÂ\nƒL\nƒ@H!‚EH\"? =‚© ƒp ƒcH!‚hH!? =‚©§ƒ‘ƒˆH!‚Hš‚©ƒ£H!‚¨H=ƒ¹Iˆ S T‰‚. ‡" [:test cl-keys cl-test :test-not t cl-test-not :key cl-key :if cl-if :if-not cl-if-not :count cl-count :start 0 cl-start :end cl-end :from-end cl-from-end cl-keys-temp (:test :test-not :key :if :if-not :count :start :end :from-end) :allow-other-keys error "Bad keyword argument %s" cl-old cl-new 8000000 cl-seq 4000000 cl-p cl-set-elt] 6 (#$ . 11717)]) #@194 Substitute NEW for all items satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :key :count :start :end :from-end (defalias 'nsubstitute-if #[(cl-new cl-pred cl-list &rest cl-keys) "ÀÁ\nÃ\fÅ&‡" [apply nsubstitute cl-new nil cl-list :if cl-pred cl-keys] 8 (#$ . 13045)]) #@198 Substitute NEW for all items not satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :key :count :start :end :from-end (defalias 'nsubstitute-if-not #[(cl-new cl-pred cl-list &rest cl-keys) "ÀÁ\nÃ\fÅ&‡" [apply nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys] 8 (#$ . 13406)]) #@155 Find the first occurrence of ITEM in LIST. Return the matching ITEM, or nil if not found. Keywords supported: :test :test-not :key :start :end :from-end (defalias 'find #[(cl-item cl-seq &rest cl-keys) "ÀÁ\n \f$‰… œ)‡" [apply position cl-item cl-seq cl-keys cl-pos] 6 (#$ . 13779)]) #@146 Find the first item satisfying PREDICATE in LIST. Return the matching ITEM, or nil if not found. Keywords supported: :key :start :end :from-end (defalias 'find-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply find nil cl-list :if cl-pred cl-keys] 7 (#$ . 14074)]) #@150 Find the first item not satisfying PREDICATE in LIST. Return the matching ITEM, or nil if not found. Keywords supported: :key :start :end :from-end (defalias 'find-if-not #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply find nil cl-list :if-not cl-pred cl-keys] 7 (#$ . 14355)]) #@168 Find the first occurrence of ITEM in LIST. Return the index of the matching item, or nil if not found. Keywords supported: :test :test-not :key :start :end :from-end (defalias 'position #[(cl-item cl-seq &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@…<Ê >A@‰ …<Ä Ì >A@†GÍÏ >A@Ñ >A@ ‰ƒ@Ô>„uÕ >A@„uÖ×@\"ˆAA‰„^)Ø%.‡" [:test cl-keys cl-test :test-not t cl-test-not :key cl-key :if cl-if :if-not cl-if-not :start 0 cl-start :end cl-end :from-end cl-from-end cl-keys-temp (:test :test-not :key :if :if-not :start :end :from-end) :allow-other-keys error "Bad keyword argument %s" cl-position cl-item cl-seq] 7 (#$ . 14648)]) (defalias 'cl-position #[(cl-item cl-seq cl-start &optional cl-end cl-from-end) "<ƒ¤ › „ÄÅ\nƒ  Wƒ ƒ&ƒ ƒF \nƒ<\n\n@!‚>\n@\"? =‚‘\fƒd\f\nƒZ\n\n@!‚\\\n@!? =‚‘ §ƒ \nƒy\n\n@!‚{\n@š‚‘ \nƒŽ\n\n@!‚\n@=ƒ— \nA T‚*‡ „«Gƒ7 S‰ Yƒ/ƒÛ \nƒÐ\n H!‚Ó H\"? =‚,\fƒû\f\nƒð\n H!‚ó H!? =‚, §ƒ \nƒ\n H!‚ Hš‚, \nƒ(\n H!‚+ H=ƒ° Y…Á ‡ Wƒºƒ_ \nƒT\n H!‚W H\"? =‚°\fƒ\f\nƒt\n H!‚w H!? =‚° §ƒœ \nƒ•\n H!‚˜ Hš‚° \nƒ¬\n H!‚¯ H=„º T‰‚8 W…Á ‡" [cl-seq cl-start cl-p cl-end 8000000 nil cl-res cl-from-end cl-test cl-item cl-key cl-test-not cl-if cl-if-not] 6]) #@159 Find the first item satisfying PREDICATE in LIST. Return the index of the matching item, or nil if not found. Keywords supported: :key :start :end :from-end (defalias 'position-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply position nil cl-list :if cl-pred cl-keys] 7 (#$ . 16019)]) #@163 Find the first item not satisfying PREDICATE in LIST. Return the index of the matching item, or nil if not found. Keywords supported: :key :start :end :from-end (defalias 'position-if-not #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply position nil cl-list :if-not cl-pred cl-keys] 7 (#$ . 16321)]) #@104 Count the number of occurrences of ITEM in LIST. Keywords supported: :test :test-not :key :start :end (defalias 'count #[(cl-item cl-seq &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@…<Ê >A@‰ …<Ä Ì >A@†GÍÏ >A@ ‰ƒx@Ò>„nÓ >A@„nÔÕ@\"ˆAA‰„W)ÍÖ„‰G:ƒ–›Wƒ.:ƒ®‰A@‚³H\nƒÒ\nƒÉ!‚Ë\"? =‚ ƒð ƒæ!‚è!? =‚§ƒ ƒ!‚š‚ƒ!‚=ƒ%TT‰‚˜. ‡" [:test cl-keys cl-test :test-not t cl-test-not :key cl-key :if cl-if :if-not cl-if-not :start 0 cl-start :end cl-end cl-keys-temp (:test :test-not :key :if :if-not :start :end) :allow-other-keys error "Bad keyword argument %s" nil cl-x cl-count cl-seq cl-item] 5 (#$ . 16635)]) #@95 Count the number of items satisfying PREDICATE in LIST. Keywords supported: :key :start :end (defalias 'count-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply count nil cl-list :if cl-pred cl-keys] 7 (#$ . 17386)]) #@99 Count the number of items not satisfying PREDICATE in LIST. Keywords supported: :key :start :end (defalias 'count-if-not #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply count nil cl-list :if-not cl-pred cl-keys] 7 (#$ . 17617)]) #@286 Compare SEQ1 with SEQ2, return index of first mismatching element. Return nil if the sequences match. If one sequence is a prefix of the other, the return value indicates the end of the shorted sequence. Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end (defalias 'mismatch #[(cl-seq1 cl-seq2 &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@†1Ë\fÍ >A@Ï >A@†CËÑ >A@ ‰ƒt@Ô>„jÕ >A@„jÖ×@\"ˆAA‰„S)„G„‰G ƒz\fWƒdWƒd\nƒØ\nƒ´Sœ!‚ºSœƒËSœ!‚ÑSœ\"? =‚TƒéSœ!‚ïSœ§ƒ%ƒSœ!‚\nSœƒSœ!‚!Sœš‚Tƒ6Sœ!‚<SœƒMSœ!‚SSœ=ƒdSS‚Ž\fW„tW…S‚<……\f›<…›\fWƒWƒ\nƒ\nƒÄƒ»@‚À\fH!‚ÔƒÏ@‚Ô\fHƒïƒæ@‚ëH!‚ÿƒú@‚ÿH\"? =‚æƒ!ƒ@‚\fH!‚1ƒ,@‚1\fH§ƒƒPƒG@‚L\fH!‚`ƒ[@‚`\fHƒ{ƒr@‚wH!‚‹ƒ†@‚‹Hš‚惪ƒ¡@‚¦\fH!‚ºƒµ@‚º\fHƒÕƒÌ@‚ÑH!‚åƒà@‚åH=ƒAA\fT\fT‚”\fW„W…\f*.‡" [:test cl-keys cl-test :test-not t cl-test-not :key cl-key :from-end cl-from-end :start1 0 cl-start1 :end1 cl-end1 :start2 cl-start2 :end2 cl-end2 cl-keys-temp (:test :test-not :key :from-end :start1 :end1 :start2 :end2) :allow-other-keys error "Bad keyword argument %s" cl-seq1 cl-seq2 cl-p2 cl-p1] 6 (#$ . 17861)]) #@226 Search for SEQ1 as a subsequence of SEQ2. Return the index of the leftmost element of the first match found; return nil if there are no matches. Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end (defalias 'search #[(cl-seq1 cl-seq2 &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@†1Ë\fÍ >A@Ï >A@†CËÑ >A@ ‰ƒt@Ô>„jÕ >A@„jÖ×@\"ˆAA‰„S)„G„‰G\fYƒ  ƒ›‚%‚%\fZƒ·\fœ!‚¼\fœÜÜSZWƒß %‰ƒàáÊ\fTÍÏTÑ\\ÈÜ &ƒ ƒ‚ÌT‰‚ÎW…$,.‡" [:test cl-keys cl-test :test-not t cl-test-not :key cl-key :from-end cl-from-end :start1 0 cl-start1 :end1 cl-end1 :start2 cl-start2 :end2 cl-end2 cl-keys-temp (:test :test-not :key :from-end :start1 :end1 :start2 :end2) :allow-other-keys error "Bad keyword argument %s" cl-seq1 cl-seq2 cl-len cl-first nil cl-if cl-pos cl-position apply mismatch] 16 (#$ . 19342)]) #@157 Sort the argument SEQUENCE according to PREDICATE. This is a destructive function; it reuses the storage of SEQUENCE if possible. Keywords supported: :key (defalias 'sort* #[(cl-seq cl-pred &rest cl-keys) "<„ÁÂÃÄÅ\"$\"‡È>A@ ‰\nƒF\n@Ë>„<Ì>A@„<ÍÎ\n@\"ˆ\nAA‰\n„$) Ï>ƒVÐ\"‚ZÐÑ\")‡" [cl-seq replace apply sort* append nil cl-pred cl-keys :key cl-key cl-keys-temp (:key) :allow-other-keys error "Bad keyword argument %s" (nil identity) sort #[(cl-x cl-y) " \n! !\"‡" [cl-pred cl-key cl-x cl-y] 4]] 8 (#$ . 20299)]) #@164 Sort the argument SEQUENCE stably according to PREDICATE. This is a destructive function; it reuses the storage of SEQUENCE if possible. Keywords supported: :key (defalias 'stable-sort #[(cl-seq cl-pred &rest cl-keys) "ÀÁ\n \f$‡" [apply sort* cl-seq cl-pred cl-keys] 5 (#$ . 20850)]) #@228 Destructively merge the two sequences to produce a new sequence. TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument sequences, and PRED is a `less-than' predicate on the elements. Keywords supported: :key (defalias 'merge #[(cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys) "<„\nÁÂ\" <„Á Â\"Ä >A@ ‰ƒC@È>„9É >A@„9ÊË@\"ˆAA‰„\")Â\fƒ ƒ ƒ^ @!‚` @ƒm@!‚o@\"ƒ€ ‰A@\fB\f‚G‰A@\fB\f‚GÎ\fŸ¤ ¤\"*‡" [cl-seq1 append nil cl-seq2 :key cl-keys cl-key cl-keys-temp (:key) :allow-other-keys error "Bad keyword argument %s" cl-res cl-pred coerce cl-type] 5 (#$ . 21142)]) #@132 Find the first occurrence of ITEM in LIST. Return the sublist of LIST whose car is ITEM. Keywords supported: :test :test-not :key (defalias 'member* #[(cl-item cl-list &rest cl-keys) "ƒðÁ>A@Ã>A@…Ã>A@‰…ÄÆ>A@È>A@ Ê>A@…@Ê>A@‰ …@Ä ‰\fƒj\f@Í>„`Î>A@„`ÏÐ\f@\"ˆ\fAA‰\f„I)ƒì\nƒ\nƒ…@!‚ˆ@\"? =‚à ƒ¯ ƒ¤@!‚§@!? =‚ৃ̃Å@!‚È@š‚àƒÜ@!‚ß@=„ìA‰„p-‡§ƒ¨„‡>‡" [cl-keys :test cl-test :test-not t cl-test-not :key cl-key :if cl-if :if-not cl-if-not cl-keys-temp (:test :test-not :key :if :if-not) :allow-other-keys error "Bad keyword argument %s" cl-list cl-item] 5 (#$ . 21779)]) #@123 Find the first item satisfying PREDICATE in LIST. Return the sublist of LIST whose car matches. Keywords supported: :key (defalias 'member-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply member* nil cl-list :if cl-pred cl-keys] 7 (#$ . 22465)]) #@127 Find the first item not satisfying PREDICATE in LIST. Return the sublist of LIST whose car matches. Keywords supported: :key (defalias 'member-if-not #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply member* nil cl-list :if-not cl-pred cl-keys] 7 (#$ . 22728)]) (defalias 'cl-adjoin #[(cl-item cl-list &rest cl-keys) "À >A@ÃÄ\nƒ\n !‚  $)ƒ‡ B‡" [:key cl-keys cl-key apply member* cl-item cl-list] 5]) #@95 Find the first item whose car matches ITEM in LIST. Keywords supported: :test :test-not :key (defalias 'assoc* #[(cl-item cl-alist &rest cl-keys) "ƒÁ>A@Ã>A@…Ã>A@‰…ÄÆ>A@È>A@ Ê>A@…@Ê>A@‰ …@Ä ‰\fƒj\f@Í>„`Î>A@„`ÏÐ\f@\"ˆ\fAA‰\f„I)ƒû@:ƒò\nƒ˜\nƒ@@!‚‘@@\"? =‚ï ƒº ƒ®@@!‚²@@!? =‚遼كÑ@@!‚Õ@@š‚ïƒê@@!‚î@@=„ûA‰„p…@-‡§ƒ¨„Ó\"‡ž‡" [cl-keys :test cl-test :test-not t cl-test-not :key cl-key :if cl-if :if-not cl-if-not cl-keys-temp (:test :test-not :key :if :if-not) :allow-other-keys error "Bad keyword argument %s" cl-alist cl-item assoc] 5 (#$ . 23153)]) #@86 Find the first item whose car satisfies PREDICATE in LIST. Keywords supported: :key (defalias 'assoc-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply assoc* nil cl-list :if cl-pred cl-keys] 7 (#$ . 23831)]) #@93 Find the first item whose car does not satisfy PREDICATE in LIST. Keywords supported: :key (defalias 'assoc-if-not #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply assoc* nil cl-list :if-not cl-pred cl-keys] 7 (#$ . 24054)]) #@95 Find the first item whose cdr matches ITEM in LIST. Keywords supported: :test :test-not :key (defalias 'rassoc* #[(cl-item cl-alist &rest cl-keys) "„ §ƒÂ>A@Ä>A@…\"Ä>A@‰…\"ÅÇ>A@É>A@\nË>A@…FË>A@‰\n…FÅ\f‰ ƒp @Î>„fÏ>A@„fÐÑ @\"ˆ AA‰ „O)ƒþ@:ƒõ ƒž ƒ’@A!‚–@A\"?=‚ò\nƒÀ\nƒ´@A!‚¸@A!?\f=‚ò §ƒÝ ƒÕ@A!‚Ù@Aš‚ò ƒí@A!‚ñ@A=„þA‰„v…@-‡Ó \"‡" [cl-keys cl-item :test cl-test :test-not t cl-test-not :key cl-key :if cl-if :if-not cl-if-not cl-keys-temp (:test :test-not :key :if :if-not) :allow-other-keys error "Bad keyword argument %s" cl-alist rassq] 5 (#$ . 24292)]) #@86 Find the first item whose cdr satisfies PREDICATE in LIST. Keywords supported: :key (defalias 'rassoc-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply rassoc* nil cl-list :if cl-pred cl-keys] 7 (#$ . 24956)]) #@93 Find the first item whose cdr does not satisfy PREDICATE in LIST. Keywords supported: :key (defalias 'rassoc-if-not #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply rassoc* nil cl-list :if-not cl-pred cl-keys] 7 (#$ . 25181)]) #@296 Combine LIST1 and LIST2 using a set-union operation. The result list contains all items that appear in either LIST1 or LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. Keywords supported: :test :test-not :key (defalias 'union #[(cl-list1 cl-list2 &rest cl-keys) "„ ‡ „\f‡ šƒ‡G GY„  ƒM\n„. @§ƒ9ÃÄ @\n$‚E @>„E @B ‰Aˆ‚ ‡" [cl-list1 cl-list2 cl-keys apply adjoin] 5 (#$ . 25422)]) #@261 Combine LIST1 and LIST2 using a set-union operation. The result list contains all items that appear in either LIST1 or LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. Keywords supported: :test :test-not :key (defalias 'nunion #[(cl-list1 cl-list2 &rest cl-keys) "„ ‡ „\f‡Âà \f$‡" [cl-list1 cl-list2 apply union cl-keys] 5 (#$ . 25920)]) #@302 Combine LIST1 and LIST2 using a set-intersection operation. The result list contains all items that appear in both LIST1 and LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. Keywords supported: :test :test-not :key (defalias 'intersection #[(cl-list1 cl-list2 &rest cl-keys) "…… …… šƒ‡Â >A@ ‰ƒ9 @Æ>„1Ç >A@„1ÈÉ @\"ˆ AA‰„)Ê G GY„I  ƒ‚ „W @§ƒlÌÍ\fƒd\f @!‚f @ $‚p @>ƒz @ B ‰Aˆ‚I *‡" [cl-list1 cl-list2 :key cl-keys cl-key cl-keys-temp (:key :test :test-not) :allow-other-keys error "Bad keyword argument %s" nil cl-res apply member*] 6 (#$ . 26322)]) #@267 Combine LIST1 and LIST2 using a set-intersection operation. The result list contains all items that appear in both LIST1 and LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. Keywords supported: :test :test-not :key (defalias 'nintersection #[(cl-list1 cl-list2 &rest cl-keys) "… …Âà \f$‡" [cl-list1 cl-list2 apply intersection cl-keys] 5 (#$ . 26998)]) #@299 Combine LIST1 and LIST2 using a set-difference operation. The result list contains all items that appear in LIST1 but not LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. Keywords supported: :test :test-not :key (defalias 'set-difference #[(cl-list1 cl-list2 &rest cl-keys) "ƒ „\n‡Â >A@ ‰ƒ3 @Æ>„+Ç >A@„+ÈÉ @\"ˆ AA‰„)Ê ƒp „E@§ƒZÌÍ\fƒR\f@!‚T@ $‚^@ >„h@ B ‰Aˆ‚7 *‡" [cl-list1 cl-list2 :key cl-keys cl-key cl-keys-temp (:key :test :test-not) :allow-other-keys error "Bad keyword argument %s" nil cl-res apply member*] 6 (#$ . 27415)]) #@264 Combine LIST1 and LIST2 using a set-difference operation. The result list contains all items that appear in LIST1 but not LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. Keywords supported: :test :test-not :key (defalias 'nset-difference #[(cl-list1 cl-list2 &rest cl-keys) "ƒ „\n‡Âà \f$‡" [cl-list1 cl-list2 apply set-difference cl-keys] 5 (#$ . 28073)]) #@309 Combine LIST1 and LIST2 using a set-exclusive-or operation. The result list contains all items that appear in exactly one of LIST1, LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. Keywords supported: :test :test-not :key (defalias 'set-exclusive-or #[(cl-list1 cl-list2 &rest cl-keys) "„ ‡ „\f‡ šƒ‡ÃÄÅ $ÄÅ $\"‡" [cl-list1 cl-list2 nil append apply set-difference cl-keys] 7 (#$ . 28494)]) #@274 Combine LIST1 and LIST2 using a set-exclusive-or operation. The result list contains all items that appear in exactly one of LIST1, LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. Keywords supported: :test :test-not :key (defalias 'nset-exclusive-or #[(cl-list1 cl-list2 &rest cl-keys) "„ ‡ „\f‡ šƒ‡ÃÄ $ÃÄ  $¤‡" [cl-list1 cl-list2 nil apply nset-difference cl-keys] 6 (#$ . 28992)]) #@134 True if LIST1 is a subset of LIST2. I.e., if every element of LIST1 also appears in LIST2. Keywords supported: :test :test-not :key (defalias 'subsetp #[(cl-list1 cl-list2 &rest cl-keys) "„Á‡\n„\fÇ\nšƒÁ‡Ä >A@ ‰ƒC@È>„9É >A@„9ÊË@\"ˆAA‰„\")ƒgÌ̓W@!‚Y@\n $ƒg‰Aˆ‚D)?‡" [cl-list1 t cl-list2 nil :key cl-keys cl-key cl-keys-temp (:key :test :test-not) :allow-other-keys error "Bad keyword argument %s" apply member*] 6 (#$ . 29446)]) #@169 Substitute NEW for elements matching PREDICATE in TREE (non-destructively). Return a copy of TREE with all matching elements replaced by NEW. Keywords supported: :key (defalias 'subst-if #[(cl-new cl-pred cl-tree &rest cl-keys) "ÀÁ BC\fÅ&‡" [apply sublis nil cl-new cl-tree :if cl-pred cl-keys] 7 (#$ . 29920)]) #@173 Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). Return a copy of TREE with all non-matching elements replaced by NEW. Keywords supported: :key (defalias 'subst-if-not #[(cl-new cl-pred cl-tree &rest cl-keys) "ÀÁ BC\fÅ&‡" [apply sublis nil cl-new cl-tree :if-not cl-pred cl-keys] 7 (#$ . 30246)]) #@188 Substitute NEW for OLD everywhere in TREE (destructively). Any element of TREE which is `eql' to OLD is changed to NEW (via a call to `setcar'). Keywords supported: :test :test-not :key (defalias 'nsubst #[(cl-new cl-old cl-tree &rest cl-keys) "ÀÁ\n BC\f $‡" [apply nsublis cl-old cl-new cl-tree cl-keys] 5 (#$ . 30584)]) #@177 Substitute NEW for elements matching PREDICATE in TREE (destructively). Any element of TREE which matches is changed to NEW (via a call to `setcar'). Keywords supported: :key (defalias 'nsubst-if #[(cl-new cl-pred cl-tree &rest cl-keys) "ÀÁ BC\fÅ&‡" [apply nsublis nil cl-new cl-tree :if cl-pred cl-keys] 7 (#$ . 30914)]) #@181 Substitute NEW for elements not matching PREDICATE in TREE (destructively). Any element of TREE which matches is changed to NEW (via a call to `setcar'). Keywords supported: :key (defalias 'nsubst-if-not #[(cl-new cl-pred cl-tree &rest cl-keys) "ÀÁ BC\fÅ&‡" [apply nsublis nil cl-new cl-tree :if-not cl-pred cl-keys] 7 (#$ . 31250)]) #@172 Perform substitutions indicated by ALIST in TREE (non-destructively). Return a copy of TREE with all matching elements replaced. Keywords supported: :test :test-not :key (defalias 'sublis #[(cl-alist cl-tree &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@…<Ê >A@‰ …<Ä ‰\fƒf\f@Í>„\\Î >A@„\\ÏÐ\f@\"ˆ\fAA‰\f„E)Ñ!-‡" [:test cl-keys cl-test :test-not t cl-test-not :key cl-key :if cl-if :if-not cl-if-not cl-keys-temp (:test :test-not :key :if :if-not) :allow-other-keys error "Bad keyword argument %s" cl-sublis-rec cl-tree] 4 (#$ . 31598)]) (byte-code "À BÀ‡" [cl-alist current-load-list] 2) (defalias 'cl-sublis-rec #[(cl-tree) "ƒ\n !‚ \n ƒQ ƒ# @@\f\"?=‚Gƒ3\f!?=‚G @@§ƒB @@\fš‚G @@\f=„Q A‰„ ƒ[ @A‚‰ :ƒˆÉ @!É A!\n‰ @=ƒ\n A=ƒ ‚„ \nB*‚‰ *‡" [cl-key cl-tree cl-alist cl-p cl-temp cl-test cl-test-not cl-if cl-if-not cl-sublis-rec cl-d cl-a] 4]) #@173 Perform substitutions indicated by ALIST in TREE (destructively). Any matching element of TREE is changed via a call to `setcar'. Keywords supported: :test :test-not :key (defalias 'nsublis #[(cl-alist cl-tree &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@…<Ê >A@‰ …<Ä ‰\fƒf\f@Í>„\\Î >A@„\\ÏÐ\f@\"ˆ\fAA‰\f„E)CÓ!ˆ@.‡" [:test cl-keys cl-test :test-not t cl-test-not :key cl-key :if cl-if :if-not cl-if-not cl-keys-temp (:test :test-not :key :if :if-not) :allow-other-keys error "Bad keyword argument %s" cl-tree cl-hold cl-nsublis-rec] 4 (#$ . 32518)]) (defalias 'cl-nsublis-rec #[(cl-tree) ":…Ù ƒ @!‚@\n ƒX ƒ* @@\f\"?=‚Nƒ:\f!?=‚N @@§ƒI @@\fš‚N @@\f=„X A‰„ ƒe @A ˆ‚p@:ƒpÉ@!ˆ ƒ{ A!‚}A\n‰ƒÃ ƒ• @@\f\"?=‚¹ƒ¥\f!?=‚¹ @@§ƒ´ @@\fš‚¹ @@\f=„à A‰„„ ƒÒ @A¡ˆÊ‚ÕA*‚‡" [cl-tree cl-key cl-alist cl-p cl-temp cl-test cl-test-not cl-if cl-if-not cl-nsublis-rec nil] 4]) #@147 T if trees X and Y have `eql' leaves. Atoms are compared by `eql'; cons cells are compared recursively. Keywords supported: :test :test-not :key (defalias 'tree-equal #[(cl-x cl-y &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@ ‰ƒI@É>„?Ê >A@„?ËÌ@\"ˆAA‰„()Í\"+‡" [:test cl-keys cl-test :test-not t cl-test-not :key cl-key cl-keys-temp (:test :test-not :key) :allow-other-keys error "Bad keyword argument %s" cl-tree-equal-rec cl-x cl-y] 4 (#$ . 33484)]) (defalias 'cl-tree-equal-rec #[(cl-x cl-y) ":ƒ :ƒÂ@ @\"ƒA A‚:?…† :?…† ƒH \fƒ7\f!‚8\fƒB\f !‚C \"? =‡\fƒR\f!‚S§ƒo\fƒa\f!‚b\fƒl\f !‚m š‡\fƒy\f!‚z\fƒ„\f !‚… =‡" [cl-x cl-y cl-tree-equal-rec cl-test cl-key cl-test-not] 4]) (run-hooks (quote cl-seq-load-hook)) emacs-19.30/lisp/cl-specs.elc100666 12120 1 20504 6045212635 14277 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:12:28 1995 ;;; from file /home/fsf/rms/e19/lisp/cl-specs.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cl-specs.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!ˆÄÅÆÇ#ˆÄÈÆÉ#ˆÄÊÆË#ˆÄÌÆÍ#ˆÄÎÆÍ#ˆÄÏÆÐ#ˆÄÑÆÏ#ˆÄÒÆÓ#ˆÄÔÆÒ#ˆÄÕÆÖ#ˆÄ×ÆÕ#ˆÄØÆÙ#ˆÄÚÆÛ#ˆÄÜÆÝ#ˆÄÞÆß#ˆÄàÆá#ˆÄâÆã#ˆÄäÆå#ˆÄæÆç#ˆÄèÆç#ˆÄéÆê#ˆÄëÆì#ˆÄíÆî#ˆÄïÆí#ˆÄðÆñ#ˆÄòÆó#ˆÄôÆõ#ˆÄöÆ÷#ˆÄøÆö#ˆÄùÆú#ˆÄûÆù#ˆÄüÆý#ˆÄþÆÿ#ˆÄ@ÆA#ˆÄBÆC#ˆÄDÆE#ˆÄFÆG#ˆÄHÆI#ˆÄJÆH#ˆÄKÆL#ˆÄMÆN#ˆÄOÆP#ˆÄQÆR#ˆÄSÆT#ˆÄUÆV#ˆÄWÆU#ˆÄXÆU#ˆÄYÆU#ˆÄZÆ[#ˆÄ\\Æ]#ˆÄ^Æ\\#ˆÄ_Æ\\#ˆÄ`Æ\\#ˆÄaÆ\\#ˆÄbÆc#ˆÄdÆe#ˆÄfÆg#ˆÄhÆi#ˆÄjÆk#ˆÄlÆm#ˆÄnÆl#ˆÄoÆÍ#ˆÄpÆq#ˆÄrÆs#ˆÄtÆu#ˆÄvÆw#ˆÄxÆy#ˆÄzÆ{#ˆÄ|Æ}#ˆÄ~Æ#ˆÄ€Æ#ˆÄ‚ƃ#ˆÄ„Æ…#ˆÄ†Æ‡#ˆÄˆÆ‰#ˆÄŠÆ‹#ˆÄŒÆ#ˆÄŽÆ#ˆÄÆŽ#ˆÄgÆ‘#ˆÄ’Æg#ˆÄ“Æ”#ˆÄ•Æ–#ˆÄ—Ƙ#ˆÄ™Æš#ˆÄ›Æœ#ˆÄ›Æ#ˆÄžÆŸ#ˆÄ Æ¡#ˆÄ¢Æ£#ˆÄ¤Æ¥#ˆÄ¦Æ§#ˆÄ¨Æ©#ˆÄªÆ«#ˆÄ¬Æ­#ˆÄ®Æ¯#ˆÄ°Æ±#‡" [provide cl-specs require edebug put block edebug-form-spec (symbolp body) return (&optional form) return-from (symbolp &optional form) when t unless case (form &rest (sexp body)) ecase do ((&rest &or symbolp (symbolp &optional form form)) (form body) cl-declarations body) do* dolist ((symbolp form &optional form) cl-declarations body) dotimes do-symbols ((symbolp &optional form form) cl-declarations body) do-all-symbols ((symbolp &optional form) cl-declarations body) multiple-value-list (form) multiple-value-call (function-form body) multiple-value-bind ((&rest symbolp) form cl-declarations body) multiple-value-setq ((&rest symbolp) form) multiple-value-prog1 (form body) lexical-let let lexical-let* psetq setq progv (form form body) flet ((&rest (defun*)) cl-declarations body) labels macrolet ((&rest (&define name (&rest arg) cl-declarations-or-string def-body)) cl-declarations body) symbol-macrolet ((&rest (symbol sexp)) cl-declarations body) destructuring-bind (&define cl-macro-list form cl-declarations def-body) setf (&rest [place form]) psetf letf ((&rest (gate place &optional form)) body) letf* defsetf (&define name [&or [symbolp &optional stringp] [cl-lambda-list (symbolp)]] cl-declarations-or-string def-body) define-setf-method (&define name cl-lambda-list cl-declarations-or-string def-body) define-modify-macro (&define name cl-lambda-list symbolp &optional stringp) callf (function* place &rest form) callf2 (function* form place &rest form) remf (place form) incf (place &optional form) decf push (form place) pushnew (form place &rest &or [[&or ":test" ":test-not" ":key"] function-form] [edebug-keywordp form]) pop (place) shiftf (&rest place) rotatef (&rest place) some (function-form form &rest form) every notany notevery map (form function-form form &rest form) maplist (function-form form &rest form) mapc mapl mapcan mapcon reduce (function-form form &rest form) cl-type-spec (sexp) deftype defmacro* check-type (place cl-type-spec &optional stringp) assert (form &rest form) typecase (form &rest ([&or cl-type-spec "otherwise"] body)) etypecase ignore-errors eval-when ((&rest &or "compile" "load" "eval") body) load-time-value (form &optional &or "t" "nil") cl-decl-spec ((symbolp &rest sexp)) cl-declarations (&rest ("declare" &rest cl-decl-spec)) cl-declarations-or-string (&or stringp cl-declarations) declaim (&rest cl-decl-spec) declare (&rest cl-decl-spec) locally (cl-declarations &rest form) the (cl-type-spec form) cl-lambda-list (([&rest arg] [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]] [&optional ["&rest" arg]] [&optional ["&key" [cl-&key-arg &rest cl-&key-arg] &optional "&allow-other-keywords"]] [&optional ["&aux" &rest &or (symbolp &optional def-form) symbolp]])) cl-&optional-arg (&or (arg &optional def-form arg) arg) cl-&key-arg (&or ([&or (symbolp arg) arg] &optional def-form arg) arg) cl-macro-list (([&optional "&environment" arg] [&rest cl-macro-arg] [&optional ["&optional" &rest &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] [&optional [[&or "&rest" "&body"] cl-macro-arg]] [&optional ["&key" [&rest [&or ([&or (symbolp cl-macro-arg) arg] &optional def-form cl-macro-arg) arg]] &optional "&allow-other-keywords"]] [&optional ["&aux" &rest &or (symbolp &optional def-form) symbolp]] [&optional "&environment" arg])) cl-macro-arg (&or arg cl-macro-list1) cl-macro-list1 (([&optional "&whole" arg] [&rest cl-macro-arg] [&optional ["&optional" &rest &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] [&optional [[&or "&rest" "&body"] cl-macro-arg]] [&optional ["&key" [&rest [&or ([&or (symbolp cl-macro-arg) arg] &optional def-form cl-macro-arg) arg]] &optional "&allow-other-keywords"]] [&optional ["&aux" &rest &or (symbolp &optional def-form) symbolp]] . [&or arg nil])) defun* (&define [&or name ("setf" :name setf name)] cl-lambda-list cl-declarations-or-string [&optional ("interactive" interactive)] def-body) defsubst* (&define name cl-macro-list cl-declarations-or-string def-body) define-compiler-macro function* (&or symbolp cl-lambda-expr) cl-lambda-expr (&define ("lambda" cl-lambda-list def-body)) function-form (&or ([&or "quote" "function"] &or symbolp lambda-expr) ("function*" cl-lambda-expr) form) defstruct (&define [&or symbolp (gate symbolp &rest (&or [":conc-name" &or stringp "nil"] [":constructor" symbolp &optional cl-lambda-list] [":copier" symbolp] [":predicate" symbolp] [":include" symbolp &rest sexp]))] [&optional stringp] &rest &or symbolp (symbolp def-form &optional ":read-only" sexp)) loop (&rest &or symbolp form) ([&optional ["named" symbolp]] [&rest &or ["repeat" form] loop-for-as loop-with loop-initial-final] [&rest loop-clause]) loop-with ("with" loop-var loop-type-spec [&optional ["=" form]] &rest ["and" loop-var loop-type-spec [&optional ["=" form]]]) loop-for-as ([&or "for" "as"] loop-for-as-subclause &rest ["and" loop-for-as-subclause]) loop-for-as-subclause (loop-var loop-type-spec &or [[&or "in" "on" "in-ref" "across-ref"] form &optional ["by" function-form]] ["=" form &optional ["then" form]] ["across" form] ["being" [&or "the" "each"] &or [[&or "element" "elements"] [&or "of" "in" "of-ref"] form &optional "using" ["index" symbolp]] [[&or "hash-key" "hash-keys" "hash-value" "hash-values"] [&or "of" "in"] hash-table-p &optional ["using" ([&or "hash-value" "hash-values" "hash-key" "hash-keys"] sexp)]] [[&or "symbol" "present-symbol" "external-symbol" "symbols" "present-symbols" "external-symbols"] [&or "in" "of"] package-p] [[&or "frame" "frames" "screen" "screens" "buffer" "buffers"]] [[&or "window" "windows"] [&or "of" "in"] form] [[&or "overlay" "overlays" "extent" "extents"] [&or "of" "in"] form &optional [[&or "from" "to"] form]] [[&or "interval" "intervals"] [&or "in" "of"] form &optional [[&or "from" "to"] form] ["property" form]] [[&or "key-code" "key-codes" "key-seq" "key-seqs" "key-binding" "key-bindings"] [&or "in" "of"] form &optional ["using" ([&or "key-code" "key-codes" "key-seq" "key-seqs" "key-binding" "key-bindings"] sexp)]] [symbolp &rest &or symbolp form]] [[&optional [[&or "from" "downfrom" "upfrom"] form]] [&optional [[&or "to" "downto" "upto" "below" "above"] form]] [&optional ["by" form]]]) loop-initial-final (&or ["initially" &rest loop-non-atomic-expr] ["finally" &or [[&optional &or "do" "doing"] &rest loop-non-atomic-expr] ["return" form]]) loop-and-clause (loop-clause &rest ["and" loop-clause]) loop-clause (&or [[&or "while" "until" "always" "never" "thereis"] form] [[&or "collect" "collecting" "append" "appending" "nconc" "nconcing" "concat" "vconcat"] form [&optional ["into" loop-var]]] [[&or "count" "counting" "sum" "summing" "maximize" "maximizing" "minimize" "minimizing"] form [&optional ["into" loop-var]] loop-type-spec] [[&or "if" "when" "unless"] form loop-and-clause [&optional ["else" loop-and-clause]] [&optional "end"]] [[&or "do" "doing"] &rest loop-non-atomic-expr] ["return" form] loop-initial-final) loop-non-atomic-expr ([¬ atom] form) loop-var (&or (loop-var . [&or nil loop-var]) [gate symbolp]) loop-type-spec (&optional ["of-type" loop-d-type-spec]) loop-d-type-spec (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec)] 4) emacs-19.30/lisp/cmacexp.elc100666 74777 1 11072 6044071731 14227 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Oct 27 01:53:24 1995 ;;; from file /home/fsf/rms/e19/lisp/cmacexp.el ;;; emacs version 19.29.1.4. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cmacexp.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!‡" [require cc-mode provide cmacexp] 2) #@72 *Non-nil means shrink the *Macroexpansion* window to fit its contents. (defvar c-macro-shrink-window-flag nil (#$ . -533)) #@68 *Non-nil makes `c-macro-expand' prompt for preprocessor arguments. (defvar c-macro-prompt-flag nil (#$ . -662)) #@157 The preprocessor used by the cmacexp package. If you change this, be sure to preserve the `-C' (don't strip comments) option, or to set an equivalent one. (defvar c-macro-preprocessor "/lib/cpp -C" (#$ . 781)) #@47 *Preprocessor flags used by `c-macro-expand'. (defvar c-macro-cppflags "" (#$ . -998)) (byte-code "ÀÁ\nBÁ‡" ["*Macroexpansion*" c-macro-buffer-name current-load-list] 2) #@434 Expand C macros in the region, using the C preprocessor. Normally display output in temp buffer, but prefix arg means replace the region with it. `c-macro-preprocessor' specifies the preprocessor to use. Prompt for arguments to the preprocessor (e.g. `-DDEBUG -I ./include') if the user option `c-macro-prompt-flag' is non-nil. Noninteractive args are START, END, SUBST. For use inside Lisp programs, see also `c-macro-expansion'. (defalias 'c-macro-expand #[(start end subst) "pƒ Á\n!‚Ã\n!ă ÉÊ \" ƒJ\fƒJ „J=„JÎÏ!ˆÐÑ!ˆÒ„JÃ\n!Ó× QØ$ƒv`U|ˆ cˆ…rÚ )‚¦qˆÒ\fÛ!ˆÜ ˆ cˆÝÒ!ˆ Ęƒ™ÎÞ!ˆ‚œß ˆØ\fÒ á!+‡" [subst get-buffer c-macro-buffer-name get-buffer-create "" expansion displaybuf inbuf c-macro-prompt-flag read-string "Preprocessor arguments: " c-macro-cppflags buffer-read-only inhibit-read-only message "Buffer is read only: displaying expansion in alternate window" sit-for 2 nil c-macro-expansion start end c-macro-preprocessor " " t exchange exchange-point-and-mark buffer-disable-undo erase-buffer set-buffer-modified-p "Null expansion" c-macro-display-buffer buffer-auto-save-file-name bury-buffer] 6 (#$ . 1177) "r\nP"]) (defalias 'c-macro-display-buffer #[nil "ebˆÀ ˆÁ Âp!à „ ÇpÈ\"ˆÁ U? …j „-\f…jÊ Ë‰\f ŠÏÂp!!ˆ ƒGÁ ‚I Ñ Ò¥\fÓ\f Ôd!Ò\\]^Á Z!ˆebˆÏ!,+‡" [c-mode window-height get-buffer-window nil popped alreadythere oldwinheight display-buffer t c-macro-shrink-window-flag selected-window 0 maxheight minheight oldwin select-window window-min-height screen-height 2 enlarge-window vertical-motion] 5]) #@324 Run a preprocessor on region and return the output as a string. Expand the region between START and END in the current buffer using the shell command CPPCOMMAND (e.g. "/lib/cpp -C -DDEBUG"). Be sure to use a -C (don't strip comments) or equivalent option. Optional arg DISPLAY non-nil means show messages in the echo area. (defalias 'c-macro-expansion #[(start end cppcommand &optional display) "pÀÁ!\nƒÃÄ !\n\"ƒ\nÆ•ÇO‚È ÉÊ \f͘ƒ*Í‚+Î\f$ÏƉÇÍÆÐÑ!ÝŽŠŒ~ˆqˆÇß ˆà!!ˆâã$#ˆ)Îcˆåã&\"çã`\"nƒã‚‚Æ\\dbˆèé&ê#ƒ¿ëå&`lj%›ìšƒˆÆ•bˆç&`\"\\Éí#cˆÆ”bˆ‚ˆë8.ï80ñ82ó842ƒà΂áÍ.ƒíõ.!‚÷0ƒöö‚÷Í÷.ƒõ.!‚0ƒø‚4…ù2…úR‰Éí#±ˆ,;ƒ4ü!ˆýãdþÿ‰Ç@ABQ&;ƒXüCP!ˆD ÆUƒiEcˆ‚webˆF!ˆã`|ˆGHÄ!IQÇÿ#ƒÆyˆ`JãyˆJ`|ˆ)‚wÆ=„ºebˆÉK\"cˆL!ˆ÷cˆM!ˆã‰dãZ]{. ‡" [get-buffer-create " *C Macro Expansion*" buffer-file-name string-match regexp-quote default-directory 0 nil buffer-name format "Invoking %s%s%s on region..." c-macro-preprocessor c-macro-cppflags "" " " "???!!!???!!! start of c-macro expansion ???!!!???!!!" make-temp-name "/tmp/" tempname exit-status startmarker startstat linenum startlinenum uniquestring mymsg filename outbuf inbuf ((kill-buffer outbuf)) buffer-read-only erase-buffer set-syntax-table c-mode-syntax-table insert-buffer-substring 1 end parse-partial-sexp start count-lines re-search-backward "\n#\\(endif\\|else\\)\\>" move 3 (nil nil nil 0 nil) "\n#line %d \"%s\"\n" startinstring 4 startincomment 5 startafterquote 7 startinbcomment char-to-string "*/" "\n" "/*" "//" "\\" display message call-process-region "sh" t "-c" cppcommand " 2>" "done" buffer-size "\nPreprocessor produced no output\n" search-forward re-search-forward "^# [0-9]+ \"" "\"" beg "Preprocessor terminated with status %s\n" insert-file-contents delete-file] 12 (#$ . 2777)]) emacs-19.30/lisp/cmuscheme.elc100666 74777 1 25640 6014665567 14603 0ustar esrdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Thu Aug 17 12:16:42 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/cmuscheme.el ;;; emacs version 19.29.11. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`cmuscheme.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require scheme comint] 2) #@45 *Hook for customising inferior-scheme mode. (defvar inferior-scheme-mode-hook nil (#$ . -530)) (byte-code "ÀÁ!„ÂÁ B „0Ä !Æ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÌ#ˆÆ ÍÎ#ˆÏ !ˆÆÇÈ#ˆÆÉÊ#ˆÆÑÈ#ˆÆÒÓ#ˆÆÔÕ#ˆÆÖ×#ˆÆØÙ#ˆÆÚÛ#ˆÆÜÝ#ˆÆËÌ#ˆÆÍÎ#ˆÞ B‡" [boundp inferior-scheme-mode-map nil current-load-list copy-keymap comint-mode-map define-key "˜" scheme-send-definition "" scheme-send-last-sexp "\f" scheme-load-file " " scheme-compile-file scheme-mode-commands scheme-mode-map "" "å" scheme-send-definition-and-go "" scheme-send-region "ò" scheme-send-region-and-go "ã" scheme-compile-definition "" scheme-compile-definition-and-go "" switch-to-scheme scheme-buffer] 4) #@1681 Major mode for interacting with an inferior Scheme process. The following commands are available: \{inferior-scheme-mode-map} A Scheme process can be fired up with M-x run-scheme. Customisation: Entry to this mode runs the hooks on comint-mode-hook and inferior-scheme-mode-hook (in that order). You can send text to the inferior Scheme process from other buffers containing Scheme source. switch-to-scheme switches the current buffer to the Scheme process buffer. scheme-send-definition sends the current definition to the Scheme process. scheme-compile-definition compiles the current definition. scheme-send-region sends the current region to the Scheme process. scheme-compile-region compiles the current region. scheme-send-definition-and-go, scheme-compile-definition-and-go, scheme-send-region-and-go, and scheme-compile-region-and-go switch to the Scheme process buffer after sending their text. For information on running multiple processes in multiple buffers, see documentation for variable scheme-buffer. Commands: Return after the end of the process' output sends the text from the end of process to point. Return before the end of the process' output copies the sexp ending at point to the end of the process' output, and sends it. Delete converts tabs to spaces as it moves back. Tab indents for Scheme; with argument, shifts rest of expression rigidly with the current line. C-M-q does Tab on each line starting within following expression. Paragraphs are separated only by blank lines. Semicolons start comments. If you accidentally suspend your process, use \[comint-continue-subjob] to continue it. (defalias 'inferior-scheme-mode #[nil "À ˆÁà ˆÄÆÈ Ê !ˆÌ ÎÐÑ!‡" [comint-mode "^[^>\n]*>+ *" comint-prompt-regexp scheme-mode-variables inferior-scheme-mode major-mode "Inferior Scheme" mode-name (":%s") mode-line-process use-local-map inferior-scheme-mode-map scheme-input-filter comint-input-filter scheme-get-old-input comint-get-old-input run-hooks inferior-scheme-mode-hook] 2 (#$ . 1215) nil]) #@128 *Input matching this regexp are not saved on the history list. Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters. (defvar inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'" (#$ . -3309)) #@60 Don't save anything matching inferior-scheme-filter-regexp (defalias 'scheme-input-filter #[(str) "À \n\"?‡" [string-match inferior-scheme-filter-regexp str] 3 (#$ . 3523)]) #@32 Snarf the sexp ending at point (defalias 'scheme-get-old-input #[nil "Š`Á ˆ`{*‡" [end backward-sexp] 2 (#$ . 3703)]) (defalias 'scheme-args-to-list #[(string) "ÀÁ\n\"‰„\nC‚8 ÄU„%\nÄ OÅ\n Æ\\\nGO!B‚8ÀÇ\n\"‰…7Å\n\nGO!))‡" [string-match "[ ]" string where 0 scheme-args-to-list 1 "[^ ]" pos] 6]) #@44 *Program invoked by the run-scheme command (defvar scheme-program-name "scheme" (#$ . -4017)) #@396 Run an inferior Scheme process, input and output via buffer *scheme*. If there is a process already running in `*scheme*', switch to that buffer. With argument, allows you to edit the command line (default is value of `scheme-program-name'). Runs the hooks `inferior-scheme-mode-hook' (after the `comint-mode-hook' is run). (Type \[describe-mode] in the process buffer for a list of commands.) (defalias 'run-scheme #[(cmd) "ÀÁ!„ !ÅÆÇ\f@È\fA%qˆÉ ˆ) \nÁ ÌÁ!‡" [comint-check-proc "*scheme*" scheme-args-to-list cmd cmdlist apply make-comint "scheme" nil inferior-scheme-mode scheme-program-name scheme-buffer pop-to-buffer] 6 (#$ . 4118) (list (if current-prefix-arg (read-string "Run Scheme: " scheme-program-name) scheme-program-name))]) #@57 Send the current region to the inferior Scheme process. (defalias 'scheme-send-region #[(start end) "ÀÁ \n #ˆÄÁ Å\"‡" [comint-send-region scheme-proc start end comint-send-string "\n"] 4 (#$ . 4869) "r"]) #@61 Send the current definition to the inferior Scheme process. (defalias 'scheme-send-definition #[nil "ŠÀ ˆ` ˆÃ` \"*‡" [end-of-defun end beginning-of-defun scheme-send-region] 3 (#$ . 5080) nil]) #@56 Send the previous sexp to the inferior Scheme process. (defalias 'scheme-send-last-sexp #[nil "ÀŠÁ ˆ`)`\"‡" [scheme-send-region backward-sexp] 3 (#$ . 5282) nil]) #@73 *Template for issuing commands to compile arbitrary Scheme expressions. (defvar scheme-compile-exp-command "(compile '%s)" (#$ . -5451)) #@117 Compile the current region in the inferior Scheme process. (A BEGIN is wrapped around the region: (BEGIN )) (defalias 'scheme-compile-region #[(start end) "ÀÁ  ÂÄ {\"\"\"ˆÀÁ Ç\"‡" [comint-send-string scheme-proc format scheme-compile-exp-command "(begin %s)" start end "\n"] 8 (#$ . 5595) "r"]) #@64 Compile the current definition in the inferior Scheme process. (defalias 'scheme-compile-definition #[nil "ŠÀ ˆ` ˆÃ` \"*‡" [end-of-defun end beginning-of-defun scheme-compile-region] 3 (#$ . 5907) nil]) #@88 Switch to the scheme process buffer. With argument, positions cursor at end of buffer. (defalias 'switch-to-scheme #[(eob-p) "À !ƒ  !ˆ‚ÃÄ!ˆ …Æ ˆdb‡" [get-buffer scheme-buffer pop-to-buffer error "No current process buffer. See variable scheme-buffer." eob-p push-mark] 2 (#$ . 6118) "P"]) #@92 Send the current region to the inferior Scheme process. Then switch to the process buffer. (defalias 'scheme-send-region-and-go #[(start end) "À \n\"ˆÃÄ!‡" [scheme-send-region start end switch-to-scheme t] 3 (#$ . 6419) "r"]) #@89 Send the current definition to the inferior Scheme. Then switch to the process buffer. (defalias 'scheme-send-definition-and-go #[nil "À ˆÁÂ!‡" [scheme-send-definition switch-to-scheme t] 2 (#$ . 6651) nil]) #@92 Compile the current definition in the inferior Scheme. Then switch to the process buffer. (defalias 'scheme-compile-definition-and-go #[nil "À ˆÁÂ!‡" [scheme-compile-definition switch-to-scheme t] 2 (#$ . 6866) nil]) #@88 Compile the current region in the inferior Scheme. Then switch to the process buffer. (defalias 'scheme-compile-region-and-go #[(start end) "À \n\"ˆÃÄ!‡" [scheme-compile-region start end switch-to-scheme t] 3 (#$ . 7090) "r"]) #@255 *Used to determine if a buffer contains Scheme source code. If it's loaded into a buffer that is in one of these major modes, it's considered a scheme source file by scheme-load-file and scheme-compile-file. Used by these commands to determine defaults. (defvar scheme-source-modes (quote (scheme-mode)) (#$ . -7325)) #@180 Caches the last (directory . file) pair. Caches the last pair used in the last scheme-load-file or scheme-compile-file command. Used for determining the default in the next one. (defvar scheme-prev-l/c-dir/file nil (#$ . 7650)) #@54 Load a Scheme file into the inferior Scheme process. (defalias 'scheme-load-file #[(file-name) "À !ˆÂ !à !BÅÆ Ç ÈQ\"‡" [comint-check-source file-name file-name-directory file-name-nondirectory scheme-prev-l/c-dir/file comint-send-string scheme-proc "(load \"" "\")\n"] 5 (#$ . 7885) (comint-get-source "Load Scheme file: " scheme-prev-l/c-dir/file scheme-source-modes t)]) #@55 Compile a Scheme file in the inferior Scheme process. (defalias 'scheme-compile-file #[(file-name) "À !ˆÂ !à !BÅÆ Ç ÈQ\"‡" [comint-check-source file-name file-name-directory file-name-nondirectory scheme-prev-l/c-dir/file comint-send-string scheme-proc "(compile-file \"" "\")\n"] 5 (#$ . 8265) (comint-get-source "Compile Scheme file: " scheme-prev-l/c-dir/file scheme-source-modes nil)]) #@1980 *The current scheme process buffer. MULTIPLE PROCESS SUPPORT =========================================================================== Cmuscheme.el supports, in a fairly simple fashion, running multiple Scheme processes. To run multiple Scheme processes, you start the first up with \[run-scheme]. It will be in a buffer named *scheme*. Rename this buffer with \[rename-buffer]. You may now start up a new process with another \[run-scheme]. It will be in a new buffer, named *scheme*. You can switch between the different process buffers with \[switch-to-buffer]. Commands that send text from source buffers to Scheme processes -- like scheme-send-definition or scheme-compile-region -- have to choose a process to send to, when you have more than one Scheme process around. This is determined by the global variable scheme-buffer. Suppose you have three inferior Schemes running: Buffer Process foo scheme bar scheme<2> *scheme* scheme<3> If you do a \[scheme-send-definition-and-go] command on some Scheme source code, what process do you send it to? - If you're in a process buffer (foo, bar, or *scheme*), you send it to that process. - If you're in some other buffer (e.g., a source file), you send it to the process attached to buffer scheme-buffer. This process selection is performed by function scheme-proc. Whenever \[run-scheme] fires up a new process, it resets scheme-buffer to be the new process's buffer. If you only run one process, this will do the right thing. If you run multiple processes, you can change scheme-buffer to another process buffer with \[set-variable]. More sophisticated approaches are, of course, possible. If you find yourself needing to switch back and forth between multiple processes frequently, you may wish to consider ilisp.el, a larger, more sophisticated package for running inferior Lisp and Scheme processes. The approach taken here is for a minimal, simple implementation. Feel free to extend it. (defvar scheme-buffer nil (#$ . -8664)) #@65 Returns the current scheme process. See variable scheme-buffer. (defalias 'scheme-proc #[nil "À Â=ƒ p‚\f !‰†ÅÆ!)‡" [get-buffer-process major-mode inferior-scheme-mode scheme-buffer proc error "No current process. See variable scheme-buffer"] 4 (#$ . 10689)]) #@88 This hook is run when cmuscheme is loaded in. This is a good place to put keybindings. (defvar cmuscheme-load-hook nil (#$ . 10959)) (byte-code "ÀÁ!ˆÂÃ!‡" [run-hooks cmuscheme-load-hook provide cmuscheme] 2) emacs-19.30/lisp/comint.elc100666 12062 1 146210 6043463600 14046 0ustar bobdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:35:25 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/comint.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`comint.el' was compiled for Emacs 19.29 or later")) (require (quote ring)) #@371 Regexp to recognise prompts in the inferior process. Defaults to "^", the null string at BOL. Good choices: Canonical Lisp: "^[^> \n]*>+:? *" (Lucid, franz, kcl, T, cscheme, oaklisp) Lucid Common Lisp: "^\\(>\\|\\(->\\)+\\) *" franz: "^\\(->\\|<[0-9]*>:\\) *" kcl: "^>+ *" shell: "^[^#$%>\n]*[#$%>] *" T: "^>+ *" This is a good thing to set in mode hooks. (defvar comint-prompt-regexp "^" (#$ . 503)) #@382 List of characters to recognise as separate arguments in input. Strings comprising a character in this list will separate the arguments surrounding them, and also be regarded as arguments in their own right (unlike whitespace). See `comint-arguments'. Defaults to the empty list. For shells, a good value is (?\| ?& ?< ?> ?\( ?\) ?;). This is a good thing to set in mode hooks. (defvar comint-delimiter-argument-list nil (#$ . 925)) #@398 *If non-nil, expand input command history references on completion. This mirrors the optional behavior of tcsh (its autoexpand and histlit). If the value is `input', then the expansion is seen on input. If the value is `history', then the expansion is only when inserting into the buffer's input ring. See also `comint-magic-space' and `comint-dynamic-complete'. This variable is buffer-local. (defvar comint-input-autoexpand nil (#$ . -1368)) #@143 *If non-nil, don't add input matching the last on the input ring. This mirrors the optional behavior of bash. This variable is buffer-local. (defvar comint-input-ignoredups nil (#$ . -1822)) #@199 *If non-nil, name of the file to read/write input history. See also `comint-read-input-ring' and `comint-write-input-ring'. This variable is buffer-local, and is a good thing to set in mode hooks. (defvar comint-input-ring-file-name nil (#$ . -2021)) #@282 *Controls whether input to interpreter causes window to scroll. If nil, then do not scroll. If t or `all', scroll all windows showing buffer. If `this', scroll only the selected window. The default is nil. See `comint-preinput-scroll-to-bottom'. This variable is buffer-local. (defvar comint-scroll-to-bottom-on-input nil (#$ . -2280)) #@405 *Controls whether interpreter output causes window to scroll. If nil, then do not scroll. If t or `all', scroll all windows showing buffer. If `this', scroll only the selected window. If `others', scroll only those that are not the selected window. The default is nil. See variable `comint-scroll-show-maximum-output' and function `comint-postoutput-scroll-to-bottom'. This variable is buffer-local. (defvar comint-scroll-to-bottom-on-output nil (#$ . -2627)) #@262 *Controls how interpreter output causes window to scroll. If non-nil, then show the maximum output when the window is scrolled. See variable `comint-scroll-to-bottom-on-output' and function `comint-postoutput-scroll-to-bottom'. This variable is buffer-local. (defvar comint-scroll-show-maximum-output nil (#$ . -3098)) #@206 *The maximum size in lines for comint buffers. Comint buffers are truncated from the top to be no greater than this number, if the function `comint-truncate-buffer' is on `comint-output-filter-functions'. (defvar comint-buffer-maximum-size 1024 (#$ . -3426)) #@29 Size of input history ring. (defvar comint-input-ring-size 32 (#$ . 3691)) #@183 *If non-nil, assume that the subprocess echoes any input. If so, delete one copy of the input so that only one copy eventually appears in the buffer. This variable is buffer-local. (defvar comint-process-echoes nil (#$ . -3773)) #@117 *Regexp matching prompts for passwords in the inferior process. This is used by `comint-watch-for-password-prompt'. (defvar comint-password-prompt-regexp "\\(\\([Oo]ld \\|[Nn]ew \\|^\\)[Pp]assword\\|pass phrase\\):\\s *\\'" (#$ . -4010)) #@318 Function that returns old text in comint mode. This function is called when return is typed while the point is in old text. It returns the text to be submitted as process input. The default is `comint-get-old-input-default', which grabs the current line, and strips off leading text matching `comint-prompt-regexp'. (defvar comint-get-old-input (quote comint-get-old-input-default) (#$ . 4255)) #@190 List of functions called to perform completion. Functions should return non-nil if completion was performed. See also `comint-dynamic-complete'. This is a good thing to set in mode hooks. (defvar comint-dynamic-complete-functions (quote (comint-replace-by-expanded-history comint-dynamic-complete-filename)) (#$ . 4658)) #@203 Predicate for filtering additions to input history. Takes one argument, the input. If non-nil, the input may be saved on the input history list. Default is to save anything that isn't all whitespace. (defvar comint-input-filter #[(str) "ÀÁ\n\"?‡" [string-match "\\`\\s *\\'" str] 3] (#$ . 4987)) #@160 Functions to call before input is sent to the process. These functions get one argument, a string containing the text to send. This variable is buffer-local. (defvar comint-input-filter-functions nil (#$ . 5292)) #@234 Functions to call after output is inserted into the buffer. One possible function is `comint-postoutput-scroll-to-bottom'. These functions get one argument, a string containing the text just inserted. This variable is buffer-local. (defvar comint-output-filter-functions (quote (comint-postoutput-scroll-to-bottom)) (#$ . 5513)) #@312 Function to actually send to PROCESS the STRING submitted by user. Usually this is just `comint-simple-send', but if your mode needs to massage the input string, put a different function here. `comint-simple-send' just sends the string plus a newline. This is called from the user command `comint-send-input'. (defvar comint-input-sender (quote comint-simple-send) (#$ . 5850)) #@89 *Non-nil means go to the end of the line before sending input. See `comint-send-input'. (defvar comint-eol-on-send t (#$ . -6235)) #@82 Called upon entry into comint-mode This is run before the process is cranked up. (defvar comint-mode-hook nil (#$ . 6372)) #@330 Called each time a process is exec'd by `comint-exec'. This is called after the process is cranked up. It is useful for things that must be done each time a process is executed in a comint mode buffer (e.g., `(process-kill-without-query)'). In contrast, the `comint-mode-hook' is only executed once when the buffer is created. (defvar comint-exec-hook nil (#$ . 6502)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp comint-mode-map nil current-load-list] 2) #@127 Non-nil if communications via pty; false if by pipe. Buffer local. This is to work around a bug in Emacs process signalling. (defvar comint-ptyp t (#$ . 6958)) (byte-code "ÀÁ!„ÂÁ BÄ BÅ BÆ B‡" [boundp comint-input-ring nil current-load-list comint-last-input-start comint-last-input-end comint-last-output-start] 2) #@40 Index of last matched history element. (defvar comint-input-ring-index nil (#$ . 7288)) #@47 Input previously used to match input history. (defvar comint-matching-input-from-input-string "" (#$ . 7382)) (byte-code "ÀÁÂÃ#ˆÀÄÅÆ#ˆÀÇÅÆ#ˆÀÃÅÆ#ˆÀÈÅÆ#ˆÀÉÅÆ#ˆÀÊÅÆ#ˆÀËÅÆ#ˆÀÌÅÆ#ˆÀÍÅÆ#‡" [put comint-replace-by-expanded-history menu-enable comint-input-autoexpand comint-input-ring permanent-local t comint-input-ring-index comint-input-filter-functions comint-output-filter-functions comint-scroll-to-bottom-on-input comint-scroll-to-bottom-on-output comint-scroll-show-maximum-output comint-ptyp] 4) #@1687 Major mode for interacting with an inferior interpreter. Interpreter name is same as buffer name, sans the asterisks. Return at end of buffer sends line as input. Return not at end copies rest of line to end and sends it. Setting variable `comint-eol-on-send' means jump to the end of the line before submitting new input. This mode is customised to create major modes such as Inferior Lisp mode, Shell mode, etc. This can be done by setting the hooks `comint-input-filter-functions', `comint-input-filter', `comint-input-sender' and `comint-get-old-input' to appropriate functions, and the variable `comint-prompt-regexp' to the appropriate regular expression. An input history is maintained of size `comint-input-ring-size', and can be accessed with the commands \[comint-next-input], \[comint-previous-input], and \[comint-dynamic-list-input-ring]. Input ring history expansion can be achieved with the commands \[comint-replace-by-expanded-history] or \[comint-magic-space]. Input ring expansion is controlled by the variable `comint-input-autoexpand', and addition is controlled by the variable `comint-input-ignoredups'. Commands with no default key bindings include `send-invisible', `comint-dynamic-complete', `comint-dynamic-list-filename-completions', and `comint-magic-space'. Input to, and output from, the subprocess can cause the window to scroll to the end of the buffer. See variables `comint-output-filter-functions', `comint-scroll-to-bottom-on-input', and `comint-scroll-to-bottom-on-output'. If you accidentally suspend your process, use \[comint-continue-subjob] to continue it. \{comint-mode-map} Entry to this mode runs the hooks on `comint-mode-hook'. (defalias 'comint-mode #[nil "À ˆÁÃÅÇ!ˆÉÊ!ˆË ‰\neÌ“ˆÉÍ!ˆË ‰ eÌ“ˆÉÎ!ˆË ÉÏ!ˆÉÐ!ˆÉÑ!ˆÉÒ!ˆÓÑ!ƒL„RÔ!ÉÕ!ˆÓÕ!ƒa„dÌÉÖ!ˆÉ×!ˆÉØ!ˆÉÙ!ˆÚÛ!ˆÉÜ!ˆÉÝ!ˆÚÞ!ˆÉß!ˆÉà!ˆÉá!ˆÉâ!ˆÉã!ˆÉä!ˆÉå!ˆæåç\"ˆÚè!ˆÉé!ˆÉê!ˆÉë!ˆÉì!ˆíî!‡" [kill-all-local-variables comint-mode major-mode "Comint" mode-name (":%s") mode-line-process use-local-map comint-mode-map make-local-variable comint-last-input-start make-marker nil comint-last-input-end comint-last-output-start comint-prompt-regexp comint-input-ring-size comint-input-ring comint-input-ring-file-name boundp make-ring comint-input-ring-index comint-matching-input-from-input-string comint-input-autoexpand comint-input-ignoredups comint-delimiter-argument-list make-local-hook comint-dynamic-complete-functions comint-completion-fignore comint-get-old-input comint-input-filter-functions comint-input-filter comint-input-sender comint-eol-on-send comint-scroll-to-bottom-on-input comint-scroll-to-bottom-on-output comint-scroll-show-maximum-output pre-command-hook add-hook comint-preinput-scroll-to-bottom comint-output-filter-functions comint-ptyp comint-exec-hook comint-process-echoes comint-file-name-quote-list run-hooks comint-mode-hook] 4 (#$ . 7888) nil]) (byte-code "„ÆÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÄ#ˆÂÈÆ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆÂáâ#ˆÂãä#ˆÂåæ#ˆÂçÒ#ˆÂèé#ˆÂêë#ˆÂìí#ˆÂîï#ˆÂðñ#ˆÂòóÁó!B#ˆÂôõ#ˆÂö÷#ˆÂøù#ˆÂúû#ˆÂüýÁý!B#ˆÂþÿ#ˆÂ@A#ˆÂBC#ˆÂDE#ˆÂFG#ˆÂHI#ˆÂJK#ˆÂLM#ˆÂNO#ˆÂPQ#ˆÂRS#ˆÂTU#ˆÂVW#ˆÂXY#ˆÂZ[#ˆÂ\\]#ˆÂ^_#ˆÂ`aÁa!B#ˆÂbc#ˆÂde#ˆÂfg#ˆÂhi#ˆÂjk#ˆÂlm#ˆnop\"pÁ‡" [comint-mode-map make-sparse-keymap define-key "p" comint-previous-input "n" comint-next-input [C-up] [C-down] "r" comint-previous-matching-input "s" comint-next-matching-input [-130023310] comint-previous-matching-input-from-input [-130023309] comint-next-matching-input-from-input "\f" comint-show-output " " comint-send-input "" comint-delchar-or-maybe-eof "" comint-bol "" comint-kill-input "" backward-kill-word "" comint-interrupt-subjob "" comint-stop-subjob "" comint-quit-subjob " " comint-copy-old-input "" comint-kill-output "" "" comint-show-maximum-output "\f" comint-dynamic-list-input-ring "" comint-next-prompt "" comint-previous-prompt "" comint-send-eof [menu-bar completion] "Complete" [menu-bar completion complete-expand] ("Expand File Name" . comint-replace-by-expanded-filename) [menu-bar completion complete-listing] ("File Completion Listing" . comint-dynamic-list-filename-completions) [menu-bar completion complete-file] ("Complete File Name" . comint-dynamic-complete-filename) [menu-bar completion complete] ("Complete Before Point" . comint-dynamic-complete) [menu-bar inout] "In/Out" [menu-bar inout kill-output] ("Kill Current Output Group" . comint-kill-output) [menu-bar inout next-prompt] ("Forward Output Group" . comint-next-prompt) [menu-bar inout previous-prompt] ("Backward Output Group" . comint-previous-prompt) [menu-bar inout show-maximum-output] ("Show Maximum Output" . comint-show-maximum-output) [menu-bar inout show-output] ("Show Current Output Group" . comint-show-output) [menu-bar inout kill-input] ("Kill Current Input" . comint-kill-input) [menu-bar inout copy-input] ("Copy Old Input" . comint-copy-old-input) [menu-bar inout forward-matching-history] ("Forward Matching Input..." . comint-forward-matching-input) [menu-bar inout backward-matching-history] ("Backward Matching Input..." . comint-backward-matching-input) [menu-bar inout next-matching-history] ("Next Matching Input..." . comint-next-matching-input) [menu-bar inout previous-matching-history] ("Previous Matching Input..." . comint-previous-matching-input) [menu-bar inout next-matching-history-from-input] ("Next Matching Current Input" . comint-next-matching-input-from-input) [menu-bar inout previous-matching-history-from-input] ("Previous Matching Current Input" . comint-previous-matching-input-from-input) [menu-bar inout next-history] ("Next Input" . comint-next-input) [menu-bar inout previous-history] ("Previous Input" . comint-previous-input) [menu-bar inout list-history] ("List Input History" . comint-dynamic-list-input-ring) [menu-bar inout expand-history] ("Expand History Before Point" . comint-replace-by-expanded-history) [menu-bar signals] "Signals" [menu-bar signals eof] ("EOF" . comint-send-eof) [menu-bar signals kill] ("KILL" . comint-kill-subjob) [menu-bar signals quit] ("QUIT" . comint-quit-subjob) [menu-bar signals cont] ("CONT" . comint-continue-subjob) [menu-bar signals stop] ("STOP" . comint-stop-subjob) [menu-bar signals break] ("BREAK" . comint-interrupt-subjob) append (completion inout signals) menu-bar-final-items] 6) #@170 Return t if there is a living process associated w/buffer BUFFER. Living means the status is `open', `run', or `stop'. BUFFER can be either a buffer or the name of one. (defalias 'comint-check-proc #[(buffer) "À !‰… Ã\n!Ä>)‡" [get-buffer-process buffer proc process-status (open run stop)] 3 (#$ . 14375)]) #@559 Make a comint process NAME in a buffer, running PROGRAM. The name of the buffer is made by surrounding NAME with `*'s. PROGRAM should be either a string denoting an executable program to create via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP connection to be opened via `open-network-stream'. If there is already a running process in that buffer, it is not restarted. Optional third arg STARTFILE is the name of a file to send the contents of to the process. If PROGRAM is a string, any more args are arguments to PROGRAM. (defalias 'make-comint #[(name program &optional startfile &rest switches) "ÀÁ!„\nÂÃ!ˆÄÅÅQ!È!„0ŠqˆÉ ˆ)Ê \f %ˆ)‡" [fboundp start-process error "Multi-processing is not supported for this system" get-buffer-create "*" name buffer comint-check-proc comint-mode comint-exec program startfile switches] 6 (#$ . 14691)]) #@285 Run PROGRAM in a comint buffer and switch to it. The buffer name is made by surrounding the file name of PROGRAM with `*'s. The file name is used to make a symbol name, such as `comint-sh-hook', and any hooks on this symbol are run in the buffer. See `make-comint' and `comint-exec'. (defalias 'comint-run #[(program) "À !ÃÄ\n \"!ˆÅÆÇ\nÈQ!!)‡" [file-name-nondirectory program name switch-to-buffer make-comint run-hooks intern-soft "comint-" "-hook"] 5 (#$ . 15590) "sRun program: "]) #@265 Start up a process in buffer BUFFER for comint modes. Blasts any old process running in the buffer. Doesn't set the buffer mode. You can use this to cheaply run a series of processes in the same comint buffer. The hook `comint-exec-hook' is run after each exec. (defalias 'comint-exec #[(buffer name command startfile switches) "ŠqˆÁ!‰ƒÃ\n!ˆ)\f:ƒ\"Å\f@\fA$‚*Ç\f$É\nÊ\"ˆËÌ!ˆ \fdbˆÎ\n!`Ï“ˆƒbÑÒ!ˆdbˆÓ!ˆ`d{`d|ˆÔ\n\"ˆÕÖ!ˆ*‡" [buffer get-buffer-process proc delete-process command open-network-stream name comint-exec-1 switches set-process-filter comint-output-filter make-local-variable comint-ptyp process-connection-type process-mark nil startfile sleep-for 1 insert-file-contents comint-send-string run-hooks comint-exec-hook] 6 (#$ . 16083)]) (defalias 'comint-exec-1 #[(name buffer command switches) "ÀÁ!ƒ ƒÂÃÄÅ \"D‚ÆÃÇÅ \"DÈÉ!?…$ÊC¤ ¤Ì !ƒ4 ‚5Î  ÏÐ%*‡" [boundp system-uses-terminfo "TERM=unknown" format "COLUMNS=%d" frame-width "TERM=emacs" "TERMCAP=emacs:co#%d:tc=unknown:" getenv "EMACS" "EMACS=t" process-environment file-directory-p default-directory "/" apply start-process name buffer command switches] 6]) #@625 Sets the buffer's `comint-input-ring' from a history file. The name of the file is given by the variable `comint-input-ring-file-name'. The history ring is of size `comint-input-ring-size', regardless of file size. If `comint-input-ring-file-name' is nil this function does nothing. If the optional argument SILENT is non-nil, we say nothing about a failure to read the history file. This function is useful for major mode commands and mode hooks. The structure of the history file should be one input command per line, with the most recent command last. See also `comint-input-ignoredups' and `comint-write-input-ring'. (defalias 'comint-read-input-ring #[(&optional silent) "ƒ\nÁšƒ\f‡Ã!„\f†‰ÅÆ\"‡ÇÈ!ÉÊ !\f ÐŽŠqˆ~ˆÑ ˆÒ!ˆdbˆ  WƒÓÔÂÕ#ƒÖ”Ö•{ƒnÙ\f!„nÚ\fÉ\"˜„uÛ\f\"ˆ) T‰ ‚B*\f‰,‡" [comint-input-ring-file-name "" nil file-readable-p silent message "Cannot read history file %s" get-buffer-create " *temp*" 0 make-ring comint-input-ring-size ring count file history-buf ((kill-buffer history-buf)) erase-buffer insert-file-contents re-search-backward "^[ ]*\\([^#\n].*\\)[ ]*$" t 1 history comint-input-ignoredups ring-empty-p ring-ref ring-insert-at-beginning comint-input-ring comint-input-ring-index] 6 (#$ . 17257)]) #@355 Writes the buffer's `comint-input-ring' to a history file. The name of the file is given by the variable `comint-input-ring-file-name'. The original contents of the file are lost if `comint-input-ring' is not empty. If `comint-input-ring-file-name' is nil this function does nothing. Useful within process sentinels. See also `comint-read-input-ring'. (defalias 'comint-write-input-ring #[nil "ƒÁš„\nƒÃ\n!ƒćÅ!„!ÆÇ\"‡ÈÉ!\n\n \fÍ !Š\nqˆÏ ˆÐVƒSSÑ \"Ò±ˆ‚:ÓÔ Ä\fÄÕ%ˆÖÄ!-‡" [comint-input-ring-file-name "" comint-input-ring ring-empty-p nil file-writable-p message "Cannot write history file %s" get-buffer-create " *Temp Input History*" history-buf ring file ring-length index erase-buffer 0 ring-ref 10 write-region buffer-string no-message kill-buffer] 6 (#$ . 18536)]) #@49 List in help buffer the buffer's input history. (defalias 'comint-dynamic-list-input-ring #[nil "À !ƒ\f !ƒÃÄ!‡ÅÆÇ !SÈ  \n \f\nÍYƒ:Î \n\"\fB\f\nS‰\n‚\" Ï\f!ˆ qˆÐyˆÑÒÅÓ#…XÔÕ!ˆ‚I‘ˆÖÍ!ˆÃ×!ˆØ ‰Ú=ƒsÛ !‚yC‰-‡" [ring-p comint-input-ring ring-empty-p message "No history" nil " *Input History*" ring-length current-window-configuration conf index history-buffer history 0 ring-ref display-completion-list 3 search-backward "completion" move replace-match "history reference" sit-for "Hit space to flush" read-event ch 32 set-window-configuration unread-command-events] 6 (#$ . 19346) nil]) (defalias 'comint-regexp-arg #[(prompt) "À\nÃ\fÀ‰‰Å%‰ǘƒ ‰A@ ‚È !+D‡" [nil minibuffer-history-sexp-flag last-command read-from-minibuffer prompt minibuffer-history-search-history regexp "" prefix-numeric-value current-prefix-arg] 7]) (defalias 'comint-search-arg #[(arg) "À „ ÁÂ!‡ ƒÄ !ƒÁÅ!‡ÇUƒ#È ʇ‡" [comint-after-pmark-p error "Not at command line" comint-input-ring ring-empty-p "Empty input ring" arg 0 nil comint-input-ring-index 1] 2]) (defalias 'comint-search-start #[(arg) "ƒÁ\nÃVƒÄ‚Å\\Æ!\"‡\nÃYƒ ÇÆ!S‡" [comint-input-ring-index mod arg 0 1 -1 ring-length comint-input-ring] 4]) #@97 Return the string ARG places along the input ring. Moves relative to `comint-input-ring-index'. (defalias 'comint-previous-input-string #[(arg) "À \nƒÃ\f\n\\Å !\"‚\f\"‡" [ring-ref comint-input-ring comint-input-ring-index mod arg ring-length] 6 (#$ . 20587)]) #@40 Cycle backwards through input history. (defalias 'comint-previous-input #[(arg) "ÀÁ\n\"‡" [comint-previous-matching-input "." arg] 3 (#$ . 20857) "*p"]) #@39 Cycle forwards through input history. (defalias 'comint-next-input #[(arg) "À [!‡" [comint-previous-input arg] 2 (#$ . 21016) "*p"]) #@113 Return the string matching REGEXP ARG places along the input ring. Moves relative to `comint-input-ring-index'. (defalias 'comint-previous-matching-input-string #[(regexp arg) "À \n\"‰… Ä \")‡" [comint-previous-matching-input-string-position regexp arg pos ring-ref comint-input-ring] 4 (#$ . 21156)]) #@122 Return the index matching REGEXP ARG places along the input ring. Moves relative to START, or `comint-input-ring-index'. (defalias 'comint-previous-matching-input-string-position #[(regexp arg &optional start) "À !ƒ\f !ƒÃÄ!ˆÅ !ÈVƒ É‚!Ê Ì †-Î! Z\"ÐÐÈU„™„™Ì \\\"Wƒƒ„ƒÓÕ \"\"„ƒÌ \\\"‰U‚VÈVƒS‚“T‰‚=ÓÕ \"\"…§-‡" [ring-p comint-input-ring ring-empty-p error "No history" ring-length len arg 0 1 -1 motion mod start comint-search-start n nil tried-each-ring-item prev string-match regexp ring-ref] 6 (#$ . 21468)]) #@218 Search backwards through input history for match for REGEXP. (Previous history elements are earlier commands.) With prefix argument N, search for Nth previous match. If N is negative, find the next or Nth next match. (defalias 'comint-previous-matching-input #[(regexp arg) "À ! \"‰„ÅÆ!‚*\fÈÉ\fT\"ˆÊËp!!`|ˆÌ \f\"c)‡" [comint-search-arg arg comint-previous-matching-input-string-position regexp pos error "Not found" comint-input-ring-index message "History item: %d" process-mark get-buffer-process ring-ref comint-input-ring] 4 (#$ . 22068) (comint-regexp-arg "Previous input matching (regexp): ")]) #@227 Search forwards through input history for match for REGEXP. (Later history elements are more recent commands.) With prefix argument N, search for Nth following match. If N is negative, find the previous or Nth previous match. (defalias 'comint-next-matching-input #[(regexp arg) "À \n[\"‡" [comint-previous-matching-input regexp arg] 3 (#$ . 22686) (comint-regexp-arg "Next input matching (regexp): ")]) #@238 Search backwards through input history for match for current input. (Previous history elements are earlier commands.) With prefix argument N, search for Nth previous match. If N is negative, search forwards for the -Nth following match. (defalias 'comint-previous-matching-input-from-input #[(arg) "Á>„ÂÃp!!`{ÅÇÈÉ\f!P\n\"‡" [last-command (comint-previous-matching-input-from-input comint-next-matching-input-from-input) process-mark get-buffer-process comint-matching-input-from-input-string nil comint-input-ring-index comint-previous-matching-input "^" regexp-quote arg] 4 (#$ . 23097) "p"]) #@243 Search forwards through input history for match for current input. (Following history elements are more recent commands.) With prefix argument N, search for Nth following match. If N is negative, search backwards for the -Nth previous match. (defalias 'comint-next-matching-input-from-input #[(arg) "À [!‡" [comint-previous-matching-input-from-input arg] 2 (#$ . 23705) "p"]) #@681 Expand input command history references before point. Expansion is dependent on the value of `comint-input-autoexpand'. This function depends on the buffer's idea of the input history, which may not match the command interpreter's idea, assuming it has one. Assumes history syntax is like typical Un*x shells'. However, since emacs cannot know the interpreter's idea of input line numbers, assuming it has one, it cannot expand absolute input line number references. If the optional argument SILENT is non-nil, never complain even if history reference seems erroneous. See `comint-magic-space' and `comint-replace-by-expanded-history-before-point'. Returns t if successful. (defalias 'comint-replace-by-expanded-history #[(&optional silent) "…,Á \"…,ŠÄyˆÅ!)…,Ç ÉÊ!ˆË\f!ˆÇ U)?‡" [comint-input-autoexpand string-match "[!^]" comint-get-old-input 0 looking-at comint-prompt-regexp buffer-modified-tick previous-modified-tick message "Expanding history references..." comint-replace-by-expanded-history-before-point silent] 3 (#$ . 24088) nil]) #@116 Expand directory stack reference before point. See `comint-replace-by-expanded-history'. Returns t if successful. (defalias 'comint-replace-by-expanded-history-before-point #[(silent) "ŠŠÀˆ`)`ZÁÀ!ˆ`ÄŠÀˆ` Z)wˆ`ŠÀˆ` Z)W…ˆÀhÆU„7Ç\n`\"ƒ>`Tbˆ‚ÈÉ!ƒOÊ•bˆËÌ!ˆ‚ÈÍ!ƒÎϔϕ{!S‰Ñ!Xƒ„ÓÔÕ!Ö”Ö•#׉#ˆËØT\"ˆ‚ŒÊ•bˆËÙ!ˆ)‚ÈÚ!„œÈÛ!ƒ±ÓÔÕÊ!ϔϕ#׉#ˆËÜ!ˆ‚ÈÝ!ƒ6ϔϕ֔ Ö•! †Î!†Õ{\"ã $åŽÈæ!*ƒéç‚êè)ã *ëŽì)í\"!PÏ\"*‰.„Ê•bˆ/„1Ëð!ˆñ ˆ‚1.ÓÔò.\"ó”ó•#׉#ˆËØ.T\"ˆ.‚Èô!ƒϔϕ{Ö”Ö•{À.56ÓÕÊ!׉#ˆ`.Ê”bˆ÷6.×#„r/„}øð!ˆ‚}Ó5׉#ˆËù!ˆ+‚Ê•bˆ‚+‡" [nil comint-bol start toend "^!^" comint-input-ring-index 92 comint-within-quotes looking-at "![0-9]+\\($\\|[^-]\\)" 0 message "Absolute reference cannot be expanded" "!-\\([0-9]+\\)\\(:?[0-9^$*-]+\\)?" string-to-number 1 number ring-length comint-input-ring replace-match comint-args comint-previous-input-string 2 t "History item: %d" "Relative reference exceeds input history size" "!!?:?\\([0-9^$*-]+\\)" "!!" "History item: previous" "!\\??\\({\\(.+\\)}\\|\\(\\sw+\\)\\)\\(:?[0-9^$*-]+\\)?" mb1 me1 mb2 me2 exp match-data match-data ((store-match-data match-data)) "!\\?" "" "^" pref match-data ((store-match-data match-data)) comint-previous-matching-input-string-position regexp-quote pos silent "Not found" ding ring-ref 4 "\\^\\([^^]+\\)\\^?\\([^^]*\\)\\^?" new old search-forward error "History item: substituted"] 6 (#$ . 25155)]) #@145 Expand input history references before point and insert ARG spaces. A useful command to bind to SPC. See `comint-replace-by-expanded-history'. (defalias 'comint-magic-space #[(arg) "À ˆÁ\n!‡" [comint-replace-by-expanded-history self-insert-command arg] 2 (#$ . 26594) "p"]) #@92 Return t if the number of quotes between BEG and END is odd. Quotes are single and double. (defalias 'comint-within-quotes #[(beg end) "ÀÁ\n #ÀÄ\n #ÇÈ\"ÉU†Ç È\"ÉU*‡" [comint-how-many-region "\\(^\\|[^\\\\]\\)'" beg end "\\(^\\|[^\\\\]\\)\"" countdq countsq mod 2 1] 5 (#$ . 26875)]) #@54 Return number of matches for REGEXP from BEG to END. (defalias 'comint-how-many-region #[(regexp beg end) "ÀŠÂ ÄŽ bˆÆÉ#ƒ T‚ + )‡" [0 count match-data match-data ((store-match-data match-data)) beg re-search-forward regexp end t] 4 (#$ . 27171)]) (defalias 'comint-args #[(string begin end) "À ÂŽ „Ä ÆÇ#‚w fÈ=ƒ T‚  {\nËÌ\n\"ƒ/Í‚JËÎ\n\"ƒ;Æ‚J\nϘƒFÇ‚JÐ\n!ËÒ\n\"ƒXÇ‚mËÓ\n\"ƒkÐ\nÆ•ÇO!‚mÄ #+*‡" [match-data match-data ((store-match-data match-data)) begin comint-arguments string 0 nil 58 end range string-match "^[*^]" 1 "^-" "$" string-to-number nth "[-*$]$" "-" mth] 4]) (defalias 'comint-delim-arg #[(arg) "„ C‡Âà G \fWƒ\\ H ‰>ƒ9 \fWƒN H=ƒN T‰‚$ \fWƒN H>„N T‰‚:  OB*‚+‡" [comint-delimiter-argument-list arg nil 0 len pos args start char] 4]) #@360 Return from STRING the NTH to MTH arguments. NTH and/or MTH can be nil, which means the last argument. Returned arguments are separated by single spaces. We assume whitespace separates arguments, except within quotes. Also, a run of one or more of a single character in `comint-delimiter-argument-list' is a separate argument. Argument 0 is the command name. (defalias 'comint-arguments #[(string nth mth) "ÀÁ‰Á‰‰‰ \n ƒ\" Xƒ{Ì\n #ƒ{ƒH”UƒH• †DΔ‚ƒm O ƒ`  B‚fÏ ! ¤ TΔ”•‚ƒ  O ƒ“  B‚™Ï ! ¤ T†¨S ƒ¶ ZS‚·ÂÓÔ ›Ÿ›Õ#.\n‡" ["[^ \n \"'`]+\\|\\(\"[^\"]*\"\\|'[^']*'\\|`[^`]*`\\)" nil 0 quotes value str beg count pos args argpart mth string-match string 1 comint-delim-arg nth m n mapconcat #[(a) "‡" [a] 1] " "] 8 (#$ . 28003)]) #@1887 Send input to process. After the process output mark, sends all text from the process mark to point as input to the process. Before the process output mark, calls value of variable `comint-get-old-input' to retrieve old input, copies it to the process mark, and sends it. If variable `comint-process-echoes' is nil, a terminal newline is also inserted into the buffer and sent to the process (if it is non-nil, all text from the process mark to point is deleted, since it is assumed the remote process will re-echo it). Any history reference may be expanded depending on the value of the variable `comint-input-autoexpand'. The list of function names contained in the value of `comint-input-filter-functions' is called on the input before sending it. The input is entered into the input history ring, if the value of variable `comint-input-filter' returns non-nil when called on the input. If variable `comint-eol-on-send' is non-nil, then point is moved to the end of line before sending the input. The values of `comint-get-old-input', `comint-input-filter-functions', and `comint-input-filter' are chosen according to the command interpreter running in the buffer. E.g., If the interpreter is the csh, comint-get-old-input is the default: take the current line, discard any initial string matching regexp comint-prompt-regexp. comint-input-filter-functions monitors input for "cd", "pushd", and "popd" commands. When it sees one, it cd's the buffer. comint-input-filter is the default: returns t if the input isn't all white space. If the comint is Lucid Common Lisp, comint-get-old-input snarfs the sexp ending at point. comint-input-filter-functions does nothing. comint-input-filter returns nil if the input matches input-filter-regexp, which matches (1) all whitespace (2) :a, :c, etc. Similarly for Soar, Scheme, etc. (defalias 'comint-send-input #[nil "Àp!‰„ÂÃ!‚ÖÄ !`Æ !Yƒ(ƒ\"Ȉ `{‚7 \n bˆ\ncˆ\n) \fÍ=„E ‚LÎÏ!ˆ `{ \fÐ=„Z ‚nÎÏ!ˆ `{\n `|ˆ cˆ\n)ƒ| `|ˆ‚Òcˆ!ƒ¬ƒ¥Õ!ƒ¥×!„¥ØÙ\"˜„¬Ú\"ˆÛÜ ÝP\"ˆÈ È“ˆ `È“ˆÄ !`È“ˆ!  \"ˆâ ã\",)‡" [get-buffer-process proc error "Current buffer has no process" process-mark pmark marker-position comint-eol-on-send nil comint-get-old-input copy intxt comint-input-autoexpand input comint-replace-by-expanded-history t history comint-process-echoes 10 comint-input-filter comint-input-ignoredups ring-p comint-input-ring ring-empty-p ring-ref 0 ring-insert run-hook-with-args comint-input-filter-functions "\n" comint-input-ring-index comint-last-input-start comint-last-input-end comint-input-sender comint-output-filter ""] 5 (#$ . 28833) nil]) (defalias 'comint-output-filter #[(process string) "À !‰…¹Ã\n!…¹pĉ‰\nqˆ`edÄ GÄ\n \f~ˆÍ !bˆ`\n`XƒG \\`WƒU \\` Xƒ`  \\Î !ˆÏÐ !`UƒxÑÐ ` GZ\"ˆƒ”Ó!ƒ”`Uƒ”‰ ZÄ“ˆ\nÄ“ˆÍ !`Ä“ˆÕ ˆ+ }ˆbˆÖ× \"ˆq,)‡" [process-buffer process oprocbuf buffer-name nil oend obeg opoint obuf string ostart nchars buffer-read-only process-mark insert-before-markers window-start selected-window set-window-start comint-last-input-end marker-buffer comint-last-output-start force-mode-line-update run-hook-with-args comint-output-filter-functions] 5]) #@386 Go to the end of buffer in all windows showing it. Movement occurs if point in the selected window is not after the process mark, and `this-command' is an insertion command. Insertion commands recognised are `self-insert-command', `comint-magic-space', `yank', and `hilit-yank'. Depends on the value of `comint-scroll-to-bottom-on-input'. This function should be a pre-command hook. (defalias 'comint-preinput-scroll-to-bottom #[nil "…7 Â>…7à pÆ !…6`É!W…6Ê=ƒ1db‚6ËÌÍÎ#,‡" [comint-scroll-to-bottom-on-input this-command (self-insert-command comint-magic-space yank hilit-yank) selected-window selected current get-buffer-process process scroll process-mark this walk-windows #[(window) "À !\n=… Ä=„ Å=…Æ !ˆdbˆÆ!‡" [window-buffer window current scroll t all select-window selected] 2] nil t] 4 (#$ . 32122)]) #@292 Go to the end of buffer in all windows showing it. Does not scroll if the current line is the last line in the buffer. Depends on the value of `comint-scroll-to-bottom-on-output' and `comint-scroll-show-maximum-output'. This function should be in the list `comint-output-filter-functions'. (defalias 'comint-postoutput-scroll-to-bottom #[(string) "À pÃ\n! ÇŽ\f…ÈÉÊË#-‡" [selected-window selected current get-buffer-process process comint-scroll-to-bottom-on-output scroll ((set-buffer current)) walk-windows #[(window) "À !\n=…ià !ˆ`Ä !WƒOÇ=„JÈ=„JÉ=ƒ0\n =„JË=ƒ>\n =ƒJ`Ä !\fGZYƒOÄ !bˆ ƒe`Ä !YƒeŠdbˆÎÏ!ˆ)Ã\n!‡" [window-buffer window current select-window process-mark process scroll t all this selected others string comint-scroll-show-maximum-output recenter -1] 3] nil t] 4 (#$ . 32966)]) #@132 Truncate the buffer to `comint-buffer-maximum-size'. This function could be on `comint-output-filter-functions' or bound to a key. (defalias 'comint-truncate-buffer #[(&optional string) "Šdbˆ[yˆÁyˆe`|)‡" [comint-buffer-maximum-size 0] 2 (#$ . 33794) nil]) #@141 Strip trailing `^M' characters from the current output group. This function could be on `comint-output-filter-functions' or bound to a key. (defalias 'comint-strip-ctrl-m #[(&optional string) "ÀÁp!!Štƒ ‚\fbˆÅÆ\nÇ#…#ÈÉlj#ˆ‚*‡" [process-mark get-buffer-process pmark comint-last-input-end comint-last-output-start re-search-forward " +$" t replace-match ""] 4 (#$ . 34058) nil]) (defalias (quote shell-strip-ctrl-m) (quote comint-strip-ctrl-m)) #@56 Put the end of the buffer at the bottom of the window. (defalias 'comint-show-maximum-output #[nil "dbˆÀÁ!‡" [recenter -1] 2 (#$ . 34515) nil]) #@122 Default for `comint-get-old-input'. Take the current line, and discard any initial text matching `comint-prompt-regexp'. (defalias 'comint-get-old-input-default #[nil "ŠÀyˆÁ ˆ`È\n`{*‡" [0 comint-skip-prompt beg nil] 2 (#$ . 34666)]) #@114 Insert after prompt old input at point as new input to be edited. Calls `comint-get-old-input' to get old input. (defalias 'comint-copy-old-input #[nil " Áp!\n„ÄÅ!‚Æ\n!bˆ c*‡" [comint-get-old-input get-buffer-process process input error "Current buffer has no process" process-mark] 3 (#$ . 34909) nil]) #@130 Skip past the text matching regexp `comint-prompt-regexp'. If this takes us past the end of the current line, don't skip at all. (defalias 'comint-skip-prompt #[nil "ŠÀˆ`) !…Ä• X…Ä•b)‡" [nil eol looking-at comint-prompt-regexp 0] 2 (#$ . 35227)]) #@55 Return t if point is after the process output marker. (defalias 'comint-after-pmark-p #[nil "ÀÁp!!Ã\n!`X)‡" [process-mark get-buffer-process pmark marker-position] 3 (#$ . 35487)]) #@145 Default function for sending to PROC input STRING. This just sends STRING plus a newline. To override this, set the hook `comint-input-sender'. (defalias 'comint-simple-send #[(proc string) "À \n\"ˆÀ Ã\"‡" [comint-send-string proc string "\n"] 3 (#$ . 35676)]) #@271 Goes to the beginning of line, then skips past the prompt, if any. If prefix argument is given (\[universal-argument]) the prompt is not skipped. The prompt skip is done by skipping text matching the regular expression `comint-prompt-regexp', a buffer local variable. (defalias 'comint-bol #[(arg) "Àyˆ ?…\n ‡" [0 arg comint-skip-prompt] 1 (#$ . 35944) "P"]) #@598 Read a single line of text from user without echoing, and return it. Prompt with argument PROMPT, a string. Optional argument STARS causes input to be echoed with '*' characters on the prompt line. Input ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. C-g aborts (if `inhibit-quit' is set because e.g. this function was called from a process filter and C-g is pressed, this function returns nil rather than a string). Note that the keystrokes comprising the text can still be recovered (temporarily) with \[view-lossage]. This may be a security bug for some applications. (defalias 'comint-read-noecho #[(prompt &optional stars) "ÀÁ‰ÂÉ \f„•\nƒ(ËÌ Î GÏ\"#ˆ‚.ËÐ \"ˆÑ ‰ÒUƒA‰‚ÔU„VÕU„VÖUƒ\\‰‚×UƒiÀ ‚ØU„ƒÙU„ƒ Ú!P ‚ GÁVƒ ÁÛO ‚ƒ©Ã‰ËÜ!ˆÝÂ!ˆ‚¯ËÀ!ˆ .‡" ["" 0 t nil done message-log-max cursor-in-echo-area echo-keystrokes c ans stars message "%s%s" prompt make-string 42 "%s" read-char-exclusive 7 quit-flag 13 10 27 21 8 127 char-to-string -1 "Quit" beep] 7 (#$ . 36314)]) #@259 Read a string without echoing. Then send it to the process running in the current buffer. A new-line is additionally sent. String is not saved on comint input history list. Security bug: your string can still be temporarily recovered with \[view-lossage]. (defalias 'send-invisible #[(str) "Àp!‰„ÂÃ!‚#Ä ;ƒ ‚ÆÇÈ\"\"ˆÄ É\")‡" [get-buffer-process proc error "Current buffer has no process" comint-send-string str comint-read-noecho "Non-echoed text: " t "\n"] 6 (#$ . 37382) "P"]) #@305 Prompt in the minibuffer for password and send without echoing. This function uses `send-invisible' to read and send a password to the buffer's process if STRING contains a password prompt defined by `comint-password-prompt-regexp'. This function could be in the list `comint-output-filter-functions'. (defalias 'comint-watch-for-password-prompt #[(string) "À \n\"…\nÃÄ!‡" [string-match comint-password-prompt-regexp string send-invisible nil] 3 (#$ . 37878)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias comint-send-string process-send-string comint-send-region process-send-region] 3) #@80 Kill all output from interpreter since last input. Does not delete the prompt. (defalias 'comint-kill-output #[nil "Àp!ÁŠÄ !bˆÅyˆÆ |ˆÄ !bˆÉ`{P`|ˆ*Ê \n\"*‡" [get-buffer-process nil replacement proc process-mark 0 point-marker pmark comint-last-input-end "*** output flushed ***\n" comint-output-filter] 3 (#$ . 38466) nil]) #@127 Display start of this batch of interpreter output at top of window. Sets mark to the value of point when this command is run. (defalias 'comint-show-output #[nil "À ˆ` !†\fdbˆÄyˆÅÆ `\"ˆÇ )‡" [push-mark pos marker-position comint-last-input-end -1 set-window-start selected-window comint-skip-prompt] 3 (#$ . 38809) nil]) #@31 Interrupt the current subjob. (defalias 'comint-interrupt-subjob #[nil "ÀÁ\n\"‡" [interrupt-process nil comint-ptyp] 3 (#$ . 39139) nil]) #@41 Send kill signal to the current subjob. (defalias 'comint-kill-subjob #[nil "ÀÁ\n\"‡" [kill-process nil comint-ptyp] 3 (#$ . 39283) nil]) #@41 Send quit signal to the current subjob. (defalias 'comint-quit-subjob #[nil "ÀÁ\n\"‡" [quit-process nil comint-ptyp] 3 (#$ . 39427) nil]) #@292 Stop the current subjob. WARNING: if there is no current subjob, you can end up suspending the top-level process running in the buffer. If you accidentally do this, use \[comint-continue-subjob] to resume the process. (This is not a problem with most shells, since they ignore this signal.) (defalias 'comint-stop-subjob #[nil "ÀÁ\n\"‡" [stop-process nil comint-ptyp] 3 (#$ . 39572) nil]) #@111 Send CONT signal to process buffer's process group. Useful if you accidentally suspend the top-level process. (defalias 'comint-continue-subjob #[nil "ÀÁ\n\"‡" [continue-process nil comint-ptyp] 3 (#$ . 39968) nil]) #@63 Kill all text from last stuff output by interpreter to point. (defalias 'comint-kill-input #[nil "ÀÁp!!`Ã\n!V…Ä\n`\")‡" [process-mark get-buffer-process pmark marker-position kill-region] 3 (#$ . 40190) nil]) #@74 Delete ARG characters forward, or (if at eob) send an EOF to subprocess. (defalias 'comint-delchar-or-maybe-eof #[(arg) "mƒÀ ‡Á\n!‡" [process-send-eof delete-char arg] 2 (#$ . 40408) "p"]) #@46 Send an EOF to the current buffer's process. (defalias 'comint-send-eof #[nil "À ‡" [process-send-eof] 1 (#$ . 40605) nil]) #@229 Search backward through buffer for match for REGEXP. Matches are searched for on lines that match `comint-prompt-regexp'. With prefix argument N, search for Nth previous match. If N is negative, find the next or Nth next match. (defalias 'comint-backward-matching-input #[(regexp arg) "Á\nQŠ\fÅVƒÅ‚ÆˆÇ ÈÉ\f$…`)‰\n„-ËÌ!ˆÍ ‚4\nbˆÎÈ!*‡" [comint-prompt-regexp ".*" regexp re arg 0 1 re-search-backward nil t pos message "Not found" ding comint-bol] 6 (#$ . 40736) (comint-regexp-arg "Backward input matching (regexp): ")]) #@237 Search forward through buffer for match for REGEXP. Matches are searched for on lines that match `comint-prompt-regexp'. With prefix argument N, search for Nth following match. If N is negative, find the previous or Nth previous match. (defalias 'comint-forward-matching-input #[(regexp arg) "À \n[\"‡" [comint-backward-matching-input regexp arg] 3 (#$ . 41275) (comint-regexp-arg "Forward input matching (regexp): ")]) #@75 Move to end of Nth next prompt in the buffer. See `comint-prompt-regexp'. (defalias 'comint-next-prompt #[(n) "\nÃVƒ\fÄ‚ ÈÅ\n!ˆÆ )‡" [comint-prompt-regexp paragraph-start n 0 1 forward-paragraph comint-skip-prompt] 2 (#$ . 41701) "p"]) #@79 Move to end of Nth previous prompt in the buffer. See `comint-prompt-regexp'. (defalias 'comint-previous-prompt #[(n) "À [!‡" [comint-next-prompt n] 2 (#$ . 41949) "p"]) (defalias 'comint-source-default #[(previous-dir/file source-modes) "ƒ \n>ƒÃ!Ä!B‡ †ÇB‡" [buffer-file-name major-mode source-modes file-name-directory file-name-nondirectory previous-dir/file default-directory nil] 3]) (defalias 'comint-check-source #[(fname) "À !‰…&Ã\n!…&ÄÅÆÇ\n!\"!…&p\nqˆÉ ˆq))‡" [get-file-buffer fname buff buffer-modified-p y-or-n-p format "Save buffer %s first? " buffer-name old-buffer save-buffer] 6]) #@66 Return string around POINT that starts the current line, or nil. (defalias 'comint-extract-string #[nil "Š`Áyˆ`È`bˆÅÆ\nÇ#…`TbˆÉÆ\fÇ#…)`S\n…:\n…:\n{.‡" [point 0 bol nil eol search-backward "\"" t start search-forward end] 4 (#$ . 42569)]) (defalias 'comint-get-source #[(prompt prev-dir/file source-modes mustmatch-p) "À \n\"Ä ‰…ÆÇÈ…É !?‰\nƒ#Ë !‚% @\f\nƒ2Í !‚4 AσFÐÑ#‚H\f‰P$ÕÖ!!.C‡" [comint-source-default prev-dir/file source-modes def comint-extract-string stringfile nil (file-exists-p stringfile) ((error)) file-directory-p sfile-p file-name-directory defdir file-name-nondirectory deffile read-file-name format "%s(default %s) " prompt mustmatch-p ans expand-file-name substitute-in-file-name] 6]) (defalias 'comint-proc-query #[(proc str) "À !à !Å\n!ˆ\nqˆÆ\n!Ç\f! Ê  \"ˆÌ !ˆÍ \"?…TÎ !Ð \f\"ˆÑÒ!ˆÍ \"„MÓ!‚SÐ \"),‡" [process-buffer proc proc-buf process-mark proc-mark display-buffer get-buffer-window marker-position proc-pt proc-win comint-send-string str accept-process-output pos-visible-in-window-p window-point opoint set-window-point sit-for 0 push-mark] 3]) #@113 *If non-nil, automatically list possiblities on partial completion. This mirrors the optional behavior of tcsh. (defvar comint-completion-autolist nil (#$ . -43728)) #@264 *If non-nil, add a `/' to completed directories, ` ' to file names. If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact completion. This mirrors the optional behavior of tcsh. (defvar comint-completion-addsuffix t (#$ . -43901)) #@188 *If non-nil, use shortest completion if characters cannot be added. This mirrors the optional behavior of tcsh. A non-nil value is useful if `comint-completion-autolist' is non-nil too. (defvar comint-completion-recexact nil (#$ . -44224)) #@182 *List of suffixes to be disregarded during file completion. This mirrors the optional behavior of bash and tcsh. Note that this applies to `comint-dynamic-complete-filename' only. (defvar comint-completion-fignore nil (#$ . -44472)) #@171 Prefix prepended to absolute file names taken from process input. This is used by comint's and shell's completion functions, and by shell's directory tracking functions. (defvar comint-file-name-prefix "" (#$ . 44713)) #@102 List of characters to quote with `' when in a file name. This is a good thing to set in mode hooks. (defvar comint-file-name-quote-list nil (#$ . 44939)) (defalias 'comint-directory #[(directory) "ÀÁ\n!ƒ \nP‚\n!‡" [expand-file-name file-name-absolute-p directory comint-file-name-prefix] 3]) #@191 Return the word of WORD-CHARS at point, or nil if non is found. Word constituents are considered to be those in WORD-CHARS, which is like the inside of a "[...]" (see `skip-chars-forward'). (defalias 'comint-word #[(word-chars) "ŠÀ ÂQ`Å\fÆÇ#ƒhÈ=ƒÉÊ!ˆ‚oƒ'Ë\f!ƒ*Êuˆ` W…9Ì` D!ˆÍÎ!+‡" ["[^\\\\" word-chars "]" here non-word-chars re-search-backward nil move 92 backward-char 1 looking-at store-match-data match-string 0] 4 (#$ . 45243)]) #@114 Return the filename at point, or nil if non is found. Environment variables are substituted. See `comint-word'. (defalias 'comint-match-partial-filename #[nil "ÀÁ!‰… ÃÄ\n!!)‡" [comint-word "~/A-Za-z0-9+@:_.$#%,={}-" filename substitute-in-file-name comint-unquote-filename] 4 (#$ . 45695)]) #@108 Return FILENAME with magic characters quoted. Magic characters are those in `comint-file-name-quote-list'. (defalias 'comint-quote-filename #[(filename) "„ ‡ÂÃÄÅÆ#\"È  ÊŽË \"ƒ(ÌÍΉ $‚ +‡" [comint-file-name-quote-list filename format "\\(^\\|[^\\]\\)\\([%s]\\)" mapconcat char-to-string "" regexp match-data match-data ((store-match-data match-data)) string-match replace-match "\\1\\\\\\2" nil] 6 (#$ . 45996)]) #@50 Return FILENAME with quoted characters unquoted. (defalias 'comint-unquote-filename #[(filename) "„ ‡Â ÄŽÅÆ \"ƒÇÈɉ $‚ *‡" [comint-file-name-quote-list filename match-data match-data ((store-match-data match-data)) string-match "\\\\\\(.\\)" replace-match "\\1" nil] 5 (#$ . 46427)]) #@212 Dynamically perform completion at point. Calls the functions in `comint-dynamic-complete-functions' to perform completion until a function returns non-nil, at which point completion is assumed to have occurred. (defalias 'comint-dynamic-complete #[nil "ÀÁ!‡" [run-hook-with-args-until-success comint-dynamic-complete-functions] 2 (#$ . 46727) nil]) #@705 Dynamically complete the filename at point. Completes if after a filename. See `comint-match-partial-filename' and `comint-dynamic-complete-as-filename'. This function is similar to `comint-replace-by-expanded-filename', except that it won't change parts of the filename already entered in the buffer; it just adds completion characters to the end of the filename. A completions listing may be shown in a help buffer if completion is ambiguous. Completion is dependent on the value of `comint-completion-addsuffix', `comint-completion-recexact' and `comint-completion-fignore', and the timing of completions listing is dependent on the value of `comint-completion-autolist'. Returns t if successful. (defalias 'comint-dynamic-complete-filename #[nil "À …Á !„ÃÄ!ˆÅ ‡" [comint-match-partial-filename window-minibuffer-p selected-window message "Completing file name..." comint-dynamic-complete-as-filename] 2 (#$ . 47083) nil]) #@112 Dynamically complete at point as a filename. See `comint-dynamic-complete-filename'. Returns t if successful. (defalias 'comint-dynamic-complete-as-filename #[nil "À\nÀÅÆ !È \n„Ë‚%\n:„\"Ì‚%\n@ \n„0Ë‚=\n:„:΂=\nAÐ †EËÒ!Ô!ƒ_Ö!‚aÙ\"‰„{ÛÜ\"ˆÀ ‚-È=ƒ’cˆ„-ÛÝ!ˆ‚-˘ƒŸÞ ˆ‚-ß!P áâ!GÀO!cˆÙ\"9ƒÛã !ƒË ‚Ícˆ„,Ûä!ˆ‚,%ƒ\nƒ˜ƒæ !ƒã !ƒ ‚cˆ„,Ûç!ˆ‚,(„˜ƒ#Þ ˆ‚,„,Ûé!ˆ) .\f‡" [nil completion-ignore-case comint-completion-fignore completion-ignored-extensions file-name-handler-alist window-minibuffer-p selected-window minibuffer-p t success comint-completion-addsuffix "" "/" dirsuffix " " filesuffix comint-match-partial-filename filename file-name-directory pathdir file-name-nondirectory pathnondir comint-directory default-directory directory file-name-completion completion message "No completions of %s" "Sole completion" comint-dynamic-list-filename-completions file-name-as-directory file comint-quote-filename directory-file-name file-directory-p "Completed" comint-completion-recexact file-exists-p "Completed shortest" comint-completion-autolist "Partially completed"] 5 (#$ . 48025)]) #@477 Dynamically expand and complete the filename at point. Replace the filename with an expanded, canonicalised and completed replacement. "Expanded" means environment variables (e.g., $HOME) and `~'s are replaced with the corresponding directories. "Canonicalised" means `..' and `.' are removed, and the filename is made absolute instead of relative. For expansion see `expand-file-name' and `substitute-in-file-name'. For completion see `comint-dynamic-complete-filename'. (defalias 'comint-replace-by-expanded-filename #[nil "ÀÁ !É#ˆÄ ‡" [replace-match expand-file-name comint-match-partial-filename t comint-dynamic-complete-filename] 4 (#$ . 49241) nil]) #@592 Dynamically complete STUB from CANDIDATES list. This function inserts completion characters at point by completing STUB from the strings in CANDIDATES. A completions listing may be shown in a help buffer if completion is ambiguous. Returns nil if no completion was inserted. Returns `sole' if completed with the only completion match. Returns `shortest' if completed with the shortest of the completion matches. Returns `partial' if completed as far as possible with the completion matches. Returns `listed' if a completion listing was shown. See also `comint-dynamic-complete-filename'. (defalias 'comint-dynamic-simple-complete #[(stub candidates) "À\n„\nÂ\n:„Ä‚\nAÆÇ\"É\n\"‰ „3ÌÍ\n\"ˆÀ‚³ GÎUƒc @‰\n˜ƒNÌÐ!ˆ‚[\nGÀOcˆÌÑ!ˆ cˆ)Ò‚³Ó\n\"‰\nGÀOcˆƒ—\nƒ—\n˜ƒ— ƒ— cˆÌÕ!ˆÖ‚²„¤\n˜ƒ­Ø !ˆÙ‚²ÌÚ!ˆÛ),‡" [nil completion-ignore-case comint-completion-addsuffix "" " " suffix mapcar #[(x) "C‡" [x] 1] candidates all-completions stub completions message "No completions of %s" 1 completion "Sole completion" "Completed" sole try-completion comint-completion-recexact "Completed shortest" shortest comint-completion-autolist comint-dynamic-list-completions listed "Partially completed" partial] 4 (#$ . 49911)]) #@68 List in help buffer possible completions of the filename at point. (defalias 'comint-dynamic-list-filename-completions #[nil "ÀÀà †\nÄÆ !È ! ƒ!Ê!‚# \fÍ \f\"‰„8ÏÐ \"‚?ÑÒÓ\"!.‡" [nil completion-ignore-case file-name-handler-alist comint-match-partial-filename "" filename file-name-directory pathdir file-name-nondirectory pathnondir comint-directory default-directory directory file-name-all-completions completions message "No completions of %s" comint-dynamic-list-completions mapcar comint-quote-filename] 5 (#$ . 51176) nil]) #@77 List in help buffer sorted COMPLETIONS. Typing SPC flushes the help buffer. (defalias 'comint-dynamic-list-completions #[(completions) "À ÂÃÄ Æ\"!‘ˆÇÈ!ˆÉ‰\n ŠÌÂ!qˆÍÉ!‰ ÎH‰\n:…T\n‰A@):…TÐ\n‰A@)‰@)!ÌÂ!=…TÒ !Ó=)ƒcÓ\n!ˆÔ !‚w\nÕ=ƒpÔ !‚wÖ !‰+‡" [current-window-configuration conf "*Completions*" display-completion-list sort completions string-lessp message "Hit space to flush" nil first key get-buffer read-key-sequence 0 event window-buffer position key-binding mouse-choose-completion set-window-configuration 32 listify-key-sequence unread-command-events] 6 (#$ . 51735)]) (provide (quote comint)) emacs-19.30/lisp/compile.elc100666 12062 1 72176 6052010631 14166 0ustar bobdaemon;ELC ;;; compiled by roland@snoopy.gnu.ai.mit.edu on Mon Nov 13 23:50:25 1995 ;;; from file /usr/src/emacs-build/lisp/compile.el ;;; emacs version 19.29.91.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`compile.el' was compiled for Emacs 19.29 or later")) #@70 *List of hook functions run by `compilation-mode' (see `run-hooks'). (defvar compilation-mode-hook nil (#$ . -480)) #@71 *Number of lines in a compilation window. If nil, use Emacs default. (defvar compilation-window-height nil (#$ . -602)) #@743 List of error message descriptors for visiting erring functions. Each error descriptor is a cons (or nil). Its car is a marker pointing to an error message. If its cdr is a marker, it points to the text of the line the message is about. If its cdr is a cons, it is a list ((DIRECTORY . FILE) LINE [COLUMN]). Or its cdr may be nil if that error is not interesting. The value may be t instead of a list; this means that the buffer of error messages should be reparsed the next time the list of errors is wanted. Some other commands (like `diff') use this list to control the error message tracking facilites; if you change its structure, you should make sure you also change those packages. Perhaps it is better not to change it at all. (defvar compilation-error-list nil (#$ . 730)) #@61 Value of `compilation-error-list' after errors were parsed. (defvar compilation-old-error-list nil (#$ . 1525)) #@440 Function to call to parse error messages from a compilation. It takes args LIMIT-SEARCH and FIND-AT-LEAST. If LIMIT-SEARCH is non-nil, don't bother parsing past that location. If FIND-AT-LEAST is non-nil, don't bother parsing after finding that many new errors. It should read in the source files which have errors and set `compilation-error-list' to a list with an element for each error message found. See that variable for more info. (defvar compilation-parse-errors-function (quote compilation-parse-errors) (#$ . 1644)) #@247 Function to compute the name of a compilation buffer. The function receives one argument, the name of the major mode of the compilation buffer. It should return a string. nil means compute the name with `(concat "*" (downcase major-mode) "*")'. (defvar compilation-buffer-name-function nil (#$ . 2178)) #@163 *Function to call when a compilation process finishes. It is called with two arguments: the compilation buffer, and a string describing how the process finished. (defvar compilation-finish-function nil (#$ . -2489)) #@162 The most recent compilation buffer. A buffer becomes most recent when its compilation is started or when it is used with \[next-error] or \[compile-goto-error]. (defvar compilation-last-buffer nil (#$ . 2712)) #@44 List of compilation processes now running. (defvar compilation-in-progress nil (#$ . 2928)) (byte-code "À ž„\n BÀ‡" [compilation-in-progress minor-mode-alist (compilation-in-progress " Compiling")] 2) #@65 Position of end of buffer when last error messages were parsed. (defvar compilation-parsing-end nil (#$ . 3138)) #@50 Message to print when no more matches are found. (defvar compilation-error-message "No more errors" (#$ . 3257)) (byte-code "À BÀ‡" [compilation-num-errors-found current-load-list] 2) #@526 Alist that specifies how to match errors in compiler output. Each elt has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX FILE-FORMAT...]) If REGEXP matches, the FILE-IDX'th subexpression gives the file name, and the LINE-IDX'th subexpression gives the line number. If COLUMN-IDX is given, the COLUMN-IDX'th subexpression gives the column number on that line. If any FILE-FORMAT is given, each is a format string to produce a file name to try; %s in the string is replaced by the text matching the FILE-IDX'th subexpression. (defvar compilation-error-regexp-alist (quote (("\n\\([^:( \n]+\\)[:(][ ]*\\([0-9]+\\)\\([) ]\\|:\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 2 5) ("\n\\(Error\\|Warning\\) \\([^:( \n]+\\) \\([0-9]+\\)\\([) ]\\|:[^0-9\n]\\)" 2 3) ("[ :]\\([^:( \n]+\\)[:(](+[ ]*\\([0-9]+\\))[:) ]*$" 1 2) ("([ ]*\\([^:( \n]+\\)[:(][ ]*\\([0-9]+\\))" 1 2) ("\n\\(cfe\\|fort\\): [^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3) ("\\(\n\\|on \\)[Ll]ine[ ]+\\([0-9]+\\)[ ]+of[ ]+\"?\\([^\":\n]+\\)\"?:" 3 2) ("\"\\([^,\" \n ]+\\)\", lines? \\([0-9]+\\)[:., (-]" 1 2) ("rror: \\([^,\" \n ]+\\)[,:] \\(line \\)?\\([0-9]+\\):" 1 3) ("in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1) ("\n[EW], \\([^(\n]*\\)(\\([0-9]+\\),[ ]*\\([0-9]+\\)" 1 2 3) ("\n[^0-9 \n :]+:[ ]*\\([^ \n :]+\\):\\([0-9]+\\):\\(\\([0-9]+\\)[: ]\\)?" 1 2 4) ("\n\\(cc\\| cft\\)-[0-9]+ c\\(c\\|f77\\): ERROR \\([^,\n]+, \\)* File = \\([^,\n]+\\), Line = \\([0-9]+\\)" 4 5) ("\n\\([^( \n ]+\\)(\\([0-9]+\\):\\([0-9]+\\)) : " 1 2 3) ("\n\\([^, ]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., (-]" 1 2 3))) (#$ . 3449)) #@128 If not nil, M-x compile reads the compilation command to use. Otherwise, M-x compile just uses the value of `compile-command'. (defvar compilation-read-command t (#$ . 5064)) #@127 If not nil, M-x compile asks which buffers to save before compiling. Otherwise, it saves all modified buffers without asking. (defvar compilation-ask-about-save t (#$ . 5246)) #@72 Regexp used to match grep hits. See `compilation-error-regexp-alist'. (defvar grep-regexp-alist (quote (("^\\([^:( \n]+\\)[:( ]+\\([0-9]+\\)[:) ]" 1 2))) (#$ . 5428)) #@59 Last grep command used in \[grep]; default for next grep. (defvar grep-command "grep -n " (#$ . 5605)) #@195 *List of directories to search for source files named in error messages. Elements should be directory names, not file names of directories. nil as an element means to try the default directory. (defvar compilation-search-path (quote (nil)) (#$ . -5715)) #@467 Last shell command used to do a compilation; default for next compilation. Sometimes it is useful for files to supply local values for this variable. You might also use mode hooks to specify it in certain modes, like this: (setq c-mode-hook '(lambda () (or (file-exists-p "makefile") (file-exists-p "Makefile") (progn (make-local-variable 'compile-command) (setq compile-command (concat "make -k " buffer-file-name)))))) (defvar compile-command "make -k " (#$ . 5976)) #@208 Regular expression matching lines that indicate a new current directory. This must contain one \(, \) pair around the directory name. The default value matches lines printed by the `-w' option of GNU Make. (defvar compilation-enter-directory-regexp ": Entering directory `\\(.*\\)'$" (#$ . 6497)) #@349 Regular expression matching lines that indicate restoring current directory. This may contain one \(, \) pair around the name of the directory being moved from. If it does not, the last directory entered (by a line matching `compilation-enter-directory-regexp') is assumed. The default value matches lines printed by the `-w' option of GNU Make. (defvar compilation-leave-directory-regexp ": Leaving directory `\\(.*\\)'$" (#$ . 6802)) #@139 Stack of previous directories for `compilation-leave-directory-regexp'. The head element is the directory the compilation was started in. (defvar compilation-directory-stack nil (#$ . 7247)) #@304 If non-nil, called when a compilation process dies to return a status message. This should be a function a two arguments as passed to a process sentinel (see `set-process-sentinel); it returns a cons (MESSAGE . MODELINE) of the strings to write into the compilation buffer, and to put in its mode line. (defvar compilation-exit-message-function nil (#$ . 7445)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp compile-history nil current-load-list grep-history] 2) #@58 Additional expressions to highlight in Compilation mode. (defvar compilation-mode-font-lock-keywords (quote (("^\\([^ \n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$" 1 font-lock-function-name-face))) (#$ . 7916)) #@799 Compile the program including the current buffer. Default: run `make'. Runs COMMAND, a shell command, in a separate process asynchronously with output going to the buffer `*compilation*'. You can then use the command \[next-error] to find the next error message and move to the source code that caused it. Interactively, prompts for the command if `compilation-read-command' is non-nil; otherwise uses `compile-command'. With prefix arg, always prompts. To run more than one compilation at once, start one and rename the `*compilation*' buffer to some other name with \[rename-buffer]. Then start the next one. The name used for the buffer is actually whatever is returned by the function in `compilation-buffer-name-function', so you can set that to a function that generates a unique name. (defalias 'compile #[(command) " ?Ä\"ˆÅ Æ\"‡" [command compile-command save-some-buffers compilation-ask-about-save nil compile-internal "No more errors"] 3 (#$ . 8122) (byte-code "„ ƒÂÃ\fʼnÆ%C‡\fC‡" [compilation-read-command current-prefix-arg read-from-minibuffer "Compile command: " compile-command nil (compile-history . 1)] 6)]) #@54 Re-compile the program including the current buffer. (defalias 'recompile #[nil "À ?Â\"ˆÃ\fÅ\"‡" [save-some-buffers compilation-ask-about-save nil compile-internal compile-command "No more errors"] 3 (#$ . 9268) nil]) #@25 The system null device. (defvar grep-null-device "/dev/null" (#$ . 9492)) #@283 Run grep, with user-specified args, and collect output in a buffer. While grep runs asynchronously, you can use the \[next-error] command to find the text that grep hits refer to. This command uses a special history list for its arguments, so you can easily repeat a grep command. (defalias 'grep #[(command-args) "À  QÄÅÆ%ŠqˆÉÊ!ËL*‡" [compile-internal command-args " " grep-null-device "No more grep hits" "grep" nil grep-regexp-alist buf make-local-variable compilation-exit-message-function #[(proc msg) "À !à !Ä=ƒ'\nÅUƒÆ‚+\nÇUƒ È‚+ \nB‚+ \nB)‡" [process-exit-status proc code process-status exit 0 ("finished (matches found)\n" . "matched") 1 ("finished with no matches found\n" . "no match") msg] 2]] 6 (#$ . 9573) (list (read-from-minibuffer "Run grep (like this): " grep-command nil nil (quote grep-history)))]) #@734 Run compilation command COMMAND (low level interface). ERROR-MESSAGE is a string to print if the user asks to see another error and there are no more errors. Third argument NAME-OF-MODE is the name to display as the major mode in the compilation buffer. Fourth arg PARSER is the error parser function (nil means the default). Fifth arg REGEXP-ALIST is the error message regexp alist to use (nil means the default). Sixth arg NAME-FUNCTION is a function called to name the buffer (nil means the default). The defaults for these variables are the global values of `compilation-parse-errors-function', `compilation-error-regexp-alist', and `compilation-buffer-name-function', respectively. Returns the compilation buffer created. (defalias 'compile-internal #[(command error-message &optional name-of-mode parser regexp-alist name-function) "ÀŠ\n„ ÃÄ ††Ç\n!!‰qˆÈp!‰ ƒDÊ !Ë=ƒ6ÌÍÎ\n\"!ƒ>ÀÏЈ‚DÑÒÓ \"ˆ)Ô ˆ)†P†WÀŠ qˆÀÝp!ˆÞ ˆßp!ˆàá\"᱈ãÀ!ˆ) p=ƒdbˆä !Š qˆå ˆæØ!Lˆæç!(LˆæÖ!Lˆ‰C)êe\"ˆ\n+ì =„Ðíe\"ˆî!ˆïð!ƒ\nñ2B2ó+— \"#4õ4ö\"ˆ÷4ø\"ˆù4!` “ˆ4:B:*‚.ûÍü\"\"!ˆýþ!ˆÿ@À ÀA\"&ˆûÍB\"\"!ˆ- ‰C)‡" [nil outbuf name-of-mode "Compilation" get-buffer-create name-function compilation-buffer-name-function #[(mode) "À —ÀQ‡" ["*" mode] 3] get-buffer-process comp-proc process-status run yes-or-no-p format "A %s process is running; kill it? " (byte-code "À !ˆÂÃ!ˆÄ !‡" [interrupt-process comp-proc sit-for 1 delete-process] 2) ((error)) error "Cannot have two processes in `%s' at once" buffer-name kill-all-local-variables regexp-alist compilation-error-regexp-alist parser compilation-parse-errors-function default-directory outwin thisdir buffer-read-only buffer-disable-undo erase-buffer buffer-enable-undo "cd " "\n" command set-buffer-modified-p display-buffer compilation-mode make-local-variable compilation-error-message error-message compilation-directory-stack set-window-start mode-name selected-window set-window-point compilation-set-window-height fboundp start-process "EMACS=t" process-environment start-process-shell-command proc set-process-sentinel compilation-sentinel set-process-filter compilation-filter process-mark compilation-in-progress message "Executing `%s'..." sit-for 0 call-process shell-file-name "-c" "Executing `%s'...done" compilation-last-buffer] 8 (#$ . 10417)]) (defalias 'compilation-set-window-height #[(window) "…-Á\n!ÃÄ\n!!U…-\nÅÄ\n!!=?…-ŠÆ ÈŽÉ\n!ˆÊË Z!+‡" [compilation-window-height window-width window frame-width window-frame frame-root-window selected-window w ((select-window w)) select-window enlarge-window window-height] 4]) #@38 Keymap for `compilation-minor-mode'. (defvar compilation-minor-mode-map (byte-code "À  ÃÄ#ˆÂ ÅÆ#ˆÂ ÇÆ#ˆÂ ÈÉ#ˆÂ ÊË#ˆÂ ÌÍ#ˆÂ ÎÏ#ˆÂ ÐÑ#ˆ )‡" [make-sparse-keymap map define-key [mouse-2] compile-mouse-goto-error "" compile-goto-error " " " " kill-compilation "î" compilation-next-error "ð" compilation-previous-error "û" compilation-previous-file "ý" compilation-next-file] 4) (#$ . 13078)) #@84 Keymap for compilation log buffers. `compilation-minor-mode-map' is a cdr of this. (defvar compilation-mode-map (byte-code "À BÃ\nÄÅ#ˆÃ\nÆÇ#ˆÃ\nÈÉÊÉ!B#ˆÃ\nËÌ#ˆÃ\nÍÎ#ˆÃ\nÏÐ#ˆÃ\nÑÒ#ˆÃ\nÓÔ#ˆÃ\nÕÖ#ˆÃ\n×Ø#ˆÃ\nÙÚ#ˆÃ\nÛÜ#ˆ\n)‡" [keymap compilation-minor-mode-map map define-key " " scroll-up "" scroll-down [menu-bar compilation-menu] "Compile" make-sparse-keymap [menu-bar compilation-menu compilation-mode-kill-compilation] ("Stop Compilation" . kill-compilation) [menu-bar compilation-menu compilation-mode-separator2] ("----") [menu-bar compilation-menu compilation-mode-first-error] ("First Error" . first-error) [menu-bar compilation-menu compilation-mode-previous-error] ("Previous Error" . previous-error) [menu-bar compilation-menu compilation-mode-next-error] ("Next Error" . next-error) [menu-bar compilation-menu compilation-separator2] ("----") [menu-bar compilation-menu compilation-mode-grep] ("Grep" . grep) [menu-bar compilation-menu compilation-mode-recompile] ("Recompile" . recompile) [menu-bar compilation-menu compilation-mode-compile] ("Compile" . compile)] 6) (#$ . 13476)) #@291 Major mode for compilation log buffers. \To visit the source for a line-numbered error, move point to the error message line and type \[compile-goto-error]. To kill the compilation, type \[kill-compilation]. Runs `compilation-mode-hook' with `run-hooks' (which see). (defalias 'compilation-mode #[nil "À ˆÁ\n!ˆÃÅÇ ˆÈÉ!ÊLˆËÌ!‡" [kill-all-local-variables use-local-map compilation-mode-map compilation-mode major-mode "Compilation" mode-name compilation-setup make-local-variable font-lock-defaults (compilation-mode-font-lock-keywords t) run-hooks compilation-mode-hook] 2 (#$ . 14576) nil]) (defalias 'compilation-setup #[nil "ÀÂÃ!ÄLˆÂÅ!ÄLˆÂÆ!ÇLˆÂÈ!ÄLˆp‰ ‡" [(":%s") mode-line-process make-local-variable compilation-error-list nil compilation-old-error-list compilation-parsing-end 1 compilation-directory-stack compilation-last-buffer] 2]) #@137 Non-nil when in compilation-minor-mode. In this minor mode, all the error-parsing commands of the Compilation major mode are available. (defvar compilation-minor-mode nil (#$ . 15453)) (byte-code "ÀÁ!ˆÁ\nž„Ã\nBÁ\fž„Á B\fBÀ‡" [make-variable-buffer-local compilation-minor-mode minor-mode-alist (compilation-minor-mode " Compilation") minor-mode-map-alist compilation-minor-mode-map] 2) #@123 Toggle compilation minor mode. With arg, turn compilation mode on if and only if arg is positive. See `compilation-mode'. (defalias 'compilation-minor-mode #[(&optional arg) "„ ?‚Â!ÃV‰…Ä ‡" [arg compilation-minor-mode prefix-numeric-value 0 compilation-setup] 2 (#$ . 15851) "P"]) #@35 Sentinel for compilation buffers. (defalias 'compilation-sentinel #[(proc msg) "À !à !Ä>…Å\n!„Æ Ç\"ˆ‚•plj \nËŽ\nqˆÇ\fƒ7\f  \"‚= Î !Bd ` bˆÑÓ@±ˆÔuˆÕÖ ×ØO±ˆÙuˆÚÛà !A#Ý !ˆÞ ˆ*ƒˆ Wƒˆbˆƒ”\n \"ˆ,à !\"‰!)‡" [process-buffer proc buffer process-status (signal exit) buffer-name set-process-buffer nil opoint omax obuf ((set-buffer obuf)) compilation-exit-message-function msg process-exit-status status buffer-read-only 10 mode-name " " -1 " at " current-time-string 0 19 1 format ":%s [%s]" mode-line-process delete-process force-mode-line-update compilation-finish-function delq compilation-in-progress] 4 (#$ . 16147)]) #@98 Process filter for compilation buffers. Just inserts the text, but uses `insert-before-markers'. (defalias 'compilation-filter #[(proc string) "ÀÁ\n!!…\"ŠÁ\n!qˆÃŠÅ\n!bˆÆ!ˆÅ\n!`Ó+‡" [buffer-name process-buffer proc nil buffer-read-only process-mark insert-before-markers string] 3 (#$ . 16818)]) (defalias 'compile-error-at-point #[nil "ÀÁ`\"ˆ\n‰ƒ` @@Vƒ A‰„ )‡" [compile-reinitialize-errors nil compilation-old-error-list errors] 4]) (defalias 'compilation-buffer-p #[(buffer) "Šqˆ † \nÃ=)‡" [buffer compilation-minor-mode major-mode compilation-mode] 2]) (put (quote compilation-buffer-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@107 Move point to the next error in the compilation buffer. Does NOT find the source line like \[next-error]. (defalias 'compilation-next-error #[(n) "Àp!„\nÁÂ!ˆpÄ ÇWƒMÇ \n =„2\nT\n A‰ ‚[\nVƒAÁË!‚I\n\\8*‚j A\fÍΉ#ˆ\fƒfS\f8‚iÁÏ!)@b)‡" [compilation-buffer-p error "Not in a compilation buffer." compilation-last-buffer compile-error-at-point errors n 0 compilation-old-error-list e i "Moved back past first error" compilation-error-list compile-reinitialize-errors nil "Moved past last error"] 5 (#$ . 17488) "p"]) #@111 Move point to the previous error in the compilation buffer. Does NOT find the source line like \[next-error]. (defalias 'compilation-previous-error #[(n) "À [!‡" [compilation-next-error n] 2 (#$ . 18043) "p"]) (defalias 'compilation-error-filedata #[(data) "AÁ!ƒ Â!‡@‡" [data markerp marker-buffer] 2]) (put (quote compilation-error-filedata) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'compilation-error-filedata-file-name #[(filedata) "À !ƒ\n !‡ @‡" [bufferp filedata buffer-file-name] 2]) (put (quote compilation-error-filedata-file-name) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@73 Move point to the next error for a different file than the current one. (defalias 'compilation-next-file #[(n) "Àp!„\nÁÂ!ˆp\fÅWƉ‰ „(Ê †#ÁË!‚MÌÆ`\"ˆÍ!\f[ƒM`@@WƒMA‰„;\fÅVƒï@‰AÐ!ƒjÑ!‚m@)†Ã ƒ˜ÁÒÓ!ƒÔ!‚“@)\"‚§ÆÌƉÖ#ˆ‰)†ÃÁ×Ó!ƒ¾Ô!‚Á@)\"@‰AÐ!ƒØÑ!‚Û@)šƒèA‚p\fS‰‚N†  ƒÿÁØ!‚ ÆÌƉÙ#ˆ)@@b+‡" [compilation-buffer-p error "Not in a compilation buffer." compilation-last-buffer n 0 nil filedata errors reversed compile-error-at-point "Moved past last error" compile-reinitialize-errors reverse compilation-old-error-list data markerp marker-buffer "%s the first erring file" bufferp buffer-file-name compilation-error-list 2 "%s is the last erring file" "This is the first erring file" 1] 6 (#$ . 18684) "p"]) #@77 Move point to the previous error for a different file than the current one. (defalias 'compilation-previous-file #[(n) "À [!‡" [compilation-next-file n] 2 (#$ . 19499) "p"]) #@50 Kill the process made by the \[compile] command. (defalias 'kill-compilation #[nil "À  !ƒà!!‚ÄÅ!)‡" [compilation-find-buffer buffer get-buffer-process interrupt-process error "The compilation process is not running."] 3 (#$ . 19679) nil]) (defalias 'compile-reinitialize-errors #[(reparse &optional limit-search find-at-least) "Šqˆ Â=„ ƒÄ ˆ …+ ƒ  V…+?†+ GY?…\\ÈÉ!ˆdW…\\ \n …J GZ\"ˆ\f ¤\f\n…[\n‰))‡" [compilation-last-buffer compilation-error-list t reparse compilation-forget-errors limit-search compilation-parsing-end find-at-least set-buffer-modified-p nil error-list-pos compilation-parse-errors-function compilation-old-error-list] 4]) (defalias 'compile-mouse-goto-error #[(event) "ŠÀ  8:ƒ‚à 8)‰@)!qˆ  8:ƒ'‚(à 8)‰A@:ƒ:\fA@@‚=\fA@)bˆÅp!„JÆÇ!ˆpÉÊ`\"ˆËyˆ\f‰ ƒo` @@Vƒo A‰ „] „xÆÎ!ˆ)Ï  8:ƒ‡Â‚ˆÃ 8)‰@)!ˆÐ „žÑÒ!ˆqˆÓ ˆÔÃ!‡" [window-buffer event 2 1 position compilation-buffer-p error "Not in a compilation buffer." compilation-last-buffer compile-reinitialize-errors nil 0 compilation-old-error-list compilation-error-list "No error to go to" select-window one-window-p other-window -1 push-mark next-error] 4 nil "e"]) #@265 Visit the source for the error message point is on. Use this command in a compilation log buffer. Sets the mark at point there. \[universal-argument] as a prefix arg means to reparse the buffer's error messages first; other kinds of prefix arguments are ignored. (defalias 'compile-goto-error #[(&optional argp) "Àp!„\nÁÂ!ˆpÄ :`\"ˆÆyˆ‰ƒ/`@@Vƒ/A‰„É „;ÊË!ˆ qˆÌ ˆÍÎ!‡" [compilation-buffer-p error "Not in a compilation buffer." compilation-last-buffer compile-reinitialize-errors argp 0 compilation-old-error-list compilation-error-list one-window-p other-window -1 push-mark next-error 1] 4 (#$ . 20883) "P"]) (defalias 'compilation-find-buffer #[(&optional other-buffer) "„pŠ qˆ\n† Ä=*ƒp‡ ƒ-Æ !ƒ-ƒ+ p=„- ‡Ç ‰ƒ]@Š qˆ\n†D Ä=*ƒTƒ]@p=ƒ]A‰„5ƒh@‚Œƒ‰pŠ qˆ\n†y Ä=*ƒ‰ƒ…ÉÊ!ˆp†ŒËÌ!)‡" [other-buffer buffer compilation-minor-mode major-mode compilation-mode compilation-last-buffer buffer-name buffer-list buffers message "This is the only compilation buffer." error "No compilation started!"] 3]) #@855 Visit next compilation error message and corresponding source code. This operates on the output from the \[compile] command. If all preparsed error messages have been processed, the error message buffer is checked for new ones. A prefix arg specifies how many error messages to move; negative means move back to previous error messages. Just C-u as a prefix means reparse the error message buffer and start at the first error. \[next-error] normally applies to the most recent compilation started, but as long as you are in the middle of parsing errors from one compilation output buffer, you stay with that compilation output buffer. Use \[next-error] in a compilation output buffer to switch to processing errors from that compilation. See variables `compilation-parse-errors-function' and `compilation-error-regexp-alist' for customization ideas. (defalias 'next-error #[(&optional argp) "À ÂÃ\f:?…Å\f!\f:\"!‡" [compilation-find-buffer compilation-last-buffer compilation-goto-locus compilation-next-error-locus argp prefix-numeric-value] 4 (#$ . 21938) "P"]) #@130 Visit previous compilation error message and corresponding source code. This operates on the output from the \[compile] command. (defalias 'previous-error #[nil "ÀÁ!‡" [next-error -1] 2 (#$ . 23015) nil]) #@153 Reparse the error message buffer and start at the first error Visit corresponding source code. This operates on the output from the \[compile] command. (defalias 'first-error #[nil "ÀÁ!‡" [next-error (4)] 2 (#$ . 23227) nil]) #@886 Visit next compilation error and return locus in corresponding source code. This operates on the output from the \[compile] command. If all preparsed error messages have been processed, the error message buffer is checked for new ones. Returns a cons (ERROR . SOURCE) of two markers: ERROR is a marker at the location of the error message in the compilation buffer, and SOURCE is a marker at the location in the source code indicated by the error message. Optional first arg MOVE says how many error messages to move forwards (or backwards, if negative); default is 1. Optional second arg REPARSE, if non-nil, says to reparse the error message buffer and reset to the first error (plus MOVE - 1). If optional third argument SILENT is non-nil, return nil instead of raising an error if there are no more errors. The current buffer should be the desired compilation output buffer. (defalias 'compilation-next-error-locus #[(&optional move reparse silent) "„ÁÂ Ä ?…ÁWƒÅ‚S#ˆÄ‰ÈɈ\nƒ?\n@AAšƒ?\nA‰\n„+*‡" [move 1 compile-reinitialize-errors reparse nil 0 next-error next-errors no-next-error (byte-code "Šqˆ ÂVƒ S ›‚C SÂ\f =„,T A‰‚[Vƒ;ÈÉ!‚B\\\f›+‰\n@‰ „š ƒb ÌU„bÈ ÂV…_ÍÉ\"ˆÎp!ƒrÏÎp!!Ð=„uÑ ˆƒÓÔÕ\"‚ÂÈÎp!…•ÏÎp!!Ð=…•×P!‚Â\nA AƒÅØ A!„´ A@ÚÛ @#‰„ñ\f‰\nƒ³\n@A:ƒè\n@A@šƒè\n@@Õ‰“ˆ\n@Õ¡ˆ\nA‰\n‚Ä\f AA@Ý A8 qˆŠŒ~ˆá!ˆƒ$ÂVƒ$âS!ˆ‚'Âyˆ ã ¡ˆ ƒ² @A:ƒ© @A@šƒ© @AA@$Ý @A8$Z%&ç=ƒ%ÂWƒvèéÕê%[$ˆ‚…ëéÕê%$ˆ‚…%yˆƒšÌVƒšâS!ˆ‚Âyˆ$ @ã ¡ˆ+ A‰ „2-*Ø A!ƒÅì A!?ƒÐ ‰\n@‰ ‚J)Õ‡" [compilation-last-buffer move 0 compilation-error-list compilation-old-error-list e i n error "Moved back past first error" next-errors next-error 1 "Moved past last error" get-buffer-process process-status run compilation-forget-errors silent throw no-next-error nil compilation-error-message " yet" markerp fileinfo apply compilation-find-file buffer 2 column last-line errors goto-line move-to-column point-marker this lines selective-display t re-search-backward "[\n ]" end re-search-forward marker-buffer] 6) compilation-error-list] 6 (#$ . 23460)]) #@205 Jump to an error locus returned by `compilation-next-error-locus'. Takes one argument, a cons (ERROR . SOURCE) of two markers. Selects a window with point at SOURCE, with another window displaying ERROR. (defalias 'compilation-goto-locus #[(next-error) "ÀÁ !ƒÁ  =ƒÃÄ A!!ˆ‚ ÆÄ A!!ˆ Abˆ`Ç A!U„3~ˆ AbˆÈ ÊÄ @!Ë\"†FÌÄ @!! Î @\"ˆÏ @\"ˆÐ !*‡" [window-dedicated-p selected-window frame-root-window switch-to-buffer-other-frame marker-buffer next-error switch-to-buffer marker-position t pop-up-windows get-buffer-window visible display-buffer w set-window-point set-window-start compilation-set-window-height] 3 (#$ . 25641)]) (defalias 'compilation-find-file #[(marker filename dir &rest formats) "„Á\nɉ‰É\n!ƒ1ËÌ\n!!\nÍ\n!BÎ\n!\nƒv„v@†C‰ƒm„mÌÐ @\n\"\"Ñ\f!…dÒ\f! A‰„KA‰„6†¹ÓÕÖ!!Ù\"ˆÚ\"ˆÌÛÐÜ\n\"\nÓ$!Ý\f!ƒ¯Ì\n\f\"Ñ\f!…¸Ò\f!+-‡" [formats ("%s") compilation-search-path nil name fmts thisdir buffer dirs file-name-absolute-p filename abbreviate-file-name expand-file-name file-name-directory file-name-nondirectory dir format file-exists-p find-file-noselect t pop-up-windows display-buffer marker-buffer marker w set-window-point set-window-start read-file-name "Find this error in: (default %s) " file-directory-p] 7]) (defalias 'compilation-forget-errors #[nil "ƒ\"@‰@‰“ˆÃ A!ƒ A‰“ˆ)A‰„ÂÂƉ‡" [compilation-old-error-list next-error nil markerp compilation-error-list compilation-directory-stack 1 compilation-parsing-end] 4]) #@64 Return the number of \( ... \) groupings in REGEXP (a string). (defalias 'count-regexp-groupings #[(regexp) "À GÀÂ\f WƒS \fH\fT ÇUƒ2\f Wƒ\n \fHÈU„\n\fT‰‚ ÉUƒ\n\f Wƒ\n \fH\fT ÊUƒ\nT‚\n,‡" [0 regexp nil c i len groupings 91 93 92 41] 5 (#$ . 27179)]) #@138 Parse the current buffer as grep, cc or lint error messages. See variable `compilation-parse-errors-function' for the interface it uses. (defalias 'compilation-parse-errors #[(limit-search find-at-least) "ÀÂÃ!ˆÀ‰‰‰‰‰‰‰‰‰‰‰Ä \n \f bˆoƒ:ÓyˆÔuˆÕ×Õ×ÕÙÚÜ#Ý°  Þ\fÞß!\\Þ\\‰ ß!\\Þ\\\n†màá! \nT ƒ¶‰ @A@\\Ó @8\\â @8…šâ @8\\FBß @@!\\Þ\\ A‰ „yã$!ãå$!!ãæç\"!„¦è Àé#ƒ¦\f”ƒ\"êæ\fÞ\\”\fÞ\\•{!!+ì+$‰+-B-î+!ƒ+$)/ƒ…`/Yƒ…é‚… ”ƒ Þ\\”-0‰1ƒiêæ1 Þ\\•{!!+ì+$+0ƒh0@+˜„h0A‰0„V)0A‰-@‰0ƒz0$*/ƒ…`/Yƒ…é‚…\n”ƒ‰ ƒ¬ @@”„¬ A‰ „› ƒ¹ @ ‚½àò!ˆÄ” A@” A@•{óÓ 8”Ó 8•{!â 8…óâ 8”…óóâ 8”â 8•{!4567øù!ƒú6!ƒ96P66$û ›BB6Š7bˆlƒ(Þ‚)Äyˆü 654EB‰=A @Aš„H= B T*>ƒU >V„a/ƒ}`/Yƒ} Aƒ} @A@ A@A@š„} A7bˆé,‚…àÿ!ˆÂ@ A`_d¥#ˆ/ƒÍ`/YƒÍ鉃҃¯`‚°d. ŸÂB!‡" [nil compilation-error-list message "Parsing error messages..." 0 compilation-num-errors-found found-desired error-regexp-groups subexpr alist error-group leave-group enter-group regexp parent-expanded orig-expanded orig text-buffer compilation-parsing-end 2 -1 "\\(" compilation-enter-directory-regexp "\\)\\|" compilation-leave-directory-regexp mapconcat #[(elt) "À @ÂQ‡" ["\\(" elt "\\)"] 3] compilation-error-regexp-alist "\\|" "\\)" 1 count-regexp-groupings error "compilation-error-regexp-alist is empty!" 3 abbreviate-file-name default-directory file-truename expand-file-name "../" re-search-forward t file-name-as-directory dir compile-abbreviate-directory compilation-directory-stack file-directory-p limit-search stack beg "compilation-parse-errors: impossible regexp match!" string-to-int column linenum filename beginning-of-match boundp comint-file-name-prefix file-name-absolute-p 4 point-marker this find-at-least "compilation-parse-errors: known groups didn't match!" "Parsing error messages...%d (%.0f%% of buffer)" 100.0 "Parsing error messages...done"] 14 (#$ . 27461)]) (defalias 'compile-abbreviate-directory #[(dir orig orig-expanded parent-expanded) "À !ÂÃ!ƒ P G\fGVƒ)\f Å\fGO˜ƒ) \fGÇOP GGVƒL ÅGO˜ƒLÉÊ!! GÇOP ‡" [abbreviate-file-name dir boundp comint-file-name-prefix orig-expanded 0 orig nil parent-expanded file-name-directory directory-file-name] 4]) (provide (quote compile)) emacs-19.30/lisp/compare-w.elc100666 74777 1 5576 5751545775 14517 0ustar esrdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:19:08 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/compare-w.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/compare-w.el' was compiled for Emacs 19")) #@656 *Regexp that defines whitespace sequences for \[compare-windows]. Changes in whitespace are optionally ignored. The value of `compare-windows-whitespace' may instead be a function; this function is called in each buffer, with point at the current scanning point. The function's job is to categorize any whitespace around (including before) point; it should also advance past any whitespace. The function is passed one argument, the point where `compare-windows' was originally called; it should not consider any text before that point. If the function returns the same value for both buffers, then the whitespace is considered to match, and is skipped. (defvar compare-windows-whitespace "[ \n]+" (#$ . -488)) #@61 *Non-nil means \[compare-windows] ignores case differences. (defvar compare-ignore-case nil (#$ . -1207)) #@590 Compare text in current window with text in next window. Compares the text starting at point in each window, moving over text in each one as far as they match. This command pushes the mark in each window at the prior location of point in that window. If both windows display the same buffer, the mark is pushed twice in that buffer: first in the other window, then in the selected window. A prefix arg means ignore changes in whitespace. The variable `compare-windows-whitespace' controls how whitespace is skipped. If `compare-ignore-case' is non-nil, changes in case are also ignored. (defalias 'compare-windows #[(ignore-whitespace) "ÀÀÀÀÀÀÀÀÀ `\nÀ \f…# `pÏÐ !‰Ð =ƒ:ÑÒ!ˆÓ!Ô!\n dŠqˆÕ\nÖ\"ˆd)Õ ˆÖƒ;À bˆ×\n\"ˆƒÛŠÀ‰‰‰‰‰;ƒ“Ý\n!‚˜\n!`qˆ\nbˆ;ƒ±Ý !‚¶ !`;„ÓƒÙƒÙ=ƒÙ.ÞÀ !‰ âVƒ7Ö!!ƒ- Z\f\nZ^^‰ âV…ã\n \n\\  \\&âU‰!ƒî  \\\n \\Ö‚î 䥉 ‚æ+‚] bˆ×\n\"ˆ`\nU…Må .\f‡" [nil p1 p2 maxp1 maxp2 b1 b2 w2 success size opoint1 opoint2 ignore-whitespace compare-windows-whitespace skip-whitespace next-window selected-window error "No other window" window-point window-buffer push-mark t set-window-point result2 result1 w1 p2a p1a compare-windows-skip-whitespace 1000 compare-ignore-case case-fold-search success-1 0 compare-buffer-substrings 2 ding] 9 (#$ . 1320) "P"]) (defalias 'compare-windows-skip-whitespace #[(start) "```Ã\f!ƒ\nÅ•XƒÅ•`V„*`U„0`Uƒ0Çuˆ‚`\nbˆ U?†@\nU?+‡" [opoint beg end looking-at compare-windows-whitespace 0 start -1] 3]) (provide (quote compare-w)) emacs-19.30/lisp/complete.elc100666 13437 1 33150 6045212735 14534 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:13:04 1995 ;;; from file /home/fsf/rms/e19/lisp/complete.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`complete.el' was compiled for Emacs 19.29 or later")) #@146 *If nil, TAB does normal Emacs completion and M-TAB does Partial Completion. If t, TAB does Partial Completion and M-TAB does normal completion. (defvar PC-meta-flag t (#$ . -477)) #@419 *A string of characters which are to be treated as word delimiters by the Partial Completion system. Some arcane rules: If `]' is in this string it must come first. If `^' is in this string it must NOT come first. If `-' is in this string, it must come first or right after `]'. In other words, if S is this string, then `[S]' must be a legal Emacs regular expression (not containing character ranges like `a-z'). (defvar PC-word-delimiters "-_. " (#$ . -665)) #@291 *If t, first character of a string to be completed is always taken literally. If nil, word delimiters are handled even if they appear as first character. This controls whether ".e" matches ".e*" (t) or "*.e*" (nil). If neither nil nor t, first char is literal only for filename completion. (defvar PC-first-char (quote x) (#$ . -1137)) #@125 *List of directories in which to look for include files. If this is nil, uses the colon-separated path in $INCPATH instead. (defvar PC-include-file-path (quote ("/usr/include")) (#$ . -1480)) #@66 Set this to non-nil to disable wildcard support in \[find-file]. (defvar PC-disable-wildcards nil (#$ . 1678)) #@70 Set this to non-nil to disable include-file support in \[find-file]. (defvar PC-disable-includes nil (#$ . 1795)) #@74 Set this to nil to suppress the default partial completion key bindings. (defvar PC-default-bindings t (#$ . 1915)) (byte-code "ƒÁ\nÃÄ#ˆÁ\nÅÆ#ˆÁ\nÇÈ#ˆÁ\nÉÄ#ˆÁ\nÊÆ#ˆÁ\nËÌ#ˆÁ\nÍÌ#ˆÁ\nÎÈ#ˆÁÃÄ#ˆÁÅÆ#ˆÁÐÑ#ˆÁÒÑ#ˆÁÇÈ#ˆÁÉÄ#ˆÁÊÆ#ˆÁËÑ#ˆÁÍÑ#ˆÁÎÈ#ˆÁÉÔ#ˆÁ‡" [PC-default-bindings define-key minibuffer-local-completion-map " " PC-complete " " PC-complete-word "?" PC-completion-help " " " " " " PC-force-complete-and-exit "\n" "?" minibuffer-local-must-match-map " " PC-complete-and-exit "\n" global-map PC-lisp-complete-symbol] 4) #@520 Like minibuffer-complete, but allows "b--di"-style abbreviations. For example, "M-x b--di" would match `byte-recompile-directory', or any name which consists of three or more words, the first beginning with "b" and the third beginning with "di". The pattern "b--d" is ambiguous for `byte-recompile-directory' and `beginning-of-defun', so this would produce a list of completions just like when normal Emacs completions are ambiguous. Word-delimiters for the purposes of Partial Completion are "-", "_", ".", and SPC. (defalias 'PC-complete #[nil "À ƒÁ ‡ÂÃ!‡" [PC-was-meta-key minibuffer-complete PC-do-completion nil] 2 (#$ . 2469) nil]) #@169 Like `minibuffer-complete-word', but allows "b--di"-style abbreviations. See `PC-complete' for details. This can be bound to other keys, like `-' and `.', if you wish. (defalias 'PC-complete-word #[nil "À =ƒ\nÃ=ƒÄ ‡ÅÆ!‡ÅÆ!ˆm…ÇÈ!‡" [PC-was-meta-key PC-meta-flag last-command-char 32 minibuffer-complete-word self-insert-command 1 PC-do-completion word] 2 (#$ . 3118) nil]) #@180 Like `minibuffer-complete-word', but allows "b--di"-style abbreviations. See `PC-complete' for details. This is suitable for binding to other keys which should act just like SPC. (defalias 'PC-complete-space #[nil "À =ƒ\n ‡Ãcˆm…ÄÅ!‡" [PC-was-meta-key PC-meta-flag minibuffer-complete-word " " PC-do-completion word] 2 (#$ . 3504) nil]) #@109 Like `minibuffer-complete-and-exit', but allows "b--di"-style abbreviations. See `PC-complete' for details. (defalias 'PC-complete-and-exit #[nil "À =ƒ\n ‡Ã ‡" [PC-was-meta-key PC-meta-flag minibuffer-complete-and-exit PC-do-complete-and-exit] 2 (#$ . 3852) nil]) #@109 Like `minibuffer-complete-and-exit', but allows "b--di"-style abbreviations. See `PC-complete' for details. (defalias 'PC-force-complete-and-exit #[nil "À )‡" [nil minibuffer-completion-confirm PC-do-complete-and-exit] 1 (#$ . 4126) nil]) (defalias 'PC-do-complete-and-exit #[nil "À ÁUƒ\n ‡ÃÄ!‰…% Æ=„„\" ‚%ÈÉ!)‡" [buffer-size 0 exit-minibuffer PC-do-completion exit flag complete minibuffer-completion-confirm PC-temp-minibuffer-message " [Confirm]"] 3]) #@107 Like `minibuffer-completion-help', but allows "b--di"-style abbreviations. See `PC-complete' for details. (defalias 'PC-completion-help #[nil "À =ƒ\n ‡ÃÄ!‡" [PC-was-meta-key PC-meta-flag minibuffer-completion-help PC-do-completion help] 2 (#$ . 4601) nil]) (defalias 'PC-was-meta-key #[nil "À GÁU?†!À ÂH‰¨ƒ ÄY‚ ÅÆ !>??)‡" [this-command-keys 1 0 key 128 meta event-modifiers] 4]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÆÅ BÀÇ!„-ÆÇ BÀÈ!„:ÆÈ BÀÉ!„GÆ É BÀÊ!„TÆ\nÊ BƇ" [boundp PC-ignored-extensions empty-cache current-load-list PC-delims PC-ignored-regexp nil PC-word-failed-flag PC-delim-regex PC-ndelims-regex PC-delims-list] 2) (defalias 'PC-do-completion #[(&optional mode beg end) "„e „\fd\n\f Æ>È È\n { …*ÌÍ \"ÈÈÈÈÈÈÈÙ=ƒYÚ #ƒYÛ‚ÀƒfÜ !G‚gÝ\nƒ Þ !‰š„ |ˆcˆ  G\\ š„® á âQ#ä åQ&ç È\"(ƒPÌé \"ƒP È*+Ìì+\"TÌ#+#‰ƒñ+ÝOí+ÈOQ+î\\‚Êï+íP!‰*ƒHÜ*@!*0A‰ƒ0Ü@!š„ƒ.ÈÈÈñ‚D |ˆ0ò !P‰ cˆ G\\*‚OÈÈÈ*ƒ|ƒm ÈO ÝO ‚€ò !Ü ! ‚€ ó!‰GÝVƒ«ÝHô=„«5ñ=„§5ƒ«ƒ«ö‚¬݉Ì##‰ƒ\"H÷=ƒìÝO&#TÈOR&G#G\\\\‚±Hø>ƒúù‚ûÝ:Ý:\\O&:\\ÈOQ&Gö\\\\)‚±ÝƒLÌû#‰ƒLÝOüî\\ÈOQ‚*ýPÌ#ƒ^þ‚_ÿP  G\\#‰„|@ #‚­@ ÝO #‰A‰ƒ¬Ì@\"ƒ£@BA‰„‘)„ÿB=ƒÔC„ÔñCDö!ˆEB!)‚ÀF ˆGƒçH‚ùI=ƒöJ‚ùK!ˆÈ‚À‰A„L>ƒ†ƒnI=„nMNOš„APQóN‰OR#SQTÈMƒdÌTM@\"„[M@BMA‰M„Iƒm)I=?…z‰ƒ’@š„’A‰„€ƒ¤„¤GU!ˆƒº„¶VW=„ºñ‚Àȉ‰ýXYZ[I=„ \\ÿ]^\"\"‰Zƒ ñÈ_`B=ƒüaZ\"Z G\\bˆÝ_ÝZGWƒŽ` Wƒ$Z_Hg=ƒ$öuˆ‚…` WƒWbc!ƒ?Z_H(>„KZ_H—g—=ƒWdö!ˆ S‚rƒobe!ƒodö!ˆ Sñ[fgZ_‰TO\"cˆ T_T‰_‚Y„œ`š„œ`Yb#!ƒ÷XóZ!&QX\\ÿ]h\"\"‰Zƒ÷_ÝV„ÓZGÝVƒ÷B=ƒ`ƒ÷ZGÝVƒ÷È`ZÝöO‰Z„B=ƒ ‚\nY†\nbˆ*B=ƒ2C„2[…‚Úö S{ #…‚ S |‚‚[ƒIÙ=…‚Úi #‚‚j„WI=ƒyklmn\"!ˆŠoqˆ\n‰p)‘ˆ‚Gq!ˆÈ,‚À@šƒŸ„¿Gr!ˆ‚¿ |ˆfgƒ¹Þ @P!‚¼@\"cˆñ.‡" [beg end minibuffer-completion-table table minibuffer-completion-predicate pred (read-file-name-internal read-directory-name-internal) filename nil dirname dirlength str string-match "<\\([^\"<>]*\\)>?$" incname ambig basestr regex p offset poss helpposs completion-ignore-case case-fold-search mode exit PC-is-complete-p complete file-name-directory 0 substitute-in-file-name PC-word-delimiters PC-delims "[" "]" PC-delim-regex "[^" "]*" PC-ndelims-regex append PC-delims-list "\\*.*/" files pat "/[^/]*\\'" "*" 2 PC-expand-many-files dir t file-name-nondirectory regexp-quote 42 PC-first-char 1 32 (36 94 46 42 43 63 91 93 92) -1 bump "\\\\\\*" "[^/]*" "\\`" "\\|\\*" "" all-completions compl word PC-word-failed-flag delete-backward-char PC-do-completion beep PC-temp-minibuffer-message " [Ambiguous dir name]" help " [No completions]" " [No match]" (help word) p2 completion-ignored-extensions PC-ignored-extensions "\\(" mapconcat "\\|" "\\)\\'" PC-ignored-regexp " [Complete, but not unique]" this-command last-command skip pt prefix improved try-completion mapcar list i first PC-chop-word looking-at " " delete-char "\\*" format "%s" #[(x) "À \n\"…\f\nÕÄOC‡" [string-match skip x 0 nil] 3] buffer-string completion-auto-help "*Completions*" display-completion-list sort string-lessp standard-output completion-base-size " [Next char not unique]" " [Sole completion]"] 7]) (defalias 'PC-is-complete-p #[(str table pred) "<ƒ\fÁ\n\"‚%Ã!ƒ\nÄš†%Å\n\"‚%\nÇ#‰…EƒC<„;Ã!ƒC!…E)‡" [table assoc str vectorp "nil" intern-soft pred lambda res] 5]) (defalias 'PC-chop-word #[(new old) "À‰Ã\f \nT#‰ƒÃ\f T#‰„ ƒ9ƒ0Ã\f T#‰ƒ9È TO‚;*‡" [-1 j i string-match PC-delim-regex old new PC-word-failed-flag 0] 4]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp PC-not-minibuffer nil current-load-list] 2) #@61 A Lisp version of `temp_minibuffer_message' from minibuf.c. (defalias 'PC-temp-minibuffer-message #[(m) "ƒÁ\n!ˆÃÄ!ˆÁÅ!‡ÆÇ!ƒÇ\n!‡dŠdbˆ\ncˆ)É\nÃÄ!ˆd|ˆ …=Ì ͉*‡" [PC-not-minibuffer message m sit-for 2 "" fboundp temp-minibuffer-message savemax t inhibit-quit quit-flag nil 7 unread-command-char] 2 (#$ . 8661)]) #@374 Perform completion on Lisp symbol preceding point. That symbol is compared against the symbols that exist and any additional characters determined by what is there are inserted. If the symbol starts just after an open-parenthesis, only symbols with function definitions are considered. Otherwise, all symbols with function definitions, values or properties are considered. (defalias 'PC-lisp-complete-symbol #[nil "`Á ÃŽŠ\fƒÅ\f!ˆÆÇ!ˆgzÈUƒ!Çuˆ‚`* \n  SfÌ=ƒ6Í‚7ÎÐÒÓ #.‡" [end syntax-table buffer-syntax ((set-syntax-table buffer-syntax)) lisp-mode-syntax-table set-syntax-table backward-sexp 1 39 beg obarray minibuffer-completion-table 40 fboundp #[(sym) "À !† !†à !‡" [boundp sym fboundp symbol-plist] 2] minibuffer-completion-predicate t PC-not-minibuffer PC-do-completion nil] 4 (#$ . 8992) nil]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp PC-many-files-list nil current-load-list] 2) (defalias 'PC-try-load-many-files #[nil "ÀÁ\n\"…f\nÄ !‰@ Èp!ˆ „ ÉÊ!ˆË‹ˆÌ!‰ „CÏ!‰ qˆÐ ˆÑÒ\"ˆ AƒaÓÀÔ \"ƒTÕ‚UÖ A×#ÙBÛ ,Ò‡" [string-match "\\*" buffer-file-name pat PC-expand-many-files files first next kill-buffer error "No matching files" ((byte-code "A‰ƒÁ@!Ã\n!ˆ)‚Á‡" [next find-file-noselect buf switch-to-buffer] 2)) get-file-buffer buf filename create-file-buffer erase-buffer insert-file-contents t mapconcat "\\*.*/" identity file-name-nondirectory ", " PC-many-files-list PC-after-load-many-files find-file-hooks nil] 5]) (defalias 'PC-after-load-many-files #[nil "ÀÁ\n\"ÃÄ \"‡" [delq PC-after-load-many-files find-file-hooks message "Also loaded %s." PC-many-files-list] 3]) (defalias 'PC-expand-many-files #[(name) "ŠÀÁ!qˆÂ ˆÃÄ PÆ\"ˆebˆÇÈ!?…HÉcˆÊËÌÆ#ƒ/ÍÎ!ˆÏcˆ‚dbˆÍÎ!ˆÐcˆebˆÑp!Óp!ˆ))‡" [generate-new-buffer " *Glob Output*" erase-buffer shell-command "echo " name t looking-at ".*No match" "(\"" search-forward " " nil delete-backward-char 1 "\" \"" "\")" read files kill-buffer] 4]) (byte-code "„Á\n>„Á\nBÁ‡" [PC-disable-wildcards PC-try-load-many-files find-file-not-found-hooks] 2) (defalias 'PC-look-for-include-file #[nil "ÀÁ \"…; ÔÕO ĔHʼn Êp!ˆ Ëšƒ‘ŠÌ @qˆŠÄyˆÍÎ!ƒIÔÕ{ ÔSf‚ÍÏ!„[ÍÐ!„[ÍÑ!ƒŒÃ”Õ{ ÒÀÔ \"ƒ{ ÄÕO ‚ÀÖ \"„ ×P ‚ØÙ!ˆ*ÀÚ \"„Ÿ ÛP Ò=ƒå†­Ü ‰ƒÉÝÞ@! P!„ÉA‰„³ƒÛÞ@! P ‚áØß \"ˆ)‚ ŠÌ @qˆ )!Ý! P!ƒ! P ‚\nØâ \"ˆ)ã !‰ƒqˆ‚.ä !‰qˆå ˆæ ç\"ˆ (Å),ç‡" [string-match "[\"<]\\([^\"<>]*\\)[\">]?$" buffer-file-name 1 0 nil new-buf path punc name kill-buffer "" buffer-list looking-at "[ ]*#[ ]*include[ ]+[<\"]\\(.+\\)[>\"][ ]*[\n/]" "[ ]*([ ]*load[ ]+\"\\([^\"]+\\)\"" "[ ]*([ ]*load-library[ ]+\"\\([^\"]+\\)\"" "[ ]*([ ]*require[ ]+'\\([^ )]+\\)[ )]" 60 load-path "\\.elc$" -1 "\\.el$" ".el" error "Not on an #include line" "\\.[a-zA-Z0-9]+$" ".h" PC-include-file-path file-exists-p file-name-as-directory "No such include file: <%s>" default-directory dir "No such include file: \"%s\"" get-file-buffer create-file-buffer erase-buffer insert-file-contents t filename buf] 5]) (defalias 'PC-include-file-path #[nil "†4ÁÂ!ɉ„ÇÈ!ˆÉÊ\"‰ƒ2\fTÃO BË\fO‚ +‡" [PC-include-file-path getenv "INCPATH" nil pos path env error "No include file path specified" string-match ":[^:]+$" 0] 4]) #@208 Return all completions for FILE in any directory on SEARCH-PATH. If optional third argument FULL is non-nil, returned pathnames should be absolute rather than relative to some directory on the SEARCH-PATH. (defalias 'PC-include-file-all-completions #[(file search-path &optional full) "ÀÁ\n\"Ã\f!ƒÅ\f!ÆÇ\f!È\f!\"‡È\f!Ç\f!É\n ‰\fƒ0ÀÍ\n\"É\nƒb\n@ƒB‚D\f\fÐ!ƒ[ÀÑÆ \n@\"\"\nB\n\nA*‚0ÒÓÔ\n\"Õ\"ɉƒŽ@@š„…@BA‰„s-‡" [mapcar #[(dir) "ƒÁ!‡\n‡" [dir file-name-as-directory default-directory] 2] search-path file-name-absolute-p file expand-file-name file-name-all-completions file-name-nondirectory file-name-directory nil file-lists ndfile subdir #[(dir) " P‡" [dir subdir] 2] dir full file-directory-p #[(file) " P‡" [subdir file] 2] sort apply nconc (lambda (x y) (not (string-lessp x y))) compressed sorted] 6 (#$ . 12280)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp PC-old-read-file-name-internal nil current-load-list] 2) (defalias 'PC-read-include-file-name-internal #[(string dir action) "ÀÁ\n\"ƒ[\nÔÕO\nÅ”ÆOÈÉÊ\fË \"\"‰\f„'Æ‚Y Æ=ƒ8Î\fÆ#‚Y Ï=ƒIÐ\fÆ#‚Y Ñ=…YÎ\fÆ#Ï=+‡\n #‡" [string-match "<\\([^\"<>]*\\)>?$" string 1 name 0 nil str2 mapcar #[(x) "ÀÁ\n\"C‡" [format "<%s>" x] 3] PC-include-file-all-completions PC-include-file-path completion-table action try-completion t all-completions lambda PC-old-read-file-name-internal dir] 6]) (byte-code "„Á\n>„Á\nB„ „ÄKÄÅMˆÆÇ!‡" [PC-disable-includes PC-look-for-include-file find-file-not-found-hooks PC-old-read-file-name-internal read-file-name-internal PC-read-include-file-name-internal provide complete] 2) emacs-19.30/lisp/completion.elc100666 13437 1 111224 6055511654 15117 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 24 22:54:44 1995 ;;; from file /home/fsf/rms/e19/lisp/completion.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`completion.el' was compiled for Emacs 19.29 or later")) #@130 *Non-nil means enable recording and saving of completions. If nil, no new words added to the database or saved to the init file. (defvar enable-completion t (#$ . -479)) #@108 *Non-nil means save most-used completions when exiting Emacs. See also `saved-completions-retention-time'. (defvar save-completions-flag t (#$ . -656)) #@39 *The filename to save completions to. (defvar save-completions-file-name "~/.completions" (#$ . -814)) #@187 *Discard a completion if unused for this many hours. (1 day = 24, 1 week = 168). If this is 0, non-permanent completions will not be saved unless these are used. Default is two weeks. (defvar save-completions-retention-time 336 (#$ . -924)) #@116 *Non-nil means separator characters mark previous word as used. This means the word will be saved as a completion. (defvar completion-on-separator-character nil (#$ . -1174)) #@61 *Number of versions to keep for the saved completions file. (defvar completions-file-versions-kept kept-new-versions (#$ . -1355)) #@70 *Minimum output speed at which to display next potential completion. (defvar completion-prompt-speed-threshold 4800 (#$ . -1492)) #@93 *If non-nil, the next completion prompt does a cdabbrev search. This can be time consuming. (defvar completion-cdabbrev-prompt-flag nil (#$ . -1628)) #@123 *How far to search in the buffer when looking for completions. In number of characters. If nil, search the whole buffer. (defvar completion-search-distance 15000 (#$ . -1785)) #@173 *List of modes {`c' or `lisp'} for automatic completions merging. Definitions from visited files which have these modes are automatically added to the completion database. (defvar completions-merging-modes (quote (lisp c)) (#$ . -1969)) #@105 *The minimum length of a stored completion. DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros. (defconst completion-min-length nil (#$ . -2213)) #@105 *The maximum length of a stored completion. DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros. (defconst completion-max-length nil (#$ . -2374)) #@111 The minimum length of a completion search string. DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros. (defconst completion-prefix-min-length nil (#$ . 2535)) (defalias 'eval-when-compile-load-eval '(macro . #[(&rest body) "ÀÁ\n\"ˆÃ\nB‡" [mapcar eval body progn] 3])) #@186 (completion-dolist (VAR LIST [RESULT]) BODY...): loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. Then evaluate RESULT to get return value, default nil. (defalias 'completion-dolist '(macro . #[(spec &rest body) "ÀÁ!ÃÄ\n A@D @DÃÆ\nÇ @È\nDEE Ç\nÊ\nDEC#E AAƒ6Ç @ËE AAB‚7Ì\")‡" [completion-gensym "--dolist-temp--" temp append let spec while setq car body cdr nil (nil)] 10 (#$ . 2817)])) (defalias 'completion-eval-when #[nil "ÀÂĉ‡" [6 completion-min-length 200 completion-max-length 3 completion-prefix-min-length] 2]) (completion-eval-when) #@110 Set to t when the completion system is initialized. Indicates that the old completion file has been read in. (defvar cmpl-initialized-p nil (#$ . 3405)) #@105 Set to t as soon as the first completion has been accepted. Used to decide whether to save completions. (defvar cmpl-completions-accepted-p nil (#$ . 3565)) (byte-code "À B BÀ‡" [cmpl-preceding-syntax current-load-list completion-string] 2) #@48 True iff the current window is the minibuffer. (defalias 'minibuffer-window-selected-p #[nil "ÀÁ !‡" [window-minibuffer-p selected-window] 2 (#$ . 3815)]) (defalias 'cmpl-read-time-eval '(macro . #[(form) "‡" [form] 1])) #@56 Returns :capitalized, :up, :down, :mixed, or :neither. (defalias 'cmpl-string-case-type #[(string) "ÀÂÃ\f\"ƒ+ÂÅ\f\"ƒ'\fGÆVƒ#ÂÅ\fÆ#„#Ç‚7È‚7É‚7ÂÅ\f\"ƒ6Ê‚7Ë)‡" [nil case-fold-search string-match "[a-z]" string "[A-Z]" 1 :capitalized :mixed :down :up :neither] 4 (#$ . 4043)]) (defalias 'cmpl-coerce-string-case #[(string case-type) "Á=ƒ \n—‡Ã=ƒ\n–‡Ä=ƒ'\n—‰ÅÆ\nÅHÇ\"Iˆ\n‡\n‡" [case-type :down string :up :capitalized 0 logand 223] 6]) (defalias 'cmpl-merge-string-cases #[(string-to-coerce given-string) "À !‰Ã>ƒÄ À !\"‚ )‡" [cmpl-string-case-type string-to-coerce string-case-type (:down :up :capitalized) cmpl-coerce-string-case given-string] 5]) (defalias 'cmpl-hours-since-origin #[nil "À  @Ã¥ÄÅÆ\"_Ç 8È¥\\!)‡" [current-time time truncate 3600.0 lsh 1 16 2 3600.0] 5]) (defalias 'cmpl-make-standard-completion-syntax-table #[nil "À ÁÄÄÅWƒ$Æ\nÇ\\È #ˆÆ\nÉ\\È #ˆ\nT‰‚ÄÄÊWƒ;Æ\nË\\È #ˆ\nT‰‚'Ì͉Á‰ƒ`@ÆÈ #ˆA‰„K*Á‰ƒ@ÆÓ #ˆA‰„l, *‡" [make-syntax-table nil i table 0 26 modify-syntax-entry 97 "_" 65 10 48 (64 47 92 42 43 126 36 60 62 37) (95 45 58 46) symbol-chars-ignore symbol-chars char --dolist-temp--16 --dolist-temp--17 "w"] 5]) (byte-code "À Á\nBÀ‡" [cmpl-make-standard-completion-syntax-table cmpl-standard-syntax-table current-load-list] 2) (defalias 'cmpl-make-lisp-completion-syntax-table #[nil "À ! ʼnƒ%@ÈÉ\f#ˆA‰„*\f*‡" [copy-syntax-table cmpl-standard-syntax-table (33 38 63 61 94) symbol-chars table nil char --dolist-temp--18 modify-syntax-entry "_"] 5]) (defalias 'cmpl-make-c-completion-syntax-table #[nil "À ! ʼnƒ%@ÈÉ\f#ˆA‰„*\f*‡" [copy-syntax-table cmpl-standard-syntax-table (43 42 47 58 37) separator-chars table nil char --dolist-temp--19 modify-syntax-entry " "] 5]) (defalias 'cmpl-make-fortran-completion-syntax-table #[nil "À ! ʼnƒ%@ÈÉ\f#ˆA‰„*\f*‡" [copy-syntax-table cmpl-standard-syntax-table (43 45 42 47 58) separator-chars table nil char --dolist-temp--20 modify-syntax-entry " "] 5]) (byte-code "À Á\nBà Ä\nBÅ Æ\nBÀ‡" [cmpl-make-lisp-completion-syntax-table cmpl-lisp-syntax-table current-load-list cmpl-make-c-completion-syntax-table cmpl-c-syntax-table cmpl-make-fortran-completion-syntax-table cmpl-fortran-syntax-table] 2) #@58 This variable holds the current completion syntax table. (defvar cmpl-syntax-table cmpl-standard-syntax-table (#$ . 6342)) (byte-code "ÀÁ!ˆÂÃÄ\"ˆÂÅÆ\"ˆÂÇÈ\"‡" [make-variable-buffer-local cmpl-syntax-table add-hook lisp-mode-hook (lambda nil (setq cmpl-syntax-table cmpl-lisp-syntax-table)) c-mode-hook (lambda nil (setq cmpl-syntax-table cmpl-c-syntax-table)) fortran-mode-hook (lambda nil (setq cmpl-syntax-table cmpl-fortran-syntax-table) (completion-setup-fortran-mode))] 3) #@72 Holds first character of symbol, after any completion symbol function. (defvar cmpl-symbol-start nil (#$ . 6826)) #@71 Holds last character of symbol, after any completion symbol function. (defvar cmpl-symbol-end nil (#$ . 6946)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp cmpl-saved-syntax nil current-load-list cmpl-saved-point] 2) #@107 Returns the symbol that the point is currently on. But only if it is longer than `completion-min-length'. (defalias 'symbol-under-point #[nil "À  !ˆgzÄ>ƒj`Æ TÇ\"Æ É\"\nfzËUƒ3bˆÉvˆ` bˆ\nSfzËUƒJ\nbˆÇvˆ`\n bˆÂ !ˆ\f\nZX…i\nZ X…o\n{‡Â !ˆÎ‡" [syntax-table cmpl-saved-syntax set-syntax-table cmpl-syntax-table (119 95) cmpl-saved-point scan-sexps -1 cmpl-symbol-start 1 cmpl-symbol-end 119 completion-min-length completion-max-length nil] 3 (#$ . 7173)]) #@126 Returns a string of the symbol immediately before point. Returns nil if there isn't one longer than `completion-min-length'. (defalias 'symbol-before-point #[nil "À  !ˆhz‰ÅUƒF`ÇTÈ\"‰ fzÊUƒ1 bˆËvˆ` bˆÂ !ˆ \f\\Y…™ {‡\fÊUƒ”` Ç TÈ\" Èvˆ` fzÊUƒp bˆËvˆ`  bˆÂ !ˆ\f ZX…“ ZX…™ {‡Â !ˆÏ‡" [syntax-table cmpl-saved-syntax set-syntax-table cmpl-syntax-table cmpl-preceding-syntax 95 cmpl-symbol-end scan-sexps -1 cmpl-symbol-start 119 1 completion-min-length cmpl-saved-point completion-max-length nil] 4 (#$ . 7659)]) (defalias 'symbol-under-or-before-point #[nil "À  !ˆgzÄ>ƒ !ˆÅ ‡Â !ˆÆ ‡" [syntax-table cmpl-saved-syntax set-syntax-table cmpl-syntax-table (119 95) symbol-under-point symbol-before-point] 2]) (defalias 'symbol-before-point-for-complete #[nil "À  !ˆhz‰Å>ƒQ`ÇTÈ\"‰ fzÊUƒ1 bˆËvˆ` bˆÂ !ˆ\f ZX…P Z X…V {‡Â !ˆÎ‡" [syntax-table cmpl-saved-syntax set-syntax-table cmpl-syntax-table cmpl-preceding-syntax (95 119) cmpl-symbol-end scan-sexps -1 cmpl-symbol-start 119 1 completion-prefix-min-length completion-max-length nil] 4]) (defalias 'cmpl-statistics-block '(macro . #[(&rest body) "À‡" [nil] 1])) (byte-code "ÀÁ\nBÃÄ\nBÅÆ\nBÇÈ\nBÉ\nÊ\nBË\fÌ\nBÍÎ\nBÏÐ\nBÑÒ!„? Ò\nBÑÓ!„LÔÓ\nBÑÕ!„YÀÕ\nBÑÖ!„fÔÖ\nBÑ×!„sÔ×\nBÑØ!„€ÙØ\nBÑÚ!„ÀÚ\nBÛ\nBÔ‡" [0 cmpl-source-unknown current-load-list 1 cmpl-source-init-file 2 cmpl-source-file-parsing 3 cmpl-source-separator 4 cmpl-source-cursor-moves 5 cmpl-source-interactive 6 cmpl-source-cdabbrev 7 num-cmpl-sources boundp current-completion-source cdabbrev-completions-tried nil cdabbrev-current-point cdabbrev-current-window cdabbrev-wrapped-p cdabbrev-abbrev-string "" cdabbrev-start-point cdabbrev-stop-point] 2) #@143 Resets the cdabbrev search to search for abbrev-string. INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore during the search. (defalias 'reset-cdabbrev #[(abbrev-string &optional initial-completions-tried) "—\nBÄÅ!‡" [abbrev-string cdabbrev-abbrev-string initial-completions-tried cdabbrev-completions-tried reset-cdabbrev-window t] 2 (#$ . 9439)]) (defalias 'set-cdabbrev-buffer #[nil "Á=ƒ  ‚Ã!q‡" [cdabbrev-current-window t other-buffer window-buffer] 2]) #@57 Resets the cdabbrev search to search for abbrev-string. (defalias 'reset-cdabbrev-window #[(&optional initializep) "ƒ\nÁ ‚&\nÃ=ƒÄ‚&\nƒ&Å\n!‰Á =ƒ&Ã\n…KŠÆ ˆ`‰ ƒCe Z]‚De\nĉ )‡" [initializep selected-window cdabbrev-current-window t nil next-window set-cdabbrev-buffer cdabbrev-current-point cdabbrev-start-point completion-search-distance cdabbrev-stop-point cdabbrev-wrapped-p] 4 (#$ . 9929)]) #@159 Return the next possible cdabbrev expansion or nil if there isn't one. `reset-cdabbrev' must've been called already. This is sensitive to `case-fold-search'. (defalias 'next-cdabbrev #[nil "…ÀÁ‰‰‰‰‰‰ŠÉŽÊ ˆ`Ë Ì !ˆbˆÏÒ#ƒ„hz‰ÓU„S ÔU…€`ÕvˆhzÓU\nbˆ…€Ö ‰…€—\fƒt \f@˜„t\fA‰„f\fƒÁ‰‚€Ò?‚¢„¥ƒ˜d\\^‚™d‰bˆÒ‰„+ƒ³ B`*†¾Û ˆÜ .‡" [cdabbrev-current-window nil saved-point-2 syntax tried-list downcase-expansion expansion saved-syntax saved-point ((byte-code "À !ˆ\nb‡" [set-syntax-table saved-syntax saved-point] 2)) set-cdabbrev-buffer syntax-table set-syntax-table cmpl-syntax-table cdabbrev-current-point search-backward cdabbrev-abbrev-string cdabbrev-stop-point t 32 119 -1 symbol-under-point cdabbrev-completions-tried cdabbrev-wrapped-p completion-search-distance cdabbrev-start-point reset-cdabbrev-window next-cdabbrev] 8 (#$ . 10354)]) (byte-code "ÀÁ\nBÀ‡" [511 cmpl-obarray-length current-load-list] 2) #@115 An obarray used to store the downcased completion prefixes. Each symbol is bound to a list of completion entries. (defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0) (#$ . 11337)) #@104 An obarray used to store the downcased completions. Each symbol is bound to a single completion entry. (defvar cmpl-obarray (make-vector cmpl-obarray-length 0) (#$ . 11536)) (defalias 'completion-string '(macro . #[(completion-entry) "À D‡" [car completion-entry] 2])) (defalias 'completion-num-uses '(macro . #[(completion-entry) "ÀÁ\nDD‡" [car cdr completion-entry] 3])) (defalias 'completion-last-use-time '(macro . #[(completion-entry) "ÀÁ\nE‡" [nth 2 completion-entry] 3])) (defalias 'completion-source '(macro . #[(completion-entry) "ÀÁ\nE‡" [nth 3 completion-entry] 3])) (defalias 'set-completion-string '(macro . #[(completion-entry string) "À \nE‡" [setcar completion-entry string] 3])) (defalias 'set-completion-num-uses '(macro . #[(completion-entry num-uses) "ÀÁ\nD E‡" [setcar cdr completion-entry num-uses] 3])) (defalias 'set-completion-last-use-time '(macro . #[(completion-entry last-use-time) "ÀÁ‰\nDD E‡" [setcar cdr completion-entry last-use-time] 4])) #@39 Returns a list of a completion entry. (defalias 'make-completion #[(string) "Á FC‡" [string 0 nil current-completion-source] 4 (#$ . 12515)]) (defalias 'cmpl-prefix-entry-head '(macro . #[(prefix-entry) "À D‡" [car prefix-entry] 2])) (defalias 'cmpl-prefix-entry-tail '(macro . #[(prefix-entry) "À D‡" [cdr prefix-entry] 2])) (defalias 'set-cmpl-prefix-entry-head '(macro . #[(prefix-entry new-head) "À \nE‡" [setcar prefix-entry new-head] 3])) (defalias 'set-cmpl-prefix-entry-tail '(macro . #[(prefix-entry new-tail) "À \nE‡" [setcdr prefix-entry new-tail] 3])) #@60 Makes a new prefix entry containing only completion-entry. (defalias 'make-cmpl-prefix-entry #[(completion-entry-list) "‰B‡" [completion-entry-list] 2 (#$ . 13087)]) #@73 Initializes the completion storage. All existing completions are lost. (defalias 'clear-all-completions #[nil "À Â\"À Â\"Ň" [make-vector cmpl-obarray-length 0 cmpl-prefix-obarray cmpl-obarray nil] 3 (#$ . 13260) nil]) (byte-code "À BÀ‡" [completions-list-return-value current-load-list] 2) #@53 Returns a list of all the known completion entries. (defalias 'list-all-completions #[nil "ÀÂÃ\f\"ˆ )‡" [nil completions-list-return-value mapatoms list-all-completions-1 cmpl-prefix-obarray] 3 (#$ . 13561)]) (defalias 'list-all-completions-1 #[(prefix-symbol) "À !… J@ \"‰‡" [boundp prefix-symbol append completions-list-return-value] 3]) #@77 Return list of lists of known completion entries, organized by hash bucket. (defalias 'list-all-completions-by-hash-bucket #[nil "ÀÂÃ\f\"ˆ )‡" [nil completions-list-return-value mapatoms list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray] 3 (#$ . 13912)]) (defalias 'list-all-completions-by-hash-bucket-1 #[(prefix-symbol) "À !… J@\nB‰‡" [boundp prefix-symbol completions-list-return-value] 2]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ B‡" [boundp completion-to-accept nil current-load-list cmpl-db-downcase-string cmpl-db-symbol cmpl-db-prefix-symbol cmpl-db-entry] 2) #@45 Set to T if you want to debug the database. (defvar cmpl-db-debug-p nil (#$ . 14532)) #@105 Returns the completion entry for string or nil. Sets up `cmpl-db-downcase-string' and `cmpl-db-symbol'. (defalias 'find-exact-completion #[(string) "ÀÁ\n—‰\f\"‰!… J‡" [boundp intern string cmpl-db-downcase-string cmpl-obarray cmpl-db-symbol] 4 (#$ . 14625)]) #@183 Returns the prefix entry for string. Sets `cmpl-db-prefix-symbol'. Prefix-string must be exactly `completion-prefix-min-length' long and downcased. Sets up `cmpl-db-prefix-symbol'. (defalias 'find-cmpl-prefix-entry #[(prefix-string) "ÀÁ\n \"‰!… \fJ‡" [boundp intern prefix-string cmpl-prefix-obarray cmpl-db-prefix-symbol] 4 (#$ . 14895)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp inside-locate-completion-entry nil current-load-list] 2) #@185 Locates the completion entry. Returns a pointer to the element before the completion entry or nil if the completion entry is at the head. Must be called after `find-exact-completion'. (defalias 'locate-completion-entry #[(completion-entry prefix-entry) "@Á‰@\f=?…C ƒ!\f A‰@=„!\n‰„ †C ƒ1ÆÇ\"‚C ƒ;Ê ‚C ÁLˆÌ\f!*‡" [prefix-entry nil next-prefix-list prefix-list completion-entry cmpl-db-debug-p error "Completion entry exists but not on prefix list - %s" completion-string inside-locate-completion-entry locate-completion-db-error cmpl-db-symbol locate-completion-entry-retry] 4 (#$ . 15338)]) (defalias 'locate-completion-entry-retry #[(old-entry) "À @ A@Ä 8#ˆÅ @!‰…ÇÉ\nO! ƒ4 ƒ4Ì \"‚6Í +‡" [t inside-locate-completion-entry add-completion old-entry 2 find-exact-completion cmpl-entry find-cmpl-prefix-entry cmpl-db-downcase-string 0 completion-prefix-min-length pref-entry locate-completion-entry locate-completion-db-error] 6]) (defalias 'locate-completion-db-error #[nil "ÀÁ!‡" [error "Completion database corrupted. Try M-x clear-all-completions. Send bug report."] 2]) #@303 If STRING is not in the database add it to appropriate prefix list. STRING is added to the end of the appropriate prefix list with num-uses = 0. The database is unchanged if it is there. STRING must be longer than `completion-prefix-min-length'. This must be very fast. Returns the completion entry. (defalias 'add-completion-to-tail-if-new #[(string) "À !†8 !Ã\fÅO!ƒ)A¡ˆ¡ˆ‚1 Ê!Lˆ @L*‡" [find-exact-completion string make-completion find-cmpl-prefix-entry cmpl-db-downcase-string 0 completion-prefix-min-length prefix-entry entry cmpl-db-prefix-symbol make-cmpl-prefix-entry cmpl-db-symbol] 5 (#$ . 16455)]) #@344 If COMPLETION-STRING is not in the database, add it to prefix list. We add COMPLETION-STRING to the head of the appropriate prefix list, or it to the head of the list. COMPLETION-STRING must be longer than `completion-prefix-min-length'. Updates the saved string with the supplied string. This must be very fast. Returns the completion entry. (defalias 'add-completion-to-head #[(completion-string) "ƒÁ ˆÂ !‰ƒLÅÇO! Ê\f \"‰ A\f\f  ˆ ƒI \fA¡„<  ¡ˆ\f @¡ˆ \f ˆ\f+‡Í !ÅÇO!  ƒp @¡ˆ  ˆ‚xÐ!Lˆ@L*‡" [completion-to-accept accept-completion find-exact-completion completion-string cmpl-db-entry find-cmpl-prefix-entry cmpl-db-downcase-string 0 completion-prefix-min-length prefix-entry locate-completion-entry splice-ptr cmpl-ptr make-completion entry cmpl-db-prefix-symbol make-cmpl-prefix-entry cmpl-db-symbol] 6 (#$ . 17098)]) #@102 Deletes the completion from the database. String must be longer than `completion-prefix-min-length'. (defalias 'delete-completion #[(completion-string) "ƒÁ ˆÂ !‰ƒMÅÇO! Ê\f \" \fÍLˆ ƒ< ‰AA¡„J  ¡ˆ‚J ‰@A „JÍLˆ*͇ÏÐ \"‡" [completion-to-accept accept-completion find-exact-completion completion-string cmpl-db-entry find-cmpl-prefix-entry cmpl-db-downcase-string 0 completion-prefix-min-length prefix-entry locate-completion-entry splice-ptr cmpl-db-symbol nil cmpl-db-prefix-symbol error "Unknown completion `%s'"] 4 (#$ . 17972)]) (defalias 'interactive-completion-string-reader #[(prompt) "À ‰ƒÂÃ\f #‚ÂÅ\f\"Ç\"‰ GÊUƒ+ †)Ë  +C‡" [symbol-under-or-before-point default format "%s: (default: %s) " prompt "%s: " new-prompt completing-read cmpl-obarray read 0 ""] 5]) (defalias 'check-completion-length #[(string) "G Wƒ\fÂÃ\"‡C‡" [string completion-min-length error "The string `%s' is too short to be saved as a completion"] 3]) #@148 Add STRING to completion list, or move it to head of list. The completion is altered appropriately if num-uses and/or last-use-time is specified. (defalias 'add-completion #[(string &optional num-uses last-use-time) "À !ˆtƒ\f\n‚ Ä !ƒ A ˆ…( AA *‡" [check-completion-length string cmpl-source-interactive current-completion-source add-completion-to-head entry num-uses last-use-time] 2 (#$ . 18946) (interactive-completion-string-reader "Completion to add")]) #@63 Add STRING if it isn't already listed, and mark it permanent. (defalias 'add-permanent-completion #[(string) "tƒ‚  ÄÅ#)‡" [cmpl-source-interactive current-completion-source add-completion string nil t] 4 (#$ . 19427) (interactive-completion-string-reader "Completion to add permanently")]) (defalias 'kill-completion #[(string) "À !ˆÂ !‡" [check-completion-length string delete-completion] 2 nil (interactive-completion-string-reader "Completion to kill")]) #@148 Accepts the pending completion in `completion-to-accept'. This bumps num-uses. Called by `add-completion-to-head' and `completion-search-reset'. (defalias 'accept-completion #[nil " ÂÂÆ !‰A A@T ˆÇ‰+‡" [completion-to-accept cmpl-source-cdabbrev nil entry current-completion-source string add-completion-to-head t cmpl-completions-accepted-p] 4 (#$ . 19899)]) #@76 Add the completion symbol underneath the point into the completion buffer. (defalias 'use-completion-under-point #[nil "…Á \n‰…Å\f!*‡" [enable-completion symbol-under-point cmpl-source-cursor-moves current-completion-source string add-completion-to-head] 3 (#$ . 20273)]) #@68 Add the completion symbol before point into the completion buffer. (defalias 'use-completion-before-point #[nil "…Á \n‰…Å\f!*‡" [enable-completion symbol-before-point cmpl-source-cursor-moves current-completion-source string add-completion-to-head] 3 (#$ . 20558)]) #@68 Add the completion symbol before point into the completion buffer. (defalias 'use-completion-under-or-before-point #[nil "…Á \n‰…Å\f!*‡" [enable-completion symbol-under-or-before-point cmpl-source-cursor-moves current-completion-source string add-completion-to-head] 3 (#$ . 20837)]) #@174 Add the completion symbol before point into the completion buffer. Completions added this way will automatically be saved if `completion-on-separator-character' is non-nil. (defalias 'use-completion-before-separator #[nil "…Á \nÉ…+Ç!…+\fA@ÉU…+\fAÊ ˆË‰\f+‡" [enable-completion symbol-before-point cmpl-source-separator nil entry current-completion-source string add-completion-to-head completion-on-separator-character 0 1 t cmpl-completions-accepted-p] 4 (#$ . 21135)]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÆÅ BÀÇ!„-ÈÇ BÀÉ!„:È É BÀÊ!„GÈ\nÊ BÀË!„TÈ Ë BÀÌ!„aÈ\fÌ Bȇ" [boundp cmpl-test-string "" current-load-list cmpl-test-regexp cmpl-last-index 0 cmpl-cdabbrev-reset-p nil cmpl-next-possibilities cmpl-starting-possibilities cmpl-next-possibility cmpl-tried-list] 2) #@108 Set up the for completion searching for STRING. STRING must be longer than `completion-prefix-min-length'. (defalias 'completion-search-reset #[(string) "ƒÁ ˆÂ Ä O—!@ È !ÉP\nË ‡" [completion-to-accept accept-completion find-cmpl-prefix-entry string 0 completion-prefix-min-length cmpl-starting-possibilities cmpl-test-string regexp-quote "." cmpl-test-regexp completion-search-reset-1] 4 (#$ . 21949)]) (defalias 'completion-search-reset-1 #[nil "ÂÂʼn‡" [cmpl-starting-possibilities cmpl-next-possibilities nil cmpl-next-possibility cmpl-cdabbrev-reset-p -1 cmpl-last-index cmpl-tried-list] 2]) #@164 Return the next completion entry. If INDEX is out of sequence, reset and start from the top. If there are no more entries, try cdabbrev and returns only a string. (defalias 'completion-search-next #[(index) " T‰UƒÂÃ!ˆ‚qÄWƒWÅ ˆÆ!ÂÉ!ƒ6T‰ÄWƒ6É\n‚!ƒq ËUƒH‚qGGZ›‚qÅ ˆÂÃ!ƒqS‰ÄW„qÉ\n‚\\\nÉ\n‡" [index cmpl-last-index completion-search-peek t 0 completion-search-reset-1 reverse cmpl-starting-possibilities cmpl-next-possibilities nil cmpl-next-possibility -1] 3 (#$ . 22568)]) #@278 Returns the next completion entry without actually moving the pointers. Calling this again or calling `completion-search-next' results in the same string being returned. Depends on `case-fold-search'. If there are no more entries, try cdabbrev and then return only a string. (defalias 'completion-search-peek #[(use-cdabbrev) "†C ƒ, @@\"Ä=„ A‰„ ƒ, @‰@— B A‡…C„?È \"ˆÊË ‰‡" [cmpl-next-possibility cmpl-next-possibilities string-match cmpl-test-regexp 0 cmpl-tried-list use-cdabbrev cmpl-cdabbrev-reset-p reset-cdabbrev cmpl-test-string t next-cdabbrev] 4 (#$ . 23092)]) #@69 Toggles whether or not to add new words to the completion database. (defalias 'completion-mode #[nil "?Áƒ ÂÄ\"‡" [enable-completion message "Completion mode is now %s." "ON" "OFF"] 3 (#$ . 23695) nil]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÇÆ BÀÈ!„.ÅÈ BŇ" [boundp cmpl-current-index 0 current-load-list cmpl-original-string nil cmpl-last-insert-location -1 cmpl-leave-point-at-start] 2) #@437 Fill out a completion of the word before point. Point is left at end. Consecutive calls rotate through all possibilities. Prefix args :: control-u :: leave the point at the beginning of the completion rather than at the end. a number :: rotate through the possible completions by that amount `-' :: same as -1 (insert previous completion) {See the comments at the top of `completion.el' for more info.} (defalias 'complete #[(&optional arg) " =ƒ\n`|ˆ \f†Å\\‚T„Ç ˆ:ƒ+ÉÊ ‚.Ì Í ‰„>ÏÐÑ\"ˆƒG\f‚HÉÓ!ˆ|ˆY…_Ø ?`Û !̃Ö;ƒ|‚@Þ\"‰cˆ ƒž`bˆ‚¡…úàÉ!…úá\"!‰…ú;ƒÁ‚Ä@Þ\"ãä\"‚úcˆÌƒ÷àÉ!ƒ÷ãå =ƒôæ‚õç\"ˆÏ‰,‡" [last-command this-command cmpl-last-insert-location cmpl-current-index arg 1 cmpl-initialized-p initialize-completions current-prefix-arg 0 t cmpl-leave-point-at-start nil symbol-before-point-for-complete cmpl-original-string failed-complete error "To complete, point must be after a symbol at least %d character long" completion-prefix-min-length completion-search-reset cmpl-symbol-start cmpl-symbol-end baud-rate completion-prompt-speed-threshold minibuffer-window-selected-p print-status-p insert-point completion-search-next entry string cmpl-merge-string-cases completion-to-accept sit-for completion-search-peek completion-cdabbrev-prompt-flag message "Next completion: %s" "No %scompletions." "more " ""] 5 (#$ . 24109) "*p"]) (byte-code "ÀÁÂ\"ˆÀÃÂ\"ˆÄ ÆÇ#‡" [global-set-key "" complete [67108877] define-key function-key-map [C-return] [67108877]] 4) #@67 Parse possible completions from a file and add them to data base. (defalias 'add-completions-from-file #[(file) "À ! !‰‰„ÅÇ !)ÈŽŠ qˆÉ ,‡" [expand-file-name file get-file-buffer buffer buffer-already-there-p nil completions-merging-modes find-file-noselect ((byte-code "„Á\n!ˆÁ‡" [buffer-already-there-p kill-buffer buffer] 2)) add-completions-from-buffer] 3 (#$ . 25716) "fFile: "]) (defalias 'add-completions-from-buffer #[nil "Á‰ Æ>ƒÇ ˆÈ‚' É>ƒ\"Ê ˆË‚'ÌÍ \"ˆ+Á‡" [cmpl-source-file-parsing nil mode start-num current-completion-source major-mode (emacs-lisp-mode lisp-mode) add-completions-from-lisp-buffer lisp (c-mode) add-completions-from-c-buffer c error "Cannot parse completions in %s buffers"] 3 nil nil]) (defalias 'cmpl-find-file-hook #[nil "…! Â>ƒÃ\f>ƒÅ ‡ Æ>…!Ç\f>…!Å ‡" [enable-completion major-mode (emacs-lisp-mode lisp-mode) lisp completions-merging-modes add-completions-from-buffer (c-mode) c] 2]) (add-hook (quote find-file-hooks) (quote cmpl-find-file-hook)) #@46 Add completions from the current tags table. (defalias 'add-completions-from-tags-table #[nil "À ˆŠebˆÁÃÄÅ*‡" [visit-tags-table-buffer nil string e (byte-code "ÀÁ!ˆÂÃ!ˆÄ ‰ƒÆ !ˆÃuˆ‚" [search-forward "" backward-char 3 symbol-under-point string add-completion-to-tail-if-new] 2) ((search-failed))] 3 (#$ . 26730) nil]) #@50 A regexp that searches for lisp definition form. (defconst *lisp-def-regexp* "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*" (#$ . 27061)) (defalias 'add-completions-from-lisp-buffer #[nil "ÀŠebˆÂÃÄ*‡" [nil string e (byte-code "À !ˆÂ ‰ƒÄ !ˆ‚" [re-search-forward *lisp-def-regexp* symbol-under-point string add-completion-to-tail-if-new] 2) ((search-failed))] 3]) (defalias 'cmpl-make-c-def-completion-syntax-table #[nil "À ÁÂÃÈÈÉWƒ!Ê\fË#ˆ\fT‰‚Ã\f‰ ƒB @\fÊ\fÎ#ˆ A‰ „,* Ã\f‰ƒc@\fÊ\fÐ#ˆA‰„M*ÊÑÒ#ˆÊÓÔ#ˆÊÕÖ#ˆÊ×Ø#ˆ,‡" [make-syntax-table (32 10 9 12 11 13) (44 42 61 40 59) nil i separator-chars whitespace-chars table 0 256 modify-syntax-entry "w" char --dolist-temp--21 "_" --dolist-temp--22 " " 91 "(]" 123 "(}" 93 ")[" 125 "){"] 5]) (byte-code "À Á\nBÀ‡" [cmpl-make-c-def-completion-syntax-table cmpl-c-def-syntax-table current-load-list] 2) #@47 A regexp that searches for a definition form. (defconst *c-def-regexp* "\n[_a-zA-Z#]" (#$ . 27963)) (defalias 'add-completions-from-c-buffer #[nil "À‰‰Á ŠebˆÆÇ-‡" [nil syntax-table saved-syntax char next-point string finish-add-completions (byte-code "ÀŽÁ\n!ˆÃÄň‚" [((set-syntax-table saved-syntax)) set-syntax-table cmpl-c-def-syntax-table e (byte-code "À !ˆhÂUƒ/``Ã\\{‰Ř„\fƘƒÇvƒÈ ‰ƒÉ\f!ˆ‚`\n\nƒË\nÌ\"‰\nƒ\nbˆg‰ ÎUƒ[Ë`Ì\"‰\nbˆ‚FÏvˆÐ ‰ƒlÉ\f!ˆ‚€ÑÒ!ƒ€ÏvˆÐ ‰ƒ€É\f!ˆ\nbˆ zÓUƒ£ zÓUƒ2Ë\nÌ\"‰\nf‰ ‚Ž ÔU„2Õ‰\n‚4" [re-search-forward *c-def-regexp* 35 6 string "define" "ifdef " 2 symbol-before-point add-completion-to-tail-if-new next-point scan-sexps 1 char 42 -1 symbol-under-point looking-at "_AP" 40 44 nil] 4) ((search-failed (byte-code "ÀÁÂ\"‡" [throw finish-add-completions t] 3)) (error (byte-code "A@Á˜„A@˜ƒÃyˆ‚ÄÅ!ˆÆÇÈ\"ˆÃ‡" [e "Containing expression ends prematurely" "Unbalanced parentheses" 1 message "Error parsing C buffer for completions--please send bug report" throw finish-add-completions t] 3)))] 3)] 4]) (defalias 'kill-emacs-save-completions #[nil "… …\n… „ÄÅ!‡Æ ‡" [save-completions-flag enable-completion cmpl-initialized-p cmpl-completions-accepted-p message "Completions database has not changed - not writing." save-completions-to-file] 2]) (byte-code "ÀÁ\nBÃÄ\nBÁ‡" ["11" completion-version current-load-list ";;; Completion Initialization file.\n;;; Version = %s\n;;; Format is ( . )\n;;; is the completion\n;;; is the time the completion was last used\n;;; If it is t, the completion will never be pruned from the file.\n;;; Otherwise it is in hours since origin.\n\n" saved-cmpl-file-header] 2) (defalias 'completion-backup-filename #[(filename) "ÁP‡" [filename ".BAK"] 2]) #@106 Save completions in init file FILENAME. If file name is not specified, use `save-completions-file-name'. (defalias 'save-completions-to-file #[(&optional filename) "À †\n!à !…Ü\f„Å ˆÆÇ \"ˆÈ Ê \f ÎÐ ÊÊÊÕ !Š×Ø!ˆØqˆ Úp!„XÆÛ!ˆÜ È\"ˆÆÝ \"ˆÞ ˆß ˆà!\"\"cˆã Î$‰%ƒÐ%@$Tæ$8‰È=ƒT‰„¶$A@ÊVƒ¡‰‚³ƒÇ'ƒ¶Z'WƒÇTè$@B!鱈%A‰%„q*êëìˆÎ-.\n·" [expand-file-name filename save-completions-file-name file-writable-p cmpl-initialized-p initialize-completions message "Saving completions to file %s" t delete-old-versions 0 kept-old-versions completions-file-versions-kept kept-new-versions nil last-use-time cmpl-hours-since-origin current-time total-in-db total-perm total-saved completion-backup-filename backup-filename get-buffer-create " *completion-save-buffer*" buffer-file-name verify-visited-file-modtime "Completion file has changed. Merging. . ." load-completions-from-file "Merging finished. Saving completions to file %s" clear-visited-file-modtime erase-buffer format saved-cmpl-file-header completion-version list-all-completions completion --dolist-temp--23 2 save-completions-retention-time prin1-to-string "\n" e (byte-code "À !‰ƒÀ\n!„à \n\"ˆÄ\n Å#ˆÆ ˆƒ$Ç\n!ˆ)À‡" [file-exists-p filename backup-filename rename-file copy-file t save-buffer delete-file] 5) ((error (byte-code "ÀÁ!ˆÂÃ\f\"‡" [set-buffer-modified-p nil message "Couldn't save completion file `%s'" filename] 3))) cmpl-completions-accepted-p] 4 (#$ . 29800) nil]) #@105 Loads a completion init file FILENAME. If file is not specified, then use `save-completions-file-name'. (defalias 'load-completions-from-file #[(&optional filename no-message-p) "À †\n!à !Å\f!‰ƒ\fÅ !…€„1ÈɃ-Ê‚.Ë #ˆŠÌÍ!ˆÍqˆ Ï ˆÐ ˆÑpÒ Ñ‰‰‰‰‰ÑÔ‰ !âãäˆ!ƒ}ebˆâåæˆ.Ñ*‡" [expand-file-name filename save-completions-file-name completion-backup-filename backup-filename file-readable-p backup-readable-p no-message-p message "Loading completions from %sfile %s . . ." "backup " "" get-buffer-create " *completion-save-buffer*" buffer-file-name clear-visited-file-modtime erase-buffer nil cmpl-hours-since-origin cmpl-source-init-file 0 total-perm total-in-file start-num current-completion-source cmpl-last-use-time cmpl-entry last-use-time entry num-uses string current-time buffer insert-okay-p e (byte-code "À Â\"ˆÂÀ‡" [insert-file-contents filename t insert-okay-p] 3) ((file-error (message "File error trying to load completion file %s." filename))) (byte-code "À ! T\n:ƒo\n@‰;ƒo\nA‰Æ=ƒ(Tȉ‚9 È=ƒ7T‰‚9 ¨ƒoÉÊ\f!‰ 8\f È=„e ÍVƒ\fÈ=„\fƒe \fVƒ AA  ˆ‚ÎÏÐ\n!\"ˆÑÒ!ˆ‚" [read buffer entry total-in-file string last-use-time T total-perm t 2 add-completion-to-tail-if-new cmpl-entry cmpl-last-use-time 1000 message "Error: invalid saved completion - %s" prin1-to-string search-forward "\n("] 4) ((search-failed (message "End of file while reading completions.")) (end-of-file (byte-code "`dUƒ„Á \"ˆ‚ÁÄ!ˆÁ‡" [no-message-p message "Loading completions from file %s . . . Done." filename "End of file while reading completions."] 3)))] 14 (#$ . 31310) nil]) #@105 Load the default completions file. Also sets up so that exiting emacs will automatically save the file. (defalias 'initialize-completions #[nil "„Á ˆÂ‰‡" [cmpl-initialized-p load-completions-from-file t] 2 (#$ . 32955) nil]) (add-hook (quote kill-emacs-hook) (quote (lambda nil (kill-emacs-save-completions) (cmpl-statistics-block (record-cmpl-kill-emacs))))) #@620 Kill between point and mark. The text is deleted but saved in the kill ring. The command \[yank] can retrieve it from there. /(If you want to kill and then yank immediately, use \[copy-region-as-kill].) This is the primitive for programs to kill text (as opposed to deleting it). Supply two arguments, character numbers indicating the stretch of text to be killed. Any command that calls this function is a "kill command". If the previous command was also a kill command, the text killed this time appends to the text killed last time to make one entry in the kill ring. Patched to remove the most recent completion. (defalias 'completion-kill-region #[(&optional beg end) "Á=ƒ`\n|ˆ cˆÄćÆ\"‡" [last-command complete cmpl-last-insert-location cmpl-original-string nil completion-to-accept kill-region beg end] 3 (#$ . 33326) "r"]) (global-set-key "" (quote completion-kill-region)) (defalias 'completion-separator-self-insert-command #[(arg) "À ˆÁ\n!‡" [use-completion-before-separator self-insert-command arg] 2 nil "p"]) (defalias 'completion-separator-self-insert-autofilling #[(arg) "À ˆÁ\n!ˆ … ‡" [use-completion-before-separator self-insert-command arg auto-fill-function] 2 nil "p"]) #@145 Add a call to update the completion database before function execution. TYPE is the type of the wrapper to be added. Can be :before or :under. (defalias 'def-completion-wrapper '(macro . #[(function-name type &optional new-name) "Á=ƒÂÃ\fDÅÆF‡Ç=ƒÂÃ\fDÈÉF‡Ê=ƒ*ÂÃ\fDËÌF‡Í=ƒ8ÂÃ\fDÎÏF‡Ð=ƒFÂÃ\fDÑÒF‡Ó=ƒTÂÃ\fDÔÕF‡Ö=…aÂÃ\fD×ØF‡" [type :separator put quote function-name (quote completion-function) (quote use-completion-before-separator) :before (quote completion-function) (quote use-completion-before-point) :backward-under (quote completion-function) (quote use-completion-backward-under) :backward (quote completion-function) (quote use-completion-backward) :under (quote completion-function) (quote use-completion-under-point) :under-or-before (quote completion-function) (quote use-completion-under-or-before-point) :minibuffer-separator (quote completion-function) (quote use-completion-minibuffer-separator)] 4 (#$ . 34538)])) (defalias 'use-completion-minibuffer-separator #[nil " )‡" [cmpl-standard-syntax-table cmpl-syntax-table use-completion-before-separator] 1]) (defalias 'use-completion-backward-under #[nil "À ˆÁ‡" [use-completion-under-point nil] 1]) (defalias 'use-completion-backward #[nil "À‡" [nil] 1]) (defalias 'completion-before-command #[nil "9ƒ ÁN†\f ‡" [this-command completion-function use-completion-under-or-before-point] 2]) (byte-code "ÀÁÂ\"ˆÃÄÅ\"ˆÃÆÇ\"ˆÃÈÇ\"ˆÃÉÇ\"ˆÃÊÇ\"ˆÃËÇ\"ˆÃÌÇ\"ˆÃÍÇ\"ˆÃÎÇ\"ˆÃÏÇ\"ˆÃÐÇ\"ˆÃÑÇ\"ˆÃÒÇ\"ˆÃÓÇ\"ˆÃÔÇ\"ˆÃÕÇ\"ˆÃÖÇ\"ˆÃ×Ç\"ˆÃØÇ\"ˆÃÙÇ\"ˆÃÚÇ\"ˆÃÛÇ\"ˆÜÆÞ#ˆÜÊÞ#ˆÜÈÞ#ˆÜÙÞ#ˆÜÍÞ#ˆÜÉÞ#‡" [add-hook pre-command-hook completion-before-command global-set-key " " completion-separator-self-insert-autofilling "!" completion-separator-self-insert-command "%" "^" "&" "(" ")" "=" "`" "|" "{" "}" "[" "]" ";" "\"" "'" "#" "," "?" "." ":" define-key lisp-mode-map self-insert-command] 4) (defalias 'completion-c-mode-hook #[nil "ÀÁÂÃ#ˆÄ ÆÇ#ˆÄ ÈÇ#ˆÄ ÉÇ#‡" [put electric-c-semi completion-function use-completion-before-separator define-key c-mode-map "+" completion-separator-self-insert-command "*" "/"] 4]) (byte-code "ÀÁ!ƒ\f ˆ‚ÃÄÂ\"ˆÀ‡" [featurep cc-mode completion-c-mode-hook add-hook c-mode-hook] 3) (defalias 'completion-setup-fortran-mode #[nil "À ÂÃ#ˆÀ ÄÃ#ˆÀ ÅÃ#ˆÀ ÆÃ#‡" [define-key fortran-mode-map "+" completion-separator-self-insert-command "-" "*" "/"] 4]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÇ#ˆÀÈÂÃ#ˆÀÉÂÃ#ˆÀÊÂË#ˆÀÌÂË#ˆÀÍÂË#ˆÀÎÂË#ˆÀÏÂË#ˆÀÐÂË#ˆÀÑÂË#ˆÀÒÂË#ˆÀÓÂË#ˆÀÔÂÕ#ˆÀÖÂÕ#ˆÀ×ÂÕ#ˆÀØÂÙ#ˆÀÚÂÙ#‡" [put newline completion-function use-completion-before-separator newline-and-indent comint-send-input exit-minibuffer use-completion-minibuffer-separator eval-print-last-sexp eval-last-sexp next-line use-completion-under-or-before-point previous-line beginning-of-buffer end-of-buffer beginning-of-line end-of-line forward-char forward-word forward-sexp backward-char use-completion-backward-under backward-word backward-sexp delete-backward-char use-completion-backward delete-backward-char-untabify] 4) emacs-19.30/lisp/cookie1.elc100666 12120 1 6030 5751546037 14107 0ustar rmsdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:19:42 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/cookie1.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/cookie1.el' was compiled for Emacs 19")) (random t) #@49 Delimiter used to separate cookie file entries. (defconst cookie-delimiter "\n%%\n\\|" (#$ . 494)) #@55 Cache of cookie files that have already been snarfed. (defvar cookie-cache (make-vector 511 0) (#$ . 600)) #@130 Return a random phrase from PHRASE-FILE. When the phrase file is read in, display STARTMSG at beginning of load, ENDMSG at end. (defalias 'cookie #[(phrase-file startmsg endmsg) "À \n #Å\f!ˆ\fÆH)‡" [cookie-snarf phrase-file startmsg endmsg cookie-vector shuffle-vector 1] 4 (#$ . 714)]) #@144 Insert random phrases from PHRASE-FILE; COUNT of them. When the phrase file is read in, display STARTMSG at beginning of load, ENDMSG at end. (defalias 'cookie-insert #[(phrase-file &optional count startmsg endmsg) "À \n #Å\f!ˆ`ÇcˆÈ\fGÉZ\n†É^\f\"ˆÇcˆË`Ì#*‡" [cookie-snarf phrase-file startmsg endmsg cookie-vector shuffle-vector start 10 cookie1 1 count fill-region-as-paragraph nil] 4 (#$ . 1010)]) #@36 Inserts a cookie phrase ARG times. (defalias 'cookie1 #[(arg cookie-vec) "ÁUƒ‡ HcˆÄcˆÅS \"‡" [arg 0 t cookie-vec " " cookie1] 3 (#$ . 1425)]) #@188 Reads in the PHRASE-FILE, returns it as a vector of strings. Emit STARTMSG and ENDMSG before and after. Caches the result; second and subsequent calls on the same file won't go to disk. (defalias 'cookie-snarf #[(phrase-file startmsg endmsg) "À \n\"‰ƒ KÄÅ !8š„Æ ÇP!ƒÈ ƒ' J‚€É \n\"Ê !ˆŠÌÍ!ȉqˆ ÄÅ !8MˆÐÑ !!ˆÒ!ˆÔÈwˆm„n`Ò!ˆ`S{B)‚PÖ!ˆÊ!ˆ ØÙ\"L+)‡" [intern-soft phrase-file cookie-cache sym 5 file-attributes yes-or-no-p " has changed. Read new contents? " nil intern message startmsg generate-new-buffer "*cookie*" result buf insert-file-contents expand-file-name re-search-forward cookie-delimiter " \n \f" beg kill-buffer endmsg apply vector] 5 (#$ . 1580)]) #@198 Prompt with PROMPT and read with completion among cookies in PHRASE-FILE. STARTMSG and ENDMSG are passed along to `cookie-snarf'. Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie. (defalias 'read-cookie #[(prompt phrase-file startmsg endmsg &optional require-match) "À \n\"„ à \f #ˆÆÈ \n\"‰ ÊN†KË\fà \f #‰ GS‰ÏVƒC HC\fB\f‚*Ð Ê\f#+)Ëˉ&‡" [intern-soft phrase-file cookie-cache cookie-snarf startmsg endmsg completing-read prompt intern sym completion-alist nil alist vec i 0 put require-match] 8 (#$ . 2283)]) #@75 Randomly permute the elements of VECTOR (all permutations equally likely) (defalias 'shuffle-vector #[(vector) "ÀÁ‰\nG‰ Wƒ5Ç Z!\\\nH\n\n HIˆ\n \fIˆT‰‚ ,\n‡" [0 nil vector len temp j i random] 5 (#$ . 2840)]) (provide (quote cookie1)) emacs-19.30/lisp/copyright.elc100666 13437 13 5613 6001002234 14434 0ustar jimbuser;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Jul 12 13:21:26 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/copyright.el ;;; emacs version 19.29.5. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`copyright.el' was compiled for Emacs 19.29 or later")) #@109 *Don't try to update copyright beyond this position unless interactive. `nil' means to search whole buffer. (defvar copyright-limit 2000 (#$ . -484)) #@90 *What your copyright notice looks like. Must contain \( \) construct matching the years. (defvar copyright-regexp "[Cc]opyright\\s *:?\\s *(C)\\s *\\([1-9][-0-9, ']*[0-9]+\\) " (#$ . -640)) #@117 *If non-`nil', ask user before changing copyright. When this is `function', only ask when called non-interactively. (defvar copyright-query (quote function) (#$ . -837)) #@39 String representing the current year. (defconst copyright-current-year (byte-code "À ÁÂO‡" [current-time-string -4 nil] 3) (#$ . 1013)) #@62 String representing the current version of the GPL or `nil'. (defconst copyright-current-gpl-version "2" (#$ . 1155)) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp copyright-update t current-load-list] 2) #@339 Update the copyright notice at the beginning of the buffer to indicate the current year. If optional prefix ARG is given replace the years in the notice rather than adding the current year after them. If necessary and `copyright-current-gpl-version' is set, the copying permissions following the copyright, if any, are updated as well. (defalias 'copyright-update #[(&optional arg) "ƒŠŒ~ˆebˆÁ\n Ä#ƒ¸Å•ÆZÅ•{ÈÉO˜„¸ÊÅ!ˆ ƒQ Ì=ƒ: À=„Q΃HÐÑQ‚MÒÓQ!ƒ¸ƒcŔŕ|ˆcˆ‚¸ŠÔÉx)Õ!Õ`\\`{!ZÖ¦Å=ƒž`×\\\\fØ=„–`È\\\\fØ=ƒžÙ!ˆ‚°Úcˆ`Û\\\\fÜ=ƒ°ÜcˆÉOcˆebˆƒÁÞ Ä#ƒߔߕ{˜„ ƒð Ì=ƒæ À=„ðÎàÑQ!ƒÆ•ƒƔƕ|ˆÆ”bˆcˆß”ß•|ˆß”bˆcˆ)áÀ!ÉLˆ)ɇ" [copyright-update re-search-forward copyright-regexp copyright-limit t 1 2 copyright-current-year -2 nil backward-char copyright-query function this-command y-or-n-p arg "Replace copyright year(s) by " "? " "Add " " to copyright? " "0-9" string-to-number 100 -1 45 delete-char ", " -3 39 copyright-current-gpl-version "\\(the Free Software Foundation; either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via \\)version \\([0-9]+\\), or (at" 3 "Replace GPL version by " make-local-variable] 4 (#$ . 1357) "*P"]) #@55 Insert a copyright by $ORGANIZATION notice at cursor. (defvar copyright (quote ("Company: " comment-start "Copyright (C) " copyright-current-year " by " (or (getenv "ORGANIZATION") str) (quote (if (> (point) copyright-limit) (message "Copyright extends beyond `copyright-limit' and won't be updated automatically."))) comment-end)) (#$ . 2557)) (defalias (quote copyright) (quote skeleton-proxy)) emacs-19.30/lisp/cplus-md.elc100666 12062 1 31525 6053157067 14273 0ustar bobdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 17 14:10:21 1995 ;;; from file /home/fsf/rms/e19/lisp/cplus-md.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`cplus-md.el' was compiled for Emacs 19.29 or later")) #@32 Abbrev table used in C++ mode. (defvar c++-mode-abbrev-table nil (#$ . 474)) (define-abbrev-table (quote c++-mode-abbrev-table) nil) #@26 Keymap used in C++ mode. (defvar c++-mode-map nil (#$ . 613)) (byte-code "„=Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÆ#ˆÂÈÉ#ˆÂÊË#ˆÂÌÍ#ˆÂÎÏ#ˆÂÐÑ#ˆÂÒÓ#ˆÁ‡" [c++-mode-map make-sparse-keymap define-key "\n" reindent-then-newline-and-indent "{" electric-c++-brace "}" ";" electric-c++-semi "" mark-c-function "" indent-c++-exp "" backward-delete-char-untabify " " c++-indent-command "" c-backslash-region] 4) #@32 Syntax table used in C++ mode. (defvar c++-mode-syntax-table nil (#$ . 1015)) (byte-code "„ Á\n!ÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊÉ#ˆÁ‡" [c++-mode-syntax-table copy-syntax-table c-mode-syntax-table modify-syntax-entry 42 ". 23b" 47 ". 124" 10 ">" 13] 4) #@150 *Extra indent for continuation lines of member inits; nil means to align with previous initializations rather than with the colon on the first line. (defvar c++-continued-member-init-offset nil (#$ . -1266)) #@72 *Indentation level of member initializations in function declarations. (defvar c++-member-init-indent 0 (#$ . -1480)) #@69 *Offset of C++ friend declarations relative to member declarations. (defvar c++-friend-offset -4 (#$ . -1604)) #@41 *If t, colon is an electric terminator. (defvar c++-electric-colon t (#$ . -1721)) #@112 *Indicates how far to indent an line following an empty argument list. Nil indicates to just after the paren. (defvar c++-empty-arglist-indent nil (#$ . -1811)) #@73 Imenu generic expression for C++ mode. See `imenu-generic-expression'. (defvar c++-imenu-generic-expression (byte-code "ÀÁÂÉÄÅÆÇÄÈÉÊËÌÍ°ÎBBÏÁÂÐÑÒ°ÓBBD‡" [nil "^" "\\(template[ ]*<[^>]+>[ ]*\\)?" "\\([a-zA-Z0-9_:]+[ ]+\\)?" "\\(" "[a-zA-Z0-9_:]+" "\\([ ]*[*&]+[ ]*\\|[ ]+\\)" "\\)?" "[a-zA-Z0-9_:~]+" "\\|" "\\([a-zA-Z0-9_:~]*::\\)?operator" "[^a-zA-Z1-9_][^(]*" " \\)" "[ ]*([^)]*)[ \n]*[^ ;]" (6) "Class" "class[ ]+" "\\([a-zA-Z0-9_]+\\)" "[ ]*[:{]" (2)] 16) (#$ . 1979)) #@2926 Major mode for editing C++ code. Very much like editing C code. Expression and list commands understand all C++ brackets. Tab at left margin indents for C++ code Comments are delimited with /* ... */ {or with // ... } Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \{c++-mode-map} Variables controlling indentation style: c-tab-always-indent Non-nil means TAB in C mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. Default is t. c-auto-newline Non-nil means automatically newline before and after braces, and after colons and semicolons, inserted in C code. c-indent-level Indentation of C statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. c-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. c-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to c-continued-statement-offset. c-brace-offset Extra indentation for line if it starts with an open brace. c-brace-imaginary-offset An open brace following other text is treated as if it were this far to the right of the start of its line. c-argdecl-indent Indentation level of declarations of C function arguments. c-label-offset Extra indentation for line that is a label, or case or ``default:'', or ``public:'' or ``private:'', or ``protected:''. c++-electric-colon If non-nil at invocation of c++-mode (t is the default) colon electricly indents. c++-empty-arglist-indent If non-nil, a function declaration or invocation which ends a line with a left paren is indented this many extra spaces, instead of flush with the left paren. c++-friend-offset Offset of C++ friend declarations relative to member declarations. c++-member-init-indent Indentation level of member initializations in function declarations, if they are on a separate line beginning with a colon. c++-continued-member-init-offset Extra indentation for continuation lines of member initializations; NIL means to align with previous initializations rather than with the colon. Settings for K&R, BSD, and Stroustrup indentation styles are c-indent-level 5 8 4 c-continued-statement-offset 5 8 4 c-continued-brace-offset 0 c-brace-offset -5 -8 0 c-brace-imaginary-offset 0 c-argdecl-indent 0 8 4 c-label-offset -5 -8 -4 c++-empty-arglist-indent 4 c++-friend-offset 0 Turning on C++ mode calls the value of the variable `c++-mode-hook' with no args if that value is non-nil. (defalias 'c++-mode #[nil "À ˆÁ\n!ˆÃ\f!ˆÅÇÉ\n \fÍÎ!ÏLˆÍÐ!ÑLˆÍÒ!ÓLˆÍÔ!ÕLˆÍÖ!×LˆÍØ!ÙPLˆÍÛ!LˆÍÜ!ÝLˆÍÞ!ÝLˆÍß!ÝLˆÍà!ˆ! âã!ˆ$…nå\næç#‡" [kill-all-local-variables use-local-map c++-mode-map set-syntax-table c++-mode-syntax-table c++-mode major-mode "C++" mode-name 32 comment-column c++-mode-abbrev-table local-abbrev-table make-local-variable indent-line-function c++-indent-line comment-start "// " comment-end "" comment-start-skip "/\\*+ *\\|// *" comment-indent-function c++-comment-indent paragraph-start "$\\|" page-delimiter paragraph-separate paragraph-ignore-fill-prefix t require-final-newline parse-sexp-ignore-comments imenu-generic-expression c++-imenu-generic-expression run-hooks c++-mode-hook c++-electric-colon define-key ":" electric-c++-terminator] 4 (#$ . 2480) nil]) (defalias 'c++-comment-indent #[nil "ÀÁ!ƒ‡ŠÃÄxˆiÂUƒ‚iT`ÆyˆÇ É#ƒ/”bˆi‚1\n)])‡" [looking-at "^\\(/\\*\\|//\\)" 0 " " nil cur-pt -1 re-search-forward comment-start-skip t comment-column] 5]) #@50 Insert character and correct line's indentation. (defalias 'electric-c++-brace #[(arg) "À\n„AlƒAŠÃÀxˆn)„\fƒAÅ ˆÆ ˆcˆÅ ˆ\fƒ3Æ ˆ`ÈZÅ ˆŠ ƒ< TbˆÉÊ!ˆ) ƒRŠ bˆËÌ\n!!)‚WËÌ\n!!)‡" [nil insertpos arg " " c-auto-newline c++-indent-line newline last-command-char 2 delete-char -1 self-insert-command prefix-numeric-value] 3 (#$ . 6412) "P"]) #@50 Insert character and correct line's indentation. (defalias 'electric-c++-semi #[(arg) "ƒÁ\n!‡ÃÄ\n!!‡" [c-auto-newline electric-c++-terminator arg self-insert-command prefix-numeric-value] 3 (#$ . 6762) "P"]) #@50 Insert character and correct line's indentation. (defalias 'electric-c++-terminator #[(arg) "À` „lƒŠÄyˆÅÀwˆgÆU†^È=ƒBÉÊ!†3ŠËvˆÅÀwˆ` Y)?†^ŠËˆÉÌ!)†^Í ˆÎ` \"Ð8†]Ñ8†]Ò8))„cˆÓ ˆƒ‚Õ „‚Ö ‰`SÀ“ˆ× ˆØ ˆŠ\nƒ‹\nTbˆÙÚ!ˆ)\nƒ¡Š\nbˆÛÜ !!)‚¦ÛÜ !!*‡" [nil end insertpos arg 0 " " 35 last-command-char 58 looking-at "case[ ]" 1 ":" beginning-of-defun parse-partial-sexp pps 3 4 5 c++-indent-line c-auto-newline c-inside-parens-p make-marker newline c-indent-line delete-char -1 self-insert-command prefix-numeric-value] 4 (#$ . 6979) "P"]) #@545 Indent current line as C++ code, or in some cases insert a tab character. If `c-tab-always-indent' is non-nil (the default), always indent current line. Otherwise, indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. A numeric argument, regardless of its value, means indent rigidly all means indent rigidly all the lines of the expression starting after point so that this line becomes properly indented. The relative indentation among the lines of the expression are preserved. (defalias 'c++-indent-command #[(&optional whole-exp) "ƒ3Á ‰ŠƒÇyˆ`ÈÉ!ˆ`\fbˆÉyˆ`) \fV…1Ê\f Ë$+‡„EŠÌÂxˆn)„EÍ ‡Á ‡" [whole-exp c++-indent-line nil end beg shift-amt c-tab-always-indent 0 forward-sexp 1 indent-code-rigidly "#" " " insert-tab] 5 (#$ . 7544) "P"]) #@80 Indent current line as C++ code. Return the amount the indentation changed by. (defalias 'c++-indent-line #[nil "ÀÁ!Á‰‰d`ZÇyˆ`Á=ƒ\"È ‚ÄÉ=ƒ0Ê ‚ÄËÌ!ƒ<Ç‚ÄÍÁwˆ<ƒK@ËÎ!ƒ[\\‚ÄËÐ!„sËÑ!ƒŠÒÓ!ˆËÔ!)ƒÓ\\]‚ÄËÕ!ƒ—ËÖ!„—Š× ˆÈ )‚ÄËØ!ƒ§\\‚ÄgÚUƒ·Z‚ÄgÜUƒÄ\\ÍÁwˆiZ‰ÇUƒãd\nZ`Vƒød\nZbˆ‚ø `|ˆjˆd\nZ`Vƒød\nZbˆ\f-‡" [calculate-c++-indent nil pos case-fold-search shift-amt beg indent 0 current-indentation t calculate-c-indent-within-comment looking-at "[ ]*#" " " "\\(default\\|public\\|private\\|protected\\):" c-label-offset "case\\b" "[A-Za-z]" forward-sexp 1 ":[^:]" "else\\b" "else\\s_" c-backward-to-start-of-if "friend[ ]" c++-friend-offset 125 c-indent-level 123 c-brace-offset] 7 (#$ . 8373)]) #@184 Return appropriate indentation for current line as C++ code. In usual case returns an integer: the column to indent to. Returns nil if line starts inside a string, t if in a comment. (defalias 'calculate-c++-indent #[(&optional parse-start) "ŠÀyˆ`Á‰‰ƒbˆ‚Ç ˆ` Wƒ1`È` À#‰A@‚É 8„=Ê 8ƒCÊ 8‚æ\n„Æ bˆËÁwˆgÌUƒXÀ‚æ͆_e!ˆhÎUƒ~ bˆËÁwˆgÏUƒy‚æ‚æhÒUƒˆÓÔ!ˆhÕUƒ’À‚æhÎUƒœÖ×!ˆÀyˆËÁwˆgÏUƒÁƒ¶Ù \\‚æÔuˆËÁwˆi‚æÙ ‚æ\nfÌU„ƒûÛ 8ƒäŠ\nTbˆÜÝ!)„û\nbˆÀyˆËÁwˆ`\\\nT^bˆi‚æ\nTbˆi‚æ bˆÍ\n!ˆhÞ>„@Š bˆËÁwˆgÕU)„@ß\n!ˆ i\\Š bˆËÁwˆg)Ì=ƒ;!‚<À\\‚æ\nbˆŠÔuˆÀ\"ãÁwˆÜäåæçR!ƒŽgèUƒdÔyˆ‚JÜé!ƒsêëÁì#ˆ‚JÜí!ƒÔyˆ‚JŠÁˆ`\")êî!ˆ‚J` W…±\"`Vƒ£Ù /Z‚¤igÌUƒ¯0‚°ÀZ*†ænƒÈ1ÀUƒÈ0 \\‚Ê1ËÁxˆnƒÖÀ‚Ø2\\hÎ=ƒãó×!ˆÙ \\-‡" [0 nil containing-sexp state case-fold-search indent-point parse-start beginning-of-defun parse-partial-sexp 3 4 " " 123 c++-backward-to-noncomment 41 58 c++-member-init-indent c-argdecl-indent 59 backward-char 1 125 forward-list -1 c++-continued-member-init-offset current-indentation c++-empty-arglist-indent 2 looking-at "\\( \\| \\)*[^/\n]" (0 44 59 125 123) c-backward-to-start-of-continued-exp c-continued-statement-offset c-continued-brace-offset colon-line-end " \n" "#\\|/\\*\\|//" "\\|case[ ]" "\\|[a-zA-Z0-9_$]*:[^:]" "\\|friend[ ]" 35 "/\\*" search-forward "*/" move "//\\|friend[ ]" ":" c-label-offset c-brace-offset c-indent-level c-brace-imaginary-offset forward-sexp] 6 (#$ . 9147)]) (defalias 'c++-backward-to-noncomment #[(lim) "À‰ ?…`Ã\fxˆ``\fÅ\\Yƒ+ŠÆuˆÇÈ!)ƒ+ÉÊ\fË#ˆ‚ÉÌÍ \f]Ë#ƒ=Î`\n\"ƒÏyˆÐÀwˆÇÑ!ƒX`\nWƒX`\fX‰‚Ò\nbˆ‚*‡" [nil stop opoint " \n \f" lim 2 -2 looking-at "\\*/" search-backward "/*" move "//" c++-point-bol c++-within-string-p 0 " " "#" t] 5]) #@55 Indent each line of the C++ grouping following point. (defalias 'indent-c++-exp #[nil "ÀC`CÀ‰‰‰‰‰‰‰‰‰‰`Á \n \f ŠÑÒ!ˆ)ŠÀ\fm?…5\f?…5\nÀ  „¡mƒVÓ‰\f„¡\n Ô`Àˆ`À‰\n%‰\n@\nAA@ƒƒ\nAA@ÁYƒƒ\nAA@Õ 8ƒÖ ˆ×\n8ƒšÒyˆ‚FÓ‰ ƒK\nÁXƒªÓ\f\f„5Ø\n8VƒÌAAS‰‚±\nU„ÖÀ\nWƒòÀBÀBT‰‚Ø@„\n\nA@†ŠÑÙ!ˆ`) ˆÒyˆÚÀwˆl„5@ƒ#@ÁY„TÀ@fÜUƒ?Š@bˆi\\)‚MÞ@…J@[! ˆ)@fÜU„e@‚§Šßà!gÜUá !ˆhâ>„’ã@!ˆ$i\\\fƒ‹%‚ŒÁ\\‚¦ ƒ¡æ !ˆç ‚¦@)ßè!ƒ·Z‚Øßé!„Ïßê!ƒØŠÑÒ!ˆßë!)ƒØÒ,\\]ßí!ƒå.\\gïUƒòZgÜUƒÿ0\\iU„gñU„`Áyˆ`|ˆjˆß2!„5ó2ŠÀˆ`)Ó#ƒ5ô ˆÁyˆ‚5.‡" [nil 0 next-depth opoint at-brace at-else last-depth last-sexp this-indent ostate state inner-loop-done outer-loop-done restart case-fold-search contain-stack indent-stack forward-sexp 1 t parse-partial-sexp 4 c++-indent-line 3 6 -1 " " val 123 c-indent-level calculate-c++-indent looking-at "else\\W" c++-backward-to-noncomment (nil 44 59 125 58 123) c-backward-to-start-of-continued-exp c-continued-statement-offset c-continued-brace-offset c-backward-to-start-of-if current-indentation "\\(public\\|private\\|protected\\):" "case[ ]" "[A-Za-z]" ":[^:]" c-label-offset "friend[ ]" c++-friend-offset 125 c-brace-offset 35 comment-start-skip re-search-forward indent-for-comment] 16 (#$ . 10903) nil]) #@98 Fill a comment contained in consecutive lines containing point. The fill lines remain a comment. (defalias 'fill-c++-comment #[nil "ŠÂyˆŠÃ\fŠÅˆ`)Æ#ˆÂ•bˆÇ ˆ)È!ƒ'ÉÊ!ˆ‚ËÊ!ˆÌÍ!ˆÎÅ!ˆÏÐ!ˆ ‰*‡" [fill-prefix save 0 re-search-forward comment-start-skip nil t set-fill-prefix looking-at previous-line 1 next-line insert-string "\n" fill-paragraph delete-char -1] 4 (#$ . 12299) nil]) #@70 Returns the value of the point at the beginning of the current line. (defalias 'c++-point-bol #[nil "ŠÀyˆ`)‡" [0] 1 (#$ . 12687)]) #@68 Returns true if number of double quotes between two points is odd. (defalias 'c++-within-string-p #[(point1 point2) " {ÃÄ\n\"ŦÆU)?‡" [point1 point2 s c++-count-char-in-string 34 2 0] 3 (#$ . 12824)]) (defalias 'c++-count-char-in-string #[(c s) "À‰ GWƒ\"\n H\fUƒÅ‚À\\ T‰‚\n*‡" [0 pos count s c 1] 4]) emacs-19.30/lisp/cpp.elc100666 12120 1 40660 5751546054 13365 0ustar rmsdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:19:50 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/cpp.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/cpp.el' was compiled for Emacs 19")) #@35 *Face used for known cpp symbols. (defvar cpp-known-face (quote invisible) (#$ . -475)) #@37 *Face used for unknown cpp cymbols. (defvar cpp-unknown-face (quote highlight) (#$ . -569)) #@168 *Indicate what background face type you prefer. Can be either light or dark for color screens, mono for monochrome screens, and none if you don't use a window system. (defvar cpp-face-type (quote light) (#$ . -668)) #@66 *Non-nil means you are allowed to modify the known conditionals. (defvar cpp-known-writable t (#$ . -890)) #@68 *Non-nil means you are allowed to modify the unknown conditionals. (defvar cpp-unknown-writable t (#$ . -1003)) #@322 Alist of cpp macros and information about how they should be displayed. Each entry is a list with the following elements: 0. The name of the macro (a string). 1. Face used for text that is `ifdef' the macro. 2. Face used for text that is `ifndef' the macro. 3. `t', `nil', or `both' depending on what text may be edited. (defvar cpp-edit-list nil (#$ . 1122)) (byte-code "ÀÁ!„ÂÁ BÄÁ!ˆÅ BÆ B‡" [boundp cpp-overlay-list nil current-load-list make-variable-buffer-local cpp-callback-data cpp-state-stack] 2) #@61 Alist of strings and names of the defined face collections. (defconst cpp-face-type-list (quote (("light color background" . light) ("dark color background" . dark) ("monochrome" . mono) ("tty" . none))) (#$ . 1640)) (byte-code "ÀÁ\nBÃÄ!„ÅÄ\nBÃÆ!„ÅÆ\nBÇÆ!ˆÈ É\nBŇ" [(("writable" . t) ("read-only")) cpp-writable-list current-load-list boundp cpp-button-event nil cpp-edit-buffer make-variable-buffer-local (("false") ("true" . t) ("both" . both)) cpp-branch-list] 2) #@57 List of faces you can choose from for cpp conditionals. (defvar cpp-face-default-list nil (#$ . 2127)) #@56 Background colours useful with dark foreground colors. (defvar cpp-face-light-name-list (quote ("light gray" "light blue" "light cyan" "light yellow" "light pink" "pale green" "beige" "orange" "magenta" "violet" "medium purple" "turquoise")) (#$ . 2236)) #@57 Background colours useful with light foreground colors. (defvar cpp-face-dark-name-list (quote ("dim gray" "blue" "cyan" "yellow" "red" "dark green" "brown" "dark orange" "dark khaki" "dark violet" "purple" "dark turquoise")) (#$ . 2497)) #@60 Alist of names and faces to be used for light backgrounds. (defvar cpp-face-light-list nil (#$ . 2742)) #@59 Alist of names and faces to be used for dark backgrounds. (defvar cpp-face-dark-list nil (#$ . 2852)) #@60 Alist of names and faces to be used for monocrome screens. (defvar cpp-face-mono-list (quote (("bold" quote bold) ("bold-italic" quote bold-italic) ("italic" quote italic) ("underline" quote underline))) (#$ . 2960)) #@75 Alist of names and faces available even if you don't use a window system. (defvar cpp-face-none-list (quote (("default" . default) ("invisible" . invisible))) (#$ . 3183)) #@62 All faces used for highligting text inside cpp conditionals. (defvar cpp-face-all-list (append cpp-face-light-list cpp-face-dark-list cpp-face-mono-list cpp-face-none-list) (#$ . 3361)) #@46 List of cpp macros used in the local buffer. (defvar cpp-parse-symbols nil (#$ . 3553)) (byte-code "ÀÁ!ˆÂÃÄQÅBÀ‡" [make-variable-buffer-local cpp-parse-symbols "'\\|\"\\|/\\*\\|//\\|" "\\(^[ ]*#[ ]*\\(ifdef\\|ifndef\\|if\\|" "elif\\|else\\|endif\\)\\b\\)" cpp-parse-regexp current-load-list] 3) #@238 Highlight C code according to preprocessor conditionals. This command pops up a buffer which you should edit to specify what kind of highlighting to use, and the criteria for highlighting. A prefix arg suppresses display of that buffer. (defalias 'cpp-highlight-buffer #[(arg) "À ˆ „\fÄ ˆÀŠebˆÆÇ!ˆÈ ÀÊ#ƒ-ÆË`eZÌ_Í ¥\"ˆÎ”Ε{‰И„?јƒKΔbˆÀÒÓˆ‚)Ô˜ƒaÕÖÀÊ#„)×Ø!ˆ‚)Ù˜ƒoÚÀwˆ‚)ÛˆÛ”`Tܔܕ{Û•`{ ᘃ›âÊ $ˆ‚(㘃¯âÀ $ˆ‚(䘃ÃâÊ $ˆ‚(嘃åÀ‰&'è \"ˆ*âÊ $ˆ‚(阃 „ôêë!ˆ @@? @A@ F,è \"ˆ, B)‚(혃$è \"ˆ‚(êî!ˆ,)‚ïð!ˆ) ƒBŠñ @8bˆêò!ˆ))3†O ?†Oô ‡" [nil cpp-parse-symbols cpp-parse-reset cpp-edit-list cpp-edit-load cpp-state-stack cpp-progress-message "Parsing..." re-search-forward cpp-parse-regexp t "Parsing...%d%%" 100 buffer-size 0 match "'" "\"" (forward-sexp) ((error (cpp-parse-error "Unterminated string or character"))) "/*" search-forward "*/" error "Unterminated comment" "//" "^\n " 1 2 expr type to from "ifdef" cpp-parse-open "ifndef" "if" "elif" cpp-unknown-face cpp-known-face cpp-parse-close "else" cpp-parse-error "Top level #else" entry "endif" "Parser error" message "Parsing...done" 3 "Unclosed conditional" arg cpp-parse-edit] 6 (#$ . 3862) "P"]) #@70 Push information about conditional-beginning onto `cpp-state-stack'. (defalias 'cpp-parse-open #[(branch expr begin end) "ÀÁ\n\"ƒ\nÉ”O\nÕÄOP‚ÀÅ\n\"ƒ#\nÉ”OÀÆ\n\"ƒ0\nÉ”OÀÇ\n\"ƒF\nÉ”O\nÕÄOP‚0\n \nF B \n\f„`\n\fB\fÍ\n\"ƒoÏ \n\"‡Ð \n\"‡" [string-match "\\b[ ]*/\\*.*\\*/[ ]*\\b" expr 0 nil "\\b[ ]*/\\*" "\\b[ ]*\\(//.*\\)?$" "[ ]+" branch begin end cpp-state-stack cpp-parse-symbols assoc cpp-edit-list cpp-make-known-overlay cpp-make-unknown-overlay] 4 (#$ . 5111)]) (defalias 'cpp-parse-close #[(from to) "À @A@\n\" @@à @8Ä @8 Aƒ’ƒ*É‚+Ã8?Ä8= GÊ  \"\f Ð \"ˆ\fB ƒ`Ó\fÍ #ˆÔ=ƒoÕ\f!ˆ‚~Ö=„~Ó\fÏ#ˆƒŠ×\f!‚ŽØ\f!,‚˜Ù \",‡" [assoc cpp-state-stack cpp-edit-list 2 3 end begin branch entry 1 make-overlay from overlay priority read-only face cpp-make-known-overlay to cpp-overlay-list overlay-put invisible cpp-make-overlay-hidden default cpp-make-overlay-read-only cpp-make-overlay-sticky cpp-make-unknown-overlay] 6]) (defalias 'cpp-parse-error #[(error) "ÀÁPÂe`\"\"‡" [error " at line %d" count-lines] 5]) #@46 Reset display of cpp conditionals to normal. (defalias 'cpp-parse-reset #[nil "…Á@!ˆA‰„‡" [cpp-overlay-list delete-overlay nil] 3 (#$ . 6214) nil]) #@48 Edit display information for cpp conditionals. (defalias 'cpp-parse-edit #[nil "„ÁÂ!ˆpÄÅ!ˆÆ ˆ È )‡" [cpp-parse-symbols cpp-highlight-buffer t buffer pop-to-buffer "*CPP Edit*" cpp-edit-mode cpp-edit-buffer cpp-edit-reset] 2 (#$ . 6377) nil]) (defalias 'cpp-make-known-overlay #[(start end) "À \n\"\fÅ=ƒÆ !ˆ‚/\fÇ=„È É\f#ˆ\n„/È ËÌ#ˆÈ ÍÎ#ˆ B‰)‡" [make-overlay start end overlay cpp-known-face invisible cpp-make-overlay-hidden default overlay-put face cpp-known-writable modification-hooks (cpp-signal-read-only) insert-in-front-hooks (cpp-signal-read-only) cpp-overlay-list] 4]) (defalias 'cpp-make-unknown-overlay #[(start end) "À \n\"\fÅ=ƒÆ !ˆ‚\fÇ=„È É\f#ˆ\n„/È ËÌ#ˆÈ ÍÎ#ˆ B‰)‡" [make-overlay start end overlay cpp-unknown-face invisible cpp-make-overlay-hidden default overlay-put face cpp-unknown-writable modification-hooks (cpp-signal-read-only) insert-in-front-hooks (cpp-signal-read-only) cpp-overlay-list] 4]) (defalias 'cpp-make-overlay-hidden #[(overlay) "À ÂÃ#ˆÀ ÄÃ#ˆÀ ÅÆ#ˆÀ ÇÈ#‡" [overlay-put overlay invisible t intangible modification-hooks (cpp-signal-read-only) insert-in-front-hooks (cpp-signal-read-only)] 4]) (defalias 'cpp-make-overlay-read-only #[(overlay) "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#‡" [overlay-put overlay modification-hooks (cpp-signal-read-only) insert-in-front-hooks (cpp-signal-read-only) insert-behind-hooks (cpp-signal-read-only)] 4]) (defalias 'cpp-make-overlay-sticky #[(overlay) "À ÂÃ#ˆÀ ÄÅ#‡" [overlay-put overlay insert-in-front-hooks (cpp-grow-overlay) insert-behind-hooks (cpp-grow-overlay)] 4]) (defalias 'cpp-signal-read-only #[(overlay after start end &optional len) "?…Á\n! W„Ä\n! V…ÆÇ!‡" [after overlay-start overlay start overlay-end end error "This text is read only"] 2]) (defalias 'cpp-grow-overlay #[(overlay after start end &optional len) "…Á\n Ä\n!^ Æ\n!]#‡" [after move-overlay overlay start overlay-start end overlay-end] 6]) (byte-code "ÀÁ!„ÂÁ B „ãÄ Å !ˆÆ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÌ#ˆÆ ÍÎ#ˆÆ ÏÎ#ˆÆ ÐÑ#ˆÆ ÒÑ#ˆÆ ÓÑ#ˆÆ ÔÕ#ˆÆ ÖÕ#ˆÆ ×Ø#ˆÆ ÙØ#ˆÆ ÚÛ#ˆÆ ÜÛ#ˆÆ ÝÞ#ˆÆ ßÞ#ˆÆ àá#ˆÆ âá#ˆÆ ãä#ˆÆ åä#ˆÆ æç#ˆÆ æç#ˆÆ èé#ˆÆ êé#ˆÆ ëì#ˆÆ íì#ˆÆ îï#ˆÆ ðï#ˆÆ ñò#ˆÆ óò#ˆÆ ôõ#ˆÆ öõ#ˆÆ ÷ø#ˆÆ ùø#ˆÀú!„ìÂ:ú Bûú!‡" [boundp cpp-edit-map nil current-load-list make-keymap suppress-keymap define-key [down-mouse-2] cpp-push-button [mouse-2] ignore " " scroll-up "" scroll-down [delete] "" cpp-edit-apply "a" "A" "r" cpp-edit-reset "R" "s" cpp-edit-save "S" "l" cpp-edit-load "L" "h" cpp-edit-home "H" "b" cpp-edit-background "B" "k" cpp-edit-known "K" "u" cpp-edit-unknown "t" cpp-edit-true "T" "f" cpp-edit-false "F" "w" cpp-edit-write "W" "X" cpp-edit-toggle-known "x" "Y" cpp-edit-toggle-unknown "y" "q" bury-buffer "Q" cpp-edit-symbols make-variable-buffer-local] 4) #@178 Major mode for editing the criteria for highlighting cpp conditionals. Click on objects to change them. You can also use the keyboard accelerators indicated like this: [K]ey. (defalias 'cpp-edit-mode #[nil "À ˆÁ ˆÂÃ!ˆÄÆÈ Ê !‡" [kill-all-local-variables buffer-disable-undo auto-save-mode -1 t buffer-read-only cpp-edit-mode major-mode "CPP Edit" mode-name use-local-map cpp-edit-map] 2 (#$ . 9105)]) #@54 Apply edited display information to original buffer. (defalias 'cpp-edit-apply #[nil "À ˆÁÂ!‡" [cpp-edit-home cpp-highlight-buffer t] 2 (#$ . 9518) nil]) #@49 Reset display information from original buffer. (defalias 'cpp-edit-reset #[nil "pÀÁ `Àqˆqˆ\n Ê ˆËcˆÌÍ!Î\"ˆÏÐѱˆÌÒÎ\"ˆÓcˆÌÔÕ\"ˆÖcˆÌ×Ø\"ˆÓcˆÌÙÚ\"ˆÛcˆÜcˆÌÝ\"@à\"ˆácˆÌâ#!äÀå$ˆæcˆÌÝ'(\"@é\"ˆêcˆÌâ+!ìÀå$ˆícˆÌÝ.(\"@ï\"ˆðñòóôõ%cˆ\nƒf\n@6÷68\"‰9A@:û98<9ƒÂý98‚Ãþ?\nA9ƒý:ƒÛ:@=ƒý<ƒé<@=ƒý?þ=ƒýA98\"8À96GBVƒ6CBOD±ˆ‚\"ðE6\"cˆÌâ:!F6åG%ˆHcˆÌâƒRÏ‚T )‚YÏ\nÐ \fÑÊ\nDÒÓD…qÖD$#+‡" [format "%s" name nil to from padding 0 make-string 32 face assoc cpp-face-all-list check (default invisible) bold add-text-properties append (mouse-face highlight) cpp-callback callback data cpp-data] 10]) (defalias 'cpp-push-button #[(event) "À ‰A@)‰@)!qˆ ‰A@)‰A@:ƒ#\nA@@‚&\nA@)Ä Å\"Ä Æ\"  ƒEÊÄ Æ\"!‚TË\fÍ\"…TÊË\fÎ\"!,‡" [window-buffer event position pos get-text-property cpp-data cpp-callback cpp-button-event fun cpp-callback-data call-interactively lookup-key global-map [down-mouse-2] [down-mouse-2]] 5 nil "@e"]) (defalias 'cpp-create-bg-face #[(color) "ÀÁ\nP!Ä !ˆÅ \n\"ˆ\n )B‡" [intern "cpp " color name make-face set-face-background] 3]) (byte-code "À ƒ \n‚\nÃ!‡" [cpp-choose-default-face window-system cpp-face-type none] 2) (defalias 'cpp-face-name #[(face) "À ƒ ‚\n \"‰ƒ\f@‚ÅÆ \")‡" [rassq face default cpp-face-all-list entry format "<%s>"] 4]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp cpp-progress-time 0 current-load-list] 2) (defalias 'cpp-progress-message #[(&rest args) "À A@‰\nU?… ÃÄ \")‡" [current-time time cpp-progress-time apply message args] 4]) (provide (quote cpp)) emacs-19.30/lisp/cust-print.elc100666 13437 1 26537 5751546057 15061 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:19:56 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/cust-print.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/cust-print.el' was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!„ÃÄMˆÀ‡" [require backquote fboundp defalias fset] 2) #@492 *Controls how many levels deep a nested data object will print. If nil, printing proceeds recursively and may lead to max-lisp-eval-depth being exceeded or an error may occur: `Apparently circular structure being printed.' Also see `print-length' and `print-circle'. If non-nil, components at levels equal to or greater than `print-level' are printed simply as `#'. The object to be printed is at level 0, and if the object is a list or vector, its top-level components are at level 1. (defvar print-level nil (#$ . -565)) #@618 *Controls the printing of recursive structures. If nil, printing proceeds recursively and may lead to `max-lisp-eval-depth' being exceeded or an error may occur: "Apparently circular structure being printed." Also see `print-length' and `print-level'. If non-nil, shared substructures anywhere in the structure are printed with `#N=' before the first occurrence (in the order of the print representation) and `#N#' in place of each subsequent occurrence, where N is a positive decimal integer. There is no way to read this representation in standard Emacs, but if you need to do so, try the cl-read.el package. (defvar print-circle nil (#$ . -1100)) #@238 *Non-nil if printing of vectors should obey print-level and print-length. For Emacs 18, setting print-level, or adding custom print list or vector handling will make this happen anyway. Emacs 19 obeys print-level, but not for vectors. (defvar custom-print-vectors nil (#$ . -1763)) #@461 An alist for custom printing of any type. Pairs are of the form (PREDICATE . PRINTER). If PREDICATE is true for an object, then PRINTER is called with the object. PRINTER should print to `standard-output' using cust-print-original-princ if the standard printer is sufficient, or cust-print-prin for complex things. The PRINTER should return the object being printed. Don't modify this variable directly. Use `add-custom-printer' and `delete-custom-printer' (defconst custom-printers nil (#$ . 2054)) #@114 Add a pair of PREDICATE and PRINTER to `custom-printers'. Any pair that has the same PREDICATE is first removed. (defalias 'add-custom-printer #[(pred printer) " B ž \"BÄ ‡" [pred printer delq custom-printers cust-print-update-custom-printers] 4 (#$ . 2564)]) #@54 Delete the custom printer associated with PREDICATE. (defalias 'delete-custom-printer #[(pred) "À \nž\n\"à ‡" [delq pred custom-printers cust-print-update-custom-printers] 3 (#$ . 2834)]) (defalias 'cust-print-use-custom-printer #[(object) "À‡" [nil] 1]) (defalias 'cust-print-update-custom-printers #[nil "ÀÁÂÃÄÅÆÇ\"É\"BE\"‡" [defalias cust-print-use-custom-printer lambda (object) cond append mapcar #[(pair) "@ÁBAÂBD‡" [pair (object) (object)] 3] custom-printers ((t nil))] 9]) (defalias 'cust-print-set-function-cell #[(symbol-pair) "À @ A@K\"‡" [defalias symbol-pair] 3]) (defalias 'cust-print-original-princ #[(object &optional stream) "À‡" [nil] 1]) (byte-code "ÀÁ!„ ÂÃÄ\"ˆÀ‡" [fboundp cust-print-original-prin1 mapcar cust-print-set-function-cell ((cust-print-original-prin1 prin1) (cust-print-original-princ princ) (cust-print-original-print print) (cust-print-original-prin1-to-string prin1-to-string) (cust-print-original-format format) (cust-print-original-message message) (cust-print-original-error error))] 3) #@170 Replace print functions with general, customizable, Lisp versions. The emacs subroutines are saved away, and you can reinstall them by running `custom-print-uninstall'. (defalias 'custom-print-install #[nil "ÀÁÂ\"ˆÃ‡" [mapcar cust-print-set-function-cell ((prin1 custom-prin1) (princ custom-princ) (print custom-print) (prin1-to-string custom-prin1-to-string) (format custom-format) (message custom-message) (error custom-error)) t] 3 (#$ . 3872) nil]) #@51 Reset print functions to their emacs subroutines. (defalias 'custom-print-uninstall #[nil "ÀÁÂ\"ˆÃ‡" [mapcar cust-print-set-function-cell ((prin1 cust-print-original-prin1) (princ cust-print-original-princ) (print cust-print-original-print) (prin1-to-string cust-print-original-prin1-to-string) (format cust-print-original-format) (message cust-print-original-message) (error cust-print-original-error)) t] 3 (#$ . 4331) nil]) (defalias (quote custom-print-funcs-installed-p) (quote custom-print-installed-p)) #@65 Return t if custom-print is currently installed, nil otherwise. (defalias 'custom-print-installed-p #[nil "ÀKÁK=‡" [custom-prin1 prin1] 2 (#$ . 4847)]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÆÁÄ\"‡" [put with-custom-print-funcs edebug-form-spec (body) with-custom-print (body) defalias] 4) #@68 Temporarily install the custom print package while executing BODY. (defalias 'with-custom-print '(macro . #[(&rest body) "ÀÁ BBÄBB‡" [unwind-protect progn (custom-print-install) body ((custom-print-uninstall))] 4 (#$ . 5128)])) #@410 Output the printed representation of OBJECT, any Lisp object. Quoting characters are printed when needed to make output that `read' can handle, whenever this is possible. Output stream is STREAM, or value of `standard-output' (which see). This is the custom-print replacement for the standard `prin1'. It uses the appropriate printer depending on the values of `print-level' and `print-circle' (which see). (defalias 'custom-prin1 #[(object &optional stream) "À \nÃ#‡" [cust-print-top-level object stream cust-print-original-prin1] 4 (#$ . 5364)]) #@285 Output the printed representation of OBJECT, any Lisp object. No quoting characters are used; no delimiters are printed around the contents of strings. Output stream is STREAM, or value of `standard-output' (which see). This is the custom-print replacement for the standard `princ'. (defalias 'custom-princ #[(object &optional stream) "À \nÃ#‡" [cust-print-top-level object stream cust-print-original-princ] 4 (#$ . 5921)]) #@264 Return a string containing the printed representation of OBJECT, any Lisp object. Quoting characters are used when needed to make output that `read' can handle, whenever this is possible. This is the custom-print replacement for the standard `prin1-to-string'. (defalias 'custom-prin1-to-string #[(object) "ÀÁ!Š\nqˆÃ ˆ)Ä \n\"ˆŠ\nqˆÆ *‡" [get-buffer-create " *custom-print-temp*" buf erase-buffer custom-prin1 object buffer-string] 3 (#$ . 6353)]) #@312 Output the printed representation of OBJECT, with newlines around it. Quoting characters are printed when needed to make output that `read' can handle, whenever this is possible. Output stream is STREAM, or value of `standard-output' (which see). This is the custom-print replacement for the standard `print'. (defalias 'custom-print #[(object &optional stream) "ÀÁ\n\"ˆÃ\f\n\"ˆÀÁ\n\"‡" [cust-print-original-princ "\n" stream custom-prin1 object] 3 (#$ . 6810)]) #@850 Format a string out of a control-string and arguments. The first argument is a control string. It, and subsequent arguments substituted into it, become the value, which is a string. It may contain %s or %d or %c to substitute successive following arguments. %s means print an argument as a string, %d means print as number in decimal, %c means print a number as a single character. The argument used by %s must be a string or a symbol; the argument used by %d, %b, %o, %x or %c must be a number. This is the custom-print replacement for the standard `format'. It calls the emacs `format' after first making strings for list, vector, or symbol args. The format specification for such args should be `%s' in any case, so a string argument will also work. The string is generated with `custom-prin1-to-string', which quotes quotable characters. (defalias 'custom-format #[(fmt &rest args) "ÀÁ\nÃÄ \"#‡" [apply cust-print-original-format fmt mapcar #[(arg) "<„Á!„9ƒÂ!‡‡" [arg vectorp custom-prin1-to-string] 2] args] 6 (#$ . 7281)]) #@495 Print a one-line message at the bottom of the screen. The first argument is a control string. It may contain %s or %d or %c to print successive following arguments. %s means print an argument as a string, %d means print as number in decimal, %c means print a number as a single character. The argument used by %s must be a string or a symbol; the argument used by %d or %c must be a number. This is the custom-print replacement for the standard `message'. See `custom-format' for the details. (defalias 'custom-message #[(fmt &rest args) "ÀÁ\nÃÄ \"#‡" [apply cust-print-original-message fmt mapcar #[(arg) "<„Á!„9ƒÂ!‡‡" [arg vectorp custom-prin1-to-string] 2] args] 6 (#$ . 8335)]) #@173 Signal an error, making error message by passing all args to `format'. This is the custom-print replacement for the standard `error'. See `custom-format' for the details. (defalias 'custom-error #[(fmt &rest args) "ÀÁÂÃ\f #C\"‡" [signal error apply custom-format fmt args] 6 (#$ . 9036)]) (byte-code "À B BÀ‡" [circle-table current-load-list cust-print-current-level] 2) (defalias 'cust-print-original-printer #[(object) "À‡" [nil] 1]) (defalias 'cust-print-low-level-prin #[(object) "À‡" [nil] 1]) (defalias 'cust-print-prin #[(object) "À‡" [nil] 1]) (defalias 'cust-print-top-level #[(object stream emacs-printer) "† \n…\fÃ\f! †ÆÉÊ \"ˆÉÌ „:„: „:ƒ> „:ƒ>Ђ?Ê\"ˆÉуLÒ‚MÌ\"ˆÑ\f!ˆ\f+‡" [stream standard-output print-circle cust-print-preprocess-circle-tree object print-level -1 cust-print-current-level circle-table defalias cust-print-original-printer emacs-printer cust-print-low-level-prin custom-printers custom-print-vectors print-length cust-print-print-object cust-print-prin cust-print-print-circular] 3]) (defalias 'cust-print-print-object #[(object) "„Á!‡Â!ƒ‡:ƒÃ!‡Ä!ƒ#Å!‡Á!‡" [object cust-print-original-printer cust-print-use-custom-printer cust-print-list vectorp cust-print-vector] 2]) (defalias 'cust-print-print-circular #[(object) " ž‰ƒ8\nA‰ÄVƒÅÆ!ˆÅ !ˆÅÆ!‚4\n [¡ˆÅÆ!ˆÅ [!ˆÅÇ!ˆÈ!)‚;È!)‡" [object circle-table tag id 0 cust-print-original-princ "#" "=" cust-print-low-level-prin] 3]) (defalias 'cust-print-list #[(list) "ÁUƒ ÂÃ!ˆ‚SÂÄ!ˆ †ÁÇ@!ˆA‰ƒ.ÂÉ!ˆSƒxÁU„x<ƒ[\nž„[Ç@!ˆA‚gÂË!ˆÇ!ˆÌSƒ3ÂÉ!ˆ‚3ƒˆÁUƒˆÂÍ!ˆÂÎ!ˆ*‡" [cust-print-current-level 0 cust-print-original-princ "#" "(" print-length length cust-print-prin list " " circle-table ". " nil "..." ")"] 3]) (defalias 'cust-print-vector #[(vector) "ÁUƒ ÂÃ!ˆ‚VSÁ\fGÂÇ!ˆƒ$ ^ WƒEÉ\fH!ˆT‰\fGWƒ$ÂÊ!ˆ‚$\fGWƒQÂË!ˆÂÌ!ˆ+\f‡" [cust-print-current-level 0 cust-print-original-princ "#" vector len i "[" print-length cust-print-prin " " "..." "]"] 4]) (defalias 'cust-print-preprocess-circle-tree #[(object) "ÀC !ˆ ‰AŸ¡ˆ ÄAƒ>A@‰Aƒ3 ¡ˆ SA‚:‰AA¡ˆ)‚* A)‡" [nil circle-table cust-print-walk-circle-tree object -1 id rest tag] 3]) (defalias 'cust-print-walk-circle-tree #[(object) "À‰ … §† 9… ÄÅ !!=‰?…$ Až‰ƒ0 Ç¡ˆ‚>\n„> CAB¡ˆ ƒFÀ‚{ :ƒUÈ @!ˆ A‚{É !…{ GÊ \f \fW…zÈ  H!ˆ T‰ ‚d*‰„À*‡" [nil tag read-equivalent-p object intern-soft symbol-name circle-table t cust-print-walk-circle-tree vectorp 0 j i] 5]) (provide (quote cust-print)) emacs-19.30/lisp/custom.elc100666 23053 1 167155 6046561254 14463 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:29:04 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/custom.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`custom.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!„\nÁÂMˆÀÃ!„ÃÄMˆÀÅ!„ÅÆMˆÀÇ!„(ÇÈMˆÀÉ!„2ÉÊMˆÀË!„<ËÌMˆÀÍ!ƒIÎÍMˆ‚MÎËMˆÎÏ!„vÀÐ!ƒ_ÑÒ!Ï!ˆÀÓ!ƒkÓÏ!„vÀÔ!ƒvÔÏÕ\"ˆÀÖ!„€Ö×MˆÀØ!„ŠÙÚMˆÀÛ!ƒ–ÜÝ!ƒšÛÞMˆÀ‡" [fboundp buffer-substring-no-properties #[(beg end) " {ÃÄ\nGÅ\n$ˆ\n)‡" [beg end string set-text-properties 0 nil] 5 "Return the text from BEG to END, without text properties, as a string."] add-to-list #[(list-var element) " J†  JBL‡" [element list-var] 3 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.\nIf you want to use `add-to-list' on a variable that is not defined\nuntil a certain package is loaded, you should put the call to `add-to-list'\ninto a hook function that will be run only after loading the package.\n`eval-after-load' provides one way to do this. In some cases\nother hooks, such as major mode hooks, can do the job."] plist-get #[(plist prop) "À\nƒ \n@ =ƒ\nA@À‰‚\n‰AALˆ‚ )‡" [nil result plist prop] 3 "Extract a value from a property list.\nPLIST is a property list, which is a list of the form\n(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value\ncorresponding to the given PROP, or nil if PROP is not\none of the properties on the list."] plist-put #[(plist prop val) "„ \nD‡‰ƒ; @ =ƒ A\n ˆÄ‰‚ AA„3 A \nD¡ˆÄ‰‚ AA‰„)‡" [plist prop val current nil] 4 "Change value in PLIST of PROP to VAL.\nPLIST is a property list, which is a list of the form\n(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.\nIf PROP is already a property on the list, its value is set to VAL,\notherwise the new PROP VAL pair is added. The new plist is returned;\nuse `(setq x (plist-put x prop val))' to be sure to use the new value.\nThe PLIST is modified by side effects."] match-string #[(num &optional string) "”… ƒ ”•O‡”•{‡" [num string] 3 "Return string of text matched by last search.\nNUM specifies which parenthesized expression in the last regexp.\n Value is nil if NUMth pair didn't match, or there were less than NUM pairs.\nZero means the entire text matched by the whole regexp or whole string.\nSTRING should be given if the last search was by `string-match' on STRING."] facep #[(x) "ÀÁ!ƒ\nÃ\n!…\nGÄU…\nÅHÆ=)„0\n9…1\nÇÈ!…,ž…1ɇ" [fboundp internal-facep x vectorp 8 0 face boundp global-face-data t] 3 "Return t if X is a face name or an internal face vector."] find-face custom-facep underline make-face intern "make-face" face-differs-from-default-p set-face-underline-p t set-text-properties #[(start end props &optional buffer) "ƒ\nÁ!…*\nƒ%\n…*Ã\f \n@\nA@%ˆ\nAA‰‚Æ\f Ç#‡" [buffer bufferp props put-text-property start end remove-text-properties nil] 7] event-closest-point event-point #[(event) "‰A@)‰A@:ƒ A@@‚ A@)‡" [event position] 2 "Return the character position of the given mouse-motion, button-press,\nor button-release event. If the event did not occur over a window, or did\nnot occur over text, then this returns nil. Otherwise, it returns an index\ninto the buffer visible in the event's window."] modify-face featurep face-lock #[(face foreground background stipple bold-p italic-p underline-p) "ÀÁˆÀÃĈÀÅƈÇÈ \"ƒ6\nƒ Ë‚!Ì !ˆƒ.Ï‚/Ð !ˆ‚V\nƒ?Ë‚@Ì ÀÑ#ˆƒOÏ‚PÐ ÀÑ#ˆÒ \"ˆt…cÔ ‡" [nil (set-face-foreground face foreground) ((error)) (set-face-background face background) ((error)) (set-face-stipple face stipple) ((error)) string-match "XEmacs" emacs-version bold-p make-face-bold make-face-unbold face italic-p make-face-italic make-face-unitalic t set-face-underline-p underline-p redraw-display] 4 "Change the display attributes for face FACE.\nFOREGROUND and BACKGROUND should be color strings or nil.\nSTIPPLE should be a stipple pattern name or nil.\nBOLD-P, ITALIC-P, and UNDERLINE-P specify whether the face should be set bold,\nin italic, and underlined, respectively. (Yes if non-nil.)\nIf called interactively, prompts for a face and face attributes." (byte-code "ÀÂÃÄ!!ÆÇ\" ÆÇÊËÆÌ \"\"\"Ï ÐÑ !!Ò $Ï ÔÑ !!Õ $Ï ×Ñ !!Ø$ÚÛ ÜQ!ÚÛ ÞQ!ÚÛ àQ!!âã äåæç…l—èP…v—éP…€—êP…†ë…Œì!…’í¯\"î##ˆÑ !!¯.\n‡" [t completion-ignore-case symbol-name read-face-name "Modify face: " face mapcar list x-colors colors apply nconc directory-files x-bitmap-file-path stipples modify-face-read-string face-foreground intern "foreground" foreground face-background "background" background face-stipple "stipple" stipple y-or-n-p "Set face " " bold " bold-p " italic " italic-p " underline " underline-p message "Face %s: %s" mapconcat identity delq nil " foreground" " background" " stipple" "bold" "italic" "underline" ", "] 13)]] 3) #@35 The symbol making text intangible (defconst intangible (byte-code "ÀÁ!ƒ\nÃV„\nÄVƒ ÅVƒƉ‡Ç‰‡" [boundp emacs-minor-version emacs-major-version 19 18 28 intangible intangible-if-it-had-been-working] 2) (#$ . 5110)) #@63 The symbol making text proeprties non-sticky in the rear end. (defconst rear-nonsticky (byte-code "ÀÁ\n\"ƒ Çć" [string-match "XEmacs" emacs-version end-open rear-nonsticky] 3) (#$ . 5340)) #@56 The symbol making text properties sticky in the front. (defconst front-sticky (byte-code "ÀÁ\n\"ƒ Çć" [string-match "XEmacs" emacs-version front-closed front-sticky] 3) (#$ . 5538)) #@48 Symbol used for highlighting text under mouse. (defconst mouse-face (byte-code "ÀÁ\n\"ƒ Çć" [string-match "XEmacs" emacs-version highlight mouse-face] 3) (#$ . 5729)) (byte-code "ÀÁ\n\"ƒ ƒÄÅÆÇÈ$ˆ‚ÉÊË\"ˆÉÌÍ\"ˆÈ‡" [string-match "XEmacs" emacs-version current-menubar add-menu-item ("Help") "Customize..." customize nil global-set-key [menu-bar help customize] ("Customize..." . customize) [menu-bar help-menu customize] ("Customize..." . customize)] 5) #@54 My hacked up function to do a blocking popup menu... (defalias 'custom-x-really-popup-menu #[(pos title menudesc) "ÀÁ‰ ƒÆ @@ @@CÇ#\nB A‰„\n\nBÉ\n!ˆÊË+‡" [0 nil menu event echo-keystrokes menudesc vector t title popup-menu popup-done (byte-code "À ! !ƒà !¢;ƒÄÅà !\"ˆ‚ !ƒ2à !Æ=„à !Ç=„È „?ÄÅÉ\"ˆ‚Ê !„Ë ˆÌÍ!ˆ‚" [next-command-event event misc-user-event-p event-object throw popup-done abort menu-no-selection-hook popup-menu-up-p nil button-release-event-p beep message "please make a choice from the menu."] 4)] 5 (#$ . 6195)]) (byte-code "ÀÁ\n\"ƒÃÄMˆÅÆMˆÇÈMˆÉÊMˆ‚*ÃËMˆÅÌMˆÇÍMˆÉÎMˆÀ‡" [string-match "XEmacs" emacs-version custom-category-create #[(name) "Á‰\"LˆÃ‡" [name make-extent nil "Create a text property category named NAME."] 4] custom-category-put #[(name property value) "À J\n #‡" [set-extent-property name property value] 4 "In CATEGORY set PROPERTY to VALUE."] custom-category-get #[(name property) "À J\n\"‡" [extent-property name property] 3 "In CATEGORY get PROPERTY."] custom-category-set #[(from to category) "À \n\"Ä J\")‡" [make-extent from to extent set-extent-parent category] 3 "Make text between FROM and TWO have category CATEGORY."] #[(name) "‰L‡" [name] 2 "Create a text property category named NAME."] #[(name property value) "À \n #‡" [put name property value] 4 "In CATEGORY set PROPERTY to VALUE."] #[(name property) " N‡" [name property] 2 "In CATEGORY get PROPERTY."] #[(from to category) "À \nà $‡" [put-text-property from to category] 5 "Make text between FROM and TWO have category CATEGORY."]] 3) #@48 Function returning the external value of NAME. (defvar custom-external (quote default-value) (#$ . 7774)) #@55 Function setting the external value of NAME to VALUE. (defvar custom-external-set (quote set-default) (#$ . 7886)) #@46 Get the external value associated with NAME. (defalias 'custom-external #[(name) " !‡" [custom-external name] 2 (#$ . 8007)]) #@55 Set the external value associated with NAME to VALUE. (defalias 'custom-external-set #[(name value) " \n\"‡" [custom-external-set name value] 3 (#$ . 8140)]) #@59 Alist of custom names and their associated editing field. (defvar custom-name-fields nil (#$ . 8305)) (make-variable-buffer-local (quote custom-name-fields)) #@28 Associate NAME with FIELD. (defalias 'custom-name-enter #[(name field) "…ÁÂ!ˆ\nB B‰‡" [name custom-assert field custom-name-fields] 2 (#$ . 8469)]) #@41 The editing field associated with NAME. (defalias 'custom-name-field #[(name) " žA‡" [name custom-name-fields] 2 (#$ . 8628)]) #@69 The value currently displayed for NAME in the customization buffer. (defalias 'custom-name-value #[(name) "À !Ã\n!Å\n!ˆÆ\fÇ\"\fÈ\f\n\"@\"*‡" [custom-name-field name field custom-field-custom custom custom-field-parse custom-property export custom-field-extract] 5 (#$ . 8762)]) #@55 Function that will save current customization buffer. (defvar custom-save (quote custom-save) (#$ . 9048)) #@46 Name of file with customization information. (defvar custom-file "~/.custom.el" (#$ . 9161)) #@68 The global customization information. A custom association list. (defconst custom-data (quote ((tag . "Emacs") (doc . "The extensible self-documenting text editor.") (type . group) (data "\n" ((header) (compact . t) (type . group) (doc . "Press [Save] to save any changes permanently after you are done editing. \nYou can load customization information from other files by editing the\n`File' field and pressing the [Load] button. When you press [Save] the\ncustomization information of all files you have loaded, plus any\nchanges you might have made manually, will be stored in the file \nspecified by the `File' field.") (data ((tag . "Load") (type . button) (query . custom-load)) ((tag . "Save") (type . button) (query . custom-save)) ((name . custom-file) (default . "~/.custom.el") (doc . "Name of file with customization information.\n") (tag . "File") (type . file))))))) (#$ . 9260)) #@175 Declare variables for customization. PATH is a list of tags leading to the place in the customization hierarchy the new entry should be added. CUSTOM is the entry to add. (defalias 'custom-declare #[(path custom) "À !ˆÂ \f\" à !†à ! C¤)‡" [custom-initialize custom custom-travel-path custom-data path current] 3 (#$ . 10165)]) (put (quote custom-declare) (quote lisp-indent-hook) 1) #@102 Alist of default properties for type symbols. The format is `((SYMBOL (PROPERTY . VALUE)... )... )'. (defconst custom-type-properties (quote ((repeat (type . default) (import . custom-repeat-import) (eval . custom-repeat-eval) (quote . custom-repeat-quote) (accept . custom-repeat-accept) (extract . custom-repeat-extract) (validate . custom-repeat-validate) (insert . custom-repeat-insert) (match . custom-repeat-match) (query . custom-repeat-query) (prefix . "") (del-tag . "[DEL]") (add-tag . "[INS]")) (pair (type . group) (accept . custom-pair-accept) (eval . custom-pair-eval) (import . custom-pair-import) (quote . custom-pair-quote) (valid lambda (c d) (consp d)) (extract . custom-pair-extract)) (list (type . group) (quote . custom-list-quote) (valid lambda (c d) (listp d)) (extract . custom-list-extract)) (group (type . default) (face-tag) (eval . custom-group-eval) (import . custom-group-import) (initialize . custom-group-initialize) (apply . custom-group-apply) (reset . custom-group-reset) (factory-reset . custom-group-factory-reset) (extract) (validate . custom-group-validate) (query . custom-toggle-hide) (accept . custom-group-accept) (insert . custom-group-insert) (find . custom-group-find)) (toggle (type . choice) (data ((type . const) (tag . "On ") (default . t)) ((type . const) (tag . "Off") (default)))) (choice (type . default) (query . custom-choice-query) (accept . custom-choice-accept) (extract . custom-choice-extract) (validate . custom-choice-validate) (insert . custom-choice-insert) (none (tag . "Unknown") (default . __uninitialized__) (type . const))) (const (type . default) (extract lambda (c f) (list (custom-default c))) (validate lambda (c f) nil) (valid . custom-const-valid) (update . custom-const-update) (insert . custom-const-insert)) (face-doc (type . doc) (doc . "You can customize the look of Emacs by deciding which faces should be\nused when. If you push one of the face buttons below, you will be\ngiven a choice between a number of standard faces. The name of the\nselected face is shown right after the face button, and it is\ndisplayed its own face so you can see how it looks. If you know of\nanother standard face not listed and want to use it, you can select\n`Other' and write the name in the editing field.\n\nIf none of the standard faces suits you, you can select `Customize' to\ncreate your own face. This will make six fields appear under the face\nbutton. The `Fg' and `Bg' fields are the foreground and background\ncolors for the face, respectively. You should type the name of the\ncolor in the field. You can use any X11 color name. A list of X11\ncolor names may be available in the file `/usr/lib/X11/rgb.txt' on\nyour system. The special color name `default' means that the face\nwill not change the color of the text. The `Stipple' field is weird,\nso just ignore it. The three remaining fields are toggles, which will\nmake the text `bold', `italic', or `underline' respectively. For some\nfonts `bold' or `italic' will not make any visible change.")) (face (type . choice) (eval . custom-face-eval) (import . custom-face-import) (data ((tag . "None") (default) (type . const)) ((tag . "Default") (default . default) (face . custom-const-face) (type . const)) ((tag . "Bold") (default . bold) (face . custom-const-face) (type . const)) ((tag . "Bold-italic") (default . bold-italic) (face . custom-const-face) (type . const)) ((tag . "Italic") (default . italic) (face . custom-const-face) (type . const)) ((tag . "Underline") (default . underline) (face . custom-const-face) (type . const)) ((tag . "Highlight") (default . highlight) (face . custom-const-face) (type . const)) ((tag . "Modeline") (default . modeline) (face . custom-const-face) (type . const)) ((tag . "Region") (default . region) (face . custom-const-face) (type . const)) ((tag . "Secondary Selection") (default . secondary-selection) (face . custom-const-face) (type . const)) ((tag . "Customized") (compact . t) (face-tag . custom-face-hack) (eval . custom-face-eval) (data ((hidden . t) (tag . "") (doc . "Select the properties you want this face to have.") (default . custom-face-lookup) (type . const)) "\n" ((tag . "Fg") (hidden . t) (default . "default") (width . 20) (type . string)) ((tag . "Bg") (default . "default") (width . 20) (type . string)) ((tag . "Stipple") (default . "default") (width . 20) (type . string)) "\n" ((tag . "Bold") (default) (type . toggle)) " " ((tag . "Italic") (default) (type . toggle)) " " ((tag . "Underline") (hidden . t) (default) (type . toggle))) (default custom-face-lookup "default" "default" "default" nil nil nil) (type . list)) ((prompt . "Other") (face . custom-field-value) (default . __uninitialized__) (type . symbol)))) (file (type . string) (directory) (default-file) (query . custom-file-query)) (sexp (type . default) (width . 40) (default __uninitialized__ . "Uninitialized") (read . custom-sexp-read) (write . custom-sexp-write)) (symbol (type . sexp) (width . 40) (valid lambda (c d) (symbolp d))) (integer (type . sexp) (width . 10) (valid lambda (c d) (integerp d))) (string (type . default) (width . 40) (valid lambda (c d) (stringp d)) (read . custom-string-read) (write . custom-string-write)) (button (type . default) (accept . ignore) (extract) (validate . ignore) (insert . custom-button-insert)) (doc (type . default) (header) (reset . ignore) (extract) (validate . ignore) (insert . custom-documentation-insert)) (default (width . 20) (valid lambda (c v) t) (insert . custom-default-insert) (update . custom-default-update) (query . custom-default-query) (tag) (prompt) (doc) (header . t) (padding . 32) (quote . custom-default-quote) (eval lambda (c v) nil) (export . custom-default-export) (import lambda (c v) (list v)) (synchronize . ignore) (initialize . custom-default-initialize) (extract . custom-default-extract) (validate . custom-default-validate) (apply . custom-default-apply) (reset . custom-default-reset) (factory-reset . custom-default-factory-reset) (accept . custom-default-accept) (match . custom-default-match) (name) (compact) (hidden) (face . custom-default-face) (data) (calculate) (default . __uninitialized__)))) (#$ . 10562)) #@92 Local type properties. Entries in this list take precedence over `custom-type-properties'. (defconst custom-local-type-properties nil (#$ . 16779)) (make-variable-buffer-local (quote custom-local-type-properties)) #@52 Special value representing an uninitialized field. (defconst custom-nil (quote __uninitialized__) (#$ . 16999)) #@46 Special value representing an invalid field. (defconst custom-invalid (quote __invalid__) (#$ . 17117)) #@40 Extract from CUSTOM property PROPERTY. (defalias 'custom-property #[(custom property) " ž\n„$à !‰ ž†\fžA žÇÁ!ˆ)‚\nA)‡" [property custom entry custom-type type custom-local-type-properties custom-type-properties custom-assert] 3 (#$ . 17227)]) #@73 Extract from CUSTOM property PROPERTY. Start with CUSTOM's superclass. (defalias 'custom-super #[(custom property) "À „# !‰ ž†\fžA žÈÃ!ˆ)‚ A)‡" [nil entry custom-type custom type custom-local-type-properties custom-type-properties property custom-assert] 3 (#$ . 17489)]) #@93 Set CUSTOM PROPERY to VALUE by side effect. CUSTOM must have at least one property already. (defalias 'custom-property-set #[(custom property value) " ž‰ƒ\n ¡‚  B AB¡)‡" [property custom entry value] 4 (#$ . 17782)]) #@29 Extract `type' from CUSTOM. (defalias 'custom-type #[(custom) "À žA‡" [type custom] 2 (#$ . 18012)]) #@29 Extract `name' from CUSTOM. (defalias 'custom-name #[(custom) "À Â\"‡" [custom-property custom name] 3 (#$ . 18119)]) #@28 Extract `tag' from CUSTOM. (defalias 'custom-tag #[(custom) "À Â\"‡" [custom-property custom tag] 3 (#$ . 18243)]) #@33 Extract `face-tag' from CUSTOM. (defalias 'custom-face-tag #[(custom) "À Â\"‡" [custom-property custom face-tag] 3 (#$ . 18364)]) #@91 Extract `prompt' from CUSTOM. If none exist, default to `tag' or, failing that, `type'. (defalias 'custom-prompt #[(custom) "À Â\"†À Ã\"†ÄÅÆ !!!‡" [custom-property custom prompt tag capitalize symbol-name custom-type] 4 (#$ . 18500)]) #@32 Extract `default' from CUSTOM. (defalias 'custom-default #[(custom) "À Â\"‰ƒÄ !‚À Å\")‡" [custom-property custom calculate value eval default] 4 (#$ . 18747)]) #@33 Extract the `data' from CUSTOM. (defalias 'custom-data #[(custom) "À Â\"‡" [custom-property custom data] 3 (#$ . 18918)]) #@28 Extract `doc' from CUSTOM. (defalias 'custom-documentation #[(custom) "À Â\"‡" [custom-property custom doc] 3 (#$ . 19046)]) #@30 Extract `width' from CUSTOM. (defalias 'custom-width #[(custom) "À Â\"‡" [custom-property custom width] 3 (#$ . 19177)]) #@32 Extract `compact' from CUSTOM. (defalias 'custom-compact #[(custom) "À Â\"‡" [custom-property custom compact] 3 (#$ . 19304)]) #@32 Extract `padding' from CUSTOM. (defalias 'custom-padding #[(custom) "À Â\"‡" [custom-property custom padding] 3 (#$ . 19437)]) #@48 Non-nil if CUSTOM may validly be set to VALUE. (defalias 'custom-valid #[(custom value) "<… @=?… Ä\" \"‡" [value custom-invalid custom-property custom valid] 3 (#$ . 19570)]) #@214 Import CUSTOM VALUE from external variable. This function change VALUE into a form that makes it easier to edit internally. What the internal form is exactly depends on CUSTOM. The internal form is returned. (defalias 'custom-import #[(custom value) " =ƒ C‡Â Ä\" \"‡" [custom-nil value custom-property custom import] 3 (#$ . 19760)]) #@57 Return non-nil if CUSTOM's VALUE needs to be evaluated. (defalias 'custom-eval #[(custom value) "À Â\" \"‡" [custom-property custom eval value] 3 (#$ . 20109)]) #@36 Quote CUSTOM's VALUE if necessary. (defalias 'custom-quote #[(custom value) "À Â\" \"‡" [custom-property custom quote value] 3 (#$ . 20277)]) #@35 Convert CUSTOM VALUE to a string. (defalias 'custom-write #[(custom value) " =ƒ‡<ƒ@ =ƒA‡Ä Æ\" \"‡" [value custom-nil "" custom-invalid custom-property custom write] 3 (#$ . 20426)]) #@48 Convert CUSTOM field content STRING into lisp. (defalias 'custom-read #[(custom string) "ÀÁ‡" [nil (byte-code "À Â\" \"‡" [custom-property custom read string] 3) ((error (cons custom-invalid string)))] 3 (#$ . 20626)]) #@621 Match CUSTOM with a list of VALUES. Return a cons-cell where the car is the sublist of VALUES matching CUSTOM, and the cdr is the remaining VALUES. A CUSTOM is actually a regular expression over the alphabet of lisp types. Most CUSTOM types are just doing a literal match, e.g. the `symbol' type matches any lisp symbol. The exceptions are: group: which corresponds to a `(' and `)' group in a regular expression. choice: which corresponds to a group of `|' in a regular expression. repeat: which corresponds to a `*' in a regular expression. optional: which corresponds to a `?', and isn't implemented yet. (defalias 'custom-match #[(custom values) " ÂD>ƒ\f ÂB‡Ã\fÅ\"\f\"‡" [values custom-nil nil custom-property custom match] 3 (#$ . 20855)]) #@54 Initialize `doc' and `default' attributes of CUSTOM. (defalias 'custom-initialize #[(custom) "À Â\" !‡" [custom-property custom initialize] 3 (#$ . 21621)]) #@38 Find child in CUSTOM with `tag' TAG. (defalias 'custom-find #[(custom tag) "À Â\" \"‡" [custom-property custom find tag] 3 (#$ . 21784)]) #@50 Find decedent of CUSTOM by looking through PATH. (defalias 'custom-travel-path #[(custom path) "„ ‡Âà @\"A\"‡" [path custom custom-travel-path custom-find] 4 (#$ . 21929)]) #@34 Extract CUSTOM's value in FIELD. (defalias 'custom-field-extract #[(custom field) ";?…Á !Ä\" \"‡" [custom custom-property custom-field-custom field extract] 3 (#$ . 22113)]) #@173 Validate CUSTOM's value in FIELD. Return nil if valid, otherwise return a cons-cell where the car is the position of the error, and the cdr is a text describing the error. (defalias 'custom-field-validate #[(custom field) ";?… ÁÂ\" \"‡" [custom custom-property validate field] 3 (#$ . 22299)]) (byte-code "ÀÁ!„ÂÁ BÄÁ!ˆÀÅ!„ÂÅ BÄÅ!‡" [boundp custom-field-last nil current-load-list make-variable-buffer-local custom-modified-list] 2) #@323 Create a field structure of type CUSTOM containing VALUE. A field structure is an array [ CUSTOM VALUE ORIGINAL START END ], where CUSTOM defines the type of the field, VALUE is the current value of the field, ORIGINAL is the original value when created, and START and END are markers to the start and end of the field. (defalias 'custom-field-create #[(custom value) "À \n ĉ%‡" [vector custom value custom-nil nil] 6 (#$ . 22750)]) #@41 Return the `custom' attribute of FIELD. (defalias 'custom-field-custom #[(field) "ÁH‡" [field 0] 2 (#$ . 23192)]) #@40 Return the `value' attribute of FIELD. (defalias 'custom-field-value #[(field) "ÁH‡" [field 1] 2 (#$ . 23313)]) #@43 Return the `original' attribute of FIELD. (defalias 'custom-field-original #[(field) "ÁH‡" [field 2] 2 (#$ . 23432)]) #@40 Return the `start' attribute of FIELD. (defalias 'custom-field-start #[(field) "ÁH‡" [field 3] 2 (#$ . 23557)]) #@38 Return the `end' attribute of FIELD. (defalias 'custom-field-end #[(field) "ÁH‡" [field 4] 2 (#$ . 23676)]) #@46 Set the `value' attribute of FIELD to VALUE. (defalias 'custom-field-value-set #[(field value) "Á\nI‡" [field 1 value] 3 (#$ . 23791)]) #@52 Set the `original' attribute of FIELD to ORIGINAL. (defalias 'custom-field-original-set #[(field original) "Á\nI‡" [field 2 original] 3 (#$ . 23934)]) #@64 Set the `start'and `end' attributes of FIELD to START and END. (defalias 'custom-field-move #[(field start end) "ÁH† Á I Ä“ˆÅH†Å IÄ“‡" [field 3 make-marker start nil 4 end] 3 (#$ . 24092)]) #@42 Query user for content of current field. (defalias 'custom-field-query #[(field) "ÀÁ\n!Ã\"\n!‡" [custom-property custom-field-custom field query] 3 (#$ . 24299)]) #@131 Store a new value into field FIELD, taking it from VALUE. If optional ORIGINAL is non-nil, concider VALUE for the original value. (defalias 'custom-field-accept #[(field value &optional original) "ÀÂÃ\f!Å\"\f#)‡" [t inhibit-point-motion-hooks custom-property custom-field-custom field accept value original] 4 (#$ . 24469)]) #@39 The face used for highlighting FIELD. (defalias 'custom-field-face #[(field) "À !‰;?…Ã\nÄ\" !Å\f!…\f))‡" [custom-field-custom field custom custom-property face custom-facep] 4 (#$ . 24805)]) #@77 Update the screen appearance of FIELD to correspond with the field's value. (defalias 'custom-field-update #[(field) "À !‰;?…Ã\nÄ\" !)‡" [custom-field-custom field custom custom-property update] 4 (#$ . 25008)]) #@50 Non-nil if CUSTOM's VALUE needs to be evaluated. (defalias 'custom-repeat-eval #[(custom value) " =?… !ÄÇÈ\"*‡" [value custom-nil custom-data custom nil found child mapcar #[(v) "À \n\"…\nɇ" [custom-eval child v t found] 3]] 3 (#$ . 25229)]) #@35 A list of CUSTOM's VALUEs quoted. (defalias 'custom-repeat-quote #[(custom value) "À !ÃÄÅÆ\"\")‡" [custom-data custom child apply append mapcar #[(v) "À \n\"‡" [custom-quote child v] 3] value] 5 (#$ . 25489)]) #@55 Modify CUSTOM's VALUE to match internal expectations. (defalias 'custom-repeat-import #[(custom value) "À !ÃÄÅÆ\"\")‡" [custom-data custom child apply append mapcar #[(v) "À \n\"‡" [custom-import child v] 3] value] 5 (#$ . 25708)]) #@59 Store a new value into field FIELD, taking it from VALUE. (defalias 'custom-repeat-accept #[(field value &optional original) "ÀÁ\n!!Á\n!Ã\n!ĉ \nƒ!Ë\n\f\"ˆ\f:ƒe\f@\fA\f ƒB @ A ‚ZbˆÍ\n!ÎÄ#Ï\n\"ˆÐ \n#ˆ‚! :…¾ @ A Ã!Ä„µÓÔ\"ÕÒ!ˆÖÔ\"×!ƒ®GØVƒ®ØH=„~ĉƒƒÙ!ˆ*‚e-‡" [copy-sequence custom-field-value field custom-field-start nil new current start all values original custom-field-original-set value custom-repeat-insert-entry custom-insert-before custom-field-value-set custom-field-accept data pos previous-single-property-change custom-data custom-assert get-text-property arrayp 1 custom-repeat-delete] 6 (#$ . 25949)]) #@67 Insert field for CUSTOM at nesting LEVEL in customization buffer. (defalias 'custom-repeat-insert #[(custom level) "À Â\"Ä Å\"Æ È ÂÂ$ ÊË!ˆ`\fÊÄ Í\"!ˆÎ Ï #ˆ\f“ˆ)Ð `#ˆÑ !ˆ ,‡" [custom-field-create custom nil field custom-property add-tag make-marker start vector data custom-text-insert "\n" pos prefix custom-tag-insert custom-repeat-add custom-field-move custom-documentation-insert] 5 (#$ . 26649)]) #@44 Insert entry at point in the REPEAT field. (defalias 'custom-repeat-insert-entry #[(repeat) "ÀÀÃÃÆ!ÉÊ\"\nÉË\" Ì  Ì Ïà $ÃÒÓ!ˆÔÕ!ˆ `ÓˆÖ×!ˆÕØÙ!Ã\"‰IˆÖ×!ˆ`Óˆ bˆÖÉÚ\"!ˆÛ\nÜ#ˆÖ×!ˆÛ Ý#ˆÕuˆ. ‡" [t inhibit-point-motion-hooks inhibit-read-only nil before-change-functions after-change-functions custom-field-custom repeat custom custom-property add-tag del-tag make-marker start end vector data field insert-before-markers "\n" backward-char 1 custom-text-insert " " custom-insert custom-data prefix custom-tag-insert custom-repeat-add custom-repeat-delete] 5 (#$ . 27071)]) #@17 Add list entry. (defalias 'custom-repeat-add #[(data) "ÁHÂHÃHÄbˆÉ!ÊËÌ! #\",‡" [data 0 1 2 nil new at field parent custom-repeat-insert-entry custom-field-value-set custom-insert-before custom-field-value] 6 (#$ . 27690)]) #@20 Delete list entry. (defalias 'custom-repeat-delete #[(data) "À‰Á‰\nÃH\nÄH \n\nËH\nÌHT|ˆÍ\nÄH!ˆÎÏ Ð!\"\".‡" [t nil data 0 1 field parent after-change-functions before-change-functions inhibit-read-only inhibit-point-motion-hooks 2 3 custom-field-untouch custom-field-value-set delq custom-field-value] 7 (#$ . 27939)]) #@27 Match CUSTOM with VALUES. (defalias 'custom-repeat-match #[(custom values) "À !Ã\n\f\"Æ @=„' @B AÃ\n\f\"‰‚ Ÿ\f+B‡" [custom-data custom child custom-match values match nil matches custom-nil] 4 (#$ . 28277)]) #@35 Extract list of childrens values. (defalias 'custom-repeat-extract #[(custom field) "À ! !ĉ=„,ƒ,É Ê@\"\"A‰„ +‡" [custom-field-value field custom-data custom nil result data values custom-nil append custom-field-extract] 6 (#$ . 28507)]) #@20 Validate children. (defalias 'custom-repeat-validate #[(custom field) "À ! !ĉ=ƒÉ !ÊBƒ3 „3Ë@\"A‰„ +‡" [custom-field-value field custom-data custom nil result data values custom-nil custom-field-start "Uninitialized list" custom-field-validate] 4 (#$ . 28774)]) #@59 Store a new value into field FIELD, taking it from VALUE. (defalias 'custom-pair-accept #[(field value &optional original) "À \n@\nAD #‡" [custom-group-accept field value original] 4 (#$ . 29067)]) #@50 Non-nil if CUSTOM's VALUE needs to be evaluated. (defalias 'custom-pair-eval #[(custom value) "À \n@\nAD\"‡" [custom-group-eval custom value] 4 (#$ . 29271)]) #@55 Modify CUSTOM's VALUE to match internal expectations. (defalias 'custom-pair-import #[(custom value) "À \n@\nAD\"@ÄÅ!ˆ @ A@)BC‡" [custom-group-import custom value result custom-assert (eq (length result) 2)] 4 (#$ . 29436)]) #@36 Quote CUSTOM's VALUE if necessary. (defalias 'custom-pair-quote #[(custom value) "À \n\"ƒà \n@\nAD\"@Å\f@\fA@E)C‡Æ \n\"‡" [custom-eval custom value custom-group-quote v cons custom-default-quote] 4 (#$ . 29668)]) #@35 Extract cons of childrens values. (defalias 'custom-pair-extract #[(custom field) "À ! !ÄÈÉ!ˆƒ/Ê Ë@@\"\"AA‰„ÈÌ!ˆ @ A@+BC‡" [custom-field-value field custom-data custom nil result data values custom-assert (eq (length values) (length data)) append custom-field-extract (null data)] 6 (#$ . 29890)]) #@36 Quote CUSTOM's VALUE if necessary. (defalias 'custom-list-quote #[(custom value) "À \n\"ƒà \n\"@Å\f)BC‡Æ \n\"‡" [custom-eval custom value custom-group-quote v list custom-default-quote] 3 (#$ . 30218)]) #@35 Extract list of childrens values. (defalias 'custom-list-extract #[(custom field) "À ! !ÄÈÉ!ˆƒ/Ê Ë@@\"\"AA‰„ÈÌ!ˆ +C‡" [custom-field-value field custom-data custom nil result data values custom-assert (eq (length values) (length data)) append custom-field-extract (null data)] 6 (#$ . 30430)]) #@20 Validate children. (defalias 'custom-group-validate #[(custom field) "À ! !ĉ=ƒÉ !ÊB‚ ËÌ!ˆƒ@ „@Í@@\"AA‰„% +‡" [custom-field-value field custom-data custom nil result data values custom-nil custom-field-start "Uninitialized list" custom-assert (eq (length values) (length data)) custom-field-validate] 4 (#$ . 30753)]) #@50 Non-nil if CUSTOM's VALUE needs to be evaluated. (defalias 'custom-group-eval #[(custom value) "ÀÂÃÄ !\"ˆ )‡" [nil found mapcar #[(c) ";†Á\n\"Ä @\"ƒÅ A‰)‡" [c custom-match value match custom-eval t found] 3] custom-data custom] 4 (#$ . 31107)]) #@43 A list of CUSTOM's VALUE members, quoted. (defalias 'custom-group-quote #[(custom value) "ÀÁÂÃÄ !\"\"C‡" [apply append mapcar #[(c) ";?…Á\n\"Ä @\" A)‡" [c custom-match value match custom-quote] 3] custom-data custom] 6 (#$ . 31370)]) #@55 Modify CUSTOM's VALUE to match internal expectations. (defalias 'custom-group-import #[(custom value) "ÀÁÂÃÄ !\"\"C‡" [apply append mapcar #[(c) ";?…Á\n\"Ä @\" A)‡" [c custom-match value match custom-import] 3] custom-data custom] 6 (#$ . 31617)]) #@51 Initialize `doc' and `default' entries in CUSTOM. (defalias 'custom-group-initialize #[(custom) "À !ƒ\n !‡ÃÄÅ !\"‡" [custom-name custom custom-default-initialize mapcar custom-initialize custom-data] 4 (#$ . 31878)]) #@39 Reset `value' in FIELD to `original'. (defalias 'custom-group-apply #[(field) "À ! !Å\f!ƒÆ !‚ÇÈ \"*‡" [custom-field-custom field custom-field-value values custom custom-name custom-default-apply mapcar custom-field-apply] 3 (#$ . 32103)]) #@39 Reset `value' in FIELD to `original'. (defalias 'custom-group-reset #[(field) "À ! !Å\f!ƒÆ !‚ÇÈ \"*‡" [custom-field-custom field custom-field-value values custom custom-name custom-default-reset mapcar custom-field-reset] 3 (#$ . 32355)]) #@38 Reset `value' in FIELD to `default'. (defalias 'custom-group-factory-reset #[(field) "À ! !Å\f!ƒÆ !‚ÇÈ \"*‡" [custom-field-custom field custom-field-value values custom custom-name custom-default-factory-reset mapcar custom-field-factory-reset] 3 (#$ . 32607)]) #@38 Find child in CUSTOM with `tag' TAG. (defalias 'custom-group-find #[(custom tag) "À ! ?…&ÅÄ!ˆÆ\f@!šƒ \f@‰‚\fA‚*‡" [custom-data custom nil result data custom-assert custom-tag tag] 3 (#$ . 32882)]) #@59 Store a new value into field FIELD, taking it from VALUE. (defalias 'custom-group-accept #[(field value &optional original) "À !à !Å !Ç\f!É\nƒ,ˉÌ\f!G\\Í \"$ˆƒ7Ð \"ˆ\n…e\n@\n\nA\nƒ7Ã\n!Ñ\f\"‰AÓ\n@#ˆ*‚7-‡" [custom-field-value field values custom-field-custom custom custom-field-start from custom-face-tag face-tag nil current put-text-property custom-tag face value original custom-field-original-set custom-match match custom-field-accept] 8 (#$ . 33098)]) #@67 Insert field for CUSTOM at nesting LEVEL in customization buffer. (defalias 'custom-group-insert #[(custom level) "À Â\"ÂÂ`Ç !É !\nË !‰\fƒ'Í\n!ˆ‚2\nƒ2Î\n \"ˆ„;Ï !ˆ„DÍÐ!ˆÑ !ƒÓ@…ZT\"\fB@;†kÕ@Å\"A‰ƒIÍ ƒ~Ö‚ˆƒ‡×‚ˆÐ!ˆ‚I)ƒ—Ï !ˆØ \fŸ\"ˆÙ `#ˆ .‡" [custom-field-create custom nil field fields hidden from custom-compact compact custom-tag tag custom-face-tag face-tag custom-text-insert custom-tag-insert custom-documentation-insert "\n" custom-data data custom-insert level custom-property "" " " custom-field-value-set custom-field-move] 5 (#$ . 33602)]) #@67 Insert field for CUSTOM at nesting LEVEL in customization buffer. (defalias 'custom-choice-insert #[(custom level) "À Â\"`ÅÆ!ˆÇ \f`#ˆÈ !ˆÉ !ˆ *‡" [custom-field-create custom nil field from custom-text-insert "lars er en nisse" custom-field-move custom-documentation-insert custom-field-reset] 4 (#$ . 34214)]) #@59 Store a new value into field FIELD, taking it from VALUE. (defalias 'custom-choice-accept #[(field value &optional original) "À ! !à !Äʼn‰ \n \f ƒ0Î \"Ð \"ˆ‚HÒ !šƒCÎ \"‚HÓÏ \"ˆÔÕ !!ˆ \n|ˆ bˆ`Ö×!ˆØÙ!ˆÚ``TÛ#ˆÜÝ\f! \"ˆÞß!ˆà\f!ʼn!\"‰#ƒ­\"„­ä#@\"„ž#A‰#‚ƒå#@Å\"\"ʼn#„†\"„Ì`!åæ\fç\"Å\"\"è!`)Äê+F#ˆ „ÙÐ\"Ò !\"ˆì\" #ˆí \"\"ˆî \n#.\n‡" [custom-field-custom field custom-field-start custom-field-end t nil from after-change-functions before-change-functions inhibit-read-only end start custom original delq custom-modified-list custom-field-original-set value custom-field-original add-to-list custom-field-untouch custom-field-value insert-before-markers " " backward-char 1 custom-category-set custom-hidden-properties custom-tag-insert custom-tag custom-text-insert ": " custom-data begin found data custom-valid custom-insert custom-property none add-text-properties rear-nonsticky face custom-field-uninitialized-face custom-field-accept custom-field-value-set custom-field-move] 8 (#$ . 34532)]) #@23 Extract childs value. (defalias 'custom-choice-extract #[(custom field) "À !ÃÄ\n!\n\")‡" [custom-field-value field value custom-field-extract custom-field-custom] 3 (#$ . 35600)]) #@24 Validate childs value. (defalias 'custom-choice-validate #[(custom field) "À ! !‰ =„Â\f!Æ Ç\"=ƒ!È !ÉB‚'ÊÂ\f!\f\"*‡" [custom-field-value field custom-field-custom custom value custom-nil custom-property none custom-field-start "Make a choice" custom-field-validate] 5 (#$ . 35787)]) #@17 Choose a child. (defalias 'custom-choice-query #[(field) "À !Àà !!Å\f!Å\n!È\n! Ê Ê\f GÍ=ƒAÎ Ï @\f=ƒ9 A@‚< @!\"‚Ï ƒ_ @  A Å ! B\fB\f‚AÐÑ!ƒ…ÐÒ!ƒ…Ñ!ƒ…ÔÕÖ\f!#@\f\"A‚Á<ƒ›×ØÖ\f!BD\"‚ÁÙÚÛR\fÊÜ$‰ƒµؘƒ¹Ô\f\"A)‰…ÎÎ Ï!\").‡" [custom-field-custom field custom custom-field-value old custom-prompt default tag custom-data data nil current alist 2 custom-field-accept custom-default fboundp button-press-event-p popup-menu last-input-event assoc custom-x-really-popup-menu reverse x-popup-menu "" completing-read " (default " "): " t choice answer] 7 (#$ . 36082)]) #@24 Prompt for a file name (defalias 'custom-file-query #[(field) "À !à !Å\f\n\"Ç\fÈ\"?…Ç\fÉ\"\nË\f!\f\nƒ4\fÍ\nÎR‚8\fÏPÑ Å\f\n\"ƒZÒÓ\n!ƒPÔ‚R\nÕ\n%‚bÒ\n#\".‡" [custom-field-value field value custom-field-custom custom custom-valid valid custom-property directory default-file default custom-tag tag " (" "): " ": " prompt custom-field-accept read-file-name file-name-absolute-p "" nil] 8 (#$ . 36713)]) #@57 Return non-nil if CUSTOM's VALUE needs to be evaluated. (defalias 'custom-face-eval #[(custom value) "9?‡" [value] 1 (#$ . 37152)]) #@55 Modify CUSTOM's VALUE to match internal expectations. (defalias 'custom-face-import #[(custom value) "À !ÃÄ\n\"ƒ/ÅÆÇ\n\"ÆÈ\n\"ÆÉ\n\"ÊÆË\n\"!ÊÆÌ\n\"!ÊÆÍ\n\"!¯‚0 )C‡" [symbol-name value name string-match "custom-face-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)" custom-face-lookup match-string 1 2 3 intern 4 5 6] 10 (#$ . 37291)]) #@88 Lookup or create a face with specified attributes. FG BG STIPPLE BOLD ITALIC UNDERLINE (defalias 'custom-face-lookup #[(fg bg stipple bold italic underline) "ÀÁ †Ä † Ä†Ä &!\nË\n!ƒ+ÌÍ!„VÍ\n!ˆÎ\n Ę?…; Ę?…C Ę?…M &ˆ\n)‡" [intern format "custom-face-%s-%s-%s-%S-%S-%S" fg "default" bg stipple bold italic underline name custom-facep fboundp make-face modify-face] 9 (#$ . 37641)]) #@67 Face that should be used for highlighting FIELD containing VALUE. (defalias 'custom-face-hack #[(field value) "À !ÃÄ\nÅ\"\n\"!È!…*‡" [custom-field-custom field custom eval custom-property export value face custom-facep] 4 (#$ . 38061)]) #@67 Insert field for CUSTOM at nesting LEVEL in customization buffer. (defalias 'custom-const-insert #[(custom level) "À \n\"Ä !`ÇÈ !!ˆÉ`Å \nËF#ˆÌ !ˆÍ `#ˆ +‡" [custom-field-create custom custom-nil field custom-field-face face from custom-text-insert custom-tag add-text-properties rear-nonsticky t custom-documentation-insert custom-field-move] 7 (#$ . 38315)]) #@23 Update face of FIELD. (defalias 'custom-const-update #[(field) "À ! !Å\f‰Æ !G\\ÇÈ !$*‡" [custom-field-start field custom-field-custom custom from put-text-property custom-tag face custom-field-face] 6 (#$ . 38689)]) #@53 Non-nil if CUSTOM can validly have the value VALUE. (defalias 'custom-const-valid #[(custom value) "À !\nš‡" [custom-default custom value] 2 (#$ . 38914)]) #@24 Face used for a FIELD. (defalias 'custom-const-face #[(field) "ÀÁ\n!!‡" [custom-default custom-field-custom field] 3 (#$ . 39076)]) #@29 Read from CUSTOM an STRING. (defalias 'custom-sexp-read #[(custom string) "À ÂŽŠÃÄ!qˆÅ ˆcˆebˆÇp!ÈÉÊË\f!!!ÍP!„+ÎÏ!ˆ+‡" [match-data match-data ((store-match-data match-data)) get-buffer-create " *Custom Scratch*" erase-buffer string read looking-at regexp-quote char-to-string custom-padding custom "*\\'" error "Junk at end of expression"] 6 (#$ . 39214)]) (autoload (quote pp-to-string) "pp") #@30 Write CUSTOM SEXP as string. (defalias 'custom-sexp-write #[(custom sexp) "À !‰GÃ\f!Xƒ\n‚!Å !ÆÇ\n\"ˆÈ\nɉ”OP)‡" [prin1-to-string sexp string custom-width custom pp-to-string string-match "[ \n]*\\'" "\n" 0] 5 (#$ . 39618)]) #@54 Read string by ignoring trailing padding characters. (defalias 'custom-string-read #[(custom string) "GÁ\n!‰ÅVƒ\fSH =ƒ\fS‰‚Å\fO*‡" [string custom-padding custom padding last 0] 4 (#$ . 39854)]) #@19 Write raw string. (defalias 'custom-string-write #[(custom string) "‡" [string] 1 (#$ . 40066)]) #@67 Insert field for CUSTOM at nesting LEVEL in customization buffer. (defalias 'custom-button-insert #[(custom level) "ÀÁ !ÄQÅ Æ\"\"ˆÇ !ˆÈ‡" [custom-tag-insert "[" custom-tag custom "]" custom-property query custom-documentation-insert nil] 5 (#$ . 40170)]) (defalias 'custom-default-export #[(custom value) "À \n\"ƒÃÄ \n\"@!‡\n‡" [custom-eval custom value eval custom-quote] 4]) #@36 Quote CUSTOM's VALUE if necessary. (defalias 'custom-default-quote #[(custom value) "À \n\"„,\n9ƒ\nƒ\nÃ=ƒ&\n<ƒ,\nƒ,\n@Ä>„,Å\nD‚-\nC‡" [custom-eval custom value t (quote function lambda) quote] 3 (#$ . 40556)]) #@51 Initialize `doc' and `default' entries in CUSTOM. (defalias 'custom-default-initialize #[(custom) "À !‰…[à !Ä !Å\nÆÇ# \n ƒ-„9Ë\nÆ #ˆ‚9ƒ9Ì É#ˆ\n =ƒPÎ\n!…ZÌ Ê\nJ#‚ZÎ\n!†Z\n\nL+)‡" [custom-name custom name custom-default custom-documentation documentation-property variable-documentation t vdoc doc default put custom-property-set custom-nil boundp] 7 (#$ . 40782)]) #@67 Insert field for CUSTOM at nesting LEVEL in customization buffer. (defalias 'custom-default-insert #[(custom level) "À \n\"à !\fƒÆ\f \"ˆÇÈ!ˆÉ !ˆÊ !ˆ *‡" [custom-field-create custom custom-nil custom-tag tag field custom-tag-insert custom-text-insert ": " custom-field-insert custom-documentation-insert] 3 (#$ . 41177)]) #@59 Store a new value into field FIELD, taking it from VALUE. (defalias 'custom-default-accept #[(field value &optional original) "ƒ Á\n \"ˆÄ\n \"ˆÅ\n!‡" [original custom-field-original-set field value custom-field-value-set custom-field-update] 3 (#$ . 41508)]) #@50 Apply any changes in FIELD since the last apply. (defalias 'custom-default-apply #[(field) "À !Ã\n!‰„ÅÆ!ˆÇ\fÈ\f!\"ˆÉ !*‡" [custom-field-custom field custom custom-name name error "This field cannot be applied alone" custom-external-set custom-name-value custom-field-reset] 5 (#$ . 41775)]) #@47 Reset content of editing FIELD to `original'. (defalias 'custom-default-reset #[(field) "À  !Ã#‡" [custom-field-accept field custom-field-original t] 4 (#$ . 42076)]) #@46 Reset content of editing FIELD to `default'. (defalias 'custom-default-factory-reset #[(field) "À !Ã\nÄ\n!\"@‰=†Ç È#*‡" [custom-field-custom field custom custom-import custom-default default custom-nil custom-field-accept nil] 5 (#$ . 42250)]) #@20 Prompt for a FIELD (defalias 'custom-default-query #[(field) "À !à !Å\n\f\"Ç\n!ÈP Ê Ë\nÌ\n\f\"ƒ+Í ÎB\"‚/Í !\"\",‡" [custom-field-custom field custom custom-field-value value custom-write initial custom-prompt ": " prompt custom-field-accept custom-read custom-valid read-string 1] 8 (#$ . 42507)]) #@27 Match CUSTOM with VALUES. (defalias 'custom-default-match #[(custom values) "‡" [values] 1 (#$ . 42822)]) #@36 Extract CUSTOM's content in FIELD. (defalias 'custom-default-extract #[(custom field) "À !C‡" [custom-field-value field] 2 (#$ . 42935)]) #@17 Validate FIELD. (defalias 'custom-default-validate #[(custom field) "À ! !‰ =ƒ ÆB‚6\f:ƒ'\f@=ƒ' ÈB‚6É\n\f\"ƒ3Ë‚6 ÌB*‡" [custom-field-value field custom-field-start start value custom-nil "Uninitialized field" custom-invalid "Unparseable field content" custom-valid custom nil "Wrong type of field content"] 4 (#$ . 43079)]) #@24 Face used for a FIELD. (defalias 'custom-default-face #[(field) "À !‰ =ƒ\f‚+ÅÆ !\n\"„‚+È !\nš„) ‚+\n)‡" [custom-field-value field value custom-nil custom-field-uninitialized-face custom-valid custom-field-custom custom-field-invalid-face custom-field-original custom-field-modified-face custom-field-face] 4 (#$ . 43422)]) #@30 Update the content of FIELD. (defalias 'custom-default-update #[(field) "ÀÁ‰Â !Ä !` \nË !Ì !šƒ)Í \"‚6 >„6 BbˆÏÐ!ˆS|ˆbˆÑ !ˆbˆÒÓ!ˆ bˆ X…i X…iÔ !.‡" [t nil custom-field-start field custom-field-end pos end start after-change-functions before-change-functions inhibit-point-motion-hooks custom-field-value custom-field-original delq custom-modified-list insert-before-markers " " custom-field-insert delete-char 1 custom-field-enter] 6 (#$ . 43764)]) #@107 Customize GNU Emacs. Create a *Customize* buffer with editable customization information about GNU Emacs. (defalias 'customize #[nil "ÀÁ!ˆÂ ‡" [custom-buffer-create "*Customize*" custom-reset-all] 2 (#$ . 44257) nil]) #@410 Create a customization buffer named NAME. If the optional argument CUSTOM is non-nil, use that as the custom declaration. If the optional argument TYPES is non-nil, use that as the local types. If the optional argument SET is non-nil, use that to set external data. If the optional argument GET is non-nil, use that to get external data. If the optional argument SAVE is non-nil, use that for saving changes. (defalias 'custom-buffer-create #[(name &optional custom types set get save) "À !ˆÂp!ˆÃ ˆ\fƒÇÈ!ˆ ƒ'ÇÊ!ˆ \n ƒ4ÇÌ!ˆ \f ƒAÇÎ!ˆ ÏЉÔ ˆÕcˆebˆÖ×!ˆØÕ!ˆÙÚ!ˆÙÛ!ˆÙÜ!ˆÙÝ!ˆÙÞ!ˆÙß!ˆÙà!ˆÙá!ˆØâ!ˆÖÕ!ˆãä\"ˆeb+‡" [switch-to-buffer name buffer-disable-undo custom-mode types custom-local-type-properties custom make-local-variable custom-data set custom-external-set get custom-external save custom-save t nil after-change-functions before-change-functions inhibit-point-motion-hooks erase-buffer "\n" custom-text-insert "This is a customization buffer.\n" custom-help-insert custom-help-button custom-forward-field custom-backward-field custom-enter-value custom-field-factory-reset custom-field-reset custom-field-apply custom-save-and-exit custom-toggle-documentation "\nClick mouse-2 on any button to activate it.\n" custom-insert 0] 3 (#$ . 44482)]) #@68 Insert custom declaration CUSTOM in current buffer at level LEVEL. (defalias 'custom-insert #[(custom level) ";ƒ Á!ˆÂ‡ ƒÄÅ\"„ ƒ, ÆVƒ,ÁÇÈ É\"ÊQ!ˆÄË\" \"\fÍÎ!\f\"ˆ\f)‡" [custom custom-text-insert nil level custom-property header 0 "\n" make-string 42 " " insert field custom-name-enter custom-name] 5 (#$ . 45763)]) #@32 Insert TEXT in current buffer. (defalias 'custom-text-insert #[(text) "c‡" [text] 1 (#$ . 46101)]) #@41 Insert TAG for FIELD in current buffer. (defalias 'custom-tag-insert #[(tag field &optional data) "` cˆÂ`Ã#ˆÄ`Å$ˆ… È`ÉD#)‡" [from tag custom-category-set custom-button-properties put-text-property custom-tag field data add-text-properties custom-data] 5 (#$ . 46207)]) #@53 Insert documentation from CUSTOM in current buffer. (defalias 'custom-documentation-insert #[(custom &rest ignore) "À !‰…\fÃÄ\n\")‡" [custom-documentation custom doc custom-help-insert "\n"] 4 (#$ . 46493)]) #@36 Insert ARGS as documentation text. (defalias 'custom-help-insert #[(&rest args) "`Á \"ˆÄ`Å#)‡" [from apply insert args custom-category-set custom-documentation-properties] 4 (#$ . 46709)]) #@34 Describe how to execute COMMAND. (defalias 'custom-help-button #[(command) "`ÁÂÃ\fÅÆ#!DZˆÈ`É\n \fÍÆÎ\f¯#ˆÏ`Ð#ˆ)ÑÒÓÔ\f!!Õ#‡" [from "`" key-description where-is-internal command nil t "'" set-text-properties face custom-button-face mouse-face custom-mouse-face custom-jump custom-tag custom-category-set custom-documentation-properties custom-help-insert ": " custom-first-line documentation "\n"] 11 (#$ . 46907)]) #@25 Keymap for Custum Mode. (defvar custom-mode-map nil (#$ . 47335)) (byte-code "„`Á ÂÃÄ \"ƒÆ‚ÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆÁ‡" [custom-mode-map make-sparse-keymap define-key string-match "XEmacs" emacs-version [button2] [mouse-2] custom-push-button " " custom-forward-field "‰" custom-backward-field " " custom-enter-value " " custom-kill-line "" custom-field-reset "’" custom-reset-all "" custom-field-factory-reset "š" custom-factory-reset-all "" custom-field-apply "" custom-apply-all "" custom-save-and-exit "" custom-toggle-documentation] 5) #@58 Major mode for doing customizations. \{custom-mode-map} (defalias 'custom-mode #[nil "À ˆÁÃÅ!ˆÇÈ!ˆÉÇÊ!ˆË\nÌÍ!„%ÎÏÐ\"‡ÍÏ!ˆÎÏÑÒÓ$‡" [kill-all-local-variables custom-mode major-mode "Custom" mode-name use-local-map custom-mode-map make-local-variable before-change-functions (custom-before-change) after-change-functions (custom-after-change) fboundp make-local-hook add-hook post-command-hook #[nil "Á=… ‡" [major-mode custom-mode custom-post-command] 2] custom-post-command nil t] 5 (#$ . 47954)]) #@90 Move point to the next field or button. With optional ARG, move across that many fields. (defalias 'custom-forward-field #[(arg) "ÁVƒ?Â`Ã\"ƒÄ`Ã\"‚`Ä Ã\"†!ÄeÃ\"‰ƒ, bˆ‚0ÆÇ!ˆ)Â`È\"„S‰‚ÁW…„Â`SÃ\"ƒTÉ`Ã\"‚U`\nÉ\nÃ\"†cÉdÃ\"‰\nƒp\nbˆ‚tÆÇ!ˆ)Â`SÈ\"„?T‰‚@‡" [arg 0 get-text-property custom-tag next-single-property-change next error "No customization fields in this buffer." custom-jump previous-single-property-change previous] 4 (#$ . 48470) "p"]) #@94 Move point to the previous field or button. With optional ARG, move across that many fields. (defalias 'custom-backward-field #[(arg) "À [!‡" [custom-forward-field arg] 2 (#$ . 48947) "p"]) #@116 Toggle display of documentation text. If the optional argument is non-nil, show text iff the argument is positive. (defalias 'custom-toggle-documentation #[(&optional arg) "„\fÁÂÃ\"?†Ä!ÅXÇÂÃ#ˆÇÂ#ˆ)É ‡" [arg custom-category-get custom-documentation-properties invisible prefix-numeric-value 0 hide custom-category-put intangible redraw-display] 4 (#$ . 49144) "P"]) #@61 Enter value for current customization field or push button. (defalias 'custom-enter-value #[(field data) "ƒ !‡ Â=ƒÃÄ!‡ 9ƒ!Å !ƒ!Æ !‡ ƒ)Ç !‡ÈÉ!‡" [data field custom-enter-value error "Don't be silly" fboundp call-interactively custom-field-query message "Nothing to enter here"] 2 (#$ . 49528) (list (get-text-property (point) (quote custom-tag)) (get-text-property (point) (quote custom-data)))]) #@58 Kill to end of field or end of line, whichever is first. (defalias 'custom-kill-line #[nil "À`Á\"ŠÂÃ!)Ä`Á\"‰ƒ$ Vƒ$È` \"‚'ÉÊ!+‡" [get-text-property custom-field search-forward "\n" next-single-property-change next newline field kill-region call-interactively kill-line] 6 (#$ . 49939) nil]) #@38 Activate button below mouse pointer. (defalias 'custom-push-button #[(event) "À !Ã\nÄ\"Ã\nÆ\"Ã\nÈ\"‰ ƒ! !‚U9ƒ5Ê!ƒ5Ë!‚U ƒDËÌ Î \"!‚UƒRÏ \"‚UÐÑ!,‡" [event-point event pos get-text-property custom-field field custom-tag tag custom-data data fboundp call-interactively lookup-key global-map this-command-keys custom-enter-value error "Nothing to click on here."] 5 (#$ . 50245) "@e"]) #@54 Undo any changes since the last apply in all fields. (defalias 'custom-reset-all #[nil "Á‰\f…\f@‰A\fAÅ\n!ˆ‚+‡" [custom-name-fields nil field current all custom-field-reset] 4 (#$ . 50661) (byte-code "…ÁÂ!?…ÃÄ!‡" [custom-modified-list y-or-n-p "Discard all changes? " error "Reset aborted"] 2)]) #@49 Undo any changes in FIELD since the last apply. (defalias 'custom-field-reset #[(field) "À !…; !Ä !Š ƒÆ Ç È !\"@\"ˆÉ Ê !\"„-ËÌ!‚:Í Î\" !ˆÍ Ï\" !+‡" [arrayp field custom-field-custom custom custom-name name custom-field-original-set custom-import custom-external custom-valid custom-field-original error "This field cannot be reset alone" custom-property reset synchronize] 6 (#$ . 50978) (list (or (get-text-property (point) (quote custom-field)) (get-text-property (point) (quote custom-tag))))]) #@42 Reset all field to their default values. (defalias 'custom-factory-reset-all #[nil "Á … @A AÄ\n!ˆ‚*‡" [custom-name-fields nil field all custom-field-factory-reset] 2 (#$ . 51490) (byte-code "…ÁÂ!?…ÃÄ!‡" [custom-modified-list y-or-n-p "Discard all changes? " error "Reset aborted"] 2)]) #@35 Reset FIELD to its default value. (defalias 'custom-field-factory-reset #[(field) "À !…ŠÂà !Ä\" !)‡" [arrayp field custom-property custom-field-custom factory-reset] 3 (#$ . 51796) (list (or (get-text-property (point) (quote custom-field)) (get-text-property (point) (quote custom-tag))))]) #@55 Apply any changes since the last reset in all fields. (defalias 'custom-apply-all #[nil "À !ˆ\nà ƒ. @A AÆÇ\f!\f\"‰ƒ*@bˆÈA!ˆ)‚*\nà …E @A AÉ\f!ˆ‚3*‡" [custom-field-parse custom-field-last custom-name-fields nil field all custom-field-validate custom-field-custom error custom-field-apply] 4 (#$ . 52095) (byte-code "?…ÁÂ!‡" [custom-modified-list error "No changes to apply."] 2)]) #@50 Apply any changes in FIELD since the last apply. (defalias 'custom-field-apply #[(field) "À !ˆÂ !…%Ä !Æ \"‰ƒÇA!ˆÈ É\" !*‡" [custom-field-parse custom-field-last arrayp field custom-field-custom custom custom-field-validate error custom-property apply] 4 (#$ . 52503) (list (or (get-text-property (point) (quote custom-field)) (get-text-property (point) (quote custom-tag))))]) #@21 Hide or show entry. (defalias 'custom-toggle-hide #[(&rest ignore) "ÀÁ!‡" [error "This button is not yet implemented"] 2 (#$ . 52895) nil]) #@37 Save and exit customization buffer. (defalias 'custom-save-and-exit #[nil "Š ˆ)Áp!‡" [custom-save kill-buffer] 2 (#$ . 53041) "@"]) #@33 Save customization information. (defalias 'custom-save #[nil "À ˆ Ã\f!qˆebˆŠÅÆlj@É=„ ÊË\f\"ˆ\nƒx\n@A\fÍ\f!Ï\f!ÑÒ!\"@\n@@\nAÕÖ!ˆšƒb×A\"¡ˆ‚tØAÙ\"@#¡ˆ-‚ Ú ˆÛ\fܱˆAƒ°Ý@p\"ˆAÞcˆß@p\"ˆA‰ƒ†àcˆ‚†ácˆâ ˆãp!+‡" [custom-apply-all custom-name-fields new find-file-noselect custom-file nil (byte-code "Àp!‡" [read] 2) ((end-of-file (byte-code "ÀÁÂ\"‡" [append (setq custom-dummy (quote custom-dummy)) nil] 3))) old setq error "Invalid customization file: %s" field custom-field-custom custom custom-field-original value custom-import custom-default default name custom-assert (eq name (custom-name custom)) custom-plist-delq plist-put custom-quote erase-buffer ";; " " --- Automatically generated customization information.\n;; \n;; Feel free to edit by hand, but the entire content should consist of\n;; a single setq. Any other lisp expressions will confuse the\n;; automatic configuration engine.\n\n(setq " prin1 " " pp "\n " ")\n" save-buffer kill-buffer] 8 (#$ . 53180) nil]) #@33 Save customization information. (defalias 'custom-load #[nil "ÀÁÂ!!ˆÃ ‡" [load-file custom-name-value custom-file custom-reset-all] 3 (#$ . 54227) (byte-code "…ÁÂ!Cš?…ÃÄ!?…ÅÆ!‡" [custom-modified-list custom-name-field custom-file y-or-n-p "Discard all changes? " error "Load aborted"] 2)]) (defalias 'custom-field-untouch #[(field) "À \n\"à !….Ä !ÆÇ !!?†-à !ƒ$È !‚- <…-ÉÈ \")‡" [delq field custom-modified-list arrayp custom-field-value value custom-data custom-field-custom custom-field-untouch mapcar] 3]) (defalias 'custom-field-insert #[(field) "`À ! !Æ\f \"cˆÇÈ\f!É\f!` ZZ\"ˆÊ `#ˆË `Ì Í ÎÏ !ѯ#+‡" [custom-field-custom field custom-field-value value custom from custom-write insert-char custom-padding custom-width custom-field-move set-text-properties custom-field custom-tag face custom-field-face front-sticky t] 11]) (defalias 'custom-field-read #[(field) "ÀÁ\n!ÃÄ\n!Å\n!\"\"‡" [custom-read custom-field-custom field buffer-substring-no-properties custom-field-start custom-field-end] 6]) (defalias 'custom-field-leave #[(field) "À‰ÃÄ !Æ !ÇÈ !$*‡" [nil after-change-functions before-change-functions put-text-property custom-field-start field custom-field-end face custom-field-face] 6]) (defalias 'custom-field-enter #[(field) "À !à !Å !Ç!É\nÉ \fÍ=„H\f\nWƒ<Sf=ƒ<S‚#`WƒGbˆ)Ï\n\fÐ$.‡" [custom-field-start field start custom-field-end end custom-field-custom custom custom-padding padding nil before-change-functions after-change-functions this-command self-insert-command pos put-text-property face custom-field-active-face] 5]) (defalias 'custom-field-resize #[(field) "À !à !Å !`È\n! Ê\n! \fZ‰\f WƒRbˆÍÎ!ƒ@ÎÏ \fZ \"!ˆ‚LÐÏ \fZ \"!ˆb‚”\f V…”\f \\WƒqXƒq‚u\f \\bˆ`Wƒh UƒÒÓ!ˆ‚{b).‡" [custom-field-custom field custom custom-field-start begin custom-field-end end pos custom-padding padding custom-width width size fboundp insert-before-markers-and-inherit make-string insert-before-markers start backward-delete-char 1] 5]) (byte-code "ÀÁ!„ÂÁ BÄÁ!‡" [boundp custom-field-changed nil current-load-list make-variable-buffer-local] 2) (defalias 'custom-field-parse #[(field) " >… \"ÃÄ!\"ˆÅ!‡" [field custom-field-changed delq custom-field-value-set custom-field-read custom-field-update] 4]) (defalias 'custom-post-command #[nil "ÀÁ!ˆÂ`!‰\f=ƒ >ƒ1Æ !ˆ‚1Ç\f!ˆ\fƒ'È\f!ˆ ƒ/É !ˆ Ê †8 !)‡" [custom-assert (eq major-mode (quote custom-mode)) custom-field-property field custom-field-last custom-field-changed custom-field-resize custom-field-parse custom-field-leave custom-field-enter set-buffer-modified-p custom-modified-list] 3]) (byte-code "ÀÁ!„ÂÁ BÄÁ!‡" [boundp custom-field-was nil current-load-list make-variable-buffer-local] 2) (defalias 'custom-before-change #[(begin end) "Á=„\nÂÃ!‡Ä !Ä!‰ƒ„$ÉÊ!‚7=„2ÉË!‚7‰\f*‡" [major-mode custom-mode message "Aargh! Why is custom-before-change called here?" custom-field-property begin end to from error "You can only modify the fields" "Changes must be limited to a single field." custom-field-was] 4]) (defalias 'custom-after-change #[(begin end length) "Á=„\nÂÃ!‡\fÆÇ!ˆÈ \nË $ˆÌ ! =ƒ>Í !\nVƒ6\nÏ“ˆÐÑ \")‚UÆÒ!ˆŠ bˆÓ ÔÕ !Ö\"\"ˆ× !))‡" [major-mode custom-mode message "Aargh! Why is custom-after-change called here?" custom-field-was field custom-assert (prog1 field (setq custom-field-was nil)) put-text-property begin end custom-field custom-field-property custom-field-end field-end nil add-to-list custom-field-changed (eq begin end) custom-field-value-set custom-read custom-field-custom "" custom-field-insert] 5]) (defalias 'custom-field-property #[(pos) "À Â\"† e=?…À SÂ\"‡" [get-text-property pos custom-field] 3]) #@53 Assert that EXPR evaluates to non-nil at this point (defalias 'custom-assert #[(expr) "À !†\nÂà \"‡" [eval expr error "Assertion failed: %S"] 3 (#$ . 57989)]) #@53 Return the part of STRING before the first newline. (defalias 'custom-first-line #[(string) "À G‰\nWƒ HÄ=„ T‰‚ \n=ƒ$ ‚( À O*‡" [0 string len pos 10] 4 (#$ . 58155)]) #@42 In LIST insert before OLD a NEW element. (defalias 'custom-insert-before #[(list old new) "„ C‡\n„ C¤‡\n@=ƒ B‡\nA@=„/AÃÄ!ˆ‚ AB¡ˆ)‡" [list new old custom-assert (cdr list)] 3 (#$ . 58339)]) #@29 Remove padding from STRING. (defalias 'custom-strip-padding #[(string padding) "ÀÁ\n!!ÃPÅ\f\"ƒ\"lj”OÇ•ÈOP‚)‡" [regexp-quote char-to-string padding "+" regexp string-match string 0 nil] 4 (#$ . 58555)]) #@74 Return non-nil if PROP is a property of PLIST. Comparison done with EQ. (defalias 'custom-plist-memq #[(prop plist) "À\nƒ\n@ =ƒ\nÀ‰‚\nAA‰„ )‡" [nil result plist prop] 3 (#$ . 58777)]) #@48 Delete property PROP from property list PLIST. (defalias 'custom-plist-delq #[(prop plist) "@ =ƒAA‰‚‰AA\nƒ6\n@ =ƒ,\nAA A\n¡ˆ‚\n\nAA‰„*‡" [plist prop next list] 3 (#$ . 58980)]) (byte-code "ÀÁÂ\"ˆÃÄ!ˆÅÄÇ#ˆÃÈ!ˆÅÈÉ\n#ˆÅÈ \f#ˆÅÈÇ#ˆÃÍ!ˆÅÍÎÏÐ\"?#ˆÅÍÇ#ˆÓ!ƒLÕ!ˆÖ×!‡" [custom-declare nil ((tag . "Meta Customization") (doc . "Customization of the customization support.") (type . group) (data ((type . face-doc)) ((tag . "Button Face") (default . bold) (doc . "Face used for tags in customization buffers.") (name . custom-button-face) (synchronize lambda (f) (custom-category-put (quote custom-button-properties) (quote face) custom-button-face)) (type . face)) ((tag . "Mouse Face") (default . highlight) (doc . "Face used when mouse is above a button in customization buffers.") (name . custom-mouse-face) (synchronize lambda (f) (custom-category-put (quote custom-button-properties) mouse-face custom-mouse-face)) (type . face)) ((tag . "Field Face") (default . italic) (doc . "Face used for customization fields.") (name . custom-field-face) (type . face)) ((tag . "Uninitialized Face") (default . modeline) (doc . "Face used for uninitialized customization fields.") (name . custom-field-uninitialized-face) (type . face)) ((tag . "Invalid Face") (default . highlight) (doc . "Face used for customization fields containing invalid data.") (name . custom-field-invalid-face) (type . face)) ((tag . "Modified Face") (default . bold-italic) (doc . "Face used for modified customization fields.") (name . custom-field-modified-face) (type . face)) ((tag . "Active Face") (default . underline) (doc . "Face used for customization fields while they are being edited.") (name . custom-field-active-face) (type . face)))) custom-category-create custom-documentation-properties custom-category-put rear-nonsticky t custom-button-properties face custom-button-face mouse-face custom-mouse-face custom-hidden-properties invisible string-match "XEmacs" emacs-version intangible file-readable-p custom-file load-file provide custom] 6) emacs-19.30/lisp/dabbrev.elc100666 13437 1 34566 6051034146 14340 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 00:44:54 1995 ;;; from file /home/fsf/rms/e19/lisp/dabbrev.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`dabbrev.el' was compiled for Emacs 19.29 or later")) #@53 *If non-nil, `dabbrev-expand' only looks backwards. (defvar dabbrev-backward-only nil (#$ . -474)) #@70 *Limits region searched by `dabbrev-expand' to this many chars away. (defvar dabbrev-limit nil (#$ . -579)) #@263 *Regexp for skipping leading characters of an abbreviation. Example: Set this to "\\$" for programming languages in which variable names may appear with or without a leading `$'. (For example, in Makefiles.) Set this to nil if no characters should be skipped. (defvar dabbrev-abbrev-skip-leading-regexp nil (#$ . -694)) #@313 *Non-nil if dabbrev searches should ignore case. A value of nil means case is significant. The value of this variable is an expression; it is evaluated and the resulting value determines the decision. For example: setting this to `case-fold-search' means evaluate that variable to see whether its value is nil. (defvar dabbrev-case-fold-search (quote case-fold-search) (#$ . -1023)) #@225 *The significance of an uppercase character in an abbreviation. nil means case fold search, non-nil means case sensitive search. This variable has an effect only when the value of `dabbrev-case-fold-search' evaluates to t. (defvar dabbrev-upcase-means-case-search nil (#$ . -1414)) #@536 *Non-nil means dabbrev should preserve case when expanding the abbreviation. More precisely, it preserves the case pattern of the abbreviation as you typed it--as opposed to the case pattern of the expansion that is copied. The value of this variable is an expression; it is evaluated and the resulting value determines the decision. For example, setting this to `case-replace' means evaluate that variable to see if its value is t or nil. This variable has an effect only when the value of `dabbrev-case-fold-search' evaluates to t. (defvar dabbrev-case-replace (quote case-replace) (#$ . -1704)) #@1012 *Regexp to recognize a character in an abbreviation or expansion. This regexp will be surrounded with \\( ... \\) when actually used. Set this variable to "\\sw" if you want ordinary words or "\\sw\\|\\s_" if you want symbols (including characters whose syntax is "symbol" as well as those whose syntax is "word". The value nil has a special meaning: the abbreviation is from point to previous word-start, but the search is for symbols. For instance, if you are programming in Lisp, `yes-or-no-p' is a symbol, while `yes', `or', `no' and `p' are considered words. If this variable is nil, then expanding `yes-or-no-' looks for a symbol starting with or containing `no-'. If you set this variable to "\\sw\\|\\s_", that expansion looks for a symbol starting with `yes-or-no-'. Finally, if you set this variable to "\\sw", then expanding `yes-or-no-' signals an error because `-' is not part of a word; but expanding `yes-or-no' looks for a word starting with `no'. The recommended value is "\\sw\\|\\s_". (defvar dabbrev-abbrev-char-regexp nil (#$ . -2311)) #@324 *Non-nil means dabbrev package should search *all* buffers. Dabbrev always searches the current buffer first. Then, if `dabbrev-check-other-buffers' says so, it searches the buffers designated by `dabbrev-select-buffers-function'. Then, if `dabbrev-check-all-buffers' is non-nil, dabbrev searches all the other buffers. (defvar dabbrev-check-all-buffers t (#$ . -3382)) #@338 *Should \[dabbrev-expand] look in other buffers? nil: Don't look in other buffers. t: Also look for expansions in the buffers pointed out by `dabbrev-select-buffers-function'. Anything else: When we can't find any more expansions in the current buffer, then ask the user whether to look in other buffers too. The default value is t. (defvar dabbrev-check-other-buffers t (#$ . -3762)) #@279 A function that selects buffers that should be searched by dabbrev. The function should take no arguments and return a list of buffers to search for expansions. Have a look at `dabbrev--select-buffers' for an example. A mode setting this variable should make it buffer local. (defvar dabbrev-select-buffers-function (quote dabbrev--select-buffers) (#$ . 4158)) #@493 *A function to decide whether dabbrev should search OTHER-BUFFER. The function should take one argument, OTHER-BUFFER, and return non-nil if that buffer should be searched. Have a look at `dabbrev--same-major-mode-p' for an example. The value of `dabbrev-friend-buffer-function' has an effect only if the value of `dabbrev-select-buffers-function' uses it. The function `dabbrev--select-buffers' is one function you can use here. A mode setting this variable should make it buffer local. (defvar dabbrev-friend-buffer-function (quote dabbrev--same-major-mode-p) (#$ . -4528)) #@210 If non-nil, a list of buffers which dabbrev should search. If this variable is non-nil, dabbrev will only look in these buffers. It will not even look in the current buffer if it is not a member of this list. (defvar dabbrev-search-these-buffers-only nil (#$ . 5115)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÈÇ BÀÉ!„GÂ É BÀÊ!„TÂ\nÊ BÀË!„aÂ Ë BÀÌ!„nÂ\fÌ BÀÍ!„{Â Í BÀÎ!„ˆÂÎ BÀÏ!„–Ï BÀÑ!„£ÂÑ B‡" [boundp dabbrev--last-obarray nil current-load-list dabbrev--last-table dabbrev--last-abbreviation dabbrev--last-abbrev-location dabbrev--last-direction 0 dabbrev--last-expansion dabbrev--last-expansion-location dabbrev--friend-buffer-list dabbrev--last-buffer dabbrev--last-buffer-found dabbrev--last-completion-buffer dabbrev--check-other-buffers dabbrev-check-other-buffers dabbrev--abbrev-char-regexp] 2) (defalias 'dabbrev--minibuffer-origin #[nil "À A@‡" [buffer-list] 1]) (put (quote dabbrev--minibuffer-origin) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'dabbrev-filter-elements '(macro . #[(element list condition) "ÀÁ EÄ EÆÂÄ ÇBBÈ ÄÁÊ ËBBEEÌBBBBÍBBBB‡" [let dabbrev-result dabbrev-tail element setq list while ((car dabbrev-tail)) if condition cons (dabbrev-result) ((setq dabbrev-tail (cdr dabbrev-tail))) ((nreverse dabbrev-result))] 13])) (byte-code "À ÂÃ#ˆÀ ÄÅ#‡" [define-key esc-map "/" dabbrev-expand [67108911] dabbrev-completion] 4) #@472 Completion on current word. Like \[dabbrev-expand] but finds all expansions in the current buffer and presents suggestions for completion. With a prefix argument, it searches all buffers accepted by the function pointed out by `dabbrev-friend-buffer-function' to find the completions. If the prefix argument is 16 (which comes from C-u C-u), then it searches *all* buffers. With no prefix argument, it reuses an old completion list if there is a suitable one already. (defalias 'dabbrev-completion #[(&optional arg) "À ˆ … …Ä !ÅUÇ É\n!…* ?†*‰—˜\f ÏŠ „}ƒ}p=„UÒÓ !ƒ}Ô A@=ƒ}ƒ}GGYƒ}ÖGO˜ƒ}×\"‰„úØ\f\"ÚGÖ\"‰GÖV„¨Û܃¥Þ‚¦ß#ˆ\fƒ² „»áâ\"ˆ‚ꉖ˜ƒÌáã\"ˆ‚êÖäOÖäO–˜ƒäáå\"ˆ‚êáæ\"ˆ p×\"));„Þ˜„<——˜„<ç\"GäVƒ-èéêë !\"ˆ‚1èì!ˆíÏ#ˆ‚Pèî!ˆïðç\"!‘ˆèñ!ˆÒÓ !…ZèÏ!.‡" [dabbrev--reset-global-variables arg t dabbrev-check-other-buffers prefix-numeric-value 16 dabbrev-check-all-buffers dabbrev--abbrev-at-point abbrev eval dabbrev-case-fold-search dabbrev-upcase-means-case-search ignore-case-p dabbrev--last-obarray my-obarray nil init dabbrev--last-completion-buffer window-minibuffer-p selected-window buffer-list dabbrev--last-abbreviation 0 try-completion dabbrev--find-all-expansions completion-list make-vector error "No dynamic expansion for \"%s\" found%s" dabbrev--check-other-buffers "" " in this-buffer" dabbrev-case-replace mapcar #[(string) "À \n\"‡" [intern string my-obarray] 3] #[(string) "À –\n\"‡" [intern string my-obarray] 3] 1 #[(string) "ÀÁ\n! \"‡" [intern capitalize string my-obarray] 3] #[(string) "À —\n\"‡" [intern string my-obarray] 3] all-completions message "Repeat `%s' to see all completions" key-description this-command-keys "The only possible completion" dabbrev--substitute-expansion "Making completion list..." " *Completions*" display-completion-list "Making completion list...done"] 6 (#$ . 6555) "*P"]) #@817 Expand previous word "dynamically". Expands to the most recent, preceding word for which this is a prefix. If no suitable preceding word is found, words following point are considered. If still no suitable word is found, then look in the buffers accepted by the function pointed out by variable `dabbrev-friend-buffer-function'. A positive prefix argument, N, says to take the Nth backward *distinct* possibility. A negative argument says search forward. If the cursor has not moved from the end of the previous expansion and no argument is given, replace the previously-made expansion with the next possible expansion not yet tried. The variable `dabbrev-backward-only' may be used to limit the direction of search to backward if set non-nil. See also `dabbrev-abbrev-char-regexp' and \[dabbrev-completion]. (defalias 'dabbrev-expand #[(arg) "À‰‰‰`Š„@Ç!ƒ@É!ƒ@\n =„4ÌÍ !ƒ@`Uƒ@‚¿hÑ=ƒ Ç!ƒ É!ƒ `TUƒ ÒŠƒhqˆÔ=„}Õ=ƒ…`Wƒ…G\\bˆ×ØÚQ!ˆ`{`)Û‚¿Ü ˆ„µƒ±Ô‚¹Õ‚¹Þ!ß À\f„Ùà \ná\"!…×#?†× ‰—˜#)\f„ Ü ˆ ƒûŠ $B$å !ˆ cˆ`` G\\|ˆ)æç ƒè‚é #‚\\*=„\"ëìí!\"ˆ*‚&ëÀ!ˆp=„2„E§ƒE`VƒEî! $B$ï \f#ˆ\f ð ‰-‡" [nil orig-point direction old expansion abbrev arg markerp dabbrev--last-abbrev-location marker-position last-command this-command window-minibuffer-p selected-window dabbrev--last-abbreviation dabbrev--last-expansion dabbrev--last-direction 32 " " dabbrev--last-buffer 1 0 dabbrev--last-expansion-location re-search-forward "\\(\\(" dabbrev--abbrev-char-regexp "\\)+\\)" -1 dabbrev--reset-global-variables dabbrev-backward-only prefix-numeric-value dabbrev--abbrev-at-point dabbrev--find-expansion eval dabbrev-case-fold-search dabbrev-upcase-means-case-search buffer-undo-list search-backward error "No%s dynamic expansion for `%s' found" " further" "" dabbrev--last-buffer-found message "Expansion found in '%s'" buffer-name copy-marker dabbrev--substitute-expansion point-marker] 5 (#$ . 8523) "*P"]) (defalias 'dabbrev--same-major-mode-p #[(other-buffer) "Š qˆ)=‡" [major-mode other-buffer] 2]) (defalias 'dabbrev--goto-start-of-abbrev #[nil "À ÂŽo„%ÃuˆÄ !ƒo„Ãuˆ‚\fÄ !„%Æuˆ…7Ä!…7Æuˆ‚**‡" [match-data match-data ((store-match-data match-data)) -1 looking-at dabbrev--abbrev-char-regexp 1 dabbrev-abbrev-skip-leading-regexp] 2]) (defalias 'dabbrev--abbrev-at-point #[nil "oƒÀÁ!ˆŠ`à ÅŽŠÆuˆÇÈ †ÊËQ!)„:Ì †*ÊÍÎ#ƒ6Ïuˆ‚:ÀÁ!ˆ*Ð ˆ\n`{)‡" [error "No possible abbreviation preceding point" dabbrev--last-abbrev-location match-data match-data ((store-match-data match-data)) -1 looking-at "\\(" dabbrev-abbrev-char-regexp "\\sw\\|\\s_" "\\)+" re-search-backward nil t 1 dabbrev--goto-start-of-abbrev] 4]) (defalias 'dabbrev--reset-global-variables #[nil "ÀÀÀÀÀÀÀÀÀ \n†Ë\f ‰‡" [nil dabbrev--last-table dabbrev--last-abbreviation dabbrev--last-abbrev-location dabbrev--last-direction dabbrev--last-expansion dabbrev--last-expansion-location dabbrev--friend-buffer-list dabbrev--last-buffer dabbrev--last-buffer-found dabbrev-abbrev-char-regexp "\\sw\\|\\s_" dabbrev--abbrev-char-regexp dabbrev-check-other-buffers dabbrev--check-other-buffers] 2]) (defalias 'dabbrev--select-buffers #[nil "ŠÀÁ !ƒ A@qˆpĉ‰ ‰ƒF@ =„=ÈÉ!ƒ= !ƒ= BA‰„ Ÿ-‡" [window-minibuffer-p selected-window buffer-list orig-buffer nil buffer dabbrev-tail dabbrev-result boundp dabbrev-friend-buffer-function] 4]) (defalias 'dabbrev--try-find #[(abbrev reverse n ignore-case) "ŠŒ~ˆÀ\nƒ \nbˆ \f ÇVƒ+È \n #‰ƒ+ S‰‚* ƒ2` +‡" [nil expansion dabbrev--last-expansion-location ignore-case n count case-fold-search 0 dabbrev--search abbrev reverse] 5]) (defalias 'dabbrev--find-all-expansions #[(abbrev ignore-case) "À‰ŠebˆÃ\fÅ#‰ƒ \nB‚)\n*‡" [nil expansion all-expansions dabbrev--find-expansion abbrev -1 ignore-case] 4]) (defalias 'dabbrev--scanning-message #[nil "ÀÁÂp!\"‡" [message "Scanning `%s'" buffer-name] 4]) (defalias 'dabbrev--find-expansion #[(abbrev direction ignore-case) "ÀŠ\nƒ\nqˆÃ ˆ‚*\f„*ÅÆ !ƒ*Ç A@qˆebˆÈ à ˆ\f„S ÊYƒSË ^‰\fƒSÍÏË ]$‰ƒS ‚K\fƒ[\nƒ~ ÊXƒ~ȉ\fƒ~ÍÀË []$‰ƒ~ ‚KÈ\f„ö\n„öÒÓ\f\"‰„öƒöÏ=„©ÕÖ!‰ƒöÀÀ ƒõÀ‰‰Ç ‰ƒæ@‰>„ÝBA‰„ÊŸ+ŸÞ\"*ƒ\"ßÆ !‰ Æ =„!á !âá !\"Bß !‰ ‚) „JƒJ@A\nqˆÃ ˆe#ÍÀË$‰ƒ& *‡" [nil expansion dabbrev--last-buffer dabbrev--scanning-message dabbrev-search-these-buffers-only window-minibuffer-p selected-window buffer-list -1 direction 0 1 dabbrev--last-direction dabbrev--try-find abbrev t ignore-case dabbrev--friend-buffer-list mapcar get-buffer dabbrev--check-other-buffers y-or-n-p "Scan other buffers also? " friend-buffer-list non-friend-buffer-list dabbrev-select-buffers-function dabbrev-check-all-buffers buffer dabbrev-tail dabbrev-result append next-window w window-buffer delq dabbrev--last-expansion-location] 6]) (defalias 'dabbrev--safe-replace-match #[(string &optional fixedcase literal) "Á=ƒ\f \f #‡Æ \f #‡" [major-mode picture-mode picture-replace-match string fixedcase literal replace-match] 4]) (defalias 'dabbrev--substitute-expansion #[(old abbrev expansion) "À !…\nƒ ‰—˜…À\f!ƒ$ŠÇ!ˆ)‚(Ç !ˆÈ ?Ê#)‡" [eval dabbrev-case-fold-search dabbrev-upcase-means-case-search abbrev dabbrev-case-replace use-case-replace old search-backward dabbrev--safe-replace-match expansion t] 4]) (defalias 'dabbrev--search #[(abbrev reverse ignore-case) "À ÂŽÃ\f!ÅÇRÃ\f!ÈÉRÊ \f Œƒ5`ƒ0[‚2\\}ˆ „ÀƒHÑ ÊÒ#‚NÓ ÊÒ#ƒÀÔ”bˆÕ ˆÖ !ƒ­Ó\f!ˆ×”ו{ ƒu — ʉ‰‰ƒ£@ ˜ƒšBA‰„†Ÿ+ƒ­Ê ƒ¹Ô”bˆ‚5Ô•bˆ‚5 …èÔ”Ô•{ BƒåÞ!ƒå—‚ç).‡" [match-data match-data ((store-match-data match-data)) regexp-quote abbrev "\\(" dabbrev--abbrev-char-regexp "\\)" "\\(\\(" "\\)+\\)" nil found-string pattern2 pattern1 dabbrev-limit dabbrev--last-expansion-location reverse re-search-backward t re-search-forward 0 dabbrev--goto-start-of-abbrev looking-at 1 ignore-case table-string dabbrev-tail dabbrev-result dabbrev--last-table result eval dabbrev-case-replace] 6]) (provide (quote dabbrev)) emacs-19.30/lisp/debug.elc100666 74777 1 25531 5751546100 13703 0ustar esrdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:20:09 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/debug.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/debug.el' was compiled for Emacs 19")) #@53 List of functions currently set for debug on entry. (defvar debug-function-list nil (#$ . 479)) #@55 Non-nil means "single-step" after the debugger exits. (defvar debugger-step-after-exit nil (#$ . 581)) #@64 This is the value for the debugger to return, when it returns. (defvar debugger-value nil (#$ . 690)) #@68 This is the buffer that was current when the debugger was entered. (defvar debugger-old-buffer nil (#$ . 798)) (byte-code "À B Bà BÄ BÅ BÆ BÇ BÈ BÉ BÊ BË BÌ BÍ BÎ BÏ BÐÀ‡" [debugger-outer-match-data current-load-list debugger-outer-load-read-function debugger-outer-overriding-local-map debugger-outer-track-mouse debugger-outer-last-command debugger-outer-this-command debugger-outer-unread-command-char debugger-outer-unread-command-events debugger-outer-last-input-event debugger-outer-last-command-event debugger-outer-last-nonmenu-event debugger-outer-last-event-frame debugger-outer-standard-input debugger-outer-standard-output debugger-outer-cursor-in-echo-area debug debugger] 2) #@349 Enter debugger. To return, type \`\[debugger-continue]'. Arguments are mainly for use when this is called from the internals of the evaluator. You may call with no args, or you may pass nil as the first arg and any other args you like. In that case, the list of args after the first will be printed into the backtrace buffer. (defalias 'debug #[(&rest debugger-args) "ÀÁ!ˆÂ‰‰ÃÅÆ!)pÂ‰Ç  \n \f  !\"#$%&'()*+‰‰ì‰‰‰‰‰‰í‰Â  \n\f .#\" !\n  \f &0+.‡" [message "Entering debugger..." nil fundamental-mode default-major-mode get-buffer-create "*Backtrace*" match-data load-read-function overriding-local-map track-mouse last-command this-command unread-command-char unread-command-events last-input-event last-command-event last-nonmenu-event last-event-frame standard-input standard-output cursor-in-echo-area debugger-outer-cursor-in-echo-area debugger-outer-standard-output debugger-outer-standard-input debugger-outer-last-event-frame debugger-outer-last-nonmenu-event debugger-outer-last-command-event debugger-outer-last-input-event debugger-outer-unread-command-events debugger-outer-unread-command-char debugger-outer-this-command debugger-outer-last-command debugger-outer-track-mouse debugger-outer-overriding-local-map debugger-outer-load-read-function debugger-outer-match-data executing-macro debugger-step-after-exit debugger-old-buffer debugger-buffer debug-on-quit debug-on-error debugger-value -1 t ((byte-code "À Â\"ƒŠ qˆÃ ˆÄ ˆ)‚Å !ˆÆ!‡" [get-buffer-window debugger-buffer visible erase-buffer fundamental-mode kill-buffer store-match-data debugger-outer-match-data] 3)) ((byte-code "À !ˆÂ ˆpÃÄÈ ˆ+ebˆÉ ˆ`ÊË!ˆÌyˆ`|ˆÍ ˆ@Ï>ƒLÐcˆ@Ñ=ƒ±ÒÓÃ\"ˆÔÌ!ˆÕcˆÖyˆ‚±@×=ƒsØcˆA@Úp\"ˆÛcˆÔÌ!ˆÜcˆÖyˆ‚±@Ý=ƒŒÞcˆÚA@p\"ˆÛcˆ‚±@Ã=ƒšßcˆ‚±Ú@à=ƒ©A‚«p\"ˆÛcˆáâ!ˆÃàÃ#$áâ!ˆå ˆ+à‡" [pop-to-buffer debugger-buffer erase-buffer t 50 print-length print-escape-newlines standard-output backtrace debugger-mode search-forward "\n debug(" 1 debugger-reenable debugger-args (lambda debug) "Entering:\n" debug backtrace-debug 3 delete-char 42 0 exit "Return value: " debugger-value prin1 10 32 error "Signalling: " "Beginning evaluation of function call form:\n" nil message "" buffer-read-only inhibit-trace recursive-edit] 3)) debug-on-next-call] 22 (#$ . 1512) nil]) #@126 Proceed, stepping through subexpressions of this expression. Enter another debugger on next entry to eval, apply or funcall. (defalias 'debugger-step-through #[nil "ÀÂÃ!ˆÄ ‡" [t debugger-step-after-exit message "Proceeding, will debug on next eval or call." exit-recursive-edit] 2 (#$ . 3966) nil]) #@56 Continue, evaluating this expression without stopping. (defalias 'debugger-continue #[nil "ÀÁ!ˆÂ ‡" [message "Continuing." exit-recursive-edit] 2 (#$ . 4272) nil]) #@156 Continue, specifying value to return. This is only useful when the value returned from the debugger will be used, such as in a debug on exit from a frame. (defalias 'debugger-return-value #[(val) "ÂÃÄ\"ˆÅ !ˆÆ ‡" [val debugger-value princ "Returning " t prin1 exit-recursive-edit] 3 (#$ . 4443) "XReturn value (evaluated): "]) #@70 Continue to exit from this frame, with all debug-on-entry suspended. (defalias 'debugger-jump #[nil "Á\\ ˆ) ‰ƒ!\f@Å\f@\f@KÆ#Mˆ\fA‰„)ÇÈ!ˆÉ ‡" [debugger-frame-offset 2 debugger-frame debug-function-list list debug-on-entry-1 nil message "Continuing through this frame" exit-recursive-edit] 6 (#$ . 4777) nil]) #@44 Turn all debug-on-entry functions back on. (defalias 'debugger-reenable #[nil "‰…& @K:„ @!ˆ @à @ @KÄ#Mˆ A‰„Å)‡" [debug-function-list list debug-convert-byte-code debug-on-entry-1 t nil] 6 (#$ . 5099)]) #@70 Return number of frames in backtrace before the one point points at. (defalias 'debugger-frame-number #[nil "ŠÀyˆ`Àebˆ``Ã\\{Äš„``Ã\\{Åšƒ'ÆÇ!ˆÈÉ!ˆÉyˆÊuˆgËUƒ:ÈÉ!ˆ‚>ÈÊ!ˆÉyˆ`\nXƒM T‚* +‡" [0 count opoint 6 "Signal" "Return" search-forward ":" forward-sexp 1 2 40] 3 (#$ . 5316)]) #@2  (defconst debugger-frame-offset 8 (#$ . 5607)) #@112 Request entry to debugger when this frame exits. Applies to the frame whose line point is on in the backtrace. (defalias 'debugger-frame #[nil "ÀyˆÁ Ã\n\f\\Å\"ˆ)gÆUƒÇÉÊ!ˆËcˆ)ÀyˆÇ‡" [0 debugger-frame-number level backtrace-debug debugger-frame-offset t 32 nil buffer-read-only delete-char 1 42] 3 (#$ . 5662) nil]) #@111 Do not enter to debugger when this frame exits. Applies to the frame whose line point is on in the backtrace. (defalias 'debugger-frame-clear #[nil "ÀyˆÁ Ã\n\f\\Å\"ˆ)gÆUƒÅÈÉ!ˆÊcˆ)ÀyˆÅ‡" [0 debugger-frame-number level backtrace-debug debugger-frame-offset nil 42 buffer-read-only delete-char 1 32] 3 (#$ . 5988) nil]) #@71 Eval an expression, in an environment like that outside the debugger. (defalias 'debugger-eval-expression #[(exp) "ŠÀ !„ p qˆ\n \f  \n \f Þ!ˆà!!â  \n \f .‡" [buffer-name debugger-old-buffer debugger-outer-track-mouse debugger-outer-last-command debugger-outer-this-command debugger-outer-unread-command-char debugger-outer-unread-command-events debugger-outer-last-input-event debugger-outer-last-command-event debugger-outer-last-nonmenu-event debugger-outer-last-event-frame debugger-outer-standard-input debugger-outer-standard-output debugger-outer-cursor-in-echo-area debugger-outer-overriding-local-map debugger-outer-load-read-function load-read-function overriding-local-map cursor-in-echo-area standard-output standard-input last-event-frame last-nonmenu-event last-command-event last-input-event unread-command-events unread-command-char this-command last-command track-mouse store-match-data debugger-outer-match-data eval-expression exp match-data] 14 (#$ . 6316) (list (read-from-minibuffer "Eval: " nil read-expression-map t (quote read-expression-history)))]) (byte-code "ÀÁ!„ÂÁ B „bÄÆ Ç !ˆÈ ÉÊ#ˆÈ ËÌ#ˆÈ ÍÎ#ˆÈ ÏÐ#ˆÈ ÑÒ#ˆÈ ÓÔ#ˆÈ ÕÖ#ˆÈ ×Ø#ˆÈ ÙÚ#ˆÈ ÛÜ#ˆÈ ÝÞ#ˆÈ ßà#ˆ)áâãä#‡" [boundp debugger-mode-map nil current-load-list 32 loop make-keymap suppress-keymap define-key "-" negative-argument "b" debugger-frame "c" debugger-continue "j" debugger-jump "r" debugger-return-value "u" debugger-frame-clear "d" debugger-step-through "l" debugger-list-functions "h" describe-mode "q" top-level "e" debugger-eval-expression " " next-line put debugger-mode mode-class special] 4) #@522 Mode for backtrace buffers, selected in debugger. \ A line starts with `*' if exiting that frame will call the debugger. Type \[debugger-frame] or \[debugger-frame-clear] to set or remove the `*'. When in debugger due to frame being exited, use the \[debugger-return-value] command to override the value being returned from that frame. Use \[debug-on-entry] and \[cancel-debug-on-entry] to control which functions will enter the debugger when called. Complete list of commands: \{debugger-mode-map} (defalias 'debugger-mode #[nil "À ˆÁÃÅÇ!ˆÉ\n!‡" [kill-all-local-variables debugger-mode major-mode "Debugger" mode-name t truncate-lines set-syntax-table emacs-lisp-mode-syntax-table use-local-map debugger-mode-map] 2 (#$ . 8011)]) #@333 Request FUNCTION to invoke debugger each time it is called. If you tell the debugger to continue, FUNCTION's execution proceeds. This works by modifying the definition of FUNCTION, which must be written in Lisp, not predefined. Use \[cancel-debug-on-entry] to cancel the effect of this command. Redefining FUNCTION also cancels it. (defalias 'debug-on-entry #[(function) "À ˆÁ\nK!ƒÃÄ\n\"ˆ\nK:„Å\n!ˆ\nK:„$ÃÆ\n\"ˆ\nÇ\n‰KÈ#Mˆ\n >„:\n B \n‡" [debugger-reenable subrp function error "Function %s is a primitive" debug-convert-byte-code "Definition of %s is not a list" debug-on-entry-1 t debug-function-list] 5 (#$ . 8778) "aDebug on entry (to function): "]) #@112 Undo effect of \[debug-on-entry] on FUNCTION. If argument is nil or an empty string, cancel for all functions. (defalias 'cancel-debug-on-entry #[(&optional function) "À ˆ ƒ ˜„ à ‰KÄ#MˆÅ \" ‡ÇÈ!ˆÉÊ\"‡" [debugger-reenable function "" debug-on-entry-1 nil delq debug-function-list message "Cancelling debug-on-entry for all functions" mapcar cancel-debug-on-entry] 5 (#$ . 9448) (list (let ((name (completing-read "Cancel debug on entry (to function): " (mapcar (quote list) (mapcar (quote symbol-name) debug-function-list)) nil t nil))) (if name (intern name))))]) (defalias 'debug-convert-byte-code #[(function) "K‰:?…D Ã\"Å\fA@Æ\f8Ç\f8FCÉ\f›ƒ,ÊÉ\f8DBË\f8ƒ:Ì!BÍ\f@BBM*)‡" [function defn append nil contents byte-code 2 3 body 5 interactive 4 documentation lambda] 6]) (defalias 'debug-on-entry-1 #[(function defn flag) "À !ƒ ÂÃ\f\"‡ @Å=ƒÆ\f A#‡ @È=„&ÂÉ\f\"ˆÊ‰ \f AA@;ƒHÍ ›\f @ A@ AA@E ‚U AA\f @ A@D \f@Κ=ƒd ‚yƒs Ï\fB¤‚y \fA¤*‡" [subrp defn error "%s is a built-in function" function macro debug-on-entry-1 flag lambda "%s not user-defined Lisp function" nil prec tail 3 (debug (quote debug)) (debug (quote debug))] 4]) #@64 Display a list of all the functions now set to debug on entry. (defalias 'debugger-list-functions #[nil "À „ ÂÃ!ˆ‚/ÂÄ!ˆ ‰ƒ&Æ @!ˆÇ ˆ A‰„)ÂÈ!ˆÂÉ!ˆŠ\nqˆË )‘‡" ["*Help*" debug-function-list princ "No debug-on-entry functions now\n" "Functions set to debug on entry:\n\n" list prin1 terpri "Note: if you have redefined a function, then it may no longer\n" "be set to debug on entry, even if it is in the list." standard-output help-mode] 4 (#$ . 10633) nil]) emacs-19.30/lisp/delsel.elc100666 13437 1 4721 6032173704 14154 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Sep 27 03:05:37 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/delsel.el ;;; emacs version 19.29.12. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`delsel.el' was compiled for Emacs 19.29 or later")) #@166 *Non-nil means Delete Selection mode is enabled. In Delete Selection mode, when a region is highlighted, insertion commands first delete the region and then insert. (defvar delete-selection-mode t (#$ . -479)) (defalias 'delete-active-region #[(&optional killp) "ƒ Á` \"ˆ‚` |ˆÃÅÆ!ˆÇ‡" [killp kill-region mark nil mark-active run-hooks deactivate-mark-hook t] 3]) (defalias 'delete-selection-pre-hook #[nil "…_ ?…_\n…_ …_\f9…\fÅN‰Ç=ƒ'ÈÉ!‚^Ê=ƒC`Ë {\f@˜ƒ=ÍÎ!ˆÈÏ!‚^Ð=ƒVÈÏ!…^щ‚^…^ÈÏ!)‡" [delete-selection-mode buffer-read-only transient-mark-mode mark-active this-command delete-selection type kill delete-active-region t yank mark kill-ring current-kill 1 nil supersede (lambda nil (interactive))] 3]) (byte-code "ÀÁÂ\"ˆÃÄÅÆ#ˆÃÇÅÆ#ˆÃÈÅÈ#ˆÃÉÅÈ#ˆÃÊÅÆ#ˆÃËÅÌ#ˆÃÍÅÌ#ˆÃÎÅÌ#ˆÃÏÅÆ#ˆÃÐÅÆ#ˆÃÑÅÆ#ˆÒÓÔ\"‡" [add-hook pre-command-hook delete-selection-pre-hook put self-insert-command delete-selection t self-insert-iso yank clipboard-yank insert-register delete-backward-char supersede backward-delete-char-untabify delete-char newline-and-indent newline open-line defalias pending-delete-mode delete-selection-mode] 4) #@150 Toggle Delete Selection mode. When ON, typed text replaces the selection if the selection is active. When OFF, typed text is just inserted at point. (defalias 'delete-selection-mode #[(arg) "„ ?‚Â!ÃVÄ ‡" [arg delete-selection-mode prefix-numeric-value 0 force-mode-line-update] 2 (#$ . 1623) "P"]) #@149 Abort recursive edit. In Delete Selection mode mode, if the mark is active, just deactivate it; then it takes a second C-g to abort the minibuffer. (defalias 'minibuffer-keyboard-quit #[nil "ƒ ƒ\nƒÉ‡Å ‡" [delete-selection-mode transient-mark-mode mark-active t deactivate-mark abort-recursive-edit] 2 (#$ . 1935) nil]) (byte-code "À ÂÃ#ˆÀ\fÂÃ#ˆÀ ÂÃ#ˆÀÂÃ#ˆÀÂÃ#ˆÈÉ!‡" [define-key minibuffer-local-map "" minibuffer-keyboard-quit minibuffer-local-ns-map minibuffer-local-completion-map minibuffer-local-must-match-map minibuffer-local-isearch-map provide delsel] 4) emacs-19.30/lisp/derived.elc100666 12120 1 16262 6043463774 14230 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:38:08 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/derived.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`derived.el' was compiled for Emacs 19.29 or later")) #@1256 Create a new mode as a variant of an existing mode. The arguments to this command are as follow: CHILD: the name of the command for the derived mode. PARENT: the name of the command for the parent mode (ie. text-mode). NAME: a string which will appear in the status line (ie. "Hypertext") DOCSTRING: an optional documentation string--if you do not supply one, the function will attempt to invent something useful. BODY: forms to execute just before running the hooks for the new mode. Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode: (define-derived-mode LaTeX-thesis-mode LaTeX-mode "LaTeX-Thesis") You could then make new key bindings for `LaTeX-thesis-mode-map' without changing regular LaTeX mode. In this example, BODY is empty, and DOCSTRING is generated by default. On a more complicated level, the following command uses sgml-mode as the parent, and then sets the variable `case-fold-search' to nil: (define-derived-mode article-mode sgml-mode "Article" "Major mode for editing technical articles." (setq case-fold-search nil)) Note that if the documentation string had been left out, it would have been generated automatically, with a reference to the keymap. (defalias 'define-derived-mode '(macro . #[(child parent name &optional docstring &rest body) "ƒ;„ B†Ã\f \"ÆÇÈ DDÉ ÂÊ\fCËÌÈ\fDÍBBÎÈ DÏBBEÐÑÈ DEÐÒEÔÈ DDÕÈ DDÖÈ DD× ØÈ DDC\"BBBBBBBBBBBBE‡" [docstring body nil derived-mode-make-docstring parent child progn derived-mode-init-mode-variables quote defun (interactive) if get ((quote special)) put ((quote special) t) setq major-mode mode-name name derived-mode-set-keymap derived-mode-set-syntax-table derived-mode-set-abbrev-table append derived-mode-run-hooks] 19 (#$ . 483)])) #@172 Find the class of a major mode. A mode's class is the first ancestor which is NOT a derived mode. Use the `derived-mode-parent' property of the symbol to trace backwards. (defalias 'derived-mode-class #[(mode) "ÁNƒÁN‰‚‡" [mode derived-mode-parent] 3 (#$ . 2287)]) #@55 Construct a setup-function name based on a mode name. (defalias 'derived-mode-setup-function-name #[(mode) "ÀÁ\n!ÃP!‡" [intern symbol-name mode "-setup"] 3 (#$ . 2565)]) (put (quote derived-mode-setup-function-name) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@46 Construct a hooks name based on a mode name. (defalias 'derived-mode-hooks-name #[(mode) "ÀÁ\n!ÃP!‡" [intern symbol-name mode "-hooks"] 3 (#$ . 2846)]) (put (quote derived-mode-hooks-name) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@44 Construct a map name based on a mode name. (defalias 'derived-mode-map-name #[(mode) "ÀÁ\n!ÃP!‡" [intern symbol-name mode "-map"] 3 (#$ . 3100)]) (put (quote derived-mode-map-name) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@53 Construct a syntax-table name based on a mode name. (defalias 'derived-mode-syntax-table-name #[(mode) "ÀÁ\n!ÃP!‡" [intern symbol-name mode "-syntax-table"] 3 (#$ . 3346)]) (put (quote derived-mode-syntax-table-name) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@54 Construct an abbrev-table name based on a mode name. (defalias 'derived-mode-abbrev-table-name #[(mode) "ÀÁ\n!ÃP!‡" [intern symbol-name mode "-abbrev-table"] 3 (#$ . 3628)]) (put (quote derived-mode-abbrev-table-name) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@208 Initialise variables for a new mode. Right now, if they don't already exist, set up a blank keymap, an empty syntax table, and an empty abbrev table -- these will be merged the first time the mode is used. (defalias 'derived-mode-init-mode-variables #[(mode) "À Âà !ÄP!)!„2ÅÆ Âà !ÄP!)ÇÈÉ \"F!ˆÊ Âà !ÄP!)ËÌ#ˆÀ Âà !ÍP!)!„dÅÆ Âà !ÍP!)ÎÈÏ \"F!ˆÊ Âà !ÍP!)ËÌ#ˆÀ Âà !ÐP!)!ƒu̇ÅÆ Âà !ÐP!)ÑÈÒ \"F!‡" [boundp mode intern symbol-name "-map" eval defvar (make-sparse-keymap) format "Keymap for %s." put derived-mode-unmerged t "-syntax-table" (make-char-table (quote syntax-table) nil) "Syntax table for %s." "-abbrev-table" (progn (define-abbrev-table (derived-mode-abbrev-table-name mode) nil) (make-abbrev-table)) "Abbrev table for %s."] 7 (#$ . 3912)]) #@59 Construct a docstring for a new mode if none is provided. (defalias 'derived-mode-make-docstring #[(parent child) "ÀÁ\n ‰\n‰ &‡" [format "This major mode is a variant of `%s', created by `define-derived-mode'.\nIt inherits all of the parent's attributes, but has its own keymap,\nabbrev table and syntax table:\n\n `%s-map' and `%s-syntax-table'\n\nwhich more-or-less shadow\n\n `%s-map' and `%s-syntax-table'\n\n\\{%s-map}" parent child] 8 (#$ . 4675)]) #@64 Set the keymap of the new mode, maybe merging with the parent. (defalias 'derived-mode-set-keymap #[(mode) "ÁÂ!ÃP!)Å\f!Ç ‰ƒ%\fÉNƒ%Ê\"ˆË\fÉÌ#ˆÍ!+‡" [mode intern symbol-name "-map" map-name eval new-map current-local-map old-map derived-mode-unmerged derived-mode-merge-keymaps put nil use-local-map] 5 (#$ . 5139)]) #@70 Set the syntax table of the new mode, maybe merging with the parent. (defalias 'derived-mode-set-syntax-table #[(mode) "ÁÂ!ÃP!)Å Ç\f!\fÉNƒ!Ê\"ˆË\fÉÌ#ˆÍ!+‡" [mode intern symbol-name "-syntax-table" table-name syntax-table old-table eval new-table derived-mode-unmerged derived-mode-merge-syntax-tables put nil set-syntax-table] 4 (#$ . 5476)]) #@107 Set the abbrev table if it exists. Always merge its parent into it, since the merge is non-destructive. (defalias 'derived-mode-set-abbrev-table #[(mode) "ÁÂ!ÃP!) Ç\f!É\"ˆ‰+‡" [mode intern symbol-name "-abbrev-table" table-name local-abbrev-table old-table eval new-table derived-mode-merge-abbrev-tables] 3 (#$ . 5841)]) #@30 Run the hooks if they exist. (defalias 'derived-mode-run-hooks #[(mode) "ÁÂ!ÃP!)Å\f!…Æ\f!)‡" [mode intern symbol-name "-hooks" hooks-name boundp run-hooks] 3 (#$ . 6186)]) #@139 Merge an old keymap into a new one. The old keymap is set to be the last cdr of the new one, so that there will be automatic inheritance. (defalias 'derived-mode-merge-keymaps #[(old new) "‰:ƒ| @:ƒ3 @@!Ä \"Ä \"È !ƒ2È!ƒ2É \"ˆ+Ê @!ƒu @GS‰ ÌYƒt !Ä \"Ä \"È !ƒjÈ!ƒjÉ \"ˆ+ S‰ ‚A) A‰‚)GS›¡‡" [new tail vector key lookup-key subnew old subold keymapp derived-mode-merge-keymaps vectorp i 0] 4 (#$ . 6371)]) #@121 Merge an old syntax table into a new one. Where the new table already has an entry, nothing is copied from the old one. (defalias 'derived-mode-merge-syntax-tables #[(old new) "ÀÁ\n\"‡" [map-char-table #[(key value) "À \n\"†\fà \n\f#‡" [char-table-range new key set-char-table-range value] 4] old] 3 (#$ . 6823)]) (defalias 'derived-mode-merge-abbrev-tables #[(old new) "…ÁÂ\"‡" [old mapatoms #[(symbol) "ÀÁ\n! \"†Ä Á\n!\nJ\nK$‡" [intern-soft symbol-name symbol new define-abbrev] 5]] 3]) (provide (quote derived)) emacs-19.30/lisp/desktop.elc100666 12120 1 24773 6034774507 14264 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Thu Oct 5 11:26:46 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/desktop.el ;;; emacs version 19.29.11. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`desktop.el' was compiled for Emacs 19.29 or later")) #@59 File for Emacs desktop, not including the directory name. (defconst desktop-basefilename (byte-code "Á=„\fÂ=ƒÇć" [system-type ms-dos windows-nt "emacs.dsk" ".emacs.desktop"] 2) (#$ . 480)) #@101 *If non-nil then desktop warns when a file no longer exists. Otherwise it simply ignores that file. (defvar desktop-missing-file-warning t (#$ . -683)) #@258 List of global variables to save when killing Emacs. An element may be variable name (a symbol) or a cons cell of the form (VAR . MAX-SIZE), which means to truncate VAR's value to at most MAX-SIZE elements (if the value is a list) before saving the value. (defvar desktop-globals-to-save (list (quote desktop-missing-file-warning) (quote tags-file-name) (quote tags-table-list) (quote search-ring) (quote regexp-search-ring) (quote register-alist)) (#$ . 842)) #@107 List of local variables to save for each buffer. The variables are saved only when they really are local. (defvar desktop-locals-to-save (list (quote desktop-locals-to-save) (quote truncate-lines) (quote case-fold-search) (quote case-replace) (quote fill-column) (quote overwrite-mode) (quote change-log-default-name) (quote line-number-mode)) (#$ . 1311)) (make-variable-buffer-local (quote desktop-locals-to-save)) #@65 Regexp identifying buffers that are to be excluded from saving. (defvar desktop-buffers-not-to-save "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$" (#$ . 1734)) #@72 Regexp identifying files whose buffers are to be excluded from saving. (defvar desktop-files-not-to-save "^/[^/:]*:" (#$ . 1909)) #@366 *List of functions to call in order to create a buffer. The functions are called without explicit parameters but may access the the major mode as `mam', the file name as `fn', the buffer name as `bn', the default directory as `dd'. If some function returns non-nil no further functions are called. If the function returns t then the buffer is considered created. (defvar desktop-buffer-handlers (quote (desktop-buffer-dired desktop-buffer-rmail desktop-buffer-mh desktop-buffer-info desktop-buffer-file)) (#$ . -2046)) #@46 Opening of form for creation of new buffers. (defvar desktop-create-buffer-form "(desktop-create-buffer 205" (#$ . 2573)) #@92 Hook run before saving the desktop to allow you to cut history lists and the like shorter. (defvar desktop-save-hook nil (#$ . 2701)) #@58 The directory in which the current desktop file resides. (defvar desktop-dirname nil (#$ . 2841)) #@35 *Header to place in Desktop file. (defconst desktop-header ";; --------------------------------------------------------------------------\n;; Desktop File for Emacs\n;; --------------------------------------------------------------------------\n" (#$ . -2945)) #@68 Hooks run after all buffers are loaded; intended for internal use. (defvar desktop-delay-hook nil (#$ . 3212)) #@52 Truncate LIST to at most N elements destructively. (defalias 'desktop-truncate #[(l n) "S ›‰:… \ná)‡" [n l here nil] 3 (#$ . 3329)]) #@20 Empty the Desktop. (defalias 'desktop-clear #[nil "ÀÀÀÀÀÀÇÈÉ \"ˆÊ ‡" [nil kill-ring kill-ring-yank-pointer search-ring search-ring-yank-pointer regexp-search-ring regexp-search-ring-yank-pointer mapcar kill-buffer buffer-list delete-other-windows] 3 (#$ . 3472) nil]) (add-hook (quote kill-emacs-hook) (quote desktop-kill)) (defalias 'desktop-kill #[nil "…ÁÂÇ" [desktop-dirname err (desktop-save desktop-dirname) ((file-error (byte-code "ÀÁ!?…  @ A\"‡" [yes-or-no-p "Error while saving the desktop. Quit anyway? " signal err] 3)))] 3]) #@238 Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE. TXT is a string that when read and evaluated yields value. QUOTE may be `may' (value may be quoted), `must' (values must be quoted), or nil (value may not be quoted). (defalias 'desktop-internal-v2s #[(val) "§„ƒÁ=ƒÂÃ!B‡;ƒ-Ä!ÆÇ GÈ $ˆÂà !)B‡9ƒ8ÉÃ!B‡Ê!ƒgÈ ÌÍ\" ƒZÈÏÐÑÒ#ÓQB‚eÂÔÐÕÒ#ÖQB*‡:ƒȉ‰:ƒÚ@!„Œ@?B)A‰‚vƒõÚ!@„¾@?‰ƒèÈÞ@É=ƒÌß‚ÍàAÒ@É=ƒÝß‚ÞàAÓ°B‚òÉAáAQB ˆ*Ÿƒ ÈâÐãÒ#ÓQB‚ÉäÐÕÒ#ÓQB+‡å!ƒ,ÈæÃ!çèOÓQB‡é!ƒQÃê!!Ãëì!!!-.Èïðñ.ò-ó°*B‡ÂôB‡" [val t may prin1-to-string copy-sequence copy set-text-properties 0 nil must vectorp special mapcar #[(el) "À !‰@„ Ã\n)‡" [desktop-internal-v2s el res t special] 3] pass1 "(vector " mapconcat #[(el) "@Á=ƒ\fÂAP‡A‡" [el must "'"] 2] " " ")" "[" cdr "]" anynil newlist p desktop-internal-v2s q\.txt el last "(cons " "'" "" " . " "(list " #[(el) "@Á=ƒ\fÂAP‡A‡" [el must "'"] 2] "(" subrp "(symbol-function '" 7 -1 markerp marker-position buffer-name marker-buffer buf pos "(let ((mk (make-marker)))" " (add-hook 'desktop-delay-hook" " (list 'lambda '() (list 'set-marker mk " " (get-buffer " ")))) mk)" "\"Unprintable entity\""] 10 (#$ . 4030)]) #@110 Convert VALUE to a string that when read evaluates to the same value. Not all types of values are supported. (defalias 'desktop-value-to-string #[(val) "ÀÂÄ !‰@AÉ=ƒ ÊP‚\"-‡" [t print-escape-newlines nil float-output-format desktop-internal-v2s val quote\.txt quote txt must "'"] 3 (#$ . 5312)]) #@286 Output a setq statement for variable VAR to the desktop file. The argument VARSPEC may be the variable name VAR (a symbol), or a cons cell of the form (VAR . MAX-SIZE), which means to truncate VAR's value to at most MAX-SIZE elements (if the value is a list) before saving the value. (defalias 'desktop-outvar #[(varspec) "À‰ :ƒ @ A‚ Ä\n!…? ¨ƒ3 ÅVƒ3Æ\n!<ƒ3ÇÆ\n! \"ˆÈÉ\n!ÊË\nJ!̱*‡" [nil size var varspec boundp 0 eval desktop-truncate "(setq " symbol-name " " desktop-value-to-string ")\n"] 5 (#$ . 5632)]) #@168 Return t if the desktop should record a particular buffer for next startup. FILENAME is the visited file name, BUFNAME is the buffer name, and MODE is the major mode. (defalias 'desktop-save-buffer-p #[(filename bufname mode &rest dummy) "À\nƒÃ\f \"„Ã\n\"?†7È=ƒ.ŠÉ !qˆÃ\n\")?†7\n?…7Ë>)‡" [nil case-fold-search filename string-match desktop-buffers-not-to-save bufname desktop-files-not-to-save mode dired-mode get-buffer default-directory (Info-mode rmail-mode)] 3 (#$ . 6161)]) #@76 Save the Desktop file. Parameter DIRNAME specifies where to save desktop. (defalias 'desktop-save #[(dirname) "ÀÁ!ˆŠÂ \fP!ÅÆÇ \"ŸÈÉ!\n \f\nqˆÍ ˆÏÐ ÑÒÔÕ±ˆÅÖ\"ˆØ>ƒIÙÚGGZ!ܱˆÝcˆÅÞ \"ˆ à\f!ƒaá\f!ˆâed\fãä%ˆ, ‰%‡" [run-hooks desktop-save-hook expand-file-name dirname desktop-basefilename mapcar #[(b) "qˆÁ  \f??C`ÅÆ!D É=ƒ#\n D‚5 Ì=…5Í!ÏÐ\"ŸABÓ Ô‰ƒu@ž‰ƒZB‚k@ƒk@B)A‰„D+¯ ‡" [b buffer-file-name buffer-name major-mode auto-fill-function mark t mark-active buffer-read-only Info-mode Info-current-file Info-current-node dired-mode expand-file-name dired-directory mapcar car dired-subdir-alist desktop-locals-to-save buffer-local-variables nil ll loclist locals here] 12] buffer-list get-buffer-create "*desktop*" buf info filename erase-buffer desktop-header ";; Created " current-time-string "\n" ";; Emacs version " emacs-version "\n\n" ";; Global section:\n" desktop-outvar desktop-globals-to-save kill-ring "(setq kill-ring-yank-pointer (nthcdr " int-to-string kill-ring-yank-pointer " kill-ring))\n" "\n;; Buffer section:\n" #[(l) "ÀÁ\n\"… cˆÄÅ\n\"ˆÆc‡" [apply desktop-save-buffer-p l desktop-create-buffer-form mapcar #[(e) "ÀÁ\n!±‡" ["\n " desktop-value-to-string e] 3] ")\n\n"] 3] default-directory file-exists-p delete-file write-region nil nomessage desktop-dirname] 8 (#$ . 6664) "DDirectory to save desktop file in: "]) #@60 Delete the Desktop file and inactivate the desktop system. (defalias 'desktop-remove #[nil "… PÃÄ\n!…Å\n!)‡" [desktop-dirname desktop-basefilename filename nil file-exists-p delete-file] 2 (#$ . 8084) nil]) #@51 Read the Desktop file and the files it specifies. (defalias 'desktop-read #[nil "ÀÂÃ\fP!ƒÅÃ!‚%ÂÇ\fP!ƒ\"ÅÇ!‚%Àƒ>È\fPɉ‰$ˆÊË!ˆÌÍ!‚@Î )‡" [nil filename file-exists-p "./" desktop-basefilename expand-file-name desktop-dirname "~/" load t run-hooks desktop-delay-hook message "Desktop loaded." desktop-clear] 5 (#$ . 8305) nil]) #@165 Load the `default' start-up library manually. Also inhibit further loading of it. Call this from your `.emacs' file to provide correct modes for autoloaded files. (defalias 'desktop-load-default #[nil "?…ÁÂÉ#ˆÃ‰‡" [inhibit-default-init load "default" t] 4 (#$ . 8654)]) #@20 Load an info file. (defalias 'desktop-buffer-info #[nil "Á=…ÂÃ!ˆÄ @ A@\"ˆÆ‡" [mam Info-mode require info Info-find-node misc t] 3 (#$ . 8936)]) #@21 Load an RMAIL file. (defalias 'desktop-buffer-rmail #[nil "Á=…\nÂÃć" [mam rmail-mode error (byte-code "À !ˆÂ‡" [rmail-input fn t] 2) ((file-locked (byte-code "Àp!ˆÁ‡" [kill-buffer ignored] 2)))] 3 (#$ . 9089)]) #@33 Load a folder in the mh system. (defalias 'desktop-buffer-mh #[nil "Á=…ÂÃ!ˆÄ ˆÅ!ˆÇ‡" [mam mh-folder-mode require mh-e mh-find-path mh-visit-folder bn t] 2 (#$ . 9310)]) #@31 Load a directory using dired. (defalias 'desktop-buffer-dired #[nil "Á=…'ÂÃ\f@!!ƒÅ\f@!ˆÆÇ\fA\"ˆÈ‡ÉÊ\f@\"ˆËÌ!ˆÍ‡" [mam dired-mode file-directory-p file-name-directory misc dired mapcar dired-insert-subdir t message "Directory %s no longer exists." sit-for 1 ignored] 3 (#$ . 9490)]) #@14 Load a file. (defalias 'desktop-buffer-file #[nil "…Á!„\nƒÃÄÅ\"!ƒÆ!ˆÇ‡È‡" [fn file-exists-p desktop-missing-file-warning y-or-n-p format "File \"%s\" no longer exists. Re-create? " find-file t ignored] 4 (#$ . 9782)]) (defalias 'desktop-create-buffer #[(ver fn bn mam mim pt mk ro misc &optional locals) "Á‰ „\fƒ\f@‰ \fA‚ Å=…—Æ š„-È!ˆÉ\n@ƒ8Ë‚9Ì!ˆ bˆ:ƒTÏ@!ˆA@‚YÏ!ˆƒb…—@‰:ƒ‚Õ@!ˆ@ALˆ‚ŒÕ!ˆÖ!ˆ)A‰„gÁ+‡" [desktop-buffer-handlers nil handler result hlist t buffer-name bn rename-buffer auto-fill-mode mim 1 0 pt mk set-mark mark-active ro buffer-read-only locals this make-local-variable makunbound] 4]) (defalias 'desktop-buffer #[(fn bn mam mim pt mk ro tl fc cfs cr misc) "ÀÁ\n \f A Ê BÌ BÎBÐBÒ @B¯&\n‡" [desktop-create-buffer 205 fn bn mam mim pt mk ro misc truncate-lines tl fill-column fc case-fold-search cfs case-replace cr overwrite-mode] 16]) (provide (quote desktop)) emacs-19.30/lisp/diary-lib.elc100666 12120 1 121671 6055526227 14477 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 25 00:41:06 1995 ;;; from file /home/fsf/rms/e19/lisp/diary-lib.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`diary-lib.el' was compiled for Emacs 19.29 or later")) (require (quote calendar)) #@252 Generate the diary window for ARG days starting with the current date. If no argument is provided, the number of days of diary entries is governed by the variable `number-of-diary-entries'. This function is suitable for execution in a `.emacs' file. (defalias 'diary #[(&optional arg) "À ! ‰ƒAÅ\f!ƒAÆ\f!ƒ;Ç ƒ%É!‚7Ê !ƒ5 Ì !H‚7 \"‚DÍÎ!‚DÍÏ!*‡" [substitute-in-file-name diary-file calendar-current-date date d-file file-exists-p file-readable-p list-diary-entries arg prefix-numeric-value vectorp number-of-diary-entries calendar-day-of-week error "Your diary file is not readable!" "You don't have a diary file!"] 6 (#$ . 504) "P"]) #@217 Prepare and display a buffer with diary entries. Searches the file named in `diary-file' for entries that match ARG days starting with the date indicated by the cursor position in the displayed three-month calendar. (defalias 'view-diary-entries #[(arg) "À !‰ƒ$Ã\n!ƒ$Ä\n!ƒÅÆÇ!\"‚'ÉÊ!‚'ÉË!)‡" [substitute-in-file-name diary-file d-file file-exists-p file-readable-p list-diary-entries calendar-cursor-to-date t arg error "Diary file is not readable!" "You don't have a diary file!"] 4 (#$ . 1162) "p"]) #@251 Prepare and display buffer of diary entries from an alternative diary file. Prompts for a file name and searches that file for entries that match ARG days starting with the date indicated by the cursor position in the displayed three-month calendar. (defalias 'view-other-diary-entries #[(arg diary-file) "À !‡" [view-diary-entries arg] 2 (#$ . 1680) (list (cond ((null current-prefix-arg) 1) ((listp current-prefix-arg) (car current-prefix-arg)) (t current-prefix-arg)) (setq diary-file (read-file-name "Enter diary file name: " default-directory nil t)))]) #@186 Check the list of holidays for any that occur on DATE. The value returned is a list of strings of relevant holiday descriptions. The holidays are those in the list `calendar-holidays'. (autoload (quote check-calendar-holidays) "holidays" '(#$ . 2246) t) #@127 Form the list of holidays that occur on dates in the calendar window. The holidays are those in the list `calendar-holidays'. (autoload (quote calendar-holiday-list) "holidays" '(#$ . 2507) t) #@49 French calendar equivalent of date diary entry. (autoload (quote diary-french-date) "cal-french" '(#$ . 2706) t) #@48 Mayan calendar equivalent of date diary entry. (autoload (quote diary-mayan-date) "cal-mayan" '(#$ . 2825) t) #@49 Julian calendar equivalent of date diary entry. (autoload (quote diary-julian-date) "cal-julian" '(#$ . 2941) t) #@47 Astronomical (Julian) day number diary entry. (autoload (quote diary-astro-day-number) "cal-julian" '(#$ . 3060) t) #@50 Chinese calendar equivalent of date diary entry. (autoload (quote diary-chinese-date) "cal-chinese" '(#$ . 3182) t) #@50 Islamic calendar equivalent of date diary entry. (autoload (quote diary-islamic-date) "cal-islamic" '(#$ . 3304) t) #@75 Add any Islamic date entries from the diary file to `diary-entries-list'. (autoload (quote list-islamic-diary-entries) "cal-islamic" '(#$ . 3426) t) #@72 Mark days in the calendar window that have Islamic date diary entries. (autoload (quote mark-islamic-diary-entries) "cal-islamic" '(#$ . 3581) t) #@76 Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR. (autoload (quote mark-islamic-calendar-date-pattern) "cal-islamic" '(#$ . 3733) t) #@49 Hebrew calendar equivalent of date diary entry. (autoload (quote diary-hebrew-date) "cal-hebrew" '(#$ . 3897) t) #@25 Omer count diary entry. (autoload (quote diary-omer) "cal-hebrew" '(#$ . 4016) t) #@76 Yahrzeit diary entry--entry applies if date is yahrzeit or the day before. (autoload (quote diary-yahrzeit) "cal-hebrew" '(#$ . 4104) t) #@59 Parasha diary entry--entry applies if date is a Saturday. (autoload (quote diary-parasha) "cal-hebrew" '(#$ . 4247) t) #@26 Rosh Hodesh diary entry. (autoload (quote diary-rosh-hodesh) "cal-hebrew" '(#$ . 4372) t) #@74 Add any Hebrew date entries from the diary file to `diary-entries-list'. (autoload (quote list-hebrew-diary-entries) "cal-hebrew" '(#$ . 4468) t) #@71 Mark days in the calendar window that have Hebrew date diary entries. (autoload (quote mark-hebrew-diary-entries) "cal-hebrew" '(#$ . 4620) t) #@75 Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR. (autoload (quote mark-hebrew-calendar-date-pattern) "cal-hebrew" '(#$ . 4769) t) #@49 Coptic calendar equivalent of date diary entry. (autoload (quote diary-coptic-date) "cal-coptic" '(#$ . 4930) t) #@51 Ethiopic calendar equivalent of date diary entry. (autoload (quote diary-ethiopic-date) "cal-coptic" '(#$ . 5049) t) #@26 Moon phases diary entry. (autoload (quote diary-phases-of-moon) "lunar" '(#$ . 5172) t) #@52 Local time of sunrise and sunset as a diary entry. (autoload (quote diary-sunrise-sunset) "solar" '(#$ . 5266) t) #@124 Local time of candle lighting diary entry--applies if date is a Friday. No diary entry if there is no sunset on that date. (autoload (quote diary-sabbath-candles) "solar" '(#$ . 5387) t) #@180 The syntax table used when parsing dates in the diary file. It is the standard syntax table used in Fundamental mode, but with the syntax of `*' changed to be a word constituent. (defvar diary-syntax-table (byte-code "ÀÁ !‡" [copy-syntax-table standard-syntax-table] 2) (#$ . 5581)) (modify-syntax-entry 42 "w" diary-syntax-table) #@1548 Create and display a buffer containing the relevant lines in diary-file. The arguments are DATE and NUMBER; the entries selected are those for NUMBER days starting with date DATE. The other entries are hidden using selective display. Returns a list of all relevant diary entries found, if any, in order by date. The list entries have the form ((month day year) string). If the variable `diary-list-include-blanks' is t, this list includes a dummy diary entry (consisting of the empty string) for a date with no diary entries. After the list is prepared, the hooks `nongregorian-diary-listing-hook', `list-diary-entries-hook', `diary-display-hook', and `diary-hook' are run. These hooks have the following distinct roles: `nongregorian-diary-listing-hook' can cull dates from the diary and each included file. Usually used for Hebrew or Islamic diary entries in files. Applied to *each* file. `list-diary-entries-hook' adds or manipulates diary entries from external sources. Used, for example, to include diary entries from other files or to sort the diary entries. Invoked *once* only, before the display hook is run. `diary-display-hook' does the actual display of information. If this is nil, simple-diary-display will be used. Use add-hook to set this to fancy-diary-display, if desired. If you want no diary display, use add-hook to set this to ignore. `diary-hook' is run last. This can be used for an appointment notification function. (defalias 'list-diary-entries #[(date number) "À W…±\nÄÄÇ\n!É\n! ÌÍ!ˆŠÎ !‰ƒ,‚1Ð Ñ\"qˆ)ÑÄÔ Õ!ˆ×ŽÄØ Ù!dSbˆÞß!„bàuˆáâ!ˆebˆÞß!„oáâ!ˆãedäåÑ%ˆÀ& &T‰&Yƒy'\n‰@)\n‰A@)\n‰AA@)è\n!)*+,‰-ƒÂ-@@º-@A‚½-@/-@@îš.ð\n!ñð\n!ÀòOóR4õö,!ñö,!ÀòOó°7øù,!P,øù+!P+øù*!:ƒ\fñù*û¦!P‚ üQ*ýþÿ@/A#B°CÑDebˆECÄÑ#ƒ·.ƒEFGÄÑ#ˆHhå\"„WHhä\"ƒhÞI!„hJà!ˆ‚+Ñ)`ÄKLFM!ˆ`KEßÄÑN$ˆÞI!ƒšEßÄÑ#ˆ‚‡Jà!ˆãK`åäÑ%ˆO\nL`{\"ˆ*‚+. -A‰-„ª)„ØPƒØQ\nüDC\"R\n‰‰AA@)SS\n‰‰@),\n‰A@)+\n‰AA@)*+,ST_\\U,NVƒPU,V_W\\ä¥ZU*‰*V¦ÀU…G*û¦ÀU?†G*X¦ÀU)ƒPUTUU-SY_\\SV¥\\Sû¥[\\SX¥\\*T!Ä)-‚z)Z!ˆ,ebˆ[\\]\"ˆ^ƒ [^!ˆ‚¥_ ˆ[`!ˆ.‡" [0 number date original-date nil old-diary-syntax-table diary-entries-list calendar-date-string date-string substitute-in-file-name diary-file d-file message "Preparing diary..." get-file-buffer diary-buffer find-file-noselect t selective-display selective-display-ellipses syntax-table set-syntax-table diary-syntax-table ((set-syntax-table old-diary-syntax-table)) buffer-modified-p regexp-quote diary-nonmarking-symbol mark diary-modified buffer-read-only looking-at " \\|\n" 1 insert-string " " subst-char-in-region 10 13 i diary-date-forms list-sexp-diary-entries entry-found year day month d backup date-form calendar-day-name "\\|" 3 ".?" dayname "\\*\\|" calendar-month-name monthname "\\*\\|0*" int-to-string abbreviated-calendar-year 100 "" "\\(\\`\\| \\|\n\\)" "?\\(" mapconcat eval "\\)\\(" "\\)" regexp case-fold-search re-search-forward re-search-backward "\\<" char-equal " \\| " backward-char date-start entry-start " \\|\n\\|\\`" 2 add-to-diary-list diary-list-include-blanks append calendar-gregorian-from-absolute prior-years 31 day-of-year 4 23 400 365 set-buffer-modified-p run-hooks nongregorian-diary-listing-hook list-diary-entries-hook diary-display-hook simple-diary-display diary-hook] 8 (#$ . 5920)]) #@496 Include the diary entries from other diary files with those of diary-file. This function is suitable for use in `list-diary-entries-hook'; it enables you to use shared diary files together with your own. The files included are specified in the diaryfile by lines of this form: #include "filename" This is recursive; that is, #include directives in diary files thus included are obeyed. You can change the `#include' to some other string by changing the variable `diary-include-string'. (defalias 'include-other-diary-files #[nil "ebˆÀÁ !ÄQÅÆ#ƒfÇȔȕ{!ÅÉÊÅ \f Ð!ƒUÑ!ƒEÒŽÓÕ\"\")‚bØ ˆÙÚ\"ˆÛÈ!ˆ‚bØ ˆÙÜ\"ˆÛÈ!ˆ-‚eb‡" [re-search-forward "\\(\\`\\| \\|\n\\)" regexp-quote diary-include-string " \"\\([^\"]*\\)\"" nil t substitute-in-file-name 2 include-other-diary-files ignore diary-hook diary-display-hook list-diary-entries-hook diary-list-include-blanks diary-file file-exists-p file-readable-p ((byte-code "ÀÁ\n!!‡" [kill-buffer get-file-buffer diary-file] 3)) append diary-entries-list list-diary-entries original-date number beep message "Can't read included diary file %s" sleep-for "Can't find included diary file %s"] 5 (#$ . 9471)]) #@73 Display the diary buffer if there are any relevant entries or holidays. (defalias 'simple-diary-display #[nil "…Á\n!ÄÅ ƒÇ‚ÈPÉÊ Ë##\f ƒ3 A„r @A@Șƒr\fGÎ XƒCÏ\f!‚‘Ð!qˆÒÔ!ˆÕ ˆÉÊ Ö#cˆebˆ×Ò!ˆØÙ!ˆÏÚ\"‚‘ÔÛ ƒ~Ü‚ÈÉÊ Ë#R!ˆÙÝ!!ˆÏß!*‡" [holidays-in-diary-buffer check-calendar-holidays original-date holiday-list format "No diary entries for %s %s" date-string ":" "" mapconcat identity "; " msg diary-entries-list frame-width message get-buffer-create holiday-buffer nil buffer-read-only calendar-set-mode-line erase-buffer "\n" set-buffer-modified-p t display-buffer "No diary entries for %s" "Diary for " ": " get-file-buffer d-file "Preparing diary...done"] 8 (#$ . 10653)]) #@148 Prepare a diary buffer with relevant entries in a fancy, noneditable form. This function is provided for optional use as the `diary-display-hook'. (defalias 'fancy-diary-display #[nil "ŠÀÁ\n!!qˆÃ ÅedÆÇÈ%ˆÉ\nËÌ!ˆÍ\f!ˆ*ƒ4A„•@A@Ϙƒ•…=Ñ!ÔÕƒLׂMÏPØÙÚ##‰GÜ XƒfÝ!‚“Þ!qˆÉ á!ˆâ ˆØÙã#cˆebˆÍÉ!ˆÈ ä!ˆÝå\"*‡Šæ qˆÉ Éç‰è‰‰E)*+‰,ƒÈí),@@\"„«,@@)ƒ;î+ï+*\"*EC)C\"ƒ;ð)!‰+ƒ;ñ)!‰*ƒ;*ò_+\\ó\\ç\\‰4ò¦T+4ò¥‰*)ƒ;+*56÷ *‰ƒ;*ò_+\\ó\\ç\\‰4ò¦T+4ò¥*)ø)!É9‰:ƒjí):@@\"ƒaû9:@A\"9:A‰:„L9*<`eUƒyÏ‚zDZˆ<ƒ‡ýcˆi>ØÙ<ãÿ>@\"P#cˆ)i>Çÿ>A\"DZˆ+è,@A@GWƒ¿,@A@DZˆ,A‰,„´-ÍÉ!ˆebˆÈ äB!ˆÝC!)‡" [get-file-buffer substitute-in-file-name diary-file buffer-modified-p diary-modified subst-char-in-region 13 10 t nil selective-display kill-local-variable mode-line-format set-buffer-modified-p diary-entries-list "" holidays-in-diary-buffer check-calendar-holidays original-date holiday-list format "No diary entries for %s %s" date-string ":" mapconcat identity "; " msg frame-width message get-buffer-create holiday-buffer buffer-read-only calendar-set-mode-line erase-buffer "\n" display-buffer "No diary entries for %s" make-fancy-diary-buffer 1 0 date holiday-list-last-year holiday-list-last-month entry-list calendar-date-equal calendar-date-compare calendar-last-day-of-month extract-calendar-month extract-calendar-year 12 -1 macro-y displayed-year displayed-month calendar-holiday-list calendar-date-string d h append date-holiday-list ": " l make-string 32 61 fancy-diary-buffer "Preparing diary...done"] 8 (#$ . 11368)]) #@51 Create and return the initial fancy diary buffer. (defalias 'make-fancy-diary-buffer #[nil "ŠÀ !qˆÂÄÅ!ˆÆÇ!ˆÈ ˆÉÂ!ˆÊË !)‡" [get-buffer-create fancy-diary-buffer nil buffer-read-only make-local-variable mode-line-format calendar-set-mode-line "Diary Entries" erase-buffer set-buffer-modified-p t get-buffer] 2 (#$ . 12992)]) #@402 Print a hard copy of the diary display. If the simple diary display is being used, prepare a temp buffer with the visible lines of the diary buffer, add a heading line composed from the mode line, print the temp buffer, and destroy it. If the fancy diary display is being used, just print the buffer. The hooks given by the variable `print-diary-entries-hook' are called to do the actual printing. (defalias 'print-diary-entries #[nil "ÀÁ\n!!ƒŠÁ\n!qˆÃÄ!)‡ÅÆ!!‰ƒ{ÉÊ!Ë\f Šqˆ;„6Ï‚CÐÑ\"ˆÒ”Ò•O\fÓ ed#ˆ qˆÔÕËÖ#ƒ_×Ø!ˆ‚Pebˆ\fÙÚ\fGÛ\"Ù±ˆÃÄ!ˆÜ !+‚~ÝÞ!)‡" [bufferp get-buffer fancy-diary-buffer run-hooks print-diary-entries-hook get-file-buffer substitute-in-file-name diary-file diary-buffer get-buffer-create "*Printable Diary Entries*" nil heading temp-buffer mode-line-format "All Diary Entries" string-match "^-*\\([^-].*[^-]\\)-*$" 1 copy-to-buffer re-search-forward " .*$" t replace-match "" "\n" make-string 61 kill-buffer error "You don't have a diary buffer!"] 6 (#$ . 13324) nil]) #@211 Show all of the diary entries in the diary file. This function gets rid of the selective display of the diary file so that all entries, not just some, are visible. If there is no diary buffer, one is created. (defalias 'show-all-diary-entries #[nil "À !‰ƒUÃ\n!ƒUÄ\n!ƒOŠÅ\n!‰ƒ#‚'Ç\nÈ\"qˆÉÊ  \fÍedÎÏÈ%ˆÉÑÒ!ˆÔp!ˆÕ !,‚XÖ×!‚XÖØ!)‡" [substitute-in-file-name diary-file d-file file-exists-p file-readable-p get-file-buffer diary-buffer find-file-noselect t nil buffer-modified-p diary-modified buffer-read-only subst-char-in-region 13 10 selective-display make-local-variable mode-line-format default-mode-line-format display-buffer set-buffer-modified-p error "Your diary file is not readable!" "You don't have a diary file!"] 7 (#$ . 14345) nil]) #@294 Convert an STRING-ARRAY, an array of strings to a pattern. The pattern will match any of the strings, either entirely or abbreviated to three characters. An abbreviated form will match with or without a period; If the optional FULLNAME is t, abbreviations will not match, just the full name. (defalias 'diary-name-pattern #[(string-array &optional fullname) "ÀÂ\fGS T‰Yƒ5 ‰À˜ƒÀ‚Å\f Hƒ'À‚0Å\f HÇÈOÉQR‚) )‡" ["" pattern -1 i string-array "\\|" fullname 0 3 ".?"] 7 (#$ . 15116)]) #@58 True during the marking of diary entries, nil otherwise. (defvar marking-diary-entries nil (#$ . 15616)) #@72 True during the marking of diary entries, if current entry is marking. (defvar marking-diary-entry nil (#$ . 15727)) #@243 Mark days in the calendar window that have diary entries. Each entry in the diary file visible in the calendar window is marked. After the entries are marked, the hooks `nongregorian-diary-marking-hook' and `mark-diary-entries-hook' are run. (defalias 'mark-diary-entries #[nil "À !À‰ƒ<Æ !ƒ<Ç !ƒ2ŠÈÉ!ˆÊ À\"qˆ Ì Ï  Ð!ˆƒ@@ÒšƒH@A‚K@Ô!Ô!ØPÚÚÚG‰Ö>GZU?…à\\Ù>GZ!!U?…˜!à\\!Ü>GZ\"\"U?…±\"à\\\"Û>GZ##U?…Ê#à\\#Ý>GZ$$U?…ã$à\\$åæçè#éQ*À+ebˆì*ÌÀ#ƒ\n… ”•{-!…!”!•{.ï#ƒ+#”#•{‚,ð!1ï\"ƒ?\"”\"•{‚@ð!2$…O$”$•{‰3„Yô‚©3GàUƒ¥5ƒ¥ö ‰7AA@)8ï3!8ù¥ù_\\‰:8ZûVƒŽ:ùZ‚¡8:ZûVƒŸ:ù\\‚¡:*‚©ï3!<-ƒÌýþÿ-ô@O!AôB#\"A!ˆ‚.ƒú.C˜ƒàô1‚úþÿ.ô@O!ADE#\"A1F12<#ˆ.‚öA.‚3G ˆHIJ\"ˆÐ !ˆÈK!+‚CLM!‚CLN!*‡" [t mark-diary-entries-in-calendar substitute-in-file-name diary-file marking-diary-entries d-file file-exists-p file-readable-p message "Marking diary entries..." find-file-noselect diary-date-forms nil old-diary-syntax-table d syntax-table set-syntax-table diary-syntax-table backup date-form diary-name-pattern calendar-day-name-array dayname calendar-month-name-array "\\|\\*" monthname "[0-9]+\\|\\*" month day year l d-name-pos 2 m-name-pos d-pos m-pos y-pos "\\(\\`\\| \\|\n\\)\\(" mapconcat eval "\\)\\(" "\\)" regexp case-fold-search re-search-forward dd-name mm-name string-to-int "" mm dd y-str 0 abbreviated-calendar-year calendar-current-date date current-y 100 y 50 yy mark-calendar-days-named assoc capitalize 3 calendar-make-alist (lambda (x) (substring x 0 3)) "*" 1 (lambda (x) (substring x 0 3)) mark-calendar-date-pattern mark-sexp-diary-entries run-hooks nongregorian-diary-marking-hook mark-diary-entries-hook "Marking diary entries...done" error "Your diary file is not readable!" "You don't have a diary file!"] 8 (#$ . 15851) nil]) #@222 Mark days in the calendar window that have sexp diary entries. Each entry in the diary file (or included files) visible in the calendar window is marked. See the documentation for the function `list-sexp-diary-entries'. (defalias 'mark-sexp-diary-entries #[nil "À !ÃÀ\n!ÄÀ !À\n!Æ°È È\nÈ È\fŠ qˆ \n)\nÐ_ \\Ñ\\‰ЦT Ð¥\n) Ó\nE‰‰AA@)S‰‰@)‰A@)‰AA@)SÙ_\\ÛVƒ½Ü_Ý\\Þ¥Z‰ܦßU…´à¦ßU?†´á¦ßU)ƒ½T-â_\\Ü¥\\à¥[\\á¥\\* \nÐ_ \\Ó\\‰ЦT Ð¥\n) ‰\n‰ÛUƒ#‰ܦßU…à¦ßU?†á¦ßU)ƒ#ã‚(äSH*\nE‰‰AA@)S‰‰@)‰A@)‰AA@)SÙ_\\ÛVƒÜ_Ý\\Þ¥Z‰ܦßU…”à¦ßU?†”á¦ßU)ƒT-â_\\Ü¥\\à¥[\\á¥\\*\febˆåÈæ#…{çhè\"ƒÑæ)‚ÔÈ)êë!ˆ`ȉ‰‰,-./0ñ ˆ0`{/Šêò!ˆ`,)Óuˆçhó\"„\nçhÞ\"ƒôõ!„öÓ!ˆ÷.‚N`-åøÈæ#ˆôõ!ƒ2åøÈæ#ˆ‚#öÓ!ˆ-`{.ùú.\"ƒN.ß”ÞIˆ‚< S\fT‰Yƒvû/.ü!#ƒSýü!!ˆ‚S.‚».‡" [regexp-quote sexp-diary-entry-symbol sexp-mark "\\(\\`\\| \\|\n\\)\\(" "(\\)\\|\\(" diary-nonmarking-symbol "(diary-remind\\)" s-entry nil m y first-date last-date calendar-buffer displayed-month displayed-year 12 -2 macro-y 1 date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 29 [31 28 31 30 31 30 31 31 30 31 30 31] re-search-forward t char-equal 40 marking-diary-entry re-search-backward "(" line-start entry-start entry sexp sexp-start forward-sexp " \\|\n\\|\\`" 13 looking-at " \\| " backward-char "" " \\|\n" string-match "[ ]" diary-sexp-entry calendar-gregorian-from-absolute mark-visible-calendar-date] 7 (#$ . 17795)]) #@503 Mark the diary entries from other diary files with those of the diary file. This function is suitable for use as the `mark-diary-entries-hook'; it enables you to use shared diary files together with your own. The files included are specified in the diary-file by lines of this form: #include "filename" This is recursive; that is, #include directives in diary files thus included are obeyed. You can change the `#include' to some other string by changing the variable `diary-include-string'. (defalias 'mark-included-diary-files #[nil "ebˆÀÁ !ÄQÅÆ#ƒXÇȔȕ{!É\n Ì !ƒGÍ !ƒ7Î ˆÏÐ !!ˆ‚TÑ ˆÒÓ \"ˆÔÈ!ˆ‚TÑ ˆÒÕ \"ˆÔÈ!ˆ*‚eb‡" [re-search-forward "\\(\\`\\| \\|\n\\)" regexp-quote diary-include-string " \"\\([^\"]*\\)\"" nil t substitute-in-file-name 2 mark-included-diary-files mark-diary-entries-hook diary-file file-exists-p file-readable-p mark-diary-entries kill-buffer get-file-buffer beep message "Can't read included diary file %s" sleep-for "Can't find included diary file %s"] 4 (#$ . 19392)]) #@126 Mark all dates in the calendar window that are day DAYNAME of the week. 0 means all Sundays, 1 means all Mondays, and so on. (defalias 'mark-calendar-days-named #[(dayname) "Šqˆ \n \nÉ Ê_\\Ë\\Ì\\‰ ʦT Ê¥)Ê_ \\Î\\‰ ʦT  Ê¥)ÏÌ $‰‰AA@)S‰‰@)‰A@)‰AA@)\fSÕ_\\×Vƒ¾Ø_Ù\\Ú¥Z‰ئÛU…µܦÛU?†µݦÛU)ƒ¾T-Þ_\\Ø¥\\Ü¥[\\Ý¥\\*ÏË$‰‰AA@)S‰‰@)‰A@)‰AA@)\fSÕ_\\×VƒPØ_Ù\\Ú¥Z‰ئÛU…GܦÛU?†GݦÛU)ƒPT-Þ_\\Ø¥\\Ü¥[\\Ý¥\\*\f X…~ßà\f!!ˆ\fá\\‰‚k.‡" [calendar-buffer displayed-month displayed-year nil day last-day succ-year succ-month prev-year prev-month 12 -1 1 macro-y -2 calendar-nth-named-day dayname date prior-years month year 31 day-of-year 2 4 23 10 0 100 400 365 mark-visible-calendar-date calendar-gregorian-from-absolute 7] 7 (#$ . 20418)]) #@115 Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. A value of 0 in any position is a wildcard. (defalias 'mark-calendar-date-pattern #[(month day year) "Šqˆ \n Å_\f\\Æ\\‰ŦTÅ¥)È Ê T‰ Y…NË\f \f %ˆ Å_\f\\È\\Ï\\‰ŦTÅ¥)‚,‡" [calendar-buffer displayed-month displayed-year y m 12 -2 macro-y -1 i 2 mark-calendar-month month day year 1] 7 (#$ . 21315)]) #@135 Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. A value of 0 in any position of the pattern is a wildcard. (defalias 'mark-calendar-month #[(month year p-month p-day p-year) " Uƒ\nÃU„$\f\nU„$ ÃU…y\nÃU„$\f\nU…y ÃUƒsÃ\f‰ÇUƒW\f‰ȦÃU…O\fɦÃU?†O\fʦÃU)ƒWË‚[ÌSH*T‰Y…qÍ\fE!ˆ‚-)‡Í \fE!‡" [month p-month p-year 0 year p-day i 2 4 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] mark-visible-calendar-date] 5 (#$ . 21714)]) #@48 Sort the list of diary entries by time of day. (defalias 'sort-diary-entries #[nil "À Â\"‰‡" [sort diary-entries-list diary-entry-compare] 3 (#$ . 22193)]) #@37 Returns t if E1 is earlier than E2. (defalias 'diary-entry-compare #[(e1 e2) "À \n\"†à @\n@\"…Ä A@!Ä\nA@!W‡" [calendar-date-compare e1 e2 calendar-date-equal diary-entry-time] 3 (#$ . 22356)]) #@249 Time at the beginning of the string S in a military-style integer. For example, returns 1325 for 1:25pm. Returns -9999 if no time is recognized. The recognized forms are XXXX or X:XX or XX:XX (military time), XXam or XXpm, and XX:XXam or XX:XXpm. (defalias 'diary-entry-time #[(s) "ÀÁ\n\"ƒÃ\nĔĕO!Å_Ã\nƔƕO!\\‡ÀÇ\n\"ƒ@Ã\nĔĕO!ȦÅ_\nƔƕOɘƒ=Ê‚>Ë\\‡ÀÌ\n\"ƒnÃ\nĔĕO!ȦÅ_Ã\nƔƕO!\\\n͔͕OɘƒkÊ‚lË\\‡Î‡" [string-match "^[ ]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s string-to-int 1 100 2 "^[ ]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" 12 "a" 0 1200 "^[ ]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" 3 -9999] 5 (#$ . 22560)]) #@7953 Add sexp entries for DATE from the diary file to `diary-entries-list'. Also, Make them visible in the diary file. Returns t if any entries were found. Sexp diary entries must be prefaced by a `sexp-diary-entry-symbol' (normally `%%'). The form of a sexp diary entry is %%(SEXP) ENTRY Both ENTRY and DATE are globally available when the SEXP is evaluated. If the SEXP yields the value nil, the diary entry does not apply. If it yields a non-nil value, ENTRY will be taken to apply to DATE; if the non-nil value is a string, that string will be the diary entry in the fancy diary display. For example, the following diary entry will apply to the 21st of the month if it is a weekday and the Friday before if the 21st is on a weekend: &%%(let ((dayname (calendar-day-of-week date)) (day (extract-calendar-day date))) (or (and (= day 21) (memq dayname '(1 2 3 4 5))) (and (memq day '(19 20)) (= dayname 5))) ) UIUC pay checks deposited A number of built-in functions are available for this type of diary entry: %%(diary-date MONTH DAY YEAR) text Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil, and DAY, MONTH, YEAR if `european-calendar-style' is t. DAY, MONTH, and YEAR can be lists of integers, the constant t, or an integer. The constant t means all values. %%(diary-float MONTH DAYNAME N) text Entry will appear on the Nth DAYNAME of MONTH. (DAYNAME=0 means Sunday, 1 means Monday, and so on; if N is negative it counts backward from the end of the month. MONTH can be a list of months, a single month, or t to specify all months. %%(diary-block M1 D1 Y1 M2 D2 Y2) text Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2, inclusive. (If `european-calendar-style' is t, the order of the parameters should be changed to D1, M1, Y1, D2, M2, Y2.) %%(diary-anniversary MONTH DAY YEAR) text Entry will appear on anniversary dates of MONTH DAY, YEAR. (If `european-calendar-style' is t, the order of the parameters should be changed to DAY, MONTH, YEAR.) Text can contain %d or %d%s; %d will be replaced by the number of years since the MONTH DAY, YEAR and %s will be replaced by the ordinal ending of that number (that is, `st', `nd', `rd' or `th', as appropriate. The anniversary of February 29 is considered to be March 1 in a non-leap year. %%(diary-cyclic N MONTH DAY YEAR) text Entry will appear every N days, starting MONTH DAY, YEAR. (If `european-calendar-style' is t, the order of the parameters should be changed to N, DAY, MONTH, YEAR.) Text can contain %d or %d%s; %d will be replaced by the number of repetitions since the MONTH DAY, YEAR and %s will be replaced by the ordinal ending of that number (that is, `st', `nd', `rd' or `th', as appropriate. %%(diary-remind SEXP DAYS &optional MARKING) text Entry is a reminder for diary sexp SEXP. DAYS is either a single number or a list of numbers indicating the number(s) of days before the event that the warning(s) should occur. If the current date is (one of) DAYS before the event indicated by EXPR, then a suitable message (as specified by `diary-remind-message') appears. In addition to the reminders beforehand, the diary entry also appears on the date itself. If optional MARKING is non-nil then the *reminders* are marked on the calendar. Marking of reminders is independent of whether the entry *itself* is a marking or nonmarking one. %%(diary-day-of-year) Diary entries giving the day of the year and the number of days remaining in the year will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-iso-date) Diary entries giving the corresponding ISO commercial date will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-french-date) Diary entries giving the corresponding French Revolutionary date will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-islamic-date) Diary entries giving the corresponding Islamic date will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-hebrew-date) Diary entries giving the corresponding Hebrew date will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-astro-day-number) Diary entries giving the corresponding astronomical (Julian) day number will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-julian-date) Diary entries giving the corresponding Julian date will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-sunrise-sunset) Diary entries giving the local times of sunrise and sunset will be made every day. Note that since there is no text, it makes sense only if the fancy diary display is used. Floating point required. %%(diary-phases-of-moon) Diary entries giving the times of the phases of the moon will be when appropriate. Note that since there is no text, it makes sense only if the fancy diary display is used. Floating point required. %%(diary-yahrzeit MONTH DAY YEAR) text Text is assumed to be the name of the person; the date is the date of death on the *civil* calendar. The diary entry will appear on the proper Hebrew-date anniversary and on the day before. (If `european-calendar-style' is t, the order of the parameters should be changed to DAY, MONTH, YEAR.) %%(diary-rosh-hodesh) Diary entries will be made on the dates of Rosh Hodesh on the Hebrew calendar. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-parasha) Diary entries giving the weekly parasha will be made on every Saturday. Note that since there is no text, it makes sense only if the fancy diary display is used. %%(diary-omer) Diary entries giving the omer count will be made every day from Passover to Shavuoth. Note that since there is no text, it makes sense only if the fancy diary display is used. Marking these entries is *extremely* time consuming, so these entries are best if they are nonmarking. (defalias 'list-sexp-diary-entries #[(date) "À !À !Å\nÆ\fÇ°É\nebˆËÉÌ#ƒÆÍÎ!ˆ`ɉ‰‰Ô ˆ`{ŠÕÖ!ˆ`)Îuˆ×hØ\"„V×hÙ\"ƒfÚÛ!„fÍÎ!ˆÜ‚š`ËÝÉÌ#ˆÚÛ!ƒ~ËÝÉÌ#ˆ‚oÍÎ!ˆ`{Þß\"ƒšà”ÙIˆ‚ˆá\"#‰#ƒ±ä`ØÙÌ%ˆå\"#\"ˆ\n†¿#\n.‚\n,‡" [regexp-quote diary-nonmarking-symbol mark sexp-diary-entry-symbol sexp-mark "\\(\\`\\| \\|\n\\)" "?" "(" s-entry nil entry-found re-search-forward t backward-char 1 line-start entry-start entry sexp sexp-start forward-sexp re-search-backward " \\|\n\\|\\`" char-equal 13 10 looking-at " \\| " "" " \\|\n" string-match "[ ]" 0 diary-sexp-entry date diary-entry subst-char-in-region add-to-diary-list] 7 (#$ . 23218)]) #@38 Process a SEXP diary ENTRY for DATE. (defalias 'diary-sexp-entry #[(sexp entry date) "ƒÁÃÄ !@!)‚ÆÇȉ ;ƒ  ‚' …'\n)‡" [calendar-debug-sexp t stack-trace-on-error eval read-from-string sexp nil (byte-code "ÀÁ\n!@!‡" [eval read-from-string sexp] 3) ((error (byte-code "À ˆÁŠŒÃ`}ˆebˆÃÅÆÇÈ#ƒ\fT‚\f+ \n$ˆËÌ!‡" [beep message "Bad sexp at line %d in %s: %s" 1 lines re-search-forward "\n\\| " nil t diary-file sexp sleep-for 2] 6))) result entry] 4 (#$ . 31855)]) #@279 Specific date(s) diary entry. Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil, and DAY, MONTH, YEAR if `european-calendar-style' is t. DAY, MONTH, and YEAR can be lists of integers, the constant t, or an integer. The constant t means all values. (defalias 'diary-date #[(month day year) "ƒ ‚ \nƒ\n‚  ‰@) ‰AA@) ‰A@) <ƒ8 >„E š„E É=…}\f<ƒQ\f>„^\fš„^\fÉ=…}\n<ƒl\n>„{\nš„{\nÉ=…} -‡" [european-calendar-style month day dd mm date m y d t year entry] 3 (#$ . 32340)]) #@211 Block diary entry. Entry applies if date is between two dates. Order of the parameters is M1, D1, Y1, M2, D2, Y2 `european-calendar-style' is nil, and D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t. (defalias 'diary-block #[(m1 d1 y1 m2 d2 y2) "ƒ \n E‚\n E‰‰AA@)S\f‰‰@)\f‰A@)\f‰AA@)SÉ_\\\nËVƒv\nÌ_Í\\Î¥Z\n‰̦ÏU…mЦÏU?†mѦÏU)ƒv\nT\n\n- Ò_\\ Ì¥\\ Ð¥[\\ Ñ¥\\*ƒ™E‚ E‰‰AA@)S\f‰‰@)\f‰A@)\f‰AA@)SÉ_\\\nËVƒ\nÌ_Í\\Î¥Z\n‰̦ÏU…þЦÏU?†þѦÏU)ƒ\nT\n\n- Ò_\\ Ì¥\\ Ð¥[\\ Ñ¥\\*\f‰‰AA@)S\f‰‰@)\f‰A@)\f‰AA@)SÉ_\\\nËVƒ„\nÌ_Í\\Î¥Z\n‰̦ÏU…{ЦÏU?†{ѦÏU)ƒ„\nT\n\n- Ò_\\ Ì¥\\ Ð¥[\\ Ñ¥\\*‰X…°X…°+‡" [european-calendar-style d1 m1 y1 date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 d2 m2 y2 d date2 date1 entry] 8 (#$ . 32889)]) #@266 Floating diary entry--entry applies if date is the nth dayname of month. Parameters are MONTH, DAYNAME, N. MONTH can be a list of months, the constant t, or an integer. The constant t means all months. If N is negative, count backward from the end of the month. (defalias 'diary-float #[(month dayname n) "‰@)‰AA@) <ƒ\n >„%\n š„% Ä=…5ÅÆ\n $\"…5 *‡" [date y m month t calendar-date-equal calendar-nth-named-day n dayname entry] 8 (#$ . 33788)]) #@490 Anniversary diary entry. Entry applies if date is the anniversary of MONTH, DAY, YEAR if `european-calendar-style' is nil, and DAY, MONTH, YEAR if `european-calendar-style' is t. Diary entry can contain `%d' or `%d%s'; the %d will be replaced by the number of years since the MONTH DAY, YEAR and the %s will be replaced by the ordinal ending of that number (that is, `st', `nd', `rd' or `th', as appropriate. The anniversary of February 29 is considered to be March 1 in non-leap years. (defalias 'diary-anniversary #[(month day year) "ƒ ‚ \nƒ\n‚  ‰AA@)‰Z\fÉUƒS ÊUƒS‰˦ÌU…KͦÌU?†KΦÌU)„SÏÐÌV…oÑ\f E \"…oÒÔ!#,‡" [european-calendar-style month day d m date y year diff 2 29 4 0 100 400 3 1 calendar-date-equal format entry diary-ordinal-suffix] 6 (#$ . 34260)]) #@372 Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR. If `european-calendar-style' is t, parameters are N, DAY, MONTH, YEAR. ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of years since the MONTH DAY, YEAR and the %s will be replaced by the ordinal ending of that number (that is, `st', `nd', `rd' or `th', as appropriate. (defalias 'diary-cyclic #[(n month day year) "ƒ ‚ \nƒ\n‚  ‰‰AA@)S ‰‰@) ‰A@) ‰AA@)\n SÈ_\\ ÊVƒw Ë_Ì\\Í¥Z ‰˦ÎU…nϦÎU?†nЦÎU)ƒw T  -Ñ_\\Ë¥\\Ï¥[\\Ð¥\\*\f E‰‰AA@)S ‰‰@) ‰A@) ‰AA@)\n SÈ_\\ ÊVƒ÷ Ë_Ì\\Í¥Z ‰˦ÎU…îϦÎU?†îЦÎU)ƒ÷ T  -Ñ_\\Ë¥\\Ï¥[\\Ð¥\\*Z‰¥ÎY…4¦ÎU…4Õ×!#,‡" [european-calendar-style month day d m date prior-years year 31 day-of-year 2 4 23 10 0 100 400 365 diff n cycle format entry diary-ordinal-suffix] 7 (#$ . 35074)]) #@77 Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.) (defalias 'diary-ordinal-suffix #[(n) "Á¦Â>„ÃĦWƒŇÆĦH‡" [n 100 (11 12 13) 3 10 "th" ["th" "st" "nd" "rd"]] 3 (#$ . 35991)]) #@75 Day of year and number of days remaining in the year of date diary entry. (defalias 'diary-day-of-year #[nil "À !‡" [calendar-day-of-year-string date] 2 (#$ . 36206)]) #@275 *Pseudo-pattern giving form of reminder messages in the fancy diary display. Used by the function `diary-remind', a pseudo-pattern is a list of expressions that can involve the keywords `days' (a number), `date' (a list of month, day, year), and `diary-entry' (a string). (defvar diary-remind-message (quote ("Reminder: Only " (if (= 0 (% days 7)) (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks")) (concat (int-to-string days) (if (= 1 days) " day" " days"))) " until " diary-entry)) (#$ . -36381)) #@629 Provide a reminder of a diary entry. SEXP is a diary-sexp. DAYS is either a single number or a list of numbers indicating the number(s) of days before the event that the warning(s) should occur on. If the current date is (one of) DAYS before the event indicated by SEXP, then a suitable message (as specified by `diary-remind-message' is returned. In addition to the reminders beforehand, the diary entry also appears on the date itself. If optional parameter MARKING is non-nil then the reminders are marked on the calendar. Marking of reminders is independent of whether the entry itself is a marking or nonmarking one. (defalias 'diary-remind #[(sexp days &optional marking) "À\nƒ\n ƒÒ\f¨ƒµÅ‰‰AA@)S‰‰@)‰A@) ‰AA@)\n SË_\\\fÍVƒƒ\fÎ_Ï\\Ð¥Z\f\n‰\nΦÑU…z\nÒ¦ÑU?†z\nÓ¦ÑU)ƒƒ\fT\f\f-Ô_\\Î¥\\Ò¥[\\Ó¥\\*\f\\!Õ!‰ƒ±×ÕÙ#)‚Ò\f<ƒÒ\fƒÒÚ\f@ #‰„ÒÚ\fA # †ã\nƒß…ãÕ!)‡" [nil diary-entry marking-diary-entries marking days calendar-gregorian-from-absolute date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 eval sexp mapconcat diary-remind-message "" diary-remind marking-diary-entry] 7 (#$ . 36908)]) #@91 Add the entry (DATE STRING) to `diary-entries-list'. Do nothing if DATE or STRING is nil. (defalias 'add-to-diary-list #[(date string) "… …  DC\"‰‡" [date string append diary-entries-list] 4 (#$ . 38108)]) #@134 Insert a diary entry STRING which may be NONMARKING in FILE. If omitted, NONMARKING defaults to nil and FILE defaults to diary-file. (defalias 'make-diary-entry #[(string &optional nonmarking file) "ÀÁ\nƒ\n\n‚ !!ˆdbˆnƒÄ‚Ń$‚%Äɱ‡" [find-file-other-window substitute-in-file-name file diary-file "" "\n" nonmarking diary-nonmarking-symbol string " "] 4 (#$ . 38329)]) #@98 Insert a diary entry for the date indicated by point. Prefix arg will make the entry nonmarking. (defalias 'insert-diary-entry #[(arg) "ÀÁÂÃ!É#\f\"‡" [make-diary-entry calendar-date-string calendar-cursor-to-date t arg] 5 (#$ . 38718) "P"]) #@116 Insert a weekly diary entry for the day of the week indicated by point. Prefix arg will make the entry nonmarking. (defalias 'insert-weekly-diary-entry #[(arg) "ÀÁÂÃ!!\f\"‡" [make-diary-entry calendar-day-name calendar-cursor-to-date t arg] 4 (#$ . 38967) "P"]) #@118 Insert a monthly diary entry for the day of the month indicated by point. Prefix arg will make the entry nonmarking. (defalias 'insert-monthly-diary-entry #[(arg) "ƒÁ‚ ÂÄÅÆÇ!Ç\"\")‡" [european-calendar-style (day " * ") ("* " day) calendar-date-display-form make-diary-entry calendar-date-string calendar-cursor-to-date t arg] 4 (#$ . 39236) "P"]) #@117 Insert an annual diary entry for the day of the year indicated by point. Prefix arg will make the entry nonmarking. (defalias 'insert-yearly-diary-entry #[(arg) "ƒÁ‚ ÂÄÅÆÇ!Ç\"\")‡" [european-calendar-style (day " " monthname) (monthname " " day) calendar-date-display-form make-diary-entry calendar-date-string calendar-cursor-to-date t arg] 4 (#$ . 39598) "P"]) #@107 Insert an anniversary diary entry for the date given by point. Prefix arg will make the entry nonmarking. (defalias 'insert-anniversary-diary-entry #[(arg) "ƒÁ‚ ÂÄÅÆÈÉÊ!ËÊ##\f\")‡" [european-calendar-style (day " " month " " year) (month " " day " " year) calendar-date-display-form make-diary-entry format "%s(diary-anniversary %s)" sexp-diary-entry-symbol calendar-date-string calendar-cursor-to-date t nil arg] 8 (#$ . 39975) "P"]) #@119 Insert a block diary entry for the days between the point and marked date. Prefix arg will make the entry nonmarking. (defalias 'insert-block-diary-entry #[(arg) "ƒÁ‚ ÂÄÅ!@†ÈÉ!\nË\fË \n‰‰AA@)S‰‰@)‰A@)‰AA@)SÓ_\\ÕVƒ“Ö_×\\Ø¥Z‰Ö¦ÙU…ŠÚ¦ÙU?†ŠÛ¦ÙU)ƒ“T-Ü_\\Ö¥\\Ú¥[\\Û¥\\*‰‰AA@)S‰‰@)‰A@)‰AA@)SÓ_\\ÕVƒÖ_×\\Ø¥Z‰Ö¦ÙU…Ú¦ÙU?†Û¦ÙU)ƒT-Ü_\\Ö¥\\Ú¥[\\Û¥\\*WƒG\n\f ‚O\f\n ÝÞß á\fËÅ#á ËÅ#$\"\"-‡" [european-calendar-style (day " " month " " year) (month " " day " " year) calendar-date-display-form calendar-cursor-to-date t cursor calendar-mark-ring error "No mark set in this buffer" mark nil start end date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 make-diary-entry format "%s(diary-block %s %s)" sexp-diary-entry-symbol calendar-date-string arg] 10 (#$ . 40425) "P"]) #@109 Insert a cyclic diary entry starting at the date given by point. Prefix arg will make the entry nonmarking. (defalias 'insert-cyclic-diary-entry #[(arg) "ƒÁ‚ ÂÄÅÆÈÉÊ\"ËÌÍ!ÎÍ#$\")‡" [european-calendar-style (day " " month " " year) (month " " day " " year) calendar-date-display-form make-diary-entry format "%s(diary-cyclic %d %s)" sexp-diary-entry-symbol calendar-read "Repeat every how many days: " (lambda (x) (> x 0)) calendar-date-string calendar-cursor-to-date t nil arg] 9 (#$ . 41376) "P"]) (provide (quote diary-lib)) emacs-19.30/lisp/diff.elc100666 12062 1 12374 5751546162 13462 0ustar bobdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:21:04 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/diff.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/diff.el' was compiled for Emacs 19")) (require (quote compile)) #@75 *A string or list of strings specifying switches to be be passed to diff. (defvar diff-switches "-c" (#$ . -503)) #@34 *The command to use to run diff. (defvar diff-command "diff" (#$ . -623)) #@327 Alist (REGEXP OLD-IDX NEW-IDX) of regular expressions to match difference sections in \[diff] output. If REGEXP matches, the OLD-IDX'th subexpression gives the line number in the old file, and NEW-IDX'th subexpression gives the line number in the new file. If OLD-IDX or NEW-IDX is nil, REGEXP matches only half a section. (defvar diff-regexp-alist (quote (("^@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@$" 1 2) ("^\\*\\*\\* \\([0-9]+\\),[0-9]+ \\*\\*\\*\\*$" 1 nil) ("^--- \\([0-9]+\\),[0-9]+ ----$" nil 1) ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]\\([0-9]+\\)\\(,[0-9]+\\)?$" 1 3) ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]$" 1) ("^[adc]\\([0-9]+\\)\\( [0-9]+\\)?$" 1))) (#$ . 704)) #@61 This is the old file name in the comparison in this buffer. (defvar diff-old-file nil (#$ . 1388)) #@61 This is the new file name in the comparison in this buffer. (defvar diff-new-file nil (#$ . 1493)) #@68 This is the name of a temp file to be deleted after diff finishes. (defvar diff-old-temp-file nil (#$ . 1598)) #@68 This is the name of a temp file to be deleted after diff finishes. (defvar diff-new-temp-file nil (#$ . 1715)) (defalias 'diff-parse-differences #[(limit-search find-at-least) "ÀÂÃ!ˆ\fƒ \fbˆÅÆÈ#É\nËÌ\")ÍÀÎÀ„žÕÀÖ#ƒž‰ƒS@@”„SA‰„B@‰A@ƒhA@\"ˆØ8ƒyØ8\"ˆTƒ‹Y„—ƒ,`Yƒ,Ö‰ƒ1ƒ¨`‚ªdÂÜ!ˆ. Ÿ‰‡" [nil compilation-error-list message "Parsing differences..." compilation-parsing-end mapconcat #[(elt) "À @ÂQ‡" ["\\(" elt "\\)"] 3] diff-regexp-alist "\\|" 1 subexpr mapcar #[(elt) "Á A\"BÄ @!Å\\\\‡" [subexpr mapcar #[(n) "… \\‡" [n subexpr] 2] elt count-regexp-groupings 1] 4] #[(file subexpr) "Š”bˆÁyˆÂ )Ô•{!ŠÅ ÇŽÈ !qˆ*ŠÊ\f!ˆÂ +B B‰ ‡" [subexpr 0 point-marker string-to-int line match-data match-data ((store-match-data match-data)) find-file-noselect file goto-line compilation-error-list] 4] 0 g num-loci-found found-desired new-error groups regexp re-search-forward t diff-old-file 2 diff-new-file find-at-least limit-search "Parsing differences...done"] 7]) #@222 Find and display the differences between OLD and NEW files. Interactively the current buffer's file name is the default for NEW and a backup file for NEW is the default for OLD. With prefix arg, prompt for diff switches. (defalias 'diff #[(old new &optional switches) "À !À\n!Ã\n!à !ÄÄŽÈÉÊ C\fƒ2\f:ƒ,\f‚@\fC‚@ :ƒ= ‚@ C„J…OÎ\nÎ FφV\n!Cφ_ !C%Ð#ÒÓÔÕ$Ö !ˆ×Ø!\nLˆ×Ù! Lˆ×Ú!Lˆ×Û!Lˆ×Ü!ÝLˆ -‡" [expand-file-name new old file-local-copy nil buf new-alt old-alt mapconcat identity append diff-command switches diff-switches "-L" shell-quote-argument " " command compile-internal "No more differences" "Diff" diff-parse-differences pop-to-buffer make-local-variable diff-old-file diff-new-file diff-old-temp-file diff-new-temp-file compilation-finish-function #[(buff msg) "ƒÁ!ˆ\n…Á\n!‡" [diff-old-temp-file delete-file diff-new-temp-file] 2]] 9 (#$ . 2771) (byte-code "À‰à ‰ƒÄ !ƒÅÆÇ !ÈQÀ É$‚%ÅÊÀ‰É$‰Ë !‰ƒEÄ\n!ƒEÅÌÇ\n!ÈQÍ\n!\nÉ$‚MÅÎÍ !ÀÉ$‰DŸ*…lÐÑ;ƒd‚jÓÔÕ#\"C¤‡" [nil newf oldf buffer-file-name file-exists-p read-file-name "Diff new file: (" file-name-nondirectory ") " t "Diff new file: " file-newest-backup "Diff original file: (" file-name-directory "Diff original file: " current-prefix-arg read-string "Diff switches: " diff-switches mapconcat identity " "] 8)]) #@220 Diff this file with its backup file or vice versa. Uses the latest backup, if there are several numerical backups. If this file is a backup, diff it with its original. The backup file is the first file given to `diff'. (defalias 'diff-backup #[(file &optional switches) "À‰Ã\f!ƒ\fÅ\f!‚ Æ\f!†ÇÈ\f\"\fÉ\n \n#*‡" [nil ori bak backup-file-name-p file file-name-sans-versions diff-latest-backup-file error "No backup found for %s" diff switches] 4 (#$ . 4109) (list (read-file-name "Diff (file with backup): ") (if current-prefix-arg (read-string "Diff switches: " (if (stringp diff-switches) diff-switches (mapconcat (quote identity) diff-switches " "))) nil))]) #@52 Return the latest existing backup of FILE, or nil. (defalias 'diff-latest-backup-file #[(fn) "À Â\"‰ƒ  \"‚PÄÅ !!Æ !È!…$)†PÉ !@\nË\n!\fÍÎ\n!!ÏP‰G\fÒÓ\f\"Ô\"@P,)‡" [find-file-name-handler fn diff-latest-backup-file handler file-chase-links expand-file-name make-backup-file-name bak file-exists-p find-backup-file-name backupname file-name-directory dir file-name-sans-versions file-name-nondirectory ".~" base-versions bv-length sort file-name-all-completions #[(fn1 fn2) "À !À\n!V‡" [backup-extract-version fn1 fn2] 3]] 6 (#$ . 4786)]) (provide (quote diff)) emacs-19.30/lisp/dired-aux.elc100666 12062 1 120150 6021170177 14432 0ustar bobdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Aug 30 19:12:20 1995 ;;; from file /home/fsf/rms/e19/lisp/dired-aux.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`dired-aux.el' was compiled for Emacs 19.29 or later")) #@232 Compare file at point with file FILE using `diff'. FILE defaults to the file at the mark. The prompted-for file is the first file given to `diff'. With prefix arg, prompt for second argument SWITCHES, which is options for `diff'. (defalias 'dired-diff #[(file &optional switches) #@59 ("À ÂÃ!\f#‡" . [diff file dired-get-filename t switches])(#$ . 761) nil 4 (#$ . 474) (byte-code "ÀÁ!…ŠÀÁ!bˆÂÁ‰\")ÄÅ!ˆÆÇÈÂÁ! ƒ'É ÊQ‚(Ë#Ì Á$ …GÎÏ;ƒ@‚FÑÒÓ#\")D‡" [mark t dired-get-filename default require diff read-file-name format "Diff %s with: %s" "(default " ") " "" dired-current-directory current-prefix-arg read-string "Options for diff: " diff-switches mapconcat identity " "] 7)]) #@295 Diff this file with its backup file or vice versa. Uses the latest backup, if there are several numerical backups. If this file is a backup, diff it with its original. The backup file is the first file given to `diff'. With prefix arg, prompt for argument SWITCHES which is options for `diff'. (defalias 'dired-backup-diff #[(&optional switches) #@58 ("ÀÁ \n\"‡" . [diff-backup dired-get-filename switches])(#$ . 1523) nil 3 (#$ . 1171) (byte-code "…Á ;ƒ ‚ÄÅ Æ#\"C‡" [current-prefix-arg read-string "Options for diff: " diff-switches mapconcat identity " "] 6)]) (defalias 'dired-do-chxxx #[(attribute-name program op-symbol arg) #@339 ("ÀÁ\n\"ÄÅÇQÈ \n %\n Ì\nQ ÈÏÐÑ  \nE $Ò\n!ˆ…=0ÓÔÕ \"È\",‡" . [dired-get-marked-files t arg files dired-mark-read-string "Change " attribute-name " of %s to: " nil op-symbol new-attribute program " " operation failures dired-bunch-files 10000 dired-check-process dired-do-redisplay dired-log-summary format "%s: error"])(#$ . 1817) nil 6]) #@114 Change the mode of the marked (or next ARG) files. This calls chmod, thus symbolic modes like `g+w' are allowed. (defalias 'dired-do-chmod #[(&optional arg) #@71 ("ÀÁ\nÃ\f$‡" . [dired-do-chxxx "Mode" dired-chmod-program chmod arg])(#$ . 2344) nil 5 (#$ . 2181) "P"]) #@53 Change the group of the marked (or next ARG) files. (defalias 'dired-do-chgrp #[(&optional arg) #@147 ("Á>ƒ\n0ÂÃ!ˆÄÅÆÇ$‡" . [system-type (ms-dos windows-nt) error "chgrp not supported on this system." dired-do-chxxx "Group" "chgrp" chgrp arg])(#$ . 2558) nil 5 (#$ . 2455) "P"]) #@53 Change the owner of the marked (or next ARG) files. (defalias 'dired-do-chown #[(&optional arg) #@160 ("Á>ƒ\n0ÂÃ!ˆÄÅÇ$‡" . [system-type (ms-dos windows-nt) error "chown not supported on this system." dired-do-chxxx "Owner" dired-chown-program chown arg])(#$ . 2848) nil 5 (#$ . 2745) "P"]) (defalias 'dired-bunch-files #[(max function args files) #@217 ("ÀÁÀ ƒH0 @‰GÇ\\ A \fƒ60 \\\nVƒ60Ë\fÍ\f\"\"\n¤ÀÁ \f¡ˆ  \\ +‚0Ë\fÍ\f\"\"\n¤+‡" . [nil 0 failures pending-length pending files thisfile 3 thislength rest max apply function append args])(#$ . 3106) nil 6]) #@129 Print the marked (or next ARG) files. Uses the shell command coming from variables `lpr-command' and `lpr-switches' as default. (defalias 'dired-do-print #[(&optional arg) #@252 ("ÀÁ\n\"ÄÅÆÇ ;ƒ0 C‚0 BÊ#Ë\n %\fÍÎ\f Ï#!*‡" . [dired-get-marked-files t arg file-list dired-mark-read-string "Print %s with: " mapconcat identity lpr-command lpr-switches " " print command dired-run-shell-command dired-shell-stuff-it nil])(#$ . 3527) nil 6 (#$ . 3348) "P"]) (defalias 'dired-mark-read-string #[(prompt initial op-symbol arg files) #@126 ("ÀÁ\n ÄÅÇ \"\" &‡" . [dired-mark-pop-up nil op-symbol files read-string format prompt dired-mark-prompt arg initial])(#$ . 3893) nil 10]) (byte-code "À BÀ‡" [dired-file-version-alist current-load-list] 2) #@353 Flag numerical backups for deletion. Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest. Positive prefix arg KEEP overrides `dired-kept-versions'; Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive. To clear the flags on these files, you can use \[dired-flag-backup-files] with a prefix argument. (defalias 'dired-clean-directory #[(keep) #@503 ("ƒ\n0Á!‚ 0\n‰ÃWƒ0[‚0\fÃXƒ\"0\n‚#0ÅÉÊ#ˆËÌ!ˆ‰ ƒx0ÎÏ @AÐ\"B‰G‰\\Vƒf0›Z›¡ˆ @A¡ˆ* A‰ „>0)ËÓ!ˆÉÔ!+‡" . [keep prefix-numeric-value dired-kept-versions 0 kept-old-versions nil dired-file-version-alist late-retention early-retention message "Cleaning numerical backups (keeping %d late, %d old)..." dired-map-dired-file-lines dired-collect-file-versions fval q sort < sorted-v-list v-count dired-trample-file-versions "Cleaning numerical backups...done"])(#$ . 4514) nil 5 (#$ . 4113) "P"]) (defalias 'dired-map-dired-file-lines #[(fun) #@145 ("ŠÀ‰ebˆm?…00ŠÃ\f!„)0l„)0ÅÀÆ\"‰ƒ)0Àˆ\n!ˆ)Èyˆ‚0+‡" . [nil buffer-read-only file looking-at dired-re-dir dired-get-filename t fun 1])(#$ . 5104) nil 3]) (defalias 'dired-collect-file-versions #[(fn) #@280 ("À ! \"?…40Ä !ÅP‰GÈÉ !\"\nËÌ\n\"‰ …30  B B‰,)‡" . [file-name-sans-versions fn assoc dired-file-version-alist file-name-nondirectory ".~" base-versions bv-length file-name-all-completions file-name-directory possibilities mapcar backup-extract-version versions])(#$ . 5320) nil 5]) (defalias 'dired-trample-file-versions #[(fn) #@211 ("ÀÁ\n\"Ä …00Æ\nÇ O\"‰…00É\n Ê\\ÄO! >?…00ÇyˆËÌ!ˆ c*‡" . [string-match "\\.~[0-9]+~$" fn start-vn nil base-version-list assoc 0 dired-file-version-alist string-to-int 2 delete-char 1 dired-del-marker])(#$ . 5671) nil 4]) #@72 Quote a file name for inferior shell (see variable `shell-file-name'). (defalias 'dired-shell-quote #[(filename) #@135 ("ÀÁÂÆÇ\f#ƒ'0Á” \f OÉ ‰TOR T‚0 \fÂOP+‡" . ["" 0 nil end start result string-match "[^-0-9a-zA-Z_./]" filename "\\"])(#$ . 6026) nil 6 (#$ . 5906)]) (defalias 'dired-read-shell-command #[(prompt arg files) #@135 ("ÀÁ ÄÅÇ \"\"ÁÉ&‡" . [dired-mark-pop-up nil shell files read-string format prompt dired-mark-prompt arg shell-command-history])(#$ . 6255) nil 10]) #@791 Run a shell command COMMAND on the marked files. If no files are marked or a specific numeric prefix arg is given, the next ARG files are used. Just \[universal-argument] means the current file. The prompt mentions the file(s) or the marker, as appropriate. If there is output, it goes to a separate buffer. Normally the command is run on each file individually. However, if there is a `*' in the command then it is run just once with the entire file list substituted there. No automatic redisplay of dired buffers is attempted, as there's no telling what files the command may have changed. Type \[dired-do-redisplay] to redisplay the marked files. The shell command has the top level directory as working directory, so output files usually are created there instead of in a subdir. (defalias 'dired-do-shell-command #[(command &optional arg) #@305 ("ÀÁ\n\"?ÄÅ\" ƒ0ÈÉ\nGZÊË$‚(0ÌÍ\nË$!*‡" . [string-match "\\*" command on-each dired-get-marked-files t arg file-list dired-bunch-files 10000 #[(&rest files) "ÀÁ\n Ä $!‡" [dired-run-shell-command dired-shell-stuff-it command files t arg] 6] nil dired-run-shell-command dired-shell-stuff-it])(#$ . 7273) nil 6 (#$ . 6416) (list (dired-read-shell-command (concat "! on " "%s: ") current-prefix-arg (dired-get-marked-files t current-prefix-arg)) current-prefix-arg)]) #@52 Prepended to marked files in dired shell commands. (defvar dired-mark-prefix "" (#$ . 7756)) #@51 Appended to marked files in dired shell commands. (defvar dired-mark-postfix "" (#$ . 7855)) #@49 Separates marked files in dired shell commands. (defvar dired-mark-separator " " (#$ . 7954)) (defalias 'dired-shell-stuff-it #[(command file-list on-each &optional raw-arg) #@338 ("ÀÁ\n\"ƒ 0Â\f0ă0Ç ÈÉ\n\"Ë#‚=0ÇÉ\n\f# \nGÎVƒ80 Q  !))‡" . [string-match "\\*" command #[(x) "ÀÁ\n #‡" [dired-replace-in-string "\\*" x command] 4] #[(x) "Á\nQ‡" [command " " x] 3] stuff-it on-each mapconcat mapcar dired-shell-quote file-list ";" dired-mark-separator fns 1 dired-mark-prefix dired-mark-postfix])(#$ . 8135) nil 5]) (defalias 'dired-run-shell-command #[(command) #@42 ("À !ˆÂ‡" . [shell-command command nil])(#$ . 8544) nil 2]) (defalias 'dired-call-process #[(program discard &rest arguments) #@72 ("ÀÁ\nÃ\f?à &‡" . [apply call-process program nil discard arguments])(#$ . 8676) nil 7]) (defalias 'dired-check-process #[(msg program &rest arguments) #@333 ("À‰ ÅÆ\"ˆŠÈÉ!‰qˆÊ ˆ\nËÌ À$ÏU?‰ƒG0Ð ÑÒ!ÓR!ˆÐ\f!ˆ†R0 †R0Ô‚R0Õ\f!ˆÅÖ\"ˆÀ,‡" . [nil default-directory dir err err-buffer message "%s..." msg get-buffer-create " *dired-check-process output*" erase-buffer apply dired-call-process program arguments 0 dired-log " " prin1-to-string "\n" t kill-buffer "%s...done"])(#$ . 8836) nil 6]) (defalias 'dired-kill-line #[(&optional arg) #@272 ("À !‰ ÅU„M0ÆÂÇ\"‰„0ÈÉ!ˆ‚0Š ƒ,0Ê !ƒ,0Ë ˆ)Åyˆ`Ìyˆ`|ˆ ÅVƒD0 S‰‚ 0 TÍyˆ‚0Î *‡" . [prefix-numeric-value arg nil file buffer-read-only 0 dired-get-filename t error "Can only kill file lines." dired-goto-subdir dired-kill-subdir 1 -1 dired-move-to-filename])(#$ . 9239) nil 4 nil "P"]) #@313 Kill all marked lines (not the files). With a prefix argument, kill that many lines starting with the current line. (A negative argument kills lines before the current line.) To kill an entire subdirectory, go to its directory header line and use this command with a prefix argument (the value does not matter). (defalias 'dired-do-kill-lines #[(&optional arg fmt) #@379 ("ƒ0Á ƒ\f0 ‡Ã!‡ŠebˆÄÅ„E0È  m„A0Ê ÄË#ƒA0TÅyˆ`Ìyˆ`|ˆ‚\"0)‚k0m„k0Í „T0ÎÏ!„Z0Ìyˆ‚E0T`ŠÌyˆ`)|ˆ‚E0К„0Ò†y0ÓÔ!#ˆ+‡" . [arg dired-get-subdir dired-kill-subdir dired-kill-line nil 0 count buffer-read-only dired-marker-regexp regexp re-search-forward t 1 dired-between-files looking-at "^ " "" fmt message "Killed %d line%s." dired-plural-s])(#$ . 9916) nil 5 (#$ . 9544) "P"]) (defalias 'dired-compress #[nil #@235 ("À Ä !‰ƒ\"0`ÀÇȈbˆÉ !ˆ)À‚)0ÊË P!ˆ +‡" . [nil buffer-read-only dired-get-filename from-file dired-compress-file new-file start (dired-remove-entry new-file) ((error)) dired-update-file-line dired-log "Failed to compress"])(#$ . 10368) nil 4]) (defalias 'dired-compress-file #[(file) #@590 ("À Â\"‰ƒ0  \"‚u0Ä !ƒ0Å‚u0ÅÇÈ \")ƒ70ÉÊ PË #?…u0 ÌÍO‚u0ÅÇÎ \")ƒT0ÉÊ PÏ #?…u0 ÌÐO‚u0ÅÇÑ \")ƒq0ÉÊ PÏ #?…u0 ÌÍO‚u0ÅÒÓ)‡" . [find-file-name-handler file dired-compress-file handler file-symlink-p nil case-fold-search string-match "\\.Z$" dired-check-process "Uncompressing " "uncompress" 0 -2 "\\.gz$" "gunzip" -3 "\\.z$" (byte-code "ÀÁ\nPÃÄ\n$?…0Å\nÆP!ƒ0\nÆP‡\nÇP‡" [dired-check-process "Compressing " file "gzip" "-f" file-exists-p ".gz" ".z"] 5) ((file-error (byte-code "ÀÁ\nPÃÄ\n$?…0\nÅP‡" [dired-check-process "Compressing " file "compress" "-f" ".Z"] 5)))])(#$ . 10669) nil 5]) (defalias 'dired-mark-confirm #[(op-symbol arg) #@252 (" >†/0ÂÃ\f\"Å=ƒ0Æ‚0ÇÈ!! \nËÌ\nÍ ÎÏ\f\n\"ÐR%*‡" . [op-symbol dired-no-confirm dired-get-marked-files t arg compress "Compress or uncompress" capitalize symbol-name string files dired-mark-pop-up nil y-or-n-p " " dired-mark-prompt "? "])(#$ . 11333) nil 10]) (defalias 'dired-map-over-marks-check #[(fun arg op-symbol &optional show-progress) #@770 ("À \n\"…á0ɉ‰\nƒ50\n¨ƒ.0È\nÉ\"ˆ\nÊWƒ*0\fŸ‚•0\f‚•0 C‚•0Ì Ã ŠebˆÏÃÐ#…K0Ñ ‰ ?? ƒ‡0 bˆƒc0ÓÊ!ˆ \fB bˆÔyˆ É“ˆÏÃÐ#…0Ñ ‰ „V0) ƒ0\f‚”0 C*,Õ ˆ‰GØÃ\"‰G Û=ƒ´0Ü‚¹0ÝÞ !!_„Î0àá_â!$‚à0ãäå_—â!%\"-‡" . [dired-mark-confirm op-symbol arg nil results found case-fold-search buffer-read-only dired-repeat-over-lines #[nil "ƒ0ÁÂ!ˆ \fB‰‡" [show-progress sit-for 0 fun results] 2] 0 fun dired-marker-regexp next-position regexp re-search-forward t point-marker show-progress sit-for 1 dired-move-to-filename total-list total delq failures count compress "Compress or uncompress" capitalize symbol-name string message "%s: %d file%s." dired-plural-s dired-log-summary format "Failed to %s %d of %d file%s"])(#$ . 11696) nil 9]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp dired-query-alist ((121 . y) (32 . y) (110 . n) (127 . n) (33 . yes) (113 . no) (27 . no)) current-load-list] 2) (defalias 'dired-query #[(qs-var qs-prompt &rest qs-args) #@423 ("J \"A‰Å=ƒ0Æ‚t0\fÇ=ƒ0È‚t0 \nƒ00ËÌÍÎ!!\"‚10ÐPȉÔÕ#ˆ× L \"‰„n0ÕØ\"ˆÙ ˆÚÛ!ˆÔÕ#ˆ× L‚G0AÜ>+*‡" . [qs-var char assoc dired-query-alist action yes t no nil qs-prompt help-form format " [Type yn!q or %s] " key-description char-to-string help-char " [Type y, n, q or !] " elt result qprompt apply message qs-args read-char "Invalid char - type %c for help." ding sit-for 1 (t y yes)])(#$ . 12699) nil 7]) #@52 Compress or uncompress marked (or next ARG) files. (defalias 'dired-do-compress #[(&optional arg) #@75 ("ÀÁ\nÃÄ$‡" . [dired-map-over-marks-check dired-compress arg compress t])(#$ . 13251) nil 5 (#$ . 13147) "P"]) (defalias 'dired-byte-compile #[nil #@379 ("À ÂÂÂÆÇÈˆÉ !Ê !„0Ë ƒ*0ÌÍ #ˆÎ !‚60Ï !ˆÂyˆÐ !ˆÂ,‡" . [dired-get-filename filename nil elc-file buffer-read-only failure err (byte-code "ŠÀ !ˆ)À‡" [byte-compile-file filename] 2) ((error (byte-code "‡" [err failure nil] 1))) byte-compile-dest-file file-exists-p t dired-log "Byte compile error for %s:\n%s\n" dired-make-relative dired-remove-file dired-add-file])(#$ . 13405) nil 4]) #@53 Byte compile marked (or next ARG) Emacs Lisp files. (defalias 'dired-do-byte-compile #[(&optional arg) #@83 ("ÀÁ\nÃÄ$‡" . [dired-map-over-marks-check dired-byte-compile arg byte-compile t])(#$ . 13918) nil 5 (#$ . 13809) "P"]) (defalias 'dired-load #[nil #@226 ("À ÁÄÅƈ\n…0ÇÈ \n#ˆÉ !*‡" . [dired-get-filename nil failure file err (byte-code "À ‰Ã$‡" [load file nil t] 5) ((error (byte-code "‡" [err failure nil] 1))) dired-log "Load error for %s:\n%s\n" dired-make-relative])(#$ . 14072) nil 4]) #@49 Load the marked (or next ARG) Emacs Lisp files. (defalias 'dired-do-load #[(&optional arg) #@67 ("ÀÁ\nÃÄ$‡" . [dired-map-over-marks-check dired-load arg load t])(#$ . 14420) nil 5 (#$ . 14323) "P"]) #@179 Redisplay all marked (or next ARG) files. If on a subdir line, redisplay that subdirectory. In that case, a prefix arg lets you edit the `ls' switches used for the new listing. (defalias 'dired-do-redisplay #[(&optional arg test-for-subdir) #@819 ("ƒ0Á ƒ0ÂÁ …0ÄÅ\"\"‡ÇÈ!ˆÉ\n:ƒ(0\n@‚*0\n!ˆË‰‰‰\f  ƒf0 ¨ƒS0Ð Ñ\"ˆ ÒWƒÕ0\fŸˆ‚Õ0Ó ÇÕ\"ˆÖ!ˆ)‚Õ0× ËŠebˆÚËÛ#…|0Ü ‰?? ƒ¾0bˆÓ ÇÕ\"ˆÖ!)\fB\fbˆÝyˆˉ“ˆÚËÛ#…¸0Ü ‰„ˆ0) „Ô0Ó ÇÕ\"ˆÖ!ˆ)*,Þ ˆÞ ˆÇß!‡" . [test-for-subdir dired-get-subdir dired-insert-subdir arg read-string "Switches for listing: " dired-actual-switches message "Redisplaying..." dired-uncache dired-directory nil results found case-fold-search buffer-read-only dired-repeat-over-lines #[nil "À Âà \"ˆÄ !) B‰‡" [dired-get-filename fname message "Redisplaying... %s" dired-update-file-line results] 3] 0 dired-get-filename fname "Redisplaying... %s" dired-update-file-line dired-marker-regexp next-position regexp re-search-forward t point-marker 1 dired-move-to-filename "Redisplaying...done"])(#$ . 14779) nil 6 (#$ . 14530) "P\np"]) (defalias 'dired-update-file-line #[(file) #@156 ("Àyˆg`Á`Åyˆ`|ˆƒ\"0Ç!ˆÈ ‰TÉ\f$ˆ+Ê ‡" . [0 nil buffer-read-only opoint char 1 file dired-add-entry subst-char-in-region 32 dired-move-to-filename])(#$ . 15687) nil 5]) (defalias 'dired-fun-in-all-buffers #[(directory fun &rest args) #@204 ("ÀÁ\n!!pɃ40@AÈŽ qˆÉ\n \"ƒ00Ì !\fB)‚0\f,‡" . [dired-buffers-for-dir expand-file-name directory nil success-list buf obuf buf-list ((set-buffer obuf)) apply fun args buffer-name])(#$ . 15934) nil 4]) (defalias 'dired-add-file #[(filename &optional marker-char) #@104 ("ÀÁ\n!Ã\n\f$‡" . [dired-fun-in-all-buffers file-name-directory filename dired-add-entry marker-char])(#$ . 16225) nil 5]) (defalias 'dired-add-entry #[(filename &optional marker-char) #@897 ("À !` à !Ä Ê !Ë̉ƒ%0 bˆ -?‡" . [directory-file-name filename dired-current-directory file-name-directory nil reason directory orig-file-name cur-dir opoint file-name-nondirectory not-found (byte-code " ˜ƒ'0ÂÃwˆgÄ=ƒ0Å ˆÆ !`Wƒ#0bˆ)‚A0È!ƒ<0ÉÊ!ƒ60Å ˆË ˆ‚A0ÌÍÎ\"ˆÃ‰Ñyˆ`Ò!ˆÕØP\"ˆ)bˆÙÚ!Ü!ƒƒ0ÈÝG[!ˆcˆÞuˆ‚†0Þyˆ)ß`\"ˆàyˆ!ƒ¨0ŠŒÑyˆ`ŠÞyˆ`)}ˆâá!ˆ*ã ˆ*Ç" [directory cur-dir "^ \n" nil 13 dired-unhide-subdir dired-after-subdir-garbage p dired-goto-subdir looking-at " " dired-goto-next-nontrivial-file throw not-found "Subdir not found" opoint buffer-read-only 0 dired-add-entry-do-indentation marker-char default-directory insert-directory filename dired-actual-switches "d" dired-get-filename no-dir inserted-name file-name-directory delete-char 1 dired-insert-set-properties -1 dired-after-readin-hook run-hooks dired-move-to-filename] 4)])(#$ . 16417) nil 6]) (defalias 'dired-add-entry-do-indentation #[(marker-char) #@69 ("ƒ0¨ƒ 0‚0 ‚0±‡" . [marker-char dired-marker-char 32])(#$ . 17397) nil 2]) (defalias 'dired-after-subdir-garbage #[(dir) #@120 ("ŠÀ !„ 0ÂÃ!ˆÄyˆl„0Å „0Äyˆ‚0`)‡" . [dired-goto-subdir dir error "This cannot happen" 1 dired-move-to-filename])(#$ . 17538) nil 2]) (defalias 'dired-remove-file #[(file) #@89 ("ÀÁ\n!Ã\n#‡" . [dired-fun-in-all-buffers file-name-directory file dired-remove-entry])(#$ . 17721) nil 4]) (defalias 'dired-remove-entry #[(file) #@80 ("ŠÀ !…0ÂÄyˆ`ŠÅyˆ`)|))‡" . [dired-goto-file file nil buffer-read-only 0 1])(#$ . 17874) nil 2]) (defalias 'dired-relist-file #[(file) #@89 ("ÀÁ\n!Ã\n#‡" . [dired-fun-in-all-buffers file-name-directory file dired-relist-entry])(#$ . 18017) nil 4]) (defalias 'dired-relist-entry #[(file) #@150 ("À‰ŠÃ\f!ƒ0Åyˆg`ŠÆyˆ`)|ˆÇ\f!È\f É=?…'0 \"+‡" . [nil marker buffer-read-only dired-goto-file file 0 1 directory-file-name dired-add-entry 32])(#$ . 18171) nil 4]) #@125 *Non-nil if Dired should ask about making backups before overwriting files. Special value `always' suppresses confirmation. (defvar dired-backup-overwrite nil (#$ . -18347)) (byte-code "À BÀ‡" [dired-overwrite-confirmed current-load-list] 2) (defalias 'dired-handle-overwrite #[(to) #@264 ("…-0 …-0Â=„0ÃÄÅÆ\"\"…-0È!@ Ê Ë#ˆÌ !)‡" . [dired-backup-overwrite dired-overwrite-confirmed always dired-query overwrite-backup-query format "Make backup for existing file `%s'? " to find-backup-file-name backup rename-file 0 dired-relist-entry])(#$ . 18638) nil 5]) (defalias 'dired-copy-file #[(from to ok-flag) #@96 ("À !ˆÂ \f $‡" . [dired-handle-overwrite to copy-file from ok-flag dired-copy-preserve-time])(#$ . 18974) nil 5]) (defalias 'dired-rename-file #[(from to ok-flag) #@233 ("À !ˆÂ \f#ˆÅ !ƒ$0ŠÅ !qˆÆ È !ˆÉ!ˆ*Ê !ˆË \"‡" . [dired-handle-overwrite to rename-file from ok-flag get-file-buffer buffer-modified-p modflag set-visited-file-name set-buffer-modified-p dired-remove-file dired-rename-subdir])(#$ . 19145) nil 4]) (defalias 'dired-rename-subdir #[(from-dir to-dir) #@405 ("À !À\n!Ã Ä \n$ˆÅ !Æ …W0Š@qˆ ƒL0Ê \"ƒL0Ë ÌÍÎ !P\n #Ñ!ˆÒ!ˆ*)A‰„0Ó*‡" . [file-name-as-directory from-dir to-dir dired-fun-in-all-buffers dired-rename-subdir-1 expand-file-name buffer-list blist expanded-from-dir buffer-file-name dired-in-this-tree buffer-modified-p dired-replace-in-string "^" regexp-quote to-file modflag set-visited-file-name set-buffer-modified-p nil])(#$ . 19455) nil 6]) (defalias 'dired-rename-subdir-1 #[(dir to) #@366 ("À !\nà ƒ&0 @ AÇ\f@\"ƒ 0È\f  #ˆ‚ 0 \nš…V0Ë !ˆ \nÀÌ ! \" ÌÎ !!Ð!„S0Ñ!ˆ)Ò +‡" . [expand-file-name dir dired-subdir-alist nil elt alist expanded-dir dired-in-this-tree dired-rename-subdir-2 to default-directory dired-unadvertise file-name-nondirectory dired-directory directory-file-name new-name get-buffer rename-buffer dired-advertise])(#$ . 19930) nil 4]) (defalias 'dired-rename-subdir-2 #[(elt dir to) #@426 ("ŠÀÁ\n!!Á !ÄÈ !bˆÊ !„$0ÌÍ\n\"ˆ‚D0ΔbˆÏΕÐ#ƒ<0ÑЉ#ˆ‚D0ÌÒ\n @#ˆ ÓÔ @#! ,‡" . [regexp-quote directory-file-name dir to nil buffer-read-only newtext regexp dired-get-subdir-min elt looking-at dired-subdir-regexp error "%s not found where expected - dired-subdir-alist broken?" 1 re-search-forward t replace-match "Expected to find `%s' in headerline of %s" dired-normalize-subdir dired-replace-in-string])(#$ . 20370) nil 6]) (defalias 'dired-create-files #[(file-creator operation fn-list name-constructor &optional marker-char) #@1318 ("À‰Á\nGÀ‰‰ ÊË\n\"ˆ+ƒ20ÌÍÎG Ð !%\"ˆ‚R0 ƒH0ÌÍÑ G Ð !% \"ˆ‚R0ÒÓ\fÐ\f!$ˆ,Ô ‡" . [nil 0 fn-list total success-count skipped failures overwrite-backup-query overwrite-query to mapcar #[(from) " !‰ šƒ0ÃÄÅ— #ˆ\n„\"0Ç !B‰‡É\n!‰\n…40Ë\fÍÎÏ\n#)¨ƒA0‚M0ƒL0Ò !‚M0ÃÔÕÖ+‡" [name-constructor from to nil dired-log "Cannot %s to same file: %s\n" operation dired-make-relative skipped file-exists-p overwrite (format "Type SPC or `y' to overwrite file `%s',\nDEL or `n' to skip to next,\nESC or `q' to not overwrite any of the remaining files,\n`!' to overwrite all remaining files with no more questions." to) help-form dired-query overwrite-query "Overwrite `%s'?" dired-overwrite-confirmed marker-char dired-file-marker actual-marker-char err (byte-code " \n #ˆ\fƒ0Å\n!ˆTÇÈ \n$ˆË\n\f\"‡" [file-creator from to dired-overwrite-confirmed overwrite dired-remove-file success-count message "%s: %d of %d" operation total dired-add-file actual-marker-char] 5) ((file-error (byte-code "À !\nBÃÄ %‡" [dired-make-relative from failures dired-log "%s `%s' to `%s' failed:\n%s\n" operation to err] 6)))] 5] dired-log-summary format "%s failed for %d of %d file%s" operation dired-plural-s "%s: %d of %d file%s skipped" message "%s: %s file%s" dired-move-to-filename])(#$ . 20927) nil 8]) (defalias 'dired-do-create-files #[(op-symbol file-creator operation arg &optional marker-char op1 how-to) #@594 ("„0 ÂÃ\f\"‰GÇÈÉUƒ0‚0 ÊPË \f\fÍÎ \"%!„80Ñ!‚H0Ò=ƒC0ÂH0!ÉVƒ]0„]0ÔÕ #ˆ„h0Ö!× ƒv0Ù‚w0Ú%,‡" . [op1 operation dired-get-marked-files nil arg fn-list fn-count expand-file-name dired-mark-read-file-name 1 " %s to: " dired-dwim-target-directory op-symbol mapcar dired-make-relative target how-to file-directory-p t into-dir error "Marked %s: target must be a directory: %s" directory-file-name dired-create-files file-creator #[(from) "ÀÁ\n! \"‡" [expand-file-name file-name-nondirectory from target] 3] #[(from) "‡" [target] 1] marker-char])(#$ . 22378) nil 10]) (defalias 'dired-mark-read-file-name #[(prompt dir op-symbol arg files) #@125 ("ÀÁ\n ÄÅÇ \"\" &‡" . [dired-mark-pop-up nil op-symbol files read-file-name format prompt dired-mark-prompt arg dir])(#$ . 23071) nil 10]) (defalias 'dired-dwim-target-directory #[nil #@182 ("Á=…0 \fƒ,0ÅÆ !ŠqˆÁ=… 0 )‰†(0 *‚-0 )‡" . [major-mode dired-mode dired-current-directory this-dir dired-dwim-target window-buffer next-window other-buf other-dir])(#$ . 23268) nil 3]) #@38 Create a directory called DIRECTORY. (defalias 'dired-create-directory #[(directory) #@138 ("ÀÁ\n!!Ä !ˆÅ !ˆÆ )‡" . [directory-file-name expand-file-name directory expanded make-directory dired-add-file dired-move-to-filename])(#$ . 23567) nil 3 (#$ . 23475) (list (read-file-name "Create directory: " (dired-current-directory)))]) (defalias 'dired-into-dir-with-symlinks #[(target) #@62 ("À !…\n0 !?‡" . [file-directory-p target file-symlink-p])(#$ . 23865) nil 2]) #@369 Copy all marked (or next ARG) files, or copy the current file. This normally preserves the last-modified date when copying. When operating on just the current file, you specify the new name. When operating on multiple or marked files, you specify a directory, and new copies of these files are made in that directory with the same names that the files currently have. (defalias 'dired-do-copy #[(&optional arg) #@145 ("ÀÁ ƒ 0Ä‚\f0Å%‡" . [dired-do-create-files copy dired-copy-file dired-copy-preserve-time "Copy [-p]" "Copy" arg dired-keep-marker-copy])(#$ . 24371) nil 6 (#$ . 23953) "P"]) #@308 Make symbolic links to current file or all marked (or next ARG) files. When operating on just the current file, you specify the new name. When operating on multiple or marked files, you specify a directory and new symbolic links are made in that directory with the same names that the files currently have. (defalias 'dired-do-symlink #[(&optional arg) #@108 ("ÀÁÂÃ\f %‡" . [dired-do-create-files symlink make-symbolic-link "Symlink" arg dired-keep-marker-symlink])(#$ . 24919) nil 6 (#$ . 24559) "P"]) #@304 Add names (hard links) current file or all marked (or next ARG) files. When operating on just the current file, you specify the new name. When operating on multiple or marked files, you specify a directory and new hard links are made in that directory with the same names that the files currently have. (defalias 'dired-do-hardlink #[(&optional arg) #@109 ("ÀÁÂÃ\f %‡" . [dired-do-create-files hardlink add-name-to-file "Hardlink" arg dired-keep-marker-hardlink])(#$ . 25427) nil 6 (#$ . 25070) "P"]) #@184 Rename current file or all marked (or next ARG) files. When renaming just the current file, you specify the new name. When renaming multiple or marked files, you specify a directory. (defalias 'dired-do-rename #[(&optional arg) #@111 ("ÀÁÂÃ\f Æ&‡" . [dired-do-create-files move dired-rename-file "Move" arg dired-keep-marker-rename "Rename"])(#$ . 25814) nil 7 (#$ . 25579) "P"]) (defalias 'dired-do-create-files-regexp #[(file-creator operation arg regexp newname &optional whole-path marker-char) #@1015 ("ÀÁ\n\"‰G ÆPÈÉ — —#\n ƒ_0Ì‚ 0ÍÁÐ %.‡" . [dired-get-marked-files nil arg fn-list fn-count operation " `%s' to `%s'?" operation-prompt format "Type SPC or `y' to %s one match, DEL or `n' to skip to next,\n`!' to %s all remaining matches with no more questions." rename-regexp-help-form whole-path #[(from) "À \n #\f‰ƒ0ÇÈ \n$…$0‚$0ÊË\f\n $*‡" [dired-string-replace-match regexp from newname rename-regexp-help-form help-form to dired-query rename-regexp-query operation-prompt dired-log "%s: %s did not match regexp %s\n" operation] 6] #[(from) "À  !\f#‰…0Æ Ç !\" \nƒ10ËÌ Î !Î!$…:0‚:0ÏР! $+‡" [dired-string-replace-match regexp file-name-nondirectory from newname new expand-file-name file-name-directory to rename-regexp-help-form help-form dired-query rename-regexp-query operation-prompt dired-make-relative dired-log "%s: %s did not match regexp %s\n" operation] 7] regexp-name-constructor rename-regexp-query dired-create-files file-creator marker-char])(#$ . 26088) nil 7]) (defalias 'dired-mark-read-regexp #[(operation) #@234 ("À !š‰?…\f0 Å ƒ0Æ‚0ÇÉQ!\nË ƒ'0Æ‚(0ÇÌ\nÍ°!\n\f F,‡" . [prefix-numeric-value current-prefix-arg 0 whole-path arg dired-read-regexp "Path " "" operation " from (regexp): " regexp read-string " " " to: " newname])(#$ . 27177) nil 7]) #@441 Rename marked files containing REGEXP to NEWNAME. As each match is found, the user must type a character saying what to do with it. For directions, type \[help-command] at that time. NEWNAME may contain \=\ or \& as in `query-replace-regexp'. REGEXP defaults to the last regexp used. With a zero prefix arg, renaming by regexp affects the complete pathname - usually only the non-directory part of file names is used and changed. (defalias 'dired-do-rename-regexp #[(regexp newname &optional arg whole-path) #@135 ("ÀÁ \f &‡" . [dired-do-create-files-regexp dired-rename-file "Rename" arg regexp newname whole-path dired-keep-marker-rename])(#$ . 27962) nil 8 (#$ . 27437) (dired-mark-read-regexp "Rename")]) #@103 Copy all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info. (defalias 'dired-do-copy-regexp #[(regexp newname &optional arg whole-path) #@179 ("ÀÁ\nƒ\n0 0Ä  &‡" . [dired-do-create-files-regexp dired-copy-file dired-copy-preserve-time "Copy [-p]" "Copy" arg regexp newname whole-path dired-keep-marker-copy])(#$ . 28355) nil 8 (#$ . 28170) (dired-mark-read-regexp "Copy")]) #@107 Hardlink all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info. (defalias 'dired-do-hardlink-regexp #[(regexp newname &optional arg whole-path) #@138 ("ÀÁ \f &‡" . [dired-do-create-files-regexp add-name-to-file "HardLink" arg regexp newname whole-path dired-keep-marker-hardlink])(#$ . 28798) nil 8 (#$ . 28605) (dired-mark-read-regexp "HardLink")]) #@106 Symlink all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info. (defalias 'dired-do-symlink-regexp #[(regexp newname &optional arg whole-path) #@138 ("ÀÁ \f &‡" . [dired-do-create-files-regexp make-symbolic-link "SymLink" arg regexp newname whole-path dired-keep-marker-symlink])(#$ . 29202) nil 8 (#$ . 29011) (dired-mark-read-regexp "SymLink")]) (defalias 'dired-create-files-non-directory #[(file-creator basename-constructor operation arg) #@508 ("À \fÅÀ\"Ç%)‡" . [nil rename-non-directory-query dired-create-files file-creator operation dired-get-marked-files arg #[(from) "À !\nà !!PÅÆ——#ÉÊËPÌ !Ì\f!$)…'0\f)‡" [file-name-directory from basename-constructor file-name-nondirectory to format "Type SPC or `y' to %s one file, DEL or `n' to skip to next,\n`!' to %s all remaining matches with no more questions." operation help-form dired-query rename-non-directory-query " `%s' to `%s'" dired-make-relative] 6] dired-keep-marker-rename])(#$ . 29510) nil 6]) (defalias 'dired-rename-non-directory #[(basename-constructor operation arg) #@105 ("ÀÁ\n \f$‡" . [dired-create-files-non-directory dired-rename-file basename-constructor operation arg])(#$ . 30121) nil 5]) #@54 Rename all marked (or next ARG) files to upper case. (defalias 'dired-upcase #[(&optional arg) #@70 ("ÀÁ #‡" . [dired-rename-non-directory upcase "Rename upcase" arg])(#$ . 30352) nil 4 (#$ . 30251) "P"]) #@54 Rename all marked (or next ARG) files to lower case. (defalias 'dired-downcase #[(&optional arg) #@74 ("ÀÁ #‡" . [dired-rename-non-directory downcase "Rename downcase" arg])(#$ . 30567) nil 4 (#$ . 30464) "P"]) #@432 Insert this subdirectory into the same dired buffer. If it is already present, just move to it (type \[dired-do-redisplay] to refresh), else inserts it at its natural place (as `ls -lR' would have done). With a prefix arg, you may edit the ls switches used for this listing. You can add `R' to the switches to expand the whole tree starting at this subdirectory. This function takes some pains to conform to `ls -lR' output. (defalias 'dired-maybe-insert-subdir #[(dirname &optional switches no-error-if-not-dir-p) #@160 ("`Á\n! „0Ä\n!„0Å\n #ˆÇ!)‡" . [opoint file-name-as-directory dirname switches dired-goto-subdir dired-insert-subdir no-error-if-not-dir-p push-mark])(#$ . 31212) nil 4 (#$ . 30684) (list (dired-get-filename) (if current-prefix-arg (read-string "Switches for listing: " dired-actual-switches)))]) #@404 Insert this subdirectory into the same dired buffer. If it is already present, overwrites previous entry, else inserts it at its natural place (as `ls -lR' would have done). With a prefix arg, you may edit the `ls' switches used for this listing. You can add `R' to the switches to expand the whole tree starting at this subdirectory. This function takes some pains to conform to `ls -lR' output. (defalias 'dired-insert-subdir #[(dirname &optional switches no-error-if-not-dir-p) #@634 ("ÀÁ\n!!Ã\n\f\"ˆ „0Æ\n!„0ÇÈ\n\"ˆÉ\n\n\"ˉ‰‰\f \f…50ÑÒ\f\"‰ƒA0Ó\nÔ\"ƒR0Õ!¤‚V0Ö\n!ˆ×\nØ\n\f\"#ˆƒh0Ù ˆÚ\n!ˆŠÛ!.‡" . [file-name-as-directory expand-file-name dirname dired-insert-subdir-validate switches no-error-if-not-dir-p file-directory-p error "Attempt to insert a non-directory: %s" assoc dired-subdir-alist nil buffer-read-only case-fold-search mark-alist switches-have-R elt string-match "R" dired-kill-tree t dired-insert-subdir-del dired-insert-subdir-newpos dired-insert-subdir-doupdate dired-insert-subdir-doinsert dired-build-subdir-alist dired-initial-position dired-mark-remembered])(#$ . 32018) nil 6 (#$ . 31524) (list (dired-get-filename) (if current-prefix-arg (read-string "Switches for listing: " dired-actual-switches)))]) (defalias 'dired-insert-subdir-validate #[(dirname &optional switches) #@338 ("À  !\"„0ÄÅ \"ˆ…0ÇÉÊË\")‡" . [dired-in-this-tree dirname expand-file-name default-directory error "%s: not in this directory tree" switches nil case-fold-search mapcar #[(x) "À \n\"?À \"?=†0ÄÅ \"‡" [string-match x switches dired-actual-switches error "Can't have dirs with and without -%s switches together"] 4] ("F" "b")])(#$ . 32875) nil 4]) (defalias 'dired-alist-add #[(dir new-marker) #@70 ("À \n\"ˆÃ ‡" . [dired-alist-add-1 dir new-marker dired-alist-sort])(#$ . 33284) nil 3]) (defalias 'dired-alist-sort #[nil #@104 ("À Â\"‰‡" . [sort dired-subdir-alist #[(elt1 elt2) "À !À\n!V‡" [dired-get-subdir-min elt1 elt2] 3]])(#$ . 33414) nil 3]) (defalias 'dired-kill-tree #[(dirname &optional remember-marks) #@216 ("À !\nɃ70@@A ˜„ 0Ç \"ƒ 0È !ƒ 0É\n!\f¤‚ 0\f+‡" . [expand-file-name dirname dired-subdir-alist nil m-alist dir s-alist dired-in-this-tree dired-goto-subdir dired-kill-subdir remember-marks])(#$ . 33608) nil 3 nil "DKill tree below directory: "]) (defalias 'dired-insert-subdir-newpos #[(new-dir) #@208 ("Á‰‰‰ƒ30@A @Ç !È\f \"ƒ 0Ê !Á‰„0\nbˆ-m„>0ËyˆÌcˆ`‡" . [dired-subdir-alist nil new-pos pos dir elt alist dired-get-subdir-min dired-tree-lessp new-dir dired-get-subdir-max -1 "\n"])(#$ . 33935) nil 6]) (defalias 'dired-insert-subdir-del #[(element) #@125 ("À !‰bˆÃ bˆm„0ÄuˆÅ\n`\"\n`|ˆ)‡" . [dired-get-subdir-min element begin-marker dired-subdir-max -1 dired-remember-marks])(#$ . 34216) nil 4]) (defalias 'dired-insert-subdir-doinsert #[(dirname switches) #@451 ("`ÀÃÄ \"ˆ†0ÇÈÉ\n#\n Ë\f!@@šƒ)0Í!ˆ‚;0`Ð \nÀÑ$ˆÒ`\"ˆ))ÃÓ \"ˆÔ Õ\n Ö#ˆ\nbˆ× !ˆ\nØ !D À‰“ˆ*‡" . [nil end begin message "Reading directory %s..." dirname switches dired-replace-in-string "R" "" dired-actual-switches reverse dired-subdir-alist dired-readin-insert dired-directory opoint insert-directory t dired-insert-set-properties "Reading directory %s...done" point-marker indent-rigidly 2 dired-insert-headerline marker-position])(#$ . 34428) nil 5]) (defalias 'dired-insert-subdir-doupdate #[(dirname elt beg-end) #@185 ("ƒ0Á! Óˆ‚0Ä Â \"ˆ…40Š@A@‰ bˆŒ }ˆÊÆ!,‡" . [elt dired-get-subdir-min point-marker nil dired-alist-add dirname dired-after-readin-hook beg-end end begin run-hooks])(#$ . 34969) nil 4]) (defalias 'dired-tree-lessp #[(dir1 dir2) #@252 ("À !À\n!ÃÄ \"ÃÄ\n\"ƒ00 ƒ00@ @šƒ00A A‚0@ @‰ƒJ0ƒJ0™‚m0„X0„X0É‚m0„a0Ê‚m0„j0É‚m0ËÌ!,‡" . [file-name-as-directory dir1 dir2 dired-split "/" components-2 components-1 c2 c1 nil t error "This can't happen"])(#$ . 35222) nil 5]) #@283 Splitting on regexp PAT, turn string STR into a list of substrings. Optional third arg LIMIT (>= 1) is a limit to the length of the resulting list. Thus, if SEP is a regexp that only matches itself, (mapconcat 'identity (dired-split SEP STRING) SEP) is always equal to STRING. (defalias 'dired-split #[(pat str &optional limit) #@188 ("À \n\"\nÄ OCÆ …0Ä•‰ƒJ0 ¨ƒ(0 WƒJ0À \n#ƒJ0Ä”T\n O BÄ•‰‚0 ¨ƒX0 Wƒe0ƒe0\nÊO B Ÿ,‡" . [string-match pat str start 0 result 1 count end limit nil])(#$ . 35840) nil 5 (#$ . 35500)]) #@129 Go to previous subdirectory, regardless of level. When called interactively and not on a subdir line, go to this subdir's line. (defalias 'dired-prev-subdir #[(arg &optional no-error-if-not-found no-skip) #@70 ("À [\n #‡" . [dired-next-subdir arg no-error-if-not-found no-skip])(#$ . 36278) nil 4 (#$ . 36067) (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) (if (dired-get-subdir) 1 0)))]) (defalias 'dired-subdir-min #[nil #@77 ("ŠÀÁ‰#„0ÃÄ!‚0`)‡" . [dired-prev-subdir 0 t error "Not in a subdir!"])(#$ . 36521) nil 4]) #@163 Go to end of header line of DIR in this dired buffer. Return value of point on success, otherwise return nil. The next char is either \n, or \r if DIR is hidden. (defalias 'dired-goto-subdir #[(dir) #@129 ("À ! \"‰…0Å\f!b…0ÆÇwˆ`)‡" . [file-name-as-directory dir assoc dired-subdir-alist elt dired-get-subdir-min "^ \n" nil])(#$ . 36830) nil 4 (#$ . 36624) (byte-code "ÀÁ ÄÅÆ %!CÇ ˆ‡" [expand-file-name completing-read "Goto in situ directory: " dired-subdir-alist nil t dired-current-directory push-mark] 7)]) #@37 Mark all files except `.' and `..'. (defalias 'dired-mark-subdir-files #[nil #@88 ("À  à \")‡" . [dired-subdir-min p-min dired-mark-files-in-region dired-subdir-max])(#$ . 37233) nil 3 (#$ . 37150) nil]) #@72 Remove all lines of current subdirectory. Lower levels are unaffected. (defalias 'dired-kill-subdir #[(&optional remember-marks) #@291 ("À Á ‰Ç ‰šƒ0ÉÊ!ˆ …#0Ì \" |ˆmƒ00ÍÎ!ˆÏ !ˆ,‡" . [dired-subdir-min dired-subdir-max nil cur-dir buffer-read-only end beg dired-current-directory default-directory error "Attempt to kill top level directory" remember-marks dired-remember-marks delete-char -1 dired-unsubdir])(#$ . 37499) nil 5 (#$ . 37363) nil]) (defalias 'dired-unsubdir #[(dir) #@57 ("ÀÁ\n \" \"‰‡" . [delq assoc dir dired-subdir-alist])(#$ . 37866) nil 4]) #@37 Go up ARG levels in the dired tree. (defalias 'dired-tree-up #[(arg) #@189 ("À \nÃYƒ0\nSÄÅ !!‚0Æ !†_0ÇÈ \")‡" . [dired-current-directory dir arg 1 file-name-directory directory-file-name dired-goto-subdir error "Cannot go up to %s - not in this tree."])(#$ . 38024) nil 3 (#$ . 37948) "p"]) #@28 Go down in the dired tree. (defalias 'dired-tree-down #[nil #@254 ("À Á‰Å!Áƒ60@AÉÊ@!\f\"ƒ0ÁË@!‚0* ƒ@0 b‚C0ÌÍ!+‡" . [dired-current-directory nil case-fold-search pos dir reverse dired-subdir-alist elt rest dired-in-this-tree directory-file-name dired-goto-subdir error "At the bottom"])(#$ . 38322) nil 3 (#$ . 38255) nil]) (defalias 'dired-unhide-subdir #[nil #@104 ("ÀÂÃ Ä ÅÆ$)‡" . [nil buffer-read-only subst-char-in-region dired-subdir-min dired-subdir-max 13 10])(#$ . 38656) nil 5]) (defalias 'dired-hide-check #[nil #@100 ("†0ÁÂ!‡" . [selective-display error "selective-display must be t for subdir hiding to work!"])(#$ . 38820) nil 2]) (defalias 'dired-subdir-hidden-p #[(dir) #@81 ("… 0ŠÁ\n!ˆÃÄ!)‡" . [selective-display dired-goto-subdir dir looking-at " "])(#$ . 38986) nil 2]) #@160 Hide or unhide the current subdirectory and move to next directory. Optional prefix arg is a repeat factor. Use \[dired-hide-all] to (un)hide all directories. (defalias 'dired-hide-subdir #[(arg) #@341 ("À ˆ S‰ÂY…P0à Å\f!Ç\f\" Ê !S Ì Î !bˆÏÌwˆƒ?0Ð` ÑÒ$ˆ‚G0Ð` ÒÑ$ˆ-ÓÔÕ\"ˆ‚0‡" . [dired-hide-check arg 0 dired-current-directory cur-dir dired-subdir-hidden-p hidden-p assoc dired-subdir-alist elt dired-get-subdir-max end-pos nil buffer-read-only dired-get-subdir-min "^\n " subst-char-in-region 13 10 dired-next-subdir 1 t])(#$ . 39296) nil 5 (#$ . 39093) "p"]) #@192 Hide all subdirectories, leaving only their header lines. If there is already something hidden, make everything visible again. Use \[dired-hide-subdir] to (un)hide a particular subdirectory. (defalias 'dired-hide-all #[(arg) #@238 ("À ˆÁŠebˆÃÄÁÅ#)ƒ0ÆedÇÈ$‚M0d \n \n…L0ÆÌ\n@!Š bˆÍyˆ`)ÈÇ$ˆÌ\n@! \nA‰\n„'0Á*)‡" . [dired-hide-check nil buffer-read-only search-forward " " t subst-char-in-region 13 10 dired-subdir-alist alist pos dired-get-subdir-min -1])(#$ . 39912) nil 6 (#$ . 39680) "P"]) #@159 Search through all marked files for a match for REGEXP. Stops when a match is found. To continue searching for next match, use command \[tags-loop-continue]. (defalias 'dired-do-search #[(regexp) #@60 ("À Â\"‡" . [tags-search regexp (dired-get-marked-files)])(#$ . 40395) nil 3 (#$ . 40193) "sSearch marked files (regexp): "]) #@253 Do `query-replace-regexp' of FROM with TO, on all marked files. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\[keyboard-quit] or ESC), you can resume the query replace with the command \[tags-loop-continue]. (defalias 'dired-do-query-replace #[(from to &optional delimited) #@80 ("À \n Ä$‡" . [tags-query-replace from to delimited (dired-get-marked-files)])(#$ . 40852) nil 5 (#$ . 40528) "sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP"]) (provide (quote dired-aux)) emacs-19.30/lisp/dired-x.elc100666 75424 13 103264 6032175020 14077 0ustar kwzhuser;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Sep 27 03:14:57 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/dired-x.el ;;; emacs version 19.29.12. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`dired-x.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require dired dired-aux] 2) #@181 *t says "V" in dired-mode will `dired-vm', otherwise "V" is `dired-rmail'. Also, RMAIL files contain -*- rmail -*- at the top so "f", `dired-advertised-find-file', will run rmail. (defvar dired-bind-vm nil (#$ . -532)) #@57 *t says bind `dired-jump' to C-x C-j, otherwise do not. (defvar dired-bind-jump t (#$ . -757)) #@66 *t says bind `dired-man' to "N" in dired-mode, otherwise do not. (defvar dired-bind-man t (#$ . -858)) #@67 *t says bind `dired-info' to "I" in dired-mode, otherwise do not. (defvar dired-bind-info t (#$ . -967)) #@218 *If t, \[dired-vm] will visit all folders read-only. If neither nil nor t, e.g. the symbol `if-file-read-only', only files not writable by you are visited read-only. Read-only folders only work in VM 5, not in VM 4. (defvar dired-vm-read-only-folders nil (#$ . -1079)) #@254 *If non-nil, "uninteresting" files are not listed (buffer-local). Use \[dired-omit-toggle] to toggle its value. Uninteresting files are those whose filenames match regexp `dired-omit-files', plus those ending with extensions in `dired-omit-extensions'. (defvar dired-omit-files-p nil (#$ . -1356)) (make-variable-buffer-local (quote dired-omit-files-p)) #@273 *Filenames matching this regexp will not be displayed. This only has effect when `dired-omit-files-p' is t. See interactive function `dired-omit-toggle' (\[dired-omit-toggle]) and variable `dired-omit-extensions'. The default is to omit `.', `..', and auto-save files. (defvar dired-omit-files "^#\\|^\\.$\\|^\\.\\.$" (#$ . -1717)) #@417 *If non-nil, Dired always finds a directory in a buffer of its own. If nil, Dired finds the directory as a subdirectory in some other buffer if it is present as one. If there are several Dired buffers for a directory, the most recently used is chosen. Dired avoids switching to the current buffer, so that if you have a normal and a wildcard buffer for the same directory, C-x d RET will toggle between those two. (defvar dired-find-subdir nil (#$ . -2059)) #@332 *Control use of local-variables lists in dired. The value can be t, nil or something else. A value of t means local-variables lists are obeyed; nil means they are ignored; anything else means query. This temporarily overrides the value of `enable-local-variables' when listing a directory. See also `dired-local-variables-file'. (defvar dired-enable-local-variables t (#$ . -2526)) #@207 *If non-nil, name of GNU tar executable (e.g., "tar" or "gtar") and `z' switch will be used for compressed or gzip'ed tar files. If no GNU tar, set to nil: a pipe using `zcat' or `gunzip -c' will be used. (defvar dired-guess-shell-gnutar nil (#$ . -2917)) #@68 *non-nil says pass -q to gzip overriding verbose GZIP environment. (defvar dired-guess-shell-gzip-quiet t (#$ . -3180)) #@70 *If non-nil, then string of switches passed to `znew', example: "-K" (defvar dired-guess-shell-znew-switches nil (#$ . -3306)) #@73 *t says offer to kill buffers visiting files and dirs deleted in dired. (defvar dired-clean-up-buffers-too t (#$ . -3439)) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆƒMÀ ÙÚ#ˆƒXÀ ÜÝ#ˆƒkÀàá#ˆÀâã#ˆäåæ\"ˆäçè\"‡" [define-key dired-mode-map "ï" dired-omit-toggle "¨" dired-mark-sexp "¡" dired-smart-shell-command "T" dired-do-toggle "w" dired-copy-filename-as-kill "ç" dired-goto-file "Ç" dired-goto-subdir "F" dired-do-find-marked-files "Y" dired-do-relsymlink "%Y" dired-do-relsymlink-regexp "V" dired-do-run-mail dired-bind-man "N" dired-man dired-bind-info "I" dired-info dired-bind-jump global-map "\n" dired-jump "4\n" dired-jump-other-window add-hook dired-mode-hook dired-extra-startup dired-after-readin-hook dired-omit-expunge] 4) #@1155 Automatically put on dired-mode-hook to get extra dired features: \ \[dired-do-run-mail] -- run mail on folder (see `dired-bind-vm') \[dired-info] -- run info on file \[dired-man] -- run man on file \[dired-do-find-marked-files] -- visit all marked files simultaneously \[dired-omit-toggle] -- toggle omitting of files \[dired-do-toggle] -- toggle marks \[dired-mark-sexp] -- mark by lisp expression \[dired-copy-filename-as-kill] -- copy the file or subdir names into the kill ring. You can feed it to other commands using \[yank]. For more features, see variables dired-bind-vm dired-bind-jump dired-bind-info dired-bind-man dired-vm-read-only-folders dired-omit-files-p dired-omit-files dired-omit-extensions dired-find-subdir dired-enable-local-variables dired-local-variables-file dired-guess-shell-gnutar dired-guess-shell-gzip-quiet dired-guess-shell-znew-switches dired-guess-shell-alist-user dired-clean-up-buffers-too See also functions dired-flag-extension dired-virtual dired-jump dired-man dired-vm dired-rmail dired-info dired-do-find-marked-files  (defalias 'dired-extra-startup #[nil "À ˆÁ ‡" [dired-hack-local-variables dired-omit-startup] 1 (#$ . 4232) nil]) (defalias 'dired-clean-up-after-deletion #[(fn) "ŠAƒÁ\n!ƒà ˆ)\f…fÅ\n!‰ƒ/ÇÈÉÊ\n!\"!ƒ/ŠË!ˆ))ÌÍ\n!!Ή…eÇÈÐÑG!Ê\n!#!…e…eŠË@!ˆ)A‰„SÎ*‡" [dired-subdir-alist dired-goto-subdir fn dired-kill-subdir dired-clean-up-buffers-too get-file-buffer buf y-or-n-p format "Kill buffer of %s, too? " file-name-nondirectory kill-buffer dired-buffers-for-dir expand-file-name nil buf-list "Kill dired buffer%s of %s, too? " dired-plural-s] 7]) #@128 Mark all files with a certain extension for use in later commands. A `.' is not automatically prepended to the string entered. (defalias 'dired-mark-extension #[(extension &optional marker-char) "<„CÁÂÃÄÅÆ#ÇR\"‡" [extension dired-mark-files-regexp "." "\\(" mapconcat regexp-quote "\\|" "\\)$" marker-char] 7 (#$ . 5959) "sMarking extension: \nP"]) #@127 In dired, flag all files with a certain extension for deletion. A `.' is *not* automatically prepended to the string entered. (defalias 'dired-flag-extension #[(extension) "À \n\"‡" [dired-mark-extension extension dired-del-marker] 3 (#$ . 6323) "sFlagging extension: "]) #@73 List of extensions of dispensable files created by the `patch' program. (defvar dired-patch-unclean-extensions (quote (".rej" ".orig")) (#$ . 6601)) #@57 List of extensions of dispensable files created by TeX. (defvar dired-tex-unclean-extensions (quote (".toc" ".log" ".aux")) (#$ . 6756)) #@59 List of extensions of dispensable files created by LaTeX. (defvar dired-latex-unclean-extensions (quote (".idx" ".lof" ".lot" ".glo")) (#$ . 6899)) #@60 List of extensions of dispensable files created by BibTeX. (defvar dired-bibtex-unclean-extensions (quote (".blg" ".bbl")) (#$ . 7053)) #@61 List of extensions of dispensable files created by texinfo. (defvar dired-texinfo-unclean-extensions (quote (".cp" ".cps" ".fn" ".fns" ".ky" ".kys" ".pg" ".pgs" ".tp" ".tps" ".vr" ".vrs")) (#$ . 7195)) #@102 Flag dispensable files created by patch for deletion. See variable `dired-patch-unclean-extensions'. (defalias 'dired-clean-patch #[nil "À !‡" [dired-flag-extension dired-patch-unclean-extensions] 2 (#$ . 7404) nil]) #@220 Flag dispensable files created by [La]TeX etc. for deletion. See variables `dired-texinfo-unclean-extensions', `dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions' and `dired-texinfo-unclean-extensions'. (defalias 'dired-clean-tex #[nil "ÀÁ\n \f $!‡" [dired-flag-extension append dired-texinfo-unclean-extensions dired-latex-unclean-extensions dired-bibtex-unclean-extensions dired-tex-unclean-extensions] 6 (#$ . 7628) nil]) #@228 Flag dispensable files created by [La]TeX *and* ".dvi" for deletion. See variables `dired-texinfo-unclean-extensions', `dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions' and `dired-texinfo-unclean-extensions'. (defalias 'dired-very-clean-tex #[nil "ÀÁ\n \f ÆC%!‡" [dired-flag-extension append dired-texinfo-unclean-extensions dired-latex-unclean-extensions dired-bibtex-unclean-extensions dired-tex-unclean-extensions ".dvi"] 7 (#$ . 8076) nil]) #@281 Jump to dired buffer corresponding to current buffer. If in a file, dired the current directory and move to file's line. If in dired already, pop up a level and goto old directory's line. In case the proper dired file line cannot be found, refresh the dired buffer and try again. (defalias 'dired-jump #[(&optional other-window) "‰ƒ\f !‚  Æ=ƒ.Ç È !ˆÊ\f!†[ËÂ\f!!ˆÊ\f!‚[ ƒ:Ì\f!ˆ‚>Í\f!ˆ …[Ê !†[ÎÏ!ˆÊ !†[Ë !!ˆÊ !*‡" [buffer-file-name file file-name-directory default-directory dir major-mode dired-mode dired-current-directory dired-up-directory other-window dired-goto-file dired-insert-subdir dired-other-window dired dired-omit-toggle t] 4 (#$ . 8546) "P"]) #@54 Like \[dired-jump] (dired-jump) but in other window. (defalias 'dired-jump-other-window #[nil "ÀÁ!‡" [dired-jump t] 2 (#$ . 9228) nil]) #@217 Toggle marks. That is, currently marked files become unmarked and vice versa. Files marked with other flags (such as `D') are not affected. `.' and `..' are never toggled. As always, hidden subdirs are not affected. (defalias 'dired-do-toggle #[nil "ŠebˆÀm?…4 „.Ã\f!„.ÅÆ``TgÇ=ƒ(ÇD‚,ÇD$ˆÉyˆ‚*‡" [nil buffer-read-only dired-between-files looking-at dired-re-dot apply subst-char-in-region 32 dired-marker-char 1] 6 (#$ . 9371) nil]) #@400 Copy names of marked (or next ARG) files into the kill ring. The names are separated by a space. With a zero prefix arg, use the complete pathname of each marked file. With \[universal-argument], use the relative pathname of each marked file. If on a subdir headerline, use subdirname instead; prefix arg is ignored in this case. You can then feed the file name(s) to other commands with \[yank]. (defalias 'dired-copy-filename-as-kill #[(&optional arg) "À †/Á ƒ*Ä !ÅUƒÆ ‚- ¨ƒ$ÆÇ \"‚-ÆÈ!‚-ÆÇ!É#\nË\n!ˆÌÍ\n\")‡" [dired-get-subdir mapconcat identity arg prefix-numeric-value 0 dired-get-marked-files no-dir t " " string kill-new message "%s"] 5 (#$ . 9822) "P"]) #@226 The LOCALP argument dired-omit-expunge passes to dired-get-filename. If it is 'no-dir, omitting is much faster, but you can only match against the basename of the file. Set it to nil if you need to match the whole pathname. (defvar dired-omit-localp (quote no-dir) (#$ . 10504)) #@103 Temporary marker used by by dired-omit. Should never be used as marker by the user or other packages. (defvar dired-omit-marker-char 15 (#$ . 10791)) (defalias 'dired-omit-startup #[nil "À ž†\fÂà \"‰‡" [dired-omit-files-p minor-mode-alist append ((dired-omit-files-p " Omit"))] 3]) #@266 Toggle omitting files matching `dired-omit-files' and `dired-omit-extensions'. With an arg, and if omitting was off, don't toggle and just mark the files but don't actually omit them. With an arg, and if omitting was on, turn it off but don't refresh the buffer. (defalias 'dired-omit-toggle #[(&optional flag) "ƒ ƒ ?‰‡Âà ĉ $‡ ?‰„Æ ‡Ç ‡" [flag dired-omit-files-p dired-mark-unmarked-files dired-omit-regexp nil dired-omit-localp revert-buffer dired-omit-expunge] 6 (#$ . 11082) "P"]) #@371 If non-nil, a list of extensions (strings) to omit from Dired listings. Defaults to elements of `completion-ignored-extensions', `dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions', and `dired-texinfo-unclean-extensions'. See interactive function `dired-omit-toggle' (\[dired-omit-toggle]) and variables `dired-omit-files-p' and `dired-omit-files'. (defvar dired-omit-extensions (append completion-ignored-extensions dired-latex-unclean-extensions dired-bibtex-unclean-extensions dired-texinfo-unclean-extensions) (#$ . 11585)) #@412 Erases all unmarked files matching REGEXP. Does nothing if global variable `dired-omit-files-p' is nil. If REGEXP is nil or not specified, uses `dired-omit-files', and also omits filenames ending in `dired-omit-extensions'. If REGEXP is the empty string, this function is a no-op. This functions works by temporarily binding `dired-marker-char' to `dired-omit-marker-char' and calling `dired-do-kill-lines'. (defalias 'dired-omit-expunge #[(&optional regexp) "…P †\n à ĉȘ„; \nËÌ!ˆÍĉ$ƒ6ÏÄÐ\"Ñ ˆ‚:ËÒ!ˆ)Ó…LŠebˆÔÄÖ#)!ˆ +‡" [dired-omit-files-p regexp dired-omit-regexp buffer-modified-p nil count old-modified-p omit-re "" dired-omit-marker-char dired-marker-char message "Omitting..." dired-mark-unmarked-files dired-omit-localp dired-do-kill-lines "Omitted %d line%s." force-mode-line-update "(Nothing to omit)" set-buffer-modified-p re-search-forward dired-re-mark t] 6 (#$ . 12141) "sOmit files (regexp): "]) (defalias 'dired-omit-regexp #[nil "ƒ ÁÂQ‚\fÃ\fƒÅ‚Ã\fƒ)ÆÁÇÈ\fÅ#ÉR‚*ÃQ‡" [dired-omit-files "\\(" "\\)" "" dired-omit-extensions "\\|" "." mapconcat regexp-quote "\\)$"] 8]) #@263 Marks unmarked files matching REGEXP, displaying MSG. REGEXP is matched against the complete pathname. Does not re-mark files which already have a mark. With prefix argument, unflag all those files. Second optional argument LOCALP is as in `dired-get-filename'. (defalias 'dired-mark-unmarked-files #[(regexp msg &optional unflag-p localp) "ƒÁ‚ \n Äʼn Š ƒ\"ÊË \"ˆebˆm„aÌÍ!ƒ[ÎÐ\"‰…@Ò\")ƒ[Ôg\n\"„[Õ`‰‰Tg\n$ˆTÖyˆ‚% ƒŠÊ× Ø!\nÁ=ƒzÙ‚{Ú\n=ƒ†Ü‚‡Ý&ˆ)ÄV…”-‡" [unflag-p 32 dired-marker-char msg 0 nil buffer-read-only pt count msg message "Marking %ss..." looking-at " " dired-get-filename localp t fn string-match regexp char-equal subst-char-in-region 1 "%s %s%s %s%s." dired-plural-s "un" "" dired-del-marker "flagged" "marked"] 9 (#$ . 13272) "P"]) (defalias 'dired-omit-new-add-entry #[(filename &optional marker-char) "ƒ?Á ‰Ø„3Ä\n Æ=ƒ‚/ È=ƒ'É!‚/ÊË!\"\"„<Ì \"‚=È)‡Ì \"‡" [dired-omit-files-p dired-omit-regexp omit-re "" string-match dired-omit-localp no-dir filename t dired-make-relative dired-make-absolute file-name-directory dired-omit-old-add-entry marker-char] 7]) (byte-code "ÀÁ!„ ÁÂKMˆÂÃMˆÄÅM‡" [fboundp dired-omit-old-add-entry dired-add-entry dired-omit-new-add-entry virtual-dired dired-virtual] 2) #@816 Put this buffer into Virtual Dired mode. In Virtual Dired mode, all commands that do not actually consult the filesystem will work. This is useful if you want to peruse and move around in an ls -lR output file, for example one you got from an ftp server. With ange-ftp, you can even dired a directory containing an ls-lR file, visit that file and turn on virtual dired mode. But don't try to save this file, as dired-virtual indents the listing and thus changes the buffer. If you have save a Dired buffer in a file you can use \[dired-virtual] to resume it in a later session. Type \\[revert-buffer] in the Virtual Dired buffer and answer `y' to convert the virtual to a real dired buffer again. You don't have to do this, though: you can relist single subdirs using \[dired-do-redisplay].  (defalias 'dired-virtual #[(dirname &optional switches) "ebˆÀÁ!„ÂedÃ#ˆ\f„ ÆÇ\f!!‰ŠebˆÈyˆÀÉ!…1ʕˈ`{)‰\fƒ>Æ\f \")ebˆÀ !„MÎ !ˆÏ\f†V\"ˆÒÔÖ×!ËLˆØ ˆebˆÙ\f!‡" [looking-at " " indent-region 2 dirname default-directory expand-file-name file-name-as-directory 1 "^ wildcard " 0 nil wildcard dired-subdir-regexp dired-insert-headerline dired-mode switches dired-listing-switches "Virtual Dired" mode-name dired-virtual-revert revert-buffer-function make-local-variable dired-subdir-alist dired-build-subdir-alist dired-initial-position] 5 (#$ . 14564) (list (read-string "Virtual Dired directory: " (dired-virtual-guess-dir)))]) (defalias 'dired-virtual-guess-dir #[nil "ÀÁebˆÄ !ƒ\n”\n•{Æ !)‚1Ç ÈÉ#ƒ0ÊËÆ\n”\n•{!!!‚1È*‡" ["^\\( \\)?\\([^ \n ]*\\)\\(:\\)[\n ]" 2 subexpr regexp looking-at dir file-name-as-directory re-search-forward nil t file-name-directory directory-file-name] 5]) (defalias 'dired-virtual-revert #[(&optional arg noconfirm) "ÀÁ!„\nÂÃ!‡ÄÆÈ ‡" [y-or-n-p "Cannot revert a Virtual Dired buffer - switch to Real Dired mode? " error "Cannot revert a Virtual Dired buffer." "Dired" mode-name dired-revert revert-buffer-function revert-buffer] 2]) #@405 Put current buffer into virtual dired mode (see `dired-virtual'). Useful on `buffer-contents-mode-alist' (which see) with the regexp "^ \(/[^ /]+\)/?+:$" to put saved dired buffers automatically into virtual dired mode. Also useful for `auto-mode-alist' (which see) like this: (setq auto-mode-alist (cons '("[^/]\.dired\'" . dired-virtual-mode) auto-mode-alist)) (defalias 'dired-virtual-mode #[nil "ÀÁ !‡" [dired-virtual dired-virtual-guess-dir] 2 (#$ . 16574) nil]) #@164 Alist of major modes and their opinion on default-directory, as a lisp expression to evaluate. A resulting value of nil is ignored in favor of default-directory. (defconst default-directory-alist (quote ((dired-mode if (fboundp (quote dired-current-directory)) (dired-current-directory) default-directory))) (#$ . 17090)) #@127 Usage like variable `default-directory', but knows about the special cases in variable `default-directory-alist' (which see). (defalias 'default-directory #[nil "À \nžA!†\n ‡" [eval major-mode default-directory-alist default-directory] 3 (#$ . 17420)]) #@73 Like function `shell-command', but in the current Tree Dired directory. (defalias 'dired-smart-shell-command #[(cmd &optional insert) "À Á\n \")‡" [default-directory shell-command cmd insert] 3 (#$ . 17680) "sShell command: \nP"]) #@305 Filename, as string, containing local dired buffer variables to be hacked. If this file found in current directory, then it will be inserted into dired buffer and `hack-local-variables' will be run. See Emacs Info pages for more information on local variables. See also `dired-enable-local-variables'. (defvar dired-local-variables-file ".dired" (#$ . 17919)) #@76 Evaluate local variables in `dired-local-variables-file' for dired buffer. (defalias 'dired-hack-local-variables #[nil "…2;…2Á!…2d ŠbˆÇcˆÈ!ˆ) Ê ˆ)Ë ˆd|+‡" [dired-local-variables-file file-exists-p nil dired-enable-local-variables enable-local-variables buffer-read-only opoint "\f\n" insert-file-contents buffer-file-name hack-local-variables dired-sort-set-modeline] 3 (#$ . 18287)]) #@155 Creates `dired-local-variables-file' for omitting and reverts directory. Sets dired-omit-file-p to t in a local variables file that is readable by dired. (defalias 'dired-omit-here-always #[nil "À !ƒ Âà \"‡ŠÄÅ!qˆÆ ˆÇcˆÈ !ˆÉp!ˆ)Ê ˆË ‡" [file-exists-p dired-local-variables-file message "File `./%s' already exists." get-buffer-create " *dot-dired*" erase-buffer "Local Variables:\ndired-omit-files-p: t\nEnd:\n" write-file kill-buffer dired-extra-startup dired-revert] 3 (#$ . 18697) nil]) #@59 History list for commands that read dired-shell commands. (defvar dired-shell-command-history nil (#$ . 19193)) #@83 Default alist used for shell command guessing. See `dired-guess-shell-alist-user' (defvar dired-guess-shell-alist-default (byte-code "ÀÁDÂÃÄEÅÆÇEÈÉÊËÌÍEÎÏÐEÑÒÓÔÕEÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìDíîïE¯\"‡" ["\\.tar$" (if dired-guess-shell-gnutar (concat dired-guess-shell-gnutar " xvf") "tar xvf") "\\.tar\\.Z$" (if dired-guess-shell-gnutar (concat dired-guess-shell-gnutar " zxvf") (concat "zcat * | tar xvf -")) (concat "znew" (if dired-guess-shell-gzip-quiet " -q") " " dired-guess-shell-znew-switches) "\\.tar\\.g?z$" (if dired-guess-shell-gnutar (concat dired-guess-shell-gnutar " zxvf") (concat "gunzip -qc * | tar xvf -")) (concat "gunzip" (if dired-guess-shell-gzip-quiet " -q" "")) ("\\.shar.Z$" "zcat * | unshar") ("\\.shar.g?z$" "gunzip -qc * | unshar") ("\\.ps$" "ghostview" "xv" "lpr") "\\.ps.g?z$" "gunzip -qc * | ghostview -" (concat "gunzip" (if dired-guess-shell-gzip-quiet " -q")) "\\.ps.Z$" "zcat * | ghostview -" (concat "znew" (if dired-guess-shell-gzip-quiet " -q") " " dired-guess-shell-znew-switches) ("\\.patch$" "cat * | patch") ("\\.patch.g?z$" "gunzip -qc * | patch") "\\.patch.Z$" "zcat * | patch" (concat "znew" (if dired-guess-shell-gzip-quiet " -q") " " dired-guess-shell-znew-switches) ("\\.dvi$" "xdvi" "dvips") ("\\.au$" "play") ("\\.mpg$" "mpeg_play") ("\\.uu$" "uudecode") ("\\.hqx$" "mcvert") ("\\.sh$" "sh") ("\\.xbm$" "bitmap") ("\\.gp$" "gnuplot") ("\\.p[bgpn]m$" "xv") ("\\.gif$" "xv") ("\\.tif$" "xv") ("\\.jpg$" "xv") ("\\.fig$" "xfig") ("\\.out$" "xgraph") ("\\.tex$" "latex" "tex") ("\\.texi\\(nfo\\)?$" "makeinfo" "texi2dvi") ("\\.zoo$" "zoo x//") ("\\.zip$" "unzip") ("\\.lzh$" "lharc x") ("\\.arc$" "arc x") ("\\.shar$" "unshar") "\\.g?z$" (concat "gunzip" (if dired-guess-shell-gzip-quiet " -q")) "\\.Z$" "uncompress" (concat "znew" (if dired-guess-shell-gzip-quiet " -q") " " dired-guess-shell-znew-switches)] 36) (#$ . 19311)) #@946 User-defined alist of rules for suggested commands. These rules take precedence over the predefined rules in the variable `dired-guess-shell-alist-default' (to which they are prepended). Each element of this list looks like (REGEXP COMMAND...) where each COMMAND can either be a string or a lisp expression that evaluates to a string. If several COMMANDs are given, the first one will be the default and the rest will be added temporarily to the history and can be retrieved with \[previous-history-element] (M-p) . You can set this variable in your ~/.emacs. For example, to add rules for `.foo' and `.bar' files, write (setq dired-guess-shell-alist-user (list (list "\\.foo$" "FOO-COMMAND");; fixed rule ;; possibly more rules ... (list "\\.bar$";; rule with condition test '(if condition "BAR-COMMAND-1" "BAR-COMMAND-2"))))  (defvar dired-guess-shell-alist-user nil (#$ . 21187)) (defalias 'dired-guess-default #[(files) "À \f\"@AÀ À\nÀ ƒ= @‰ @\n AÌ\n\"ƒ A À‰„ƒUÌ\n@\"ƒUA‰„B?…] ‰ A„lÍ @!‚qÎÍ \".‡" [nil case-fold-search append dired-guess-shell-alist-user dired-guess-shell-alist-default alist files file flist elt regexp cmds string-match eval mapcar] 4]) (defalias 'dired-guess-shell-command #[(prompt files) "À !‰‰Ã‰„É\n‰‰Ë%‚n <ƒ?@\nÌÍG\"P\n‚DCÎ \" \nÌÏ\"P\nÐŽÉ\n‰‰Ë% њƒl )-‡" [dired-guess-default files nil t failed val old-history default-list default read-from-minibuffer prompt dired-shell-command-history format "{%d guesses} " append "[%s] " ((byte-code "\n„ ¢š„ Bć" [old-history dired-shell-command-history failed val nil] 2)) ""] 7]) (defalias 'dired-read-shell-command #[(prompt arg files) "ÀÁ ÄÅÇ \"\" &‡" [dired-mark-pop-up nil shell files dired-guess-shell-command format prompt dired-mark-prompt arg] 10]) #@40 See variable `dired-keep-marker-move'. (defvar dired-keep-marker-relsymlink 83 (#$ . 23157)) #@264 Three arguments: FILE1 FILE2 &optional OK-IF-ALREADY-EXISTS Make a symbolic link (pointing to FILE1) in FILE2. The link is relative (if possible), for example "/vol/tex/bin/foo" "/vol/local/bin/foo" results in "../../tex/bin/foo" "/vol/local/bin/foo"  (defalias 'dired-make-relative-symlink #[(file1 file2 &optional ok-if-already-exists) "À‰‰‰ÁÀÈ ! È\n!\n G\nGÀ ÌÍ #‰ ƒY T‰ ƒY \f^WƒY Á O\nÁ O˜ƒY ‚%\n Á O ÀO)\n͘ƒx ‚µ\n ÀOÁ‰ÌÍ#‰ƒŸTT‚…ÁVƒ´SÑP‚Ÿ+ÒÓ!#.‡" [nil 0 sub index len2 len1 name2 name1 expand-file-name file1 file2 next string-match "/" count start tem "../" make-symbolic-link directory-file-name ok-if-already-exists] 6 (#$ . 23257) "FRelSymLink: \nFRelSymLink %s: \np"]) #@265 Relative symlink all marked (or next ARG) files into a directory, or make a relative symbolic link to the current file. This creates relative symbolic links like foo -> ../bar/foo not absolute ones like foo -> /ugly/path/that/may/change/any/day/bar/foo (defalias 'dired-do-relsymlink #[(&optional arg) "ÀÁÂÃ\f %‡" [dired-do-create-files relsymlink dired-make-relative-symlink "RelSymLink" arg dired-keep-marker-relsymlink] 6 (#$ . 24045) "P"]) #@139 RelSymlink all marked files containing REGEXP to NEWNAME. See functions `dired-do-rename-regexp' and `dired-do-relsymlink' for more info. (defalias 'dired-do-relsymlink-regexp #[(regexp newname &optional whole-path) "ÀÁÂÃ\f &‡" [dired-do-create-files-regexp dired-make-relative-symlink "RelSymLink" nil regexp newname whole-path dired-keep-marker-relsymlink] 8 (#$ . 24507) (dired-mark-read-regexp "RelSymLink")]) #@509 Find all marked files displaying all of them simultaneously. With optional NOSELECT just find files but do not select them. The current window is split across all files marked, as evenly as possible. Remaining lines go to bottom-most window. The number of files that can be displayed this way is restricted by the height of the current window and `window-min-height'. To keep dired buffer displayed, type \[split-window-vertically] first. To display just marked files, type \[delete-other-windows] first. (defalias 'dired-do-find-marked-files #[(&optional noselect) "ÀÁ \n\"‡" [dired-simultaneous-find-file dired-get-marked-files noselect] 3 (#$ . 24933) "P"]) (defalias 'dired-simultaneous-find-file #[(file-list noselect) "À\nƒÃ\f@!ˆ‚$Å \fG¥ X„ÇÈ!ˆÉ\f@!ˆ\fA‰…K\nƒ7Ã\f@!ˆ‚CÊËÀ \"!ˆÉ\f@!ˆ\fA‰„+À)‡" [nil size noselect find-file-noselect file-list window-height window-min-height error "Too many files to visit simultaneously. Try C-u prefix." find-file select-window split-window] 5]) #@121 Run man on this file. Display old buffer if buffer name matches filename. Uses ../lisp/man.el of \[manual-entry] fame. (defalias 'dired-man #[nil "ÀÁ!ˆÂ ÃÆ !*‡" [require man dired-get-filename "nroff -man -h" manual-program file Man-getpage-in-background] 2 (#$ . 25944) nil]) #@24 Run info on this file. (defalias 'dired-info #[nil "ÀÁ !‡" [info dired-get-filename] 2 (#$ . 26230) nil]) #@141 Run VM on this file. With prefix arg, visit folder read-only (this requires at least VM 5). See also variable `dired-vm-read-only-folders'. (defalias 'dired-vm #[(&optional read-only) "À Á \fƒÅ\nÆ\"ˆ‚5Æ=ƒ!Å\nÆ\"ˆ‚5„-Å\n!ˆ‚5Å\nÈ\n!?\"ˆÉÊ! L*‡" [dired-current-directory dired-get-filename fil dir read-only vm-visit-folder t dired-vm-read-only-folders file-writable-p make-local-variable vm-folder-directory] 4 (#$ . 26343) "P"]) #@25 Run RMAIL on this file. (defalias 'dired-rmail #[nil "ÀÁ !‡" [rmail dired-get-filename] 2 (#$ . 26790) nil]) #@77 If `dired-bind-vm' is t, then function `dired-vm', otherwise `dired-rmail'. (defalias 'dired-do-run-mail #[nil "ƒÁ ‡Â ‡" [dired-bind-vm dired-vm dired-rmail] 1 (#$ . 26905) nil]) (byte-code "ÀÁ!„ ÁÂKMˆÀ‡" [fboundp dired-old-find-buffer-nocreate dired-find-buffer-nocreate] 2) (defalias 'dired-find-buffer-nocreate #[(dirname &optional mode) "ƒ;  !˜ƒ;pÄÅ !!Ÿ >…! šÉ \"ÊË\"@†9…9 +‡Ì  \"‡" [dired-find-subdir dirname file-name-directory cur-buf dired-buffers-for-dir expand-file-name buffers dired-directory cur-buf-matches delq sort dired-buffer-more-recently-used-p dired-old-find-buffer-nocreate mode] 3]) #@57 Return t if BUFFER1 is more recently used than BUFFER2. (defalias 'dired-buffer-more-recently-used-p #[(buffer1 buffer2) " š?…)Âà \fƒ'\f@š‰„' \f@š„'\fA‰„ *‡" [buffer1 buffer2 nil buffer-list list more-recent] 3 (#$ . 27546)]) (defalias 'dired-initial-position #[(dirname) "Àˆ ƒ  !ˆ\f…Å ‡" [nil dired-find-subdir dired-goto-subdir dirname dired-trivial-filenames dired-goto-next-nontrivial-file] 2]) #@924 Mark files for which PREDICATE returns non-nil. With a prefix arg, unflag those files instead. PREDICATE is a lisp expression that can refer to the following symbols: inode [integer] the inode of the file (only for ls -i output) s [integer] the size of the file for ls -s output (ususally in blocks or, with -k, in KByte) mode [string] file permission bits, e.g. "-rw-r--r--" nlink [integer] number of links to file uid [string] owner gid [string] group (If the gid is not displayed by ls, this will still be set (to the same as uid)) size [integer] file size in bytes time [string] the time that ls displays, e.g. "Feb 12 14:17" name [string] the name of the file sym [string] if file is a symbolic link, the linked-to name, else "" For example, use (equal 0 size) to mark all zero length files. (defalias 'dired-mark-sexp #[(predicate &optional unflag-p) "ÀÁ\n\"ˆ ƒ Ä‚ Ɖ‰‰‰‰‰‰‰‰ \n \f ÑÒ\n\"ÓƉŠƒHÀØ\"ˆebˆm„ŠÙ …üÆÚÛÓyˆßuˆà!ƒ„Ó•bˆáâ”â•{!áߔߕ{!‚ŠÆÆ``\\{uˆãp! `âvˆ`{\fäå!ˆâ”bˆæuˆáŠçâ!ˆ`‰)`{!\nbˆçâ!ˆŠâvˆ`)`{ â”Ù S{ `èé!†à`{àê!ƒõëuˆ`ƈ`{‚öì+í\n!)ƒîg \"„ï`‰‰Tg $ˆTâyˆ‚KƒFÀðñ! Ä=ƒ6ò‚7ì 3=ƒBô‚Cõ&ˆ)ÓV…P.‡" [message "%s" predicate unflag-p 32 dired-marker-char nil sym name time size gid uid nlink mode s inode format "'%s file" 0 buffer-read-only pt count msg "Marking %ss..." dired-move-to-filename 10 "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?" dired-re-inode-size mode-len pos 2 looking-at string-to-int 1 read re-search-forward "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)" -1 backward-word dired-move-to-end-of-filename t " -> " 4 "" eval char-equal subst-char-in-region "%s %s%s %s%s." dired-plural-s "un" dired-del-marker "flagged" "marked"] 11 (#$ . 27969) "xMark if (lisp expr): \nP"]) #@239 *t means don't bind `dired-x-find-file' over `find-file' on keyboard. Similarly for `dired-x-find-file-other-window' over `find-file-other-window'. If you change this variable after dired-x.el is loaded then do \[dired-x-bind-find-file]. (defvar dired-x-hands-off-my-keys t (#$ . -29929)) #@238 Bind `dired-x-find-file' in place of `find-file' (or reverse). Similarly for `dired-x-find-file-other-window' and `find-file-other-window'. Binding direction based on `dired-x-hands-off-my-keys'. This function part of `after-init-hook'. (defalias 'dired-x-bind-find-file #[nil "tƒ ÀÁ!?\n„ÃÄÅÆ #ˆÃÇÈÆ #ˆ‚,ÃÅÄÆ #ˆÃÈÇÆ #ˆÉÊ!‡" [y-or-n-p "Bind dired-x-find-file over find-file? " dired-x-hands-off-my-keys substitute-key-definition find-file dired-x-find-file current-global-map find-file-other-window dired-x-find-file-other-window message nil] 4 (#$ . 30225) nil]) (byte-code "À ˆÁÂÀ\"‡" [dired-x-bind-find-file add-hook after-init-hook] 3) #@398 Edit file FILENAME. May create a new window, or reuse an existing one. See the function `display-buffer'. Identical to `find-file' except when called interactively, with a prefix arg (e.g., \[universal-argument]), in which case it guesses filename near point. Useful for editing file mentioned in buffer you are viewing, or to test if that file exists. Use minibuffer after snatching filename. (defalias 'dired-x-find-file #[(filename) "ÀÁ\n!!‡" [find-file expand-file-name filename] 3 (#$ . 30876) (list (read-filename-at-point "Find file: "))]) #@430 Edit file FILENAME, in another window. May create a new window, or reuse an existing one. See the function `display-buffer'. Identical to `find-file-other-window' except when called interactively, with a prefix arg (e.g., \[universal-argument]), in which case it guesses filename near point. Useful for editing file mentioned in buffer you are viewing, or to test if that file exists. Use minibuffer after snatching filename. (defalias 'dired-x-find-file-other-window #[(filename) "ÀÁ\n!!‡" [find-file-other-window expand-file-name filename] 3 (#$ . 31433) (list (read-filename-at-point "Find file: "))]) (defalias 'dired-filename-at-point #[nil "ÀŠÁyˆ`)ŠÂˆ`)‰‰Šm„0ÉÊ!ƒ0ËÂxˆo„0ÌÍ!ˆÎÏÐQÑg!\"ƒXÂxˆ`ÎÒÑh!\"ƒP SÂwˆ‚\\ÓÔ!ˆÕ `{!.‡" [".a-zA-Z0-9---_/:$+" 0 nil filename end start eol bol filename-chars looking-at "[] \n[{}()]" " \n ({[]})" backward-char 1 string-match "[" "]" char-to-string "[/~]" error "No file found around point!" expand-file-name] 6]) (defalias 'read-filename-at-point #[(prompt) "ƒÁ Ã\fÅ\n!\nÆÇ\n!%)‡Ã\f\"‡" [current-prefix-arg dired-filename-at-point guess read-file-name prompt file-name-directory nil file-name-nondirectory default-directory] 7]) #@201 Revision number of dired-x.el -- dired extra for GNU Emacs v19. Type \[dired-x-submit-report] to send a bug report. Available via anonymous ftp in /roebling.poly.edu:/pub/packages/dired-x.tar.gz (defconst dired-x-version "2.37" (#$ . 32644)) #@60 Address(es) accepting submission of reports on dired-x.el. (defconst dired-x-help-address "dodd@roebling.poly.edu" (#$ . 32897)) #@72 First name(s) of people accepting submission of reports on dired-x.el. (defconst dired-x-maintainer "Larry" (#$ . 33032)) #@42 Name of file containing emacs lisp code. (defconst dired-x-file "dired-x.el" (#$ . 33160)) #@78 List of variables to be appended to reports sent by `dired-x-submit-report.' (defconst dired-x-variable-list (list (quote dired-bind-vm) (quote dired-vm-read-only-folders) (quote dired-bind-jump) (quote dired-bind-info) (quote dired-bind-man) (quote dired-find-subdir) (quote dired-enable-local-variables) (quote dired-local-variables-file) (quote dired-guess-shell-gnutar) (quote dired-guess-shell-gzip-quiet) (quote dired-guess-shell-znew-switches) (quote dired-guess-shell-alist-user) (quote dired-clean-up-buffers-too) (quote dired-omit-files-p) (quote dired-omit-files) (quote dired-omit-extensions)) (#$ . 33257)) #@223 Submit via reporter.el a bug report on program. Send report on `dired-x-file' version `dired-x-version,' to `dired-x-maintainer' at address `dired-x-help-address' listing variables `dired-x-variable-list' in the message. (defalias 'dired-x-submit-report #[nil "ÀÁ‡" [err (byte-code "ÀÁ!ˆÂ \fÅÇRɉ\nËP&‡" [require reporter reporter-submit-bug-report dired-x-help-address dired-x-file " (" dired-x-version ")" dired-x-variable-list nil dired-x-maintainer ","] 8) ((error (byte-code "À ˆÁÂ!‡" [beep message "Sorry, reporter.el not found."] 2)))] 3 (#$ . 33884) nil]) (provide (quote dired-x)) emacs-19.30/lisp/dired.elc100666 12120 1 165207 6032175145 13707 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Sep 27 03:15:30 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/dired.el ;;; emacs version 19.29.12. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`dired.el' was compiled for Emacs 19.29 or later")) #@243 *Switches passed to `ls' for dired. MUST contain the `l' option. May contain all other options that don't contradict `-l'; may contain even `F', `b', `i' and `s'. See also the variable `dired-ls-F-marks-symlinks' concerning the `F' switch. (defvar dired-listing-switches "-al" (#$ . -477)) #@58 Name of chown command (usually `chown' or `/etc/chown'). (defvar dired-chown-program (byte-code "Á>ƒ‡Ç" [system-type (hpux dgux usg-unix-v irix linux) "chown" "/etc/chown"] 2) (#$ . 775)) #@54 Name of chmod command (usually `chmod' or `chmode'). (defvar dired-chmod-program (byte-code "Á=ƒ‡Ç" [system-type windows-nt "chmode" "chmod"] 2) (#$ . 974)) #@559 *Informs dired about how `ls -lF' marks symbolic links. Set this to t if `insert-directory-program' with `-lF' marks the symbolic link itself with a trailing @ (usually the case under Ultrix). Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to nil (the default), if it gives `bar@ -> foo', set it to t. Dired checks if there is really a @ appended. Thus, if you have a marking `ls' program on one host and a non-marking on another host, and don't care about symbolic links which really end in a @, you can always set this variable to t. (defvar dired-ls-F-marks-symlinks nil (#$ . -1143)) #@151 *Regexp of files to skip when finding first file of a directory. A value of nil means move to the subdir line. A value of t means move to first file. (defvar dired-trivial-filenames "^\\.\\.?$\\|^#" (#$ . -1760)) #@205 *Controls marking of renamed files. If t, files keep their previous marks when they are renamed. If a character, renamed files (whether previously marked or not) are afterward marked with that character. (defvar dired-keep-marker-rename t (#$ . -1980)) #@192 *Controls marking of copied files. If t, copied files are marked if and as the corresponding original files were. If a character, copied files are unconditionally marked with that character. (defvar dired-keep-marker-copy 67 (#$ . -2240)) #@184 *Controls marking of newly made hard links. If t, they are marked if and as the files linked to were marked. If a character, new links are unconditionally marked with that character. (defvar dired-keep-marker-hardlink 72 (#$ . -2486)) #@188 *Controls marking of newly made symbolic links. If t, they are marked if and as the files linked to were marked. If a character, new links are unconditionally marked with that character. (defvar dired-keep-marker-symlink 89 (#$ . -2728)) #@269 *If non-nil, dired tries to guess a default target directory. This means: if there is a dired buffer displayed in the next window, use its current subdir, instead of the current subdir of this dired buffer. The target is used in the prompt for file copy, rename etc. (defvar dired-dwim-target nil (#$ . -2973)) #@104 *If non-nil, Dired preserves the last-modified time in a file copy. (This works on only some systems.) (defvar dired-copy-preserve-time t (#$ . -3292)) #@52 Additional expressions to highlight in Dired mode. (defvar dired-font-lock-keywords (quote (("^ \\(/.+\\)" 1 font-lock-type-face) ("\\([^ ]+\\) -> [^ ]+$" . font-lock-function-name-face) ("^[^ ]" . font-lock-reference-face) ("^..d.* \\([^ ]+\\)$" 1 font-lock-keyword-face))) (#$ . 3450)) #@87 Run after loading dired. You can customize key bindings or load extensions with this. (defvar dired-load-hook nil (#$ . 3745)) #@36 Run at the very end of dired-mode. (defvar dired-mode-hook nil (#$ . 3878)) #@74 This hook is run before a dired buffer is read in (created or reverted). (defvar dired-before-readin-hook nil (#$ . 3960)) #@165 Hook run after each time a file or directory is read by Dired. After each listing of a file or directory, this hook is run with the buffer narrowed to the listing. (defvar dired-after-readin-hook nil (#$ . 4090)) #@115 In Dired, the current mark character. This is what the `do' commands look for and what the `mark' commands store. (defvar dired-marker-char 42 (#$ . 4310)) #@44 Character used to flag files for deletion. (defvar dired-del-marker 68 (#$ . 4472)) #@73 Non-nil means Dired shrinks the display buffer to fit the marked files. (defvar dired-shrink-to-fit t (#$ . 4562)) (byte-code "ÀÁ!„ÂÁ BÄ B‡" [boundp dired-flagging-regexp nil current-load-list dired-file-version-alist] 2) #@202 The directory name or shell wildcard that was used as argument to `ls'. Local to each dired buffer. May be a list, in which case the car is the directory name and the cdr is the actual files to list. (defvar dired-directory nil (#$ . 4797)) #@72 The value of `dired-listing-switches' used to make this buffer's text. (defvar dired-actual-switches nil (#$ . 5045)) #@72 Regexp for optional initial inode and file size as made by `ls -i -s'. (defvar dired-re-inode-size "[0-9 ]*" (#$ . 5169)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„%\fÈQÆ BÀÉ!„6\fÊQ É BÀË!„GÌÍÎÏ# Ë BÀÐ!„TÑÐ BÀÒ!„aÓÒ BÀ‡" [boundp dired-re-mark "^[^ \n]" current-load-list dired-re-maybe-mark "^. " dired-re-dir dired-re-inode-size "d" dired-re-sym "l" dired-re-exe mapconcat #[(x) " \nQ‡" [dired-re-maybe-mark dired-re-inode-size x] 3] ("-[-r][-w][xs][-r][-w].[-r][-w]." "-[-r][-w].[-r][-w][xs][-r][-w]." "-[-r][-w].[-r][-w].[-r][-w][xst]") "\\|" dired-re-perms "[-bcdlps][-r][-w].[-r][-w].[-r][-w]." dired-re-dot "^.* \\.\\.?$"] 4) #@237 Association list of subdirectories and their buffer positions. Each subdirectory has an element: (DIRNAME . STARTMARKER). The order of elements is the reverse of the order in the buffer. In simple cases, this list contains one element. (defvar dired-subdir-alist nil (#$ . 5830)) #@278 Regexp matching a maybe hidden subdirectory line in `ls -lR' output. Subexpression 1 is the subdirectory proper, no trailing colon. The match starts at the beginning of the line and ends after the end of the line (\n or \r). Subexpression 2 must end right before the \n or \r. (defvar dired-subdir-regexp "^. \\([^\n ]+\\)\\(:\\)[\n ]" (#$ . 6117)) (defalias 'dired-mark-if '(macro . #[(predicate msg) "ÀÁÂÃÄ ÆÇ EEÈÉÊÄ ÌBBÍBBBÄ ÆÎÏ ÐBBBBE¯ÑBBB‡" [let (buffer-read-only count) save-excursion (setq count 0) if msg message "Marking %ss..." (goto-char (point-min)) while (not (eobp)) predicate ((progn (delete-char 1) (insert dired-marker-char) (setq count (1+ count)))) ((forward-line 1)) "%s %s%s %s%s." count ((dired-plural-s count) (if (eq dired-marker-char 32) "un" "") (if (eq dired-marker-char dired-del-marker) "flagged" "marked")) ((and (> count 0) count))] 14])) (defalias 'dired-map-over-marks '(macro . #[(body arg &optional show-progress) "ÀÁÂÃ\fÃÅ\fDÆÇ\fÈÉÊà ÌBBÍÎÏÑBBEFDEÃÒ\fÓBBÔBBEÕDFÁÖ×ØÙÚÛÜà ÝBBÍÎÏÞBBEßBBBBBFÃàÎÕDFFFEáBB‡" [prog1 let (buffer-read-only case-fold-search found results) if arg integerp progn dired-repeat-over-lines function lambda nil show-progress ((sit-for 0)) setq results cons body (results) < (0) ((nreverse results) results) list ((regexp (dired-marker-regexp)) next-position) save-excursion (goto-char (point-min)) (setq next-position (and (re-search-forward regexp nil t) (point-marker)) found (not (null next-position))) while next-position (goto-char next-position) ((sit-for 0)) (results) ((goto-char next-position) (forward-line 1) (set-marker next-position nil) (setq next-position (and (re-search-forward regexp nil t) (point-marker)))) found ((dired-move-to-filename))] 20])) #@442 Return the marked files' names as list of strings. The list is in the same order as the buffer, that is, the car is the first marked file. Values returned are normally absolute pathnames. Optional arg LOCALP as in `dired-get-filename'. Optional second argument ARG forces to use other files. If ARG is an integer, use the next ARG files. If ARG is otherwise non-nil, use current file. Usually ARG comes from the current prefix arg. (defalias 'dired-get-marked-files #[(&optional localp arg) "ŠÀ‰‰‰ ƒ. ¨ƒ&Æ Ç\"ˆ ÈWƒ\" Ÿ‚‡ ‚‡É\n!C‚‡Ë À\f ŠebˆÎ ÀÏ#…DÐ ‰\f??\fƒx\fbˆÉ\n! B\fbˆÑyˆ\fÀ‰“ˆÎ ÀÏ#…rÐ ‰\f„O)\nƒ ‚†É\n!C*,Ò ˆŸ)‡" [nil results found case-fold-search buffer-read-only arg dired-repeat-over-lines #[nil "À !\nB‰‡" [dired-get-filename localp results] 2] 0 dired-get-filename localp dired-marker-regexp next-position regexp re-search-forward t point-marker 1 dired-move-to-filename] 5 (#$ . 7858)]) (defalias 'dired-read-dir-and-switches #[(str) "À … ÂÃ\f\"ÅÆÇ\"É\nÉ$D!‡" [reverse current-prefix-arg read-string "Dired listing switches: " dired-listing-switches read-file-name format "Dired %s(directory): " str nil default-directory] 7]) #@799 "Edit" directory DIRNAME--delete, rename, print, etc. some files in it. Optional second argument SWITCHES specifies the `ls' options used. (Interactively, use a prefix argument to be able to specify SWITCHES.) Dired displays a list of files in DIRNAME (which may also have shell wildcards appended to select certain files). If DIRNAME is a cons, its first element is taken as the directory name and the resr as an explicit list of files to make directory entries for. \You can move around in it with the usual commands. You can flag files for deletion with \[dired-flag-file-deletion] and then delete them by typing \[dired-do-flagged-delete]. Type \[describe-mode] after entering dired for more info. If DIRNAME is already in a dired buffer, that buffer is used without refresh. (defalias 'dired #[(dirname &optional switches) "ÀÁ\n \"!‡" [switch-to-buffer dired-noselect dirname switches] 4 (#$ . 9049) (dired-read-dir-and-switches "")]) #@72 "Edit" directory DIRNAME. Like `dired' but selects in another window. (defalias 'dired-other-window #[(dirname &optional switches) "ÀÁ\n \"!‡" [switch-to-buffer-other-window dired-noselect dirname switches] 4 (#$ . 10013) (dired-read-dir-and-switches "in other window ")]) #@64 "Edit" directory DIRNAME. Like `dired' but makes a new frame. (defalias 'dired-other-frame #[(dirname &optional switches) "ÀÁ\n \"!‡" [switch-to-buffer-other-frame dired-noselect dirname switches] 4 (#$ . 10293) (dired-read-dir-and-switches "in other frame ")]) #@73 Like `dired' but returns the dired buffer as value, does not select it. (defalias 'dired-noselect #[(dir-or-list &optional switches) "„ Â:ƒ@‚ÄÅÆ !!!Ç !ƒ'È !:ƒ4 AB‚6 É\n\")‡" [dir-or-list default-directory nil dirname abbreviate-file-name expand-file-name directory-file-name file-directory-p file-name-as-directory dired-internal-noselect switches] 4 (#$ . 10562)]) (defalias 'dired-internal-noselect #[(dir-or-list &optional switches mode) ":ƒ\n@‚  \"‰?p\f„%ÇÉÊ !!)\fqˆ „} ƒA:ƒ9\fÍ !ˆ‚»Î !Ï Ò=†p@Ó=?†pÔ8@@U…pÔ8A@AU*„»ÕÖ×!!ˆ‚»Ø !ƒ‡ ‚ŠÙ ! „• Ü  \"ˆ ƒ¢ ˆÓÞŽß\f\"ˆà*áâ!ˆebˆã !ˆqˆ\f,‡" [dir-or-list dirname dired-find-buffer-nocreate mode buffer new-buffer-p old-buf fundamental-mode default-major-mode create-file-buffer directory-file-name switches dired-directory dired-sort-other file-attributes visited-file-modtime modtime attributes 0 t 5 message substitute-command-keys "Directory has changed on disk; type \\[revert-buffer] to update Dired" file-directory-p file-name-directory default-directory dired-listing-switches dired-mode failed ((byte-code "ƒÁ\n!ˆÁ‡" [failed kill-buffer buffer] 2)) dired-readin nil run-hooks dired-after-readin-hook dired-initial-position] 4]) (defalias 'dired-find-buffer-nocreate #[(dirname &optional mode) "À \f„\nÅ\nƒQÆ\n@A!„\nA‰‚ Š\n@Aqˆ\f=ƒJ:ƒ9@ š‚> šƒJ\n@AÀ‚M\nA)‚\n *‡" [nil dired-buffers blist found mode dired-mode buffer-name major-mode dired-directory dirname] 3]) (defalias 'dired-readin #[(dir-or-list buffer) "À\n:ƒ \n@‚\nà !\n:ƒ \nABÄÅ!ˆŠÆÇ \"ˆqˆÀÉ\n ~ˆÌ ˆÍ\n!ˆÎedÏ#ˆebˆÐ!ˆ*ÆÒ \"ˆÓÔ!ÀLˆÕ ˆÖ !‰@É=ƒjØÙ8!ˆ)ÚÀ!*‡" [nil dirname dir-or-list expand-file-name run-hooks dired-before-readin-hook message "Reading directory %s..." buffer t failed buffer-read-only erase-buffer dired-readin-insert indent-rigidly 2 dired-insert-headerline default-directory "Reading directory %s...done" make-local-variable dired-subdir-alist dired-build-subdir-alist file-attributes attributes set-visited-file-modtime 5 set-buffer-modified-p] 5]) (defalias 'dired-readin-insert #[(dir-or-list) "À\n:ƒ \n@‚\nÃ\f!à !šƒ(\n:„(Å\nÀÇ$‚NÈÉÊ !!!„9ËÌ \"‚NÅ\n\nÒÓÀÑ#ˆ‚-\nbˆÏÔ Ñ#ƒRÒÕÀÑ#ˆ‚A À‰“ˆ)Ö\n`\"ˆ* ‰‡" [nil end opoint dir-or-list mapcar #[(x) "À \n \f$‡" [insert-directory x switches wildcard full-p] 5] insert-directory expand-file-name switches wildcard full-p string-match "b" dired-actual-switches point-marker search-forward "\\" t replace-match "\\\\" " " "\\015" dired-insert-set-properties dired-directory] 5]) (defalias 'dired-insert-set-properties #[(beg end) "Šbˆ` W…ÂÃĈÅyˆ‚)‡" [beg end nil (byte-code "À ƒÁ`ŠÂ ˆ`)ÃÄ$ˆÀ‡" [dired-move-to-filename put-text-property dired-move-to-end-of-filename mouse-face highlight] 5) ((error)) 1] 3]) (defalias 'dired-insert-headerline #[(dir) "ŠÀÁ\n!ñ)‡" [" " directory-file-name dir ":\n"] 3]) (defalias 'dired-revert #[(&optional arg noconfirm) "~ˆ`ÀÁÂ\"ÁÃ Ä !AÁ‰ \n \febˆÍed\"\nÎ:ƒ4@‚6!ˆÐp\"ˆÁÒ!ˆ)Ó\n!ˆÔÑ!ˆ ƒ\\Õ !„`\fbˆÖ ˆŠ×Ø \".‡" [dired-get-filename nil t dired-remember-hidden reverse dired-subdir-alist buffer-read-only case-fold-search old-subdir-alist hidden-subdirs mark-alist ofile opoint dired-remember-marks dired-uncache dired-directory dired-readin dired-after-readin-hook dired-insert-old-subdirs dired-mark-remembered run-hooks dired-goto-file dired-move-to-filename mapcar #[(dir) "À !… ÂÃ!‡" [dired-goto-subdir dir dired-hide-subdir 1] 2]] 7]) (defalias 'dired-remember-marks #[(beg end) "ƒÁÃ\f ÆÇ$ˆ)Á‰‰ \nŠ\fbˆË\f Í#ƒ>ÎÁÍ\"‰\nƒh \n BB‚)+‡" [selective-display nil buffer-read-only subst-char-in-region beg end 13 10 alist chr fil re-search-forward dired-re-mark t dired-get-filename] 5]) (defalias 'dired-mark-remembered #[(alist) "À‰‰\f…+\f@\fA @ AÅ\n!ƒŠÆyˆÇÈ!ˆ cˆ)‚+‡" [nil chr fil elt alist dired-goto-file 0 delete-char 1] 3]) (defalias 'dired-remember-hidden #[nil "Á‰‰ ƒ+ @@ @A A bˆÆÁwˆgÇ=ƒ\f\nB‚\n,‡" [dired-subdir-alist nil result pos dir l "^ \n" 13] 4]) (defalias 'dired-insert-old-subdirs #[(old-subdir-alist) "ÀÁ\n\"†%É…$@A @ÃÇȈ‚ *‡" [string-match "R" dired-actual-switches nil dir elt old-subdir-alist (byte-code "À !ˆÂ !‡" [dired-uncache dir dired-insert-subdir] 2) ((error))] 3]) (defalias 'dired-uncache #[(dir) "À Â\"‰…  \")‡" [find-file-name-handler dir dired-uncache handler] 4]) #@38 Local keymap for dired-mode buffers. (defvar dired-mode-map nil (#$ . 15451)) (byte-code "„Á Ã\n!ˆÄ\nÅÆ#ˆÄ\nÇÈ#ˆÄ\nÉÊ#ˆÄ\nËÌ#ˆÄ\nÍÎ#ˆÄ\nÏÐ#ˆÄ\nÑÒ#ˆÄ\nÓÔ#ˆÄ\nÕÖ#ˆÄ\n×Ø#ˆÄ\nÙÚ#ˆÄ\nÛÜ#ˆÄ\nÝÞ#ˆÄ\nßà#ˆÄ\náâ#ˆÄ\nãä#ˆÄ\nåæ#ˆÄ\nçè#ˆÄ\néê#ˆÄ\nëì#ˆÄ\níî#ˆÄ\nïð#ˆÄ\nñî#ˆÄ\nòó#ˆÄ\nôõ#ˆÄ\nö÷#ˆÄ\nøù#ˆÄ\núû#ˆÄ\nüý#ˆÄ\nþÿ#ˆÄ\n@A#ˆÄ\nBC#ˆÄ\nDE#ˆÄ\nFG#ˆÄ\nHI#ˆÄ\nJK#ˆÄ\nLM#ˆÄ\nNO#ˆÄ\nPQ#ˆÄ\nRS#ˆÄ\nTO#ˆÄ\nUV#ˆÄ\nWX#ˆÄ\nYZ#ˆÄ\n[\\#ˆÄ\n]\\#ˆÄ\n^_#ˆÄ\n`a#ˆÄ\nbc#ˆÄ\nde#ˆÄ\nfg#ˆÄ\nhi#ˆÄ\njk#ˆÄ\nlm#ˆÄ\nno#ˆÄ\npq#ˆÄ\nrs#ˆÄ\ntu#ˆÄ\nvw#ˆÄ\nxy#ˆÄ\nz{#ˆÄ\n|}#ˆÄ\n~#ˆÄ\n€#ˆÄ\n‚ƒ#ˆÄ\n„…#ˆÄ\n†m#ˆÄ\n‡m#ˆÄ\nˆs#ˆÄ\n‰m#ˆÄ\nŠs#ˆÄ\n‹Œ#ˆÄ\nŽ#ˆÄ\n#ˆÄ\n‘’#ˆÄ\n“”#ˆÄ\n•”#ˆÄ\n–—#ˆÄ\n˜™š™!B#ˆÄ\n›œ#ˆÄ\nž#ˆÄ\nŸ #ˆÄ\n¡¢#ˆÄ\n£¤#ˆÄ\n¥¦#ˆÄ\n§¨#ˆÄ\n©ª#ˆÄ\n«¬#ˆÄ\n­®#ˆÄ\n¯°š°!B#ˆÄ\n±²#ˆÄ\n³´#ˆÄ\nµ¶#ˆÄ\n·¸#ˆÄ\n¹º#ˆÄ\n»¼#ˆÄ\n½¾#ˆÄ\n¿ÀšÀ!B#ˆÄ\nÁÂ#ˆÄ\nÃÄ#ˆÄ\nÅÆ#ˆÄ\nÇÈ#ˆÄ\nÉÊ#ˆÄ\nËÌ#ˆÄ\nÍÎ#ˆÄ\nÏÐ#ˆÄ\nÑÒšÒ!B#ˆÄ\nÓÔ#ˆÄ\nÕÖ#ˆÄ\n×Ø#ˆÄ\nÙÚ#ˆÄ\nÛÜ#ˆÄ\nÝÞ#ˆÄ\nßà#ˆÄ\náâ#ˆÄ\nãä#ˆÄ\nåæ#ˆÄ\nçè#ˆÄ\néê#ˆÄ\nëì#ˆÄ\níîšî!B#ˆÄ\nïð#ˆÄ\nñò#ˆÄ\nóô#ˆÄ\nõö#ˆÄ\n÷ø#ˆÄ\nùú#ˆÄ\nûü#ˆÄ\nýþ#ˆÄ\nÿ#ˆÄ\n#ˆÄ\n#ˆÄ\n#ˆÄ\n#ˆÄ\n \n#ˆÄ\n \f#ˆ\n) #‡" [dired-mode-map make-keymap map suppress-keymap define-key [mouse-2] dired-mouse-find-file-other-window "#" dired-flag-auto-save-files "*" dired-mark-executables "." dired-clean-directory "/" dired-mark-directories "@" dired-mark-symlinks "~" dired-flag-backup-files "A" dired-do-search "C" dired-do-copy "B" dired-do-byte-compile "D" dired-do-delete "G" dired-do-chgrp "H" dired-do-hardlink "L" dired-do-load "M" dired-do-chmod "O" dired-do-chown "P" dired-do-print "Q" dired-do-query-replace "R" dired-do-rename "S" dired-do-symlink "X" dired-do-shell-command "Z" dired-do-compress "!" "=" dired-diff "½" dired-backup-diff "ÿ" dired-unmark-all-files "„" dired-tree-down "•" dired-tree-up "Ž" dired-next-subdir "" dired-prev-subdir "û" dired-prev-marked-file "ý" dired-next-marked-file "%" nil "%u" dired-upcase "%l" dired-downcase "%d" dired-flag-files-regexp "%m" dired-mark-files-regexp "%r" dired-do-rename-regexp "%C" dired-do-copy-regexp "%H" dired-do-hardlink-regexp "%R" "%S" dired-do-symlink-regexp "c" dired-change-marks "d" dired-flag-file-deletion "e" dired-find-file "f" " " dired-advertised-find-file "g" revert-buffer "h" describe-mode "i" dired-maybe-insert-subdir "k" dired-do-kill-lines "l" dired-do-redisplay "m" dired-mark "n" dired-next-line "o" dired-find-file-other-window "" dired-display-file "p" dired-previous-line "q" dired-quit "s" dired-sort-toggle-or-edit "u" dired-unmark "v" dired-view-file "x" dired-do-flagged-delete "+" dired-create-directory "<" dired-prev-dirline ">" dired-next-dirline "^" dired-up-directory " " "" "" [down] [up] "$" dired-hide-subdir "¤" dired-hide-all "?" dired-summary "" dired-unmark-backward "" dired-undo "u" [menu-bar edit] undefined [menu-bar subdir] "Subdir" make-sparse-keymap [menu-bar subdir hide-all] ("Hide All" . dired-hide-all) [menu-bar subdir hide-subdir] ("Hide Subdir" . dired-hide-subdir) [menu-bar subdir tree-down] ("Tree Down" . dired-tree-down) [menu-bar subdir tree-up] ("Tree Up" . dired-tree-up) [menu-bar subdir up] ("Up Directory" . dired-up-directory) [menu-bar subdir prev-subdir] ("Prev Subdir" . dired-prev-subdir) [menu-bar subdir next-subdir] ("Next Subdir" . dired-next-subdir) [menu-bar subdir prev-dirline] ("Prev Dirline" . dired-prev-dirline) [menu-bar subdir next-dirline] ("Next Dirline" . dired-next-dirline) [menu-bar subdir insert] ("Insert This Subdir" . dired-maybe-insert-subdir) [menu-bar immediate] "Immediate" [menu-bar immediate backup-diff] ("Compare with Backup" . dired-backup-diff) [menu-bar immediate diff] ("Diff" . dired-diff) [menu-bar immediate view] ("View This File" . dired-view-file) [menu-bar immediate display] ("Display in Other Window" . dired-display-file) [menu-bar immediate find-file-other-window] ("Find in Other Window" . dired-find-file-other-window) [menu-bar immediate find-file] ("Find This File" . dired-find-file) [menu-bar immediate create-directory] ("Create Directory..." . dired-create-directory) [menu-bar regexp] "Regexp" [menu-bar regexp downcase] ("Downcase" . dired-downcase) [menu-bar regexp upcase] ("Upcase" . dired-upcase) [menu-bar regexp hardlink] ("Hardlink..." . dired-do-hardlink-regexp) [menu-bar regexp symlink] ("Symlink..." . dired-do-symlink-regexp) [menu-bar regexp rename] ("Rename..." . dired-do-rename-regexp) [menu-bar regexp copy] ("Copy..." . dired-do-copy-regexp) [menu-bar regexp flag] ("Flag..." . dired-flag-files-regexp) [menu-bar regexp mark] ("Mark..." . dired-mark-files-regexp) [menu-bar mark] "Mark" [menu-bar mark prev] ("Previous Marked" . dired-prev-marked-file) [menu-bar mark next] ("Next Marked" . dired-next-marked-file) [menu-bar mark marks] ("Change Marks..." . dired-change-marks) [menu-bar mark unmark-all] ("Unmark All" . dired-unmark-all-files-no-query) [menu-bar mark symlinks] ("Mark Symlinks" . dired-mark-symlinks) [menu-bar mark directories] ("Mark Directories" . dired-mark-directories) [menu-bar mark directory] ("Mark Old Backups" . dired-clean-directory) [menu-bar mark executables] ("Mark Executables" . dired-mark-executables) [menu-bar mark backup-files] ("Flag Backup Files" . dired-flag-backup-files) [menu-bar mark auto-save-files] ("Flag Auto-save Files" . dired-flag-auto-save-files) [menu-bar mark deletion] ("Flag" . dired-flag-file-deletion) [menu-bar mark unmark] ("Unmark" . dired-unmark) [menu-bar mark mark] ("Mark" . dired-mark) [menu-bar operate] "Operate" [menu-bar operate query-replace] ("Query Replace in Files..." . dired-do-query-replace) [menu-bar operate search] ("Search Files..." . dired-do-search) [menu-bar operate chown] ("Change Owner..." . dired-do-chown) [menu-bar operate chgrp] ("Change Group..." . dired-do-chgrp) [menu-bar operate chmod] ("Change Mode..." . dired-do-chmod) [menu-bar operate load] ("Load" . dired-do-load) [menu-bar operate compile] ("Byte-compile" . dired-do-byte-compile) [menu-bar operate compress] ("Compress" . dired-do-compress) [menu-bar operate print] ("Print" . dired-do-print) [menu-bar operate hardlink] ("Hardlink to..." . dired-do-hardlink) [menu-bar operate symlink] ("Symlink to..." . dired-do-symlink) [menu-bar operate command] ("Shell Command..." . dired-do-shell-command) [menu-bar operate delete] ("Delete" . dired-do-delete) [menu-bar operate rename] ("Rename to..." . dired-do-rename) [menu-bar operate copy] ("Copy to..." . dired-do-copy) put dired-mode mode-class special] 6) #@2928 Mode for "editing" directory listings. In dired, you are "editing" a list of the files in a directory and (optionally) its subdirectories, in the format of `ls -lR'. Each directory is a page: use \[backward-page] and \[forward-page] to move pagewise. "Editing" means that you can run shell commands on files, visit, compress, load or byte-compile them, change their file attributes and insert subdirectories into the same buffer. You can "mark" files for later commands or "flag" them for deletion, either file by file or all files matching certain criteria. You can move using the usual cursor motion commands.\ Letters no longer insert themselves. Digits are prefix arguments. Instead, type \[dired-flag-file-deletion] to flag a file for Deletion. Type \[dired-mark] to Mark a file or subdirectory for later commands. Most commands operate on the marked files and use the current file if no files are marked. Use a numeric prefix argument to operate on the next ARG (or previous -ARG if ARG<0) files, or just `1' to operate on the current file only. Prefix arguments override marks. Mark-using commands display a list of failures afterwards. Type \[dired-summary] to see why something went wrong. Type \[dired-unmark] to Unmark a file or all files of a subdirectory. Type \[dired-unmark-backward] to back up one line and unflag. Type \[dired-do-flagged-delete] to eXecute the deletions requested. Type \[dired-advertised-find-file] to Find the current line's file (or dired it in another buffer, if it is a directory). Type \[dired-find-file-other-window] to find file or dired directory in Other window. Type \[dired-maybe-insert-subdir] to Insert a subdirectory in this buffer. Type \[dired-do-rename] to Rename a file or move the marked files to another directory. Type \[dired-do-copy] to Copy files. Type \[dired-sort-toggle-or-edit] to toggle sorting by name/date or change the `ls' switches. Type \[revert-buffer] to read all currently expanded directories again. This retains all marks and hides subdirs again that were hidden before. SPC and DEL can be used to move down and up by lines. If dired ever gets confused, you can either type \[revert-buffer] to read the directories again, type \[dired-do-redisplay] to relist a single or the marked files or a subdirectory, or type \[dired-build-subdir-alist] to parse the buffer again for the directory tree. Customization variables (rename this buffer and type \[describe-variable] on each line for more info): dired-listing-switches dired-trivial-filenames dired-shrink-to-fit dired-marker-char dired-del-marker dired-keep-marker-rename dired-keep-marker-copy dired-keep-marker-hardlink dired-keep-marker-symlink Hooks (use \[describe-variable] to see their documentation): dired-before-readin-hook dired-after-readin-hook dired-mode-hook dired-load-hook Keybindings: \{dired-mode-map} (defalias 'dired-mode #[(&optional dirname switches) "À ˆÁ\n!ˆÃ ˆÄÆÈ È\nË\fÍÎ!ÏLˆÍÐ!ÑLˆÍÒ!†.LˆÍÕ!Ö!LˆÍ×!†CLˆÍÚ!ÛLˆÜÈ\"ˆÝÞ!‡" [kill-all-local-variables use-local-map dired-mode-map dired-advertise dired-mode major-mode "Dired" mode-name t buffer-read-only selective-display ("Dired: %17b") mode-line-buffer-identification make-local-variable revert-buffer-function dired-revert page-delimiter "\n\n" dired-directory dirname default-directory list-buffers-directory expand-file-name dired-actual-switches switches dired-listing-switches font-lock-defaults (dired-font-lock-keywords t) dired-sort-other run-hooks dired-mode-hook] 3 (#$ . 22364)]) #@32 Bury the current dired buffer. (defalias 'dired-quit #[nil "À ‡" [bury-buffer] 1 (#$ . 25961) nil]) #@62 Summarize basic Dired commands and show recent Dired errors. (defalias 'dired-summary #[nil "À ˆÁÂ!‡" [dired-why message "d-elete, u-ndelete, x-punge, f-ind, o-ther window, R-ename, C-opy, h-elp"] 2 (#$ . 26067) nil]) #@251 Undo in a dired buffer. This doesn't recover lost files, it just undoes changes in the buffer itself. You can use it to recover marks, killed lines or subdirs. In the latter case, you have to do \[dired-build-subdir-alist] to parse the buffer again. (defalias 'dired-undo #[nil "À )‡" [nil buffer-read-only undo] 1 (#$ . 26292) nil]) #@114 Move down lines then position at filename. Optional prefix ARG says how many lines to move; default is one line. (defalias 'dired-next-line #[(arg) "À !ˆÂ ‡" [next-line arg dired-move-to-filename] 2 (#$ . 26635) "p"]) #@112 Move up lines then position at filename. Optional prefix ARG says how many lines to move; default is one line. (defalias 'dired-previous-line #[(arg) "À !ˆÂ ‡" [previous-line arg dired-move-to-filename] 2 (#$ . 26860) "p"]) #@39 Goto ARG'th next directory file line. (defalias 'dired-next-dirline #[(arg &optional opoint) "„` ÂVƒÃ\fÅÆ $‚ÂyˆÇ\fÅÆ [$ƒ%È ‡bˆÉÊ!‡" [opoint arg 0 re-search-forward dired-re-dir nil t re-search-backward dired-move-to-filename error "No more subdirectories"] 5 (#$ . 27090) "p"]) #@43 Goto ARG'th previous directory file line. (defalias 'dired-prev-dirline #[(arg) "À [!‡" [dired-next-dirline arg] 2 (#$ . 27384) "p"]) #@151 Run dired on parent directory of current directory. Find the parent directory either in this buffer or another buffer. Creates a buffer if necessary. (defalias 'dired-up-directory #[(&optional other-window) "À Âà !!Åà !!†0AƒÇ\f!†0ƒ)É\f!ˆ‚-Ê\f!ˆÅ !*‡" [dired-current-directory dir file-name-directory directory-file-name up dired-goto-file dired-subdir-alist dired-goto-subdir other-window dired-other-window dired] 3 (#$ . 27525) "P"]) (defalias (quote dired-advertised-find-file) (quote dired-find-file)) #@59 In dired, visit the file or directory named on this line. (defalias 'dired-find-file #[nil "ÀÁ Ã\"!‡" [find-file file-name-sans-versions dired-get-filename t] 4 (#$ . 28049) nil]) #@58 In dired, visit the file or directory name you click on. (defalias 'dired-mouse-find-file-other-window #[(event) "ÀŠÂ Ä 8:ƒÄ‚Å 8)‰@)!qˆŠ Ä 8:ƒ+Ä‚,Å 8)‰A@:ƒ@A@@‚DA@)bˆÇ *È Ä 8:ƒYÄ‚ZÅ 8)‰@)!ˆÉÊ Ë\"!)‡" [nil file window-buffer event 2 1 position dired-get-filename select-window find-file-other-window file-name-sans-versions t] 5 (#$ . 28236) "e"]) #@179 In dired, examine a file in view mode, returning to dired when done. When file is a directory, show it in this buffer if it is inserted; otherwise, display it in another buffer. (defalias 'dired-view-file #[nil "ÀÁ !ƒ\nAƒÃÁ !†ÄÁ !‡ÅÁ !‡" [file-directory-p dired-get-filename dired-subdir-alist dired-goto-subdir dired view-file] 2 (#$ . 28615) nil]) #@59 In dired, visit this file or directory in another window. (defalias 'dired-find-file-other-window #[nil "ÀÁ Ã\"!‡" [find-file-other-window file-name-sans-versions dired-get-filename t] 4 (#$ . 28977) nil]) #@61 In dired, display this file or directory in another window. (defalias 'dired-display-file #[nil "ÀÁ Â\"ÄÅ !!)‡" [file-name-sans-versions dired-get-filename t file display-buffer find-file-noselect] 3 (#$ . 29190) nil]) #@430 In dired, return name of file mentioned on this line. Value returned normally includes the directory name. Optional arg LOCALP with value `no-dir' means don't include directory name in result. A value of t means construct name relative to `default-directory', which still may contain slashes if in a subdirectory. Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename on this line, otherwise an error occurs. (defalias 'dired-get-filename #[(&optional localp no-error-if-not-filep) "À‰‰‰ŠÅ?!‰ƒÇ!)\n…$ …$\n {‰ƒ@ÈÉ GÀ $ˆÊËÌÍ Î#†< ËQ!Ð=ƒK ‚U …UÑ! P,‡" [nil p2 p1 file case-fold-search dired-move-to-filename no-error-if-not-filep dired-move-to-end-of-filename set-text-properties 0 read "\"" dired-string-replace-match "\\([^\\]\\)\"" "\\1\\\\\"" localp no-dir dired-current-directory] 6 (#$ . 29417)]) #@224 Replace first match of REGEXP in STRING with NEWTEXT. If it does not match, nil is returned instead of the new string. Optional arg LITERAL means to take NEWTEXT literally. Optional arg GLOBAL means to replace all matches. (defalias 'dired-string-replace-match #[(regexp string newtext &optional literal global) "ƒ+ÁÃ\f \n#ƒ( GÁ•ZÇÉ\n $‰GZ)‚ )‡Ã\f Á#??…=ÇÉ\n $‡" [global 0 start string-match regexp string from-end replace-match newtext t literal] 6 (#$ . 30269)]) (defalias 'dired-make-absolute #[(file &optional dir) "† \nP‡" [dir default-directory file] 2]) (defalias 'dired-make-relative #[(file &optional dir no-error) "„ GÂVƒÂHÃUƒÄ!ÅÆÇ!P\"ƒ,•ÉO‡\nƒ4‡ËÌ#‡" [dir default-directory 0 126 expand-file-name string-match "^" regexp-quote file nil no-error error "%s: not in directory tree growing at %s"] 4]) #@72 Regular expression to match a month abbreviation followed by a number. (defvar dired-move-to-filename-regexp "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+ [ 0-9][0-9][:0-9][0-9][ 0-9] " (#$ . 31132)) (defalias 'dired-move-to-filename #[(&optional raise-error eol) "„ Áˆ`ÂyˆÃ\fÅ#ƒ•b‡… ÇÈ!‡" [eol nil 0 re-search-forward dired-move-to-filename-regexp t raise-error error "No file on this line"] 4]) (defalias 'dired-move-to-end-of-filename #[(&optional no-error) "À‰‰‰‰‰‰‰ÉÊ \"`ŠÀˆ`)\f…/ŠÍÎ Ï#)‰„¦ŠÐÑÀÏ#ƒbÒ”f‰Ó=\n…]ÉÔÕ”Õ•{Ö”Ö•{הו{Q\"‚k„kÙÚ!ˆ) ƒÍÛ Ï#ƒ¦Üuˆ\nƒ¦ƒ¦hÞ=ƒ¦ßuˆ‚¦ bˆ\nƒ¦à>„£ƒ¦ßuˆ„À`=ƒÀÙ\fƒ½áâ!‚¾Ú!ˆ`=?…É`.‡" [nil eol used-F case-fold-search hidden symlink executable file-type opoint string-match "F" dired-actual-switches selective-display search-forward " " t re-search-backward "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)" 1 108 "[xst]" 2 3 4 no-error error "No file on this line" " ->" -3 dired-ls-F-marks-symlinks 64 -1 (100 115) substitute-command-keys "File line is hidden, type \\[dired-hide-subdir] to unhide"] 9]) #@67 Alist of expanded directories and their associated dired buffers. (defvar dired-buffers nil (#$ . 32303)) (defalias 'dired-buffers-for-dir #[(dir) "À !\nɉ‰ƒK@‰AÈ\f!ƒ=É @\"ƒBÊ Š\fqˆ )\"ƒB\fB‚BÌ \n\"A‰„,‡" [file-name-as-directory dir dired-buffers nil buf elt result alist buffer-name dired-in-this-tree assoc dired-subdir-alist delq] 5]) (defalias 'dired-advertise #[nil "À !pÃ\n!>ƒÄ‚\npB B‰)‡" [expand-file-name default-directory expanded-default dired-buffers-for-dir t dired-buffers] 3]) (defalias 'dired-unadvertise #[(dir) "ÀÁ !\f\"\f\"‰‡" [delq assoc expand-file-name dir dired-buffers] 4]) (defalias 'dired-in-this-tree #[(file dir) "ÀÂÃÄ !P\")‡" [nil case-fold-search string-match "^" regexp-quote dir file] 4]) (defalias 'dired-normalize-subdir #[(dir) "ÀÁ\n!ƒ \n‚Ã\n\f\"!‡" [file-name-as-directory file-name-absolute-p dir expand-file-name default-directory] 4]) (defalias 'dired-get-subdir #[nil "ŠÀ Âyˆ`ÃÄ \"!ZÂU… *‡" [dired-current-directory cur-dir 0 dired-get-subdir-min assoc dired-subdir-alist] 5]) (defalias (quote dired-get-subdir-min) (quote cdr)) (defalias 'dired-get-subdir-max #[(elt) "ŠÀ !bˆÂ )‡" [dired-get-subdir-min elt dired-subdir-max] 2]) (defalias 'dired-clear-alist #[nil "…Á@!‰“ˆA‰„‡" [dired-subdir-alist dired-get-subdir-min nil] 4]) (defalias 'dired-subdir-index #[(dir) "ÀÁ\n ƒ# @@˜ƒÀÇ‚ A\fT‚ …(\f+‡" [nil 0 dired-subdir-alist alist index found dir t] 3]) #@47 Go to next subdirectory, regardless of level. (defalias 'dired-next-subdir #[(arg &optional no-error-if-not-found no-skip) "À Á‰Å\f!Z‰ÇY…È\n 8!‰ƒ/ bˆ\n„+ËÁwˆ`‚D\f?…DÍÎÇVƒBÏ‚CÐ\"+‡" [dired-current-directory nil index pos this-dir dired-subdir-index arg 0 dired-get-subdir-min dired-subdir-alist no-skip "^\n " no-error-if-not-found error "%s directory" "Last" "First"] 5 (#$ . 33778) "p"]) #@87 Build `dired-subdir-alist' by parsing the buffer. Returns the new value of the alist. (defalias 'dired-build-subdir-alist #[nil "À ˆŠÁ‰ebˆÂÇÂÉ#ƒ\\ŠÁ”bˆÁyˆÊuˆË \fÍŽÎ!+„\\ŠÐ”bˆÑ`Е{!`Е|ˆ cˆ) TÒ ŠÁ”bˆÁyˆÓ )\"ˆ‚ ÐVƒgÔÕ \"ˆ,‡" [dired-clear-alist 0 nil new-dir-name buffer-read-only count dired-subdir-alist re-search-forward dired-subdir-regexp t 2 match-data match-data ((store-match-data match-data)) looking-at dired-re-perms 1 expand-file-name dired-alist-add-1 point-marker message "Buffer includes %d directories"] 4 (#$ . 34193) nil]) (defalias 'dired-alist-add-1 #[(dir new-marker) "À !\nB B‰‡" [dired-normalize-subdir dir new-marker dired-subdir-alist] 2]) (defalias 'dired-goto-next-nontrivial-file #[nil "À ˆ ;…&m?…& ÃÄÅÆ\"†Ç!\"…&ÈyˆÉ ˆ‚‡" [dired-goto-next-file dired-trivial-filenames string-match file-name-nondirectory dired-get-filename nil t "" 1 dired-move-to-filename] 6]) (defalias 'dired-goto-next-file #[nil "À S ?…` W…Ãyˆ‚)‡" [dired-subdir-max max dired-move-to-filename 1] 2]) #@47 Go to file line of FILE in this dired buffer. (defalias 'dired-goto-file #[(file) "À !‰‰Æ !†ÇÈ \"Š É\n!˜ƒ$eb‚- AƒaÌ !ƒaÍ !Î  „`ÑÒPÓ#ƒ`ÔÕÖ\"šƒZ× ‰‚:Øyˆ‚9*) …h b+‡" [directory-file-name file nil dir case-fold-search found file-name-directory error "Need absolute pathname for %s" expand-file-name default-directory dired-subdir-alist dired-goto-subdir file-name-nondirectory dired-subdir-max boundary base search-forward " " move dired-get-filename no-dir t dired-move-to-filename 1] 5 (#$ . 35232) (byte-code "ÀÁÂà \"!CÄ ˆ‡" [expand-file-name read-file-name "Goto file: " dired-current-directory push-mark] 4)]) (defalias 'dired-initial-position #[(dirname) "Àˆ …  ‡" [nil dired-trivial-filenames dired-goto-next-nontrivial-file] 1]) #@210 Return the name of the subdirectory to which this line belongs. This returns a string with trailing slash, like `default-directory'. Optional argument means return a file name relative to `default-directory'. (defalias 'dired-current-directory #[(&optional localp) "`† ÁÂp\"Ƀ0@‰@È !X?…*A‰„ ƒ=Ê\f \"‚>\f,‡" [dired-subdir-alist error "No subdir-alist in %s" nil dir elt alist here dired-get-subdir-min localp dired-make-relative default-directory] 5 (#$ . 36006)]) (defalias 'dired-subdir-max #[nil "ŠAƒÁÂÉ#„d‚`)‡" [dired-subdir-alist dired-next-subdir 1 t] 4]) #@135 In dired, delete the files flagged for deletion. If NOMESSAGE is non-nil, we don't display any message if there are no flagged files. (defalias 'dired-do-flagged-delete #[(&optional nomessage) " ÄŠebˆÆ ÄÇ#)ƒ„Èĉ‰‰ \n  Ä\fŠebˆÆ ÄÇ#…4Í ‰\f??\n\fƒj\fbˆÎ `B B \fbˆÏyˆ\fĉ“ˆÆ ÄÇ#…dÍ ‰\f„@)\nƒu ‚zÎ `BC.Ð ˆÄ\"‚Œ†ŒÒÓ!+‡" [dired-del-marker dired-marker-char dired-marker-regexp regexp nil case-fold-search re-search-forward t dired-internal-do-deletions results found buffer-read-only next-position point-marker dired-get-filename 1 dired-move-to-filename nomessage message "(No deletions requested)"] 6 (#$ . 36611) nil]) #@40 Delete all marked (or next ARG) files. (defalias 'dired-do-delete #[(&optional arg) "ÀÁ‰‰‰ƒ2¨ƒ*ÇÈ\"ˆÉWƒ&\nŸ‚‹\n‚‹Ê `BC‚‹Ë Á\f ŠebˆÎ ÁÏ#…HÐ ‰\f??\fƒ|\fbˆÊ `B\nB\fbˆÑyˆ\fÁ‰“ˆÎ ÁÏ#…vÐ ‰\f„S) ƒ…\n‚ŠÊ `BC*,Ò ˆ\"‡" [dired-internal-do-deletions nil results found case-fold-search buffer-read-only arg dired-repeat-over-lines #[nil "À `B B‰‡" [dired-get-filename results] 2] 0 dired-get-filename dired-marker-regexp next-position regexp re-search-forward t point-marker 1 dired-move-to-filename] 6 (#$ . 37267) "P"]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp dired-deletion-confirmer yes-or-no-p current-load-list] 2) (defalias 'dired-internal-do-deletions #[(l arg) "ÀÁ\n\"\nGÃÀÇ\"ŸÈÉÊ ÌÍÎ\"\"%ƒgŠÐ\nƒD\n@AbˆÐÓÔÕˆ)\nA‰„/„TÖ× Ø !#ˆ‚cÙÌÚG Ø !$\"ˆ*‚kÖÛ!ˆ+Ü ‡" [mapcar car l 0 succ count files dired-make-relative dired-mark-pop-up " *Deletions*" delete dired-deletion-confirmer format "Delete %s " dired-mark-prompt arg nil failures buffer-read-only err (byte-code "@@ !@Ã=ƒÄ !ˆ‚Å !ˆTÇÈ #ˆÊyˆ`Ëyˆ`|ˆÌ !ˆ)‡" [l fn file-attributes t delete-directory delete-file succ message "%s of %s deletions" count 0 1 dired-clean-up-after-deletion] 4) ((error (byte-code "ÀÁ\n\"ˆ @@\fBÀ‡" [dired-log "%s\n" err l failures] 3))) message "%d deletion%s done" dired-plural-s dired-log-summary "%d of %d deletion%s failed" "(No deletions performed)" dired-move-to-filename] 11]) (defalias 'dired-clean-up-after-deletion #[(fn) "ŠA…Á\n!…à )‡" [dired-subdir-alist dired-goto-subdir fn dired-kill-subdir] 2]) (defalias 'dired-marker-regexp #[nil "ÀÁ !!P‡" ["^" regexp-quote char-to-string dired-marker-char] 4]) (defalias 'dired-plural-s #[(count) "ÁUƒ‡Ç" [count 1 "" "s"] 2]) (defalias 'dired-mark-prompt #[(arg files) "G‰ÂUƒ@‚ ¨ƒÄÅ \"‚ ÄÆ #)‡" [files count 1 arg format "[next %d files]" "%c [%d files]" dired-marker-char] 5]) (defalias 'dired-pop-to-buffer #[(buf) "„\nÁ !!‡Ä ʼnÉÊ ‰! Vƒ2Ì Í!Uƒ2‚OÉÎ ‰!‰\\VƒOÌ Í!UƒOŠ qˆdbˆÐÅxˆÑe`\"n„iT)É!‰\\Xƒ~Ò !‚’ÓÉ!]TZ]\"Ô \"ˆÉ!SWƒ³Õ!ˆÖÉ!SZ!ˆ×Ø\"+‡" [dired-shrink-to-fit pop-to-buffer get-buffer-create buf selected-window nil w2 target-lines window window-height get-largest-window split-height-threshold frame-width window-width get-lru-window window-min-height "\n " count-lines display-buffer split-window set-window-buffer select-window enlarge-window set-window-start 1] 6]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp dired-no-confirm nil current-load-list] 2) (defalias 'dired-mark-pop-up #[(bufname op-symbol files function &rest args) "„Á\n >„\fGÅUƒÆ\"‡ŠÉ!qˆÊ ˆË\f!ˆÌedÍ#ˆ)΋‡" [bufname " *Marked Files*" op-symbol dired-no-confirm files 1 apply function args get-buffer-create erase-buffer dired-format-columns-of-files remove-text-properties (mouse-face) ((byte-code "À !ˆÂ \f\"‡" [dired-pop-to-buffer bufname apply function args] 3))] 4]) (defalias 'dired-format-columns-of-files #[(files) "ÀÁÂÃ\f\"\"Å\\ÇÈ !ÅZ Ê ¥] \fG‰\f ¥\f ¦ÍUƒ2Í‚3Ê\\ÍÍÑ\f!Ò _\fZÓ\"¤‰GS\f›\f¡ˆWƒŽ Wƒ}_jˆ\f@cˆ\f›T‰‚^ÔcˆÍT\fA‚T.‡" [apply max mapcar length files 2 maxlen window-width selected-window width 1 columns nfiles 0 rows i j copy-sequence make-list "" "\n"] 6]) (defalias 'dired-repeat-over-lines #[(arg function) "À Âyˆ ÂVƒ<m„< SÂyˆm„%Ä ƒ%Åyˆ‚ŠÅyˆ `TÆ“ˆ)Š ˆ) bˆ‚ ÂWƒgo„g TÈyˆo„[Ä ƒ[Èyˆ‚LÂyˆŠ ˆ)‚< Ɖ“ˆÉ )‡" [make-marker pos 0 arg dired-between-files 1 nil function -1 dired-move-to-filename] 3]) (defalias 'dired-between-files #[nil "ÀÁ!†À\n!…ŠÃ )?‡" [looking-at "^$\\|^. *$\\|^. total\\|^. wildcard" dired-subdir-regexp dired-move-to-filename] 2]) #@70 Move to the next marked file, wrapping around the end of the buffer. (defalias 'dired-next-marked-file #[(arg &optional wrap opoint) "„` ÂVƒÃ\fÅÆ $‚ÂyˆÇ\fÅÆ [$ƒ%È ‡ „1bˆÊË!‡ÌÍ!ˆ ÂVƒ?e‚@dbˆÎ Å#‡" [opoint arg 0 re-search-forward dired-re-mark nil t re-search-backward dired-move-to-filename wrap error "No next marked file" message "(Wraparound for next marked file)" dired-next-marked-file] 5 (#$ . 40990) "p\np"]) #@74 Move to the previous marked file, wrapping around the end of the buffer. (defalias 'dired-prev-marked-file #[(arg &optional wrap) "À [\n\"‡" [dired-next-marked-file arg wrap] 3 (#$ . 41425) "p\np"]) (defalias 'dired-file-marker #[(file) "ŠÀ !…ÂyˆgÚ?…g)‡" [dired-goto-file file 0 32] 2]) (defalias 'dired-mark-files-in-region #[(start end) "À\n Vƒ\fÄÅ!ˆ\nbˆ` W…B` Wƒ&Æ ƒ&Çyˆ‚È !„<ÊÀË\"ƒ<ÌÇ!ˆ cˆÇyˆ‚)‡" [nil buffer-read-only start end error "start > end" dired-between-files 1 looking-at dired-re-dot dired-get-filename t delete-char dired-marker-char] 3]) #@225 Mark the current (or next ARG) files. If on a subdir headerline, mark all its files except `.' and `..'. Use \[dired-unmark-all-files] to remove all marks and \[dired-unmark] on a subdir to remove the marks in this subdir. (defalias 'dired-mark #[(arg) "À ƒ\nŠÁ )‡ÂÄÅ!Ç\")‡" [dired-get-subdir dired-mark-subdir-files nil buffer-read-only dired-repeat-over-lines prefix-numeric-value arg #[nil "ÀÁ!ˆ\nc‡" [delete-char 1 dired-marker-char] 2]] 3 (#$ . 42005) "P"]) #@107 Unmark the current (or next ARG) files. If looking at a subdir, unmark all its files except `.' and `..'. (defalias 'dired-unmark #[(arg) "À !)‡" [32 dired-marker-char dired-mark arg] 2 (#$ . 42480) "P"]) #@166 In dired, flag the current line's file for deletion. With prefix arg, repeat over several lines. If on a subdir headerline, mark all its files except `.' and `..'. (defalias 'dired-flag-file-deletion #[(arg) " !)‡" [dired-del-marker dired-marker-char dired-mark arg] 2 (#$ . 42694) "P"]) #@129 In dired, move up lines and remove deletion flag there. Optional prefix ARG says how many lines to unflag; default is one line. (defalias 'dired-unmark-backward #[(arg) "À [!‡" [dired-unmark arg] 2 (#$ . 42993) "p"]) #@61 History list of regular expressions used in Dired commands. (defvar dired-regexp-history nil (#$ . 43216)) (defalias 'dired-read-regexp #[(prompt) "À ‰‰Ã%‡" [read-from-minibuffer prompt nil dired-regexp-history] 6]) #@271 Mark all files matching REGEXP for use in later commands. A prefix argument means to unmark them instead. `.' and `..' are never marked. REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\.o$' for object files--just `.o' will mark more than you might think. (defalias 'dired-mark-files-regexp #[(regexp &optional marker-char) "† ‰ŠÅÆÇÈ\"ˆebˆm„JÉ\n!„Dl„DËÂÌ\"‰ …6ÎÐ !\")ƒDÑÒ!ˆ cˆ TÒyˆ‚ÆÓ ÈÔ ! Õ=ƒ[Ö‚\\× =ƒgÙ‚hÚ&ˆ) ÅV…s +‡" [marker-char dired-marker-char nil count buffer-read-only 0 message "Marking %ss..." "matching file" looking-at dired-re-dot dired-get-filename t fn string-match regexp file-name-nondirectory delete-char 1 "%s %s%s %s%s." dired-plural-s 32 "un" "" dired-del-marker "flagged" "marked"] 9 (#$ . 43440) (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark") " files (regexp): ")) (if current-prefix-arg 32))]) #@236 In dired, flag all files containing the specified REGEXP for deletion. The match is against the non-directory part of the filename. Use `^' and `$' to anchor matches. Exclude subdirs by hiding them. `.' and `..' are never flagged. (defalias 'dired-flag-files-regexp #[(regexp) "À \n\"‡" [dired-mark-files-regexp regexp dired-del-marker] 3 (#$ . 44335) (list (dired-read-regexp "Flag for deletion (regexp): "))]) #@72 Mark all symbolic links. With prefix argument, unflag all those files. (defalias 'dired-mark-symlinks #[(unflag-p) "ƒÁ‚ \nÉŠÆÇÈÉ\"ˆebˆm„4Ê !ƒ.ÌÍ!ˆ\ncˆ\fTÍyˆ‚ÇÎ\fÉÏ\f!\nÁ=ƒEЂFÑ\n=ƒQÓ‚RÔ&ˆ)\fÆV…]\f+‡" [unflag-p 32 dired-marker-char nil count buffer-read-only 0 message "Marking %ss..." "symbolic link" looking-at dired-re-sym delete-char 1 "%s %s%s %s%s." dired-plural-s "un" "" dired-del-marker "flagged" "marked"] 8 (#$ . 44757) "P"]) #@98 Mark all directory file lines except `.' and `..'. With prefix argument, unflag all those files. (defalias 'dired-mark-directories #[(unflag-p) "ƒÁ‚ \nÉŠÆÇÈÉ\"ˆebˆm„;Ê !ƒ5Ê\f!„5ÍÎ!ˆ\ncˆ\fTÎyˆ‚ÇÏ\fÉÐ\f!\nÁ=ƒLÑ‚MÒ\n=ƒXÔ‚YÕ&ˆ)\fÆV…d\f+‡" [unflag-p 32 dired-marker-char nil count buffer-read-only 0 message "Marking %ss..." "directory file" looking-at dired-re-dir dired-re-dot delete-char 1 "%s %s%s %s%s." dired-plural-s "un" "" dired-del-marker "flagged" "marked"] 8 (#$ . 45222) "P"]) #@74 Mark all executable files. With prefix argument, unflag all those files. (defalias 'dired-mark-executables #[(unflag-p) "ƒÁ‚ \nÉŠÆÇÈÉ\"ˆebˆm„4Ê !ƒ.ÌÍ!ˆ\ncˆ\fTÍyˆ‚ÇÎ\fÉÏ\f!\nÁ=ƒEЂFÑ\n=ƒQÓ‚RÔ&ˆ)\fÆV…]\f+‡" [unflag-p 32 dired-marker-char nil count buffer-read-only 0 message "Marking %ss..." "executable file" looking-at dired-re-exe delete-char 1 "%s %s%s %s%s." dired-plural-s "un" "" dired-del-marker "flagged" "marked"] 8 (#$ . 45738) "P"]) #@125 Flag for deletion files whose names suggest they are auto save files. A prefix argument says to unflag those files instead. (defalias 'dired-flag-auto-save-files #[(&optional unflag-p) "ƒÁ‚ \nĉŠÇÈÉÊ\"ˆebˆm„cŠÄˆhË=†4hÌ=…4ÍuˆhË=)ƒ]Î!„]Ðщ\"‰…OÓÔ!!)ƒ]ÕÖ!ˆ cˆ TÖyˆ‚È× ÊØ ! Á=ƒtÙ‚uÚ \n=ƒÛ‚€Ü&ˆ) ÇV…‹ +‡" [unflag-p 32 dired-del-marker dired-marker-char nil count buffer-read-only 0 message "Marking %ss..." "auto save file" 35 42 -1 looking-at dired-re-dir dired-get-filename t fn auto-save-file-name-p file-name-nondirectory delete-char 1 "%s %s%s %s%s." dired-plural-s "un" "" "flagged" "marked"] 9 (#$ . 46211) "P"]) #@103 Flag all backup files (names ending with `~') for deletion. With prefix argument, unflag these files. (defalias 'dired-flag-backup-files #[(&optional unflag-p) "ƒÁ‚ \nĉŠÇÈÉÊ\"ˆebˆm„aŠÄˆhË=†4hÌ=…4ÍuˆhË=)ƒ[Î!„[Ðщ\"‰…MÓ!)ƒ[ÔÕ!ˆ cˆ TÕyˆ‚ÈÖ Ê× ! Á=ƒrØ‚sÙ \n=ƒ}Ú‚~Û&ˆ) ÇV…‰ +‡" [unflag-p 32 dired-del-marker dired-marker-char nil count buffer-read-only 0 message "Marking %ss..." "backup file" 126 42 -1 looking-at dired-re-dir dired-get-filename t fn backup-file-name-p delete-char 1 "%s %s%s %s%s." dired-plural-s "un" "" "flagged" "marked"] 9 (#$ . 46866) "P"]) #@88 Change all OLD marks to NEW marks. OLD and NEW are both characters used to mark files. (defalias 'dired-change-marks #[(&optional old new) "Á=„\f\nÁ=ƒà ‡ÄÅ\"ÆŠebˆÉÆÊ#…IËUƒ9Ì  ÎŽÏÐÊ\"*‚:ʃÑÒ”Ò•\n$ˆ‚+‡" [old 13 new ding format "\n%c" nil buffer-read-only string search-forward t 32 match-data match-data ((store-match-data match-data)) dired-get-filename no-dir subst-char-in-region 0] 5 (#$ . 47465) (byte-code "ÀÂÃ!ˆÄ ÂÆ \"ˆÄ  +D‡" [t cursor-in-echo-area message "Change (old mark): " read-char old "Change %c marks to (new mark): " new] 3)]) #@54 Remove all marks from all files in the Dired buffer. (defalias 'dired-unmark-all-files-no-query #[nil "ÀÁ!‡" [dired-unmark-all-files 13] 2 (#$ . 48041) nil]) #@233 Remove a specific mark (or any mark) from every file. After this command, type the mark character to remove, or type RET to remove all marks. With prefix arg, query for each marked file. Type \[help-command] at that time for help. (defalias 'dired-unmark-all-files #[(mark &optional arg) "ŠÀÂÂÂÆÇ\" Ê ebˆÌ=ƒ&ÍÂÏ#‚,Ð ÂÏ#ƒLƒ>ÒÅÓÔÏ!#ƒÕ`S`hÖ$ˆ T‚× ØUƒWÙ‚XÚ \".‡" [0 count nil buffer-read-only case-fold-search query format "\n%c" mark string "Type SPC or `y' to unmark one file, DEL or `n' to skip to next,\n`!' to unmark all remaining files with no more questions." help-form 13 re-search-forward dired-re-mark t search-forward arg dired-query "Unmark file `%s'? " dired-get-filename subst-char-in-region 32 message 1 "1 mark removed" "%d marks removed"] 5 (#$ . 48206) "cRemove marks (RET means all): \nP"]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp dired-log-buffer "*Dired log*" current-load-list] 2) #@184 Pop up a buffer with error log output from Dired. A group of errors from a single command ends with a formfeed. Thus, use \[backward-page] to find the beginning of a group of errors. (defalias 'dired-why #[nil "À !… ÃÀ !!ÆŽÇ\f!ˆdbˆÈÉ!+‡" [get-buffer dired-log-buffer selected-window display-buffer window owindow ((select-window owindow)) select-window recenter -1] 4 (#$ . 49136) nil]) (defalias 'dired-log #[(log &rest args) "pÁŽÂ !qˆdbˆÄ;ƒ)ƒ#ÈÉ#‚%c‚HÊ!ƒ7Ë!‚HÌ=…HÍÎ ÏÐ!ѱ+‡" [obuf ((set-buffer obuf)) get-buffer-create dired-log-buffer nil buffer-read-only log args apply format bufferp insert-buffer t "\n " current-time-string " Buffer `" buffer-name "'\n\f\n"] 5]) (defalias 'dired-log-summary #[(string failures) "À ƒ ‚\nÃ\f #ˆÅÆ\fP!ˆÅÇ!‡" [message failures "%s--type ? for details (%s)" "%s--type ? for details" string dired-log "\n" t] 4]) #@77 String of `ls' switches (single letters) except `t' that influence sorting. (defvar dired-ls-sorting-switches "SXU" (#$ . 50025)) #@51 Regexp recognized by dired to set `by date' mode. (defvar dired-sort-by-date-regexp (concat "^-[^" dired-ls-sorting-switches "]*t[^" dired-ls-sorting-switches "]*$") (#$ . 50161)) #@51 Regexp recognized by dired to set `by name' mode. (defvar dired-sort-by-name-regexp (concat "^-[^t" dired-ls-sorting-switches "]+$") (#$ . 50347)) (defalias 'dired-sort-set-modeline #[nil "À \f\"ƒ Å‚Â\f\"ƒÇ‚È\fP) Ê ‡" [nil case-fold-search string-match dired-sort-by-name-regexp dired-actual-switches "Dired by name" dired-sort-by-date-regexp "Dired by date" "Dired " mode-name force-mode-line-update] 3]) #@138 Toggle between sort by date/name and refresh the dired buffer. With a prefix argument you can edit the current listing switches instead. (defalias 'dired-sort-toggle-or-edit #[(&optional arg) "ƒ ÁÂÃ\f\"!‡Å ‡" [arg dired-sort-other read-string "ls switches (must contain -l): " dired-actual-switches dired-sort-toggle] 4 (#$ . 50772) "P"]) (defalias 'dired-sort-toggle #[nil "ÀÂÃÄ ÆQÇ#ÉÊ ÆQ\"ƒÇ‚ËQ)Ì ˆÍ ‡" [nil case-fold-search "-l" dired-replace-in-string "[-lt" dired-ls-sorting-switches "]" "" dired-actual-switches string-match "[t" "t" dired-sort-set-modeline revert-buffer] 6]) (defalias 'dired-replace-in-string #[(regexp newtext string) "ÀÁ‰Ç #ƒ*Á”Á• \fO\nQ ‚  ÂOP,‡" ["" 0 nil me mb start result string-match regexp string newtext] 4]) (defalias 'dired-sort-other #[(switches &optional no-revert) "\nÃ=ƒ Ä ˆ †Æ ‡" [switches dired-actual-switches major-mode dired-mode dired-sort-set-modeline no-revert revert-buffer] 2]) #@148 Compare file at point with file FILE using `diff'. FILE defaults to the file at the mark. The prompted-for file is the first file given to `diff'. (autoload (quote dired-diff) "dired-aux" '(#$ . 51752) t) #@220 Diff this file with its backup file or vice versa. Uses the latest backup, if there are several numerical backups. If this file is a backup, diff it with its original. The backup file is the first file given to `diff'. (autoload (quote dired-backup-diff) "dired-aux" '(#$ . 51964) t) #@353 Flag numerical backups for deletion. Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest. Positive prefix arg KEEP overrides `dired-kept-versions'; Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive. To clear the flags on these files, you can use \[dired-flag-backup-files] with a prefix argument. (autoload (quote dired-clean-directory) "dired-aux" '(#$ . 52255) t) #@114 Change the mode of the marked (or next ARG) files. This calls chmod, thus symbolic modes like `g+w' are allowed. (autoload (quote dired-do-chmod) "dired-aux" '(#$ . 52683) t) #@53 Change the group of the marked (or next ARG) files. (autoload (quote dired-do-chgrp) "dired-aux" '(#$ . 52864) t) #@53 Change the owner of the marked (or next ARG) files. (autoload (quote dired-do-chown) "dired-aux" '(#$ . 52984) t) #@129 Print the marked (or next ARG) files. Uses the shell command coming from variables `lpr-command' and `lpr-switches' as default. (autoload (quote dired-do-print) "dired-aux" '(#$ . 53105) t) #@791 Run a shell command COMMAND on the marked files. If no files are marked or a specific numeric prefix arg is given, the next ARG files are used. Just \[universal-argument] means the current file. The prompt mentions the file(s) or the marker, as appropriate. If there is output, it goes to a separate buffer. Normally the command is run on each file individually. However, if there is a `*' in the command then it is run just once with the entire file list substituted there. No automatic redisplay of dired buffers is attempted, as there's no telling what files the command may have changed. Type \[dired-do-redisplay] to redisplay the marked files. The shell command has the top level directory as working directory, so output files usually are created there instead of in a subdir. (autoload (quote dired-do-shell-command) "dired-aux" '(#$ . 53302) t) #@97 Kill all marked lines (not the files). With a prefix arg, kill all lines not marked or flagged. (autoload (quote dired-do-kill-lines) "dired-aux" '(#$ . 54168) t) #@52 Compress or uncompress marked (or next ARG) files. (autoload (quote dired-do-compress) "dired-aux" '(#$ . 54337) t) #@53 Byte compile marked (or next ARG) Emacs Lisp files. (autoload (quote dired-do-byte-compile) "dired-aux" '(#$ . 54459) t) #@49 Load the marked (or next ARG) Emacs Lisp files. (autoload (quote dired-do-load) "dired-aux" '(#$ . 54586) t) #@179 Redisplay all marked (or next ARG) files. If on a subdir line, redisplay that subdirectory. In that case, a prefix arg lets you edit the `ls' switches used for the new listing. (autoload (quote dired-do-redisplay) "dired-aux" '(#$ . 54702) t) #@224 Replace first match of REGEXP in STRING with NEWTEXT. If it does not match, nil is returned instead of the new string. Optional arg LITERAL means to take NEWTEXT literally. Optional arg GLOBAL means to replace all matches. (autoload (quote dired-string-replace-match) "dired-aux" '(#$ . 54953) t) #@38 Create a directory called DIRECTORY. (autoload (quote dired-create-directory) "dired-aux" '(#$ . 55256) t) #@178 Copy all marked (or next ARG) files, or copy the current file. Thus, a zero prefix argument copies nothing. But it toggles the variable `dired-copy-preserve-time' (which see). (autoload (quote dired-do-copy) "dired-aux" '(#$ . 55370) t) #@308 Make symbolic links to current file or all marked (or next ARG) files. When operating on just the current file, you specify the new name. When operating on multiple or marked files, you specify a directory and new symbolic links are made in that directory with the same names that the files currently have. (autoload (quote dired-do-symlink) "dired-aux" '(#$ . 55615) t) #@304 Add names (hard links) current file or all marked (or next ARG) files. When operating on just the current file, you specify the new name. When operating on multiple or marked files, you specify a directory and new hard links are made in that directory with the same names that the files currently have. (autoload (quote dired-do-hardlink) "dired-aux" '(#$ . 55993) t) #@184 Rename current file or all marked (or next ARG) files. When renaming just the current file, you specify the new name. When renaming multiple or marked files, you specify a directory. (autoload (quote dired-do-rename) "dired-aux" '(#$ . 56368) t) #@441 Rename marked files containing REGEXP to NEWNAME. As each match is found, the user must type a character saying what to do with it. For directions, type \[help-command] at that time. NEWNAME may contain \=\ or \& as in `query-replace-regexp'. REGEXP defaults to the last regexp used. With a zero prefix arg, renaming by regexp affects the complete pathname - usually only the non-directory part of file names is used and changed. (autoload (quote dired-do-rename-regexp) "dired-aux" '(#$ . 56621) t) #@103 Copy all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info. (autoload (quote dired-do-copy-regexp) "dired-aux" '(#$ . 57138) t) #@107 Hardlink all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info. (autoload (quote dired-do-hardlink-regexp) "dired-aux" '(#$ . 57315) t) #@106 Symlink all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info. (autoload (quote dired-do-symlink-regexp) "dired-aux" '(#$ . 57500) t) #@54 Rename all marked (or next ARG) files to upper case. (autoload (quote dired-upcase) "dired-aux" '(#$ . 57682) t) #@54 Rename all marked (or next ARG) files to lower case. (autoload (quote dired-downcase) "dired-aux" '(#$ . 57801) t) #@432 Insert this subdirectory into the same dired buffer. If it is already present, just move to it (type \[dired-do-redisplay] to refresh), else inserts it at its natural place (as `ls -lR' would have done). With a prefix arg, you may edit the ls switches used for this listing. You can add `R' to the switches to expand the whole tree starting at this subdirectory. This function takes some pains to conform to `ls -lR' output. (autoload (quote dired-maybe-insert-subdir) "dired-aux" '(#$ . 57923) t) #@47 Go to next subdirectory, regardless of level. (autoload (quote dired-next-subdir) "dired-aux" '(#$ . 58433) t) #@129 Go to previous subdirectory, regardless of level. When called interactively and not on a subdir line, go to this subdir's line. (autoload (quote dired-prev-subdir) "dired-aux" '(#$ . 58551) t) #@163 Go to end of header line of DIR in this dired buffer. Return value of point on success, otherwise return nil. The next char is either \n, or \r if DIR is hidden. (autoload (quote dired-goto-subdir) "dired-aux" '(#$ . 58751) t) #@37 Mark all files except `.' and `..'. (autoload (quote dired-mark-subdir-files) "dired-aux" '(#$ . 58984) t) #@72 Remove all lines of current subdirectory. Lower levels are unaffected. (autoload (quote dired-kill-subdir) "dired-aux" '(#$ . 59097) t) #@37 Go up ARG levels in the dired tree. (autoload (quote dired-tree-up) "dired-aux" '(#$ . 59239) t) #@28 Go down in the dired tree. (autoload (quote dired-tree-down) "dired-aux" '(#$ . 59342) t) #@160 Hide or unhide the current subdirectory and move to next directory. Optional prefix arg is a repeat factor. Use \[dired-hide-all] to (un)hide all directories. (autoload (quote dired-hide-subdir) "dired-aux" '(#$ . 59439) t) #@192 Hide all subdirectories, leaving only their header lines. If there is already something hidden, make everything visible again. Use \[dired-hide-subdir] to (un)hide a particular subdirectory. (autoload (quote dired-hide-all) "dired-aux" '(#$ . 59670) t) (byte-code "Á=ƒ\nÂÃ!ˆÄÅ!ˆÆÇ!‡" [system-type vax-vms load "dired-vms" provide dired run-hooks dired-load-hook] 2) emacs-19.30/lisp/disass.elc100666 13437 1 7507 6046535326 14206 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 19:58:53 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/disass.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`disass.el' was compiled for Emacs 19.29 or later")) (require (quote byte-compile) "bytecomp") #@3 * (defvar disassemble-column-1-indent 8 (#$ . -518)) #@3 * (defvar disassemble-column-2-indent 10 (#$ . -576)) #@3 * (defvar disassemble-recursive-indent 3 (#$ . -635)) #@274 Print disassembled code for OBJECT in (optional) BUFFER. OBJECT can be a symbol defined as a function, or a function itself (a lambda expression or a compiled-function object). If OBJECT is not already compiled, we compile it, but do not redefine OBJECT if it is a symbol. (defalias 'disassemble #[(object &optional buffer indent interactive-p) "¢Á=ƒ\fÂÃE\f„ÅŠ„„.ÈÈqˆÉ\f?#‘ˆ‚8qˆÉ\fÃ#ˆ)Ç" [object byte-code lambda nil indent 0 interactive-p buffer "*Disassemble*" disassemble-internal] 5 (#$ . 696) (list (intern (completing-read "Disassemble function: " obarray (quote fboundp) t)) nil 0 t)]) (defalias 'disassemble-internal #[(obj indent interactive-p) "À‰‰‰ 9ƒ  K‰‚ Æ !ƒ!ÇÈ \"ˆ <ƒ6 @É=ƒ6Ê A@!ˆ K ¢Ä=ƒBË A <ƒS @Ì=ƒSÍÀ E <ƒc @Í=„cÇÎ!ˆ :ƒÌ ž„ƒ€Ð ƒ|Ñ‚}Ò \"ˆÓ !ƒÐÔ!ˆ :ƒž A‰@ A‚¢ ÕHÕUƒÔjˆ×Ø\f„· ƒ»Ù‚¼Ú\fƒÄÛ‚ÅÚ ƒÐ×Ü \"‚ÑÚ$cˆ :ƒä @;…è @‚èÝ Ë\"‰ƒ\n;ƒ :ƒú AjˆÞßp\"ˆàá\n\"ƒ\nÕ‰”OâP\n᱈)jˆãcˆä p\"ˆácˆ :ƒ2å ž‚> GæV…>å æHD‰%ƒ%A@% ¢¢å=ƒU Ajˆçcˆ%¢Ì=ƒtácˆè%)\\\"ˆ‚~Ë*ä%p\"ˆ)ácˆ) :ƒ˜Ì žƒ˜èÌ ž\"ˆ‚¿ë !ƒ§è \"ˆ‚¿ìcˆË*ä Aƒ¹í B‚» @p\"ˆ),…ÈÐÚ!‡" [nil args doc name macro obj subrp error "Can't disassemble #" autoload load t byte-code lambda "not a function" interactive-p message "Compiling %s's definition..." "Compiling definition..." byte-compile "Done compiling. Disassembling..." 0 indent format "byte code%s%s%s:\n" " for" "" " macro" " %s" documentation princ " doc: " string-match "\n" " ..." " args: " prin1 interactive 5 " interactive: " disassemble-1 disassemble-recursive-indent print-escape-newlines byte-code-function-p "Uncompiled body: " progn] 8]) #@120 Prints the byte-code call OBJ in the current buffer. OBJ should be a call to BYTE-CODE generated by the byte compiler. (defalias 'disassemble-1 #[(obj indent) "À‰ :ƒ A@ AA@‚!Ä !ˆ ÅH ÆHÇ\n \"À‰‰‰ \n \fÍÀ\f\fÐ\fž‰ƒ]AT‰ ˆ\f>A\f‚=+\fƒÚÀ\f@§ƒw\f@\fA\f\f@@ \f@A\n\fA\fjˆ Ð=ƒ©ƒŸÒÓ\"cˆÔ\n@!cˆ‚^ƒµÒÕ\"cˆ\\jˆ ƒØ×ØÙ !‰ \"ƒØ ÚÀO ‚ÛÛ  Ü=ƒåÝcˆ cˆß\\\\\\jˆàcˆ !>ƒ Ô\nA@!cˆ‚Ô â>ƒÔ\n!cˆ‚Ô ã>ƒ,ä\n@p\"ˆ‚Ô å>ƒÔ\n@\næ\n!„o\n¢ç=ƒNè\nž„o\n¢é=ƒæ\nA!„o\nA¢ç=ƒè\nAžƒæ\n!ƒ|êcˆ‚\n¢ç=ƒŠëcˆ‚ìcˆí\n.Å\\\\À#ˆ‚Ô\n¢è=ƒµïcˆð\n.\\\"ˆ‚Ô\n¢¢è=ƒÊñcˆòó\n\"ˆ‚Ôô5ä\np\"ˆ)öcˆ‚^.À‡" [nil constvec bytes obj fetch-bytecode 1 2 byte-decompile-bytecode pc-value opname arg op lap 0 tmp tagno TAG indent format "%d:" int-to-string "%d" disassemble-column-1-indent string-match "^byte-" symbol-name 5 "" byte-constant2 " #### shouldn't have seen constant2 here!\n " disassemble-column-2-indent -1 " " byte-goto-ops (byte-call byte-unbind byte-listN byte-concatN byte-insertN) (byte-varref byte-varset byte-varbind) prin1 (byte-constant byte-constant2) byte-code-function-p lambda byte-code macro "\n" "" "\n" disassemble-internal disassemble-recursive-indent "\n" disassemble-1 "(...)\n" mapcar #[(obj) "À \n \\\"‡" [disassemble-1 obj indent disassemble-recursive-indent] 4] t print-escape-newlines "\n"] 5 (#$ . 2393)]) emacs-19.30/lisp/disp-table.elc100666 12120 1 11643 6036627171 14623 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Oct 10 22:39:48 1995 ;;; from file /home/fsf/rms/e19/lisp/disp-table.el ;;; emacs version 19.29.15. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`disp-table.el' was compiled for Emacs 19.29 or later")) (put (quote display-table) (quote char-table-extra-slots) 6) #@36 Return a new, empty display table. (defalias 'make-display-table #[nil "ÀÁÂ\"‡" [make-char-table display-table nil] 3 (#$ . 540)]) (byte-code "„Á ÂÃÄÅ#ˆÂÆÄÇ#ˆÂÈÄÉ#ˆÂÊÄË#ˆÂÌÄÍ#ˆÂÎÄÏ#‡" [standard-display-table make-display-table put truncation display-table-slot 0 wrap 1 escape 2 control 3 selective-display 4 vertical-border 5] 4) #@134 Return the value of the extra slot in DISPLAY-TABLE named SLOT. SLOT may be a number from 0 to 5 inclusive, or a slot name (symbol). (defalias 'display-table-slot #[(display-table slot) "§ƒ ‚ÁN†ÂÃ\"Å\f\")‡" [slot display-table-slot error "Invalid display-table slot name: %s" slot-number char-table-extra-slot display-table] 3 (#$ . 882)]) #@198 Set the value of the extra slot in DISPLAY-TABLE named SLOT to VALUE. SLOT may be a number from 0 to 5 inclusive, or a name (symbol). See `display-table-slot-name-alist' for the names and numbers. (defalias 'set-display-table-slot #[(display-table slot value) "§ƒ ‚ÁN†ÂÃ\"Å\f#)‡" [slot display-table-slot error "Invalid display-table slot name: %s" slot-number set-char-table-extra-slot display-table value] 4 (#$ . 1241)]) #@49 Describe the display table DT in a help buffer. (defalias 'describe-display-table #[(dt) "ÀÁÂ!ˆÃÄ Æ\"!ˆÁÇ!ˆÃÄ È\"!ˆÁÉ!ˆÃÄ Ê\"!ˆÁË!ˆÃÄ Ì\"!ˆÁÍ!ˆÃÄ Î\"!ˆÁÏ!ˆÃÄ Ð\"!ˆÁÑ!ˆŠqˆÓÔÕ\"ÖÔWƒp HIˆT‰‚XÙ!ˆ*Ú ˆ)Û ‘‡" ["*Help*" princ "\nTruncation glyph: " prin1 display-table-slot dt truncation "\nWrap glyph: " wrap "\nEscape glyph: " escape "\nCtrl glyph: " control "\nSelective display glyph sequence: " selective-display "\nVertical window border glyph: " vertical-border "\nCharacter display glyph sequences:\n" standard-output make-vector 256 nil 0 i vector describe-vector help-mode print-help-return-message] 6 (#$ . 1685)]) #@70 Describe the display table in use in the selected window and buffer. (defalias 'describe-current-display-table #[nil "ÀÁ !†\f\n†\f ‰ƒÅ\f!‚ÆÇ!)‡" [window-display-table selected-window buffer-display-table standard-display-table disptab describe-display-table message "No display table"] 3 (#$ . 2332) nil]) #@51 Display characters in the range L to H literally. (defalias 'standard-display-8bit #[(l h) " X…(ÂYƒÃWƒ\fÅIˆ‚!\fÆ!IˆT‰‚‡" [l h 32 127 standard-display-table nil vector] 5 (#$ . 2651)]) #@68 Display characters in the range L to H using the default notation. (defalias 'standard-display-default #[(l h) " X…&ÂYƒÃWƒ\fÅIˆ‚\fÅIˆT‰‚‡" [l h 32 127 standard-display-table nil] 4 (#$ . 2857)]) #@47 Display character C using printable string S. (defalias 'standard-display-ascii #[(c s) "  !I‡" [standard-display-table c vconcat s] 4 (#$ . 3074)]) #@164 Display character C as character SC in the g1 character set. This function assumes that your terminal uses the SO/SI characters; it is meaningless for an X frame. (defalias 'standard-display-g1 #[(c sc) "ƒÁÂ!ˆ \fÅÆÇÈ !ÊQ!!I‡" [window-system error "Cannot use string glyphs in a windowing system" standard-display-table c vector create-glyph "" char-to-string sc ""] 7 (#$ . 3232)]) #@146 Display character C as character GC in graphics character set. This function assumes VT100-compatible escapes; it is meaningless for an X frame. (defalias 'standard-display-graphic #[(c gc) "ƒÁÂ!ˆ \fÅÆÇÈ !ÊQ!!I‡" [window-system error "Cannot use string glyphs in a windowing system" standard-display-table c vector create-glyph "(0" char-to-string gc "(B"] 7 (#$ . 3627)]) #@55 Display character C as character UC plus underlining. (defalias 'standard-display-underline #[(c uc) "ƒÁÂ!ˆ \fŃÆÈÉÊË!!Ì\"\"‚'ÍÎÏ!ÐQ!!I‡" [window-system require faces standard-display-table c vector logior uc lsh face-id internal-find-face underline 8 create-glyph "" char-to-string ""] 9 (#$ . 4012)]) (defalias 'create-glyph #[(string) "GÁUƒ ÂÃ!ˆGÄUƒÅÆÇÈ\"\"Å C\"‰GS‡" [glyph-table 65536 error "No free glyph codes remain" 32 vconcat make-vector 224 nil string] 6]) #@249 Toggle display of European characters encoded with ISO 8859. When enabled, characters in the range of 160 to 255 display not as octal escapes, but as accented characters. With prefix argument, enable European character display iff arg is positive. (defalias 'standard-display-european #[(arg) "À !ÂX„ „Ã\f!ƒ\fÅHÆšƒÇÅÈ\"‡ÉÅÈ\"‡" [prefix-numeric-value arg 0 char-table-p standard-display-table 160 [160] standard-display-default 255 standard-display-8bit] 3 (#$ . 4515) "P"]) (provide (quote disp-table)) emacs-19.30/lisp/dissociate.elc100666 13437 1 3152 5751546254 15043 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:21:59 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/dissociate.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/dissociate.el' was compiled for Emacs 19")) #@315 Dissociate the text of the current buffer. Output goes in buffer named *Dissociation*, which is redisplayed each time text is added to it. Every so often the user must say whether to continue. If ARG is positive, require ARG chars of continuity. If ARG is negative, require -ARG words of continuity. Default is 2. (defalias 'dissociated-press #[(&optional arg) "ƒ\nÁ!‚ ÂpÄÅ!ÇVƒÈ‚É\nÇVƒ*‚,[ ÇVƒ8Ì‚9ÍÇdeUƒHÐÑ!ˆÒ!ˆÓ ˆŠbˆÔÕ ÖZ!ˆ`dU†wdbˆ×Ø!…wÙÚ!ˆÛÜ!ˆdÝ)…!Þ‰ Š qˆ` \nÈ=ƒ±  áâ!\\\\‰dVƒª áâ!Ü\\\\bˆ‚»\n áâ!\\!ˆ`)`#ä  #ˆŠ#bˆÞˆi%VƒÜæ ˆ,Š qˆmƒëebˆ‚`\n [!ˆ`{'ádS!Tbˆ'ÞÝ#„`#Übˆ'#Ý#ˆ)))èÇ!ˆ‚P.‡" [arg prefix-numeric-value 2 inbuf get-buffer-create "*Dissociation*" outbuf 0 forward-char forward-word move-function move-amount search-forward word-search-forward search-function last-query-point error "The buffer contains no text to start from" switch-to-buffer erase-buffer vertical-motion window-height 4 y-or-n-p "Continue dissociation? " message "" recenter 1 t nil end start random 16 opoint insert-buffer-substring fill-column do-auto-fill overlap sit-for] 5 (#$ . 490) "P"]) emacs-19.30/lisp/docref.elc100666 12120 1 13544 6045212745 14040 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:13:52 1995 ;;; from file /home/fsf/rms/e19/lisp/docref.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`docref.el' was compiled for Emacs 19.29 or later")) #@235 *If non-nil, \(f@docref-subst) highlights cross-references. Under window system it highlights them with face defined by \(v@docref-highlight-face), on character terminal highlighted references look like cross-references in info mode. (defvar docref-highlight-p t (#$ . -473)) #@70 *Face used to highlight cross-references (used by \(f@docref-subst)) (defvar docref-highlight-face (quote highlight) (#$ . -755)) #@250 Alist which maps cross-reference ``types'' to retrieval functions. The car of each element is a string that serves as `type' in cross-references. (See \(f@docref-subst)). The cdr is a function of one argument, to be called to find this reference. (defvar docref-methods-alist (quote (("f" . docref-describe-function) ("v" . docref-describe-variable) ("F" . docref-read-file) ("s" . docref-use-string) ("V" . docref-use-variable-value) ("0" . beep))) (#$ . 892)) #@62 Label to use by \(f@docref-subst) for the go-back reference. (defvar docref-back-label "\nback" (#$ . 1362)) #@251 If non-nil, this is a go-back reference to add to the current buffer. The value specifies how to go back. It should be suitable for use as the second argument to \(f@docref-insert-label). \(f@docref-subst) uses this to set up the go-back reference. (defvar docref-back-reference nil (#$ . 1478)) (byte-code "À BÀ‡" [docref-last-active-buffer current-load-list] 2) #@84 Process docref cross-references in the current buffer. See also \(f@docref-subst). (defalias 'docref-setup #[nil "Àp!ˆÁ ‡" [docref-subst docref-mode] 2 (#$ . 1850) nil]) (byte-code "ÀÁ!„ÂÁ B „(Ä Æ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÌ#ˆ )‡" [boundp docref-mode-map nil current-load-list make-sparse-keymap map define-key [mouse-2] docref-follow-mouse "" docref-go-back "" docref-follow] 4) #@227 Major mode for help buffers that contain cross references. To follow a reference, move to it and type \[docref-follow], or use \[docref-follow-mouse]. The command \[docref-go-back] can used to go back to where you came from. (defalias 'docref-mode #[nil "À ˆÁÃÅ!ˆÇÁ!‡" [kill-all-local-variables docref-mode major-mode "Docref" mode-name use-local-map docref-mode-map run-hooks] 2 (#$ . 2236) nil]) #@673 Parse documentation cross-references in buffer BUF. Find cross-reference information in a buffer and highlight them with face defined by \(v@docref-highlight-face). Cross-reference has the following format: \ (TYPE[@LABEL]@DATA), where TYPE defines method used to retrive xref data (like reading from file or calling \(f@describe-function)), DATA is an argument to this method (like file name or function name), and LABEL is displayed in text using \(v@docref-highlight-face). The special reference `back' can be used to return back. The variable \(v@docref-back-label) specifies the label to use for that. See \(v@docref-methods-alist) for currently defined methods. (defalias 'docref-subst #[(buf) "ŠqˆebˆÁeÂ\"?…uà ÅÆÇÈ#ƒRÉ”\n˔˕{\f͔͕{Ï”ƒ;Ï”Ë\\Ï•{‚=ÑÒÈ\"ˆÓ\fB\"ˆ,‚ƒidbˆÕeeTÖ`$ˆÓ\"ˆÕeeTÂÈ$ˆØ\f!))‡" [buf get-text-property docref-seen buffer-modified-p old-modified re-search-forward "[\\](\\([^)@]+\\)\\(@[^)@]+\\)?@\\([^)]*\\))" nil t 0 start 1 type 3 data 2 label replace-match "" docref-insert-label docref-back-reference put-text-property docref-back-position docref-back-label set-buffer-modified-p] 5 (#$ . 2646) "b"]) (defalias 'docref-insert-label #[(string ref) "°`à ÅŽÆÇ\n\"ƒÈ•‚É*à \nËŽÆÌ\n\"ƒ+È”‚-\nG* ƒ_„T\nÉOÑ\n OÒ\n ÓO°‚_Ô Õ\n%ˆÔÉ\nG×\n%ˆ\nc,‡" [string pos label match-data match-data ((store-match-data match-data)) string-match "^\\([ \n]+\\)" 1 0 match-data ((store-match-data match-data)) "\\([ \n]+\\)$" trailing-space-start leading-space-end docref-highlight-p window-system "(*note " ")" nil put-text-property face docref-highlight-face docref ref] 7]) #@47 Follow the cross-reference that you click on. (defalias 'docref-follow-mouse #[(click) "Š‰A@)‰@\nA@pÆ !qˆÇ\f!-‡" [click event start window pos docref-last-active-buffer window-buffer docref-follow] 3 (#$ . 4301) "e"]) #@50 Go back to the previous contents of help buffer. (defalias 'docref-go-back #[nil "ÀeÁ\"‰ƒÃ\n!‚ÄÅ!)‡" [get-text-property docref-back-position pos docref-follow error "No go-back reference"] 4 (#$ . 4531) nil]) #@151 Follow cross-reference at point. For the cross-reference format, see \(f@docref-subst). The special reference named `back' can be used to return back (defalias 'docref-follow #[(&optional pos) "„`ÁÂ\"‰…E @ AÆ\f\"É \n` Ì\nB ΄6ÐÑ\f\"ˆÒŽŠA !ˆÓ‰. )‡" [pos get-text-property docref docref-data type name assoc docref-methods-alist method buffer-string cur-contents opoint "s" docref-back-reference nil success error "Unknown cross-reference type: %s" ((byte-code "„ Á ˆ\ncˆ bˆÄÅ!‡" [success erase-buffer cur-contents opoint set-buffer-modified-p nil] 2)) t] 4 (#$ . 4752) nil]) (defalias 'docref-describe-function #[(data) "ŠÀÁ!ƒ\n qˆÂÃ\f!!)‡" [boundp docref-last-active-buffer describe-function intern data] 3]) (defalias 'docref-describe-variable #[(data) "ŠÀÁ!ƒ\n qˆÂÃ\f!!)‡" [boundp docref-last-active-buffer describe-variable intern data] 3]) (defalias 'docref-read-file #[(data) "À Á ˆÂÃ\f!!‘‡" [buffer-name erase-buffer insert-file-contents expand-file-name data] 4]) (defalias 'docref-use-string #[(data) "À Á ˆ\nc‘‡" [buffer-name erase-buffer data] 2]) (defalias 'docref-use-variable-value #[(data) "À !Ã Ä ˆÅ\nJ!‘)‡" [intern data sym buffer-name erase-buffer princ] 3]) (provide (quote docref)) emacs-19.30/lisp/edt.elc100666 13437 1 130513 6045213115 13512 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:14:35 1995 ;;; from file /home/fsf/rms/e19/lisp/edt.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`edt.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require ehelp picture] 2) #@60 Last text deleted by an EDT emulation line delete command. (defvar edt-last-deleted-lines "" (#$ . 515)) #@60 Last text deleted by an EDT emulation word delete command. (defvar edt-last-deleted-words "" (#$ . 626)) #@65 Last text deleted by an EDT emulation character delete command. (defvar edt-last-deleted-chars "" (#$ . 737)) #@67 Key definition replaced with edt-define-key or edt-learn command. (defvar edt-last-replaced-key-definition "" (#$ . 853)) #@50 String indicating current direction of movement. (defvar edt-direction-string "" (#$ . 981)) #@38 Non-nil means select mode is active. (defvar edt-select-mode nil (#$ . 1080)) #@57 Text displayed in mode line when select mode is active. (defvar edt-select-mode-text "" (#$ . 1164)) #@43 String to indicate select mode is active. (defconst edt-select-mode-string " Select" (#$ . 1271)) #@61 Direction string in mode line to indicate forward movement. (defconst edt-forward-string " ADVANCE" (#$ . 1375)) #@62 Direction string in mode line to indicate backward movement. (defconst edt-backward-string " BACKUP" (#$ . 1494)) #@122 Non-nil indicates that default EDT emulation key bindings are active. Nil means user-defined custom bindings are active. (defvar edt-default-map-active nil (#$ . 1616)) #@140 Non-nil indicates that user custom EDT key bindings are configured. This means that an edt-user.el file was found in the user's load-path. (defvar edt-user-map-configured nil (#$ . 1792)) #@221 Non-nil leaves current value of page-delimiter unchanged. Nil causes the page-delimiter variable to be set to to "\f" when edt-emulation-on is first invoked. Original value is restored when edt-emulation-off is called. (defvar edt-keep-current-page-delimiter nil (#$ . 1987)) #@217 Non-nil causes the control key bindings to be replaced with EDT bindings. Nil (the default) means EDT control key bindings are not used and the current control key bindings are retained for use in the EDT emulation. (defvar edt-use-EDT-control-key-bindings nil (#$ . 2271)) #@52 *Specifies the list of EDT word entity characters. (defvar edt-word-entities (quote (9)) (#$ . -2551)) #@58 Non-nil if we are running Lucid or GNU Emacs version 19. (defconst edt-emacs19-p (byte-code "Á™?‡" [emacs-version "19"] 2) (#$ . 2660)) #@51 Non-nil if we are running Lucid Emacs version 19. (defconst edt-lucid-emacs19-p (byte-code "…Á \"‡" [edt-emacs19-p string-match "Lucid" emacs-version] 3) (#$ . 2803)) #@49 Non-nil if we are running GNU Emacs version 19. (defconst edt-gnu-emacs19-p (byte-code "… ?‡" [edt-emacs19-p edt-lucid-emacs19-p] 1) (#$ . 2980)) #@75 File mapping X function keys to LK-201 keyboard function and keypad keys. (defvar edt-xkeys-file nil (#$ . 3135)) #@127 Move forward to just after next page delimiter. Accepts a positive prefix argument for the number of page delimiters to move. (defalias 'edt-page-forward #[(num) "À !ˆmƒ\fÂÃ!‡Ä !ˆmƒÅ ‡Æ ‡" [edt-check-prefix num error "End of buffer" forward-page edt-line-to-bottom-of-window edt-line-to-top-of-window] 2 (#$ . 3256) "p"]) #@132 Move backward to just after previous page delimiter. Accepts a positive prefix argument for the number of page delimiters to move. (defalias 'edt-page-backward #[(num) "À !ˆoƒ\fÂÃ!‡Ä !ˆÅ ‡" [edt-check-prefix num error "Beginning of buffer" backward-page edt-line-to-top-of-window] 2 (#$ . 3588) "p"]) #@129 Move in current direction to next page delimiter. Accepts a positive prefix argument for the number of page delimiters to move. (defalias 'edt-page #[(num) " šƒ\n !‡Ä !‡" [edt-direction-string edt-forward-string edt-page-forward num edt-page-backward] 2 (#$ . 3897) "p"]) #@116 Move cursor forward two-thirds of a window. Accepts a positive prefix argument for the number of sections to move. (defalias 'edt-sect-forward #[(num) "À !ˆÂà ÄZÅ¥Æ_ _!‡" [edt-check-prefix num edt-line-forward window-height 1 3 2] 3 (#$ . 4179) "p"]) #@117 Move cursor backward two-thirds of a window. Accepts a positive prefix argument for the number of sections to move. (defalias 'edt-sect-backward #[(num) "À !ˆÂà ÄZÅ¥Æ_ _!‡" [edt-check-prefix num edt-line-backward window-height 1 3 2] 3 (#$ . 4437) "p"]) #@109 Move in current direction a full window. Accepts a positive prefix argument for the number windows to move. (defalias 'edt-sect #[(num) " šƒ\n !‡Ä !‡" [edt-direction-string edt-forward-string edt-sect-forward num edt-sect-backward] 2 (#$ . 4698) "p"]) #@119 Move backward to next beginning of line mark. Accepts a positive prefix argument for the number of BOL marks to move. (defalias 'edt-beginning-of-line #[(num) "À !ˆnƒ\f [y‡ S‰[y‡" [edt-check-prefix num] 3 (#$ . 4960) "p"]) #@112 Move forward to next end of line mark. Accepts a positive prefix argument for the number of EOL marks to move. (defalias 'edt-end-of-line-forward #[(num) "À !ˆÂuˆ ‡" [edt-check-prefix num nil] 2 (#$ . 5192) "p"]) #@113 Move backward to next end of line mark. Accepts a positive prefix argument for the number of EOL marks to move. (defalias 'edt-end-of-line-backward #[(num) "À !ˆ S‡" [edt-check-prefix num] 2 (#$ . 5413) "p"]) #@125 Move in current direction to next end of line mark. Accepts a positive prefix argument for the number of EOL marks to move. (defalias 'edt-end-of-line #[(num) " šƒ\n !‡Ä !‡" [edt-direction-string edt-forward-string edt-end-of-line-forward num edt-end-of-line-backward] 2 (#$ . 5630) "p"]) #@47 Move forward to first character of next word. (defalias 'edt-one-word-forward #[nil "mƒÀÁ!ˆlƒÂu‡g >ƒÂuˆ‚6l„6m„6gzÄ=„6g >„6Âuˆ‚l?…Tm?…TgzÄ=…Tg >?…TÂuˆ‚6‡" [error "End of buffer" nil edt-word-entities 32] 2 (#$ . 5928) nil]) #@52 Move backward to first character of previous word. (defalias 'edt-one-word-backward #[nil "oƒÀÁ!ˆnƒ ‡Â ˆn„-o„-gzÃ=ƒ-g\f>„- ˆ‚g\f>?…Sn?…So?…ShzÃ=?…Sh\f>?…S ˆ‚4‡" [error "Beginning of buffer" backward-char 32 edt-word-entities] 2 (#$ . 6175) nil]) #@115 Move forward to first character of next word. Accepts a positive prefix argument for the number of words to move. (defalias 'edt-word-forward #[(num) "À !ˆ ÂV…à ˆ S‰‚‡" [edt-check-prefix num 0 edt-one-word-forward] 3 (#$ . 6447) "p"]) #@120 Move backward to first character of previous word. Accepts a positive prefix argument for the number of words to move. (defalias 'edt-word-backward #[(num) "À !ˆ ÂV…à ˆ S‰‚‡" [edt-check-prefix num 0 edt-one-word-backward] 3 (#$ . 6694) "p"]) #@128 Move in current direction to first character of next word. Accepts a positive prefix argument for the number of words to move. (defalias 'edt-word #[(num) " šƒ\n !‡Ä !‡" [edt-direction-string edt-forward-string edt-word-forward num edt-word-backward] 2 (#$ . 6948) "p"]) #@119 Move in current direction to next character. Accepts a positive prefix argument for the number of characters to move. (defalias 'edt-character #[(num) "À !ˆ\n šƒ u‡Ä !‡" [edt-check-prefix num edt-direction-string edt-forward-string backward-char] 2 (#$ . 7229) "p"]) #@119 Move backward to next beginning of line mark. Accepts a positive prefix argument for the number of BOL marks to move. (defalias 'edt-line-backward #[(num) "À !‡" [edt-beginning-of-line num] 2 (#$ . 7505) "p"]) #@118 Move forward to next beginning of line mark. Accepts a positive prefix argument for the number of BOL marks to move. (defalias 'edt-line-forward #[(num) "À !ˆ y‡" [edt-check-prefix num] 2 (#$ . 7722) "p"]) #@131 Move in current direction to next beginning of line mark. Accepts a positive prefix argument for the number of BOL marks to move. (defalias 'edt-line #[(num) " šƒ\n !‡Ä !‡" [edt-direction-string edt-forward-string edt-line-forward num edt-line-backward] 2 (#$ . 7935) "p"]) #@41 Move cursor to the beginning of buffer. (defalias 'edt-top #[nil "eb‡" [] 1 (#$ . 8218) nil]) #@35 Move cursor to the end of buffer. (defalias 'edt-bottom #[nil "dbˆÀ ‡" [edt-line-to-bottom-of-window] 1 (#$ . 8318) nil]) #@68 Find first occurance of a string in forward direction and save it. (defalias 'edt-find-forward #[(&optional find) "„\nÁÂÃ!LˆÄ !…Å !‡" [find search-last-string read-string "Search forward: " search-forward search-backward] 3 (#$ . 8446) nil]) #@73 Find first occurance of a string in the backward direction and save it. (defalias 'edt-find-backward #[(&optional find) "„\nÁÂÃ!LˆÄ !‡" [find search-last-string read-string "Search backward: " search-backward] 3 (#$ . 8698) nil]) #@66 Find first occurance of string in current direction and save it. (defalias 'edt-find #[nil "ÀÁÂ!Lˆ \fšƒÅÆ!‡ÇÆ!‡" [search-last-string read-string "Search: " edt-direction-string edt-forward-string edt-find-forward t edt-find-backward] 3 (#$ . 8936) nil]) #@55 Find next occurance of a string in forward direction. (defalias 'edt-find-next-forward #[nil "ÀuˆÁ\nÃÄ#ƒÅ\n!‡ÆÀ!ˆÇÈ\n\"‡" [1 search-forward search-last-string nil t search-backward backward-char error "Search failed: \"%s\"."] 4 (#$ . 9198) nil]) #@56 Find next occurance of a string in backward direction. (defalias 'edt-find-next-backward #[nil "À ÂÃ#Â=…ÄÅ \"‡" [search-backward search-last-string nil t error "Search failed: \"%s\"."] 4 (#$ . 9453) nil]) #@55 Find next occurance of a string in current direction. (defalias 'edt-find-next #[nil " šƒ  ‡Ã ‡" [edt-direction-string edt-forward-string edt-find-next-forward edt-find-next-backward] 2 (#$ . 9667) nil]) #@48 Append this kill region to last killed region. (defalias 'edt-append #[nil "À ˆÁ ˆÂà `\"ˆÄÅ!‡" [edt-check-selection append-next-kill kill-region mark message "Selected text APPENDED to kill ring"] 3 (#$ . 9880) "*"]) #@132 Delete from cursor up to and including the end of line mark. Accepts a positive prefix argument for the number of lines to delete. (defalias 'edt-delete-line #[(num) "À !ˆ` yˆhÃ=„Äcˆ\n`{\n`|)‡" [edt-check-prefix num beg 10 "\n" edt-last-deleted-lines] 2 (#$ . 10104) "*p"]) #@132 Delete from cursor up to but excluding the end of line mark. Accepts a positive prefix argument for the number of lines to delete. (defalias 'edt-delete-to-end-of-line #[(num) "À !ˆ`Ãuˆ ˆ\n`{\n`|)‡" [edt-check-prefix num beg 1 edt-last-deleted-lines] 2 (#$ . 10389) "*p"]) #@123 Turn EDT select mode off if ARG is nil; otherwise, turn EDT select mode on. In select mode, selected text is highlighted. (defalias 'edt-select-mode #[(arg) "ƒÁÂ!ˆÃÄ ‚ÆÂ!ˆÇ ‡" [arg make-local-variable edt-select-mode edt-select-mode-text window-point rect-start-point kill-local-variable force-mode-line-update] 2 (#$ . 10672)]) #@46 Set mark at cursor and start text selection. (defalias 'edt-select #[nil "ÀÁ!‡" [set-mark-command nil] 2 (#$ . 11014) nil]) #@24 Cancel text selection. (defalias 'edt-reset #[nil "… ÁÃÄ!‡" [transient-mark-mode nil mark-active run-hooks deactivate-mark-hook] 2 (#$ . 11144) nil]) #@48 Deletes selected text but copies to kill ring. (defalias 'edt-cut #[nil "À ˆÁ `\"ˆÃÄ!‡" [edt-check-selection kill-region mark message "Selected text CUT to kill ring"] 3 (#$ . 11303) "*"]) #@112 Delete from cursor to beginning of line. Accepts a positive prefix argument for the number of lines to delete. (defalias 'edt-delete-to-beginning-of-line #[(num) "À !ˆ`à !ˆ`\n{\n`|)‡" [edt-check-prefix num beg edt-beginning-of-line edt-last-deleted-lines] 2 (#$ . 11500) "*p"]) #@140 Delete from cursor up to but excluding first character of next word. Accepts a positive prefix argument for the number of words to delete. (defalias 'edt-delete-word #[(num) "À !ˆ`à !ˆ\n`{\n`|)‡" [edt-check-prefix num beg edt-word-forward edt-last-deleted-words] 2 (#$ . 11787) "*p"]) #@112 Delete from cursor to beginning of word. Accepts a positive prefix argument for the number of words to delete. (defalias 'edt-delete-to-beginning-of-word #[(num) "À !ˆ`à !ˆ`\n{\n`|)‡" [edt-check-prefix num beg edt-word-backward edt-last-deleted-words] 2 (#$ . 12081) "*p"]) #@107 Delete character under cursor. Accepts a positive prefix argument for the number of characters to delete. (defalias 'edt-delete-character #[(num) "À !ˆ`d` \\^{`d` \\^|‡" [edt-check-prefix num edt-last-deleted-chars] 4 (#$ . 12364) "*p"]) #@113 Delete character in front of cursor. Accepts a positive prefix argument for the number of characters to delete. (defalias 'edt-delete-previous-character #[(num) "À !ˆe` Z]`{e` Z]`|‡" [edt-check-prefix num edt-last-deleted-chars] 3 (#$ . 12610) "*p"]) #@36 Undelete previous deleted line(s). (defalias 'edt-undelete-line #[nil "ÀÁ!ˆ\ncˆÃÁ!‡" [point-to-register 1 edt-last-deleted-lines register-to-point] 2 (#$ . 12868) "*"]) #@36 Undelete previous deleted word(s). (defalias 'edt-undelete-word #[nil "ÀÁ!ˆ\ncˆÃÁ!‡" [point-to-register 1 edt-last-deleted-words register-to-point] 2 (#$ . 13043) "*"]) #@41 Undelete previous deleted character(s). (defalias 'edt-undelete-character #[nil "ÀÁ!ˆ\ncˆÃÁ!‡" [point-to-register 1 edt-last-deleted-chars register-to-point] 2 (#$ . 13218) "*"]) #@53 Replace marked section with last CUT (killed) text. (defalias 'edt-replace #[nil "À ˆ`À ˆ `|ˆ) ‡" [exchange-point-and-mark beg yank] 2 (#$ . 13403) "*"]) #@83 Set movement direction forward. Also, execute command specified if in Minibuffer. (defalias 'edt-advance #[nil " ˆÃ Äà GÅ^OƘ…Ç ‡" [edt-forward-string edt-direction-string force-mode-line-update buffer-name 0 9 " *Minibuf" exit-minibuffer] 4 (#$ . 13565) nil]) #@84 Set movement direction backward. Also, execute command specified if in Minibuffer. (defalias 'edt-backup #[nil " ˆÃ Äà GÅ^OƘ…Ç ‡" [edt-backward-string edt-direction-string force-mode-line-update buffer-name 0 9 " *Minibuf" exit-minibuffer] 4 (#$ . 13837) nil]) #@544 Change the case of specified characters. If text selection IS active, then characters between the cursor and mark are changed. If text selection is NOT active, there are two cases. First, if the current direction is ADVANCE, then the prefix number of character(s) under and following cursor are changed. Second, if the current direction is BACKUP, then the prefix number of character(s) before the cursor are changed. Accepts a positive prefix for the number of characters to change, but the prefix is ignored if text selection is active. (defalias 'edt-change-case #[(num) "À !ˆ\nƒ5à `]``à ^bˆ` =„1ÆgXƒ%Ç‚&È``T\"ˆÉuˆ‚\fb*‡\n ˜ƒAÌ !ˆ ÍV…aÆgXƒQÇ‚RÈ``T\"ˆÉuˆ S‰‚B‡" [edt-check-prefix num edt-select-mode mark point-save end 97 upcase-region downcase-region 1 edt-direction-string edt-backward-string backward-char 0] 4 (#$ . 14111) "*p"]) #@206 Assign an interactively-callable function to a specified key sequence. The current key definition is saved in edt-last-replaced-key-definition. Use edt-restore-key to restore last replaced key definition. (defalias 'edt-define-key #[nil "À‰ÃÄ!‰ŘƒÆÇ!‚1ÈÉ!‰ʘƒ$ÆÇ!‚1ËÌ \" ÎÌ \n#*‡" [nil edt-key-definition-string edt-function read-key-sequence "Press the key to be defined: " " " message "Key not defined" read-command "Enter command name: " "" lookup-key current-global-map edt-last-replaced-key-definition define-key] 5 (#$ . 14975) nil]) #@123 Insert form feed character at cursor position. Accepts a positive prefix argument for the number of form feeds to insert. (defalias 'edt-form-feed-insert #[(num) "À !ˆ ÂV…Ãcˆ S‰‚‡" [edt-check-prefix num 0 12] 3 (#$ . 15534) "*p"]) #@111 Insert tab character at cursor position. Accepts a positive prefix argument for the number of tabs to insert. (defalias 'edt-tab-insert #[(num) "À !ˆ ÂV…Ãcˆ S‰‚‡" [edt-check-prefix num 0 9] 3 (#$ . 15777) "*p"]) #@43 Indicate error if prefix is not positive. (defalias 'edt-check-prefix #[(num) "ÁX… ÂÃ!‡" [num 0 error "Prefix must be positive"] 2 (#$ . 16000)]) #@48 Indicate error if EDT selection is not active. (defalias 'edt-check-selection #[nil "?…ÁÂ!‡" [edt-select-mode error "Selection NOT active"] 2 (#$ . 16154)]) #@28 Toggle movement direction. (defalias 'edt-change-direction #[nil " šƒ  ‡Ã ‡" [edt-direction-string edt-forward-string edt-backup edt-advance] 2 (#$ . 16320) nil]) #@45 Toggle to start (or cancel) text selection. (defalias 'edt-toggle-select #[nil "ƒÁ ‡Â ‡" [edt-select-mode edt-reset edt-select] 1 (#$ . 16492) nil]) #@113 Move forward to start of next sentence. Accepts a positive prefix argument for the number of sentences to move. (defalias 'edt-sentence-forward #[(num) "À !ˆmƒ\fÂÃ!‡Ä !ˆÅ ‡" [edt-check-prefix num error "End of buffer" forward-sentence edt-one-word-forward] 2 (#$ . 16651) "p"]) #@115 Move backward to next sentence beginning. Accepts a positive prefix argument for the number of sentences to move. (defalias 'edt-sentence-backward #[(num) "À !ˆmƒ\fÂÃ!‡Ä !‡" [edt-check-prefix num error "End of buffer" backward-sentence] 2 (#$ . 16937) "p"]) #@117 Move in current direction to next sentence. Accepts a positive prefix argument for the number of sentences to move. (defalias 'edt-sentence #[(num) " šƒ\n !‡Ä !‡" [edt-direction-string edt-forward-string edt-sentence-forward num edt-sentence-backward] 2 (#$ . 17203) "p"]) #@114 Move forward to beginning of paragraph. Accepts a positive prefix argument for the number of paragraphs to move. (defalias 'edt-paragraph-forward #[(num) "À !ˆ ÂV…$ÃÄ!ˆÅ ˆÆÄ!ˆlƒÃÄ!ˆ S‰‚‡" [edt-check-prefix num 0 next-line 1 forward-paragraph previous-line] 3 (#$ . 17486) "p"]) #@115 Move backward to beginning of paragraph. Accepts a positive prefix argument for the number of paragraphs to move. (defalias 'edt-paragraph-backward #[(num) "À !ˆ ÂV… à ˆÄÅ!ˆlƒÆÅ!ˆ S‰‚‡" [edt-check-prefix num 0 backward-paragraph previous-line 1 next-line] 3 (#$ . 17777) "p"]) #@118 Move in current direction to next paragraph. Accepts a positive prefix argument for the number of paragraph to move. (defalias 'edt-paragraph #[(num) " šƒ\n !‡Ä !‡" [edt-direction-string edt-forward-string edt-paragraph-forward num edt-paragraph-backward] 2 (#$ . 18067) "p"]) #@97 Restore last replaced key definition. Definition is stored in edt-last-replaced-key-definition. (defalias 'edt-restore-key #[nil "ƒ ÁÂÃÄ!Lˆ\nŘƒÆÇ!‚ÈÉ \n#)‡ÊË!‡" [edt-last-replaced-key-definition nil edt-key-definition-string read-key-sequence "Press the key to be restored: " " " message "Key not restored" define-key current-global-map error "No replaced key definition to restore!"] 4 (#$ . 18353) nil]) #@43 Move the cursor to the top of the window. (defalias 'edt-window-top #[nil "iÁÂ!ˆÃ!)‡" [start-column move-to-window-line 0 move-to-column] 2 (#$ . 18774) nil]) #@46 Move the cursor to the bottom of the window. (defalias 'edt-window-bottom #[nil "iÁ ÃZ!ˆÄ!)‡" [start-column move-to-window-line window-height 2 move-to-column] 3 (#$ . 18941) nil]) #@68 Move window forward one line leaving cursor at position in window. (defalias 'edt-scroll-window-forward-line #[nil "ÀÁ!‡" [scroll-up 1] 2 (#$ . 19131) nil]) #@69 Move window backward one line leaving cursor at position in window. (defalias 'edt-scroll-window-backward-line #[nil "ÀÁ!‡" [scroll-down 1] 2 (#$ . 19294) nil]) #@44 Move window one line in current direction. (defalias 'edt-scroll-line #[nil " šƒ  ‡Ã ‡" [edt-direction-string edt-forward-string edt-scroll-window-forward-line edt-scroll-window-backward-line] 2 (#$ . 19461) nil]) #@123 Scroll forward one window in buffer, less one line. Accepts a positive prefix argument for the number of windows to move. (defalias 'edt-scroll-window-forward #[(num) "À !ˆÂà _ÄZ!ˆÅà ÆZÄ¥!‡" [edt-check-prefix num scroll-up window-height 2 edt-line-forward 1] 3 (#$ . 19685) "p"]) #@124 Scroll backward one window in buffer, less one line. Accepts a positive prefix argument for the number of windows to move. (defalias 'edt-scroll-window-backward #[(num) "À !ˆÂà _ÄZ!ˆÅà ÆZÄ¥!‡" [edt-check-prefix num scroll-down window-height 2 edt-line-backward 1] 3 (#$ . 19973) "p"]) #@134 Scroll one window in buffer, less one line, in current direction. Accepts a positive prefix argument for the number windows to move. (defalias 'edt-scroll-window #[(num) " šƒ\n !‡Ä !‡" [edt-direction-string edt-forward-string edt-scroll-window-forward num edt-scroll-window-backward] 2 (#$ . 20266) "p"]) #@52 Move the current line to the bottom of the window. (defalias 'edt-line-to-bottom-of-window #[nil "ÀÁ!‡" [recenter -1] 2 (#$ . 20580) nil]) #@49 Move the current line to the top of the window. (defalias 'edt-line-to-top-of-window #[nil "ÀÁ!‡" [recenter 0] 2 (#$ . 20725) nil]) #@65 Move window so line with cursor is in the middle of the window. (defalias 'edt-line-to-middle-of-window #[nil "ÀÁ!‡" [recenter (4)] 2 (#$ . 20863) nil]) #@60 Move to specified percentage in buffer from top of buffer. (defalias 'edt-goto-percentage #[(num) "ÁV„\fÂWƒÃÄ\"‡d_Á¥b‡" [num 100 0 error "Percentage %d out of range 0 < percent < 100"] 3 (#$ . 21022) "NGoto-percentage: "]) #@21 Fill selected text. (defalias 'edt-fill-region #[nil "À ˆÁ` \"‡" [edt-check-selection fill-region mark] 3 (#$ . 21258) "*"]) #@73 Fill region in text modes, indent region in programming language modes. (defalias 'edt-indent-or-fill-region #[nil "Á˜ƒ Â`à Ä#‡Å`à \"‡" [paragraph-start "$\\|\f" indent-region mark nil fill-region] 4 (#$ . 21390) "*"]) #@198 Mark the section in a manner consistent with the major-mode. Uses mark-defun for emacs-lisp and lisp, mark-c-function for C, mark-fortran-subsystem for fortran, and mark-paragraph for other modes. (defalias 'edt-mark-section-wisely #[nil "ƒÁ ‡\nÃ=„\nÄ=ƒÅ ˆÆÇ!‡\nÈ=ƒ'É ˆÆÊ!‡\nË=ƒ4Ì ˆÆÍ!‡Î ˆÆÏ!‡" [edt-select-mode edt-reset major-mode emacs-lisp-mode lisp-mode mark-defun message "Lisp defun selected" c-mode mark-c-function "C function selected" fortran-mode mark-fortran-subprogram "Fortran subprogram selected" mark-paragraph "Paragraph selected"] 2 (#$ . 21618) nil]) #@57 Copy selected region to kill ring, but don't delete it! (defalias 'edt-copy #[nil "À ˆÁ `\"ˆÃ ˆÄÅ!‡" [edt-check-selection copy-region-as-kill mark edt-reset message "Selected text COPIED to kill ring"] 3 (#$ . 22203) nil]) #@140 Cuts (or copies) selected text to kill ring. Cuts selected text if buffer-read-only is nil. Copies selected text if buffer-read-only is t. (defalias 'edt-cut-or-copy #[nil "ƒÁ ‡Â ‡" [buffer-read-only edt-copy edt-cut] 1 (#$ . 22434) nil]) #@63 Delete entire line regardless of cursor position in the line. (defalias 'edt-delete-entire-line #[nil "ÀyˆÁÂ!‡" [0 edt-delete-line 1] 2 (#$ . 22682) "*"]) #@106 Duplicate a line of text. Accepts a positive prefix argument for the number times to duplicate the line. (defalias 'edt-duplicate-line #[(num) "À !ˆi Ä ˆÅ ˆ\nÆVƒÅ ˆ\nS‰‚Ç !ˆÈ !*‡" [edt-check-prefix num count old-column edt-delete-entire-line edt-undelete-line 0 edt-line-forward move-to-column] 3 (#$ . 22844) "*p"]) #@71 Duplicate word (or rest of word) found directly above cursor, if any. (defalias 'edt-duplicate-word #[nil "`iÂyˆÃ!ˆ `š„>l„>hÄšƒ$iWƒ$Å ˆ`Ç ˆ`{)ÉyˆÃ!ˆc‚N `š„GÉyˆÃ!ˆÊË!*‡" [start-column start -1 move-to-column 9 backward-char beg edt-one-word-forward edt-last-copied-word nil error "Nothing to duplicate!"] 2 (#$ . 23174) "*"]) #@64 Displays message that key has not been assigned to a function. (defalias 'edt-key-not-assigned #[nil "ÀÁ!‡" [error "Key not assigned"] 2 (#$ . 23525) nil]) #@73 Toggle the capitalization of the current word and move forward to next. (defalias 'edt-toggle-capitalization-of-word #[nil "À ˆÁ ˆÂÃ!ˆÁ ˆÀ ‡" [edt-one-word-forward edt-one-word-backward edt-change-case 1] 2 (#$ . 23687) "*"]) #@50 Convert all tabs to spaces in the entire buffer. (defalias 'edt-eliminate-all-tabs #[nil "Àed\"ˆÁÂ!‡" [untabify message "TABS converted to SPACES"] 3 (#$ . 23919) "*"]) #@27 Display the current time. (defalias 'edt-display-the-time #[nil "ÀÁ LˆÂ!‡" [time-string current-time-string message] 2 (#$ . 24094) nil]) #@51 Learn a sequence of key strokes to bind to a key. (defalias 'edt-learn #[nil "Á=ƒ  ‡ÃÄ!‡" [defining-kbd-macro t edt-remember start-kbd-macro nil] 2 (#$ . 24239) nil]) #@66 Store the sequence of key strokes started by edt-learn to a key. (defalias 'edt-remember #[nil "Á=ƒ\nÂÃ!‡ÄÁ!ˆÁÅÆÇ!Lˆ Șƒ\"ÉÊ!‚?Ë Ì\\LˆÍÎ \"ÐÎ ÑÒÓÔ !P!!#)‡" [defining-kbd-macro nil error "Nothing to remember!" end-kbd-macro edt-key-definition-string read-key-sequence "Enter key for binding: " " " message "Key sequence not remembered" edt-learn-macro-count 1 lookup-key current-global-map edt-last-replaced-key-definition define-key name-last-kbd-macro intern "last-learned-sequence-" int-to-string] 8 (#$ . 24415) nil]) #@70 Save current buffer, ask to save other buffers, and then exit Emacs. (defalias 'edt-exit #[nil "À ˆÁ ‡" [save-buffer save-buffers-kill-emacs] 1 (#$ . 24953) nil]) #@36 Quit Emacs without saving changes. (defalias 'edt-quit #[nil "À ‡" [kill-emacs] 1 (#$ . 25122) nil]) #@58 Split current window and place cursor in the new window. (defalias 'edt-split-window #[nil "À ˆÁÂ!‡" [split-window other-window 1] 2 (#$ . 25229) nil]) #@63 Copy a rectangle of text between mark and cursor to register. (defalias 'edt-copy-rectangle #[nil "À ˆÁÂÃ Ä Å$ˆÆ ˆÇÈ!‡" [edt-check-selection copy-rectangle-to-register 3 region-beginning region-end nil edt-reset message "Selected rectangle COPIED to register"] 5 (#$ . 25387) nil]) #@142 Cut a rectangle of text between mark and cursor to register. Replace cut characters with spaces and moving cursor back to upper left corner. (defalias 'edt-cut-rectangle-overstrike-mode #[nil "À ˆÁ ÃÁ Ä Å#ˆÆÇÈ !\n\"ˆÉÊ!‡" [edt-check-selection region-beginning edt-rect-start-point picture-clear-rectangle-to-register region-end 3 set-window-point get-buffer-window window-buffer message "Selected rectangle CUT to register"] 4 (#$ . 25676) "*"]) #@101 Cut a rectangle of text between mark and cursor to register. Move cursor back to upper left corner. (defalias 'edt-cut-rectangle-insert-mode #[nil "À ˆÁ ÃÁ Ä ÅÆ$ˆÇ ˆÈÉÊ !\n\"ˆËÌ!‡" [edt-check-selection region-beginning edt-rect-start-point picture-clear-rectangle-to-register region-end 3 t fixup-whitespace set-window-point get-buffer-window window-buffer message "Selected rectangle CUT to register"] 5 (#$ . 26130) "*"]) #@114 Cut a rectangular region of text to register. If overwrite mode is active, cut text is replaced with whitespace. (defalias 'edt-cut-rectangle #[nil "ƒÁ ‡Â ‡" [overwrite-mode edt-cut-rectangle-overstrike-mode edt-cut-rectangle-insert-mode] 1 (#$ . 26562) "*"]) #@77 Paste a rectangular region of text from register, replacing text at cursor. (defalias 'edt-paste-rectangle-overstrike-mode #[nil "ÀÁ!‡" [picture-yank-rectangle-from-register 3] 2 (#$ . 26831) "*"]) #@72 Paste previously deleted rectangular region, inserting text at cursor. (defalias 'edt-paste-rectangle-insert-mode #[nil "ÀÁÂ\"‡" [picture-yank-rectangle-from-register 3 t] 3 (#$ . 27035) "*"]) #@116 Paste a rectangular region of text. If overwrite mode is active, existing text is replace with text from register. (defalias 'edt-paste-rectangle #[nil "ƒÁ ‡Â ‡" [overwrite-mode edt-paste-rectangle-overstrike-mode edt-paste-rectangle-insert-mode] 1 (#$ . 27235) nil]) #@519 Change specified characters to lower case. If text selection IS active, then characters between the cursor and mark are changed. If text selection is NOT active, there are two situations. If the current direction is ADVANCE, then the word under the cursor is changed to lower case and the cursor is moved to rest at the beginning of the next word. If the current direction is BACKUP, the word prior to the word under the cursor is changed to lower case and the cursor is left to rest at the beginning of that word. (defalias 'edt-lowercase #[nil "ƒ\nÁ `\"‡o„0m„0n„0l„0hzÃ=„0h\f>„0g\f>„0Å ˆšƒ;Å ˆ`É ˆÁ`\"ˆ)š…RÅ ‡" [edt-select-mode downcase-region mark 32 edt-word-entities edt-one-word-backward edt-direction-string edt-backward-string beg edt-one-word-forward] 3 (#$ . 27513) "*"]) #@519 Change specified characters to upper case. If text selection IS active, then characters between the cursor and mark are changed. If text selection is NOT active, there are two situations. If the current direction is ADVANCE, then the word under the cursor is changed to upper case and the cursor is moved to rest at the beginning of the next word. If the current direction is BACKUP, the word prior to the word under the cursor is changed to upper case and the cursor is left to rest at the beginning of that word. (defalias 'edt-uppercase #[nil "ƒ\nÁ `\"‡o„0m„0n„0l„0hzÃ=„0h\f>„0g\f>„0Å ˆšƒ;Å ˆ`É ˆÁ`\"ˆ)š…RÅ ‡" [edt-select-mode upcase-region mark 32 edt-word-entities edt-one-word-backward edt-direction-string edt-backward-string beg edt-one-word-forward] 3 (#$ . 28329) "*"]) #@39 Most recent response to edt-y-or-n-p. (defvar edt-last-answer nil (#$ . 29142)) #@172 Prompt for a y or n answer with positive default. Optional second argument NOT-YES changes default to negative. Like emacs y-or-n-p, also accepts space as y and DEL as n. (defalias 'edt-y-or-n-p #[(prompt &optional not-yes) "ÀÁ \fƒ\fÅ‚ Æ#!ˆÇƒ|ÉÊ ‰ ÌU„3 ÍU„3 ÎUƒ9Ç‚x ÐU„N ÑU„N ÒUƒTÉ‚x ÓUƒb\f?‚xÇÔ ˆÀÁÕ \fƒtÅ‚uÆ#!ˆ)‚)‡" [message format "%s[%s]" prompt not-yes "n" "y" t doit nil read-char ans 121 89 32 edt-last-answer 110 78 127 13 beep "Please answer y or n. %s[%s]"] 6 (#$ . 29229)]) #@188 Load the EDT X-windows key definitions FILE. If FILE is nil, try to load a default file. The default file names are ~/.edt-lucid-keys for Lucid emacs, and ~/.edt-gnu-keys for GNU emacs. (defalias 'edt-load-xkeys #[(file) "ƒ Á!‚)\nƒÁ\n!‚) ƒ!ÁÄ!‚) ƒ)ÁÆ!Ç!ƒ3È!‡ÉÊ!ˆË ˆÌcˆÍΉÏÁÐ!C\"„‡ƒ‡@ÕÖ@\"ƒiׂjØQÙ!ƒÚ!„ÛA‚Oƒ¦ÜÝ\"cˆÞß!ƒ È!‚°àá!‚°âcˆãä!ˆàá!,‡" [file expand-file-name edt-xkeys-file edt-gnu-emacs19-p "~/.edt-gnu-keys" edt-lucid-emacs19-p "~/.edt-lucid-keys" file-readable-p load-file switch-to-buffer "*scratch*" erase-buffer "\n\n Ack!! You're running the Enhanced EDT Emulation under X-windows\n without loading an EDT X key definition file. To create an EDT X\n key definition file, run the edt-mapper.el program. But ONLY run\n it from an Emacs loaded without any of your own customizations\n found in your .emacs file, etc. Some user customization confuse\n the edt-mapper function. To do this, you need to invoke Emacs\n as follows:\n\n emacs -q -l edt-mapper.el\n \n The file edt-mapper.el includes these same directions on how to\n use it! Perhaps it's laying around here someplace. \n " "edt-mapper.el" nil append "." load-path search-list path found string-match "/$" "" "/" file-exists-p file-directory-p t format "Ah yes, there it is, in \n\n %s \n\n" edt-y-or-n-p "Do you want to run it now? " error "EDT Emulation not configured." "Nope, I can't seem to find it. :-(\n\n" sit-for 20] 6 (#$ . 29763) "fX key definition file: "]) #@24 Turn on EDT Emulation. (defalias 'edt-emulation-on #[nil "Á˜ƒ ‚ÄÅ! Æ GÇ^OȘƒÉ Ê ‰\fƒPÍÎ\fPω#„PÐÑ\f\"‰ ƒI\fÆ O‰\f‚$ʉ\f„'Ó=ƒ^ÔÊ!ˆ‚h\f„hÕÖ \"ˆ\f*ÙÚÛ\"ˆÙÜÝ\"ˆÍÞω#ƒ…ß ‡à ‡" [system-type "ms-dos" "pc" edt-term getenv "TERM" 0 2 "vt" "vt100" nil hyphend term load "edt-" t string-match "[-_][^-_]+$" window-system x edt-load-xkeys error "Unable to load EDT terminal specific file for %s" transient-mark-mode edt-orig-transient-mark-mode add-hook activate-mark-hook #[nil "ÀÁ!‡" [edt-select-mode t] 2] deactivate-mark-hook #[nil "ÀÁ!‡" [edt-select-mode nil] 2] "edt-user" edt-user-emulation-setup edt-default-emulation-setup] 5 (#$ . 31341) nil]) #@63 Select original global key bindings, disabling EDT Emulation. (defalias 'edt-emulation-off #[nil "À !ˆ\n„\n ÅÇÉ ˆÊË!ˆ\f ÎÏ!‡" [use-global-map global-map edt-keep-current-page-delimiter edt-orig-page-delimiter page-delimiter "" edt-direction-string nil edt-select-mode-text edt-reset force-mode-line-update t edt-orig-transient-mark-mode transient-mark-mode message "Original key bindings restored; EDT Emulation disabled"] 2 (#$ . 32026) nil]) #@38 Setup emulation of DEC's EDT editor. (defalias 'edt-default-emulation-setup #[(&optional user-setup) "ÀÁÂ!MˆÁà !Å\fÆÀ#ˆÇÈ!ˆÉ ˆÊË!ƒ!Ë ˆÌ Ξ„1ÐBÑž„>ÒBƒKÔÖ×KM‡ÖØKMˆØ ‡" [edt-default-ESC-prefix copy-keymap ESC-prefix current-global-map edt-default-global-map define-key "" define-prefix-command edt-default-gold-map edt-setup-default-bindings fboundp edt-setup-extra-default-bindings 0 edt-learn-macro-count edt-select-mode minor-mode-alist (edt-select-mode edt-select-mode) edt-direction-string (edt-direction-string edt-direction-string) user-setup t edt-user-map-configured edt-emulation-on edt-select-user-global-map edt-select-default-global-map] 4 (#$ . 32484)]) #@50 Setup user custom emulation of DEC's EDT editor. (defalias 'edt-user-emulation-setup #[nil "ÀÁ!ˆÂÃÄ!MˆÃ !ÇÈÂ#ˆÉÊ!ˆÊÃË!MˆÌ ˆÍ ‡" [edt-default-emulation-setup t edt-user-ESC-prefix copy-keymap edt-default-ESC-prefix edt-default-global-map edt-user-global-map define-key "" define-prefix-command edt-user-gold-map edt-default-gold-map edt-setup-user-bindings edt-select-user-global-map] 4 (#$ . 33178)]) #@44 Select default EDT emulation key bindings. (defalias 'edt-select-default-global-map #[nil "ÀÁ!ˆÂ !ˆ\f„ ÇÈ Ê ˆË\fÍ ˆÎÏ!‡" [transient-mark-mode 1 use-global-map edt-default-global-map edt-keep-current-page-delimiter page-delimiter edt-orig-page-delimiter "\f" t edt-default-map-active edt-advance edt-select-mode-string edt-select-mode-text edt-reset message "Default EDT keymap active"] 2 (#$ . 33590) nil]) #@48 Select user EDT emulation custom key bindings. (defalias 'edt-select-user-global-map #[nil "ƒ'ÁÂ!ˆÃ\f!ˆ „ÈÉ\nË ˆÌ Î ˆÏÐ!‡ÑÒ!‡" [edt-user-map-configured transient-mark-mode 1 use-global-map edt-user-global-map edt-keep-current-page-delimiter page-delimiter edt-orig-page-delimiter "\f" nil edt-default-map-active edt-advance edt-select-mode-string edt-select-mode-text edt-reset message "User EDT custom keymap active" error "User EDT custom keymap NOT configured!"] 2 (#$ . 34010) nil]) #@56 Toggle between default EDT keymap and user EDT keymap. (defalias 'edt-switch-global-maps #[nil "ƒÁ ‡Â ‡" [edt-default-map-active edt-select-user-global-map edt-select-default-global-map] 1 (#$ . 34515) nil]) #@60 Binds commands to a gold key sequence in the EDT Emulator. (defalias 'edt-bind-gold-key #[(key gold-binding &optional default) "ƒ\nÁ \f#‡ÁÅ \f#‡" [default define-key edt-default-gold-map key gold-binding edt-user-gold-map] 4 (#$ . 34732)]) #@65 Bind commands to a gold key sequence in the default EDT keymap. (defalias 'edt-bind-standard-key #[(key gold-binding &optional default) "ƒ\nÁ\n \f#‡Á \f#‡" [default define-key edt-default-global-map key gold-binding edt-user-global-map] 4 (#$ . 34981)]) #@42 Binds function keys in the EDT Emulator. (defalias 'edt-bind-function-key #[(function-key binding gold-binding &optional default) "ÀÁ‡" [edt-key-not-supported (byte-code "À \n\"A‰;ƒÄÅÆ\"ˆ ƒ;ƒ*È \n#ˆÈË \f#‚?È \n#ˆÈÎ \f#‚?ÏÐ \")‡" [assoc function-key *EDT-keys* key-vector throw edt-key-not-supported t default define-key edt-default-global-map binding edt-default-gold-map gold-binding edt-user-global-map edt-user-gold-map error "%s is not a legal function key name"] 5)] 2 (#$ . 35244)]) #@50 Assigns default EDT Emulation keyboard bindings. (defalias 'edt-setup-default-bindings #[nil "ÀÁÂÃÄ$ˆÀÅÆÇÄ$ˆÀÈÉÊÄ$ˆÀËÌÍÄ$ˆÀÎÏÐÄ$ˆÀÑÒÓÄ$ˆÀÔÕÖÄ$ˆÀ×ØÙÄ$ˆÀÚÛÜÄ$ˆÀÝÞßÄ$ˆÀàáâÄ$ˆÀãäåÄ$ˆÀæçèÄ$ˆÀéêëÄ$ˆÀìíîÄ$ˆÀïðñÄ$ˆÀòóôÄ$ˆÀõö÷Ä$ˆÀøùúÄ$ˆÀûüýÄ$ˆÀþÿ@Ä$ˆÀABCÄ$ˆÀDÉÊÄ$ˆÀEîFÄ$ˆÀGíHÄ$ˆÀIJFÄ$ˆÀKLFÄ$ˆÀMNFÄ$ˆÀOF‰Ä$ˆÀPQFÄ$ˆÀRSTÄ$ˆÀUVWÄ$ˆÀXYZÄ$ˆÀ[F‰Ä$ˆÀ\\]^Ä$ˆÀ_`FÄ$ˆÀaF‰Ä$ˆÀbÆFÄ$ˆÀcñFÄ$ˆÀdF‰Ä$ˆÀeF‰Ä$ˆÀfF‰Ä$ˆÀgF‰Ä$ˆhƒŽijFÄ#ˆikFÄ#ˆilFÄ#ˆimFÄ#ˆinFÄ#ˆio]Ä#ˆipqÄ#ˆir`Ä#ˆistÄ#ˆusvÄ#ˆiwxÄ#ˆiyzÄ#ˆi{FÄ#ˆi|FÄ#ˆi}FÄ#ˆi~Ä#ˆi€Ä#ˆi‚ƒÄ#ˆi„…Ä#ˆi†FÄ#ˆu‡ˆÄ#ˆuo‰Ä#ˆuŠ‰Ä#ˆu‹‰Ä#ˆuŒÄ#ˆuŽFÄ#ˆuFÄ#ˆu‘Ä#ˆu’‘Ä#ˆu“”Ä#ˆu•”Ä#ˆu–—Ä#ˆu˜—Ä#ˆu™šÄ#ˆu›šÄ#ˆuœÄ#ˆužÄ#ˆuŸ Ä#ˆu¡ Ä#ˆu¢ÆÄ#ˆu£ÆÄ#ˆu¤¥Ä#ˆu¦¥Ä#ˆu§FÄ#ˆu¨FÄ#ˆu©ªÄ#ˆu«ªÄ#ˆu¬­Ä#ˆu®­Ä#ˆu¯°Ä#ˆu±°Ä#ˆu²³Ä#ˆu´³Ä#ˆuµ¶Ä#ˆu·¶Ä#ˆu¸FÄ#ˆu¹FÄ#ˆuº»Ä#ˆu¼»Ä#ˆu½¾Ä#ˆu¿¾Ä#ˆuÀÁÄ#ˆuÂÁÄ#ˆuÃFÄ#ˆuÄFÄ#ˆuÅÆÄ#ˆuÇÆÄ#ˆuÈ Ä#ˆuÉ Ä#ˆuÊËÄ#ˆuÌËÄ#ˆuÍFÄ#ˆuÎFÄ#ˆuÏÐÄ#ˆuÑÐÄ#ˆuÒÓÄ#ˆuÔÓÄ#ˆuÕ^Ä#ˆuÖFÄ#ˆu×ØÄ#ˆuÙFÄ#ˆuÚFÄ#ˆuÛFÄ#ˆuÜFÄ#ˆuÝFÄ#ˆuÞFÄ#ˆußàÄ#ˆuáFÄ#ˆuâFÄ#ˆuãFÄ#ˆuäFÄ#ˆuåFÄ#ˆuæFÄ#ˆuçFÄ#ˆuèFÄ#ˆuéFÄ#ˆuêFÄ#ˆuëìÄ#ˆuíFÄ#ˆuîFÄ#ˆuïFÄ#ˆuðFÄ#ˆuñFÄ#ˆuòFÄ#ˆuóFÄ#ˆuôFÄ#ˆuõFÄ#ˆuöFÄ#ˆu÷FÄ#ˆuøFÄ#ˆuùFÄ#ˆuúFÄ#ˆuûüÄ#ˆuýFÄ#ˆuþFÄ#ˆuÿFÄ#ˆuFÄ#ˆuFÄ#ˆuÄ#ˆuFÄ#‡" [edt-bind-function-key "PF1" edt-default-gold-map edt-mark-section-wisely t "PF2" edt-electric-keypad-help describe-function "PF3" edt-find-next edt-find "PF4" edt-delete-line edt-undelete-line "UP" previous-line edt-window-top "DOWN" next-line edt-window-bottom "LEFT" backward-char edt-sentence-backward "RIGHT" forward-char edt-sentence-forward "KP0" edt-line open-line "KP1" edt-word edt-change-case "KP2" edt-end-of-line edt-delete-to-end-of-line "KP3" edt-character quoted-insert "KP4" edt-advance edt-bottom "KP5" edt-backup edt-top "KP6" edt-cut yank "KP7" edt-page execute-extended-command "KP8" edt-sect edt-fill-region "KP9" edt-append edt-replace "KP-" edt-delete-word edt-undelete-word "KP," edt-delete-character edt-undelete-character "KPP" edt-select edt-reset "KPE" other-window query-replace "FIND" "INSERT" edt-key-not-assigned "REMOVE" edt-copy "SELECT" edt-toggle-select "NEXT" edt-sect-forward "PREVIOUS" edt-sect-backward "F6" "F7" edt-copy-rectangle "F8" edt-cut-rectangle-overstrike-mode edt-paste-rectangle-overstrike-mode "F9" edt-cut-rectangle-insert-mode edt-paste-rectangle-insert-mode "F10" edt-cut-rectangle edt-paste-rectangle "F11" "F12" edt-beginning-of-line delete-other-windows "F13" edt-delete-to-beginning-of-word "F14" "HELP" "DO" "F17" "F18" "F19" "F20" edt-use-EDT-control-key-bindings edt-bind-standard-key "" "" "" "" "" "" " " edt-tab-insert "\n" " " edt-define-key edt-bind-gold-key edt-restore-key "\f" edt-form-feed-insert "" edt-set-screen-width-80 "" "" "" "" edt-display-the-time "" edt-delete-to-beginning-of-line "" redraw-display "" edt-set-screen-width-132 "" "" keyboard-quit help-for-help [f1] [help] "" split-window-vertically "a" "A" "b" buffer-menu "B" "c" compile "C" "d" delete-window "D" "e" edt-exit "E" "f" find-file "F" "g" find-file-other-window "G" "h" "H" "i" insert-file "I" "j" "J" "k" edt-toggle-capitalization-of-word "K" "l" edt-lowercase "L" "m" save-some-buffers "M" "n" next-error "N" "o" switch-to-buffer-other-window "O" "p" "P" "q" edt-quit "Q" "r" revert-buffer "R" "s" save-buffer "S" "t" "T" "u" edt-uppercase "U" "v" "V" "w" write-file "W" "x" "X" "y" edt-emulation-off "Y" "z" edt-switch-global-maps "Z" "1" "!" "2" edt-split-window "@" "3" "#" "4" "$" "5" "%" edt-goto-percentage "6" "^" "7" "&" "8" "*" "9" "(" "0" ")" " " undo "," "<" "." ">" "/" "?" "\\" "|" ";" ":" "'" "\"" "-" "_" "=" goto-line "+" "[" "{" "]" "}" "`" what-line "~"] 5 (#$ . 35757)]) #@3854 DEFAULT EDT Keypad Active F7: Copy Rectangle +----------+----------+----------+----------+ F8: Cut Rect Overstrike |Prev Line |Next Line |Bkwd Char |Frwd Char | G-F8: Paste Rect Overstrike | (UP) | (DOWN) | (LEFT) | (RIGHT) | F9: Cut Rect Insert |Window Top|Window Bot|Bkwd Sent |Frwd Sent | G-F9: Paste Rect Insert +----------+----------+----------+----------+ F10: Cut Rectangle G-F10: Paste Rectangle F11: ESC F12: Begining of Line +----------+----------+----------+----------+ G-F12: Delete Other Windows | GOLD | HELP | FNDNXT | DEL L | F13: Delete to Begin of Word | (PF1) | (PF2) | (PF3) | (PF4) | HELP: Keypad Help |Mark Wisel|Desc Funct| FIND | UND L | DO: Execute extended command +----------+----------+----------+----------+ | PAGE | SECT | APPEND | DEL W | C-g: Keyboard Quit | (7) | (8) | (9) | (-) | G-C-g: Keyboard Quit |Ex Ext Cmd|Fill Regio| REPLACE | UND W | C-h: Beginning of Line +----------+----------+----------+----------+ G-C-h: Emacs Help | ADVANCE | BACKUP | CUT | DEL C | C-i: Tab Insert | (4) | (5) | (6) | (,) | C-j: Delete to Begin of Word | BOTTOM | TOP | Yank | UND C | C-k: Define Key +----------+----------+----------+----------+ G-C-k: Restore Key | WORD | EOL | CHAR | Next | C-l: Form Feed Insert | (1) | (2) | (3) | Window | C-n: Set Screen Width 80 | CHNGCASE | DEL EOL |Quoted Ins| ! C-r: Isearch Backward +---------------------+----------+ (ENTER) | C-s: Isearch Forward | LINE | SELECT | ! C-t: Display the Time | (0) | (.) | Query | C-u: Delete to Begin of Line | Open Line | RESET | Replace | C-v: Redraw Display +---------------------+----------+----------+ C-w: Set Screen Width 132 C-z: Suspend Emacs +----------+----------+----------+ G-C-\: Split Window | FNDNXT | Yank | CUT | | (FIND) | (INSERT) | (REMOVE) | G-b: Buffer Menu | FIND | | COPY | G-c: Compile +----------+----------+----------+ G-d: Delete Window |SELECT/RES|SECT BACKW|SECT FORWA| G-e: Exit | (SELECT) |(PREVIOUS)| (NEXT) | G-f: Find File | | | | G-g: Find File Other Window +----------+----------+----------+ G-h: Keypad Help G-i: Insert File G-k: Toggle Capitalization Word G-l: Downcase Region G-m: Save Some Buffers G-n: Next Error G-o: Switch to Next Window G-q: Quit G-r: Revert File G-s: Save Buffer G-u: Upcase Region G-v: Find File Other Window G-w: Write file G-y: EDT Emulation OFF G-z: Switch to User EDT Key Bindings G-1: Delete Other Windows G-2: Split Window G-%: Go to Percentage G- : Undo (GOLD Spacebar) G-=: Go to Line G-`: What line (defalias 'edt-keypad-help #[nil "ÀÁ!‡" [describe-function edt-keypad-help] 2 (#$ . 40171) nil]) (defalias 'edt-electric-helpify #[(fun) "À‹…\fÃÄ Å#)‡" ["*Help*" name ((byte-code "ÀK !Å\f!\fƒÇ\f!„ÈÉŽÊËÌÍ!!\"ˆ\fƒ1Š\fqˆÏÐ!ˆ)ÀÑMˆÒ!ˆÂ !…ZÇ !!…Z\f?†Z\f !=?†ZÅ\f!?,‡" [print-help-return-message p get-buffer name b buffer-modified-p m get-buffer-window nil ((byte-code "À Mˆ\nƒÃ\n!ƒŠ\nqˆÄ !ˆ)À‡" [print-help-return-message p b buffer-name set-buffer-modified-p m] 2)) message "%s..." capitalize symbol-name fun set-buffer-modified-p t ignore call-interactively] 5)) with-electric-help delete-other-windows t] 4]) #@31 Display default EDT bindings. (defalias 'edt-electric-keypad-help #[nil "ÀÁ!‡" [edt-electric-helpify edt-keypad-help] 2 (#$ . 44665) nil]) #@35 Display user custom EDT bindings. (defalias 'edt-electric-user-keypad-help #[nil "ÀÁ!‡" [edt-electric-helpify edt-user-keypad-help] 2 (#$ . 44810) nil]) #@33 Set screen width to 80 columns. (defalias 'edt-set-screen-width-80 #[nil "ÀÁ!ƒ Á ˆÂÃ!ˆÄÅ!‡" [fboundp edt-set-term-width-80 set-screen-width 80 message "Screen width 80"] 2 (#$ . 44969) nil]) #@34 Set screen width to 132 columns. (defalias 'edt-set-screen-width-132 #[nil "ÀÁ!ƒ Á ˆÂÃ!ˆÄÅ!‡" [fboundp edt-set-term-width-132 set-screen-width 132 message "Screen width 132"] 2 (#$ . 45167) nil]) (provide (quote edt)) emacs-19.30/lisp/doctor.elc100666 74777 1 105207 5751546275 14143 0ustar esrdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:22:06 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/doctor.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/doctor.el' was compiled for Emacs 19")) (defalias 'doctor-cadr #[(x) "A@‡" [x] 1]) (defalias 'doctor-caddr #[(x) "AA@‡" [x] 1]) (defalias 'doctor-cddr #[(x) "AA‡" [x] 1]) (defalias '// #[(x) "‡" [x] 1]) #@29 quoted arg form of doctor-$ (defalias '$ '(macro . #[(what) "ÀÁ\nDD‡" [doctor-$ quote what] 3 (#$ . 648)])) #@55 Return the car of a list, rotating the list each time (defalias 'doctor-$ #[(what) "J‰@à A\nC\"\fLˆ\n+‡" [what vv first append ww] 4 (#$ . 762)]) (byte-code "ÀÁ!„ÂÁ B „Ä Å ÆÇ#ˆÅ ÈÉ#ˆÂ‡" [boundp doctor-mode-map nil current-load-list make-sparse-keymap define-key "\n" doctor-read-print " " doctor-ret-or-read] 4) #@219 Major mode for running the Doctor (Eliza) program. Like Text mode with Auto Fill mode except that RET when point is after a newline, or LFD at any time, reads the sentence before point, and prints the Doctor's answer. (defalias 'doctor-mode #[nil "À ˆÁ ˆÂ !ˆÄÆÈ ˆÉÊ!ˆËc‡" [text-mode make-doctor-variables use-local-map doctor-mode-map doctor-mode major-mode "Doctor" mode-name turn-on-auto-fill doctor-type (i am the psychotherapist \. ($ please) ($ describe) your ($ problems) \. each time you are finished talking\, type RET twice \.) "\n"] 2 (#$ . 1093) nil]) (defalias 'make-doctor-variables #[nil "ÀÁ!ˆÂÀÃ!ˆÄÅÆ\"ÀÇ!ˆÈÀÉ!ˆÈ ÀÊ!ˆÈ\nÀË!ˆÈ ÀÌ!ˆÍ\fÀÎ!ˆÏÀÐ!ˆÑÀÒ!ˆÓÀÔ!ˆÕÀÖ!ˆ×ÀØ!ˆÙÀÚ!ˆÛÀÜ!ˆÝÀÞ!ˆßÀà!ˆá Àâ!ˆã\"Àä!ˆå$Àæ!ˆç&Àè!ˆé(Àê!ˆë*Àì!ˆí,Àî!ˆï.Àð!ˆñ0Àò!ˆó2Àô!ˆõ4Àö!ˆ÷6Àø!ˆù8Àú!ˆû:Àü!ˆý<Àþ!ˆÿ>À@!ˆA@ÀB!ˆCBÀD!ˆEDÀF!ˆGFÀH!ˆIHÀJ!ˆKJÀL!ˆMLÀN!ˆONÀP!ˆQPÀR!ˆSRÀT!ˆUTÀV!ˆWVÀX!ˆYXÀZ!ˆ[ZÀ\\!ˆ]\\À^!ˆ_^À`!ˆa`Àb!ˆcbÀd!ˆedÀf!ˆgfÀh!ˆihÀj!ˆkjÀl!ˆmlÀn!ˆonÀp!ˆqpÀr!ˆsrÀt!ˆutÀv!ˆwvÀx!ˆyxÀz!ˆ{zÀ|!ˆ}|À~!ˆ~À€!ˆ€À‚!ˆƒ‚À„!ˆÈ„À…!ˆÈ…À†!ˆÈ†À‡!ˆÈ‡Àˆ!ˆÈˆÀ‰!ˆŠ‰À‹!ˆÈ‹ÀŒ!ˆÈŒÀ!ˆÈÀŽ!ˆÈŽÀ!ˆÀ‘!ˆÈ‘À’!ˆ“’À”!ˆÈ”À•!ˆÈ•À–!ˆÈ–À—!ˆÈ‰—‡" [make-local-variable monosyllables "\n Your attitude at the end of the session was wholly unacceptable.\n Please try to come back next time with a willingness to speak more\n freely. If you continue to refuse to talk openly, there is little\n I can do to help!\n" typos mapcar #[(x) "À @Âà !#ˆÀà !ÄÅ !#ˆ @‡" [put x doctor-correction doctor-cadr doctor-expansion doctor-caddr] 5] ((theyll they\'ll (they will)) (theyre they\'re (they are)) (hes he\'s (he is)) (he7s he\'s (he is)) (im i\'m (you are)) (i7m i\'m (you are)) (isa is\ a (is a)) (thier their (their)) (dont don\'t (do not)) (don7t don\'t (do not)) (you7re you\'re (i am)) (you7ve you\'ve (i have)) (you7ll you\'ll (i will))) found nil owner history *debug* inter ((well\,) (hmmm \.\.\.\ so\,) (so) (\.\.\.and) (then)) continue ((continue) (proceed) (go on) (keep going)) relation ((your relationship with) (something you remember about) (your feelings toward) (some experiences you have had with) (how you feel about)) fears ((($ whysay) you are ($ afraidof) (// feared) \?) (you seem terrified by (// feared) \.) (when did you first feel ($ afraidof) (// feared) \?)) sure ((sure) (positive) (certain) (absolutely sure)) afraidof ((afraid of) (frightened by) (scared of)) areyou ((are you) (have you been) (have you been)) isrelated ((has something to do with) (is related to) (could be the reason for) (is caused by) (is because of)) arerelated ((have something to do with) (are related to) (could have caused) (could be the reason for) (are caused by) (are because of)) moods ((($ areyou) (// found) often \?) (what causes you to be (// found) \?) (($ whysay) you are (// found) \?)) maybe ((maybe) (perhaps) (possibly)) whatwhen ((what happened when) (what would happen if)) hello ((how do you do \?) (hello \.) (howdy!) (hello \.) (hi \.) (hi there \.)) drnk ((do you drink a lot of (// found) \?) (do you get drunk often \?) (($ describe) your drinking habits \.)) drugs ((do you use (// found) often \?) (($ areyou) addicted to (// found) \?) (do you realize that drugs can be very harmful \?) (($ maybe) you should try to quit using (// found) \.)) whywant ((($ whysay) (// subj) might ($ want) (// obj) \?) (how does it feel to want \?) (why should (// subj) get (// obj) \?) (when did (// subj) first ($ want) (// obj) \?) (($ areyou) obsessed with (// obj) \?) (why should i give (// obj) to (// subj) \?) (have you ever gotten (// obj) \?)) canyou ((of course i can \.) (why should i \?) (what makes you think i would even want to \?) (i am the doctor\, i can do anything i damn please \.) (not really\, it\'s not up to me \.) (depends\, how important is it \?) (i could\, but i don\'t think it would be a wise thing to do \.) (can you \?) (maybe i can\, maybe i can\'t \.\.\.) (i don\'t think i should do that \.)) want ((want) (desire) (wish) (want) (hope)) shortlst ((can you elaborate on that \?) (($ please) continue \.) (go on\, don\'t be afraid \.) (i need a little more detail please \.) (you\'re being a bit brief\, ($ please) go into detail \.) (can you be more explicit \?) (and \?) (($ please) go into more detail \?) (you aren\'t being very talkative today!) (is that all there is to it \?) (why must you respond so briefly \?)) famlst ((tell me ($ something) about (// owner) family \.) (you seem to dwell on (// owner) family \.) (($ areyou) hung up on (// owner) family \?)) huhlst ((($ whysay) (// sent) \?) (is it because of ($ things) that you say (// sent) \?)) longhuhlst ((($ whysay) that \?) (i don\'t understand \.) (($ thlst)) (($ areyou) ($ afraidof) that \?)) feelings-about ((feelings about) (aprehensions toward) (thoughts on) (emotions toward)) random-adjective ((vivid) (emotionally stimulating) (exciting) (boring) (interesting) (recent) (random) (unusual) (shocking) (embarrassing)) whysay ((why do you say) (what makes you believe) (are you sure that) (do you really think) (what makes you think)) isee ((i see \.\.\.) (yes\,) (i understand \.) (oh \.)) please ((please\,) (i would appreciate it if you would) (perhaps you could) (please\,) (would you please) (why don\'t you) (could you)) bye ((my secretary will send you a bill \.) (bye bye \.) (see ya \.) (ok\, talk to you some other time \.) (talk to you later \.) (ok\, have fun \.) (ciao \.)) something ((something) (more) (how you feel)) things ((your plans) (your life) (the people you hang around with) (problems at school) (any hobbies you have) (your sex life) (hangups you have) (your inhibitions) (some problems in your childhood) (some problems at home)) describe ((describe) (tell me about) (talk about) (discuss) (tell me more about) (elaborate on)) ibelieve ((i believe) (i think) (i have a feeling) (it seems to me that) (it looks like)) problems ((problems) (inhibitions) (hangups) (difficulties) (anxieties) (frustrations)) bother ((does it bother you that) (are you annoyed that) (did you ever regret) (are you sorry) (are you satisfied with the fact that)) machlst ((you have your mind on (// found) \, it seems \.) (you think too much about (// found) \.) (you should try taking your mind off of (// found) \.) (are you a computer hacker \?)) qlist ((what do you think \?) (i\'ll ask the questions\, if you don\'t mind!) (i could ask the same thing myself \.) (($ please) allow me to do the questioning \.) (i have asked myself that question many times \.) (($ please) try to answer that question yourself \.)) elist ((($ please) try to calm yourself \.) (you seem very excited \. relax \. ($ please) ($ describe) ($ things) \.) (you\'re being very emotional \. calm down \.)) foullst ((($ please) watch your tongue!) (($ please) avoid such unwholesome thoughts \.) (($ please) get your mind out of the gutter \.) (such lewdness is not appreciated \.)) deathlst ((this is not a healthy way of thinking \.) (($ bother) you\, too\, may die someday \?) (i am worried by your obsession with this topic!) (did you watch a lot of crime and violence on television as a child \?)) sexlst ((($ areyou) ($ afraidof) sex \?) (($ describe) ($ something) about your sexual history \.) (($ please) ($ describe) your sex life \.\.\.) (($ describe) your ($ feelings-about) your sexual partner \.) (($ describe) your most ($ random-adjective) sexual experience \.) (($ areyou) satisfied with (// lover) \.\.\. \?)) neglst ((why not \?) (($ bother) i ask that \?) (why not \?) (why not \?) (how come \?) (($ bother) i ask that \?)) beclst ((is it because (// sent) that you came to me \?) (($ bother) (// sent) \?) (when did you first know that (// sent) \?) (is the fact that (// sent) the real reason \?) (does the fact that (// sent) explain anything else \?) (($ areyou) ($ sure) (// sent) \?)) shortbeclst ((($ bother) i ask you that \?) (that\'s not much of an answer!) (($ inter) why won\'t you talk about it \?) (speak up!) (($ areyou) ($ afraidof) talking about it \?) (don\'t be ($ afraidof) elaborating \.) (($ please) go into more detail \.)) thlst ((($ maybe) ($ things) ($ arerelated) this \.) (is it because of ($ things) that you are going through all this \?) (how do you reconcile ($ things) \?) (($ maybe) this ($ isrelated) ($ things) \?)) remlst ((earlier you said ($ history) \?) (you mentioned that ($ history) \?) (($ whysay) ($ history) \?)) toklst ((is this how you relax \?) (how long have you been smoking grass \?) (($ areyou) ($ afraidof) of being drawn to using harder stuff \?)) states ((do you get (// found) often \?) (do you enjoy being (// found) \?) (what makes you (// found) \?) (how often ($ areyou) (// found) \?) (when were you last (// found) \?)) replist ((i you) (my your) (me you) (you me) (your my) (mine yours) (yours mine) (our your) (ours yours) (we you) (dunno do not know) (no\,) (yes\,) (ya i) (aint am not) (wanna want to) (gimme give me) (gotta have to) (gonna going to) (never not ever) (doesn\'t does not) (don\'t do not) (aren\'t are not) (isn\'t is not) (won\'t will not) (can\'t cannot) (haven\'t have not) (i\'m you are) (ourselves yourselves) (myself yourself) (yourself myself) (you\'re i am) (you\'ve i have) (i\'ve you have) (i\'ll you will) (you\'ll i shall) (i\'d you would) (you\'d i would) (here there) (please) (eh\,) (eh) (oh\,) (oh) (shouldn\'t should not) (wouldn\'t would not) (won\'t will not) (hasn\'t has not)) stallmanlst ((($ describe) your ($ feelings-about) him \.) (($ areyou) a friend of Stallman \?) (($ bother) Stallman is ($ random-adjective) \?) (($ ibelieve) you are ($ afraidof) him \.)) schoollst ((($ describe) your (// found) \.) (($ bother) your grades could ($ improve) \?) (($ areyou) ($ afraidof) (// found) \?) (($ maybe) this ($ isrelated) to your attitude \.) (($ areyou) absent often \?) (($ maybe) you should study ($ something) \.)) improve ((improve) (be better) (be improved) (be higher)) elizalst ((($ areyou) ($ sure) \?) (($ ibelieve) you have ($ problems) with (// found) \.) (($ whysay) (// sent) \?)) sportslst ((tell me ($ something) about (// found) \.) (($ describe) ($ relation) (// found) \.) (do you find (// found) ($ random-adjective) \?)) mathlst ((($ describe) ($ something) about math \.) (($ maybe) your ($ problems) ($ arerelated) (// found) \.) (i do\'nt know much (// found) \, but ($ continue) anyway \.)) zippylst ((($ areyou) Zippy \?) (($ ibelieve) you have some serious ($ problems) \.) (($ bother) you are a pinhead \?)) chatlst ((($ maybe) we could chat \.) (($ please) ($ describe) ($ something) about chat mode \.) (($ bother) our discussion is so ($ random-adjective) \?)) abuselst ((($ please) try to be less abusive \.) (($ describe) why you call me (// found) \.) (i\'ve had enough of you!)) abusewords (boring bozo clown clumsy cretin dumb dummy fool foolish gnerd gnurd idiot jerk lose loser louse lousy luse luser moron nerd nurd oaf oafish reek stink stupid tool toolish twit) howareyoulst ((how are you) (hows it going) (hows it going eh) (how\'s it going) (how\'s it going eh) (how goes it) (whats up) (whats new) (what\'s up) (what\'s new) (howre you) (how\'re you) (how\'s everything) (how is everything) (how do you do) (how\'s it hanging) (que pasa) (how are you doing) (what do you say)) whereoutp (huh remem rthing) subj verb obj feared observation-list repetitive-shortness (0 . 0) **mad** rms-flag eliza-flag zippy-flag lover (your partner) bak lincount 0 *print-upcase* *print-space* howdyflag object] 3]) (defalias 'doctor-meaning #[(x) "ÁN‡" [x doctor-meaning] 2]) #@56 Store the base meaning of a word on the property list. (defalias 'doctor-put-meaning '(macro . #[(symb val) "ÀÁ\nDÃ\fF‡" [put quote symb (quote doctor-meaning) val] 4 (#$ . 12873)])) (byte-code "ÀÁÂÁ#ˆÀÃÂÁ#ˆÀÄÂÁ#ˆÀÅÂÁ#ˆÀÆÂÇ#ˆÀÈÂÇ#ˆÀÉÂÇ#ˆÀÊÂÇ#ˆÀËÂÇ#ˆÀÌÂÇ#ˆÀÍÂÇ#ˆÀÎÂÇ#ˆÀÏÂÇ#ˆÀÐÂÇ#ˆÀÑÂÇ#ˆÀÒÂÇ#ˆÀÓÂÇ#ˆÀÔÂÇ#ˆÀÕÂÇ#ˆÀÖÂÇ#ˆÀ×ÂÇ#ˆÀØÂÇ#ˆÀÙÂÇ#ˆÀÚÂÇ#ˆÀÛÂÇ#ˆÀÜÂÇ#ˆÀÝÂÇ#ˆÀÞÂÇ#ˆÀßÂÇ#ˆÀàÂÇ#ˆÀáÂÇ#ˆÀâÂÇ#ˆÀãÂÇ#ˆÀäÂÇ#ˆÀåÂÇ#ˆÀæÂÇ#ˆÀçÂÇ#ˆÀèÂé#ˆÀêÂé#ˆÀëÂé#ˆÀìÂé#ˆÀíÂé#ˆÀîÂé#ˆÀïÂé#ˆÀðÂé#ˆÀñÂé#ˆÀòÂé#ˆÀóÂé#ˆÀôÂé#ˆÀõÂé#ˆÀöÂé#ˆÀ÷Âø#ˆÀùÂø#ˆÀúÂø#ˆÀûÂø#ˆÀüÂø#ˆÀýÂø#ˆÀþÂø#ˆÀÿÂø#ˆÀøÂø#ˆÀ@Âø#ˆÀAÂø#ˆÀBÂø#ˆÀCÂø#ˆÀDÂE#ˆÀFÂE#ˆÀGÂE#ˆÀHÂE#ˆÀIÂE#ˆÀJÂE#ˆÀKÂE#ˆÀLÂE#ˆÀMÂE#ˆÀNÂE#ˆÀOÂO#ˆÀPÂP#ˆÀQÂP#ˆÀRÂR#ˆÀSÂR#ˆÀTÂT#ˆÀUÂT#ˆÀVÂT#ˆÀWÂX#ˆÀYÂX#ˆÀZÂX#ˆÀ[ÂX#ˆÀ\\ÂX#ˆÀ]ÂX#ˆÀ^ÂX#ˆÀ_ÂX#ˆÀ`Âa#ˆÀbÂa#ˆÀcÂa#ˆÀaÂa#ˆÀdÂa#ˆÀeÂa#ˆÀfÂa#ˆÀgÂa#ˆÀhÂa#ˆÀgÂa#ˆÀiÂa#ˆÀjÂa#ˆÀkÂa#ˆÀlÂm#ˆÀnÂm#ˆÀoÂm#ˆÀpÂm#ˆÀqÂm#ˆÀrÂm#ˆÀsÂm#ˆÀtÂm#ˆÀuÂm#ˆÀvÂm#ˆÀwÂm#ˆÀxÂm#ˆÀyÂz#ˆÀ{Âz#ˆÀzÂz#ˆÀ|Âz#ˆÀ}Âz#ˆÀ~Â#ˆÀ€Â#ˆÀÂ#ˆÀ‚Â#ˆÀƒÂ#ˆÀ„Â#ˆÀ…Â#ˆÀ†Â#ˆÀ‡Â#ˆÀˆÂ#ˆÀ‰Â#ˆÀŠÂ#ˆÀ‹Â#ˆÀŒÂ#ˆÀÂ#ˆÀŽÂ#ˆÀÂ#ˆÀÂ#ˆÀ‘Â#ˆÀ’Â#ˆÀ“Â#ˆÀ”Â#ˆÀ•Â#ˆÀ–Â#ˆÀ—Â#ˆÀ˜Â#ˆÀ™Â#ˆÀšÂ#ˆÀ›Â#ˆÀœÂ#ˆÀžÂ#ˆÀŸÂ#ˆÀ Â#ˆÀ¡Â#ˆÀ¢Â#ˆÀ£Â#ˆÀ¤Â#ˆÀ¥Â#ˆÀ¦Â#ˆÀ§Â#ˆÀÂ#ˆÀ¨Â#ˆÀ©Âª#ˆÀ«Âª#ˆÀ¬Âª#ˆÀ­Âª#ˆÀ®Âª#ˆÀ¯Âª#ˆÀ°Âª#ˆÀ±Âª#ˆÀ²Âª#ˆÀ³Âª#ˆÀ´Âª#ˆÀµÂª#ˆÀ¶Âª#ˆÀ·Âª#ˆÀ¸Âª#ˆÀ¹Âº#ˆÀ»Âº#ˆÀ¼Âº#ˆÀºÂº#ˆÀ½Âº#ˆÀ¾Âº#ˆÀ¿Âº#ˆÀÀº#ˆÀÁº#ˆÀÂÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#ˆÀÉÂÃ#ˆÀÊÂÃ#ˆÀËÂÃ#ˆÀÌÂÃ#ˆÀÍÂÃ#ˆÀÎÂÃ#ˆÀÏÂÐ#ˆÀÑÂÐ#ˆÀÒÂÐ#ˆÀÓÂÐ#ˆÀÔÂÐ#ˆÀÕÂÐ#ˆÀÖÂÐ#ˆÀ×ÂÐ#ˆÀØÂÐ#ˆÀÙÂÚ#ˆÀÚÂÚ#ˆÀÛÂÚ#ˆÀÜÂÚ#ˆÀÝÂÚ#ˆÀÞÂÞ#ˆÀßÂÞ#ˆÀàÂà#ˆÀáÂà#ˆÀâÂà#ˆÀãÂà#ˆÀäÂà#ˆÀåÂà#ˆÀæÂà#ˆÀçÂà#ˆÀèÂà#ˆÀéÂà#ˆÀêÂà#ˆÀëÂà#ˆÀìÂà#ˆÀíÂî#ˆÀîÂî#ˆÀïÂî#ˆÀðÂî#ˆÀñÂî#ˆÀòÂî#ˆÀóÂô#ˆÀõÂô#ˆÀöÂô#ˆÀ÷Âô#ˆÀøÂô#ˆÀùÂô#ˆÀúÂô#ˆÀûÂô#ˆÀüÂô#ˆÀýÂô#ˆÀþÂô#ˆÀôÂô#ˆÀÿÂô#ˆÀÂô#ˆÀÂô#ˆÀÂô#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀ Â#ˆÀ\nÂ#ˆÀ Â#ˆÀ\fÂ#ˆÀ Â#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀÂ#‡" [put howdy doctor-meaning hi greetings hello tops20 mach tops-20 tops pdp11 computer unix machine computers machines pdp11s foo foobar multics macsyma teletype la36 vt52 zork trek startrek advent pdp dec commodore vic bbs modem baud macintosh vax vms ibm pc bitching foul shit bastard damn damned hell suck sucking sux ass whore bitch asshole shrink pot toke grass weed marijuana acapulco columbian tokin joint toking tokin\' toked roach pills drug dope acid lsd speed heroin hash cocaine uppers downers loves love loved hates dislikes hate hated dislike stoned state drunk drunken high horny blasted happy paranoid wish desire wishes want like hope hopes desires wants likes needs need frustrated mood depressed annoyed upset unhappy excited worried lonely angry mad pissed jealous afraid fear terrified scared frightened virginity sexnoun virgins virgin cock cocks dick dicks cunt cunts prostitute condom sex rapes wife family brothers sisters parent parents brother sister father mother husband siblings grandmother grandfather maternal paternal stab death murder murders suicide suicides kill kills die dies died dead deaths pain symptoms ache fever sore aching stomachache headache hurts disease virus vomit vomiting barf toothache hurt rum alcohol gin vodka bourbon beer wine whiskey scotch fuck sexverb fucked screw screwing fucking rape raped kiss kissing kisses screws fucks because conj but however besides anyway that except why how until when whenever while since rms stallman school schools skool grade grades teacher teachers classes professor prof profs professors mit emacs eliza liza elisa weizenbaum doktor athletics sports baseball basketball football frisbee gym gymnastics hockey lacrosse soccer softball swimming swim tennis volleyball math mathematics mathematical theorem axiom lemma algebra algebraic trig trigonometry trigonometric geometry geometric calculus arithmetic zippy pinhead chat] 4) #@59 Switch to *doctor* buffer and start giving psychotherapy. (defalias 'doctor #[nil "ÀÁ!ˆÂ ‡" [switch-to-buffer "*doctor*" doctor-mode] 2 (#$ . 17431) nil]) #@114 Insert a newline if preceding character is not a newline. Otherwise call the Doctor to parse preceding sentence. (defalias 'doctor-ret-or-read #[(arg) "hÀUƒ Á ‡Â !‡" [10 doctor-read-print newline arg] 2 (#$ . 17593) "*p"]) #@16 top level loop (defalias 'doctor-read-print #[nil "À Âcˆ TÄ !ˆÂcˆ ‰)‡" [doctor-readin sent "\n" lincount doctor-doc bak] 2 (#$ . 17823) nil]) #@49 Read a sentence. Return it as a list of words. (defalias 'doctor-readin #[nil "ÀÂÃ!ˆm„Ä Å C\"‚ )‡" [nil sentence backward-sentence 1 append doctor-read-token] 3 (#$ . 17974)]) #@27 read one word from buffer (defalias 'doctor-read-token #[nil "À`Ávˆ`{—!ÂÃ!ˆ‡" [intern 1 re-search-forward "\\Sw*"] 3 (#$ . 18163)]) (defalias 'doctor-doc #[(sent) "Ášƒ\nÂÃ!‡\fƒÂÅ!‡Æ„!@Ç>ƒ'ÂÈÉ!!‡@Ê=ƒBË!\f>ƒBË! ÂÈÎ!!‡@Ï=ƒOÐË!!‡Ñšƒ‚ÂÒÓÔÕÓÖ×ØÓÚÛÜÓÖÝÞß àáâãß$Öåæçèé¯\"!‡ê!ƒŽë \"ˆGìVƒ™í!ˆîï0\"!ñ>„¸ò>„¸ó>ƒ¸ïô\"@õšƒÂö ‡G÷WƒØø@!ù=ƒÕú ‡û ‡ó>ƒãïü\"ý!‰@þ=ƒ'Ë!ÿ=ƒ'@A!BUƒ\nÂC!‡@÷!BUƒ!ÂD!ˆE ‡ÂF!‡GH!!‡" [sent (foo) doctor-type (bar! ($ please) ($ continue)) howareyoulst (i\'m ok \. ($ describe) yourself \.) ((good bye) (see you later) (i quit) (so long) (go away) (get lost)) (bye halt break quit done exit goodbye bye\, stop pause goodbye\, stop pause) doctor-$ bye you doctor-cadr abusewords found abuselst whatmeans doctor-def (parse) subj = ", " verb "\n" object phrase obj "," noun form current keyword is ", " most recent possessive owner sentence used was "..." (// bak) doctor-defq doctor-define 12 doctor-shorten doctor-correct-spelling doctor-replace replist me i am ((am are)) yow doctor-zippy 2 doctor-meaning howdy doctor-howdy doctor-short ((me i)) doctor-fixup do not random 3 0 (are you ($ afraidof) that \?) (don\'t tell me what to do \. i am the psychiatrist here!) doctor-rthing (($ whysay) that i shouldn\'t (doctor-cddr sent) \?) doctor-go doctor-wherego] 36]) #@56 Correct the spelling and expand each word in sentence. (defalias 'doctor-correct-spelling #[(sent) "… ÁÂÃÄ\"\"‡" [sent apply append mapcar #[(word) " >ƒ\fÂNÃN‡C‡" [word typos doctor-correction doctor-expansion] 2]] 5 (#$ . 19531)]) #@53 Make a sentence manageably short using a few hacks. (defalias 'doctor-shorten #[(sent) "À‰Á\nƒ.\n@ >‰ƒ'\fGÆVƒ'\fÇ !ÀÈ‚\nA‰„\n +‡" [nil (because but however besides anyway until while that except why how) temp retval foo sent 3 doctor-fixup t] 4 (#$ . 19776)]) (defalias 'doctor-define #[(sent found) "À \nÃÄ$ˆÅ!…/Ç!?…/…/È !…/Êȉ !#…/ˇ" [doctor-svo sent found 1 nil doctor-nounp subj doctor-pronounp doctor-meaning object put t] 5]) #@63 Set global var FOUND to first keyword found in sentence SENT. (defalias 'doctor-defq #[(sent) "Àƒ @\f>ƒ @À‰‚ A‰„) ‡" [nil found (means applies mean refers refer related similar defined associated linked like same) temp sent] 3 (#$ . 20245)]) (defalias 'doctor-def #[(x) "ÀÁ ÄÅ !Æǯ!ˆÈ‡" [doctor-type the word x means doctor-meaning to me nil] 8]) #@46 Delete the last element of the history list. (defalias 'doctor-forget #[nil "À‰ !A!‰‡" [reverse history] 3 (#$ . 20615)]) #@102 Prompt for a line of input from the minibuffer until a noun or verb is seen. Put dialogue in buffer. (defalias 'doctor-query #[(x) "ÀÁ\n!ÃPÀ\f„[„%Ç È !DZˆÉ ‰ƒƒ \f„ Ê@!ƒ=@‚%Ë@!ƒR̉\nÍ\"@\"‚%A‰‚'\f+‡" [nil doctor-make-string x " what ? " retval prompt a 10 read-string doctor-readin doctor-nounp doctor-verbp doctor-build " "] 5 (#$ . 20745)]) #@218 Search for the subject of a sentence SENT, looking for the noun closest to and preceding KEY by at least TYPE words. Set global variable subj to the subject noun, and return the portion of the sentence following it. (defalias 'doctor-subjsearch #[(sent key type) "G >GZ\nZ‰ÄVƒÅ 8!„ S‰‚ ÄVƒ1 8 T›‚5ÇÈ)‡" [sent key type i -1 doctor-nounp subj you nil] 4 (#$ . 21131)]) #@45 Returns t if the symbol argument is a noun. (defalias 'doctor-nounp #[(x) "À !† !† Ú†Ä !†Å !?‡" [doctor-pronounp x doctor-verbp not doctor-prepp doctor-modifierp] 2 (#$ . 21524)]) #@48 Returns t if the symbol argument is a pronoun. (defalias 'doctor-pronounp #[(x) "Á>‡" [x (i me mine myself we us ours ourselves ourself you yours yourself yourselves he him himself she hers herself it that those this these things thing they them themselves theirs anybody everybody somebody anyone everyone someone anything something everything)] 2 (#$ . 21720)]) (mapcar #[(x) "À ÂÃ#‡" [put x doctor-sentence-type verb] 4] (quote (abort aborted aborts ask asked asks am applied applies apply are associate associated ate be became become becomes becoming been being believe believed believes bit bite bites bore bored bores boring bought buy buys buying call called calling calls came can caught catch come contract contracted contracts control controlled controls could croak croaks croaked cut cuts dare dared define defines dial dialed dials did die died dies dislike disliked dislikes do does drank drink drinks drinking drive drives driving drove dying eat eating eats expand expanded expands expect expected expects expel expels expelled explain explained explains fart farts feel feels felt fight fights find finds finding forget forgets forgot fought found fuck fucked fucking fucks gave get gets getting give gives go goes going gone got gotten had harm harms has hate hated hates have having hear heard hears hearing help helped helping helps hit hits hope hoped hopes hurt hurts implies imply is join joined joins jump jumped jumps keep keeping keeps kept kill killed killing kills kiss kissed kisses kissing knew know knows laid lay lays let lets lie lied lies like liked likes liking listen listens login look looked looking looks lose losing lost love loved loves loving luse lusing lust lusts made make makes making may mean means meant might move moved moves moving must need needed needs order ordered orders ought paid pay pays pick picked picking picks placed placing prefer prefers put puts ran rape raped rapes read reading reads recall receive received receives refer refered referred refers relate related relates remember remembered remembers romp romped romps run running runs said sang sat saw say says screw screwed screwing screws scrod see sees seem seemed seems seen sell selling sells send sendind sends sent shall shoot shot should sing sings sit sits sitting sold studied study take takes taking talk talked talking talks tell tells telling think thinks thought told took tooled touch touched touches touching transfer transferred transfers transmit transmits transmitted type types types typing walk walked walking walks want wanted wants was watch watched watching went were will wish would work worked works write writes writing wrote use used uses using))) (defalias 'doctor-verbp #[(x) "9…\nÁNÂ=‡" [x doctor-sentence-type verb] 2]) #@39 Form the plural of the word argument. (defalias 'doctor-plural #[(x) "À !‰ÃÄOŘƒ\"\nÆÃOŘƒÇ\nÈP!‚; ‚;\nÃÄOɘƒ6Ç\nÊÃOËP!‚;Ç\nÅP!)‡" [doctor-make-string x foo -1 nil "s" -2 intern "es" "y" 0 "ies"] 5 (#$ . 24501)]) (defalias 'doctor-setprep #[(sent key) "À \n>ÅÆ !!ƒ ÇÈ !!‰ƒ\f‚CÉ‚CÊÆ !!ƒBÇÈ !!‰ƒ>Ë‰Æ !Ì\"\f\"‚CÉ‚CÉ*‡" [nil key sent foo val doctor-prepp doctor-cadr doctor-getnoun doctor-cddr something doctor-articlep doctor-build " "] 5]) (defalias 'doctor-getnoun #[(x) "„Á‰‡:„‰‡GÃ=ƒ+Ä@‰!ƒ%\n‚(Å\n!‰‡@Æ=ƒ:ÇÈÉA!\"‡Ê@!ƒFÉA!‡Ä@!„dlj@ËÌ@@BC\"žAÍ\"ÉA!\"‡@‰‡" [x something object 1 doctor-nounp doctor-query to doctor-build to\ doctor-getnoun doctor-prepp append ((a . this) (some . this) (one . that)) " "] 7]) (defalias 'doctor-modifierp #[(x) "À !† !†à !‡" [doctor-adjectivep x doctor-adverbp doctor-othermodifierp] 2]) (defalias 'doctor-adjectivep #[(x) "§† Á!† Â!† Ã!† Ä!† Å!‡" [x doctor-nmbrp doctor-articlep doctor-colorp doctor-sizep doctor-possessivepronounp] 2]) (defalias 'doctor-adverbp #[(xx) "À !‰GÃY…À !ÄÅOƘ)‡" [doctor-make-string xx xxstr 2 -2 nil "ly"] 4]) (defalias 'doctor-articlep #[(x) "Á>‡" [x (the a an)] 2]) (defalias 'doctor-nmbrp #[(x) "Á>‡" [x (one two three four five six seven eight nine ten eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen twenty thirty forty fifty sixty seventy eighty ninety hundred thousand million billion half quarter first second third fourth fifth sixth seventh eighth ninth tenth)] 2]) (defalias 'doctor-colorp #[(x) "Á>‡" [x (beige black blue brown crimson gray grey green orange pink purple red tan tawny violet white yellow)] 2]) (defalias 'doctor-sizep #[(x) "Á>‡" [x (big large tall fat wide thick small petite short thin skinny)] 2]) (defalias 'doctor-possessivepronounp #[(x) "Á>‡" [x (my your his her our their)] 2]) (defalias 'doctor-othermodifierp #[(x) "Á>‡" [x (all also always amusing any anyway associated awesome bad beautiful best better but certain clear ever every fantastic fun funny good great gross growdy however if ignorant less linked losing lusing many more much never nice obnoxious often poor pretty real related rich similar some stupid super superb terrible terrific too total tubular ugly very)] 2]) (defalias 'doctor-prepp #[(x) "Á>‡" [x (about above after around as at before beneath behind beside between by for from in inside into like near next of on onto over same through thru to toward towards under underneath with without)] 2]) (defalias 'doctor-remember #[(thing) "„ C‰‡Â C\"‰‡" [history thing append] 3]) (defalias 'doctor-type #[(x) "À !Âà !!‡" [doctor-fix-2 x doctor-txtype doctor-assm] 3]) (defalias 'doctor-fixup #[(sent) "À @À @ @DC\"žA A\"à !‡" [append sent ((me i) (him he) (her she) (them they) (okay) (well) (sigh) (hmm) (hmmm) (hmmmm) (hmmmmm) (gee) (sure) (great) (oh) (fine) (ok) (no)) doctor-fix-2] 6]) (defalias 'doctor-fix-2 #[(sent) " ƒâ @Â=ƒÃÄ !!ƒ Å ˆ‚ @Æ=ƒSÄ !Ç>ƒ3 AÈ ˆ‚ÛÄ !É>ƒC AÊ ˆ‚ÛÄ !Ë>ƒÛ AÌ ˆ‚Û @ÅšƒŠÄ !Í>ƒj AΠˆ‚ÛÄ !Ï>ƒz AРˆ‚ÛÄ !Ñ>ƒÛ AÊ ˆ‚Ûà @!ƒªÄ !Å=ƒªÃÒ !@!„ª A ˆ‚Û @Ó=ƒÄÔÕÖÄ !!!!ƒÄ × ˆ‚Û @×=ƒÛÔÕÖÄ !!!!„Û Ó ˆ A‰„)‡" [sent foo me doctor-verbp doctor-cadr i you (am be been is) are (has) have (was) were (are is be been) am (were) was (has) doctor-cddr a doctor-vowelp string-to-char doctor-make-string an] 6]) (defalias 'doctor-vowelp #[(x) "Á>‡" [x (97 101 105 111 117)] 2]) #@85 Replace any element of SENT that is the car of a replacement element pair in RLIST. (defalias 'doctor-replace #[(sent rlist) "ÀÁÂÃ\f\"\"‡" [apply append mapcar #[(x) " ž† ‰DA‡" [x rlist] 2] sent] 5 (#$ . 27954)]) (defalias 'doctor-wherego #[(sent) "„ÁÂ!‡Ã@!„#ÄÅÆ!ÇUƒÈA!‚!A!‡@ Ã@!‡" [sent doctor-$ whereoutp doctor-meaning doctor-wherego random 2 0 reverse found] 3]) #@254 Find subject, verb and object in sentence SENT with focus on word KEY. TYPE is number of words preceding KEY to start looking for subject. MEM is t if results are to be put on Doctor's memory stack. Return in the global variables SUBJ, VERB and OBJECT. (defalias 'doctor-svo #[(sent key type mem) "À \n #‰„ ÅÇ\f@!„!\fAƒ!\fA‚\f@É\fA!\n Ì=ƒ8Í ‚BÍ=ƒBÌ…PÏ\nE!)‡" [doctor-subjsearch sent key type foo nil mem doctor-verbp verb doctor-getnoun obj object i me subj doctor-remember] 5 (#$ . 28344)]) #@113 Set possessive in SENT for keyword KEY. Hack on previous word, setting global variable OWNER to correct result. (defalias 'doctor-possess #[(sent key) "G >GZÂZ‰ÄWƒÅ‚ 8Ç!„,È!ÉÊO˘ƒ1‚2ʼn\f*‡" [sent key 1 i 0 your prev doctor-possessivepronounp doctor-make-string -1 nil "s" owner] 4 (#$ . 28874)]) #@62 Output to buffer a list of symbols or strings as a sentence. (defalias 'doctor-txtype #[(ans) "ÀÂÄÅ\"ˆÇc‡" [t *print-upcase* nil *print-space* mapcar doctor-type-symbol ans "\n"] 3 (#$ . 29196)]) #@71 Output a symbol to the buffer with some fancy case and spacing hacks. (defalias 'doctor-type-symbol #[(word) "À !‰˜ƒ\fÃ\fƒÅ !ƒÇcˆÈÉ \"„(„. cˆ‚3Ê ±ˆ ƒCi\fVƒC ˆÈÍ \"Ή‡" [doctor-make-string word "i" "I" *print-upcase* capitalize *print-space* " " string-match "^[.,;:?! ]" 32 auto-fill-function fill-column "[.?!]$" t] 4 (#$ . 29402)]) #@71 Make a symbol out of the concatenation of the two non-list arguments. (defalias 'doctor-build #[(str1 str2) "„ ‡ „\f‡:„ :„ ÂÃ!à !P!‡Ä‡" [str1 str2 intern doctor-make-string nil] 4 (#$ . 29768)]) (defalias 'doctor-make-string #[(obj) ";ƒ‡9ƒÁ!‡§ƒÂ!‡Ã‡" [obj symbol-name int-to-string ""] 2]) #@54 Like append, but force atomic arguments to be lists. (defalias 'doctor-concat #[(x y) "À ƒ :„ C‚ \nƒ\n:„\nC‚\n\"‡" [append x y] 3 (#$ . 30086)]) (defalias 'doctor-assm #[(proto) "„Á‡:„C‡@:„@ÂA!B‡ÃÂÄ@!!ÂA!\"‡" [proto nil doctor-assm doctor-concat eval] 4]) #@29 Call a `doctor-*' function. (defalias 'doctor-go #[(destination) "ÀÁ !P! ‡" [intern "doctor-" doctor-make-string destination] 4 (#$ . 30374)]) (defalias 'doctor-desire1 #[nil "ÀÁÂ!!‡" [doctor-go doctor-$ whereoutp] 3]) (defalias 'doctor-huh #[nil "GÁWƒ ÂÃÄ!!‡ÂÃÅ!!‡" [sent 9 doctor-type doctor-$ huhlst longhuhlst] 3]) (defalias 'doctor-rthing #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ thlst] 3]) (defalias 'doctor-remem #[nil "„Á ‡ÂÃÄ!!‡" [history doctor-huh doctor-type doctor-$ remlst] 3]) (defalias 'doctor-howdy #[nil "„\fÁÂ!ˆÃ‰‡ÁÄ!ˆÁÅ!‡" [howdyflag doctor-type (($ hello) what brings you to see me \?) t (($ ibelieve) we\'ve introduced ourselves already \.) (($ please) ($ describe) ($ things) \.)] 2]) (defalias 'doctor-when #[nil " >GÂWƒ\fà ‡ >AÄ !ÅÆ!‡" [found sent 3 doctor-short doctor-fixup doctor-type (($ whatwhen) (// sent) \?)] 2]) (defalias 'doctor-conj #[nil " >GÂWƒ\fà ‡ >AÄ !‰@Å=ƒ)ÆÇ!ˆ AB‰‡É !ˆÆÊË!!‡" [found sent 4 doctor-short doctor-fixup of doctor-type (are you ($ sure) that is the real reason \?) things doctor-remember doctor-$ beclst] 4]) (defalias 'doctor-short #[nil "@ SUƒ‰AT¡ˆ‚¡ˆ  ˆAÃVƒ0\f„,ÅÆ!ˆÇ‰‡ÅÈ!‡ ÊË!šƒ=ÅÌ!‡ ÊÍ!šƒLÅÎÏ!!‡ ÊÐ!šƒ[ÅÎÑ!!‡ÅÎÒ!!‡" [repetitive-shortness lincount 1 6 **mad** doctor-type (($ areyou) just trying to see what kind of things i have in my vocabulary \? please try to carry on a reasonable conversation!) t (i give up \. you need a lesson in creative writing \.\.\.) sent doctor-assm (yes) (($ isee) ($ inter) ($ whysay) this is so \?) (because) doctor-$ shortbeclst (no) neglst shortlst] 3]) (defalias 'doctor-alcohol #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ drnk] 3]) (defalias 'doctor-desire #[nil " >‰GÃWƒÄÅÆ!Ç\"!‚hÈ\n!É>ƒ?\nÊË\nA\"¡ˆÌ ÇÍ$ˆÎÐÑF!ˆÓÔÕ!!‚hÈ\n!Ö=„RÄÅÆ!Ç\"!‚hÌ ÇÍ$ˆÎÐÑF!ˆÓÔÕ!!)‡" [found sent foo 2 doctor-go doctor-build doctor-meaning 1 doctor-cadr (a an) append (to have) doctor-svo nil doctor-remember subj would like obj doctor-type doctor-$ whywant to] 6]) (defalias 'doctor-drug #[nil "ÀÁÂ!!ˆÃÄÅE!‡" [doctor-type doctor-$ drugs doctor-remember you used found] 4]) (defalias 'doctor-toke #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ toklst] 3]) (defalias 'doctor-state #[nil "ÀÁÂ!!ˆÃÄÅE!‡" [doctor-type doctor-$ states doctor-remember you were found] 4]) (defalias 'doctor-mood #[nil "ÀÁÂ!!ˆÃÄÅE!‡" [doctor-type doctor-$ moods doctor-remember you felt found] 4]) (defalias 'doctor-fear #[nil "À \n\"ÄÅÆ!!ˆÇÈÉÊË ¯!‡" [doctor-setprep sent found feared doctor-type doctor-$ fears doctor-remember you were afraid of] 6]) (defalias 'doctor-hate #[nil "À \nÃÄ$ˆÅ >ƒÆ ˆÇ ‡ÉšƒÊË!‡ÊÌ!‡" [doctor-svo sent found 1 t not doctor-forget doctor-huh subj you doctor-type (why do you (// verb) (// obj) \?) (($ whysay) (list subj verb obj))] 5]) (defalias 'doctor-symptoms #[nil "ÀÁ!‡" [doctor-type (($ maybe) you should consult a doctor of medicine\, i am a psychiatrist \.)] 2]) (defalias 'doctor-hates #[nil "À \nÃÄ$ˆÅ ‡" [doctor-svo sent found 1 t doctor-hates1] 5]) (defalias 'doctor-hates1 #[nil "ÀÁ!‡" [doctor-type (($ whysay) (list subj verb obj))] 2]) (defalias 'doctor-loves #[nil "À \nÃÄ$ˆÅ ‡" [doctor-svo sent found 1 t doctor-qloves] 5]) (defalias 'doctor-qloves #[nil "ÀÁ!‡" [doctor-type (($ bother) (list subj verb obj) \?)] 2]) (defalias 'doctor-love #[nil "À \nÃÄ$ˆÅ >ƒÆ ˆÇ ‡È >ƒÉ ‡\nËšƒ&Ì\n ΚƒE‰ÑšƒAÒÆ ˆÓÔ!‡ÓÕ!‡ ÖšƒP×Ø!‡Æ ˆÙÚÜ\"Ý ‡" [doctor-svo sent found 1 t not doctor-forget doctor-huh to doctor-hates1 object something (this person you love) subj you obj lover (this person you love) (your partner) doctor-type (with whom are you in love \?) (($ please) ($ describe) ($ relation) (// lover) \.) i doctor-txtype (we were discussing you!) someone doctor-build verb s doctor-qloves] 6]) (defalias 'doctor-mach #[nil "À !ÂÃÄ!!‡" [doctor-plural found doctor-type doctor-$ machlst] 3]) (defalias 'doctor-sexnoun #[nil "À ‡" [doctor-sexverb] 1]) (defalias 'doctor-sexverb #[nil "À >„ >„à >ƒÄ ‡ÅÆÇ!!‡" [me sent myself i doctor-foul doctor-type doctor-$ sexlst] 3]) (defalias 'doctor-death #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ deathlst] 3]) (defalias 'doctor-foul #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ foullst] 3]) (defalias 'doctor-family #[nil "À \n\"ˆÃÄÅ!!‡" [doctor-possess sent found doctor-type doctor-$ famlst] 3]) (defalias 'doctor-rms #[nil "ƒ\nÁÂÃ!!‡ÄÁÅ!‡" [rms-flag doctor-type doctor-$ stallmanlst t (do you know Stallman \?)] 3]) (defalias 'doctor-school #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ schoollst] 3]) (defalias 'doctor-eliza #[nil "ƒ\nÁÂÃ!!‡ÄÁÅ!‡" [eliza-flag doctor-type doctor-$ elizalst t ((// found) \? hah ! ($ please) ($ continue) \.)] 3]) (defalias 'doctor-sports #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ sportslst] 3]) (defalias 'doctor-math #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ mathlst] 3]) (defalias 'doctor-zippy #[nil "ƒ\nÁÂÃ!!‡ÄÁÅ!‡" [zippy-flag doctor-type doctor-$ zippylst t (yow! are we interactive yet \?)] 3]) (defalias 'doctor-chat #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ chatlst] 3]) (defalias 'doctor-strangelove #[nil "ÀcˆÁ ‡" ["Mein fuhrer!!\n" doctor-read-print] 1 nil nil]) emacs-19.30/lisp/dos-fns.elc100666 12120 1 6644 6051026656 14133 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 10 23:59:23 1995 ;;; from file /home/fsf/rms/e19/lisp/dos-fns.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`dos-fns.el' was compiled for Emacs 19.29 or later")) (byte-code "À ‰ÃÄ!\nAB¡ˆ)ÅÇÉ\nÇ" [" %[(" mode-line-format tail purecopy "%t:" ";" path-separator "NUL" grep-null-device (("^\\(\\([a-zA-Z]:\\)?[^:( \n]+\\)[:( ]+\\([0-9]+\\)[:) ]" 1 3)) grep-regexp-alist] 4) #@187 *Alist for distinguishing text files from binary files. Each element has the form (REGEXP . TYPE), where REGEXP is matched against the file name, and TYPE is nil for text, t for binary. (defvar file-name-buffer-file-type-alist (quote (("[:/].*config.sys$") ("\\.elc$" . t) ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t) ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t) ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t) ("\\.tp[ulpw]$" . t) ("[:/]tags$" . t))) (#$ . -696)) (defalias 'find-buffer-file-type #[(filename) "Á‰ÅÇ! „-\fƒ-É\f@@\"ƒ'\f@AÅ\fA‚) ƒN\nÊ>ƒ<\n‚P\n9…PË\n!…P\n!‚P\f+‡" [file-name-buffer-file-type-alist nil code found alist t case-fold-search file-name-sans-versions filename string-match (nil t) fboundp default-buffer-file-type] 3]) #@45 Visit file FILENAME and treat it as binary. (defalias 'find-file-binary #[(filename) "À !)‡" [(("" . t)) file-name-buffer-file-type-alist find-file filename] 2 (#$ . 1504) "FFind file binary: "]) #@50 Visit file FILENAME and treat it as a text file. (defalias 'find-file-text #[(filename) "À !)‡" [(("")) file-name-buffer-file-type-alist find-file filename] 2 (#$ . 1708) "FFind file text: "]) (defalias 'find-file-not-found-set-buffer-file-type #[nil "ŠpqˆÀÁ !)Ç" [find-buffer-file-type buffer-file-name buffer-file-type nil] 2]) (add-hook (quote find-file-not-found-hooks) (quote find-file-not-found-set-buffer-file-type)) #@74 *List of shells that use `/c' instead of `-c' and a backslashed command. (defvar msdos-shells (quote ("command.com" "4dos.com" "ndos.com")) (#$ . -2142)) (byte-code "ÀÁ\nBÁ‡" [((ax . 0) (bx . 1) (cx . 2) (dx . 3) (si . 4) (di . 5) (cflag . 6) (flags . 7) (al 0 . 0) (bl 1 . 0) (cl 2 . 0) (dl 3 . 0) (ah 0 . 1) (bh 1 . 1) (ch 2 . 1) (dh 3 . 1)) register-name-alist current-load-list] 2) (defalias 'make-register #[nil "ÀÁÂ\"‡" [make-vector 8 0] 3]) (defalias 'register-value #[(regs name) "À \n\"A‰:ƒ$\f @H AÆUƒ Ǧ‚ Ç¥)‚0 §ƒ/\f H‚0È)‡" [assoc name register-name-alist where regs tem 0 256 nil] 4]) (defalias 'set-register-value #[(regs name value) "§ƒXÁYƒX \f\"A‰:ƒI @HÇÈ\"  @ AÁUƒ8ÊÇ Ë\"\"‚CÊÇ È\"ÌÍ\"\"Iˆ*‚W §ƒW ÇÎ\"Iˆ)‡" [value 0 assoc name register-name-alist where regs logand 255 tem logior 65280 lsh 8 65535] 8]) (defalias 'intdos #[(regs) "ÀÁ\n\"‡" [int86 33 regs] 3]) (put (quote intdos) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@42 Return the frame that WINDOW resides on. (defalias 'window-frame #[(window) "À ‡" [selected-frame] 1 (#$ . 3142)]) #@40 Raise FRAME to the top of the desktop. (defalias 'raise-frame #[(frame) "À‡" [nil] 1 (#$ . 3263)]) #@32 Select FRAME for input events. (defalias 'select-frame #[(frame &optional no-enter) "À ‡" [selected-frame] 1 (#$ . 3368)]) emacs-19.30/lisp/double.elc100666 12120 1 6120 6045212750 14014 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:13:58 1995 ;;; from file /home/fsf/rms/e19/lisp/double.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`double.el' was compiled for Emacs 19.29 or later")) #@254 Alist of key translations activated by double mode. Each entry is a list with three elements: 1. The key activating the translation. 2. The string to be inserted when the key is pressed once. 3. The string to be inserted when the key is pressed twice. (defvar double-map (quote ((59 "æ" ";") (39 "ø" "'") (91 "å" "[") (58 "Æ" ":") (34 "Ø" "\"") (123 "Å" "{"))) (#$ . 473)) #@199 *Non-nil means that Double mode mapping only works for prefix keys. That is, for any key `X' in `double-map', `X' alone will be mapped but not `C-u X' or `ESC X' since the X is not the prefix key. (defvar double-prefix-only t (#$ . -854)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp double-last-event nil current-load-list] 2) (defalias 'double-read-event #[(prompt) "ƒÁ ˆ\nƒÃÄ\n #ˆÆ ÃÇ!ˆ‡Æ ‡" [isearch-mode isearch-update prompt message "%s%c" double-last-event read-event ""] 4]) (byte-code "ÀÁÂ\"ˆÃÄ!„ÅÆ!ˆÇ\fÈÉ#‡" [global-set-key [ignore] (lambda nil (interactive)) boundp isearch-mode-map load-library "isearch" define-key [ignore] #[nil "À ‡" [isearch-update] 1 nil nil]] 4) (defalias 'double-translate-key #[(prompt) "\nƒ\fà !‚\fƒÅ GÆVƒà !‚ Ç=ƒYÈ !Ê \f\" ‰ =ƒPÏÐ A@GSÑ\"Ò 8Ó#ÃÑ!‚UCÔ*‚ Õ=ƒcÖ‚Ê \f\"A@  ÏÆØOÙ\"ÃÚH!))‡" [last-input-char key unread-command-events vector double-prefix-only this-command-keys 1 magic-start double-read-event prompt assoc double-last-event double-map entry new append make-list 127 2 (magic-end) [ignore] magic-end [ignore] exp nil (magic-start) 0] 5]) #@151 Key translation you want to have effect, regardless of Double mode. This defaults to the value of `key-translation-map' when double was first loaded. (defvar default-key-translation-map (byte-code "†Á ‡" [key-translation-map make-sparse-keymap] 1) (#$ . 1988)) (make-variable-buffer-local (quote key-translation-map)) (defalias 'double-setup #[nil "À !ÃÄÅÇ\"\"‡" [copy-keymap default-key-translation-map key-translation-map mapcar #[(entry) "À  @!Ä#‡" [define-key key-translation-map vector entry double-translate-key] 4] append double-map ((magic-start) (magic-end))] 5]) (byte-code "ÀÁ!„ÂÁ BÄÁ!ˆÁ ž„Æ B‡" [boundp double-mode nil current-load-list make-variable-buffer-local minor-mode-alist (double-mode " Double")] 2) #@204 Toggle Double mode. With prefix arg, turn Double mode on iff arg is positive. When Double mode is on, some keys will insert different strings when pressed twice. See variable `double-map' for details. (defalias 'double-mode #[(arg) "„ „Â!ÃXƒ …+ÄÆ ˆ)ÄÇ ‡ ?…+Æ ˆÈÇ ‡" [arg double-mode prefix-numeric-value 0 nil double-map double-setup force-mode-line-update t] 2 (#$ . 2731) "P"]) (provide (quote double)) emacs-19.30/lisp/dunnet.elc100666 21623 1 220305 6032175373 14065 0ustar mibdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Sep 27 03:16:59 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/dunnet.el ;;; emacs version 19.29.12. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`dunnet.el' was compiled for Emacs 19.29 or later")) #@53 Name of file to store score information for dunnet. (defvar dun-log-file "/usr/local/dunnet.score" (#$ . 478)) (require (quote cl)) #@32 Major mode for running dunnet. (defalias 'dun-mode #[nil "À ˆÁ\n!ˆÃʼn‡" [text-mode use-local-map dungeon-mode-map dungeon-mode major-mode "Dungeon" mode-name] 2 (#$ . 616) nil]) #@75 Function called when return is pressed in interactive mode to parse line. (defalias 'dun-parse #[(arg) "Àyˆ`Á\\È\n`U„<`\nW„<\nÁZ\n{Ęƒ<\n`{—Æ !ˆÇ #Ê=ƒCËÌ!ˆ‚CdbˆËÍ!ˆÎ ‡" [0 1 beg nil ">" line princ dun-vparse dun-ignore dun-verblist -1 dun-mprinc "I don't understand that.\n" "\n" dun-messages] 4 (#$ . 803) "*p"]) (defalias 'dun-messages #[nil "ƒÁ ‡\nÃ=…\f U„Æ !ˆ Ç ˆÈÉ!‡" [dun-dead text-mode dungeon-mode dungeon room dun-current-room dun-describe-room dun-fix-screen dun-mprinc ">"] 2]) #@44 Switch to *dungeon* buffer and start game. (defalias 'dunnet #[nil "ÀÁ!ˆÂ ˆÃÅÇ ‡" [switch-to-buffer "*dungeon*" dun-mode nil dun-dead 0 room dun-messages] 2 (#$ . 1319) nil]) (defalias 'dun-describe-room #[(room) "À !\n„ \f„ÅÆ!‡ÅÀ !8A@!ˆ „+ ʘƒ8 ËVƒ8 ̘ƒFÍÀ !8@!ˆÍÎ!ˆ ̘„`À !„`ÏÀ !C\"8Ò‰ƒì@‰Uƒ€Ö ˆ‚«ËYƒ“Å8@!ˆ‚«Uƒ „«ÅÀ!8@!ˆUƒãƒãÅÝ!ˆÒ‰ƒâ@Íà!ˆÅ8@!ˆA‰„Ç*A‰„n*8……Åá!‡" [abs room dun-light-rooms obj-lamp dun-inventory dun-mprincl "It is pitch dark. You are likely to be eaten by a grue." dun-rooms dun-visited dun-mode "dun-superb" 0 "long" dun-mprinc "\n" append dun-current-room dun-room-objects nil xobjs --dolist-temp--14500 obj-special dun-special-object dun-objects obj-bus dun-inbus dun-perm-objects obj-jar dun-jar "The jar contains:" x --dolist-temp--14501 " " "You are on the bus."] 5]) (defalias 'dun-special-object #[nil " Uƒ\nƒÃÄ!ˆ‚ÃÅ!ˆUƒ+8„+ÃÉ!ˆ\nUƒ; ƒ;ÃÌ!ˆ Uƒcƒc„[ÃÐ!ˆÒ!ˆ‚cÃÓ!ˆÔÕ!ˆVƒ~„uØ ˆ‚~ÃÙ!ˆÃ!ˆU…íÃÜ8!ˆÝU…í„¥8…íÃà!ˆƒÂá!ˆâ#C\"‚×ä\"ˆåâ8#C\"#ˆ&…íÃç!ˆá&!ˆä&\"‡" [dun-current-room computer-room dun-computer dun-mprincl "The panel lights are flashing in a seemingly organized pattern." "The panel lights are steady and motionless." red-room obj-towel dun-room-objects "There is a hole in the floor here." marine-life-area dun-black "The room is lit by a black light, causing the fish, and some of \nyour objects, to give off an eerie glow." fourth-vermont-intersection dun-hole dun-inbus "You fall into a hole in the ground." vermont-station dun-describe-room "The bus falls down a hole in the ground and explodes." dun-die "burning" endgame-computer-room dun-correct-answer dun-endgame-question "Your question is:" sauna 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.") 3 obj-rms dun-inventory "You notice the wax on your statuette beginning to melt, until it completely\nmelts off. You are left with a beautiful diamond!" dun-remove-obj-from-inven append obj-diamond dun-remove-obj-from-room dun-replace obj-floppy "You notice your floppy disk beginning to melt. As you grab for it, the \ndisk bursts into flames, and disintegrates."] 6]) (defalias 'dun-die #[(murderer) "ÀÁ!ˆ\nƒ\fÃÄ!ˆÅÆ\n\"ˆÇÈ!ˆÉ‰\n‡" [dun-mprinc "\n" murderer dun-mprincl "You are dead." dun-do-logfile dun-die dun-score nil t dun-dead] 3]) (defalias 'dun-quit #[(args) "ÀÁ!‡" [dun-die nil] 2]) (defalias 'dun-inven #[(args) "ÀÁ!ˆÀÂ!ˆ ĉƒc@‰ƒZÇ 8A@!ˆ  UƒZ\nƒZÇË!ˆ\nÄ\f‰ ƒY @\fÀÎ!ˆÇ\f8A@!ˆ A‰ „=*A‰„*ć" [dun-mprinc "You currently have:" "\n" dun-inventory nil curobj --dolist-temp--14502 dun-mprincl dun-objects obj-jar dun-jar "The jar contains:" x --dolist-temp--14503 " "] 5]) (defalias 'dun-shake #[(obj) "À !‰…s \fƒ(ÅÆ!ˆÅ 8A@—!ˆÅÈ!ˆÅÉ!‚s \n 8„B \n\f8„BÍÎ!‚s UƒSÅÐ!ˆÑÒ!‚s UƒdÅÔ!ˆÑÕ!‚s ÖWƒpÍ×!‚sÍØ!)‡" [nil objnum dun-objnum-from-args-std obj dun-inventory dun-mprinc "Shaking " dun-objects " seems to have no effect." "\n" dun-current-room dun-room-silents dun-room-objects dun-mprincl "I don't see that here." obj-tree "You begin to shake a tree, and notice a coconut begin to fall from the air.\nAs you try to get your hand up to block it, you feel the impact as it lands\non your head." dun-die "a coconut" obj-bear "As you go up to the bear, it removes your head and places it on the ground." "a bear" 0 "You cannot shake that." "You don't have that."] 3]) (defalias 'dun-drop #[(obj) "ƒÁÂ!‡Ã‰Æ!‰…K ‰„$ÁÉ!‚KÊ !ˆË\f Î \f8 C\"#ˆÁÏ!ˆ E…KÓ !*‡" [dun-inbus dun-mprincl "You can't drop anything while on the bus." nil ptr objnum dun-objnum-from-args-std obj dun-inventory "You don't have that." dun-remove-obj-from-inven dun-replace dun-room-objects dun-current-room append "Done." obj-food obj-weight obj-jar dun-drop-check] 6]) (defalias 'dun-drop-check #[(objnum) " Uƒ3\n Uƒ3\f 8ƒ3ÆÇ!ˆÈ \f\"ˆÈ \"ˆÊ  Ë 8\fC\"#ˆ UƒkƒkƒkÆÑ!ˆÒÈ  \"ˆ UƒkÔ Æ×!ˆU…} U…}ÆÚ!‡" [objnum obj-food room bear-hangout obj-bear dun-room-objects dun-mprincl "The bear takes the food and runs away with it. He left something behind." dun-remove-obj-from-room dun-current-room dun-replace append obj-key obj-jar obj-nitric dun-jar obj-glycerine "As the jar impacts the ground it explodes into many pieces." nil fourth-vermont-intersection t dun-hole vermont-station "The explosion causes a hole to open up in the ground, which you fall\nthrough." obj-weight maze-button-room "A passageway opens."] 6]) (defalias 'dun-examine #[(obj) "À !‰\f=ƒÅ[!‚¦ =ƒ, 8ƒ,ÊË!‚¦ À=ƒ8ÌÍ!‚¦ 8„Y  8„Y „YÌÐ!‚¦ ÑYƒ UƒyUƒyƒyÌÕ!‚¦ 8ƒ‰Ì 8!‚¦Ì×!‚¦Ø !8ƒ£ÌØ !8!‚¦Ì×!)‡" [nil objnum dun-objnum-from-args obj obj-special dun-describe-room dun-current-room obj-computer obj-pc dun-room-silents dun-examine ("pc") dun-mprincl "I don't know what that is." dun-room-objects dun-inventory "I don't see that here." 0 obj-bone marine-life-area dun-black "In this light you can see some writing on the bone. It says:\nFor an explosive time, go to Fourth St. and Vermont." dun-physobj-desc "I see nothing special about that." abs dun-permobj-desc] 4]) (defalias 'dun-take #[(obj) "ƒÁÂ!‡Ã\f!‰„ÁÅ!‡\fƘƒlÇÇ \n8Ç ‰\fƒ`\f@‰ ÍYƒW U„WÏÐ 8A@!ˆÐÒ!ˆÓ !ˆ\fA‰\f„.*?…jÁÔ!)‡ÇÖ\f!žA‰Ç=ƒˆÐØ!ˆÐÙ!‚ŒÓ!)‡" [dun-inbus dun-mprincl "You can't take anything while on the bus." dun-firstword obj "You must supply an object." "all" nil gotsome dun-current-room dun-room-objects x --dolist-temp--14504 0 obj-special t dun-mprinc dun-objects ": " dun-take-object "Nothing to take." objnum intern dun-objnames "I don't know what that is." "\n"] 5]) (defalias 'dun-take-object #[(objnum) " ƒE\n ƒEÄÆÇ!ˆÄ ĉ ƒ9 @‰U„0Ê C\" A‰ „* Ê C\"‰)‡ \f8„g  8„`ÎÏ!ˆ‚¯Ð!ˆ‚¯ÑYƒ« @ƒ…Ò 8\\ÔVƒ…ÎÕ!ˆ‚¯Ê C\"Ö \"ˆÎ×!ˆUƒ¯ Uƒ¯ÎÚ!ˆ‚¯Ð!ˆÎÛ!‡" [objnum dun-jar obj-jar dun-inventory nil newjar dun-mprincl "You remove it from the jar." x --dolist-temp--14505 append dun-current-room dun-room-objects dun-room-silents dun-mprinc "I do not see that here." dun-try-take 0 dun-inven-weight dun-object-lbs 11 "Your load would be too heavy." dun-remove-obj-from-room "Taken. " obj-towel red-room "Taking the towel reveals a hole in the floor." "\n"] 4]) (defalias 'dun-inven-weight #[nil "À À‰ƒ @ \f8\\ A‰„\f*À‰ƒ<@ \f8\\A‰„(* )‡" [nil total 0 dun-jar x --dolist-temp--14506 dun-object-lbs dun-inventory --dolist-temp--14507] 4]) (defalias 'dun-try-take #[(obj) "ÀÁ!‡" [dun-mprinc "You cannot take that."] 2]) (defalias 'dun-dig #[(args) "ƒÁÂ!‡Ã\f„ÁÅ!‡8„ÁÈ!‡ÁÉ!ˆÊ Ì 88\"#ˆÊÍ#‡" [dun-inbus dun-mprincl "You can't dig while on the bus." 0 dun-inventory "You have nothing with which to dig." dun-current-room dun-diggables "Digging here reveals nothing." "I think you found something." dun-replace dun-room-objects append nil] 7]) (defalias 'dun-climb #[(obj) "À !‰„ÄÅ!‚g =„8 8„8  8„8 \n„8ÄË!‚g =ƒP\f 8„PÄÍ!‚g \f=„d =„dÄÎ!‚gÄÏ!)‡" [nil objnum dun-objnum-from-args obj dun-mprincl "I don't know that name." obj-special dun-current-room dun-room-objects dun-room-silents dun-inventory "I don't see that here." obj-tree "There is nothing here to climb." "You can't climb that." "You manage to get about two feet up the tree and fall back down. You\nnotice that the tree is very unsteady."] 4]) (defalias 'dun-eat #[(obj) "À !‰…= \f„ÅÆ!‚= U„5ÈÉ!ˆÈ \n8A@—!ˆÅË!ˆÌÍ!‚=ÅÎ!ˆÏ!)‡" [nil objnum dun-objnum-from-args-std obj dun-inventory dun-mprincl "You don't have that." obj-food dun-mprinc "You forcefully shove " dun-objects " down your throat, and start choking." dun-die "choking" "That tasted horrible." dun-remove-obj-from-inven] 3]) (defalias 'dun-put #[(args) "ƒÁÂ!‡Ã‰‰‰È !‰„\"ÁÊ!‚«Ë@!‰\fžA‰„9ÁÍ!‚«„GÁÏ!‚«ÈA!ÈA!‰„_ÁÐ!‚«Ë@!\fžA‰=ƒ{Uƒ{ „…ÁÕ!‚« 8„¦ 8„¦ „¦ÁØ!‚«Ù \",‡" [dun-inbus dun-mprincl "You can't do that while on the bus" nil obj objnum2 objnum newargs dun-firstwordl args "You must supply an object" intern dun-objnames "I don't know what that object is." dun-inventory "You don't have that." "You must supply an indirect object." obj-computer dun-current-room pc-area obj-pc "I don't know what that indirect object is." dun-room-objects dun-room-silents "That indirect object is not here." dun-put-objs] 5]) (defalias 'dun-put-objs #[(obj1 obj2) " Uƒ\f\n„\f \fUƒ  Uƒ.Uƒ.È!ˆÉ\nËÌ!‡  Uƒ@Uƒ@ÏÐ!‡Uƒr ¯„bËÚ!‡È !ˆÛ C\"ËÝ!‡ Uƒ…È !ˆËÞ!ˆß C!‡ Uƒ½ !Uƒ¹Ëâ!ˆÈ !ˆã$%Û%$8 C\"#ˆæ' \"ˆ(T‰(‡Ëé!‡ *UƒÖ+UƒÖÉ,È !ˆËÝ!‡-UƒõÈ !ˆã$.Û.$8 C\"#ˆËï!‡0UƒËñ!‡ 2ƒ Ëó!‡Ëô!‡" [obj2 obj-drop dun-nomail obj-chute obj-disposal obj1 obj-cpu obj-computer dun-remove-obj-from-inven t dun-computer dun-mprincl "As you put the CPU board in the computer, it immediately springs to life.\nThe lights start flashing, and the fans seem to startup." obj-weight obj-button dun-drop ("weight") obj-jar obj-paper obj-diamond obj-emerald obj-license obj-coins obj-egg obj-nitric obj-glycerine "That will not fit in the jar." append dun-jar "Done." "You hear it slide down the chute and off into the distance." dun-put-objs-in-treas obj-box obj-key "As you drop the key, the box begins to shake. Finally it explodes\nwith a bang. The key seems to have vanished!" dun-replace dun-room-objects computer-room dun-remove-obj-from-room dun-current-room dun-key-level "You can't put that in the key box!" obj-floppy obj-pc dun-floppy obj-urinal urinal "You hear it plop down in some water below." obj-mail "The mail chute is locked." dun-inventory "I don't know how to combine those objects. Perhaps you should\njust try dropping it." "You can't put that there."] 9]) (defalias 'dun-type #[(args) " U„\nÂÃ!‡\f„ÂÅ!‡Æ ‡" [dun-current-room computer-room dun-mprincl "There is nothing here on which you could type." dun-computer "You type on the keyboard, but your characters do not even echo." dun-unix-interface] 2]) (defalias 'dun-n #[(args) "À !‡" [dun-move north] 2]) (defalias 'dun-s #[(args) "À !‡" [dun-move south] 2]) (defalias 'dun-e #[(args) "À !‡" [dun-move east] 2]) (defalias 'dun-w #[(args) "À !‡" [dun-move west] 2]) (defalias 'dun-ne #[(args) "À !‡" [dun-move northeast] 2]) (defalias 'dun-se #[(args) "À !‡" [dun-move southeast] 2]) (defalias 'dun-nw #[(args) "À !‡" [dun-move northwest] 2]) (defalias 'dun-sw #[(args) "À !‡" [dun-move southwest] 2]) (defalias 'dun-up #[(args) "À !‡" [dun-move up] 2]) (defalias 'dun-down #[(args) "À !‡" [dun-move down] 2]) (defalias 'dun-in #[(args) "À !‡" [dun-move in] 2]) (defalias 'dun-out #[(args) "À !‡" [dun-move out] 2]) (defalias 'dun-go #[(args) "@ƒÁ\n @AA$Ä=…ÅÆ!‡" [args dun-doverb dun-ignore dun-verblist -1 dun-mprinc "I don't understand where you want me to go.\n"] 5]) (defalias 'dun-move #[(dir) " „\n „ÄÅ!ˆÆÇ!‡È \n 88‰ Ì=ƒ,ÄÍ!‚~ Î=ƒ:Ï\n!‚~Ì\nƒz ÓW„T ÔVƒZÕÖ!‚~Õ×!ˆØ\"ˆ Ú Ü 8C\"#‚~ ‰)‡" [dun-current-room dun-light-rooms obj-lamp dun-inventory dun-mprinc "You trip over a grue and fall into a pit and break every bone in your\nbody." dun-die "a grue" nil newroom dir dungeon-map -1 "You can't go that way.\n" 255 dun-special-move room dun-lastdir dun-inbus 58 83 dun-mprincl "The bus cannot go this way." "The bus lurches ahead and comes to a screeching halt." dun-remove-obj-from-room obj-bus dun-replace dun-room-objects append] 7]) (defalias 'dun-special-move #[(dir) " Uƒ\n „ÄÅ!‡‰‡UƒGÈ ÄÊ!ˆËÌ!ˆÍ  „4ËÏ!ˆ ˜ƒB‚FÄÒ!ˆ)Uƒh8ƒdËÖ!ˆ×Ø!ˆ‚hÄÙ!ˆUƒzÄÛ!ˆÄÜ!ˆUƒ˜\n ƒ”ßVƒ” ‚˜ÄÅ!ˆ!Uƒ»\"#Uƒ»$!8ƒ·å‚»ÄÙ!ˆ!Uƒß\"&Uƒß$!8ƒÜÄÙ!ˆ‚ß'(UƒêÄé!ˆ*U„ø+UƒüìÈ!ˆ-Uƒ.ïU„0‚Äñ!ˆ×ò!ˆ3Uƒ4438„05‚4ÄÙ!ˆ\"6VƒŠVƒŠ7WƒŠ88„[ÄÙ!ˆ‚í\"9Uƒ~: ƒwÄû!ˆü=ü>‚íÄÿ!ˆ‚íÄ@!ˆÈ>‚íAUƒ±>„¥ÄB!ˆ×C!ˆ‚±ÄD!ˆ×E!ˆFUƒí>„ÆÄG!ˆ‚íÄH!ˆIF8\"ˆJKLK88C\"#ˆKMU…þÄN!ˆO‰‡" [dun-current-room building-front obj-key dun-inventory dun-mprincl "You don't have a key that can open this door." old-building-hallway north-end-of-cave-passage nil combo "You must type a 3 digit combination code to enter this room." dun-mprinc "Enter it here: " dun-read-line dun-batch-mode "\n" dun-combination gamma-computing-center "Sorry, that combination is incorrect." bear-hangout obj-bear dun-room-objects "The bear is very annoyed that you would be so presumptuous as to try\nand walk right by it. He tells you so by tearing your head off.\n" dun-die "a bear" "You can't go that way." vermont-station "As you board the train it immediately leaves the station. It is a very\nbumpy ride. It is shaking from side to side, and up and down. You\nsit down in one of the chairs in order to be more comfortable." "\nFinally the train comes to a sudden stop, and the doors open, and some\nforce throws you out. The train speeds away.\n" museum-station dun-key-level 0 meadow maze-button-room dir northwest obj-weight 18 up weight-room classroom "The door is locked." lakefront-north lakefront-south dun-swim reception-area dun-sauna-level 3 health-club-front "As you exit the building, you notice some flames coming out of one of the\nwindows. Suddenly, the building explodes in a huge ball of fire. The flames\nengulf you, and you burn to death." "burning" red-room obj-towel long-n-s-hallway down museum-lobby obj-bus in obj-license "You board the bus and get in the driver's seat." t dun-nomail dun-inbus "You are not licensed for this type of vehicle." "You hop off the bus." fifth-oaktree-intersection "You fall down the cliff and land on your head." "a cliff" "The bus flies off the cliff, and plunges to the bottom, where it explodes." "a bus accident" main-maple-intersection "The gate will not open." "As the bus approaches, the gate opens and you drive through." dun-remove-obj-from-room dun-replace museum-entrance append cave-entrance "As you enter the room you hear a rumbling noise. You look back to see\nhuge rocks sliding down from the ceiling, and blocking your way out.\n" misty-room] 6]) (defalias 'dun-long #[(args) "À‰‡" ["long" dun-mode] 2]) (defalias 'dun-turn #[(obj) "À‰Ã\f!‰…u\n 8„$\n 8„$ÈÉ!‚u\n\nU„1ÈË!‚uÌ\fA!‰ƒF ͘„L Θ„LÈÏ!‚u ͘ƒ[Ñ\\‚aÑZÒWƒsÈÓ!ˆÒ‰‚uÔ *‡" [nil direction objnum dun-objnum-from-args-std obj dun-current-room dun-room-objects dun-room-silents dun-mprincl "I don't see that here." obj-dial "You can't turn that." dun-firstword "clockwise" "counterclockwise" "You must indicate clockwise or counterclockwise." dun-sauna-level 1 0 "The dial will not turn further in that direction." dun-sauna-heat] 4]) (defalias 'dun-sauna-heat #[nil "ÁUƒ\nÂÃ!ˆÄUƒÂÅ!ˆÆUƒÂÇ!ˆÈUƒžÂÉ!ˆ\n „;\n\f 8ƒpÂÎ!ˆ\n ƒXÏ\n!ˆÐ C\" ‚pÒ\f\n\"ˆÓ \fÐ\f 8C\"#ˆ „ƒ\f 8ƒžÂÕ!ˆ ƒ—Ï!ˆ‚žÒ\f\"ˆÖU…«Â×!ˆØÙ!‡" [dun-sauna-level 0 dun-mprincl "The termperature has returned to normal room termperature." 1 "It is now luke warm in here. You begin to sweat." 2 "It is pretty hot in here. It is still very comfortable." 3 "It is now very hot. There is something very refreshing about this." obj-rms dun-inventory dun-current-room dun-room-objects "You notice the wax on your statuette beginning to melt, until it completely\nmelts off. You are left with a beautiful diamond!" dun-remove-obj-from-inven append obj-diamond dun-remove-obj-from-room dun-replace obj-floppy "You notice your floppy disk beginning to melt. As you grab for it, the \ndisk bursts into flames, and disintegrates." 4 "As the dial clicks into place, you immediately burst into flames." dun-die "burning"] 6]) (defalias 'dun-press #[(obj) "À !‰…e \f 8„! \f8„!ÇÈ!‚e  \nD„;ËÌ!ˆË @!ˆÇÎ!‚e  UƒFÇÏ!ˆ \nU…eƒ]ÇÑ!ˆÀ‰‚eÇÒ!ˆÓ‰)‡" [nil objnum dun-objnum-from-args-std obj dun-current-room dun-room-objects dun-room-silents dun-mprincl "I don't see that here." obj-button obj-switch dun-mprinc "You can't " line-list " that." "As you press the button, you notice a passageway open up, but\nas you release it, the passageway closes." dun-black "The button is now in the off position." "The button is now in the on position." t] 3]) (defalias 'dun-swim #[(args) " \nD„\fÃÄ!‡ „ÃÇ!ˆÈÉ!‡ Uƒ%\n‰‡ ‰‡" [dun-current-room lakefront-north lakefront-south dun-mprincl "I see no water!" obj-life dun-inventory "You dive in the water, and at first notice it is quite cold. You then\nstart to get used to it as you realize that you never really learned how\nto swim." dun-die "drowning"] 3]) (defalias 'dun-score #[(args) "„Áà ÄÅ!ˆÄ\n!ˆÆÇ!ˆ\n)‡ÄÅ!ˆÄÈ !ˆÆÉ!ˆÈ ÊU…/ÆË!‡" [dun-endgame nil total dun-reg-score dun-mprinc "You have scored " dun-mprincl " out of a possible 90 points." dun-endgame-score " endgame points out of a possible 110." 110 "\n\nCongratulations. You have won. The wizard password is 'moby'"] 2]) (defalias 'dun-help #[(args) "ÀÁ!‡" [dun-mprincl "Welcome to dunnet (2.0), by Ron Schnell (ronnie@media.mit.edu).\nHere is some useful information (read carefully because there are one\nor more clues in here):\n- If you have a key that can open a door, you do not need to explicitly\n open it. You may just use 'in' or walk in the direction of the door.\n\n- If you have a lamp, it is always lit.\n\n- You will not get any points until you manage to get treasures to a certain\n place. Simply finding the treasures is not good enough. There is more\n than one way to get a treasure to the special place. It is also\n important that the objects get to the special place *unharmed* and\n *untarnished*. You can tell if you have successfully transported the\n object by looking at your score, as it changes immediately. Note that\n an object can become harmed even after you have received points for it.\n If this happens, your score will decrease, and in many cases you can never\n get credit for it again.\n\n- You can save your game with the 'save' command, and use restore it\n with the 'restore' command.\n\n- There are no limits on lengths of object names.\n\n- Directions are: north,south,east,west,northeast,southeast,northwest,\n southwest,up,down,in,out.\n\n- These can be abbreviated: n,s,e,w,ne,se,nw,sw,u,d,in,out.\n\n- If you go down a hole in the floor without an aid such as a ladder,\n you probably won't be able to get back up the way you came, if at all.\n\n- To run this game in batch mode (no emacs window), use:\n emacs -batch -l dunnet\n\nIf you have questions or comments, please contact ronnie@media.mit.edu."] 2]) (defalias 'dun-flush #[(args) " U„\nÂÃ!‡ÂÄ!ˆÅ8!ˆÈÉ#‡" [dun-current-room bathroom dun-mprincl "I see nothing to flush." "Whoooosh!!" dun-put-objs-in-treas urinal dun-room-objects dun-replace nil] 4]) (defalias 'dun-piss #[(args) " U„\nÂÃ!‡\f„ÂÅ!‡ÂÆ!ˆÇÈ \nË\n 8\fC\"#‡" [dun-current-room bathroom dun-mprincl "You can't do that here, don't even bother trying." dun-gottago "I'm afraid you don't have to go now." "That was refreshing." nil dun-replace dun-room-objects urinal append obj-URINE] 6]) (defalias 'dun-sleep #[(args) " U„\nÂÃ!‡ÄÂÆ!‡" [dun-current-room bedroom dun-mprincl "You try to go to sleep while standing up here, but can't seem to do it." t dun-gottago "As soon as you start to doze off you begin dreaming. You see images of\nworkers digging caves, slaving in the humid heat. Then you see yourself\nas one of these workers. While no one is looking, you leave the group\nand walk into a room. The room is bare except for a horseshoe\nshaped piece of stone in the center. You see yourself digging a hole in\nthe ground, then putting some kind of treasure in it, and filling the hole\nwith dirt again. After this, you immediately wake up."] 2]) (defalias 'dun-break #[(obj) "À\n „ÄÅ!‚›Æ!‰…› ƒ'ÄÈ!ˆÉÊ!‚›  \f8„A   8„AÄÎ!‚› Uƒ‚ÄÐ!ˆÑ\fÓ\f8 \"#ˆ ƒpCÕ\"ˆ‚rÀ ÀÄØ!ˆÙ ‚› ÚWƒ’ÄÛ!ˆÜ\n!‚›ÄÝ!ˆÕ \")‡" [nil objnum obj-axe dun-inventory dun-mprincl "You have nothing you can use to break things." dun-objnum-from-args-std obj "You take the object in your hands and swing the axe. Unfortunately, you miss\nthe object and slice off your hand. You bleed to death." dun-die "an axe" dun-current-room dun-room-objects dun-room-silents "I don't see that here." obj-cable "As you break the ethernet cable, everything starts to blur. You collapse\nfor a moment, then straighten yourself up.\n" dun-replace gamma-computing-center append obj-key dun-remove-obj-from-room computer-room dun-ethernet "Connection closed." dun-unix-interface 0 "Your axe shatters into a million pieces." dun-remove-obj-from-inven "Your axe breaks it into a million pieces."] 6]) (defalias 'dun-drive #[(args) "„ÁÂ!‡ÁÃ!‡" [dun-inbus dun-mprincl "You cannot drive when you aren't in a vehicle." "To drive while you are in the bus, just give a direction."] 2]) (defalias 'dun-superb #[(args) "À‰‡" [dun-superb dun-mode] 2]) (defalias 'dun-reg-score #[nil "À \f8À‰ƒ#@ 8\\A‰„* \f8ƒ/ )‡" [nil total 0 treasure-room dun-room-objects x --dolist-temp--14508 dun-object-pts obj-URINE] 4]) (defalias 'dun-endgame-score #[nil "À \f8À‰ƒ#@ 8\\A‰„* )‡" [nil total 0 endgame-treasure-room dun-room-objects x --dolist-temp--14509 dun-object-pts] 4]) (defalias 'dun-answer #[(args) "„ÁÂ!‡ @‰„ÁÄ!‡Å \"ƒ7ÁÆ!ˆÈUƒ- T ‚3 ÊZ ˉ‡ÁÌ!‡" [dun-correct-answer dun-mprincl "I don't believe anyone asked you anything." args "You must give the answer on the same line." dun-members "Correct." dun-lastdir 0 dun-current-room 1 nil "That answer is incorrect."] 4]) (defalias 'dun-endgame-question #[nil "„ÁÂ!ˆÁÃ!ˆÄ‰‡Æ‰‰ ÊÆËG! ÁÂ!ˆÁ 8@‰\f!ˆ 8A WƒVÍ8C\"T‰‚< T‰GWƒvÍ8C\"T‰‚\\‰+‡" [dun-endgame-questions dun-mprincl "Your question is:" "No more questions, just do 'answer foo'." ("foo") dun-correct-answer nil newques i which 0 random dun-endgame-question append] 5]) (defalias 'dun-power #[(args) " U„\nÂÃ!‡\f„Å ‡Æ ‡" [dun-current-room pc-area dun-mprincl "That operation is not applicable here." dun-floppy dun-dos-no-disk dun-dos-interface] 2]) (defalias 'dun-feed #[(args) "À !‰…O \fUƒ-\f 8ƒ-„'ÉÊ!‚OËÌ!‚O 8„L „L  8„LÉÎ!‚OÉÏ!)‡" [nil objnum dun-objnum-from-args-std args obj-bear dun-current-room dun-room-objects obj-food dun-inventory dun-mprincl "You have nothing with which to feed it." dun-drop ("food") dun-room-silents "I don't see that here." "You cannot feed that."] 3]) (defalias 'dun-doverb #[(dun-ignore dun-verblist verb rest) "??…;Á!\nƒ @„ćÅ\n @ A$‡Á!žA„+ćTÈÁ!žAÃD!‡" [verb intern dun-ignore rest -1 dun-doverb dun-verblist dun-numcmds eval] 5]) (defalias 'dun-listify-string #[(strin) "À‰‰ÄÀÅÆ ÀO\"‰ƒ3 \\‰ U„,È\n O—C\" É\\‚\n\n+‡" [nil end-pos ret-list pos 0 string-match "[ ,:;]" strin append 1] 6]) (defalias 'dun-listify-string2 #[(strin) "À‰‰ÄÀÅÆ ÀO\"‰ƒ3 \\‰ U„,È\n O—C\" É\\‚\n\n+‡" [nil end-pos ret-list pos 0 string-match " " strin append 1] 6]) (defalias 'dun-replace #[(list n number) " ›\n ‡" [n list number] 2]) (defalias 'dun-firstword #[(list) "@??…ƒÁ@!\nƒA‰„ @‡" [list intern dun-ignore] 3]) (defalias 'dun-firstwordl #[(list) "@??…ƒÁ@!\nƒA‰„ ‡" [list intern dun-ignore] 3]) (defalias 'dun-vparse #[(dun-ignore dun-verblist line) "ÀÁ!ˆÂ ÄP!Æ @ A$‡" [dun-mprinc "\n" dun-listify-string line " " line-list dun-doverb dun-ignore dun-verblist] 5]) (defalias 'dun-parse2 #[(dun-ignore dun-verblist line) "ÀÁ!ˆÂ ÄP!Æ @ A$‡" [dun-mprinc "\n" dun-listify-string2 line " " line-list dun-doverb dun-ignore dun-verblist] 5]) (defalias 'dun-read-line #[nil "ÀÂÃ!Ä !ˆ )‡" [nil line read-string "" dun-mprinc] 2]) (defalias 'dun-minsert #[(string) ";ƒc‡Á!c‡" [string prin1-to-string] 2]) (defalias 'dun-mprinc #[(string) ";ƒc‡Á!c‡" [string prin1-to-string] 2]) (defalias 'dun-fix-screen #[nil "À ÁZ[yˆÂà `\"ˆÄ ‡" [window-height 2 set-window-start selected-window end-of-buffer] 3 nil nil]) (defalias 'dun-minsertl #[(string) "À !ˆÀÂ!‡" [dun-minsert string "\n"] 2]) (defalias 'dun-mprincl #[(string) "À !ˆÀÂ!‡" [dun-mprinc string "\n"] 2]) (defalias 'dun-objnum-from-args #[(obj) "À !‰„\f‚Å !žA‰)‡" [nil objnum dun-firstword obj obj-special intern dun-objnames] 3]) (defalias 'dun-objnum-from-args-std #[(obj) "À !‰\f=ƒÅÆ!ˆ À=ƒÅÇ!ˆ \f=?…\" )‡" [nil result dun-objnum-from-args obj obj-special dun-mprincl "You must supply an object." "I don't know what that is."] 2]) (defalias 'dun-space-to-hyphen #[(string) "ÀÂÃ\f\"‰ƒ\fÅ OÆ\f TÀOQÇ\f!‚\f)‡" [nil space string-match "[ /]" string 0 "-" dun-space-to-hyphen] 5]) (defalias 'dun-get-path #[(dirstring startlist) "À‰ GÄUƒ ‚F ÄÆOǘƒ&È ÆÀOÉ ÇC\"\"‚FÊÇ \"‰„7É C\"‚FÈ \nTÀOÉ Ä\nOC\"\"*‡" [nil pos slash dirstring 0 startlist 1 "/" dun-get-path append string-match] 7]) (defalias 'dun-members #[(string string-list) "ÀÀ\nÀ‰ƒ\f@‰ ˜ƒÆ\fA‰„\f* )‡" [nil found string-list x --dolist-temp--14510 string t] 3]) (defalias 'dun-put-objs-in-treas #[(objlist) "À‰à Ä ÆÇ @\"#ˆÃ \n U?…ÉÀ!*‡" [nil newscore oscore dun-reg-score dun-replace dun-room-objects 0 append objlist dun-score] 6]) (defalias 'dun-load-d #[(filename) "À‰ÃpÄÅÆ!!ˆÇ ˆÀÈɈ ƒ*ÀÊËˆÌ ˆÍp!ˆÄ\n!ˆ *‡" [nil result old-buffer t switch-to-buffer get-buffer-create "*loadc*" erase-buffer (insert-file-contents filename) ((error (byte-code "ÀÀ‡" [nil result] 1))) (dun-rot13) ((error (yank))) eval-current-buffer kill-buffer] 3]) (defalias 'dun-remove-obj-from-room #[(room objnum) "ÀÀ\n 8À‰ƒ% @‰U„Ç \fC\" A‰„*\n ›  )‡" [nil newroom room dun-room-objects x --dolist-temp--14511 objnum append] 4]) (defalias 'dun-remove-obj-from-inven #[(objnum) "ÀÀ\nÀ‰ƒ\"\f@‰ U„Æ C\"\fA‰„\f* ‰)‡" [nil new-inven dun-inventory x --dolist-temp--14512 objnum append] 4]) (byte-code "ÀÁÂÆÇÀ\" ÇWƒ ‰Iˆ T‰‚ \f‰P‰–ÀÀÉWƒM Ê\\\f Ë\\HIˆ Ì\\ Ë\\HIˆ T‰‚)+‡" [0 "abcdefghijklmnopqrstuvwxyz" nil upper lower i make-vector 256 dun-translate-table 26 97 13 65] 6) (defalias 'dun-rot13 #[nil "À‰Áed{‰G\n Wƒ#\f\n \f\nHHIˆ\nT‰‚Æ ˆ\fc+‡" [nil 0 i len str dun-translate-table erase-buffer] 6]) (byte-code "ÀÂÄÄÇÈ!„ÄÈ B Ê ËÌÍ#ˆÇÎ!„-Ï Î B ÑÒOÓ˜ƒ]ÄÕÑÂZ‰WƒYÖIˆ‚C)‚|ÄÕÑÂZ‰Wƒ{A@ÖIˆ‚c)ËÌ×#ˆËØ×#ˆÄÄÑÄÄÑÑÄ Ä!Ñ\"Ñ#Ä$Ä%Ä&ç(é*ë,Ä-î/ð1Ä2ó4õ6÷8Ä9ó:Ä;ü=þ?@AÄBÄCDEFGÑHÑII B ÂJJ B ÒKK B LMM B NOO B PQQ B RSS B TUU B VWW B XYY B Z[[ B \\]] B ^_`a`Äb‰cƒÖc@bÄdefb@!Pdghid!bAE!ˆ)cA‰c„¥*jkk B ÄlCmCĉ‰nCoCĉkCpqrEĉkCÄstDĉuvDĉ‰‰‰‰‰wCÄxCĉ‰‰‰‰‰‰‰‰‰‰‰‰‰‰ykDĉ‰‰‰zCĉ‰{Cĉ‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰kCĉ|CÄ}CÄ~CÄk€EC‚Cĉ‰‰‰ƒCĉkCÄkCÄkCÄ„Cĉ‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰¯¡…ĆC†Cĉ‰‰‰‰‡CˆCĉ‰‰CÄŠC‹ŠDĉ‰‰‰‰‰‰‰‰ŒCĉ‰‰‰ŽDDĉ‰‰‰‰mCĉ‰‰‰‰‰‰‰‰‰‰‰‰ˆ‘D’C“Cĉ‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰”Cĉ‰•CÄ–—D˜C™CšCĉ›CĉˆCĉ‰‰‰‰‰‰œCĉ‰‰‰‰¯ožŸ ¡¢£¤¥¦§¨©ª«¬­Ä‰‰®Cĉ‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰¯Cĉ‰‰‰‰‰‰¯3°Ò±Ä²=Äb‰³ƒ\n³@b´²µbA@!—C\"²³A‰³„ê*¶·Ä¸Ñ¸²Äb‰¹ƒF¹@bghib!¸E!ˆ¸Â\\¸¹A‰¹„!+ć" [(27) dun-visited 1 dun-current-room nil dun-exitf dun-badcd boundp dungeon-mode-map current-load-list make-sparse-keymap define-key " " dun-parse dungeon-batch-map make-keymap emacs-version 0 2 "18" n 32 dungeon-nil exit-minibuffer "\n" dun-computer dun-floppy dun-key-level dun-hole dun-correct-answer dun-lastdir dun-numsaves dun-jar dun-dead room dun-numcmds dun-wizard dun-endgame-question dun-logged-in dungeon dungeon-mode ((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)) dun-unix-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)) dun-dos-verbs dun-batch-mode "/usr/toukmond" dun-cdpath -10 dun-cdroom dun-uncompressed t dun-ethernet (dun-room-objects dungeon-map dun-rooms dun-room-silents dun-combination) dun-restricted ascii dun-ftptype dun-endgame dun-gottago dun-black (("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.\nIn the distance you can see that it will eventually fork off. The\ntrees here are very tall royal palms, and they are spaced equidistant\nfrom each other." "Dead end") ("You are on the continuation of a dirt road. There are more trees on\nboth 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\nsoutheast. 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\nto 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\nnorthwest." "Bear hangout") ("You are in the hallway of an old building. There are rooms to the east\nand 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\nkept. The exit is to the west." "Mailroom") ("You are in a computer room. It seems like most of the equipment has\nbeen removed. There is a VAX 11/780 in front of you, however, with\none of the cabinets wide open. A sign on the front of the machine\nsays: This VAX is named 'pokey'. To type on the console, use the\n'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\nto the west, and a door leads to the south." "Meadow") ("You are in a round, stone room with a door to the east. There\nis 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\nare rooms to the east and west." "Northbound Hallway") ("You are in a sauna. There is nothing in the room except for a dial\non 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,\nor 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\nor completely broken. There is a door out to the west, and there is a ladder\nleading down a hole in the floor." "Weight room") ("You are in a maze of twisty little passages, all alike.\nThere 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") ("You are in a maze of twenty little passages, all alike." "Maze") ("You are in a daze of twisty little passages, all alike." "Maze") ("You are in a maze of twisty little cabbages, all alike." "Maze") ("You are in a reception area for a health and fitness center. The place\nappears to have been recently ransacked, and nothing is left. There is\na 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\nand 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\na 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\nnortheast 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\ntowards a deep lake. On the ground nearby there is a chute, with a sign\nthat says 'put treasures here for points'." "Cave Entrance") ("You are in a misty, humid room carved into a mountain.\nTo the north is the remains of a rockslide. To the east, a small\npassage leads away into the darkness." "Misty Room") ("You are in an east/west passageway. The walls here are made of\nmulticolored rock and are quite beautiful." "Cave E/W passage") ("You are at the junction of two passages. One goes north/south, and\nthe other goes west." "N/S/W Junction") ("You are at the north end of a north/south passageway. There are stairs\nleading down from here. There is also a door leading west." "North end of cave passage") ("You are at the south end of a north/south passageway. There is a hole\nin the floor here, into which you could probably fit." "South end of cave passage") ("You are in what appears to be a worker's bedroom. There is a queen-\nsized bed in the middle of the room, and a painting hanging on the\nwall. A door leads to another room to the south, and stairways\nlead up and down." "Bedroom") ("You are in a bathroom built for workers in the cave. There is a\nurinal hanging on the wall, and some exposed pipes on the opposite\nwall where a sink used to be. To the north is a bedroom." "Bathroom") ("This is a marker for the urinal. User will not see this, but it\nis a room that can contain objects." "Urinal") ("You are at the northeast end of a northeast/southwest passageway.\nStairs lead up out of sight." "Ne end of ne/sw cave passage") ("You are at the junction of northeast/southwest and east/west passages." "Ne/sw-e/w junction") ("You are at the southwest end of a northeast/southwest passageway." "Sw end of ne/sw cave passage") ("You are at the east end of an e/w passage. There are stairs leading up\nto a room above." "East end of e/w cave passage") ("You are at the west end of an e/w passage. There is a hole on the ground\nwhich leads down out of sight." "West end of e/w cave passage") ("You are in a room which is bare, except for a horseshoe shaped boulder\nin the center. Stairs lead down from here." "Horseshoe boulder room") ("You are in a room which is completely empty. Doors lead out to the north\nand east." "Empty room") ("You are in an empty room. Interestingly enough, the stones in this\nroom are painted blue. Doors lead out to the east and south." "Blue room") ("You are in an empty room. Interestingly enough, the stones in this\nroom are painted yellow. Doors lead out to the south and west." "Yellow room") ("You are in an empty room. Interestingly enough, the stones in this room\nare painted red. Doors lead out to the west and north." "Red room") ("You are in the middle of a long north/south hallway." "Long n/s hallway") ("You are 3/4 of the way towards the north end of a long north/south hallway." "3/4 north") ("You are at the north end of a long north/south hallway. There are stairs\nleading upwards." "North end of long hallway") ("You are 3/4 of the way towards the south end of a long north/south hallway." "3/4 south") ("You are at the south end of a long north/south hallway. There is a hole\nto the south." "South end of long hallway") ("You are at a landing in a stairwell which continues up and down." "Stair landing") ("You are at the continuation of an up/down staircase." "Up/down staircase") ("You are at the top of a staircase leading down. A crawlway leads off\nto the northeast." "Top of staircase.") ("You are in a crawlway that leads northeast or southwest." "Ne crawlway") ("You are in a small crawlspace. There is a hole in the ground here, and\na small passage back to the southwest." "Small crawlspace") ("You are in the Gamma Computing Center. An IBM 3090/600s is whirring\naway in here. There is an ethernet cable coming out of one of the units,\nand going through the ceiling. There is no console here on which you\ncould type." "Gamma computing center") ("You are near the remains of a post office. There is a mail drop on the\nface of the building, but you cannot see where it leads. A path leads\nback to the east, and a road leads to the north." "Post office") ("You are at the intersection of Main Street and Maple Ave. Main street\nruns north and south, and Maple Ave runs east off into the distance.\nIf you look north and east you can see many intersections, but all of\nthe buildings that used to stand here are gone. Nothing remains except\nstreet signs.\nThere is a road to the northwest leading to a gate that guards a building." "Main-Maple intersection") ("You are at the intersection of Main Street and the west end of Oaktree Ave." "Main-Oaktree intersection") ("You are at the intersection of Main Street and the west end of Vermont Ave." "Main-Vermont intersection") ("You are at the north end of Main Street at the west end of Sycamore Ave." "Main-Sycamore intersection") ("You are at the south end of First Street at Maple Ave." "First-Maple intersection") ("You are at the intersection of First Street and Oaktree Ave." "First-Oaktree intersection") ("You are at the intersection of First Street and Vermont Ave." "First-Vermont intersection") ("You are at the north end of First Street at Sycamore Ave." "First-Sycamore intersection") ("You are at the south end of Second Street at Maple Ave." "Second-Maple intersection") ("You are at the intersection of Second Street and Oaktree Ave." "Second-Oaktree intersection") ("You are at the intersection of Second Street and Vermont Ave." "Second-Vermont intersection") ("You are at the north end of Second Street at Sycamore Ave." "Second-Sycamore intersection") ("You are at the south end of Third Street at Maple Ave." "Third-Maple intersection") ("You are at the intersection of Third Street and Oaktree Ave." "Third-Oaktree intersection") ("You are at the intersection of Third Street and Vermont Ave." "Third-Vermont intersection") ("You are at the north end of Third Street at Sycamore Ave." "Third-Sycamore intersection") ("You are at the south end of Fourth Street at Maple Ave." "Fourth-Maple intersection") ("You are at the intersection of Fourth Street and Oaktree Ave." "Fourth-Oaktree intersection") ("You are at the intersection of Fourth Street and Vermont Ave." "Fourth-Vermont intersection") ("You are at the north end of Fourth Street at Sycamore Ave." "Fourth-Sycamore intersection") ("You are at the south end of Fifth Street at the east end of Maple Ave." "Fifth-Maple intersection") ("You are at the intersection of Fifth Street and the east end of Oaktree Ave.\nThere is a cliff off to the east." "Fifth-Oaktree intersection") ("You are at the intersection of Fifth Street and the east end of Vermont Ave." "Fifth-Vermont intersection") ("You are at the north end of Fifth Street and the east end of Sycamore Ave." "Fifth-Sycamore intersection") ("You are in front of the Museum of Natural History. A door leads into\nthe building to the north, and a road leads to the southeast." "Museum entrance") ("You are in the main lobby for the Museum of Natural History. In the center\nof the room is the huge skeleton of a dinosaur. Doors lead out to the\nsouth and east." "Museum lobby") ("You are in the geological display. All of the objects that used to\nbe on display are missing. There are rooms to the east, west, and \nnorth." "Geological display") ("You are in the marine life area. The room is filled with fish tanks,\nwhich are filled with dead fish that have apparently died due to\nstarvation. Doors lead out to the south and east." "Marine life area") ("You are in some sort of maintenance room for the museum. There is a\nswitch on the wall labeled 'BL'. There are doors to the west and north." "Maintenance room") ("You are in a classroom where school children were taught about natural\nhistory. On the blackboard is written, 'No children allowed downstairs.'\nThere is a door to the east with an 'exit' sign on it. There is another\ndoor to the west." "Classroom") ("You are at the Vermont St. subway station. A train is sitting here waiting." "Vermont station") ("You are at the Museum subway stop. A passage leads off to the north." "Museum station") ("You are in a north/south tunnel." "N/S tunnel") ("You are at the north end of a north/south tunnel. Stairs lead up and\ndown from here. There is a garbage disposal here." "North end of n/s tunnel") ("You are at the top of some stairs near the subway station. There is\na door to the west." "Top of subway stairs") ("You are at the bottom of some stairs near the subway station. There is\na room to the northeast." "Bottom of subway stairs") ("You are in another computer room. There is a computer in here larger\nthan you have ever seen. It has no manufacturers name on it, but it\ndoes have a sign that says: This machine's name is 'endgame'. The\nexit is to the southwest. There is no console here on which you could\ntype." "Endgame computer room") ("You are in a north/south hallway." "Endgame n/s hallway") ("You have reached a question room. You must answer a question correctly in\norder to get by. Use the 'answer' command to answer the question." "Question room 1") ("You are in a north/south hallway." "Endgame n/s hallway") ("You are in a second question room." "Question room 2") ("You are in a north/south hallway." "Endgame n/s hallway") ("You are in a third question room." "Question room 3") ("You are in the endgame treasure room. A door leads out to the north, and\na hallway leads to the south." "Endgame treasure room") ("You are in the winner's room. A door leads back to the south." "Winner's room") ("You have reached a dead end. There is a PC on the floor here. Above\nit is a sign that reads:\n Type the 'reset' command to type on the PC. \nA hole leads north." "PC area")) dun-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) dun-light-rooms ((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)) dun-verblist dun-inbus dun-nomail (the to at) dun-ignore moby dun-mode dun-sauna-level north south east 3 west 4 northeast 5 southeast 6 northwest 7 southwest 8 up 9 down 10 in 11 out ((96 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 2 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 3 1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 -1 2 4 6 -1 -1 -1 -1 -1 -1) (-1 -1 -1 -1 5 -1 -1 3 -1 -1 -1 -1) (-1 -1 -1 -1 255 -1 -1 4 -1 -1 255 -1) (-1 -1 -1 -1 -1 7 3 -1 -1 -1 -1 -1) (-1 -1 -1 -1 -1 255 6 27 -1 -1 -1 -1) (255 5 9 10 -1 -1 -1 5 -1 -1 -1 5) (-1 -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 8 -1 58 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 -1) (15 -1 14 12 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1) (-1 13 16 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 -1 15 -1 -1 -1 -1 -1 17 16 -1) (-1 -1 17 17 17 17 255 17 255 17 -1 -1) (18 18 18 18 18 -1 18 18 19 18 -1 -1) (-1 18 18 19 19 20 19 19 -1 18 -1 -1) (-1 -1 -1 18 -1 -1 -1 -1 -1 21 -1 -1) (-1 -1 -1 -1 -1 20 22 -1 -1 -1 -1 -1) (18 18 18 18 16 18 23 18 18 18 18 18) (-1 255 -1 -1 -1 19 -1 -1 -1 -1 -1 -1) (23 25 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (24 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1) (255 28 -1 -1 -1 -1 -1 -1 -1 -1 255 -1) (-1 -1 -1 -1 7 -1 -1 -1 -1 -1 -1 -1) (26 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1) (-1 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 31 29 -1 -1 -1 -1 -1 -1 -1 -1) (32 33 -1 30 -1 -1 -1 -1 -1 -1 -1 -1) (-1 31 -1 255 -1 -1 -1 -1 -1 34 -1 -1) (31 -1 -1 -1 -1 -1 -1 -1 -1 35 -1 -1) (-1 35 -1 -1 -1 -1 -1 -1 32 37 -1 -1) (34 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 -1 -1 -1 -1 -1 38 34 -1 -1 -1) (-1 -1 40 41 37 -1 -1 39 -1 -1 -1 -1) (-1 -1 -1 -1 38 -1 -1 -1 -1 -1 -1 -1) (-1 -1 -1 38 -1 -1 -1 -1 42 -1 -1 -1) (-1 -1 38 -1 -1 -1 -1 -1 -1 43 -1 -1) (-1 -1 -1 -1 -1 -1 -1 -1 -1 40 -1 -1) (44 -1 46 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 43 45 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 46 -1 44 -1 -1 -1 -1 -1 -1 -1 -1) (45 -1 -1 43 -1 -1 -1 -1 -1 255 -1 -1) (48 50 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (49 47 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 48 -1 -1 -1 -1 -1 -1 52 -1 -1 -1) (47 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (50 104 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 -1 -1 -1 -1 -1 -1 53 49 -1 -1) (-1 -1 -1 -1 -1 -1 -1 -1 54 52 -1 -1) (-1 -1 -1 -1 55 -1 -1 -1 -1 53 -1 -1) (-1 -1 -1 -1 56 -1 -1 54 -1 -1 -1 54) (-1 -1 -1 -1 -1 -1 -1 55 -1 31 -1 -1) (-1 -1 32 -1 -1 -1 -1 -1 -1 -1 -1 -1) (59 -1 11 -1 -1 -1 -1 -1 -1 -1 255 255) (60 58 63 -1 -1 -1 255 -1 -1 -1 255 255) (61 59 64 -1 -1 -1 -1 -1 -1 -1 255 255) (62 60 65 -1 -1 -1 -1 -1 -1 -1 255 255) (-1 61 66 -1 -1 -1 -1 -1 -1 -1 255 255) (64 -1 67 59 -1 -1 -1 -1 -1 -1 255 255) (65 63 68 60 -1 -1 -1 -1 -1 -1 255 255) (66 64 69 61 -1 -1 -1 -1 -1 -1 255 255) (-1 65 70 62 -1 -1 -1 -1 -1 -1 255 255) (68 -1 71 63 -1 -1 -1 -1 -1 -1 255 255) (69 67 72 64 -1 -1 -1 -1 -1 -1 255 255) (70 68 73 65 -1 -1 -1 -1 -1 -1 255 255) (-1 69 74 66 -1 -1 -1 -1 -1 -1 255 255) (72 -1 75 67 -1 -1 -1 -1 -1 -1 255 255) (73 71 76 68 -1 -1 -1 -1 -1 -1 255 255) (74 72 77 69 -1 -1 -1 -1 -1 -1 255 255) (-1 73 78 70 -1 -1 -1 -1 -1 -1 255 255) (76 -1 79 71 -1 -1 -1 -1 -1 -1 255 255) (77 75 80 72 -1 -1 -1 -1 -1 -1 255 255) (78 76 81 73 -1 -1 -1 -1 -1 -1 255 255) (-1 77 82 74 -1 -1 -1 -1 -1 -1 255 255) (80 -1 -1 75 -1 -1 -1 -1 -1 -1 255 255) (81 79 255 76 -1 -1 -1 -1 -1 -1 255 255) (82 80 -1 77 -1 -1 -1 -1 -1 -1 255 255) (-1 81 -1 78 -1 -1 -1 -1 -1 -1 255 255) (84 -1 -1 -1 -1 59 -1 -1 -1 -1 255 255) (-1 83 85 -1 -1 -1 -1 -1 -1 -1 -1 -1) (86 -1 87 84 -1 -1 -1 -1 -1 -1 -1 -1) (-1 85 88 -1 -1 -1 -1 -1 -1 -1 -1 -1) (88 -1 -1 85 -1 -1 -1 -1 -1 -1 -1 -1) (-1 87 255 86 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 255 -1) (91 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (92 90 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 91 -1 -1 -1 -1 -1 -1 93 94 -1 -1) (-1 -1 -1 88 -1 -1 -1 -1 -1 92 -1 -1) (-1 -1 -1 -1 95 -1 -1 -1 92 -1 -1 -1) (-1 -1 -1 -1 -1 -1 -1 94 -1 -1 -1 -1) (97 0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (99 97 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (101 99 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (103 101 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (-1 102 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) (51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1)) dungeon-map ((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) (palm . -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)) dun-objnames x --dolist-temp--14513 name "obj-" prin1-to-string eval defconst intern 255 obj-special obj-shovel obj-boulder obj-food obj-bear obj-lamp obj-license obj-silver obj-weight obj-life obj-rms obj-floppy obj-emerald obj-gold obj-towel obj-box obj-axe obj-coins obj-bus obj-bone obj-jar obj-ruby obj-nitric obj-glycerine obj-amethyst obj-mona dun-room-objects obj-tree obj-bin obj-computer obj-dial obj-ladder obj-button obj-chute obj-painting obj-bed obj-urinal obj-pipes obj-cable obj-mail obj-gate obj-cliff obj-dinosaur obj-fish obj-tanks obj-switch obj-blackboard obj-train obj-disposal obj-pc dun-room-silents (1) dun-inventory (("There is a shovel here." "A shovel") ("There is a lamp nearby." "A lamp") ("There is a CPU card here." "A computer board") ("There is some food here." "Some food") ("There is a shiny brass key here." "A brass key") ("There is a slip of paper here." "A slip of paper") ("There is a wax statuette of Richard Stallman here." "An RMS statuette") ("There is a shimmering diamond here." "A diamond") ("There is a 10 pound weight here." "A weight") ("There is a life preserver here." "A life preserver") ("There is an emerald bracelet here." "A bracelet") ("There is a gold bar here." "A gold bar") ("There is a platinum bar here." "A platinum bar") ("There is a beach towel on the ground here." "A beach towel") ("There is an axe here." "An axe") ("There is a silver bar here." "A silver bar") ("There is a bus driver's license here." "A license") ("There are some valuable coins here." "Some valuable coins") ("There is a jewel-encrusted egg here." "A valuable egg") ("There is a glass jar here." "A glass jar") ("There is a dinosaur bone here." "A bone") ("There is a packet of nitric acid here." "Some nitric acid") ("There is a packet of glycerine here." "Some glycerine") ("There is a valuable ruby here." "A ruby") ("There is a valuable amethyst here." "An amethyst") ("The Mona Lisa is here." "The Mona Lisa") ("There is a 100 dollar bill here." "A $100 bill") ("There is a floppy disk here." "A floppy disk")) dun-objects (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) dun-object-lbs (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) dun-object-pts ("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") dun-objfiles (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) dun-perm-objects ("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\n2 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\nthis word: 'worms'" "The statuette is of the likeness of Richard Stallman, the author of the\nfamous 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) dun-physobj-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\nare names written at the bottom of each bin, but most of them are\nfaded away so that you cannot read them. You can only make out three\nnames:\n Jeffrey Collier\n Robert Toukmond\n Thomas Stock\n" 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\nwall, 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\nisn't even any rust. Upon close examination you realize that the drain at the\nbottom is missing, and there is just a large hole leading down the\npipes into nowhere. The hole is too small for a person to fit in. The \nflush 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\nwritten: '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\nit. 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.") dun-permobj-desc obj-cpu obj-platinum dun-diggables scroll-step dun-room-shorts --dolist-temp--14514 append dun-space-to-hyphen (("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\ntreasures 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")) dun-endgame-questions a --dolist-temp--14515] 161) (defalias 'dun-unix-parse #[(args) "ÀyˆÁ‰`Ä\\Áˆ `U„W ÄZ ÅZ{ƘƒW `{—È!ˆÉÁ\n#Ë=ƒ^ÌÍ\"‰ƒJÎ\n\"ˆ‚^Ï@!ˆÑÒ!ˆ‚^dbˆÏÓ!ˆÕ=…kÖ ˆÏ×!*‡" [0 nil esign beg 2 1 "$" line princ dun-parse2 dun-unix-verbs -1 string-match "=" dun-doassign dun-mprinc line-list dun-mprincl ": not found." "\n" dungeon-mode unix dun-fix-screen "$ "] 4 nil "*p"]) (defalias 'dun-doassign #[(line esign) "„,ÁÃÄ!ˆÅ „ÃÇ!ˆ\nȘƒ'ÉÊ \f\"‚*ÍÎ!)‡Á‰‰‰‰ Ô\fOÕÖ \"‰„‰ \fT\f×\\Oؘƒv \f×\\ÁOÕØ\"\fÙ\\\\‚²ÕÚ \"‰„² G‚²T‰ GU„²ÕÖ ÁO\"‰ƒ²Û\\\\‰‚ \fTOÜ\"-‡" [dun-wizard nil passwd dun-mprinc "Enter wizard password: " dun-read-line dun-batch-mode "\n" "moby" t dun-doassign line esign dun-mprincl "Incorrect." value i afterq epoint varname 0 string-match ")" 2 "\"" 3 " " 1 dun-eval] 6]) (defalias 'dun-eval #[(varname value) "ÀÂÃÄ!!ˆÅ ˆÆcˆcˆÈcˆ cˆÊcˆÀÀË̈Íp!ˆÂÎ!ˆ …2ÏÐ!)‡" [nil eval-error switch-to-buffer get-buffer-create "*dungeon-eval*" erase-buffer "(setq " varname " " value ")" (eval-current-buffer) ((error (byte-code "ÀÀ‡" [t eval-error] 1))) kill-buffer "*dungeon*" dun-mprincl "Invalid syntax."] 3]) (defalias 'dun-unix-interface #[nil "À ˆ …ÂÄ ÆÇ#ˆÈÉ!‡" [dun-login dun-logged-in unix dungeon-mode define-key dungeon-mode-map " " dun-unix-parse dun-mprinc "$ "] 4]) (defalias 'dun-login #[nil "À‰‰Ä „R ÆZ‰ÇVƒRÈÉ!ˆÊ  „&ÈÌ!ˆÈÍ!ˆÊ  „6ÈÌ!ˆ\nΘƒB Ϙ„IÐÑ!ˆ‚ÒÐÓ!ˆ‚Ô‰+‡" [nil password username tries 4 dun-logged-in 1 0 dun-mprinc "\n\nUNIX System V, Release 2.2 (pokey)\n\nlogin: " dun-read-line dun-batch-mode "\n" "password: " "toukmond" "robert" dun-mprincl "login incorrect" t "\nWelcome to Unix\n\nPlease clean up your directories. The filesystem is getting full.\nOur tcp/ip link to gamma is a little flakey, but seems to work.\nThe current version of ftp can only send files from the current\ndirectory, and deletes them after they are sent! Be careful.\n\nNote: Restricted bourne shell in use.\n" dungeon dungeon-mode] 3]) (defalias 'dun-ls #[(args) "@ƒ Á‰\f Æ!Ç=„ÈÁ!ˆ \n‰*‡ ÉUƒ)Ê ˆ ÇUƒ2Ë ˆ ÌUƒ;Í ˆ ÎUƒDÏ ˆ ÐV…LÑ ‡" [args nil ocdroom ocdpath dun-cdpath dun-cdroom dun-cd -2 dun-ls -10 dun-ls-inven dun-ls-rooms -3 dun-ls-root -4 dun-ls-usr 0 dun-ls-room] 2]) (defalias 'dun-ls-root #[nil "ÀÁ!‡" [dun-mprincl "total 4\ndrwxr-xr-x 3 root staff 512 Jan 1 1970 .\ndrwxr-xr-x 3 root staff 2048 Jan 1 1970 ..\ndrwxr-xr-x 3 root staff 2048 Jan 1 1970 usr\ndrwxr-xr-x 3 root staff 2048 Jan 1 1970 rooms"] 2]) (defalias 'dun-ls-usr #[nil "ÀÁ!‡" [dun-mprincl "total 4\ndrwxr-xr-x 3 root staff 512 Jan 1 1970 .\ndrwxr-xr-x 3 root staff 2048 Jan 1 1970 ..\ndrwxr-xr-x 3 toukmond restricted 512 Jan 1 1970 toukmond"] 2]) (defalias 'dun-ls-rooms #[nil "ÀÁ!ˆ\nɃ! @ÆÇ!ˆÀ\f8!ˆ A‰„\f*Ç" [dun-mprincl "total 16\ndrwxr-xr-x 3 root staff 512 Jan 1 1970 .\ndrwxr-xr-x 3 root staff 2048 Jan 1 1970 .." dun-visited nil x --dolist-temp--14516 dun-mprinc "drwxr-xr-x 3 root staff 512 Jan 1 1970 " dun-room-shorts] 4]) (defalias 'dun-ls-room #[nil "ÀÁ!ˆ\n 8ĉƒ3@‰ÇYƒ* ÈU„*ÉÊ!ˆÀ  8!ˆA‰„*ć" [dun-mprincl "total 4\ndrwxr-xr-x 3 root staff 512 Jan 1 1970 .\ndrwxr-xr-x 3 root staff 2048 Jan 1 1970 ..\n-rwxr-xr-x 3 root staff 2048 Jan 1 1970 description" dun-cdroom dun-room-objects nil x --dolist-temp--14517 0 255 dun-mprinc "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 " dun-objfiles] 4]) (defalias 'dun-ls-inven #[nil "ÀÁ!ˆ\nɃ& @‰@Æ=„ÀÇ!ˆÀ\f@!ˆ A‰„\f*ÀÈ!ˆ „4ÊË!ˆ\fÉ ƒV @ÀÎ!ˆÊ\f8!ˆ A‰ „>*Ç" [dun-mprinc "total 467\ndrwxr-xr-x 3 toukmond restricted 512 Jan 1 1970 .\ndrwxr-xr-x 3 root staff 2048 Jan 1 1970 .." dun-unix-verbs nil x --dolist-temp--14518 IMPOSSIBLE "\n-rwxr-xr-x 1 toukmond restricted 10423 Jan 1 1970 " "\n" dun-uncompressed dun-mprincl "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 paper.o.Z" dun-inventory --dolist-temp--14519 "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 " dun-objfiles] 4]) (defalias 'dun-echo #[(args) "À‰À À‰ƒb @\n„[\fÆÇOȘ„)É\f!ˆÉÊ!ˆ‚[Ë\fÇÀO!Ì !„=ÉÊ!ˆ‚[  ƒQÉ !ˆÉÎ!ˆÏ‚[ÐÉ D!ˆÉÊ!ˆ A‰„*ÉÑ!*‡" [nil var nomore args x --dolist-temp--14520 0 1 "$" dun-mprinc " " intern boundp dun-restricted ": Permission denied" t eval "\n"] 5]) (defalias 'dun-ftp #[(args) "À‰‰‰‰@„ÇÈ!‚ÌÉ@!‰Ê„(ÇË!‚Ì Ì=ƒ4ÇÍ!‚Ì„?ÇÏ!‚ÌÇÐ!ˆÑÒ!ˆÓ ‰Ô˜ƒaƒ[ÇÖ!‚ÌÇ×!‚Ì\fؘƒzƒsÇÙ!ˆ‚ŽÇÚ!ˆ‚Žƒ†ÑÛ!ˆ‚ŠÑÜ!ˆÇ\f!ˆÑÝ!ˆÓ \fؘ„¬ƒ¦ÇÞ!‚ÌÇß!‚̃¸Çà!ˆ‚¼Çá!ˆâ ˆãä \nC\"%A  -‡" [nil newlist ident passwd username host args dun-mprincl "ftp: hostname required on command line." intern (gamma dun-endgame) "ftp: Unknown host." dun-endgame "ftp: connection to endgame not allowed" dun-ethernet "ftp: host not responding." "Connected to gamma. FTP ver 0.9 00:00:00 01/01/70" dun-mprinc "Username: " dun-read-line "toukmond" dun-batch-mode "toukmond ftp access not allowed." "\ntoukmond ftp access not allowed." "anonymous" "Guest login okay, send your user ident as password." "\nGuest login okay, send your user ident as password." "Password required for " "\nPassword required for " "Password: " "Login failed." "\nLogin failed." "Guest login okay, user access restrictions apply." "\nGuest login okay, user access restrictions apply." dun-ftp-commands ("What password did you use during anonymous ftp to gamma?") append dun-endgame-questions] 6]) (defalias 'dun-ftp-commands #[nil "ÀÀ „ ÃÄ!ˆÅ ÆÀÇ\n#È=ƒÉÊ!ˆ‚ˉ\f)‡" [nil dun-exitf line dun-mprinc "ftp> " dun-read-line dun-parse2 ((type . dun-ftptype) (binary . dun-bin) (bin . dun-bin) (send . dun-send) (put . dun-send) (quit . dun-ftpquit) (help . dun-ftphelp) (ascii . dun-fascii)) -1 dun-mprincl "No such command. Try help." ascii dun-ftptype] 4]) (defalias 'dun-ftptype #[(args) "@„ ÁÂ!‡Ã@!‰Ä=ƒÅÆ!‡Ç=ƒ\"ÈÆ!‡ÁÉ!‡" [args dun-mprincl "Usage: type [binary | ascii]" intern binary dun-bin nil ascii dun-fascii "Unknown type."] 3]) (defalias 'dun-bin #[(args) "ÀÁ!ˆÂ‰‡" [dun-mprincl "Type set to binary." binary dun-ftptype] 2]) (defalias 'dun-fascii #[(args) "ÀÁ!ˆÂ‰‡" [dun-mprincl "Type set to ascii." ascii dun-ftptype] 2]) (defalias 'dun-ftpquit #[(args) "À‰‡" [t dun-exitf] 2]) (defalias 'dun-send #[(args) "@„ ÁÂ!‡@ÉÃÆÇ!žƒ=Ç!žÉ ˆÊË!ˆÊ\f!ˆÊÍ!ˆÁ!ˆÁÎ!‚ÙɃÐ@˜ƒÃ „dÁÓ!ˆÔ‚ÃÊË!ˆÊ\f!ˆÊÍ!ˆÊ 8A@—!ˆÁÖ!ˆ\f×=„©8„¢ÛÜ8C\"#ˆÝ !ˆ‚½Ý !ˆÛÜ8 C\"#ˆÔÁÎ!ˆ Þ\\A‰„H*\f?…ÙÁÓ!*‡" [args dun-mprincl "Usage: send " nil foo counter 0 intern dun-unix-verbs IMPOSSIBLE dun-mprinc "Sending " dun-ftptype " file for " "Transfer complete." dun-objfiles x --dolist-temp--14521 dun-inventory "No such file." t dun-objects ", (0 bytes)" binary obj-protoplasm receiving-room dun-room-objects dun-replace append dun-remove-obj-from-inven 1] 7]) (defalias 'dun-ftphelp #[(args) "ÀÁ!‡" [dun-mprincl "Possible commands are:\nsend quit type ascii binary help"] 2]) (defalias 'dun-uexit #[(args) "ÀÂÃ!ˆÄ ÆÇ#ˆ?…É ‡" [dungeon dungeon-mode dun-mprincl "\nYou step back from the console." define-key dungeon-mode-map " " dun-parse dun-batch-mode dun-messages] 4]) (defalias 'dun-pwd #[(args) "À !‡" [dun-mprincl dun-cdpath] 2]) (defalias 'dun-uncompress #[(args) "@„ ÁÂ!‡@ „Ę„ Ř„ ÁÆ!‡ÇÈ \nC\"‰ ‡" [args dun-mprincl "Usage: uncompress " dun-uncompressed "paper.o" "paper.o.z" "Uncompress command failed." t append dun-inventory obj-paper] 3]) (defalias 'dun-rlogin #[(args) "À\n@„ ÃÄ!‚c\n@‰ŘƒÆ ‚c\nǘ„'ÃÈ!‚c „2ÃÊ!‚cËÌ!ˆÍ ‰Θ„EÃÏ!‚cËÐ!ˆÑÔ8\"#ˆÀØÀ!)‡" [nil passwd args dun-mprincl "Usage: rlogin " "endgame" dun-rlogin-endgame "gamma" "No such host." dun-ethernet "Host not responding." dun-mprinc "Password: " dun-read-line "worms" "\nlogin incorrect" "\nYou begin to feel strange for a moment, and you lose your items." dun-replace dun-room-objects computer-room append dun-inventory receiving-room dun-current-room dun-uexit] 7]) (defalias 'dun-cd #[(args) "À‰‰‰ @„ÆÇ!‚5 À\nÀË̈ À‰ƒ$@\n„И„јƒw ÒVƒQÓÔ‚ ÔU„c ÕU„c ÖUƒj×Ö‚ ØUƒÙÕ‚טƒ…×Ö‚ ÕUƒŸÚ˜ƒ™ÛØ‚Ü ˆ‚ ØUƒ«Ü ˆ‚ ÒVƒ·Ü ˆ‚ ÖUƒßݘƒËÓÔ‚Þ˜ƒÙÙÕ‚Ü ˆ‚ ÔUƒÀ ‰!ƒ!@‰ \"8‰˜ƒã P !A‰!„ð* ÔUƒÜ ˆA‰„,*\n„4\f  Ò‚5Ô,‡" [nil room-check path-elemants tcdroom tcdpath args dun-mprincl "Usage: cd " dun-cdpath dun-cdroom dun-badcd (byte-code "À @Â\"‡" [dun-get-path args nil path-elements] 3) ((error (byte-code "ÀÁ!ˆÂÀ‡" [dun-mprincl "Invalid path." t dun-badcd] 2))) path-elements pe --dolist-temp--14522 "." ".." 0 "/rooms" -2 -4 -3 "/" -10 "/usr" "toukmond" "/usr/toukmond" dun-nosuchdir "rooms" "usr" dun-visited x --dolist-temp--14523 dun-room-shorts "/rooms/"] 4]) (defalias 'dun-nosuchdir #[nil "ÀÁ!ˆÂ‰‡" [dun-mprincl "No such directory." t dun-badcd] 2]) (defalias 'dun-cat #[(args) "À‰ @‰„ÄÅ!‚ÆÇ \"ƒÄÈ!‚ ÊVƒ6 ˘ƒ6Ä \f8@!‚ÆÍ \"‰ƒm ÎUƒL‚R 8Ñ Ê\nO!žA „gÄÓ!‚ÄÔ!‚Ñ !žƒ|ÄÔ!‚ÄÓ!*‡" [nil checklist doto args dun-mprincl "Usage: cat " string-match "/" "cat: only files in current directory allowed." dun-cdroom 0 "description" dun-rooms "\\.o" -10 dun-inventory dun-room-objects intern dun-objnames "File not found." "Ascii files only." dun-unix-verbs] 4]) (defalias 'dun-zippy #[(args) "ÀÁ !‡" [dun-mprincl yow] 2]) (defalias 'dun-rlogin-endgame #[nil "ÀÁ!ÂU„\fÃÄ!‡ÃÅ!ˆÈ Ê \f C#ˆÎÁ!‡" [dun-score nil 90 dun-mprincl "You have not achieved enough points to connect to endgame." "\nWelcome to the endgame. You are a truly noble adventurer." treasure-room dun-current-room t dun-endgame dun-replace dun-room-objects endgame-treasure-room obj-bill dun-uexit] 4]) (byte-code "ÀÁ!ˆÀÂ!Ã\\Å\fÇ\f8ÂC\"#ˆÀÈ!É\\\nË\n!\fÀ‡" [random t 18 60 tloc dun-replace dun-room-objects append 899 100 tcomb prin1-to-string dun-combination] 6) (defalias 'dun-dos-parse #[(args) "ÀyˆÁ`Ã\\Áˆ\n`U„4Á\n`{—Å\f!ˆÆÁ\f#È=ƒ0ÉÊ!ˆËÌ!ˆ)‚;dbˆÍÎ!ˆÐ=…GÑ ˆÒ )‡" [0 nil beg 3 line princ dun-parse2 dun-dos-verbs -1 sleep-for 1 dun-mprincl "Bad command or file name" dun-mprinc "\n" dungeon-mode dos dun-fix-screen dun-dos-prompt] 4 nil "*p"]) (defalias 'dun-dos-interface #[nil "À ˆÁÃ\fÅÆ#ˆÇ ‡" [dun-dos-boot-msg dos dungeon-mode define-key dungeon-mode-map " " dun-dos-parse dun-dos-prompt] 4]) (defalias 'dun-dos-type #[(args) "ÀÁ!ˆ\n@‰ƒ'\n؃Ä ‡\nŘƒÆÇ!‡ÈÉ!ˆÆ\n–!‡ÆÊ!‡" [sleep-for 2 args "foo.txt" dun-dos-show-combination "command.com" dun-mprincl "Cannot type binary files" dun-mprinc "File not found - " "Must supply file name"] 2]) (defalias 'dun-dos-invd #[(args) "ÀÁ!ˆÂÃ!‡" [sleep-for 1 dun-mprincl "Invalid drive specification"] 2]) (defalias 'dun-dos-dir #[(args) "ÀÁ!ˆ\n@‰ƒ\n؃ÄÅ!‡ÄÆ!‡" [sleep-for 1 args "\\" dun-mprincl "\n Volume in drive A is FOO \n Volume Serial Number is 1A16-08C9\n Directory of A:\\\n\nCOMMAND COM 47845 04-09-91 2:00a\nFOO TXT 40 01-20-93 1:01a\n 2 file(s) 47845 bytes\n 1065280 bytes free\n" "\n Volume in drive A is FOO \n Volume Serial Number is 1A16-08C9\n Directory of A:\\\n\nFile not found"] 2]) (defalias 'dun-dos-prompt #[nil "ÀÁ!‡" [dun-mprinc "A> "] 2]) (defalias 'dun-dos-boot-msg #[nil "ÀÁ!ˆÂÃ!ˆÄÅ ÆÇO!ˆÂÈ!ˆÉ ˆ\n?… ÂË!‡" [sleep-for 3 dun-mprinc "Current time is " dun-mprincl current-time-string 12 20 "Enter new time: " dun-read-line dun-batch-mode "\n"] 4]) (defalias 'dun-dos-spawn #[(args) "ÀÁ!ˆÂÃ!‡" [sleep-for 1 dun-mprincl "Cannot spawn subshell"] 2]) (defalias 'dun-dos-exit #[(args) "ÀÂÃ!ˆÄ ÆÇ#ˆ?…É ‡" [dungeon dungeon-mode dun-mprincl "\nYou power down the machine and step back." define-key dungeon-mode-map " " dun-parse dun-batch-mode dun-messages] 4]) (defalias 'dun-dos-no-disk #[nil "ÀÁ!ˆÂÃ!‡" [sleep-for 3 dun-mprincl "Boot sector not found"] 2]) (defalias 'dun-dos-show-combination #[nil "ÀÁ!ˆÂÃ!ˆÂ\f!ˆÂÅ!‡" [sleep-for 2 dun-mprinc "\nThe combination is " dun-combination ".\n"] 2]) (defalias 'dun-dos-nil #[(args) "À‡" [nil] 1]) (defalias 'dun-save-game #[(filename) "@‰„ ÁÂ!‡Ã!ƒÄ!ˆ TÆ ˆÇÈ!ˆÇÉ!ˆÇÊ!ˆÇË!ˆÇÌ!ˆÇÍ!ˆÇÎ!ˆÇÏ!ˆÇÐ!ˆÇÑ!ˆÇÒ!ˆÇÓ!ˆÇÔ!ˆÇÕ!ˆÇÖ!ˆÇ×!ˆÇØ!ˆÇÙ!ˆÇÚ!ˆÇÛ!ˆÇÜ!ˆÇÝ!ˆÇÞ!ˆÇß!ˆÇà!ˆÇá!ˆÇâ!ˆÇã!ˆÇä!ˆå!ƒ™Áæ!‡çèé\"ˆêë!ˆìí!ˆÁî!‡" [filename dun-mprincl "You must supply a filename for the save." file-exists-p delete-file dun-numsaves dun-make-save-buffer dun-save-val "dun-current-room" "dun-computer" "dun-combination" "dun-visited" "dun-diggables" "dun-key-level" "dun-floppy" "dun-numsaves" "dun-numcmds" "dun-logged-in" "dungeon-mode" "dun-jar" "dun-lastdir" "dun-black" "dun-nomail" "dun-unix-verbs" "dun-hole" "dun-uncompressed" "dun-ethernet" "dun-sauna-level" "dun-room-objects" "dun-room-silents" "dun-inventory" "dun-endgame-questions" "dun-endgame" "dun-cdroom" "dun-cdpath" "dun-correct-answer" "dun-inbus" dun-compile-save-out "Error saving to file." dun-do-logfile save nil switch-to-buffer "*dungeon*" princ "" "Done."] 3]) (defalias 'dun-make-save-buffer #[nil "ÀÁÂ!!ˆÃ ‡" [switch-to-buffer get-buffer-create "*save-dungeon*" erase-buffer] 3]) (defalias 'dun-compile-save-out #[(filename) "ÀÀÀÂÈ „ebˆÀÄňÆp!ˆ )‡" [nil ferror (dun-rot13) ((error (byte-code "ÀÀ‡" [t ferror] 1))) (byte-code "ÀÁd\nÃÁ%‡" [write-region 1 filename nil] 6) ((error (byte-code "ÀÀ‡" [t ferror] 1))) kill-buffer] 3]) (defalias 'dun-save-val #[(varname) "À !Ä !ÅÆ!ˆÅ !ˆÅÇ!ˆ <„ 9ƒ$ÅÈ!ˆ ;ƒ-ÅÉ!ˆÅ !ˆ ;ƒ:ÅÉ!ˆÊË!)‡" [nil value intern varname eval dun-minsert "(setq " " " "'" "\"" dun-minsertl ")"] 2]) (defalias 'dun-restore #[(args) "À\n@‰„ÃÄ!‚#Å !„ÃÆ!‚#ÃÇ!ˆÈ‰ )‡" [nil file args dun-mprincl "You must supply a filename." dun-load-d "Could not load restore file." "Done." 0 room] 2]) (defalias 'dun-do-logfile #[(type how) "À‰ÀÃÄÅ!!ˆÆ ˆÀÇȈ\n„¯dbˆÉÊ !ˆÉË!ˆÉÌ !ˆÉË!ˆ Î=ƒ;ÉÏ!ˆ‚bÐ ÑUƒIÉÒ!ˆ‚b„UÉÔ!ˆ‚bÉÕ!ˆÉ!ˆÉË!ˆÉÖ!ˆÉ×!8A@!ˆÉÚ!ˆÐ ÛVƒ‰ÉÐ Ü\\‰!ˆ‚ÉÝ ‰!ˆÉÞ!ˆÉ!ˆÉà!ˆÉ!!ˆÉâ!ˆãäd%Àä%ˆæp!*‡" [nil newscore ferror switch-to-buffer get-buffer-create "*score*" erase-buffer (insert-file-contents dun-log-file) ((error (byte-code "ÀÀ‡" [t ferror] 1))) dun-minsert current-time-string " " user-login-name type save "saved " dun-endgame-score 110 "won " how "quit " "killed by " "at " abs room dun-rooms ". score: " 0 90 dun-reg-score " saves: " dun-numsaves " commands: " dun-numcmds "\n" write-region 1 dun-log-file kill-buffer] 6]) (defalias 'dun-batch-mprinc #[(arg) ";ƒ Á!‡ÁÂ!!‡" [arg send-string-to-terminal prin1-to-string] 3]) (defalias 'dun-batch-mprincl #[(arg) ";ƒ Á!ˆÁÂ!‡ÁÃ!!ˆÁÂ!‡" [arg send-string-to-terminal "\n" prin1-to-string] 3]) (defalias 'dun-batch-parse #[(dun-ignore dun-verblist line) "À ÂP!Ä  @ A$‡" [dun-listify-string line " " line-list dun-doverb dun-ignore dun-verblist] 5]) (defalias 'dun-batch-parse2 #[(dun-ignore dun-verblist line) "À ÂP!Ä  @ A$‡" [dun-listify-string2 line " " line-list dun-doverb dun-ignore dun-verblist] 5]) (defalias 'dun-batch-read-line #[nil "ÀÁ #‡" [read-from-minibuffer "" nil dungeon-batch-map] 4]) (defalias 'dun-batch-loop #[nil "À ?…;\fÅ=ƒ U„Ç!ˆÈÉ!ˆÊ — Ì  #Ï=ƒÈÐ!ˆ‚‡" [nil dun-dead 0 room dungeon-mode dungeon dun-current-room dun-describe-room dun-mprinc ">" dun-read-line line dun-vparse dun-ignore dun-verblist -1 "I don't understand that.\n"] 4]) (defalias 'dun-batch-dos-interface #[nil "À ˆÁ\nÁ=ƒ(à ˆÄ —ÆÇ #É=ƒÊË!ˆÌÍ!ˆ‚dbˆÎÏ!‡" [dun-dos-boot-msg dos dungeon-mode dun-dos-prompt dun-read-line line dun-parse2 nil dun-dos-verbs -1 sleep-for 1 dun-mprincl "Bad command or file name" dun-mprinc "\n"] 4]) (defalias 'dun-batch-unix-interface #[nil "À ˆ …P Â=ƒJÄÅ!ˆÆ —ÈÉ\n#Ë=ƒ É\fÍÎ\"‰\fƒ<Ï\f\"ˆ‚FÄ@!ˆÑÒ!ˆ)‚ dbˆÄÓ!‡" [dun-login dun-logged-in unix dungeon-mode dun-mprinc "$ " dun-read-line line dun-parse2 nil dun-unix-verbs -1 esign string-match "=" dun-doassign line-list dun-mprincl ": not found." "\n"] 4]) #@6 noop (defalias 'dungeon-nil #[(arg) "À‡" [nil] 1 (#$ . 73385) "*p"]) (defalias 'dun-batch-dungeon #[nil "ÀÁ!ˆÂÄÅ!ˆÆ ‡" [load "dun-batch" (27) dun-visited dun-mprinc "\n" dun-batch-loop] 2]) (byte-code "ƒ*ÁÂMˆÃÄMˆÅÆMˆÇÈMˆÉÊMˆËÌMˆÍÎMˆÁÏ!ˆÐÒ ˆÁ‡" [noninteractive dun-mprinc dun-batch-mprinc dun-mprincl dun-batch-mprincl dun-vparse dun-batch-parse dun-parse2 dun-batch-parse2 dun-read-line dun-batch-read-line dun-dos-interface dun-batch-dos-interface dun-unix-interface dun-batch-unix-interface "\n" t dun-batch-mode dun-batch-loop] 2) emacs-19.30/lisp/easymenu.elc100666 12241 1 11166 5757267706 15124 0ustar rolanddaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Sat May 20 00:27:49 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/easymenu.el ;;; emacs version 19.28.92.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/easymenu.el' was compiled for Emacs 19")) #@1981 Define a menu bar submenu in maps MAPS, according to MENU. The menu keymap is stored in symbol SYMBOL, both as its value and as its function definition. DOC is used as the doc string for SYMBOL. The first element of MENU must be a string. It is the menu bar item name. The rest of the elements are menu items. A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE] NAME is a string--the menu item name. CALLBACK is a command to run when the item is chosen, or a list to evaluate when the item is chosen. ENABLE is an expression; the item is enabled for selection whenever this expression's value is non-nil. Alternatively, a menu item may have the form: [ NAME CALLBACK [ KEYWORD ARG ] ... ] Where KEYWORD is one of the symbol defined below. :keys KEYS KEYS is a string; a complex keyboard equivalent to this menu item. This is normally not needed because keyboard equivalents are usually computed automatically. :active ENABLE ENABLE is an expression; the item is enabled for selection whenever this expression's value is non-nil. :suffix NAME NAME is a string; the name of an argument to CALLBACK. :style STYLE is a symbol describing the type of menu item. The following are defined: toggle: A checkbox. Currently just prepend the name with the string "Toggle ". radio: A radio button. nil: An ordinary menu item. :selected SELECTED SELECTED is an expression; the checkbox or radio button is selected whenever this expression's value is non-nil. Currently just disable radio buttons, no effect on checkboxes. A menu item can be a string. Then that string appears in the menu as unselectable text. A string consisting solely of hyphens is displayed as a solid horizontal line. A menu item can be a list. It is treated as a submenu. The first element should be the submenu name. That's used as the menu item in the top-level menu. The cdr of the submenu list is a list of menu items, as above. (defalias 'easy-menu-define '(macro . #[(symbol maps doc menu) "ÀÁ\nÃ\fFÅÆ\nD\f¯E‡" [progn defvar symbol nil doc easy-menu-do-define quote maps menu] 7 (#$ . 486)])) (defalias 'easy-menu-do-define #[(symbol maps doc menu) "Á\n@\nA\"LˆÃÄ ÆÇÈE¯MˆÉÊË\f!ƒ%\fC‚'\f\"‡" [symbol easy-menu-create-keymaps menu lambda (event) doc (interactive "@e") easy-popup-menu event mapcar #[(map) "À ÂÃÄ @!\" @JB#‡" [define-key map vector menu-bar intern menu symbol] 6] keymapp maps] 8]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp easy-menu-item-count 0 current-load-list] 2) (defalias 'easy-menu-create-keymaps #[(menu-name menu-items) "À !Ã\f!‰ƒ˜\f@Æ !… ÇHÉ\nÉ É\f ;ƒ<É\nÍÎ \"ƒ6Ï‚7 \f‚j :ƒPÐ @ A\"\n @\f‚jÆ !ƒjÑÒÓ\"!\nT ÕH\f ÖH‰9ƒ;Ø!ÕHÙUƒ;Öɉ‰‰‰ GVƒõ H THÖ\\à=ƒ¹‚á=ƒÇ‚â=ƒÙ\fãQ\f‚ä=ƒç‚å=ƒ‚ƒ\fæçR\fè=ƒé\fP\fƒ ê\në#ˆ‚6ì=ƒ6ƒ6ê\nëíD#ˆ.‚Cê\në#ˆ)î!ƒQ\fïP\f9ƒ`\nMˆ‚j\nðÉñFMˆ\n„|\nÉ\fD\nAB¡ˆ‚\fƒò\nóô\f!!\f\nB#ˆ-\fA‰„\f\n)‡" [make-sparse-keymap menu-name menu reverse menu-items item vectorp 1 callback nil command enabler name string-match "^-+$" "" easy-menu-create-keymaps make-symbol format "menu-function-%d" easy-menu-item-count 0 2 keyword symbol-name 58 arg keys active selected style count :keys :active :suffix " " :style :selected " (" ")" toggle "Toggle " put menu-enable radio not keymapp " ..." lambda (interactive) define-key vector intern] 7]) #@326 Change menu found at PATH as item NAME to contain ITEMS. PATH is a list of strings for locating the menu containing NAME in the menu bar. ITEMS is a list of menu items, as in `easy-menu-define'. These items entirely replace the previous items in that map. Call this from `activate-menubar-hook' to implement dynamic menus. (defalias 'easy-menu-change #[(path name items) "ÀÁÂÃÄÅÆC\"\"#! Ê !ƒ& Ë\f\"A¡‚)ÍÎ!)‡" [key-binding apply vector menu-bar mapcar intern append path name map keymapp easy-menu-create-keymaps items error "Malformed menu in `easy-menu-change'"] 9 (#$ . 3989)]) (defalias 'easy-menu-remove #[(menu) "À‡" [nil] 1]) (defalias 'easy-menu-add #[(menu &optional map) "À‡" [nil] 1]) (provide (quote easymenu)) emacs-19.30/lisp/ebuff-menu.elc100666 13437 1 16152 6002574437 14763 0ustar jimbdaemon;ELC ;;; compiled by kwzh@kropotkin.gnu.ai.mit.edu on Mon Jul 17 19:58:09 1995 ;;; from file /home/gd/gnu/emacs/19.0/lisp/ebuff-menu.el ;;; emacs version 19.29.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`ebuff-menu.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!„\fÄà Bć" [require electric boundp electric-buffer-menu-mode-map nil current-load-list] 2) #@632 Pops up a buffer describing the set of Emacs buffers. Vaguely like ITS lunar select buffer; combining typeoutoid buffer listing with menuoid buffer selection. If the very next character typed is a space then the buffer list window disappears. Otherwise, one may move around in the buffer list window, marking buffers to be selected, saved or deleted. To exit and select a new buffer, type a space when the cursor is on the appropriate line of the buffer-list window. Other commands are much like those of buffer-menu-mode. Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil. \{electric-buffer-menu-mode-map} (defalias 'electric-buffer-list #[(arg) "À‰ˈ\n…2 qˆÄ Æ ˆebˆÇÈÀÉ# bˆ À‰“ˆƒ,Ê ‚1ËÌÉ!!)*‡" [nil buffer select ((byte-code "À‹ˆÁÂÃ!!ÅŽ\fqˆÆ ˆÇÈ )Á‡" [((list-buffers arg)) window-buffer Electric-pop-up-window "*Buffer List*" buffer ((byte-code "qˆÁ ˆÂ!ˆÃÄ!‡" [buffer Buffer-menu-mode bury-buffer message ""] 2)) Electric-buffer-menu-mode electric-buffer-menu-select (byte-code "ÀÁ!ˆÂ C‰Ä=ƒÅÆÇÅ\"ˆ`ebˆÈyˆ`dbˆÉyˆ`Ê \f ‰ W„<\fVƒA ‚CbˆÏÇÅÐÑ \fB%,‡" [message "<<< Press Return to bury the buffer list >>>" read-event unread-command-events 32 nil throw electric-buffer-menu-select 2 -1 0 goal-column last first start-point Electric-command-loop t electric-buffer-menu-looper] 8) select] 3)) point-marker opoint Buffer-menu-execute search-forward "\n>" t Buffer-menu-select switch-to-buffer Buffer-menu-buffer] 4 (#$ . 605) "P"]) (defalias 'electric-buffer-menu-looper #[(state condition) "ƒ@Á>„Â@A\"‡` @WƒebˆÄy‡` AV…5dbˆÅyˆÆd!…5ÇÅ!‡" [condition (buffer-read-only end-of-buffer beginning-of-buffer) signal state 2 -1 pos-visible-in-window-p recenter] 3]) (put (quote Electric-buffer-menu-mode) (quote mode-class) (quote special)) #@1209 Major mode for editing a list of buffers. Each line describes one of the buffers in Emacs. Letters do not insert themselves; instead, they are commands. \ \[keyboard-quit] or \[Electric-buffer-menu-quit] -- exit buffer menu, returning to previous window and buffer configuration. If the very first character typed is a space, it also has this effect. \[Electric-buffer-menu-select] -- select buffer of line point is on. Also show buffers marked with m in other windows, deletes buffers marked with "D", and saves those marked with "S". \[Buffer-menu-mark] -- mark buffer to be displayed. \[Buffer-menu-not-modified] -- clear modified-flag on that buffer. \[Buffer-menu-save] -- mark that buffer to be saved. \[Buffer-menu-delete] or \[Buffer-menu-delete-backwards] -- mark that buffer to be deleted. \[Buffer-menu-unmark] -- remove all kinds of marks from current line. \[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done. \[Buffer-menu-backup-unmark] -- back up a line and remove marks. \{electric-buffer-menu-mode-map} Entry to this mode via command electric-buffer-list calls the value of electric-buffer-menu-mode-hook if it is non-nil. (defalias 'Electric-buffer-menu-mode #[nil "À ˆÁ\n!ˆÃÅÇÈ!ˆÉÊ Ê\fÍebˆÏÐÑÊ#ƒ*ÒuˆÓÔ!‡" [kill-all-local-variables use-local-map electric-buffer-menu-mode-map "Electric Buffer Menu" mode-name "Electric Buffer List" mode-line-buffer-identification make-local-variable Helper-return-blurb "return to buffer editing" t truncate-lines buffer-read-only Electric-buffer-menu-mode major-mode search-forward "\n." nil -1 run-hooks electric-buffer-menu-mode-hook] 4 (#$ . 2408)]) (byte-code "ÀÁÂÃ#ˆ\f„}Å Å ÈA@Á\"ˆÉÊ#ˆÈA@Á\"ˆÉËÌ#ˆÉÍÎ#ˆÉÏ!Ñ#ˆÉÒÓ#ˆÉÔÕ#ˆÉÖ×#ˆÉØ×#ˆÉÙ×#ˆÉÚÛ#ˆÉÜÛ#ˆÉÝÞ#ˆÉßà#ˆÉáâ#ˆÉãâ#ˆÉäå#ˆÉæç#ˆÉèé#ˆÉêë#ˆì-ìîXƒÓÉÏ-!ï#ˆÉÊÏ-!Pï#ˆ-T‰-‚¯)Éðñ#ˆÉòñ#ˆÉóô#ˆÉõö#ˆÉ÷ø#ˆÉùú#ˆÉûø#ˆÉüú#ˆÉýþ#ˆÉÿ@#ˆÉAB#ˆÉCD#ˆÉEF#ˆÉGH#ˆÉIJ#ˆÉKÕ#ˆÉL×#ˆÉM×#ˆÉNO#ˆ*Õ‡" [put Electric-buffer-menu-undefined suppress-keymap t electric-buffer-menu-mode-map make-keymap submap map fillarray define-key "" "" suspend-emacs "v" Electric-buffer-menu-mode-view-buffer char-to-string help-char Helper-help "?" Helper-describe-bindings "" nil "" Electric-buffer-menu-quit "" "q" " " Electric-buffer-menu-select " " "\f" recenter "s" Buffer-menu-save "d" Buffer-menu-delete "k" "" Buffer-menu-delete-backwards "" Buffer-menu-backup-unmark "~" Buffer-menu-not-modified "u" Buffer-menu-unmark 48 i 57 digit-argument "-" negative-argument "-" "m" Buffer-menu-mark "" universal-argument "" previous-line "" next-line "p" "n" "" scroll-up "v" scroll-down ">" scroll-right "<" scroll-left "" scroll-other-window ">" end-of-buffer "<" beginning-of-buffer "" "" [escape escape escape] [mouse-2] Electric-buffer-menu-mouse-select] 6) (defalias 'Electric-buffer-menu-exit #[nil "ÀÁ !ÃÄŇ" [listify-key-sequence this-command-keys unread-command-events nil (byte-code "ÀÁÂ\"‡" [throw electric-buffer-menu-select nil] 3) ((error (byte-code "À ˆÁ ‡" [Buffer-menu-mode other-buffer] 1)))] 3 nil nil]) #@199 Leave Electric Buffer Menu, selecting buffers and executing changes. Saves buffers marked "S". Deletes buffers marked "K". Selects buffer at point and displays buffers marked ">" in other windows. (defalias 'Electric-buffer-menu-select #[nil "ÀÁ`\"‡" [throw electric-buffer-menu-select] 3 (#$ . 5629) nil]) (defalias 'Electric-buffer-menu-mouse-select #[(event) "À  8:ƒ‚à 8)‰@)!ˆÅÆ !qˆ  8:ƒ+‚,à 8)‰A@:ƒ>\fA@@‚A\fA@)bˆÇÈ`\"‡" [select-window event 2 1 position window-buffer selected-window throw electric-buffer-menu-select] 4 nil "e"]) #@121 Leave Electric Buffer Menu, restoring previous window configuration. Does not execute select, save, or delete commands. (defalias 'Electric-buffer-menu-quit #[nil "ÀÁÂ\"‡" [throw electric-buffer-menu-select nil] 3 (#$ . 6189) nil]) (defalias 'Electric-buffer-menu-undefined #[nil "À ˆÁÂÃ!Ä=ƒ-ÂÅ!Æ=ƒ-ÂÇ!!É=ƒ-ÂÊ!Ë=ƒ-ÌÍ!‚0ÌÎ!!ˆÏÐ!‡" [ding message key-binding "" Electric-buffer-menu-quit " " Electric-buffer-menu-select char-to-string help-char Helper-help "?" Helper-describe-bindings substitute-command-keys "Type C-c C-c to exit, Space to select, \\[Helper-help] for help, ? for commands" "Type \\[Electric-buffer-menu-quit] to exit, \\[Electric-buffer-menu-select] to select, \\[Helper-help] for help, \\[Helper-describe-bindings] for commands." sit-for 4] 4 nil nil]) #@97 View buffer on current line in Electric Buffer Menu. Returns to Electric Buffer Menu when done. (defalias 'Electric-buffer-menu-mode-view-buffer #[nil "ÀÁ!‰ƒÃ\n!‚Ä ˆÅÆ\n\"ˆÇÈ!)‡" [Buffer-menu-buffer nil bufnam view-buffer ding message "Buffer %s does not exist!" sit-for 4] 4 (#$ . 6974) nil]) emacs-19.30/lisp/echistory.elc100666 13437 1 7744 5751546355 14742 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:23:07 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/echistory.el ;;; emacs version 19.28.90.69. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/echistory.el' was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!‡" [require electric chistory] 2) #@132 Edit current history line in minibuffer and execute result. With prefix arg NOCONFIRM, execute current line as-is without editing. (defalias 'Electric-command-history-redo-expression #[(&optional noconfirm) "ÀŠÂqˆÃyˆÄp!ÅÆ!… …ÇÈ D\"*‡" [nil todo "*Command History*" 0 read boundp electric-history-in-progress throw electric-history-quit noconfirm] 4 (#$ . 541) "P"]) (byte-code "ÀÁ!„ÂÁ B „Ä Å ÆÇ#ˆÅ ÈÄ #ˆÅ ÉÇ#ˆÅ ÊË#ˆÅ ÌÍ#ˆÅ ÎÍ#ˆÅ ÏÐ#ˆÅ ÑÒ#ˆÅ ÓÔ#ˆÅ ÕÖ#ˆÅ ×Ø#ˆÅ ÙÚ#ˆÅ ÛÜ#ˆÅ ÝÞ#ˆÅ ßà#ˆÅ áâ#ˆÅ ãÂ#ˆÅ äâ#ˆÅ åâ#ˆÅ æç#ˆÅ è)!ê#ˆÅ ëì#ˆÅ íî#ˆÅ ïð#ˆÅ ñò#ˆÅ óò#ˆÅ ôõ#ˆÅ öò#ˆÅ ÷õ#ˆÅ øù#ˆÅ úû#ˆÅ üð#ˆÅ ýò#ˆÅ þõ#ˆÅ ÿù#ˆÅ @û#ˆÅ AB#ˆÅ CD#ˆÂ‡" [boundp electric-history-map nil current-load-list make-sparse-keymap define-key [t] Electric-history-undefined "" [27 t] "" universal-argument " " Electric-command-history-redo-expression "!" "" eval-sexp "" down-list "" backward-up-list "" backward-sexp "" forward-sexp "" beginning-of-defun "" end-of-defun "" forward-list "" backward-list "q" Electric-history-quit "" "" "" "" suspend-emacs char-to-string help-char Helper-help "?" Helper-describe-bindings ">" end-of-buffer "<" beginning-of-buffer "\n" next-line " " "" previous-line "" "" "v" scroll-down "" scroll-up [home] [down] [up] [prior] [next] "\f" recenter "" scroll-other-window] 4) #@64 If non-nil, its value is called by `electric-command-history'. (defvar electric-command-history-hook nil (#$ . 1881)) #@843 \Major mode for examining and redoing commands from `command-history'. This pops up a window with the Command History listing. The number of command listed is controlled by `list-command-history-max'. The command history is filtered by `list-command-history-filter' if non-nil. Combines typeout Command History list window with menu like selection of an expression from the history for re-evaluation in the *original* buffer. The history displayed is filtered by `list-command-history-filter' if non-nil. Like Emacs-Lisp mode except that characters do not insert themselves and Tab and Linefeed do not indent. Instead these commands are provided: \{electric-history-map} Calls the value of `electric-command-history-hook' if that is non-nil. The Command History listing is recomputed each time this mode is invoked. (defalias 'electric-command-history #[nil "ÀpÁÅŽÆÇ)\n:…- qˆ\n@ƒ'È\nA@@\nA@A\"‚-ÉÊ\nA@\"+‡" [t nil todo old-buffer electric-history-in-progress ((byte-code "ÀqˆÁ ˆÂp!‡" ["*Command History*" Command-history-setup bury-buffer] 2)) electric-history-quit (byte-code "À‹‡" [((byte-code "À‹ˆÁÂ!ˆÃÄ!ˆmƒÅ ˆÆÇ!ˆÈÉÊ\"‡Ë\fÍÉÎÏ#)‡" [((byte-code "À ˆÁqˆÂÃÄ #‡" [list-command-history "*Command History*" Command-history-setup electric-command-history "Electric History" electric-history-map] 4)) Electric-pop-up-window "*Command History*" run-hooks electric-command-history-hook ding message "No command history." throw electric-history-quit nil "return to History" Helper-return-blurb Electric-command-loop "->" t] 4))] 1) apply edit-and-eval-command "Redo: "] 3 (#$ . 2006) nil]) (defalias 'Electric-history-undefined #[nil "À ˆÁÂÃ!!ˆÄÅ!‡" [ding message substitute-command-keys "Type \\[Helper-help] for help, ? for commands, C-c C-c to quit, Space to execute" sit-for 4] 3 nil nil]) #@73 Quit Electric Command History, restoring previous window configuration. (defalias 'Electric-history-quit #[nil "ÀÁ!…ÂÃ!ˆÄÅÆ\"‡" [boundp electric-history-in-progress message "" throw electric-history-quit nil] 3 (#$ . 3836) nil]) emacs-19.30/lisp/edebug.elc100666 12120 1 266500 6043464172 14054 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:38:26 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/edebug.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`edebug.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÀÂà \"Ä•O)ÅBÇÈ!ˆÉÊ!„ ÊËMˆÌ ÍB‡" ["$Revision: 3.5.1.22 $" raw-version string-match "[0-9.]*" 0 edebug-version current-load-list require backquote fboundp defalias fset "liberte@cs.uiuc.edu" edebug-maintainer-address] 4) #@43 Submit, via mail, a bug report on edebug. (defalias 'edebug-submit-bug-report #[nil "ÀÁ!ˆÂÃ!…!Ä ÆPÈÉÊËÌÍÎÏÐÑÒÓÔÕ¯#‡" [require reporter y-or-n-p "Do you really want to submit a report on edebug? " reporter-submit-bug-report edebug-maintainer-address "edebug.el " edebug-version edebug-setup-hook edebug-all-defs edebug-all-forms edebug-eval-macro-args edebug-stop-before-symbols edebug-save-windows edebug-save-displayed-buffer-points edebug-initial-mode edebug-trace edebug-test-coverage edebug-continue-kbd-macro edebug-print-length edebug-print-level edebug-print-circle] 17 (#$ . 724) nil]) #@291 *Functions to call before edebug is used. Each time it is set to a new value, Edebug will call those functions once and then `edebug-setup-hook' is reset to nil. You could use this to load up Edebug specifications associated with a package you are using but only when you also use Edebug. (defvar edebug-setup-hook nil (#$ . -1329)) #@444 *If non-nil, evaluation of any defining forms will instrument for Edebug. This applies to `eval-defun', `eval-region', `eval-buffer', and `eval-current-buffer'. `eval-region' is also called by `eval-last-sexp', and `eval-print-last-sexp'. You can use the command `edebug-all-defs' to toggle the value of this variable. You may wish to make it local to each buffer with (make-local-variable 'edebug-all-defs) in your `emacs-lisp-mode-hook'. (defvar edebug-all-defs nil (#$ . -1670)) #@197 *Non-nil evaluation of all forms will instrument for Edebug. This doesn't apply to loading or evaluations in the minibuffer. Use the command `edebug-all-forms' to toggle the value of this option. (defvar edebug-all-forms nil (#$ . -2162)) #@395 *Non-nil means all macro call arguments may be evaluated. If this variable is nil, the default, Edebug will *not* wrap macro call arguments as if they will be evaluated. For each macro, a `edebug-form-spec' overrides this option. So to specify exceptions for macros that have some arguments evaluated and some not, you should specify an `edebug-form-spec'. This option is going away soon. (defvar edebug-eval-macro-args nil (#$ . -2408)) #@165 *Non-nil causes Edebug to stop before symbols as well as after. In any case, a breakpoint or interrupt may stop before a symbol. This option is going away soon. (defvar edebug-stop-before-symbols nil (#$ . -2858)) #@348 *If non-nil, Edebug saves and restores the window configuration. That takes some time, so if your program does not care what happens to the window configurations, it is better to set this variable to nil. If the value is a list, only the listed windows are saved and restored. `edebug-toggle-save-windows' may be used to change this variable. (defvar edebug-save-windows t (#$ . -3082)) #@473 *If non-nil, save and restore point in all displayed buffers. Saving and restoring point in other buffers is necessary if you are debugging code that changes the point of a buffer which is displayed in a non-selected window. If Edebug or the user then selects the window, the buffer's point will be changed to the window's point. Saving and restoring point in all buffers is expensive, since it requires selecting each window twice, so enable this only if you need it. (defvar edebug-save-displayed-buffer-points nil (#$ . -3480)) #@262 *Initial execution mode for Edebug, if non-nil. If this variable is non-@code{nil}, it specifies the initial execution mode for Edebug when it is first activated. Possible values are step, next, go, Go-nonstop, trace, Trace-fast, continue, and Continue-fast. (defvar edebug-initial-mode (quote step) (#$ . -4021)) #@298 *Non-nil means display a trace of function entry and exit. Tracing output is displayed in a buffer named `*edebug-trace*', one function entry or exit per line, indented by the recursion level. You can customize by replacing functions `edebug-print-trace-before' and `edebug-print-trace-after'. (defvar edebug-trace nil (#$ . -4344)) #@316 *If non-nil, Edebug tests coverage of all expressions debugged. This is done by comparing the result of each expression with the previous result. Coverage is considered OK if two different results are found. Use `edebug-display-freq-count' to display the frequency count and coverage information for a definition. (defvar edebug-test-coverage nil (#$ . -4687)) #@113 *If non-nil, continue defining or executing any keyboard macro. Use this with caution since it is not debugged. (defvar edebug-continue-kbd-macro nil (#$ . -5056)) #@75 *Default value of `print-length' to use while printing results in Edebug. (defvar edebug-print-length 50 (#$ . -5226)) #@74 *Default value of `print-level' to use while printing results in Edebug. (defvar edebug-print-level 50 (#$ . -5351)) #@75 *Default value of `print-circle' to use while printing results in Edebug. (defvar edebug-print-circle t (#$ . -5474)) #@241 *Non-nil if Edebug should unwrap results of expressions. This is useful when debugging macros where the results of expressions are instrumented expressions. But don't do this when results might be circular or an infinite loop will result. (defvar edebug-unwrap-results nil (#$ . -5599)) #@447 *Value bound to `debug-on-error' while Edebug is active. If `debug-on-error' is non-nil, that value is still used. If the value is a list of signal names, Edebug will stop when any of these errors are signaled from Lisp code whether or not the signal is handled by a `condition-case'. This option is useful for debugging signals that *are* handled since they would otherwise be missed. After execution is resumed, the error is signaled again. (defvar edebug-on-error t (#$ . -5894)) #@57 *Value bound to `debug-on-quit' while Edebug is active. (defvar edebug-on-quit t (#$ . -6386)) #@120 *If non-nil, an expression to test for at every stop point. If the result is non-nil, then break. Errors are ignored. (defvar edebug-global-break-condition nil (#$ . -6488)) #@165 Set the edebug-form-spec property of SYMBOL according to SPEC. Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol (naming a function), or a list. (defalias 'def-edebug-spec '(macro . #[(symbol spec) "ÀÁ\nDÃÁ\fDF‡" [put quote symbol (quote edebug-form-spec) spec] 5 (#$ . 6670)])) #@69 For compatibility with old version. Use `def-edebug-spec' instead. (defalias 'def-edebug-form-spec '(macro . #[(symbol spec-form) "ÀÁ!ˆÂÃÄÅ#‡" [message "Obsolete: use def-edebug-spec instead." put symbol edebug-form-spec (eval spec-form)] 4 (#$ . 6974)])) (defalias 'get-edebug-spec #[(symbol) "ÁN‰9ƒ ÁN‰ƒ ‰‚ *‡" [symbol edebug-form-spec nil indirect] 3]) #@55 Integer used by `edebug-gensym' to produce new names. (defvar edebug-gensym-index 0 (#$ . 7349)) #@207 Generate a fresh uninterned symbol. There is an optional argument, PREFIX. PREFIX is the string that begins the new name. Most people take just the default, except when debugging needs suggest otherwise. (defalias 'edebug-gensym #[(&optional prefix) "„ÁÂà „)Æ!PÈ\\É\f!„\nÊ\f!‰ƒ *‡" [prefix "G" nil "" newname newsymbol int-to-string edebug-gensym-index 1 intern-soft make-symbol] 4 (#$ . 7453)]) #@78 Return t if OBJECT is a keyword. A keyword is a symbol that starts with `:'. (defalias 'edebug-keywordp #[(object) "9…\fÁ!ÂHÃU‡" [object symbol-name 0 58] 2 (#$ . 7876)]) #@102 Return t if OBJECT is a lambda list keyword. A lambda list keyword is a symbol that starts with `&'. (defalias 'edebug-lambda-list-keywordp #[(object) "9…\fÁ!ÂHÃU‡" [object symbol-name 0 38] 2 (#$ . 8057)]) (defalias 'edebug-last-sexp #[nil "ÀŠÁÂ!ˆ`)`{!@‡" [read-from-string forward-sexp -1] 3]) #@54 Return a list of windows, in order of `next-window'. (defalias 'edebug-window-list #[nil "À ‰Cà !‰ =„\f\nBÃ\f!‰‚ \nŸ+‡" [selected-window first-window window-list next-window next] 3 (#$ . 8362)]) #@38 Return non-nil if WINDOW is visible. (defalias 'edebug-window-live-p #[(window) "À  Ã\"‰ =„\f =„Â\fÃ\"‰‚ \f *=‡" [selected-window first-window next-window t next window] 4 (#$ . 8572)]) (defalias 'edebug-lookup-function #[(object) "9ƒÁ!ƒK‰‚‡" [object fboundp] 3]) (put (quote edebug-lookup-function) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@64 Return the macro named by OBJECT, or nil if it is not a macro. (defalias 'edebug-macrop #[(object) "‰9ƒÁ!ƒK‰‚)‰<…+@Â=…+ÃA!…+‡" [object fboundp macro edebug-functionp] 4 (#$ . 8957)]) #@71 Returns the function named by OBJECT, or nil if it is not a function. (defalias 'edebug-functionp #[(object) "‰9ƒÁ!ƒK‰‚)Â!„6Ã!„6<…7@Ä=…7A@<…7‡" [object fboundp subrp byte-code-function-p lambda] 4 (#$ . 9165)]) (defalias 'edebug-sort-alist #[(alist function) "À Â\"‡" [sort alist #[(e1 e2) " @\n@\"‡" [function e1 e2] 3]] 3]) #@42 Name of the buffer to put trace info in. (defconst edebug-trace-buffer "*edebug-trace*" (#$ . 9522)) (defalias 'edebug-pop-to-buffer #[(buffer &optional window) "À !ƒ !ƒà !\f=ƒ ‚)ÃÅ !\f=ƒ&Å ‚)Æ\f!‰ƒ5Ç !ˆ‚LÈ ƒ=É ˆÊ !Ì =„LÇÌ !ˆÍÅ \f\"ˆÎÅ Ï\"‡" [windowp window edebug-window-live-p window-buffer buffer selected-window edebug-get-buffer-window select-window one-window-p split-window get-buffer-window edebug-trace-buffer next-window set-window-buffer set-window-hscroll 0] 4]) (defalias 'edebug-get-displayed-buffer-points #[nil "ŠÀ  !ÄÄ =„*Ç !‰qˆ`B B !‰‚ -‡" [selected-window first-window next-window next nil buffer-point-list buffer window-buffer] 3]) (defalias 'edebug-set-buffer-points #[(buffer-points) "pÁ \"ˆq)‡" [current-buffer mapcar #[(buf-point) "À @!… @qˆ Ab‡" [buffer-name buf-point] 2] buffer-points] 3]) (defalias 'edebug-current-windows #[(which-windows) "<ƒ\nÁÂ\"‡Ã ‡" [which-windows mapcar #[(window) "À !…  !à !Ä !Å !¯‡" [edebug-window-live-p window window-buffer window-point window-start window-hscroll] 6] current-window-configuration] 3]) (defalias 'edebug-set-windows #[(window-info) "<ƒ\nÁÂ\"‡Ã!‡" [window-info mapcar #[(one-window-info) "…ÁÂ\"‡" [one-window-info apply #[(window buffer point start hscroll) "À !… \"ˆÄ \"ˆÆ \"ˆÈ  \"‡" [edebug-window-live-p window set-window-buffer buffer set-window-point point set-window-start start set-window-hscroll hscroll] 3]] 3] set-window-configuration] 3]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÇÈÉ\"ˆÊË!„ ÀËÌK\"ˆÀ‡" [defalias edebug-get-buffer-window get-buffer-window edebug-sit-for sit-for edebug-input-pending-p input-pending-p require eval-reg "eval-reg" fboundp edebug-original-read read] 3) #@721 Read one Lisp expression as text from STREAM, return as Lisp object. If STREAM is nil, use the value of `standard-input' (which see). STREAM or the value of `standard-input' may be: a buffer (read from point and advance it) a marker (read from where it points and advance it) a function (call it with no arguments for each character, call it with a char as argument to push a char back) a string (takes text from string, starting at the beginning) t (read text line using minibuffer and use it). This version, from Edebug, maybe instruments the expression. But the STREAM must be the current buffer to do so. Whether it instuments is also dependent on the values of `edebug-all-defs' and `edebug-all-forms'. (defalias 'edebug-read #[(&optional stream) "„ p=ƒ ‡Ã!‡" [stream standard-input edebug-read-and-maybe-wrap-form edebug-original-read] 2 (#$ . 11248)]) (byte-code "ÀÁ!„\fÂÁÃK\"ˆÀ‡" [fboundp edebug-original-eval-defun defalias eval-defun] 3) #@372 Evaluate the top-level form containing point, or after point. This version, from Edebug, has the following differences: With a prefix argument instrument the code for Edebug. If `edebug-all-defs' is non-nil, then the code is instrumented *unless* there is a prefix argument. If instrumenting, it prints: `Edebug: FUNCTIONNAME'. Otherwise, it prints in the minibuffer. (defalias 'edebug-eval-defun #[(edebug-it) "? ?=?ÂÅ\f ?=Ç *!\f„!È !‚\" *‡" [edebug-it edebug-all-defs nil edebug-result edebugging eval edebug-all-forms edebug-read-top-level-form princ] 4 (#$ . 12225) "P"]) (defalias (quote edebug-defun) (quote edebug-eval-top-level-form)) #@271 Evaluate a top level form, such as a defun or defmacro. This is like `eval-defun', but the code is always instrumented for Edebug. Print its name in the minibuffer and leave point where it is, or if an error occurs, leave point after it with mark at the original point. (defalias 'edebug-eval-top-level-form #[nil "ÀÁ‰Ä *!‡" [eval t edebug-all-defs edebug-all-forms edebug-read-top-level-form] 3 (#$ . 12888) nil]) (defalias 'edebug-read-top-level-form #[nil "`Á ˆÂ ˆÃ bˆ)‡" [starting-point end-of-defun beginning-of-defun edebug-read-and-maybe-wrap-form] 2]) (defalias (quote edebug-all-defuns) (quote edebug-all-defs)) #@39 Toggle edebugging of all definitions. (defalias 'edebug-all-defs #[nil "?Áƒ ÂÄ\"‡" [edebug-all-defs message "Edebugging all definitions is %s." "on" "off"] 3 (#$ . 13519) nil]) #@33 Toggle edebugging of all forms. (defalias 'edebug-all-forms #[nil "?Áƒ ÂÄ\"‡" [edebug-all-forms message "Edebugging all forms is %s." "on" "off"] 3 (#$ . 13710) nil]) (defalias 'edebug-install-read-eval-functions #[nil "ÀKÁ=?… ˆÃÀÁ\"ˆÃÄÅ\"‡" [read edebug-read elisp-eval-region-install defalias eval-defun edebug-eval-defun] 3 nil nil]) (defalias 'edebug-uninstall-read-eval-functions #[nil "À ˆÁÂÃK\"ˆÁÄÅK\"‡" [elisp-eval-region-uninstall defalias read edebug-original-read eval-defun edebug-original-eval-defun] 3 nil nil]) (byte-code "ÀÁ!ˆÂÁ B‡" [make-variable-buffer-local edebug-form-data nil current-load-list] 2) (defalias 'edebug-make-form-data-entry #[(symbol begin end) " \nE‡" [symbol begin end] 3]) (defalias 'edebug-form-data-name #[(entry) "@‡" [entry] 1]) (put (quote edebug-form-data-name) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-form-data-begin #[(entry) "A@‡" [entry] 1]) (put (quote edebug-form-data-begin) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-form-data-end #[(entry) "À 8‡" [2 entry] 2]) (put (quote edebug-form-data-end) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-set-form-data-entry #[(entry name begin end) "  ˆA@\nÓˆÄ8 Ó‡" [entry name begin nil 2 end] 3]) (put (quote edebug-set-form-data-entry) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-get-form-data-entry #[(pnt &optional end-point) "Á ƒbÆ Wƒb @‰‰A@) Z\n AÆ\nXƒ^\n Wƒ^ ƒI Ì8)Uƒ^ Ì8)Xƒ^\n+‚\f+‡" [edebug-form-data nil 999999 closest-dist closest-entry rest 0 entry begin pnt dist end-point 2] 4]) (defalias 'edebug-form-data-symbol #[nil "À`!‰@)† ÂÃ!‡" [edebug-get-form-data-entry entry error "Not inside instrumented form"] 3]) (defalias 'edebug-make-top-form-data-entry #[(new-entry) "À !ˆ \nB‰‡" [edebug-clear-form-data-entry new-entry edebug-form-data] 2]) (defalias 'edebug-clear-form-data-entry #[(entry) "…\nÁ\n\"‰‡" [entry delq edebug-form-data] 3]) (defalias 'edebug-syntax-error #[(&rest args) "ÀÁ\n\"‡" [signal invalid-read-syntax args] 3]) (byte-code "ÀÁÂ\"Ã\fÆWƒ \fÇIˆ\fT‰‚ ÈÉIˆ ÊËIˆ ÌÍIˆ ÎÏIˆ ÐÑIˆ ÒÓIˆ ÔÕIˆ Ö×Iˆ ØÙIˆ *ÚBÀ‡" [make-vector 256 symbol 0 i table 33 space 40 lparen 41 rparen 39 quote 34 string 63 char 91 lbracket 93 rbracket 46 dot 35 hash edebug-read-syntax-table current-load-list] 4) (defalias 'edebug-next-token-class #[nil "À ˆ gH‡" [edebug-skip-whitespace edebug-read-syntax-table] 2]) (defalias 'edebug-skip-whitespace #[nil "ÀÁwˆgÂU…ÃÁwˆÀÁwˆ‚‡" [" \n\f" nil 59 "^\n "] 2]) (defalias 'edebug-read-sexp #[nil "À ‰Â=ƒÃp!\fhHÂ=„BÅuˆ‚B Æ=ƒ/Ãp!hÇU„BÅuˆ‚B È=ƒ?ÉuˆÈÊ D‚BÃp!)‡" [edebug-next-token-class class symbol edebug-original-read edebug-read-syntax-table -1 string 34 quote 1 edebug-read-sexp] 4]) (byte-code "ÀÁ\nBÀÃ\nBÀÄ\nBÀÅ\nBÀ‡" [nil edebug-offsets current-load-list edebug-offsets-stack edebug-current-offset edebug-read-dotted-list] 2) (defalias 'edebug-initialize-offsets #[nil "À‰‡" [nil edebug-current-offset] 2]) (put (quote edebug-initialize-offsets) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-store-before-offset #[(point) "C\nƒ\n \nAB¡ˆ‚ ÄÄ B ‰)‡" [point new-offset edebug-current-offset edebug-offsets nil edebug-offsets-stack edebug-read-dotted-list] 3]) (defalias 'edebug-store-after-offset #[(point) "„ ‰AŸ¡ˆ‚ ‰AAŸ A@A¤¡ˆ ¤\fA‰@‰‡" [edebug-read-dotted-list edebug-current-offset nil point edebug-offsets-stack] 4]) (defalias 'edebug-ignore-offset #[nil "‰AA¡‡" [edebug-current-offset] 2]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put edebug-storing-offsets edebug-form-spec (form body) lisp-indent-hook 1] 4) (defalias 'edebug-storing-offsets '(macro . #[(point &rest body) "ÀÁ D\fBBÅBB‡" [unwind-protect progn edebug-store-before-offset point body ((edebug-store-after-offset (point)))] 4])) (byte-code "ÀÁ\nBÁ‡" [((symbol . edebug-read-symbol) (lparen . edebug-read-list) (string . edebug-read-string) (quote . edebug-read-quote) (lbracket . edebug-read-vector) (hash . edebug-read-function)) edebug-read-alist current-load-list] 2) (defalias 'edebug-read-storing-offsets #[(stream) "À Á‰ÅŽÆ`!ˆ\fž‰ƒ A!‚\"É!,‡" [edebug-next-token-class nil edebug-read-dotted-list func class ((byte-code "À`!‡" [edebug-store-after-offset] 2)) edebug-store-before-offset edebug-read-alist stream edebug-original-read] 3]) (defalias 'edebug-read-symbol #[(stream) "À !\nhHÃ=„Äuˆ‡" [edebug-original-read stream edebug-read-syntax-table symbol -1] 3]) (defalias 'edebug-read-string #[(stream) "À !hÂU„\fÃuˆ‡" [edebug-original-read stream 34 -1] 3]) (defalias 'edebug-read-quote #[(stream) "ÀuˆÁŽÂ`!ˆ)ÃÄ !D‡" [1 ((byte-code "À`!‡" [edebug-store-after-offset] 2)) edebug-store-before-offset quote edebug-read-storing-offsets stream] 3]) (defalias 'edebug-read-function #[(stream) "ÀuˆgÁU„ ÂÃ!ˆÀuˆÄŽÅ`!ˆÆÇ!ƒ È‚!É)Ê !D‡" [1 39 edebug-syntax-error "Bad char" ((byte-code "À`!‡" [edebug-store-after-offset] 2)) edebug-store-before-offset featurep cl function* function edebug-read-storing-offsets stream] 3]) (defalias 'edebug-read-list #[(stream) "ÀuˆÁà Ä>„Å!\nB‚\nŸà Ç=ƒBÁÀuˆÅ!\n¤ˆÃ É=„<ÊË!ˆ<\f)\n)Àuˆ‡" [1 nil elements edebug-next-token-class (rparen dot) edebug-read-storing-offsets stream dot dotted-form rparen edebug-syntax-error "Expected `)'" edebug-read-dotted-list] 2]) (defalias 'edebug-read-vector #[(stream) "ÀuˆÁà Ä=„Å!\nB‚ÇÈ\nŸ\")Àuˆ‡" [1 nil elements edebug-next-token-class rbracket edebug-read-storing-offsets stream apply vector] 3]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp edebug-dotted-spec nil current-load-list] 2) (defalias 'edebug-new-cursor #[(expressions offsets) "À !ƒ  Ã\" \fB‡" [vectorp expressions append nil offsets] 3]) (defalias 'edebug-set-cursor #[(cursor expressions offsets) "  ˆ\n¡ˆ‡" [cursor expressions offsets] 2]) (put (quote edebug-set-cursor) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-cursor-expressions #[(cursor) "@‡" [cursor] 1]) (put (quote edebug-cursor-expressions) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-cursor-offsets #[(cursor) "A‡" [cursor] 1]) (put (quote edebug-cursor-offsets) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-empty-cursor #[(cursor) "@?‡" [cursor] 1]) (put (quote edebug-empty-cursor) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-top-element #[(cursor) "@@‡" [cursor] 1]) (put (quote edebug-top-element) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-top-element-required #[(cursor &rest error) "ƒ Á\nÃ\"ˆ\n‰@)„ÄÁ\n #ˆ\n‰@@)‡" [edebug-dotted-spec edebug-no-match cursor "Dot expected." apply error] 5]) (defalias 'edebug-top-offset #[(cursor) "A@‡" [cursor] 1]) (put (quote edebug-top-offset) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-move-cursor #[(cursor) "‰@)„ ÁÂ\"ˆ‰@A ˆ‰AA¡ˆ‡" [cursor edebug-no-match "Not enough arguments."] 4]) (defalias 'edebug-before-offset #[(cursor) "‰A)‰:ƒ @@‚ S)‡" [cursor offset] 2]) (defalias 'edebug-after-offset #[(cursor) "‰A@)‰:ƒ A‰‚ )‡" [cursor offset] 2]) (byte-code "À B Bà BÄÅ!„ÆÅ BÆÇ BÆÈ BÆ É BÆ\nÊ BƇ" [edebug-top-window-data current-load-list edebug-&optional edebug-&rest boundp edebug-gate nil edebug-def-name edebug-old-def-name edebug-error-point edebug-best-error] 2) (defalias 'edebug-read-and-maybe-wrap-form #[nil "ÀÁ!ˆÂ‰‰‰‰‰‰‰‰ Ä\\ Æ\\ \n \f ÇЉƒ8ÑÒ\"ˆ. ‡" [run-hooks edebug-setup-hook nil max-lisp-eval-depth 800 max-specpdl-size 2000 no-match edebug-error-point edebug-best-error edebug-gate edebug-&rest edebug-&optional edebug-def-name edebug-top-window-data result (byte-code "À ‡" [edebug-read-and-maybe-wrap-form1 result nil] 1) apply edebug-syntax-error] 13]) (defalias 'edebug-read-and-maybe-wrap-form1 #[nil "À‰‰‰‰‰‰ŠÈ É=ƒUÊuˆÈ Ë=ƒUÌp!‰9…0Í!‰<…<@Î=‰…TA@Ï=…TÈ Ë=…TÌp!) ƒ•„dƒ‰ÒÓp!C C\"ÕÖ!×!SØ!ABC$@)‚·Ù\fÚÛ #ˆÜ ‚·ƒµÒÓp!C C\"ÕÖ!×!À$)‚·Ü .‡" [nil edebug-current-offset edebug-offsets-stack edebug-offsets def-name defining-form-p def-kind spec edebug-next-token-class lparen 1 symbol edebug-original-read get-edebug-spec &define name edebug-all-defs edebug-all-forms edebug-new-cursor edebug-read-storing-offsets cursor edebug-make-form-wrapper edebug-before-offset edebug-after-offset symbol-name put edebug point-marker edebug-read-sexp] 8]) (byte-code "À B Bà BÀ‡" [edebug-def-args current-load-list edebug-def-interactive edebug-inside-func] 2) (defalias 'edebug-interactive-p-name #[nil "ÀÁ \"!‡" [intern format "edebug-%s-interactive-p" edebug-def-name] 4]) #@38 Wrap the FORMS of a definition body. (defalias 'edebug-wrap-def-body #[(forms) "ƒÁ ÃBCÄ !E‡Ä !‡" [edebug-def-interactive let edebug-interactive-p-name ((interactive-p)) edebug-make-enter-wrapper forms] 4 (#$ . 22521)]) (defalias 'edebug-make-enter-wrapper #[(forms) "† † ÂÃ!ÄÅD…ÇŸBÉÊË\fBBDF‡" [edebug-def-name edebug-old-def-name edebug-gensym "edebug-anon" edebug-enter quote edebug-inside-func list edebug-def-args function lambda nil forms] 7]) (byte-code "À B Bà BÀ‡" [edebug-form-begin-marker current-load-list edebug-offset-index edebug-offset-list] 2) (defalias 'edebug-inc-offset #[(offset) " \nZ BT‡" [edebug-offset-index offset edebug-form-begin-marker edebug-offset-list] 3]) (defalias 'edebug-make-before-and-after-form #[(before-index form after-index) "ÀÁ\nD \fF‡" [edebug-after edebug-before before-index after-index form] 4]) (defalias 'edebug-make-after-form #[(form after-index) "ÀÁ\n F‡" [edebug-after 0 after-index form] 4]) #@205 Return the unwrapped SEXP or return it as is if it is not wrapped. The SEXP might be the result of wrapping a body, which is a list of expressions; a `progn' form will be returned enclosing these forms. (defalias 'edebug-unwrap #[(sexp) ":ƒ2@Á=ƒÂ8‡@Ã=ƒ0Â8A@AA‰GÅVƒ,Æ\fB‚.\f@)‡‡‡" [sexp edebug-after 3 edebug-enter forms 1 progn] 3 (#$ . 23498)]) #@40 Return the sexp recursively unwrapped. (defalias 'edebug-unwrap* #[(sexp) "À ! \n=„\nÀ !‚\n:ƒÃÄ\n\"‚ \n)‡" [edebug-unwrap sexp new-sexp mapcar edebug-unwrap*] 3 (#$ . 23865)]) (defalias 'edebug-defining-form #[(cursor form-begin form-end speclist) "‰‰@)‰A)A‰\n ˆ ¡ˆ+Ã\f S$‡" [cursor offsets expressions edebug-make-form-wrapper form-begin form-end speclist] 6]) (defalias 'edebug-make-form-wrapper #[(cursor form-begin form-end &optional speclist) "À \n\"‰ƒ ‰A@)‚Å Æ“ÆÈÆ ‰@)Ɖ‰‰ \n \f ƒCÒ\"‚JÔÕ!C!\f†Y †YÖ×!\f „nØ\fÅ \nÆ“#‚ \f \n‰ ˆ\fA@Æ“ˆÜ\f8Æ“ˆ,Ý !ˆÞß\f\"ˆàŸ!á\f!ˆâ\f!ˆ#„Ãäp!†¸å ‰&ç&!B#)è\féÆ#F#ˆ.\n‡" [edebug-get-form-data-entry form-begin form-end form-data-entry entry make-marker nil edebug-form-begin-marker 0 edebug-inside-func edebug-def-interactive edebug-def-args edebug-def-name edebug-old-def-name result edebug-offset-index edebug-offset-list speclist edebug-match cursor edebug-make-enter-wrapper edebug-form edebug-gensym "edebug-anon" edebug-make-form-data-entry end begin name 2 edebug-make-top-form-data-entry message "Edebug: %s" vconcat edebug-clear-frequency-count edebug-clear-coverage edebug-top-window-data get-buffer-window selected-window window window-start put edebug] 9]) (defalias 'edebug-clear-frequency-count #[(name) "À ÂÃ\fGÅ\"#‡" [put name edebug-freq-count make-vector edebug-offset-list 0] 6]) (defalias 'edebug-clear-coverage #[(name) "À ÂÃ\fGÅ\"#‡" [put name edebug-coverage make-vector edebug-offset-list unknown] 6]) (defalias 'edebug-form #[(cursor) "À Â\" ‰A@) :ƒi @Å=ƒ ‚¢ @‰9…)Ç!É \f\"\n:ƒS@Ë=ƒSÌ\n\f@Í !Î!AB$‚eÏÐ\f@!Ñ\n!Ð\n‰A)!#+‚¢ 9ƒ¡ Ò>„€ÓÔ!ƒ„Ô !ƒ„ ‚¢ƒ—ÏÐ\f@! Ð\fA!#‚¢Ö Ð\fA!\"‚¢ × !ˆ*‡" [edebug-top-element-required cursor "Expected form" form offset quote head get-edebug-spec spec edebug-new-cursor new-cursor &define edebug-defining-form edebug-after-offset symbol-name edebug-make-before-and-after-form edebug-inc-offset edebug-list-form (t nil) fboundp edebug-keywordp edebug-stop-before-symbols edebug-make-after-form edebug-move-cursor] 7]) (defalias 'edebug-forms #[(cursor) "À Â\"‡" [edebug-match cursor (&rest form)] 3]) (put (quote edebug-forms) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-sexps #[(cursor) "À Â\"‡" [edebug-match cursor (&rest sexp)] 3]) (put (quote edebug-sexps) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-list-form-args #[(head cursor) "À !‰ƒL\n:ƒÉÆ\n\"*‚{\nÈ=ƒ-ÉÊ\")‚{\nË=ƒ@ÉÌ\")‚{\n9…{\n!‚{Í !ƒqƒdÉÊ\")‚{ÉÌ\")‚{ÉÊ\"))‡" [get-edebug-spec head spec nil edebug-error-point edebug-best-error edebug-match-sublist cursor t edebug-match (&rest form) 0 (&rest sexp) edebug-macrop edebug-eval-macro-args] 4]) (put (quote edebug-list-form-args) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-list-form #[(cursor) "À Â\"Ãĉ ‰‰@) ‰A)A \n‰\n ˆ  ¡ˆ+„3Ä‚9ƒÚ„DËÌ!‚Í=ƒWÎÐ !ˆÑ ‚‰Ð !Ò!‰ƒ®:ƒĉÖ \"*‚ÕÃ=ƒ × Ø\")‚ÕÙ=ƒ¡ × Ú\")‚Õ9…Õ !‚ÕÛ!ƒÎƒÄ × Ø\")‚Õ × Ú\")‚Õ × Ø\")+B‚:ƒý<ƒõ@Ý=ƒõ× Þ\"‚ß àß#‚Ëá!,‡" [edebug-top-element-required cursor "Expected elements" t nil edebug-&rest edebug-&optional edebug-gate head offsets expressions edebug-syntax-error "nil head" interactive-p check-it edebug-def-interactive edebug-move-cursor edebug-interactive-p-name get-edebug-spec spec edebug-error-point edebug-best-error edebug-match-sublist edebug-match (&rest form) 0 (&rest sexp) edebug-macrop edebug-eval-macro-args \, (("," def-form) body) edebug-match-specs (lambda-expr body) "Head of list form must be a symbol or lambda expression."] 6]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÆÇ B‡" [boundp edebug-after-dotted-spec nil current-load-list edebug-matching-depth 0 150 edebug-max-depth] 2) (defalias 'edebug-no-match #[(cursor &rest edebug-args) "†Á\n! † \f ƒ#„#ƒbˆÇÈ\f\"‡ÉÊ\f\"‡" [edebug-error-point edebug-before-offset cursor edebug-best-error edebug-args edebug-gate edebug-&optional apply edebug-syntax-error throw no-match] 3]) (defalias 'edebug-match #[(cursor specs) "À‰‰‰ ÆÆ#-‡" [nil edebug-gate edebug-error-point edebug-best-error edebug-&rest edebug-&optional edebug-match-specs cursor specs] 5]) (defalias 'edebug-match-one-spec #[(cursor spec) "9ƒ\nÁ\n\"‡Ã!ƒÄ\nÅÆ\"\"‡;ƒ\"Ç\n\"‡<…+È\n\"‡" [spec edebug-match-symbol cursor vectorp edebug-match append nil edebug-match-string edebug-match-list] 5]) (defalias 'edebug-match-specs #[(cursor specs remainder-handler) " Vƒ\fÂÃ!‚T\f„Å‚Ð\f:„+ÆÈ \fC\n#)‚Ð ‰ @)<„{„AË Ì\"ˆÅ ‰ @) ‰ A)  C ‰  ˆ ¡ˆ+È \f\n#@+‚Ð\f@Å9…ŽÓ!ÔH‰Ö=ƒ¢×! \fA\"‚ÅØ=ƒ»\fAA×! \fA@\"‚Å\fAÙ \"\n \n#¤+)‡" [edebug-matching-depth edebug-max-depth error "too deep - perhaps infinite loop in spec?" specs nil t edebug-dotted-spec edebug-match-specs cursor remainder-handler edebug-no-match "Dotted spec required." this-offset this-form offsets expressions spec rest symbol-name 0 first-char 38 get-edebug-spec 58 edebug-match-one-spec] 6]) (mapcar #[(pair) "À @ A#‡" [put pair edebug-form-spec] 4] (quote ((&optional . edebug-match-&optional) (&rest . edebug-match-&rest) (&or . edebug-match-&or) (form . edebug-match-form) (sexp . edebug-match-sexp) (body . edebug-match-body) (&define . edebug-match-&define) (name . edebug-match-name) (:name . edebug-match-colon-name) (arg . edebug-match-arg) (def-body . edebug-match-def-body) (def-form . edebug-match-def-form) (lambda-expr . edebug-match-lambda-expr) (¬ . edebug-match-¬) (&key . edebug-match-&key) (place . edebug-match-place) (gate . edebug-match-gate)))) (defalias 'edebug-match-symbol #[(cursor symbol) "À !‰ƒ\n:ƒÃ\f\n\"‚a\n\f!‚a „$Å\f!‚aÆ !ƒ]Ç\fÈ #‰ <ƒE @Ê=ƒEÃ\fË\"‚Y  !„RÌ\f Í#ˆÎ\f!ˆ C)‚aÏÐ \")‡" [get-edebug-spec symbol spec edebug-match cursor edebug-match-nil fboundp edebug-top-element-required "Expected" sexp \, (("," def-form)) edebug-no-match "failed" edebug-move-cursor error "%s is not a form-spec or function"] 5]) (defalias 'edebug-match-sexp #[(cursor) "À Â\"à !ˆC‡" [edebug-top-element-required cursor "Expected sexp" edebug-move-cursor] 3]) (defalias 'edebug-match-form #[(cursor) "À !C‡" [edebug-form cursor] 2]) (defalias (quote edebug-match-place) (quote edebug-match-form)) (defalias 'edebug-match-body #[(cursor) "ÁÂ\")‡" [cursor edebug-match (&rest form)] 3]) (put (quote edebug-match-body) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'edebug-match-&optional #[(cursor specs) "À \nÀ#‡" [edebug-&optional-wrapper cursor specs] 4]) (defalias 'edebug-&optional-wrapper #[(cursor specs remainder-handler) "À À\n‰@)\n‰A)ÈÉ„‚3\n\f \n ‰  ˆ\n\n¡ˆ+À-‡" [nil specs cursor this-offset this-form edebug-gate edebug-&optional result no-match (byte-code "À \n #Ň" [edebug-match-specs cursor specs remainder-handler result nil] 4) offsets expressions] 6]) (defalias 'edebug-&rest-wrapper #[(cursor specs remainder-handler) "„  \f#‡" [specs edebug-&rest edebug-&optional-wrapper cursor remainder-handler] 4]) (defalias 'edebug-match-&rest #[(cursor specs) "Á‰ÅÅ#+‡" [specs nil edebug-error-point edebug-best-error edebug-&rest edebug-&rest-wrapper cursor] 4]) (defalias 'edebug-match-&or #[(cursor specs) " ‰@) ‰A)ÅÆ+‡" [specs cursor this-offset this-form original-specs matched (byte-code "ƒ!ÁˆA \f ‰ ˆ ¡ˆ+‚ÈÉ Ê $‡" [specs no-match (byte-code "ÀÁ‰‰Æ@\"+\"‡" [throw matched nil edebug-error-point edebug-best-error edebug-gate edebug-match-one-spec cursor specs] 5) cursor this-form this-offset offsets expressions apply edebug-no-match "Expected one of" original-specs] 6)] 4]) (defalias 'edebug-match-¬ #[(cursor specs) "ÀÁ„  Ä\"ˆÅ‡" [no-match (byte-code "ÀŠÂ \f\"ˆ*À‡" [nil edebug-gate edebug-match-&or cursor specs] 3) edebug-no-match cursor "Unexpected" nil] 3]) (put (quote &key) (quote edebug-form-spec) (quote edebug-match-&key)) (defalias 'edebug-match-&key #[(cursor specs) "À ÂÃÄ \"B\"‡" [edebug-match-&rest cursor &or mapcar #[(pair) "ÀÁ @\" A@\"‡" [vector format ":%s" pair] 4] specs] 6]) (defalias 'edebug-match-gate #[(cursor) "À‡" [t edebug-gate nil] 1]) (defalias 'edebug-match-list #[(cursor specs) "ƒÁ \fÂ#)Á‡\f@Å Æ\f#‰É=ƒM\fA@‰9ƒE=„9Ê Æ#ˆË !ˆÌ ‚IÎÏ\f\")‚›<ƒiÐÑ ‰A@)A\"\f\"CË !ˆ‚›Ò=ƒ–Ó!ƒ–ÐÑ ‰A@)A\"\fA\"Ë !ˆÕÒ\")C‚›Ê Æ\f#*‡" [edebug-dotted-spec nil edebug-match-specs cursor specs edebug-top-element-required "Expected" form spec quote edebug-no-match edebug-move-cursor t edebug-gate error "Bad spec: %s" edebug-match-sublist edebug-new-cursor vector vectorp result apply] 6]) (defalias 'edebug-match-sublist #[(cursor specs) "À \fÂ# ‰@)ƒ\" ƒÆÇ #ˆ‚\"Ç È\f#ˆ)‡" [nil edebug-&optional edebug-match-specs cursor specs edebug-best-error apply edebug-no-match "Failed matching"] 6]) (defalias 'edebug-match-string #[(cursor spec) "À  #Å !\f=„Æ Â #‚ÇÉ !ˆ\fC)‡" [edebug-top-element-required cursor "Expected" spec sexp intern edebug-no-match t edebug-gate edebug-move-cursor] 4]) (defalias 'edebug-match-nil #[(cursor) "‰@)??…ÁÂ\"‡" [cursor edebug-no-match "Unmatched argument(s)"] 4]) (defalias 'edebug-match-function #[(cursor) "ÀÁ!‡" [error "Use function-form instead of function in edebug spec"] 2]) (defalias 'edebug-match-&define #[(cursor specs) "À  ! ‰A)‰:ƒ A‰‚\f )\f$‡" [edebug-make-form-wrapper cursor edebug-before-offset offsets specs] 6]) (defalias 'edebug-match-lambda-expr #[(cursor) "À Â\" ‰A@) :… @‰9…Æ !È :ƒI@Ê=ƒIËÌ \f\"\f@Í !Î !AB$CÏ !ˆ‚MÐ Â\"-‡" [edebug-top-element-required cursor "Expected lambda expression" sexp offset head get-edebug-spec spec nil edebug-inside-func &define edebug-defining-form edebug-new-cursor edebug-after-offset symbol-name edebug-move-cursor edebug-no-match] 7]) (defalias 'edebug-match-name #[(cursor) "À Â\"‰9„Ä Å\"ˆƒÇÈÉ #!‚ Ê !ˆ )C‡" [edebug-top-element-required cursor "Expected name" name edebug-no-match "Symbol expected for name of definition" edebug-def-name intern format "%s@%s" edebug-move-cursor] 6]) (defalias 'edebug-match-colon-name #[(cursor spec) "ƒÁÂÃ\f#!‚\fŇ" [edebug-def-name intern format "%s@%s" spec nil] 5]) (defalias 'edebug-match-arg #[(cursor) "À Â\"‰9ƒÄ !ƒÅ Æ #ˆÇ !ˆ B )C‡" [edebug-top-element-required cursor "Expected arg" edebug-arg edebug-lambda-list-keywordp edebug-no-match "Bad argument:" edebug-move-cursor edebug-def-args] 5]) (defalias 'edebug-match-def-form #[(cursor) "ÀÂÃ\f!C!)C‡" [nil edebug-inside-func edebug-make-enter-wrapper edebug-form cursor] 3]) (defalias 'edebug-match-def-body #[(cursor) "À Ä Å\")!)C‡" [t edebug-inside-func edebug-wrap-def-body cursor edebug-match (&rest form)] 4]) #@73 Return non-nil if OBJECT is a symbol with an edebug-form-spec property. (defalias 'edebug-spec-p #[(object) "9…ÁN‡" [object edebug-form-spec] 2 (#$ . 34776)]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#ˆÀÈÂÉ#ˆÀÊÂË#ˆÀËÂÌ#ˆÀÍÂÎ#ˆÀÏÂÐ#ˆÀÑÂÒ#ˆÀÒÂÓ#ˆÀÔÂÕ#ˆÀÖÂ×#ˆÀØÂÙ#ˆÀÚÂÛ#ˆÀÜÂÝ#ˆÀÞÂß#ˆÀàÂá#ˆÀâÂã#ˆÀäÂå#ˆÀæÂç#ˆÀèÂé#ˆÀêÂè#ˆÀëÂì#ˆÀíÂë#ˆÀîÂï#ˆÀðÂñ#ˆÀòÂó#ˆÀôÂõ#ˆö÷ò\"ˆÀ÷Âø#ˆÀùÂú#ˆÀûÂü#ˆÀýÂÍ#ˆÀþÂÿ#ˆÀ@Âÿ#ˆÀAÂÿ#ˆÀBÂC#ˆÀDÂE#ˆFG!„þHGGIBIGJž„GKDJBJFL!„*HLLIBIFM!„ANMMIBIFO!„XHOOIBIFP!„oHPPIBIQRRIBISIBITIBIUIBIVIBIWIBIXIBIYIBIZIBI[IBI\\IBI]IBI^IBIF_!„ó`__IBIFa!„\nHaaIBIbIBIcIBIdIBIeIBIfIBIFg!„IHggIBIFh!„`HhhIBIFi!„wHiiIBIjIBIkl!„›ölmK\"ˆH‡" [put def-edebug-spec edebug-form-spec (&define :name edebug-spec name &or "nil" edebug-spec-p "t" "0" (&rest edebug-spec)) edebug-spec-list ((edebug-spec . [&or nil edebug-spec])) edebug-spec (&or (vector &rest edebug-spec) ("vector" &rest edebug-spec) ("quote" symbolp) edebug-spec-list stringp [edebug-lambda-list-keywordp &rest edebug-spec] edebug-spec-p symbolp) quote sexp defconst defvar (symbolp &optional form stringp) defun (&define name lambda-list [&optional stringp] [&optional ("interactive" interactive)] def-body) defmacro (&define name lambda-list def-body) arglist lambda-list (([&rest arg] [&optional ["&optional" arg &rest arg]] &optional ["&rest" arg])) interactive (&optional &or stringp def-form) function-form (&or ([&or "quote" "function"] &or symbolp lambda-expr) form) function (&or symbolp lambda-expr) lambda (&define lambda-list [&optional stringp] [&optional ("interactive" interactive)] def-body) macro (&define "lambda" lambda-list def-body) mapcar (function-form form) mapconcat (function-form form form) mapatoms (function-form &optional form) apply (function-form &rest form) funcall (function-form &rest form) let ((&rest &or (symbolp &optional form) symbolp) body) let* setq (&rest symbolp form) setq-default cond (&rest (&rest form)) condition-case (symbolp form &rest (symbolp body)) \` (backquote-form) backquote-form (&or ([&or "," ",@"] &or ("quote" backquote-form) form) (backquote-form &rest backquote-form) (vector &rest backquote-form) sexp) defalias edebug-\` (def-form) \, (&or ("quote" edebug-\`) def-form) \,@ (&define &or ("quote" edebug-\`) def-form) defsubst dont-compile t eval-when-compile eval-and-compile ad-dolist ((symbolp form &optional form) body) defadvice (&define name (name name &rest sexp) [&optional stringp] [&optional ("interactive" interactive)] def-body) boundp edebug-active nil current-load-list minor-mode-alist " *Debugging*" edebug-stack edebug-stack-depth -1 edebug-offset-indices edebug-entered edebug edebug-debugger edebug-function edebug-args edebug-data edebug-value edebug-after-index edebug-def-mark edebug-freq-count edebug-coverage edebug-buffer edebug-result edebug-outside-executing-macro edebug-outside-defining-kbd-macro edebug-execution-mode step edebug-next-execution-mode edebug-outside-debug-on-error edebug-outside-debug-on-quit edebug-outside-pre-command-hook edebug-outside-post-command-hook edebug-outside-post-command-idle-hook pre-command-hook post-command-hook post-command-idle-hook cl-lexical-debug fboundp edebug-original-signal signal] 4) #@671 Signal an error. Args are SIGNAL-NAME, and associated DATA. A signal name is a symbol with an `error-conditions' property that is a list of condition names. A handler for any of those names will get to handle this signal. The symbol `error' should always be one of them. DATA should be a list. Its elements are printed as part of the error message. If the signal is handled, DATA is made available to the handler. See `condition-case'. This is the Edebug replacement for the standard `signal'. It should only be active while Edebug is. It checks `debug-on-error' to see whether it should call the debugger. When execution is resumed, the error is signaled again. (defalias 'edebug-signal #[(edebug-signal-name edebug-signal-data) "<ƒ >ƒÂà \fB\"ˆÅ \f\"‡" [debug-on-error edebug-signal-name edebug error edebug-signal-data edebug-original-signal] 4 (#$ . 38179)]) (defalias 'edebug-enter #[(edebug-function edebug-args edebug-body) "„pÁ\nÃ\\\fÅ\\† \nÁ \f ׎…C Ù‰‰ \f †Z†ZÙÝÞMˆßŽà!\"##.‡!äN‰%@&!çN'!èN(é&!*!+B+ì-B-!îNƒ³ï!îNð=ƒ³ñ!îÙ#ˆ2ƒ¿ó#!‚Â# .‡" [edebug-entered t max-lisp-eval-depth 100 max-specpdl-size 200 edebug-debugger debug-on-error debug-on-quit edebug-on-error edebug-on-quit executing-macro pre-command-hook post-command-hook post-command-idle-hook edebug-outside-post-command-idle-hook edebug-outside-post-command-hook edebug-outside-pre-command-hook edebug-outside-executing-macro cl-lexical-debug edebug-outside-debug-on-quit edebug-outside-debug-on-error debugger ((byte-code "\n\fȇ" [edebug-outside-executing-macro executing-macro edebug-outside-pre-command-hook pre-command-hook edebug-outside-post-command-hook post-command-hook edebug-outside-post-command-idle-hook post-command-idle-hook nil] 1)) edebug-continue-kbd-macro nil edebug-next-execution-mode edebug-initial-mode edebug-execution-mode signal edebug-signal ((byte-code "ÀÁKM‡" [signal edebug-original-signal] 2)) edebug-enter edebug-function edebug-args edebug-body edebug edebug-data edebug-def-mark edebug-freq-count edebug-coverage marker-buffer edebug-buffer edebug-stack 0 edebug-offset-indices edebug-on-entry step temp put edebug-trace edebug-enter-trace] 14]) (defalias 'edebug-enter-trace #[(edebug-body) "TÁÃÄÅ#!ˆ ‰ÉÄÊ\n#!ˆ*‡" [edebug-stack-depth nil edebug-result edebug-print-trace-before format "%s args: %s" edebug-function edebug-args edebug-body edebug-print-trace-after "%s result: %s"] 6]) (put (quote edebug-tracing) (quote edebug-form-spec) (quote (form body))) #@99 Print MSG in *edebug-trace* before and after evaluating BODY. The result of BODY is also printed. (defalias 'edebug-tracing '(macro . #[(msg &rest body) "ÀÁ DÄÅÆÇBEÉÊË ÌBBBDEF‡" [let ((edebug-stack-depth (1+ edebug-stack-depth)) edebug-result) edebug-print-trace-before msg prog1 setq edebug-result progn body edebug-print-trace-after format "%s result: %s" (edebug-result)] 10 (#$ . 40772)])) #@98 Function called to print trace info before expression evaluation. MSG is printed after `::::{ '. (defalias 'edebug-print-trace-before #[(msg) "À ÂÃ\fÅ\"$‡" [edebug-trace-display edebug-trace-buffer "%s{ %s" make-string edebug-stack-depth 58 msg] 6 (#$ . 41175)]) #@97 Function called to print trace info after expression evaluation. MSG is printed after `::::} '. (defalias 'edebug-print-trace-after #[(msg) "À ÂÃ\fÅ\"$‡" [edebug-trace-display edebug-trace-buffer "%s} %s" make-string edebug-stack-depth 58 msg] 6 (#$ . 41446)]) (defalias 'edebug-slow-before #[(edebug-before-index) "  ˆ\n \n HTIˆ Ä>ƒÅ ƒÆ ÇÈ#ˆ ‡" [edebug-offset-indices edebug-before-index edebug-freq-count edebug-execution-mode (Go-nonstop next) edebug-input-pending-p edebug-debugger before nil] 4]) (defalias 'edebug-fast-before #[(edebug-before-index) "À‡" [nil] 1]) (defalias 'edebug-slow-after #[(edebug-before-index edebug-after-index edebug-value) "  ˆ\n \n HTIˆ ƒÄ ˆ Æ=ƒ!Ç „!‡É Ê#‡" [edebug-offset-indices edebug-after-index edebug-freq-count edebug-test-coverage edebug-update-coverage edebug-execution-mode Go-nonstop edebug-input-pending-p edebug-value edebug-debugger after] 4]) (defalias 'edebug-fast-after #[(edebug-before-index edebug-after-index edebug-value) "‡" [edebug-value] 1]) (defalias 'edebug-run-slow #[nil "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias edebug-before edebug-slow-before edebug-after edebug-slow-after] 3]) (defalias 'edebug-run-fast #[nil "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias edebug-before edebug-fast-before edebug-after edebug-fast-after] 3]) (edebug-run-slow) (defalias 'edebug-update-coverage #[nil " H‰Ã=†\"\nÄ=ƒ I‚\" \n=?…\" ÃI)‡" [edebug-coverage edebug-after-index old-result ok-coverage unknown edebug-value] 4]) (byte-code "À B Bà BÄ BÅ BÆ BÇÈ!„!ÉÈ BÇÊ!„.É\nÊ Bɇ" [edebug-arg-mode current-load-list edebug-breakpoints edebug-break-data edebug-break edebug-global-break edebug-break-condition boundp edebug-break-result nil edebug-global-break-result] 2) (defalias 'edebug-debugger #[(edebug-offset-index edebug-arg-mode edebug-value) "A@\n ž‰A@ …ÆÇÈ Æ\n †- …-\f?†-Ë\f!‰\f‰\nƒDÍ 8ƒDÎ \"AAB¡ˆÐ>ƒU\n„UÑ ƒXÒ ˆ-‡" [edebug-data edebug-breakpoints edebug-offset-index edebug-break-data edebug-break-condition edebug-global-break-condition nil (byte-code "À !‰‡" [eval edebug-global-break-condition edebug-global-break-result] 2) ((error)) edebug-global-break edebug-break eval edebug-break-result 2 delq edebug-execution-mode (go continue Continue-fast) edebug-input-pending-p edebug-display edebug-value] 5]) (byte-code "À B Bà BÄ BÅ BÆ BÇ BÈ BÉ BÊ BËÌ!„1Í\fÌ BËÎ!„>ÍÎ BÏÐÑ\"ˆÏÒÓ\"‡" [edebug-point current-load-list edebug-outside-buffer edebug-outside-point edebug-outside-mark edebug-window-data edebug-outside-windows edebug-eval-buffer edebug-outside-o-a-p edebug-outside-o-a-s edebug-outside-c-i-e-a boundp edebug-eval-list nil edebug-previous-result defalias edebug-mark mark edebug-mark-marker mark-marker] 3) (defalias 'edebug-display #[nil "ÀÁ\nÃ\f8 H\\ÁÆ\f8Ç p`È Á‰‰ …Ê Á‰ \f \nߎ \fÁ \f à!!„gÁ\"ãä%\"ˆ)&ç=ƒsè)!ˆ*ƒ~ë*!,ƒ‡í î!@\"ˆÇ  ˆï\n!ˆð@!ˆ!qˆ`bˆ&ñ=ƒÂgò>„ÂÁ\"ãó%\"ˆ)ôA!¡ˆõ ƒÙö7ÀÝ ˆø ˆ&ã=ƒö7ø ˆù ˆ)@ú=ƒûûü!ˆ‚Dý)!ˆ‚D>ƒ>?ƒû@AB#ˆ‚DCƒ,ûDCE#ˆ‚D7F=„DûG!ˆ‚DûH!ˆ&ç=ƒf>ƒa7F=„aIJ!ˆK ˆ>ƒ™7L=ƒMJ!ˆ‚¾7F=ƒ“MN!ˆ‚¾À‚¾7O=ƒ­MJ!ˆ‚¾7P=ƒ¾MN!ˆQŽ„×7R>„×&ã=ƒÜS ˆ)pT!qˆbˆTq.‡" [t nil edebug-def-mark 2 edebug-data edebug-offset-index 3 selected-window edebug-mark edebug-eval-list edebug-eval-result-list overlay-arrow-position overlay-arrow-string cursor-in-echo-area edebug-outside-c-i-e-a edebug-outside-o-a-s edebug-outside-o-a-p edebug-trace-window-start edebug-trace-window edebug-eval-buffer edebug-buffer-points edebug-outside-windows edebug-outside-mark edebug-outside-point edebug-outside-buffer edebug-outside-window edebug-window-data edebug-buffer-outside-point edebug-point edebug-stop edebug-active ((byte-code "\n\fƇ" [edebug-outside-o-a-p overlay-arrow-position edebug-outside-o-a-s overlay-arrow-string edebug-outside-c-i-e-a cursor-in-echo-area nil] 1)) buffer-name edebug-buffer debug-on-error error "Buffer defining %s not found" edebug-function edebug-arg-mode after edebug-compute-previous-result edebug-value edebug-save-windows edebug-current-windows edebug-save-displayed-buffer-points edebug-get-displayed-buffer-points edebug-pop-to-buffer edebug-eval-display select-window before (40 35 96) "Source has changed - reevaluate definition of %s" edebug-adjust-window edebug-input-pending-p step edebug-execution-mode edebug-overlay-arrow beep quit message "Quit" edebug-report-error edebug-break edebug-global-break "Global Break: %s => %s" edebug-global-break-condition edebug-global-break-result edebug-break-condition "Break: %s => %s" edebug-break-result Continue-fast "Break" "" sit-for 1 edebug-previous-result continue edebug-sit-for 0 trace Trace-fast ((byte-code "À =ƒ\f ‚à !‰ƒ \f ˆ Æ\f!¡ˆ)Ç!‰ ƒ4 …2Æ !\n ƒsÌ !ˆƒHÏ!ˆ ƒTÑ \n\"ˆ @‰ƒoÒ\f!ƒoÀ =ƒoÑ\f AÓ#ˆ)‚Ò!ƒÕ!ˆqˆ =„ŽbˆØÙ !ƒœÙ Û“ˆÛ‡" [window-buffer edebug-buffer selected-window edebug-get-buffer-window window edebug-window-data window-start get-buffer-window edebug-trace-buffer edebug-trace-window edebug-trace-window-start edebug-save-windows edebug-set-windows edebug-outside-windows edebug-save-displayed-buffer-points edebug-set-buffer-points edebug-buffer-points set-window-start edebug-window-live-p no-force edebug-outside-window select-window edebug-outside-buffer edebug-outside-point marker-buffer edebug-mark-marker edebug-outside-mark nil] 5)) (step next) edebug-recursive-edit current-buffer] 18]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÅ BÆ BÇ BÈ BÉ BÊ BË BÌ BÍ BÎ BÏ BÐ BÑ BÀÒ!„UÓÒ BÔ BÕ BÖ B× BØ BÙ BÚ BÛ BÓ‡" [boundp edebug-number-of-recursions 0 current-load-list edebug-recursion-depth edebug-outside-match-data edebug-backtrace-buffer edebug-inside-windows edebug-interactive-p edebug-outside-map edebug-outside-standard-output edebug-outside-standard-input edebug-outside-last-command-char edebug-outside-last-command edebug-outside-this-command edebug-outside-last-input-char edebug-outside-unread-command-char edebug-outside-unread-command-event unread-command-event nil edebug-outside-last-command-event edebug-outside-unread-command-events edebug-outside-last-input-event edebug-outside-last-event-frame edebug-outside-last-nonmenu-event edebug-outside-track-mouse edebug-unread-command-char-warning edebug-unread-command-event-warning] 2) (defalias 'edebug-recursive-edit #[nil "Š qˆÂ )à ĉ‰‰Å  \n \f  !\"#$%&'()*+ìŽ \n \fíĉ‰‰‰‰‰./0…y12 \f \n óô!ƒ ô ˆ5ö=ƒ²7ø>„²ùú!ˆûüýKMˆþ ˆÿŽ@ .(‡" [buffer-read-only edebug-outside-buffer match-data recursion-depth nil current-local-map standard-output standard-input defining-kbd-macro last-command-char last-command this-command last-input-char unread-command-char last-input-event last-command-event unread-command-event unread-command-events last-event-frame last-nonmenu-event track-mouse edebug-outside-track-mouse edebug-outside-last-nonmenu-event edebug-outside-last-event-frame edebug-outside-unread-command-events edebug-outside-unread-command-event edebug-outside-last-command-event edebug-outside-last-input-event edebug-outside-unread-command-char edebug-outside-last-input-char edebug-outside-this-command edebug-outside-last-command edebug-outside-last-command-char edebug-outside-defining-kbd-macro edebug-outside-standard-input edebug-outside-standard-output edebug-outside-map edebug-inside-windows edebug-backtrace-buffer edebug-interactive-p edebug-entered edebug-recursion-depth edebug-outside-match-data edebug-buffer-read-only ((byte-code "\n\f \n \f Þ‡" [edebug-outside-last-command-char last-command-char edebug-outside-last-command-event last-command-event edebug-outside-last-command last-command edebug-outside-this-command this-command edebug-outside-unread-command-char unread-command-char edebug-outside-unread-command-event unread-command-event edebug-outside-unread-command-events unread-command-events edebug-outside-last-input-char last-input-char edebug-outside-last-input-event last-input-event edebug-outside-last-event-frame last-event-frame edebug-outside-last-nonmenu-event last-nonmenu-event edebug-outside-track-mouse track-mouse edebug-outside-standard-output standard-output edebug-outside-standard-input standard-input edebug-outside-defining-kbd-macro defining-kbd-macro nil] 1)) -1 edebug-outside-debug-on-error edebug-outside-debug-on-quit edebug-continue-kbd-macro debug-on-quit debug-on-error fboundp zmacs-deactivate-region edebug-execution-mode go edebug-arg-mode (after error) message "Break" t signal edebug-original-signal edebug-mode ((byte-code "ÀÁMˆ\nƒ\fÃ\n!ˆ\fƒÃ\f!ˆÅ!ˆÇ!ƒ:qˆ Ê>ƒ.Ë ˆ\f Î!ˆ‚>ÐÑ!ˆÀ‡" [signal edebug-signal edebug-backtrace-buffer kill-buffer edebug-eval-buffer store-match-data edebug-outside-match-data buffer-name edebug-buffer edebug-execution-mode (go Go-nonstop) edebug-overlay-arrow edebug-buffer-read-only buffer-read-only use-local-map edebug-outside-map get-buffer-create " bogus edebug buffer"] 2)) recursive-edit] 23]) (defalias 'edebug-adjust-window #[(old-start) "À „1 ƒÂà \"ˆÀ „1Âà Š`Ä Wƒ#Å‚(Æ Ç¥[yˆÈyˆ`)\"ˆÄ ‡" [pos-visible-in-window-p old-start set-window-start selected-window window-start -1 window-height 2 0] 4]) #@50 Association list of arrows for each edebug mode. (defconst edebug-arrow-alist (quote ((Continue-fast . "=") (Trace-fast . "-") (continue . ">") (trace . "->") (step . "=>") (next . "=>") (go . "<>") (Go-nonstop . ".."))) (#$ . 50841)) (defalias 'edebug-overlay-arrow #[nil "ŠÀyˆ`)\n žAÅ ‰ p“)‡" [0 pos edebug-execution-mode edebug-arrow-alist overlay-arrow-string make-marker overlay-arrow-position] 4]) #@174 Toggle the saving and restoring of all windows. Also, each time you toggle it on, the inside and outside window configurations become the same as the current configuration. (defalias 'edebug-toggle-save-all-windows #[nil "?‰ƒ Á!‰ÄŃƂÇ\"‡" [edebug-save-windows edebug-current-windows edebug-outside-windows edebug-inside-windows message "Window saving is %s for all windows." "on" "off"] 4 (#$ . 51256) nil]) (defalias 'edebug-changing-windows '(macro . #[(&rest body) "ÀÁÂÃÄ Æ\"BBBB‡" [let ((window (selected-window))) (setq edebug-inside-windows (edebug-current-windows t)) (edebug-set-windows edebug-outside-windows) append body ((setq edebug-outside-windows (edebug-current-windows edebug-save-windows)) (edebug-set-windows edebug-inside-windows))] 7])) #@183 Toggle the saving and restoring of the selected window. Also, each time you toggle it on, the inside and outside window configurations become the same as the current configuration. (defalias 'edebug-toggle-save-selected-window #[nil "Á=ƒ% ÄÁ!Æ!ˆÈ É \"Ä!Æ !ˆ)‚Z >ƒ@È ž\"È \"‚Z ÄÁ!Æ!ˆ BÄ!Æ !ˆ)ÊË >ƒgÌ‚hÍ #‡" [edebug-save-windows t selected-window window edebug-current-windows edebug-inside-windows edebug-set-windows edebug-outside-windows delq edebug-window-list message "Window saving is %s for %s." "on" "off"] 4 (#$ . 52032) nil]) #@130 Toggle the saving and restoring of windows. With prefix, toggle for just the selected window. Otherwise, toggle for all windows. (defalias 'edebug-toggle-save-windows #[(arg) "ƒÁ ‡Â ‡" [arg edebug-toggle-save-selected-window edebug-toggle-save-all-windows] 1 (#$ . 52615) "P"]) #@61 Show the debug windows and where we stopped in the program. (defalias 'edebug-where #[nil "„ÁÂ!ˆÃ\f!ˆ b‡" [edebug-active error "Edebug is not active" edebug-pop-to-buffer edebug-buffer edebug-point] 2 (#$ . 52902) nil]) #@45 Change to the outside window configuration. (defalias 'edebug-view-outside #[nil "„ÁÂ!ˆÃ\f!Æ!ˆbˆÉÊËÌ!\"‡" [edebug-active error "Edebug is not active" edebug-current-windows edebug-save-windows edebug-inside-windows edebug-set-windows edebug-outside-windows edebug-outside-point message "Window configuration outside of Edebug. Return with %s" substitute-command-keys "\\\\[edebug-where]"] 4 (#$ . 53131) nil]) #@147 Bounce the point in the outside current buffer. If prefix arg is supplied, sit for that many seconds before returning. The default is one second. (defalias 'edebug-bounce-point #[(arg) "„ÁÂ!ˆŠÃ‹)‡" [edebug-active error "Edebug is not active" ((byte-code "À !ˆ\nbˆÃÄp`ÅÆ !ƒÇÆ !‚È$ˆÉ\n!ˆÀ \f@\"‡" [edebug-pop-to-buffer edebug-outside-buffer edebug-outside-point message "Current buffer: %s Point: %s Mark: %s" marker-buffer edebug-mark-marker marker-position "" edebug-sit-for arg edebug-buffer edebug-window-data] 6))] 2 (#$ . 53569) "p"]) (defalias 'edebug-find-stop-point #[nil "À ‰ÂN‰ƒÄ !ƒÅÆ \"ˆ )‰@É8\nŠËÌ!ƒ/ÍÎxˆ`)ZÎÎ\nGÒÒWƒ_\nHVƒ_T‰‚EWƒy\nHXƒy B‚}ÓÔ \".‡" [edebug-form-data-symbol edebug-def-name edebug data markerp error "%s is not instrumented for Edebug" edebug-data edebug-def-mark 2 offset-vector looking-at "[ ]" " " nil offset len i 0 message "Point is not on an expression in %s."] 4]) #@65 Move point to the next breakpoint, or first if none past point. (defalias 'edebug-next-breakpoint #[nil "À ‰…ˆ @ A\nÄN‰@ A@È 8 Ê „-ÌÍ!‚†‰ƒG@@ XƒGA‰„5ƒR@‚U@   @H\\bˆÌÈ 8ƒnÏ‚oÐ A@ƒ‚ÑÒÓ A@!\"‚ƒÐP!).)‡" [edebug-find-stop-point edebug-stop-point edebug-def-name index edebug edebug-data edebug-def-mark edebug-breakpoints 2 offset-vector nil breakpoint message "No breakpoints in this function." breaks "Temporary " "" format "Condition: %s" edebug-safe-prin1-to-string] 7 (#$ . 54551) nil]) #@207 Modify the breakpoint for the form at point or after it according to FLAG: set if t, clear if nil. Then move to that point. If CONDITION or TEMPORARY are non-nil, add those attributes to the breakpoint.  (defalias 'edebug-modify-breakpoint #[(flag &optional condition temporary) "À ‰…{ @ A\nÄN‰@ A@È 8 Ê ž Ì \" ƒZÎ EBÑ\"ƒRÒÓ\n#ˆ‚kÒÔ\n\"ˆ‚k ƒgÒÕ\n\"ˆ‚kÒÖ!ˆ A ˆ H\\b.)‡" [edebug-find-stop-point edebug-stop-point edebug-def-name index edebug edebug-data edebug-def-mark edebug-breakpoints 2 offset-vector nil present delq flag edebug-sort-alist condition temporary < message "Breakpoint set in %s with condition: %s" "Breakpoint set in %s" "Breakpoint unset in %s" "No breakpoint here"] 5 (#$ . 55094)]) #@91 Set the breakpoint of nearest sexp. With prefix argument, make it a temporary breakpoint. (defalias 'edebug-set-breakpoint #[(arg) "ÀÁ #‡" [edebug-modify-breakpoint t nil arg] 4 (#$ . 55851) "P"]) #@39 Clear the breakpoint of nearest sexp. (defalias 'edebug-unset-breakpoint #[nil "ÀÁ!‡" [edebug-modify-breakpoint nil] 2 (#$ . 56055) nil]) #@152 Set a conditional breakpoint at nearest sexp. The condition is evaluated in the outside context. With prefix argument, make it a temporary breakpoint. (defalias 'edebug-set-conditional-breakpoint #[(arg condition) "ÀÁ\n #‡" [edebug-modify-breakpoint t condition arg] 4 (#$ . 56200) (list current-prefix-arg (let ((edebug-stop-point (edebug-find-stop-point))) (if edebug-stop-point (let* ((edebug-def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) (edebug-data (get edebug-def-name (quote edebug))) (edebug-breakpoints (car (cdr edebug-data))) (edebug-break-data (assq index edebug-breakpoints)) (edebug-break-condition (car (cdr edebug-break-data)))) (read-minibuffer (format "Condition in %s: " edebug-def-name) (if edebug-break-condition (format "%s" edebug-break-condition) (format "")))))))]) (defalias 'edebug-set-global-break-condition #[(expression) "‰‡" [expression edebug-global-break-condition] 2 nil (list (read-minibuffer "Global Condition: " (format "%s" edebug-global-break-condition)))]) (defalias 'edebug-set-mode #[(mode shortmsg msg) "TÁ =ƒ\nÄ !ˆÆ ‡\nÄ!‡" [edebug-recursion-depth recursion-depth mode edebug-execution-mode message shortmsg exit-recursive-edit edebug-next-execution-mode msg] 2]) (defalias (quote edebug-step-through-mode) (quote edebug-step-mode)) #@29 Proceed to next stop point. (defalias 'edebug-step-mode #[nil "ÀÁÂÃ#‡" [edebug-set-mode step "" "Edebug will stop at next stop point."] 4 (#$ . 57514) nil]) #@37 Proceed to next `after' stop point. (defalias 'edebug-next-mode #[nil "ÀÁÂÃ#‡" [edebug-set-mode next "" "Edebug will stop after next eval."] 4 (#$ . 57677) nil]) #@91 Go, evaluating until break. With prefix ARG, set temporary break at current point and go. (defalias 'edebug-go-mode #[(arg) "ƒÁÂ!ˆÃÄÅÆ#‡" [arg edebug-set-breakpoint t edebug-set-mode go "Go..." "Edebug will go until break."] 4 (#$ . 57845) "P"]) #@35 Go, evaluating without debugging. (defalias 'edebug-Go-nonstop-mode #[nil "ÀÁÂÃ#‡" [edebug-set-mode Go-nonstop "Go-Nonstop..." "Edebug will not stop at breaks."] 4 (#$ . 58100) nil]) #@19 Begin trace mode. (defalias 'edebug-trace-mode #[nil "ÀÁÂÃ#‡" [edebug-set-mode trace "Tracing..." "Edebug will trace with pause."] 4 (#$ . 58289) nil]) #@34 Trace with no wait at each step. (defalias 'edebug-Trace-fast-mode #[nil "ÀÁÂÃ#‡" [edebug-set-mode Trace-fast "Trace fast..." "Edebug will trace without pause."] 4 (#$ . 58447) nil]) #@22 Begin continue mode. (defalias 'edebug-continue-mode #[nil "ÀÁÂÃ#‡" [edebug-set-mode continue "Continue..." "Edebug will pause at breakpoints."] 4 (#$ . 58636) nil]) #@34 Trace with no wait at each step. (defalias 'edebug-Continue-fast-mode #[nil "ÀÁÂÃ#‡" [edebug-set-mode Continue-fast "Continue fast..." "Edebug will stop and go at breakpoints."] 4 (#$ . 58808) nil]) #@29 Proceed to this stop point. (defalias 'edebug-goto-here #[nil "ÀÁ!‡" [edebug-go-mode t] 2 (#$ . 59013) nil]) #@85 Stop execution and do not continue. Useful for exiting from trace or continue loop. (defalias 'edebug-stop #[nil "ÀÁ!‡" [message "Stop"] 2 (#$ . 59128) nil]) #@127 Proceed from the current point to the end of the ARGth sexp ahead. If there are not ARG sexps ahead, then do edebug-step-out. (defalias 'edebug-forward-sexp #[(arg) "ÀÁ‡" [nil (byte-code "À !ˆÄÀ!)‡" [t parse-sexp-ignore-comments forward-sexp arg edebug-go-mode] 2) ((error (edebug-step-out)))] 3 (#$ . 59293) "p"]) #@204 Proceed from the current point to the end of the containing sexp. If there is no containing sexp that is not the top level defun, go to the end of the last sexp, or if that is the same point, then step. (defalias 'edebug-step-out #[nil "ÀÁ‡" [nil (byte-code "ÀÂÃ!ˆŠÂÃ!ˆ)ÄÀ!)‡" [t parse-sexp-ignore-comments up-list 1 edebug-go-mode] 2) ((error (byte-code "`ÁÂ!ˆ`Uƒà ‚ÄÅ!)‡" [start-point down-list -1 edebug-step-mode edebug-go-mode t] 2)))] 3 (#$ . 59619) nil]) (defalias 'edebug-instrument-function #[(func) "À\nÃNÄ !ƒŠÅ !qˆ bˆÆ ˆ\n)‚1 :ƒ+ÇÈ\n\"ˆ\n‚1ÉÊ\n\"ˆÀ)‡" [nil func-marker func edebug markerp marker-buffer edebug-eval-top-level-form message "%s is already instrumented." error "Don't know where %s is defined"] 3]) #@265 Instrument the definition of the function or macro about to be called. Do this when stopped before the form or it will be too late. One side effect of using this command is that the next time the function or macro is called, Edebug will be called there as well. (defalias 'edebug-instrument-callee #[nil "ÀÁ!„\nÂÃ!‡ŠÄÅ!ˆÀÁ!ƒ Æ`!‰@)‚#Èp!) Ê !)‡" [looking-at "(" error "You must be before a list form" down-list 1 edebug-get-form-data-entry entry edebug-original-read func edebug-instrument-function] 3 (#$ . 60365) nil]) #@211 Step into the definition of the function or macro about to be called. This first does `edebug-instrument-callee' to ensure that it is instrumented. Then it does `edebug-on-entry' and switches to `go' mode. (defalias 'edebug-step-in #[nil "À ‰… Ã\"ˆÄÅ!)‡" [edebug-instrument-callee func edebug-on-entry temp edebug-go-mode nil] 4 (#$ . 60901) nil]) #@162 Cause Edebug to stop when FUNCTION is called. With prefix argument, make this temporary so it is automatically cancelled the first time the function is entered. (defalias 'edebug-on-entry #[(function &optional flag) "À  ƒ Ä‚\fÅ#‡" [put function edebug-on-entry flag temp t] 4 (#$ . 61264) "aEdebug on entry to: \nP"]) (defalias 'cancel-edebug-on-entry #[(function) "À ÂÃ#‡" [put function edebug-on-entry nil] 4 nil "aEdebug on entry to: "]) (byte-code "ÀÁ!„ ÁÂKMˆÀ‡" [fboundp edebug-original-debug-on-entry debug-on-entry] 2) #@120 Set mode to Go-nonstop, and exit to top-level. This is useful for exiting even if unwind-protect code may be executed. (defalias 'edebug-top-level-nonstop #[nil "À ‡" [Go-nonstop edebug-execution-mode top-level] 1 (#$ . 61801) nil]) (put (quote edebug-outside-excursion) (quote edebug-form-spec) t) #@95 Evaluate an expression list in the outside context. Return the result of the last expression. (defalias 'edebug-outside-excursion '(macro . #[(&rest body) "ÀÁÂÃÄÅÆÀÇÈÉ\nBBBBËBBE¯‡" [save-excursion (if edebug-save-windows (progn (setq edebug-inside-windows (edebug-current-windows edebug-save-windows)) (edebug-set-windows edebug-outside-windows))) (set-buffer edebug-buffer) (store-match-data edebug-outside-match-data) let ((last-command-char edebug-outside-last-command-char) (last-command-event edebug-outside-last-command-event) (last-command edebug-outside-last-command) (this-command edebug-outside-this-command) (unread-command-char edebug-outside-unread-command-char) (unread-command-event edebug-outside-unread-command-event) (unread-command-events edebug-outside-unread-command-events) (last-input-char edebug-outside-last-input-char) (last-input-event edebug-outside-last-input-event) (last-event-frame edebug-outside-last-event-frame) (last-nonmenu-event edebug-outside-last-nonmenu-event) (track-mouse edebug-outside-track-mouse) (standard-output edebug-outside-standard-output) (standard-input edebug-outside-standard-input) (executing-macro edebug-outside-executing-macro) (defining-kbd-macro edebug-outside-defining-kbd-macro) (pre-command-hook edebug-outside-pre-command-hook) (post-command-hook edebug-outside-post-command-hook) (post-command-idle-hook edebug-outside-post-command-idle-hook) (overlay-arrow-position edebug-outside-o-a-p) (overlay-arrow-string edebug-outside-o-a-s) (cursor-in-echo-area edebug-outside-c-i-e-a)) unwind-protect (set-buffer edebug-outside-buffer) (goto-char edebug-outside-point) (if (marker-buffer (edebug-mark-marker)) (set-marker (edebug-mark-marker) edebug-outside-mark)) body ((if edebug-save-windows (edebug-set-windows edebug-inside-windows)) (setq edebug-outside-last-command-char last-command-char edebug-outside-last-command-event last-command-event edebug-outside-last-command last-command edebug-outside-this-command this-command edebug-outside-unread-command-char unread-command-char edebug-outside-unread-command-event unread-command-event edebug-outside-unread-command-events unread-command-events edebug-outside-last-input-char last-input-char edebug-outside-last-input-event last-input-event edebug-outside-last-event-frame last-event-frame edebug-outside-last-nonmenu-event last-nonmenu-event edebug-outside-track-mouse track-mouse edebug-outside-standard-output standard-output edebug-outside-standard-input standard-input edebug-outside-executing-macro executing-macro edebug-outside-defining-kbd-macro defining-kbd-macro edebug-outside-pre-command-hook pre-command-hook edebug-outside-post-command-hook post-command-hook edebug-outside-post-command-idle-hook post-command-idle-hook edebug-outside-o-a-p overlay-arrow-position edebug-outside-o-a-s overlay-arrow-string edebug-outside-c-i-e-a cursor-in-echo-area))] 12 (#$ . 62108)])) (byte-code "ÀÁ!„ÂÁ B‡" [boundp cl-debug-env nil current-load-list] 2) (defalias 'edebug-eval #[(edebug-expr) "ƒ Á \"!‡Á !‡" [cl-debug-env eval cl-macroexpand-all edebug-expr] 4]) (defalias 'edebug-safe-eval #[(edebug-expr) "ÀÁ‡" [edebug-err (edebug-eval edebug-expr) ((error (byte-code "ÀÁ\n@ÃN\nA@#‡" [edebug-format "%s: %s" edebug-err error-message] 4)))] 3]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÄ\"‡" [defalias edebug-install-custom-print-funcs edebug-install-custom-print edebug-reset-print-funcs edebug-uninstall-custom-print edebug-uninstall-custom-print-funcs] 3) #@62 Replace print functions used by Edebug with custom versions. (defalias 'edebug-install-custom-print #[nil "ÀÁ!ˆÂÃÄ\"ˆÂÅÆ\"ˆÂÇÈ\"ˆÂÉÊ\"ˆÂËÌ\"ˆÍ‡" [require cust-print defalias edebug-prin1 custom-prin1 edebug-print custom-print edebug-prin1-to-string custom-prin1-to-string edebug-format custom-format edebug-message custom-message "Installed"] 3 (#$ . 65591) nil]) #@63 Replace edebug custom print functions with internal versions. (defalias 'edebug-uninstall-custom-print #[nil "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆË‡" [defalias edebug-prin1 prin1 edebug-print print edebug-prin1-to-string prin1-to-string edebug-format format edebug-message message "Uninstalled"] 3 (#$ . 65961) nil]) (edebug-uninstall-custom-print) (defalias 'edebug-report-error #[(edebug-value) "ÀÁ\n@ÃN†ÄÅ\n@\"ÆÇ\nAÈ##‡" [message "%s: %s" edebug-value error-message format "peculiar error (%s)" mapconcat #[(edebug-arg) "À !‡" [prin1-to-string edebug-arg] 2] ", "] 7]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÅ B‡" [boundp print-level nil current-load-list print-circle print-readably] 2) (defalias 'edebug-safe-prin1-to-string #[(value) "À †\n † \f †Ç Ê !-‡" [t edebug-print-length print-length edebug-print-level print-level edebug-print-circle print-circle nil print-readably print-escape-newlines edebug-prin1-to-string value] 5]) (defalias 'edebug-compute-previous-result #[(edebug-previous-value) "§ƒÁWƒÂYƒÃÄÅ!#‚)ƒ$Ç!ÈÉ!P‰\n‡" [edebug-previous-value 256 0 format "Result: %s = %s" single-key-description edebug-unwrap-results edebug-unwrap* "Result: " edebug-safe-prin1-to-string edebug-previous-result] 5]) #@28 Print the previous result. (defalias 'edebug-previous-result #[nil "ÀÁ\n\"‡" [message "%s" edebug-previous-result] 3 (#$ . 67212) nil]) #@125 Evaluate an expression in the outside environment. If interactive, prompt for the expression. Print result in minibuffer. (defalias 'edebug-eval-expression #[(edebug-expr) "ÀŠ ƒ !Ä !ˆqˆÇ!ˆ \n \f  !\"#$%&'()*+,-./01234õŽŠ6qˆ7bˆøù !ƒˆù :û“ˆü=!>B>ÿ>@!.!‡" [princ edebug-save-windows edebug-current-windows edebug-inside-windows edebug-set-windows edebug-outside-windows edebug-buffer store-match-data edebug-outside-match-data edebug-outside-last-command-char edebug-outside-last-command-event edebug-outside-last-command edebug-outside-this-command edebug-outside-unread-command-char edebug-outside-unread-command-event edebug-outside-unread-command-events edebug-outside-last-input-char edebug-outside-last-input-event edebug-outside-last-event-frame edebug-outside-last-nonmenu-event edebug-outside-track-mouse edebug-outside-standard-output edebug-outside-standard-input edebug-outside-executing-macro edebug-outside-defining-kbd-macro edebug-outside-pre-command-hook edebug-outside-post-command-hook edebug-outside-post-command-idle-hook edebug-outside-o-a-p edebug-outside-o-a-s edebug-outside-c-i-e-a cursor-in-echo-area overlay-arrow-string overlay-arrow-position post-command-idle-hook post-command-hook pre-command-hook defining-kbd-macro executing-macro standard-input standard-output track-mouse last-nonmenu-event last-event-frame last-input-event last-input-char unread-command-events unread-command-event unread-command-char this-command last-command last-command-event last-command-char ((byte-code "ƒÁ\n!ˆ   \n \f  !\"#$%&'()*+,-.Á‡" [edebug-save-windows edebug-set-windows edebug-inside-windows last-command-char edebug-outside-last-command-char last-command-event edebug-outside-last-command-event last-command edebug-outside-last-command this-command edebug-outside-this-command unread-command-char edebug-outside-unread-command-char unread-command-event edebug-outside-unread-command-event unread-command-events edebug-outside-unread-command-events last-input-char edebug-outside-last-input-char last-input-event edebug-outside-last-input-event last-event-frame edebug-outside-last-event-frame last-nonmenu-event edebug-outside-last-nonmenu-event track-mouse edebug-outside-track-mouse standard-output edebug-outside-standard-output standard-input edebug-outside-standard-input executing-macro edebug-outside-executing-macro defining-kbd-macro edebug-outside-defining-kbd-macro pre-command-hook edebug-outside-pre-command-hook post-command-hook edebug-outside-post-command-hook post-command-idle-hook edebug-outside-post-command-idle-hook overlay-arrow-position edebug-outside-o-a-p overlay-arrow-string edebug-outside-o-a-s cursor-in-echo-area edebug-outside-c-i-e-a] 2)) edebug-outside-buffer edebug-outside-point marker-buffer edebug-mark-marker edebug-outside-mark nil edebug-eval edebug-expr values edebug-safe-prin1-to-string] 23 (#$ . 67355) "xEval: "]) #@83 Evaluate sexp before point in the outside environment; print value in minibuffer. (defalias 'edebug-eval-last-sexp #[nil "ÀÁ !‡" [edebug-eval-expression edebug-last-sexp] 2 (#$ . 70387) nil]) #@90 Evaluate sexp before point in the outside environment; print value into current buffer. (defalias 'edebug-eval-print-last-sexp #[nil "À Š\nƒÃ\n!Å!ˆqˆÈ !ˆ\n \f  !\"#$%&'()*+,-./012345öŽŠ7qˆ8bˆùú !ƒ‹ú ;ü“ˆýþ !!.?p)@A!ˆ@?!ˆ@A!+‡" [edebug-last-sexp edebug-form edebug-save-windows edebug-current-windows edebug-inside-windows edebug-set-windows edebug-outside-windows edebug-buffer store-match-data edebug-outside-match-data edebug-outside-last-command-char edebug-outside-last-command-event edebug-outside-last-command edebug-outside-this-command edebug-outside-unread-command-char edebug-outside-unread-command-event edebug-outside-unread-command-events edebug-outside-last-input-char edebug-outside-last-input-event edebug-outside-last-event-frame edebug-outside-last-nonmenu-event edebug-outside-track-mouse edebug-outside-standard-output edebug-outside-standard-input edebug-outside-executing-macro edebug-outside-defining-kbd-macro edebug-outside-pre-command-hook edebug-outside-post-command-hook edebug-outside-post-command-idle-hook edebug-outside-o-a-p edebug-outside-o-a-s edebug-outside-c-i-e-a cursor-in-echo-area overlay-arrow-string overlay-arrow-position post-command-idle-hook post-command-hook pre-command-hook defining-kbd-macro executing-macro standard-input standard-output track-mouse last-nonmenu-event last-event-frame last-input-event last-input-char unread-command-events unread-command-event unread-command-char this-command last-command last-command-event last-command-char ((byte-code "ƒÁ\n!ˆ   \n \f  !\"#$%&'()*+,-.Á‡" [edebug-save-windows edebug-set-windows edebug-inside-windows last-command-char edebug-outside-last-command-char last-command-event edebug-outside-last-command-event last-command edebug-outside-last-command this-command edebug-outside-this-command unread-command-char edebug-outside-unread-command-char unread-command-event edebug-outside-unread-command-event unread-command-events edebug-outside-unread-command-events last-input-char edebug-outside-last-input-char last-input-event edebug-outside-last-input-event last-event-frame edebug-outside-last-event-frame last-nonmenu-event edebug-outside-last-nonmenu-event track-mouse edebug-outside-track-mouse standard-output edebug-outside-standard-output standard-input edebug-outside-standard-input executing-macro edebug-outside-executing-macro defining-kbd-macro edebug-outside-defining-kbd-macro pre-command-hook edebug-outside-pre-command-hook post-command-hook edebug-outside-post-command-hook post-command-idle-hook edebug-outside-post-command-idle-hook overlay-arrow-position edebug-outside-o-a-p overlay-arrow-string edebug-outside-o-a-s cursor-in-echo-area edebug-outside-c-i-e-a] 2)) edebug-outside-buffer edebug-outside-point marker-buffer edebug-mark-marker edebug-outside-mark nil edebug-safe-prin1-to-string edebug-safe-eval edebug-result-string princ "\n"] 22 (#$ . 70585) nil]) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÊË!„!Ì Ë B  „‰Î ! À ÏÃ#ˆÀ ÐÅ#ˆÀ ÑÇ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆÀ ØÙ#ˆÀ ÚÛ#ˆÀ ÜÝ#ˆÀ Þß#ˆÀ àá#ˆÀ âã#ˆÀ äå#ˆÀ æç#ˆÀ èé#ˆÀ êë#ˆÀ ìí#ˆÀ îï#ˆÀ ðñ#ˆÀ òó#ˆÀ ôõ#ˆÀ ö÷#ˆÀ øù#ˆÀ úû#ˆÀ üý#ˆÀ þÿ#ˆÀ @É#ˆÀ AB#ˆÀ CD#ˆÀ EB#ˆÀ FG#ˆÀ HI#ˆÀ JK#ˆÀ LM#ˆÀ NO#ˆÀ PÃ#ˆÀ QÅ#ˆÀ RÇ#ˆÀ Sï#ˆÀ Tñ#ˆÀ UV#ˆÀ WÉ#ˆÌ‡" [define-key emacs-lisp-mode-map "" edebug-step-mode "" edebug-next-mode "" edebug-go-mode "\f" edebug-where boundp edebug-mode-map nil current-load-list copy-keymap " " "n" "g" "G" edebug-Go-nonstop-mode "t" edebug-trace-mode "T" edebug-Trace-fast-mode "c" edebug-continue-mode "C" edebug-Continue-fast-mode "f" edebug-forward-sexp "h" edebug-goto-here "I" edebug-instrument-callee "i" edebug-step-in "o" edebug-step-out "q" top-level "Q" edebug-top-level-nonstop "a" abort-recursive-edit "S" edebug-stop "b" edebug-set-breakpoint "u" edebug-unset-breakpoint "B" edebug-next-breakpoint "x" edebug-set-conditional-breakpoint "X" edebug-set-global-break-condition "r" edebug-previous-result "e" edebug-eval-expression "" edebug-eval-last-sexp "E" edebug-visit-eval-list "w" "v" edebug-view-outside "p" edebug-bounce-point "P" "W" edebug-toggle-save-windows "?" edebug-help "d" edebug-backtrace "-" negative-argument "=" edebug-temp-display-freq-count "" "" "" " " "" "" #[nil "ÀÁ!‡" [edebug-set-breakpoint t] 2] "\f"] 4) #@67 Prefix key for global edebug commands, available from any buffer. (defvar global-edebug-prefix "X" (#$ . 75088)) #@59 Global map of edebug commands, available from any buffer. (defvar global-edebug-map nil (#$ . 75208)) (byte-code "„vÁ  !ˆÄ \"ˆÅÆÇ#ˆÅÈÉ#ˆÅÊË#ˆÅÌÍ#ˆÅÎÏ#ˆÅÐÑ#ˆÅÒÓ#ˆÅÔÕ#ˆÅÖ×#ˆÅØÙ#ˆÅÚÛ#ˆÅÜÝ#ˆÅÞß#ˆÅàá#ˆÅâã#ˆÅäå#ˆÅæç#ˆÁ‡" [global-edebug-map make-sparse-keymap global-unset-key global-edebug-prefix global-set-key define-key " " edebug-step-mode "g" edebug-go-mode "G" edebug-Go-nonstop-mode "t" edebug-trace-mode "T" edebug-Trace-fast-mode "c" edebug-continue-mode "C" edebug-Continue-fast-mode "b" edebug-set-breakpoint "u" edebug-unset-breakpoint "x" edebug-set-conditional-breakpoint "X" edebug-set-global-break-condition "w" edebug-where "W" edebug-toggle-save-windows "q" top-level "Q" edebug-top-level-nonstop "a" abort-recursive-edit "=" edebug-display-freq-count] 4) (defalias 'edebug-help #[nil "ÀÁ!‡" [describe-function edebug-mode] 2 nil nil]) #@866 Mode for Emacs Lisp buffers while in Edebug. In addition to all Emacs Lisp commands (except those that modify the buffer) there are local and global key bindings to several Edebug specific commands. E.g. `edebug-step-mode' is bound to \[edebug-step-mode] in the Edebug buffer and \\[edebug-step-mode] in any buffer. Also see bindings for the eval list buffer, *edebug*. The edebug buffer commands: \{edebug-mode-map} Global commands prefixed by `global-edebug-prefix': \{global-edebug-map} Options: edebug-setup-hook edebug-all-defs edebug-all-forms edebug-save-windows edebug-save-displayed-buffer-points edebug-initial-mode edebug-trace edebug-test-coverage edebug-continue-kbd-macro edebug-print-length edebug-print-level edebug-print-circle edebug-on-error edebug-on-quit edebug-on-signal edebug-unwrap-results edebug-global-break-condition  (defalias 'edebug-mode #[nil "À !‡" [use-local-map edebug-mode-map] 2 (#$ . 76085)]) #@50 Return a list of evaluations of edebug-eval-list (defalias 'edebug-eval-result-list #[nil "ÀÁÄÅ\"*‡" [Go-nonstop nil edebug-trace edebug-execution-mode mapcar edebug-safe-eval edebug-eval-list] 3 (#$ . 77041)]) (defalias 'edebug-eval-display-list #[(edebug-eval-result-list) " ÂÃÄÅ ÆZÇ\"\" \n qˆË ˆ\nƒAÌ\n@!ˆÍ ˆÌ@!ˆÍ ˆÏ!ˆ\nA\nA‚Ð !+‡" [edebug-eval-list edebug-eval-buffer format ";%s\n" make-string window-width 2 45 edebug-comment-line standard-output edebug-eval-list-temp erase-buffer prin1 terpri edebug-eval-result-list princ edebug-pop-to-buffer] 7]) (defalias 'edebug-create-eval-buffer #[nil "…Á!?…ÂÃ!‰qˆÄ ‡" [edebug-eval-buffer buffer-name get-buffer-create "*edebug*" edebug-eval-mode] 2]) #@107 Display expressions and evaluations in EVAL-LIST. It modifies the context by popping up the eval display. (defalias 'edebug-eval-display #[(edebug-eval-result-list) "…\nÁ ˆÂ!‡" [edebug-eval-result-list edebug-create-eval-buffer edebug-eval-display-list] 2 (#$ . 77779)]) #@99 Redisplay eval list in outside environment. May only be called from within edebug-recursive-edit. (defalias 'edebug-eval-redisplay #[nil "À ˆŠ ƒ !Ä !ˆqˆÇ!ˆ \n \f  !\"#$%&'()*+,-./01234õŽŠ6qˆ7bˆøù !ƒŠù :û“ˆüý !.‡" [edebug-create-eval-buffer edebug-save-windows edebug-current-windows edebug-inside-windows edebug-set-windows edebug-outside-windows edebug-buffer store-match-data edebug-outside-match-data edebug-outside-last-command-char edebug-outside-last-command-event edebug-outside-last-command edebug-outside-this-command edebug-outside-unread-command-char edebug-outside-unread-command-event edebug-outside-unread-command-events edebug-outside-last-input-char edebug-outside-last-input-event edebug-outside-last-event-frame edebug-outside-last-nonmenu-event edebug-outside-track-mouse edebug-outside-standard-output edebug-outside-standard-input edebug-outside-executing-macro edebug-outside-defining-kbd-macro edebug-outside-pre-command-hook edebug-outside-post-command-hook edebug-outside-post-command-idle-hook edebug-outside-o-a-p edebug-outside-o-a-s edebug-outside-c-i-e-a cursor-in-echo-area overlay-arrow-string overlay-arrow-position post-command-idle-hook post-command-hook pre-command-hook defining-kbd-macro executing-macro standard-input standard-output track-mouse last-nonmenu-event last-event-frame last-input-event last-input-char unread-command-events unread-command-event unread-command-char this-command last-command last-command-event last-command-char ((byte-code "ƒÁ\n!ˆ   \n \f  !\"#$%&'()*+,-.Á‡" [edebug-save-windows edebug-set-windows edebug-inside-windows last-command-char edebug-outside-last-command-char last-command-event edebug-outside-last-command-event last-command edebug-outside-last-command this-command edebug-outside-this-command unread-command-char edebug-outside-unread-command-char unread-command-event edebug-outside-unread-command-event unread-command-events edebug-outside-unread-command-events last-input-char edebug-outside-last-input-char last-input-event edebug-outside-last-input-event last-event-frame edebug-outside-last-event-frame last-nonmenu-event edebug-outside-last-nonmenu-event track-mouse edebug-outside-track-mouse standard-output edebug-outside-standard-output standard-input edebug-outside-standard-input executing-macro edebug-outside-executing-macro defining-kbd-macro edebug-outside-defining-kbd-macro pre-command-hook edebug-outside-pre-command-hook post-command-hook edebug-outside-post-command-hook post-command-idle-hook edebug-outside-post-command-idle-hook overlay-arrow-position edebug-outside-o-a-p overlay-arrow-string edebug-outside-o-a-s cursor-in-echo-area edebug-outside-c-i-e-a] 2)) edebug-outside-buffer edebug-outside-point marker-buffer edebug-mark-marker edebug-outside-mark nil edebug-eval-display-list edebug-eval-result-list] 22 (#$ . 78059)]) (defalias 'edebug-visit-eval-list #[nil "À ˆÁ\n!‡" [edebug-eval-redisplay edebug-pop-to-buffer edebug-eval-buffer] 2 nil nil]) #@68 Replace the evaluation list with the sexps now in the eval buffer. (defalias 'edebug-update-eval-list #[nil "`ÀebˆÃ ˆm„ÄÅ!ˆÆ BÇÈÀÉ#ƒ<ÅyˆÊÀwˆgËU„m„ÄÅ!ˆÆ B‚ Ÿ\fÍ ˆ\nb*‡" [nil new-list starting-point edebug-skip-whitespace forward-sexp 1 edebug-last-sexp re-search-forward "^;" t " \n " 59 edebug-eval-list edebug-eval-redisplay] 4 (#$ . 81172) nil]) #@44 Delete the item under point and redisplay. (defalias 'edebug-delete-eval-item #[nil "ÀÁÂÃ#ƒ Äyˆ`ÅÁÂÃ#ˆÆyˆ`|ˆÇ ‡" [re-search-backward "^;" nil nofail 1 re-search-forward 0 edebug-update-eval-list] 5 (#$ . 81543) nil]) #@66 Keymap for edebug-eval-mode. Superset of lisp-interaction-mode. (defvar edebug-eval-mode-map nil (#$ . 81767)) (byte-code "„&Á\n!ÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÁ‡" [edebug-eval-mode-map copy-keymap lisp-interaction-mode-map define-key "" edebug-where "" edebug-delete-eval-item "" edebug-update-eval-list "" edebug-eval-last-sexp "\n" edebug-eval-print-last-sexp] 4) #@434 Mode for evaluation list buffer while in Edebug. In addition to all Interactive Emacs Lisp commands there are local and global key bindings to several Edebug specific commands. E.g. `edebug-step-mode' is bound to \[edebug-step-mode] in the Edebug buffer and \\[edebug-step-mode] in any buffer. Eval list buffer commands: \{edebug-eval-mode-map} Global commands prefixed by global-edebug-prefix: \{global-edebug-map}  (defalias 'edebug-eval-mode #[nil "À ˆÁÃÅ!‡" [lisp-interaction-mode edebug-eval-mode major-mode "Edebug-Eval" mode-name use-local-map edebug-eval-mode-map] 2 (#$ . 82152)]) #@124 Replacement for debug. If we are running an edebugged function, show where we last were. Otherwise call debug normally. (defalias 'edebug #[(&optional edebug-arg-mode &rest debugger-args) "ƒ4Á \n=ƒ4 @\f@ʼn‰‰? \n \f Î ˆÏ=?…1\f.‡ÐÑ\f#‡" [edebug-entered recursion-depth edebug-recursion-depth edebug-offset-indices debugger-args nil edebug-arg-mode edebug-break edebug-global-break edebug-break-condition edebug-break-data edebug-breakpoints edebug-value edebug-offset-index edebug-display error apply debug] 7 (#$ . 82769)]) #@58 Display a non-working backtrace. Better than nothing... (defalias 'edebug-backtrace #[nil "ƒ\nÁ!„ÂÃ!Á!\fÅÆÇ \nË ˆqˆÅ\febˆ`ÍÎÇÅ#…\\ÏyˆÐÑ!ƒK`Òyˆ`|ˆ‚,ÐÓ!ƒ,Òyˆ`|ˆ‚,+‘‡" [edebug-backtrace-buffer buffer-name generate-new-buffer "*Backtrace*" standard-output t 50 nil last-ok-point print-length print-escape-newlines backtrace truncate-lines re-search-forward "^ (?edebug" 0 looking-at "^ (edebug-after" 1 "^ edebug"] 5 (#$ . 83322) nil]) #@196 In buffer BUF-NAME, display FMT and ARGS at the end and make it visible. The buffer is created if it does not exist. You must include newlines in FMT to break lines, but one newline is appended. (defalias 'edebug-trace-display #[(buf-name fmt &rest args) "À Á\n!ÄÆ !ˆÇÀ dbˆÉÊ \f#ͱˆÎÏÐ Z!ˆÑ `\"ˆdbˆÒ !ˆÓ!ˆ+\n‡" [selected-window get-buffer-create buf-name buffer nil buf-window edebug-pop-to-buffer t truncate-lines apply edebug-format fmt args "\n" vertical-motion 1 window-height set-window-start bury-buffer select-window] 4 (#$ . 83793)]) #@68 Convenience call to edebug-trace-display using edebug-trace-buffer (defalias 'edebug-trace #[(fmt &rest args) "ÀÁ\n \f$‡" [apply edebug-trace-display edebug-trace-buffer fmt args] 5 (#$ . 84351)]) #@729 Display the frequency count data for each line of the current definition. The frequency counts are inserted as comment lines after each line, and you can undo all insertions with one `undo' command. The counts are inserted starting under the `(' before an expression or the `)' after an expression, or on the last char of a symbol. The counts are only displayed when they differ from previous counts on the same line. If coverage is being tested, whenever all known results of an expression are `eq', the char `=' will be appended after the count for that expression. Note that this is always the case for an expression only evaluated once. To clear the frequency count and coverage data for a definition, reinstrument it. (defalias 'edebug-display-freq-count #[nil "À ‰ÂN ÄN ÆN‰@É8‰\nGS Ì ÌÌÌÌŠÒ X…ë\n H\\bˆÒyˆ`Z  Ò S‰ Xƒc\n HX„MÓyˆ` ÔÕcˆ T‰  Xƒá  H  HŠ\n H\\bˆigÖUƒÒ‚žÓZ)ÚÒ`ZZ]Û\"ÒWƒÄÜ>„ÄÝ‚ÅÞUƒÑÞ‚Õß!ై+‚sácˆ ‚/. ‡" [edebug-form-data-symbol function edebug-freq-count counts edebug-coverage coverages edebug data def-mark 2 edebug-points i nil last-index first-index start-of-line start-of-count-line last-count 0 1 -1 ";#" 40 col coverage count make-string 32 (unknown ok-coverage) "=" "" int-to-string " " "\n"] 6 (#$ . 84555) nil]) #@111 Temporarily display the frequency count data for the current definition. It is removed when you hit any char. (defalias 'edebug-temp-display-freq-count #[nil "À ˆÃ ˆÄ Æ )‡" [nil buffer-read-only undo-boundary edebug-display-freq-count read-char unread-command-char undo] 1 (#$ . 85900) nil]) (defalias 'edebug-toggle #[(variable) "Á!?LˆÂÃÁ!#‡" [variable eval message "%s: %s"] 5]) (require (quote easymenu)) #@32 Lemacs style menus for Edebug. (defconst edebug-mode-menus (quote ("Edebug" "----" ["Stop" edebug-stop t] ["Step" edebug-step-mode t] ["Next" edebug-next-mode t] ["Trace" edebug-trace-mode t] ["Trace Fast" edebug-Trace-fast-mode t] ["Continue" edebug-continue-mode t] ["Continue Fast" edebug-Continue-fast-mode t] ["Go" edebug-go-mode t] ["Go Nonstop" edebug-Go-nonstop-mode t] "----" ["Help" edebug-help t] ["Abort" abort-recursive-edit t] ["Quit to Top Level" top-level t] ["Quit Nonstop" edebug-top-level-nonstop t] "----" ("Jumps" ["Forward Sexp" edebug-forward-sexp t] ["Step In" edebug-step-in t] ["Step Out" edebug-step-out t] ["Goto Here" edebug-goto-here t]) ("Breaks" ["Set Breakpoint" edebug-set-breakpoint t] ["Unset Breakpoint" edebug-unset-breakpoint t] ["Set Conditional Breakpoint" edebug-set-conditional-breakpoint t] ["Set Global Break Condition" edebug-set-global-break-condition t] ["Show Next Breakpoint" edebug-next-breakpoint t]) ("Views" ["Where am I?" edebug-where t] ["Bounce to Current Point" edebug-bounce-point t] ["View Outside Windows" edebug-view-outside t] ["Previous Result" edebug-previous-result t] ["Show Backtrace" edebug-backtrace t] ["Display Freq Count" edebug-display-freq-count t]) ("Eval" ["Expression" edebug-eval-expression t] ["Last Sexp" edebug-eval-last-sexp t] ["Visit Eval List" edebug-visit-eval-list t]) ("Options" ["Edebug All Defs" edebug-all-defs t] ["Edebug All Forms" edebug-all-forms t] "----" ["Toggle Tracing" (edebug-toggle (quote edebug-trace)) t] ["Toggle Coverage Testing" (edebug-toggle (quote edebug-test-coverage)) t] ["Toggle Window Saving" edebug-toggle-save-windows t] ["Toggle Point Saving" (edebug-toggle (quote edebug-save-displayed-buffer-points)) t]))) (#$ . 86321)) (defalias 'edebug-emacs-19-specific #[nil "ÀÁÂ\"ˆÃÄMˆÅBÇBÈÉMˆÊËMˆÌÍ!„&Î ÍBÏÍÐÑ#ˆÒÍÑ$ˆ…HÖÎ×Ø\"\"‡" [defalias edebug-window-live-p window-live-p edebug-mark #[nil "ÀÁ!‡" [mark t] 2] read-expression-history current-load-list read-expression-map edebug-set-conditional-breakpoint #[(arg condition) "ÀÁ\n #‡" [edebug-modify-breakpoint t condition arg] 4 "Set a conditional breakpoint at nearest sexp.\nThe condition is evaluated in the outside context.\nWith prefix argument, make it a temporary breakpoint." (list current-prefix-arg (let ((edebug-stop-point (edebug-find-stop-point))) (if edebug-stop-point (let* ((edebug-def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) (edebug-data (get edebug-def-name (quote edebug))) (edebug-breakpoints (car (cdr edebug-data))) (edebug-break-data (assq index edebug-breakpoints)) (edebug-break-condition (car (cdr edebug-break-data))) (edebug-expression-history (if edebug-break-condition (cons edebug-break-condition read-expression-history) read-expression-history))) (prog1 (read-from-minibuffer "Condition: " nil read-expression-map t (quote edebug-expression-history)) (setq read-expression-history edebug-expression-history))))))] edebug-eval-expression #[(edebug-expr) "ÀŠ ƒ !Ä !ˆqˆÇ!ˆ \n \f  !\"#$%&'()*+,-./01234õŽŠ6qˆ7bˆøù !ƒˆù :û“ˆü=!>B>ÿ>@!.!‡" [princ edebug-save-windows edebug-current-windows edebug-inside-windows edebug-set-windows edebug-outside-windows edebug-buffer store-match-data edebug-outside-match-data edebug-outside-last-command-char edebug-outside-last-command-event edebug-outside-last-command edebug-outside-this-command edebug-outside-unread-command-char edebug-outside-unread-command-event edebug-outside-unread-command-events edebug-outside-last-input-char edebug-outside-last-input-event edebug-outside-last-event-frame edebug-outside-last-nonmenu-event edebug-outside-track-mouse edebug-outside-standard-output edebug-outside-standard-input edebug-outside-executing-macro edebug-outside-defining-kbd-macro edebug-outside-pre-command-hook edebug-outside-post-command-hook edebug-outside-post-command-idle-hook edebug-outside-o-a-p edebug-outside-o-a-s edebug-outside-c-i-e-a cursor-in-echo-area overlay-arrow-string overlay-arrow-position post-command-idle-hook post-command-hook pre-command-hook defining-kbd-macro executing-macro standard-input standard-output track-mouse last-nonmenu-event last-event-frame last-input-event last-input-char unread-command-events unread-command-event unread-command-char this-command last-command last-command-event last-command-char ((byte-code "ƒÁ\n!ˆ   \n \f  !\"#$%&'()*+,-.Á‡" [edebug-save-windows edebug-set-windows edebug-inside-windows last-command-char edebug-outside-last-command-char last-command-event edebug-outside-last-command-event last-command edebug-outside-last-command this-command edebug-outside-this-command unread-command-char edebug-outside-unread-command-char unread-command-event edebug-outside-unread-command-event unread-command-events edebug-outside-unread-command-events last-input-char edebug-outside-last-input-char last-input-event edebug-outside-last-input-event last-event-frame edebug-outside-last-event-frame last-nonmenu-event edebug-outside-last-nonmenu-event track-mouse edebug-outside-track-mouse standard-output edebug-outside-standard-output standard-input edebug-outside-standard-input executing-macro edebug-outside-executing-macro defining-kbd-macro edebug-outside-defining-kbd-macro pre-command-hook edebug-outside-pre-command-hook post-command-hook edebug-outside-post-command-hook post-command-idle-hook edebug-outside-post-command-idle-hook overlay-arrow-position edebug-outside-o-a-p overlay-arrow-string edebug-outside-o-a-s cursor-in-echo-area edebug-outside-c-i-e-a] 2)) edebug-outside-buffer edebug-outside-point marker-buffer edebug-mark-marker edebug-outside-mark nil edebug-eval edebug-expr values edebug-safe-prin1-to-string] 23 "Evaluate an expression in the outside environment. \nIf interactive, prompt for the expression.\nPrint result in minibuffer." (list (read-from-minibuffer "Eval: " nil read-expression-map t (quote read-expression-history)))] boundp edebug-menu nil put variable-documentation "Edebug menus" easy-menu-do-define edebug-mode-map edebug-mode-menus window-system x-popup-menu lookup-key [menu-bar Edebug]] 5]) (defalias 'edebug-lemacs-specific #[nil "À BÂÃMˆÄÅMˆÆÇMˆÈ ÊÆ#‡" [zmacs-regions current-load-list edebug-mark #[nil "À )‡" [nil zmacs-regions mark] 1] edebug-mark-marker #[nil "À )‡" [nil zmacs-regions mark-marker] 1] edebug-mode-menu #[(event) "À !‡" [popup-menu edebug-mode-menus] 2 nil "@event"] define-key edebug-mode-map button3] 4]) (defalias 'edebug-emacs-version-specific #[nil "ÀÁ\n\"ƒ\nà ‡ÄÅ!ƒ ƒÆÇ!‡ÀÈ\n\"?…\"É ‡" [string-match "Lucid" emacs-version edebug-lemacs-specific boundp epoch::version require edebug-epoch "^18" edebug-emacs-19-specific] 3]) (byte-code "À ˆÁÂ!ƒÃÄÅ\"ˆ‚ÃÆÇ\"ˆÁÈ!ƒ$ÃÄÉ\"ˆ‚)ÃÊË\"ˆÌ ˆÍÎ!‡" [edebug-emacs-version-specific featurep cl add-hook edebug-setup-hook #[nil "ÀÁ!‡" [require cl-specs] 2] cl-load-hook #[nil "ÀÁ!‡" [require cl-specs] 2] cl-read #[nil "ÀÁ!‡" [require edebug-cl-read] 2] cl-read-load-hooks #[nil "ÀÁ!‡" [require edebug-cl-read] 2] edebug-install-read-eval-functions provide edebug] 3) emacs-19.30/lisp/ediff-diff.elc100666 75424 12 55101 6047377560 14651 0ustar kwzhstaff;ELC ;;; compiled by simon@mole.gnu.ai.mit.edu on Mon Nov 6 07:27:45 1995 ;;; from file /home/gp2/simon/Emacs/lisp/ediff-diff.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`ediff-diff.el' was compiled for Emacs 19.29 or later")) (require (quote ediff-init)) #@366 *The shell used to run diff and patch. If user's .profile or .cshrc files are set up correctly, any shell will do. However, some people set $prompt or other things incorrectly, which leads to undesirable output messages. These may cause Ediff to fail. In such a case, set ediff-shell to a shell that you are not using or, better, fix your shell's startup file. (defvar ediff-shell (byte-code "Á=ƒ‡Ã>ƒćŇ" [system-type emx "cmd" (vax-vms axp-vms) "*dcl*" "sh"] 2) (#$ . -514)) #@67 *Program to use for generating the differential of the two files. (defvar ediff-diff-program "diff" (#$ . -1008)) #@273 *Options to pass to `ediff-diff-program'. If diff(1) is used as `ediff-diff-program', then the most useful options are `-w', to ignore space, and `-i', to ignore case of letters. At present, the option `-c' is ignored, since Ediff doesn't understand this type of output. (defvar ediff-diff-options "" (#$ . -1129)) #@121 *Program to use for generating custom diff output for saving it in a file. This output is not used by Ediff internally. (defvar ediff-custom-diff-program ediff-diff-program (#$ . -1452)) #@50 *Options to pass to `ediff-custom-diff-program'. (defvar ediff-custom-diff-options "-c" (#$ . -1645)) #@69 Pattern to match lines produced by diff3 that describe differences. (defvar ediff-match-diff3-line "^====\\(.?\\)$" (#$ . 1753)) #@105 *Program to be used for three-way comparison. Must produce output compatible with Unix's diff3 program. (defvar ediff-diff3-program "diff3" (#$ . -1889)) #@44 *Options to pass to `ediff-diff3-program'. (defvar ediff-diff3-options "" (#$ . -2049)) #@128 *Regexp that matches normal output lines from `ediff-diff3-program'. Lines that do not match are assumed to be error messages. (defvar ediff-diff3-ok-lines-regexp "^\\([1-3]:\\|====\\| \\|.*Warning *:\\|.*No newline\\|.*missing newline\\)" (#$ . -2144)) #@2  (defvar ediff-diff-status "" (#$ . 2404)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-diff-status put permanent-local t] 4) #@44 *Name of the program that applies patches. (defvar ediff-patch-program "patch" (#$ . -2549)) #@42 *Options to pass to ediff-patch-program. (defvar ediff-patch-options "" (#$ . -2648)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp ediff-patch-buf nil current-load-list ediff-patch-diagnostics] 2) #@324 If `on', Ediff auto-highlights fine diffs for the current diff region. If `off', auto-highlighting is not used. If `nix', no fine diffs are shown at all, unless the user force-refines the region by hitting `*'. This variable can be set either in .emacs or toggled interactively. Use `setq-default' if setting it in .emacs (defvar ediff-auto-refine (byte-code "ƒ ‚\fÂà !ƒ\"ƒ ‚Âà !Ä>„\"ŇƇ" [ediff-emacs-p window-system device-type selected-device (tty stream) on nix] 2) (#$ . 2855)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-auto-refine put permanent-local t] 4) #@201 *If t, skip over difference regions that differ only in the white space and line breaks. This variable can be set either in .emacs or toggled interactively. Use `setq-default' if setting it in .emacs (defvar ediff-ignore-similar-regions nil (#$ . -3454)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-ignore-similar-regions put permanent-local t] 4) #@76 Auto-refine only those regions that are smaller than this number of bytes. (defvar ediff-auto-refine-limit 700 (#$ . 3822)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-auto-refine-limit put permanent-local t] 4) #@260 Regexp that matches normal output lines from `ediff-diff-program'. This is mostly lifted from Emerge, except that Ediff also considers warnings and `Missing newline'-type messages to be normal output. Lines that do not match are assumed to be error messages. (defvar ediff-diff-ok-lines-regexp "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\|.*Warning *:\\|.*No newline\\|.*missing newline\\)" (#$ . 4055)) #@68 Pattern to match lines produced by diff that describe differences. (defvar ediff-match-diff-line (byte-code "À à İ)‡" ["\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)" x "^" "\\([acd]\\)" "$"] 5) (#$ . 4462)) #@402 value is a function symbol depending on the kind of job is to be done. For 2-way jobs and for ediff-merge, it should be `ediff-setup-diff-regions'. For jobs requiring diff3, it should be `ediff-setup-diff-regions3'. The function should take three mandatory arguments, file-A, file-B, and file-C. It may ignore file C for diff2 jobs. It should also take one optional arguments, diff-number to refine. (defvar ediff-setup-diff-regions-function nil (#$ . 4670)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-setup-diff-regions-function put permanent-local t] 4) (defalias 'ediff-setup-diff-regions #[(file-A file-B file-C) "ƒÁ ƒÄ !ƒÅÄ !!„ÆÇÈÉ\"!ÊË!ˆÌ Î&ˆÒ \"ˆÔÕ #!‡" [ediff-xemacs-p t synchronize-minibuffers ediff-diff-buffer get-buffer buffer-name get-buffer-create ediff-unique-buffer-name "*ediff-diff" "*" message "Computing differences ..." ediff-exec-process ediff-diff-program synchronize ediff-diff-options file-A file-B ediff-prepare-error-list ediff-diff-ok-lines-regexp ediff-convert-diffs-to-overlays ediff-extract-diffs ediff-word-mode ediff-narrow-bounds] 7]) (defalias 'ediff-setup-fine-diff-regions #[(file-A file-B file-C reg-num) "ƒÁ!ƒÂÁ!!„ÃÄÅÆ\"!lj‰‰ \n \f‰ ƒ2 ‚4\n ƒ@‚B ÑTCƒZÖ×#ˆ*Ø\nÙƒj‚lƒv‚x …‰ƒ‡‚‰&ˆÝ \"ˆ ƒŸÞßà#‚£áà\" ƒÔ„¹âãA\"ˆ‚Ô„ÈâäA\"ˆ‚Ô„ÔâåA\"ˆ&çè&#ˆçé&#ˆ\f…øçê&#.‡" [ediff-fine-diff-buffer get-buffer buffer-name get-buffer-create ediff-unique-buffer-name "*ediff-fine-diff" "*" nil diff-list ok-regexp diff-program diff3-job ediff-3way-job ediff-diff3-program ediff-diff-program ediff-diff3-ok-lines-regexp ediff-diff-ok-lines-regexp "Refining difference region %d ..." reg-num args string ediff-verbose-p apply message ediff-exec-process synchronize file-A file-B file-C ediff-prepare-error-list ediff-extract-diffs3 3way-comparison word-mode ediff-extract-diffs mapcar #[(elt) "ÁÂIˆÃÂI‡" [elt 0 nil 1] 3] #[(elt) "ÁÂIˆÃÂI‡" [elt 2 nil 3] 3] #[(elt) "ÁÂIˆÃÂI‡" [elt 4 nil 5] 3] region-num ediff-set-fine-overlays-in-one-buffer A B C] 8]) (defalias 'ediff-prepare-error-list #[(ok-regexp diff-buff) "ƒÁ!ƒÂÁ!!„ÃÄÅÆ\"!pƒ~Á!ƒ~ÂÁ!!ƒ~ÈŽqˆÉ ˆp\nƒZÁ\n!ƒZÂÁ\n!!ƒZËŽ\nqˆÌ )‚d Î=†dÏÐ!)cˆebˆÑ!ˆÔ>ƒzÑÕ!ˆ)‚‰ Î=„‰ÏÐ!ˆ)pƒªÁ!ƒªÂÁ!!ƒªÖŽqˆ× )‚´ Î=†´ÏÐ!)ØU?…ðÜ ˆÝ!ˆ‰ƒéÁ!ƒéÂÁ!!ƒéßÁ!!ˆ)Ïà\n\"*‡" [ediff-error-buffer get-buffer buffer-name get-buffer-create ediff-unique-buffer-name "*ediff-errors" "*" StartBuffer ((set-buffer StartBuffer)) erase-buffer diff-buff ((set-buffer StartBuffer)) buffer-string this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" delete-matching-lines ok-regexp system-type (vax-vms axp-vms) "^$" ((set-buffer StartBuffer)) buffer-size 0 ediff-control-buffer error-buf ctl-buf ediff-skip-unsuitable-frames switch-to-buffer buf kill-buffer "Errors in diff output. Diff output is in %S"] 5]) (defalias 'ediff-extract-diffs #[(diff-buffer word-mode &optional bounds) " \nɉĉ‰ \n \f ƒ#Ï‚$ÐBƒ<Ò@!ÒA@!p ƒkÔ !ƒkÕÔ !!ƒkÖŽ qˆƒd‚eebˆ)‚vØ=„vÙÚ!ˆ)p\fƒ¤Ô\f!ƒ¤ÕÔ\f!!ƒ¤ÛŽ\fqˆ ƒ ‚žebˆ)‚¯Ø=„¯ÙÚ!ˆ) ƒöÔ !ƒöÕÔ !!ƒöp ƒêÔ !ƒêÕÔ !!ƒêÜŽ qˆebˆ)‚õØ=„õÙÚ!ˆ)pƒÔ!ƒÕÔ!!ƒÞŽqˆebˆß Äá#ƒ‹âÔÕ{!#ä”ä•%‰&ƒ?â&%{!‚A#*'è”è•{)âê”ê•{!+ì”ì•%‰&ƒjâ&%{!‚l+*-Ä.Ä/Ä0Ä1Ä2Ä3Ä4Ä5)ö˜ƒž-T-#T‰#'‚¿)÷˜ƒµ'T'+T‰+-‚¿'T'-T-8ù=ƒÑ+2-3‚Ù#2'3ƒO ƒÔ !ƒÕÔ !!ƒú#\nZ'#Z+ Z-+Z2Z32Zĉ‰‰‰& ‚<ú#\nZ'#Z+ Z-+Zĉ‰‰‰‰‰& C¤'\n- 3‚†p ƒ‰Ô !ƒ‰ÕÔ !!ƒ‰ûŽ qˆ#\nZyˆ`.'#Zyˆ`/'\n)‚”Ø=„”ÙÚ!ˆ)p\fƒÏÔ\f!ƒÏÕÔ\f!!ƒÏüŽ\fqˆ+ Zyˆ`0-+Zyˆ`1- )‚ÚØ=„ÚÙÚ!ˆ) ƒ6Ô !ƒ6ÕÔ !!ƒ6p ƒ*Ô !ƒ*ÕÔ !!ƒ*ýŽ qˆ2Zyˆ`432Zyˆ`53)‚5Ø=„5ÙÚ!ˆ) ƒpÔ !ƒpÕÔ !!ƒpú./0145ĉ8ù=ƒgþ‚hÿ8Ä& ‚‚ú./01ĉ‰‰‰‰‰& C¤. ‚)‚šØ=„šÙÚ!ˆ). ‡" [ediff-buffer-A ediff-buffer-B ediff-buffer-C 1 nil shift-B shift-A diff-list c-prev b-prev a-prev C-buffer B-buffer A-buffer word-mode words points bounds ediff-overlay-start StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) diff-buffer ((set-buffer StartBuffer)) re-search-forward ediff-match-diff-line t string-to-int a-begin 3 e b a-end 4 diff-type 5 b-begin 7 b-end a-begin-pt a-end-pt b-begin-pt b-end-pt c-begin c-end c-begin-pt c-end-pt "a" "d" ediff-default-variant default-B vector ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) A B] 14]) (defalias 'ediff-convert-diffs-to-overlays #[(diff-list) "ÀÁ\n\"ˆÀÃ\n\"ˆ\fƒÀÅ\n\"ˆƒÀÇ\n\"ˆƒ+ÉÊË\nA\"!\fÍÎ!‡" [ediff-set-diff-overlays-in-one-buffer A diff-list B ediff-3way-job C ediff-merge-with-ancestor-job Ancestor ediff-merge-job vconcat mapcar #[(elt) "ÁHÂHÅ\f…ÆÇ\f\" \"*‡" [elt 9 10 state-of-ancestor state-of-merge vector format "%S"] 4] ediff-state-of-merge message "Processing difference regions ... done"] 4]) (defalias 'ediff-set-diff-overlays-in-one-buffer #[(buf-type diff-list) "À\nÃ=ƒ\f\f‚*\nÅ=ƒ‚*\nÇ=ƒ\"‚*\nÉ=…*\n \f@ Î\nÃ=ƒ>@‚U\nÅ=ƒKA@‚U\nÇ=…UÐ8!Ò\nÃ=ƒe@‚|\nÅ=ƒrA@‚|\nÇ=…|Ð8!ÔÔÔÔÔÔÔÔ\fA‰\fGp ƒÆÞ !ƒÆßÞ !!ƒÆàŽ qˆ)‚Ñ!â=„Ñãä!ˆ)\fƒ˜ T\f@‰\nÃ=ƒêå‚ÿ\nÅ=ƒôЂÿ\nÇ=ƒþæ‚ÿçH\nÃ=ƒè‚#\nÅ=ƒé‚#\nÇ=ƒ\"ê‚#ëHìH\n=„X\nÉ=„Xí>ƒXî\nîÃÅÇE\"\"@ïð\"‚[Ô ñ=ƒíp ƒˆÞ !ƒˆßÞ !!ƒˆòŽ qˆbˆ)‚“!â=„“ãä!ˆ)óT \"ó Ù#‰Vƒ±Vƒ½p ƒàÞ !ƒàßÞ !!ƒàôŽ qˆ`)‚ê!â=†êãä!)õ #ö÷8#ˆöù #ˆöúû#ˆ<ƒ=‚þÿ !ƒf<ƒ(=‚,þÿ !@>„fAƒfBƒfC\n DEïFDè\"è=ƒ]G‚`H\n\"!*\"ˆI J\"åUƒKL\n $ˆMÔ‰$C¤\fA‰\f„×EïN\n\"!O!L. ‡" [-1 current-diff buf-type A ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer buff diff-list diff-list-type ediff-overlay-start ediff-narrow-bounds 2 shift ediff-overlay-end limit nil diff-overlay-list list-element total-diffs begin end pt-saved overlay state-of-diff StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" 0 4 6 1 3 5 7 8 (A B C) delq format "=diff(%S)" words ((set-buffer StartBuffer)) ediff-goto-word ((set-buffer StartBuffer)) ediff-make-bullet-proof-overlay ediff-overlay-put priority ediff-shadow-overlay-priority ediff-diff-num insert-in-front-hooks (ediff-insert-in-front) ediff-emacs-p window-system device-type selected-device (tty stream) ediff-use-faces ediff-highlight-all-diffs ediff-set-overlay-face dif-num intern logand "ediff-even-diff-face-%S" "ediff-odd-diff-face-%S" mod 10 message "Buffer %S: Processing difference region %d of %d" vector "ediff-difference-vector-%S" vconcat] 8]) (defalias 'ediff-make-fine-diffs #[(&optional n flag) "„ \nÃWƒÄÅ!ˆƒÇÉ\nËW†5\nY†5Ì !ÑÒ\"ÑÓ\"ÑÔ\"ÕÒ\"ÕÓ\"ÕÔ\"Ö !â=ƒœãäåÒ\"!JHÃHƒœãäåÒ\"!JHæHƒ.çTC()*ƒ˜ëì)(#ˆ*‚.íÖE\"GÃVƒQî!ƒ½/ƒ½ðÔÖ#ˆ1ƒôòT„ÎÒ‚Þ„×Ó‚Þ?…ÞÔD()*ƒðëì)(#ˆ*‚\"óTƒÒ‚ƒ Ó‚…ÔD()*ƒ!ëì)(#ˆ*ƒAƒAƒAãäåÒ\"!JHæôIˆ‚.ãäåÒ\"!JHæÖIˆ‚.Ç=ƒ‰ãäåÒ\"!JHÃH„.\nõ>„.öT÷ø!D()*ƒ…ëì)(#ˆ*‚.ùúÒû#úÒü#=!>%ˆÿ!@ # ùúÓû#úÓü#A!>%ˆÿ!B#CƒèùúÔû#úÔü#D!>%ˆÿ!E# Cƒ\fƒ\fFÖ$ˆ‚SCƒ$ƒ$F Ö$ˆ‚SCƒG„9/ƒGî!ƒGF Ö$ˆ‚SF $ˆãäåÒ\"!JHÃHGãäåÓ\"!JHÃHGƒãäåÔ\"!JHÃHG‚€Ë\\\\ƒ“ƒ“„®„Ô„ÔCƒ§„ÔË=ƒÔãäåÒ\"!JHæôIˆçTC()*ƒÐëì)(#ˆ*‚.Ë=ƒ!ãäåÒ\"!JHæÖIˆGTƒøH‚ ƒI‚ … JD()*ƒëì)(#ˆ*‚.ãäåÒ\"!JHæÖIˆK!. ‡" [n ediff-current-difference ediff-number-of-differences 1 error "No differences found" ediff-word-mode skip flag nix ediff-auto-refine 0 get-buffer-create ediff-tmp-buffer ediff-temp-file-A ediff-temp-file-B ediff-temp-file-C ediff-empty-diff-region-p A B C ediff-whitespace-diff-region-p nil cumulative-fine-diff-length whitespace-C whitespace-B whitespace-A empty-C empty-B empty-A file-C file-B file-A tmp-buffer noforce intern format "ediff-difference-vector-%S" 2 "Only white-space differences in region %d" args string ediff-verbose-p apply message delq ediff-looks-like-combined-merge ediff-merge-job ediff-set-fine-overlays-in-one-buffer ediff-3way-comparison-job "Region %d is empty in all buffers but %S" "Region %d in buffer %S is empty" t (off nix) "Region %d exceeds auto-refine limit. `%s' force-refines" substitute-command-keys "\\[ediff-make-or-kill-fine-diffs]" ediff-wordify ediff-get-diff-posn beg end ediff-buffer-A ediff-control-buffer ediff-make-temp-file "fineDiffA" ediff-buffer-B "fineDiffB" ediff-3way-job ediff-buffer-C "fineDiffC" ediff-setup-fine-diff-regions "Only white-space differences in region %d %s" "in buffers B & C" "in buffers A & C" "in buffers A & B" ediff-set-fine-diff-properties] 12]) (defalias 'ediff-install-fine-diff-if-necessary #[(n) "Á=ƒ6\nÃÄÅ#ÃÄÇ#ZVƒ0\nÃÈÅ#ÃÈÇ#ZVƒ0ÉÊ\"‡ÉË\"‡Ì=…AÉË\"‡" [ediff-auto-refine on ediff-auto-refine-limit ediff-get-diff-posn A end n beg B ediff-make-fine-diffs noforce skip off] 6]) (defalias 'ediff-set-fine-diff-properties #[(n &optional default) "ƒ ‚\fÂà !…ƒ ‚Âà !Ä>??†H ÆW†H Y†HÈÉ \n#ˆÈË \n#ˆ\f…HÈÍ \n#‡" [ediff-emacs-p window-system device-type selected-device (tty stream) n 0 ediff-number-of-differences ediff-set-fine-diff-properties-in-one-buffer A default B ediff-3way-job C] 4]) (defalias 'ediff-set-fine-diff-properties-in-one-buffer #[(buf-type n &optional default) "ÀÁ \"!J\fHÅHƒÆ‚ÇÀÁÈ \"!!ƒ%É‚4ÊÀÁË \"!JÌ\"†3ÉT\f ÏÐ\"+‡" [intern format "ediff-difference-vector-%S" buf-type n 1 default face-name "ediff-fine-diff-face-%S" 0 ediff-overlay-get "ediff-current-diff-overlay-%S" priority face fine-diff-vector mapcar #[(overl) "À \n\"ˆÃ Ä\f#‡" [ediff-set-overlay-face overl face ediff-overlay-put priority] 4]] 7]) (defalias 'ediff-set-fine-overlays-for-combined-merge #[(diff-list reg-num) "À‰‰Ä @ A@#ÄÇ 8È 8#ÄÉ 8Ê 8#ËÌÍÎ\"!JHÐÑ \n #I+‡" [nil overlay3 overlay2 overlay1 ediff-make-bullet-proof-overlay diff-list ediff-buffer-C 2 3 4 5 intern format "ediff-difference-vector-%S" C reg-num 1 vector] 6]) (defalias 'ediff-set-fine-overlays-in-one-buffer #[(buf-type diff-list region-num) "ÀÂ Ä # Ç=ƒ‚2 É=ƒ\n‚2 Ë=ƒ*\f‚2 Í=…2ÐÐÐÐÐÐ ØÙÚ \"!JH‰ƒcÜÝÞH\"ˆ)ØÙÚ \"!JHÞÐIˆ*Ap ƒžá!ƒžâá!!ƒžãŽqˆbˆ)‚©$å=„©æç!ˆ)(ƒÆ Ë=ƒÆé !‰ƒÆê \"‚Lƒ= T@‰ Ç=ƒÞë‚é É=ƒèì‚éíH Ç=ƒøÞ‚ É=ƒî‚ïH„ƒ4ðT\"ðÕ#ñ#C¤A‰„ËØÙÚ \"!J HÞò!I. ‡" [-1 current-diff ediff-get-diff-posn buf-type beg region-num reg-start A ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer buff nil combined-merge-diff-list diff-overlay-list list-element begin end overlay n intern format "ediff-difference-vector-%S" diff-record mapcar ediff-delete-overlay 1 diff-list StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ediff-merge-job ediff-looks-like-combined-merge ediff-set-fine-overlays-for-combined-merge 0 2 4 3 5 ediff-goto-word ediff-make-bullet-proof-overlay vconcat] 6]) (defalias 'ediff-get-diff3-group #[(file) "ŠÀÁ\nÃQ!ˆÄyˆÅ”Å•{Ƙƒ>Ç”ƒ-ÈĔĕ{!Èɔɕ{!TD‚HÈĔĕ{!‰\n‰T)D‚HÈĔĕ{!T‰D)‡" [re-search-forward "^" file ":\\([0-9]+\\)\\(,\\([0-9]+\\)\\)?\\([ac]\\)$" 1 4 "c" 2 string-to-int 3 x] 5]) (defalias 'ediff-extract-diffs3 #[(diff-buffer word-mode three-way-comp &optional bounds) " \n ĉ‰‰Å‰‰‰ \n \f ƒ-Ó‚.Ô B ƒTÖ@!ÖA@!…RÖØ8!pƒƒÚ!ƒƒÛÚ!!ƒƒÜŽqˆƒ|‚}ebˆ)‚ŽÞ=„Žßà!ˆ)pƒ¾Ú!ƒ¾ÛÚ!!ƒ¾áŽqˆƒ·‚¸ebˆ)‚ÉÞ=„Éßà!ˆ)ƒ\npƒþÚ!ƒþÛÚ!!ƒþâŽqˆƒ÷‚øebˆ)‚ Þ=„ ßà!ˆ)ƒPÚ!ƒPÛÚ!!ƒPpƒDÚ!ƒDÛÚ!!ƒDãŽqˆebˆ)‚OÞ=„Oßà!ˆ)p$ƒÚ$!ƒÛÚ$!!ƒåŽ$qˆebˆæ'Åè#ƒÄyˆÄ”Ä•{)„)ꘄ\fëì!@-ëì!A@.ëï!@0ëï!A@1ëê!@2ëê!A@3)옃Âô‚Ï)Íõ‚Ï6‰7ø>ƒÛù‚Üú;)옃éú‚ü)ôù‚ü)ꘅüü=Å>Å?Å@ÅAÅBÅCÅDÅEÅFÅGÅH23U>ƒ62?3@‚R6I=ƒJ0?1@‚R-?.@ƒ” J- Z.-Z0\fZ10Z? Z@?Zʼn‰‰‰& C¤ . 1\f@ ‚\npƒÐÚ!ƒÐÛÚ!!ƒÐKŽqˆ- Zyˆ`A.-Zyˆ`B. )‚ÛÞ=„Ûßà!ˆ)pƒÚ!ƒÛÚ!!ƒLŽqˆ0\fZyˆ`C10Zyˆ`D1\f)‚#Þ=„#ßà!ˆ)pƒ`Ú!ƒ`ÛÚ!!ƒ`MŽqˆ? Zyˆ`E@?Zyˆ`F@ )‚kÞ=„kßà!ˆ)ƒÉÚ!ƒÉÛÚ!!ƒÉpƒ½Ú!ƒ½ÛÚ!!ƒ½NŽqˆ2\nZyˆ`G32Zyˆ`H3\n)‚ÈÞ=„Èßà!ˆ) ƒëJABCDEFʼn=ʼn& C‚JABCDEFGH;7>& C¤ .)‚q)‚Þ=„ßà!ˆ) .\f‡" [ediff-buffer-A ediff-buffer-B ediff-buffer-C ediff-ancestor-buffer 1 nil shift-C shift-B shift-A diff-list anc-prev c-prev b-prev a-prev anc-buffer C-buffer B-buffer A-buffer word-mode words points bounds ediff-overlay-start three-way-comp 2 StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) diff-buffer ((set-buffer StartBuffer)) re-search-forward ediff-match-diff3-line t agreement "3" ediff-get-diff3-group "1" a-begin a-end "2" b-begin b-end c-or-anc-begin c-or-anc-end prefer-A prefer-B ediff-default-variant state-of-merge (default-A prefer-A) B A state-of-diff-merge C state-of-diff-comparison state-of-ancestor c-begin c-end a-begin-pt a-end-pt b-begin-pt b-end-pt c-begin-pt c-end-pt anc-begin-pt anc-end-pt default-B vector ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer))] 14]) (defalias 'ediff-setup-diff-regions3 #[(file-A file-B file-C) "ƒÁ ƒÄ !ƒÅÄ !!„ÆÇÈÉ\"!ÊË!ˆÌ Î&ˆÓ \"ˆÕÖ $!‡" [ediff-xemacs-p t synchronize-minibuffers ediff-diff-buffer get-buffer buffer-name get-buffer-create ediff-unique-buffer-name "*ediff-diff" "*" message "Computing differences ..." ediff-exec-process ediff-diff3-program synchronize ediff-diff3-options file-A file-B file-C ediff-prepare-error-list ediff-diff3-ok-lines-regexp ediff-convert-diffs-to-overlays ediff-extract-diffs3 ediff-word-mode ediff-3way-comparison-job ediff-narrow-bounds] 8]) (defalias 'ediff-exec-process #[(program buffer synch &rest args) "À ÂÃ\f@\"ƒ\fAÅÆ\f\"ÇÈÉ\fÊ#!ËŽ\fÆ ŠqˆÐ ˆ\fÒ=„<ƒJÔÕÆÆ\f&‚r×!‰ ƒYØ !ˆÔÙÚ\f% ÛÝ Þ\"ˆß à\"-‡" [match-data data string-match "^[ ]*$" args delq nil ediff-split-string mapconcat identity " " ((store-match-data data)) default-directory proc directory buffer erase-buffer system-type emx synch apply call-process program get-buffer-process kill-process start-process "Custom Diff" (":%s") mode-line-process set-process-sentinel ediff-process-sentinel set-process-filter ediff-process-filter] 8]) (defalias 'ediff-process-filter #[(proc string) "pÁ\n!ÄÆ !È! ÊŽ qˆ`dU„ `dbˆË\f!.‡" [obuf process-buffer proc buffer nil opoint get-buffer-window window window-start pos ((byte-code "À \n\"ˆ ƒ\f bˆ\fq‡" [set-window-start window pos opoint obuf] 3)) insert-before-markers string] 2]) (defalias 'ediff-process-sentinel #[(process signal) "À !Â>…ÃÄ !!…ŠÄ !qˆÅ)Ç !‡" [process-status process (exit signal) buffer-name process-buffer nil mode-line-process delete-process] 3]) #@106 *Function to call to move to the next word. Used for splitting difference regions into individual words. (defvar ediff-forward-word-function (quote ediff-forward-word) (#$ . -20372)) #@113 *Characters constituting white space. These characters are ignored when differing regions are split into words. (defvar ediff-whitespace " \n \f" (#$ . -20562)) #@159 *Characters that constitute words of type 1. More precisely, [ediff-word-1] is a regexp that matches type 1 words. See `ediff-forward-word' for more details. (defvar ediff-word-1 "a-zA-Z---_" (#$ . -20730)) #@159 *Characters that constitute words of type 2. More precisely, [ediff-word-2] is a regexp that matches type 2 words. See `ediff-forward-word' for more details. (defvar ediff-word-2 "0-9.," (#$ . -20944)) #@159 *Characters that constitute words of type 3. More precisely, [ediff-word-3] is a regexp that matches type 3 words. See `ediff-forward-word' for more details. (defvar ediff-word-3 "`'?!:;\"{}[]()" (#$ . -21153)) #@159 *Characters that constitute words of type 4. More precisely, [ediff-word-4] is a regexp that matches type 4 words. See `ediff-forward-word' for more details. (defvar ediff-word-4 (concat "^" ediff-word-1 ediff-word-2 ediff-word-3 ediff-whitespace) (#$ . -21371)) #@265 Move point one word forward. There are four types of words, each of which consists entirely of characters in `ediff-word-1', `ediff-word-2', `ediff-word-3', or `ediff-word-4'. Words are recognized by passing these in turn as the argument to `skip-chars-forward'. (defalias 'ediff-forward-word #[nil "ÁwÂV† ÁwÂV†\fÁwÂV† ÁwÂV‡" [ediff-word-1 nil 0 ediff-word-2 ediff-word-3 ediff-word-4] 2 (#$ . 21641)]) (defalias 'ediff-wordify #[(beg end in-buffer out-buffer &optional control-buf) "À‰Š qˆ\f {qˆÇ ˆ cˆebˆÀwˆe`|ˆm?…u ƒ`p\n ƒPË !ƒPÌË !!ƒPÍŽ qˆ)‚ZÐ=†ZÑÒ!) ˆ‚d ˆ`Àwˆ\n`|ˆÓcˆ‚\"+‡" [nil string sv-point in-buffer beg end out-buffer erase-buffer ediff-whitespace control-buf StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-forward-word-function this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" "\n"] 3]) (defalias 'ediff-copy-to-buffer #[(beg end in-buffer out-buffer) "ÀŠ\nqˆ \f{ qˆÆ ˆ cˆeb*‡" [nil string in-buffer beg end out-buffer erase-buffer] 2]) (defalias 'ediff-goto-word #[(n buf &optional flag) "p ƒLÄ !ƒLÅÄ !!ƒLÆŽ qˆÈwˆ ÊVƒ8 ˆÈwˆ S‰ ‚\" ƒG ÌVƒG ˆ`)‚V Î=†VÏÐ!*‡" [ediff-forward-word-function fwd-word-fun StartBuffer buf get-buffer buffer-name ((set-buffer StartBuffer)) ediff-whitespace nil n 1 flag 0 this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 4]) (provide (quote ediff-diff)) emacs-19.30/lisp/ediff-hook.elc100666 12241 1 16061 6054204371 15264 0ustar rolanddaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 20 18:02:10 1995 ;;; from file /home/fsf/rms/e19/lisp/ediff-hook.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`ediff-hook.el' was compiled for Emacs 19.29 or later")) (defalias 'ediff-xemacs-init-menus #[nil "ÀÁ!…%ÂÃ\fÅ#ˆÂÆÅ#ˆÂÈ Å#ˆÊËÌÅ#ˆÊÍÎÅ#‡" [featurep menubar add-submenu ("Tools") ediff-menu "OO-Browser..." ("Tools") ediff-merge-menu ("Tools") epatch-menu add-menu-button ("Tools") ["List Ediff Sessions" ediff-show-registry t] ("Tools") ["---" nil nil]] 4]) (byte-code "ÀÁ\n\"ƒCÃÄ!„ÅÄBÃÇ!„ÈÇBÃÉ!„-Ê ÉBËÌÍ\"ˆ„’Í ˆ‚’ÏÐ!ƒ’ÃÑ!„TÒÓ!ÑBщJMˆÃÔ!„jÒÕ!ÔBÔ‰JMˆÃÖ!„€Ò×!ÖBÖ‰JMˆØÙÚ#ˆØÛÜ#ˆØÝÞ#ˆØßà#ˆØáâ#ˆØãä#ˆØåæ#ˆØçè#ˆØéê#ˆØëì#ˆØíî#ˆØïð#ˆØñò#ˆØóô#ˆØõö#ˆØ÷ø#ˆØùú#ˆØûü#ˆØýþ#ˆØÿ@#ˆØAB#ˆØCD#ˆØEF#ˆØGH#ˆØIJ#ˆØKL#ˆØMN#ˆØOP#ˆØQR#ˆØST#ˆØUV#ˆ„WXYZ[$ˆW\\YZ[$ˆW]Y^[$ˆW_Y`[$ˆWaY`[$ˆWbYc[$ˆWdYe[$ˆWfYg[$ˆWhYi[$ˆWjYk[$ˆWlYm[$ˆWnYo[$ˆWpYo[$ˆWqYr#ˆWsYr[$ˆWtYu[$ˆWvYu[$ˆWwYx[$ˆWyYz[$ˆW{Y|[$ˆW}Y~[$ˆWY~[$ˆW€Y[$ˆW‚Y[$ˆWƒY„[$ˆW…Y„[$ˆW†Y‡[$ˆWˆY‡[$ˆW‰YŠ[$ˆW‹YŠ[$ˆWŒY[$ˆWŽY[$ˆWY[$ˆW‘Y[$ˆW’Y“[$ˆW”Y“[$ˆW•–—[$ˆW˜Y™[$ˆš›!‡" [string-match "XEmacs" emacs-version boundp ediff-menu ("Compare" ["Two Files ..." ediff-files t] ["Two Buffers ..." ediff-buffers t] ["Three Files ..." ediff-files3 t] ["Three Buffers ..." ediff-buffers3 t] "---" ["Two Directories ..." ediff-directories t] ["Three Directories ..." ediff-directories3 t] "---" ["File with Revision ..." ediff-revision t] ["Directory Revisions ..." ediff-directory-revisions t] "---" ["Windows Word-by-word ..." ediff-windows-wordwise t] ["Windows Line-by-line ..." ediff-windows-linewise t] "---" ["Regions Word-by-word ..." ediff-regions-wordwise t] ["Regions Line-by-line ..." ediff-regions-linewise t]) current-load-list ediff-merge-menu ("Merge" ["Files ..." ediff-merge-files t] ["Files with Ancestor ..." ediff-merge-files-with-ancestor t] ["Buffers ..." ediff-merge-buffers t] ["Buffers with Ancestor ..." ediff-merge-buffers-with-ancestor t] "---" ["Directories ..." ediff-merge-directories t] ["Directories with Ancestor ..." ediff-merge-directories-with-ancestor t] "---" ["Revisions ..." ediff-merge-revisions t] ["Revisions with Ancestor ..." ediff-merge-revisions-with-ancestor t] ["Directory Revisions ..." ediff-merge-directory-revisions t] ["Directory Revisions with Ancestor ..." ediff-merge-directory-revisions-with-ancestor t]) epatch-menu ("Apply Patch" ["To a file ..." ediff-patch-file t] ["To a buffer ..." ediff-patch-buffer t]) add-hook before-init-hook ediff-xemacs-init-menus purify-flag featurep menu-bar menu-bar-epatch-menu make-sparse-keymap "Apply Patch" menu-bar-ediff-merge-menu "Merge" menu-bar-ediff-menu "Compare" define-key [window] ("This Window And Next Window" . compare-windows) [ediff-dir-revision] ("Directory Revisions ..." . ediff-directory-revisions) [ediff-revision] ("File with Revision ..." . ediff-revision) [separator-ediff-directories] ("--") [ediff-directories3] ("Three Directories ..." . ediff-directories3) [ediff-directories] ("Two Directories ..." . ediff-directories) [separator-ediff-files] ("--") [ediff-buffers3] ("Three Buffers ..." . ediff-buffers3) [ediff-files3] ("Three Files ..." . ediff-files3) [ediff-buffers] ("Two Buffers ..." . ediff-buffers) [ediff-files] ("Two Files ..." . ediff-files) [separator-ediff-regions] ("--") [ediff-regions-linewise] ("Regions Line-by-line ..." . ediff-regions-linewise) [ediff-regions-wordwise] ("Regions Word-by-word ..." . ediff-regions-wordwise) [separator-ediff-windows] ("--") [ediff-windows-linewise] ("Windows Line-by-line ..." . ediff-windows-linewise) [ediff-windows-wordwise] ("Windows Word-by-word ..." . ediff-windows-wordwise) [ediff-merge-dir-revisions-with-ancestor] ("Directory Revisions with Ancestor ..." . ediff-merge-directory-revisions-with-ancestor) [ediff-merge-dir-revisions] ("Directory Revisions ..." . ediff-merge-directory-revisions) [ediff-merge-revisions-with-ancestor] ("Revisions with Ancestor ..." . ediff-merge-revisions-with-ancestor) [ediff-merge-revisions] ("Revisions ..." . ediff-merge-revisions) [separator-ediff-merge] ("--") [ediff-merge-directories-with-ancestor] ("Directories with Ancestor ..." . ediff-merge-directories-with-ancestor) [ediff-merge-directories] ("Directories ..." . ediff-merge-directories) [separator-ediff-merge-dirs] ("--") [ediff-merge-buffers-with-ancestor] ("Buffers with Ancestor ..." . ediff-merge-buffers-with-ancestor) [ediff-merge-buffers] ("Buffers ..." . ediff-merge-buffers) [ediff-merge-files-with-ancestor] ("Files with Ancestor ..." . ediff-merge-files-with-ancestor) [ediff-merge-files] ("Files ..." . ediff-merge-files) [ediff-patch-buffer] ("To a Buffer ..." . ediff-patch-buffer) [ediff-patch-file] ("To a File ..." . ediff-patch-file) autoload ediff "ediff" "Compare two files" t ediff-files ediff-buffers "Compare two bufers" ediff3 "Compare three files" ediff-files3 ediff-buffers3 "Compare three bufers" ediff-revision "Compare versions of a file" ediff-windows-wordwise "Compare two windows word-by-word" ediff-regions-wordwise "Compare two regions word-by-word" ediff-windows-linewise "Compare two windows line-by-line" ediff-regions-linewise "Compare two regions line-by-line" ediff-patch-file "Patch a file" epatch ediff-patch-buffer "Patch a buffer" epatch-buffer ediff-merge "Merge two files" ediff-merge-files ediff-merge-files-with-ancestor "Merge two files using a third file as an ancestor" ediff-merge-buffers "Merge two buffers" ediff-merge-buffers-with-ancestor "Merge two buffers using a third buffer as an ancestor" ediff-merge-revisions "Merge two versions of a file" ediff-merge-revisions-with-ancestor edirs "Compare files in two directories" ediff-directories edirs3 "Compare files in three directories" ediff-directories3 edir-revisions "Compare two versions of a file" ediff-directory-revisions edirs-merge "Merge files in two directories" ediff-merge-directories edirs-merge-with-ancestor "Merge files in two directories using files in a third dir as ancestors" ediff-merge-directories-with-ancestor edir-merge-revisions "Merge versions of files in a directory" ediff-merge-directory-revisions ediff-merge-directory-revisions-with-ancestor "Merge versions of files in a directory using other versions as ancestors" edir-merge-revisions-with-ancestor ediff-show-registry "ediff-mult" "Display the registry of active Ediff sessions" ediff-version "Show Ediff's version and last modification date" provide ediff-hook] 5) emacs-19.30/lisp/ediff-init.elc100666 75424 12 153367 6051026753 14727 0ustar kwzhstaff;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 10 23:59:28 1995 ;;; from file /home/fsf/rms/e19/lisp/ediff-init.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`ediff-init.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ\n\"Ã\fB ?Å\fBÀ‡" [string-match "XEmacs" emacs-version ediff-xemacs-p current-load-list ediff-emacs-p] 3) (defalias 'ediff-device-type #[nil "ƒ ‡Âà !‡" [ediff-emacs-p window-system device-type selected-device] 2]) (put (quote ediff-device-type) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-window-display-p #[nil "ƒ ‚\fÂà !…ƒ ‚Âà !Ä>?‡" [ediff-emacs-p window-system device-type selected-device (tty stream)] 2]) (put (quote ediff-window-display-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-odd-p '(macro . #[(arg) "ÀÁ\nÃBBÄBB‡" [eq logand arg (1) (1)] 4])) (defalias 'ediff-buffer-live-p '(macro . #[(buf) "À  DàDDF‡" [and buf get-buffer buffer-name] 6])) (defalias 'ediff-get-buffer '(macro . #[(arg) "ÀÁ\nÃBBÄBÁ\nÅBBÆBÁ\nÇBBÈBÁ\nÉBBÊB¯‡" [cond eq arg ((quote A)) (ediff-buffer-A) ((quote B)) (ediff-buffer-B) ((quote C)) (ediff-buffer-C) ((quote Ancestor)) (ediff-ancestor-buffer)] 7])) (defalias 'ediff-get-value-according-to-buffer-type '(macro . #[(buf-type list) "ÀÁ\nÃBBÄÅEDÁ\nÇBBÄÈEDÁ\nÉBBÄÊEDF‡" [cond eq buf-type ((quote A)) nth 0 list ((quote B)) 1 ((quote C)) 2] 7])) (defalias 'ediff-char-to-buftype '(macro . #[(arg) "ÀÁ\nÃBBÄBÁ\nÅBBÆBÁ\nÇBBÈBF‡" [cond memq arg ((quote (97 65))) ((quote A)) ((quote (98 66))) ((quote B)) ((quote (99 67))) ((quote C))] 6])) (defalias 'ediff-get-difference '(macro . #[(n buf-type) "ÀÁÂÃÄ EDDE‡" [aref symbol-value intern format "ediff-difference-vector-%S" buf-type n] 6])) (defalias 'ediff-no-fine-diffs-p '(macro . #[(n) "ÀÁ\nÃBBÄBB‡" [aref ediff-get-difference n ((quote A)) (2)] 4])) (defalias 'ediff-get-diff-overlay-from-diff-record '(macro . #[(diff-rec) "À ÂBB‡" [aref diff-rec (0)] 3])) (defalias 'ediff-get-diff-overlay '(macro . #[(n buf-type) "ÀÁ\n ED‡" [ediff-get-diff-overlay-from-diff-record ediff-get-difference n buf-type] 4])) (defalias 'ediff-get-fine-diff-vector-from-diff-record '(macro . #[(diff-rec) "À ÂBB‡" [aref diff-rec (1)] 3])) (defalias 'ediff-set-fine-diff-vector '(macro . #[(n buf-type fine-vec) "ÀÁ\n EÄ F‡" [aset ediff-get-difference n buf-type 1 fine-vec] 4])) (defalias 'ediff-get-state-of-diff '(macro . #[(n buf-type) "ÀÁÂÃ\f EÆBBE‡" [if (ediff-buffer-live-p ediff-buffer-C) aref ediff-get-difference n buf-type (3)] 6])) (defalias 'ediff-set-state-of-diff '(macro . #[(n buf-type val) "ÀÁ\n EÄ F‡" [aset ediff-get-difference n buf-type 3 val] 4])) (defalias 'ediff-get-state-of-merge '(macro . #[(n) "ÀÁ‰Á EÄBBE‡" [if ediff-state-of-merge aref n (0)] 6])) (defalias 'ediff-get-state-of-ancestor '(macro . #[(n) "ÀÁ‰Á EÄBBE‡" [if ediff-state-of-merge aref n (1)] 6])) (defalias 'ediff-set-state-of-merge '(macro . #[(n val) "ÀÁÂÃÁ\fEÅFE‡" [if ediff-state-of-merge aset aref n 0 val] 6])) (defalias 'ediff-mark-diff-as-space-only '(macro . #[(n flag) "ÀÁ\nÃBBÄ F‡" [aset ediff-get-difference n ((quote A)) 2 flag] 4])) (defalias 'ediff-get-fine-diff-vector '(macro . #[(n buf-type) "ÀÁ\n ED‡" [ediff-get-fine-diff-vector-from-diff-record ediff-get-difference n buf-type] 4])) (defalias 'ediff-defvar-local '(macro . #[(var value doc) "ÀÁ\n \fFÅÆ\nDDÇÆ\nDÈBBF‡" [progn defvar var value doc make-variable-buffer-local quote put ((quote permanent-local) t)] 6])) (defalias 'ediff-eval-in-buffer '(macro . #[(buffer &rest forms) "ÀÁÂÃ\fDÅÆÇ\fDBBÉBBÊBBBE‡" [let ((StartBuffer (current-buffer))) if ediff-buffer-live-p buffer unwind-protect progn set-buffer forms ((set-buffer StartBuffer)) ((or (eq this-command (quote ediff-quit)) (error "You've killed an essential Ediff buffer---Please quit Ediff")))] 8])) (defalias 'ediff-multiframe-setup-p #[nil "ƒ ‚\fÂà !…\"ƒ ‚Âà !Ä>?…\" ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) ediff-multiframe] 2]) (put (quote ediff-multiframe-setup-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-narrow-control-frame-p '(macro . #[nil "À‡" [(and (ediff-multiframe-setup-p) (equal ediff-help-message ediff-brief-message-string))] 1])) (defalias 'ediff-3way-comparison-job '(macro . #[nil "À‡" [(memq ediff-job-name (quote (ediff-files3 ediff-buffers3)))] 1])) #@2  (defvar ediff-3way-comparison-job nil (#$ . 4637)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-3way-comparison-job put permanent-local t] 4) (defalias 'ediff-merge-job '(macro . #[nil "À‡" [(memq ediff-job-name (quote (ediff-merge-files ediff-merge-buffers ediff-merge-files-with-ancestor ediff-merge-buffers-with-ancestor ediff-merge-revisions ediff-merge-revisions-with-ancestor)))] 1])) #@2  (defvar ediff-merge-job nil (#$ . 5047)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-merge-job put permanent-local t] 4) (defalias 'ediff-merge-with-ancestor-job '(macro . #[nil "À‡" [(memq ediff-job-name (quote (ediff-merge-files-with-ancestor ediff-merge-buffers-with-ancestor ediff-merge-revisions-with-ancestor)))] 1])) #@2  (defvar ediff-merge-with-ancestor-job nil (#$ . 5391)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-merge-with-ancestor-job put permanent-local t] 4) (defalias 'ediff-3way-job '(macro . #[nil "À‡" [(or ediff-3way-comparison-job ediff-merge-job)] 1])) #@2  (defvar ediff-3way-job nil (#$ . 5661)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-3way-job put permanent-local t] 4) (defalias 'ediff-diff3-job '(macro . #[nil "À‡" [(or ediff-3way-comparison-job ediff-merge-with-ancestor-job)] 1])) #@2  (defvar ediff-diff3-job nil (#$ . 5916)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-diff3-job put permanent-local t] 4) (defalias 'ediff-windows-job '(macro . #[nil "À‡" [(memq ediff-job-name (quote (ediff-windows-wordwise ediff-windows-linewise)))] 1])) #@2  (defvar ediff-windows-job nil (#$ . 6192)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-windows-job put permanent-local t] 4) (defalias 'ediff-word-mode-job '(macro . #[nil "À‡" [(memq ediff-job-name (quote (ediff-windows-wordwise ediff-regions-wordwise)))] 1])) #@2  (defvar ediff-word-mode-job nil (#$ . 6474)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-word-mode-job put permanent-local t] 4) (defalias 'ediff-narrow-job '(macro . #[nil "À‡" [(memq ediff-job-name (quote (ediff-windows-wordwise ediff-regions-wordwise ediff-windows-linewise ediff-regions-linewise)))] 1])) #@2  (defvar ediff-narrow-job nil (#$ . 6803)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-narrow-job put permanent-local t] 4) (defalias 'ediff-ancestor-metajob #[(&optional metajob) "† Â>‡" [metajob ediff-metajob-name (ediff-merge-directories-with-ancestor ediff-merge-filegroups-with-ancestor)] 2]) (put (quote ediff-ancestor-metajob) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-revision-metajob #[(&optional metajob) "† Â>‡" [metajob ediff-metajob-name (ediff-directory-revisions ediff-merge-directory-revisions ediff-merge-directory-revisions-with-ancestor)] 2]) (put (quote ediff-revision-metajob) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-dir1-metajob #[(&optional metajob) "‰† Â>)‡" [metajob ediff-metajob-name (ediff-directory-revisions ediff-merge-directory-revisions ediff-merge-directory-revisions-with-ancestor)] 3]) (put (quote ediff-dir1-metajob) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-collect-diffs-metajob #[(&optional metajob) "‰† Â>)† Ã>‡" [metajob ediff-metajob-name (ediff-directory-revisions ediff-merge-directory-revisions ediff-merge-directory-revisions-with-ancestor) (ediff-directories ediff-directory-revisions)] 3]) (put (quote ediff-collect-diffs-metajob) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-metajob3 #[(&optional metajob) "† Â>‡" [metajob ediff-metajob-name (ediff-merge-directories-with-ancestor ediff-merge-filegroups-with-ancestor ediff-directories3 ediff-filegroups3)] 2]) (put (quote ediff-metajob3) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-comparison-metajob3 #[(&optional metajob) "† Â>‡" [metajob ediff-metajob-name (ediff-directories3 ediff-filegroups3)] 2]) (put (quote ediff-comparison-metajob3) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-barf-if-not-control-buffer #[(&optional meta-buf) "ƒ ‚ \np=†ÃÄ \"‡" [meta-buf ediff-meta-buffer ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command] 3]) (put (quote ediff-barf-if-not-control-buffer) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@167 *Hooks to run before Ediff sets its window configuration. This can be used to save the previous window config, which can be restored on ediff-quit or ediff-suspend. (defvar ediff-before-setup-windows-hook nil (#$ . -9039)) #@129 *Hooks to run after Ediff sets its window configuration. This can be used to set up control window or icon in a desired place. (defvar ediff-after-setup-windows-hook nil (#$ . -9270)) #@157 *Hooks run before setting up the frame to display Ediff Control Panel. Can be used to change control frame parameters to position it where it is desirable. (defvar ediff-before-setup-control-frame-hook nil (#$ . -9462)) #@122 *Hooks run after setting up the frame to display Ediff Control Panel. Can be used to move the frame where it is desired. (defvar ediff-after-setup-control-frame-hook nil (#$ . -9689)) #@66 *Hooks to run in the control buffer after Ediff has been set up. (defvar ediff-startup-hook nil (#$ . -9879)) #@53 *Hooks to run after a difference has been selected. (defvar ediff-select-hook nil (#$ . -9995)) #@55 *Hooks to run after a difference has been unselected. (defvar ediff-unselect-hook nil (#$ . -10097)) #@53 *Hooks called after buffers A, B, and C are set up. (defvar ediff-prepare-buffer-hook nil (#$ . -10204)) #@67 *Hook run after Ediff is loaded. Can be used to change defaults. (defvar ediff-load-hook nil (#$ . -10315)) #@203 *Hook run just after ediff-mode is set up in the control buffer. This is done before any windows or frames are created. One can use it to set local variables that determine how the display looks like. (defvar ediff-mode-hook nil (#$ . -10431)) #@71 *Hook run just after the default bindings in Ediff keymap are set up. (defvar ediff-keymap-setup-hook nil (#$ . -10682)) #@46 *Hooks run after preparing the help message. (defvar ediff-display-help-hook nil (#$ . -10809)) #@68 *Hooks to run in the Ediff control buffer when Ediff is suspended. (defvar ediff-suspend-hook (list (quote ediff-default-suspend-function)) (#$ . -10911)) #@66 *Hooks to run in the Ediff control buffer after finishing Ediff. (defvar ediff-quit-hook (list (quote ediff-cleanup-mess)) (#$ . -11072)) #@220 *Hooks to run on exiting Ediff but before killing the control buffer. This is a place to do various cleanups, such as deleting the variant buffers. Ediff provides a function, `ediff-janitor', as one such possible hook. (defvar ediff-cleanup-hook nil (#$ . -11217)) #@36 The head of the full help message. (defconst ediff-long-help-message-head " Moving around | Toggling features | Manipulations\n=====================|===========================|=============================" (#$ . 11488)) #@36 The tail of the full-help message. (defconst ediff-long-help-message-tail "=====================|===========================|=============================\n R -show registry | | M -show session group\n D -diff output | E -browse Ediff manual| G -send bug report \n i -status info | ? -help off | z/q -suspend/quit\n-------------------------------------------------------------------------------\nX,Y (x,y) on the left are meta-symbols for the keys A,B,C (a,b,c).\nX,Y on the right are meta-symbols for buffers A,B,C.\nA,B,C on the right denote the working buffers A,B,C, respectively." (#$ . 11736)) #@116 Help message usually used for 3-way comparison. Normally, not a user option. See `ediff-help-message' for details. (defconst ediff-long-help-message-compare3 "\np,DEL -previous diff | | -vert/horiz split | xy -copy buf X's region to Y\nn,SPC -next diff | h -hiliting | rx -restore buf X's old diff\n j -jump to diff | @ -auto-refinement | * -refine current region\n gx -goto X's point| | ! -update diff regions\n C-l -recenter | ## -ignore whitespace |\n v/V -scroll up/dn | #f/#h -focus/hide regions | wx -save buf X\n -scroll lt/rt | X -read-only in buf X | wd -save diff output\n | m -wide display | ~ -rotate buffers\n" (#$ . 12411)) #@116 Help message usually used for 2-way comparison. Normally, not a user option. See `ediff-help-message' for details. (defconst ediff-long-help-message-compare2 "\np,DEL -previous diff | | -vert/horiz split |a/b -copy A/B's region to B/A\nn,SPC -next diff | h -hiliting | rx -restore buf X's old diff\n j -jump to diff | @ -auto-refinement | * -refine current region\n gx -goto X's point| | ! -update diff regions\n C-l -recenter | ## -ignore whitespace |\n v/V -scroll up/dn | #f/#h -focus/hide regions | wx -save buf X\n -scroll lt/rt | X -read-only in buf X | wd -save diff output\n | m -wide display | ~ -swap buffers\n" (#$ . 13174)) #@129 Help message when comparing windows or regions line-by-line. Normally, not a user option. See `ediff-help-message' for details. (defconst ediff-long-help-message-narrow2 "\np,DEL -previous diff | | -vert/horiz split |a/b -copy A/B's region to B/A\nn,SPC -next diff | h -hiliting | rx -restore buf X's old diff\n j -jump to diff | @ -auto-refinement | * -refine current region\n gx -goto X's point| % -narrow/widen buffs | ! -update diff regions\n C-l -recenter | ## -ignore whitespace |\n v/V -scroll up/dn | #f/#h -focus/hide regions | wx -save buf X\n -scroll lt/rt | X -read-only in buf X | wd -save diff output\n | m -wide display | ~ -swap buffers\n" (#$ . 13935)) #@129 Help message when comparing windows or regions word-by-word. Normally, not a user option. See `ediff-help-message' for details. (defconst ediff-long-help-message-word-mode "\np,DEL -previous diff | | -vert/horiz split | xy -copy buf X's region to Y\nn,SPC -next diff | h -hiliting | rx -restore buf X's old diff\n j -jump to diff | | \n gx -goto X's point| % -narrow/widen buffs | ! -recompute diffs\n C-l -recenter | |\n v/V -scroll up/dn | #f/#h -focus/hide regions | wx -save buf X\n -scroll lt/rt | X -read-only in buf X | wd -save diff output\n | m -wide display | ~ -swap buffers\n" (#$ . 14708)) #@97 Help message during merging. Normally, not a user option. See `ediff-help-message' for details. (defconst ediff-long-help-message-merge "\np,DEL -previous diff | | -vert/horiz split | x -copy buf X's region to C\nn,SPC -next diff | h -hiliting | r -restore buf C's old diff\n j -jump to diff | @ -auto-refinement | * -refine current region\n gx -goto X's point| ## -ignore whitespace | ! -update diff regions\n C-l -recenter | #f/#h -focus/hide regions | + -combine diff regions\n v/V -scroll up/dn | X -read-only in buf X | wx -save buf X\n -scroll lt/rt | m -wide display | wd -save diff output\n / -ancestor buff | s -shrink window C | ~ -swap buffers\n | $ -show clashes only | & -merge w/new default\n" (#$ . 15471)) #@68 Normally, not a user option. See `ediff-help-message' for details. (defvar ediff-long-help-message "" (#$ . 16310)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-long-help-message put permanent-local t] 4) #@37 Contents of the brief help message. (defconst ediff-brief-message-string " ? - help " (#$ . 16534)) #@68 Normally, not a user option. See `ediff-help-message' for details. (defvar ediff-brief-help-message "" (#$ . 16642)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-brief-help-message put permanent-local t] 4) #@194 The brief help message that the user can customize. If the user sets this to a parameter-less function, Ediff will use it to produce the brief help message. This function must return a string. (defvar ediff-brief-help-message-function nil (#$ . 16869)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-brief-help-message-function put permanent-local t] 4) #@102 The long help message that the user can customize. See `ediff-brief-help-message-function' for more. (defvar ediff-long-help-message-function nil (#$ . 17241)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-long-help-message-function put permanent-local t] 4) #@73 *If t, Ediff starts with a long help message. Short help msg otherwise. (defvar ediff-prefer-long-help-message nil (#$ . -17518)) #@263 The actual help message. Normally, the user shouldn't touch this. However, if you want Ediff to start up with different help messages for different jobs, you can change the value of this variable and the variables `ediff-help-message-*' in `ediff-startup-hook'. (defvar ediff-help-message "" (#$ . 17655)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-help-message put permanent-local t] 4) #@279 Function that determines the next/previous diff region to show. Should return t for regions to be ignored and nil otherwise. This function gets a region number as an argument. The region number is the one used internally by Ediff. It is 1 less than the number seen by the user. (defvar ediff-skip-diff-region-function (quote ediff-show-all-diffs) (#$ . 18065)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-skip-diff-region-function put permanent-local t] 4) #@128 Function to use in determining which regions to hide. See the documentation string of `ediff-hide-regexp-matches' for details. (defvar ediff-hide-regexp-matches-function (quote ediff-hide-regexp-matches) (#$ . 18543)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-hide-regexp-matches-function put permanent-local t] 4) #@136 Function to use in determining which regions to focus on. See the documentation string of `ediff-focus-on-regexp-matches' for details. (defvar ediff-focus-on-regexp-matches-function (quote ediff-focus-on-regexp-matches) (#$ . 18881)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-focus-on-regexp-matches-function put permanent-local t] 4) #@2  (defvar ediff-regexp-focus-A "" (#$ . 19237)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-regexp-focus-A put permanent-local t] 4) #@2  (defvar ediff-regexp-focus-B "" (#$ . 19388)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-regexp-focus-B put permanent-local t] 4) #@2  (defvar ediff-regexp-focus-C "" (#$ . 19539)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-regexp-focus-C put permanent-local t] 4) #@2  (defvar ediff-focus-regexp-connective (quote and) (#$ . 19690)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-focus-regexp-connective put permanent-local t] 4) #@2  (defvar ediff-regexp-hide-A "" (#$ . 19868)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-regexp-hide-A put permanent-local t] 4) #@2  (defvar ediff-regexp-hide-B "" (#$ . 20017)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-regexp-hide-B put permanent-local t] 4) #@2  (defvar ediff-regexp-hide-C "" (#$ . 20166)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-regexp-hide-C put permanent-local t] 4) #@2  (defvar ediff-hide-regexp-connective (quote and) (#$ . 20315)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-hide-regexp-connective put permanent-local t] 4) #@55 Function ange-ftp uses to find out if file is remote. (defvar ediff-ange-ftp-ftp-name (byte-code "ƒÁ‡Â‡" [ediff-xemacs-p ange-ftp-ftp-path ange-ftp-ftp-name] 1) (#$ . 20492)) #@240 A list of killed diffs. A diff is saved here if it is replaced by a diff from another buffer. This alist has the form: ((num (buff-object . diff) (buff-object . diff) (buff-object . diff)) ...), where some buffer-objects may be missing. (defvar ediff-killed-diffs-alist nil (#$ . 20677)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-killed-diffs-alist put permanent-local t] 4) #@82 *Flag placed above the highlighted block of differences. Must end with newline. (defvar ediff-before-flag-bol (byte-code "ƒÁÂ!‡Â‡" [ediff-xemacs-p make-glyph "->>"] 2) (#$ . -21076)) #@81 *Flag placed below the highlighted block of differences. Must end with newline. (defvar ediff-after-flag-eol (byte-code "ƒÁÂ!‡Â‡" [ediff-xemacs-p make-glyph "<<-"] 2) (#$ . -21269)) #@69 *Like ediff-before-flag, used when a difference starts in mid-line. (defvar ediff-before-flag-mol (byte-code "ƒÁÂ!‡Â‡" [ediff-xemacs-p make-glyph "->>"] 2) (#$ . -21460)) #@68 *Like ediff-after-flag, used when a difference starts in mid-line. (defvar ediff-after-flag-mol (byte-code "ƒÁÂ!‡Â‡" [ediff-xemacs-p make-glyph "<<-"] 2) (#$ . -21640)) #@345 If t, differences are highlighted using faces on a window system. If nil, they are highlighted using ASCII flags, ediff-before-flag and ediff-after-flag. On a non-window system, differences are always highlighted using ASCII flags. This variable can be set either in .emacs or toggled interactively. Use `setq-default' if setting it in .emacs (defvar ediff-use-faces t (#$ . 21819)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-use-faces put permanent-local t] 4) #@2  (defvar ediff-word-mode nil (#$ . 22302)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-word-mode put permanent-local t] 4) #@2  (defvar ediff-job-name nil (#$ . 22444)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-job-name put permanent-local t] 4) #@2  (defvar ediff-narrow-bounds nil (#$ . 22584)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-narrow-bounds put permanent-local t] 4) #@2  (defvar ediff-wide-bounds nil (#$ . 22734)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-wide-bounds put permanent-local t] 4) #@2  (defvar ediff-visible-bounds nil (#$ . 22880)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-visible-bounds put permanent-local t] 4) #@75 Non-nil means start narrowed, if doing ediff-windows-* or ediff-regions-* (defvar ediff-start-narrowed t (#$ . 23033)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-start-narrowed put permanent-local t] 4) #@132 *Non-nil means: when finished, Ediff widens buffers A/B. Actually, Ediff restores the scope of visibility that existed at startup. (defvar ediff-quit-widened t (#$ . -23258)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-quit-widened put permanent-local t] 4) #@192 *Nil means that non-modified variant buffers should be removed after some interrogation. Supplying a prefix agument to the quit command `q' temporarily reverses the meaning of this variable. (defvar ediff-keep-variants t (#$ . -23537)) #@180 If nil, only the selected differences are highlighted. This variable can be set either in .emacs or toggled interactively, using ediff-toggle-hilit. Use `setq-default' to set it. (defvar ediff-highlight-all-diffs t (#$ . 23780)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-highlight-all-diffs put permanent-local t] 4) #@2  (defvar ediff-highlighting-style nil (#$ . 24118)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-highlighting-style put permanent-local t] 4) #@2  (defvar ediff-buffer-A nil (#$ . 24278)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-buffer-A put permanent-local t] 4) #@2  (defvar ediff-buffer-B nil (#$ . 24418)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-buffer-B put permanent-local t] 4) #@2  (defvar ediff-buffer-C nil (#$ . 24558)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-buffer-C put permanent-local t] 4) #@2  (defvar ediff-ancestor-buffer nil (#$ . 24698)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-ancestor-buffer put permanent-local t] 4) #@2  (defvar ediff-control-buffer nil (#$ . 24852)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-control-buffer put permanent-local t] 4) #@2  (defvar ediff-control-buffer-suffix nil (#$ . 25004)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-control-buffer-suffix put permanent-local t] 4) #@2  (defvar ediff-control-buffer-number nil (#$ . 25170)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-control-buffer-number put permanent-local t] 4) #@2  (defvar ediff-buffer-values-orig-A nil (#$ . 25336)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-buffer-values-orig-A put permanent-local t] 4) #@2  (defvar ediff-buffer-values-orig-B nil (#$ . 25500)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-buffer-values-orig-B put permanent-local t] 4) #@2  (defvar ediff-buffer-values-orig-C nil (#$ . 25664)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-buffer-values-orig-C put permanent-local t] 4) #@2  (defvar ediff-buffer-values-orig-Ancestor nil (#$ . 25828)) (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅÆBÀ‡" [make-variable-buffer-local ediff-buffer-values-orig-Ancestor put permanent-local t (buffer-read-only synchronize-minibuffers mode-line-format) ediff-protected-variables current-load-list] 4) #@2  (defvar ediff-difference-vector-A nil (#$ . 26121)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-difference-vector-A put permanent-local t] 4) #@2  (defvar ediff-difference-vector-B nil (#$ . 26283)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-difference-vector-B put permanent-local t] 4) #@2  (defvar ediff-difference-vector-C nil (#$ . 26445)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-difference-vector-C put permanent-local t] 4) #@2  (defvar ediff-difference-vector-Ancestor nil (#$ . 26607)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-difference-vector-Ancestor put permanent-local t] 4) #@2  (defvar ediff-state-of-merge nil (#$ . 26783)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-state-of-merge put permanent-local t] 4) #@2  (defvar ediff-current-difference -1 (#$ . 26935)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-current-difference put permanent-local t] 4) #@2  (defvar ediff-number-of-differences nil (#$ . 27094)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-number-of-differences put permanent-local t] 4) #@2  (defvar ediff-diff-buffer nil (#$ . 27260)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-diff-buffer put permanent-local t] 4) #@2  (defvar ediff-custom-diff-buffer nil (#$ . 27406)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-custom-diff-buffer put permanent-local t] 4) #@2  (defvar ediff-fine-diff-buffer nil (#$ . 27566)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-fine-diff-buffer put permanent-local t] 4) #@2  (defconst ediff-tmp-buffer " *ediff-tmp*" (#$ . 27722)) #@2  (defconst ediff-msg-buffer " *ediff-message*" (#$ . 27784)) #@2  (defvar ediff-error-buffer nil (#$ . 27850)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-error-buffer put permanent-local t] 4) #@2  (defvar ediff-debug-buffer "*ediff-debug*" (#$ . 27998)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-debug-buffer put permanent-local t] 4) #@2  (defvar ediff-this-buffer-ediff-sessions nil (#$ . 28158)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-this-buffer-ediff-sessions put permanent-local t] 4) #@2  (defvar ediff-disturbed-overlays nil (#$ . 28334)) #@2  (defvar ediff-shadow-overlay-priority 100 (#$ . 28391)) #@287 Version control package used. Currently, Ediff supports vc.el, rcs.el, and generic-sc.el. The standard Emacs interface to RCS, CVS, SCCS, etc., is vc.el. However, some people find the other two packages more convenient. Set this variable `rcs' or `generic-sc' if you are such a person. (defvar ediff-version-control-package (quote vc) (#$ . 28455)) (byte-code "ƒ%ÁÂKMˆÃÄKMˆÅÆKMˆÇÈKMˆÉÊKMˆËÌKMˆ‚HÁÍKMˆÃÎKMˆÃÎKMˆÅÏKMˆÇÐKMˆÉÑKMˆËÒKMˆÁ‡" [ediff-xemacs-p ediff-read-event next-command-event ediff-overlayp extentp ediff-make-overlay make-extent ediff-delete-overlay delete-extent ediff-overlay-buffer extent-buffer ediff-overlay-get extent-property read-event overlayp make-overlay delete-overlay overlay-buffer overlay-get] 2) (defalias 'ediff-check-version #[(op major minor &optional type-of-emacs) "ÀÁ!ƒeÀÂ!ƒe Ä=ƒ ‚\" Æ=ƒ!‚\"È…v Ê=ƒ8\n U…d \fU‡ Í>ƒ_ \f\"„O \fU…d \fUƒ] \n \"‡È‡ÎÏ \"‡ Ð>ƒnч Ò>…vȇ" [boundp emacs-major-version emacs-minor-version type-of-emacs xemacs ediff-xemacs-p emacs ediff-emacs-p t op = minor major (> >= < <=) error "%S: Invalid op in ediff-check-version" (= > >=) nil (< <=)] 3]) (byte-code "ƒ ‚\fÂà !ƒEƒ ‚Âà !Ä>„Eƒ( ‚,Âà !Å=ƒEÆÇKMˆÈÉKMˆÊËKMˆÌÍKMˆÂ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) ns x-display-color-p ns-display-color-p x-color-defined-p ns-color-defined-p x-display-pixel-height ns-display-pixel-height x-display-pixel-width ns-display-pixel-width] 2) (defalias 'ediff-color-display-p #[nil "ƒÁ ‡Âà !Ä=‡" [ediff-emacs-p x-display-color-p device-class selected-device color] 2]) (byte-code "ÀÁÂÃ#ˆ\fƒ ‚ÆÇ !ƒn\fƒ ‚!ÆÇ !È>„n ƒBÊËKMˆÌÍKMˆÎÏKMˆÐÑKMˆ‚nÊÒKMˆÌÓKMˆ\fƒT ‚XÆÇ !Ô=ƒdÎÕMˆ‚iÎÖKMˆÐ×KMˆÀ‡" [put ediff-color-display-p byte-optimizer byte-compile-inline-expand ediff-emacs-p window-system device-type selected-device (tty stream) ediff-xemacs-p ediff-display-pixel-width device-pixel-width ediff-display-pixel-height device-pixel-height ediff-valid-color-p valid-color-name-p ediff-get-face get-face x-display-pixel-width x-display-pixel-height pm #[(color) "À \n\"‡" [assoc color pm-color-alist] 3] x-color-defined-p internal-get-face] 4) (defalias 'ediff-make-current-diff-overlay #[(type) "ƒ ‚\fÂà !…ƒ ‚Âà !Ä>?…ÅÆÇ\"!É=ƒ4\n‚UË=ƒ@\f‚UÍ=ƒL‚UÏ=…UÑÅÆÒ\"!J!‰Ödd#Lˆ×J\"ˆØJÙ#+‡" [ediff-emacs-p window-system device-type selected-device (tty stream) intern format "ediff-current-diff-overlay-%S" type A ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer face-name "ediff-current-diff-face-%S" face buffer overlay ediff-make-bullet-proof-overlay ediff-set-overlay-face ediff-overlay-put ediff ediff-control-buffer] 8]) (defalias 'ediff-set-overlay-face #[(extent face) "À Â\n#ˆÀ ÃÄ#‡" [ediff-overlay-put extent face help-echo ediff-region-help-echo] 4]) (defalias 'ediff-region-help-echo #[(extent) "À Â\"À Ã\"À Ä\"ʼn … ÊN ƒ3ƒ3ËÌT\"‚G†GƒFËÍT\"‚GΉ-‡" [ediff-overlay-get extent ediff face ediff-diff-num nil help-msg face-help diff-num is-current ediff-help-echo format "Difference region %S -- current" "Difference region %S -- non-current" ""] 5]) #@33 Set face foreground/background. (defalias 'ediff-set-face #[(ground face color) "ƒ ‚\fÂà !…iƒ ‚Âà !Ä>?…iÅ!ƒ=È=ƒ6É\n\"‡Ë\n\"‡\nÌ>ƒJÍÎ\n\"‡\nÏ>ƒ]ÍÐ\n\"ˆÑ\nÒ\"‡\nÓ>…iÍÐ\n\"‡" [ediff-emacs-p window-system device-type selected-device (tty stream) ediff-valid-color-p color ground foreground set-face-foreground face set-face-background (ediff-current-diff-face-A ediff-current-diff-face-B ediff-current-diff-face-C ediff-current-diff-face-Ancestor) copy-face highlight (ediff-fine-diff-face-A ediff-fine-diff-face-B ediff-fine-diff-face-C ediff-fine-diff-face-Ancestor) secondary-selection set-face-underline-p t (ediff-even-diff-face-A ediff-odd-diff-face-A ediff-even-diff-face-B ediff-odd-diff-face-B ediff-even-diff-face-C ediff-odd-diff-face-C ediff-even-diff-face-Ancestor ediff-odd-diff-face-Ancestor)] 3 (#$ . 31653)]) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-current-diff-face-A)) #@60 Face for highlighting the selected difference in buffer A. (defvar ediff-current-diff-face-A (byte-code "ƒ ‚\fÂà !…_ƒ ‚Âà !Ä>?…_ÅÆ!ˆÇÆ!„^ƒ4È ‚:Éà !Ê=ƒLËÌÆÍ#ˆËÎÆÏ#ˆ‚^ƒYÑÒÆ\"ˆ‚^ÑÓÆ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-current-diff-face-A face-differs-from-default-p x-display-color-p device-class color ediff-set-face foreground "firebrick" background "pale green" ediff-xemacs-p copy-face modeline highlight] 4) (#$ . 32594)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-current-diff-face-B)) #@60 Face for highlighting the selected difference in buffer B. (defvar ediff-current-diff-face-B (byte-code "ƒ ‚\fÂà !…_ƒ ‚Âà !Ä>?…_ÅÆ!ˆÇÆ!„^ƒ4È ‚:Éà !Ê=ƒLËÌÆÍ#ˆËÎÆÏ#ˆ‚^ƒYÑÒÆ\"ˆ‚^ÑÓÆ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-current-diff-face-B face-differs-from-default-p x-display-color-p device-class color ediff-set-face foreground "DarkOrchid" background "Yellow" ediff-xemacs-p copy-face modeline highlight] 4) (#$ . 33181)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-current-diff-face-C)) #@60 Face for highlighting the selected difference in buffer C. (defvar ediff-current-diff-face-C (byte-code "ƒ ‚\fÂà !…_ƒ ‚Âà !Ä>?…_ÅÆ!ˆÇÆ!„^ƒ4È ‚:Éà !Ê=ƒLËÌÆÍ#ˆËÎÆÏ#ˆ‚^ƒYÑÒÆ\"ˆ‚^ÑÓÆ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-current-diff-face-C face-differs-from-default-p x-display-color-p device-class color ediff-set-face foreground "Navy" background "Pink" ediff-xemacs-p copy-face modeline highlight] 4) (#$ . 33765)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-current-diff-face-Ancestor)) #@71 Face for highlighting the selected difference in the ancestor buffer. (defvar ediff-current-diff-face-Ancestor (byte-code "ƒ ‚\fÂà !…/ƒ ‚Âà !Ä>?…/ÅÆ!ˆÇÆ!†/ÈÉÆ\"‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-current-diff-face-Ancestor face-differs-from-default-p copy-face ediff-current-diff-face-C] 3) (#$ . 34348)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-fine-diff-face-A)) #@72 Face for highlighting the refinement of the selected diff in buffer A. (defvar ediff-fine-diff-face-A (byte-code "ƒ ‚\fÂà !…Rƒ ‚Âà !Ä>?…RÅÆ!ˆÇÆ!„Qƒ4È ‚:Éà !Ê=ƒLËÌÆÍ#ˆËÎÆÏ#ˆ‚QÐÆÑ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-fine-diff-face-A face-differs-from-default-p x-display-color-p device-class color ediff-set-face foreground "Navy" background "sky blue" set-face-underline-p t] 4) (#$ . 34801)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-fine-diff-face-B)) #@72 Face for highlighting the refinement of the selected diff in buffer B. (defvar ediff-fine-diff-face-B (byte-code "ƒ ‚\fÂà !…Rƒ ‚Âà !Ä>?…RÅÆ!ˆÇÆ!„Qƒ4È ‚:Éà !Ê=ƒLËÌÆÍ#ˆËÎÆÏ#ˆ‚QÐÆÑ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-fine-diff-face-B face-differs-from-default-p x-display-color-p device-class color ediff-set-face foreground "Black" background "cyan" set-face-underline-p t] 4) (#$ . 35349)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-fine-diff-face-C)) #@72 Face for highlighting the refinement of the selected diff in buffer C. (defvar ediff-fine-diff-face-C (byte-code "ƒ ‚\fÂà !…Rƒ ‚Âà !Ä>?…RÅÆ!ˆÇÆ!„Qƒ4È ‚:Éà !Ê=ƒLËÌÆÍ#ˆËÎÆÏ#ˆ‚QÐÆÑ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-fine-diff-face-C face-differs-from-default-p x-display-color-p device-class color ediff-set-face foreground "black" background "Turquoise" set-face-underline-p t] 4) (#$ . 35894)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-fine-diff-face-Ancestor)) #@163 Face highlighting refinements of the selected diff in ancestor buffer. Presently, this is not used, as difference regions are not refined in the ancestor buffer. (defvar ediff-fine-diff-face-Ancestor (byte-code "ƒ ‚\fÂà !…/ƒ ‚Âà !Ä>?…/ÅÆ!ˆÇÆ!†/ÈÉÆ\"‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-fine-diff-face-Ancestor face-differs-from-default-p copy-face ediff-fine-diff-face-C] 3) (#$ . 36452)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-even-diff-face-A)) #@63 Face used to highlight even-numbered differences in buffer A. (defvar ediff-even-diff-face-A (byte-code "ƒ ‚\fÂà !…Rƒ ‚Âà !Ä>?…RÅÆ!ˆÇÆ!„Qƒ4È ‚:Éà !Ê=ƒLËÌÆÍ#ˆËÎÆÏ#ˆ‚QÐÑÆ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-even-diff-face-A face-differs-from-default-p x-display-color-p device-class color ediff-set-face foreground "black" background "light grey" copy-face italic] 4) (#$ . 36988)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-even-diff-face-B)) #@63 Face used to highlight even-numbered differences in buffer B. (defvar ediff-even-diff-face-B (byte-code "ƒ ‚\fÂà !…Rƒ ‚Âà !Ä>?…RÅÆ!ˆÇÆ!„Qƒ4È ‚:Éà !Ê=ƒLËÌÆÍ#ˆËÎÆÏ#ˆ‚QÐÑÆ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-even-diff-face-B face-differs-from-default-p x-display-color-p device-class color ediff-set-face foreground "White" background "Gray" copy-face italic] 4) (#$ . 37524)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-even-diff-face-C)) #@63 Face used to highlight even-numbered differences in buffer C. (defvar ediff-even-diff-face-C (byte-code "ƒ ‚\fÂà !…1ƒ ‚Âà !Ä>?…1ÅÆ!ˆÇÆ!„0ÈÉÆ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-even-diff-face-C face-differs-from-default-p copy-face ediff-even-diff-face-A] 3) (#$ . 38054)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-even-diff-face-Ancestor)) #@69 Face highlighting even-numbered differences in the ancestor buffer. (defvar ediff-even-diff-face-Ancestor (byte-code "ƒ ‚\fÂà !…1ƒ ‚Âà !Ä>?…1ÅÆ!ˆÇÆ!„0ÈÉÆ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-even-diff-face-Ancestor face-differs-from-default-p copy-face ediff-even-diff-face-C] 3) (#$ . 38485)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-odd-diff-face-A)) #@62 Face used to highlight odd-numbered differences in buffer A. (defvar ediff-odd-diff-face-A (byte-code "ƒ ‚\fÂà !…Rƒ ‚Âà !Ä>?…RÅÆ!ˆÇÆ!„Qƒ4È ‚:Éà !Ê=ƒLËÌÆÍ#ˆËÎÆÏ#ˆ‚QÐÑÆ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-odd-diff-face-A face-differs-from-default-p x-display-color-p device-class color ediff-set-face foreground "White" background "Gray" copy-face italic] 4) (#$ . 38928)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-odd-diff-face-B)) #@62 Face used to highlight odd-numbered differences in buffer B. (defvar ediff-odd-diff-face-B (byte-code "ƒ ‚\fÂà !…Rƒ ‚Âà !Ä>?…RÅÆ!ˆÇÆ!„Qƒ4È ‚:Éà !Ê=ƒLËÌÆÍ#ˆËÎÆÏ#ˆ‚QÐÑÆ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-odd-diff-face-B face-differs-from-default-p x-display-color-p device-class color ediff-set-face foreground "Black" background "light grey" copy-face italic] 4) (#$ . 39454)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-odd-diff-face-C)) #@62 Face used to highlight odd-numbered differences in buffer C. (defvar ediff-odd-diff-face-C (byte-code "ƒ ‚\fÂà !…1ƒ ‚Âà !Ä>?…1ÅÆ!ˆÇÆ!„0ÈÉÆ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-odd-diff-face-C face-differs-from-default-p copy-face ediff-odd-diff-face-A] 3) (#$ . 39986)) (add-to-list (quote facemenu-unlisted-faces) (quote ediff-odd-diff-face-Ancestor)) #@74 Face used to highlight even-numbered differences in the ancestor buffer. (defvar ediff-odd-diff-face-Ancestor (byte-code "ƒ ‚\fÂà !…1ƒ ‚Âà !Ä>?…1ÅÆ!ˆÇÆ!„0ÈÉÆ\"ˆÆ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) make-face ediff-odd-diff-face-Ancestor face-differs-from-default-p copy-face ediff-odd-diff-face-C] 3) (#$ . 40412)) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#‡" [put ediff-fine-diff-face-A ediff-help-echo "A `refinement' of the current difference region" ediff-fine-diff-face-B ediff-fine-diff-face-C ediff-fine-diff-face-Ancestor] 4) #@56 Overlay for the current difference region in buffer A. (defvar ediff-current-diff-overlay-A nil (#$ . 40993)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-current-diff-overlay-A put permanent-local t] 4) #@56 Overlay for the current difference region in buffer B. (defvar ediff-current-diff-overlay-B nil (#$ . 41216)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-current-diff-overlay-B put permanent-local t] 4) #@56 Overlay for the current difference region in buffer C. (defvar ediff-current-diff-overlay-C nil (#$ . 41439)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-current-diff-overlay-C put permanent-local t] 4) #@67 Overlay for the current difference region in the ancestor buffer. (defvar ediff-current-diff-overlay-Ancestor nil (#$ . 41662)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-current-diff-overlay-Ancestor put permanent-local t] 4) (defalias 'ediff-highest-priority #[(start end buffer) "À S] ƒT‚_pƒTÉ!ƒTÊÉ!!ƒTËŽqˆ\fd\fT^WƒHÍÎ\f! \"Ï\f!‰‚0ÐÑÒÓ \"\"T)‚^Õ=†^Ö×!)*‡" [1 start nil ovr-list pos ediff-xemacs-p ediff-shadow-overlay-priority StartBuffer buffer get-buffer buffer-name ((set-buffer StartBuffer)) end append overlays-at next-overlay-change apply + mapcar #[(ovr) "ƒ ÁÂ\"†ÇÇ" [ovr ediff-overlay-get priority 0] 3] this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 6]) #@274 *Specifies the function to be used to toggle read-only. If nil, Ediff tries to deduce the function from the binding of C-x C-q. Normally, this is the `toggle-read-only' function, but, if version control is used, it could be `vc-toggle-read-only' or `rcs-toggle-read-only'. (defvar ediff-toggle-read-only-function nil (#$ . -42433)) (byte-code "ÀÁ\nBÀ‡" [t ediff-verbose-p current-load-list] 2) #@111 *Non-nil means C-h should not invoke Emacs help in control buffer. Instead, C-h jumps to previous difference. (defvar ediff-no-emacs-help-in-control-buffer nil (#$ . -42836)) #@88 *Prefix to put on Ediff temporary file names. Do not start with `~/' or `~user-name/'. (defvar ediff-temp-file-prefix (byte-code "ÀÁ!†ÀÂ!†ÀÃ!ĉƒ$GÇVƒ$‚0É>ƒ/Ê‚0ËÌÍ !!‰*‡" [getenv "TMPDIR" "TMP" "TEMP" nil d env 0 system-type (vax-vms axp-vms) "SYS$SCRATCH:" "/tmp" file-name-as-directory directory-file-name] 4) (#$ . -43017)) #@34 *Mode for Ediff temporary files. (defvar ediff-temp-file-mode 384 (#$ . -43369)) #@132 Characters that must be quoted with \ when used in a shell command line. More precisely, a regexp to match any one such character. (defvar ediff-metachars "[ \n!\"#$&'()*;<=>?[\\^`{|~]" (#$ . 43457)) #@66 Temporary file used for refining difference regions in buffer A. (defvar ediff-temp-file-A nil (#$ . 43664)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-temp-file-A put permanent-local t] 4) #@66 Temporary file used for refining difference regions in buffer B. (defvar ediff-temp-file-B nil (#$ . 43875)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-temp-file-B put permanent-local t] 4) #@66 Temporary file used for refining difference regions in buffer C. (defvar ediff-temp-file-C nil (#$ . 44086)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-temp-file-C put permanent-local t] 4) (defalias 'ediff-file-remote-p #[(file-name) "À !… \n!‡" [fboundp ediff-ange-ftp-ftp-name file-name] 2]) (put (quote ediff-file-remote-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-frame-unsplittable-p #[(frame) "ÀÁ\n!žA‡" [unsplittable frame-parameters frame] 3]) (put (quote ediff-frame-unsplittable-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-get-next-window #[(wind prev-wind) "À !†\nƒà !‚Ä ‰‡" [window-live-p wind prev-wind next-window selected-window] 2]) (put (quote ediff-get-next-window) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@31 Kill buffer BUF if it exists. (defalias 'ediff-kill-buffer-carefully #[(buf) "…Á!…ÂÁ!!…ÃÁ!!‡" [buf get-buffer buffer-name kill-buffer] 3 (#$ . 44930)]) (put (quote ediff-kill-buffer-carefully) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@51 Put face on diff N. Invoked for X displays only. (defalias 'ediff-highlight-diff #[(n) "À Â\"ˆÀ Ã\"ˆÀ Ä\"ˆÀ Å\"‡" [ediff-highlight-diff-in-one-buffer n A B C Ancestor] 3 (#$ . 45198)]) (put (quote ediff-highlight-diff) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@43 Remove overlays from buffers A, B, and C. (defalias 'ediff-unhighlight-diff #[nil "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!‡" [ediff-unhighlight-diff-in-one-buffer A B C Ancestor] 2 (#$ . 45483)]) (put (quote ediff-unhighlight-diff) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-unhighlight-diffs-totally #[nil "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!‡" [ediff-unhighlight-diffs-totally-in-one-buffer A B C Ancestor] 2]) (put (quote ediff-unhighlight-diffs-totally) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-background-face #[(buf-type dif-num) "ÀÁ Ä\"Ä=ƒÅ‚Æ\"!‡" [intern format logand dif-num 1 "ediff-even-diff-face-%S" "ediff-odd-diff-face-%S" buf-type] 5]) (put (quote ediff-background-face) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-clear-fine-diff-vector #[(diff-record) "…\nÁÂÃH\"‡" [diff-record mapcar ediff-delete-overlay 1] 4]) (put (quote ediff-clear-fine-diff-vector) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-clear-fine-differences-in-one-buffer #[(n buf-type) "ÀÁ \"!J\fH‰ƒÆÇ ÈH\"ˆ)ÀÁ \"!J\fHÈÉI‡" [intern format "ediff-difference-vector-%S" buf-type n diff-record mapcar ediff-delete-overlay 1 nil] 5]) (put (quote ediff-clear-fine-differences-in-one-buffer) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-clear-fine-differences #[(n) "ÁÃÄÅ\n\"!JH‰ƒÇÈÉH\"ˆ)ÃÄÅ\n\"!JHÉÊIˆ*ËÃÄÅ\n\"!JH‰ƒEÇÈÉH\"ˆ)ÃÄÅ\n\"!JHÉÊIˆ*\f…‚ÍÃÄÅ\n\"!JH‰ƒtÇÈÉH\"ˆ)ÃÄÅ\n\"!JHÉÊI*‡" [n A buf-type intern format "ediff-difference-vector-%S" diff-record mapcar ediff-delete-overlay 1 nil B ediff-3way-job C] 5]) (put (quote ediff-clear-fine-differences) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-convert-fine-diffs-to-overlays #[(diff-list region-num) "ÀÁ\n #ˆÀÄ\n #ˆ …ÀÆ\n #‡" [ediff-set-fine-overlays-in-one-buffer A diff-list region-num B ediff-3way-job C] 4]) (put (quote ediff-convert-fine-diffs-to-overlays) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-mouse-event-p #[(event) "ƒÁ\n!‡ÃÄÅÆÇ\n!\"\"‡" [ediff-xemacs-p button-event-p event string-match "mouse" format "%S" event-basic-type] 6]) (put (quote ediff-mouse-event-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-key-press-event-p #[(event) "ƒÁ\n!‡Ã\n!†\n9‡" [ediff-xemacs-p key-press-event-p event char-or-string-p] 2]) (put (quote ediff-key-press-event-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-event-point #[(event) " ƒ\fÂ!‚ÃÄÅÆÇ!\"\")ƒ> ƒ!È!‡‰A@)‰ A@:ƒ8 A@@‚< A@)‡ ƒJÊ!‚RË!†R9)ƒX`‡Ì ‡" [event ediff-xemacs-p button-event-p string-match "mouse" format "%S" event-basic-type event-point position key-press-event-p char-or-string-p error] 7]) (defalias 'ediff-event-buffer #[(event) " ƒ\fÂ!‚ÃÄÅÆÇ!\"\")ƒ/ ƒ!È!‡É‰A@)‰\n@)!‡ ƒ;Ë!‚CÌ!†C9)ƒIp‡Í ‡" [event ediff-xemacs-p button-event-p string-match "mouse" format "%S" event-basic-type event-buffer window-buffer position key-press-event-p char-or-string-p error] 7]) (defalias 'ediff-frame-iconified-p #[(frame) "ƒ ‚\fÂà !…8ƒ ‚Âà !Ä>?…8Å!…8ƒ2È!‡É!Ê=‡" [ediff-emacs-p window-system device-type selected-device (tty stream) frame-live-p frame ediff-xemacs-p frame-iconified-p frame-visible-p icon] 2]) (put (quote ediff-frame-iconified-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-window-visible-p #[(wind) "À !…-\nƒ ‚ÄÅ !…$\nƒ ‚!ÄÅ !Æ>??†-ÇÈ !!‡" [window-live-p wind ediff-emacs-p window-system device-type selected-device (tty stream) frame-visible-p window-frame] 3]) (put (quote ediff-window-visible-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-frame-char-width #[(frame) "ƒ\fÁ\n!Ã\n!¥‡Ä\n!‡" [ediff-xemacs-p frame-pixel-width frame frame-width frame-char-width] 3]) (put (quote ediff-frame-char-width) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-reset-mouse #[(&optional frame do-not-grab-mouse) "„Á \nƒ ‚ÄÅ !…U\nƒ ‚\"ÄÅ !Æ>?…Uƒ5É!\n†T ?†T Ì=ƒN Î>†TÏÐÑ#)‡" [frame selected-frame ediff-emacs-p window-system device-type selected-device (tty stream) frame-or-wind ediff-xemacs-p frame-selected-window do-not-grab-mouse ediff-grab-mouse maybe this-command (ediff-quit ediff-update-diffs) set-mouse-position 1 0] 4]) (defalias 'ediff-spy-after-mouse #[nil "À ‰‡" [mouse-pixel-position ediff-mouse-pixel-position] 2]) (put (quote ediff-spy-after-mouse) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-user-grabbed-mouse #[nil "…F@Á @=?†FA@ƒEÁ A@ƒEAAƒEÁ AAƒEÂA@Á A@Z! W…CÂAAÁ AAZ! W?‡Ä‡" [ediff-mouse-pixel-position mouse-pixel-position abs ediff-mouse-pixel-threshhold nil] 3]) (defalias 'ediff-frame-char-height #[(frame) "ƒ\fÁ\n!Ã\n!¥‡Ä\n!‡" [ediff-xemacs-p frame-pixel-height frame frame-height frame-char-height] 3]) (put (quote ediff-frame-char-height) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-empty-overlay-p #[(overl) "À ! !U‡" [ediff-overlay-start overl ediff-overlay-end] 3]) (put (quote ediff-empty-overlay-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-empty-diff-region-p #[(n buf-type) "Á=ƒ\n?†\"ÃÁÄ #ÃÁÆ #U‡ÃÄ #ÃÆ #U‡" [buf-type C ediff-3way-comparison-job ediff-get-diff-posn beg n end] 5]) (defalias 'ediff-whitespace-diff-region-p #[(n buf-type) "Á=ƒ \n?†÷Ã\f\"†÷ÅÆ\f#ÅÇ\f#pÉ=ƒ.\n‚LË=ƒ9\f‚LÁ=ƒD ‚LÎ=ƒìƒìÐÉ=ƒ[\n‚yË=ƒf\f‚yÁ=ƒq ‚yÎ=…y!ƒìÑÐÉ=ƒŠ\n‚¨Ë=ƒ•\f‚¨Á=ƒ  ‚¨Î=…¨!!ƒìÒŽÉ=ƒº\n‚ØË=ƒÅ\f‚ØÁ=ƒÐ ‚ØÎ=…ØqˆŠbˆÔwˆ`Y*‚öÖ=†ö×Ø!+‡" [buf-type C ediff-3way-job ediff-empty-diff-region-p n ediff-get-diff-posn beg end StartBuffer A ediff-buffer-A B ediff-buffer-B ediff-buffer-C Ancestor ediff-ancestor-buffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-whitespace nil this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 5]) (defalias 'ediff-abbreviate-file-name #[(file &optional dir) ";ƒÁBCÃ\f!)‡ ƒÃ\f!‡Ã\fÆ\"‡" [dir "" directory-abbrev-alist abbreviate-file-name file ediff-emacs-p t] 3]) (put (quote ediff-abbreviate-file-name) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-strip-last-dir #[(dir) ";„ Â!Ã!„Ä!GS H ÇVƒ0ÈUƒ0Ç OÄ!É\n;ƒJËBC\fÍ\n!)‚[ƒVÍ\n!‚[Í\nÏ\",‡" [dir default-directory expand-file-name file-directory-p file-name-directory pos last-char 0 47 nil file "" directory-abbrev-alist abbreviate-file-name ediff-emacs-p t] 3]) (defalias 'ediff-truncate-string-left #[(str newlen) "GÁ‰\fXƒ‚#Å\fÆZ]Å \fZÇZ]ÁOÈ\nP*‡" [str nil substr len newlen 0 3 1 "..."] 5]) (defalias 'ediff-abbrev-jobname #[(jobname) "Á=ƒ‡Ã=ƒćÅ=ƒƇÇ=ƒ ȇÉ=ƒ(ʇË=ƒ0̇Í=ƒ8·Ï=ƒ@ЇÑ=ƒHÒ‡Ó=ƒPÔ‡Õ!Ö×O‰GÚÚWƒ“ÚUƒyH–IˆHÜUƒŠÝIˆT‰‚`+‡" [jobname ediff-directories "Compare two directories" ediff-files "Compare two files" ediff-buffers "Compare two buffers" ediff-directories3 "Compare three directories" ediff-files3 "Compare three files" ediff-buffers3 "Compare three buffers" ediff-revision "Compare file with a version" ediff-directory-revisions "Compare dir files with versions" ediff-merge-directory-revisions "Merge dir files with versions" ediff-merge-directory-revisions-with-ancestor "Merge dir versions via ancestors" symbol-name 6 nil str len 0 pos 45 32] 5]) (defalias 'ediff-get-region-contents #[(n buf-type ctrl-buf &optional start end) "pp ƒH !ƒHà!!ƒHÄŽ qˆ Æ=ƒ&‚D È=ƒ1 ‚D Ê=ƒ< ‚D Ì=…D )‚RÏ=†RÐÑ!)ƒvÂp ƒÂ !ƒÃ !!ƒÒŽ qˆ Æ=ƒ{‚™ È=ƒ† ‚™ Ê=ƒ‘ ‚™ Ì=…™ )‚§Ï=†§ÐÑ!)!ƒvÃÂp ƒô !ƒôà!!ƒôÓŽ qˆ Æ=ƒÒ‚ð È=ƒÝ ‚ð Ê=ƒè ‚ð Ì=…ð )‚þÏ=†þÐÑ!)!!ƒvÔŽp ƒL !ƒLà!!ƒLÕŽ qˆ Æ=ƒ*‚H È=ƒ5 ‚H Ê=ƒ@ ‚H Ì=…H )‚VÏ=†VÐÑ!)qˆ†e× Ø $†q× Ú ${)‚€Ï=†€ÐÑ!)‡" [StartBuffer ctrl-buf get-buffer buffer-name ((set-buffer StartBuffer)) buf-type A ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) start ediff-get-diff-posn beg n end] 6]) (put (quote ediff-get-region-contents) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-strip-mode-line-format #[nil "@Á…\fÂ8‰‡" [mode-line-format (" A: " " B: " " C: " " Ancestor: ") 2] 2]) (put (quote ediff-strip-mode-line-format) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-valid-difference-p #[(&optional n) "„ ÂY… W‡" [n ediff-current-difference 0 ediff-number-of-differences] 2]) (put (quote ediff-valid-difference-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@32 Don't skip difference regions. (defalias 'ediff-show-all-diffs #[(n) "À‡" [nil] 1 (#$ . 54473)]) (put (quote ediff-show-all-diffs) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'Xor #[(a b) "ƒ ?†?… ‡" [a b] 1]) (put (quote Xor) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-message-if-verbose #[(string &rest args) "… Á \f#‡" [ediff-verbose-p apply message string args] 4]) (byte-code "ÀÁÂÃ#ˆÄÅ!‡" [put ediff-message-if-verbose byte-optimizer byte-compile-inline-expand provide ediff-init] 4) emacs-19.30/lisp/ediff-merg.elc100666 75424 12 31256 6047377735 14704 0ustar kwzhstaff;ELC ;;; compiled by simon@mole.gnu.ai.mit.edu on Mon Nov 6 07:29:31 1995 ;;; from file /home/gp2/simon/Emacs/lisp/ediff-merg.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`ediff-merg.el' was compiled for Emacs 19.29 or later")) (require (quote ediff-init)) #@134 *The variant to be used as a default for buffer C in merging. Valid values are the symbols `default-A', `default-B', and `combined'. (defvar ediff-default-variant (quote default-A) (#$ . -514)) #@233 *Pattern to be used for combining difference regions in buffers A and B. The value is (STRING1 STRING2 STRING3). The combined text will look like this: STRING1 diff region from variant A STRING2 diff region from variant B STRING3  (defvar ediff-combination-pattern (quote ("#ifdef NEW /* variant A */" "#else /* variant B */" "#endif /* NEW */")) (#$ . -715)) #@195 *If t, show only those diff regions where both buffers disagree with the ancestor. This means that regions that have status prefer-A or prefer-B will be skiped over. Nil means show all regions. (defvar ediff-show-clashes-only nil (#$ . -1083)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-show-clashes-only put permanent-local t] 4) (defalias 'ediff-get-combined-region #[(n) "@Á\nÃ\fʼn p\np\nƒcË!ƒcÌË!!ƒcÍŽqˆ Ã=ƒ>‚_ Ï=ƒJ‚_ Ñ=ƒV‚_ Ó=…_)‚mÖ=†m×Ø!)ƒ®Ëp\nƒÁË!ƒÁÌË!!ƒÁÙŽqˆ Ã=ƒœ‚½ Ï=ƒ¨‚½ Ñ=ƒ´‚½ Ó=…½)‚ËÖ=†Ë×Ø!)!ƒ®ÌËp\nƒ!Ë!ƒ!ÌË!!ƒ!ÚŽqˆ Ã=ƒü‚ Ï=ƒ‚ Ñ=ƒ‚ Ó=…)‚+Ö=†+×Ø!)!!ƒ®ÛŽp\nƒ‚Ë!ƒ‚ÌË!!ƒ‚ÜŽqˆ Ã=ƒ]‚~ Ï=ƒi‚~ Ñ=ƒu‚~ Ó=…~)‚ŒÖ=†Œ×Ø!)qˆ†œÝ Þ\n$†©Ý Æ\n${)‚¸Ö=†¸×Ø!.A@Á\nÏ\fʼn p\np\nƒË!ƒÌË!!ƒÍŽqˆ Ã=ƒù‚ Ï=ƒ‚ Ñ=ƒ‚ Ó=…)‚(Ö=†(×Ø!)ƒiËp\nƒ|Ë!ƒ|ÌË!!ƒ|ÙŽqˆ Ã=ƒW‚x Ï=ƒc‚x Ñ=ƒo‚x Ó=…x)‚†Ö=††×Ø!)!ƒiÌËp\nƒÜË!ƒÜÌË!!ƒÜÚŽqˆ Ã=ƒ·‚Ø Ï=ƒÃ‚Ø Ñ=ƒÏ‚Ø Ó=…Ø)‚æÖ=†æ×Ø!)!!ƒiÛŽp\nƒ=Ë!ƒ=ÌË!!ƒ=ÜŽqˆ Ã=ƒ‚9 Ï=ƒ$‚9 Ñ=ƒ0‚9 Ó=…9)‚GÖ=†G×Ø!)qˆ†WÝ Þ\n$†dÝ Æ\n${)‚sÖ=†s×Ø!.ß8Á°‡" [ediff-combination-pattern "\n" n A ediff-control-buffer nil end start ctrl-buf buf-type StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ediff-get-diff-posn beg 2] 11]) (put (quote ediff-get-combined-region) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-make-combined-diff #[(regA regB) "@Á\nA@Á Ä8Á°‡" [ediff-combination-pattern "\n" regA regB 2] 8]) (put (quote ediff-make-combined-diff) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-set-state-of-all-diffs-in-all-buffers #[(ctl-buf) "ÀÀ\nW…à \f\"ˆ T‰‚)‡" [0 n ediff-number-of-differences ediff-set-state-of-diff-in-all-buffers ctl-buf] 4]) (put (quote ediff-set-state-of-all-diffs-in-all-buffers) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-set-state-of-diff-in-all-buffers #[(n ctl-buf) "Á\nÉppƒ^É!ƒ^ÊÉ!!ƒ^ËŽqˆÁ=ƒ9\f‚ZÍ=ƒE‚ZÏ=ƒQ‚ZÑ=…Z)‚hÔ=†hÕÖ!)ƒ§Épƒ¼É!ƒ¼ÊÉ!!ƒ¼×ŽqˆÁ=ƒ—\f‚¸Í=ƒ£‚¸Ï=ƒ¯‚¸Ñ=…¸)‚ÆÔ=†ÆÕÖ!)!ƒ§ÊÉpƒÉ!ƒÊÉ!!ƒØŽqˆÁ=ƒ÷\f‚Í=ƒ‚Ï=ƒ‚Ñ=…)‚&Ô=†&ÕÖ!)!!ƒ§ÙŽpƒ}É!ƒ}ÊÉ!!ƒ}ÚŽqˆÁ=ƒX\f‚yÍ=ƒd‚yÏ=ƒp‚yÑ=…y)‚‡Ô=†‡ÕÖ!)qˆ †–ÛÜ$\f†¢ÛÄ${)‚±Ô=†±ÕÖ!.Í\nÉppƒÉ!ƒÊÉ!!ƒËŽqˆÁ=ƒì\f‚ Í=ƒø‚ Ï=ƒ‚ Ñ=… )‚Ô=†ÕÖ!)ƒZÉpƒoÉ!ƒoÊÉ!!ƒo׎qˆÁ=ƒJ\f‚kÍ=ƒV‚kÏ=ƒb‚kÑ=…k)‚yÔ=†yÕÖ!)!ƒZÊÉpƒÏÉ!ƒÏÊÉ!!ƒÏØŽqˆÁ=ƒª\f‚ËÍ=ƒ¶‚ËÏ=ƒÂ‚ËÑ=…Ë)‚ÙÔ=†ÙÕÖ!)!!ƒZÙŽpƒ0É!ƒ0ÊÉ!!ƒ0ÚŽqˆÁ=ƒ \f‚,Í=ƒ‚,Ï=ƒ#‚,Ñ=…,)‚:Ô=†:ÕÖ!)qˆ †IÛÜ$\f†UÛÄ${)‚dÔ=†dÕÖ!.Ï\nÉppƒÄÉ!ƒÄÊÉ!!ƒÄËŽqˆÁ=ƒŸ\f‚ÀÍ=ƒ«‚ÀÏ=ƒ·‚ÀÑ=…À)‚ÎÔ=†ÎÕÖ!)ƒ Épƒ\"É!ƒ\"ÊÉ!!ƒ\"׎qˆÁ=ƒý\f‚Í=ƒ ‚Ï=ƒ‚Ñ=…)‚,Ô=†,ÕÖ!)!ƒ ÊÉpƒ‚É!ƒ‚ÊÉ!!ƒ‚ØŽqˆÁ=ƒ]\f‚~Í=ƒi‚~Ï=ƒu‚~Ñ=…~)‚ŒÔ=†ŒÕÖ!)!!ƒ ÙŽpƒãÉ!ƒãÊÉ!!ƒãÚŽqˆÁ=ƒ¾\f‚ßÍ=ƒÊ‚ßÏ=ƒÖ‚ßÑ=…ß)‚íÔ=†íÕÖ!)qˆ †üÛÜ$\f†ÛÄ${)‚Ô=†ÕÖ!.‰˜ƒW˜ƒWàáâÁ\"!JHãäIˆàáâÍ\"!JHãåIˆàáâÏ\"!JHãæI‚º ˜ƒˆàáâÁ\"!JHãäIˆàáâÍ\"!JHãæIˆàáâÏ\"!JHãÃI‚º ˜ƒ¹àáâÁ\"!JHãåIˆàáâÏ\"!JHãæIˆàáâÍ\"!JHãÃI‚º ˜ƒêàáâÏ\"!JHãäIˆàáâÍ\"!JHãåIˆàáâÁ\"!JHãÃI‚º '@èÁ)ÉppƒQÉ!ƒQÊÉ!!ƒQËŽqˆÁ=ƒ,\f‚MÍ=ƒ8‚MÏ=ƒD‚MÑ=…M)‚[Ô=†[ÕÖ!)ƒšÉpƒ¯É!ƒ¯ÊÉ!!ƒ¯׎qˆÁ=ƒŠ\f‚«Í=ƒ–‚«Ï=ƒ¢‚«Ñ=…«)‚¹Ô=†¹ÕÖ!)!ƒšÊÉpƒÉ!ƒÊÉ!!ƒØŽqˆÁ=ƒê\f‚ Í=ƒö‚ Ï=ƒ‚ Ñ=… )‚Ô=†ÕÖ!)!!ƒšÙŽpƒpÉ!ƒpÊÉ!!ƒpÚŽqˆÁ=ƒK\f‚lÍ=ƒW‚lÏ=ƒc‚lÑ=…l)‚zÔ=†zÕÖ!)qˆ †‰ÛÜ$\f†•ÛÄ${)‚¤Ô=†¤ÕÖ!.'A@èÍ)Éppƒ\nÉ!ƒ\nÊÉ!!ƒ\nËŽqˆÁ=ƒå\f‚Í=ƒñ‚Ï=ƒý‚Ñ=…)‚Ô=†ÕÖ!)ƒS ÉpƒhÉ!ƒhÊÉ!!ƒh׎qˆÁ=ƒC\f‚dÍ=ƒO‚dÏ=ƒ[‚dÑ=…d)‚rÔ=†rÕÖ!)!ƒS ÊÉpƒÈÉ!ƒÈÊÉ!!ƒÈØŽqˆÁ=ƒ£\f‚ÄÍ=ƒ¯‚ÄÏ=ƒ»‚ÄÑ=…Ä)‚ÒÔ=†ÒÕÖ!)!!ƒS ÙŽpƒ) É!ƒ) ÊÉ!!ƒ) ÚŽqˆÁ=ƒ \f‚% Í=ƒ ‚% Ï=ƒ ‚% Ñ=…% )‚3 Ô=†3 ÕÖ!)qˆ †B ÛÜ$\f†N ÛÄ${)‚] Ô=†] ÕÖ!.ê'8è°)˜ƒ” àáâÁ\"!JHãÃIˆàáâÍ\"!JHãÃIˆàáâÏ\"!JHãëI‚º àáâÁ\"!JHãÃIˆàáâÍ\"!JHãÃIˆàáâÏ\"!JHãÃI+‡" [n A ctl-buf nil end start ctrl-buf buf-type StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ediff-get-diff-posn beg regC regB regA intern format "ediff-difference-vector-%S" 3 "=diff(B)" "=diff(C)" "=diff(A)" ediff-combination-pattern "\n" ediff-control-buffer 2 "=diff(A+B)"] 13]) (defalias 'ediff-set-merge-mode #[nil "ÀÁ!ˆÂÃÄ\"‡" [normal-mode t remove-hook local-write-file-hooks ediff-set-merge-mode] 3]) (defalias 'ediff-do-merge #[(diff-num &optional remerging) "ÁWƒÁÂÃ\f\"ʼn‰ \nWƒ<Ë Ì\"ÁUƒ:Í΃3Ђ4Ñ \n$ˆ…F HÁHƒù Óʼn ppƒ°Ú!ƒ°ÛÚ!!ƒ°ÜŽqˆÓ=ƒ‹‚¬Þ=ƒ—‚¬à=ƒ£!‚¬â=…¬#)‚º$å=†ºæç!)ƒýÚpƒÚ!ƒÛÚ!!ƒèŽqˆÓ=ƒé‚\nÞ=ƒõ‚\nà=ƒ!‚\nâ=…\n#)‚$å=†æç!)!ƒýÛÚpƒnÚ!ƒnÛÚ!!ƒnéŽqˆÓ=ƒI‚jÞ=ƒU‚jà=ƒa!‚jâ=…j#)‚x$å=†xæç!)!!ƒýêŽpƒÏÚ!ƒÏÛÚ!!ƒÏëŽqˆÓ=ƒª‚ËÞ=ƒ¶‚Ëà=ƒÂ!‚Ëâ=…Ë#)‚Ù$å=†Ùæç!)qˆ†êìí $†øìÕ ${)‚$å=†æç!. Þʼn ppƒlÚ!ƒlÛÚ!!ƒlÜŽqˆÓ=ƒG‚hÞ=ƒS‚hà=ƒ_!‚hâ=…h#)‚v$å=†væç!)ƒ¹ÚpƒÊÚ!ƒÊÛÚ!!ƒÊèŽqˆÓ=ƒ¥‚ÆÞ=ƒ±‚Æà=ƒ½!‚Æâ=…Æ#)‚Ô$å=†Ôæç!)!ƒ¹ÛÚpƒ*Ú!ƒ*ÛÚ!!ƒ*éŽqˆÓ=ƒ‚&Þ=ƒ‚&à=ƒ!‚&â=…&#)‚4$å=†4æç!)!!ƒ¹êŽpƒ‹Ú!ƒ‹ÛÚ!!ƒ‹ëŽqˆÓ=ƒf‚‡Þ=ƒr‚‡à=ƒ~!‚‡â=…‡#)‚•$å=†•æç!)qˆ†¦ìí $†´ìÕ ${)‚Ã$å=†Ãæç!. àʼn ppƒ(Ú!ƒ(ÛÚ!!ƒ(ÜŽqˆÓ=ƒ‚$Þ=ƒ‚$à=ƒ!‚$â=…$#)‚2$å=†2æç!)ƒuÚpƒ†Ú!ƒ†ÛÚ!!ƒ†èŽqˆÓ=ƒa‚‚Þ=ƒm‚‚à=ƒy!‚‚â=…‚#)‚$å=†æç!)!ƒuÛÚpƒæÚ!ƒæÛÚ!!ƒæéŽqˆÓ=ƒÁ‚âÞ=ƒÍ‚âà=ƒÙ!‚ââ=…â#)‚ð$å=†ðæç!)!!ƒuêŽpƒGÚ!ƒGÛÚ!!ƒGëŽqˆÓ=ƒ\"‚CÞ=ƒ.‚Cà=ƒ:!‚Câ=…C#)‚Q$å=†Qæç!)qˆ†bìí $†pìÕ ${)‚$å=†æç!../0ñ˜ƒ–0.˜ƒ×ò˜ƒ¥/.˜ƒ×ó˜ƒÏ0/456@÷56A@÷4ø68÷°*.˜ƒ×ùú\"ƒÚûùü\"ƒø„øƒø HÁÂÃ\f\"Iˆ+… HÁH„3ó˜ƒý Tþ\"ˆ‚3ÿ ù@\"ƒ.Ó‚/Þàþ$ˆ T‰ ‚ÍA!,‡" [diff-num 0 format "%S" ediff-default-variant nil state-of-merge do-not-copy default-state-of-merge n ediff-number-of-differences mod 10 message "%s buffers A & B into C ... region %d of %d" remerging "Re-merging" "Merging" ediff-state-of-merge A ediff-control-buffer end start ctrl-buf buf-type StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ediff-get-diff-posn beg reg-C reg-B reg-A "default-A" "default-B" "combined" regB regA ediff-combination-pattern "\n" 2 string-match "prefer" t "\\(default\\|combined\\)" ediff-combine-diffs batch ediff-copy-diff "-A" "Merging buffers A & B into C ... Done"] 9]) #@85 Remerge unmodified diff regions using a new default. Start with the current region. (defalias 'ediff-re-merge #[nil "ÀÁÂEÄÅ!C \"ÈÉÊË\"ÌÍ$!ÎÐ\"ˆÑ *‡" [("default-A") ("default-B") ("combined") default-variant-alist delete symbol-name ediff-default-variant actual-alist intern completing-read format "Current merge default is `%S'. New default: " nil must-match ediff-do-merge ediff-current-difference remerge ediff-recenter] 6 (#$ . 9361) nil]) #@124 Shrink window C to just one line. With a prefix argument, returns window C to its normal size. Used only for merging jobs. (defalias 'ediff-shrink-window-C #[(arg) "„ÁÂ!ˆ Ä=ƒÅ‚ §„Æ „7Ç!ÉWƒ,\n‚-Ë\nÌ ÎÏ!)‡ ËWƒSÇ!ÐVƒS\nÑ_\nÌ ÎÏ!‡ ËV…nÇ!ÐV…n\nÓ_\nÌ ÎÏ!‡" [ediff-merge-job error "ediff-shrink-window-C can be used only for merging jobs" arg - -1 nil window-height ediff-window-C 3 ediff-merge-window-share 0 "" ediff-window-config-saved ediff-recenter no-rehighlight 2 .9 ediff-window-A 1.1000000000000001] 2 (#$ . 9824) "P"]) #@151 Combine Nth diff regions of buffers A and B and place the combination in C. Combining is done using the list in variable `ediff-combination-pattern'. (defalias 'ediff-combine-diffs #[(n &optional batch-invocation) "ƒ S‚\n ‰‰Æ‰ \n p\fp\f\nƒrÍ\n!ƒrÎÍ\n!!ƒrÏŽ\nqˆ Æ=ƒM‚n Ñ=ƒY‚n Ó=ƒe‚n Õ=…n)‚|Ø=†|ÙÚ!)ƒ½Íp\f\nƒÐÍ\n!ƒÐÎÍ\n!!ƒÐÛŽ\nqˆ Æ=ƒ«‚Ì Ñ=ƒ·‚Ì Ó=ƒÃ‚Ì Õ=…Ì)‚ÚØ=†ÚÙÚ!)!ƒ½ÎÍp\f\nƒ0Í\n!ƒ0ÎÍ\n!!ƒ0ÜŽ\nqˆ Æ=ƒ ‚, Ñ=ƒ‚, Ó=ƒ#‚, Õ=…,)‚:Ø=†:ÙÚ!)!!ƒ½ÝŽp\f\nƒ‘Í\n!ƒ‘ÎÍ\n!!ƒ‘ÞŽ\nqˆ Æ=ƒl‚ Ñ=ƒx‚ Ó=ƒ„‚ Õ=…)‚›Ø=†›ÙÚ!)qˆ †«ß à\n$†¸ß È\n${)‚ÇØ=†ÇÙÚ!.щ \n p\fp\f\nƒ+Í\n!ƒ+ÎÍ\n!!ƒ+ÏŽ\nqˆ Æ=ƒ‚' Ñ=ƒ‚' Ó=ƒ‚' Õ=…')‚5Ø=†5ÙÚ!)ƒvÍp\f\nƒ‰Í\n!ƒ‰ÎÍ\n!!ƒ‰ÛŽ\nqˆ Æ=ƒd‚… Ñ=ƒp‚… Ó=ƒ|‚… Õ=……)‚“Ø=†“ÙÚ!)!ƒvÎÍp\f\nƒéÍ\n!ƒéÎÍ\n!!ƒéÜŽ\nqˆ Æ=ƒÄ‚å Ñ=ƒÐ‚å Ó=ƒÜ‚å Õ=…å)‚óØ=†óÙÚ!)!!ƒvÝŽp\f\nƒJÍ\n!ƒJÎÍ\n!!ƒJÞŽ\nqˆ Æ=ƒ%‚F Ñ=ƒ1‚F Ó=ƒ=‚F Õ=…F)‚TØ=†TÙÚ!)qˆ †dß à\n$†qß È\n${)‚€Ø=†€ÙÚ!. \f!@â !A@â\fã!8â°*äÂÓ% %ˆ+%†¬æ ‡" [n ediff-current-difference nil reg-combined regB regA A ediff-control-buffer end start ctrl-buf buf-type StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ediff-get-diff-posn beg ediff-combination-pattern "\n" 2 ediff-copy-diff batch-invocation ediff-recenter] 8 (#$ . 10386) "P"]) (defalias 'ediff-looks-like-combined-merge #[(region-num) "…æÁÂÃ!\fƒ)Å\f!ƒ)ÆÅ\f!!ƒ)ÇÈÉÊ\"!J HÌH†*Í\"ÎÊÏ #ÎÊÐ #@A@Ò8Ó‰‰‰‰‰‰ƒÂp \fƒ¶Å\f!ƒ¶ÆÅ\f!!ƒ¶áŽ\fqˆbˆâã#ˆä”ä•âã#ˆä”ä•âã#ˆä”ä•)‚Á%æ=„Áçè!ˆ)…ä…ä…ä…ä¯.\f‡" [ediff-merge-job string-match regexp-quote "(A+B)" ediff-buffer-C get-buffer buffer-name intern format "ediff-difference-vector-%S" C region-num 3 "" ediff-get-diff-posn beg end ediff-combination-pattern 2 nil reg-c-end reg-c-beg reg-b-end reg-b-beg reg-a-end reg-a-beg pat3 pat2 pat1 reg-end reg-beg combined StartBuffer ((set-buffer StartBuffer)) search-forward noerror 0 this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 13]) (provide (quote ediff-merg)) emacs-19.30/lisp/ediff-mult.elc100666 12120 1 75266 6055511740 14641 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 24 22:55:29 1995 ;;; from file /home/fsf/rms/e19/lisp/ediff-mult.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`ediff-mult.el' was compiled for Emacs 19.29 or later")) (require (quote ediff-init)) #@2  (defvar ediff-meta-buffer nil (#$ . 506)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-meta-buffer put permanent-local t] 4) #@2  (defvar ediff-parent-meta-buffer nil (#$ . 650)) (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅÆ!„ÇÆBÉ\nÊBLJ" [make-variable-buffer-local ediff-parent-meta-buffer put permanent-local t boundp ediff-registry-buffer nil current-load-list "This is an Ediff Session Group Panel: %s\n\nUseful commands:\n button2, `v', RET over a session line: start that Ediff session\n `M' in any session invoked from here: bring back this buffer\n `R': display the registry of active Ediff sessions\n `h': mark session for hiding; with prefix arg--unmark\n `x': hide marked sessions; with prefix arg--unhide hidden sessions\n `m': mark session for non-hiding operation; with prefix arg--unmark\n SPC: next session\n DEL: previous session\n `E': browse Ediff on-line manual\n `q': quit this session group\n" ediff-meta-buffer-message] 4) #@33 The keymap for the meta buffer. (defvar ediff-meta-buffer-map nil (#$ . 1510)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-meta-buffer-map put permanent-local t] 4) #@83 The keymap to be installed in the buffer showing differences between directories. (defvar ediff-dir-diffs-buffer-map (make-sparse-keymap) (#$ . 1695)) #@2  (defvar ediff-meta-action-function nil (#$ . 1851)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-meta-action-function put permanent-local t] 4) #@2  (defvar ediff-meta-redraw-function nil (#$ . 2014)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-meta-redraw-function put permanent-local t] 4) #@2  (defvar ediff-session-action-function nil (#$ . 2177)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-session-action-function put permanent-local t] 4) #@2  (defvar ediff-metajob-name nil (#$ . 2346)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-metajob-name put permanent-local t] 4) #@2  (defvar ediff-meta-diff-buffer nil (#$ . 2493)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-meta-diff-buffer put permanent-local t] 4) #@2  (defvar ediff-filtering-regexp-history nil (#$ . 2648)) #@2  (defvar ediff-meta-list nil (#$ . 2710)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-meta-list put permanent-local t] 4) #@2  (defvar ediff-dir-difference-list nil (#$ . 2851)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-dir-difference-list put permanent-local t] 4) #@2  (defvar ediff-dir-diffs-buffer nil (#$ . 3012)) (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅÆ!„ÇÆBLJ" [make-variable-buffer-local ediff-dir-diffs-buffer put permanent-local t boundp ediff-session-registry nil current-load-list] 4) #@61 *Hooks run just after the registry control panel is set up. (defvar ediff-registry-setup-hook nil (#$ . -3237)) #@101 *Hooks run just after a meta-buffer controlling a session group, such as ediff-directories, is run. (defvar ediff-session-group-setup-hook nil (#$ . -3356)) #@53 *Hooks run just after the registry buffer is shown. (defvar ediff-show-registry-hook nil (#$ . -3519)) #@56 *Hooks run just after a session group buffer is shown. (defvar ediff-show-session-group-hook nil (#$ . -3628)) (defalias 'ediff-get-group-buffer #[(meta-list) "@@‡" [meta-list] 1]) (defalias 'ediff-get-group-regexp #[(meta-list) "@A@‡" [meta-list] 1]) (defalias 'ediff-get-group-objA #[(meta-list) "À @8‡" [2 meta-list] 2]) (defalias 'ediff-get-group-objB #[(meta-list) "À @8‡" [3 meta-list] 2]) (defalias 'ediff-get-group-objC #[(meta-list) "À @8‡" [4 meta-list] 2]) (defalias 'ediff-get-session-buffer #[(elt) "@‡" [elt] 1]) (defalias 'ediff-get-session-status #[(elt) "A@‡" [elt] 1]) (defalias 'ediff-get-session-objA #[(elt) "À 8‡" [2 elt] 2]) (defalias 'ediff-get-session-objB #[(elt) "À 8‡" [3 elt] 2]) (defalias 'ediff-get-session-objC #[(elt) "À 8‡" [4 elt] 2]) (defalias 'ediff-set-session-status #[(session-info new-status) "A  ‡" [session-info new-status] 2]) (defalias 'ediff-setup-meta-map #[nil "À  !ˆÃ ÄÅ#ˆÃ ÆÇ#ˆÃ ÈÉ#ˆÃ Ê #ˆÃ Ì #ˆÃ ÍÎ#ˆÃ ÏÐ#ˆÃ ÑÐ#ˆÃ ÒÐ#ˆƒJà ÔÐ#ˆƒYà Ö #ˆ‚`à × #ˆØ !‡" [make-sparse-keymap ediff-meta-buffer-map suppress-keymap define-key "q" ediff-quit-meta-buffer "R" ediff-show-registry "E" ediff-documentation "v" ediff-meta-action-function " " " " ediff-next-meta-item "" ediff-previous-meta-item [delete] [backspace] ediff-no-emacs-help-in-control-buffer "" ediff-emacs-p [mouse-2] [button2] use-local-map] 4]) #@516 This mode controls all operations on Ediff session groups. It is entered through one of the following commands: `ediff-directories' `edirs' `ediff-directories3' `edirs3' `ediff-merge-directories' `edirs-merge' `ediff-merge-directories-with-ancestor' `edirs-merge-with-ancestor' `ediff-directory-revisions' `edir-revisions' `ediff-merge-directory-revisions' `edir-merge-revisions' `ediff-merge-directory-revisions-with-ancestor' `edir-merge-revisions-with-ancestor' Commands: \{ediff-meta-buffer-map} (defalias 'ediff-meta-mode #[nil "À ˆÁɇ" [kill-all-local-variables ediff-meta-mode major-mode "MetaEdiff" mode-name] 2 (#$ . 5001)]) (byte-code "À !ˆÂ ÃÄ#ˆÂ ÅÆ#ˆÂ ÇÈ#ˆÂ ÉÈ#ˆÂ ÊÈ#‡" [suppress-keymap ediff-dir-diffs-buffer-map define-key "q" ediff-bury-dir-diffs-buffer " " next-line "" previous-line [delete] [backspace]] 4) #@140 Move to the next item in Ediff registry or session group buffer. Moves in circular fashion. With numeric prefix arg, skip this many items. (defalias 'ediff-next-meta-item #[(count) "„ÁÂW…Sà ˆ‚‡" [count 1 0 ediff-next-meta-item1] 2 (#$ . 5852) "p"]) (defalias 'ediff-next-meta-item1 #[nil "ÀÂ`!‰ƒ bˆ Ä=ƒ!ÅÆÀÇ#…,ÈÀx‚,ÉÀwÊV…,ËÌ!)‡" [nil pos ediff-next-meta-overlay-start ediff-metajob-name ediff-registry search-forward "*Ediff" t "a-zA-Z*" "-+?H* 0-9" 0 backward-char 1] 5]) #@144 Move to the previous item in Ediff registry or session group buffer. Moves in circular fashion. With numeric prefix arg, skip this many items. (defalias 'ediff-previous-meta-item #[(count) "„ÁÂW…Sà ˆ‚‡" [count 1 0 ediff-previous-meta-item1] 2 (#$ . 6352) "p"]) (defalias 'ediff-previous-meta-item1 #[nil "ÀÂ`!‰ƒ bˆ Ä=ƒ!ÅÆÀÇ#…,ÈÀx‚,ÉÀwÊV…,ËÌ!)‡" [nil pos ediff-previous-meta-overlay-start ediff-metajob-name ediff-registry search-forward "*Ediff" t "a-zA-Z*" "-+?H* 0-9" 0 backward-char 1] 5]) (defalias 'ediff-intersect-directories #[(jobname diff-var regexp dir1 dir2 &optional dir3 comparison-func) "ÀÁ!ˆ\n† Ãĉ‰‰‰‰‰‰ \n \fÍ!ÏÄ#\fÍ!ÏÄ# ;ƒTÍ!ÏÄ#\nÓÔ\f\"\fÓÕ\f\"\fÖ\f ×\n$ ØÙ \"ˆ\nƒÖ \n×\n$ ‰†‹Ý>)ƒ—ØÞ \"ˆßà !á\" âã‰\f ×\n$\n×\n$ ×\n$ÓÔ \"ßàÓÕ \"!á\"Øä \"Øå \"ˆF B& LˆFØç \".B‡" [require cl comparison-func string= nil difflist auxdir3 auxdir2 auxdir1 common lis3 lis2 lis1 file-name-as-directory dir1 directory-files regexp dir2 dir3 delete "." ".." intersection :test mapcar #[(elt) "À \nP!À \nP!‰ƒ\f?† ?…\f*…'Æ\n\"‰‡" [file-directory-p auxdir1 elt auxdir2 b a delq common] 5] jobname metajob ediff-metajob-name (ediff-directories3 ediff-filegroups3) #[(elt) "À \nP!À \nP!‰ƒ\f?† ?…\f*…'Æ\n\"‰‡" [file-directory-p auxdir1 elt auxdir3 b a delq common] 5] sort copy-list string-lessp set-difference union #[(elt) "ÁB‡" [elt 1] 2] #[(elt) "@ ƒ‰AÂ_¡ˆ@ ƒ‰AÄ_¡ˆ@ …)‰AÆ_¡‡" [elt lis1 2 lis2 3 lis3 5] 3] diff-var #[(elt) " P\n P … \f PE‡" [auxdir1 elt auxdir2 lis3 auxdir3] 4]] 9]) (defalias 'ediff-get-directory-files-under-revision #[(jobname regexp dir1) "ÀÁ!ˆÂ‰‰‰Ç!É Â\n#ƒG@AË P!ƒ7 \fB‚Ì ÍQ!ƒ \fB‚ÎÏ\f\"ÎÐ\f\"ÑÒ\f!Ó\"\n ‰FÔÕ\f\",B‡" [require cl nil auxdir1 common elt lis1 file-name-as-directory dir1 directory-files regexp file-directory-p file-exists-p ",v" delete "." ".." sort copy-list string-lessp mapcar #[(elt) " P‰E‡" [auxdir1 elt nil] 3]] 4]) (defalias 'ediff-prepare-meta-buffer #[(action-func meta-list meta-buffer-name redraw-function jobname &optional startup-hooks) "À Â\"à !p\fƒôÆ\f!ƒôÇÆ\f!!ƒôÈŽ\fqˆÉ ˆ\n \f \fÑ ˆÒ=ƒO\fÖØÙ#ˆ‚]\f@BÚÛA\"B\f=„j\fB\f!ˆÝßà!ˆáâ!ˆ\nã=ƒÞ\f$@B$AB$å!„™æ$!ˆÖçè#ˆÖéê#ˆÖëì#ˆ‰-‰-†»î>)†Åï>)ƒÐÖðñ#ˆÖòó#ˆÖôõ#ˆÒ=ƒìáö!ˆ‚ðá÷!ˆ)‚ÿ8ù=„ÿúû!ˆ)\f*‡" [ediff-unique-buffer-name meta-buffer-name "*" get-buffer-create meta-buffer StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-meta-mode action-func ediff-meta-action-function redraw-function ediff-meta-redraw-function jobname ediff-metajob-name ediff-meta-buffer ediff-setup-meta-map ediff-registry ediff-registry-buffer meta-list ediff-meta-list define-key ediff-meta-buffer-map "M" ediff-show-meta-buff-from-registry mapcar #[(elt) "À‰ BB‡" [nil elt] 3] ediff-session-registry t buffer-read-only set-buffer-modified-p nil run-hooks startup-hooks ediff-dir-action ediff-dir-difference-list ediff-dir1-metajob ediff-draw-dir-diffs "h" ediff-mark-for-hiding "x" ediff-hide-marked-sessions "m" ediff-mark-for-operation metajob (ediff-directory-revisions ediff-merge-directory-revisions ediff-merge-directory-revisions-with-ancestor) (ediff-directories ediff-directory-revisions) "P" ediff-collect-custom-diffs "u" ediff-up-meta-hierarchy "D" ediff-show-dir-diffs ediff-registry-setup-hook ediff-session-group-setup-hook this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 5]) (defalias 'ediff-redraw-directory-group-buffer #[(meta-list) "À !ÂÃĉ‰‰‰‰‰‰‰‰ \n \f pƒZÓ!ƒZÔÓ!!ƒZÕŽqˆ`Ö ˆ×Ù!\"cˆÛ !Äĉ†gÝ>)†qÞ>)ƒxßcˆàcˆ;ƒGÃVƒ×á\"cˆâcˆ A‰‰ƒ¾ƒ¾@ƒµã@!ä=„µÄA‰„ƒÆåcˆ ƒL @ ATã !ä=„Ææ !\fç ! è !\né ! `\f„ê‚\fƒÓ\f!ƒÔÓ\f!!ƒë‚ìcˆã !†'êcˆíî!ﱈð !ˆð\n!ˆð !ˆñ` #ˆ‚ÆòÄ!ˆbˆ)‚d3ô=†dõö!.‡" [ediff-get-group-buffer meta-list t 0 nil buffer-read-only tmp-list point pt f3 f2 f1 session-buf elt regexp sessionNum empty meta-buf StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) erase-buffer format ediff-meta-buffer-message ediff-abbrev-jobname ediff-metajob-name ediff-get-group-regexp metajob (ediff-directory-revisions ediff-merge-directory-revisions ediff-merge-directory-revisions-with-ancestor) (ediff-directories ediff-directory-revisions) " `P': collect custom diffs of all marked sessions\n" " `u': show parent session group\n `D': display differences among the contents of directories\n\n" "Filter-through regular expression: %s\n" "\n\n Size Name\n -----------------------------------------------------------------------\n\n" ediff-get-session-status 73 " ****** ****** This session group has no members\n" ediff-get-session-buffer ediff-get-session-objA ediff-get-session-objB ediff-get-session-objC " " "+" "-" " Session " int-to-string ":\n" ediff-meta-insert-file-info ediff-set-meta-overlay set-buffer-modified-p this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 14]) (defalias 'ediff-problematic-session-p #[(session) "À ! !à !‰;ƒ>Ç!„> ;ƒ>Ç !„>\f;ƒ>Ç\f!ƒ>È \nË>)ƒ>Ì‚?È+‡" [ediff-get-session-objA session ediff-get-session-objB ediff-get-session-objC f3 f2 f1 file-directory-p nil metajob ediff-metajob-name (ediff-merge-directories-with-ancestor ediff-merge-filegroups-with-ancestor) ancestor-is-dir] 5]) (defalias 'ediff-meta-insert-file-info #[(file) ";…kÁÂÃÄ!8Å!ƒ@ÆÇ;ƒ,ÉBC\nË!)‚;\fƒ7Ë!‚;ËÍ\"*!‚iÇ;ƒYÉBC\nË!)‚h\fƒdË!‚hËÍ\"*#c‡" [file format " %10d %s\n" 7 file-attributes file-directory-p file-name-as-directory nil dir "" directory-abbrev-alist abbreviate-file-name ediff-emacs-p t] 7]) (defalias 'ediff-draw-dir-diffs #[(diff-list) "„ÁÂ!ˆÃÄÅ\"Ç!É!Ê \f ;ƒ0 ÍBCÏ\f!)‚Aƒ<Ï\f!‚AÏ\fÑ\"*Ó!Ê \f ;ƒa ÍBCÏ\f!)‚rƒmÏ\f!‚rÏ\fÑ\"*Õ!‰;…­Ê \f ;ƒ› ÍBCÏ\f!)‚¬ƒ§Ï\f!‚¬Ï\fÑ\"*×!ÙÚÛ\"Ê\fÊÊAß! p! ƒ!â !ƒ!ãâ !!ƒ!äŽ qˆå&!ˆç ˆ(écˆêcˆ;ƒGëVƒìí\"cˆîcˆìïðñ!Ê \f ;ƒ5 ÍBCÏ\f!)‚FƒAÏ\f!‚FÏ\fÑ\"*ò\"ðñ!Ê \f ;ƒh ÍBCÏ\f!)‚yƒtÏ\f!‚yÏ\fÑ\"*ò\"#cˆƒ¿ìóðñ!Ê \f ;ƒ¥ ÍBCÏ\f!)‚¶ƒ±Ï\f!‚¶Ï\fÑ\"*ò\"\"cˆ‚Âîcˆìô‰#cˆ;ƒÚìõ\"cˆ‚Ýöcˆ„ä÷cˆƒ@@\f@AAøù\"ëUƒIìúðû\fP!ƒñ\f!‚\fÊ \f ;ƒ/ ÍBCÏ\f!)‚@ƒ;Ï\f!‚@Ï\fÑ\"*ü\"\"cˆ‚Oìúý\"cˆøþ\"ëUƒ£ìÿðû\fP!ƒmñ\f!‚o\fÊ \f ;ƒ‰ ÍBCÏ\f!)‚šƒ•Ï\f!‚šÏ\fÑ\"*ü\"\"cˆ‚©ìÿý\"cˆ;ƒø@\"ëUƒìAðû\fP!ƒÑñ\f!‚Ó\fÊ \f ;ƒí ÍBCÏ\f!)‚þƒùÏ\f!‚þÏ\fÑ\"*ü\"\"cˆ‚ìAý\"cˆîcˆ‚äÑBÊ!)‚/CD=†/ÁE!.\f‡" [diff-list error "Lost difference info on these directories" ediff-unique-buffer-name "*Ediff File Group Differences" "*" buf-name ediff-get-group-regexp regexp ediff-get-group-objA nil dir file "" directory-abbrev-alist abbreviate-file-name ediff-emacs-p t dir1 ediff-get-group-objB dir2 ediff-get-group-objC dir3 ediff-get-group-buffer meta-buf make-string 26 45 underline code buffer-read-only get-buffer-create ediff-dir-diffs-buffer StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) use-local-map ediff-dir-diffs-buffer-map erase-buffer ediff-meta-buffer " *** Directory Differences ***\n" "\nUseful commands:\n `q': hide this buffer\n SPC: next line\n DEL: previous line\n\n" 0 format "Filter-through regular expression: %s\n" "\n" "\n%-27s%-26s" ediff-truncate-string-left file-name-as-directory 25 " %-25s\n" "%s%s" "%s\n\n" "\n\n" "\n *** No differences ***\n" mod 2 "%-27s" file-directory-p 24 "---" 3 "%-26s" 5 " %-25s" set-buffer-modified-p this-command ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff"] 8]) #@72 Bury the directory difference buffer. Display the meta buffer instead. (defalias 'ediff-bury-dir-diffs-buffer #[nil "ÁÄ ˆÅ !‰ƒÆ\n!‚ÇÈ \"*‡" [ediff-meta-buffer nil wind buf bury-buffer ediff-get-visible-buffer-window select-window set-window-buffer selected-window] 3 (#$ . 14257) nil]) #@70 Display differences among the directories involved in session group. (defalias 'ediff-show-dir-diffs #[nil "ÀÀ‰† \nÃ>*ƒÄÅ!ˆƒ(Ç!ƒ(ÈÇ!!„-É\n!ˆ ÌÍ!ˆÎÏ  \"ˆeb)‡" [nil metajob ediff-metajob-name (ediff-directory-revisions ediff-merge-directory-revisions ediff-merge-directory-revisions-with-ancestor) error "This command is inapplicable in the present context" ediff-dir-diffs-buffer get-buffer buffer-name ediff-draw-dir-diffs ediff-dir-difference-list buf other-window 1 set-window-buffer selected-window] 3 (#$ . 14558) nil]) #@40 Go to the parent session group buffer. (defalias 'ediff-up-meta-hierarchy #[nil "ƒÁ!ƒÂÁ!!ƒÃ!‡ÄÅ!‡" [ediff-parent-meta-buffer get-buffer buffer-name ediff-show-meta-buffer error "This session group has no parent"] 3 (#$ . 15107) nil]) (defalias 'ediff-redraw-registry-buffer #[(&optional ignore) "p ƒ{ !ƒ{à!!ƒ{ÄŽ qˆ`ʼn‰‰‰‰‰‰‰‰‰ \n \f Ò ˆÓcˆÔÕ\"ˆ„Q×cˆƒm@AƒUÂ!ƒUÃÂ!!ƒUpƒ¬Â!ƒ¬ÃÂ!!ƒ¬ØŽqˆ …¨Û=?)‚¶Ý=†¶Þß!)ƒr`\nàáÃ!â !#cˆàãä!Å%&%;ƒê%çBC(é&!)‚û*ƒöé&!‚ûé&ë\"*ì!†çÅ%&%;ƒ%çBC(é&!)‚/*ƒ*é&!‚/é&ë\"*í!†8çÅ%&%;ƒR%çBC(é&!)‚c*ƒ^é&!‚cé&ë\"*$cˆî\n`#ˆ‚Upƒ(Â!ƒ(ÃÂ!!ƒ(ïŽqˆ0ƒ«Â0!ƒ«ÃÂ0!!ƒ«Ã0!‚¬ñ2ƒÊÂ2!ƒÊÃÂ2!!ƒÊÃ2!‚Ëñ3„Û4„Ûç‚ø5ƒ÷Â5!ƒ÷ÃÂ5!!ƒ÷Ã5!‚øñ àö7\" 8ùUƒ\fú‚87Uƒû‚àü8T\"\f= )‚3Ý=„3Þß!ˆ)`\n\fþ ÿÃ!à@â !\"±ˆABB C±ˆî\n`#ˆ‚UDÅ!ˆb. ‚…Ý=†…Þß!)‡" [StartBuffer ediff-registry-buffer get-buffer buffer-name ((set-buffer StartBuffer)) nil buffer-read-only registry-list meta-list job-name pt total-diffs cur-diff bufCname bufBname bufAname elt point erase-buffer "This is a registry of all active Ediff sessions.\n\nUseful commands:\n button2, `v', RET over a session record: switch to that session\n `M' over a session record: display the associated session group\n `R' in any Ediff session: display session registry\n SPC: next session\n DEL: previous session\n `E': browse Ediff on-line manual\n `q': bury registry\n\n\n Active Ediff Sessions:\n ----------------------\n\n" mapcar #[(elt) "…Á!…ÂÁ!!?…Ã\f\"‰‡" [elt get-buffer buffer-name delq ediff-session-registry] 3] ediff-session-registry " ******* No active Ediff sessions *******\n" ((set-buffer StartBuffer)) ediff-metajob-name ediff-meta-list ediff-registry this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" format " *group* %s: %s\n" ediff-abbrev-jobname " %s %s %s\n" ediff-get-group-objA dir file "" directory-abbrev-alist abbreviate-file-name ediff-emacs-p t ediff-get-group-objB ediff-get-group-objC ediff-set-meta-overlay ((set-buffer StartBuffer)) ediff-buffer-A "!!!killed buffer!!!" ediff-buffer-B ediff-3way-comparison-job ediff-merge-job ediff-buffer-C "%-4d" ediff-number-of-differences ediff-current-difference -1 " _" " $" "%4d" ediff-job-name "/" " " ": %s" "\n " " " "\n" set-buffer-modified-p] 12]) (defalias 'ediff-set-meta-overlay #[(b e prop) "À \f\" ƒÆ ÇÈ#ˆ‚Æ ÈÉ#ˆÆ Ê #)‡" [nil overl ediff-make-overlay b e ediff-emacs-p ediff-overlay-put mouse-face highlight t ediff-meta-info prop] 4]) #@51 Mark session for hiding. With prefix arg, unmark. (defalias 'ediff-mark-for-hiding #[(unmark) "À !à !Å\f\n\"Ç! ƒ\"ÊË\"ˆ‚Eƒ?Ì!ƒ?ÍÌ!!ƒ?ÎÏÍ!\"ˆÊÐ\"ˆÑ\f!,‡" [ediff-event-point last-command-event pos ediff-event-buffer meta-buf ediff-get-meta-info info ediff-get-session-buffer session-buf unmark ediff-set-session-status nil get-buffer buffer-name error "Can't hide active session, %s" 72 ediff-update-meta-buffer] 4 (#$ . 17823) "P"]) #@62 Mark session for a group operation. With prefix arg, unmark. (defalias 'ediff-mark-for-operation #[(unmark) "À !à !Å\f\n\"ƒÈÉ\"ˆ‚\"ÈÊ\"ˆË\f!+‡" [ediff-event-point last-command-event pos ediff-event-buffer meta-buf ediff-get-meta-info info unmark ediff-set-session-status nil 42 ediff-update-meta-buffer] 3 (#$ . 18287) "P"]) #@48 Hide marked sessions. With prefix arg, unhide. (defalias 'ediff-hide-marked-sessions #[(unhide) "À ! A\nƒ ÂÄ\nƒÄ‚ÃÅÆ \n \f ƒM @ A Í!\n=ƒ%TÎ \"ˆ‚%ÅVƒ[Ï\f!‚kÐ ˆ\nƒhÑÒ!‚kÑÓ!.‡" [ediff-get-group-buffer ediff-meta-list unhide 73 72 0 nil elt numMarked to from meta-list grp-buf ediff-get-session-status ediff-set-session-status ediff-update-meta-buffer beep message "Nothing to reveal..." "Nothing to hide..."] 6 (#$ . 18631) "P"]) (defalias 'ediff-operate-on-marked-sessions #[(operation) "À ! AÂÉÄ \n ƒA @ A TË !=ƒŠT\f \"ˆ)‚Í\n!ˆ.‡" [ediff-get-group-buffer ediff-meta-list 42 0 nil elt sessionNum numMarked marksym meta-list grp-buf ediff-get-session-status operation ediff-update-meta-buffer] 6]) (defalias 'ediff-append-custom-diff #[(session sessionNum) "À „ ÁÂ!ˆÃ\f! lj \n ‰\fƒiÍ\f!ƒiÎÍ\f!!ƒip\fƒ]Í\f!ƒ]ÎÍ\f!!ƒ]ÐŽ\fqˆ\f=ƒY)‚hÔ=„hÁÕ!ˆ) ƒ~Í !ƒ~ÎÍ !!„‚ÁÖ!ˆƒªÍ!ƒªÎÍ!!ƒªŠ qˆdbˆ×!ˆØc)‚è\nÙ=ƒãŠÚ!‰ qˆÜ ˆÝÞß !â\f!ã\f!%ä\"ˆ)Š qˆdbˆ× !ˆØc)‚èÁå&\"-‡" [ediff-collect-diffs-metajob error "Sorry, I don't do this for everyone..." ediff-get-session-buffer session ediff-meta-diff-buffer ediff-metajob-name nil custom-diff-buf tmp-buf metajob meta-diff-buff session-buf get-buffer buffer-name StartBuffer ((set-buffer StartBuffer)) ediff-control-buffer ediff-custom-diff-buffer this-command ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff" "Ediff: something wrong--no multiple diffs buffer" insert-buffer "\n" ediff-directories get-buffer-create ediff-tmp-buffer erase-buffer shell-command format "%s %s %s %s" ediff-custom-diff-program ediff-custom-diff-options ediff-get-session-objA ediff-get-session-objB t "Session %d is marked but inactive--can't make its diff" sessionNum] 9]) #@300 Collect custom diffs of marked sessions in buffer `*Ediff Multifile Diffs*'. This operation is defined only for `ediff-directories' and `ediff-directory-revisions', since its intent is to produce multifile patches. For `ediff-directory-revisions', we insist that all marked sessions must be active. (defalias 'ediff-collect-custom-diffs #[nil "ƒÁ!ƒÂÁ!!„ÃÄÅÆ\"!pƒ:Á!ƒ:ÂÁ!!ƒ:ÈŽqˆÉ ˆ)‚E\nË=„EÌÍ!ˆ)ÎÏ!ÐVƒSÑÒ\"‡Ó ˆÔÕ!‡" [ediff-meta-diff-buffer get-buffer buffer-name get-buffer-create ediff-unique-buffer-name "*Ediff Multifile Diffs" "*" StartBuffer ((set-buffer StartBuffer)) erase-buffer this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ediff-operate-on-marked-sessions ediff-append-custom-diff 0 display-buffer not-this-window beep message "No marked sessions found"] 4 (#$ . 20476) nil]) #@54 Execute appropriate action for the selected session. (defalias 'ediff-dir-action #[nil "À !à !Å\f\n\"ÇÇ Ç\nÇ Ç\fÍ!Î! Ï!\nÐ! Ñ!Ò>ƒXÓ ˆÔÕ!ƒTÖÇ\"ˆ×\f!ˆ‚XØÙ!ˆp\fƒ>Û\f!ƒ>ÜÛ\f!!ƒ>ÝŽ\fqˆ\nbˆÞ !ƒã\n;ƒãÞ\n!ƒã ;ƒ–Þ !‚—߃ヶÛ!ƒ¶ÜÛ!!ƒ¶à!‚:áâÇã#\fä \n \f%&çèÇéêë,DEíëDîBBFD&‚:Ç/lj/†ï&ð>*ƒ@Þ !ƒ@ƒÛ!ƒÜÛ!!ƒà!‚:áâÇã#\fñ \f%&çèÇéêë,DEíëDòBBFD%‚:ƒŒÛ!ƒŒÜÛ!!ƒŒpƒ~Û!ƒ~ÜÛ!!ƒ~óŽqˆô 5ö÷!)‚ˆ8ù=†ˆØú!)‚:û!ƒ¼Ó ˆÔü!ƒ¶ý \nçèÇéìpEíëDþBBFD#‚:ØÙ!‚:Ç/lj/†È&ð>*ƒç% çèÇéìpEíëDÿBBFD\"‚:Ç/&@>)„% \nçèÇéìpEíëDABBFD#‚:Ç/&@>)…:% \n çèÇéìpEíëDBBBFD$)‚H8ù=†HØú!. ‡" [ediff-event-point last-command-event pos ediff-event-buffer meta-buf ediff-get-meta-info info nil session-buf file1 file2 file3 regexp ediff-get-session-buffer ediff-get-session-objA ediff-get-session-objB ediff-get-session-objC ediff-get-session-status (72 73) beep y-or-n-p "This session is marked as hidden, unmark? " ediff-set-session-status ediff-update-meta-buffer error "Aborted" StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) file-directory-p t ediff-show-meta-buffer read-string "Filter through regular expression: " ediff-filtering-regexp-history ediff-directories-internal ediff-session-action-function ediff-metajob-name list lambda setq ediff-parent-meta-buffer quote ediff-meta-buffer setcar (ediff-meta-buffer) metajob (ediff-directory-revisions ediff-merge-directory-revisions ediff-merge-directory-revisions-with-ancestor) ediff-directory-revisions-internal (ediff-meta-buffer) ((set-buffer StartBuffer)) mouse-pixel-position ediff-mouse-pixel-position ediff-recenter no-rehighlight this-command ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff" ediff-problematic-session-p "This session's ancestor is a directory, merge without the ancestor? " ediff-merge-files (ediff-control-buffer) (ediff-control-buffer) (ediff-merge-directories-with-ancestor ediff-merge-filegroups-with-ancestor ediff-directories3 ediff-filegroups3) (ediff-control-buffer) (ediff-control-buffer)] 14 (#$ . 21337) nil]) #@31 Switch to a selected session. (defalias 'ediff-registry-action #[nil "À !à !Å\f\n\"‰ƒ˜Ç!ƒ˜ÈÇ!!ƒ˜p ƒIÇ!ƒIÈÇ!!ƒIÊŽqˆËÌ!)Í=‚SÏ=†SÐÑ!)ƒ_Ò!ˆ‚¢p ƒ‰Ç!ƒ‰ÈÇ!!ƒ‰ÓŽqˆÔ Ö×!ˆ)‚”Ï=„”ÐÑ!ˆ)‚¢Ø ˆÙÚ!ˆÛ ˆp \fƒÂÇ\f!ƒÂÈÇ\f!!ƒÂÜŽ\fqˆ\nb)‚ÌÏ=†ÌÐÑ!,‡" [ediff-event-point last-command-event pos ediff-event-buffer buf ediff-get-meta-info ctl-buf get-buffer buffer-name StartBuffer ((set-buffer StartBuffer)) key-binding "q" ediff-quit-meta-buffer this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ediff-show-meta-buffer ((set-buffer StartBuffer)) mouse-pixel-position ediff-mouse-pixel-position ediff-recenter no-rehighlight beep message "You've selected a stale session --- try again" ediff-update-registry ((set-buffer StartBuffer))] 4 (#$ . 23492) nil]) #@32 Show the session group buffer. (defalias 'ediff-show-meta-buffer #[(&optional meta-buf) "À‰‰\fƒ\fÅ\f†Ç\f!„ ÈÉ!ˆ‚6\fƒ2Ê\f!ƒ2ËÊ\f!!„6ÈÌ!ˆÍ\f!ˆp\fƒÿÊ\f!ƒÿËÊ\f!!ƒÿÏŽ\fqˆŠÐ\f!‰ƒq „eÑÒ!ˆÓ \f\"ˆÔ !ˆ‚ûÕ‰!ƒ‡Ó\f\"ˆÔ !ˆ‚ûÕ‰!ƒÓ\f\"ˆÔ !ˆ‚ûÕ‰!ƒ³Ó\f\"ˆÔ !ˆ‚ûÐ!‰ƒñƒÆ‚ÊÜÝ !ƒñƒ×‚ÛÜÝ !Þ>„ñÔ !ˆßà!ˆÓá \f\"ˆ‚ûâã!ˆÓá \f\"ˆ*‚\n$å=„\nÈæ!ˆ)ƒ‚ÜÝ !ƒ=ƒ&‚*ÜÝ !Þ>„=çÐ\f!!è\n!ˆé\n!ˆêë!+‡" [nil silent frame wind meta-buf t ediff-meta-buffer bufferp error "This Ediff session is not part of a session group" get-buffer buffer-name "Can't find this session's group panel -- session itself is ok" ediff-cleanup-meta-buffer StartBuffer ((set-buffer StartBuffer)) ediff-get-visible-buffer-window message "Already showing the group panel for this session" set-window-buffer select-window window-live-p ediff-window-C ediff-window-A ediff-window-B ediff-registry-buffer ediff-emacs-p window-system device-type selected-device (tty stream) other-window 1 selected-window ediff-skip-unsuitable-frames ok-unsplittable this-command ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff" window-frame raise-frame ediff-reset-mouse run-hooks ediff-show-session-group-hook] 3 (#$ . 24330) nil]) #@64 Display the session group buffer for a selected session group. (defalias 'ediff-show-meta-buff-from-registry #[nil "À !à !Å\f\n\"‰pƒ5É!ƒ5ÊÉ!!ƒ5ËŽqˆÌ )‚? Î=†?ÏÐ!-‡" [ediff-event-point last-command-event pos ediff-event-buffer meta-buf ediff-get-meta-info info meta-or-session-buf StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-show-meta-buffer this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 4 (#$ . 25589) nil]) #@27 Display Ediff's registry. (defalias 'ediff-show-registry #[nil "À ˆ ƒ !ƒà!!„ÄÅ!ˆÆ‰p ƒâ !ƒâà!!ƒâÊŽ qˆŠË !‰ƒUÌÍ!ˆÎ \"ˆÏ!ˆ‚ÞÐ!ƒjÎ \"ˆÏ!ˆ‚ÞÐ!ƒÎ \"ˆÏ!ˆ‚ÞÐ!ƒ”Î \"ˆÏ!ˆ‚ÞË!‰ƒÔƒ¨‚¬×Ø !ƒÔƒ¹‚½×Ø !Ù>„ÔÏ!ˆÚÛ!ˆÎÜ \"ˆ‚ÞÝÞ!ˆÎÜ \"ˆ*‚íà=„íÄá!ˆ)ƒø‚ü×Ø !ƒ#ƒ ‚ ×Ø !Ù>„#âË !!ã!ˆä!ˆåæ!*‡" [ediff-update-registry ediff-registry-buffer get-buffer buffer-name error "No active Ediff sessions or corrupted session registry" nil frame wind StartBuffer ((set-buffer StartBuffer)) ediff-get-visible-buffer-window message "Already showing the registry" set-window-buffer select-window window-live-p ediff-window-C ediff-window-A ediff-window-B ediff-meta-buffer ediff-emacs-p window-system device-type selected-device (tty stream) other-window 1 selected-window ediff-skip-unsuitable-frames ok-unsplittable this-command ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff" window-frame raise-frame ediff-reset-mouse run-hooks ediff-show-registry-hook] 3 (#$ . 26095) nil]) (defalias (quote eregistry) (quote ediff-show-registry)) (defalias 'ediff-update-meta-buffer #[(meta-buf) "ppƒ\\Áp!ƒ\\ÂÁp!!ƒ\\ÃŽpqˆ\f…XÁ\f!…XÂÁ\f!!…Xp\fƒMÁ\f!ƒMÂÁ\f!!ƒMÅŽ\fqˆ!)‚WÉ=†WÊË!))‚fÉ=†fÊË!)‡" [StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) meta-buf ((set-buffer StartBuffer)) ediff-meta-redraw-function ediff-meta-list this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 3]) (defalias 'ediff-update-registry #[nil "ppƒ<Áp!ƒ<ÂÁp!!ƒ<ÃŽpqˆ\fƒ0Á\f!ƒ0ÂÁ\f!!ƒ0Å ‚8ÆÇÉÅÊ%)‚F Ì=†FÍÎ!)‡" [StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-registry-buffer ediff-redraw-registry-buffer ediff-prepare-meta-buffer ediff-registry-action ediff-session-registry "*Ediff Registry" ediff-registry this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 6]) (defalias 'ediff-cleanup-meta-buffer #[(meta-buffer) "…WÁ!…WÂÁ!!…WpƒLÁ!ƒLÂÁ!!ƒLÄŽqˆÅ!ˆ…HÁ!…HÂÁ!!…HÅ!)‚VÈ=†VÉÊ!)‡" [meta-buffer get-buffer buffer-name StartBuffer ((set-buffer StartBuffer)) ediff-update-meta-buffer ediff-parent-meta-buffer this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 3]) (defalias 'ediff-safe-to-quit #[(meta-buffer) "…Á!…ÂÁ!!… ÄÅÉ!ˆp\nƒtÁ!ƒtÂÁ!!ƒtËŽqˆAƒnƒnÌ!ƒfÁÌ!!ƒfÂÁÌ!!!ƒfÅA‚>)‚~ Î=†~ÏÐ!,‡" [meta-buffer get-buffer buffer-name ediff-meta-list t nil buffer-read-only cont lis ediff-update-meta-buffer StartBuffer ((set-buffer StartBuffer)) ediff-get-group-buffer this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 4]) #@229 If no unprocessed sessions in the group, delete the meta buffer. If no session is in progress, ask to confirm before deleting meta buffer. Otherwise, bury the meta buffer. If this is a session registry buffer then just bury it. (defalias 'ediff-quit-meta-buffer #[nil "p   =‰ƒÉ ˆ‚žÊ!ˆË!ƒ0ÌÍ!ƒ0Î!ˆ‚FË!ƒ<É ˆ‚FÉ ˆÏ ˆÐÑ!ˆÊ!ˆ\n‰ƒeÒ!ƒeÓÒ!!ƒeÔÒ!!ˆ)\f‰ƒ€Ò!ƒ€ÓÒ!!ƒ€ÔÒ!!ˆ)ƒžÒ!ƒžÓÒ!!ƒžÕÖ!ˆ†¥× -‡" [buf ediff-dir-diffs-buffer dir-diffs-buffer ediff-meta-diff-buffer meta-diff-buffer ediff-parent-meta-buffer parent-buf ediff-registry-buffer dont-show-registry bury-buffer ediff-cleanup-meta-buffer ediff-safe-to-quit y-or-n-p "Quit this session group? " ediff-dispose-of-meta-buffer beep message "Group has active sessions, panel not deleted" get-buffer buffer-name kill-buffer t ediff-show-meta-buffer ediff-show-registry] 4 (#$ . 28872) nil]) (defalias 'ediff-dispose-of-meta-buffer #[(buf) "À \n\"p ƒ<Ä !ƒ<ÅÄ !!ƒ<ÆŽ qˆƒ8Ä!ƒ8ÅÄ!!ƒ8È!ˆ)‚G Ê=„GËÌ!ˆ)È !‡" [delq buf ediff-session-registry StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-dir-diffs-buffer kill-buffer this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 3]) (defalias 'ediff-get-meta-info #[(buf point &optional noerror) "À‰‰\fƒ ƒÆ !ƒÇÆ !!ƒp ƒuÆ !ƒuÇÆ !!ƒuÉŽ qˆ\nƒMË\f Ì#‰…IÍ Ì\"‚qÎ\f!ÏÐ\n\"‰ƒn\n@„nÑ\n@Ò\"ƒn\nA‰„Z\n@)‚€Ô=„€ÕÖ!ˆ) ƒ‰ ‚•?…•Ø ˆÕÙ!+‡" [nil tmp olist result point buf get-buffer buffer-name StartBuffer ((set-buffer StartBuffer)) ediff-xemacs-p extent-at ediff-meta-info ediff-overlay-get overlays-at mapcar #[(elt) "À Â\"‡" [overlay-get elt ediff-meta-info] 3] overlay-get invisible this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" noerror ediff-update-registry "No session info in this line"] 5]) (defalias 'ediff-next-meta-overlay-start #[(point) "À\nƒ)Ã\fpÅ#‰ƒÆ !‚Æp! ƒ%Ç !‚Jd‚J\fdUƒ1eÈ\f!@‰ƒGÉ Å\"ƒGÊ !‚JË\f!)‡" [nil overl ediff-xemacs-p extent-at point ediff-meta-info next-extent extent-start-position overlays-at overlay-get overlay-end next-overlay-change] 5]) (defalias 'ediff-previous-meta-overlay-start #[(point) "À\nƒ)Ã\fpÅ#‰ƒÆ !‚Æp! ƒ%Ç !‚Pd‚PÈ\f!@‰ƒAÉ Å\"ƒAÊË !!‚DÊ\f!‰eUƒOd‚P\f)‡" [nil overl ediff-xemacs-p extent-at point ediff-meta-info previous-extent extent-start-position overlays-at overlay-get previous-overlay-change overlay-start] 5]) (byte-code "ÀÁ!ˆÂÃ!‡" [provide ediff-mult require ediff-util] 2) emacs-19.30/lisp/ediff-util.elc100666 12120 1 246133 6054602773 14654 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 22 06:11:07 1995 ;;; from file /home/fsf/rms/e19/lisp/ediff-util.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`ediff-util.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require ediff-init ediff-mult] 2) #@623 Ediff mode controls all operations in a single Ediff session. This mode is entered through one of the following commands: `ediff' `ediff-files' `ediff-buffers' `ediff3' `ediff-files3' `ediff-buffers3' `ediff-merge' `ediff-merge-files' `ediff-merge-files-with-ancestor' `ediff-merge-buffers' `ediff-merge-buffers-with-ancestor' `ediff-merge-revisions' `ediff-merge-revisions-with-ancestor' `ediff-windows-wordwise' `ediff-windows-linewise' `ediff-regions-wordwise' `ediff-regions-linewise' `epatch' `ediff-patch-file' `ediff-patch-buffer' `epatch-buffer' `ediff-revision' Commands: \{ediff-mode-map} (defalias 'ediff-mode #[nil "À ˆÁÃÅÆ!‡" [kill-all-local-variables ediff-mode major-mode "Ediff" mode-name run-hooks ediff-mode-hook] 2 (#$ . 536)]) (byte-code "ÀÁ!ˆÀÂ!‡" [require ediff-diff ediff-merg] 2) #@125 Local keymap used in Ediff mode. This is local to each Ediff Control Panel, so they may vary from invocation to invocation. (defvar ediff-mode-map nil (#$ . 1372)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-mode-map put permanent-local t] 4) #@36 Set up Ediff keymap, if necessary. (defalias 'ediff-set-keys #[nil "„Á ˆÂ!‡" [ediff-mode-map ediff-setup-keymap use-local-map] 2 (#$ . 1635)]) (defalias 'ediff-reload-keymap #[nil "À ‡" [nil ediff-mode-map ediff-set-keys] 1 nil nil]) #@56 Set up the keymap used in the control buffer of Ediff. (defalias 'ediff-setup-keymap #[nil "À  !ˆÃ ÄÅ#ˆÃ ÆÅ#ˆÃ ÇÅ#ˆÃ ÈÅ#ˆÃ É\n…(Å#ˆÃ ËÌ#ˆÃ ÍÌ#ˆÃ ÎÏ#ˆÃ ÐÑ#ˆÃ ÒÓ#ˆÃ ÔÓ#ˆÃ ÕÖ#ˆÃ ×Ø#ˆÃ ÙÚ#ˆÃ ÛÜ#ˆÃ ÝÞ#ˆÃ ßà#ˆ!„}à âã#ˆ$ƒˆÃ åæ#ˆÃ çè#ˆÃ éê#ˆÃ ëê#ˆÃ ìê#ˆÃ íê#ˆÃ îê#ˆÃ ïð#ˆÃ ñð#ˆÃ òó#ˆÃ ôõ#ˆÃ ö÷#ˆÃ øù#ˆÃ úû#ˆÃ üý#ˆ!„çà þÿ#ˆÃ @Ñ#ˆÃ AÑ#ˆÃ BÑ#ˆCƒWà DE#ˆÃ @F#ˆÃ AG#ˆÃ BH#ˆÃ IJ#ˆÃ KL#ˆÃ MN#ˆÃ OP#ˆ‚óQƒËà RS#ˆÃ TS#ˆÃ US#ˆÃ VS#ˆÃ WÑ#ˆÃ XS#ˆÃ YS#ˆÃ Z[#ˆÃ \\[#ˆÃ ][#ˆÃ ^_#ˆ‚óà @`#ˆÃ Aa#ˆÃ Z[#ˆÃ \\[#ˆÃ bc#ˆÃ dÑ#ˆÃ ef#ˆÃ gf#ˆ!„(à hi#ˆÃ jÑ#ˆÃ k_#ˆÃ l_#ˆÃ mÑ#ˆÃ no#ˆÃ po#ˆÃ qo#ˆrƒà so#ˆÃ tÓ#ˆÃ uv#ˆÁ Mˆwx!‡" [make-sparse-keymap ediff-mode-map suppress-keymap define-key "p" ediff-previous-difference "" [backspace] [delete] "" ediff-no-emacs-help-in-control-buffer "n" ediff-next-difference " " "j" ediff-jump-to-difference "g" nil "ga" ediff-jump-to-difference-at-point "gb" "q" ediff-quit "D" ediff-show-diff-output "z" ediff-suspend "\f" ediff-recenter "|" ediff-toggle-split "h" ediff-toggle-hilit ediff-word-mode "@" ediff-toggle-autorefine ediff-narrow-job "%" ediff-toggle-narrow-region "~" ediff-swap-buffers "v" ediff-scroll-vertically "" "^" "ö" "V" "<" ediff-scroll-horizontally ">" "i" ediff-status-info "E" ediff-documentation "?" ediff-toggle-help "!" ediff-update-diffs "M" ediff-show-meta-buffer "R" ediff-show-registry "*" ediff-make-or-kill-fine-diffs "a" "b" "r" ediff-merge-job "/" ediff-show-ancestor #[(arg) "À Â\"‡" [ediff-diff-to-diff arg "ac"] 3 nil "P"] #[(arg) "À Â\"‡" [ediff-diff-to-diff arg "bc"] 3 nil "P"] #[(arg) "À Â\"‡" [ediff-restore-diff arg 99] 3 nil "P"] "s" ediff-shrink-window-C "+" ediff-combine-diffs "$" ediff-toggle-show-clashes-only "&" ediff-re-merge ediff-3way-comparison-job "ab" ediff-diff-to-diff "ba" "ac" "bc" "c" "ca" "cb" "ra" ediff-restore-diff "rb" "rc" "C" ediff-toggle-read-only #[(arg) "À Â\"‡" [ediff-diff-to-diff arg "ab"] 3 nil "P"] #[(arg) "À Â\"‡" [ediff-diff-to-diff arg "ba"] 3 nil "P"] "G" ediff-submit-report "#" "#h" ediff-toggle-regexp-match "#f" "##" ediff-toggle-skip-similar "o" "A" "B" "w" "wa" ediff-save-buffer "wb" "wd" ediff-3way-job "wc" "gc" "m" ediff-toggle-wide-display run-hooks ediff-keymap-setup-hook] 4 (#$ . 1881)]) (byte-code "ÀÁ!ˆÂÃ!„ÂÃ!„Äà Bć" [require ediff-wind boundp synchronize-minibuffers nil current-load-list] 2) (defalias 'ediff-setup #[(buffer-A file-A buffer-B file-B buffer-C file-C startup-hooks setup-parameters) "À !À\n! ;ƒÀ !ÄÅÆ\"p ƒ=Ê !ƒ=ËÊ !!ƒ=ÌŽ qˆÍ!)‚GÏ=†GÐÑ!)pƒ6Ê!ƒ6ËÊ!!ƒ6ÓŽqˆÔ ˆƒƒ@@@ALˆA‰„p×>Ù>Û>†œ†¥ß> á>\"ã>$åæ!ˆåç!ˆåè!ˆåé!ˆåê!ˆåë!ˆåì!ˆíîï!\"ƒâð,1ƒëåò!ˆ1ƒøóòô\"ˆ‚ýóõô\"ˆö 7ƒm)ø=ƒ9‚ :;(<=ÍÄþÆ\"!<Š„¶oBo)‚ÅÏ=„ÅÐÑ!ˆ)pGƒ=ÊG!ƒ=ËÊG!!ƒ=pŽGqˆk ˆlm!ˆpƒÊ!ƒËÊ!!ƒqŽqˆ)‚#Ï=†#ÐÑ!)ƒ*ðEo>„9oBo)‚HÏ=„HÐÑ!ˆ)ƒšpHƒŽÊH!ƒŽËÊH!!ƒŽrŽHqˆk ˆlm!ˆo>„ŠoBo)‚™Ï=„™ÐÑ!ˆ)=ƒþÊ=!ƒþËÊ=!!ƒþp=ƒòÊ=!ƒòËÊ=!!ƒòsŽ=qˆk ˆðElm!ˆo>„îoBo)‚ýÏ=„ýÐÑ!ˆ)] \n #ˆtGuvwxy!ˆxz!ˆƒ,x{!ˆƒ9x|!ˆ} 9<$ˆg@~~!…h1ƒb€~!‚h~!)gA@~~!…Œ1ƒ†€~!‚Œ~!)Vg8~~!…²1ƒ¬€~!‚²~!)‚ƒ„Š…†!ˆ„bˆ)Š…‡!ˆƒbˆ)ƒåŠ…ˆ!ˆ‚bˆ)+…‰!ˆŠ ˆl‹!ˆŒ ˆðEBŽ ˆƒ*Ê!ƒ*ËÊ!!ƒ*!ˆl‘!ˆ)‚AÏ=„AÐÑ!ˆ)*‡" [expand-file-name file-A file-B file-C ediff-unique-buffer-name "*Ediff Control Panel" "*" control-buffer-name StartBuffer buffer-A get-buffer buffer-name ((set-buffer StartBuffer)) get-buffer-create this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" control-buffer ((set-buffer StartBuffer)) ediff-mode setup-parameters ediff-job-name (ediff-files3 ediff-buffers3) ediff-3way-comparison-job (ediff-merge-files ediff-merge-buffers ediff-merge-files-with-ancestor ediff-merge-buffers-with-ancestor ediff-merge-revisions ediff-merge-revisions-with-ancestor) ediff-merge-job (ediff-merge-files-with-ancestor ediff-merge-buffers-with-ancestor ediff-merge-revisions-with-ancestor) ediff-merge-with-ancestor-job ediff-3way-job ediff-diff3-job (ediff-windows-wordwise ediff-regions-wordwise ediff-windows-linewise ediff-regions-linewise) ediff-narrow-job (ediff-windows-wordwise ediff-windows-linewise) ediff-windows-job (ediff-windows-wordwise ediff-regions-wordwise) ediff-word-mode-job make-local-variable ediff-prefer-long-help-message ediff-prefer-iconified-control-frame ediff-split-window-function ediff-default-variant ediff-merge-window-share ediff-window-setup-function ediff-keep-variants string-match "buffer" symbol-name t ediff-emacs-p pre-command-hook add-hook ediff-spy-after-mouse local-pre-command-hook mouse-pixel-position ediff-mouse-pixel-position default-B buffer-B buf ediff-merge-split-window-function buffer-C ediff-ancestor-buffer "*ediff-merge" insert-buffer ((set-buffer StartBuffer)) major-mode local-write-file-hooks ediff-set-merge-mode nil buffer-read-only ediff-buffer-A ediff-buffer-B ediff-buffer-C ediff-control-buffer "<[0-9]*>" 0 "" ediff-control-buffer-suffix string-to-number "[0-9]+" ediff-control-buffer-number "*ediff-errors" ediff-error-buffer ((set-buffer StartBuffer)) mode-line-format (" A: " " B: " " C: " " Ancestor: ") 2 ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ediff-save-protected-variables ediff-setup-diff-regions3 ediff-setup-diff-regions ediff-setup-diff-regions-function ediff-make-bullet-proof-overlay (point-min) (point-max) (point-min) (point-max) (point-min) (point-max) ediff-wide-bounds ediff-start-narrowed ediff-narrow-bounds ediff-visible-bounds ediff-set-keys ((set-buffer StartBuffer)) ediff-nuke-selective-display run-hooks ediff-prepare-buffer-hook ((set-buffer StartBuffer)) ediff-this-buffer-ediff-sessions ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ediff-difference-vector-A ediff-number-of-differences -1 ediff-current-difference ediff-make-current-diff-overlay A B C Ancestor ediff-setup-windows overl ediff-overlayp overlay-start extent-start-position shift-C shift-B shift-A select-window ediff-window-A ediff-window-B ediff-window-C ediff-control-window ediff-visible-region startup-hooks ediff-refresh-mode-lines ediff-session-registry ediff-update-registry ediff-meta-buffer ediff-update-meta-buffer ediff-startup-hook] 7]) #@35 Set up window for control buffer. (defalias 'ediff-setup-control-buffer #[(ctl-buf) "ÀÁ !ƒ \nqˆ‚Ã\n!ˆÄÆ ˆÇ ˆcˆÉ ˆÊ „(Ë ˆÌÍ!ˆÎ ˆÁ ÐуI‚MØÙ !…fƒZ‚^ØÙ !Ú>?…f&ebˆÍw)‡" [window-dedicated-p selected-window ctl-buf switch-to-buffer 2 window-min-height erase-buffer ediff-set-help-message ediff-help-message shrink-window-if-larger-than-buffer ediff-multiframe-setup-p ediff-indent-help-message set-buffer-modified-p nil ediff-refresh-mode-lines ediff-control-window format "%S%S%S%S%S%S%S" ediff-window-A ediff-window-B ediff-window-C ediff-split-window-function ediff-emacs-p window-system device-type selected-device (tty stream) ediff-multiframe ediff-wide-display-p ediff-window-config-saved ediff-whitespace] 9 (#$ . 9132)]) (defalias 'ediff-help-message-line-length #[nil "Šebˆƒ\fÁÂ!ˆÃˆi)‡" [ediff-prefer-long-help-message next-line 1 nil] 2]) (defalias 'ediff-indent-help-message #[nil "ÀÁ !à Z]Ä¥Æ Ç\"Šebˆ`dW…)cˆÀyˆÉyˆ‚+‡" [0 window-width selected-window ediff-help-message-line-length 2 shift make-string 32 str 1] 3]) (defalias 'ediff-set-help-message #[nil "ƒ9„:ƒ ‚I ƒ\n \fQ‚I ƒ*\n\fQ‚Iƒ7\n\fQ‚I ƒD\n\n\fQ‚I\n \fQ\f ƒb 9„\\ :ƒb ‚ ;ƒm ‚ƒw‚{ÐÑ !ƒ›ƒˆ‚ŒÐÑ !Ò>„›ƒ›‚ƒ©\f‚«ØÙ!‡" [ediff-long-help-message-function ediff-word-mode ediff-long-help-message-head ediff-long-help-message-word-mode ediff-long-help-message-tail ediff-narrow-job ediff-long-help-message-narrow2 ediff-merge-job ediff-long-help-message-merge ediff-diff3-job ediff-long-help-message-compare3 ediff-long-help-message-compare2 ediff-long-help-message ediff-brief-help-message-function ediff-emacs-p window-system device-type selected-device (tty stream) ediff-multiframe ediff-brief-message-string ediff-brief-help-message ediff-prefer-long-help-message ediff-help-message run-hooks ediff-display-help-hook] 3]) #@217 Recompute difference regions in buffers A, B, and C. Buffers are not synchronized with their respective files, so changes done to these buffers are not saved at this point---the user can do this later, if necessary. (defalias 'ediff-update-diffs #[nil "À\np=„ ÃÄ \"ˆ)ƒ-Ç!ƒ-ÈÇ!!ƒ-ÉÊ!„-ÃË!ˆp\f ƒPÇ !ƒPÈÇ !!ƒPÎŽ qˆ`)‚Y Ï=†YÃÐ!)Ñ!ÓÔ !†jÈ !!ÓÔ!†wÈ!!ÓÔ!†„È!!@A@Ø8À‰‰‰‰‰‰‰‰ !\"#$%&'()êë!ˆ$,í,!…Ú.ƒÖï,!‚Úð,!)!#,í,!…ø.ƒôï,!‚øð,!)\",í,!….ƒï,!‚ð,!)$,í,!…4.ƒ0ñ,!‚4ò,!) #,í,!…R.ƒNñ,!‚Rò,!)\",í,!…p.ƒlñ,!‚pò,!)3ƒ¶ô!  ($ˆõ(ö\"ô($ˆõ(÷\"8ƒÓô($ˆõ(ù\"‚Óõ '\"õ&\"8ƒÓõ%\"úûü\"ˆúýü\"ˆúþü\"ˆúÿü\"ˆÀ?ÀÀ@ÀABCDEFFEDCBDƒ!GBHCÀDÀEIFB#ˆ-;GJK!ˆK!ˆƒKK!ˆ8ƒv\nLMNMJW…sONL\"ˆNT‰N‚[)ˆ)PQR)\"!ˆST!.‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-ancestor-buffer get-buffer buffer-name y-or-n-p "Recompute differences during merge, really? " "God forbid!" StartBuffer ediff-buffer-A ((set-buffer StartBuffer)) ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff" get-buffer-create ediff-tmp-buffer file-name-nondirectory buffer-file-name ediff-buffer-B ediff-buffer-C ediff-narrow-bounds 2 file-C file-B file-A end-C beg-C end-B beg-B end-A beg-A overl-C overl-B overl-A buf-C-file-name buf-B-file-name buf-A-file-name tmp-buffer point-A ediff-unselect-and-select-difference -1 overl ediff-overlayp ediff-emacs-p overlay-start extent-start-position overlay-end extent-end-position ediff-word-mode ediff-wordify ediff-make-temp-file "regA" "regB" ediff-3way-job "regC" ediff-clear-diff-vector ediff-difference-vector-A fine-diffs-also ediff-difference-vector-B ediff-difference-vector-C ediff-difference-vector-Ancestor ediff-state-of-merge ediff-killed-diffs-alist ediff-setup-diff-regions-function ediff-3way-comparison-job ediff-merge-job ediff-merge-with-ancestor-job ediff-job-name ediff-setup-diff-regions3 t ediff-files3 ediff-number-of-differences delete-file ctl-buf 0 n ediff-set-state-of-diff-in-all-buffers ediff-jump-to-difference ediff-diff-at-point A message ""] 17 (#$ . 11052) nil]) #@67 Revert buffers A, B and C. Then rerun Ediff on file A and file B. (defalias 'ediff-revert-buffers-then-recompute-diffs #[(noconfirm) "À\np=„ ÃÄ \"ˆ)\n \n \f pƒYØ!ƒYÙØ!!ƒYÚŽqˆÛÜ\"ˆ)‚c Þ=„cÃß!ˆ)pƒŒØ!ƒŒÙØ!!ƒŒàŽqˆÛÜ\"ˆ)‚– Þ=„–Ãß!ˆ)ƒÏpƒÄØ!ƒÄÙØ!!ƒÄáŽqˆÛÜ\"ˆ)‚Î Þ=„ÎÃß!ˆ)ƒüqˆâ?!ˆã!ˆƒóä#‚þå\"‚þæ . ‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-buffer-A ediff-buffer-B ediff-buffer-C ediff-keep-variants ediff-ancestor-buffer ediff-merge-with-ancestor-job ediff-merge-job ediff-3way-comparison-job comparison merge ancestor-job ancestor-buf keep-variants ctl-buf bufC bufB bufA StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) revert-buffer t noconfirm ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff" ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ediff-really-quit kill-buffer ediff-merge-buffers-with-ancestor ediff-merge-buffers ediff-update-diffs] 9 (#$ . 13372) "P"]) #@117 Bring the highlighted region of all buffers being compared into view. Reestablish the default three-window display. (defalias 'ediff-recenter #[(&optional no-rehighlight) "À\np=„ ÃÄ \"ˆ)ƒÇÀ À\n ƒmÌ !ƒmÍÌ !!ƒmƒmÌ!ƒmÍÌ!!ƒmƒ`ƒmÌ!ƒmÍÌ!!ƒmÑ \n$ˆ‚z Ò=„zÓÔÕÖ!\"ˆ)× ˆƒˆ‚ŒÚÛ !ƒíƒ™‚ÚÛ !Ü>„í 9ƒí9ƒí Þ>„à ß>ƒíàáâ!\"„íã$!ƒÑåæ$!!ˆã'!ƒßåæ'!!ˆã(!ƒíåæ(!!ˆƒ÷‚ûÚÛ !ƒhƒ‚\fÚÛ !Ü>„hé*!ƒh+„h*,ƒ+‚/ÚÛ !…_ƒ<‚@ÚÛ !í>?…_é,!…_ƒYî,!‚_ï,!ð=)„hå*!ˆ*\n12 ƒzÌ !ƒzÍÌ !!ƒzƒzÌ!ƒzÍÌ!!ƒzƒ³ƒzÌ!ƒzÍÌ!!ƒz3„½ô5!ˆö÷!ˆöø!ˆƒÎöù!ˆp:1ƒoÌ1!ƒoÍÌ1!!ƒoûŽ1qˆü ˆƒù‚ýÚÛ !ƒkƒ\n‚ÚÛ !ý>„k>ƒk+„k*,ƒ+‚/ÚÛ !…_ƒ<‚@ÚÛ !í>?…_é,!…_ƒYî,!‚_ï,!ð=)„kÿ2 Ò=\"ˆ)‚y Ò=„yÃÔ!ˆ)p:1ƒ¢Ì1!ƒ¢ÍÌ1!!ƒ¢@Ž1qˆA )‚« Ò=†«ÃÔ!+‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-xemacs-p t synchronize-minibuffers ediff-disturbed-overlays buffer-read-only ediff-buffer-A get-buffer buffer-name ediff-buffer-B ediff-3way-job ediff-buffer-C ediff-setup-windows ediff-quit message "You've killed an essential Ediff buffer---Please quit Ediff" beep 1 ediff-visible-region ediff-emacs-p window-system device-type selected-device (tty stream) last-command (ediff-recenter ediff-dir-action ediff-registry-action ediff-patch-action ediff-toggle-wide-display ediff-toggle-multiframe) (ediff-next-difference ediff-previous-difference ediff-jump-to-difference ediff-jump-to-difference-at-point) string-match "^ediff-" symbol-name window-live-p ediff-window-A raise-frame window-frame ediff-window-B ediff-window-C frame-live-p ediff-control-frame ediff-prefer-long-help-message frame (tty stream) frame-iconified-p frame-visible-p icon control-buf control-frame no-rehighlight ediff-select-difference ediff-current-difference ediff-recenter-one-window A B C StartBuffer ((set-buffer StartBuffer)) ediff-recenter-ancestor (tty stream) ediff-multiframe ediff-reset-mouse ((set-buffer StartBuffer)) ediff-refresh-mode-lines] 5 (#$ . 14468) nil]) (defalias 'ediff-recenter-one-window #[(buf-type) "À\n‰ÃY… \fW)…µÅ È=ƒ\" @‚;Ê=ƒ0 A@‚;Ë=…;Ì 8 Î !…TƒPÐ !‚TÑ !)×ØÙ\"!ÛJ!…sJ‰ƒ…ƒ…Þ\"ˆƒ¯ß!ˆà ˆáâãÀ$âäÀ$âãÀ$$ˆß!.‡" [nil n ediff-current-difference 0 ediff-number-of-differences selected-window ctl-wind buf-type A ediff-narrow-bounds B C 2 overl ediff-overlayp ediff-emacs-p overlay-start extent-start-position shift ediff-job-name job-name ediff-control-buffer control-buf intern format "ediff-window-%S" window-name window-live-p window ediff-windows-job set-window-start select-window ediff-deactivate-mark ediff-position-region ediff-get-diff-posn beg end] 9]) (defalias 'ediff-recenter-ancestor #[nil "…‘Á!…‘ÂÁ!!…‘à ‰ÆY… \fW)…‘È!É \n \f pƒ€Á!ƒ€ÂÁ!!ƒ€ÑŽqˆÒÓÔÃ\f$bˆƒ|Õ!ˆÖÒÓÔÃ\f$ÒÓ×Ã\f$ÒÓÔÃ\f$ $ˆ)‚‹Ù=„‹ÚÛ!ˆ)Õ!,‡" [ediff-ancestor-buffer get-buffer buffer-name nil n ediff-current-difference 0 ediff-number-of-differences ediff-get-visible-buffer-window selected-window ediff-job-name ediff-control-buffer ctl-buf job-name ctl-wind window StartBuffer ((set-buffer StartBuffer)) ediff-get-diff-posn Ancestor beg select-window ediff-position-region end this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 9]) #@102 Toggle vertical/horizontal window split. Does nothing if file-A and file-B are in different frames. (defalias 'ediff-toggle-split #[nil "À\np=„ ÃÄ \"ˆ)Æ!…Æ !…\" \nÆ !…- \f…8Í!\n…CÍ\n!\f…NÍ\f!=„‚Ñ!ƒ‚Ñ!ƒ‚ƒ“Ñ!ƒ‚=„‚=ƒ“Ô=ƒÕ‚ŽÔ‚—Ö×!ˆØÙ!.‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command window-live-p ediff-window-A wind-A ediff-window-B wind-B ediff-window-C wind-C window-frame frame-A frame-B frame-C frame-live-p ediff-3way-comparison-job ediff-split-window-function split-window-vertically split-window-horizontally message "Buffers being compared are in different frames" ediff-recenter no-rehighlight] 3 (#$ . 17930) nil]) #@154 Switch between highlighting using ASCII flags and highlighting using faces. On a dumb terminal, switches between ASCII highlighting and no highlighting. (defalias 'ediff-toggle-hilit #[nil "À\np=„ ÃÄ \"ˆ)ƒ‚ÈÉ !ƒ2ƒ)‚-ÈÉ !Ê>ƒN Ì=ƒHÍÎ!ˆÏÑ\"ˆÒ‰ ‡ÏÓ\"‡ÏÑ\"ˆƒhƒhÍÖ!ˆÀ‚ƒwÍ×!ˆÀ‚ÍØ!ˆÙÙƒ‘ƒ‘Ú ˆ‚•ÚÛ!ˆÏÓ\"‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-emacs-p window-system device-type selected-device (tty stream) ediff-highlighting-style ascii message "ASCII highlighting flags removed" ediff-unselect-and-select-difference ediff-current-difference unselect-only off select-only ediff-use-faces ediff-highlight-all-diffs "Unhighlighting unselected difference regions" "Highlighting with ASCII flags" "Re-highlighting all difference regions" t ediff-color-background-regions unhighlight] 3 (#$ . 18694) nil]) #@26 Toggle auto-refine mode. (defalias 'ediff-toggle-autorefine #[nil "À\np=„ ÃÄ \"ˆ)ƒÃÇ!ˆÉ=ƒ+ÊË\fÍ\"ˆÎÏ!‡Ê=ƒ;ÎÐ!ˆÑ‰‡Ò\fÓ\"ˆÎÔ!ˆÉ‰‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-word-mode "No fine differences in this mode" ediff-auto-refine nix on ediff-make-fine-diffs ediff-current-difference noforce message "Auto-refining is ON" "Auto-refining is OFF" off ediff-set-fine-diff-properties default "Refinements are HIDDEN"] 3 (#$ . 19625) nil]) #@48 Show the ancestor buffer in a suitable window. (defalias 'ediff-show-ancestor #[nil "À ˆ ƒ !ƒà!!„$\fƒ ÅÆ!ˆ‚$ÅÇ!ˆÈ Ê !‰ ƒ9ËÌ !!‚>Í \")‡" [ediff-recenter ediff-ancestor-buffer get-buffer buffer-name ediff-merge-with-ancestor-job error "Lost connection to ancestor buffer...sorry" "Not merging with ancestor" nil wind ediff-get-visible-buffer-window raise-frame window-frame set-window-buffer ediff-window-C] 3 (#$ . 20162) nil]) #@123 Compute fine diffs. With negative prefix arg, kill fine diffs. In both cases, operates on the currrent difference region. (defalias 'ediff-make-or-kill-fine-diffs #[(arg) "À\np=„ ÃÄ \"ˆ)Ç=ƒ±‰ Ê  ÌÍÎ \"!J H‰ƒ8ÐÑÒH\"ˆ)ÌÍÎ \"!J HÒÀIˆ* Ó  ÌÍÎ \"!J H‰ƒiÐÑÒH\"ˆ)ÌÍÎ \"!J HÒÀIˆ*…¯ Õ  ÌÍÎ \"!J H‰ƒŸÐÑÒH\"ˆ)ÌÍÎ \"!J HÒÀI*)‡§ƒZÖWƒZ‰ Ê  ÌÍÎ \"!J H‰ƒáÐÑÒH\"ˆ)ÌÍÎ \"!J HÒÀIˆ* Ó  ÌÍÎ \"!J H‰ƒÐÑÒH\"ˆ)ÌÍÎ \"!J HÒÀIˆ*…X Õ  ÌÍÎ \"!J H‰ƒHÐÑÒH\"ˆ)ÌÍÎ \"!J HÒÀI*)‡× ‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command arg - ediff-current-difference n A buf-type intern format "ediff-difference-vector-%S" diff-record mapcar ediff-delete-overlay 1 B ediff-3way-job C 0 ediff-make-fine-diffs] 6 (#$ . 20613) "P"]) #@33 Toggle short/long help message. (defalias 'ediff-toggle-help #[nil "À\np=„ ÃÄ \"ˆ)ÀÇ ˆ?É ˆ)ƒ\nƒ, ‚0ÌÍ !ƒ\nƒ= ‚AÌÍ !Î>„ƒ\nƒY ‚]ÌÍ !…\nƒj ‚nÌÍ !Ò>?…Ó!…ƒ‡Õ!‚Ö!×=)ÙÛÜ!‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command buffer-read-only erase-buffer ediff-prefer-long-help-message ediff-set-help-message ediff-emacs-p window-system device-type selected-device (tty stream) ediff-multiframe ediff-control-frame frame (tty stream) frame-live-p ediff-xemacs-p frame-iconified-p frame-visible-p icon ediff-prefer-iconified-control-frame "" ediff-window-config-saved ediff-recenter no-rehighlight] 3 (#$ . 21464) nil]) #@206 Toggle read-only in current buffer. If buffer is under version control and locked, check it out first. If optional argument BUF is specified, toggle read-only in that buffer instead of the current buffer. (defalias 'ediff-toggle-read-only #[(&optional buf) "À\np=„ ÃÄ \"ˆ)?…p„È ˆ„à Ê>ƒ/Ë‚B Ì>ƒ:Í‚B Î>…BÏË=ƒL‚Á Ê>ƒWË‚j Ì>ƒbÍ‚j Î>…jÏÍ=ƒt‚Á Ê>ƒË‚’ Ì>ƒŠÍ‚’ Î>…’ÏÏ=ƒœ‚Á Ê>ƒ§Ë‚º Ì>ƒ²Í‚º Î>…ºÏÓ=…ÁpƒwÖ!ƒw×Ö!!ƒwØŽqˆÙ!‰…öÛ!…öÜ!†.‰;…Û!…Ü!…ÛßP!)ƒ\"à‚.ƒ+à‚.áâ!#‰;…NÛ!…NÜ!?…NÛßP!)ƒƒ$„bà#‚åæ!ˆçèéÀ**;ƒ…*ëBC,í!)‚–.ƒ‘í!‚–íï\"*\"!ƒïpƒáÖ!ƒá×Ö!!ƒáðŽqˆñäÀ Ê>ƒÈË‚Û Ì>ƒÓÍ‚Û Î>…ÛÏ#ˆ)‚ë ò=„ëÃó!ˆ)‚à#åæ!ˆåæ!ˆôõ!ˆö÷!ˆ#ƒøùú#!\"ƒŠû‹ˆ)‚Ãü\"ˆ…s$?…s ý=…sÛ!…sÜ!?…sôþÀ**;ƒ]*ëBC,í!)‚n.ƒií!‚níï\"*åæ!#,‚€ ò=†€Ãó!*‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command buf ctl-buf ediff-recenter last-command-char (97 65) A (98 66) B (99 67) C ediff-buffer-A ediff-buffer-B ediff-buffer-C Ancestor ediff-ancestor-buffer StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) buffer-file-name file file-exists-p file-writable-p file-writable ediff-toggle-read-only-function ",v" toggle-read-only key-binding "" toggle-ro-cmd buffer-read-only beep 1 y-or-n-p format "File %s is under version control. Check it out? " dir "" directory-abbrev-alist abbreviate-file-name ediff-emacs-p t ((set-buffer StartBuffer)) ediff-change-saved-variable ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff" message "Boy, this is risky! Better don't change this file..." sit-for 3 string-match "toggle-read-only" symbol-name ((command-execute toggle-ro-cmd)) "Don't know how to toggle read-only in buffer %S" ediff-toggle-read-only "Warning: file %s is read-only"] 7 (#$ . 22200) nil]) (defalias 'ediff-file-checked-out-p #[(file) ";…Á!…Â!…ÁÃP!‡" [file file-exists-p file-writable-p ",v"] 3]) (put (quote ediff-file-checked-out-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-file-checked-in-p #[(file) ";…Á!…Â!?…ÁÃP!‡" [file file-exists-p file-writable-p ",v"] 3]) (put (quote ediff-file-checked-in-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@44 Rotate the display of buffers A, B, and C. (defalias 'ediff-swap-buffers #[nil "À\np=„ ÃÄ \"ˆ)Æ!ƒÅÆ!ƒÅ \n \f =ƒ5‚9ÒÓ !…RƒF‚JÒÓ !Ô>?…Rƒ}Þ\"ˆÞ \"ˆÞ !\"ˆ‚‹Þ!\"ˆÞ \"ˆƒŸ !!‚§! !ƒ»\"\n#\"#‚Ã#\n#ƒ×$ %$%‚ß% %ƒÿ&\f'&'( )()‚'\f') )ƒ‚ÒÓ !ƒOƒ*‚.ÒÓ !Ô>„OƒG*+*+‚O++ƒcì8@A@E‚-ƒwA@@ì8E‚A@@Dƒ•ì.8.@.A@E‚±-ƒ©.A@.@ì.8E‚±.A@.@D.ƒ¿‚Ã..-ƒê\n/ð1ð2W…çó1/\"ˆ1T‰1‚Ñ)ˆ)ôõ!‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command window-live-p ediff-window-A ediff-window-B ediff-buffer-A ediff-buffer-values-orig-A ediff-difference-vector-A ediff-regexp-hide-A ediff-regexp-focus-A ediff-visible-bounds ediff-wide-bounds ediff-emacs-p window-system device-type selected-device (tty stream) ediff-current-diff-overlay-A overlay wide-visibility-p focus-regexp hide-regexp diff-vec values buf ediff-3way-comparison-job set-window-buffer ediff-buffer-C ediff-window-C ediff-buffer-B ediff-buffer-values-orig-C ediff-buffer-values-orig-B ediff-difference-vector-C ediff-difference-vector-B ediff-regexp-hide-C ediff-regexp-hide-B ediff-regexp-focus-C ediff-regexp-focus-B ediff-current-diff-overlay-C ediff-current-diff-overlay-B 2 ediff-3way-job ediff-narrow-bounds ctl-buf 0 n ediff-number-of-differences ediff-set-state-of-diff-in-all-buffers ediff-recenter no-rehighlight] 8 (#$ . 24579) nil]) #@93 Toggle wide/regular display. This is especially useful when comparing buffers side-by-side. (defalias 'ediff-toggle-wide-display #[nil "À\np=„ ÃÄ \"ˆ)Æ „!ÃǃɂÊ\"ˆËÌ!ˆ\n ?‰„tp ƒgÐ !ƒgÑÐ !!ƒgÒŽ qˆÓ\"ˆ qˆÀÀËÌ!)‚p ×=†pÃØ!)‚ª ˆp ƒ Ð !ƒ ÑÐ !!ƒ ÚŽ qˆÀËÌ!)‚© ×=†©ÃØ!))‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-window-display-p "%sEmacs is not running as a window application" ediff-emacs-p "" "X" ediff-recenter no-rehighlight ctl-buf ediff-wide-display-p StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) modify-frame-parameters ediff-wide-display-frame ediff-wide-display-orig-parameters ediff-window-B ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff" ediff-make-wide-display-function ((set-buffer StartBuffer))] 4 (#$ . 26150) nil]) #@136 Switch from the multiframe display to single-frame display and back. This is primarily for debugging, but one can use it for fun, too. (defalias 'ediff-toggle-multiframe #[nil "À\np=„ ÃÄ \"ˆ)Æ „!ÃǃɂÊ\"ˆ Ì=ƒ.Í ‚8 Í=ƒ8Ì ÀÏÐ!‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-window-display-p "%sEmacs is not running as a window application" ediff-emacs-p "" "X" ediff-window-setup-function ediff-setup-windows-multiframe ediff-setup-windows-plain ediff-window-B ediff-recenter no-rehighlight] 3 (#$ . 27048) nil]) #@95 Toggle the mode where only the regions where both buffers differ with the ancestor are shown. (defalias 'ediff-toggle-show-clashes-only #[nil "À\np=„ ÃÄ \"ˆ)„ÃÇ!ˆ?‰ƒ$ÉÊ!‡ÉË!‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-merge-with-ancestor-job "This command makes sense only when merging with an ancestor" ediff-show-clashes-only message "Focus on regions where both buffers differ from the ancestor" "Canceling focus on regions where changes clash"] 4 (#$ . 27652) nil]) #@78 Toggle narrowing in buffers A, B, and C. Used in ediff-windows/regions only. (defalias 'ediff-toggle-narrow-region #[nil " =ƒ\nÂÃ!ˆ\f =ƒ‚ ÇÈ!‡" [ediff-buffer-A ediff-buffer-B error "Buffers A and B are the same. Can't narrow to two different regions" ediff-visible-bounds ediff-wide-bounds ediff-narrow-bounds ediff-recenter no-rehighlight] 2 (#$ . 28211) nil]) (defalias 'ediff-visible-region #[nil " =†\n=†\n =?…W „\f @ A@Æ 8 p\nƒË!ƒÌË!!ƒÍŽqˆ Ï!…\\ƒXÑ!‚\\Ò!) Ï!…xƒtÓ!‚xÔ!)}ˆ)‚ŠÖ=„Š×Ø!ˆ)p\n ƒãË !ƒãÌË !!ƒãÙŽ qˆÏ!…Àƒ¼Ñ!‚ÀÒ!)Ï!…܃ØÓ!‚ÜÔ!)}ˆ)‚îÖ=„î×Ø!ˆ)…Vp\n\nƒKË\n!ƒKÌË\n!!ƒKÛŽ\nqˆÏ!…)ƒ%Ñ!‚)Ò!)Ï!…EƒAÓ!‚EÔ!)})‚UÖ=†U×Ø!)+‡" [ediff-buffer-A ediff-buffer-B ediff-buffer-C ediff-narrow-job ediff-wide-bounds ediff-visible-bounds 2 overl-C overl-B overl-A StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) overl ediff-overlayp ediff-emacs-p overlay-start extent-start-position overlay-end extent-end-position this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ((set-buffer StartBuffer)) ediff-3way-job ((set-buffer StartBuffer))] 4]) (defalias 'ediff-operate-on-windows #[(operation arg) "À !ƒ\fÀ\n!„ÃÄ!ˆ ƒAÆ !ƒAÇÆ !!ƒAƒAÆ!ƒAÇÆ!!ƒA ƒE\n„EËÌ!ˆÍ  \nÓÔ\"Ó×\" ‰…nÓÚ\"Ü!ˆÝÞ߈Ü!ˆÝàሃ“Ü!ˆÝâãˆÜ!.‡" [window-live-p ediff-window-A ediff-window-B ediff-recenter no-rehighlight ediff-buffer-A get-buffer buffer-name ediff-buffer-B ediff-3way-job ediff-buffer-C error "You've killed an essential Ediff buffer---Please quit Ediff" selected-window wind wind-A wind-B ediff-window-C wind-C ediff-get-region-size-coefficient A operation coefA B coefB three-way C coefC select-window nil (byte-code "Á\n _!!‡" [operation round coefA arg] 4) ((error)) (byte-code "Á\n _!!‡" [operation round coefB arg] 4) ((error)) (byte-code "Á\n _!!‡" [operation round coefC arg] 4) ((error))] 4]) #@153 Vertically scroll buffers A, B (and C if appropriate). With optional argument ARG, scroll ARG lines; otherwise scroll by nearly the height of window-A. (defalias 'ediff-scroll-vertically #[(&optional arg) "À\np=„ ÃÄ \"ˆ)Æ!ƒÆ!„ ÉÊ!ˆ ƒdÌ !ƒdÍÌ !!ƒdƒdÌ!ƒdÍÌ!!ƒdƒhƒdÌ!ƒdÍÌ!!„hÃÑ!ˆÒÔ>ƒtÕ‚uÖƒˆØš„ˆÙ!‚ºÀÛ!Û!^ƒ Û!‚¡Ý^Þ¥ZàZƒ·Þ¥‚¹)\"‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command window-live-p ediff-window-A ediff-window-B ediff-recenter no-rehighlight ediff-buffer-A get-buffer buffer-name ediff-buffer-B ediff-3way-job ediff-buffer-C "You've killed an essential Ediff buffer---Please quit Ediff" ediff-operate-on-windows last-command-char (118 22) scroll-up scroll-down arg - prefix-numeric-value default-amount window-height ediff-window-C 500 2 next-screen-context-lines 1] 5 (#$ . 30240) "P"]) #@166 Horizontally scroll buffers A, B (and C if appropriate). If an argument is given, that is how many columns are scrolled, else nearly the width of the A/B/C windows. (defalias 'ediff-scroll-horizontally #[(&optional arg) "À\np=„ ÃÄ \"ˆ)Æ!ƒÆ!„ ÉÊ!ˆ ƒdÌ !ƒdÍÌ !!ƒdƒdÌ!ƒdÍÌ!!ƒdƒhƒdÌ!ƒdÍÌ!!„hÃÑ!ˆÒÔUƒtÕ‚uÖƒˆØš„ˆÙ!‚¹…¹Û!Û!^ƒ¢Û!‚£Þ^ߥàZ!ƒ¶!ߥ‚¸!)\"‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command window-live-p ediff-window-A ediff-window-B ediff-recenter no-rehighlight ediff-buffer-A get-buffer buffer-name ediff-buffer-B ediff-3way-job ediff-buffer-C "You've killed an essential Ediff buffer---Please quit Ediff" ediff-operate-on-windows last-command-char 60 scroll-left scroll-right arg - prefix-numeric-value ediff-control-window window-width ediff-3way-comparison-job ediff-window-C 500 2 3 default-amount] 5 (#$ . 31174) "P"]) (defalias 'ediff-position-region #[(beg end pos job-name) "dVƒd ƒ)Â!?…qŠÃÄ ÅZ!ˆÆ`\"Å\\È!*‡ÉÊ  \"ˆÂ!ƒn̉ Ã!ˆ`VƒY `WƒY` T‚< bˆÏÄÊ !SZÐ]TÅ¥!ˆ*b‡" [end ediff-windows-job pos-visible-in-window-p move-to-window-line window-height 2 count-lines amount scroll-up set-window-start selected-window beg 0 prev-point lines recenter 1 pos] 3]) (defalias 'ediff-get-lines-to-region-end #[(buf-type &optional n ctl-buf) "„ \n„\f p\nƒ·Å\n!ƒ·ÆÅ\n!!ƒ·ÇŽ\nqˆÉ=ƒ1\n‚RË=ƒ=\f‚RÍ=ƒI‚RÏ=…RÒÓÔÕ\"!!×!ÙÚ\"Ûpƒ¨Å!ƒ¨ÆÅ!!ƒ¨ÝŽqˆWƒŸÞ\"‚¢ß)‚² á=†²âã!.‚Á á=†Áâã!)‡" [n ediff-current-difference ctl-buf ediff-control-buffer StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) buf-type A ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer buf eval intern format "ediff-window-%S" wind window-start beg ediff-get-diff-posn end nil lines ((set-buffer StartBuffer)) count-lines 0 this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 5]) (defalias 'ediff-get-lines-to-region-start #[(buf-type &optional n ctl-buf) "„ \n„\f p\nƒ®Å\n!ƒ®ÆÅ\n!!ƒ®ÇŽ\nqˆÉ=ƒ1\n‚RË=ƒ=\f‚RÍ=ƒI‚RÏ=…RÒÓÔÕ\"!!×!ÙÚ\"pƒŸÅ!ƒŸÆÅ!!ƒŸÛŽqˆWƒšÜ\"‚›Ý)‚©ß=†©àá!.‚¸ß=†¸àá!)‡" [n ediff-current-difference ctl-buf ediff-control-buffer StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) buf-type A ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer buf eval intern format "ediff-window-%S" wind window-end end ediff-get-diff-posn beg ((set-buffer StartBuffer)) count-lines 0 this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 5]) (defalias 'ediff-get-region-size-coefficient #[(buf-type op &optional n ctl-buf) "p „\n\nƒÃ †\n!ƒÄà †\n!!ƒÅŽ †'\nqˆÇ=ƒ4È‚@É=ƒ?Ê‚@ˉ\fÍ #\fÏ #]ƒoÃ!ƒoÄÃ!!ƒo\fÑ #‚pÒ]‰ÒVƒ‹\f #Õ\\Ö\\¥‚Œ×+‚šÙ=†šÚÛ!)‡" [StartBuffer ctl-buf ediff-control-buffer get-buffer buffer-name ((set-buffer StartBuffer)) op scroll-down ediff-get-lines-to-region-start scroll-up ediff-get-lines-to-region-end (lambda (a b c) 0) func A n B ediff-buffer-C C 0 max-lines buf-type 0.0 0.0 1 this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 6]) #@89 Advance to the next difference. With a prefix argument, go back that many differences. (defalias 'ediff-next-difference #[(&optional arg) "À\np=„ ÃÄ \"ˆ)Wƒ¹ƒ$‚%É\\^À\n‰ Y„C\f !‰\n„CÍ !ˆ Wƒ¯\n„ƒkÏЃf HÒH†gÓ\"„ƒ¯ÕÖ×Ø\"!J HÙHƒ¯ T Ú Û\"ÒUƒ”ÜÝ \"ˆ Y„C\f !‰\n„CÍ !ˆ‚CÜÓ!ˆÞ !*‡ß ˆÃà!‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-current-difference ediff-number-of-differences arg 1 regexp-skip n ediff-skip-diff-region-function ediff-install-fine-diff-if-necessary ediff-show-clashes-only string-match "prefer" ediff-state-of-merge 0 "" ediff-ignore-similar-regions intern format "ediff-difference-vector-%S" A 2 mod 20 message "Skipped over region %d and counting ..." ediff-unselect-and-select-difference ediff-visible-region "At end of the difference list"] 5 (#$ . 34546) "P"]) #@88 Go to the previous difference. With a prefix argument, go back that many differences. (defalias 'ediff-previous-difference #[(&optional arg) "À\np=„ ÃÄ \"ˆ)ÇVƒµÇƒ\"‚#ÉZ]À\n‰ ÌW„@  !‰\n„@Î !ˆ ÇVƒ«\n„{ƒgÐуb HÌH†cÓ\"„{ƒ«ÕÖ×Ø\"!J HÙHƒ«Ú TÛ\"ÌUƒÜÝ T\"ˆ S‰ ÌW„@  !‰\n„@Î !ˆ‚@ÜÓ!ˆÞ !*‡ß ˆÃà!‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-current-difference -1 arg 1 regexp-skip n 0 ediff-skip-diff-region-function ediff-install-fine-diff-if-necessary ediff-show-clashes-only string-match "prefer" ediff-state-of-merge "" ediff-ignore-similar-regions intern format "ediff-difference-vector-%S" A 2 mod 20 message "Skipped over region %d and counting ..." ediff-unselect-and-select-difference ediff-visible-region "At beginning of the difference list"] 5 (#$ . 35466) "P"]) #@54 Go to the difference specified as a prefix argument. (defalias 'ediff-jump-to-difference #[(difference-number) "À\np=„ ÃÄ \"ˆ)S‰ÇYƒ'TWƒ'É!‡ÃÊ\"‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command difference-number -1 ediff-number-of-differences ediff-unselect-and-select-difference "Bad difference number, %d"] 4 (#$ . 36364) "p"]) #@154 Go to difference closest to the point in buffer A, B, or C. The type of buffer depends on last command character (a, b, or c) that invoked this command. (defalias 'ediff-jump-to-difference-at-point #[nil "À\np=„ ÃÄ \"ˆ)Ç>ƒÈ‚,É>ƒ$Ê‚,Ë>…,Ì ÎÏ !!)‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command last-command-char (97 65) A (98 66) B (99 67) C buf-type ediff-jump-to-difference ediff-diff-at-point] 3 (#$ . 36777) nil]) (defalias 'ediff-diff-at-point #[(buf-type &optional pos) "Á=ƒ\n\n‚'Ã=ƒ\f‚'Å=ƒ‚'Ç=…' \nSË̉‰‰ pƒÁÖ!ƒÁ×Ö!!ƒÁØŽqˆ†e`W„wVƒ£Wƒ£T ÚÎ$ÚÍ$ ‚gÛZ!ÛZ!Wƒº‚½T)‚ËÝ=†ËÞß!. ‡" [buf-type A ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer ediff-control-buffer ediff-number-of-differences -1 0 end beg prev-end prev-beg diff-no max-dif-num ctl-buffer buffer StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) pos ediff-get-diff-posn abs this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 8]) #@621 Copy buffer-X'th diff to buffer Y (X,Y are A, B, or C). If numerical prefix argument, copy this diff specified in the arg. Otherwise, copy the difference given by `ediff-current-difference'. This command assumes it is bound to a 2-character key sequence, `ab', `ba', `ac', etc., which is used to determine the types of buffers to be used for copying difference regions. The first character in the sequence specifies the source buffer and the second specifies the target. If the second optional argument, a 2-character string, is given, use it to determine the source and the target buffers instead of the command keys. (defalias 'ediff-diff-to-diff #[(arg &optional keys) "À\np=„ ÃÄ \"ˆ)„Ç ƒ!É!ˆÊH ÌH ƒe ‰¨†Z9ƒHÐN†Z:…Z@9…Z@ÐN)ƒeÑ !‚g ƒ¡ ‰¨†–9ƒ„ÐN†–:…–@9…–@ÐN)ƒ¡Ñ !‚£ ÀÕ×>ƒ¶Ø‚ÉÙ>ƒÁÚ‚ÉÛ>…ÉÜ×>ƒÔØ‚çÙ>ƒßÚ‚çÛ>…çÜ#ˆÝ -‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command keys this-command-keys arg ediff-jump-to-difference 0 key1 1 key2 ediff-xemacs-p obj event-symbol-elements event-key char1 char2 ediff-verbose-p ediff-copy-diff ediff-current-difference (97 65) A (98 66) B (99 67) C ediff-recenter] 6 (#$ . 37947) "P"]) (defalias 'ediff-copy-diff #[(n from-buf-type to-buf-type &optional batch-invocation reg-to-copy) "Á=ƒ\n\n‚'Ã=ƒ\f‚'Å=ƒ‚'Ç=…' \n Ì ÐÐÐÐÐÖ× $ÖÙ $ƒbЂ Љ pp ƒÄß !ƒÄàß !!ƒÄᎠqˆÁ=ƒ \n‚ÀÃ=ƒ«\f‚ÀÅ=ƒ·‚ÀÇ=…À)‚Î\"ã=†Îäå!)ƒ ßp ƒ ß !ƒ àß !!ƒ æŽ qˆÁ=ƒü\n‚Ã=ƒ\f‚Å=ƒ‚Ç=…)‚*\"ã=†*äå!)!ƒ àßp ƒ~ß !ƒ~àß !!ƒ~çŽ qˆÁ=ƒZ\n‚zÃ=ƒe\f‚zÅ=ƒq‚zÇ=…z)‚ˆ\"ã=†ˆäå!)!!ƒ èŽp ƒÝß !ƒÝàß !!ƒÝéŽ qˆÁ=ƒ¹\n‚ÙÃ=ƒÄ\f‚ÙÅ=ƒÐ‚ÙÇ=…Ù)‚ç\"ã=†çäå!)qˆ†øÖ× $†ÖÙ ${)‚\"ã=†äå!.  pp ƒ|ß !ƒ|àß !!ƒ|ᎠqˆÁ=ƒX\n‚xÃ=ƒc\f‚xÅ=ƒo‚xÇ=…x)‚†\"ã=††äå!)ƒÃßp ƒØß !ƒØàß !!ƒØæŽ qˆÁ=ƒ´\n‚ÔÃ=ƒ¿\f‚ÔÅ=ƒË‚ÔÇ=…Ô)‚â\"ã=†âäå!)!ƒÃàßp ƒ6ß !ƒ6àß !!ƒ6çŽ qˆÁ=ƒ\n‚2Ã=ƒ\f‚2Å=ƒ)‚2Ç=…2)‚@\"ã=†@äå!)!!ƒÃèŽp ƒ•ß !ƒ•àß !!ƒ•éŽ qˆÁ=ƒq\n‚‘Ã=ƒ|\f‚‘Å=ƒˆ‚‘Ç=…‘)‚Ÿ\"ã=†Ÿäå!)qˆ†°Ö× $†¾ÖÙ ${)‚Í\"ã=†Íäå!.Ð*˜ƒâÐ ‚ô+„ïì\"ƒôíîïˆ ƒƒð \"ˆ+ƒ¨‰Áñòó\"!JH‰4ƒ-õö4÷H\"ˆ)ñòó\"!JH÷ÐIˆ*Ãñòó\"!JH‰4ƒ^õö4÷H\"ˆ)ñòó\"!JH÷ÐIˆ*…¤Åñòó\"!JH‰4ƒ”õö4÷H\"ˆ)ñòó\"!JH÷ÐI*)‚û ƒNƒN‰Áñòó\"!JH‰4ƒÕõö4÷H\"ˆ)ñòó\"!JH÷ÐIˆ*Ãñòó\"!JH‰4ƒõö4÷H\"ˆ)ñòó\"!JH÷ÐIˆ*ƒMÅñòó\"!JH‰4ƒ<õö4÷H\"ˆ)ñòó\"!JH÷ÐI*ˆ)ø ˆ ƒ÷„÷‰Áñòó\"!JH‰4ƒ~õö4÷H\"ˆ)ñòó\"!JH÷ÐIˆ*Ãñòó\"!JH‰4ƒ¯õö4÷H\"ˆ)ñòó\"!JH÷ÐIˆ*ƒöÅñòó\"!JH‰4ƒåõö4÷H\"ˆ)ñòó\"!JH÷ÐI*ˆ)ù!. ‡" [to-buf-type A ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer to-buf ediff-control-buffer ctrl-buf t saved-p ediff-3way-job three-way nil messg ediff-verbose-p reg-to-delete reg-to-delete-beg reg-to-delete-end ediff-get-diff-posn beg n end reg-to-copy from-buf-type start buf-type StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ediff-disturbed-overlays batch-invocation ediff-test-save-region conds (byte-code "p ƒn !ƒnà!!ƒnÄŽ qˆ ?ƒ*bˆÉÊ!ˆbˆÉ !ˆƒ<ÌÍ!ˆƒSVƒjÏ\"ˆ‚jVƒeÏ\"ˆ‚jÐ!ˆ*‚yÒ=„yÓÔ!ˆ)„‰Ö#‡" [StartBuffer to-buf get-buffer buffer-name ((set-buffer StartBuffer)) buffer-read-only inhibit-read-only ediff-xemacs-p reg-to-delete-end insert-before-markers "@" reg-to-copy delete-char 1 reg-to-delete-beg kill-region ediff-move-disturbed-overlays this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" batch-invocation ediff-save-diff-region n to-buf-type reg-to-delete messg] 4) ((error (byte-code "ÀÁ\n@ÃÄ\nAÅ##ˆÆÇ!ˆÈÉ!ˆÊ ʇ" [message "ediff-copy-diff: %s %s" conds mapconcat prin1-to-string " " beep 1 sit-for 2 nil saved-p] 7))) ediff-set-state-of-diff-in-all-buffers intern format "ediff-difference-vector-%S" diff-record mapcar ediff-delete-overlay 1 ediff-refresh-mode-lines message] 7]) (defalias 'ediff-save-diff-region #[(n buf-type reg) "À \n\"\fÅ=ƒ‚.\fÇ=ƒ‚.\fÉ=ƒ&\n‚.\fË=….\f À A\"‰ƒE¡ˆ‚_ ƒU  BC¤ˆ‚_  BD\nBÐÑ T\fƒmÓ‚qÔ\f!—$+‡" [assoc n ediff-killed-diffs-alist n-th-diff-saved buf-type A ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer buf this-buf-n-th-diff-saved reg message "Saving old diff region #%d of buffer %S. To recover, type `r%s'" ediff-merge-job "" symbol-name] 7]) (defalias 'ediff-test-save-region #[(n buf-type) "À \n\"\fÅ=ƒ‚.\fÇ=ƒ‚.\fÉ=ƒ&\n‚.\fË=….\f À A\"‰ƒQÏÐÑ T\f#!ƒKÒ‚RÓÔ!‚RÒ+‡" [assoc n ediff-killed-diffs-alist n-th-diff-saved buf-type A ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer buf this-buf-n-th-diff-saved yes-or-no-p format "You've previously copied diff region %d to buffer %S. Confirm " t error "Quit"] 6]) #@55 Pop last killed Nth diff region from buffer BUF-TYPE. (defalias 'ediff-pop-diff #[(n buf-type) "À \n\"\fÅ=ƒ‚.\fÇ=ƒ‚.\fÉ=ƒ&\n‚.\fË=….\f À A\"ÓÓÓÓÓAƒ]A‚rÚVƒnÛÜ T\f#ˆ‚rÛÝ!ˆÞ\fß $Þ\fà $Ó!âã䈃 ‰Ååæç\f\"!J H‰(ƒ®éê(ëH\"ˆ)åæç\f\"!J HëÓIˆ* Çåæç\f\"!J H‰(ƒØéê(ëH\"ˆ)åæç\f\"!J HëÓIˆ*ƒ Éåæç\f\"!J H‰(ƒéê(ëH\"ˆ)åæç\f\"!J HëÓI*ˆ)ƒ'ƒ'ì \"ˆí ˆ…;î \"ïð T\f#.\n‡" [assoc n ediff-killed-diffs-alist n-th-record buf-type A ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer buf saved-rec ediff-3way-job three-way ediff-control-buffer ctl-buf nil ediff-verbose-p saved-diff reg-beg reg-end recovered ediff-number-of-differences 0 error "Nothing saved for diff %d in buffer %S" "No differences found" ediff-get-diff-posn beg end ediff-disturbed-overlays conds (byte-code "p ƒq !ƒqà!!ƒqÄŽ qˆ ?ƒ*bˆÉÊ!ˆbˆÉ !ˆƒ<ÌÍ!ˆƒSVƒjÏ\"ˆ‚jVƒeÏ\"ˆ‚jÐ!ˆÑ*‚|Ô=„|ÕÖ!ˆ)‡" [StartBuffer buf get-buffer buffer-name ((set-buffer StartBuffer)) buffer-read-only inhibit-read-only ediff-xemacs-p reg-end insert-before-markers "@" saved-diff delete-char 1 reg-beg kill-region ediff-move-disturbed-overlays t recovered this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 3) ((error (byte-code "ÀÁ\n@ÃÄ\nAÅ##ˆÆÇ!‡" [message "ediff-pop-diff: %s %s" conds mapconcat prin1-to-string " " beep 1] 7))) intern format "ediff-difference-vector-%S" diff-record mapcar ediff-delete-overlay 1 ediff-set-state-of-diff-in-all-buffers ediff-refresh-mode-lines delq message "Diff region %d in buffer %S restored"] 6 (#$ . 43349)]) #@247 Restore ARGth diff from `ediff-killed-diffs-alist'. ARG is a prefix argument. If ARG is nil, restore current-difference. If the second optional argument, a character, is given, use it to determine the target buffer instead of last-command-char (defalias 'ediff-restore-diff #[(arg &optional key) "À\np=„ ÃÄ \"ˆ)ƒÇ!ˆÈ \n†\" Ì>ƒ+Í‚H\n†2 Î>ƒ;Ï‚H\n†B Ð>…HÑ\"ˆÀÓ )‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command arg ediff-jump-to-difference ediff-pop-diff ediff-current-difference key last-command-char (97 65) A (98 66) B (99 67) C ediff-verbose-p ediff-recenter] 4 (#$ . 45042) "P"]) #@112 Toggle between focusing and hiding of difference regions that match a regular expression typed in by the user. (defalias 'ediff-toggle-regexp-match #[nil "À\np=„ ÃÄ \"ˆ)Ɖ‰À‰‰ \n \f Î=ƒ.Ð=„= =ƒHÒ=ƒHÓÔ!ˆÕ‰ ‚[Ò=ƒÓ Ö×Ø\"!\fÖ×Ú\"! ƒsÖ×Ý\"!\nà=ƒ†á âã‚â áàä×å #!ƒ¤Óæ \"ˆ‚®Óæ\"ˆ\fƘ„¹\f Ƙ„Ä \nƘ†[\n‰‚[Ð=…[ Ö×ç(\"!\fÖ×é*\"! ƒþÖ×ë,\"!\n-à=ƒá âã‚â áàä×î #!ƒ/Óï \"ˆ‚9-Óï\"ˆ\fƘ„D\f( Ƙ„O *\nƘ†[\n‰,.‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command "" alt-connective alt-msg-connective msg-connective regexp-C regexp-B regexp-A ediff-skip-diff-region-function ediff-focus-on-regexp-matches-function last-command-char 102 ediff-hide-regexp-matches-function 104 message "Selective browsing by regexp turned off" ediff-show-all-diffs read-string format "Ignore A-regions matching this regexp (default \"%s\"): " ediff-regexp-hide-A "Ignore B-regions matching this regexp (default \"%s\"): " ediff-regexp-hide-B ediff-3way-comparison-job "Ignore C-regions matching this regexp (default \"%s\"): " ediff-regexp-hide-C ediff-hide-regexp-connective and "BOTH" "ONE OF" or y-or-n-p "Ignore regions that match %s regexps, OK? " "Will ignore regions that match %s regexps" "Focus on A-regions matching this regexp (default \"%s\"): " ediff-regexp-focus-A "Focus on B-regions matching this regexp (default \"%s\"): " ediff-regexp-focus-B "Focus on C-regions matching this regexp (default \"%s\"): " ediff-regexp-focus-C ediff-focus-regexp-connective "Focus on regions that match %s regexps, OK? " "Will focus on regions that match %s regexps"] 6 (#$ . 45720) nil]) (defalias 'ediff-toggle-skip-similar #[nil "À\np=„ ÃÄ \"ˆ)Ç=„ÃÈ!ˆ ?‰ ƒ&ÊË!‡ÊÌ!‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-auto-refine on "Can't skip over whitespace regions: first turn auto-refining on" ediff-ignore-similar-regions message "Skipping regions that differ only in white space & line breaks" "Skipping over white-space differences turned off"] 4 nil nil]) #@456 Focus on diffs that match regexp `ediff-regexp-focus-A/B'. Regions to be ignored according to this function are those where buf A region doesn't match `ediff-regexp-focus-A' and buf B region doesn't match `ediff-regexp-focus-B'. This function returns nil if the region number N (specified as an argument) is not to be ignored and t if region N is to be ignored. N is a region number used by Ediff internally. It is 1 less the number seen by the user. (defalias 'ediff-focus-on-regexp-matches #[(n) "‰„ ÂY… W)… \f \n p\f ƒXÎ !ƒXÏÎ !!ƒXÐŽ qˆÑÒÓ $bˆÔÑÒÕ $Ö#)‚bØ=†bÙÚ!)p\fƒšÎ!ƒšÏÎ!!ƒšÝŽqˆÑÞÓ $bˆÔ ÑÞÕ $Ö#)‚¤Ø=†¤ÙÚ!) …ìp\f!ƒáÎ!!ƒáÏÎ!!!ƒáâŽ!qˆÑãÓ $bˆÔ ÑãÕ $Ö#)‚ëØ=†ëÙÚ!)$å ƒ&$F‚&E!.?‡" [n ediff-current-difference 0 ediff-number-of-differences ediff-control-buffer ctl-buf ediff-regexp-focus-A regex-A ediff-regexp-focus-B regex-B ediff-regexp-focus-C regex-C StartBuffer ediff-buffer-A get-buffer buffer-name ((set-buffer StartBuffer)) ediff-get-diff-posn A beg re-search-forward end t this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" reg-A-match ediff-buffer-B ((set-buffer StartBuffer)) B reg-B-match ediff-3way-comparison-job ediff-buffer-C ((set-buffer StartBuffer)) C reg-C-match eval ediff-focus-regexp-connective] 8 (#$ . 47924)]) #@409 Hide diffs that match regexp `ediff-regexp-hide-A/B/C'. Regions to be ignored are those where buf A region matches `ediff-regexp-hide-A' and buf B region matches `ediff-regexp-hide-B'. This function returns nil if the region number N (specified as an argument) is not to be ignored and t if region N is to be ignored. N is a region number used by Ediff internally. It is 1 less the number seen by the user. (defalias 'ediff-hide-regexp-matches #[(n) "‰„ ÂY… W)…\n\f \n p\f ƒXÎ !ƒXÏÎ !!ƒXÐŽ qˆÑÒÓ $bˆÔÑÒÕ $Ö#)‚bØ=†bÙÚ!)p\fƒšÎ!ƒšÏÎ!!ƒšÝŽqˆÑÞÓ $bˆÔ ÑÞÕ $Ö#)‚¤Ø=†¤ÙÚ!) …ìp\f!ƒáÎ!!ƒáÏÎ!!!ƒáâŽ!qˆÑãÓ $bˆÔ ÑãÕ $Ö#)‚ëØ=†ëÙÚ!)$å ƒ&$F‚&E!.‡" [n ediff-current-difference 0 ediff-number-of-differences ediff-control-buffer ctl-buf ediff-regexp-hide-A regex-A ediff-regexp-hide-B regex-B ediff-regexp-hide-C regex-C StartBuffer ediff-buffer-A get-buffer buffer-name ((set-buffer StartBuffer)) ediff-get-diff-posn A beg re-search-forward end t this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" reg-A-match ediff-buffer-B ((set-buffer StartBuffer)) B reg-B-match ediff-3way-comparison-job ediff-buffer-C ((set-buffer StartBuffer)) C reg-C-match eval ediff-hide-regexp-connective] 8 (#$ . 49305)]) #@496 Finish an Ediff session and exit Ediff. Unselects the selected difference, if any, restores the read-only and modified flags of the compared file buffers, kills Ediff buffers for this session (but not buffers A, B, C). If `ediff-keep-variants' is nil, the user will be asked whether the buffers containing the variants should be removed (if they haven't been modified). If it is t, they will be preserved unconditionally. A prefix argument, temporarily reverses the meaning of this variable. (defalias 'ediff-quit #[(reverse-default-keep-variants) "À\np=„ ÃÄ \"ˆ)ÆÇÈ ƒ*Ê !ƒ*ËÊ !!ƒ*Ì‚+Í\"!ÎÍ!ˆ…8Ï!‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command y-or-n-p format "Quit this Ediff session%s? " ediff-meta-buffer get-buffer buffer-name " & show containing session group" "" message ediff-really-quit reverse-default-keep-variants] 6 (#$ . 50631) "P"]) (defalias 'ediff-really-quit #[(reverse-default-keep-variants) "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÅÆÇ\"ˆÅÈÇ\"ˆÅÉÇ\"ˆÅÊÇ\"ˆË ˆ\fƒ3 ‚7Ð ˆÑÒ \"ˆÑÓ\"ˆØÙÚˆØÛ܈ØÝÞˆØßàˆá\"\"\"ã ˆä ˆåæ!ˆ''(ƒ‚'?''„‹éê!ˆ)åë!ˆì!ˆ…®í!…®îí!!…®ï!*‡" [ediff-unhighlight-diffs-totally-in-one-buffer A B C Ancestor ediff-clear-diff-vector ediff-difference-vector-A fine-diffs-also ediff-difference-vector-B ediff-difference-vector-C ediff-difference-vector-Ancestor ediff-delete-temp-files ediff-quit-widened ediff-wide-bounds ediff-visible-bounds ediff-narrow-bounds ediff-visible-region mapcar #[(overl) "À !…  !‡" [ediff-overlayp overl ediff-delete-overlay] 2] #[(overl) "À !…  !‡" [ediff-overlayp overl ediff-delete-overlay] 2] ediff-control-buffer ediff-meta-buffer meta-buffer control-buffer nil (byte-code "p ƒ- !ƒ-à!!ƒ-ÄŽ qˆÅ\"ÈÉ!ˆÈÊ!ˆ)‚8 Ì=„8ÍÎ!ˆ)‡" [StartBuffer ediff-buffer-A get-buffer buffer-name ((set-buffer StartBuffer)) delq control-buffer ediff-this-buffer-ediff-sessions kill-local-variable mode-line-buffer-identification mode-line-format this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 3) ((error)) (byte-code "p ƒ- !ƒ-à!!ƒ-ÄŽ qˆÅ\"ÈÉ!ˆÈÊ!ˆ)‚8 Ì=„8ÍÎ!ˆ)‡" [StartBuffer ediff-buffer-B get-buffer buffer-name ((set-buffer StartBuffer)) delq control-buffer ediff-this-buffer-ediff-sessions kill-local-variable mode-line-buffer-identification mode-line-format this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 3) ((error)) (byte-code "p ƒ- !ƒ-à!!ƒ-ÄŽ qˆÅ\"ÈÉ!ˆÈÊ!ˆ)‚8 Ì=„8ÍÎ!ˆ)‡" [StartBuffer ediff-buffer-C get-buffer buffer-name ((set-buffer StartBuffer)) delq control-buffer ediff-this-buffer-ediff-sessions kill-local-variable mode-line-buffer-identification mode-line-format this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 3) ((error)) (byte-code "p ƒ- !ƒ-à!!ƒ-ÄŽ qˆÅ\"ÈÉ!ˆÈÊ!ˆ)‚8 Ì=„8ÍÎ!ˆ)‡" [StartBuffer ediff-ancestor-buffer get-buffer buffer-name ((set-buffer StartBuffer)) delq control-buffer ediff-this-buffer-ediff-sessions kill-local-variable mode-line-buffer-identification mode-line-format this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 3) ((error)) delq ediff-session-registry ediff-update-registry ediff-restore-protected-variables run-hooks ediff-cleanup-hook ediff-keep-variants reverse-default-keep-variants ediff-janitor ask ediff-quit-hook ediff-cleanup-meta-buffer get-buffer buffer-name ediff-show-meta-buffer] 3]) (defalias 'ediff-delete-temp-files #[nil ";ƒ Á!ˆ\n;ƒÁ\n!ˆ ;…Á !‡" [ediff-temp-file-A delete-file ediff-temp-file-B ediff-temp-file-C] 2]) (defalias 'ediff-cleanup-mess #[nil " \n \f  \n \f‰ ƒ1Î !ƒ1ÏÎ !!ƒ1ÐÎ !!ˆ)‰ ƒQÎ !ƒQÏÎ !!ƒQÐÎ !!ˆ)‰ ƒqÎ !ƒqÏÎ !!ƒqÐÎ !!ˆ)‰ ƒ‘Î !ƒ‘ÏÎ !!ƒ‘ÐÎ !!ˆ)‰ ƒ±Î !ƒ±ÏÎ !!ƒ±ÐÎ !!ˆ)‰ ƒÑÎ !ƒÑÏÎ !!ƒÑÐÎ !!ˆ)‰ ƒñÎ !ƒñÏÎ !!ƒñÐÎ !!ˆ)‰ ƒÎ !ƒÏÎ !!ƒÐÎ !!ˆ)ƒ‚ ÚÛ !ƒBƒ-‚1ÚÛ !Ü>„BÝ!ƒBÞ!ˆ‰ ƒaÎ !ƒaÏÎ !!ƒaÐÎ !!ˆ)ß ˆàáâˆàã䈃yàåæˆçè!.‡" [ediff-buffer-A ediff-buffer-B ediff-buffer-C ediff-control-buffer ediff-control-frame ediff-3way-job three-way-job ctl-frame ctl-buf buff-C buff-B buff-A ediff-diff-buffer buf get-buffer buffer-name kill-buffer ediff-custom-diff-buffer ediff-fine-diff-buffer ediff-tmp-buffer ediff-error-buffer ediff-patch-diagnostics ediff-msg-buffer ediff-debug-buffer ediff-emacs-p window-system device-type selected-device (tty stream) frame-live-p delete-frame delete-other-windows nil (byte-code "À !„\n !ˆÀ‡" [ediff-get-visible-buffer-window buff-B switch-to-buffer] 2) ((error)) (byte-code "À !„À\n!ƒà ˆÄ !ˆÀ‡" [ediff-get-visible-buffer-window buff-A buff-B split-window-vertically switch-to-buffer] 2) ((error)) (byte-code "À !„À\n!„À !ƒÄ ˆÅ !ˆÆ ˆÀ‡" [ediff-get-visible-buffer-window buff-C buff-A buff-B split-window-vertically switch-to-buffer balance-windows] 2) ((error)) message ""] 7]) #@306 Kill buffers A, B, and, possibly, C, if these buffers aren't modified. In merge jobs, buffer C is never deleted. However, the side effect of cleaning up may be that you cannot compare the same buffer in two separate Ediff sessions: quitting one of them will delete this buffer in another session as well. (defalias 'ediff-janitor #[(&optional ask) "ƒFÁ!ƒFÂÁ!!ƒFÃ!„F\fƒ'ÅÆÇÂ!\"!ƒF‰ƒEÁ!ƒEÂÁ!!ƒEÉÁ!!ˆ)\nƒ’Á\n!ƒ’ÂÁ\n!!ƒ’Ã\n!„’\fƒrÅÆËÂ\n!\"!ƒ’\n‰ƒ‘Á!ƒ‘ÂÁ!!ƒ‘ÉÁ!!ˆ)\fƒå …©Á !…©ÂÁ !!?†2à !†2\fƒÅÅÆΠ!\"!?†2 ‰…ãÁ!…ãÂÁ!!…ãÉÁ!!)‡…÷Á!…÷ÂÁ!!?†2Ã!†2\fƒÅÆÐÂ!\"!?†2‰…1Á!…1ÂÁ!!…1ÉÁ!!)‡" [ediff-buffer-A get-buffer buffer-name buffer-modified-p ask y-or-n-p format "Kill buffer A [%s]? " buf kill-buffer ediff-buffer-B "Kill buffer B [%s]? " ediff-merge-job ediff-ancestor-buffer "Kill the ancestor buffer [%s]? " ediff-buffer-C "Kill buffer C [%s]? "] 6 (#$ . 55638)]) (defalias 'ediff-default-suspend-function #[nil "\n\fÆ !Æ !Æ ! \n \f ƒ7‚;ØÙ !ƒ`ƒH‚LØÙ !Ú>„`Û!ƒ`Ý!ˆ‚cÞ ˆƒmÞ!ˆƒwÞ!ˆƒÞ!ˆƒ‹Þ!ˆ ƒ•Þ !ˆ ƒŸÞ !ˆß!ƒ´à!ˆá ˆÞ ˆ‚Ê ƒÊâ !ƒÊãâ !!ƒÊÞ !ˆß!ƒßà!ˆá ˆÞ ˆ‚õ ƒõâ !ƒõãâ !!ƒõÞ !ˆß !ƒ à !ˆá ˆÞ ‚ …â !…ãâ !!…Þ !.\f‡" [ediff-buffer-A buf-A ediff-buffer-B buf-B ediff-buffer-C buf-C ediff-get-visible-buffer-window buf-A-wind buf-B-wind buf-C-wind ediff-patch-buf buf-patch ediff-patch-diagnostics buf-patch-diag ediff-error-buffer buf-err ediff-diff-buffer buf-diff ediff-custom-diff-buffer buf-custom-diff ediff-fine-diff-buffer buf-fine-diff ediff-emacs-p window-system device-type selected-device (tty stream) frame-live-p ediff-control-frame iconify-frame bury-buffer window-live-p select-window delete-other-windows get-buffer buffer-name] 3]) #@178 Suspend Ediff. To resume, switch to the appropriate `Ediff Control Panel' buffer and then type \[ediff-recenter]. Ediff will automatically set up an appropriate window config. (defalias 'ediff-suspend #[nil "À\np=„ ÃÄ \"ˆ)ÆÇ!ˆÈÉ!‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command run-hooks ediff-suspend-hook message "To resume, type M-x eregistry and select the desired Ediff session"] 3 (#$ . 57476) nil]) #@122 Show the names of the buffers or files being operated on by Ediff. Hit \[ediff-recenter] to reset the windows afterward. (defalias 'ediff-status-info #[nil "À\np=„ ÃÄ \"ˆ)ŠÆ ˆ)ÇÈÉ !ˆÈÊ!ˆp \fƒXÍ\f!ƒXÎÍ\f!!ƒXÏŽ\fqˆƒLÈÑÒ\"!ˆ‚TÈÑÓÎ \"!ˆ)‚b Ô=„bÃÕ!ˆ)p ƒÍ!ƒÎÍ!!ƒ×Žqˆƒ‘ÈÑØ\"!ˆ‚™ÈÑÙÎ \"!ˆ)‚§ Ô=„§ÃÕ!ˆ)ƒòp ƒçÍ!ƒçÎÍ!!ƒçÜŽqˆƒÛÈÑÝ\"!ˆ‚ãÈÑÞÎ \"!ˆ)‚ñ Ô=„ñÃÕ!ˆ)ÈÑß ƒÍ !ƒÎÍ !!ƒáÎ !P‚â\"!ˆÈÑã$ƒ8Í$!ƒ8ÎÍ$!!ƒ8áÎ$!P‚9â\"!ˆp \fƒcÍ\f!ƒcÎÍ\f!!ƒcåŽ\fqˆæe`\"T)‚l Ô=†lÃÕ!)'p ƒ–Í!ƒ–ÎÍ!!ƒ–èŽqˆæe`\"T)‚Ÿ Ô=†ŸÃÕ!))À*ÈÑë'\"!ˆÈÑì)\"!ˆƒõp ƒáÍ!ƒáÎÍ!!ƒáíŽqˆæe`\"T)‚ê Ô=†êÃÕ!)*ÈÑî*\"!ˆ+ÈÑï0ñWƒò‚03Yƒô‚0T\"!ˆ5ƒ\"Èö!ˆ‚&È÷!ˆ8ù=ƒ4Èú!ˆ‚r8;=ƒOÈü!ˆÈÑý>?@$!ˆ‚r8A=ƒlÈB!ˆÈÑýCDE$!ˆ‚rÈF!ˆÈÑGHI!\"!‘ˆJK!ƒ’LK!ˆMN!…¡ON!‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-skip-unsuitable-frames " *ediff-info*" princ ediff-version "\n\n" StartBuffer ediff-buffer-A get-buffer buffer-name ((set-buffer StartBuffer)) buffer-file-name format "File A = %S\n" "Buffer A = %S\n" ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff" ediff-buffer-B ((set-buffer StartBuffer)) "File B = %S\n" "Buffer B = %S\n" ediff-3way-job ediff-buffer-C ((set-buffer StartBuffer)) "File C = %S\n" "Buffer C = %S\n" "Customized diff output %s\n" ediff-custom-diff-buffer " in buffer " "is not available" "Plain diff output %s\n" ediff-diff-buffer ((set-buffer StartBuffer)) count-lines A-line ((set-buffer StartBuffer)) B-line C-line "Buffer A's point is on line %d\n" "Buffer B's point is on line %d\n" ((set-buffer StartBuffer)) "Buffer C's point is on line %d\n" "\nCurrent difference number = %S\n" ediff-current-difference 0 start ediff-number-of-differences end ediff-ignore-similar-regions "\nSkipping regions that differ only in white space & line breaks" "\nNot skipping regions that differ in white space & line breaks" ediff-skip-diff-region-function ediff-show-all-diffs "\nSelective browsing by regexp is off.\n" ediff-hide-regexp-matches-function "\nIgnoring regions that match" "\n regexp `%s' in buffer A %S\n regexp `%s' in buffer B\n" ediff-regexp-hide-A ediff-hide-regexp-connective ediff-regexp-hide-B ediff-focus-on-regexp-matches-function "\nFocusing on regions that match" ediff-regexp-focus-A ediff-focus-regexp-connective ediff-regexp-focus-B "\nSelective browsing via a user-defined method.\n" "\nBugs/suggestions: type `%s' while in Ediff Control Panel." substitute-command-keys "\\[ediff-submit-report]" frame-live-p ediff-control-frame ediff-reset-mouse window-live-p ediff-control-window select-window] 7 (#$ . 57954) nil]) #@28 Jump to Ediff's Info file. (defalias 'ediff-documentation #[nil " Ä ˆÅÆÇ*‡" [ediff-control-window ediff-control-buffer ctl-buf ctl-window ediff-skip-unsuitable-frames nil (byte-code "ÀÁÂ!!ˆÃÄ!ˆÅÆ!‡" [pop-to-buffer get-buffer-create "*info*" info "ediff.info" message "Type `i' to search for a specific topic"] 3) ((error (byte-code "ÀÁ!ˆÂÃÄŃǂÈ\"!‘ˆÉ\n!…)Ë\n!ˆÌ\n \"‡" [beep 1 " *ediff-info*" princ format "\nThe Info file for Ediff does not seem to be installed.\n\nThis file is part of the distribution of %sEmacs.\nPlease contact your system administrator. " ediff-xemacs-p "X" "" window-live-p ctl-window select-window set-window-buffer ctl-buf] 5)))] 3 (#$ . 60716) nil]) (defalias 'ediff-select-difference #[(n) "…ÆÁ!…ÆÂÁ!!…Æ …ÆÁ !…ÆÂÁ !!…Æ\f‰„, \fÆY…6\fW)…ƃD ‚HÊË !ƒ€ƒU ‚YÊË !Ì>„€ ƒ€\fÎ\fÏ\"ˆÎ\fÐ\"ˆÎ\fÑ\"ˆÎ\fÒ\"ˆ)Ó‚¿ÕÖÏ\f$ˆÖÐ \f$ˆƒ¡ÖÑ\f$ˆƒ¿Á!ƒ¿ÂÁ!!ƒ¿ÖÒ\f$ˆÛ\f!ˆÜÝ!‡" [ediff-buffer-A get-buffer buffer-name ediff-buffer-B n ediff-current-difference 0 ediff-number-of-differences ediff-emacs-p window-system device-type selected-device (tty stream) ediff-use-faces ediff-highlight-diff-in-one-buffer A B C Ancestor face ediff-highlighting-style ascii ediff-place-flags-in-buffer ediff-control-buffer ediff-3way-job ediff-buffer-C ediff-ancestor-buffer ediff-install-fine-diff-if-necessary run-hooks ediff-select-hook] 6]) (defalias 'ediff-unselect-difference #[(n) "‰„ ÂY… W)…¹\fƒ ‚!ÆÇ !ƒM\fƒ, ‚0ÆÇ !È>„M ƒMÊË!ˆÊÌ!ˆÊÍ!ˆÊÎ!ˆ‚®Ð=ƒ®ÑÓÔÕË\"!JHÂH\"ˆÑÓÔÕÌ\"!JHÂH\"ˆƒ‰ÑÓÔÕÍ\"!JHÂH\"ˆƒ®Ú!ƒ®ÛÚ!!ƒ®ÑÓÔÕÎ\"!JHÂH\"ˆÜÝ Þ\"ˆßà!‡" [n ediff-current-difference 0 ediff-number-of-differences ediff-emacs-p window-system device-type selected-device (tty stream) ediff-use-faces ediff-unhighlight-diff-in-one-buffer A B C Ancestor ediff-highlighting-style ascii ediff-remove-flags-from-buffer ediff-buffer-A intern format "ediff-difference-vector-%S" ediff-buffer-B ediff-3way-job ediff-buffer-C ediff-ancestor-buffer get-buffer buffer-name nil ediff-set-fine-diff-properties default run-hooks ediff-unselect-hook] 7]) (defalias 'ediff-unselect-and-select-difference #[(n &optional flag no-recenter) "\n„\nÃÄ!ˆ) ÇŽÉ=„Ê !ˆË=„&Ì!ˆ‰*‡" [n ediff-current-difference no-recenter ediff-recenter no-rehighlight ediff-control-buffer control-buf ((byte-code "p ƒ  !ƒ à!!ƒ ÄŽ qˆÅ ˆ)‚+Ç=„+ÈÉ!ˆ)‡" [StartBuffer control-buf get-buffer buffer-name ((set-buffer StartBuffer)) ediff-refresh-mode-lines this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 3)) flag select-only ediff-unselect-difference unselect-only ediff-select-difference] 2]) (defalias 'ediff-read-file-name #[(prompt default-dir default-file) "ÀÁ\n† ƒÄ !† !Æ;ƒ,ÉBC\nË!)‚=\fƒ8Ë!‚=ËÍ\"*! ƒHÎ ! ɘƒPÆÆÁÐÑÒ ƒdÔ ÕQ‚eÉ#\n Í …pÄ !%\n\"Ö!ƒ‰ ƒ‰ÁÎ !\")‡" [file-name-as-directory expand-file-name default-dir default-file file-name-directory default-directory nil dir file "" directory-abbrev-alist abbreviate-file-name ediff-emacs-p t file-name-nondirectory f read-file-name format "%s%s: " prompt " (default " ")" file-directory-p] 8]) (defalias 'ediff-make-temp-file #[(buff &optional prefix given-file start end) "†Á\n ƒ ÄP‚ÅP!pƒ]É!ƒ]ÊÉ!!ƒ]ËŽqˆÌ ƒ> ‚?eƒI‚JdÏÐ%ˆÑ\"ˆ)‚gÔ=†gÕÖ!*‡" [given-file make-temp-name ediff-temp-file-prefix prefix "_" "ediff_" f StartBuffer buff get-buffer buffer-name ((set-buffer StartBuffer)) write-region start end nil no-message set-file-modes ediff-temp-file-mode this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 6]) (defalias 'ediff-verify-file-buffer #[(&optional file-magic) "Àp!ƒ3Á …NÂÃÄ ƒÆ‚Ç#!ƒ- „%É ‡Ê ˆË̉\"‡ÍÎ\"‡ÂÃÏ\"!ƒI ƒDÊ ˆË̉\"‡ÍÎ\"‡" [verify-visited-file-modtime buffer-modified-p yes-or-no-p format "Buffer out of sync with visited file. %s file %s? " file-magic "Revert" "Save" buffer-file-name save-buffer erase-buffer revert-buffer t error "Buffer out of sync for file %s" "Buffer out of sync with visited file. Revert file %s? "] 5]) (defalias 'ediff-insert-in-front #[(overl &optional flag beg end length) "À Â\"…\f B‰‡" [ediff-overlay-get overl ediff-diff-num ediff-disturbed-overlays] 3]) (defalias 'ediff-move-disturbed-overlays #[(posn) "ÀÁ\n\"ˆÃ‰‡" [mapcar #[(overl) "À \n à !…\fƒÅ !‚Æ !)#‡" [ediff-move-overlay overl posn ediff-overlayp ediff-emacs-p overlay-end extent-end-position] 5] ediff-disturbed-overlays nil] 3]) #@335 Safe way of saving buffers A, B, C, and the diff output. `wa' saves buffer A, `wb' saves buffer B, `wc' saves buffer C, and `wd' saves the diff output. With prefix argument, `wd' saves plain diff output. Without an argument, it saves customized diff argument, if available (and plain output, if customized output was not generated). (defalias 'ediff-save-buffer #[(arg) "À\np=„ ÃÄ \"ˆ)Æ ˆpÉ>ƒ»Ê>ƒ&Ë‚9Ì>ƒ1Í‚9Î>…9ÏË=ƒC‚ Ê>ƒNË‚aÌ>ƒYÍ‚aÎ>…aÏÍ=ƒk‚ Ê>ƒvË‚‰Ì>ƒÍ‚‰Î>…‰ÏÏ=ƒ“‚ Ê>ƒžË‚±Ì>ƒ©Í‚±Î>…±ÏÓ=ƒ]‚ Õ=ƒ]Ö×!ˆØÙ!ˆƒéƒéÜ!ƒéÝÜ!!ƒé‚ ƒÜ!ƒÝÜ!!ƒ‚ ƒÜ!ƒÝÜ!!ƒ‚ Ãß!ƒ]ÜÉ>ƒËÊ>ƒ6Ë‚IÌ>ƒAÍ‚IÎ>…IÏË=ƒS‚0Ê>ƒ^Ë‚qÌ>ƒiÍ‚qÎ>…qÏÍ=ƒ{‚0Ê>ƒ†Ë‚™Ì>ƒ‘Í‚™Î>…™ÏÏ=ƒ£‚0Ê>ƒ®Ë‚ÁÌ>ƒ¹Í‚ÁÎ>…ÁÏÓ=…0‚0Õ=…0Ö×!ˆØÙ!ˆƒùƒùÜ!ƒùÝÜ!!ƒù‚0ƒÜ!ƒÝÜ!!ƒ‚0ƒ-Ü!ƒ-ÝÜ!!ƒ-‚0Ãß!!ƒ]ÝÜÉ>ƒÝÊ>ƒHË‚[Ì>ƒSÍ‚[Î>…[ÏË=ƒe‚BÊ>ƒpË‚ƒÌ>ƒ{Í‚ƒÎ>…ƒÏÍ=ƒ‚BÊ>ƒ˜Ë‚«Ì>ƒ£Í‚«Î>…«ÏÏ=ƒµ‚BÊ>ƒÀË‚ÓÌ>ƒËÍ‚ÓÎ>…ÓÏÓ=…B‚BÕ=…BÖ×!ˆØÙ!ˆƒ ƒ Ü!ƒ ÝÜ!!ƒ ‚Bƒ%Ü!ƒ%ÝÜ!!ƒ%‚Bƒ?Ü!ƒ?ÝÜ!!ƒ?‚BÃß!!!ƒ]àŽÉ>ƒðÊ>ƒ[Ë‚nÌ>ƒfÍ‚nÎ>…nÏË=ƒx‚UÊ>ƒƒË‚–Ì>ƒŽÍ‚–Î>…–ÏÍ=ƒ ‚UÊ>ƒ«Ë‚¾Ì>ƒ¶Í‚¾Î>…¾ÏÏ=ƒÈ‚UÊ>ƒÓË‚æÌ>ƒÞÍ‚æÎ>…æÏÓ=…U‚UÕ=…UÖ×!ˆØÙ!ˆƒƒÜ!ƒÝÜ!!ƒ‚Uƒ8Ü!ƒ8ÝÜ!!ƒ8‚UƒRÜ!ƒRÝÜ!!ƒR‚UÃß!qˆá )‚f â=†fÃã!)‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-compute-custom-diffs-maybe StartBuffer last-command-char (97 98 99) (97 65) A (98 66) B (99 67) C ediff-buffer-A ediff-buffer-B ediff-buffer-C Ancestor ediff-ancestor-buffer 100 message "Saving diff output ..." sit-for 1 arg ediff-diff-buffer get-buffer buffer-name ediff-custom-diff-buffer "Output from `diff' not found" ((set-buffer StartBuffer)) save-buffer ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff"] 5 (#$ . 65291) "P"]) (defalias 'ediff-compute-custom-diffs-maybe #[nil "†6Á\n!Á !ƒ!Ç!ƒ!ÈÇ!!„)ÉÊËÌ\"!ÍÏ \f&*‡" [ediff-3way-job ediff-make-temp-file ediff-buffer-A ediff-buffer-B file-B file-A ediff-custom-diff-buffer get-buffer buffer-name get-buffer-create ediff-unique-buffer-name "*ediff-custom-diff" "*" ediff-exec-process ediff-custom-diff-program synchronize ediff-custom-diff-options] 7]) (defalias 'ediff-show-diff-output #[(arg) "À\np=„ ÃÄ \"ˆ)Æ ˆŠÇÈ!ˆ) ƒ6\nƒ6Ë\n!ƒ6ÌË\n!!ƒ6\n‚r ƒPË !ƒPÌË !!ƒP ‚r\nƒjË\n!ƒjÌË\n!!ƒj\n‚rÎ ˆÏÐ!ˆÀ‰ƒ²pƒË!ƒÌË!!ƒÓŽqˆebˆ)‚§ Ô=„§ÃÕ!ˆ)Ö!ˆ×Ø !ˆ)Ù!ƒ¿Û!ˆÜ!…ÊÞ!‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-compute-custom-diffs-maybe ediff-skip-unsuitable-frames ok-unsplittable arg ediff-diff-buffer get-buffer buffer-name ediff-custom-diff-buffer beep message "Output from `diff' not found" buf StartBuffer ((set-buffer StartBuffer)) ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff" switch-to-buffer raise-frame selected-frame frame-live-p ediff-control-frame ediff-reset-mouse window-live-p ediff-control-window select-window] 4 nil "P"]) (defalias 'ediff-remove-flags-from-buffer #[(buffer overlay) "p ƒJ !ƒJà!!ƒJÄŽ qˆÅƒ+È ÊË#ˆ‚2È ÌË#ˆƒ@È ÍË#‚FÈ ÎË#*‚TÐ=†TÑÒ!)‡" [StartBuffer buffer get-buffer buffer-name ((set-buffer StartBuffer)) t inhibit-read-only ediff-xemacs-p ediff-overlay-put overlay begin-glyph nil before-string end-glyph after-string this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 4]) (defalias 'ediff-place-flags-in-buffer #[(buf-type buffer ctl-buffer diff) "p ƒ% !ƒ%à!!ƒ%ÄŽ qˆÅ#)‚/ Ê=†/ËÌ!)‡" [StartBuffer buffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-place-flags-in-buffer1 buf-type ctl-buffer diff this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 4]) (defalias 'ediff-place-flags-in-buffer1 #[(buf-type ctl-buffer diff-no) "p ƒ* !ƒ*à!!ƒ*ÄŽ qˆÅÆÇ\"!J HÊH)‚4 Ì=†4ÍÎ!)ÐÑ $ÓÓÓbˆnp ƒÂ !ƒÃ !!ƒ×Ž qˆÙ=…}ƒ{‚})‚‹ Ì=†‹ÍÎ!)ƒžÝÞ#ˆ‚¦Ýß#ˆÐà $‰bˆnp ƒæ !ƒæà!!ƒæᎠqˆÙ=…âƒà\"‚â#)‚ð Ì=†ðÍÎ!)ƒÝä#‚ Ýå#-‡" [StartBuffer ctl-buffer get-buffer buffer-name ((set-buffer StartBuffer)) intern format "ediff-difference-vector-%S" buf-type diff-no 0 this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" curr-overl ediff-get-diff-posn beg before nil after beg-of-line flag ((set-buffer StartBuffer)) ediff-highlighting-style ascii ediff-before-flag-bol ediff-before-flag-mol ediff-xemacs-p ediff-overlay-put begin-glyph before-string end ((set-buffer StartBuffer)) ediff-after-flag-eol ediff-after-flag-mol end-glyph after-string] 6]) #@433 Returns positions of difference sectors in the BUF-TYPE buffer. BUF-TYPE should be a symbol--either `A' or `B'. POS is either `beg' or `end'--it specifies whether you want the position at the beginning of a difference or at the end. The optional argument N says which difference (default: `ediff-current-difference'). The optional argument CONTROL-BUF says which control buffer is in effect in case it is not the current buffer. (defalias 'ediff-get-diff-posn #[(buf-type pos &optional n control-buf) "À\n„pp\nƒbÄ\n!ƒbÅÄ\n!!ƒbÆŽ\nqˆ„*ÉW„9\nYƒP\nÉVƒLËÌT\n#ˆ‚PËÍ!ˆÎÏÐ\"!JHÉH)‚mÓ=„mËÔ!ˆ)Õ !ƒ†ÄÕ !!ƒ†ÅÄÕ !!!„ŠËÖ!ˆØ=ƒ¯ Ú!…«ƒ§Ü!‚«Ý!)‚Ê Ú!…ɃÅÞ!‚Éß!))‡" [nil diff-overlay control-buf StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) n ediff-current-difference 0 ediff-number-of-differences error "There is no diff %d. Valid diffs are 1 to %d" "No differences found" intern format "ediff-difference-vector-%S" buf-type this-command ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff" ediff-overlay-buffer "You have killed an essential Ediff buffer---Please exit Ediff" pos beg overl ediff-overlayp ediff-emacs-p overlay-start extent-start-position overlay-end extent-end-position] 4 (#$ . 70281)]) (defalias 'ediff-highlight-diff-in-one-buffer #[(n buf-type) "Á=ƒ\n\n‚'Ã=ƒ\f‚'Å=ƒ‚'Ç=…Y…YÉÁ=ƒ5\n‚RÃ=ƒ?\f‚RÅ=ƒJ‚RÇ=…R!…YÊÉÁ=ƒb\n‚Ã=ƒl\f‚Å=ƒw‚Ç=…!!…YÁ=ƒŽ\n‚«Ã=ƒ˜\f‚«Å=ƒ£‚«Ç=…« p\f ƒÐÉ !ƒÐÊÉ !!ƒÐÍŽ qˆd)‚ÚÏ=†ÚÐÑ!)ÓÔ#Ó×#šƒùØ‚úÙ\\^ÜÝÞ\"!J ƒ á#ˆ‚+á $ˆâãÙ#ˆâãä ##ˆâå#ˆæÜÝç\"!JHÙHè\".‡" [buf-type A ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer get-buffer buffer-name buff StartBuffer ((set-buffer StartBuffer)) this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" last ediff-get-diff-posn beg n begin end 1 0 xtra end-hilit intern format "ediff-current-diff-overlay-%S" current-diff-overlay ediff-xemacs-p ediff-move-overlay ediff-overlay-put priority ediff-highest-priority ediff-diff-num ediff-set-overlay-face "ediff-difference-vector-%S" nil] 7]) (defalias 'ediff-unhighlight-diff-in-one-buffer #[(buf-type) "Á=ƒ\n\n‚'Ã=ƒ\f‚'Å=ƒ‚'Ç=…ñ…ñÉÁ=ƒ5\n‚RÃ=ƒ?\f‚RÅ=ƒJ‚RÇ=…R!…ñÊÉÁ=ƒb\n‚Ã=ƒl\f‚Å=ƒw‚Ç=…!!…ñËÌÍ\"!JËÌÎ\"!JHÐHÓÔ‰#ˆÕƒ¯‚³ØÙ !…ïƒÀ‚ÄØÙ !Ú>?…ï…ï…ïËÌÞÔ\"Ô=ƒêß‚ëà\"!*\"*‡" [buf-type A ediff-buffer-A B ediff-buffer-B C ediff-buffer-C Ancestor ediff-ancestor-buffer get-buffer buffer-name intern format "ediff-current-diff-overlay-%S" "ediff-difference-vector-%S" ediff-current-difference 0 overlay current-diff-overlay ediff-move-overlay 1 ediff-set-overlay-face ediff-emacs-p window-system device-type selected-device (tty stream) ediff-use-faces ediff-highlight-all-diffs dif-num logand "ediff-even-diff-face-%S" "ediff-odd-diff-face-%S"] 7]) (defalias 'ediff-unhighlight-diffs-totally-in-one-buffer #[(buf-type) "ÀÁ!ˆ\nƒ\f ‚ÄÅ !…O\nƒ ‚ÄÅ !Æ>?…O…OÈ ÊËÌ \"!‰JÐÑ!ˆÒ!ƒJÓ!ˆÔL+‡" [ediff-unselect-and-select-difference -1 ediff-emacs-p window-system device-type selected-device (tty stream) ediff-use-faces t inhibit-quit intern format "ediff-current-diff-overlay-%S" buf-type current-diff-overlay-var current-diff-overlay ediff-color-background-regions unhighlight ediff-overlayp ediff-delete-overlay nil] 5]) (defalias 'ediff-clear-diff-vector #[(vec-var &optional fine-diffs-also) "À J!ƒ Âà J\"ˆ ÄL‡" [vectorp vec-var mapcar #[(elt) "À ÂH!ˆ … ‰…ÅÀ\fÆH\")‡" [ediff-delete-overlay elt 0 fine-diffs-also diff-record mapcar 1] 5] nil] 3]) (defalias 'ediff-color-background-regions #[(&optional unhighlight) "ÀÁ\n\"ˆÀÃ\n\"ˆÀÄ\n\"ˆÀÅ\n\"‡" [ediff-color-background-regions-in-one-buffer A unhighlight B C Ancestor] 3]) (defalias 'ediff-color-background-regions-in-one-buffer #[(buf-type unhighlight) "ÀÁÂÃ\f\"!!ʼnÉÊ\"+‡" [eval intern format "ediff-difference-vector-%S" buf-type nil diff-num overl diff-vector mapcar #[(rec) "ÁHÃ\nÄ\"Æ\n?….  ÊËÌ Í\"Í=ƒ(΂)Ï\"!*\"‡" [rec 0 overl ediff-overlay-get ediff-diff-num diff-num ediff-set-overlay-face unhighlight buf-type dif-num intern format logand 1 "ediff-even-diff-face-%S" "ediff-odd-diff-face-%S"] 7]] 5]) #@135 Calls `move-overlay' in Emacs and `set-extent-endpoints' in Lemacs. Checks if overlay's buffer exists before actually doing the move. (defalias 'ediff-move-overlay #[(overlay beg end &optional buffer) "…Á!‰ƒ4Ã\n!ƒ4ÄÃ\n!!ƒ4 ƒ(Æ#‚;É\n$‚;…;Ë!)‡" [overlay ediff-overlay-buffer buf get-buffer buffer-name ediff-xemacs-p set-extent-endpoints beg end move-overlay buffer ediff-delete-overlay] 6 (#$ . 74695)]) #@109 Calls `overlay-put' or `set-extent-property' depending on Emacs version. Checks if overlay's buffer exists. (defalias 'ediff-overlay-put #[(overlay prop value) "À !ƒ,ÂÀ !!ƒ,ÃÂÀ !!!ƒ,\fƒ$Å #‡È #‡É !‡" [ediff-overlay-buffer overlay get-buffer buffer-name ediff-xemacs-p set-extent-property prop value overlay-put ediff-delete-overlay] 4 (#$ . 75130)]) (defalias 'ediff-make-bullet-proof-overlay #[(beg end buff) "…‘Á!…‘ÂÁ!!…‘Ãpƒ†Á!ƒ†ÂÁ!!ƒ†ÆŽqˆÇ!„:É!Ç\n!„GÉ\n!\nË\n#\fƒiÍ\fÎÃ#ˆÍ\fÏÃ#ˆÍ\fÐÃ#ˆ‚{Í\fÑÃ#ˆÍ\fÒÓ#ˆÍ\fÔÓ#ˆÍ\fÕÖ#ˆ\f)‚Ø=†ÙÚ!*‡" [buff get-buffer buffer-name nil overl StartBuffer ((set-buffer StartBuffer)) number-or-marker-p beg eval end ediff-make-overlay ediff-xemacs-p ediff-overlay-put detachable start-open end-open evaporate rear-sticky t front-sticky ediff-diff-num 0 this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 4]) (defalias 'ediff-overlay-start #[(overl) "À !…\nƒà !‡Ä !‡" [ediff-overlayp overl ediff-emacs-p overlay-start extent-start-position] 2]) (put (quote ediff-overlay-start) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-overlay-end #[(overl) "À !…\nƒà !‡Ä !‡" [ediff-overlayp overl ediff-emacs-p overlay-end extent-end-position] 2]) (put (quote ediff-overlay-end) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-other-buffer #[(buff) "<„CÁ ÃÄ\n\"ÆÇ \"Ç ƒ$@‚:ÆÇÃÊ\n\"\"‰ ƒ7 @‚:Ëp!,‡" [buff buffer-list frame-buffers mapcar #[(x) "À !\nƒ\nÃ‡Ä !„ÇÅÆÀ !\"ƒÇ ‡" [buffer-name x buff nil ediff-get-visible-buffer-window string-match "^ "] 4] significant-buffers delq nil buffers less-significant-buffers #[(x) "À !\nƒ\nÇÄÅÀ !\"ƒÇ ‡" [buffer-name x buff nil string-match "^[ *]"] 4] other-buffer] 5]) (defalias 'ediff-unique-buffer-name #[(prefix suffix) "À \nP!„\f \nP‡ÃÀÅÆ \f\n$!ƒ\fT‚ÅÆ \f\n$)‡" [get-buffer prefix suffix 2 n format "%s<%d>%s"] 6]) (defalias 'ediff-split-string #[(string) "ÀÁ‰ÅÆ\f#ƒ0ÅÆ\f#\fO‰GÀVƒ)\n BÀ•)‚\fÁO‰GÀVƒA\n B Ÿ+‡" [0 nil substr result start string-match "[ ]+" string match] 5]) #@29 Submit bug report on Ediff. (defalias 'ediff-submit-report #[nil "À\np=„ ÃÄ \"ˆ)Æ\nƒ‚ÉÊ !À‰‰ \f Ñ Ò\fÓ ˆÔ ˆÕ!ˆ× ˆØ ˆÙcˆÚÛ!ƒ}ƒfÜ!ƒfËÜ!!ƒfqˆË  ÝÞ!ˆßàá  ÀØ\f&‚Ìâ ˆãä!ˆåæ!ˆ…ÌÜ!…ÌËÜ!!…Ìp'ƒÂÜ!ƒÂËÜ!!ƒÂèŽqˆéê!)‚Ë ë=†ËÃì!).‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command t ediff-emacs-p window-system device-type selected-device buffer-name salutation varlist ediff-device-type ctl-buf reporter-prompt-for-summary-p (ediff-diff-program ediff-diff-options ediff-patch-program ediff-patch-options ediff-shell ediff-use-faces ediff-auto-refine ediff-highlighting-style ediff-buffer-A ediff-buffer-B ediff-control-buffer ediff-forward-word-function ediff-control-frame ediff-control-frame-parameters ediff-control-frame-position-function ediff-prefer-iconified-control-frame ediff-window-setup-function ediff-split-window-function ediff-job-name ediff-word-mode buffer-name ediff-device-type) "\nCongratulations! You may have unearthed a bug in Ediff!\n\nPlease make a concise and accurate summary of what happened\nand mail it to the address above.\n-----------------------------------------------------------\n" ediff-skip-unsuitable-frames ediff-reset-mouse switch-to-buffer ediff-msg-buffer erase-buffer delete-other-windows "\nPlease read this first:\n----------------------\n\nSome ``bugs'' may actually be no bugs at all. For instance, if you are\nreporting that certain difference regions are not matched as you think they\nshould, this is most likely due to the way Unix diff program decides what\nconstitutes a difference region. Ediff is an Emacs interface to diff, and\nit has nothing to do with those decisions---it only takes the output from\ndiff and presents it in a way that is better suited for human browsing and\nmanipulation.\n\nIf Emacs happens to dump core, this is NOT an Ediff problem---it is\nan Emacs bug. Report this to Emacs maintainers.\n\nAnother popular topic for reports is compilation messages. Because Ediff\ninterfaces to several other packages and runs under Emacs and XEmacs,\nbyte-compilation may produce output like this:\n\n While compiling toplevel forms in file ediff.el:\n ** reference to free variable pm-color-alist\n ........................\n While compiling the end of the data:\n ** The following functions are not known to be defined: \n ediff-valid-color-p, ediff-set-face,\n ........................\n\nThese are NOT errors, but inevitable warnings, which ought to be ignored.\n\nPlease do not report those and similar things. However, comments and\nsuggestions are always welcome.\n\nMail anyway? (y or n) " y-or-n-p "Mail anyway? " get-buffer require reporter reporter-submit-bug-report "kifer@cs.sunysb.edu" ediff-version bury-buffer beep 1 message "Bug report aborted" StartBuffer ((set-buffer StartBuffer)) ediff-recenter no-rehighlight ediff-quit "You've killed an essential Ediff buffer---Please quit Ediff"] 7 (#$ . 77294) nil]) (defalias 'ediff-deactivate-mark #[nil "ƒÁ ‡\n…ÃÅÆ!‡" [ediff-xemacs-p zmacs-deactivate-region transient-mark-mode nil mark-active run-hooks deactivate-mark-hook] 2]) (byte-code "ÀÁ!ƒ ÂÁMˆ‚ÂÃMˆÀ‡" [fboundp nuke-selective-display ediff-nuke-selective-display #[nil "ŠŒ~ˆebˆÀ Á‰Å=ƒ7ÇÈÁÅ#ƒ7Áˆ`ÉyˆÇÈ\nÅ#ƒÊË!ˆÌcˆ‚%Í\f!ˆÁ‰-‡" [buffer-modified-p nil end buffer-read-only mod-p t selective-display search-forward " " 0 delete-char -1 "\n" set-buffer-modified-p] 4]] 2) (defalias 'ediff-save-variables #[(vars) "ÀÁ\n\"‡" [mapcar #[(v) "‰JB‡" [v] 2] vars] 3]) (put (quote ediff-save-variables) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'ediff-restore-variables #[(vars assoc-list) "…@Á@\n\"ALˆA‰„Ç" [vars assoc assoc-list nil] 5]) (defalias 'ediff-change-saved-variable #[(var value buf-type) "ÀÁ !P!JÅ\f\"‰…¡*‡" [intern "ediff-buffer-values-orig-" symbol-name buf-type assoc-list assoc var assoc-elt value] 5]) (defalias 'ediff-save-protected-variables #[nil "p ƒ% !ƒ%à!!ƒ%ÄŽ qˆ ÇÈ\"*‚/ Ê=†/ËÌ!) pƒ[Â!ƒ[ÃÂ!!ƒ[ÏŽqˆ ÇÈ\"*‚e Ê=†eËÌ!)ƒ£pƒ–Â!ƒ–ÃÂ!!ƒ–ÓŽqˆ ÇÈ\"*‚  Ê=† ËÌ!)…ïÂ!…ïÃÂ!!…ïpƒáÂ!ƒáÃÂ!!ƒáÖŽqˆ ÇÈ\"*‚ë Ê=†ëËÌ!)‰‡" [StartBuffer ediff-buffer-A get-buffer buffer-name ((set-buffer StartBuffer)) ediff-protected-variables vars mapcar #[(v) "‰JB‡" [v] 2] this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ediff-buffer-values-orig-A ediff-buffer-B ((set-buffer StartBuffer)) ediff-buffer-values-orig-B ediff-3way-comparison-job ediff-buffer-C ((set-buffer StartBuffer)) ediff-buffer-values-orig-C ediff-ancestor-buffer ((set-buffer StartBuffer)) ediff-buffer-values-orig-Ancestor] 3]) (defalias 'ediff-restore-protected-variables #[nil " \n p ƒ3Ê !ƒ3ËÊ !!ƒ3ÌŽ qˆÍ\"ˆ)‚>Ð=„>ÑÒ!ˆ)pƒhÊ!ƒhËÊ!!ƒhÔŽqˆÍ\"ˆ)‚sÐ=„sÑÒ!ˆ)ƒ­pƒ¡Ê!ƒ¡ËÊ!!ƒ¡×ŽqˆÍ \"ˆ)‚¬Ð=„¬ÑÒ!ˆ)…ôÊ!…ôËÊ!!…ôpƒéÊ!ƒéËÊ!!ƒéÙŽqˆÍ\f\")‚óÐ=†óÑÒ!),‡" [ediff-buffer-values-orig-A ediff-buffer-values-orig-B ediff-buffer-values-orig-C ediff-buffer-values-orig-Ancestor values-Ancestor values-C values-B values-A StartBuffer ediff-buffer-A get-buffer buffer-name ((set-buffer StartBuffer)) ediff-restore-variables ediff-protected-variables this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ediff-buffer-B ((set-buffer StartBuffer)) ediff-3way-comparison-job ediff-buffer-C ((set-buffer StartBuffer)) ediff-ancestor-buffer ((set-buffer StartBuffer))] 4]) #@2  (defvar ediff-command-begin-time (quote (0 0 0)) (#$ . 82953)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-command-begin-time put permanent-local t] 4) (defalias 'ediff-calc-command-time #[nil "À Á‰Å\f8Å8YƒÅ\f8Å8Z‚'Å\f8ÇÅ8Z\\\fA@A@ZÈš†=ÉÊ\n #+‡" [current-time nil sec micro end 2 ediff-command-begin-time 1000000 (0 0 0) message "Elapsed time: %d second(s) + %d microsecond(s)"] 4]) (defalias 'ediff-save-time #[nil "À ‰‡" [current-time ediff-command-begin-time] 2]) (put (quote ediff-save-time) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@34 Toggle profiling Ediff commands. (defalias 'ediff-profile #[nil "À\np=„ ÃÄ \"ˆ)ƒÇÈ!ˆƒ É‚!ʃ*È‚+Ë\f Ïš„KÐ Ñ\"ˆÐ\fÒ\"ˆÓÔÕ!‚[Ö Ñ×#ˆÖ\fÒ\"ˆÔØ!*‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-emacs-p make-local-variable post-command-hook pre-command-hook local-pre-command-hook local-post-command-hook post-hook pre-hook ediff-command-begin-time (0 0 0) remove-hook ediff-save-time ediff-calc-command-time (0 0 0) message "Ediff profiling disabled" add-hook t "Ediff profiling enabled"] 4 (#$ . 83549) nil]) (defalias 'ediff-print-diff-vector #[(diff-vector-var) "ÀÁ \"!ˆÄÅÆ !\"‡" [princ format "\n*** %S ***\n" diff-vector-var mapcar #[(overl-vec) "ÀÁÂÃ\fÅHÆ\"T\fÅH\fÇHGÅUƒÈ‚!ÉÊ\fÇHË#\fÌH\fÍH\fÎH&!‡" [princ format "Diff %d: Overlay: %S\n Fine diffs: %s\n No-fine-diff-flag: %S\n State-of-diff: %S\n State-of-merge: %S\n" ediff-overlay-get overl-vec 0 ediff-diff-num 1 "none\n" mapconcat prin1-to-string "\n " 2 3 4] 10] eval] 4]) (defalias 'ediff-debug-info #[nil "À\np=„ ÃÄ \"ˆ)ÇÈÉ\n\"!ˆÊËÌ!!ˆÊËÍ!!ˆÊËÎ!!ˆÊËÏ!!‘‡" [nil meta-buf ediff-control-buffer error "%S: This command runs in Ediff Control Buffer only!" this-command ediff-debug-buffer princ format "\nCtl buffer: %S\n" ediff-print-diff-vector intern "ediff-difference-vector-A" "ediff-difference-vector-B" "ediff-difference-vector-C" "ediff-difference-vector-Ancestor"] 5 nil nil]) (byte-code "ÀÁ!ˆÂÃ!‡" [run-hooks ediff-load-hook provide ediff-util] 2) emacs-19.30/lisp/ediff-wind.elc100666 75424 12 64221 6047400345 14671 0ustar kwzhstaff;ELC ;;; compiled by simon@mole.gnu.ai.mit.edu on Mon Nov 6 07:34:00 1995 ;;; from file /home/gp2/simon/Emacs/lisp/ediff-wind.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`ediff-wind.el' was compiled for Emacs 19.29 or later")) (require (quote ediff-init)) #@995 *Function called to set up windows. Ediff provides a choice of two functions: ediff-setup-windows-plain, for doing everything in one frame, and ediff-setup-windows-multiframe, which sets the control panel in a separate frame. Also, if the latter function detects that one of the buffers A/B is seen in some other frame, it will try to keep that buffer in that frame. If you don't like the two functions provided---write your own one. The basic guidelines: 1. It should leave the control buffer current and the control window selected. 2. It should set ediff-window-A, ediff-window-B, ediff-window-C, and ediff-control-window to contain window objects that display the corresponding buffers. 3. It should accept the following arguments: buffer-A, buffer-B, buffer-C, control-buffer Buffer C may not be used in jobs that compare only two buffers. If you plan to do something fancy, take a close look at how the two provided functions are written. (defvar ediff-window-setup-function (byte-code "ƒ ‚\fÂà !ƒ\"ƒ ‚Âà !Ä>„\"ŇƇ" [ediff-emacs-p window-system device-type selected-device (tty stream) ediff-setup-windows-multiframe ediff-setup-windows-plain] 2) (#$ . -514)) #@2  (defvar ediff-multiframe nil (#$ . 1746)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-multiframe put permanent-local t] 4) #@2  (defvar ediff-merge-window-share .45 (#$ . 1889)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-merge-window-share put permanent-local t] 4) #@2  (defvar ediff-control-window nil (#$ . 2048)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-control-window put permanent-local t] 4) #@2  (defvar ediff-window-A nil (#$ . 2199)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-window-A put permanent-local t] 4) #@2  (defvar ediff-window-B nil (#$ . 2338)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-window-B put permanent-local t] 4) #@2  (defvar ediff-window-C nil (#$ . 2477)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-window-C put permanent-local t] 4) #@2  (defvar ediff-window-config-saved "" (#$ . 2616)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-window-config-saved put permanent-local t] 4) #@407 *The function used to split the main window between buffer-A and buffer-B. You can set it to a horizontal split instead of the default vertical split by setting this variable to `split-window-horizontally'. You can also have your own function to do fancy splits. This variable has no effect when buffer-A/B are shown in different frames. In this case, Ediff will use those frames to display these buffers. (defvar ediff-split-window-function (quote split-window-vertically) (#$ . -2778)) #@407 *The function used to split the main window between buffer-A and buffer-B. You can set it to a vertical split instead of the default horizontal split by setting this variable to `split-window-vertically'. You can also have your own function to do fancy splits. This variable has no effect when buffer-A/B/C are shown in different frames. In this case, Ediff will use those frames to display these buffers. (defvar ediff-merge-split-window-function (quote split-window-horizontally) (#$ . -3273)) #@126 Frame parameters for displaying Ediff Control Panel. Do not specify width and height here. These are computed automatically. (defconst ediff-control-frame-parameters (byte-code "ƒ ‚\fÂà !…Jƒ ‚Âà !Ä>?…JÅÆÇÈÉÊËÌÍÎÏÐ!ƒ7Ð T‚8ÑBÒÏÓ!ƒFÓ T‚GÑB¯ ‡" [ediff-emacs-p window-system device-type selected-device (tty stream) (name . "Ediff") (minibuffer) (user-position . t) (vertical-scroll-bars) (scrollbar-width . 0) (menu-bar-lines . 0) (visibility) (auto-lower) (auto-raise . t) top fboundp ediff-display-pixel-height 3000 left ediff-display-pixel-width] 13) (#$ . 3776)) #@2  (defvar ediff-mouse-pixel-position nil (#$ . 4359)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-mouse-pixel-position put permanent-local t] 4) #@97 If the user moves mouse more than this many pixels, Ediff won't warp mouse into control window. (defvar ediff-mouse-pixel-threshhold 30 (#$ . 4523)) #@231 *If t, Ediff will always grab the mouse and put it in the control frame. If 'maybe, Ediff will do it sometimes, but not after operations that require relatively long time. If nil, the mouse will be entirely user's responsibility. (defvar ediff-grab-mouse t (#$ . -4679)) #@256 Function to call to determine the desired location for the control panel. Expects three parameters: the control buffer, the desired width and height of the control frame. It returns an association list of the form ((top . ) (left . )) (defvar ediff-control-frame-position-function (quote ediff-make-frame-position) (#$ . 4957)) #@248 *The upward shift of control frame from the top of buffer A's frame. Measured in pixels. This is used by the default control frame positioning function, `ediff-make-frame-position'. This variable is provided for easy customization of the default. (defvar ediff-control-frame-upward-shift (byte-code "ƒÁ‡Â‡" [ediff-xemacs-p 42 14] 1) (#$ . -5312)) #@331 *The leftward shift of control frame from the right edge of buf A's frame. Measured in characters. This is used by the default control frame positioning function, `ediff-make-frame-position' to adjust the position of the control frame when it shows the short menu. This variable is provided for easy customization of the default. (defvar ediff-narrow-control-frame-leftward-shift (byte-code "ƒÁ‡Â‡" [ediff-xemacs-p 7 3] 1) (#$ . -5669)) #@330 *The rightward shift of control frame from the left edge of buf A's frame. Measured in characters. This is used by the default control frame positioning function, `ediff-make-frame-position' to adjust the position of the control frame when it shows the full menu. This variable is provided for easy customization of the default. (defvar ediff-wide-control-frame-rightward-shift 7 (#$ . -6116)) #@2  (defvar ediff-wide-display-p nil (#$ . 6515)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-wide-display-p put permanent-local t] 4) #@85 Frame parameters to be restored when the user wants to toggle the wide display off. (defvar ediff-wide-display-orig-parameters nil (#$ . 6667)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-wide-display-orig-parameters put permanent-local t] 4) #@36 Frame to be used for wide display. (defvar ediff-wide-display-frame nil (#$ . 6930)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-wide-display-frame put permanent-local t] 4) #@372 The value is a function that is called to create a wide display. The function is called without arguments. It should resize the frame in which buffers A, B, and C are to be displayed, and it should save the old frame parameters in `ediff-wide-display-orig-parameters'. The variable `ediff-wide-display-frame' should be set to contain the frame used for the wide display. (defvar ediff-make-wide-display-function (quote ediff-make-wide-display) (#$ . 7125)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-make-wide-display-function put permanent-local t] 4) #@2  (defvar ediff-control-frame nil (#$ . 7698)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local ediff-control-frame put permanent-local t] 4) #@433 *If t, keep control panel iconified when help message is off. This has effect only on a windowing system. If t, hiting `?' to toggle control panel off iconifies it. This is only useful in Emacs and only for certain kinds of window managers, such as TWM and its derivatives, since the window manager must permit keyboard input to go into icons. XEmacs completely ignores keyboard input into icons, regardless of the window manager. (defvar ediff-prefer-iconified-control-frame nil (#$ . -7849)) (defalias 'ediff-get-window-by-clicking #[(wind prev-wind wind-number) "ÀÂÃ\f\"ˆÅ ‰ƒÇ !‚ ÈÉÊËÌ !\"\")„6ÍÎ!ƒ.ÏÎ!ˆÂÐ\f\"ˆ‚Å ˆƒDÑ !‚O ‰A@)‰@)‰)‡" [nil event message "Select windows by clicking. Please click on Window %d " wind-number ediff-read-event ediff-xemacs-p button-event-p string-match "mouse" format "%S" event-basic-type sit-for 1 beep "Please click on Window %d " event-window position wind] 7]) (defalias 'ediff-select-lowest-window #[nil "ƒ Á !‡Ã Å AAA@ŠÇÈ!ˆÃ ) Ê  …[Ì  Å !AAA@WƒC Á !ˆ  =ƒWÁ\f!ˆÏ *‚!,‡" [ediff-xemacs-p select-window frame-lowest-window selected-window lowest-window window-edges bottom-edge other-window -1 last-window t window-search next-window this-window next-bottom-edge nil] 2]) (defalias 'ediff-setup-windows #[(buffer-A buffer-B buffer-C control-buffer) "ÀÁ!ˆÂ à =ƒÄÅ!ˆÆ „ÇÉ\n!„Xp \nƒCÌ\n!ƒCÍÌ\n!!ƒCÎŽ\nqˆ)‚MÐ=†MÑÒ!)\n$ˆÀÖ!‡" [run-hooks ediff-before-setup-windows-hook selected-window minibuffer-window other-window 1 ediff-window-display-p ediff-setup-windows-plain ediff-window-setup-function ediff-keep-window-config control-buffer StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" buffer-A buffer-B buffer-C ediff-after-setup-windows-hook] 5]) (defalias 'ediff-setup-windows-plain #[(buffer-A buffer-B buffer-C control-buffer) "p ƒ  !ƒ à!!ƒ ÄŽ qˆÅ)‚+È=„+ÉÊ!ˆ) ƒ;Ì  $‡Ð  $‡" [StartBuffer control-buffer get-buffer buffer-name ((set-buffer StartBuffer)) nil ediff-multiframe this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ediff-merge-job ediff-setup-windows-plain-merge buffer-A buffer-B buffer-C ediff-setup-windows-plain-compare] 5]) (defalias 'ediff-setup-windows-plain-merge #[(buf-A buf-B buf-C control-buffer) "À !ˆÂɉ‰‰‰ \np ƒ=Ì !ƒ=ÍÌ !!ƒ=ÎŽ qˆ )‚HÒ=„HÓÔ!ˆ)Õ ˆÖ ˆ× ˆØ !ˆÙÚ!ˆÂÛÜ _!]Ý!ˆß ÖÂÜ Z]!ˆß =ƒ„ÙÚ!ˆß Ý !ˆá!ˆ ˆß =ƒ¡ÙÚ!ˆÝ\"!ˆß p ƒÑÌ !ƒÑÍÌ !!ƒÑ㎠qˆ$ %\f&)‚ÜÒ=„ÜÓÔ!ˆ)× ˆØ !.‡" [ediff-destroy-control-frame control-buffer 2 nil wind-C wind-B wind-A merge-window-lines merge-window-share split-window-function window-min-height StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-merge-window-share ediff-split-window-function this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" delete-other-windows split-window-vertically ediff-select-lowest-window ediff-setup-control-buffer other-window 1 round window-height switch-to-buffer buf-A selected-window buf-C select-window buf-B ((set-buffer StartBuffer)) ediff-window-A ediff-window-B ediff-window-C] 7]) (defalias 'ediff-setup-windows-plain-compare #[(buf-A buf-B buf-C control-buffer) "À !ˆÂɉ‰‰‰‰‰ \n \fp ƒ‚Î !ƒ‚ÏÎ !!ƒ‚ÐŽ qˆ@Ó!…SƒOÕ!‚SÖ!)A@Ó!…sƒoÕ!‚sÖ!)  )‚Ú=„ÛÜ!ˆ)Ý ˆÞ ˆß ˆà !ˆáâ!ˆã$!ˆå  ƒÃ Þ=ƒ»æ!‚¿ç!è¥\n \n!ˆå =ƒÕáâ!ˆã)!ˆå  ƒù ˆå =ƒñáâ!ˆã*!ˆå p ƒ!Î !ƒ!ÏÎ !!ƒ!ëŽ qˆ, -\f.)‚,Ú=„,ÛÜ!ˆ)/ƒ?ð\"ˆð \"ˆß ˆà !. ‡" [ediff-destroy-control-frame control-buffer 2 nil wind-C wind-B wind-A wind-B-start wind-A-start three-way-comparison wind-width-or-height split-window-function window-min-height StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-narrow-bounds overl ediff-overlayp ediff-emacs-p overlay-start extent-start-position ediff-split-window-function ediff-3way-comparison-job this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" delete-other-windows split-window-vertically ediff-select-lowest-window ediff-setup-control-buffer other-window 1 switch-to-buffer buf-A selected-window window-height window-width 3 buf-B buf-C ((set-buffer StartBuffer)) ediff-window-A ediff-window-B ediff-window-C ediff-windows-job set-window-start] 9]) (defalias 'ediff-setup-windows-multiframe #[(buf-A buf-B buf-C control-buf) "p ƒ  !ƒ à!!ƒ ÄŽ qˆÅ)‚+È=„+ÉÊ!ˆ) ƒ;Ì  $‡Ð  $‡" [StartBuffer control-buf get-buffer buffer-name ((set-buffer StartBuffer)) t ediff-multiframe this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ediff-merge-job ediff-setup-windows-multiframe-merge buf-A buf-B buf-C ediff-setup-windows-multiframe-compare] 5]) (defalias 'ediff-setup-windows-multiframe-merge #[(buf-A buf-B buf-C control-buf) "ÀÁ!ˆÂÄ !Ä!Ä !\n… Ë!\f…+Ë! \n…6Ë\n!pƒ\\Ñ!ƒ\\ÒÑ!!ƒ\\ÓŽqˆ)‚fÖ=†f×Ø!)pƒÑ!ƒÒÑ!!ƒÚŽqˆ)‚—Ö=†—×Ø!)Ý ß  †Þ\f†° =†Þ †½ =†Þá\f!?†Þá !?†Þ\f =…Þá!?‰\"?…ê\f =#pƒÑ!ƒÒÑ!!ƒäŽqˆ%)‚Ö=†×Ø!)&ç(ç)ç*ç+ç,í!ƒP\"„P#„Pî!ˆï ˆð !ˆÝ ñ*í!ƒp\"„pî!ˆï ˆð!ˆÝ ñ+í\n!ƒ\"„î\n!ˆï ˆð !ˆÝ \nñ,#ƒÄò\f!ˆð !ˆï ˆÝ  ˆÝ =ƒµóô!ˆð!ˆÝ ñ*ñ+\"ƒpß Â5À ˆ5ß =„çççç\nÝ ƒôî!ˆ‚ƒî!ˆ‚\nƒî\n!ˆ‚î!ˆï ˆÂö÷ &_!](ð !ˆÝ øÂ÷ (Z]!ˆÝ =ƒ?óô!ˆÝ \nð !ˆî!ˆ ˆÝ =ƒ]óô!ˆð!ˆÝ ñ*ñ+ñ,**„…î!ˆï ˆð !ˆÝ +„›î!ˆï ˆð!ˆÝ ,„±î!ˆï ˆð !ˆÝ \npƒíÑ!ƒíÒÑ!!ƒíùŽqˆ:;\n<Ë:!\fËý\f!!))‚øÖ=„ø×Ø!ˆ)þ)\".‡" [ediff-skip-unsuitable-frames ok-unsplittable 2 window-min-height ediff-get-visible-buffer-window buf-A wind-A buf-B wind-B buf-C wind-C window-frame frame-A frame-B frame-C StartBuffer control-buf get-buffer buffer-name ((set-buffer StartBuffer)) ediff-wide-display-p this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" force-one-frame ((set-buffer StartBuffer)) ediff-split-window-function split-window-function selected-window orig-wind selected-frame orig-frame frame-live-p use-same-frame use-same-frame-for-AB ((set-buffer StartBuffer)) ediff-merge-window-share merge-window-share nil merge-window-lines designated-minibuffer-frame done-A done-B done-C window-live-p select-window delete-other-windows switch-to-buffer t select-frame other-window 1 curr-frame round window-height split-window-vertically ((set-buffer StartBuffer)) ediff-window-A ediff-window-B ediff-window-C minibuffer-window ediff-setup-control-frame] 5]) (defalias 'ediff-setup-windows-multiframe-compare #[(buf-A buf-B buf-C control-buf) "ÀÁ!ˆÂÄ !Ä!Ä !\n… Ë!\f…+Ë! \n…6Ë\n!pƒ^Ñ!ƒ^ÒÑ!!ƒ^ÓŽqˆÔ!)‚h×=†hØÙ!)pƒÑ!ƒÒÑ!!ƒÛŽqˆ)‚™×=†™ØÙ!)pƒÀÑ!ƒÀÒÑ!!ƒÀÞŽqˆ)‚Ê×=†ÊØÙ!) pƒñÑ!ƒñÒÑ!!ƒñáŽqˆ\")‚û×=†ûØÙ!)#ä %†b\f =†b#ƒ<\f=†b =†bÔ\f!?†bÔ !?†bÔ!?†bÔ !„P†b\fæ =†bÔ\f!?…b†b æ ='è)è*è+è,è-è.pƒ×Ñ!ƒ×ÒÑ!!ƒ×ïŽqˆ0@1ò1!…°3ƒ¬ô1!‚°õ1!))0A@1ò1!…Ð3ƒÌô1!‚Ðõ1!)*)‚â×=„âØÙ!ˆ)ö!ƒ'„÷!ˆø ˆù !ˆä ú,ö!ƒ\"'„\"÷!ˆø ˆù!ˆä ú-ö\n!ƒB'„B÷\n!ˆø ˆù !ˆä \nú.'ƒæ è;<À ˆ<æ =„fèèè\nä %ƒs÷!ˆ‚’ƒ€÷!ˆ‚’\nƒ÷\n!ˆ‚’÷%!ˆø ˆù !ˆä #ƒº ý=ƒ°þ!‚´ÿ!@¥; ;!ˆä =ƒÐAB!ˆù!ˆä #ƒþ ˆä D>ƒõAB!ˆù !ˆä \nú,ú-ú.*,„÷%!ˆø ˆù !ˆä -„3÷%!ˆø ˆù!ˆä #ƒN.„N÷%!ˆø ˆù !ˆä \npƒŽÑ!ƒŽÒÑ!!ƒŽCŽqˆDE\nFËD!\fËG\f!!+)‚™×=„™ØÙ!ˆ)Hƒ±I)\"ˆI*\"ˆJ+\".‡" [ediff-skip-unsuitable-frames ok-unsplittable 2 window-min-height ediff-get-visible-buffer-window buf-A wind-A buf-B wind-B buf-C wind-C window-frame frame-A frame-B frame-C StartBuffer control-buf get-buffer buffer-name ((set-buffer StartBuffer)) frame-live-p ediff-control-frame this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ctl-frame-exists-p ((set-buffer StartBuffer)) ediff-wide-display-p force-one-frame ((set-buffer StartBuffer)) ediff-split-window-function split-window-function ((set-buffer StartBuffer)) ediff-3way-comparison-job three-way-comparison selected-window orig-wind selected-frame use-same-frame nil wind-A-start wind-B-start designated-minibuffer-frame done-A done-B done-C ((set-buffer StartBuffer)) ediff-narrow-bounds overl ediff-overlayp ediff-emacs-p overlay-start extent-start-position window-live-p select-window delete-other-windows switch-to-buffer t wind-width-or-height curr-frame split-window-vertically window-height window-width 3 other-window 1 ((set-buffer StartBuffer)) ediff-window-A ediff-window-B ediff-window-C minibuffer-window ediff-windows-job set-window-start ediff-setup-control-frame] 3]) (defalias 'ediff-skip-unsuitable-frames #[(&optional ok-unsplittable) "ƒ ‚\fÂà !…¨ƒ ‚Âà !Ä>?…¨ÅÇ =„šÈÇ !„‰É \nƒ? ‚CÂà !…qƒN ‚RÂà !Ë>?…qÌ\n!…q ƒkÎ\n!‚qÏ\n!Ð=)„‰„šÉ \nÒÓ\n!žA)ƒš„’Ç ÔÕÖ\"ˆ‚$Ç =…§×ØÙ!!)‡" [ediff-emacs-p window-system device-type selected-device (tty stream) nil last-window selected-window window-dedicated-p selected-frame frame (tty stream) frame-live-p ediff-xemacs-p frame-iconified-p frame-visible-p icon ok-unsplittable unsplittable frame-parameters other-window 1 t select-frame make-frame ((unsplittable))] 3]) (defalias 'ediff-setup-control-frame #[(ctl-buffer designated-minibuffer-frame) "ÀÁ‰‰‰‰‰‰‰‰‰ \n \fp ƒLÏ!ƒLÐÏ!!ƒLÑŽqˆƒDÓÁ!ˆÔÕ!ˆ)‚W×=„WØÙ!ˆ)p ƒ|Ï!ƒ|ÐÏ!!ƒ|ÚŽqˆ)‚†×=††ØÙ!)Ü!ƒ•Ý!ˆp ƒÄÏ!ƒÄÐÏ!!ƒÄÞŽqˆ á\"!‰*‚Ï×=„ÏØÙ!ˆ)#$ƒÞ%‚âæç !…$ƒï%‚óæç !è>?…Ü#!…ƒ\fé#!‚ê#!ë=) ì!ˆíî !„)ï ˆð!ˆp ƒWÏ!ƒWÐÏ!!ƒWñŽqˆòó!ˆòô!ˆòõ!ˆ)‚b×=„bØÙ!ˆ)ö!ˆ78˜?\nù=…y\n ƒ‰úed\"À\\‚Žúed\"T‰û À\\üýþ Bÿ\fBE@ \f#\"Aƒ´B\nBƒíCDED\"ˆCFED\"ˆCGED\"ˆCHED\"ˆIJ=ƒþK\n\"ˆebˆK\n\"ˆì!ˆL ˆMƒ, „,\n„,N!ˆ‚= „6 „=O!ˆƒNPî \"ˆ‚XQî R\"ˆSTUV!ˆê!„…TEVƒ…TSTUW!ˆ‚e)X!„YZR=?\"ˆƒãp ƒ×Ï!ƒ×ÐÏ!!ƒ×[Žqˆò\\!ˆ]\\^\"ˆ)‚â×=„âØÙ!ˆ)p ƒ\fÏ!ƒ\fÐÏ!!ƒ\f_ŽqˆÔ`!)‚×=†ØÙ!.\f‡" [2 nil adjusted-parameters fwidth fheight user-grabbed-mouse lines old-ctl-frame ctl-frame deiconify-ctl-frame dont-iconify-ctl-frame ctl-frame-iconified-p window-min-height StartBuffer ctl-buffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-xemacs-p set-buffer-menubar run-hooks ediff-before-setup-control-frame-hook this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ((set-buffer StartBuffer)) ediff-control-frame frame-live-p delete-frame ((set-buffer StartBuffer)) designated-minibuffer-frame default-minibuffer-frame make-frame ediff-control-frame-parameters frame ediff-emacs-p window-system device-type selected-device (tty stream) frame-iconified-p frame-visible-p icon select-frame window-dedicated-p selected-window delete-other-windows switch-to-buffer ((set-buffer StartBuffer)) make-local-variable frame-title-format frame-icon-title-format icon-title-format ediff-setup-control-buffer ediff-help-message ediff-brief-help-message ediff-toggle-help count-lines ediff-help-message-line-length append (visibility . t) width height ediff-control-frame-position-function ediff-prefer-long-help-message (auto-raise) set-specifier top-toolbar-height 0 bottom-toolbar-height left-toolbar-width right-toolbar-width system-type emx modify-frame-parameters ediff-refresh-control-frame ediff-prefer-iconified-control-frame iconify-frame raise-frame set-window-buffer-dedicated set-window-dedicated-p t 7 count sit-for .1 .3 ediff-frame-iconified-p ediff-reset-mouse ediff-grab-mouse ((set-buffer StartBuffer)) select-frame-hook add-hook ediff-xemacs-select-frame-hook ((set-buffer StartBuffer)) ediff-after-setup-control-frame-hook] 12]) (defalias 'ediff-destroy-control-frame #[(ctl-buffer) "p ƒ] !ƒ]à!!ƒ]ÄŽ qˆ ƒ\"‚&ÇÈ !ƒY ƒ2‚6ÇÈ !É>„YÊ !ƒY \f ƒPÎ!ˆÐ Ñ\f!ˆ))‚hÓ=„hÔÕ!ˆ)Ö ‡" [StartBuffer ctl-buffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-emacs-p window-system device-type selected-device (tty stream) frame-live-p ediff-control-frame ctl-frame ediff-xemacs-p set-buffer-menubar default-menubar nil delete-frame this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ediff-skip-unsuitable-frames] 3]) (defalias 'ediff-make-frame-position #[(ctl-buffer ctl-frame-width ctl-frame-height) "p ƒ9 !ƒ9à!!ƒ9ÄŽ qˆÅ!È! ÊËÌ \"A! ÊËÎ \"A!Ð!ÔÔÔÔ‰\\Ú_ ZZƒƒß!Ð!¥‚…à!)!\\_‚Ѓ¦ß!Ð!¥‚ªà!)_ƒÁß!Ð!¥‚Åà!)\"#\\\\_Z\\ä]ä]å &‰\\ƒüç!è!¥‚é!)_Z^ê \"ƒ!ß!Ð!¥‚%à!)_Z^ÌBÎ. BD‚C+ì=†Cíî!)‡" [StartBuffer ctl-buffer get-buffer buffer-name ((set-buffer StartBuffer)) window-frame ediff-window-A frame-A frame-parameters frame-A-parameters eval assoc top frame-A-top left frame-A-left frame-width frame-A-width ediff-control-frame ctl-frame nil horizontal-adjustment upward-adjustment ctl-frame-top ctl-frame-left ediff-control-buffer-number -14 ediff-control-frame-upward-shift ediff-prefer-long-help-message frame ediff-xemacs-p frame-pixel-width frame-char-width ediff-wide-control-frame-rightward-shift ctl-frame-width ediff-narrow-control-frame-leftward-shift 1 ediff-display-pixel-height ctl-frame-height frame-pixel-height frame-height frame-char-height ediff-display-pixel-width this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 6]) (defalias 'ediff-xemacs-select-frame-hook #[nil "À š…\n?…à !‡" [selected-frame ediff-control-frame ediff-prefer-long-help-message raise-frame] 2]) #@326 Construct an alist of parameters for the wide display. Saves the old frame parameters in `ediff-wide-display-orig-parameters'. The frame to be resized is kept in `ediff-wide-display-frame'. This function modifies only the left margin and the width of the display. It assumes that it is called from within the control buffer. (defalias 'ediff-make-wide-display #[nil "ÀÁ!„\nÂÃ!ˆÄ !Ç! \nƒ*Ë !Ì !¥‚.Í !)Á ¥ÏZÑÒÓÔÑ\"A!]BÕÔÕ\"ABDØÑBÕBD\",‡" [fboundp ediff-display-pixel-width error "Can't determine display width." window-frame ediff-window-A frame-A frame-parameters frame-A-params frame ediff-xemacs-p frame-pixel-width frame-width frame-char-width cw 5 wd left 0 eval assoc width ediff-wide-display-orig-parameters ediff-wide-display-frame modify-frame-parameters] 6 (#$ . 21982)]) (defalias 'ediff-refresh-mode-lines #[nil "À‰‰‰À‰ÇY… W)ƒô …<Ê !…<ËÊ !!…<ÌÍÎÏ\"!JHÐH…IHÇH …kÊ !…kËÊ !!…kÌÍÎÒ\"!JHÐH …Ê !…ËÊ !!…ÌÍÎÓ\"!JHÐH\fƒ™ÍÔ\f\"‚šÕ ƒ¦ÍÔ \"‚§Õ ƒïÊ !ƒïËÊ !!ƒï\n„Å ƒïÍÖ\n†ÌÕ ƒÖ× P‚×ÕƒêHØHƒêÙ‚ëÕ$‚ðÕ‚úÕÕÕƒ‚ÜÝ !ƒ/ƒ‚ÜÝ !Þ>„/ƒ/ !šƒ/â‚0ã$åE&ƒ@‚DÜÝ !ƒmƒQ‚UÜÝ !Þ>„mƒm !šƒmçè!‚oé $ê ˆƒ~‚‚ÜÝ !ƒ¢ƒ‚“ÜÝ !ë>„¢ì-!ƒ¢î ˆp/0ƒßÊ0!ƒßËÊ0!!ƒßñŽ0qˆ\f2&@óƒÑô&8&õò&E&ê ˆ)‚ê6÷=„êøù!ˆ)p/:ƒ(Ê:!ƒ(ËÊ:!!ƒ(ûŽ:qˆ 2&@óƒô&8&üò&E&ê ˆ)‚36÷=„3øù!ˆ)=ƒ‚p/ ƒvÊ !ƒvËÊ !!ƒvþŽ qˆ\n2&@óƒhô&8&ÿò&E&ê ˆ)‚6÷=„øù!ˆ)@… Ê@!… ËÊ@!!… p/@ƒþÊ@!ƒþËÊ@!!ƒþAŽ@qˆ&@óƒÅô&8&B ;„ÑÕ‚ôCD \"ƒâE‚ôCF \"ƒóG‚ôÕ&E‰&)‚6÷=†øù!),‡" [nil buf-C-state-merge buf-C-state-diff buf-B-state-diff buf-A-state-diff n ediff-current-difference 0 ediff-number-of-differences ediff-buffer-C get-buffer buffer-name intern format "ediff-difference-vector-%S" C 3 ediff-state-of-merge A B "[%s] " "" "[%s%s%s] " " " 1 " AncestorEmpty" ediff-emacs-p window-system device-type selected-device (tty stream) ediff-multiframe ediff-help-message ediff-brief-message-string " " "-- " mode-line-buffer-identification " Howdy!" mode-line-format ediff-make-narrow-control-buffer-id skip-name ediff-make-wide-control-buffer-id force-mode-line-update (tty stream) frame-live-p ediff-control-frame ediff-refresh-control-frame StartBuffer ediff-buffer-A ((set-buffer StartBuffer)) ediff-diff-status (" A: " " B: " " C: " " Ancestor: ") 2 " A: " this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ediff-buffer-B ((set-buffer StartBuffer)) " B: " ediff-3way-job ((set-buffer StartBuffer)) " C: " ediff-ancestor-buffer ((set-buffer StartBuffer)) " Ancestor: " string-match "prefer-A" "[=diff(B)] " "prefer-B" "[=diff(A)] "] 7]) (defalias 'ediff-refresh-control-frame #[nil "À À À \fƒÅÇÀ BC\"‡ÅÈ\"‡" [ediff-make-narrow-control-buffer-id frame-title-format frame-icon-title-format icon-title-format ediff-emacs-p modify-frame-parameters ediff-control-frame name (nil)] 4]) (defalias 'ediff-make-narrow-control-buffer-id #[(&optional skip-name) "ƒÁ‚ÂÃ\f\"A PÇWƒÈÉ\n\"‚6\nYƒ.ÈË\n\"‚6ÈÌT\n#P‡" [skip-name " " assoc name ediff-control-frame-parameters ediff-control-buffer-suffix ediff-current-difference 0 format " _/%d" ediff-number-of-differences " $/%d" " %d/%d"] 5]) (defalias 'ediff-make-wide-control-buffer-id #[nil "ÁWƒ\fÂÃ\f\"C‡\fYƒÂÅ\f\"C‡ÂÆT\f#C‡" [ediff-current-difference 0 format "%%b At start of %d diffs" ediff-number-of-differences "%%b At end of %d diffs" "%%b diff %d of %d"] 4]) (defalias 'ediff-get-visible-buffer-window #[(buff) "…Á!…ÂÁ!!… ƒÄÅ\"‡ÄÆ\"‡" [buff get-buffer buffer-name ediff-xemacs-p get-buffer-window t visible] 3]) (defalias 'ediff-keep-window-config #[(control-buf) "p=…YÁ ÂU?…YpƒNÄ!ƒNÅÄ!!ƒNÆŽqˆ \n \f  Ð!…nƒL‚PÓÔ !…dƒ]‚aÓÔ !Õ>??†nÖ×!!)…J\fÐ!…©ƒ‡‚‹ÓÔ !…Ÿƒ˜‚œÓÔ !Õ>??†©Ö×!!)…Jƒí Ð!…éƒÇ‚ËÓÔ !…߃؂ÜÓÔ !Õ>??†éÖ×!!)…JÙ !=…JÙ\f!=…JƒÙ !=…JÞß \f  ƒ(‚,ÓÔ !…Eƒ9‚=ÓÔ !á>?…E\"#&˜-‚X$å=†Xæç!)‡" [control-buf buffer-size 0 StartBuffer get-buffer buffer-name ((set-buffer StartBuffer)) ediff-control-window ediff-window-A ediff-window-B ediff-window-C C-wind B-wind A-wind ctl-wind wind window-live-p ediff-emacs-p window-system device-type selected-device (tty stream) frame-visible-p window-frame ediff-3way-job window-buffer ediff-buffer-A ediff-buffer-B ediff-buffer-C ediff-window-config-saved format "%S%S%S%S%S%S%S" ediff-split-window-function (tty stream) ediff-multiframe ediff-wide-display-p this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 10]) (provide (quote ediff-wind)) emacs-19.30/lisp/ediff.elc100666 75424 1 76674 6054603236 14071 0ustar kwzhdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 22 06:16:06 1995 ;;; from file /home/fsf/rms/e19/lisp/ediff.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`ediff.el' was compiled for Emacs 19.29 or later")) #@30 The current version of Ediff (defconst ediff-version "2.47" (#$ . 468)) #@21 Date of last update (defconst ediff-date "October 11, 1995" (#$ . 546)) (byte-code "ÀÁ!ˆÀÂ!‡" [require ediff-init ediff-mult] 2) #@73 *If t, Ediff uses previous directory as default when reading file name. (defvar ediff-use-last-dir nil (#$ . -681)) #@53 Last directory used by an Ediff command for file-A. (defvar ediff-last-dir-A nil (#$ . 803)) #@53 Last directory used by an Ediff command for file-B. (defvar ediff-last-dir-B nil (#$ . 902)) #@53 Last directory used by an Ediff command for file-C. (defvar ediff-last-dir-C nil (#$ . 1001)) #@64 Last directory used by an Ediff command for the ancestor file. (defvar ediff-last-dir-ancestor nil (#$ . 1101)) #@60 Last directory used by an Ediff command for file to patch. (defvar ediff-last-dir-patch nil (#$ . 1219)) #@49 Default backup extension for the patch program. (defvar ediff-backup-extension (byte-code "Á>ƒ‡Ç" [system-type (vax-vms axp-vms emx ms-dos windows-nt windows-95) "_orig" ".orig"] 2) (#$ . 1330)) #@38 Run Ediff by patching FILE-TP-PATCH. (defalias 'ediff-patch-file #[(source-filename &optional startup-hooks job-name) "À ! Ä=ƒ@pÆ !ƒ2ÇÆ !!ƒ2ÈÇÆ !!!ƒ2ÉŽÆ !qˆ\n)‚< Ì=†<ÍÎ!)‚CÏ !!ˆÑÒ\"ƒTÓ•‚UÓÑÔ\"ƒbÓ•‚cÓO  ÚÚÚÚߘƒ‡ áØÜâã$ˆä!ä !š?å!‰&;…¹ç&!…¹è&!?…¹ç&éP!)ƒÂê!ˆp+ƒúÇ+!ƒúÈÇ+!!ƒúìŽ+qˆíî!ˆïedðñ2À!%ó$ˆ)‚ Ì=„ÍÎ!ˆ)ô+!ˆõÓ!ˆçP!„Íö!ˆ„]pƒNÇ!ƒNÈÇ!!ƒN÷Žqˆø P!ˆùÚ!ˆ)‚Y Ì=„YÍÎ!ˆ)‚ä !:ûÄÅ\f\"ˆÇÌÁ Î=ƒ:Ï‚;ÐÉ$ˆÑ \n\n \f Ò BC&+‡" [nil buf-C buf-B buf-A message "Reading file %s ... " file-A ediff-find-file ediff-last-dir-A startup-hooks file-B ediff-last-dir-B file-C job-name ediff-merge-files-with-ancestor ediff-last-dir-ancestor ediff-last-dir-C ediff-setup ediff-job-name] 10]) (defalias (quote ediff) (quote ediff-files)) #@56 Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B. (defalias 'ediff-buffers #[(buffer-A buffer-B &optional startup-hooks job-name) "„Á \fÅ%‡" [job-name ediff-buffers ediff-buffers-internal buffer-A buffer-B nil startup-hooks] 6 (#$ . 7750) (let (bf) (list (setq bf (read-buffer "Buffer A to compare: " (ediff-other-buffer "") t)) (read-buffer "Buffer B to compare: " (progn (save-window-excursion (other-window 1)) (ediff-other-buffer bf)) t)))]) #@63 Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C. (defalias 'ediff-buffers3 #[(buffer-A buffer-B buffer-C &optional startup-hooks job-name) "„Á \f %‡" [job-name ediff-buffers3 ediff-buffers-internal buffer-A buffer-B buffer-C startup-hooks] 6 (#$ . 8215) (let (bf bff) (list (setq bf (read-buffer "Buffer A to compare: " (ediff-other-buffer "") t)) (setq bff (read-buffer "Buffer B to compare: " (progn (save-window-excursion (other-window 1)) (ediff-other-buffer bf)) t)) (read-buffer "Buffer C to compare: " (progn (save-window-excursion (other-window 1)) (ediff-other-buffer (list bf bff))) t)))]) (defalias 'ediff-buffers-internal #[(buf-A buf-B buf-C startup-hooks job-name) "ÀÁ\n!!ÀÁ\f!!…Á!…ÇÁ!!‰…)ÀÁ\f!! Ê Ê\fÊ \nƒFÁ\n!ƒFÇÁ\n!!„KÎÏ\n\"ˆ\fƒ]Á\f!ƒ]ÇÁ\f!!„bÎÏ\f\"ˆƒv„vÎÏ\"ˆ) ;ƒ€Ó ! ;ƒ‰Ó ! ;ƒ•Ó ! Ô\n \" Ô\f \"\fƒ®Ô \" ÕÁ\n! Á\f!\f…ÂÁ! ÖÊ× D×\fDØÙ D× DE¯BÑBC&.‡" [buffer-file-name get-buffer buf-A buf-A-file-name buf-B buf-B-file-name buf-C buffer-name buf-C-is-alive buf-C-file-name nil file-A file-B file-C error "Buffer %S doesn't exist" job-name ediff-job-name ediff-3way-comparison-job file-name-nondirectory ediff-make-temp-file ediff-setup lambda delete-file if stringp startup-hooks] 16]) (defalias 'ediff-get-default-directory-name #[nil "ƒ ‡\nÃ=ƒ'ÄÅÆ\"‰;ƒ#È!ƒ#‚% )‡ ‡" [ediff-use-last-dir ediff-last-dir-A major-mode dired-mode dired-get-filename nil noerror f file-directory-p default-directory] 4]) #@190 Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have the same name in both. The third argument, REGEXP, is a regular expression that further filters the file names. (defalias 'ediff-directories #[(dir1 dir2 regexp) "À \nÃ\fÅÆ&‡" [ediff-directories-internal dir1 dir2 nil regexp ediff-files ediff-directories] 7 (#$ . 9745) (let ((dir-A (ediff-get-default-directory-name)) f) (list (setq f (ediff-read-file-name "Directory A to compare" dir-A nil)) (ediff-read-file-name "Directory B to compare" (if ediff-use-last-dir ediff-last-dir-B (ediff-strip-last-dir f)) nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history)))]) (defalias (quote edirs) (quote ediff-directories)) #@228 Run Ediff on a directory, DIR1, comparing its files with their revisions. The second argument, REGEXP, is a regular expression that filters the file names. Only the files that are under revision control are taken into account. (defalias 'ediff-directory-revisions #[(dir1 regexp) "À \nÃÄ$‡" [ediff-directory-revisions-internal dir1 regexp ediff-revision ediff-directory-revisions] 5 (#$ . 10485) (let ((dir-A (ediff-get-default-directory-name))) (list (ediff-read-file-name "Directory to compare with revision" dir-A nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history)))]) (defalias (quote edir-revisions) (quote ediff-directory-revisions)) #@197 Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that have the same name in all three. The last argument, REGEXP, is a regular expression that further filters the file names. (defalias 'ediff-directories3 #[(dir1 dir2 dir3 regexp) "À \n \fÅÆ&‡" [ediff-directories-internal dir1 dir2 dir3 regexp ediff-files3 ediff-directories3] 7 (#$ . 11173) (let ((dir-A (ediff-get-default-directory-name)) f) (list (setq f (ediff-read-file-name "Directory A to compare" dir-A nil)) (setq f (ediff-read-file-name "Directory B to compare" (if ediff-use-last-dir ediff-last-dir-B (ediff-strip-last-dir f)) nil)) (ediff-read-file-name "Directory C to compare" (if ediff-use-last-dir ediff-last-dir-C (ediff-strip-last-dir f)) nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history)))]) (defalias (quote edirs3) (quote ediff-directories3)) #@188 Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have the same name in both. The third argument, REGEXP, is a regular expression that further filters the file names. (defalias 'ediff-merge-directories #[(dir1 dir2 regexp) "À \nÃ\fÅÆ&‡" [ediff-directories-internal dir1 dir2 nil regexp ediff-merge-files ediff-merge-directories] 7 (#$ . 12059) (let ((dir-A (ediff-get-default-directory-name)) f) (list (setq f (ediff-read-file-name "Directory A to merge" dir-A nil)) (ediff-read-file-name "Directory B to merge" (if ediff-use-last-dir ediff-last-dir-B (ediff-strip-last-dir f)) nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history)))]) (defalias (quote edirs-merge) (quote ediff-merge-directories)) #@188 Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have the same name in both. The third argument, REGEXP, is a regular expression that further filters the file names. (defalias 'ediff-merge-directories-with-ancestor #[(dir1 dir2 dir3 regexp) "À \n \fÅÆ&‡" [ediff-directories-internal dir1 dir2 dir3 regexp ediff-merge-files-with-ancestor ediff-merge-directories-with-ancestor] 7 (#$ . 12824) (let ((dir-A (ediff-get-default-directory-name)) f) (list (setq f (ediff-read-file-name "Directory A to merge" dir-A nil)) (setq f (ediff-read-file-name "Directory B to merge" (if ediff-use-last-dir ediff-last-dir-B (ediff-strip-last-dir f)) nil)) (ediff-read-file-name "Ancestor directory: " (if ediff-use-last-dir ediff-last-dir-C (ediff-strip-last-dir f)) nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history)))]) #@226 Run Ediff on a directory, DIR1, merging its files with their revisions. The second argument, REGEXP, is a regular expression that filters the file names. Only the files that are under revision control are taken into account. (defalias 'ediff-merge-directory-revisions #[(dir1 regexp) "À \nÃÄ$‡" [ediff-directory-revisions-internal dir1 regexp ediff-merge-revisions ediff-merge-directory-revisions] 5 (#$ . 13699) (let ((dir-A (ediff-get-default-directory-name))) (list (ediff-read-file-name "Directory to merge with revisions" dir-A nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history)))]) (defalias (quote edir-merge-revisions) (quote ediff-merge-directory-revisions)) #@240 Run Ediff on a directory, DIR1, merging its files with their revisions and ancestors. The second argument, REGEXP, is a regular expression that filters the file names. Only the files that are under revision control are taken into account. (defalias 'ediff-merge-directory-revisions-with-ancestor #[(dir1 regexp) "À \nÃÄ$‡" [ediff-directory-revisions-internal dir1 regexp ediff-merge-revisions-with-ancestor ediff-merge-directory-revisions-with-ancestor] 5 (#$ . 14415) (let ((dir-A (ediff-get-default-directory-name))) (list (ediff-read-file-name "Directory to merge with revisions and ancestors" dir-A nil) (read-string "Filter through regular expression: " nil ediff-filtering-regexp-history)))]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias edir-merge-revisions-with-ancestor ediff-merge-directory-revisions-with-ancestor edirs-merge-with-ancestor ediff-merge-directories-with-ancestor] 3) (defalias 'ediff-directories-internal #[(dir1 dir2 dir3 regexp action jobname &optional startup-hooks) "À !ƒ\n ‚  !À !ƒ ‚ !\f;ƒ/À\f!ƒ+\f‚.Â\f! ˜ƒ=ÅÆ \"ˆ‚dÈ=ƒR \f˜ƒRÅÉ \"ˆ‚dÈ=ƒd \f˜ƒdÅÊ \"ˆË‰‰\f ÏÎ \f& ÑËÒÓÔDEÒÖÔDEFBØÙ ÚÛ&\fÜ\f!+‡" [file-directory-p dir1 file-name-directory dir2 dir3 error "Directories A and B are the same: %s" jobname ediff-directories3 "Directories A and C are the same: %s" "Directories B and C are the same: %s" nil meta-buf file-list diffs ediff-intersect-directories regexp lambda setq ediff-session-action-function quote action ediff-dir-difference-list startup-hooks ediff-prepare-meta-buffer ediff-dir-action "*Ediff Session Group Panel" ediff-redraw-directory-group-buffer ediff-show-meta-buffer] 7]) (defalias 'ediff-directory-revisions-internal #[(dir1 regexp action jobname &optional startup-hooks) "À !ƒ\n ‚  !ÉÆ #ÉÃÊËÌ DEEBÏÐ ÑÒ&Ó\f!*‡" [file-directory-p dir1 file-name-directory nil meta-buf file-list ediff-get-directory-files-under-revision jobname regexp lambda setq ediff-session-action-function quote action startup-hooks ediff-prepare-meta-buffer ediff-dir-action "*Ediff Session Group Panel" ediff-redraw-directory-group-buffer ediff-show-meta-buffer] 7]) #@236 Compare WIND-A and WIND-B, which are selected by clicking, wordwise. With prefix argument, DUMB-MODE, or on a non-windowing display, works as follows: If WIND-A is nil, use selected window. If WIND-B is nil, use window next to WIND-A. (defalias 'ediff-windows-wordwise #[(dumb-mode &optional wind-A wind-B startup-hooks) "À \n \fÅÆ&‡" [ediff-windows dumb-mode wind-A wind-B startup-hooks ediff-windows-wordwise word-mode] 7 (#$ . 16579) "P"]) #@236 Compare WIND-A and WIND-B, which are selected by clicking, linewise. With prefix argument, DUMB-MODE, or on a non-windowing display, works as follows: If WIND-A is nil, use selected window. If WIND-B is nil, use window next to WIND-A. (defalias 'ediff-windows-linewise #[(dumb-mode &optional wind-A wind-B startup-hooks) "À \n \fÅÆ&‡" [ediff-windows dumb-mode wind-A wind-B startup-hooks ediff-windows-linewise nil] 7 (#$ . 17030) "P"]) (defalias 'ediff-windows #[(dumb-mode wind-A wind-B startup-hooks job-name word-mode) "„$ ƒ\f\n‚ÃÄ !ƒ$ ƒ\n‚ÃÄ !Å>ƒlÇ Ê !†Cƒ>Ë !‚@Ì ‰ *  Ê !†fƒaË !‚cÌ ‰ * ‚}ÎÇÏ#Î Ð# Ñ!Ñ !lj‰‰ŠØ‹ˆ)Ù& .‡" [dumb-mode ediff-emacs-p window-system device-type selected-device (tty stream) wind-A nil prev-wind wind window-live-p next-window selected-window wind-B ediff-get-window-by-clicking 1 2 window-buffer end-B beg-B end-A beg-A buffer-B buffer-A ((byte-code "ÀÁ!ˆÂ !ˆÄ Æ Â!ˆÄ  Æ \nÀ‡" [sit-for 0 select-window wind-A window-start beg-A window-end end-A wind-B beg-B end-B] 2)) ediff-regions-internal startup-hooks job-name word-mode] 10]) #@251 Run Ediff on a pair of regions in two different buffers. Regions (i.e., point and mark) are assumed to be set in advance. This function is effective only for relatively small regions, up to 200 lines. For large regions, use `ediff-regions-linewise'. (defalias 'ediff-regions-wordwise #[(buffer-A buffer-B &optional startup-hooks) "ƒÁ!ƒÂÁ!!„ÃÄ\"ˆ ƒ)Á !ƒ)ÂÁ !!„.ÃÄ \"ˆÆ‰‰‰ \nŠqˆË \nÌ  qˆË Ì )ÍÁ!\n Á !ÏÐ& ,‡" [buffer-A get-buffer buffer-name error "Buffer %S doesn't exist" buffer-B nil reg-B-end reg-B-beg reg-A-end reg-A-beg region-beginning region-end ediff-regions-internal startup-hooks ediff-regions-wordwise word-mode] 10 (#$ . 18189) (let (bf) (list (setq bf (read-buffer "Region's A buffer: " (ediff-other-buffer "") t)) (read-buffer "Region's B buffer: " (progn (save-window-excursion (other-window 1)) (ediff-other-buffer bf)) t)))]) #@285 Run Ediff on a pair of regions in two different buffers. Regions (i.e., point and mark) are assumed to be set in advance. Each region is enlarged to contain full lines. This function is effective for large regions, over 100-200 lines. For small regions, use `ediff-regions-wordwise'. (defalias 'ediff-regions-linewise #[(buffer-A buffer-B &optional startup-hooks) "ƒÁ!ƒÂÁ!!„ÃÄ\"ˆ ƒ)Á !ƒ)ÂÁ !!„.ÃÄ \"ˆÆ‰‰‰ \nŠqˆË \nÌ  \nbˆÍyˆ`\n bˆÆˆm„^Æuˆ` qˆË Ì \nbˆbˆÍyˆ`bˆÆˆm„ˆÆuˆ`)ÎÁ!\n Á !ÐÆ& ,‡" [buffer-A get-buffer buffer-name error "Buffer %S doesn't exist" buffer-B nil reg-B-end reg-B-beg reg-A-end reg-A-beg region-beginning region-end 0 ediff-regions-internal startup-hooks ediff-regions-linewise] 10 (#$ . 19075) (let (bf) (list (setq bf (read-buffer "Region A's buffer: " (ediff-other-buffer "") t)) (read-buffer "Region B's buffer: " (progn (save-window-excursion (other-window 1)) (ediff-other-buffer bf)) t)))]) (defalias 'ediff-regions-internal #[(buffer-A beg-A end-A buffer-B beg-B end-B startup-hooks job-name word-mode) "À !‰‰‰p ƒ@Ê !ƒ@ËÊ !!ƒ@ÌŽ qˆÍ “Í “)‚KÑ=„KÒÓ!ˆ)pƒ~Ê!ƒ~ËÊ!!ƒ~ÕŽqˆÍ “Í “)‚‰Ñ=„‰ÒÓ!ˆ) =ƒÆWƒ¢X„²WƒÆXƒÆÙÚ!‘ˆÛÜ!„ÆÒÝ\"ˆƒÙà $ˆ‚äá $ˆâã\"ƒýà$ˆ‚á$ˆâä\"å #å#æ \f ‰çÂè\fDè DF)BêBë DBìBE&-‡" [get-buffer-create ediff-tmp-buffer nil file-B file-A overl-B overl-A tmp-buffer StartBuffer buffer-A get-buffer buffer-name ((set-buffer StartBuffer)) make-marker beg-A end-A this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" buffer-B ((set-buffer StartBuffer)) beg-B end-B ediff-msg-buffer princ "\nYou have requested to compare overlapping regions of the same buffer.\n\nIn this case, Ediff's highlighting may be confusing---in the same window,\nyou may see highlighted regions that belong to different regions.\n\nContinue anyway? (y/n) " y-or-n-p "Continue anyway? " "%S aborted" job-name word-mode ediff-wordify ediff-copy-to-buffer ediff-make-temp-file "regA" "regB" ediff-make-bullet-proof-overlay ediff-setup lambda delete-file startup-hooks ediff-word-mode ediff-narrow-bounds ediff-job-name] 12]) (defalias (quote ediff-merge) (quote ediff-merge-files)) (defalias 'ediff-merge-on-startup #[nil "ÀÁ!ˆp ƒ$Ä !ƒ$ÅÄ !!ƒ$ÆŽ qˆÇÈ!)‚. Ê=†.ËÌ!)‡" [ediff-do-merge 0 StartBuffer ediff-buffer-C get-buffer buffer-name ((set-buffer StartBuffer)) set-buffer-modified-p nil this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 3]) (put (quote ediff-merge-on-startup) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@35 Merge two files without ancestor. (defalias 'ediff-merge-files #[(file-A file-B &optional startup-hooks) "À BÂ Ä !ƒÆÇ ! \"‚ È É%‡" [ediff-merge-on-startup startup-hooks ediff-files-internal file-A file-directory-p file-B expand-file-name file-name-nondirectory nil ediff-merge-files] 6 (#$ . 21807) (let ((dir-A (if ediff-use-last-dir ediff-last-dir-A default-directory)) dir-B f) (list (setq f (ediff-read-file-name "File A to merge" dir-A (ediff-get-default-file-name))) (ediff-read-file-name "File B to merge" (setq dir-B (if ediff-use-last-dir ediff-last-dir-B (file-name-directory f))) (progn (setq file-name-history (cons (ediff-abbreviate-file-name (expand-file-name (file-name-nondirectory f) dir-B)) file-name-history)) f))))]) #@32 Merge two files with ancestor. (defalias 'ediff-merge-files-with-ancestor #[(file-A file-B file-ancestor &optional startup-hooks) "À BÂ Ä !ƒÆÇ ! \"‚  É%‡" [ediff-merge-on-startup startup-hooks ediff-files-internal file-A file-directory-p file-B expand-file-name file-name-nondirectory file-ancestor ediff-merge-files-with-ancestor] 6 (#$ . 22555) (let ((dir-A (if ediff-use-last-dir ediff-last-dir-A default-directory)) dir-B dir-ancestor f ff) (list (setq f (ediff-read-file-name "File A to merge" dir-A (ediff-get-default-file-name))) (setq ff (ediff-read-file-name "File B to merge" (setq dir-B (if ediff-use-last-dir ediff-last-dir-B (file-name-directory f))) (progn (setq file-name-history (cons (ediff-abbreviate-file-name (expand-file-name (file-name-nondirectory f) dir-B)) file-name-history)) f))) (ediff-read-file-name "Ancestor file" (setq dir-ancestor (if ediff-use-last-dir ediff-last-dir-ancestor (file-name-directory ff))) (progn (setq file-name-history (cons (ediff-abbreviate-file-name (expand-file-name (file-name-nondirectory ff) dir-ancestor)) file-name-history)) ff))))]) (defalias (quote ediff-merge-with-ancestor) (quote ediff-merge-files-with-ancestor)) #@33 Merge buffers without ancestor. (defalias 'ediff-merge-buffers #[(buffer-A buffer-B &optional startup-hooks job-name) "À B\n„\nÃÄ Ç \n%‡" [ediff-merge-on-startup startup-hooks job-name ediff-merge-buffers ediff-buffers-internal buffer-A buffer-B nil] 6 (#$ . 23746) (let (bf) (list (setq bf (read-buffer "Buffer A to merge: " (ediff-other-buffer "") t)) (read-buffer "Buffer B to merge: " (progn (save-window-excursion (other-window 1)) (ediff-other-buffer bf)) t)))]) #@30 Merge buffers with ancestor. (defalias 'ediff-merge-buffers-with-ancestor #[(buffer-A buffer-B buffer-ancestor &optional startup-hooks job-name) "À B\n„\nÃÄ  \n%‡" [ediff-merge-on-startup startup-hooks job-name ediff-merge-buffers-with-ancestor ediff-buffers-internal buffer-A buffer-B buffer-ancestor] 6 (#$ . 24226) (let (bf bff) (list (setq bf (read-buffer "Buffer A to merge: " (ediff-other-buffer "") t)) (setq bff (read-buffer "Buffer B to merge: " (progn (save-window-excursion (other-window 1)) (ediff-other-buffer bf)) t)) (read-buffer "Ancestor buffer: " (progn (save-window-excursion (other-window 1)) (ediff-other-buffer (list bf bff))) t)))]) #@129 Run Ediff by merging two revisions of a file. The file is the optional FILE argument or the file visited by the current buffer. (defalias 'ediff-merge-revisions #[(&optional file startup-hooks) "À ˆ ;ƒ\f !ˆÃ‰‰‰ÈÉÊ ;ƒ$Ë !‚%Ì\"!ÈÉÍ ;ƒ7Ë !‚8Ì\"!Ï=ƒwŠÐ!ˆp)Šј„YÐ!ˆp)ÒÃÓÔ !DÕјÓÔ\f!DEFB‚Á×=ƒ–Ø!јƒŽp‚’Ø!‚ÁÙ=ƒÁŠјƒ©Ú Û!ˆp)Šј„¾Û!ˆp)Ü \fÝ$,‡" [ediff-load-version-control file find-file nil buf2 buf1 rev2 rev1 read-string format "Version 1 to merge (default: %s's latest version): " file-name-nondirectory "current buffer" "Version 2 to merge (default: %s): " ediff-version-control-package vc vc-version-other-window "" lambda delete-file buffer-file-name or startup-hooks rcs rcs-ediff-view-revision generic-sc generic-sc-get-latest-rev sc-visit-previous-revision ediff-merge-buffers ediff-merge-revisions] 8 (#$ . 24896) nil]) #@156 Run Ediff by merging two revisions of a file with a common ancestor. The file is the the optional FILE argument or the file visited by the current buffer. (defalias 'ediff-merge-revisions-with-ancestor #[(&optional file startup-hooks) "À ˆ ;ƒ\f !ˆÃ‰‰‰‰‰ ÊËÌ ;ƒ*Í !‚+Î\"! ÊËÏ ;ƒ=Í !‚>Î\"!ÊËÐ ;ƒPÍ !‚QÎ\"!Ò=ƒ®ŠÓ !ˆp)ŠÔ˜„sÓ!ˆp)ŠÔ˜„ƒÓ!ˆp)ÕÃÖ×!DØÔ˜Ö× !DEØÔ˜Ö×\f!DE¯B‚Ú=ƒÞÛ !Ô˜ƒÆp‚ÊÛ!Ô˜ƒÖp‚ÚÛ!‚Ü=ƒŠ Ô˜ƒñÝ  Þ !ˆp)ŠÔ˜„Þ!ˆp)ŠÔ˜„Þ!ˆp)ß \fà%.‡" [ediff-load-version-control file find-file nil ancestor-buf buf2 buf1 ancestor-rev rev2 rev1 read-string format "Version 1 to merge (default: %s's latest version): " file-name-nondirectory "current buffer" "Version 2 to merge (default: %s): " "Ancestor version (default: %s): " ediff-version-control-package vc vc-version-other-window "" lambda delete-file buffer-file-name or startup-hooks rcs rcs-ediff-view-revision generic-sc generic-sc-get-latest-rev sc-visit-previous-revision ediff-merge-buffers-with-ancestor ediff-merge-revisions-with-ancestor] 9 (#$ . 25793) nil]) #@36 Run Ediff by patching BUFFER-NAME. (defalias 'ediff-patch-buffer #[(buffer-name &optional startup-hooks) "À !‰… Ã\n!Å\n!ÇÇ Ç\n\fƒ$\f ‚np ƒbÀ !ƒbÁÀ !!ƒbÌŽ qˆ Î ! Ï !ˆÇÑ !ˆÒÇ!ˆÓ ˆ )‚mÕ=„mÖ×!ˆ)Ø Ú#\n\f?…Cp \nƒ8À\n!ƒ8ÁÀ\n!!ƒ8ÛŽ\nqˆÜÃ!!ˆÜÃ!!ˆp ƒàÀ!ƒàÁÀ!!ƒàߎqˆƒÏ ÏÇ!ˆÑ !ˆÒ!ˆ)‚ëÕ=„ëÖ×!ˆ)p ƒ*À!ƒ*ÁÀ!!ƒ*àŽqˆÇƒ ÏÇ!ˆÑá âPã\"!ˆÒä!)‚4Õ=†4Ö×!*‚BÕ=†BÖ×!).‡" [get-buffer buffer-name buf-to-patch buffer-file-name file-name-ok buffer-modified-p buf-mod-status nil default-dir file-name ctl-buf StartBuffer ((set-buffer StartBuffer)) default-directory ediff-make-temp-file set-visited-file-name buffer-auto-save-file-name rename-buffer set-buffer-modified-p set-visited-file-modtime this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff" ediff-patch-file startup-hooks ediff-patch-buffer ((set-buffer StartBuffer)) delete-file ediff-buffer-A ediff-buffer-B ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ediff-unique-buffer-name "_patched" "" t] 5 (#$ . 26912) "bBuffer to patch: "]) #@106 Obtain patch buffer. If patch is already in a buffer---use it. Else, read patch file into a new buffer. (defalias 'ediff-get-patch-buffer #[(dir) "ÀÁ!ƒÂÃÄÅÆ#!‚ÈÉÊ \"!ÌÍ!pƒFÂ!ƒFÐÂ!!ƒFÑŽqˆÒ!)‚PÔ=†PÕÖ!)‡" [y-or-n-p "Is the patch file already in a buffer? " get-buffer read-buffer "Patch buffer name: " nil t ediff-patch-buf find-file-noselect read-file-name "Patch file name: " dir get-buffer-create "*ediff patch diagnostics*" ediff-patch-diagnostics StartBuffer buffer-name ((set-buffer StartBuffer)) insert-buffer this-command ediff-quit error "You've killed an essential Ediff buffer---Please quit Ediff"] 5 (#$ . 28032)]) #@195 Run Ediff by comparing versions of a file. The file is an optional FILE argument or the file visited by the current buffer. Use `vc.el' or `rcs.el' depending on `ediff-version-control-package'. (defalias 'ediff-revision #[(&optional file startup-hooks) ";ƒ Á!ˆÂ‰ÅÆÇ;ƒÈ!‚É\"!ÅÆÊ;ƒ-È!‚.É\"!Ë ˆÌÆÍ\"!\f #*‡" [file find-file nil rev2 rev1 read-string format "Version 1 to compare (default: %s's latest version): " file-name-nondirectory "current buffer" "Version 2 to compare (default: %s): " ediff-load-version-control intern "%S-ediff-internal" ediff-version-control-package startup-hooks] 5 (#$ . 28694) "P"]) (defalias 'ediff-load-version-control #[(&optional silent) "À !†Âà !!ƒÄÅ!ˆÆ !‡†ÈÉ \"‡" [featurep ediff-version-control-package locate-library symbol-name message "" require silent error "Version control package %S.el not found. Use vc.el instead"] 3]) #@236 Run Ediff on versions of the current buffer. If REV2 is "" then compare current buffer with REV1. If the current buffer is named `F', the version is named `F.~REV~'. If `F.~REV~' already exists, it is used instead of being re-created. (defalias 'vc-ediff-internal #[(rev1 rev2 &optional startup-hooks) "À‰‰‰ŠÅ!ˆpÇ )Šɘ„!Å!ˆpÇ )ÊÀË\fDÌÉ˜Ë DEF B Î\n  Ï$,‡" [nil rev2buf rev1buf file2 file1 vc-version-other-window rev1 buffer-file-name rev2 "" lambda delete-file or startup-hooks ediff-buffers ediff-revision] 7 (#$ . 29591)]) #@96 View previous RCS revision of current file. With prefix argument, prompts for a revision name. (defalias 'rcs-ediff-view-revision #[(&optional rev) "Àp!ÂÃ\f…Å\fPC\"Ç !È\fÉR\nËÌ!ˆÍ !\nÎ \n\"Ð!ˆŠqˆÑÒÓÔÕÔÂ× D#&ˆ*ËØ!ˆ\n‘+‡" [buffer-file-name filename append ("-p") rev "-r" switches file-name-nondirectory ".~" "~" buff message "Working ..." expand-file-name ediff-rcs-get-output-buffer output-buffer delete-windows-on apply call-process "co" nil t rcs-default-co-switches "-q" ""] 12 (#$ . 30142) (list (if current-prefix-arg (read-string "Revision: ")))]) (defalias 'ediff-rcs-get-output-buffer #[(file name) "À !Š\fqˆÅÇÈ !!\nË ˆ)\f*‡" [fundamental-mode default-major-mode get-buffer-create name buf nil buffer-read-only file-name-directory expand-file-name file default-directory erase-buffer] 3]) #@85 Run Ediff on versions of the current buffer. If REV2 is "" then use current buffer. (defalias 'rcs-ediff-internal #[(rev1 rev2 &optional startup-hooks) "Á˜ƒ\np‚ Â! !Æ\f È$*‡" [rev2 "" rcs-ediff-view-revision rev1 rev1buf rev2buf ediff-buffers startup-hooks ediff-revision] 5 (#$ . 30974)]) (defalias 'generic-sc-get-latest-rev #[nil "Á=ƒ\nÂÃ!‡ÂÄ!‡" [sc-mode CCASE eval "main/LATEST" ""] 2]) #@236 Run Ediff on versions of the current buffer. If REV2 is "" then compare current buffer with REV1. If the current buffer is named `F', the version is named `F.~REV~'. If `F.~REV~' already exists, it is used instead of being re-created. (defalias 'generic-sc-ediff-internal #[(rev1 rev2 &optional startup-hooks) "À‰Š ƒ ĘƒÅ Æ !ˆp)ŠĘ„&Æ!ˆp)È\n  Ê$*‡" [nil rev2buf rev1buf rev1 "" generic-sc-get-latest-rev sc-visit-previous-revision rev2 ediff-buffers startup-hooks ediff-revision] 5 (#$ . 31383)]) #@97 Return string describing the version of Ediff. When called interactively, displays the version. (defalias 'ediff-version #[nil "tƒ ÀÁ !‡Âà \f#‡" [message ediff-version format "Ediff %s of %s" ediff-date] 4 (#$ . 31901) nil]) (byte-code "ÀÁ!ˆÂÃ!‡" [provide ediff require ediff-util] 2) emacs-19.30/lisp/edmacro.elc100666 13437 1 41641 6021170731 14333 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Aug 30 19:18:04 1995 ;;; from file /home/fsf/rms/e19/lisp/edmacro.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`edmacro.el' was compiled for Emacs 19.29 or later")) #@134 *Non-nil if edit-kbd-macro should leave 8-bit characters intact. Default nil means to write characters above \177 in octal notation. (defvar edmacro-eight-bits nil (#$ . -470)) (byte-code "ÀÁ!„ÂÁ B „Ä Å ÆÇ#ˆÅ ÈÉ#ˆÂ‡" [boundp edmacro-mode-map nil current-load-list make-sparse-keymap define-key "" edmacro-finish-edit "" edmacro-insert-key] 4) #@325 Edit a keyboard macro. At the prompt, type any key sequence which is bound to a keyboard macro. Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit the last 100 keystrokes as a keyboard macro, or `M-x' to edit a macro by its command name. With a prefix argument, format the macro in a more concise way. (defalias 'edit-kbd-macro #[(keys &optional prefix finish-hook store-hook) "…PÁ!ƒÂ!‚à  Ç=„,ȃF „:ÊË!„:Ì ˆ †@ÍÉ‚ Î=ƒVÏÐ!‰K‚ Ñ=ƒdÒ É‚ „rÓÔÕ!\"ˆ‚ 9ƒ} K‚ ÃÁ\f!„ŽÓÖÕ!\"ˆ×Ø!ˆpÚ\f!ÜÝ\"Ü?\" áâ!#×ä!ˆå#!ˆæ ˆç(!ˆÃ)ê+ì-îï!Lˆîð!1Lˆîò!Lˆó ˆôõ±ˆö÷±ˆ„'ø ƒýù !‚þú÷±ˆû †\fü\"‰ƒ#ƒ&ý܉A@Ý\"÷±ˆ‚þcˆ)ÿcˆŠ ÷±ˆ)@A!ˆ\f=ƒGBÃ!ˆCD!.‡" [keys arrayp key-binding nil mac cmd store-hook call-last-kbd-macro (" " [return]) last-kbd-macro y-or-n-p "No keyboard macro defined. Create one? " keyboard-quit "" execute-extended-command read-command "Name of keyboard macro to edit: " view-lossage recent-keys error "Key sequence %s is not defined" key-description "Key sequence %s is not a keyboard macro" message "Formatting keyboard macro..." oldbuf edmacro-fix-menu-commands mmac edmacro-format-keys 1 fmt prefix fmtv get-buffer-create "*Edit Macro*" buf "Formatting keyboard macro...done" switch-to-buffer kill-all-local-variables use-local-map edmacro-mode-map buffer-read-only edmacro-mode major-mode "Edit Macro" mode-name make-local-variable edmacro-original-buffer edmacro-finish-hook finish-hook edmacro-store-hook erase-buffer ";; Keyboard Macro Editor. Press C-c C-c to finish; " "press C-x k RET to cancel.\n" ";; Original keys: " "\n" "\nCommand: " symbol-name "none" where-is-internal (keymap) "Key: " "Key: none\n" "\nMacro:\n\n" recenter (4) set-buffer-modified-p run-hooks edmacro-format-hook] 5 (#$ . 831) "kKeyboard macro to edit (C-x e, M-x, C-h l, or keys): \nP"]) #@48 Edit the most recently defined keyboard macro. (defalias 'edit-last-kbd-macro #[(&optional prefix) "ÀÁ\n\"‡" [edit-kbd-macro call-last-kbd-macro prefix] 3 (#$ . 2730) "P"]) #@77 Edit a keyboard macro which has been given a name by `name-last-kbd-macro'. (defalias 'edit-named-kbd-macro #[(&optional prefix) "ÀÁ\n\"‡" [edit-kbd-macro execute-extended-command prefix] 3 (#$ . 2909) "P"]) #@595 Read the region as a keyboard macro definition. The region is interpreted as spelled-out keystrokes, e.g., "M-x abc RET". See documentation for `edmacro-mode' for details. Leading/trailing "C-x (" and "C-x )" in the text are allowed and ignored. The resulting macro is installed as the "current" keyboard macro. In Lisp, may also be called with a single STRING argument in which case the result is returned rather than being installed as the current macro. The result will be a string if possible, otherwise an event vector. Second argument NEED-VECTOR means to return an event vector always. (defalias 'read-kbd-macro #[(start &optional end) ";ƒ\nÁ\n\"‡Á\n{!‰‡" [start edmacro-parse-keys end last-kbd-macro] 3 (#$ . 3124) "r"]) #@301 Return the keyboard macro MACRO as a human-readable string. This string is suitable for passing to `read-kbd-macro'. Second argument VERBOSE means to put one command per line with comments. If VERBOSE is `1', put everything on one line. If VERBOSE is omitted or nil, use a compact 80-column format. (defalias 'format-kbd-macro #[(&optional macro verbose) "ƒ\f9ƒ\fKÁ†\n \"‡" [macro edmacro-format-keys last-kbd-macro verbose] 3 (#$ . 3866)]) (defalias 'edmacro-finish-edit #[nil "Á=„\nÂÃ!ˆÄÅ!ˆÆ‰‰e \nbˆÆ ÌÍ!„øÌÎ!ƒrƒ6ÂÐ!ˆÑ”Ñ•{‰Óš„nÔš?…OÕ!\nÖ\n!ƒn×\nK!„nØÙÚ\nÛ#!„nÜ ˆ)‚øÌÝ!ƒáƒÂÞ!ˆßєѕ{!‰ Óš„Ý Ôšƒá‚Ý  B â !‰#ƒÜä#!ƒÜ×#!„ÜÖ#!ƒË×#K!„ÜØÙåæ Ñ\"Û#!„ÜÜ ˆ))‚øÌç!ƒîè•bˆ‚þm„þÂé!ƒþÑyˆ‚!`)p*d{ë ,-./ 0\n„4 „4/„4Óš„4Âñ!ˆ,ƒò.!ƒD.qˆóô!ˆß!5óö!ˆ/ƒ`/5!ˆ‚\n÷=ƒv5GèV…q57Æ\n\nƒ‘5GèUƒ‹ø\n!ˆ‚‘\n5MˆƒÂ\nƒù\nú\";Æ ;:ƒ¾;@ ü !ˆ;A‰;‚§*‚ ƒ5GèUƒó =Æ =:ƒï=@ ü !ˆ=A‰=‚Ø*‚ >Æ >:ƒ>@ ÿ \n†5\"ˆ>A‰>‚ü*)@*!ˆò.!ƒ1A.!ˆ0…90 .\n‡" [major-mode edmacro-mode error "This command is valid only in buffers created by `edit-kbd-macro'" run-hooks edmacro-finish-hook nil top no-keys keys cmd case-fold-search looking-at "[ ]*\\($\\|;;\\|REM[ \n]\\)" "Command:[ ]*\\([^ \n]*\\)[ ]*$" edmacro-store-hook "\"Command\" line not allowed in this context" 1 str "" "none" intern fboundp arrayp y-or-n-p format "Command %s is already defined; %s" "proceed? " keyboard-quit "Key:\\(.*\\)$" "\"Key\" line not allowed in this context" edmacro-parse-keys key t key-binding b commandp "Key %s is already defined; %s" edmacro-format-keys "Macro:[ \n]*" 0 "Expected a `Macro:' line" buf buffer-modified-p modp edmacro-original-buffer obuf store-hook finish-hook "No command name or keys specified" buffer-name message "Compiling keyboard macro..." mac "Compiling keyboard macro...done" last-kbd-macro fmakunbound where-is-internal (keymap) G9250 global-unset-key G9251 G9252 global-set-key kill-buffer switch-to-buffer] 7 nil nil]) #@49 Insert the written name of a key in the buffer. (defalias 'edmacro-insert-key #[(key) "nƒ\fÀ Â\"ñ‡À !ı‡" [edmacro-format-keys key t "\n" " "] 3 (#$ . 5939) "kKey to insert: "]) #@3091 \Keyboard Macro Editing mode. Press \[edmacro-finish-edit] to save and exit. To abort the edit, just kill this buffer with \[kill-buffer] RET. Press \[edmacro-insert-key] to insert the name of any key by typing the key. The editing buffer contains a "Command:" line and any number of "Key:" lines at the top. These are followed by a "Macro:" line and the macro itself as spelled-out keystrokes: `C-x C-f foo RET'. The "Command:" line specifies the command name to which the macro is bound, or "none" for no command name. Write "last-kbd-macro" to refer to the current keyboard macro (as used by \[call-last-kbd-macro]). The "Key:" lines specify key sequences to which the macro is bound, or "none" for no key bindings. You can edit these lines to change the places where the new macro is stored. Format of keyboard macros during editing: Text is divided into "words" separated by whitespace. Except for the words described below, the characters of each word go directly as characters of the macro. The whitespace that separates words is ignored. Whitespace in the macro must be written explicitly, as in "foo SPC bar RET". * The special words RET, SPC, TAB, DEL, LFD, ESC, and NUL represent special control characters. The words must be written in uppercase. * A word in angle brackets, e.g., , , or , represents a function key. (Note that in the standard configuration, the function key and the control key RET are synonymous.) You can use angle brackets on the words RET, SPC, etc., but they are not required there. * Keys can be written by their ASCII code, using a backslash followed by up to six octal digits. This is the only way to represent keys with codes above \377. * One or more prefixes M- (meta), C- (control), S- (shift), A- (alt), H- (hyper), and s- (super) may precede a character or key notation. For function keys, the prefixes may go inside or outside of the brackets: C- = . The prefixes may be written in any order: M-C-x = C-M-x. Prefixes are not allowed on multi-key words, e.g., C-abc, except that the Meta prefix is allowed on a sequence of digits and optional minus sign: M--123 = M-- M-1 M-2 M-3. * The `^' notation for control characters also works: ^M = C-m. * Double angle brackets enclose command names: <> is shorthand for M-x next-line RET. * Finally, REM or ;; causes the rest of the line to be ignored as a comment. Any word may be prefixed by a multiplier in the form of a decimal number and `*': 3* = , and 10*foo = foofoofoofoofoofoofoofoofoofoo. Multiple text keys can normally be strung together to form a word, but you may need to add whitespace if the word would look like one of the above notations: `; ; ;' is a keyboard macro with three semicolons, but `;;;' is a comment. Likewise, `\ 1 2 3' is four keys but `\123' is a single key written in octal, and `< right >' is seven keys but `' is a single function key. When in doubt, use whitespace. (defalias 'edmacro-mode #[nil "ÀÁ!‡" [error "This mode can be enabled only by `edit-kbd-macro'"] 2 (#$ . 6129) nil]) (put (quote edmacro-mode) (quote mode-class) (quote special)) (defalias 'edmacro-format-keys #[(macro &optional verbose) "À !ÂÃ Ä …Ä CÅ C#ÇÉ›\n ƒ'Ì‚(ÍÏÑÓ Ô\"ÖØÛ=‰ƒIÏ ;ƒØ GWƒ~HßYƒtHà\\IˆÛ\\‰‚W*ØHá=„bØH¨ƒàØH\n>ƒàâãØÛ#!ä>ƒàÛH\nA>ƒ¾T‚ªH>?…ÜåãØ#æQã\")†ØHç=ƒ<âè!é=ƒ<ÛHç=ƒT‚ôH>?…8*Ö+*S‰*ØYƒ-+ìP+‚+*ã\")†ØHç=…âí!é=…ÛHî=ƒ_THï>ƒqT‚_H>?…ìãÛ#æQã\")0ñòÛ3Ï4Ï5Ï63:ƒÉ3@4÷4\"‰5ƒÀ56B63A‰3‚¤6Ÿ,#8ãØ8#9Ï:Ï;Ï<=Ï4Ï5þ?Ï@=:ƒ =@4÷49\"‰5¨?… 5‰@?‰?ƒ =A‰=‚ô@-†§÷A\"‰:…§:;ãØ;#<÷A<\"‰:…§BÏ4Ï5þCÏDB:ƒ˜B@4÷4:\"‰5¨„‹5ƒ‹;8<95DωC‚Œþƒ˜BA‰B‚]Cƒ¤Ï:Ï‚¦D-E9ØHF8GGÏHGWƒ+H‰H¨ƒ+HIVƒ+HWƒ+HJU„+âKH!!L=ƒ+GMZV„!HÛ\\H=ƒ!HM\\H=„+Û\\‰‚½+NÏOE;ƒ<ÏEEL=ƒé0„éNÛVƒéF¨ƒéFIVƒéFXƒéFJU„éNPVƒPNãØN#°OQRO\"ƒ¤MNOØMOOQSO\"„éQTO\"„ÄOƒÐUKOæ#OƒâVWEN#EN8‚TEX=ƒCN8VƒCNHY>ƒCã8N#°OZ[O!!ƒCZ[O!!ƒ0OEV\\O\"ONT8‚TU]:†P9æ#O0ƒ`0OPOQæO\"„±Û8^_`‰Ø8^8^\\&„•_T_^8\\^‚q_ÛVƒ°Va_O#O8__8*ã8\"ƒÖš„ÍbPOPEƒE;„åE9ƒcdOGe¥ZÛ]f\"gE;ƒ E‚hE!RØ‚]OGM\\\\iVƒ<„<jPÛ‚NÖš„NæPTOPOG\\.\n‚.\n‡" [edmacro-fix-menu-commands macro append current-minor-mode-maps current-local-map current-global-map maps (end-macro 48 49 50 51 52 53 54 55 56 57 45 21 -134217683 -134217680 -134217679 -134217678 -134217677 -134217676 -134217675 -134217674 -134217673 -134217672 -134217671) pkeys 13 mdigs edmacro-eight-bits 255 127 maxkey nil case-fold-search ("NUL" "TAB" "LFD" "RET" "ESC" "SPC" "DEL" "REM") res-words vconcat [end-macro] rest-mac "" res 0 len verbose 1 one-line i G9253 128 134217600 end-macro key-binding edmacro-subseq (digit-argument negative-argument) "M-" " " 21 [21] universal-argument G9255 G9256 "C-u " [21] 45 (48 49 50 51 52 53 54 55 56 57) prefix apply max G9259 map b G9260 lookup-key bind-len key fkey tlen tkey G9261 t G9262 G9263 function-key-map G9264 G9265 G9266 bind first G9267 ch 32 92 char-to-string self-insert-command 2 text desc 30 string-match "^[ACHMsS]-." "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*." "^\\^.$" mapconcat format "%s * %d" execute-extended-command (return 13) commandp intern-soft "<<%s>>" #[(ch) "¨ƒØÁÃÅÇÅ Ê \fT‰\nGWƒK\n\fH:ƒK@ Ì \"ÍU„C ÎÏ\"P A‚ .ÌÐÑÒ\"S\"‰ÔXƒ¶Í=ƒjÕ‚ÕÖ=ƒuׂÕØ=ƒ€Ù‚ÕÚ=ƒ‹Û‚ÕÜ=ƒ–Ý‚ÕÔ=ƒ¡Þ‚ÕÎßàXƒ®á‚¯â\\\"‚ÕãUƒÁä‚Õ%XƒÐæ!‚ÕÎç\")P‡9ƒâÎè\"‡éê\"‡" [ch "ACHMsS" G9279 -1 G9280 nil pf (4194304 67108864 16777216 -134217728 8388608 33554432) G9281 bit "" G9282 logand 0 format "%c-" lsh 1 18 ch2 32 "NUL" 9 "TAB" 10 "LFD" 13 "RET" 27 "ESC" "SPC" "C-%c" 26 96 64 127 "DEL" maxkey char-to-string "\\%o" "<%s>" error "Unrecognized item in macro: %s"] 7] pos times edmacro-mismatch "%d*%s" "\n" make-string 3 8 9 ";; " symbol-name 72 "\n "] 9]) #@206 Compare SEQ1 with SEQ2, return index of first mismatching element. Return nil if the sequences match. If one sequence is a prefix of the other, the return value indicates the end of the shorted sequence. (defalias 'edmacro-mismatch #[(cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2) "À‰‰‰ „G„G ƒï WƒÛ\nWƒÛ\fƒa\f\nƒ@\n Sœ!‚E Sœ\nƒT\nSœ!‚ZSœ\"? =‚Í\nƒo\n Sœ!‚t Sœ§ƒ¤\nƒ†\n Sœ!‚‹ Sœ\nƒš\nSœ!‚ Sœš‚Í\nƒ²\n Sœ!‚· Sœ\nƒÆ\nSœ!‚ÌSœ=ƒÛ SS‚ W„ê\nW…x S‚x<…ú ›<…\n› \f Wƒf\nWƒf\fƒv\f\nƒ6\n\fƒ-\f@‚2 H!‚F\fƒA\f@‚F H\nƒ_\n ƒV @‚[\nH!‚o ƒj @‚o\nH\"? =‚L\nƒ\n\fƒ†\f@‚‹ H!‚Ÿ\fƒš\f@‚Ÿ H§ƒù\nƒ¼\n\fƒ³\f@‚¸ H!‚Ì\fƒÇ\f@‚Ì H\nƒå\n ƒÜ @‚á\nH!‚õ ƒð @‚õ\nHš‚L\nƒ\n\fƒ \f@‚ H!‚\"\fƒ\f@‚\" H\nƒ;\n ƒ2 @‚7\nH!‚K ƒF @‚K\nH=ƒf\fA\f A  T \nT\n‚  W„u\nW…w *,‡" [nil cl-from-end cl-key cl-test-not cl-test cl-end1 cl-seq1 cl-end2 cl-seq2 cl-start1 cl-start2 cl-p2 cl-p1] 5 (#$ . 12560)]) #@165 Return the subsequence of SEQ from START to END. If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end. (defalias 'edmacro-subseq #[(seq start &optional end) ";ƒ\n \nO‡Ã\nƒ\nÅWƒ\nG‰\\ ÅWƒ. \f†,G‰\\<ƒg ÅVƒ= ›\nƒaÃ\nS‰ YƒZ‰A@B‚DŸ)‚Ç!‚\n„r\f†qGÈ\n ZÅ]Ã\"Å  \nWƒš  HIˆ T T‰‚€*)‡" [seq start end nil len 0 res copy-sequence make-vector i] 5 (#$ . 13687)]) (defalias 'edmacro-fix-menu-commands #[(macro) "À !ƒIÂÉ GWƒH H‰:ƒA\fA@A@Æšƒ<ÇÈ Â #ÉÊ\f@\"È T\"# T‚AËÌÍ\"ˆ T‰‚ * ‡" [vectorp macro 0 nil ev i (menu-bar) vconcat edmacro-subseq vector menu-bar error "Macros with mouse clicks are not %s" "supported by this command"] 7]) (defalias 'edmacro-parse-keys #[(string &optional need-vector) "ÀÁÂ\fGWƒ1ÇÈ\f#ƒ1Á”Á•OÀÉ\n \fÁ•ÇÍ\f\"ƒDÎ\fÁÉ•O!\n\fÉ•TÀO\fÇÏ\f\"ƒmÐÑÒ!Ó=ƒYÔ‚aÕÓ!@†aÖ\f×ØOÙ# ‚ÇÚ\f\"ƒ˜\fɔɕO\fÛ”Û•OP\fÇÜ\f\"„˜Ý\f!C ‚\fÞš„§Çß\f\"ƒ±Çà\f#‚\fÁ‰!\"#Çä\f\"ƒß!\fÁHåžA\\!\"×\\\"\f×ÀO\f‚»Çæ\f\"ƒù!ç\\!\"T\"\fÉÀO\fè\fé\"‰*ƒ *A\f)Çë\f\"ƒW\f,í.À/À0ñ2.T‰.,GWƒP,.H/2ƒ?Á‚H0ó_/ô\\\\0À2‚\"õ0!\f-!ÁUƒe\f ‚!öUƒ°\f;ƒ°Ç÷\f\"ƒ°\f8í9À:À;9T‰98GWƒ§89H‰:!\\;B;‚‡;Ÿ, ‚\fGÉU„Çüý#Á\"O\f#ˆ‚þ!ç\"ÁU„\f;ƒÇÿ\f\"ƒ!\f@šƒðA‚ùþ\fÁHB\"C\\\\C ‚!\fÁH\\C + ƒ-\nDDS‰DÁYƒ,Ð  \"‚)+‚ GEYƒp ÁHF=ƒp ÉHG=ƒp ‰G×ZHF=ƒp ‰GÉZHH=ƒpI ×Ø#J„ KíLÀ/ñMLT‰LKGWƒ¶KLH‰/¨…°þ/N\"‰OÁY…¯OAX)‰M„M…¼ñ,ƒ PíQÀ/ÀRQT‰QPGWƒýPQH/þ/ö\"ÁUƒï/‚õ/S\\RBR‚ÌRŸ,°‚ +‡" [nil 0 [] res pos case-fold-search string string-match "[^ \n\f]+" 1 times key word "\\([0-9]+\\)\\*." string-to-int "^<<.+>>$" vconcat key-binding [-134217608] execute-extended-command [-134217608] where-is-internal [-134217608] 2 -2 " " "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" 3 "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" intern "REM" "^;;" "$" bits prefix orig-word "^[ACHMsS]-." ((65 . 4194304) (67 . 67108864) (72 . 16777216) (77 . -134217728) (115 . 8388608) (83 . 33554432)) "^\\^.$" 67108864 assoc (("NUL" . "") ("RET" . " ") ("LFD" . "\n") ("TAB" . " ") ("ESC" . "") ("SPC" . " ") ("DEL" . "")) found "^\\\\[0-7]+$" G9286 -1 G9287 ch n t G9288 8 -48 vector -134217728 "^-?[0-9]+$" G9289 G9290 x G9291 error "%s must prefix a single character, not %s" logand "[@-_.a-z?]" "?" 127 31 -67108864 G9292 4 24 40 41 edmacro-subseq need-vector G9293 G9294 G9295 134217727 ch2 G9296 G9297 G9298 128] 6]) #@584 Insert in buffer the definition of kbd macro NAME, as Lisp code. Optional second arg KEYS means also record the keys it is on (this is the prefix argument, when calling interactively). This Lisp code will, when executed, define the kbd macro with the same definition it has now. If you say to record the keys, the Lisp code will also rebind those keys to the macro. Only global key bindings are recorded since executing this Lisp code always makes global bindings. To save a kbd macro, visit a file of Lisp code such as your `~/.emacs', use this command, and then save the file. (defalias 'insert-kbd-macro #[(macroname &optional keys) "À !ĘƒÅ Æcˆ‚Å !ÇÈ \"cˆ GÉVƒ*Êcˆ‚-ËcˆÌ p\"ˆÍcˆ…XÏ Ð\"‰…WÇÑ@ #cˆA‰„DÀ))‡" [nil definition symbol-name macroname "" format-kbd-macro "(setq last-kbd-macro" format "(defalias '%s" 50 " (read-kbd-macro\n" "\n (read-kbd-macro " prin1 "))\n" keys where-is-internal (keymap) "(global-set-key %S '%s)\n"] 5 (#$ . 16276) "CInsert kbd macro (name): \nP"]) (provide (quote edmacro)) emacs-19.30/lisp/edt-lk201.elc100666 75424 1 2526 6045212754 14361 0ustar kwzhdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:14:03 1995 ;;; from file /home/fsf/rms/e19/lisp/edt-lk201.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`edt-lk201.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ\nBÁ‡" [(("KP0" . [kp-0]) ("KP1" . [kp-1]) ("KP2" . [kp-2]) ("KP3" . [kp-3]) ("KP4" . [kp-4]) ("KP5" . [kp-5]) ("KP6" . [kp-6]) ("KP7" . [kp-7]) ("KP8" . [kp-8]) ("KP9" . [kp-9]) ("KP," . [kp-separator]) ("KP-" . [kp-subtract]) ("KPP" . [kp-decimal]) ("KPE" . [kp-enter]) ("PF1" . [kp-f1]) ("PF2" . [kp-f2]) ("PF3" . [kp-f3]) ("PF4" . [kp-f4]) ("UP" . [up]) ("DOWN" . [down]) ("RIGHT" . [right]) ("LEFT" . [left]) ("FIND" . [find]) ("INSERT" . [insert]) ("REMOVE" . [delete]) ("SELECT" . [select]) ("PREVIOUS" . [prior]) ("NEXT" . [next]) ("F1" . [f1]) ("F2" . [f2]) ("F3" . [f3]) ("F4" . [f4]) ("F5" . [f5]) ("F6" . [f6]) ("F7" . [f7]) ("F8" . [f8]) ("F9" . [f9]) ("F10" . [f10]) ("F11" . [f11]) ("F12" . [f12]) ("F13" . [f13]) ("F14" . [f14]) ("HELP" . [help]) ("DO" . [menu]) ("F17" . [f17]) ("F18" . [f18]) ("F19" . [f19]) ("F20" . [f20])) *EDT-keys* current-load-list] 2) emacs-19.30/lisp/edt-mapper.elc100666 75424 1 21176 6045213006 15025 0ustar kwzhdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:14:04 1995 ;;; from file /home/fsf/rms/e19/lisp/edt-mapper.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`edt-mapper.el' was compiled for Emacs 19.29 or later")) (byte-code "ƒ\n ™ƒÃcˆÄÅ!ˆÆÇ!ˆÄ‡" [window-system emacs-version "19" "\n\n Whoa! This isn't going to work...\n\n You must run edt-mapper.el under X-windows and Emacs version 19.\n\n Press any key to exit. " sit-for 600 kill-emacs t] 2) #@51 Non-NIL if we are running Lucid Emacs version 19. (defconst edt-lucid-emacs19-p (string-match "Lucid" emacs-version) (#$ . 730)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ BÀÈ!„GÂÈ B ƒYÊÂËÌ#ˆ‚`ÍÎ ËÌ#ˆÏÐ!„jÑÐ!ˆÏÒ!„tÑÒ!ˆÒqˆÓcˆÔÐ!ˆÕcˆÖ ˆ ƒž×Ø!ÙÚÛÜÝH!\"ÞQ‚¯ßØ!ˆà ÙÚÛ\"ÞQÐqˆed|ˆác‡" [boundp edt-key nil current-load-list edt-enter edt-return edt-key-seq edt-enter-seq edt-return-seq edt-lucid-emacs19-p set-screen-size 80 36 set-frame-size selected-frame get-buffer "Directions" generate-new-buffer "Keys" ";;\n;; Key definitions for the EDT emulation within GNU Emacs\n;;\n\n(defconst *EDT-keys*\n '(\n" switch-to-buffer "\n EDT MAPPER\n\n You will be asked to press keys to create a custom mapping (under\n X-Windows) of your keypad keys and function keys so that they can emulate\n the LK-201 keypad and function keys or the subset of keys found on a \n VT-100 series terminal keyboard. (The LK-201 keyboard is the standard\n keyboard attached to VT-200 series terminals, and above.) \n\n Sometimes, edt-mapper will ignore a key you press, and just continue to\n prompt for the same key. This can happen when your window manager sucks\n up the key and doesn't pass it on to emacs, or it could be an emacs bug.\n Either way, there's nothing that edt-mapper can do about it. You must\n press RETURN, to skip the current key and continue. Later, you and/or\n your local X guru can try to figure out why the key is being ignored.\n\n Start by pressing the RETURN key, and continue by pressing the keys\n specified in the mini-buffer. If you want to entirely omit a key, \n because your keyboard does not have a corresponding key, for example, \n just press RETURN at the prompt.\n\n" delete-other-windows read-key-sequence "Hit carriage-return to continue " "[" format "%s" event-key 0 "]" message read-event "\n\n\n\n PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW.\n\n\n\n\n Here's a picture of the standard LK-201 keypad for reference:\n\n _______________________ _______________________________\n | HELP | DO | | F17 | F18 | F19 | F20 |\n | | | | | | | |\n |_______|_______________| |_______|_______|_______|_______|\n _______________________ _______________________________\n | FIND |INSERT |REMOVE | | PF1 | PF2 | PF3 | PF4 |\n | | | | | | | | |\n |_______|_______|_______| |_______|_______|_______|_______|\n |SELECT |PREVIOU| NEXT | | KP7 | KP8 | KP9 | KP- |\n | | | | | | | | |\n |_______|_______|_______| |_______|_______|_______|_______|\n | UP | | KP4 | KP5 | KP6 | KP, |\n | | | | | | |\n _______|_______|_______ |_______|_______|_______|_______|\n | LEFT | DOWN | RIGHT | | KP1 | KP2 | KP3 | |\n | | | | | | | | |\n |_______|_______|_______| |_______|_______|_______| KPE |\n | KP0 | KPP | |\n | | | |\n |_______________|_______|_______|\n\n"] 6) (defalias 'edt-lucid-map-key #[(ident descrip func gold-func) "ÀÁ \f#!ÆÁÇÈ ÉH!\"ÊQ‰ \fš„*ÍqˆÁÎ  #cˆÏqˆ ‡" [read-key-sequence format "Press %s%s: " ident descrip edt-key-seq "[" "%s" event-key 0 "]" edt-key edt-return "Keys" " (\"%s\" . %s)\n" "Directions"] 7 nil nil]) (defalias 'edt-gnu-map-key #[(ident descrip) "ÀÁ\n #ˆÄ ÆÇÈ \"ÉQ‰\n š„*ÌqˆÇÍ\n\n#cˆÎqˆ‚6ÌqˆÇÏ\n\"cˆÎqˆ\n‡" [message "Press %s%s: " ident descrip read-event edt-key-seq "[" format "%s" "]" edt-key edt-return "Keys" " (\"%s\" . %s)\n" "Directions" " (\"%s\" . \"\" )\n"] 5 nil nil]) (byte-code "À ƒ ‚\nÃMˆÄqˆÅcˆÆqˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÄqˆÏcˆÆqˆÀÐÑ\"ˆÀÒÓ\"ˆÀÔÕ\"ˆÀÖ×\"ˆÄqˆØcˆÆqˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"ˆÀãä\"ˆÀåæ\"ˆÀçè\"ˆÀéê\"ˆÀëì\"ˆÀíî\"ˆÀïð\"ˆÀñò\"ˆÀóô\"ˆ5678ÄqˆùcˆÆqˆÀúû\"ˆÀüý\"ˆÀþÿ\"ˆÀ@A\"ˆÀBC\"ˆÀDE\"ˆÄqˆFcˆÆqˆÀGH\"ˆÀIJ\"ˆÀKL\"ˆÀMN\"ˆÀOP\"ˆÀQR\"ˆÀST\"ˆÀUV\"ˆÀWX\"ˆÀYZ\"ˆÀ[\\\"ˆÀ]^\"ˆÀ_`\"ˆÀab\"ˆÀcd\"ˆÀef\"ˆÀgh\"ˆÀij\"ˆÀkl\"ˆÀmn\"ˆÆqˆed|ˆocˆpÆ!ˆÄqˆqcˆrstu!‰sr˜„ÊÀsr\"ˆ‚®Äqˆvcˆ ƒÜw‚ßxyz{|}y\"~y#!ˆ) ˆ€!ˆ‚ƒ!ˆ„…!‡" [edt-map-key edt-lucid-emacs19-p edt-lucid-map-key edt-gnu-map-key "Keys" "\n;;\n;; Arrows\n;;\n" "Directions" "UP" " - The Up Arrow Key" "DOWN" " - The Down Arrow Key" "LEFT" " - The Left Arrow Key" "RIGHT" " - The Right Arrow Key" "\n;;\n;; PF keys\n;;\n" "PF1" " - The PF1 (GOLD) Key" "PF2" " - The Keypad PF2 Key" "PF3" " - The Keypad PF3 Key" "PF4" " - The Keypad PF4 Key" "\n;;\n;; KP0-9 KP- KP, KPP and KPE\n;;\n" "KP0" " - The Keypad 0 Key" "KP1" " - The Keypad 1 Key" "KP2" " - The Keypad 2 Key" "KP3" " - The Keypad 3 Key" "KP4" " - The Keypad 4 Key" "KP5" " - The Keypad 5 Key" "KP6" " - The Keypad 6 Key" "KP7" " - The Keypad 7 Key" "KP8" " - The Keypad 8 Key" "KP9" " - The Keypad 9 Key" "KP-" " - The Keypad - Key" "KP," " - The Keypad , Key" "KPP" " - The Keypad . Key" "KPE" " - The Keypad Enter Key" edt-key edt-enter edt-key-seq edt-enter-seq "\n;;\n;; Editing keypad (FIND, INSERT, REMOVE)\n;; (SELECT, PREVIOUS, NEXT)\n;;\n" "FIND" " - The Find key on the editing keypad" "INSERT" " - The Insert key on the editing keypad" "REMOVE" " - The Remove key on the editing keypad" "SELECT" " - The Select key on the editing keypad" "PREVIOUS" " - The Prev Scr key on the editing keypad" "NEXT" " - The Next Scr key on the editing keypad" "\n;;\n;; F1-14 Help Do F17-F20\n;;\n" "F1" " - F1 Function Key" "F2" " - F2 Function Key" "F3" " - F3 Function Key" "F4" " - F4 Function Key" "F5" " - F5 Function Key" "F6" " - F6 Function Key" "F7" " - F7 Function Key" "F8" " - F8 Function Key" "F9" " - F9 Function Key" "F10" " - F10 Function Key" "F11" " - F11 Function Key" "F12" " - F12 Function Key" "F13" " - F13 Function Key" "F14" " - F14 Function Key" "HELP" " - HELP Function Key" "DO" " - DO Function Key" "F17" " - F17 Function Key" "F18" " - F18 Function Key" "F19" " - F19 Function Key" "F20" " - F20 Function Key" "\n ADDITIONAL FUNCTION KEYS\n\n Your keyboard may have additional function keys which do not\n correspond to any LK-201 keys. The EDT Emulation can be\n configured to recognize those keys, since you may wish to add your\n own key bindings to those keys.\n \n For example, suppose your keyboard has a keycap marked \"Line Del\"\n and you wish to add it to the list of keys which can be customized\n by the EDT Emulation. First, assign a unique single-word name to\n the key for use by the EDT Emulation, let's say \"linedel\", in this\n example. Then, at the \"EDT Key Name:\" prompt, enter \"linedel\",\n followed by a press of the RETURN key. Finally, when prompted,\n press the \"Line Del\" key. You now will be able to bind functions\n to \"linedel\" and \"Gold-linedel\" in edt-user.el in just the same way\n you can customize bindings of the standard LK-201 keys.\n\n When you have no additional function keys to specify, just press\n RETURN at the \"EDT Key Name:\" prompt. (If you change your mind\n AFTER you enter an EDT Key Name and before you press a key at the\n \"Press\" prompt, you may omit the key by simply pressing RETURN at\n the prompt.)\n" switch-to-buffer ";;\n;; Extra Keys \n;;\n" "" EDT-key-name read-string "EDT Key Name: " " )\n )\n" "~/.edt-lucid-keys" "~/.edt-gnu-keys" file set-visited-file-name read-file-name format "Save key mapping to file (default %s): " nil save-buffer message "That's it! Press any key to exit" sit-for 600 kill-emacs t] 5) emacs-19.30/lisp/edt-pc.elc100666 75424 1 2455 6045213010 14115 0ustar kwzhdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:14:31 1995 ;;; from file /home/fsf/rms/e19/lisp/edt-pc.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`edt-pc.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ\nBÁ‡" [(("KP0" . [kp-0]) ("KP1" . [kp-1]) ("KP2" . [kp-2]) ("KP3" . [kp-3]) ("KP4" . [kp-4]) ("KP5" . [kp-5]) ("KP6" . [kp-6]) ("KP7" . [kp-7]) ("KP8" . [kp-8]) ("KP9" . [kp-9]) ("KP," . "") ("KP-" . [kp-add]) ("KPP" . [kp-decimal]) ("KPE" . [kp-enter]) ("PF1" . [f1]) ("PF2" . [kp-divide]) ("PF3" . [kp-multiply]) ("PF4" . [kp-subtract]) ("UP" . [up]) ("DOWN" . [down]) ("RIGHT" . [right]) ("LEFT" . [left]) ("FIND" . [insert]) ("INSERT" . [home]) ("REMOVE" . [prior]) ("SELECT" . [delete]) ("PREVIOUS" . [end]) ("NEXT" . [next]) ("F1" . "") ("F2" . [f2]) ("F3" . [f3]) ("F4" . [f4]) ("F5" . [f5]) ("F6" . [f6]) ("F7" . [f7]) ("F8" . [f8]) ("F9" . [f9]) ("F10" . [f10]) ("F11" . [f11]) ("F12" . [f12]) ("F13" . "") ("F14" . "") ("HELP" . "") ("DO" . "") ("F17" . "") ("F18" . "") ("F19" . "") ("F20" . "")) *EDT-keys* current-load-list] 2) emacs-19.30/lisp/edt-vt100.elc100666 75424 1 1347 6045213011 14365 0ustar kwzhdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:14:33 1995 ;;; from file /home/fsf/rms/e19/lisp/edt-vt100.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`edt-vt100.el' was compiled for Emacs 19.29 or later")) (load "edt-lk201" nil t) #@35 Set terminal width to 80 columns. (defalias 'edt-set-term-width-80 #[nil "ÀÁ!‡" [vt100-wide-mode -1] 2 (#$ . 503)]) #@36 Set terminal width to 132 columns. (defalias 'edt-set-term-width-132 #[nil "ÀÁ!‡" [vt100-wide-mode 1] 2 (#$ . 625)]) emacs-19.30/lisp/ehelp.elc100666 13437 1 20467 6046535340 14031 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 19:59:03 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/ehelp.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`ehelp.el' was compiled for Emacs 19.29 or later")) (require (quote electric)) #@61 Keymap defining commands available in `electric-help-mode'. (defvar electric-help-map nil (#$ . 502)) (byte-code "ÀÁÂÃ#ˆ\f„ÂÅ Â!ˆÇÈÁ#ˆÇÉÁ#ˆÇÊÁ#ˆÇËÁ#ˆÇÌÁ#ˆÇÍÁ#ˆÇÎÁ#ˆÇÏÁ#ˆÇÐÁ#ˆÇÑÁ#ˆÇÒÁ#ˆÇÓ!Õ#ˆÇÖÕ#ˆÇ×Ø#ˆÇÙÚ#ˆÇÛÜ#ˆÇÝÜ#ˆÇÞß#ˆÇàá#ˆÇâá#ˆÇãä#ˆÇåä#ˆÇæç#ˆÇèé#ˆ)À‡" [put electric-help-undefined suppress-keymap t electric-help-map make-keymap map define-key "" [67108912] [67108913] [67108914] [67108915] [67108916] [67108917] [67108918] [67108919] [67108920] [67108921] char-to-string help-char electric-help-help "?" " " scroll-up "" scroll-down "." beginning-of-buffer "<" ">" end-of-buffer "q" electric-help-exit "Q" "r" electric-help-retain "R" "x" electric-help-execute-extended "" electric-help-ctrl-x-prefix] 4) #@146 `with-electric-help' temporarily places its buffer in this mode. (On exit from `with-electric-help', the buffer is put in `default-major-mode'.) (defalias 'electric-help-mode #[nil "ÀÂÄÆÈ !ˆÊ‰ ‡" [t buffer-read-only "Help" mode-name help major-mode (" Help: %b") mode-line-buffer-identification use-local-map electric-help-map (electric-help-retain) mouse-leave-buffer-hook] 2 (#$ . 1280)]) #@1159 Pop up an "electric" help buffer. The arguments are THUNK &optional BUFFER NOERASE MINHEIGHT. THUNK is a function of no arguments which is called to initialize the contents of BUFFER. BUFFER defaults to `*Help*'. BUFFER will be erased before THUNK is called unless NOERASE is non-nil. THUNK will be called while BUFFER is current and with `standard-output' bound to the buffer specified by BUFFER. If THUNK returns nil, we display BUFFER starting at the top, and shrink the window to fit. If THUNK returns non-nil, we don't do those things. After THUNK has been called, this function "electrically" pops up a window in which BUFFER is displayed and allows the user to scroll through that buffer in electric-help-mode. The window's height will be at least MINHEIGHT if this value is non-nil. If THUNK returns nil, we display BUFFER starting at the top, and shrink the window to fit. If THUNK returns non-nil, we don't do those things. When the user exits (with `electric-help-exit', or otherwise) the help buffer's window disappears (i.e., we use `save-window-excursion') BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit. (defalias 'with-electric-help #[(thunk &optional buffer noerase minheight) "À †Â!ÃÄ!ŠƉ \nËŽŠ\nƒ%ÌÍ !bˆÄÏ !ˆ)Š qˆƒFÑ WƒFÒÑ Z!ˆÓ ˆ„QÕ ˆ)  „o qˆØÆ!ˆebˆ\nƒoÙÍ !ˆ) qˆÚÛ!ˆÜ ¢Ý=ƒ‡Å ‰ ‚‹Ä‰.‡" [get-buffer-create buffer "*Help*" one-window-p t current-window-configuration nil to-be-executed bury config one ((byte-code "ÀÁ!ˆ\nqˆÃÃÅƈÇ!ˆ ƒ Ê\n!ˆË\n!ˆÌ !‡" [message "" buffer nil buffer-read-only (byte-code "†Á ‡" [default-major-mode fundamental-mode] 1) ((error)) set-window-configuration config bury replace-buffer-in-windows bury-buffer eval to-be-executed] 3)) window-start selected-window pop-up-windows pop-to-buffer minheight window-height enlarge-window electric-help-mode noerase erase-buffer standard-output thunk set-buffer-modified-p shrink-window-if-larger-than-buffer run-hooks electric-help-mode-hook electric-help-command-loop retain] 4 (#$ . 1687)]) (defalias 'electric-help-command-loop #[nil "ÀÁ‡" [exit (byte-code "Àd!ƒÁÂÃ!!ˆÄ C‰ÆšƒÇÈÉÊ\"ˆÇ‰‰‰ËÌ!Í=…>ËÎ!Ï=…>ËÐ!Ñ=…>ËÒ!Ó=ÙÉÚÊ#-‡" [pos-visible-in-window-p message substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>" read-event unread-command-events (32) nil throw exit t key-binding " " scroll-up "" scroll-down "q" electric-help-exit "r" electric-help-retain standard neither both down up Electric-command-loop #[nil "ÀÁ!ˆÂe!Âd! ƒÆ‚}\fƒ3 ƒ3ƒ%È‚} †}ÊË!‰ ‚}\fƒNƒ@Ì‚} †}ÊÎ!‰ ‚} ƒiƒ[Ï‚}†}ÊÑ!‰‚}ƒrÒ‚}†}ÊÔ!‰*‡" [sit-for 0 pos-visible-in-window-p max min isearch-mode noprompt standard "Press q to exit, r to retain " neither substitute-command-keys "Press \\[electric-help-exit] to exit, \\[electric-help-retain] to retain " "Press SPC to scroll, q to exit, r to retain " up "Press \\[scroll-up] to scroll, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain " "Press DEL to scroll back, q to exit, r to retain " down "Press \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain " "Press SPC to scroll, DEL to scroll back, q to exit, r to retain " both "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain "] 3]] 6)] 2]) #@8 >>>Doc (defalias 'electric-help-exit #[nil "ÀÁÂ\"‡" [throw exit t] 3 (#$ . 5138) nil]) #@173 Exit `electric-help', retaining the current window/buffer configuration. (The *Help* buffer will not be selected, but \[switch-to-buffer-other-window] RET will select it.) (defalias 'electric-help-retain #[nil "…\nÁÂÃÄ\"‡" [mouse-leave-buffer-hook nil throw exit (retain)] 3 (#$ . 5232) nil]) (defalias 'electric-help-undefined #[nil "ÀÁÂÃÄ Å#ÆÇ!È=ƒÇ‚ÉÊ!#‡" [error "%s is undefined -- Press %s to exit" mapconcat single-key-description this-command-keys " " key-binding "q" electric-help-exit substitute-command-keys "\\[electric-help-exit]"] 6 nil nil]) (defalias 'electric-help-help #[nil "ÀÁ!Â=ƒ'ÀÃ!Ä=ƒ'ÀÅ!Æ=ƒ'ÀÇ!È=ƒ'ÉÊ!ˆ‚.ÉËÌÍ!\"ˆÎÏ!‡" [key-binding "q" electric-help-exit " " scroll-up "" scroll-down "r" electric-help-retain message "SPC scrolls up, DEL scrolls down, q exits burying help buffer, r exits" "%s" substitute-command-keys "\\[scroll-up] scrolls up, \\[scroll-down] scrolls down, \\[electric-help-exit] exits burying help buffer, \\[electric-help-retain] exits" sit-for 2] 4 nil nil]) (defalias 'electric-helpify #[(fun) "À‹…\fÃÄ Å#)‡" ["*Help*" name ((byte-code "ÀK !Å\f!\fƒÇ\f!„ÈÉŽÊËÌÍ!!\"ˆ\fƒ1Š\fqˆÏÐ!ˆ)ÀÑMˆÒ!ˆÂ !…ZÇ !!…Z\f?†Z\f !=?†ZÅ\f!?,‡" [print-help-return-message p get-buffer name b buffer-modified-p m get-buffer-window nil ((byte-code "À Mˆ\nƒÃ\n!ƒŠ\nqˆÄ !ˆ)À‡" [print-help-return-message p b buffer-name set-buffer-modified-p m] 2)) message "%s..." capitalize symbol-name fun set-buffer-modified-p t ignore call-interactively] 5)) with-electric-help ignore t] 4]) (defalias 'electric-help-execute-extended #[(prefixarg) "À ‡" [(execute-extended-command nil) to-be-executed electric-help-retain] 1 nil "p"]) (defalias 'electric-help-ctrl-x-prefix #[(prefixarg) "À ‡" [(progn (message nil) (setq unread-command-char 24)) to-be-executed electric-help-retain] 1 nil "p"]) (defalias 'electric-describe-key #[nil "ÀÁ!‡" [electric-helpify describe-key] 2 nil nil]) (defalias 'electric-describe-mode #[nil "ÀÁ!‡" [electric-helpify describe-mode] 2 nil nil]) (defalias 'electric-view-lossage #[nil "ÀÁ!‡" [electric-helpify view-lossage] 2 nil nil]) (defalias 'electric-describe-function #[nil "ÀÁ!‡" [electric-helpify describe-function] 2 nil nil]) (defalias 'electric-describe-variable #[nil "ÀÁ!‡" [electric-helpify describe-variable] 2 nil nil]) (defalias 'electric-describe-bindings #[nil "ÀÁ!‡" [electric-helpify describe-bindings] 2 nil nil]) (defalias 'electric-describe-syntax #[nil "ÀÁ!‡" [electric-helpify describe-syntax] 2 nil nil]) (defalias 'electric-command-apropos #[nil "ÀÁ!‡" [electric-helpify command-apropos] 2 nil nil]) (defalias 'electric-apropos #[nil "ÀÁ!‡" [electric-helpify apropos] 2 nil nil]) (byte-code "ÀÁ!„ÂÁ B „]Ä !ÇÈÉ#ˆÇÊË#ˆÇÌÍ#ˆÇÎÏ#ˆÇÐÑ#ˆÇÒÓ#ˆÇÔÕ#ˆÇÖ×#ˆÇØÙ#ˆÚMˆ)ÛÜ!‡" [boundp ehelp-map nil current-load-list copy-keymap help-map map substitute-key-definition apropos electric-apropos command-apropos electric-command-apropos describe-key electric-describe-key describe-mode electric-describe-mode view-lossage electric-view-lossage describe-function electric-describe-function describe-variable electric-describe-variable describe-bindings electric-describe-bindings describe-syntax electric-describe-syntax ehelp-command provide ehelp] 4) emacs-19.30/lisp/elp.elc100666 12120 1 21445 5744575700 13365 0ustar rmsdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:37:34 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/elp.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/elp.el' was compiled for Emacs 19")) #@31 *List of function to profile. (defvar elp-function-list nil (#$ . -475)) #@124 *Non-nil means reset all profiling info after results are displayed. Results are displayed with the `elp-results' command. (defvar elp-reset-after-results t (#$ . -555)) #@641 *Non-nil specifies elp results sorting function. These functions are currently available: elp-sort-by-call-count -- sort by the highest call count elp-sort-by-total-time -- sort by the highest total time elp-sort-by-average-time -- sort by the highest average times You can write you're own sort function. It should adhere to the interface specified by the PRED argument for the `sort' defun. Each "element of LIST" is really a 4 element vector where element 0 is the call count, element 1 is the total time spent in the function, element 2 is the average time spent in the function, and element 3 is the symbol's name string. (defvar elp-sort-by-function nil (#$ . -732)) #@230 *Prevents some functions from being displayed in the results buffer. If a number, no function that has been called fewer than that number of times will be displayed in the output buffer. If nil, all functions will be displayed. (defvar elp-report-limit nil (#$ . -1425)) #@21 ELP version number. (defconst elp-version "2.23" (#$ . 1703)) #@61 Address accepting submissions of bug reports and questions. (defconst elp-help-address "tools-help@anthem.nlm.nih.gov" (#$ . 1771)) #@47 Buffer name for outputting profiling results. (defvar elp-results-buffer "*ELP Profiling Results*" (#$ . 1909)) #@32 ELP information property name. (defconst elp-timer-info-property (quote elp-info) (#$ . 2027)) #@53 List of all functions currently being instrumented. (defvar elp-all-instrumented-list nil (#$ . 2128)) #@101 Controls whether functions should record times or not. This variable is set by the master function. (defvar elp-record-p t (#$ . 2238)) #@25 Master function symbol. (defvar elp-master nil (#$ . 2380)) #@81 Instrument FUNSYM for profiling. FUNSYM must be a symbol of a defined function. (defalias 'elp-instrument-function #[(funsym) "KÂÉ #Å ¢Ç=ƒÈÉ\"ˆÊ!ƒ%ËÌ\"ËÍÎDÏÐÊ!??EÑFC\"Ò\f#ˆMˆ>†TB‰+‡" [funsym funguts vector 0 infovec (lambda (&rest args)) newguts macro error "ELP cannot profile macro %s" commandp append ((interactive)) elp-wrapper quote and (interactive-p) args put elp-timer-info-property elp-all-instrumented-list] 8 (#$ . 2446) "aFunction to instrument: "]) #@115 Restore an instrumented function to its original definition. Argument FUNSYM is the symbol of a defined function. (defalias 'elp-restore-function #[(funsym) " NÃ\f\" =ƒÆÇÉ Æ#ˆ\n…*ÊKž…*\nËHM)‡" [funsym elp-timer-info-property info delq elp-all-instrumented-list elp-master nil t elp-record-p put elp-wrapper 2] 4 (#$ . 2951) "aFunction to restore: "]) #@104 Instrument for profiling, all functions in `elp-function-list'. Use optional LIST if provided instead. (defalias 'elp-instrument-list #[(&optional list) "† ÂÃ\")‡" [list elp-function-list mapcar elp-instrument-function] 3 (#$ . 3324) "PList of functions to instrument: "]) #@174 Instrument for profiling, all functions which start with PREFIX. For example, to instrument all ELP functions, do the following: \[elp-instrument-package] RET elp- RET (defalias 'elp-instrument-package #[(prefix) "ÀÁÂÃ\f Æ#\"!‡" [elp-instrument-list mapcar intern all-completions prefix obarray #[(sym) "À !…\f K¢Â=?‡" [fboundp sym macro] 2]] 7 (#$ . 3609) "sPrefix of package to instrument: "]) #@115 Restore the original definitions for all functions in `elp-function-list'. Use optional LIST if provided instead. (defalias 'elp-restore-list #[(&optional list) "† ÂÃ\")‡" [list elp-function-list mapcar elp-restore-function] 3 (#$ . 4018) "PList of functions to restore: "]) #@68 Restores the original definitions of all functions being profiled. (defalias 'elp-restore-all #[nil "À !‡" [elp-restore-list elp-all-instrumented-list] 2 (#$ . 4304) nil]) #@45 Reset the profiling information for FUNSYM. (defalias 'elp-reset-function #[(funsym) " N‰„ ÃÄ\"ˆ\nʼnIˆ\nÆÇI)‡" [funsym elp-timer-info-property info error "%s is not instrumented for profiling." 0 1 0.0] 4 (#$ . 4482) "aFunction to reset: "]) #@114 Reset the profiling information for all functions in `elp-function-list'. Use optional LIST if provided instead. (defalias 'elp-reset-list #[(&optional list) "† ÂÃ\")‡" [list elp-function-list mapcar elp-reset-function] 3 (#$ . 4735) "PList of functions to reset: "]) #@67 Reset the profiling information for all functions being profiled. (defalias 'elp-reset-all #[nil "À !‡" [elp-reset-list elp-all-instrumented-list] 2 (#$ . 5014) nil]) #@40 Set the master function for profiling. (defalias 'elp-set-master #[(funsym) "Â\f>† Å!‡" [funsym elp-master nil elp-record-p elp-all-instrumented-list elp-instrument-function] 2 (#$ . 5187) "aMaster function: "]) #@29 Unsets the master function. (defalias 'elp-unset-master #[nil "À‰‡" [nil elp-master t elp-record-p] 2 (#$ . 5411) nil]) (defalias 'elp-get-time #[nil "À  A@!Âà 8!Ä¥\\)‡" [current-time now float 2 1000000.0] 4]) (put (quote elp-get-time) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@199 This function has been instrumented for profiling by the ELP. ELP is the Emacs Lisp Profiler. To restore the function to its original definition, use \[elp-restore-function] or \[elp-restore-all]. (defalias 'elp-wrapper #[(funsym interactive-p args) "ƒ\f =ƒ\f \fN‰ÆHÈ „\"ÊË \"ˆ „=\fƒ2Í!‚8Î\" ‚Ð ÒA@!ÒÆ8!Ó¥\\) Õ ÕHTIˆ\fƒgÍ!‚mÎ\" Ö ÖHÐ ÒA@!ÒÆ8!Ó¥\\)Z\\Iˆ)ƒ› =ƒ›È +‡" [elp-master funsym t elp-record-p elp-timer-info-property info 2 func nil result error "%s is not instrumented for profiling." interactive-p call-interactively apply args current-time now float 1000000.0 enter-time 0 1] 8 (#$ . 5719)]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ B‡" [boundp elp-field-len nil current-load-list elp-cc-len elp-at-len elp-et-len] 2) (defalias 'elp-sort-by-call-count #[(vec1 vec2) "ÁH\nÁHY‡" [vec1 0 vec2] 3]) (defalias 'elp-sort-by-total-time #[(vec1 vec2) "ÁH\nÁHY‡" [vec1 1 vec2] 3]) (defalias 'elp-sort-by-average-time #[(vec1 vec2) "ÁH\nÁHY‡" [vec1 2 vec2] 3]) (defalias 'elp-pack-number #[(number width) "G Xƒ ‡ÂÃ\"ƒ+ĔĕOÅ Æ•ZÆ”[ZÇZOÈƔƕOQ‡Å O°‡" [number width string-match "^\\(.*\\)\\(e[+-].*\\)$" 1 0 2 3 "..."] 5]) (put (quote elp-pack-number) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'elp-output-result #[(resultvec) "ÁHÃHÅHÇHÉ\nÉ É\fÍ\n!\nÍ\f! Í!\f…:§…:\nW?…cˆÏÐG[Å\\\\\"ˆ\ncˆÏÐ\nG[Å\\\\\"ˆ ‰GXƒu‚¥Ö×\"ƒÔÕOÁÅ•ZÅ”[ZÇZOØŔŕOQ‚¥ÁO°*\f‰GXƒ»‚ëÖ×\"ƒãÔÕOÁÅ•ZÅ”[ZÇZOØŔŕOQ‚ëÁO°*‰cˆÏÐG[Å\\\\\"ˆcˆ*Üc.‡" [resultvec 0 cc 1 tt 2 at 3 symname nil callcnt totaltime avetime number-to-string elp-report-limit insert-char 32 elp-field-len elp-cc-len elp-et-len width number string-match "^\\(.*\\)\\(e[+-].*\\)$" "..." elp-at-len atstr ttstr "\n"] 7]) #@182 Display current profiling results. If `elp-reset-after-results' is non-nil, then current profiling information for all instrumented functions are reset after results are displayed. (defalias 'elp-results #[nil "pÀ !\nqˆÄ ˆÅ ˆÆÈ ÈG‰\n Ì ÌGÏÏGÒÒGÕÖ\" cˆ\nVƒQÙÚ\nZ\"ˆ Û ÛÛܱˆÙÝ \"ˆÛcˆÙÝ\"ˆÛcˆÙÝ\"ˆÛcˆÙÝ\"ˆÜcˆƒß\"Õà\"ˆ. qˆá\n!ˆ\"…¥ã *‡" [get-buffer-create elp-results-buffer resultsbuf curbuf erase-buffer beginning-of-buffer 0 longest "Function Name" title titlelen elp-field-len "Call Count" cc-header elp-cc-len "Elapsed Time" et-header elp-et-len "Average Time" at-header elp-at-len mapcar #[(funsym) " NÃÄ\"\nÆH\nÈH \n„Ê ±‚@ G] Ì ÆUƒ5Í‚>Î !Î!¥ $,‡" [funsym elp-timer-info-property info format "%s" symname 0 cc 1 tt "No profiling information found for: " longest vector 0.0 float] 6] elp-all-instrumented-list resvec insert-char 32 " " "\n" 61 elp-sort-by-function sort elp-output-result pop-to-buffer elp-reset-after-results elp-reset-all] 8 (#$ . 7602) nil]) #@39 Submit via mail, a bug report on elp. (defalias 'elp-submit-bug-report #[nil "ÀÁ!…ÂÃ!…Ä ÆPÈ#‡" [y-or-n-p "Do you want to submit a report on elp? " require reporter reporter-submit-bug-report elp-help-address "elp " elp-version (elp-report-limit elp-reset-after-results elp-sort-by-function)] 4 (#$ . 8656) nil]) (provide (quote elp)) emacs-19.30/lisp/electric.elc100666 13437 1 4632 6043465245 14505 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:49:37 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/electric.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`electric.el' was compiled for Emacs 19.29 or later")) (defalias 'Electric-command-loop #[(return-tag &optional prompt inhibit-quit loop-function loop-state) "À‰  ;„ À=„ Å=„ \n;„,\nÅ=ƒ*À‚,ÆÇ\n!‰‰GSHÉ\f!‰\n À „M\fÍ=ƒrÀÀÐ GÑU„`„pÓ ˆÔÕ!ˆÖÀ\"ˆ‚rÀ\fƒ‚ÙÚÛˆ‚…Ó ˆƒ \"ˆ‚" [nil prompt prompt-string err cmd noprompt "->" read-key-sequence last-command-char key-binding this-command quit-flag last-input-char 7 unread-command-events prefix-arg this-command-keys 1 inhibit-quit ding message "Quit" throw return-tag current-prefix-arg conditions (byte-code "À !ˆ\n\fÅ„Ç=ƒ.Å „+Ê ˆËÌ!ˆÍÅ\"ˆ‚.Ê ˆÅ‡" [command-execute cmd this-command last-command quit-flag nil last-input-char 7 unread-command-events inhibit-quit ding message "Quit" throw return-tag] 3) ((buffer-read-only (byte-code "ƒ ‚à ˆÄÅ!ˆÆÇ!ˆÃ‡" [loop-function conditions err ding message "Buffer is read-only" sit-for 2] 2)) (beginning-of-buffer (byte-code "ƒ ‚à ˆÄÅ!ˆÆÇ!ˆÃ‡" [loop-function conditions err ding message "Beginning of Buffer" sit-for 2] 2)) (end-of-buffer (byte-code "ƒ ‚à ˆÄÅ!ˆÆÇ!ˆÃ‡" [loop-function conditions err ding message "End of Buffer" sit-for 2] 2)) (error (byte-code "ƒ ‚$à ˆÄÅ @Æ=ƒ A@‚Ç !\"ˆÈÉ!ˆÃ‡" [loop-function conditions err ding message "Error: %s" error prin1-to-string sit-for 2] 4))) loop-function loop-state] 4]) (defalias 'Electric-pop-up-window #[(buffer &optional max-height) "À !† Ä !ÆÇ!Ç Ê Ê\f „&ÍÎ \"‚›Š qˆÏed\"\fƒ>\fT^‚A\fT]Ò‹^ )Ó ! =ƒYÔ !ˆ‚zƒvÕ !bˆÖ !ˆÂ × Ø !Z!ˆ‚zÙ !ˆ„— Ø !Vƒ—Õ !bˆ× Ø !Z!ˆebˆ .‡" [get-buffer-window buffer selected-window win get-buffer buf one-window-p t one-window pop-up-windows nil target-height lines error "Buffer %s does not exist" count-lines max-height window-min-height ((byte-code "À ˆÁ !S‡" [delete-other-windows window-height selected-window] 2)) window-buffer select-window window-start pop-to-buffer enlarge-window window-height switch-to-buffer] 4]) (provide (quote electric)) emacs-19.30/lisp/emacsbug.elc100666 13437 1 4101 6043465251 14465 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:49:42 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/emacsbug.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`emacsbug.el' was compiled for Emacs 19.29 or later")) (require (quote sendmail)) #@62 Address of site maintaining mailing list for GNU Emacs bugs. (defvar bug-gnu-emacs "bug-gnu-emacs@prep.ai.mit.edu" (#$ . 510)) #@55 The automatically-created initial text of bug report. (defvar report-emacs-bug-orig-text nil (#$ . 643)) #@83 Report a bug in GNU Emacs. Prompts for bug subject. Leaves you in a mail buffer. (defalias 'report-emacs-bug #[(topic) "ÀÁ\n #ˆebˆÄÅÆ!ÈQ!ˆÉÊ È±ˆ ƒ- Ìš„-Í αˆÈcˆÏÐ Ñ ¤!ˆÒÑ ÓÔ#ˆÕÖ×Ø!!ˆÙ ˆÖ×Ú!!‘ˆÛÜ!ˆÝÜÞ\"ˆŠdbˆßÁxˆÛà!ˆe`{‰ )‡" [mail nil bug-gnu-emacs topic re-search-forward "^" regexp-quote mail-header-separator "\n" "In " emacs-version system-configuration-options "" "configured using `configure " "'\n" use-local-map make-sparse-keymap current-local-map define-key " " report-emacs-bug-info "*Bug Help*" princ substitute-command-keys "Type \\[mail-send-and-exit] to send the bug report.\n" terpri "Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section\nabout when and how to write a bug report,\nand what information to supply so that the bug can be fixed.\nType SPC to scroll through this section and its subsections." make-local-variable mail-send-hook add-hook report-emacs-bug-hook " \n" report-emacs-bug-orig-text] 4 (#$ . 754) "sBug Subject: "]) #@46 Go to the Info node on reporting Emacs bugs. (defalias 'report-emacs-bug-info #[nil "À ˆÁ ˆÂÃ!ˆÄÅ!‡" [info Info-directory Info-menu "emacs" Info-goto-node "Bugs"] 2 (#$ . 1746) nil]) (defalias 'report-emacs-bug-hook #[nil "ŠdbˆÀÁxˆ`eZ\nGU…e`{\nš…ÃÄ!)‡" [" \n" nil report-emacs-bug-orig-text error "No text entered in bug report"] 2]) (provide (quote emacsbug)) emacs-19.30/lisp/emerge.elc100666 13437 1 213471 5747270073 14225 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue Apr 25 17:56:31 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/emerge.el ;;; emacs version 19.28.90.40. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/emerge.el' was compiled for Emacs 19")) (byte-code "ÀÁ!„\nÂÃ!Á\fBÁ‰JMˆÅ ÆÇ#ˆÅ ÈÉ#ˆÅ ÊË#ˆÅ ÌÍ#ˆÅ ÎÏ#ˆÅ ÐÑ#ˆÅ ÒÓ#‡" [boundp menu-bar-emerge-menu make-sparse-keymap "Emerge" current-load-list define-key [emerge-merge-directories] ("Merge Directories ..." . emerge-merge-directories) [emerge-revisions-with-ancestor] ("Revisions with Ancestor ..." . emerge-revisions-with-ancestor) [emerge-revisions] ("Revisions ..." . emerge-revisions) [emerge-files-with-ancestor] ("Files with Ancestor ..." . emerge-files-with-ancestor) [emerge-files] ("Files ..." . emerge-files) [emerge-buffers-with-ancestor] ("Buffers with Ancestor ..." . emerge-buffers-with-ancestor) [emerge-buffers] ("Buffers ..." . emerge-buffers)] 4) #@146 Macro to switch to BUFFER, evaluate FORMS, returns to original buffer. Differs from `save-excursion' in that it doesn't save the point and mark. (defalias 'emerge-eval-in-buffer '(macro . #[(buffer &rest forms) "ÀÁÂÃÄ DBBÇBBE‡" [let ((StartBuffer (current-buffer))) unwind-protect progn set-buffer buffer forms ((set-buffer StartBuffer))] 6 (#$ . 1155)])) #@277 Defines SYMBOL as an advertised variable. Performs a defvar, then executes `make-variable-buffer-local' on the variable. Also sets the `preserved' property, so that `kill-all-local-variables' (called by major-mode setting commands) won't destroy Emerge control variables. (defalias 'emerge-defvar-local '(macro . #[(var value doc) "ÀÁ\n \fFÅÆ\nDDÇÆ\nDÈBBF‡" [progn defvar var value doc make-variable-buffer-local quote put ((quote preserved) t)] 6 (#$ . 1520)])) (byte-code "ÀÁ!„ÂÁ BÄ ž„Æ \"À‡" [boundp emerge-minor-modes-list ((emerge-mode " Emerge") (emerge-fast-mode " F") (emerge-edit-mode " E") (emerge-auto-advance " A") (emerge-skip-prefers " S")) current-load-list emerge-mode minor-mode-alist append] 3) #@491 Emerge mode is used by the Emerge file-merging package. It is entered only through one of the functions: `emerge-files' `emerge-files-with-ancestor' `emerge-buffers' `emerge-buffers-with-ancestor' `emerge-files-command' `emerge-files-with-ancestor-command' `emerge-files-remote' `emerge-files-with-ancestor-remote' Commands: \{emerge-basic-keymap} Commands must be prefixed by \\[emerge-basic-keymap] in `edit' mode, but can be invoked directly in `fast' mode. (defalias 'emerge-mode #[nil "À‡" [nil] 1 (#$ . 2252)]) #@24 The version of Emerge. (defvar emerge-version "5fsf" (#$ . 2804)) #@98 Return string describing the version of Emerge. When called interactively, displays the version. (defalias 'emerge-version #[nil "tƒ\nÀÁ \"‡\n‡" [message "Emerge version %s" emerge-version] 3 (#$ . 2876) nil]) #@48 *Name of the program which compares two files. (defvar emerge-diff-program "diff" (#$ . -3094)) #@113 *Name of the program which compares three files. Its arguments are the ancestor file and the two variant files. (defvar emerge-diff3-program "diff3" (#$ . -3197)) #@71 *Options to pass to `emerge-diff-program' and `emerge-diff3-program'. (defvar emerge-diff-options "" (#$ . -3366)) #@120 *Pattern to match lines produced by diff that describe differences. This is as opposed to lines from the source files. (defvar emerge-match-diff-line (byte-code "À à İ)‡" ["\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)" x "^" "\\([acd]\\)" "$"] 5) (#$ . -3488)) #@128 *Regexp that matches normal output lines from `emerge-diff-program'. Lines that do not match are assumed to be error messages. (defvar emerge-diff-ok-lines-regexp "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\)" (#$ . -3750)) #@129 *Regexp that matches normal output lines from `emerge-diff3-program'. Lines that do not match are assumed to be error messages. (defvar emerge-diff3-ok-lines-regexp "^\\([1-3]:\\|====\\| \\)" (#$ . -3978)) #@52 *Name of the program that checks in RCS revisions. (defvar emerge-rcs-ci-program "ci" (#$ . -4191)) #@53 *Name of the program that checks out RCS revisions. (defvar emerge-rcs-co-program "co" (#$ . -4297)) #@174 *Non-nil if Emerge should process local-variables lists in merge buffers. (You can explicitly request processing the local-variables by executing `(hack-local-variables)'.) (defvar emerge-process-local-variables nil (#$ . -4405)) #@339 *If non-nil: `emerge-execute-line' makes no output if an input was deleted. It concludes that an input version has been deleted when an ancestor entry is present, only one A or B entry is present, and an output entry is present. If nil: In such circumstances, the A or B file that is present will be copied to the designated output file. (defvar emerge-execute-line-deletions nil (#$ . -4642)) #@161 *Flag placed above the highlighted block of code. Must end with newline. Must be set before Emerge is loaded, or emerge-new-flags must be run after setting. (defvar emerge-before-flag "vvvvvvvvvvvvvvvvvvvv\n" (#$ . -5043)) #@161 *Flag placed below the highlighted block of code. Must end with newline. Must be set before Emerge is loaded, or emerge-new-flags must be run after setting. (defvar emerge-after-flag "^^^^^^^^^^^^^^^^^^^^\n" (#$ . -5276)) #@67 *Hook to run in the merge buffer after the merge has been set up. (defvar emerge-startup-hook nil (#$ . -5507)) #@116 *Hook to run after a difference has been selected. The variable `n' holds the (internal) number of the difference. (defvar emerge-select-hook nil (#$ . -5626)) #@118 *Hook to run after a difference has been unselected. The variable `n' holds the (internal) number of the difference. (defvar emerge-unselect-hook nil (#$ . -5793)) #@189 *If nil, default dir for filenames in emerge is `default-directory'. If non-nil, filenames complete in the directory of the last argument of the same type to an `emerge-files...' command. (defvar emerge-default-last-directories nil (#$ . -5964)) #@68 Last directory for the first file of an `emerge-files...' command. (defvar emerge-last-dir-A nil (#$ . 6216)) #@69 Last directory for the second file of an `emerge-files...' command. (defvar emerge-last-dir-B nil (#$ . 6332)) #@71 Last directory for the ancestor file of an `emerge-files...' command. (defvar emerge-last-dir-ancestor nil (#$ . 6449)) #@69 Last directory for the output file of an `emerge-files...' command. (defvar emerge-last-dir-output nil (#$ . 6575)) #@76 Last RCS revision used for first file of an `emerge-revisions...' command. (defvar emerge-last-revision-A nil (#$ . 6697)) #@77 Last RCS revision used for second file of an `emerge-revisions...' command. (defvar emerge-last-revision-B nil (#$ . 6826)) #@79 Last RCS revision used for ancestor file of an `emerge-revisions...' command. (defvar emerge-last-revision-ancestor nil (#$ . 6956)) (byte-code "À B Bà BÄ BÅ BÆ BÇ BÈ BÉ BÊ BË BÌ BÍ BÀ‡" [emerge-before-flag-length current-load-list emerge-before-flag-lines emerge-before-flag-match emerge-after-flag-length emerge-after-flag-lines emerge-after-flag-match emerge-diff-buffer emerge-diff-error-buffer emerge-prefix-argument emerge-file-out emerge-exit-func emerge-globalized-difference-list emerge-globalized-number-of-differences] 2) #@152 Function to be called after `emerge-{before,after}-flag'. This is called after these functions are changed to compute values that depend on the flags. (defalias 'emerge-new-flags #[nil "GÂÃ\"Å!GÂÃ\" Å!‰\n‡" [emerge-before-flag emerge-before-flag-length emerge-count-matches-string "\n" emerge-before-flag-lines regexp-quote emerge-before-flag-match emerge-after-flag emerge-after-flag-length emerge-after-flag-lines emerge-after-flag-match] 3 (#$ . 7510)]) #@52 Return the number of matches in STRING for REGEXP. (defalias 'emerge-count-matches-string #[(string regexp) "À‰Ã\f \n#ƒ TÀ•‚ *‡" [0 count i string-match regexp string] 4 (#$ . 7990)]) (emerge-new-flags) #@102 *Number of lines that we want to show above and below the flags when we are displaying a difference. (defvar emerge-min-visible-lines 3 (#$ . -8208)) #@89 *Prefix to put on Emerge temporary file names. Do not start with `~/' or `~user-name/'. (defvar emerge-temp-file-prefix (byte-code "ÀÁ!†ÀÂ!†ÀÃ!ĉƒ$GÇVƒ$‚%ȉ‰GSHÉUƒ5 ÇÊO ËP*‡" [getenv "TMPDIR" "TMP" "TEMP" nil d env 0 "/tmp" 47 -1 "/emerge"] 4) (#$ . -8364)) #@35 *Mode for Emerge temporary files. (defvar emerge-temp-file-mode 384 (#$ . -8645)) #@428 *Template for `emerge-combine-versions' to combine the two versions. The template is inserted as a string, with the following interpolations: %a the A version of the difference %b the B version of the difference %% the character `%' Don't forget to end the template with a newline. Note that this variable can be made local to a particular merge buffer by giving a prefix argument to `emerge-set-combine-versions-template'. (defvar emerge-combine-versions-template "#ifdef NEW\n%b#else /* NEW */\n%a#endif /* NEW */\n" (#$ . -8734)) #@143 Keymap of Emerge commands. Directly available in `fast' mode; must be prefixed by \\[emerge-basic-keymap] in `edit' mode. (defvar emerge-basic-keymap nil (#$ . 9277)) #@84 Local keymap used in Emerge `fast' mode. Makes Emerge commands directly available. (defvar emerge-fast-keymap nil (#$ . 9470)) (byte-code "ÀÁ!„\nÂÃ!Á\fBÀÅ!„ÂÆ!Å\fBÀÇ!„'ÂÈ!Ç\fBÀ‡" [boundp emerge-options-menu make-sparse-keymap "Options" current-load-list emerge-merge-menu "Merge" emerge-move-menu "Move"] 2) #@90 *Command prefix for Emerge commands in `edit' mode. Must be set before Emerge is loaded. (defvar emerge-command-prefix "" (#$ . -9795)) (defalias 'emerge-setup-fixed-keymaps #[nil "À  !ˆÃ ÄÅ#ˆÃ ÆÇ#ˆÃ ÈÉ#ˆÃ ÊË#ˆÃ ÌÍ#ˆÃ ÎÏ#ˆÃ ÐÑ#ˆÃ ÒÓ#ˆÃ ÔÕ#ˆÃ Ö×#ˆÃ ØÙ#ˆÃ ÚÛ#ˆÃ ÜÝ#ˆÃ Þß#ˆÃ àÙ#ˆÃ áâ#ˆÃ ãä#ˆÃ åÙ#ˆÃ æç#ˆÃ èé#ˆÃ êÙ#ˆÃ ëì#ˆÃ íî#ˆÃ ïð#ˆÃ ñò#ˆÃ óô#ˆÃ õö#ˆÃ ÷ø#ˆÃ ùú#ˆÃ ûÙ#ˆÃ üý#ˆÃ þÿ#ˆÃ @A#ˆÃ BC#ˆÃ DE#ˆÃ FG#ˆÃ HI#ˆÃ JK#ˆÃ LM#ˆÃ NO#ˆÁ MˆP !QÃQRÁ#ˆQQMˆSTUQV $ˆSWXQV $ˆÃ YZ #ˆÃQ[\\]B#ˆÃQ^_`B#ˆÃQabcB#ˆÃcde#ˆÃcfg#ˆÃchi#ˆÃcjk#ˆÃclm#ˆÃcno#ˆÃcpq#ˆÃcrs#ˆÃctu#ˆÃcvw#ˆÃcxy#ˆÃ]z{#ˆÃ]|}#ˆÃ]~#ˆÃ]€#ˆÃ]‚ƒ#ˆÃ]„…#ˆÃ]†‡#ˆÃ]ˆ‰#ˆÃ]Š‹#ˆÃ`Œ#ˆÃ`Ž#ˆÃ`‘#ˆÃ`’“#ˆÃ`”•#ˆÃ`–—#ˆÃ`˜™#ˆÃ`š›#ˆÃ`œ#ˆÃ`žŸ#ˆÃ` ¡#ˆÃ`¢£#‡" [make-keymap emerge-basic-keymap suppress-keymap define-key "p" emerge-previous-difference "n" emerge-next-difference "a" emerge-select-A "b" emerge-select-B "j" emerge-jump-to-difference "." emerge-find-difference "q" emerge-quit "" emerge-abort "f" emerge-fast-mode "e" emerge-edit-mode "s" nil "sa" emerge-auto-advance "ss" emerge-skip-prefers "l" emerge-recenter "d" "da" emerge-default-A "db" emerge-default-B "c" "ca" emerge-copy-as-kill-A "cb" emerge-copy-as-kill-B "i" "ia" emerge-insert-A "ib" emerge-insert-B "m" emerge-mark-difference "v" emerge-scroll-up "^" emerge-scroll-down "<" emerge-scroll-left ">" emerge-scroll-right "|" emerge-scroll-reset "x" "x1" emerge-one-line-window "xc" emerge-combine-versions "xC" emerge-combine-versions-register "xf" emerge-file-names "xj" emerge-join-differences "xl" emerge-line-numbers "xm" emerge-set-merge-mode "xs" emerge-split-difference "xt" emerge-trim-difference "xx" emerge-set-combine-versions-template copy-keymap emerge-fast-keymap emerge-command-prefix substitute-key-definition write-file emerge-query-write-file current-global-map save-buffer emerge-query-save-buffer [menu-bar] make-sparse-keymap [menu-bar options] "Options" emerge-options-menu [menu-bar merge] "Merge" emerge-merge-menu [menu-bar move] "Move" emerge-move-menu [emerge-scroll-reset] ("Scroll Reset" . emerge-scroll-reset) [emerge-scroll-right] ("Scroll Right" . emerge-scroll-right) [emerge-scroll-left] ("Scroll Left" . emerge-scroll-left) [emerge-scroll-down] ("Scroll Down" . emerge-scroll-down) [emerge-scroll-up] ("Scroll Up" . emerge-scroll-up) [emerge-recenter] ("Recenter" . emerge-recenter) [emerge-mark-difference] ("Mark Difference" . emerge-mark-difference) [emerge-jump-to-difference] ("Jump To Difference" . emerge-jump-to-difference) [emerge-find-difference] ("Find Difference" . emerge-find-difference) [emerge-previous-difference] ("Previous Difference" . emerge-previous-difference) [emerge-next-difference] ("Next Difference" . emerge-next-difference) [emerge-one-line-window] ("One Line Window" . emerge-one-line-window) [emerge-set-merge-mode] ("Set Merge Mode" . emerge-set-merge-mode) [emerge-set-combine-template] ("Set Combine Template..." . emerge-set-combine-template) [emerge-default-B] ("Default B" . emerge-default-B) [emerge-default-A] ("Default A" . emerge-default-A) [emerge-skip-prefers] ("Skip Prefers" . emerge-skip-prefers) [emerge-auto-advance] ("Auto Advance" . emerge-auto-advance) [emerge-edit-mode] ("Edit Mode" . emerge-edit-mode) [emerge-fast-mode] ("Fast Mode" . emerge-fast-mode) [emerge-abort] ("Abort" . emerge-abort) [emerge-quit] ("Quit" . emerge-quit) [emerge-split-difference] ("Split Difference" . emerge-split-difference) [emerge-join-differences] ("Join Differences" . emerge-join-differences) [emerge-trim-difference] ("Trim Difference" . emerge-trim-difference) [emerge-combine-versions] ("Combine Versions" . emerge-combine-versions) [emerge-copy-as-kill-B] ("Copy B as Kill" . emerge-copy-as-kill-B) [emerge-copy-as-kill-A] ("Copy A as Kill" . emerge-copy-as-kill-A) [emerge-insert-B] ("Insert B" . emerge-insert-B) [emerge-insert-A] ("Insert A" . emerge-insert-A) [emerge-select-B] ("Select B" . emerge-select-B) [emerge-select-A] ("Select A" . emerge-select-A)] 5]) #@28 Indicator for emerge-mode. (defvar emerge-mode nil (#$ . 13993)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-mode put preserved t] 4) #@41 Indicator for emerge-mode fast submode. (defvar emerge-fast-mode nil (#$ . 14148)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-fast-mode put preserved t] 4) #@41 Indicator for emerge-mode edit submode. (defvar emerge-edit-mode nil (#$ . 14326)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-edit-mode put preserved t] 4) #@46 The buffer in which the A variant is stored. (defvar emerge-A-buffer nil (#$ . 14504)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-A-buffer put preserved t] 4) #@46 The buffer in which the B variant is stored. (defvar emerge-B-buffer nil (#$ . 14685)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-B-buffer put preserved t] 4) #@53 The buffer in which the merged file is manipulated. (defvar emerge-merge-buffer nil (#$ . 14866)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-merge-buffer put preserved t] 4) #@78 The buffer in which the ancestor variant is stored, or nil if there is none. (defvar emerge-ancestor-buffer nil (#$ . 15062)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-ancestor-buffer put preserved t] 4) #@93 Variables and properties of a buffer which are saved, modified and restored during a merge. (defconst emerge-saved-variables (quote ((buffer-modified-p set-buffer-modified-p) buffer-read-only buffer-auto-save-file-name)) (#$ . 15289)) #@65 Values to be assigned to emerge-saved-variables during a merge. (defconst emerge-merging-values (quote (nil t nil)) (#$ . 15530)) #@55 Remembers emerge-saved-variables for emerge-A-buffer. (defvar emerge-A-buffer-values nil (#$ . 15666)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-A-buffer-values put preserved t] 4) #@55 Remembers emerge-saved-variables for emerge-B-buffer. (defvar emerge-B-buffer-values nil (#$ . 15870)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-B-buffer-values put preserved t] 4) #@1405 Vector of differences between the variants, and markers in the buffers to show where they are. Each difference is represented by a vector of seven elements. The first two are markers to the beginning and end of the difference section in the A buffer, the second two are markers for the B buffer, the third two are markers for the merge buffer, and the last element is the "state" of that difference in the merge buffer. A section of a buffer is described by two markers, one to the beginning of the first line of the section, and one to the beginning of the first line after the section. (If the section is empty, both markers point to the same point.) If the section is part of the selected difference, then the markers are moved into the flags, so the user can edit the section without disturbing the markers. The "states" are: A the merge buffer currently contains the A variant B the merge buffer currently contains the B variant default-A the merge buffer contains the A variant by default, but this difference hasn't been selected yet, so change-default commands can alter it default-B the merge buffer contains the B variant by default, but this difference hasn't been selected yet, so change-default commands can alter it prefer-A in a three-file merge, the A variant is the preferred choice prefer-B in a three-file merge, the B variant is the preferred choice (defvar emerge-difference-list nil (#$ . 16076)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-difference-list put preserved t] 4) #@44 The difference that is currently selected. (defvar emerge-current-difference -1 (#$ . 17630)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-current-difference put preserved t] 4) #@30 Number of differences found. (defvar emerge-number-of-differences nil (#$ . 17828)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-number-of-differences put preserved t] 4) #@186 The local keymap for the merge buffer, with the emerge commands defined in it. Used to save the local keymap during fast mode, when the local keymap is replaced by emerge-fast-keymap. (defvar emerge-edit-keymap nil (#$ . 18020)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-edit-keymap put preserved t] 4) #@49 The original local keymap for the merge buffer. (defvar emerge-old-keymap nil (#$ . 18347)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-old-keymap put preserved t] 4) #@96 *If non-nil, emerge-select-A and emerge-select-B automatically advance to the next difference. (defvar emerge-auto-advance nil (#$ . -18535)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-auto-advance put preserved t] 4) #@85 *If non-nil, differences for which there is a preference are automatically skipped. (defvar emerge-skip-prefers nil (#$ . -18775)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-skip-prefers put preserved t] 4) #@228 Hooks to run in the merge buffer after the merge has been finished. `emerge-prefix-argument' will hold the prefix argument of the `emerge-quit' command. This is *not* a user option, since Emerge uses it for its own processing. (defvar emerge-quit-hook nil (#$ . 19005)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-quit-hook put preserved t] 4) #@66 Describes output destination of emerge, for `emerge-file-names'. (defvar emerge-output-description nil (#$ . 19370)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-output-description put preserved t] 4) (defalias 'emerge-files-internal #[(file-A file-B &optional startup-hooks quit-hooks output-file) "À !„ Âà \"ˆÀ\f!„ÂÃ\f\"ˆÅ !Å\f!È ! È\f!\n ƒ5È !\fp ÎŽqˆ~ˆÏ !‰ƒZÑÒÓ DEB‚]Õ ˆ+p ÖŽqˆ~ˆÏ\f!‰ƒƒÑÒÓ\fDEB‚†Õ ˆ+× \f &*‡" [file-readable-p file-A error "File `%s' does not exist or is not readable" file-B find-file-noselect buffer-B buffer-A file-name-directory emerge-last-dir-A emerge-last-dir-B output-file emerge-last-dir-output StartBuffer ((set-buffer StartBuffer)) file-local-copy temp lambda nil delete-file startup-hooks emerge-verify-file-buffer ((set-buffer StartBuffer)) emerge-setup quit-hooks] 9]) (defalias 'emerge-setup #[(buffer-A file-A buffer-B file-B startup-hooks quit-hooks output-file) "À !À\n! …À !ÄÅÆ\"pÉŽ\nqˆË!*\fpÍŽ\fqˆÎ\n!ˆÏÑÒ!ˆÓ\nÏ\f ƒWÚ P‚]ÛÜ\f!PÞ!ˆß ˆà \n\"‰!G\"ã$%&ç ˆè ˆ*é\n\fÓ$ˆpêŽ\fqˆëìí\"ˆÓ‰,‡" [expand-file-name file-A file-B output-file emerge-unique-buffer-name "*merge" "*" merge-buffer-name StartBuffer ((set-buffer StartBuffer)) buffer-A get-buffer-create merge-buffer ((set-buffer StartBuffer)) emerge-copy-modes nil buffer-read-only auto-save-mode 1 t emerge-mode emerge-A-buffer buffer-B emerge-B-buffer emerge-ancestor-buffer emerge-merge-buffer "Output to file: " "Output to buffer: " buffer-name emerge-output-description insert-buffer emerge-set-keys emerge-make-diff-list emerge-difference-list emerge-number-of-differences -1 emerge-current-difference quit-hooks emerge-quit-hook emerge-remember-buffer-characteristics emerge-handle-local-variables emerge-setup-windows ((set-buffer StartBuffer)) run-hooks startup-hooks emerge-startup-hook] 6]) (defalias 'emerge-make-diff-list #[(file-A file-B) "ÀÁ!pÄŽ\nqˆÅ ˆÆÇÈ \nË\f!Ë !%Î\"ˆ*Ï!ˆÑÕ\n!$‡" [get-buffer-create "*emerge-diff*" emerge-diff-buffer StartBuffer ((set-buffer StartBuffer)) erase-buffer shell-command format "%s %s %s %s" emerge-diff-program emerge-diff-options emerge-protect-metachars file-A file-B t emerge-prepare-error-list emerge-diff-ok-lines-regexp emerge-convert-diffs-to-markers emerge-A-buffer emerge-B-buffer emerge-merge-buffer emerge-extract-diffs] 8]) (defalias 'emerge-extract-diffs #[(diff-buffer) "ÀpÃŽ\fqˆebˆÅÀÇ#ƒ®Èɔɕ{!\n˔˕\f‰ ƒ4È \f{!‚6\n*ϔϕ{Èєѕ{!Ó”Ó•\f‰ ƒ_È \f{!‚a*Õ˜ƒ{T\nT‰\n‚œÖ˜ƒ’TT‰‚œTT×\nØ% B-‚\f* Ÿ)‡" [nil list StartBuffer ((set-buffer StartBuffer)) diff-buffer re-search-forward emerge-match-diff-line t string-to-int 1 a-begin 3 e b a-end 4 diff-type 5 b-begin 7 b-end "a" "d" vector default-A] 7]) (defalias 'emerge-prepare-error-list #[(ok-regexp) "ÀÁ!pÄŽ\nqˆÅ ˆÆ!ˆÈ !*‡" [get-buffer-create "*emerge-diff-errors*" emerge-diff-error-buffer StartBuffer ((set-buffer StartBuffer)) erase-buffer insert-buffer emerge-diff-buffer delete-matching-lines ok-regexp] 2]) (defalias 'emerge-files-with-ancestor-internal #[(file-A file-B file-ancestor &optional startup-hooks quit-hooks output-file) "À !„ Âà \"ˆÀ\f!„ÂÃ\f\"ˆÀ !„!Âà \"ˆÆ !Æ\f!Æ ! Ê ! Ê\f!\fÊ ! ƒJÊ!pÑŽ qˆ~ˆÒ !‰ƒoÔÕÖ DEB‚rØ ˆ+pÙŽqˆ~ˆÒ\f!‰ƒ˜ÔÕÖ\fDEB‚›Ø ˆ+pÚŽqˆ~ˆÒ !‰ƒÁÔÕÖ DEB‚ÄØ ˆ+Û \f & +‡" [file-readable-p file-A error "File `%s' does not exist or is not readable" file-B file-ancestor find-file-noselect buffer-ancestor buffer-B buffer-A file-name-directory emerge-last-dir-A emerge-last-dir-B emerge-last-dir-ancestor output-file emerge-last-dir-output StartBuffer ((set-buffer StartBuffer)) file-local-copy temp lambda nil delete-file startup-hooks emerge-verify-file-buffer ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) emerge-setup-with-ancestor quit-hooks] 11]) (defalias 'emerge-setup-with-ancestor #[(buffer-A file-A buffer-B file-B buffer-ancestor file-ancestor &optional startup-hooks quit-hooks output-file) "À !À\n!À !\f…À\f!ÅÆÇ\"p ÊŽ qˆÌ!* p ÎŽ qˆÏ !ˆÐÒÓ!ˆÔ  \fƒ\\Ü\fP‚bÝÞ !Pà!ˆá ˆâ \n #‰#G$å&'(é ˆê ˆë ˆ*ì  Ô$ˆp íŽ qˆîïð\"ˆÔ‰,‡" [expand-file-name file-A file-B file-ancestor output-file emerge-unique-buffer-name "*merge" "*" merge-buffer-name StartBuffer ((set-buffer StartBuffer)) buffer-A get-buffer-create merge-buffer ((set-buffer StartBuffer)) emerge-copy-modes nil buffer-read-only auto-save-mode 1 t emerge-mode emerge-A-buffer buffer-B emerge-B-buffer buffer-ancestor emerge-ancestor-buffer emerge-merge-buffer "Output to file: " "Output to buffer: " buffer-name emerge-output-description insert-buffer emerge-set-keys emerge-make-diff3-list emerge-difference-list emerge-number-of-differences -1 emerge-current-difference quit-hooks emerge-quit-hook emerge-remember-buffer-characteristics emerge-select-prefer-Bs emerge-handle-local-variables emerge-setup-windows ((set-buffer StartBuffer)) run-hooks startup-hooks emerge-startup-hook] 6]) (defalias 'emerge-make-diff3-list #[(file-A file-B file-ancestor) "ÀÁ!pÄŽ\nqˆÅ ˆÆÇÈ \nË\f!Ë !Ë!&Ï\"ˆ*Ð!ˆÒÖ\n!$‡" [get-buffer-create "*emerge-diff*" emerge-diff-buffer StartBuffer ((set-buffer StartBuffer)) erase-buffer shell-command format "%s %s %s %s %s" emerge-diff3-program emerge-diff-options emerge-protect-metachars file-A file-ancestor file-B t emerge-prepare-error-list emerge-diff3-ok-lines-regexp emerge-convert-diffs-to-markers emerge-A-buffer emerge-B-buffer emerge-merge-buffer emerge-extract-diffs3] 9]) (defalias 'emerge-extract-diffs3 #[(diff-buffer) "ÀpÃŽ\fqˆÅÆÀÇ#ƒjÈyˆÈ”È•{‰ ʘ„fÀ‰‰ \f ` ÎÏ!  bˆÎÐ!\fÑ @ A@\f@\fA@ ϘƒUÒ‚a Иƒ`Ó‚aÔ%+ B)‚ * Ÿ)‡" [nil list StartBuffer ((set-buffer StartBuffer)) diff-buffer re-search-forward "^====\\(.?\\)$" t 1 agreement "2" pos group-3 group-1 emerge-get-diff3-group "1" "3" vector prefer-A prefer-B default-A] 8]) (defalias 'emerge-get-diff3-group #[(file) "ŠÀÁ\nÃQ!ˆÄyˆÅ”Å•{Ƙƒ>Ç”ƒ-ÈĔĕ{!Èɔɕ{!TD‚HÈĔĕ{!‰\n‰T)D‚HÈĔĕ{!T‰D)‡" [re-search-forward "^" file ":\\([0-9]+\\)\\(,\\([0-9]+\\)\\)?\\([ac]\\)$" 1 4 "c" 2 string-to-int 3 x] 5]) #@26 Run Emerge on two files. (defalias 'emerge-files #[(arg file-A file-B file-out &optional startup-hooks quit-hooks) "À \n \fƒÅÆÇ\fDEB‚\f%‡" [emerge-files-internal file-A file-B startup-hooks file-out lambda nil emerge-files-exit quit-hooks] 8 (#$ . 25623) (byte-code "À\nÃÄ À‰Æ%‰ÃÇÀ Æ%\n… ÃÉ\n ‰À%F)‡" [nil f current-prefix-arg emerge-read-file-name "File A to merge" emerge-last-dir-A t "File B to merge" emerge-last-dir-B "Output file" emerge-last-dir-output] 9)]) #@63 Run Emerge on two files, giving another file as the ancestor. (defalias 'emerge-files-with-ancestor #[(arg file-A file-B file-ancestor file-out &optional startup-hooks quit-hooks) "À \n \f ƒÆÇÈ DE B‚ &‡" [emerge-files-with-ancestor-internal file-A file-B file-ancestor startup-hooks file-out lambda nil emerge-files-exit quit-hooks] 9 (#$ . 26109) (byte-code "À\nÃÄ À‰Æ%‰ÃÇÀ Æ%ÃÉ\nÀ Æ%\n…(ÃË\f ‰À%¯)‡" [nil f current-prefix-arg emerge-read-file-name "File A to merge" emerge-last-dir-A t "File B to merge" emerge-last-dir-B "Ancestor file" emerge-last-dir-ancestor "Output file" emerge-last-dir-output] 10)]) (defalias 'emerge-files-exit #[(file-out) "?…Á\n!‡" [emerge-prefix-argument emerge-write-and-delete file-out] 2]) #@28 Run Emerge on two buffers. (defalias 'emerge-buffers #[(buffer-A buffer-B &optional startup-hooks quit-hooks) "ÀÁ!ÀÂ!pÆŽqˆÈed\fÉÊ%ˆ*pËŽ\fqˆÈed ÉÊ%ˆ*ÍÎ!\fÎ\f! ÏÉÐ\fDÐ DFBÉ&*‡" [emerge-make-temp-file "A" "B" emerge-file-B emerge-file-A StartBuffer ((set-buffer StartBuffer)) buffer-A write-region nil no-message ((set-buffer StartBuffer)) buffer-B emerge-setup get-buffer lambda delete-file startup-hooks quit-hooks] 10 (#$ . 26857) "bBuffer A to merge: \nbBuffer B to merge: "]) #@67 Run Emerge on two buffers, giving another buffer as the ancestor. (defalias 'emerge-buffers-with-ancestor #[(buffer-A buffer-B buffer-ancestor &optional startup-hooks quit-hooks) "ÀÁ!ÀÂ!ÀÃ!pÈŽ qˆÊedËÌ%ˆ*pÍŽqˆÊed ËÌ%ˆ*pÏŽqˆÊed\fËÌ%ˆ*ÑÒ !Ò! Ò!\fÓËÔDÔ DÔ\fD¯BË& +‡" [emerge-make-temp-file "A" "B" "anc" emerge-file-ancestor emerge-file-B emerge-file-A StartBuffer ((set-buffer StartBuffer)) buffer-A write-region nil no-message ((set-buffer StartBuffer)) buffer-B ((set-buffer StartBuffer)) buffer-ancestor emerge-setup-with-ancestor get-buffer lambda delete-file startup-hooks quit-hooks] 13 (#$ . 27356) "bBuffer A to merge: \nbBuffer B to merge: \nbAncestor buffer: "]) (defalias 'emerge-files-command #[nil "@A@Á8Å›Æ\f ÇÈÇÉ\nDEC$+‡" [command-line-args-left 2 file-out file-b file-a 3 emerge-files-internal nil lambda emerge-command-exit] 8]) (defalias 'emerge-files-with-ancestor-command #[nil "À‰‰‰ @Ƙƒ&Ç 8È 8 A@É 8Ê ›‚9 @ A@Ç 8È 8É ›Ë\f \nÀÌÀÍ DEC%,‡" [nil file-out file-anc file-b file-a command-line-args-left "-a" 2 3 4 5 emerge-files-with-ancestor-internal lambda emerge-command-exit] 9]) (defalias 'emerge-command-exit #[(file-out) "À !ˆÂ ƒ Ä‚Å!‡" [emerge-write-and-delete file-out kill-emacs emerge-prefix-argument 1 0] 2]) (defalias 'emerge-files-remote #[(file-a file-b file-out) " \fÅÆÅÇÈ DEEC%ˆÊËÅ\"‡" [file-out emerge-file-out emerge-files-internal file-a file-b nil lambda emerge-remote-exit quote emerge-exit-func throw client-wait] 10]) (defalias 'emerge-files-with-ancestor-remote #[(file-a file-b file-anc file-out) " \f ÆÇÆÈÉ\nDEEC&ˆËÌÆ\"‡" [file-out emerge-file-out emerge-files-with-ancestor-internal file-a file-b file-anc nil lambda emerge-remote-exit quote emerge-exit-func throw client-wait] 11]) (defalias 'emerge-remote-exit #[(file-out emerge-exit-func) "À !ˆÂ !ˆ\f ƒÆ‚Ç!‡" [emerge-write-and-delete file-out kill-buffer emerge-merge-buffer emerge-exit-func emerge-prefix-argument 1 0] 2]) #@37 Emerge two RCS revisions of a file. (defalias 'emerge-revisions #[(arg file revision-A revision-B &optional startup-hooks quit-hooks) "\nÄ \nƒ ÈÉÊËÌ #DEB‚\"%‡" [revision-A emerge-last-revision-A revision-B emerge-last-revision-B emerge-revisions-internal file startup-hooks arg lambda nil shell-command format "%s %s" emerge-rcs-ci-program quit-hooks] 12 (#$ . 29356) (list current-prefix-arg (read-file-name "File to merge: " nil nil (quote confirm)) (read-string "Revision A to merge: " emerge-last-revision-A) (read-string "Revision B to merge: " emerge-last-revision-B))]) #@72 Emerge two RCS revisions of a file, with another revision as ancestor. (defalias 'emerge-revisions-with-ancestor #[(arg file revision-A revision-B ancestor &optional startup-hooks quit-hooks) "\n\fÆ\n\f ƒ)Ê ÌÊÍÎÏ#DE)B‚+&‡" [revision-A emerge-last-revision-A revision-B emerge-last-revision-B ancestor emerge-last-revision-ancestor emerge-revision-with-ancestor-internal file startup-hooks arg nil cmd lambda shell-command format "%s %s" emerge-rcs-ci-program quit-hooks] 13 (#$ . 29955) (list current-prefix-arg (read-file-name "File to merge: " nil nil (quote confirm)) (read-string "Revision A to merge: " emerge-last-revision-A) (read-string "Revision B to merge: " emerge-last-revision-B) (read-string "Ancestor: " emerge-last-revision-ancestor))]) (defalias 'emerge-revisions-internal #[(file revision-A revision-B &optional startup-hooks quit-hooks output-file) "ÀÁ \f#!ÀÁ #!ÆÇ!ÆÈ! \n \fp ÎŽ\fqˆÏ ˆÐÁÑ\f $Ó\"ˆÔed\nÕÖ%ˆ×Õ!ˆ*p ØŽ qˆÏ ˆÐÁÑ $Ó\"ˆÔed ÕÖ%ˆ×Õ!ˆ*Ù\f\n  ÚÕÛ\nDÛ DFBÚÕÝ DEBÕ&,‡" [get-buffer-create format "%s,%s" file revision-A revision-B emerge-make-temp-file "A" "B" emerge-file-B emerge-file-A buffer-B buffer-A StartBuffer ((set-buffer StartBuffer)) erase-buffer shell-command "%s -q -p%s %s" emerge-rcs-co-program t write-region nil no-message set-buffer-modified-p ((set-buffer StartBuffer)) emerge-setup lambda delete-file startup-hooks emerge-files-exit quit-hooks] 10]) (defalias 'emerge-revision-with-ancestor-internal #[(file revision-A revision-B ancestor &optional startup-hooks quit-hooks output-file) "ÀÁ \f#!ÀÁ #!ÀÁ #!ÇÈ!ÇÉ!ÇÊ! \f pÒŽqˆÓ ˆÔÁÕ\f $×\"ˆØed ÙÚ%ˆÛÙ!ˆ*pÜŽqˆÓ ˆÔÁÕ $×\"ˆØed\fÙÚ%ˆÛÙ!ˆ*pÝŽqˆÓ ˆÔÁÕ $×\"ˆØed ÙÚ%ˆÛÙ!ˆ*Þ \f ßÙà Dà\fDà D¯!BßÙâ DE#B$& .‡" [get-buffer-create format "%s,%s" file revision-A revision-B ancestor emerge-make-temp-file "A" "B" "ancestor" emerge-ancestor emerge-file-B emerge-file-A buffer-ancestor buffer-B buffer-A StartBuffer ((set-buffer StartBuffer)) erase-buffer shell-command "%s -q -p%s %s" emerge-rcs-co-program t write-region nil no-message set-buffer-modified-p ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) emerge-setup-with-ancestor lambda delete-file startup-hooks emerge-files-exit quit-hooks output-file] 13]) #@541 Run Emerge using files named in current text line. Looks in that line for whitespace-separated entries of these forms: a=file1 b=file2 ancestor=file3 output=file4 to specify the files to use in Emerge. In addition, if only one of `a=file' or `b=file' is present, and `output=file' is present: If `emerge-execute-line-deletions' is non-nil and `ancestor=file' is present, it is assumed that the file in question has been deleted, and it is not copied to the output file. Otherwise, the A or B file present is copied to the output file. (defalias 'emerge-execute-line #[nil "À‰‰‰ÁmƒÇÈ!ˆÉyˆÊË!ƒ É•bˆl„°ÊÌ!ƒ©Í”Í•{—ΔΕ{É•bˆјƒTƒMÇÒ!ˆ‚¥Ó˜ƒi ƒcÇÔ!ˆ‚¥Õ˜„wÖ˜ƒ…\fƒÇ×!ˆ‚¥ؘ„“Ù˜ƒ¡ ƒ›ÇÚ!ˆ‚¥ÇÛ!ˆ*‚ ÇÜ!ˆ‚ ƒ¹ „Á „ÁÇÝ!ˆ„Î „ÎÇÞ!ˆÍyˆƒþ ƒþ\fƒþßà #ˆá ?? \f ÀâÀãpDäBBBC&‚Nƒ& ƒ&ßà #ˆå ?? ÀâÀãpDæBBBC&‚N\fƒ5'ƒ5ßè!‚N†; )ßê!ˆë) \"ˆßì) #)-‡" [nil t case-fold-search file-out file-ancestor file-B file-A error "At end of buffer" 0 looking-at "[ ]*" "\\([a-z]+\\)=\\([^ \n]+\\)[ ]*" 1 2 file tag "a" "This line has two `A' entries" "b" "This line has two `B' entries" "anc" "ancestor" "This line has two `ancestor' entries" "out" "output" "This line has two `output' entries" "Unrecognized entry" "Unparsable entry" "Must have both `A' and `B' entries" "Must have `A' or `B' entry" message "Merging %s and %s..." emerge-files-with-ancestor lambda switch-to-buffer ((message "Merge done.")) emerge-files ((message "Merge done.")) emerge-execute-line-deletions "No action." input-file "Copying..." copy-file "%s copied to %s."] 11 (#$ . 32264) nil]) #@72 Regexp describing files to be processed by `emerge-merge-directories'. (defvar emerge-merge-directories-filename-regexp "[^.]" (#$ . 33898)) (defalias 'emerge-merge-directories #[(a-dir b-dir ancestor-dir output-dir) "nƒl„\fÀÁ!ˆ\nƒ\n؃Ä ƒ$ ؃$ÄÆ!‰ÈÄOɘ„9ÉPÆ\n!‰\nÈÄOɘ„N\nÉP\n\nƒcÆ\n!‰ÈÄOɘ„c\nÉP ƒxÆ !‰ÈÄOɘ„x ÉPË ˆÌÄ #Ì\nÄ #\n…—Ì\nÄ #ÑÒ!Ò!¤Ò!¤Ó\"‰ƒØAƒÏ@A@˜ƒÏ‰AA¡ˆ‚¯A‰„´)…R@Aƒ@˜ƒ×رˆAƒ @˜ƒ Ù\nرˆAƒ;@˜ƒ;Ú\nرˆA ƒGÛ رˆÜÝ!ˆÞcˆ)‚Ù,‡" [error "There is text on this line" ancestor-dir "" nil output-dir expand-file-name a-dir -1 "/" b-dir push-mark directory-files emerge-merge-directories-filename-regexp a-dir-files b-dir-files ancestor-dir-files sort copy-sequence string-lessp all-files p f "A=" " " "B=" "ancestor=" "output=" backward-delete-char 1 "\n"] 5 nil (list (read-file-name "A directory: " nil nil (quote confirm)) (read-file-name "B directory: " nil nil (quote confirm)) (read-file-name "Ancestor directory (null for none): " nil nil (quote confirm)) (read-file-name "Output directory (null for none): " nil nil (quote confirm)))]) (defalias 'emerge-setup-windows #[(buffer-A buffer-B merge-buffer &optional pos) "À Á =ƒ\fÂÃ!ˆÄ ˆÅ!ˆÇ ˆÈ ˆÉ ˆÅ\n!ˆ ƒ*ebˆÂÃ!ˆÅ\f!ˆ ƒ;ebˆÂÃ!ˆ ƒGebˆp ÎŽqˆÐ *ÑU?…hÒ ˆÓÔÕ!\"ˆÅ!‡" [selected-window minibuffer-window other-window 1 delete-other-windows switch-to-buffer merge-buffer emerge-refresh-mode-line split-window-vertically split-window-horizontally buffer-A pos buffer-B StartBuffer ((set-buffer StartBuffer)) emerge-diff-error-buffer buffer-size 0 ding message "Errors found in diff/diff3 output. Merge buffer is %s." buffer-name emerge-merge-buffer] 4]) (defalias 'emerge-set-keys #[nil "„Á ˆÂ ‰ƒÄ !‚Å ÇÀ#ˆÉÊÅ #ˆÉËÌ B#ˆÉÎÏB#ˆÉÑÒB#ˆÔÕÖ#ˆÔ×Ø#ˆÔÕÖÙ $ˆÔ×ØÙ $ˆÚ!ˆÜÞ‰‡" [emerge-basic-keymap emerge-setup-fixed-keymaps current-local-map emerge-old-keymap copy-keymap make-sparse-keymap emerge-edit-keymap emerge-force-define-key emerge-command-prefix define-key [menu-bar] [menu-bar options] "Options" emerge-options-menu [menu-bar merge] "Merge" emerge-merge-menu [menu-bar move] "Move" emerge-move-menu substitute-key-definition write-file emerge-query-write-file save-buffer emerge-query-save-buffer current-global-map use-local-map emerge-fast-keymap nil emerge-edit-mode t emerge-fast-mode] 6]) #@316 Record certain properties of the buffers being merged. Must be called in the merge buffer. Remembers read-only, modified, auto-save, and saves them in buffer local variables. Sets the buffers read-only and turns off `auto-save-mode'. These characteristics are restored by `emerge-restore-buffer-characteristics'. (defalias 'emerge-remember-buffer-characteristics #[nil "À ˆpÂŽ qˆÄ !Æ \"ˆ*pÉŽ\nqˆÄ !Æ \"ˆ*‰ ‡" [do-auto-save StartBuffer ((set-buffer StartBuffer)) emerge-A-buffer emerge-save-variables emerge-saved-variables emerge-restore-variables emerge-merging-values emerge-A-buffer-values ((set-buffer StartBuffer)) emerge-B-buffer emerge-B-buffer-values] 4 (#$ . 36349)]) #@77 Restores characteristics saved by `emerge-remember-buffer-characteristics'. (defalias 'emerge-restore-buffer-characteristics #[nil " pÅŽqˆÇ \"ˆ*pÉŽ\nqˆÇ\n\",‡" [emerge-A-buffer-values emerge-B-buffer-values B-values A-values StartBuffer ((set-buffer StartBuffer)) emerge-A-buffer emerge-restore-variables emerge-saved-variables ((set-buffer StartBuffer)) emerge-B-buffer] 3 (#$ . 37044)]) (defalias 'emerge-goto-line #[(desired-line current-line) " Zyˆ‡" [desired-line current-line] 2]) (defalias 'emerge-convert-diffs-to-markers #[(A-buffer B-buffer merge-buffer lineno-list) "ÀpÃŽ\fqˆe*‰SpÇŽqˆe* Ê Ê\fpÍŽ\fqˆebˆ*pÎŽqˆebˆ*ƒï@ÀÀÀÀÀÀ×HÊHÚHÜHÞHpàŽ\fqˆá \" â á \" â *pãŽqˆá\f\"\fâ á\f\"\fâ *ä å!Z&“ä å!Z&“ç& B.\fA‰„>èç Ÿ\"‰).‡" [nil marker-list StartBuffer ((set-buffer StartBuffer)) A-buffer A-point-min offset ((set-buffer StartBuffer)) B-buffer B-point-min 1 a-line b-line ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) lineno-list list-element a-begin-marker a-end-marker b-begin-marker b-end-marker merge-begin-marker merge-end-marker 0 a-begin a-end 2 b-begin 3 b-end 4 state ((set-buffer StartBuffer)) emerge-goto-line point-marker ((set-buffer StartBuffer)) make-marker marker-position merge-buffer vector apply emerge-difference-list] 9]) (defalias 'emerge-select-prefer-Bs #[nil "ÀÀ\nWƒ( HÄHÅ=ƒ!Æ Ç\"ˆÈ ˆ HÄÅIˆ T‰‚)ÆÉ!‡" [0 n emerge-number-of-differences emerge-difference-list 6 prefer-B emerge-unselect-and-select-difference t emerge-select-B -1] 4]) (defalias 'emerge-handle-local-variables #[nil "…ÁÂÇ" [emerge-process-local-variables err (hack-local-variables) ((error (byte-code "ÀÁ !\"‡" [message "Local-variables error in merge buffer: %s" prin1-to-string err] 4)))] 3]) (defalias 'emerge-write-and-delete #[(file-out) "À ˆÁ\n!„ Ã\n!ˆÁ\f!„Ã\f!ˆ ƒ%Á !„%à !ˆ….Ç!‡" [delete-other-windows buffer-modified-p emerge-A-buffer kill-buffer emerge-B-buffer emerge-ancestor-buffer file-out write-file] 2]) #@190 Bring the highlighted region of all three merge buffers into view. This brings the buffers into view if they are in windows. With an argument, reestablish the default three-window display. (defalias 'emerge-recenter #[(&optional arg) "ƒ\nÁ\n \f#ˆ ÆY…¡ W…¡\f\n \nË Ì\" Ë\nÌ\"Ë! H ƒ\\Ò !ˆÓÆHSZÕHS\\ÆHT#ˆƒ~Ò!ˆÓ×HSZØHS\\×HT#ˆ…ŸÒ!ˆÓÙHSZÚHS\\ÙHT#.‡" [arg emerge-setup-windows emerge-A-buffer emerge-B-buffer emerge-merge-buffer emerge-current-difference 0 emerge-number-of-differences merge-buffer buffer-A buffer-B get-buffer-window visible window-A window-B merge-window emerge-difference-list diff-vector select-window emerge-position-region emerge-before-flag-length 1 emerge-after-flag-length 2 3 4 5] 5 (#$ . 39125) "P"]) (defalias 'emerge-operate-on-windows #[(operation arg) "\n\fÆ Ç\"Æ Ç\" Æ !\nƒ&Ë!ˆÌÍΈ ƒ5Ë !ˆÌÏЈ\n…DË\n!ˆ!.‡" [emerge-merge-buffer merge-buffer emerge-A-buffer buffer-A emerge-B-buffer buffer-B get-buffer-window visible window-A window-B merge-window select-window nil (funcall operation arg) ((error)) (funcall operation arg) ((error)) operation arg] 3]) #@223 Scroll up all three merge buffers, if they are in windows. With argument N, scroll N lines; otherwise scroll by nearly the height of the merge window. `C-u -' alone as argument scrolls half the height of the merge window. (defalias 'emerge-scroll-up #[(&optional arg) "ÀÁ\nƒ\nÚ„Ä\n!‚8Å!‰??…7È! ZÊZ \nƒ4 Ì¥‚6 ))\"‡" [emerge-operate-on-windows scroll-up arg - prefix-numeric-value get-buffer-window emerge-merge-buffer merge-window window-height next-screen-context-lines 1 default-amount 2] 5 (#$ . 40304) "P"]) #@225 Scroll down all three merge buffers, if they are in windows. With argument N, scroll N lines; otherwise scroll by nearly the height of the merge window. `C-u -' alone as argument scrolls half the height of the merge window. (defalias 'emerge-scroll-down #[(&optional arg) "ÀÁ\nƒ\nÚ„Ä\n!‚8Å!‰??…7È! ZÊZ \nƒ4 Ì¥‚6 ))\"‡" [emerge-operate-on-windows scroll-down arg - prefix-numeric-value get-buffer-window emerge-merge-buffer merge-window window-height next-screen-context-lines 1 default-amount 2] 5 (#$ . 40841) "P"]) #@246 Scroll left all three merge buffers, if they are in windows. If an argument is given, that is how many columns are scrolled, else nearly the width of the A and B windows. `C-u -' alone as argument scrolls half the width of the A and B windows. (defalias 'emerge-scroll-left #[(&optional arg) "ÀÁ\nƒ\nÚ„Ä\n!‚7Å!‰??…6È!É¥ÊZ \nƒ3 É¥‚5 ))\"‡" [emerge-operate-on-windows scroll-left arg - prefix-numeric-value get-buffer-window emerge-merge-buffer merge-window window-width 2 3 default-amount] 5 (#$ . 41384) "P"]) #@247 Scroll right all three merge buffers, if they are in windows. If an argument is given, that is how many columns are scrolled, else nearly the width of the A and B windows. `C-u -' alone as argument scrolls half the width of the A and B windows. (defalias 'emerge-scroll-right #[(&optional arg) "ÀÁ\nƒ\nÚ„Ä\n!‚7Å!‰??…6È!É¥ÊZ \nƒ3 É¥‚5 ))\"‡" [emerge-operate-on-windows scroll-right arg - prefix-numeric-value get-buffer-window emerge-merge-buffer merge-window window-width 2 3 default-amount] 5 (#$ . 41920) "P"]) #@147 Reset horizontal scrolling in Emerge. This resets the horizontal scrolling of all three merge buffers to the left margin, if they are in windows. (defalias 'emerge-scroll-reset #[nil "ÀÁÂ\"‡" [emerge-operate-on-windows #[(x) "ÀÁ Â\"‡" [set-window-hscroll selected-window 0] 3] nil] 3 (#$ . 42459) nil]) (defalias 'emerge-position-region #[(beg end pos) "À !ˆ`\nXƒ À T[!ˆ`X„JÄÅ \n\"ˆÆ !ƒJÇ À!ˆ`Vƒ8T‚%\nbˆÉÊÅ !SZTË¥!ˆ)\fb‡" [move-to-window-line emerge-min-visible-lines beg end set-window-start selected-window pos-visible-in-window-p 0 lines recenter window-height 2 pos] 3]) #@33 Advance to the next difference. (defalias 'emerge-next-difference #[nil " Wƒ+T ƒ#\n Wƒ#\f\nHÅHÆ>ƒ#\nT‚ ÇÉ\n!*‡ÊË!‡" [emerge-current-difference emerge-number-of-differences n emerge-skip-prefers emerge-difference-list 6 (prefer-A prefer-B) nil buffer-read-only emerge-unselect-and-select-difference error "At end"] 2 (#$ . 43057) nil]) #@32 Go to the previous difference. (defalias 'emerge-previous-difference #[nil "ÁVƒ+S ƒ#\nÁVƒ#\f\nHÅHÆ>ƒ#\nS‚ ÇÉ\n!*‡ÊË!‡" [emerge-current-difference -1 n emerge-skip-prefers emerge-difference-list 6 (prefer-A prefer-B) nil buffer-read-only emerge-unselect-and-select-difference error "At beginning"] 2 (#$ . 43409) nil]) #@28 Go to the N-th difference. (defalias 'emerge-jump-to-difference #[(difference-number) "À\nS‰ÃYƒ\n\fTWƒÅ\n!‚ÆÇ!)‡" [nil buffer-read-only difference-number -1 emerge-number-of-differences emerge-unselect-and-select-difference error "Bad difference number"] 3 (#$ . 43744) "p"]) #@27 Abort the Emerge session. (defalias 'emerge-abort #[nil "ÀÁ!‡" [emerge-quit t] 2 (#$ . 44034) nil]) #@564 Finish the Emerge session and exit Emerge. Prefix argument means to abort rather than successfully finish. The difference depends on how the merge was started, but usually means to not write over one of the original files, or to signal to some process which invoked Emerge a failure code. Unselects the selected difference, if any, restores the read-only and modified flags of the merged file buffers, restores the local keymap of the merge buffer, and sets off various emerge flags. Using Emerge commands in this buffer after this will cause serious problems. (defalias 'emerge-quit #[(arg) "À „ ‚\nÃ!ÄÅ!ˆ…Æ !‡" [y-or-n-p arg "Do you really want to successfully finish this merge? " "Do you really want to abort this merge? " message "" emerge-really-quit] 3 (#$ . 44141) "P"]) (defalias 'emerge-really-quit #[(arg) "ÀÂÃ!ˆÄ ˆÅÆ\"ˆÀÈ !ˆÀ\nÀ À\fÀ ÀÏÐ!ˆÓÔ!)‡" [nil buffer-read-only emerge-unselect-and-select-difference -1 emerge-restore-buffer-characteristics mapcar #[(d) "ÁH‰“ˆÃH‰“ˆÄH‰“ˆÅH‰“ˆÆH‰“ˆÇH‰“‡" [d 0 nil 1 2 3 4 5] 3] emerge-difference-list use-local-map emerge-old-keymap emerge-mode emerge-fast-mode emerge-edit-mode emerge-auto-advance emerge-skip-prefers kill-local-variable mode-line-buffer-identification arg emerge-prefix-argument run-hooks emerge-quit-hook] 3]) #@240 Select the A variant of this difference. Refuses to function if this difference has been edited, i.e., if it is neither the A nor the B variant. A prefix argument forces the variant to be selected even if the difference has been edited. (defalias 'emerge-select-A #[(&optional force) "ÀÁÄ \n ‰$*‡" [#[nil "À \n \f$ˆ … Æ ‡" [emerge-select-A-edit merge-begin merge-end A-begin A-end emerge-auto-advance emerge-next-difference] 5] #[nil "…Á ‡" [emerge-auto-advance emerge-next-difference] 1] operate-no-change operate emerge-select-version force] 5 (#$ . 45463) "P"]) (defalias 'emerge-select-A-edit #[(merge-begin merge-end A-begin A-end) "pÁŽ\nqˆ \f|ˆ bˆÅ#ˆ bˆ ÊËIˆÌ *‡" [StartBuffer ((set-buffer StartBuffer)) emerge-merge-buffer merge-begin merge-end insert-buffer-substring emerge-A-buffer A-begin A-end diff-vector 6 A emerge-refresh-mode-line] 4]) #@238 Select the B variant of this difference. Refuses to function if this difference has been edited, i.e., if it is neither the A nor the B variant. A prefix argument forces the variant to be selected even if the difference has been edited. (defalias 'emerge-select-B #[(&optional force) "ÀÁÄ \n $*‡" [#[nil "À \n \f$ˆ … Æ ‡" [emerge-select-B-edit merge-begin merge-end B-begin B-end emerge-auto-advance emerge-next-difference] 5] #[nil "…Á ‡" [emerge-auto-advance emerge-next-difference] 1] operate-no-change operate emerge-select-version force] 5 (#$ . 46338) "P"]) (defalias 'emerge-select-B-edit #[(merge-begin merge-end B-begin B-end) "pÁŽ\nqˆ \f|ˆ bˆÅ#ˆ bˆ ÊËIˆÌ *‡" [StartBuffer ((set-buffer StartBuffer)) emerge-merge-buffer merge-begin merge-end insert-buffer-substring emerge-B-buffer B-begin B-end diff-vector 6 B emerge-refresh-mode-line] 4]) #@227 Make the A variant the default from here down. This selects the A variant for all differences from here down in the buffer which are still defaulted, i.e., which the user has not selected and for which there is no preference. (defalias 'emerge-default-A #[nil "À\n‰Ã]\fWƒ?\fH‰ÉHÊ=ƒ+Ë\fÌ\"ˆÍ ˆÉÎIˆ)\fT‰ϦÃUƒÐÑ\f\"ˆ‚Ë !ˆ+ÐÒ!‡" [nil buffer-read-only emerge-current-difference 0 n selected-difference emerge-number-of-differences emerge-difference-list diff-vector 6 default-B emerge-unselect-and-select-difference t emerge-select-A default-A 10 message "Setting default to A...%d" "Default choice is now A"] 4 (#$ . 47211) nil]) #@227 Make the B variant the default from here down. This selects the B variant for all differences from here down in the buffer which are still defaulted, i.e., which the user has not selected and for which there is no preference. (defalias 'emerge-default-B #[nil "À\n‰Ã]\fWƒ?\fH‰ÉHÊ=ƒ+Ë\fÌ\"ˆÍ ˆÉÎIˆ)\fT‰ϦÃUƒÐÑ\f\"ˆ‚Ë !ˆ+ÐÒ!‡" [nil buffer-read-only emerge-current-difference 0 n selected-difference emerge-number-of-differences emerge-difference-list diff-vector 6 default-A emerge-unselect-and-select-difference t emerge-select-B default-B 10 message "Setting default to B...%d" "Default choice is now B"] 4 (#$ . 47862) nil]) #@170 Set fast mode, for Emerge. In this mode ordinary Emacs commands are disabled, and Emerge commands need not be prefixed with \\[emerge-basic-keymap]. (defalias 'emerge-fast-mode #[nil "À !ˆÀÀÆÈÉ!ˆÊ ‡" [t buffer-read-only use-local-map emerge-fast-keymap emerge-mode emerge-fast-mode nil emerge-edit-mode message "Fast mode set" force-mode-line-update] 2 (#$ . 48513) nil]) #@167 Set edit mode, for Emerge. In this mode ordinary Emacs commands are available, and Emerge commands must be prefixed with \\[emerge-basic-keymap]. (defalias 'emerge-edit-mode #[nil "À !ˆÄÀÄÈÉ!ˆÊ ‡" [nil buffer-read-only use-local-map emerge-edit-keymap t emerge-mode emerge-fast-mode emerge-edit-mode message "Edit mode set" force-mode-line-update] 2 (#$ . 48918) nil]) #@252 Toggle Auto-Advance mode, for Emerge. This mode causes `emerge-select-A' and `emerge-select-B' to automatically advance to the next difference. With a positive argument, turn on Auto-Advance mode. With a negative argument, turn off Auto-Advance mode. (defalias 'emerge-auto-advance #[(arg) "„ ?‚Â!ÃVÄ ƒÅ‚Æ!ˆÇ ‡" [arg emerge-auto-advance prefix-numeric-value 0 message "Auto-advance set" "Auto-advance cleared" force-mode-line-update] 2 (#$ . 49321) "P"]) #@293 Toggle Skip-Prefers mode, for Emerge. This mode causes `emerge-next-difference' and `emerge-previous-difference' to automatically skip over differences for which there is a preference. With a positive argument, turn on Skip-Prefers mode. With a negative argument, turn off Skip-Prefers mode. (defalias 'emerge-skip-prefers #[(arg) "„ ?‚Â!ÃVÄ ƒÅ‚Æ!ˆÇ ‡" [arg emerge-skip-prefers prefix-numeric-value 0 message "Skip-prefers set" "Skip-prefers cleared" force-mode-line-update] 2 (#$ . 49794) "P"]) #@56 Put the A variant of this difference in the kill ring. (defalias 'emerge-copy-as-kill-A #[nil "À ˆ \nH‰ÄHT ÆHSÈ Š\nqˆË \"-‡" [emerge-validate-difference emerge-difference-list emerge-current-difference diff-vector 0 A-begin 1 A-end nil this-command emerge-A-buffer copy-region-as-kill] 4 (#$ . 50307) nil]) #@56 Put the B variant of this difference in the kill ring. (defalias 'emerge-copy-as-kill-B #[nil "À ˆ \nH‰ÄHT ÆHSÈ Š\nqˆË \"-‡" [emerge-validate-difference emerge-difference-list emerge-current-difference diff-vector 2 B-begin 3 B-end nil this-command emerge-B-buffer copy-region-as-kill] 4 (#$ . 50628) nil]) #@146 Insert the A variant of this difference at the point. Leaves point after text, mark before. With prefix argument, puts point before, mark after. (defalias 'emerge-insert-A #[(arg) "À ˆ \nH‰ÄHT ÆHS`É\nË\f #ˆ „,Î!‚3Î`!ˆb-‡" [emerge-validate-difference emerge-difference-list emerge-current-difference diff-vector 0 A-begin 1 A-end opoint nil buffer-read-only insert-buffer-substring emerge-A-buffer arg set-mark] 5 (#$ . 50950) "P"]) #@146 Insert the B variant of this difference at the point. Leaves point after text, mark before. With prefix argument, puts point before, mark after. (defalias 'emerge-insert-B #[(arg) "À ˆ \nH‰ÄHT ÆHS`É\nË\f #ˆ „,Î!‚3Î`!ˆb-‡" [emerge-validate-difference emerge-difference-list emerge-current-difference diff-vector 2 B-begin 3 B-end opoint nil buffer-read-only insert-buffer-substring emerge-B-buffer arg set-mark] 5 (#$ . 51406) "P"]) #@117 Leaves the point before this difference and the mark after it. With prefix argument, puts mark before, point after. (defalias 'emerge-mark-difference #[(arg) "À ˆ \nH‰ÄHT ÆHS„! bˆÉ!‚(bˆÉ !+‡" [emerge-validate-difference emerge-difference-list emerge-current-difference diff-vector 4 merge-begin 5 merge-end arg set-mark] 3 (#$ . 51862) "P"]) #@111 Show the names of the buffers or files being operated on by Emerge. Use C-u l to reset the windows afterward. (defalias 'emerge-file-names #[nil "À ˆÁÃpÅŽqˆƒ ÈÉ!ˆÈ!ˆ‚)ÈÊ!ˆÈË !ˆÈÌ!ˆ*pÍŽqˆƒGÈÏ!ˆÈ!ˆ‚PÈÐ!ˆÈË !ˆÈÌ!ˆ*ƒpÒŽqˆƒsÈÓ!ˆÈ!ˆ‚|ÈÔ!ˆÈË !ˆÈÌ!ˆ*È!ˆŠqˆ× )‘)‡" [delete-other-windows #[(buf) "À ˆÁ\n!ˆÃÄ!‡" [split-window-vertically switch-to-buffer buf other-window 1] 2] temp-buffer-show-function "*Help*" StartBuffer ((set-buffer StartBuffer)) emerge-A-buffer buffer-file-name princ "File A is: " "Buffer A is: " buffer-name "\n" ((set-buffer StartBuffer)) emerge-B-buffer "File B is: " "Buffer B is: " emerge-ancestor-buffer ((set-buffer StartBuffer)) "Ancestor file is: " "Ancestor buffer is: " emerge-output-description standard-output help-mode] 3 (#$ . 52223) nil]) #@107 Join the selected difference with the following one. With a prefix argument, join with the preceding one. (defalias 'emerge-join-differences #[(arg) "\nƒ S ÃW„ \fSYƒÅÆ!ˆÇ!ˆ\fSÃÈ\fÉ\"\n‰ \fWƒÂ\n ‰ WƒB\f H‚· VƒR\f TH‚·\f H\f TH ÏÃH ÐHÑH ÒHÓH ÔHÕH ÕH‰=ƒ’‚³Ø=„ Ù=ƒ²Ø=„®Ù=ƒ²Ø‚³Ú*&*Iˆ T‰ ‚+\n\f* Û ˆÜ!ˆÝ )‡" [emerge-current-difference n arg 0 emerge-number-of-differences error "Incorrect differences to join" emerge-unselect-difference make-vector nil new-differences i emerge-difference-list next prev vector 1 2 3 4 5 6 ns ps B prefer-B A emerge-refresh-mode-line emerge-select-difference emerge-recenter] 13 (#$ . 53034) "P"]) #@73 Split the current difference where the points are in the three windows. (defalias 'emerge-split-difference #[nil " ˆpÄŽ qˆÆ *pÇŽqˆÆ *Æ  H\n \f‰ \nÎHW„; \nÏHVƒ?ÐÑ!ˆ\f\nÒHW„S\f\nÓHVƒWÐÔ!ˆ \nÕHW„k \nÖHVƒoÐ×!ˆØ!ˆTÎÚÛ\"‰Wƒù‰ Wƒ› H‚î TVƒ¬ SH‚î UƒÏÞ\nÎH \nÒH\f\nÕH \nßH&‚îÞà !\nÏHà\f!\nÓHà !\nÖH\nßH&IˆT‰‚ƒ * á ˆâ!ˆã -‡" [emerge-current-difference n emerge-validate-difference StartBuffer ((set-buffer StartBuffer)) emerge-A-buffer point-marker ((set-buffer StartBuffer)) emerge-B-buffer emerge-difference-list old-diff merge-point B-point A-point 0 1 error "Point outside of difference in A buffer" 2 3 "Point outside of difference in B buffer" 4 5 "Point outside of difference in merge buffer" emerge-unselect-difference emerge-number-of-differences make-vector nil new-differences i vector 6 copy-marker emerge-refresh-mode-line emerge-select-difference emerge-recenter] 12 (#$ . 53741) nil]) #@240 Trim lines off top and bottom of difference that are the same. If lines are the same in both the A and the B versions, strip them off. (This can happen when the A and B versions have common lines that the ancestor version does not share.) (defalias 'emerge-trim-difference #[nil "À ˆÁ\n!ˆ \nHÅ\fÆH!Å\fÈH! Å\fÊH! Å\fÌH! Å\fÎH!Å\fÐH!ÒÒÒÒÒØØÆVƒÙÙƒÏ Z  ZZ^^^pÛŽqˆ\\{*pÝŽqˆ  \\{*\\{ÆV…±š…±š‰ƒP\\ \\ \\‚PÊ¥‰‚HØØÆVƒnÙƒd Z  ZZ^^^pߎqˆ Z {*pàŽqˆ Z {*Z{ÆV…Fš…Fš‰ƒå Z  Z Z‚åÊ¥‰‚ÝpáŽqˆbˆÆyˆ\fÆâ Iˆ bˆÈyˆ\fÈâ Iˆ*pãŽqˆ bˆÆyˆ\fÊâ Iˆ bˆÈyˆ\fÌâ Iˆ*bˆÆyˆ\fÎâ IˆbˆÈyˆ\fÐâ Iˆä\n!ˆå .\f‡" [emerge-validate-difference emerge-unselect-difference emerge-current-difference emerge-difference-list diff marker-position 0 top-a 1 bottom-a 2 top-b 3 bottom-b 4 top-m 5 bottom-m nil size success sa sb sm 1000 t StartBuffer ((set-buffer StartBuffer)) emerge-A-buffer ((set-buffer StartBuffer)) emerge-B-buffer ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) ((set-buffer StartBuffer)) point-marker ((set-buffer StartBuffer)) emerge-select-difference emerge-recenter] 6 (#$ . 54727) nil]) #@251 Find the difference containing the current position of the point. If there is no containing difference and the prefix argument is positive, it finds the nearest following difference. A negative prefix argument finds the nearest previous difference. (defalias 'emerge-find-difference #[(arg) "p=ƒ\nÁ\n!‡p =ƒÄ\n!‡Å\n!‡" [emerge-A-buffer emerge-find-difference-A arg emerge-B-buffer emerge-find-difference-B emerge-find-difference-merge] 2 (#$ . 56008) "P"]) #@244 Find the difference containing point, in the merge buffer. If there is no containing difference and the prefix argument is positive, it finds the nearest following difference. A negative prefix argument finds the nearest previous difference. (defalias 'emerge-find-difference-merge #[(arg) "À `ÂÃ$‡" [emerge-find-difference1 arg 4 5] 5 (#$ . 56476) "P"]) #@291 Find the difference containing point, in the A buffer. This command must be executed in the merge buffer. If there is no containing difference and the prefix argument is positive, it finds the nearest following difference. A negative prefix argument finds the nearest previous difference. (defalias 'emerge-find-difference-A #[(arg) "À pÃŽ\fqˆ`*ÅÆ$‡" [emerge-find-difference1 arg StartBuffer ((set-buffer StartBuffer)) emerge-A-buffer 0 1] 5 (#$ . 56839) "P"]) #@291 Find the difference containing point, in the B buffer. This command must be executed in the merge buffer. If there is no containing difference and the prefix argument is positive, it finds the nearest following difference. A negative prefix argument finds the nearest previous difference. (defalias 'emerge-find-difference-B #[(arg) "À pÃŽ\fqˆ`*ÅÆ$‡" [emerge-find-difference1 arg StartBuffer ((set-buffer StartBuffer)) emerge-B-buffer 2 3] 5 (#$ . 57309) "P"]) (defalias 'emerge-find-difference1 #[(arg location begin end) "ÀÁ‰ W…Ä \nHH!XÉ\n! ̃'\n‚W\n„2ÍÎ!‚W ÏVƒI\n WƒC\n‚WÍÐ!‚W\nÏVƒT\nS‚WÍÑ!!+‡" [search (byte-code "ÀÀ\nWƒ$ H Æ\fH!XƒÈÉ \"ˆ) T‰‚)\n‡" [0 n emerge-number-of-differences emerge-difference-list diff-vector location marker-position end throw search] 5) index emerge-number-of-differences marker-position emerge-difference-list begin location contains prefix-numeric-value arg arg-value emerge-unselect-and-select-difference error "No difference contains point" 0 "No difference contains or follows point" "No difference contains or precedes point"] 4]) #@121 Display the current line numbers. This function displays the line numbers of the points in the A, B, and merge buffers. (defalias 'emerge-line-numbers #[nil "ÁY… \nW‰…\fHÆÇÈ\" p\nËŽ\fqˆÆÁÍ\"*p\nÏŽqˆÆÑÒ\"*ÔÕ $-‡" [emerge-current-difference 0 emerge-number-of-differences valid-diff emerge-difference-list diff emerge-line-number-in-buf 4 5 merge-line StartBuffer ((set-buffer StartBuffer)) emerge-A-buffer 1 A-line ((set-buffer StartBuffer)) emerge-B-buffer 2 3 B-line message "At lines: merge = %d, A = %d, B = %d"] 6 (#$ . 58422) nil]) (defalias 'emerge-line-number-in-buf #[(begin-marker end-marker) "ÀŠÂyˆÃÄ`\"T) ƒ/`HVƒ Z` HVƒ/ \nZ )‡" [nil temp 0 count-lines 1 valid-diff diff begin-marker emerge-before-flag-lines end-marker emerge-after-flag-lines] 3]) #@281 Set `emerge-combine-versions-template' to STRING. This value controls how `emerge-combine-versions' combines the two versions. With prefix argument, `emerge-combine-versions-template' is made local to this merge buffer. Localization is permanent for any particular merge buffer. (defalias 'emerge-set-combine-template #[(string &optional localize) "ƒÁÂ!ˆ ÄÂÅ žƒÆ‚Ç!‡" [localize make-local-variable emerge-combine-versions-template string message buffer-local-variables "emerge-set-combine-versions-template set locally" "emerge-set-combine-versions-template set"] 3 (#$ . 59229) "s\nP"]) #@282 Copy region into `emerge-combine-versions-template'. This controls how `emerge-combine-versions' will combine the two versions. With prefix argument, `emerge-combine-versions-template' is made local to this merge buffer. Localization is permanent for any particular merge buffer. (defalias 'emerge-set-combine-versions-template #[(start end &optional localize) "ƒÁÂ!ˆ \f{ÅÂÆ žƒÇ‚È!‡" [localize make-local-variable emerge-combine-versions-template start end message buffer-local-variables "emerge-set-combine-versions-template set locally." "emerge-set-combine-versions-template set."] 3 (#$ . 59833) "r\nP"]) #@266 Combine versions using the template in `emerge-combine-versions-template'. Refuses to function if this difference has been edited, i.e., if it is neither the A nor the B variant. An argument forces the variant to be selected even if the difference has been edited. (defalias 'emerge-combine-versions #[(&optional force) "À \n\"‡" [emerge-combine-versions-internal emerge-combine-versions-template force] 3 (#$ . 60458) "P"]) #@358 Combine the two versions using the template in register REG. See documentation of the variable `emerge-combine-versions-template' for how the template is interpreted. Refuses to function if this difference has been edited, i.e., if it is neither the A nor the B variant. An argument forces the variant to be selected even if the difference has been edited. (defalias 'emerge-combine-versions-register #[(char &optional force) "À !‰;„ ÃÄ!ˆÅ\n\")‡" [get-register char template error "Register does not contain text" emerge-combine-versions-internal force] 4 (#$ . 60890) "cRegister containing template: \nP"]) (defalias 'emerge-combine-versions-internal #[(template force) "À ‰‰$)‡" [#[nil "À \n \f &ˆ…È ‡" [emerge-combine-versions-edit merge-begin merge-end A-begin A-end B-begin B-end emerge-auto-advance emerge-next-difference] 7] operate emerge-select-version force] 5]) (defalias 'emerge-combine-versions-edit #[(merge-begin merge-end A-begin A-end B-begin B-end) "pÁŽ\nqˆ \f|ˆ bˆÅÅGWƒxH‰ÉUƒjTÊË̉ÍUƒCÎ#ˆ‚nÒUƒVÎ#ˆ‚nÉUƒcÉcˆ‚ncˆ‚ncˆ)T‰‚) bˆ×ØIˆÙ *‡" [StartBuffer ((set-buffer StartBuffer)) emerge-merge-buffer merge-begin merge-end 0 i template c 37 nil (aref template i) ((error 37)) 97 insert-buffer-substring emerge-A-buffer A-begin A-end 98 emerge-B-buffer B-begin B-end diff-vector 6 combined emerge-refresh-mode-line] 5]) #@147 Set the major mode in a merge buffer. Overrides any change that the mode might make to the mode line or local keymap. Leaves merge in fast mode. (defalias 'emerge-set-merge-mode #[(mode) " ˆÁ ˆ\nƒ  ‡Ã ‡" [mode emerge-refresh-mode-line emerge-fast-mode emerge-edit-mode] 1 (#$ . 62295) (list (intern (completing-read "New major mode for merge buffer: " obarray (quote commandp) t nil)))]) (defalias 'emerge-one-line-window #[nil "ÀÂà ÄZ!)‡" [1 window-min-height shrink-window window-height 2] 3 nil nil]) (defalias 'emerge-select-difference #[(n) " Ä ÇÈ$ˆÄ ÊË$ˆÄÌÍÎ$ˆ*ÏÐ!‡" [emerge-difference-list emerge-number-of-differences emerge-globalized-number-of-differences emerge-globalized-difference-list emerge-place-flags-in-buffer emerge-A-buffer n 0 1 emerge-B-buffer 2 3 nil 4 5 run-hooks emerge-select-hook] 5]) (defalias 'emerge-place-flags-in-buffer #[(buffer difference before-index after-index) "ƒpÂŽqˆÃ\f #*‡Ã\f #‡" [buffer StartBuffer ((set-buffer StartBuffer)) emerge-place-flags-in-buffer1 difference before-index after-index] 4]) (defalias 'emerge-place-flags-in-buffer1 #[(difference before-index after-index) "À\n H\fHÀ‰bˆÇ!ˆ`‰SÀ“ˆ SÀ‰‰ \n ‰\fÍYƒb\n\fH‰ H‰ Uƒb ‰SÀ“ˆ \fH‰\n UƒY\nS\n\fS‰\f‚*.\n HHÐ!‰bˆcˆ‰TÀ“ˆ TÀ‰‰  \n‰\fW…Æ\n\fH‰ \fH‰\n U…Æ\n‰TÀ“ˆ H‰ Uƒ½ T \fT‰\f‚.‡" [nil buffer-read-only emerge-globalized-difference-list difference before-index here before insert-before-markers emerge-before-flag diff-list before-marker after-marker n 0 after-index after marker-position emerge-after-flag emerge-globalized-number-of-differences] 5]) (defalias 'emerge-unselect-difference #[(n) " HÃ\f\nÅH\nÆH#ˆÃ\nÈH\nÉH#ˆÃ\n\nËH\nÌH#ˆ)ÍÎ!‡" [emerge-difference-list n diff-vector emerge-remove-flags-in-buffer emerge-A-buffer 0 1 emerge-B-buffer 2 3 emerge-merge-buffer 4 5 run-hooks emerge-unselect-hook] 5]) (defalias 'emerge-remove-flags-in-buffer #[(buffer before after) "pÁŽ\nqˆÃ SZbˆÇ!ƒÉ!ˆ‚&Ê ˆËÌ!ˆ SbˆÇ!ƒ9É!‚?Ê ˆËÌ!+‡" [StartBuffer ((set-buffer StartBuffer)) buffer nil buffer-read-only before emerge-before-flag-length looking-at emerge-before-flag-match delete-char ding message "Trouble removing flag" after emerge-after-flag-match emerge-after-flag-length] 2]) (defalias 'emerge-unselect-and-select-difference #[(n &optional suppress-display) "ÁYƒ\nWƒÃ!ˆ\fÁYƒH\f\nWƒHÅ\f!ˆ\fH‰ÈH‰ Ê=ƒ:ÈËIˆ‚G Ì=ƒGÈÍIˆ*\f?…UÏ ˆÐ ‡" [emerge-current-difference 0 emerge-number-of-differences emerge-unselect-difference n emerge-select-difference emerge-difference-list diff-vector 6 selection-type default-A A default-B B suppress-display emerge-recenter emerge-refresh-mode-line] 4]) (defalias 'emerge-select-version #[(force a-version b-version neither-version) "À ˆÁ \fH‰ÆHT ÈHS ÊHT ÌHS ÎHT ÐHSÒ &ƒE ‚sÒ  &ƒ] ‚s„jUƒp ‚sÚÛ!.‡" [emerge-validate-difference nil buffer-read-only emerge-difference-list emerge-current-difference diff-vector 0 A-begin 1 A-end 2 B-begin 3 B-end 4 merge-begin 5 merge-end emerge-compare-buffers emerge-A-buffer emerge-merge-buffer a-version emerge-B-buffer b-version force neither-version error "This difference region has been edited"] 8]) (defalias 'emerge-read-file-name #[(prompt alternative-default-dir default-file A-file must-match) "ƒ+ ƒ+\nƒ+\nà !˜„+ÄÅÆÈ !#\n‰È !P …)Ê$‡ ƒGÄÅÆ #…=\n  …EÊ$‡ÄÌP…Q\nÍ …XÊ$‡" [emerge-default-last-directories A-file alternative-default-dir file-name-directory read-file-name format "%s (default %s): " prompt file-name-nondirectory must-match confirm default-file ": " nil] 6]) (defalias 'emerge-refresh-mode-line #[nil "ÀÁ\nT \nÄYƒ\n Wƒ \nHÆHÇžA‚È$C Ê ‡" [format "Emerge: %%b diff %d of %d%s" emerge-current-difference emerge-number-of-differences 0 emerge-difference-list 6 ((A . " - A") (B . " - B") (prefer-A . " - A*") (prefer-B . " - B*") (combined . " - comb")) "" mode-line-buffer-identification force-mode-line-update] 6]) (defalias 'emerge-compare-buffers #[(buffer-x x-begin x-end buffer-y y-begin y-end) " Z\n ZU??…ÄŇ" [x-end x-begin y-end y-begin exit (byte-code " WƒK ZÂ^pÅŽqˆ‰ \\{*pÈŽ qˆ\n‰ \\{*  ˜„=ÌÍÎ\"ˆ‚G \\\n \\\n+‚χ" [x-begin x-end 1000 compare-length StartBuffer ((set-buffer StartBuffer)) buffer-x x-string ((set-buffer StartBuffer)) buffer-y y-begin y-string throw exit nil t] 3)] 3]) (defalias 'emerge-unique-buffer-name #[(prefix suffix) "À \nP!„\f \nP‡ÃÀÅÆ \f\n$!ƒ\fT‚ÅÆ \f\n$)‡" [get-buffer prefix suffix 2 n format "%s<%d>%s"] 6]) (defalias 'emerge-validate-difference #[nil "ÁY… \nW?…ÃÄ!‡" [emerge-current-difference 0 emerge-number-of-differences error "No difference selected"] 2]) (defalias 'emerge-save-variables #[(vars) "ÀÁ\n\"‡" [mapcar #[(v) "9ƒJ‡@ ‡" [v] 1] vars] 3]) (defalias 'emerge-restore-variables #[(vars values) "…&@ @‰9ƒ \nLˆ‚ A@\n!ˆ*A A‚‡" [vars values value var] 3]) (defalias 'emerge-make-temp-file #[(prefix) "À \nP!Äee ÅÆ%ˆÇ \"ˆ )‡" [make-temp-name emerge-temp-file-prefix prefix f write-region nil no-message set-file-modes emerge-temp-file-mode] 6]) #@168 Ask the user whether to write out an incomplete merge. If answer is yes, call `write-file' to do so. See `emerge-query-and-call' for details of the querying process. (defalias 'emerge-query-write-file #[nil "ÀÁ!‡" [emerge-query-and-call write-file] 2 (#$ . 67459) nil]) #@164 Ask the user whether to save an incomplete merge. If answer is yes, call `save-buffer' to do so. See `emerge-query-and-call' for details of the querying process. (defalias 'emerge-query-save-buffer #[nil "ÀÁ!‡" [emerge-query-and-call save-buffer] 2 (#$ . 67737) nil]) #@182 Ask the user whether to save or write out the incomplete merge. If answer is yes, call COMMAND interactively. During the call, the flags around the current difference are removed. (defalias 'emerge-query-and-call #[(command) "ÀÁ!ƒ.\nÃYƒ\n\fWƒÅ\n!ˆÆ!ˆ\nÃY…-\n\fW…1È\n!ˆÉ ‡ÊË!‡" [yes-or-no-p "Do you really write to write out this unfinished merge? " emerge-current-difference 0 emerge-number-of-differences emerge-unselect-difference call-interactively command emerge-select-difference emerge-recenter message "Not written"] 2 (#$ . 68013)]) (defalias 'emerge-verify-file-buffer #[nil "Àp!ƒÁ …8ÂÃÄ \"!ƒÆ ‡ÇÈ \"‡Á ƒ&ÇÈ \"‡ÂÃÉ \"!ƒ4Êˉ\"‡ÇÈ \"‡" [verify-visited-file-modtime buffer-modified-p yes-or-no-p format "Save file %s? " buffer-file-name save-buffer error "Buffer out of sync for file %s" "Revert file %s? " revert-buffer t] 4]) (defalias 'emerge-copy-modes #[(buffer) "pÁŽ\nqˆ * ‡" [StartBuffer ((set-buffer StartBuffer)) buffer major-mode] 1]) #@138 Like `define-key', but forcibly creates prefix characters as needed. If some prefix of KEY has a non-prefix definition, it is redefined. (defalias 'emerge-force-define-key #[(keymap key definition) "À \n\"‰¨ƒÄ \nÅ OÆ#ˆ)Ä \n#‡" [lookup-key keymap key v define-key 0 nil definition] 6 (#$ . 68989)]) (defalias 'emerge-define-key-if-possible #[(keymap key definition) "À \n\"‰¨ƒÀ \nÄ O\"?…)Å \n#‚) ?…)Å \n#)‡" [lookup-key keymap key present 0 define-key definition] 6]) #@285 Displays the name of the file loaded into the current buffer. If the name won't fit on one line, the minibuffer is expanded to hold it, and the command waits for a keystroke from the user. If the keystroke is SPC, it is ignored; if it is anything else, it is processed as a command. (defalias 'emerge-show-file-name #[nil "À ‰„ ÂË)‡" [buffer-file-name name "Buffer has no file name." ((byte-code "ÀÁ !ˆÂ ˆ cˆÄ ?…;ÅÄ „)Ç SÈ Vƒ)ÉÊ!ˆ‚Ë ‰\fÍ=?…:\fC‰*‡" [select-window minibuffer-window erase-buffer name pos-visible-in-window-p 0 echo-keystrokes screen-height window-height enlarge-window 1 read-event c 32 unread-command-events] 3))] 2 (#$ . 69478) nil]) #@229 Return file name to use for auto-saves of current buffer. Does not consider `auto-save-visited-file-name'; that is checked before calling this function. You can redefine this for customization. See also `auto-save-file-name-p'. (defalias 'emerge-make-auto-save-file-name #[nil "ƒ*Á!ÂÃ!ÂRÅ\f!ƒ\f‚(ÆÇ!ÈÃ!ÉÊÁ!!°)‡ËÆÇ!ÌÍÎ !ÏÐÑ!°!‡" [buffer-file-name file-name-directory "#" file-name-nondirectory f file-writable-p getenv "HOME" "/#&" "&" emerge-hash-string-into-string expand-file-name "/#%" emerge-unslashify-name buffer-name "%" make-temp-name ""] 7 (#$ . 70154)]) (defalias 'emerge-hash-string-into-string #[(s) "ÀÁ‰‰‰‰%Á\n\fGWƒ+ \nŦ \nŦHÆ_\f\nH\\ǦIˆ\nT‰‚ ÈÉ Ê#*‡" [vector 0 i bins s 5 35 65536 mapconcat #[(b) "Á¦Â\\‰ÃYƒTÄ!‡" [b 93 33 47 char-to-string] 3] ""] 7]) (defalias 'emerge-unslashify-name #[(s) "ÀÂÃ\f #ƒ-\fÀ‰”O\fÀ”À•OŘƒÆ‚Ç\fÀ•ÈOQÀ•T‚)\f‡" [0 limit string-match "[/\\]" s "/" "\\!" "\\\\" nil] 5]) #@138 Characters that must be quoted with \ when used in a shell command line. More precisely, a [...] regexp to match any one such character. (defvar emerge-metachars "[ \n!\"#$&'()*;<=>?[\\^`{|~]" (#$ . 71110)) (defalias 'emerge-protect-metachars #[(s) "À \f #ƒ\fÀ‰”OÅ\fÀ”ÆOQÀ•T‚)\f‡" [0 limit string-match emerge-metachars s "\\" nil] 5]) (provide (quote emerge)) emacs-19.30/lisp/enriched.elc100666 12120 1 24761 6051026771 14361 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 00:00:31 1995 ;;; from file /home/fsf/rms/e19/lisp/enriched.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`enriched.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆ\nƒ\fÃÄ!ˆÀ‡" [provide enriched window-system require facemenu] 2) #@67 *If non-nil, give status messages when reading and writing files. (defvar enriched-verbose t (#$ . -559)) #@238 *Default amount of space to leave on the right edge of the screen. This can be increased inside text by changing the 'right-margin text property. Measured in character widths. If the screen is narrower than this, it is assumed to be 0. (defvar enriched-default-right-margin 10 (#$ . -672)) #@267 If t, fills paragraphs when reading in enriched documents. If nil, only fills when you explicitly request it. If the value is 'ask, then it will query you whether to fill. Filling is never done if the current text-width is the same as the value stored in the file. (defvar enriched-fill-after-visiting t (#$ . 970)) (byte-code "ÀÁ!„\"ÂÁ!ˆ ƒ\"ÄÁÅÆÇÈ #†ÅÉÇÈ #@\"ˆÀÊ!„6ÂÊ!ˆ ƒ6ËÊÌÍ#ˆÎ!†?Ð ÑBÓÔÕ SÖ\"I‡" [internal-find-face fixed make-face window-system set-face-font x-list-fonts "*fixed-medium*" default selected-frame "*fixed*" excerpt make-face-italic nil t copy-sequence standard-display-table make-display-table enriched-display-table current-load-list 12 make-vector frame-width 45] 6) #@120 Text-properties that usually apply to whole paragraphs. These are set front-sticky everywhere except at hard newlines. (defconst enriched-par-props (quote (left-margin right-margin justification)) (#$ . 1683)) #@191 What to insert at the start of a text/enriched file. If this is a string, it is inserted. If it is a list, it should be a lambda expression, which is evaluated to get the string to insert. (defconst enriched-initial-annotation #[nil "ÀÁ \"‡" [format "Content-Type: text/enriched\nText-Width: %d\n\n" enriched-text-width] 3] (#$ . 1900)) #@46 General format of enriched-text annotations. (defconst enriched-annotation-format "<%s%s>" (#$ . 2245)) #@56 Regular expression matching enriched-text annotations. (defconst enriched-annotation-regexp "<\\(/\\)?\\([-A-za-z0-9]+\\)>" (#$ . 2355)) #@149 List of definitions of text/enriched annotations. See `format-annotate-region' and `format-deannotate-region' for the definition of this structure. (defconst enriched-translations (quote ((face (bold-italic "bold" "italic") (bold "bold") (italic "italic") (underline "underline") (fixed "fixed") (excerpt "excerpt") (default) (nil enriched-encode-other-face)) (left-margin (4 "indent")) (right-margin (4 "indentright")) (justification (none "nofill") (right "flushright") (left "flushleft") (full "flushboth") (center "center")) (PARAMETER (t "param")) (FUNCTION (enriched-decode-foreground "x-color") (enriched-decode-background "x-bg-color")) (read-only (t "x-read-only")) (unknown (nil format-annotate-value)))) (#$ . 2499)) #@176 Properties that are OK to ignore when saving text/enriched files. Any property that is neither on this list nor dealt with by `enriched-translations' will generate a warning. (defconst enriched-ignore (quote (front-sticky rear-nonsticky hard)) (#$ . 3234)) #@36 True if `enriched-mode' is in use. (defvar enriched-mode nil (#$ . 3497)) (byte-code "ÀÁ!ˆÁ\nž„Ã\nBÀ‡" [make-variable-buffer-local enriched-mode minor-mode-alist (enriched-mode " Enriched")] 2) #@257 Functions to run when entering `enriched-mode'. If you set variables in this hook, you should arrange for them to be restored to their old values if enriched-mode is left. One way to do this is to add them and their old values to `enriched-old-bindings'. (defvar enriched-mode-hooks nil (#$ . 3701)) #@111 Store old variable values that we change when entering mode. The value is a list of (VAR VALUE VAR VALUE...). (defvar enriched-old-bindings nil (#$ . 4009)) (byte-code "ÀÁ!ˆÂÃ!„\fÄà BÀÃ!‡" [make-variable-buffer-local enriched-old-bindings boundp enriched-text-width nil current-load-list] 2) #@361 Minor mode for editing text/enriched files. These are files with embedded formatting information in the MIME standard text/enriched format. Turning the mode on runs `enriched-mode-hooks'. More information about enriched-mode is available in the file etc/enriched.doc in the Emacs distribution directory. Commands: \\{enriched-mode-map} (defalias 'enriched-mode #[(&optional arg) "À  !ÄX„ ƒ4 „4ÆÇÈ \" \nƒª\n@\nA@Lˆ\nAA‰\n‚ „ªËÈ >„GÈ B Ì\fÍ Îϯ\nÐÍ!ˆÐÎ!ˆÐÏ!ˆÑ \fËÓÔ\"ƒ—@>„Ž@BA‰„}ƒ¥ØÔ#*ÙÚ!ˆÛ !ˆÜ )‡" [buffer-modified-p mod prefix-numeric-value arg 0 enriched-mode nil delq text/enriched buffer-file-format enriched-old-bindings t buffer-display-table indent-line-function use-hard-newlines default-text-properties make-local-variable indent-to-left-margin enriched-display-table plist-get front-sticky enriched-par-props p sticky plist-put run-hooks enriched-mode-hooks set-buffer-modified-p force-mode-line-update] 9 (#$ . 4311) "P"]) #@29 Keymap for `enriched-mode'. (defvar enriched-mode-map nil (#$ . 5347)) (byte-code "„ ÀÁ ‰MˆÂ ž„ÂB BÄÅÆ#ˆÄÇÈ#ˆÄÉÈ#ˆÄÊË#ˆÄÌÍ#ˆÄÎÏ#ˆÄÐÑ#ˆÄÒÓ#‡" [enriched-mode-map make-sparse-keymap enriched-mode minor-mode-map-alist define-key "" beginning-of-line-text " " reindent-then-newline-and-indent "\n" "ê" facemenu-justification-menu "Ó" set-justification-center " " increase-left-margin "\f" set-left-margin "" set-right-margin] 4) #@378 Apply a function to regions of the buffer based on a text property. For each contiguous region of the buffer for which the value of PROPERTY is eq, the FUNCTION will be called. Optional arguments FROM and TO specify the region over which to scan. The specified function receives three arguments: the VALUE of the property in the region, and the START and END of each region. (defalias 'enriched-map-property-regions #[(prop func &optional from to) "ŠŒƒ\ne}ˆ †ebˆ`Âà Ä` \" Ê d $‰ƒR“ˆ  Ì!#ˆÌ! Ä \"‚! dW…a  d#.‡" [to from nil make-marker get-text-property prop val marker end begin text-property-not-all func marker-position] 6 (#$ . 5798)]) (put (quote enriched-map-property-regions) (quote lisp-indent-hook) 1) #@45 Indent and justify each line in the region. (defalias 'enriched-insert-indentation #[(&optional from to) "ŠŒƒ\ne}ˆ †ebˆn„Âyˆm?…1l„+à jˆÄÅÆÅ#ˆÂyˆ‚*‡" [to from 1 current-left-margin justify-current-line t nil] 4 (#$ . 6560)]) #@132 The width of unindented text in this window, in characters. This is the width of the window minus `enriched-default-right-margin'. (defalias 'enriched-text-width #[nil "†Á ‰ Vƒ\n Z‚\n‰)‡" [enriched-text-width window-width ww enriched-default-right-margin] 3 (#$ . 6802)]) (defalias 'enriched-encode #[(from to) "ƒÁÂ!ˆŒ \f}ˆÅ ˆÆ ˆ bˆÇÈ!ˆÉÊ d Ì %!ˆ bˆ;ƒ4‚7 cˆÏÐÑ`Ò$ˆƒHÁÒ!ˆd)‡" [enriched-verbose message "Enriched: encoding document..." from to delete-to-left-margin unjustify-region format-replace-strings (("<" . "<<")) format-insert-annotations format-annotate-region enriched-translations enriched-make-annotation enriched-ignore enriched-initial-annotation enriched-map-property-regions hard #[(v b e) "… fÂU… bˆÃc‡" [v b 10 "\n"] 2] nil] 7]) #@127 Format an annotation called NAME. If POSITIVE is non-nil, this is the opening annotation, if nil, this is the matching close. (defalias 'enriched-make-annotation #[(name positive) ";ƒÁ\n ƒÄ‚Å#‡ ƒ.@AÁ\nÄ#ÈÉÄ#P*‡Á\nÅ@#‡" [name format enriched-annotation-format positive "" "/" params item mapconcat #[(i) "À ÂQ‡" ["" i ""] 3]] 5 (#$ . 7583)]) #@119 Generate annotations for random face change. One annotation each for foreground color, background color, italic, etc. (defalias 'enriched-encode-other-face #[(old new) "…Á!\n…Á\n!B‡" [old enriched-face-ans new] 3 (#$ . 7966)]) #@37 Return annotations specifying FACE. (defalias 'enriched-face-ans #[(face) "ÀÁ !\"ƒÄ !ÅÆODC‡ÀÇ !\"ƒ&È !ÅÆODC‡É !\nË !\fÍ Î\"ÐÃÆ$A\nƒOÄ\nDB\fƒ]È\fDB,‡" [string-match "^fg:" symbol-name face "x-color" 3 nil "^bg:" "x-bg-color" face-foreground fg face-background bg face-font t props format-annotate-single-property-change enriched-translations ans] 5 (#$ . 8205)]) (defalias 'enriched-decode #[(from to) "ƒÁÂ!ˆŠŒ \f}ˆ bˆÅ ÆÉ ˆ bˆÊËÌÆ#ƒBÍ ƒ/ÎÏ!ˆÐÑ”`ÒÆ$ˆÐÑ”`ÓÌ$ˆ‚Ô dÖ$ˆƒW× U„iƒiÙ=ƒoÚÛ!„oÜ ˆ‚|ƒwÁÝ!ˆÞed\"ˆ*ƒ…ÁÌ!ˆd*‡" [enriched-verbose message "Enriched: decoding document..." from to enriched-get-file-width t use-hard-newlines file-width enriched-remove-header search-forward-regexp "\n\n+" nil current-justification delete-char -1 put-text-property 0 hard front-sticky format-deannotate-region enriched-translations enriched-next-annotation enriched-text-width enriched-fill-after-visiting ask y-or-n-p "Re-fill for current display width? " enriched-insert-indentation "Filling paragraphs..." fill-region] 5]) #@170 Find and return next text/enriched annotation. Any "<<" strings encountered are converted to "<". Return value is (begin end name positive-p), or nil if none was found. (defalias 'enriched-next-annotation #[nil "ÀÁÂÃ#ƒ/Ä”bˆÅ!„/Ãuˆ`fÇUƒ$ÈÃ!ˆ‚ÉÊË`S\"!ˆ‚m?…SÄ”\fÄ• ΔΕ{—Ô?\f F,‡" [search-forward "<" nil 1 0 looking-at enriched-annotation-regexp 60 delete-char message format "Warning: malformed annotation in file at %s" beg end 2 name pos] 4 (#$ . 9282)]) #@47 Look for file width information on this line. (defalias 'enriched-get-file-width #[nil "ŠÀÁ`Â\\Ã#…Äp!)‡" [search-forward "Text-Width: " 1000 t read] 4 (#$ . 9767)]) #@37 Remove file-format header at point. (defalias 'enriched-remove-header #[nil "ÀÁ!ƒ`•|ˆ‚ÀÃ!…ÄÅ!‡" [looking-at "^[-A-Za-z]+: .*\n" 0 "^\n" delete-char 1] 2 (#$ . 9940)]) (defalias 'enriched-decode-foreground #[(from to color) "ÀÁ\nP!Ä !„- ƒÆ !„- ƒ\"ÇÈ\n\"ˆ‚-É !ƒ-ÇÊ\n\"ˆ \fà F)‡" [intern "fg:" color face internal-find-face window-system facemenu-get-face message "Warning: color \"%s\" is not defined." make-face "Warning: Color \"%s\" can't be displayed." from to] 4]) (defalias 'enriched-decode-background #[(from to color) "ÀÁ\nP!Ä !„- ƒÆ !„- ƒ\"ÇÈ\n\"ˆ‚-É !ƒ-ÇÊ\n\"ˆ \fà F)‡" [intern "bg:" color face internal-find-face window-system facemenu-get-face message "Warning: color \"%s\" is not defined." make-face "Warning: Color \"%s\" can't be displayed." from to] 4]) emacs-19.30/lisp/env.elc100666 74777 1 4431 6032175507 13363 0ustar esrdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Sep 27 03:20:36 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/env.el ;;; emacs version 19.29.12. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`env.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!„ÂÁ B‡" [boundp read-envvar-name-history nil current-load-list] 2) #@206 Read environment variable name, prompting with PROMPT. Optional second arg MUSTMATCH, if non-nil, means require existing envvar name. If it is also not t, RET does not exit if it does non-null completion. (defalias 'read-envvar-name #[(prompt &optional mustmatch) "À ÂÃ\f\"ÅÅÇ&‡" [completing-read prompt mapcar #[(enventry) "ÁÂÃ\"OC‡" [enventry 0 string-match "="] 5] process-environment nil mustmatch read-envvar-name-history] 7 (#$ . 560)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp setenv-history nil current-load-list] 2) #@450 Set the value of the environment variable named VARIABLE to VALUE. VARIABLE should be a string. VALUE is optional; if not provided or is `nil', the environment variable VARIABLE will be removed. Interactively, a prefix argument means to unset the variable. Interactively, the current value (if any) of the variable appears at the front of the history list when you type in the new value. This function works by modifying `process-environment'. (defalias 'setenv #[(variable &optional value unset) "ƒÁÃÄ \"ƒÆÇ \"‡ÈÉ ÄP!PÁ\nÁ \f  Ϙƒ/Ð\n!ˆ\fƒgÃ\f@\"ƒ^Ñ \nÁ=ƒSÒ\f@\n\"\n‚[\f Ä\nQ ˆÁ\f\fA‰\f„4 †z\n…z Ä\nQ\nB‰\n,‡" [unset nil value string-match "=" variable error "Environment variable name `%s' contains `='" "\\`" regexp-quote process-environment found scan case-fold-search pattern "TZ" set-time-zone-rule t delq] 5 (#$ . 1092) (byte-code "ƒ\fÁÂÃ\"ÄÅE‡ÁÆÄ\"È! Ä\nÄ  \f@šƒ*Ä  ƒ6 \fB\f\f ÍÎÏ\"ĉ‰Ì%\n ƒc \f=ƒ\\\fA\f‚c\f‰AA¡ˆ\n,D‡" [current-prefix-arg read-envvar-name "Clear environment variable: " exact nil t "Set environment variable: " var getenv oldval newval oldhist setenv-history read-from-minibuffer format "Set %s to value: "] 6)]) (provide (quote env)) emacs-19.30/lisp/etags.elc100666 12062 1 100411 6053337025 13653 0ustar bobdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Sat Nov 18 06:05:18 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/etags.el ;;; emacs version 19.29.91.4. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`etags.el' was compiled for Emacs 19.29 or later")) #@207 *File name of tags table. To switch to a new tags table, setting this variable is sufficient. If you set this variable, do not also set `tags-table-list'. Use the `etags' program to make a tags table file. (defvar tags-file-name nil (#$ . -476)) #@307 *List of file names of tags tables to search. An element that is a directory means the file "TAGS" in that directory. To switch to a new list of tags tables, setting this variable is sufficient. If you set this variable, do not also set `tags-file-name'. Use the `etags' program to make a tags table file. (defvar tags-table-list nil (#$ . -729)) #@242 *Control whether to add a new tags table to the current list. t means do; nil means don't (always start a new list). Any other value means ask the user whether to add a new tags table to the current list (as opposed to starting a new list). (defvar tags-add-tables (quote ask-user) (#$ . -1083)) #@444 List of tags tables to search, computed from `tags-table-list'. This includes tables implicitly included by other tables. The list is not always complete: the included tables of a table are not known until that table is read into core. An element that is `t' is a placeholder indicating that the preceding element is a table that has not been read into core and might contain included tables to search. See `tags-table-check-computed-list'. (defvar tags-table-computed-list nil (#$ . 1386)) #@202 Value of `tags-table-list' that `tags-table-computed-list' corresponds to. If `tags-table-list' changes, `tags-table-computed-list' is thrown away and recomputed; see `tags-table-check-computed-list'. (defvar tags-table-computed-list-for nil (#$ . 1886)) #@150 Pointer into `tags-table-computed-list' for the current state of searching. Use `visit-tags-table-buffer' to cycle through tags tables in this list. (defvar tags-table-list-pointer nil (#$ . 2148)) #@76 Pointer into `tags-table-computed-list', where the current search started. (defvar tags-table-list-started-at nil (#$ . 2352)) #@127 List of sets of tags table which have been used together in the past. Each element is a list of strings which are file names. (defvar tags-table-set-list nil (#$ . 2486)) #@182 *Hook to be run by \[find-tag] after finding a tag. See `run-hooks'. The value in the buffer in which \[find-tag] is done is used, not the value in the buffer \[find-tag] goes to. (defvar find-tag-hook nil (#$ . -2664)) #@238 *A function of no arguments used by \[find-tag] to pick a default tag. If nil, and the symbol that is the value of `major-mode' has a `find-tag-default-function' property (see `put'), that is used. Otherwise, `find-tag-default' is used. (defvar find-tag-default-function nil (#$ . -2892)) #@181 If non-nil, a function to choose a default tags file for a buffer. This function receives no arguments and should return the default tags table file to use for the current buffer. (defvar default-tags-table-function nil (#$ . 3188)) #@130 List of markers which are locations visited by \[find-tag]. Pop back to the last location with \[negative-argument] \[find-tag]. (defvar tags-location-stack nil (#$ . 3428)) #@90 List of positions of beginnings of lines within the tags table that are already matched. (defvar tag-lines-already-matched nil (#$ . 3608)) #@124 List of file names covered by current tags table. nil means it has not yet been computed; use `tags-table-files' to do so. (defvar tags-table-files nil (#$ . 3755)) #@51 Alist of tag names defined in current tags table. (defvar tags-completion-table nil (#$ . 3926)) #@57 List of tags tables included by the current tags table. (defvar tags-included-tables nil (#$ . 4029)) #@44 List of files for \[next-file] to process. (defvar next-file-list nil (#$ . 4137)) #@282 List of functions to be called in a tags table buffer to identify the type of tags table. The functions are called in order, with no arguments, until one returns non-nil. The function should make buffer-local bindings of the format-parsing tags function variables if successful. (defvar tags-table-format-hooks (quote (etags-recognize-tags-table recognize-empty-tags-table)) (#$ . 4227)) #@55 Function to do the work of `file-of-tag' (which see). (defvar file-of-tag-function nil (#$ . 4623)) #@60 Function to do the work of `tags-table-files' (which see). (defvar tags-table-files-function nil (#$ . 4729)) #@46 Function to build the tags-completion-table. (defvar tags-completion-table-function nil (#$ . 4845)) #@76 Function to get info about a matched tag for `goto-tag-location-function'. (defvar snarf-tag-function nil (#$ . 4952)) #@130 Function of to go to the location in the buffer specified by a tag. One argument, the tag info returned by `snarf-tag-function'. (defvar goto-tag-location-function nil (#$ . 5078)) #@77 Function which checks for complete and correct match, for file name as tag. (defvar find-tag-file-order nil (#$ . 5265)) #@73 Search function passed to `find-tag-in-order' for finding a regexp tag. (defvar find-tag-regexp-search-function nil (#$ . 5392)) #@67 Tag order passed to `find-tag-in-order' for finding a regexp tag. (defvar find-tag-regexp-tag-order nil (#$ . 5527)) #@62 Flag passed to `find-tag-in-order' for finding a regexp tag. (defvar find-tag-regexp-next-line-after-failure-p nil (#$ . 5650)) #@66 Search function passed to `find-tag-in-order' for finding a tag. (defvar find-tag-search-function nil (#$ . 5784)) #@60 Tag order passed to `find-tag-in-order' for finding a tag. (defvar find-tag-tag-order nil (#$ . 5905)) #@55 Flag passed to `find-tag-in-order' for finding a tag. (defvar find-tag-next-line-after-failure-p nil (#$ . 6014)) #@53 Function to do the work of `list-tags' (which see). (defvar list-tags-function nil (#$ . 6134)) #@56 Function to do the work of `tags-apropos' (which see). (defvar tags-apropos-function nil (#$ . 6236)) #@64 Function to do the work of `tags-included-tables' (which see). (defvar tags-included-tables-function nil (#$ . 6344)) #@95 Function to return t iff the current buffer contains a valid (already initialized) tags file. (defvar verify-tags-table-function nil (#$ . 6468)) (defalias 'initialize-new-tags-table #[nil "ÀÁ!ÂLˆÀÃ!ÂLˆÀÄ!ÂLˆÀÅ!ÂLˆ‰ƒ0@ „0A‰„ )‡" [make-local-variable tag-lines-already-matched nil tags-table-files tags-completion-table tags-included-tables tags-table-format-hooks hooks] 3]) #@471 Tell tags commands to use tags table file FILE. FILE should be the name of a file created with the `etags' program. A directory name is ok too; it means file TAGS in that directory. Normally \[visit-tags-table] sets the global value of `tags-file-name'. With a prefix arg, set the buffer-local value instead. When you find a tag with \[find-tag], the buffer it finds the tag in is given a local value of this variable which is the name of the tags file the tag was in. (defalias 'visit-tags-table #[(file &optional local) ";„\fÁÂÃD\"ˆŠÅ!„ÁÆÇÈE\"ˆ\f* ƒ+ÊÄ!L‡ËÄ\"‡" [file signal wrong-type-argument stringp tags-file-name visit-tags-table-buffer file-error "Visiting tags table" "file does not exist" local make-local-variable set-default] 5 (#$ . 6865) (list (read-file-name "Visit tags table: (default TAGS) " default-directory (expand-file-name "TAGS" default-directory) t) current-prefix-arg)]) #@73 Compute `tags-table-computed-list' from `tags-table-list' if necessary. (defalias 'tags-table-check-computed-list #[nil "ÀÁ\n\"\f š†tÀÅ \"Å!È È\nƒj@ B Ë@!‰\nƒ[ŠÌÍ\n!!)ƒ[Š\nqˆÎ ƒWÀÁÎ \"A¤¡ˆ)‚aÏ B A‰„\" Ÿ‰,)‡" [mapcar tags-expand-table-name tags-table-list expanded-list tags-table-computed-list-for copy-sequence compute-for tables nil computed table-buffer get-file-buffer tags-verify-table buffer-file-name tags-included-tables t tags-table-computed-list] 5 (#$ . 7783)]) (defalias 'tags-table-extend-computed-list #[nil "‰A@Â=„ A‰‚ŠÃ @!ƒrÄ Å‰‰ƒa@BÉ@!‰ƒRŠqˆÄ ƒNÊÄ \"¡ˆ)‚XÂBA‰„'Ÿ  AA¤¡+‚w ‰AA¡*‡" [tags-table-computed-list list t tags-verify-table tags-included-tables nil table-buffer computed tables get-file-buffer append] 5]) (defalias 'tags-expand-table-name #[(file) "À ! !ƒÀà \"‡ ‡" [expand-file-name file file-directory-p "TAGS"] 3]) (defalias 'tags-table-list-member #[(file list) "À !\nƒ\n@Ã=„ À\n@!˜„\nA‰„\n‡" [tags-expand-table-name file list t] 4]) #@169 Read FILE into a buffer and verify that it is a valid tags table. Sets the current buffer to one visiting FILE (if it exists). Returns non-nil iff it is a valid table. (defalias 'tags-verify-table #[(file) "À !ƒ5ÂÀ !qˆ\f†Å Æp!„#ÇÈÉ \"!„, …3\f ‚3Êˉ\"ˆÅ )‡Ì !…eÍ !qˆ ˜„c ‰ƒW ˆ =ƒb)Å ‡" [get-file-buffer file nil win verify-tags-table-function initialize-new-tags-table verify-visited-file-modtime yes-or-no-p format "Tags file %s has changed, read new contents? " revert-buffer t file-exists-p find-file-noselect buffer-file-name tags-table-list tail tags-file-name] 5 (#$ . 8859)]) (defalias 'tags-table-including #[(this-file core-only) "Á\n„H ƒH\fƒ A@Å=ƒ+ AA‰‚ A@Å=ƒ+Æ ˆ ƒB @ÈÉ!ˆ\nË ƒA ) A‚\n…Á\f \f\nA=„~Î\f@\"ƒi\f@ \fA‰\f@Å=ƒR\fA‰\f‚T **‡" [tags-table-computed-list nil found tables core-only t tags-table-extend-computed-list tags-file-name visit-tags-table-buffer same this-file tags-table-files elt could-be tags-table-list-member tags-table-list] 4]) (defalias 'tags-next-table #[nil "A@Á=ƒ ˆ‚A‰„ \f=ƒ!ʼn‡@‰‡" [tags-table-list-pointer t tags-table-extend-computed-list tags-table-computed-list tags-table-list-started-at nil tags-file-name] 3]) #@506 Select the buffer containing the current tags table. If optional arg is a string, visit that file as a tags table. If optional arg is t, visit the next table in `tags-table-list'. If optional arg is the atom `same', don't look for a new table; just select the buffer visiting `tags-file-name'. If arg is nil or absent, choose a first buffer from information in `tags-file-name', `tags-table-list', `tags-table-list-pointer'. Returns t if it visits a tags table, or nil if there are no more in the list. (defalias 'visit-tags-table-buffer #[(&optional cont) "Á=ƒ\n„¸ÃÄÅÆP!!ˆ‚¸Ç=ƒ4È ƒ¸É\n!„¸Ê\n!„¸È „ ‚¸Ë ˆ;ƒB̆·ÂÍ žA†·ƒU †·ƒjÐÇ\"†·ÐÌ\"†·\nƒzÑ\n\"„z\n†·Ì‰ƒ§Ö@!‰ƒ§É!„§Ê!„§A‰„…@*†·×ØÙÛÇ$!Ö\n!Ç=…Å??…”p\nß!ƒ}àp!ˆ„yÑ\"‰!ƒõ!!\"‚x#‰$ƒÑ$@\"„$A‰$„ý$ƒ,#>„$#B#$@‚lƒO%Ç=„E%ƒOæçèP!ƒOB‚léê!ˆƒg#>„g#B#CË ˆ\"))Ç‚“qˆëÂ!ˆ\n=ƒŽÌÃì\"*‡" [cont same tags-file-name error substitute-command-keys "No tags table in use! " "Use \\[visit-tags-table] to select one." t tags-next-table get-file-buffer file-exists-p tags-table-check-computed-list nil buffer-local-variables default-tags-table-function buffer-file-name tags-table-including tags-table-list-member tags-table-computed-list tags-table-list file list tags-expand-table-name expand-file-name read-file-name "Visit tags table: (default TAGS) " default-directory "TAGS" tags-table-list-pointer local-tags-file-name curbuf tags-verify-table bury-buffer found tags-table-list-started-at tags-table-set-list sets tags-add-tables y-or-n-p "Keep current list of " "tags tables also? " message "Starting a new list of tags tables" kill-local-variable "File %s is not a valid tags table"] 7 (#$ . 10108)]) #@87 Reset tags state to cancel effect of any previous \[visit-tags-table] or \[find-tag]. (defalias 'tags-reset-tags-tables #[nil "ÀÀÀÀÀÀÀÀ‰‡" [nil tags-file-name tags-location-stack tags-table-list tags-table-computed-list tags-table-computed-list-for tags-table-list-pointer tags-table-list-started-at tags-table-set-list] 2 (#$ . 11913) nil]) #@171 Return the file name of the file whose tags point is within. Assumes the tags table is the current buffer. File name returned is relative to tags table file's directory. (defalias 'file-of-tag #[nil " ‡" [file-of-tag-function] 1 (#$ . 12273)]) #@131 Return a list of files in the current tags table. Assumes the tags table is the current buffer. File names returned are absolute. (defalias 'tags-table-files #[nil "† ‰‡" [tags-table-files tags-table-files-function] 2 (#$ . 12525)]) #@107 Return a list of tags tables included by the current table. Assumes the tags table is the current buffer. (defalias 'tags-included-tables #[nil "† ‰‡" [tags-included-tables tags-included-tables-function] 2 (#$ . 12770)]) (defalias 'tags-completion-table #[nil "†ÁÂÇ" [tags-completion-table nil (byte-code "ÀÁ\n\"ˆÃ \f Šƒ0@ÈÉ!ˆ)Ê ƒ'ËÌ\n\"ˆA‰„) ‰\n*ÀÍ\n\"ˆ‡" [message "Making tags completion table for %s..." buffer-file-name tags-included-tables tags-completion-table-function table included tags-file-name visit-tags-table-buffer same tags-completion-table mapatoms #[(sym) "ÀÁ\n! \"‡" [intern symbol-name sym table] 3] "Making tags completion table for %s...done"] 5) ((quit (byte-code "ÀÁ!ˆÂ‰‡" [message "Tags completion table construction aborted." nil tags-completion-table] 2)))] 3]) (defalias 'tags-complete-tag #[(string predicate what) "ŠÀ ˆ) À=ƒÄ Æ #‚È Æ #)‡" [t enable-recursive-minibuffers visit-tags-table-buffer what all-completions string tags-completion-table predicate try-completion] 4]) (defalias 'find-tag-default #[nil "ŠÀÁ!ƒ Âuˆ‚ÃÁŠÄyˆ`)Å#„'ÆNJȈ`)Å#…>Ä•bˆ`ÉÊ!ˆÀË!ƒ<Âuˆ‚0`{)‡" [looking-at "\\sw\\|\\s_" 1 re-search-backward 0 t re-search-forward "\\(\\sw\\|\\s_\\)+" nil forward-sexp -1 "\\s'"] 4]) (defalias 'find-tag-tag #[(string) "† ÀN†  Ä ƒÅÆ #‚È\"‰ Êšƒ1 †3ËÌ!‚3 *‡" [find-tag-default-function major-mode find-tag-default default completing-read format "%s(default %s) " string tags-complete-tag spec "" error "There is no default tag"] 6]) #@32 Last tag found by \[find-tag]. (defvar last-tag nil (#$ . 14310)) (defalias 'find-tag-interactive #[(prompt &optional no-default) "ƒÁÂ!ÃWƒÄ‚ÅD‡ƒ Ç!‚$É!C‡" [current-prefix-arg nil prefix-numeric-value 0 - t no-default read-string prompt find-tag-tag] 3]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp find-tag-history nil current-load-list] 2) #@716 Find tag (in current tags table) whose name contains TAGNAME. Returns the buffer containing the tag's definition and moves its point there, but does not select the buffer. The default for TAGNAME is the expression in the buffer near point. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is the atom `-' (interactively, with prefix arg that is a negative number or just \[negative-argument]), pop back to the previous tag gone to. If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp. See documentation of variable `tags-file-name'. (defalias 'find-tag-noselect #[(tagname &optional next-p regexp-p) " B\nÃÇ=ƒ=„ÉÊ!‚À@ AÌ !qÍ !bˆ É“ˆÎÅ!ˆ)‚ÀƒIÏÐ!ˆ‚OÏ ˆÒ  Šƒ^‚_Óƒk‚lƒv‚xƒ‚‚ØÙ\f\"ƒŽ‚ƒš‚œƒ¥Þ‚¦ß?&qˆ `ÓˆÎÅ!ˆ Bp**‡" [tagname find-tag-history find-tag-hook nil search-tag local-find-tag-hook next-p - tags-location-stack error "No previous tag locations" marker marker-buffer marker-position run-hooks visit-tags-table-buffer same last-tag make-marker find-tag-in-order regexp-p find-tag-regexp-search-function find-tag-search-function find-tag-regexp-tag-order string-match "\\b.*\\.\\w*" find-tag-file-order find-tag-tag-order find-tag-regexp-next-line-after-failure-p find-tag-next-line-after-failure-p "matching" "containing"] 7 (#$ . 14666) (find-tag-interactive "Find tag: ")]) #@629 Find tag (in current tags table) whose name contains TAGNAME. Select the buffer containing the tag's definition, and move point there. The default for TAGNAME is the expression in the buffer around or before point. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is the atom `-' (interactively, with prefix arg that is a negative number or just \[negative-argument]), pop back to the previous tag gone to. See documentation of variable `tags-file-name'. (defalias 'find-tag #[(tagname &optional next-p regexp-p) "ÀÁ\n \f#!‡" [switch-to-buffer find-tag-noselect tagname next-p regexp-p] 5 (#$ . 16222) (find-tag-interactive "Find tag: ")]) #@644 Find tag (in current tags table) whose name contains TAGNAME. Select the buffer containing the tag's definition in another window, and move point there. The default for TAGNAME is the expression in the buffer around or before point. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is negative (interactively, with prefix arg that is a negative number or just \[negative-argument]), pop back to the previous tag gone to. See documentation of variable `tags-file-name'. (defalias 'find-tag-other-window #[(tagname &optional next-p regexp-p) "ÀÁ ! \f #‰qˆ`ÈÁ É!ˆÈÁ \"ˆ\"+‡" [window-point selected-window find-tag-noselect tagname next-p regexp-p tagbuf tagpoint set-window-point switch-to-buffer-other-window] 6 (#$ . 17042) (find-tag-interactive "Find tag other window: ")]) #@643 Find tag (in current tags table) whose name contains TAGNAME. Select the buffer containing the tag's definition in another frame, and move point there. The default for TAGNAME is the expression in the buffer around or before point. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is negative (interactively, with prefix arg that is a negative number or just \[negative-argument]), pop back to the previous tag gone to. See documentation of variable `tags-file-name'. (defalias 'find-tag-other-frame #[(tagname &optional next-p) "À \f\")‡" [t pop-up-frames find-tag-other-window tagname next-p] 3 (#$ . 18008) (find-tag-interactive "Find tag other frame: ")]) #@618 Find tag (in current tags table) whose name matches REGEXP. Select the buffer containing the tag's definition and move point there. If second arg NEXT-P is t (interactively, with prefix arg), search for another tag that matches the last tagname or regexp used. When there are multiple matches for a tag, more exact matches are found first. If NEXT-P is negative (interactively, with prefix arg that is a negative number or just \[negative-argument]), pop back to the previous tag gone to. If third arg OTHER-WINDOW is non-nil, select the buffer in another window. See documentation of variable `tags-file-name'. (defalias 'find-tag-regexp #[(regexp &optional next-p other-window) "ƒÁ‚  \fÅ#‡" [other-window find-tag-other-window find-tag regexp next-p t] 4 (#$ . 18851) (find-tag-interactive "Find tag regexp: " t)]) (defalias 'find-tag-in-order #[(pattern search-forward-func order next-line-after-failure-p matching first-search) "À‰‰Á\nÀ‰ Š\n„ËÌ!ˆÍÎÏyˆ`BÑÒ !  Õ !qˆ~ˆÖ ˆ ×=ƒNebˆ‚S\f!ˆp.‡" [nil t order match-type goto-func tag-order first-table tags-table-file tag-info file first-search visit-tags-table-buffer same qualified-match-found (byte-code "„\nÁÂ!ƒm ƒÄ ƒƒebˆ„\"ebˆÄƒf \nÄÂ#ƒ[@\n!ƒPŠËyˆ`) >„PÌÍÄ\"ˆƒ-Ïyˆ‚-Aebˆ‚(‚ÑÒ ƒwÓ‚xÔ\n$‡" [first-table visit-tags-table-buffer t first-search nil tag-lines-already-matched buffer-file-name tags-table-file order search-forward-func pattern 0 throw qualified-match-found next-line-after-failure-p 1 tag-order error "No %stags %s %s" "" "more " matching] 5) 0 tag-lines-already-matched expand-file-name file-of-tag snarf-tag-function goto-tag-location-function find-file-noselect push-mark tag-filename-match-p] 7]) (defalias 'etags-recognize-tags-table #[nil "À … ÁÂÃ\"‡" [etags-verify-tags-table mapcar #[(elt) "À @! AL‡" [make-local-variable elt] 2] ((file-of-tag-function . etags-file-of-tag) (tags-table-files-function . etags-tags-table-files) (tags-completion-table-function . etags-tags-completion-table) (snarf-tag-function . etags-snarf-tag) (goto-tag-location-function . etags-goto-tag-location) (find-tag-regexp-search-function . re-search-forward) (find-tag-regexp-tag-order tag-re-match-p) (find-tag-regexp-next-line-after-failure-p . t) (find-tag-search-function . search-forward) (find-tag-tag-order tag-filename-match-p tag-exact-match-p tag-symbol-match-p tag-word-match-p tag-any-match-p) (find-tag-file-order tag-filename-match-p) (find-tag-next-line-after-failure-p) (list-tags-function . etags-list-tags) (tags-apropos-function . etags-tags-apropos) (tags-included-tables-function . etags-tags-included-tables) (verify-tags-table-function . etags-verify-tags-table))] 3]) (defalias 'etags-verify-tags-table #[nil "ÀfÁ=‡" [1 12] 2]) (defalias 'etags-file-of-tag #[nil "ŠÀÁ!ƒÂÃ!ˆ‚ÄÅ!ˆÆ”Æ•{)‡" [looking-at "./" re-search-forward "\\([^\n]+\\),[0-9]*\n" re-search-backward "\f\n\\([^\n]+\\),[0-9]*\n" 1] 2]) (defalias 'etags-tags-completion-table #[nil "ÀÁÂ\"ŠebˆÄÅÆÇ#ƒ*ÈÉ”ƒɔɕ{‚$ʔʕ{ \"ˆ‚ ) )‡" [make-vector 511 0 table re-search-forward "^\\(\\([^]+[^-a-zA-Z0-9_$]+\\)?\\([-a-zA-Z0-9_$?:]+\\)[^-a-zA-Z0-9_$?:]*\\)\\(\\([^\n]+\\)\\)?\\([0-9]+\\)?,\\([0-9]+\\)?\n" nil t intern 5 3] 4]) (defalias 'etags-snarf-tag #[nil "À‰‰ÄÅ!ˆ`SŠÆyˆ`){ÄÇŠÈyˆ`)É#ˆÊË!ƒ/Ì`ÍÀwˆ`{!ÄÎ!ˆÊË!ƒCÌ`ÍÀwˆ`{!Èyˆ \n +BB‡" [nil startpos line tag-text search-forward "" 0 "" 1 t looking-at "[0-9]" string-to-int "0-9" ","] 4]) (defalias 'etags-goto-tag-location #[(tag-info) "AAÁ Ä=ƒÅ‚ÆÇ@!P \n‰ ƒ& T  „:A@ƒ:ÌA@!ˆ`  „Be  bˆÍ!  „q \nZbˆo„qÎ \n\\Ä# \nÏ_\n‚L „‡ÎÂÄ#„‡ÐÑ#ˆ, Ä=ƒ—ÍÓ!ƒ—ÔuˆÕyˆÂ‡" [tag-info 1000 nil selective-display t "\\(^\\| \\)" "^" regexp-quote pat found offset startpos goto-line looking-at re-search-forward 3 error "Rerun etags: `%s' not found in %s" buffer-file-name " " 1 0] 7]) (defalias 'etags-list-tags #[(file) "ÀbˆÁ ÄQÅÆ#…DÀyˆm„CÇÈ!„C`ÉÅwˆ`{\nËÇÌ!ƒ5`ÍÅwˆ`{‚7\n!ˆ)Î ˆÀyˆ‚Ƈ" [1 search-forward "\f\n" file "," nil t looking-at "\f" "^" tag princ "[^\n]+" "^" terpri] 4]) (defalias 'etags-tags-apropos #[(string) "ÀbˆÁ\nÃÄ#…!ÅyˆÆ`ÇÃwˆ`{!ˆÈ ˆÀyˆ‚‡" [1 re-search-forward string nil t 0 princ "^" terpri] 4]) (defalias 'etags-tags-table-files #[nil "À‰ebˆÃÄÀÅ#ƒ*`ÀˆÆ xˆÇÈ!„É `S{!\nB‚\nŸ*‡" [nil beg files search-forward "\f\n" t "^," looking-at "include$" expand-file-name] 4]) (defalias 'etags-tags-included-tables #[nil "À‰ebˆÃÄÀÅ#ƒ*`ÀˆÆ xˆÇÈ!ƒÉ `S{!\nB‚\nŸ*‡" [nil beg files search-forward "\f\n" t "^," looking-at "include$" expand-file-name] 4]) (defalias 'recognize-empty-tags-table #[nil "À ÁU…ÂÃÄ\"…ÅÆ!ÇL‡" [buffer-size 0 mapcar #[(sym) "À !ÂL‡" [make-local-variable sym ignore] 2] (tags-table-files-function tags-completion-table-function find-tag-regexp-search-function find-tag-search-function tags-apropos-function tags-included-tables-function) make-local-variable verify-tags-table-function #[nil "À ÁU‡" [buffer-size 0] 2]] 3]) (defalias 'tag-exact-match-p #[(tag) "`fÀ=ƒ` GZÀZfÂ=†ÃÄÅ !ÆQ!‡" [1 tag 127 looking-at "[^\n]*" regexp-quote ""] 4]) (defalias 'tag-symbol-match-p #[(tag) "ÀÁ!…ÀÂ!…ŠÃ\fGT!ˆÀÅ!…ÀÆ!)‡" [looking-at "\\Sw.*" "\\S_.*" backward-char tag "\\Sw" "\\S_"] 2]) (defalias 'tag-word-match-p #[(tag) "ÀÁ!…ŠÂ GT!ˆÀÄ!)‡" [looking-at "\\b.*" backward-char tag "\\b"] 2]) (defalias 'tag-filename-match-p #[(tag) "ÀÁ!…ŠÂ GT!ˆÀÄ!)‡" [looking-at "," backward-char tag "\\b"] 2]) (defalias 'tag-any-match-p #[(tag) "ÀÁ!‡" [looking-at ".*"] 2]) (defalias 'tag-re-match-p #[(re) "ŠÀyˆ`ÂÊĈ`)Å#…Æ Å#*‡" [0 bol search-forward "" nil t re-search-backward re] 4]) #@475 Select next file among files in current tags table. A first argument of t (prefix arg, if interactive) initializes to the beginning of the list of files in the tags table. If the argument is neither nil nor t, it is evalled to initialize the list of files. Non-nil second argument NOVISIT means use a temporary buffer to save time and avoid uninteresting warnings. Value is nil if the file was already visited; if the file was newly read in, the value is the filename. (defalias 'next-file #[(&optional initialize novisit) "ƒKÁ=ƒGŠÂ ˆÃÄ !ÂÁ!ƒC ‰Aƒ*A‰‚ƒ:ÃÄ !¡ˆ‚?ÃÄ !)‚)‚KÇ! „bƒ^ÉÊ!ƒ^ËÊ!ˆÌÍ!ˆ @Ï!? Aƒz„…Ñ\"qˆ‚šÒÊ!qˆÓ ˆÔ ˆÕÖ\"ˆ*‡" [initialize t visit-tags-table-buffer copy-sequence tags-table-files next-file-list tail eval novisit get-buffer " *next-file*" kill-buffer error "All files processed." next get-file-buffer new find-file-noselect get-buffer-create kill-all-local-variables erase-buffer insert-file-contents nil] 4 (#$ . 24529) (list (if current-prefix-arg t))]) #@59 Form for `tags-loop-continue' to eval to change one file. (defvar tags-loop-operate nil (#$ . 25571)) #@178 Form for `tags-loop-continue' to eval to scan one file. If it returns non-nil, this file needs processing by evalling `tags-loop-operate'. Otherwise, move on to the next file. (defvar tags-loop-scan (quote (error (substitute-command-keys "No \\[tags-search] or \\[tags-query-replace] in progress."))) (#$ . 25680)) #@521 Continue last \[tags-search] or \[tags-query-replace] command. Used noninteractively with non-nil argument to begin such a command (the argument is passed to `next-file', which see). Two variables control the processing we do on each file: the value of `tags-loop-scan' is a form to be executed on each file to see if it is interesting (it returns non-nil if so) and `tags-loop-operate' is a form to evaluate to operate on an interesting file. If the latter evaluates to nil, we exit; otherwise we scan the next file. (defalias 'tags-loop-continue #[(&optional first-time) "À‰ „Œ~ˆÄ !)„?Æ Ç\" „- „7 Vƒ7ljƒ7ÊË\n†5\f\"ˆÀebˆ‚\nƒW` Î ˆÏ\n!qˆÀ~ˆ bˆ)Ðp!ˆÄ!„ …q?…qÊÒ\f\"*‡" [nil messaged new first-time eval tags-loop-scan next-file t baud-rate search-slow-speed message "Scanning file %s..." buffer-file-name pos erase-buffer find-file-noselect switch-to-buffer tags-loop-operate "Scanning file %s...found"] 3 (#$ . 26003) nil]) #@220 Search through all files listed in tags table for match for REGEXP. Stops when a match is found. To continue searching for next match, use command \[tags-loop-continue]. See documentation of variable `tags-file-name'. (defalias 'tags-search #[(regexp &optional file-list-form) "Ášƒ\n@Ã=ƒ\f„ÅÆ!‡ÃÇDÆÈFÆÅ †&È!‡" [regexp "" tags-loop-scan re-search-forward tags-loop-operate tags-loop-continue nil quote t file-list-form] 4 (#$ . 26967) "sTags search (regexp): "]) #@312 Query-replace-regexp FROM with TO through all files listed in tags table. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\[keyboard-quit] or ESC), you can resume the query-replace with the command \[tags-loop-continue]. See documentation of variable `tags-file-name'. (defalias 'tags-query-replace #[(from to &optional delimited file-list-form) "ÀÁÂÃ\fDÅÆFÇEDÉÃ\fDÃ\nDƉà D¯\f͆'Æ!‡" [prog1 if re-search-forward quote from nil t (goto-char (match-beginning 0)) tags-loop-scan perform-replace to delimited tags-loop-operate tags-loop-continue file-list-form] 7 (#$ . 27449) (query-replace-read-args "Tags query replace (regexp)" t)]) #@93 Gives the list of functions available in file "filename" Searches only in "tags-file-name". (defalias 'list-tags #[(filename &optional next-match) "À \f… \f\"‰ƒÅ @A@Æ @8\"‚\"ÇÈÉ \"!)‡" [nil file-list tags-locate-file-in-tags-table filename next-match tags-list-functions-in-file 2 message format "%s not found in tags table"] 5 (#$ . 28140) "sFunctions in File: "]) #@56 Display list of all tags in tags table REGEXP matches. (defalias 'tags-apropos #[(regexp) "ÀÁÂ!ˆÃ\f!ˆÅ ˆŠÆÈ?!…$É\n\f!ˆ‚*‘‡" ["*Tags List*" princ "Tags matching regexp " prin1 regexp terpri t first-time visit-tags-table-buffer nil tags-apropos-function] 3 (#$ . 28519) "sTags apropos (regexp): "]) #@212 Select a tags table file from a menu of those you have already used. The list of tags tables to select from is stored in `tags-table-set-list'; see the doc of that variable if you want to add names to the list. (defalias 'select-tags-table #[nil "ÀÁ!ˆÂÄ ˆ ƒ+É Êp\"ˆËcˆÌ@p\"ˆÍcˆƒW@=„NÊ@p\"ˆËcˆÌ@@p\"ˆÍcˆA‰„0ƒt„eÉ ˱ˆÌp\"ˆÍcˆÏÐÑÒ!ÓÒ \"B\"\"‰ƒ¨@˱ˆÌ@p\"ˆÍcˆÏ@\"‰„ŠÔbˆÕÖ!ˆƒ¸bˆ×Ø ÔÙ#ˆ*ÚÂ!ˆÛ ‡" [pop-to-buffer "*Tags Table List*" nil buffer-read-only erase-buffer tags-table-set-list desired-point set-list tags-table-list point-marker princ " " prin1 "\n" tags-file-name delete apply nconc copy-sequence mapcar 1 insert-before-markers "Type `t' to select a tags table or set of tags tables:\n\n" set-window-start selected-window t set-buffer-modified-p select-tags-table-mode] 9 (#$ . 28834) nil]) (byte-code "À B Ä ÅÆ#ˆÄ ÇÈ#ˆÄ ÉÊ#ˆÄ ËÈ#ˆÄ ÌÊ#ˆÄ ÍÎ#ˆ )À‡" [select-tags-table-mode-map current-load-list make-sparse-keymap map define-key "t" select-tags-table-select " " next-line "" previous-line "n" "p" "q" select-tags-table-quit] 4) #@105 Major mode for choosing a current tags table among those already loaded. \{select-tags-table-mode-map} (defalias 'select-tags-table-mode #[nil "À ˆÁÃÅÇ!ˆÁ ʉ ‡" [kill-all-local-variables t buffer-read-only select-tags-table-mode major-mode "Select Tags Table" mode-name use-local-map select-tags-table-mode-map selective-display nil selective-display-ellipses] 2 (#$ . 29945) nil]) #@43 Select the tags table named on this line. (defalias 'select-tags-table-select #[nil "ÀÁ!ˆÂp!Ä !ˆÅ ˆÆÇ \")‡" [search-forward " " read name visit-tags-table select-tags-table-quit message "Tags table now %s"] 3 (#$ . 30342) nil]) #@49 Kill the buffer and delete the selected window. (defalias 'select-tags-table-quit #[nil "Àp!ˆÁ †  ‡" [kill-buffer one-window-p delete-window] 2 (#$ . 30577) nil]) #@210 Perform tags completion on the text around point. Completes to the set of names listed in the current tags table. The string to complete is chosen in the same way as the default for \[find-tag] (which see). (defalias 'complete-tag #[nil "„ „ÂÃÄ!!ˆ †ÅN†Ç ȉ \n‰ „+ÂÌ!ˆÍ !ˆ`\n GuˆÎ ÏÈ#‰ Ð=†} „VÑÒ \"ˆÓ ‚}  ˜„i\n`|ˆ c‚}ÑÔ!ˆÕÖ× ÏÈ#!‘ˆÑØÙ\"+‡" [tags-table-list tags-file-name error substitute-command-keys "No tags table loaded. Try \\[visit-tags-table]." find-tag-default-function major-mode find-tag-default nil completion beg pattern "Nothing to complete" search-backward try-completion tags-complete-tag t message "Can't find completion for \"%s\"" ding "Making completion list..." "*Completions*" display-completion-list all-completions "Making completion list...%s" "done"] 7 (#$ . 30749) nil]) #@67 Lists the functions for the given file. Backend for `list-tags'. (defalias 'tags-list-functions-in-file #[(pos tag-file) "À !ÂÃ!ĉ‰ ŠqˆÊ ˆ qˆ bˆÌyˆÍyˆÎÏ!„fm„fÎÐ!„]ÎÑ!„]ÎÒ!„]`ÓÄwˆ`{ŠqˆÔPcˆ)ÌyˆÍyˆ‚()ÕÃ!ˆÌbˆÖÄ!ˆ×‰-‡" [find-file-noselect tag-file get-buffer-create "*Tags Function List*" nil map beg function result-buf tag-buf erase-buffer pos 1 0 looking-at "^\f" "^#define\\s-+[a-zA-Z0-9_]+\\s-+" "^typedef\\s-+" "^\\s-*}" "^(" "\n" switch-to-buffer set-buffer-modified-p t buffer-read-only] 5 (#$ . 31587)]) #@262 This function is used to locate `filename' in `tags-table-list'. Its internally used by the functions `find-file-from-tags' and `tags-list-tags-in-file'. If `first-search' is t, search continues from where it left off last time. Else, its a fresh search. (defalias 'tags-locate-file-in-tags-table #[(filename first-search) "À‰‰‰‰‰ÈÉ.‡" [nil next-tag-file found-file-list file beg current-tags-buffer tag-list tags-table-list found-file (byte-code "ÀÀ ƒgÄ @!Š qˆ\n„„ebˆÇÀÉ#ƒ^Ê!ƒ^Ëyˆ`\fÍÀwˆÎÏ!„EÐ\f`{!ÒÓ!\"ƒ^`Ô E BÕÖ \"ˆ AÉ)‚ÕÖ \"‡" [nil found-file-list next-tag-file tag-list find-file-noselect current-tags-buffer first-search search-forward filename t tag-filename-match-p 0 beg "^," looking-at ",include$" expand-file-name file string-match file-name-nondirectory buffer-file-name throw found-file] 4)] 6 (#$ . 32134)]) (provide (quote etags)) emacs-19.30/lisp/eval-reg.elc100666 75432 1 10471 5744575754 15161 0ustar libertedaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:38:19 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/eval-reg.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/eval-reg.el' was compiled for Emacs 19")) (byte-code "ÀÁ!„\fÂÁÃK\"ˆÀÄ!„\"ÂÄÀÅ!ƒÅK‚ Æ\"ˆÀÇ!„.ÂÇÈK\"ˆÀ‡" [fboundp original-eval-region defalias eval-region original-eval-buffer eval-buffer undefined original-eval-current-buffer eval-current-buffer] 4) #@266 If the value is 0, use the original version of `elisp-eval-region'. Callers of `elisp-eval-region' should increment `elisp-eval-region-level' while the Lisp version should be used. Installing `elisp-eval-region' increments it once, and uninstalling decrements it. (defvar elisp-eval-region-level 0 (#$ . 700)) (defalias 'elisp-eval-region-install #[nil "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆT‰‡" [defalias eval-region elisp-eval-region eval-buffer elisp-eval-buffer eval-current-buffer elisp-eval-current-buffer elisp-eval-region-level] 3 nil nil]) (defalias 'elisp-eval-region-uninstall #[nil "À Vƒ S‰‡ÂÃÄÅK\"ˆÃÆÇK\"ˆÃÈÉK\"‡" [1 elisp-eval-region-level 0 defalias eval-region original-eval-region eval-buffer original-eval-buffer eval-current-buffer original-eval-current-buffer] 3 nil nil]) (byte-code "ÀÁÂÃ#ˆÀÁÄÃ#ˆÀÁÅÆ#‡" [put with-elisp-eval-region lisp-indent-function 1 lisp-indent-hook edebug-form-spec t] 4) #@578 If FLAG is nil, decrement `eval-region-level' while executing BODY. The effect of decrementing all the way to zero is that `eval-region' will use the original `eval-region', which may be the Emacs subr or some previous redefinition. Before calling this macro, this package should already have been installed, using `elisp-eval-region-install', which increments the count once. So if another package still requires the Lisp version of the code, the count will still be non-zero. The count is not bound locally by this macro, so changes by BODY to its value will not be lost. (defalias 'with-elisp-eval-region '(macro . #[(flag &rest body) "ÀÁÂÃÄ BBDDCÆÇDÉBBE‡" [let elisp-code function lambda nil body if not flag ((unwind-protect (progn (setq elisp-eval-region-level (1- elisp-eval-region-level)) (funcall elisp-code)) (setq elisp-eval-region-level (1+ elisp-eval-region-level))) (funcall elisp-code))] 6 (#$ . 1613)])) #@397 Execute the region as Lisp code. When called from programs, expects two arguments, giving starting and ending indices in the current buffer of the text to be executed. Programs can pass third argument PRINTFLAG which controls printing of output: nil means discard it; anything else is stream for print. This version, from `eval-reg.el', allows Lisp customization of read, eval, and the printer. (defalias 'elisp-eval-region #[(elisp-start elisp-end &optional elisp-output) "ÁUƒ\f \f #‡`ppÆ \fǓlj \n \f bˆÎ ˆ`\nWƒ‡Ï\f! p qˆÑ !p qˆ) ƒy †SÒBÒ=ƒkÕ!ˆ‚xÖ×!ˆÕ!ˆÖ×!ˆ)\n`]Î ˆ`^bˆ‚( „“\fqˆ bˆ.LJ" [elisp-eval-region-level 0 original-eval-region elisp-start elisp-end elisp-output make-marker nil elisp-val elisp-form elisp-end-marker elisp-inside-buf elisp-buf elisp-pnt elisp-skip-whitespace read elisp-current-buffer eval t standard-output values prin1 princ "\n"] 6 (#$ . 2545) "r"]) (defalias 'elisp-skip-whitespace #[nil "ÀÁwˆgÂU…ÃÁwˆÀÁwˆ‚‡" [" \n\f" nil 59 "^\n "] 2]) #@226 Execute the current buffer as Lisp code. Programs can pass argument PRINTFLAG which controls printing of output: nil means discard it; anything else is stream for print. This version calls `eval-region' on the whole buffer. (defalias 'elisp-eval-current-buffer #[(&optional elisp-output) "Àed #‡" [eval-region elisp-output] 4 (#$ . 3573) nil]) #@252 Execute BUFFER as Lisp code. Use current buffer if BUFFER is nil. Programs can pass argument PRINTFLAG which controls printing of output: nil means discard it; anything else is stream for print. This version calls `eval-region' on the whole buffer. (defalias 'elisp-eval-buffer #[(&optional elisp-bufname elisp-printflag) "„pŠÁ!†ÂÃ\"qˆÄed #)‡" [elisp-bufname get-buffer error "No such buffer: %s" eval-region elisp-printflag] 4 (#$ . 3925) nil]) (provide (quote eval-reg)) emacs-19.30/lisp/executable.elc100666 75424 1 13216 6021170737 15113 0ustar kwzhdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Aug 30 19:18:51 1995 ;;; from file /home/fsf/rms/e19/lisp/executable.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`executable.el' was compiled for Emacs 19.29 or later")) #@464 *What to do when newly found file has no or wrong magic number: nil do nothing t insert or update magic number other insert or update magic number, but mark as unmodified. When the insertion is marked as unmodified, you can save it with \[write-file] RET. This variable is used when `executable-set-magic' is called as a function, e.g. when Emacs sets some Un*x interpreter script mode. With \[executable-set-magic], this is always treated as if it were `t'. (defvar executable-insert (quote not-modified) (#$ . -476)) #@133 *If non-`nil', ask user before inserting or changing magic number. When this is `function', only ask when called non-interactively. (defvar executable-query (quote function) (#$ . -1006)) #@67 *On files with this kind of name no magic is inserted or changed. (defvar executable-magicless-file-regexp "/[Mm]akefile$\\|/\\.\\(z?profile\\|bash_profile\\|z?login\\|bash_login\\|z?logout\\|bash_logout\\|.+shrc\\|esrc\\|rcrc\\|[kz]shenv\\)$" (#$ . -1200)) #@75 *Interpreter magic number prefix inserted when there was no magic number. (defvar executable-prefix "#! " (#$ . -1464)) #@251 *After saving, if the file is not executable, set this mode. This mode passed to `set-file-modes' is taken absolutely when negative, or relative to the files existing modes. Do nothing if this is nil. Typical values are 73 (+x) or -493 (rwxr-xr-x). (defvar executable-chmod 73 (#$ . -1591)) (byte-code "ÀÁ!„ÂÁ BÄÅ\"„ǤˆÂ‡" [boundp executable-command nil current-load-list assoc "tail" interpreter-mode-alist (("tail" . text-mode) ("more" . text-mode) ("less" . text-mode) ("pg" . text-mode))] 3) #@144 *Command you use with argument `+2' to make text files self-display. Note that the like of `more' doesn't work too well under Emacs \[shell]. (defvar executable-self-display "tail" (#$ . -2105)) #@137 *Rules for highlighting executable scripts' magic number. This can be included in `font-lock-keywords' by modes that call `executable'. (defvar executable-font-lock-keywords (quote (("\\`#!.*/\\([^ \n]+\\)" 1 font-lock-keyword-face t))) (#$ . -2308)) #@85 Alist of regexps used to match script errors. See `compilation-error-regexp-alist'. (defvar executable-error-regexp-alist (quote (("^\\(.*[^[/]\\)\\(\\[[0-9]+\\]\\)?: .* error .* line \\([0-9]+\\)" 1 3) ("^\\(.*[^/]\\)\\[\\([0-9]+\\)\\]: .*: " 1 2) ("^\\(.*[^/]\\): [^0-9\n]+\n\\1: \\1: line \\([0-9]+\\):" 1 2) (" error .* line \\([0-9]+\\) of file \\(.+\\)$" 2 1) ("^[^ ].+\n\\( .+\n\\)* line \\([0-9]+\\) of file \\(.+\\)$" 3 2) ("^\\(.+\\):\\([0-9]+\\): " 1 2))) (#$ . 2566)) #@76 If COMMAND is an executable in $PATH its full name is returned. Else nil. (defalias 'executable #[(command) "Á‰ƒ)Ä @\"‰…Æ\n!…Ç\n!??…$Á A‰„\n*‡" [exec-path nil path list expand-file-name command file-executable-p file-directory-p] 4 (#$ . 3052)]) #@170 This gets called after saving a file to assure that it be executable. You can set the absolute or relative mode in variable `executable-chmod' for non-executable files. (defalias 'executable-chmod #[nil "…\" …\" !†\"à ÄWƒ[‚!ÅÆ !\"\"‡" [executable-chmod buffer-file-name file-executable-p set-file-modes 0 logior file-modes] 6 (#$ . 3321)]) #@166 Run script with user-specified args, and collect output in a buffer. While script runs asynchronously, you can use the \[next-error] command to find the next error. (defalias 'executable-interpret #[(command) "ÀÁ!ˆÂ ?!ˆÄÅ!ˆÆ‰ÈÉÊ %‡" [require compile save-some-buffers compilation-ask-about-save make-local-variable executable-command compile-internal command "No more errors." "Interpretation" nil executable-error-regexp-alist] 6 (#$ . 3679) (list (read-string "Run script: " (or executable-command buffer-file-name)))]) #@293 Set this buffer's interpreter to INTERPRETER with optional ARGUMENT. The variables `executable-magicless-file-regexp', `executable-prefix', `executable-insert', `executable-query' and `executable-chmod' control when and how magic numbers are inserted or replaced and scripts made executable. (defalias 'executable-set-magic #[(interpreter &optional argument) "À !ƒ\n ‚ !†ÃÄ \"‰ …!Æ ™…!Ç Q„  ƒ7Ê  \"„ \fÍ=„Cƒ eÏV„ Ð Ñ ebˆÓÔ!ˆÕÔÖ×Ø$ˆÙÚ!ƒ†Ï”bƒ `Ï•{˜„Û‹ƒ`Ï•|„ cˆ‚ ݱˆÞ!`W„šbˆß!ˆ* ‡" [file-name-absolute-p interpreter executable error "Cannot find %s." argument "" " " buffer-read-only buffer-file-name string-match executable-magicless-file-regexp this-command executable-set-magic executable-insert 1 point-marker buffer-modified-p point make-local-hook after-save-hook add-hook executable-chmod nil t looking-at "#![ ]*\\(.*\\)$" ((byte-code "Àp!ˆ ƒ Â=ƒ Ä=ƒÅÆ eÇ•{#‡ÈÉ\n ÌR!‡" [switch-to-buffer executable-query function this-command executable-set-magic message "%s Magic number ``%s'' replaced." 1 y-or-n-p "Replace magic number by ``" executable-prefix argument "''? "] 5)) executable-prefix 10 marker-position set-buffer-modified-p] 6 (#$ . 4212) "sName or path of interpreter: \nsArgument for %s: "]) #@121 Turn a text file into a self-displaying Un*x command. The magic number of such a command displays all lines but itself. (defalias 'executable-self-display #[nil "Á=ƒÂ Ã\"‡" [this-command executable-self-display executable-set-magic "+2"] 3 (#$ . 5481) nil]) (provide (quote executable)) emacs-19.30/lisp/f90.elc100666 12120 1 144726 6045213330 13212 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:15:59 1995 ;;; from file /home/fsf/rms/e19/lisp/f90.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`f90.el' was compiled for Emacs 19.29 or later")) #@44 Address of mailing list for F90 mode bugs. (defconst bug-f90-mode "T.Einarsson@clab.ericsson.se" (#$ . 466)) #@42 *Extra indentation applied to DO blocks. (defvar f90-do-indent 3 (#$ . -581)) #@73 *Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks. (defvar f90-if-indent 3 (#$ . -665)) #@70 *Extra indentation applied to TYPE, INTERFACE and BLOCK DATA blocks. (defvar f90-type-indent 3 (#$ . -780)) #@74 *Extra indentation applied to PROGRAM/MODULE/SUBROUTINE/FUNCTION blocks. (defvar f90-program-indent 2 (#$ . -894)) #@55 *Extra indentation applied to F90 continuation lines. (defvar f90-continuation-indent 5 (#$ . -1015)) #@76 *String inserted by \[f90-comment-region] at start of each line in region. (defvar f90-comment-region "!!$" (#$ . -1123)) #@57 *Regexp saying which comments to be indented like code. (defvar f90-indented-comment-re "!" (#$ . -1251)) #@71 *Regexp of comment-like directive like "!HPF\\$", not to be indented. (defvar f90-directive-comment-re "!hpf\\$" (#$ . -1363)) #@70 *t makes automatic insertion of & at beginning of continuation line. (defvar f90-beginning-ampersand t (#$ . -1496)) #@180 *From an END statement, check and fill the end using matching block start. Allowed values are 'blink, 'no-blink, and nil, which determine whether to blink the matching beginning. (defvar f90-smart-end (quote blink) (#$ . -1620)) #@66 *Regexp holding list of delimiters at which lines may be broken. (defvar f90-break-delimiters "[-+\\*/><=,% ]" (#$ . -1855)) #@70 *Non-nil causes `f90-do-auto-fill' to break lines before delimiters. (defvar f90-break-before-delimiters t (#$ . -1987)) #@114 *Automatic case conversion of keywords. The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil (defvar f90-auto-keyword-case nil (#$ . -2115)) #@36 *If nil, left-justify linenumbers. (defvar f90-leave-line-no nil (#$ . -2282)) #@68 *Non-nil displays a startup message when F90 mode is first called. (defvar f90-startup-message t (#$ . -2367)) #@26 Regexp for F90 keywords. (defconst f90-keywords-re (concat "\\<\\(a\\(llocat\\(able\\|e\\)\\|ssign\\(\\|ment\\)\\)\\|b\\(ackspace\\|" "lock\\)\\|c\\(a\\(ll\\|se\\)\\|haracter\\|lose\\|o\\(m\\(mon\\|plex\\)\\|" "nt\\(ains\\|inue\\)\\)\\|ycle\\)\\|d\\(ata\\|eallocate\\|imension\\|" "o\\(\\|uble\\)\\)\\|e\\(lse\\(\\|if\\|where\\)\\|n\\(d\\(\\|do\\|file\\|" "if\\)\\|try\\)\\|quivalence\\|x\\(it\\|ternal\\)\\)\\|f\\(or\\(all\\|" "mat\\)\\|unction\\)\\|goto\\|i\\(f\\|mplicit\\|n\\(clude\\|quire\\|t\\(" "e\\(ger\\|nt\\|rface\\)\\|rinsic\\)\\)\\)\\|logical\\|module\\|n\\(" "amelist\\|one\\|ullify\\)\\|o\\(nly\\|p\\(en\\|tional\\)\\)\\|p\\(a\\(" "rameter\\|use\\)\\|ointer\\|r\\(ecision\\|i\\(nt\\|vate\\)\\|o\\(" "cedure\\|gram\\)\\)\\|ublic\\)\\|re\\(a[dl]\\|cursive\\|turn\\|wind\\)\\|" "s\\(ave\\|e\\(lect\\|quence\\)\\|top\\|ubroutine\\)\\|t\\(arget\\|hen\\|" "ype\\)\\|use\\|w\\(h\\(ere\\|ile\\)\\|rite\\)\\)\\>") (#$ . 2484)) #@42 Keyword-regexp for font-lock level >= 3. (defconst f90-keywords-level-3-re (concat "\\<\\(a\\(llocat\\(able\\|e\\)\\|ssign\\(\\|ment\\)\\)\\|backspace\\|" "close\\|deallocate\\|e\\(n\\(dfile\\|try\\)\\|quivalence\\|xternal\\)\\|" "in\\(quire\\|t\\(ent\\|rinsic\\)\\)\\|o\\(nly\\|p\\(en\\|tional\\)\\)\\|" "p\\(a\\(rameter\\|use\\)\\|ointer\\|ri\\(nt\\|vate\\)\\|ublic\\)\\|re\\(" "ad\\|cursive\\|wind\\)\\|s\\(ave\\|e\\(lect\\|quence\\)\\)\\|target\\|" "write\\)\\>") (#$ . 3422)) #@59 Regexp whose first part matches F90 intrinsic procedures. (defconst f90-procedures-re (concat "\\<\\(a\\(bs\\|c\\(har\\|os\\)\\|djust[lr]\\|i\\(mag\\|nt\\)\\|ll\\(\\|" "ocated\\)\\|n\\(int\\|y\\)\\|s\\(in\\|sociated\\)\\|tan2?\\)\\|b\\(" "it_size\\|test\\)\\|c\\(eiling\\|har\\|mplx\\|o\\(njg\\|sh?\\|unt\\)\\|" "shift\\)\\|d\\(ate_and_time\\|ble\\|i\\(gits\\|m\\)\\|ot_product\\|prod" "\\)\\|e\\(oshift\\|psilon\\|xp\\(\\|onent\\)\\)\\|f\\(loor\\|" "raction\\)\\|huge\\|i\\(a\\(char\\|nd\\)\\|b\\(clr\\|its\\|set\\)\\|" "char\\|eor\\|n\\(dex\\|t\\)\\|or\\|shftc?\\)\\|kind\\|l\\(bound\\|" "en\\(\\|_trim\\)\\|g[et]\\|l[et]\\|og\\(\\|10\\|ical\\)\\)\\|m\\(a\\(" "tmul\\|x\\(\\|exponent\\|loc\\|val\\)\\)\\|erge\\|in\\(\\|exponent\\|" "loc\\|val\\)\\|od\\(\\|ulo\\)\\|vbits\\)\\|n\\(earest\\|int\\|ot\\)\\|" "p\\(ack\\|r\\(e\\(cision\\|sent\\)\\|oduct\\)\\)\\|r\\(a\\(dix\\|n\\(" "dom_\\(number\\|seed\\)\\|ge\\)\\)\\|e\\(peat\\|shape\\)\\|rspacing\\)\\|" "s\\(ca\\(le\\|n\\)\\|e\\(lected_\\(int_kind\\|real_kind\\)\\|" "t_exponent\\)\\|hape\\|i\\(gn\\|nh?\\|ze\\)\\|p\\(acing\\|read\\)\\|" "qrt\\|um\\|ystem_clock\\)\\|t\\(anh?\\|iny\\|r\\(ans\\(fer\\|pose\\)\\|" "im\\)\\)\\|u\\(bound\\|npack\\)\\|verify\\)[ ]*(") (#$ . 3909)) #@38 Regexp matching intrinsic operators. (defconst f90-operators-re (concat "\\.\\(and\\|eqv?\\|false\\|g[et]\\|l[et]\\|n\\(e\\(\\|qv\\)\\|" "ot\\)\\|or\\|true\\)\\.") (#$ . 5145)) #@57 Regexp for all HPF keywords, procedures and directives. (defconst f90-hpf-keywords-re (concat "\\<\\(a\\(l\\(ign\\|l_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|ny_\\(" "prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|block\\|c\\(o\\(py_\\(prefix\\|" "s\\(catter\\|uffix\\)\\)\\|unt_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|" "yclic\\)\\|d\\(istribute\\|ynamic\\)\\|extrinsic\\|grade_\\(down\\|" "up\\)\\|hpf_\\(alignment\\|distribution\\|template\\)\\|i\\(a\\(ll\\(\\|" "_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|ny\\(\\|_\\(prefix\\|s\\(" "catter\\|uffix\\)\\)\\)\\)\\|len\\|n\\(dependent\\|herit\\)\\|parity\\(\\|" "_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\)\\|leadz\\|m\\(axval_\\(" "prefix\\|s\\(catter\\|uffix\\)\\)\\|inval_\\(prefix\\|s\\(catter\\|" "uffix\\)\\)\\)\\|n\\(ew\\|umber_of_processors\\)\\|onto\\|p\\(arity\\(\\|" "_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|op\\(cnt\\|par\\)\\|ro\\(" "cessors\\(\\|_shape\\)\\|duct_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|" "ure\\)\\|re\\(align\\|distribute\\)\\|sum_\\(prefix\\|s\\(catter\\|" "uffix\\)\\)\\|template\\|with\\)\\>") (#$ . 5328)) #@71 This does fairly subdued highlighting of comments and function calls. (defvar f90-font-lock-keywords-1 (byte-code "ÀÁ\n\"ƒÃÄÅÆÇÈÉʯ‡ËÌÍÎʯ‡" [string-match "XEmacs" emacs-version ("\\<\\(end[ ]*\\(program\\|module\\|function\\|subroutine\\|type\\)\\)\\>" 1 font-lock-keyword-face) ("\\<\\(end[ ]*\\(program\\|module\\|function\\|subroutine\\|type\\)\\)\\>[ ]*\\(\\sw+\\)" 3 font-lock-function-name-face) ("\\<\\(program\\|call\\|module\\|subroutine\\|function\\|use\\)\\>" 1 font-lock-keyword-face) ("\\<\\(program\\|call\\|module\\|subroutine\\|function\\|use\\)\\>[ ]*\\(\\sw+\\)" 2 font-lock-function-name-face nil t) ("\\<\\(module[ ]*procedure\\)\\>" 1 font-lock-keyword-face t) ("\\<\\(type\\)[ ]*\\(,.*::[ ]*\\|[ ]+\\)\\(\\sw+\\)" 1 font-lock-keyword-face) ("\\<\\(type\\)[ ]*\\(,.*::[ ]*\\|[ ]+\\)\\(\\sw+\\)" 3 font-lock-function-name-face) "\\<\\(\\(end[ ]*\\)?\\(interface\\|block[ ]*data\\)\\|contains\\)\\>" ("\\<\\(end[ ]*\\(program\\|module\\|function\\|subroutine\\|type\\)\\)\\>[ ]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) ("\\<\\(program\\|call\\|module\\|subroutine\\|function\\|use\\)\\>[ ]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) ("\\<\\(module[ ]*procedure\\)\\>" (1 font-lock-keyword-face t)) ("\\<\\(type\\)[ ]*\\(,.*::[ ]*\\|[ ]+\\)\\(\\sw+\\)" (1 font-lock-keyword-face) (3 font-lock-function-name-face))] 8) (#$ . 6427)) #@59 Highlights declarations, do-loops and other constructions (defvar f90-font-lock-keywords-2 (byte-code "À ÂÃ\f\"ƒ!ÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖׯ‚/ØÙÚÛÜÝÐÑÞßàá¯\f\"‡" [append f90-font-lock-keywords-1 string-match "XEmacs" emacs-version ("^[ 0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ ]*(\\sw+)\\)" 1 font-lock-type-face) ("^[ 0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ ]*(\\sw+)\\)\\(.*::\\|[ ]*(.*)\\)?\\(.*\\)" 4 font-lock-doc-string-face) ("\\<\\(end[ ]*\\(do\\|if\\|select\\)\\)\\>" 1 font-lock-keyword-face) ("\\<\\(end[ ]*\\(do\\|if\\|select\\)\\)\\>\\([ ]+\\(\\sw+\\)\\)" 3 font-lock-doc-string-face) ("^[ 0-9]*\\(\\(\\sw+\\)[ ]*:[ ]*\\)\\(\\(if\\|do\\([ ]*while\\)?\\|select[ ]*case\\)\\)\\>" 2 font-lock-doc-string-face) ("^[ 0-9]*\\(\\(\\sw+\\)[ ]*:[ ]*\\)?\\(\\(if\\|do\\([ ]*while\\)?\\|select[ ]*case\\)\\)\\>" 3 font-lock-keyword-face) ("\\<\\(implicit\\)[ ]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ ]*(\\sw+)\\|none\\)\\>" 1 font-lock-keyword-face) ("\\<\\(implicit\\)[ ]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ ]*(\\sw+)\\|none\\)\\>" 2 font-lock-type-face) ("\\<\\(namelist\\|common\\)[ ]*/\\(\\sw+\\)?/" 1 font-lock-keyword-face) ("\\<\\(namelist\\|common\\)[ ]*/\\(\\sw+\\)/" 2 font-lock-doc-string-face nil t) ("\\<\\(where\\|forall\\)[ ]*(" . 1) "\\" "\\<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\>" ("\\<\\(exit\\|cycle\\)\\>" 1 font-lock-keyword-face) ("\\<\\(exit\\|cycle\\)[ ]*\\(\\sw+\\)2\\>" 2 font-lock-doc-string-face) ("\\<\\(case\\)[ ]+\\(default\\|(\\)" . 1) ("\\<\\(do\\|go *to\\)\\>[ ]*\\([0-9]+\\)" 1 font-lock-keyword-face) ("\\<\\(do\\|go *to\\)\\>[ ]*\\([0-9]+\\)" 2 font-lock-doc-string-face) ("^[ ]*\\([0-9]+\\)" 1 font-lock-doc-string-face t) ("^[ 0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ ]*(\\sw+)\\)\\(.*::\\|[ ]*(.*)\\)?\\(.*\\)" (1 font-lock-type-face) (4 font-lock-variable-name-face)) ("\\<\\(end[ ]*\\(do\\|if\\|select\\)\\)\\>\\([ ]+\\(\\sw+\\)\\)?" (1 font-lock-keyword-face) (3 font-lock-reference-face nil t)) ("^[ 0-9]*\\(\\(\\sw+\\)[ ]*:[ ]*\\)?\\(\\(if\\|do\\([ ]*while\\)?\\|select[ ]*case\\)\\)\\>" (2 font-lock-reference-face nil t) (3 font-lock-keyword-face)) ("\\<\\(implicit\\)[ ]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ ]*(\\sw+)\\|none\\)\\>" (1 font-lock-keyword-face) (2 font-lock-type-face)) ("\\<\\(namelist\\|common\\)[ ]*/\\(\\sw+\\)?/" (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) ("\\<\\(where\\|forall\\)[ ]*(" . 1) ("\\<\\(exit\\|cycle\\)[ ]*\\(\\sw+\\)?\\>" (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) ("\\<\\(case\\)[ ]+\\(default\\|(\\)" . 1) ("\\<\\(do\\|go *to\\)\\>[ ]*\\([0-9]+\\)" (1 font-lock-keyword-face) (2 font-lock-reference-face)) ("^[ ]*\\([0-9]+\\)" (1 font-lock-reference-face t))] 21) (#$ . 7885)) #@55 Highlights all F90 keywords and intrinsic procedures. (defvar f90-font-lock-keywords-3 (byte-code "À \n ÄÅ\"ƒÀCÈ\"‚ÉDÊF\"‡" [append f90-font-lock-keywords-2 f90-keywords-level-3-re f90-operators-re string-match "XEmacs" emacs-version f90-procedures-re (1 font-lock-keyword-face t) (1 font-lock-keyword-face t) "\\"] 7) (#$ . 10884)) #@38 Highlights all F90 and HPF keywords. (defvar f90-font-lock-keywords-4 (byte-code "À \nC\"‡" [append f90-font-lock-keywords-3 f90-hpf-keywords-re] 3) (#$ . 11241)) #@48 *Default expressions to highlight in F90 mode. (defvar f90-font-lock-keywords f90-font-lock-keywords-2 (#$ . -11410)) #@42 Syntax table in use in F90 mode buffers. (defvar f90-mode-syntax-table nil (#$ . 11534)) (byte-code "„UÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÊ#ˆÂÌÈ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÐ#ˆÂÒÐ#ˆÂÓÐ#ˆÂÔÐ#ˆÂÕÖ#ˆÁ‡" [f90-mode-syntax-table make-syntax-table modify-syntax-entry 33 "<" 10 ">" 95 "w" 39 "\"" 34 96 13 " " 43 "." 45 61 42 47 92 "/"] 4) #@26 Keymap used in F90 mode. (defvar f90-mode-map nil (#$ . 11863)) (byte-code "„aÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆáâ#\"ƒäå!„ræ%å'B'èåéê#ˆ‚$ÂëÁ #ˆÂìíÁî!B#ˆÂïð#ˆÂñò#ˆÂóô#ˆÂõö#ˆÂ÷ø#ˆÂùú#ˆÂûü#ˆÂýþ#ˆÂÿ@#ˆÂAB#ˆÂCD#ˆÂEF#ˆÂGH#ˆÂIJ#ˆÂKL#ˆÂMN#ˆÂOP#ˆÂQR#ˆSTT'B'UVV'B'WXX'B'YZZ'B'[\\\\'B']^^'B'_``'B'äa!„Œbaa'B'ca!‡" [f90-mode-map make-sparse-keymap define-key "`" f90-abbrev-start ";" f90-comment-region "" f90-beginning-of-subprogram "…" f90-end-of-subprogram "ˆ" f90-mark-subprogram "‘" f90-indent-subprogram "\n" f90-indent-new-line " " newline " " f90-break-line "" f90-join-lines "" f90-fill-region "" f90-previous-statement "" f90-next-statement "" f90-insert-end " " f90-indent-line string-match "XEmacs" emacs-version boundp f90-xemacs-menu ("F90" ["Indent Subprogram" f90-indent-subprogram t] ["Mark Subprogram" f90-mark-subprogram t] ["Beginning of Subprogram" f90-beginning-of-subprogram t] ["End of Subprogram" f90-end-of-subprogram t] "-----" ["(Un)Comment Region" f90-comment-region t] ["Indent Region" indent-region t] ["Fill Region" f90-fill-region t] "-----" ["Break Line at Point" f90-break-line t] ["Join with Next Line" f90-join-lines t] ["Insert Newline" newline t] ["Insert End" f90-insert-end t] "-----" ["Upcase Keywords (buffer)" f90-upcase-keywords t] ["Upcase Keywords (region)" f90-upcase-region-keywords t] ["Capitalize Keywords (buffer)" f90-capitalize-keywords t] ["Capitalize Keywords (region)" f90-capitalize-region-keywords t] ["Downcase Keywords (buffer)" f90-downcase-keywords t] ["Downcase Keywords (region)" f90-downcase-region-keywords t] "-----" ["Toggle abbrev-mode" abbrev-mode t] ["Toggle auto-fill" f90-auto-fill-mode t]) current-load-list put variable-documentation "XEmacs menu for F90 mode." [menu-bar] [menu-bar f90] "F90" "f90" [menu-bar f90 abbrev-mode] ("Toggle abbrev-mode" . abbrev-mode) [menu-bar f90 f90-auto-fill-mode] ("Toggle auto-fill" . f90-auto-fill-mode) [menu-bar f90 f90-downcase-region-keywords] ("Downcase Keywords (region)" . f90-downcase-region-keywords) [menu-bar f90 f90-downcase-keywords] ("Downcase Keywords (buffer)" . f90-downcase-keywords) [menu-bar f90 f90-capitalize-keywords] ("Capitalize Keywords (region)" . f90-capitalize-region-keywords) [menu-bar f90 f90-capitalize-region-keywords] ("Capitalize Keywords (buffer)" . f90-capitalize-keywords) [menu-bar f90 f90-upcase-region-keywords] ("Upcase Keywords (region)" . f90-upcase-region-keywords) [menu-bar f90 f90-upcase-keywords] ("Upcase Keywords (buffer)" . f90-upcase-keywords) [menu-bar f90 f90-insert-end] ("Insert end" . f90-insert-end) [menu-bar f90 f90-join-lines] ("Join with Next Line" . f90-join-lines) [menu-bar f90 f90-break-line] ("Break Line at Point" . f90-break-line) [menu-bar f90 f90-fill-region] ("Fill Region" . f90-fill-region) [menu-bar f90 indent-region] ("Indent Region" . indent-region) [menu-bar f90 f90-comment-region] ("(Un)Comment Region" . f90-comment-region) [menu-bar f90 f90-end-of-subprogram] ("End of Subprogram" . f90-end-of-subprogram) [menu-bar f90 f90-beginning-of-subprogram] ("Beginning of Subprogram" . f90-beginning-of-subprogram) [menu-bar f90 f90-mark-subprogram] ("Mark Subprogram" . f90-mark-subprogram) [menu-bar f90 f90-indent-subprogram] ("Indent Subprogram" . f90-indent-subprogram) "\\(block[ ]*data\\|do\\|if\\|interface\\|function\\|module\\|program\\|select\\|subroutine\\|type\\|where\\|forall\\)\\>" f90-blocks-re "\\(program\\|module\\|subroutine\\|function\\)" f90-program-block-re "\\(else\\([ ]*if\\|where\\)?\\|case[ ]*\\(default\\|(\\)\\)\\>" f90-else-like-re "end[ ]*\\(if\\|select\\|where\\|forall\\)\\>" f90-end-if-re "end[ ]*\\(type\\|interface\\|block[ ]*data\\)" f90-end-type-re "\\<\\(type\\)[ ]*\\(,.*::[ ]*\\|[ ]+\\)\\(\\sw+\\)" f90-type-def-re "\\(\\*\\*\\|//\\|=>\\)" f90-no-break-re f90-cache-position nil make-variable-buffer-local] 6) #@40 imenu generic expression for F90 mode. (defvar f90-imenu-generic-expression (byte-code "ÀÁÂÃÄÅÆ°ÇÈÉÊFB‡" ["^[ 0-9]*\\(" "program[ ]+\\(\\sw+\\)\\|" "module[ ]+\\(\\sw+\\)[ ]*\\(!\\|$\\)\\|" "\\(recursive[ ]*\\)?subroutine[ ]+\\(\\sw+\\)\\|" "\\([^!]*\\([^e!].[^ !]\\|.[^n!][^ !]\\|..[^d !]\\)" "\\|[^!]?[^!]?\\)[ ]*function[ ]+\\(\\sw+\\)" "\\)" 2 3 6 9] 7) (#$ . 15911)) (byte-code "ÀÁ!„ÂÁ B „ñ\fÆÁÂ\"ˆÇ ÈÉÂ$ˆÇ ÊËÂ$ˆÇ ÌÍÂ$ˆÇ ÎÏÂ$ˆÇ ÐÑÂ$ˆÇ ÒÓÂ$ˆÇ ÔÕÂ$ˆÇ Ö×Â$ˆÇ ØÙÂ$ˆÇ ÚÛÂ$ˆÇ ÜÝÂ$ˆÇ ÞßÂ$ˆÇ àáÂ$ˆÇ âãÂ$ˆÇ äåÂ$ˆÇ æçÂ$ˆÇ èéÂ$ˆÇ êëÂ$ˆÇ ìíÂ$ˆÇ îïÂ$ˆÇ ðñÂ$ˆÇ òóÂ$ˆÇ ôõÂ$ˆÇ ö÷Â$ˆÇ øùÂ$ˆÇ úûÂ$ˆÇ üýÂ$ˆÇ þÿÂ$ˆÇ @AÂ$ˆÇ BCÂ$ˆÇ DEÂ$ˆÇ FGÂ$ˆÇ HIÂ$ˆÇ JKÂ$ˆÇ LMÂ$ˆÇ NOÂ$ˆÇ PQÂ$ˆÇ RSÂ$ˆÇ TUÂ$ˆÇ VWÂ$ˆÇ XYÂ$ˆÇ Z[Â$ˆÇ \\]Â$ˆÇ ^_Â$ˆÇ `aÂ$ˆÇ bcÂ$ˆÇ deÂ$ˆÇ fgÂ$ˆÇ hiÂ$ˆÇ jkÂ$ˆÇ lmÂ$ˆÇ noÂ$ˆÇ pqÂ$ˆ )‡" [boundp f90-mode-abbrev-table nil current-load-list abbrevs-changed ac define-abbrev-table define-abbrev "`al" "allocate" "`ab" "allocatable" "`as" "assignment" "`ba" "backspace" "`bd" "block data" "`c" "character" "`cl" "close" "`cm" "common" "`cx" "complex" "`cn" "contains" "`cy" "cycle" "`de" "deallocate" "`df" "define" "`di" "dimension" "`dw" "do while" "`el" "else" "`eli" "else if" "`elw" "elsewhere" "`eq" "equivalence" "`ex" "external" "`ey" "entry" "`fl" "forall" "`fo" "format" "`fu" "function" "`fa" ".false." "`im" "implicit none" "`in " "include" "`i" "integer" "`it" "intent" "`if" "interface" "`lo" "logical" "`mo" "module" "`na" "namelist" "`nu" "nullify" "`op" "optional" "`pa" "parameter" "`po" "pointer" "`pr" "print" "`pi" "private" "`pm" "program" "`pu" "public" "`r" "real" "`rc" "recursive" "`rt" "return" "`rw" "rewind" "`se" "select" "`sq" "sequence" "`su" "subroutine" "`ta" "target" "`tr" ".true." "`t" "type" "`wh" "where" "`wr" "write"] 5) #@2317 Major mode for editing Fortran 90 code in free format. \[f90-indent-new-line] corrects current indentation and creates new indented line. \[f90-indent-line] indents the current line correctly. \[f90-indent-subprogram] indents the current subprogram. Type `? or `\[help-command] to display a list of built-in abbrevs for F90 keywords. Key definitions: \{f90-mode-map} Variables controlling indentation style and extra features: f90-do-indent Extra indentation within do blocks. (default 3) f90-if-indent Extra indentation within if/select case/where/forall blocks. (default 3) f90-type-indent Extra indentation within type/interface/block-data blocks. (default 3) f90-program-indent Extra indentation within program/module/subroutine/function blocks. (default 2) f90-continuation-indent Extra indentation applied to continuation lines. (default 5) f90-comment-region String inserted by \[f90-comment-region] at start of each line in region. (default "!!!$") f90-indented-comment-re Regexp determining the type of comment to be intended like code. (default "!") f90-directive-comment-re Regexp of comment-like directive like "!HPF\\$", not to be indented. (default "!hpf\\$") f90-break-delimiters Regexp holding list of delimiters at which lines may be broken. (default "[-+*/><=,% \t]") f90-break-before-delimiters Non-nil causes `f90-do-auto-fill' to break lines before delimiters. (default t) f90-beginning-ampersand Automatic insertion of & at beginning of continuation lines. (default t) f90-smart-end From an END statement, check and fill the end using matching block start. Allowed values are 'blink, 'no-blink, and nil, which determine whether to blink the matching beginning.) (default 'blink) f90-auto-keyword-case Automatic change of case of keywords. (default nil) The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word. f90-leave-line-no Do not left-justify line numbers. (default nil) f90-startup-message Set to nil to inhibit message first time F90 mode is used. (default t) f90-keywords List of keywords used for highlighting/upcase-keywords etc. Turning on F90 mode calls the value of the variable `f90-mode-hook' with no args, if that value is non-nil. (defalias 'f90-mode #[nil "À ˆÁà Ç!ˆÉ\n!ˆËÌ!ˆÍ\fËÎ!ˆÏËÐ!ˆÑËÒ!ˆÓËÔ!ˆÕËÖ!ˆ×ËØ!ˆÑÙÛÜ\"ƒ{ÞÁßÑ#ˆ ƒpáà \"„pâã !!ˆäÙ%\"ˆËæ!ˆ'&‚ŠËè!ˆé(Ëê!ˆ+*ìí!ˆ.ƒ™ïð1\"ˆÙ‰.‡" [kill-all-local-variables f90-mode major-mode "F90" mode-name f90-mode-abbrev-table local-abbrev-table set-syntax-table f90-mode-syntax-table use-local-map f90-mode-map make-local-variable indent-line-function f90-indent-line indent-region-function f90-indent-region require-final-newline t comment-start "!" comment-start-skip "!+ *" comment-indent-function f90-comment-indent abbrev-all-caps nil indent-tabs-mode string-match "Xemacs" emacs-version put font-lock-keywords-case-fold-search current-menubar assoc set-buffer-menubar copy-sequence add-submenu f90-xemacs-menu font-lock-keywords f90-font-lock-keywords font-lock-defaults ((f90-font-lock-keywords f90-font-lock-keywords-1 f90-font-lock-keywords-2 f90-font-lock-keywords-3 f90-font-lock-keywords-4) nil t) imenu-generic-expression f90-imenu-generic-expression run-hooks f90-mode-hook f90-startup-message message "Emacs F90 mode; please report bugs to %s" bug-f90-mode] 4 (#$ . 17790) nil]) (defalias 'f90-get-beg-of-line #[nil "ŠÀyˆ`)‡" [0] 1]) (put (quote f90-get-beg-of-line) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'f90-get-end-of-line #[nil "ŠÀˆ`)‡" [nil] 1]) (put (quote f90-get-end-of-line) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'f90-in-string #[nil "ƒ`Vƒ‚eÂà `\"8)‡" [f90-cache-position beg-pnt 3 parse-partial-sexp] 4]) (put (quote f90-in-string) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'f90-in-comment #[nil "ƒ`Vƒ‚eÂà `\"8)‡" [f90-cache-position beg-pnt 4 parse-partial-sexp] 4]) (put (quote f90-in-comment) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'f90-line-continued #[nil "ŠŠÀyˆ`)ˆ ƒ` Vƒ ‚eÅÆ\f`\"8)ƒ1ÇÈ \"ˆÈÂxˆ‚ ÉÂxˆhÊU*‡" [0 bol nil f90-cache-position beg-pnt 4 parse-partial-sexp search-backward "!" " " 38] 4]) (put (quote f90-line-continued) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@88 Return indentation of current line. Line-numbers are considered whitespace characters. (defalias 'f90-current-indentation #[nil "ŠÀyˆÁÂwˆi)‡" [0 " 0-9" nil] 2 (#$ . 22236)]) (put (quote f90-current-indentation) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@93 Indent current line to column COL. If no-line-number nil, jump over a possible line-number. (defalias 'f90-indent-to #[(col &optional no-line-number) "Àyˆ „ ÂÃwˆÄ ˆiÀUƒ j‡Æ Ç\"‡" [0 no-line-number " 0-9" nil delete-horizontal-space col indent-to 1] 3 (#$ . 22513)]) (put (quote f90-indent-to) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'f90-match-piece #[(arg) "”…\n”•{‡" [arg] 2]) (put (quote f90-match-piece) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'f90-get-present-comment-type #[nil "ŠÀŠÀˆ`) ƒ` Vƒ ‚eÅÆ\f`\"8)ƒTÇyˆÈÉ \"ˆ ƒ:` Vƒ: ‚;eÊÆ\f`\"8)ƒNÈÉ \"ˆ‚,ǔǕ{\n+‡" [nil eol type f90-cache-position beg-pnt 4 parse-partial-sexp 0 re-search-forward "[!]+" 3] 4]) (put (quote f90-get-present-comment-type) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@61 Compare strings neglecting case and allowing for nil value. (defalias 'f90-equal-symbols #[(a b) "…— …\f —‰\n*š‡" [a b b-local a-local] 3 (#$ . 23363)]) (put (quote f90-equal-symbols) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@101 Return ("do" name) if a do statement starts after point. Name is nil if the statement has no label. (defalias 'f90-looking-at-do #[nil "ÀÁ!…1ÂÃÔ…\f”\f•{)ÀÇ!ƒ,ÈÈ”…)\f”\f•{) *D‡" [looking-at "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(do\\)\\>" nil 3 arg struct label "\\(\\sw+\\)[ ]*:" 1] 3 (#$ . 23620)]) (put (quote f90-looking-at-do) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@114 Return ("select" name) if a select-case statement starts after point. Name is nil if the statement has no label. (defalias 'f90-looking-at-select-case #[nil "ÀÁ!…1ÂÃÔ…\f”\f•{)ÀÇ!ƒ,ÈÈ”…)\f”\f•{) *D‡" [looking-at "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(select\\)[ ]*case[ ]*(" nil 3 arg struct label "\\(\\sw+\\)[ ]*:" 1] 3 (#$ . 24027)]) (put (quote f90-looking-at-select-case) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@110 Return ("if" name) if an if () then statement starts after point. Name is nil if the statement has no label. (defalias 'f90-looking-at-if-then #[nil "ŠÀ‰ÃÄ!…—ÅÅ”…”•{)ÃÇ!ƒ3ÈÈ”…1”•{)É`ÈÊ#bˆËÀwˆÃÌ!„”ŠŠÊyˆ`) Àˆƒa`Vƒa‚beÐÑ`\"8)ƒ|ÒÓ \"ˆÓÀxˆ‚PËÀxˆhÔU*…—Õ ˆÖÀwˆÃÌ!…—\n D+‡" [nil label struct looking-at "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(if\\)\\>" 3 arg "\\(\\sw+\\)[ ]*:" 1 scan-lists 0 " " "then\\>" bol f90-cache-position beg-pnt 4 parse-partial-sexp search-backward "!" 38 f90-next-statement " 0-9&"] 4 (#$ . 24481)]) (put (quote f90-looking-at-if-then) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@61 Return (kind nil) if where/forall...end starts after point. (defalias 'f90-looking-at-where-or-forall #[nil "ŠÀÂÃ!…+ÄÄ”… ” •{)ÀDÆ`ÄÇ#bˆÈÀwˆÂÉ!…+ *‡" [nil command looking-at "\\(where\\|forall\\)[ ]*(" 1 arg scan-lists 0 " " "\\(!\\|$\\)"] 4 (#$ . 25139)]) (put (quote f90-looking-at-where-or-forall) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@102 Return (kind name) at the start of a type/interface/block-data block. Name is non-nil only for type. (defalias 'f90-looking-at-type-like #[nil "À !ƒ\"”… ” •{)ÄÄ”… ” •{)D‡ÀÅ!…7”…4 ” •{)ÆD‡" [looking-at f90-type-def-re 1 arg 3 "\\(interface\\|block[ ]*data\\)\\>" nil] 3 (#$ . 25514)]) (put (quote f90-looking-at-type-like) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@74 Return (kind name) if a program block with name name starts after point. (defalias 'f90-looking-at-program-block-start #[nil "ÀÁ!ƒ\"”… ” •{)ÄÄ”… ” •{)D‡ÀÅ!„JÀÆ!ƒJ”…: ” •{)ÄÄ”…G ” •{)D‡ÀÇ!ƒlÄÄ”…\\ ” •{)ÈÈ”…i ” •{)D‡ÀÉ!?…”ÀÊ!…””…… ” •{)ÄÄ”…’ ” •{)D‡" [looking-at "\\(program\\)[ ]+\\(\\sw+\\)\\>" 1 arg 2 "module[ ]*procedure\\>" "\\(module\\)[ ]+\\(\\sw+\\)\\>" "\\(recursive[ ]*\\)?\\(subroutine\\)[ ]+\\(\\sw+\\)" 3 "end[ ]*function" ".*\\(function\\)[ ]+\\(\\sw+\\)"] 3 (#$ . 25915)]) (put (quote f90-looking-at-program-block-start) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@47 Return list of type and name of end of block. (defalias 'f90-looking-at-program-block-end #[nil "ÀÁ\nÃQ!…$ÄÄ”… ” •{)ÆÆ”…\" ” •{)D‡" [looking-at "end[ ]*" f90-blocks-re "?\\([ ]+\\(\\sw+\\)\\)?\\>" 1 arg 3] 4 (#$ . 26552)]) (put (quote f90-looking-at-program-block-end) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'f90-comment-indent #[nil "ÀÁ!ƒ‡ ƒÀ !ƒ‡ÀÄ !!ƒ‡À!ƒ(Ç ‡ÈÉxˆnƒ4‚6iT\n]‡" [looking-at "!!!" 0 f90-directive-comment-re regexp-quote f90-comment-region f90-indented-comment-re f90-calculate-indent " " nil comment-column] 3]) (put (quote f90-comment-indent) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@54 Return continuation properties of present statement. (defalias 'f90-present-statement-cont #[nil "À‰ŠÃ …HŠŠÄyˆ`)Àˆƒ&`Vƒ&‚'eÈÉ`\"8)ƒ@ÊË \"ˆËÀxˆ‚ÌÀxˆhÍU*)ŠŠÄyˆ`)Àˆƒf`Vƒf‚geÈÉ`\"8)ƒ€ÊË \"ˆËÀxˆ‚UÌÀxˆhÍU*\n„• „•Î‚»\n„¡ ƒ¡Ï‚»\nƒ­ „­Ð‚»\nƒ¹ ƒ¹Ñ‚»Ò *‡" [nil cont pcont f90-previous-statement 0 bol f90-cache-position beg-pnt 4 parse-partial-sexp search-backward "!" " " 38 single begin end middle error] 4 (#$ . 27234)]) (put (quote f90-present-statement-cont) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'f90-indent-line-no #[nil "„ÁÂwÃU„ÄÅ!ƒÆ ˆÇÂw‡" [f90-leave-line-no " " nil 0 looking-at "[0-9]" delete-horizontal-space " 0-9"] 2]) (put (quote f90-indent-line-no) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'f90-no-block-limit #[nil "ŠÀˆ`)ŠÂÃ!†,ÂÄ!†,ÂÅ!†,ÂÆ!†,Â!†,ÈÉ Ê#*?‡" [nil eol looking-at "end" "\\(do\\|if\\|else\\|select[ ]*case\\|case\\|where\\|forall\\)\\>" "\\(program\\|module\\|interface\\|block[ ]*data\\)\\>" "\\(contains\\|\\sw+[ ]*:\\)" f90-type-def-re re-search-forward "\\(function\\|subroutine\\)" t] 4]) (put (quote f90-no-block-limit) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'f90-update-line #[nil "À‰ …ŠÄyˆ`)ŠÀˆ`) …Å \n #*‡" [nil eol bol f90-auto-keyword-case 0 f90-change-keywords] 4]) (put (quote f90-update-line) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@106 Get correct indent for a line starting with line number. Does not check type and subprogram indentation. (defalias 'f90-get-correct-indent #[nil "ŠÀˆ`)À‰ŠÄ ƒäÀ‰ŠÄ …[ŠŠÆyˆ`)Àˆƒ8`Vƒ8‚9e ÊË `\"8)ƒSÌÍ\"ˆÍÀxˆ‚'ÎÀxˆhÏU*)ŠŠÆyˆ`)Àˆƒz`Vƒz‚{e ÊË `\"8)ƒ•ÌÍ\"ˆÍÀxˆ‚iÎÀxˆhÏU* „ª „ªÐ‚Ð „¶ ƒ¶Ñ‚Ð ƒÂ „ÂÒ‚Ð ƒÎ ƒÎÓ‚ÐÔ *‰Ò=„\f Ó=„\fÕÖ!„\f× ÆyˆØÙŠÀˆ`)Ú#ƒ\\ÆyˆÎÀwˆÕÛ!ƒBÀÜÜ”…”•{)Õà!ƒ1áá”….”•{)*DƒB\n\"\\‚YŠÀ‰Õã!…ßÜÜ”…^”•{)Õà!ƒyáá”…v”•{)ä`áÆ#bˆÎÀwˆÕå!„ÚŠŠÆyˆ`)Àˆƒ§`Vƒ§‚¨e ÊË `\"8)ƒÂÌÍ\"ˆÍÀxˆ‚–ÎÀxˆhÏU*…ßæ ˆçÀwˆÕå!…ßD+„TŠÀ(Õé!…áá”…ü”•{)ÀD(ä`áÆ#bˆÎÀwˆÕê!…(*„TÕë!ƒYÀÜÜ”….”•{)Õà!ƒKáá”…H”•{)*DƒY\n,\\ÀˆØÙ Ú#ƒéÆyˆíÀwˆÕÛ!ƒ¯ÀÜÜ”…”•{)Õà!ƒžáá”…›”•{)*Dƒ¯\n\"\\‚ãŠÀ‰Õã!…LÜÜ”…Ë”•{)Õà!ƒæáᔅ㔕{)ä`áÆ#bˆÎÀwˆÕå!„GŠŠÆyˆ`)Àˆƒ`Vƒ‚e ÊË `\"8)ƒ/ÌÍ\"ˆÍÀxˆ‚ÎÀxˆhÏU*…Læ ˆçÀwˆÕå!…LD+„ÁŠÀ(Õé!…áá”…i”•{)ÀD(ä`áÆ#bˆÎÀwˆÕê!…(*„ÁÕë!ƒÉÀÜÜ”…›”•{)Õà!ƒ¸áá”…µ”•{)*DƒÉ\n,\\‚ãÕ.!ƒØ\n,Z‚ãÕï!ƒã\n\"ZÀˆ‚\\\n,‡" [nil cont icol epnt f90-previous-statement pcont 0 bol f90-cache-position beg-pnt 4 parse-partial-sexp search-backward "!" " " 38 single begin end middle error looking-at "[ ]*[0-9]" current-indentation re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)" t "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(do\\)\\>" 3 arg struct label "\\(\\sw+\\)[ ]*:" 1 f90-do-indent "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(if\\)\\>" scan-lists "then\\>" f90-next-statement " 0-9&" command "\\(where\\|forall\\)[ ]*(" "\\(!\\|$\\)" "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(select\\)[ ]*case[ ]*(" f90-if-indent " 0-9" f90-end-if-re "end[ ]*do\\>"] 5 (#$ . 28697)]) #@59 Calculate the indent column based on previous statements. (defalias 'f90-calculate-indent #[nil "À‰Á`ŠÆ „Ç‚îÀ‰ŠÆ …^ŠŠÇyˆ`) Àˆ\nƒ;`\nVƒ;\n‚<e ÌÍ `\"8)ƒVÎÏ \"ˆÏÀxˆ‚*ÐÀxˆhÑU*)ŠŠÇyˆ`) Àˆ\nƒ~`\nVƒ~\n‚e ÌÍ `\"8)ƒ™ÎÏ \"ˆÏÀxˆ‚mÐÀxˆhÑU*„¯\f„¯Ò‚Ø„¼\fƒ¼Ó‚؃É\f„ÉԂ؃Ö\fƒÖÕ‚ØÖ *‰Ô=ƒ±À‰ŠÆ …+ŠŠÇyˆ`) Àˆ\nƒ`\nVƒ\n‚ e ÌÍ `\"8)ƒ#ÎÏ \"ˆÏÀxˆ‚÷ÐÀxˆhÑU*)ŠŠÇyˆ`) Àˆ\nƒK`\nVƒK\n‚Le ÌÍ `\"8)ƒfÎÏ \"ˆÏÀxˆ‚:ÐÀxˆhÑU*„|\f„|Ò‚¥„‰\fƒ‰Ó‚¥ƒ–\f„–Ô‚¥ƒ£\fƒ£Õ‚¥Ö *Ó=„±Æ ˆ‚à\fÓ=ƒÈŠÇyˆ×Àwˆi)\\‚î\fÕ=ƒÔÙ ‚îŠÇyˆ×Àwˆi)ÐÀwˆÚÛ!ƒïÜ ‚aŠÀ‰Úß!…Œà!à”… !”!•{)Úâ!ƒ&ã!ã”…#!”!•{)ä`ãÇ#bˆÐÀwˆÚå!„‡ŠŠÇyˆ`) Àˆ\nƒT`\nVƒT\n‚Ue ÌÍ `\"8)ƒoÎÏ \"ˆÏÀxˆ‚CÐÀxˆhÑU*…Œæ ˆçÀwˆÚå!…ŒD+„ŠÀ(Úé!…Áã!ã”…©!”!•{)ÀD(ä`ãÇ#bˆÐÀwˆÚê!…Á(*„Úë!ƒÀà!à”…Û!”!•{)Úâ!ƒøã!ã”…õ!”!•{)*D„Ú,!ƒ -\\‚aÚî!ƒTÀà!à”…&!”!•{)Úâ!ƒCã!ã”…@!”!•{)*DƒT /\\‚aÚ0!ƒã!ã”…j!”!•{)à!à”…z!”!•{)D‚—Úñ!ƒ¢ã!ã”…”!”!•{)ÀDƒ¢ 2\\‚aÚó!ƒÌã!ã”…·!”!•{)ô!ô”…Ç!”!•{)D‚SÚõ!„üÚö!ƒüã!ã”…ç!”!•{)ô!ô”…÷!”!•{)D‚SÚ÷!ƒ&ô!ô”…!”!•{)à!à”…!!”!•{)D‚SÚø!„VÚù!ƒVã!ã”…A!”!•{)ô!ô”…Q!”!•{)D„\\Úú!ƒa ;\\\nbˆÇyˆÚü!„îÚý!ƒxÇ‚î×ÀwˆÚ,!„ŠÚ>!ƒ’ -Z‚îÚÿ!ƒ  /Z‚îÚ@!ƒ¯ 2Z‚îÚA!„éÚBCDQ!ƒîã!ã”…Ô!”!•{)à!à”…ä!”!•{)Dƒî ;Z) ,‡" [nil t pnt case-fold-search cont icol f90-previous-statement 0 pcont bol f90-cache-position beg-pnt 4 parse-partial-sexp search-backward "!" " " 38 single begin end middle error " 0-9" f90-continuation-indent current-indentation looking-at "[0-9]" f90-get-correct-indent label struct "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(if\\)\\>" 3 arg "\\(\\sw+\\)[ ]*:" 1 scan-lists "then\\>" f90-next-statement " 0-9&" command "\\(where\\|forall\\)[ ]*(" "\\(!\\|$\\)" "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(select\\)[ ]*case[ ]*(" f90-else-like-re f90-if-indent "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(do\\)\\>" f90-do-indent f90-type-def-re "\\(interface\\|block[ ]*data\\)\\>" f90-type-indent "\\(program\\)[ ]+\\(\\sw+\\)\\>" 2 "module[ ]*procedure\\>" "\\(module\\)[ ]+\\(\\sw+\\)\\>" "\\(recursive[ ]*\\)?\\(subroutine\\)[ ]+\\(\\sw+\\)" "end[ ]*function" ".*\\(function\\)[ ]+\\(\\sw+\\)" "contains[ ]*\\($\\|!\\)" f90-program-indent "[ ]*$" "[ ]*#" f90-end-if-re "end[ ]*do\\>" f90-end-type-re "contains[ ]*\\(!\\|$\\)" "end[ ]*" f90-blocks-re "?\\([ ]+\\(\\sw+\\)\\)?\\>"] 5 (#$ . 30519) nil]) #@102 Move point to beginning of the previous F90 statement. Return nil if no previous statement is found. (defalias 'f90-previous-statement #[nil "ÀÂyˆÃyÂU‰ƒÄÅ!„ )‡" [nil not-first-statement 0 -1 looking-at "[ 0-9]*\\(!\\|$\\|#\\)"] 2 (#$ . 33027) nil]) #@95 Move point to beginning of the next F90 statement. Return nil if no later statement is found. (defalias 'f90-next-statement #[nil "ÀÂyˆÃyÂU…m?‰ƒÄÅ!„ )‡" [nil not-last-statement 0 1 looking-at "[ 0-9]*\\(!\\|$\\)"] 2 (#$ . 33289) nil]) #@84 Move point to the beginning of subprogram. Return (type name) or nil if not found. (defalias 'f90-beginning-of-subprogram #[nil "ÀÁÂÆyˆÇÂwˆÈÉ!ƒ7À\nÀ”…\"\n”\n•{)Ë\nË”…2\n”\n•{)D‚¿ÈÌ!„gÈÍ!ƒgÀ\nÀ”…R\n”\n•{)Ë\nË”…b\n”\n•{)D‚¿ÈÎ!ƒ‘Ë\nË”…|\n”\n•{)Ï\nÏ”…Œ\n”\n•{)D‚¿ÈÐ!?…¿ÈÑ!…¿À\nÀ”…­\n”\n•{)Ë\nË”…½\n”\n•{)D‰ƒÈ ÀZ ÆU„ÓÒÂÔ#ƒÓÆyˆÇÂwˆÈÉ!ƒÀ\nÀ”…ó\n”\n•{)Ë\nË”…\n”\n•{)D‚ÈÌ!„8ÈÍ!ƒ8À\nÀ”…#\n”\n•{)Ë\nË”…3\n”\n•{)D‚ÈÎ!ƒbË\nË”…M\n”\n•{)Ï\nÏ”…]\n”\n•{)D‚ÈÐ!?…ÈÑ!…À\nÀ”…~\n”\n•{)Ë\nË”…Ž\n”\n•{)D‰ƒ ÀZ‰‚ÉÈÕ×Q!ƒÈÀ\nÀ”…¶\n”\n•{)Ï\nÏ”…Æ\n”\n•{)DƒÈ À\\‰‚ÉÆyˆ ÆUƒà ‚åØÙ!ˆÂ+‡" [1 t nil matching-beg case-fold-search count 0 " 0-9" looking-at "\\(program\\)[ ]+\\(\\sw+\\)\\>" arg 2 "module[ ]*procedure\\>" "\\(module\\)[ ]+\\(\\sw+\\)\\>" "\\(recursive[ ]*\\)?\\(subroutine\\)[ ]+\\(\\sw+\\)" 3 "end[ ]*function" ".*\\(function\\)[ ]+\\(\\sw+\\)" re-search-backward f90-program-block-re move "end[ ]*" f90-blocks-re "?\\([ ]+\\(\\sw+\\)\\)?\\>" message "No beginning-found."] 5 (#$ . 33539) nil]) #@78 Move point to the end of subprogram. Return (type name) or nil if not found. (defalias 'f90-end-of-subprogram #[nil "ÀÁÂÆyˆÇÂwˆÈÉ\nËQ!…8À\fÀ”…&\f”\f•{)Í\fÍ”…6\f”\f•{)D‰ƒ@ Sˆ ÆU„MÎÂÐ#ƒMÆyˆÇÂwˆÈÑ!ƒƒÀ\fÀ”…n\f”\f•{)Ò\fÒ”…~\f”\f•{)D‚\nÈÓ!„³ÈÔ!ƒ³À\fÀ”…ž\f”\f•{)Ò\fÒ”…®\f”\f•{)D‚\nÈÕ!ƒÝÒ\fÒ”…È\f”\f•{)Í\fÍ”…Ø\f”\f•{)D‚\nÈÖ!„È×!ƒÀ\fÀ”…ø\f”\f•{)Ò\fÒ”…\f”\f•{)Dƒ À\\‚GÈÉ\nËQ!…?À\fÀ”…-\f”\f•{)Í\fÍ”…=\f”\f•{)D‰ƒG Sˆ‚CÀyˆ ÆUƒZ ‚_ØÙ!ˆÂ+‡" [1 t nil matching-end case-fold-search count 0 " 0-9" looking-at "end[ ]*" f90-blocks-re "?\\([ ]+\\(\\sw+\\)\\)?\\>" arg 3 re-search-forward f90-program-block-re move "\\(program\\)[ ]+\\(\\sw+\\)\\>" 2 "module[ ]*procedure\\>" "\\(module\\)[ ]+\\(\\sw+\\)\\>" "\\(recursive[ ]*\\)?\\(subroutine\\)[ ]+\\(\\sw+\\)" "end[ ]*function" ".*\\(function\\)[ ]+\\(\\sw+\\)" message "No end found."] 4 (#$ . 34650) nil]) #@115 Put mark at end of F90 subprogram, point at beginning. Marks are pushed and highlight (grey shadow) is turned on. (defalias 'f90-mark-subprogram #[nil "`Àà ˆÄ`Å\"ˆ\nbˆÆ ÇÈ \"ƒ Ê ˆ‚&Å À\f *‡" [nil program pos f90-end-of-subprogram push-mark t f90-beginning-of-subprogram string-match "XEmacs" emacs-version zmacs-activate-region mark-active deactivate-mark] 3 (#$ . 35595) nil]) #@151 Comment/uncomment every line in the region. Insert f90-comment-region at the beginning of every line in the region or, if already present, remove it. (defalias 'f90-comment-region #[(beg-region end-region) "À ‰\nÓˆ\fbˆÅyˆÆÇ!!ƒ`Å•|ˆ‚#cˆÉyÅUƒJ`Ê !WƒJÆÇ!!ƒC`Å•|ˆ‚#cˆ‚# É“)‡" [make-marker end end-region nil beg-region 0 looking-at regexp-quote f90-comment-region 1 marker-position] 4 (#$ . 35988) "*r"]) #@34 Indent current line as F90 code. (defalias 'f90-indent-line #[(&optional no-update) "À‰Á Â\f`À“ˆÇyˆŠÈ …XŠŠÇyˆ`) Àˆ\nƒ5`\nVƒ5\n‚6e ÌÍ `\"8)ƒPÎÏ \"ˆÏÀxˆ‚$ÐÀxˆhÑU*)ƒeÂÐÀwˆ‚„{ÐÀwÇU„{ÓÔ!ƒ{Õ ˆÖÀwˆÓÏ!ƒÎÓ×!ƒÇ‚ɃŸÓ!ƒŸÇ‚ÉÓÙ!!ƒ¬Ç‚ÉÓ!ƒ¸Ü ‚ÉÐÀxˆnƒÄÇ‚ÆiT]‚àÓÞ!ƒÜƒÜà ˆÜ iZÇU„ !Çyˆ „úÖÀwˆÕ ˆiÇUƒ !j‚â!ã\"ˆ*`ä\f!Wƒä\f!bˆ%„LÀ‰& '…JŠÇyˆ`) ŠÀˆ`)&'…Jè' &#*ˆ)ƒbŠÀˆi)*VƒbŠë ˆ)\fÀ‰“,‡" [nil make-marker t case-fold-search pos no-line-number indent 0 f90-previous-statement bol f90-cache-position beg-pnt 4 parse-partial-sexp search-backward "!" " " 38 f90-leave-line-no looking-at "[0-9]" delete-horizontal-space " 0-9" "!!!" f90-directive-comment-re regexp-quote f90-comment-region f90-indented-comment-re f90-calculate-indent comment-column "end" f90-smart-end f90-match-end col indent-to 1 marker-position no-update eol f90-auto-keyword-case f90-change-keywords auto-fill-function fill-column f90-do-auto-fill] 4 (#$ . 36414) nil]) #@193 Reindent the current F90 line, insert a newline and indent the newline. An abbrev before point is expanded if `abbrev-mode' is non-nil. If run in the middle of a line, the line is not broken. (defalias 'f90-indent-new-line #[nil "À‰Á ƒ Æ ˆÇyˆ„&ÉÀwÇU„&ÊË!ƒ&Ì ˆÍÀwˆÊÎ!ƒ4ÏÐ!ˆÀˆÌ ˆƒK`VƒK‚LeÓÔ`\"8)ŠŠÇyˆ`)Àˆƒt`Vƒt‚ueÖÔ`\"8)ƒ×Ø\"ˆØÀxˆ‚cÉÀxˆhÙU*\fƒ£ „£ÚcˆÀ‰…ËŠÇyˆ`)ŠÀˆ`)…ËÝ#*ˆÞ ˆ\f„Ý ƒàƒàÚcˆÏÐ!+‡" [nil t case-fold-search cont string abbrev-mode expand-abbrev 0 f90-leave-line-no " " looking-at "[0-9]" delete-horizontal-space " 0-9" "\\(end\\|else\\|!\\)" f90-indent-line no-update f90-cache-position beg-pnt 3 parse-partial-sexp bol 4 search-backward "!" 38 "&" eol f90-auto-keyword-case f90-change-keywords newline f90-beginning-ampersand] 4 (#$ . 37429) nil]) #@49 Indent every line in region by forward parsing. (defalias 'f90-indent-region #[(beg-region end-region) "À Á ‰‰‰‰‰‰‰ \n ‰\f “ˆbˆÏyˆÐÑ!ƒBÒÓ!ˆÔyÏUƒB`\fW„*‰ŠÖ …ŽŠŠÏyˆ`)ˆƒk`Vƒk‚leÚÛ`\"8)ƒ†ÜÝ\"ˆÝÂxˆ‚ZÞÂxˆhßU*)ŠŠÏyˆ`)ˆƒ®`Vƒ®‚¯eÚÛ`\"8)ƒÉÜÝ\"ˆÝÂxˆ‚ÞÂxˆhßU*„á„áà‚ „ïƒïá‚ ƒý„ýâ‚ ƒ ƒ ã‚ ä *‰ã=„â=ƒôÖ ƒô‰ŠÖ …nŠŠÏyˆ`)ˆƒK`VƒK‚LeÚÛ`\"8)ƒfÜÝ\"ˆÝÂxˆ‚:ÞÂxˆhßU*)ŠŠÏyˆ`)ˆƒŽ`VƒŽ‚eÚÛ`\"8)ƒ©ÜÝ\"ˆÝÂxˆ‚}ÞÂxˆhßU*„Á„Áà‚í„σÏá‚íƒÝ„Ýâ‚íƒëƒëã‚íä *‰‚`ÒÓ!ˆŠÏyˆåÂwˆi)‰ ÏyˆåÂwˆÂÐæ!…JÂç(ç”…)(”(•{))Ðê!ƒEÔ(Ô”…B(”(•{)) )*D‰ƒT+‚ƒŠÂ‰)Ðì!…îç(ç”…o(”(•{)Ðê!ƒ‰Ô(Ô”…†(”(•{))í`ÔÏ#bˆÞÂwˆÐî!„ꊊÏyˆ`)ˆƒ·`Vƒ·‚¸eÚÛ`\"8)ƒÒÜÝ\"ˆÝÂxˆ‚¦ÞÂxˆhßU*…îï ˆðÂwˆÐî!…î )D+‰„nÐñ!…+Âç(ç”…\n(”(•{))Ðê!ƒ&Ô(Ô”…#(”(•{)) )*D‰„nŠÂ2Ðó!…aÔ(Ô”…I(”(•{)ÂD2í`ÔÏ#bˆÞÂwˆÐô!…a2*‰„nÐ5!ƒs6‚ƒÐ7!ƒžÔ(Ô”…‰(”(•{)ç(ç”…™(”(•{)D‚¶Ðø!…¶Ô(Ô”…³(”(•{)ÂD‰ƒÀ9‚ƒÐú!ƒêÔ(Ô”…Õ(”(•{)û(û”…å(”(•{)D‚tÐü!„Ðý!ƒÔ(Ô”…(”(•{)û(û”…(”(•{)D‚tÐþ!ƒDû(û”…/(”(•{)ç(ç”…?(”(•{)D‚tÐÿ!?…tÐ@!…tÔ(Ô”…b(”(•{)û(û”…r(”(•{)D‰„ÐA!…ƒB‰ƒ \\ ƒš \nB\nŠŠÏyˆ`)ˆƒ·`Vƒ·‚¸eÚÛ`\"8)ƒÒÜÝ\"ˆÝÂxˆ‚¦ÞÂxˆhßU*ƒ/ÔyÏUƒ/`\fWƒ/C D\\ZÏU„šD\\EFGÏyˆF„åÂwˆH ˆiÏUƒ#Gj‚*IGÔ\"ˆ*‚šÔyÏUƒK\n`\fWƒK\nÏyˆJ„ZÞÂwÏU„ZÐK!ƒZH ˆåÂwˆ`ÐL!ƒoÏ‚€ ÐM!ƒ}Ï‚€ ÐÝ!ƒÒÐN!ƒÏ‚ÍOƒŸÐO!ƒŸÏ‚ÍÐPQ!!ƒ®Ï‚ÍÐR!ƒ¼S ‚ÍÞÂxˆnƒÈÏ‚ÊiTT]‚€ ŠÂˆ`)UŠÐV!†ÐW!†ÐX!†ÐY!†Ð7!†Z[U\\#*„ ‚€ Ð5!ƒ* 6Z‚€ ÐA!ƒ< BZ‚€ Ðæ!…sÂç(ç”…R(”(•{))Ðê!ƒnÔ(Ô”…k(”(•{)) )*D‰ƒ}+‚ŠÂ‰)Ðì!…ç(ç”…˜(”(•{)Ðê!ƒ²Ô(Ô”…¯(”(•{))í`ÔÏ#bˆÞÂwˆÐî!„ŠŠÏyˆ`)ˆƒà`Vƒà‚áeÚÛ`\"8)ƒûÜÝ\"ˆÝÂxˆ‚ÏÞÂxˆhßU*…ï ˆðÂwˆÐî!… )D+‰„Ðñ!…TÂç(ç”…3(”(•{))Ðê!ƒOÔ(Ô”…L(”(•{)) )*D‰„ŠÂ2Ðó!…ŠÔ(Ô”…r(”(•{)ÂD2í`ÔÏ#bˆÞÂwˆÐô!…Š2*‰ƒ•6‚Ð7!ƒÀÔ(Ô”…«(”(•{)ç(ç”…»(”(•{)D‚ØÐø!…ØÔ(Ô”…Õ(”(•{)ÂD‰ƒâ9‚Ðú!ƒ\fÔ(Ô”…÷(”(•{)û(û”…(”(•{)D‚–Ðü!„<Ðý!ƒ<Ô(Ô”…'(”(•{)û(û”…7(”(•{)D‚–Ðþ!ƒfû(û”…Q(”(•{)ç(ç”…a(”(•{)D‚–Ðÿ!?…–Ð@!…–Ô(Ô”…„(”(•{)û(û”…”(”(•{)D‰…B‰ƒ¼ ƒ³ \\ \nB\n‚€ Ð]^_Q!…ëÔ(Ô”…Ù(”(•{)ç(ç”…é(”(•{)D‰ƒ| \n@\nA\n`ƒ Ša\f@\fA@ @ A@$ˆ)Ðb!ƒ 6‚h Ðc!ƒ( +‚h Ðd!ƒ4 9‚h Ð]^_Q!…h Ô(Ô”…Q (”(•{)ç(ç”…a (”(•{)D…h B‰ƒu  Z  ‚€  iZÏU„¶ ÂFGÏyˆF„œ åÂwˆH ˆiÏUƒ­ Gj‚´ IGÔ\"ˆ*ŠŠÏyˆ`)ˆƒÓ `VƒÓ ‚Ô eÚÛ`\"8)ƒî ÜÝ\"ˆÝÂxˆ‚ ÞÂxˆhßU*ƒ/ÔyÏUƒ/`\fWƒ/C D\\ZÏU„¶ D\\EFGÏyˆF„.\nåÂwˆH ˆiÏUƒ?\nGj‚F\nIGÔ\"ˆ*‚¶  bˆ\f‰“ˆ ‰“ˆefg\"ƒq\nh ‚€\ni…€\nÂjkl!.\n‡" [make-marker point-marker nil end-struct beg-struct struct cont ind-b ind-curr ind-lev block-list save-point end-region-mark end-region beg-region 0 looking-at "[ ]*[0-9]*\\(!\\|#\\|[ ]*$\\)" f90-indent-line no-update 1 pcont f90-previous-statement bol f90-cache-position beg-pnt 4 parse-partial-sexp search-backward "!" " " 38 single begin end middle error " 0-9" "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(do\\)\\>" 3 arg label "\\(\\sw+\\)[ ]*:" f90-do-indent "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(if\\)\\>" scan-lists "then\\>" f90-next-statement " 0-9&" "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(select\\)[ ]*case[ ]*(" command "\\(where\\|forall\\)[ ]*(" "\\(!\\|$\\)" f90-else-like-re f90-if-indent f90-type-def-re "\\(interface\\|block[ ]*data\\)\\>" f90-type-indent "\\(program\\)[ ]+\\(\\sw+\\)\\>" 2 "module[ ]*procedure\\>" "\\(module\\)[ ]+\\(\\sw+\\)\\>" "\\(recursive[ ]*\\)?\\(subroutine\\)[ ]+\\(\\sw+\\)" "end[ ]*function" ".*\\(function\\)[ ]+\\(\\sw+\\)" "contains[ ]*\\($\\|!\\)" f90-program-indent current-indentation f90-continuation-indent no-line-no no-line-number col delete-horizontal-space indent-to f90-leave-line-no "[0-9]" "[ ]*$" "[ ]*#" "!!!" f90-directive-comment-re regexp-quote f90-comment-region f90-indented-comment-re f90-calculate-indent comment-column eol "end" "\\(do\\|if\\|else\\|select[ ]*case\\|case\\|where\\|forall\\)\\>" "\\(program\\|module\\|interface\\|block[ ]*data\\)\\>" "\\(contains\\|\\sw+[ ]*:\\)" re-search-forward "\\(function\\|subroutine\\)" t "end[ ]*" f90-blocks-re "?\\([ ]+\\(\\sw+\\)\\)?\\>" f90-smart-end f90-block-match f90-end-if-re "end[ ]*do\\>" f90-end-type-re string-match "Xemacs" emacs-version zmacs-deactivate-region transient-mark-mode mark-active run-hooks deactivate-mark-hook] 11 (#$ . 38269) "*r"]) #@54 Properly indent the subprogram which contains point. (defalias 'f90-indent-subprogram #[nil "ŠÀ ‰ƒ,ÃÄ @Å A@Æ°!ˆÇ`È \"ˆÃÄ @Å A@É°!‚;ÃÊ!ˆÇ`È \"ˆÃË°!*‡" [nil program f90-mark-subprogram message "Indenting " " " "." f90-indent-region mark "...done." "Indenting the whole file." "Indenting the whole file...done."] 7 (#$ . 42908) nil]) #@64 Break line at point, insert continuation marker(s) and indent. (defalias 'f90-break-line #[(&optional no-update) "À\nƒ`\nVƒ\n‚eÄÅ `\"8)ƒ(ÆcˆÇ ˆÆcˆ‚í\nƒ6`\nVƒ6\n‚7eÈÅ `\"8)ƒ­É ˆŠÀŠÀˆ`)\n \nƒ_`\nVƒ_\n‚`eÈÅ `\"8)ƒžÌyˆÍÎ\n\"ˆ\nƒ‚`\nVƒ‚\n‚ƒeÄÅ `\"8)ƒ—ÍÎ\n\"ˆ‚t̔̕{  +Ç ˆ ÏPcˆ‚íÉ ˆÆcˆ„âÀ‰\n…àŠÌyˆ`)ŠÀˆ`)\n…àÓ\n#*ˆÇ ˆƒíÕcˆ)?…öÖ ‡" [nil ctype f90-cache-position beg-pnt 3 parse-partial-sexp "&" newline 4 delete-horizontal-space eol type 0 re-search-forward "[!]+" " " no-update bol f90-auto-keyword-case f90-change-keywords f90-beginning-ampersand "& " f90-indent-line] 4 (#$ . 43253) nil]) #@56 From fill-column, search backward for break-delimiter. (defalias 'f90-find-breakpoint #[nil "ŠÀyˆ`) \"ˆ\fƒ Å ˆÆ!?….Èu‚.Æ!ƒ,Éu‚.Èu)‡" [0 bol re-search-backward f90-break-delimiters f90-break-before-delimiters backward-char looking-at f90-no-break-re nil 2] 3 (#$ . 43906)]) #@215 Toggle f90-auto-fill mode. With ARG, turn `f90-auto-fill' mode on iff ARG is positive. In `f90-auto-fill' mode, inserting a space at a column beyond `fill-column' automatically breaks the line at a previous space. (defalias 'f90-auto-fill-mode #[(arg) "„ ?‚Â!ÃV…ĉÅ ˆ‡" [arg auto-fill-function prefix-numeric-value 0 f90-do-auto-fill force-mode-line-update] 2 (#$ . 44198) "P"]) #@56 Break line if non-white characters beyond fill-column. (defalias 'f90-do-auto-fill #[nil "ŠÀˆi) V…< !ˆÃÄ!ƒ4 ƒ#` Vƒ# ‚$eÇÈ`\"8)„4É ‡Ê ˆË ˆÀ‡" [nil fill-column move-to-column looking-at "[ ]*$" f90-cache-position beg-pnt 3 parse-partial-sexp delete-horizontal-space f90-find-breakpoint f90-break-line] 4 (#$ . 44592) nil]) #@61 Join present line with next line, if this line ends with &. (defalias 'f90-join-lines #[nil "À`ÀˆÃÀxˆhÄU…iÅÆ!ˆ`ÇyˆÃÀwˆÈÉ!ƒ(ÅÇ!ˆ\n`|ˆ\nƒ=`\nVƒ=\n‚>e ÌÍ `\"8)„QÎ ˆÏcˆƒeŠÀˆi)VƒeÒ ˆ bˆÓ*‡" [nil oldpos pos " " 38 delete-char -1 1 looking-at "&" f90-cache-position beg-pnt 3 parse-partial-sexp delete-horizontal-space " " auto-fill-function fill-column f90-do-auto-fill t] 4 (#$ . 44933) nil]) #@71 Fill every line in region by forward parsing. Join lines if possible. (defalias 'f90-fill-region #[(beg-region end-region) "À Á‰‰Â Á‰ \nÁ“ˆ bˆ ƒ¸Ì „!ŠÍyˆÎÁwˆi)\\ŠÁˆi)Vƒ¤Ñ!ˆÒÓ!ƒqƒ]`Vƒ]‚^eÖ×`\"8)„qØ ˆ‚5Ù ˆÚÛ!ˆÜÍyˆ„‹ÎÁwˆØ ˆiÍUƒšj‚Ÿßà\"ˆ*‚5`á !W…±àyÍU`‚\fÁâã$\"ƒÊå ‚Õ&…ÕÁ'èé!.‡" [make-marker nil t auto-fill-function af-function go-on indent f90-auto-keyword-case f90-smart-end end-region-mark end-region beg-region f90-join-lines 0 " 0-9" f90-continuation-indent fill-column move-to-column looking-at "[ ]*$" f90-cache-position beg-pnt 3 parse-partial-sexp delete-horizontal-space f90-find-breakpoint f90-break-line no-update no-line-no no-line-number col indent-to 1 marker-position string-match "XEmacs" emacs-version zmacs-deactivate-region transient-mark-mode mark-active run-hooks deactivate-mark-hook] 8 (#$ . 45350) "*r"]) #@102 Match end-struct with beg-struct and complete end-block if possible. Leave point at the end of line. (defalias 'f90-block-match #[(beg-block beg-name end-block end-name) "ÀÁŠÂˆ`)\"ˆÃć" [search-forward "end" nil no-match (byte-code " ‰…\n —\n…\n—‰\f,š„; ƒ.ÆÇ #ˆÈˆÉÊÈ\"ˆ‚?ÆË\"ˆÌPcˆ‚?Í !ˆ‰…K —\n…Q\n—‰\f,š„®ƒs„sÆË\"ˆÌPcˆ‚¸ƒ’ƒ’ÆÐ#ˆÍ!ˆÑ!ˆ‚¸„¸ƒ¸ÆÒ\"ˆÍ!ˆÑÓ!ˆ‚¸ƒ¸Í!ˆÔÕ!?…ÁÖ ‡" [beg-block end-block b a b-local a-local message "END %s does not match %s." nil throw no-match "Inserting %s." " " search-forward beg-name end-name "Replacing %s with %s." replace-match "Deleting %s." "" looking-at "[ ]*!" delete-horizontal-space] 5)] 3 (#$ . 46259)]) #@71 From an end foo statement, find the corresponding foo including name. (defalias 'f90-match-end #[nil "ÀÁ Â`ɉ‰‰ \n \f ŠÎyˆÏÂwˆÐÑÓQ!…PÀÀ”…>”•{)ÕÕ”…N”•{)D‰)…l\f@\fA@ŠÎyˆ ÎU„éÖ×ØQÂÃ#ƒéÎyˆÏÂwˆÐÙ!ƒ¸ÂÕÕ”…’”•{)ÐÜ!ƒ¯ÀÀ”…¬”•{)*D†ÅŠÂ‰ÐÝ!…UÕÕ”…Ô”•{)ÐÜ!ƒïÀÀ”…씕{)Þ`ÀÎ#bˆßÂwˆÐà!„PŠŠÎyˆ`)!ˆ\"ƒ`\"Vƒ\"‚e#äå#`\"8)ƒ8æç!\"ˆçÂxˆ‚\fßÂxˆhèU*…Ué ˆêÂwˆÐà!…UD+†ÅŠÂ+Ðì!…ŠÀÀ”…r”•{)ÂD+Þ`ÀÎ#bˆßÂwˆÐí!…Š+*†ÅÐî!ƒÊÂÕÕ”…¤”•{)ÐÜ!ƒÁÀÀ”…¾”•{)*D†ÅÐ/!ƒõÀÀ”…à”•{)ÕÕ”…ð”•{)D‚ Ðð!ƒÀÀ”…\n”•{)ÂD†ÅÐñ!ƒ:ÀÀ”…%”•{)òò”…5”•{)D‚ÁÐó!„jÐô!ƒjÀÀ”…U”•{)òò”…e”•{)D‚ÁÐõ!ƒ”òò”…”•{)ÕÕ”…”•{)D‚ÁÐö!„ÄÐ÷!ƒÄÀÀ”…¯”•{)òò”…¿”•{)D†Å‰ ƒÕ ÀZ‰ ‚dÐÑøQ!ƒb À\\‰ ‚d ÎU„öùú!‚k‰;!<…ŠÎyˆ`)!ŠÂˆ`);<…ý<!;#*ˆ>ÿ=ƒN`\fWƒHù@A BÎyˆ`ˆ`{R!ˆ‚NCÀ!ˆ @ A@\nbˆÎyˆD $).\n‡" [1 window-start nil t end-struct end-block beg-block end-name beg-name case-fold-search end-point matching-beg top-of-window count 0 " 0-9" looking-at "end[ ]*" f90-blocks-re "?\\([ ]+\\(\\sw+\\)\\)?\\>" arg 3 re-search-backward "\\(" "\\)" "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(do\\)\\>" struct label "\\(\\sw+\\)[ ]*:" "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(if\\)\\>" scan-lists " " "then\\>" bol f90-cache-position beg-pnt 4 parse-partial-sexp search-backward "!" 38 f90-next-statement " 0-9&" command "\\(where\\|forall\\)[ ]*(" "\\(!\\|$\\)" "\\(\\(\\sw+\\)[ ]*:\\)?[ ]*\\(select\\)[ ]*case[ ]*(" f90-type-def-re "\\(interface\\|block[ ]*data\\)\\>" "\\(program\\)[ ]+\\(\\sw+\\)\\>" 2 "module[ ]*procedure\\>" "\\(module\\)[ ]+\\(\\sw+\\)\\>" "\\(recursive[ ]*\\)?\\(subroutine\\)[ ]+\\(\\sw+\\)" "end[ ]*function" ".*\\(function\\)[ ]+\\(\\sw+\\)" "\\b" message "No matching beginning." eol f90-auto-keyword-case f90-change-keywords f90-smart-end blink "Matches " what-line ": " sit-for f90-block-match] 11 (#$ . 46978) nil]) #@72 Inserts an complete end statement matching beginning of present block. (defalias 'f90-insert-end #[nil "ƒ‚ ÁÂcˆÃ )‡" [f90-smart-end blink "end" f90-indent-new-line] 1 (#$ . 49022) nil]) #@107 Typing `\[help-command] or `? lists all the F90 abbrevs. Any other key combination is executed normally. (defalias 'f90-abbrev-start #[nil "À‰ cˆÄ ÅÆ\"ƒÈ\n!‚É ‰ÊU„(  =ƒ-Ì ‚AÅÆ\"ƒ<\n‰ ‚A C‰*‡" [nil c e last-command-char next-command-event string-match "XEmacs" emacs-version event-to-character read-event 63 help-char f90-abbrev-help unread-command-event unread-command-events] 4 (#$ . 49221) nil]) #@49 List the currently defined abbrevs in F90 mode. (defalias 'f90-abbrev-help #[nil "ÀÁ!ˆÂà !ˆÀÄ!‡" [message "Listing abbrev table..." display-buffer f90-prepare-abbrev-list-buffer "Listing abbrev table...done"] 2 (#$ . 49647) nil]) (defalias 'f90-prepare-abbrev-list-buffer #[nil "ŠÀÁ!qˆÂ ˆÃÄÅ\"ˆebˆÆÇ!ˆÈ ˆ)ÀÁ!‡" [get-buffer-create "*Abbrevs*" erase-buffer insert-abbrev-table-description f90-mode-abbrev-table t set-buffer-modified-p nil edit-abbrevs-mode] 3]) #@40 Upcase all F90 keywords in the buffer. (defalias 'f90-upcase-keywords #[nil "ÀÁ!‡" [f90-change-keywords upcase-word] 2 (#$ . 50113) nil]) #@44 Capitalize all F90 keywords in the buffer. (defalias 'f90-capitalize-keywords #[nil "ÀÁ!‡" [f90-change-keywords capitalize-word] 2 (#$ . 50257) nil]) #@42 Downcase all F90 keywords in the buffer. (defalias 'f90-downcase-keywords #[nil "ÀÁ!‡" [f90-change-keywords downcase-word] 2 (#$ . 50413) nil]) #@40 Upcase all F90 keywords in the region. (defalias 'f90-upcase-region-keywords #[(beg end) "ÀÁ\n #‡" [f90-change-keywords upcase-word beg end] 4 (#$ . 50563) "*r"]) #@44 Capitalize all F90 keywords in the region. (defalias 'f90-capitalize-region-keywords #[(beg end) "ÀÁ\n #‡" [f90-change-keywords capitalize-word beg end] 4 (#$ . 50732) "*r"]) #@42 Downcase all F90 keywords in the region. (defalias 'f90-downcase-region-keywords #[(beg end) "ÀÁ\n #‡" [f90-change-keywords downcase-word beg end] 4 (#$ . 50913) "*r"]) (defalias 'f90-change-keywords #[(change-word &optional beg end) "Šƒ ‚\ne ƒ ‚dÂ Ä ÄÄÈ° eÉÊ É‰ \f bˆÑŽÒ Ó#…ŽÔ`\"Õ8„9Ö8„9Š×yˆØÉwˆÙÚ!)„9`ŠÛÜ!ˆ`)‰ {\fÞ!ˆ\f {˜„9Ó ‚9.‡" [beg end "\\(" f90-keywords-re "\\|" f90-procedures-re f90-hpf-keywords-re f90-operators-re "\\)" nil buffer-modified-p back-point saveword modified state ref-point keyword-re ((byte-code "„ÁÂ!ˆÂ‡" [modified set-buffer-modified-p nil] 2)) re-search-forward t parse-partial-sexp 3 4 0 " 0-9" looking-at "#" backward-word 1 change-word -1] 10]) (provide (quote f90)) emacs-19.30/lisp/facemenu.elc100666 12120 1 37241 6051027010 14343 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 00:00:43 1995 ;;; from file /home/fsf/rms/e19/lisp/facemenu.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`facemenu.el' was compiled for Emacs 19.29 or later")) (provide (quote facemenu)) #@42 Prefix key to use for facemenu commands. (defvar facemenu-key "ç" (#$ . 503)) #@591 Alist of interesting faces and keybindings. Each element is itself a list: the car is the name of the face, the next element is the key to use as a keyboard equivalent of the menu item; the binding is made in facemenu-keymap. The faces specifically mentioned in this list are put at the top of the menu, in the order specified. All other faces which are defined, except for those in `facemenu-unlisted-faces', are listed after them, but get no keyboard equivalents. If you change this variable after loading facemenu.el, you will need to call `facemenu-update' to make it take effect. (defvar facemenu-keybindings (quote ((default . "d") (bold . "b") (italic . "i") (bold-italic . "l") (underline . "u"))) (#$ . 588)) #@154 Where in the menu to insert newly-created faces. This should be nil to put them at the top of the menu, or t to put them just before "Other" at the end. (defvar facemenu-new-faces-at-end t (#$ . 1318)) #@513 List of faces not to include in the Face menu. You can set this list before loading facemenu.el, or add a face to it before creating that face if you do not want it to be listed. If you change the variable so as to eliminate faces that have already been added to the menu, call `facemenu-update' to recalculate the menu contents. If this variable is t, no faces will be added to the menu. This is useful for temporarily turning off the feature that automatically adds faces to the menu when they are created. (defvar facemenu-unlisted-faces (quote (modeline region secondary-selection highlight scratch-face)) (#$ . 1527)) #@24 Menu keymap for faces. (defvar facemenu-face-menu (byte-code "ÀÁ!Ã\nÄÅÆB#ˆ\n)‡" [make-sparse-keymap "Face" map define-key "o" "Other..." facemenu-set-face] 5) (#$ . 2159)) (defalias (quote facemenu-face-menu) facemenu-face-menu) #@36 Menu keymap for foreground colors. (defvar facemenu-foreground-menu (byte-code "ÀÁ!Ã\nÄÅÆB#ˆ\n)‡" [make-sparse-keymap "Foreground Color" map define-key "o" "Other..." facemenu-set-foreground] 5) (#$ . 2395)) (defalias (quote facemenu-foreground-menu) facemenu-foreground-menu) #@35 Menu keymap for background colors (defvar facemenu-background-menu (byte-code "ÀÁ!Ã\nÄÅÆB#ˆ\n)‡" [make-sparse-keymap "Background Color" map define-key "o" "Other..." facemenu-set-background] 5) (#$ . 2679)) (defalias (quote facemenu-background-menu) facemenu-background-menu) #@43 Menu keymap for non-face text-properties. (defvar facemenu-special-menu (byte-code "ÀÁ!Ã\nÄÅÆB#ˆÃ\nÇÈÉB#ˆÃ\nÊËÌB#ˆÃ\nÍÎÏB#ˆ\n)‡" [make-sparse-keymap "Special" map define-key [115] "Remove Special" facemenu-remove-special [116] "Intangible" facemenu-set-intangible [118] "Invisible" facemenu-set-invisible [114] "Read-Only" facemenu-set-read-only] 5) (#$ . 2962)) (defalias (quote facemenu-special-menu) facemenu-special-menu) #@42 Submenu for text justification commands. (defvar facemenu-justification-menu (byte-code "ÀÁ!Ã\nÄÅÆB#ˆÃ\nÇÈÉB#ˆÃ\nÊËÌB#ˆÃ\nÍÎÏB#ˆÃ\nÐÑÒB#ˆ\n)‡" [make-sparse-keymap "Justification" map define-key [99] "Center" set-justification-center [98] "Full" set-justification-full [114] "Right" set-justification-right [108] "Left" set-justification-left [117] "Unfilled" set-justification-none] 5) (#$ . 3395)) (defalias (quote facemenu-justification-menu) facemenu-justification-menu) #@35 Submenu for indentation commands. (defvar facemenu-indentation-menu (byte-code "ÀÁ!Ã\nÄÅÆB#ˆÃ\nÇÈÉB#ˆÃ\nÊËÌB#ˆÃ\nÍÎÏB#ˆ\n)‡" [make-sparse-keymap "Indentation" map define-key [decrease-right-margin] "Indent Right Less" decrease-right-margin [increase-right-margin] "Indent Right More" increase-right-margin [decrease-left-margin] "Indent Less" decrease-left-margin [increase-left-margin] "Indent More" increase-left-margin] 5) (#$ . 3876)) (defalias (quote facemenu-indentation-menu) facemenu-indentation-menu) #@33 Facemenu top-level menu keymap. (defvar facemenu-menu nil (#$ . 4393)) (byte-code "ÀÁ!‰Ä ÅÆÇB#ˆÄ ÈÉÊB#ˆÄ ËÌÍB#ˆÄ ÎÏÐB#ˆÄ ÑÒÓB#ˆÄ ÔÕC#ˆ)\nÄ Ö×ØB#ˆÄ ÙÚÛB#ˆÄ ÜÕC#ˆÄ ÝÞßB#ˆÄ àáâB#ˆÄ ãäåB#ˆÄ æçèB#ˆ)éÂ\n\"‡" [make-sparse-keymap "Text Properties" facemenu-menu map define-key [dc] "Display Colors" list-colors-display [df] "Display Faces" list-faces-display [dp] "List Properties" list-text-properties-at [ra] "Remove All" facemenu-remove-all [rm] "Remove Properties" facemenu-remove-props [s1] "-----------------" [in] "Indentation" facemenu-indentation-menu [ju] "Justification" facemenu-justification-menu [s2] [sp] "Special Properties" facemenu-special-menu [bg] "Background Color" facemenu-background-menu [fg] "Foreground Color" facemenu-foreground-menu [fc] "Face" facemenu-face-menu defalias] 6) #@137 Keymap for face-changing commands. `Facemenu-update' fills in the keymap according to the bindings requested in `facemenu-keybindings'. (defvar facemenu-keymap (byte-code "ÀÁ!Ã\nÄÅÆB#ˆ\n)‡" [make-sparse-keymap "Set face" map define-key "o" "Other..." facemenu-set-face] 5) (#$ . 5200)) (defalias (quote facemenu-keymap) facemenu-keymap) #@83 Alist of colors, used for completion. If null, `facemenu-read-color' will set it. (defvar facemenu-color-alist nil (#$ . 5544)) #@138 Add or update the "Face" menu in the menu bar. You can call this to update things if you change any of the menu configuration variables. (defalias 'facemenu-update #[nil "À ÂÃ#ˆ\fƒÀ \fÅ#ˆÆÇÈ !\"‡" [define-key global-map [C-down-mouse-2] facemenu-menu facemenu-key facemenu-keymap facemenu-iterate facemenu-add-new-face facemenu-complete-face-list facemenu-keybindings] 4 (#$ . 5679) nil]) #@524 Add FACE to the region or next character typed. It will be added to the top of the face list; any faces lower on the list that will not show through at all will be removed. Interactively, the face to be used is read with the minibuffer. If the region is active and there is no prefix argument, this command sets the region to the requested face. Otherwise, this command specifies the face for the next character inserted. Moving point or switching buffers before typing a character to insert cancels the specification. (defalias 'facemenu-set-face #[(face &optional start end) "À ˆÁ\n!ˆ ƒ'\f„' †Æ †È É\n #*‡Ê\n!‡" [barf-if-buffer-read-only facemenu-add-new-face face mark-active current-prefix-arg start region-beginning end region-end facemenu-add-face facemenu-self-insert-face] 4 (#$ . 6078) (list (read-face-name "Use face: "))]) #@437 Set the foreground color of the region or next character typed. The color is prompted for. A face named `fg:color' is used (or created). If the region is active, it will be set to the requested face. If it is inactive (even if mark-even-if-inactive is set) the next character that is typed (via `self-insert-command') will be set to the selected face. Moving point or switching buffers before typing a character cancels the request. (defalias 'facemenu-set-foreground #[(color &optional start end) "ÀÁ\nP!Ä !„ÅÆ\n\"ˆÇ  #)‡" [intern "fg:" color face facemenu-get-face error "Unknown color: %s" facemenu-set-face start end] 4 (#$ . 6936) (list (facemenu-read-color "Foreground color: "))]) #@437 Set the background color of the region or next character typed. The color is prompted for. A face named `bg:color' is used (or created). If the region is active, it will be set to the requested face. If it is inactive (even if mark-even-if-inactive is set) the next character that is typed (via `self-insert-command') will be set to the selected face. Moving point or switching buffers before typing a character cancels the request. (defalias 'facemenu-set-background #[(color &optional start end) "ÀÁ\nP!Ä !„ÅÆ\n\"ˆÇ  #)‡" [intern "bg:" color face facemenu-get-face error "Unknown color: %s" facemenu-set-face start end] 4 (#$ . 7640) (list (facemenu-read-color "Background color: "))]) #@431 Set the face of the region or next character typed. This function is designed to be called from a menu; the face to use is the menu item's name. If the region is active and there is no prefix argument, this command sets the region to the requested face. Otherwise, this command specifies the face for the next character inserted. Moving point or switching buffers before typing a character to insert cancels the specification. (defalias 'facemenu-set-face-from-menu #[(face start end) "À ˆÁ\n!ˆ ƒÄ\n #‡Æ\n!‡" [barf-if-buffer-read-only facemenu-get-face face start facemenu-add-face end facemenu-self-insert-face] 4 (#$ . 8344) (list last-command-event (if (and mark-active (not current-prefix-arg)) (region-beginning)) (if (and mark-active (not current-prefix-arg)) (region-end)))]) (defalias 'facemenu-self-insert-face #[(face) " =ƒ\n <ƒ ‚ CB‚\n\f‰‡" [last-command self-insert-face-command face self-insert-face this-command] 2]) #@118 Make the region invisible. This sets the `invisible' text property; it can be undone with `facemenu-remove-special'. (defalias 'facemenu-set-invisible #[(start end) "À \nÃÄ$‡" [put-text-property start end invisible t] 5 (#$ . 9299) "r"]) #@145 Make the region intangible: disallow moving into it. This sets the `intangible' text property; it can be undone with `facemenu-remove-special'. (defalias 'facemenu-set-intangible #[(start end) "À \nÃÄ$‡" [put-text-property start end intangible t] 5 (#$ . 9544) "r"]) #@121 Make the region unmodifiable. This sets the `read-only' text property; it can be undone with `facemenu-remove-special'. (defalias 'facemenu-set-read-only #[(start end) "À \nÃÄ$‡" [put-text-property start end read-only t] 5 (#$ . 9818) "r"]) #@59 Remove all text properties that facemenu added to region. (defalias 'facemenu-remove-props #[(start end) "À \fÅ#)‡" [t inhibit-read-only remove-text-properties start end (face nil invisible nil intangible nil read-only nil category nil)] 4 (#$ . 10065) "*r"]) #@45 Remove all text properties from the region. (defalias 'facemenu-remove-all #[(start end) "À \fÅ#)‡" [t inhibit-read-only set-text-properties start end nil] 4 (#$ . 10333) "*r"]) #@135 Remove all the "special" text properties from the region. These special properties include `invisible', `intangible' and `read-only'. (defalias 'facemenu-remove-special #[(start end) "À \fÅ#)‡" [t inhibit-read-only remove-text-properties start end (invisible nil intangible nil read-only nil)] 4 (#$ . 10520) "*r"]) #@54 Pop up a buffer listing text-properties at LOCATION. (defalias 'list-text-properties-at #[(p) "À !‰„ÃÄ!‚0ÅÆÇÈ \"!ˆ\n…/ÆÇÉ\n@\nA@#!ˆ\nAA‰„Ê‘)‡" [text-properties-at p props message "None" "*Text Properties*" princ format "Text properties at %d:\n\n" "%-20s %S\n" nil] 7 (#$ . 10844) "d"]) #@36 Read a color using the minibuffer. (defalias 'facemenu-read-color #[(&optional prompt) "À † †\fÅ=„\fÆ=…ÇÈÉ \"ÊË$‰\fÍš?…)\f)‡" [completing-read prompt "Color: " facemenu-color-alist window-system x win32 mapcar list x-defined-colors nil t col ""] 6 (#$ . 11146)]) #@236 Display names of defined colors, and show what they look like. If the optional argument LIST is non-nil, it should be a list of colors to display. Otherwise, this command computes a list of colors that the current display can handle. (defalias 'list-colors-display #[(&optional list) "„5 Â=„ Ã=ƒ5Ä ‰ Aƒ4Æ @ A@\"ƒ- ‰AA¡ˆ‚ A‰‚)ÇŠqˆÉÊ \f…€` @cˆÍjˆÎ `ÏÐÑÒ@P!!$ˆ` Ó@Ô±ˆÎ `ÏÐÑÕ@P!!$ˆA‰„FÊ+‘‡" [list window-system x win32 x-defined-colors l facemenu-color-equal "*Colors*" standard-output t nil s facemenu-unlisted-faces 20 put-text-property face facemenu-get-face intern "bg:" " " "\n" "fg:"] 10 (#$ . 11428) nil]) #@257 Return t if colors A and B are the same color. A and B should be strings naming colors. This function queries the window-system server to find out what the color names mean. It returns nil if the colors differ or if it can't determine the correct answer. (defalias 'facemenu-color-equal #[(a b) " šƒ‡ Ä=„ Å=…Æ!Æ !š‡" [a b t window-system x win32 x-color-values] 3 (#$ . 12079)]) #@380 Add FACE to text between START and END. For each section of that region that has a different face property, FACE will be consed onto it, and other faces that are completely hidden by that will be removed from the list. As a special case, if FACE is `default', then the region is left with NO face text property. Otherwise, selecting the default face would not have any effect. (defalias 'facemenu-add-face #[(face start end) "Á=ƒ\f \fÅ#‡ Ɖ\fU?…UÉÀÆ\f$ÊÀ\" ÌÀ „8‚JÍ <ƒE ‚H CB!$ˆ)‰‚*‡" [face default remove-text-properties start end (face default) nil part-end part-start next-single-property-change get-text-property prev put-text-property facemenu-active-faces] 8 (#$ . 12475) "*xFace:\nr"]) #@363 Return from FACE-LIST those faces that would be used for display. This means each face attribute is not specified in a face earlier in FACE-LIST and such a face is therefore active when used to display text. If the optional argument FRAME is given, use the faces in that frame; otherwise use the selected frame. If t, then the global, non-frame faces are used. (defalias 'facemenu-active-faces #[(face-list &optional frame) "ÀÁ\n@ \"!\n@C\nA\fG\nƒ]Á\n@ \"Ç \n S‰ ËVƒK\n Hƒ%\f H„%\f ̉Iˆ‚%+ƒV\n@ B\nA‰„ Ÿ,‡" [copy-sequence internal-get-face face-list frame mask-atts active-list mask-len nil useful i face-atts 1 t] 5 (#$ . 13212)]) #@276 Make sure FACE exists. If not, it is created. If it is created and is of the form `fg:color', then set the foreground to that color. If of the form `bg:color', set the background. In any case, add it to the appropriate menu. Returns the face, or nil if given a bad color. (defalias 'facemenu-get-face #[(symbol) "À !„] !Ä !‰ÆÇOÉÊ \"ƒ6Ë \"ˆ\fÍ=„/\fÎ=…YÏ!‚YÉÐ \"ƒXÑ \"ˆ\fÍ=„Q\fÎ=…YÏ!‚YÒ+…^ ‡" [internal-find-face symbol make-face face symbol-name name 3 nil color string-match "^fg:" set-face-foreground window-system x win32 x-color-defined-p "^bg:" set-face-background t] 4 (#$ . 13883)]) #@91 Add a FACE to the appropriate Face menu. Automatically called when a new face is created. (defalias 'facemenu-add-new-face #[(face) "À !ÃÄ\n\"ƒ\nÅÆOÇ‚%ÃÈ\n\"ƒ$\nÅÆOÉ‚%Ê Ì  \"AÆÆÒ=„¹ >„¹ƒsÓÔ\nP!‰ÕÆÖ×Ø DDFMˆÙÚ\nB#ˆÙ \nB#ˆ‚¹ÛÜ KA\"„¹Ý !Þ Kƒ®GÅVƒ®à\nBGÅZ8@$ˆ‚¹Ù \nB#ˆ-Ƈ" [symbol-name face name string-match "^fg:" 3 nil facemenu-foreground-menu "^bg:" facemenu-background-menu facemenu-face-menu menu assoc facemenu-keybindings key function menu-val facemenu-unlisted-faces t intern "facemenu-set-" lambda (interactive) facemenu-set-face quote define-key facemenu-keymap facemenu-iterate #[(m) "<…@9…Á@\n\"‡" [m face-equal face] 3] vector facemenu-set-face-from-menu facemenu-new-faces-at-end define-key-after] 8 (#$ . 14508)]) #@255 Return list of all faces that are look different. Starts with given ALIST of faces, and adds elements only if they display differently from any face already on the list. The faces on ALIST will end up at the end of the returned list, in reverse order. (defalias 'facemenu-complete-face-list #[(&optional oldlist) "ÀÁ\n\"ŸÄÅÆ Ÿ\"ˆ )‡" [mapcar car oldlist list facemenu-iterate #[(new-face) " >„\n B‡" [new-face list nil] 2] face-list] 3 (#$ . 15315)]) #@123 Apply FUNC to each element of LIST until one returns non-nil. Returns the non-nil value it found, or nil if all were nil. (defalias 'facemenu-iterate #[(func iterate-list) "ƒ @!„A‰„@‡" [iterate-list func] 3 (#$ . 15781)]) (facemenu-update) emacs-19.30/lisp/faces.elc100666 12120 1 71305 6054600701 13647 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 22 05:54:55 1995 ;;; from file /home/fsf/rms/e19/lisp/faces.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`faces.el' was compiled for Emacs 19.29 or later")) (defalias 'internal-facep #[(x) "À !… GÂU… ÃHÄ=‡" [vectorp x 8 0 face] 2]) (put (quote internal-facep) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@58 Return t if X is a face name or an internal face vector. (defalias 'facep #[(x) "Á!…GÂU…ÃHÄ=)„#9…$ ž…$Ƈ" [x vectorp 8 0 face global-face-data t] 2 (#$ . 634)]) (defalias 'internal-check-face '(macro . #[(face) "ÀÁ\nDÃÄÅÆ\nEEE‡" [or internal-facep face signal (quote wrong-type-argument) list (quote internal-facep)] 7])) #@31 Return the name of face FACE. (defalias 'face-name #[(face) "À !ÂH‡" [internal-get-face face 1] 2 (#$ . 976)]) #@45 Return the internal ID number of face FACE. (defalias 'face-id #[(face) "À !ÂH‡" [internal-get-face face 2] 2 (#$ . 1093)]) #@367 Return the font name of face FACE, or nil if it is unspecified. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). The font default for a face is either nil, or a list of the form (bold), (italic) or (bold italic). If FRAME is omitted or nil, use the selected frame. (defalias 'face-font #[(face &optional frame) "À \n\"ÃH‡" [internal-get-face face frame 3] 3 (#$ . 1224)]) #@269 Return the foreground color name of face FACE, or nil if unspecified. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame. (defalias 'face-foreground #[(face &optional frame) "À \n\"ÃH‡" [internal-get-face face frame 4] 3 (#$ . 1704)]) #@269 Return the background color name of face FACE, or nil if unspecified. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame. (defalias 'face-background #[(face &optional frame) "À \n\"ÃH‡" [internal-get-face face frame 5] 3 (#$ . 2092)]) #@267 Return the stipple pixmap name of face FACE, or nil if unspecified. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame. (defalias 'face-stipple #[(face &optional frame) "À \n\"ÃH‡" [internal-get-face face frame 6] 3 (#$ . 2480)]) (defalias (quote face-background-pixmap) (quote face-stipple)) #@236 Return t if face FACE is underlined. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame. (defalias 'face-underline-p #[(face &optional frame) "À \n\"ÃH‡" [internal-get-face face frame 7] 3 (#$ . 2926)]) #@150 Change the font of face FACE to FONT (a string). If the optional FRAME argument is provided, change only in that frame; otherwise change each frame. (defalias 'set-face-font #[(face font &optional frame) ";ƒ Á #Ä ÀÆ %‡" [font x-resolve-font-name default frame internal-set-face-1 face 3] 6 (#$ . 3282) (internal-face-interactive "font")]) #@163 Change the foreground color of face FACE to COLOR (a string). If the optional FRAME argument is provided, change only in that frame; otherwise change each frame. (defalias 'set-face-foreground #[(face color &optional frame) "À Â Ä %‡" [internal-set-face-1 face foreground color 4 frame] 6 (#$ . 3634) (internal-face-interactive "foreground")]) #@223 Default stipple pattern used on monochrome displays. This stipple pattern is used on monochrome displays instead of shades of gray for a face background color. See `set-face-stipple' for possible values for this variable. (defvar face-default-stipple "gray3" (#$ . 3985)) #@130 Return t if COLOR is a shade of gray (or white or black). FRAME specifies the frame and thus the display for interpreting COLOR. (defalias 'face-color-gray-p #[(color &optional frame) "À \n\"‰@ A@Æ 8È\f Z!ÉÈ\f!]È !]Ê¥W…NÈ Z!ÉÈ !]È!]Ê¥W…NÈ\fZ!ÉÈ!]È\f!]Ê¥W,‡" [x-color-values color frame values r g 2 b abs 1 20] 5 (#$ . 4264)]) #@163 Change the background color of face FACE to COLOR (a string). If the optional FRAME argument is provided, change only in that frame; otherwise change each frame. (defalias 'set-face-background #[(face color &optional frame) "ƒÁ=„\nƒÃ\nÄ#„Å#‡„HÈ ‰ ƒ>ÊË!\n @#ˆ A‰ „*Ê\nÁ#ˆ\n)‡ÌÍ\nÎ%‡" [frame t color face-color-supported-p nil set-face-stipple face face-default-stipple frame-list frames set-face-background face-name internal-set-face-1 background 5] 7 (#$ . 4613) (internal-face-interactive "background")]) #@467 Change the stipple pixmap of face FACE to PIXMAP. PIXMAP should be a string, the name of a file of pixmap data. The directories listed in the `x-bitmap-file-path' variable are searched. Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is a string, containing the raw bits of the bitmap. If the optional FRAME argument is provided, change only in that frame; otherwise change each frame. (defalias 'set-face-stipple #[(face pixmap &optional frame) "À Â Ä %‡" [internal-set-face-1 face background-pixmap pixmap 6 frame] 6 (#$ . 5158) (internal-face-interactive "stipple")]) (defalias (quote set-face-background-pixmap) (quote set-face-stipple)) #@176 Specify whether face FACE is underlined. (Yes if UNDERLINE-P is non-nil.) If the optional FRAME argument is provided, change only in that frame; otherwise change each frame. (defalias 'set-face-underline-p #[(face underline-p &optional frame) "À Â Ä %‡" [internal-set-face-1 face underline underline-p 7 frame] 6 (#$ . 5887) (internal-face-interactive "underline-p" "underlined")]) (defalias 'modify-face-read-string #[(face default name alist) "À ƒÂÃ\f —$‚ÂÆ\f #\"‰Éšƒ#Ê‚0Ëšƒ. ‚0)‡" [completing-read default format "Set face %s %s (default %s): " face name "Set face %s %s: " alist value "none" nil ""] 7]) #@357 Change the display attributes for face FACE. FOREGROUND and BACKGROUND should be color strings or nil. STIPPLE should be a stipple pattern name or nil. BOLD-P, ITALIC-P, and UNDERLINE-P specify whether the face should be set bold, in italic, and underlined, respectively. (Yes if non-nil.) If called interactively, prompts for a face and face attributes. (defalias 'modify-face #[(face foreground background stipple bold-p italic-p underline-p) "ÀÁˆÀÃĈÀÅƈƒÈ‚É\nÀË#ˆ\fƒ(Í‚)Î\nÀË#ˆÏ\n\"ˆt…<Ñ ‡" [nil (set-face-foreground face foreground) ((error)) (set-face-background face background) ((error)) (set-face-stipple face stipple) ((error)) bold-p make-face-bold make-face-unbold face t italic-p make-face-italic make-face-unitalic set-face-underline-p underline-p redraw-display] 4 (#$ . 6520) (let* ((completion-ignore-case t) (face (symbol-name (read-face-name "Modify face: "))) (colors (mapcar (quote list) x-colors)) (stipples (mapcar (quote list) (apply (quote nconc) (mapcar (quote directory-files) x-bitmap-file-path)))) (foreground (modify-face-read-string face (face-foreground (intern face)) "foreground" colors)) (background (modify-face-read-string face (face-background (intern face)) "background" colors)) (stipple (modify-face-read-string face (face-stipple (intern face)) "stipple" stipples)) (bold-p (y-or-n-p (concat "Set face " face " bold "))) (italic-p (y-or-n-p (concat "Set face " face " italic "))) (underline-p (y-or-n-p (concat "Set face " face " underline ")))) (message "Face %s: %s" face (mapconcat (quote identity) (delq nil (list (and foreground (concat (downcase foreground) " foreground")) (and background (concat (downcase background) " background")) (and stipple (concat (downcase stipple) " stipple")) (and bold-p "bold") (and italic-p "italic") (and underline-p "underline"))) ", ")) (list (intern face) foreground background stipple bold-p italic-p underline-p))]) #@200 Internal data for face support functions. Not for external use. This is an alist associating face names with the default values for their parameters. Newly created frames get their data from here. (defvar global-face-data nil (#$ . 8449)) #@43 Returns a list of all defined face names. (defalias 'face-list #[nil "ÀÁ\n\"‡" [mapcar car global-face-data] 3 (#$ . 8696)]) #@310 Retrieve the face named NAME. Return nil if there is no such face. If the optional argument FRAME is given, this gets the face NAME for that frame; otherwise, it uses the selected frame. If FRAME is the symbol t, then the global, non-frame face is returned. If NAME is already a face, it is simply returned. (defalias 'internal-find-face #[(name &optional frame) "Á=ƒ\n9„Ã\n!\n9ƒ*\nÁ=ƒ\f‚'ņ&Æ !žA‡Ç\n!„7ÈÉÇ\nD\"ˆ\n‡" [frame t name face-name global-face-data frame-face-alist selected-frame internal-facep signal wrong-type-argument] 4 (#$ . 8828)]) #@296 Retrieve the face named NAME; error if there is none. If the optional argument FRAME is given, this gets the face NAME for that frame; otherwise, it uses the selected frame. If FRAME is the symbol t, then the global, non-frame face is returned. If NAME is already a face, it is simply returned. (defalias 'internal-get-face #[(name &optional frame) "À \n\"†% Ä !… GÅU… ÆHÇ=)†%ÈÉÊ D\"‡" [internal-find-face name frame x vectorp 8 0 face signal wrong-type-argument internal-facep] 4 (#$ . 9400)]) (defalias 'internal-set-face-1 #[(face name value index frame) "À\n„Aà ‰ƒ#ÅÆ! \n\f@%ˆ\fA‰„ Ë9ƒ/‚3Æ!À\"\n Iˆ )‚]\nÀ=„SÌÍ! \n$ˆË\n\"\n I)‡" [t inhibit-quit frame frame-list frames internal-set-face-1 face-name face name value index internal-get-face set-face-attribute-internal face-id] 7]) (defalias 'read-face-name #[(prompt) "ÀÀGÂUƒÃ\fÅÆÇ \"ÀÈ$‰‚É !)‡" [nil face 0 completing-read prompt mapcar #[(x) "À !C‡" [symbol-name x] 2] face-list t intern] 6]) (defalias 'internal-face-interactive #[(what &optional bool) "ÀÁ\nP!Ä\nÅQÇÈP! Ê !…(  Ë \"†( ÌË \"\f ƒ?ÎÏÐ !Ñ Ò°!‚LÓÔÐ !ÕR\f\" ך?…Z-D‡" [intern "face-" what fn "Set " " of face" prompt read-face-name ": " face fboundp selected-frame default bool y-or-n-p "Should face " symbol-name " be " "? " read-string " " " to: " value ""] 6]) #@161 Define a new FACE on all frames. You can modify the font, color, etc of this face with the set-face- functions. If the face already exists, it is unmodified. (defalias 'make-face #[(name) "À !„pÂÃÄ\"‰ÆÅIˆ Ç IˆÈ  Ê Ì  Î !ˆ Ï Iˆ ƒJÐ @ Ñ !BÒ @!B\"ˆ A‰ „0 BB+Õ=„aÖ=ƒe× !ˆØÙ!ƒoÙ !ˆ) ‡" [internal-find-face name make-vector 8 nil face 0 1 frame-list frames t inhibit-quit internal-next-face-id id make-face-internal 2 set-frame-face-alist copy-sequence frame-face-alist global-face-data window-system x win32 make-face-x-resource-internal fboundp facemenu-add-new-face] 6 (#$ . 10762) "SMake face: "]) (defalias 'make-face-x-resource-internal #[(face &optional frame set-anyway) "„3Á ‰ƒ/Ã\n@!Ä=„Ã\n@!Å=ƒ(ÆÇ!\n@ #ˆ\nA‰„ )‚ÿÊÇ!\"ËÇ!!\fÍ\fÎPÏ\"†W …WÐ!Í\fÒPÓ\"†l …lÔ!Í\fÖP×\"† …Ø!Í\fÚPÛ\"† Í\fÜPÝ\"†  … Þ!Í\fàPá\"‰\"ƒ·\"—ã‚À …Àä!)%ƒÍæç舃×æéꈃáæë숃ëæíîˆ%„õ ƒýï%#ˆ.‡" [frame frame-list frames framep x win32 make-face-x-resource-internal face-name face set-anyway internal-get-face symbol-name name x-get-resource ".attributeFont" "Face.AttributeFont" face-font fn ".attributeForeground" "Face.AttributeForeground" face-foreground fg ".attributeBackground" "Face.AttributeBackground" face-background bg ".attributeStipple" "Face.AttributeStipple" ".attributeBackgroundPixmap" "Face.AttributeBackgroundPixmap" face-stipple bgp ".attributeUnderline" "Face.AttributeUnderline" resource ("on" "true") face-underline-p ulp nil (byte-code "Á˜ƒ  !ˆ‚.ĘƒÅ !ˆ‚.Ƙƒ'Ç !ˆ‚.È  #ˆÂ‡" [fn "italic" make-face-italic face "bold" make-face-bold "bold-italic" make-face-bold-italic set-face-font frame] 4) ((error (byte-code "ÁƒÂÃ\f#ˆ‚ÂÅ\f#ˆÂ‡" [fn ("italic" "bold" "bold-italic") message "no %s version found for face `%s'" name "font `%s' not found for face `%s'"] 4))) (set-face-foreground face fg frame) ((error (message "color `%s' not allocated for face `%s'" fg name))) (set-face-background face bg frame) ((error (message "color `%s' not allocated for face `%s'" bg name))) (set-face-stipple face bgp frame) ((error (message "pixmap `%s' not found for face `%s'" bgp name))) set-face-underline-p] 5]) #@593 Define a face just like OLD-FACE, with name NEW-FACE. If NEW-FACE already exists as a face, it is modified to be like OLD-FACE. If it doesn't already exist, it is created. If the optional argument FRAME is given as a frame, NEW-FACE is changed on FRAME only. If FRAME is t, the frame-independent default specification for OLD-FACE is copied to NEW-FACE. If FRAME is nil, copying is done for the frame-independent defaults and for each existing frame. If the optional fourth argument NEW-FRAME is given, copy the information from face OLD-FACE on frame FRAME to NEW-FACE on frame NEW-FRAME. (defalias 'copy-face #[(old-face new-face &optional frame new-frame) "„  „/Ä ‰ƒ#Æ @#ˆ A‰„ÆÂ#ˆ)‚uÉ \"Ê\"†BË!ÌÍΈÏÐ \"#ˆÑÒ \"#ˆÓÔ \"#ˆÕÖ \"#ˆ)‡" [new-frame frame t inhibit-quit frame-list frames copy-face old-face new-face internal-get-face internal-find-face make-face nil (byte-code "À  \f\" #‡" [set-face-font new-face face-font old-face frame new-frame] 5) ((error (set-face-font new-face nil new-frame))) set-face-foreground face-foreground set-face-background face-background set-face-stipple face-stipple set-face-underline-p face-underline-p] 6 (#$ . 12995)]) #@60 True if the faces FACE1 and FACE2 display in the same way. (defalias 'face-equal #[(face1 face2 &optional frame) "À \n\"À \n\"Ä \n\"Ä \n\"š…CÅ \n\"Å \n\"š…CÆ \n\"Æ \n\"š…CÇ \n\"Ç \n\"=…CÈ \n\"È \n\"š‡" [internal-get-face face1 frame face2 face-foreground face-background face-font face-underline-p face-stipple] 4 (#$ . 14216)]) #@468 True if face FACE displays differently from the default face, on FRAME. A face is considered to be ``the same'' as the default face if it is actually specified in the same way (equivalent fonts, etc) or if it is fully unspecified, and thus inherits the attributes of any face it is displayed on top of. The optional argument FRAME specifies which frame to test; if FRAME is t, test the default for new frames. If FRAME is nil or omitted, test the selected frame. (defalias 'face-differs-from-default-p #[(face &optional frame) "ÀÁ\n\"À \n\"Ä \n\"Ä \n\"š„Ä \n\"?…cÅ \n\"Å \n\"š„2Å \n\"?…cÆ \n\"Æ \n\"š„FÆ \n\"?…cÇ \n\"Ç \n\"š„ZÇ \n\"?…cÈ \n\"È \n\"š)?‡" [internal-get-face default frame face face-foreground face-background face-font face-stipple face-underline-p] 4 (#$ . 14558)]) #@207 True if face FACE has some non-nil attribute. The optional argument FRAME specifies which frame to test; if FRAME is t, test the default for new frames. If FRAME is nil or omitted, test the selected frame. (defalias 'face-nontrivial-p #[(face &optional frame) "À \n\"à \n\"†%Ä \n\"†%Å \n\"†%Æ \n\"†%Ç \n\"‡" [internal-get-face face frame face-foreground face-background face-font face-stipple face-underline-p] 3 (#$ . 15361)]) #@198 Swap the foreground and background colors of face FACE. If the face doesn't specify both foreground and background, then set its foreground and background to the default background and foreground. (defalias 'invert-face #[(face &optional frame) "À \n\"à \n\"Ä \n\"‰„ ƒ(Ç \n#ˆÈ \n#ˆ‚LÇ ÄÉ\n\"†7ÊË\n!žA\n#ˆÈ ÃÉ\n\"†IÌË\n!žA\n#ˆ* ‡" [internal-get-face face frame face-foreground face-background bg fg set-face-foreground set-face-background default background-color frame-parameters foreground-color] 6 (#$ . 15801) (list (read-face-name "Invert face: "))]) #@69 Like set-face-font, but returns nil on failure instead of an error. (defalias 'internal-try-face-font #[(face font &optional frame) "ÀÁ‡" [nil (set-face-font face font frame) ((error))] 3 (#$ . 16375)]) (byte-code "ÀÁ\nBÀÃ\nBÀÄ\nBÀÅ\nBÆÇ\nBÈ É\nBÊ Ë\nBÌ Í\nBÎωÐÑÒÓщÔÕ‰‰ÖÔω !\"#$%&'è&'%'#'!' '''''''''é°ê&'%'#'!ë° '\"'Q'$'Q.À‡" [nil x-font-regexp current-load-list x-font-regexp-head x-font-regexp-weight x-font-regexp-slant 1 x-font-regexp-weight-subnum 2 x-font-regexp-slant-subnum 3 x-font-regexp-swidth-subnum 4 x-font-regexp-adstyle-subnum "[-?]" "[^-]+" "\\(bold\\|demibold\\|medium\\)" "\\([^-]*\\)" "\\([ior]\\)" "\\([^-]?\\)" "[0-9]+" "[0-9][0-9]+" "[cmp?*]" encoding registry avgwidth spacing resy resx pointsize pixelsize adstyle swidth slant\? slant weight\? weight family foundry - "\\`\\*?[-?*]" "\\*?\\'" "\\`[-?*]" "\\([-*?]\\|\\'\\)"] 29) #@288 Return a font name matching PATTERN. All wildcards in PATTERN become substantiated. If PATTERN is nil, return the name of the frame's base font, which never contains wildcards. Given optional arguments FACE and FRAME, return a font which is also the same size as FACE on FRAME, or fail. (defalias 'x-resolve-font-name #[(pattern &optional face frame) "9„ Á!\nÃ=ƒÄ ƒaÆ \n#‰„\\ƒWÈÉ \"ƒ@Ê!„8ËÌ!ˆ‚\\ËÍ\"ˆ‚\\Ê!„NËÎ \"ˆ‚\\ËÏ #ˆ‚\\ËÐ \"ˆ@)‡ÑÒÓ !žA‡" [face face-name frame t nil pattern x-list-fonts fonts string-match "\\*" face-font error "No matching fonts are the same height as the frame default font" "No matching fonts are the same height as face `%s'" "Height of font `%s' doesn't match the frame default font" "Height of font `%s' doesn't match face `%s'" "No fonts match `%s'" font frame-parameters selected-frame] 5 (#$ . 17340)]) (defalias 'x-frob-font-weight #[(font which) "À \n\"ƒ\nÃ\f”O \n\f•”OÇ\n•ÈO°‡À \n\"„.À\n\n\"…:\nÃË”O \nË•ÈOQ‡" [string-match x-font-regexp font 0 x-font-regexp-weight-subnum which x-font-regexp-adstyle-subnum "*" nil x-font-regexp-head x-font-regexp-weight 1] 7]) (defalias 'x-frob-font-slant #[(font which) "À \n\"ƒ\nÃ\f”O \n\f•”OÇ\n•ÈO°‡À \n\"„.À\n\n\"…:\nÃË”O \nË•ÈOQ‡" [string-match x-font-regexp font 0 x-font-regexp-slant-subnum which x-font-regexp-adstyle-subnum "*" nil x-font-regexp-head x-font-regexp-slant 1] 7]) #@94 Given an X font specification, make a bold version of it. If that can't be done, return nil. (defalias 'x-make-font-bold #[(font) "À Â\"‡" [x-frob-font-weight font "bold"] 3 (#$ . 18752)]) #@98 Given an X font specification, make a demibold version of it. If that can't be done, return nil. (defalias 'x-make-font-demibold #[(font) "À Â\"‡" [x-frob-font-weight font "demibold"] 3 (#$ . 18947)]) #@98 Given an X font specification, make a non-bold version of it. If that can't be done, return nil. (defalias 'x-make-font-unbold #[(font) "À Â\"‡" [x-frob-font-weight font "medium"] 3 (#$ . 19154)]) #@97 Given an X font specification, make an italic version of it. If that can't be done, return nil. (defalias 'x-make-font-italic #[(font) "À Â\"‡" [x-frob-font-slant font "i"] 3 (#$ . 19357)]) #@98 Given an X font specification, make an oblique version of it. If that can't be done, return nil. (defalias 'x-make-font-oblique #[(font) "À Â\"‡" [x-frob-font-slant font "o"] 3 (#$ . 19553)]) #@100 Given an X font specification, make a non-italic version of it. If that can't be done, return nil. (defalias 'x-make-font-unitalic #[(font) "À Â\"‡" [x-frob-font-slant font "r"] 3 (#$ . 19752)]) #@103 Make the font of the given face be bold, if possible. If NOERROR is non-nil, return nil on failure. (defalias 'make-face-bold #[(face &optional frame noerror) "Á=ƒ! Á\"<ƒ!Ä Å Á\">ƒÆ‚ÇÁ#‡È „OÊ  Ì Á #ˆ …KÌ  @ #ˆ A‰ „8È)‚”Î \" \"†_ Á\"‰ <ƒiÈ  †{ÂÏ\"†{ÉÐ!žA‰ ƒŠÑ  #†” †”ÒÓ \")‡" [frame t face-font face set-face-font italic (bold italic) (bold) nil font frame-list frames make-face-bold noerror internal-get-face default frame-parameters make-face-bold-internal error "No bold version of %S"] 7 (#$ . 19954) (list (read-face-name "Make which face bold: "))]) (defalias 'make-face-bold-internal #[(face frame font) "À !‰ƒÄ #†!Ç !‰…!Ä #)‡" [nil f2 x-make-font-bold font internal-try-face-font face frame x-make-font-demibold] 4]) #@105 Make the font of the given face be italic, if possible. If NOERROR is non-nil, return nil on failure. (defalias 'make-face-italic #[(face &optional frame noerror) "Á=ƒ! Á\"<ƒ!Ä Å Á\">ƒÆ‚ÇÁ#‡È „OÊ  Ì Á #ˆ …KÌ  @ #ˆ A‰ „8È)‚”Î \" \"†_ Á\"‰ <ƒiÈ  †{ÂÏ\"†{ÉÐ!žA‰ ƒŠÑ  #†” †”ÒÓ \")‡" [frame t face-font face set-face-font bold (bold italic) (italic) nil font frame-list frames make-face-italic noerror internal-get-face default frame-parameters make-face-italic-internal error "No italic version of %S"] 7 (#$ . 20745) (list (read-face-name "Make which face italic: "))]) (defalias 'make-face-italic-internal #[(face frame font) "À !‰ƒÄ #†!Ç !‰…!Ä #)‡" [nil f2 x-make-font-italic font internal-try-face-font face frame x-make-font-oblique] 4]) #@114 Make the font of the given face be bold and italic, if possible. If NOERROR is non-nil, return nil on failure. (defalias 'make-face-bold-italic #[(face &optional frame noerror) "Á=ƒ Á\"<ƒÄ ÅÁ#‡Æ„BÈ  Ê Á #ˆ …>Ê  @ #ˆ A‰ „+Æ)‚‡Ì \" \"†R Á\"‰<ƒ\\ƆnÂÍ\"†nÇÎ!žA‰ƒ}Ï #†‡ †‡ÐÑ\")‡" [frame t face-font face set-face-font (bold italic) nil font frame-list frames make-face-bold-italic noerror internal-get-face default frame-parameters make-face-bold-italic-internal error "No bold italic version of %S"] 5 (#$ . 21551) (list (read-face-name "Make which face bold-italic: "))]) (defalias 'make-face-bold-italic-internal #[(face frame font) "À‰Ã\f!‰ƒ*\f\nš„*Å\n!‰ƒ*\n š„*Æ #†›É\f!‰ƒP\f\nš„PÅ\n!‰ƒP\n š„PÆ #†›Ã\f!‰ƒv\f\nš„vÊ\n!‰ƒv\n š„vÆ #†›É\f!‰…›\f\nš?…›Ê\n!‰…›\n š?…›Æ #*‡" [nil f3 f2 x-make-font-italic font x-make-font-bold internal-try-face-font face frame x-make-font-oblique x-make-font-demibold] 4]) #@107 Make the font of the given face be non-bold, if possible. If NOERROR is non-nil, return nil on failure. (defalias 'make-face-unbold #[(face &optional frame noerror) "Á=ƒ Á\"<ƒÄ Å Á\">…ÆÁ#‡Ç‰ „NÊ  Ì Á #ˆ …JÌ  @ #ˆ A‰ „7Ç)‚Î \" \"†^ Á\"‰<ƒhdžzÂÏ\"†zÉÐ!žA‰…„Ñ!‰ ƒ“Ò  #† †ÓÔ\"*‡" [frame t face-font face set-face-font italic (italic) nil font1 font frame-list frames make-face-unbold noerror internal-get-face default frame-parameters x-make-font-unbold internal-try-face-font error "No unbold version of %S"] 7 (#$ . 22552) (list (read-face-name "Make which face non-bold: "))]) #@109 Make the font of the given face be non-italic, if possible. If NOERROR is non-nil, return nil on failure. (defalias 'make-face-unitalic #[(face &optional frame noerror) "Á=ƒ Á\"<ƒÄ Å Á\">…ÆÁ#‡Ç‰ „NÊ  Ì Á #ˆ …JÌ  @ #ˆ A‰ „7Ç)‚Î \" \"†^ Á\"‰<ƒhdžzÂÏ\"†zÉÐ!žA‰…„Ñ!‰ ƒ“Ò  #† †ÓÔ\"*‡" [frame t face-font face set-face-font bold (bold) nil font1 font frame-list frames make-face-unitalic noerror internal-get-face default frame-parameters x-make-font-unitalic internal-try-face-font error "No unitalic version of %S"] 7 (#$ . 23195) (list (read-face-name "Make which face non-italic: "))]) #@70 *Text string to display as the sample text for `list-faces-display'. (defvar list-faces-sample-text "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ" (#$ . -23845)) #@284 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. (defalias 'list-faces-display #[nil "ÀÁ Â\"ÃÄ Ã‰ ÊŠ qˆÌ  ƒa @ A ÎÏÐ!\"cˆ`cˆÓcˆÔ`SÈ$ˆbˆÕyˆm„]ÖcˆÕyˆ‚P)‚eb)‘ˆ×ØÊ!Ì\"‰ƒwÙ !‚zÚ @=†¤Á ‰ …£Û @ @$ˆ A‰ „ŒÃ)-‡" [sort face-list string-lessp nil selected-frame window disp-frame frame face faces "*Faces*" standard-output t truncate-lines format "%25s " symbol-name beg list-faces-sample-text "\n" put-text-property 1 " " get-buffer-window get-buffer window-frame frame-list copy-face] 7 (#$ . 24023) nil]) #@38 Display the properties of face FACE. (defalias 'describe-face #[(face) "ÀÁÂ!ˆÁÃ\f!!ˆÁÅ!ˆÆ ˆÁÇ!ˆÁÈ\f!!ˆÆ ˆÁÉ!ˆÁÊ\f!!ˆÆ ˆÁË!ˆÁÌ\f!!ˆÆ ˆÁÍ!ˆÁÎ\f!ƒIÏ‚JÐ!ˆÆ ˆÁÑ!ˆÁÒ\f!†[Ó!‘‡" ["*Help*" princ "Properties of face `" face-name face "':" terpri "Foreground: " face-foreground "Background: " face-background " Font: " face-font "Underlined: " face-underline-p "yes" "no" " Stipple: " face-stipple "none"] 4 (#$ . 24839) (list (read-face-name "Describe face: "))]) (defalias 'face-initialize #[nil "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÀÅ!ˆÀÆ!ˆÀÇ!ˆÀÈ!ˆÀÉ!ˆÊÇ! ÌÄÍ\"ˆÎÅÍ\"ˆÏÆÍ\"ˆÐÃÑÍ#ˆÐÇÒÍ#ˆÐÈÓÍ#ˆÐÂÔÍ#ˆÕÉ͉#ˆÖ ‰…£Ø@!Ù>„™@ƒ˜@@Þ!„Žß@A#ˆ)A‰„v*A‰„^à)‡" [make-face default modeline highlight bold italic bold-italic region secondary-selection underline face-id region-face make-face-bold t make-face-italic make-face-bold-italic set-face-background ("darkseagreen2" "green" t) ("gray" underline) ("paleturquoise" "green" t) (t) set-face-underline-p frame-list frames framep (t nil) global-face-data rest frame face face-differs-from-default-p face-fill-in nil] 5]) (defalias 'x-create-frame-with-faces #[(&optional parameters) "À žA† À\nžA‰…ÄÅÆ\"È ƒCÊ! Ë ž„4Ì žƒ<ÍÎ BB Ï \n #,È„TÒ !‚WÓ žÕ!ÈÒÙ B!ÚŽÛ\"ˆÜ ž†”Ü\nž†”ÄÝÞ\"‰…“È—àB)Aƒúá!\"ã\"žA$å\"žA&çã&Bå$BD\"ˆ$è\"žAšƒÏçè&BC\"ˆ$é\"žAšƒäçé&BC\"ˆ$ê\"žAšƒùçê&BC\"ˆ+ƒ>@A+@ìíî@A!ï@A!ȉ‰‰‰&¡ˆð@@+#ˆ)ñ@Aò#ˆA‰„ÿ„Kó!ˆ‚SçC\"ˆò-Äôõ\"á!È6\"‰7ƒrø7—!‚‘ùúûå\"žA\"\"ùúûü\"\"ý¥Wƒþ‚‘ÿ6ç@6BAB!ƒ®C‚ÀD!ƒ½E‚ÀFBD\"ˆ+)‡" [name parameters default-frame-alist x-resource-name x-get-resource "geometry" "Geometry" res-geometry nil parsed x-parse-geometry top left (user-position . t) (user-size . t) append frame global-face-data x-create-frame visibility visibility-spec copy-alist faces success rest (visibility) ((byte-code "„Á\n!ˆÁ‡" [success delete-frame frame] 2)) set-frame-face-alist reverse "reverseVideo" "ReverseVideo" resource ("on" "true") frame-parameters params foreground-color bg background-color fg modify-frame-parameters border-color mouse-color cursor-color global vector face face-name face-id face-fill-in make-face-x-resource-internal t make-frame-visible ".backgroundMode" "BackgroundMode" bg-mode bg-resource intern apply + x-color-values "white" 3 dark light background-mode display-type x-display-color-p color x-display-grayscale-p grayscale mono] 11]) (defalias 'frame-update-faces #[(frame) "‰\n…a\n@@Ä Å\"‰<ƒZÇ>È>É Ê #ˆƒ>ƒ>Ì  Å#ˆ‚YƒMÍ  Å#ˆ‚YƒYÎ  Å#ˆ*\nA*‚*‡" [global-face-data faces rest face face-font t font bold italic set-face-font nil frame make-face-bold-italic make-face-bold make-face-italic] 5]) (defalias 'frame-update-face-colors #[(frame) "‰…ÂÃĈ A‰„Â)‡" [global-face-data faces nil (byte-code "@A@@à !Å !\f<„Ç<„!Ç\f„*ƒ8È\nÇ #ˆÊ\nÇ #ˆ\fƒDËÈ\n\f $ˆƒRËÊ\n $ˆ,LJ" [faces data face face-foreground foreground face-background background nil set-face-foreground frame set-face-background face-try-color-list] 5) ((error))] 4]) (defalias 'face-fill-in #[(face data frame) "ÀÁ‡" [nil (byte-code "À ! !à !Ä !É\nË !\f#ˆƒ,ÍÎ\n\f$ˆƒ;ÍÏ\n\f$ˆ<ƒÐ>Ñ>‰ƒ`ƒ`Ò\n\f\"ˆ‚{ƒoÓ\n\f\"ˆ‚{ƒ{Ô\n\f\"ˆ*‚ƒÕ\n\f#ˆ …˜Ö\n \f#,‡" [face-foreground data face-background face-font face-stipple stipple font background foreground set-face-underline-p face face-underline-p frame face-try-color-list set-face-foreground set-face-background bold italic make-face-bold-italic make-face-bold make-face-italic set-face-font set-face-stipple] 6) ((error))] 3]) (defalias 'face-color-supported-p #[(frame color background-p) "…%Á\n!†% Ć% ƒÆ \n\"†%Ç\n!…%Æ \n\"‡" [window-system x-display-color-p frame color ("black" "white") background-p face-color-gray-p x-display-grayscale-p] 3]) (defalias 'face-try-color-list #[(function face colors frame) ";ƒÁ\n Ä=#…{ \n#‡Æ=ƒ Ç \n\"‡È …z ?…z@Ê>„?Á\n@ Ä=#ƒrAƒLÈË̈‚r@Æ=ƒ[Ç \n\"ˆ‚r@Í=ƒkÎ Æ\n#ˆ‚r @\n#ˆA‰„'È)‡" [colors face-color-supported-p frame function set-face-background face t invert-face nil done (t underline) (byte-code "@Á=ƒ \f\"ˆ‚'@Å=ƒÆ Á\f#ˆ‚' @\f#ˆÁÁ‡" [colors t invert-face face frame underline set-face-underline-p function done] 4) ((error)) underline set-face-underline-p] 6]) (byte-code "ÀÁ !Â=„ÀÁ !Ã=ƒÄ ˆÅÆ!‡" [framep selected-frame x win32 face-initialize provide faces] 2) emacs-19.30/lisp/fast-lock.elc100666 12120 1 32771 6044071115 14455 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Oct 27 01:46:43 1995 ;;; from file /home/fsf/rms/e19/lisp/fast-lock.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`fast-lock.el' was compiled for Emacs 19.29 or later")) (require (quote font-lock)) #@47 Submit via mail a bug report on fast-lock.el. (defalias 'fast-lock-submit-bug-report #[nil "ÀÂÃÄÅƉÇÉQ&)‡" [t reporter-prompt-for-summary-p reporter-submit-bug-report "simon@gnu.ai.mit.edu" "fast-lock 3.08" (fast-lock-cache-directories fast-lock-minimum-size fast-lock-save-others fast-lock-save-events fast-lock-save-faces) nil "Hi Si.,\n\nI want to report a bug. I've read the `Bugs' section of `Info' on Emacs, so I\nknow how to make a clear and unambiguous report. To reproduce the bug:\n\nStart a fresh Emacs via `" invocation-name " -no-init-file -no-site-file'.\nIn the `*scratch*' buffer, evaluate:"] 9 (#$ . 506) nil]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ B‡" [boundp fast-lock-mode nil current-load-list fast-lock-cache-timestamp fast-lock-cache-filename] 2) #@831 Directories in which Font Lock cache files are saved and read. Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where DIR is a directory name (relative or absolute) and REGEXP is a regexp. An attempt will be made to save or read Font Lock cache files using these items until one succeeds (i.e., until a readable or writable one is found). If an item contains REGEXP, DIR is used only if the buffer file name matches REGEXP. For example: (let ((home (expand-file-name (abbreviate-file-name (file-truename "~/"))))) (list (cons (concat "^" (regexp-quote home)) ".") "~/.emacs-flc")) => (("^/your/true/home/directory/" . ".") "~/.emacs-flc") would cause a file's current directory to be used if the file is under your home directory hierarchy, or otherwise the absolute directory `~/.emacs-flc'. (defvar fast-lock-cache-directories (quote ("." "~/.emacs-flc")) (#$ . 1299)) #@154 If non-nil, the minimum size for buffers. Only buffers more than this can have associated Font Lock cache files saved. If nil, means size is irrelevant. (defvar fast-lock-minimum-size 25600 (#$ . 2214)) #@251 A list of events under which caches will be saved. Valid events are `save-buffer', `kill-buffer' and `kill-emacs'. If concurrent editing sessions use the same associated cache file for a file's buffer, then you should add `save-buffer' to this list. (defvar fast-lock-save-events (quote (kill-buffer kill-emacs)) (#$ . 2424)) #@221 If non-nil, save Font Lock cache files irrespective of file owner. If nil, means only buffer files known to be owned by you can have associated Font Lock cache files saved. Ownership may be unknown for networked files. (defvar fast-lock-save-others t (#$ . 2757)) #@118 A list of faces that will be saved in a Font Lock cache file. If nil, means information for all faces will be saved. (defvar fast-lock-save-faces (byte-code "À ÂŽÃÄÅ \"*…Ƈ" [match-data match-data ((store-match-data match-data)) string-match "XEmacs" emacs-version (font-lock-string-face font-lock-doc-string-face font-lock-type-face font-lock-function-name-face font-lock-comment-face font-lock-keyword-face font-lock-preprocessor-face)] 3) (#$ . 3029)) #@1199 Toggle Fast Lock mode. With arg, turn Fast Lock mode on if and only if arg is positive and the buffer is associated with a file. Enable it automatically in your `~/.emacs' by: (add-hook 'font-lock-mode-hook 'turn-on-fast-lock) If Fast Lock mode is enabled, and the current buffer does not contain any text properties, any associated Font Lock cache is used if its timestamp matches the buffer's file, and its `font-lock-keywords' match those that you are using. Font Lock caches may be saved: - When you save the file's buffer. - When you kill an unmodified file's buffer. - When you exit Emacs, for all unmodified or saved buffers. Depending on the value of `fast-lock-save-events'. See also the commands `fast-lock-read-cache' and `fast-lock-save-cache'. Use \[font-lock-fontify-buffer] to fontify the buffer if the cache is bad. Various methods of control are provided for the Font Lock cache. In general, see variable `fast-lock-cache-directories' and function `fast-lock-cache-name'. For saving, see variables `fast-lock-minimum-size', `fast-lock-save-events', `fast-lock-save-others' and `fast-lock-save-faces'. Use \[fast-lock-submit-bug-report] to send bug reports or feedback. (defalias 'fast-lock-mode #[(&optional arg) "ÀÁ!\n… ƒÄ !ÅV‚ ?Lˆ ƒ)„)ÇÈÉ\"ˆÆÊ!‡ÀË!ÌLˆÀÍ!ÌLˆ …A?…AÏ ‡" [make-local-variable fast-lock-mode buffer-file-truename arg prefix-numeric-value 0 font-lock-mode add-hook font-lock-mode-hook turn-on-fast-lock t fast-lock-cache-timestamp nil fast-lock-cache-filename font-lock-fontified fast-lock-read-cache] 3 (#$ . 3495) "P"]) #@405 Read the Font Lock cache for the current buffer. The following criteria must be met for a Font Lock cache file to be read: - Fast Lock mode must be turned on in the buffer. - The buffer must not be modified. - The buffer's `font-lock-keywords' must match the cache's. - The buffer file's timestamp must match the cache's. - Criteria imposed by `fast-lock-cache-directories'. See `fast-lock-mode'. (defalias 'fast-lock-read-cache #[nil "Á  ÈÃ!ÉLˆƒ: „:Ê@É\"‰ ƒ1Ì ! ÉÎψA)‚Ð!ˆ ?…JÉ \f‰,‡" [fast-lock-cache-directories buffer-modified-p t font-lock-fontified fontified inhibit-read-only modified directories make-local-variable nil fast-lock-cache-directory directory fast-lock-cache-name fast-lock-cache-filename (byte-code "À !ƒ  É‰$ˆÀ‡" [file-readable-p fast-lock-cache-filename load t] 5) ((error) (quit)) set-buffer-modified-p] 5 (#$ . 5080) nil]) #@707 Save the Font Lock cache of BUFFER or the current buffer. The following criteria must be met for a Font Lock cache file to be saved: - Fast Lock mode must be turned on in the buffer. - The event must be one of `fast-lock-save-events'. - The buffer must be at least `fast-lock-minimum-size' bytes long. - The buffer file must be owned by you, or `fast-lock-save-others' must be t. - The buffer must contain at least one `face' text property. - The buffer must not be modified. - The buffer file's timestamp must be the same as the file's on disk. - The on disk file's timestamp must be different than the buffer's cache. - Criteria imposed by `fast-lock-cache-directories'. See `fast-lock-mode'. (defalias 'fast-lock-save-cache #[(&optional buffer) "ŠƒqˆÁ  …ˆÆ ?…ˆÇp!…ˆ\fš?…ˆ ƒ2 Ê X…ˆ „CÌ ÍÎ!8=…ˆÐedÑÂ$…ˆ…‡ Ô>…‡Õ@Ö\"‰…kØ!‰ƒ~Ú!ƒ~Û\f\"A*‚P)+‡" [buffer visited-file-modtime nil saved file-timestamp fast-lock-mode buffer-modified-p verify-visited-file-modtime fast-lock-cache-timestamp fast-lock-minimum-size buffer-size fast-lock-save-others user-uid 2 file-attributes buffer-file-name text-property-not-all face fast-lock-cache-directories directories (nil error) fast-lock-cache-directory t dir fast-lock-cache-name file file-writable-p fast-lock-save-cache-1] 6 (#$ . 5976) nil]) #@41 Unconditionally turn on Fast Lock mode. (defalias 'turn-on-fast-lock #[nil "ÀÁ!‡" [fast-lock-mode t] 2 (#$ . 7325)]) (defalias 'fast-lock-after-fontify-buffer #[nil "ƒÁ!ƒÂ!ˆ‚ÃÄÅ \"ˆÆ‰‡" [fast-lock-cache-filename file-writable-p delete-file message "File %s font lock cache cannot be deleted" buffer-name nil fast-lock-cache-timestamp] 3]) (defalias 'fast-lock-after-save-hook #[nil "À >… ‡" [save-buffer fast-lock-save-events fast-lock-save-cache] 2]) (defalias 'fast-lock-kill-buffer-hook #[nil "À >… ‡" [kill-buffer fast-lock-save-events fast-lock-save-cache] 2]) (defalias 'fast-lock-kill-emacs-hook #[nil "À >… ÂÃÄ \"‡" [kill-emacs fast-lock-save-events mapcar fast-lock-save-cache buffer-list] 3]) #@237 Return usable directory based on DIRECTORY. Returns nil if the directory does not exist, or, if CREATE non-nil, cannot be created. DIRECTORY may be a string or a cons pair of the form (REGEXP . DIR). See `fast-lock-cache-directories'. (defalias 'fast-lock-cache-directory #[(directory create) "„Á‚+\n;ƒ\n‚+Ã\f!ÁÇ ÉŽÊ\n@\"*…*\nA*‰ „5Á‚JÌ !ƒA ‚J …JÁÎÏ)‡" [buffer-file-name nil directory expand-file-name buffer-file-truename case-fold-search bufile match-data match-data ((store-match-data match-data)) string-match dir file-accessible-directory-p create (byte-code "À Â\"ˆ ‡" [make-directory dir t] 3) ((error))] 4 (#$ . 8053)]) #@739 Return full cache path name using caching DIRECTORY. If DIRECTORY is `.', the path is the buffer file name appended with `.flc'. Otherwise, the path name is constructed from DIRECTORY and the buffer's true abbreviated file name, with all `/' characters in the name replaced with `#' characters, and appended with `.flc'. If the same file has different cache path names when edited on different machines, e.g., on one machine the cache file name has the prefix `#home', perhaps due to automount, try putting in your `~/.emacs' something like: (setq directory-abbrev-alist (cons '("^/home/" . "/") directory-abbrev-alist)) Emacs automagically removes the common `/tmp_mnt' automount prefix by default. See `fast-lock-cache-directory'. (defalias 'fast-lock-cache-name #[(directory) "Á˜ƒ\n\nÃP‡Ä !È=ƒÉ‚Ê Ì ÎÄ!!ÏÐÑÒÓ \"\"Ô#ÃQ+‡" [directory "." buffer-file-name ".flc" expand-file-name buffer-file-truename bufile system-type emx ((47 35) (35 35 35) (58 59) (59 59 59)) ((47 35) (35 35 35)) chars-alist #[(c) " žA† C‡" [c chars-alist] 2] mapchars file-name-as-directory mapconcat char-to-string apply append mapcar ""] 8 (#$ . 8714)]) (defalias 'fast-lock-save-cache-1 #[(file timestamp) "ÀÁ! ÃÇÈ \"ˆÉÊˈÌ!ˆÇÍ \fÎ=ƒ&Ï‚1\fÐ=ƒ0Ñ‚1Ò#ˆ\f+‡" [generate-new-buffer " *fast-lock*" buffer-name t saved buname tpbuf message "Saving %s font lock cache..." nil (byte-code "ŠÀÁÂÃ\fDà DÃÆ D¯\"ˆqˆÈed ÊË%ˆ\f\f  )ʇ" [print fast-lock-cache-data 2 quote timestamp font-lock-keywords fast-lock-get-face-properties tpbuf write-region file nil quietly fast-lock-cache-timestamp fast-lock-cache-filename] 7) ((error (byte-code "ÀÀ‡" [error saved] 1)) (quit (byte-code "ÀÀ‡" [quit saved] 1))) kill-buffer "Saving %s font lock cache... %s." error "failed" quit "aborted" "done"] 5]) (defalias 'fast-lock-cache-data #[(version timestamp keywords properties &rest ignored) "£:ƒ\f‰A@¡ˆ Ã\f!Ã\n!)Å Æ Ç \n ÌUƒ;Í „;\nšƒ;\f š„A΂iÏÐ \"ˆÎÑÒˆÏÓ Ô=ƒ[Õ‚gÖ=ƒfׂgØ#ˆÇ=Ç=…w‰+‡" [timestamp font-lock-keywords current font-lock-compile-keywords keywords visited-file-modtime buffer-name t loaded buname buf-timestamp version 2 buffer-modified-p nil message "Loading %s font lock cache..." (fast-lock-set-face-properties properties) ((error (byte-code "ÀÀ‡" [error loaded] 1)) (quit (byte-code "ÀÀ‡" [quit loaded] 1))) "Loading %s font lock cache... %s." error "failed" quit "aborted" "done" font-lock-fontified fast-lock-cache-timestamp] 5]) #@283 Return a list of all `face' text properties in the current buffer. Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) where VALUE is a `face' property value and STARTx and ENDx are positions. Only those `face' VALUEs in `fast-lock-save-faces' are returned. (defalias 'fast-lock-get-face-properties #[nil "Œ~ˆ† Á d‰‰‰‰  ƒb @ A ÂeÊ Å $‰ƒQË\fÅ $†E\f BB‚-ƒ BB‚.‡" [fast-lock-save-faces face-list nil end start face regions properties limit faces text-property-any text-property-not-all] 7 (#$ . 11208)]) #@215 Set all `face' text properties to PROPERTIES in the current buffer. Any existing `face' text properties are removed first. Leaves buffer modified. See `fast-lock-get-face-properties' for the format of PROPERTIES. (defalias 'fast-lock-set-face-properties #[(properties) "Œ~ˆÀed\"ˆ …2 @@D @A ƒ+Å @ A@\f#ˆ AA‰„ A*‚)‡" [font-lock-unfontify-region properties face regions plist set-text-properties] 5 (#$ . 11792)]) (byte-code "À ÂŽÃÄÅ \"*ƒÆÇMˆÀ ÉŽÃÄÅ \"*ƒ%ÊËMˆÀ \fÍŽÃÄÅ \"*ƒ9ÎÏÐ\"ˆÑÒ!„DÓÒÔ\"ˆÎÕÖ\"ˆÎ×Ø\"ˆÎÙÚ\"ˆÛž„`ÝBÞß!‡" [match-data match-data ((store-match-data match-data)) string-match "XEmacs" emacs-version fast-lock-get-face-properties #[nil "Œ~ˆÀ‰ÃÄ!ˆ\n+‡" [nil cell properties map-extents #[(extent ignore) "À !‰ƒB ƒ\n >ƒBÄ !Å !\nž‰ ƒ6  ABB¡ˆ‚A\nEB*)ʇ" [extent-face extent value fast-lock-save-faces extent-start-position extent-end-position end start properties cell nil] 5]] 2 "Return a list of all `face' text properties in the current buffer.\nEach element of the list is of the form (VALUE START1 END1 START2 END2 ...)\nwhere VALUE is a `face' property value and STARTx and ENDx are positions.\nOnly those `face' VALUEs in `fast-lock-save-faces' are returned."] match-data ((store-match-data match-data)) fast-lock-set-face-properties #[(properties) "Œ~ˆÀed\"ˆ …0 @@ @A\nƒ)Ä\n@\nA@ #ˆ\nAA‰„ A*‚)‡" [font-lock-unfontify-region properties regions face font-lock-set-face] 5 "Set all `face' text properties to PROPERTIES in the current buffer.\nAny existing `face' text properties are removed first.\nSee `fast-lock-get-face-properties' for the format of PROPERTIES."] match-data ((store-match-data match-data)) add-hook font-lock-after-fontify-buffer-hook fast-lock-after-fontify-buffer fboundp font-lock-compile-keywords defalias identity after-save-hook fast-lock-after-save-hook kill-buffer-hook fast-lock-kill-buffer-hook kill-emacs-hook fast-lock-kill-emacs-hook fast-lock-mode minor-mode-alist (fast-lock-mode " Fast") provide fast-lock] 3) emacs-19.30/lisp/ffap.elc100666 12120 1 67640 6051504724 13516 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Nov 12 18:56:25 1995 ;;; from file /home/fsf/rms/e19/lisp/ffap.el ;;; emacs version 19.29.90.5. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`ffap.el' was compiled for Emacs 19.29 or later")) (provide (quote ffap)) (defalias 'ffap-soft-value #[(name &optional default) "À !‰ƒÃ\n!ƒ\nJ‚\f)‡" [intern-soft name sym boundp default] 3]) #@122 *Treat paths matching this as remote ftp paths. Nil to disable. Nil also disables the generation of such paths by ffap. (defvar ffap-ftp-regexp (byte-code "ÀÁ!„ ÀÂ!„ ÃÄ!…!ÅÆ\f\"„ ÅÇ\f\"…!ȇ" [featurep ange-ftp efs boundp file-name-handler-alist rassq ange-ftp-hook-function efs-file-handler-function "\\`/[^/:]+:"] 3) (#$ . -614)) #@62 *If set, convert local "file:" URL to path before prompting. (defvar ffap-url-unwrap-local t (#$ . -957)) #@110 *Convert remote "file:" or "ftp:" URL to path before prompting. This is ignored if `ffap-ftp-regexp' is nil. (defvar ffap-url-unwrap-remote t (#$ . -1070)) #@134 *User name in ftp paths generated by ffap (see host-to-ftp-path). Nil to fall back on `efs-default-user' or `ange-ftp-default-user'. (defvar ffap-ftp-default-user (byte-code "ÀÁ!š† ÀÃ!š?…‡" [ffap-soft-value "ange-ftp-default-user" "anonymous" "efs-default-user"] 2) (#$ . -1233)) #@69 *Paths matching this are remote file-system paths. Nil to disable. (defvar ffap-rfs-regexp "\\`/\\(afs\\|net\\)/." (#$ . -1525)) #@43 Regexp matching URL's, or nil to disable. (defvar ffap-url-regexp (concat "\\`\\(" "news\\(post\\)?:\\|mailto:\\|file:" "\\|" "\\(ftp\\|http\\|telnet\\|gopher\\|www\\|wais\\)://" "\\).") (#$ . 1661)) #@105 *Presumed url prefix type of strings like "". Sensible values are nil, "news", or "mailto". (defvar ffap-foo@bar-prefix "mailto" (#$ . -1868)) #@166 *A regexp matching filename wildcard characters, or nil. If find-file-at-point gets a filename matching this pattern, it passes it on to dired instead of find-file. (defvar ffap-dired-wildcards nil (#$ . -2030)) #@63 *Whether find-file-at-point prompts about a nonexistent file. (defvar ffap-newfile-prompt nil (#$ . -2248)) #@62 *If set, reverses the prefix argument to find-file-at-point. (defvar ffap-require-prefix nil (#$ . -2362)) #@152 *The command symbol called by find-file-at-point to find a file. Probably find-file, or find-file-using-paths if you use ff-paths with version < 3.00. (defvar ffap-file-finder (byte-code "ÀÁ!ƒÁ‡ÂÃÄ\"ˆÅ‡" [commandp find-file-using-paths eval-after-load "ff-paths" (and (commandp (quote find-file-using-paths)) (setq ffap-file-finder find-file-using-paths)) find-file] 3) (#$ . -2476)) (put (quote ffap-file-finder) (quote risky-local-variable) t) #@454 *A function of one argument, called by ffap to fetch URL's. The default is w3-fetch from the w3 package. If you prefer Mosaic or Netscape, install http://wombat.doc.ic.ac.uk/emacs/browse-url.el, and add one of the following lines to your setup: (setq ffap-url-fetcher 'browse-url-netscape) (setq ffap-url-fetcher 'browse-url-mosaic) Or for something hairier (choose fetch method based on url type and prompting) get ffap-url.el wherever you ffap.el. (defvar ffap-url-fetcher (quote w3-fetch) (#$ . -2931)) (put (quote ffap-url-fetcher) (quote risky-local-variable) t) #@52 *Regular expression governing search of ffap-next. (defvar ffap-next-regexp "[/:.~a-zA-Z]/\\|@[a-zA-Z][-a-zA-Z0-9]*\\." (#$ . -3508)) #@43 Last value returned by `ffap-next-guess'. (defvar ffap-next-guess nil (#$ . 3648)) #@259 Move point to next file or url, and return it as a string. If nothing found, leaves point at limit and returns nil. Optional BACK argument makes search backwards. Optional LIM argument limits the search. Only considers strings that match `ffap-next-regexp'. (defalias 'ffap-next-guess #[(&optional back lim) "„ ƒ\fe‚ dÂ`=„, ƒÄ‚ÅÇ#ˆÈ ‰ƒ ƒ4É‚5Ê 8bˆ ‰\f)‡" [lim back nil guess re-search-backward re-search-forward ffap-next-regexp move ffap-guesser 0 1 ffap-string-at-point-region ffap-next-guess] 5 (#$ . 3738)]) #@320 Search buffer for next file or url, and run ffap. Optional argument BACK says to search backwards. Optional argument WRAP says to try wrapping around if necessary. Interactively: use a single prefix to search backwards, double prefix to wrap forward, triple to wrap backwards. Actual search is done by ffap-next-guess. (defalias 'ffap-next #[(&optional back wrap) "`À !\n„ \fƒ ƒd‚ebƒ À \"\nƒ0ÅÆ!ˆÇÈ\n!!‚? bˆÉÊ\fƒ=Ë‚>Ì\"*‡" [ffap-next-guess back guess pt wrap sit-for 0 find-file-at-point ffap-prompter message "No %sfiles or URL's found." "" "more "] 3 (#$ . 4279) (byte-code "À !žA‡" [prefix-numeric-value current-prefix-arg ((1) (4 t) (16 nil t) (64 t t))] 2)]) #@59 Just like ffap-next, but searches with `ffap-url-regexp'. (defalias 'ffap-next-url #[(&optional back wrap) "tƒ\fÂÃ!‚Ã\f \")‡" [ffap-url-regexp ffap-next-regexp call-interactively ffap-next back wrap] 3 (#$ . 4966) nil]) #@63 Binds ffap-gnus-next and ffap-gnus-menu to M-l and M-m, resp. (defalias 'ffap-ro-mode-hook #[nil "ÀÁÂ\"ˆÀÃÄ\"‡" [local-set-key "ì" ffap-next "í" ffap-menu] 3 (#$ . 5197)]) #@59 Binds ffap-gnus-next and ffap-gnus-menu to L and M, resp. (defalias 'ffap-gnus-hook #[nil "ÀÁ!ÂLˆÃÄÅ\"ˆÃÆÇ\"‡" [make-local-variable ffap-foo@bar-prefix "news" local-set-key "L" ffap-gnus-next "M" ffap-gnus-menu] 3 (#$ . 5375)]) (defalias 'ffap-gnus-wrapper #[(form) "pÀ !=ƒ  ˆÃÄ !ÆÇ!ˆÈ !ˆ~ˆ`e=ƒ'ÊËÌÍ#ˆÎŽÏ!*‡" [get-buffer gnus-summary-buffer gnus-summary-select-article window-buffer selected-window sb gnus-configure-windows article pop-to-buffer gnus-article-buffer search-forward "\n\n" nil t ((pop-to-buffer sb)) eval form] 4]) #@43 Run ffap-next in the GNUS article buffer. (defalias 'ffap-gnus-next #[nil "ÀÁ!‡" [ffap-gnus-wrapper (ffap-next nil t)] 2 (#$ . 5919) nil]) #@43 Run ffap-menu in the GNUS article buffer. (defalias 'ffap-gnus-menu #[nil "ÀÁ!‡" [ffap-gnus-wrapper (ffap-menu)] 2 (#$ . 6064) nil]) (byte-code "ÀÁÂ!„ÃÄ!ƒÅÆ\f\"ƒÇ‚ÈM‡" [ffap-replace-path-component featurep efs boundp file-name-handler-alist rassq efs-file-handler-function efs-replace-path-component ange-ftp-replace-name-component] 4) #@54 Return FILE (maybe modified) if it exists, else nil. (defalias 'ffap-file-exists-string #[(file) "À !‰…\n;ƒ\n‚ )‡" [file-exists-p file exists] 3 (#$ . 6414)]) #@110 A symbol, one of: ping, accept, reject. This is what ffap-machine-p does with hostnames that have no domain. (defvar ffap-machine-p-local (quote reject) (#$ . 6587)) #@169 A symbol, one of: ping, accept, reject. This is what ffap-machine-p does with hostnames that have a known domain (see lisp/mail-extr.el for the list of known domains). (defvar ffap-machine-p-known (quote ping) (#$ . 6760)) #@172 A symbol, one of: ping, accept, reject. This is what ffap-machine-p does with hostnames that have an unknown domain (see lisp/mail-extr.el for the list of known domains). (defvar ffap-machine-p-unknown (quote reject) (#$ . 6990)) #@69 Top-level domains known to ffap. Ignored if mail-extr is loadable. (defvar ffap-machine-p-known-domains (quote ("com" "edu" "net" "org" "mil" "gov" "us" "arpa")) (#$ . 7226)) #@592 Indicate whether HOST is the name of a real machine. The variables ffap-machine-p-local, ffap-machine-p-known, and ffap-machine-p-unknown control ffap-machine-p depending on HOST's domain (none/known/unknown). Pinging is done using open-network-stream to decide HOST existence. Optional SERVICE specifies the service used (default "discard"). Optional QUIET flag suppresses the "Pinging..." message. Returned values: A t value means that HOST answered. A symbol (accept) means the relevant variable told us to accept. A string means the machine exists, but does not respond for some reason. (defalias 'ffap-machine-p #[(host &optional service quiet) "ÀÁ\n\"†\fÀÃ\n\"??… ÀÄ\n\"…\nÅ”TÆO—‰„(È‚RÉÊ!„<ËÌ͉#ƒIÎÊ!ƒIÏÆÐÑ\"ÒN‚R…RÍ„^‚j„h‚j‰Ø=ƒvØ‚ŸÙ=ƒÆ‚Ÿ„›;ƒ–ÛÜ\n#ˆ‚›ÛÝ\n\"ˆÞßà+‡" [string-match "[^-a-zA-Z0-9.]" host "[^0-9]" "\\.[^.]*$" 0 nil domain "Local" featurep mail-extr load "mail-extr" t provide intern-soft mail-extr-all-top-level-domains ((error obarray)) domain-name ffap-machine-p-known-domains ffap-machine-p-local ffap-machine-p-unknown ffap-machine-p-known strategy accept reject quiet message "Pinging %s (%s)..." "Pinging %s ..." error (byte-code "ÀÁÂÃ\f †\nÆ$!ˆÇ‡" [delete-process open-network-stream "ffap-machine-p" nil host service "discard" t] 6) ((error (byte-code "A@Âà \"ƒÄ‚5ÂÅ \"ƒ ‚5 Æšƒ/Ç8Èš?…5Ç8‚5É@A\")‡" [error mesg string-match "^Unknown host" nil "not responding$" "connection failed" 2 "permission denied" signal] 3)))] 6 (#$ . 7409)]) #@64 If FILENAME looks remote, return it (maybe slightly improved). (defalias 'ffap-file-remote-p #[(filename) "ƒ%Á\n\"ƒ%ÁÃ\n\"ƒ!\nĉ”O\nÄ•SÅOP‚\"\n†3…3Á\n\"…3\n‡" [ffap-ftp-regexp string-match filename "//" 0 nil ffap-rfs-regexp] 4 (#$ . 8946)]) #@61 Return machine name from around point if it exists, or nil. (defalias 'ffap-machine-at-point #[nil "ÀÁÂÃ#Å\f!… \f)‡" [ffap-string-at-point "-a-zA-Z0-9." nil "." mach ffap-machine-p] 4 (#$ . 9207)]) (defalias 'ffap-fixup-machine #[(mach) "ƒ ;„ ‡ÃÄ \"ƒÅ ÆQ‡ÃÇ \"ƒ#È ÆQ‡ …+Ê !‡" [ffap-url-regexp mach nil string-match "\\`gopher[-.]" "gopher://" "/" "\\`w\\(ww\\|eb\\)[-.]" "http://" ffap-ftp-regexp ffap-host-to-path] 3]) #@133 Convert "HOST" to "/anonymous@HOST:" (or "" for "localhost"). Variable `ffap-ftp-default-user' overrides or suppresses "anonymous". (defalias 'ffap-host-to-path #[(host) "Ášƒ‡ ƒÄ ÅÆ°‡ÄÆQ‡" [host "localhost" "" ffap-ftp-default-user "/" "@" ":"] 5 (#$ . 9646)]) #@60 Return STRING if it looks like a newsgroup name, else nil. (defalias 'ffap-newsgroup-p #[(string) "À \n\"…XÃ\fʼn  ƒ* @ A ÅÊˈ‚„UƒUÀÌ\n\"‰ ƒT\nÎÏ•O‰ ƒT ƒT\n),‡" [string-match ffap-newsgroup-regexp string (gnus-active-hashtb gnus-newsrc-hashtb gnus-killed-hashtb) ffap-newsgroup-heads nil ret htb heads htbs (byte-code "À \nJ\"ƒ\f ÄÄć" [intern-soft string htb ret nil htbs heads] 3) ((error)) "\\`\\([a-z]+\\)\\." head 0 1] 5 (#$ . 9922)]) #@66 ffap-newsgroup-p quickly rejects strings that do not match this. (defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$" (#$ . 10409)) #@50 Used by ffap-newsgroup-p if GNUS is not running. (defvar ffap-newsgroup-heads (quote ("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk")) (#$ . 10551)) #@68 If STRING looks like an URL, return it (maybe improved), else nil. (defalias 'ffap-url-p #[(string) "À\n…Ã\n\f\"…\f)‡" [t case-fold-search ffap-url-regexp string-match string] 3 (#$ . 10711)]) #@69 Return unwrapped local file URL, or nil. Ignores ffap-* variables. (defalias 'ffap-url-unwrap-local #[(url) "ÀÁ\n\"… \nÕTÄO‡" [string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url 1 nil] 3 (#$ . 10915)]) #@70 Return unwrapped remote file URL, or nil. Ignores ffap-* variables. (defalias 'ffap-url-unwrap-remote #[(url) "ÀÁ\n\"…Ã\nĔĕO!\nŔŕOP‡" [string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url ffap-host-to-path 2 3] 4 (#$ . 11133)]) #@64 Given URL, clean it up and return it. May become a file name. (defalias 'ffap-fixup-url #[(url) ";„Á‡\nƒÂ!†= ƒ\fƒÃ!†=ÅÆ!…(Æ!‰ƒ;GÈU„;†<)‡" [url nil ffap-url-unwrap-local ffap-url-unwrap-remote ffap-ftp-regexp fboundp url-normalize-url normal 0] 3 (#$ . 11386)]) #@200 Directory list parsed from ":"-separated ENVinronment variable. Optional EMPTY is default if (getenv ENV) is undefined, and is also substituted for the first empty-string component, if there is one. (defalias 'ffap-list-env #[(env &optional empty) "„\nÁ\n!…cÃĉ‰Á\n!ÉPÊÉ\n#‰ƒ<\nOT B‚ ŸƒaË ‰ƒaÌ£A\"¡ˆ¢†_ ˆ ,‡" [empty getenv env 0 nil ret dir match start ":" string-match "" append] 4 (#$ . 11680)]) #@42 Remove duplicates or non-dirs from PATH. (defalias 'ffap-reduce-path #[(path) "À‰ ƒ$  A @\n„Ä @!ƒ \n¡ˆ ‚\nŸ*‡" [nil tem ret path file-directory-p] 2 (#$ . 12132)]) #@58 Return PATH augmented with its immediate subdirectories. (defalias 'ffap-add-subdirs #[(path) "À‰ ƒÄÅÀÆÇ\"ˆ @\nB A‰„\nŸ*‡" [nil subs ret path mapcar #[(f) "À !… \nB‰‡" [file-directory-p f ret] 2] (byte-code "À @ÂÃ#‡" [directory-files path t "[^.]"] 4) ((error))] 6 (#$ . 12315)]) #@234 List of compression suffixes that ffap-locate-file tries. If not a list, it will be initialized by ffap-locate-file, and it will become nil unless you are using jka-compr. You might set this to nil or a list like '(".gz" ".z" ".Z"). (defvar ffap-locate-jka-suffixes t (#$ . 12614)) #@419 A generic path-searching function, defaults mimic `load' behavior. Returns path of an existing FILE that (load FILE) would load, or nil. Optional second argument NOSUFFIX, if t, is like the fourth argument for load, i.e. don't try adding suffixes ".elc" and ".el". If a list, it is taken as a list of suffixes to try instead. Optional third argument PATH specifies a different search path, it defaults to `load-path'. (defalias 'ffap-locate-file #[(file &optional nosuffix path) "„  !ƒÄ !CÅ !:ƒ ‚*ƒ)Ç‚*È \n<„QËÌ!…OËÍ!?…O…OÏ@Ð\"?…OÑ\n\nƒ`ÒÓÔÕ \"\" Ö‰ƒª„ª ‰ƒ£„£Ù @P@\"Û!ƒ™Ü!„™)A‰„wA‰„j+‡" [path load-path file-name-absolute-p file file-name-directory file-name-nondirectory nosuffix ("") (".elc" ".el" "") suffixes-to-try ffap-locate-jka-suffixes featurep jka-compr jka-aux jka-compr-file-name-handler-entry string-match "foo" (".gz" ".Z") apply nconc mapcar #[(suf) "Á \"B‡" [suf mapcar #[(x) " P‡" [suf x] 2] ffap-locate-jka-suffixes] 4] nil suffixes found expand-file-name try file-exists-p file-directory-p] 6 (#$ . 12903)]) #@503 Alist of (KEY . FUNCTION), applied to text around point. If ffap-file-at-point has a string NAME (maybe "") which is not an existing filename, it looks for pairs with a matching KEY: * if KEY is a symbol, it should equal `major-mode'. * if KEY is a string, it should match NAME as a regular expression. If KEY matches, ffap-file-at-point calls (FUNCTION NAME). FUNCTION should return a file, url, or nil (nil means keep looking for more KEY matches). Note URL's are ok despite the function name. (defvar ffap-alist (byte-code "ÀÁÂMˆÁBÃÄÅMˆÄBÆÇÈMˆÇBÉÊËMˆÊBÌÍÎMˆÍBÏÐÑÒÓ!„/ÔÓBÖ×MˆÖBØÙÚÛÒÜ!„YÝÞßCàá!âàãäåæ\"\"!#!ÜBçÜèé#ˆêëMˆêBìíîMˆíBïðñMˆðBòóôMˆóBõö÷MˆöBøùúMˆùBûüýMˆüBþÒÿ!„©@A!BP?ÿBCDMˆCB¯‡" ["\\.info\\'" ffap-info #[(name) "À ÂÃÄ!†ÃÅ!†ÃÆÇ\"C#‡" [ffap-locate-file name ("" ".info") ffap-soft-value "Info-directory-list" "Info-default-directory-list" "Info-directory" "~/info/"] 6] "\\`info/" ffap-info-2 #[(name) "À ÂÃO!‡" [ffap-info name 5 nil] 4] "\\`[-a-z]+\\'" ffap-info-3 #[(name) "À Áš…\n !‡" [ffap-string-around "()" ffap-info name] 2] "\\.elc?\\'" ffap-el #[(name) "À Â\"‡" [ffap-locate-file name t] 3] emacs-lisp-mode ffap-el-mode #[(name) "ÀÁ\n\"?…\fÃ\nÄ\"‡" [string-match "\\.el\\'" name ffap-locate-file (".el")] 3] (finder-mode . ffap-el-mode) (help-mode . ffap-el-mode) c-mode boundp ffap-c-path ("/usr/include" "/usr/local/include") current-load-list ffap-c-mode #[(name) "À  #‡" [ffap-locate-file name t ffap-c-path] 4] (c++-mode . ffap-c-mode) (cc-mode . ffap-c-mode) ("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode) tex-mode ffap-tex-path ffap-reduce-path append "." ffap-list-env "TEXINPUTS" ffap-add-subdirs "TEXINPUTS_SUBDIR" ffap-soft-value "TeX-macro-global" ("/usr/local/lib/tex/macros" "/usr/local/lib/tex/inputs") put variable-documentation "*Where ffap-tex-mode looks for tex files." ffap-tex-mode #[(name) "À  #‡" [ffap-locate-file name (".tex" "") ffap-tex-path] 4] latex-mode ffap-latex-mode #[(name) "À  #‡" [ffap-locate-file name (".sty" ".tex" "") ffap-tex-path] 4] "\\.\\(tex\\|sty\\|doc\\)\\'" ffap-tex #[(name) "À  #‡" [ffap-locate-file name t ffap-tex-path] 4] "\\.bib\\'" ffap-bib #[(name) "À ÂÃÄÅ\"#‡" [ffap-locate-file name t ffap-list-env "BIBINPUTS" ("/usr/local/lib/tex/macros/bib")] 6] math-mode ffap-math-mode #[(name) "ÀÁ\n\"ƒ\nÉ”OÄ\nÕÅOQ‚Æ\nÇÈÉ!#‡" [string-match "`" name 0 "/" nil ffap-locate-file (".m" "") ffap-soft-value "Mathematica-search-path"] 5] "\\`\\." ffap-home #[(name) "À ÂÃ#‡" [ffap-locate-file name t ("~")] 4] "\\`~/" ffap-lcd #[(name) "ÀÁ \"„à ą!ÅÆÇÈ\"!ÉÆÊË\"!\fÍÎOQ‡" [string-match "Lisp Code Dir" buffer-name ffap-string-around ("||" "|\n") ffap-host-to-path ffap-soft-value "elisp-archive-host" "archive.cis.ohio-state.edu" file-name-as-directory "elisp-archive-directory" "/pub/gnu/emacs/elisp-archive/" name 2 nil] 5] "^[Rr][Ff][Cc][- #]?\\([0-9]+\\)" ffap-rfc-path ffap-host-to-path "ds.internic.net" "/rfc/rfc%s.txt" ffap-rfc #[(name) "À \nÔÕO\"‡" [format ffap-rfc-path name 1] 5]] 22) (#$ . 14016)) (put (quote ffap-alist) (quote risky-local-variable) t) #@181 Alist of (MODE CHARS BEG END), where MODE is a major-mode or t. The data are arguments to ffap-string-at-point, used to guess the filename at point. The `t' entry is the default. (defvar ffap-string-at-point-mode-alist (quote ((t "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:") (math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:"))) (#$ . 17112)) #@63 List (BEG END), last region returned by ffap-string-at-point. (defvar ffap-string-at-point-region (quote (1 1)) (#$ . 17447)) #@47 Last string returned by ffap-string-at-point. (defvar ffap-string-at-point nil (#$ . 17579)) #@317 Return maximal string of CHARS (a string) around point. Optional BEGPUNCT chars before point are stripped from the beginning; Optional ENDPUNCT chars after point are stripped from the end. Without arguments, uses `ffap-string-at-point-mode-alist'. Also sets `ffap-string-at-point' and `ffap-string-at-point-region'. (defalias 'ffap-string-at-point #[(&optional chars begpunct endpunct) "ƒ=`ŠÂxˆ ƒ wˆ\f` )ŠÂwˆ ƒ$ xˆ\fA` ){ÇÈGÂ$ˆ‰ *‡ÊÉ \fž†QÍ\fž†QÎÏ!A\"‡" [chars pt nil begpunct ffap-string-at-point-region endpunct str set-text-properties 0 ffap-string-at-point apply major-mode ffap-string-at-point-mode-alist t error "ffap-string-at-point: bad alist"] 5 (#$ . 17679)]) #@67 Return string of two characters around last ffap-string-at-point. (defalias 'ffap-string-around #[nil "ŠÀÁ\n@bˆh\nA@bˆg#)‡" [format "%c%c" ffap-string-at-point-region] 4 (#$ . 18379)]) #@52 Return URL from around point if it exists, or nil. (defalias 'ffap-url-at-point #[nil "…¨Á Ä=… Å`!‰… Æ\n!‰:… Ç\n8)†¨ÈÉÊË#\fÍÎ\f\"ƒ=\fÏÁO\f‚žÍÐ\f\"ƒmÑ ÒšƒYÍÓ\f\"ƒY‚ZÕ‰…i×\fQ‰\f)„žØ\f!ƒ}Ù\fP\f‚žÍÚ\f\"ƒžÑ ÒšƒžÍÛÜÛ\fP!\"„žÝ\fP\fÞ\f!…§\f)‡" [ffap-url-regexp nil tem major-mode w3-mode w3-zone-at w3-zone-data 2 ffap-string-at-point "--:?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?" name string-match "^url:" 4 "\\`[^:@]+@[^:@]+[a-zA-Z]\\'" ffap-string-around "<>" "[$.0-9].*[$.0-9].*@" ffap-foo@bar-prefix "mailto" prefix ":" ffap-newsgroup-p "news:" "\\`[a-z0-9]+\\'" "~" expand-file-name "mailto:" ffap-url-p] 6 (#$ . 18570)]) #@105 Regexp Matching a line in a gopher bookmark (maybe indented). Two subexpressions are the KEY and VALUE. (defvar ffap-gopher-regexp "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$" (#$ . 19245)) #@61 If point is inside a gopher bookmark block, return its url. (defalias 'ffap-gopher-at-point #[nil "ŠÀyˆÁ\n!…›Á\n!ƒo„Ãyˆ‚\nÁ\n!„#ÄyˆÅƉ‰Ç \n \fÁ\n!ƒUÍĔĕ{—!ΔΕ{‰LˆÄyˆ*‚2\nƒtÑÒ\n\"ƒtÓ\nÔÀ•SO\nÀ•ÆOQ‚š\fGÄU…š …šÕ ÇšƒÖ‚“×PØ\f\n°-)‡" [0 looking-at ffap-gopher-regexp -1 1 "1" nil "70" port host path name type intern 2 val var string-match "^ftp:.*@" "ftp://" 4 "gopher://" "" ":" "/"] 7 (#$ . 19459)]) #@114 Strings matching this are coerced to ftp paths by ffap. That is, ffap just prepends "/". Set to nil to disable. (defvar ffap-ftp-sans-slash-regexp (byte-code "…Á‡" [ffap-ftp-regexp "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)"] 1) (#$ . 19908)) #@231 Return filename from around point if it exists, or nil. Existence test is skipped for names that look remote. If the filename is not obvious, it also tries `ffap-alist', which may actually result in an URL rather than a filename. (defalias 'ffap-file-at-point #[nil "À Ä ÆÇÈ Ê ! \f\fÍŽ ΃%Æ‚\n „1Ï !†\n ƒ=Ð !‚QƒTÒ \"ƒTÐÓ P!†\n ƒ`Ï !†\nƉ‰ƒ½„½@A@=„š@;ƒlÒ@ \"ƒlA !‰ƒlÙ!†¸Ð!†¸Ï!‚l,†\nÆÐ\f!†äÛ=…äÒÜÝ \"…äÓÝ ÞßOàQ‰!… Òâ \"ƒÏã! ä•ÆO\"!† Ïã! \"!*.‡" [t case-fold-search match-data data ffap-string-at-point string nil (substitute-in-file-name string) ((error string)) name file-name-absolute-p abs default-directory ((store-match-data data)) ("" "/" "//") ffap-file-exists-string ffap-file-remote-p ffap-ftp-sans-slash-regexp string-match "/" ffap-alist try tem alist major-mode ffap-url-p ffap-rfs-regexp internal-ange-ftp-mode "^\\*ftp \\(.*\\)@\\(.*\\)\\*$" buffer-name 5 -1 ":" remote-dir "\\`\\(/?~?ftp\\)/" ffap-replace-path-component 1] 7 (#$ . 20193)]) #@68 Read a file or url from minibuffer, with PROMPT and initial GUESS. (defalias 'ffap-read-file-or-url #[(prompt guess) "„ Â!?Ƀ!Æ!„ÇÈ!!É!ÊË\fÍ\fÃ\fƒ3\fGB‚4ÎC&*‡" [guess default-directory ffap-url-p nil dir filep ffap-file-remote-p abbreviate-file-name expand-file-name file-name-directory apply completing-read prompt ffap-read-file-or-url-internal file-name-history] 9 (#$ . 21262)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp url-global-history-completion-list nil current-load-list] 2) (defalias 'ffap-read-url-internal #[(string dir action) "\n„Ã\f \"†$\f‚$\nÅ=ƒ#Æ\f \"†$\fC‚$\f)‡" [url-global-history-completion-list hist action try-completion string t all-completions] 3]) (defalias 'ffap-read-file-or-url-internal #[(string dir action) "À !ƒ\f \f#‡Å \f#‡" [ffap-url-p string ffap-read-url-internal dir action read-file-name-internal] 4]) (byte-code "ÀÁ!ƒÂÃ!ƒÄÅÆÇÈ$ˆÉÅÈ\"ˆÈ‡" [featurep complete require advice ad-add-advice PC-do-completion (ffap-fix nil t (advice lambda nil "Work with ffap.el." (let ((minibuffer-completion-table minibuffer-completion-table)) (and (eq minibuffer-completion-table (quote ffap-read-file-or-url-internal)) (setq minibuffer-completion-table (if (ffap-url-p (buffer-string)) (quote ffap-read-url-internal) (quote read-file-name-internal)))) ad-do-it))) around nil ad-activate-on] 5) #@59 If non-nil, ffap highlights the current buffer substring. (defvar ffap-highlight (byte-code "…Á‡" [window-system t] 1) (#$ . 22618)) #@33 Overlay used by ffap-highlight. (defvar ffap-overlay nil (#$ . 22760)) #@251 If `ffap-highlight' is set, highlight the guess in the buffer. That is, the last buffer substring found by ffap-string-at-point. Optional argument REMOVE means to remove any such highlighting. Uses the face `ffap' if it is defined, else `highlight'. (defalias 'ffap-highlight #[(&optional remove) "ƒ\f …8 !‡ „ć ƒ\"Å @A@p$‡ÇÈ\"É ÊËÌÄ\"ƒ6Ì‚7Í#‡" [remove ffap-overlay delete-overlay ffap-highlight nil move-overlay ffap-string-at-point-region apply make-overlay overlay-put face internal-find-face ffap highlight] 6 (#$ . 22838)]) #@60 Return file or URL or nil, guessed from text around point. (defalias 'ffap-guesser #[nil "ƒÁ †\fà !†Ä †ÅÆ !‡" [ffap-url-regexp ffap-fixup-url ffap-url-at-point ffap-gopher-at-point ffap-file-at-point ffap-fixup-machine ffap-machine-at-point] 2 (#$ . 23389)]) (defalias 'ffap-prompter #[(&optional guess) "ÀŽÁ\nƒ Â\fÄ †Æ ‰‰ƒÇ ˆ\")‡" [((ffap-highlight t)) ffap-read-file-or-url ffap-url-regexp "Find file or URL: " "Find file: " guess ffap-guesser ffap-highlight] 4]) #@409 Find FILENAME (or url), guessing default from text around point. If `ffap-dired-wildcards' is set, wildcard patterns are passed to dired. See also the functions ffap-file-at-point, ffap-url-at-point. With a prefix, this command behaves *exactly* like `ffap-file-finder'. If `ffap-require-prefix' is set, the prefix meaning is reversed. See ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ for most recent version. (defalias 'find-file-at-point #[(&optional filename) "tƒƒ ?‚ ƒ !‡\f„Å Æ\f!ƒ'\f!‡ƒ8É\f\"ƒ8Ê\f!‡ ƒIÌ\f!„IÍÎ!ƒO Ï\f!!‡ÐÑÒÓ\fE\"‡" [ffap-require-prefix current-prefix-arg call-interactively ffap-file-finder filename ffap-prompter ffap-url-p ffap-url-fetcher ffap-dired-wildcards string-match dired ffap-newfile-prompt file-exists-p y-or-n-p "File does not exist, create buffer? " expand-file-name signal file-error "Opening file buffer" "no such file or directory"] 5 (#$ . 23879) nil]) (fset (quote ffap) (quote find-file-at-point)) #@171 *If non-nil, overrides `ffap-next-regexp' during ffap-menu. Make this more restrictive for faster menu building. For example, try ":/" for url (and some ftp) references. (defvar ffap-menu-regexp nil (#$ . -24850)) #@58 Buffer local menu of files and urls cached by ffap-menu. (defvar ffap-menu-alist nil (#$ . 25070)) (make-variable-buffer-local (quote ffap-menu-alist)) #@300 Puts up a menu of files and urls mentioned in the buffer. Sets mark, jumps to choice, and tries to fetch it. Menu is cached in `ffap-menu-alist', but will always be rebuilt with the optional RESCAN argument (a prefix interactively). Searches buffer with `ffap-menu-regexp' (see `ffap-next-regexp'). (defalias 'ffap-menu #[(&optional rescan) "ƒ „ƒ @Š\nAbˆ\n@à *š„ Ä ˆÅƒ*Ç‚+ÈÉÊBBË#‡" [ffap-menu-alist rescan first ffap-guesser ffap-menu-rescan ffap-menu-ask ffap-url-regexp "Find file or URL" "Find file" "*Rescan Buffer*" -1 ffap-menu-cont] 4 (#$ . 25229) "P"]) (defalias 'ffap-menu-cont #[(choice) "AÁWƒ ÂÃ!‡Ä ˆAbˆÅŽƒ!Ç ƒ!Æ ˆÈÁ!ˆÉ@!)‡" [choice 0 ffap-menu t push-mark ((ffap-highlight t)) ffap-highlight ffap-guesser sit-for find-file-at-point] 2]) #@404 Prompt from a menu of choices, and then apply some action. Arguments are TITLE, ALIST, and CONT (a continuation). This uses either a menu or the minibuffer depending on invocation. The TITLE string is used as either the prompt or menu title. Each (string . data) entry in ALIST defines a choice (data is ignored). Once the user makes a choice, function CONT is applied to the entry. Always returns nil. (defalias 'ffap-menu-ask #[(title alist cont) "ÀÁ!ƒ!ÂÃ!ƒ! <ƒ!ÁÄÅÇÈ \"BD\"‚8ÊË\f ÎÏÐ @@# ÑÄÑ%*‰ÅšƒF @@;ƒTÓ \"ƒb!ˆ‚fÕÖ!ˆ)ч" [fboundp x-popup-menu boundp last-nonmenu-event t "" title mapcar #[(i) "@B‡" [i] 2] alist minibuffer-completion-help -1 unread-command-char minibuffer-setup-hook completing-read format "%s (default %s): " nil choice assoc cont message "No choice made!"] 8 (#$ . 26008)]) (defalias 'ffap-menu-rescan #[nil "† deZŠebˆÆ ‰ƒ. `B BÇÈ`eZÉ_\f¥ #ˆ‚,ÇÊ!ˆË Ì\"‰  Aƒa @@ A@@šƒX ‰AA¡ˆ‚; A‰ ‚=)Ë Î\"‰‡" [ffap-menu-regexp ffap-next-regexp nil item range ffap-menu-alist ffap-next-guess message "Scanning...%2d%% <%s>" 100 "Scanning...done" sort #[(a b) "@ @™‡" [a b] 2] ptr #[(a b) "A AW‡" [a b] 2]] 5 nil nil]) #@98 Invoked by ffap-at-mouse if no file or url found at point. A command symbol, or nil for nothing. (defvar ffap-at-mouse-fallback (quote ffap-menu) (#$ . 27204)) (put (quote ffap-at-mouse-fallback) (quote risky-local-variable) t) #@105 Find file or URL guessed from text around mouse point. If none is found, call `ffap-at-mouse-fallback'. (defalias 'ffap-at-mouse #[(e) "ŠÀ !ˆÂ )‰ƒ\"Ä ˆÅŽÆÇ!ˆÈÉ \"ˆÊ !)‚5tƒ2 ƒ2Ì !‚5ÈÍ!)‡" [mouse-set-point e ffap-guesser guess ffap-highlight ((ffap-highlight t)) sit-for 0 message "Guessing `%s'" find-file-at-point ffap-at-mouse-fallback call-interactively "No file or URL found at mouse click."] 4 (#$ . 27439) "e"]) #@46 Like ffap, but put buffer in another window. (defalias 'ffap-other-window #[nil "ÀÁ‹!‡" [switch-to-buffer-other-window ((byte-code "ÀÁ!ˆp‡" [call-interactively ffap] 2))] 2 (#$ . 27870) nil]) #@45 Like ffap, but put buffer in another frame. (defalias 'ffap-other-frame #[nil "ÀÁ‹!‡" [switch-to-buffer-other-frame ((byte-code "ÀÁ!ˆp‡" [call-interactively ffap] 2))] 2 (#$ . 28068) nil]) #@31 Submit a bug report for ffap. (defalias 'ffap-bug #[nil "ÀÁ!ˆÂÄÅÆÇÈÉÊ Ì#\"#)‡" [require reporter t reporter-prompt-for-summary-p reporter-submit-bug-report "mic@mathcs.emory.edu" "ffap " mapcar intern all-completions "ffap-" obarray boundp] 9 (#$ . 28263) nil]) (fset (quote ffap-submit-bug) (quote ffap-bug)) emacs-19.30/lisp/files.elc100666 12241 1 175040 6051027144 14374 0ustar rolanddaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 00:01:33 1995 ;;; from file /home/fsf/rms/e19/lisp/files.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`files.el' was compiled for Emacs 19.29 or later")) #@72 *Non-nil means delete auto-save file when a buffer is saved or killed. (defconst delete-auto-save-files t (#$ . -470)) #@549 *Alist of abbreviations for file directories. A list of elements of the form (FROM . TO), each meaning to replace FROM with TO when it appears in a directory name. This replacement is done when setting up the default directory of a newly visited file. *Every* FROM string should start with `^'. Do not use `~' in the TO strings. They should be ordinary absolute directory names. Use this feature when you have directories which you normally refer to via absolute symbolic links. Make TO the name of the link, and FROM the name it is linked to. (defconst directory-abbrev-alist nil (#$ . -596)) #@810 *Non-nil means make a backup of a file the first time it is saved. This can be done by renaming the file or by copying. Renaming means that Emacs renames the existing file so that it is a backup file, then writes the buffer into a new file. Any other names that the old file had will now refer to the backup file. The new file is owned by you and its group is defaulted. Copying means that Emacs copies the existing file into the backup file, then writes the buffer on top of the existing file. Any other names that the old file had will now refer to the new (edited) file. The file's owner and group are unchanged. The choice of renaming or copying is controlled by the variables `backup-by-copying', `backup-by-copying-when-linked' and `backup-by-copying-when-mismatch'. See also `backup-inhibited'. (defconst make-backup-files (byte-code "Á=?‡" [system-type vax-vms] 2) (#$ . -1201)) #@181 Non-nil means don't make a backup, regardless of the other parameters. This variable is intended for use by making it local to a buffer. But it is local only if you make it local. (defvar backup-inhibited nil (#$ . 2103)) (put (quote backup-inhibited) (quote permanent-local) t) #@110 *Non-nil means always use copying to create backup files. See documentation of variable `make-backup-files'. (defconst backup-by-copying nil (#$ . -2389)) #@213 *Non-nil means use copying to create backups for files with multiple names. This causes the alternate names to refer to the latest version as edited. This variable is relevant only if `backup-by-copying' is nil. (defconst backup-by-copying-when-linked nil (#$ . -2551)) #@389 *Non-nil means create backups by copying if this preserves owner or group. Renaming may still be used (subject to control of other variables) when it would not result in changing the owner or group of the file; that is, for files which are owned by you and whose group matches the default for a new file created there by you. This variable is relevant only if `backup-by-copying' is nil. (defconst backup-by-copying-when-mismatch nil (#$ . -2828)) #@152 Predicate that looks at a file name and decides whether to make backups. Called with an absolute file name as argument, it returns t to enable backup. (defvar backup-enable-predicate (quote (lambda (name) (or (< (length name) 5) (not (string-equal "/tmp/" (substring name 0 5)))))) (#$ . 3283)) #@140 *Non-nil in a buffer means offer to save the buffer on exit even if the buffer is not visiting a file. Automatically local in all buffers. (defconst buffer-offer-save nil (#$ . -3585)) (make-variable-buffer-local (quote buffer-offer-save)) #@211 *Non-nil means find a file under alternative names, in existing buffers. This means if any existing buffer is visiting the file you want under another name, you get the existing buffer instead of a new buffer. (defconst find-file-existing-other-name nil (#$ . -3832)) #@174 *Non-nil means visit a file under its truename. The truename of a file is found by chasing all links both at the file level and at the levels of the containing directories. (defconst find-file-visit-truename nil (#$ . -4107)) #@235 The device number and file number of the file visited in the current buffer. The value is a list of the form (FILENUM DEVNUM). This pair of numbers uniquely identifies the file. If the buffer is visiting a new file, the value is nil. (defvar buffer-file-number nil (#$ . 4340)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local buffer-file-number put permanent-local t] 4) #@535 *Non-nil means protect against I/O errors while saving files. Some modes set this non-nil in particular buffers. This feature works by writing the new contents into a temporary file and then renaming the temporary file to replace the original. In this way, any I/O error in writing leaves the original untouched, and there is never any instant where the file is nonexistent. Note that this feature forces backups to be made by copying. Yet, at the same time, saving a precious file breaks any hard links between it and other files. (defconst file-precious-flag nil (#$ . -4722)) #@191 *Control use of version numbers for backup files. t means make numeric backup versions unconditionally. nil means make them for files that have some already. `never' means do not make them. (defvar version-control nil (#$ . -5310)) #@55 *When cleaning directory, number of versions to keep. (defvar dired-kept-versions 2 (#$ . -5548)) #@114 *If t, delete excess backup versions silently. If nil, ask confirmation. Any other value prevents any trimming. (defvar delete-old-versions nil (#$ . -5653)) #@72 *Number of oldest versions to keep when a new numbered backup is made. (defvar kept-old-versions 2 (#$ . -5818)) #@110 *Number of newest versions to keep when a new numbered backup is made. Includes the new backup. Must be > 0 (defvar kept-new-versions 2 (#$ . -5938)) #@186 *Value of t says silently ensure a file ends in a newline when it is saved. Non-nil but not t says ask user whether to add a newline when there isn't one. nil means don't add newlines. (defconst require-final-newline nil (#$ . -6096)) #@72 *Non-nil says by default do auto-saving of every file-visiting buffer. (defconst auto-save-default t (#$ . -6337)) #@134 *Non-nil says auto-save a buffer in the file it is visiting, when practical. Normally auto-save files are written under other names. (defconst auto-save-visited-file-name nil (#$ . -6459)) #@99 *Non-nil means save word abbrevs too when files are saved. Loading an abbrev file sets this to t. (defconst save-abbrevs nil (#$ . -6654)) #@74 *Non-nil says run dired if `find-file' is given the name of a directory. (defconst find-file-run-dired t (#$ . -6799)) #@247 List of functions to be called for `find-file' on nonexistent file. These functions are called as soon as the error is detected. `buffer-file-name' is already set up. The functions are called in the order given until one of them returns non-nil. (defvar find-file-not-found-hooks nil (#$ . 6925)) #@166 List of functions to be called after a buffer is loaded from a file. The buffer's local variables (if any) will have been processed before the functions are called. (defvar find-file-hooks nil (#$ . 7229)) #@402 List of functions to be called before writing out a buffer to a file. If one of them returns non-nil, the file is considered already written and the rest are not called. These hooks are considered to pertain to the visited file. So this list is cleared if you change the visited file name. See also `write-contents-hooks'. Don't make this variable buffer-local; instead, use `local-write-file-hooks'. (defvar write-file-hooks nil (#$ . 7442)) (put (quote write-file-hooks) (quote permanent-local) t) #@144 Just like `write-file-hooks', except intended for per-buffer use. The functions in this list are called before the ones in `write-file-hooks'. (defvar local-write-file-hooks nil (#$ . 7949)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local local-write-file-hooks put permanent-local t] 4) #@403 List of functions to be called before writing out a buffer to a file. If one of them returns non-nil, the file is considered already written and the rest are not called. These hooks are considered to pertain to the buffer's contents, not to the particular visited file; thus, `set-visited-file-name' does not clear this variable, but changing the major mode does clear it. See also `write-file-hooks'. (defvar write-contents-hooks nil (#$ . 8248)) #@300 *Control use of local-variables lists in files you visit. The value can be t, nil or something else. A value of t means local-variables lists are obeyed; nil means they are ignored; anything else means query. The command \[normal-mode] always obeys local-variables lists and ignores this variable. (defconst enable-local-variables t (#$ . -8703)) #@300 *Control processing of the "variable" `eval' in a file's local variables. The value can be t, nil or something else. A value of t means obey `eval' variables; nil means ignore them; anything else means query. The command \[normal-mode] always obeys local-variables lists and ignores this variable. (defconst enable-local-eval (quote maybe) (#$ . -9058)) (byte-code "ÀÁ!„ ÂÁÃ\"ˆÀÄ!„ÂÄÃ\"ˆÀ‡" [fboundp lock-buffer defalias ignore unlock-buffer] 3) (defalias 'ange-ftp-completion-hook-function #[(op &rest args) "Á>ƒ\fÂÃ\f#‡Å=…BÂ\f\"*‡" [op (file-name-completion file-name-all-completions) apply ange-ftp-hook-function args ange-ftp-completion-hook-function inhibit-file-name-operation inhibit-file-name-handlers] 4]) #@37 Show the current default directory. (defalias 'pwd #[nil "ÀÁ\n\"‡" [message "Directory %s" default-directory] 3 (#$ . 9799) nil]) #@111 Value of the CDPATH environment variable, as a list. Not actually set up until the first time you you use it. (defvar cd-path nil (#$ . 9936)) #@48 Character used to separate concatenated paths. (defvar path-separator ":" (#$ . 10085)) #@61 Explode a colon-separated list of paths into a string list. (defalias 'parse-colon-path #[(cd-path) "…9Á‰ÂÁPÈ\f#‰ƒ7 \f U?…-ÉÊ\f O!!C¤ Ë\\‚ ,‡" [cd-path nil 0 cd-colon cd-start cd-list cd-prefix path-separator string-match substitute-in-file-name file-name-as-directory 1] 6 (#$ . 10179)]) #@59 Change current directory to given absolute file name DIR. (defalias 'cd-absolute #[(dir) "Á=„\n !ÄÅ !!Æ !„ÇÈ \"‡É !ƒ& ‰\n‡ÇË \"‡" [system-type vax-vms file-name-as-directory dir abbreviate-file-name expand-file-name file-directory-p error "%s is not a directory" file-executable-p default-directory "Cannot cd to %s: Permission denied"] 3 (#$ . 10496)]) #@206 Make DIR become the current buffer's default directory. If your environment includes a `CDPATH' variable, try each one of that colon-separated list of directories when resolving a relative directory name. (defalias 'cd #[(dir) "À !ƒ\fÂà !!‡\f„ÅÆÇ!!‰†ÉC)ÊË?…)ÌÍ!‡" [file-name-absolute-p dir cd-absolute expand-file-name cd-path parse-colon-path getenv "CDPATH" trypath "./" found (byte-code "ÀÁ\n\"ˆÃ‡" [mapcar #[(x) "À \nP!Ä !…Å !ˆÆÇÈ\")‡" [expand-file-name x dir f file-directory-p cd-absolute throw found t] 3] cd-path nil] 3) error "No such directory found via CDPATH environment variable"] 4 (#$ . 10867) (list (read-file-name "Change default directory: " default-directory default-directory (and (member cd-path (quote (nil ("./")))) (null (getenv "CDPATH")))))]) #@32 Load the Lisp file named FILE. (defalias 'load-file #[(file) "ÀÁ\n!ÉÄ$‡" [load expand-file-name file nil t] 5 (#$ . 11655) "fLoad file: "]) #@78 Load the library named LIBRARY. This is an interface to the function `load'. (defalias 'load-library #[(library) "À !‡" [load library] 2 (#$ . 11802) "sLoad library: "]) #@135 Copy the file FILE into a temporary file on this machine. Returns the name of the local copy, or nil, if FILE is directly accessible. (defalias 'file-local-copy #[(file &optional buffer) "À Â\"‰…  \")‡" [find-file-name-handler file file-local-copy handler] 4 (#$ . 11979)]) #@349 Return the truename of FILENAME, which should be absolute. The truename of a file name is found by chasing symbolic links both at the level of the file and at the level of the directories containing it, until no links are left at any level. The arguments COUNTER and PREV-DIRS are used only in recursive calls. Do not specify them in other calls. (defalias 'file-truename #[(filename &optional counter prev-dirs) "Á˜„˜„ÃÄO˜ƒ(ÅÆ\"ƒ(Ç!‰Á˜ƒ(È „1ÊC Ë\fƒ< ‚LÎ !ÐÑÒ\"\") \f„YËC\f„9 ‰@S ˆ @ÃWƒrÔÕ\"ˆÖ×\"‰ƒˆ×\"Ù‚5Ú!†ˉß!˜„ßà\f@\"ƒ½à\f@\"A‚ßá× \f#!\"#\f#\"B\f@B ˆ\"*ä!嚃ößÚß!!!Ù‚4ä!暃 ß!Ù‚4ä!Pç!‰ƒ1è!ƒ%‚*PË‚4Ù+)‚Y*‡" [filename "" "~" 0 1 string-match "~[^/]*" expand-file-name "/" counter 100 nil prev-dirs file-name-handler-alist copy-sequence tem delq rassq ange-ftp-completion-hook-function done error "Apparent cycle of symbolic links for %s" find-file-name-handler file-truename handler t file-name-directory default-directory dirfile target dir directory-file-name assoc file-name-as-directory new old file-name-nondirectory ".." "." file-symlink-p file-name-absolute-p] 7 (#$ . 12264)]) #@133 Chase links in FILENAME until a name that is not a link. Does not examine containing directories for links, unlike `file-truename'. (defalias 'file-chase-links #[(filename) "ÀÁ\nÆ !‰ƒZ\fÇUƒÈÉ\n\"ˆÊË \"ƒ0 lj”TO Ç•ÀOP‚ÊÌ \"ƒM ÍÀOÎÏÐÑÏÐ !!!!!!‚0Ò Ð !\"\fS‚ +‡" [nil 100 filename newname count tem file-symlink-p 0 error "Apparent cycle of symbolic links for %s" string-match "//+" "\\`\\.\\./" 3 file-name-as-directory directory-file-name file-name-directory file-chase-links expand-file-name] 7 (#$ . 13500)]) #@41 Select buffer BUFFER in another window. (defalias 'switch-to-buffer-other-window #[(buffer) "À À\")‡" [t pop-up-windows pop-to-buffer buffer] 3 (#$ . 14033) "BSwitch to buffer in other window: "]) #@43 Switch to buffer BUFFER in another frame. (defalias 'switch-to-buffer-other-frame #[(buffer) "À À\"ˆÄÅÆ !!)‡" [t pop-up-frames pop-to-buffer buffer raise-frame window-frame selected-window] 3 (#$ . 14238) "BSwitch to buffer in other frame: "]) #@101 Edit file FILENAME. Switch to a buffer visiting file FILENAME, creating one if none already exists. (defalias 'find-file #[(filename) "ÀÁ\n!!‡" [switch-to-buffer find-file-noselect filename] 3 (#$ . 14491) "FFind file: "]) #@126 Edit file FILENAME, in another window. May create a new window, or reuse an existing one. See the function `display-buffer'. (defalias 'find-file-other-window #[(filename) "ÀÁ\n!!‡" [switch-to-buffer-other-window find-file-noselect filename] 3 (#$ . 14721) "FFind file in other window: "]) #@124 Edit file FILENAME, in another frame. May create a new frame, or reuse an existing one. See the function `display-buffer'. (defalias 'find-file-other-frame #[(filename) "ÀÁ\n!!‡" [switch-to-buffer-other-frame find-file-noselect filename] 3 (#$ . 15018) "FFind file in other frame: "]) #@137 Edit file FILENAME but don't allow changes. Like \[find-file] but marks buffer as read-only. Use \[toggle-read-only] to permit editing. (defalias 'find-file-read-only #[(filename) "À !ˆÂp‡" [find-file filename t buffer-read-only] 2 (#$ . 15310) "fFind file read-only: "]) #@168 Edit file FILENAME in another window but don't allow changes. Like \[find-file-other-window] but marks buffer as read-only. Use \[toggle-read-only] to permit editing. (defalias 'find-file-read-only-other-window #[(filename) "À !ˆÂp‡" [find-file-other-window filename t buffer-read-only] 2 (#$ . 15590) "fFind file read-only other window: "]) #@166 Edit file FILENAME in another frame but don't allow changes. Like \[find-file-other-frame] but marks buffer as read-only. Use \[toggle-read-only] to permit editing. (defalias 'find-file-read-only-other-frame #[(filename) "À !ˆÂp‡" [find-file-other-frame filename t buffer-read-only] 2 (#$ . 15940) "fFind file read-only other frame: "]) #@112 Find file FILENAME as a replacement for the file in the next window. This command does not select that window. (defalias 'find-alternate-file-other-window #[(filename) "À ƒ Á\n!‡Ã ÅŽÆÇ!ˆÈ\n!*‡" [one-window-p find-file-other-window filename selected-window save-selected-window-window ((select-window save-selected-window-window)) other-window 1 find-alternate-file] 2 (#$ . 16285) (byte-code "À ÂŽÃÄ!ˆ Ɖ‰ ƒ\"Ê !Ë !ÌÍƉ%-C‡" [selected-window save-selected-window-window ((select-window save-selected-window-window)) other-window 1 buffer-file-name nil file-dir file-name file file-name-nondirectory file-name-directory read-file-name "Find alternate file: "] 7)]) #@210 Find file FILENAME, select its buffer, kill previous buffer. If the current buffer now contains an empty file that you just visited (presumably by mistake), use this command to visit the file you really want. (defalias 'find-alternate-file #[(filename) "À ƒÁ ƒÂÃÄÅ \"!„ÆÇ!ˆp  Å \n \f ÏÐ!ƒ4ÑÐ!ˆÒÐ!ˆÓÓÓ ÔŽÕ ˆÖ!ˆ)p=†VÑ!-‡" [buffer-modified-p buffer-file-name yes-or-no-p format "Buffer %s is modified; kill anyway? " buffer-name error "Aborted" buffer-file-number buffer-file-truename oname otrue onum ofile obuf get-buffer " **lose**" kill-buffer rename-buffer nil ((byte-code "p=ƒ   Ç ˆÈ !ˆÇ‡" [obuf ofile buffer-file-name onum buffer-file-number otrue buffer-file-truename lock-buffer rename-buffer oname] 2)) unlock-buffer find-file filename] 5 (#$ . 16975) (byte-code "Á‰‰ƒÅ\f!Æ\f!ÇÈ\nÁ‰ %+C‡" [buffer-file-name nil file-dir file-name file file-name-nondirectory file-name-directory read-file-name "Find alternate file: "] 7)]) #@208 Create a suitably named buffer for visiting FILENAME, and return it. FILENAME (sans directory) is used unchanged if that name is free; otherwise a string <2> or <3> or ... is appended to get an unused name. (defalias 'create-file-buffer #[(filename) "À !‰؃\f Ä\n!)‡" [file-name-nondirectory filename lastname "" generate-new-buffer] 3 (#$ . 17955)]) #@114 Create and return a buffer with a name based on NAME. Choose the buffer's name using `generate-new-buffer-name'. (defalias 'generate-new-buffer #[(name) "ÀÁ\n!!‡" [get-buffer-create generate-new-buffer-name name] 3 (#$ . 18317)]) #@61 Regexp to match the automounter prefix in a directory name. (defconst automount-dir-prefix "^/tmp_mnt/" (#$ . 18553)) #@70 The user's homedir abbreviated according to `directory-abbrev-list'. (defvar abbreviated-home-dir nil (#$ . 18677)) #@204 Return a version of FILENAME shortened using `directory-abbrev-alist'. This also substitutes "~" for the user's home directory. Type \[describe-variable] directory-abbrev-alist RET for more information. (defalias 'abbreviate-file-name #[(filename) "À \n\"ƒÃÄ\nÅ•SÆO!!ƒ\nÅ•SÆO‰ƒAÀ@@\n\"ƒ8@A\nÅ•ÆOPA‰„# „TÊ ËÌÍÎ!!ÏQ) À \n\"ƒ•Å•ÐUƒk\nÅHÑU„•Ó=„yÔ=ƒ‡Õ ׎ÀØ\n\"*„•Î\nДЕO\nÅ•ÆOQ\n)‡" [string-match automount-dir-prefix filename file-exists-p file-name-directory 0 nil directory-abbrev-alist tail abbreviated-home-dir "$foo" "^" abbreviate-file-name expand-file-name "~" "\\(/\\|$\\)" 1 47 system-type ms-dos windows-nt match-data match-data ((store-match-data match-data)) "^[a-zA-Z]:/$"] 6 (#$ . 18800)]) #@329 *List of logical names for which visiting shouldn't save the true dirname. On VMS, when you visit a file using a logical name that searches a path, you may or may not want the visited file name to record the specific directory where the file was found. If you *do not* want that, add the logical name to this list as a string. (defvar find-file-not-true-dirname-list nil (#$ . -19547)) #@225 Return the buffer visiting file FILENAME (a string). This is like `get-file-buffer', except that it checks for any buffer visiting the same file, possibly under a different name. If there is no such live buffer, return nil. (defalias 'find-buffer-visiting #[(filename) "À !Âà !!‰†˜Æ Ç „? ƒ?Š @qˆ\nƒ6 \f˜ƒ6 @) A ‚*†˜ÌÍ\f!›Æ Ç ‰ƒ•„• ƒ•Š @qˆ\nƒŒšƒŒÐ\n!ƒŒÌÍ\n!›šƒŒ @) A ‚W+*‡" [get-file-buffer filename abbreviate-file-name file-truename truename buf buffer-list nil found list buffer-file-name buffer-file-truename 10 file-attributes number buffer-file-number file-exists-p] 5 (#$ . 19941)]) #@308 Like `insert-file-contents', q.v., but only reads in the file. A buffer may be modified in several ways after reading into the buffer due to advanced Emacs features, such as file-name-handlers, format decoding, find-file-hooks, etc. This function ensures that none of these modifications will take place. (defalias 'insert-file-contents-literally #[(filename &optional visit beg end replace) "À‰‰ÁÂ!… ÂKÇŽÂÈMˆÉ\n \f %-‡" [nil fboundp find-buffer-file-type find-buffer-file-type-function after-insert-file-functions format-alist file-name-handler-alist ((byte-code "ƒ ÁMˆ‚ÂÁ!ˆÁ‡" [find-buffer-file-type-function find-buffer-file-type fmakunbound] 2)) #[(filename) "À‡" [t] 1] insert-file-contents filename visit beg end replace] 6 (#$ . 20596)]) #@234 Read file FILENAME into a buffer and return the buffer. If a buffer exists visiting FILENAME, return that one, but verify that the file has not changed since visited or saved. The buffer is not selected, just returned to the caller. (defalias 'find-file-noselect #[(filename &optional nowarn rawfile) "ÀÁ\n!!Ã\n!ƒ&\fƒ!ŃÀÇ\n!!‚\n!‡ÈÉ\n\"‡Ê\n! ÀÇ\n!!\fÍÎ\f!› ?…CÐ\n!Òƒr„d\nÔ!˜„dÕÖ\nÔ!#ˆ„nƒr  ƒØ„\\Ø !„\\Ù\n!„‘ÈÚ\n\"ˆ‚\\ÛÜ\n!Ý !˜ƒ±Þß !ƒ©à‚ªáÜ\n!\"‚ÆÞß !ƒ½â‚¾ãÜ\n!Ý !#!ƒ\\Š qˆäå‰\"ˆ)‚\\Šæ\n! ç !ˆ qˆè ˆ)ƒ÷Òê눂üÒìíˆ\f./0ñ=ƒ-Ò2óôõ\n!\"ƒ õ\n!ö‰”O227)„-.ƒ:Á.!‰õ\n!89!„Núû!ˆå;)„[ü?\"ˆ) -‡" [abbreviate-file-name expand-file-name filename file-directory-p find-file-run-dired dired-noselect find-file-visit-truename file-truename error "%s is a directory." get-file-buffer buf truename 10 file-attributes number find-buffer-visiting other nil nowarn buffer-file-name message "%s and %s are the same file" find-file-existing-other-name verify-visited-file-modtime file-exists-p "File %s no longer exists!" yes-or-no-p file-name-nondirectory buffer-name format buffer-modified-p "File %s changed on disk. Discard your edits? " "File %s changed on disk. Reread from disk? " "File %s changed on disk. Discard your edits in %s? " "File %s changed on disk. Reread from disk into %s? " revert-buffer t create-file-buffer set-buffer-major-mode erase-buffer rawfile (insert-file-contents-literally filename t) ((file-error (byte-code "ÀÀ‡" [t error] 1))) (insert-file-contents filename t) ((file-error (byte-code "ÀÁ!„ÂÀ‡" [run-hook-with-args-until-success find-file-not-found-hooks t error] 2))) buffer-file-truename buffer-file-number system-type vax-vms logical string-match ":" file-name-directory 0 find-file-not-true-dirname-list default-directory backup-enable-predicate make-local-variable backup-inhibited after-find-file] 6 (#$ . 21367)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp after-find-file-from-revert-buffer nil current-load-list] 2) #@498 Called after finding a file and by the default revert function. Sets buffer mode, parses local variables. Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an error in reading the file. WARN non-nil means warn if there exists an auto-save file more recent than the visited file. NOAUTO means don't mess with auto-save mode. Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil means this call was from `revert-buffer'. Finishes by calling the functions in `find-file-hooks'. (defalias 'after-find-file #[(&optional error warn noauto after-find-file-from-revert-buffer) "À !? „™ÄƒÇ !ƒÈÉ‚u\n„<\nƒ1ËÌ \"ƒ1Í‚uÈ…u΂u„GÈÏ‚uÇÐ!!ƒTÒ‚uÓÔ !!ƒbĉ‚uÄÓÔÐÔ !!!!ƒtÕ‚uÖ‰ƒŠØ!ˆ „ŠÙÚÄÈ#ˆ*ƒ™„™ÝÈ!ˆÞÈ!ˆßà!‡" [file-writable-p buffer-file-name buffer-read-only noninteractive nil not-serious error file-attributes t "File exists, but cannot be read." warn file-newer-than-file-p make-auto-save-file-name "Auto save file is newer; consider M-x recover-file" "(New file)" "Note: file is write protected" directory-file-name default-directory "File not found and directory write-protected" file-exists-p file-name-directory "Use M-x make-dir RET RET to create the directory" "Use C-u M-x make-dir RET RET to create directory and its parents" msg message sit-for 1 auto-save-default noauto auto-save-mode normal-mode run-hooks find-file-hooks] 6 (#$ . 23418)]) #@484 Choose the major mode for this buffer automatically. Also sets up any specified local variables of the file. Uses the visited file name, the -*- line, and the local variables spec. This function is called automatically from `find-file'. In that case, we may set up specified local variables depending on the value of `enable-local-variables': if it is t, we do; if it is nil, we don't; otherwise, we query. `enable-local-variables' is ignored if you run `normal-mode' explicitly. (defalias 'normal-mode #[(&optional find-file) "„ †  ˆÃÄňÃÆLJ" [find-file default-major-mode fundamental-mode err (set-auto-mode) ((error (byte-code "ÀÁ !\"‡" [message "File mode specification error: %s" prin1-to-string err] 4))) (byte-code "?†  )‡" [find-file enable-local-variables hack-local-variables] 1) ((error (byte-code "ÀÁ !\"‡" [message "File local-variables error: %s" prin1-to-string err] 4)))] 3 (#$ . 24830) nil]) #@538 Alist of filename patterns vs corresponding major mode functions. Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL). (NON-NIL stands for anything that is not nil; the value does not matter.) Visiting a file whose name matches REGEXP specifies FUNCTION as the mode function to use. FUNCTION will be called, unless it is nil. If the element has the form (REGEXP FUNCTION NON-NIL), then after calling FUNCTION (if it's not nil), we delete the suffix that matched REGEXP and search the list again for another match. (defvar auto-mode-alist (mapcar (quote purecopy) (quote (("\\.text\\'" . text-mode) ("\\.c\\'" . c-mode) ("\\.h\\'" . c-mode) ("\\.tex\\'" . tex-mode) ("\\.ltx\\'" . latex-mode) ("\\.el\\'" . emacs-lisp-mode) ("\\.mm\\'" . nroff-mode) ("\\.me\\'" . nroff-mode) ("\\.ms\\'" . nroff-mode) ("\\.man\\'" . nroff-mode) ("\\.scm\\'" . scheme-mode) ("\\.l\\'" . lisp-mode) ("\\.lisp\\'" . lisp-mode) ("\\.f\\'" . fortran-mode) ("\\.for\\'" . fortran-mode) ("\\.p\\'" . pascal-mode) ("\\.pas\\'" . pascal-mode) ("\\.mss\\'" . scribe-mode) ("\\.ad[abs]\\'" . ada-mode) ("\\.icn\\'" . icon-mode) ("\\.pl\\'" . perl-mode) ("\\.cc\\'" . c++-mode) ("\\.hh\\'" . c++-mode) ("\\.C\\'" . c++-mode) ("\\.H\\'" . c++-mode) ("\\.cpp\\'" . c++-mode) ("\\.cxx\\'" . c++-mode) ("\\.hxx\\'" . c++-mode) ("\\.c\\+\\+\\'" . c++-mode) ("\\.h\\+\\+\\'" . c++-mode) ("\\.mk\\'" . makefile-mode) ("[Mm]akefile\\(.in\\)?\\'" . makefile-mode) ("\\.texinfo\\'" . texinfo-mode) ("\\.texi\\'" . texinfo-mode) ("\\.s\\'" . asm-mode) ("ChangeLog\\'" . change-log-mode) ("change.log\\'" . change-log-mode) ("changelo\\'" . change-log-mode) ("ChangeLog.[0-9]+\\'" . change-log-mode) ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) ("\\.scm\\.[0-9]*\\'" . scheme-mode) ("\\.[12345678]\\'" . nroff-mode) ("\\.TeX\\'" . tex-mode) ("\\.sty\\'" . latex-mode) ("\\.cls\\'" . latex-mode) ("\\.bbl\\'" . latex-mode) ("\\.bib\\'" . bibtex-mode) ("\\.article\\'" . text-mode) ("\\.letter\\'" . text-mode) ("\\.tcl\\'" . tcl-mode) ("\\.f90\\'" . f90-mode) ("\\.lsp\\'" . lisp-mode) ("\\.awk\\'" . awk-mode) ("\\.prolog\\'" . prolog-mode) ("\\.tar\\'" . tar-mode) ("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode) ("^/tmp/Re" . text-mode) ("/Message[0-9]*\\'" . text-mode) ("/drafts/[0-9]+\\'" . mh-letter-mode) ("^/tmp/fol/" . text-mode) ("\\.y\\'" . c-mode) ("\\.lex\\'" . c-mode) ("\\.oak\\'" . scheme-mode) ("\\.sgm\\'" . sgml-mode) ("\\.sgml\\'" . sgml-mode) ("\\.dtd\\'" . sgml-mode) ("[]>:/]\\..*emacs\\'" . emacs-lisp-mode) ("[:/]_emacs\\'" . emacs-lisp-mode) ("\\.ml\\'" . lisp-mode)))) (#$ . 25763)) #@294 Alist mapping interpreter names to major modes. This alist applies to files whose first line starts with `#!'. Each element looks like (INTERPRETER . MODE). The car of each element is compared with the name of the interpreter specified in the first line. If it matches, mode MODE is selected. (defconst interpreter-mode-alist (quote (("perl" . perl-mode) ("wish" . tcl-mode) ("wishx" . tcl-mode) ("tcl" . tcl-mode) ("tclsh" . tcl-mode) ("awk" . awk-mode) ("nawk" . awk-mode) ("gawk" . awk-mode) ("scm" . scheme-mode))) (#$ . 28367)) #@68 List of regexps; if one matches a file name, don't look for `-*-'. (defconst inhibit-first-line-modes-regexps (quote ("\\.tar\\'")) (#$ . 28906)) #@218 List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'. When checking `inhibit-first-line-modes-regexps', we first discard from the end of the file name anything that matches one of these regexps. (defconst inhibit-first-line-modes-suffixes nil (#$ . 29059)) #@62 File name including directory of user's initialization file. (defvar user-init-file "" (#$ . 29344)) #@466 Select major mode appropriate for current buffer. This checks for a -*- mode tag in the buffer's text, compares the filename against the entries in `auto-mode-alist', or checks the interpreter that runs this file against `interpreter-mode-alist'. It does not check for the `mode:' local variable in the Local Variables section of the file; for that, use `hack-local-variables'. If `enable-local-variables' is nil, this function does not check for a -*- mode tag. (defalias 'set-auto-mode #[nil "À‰‰‰ŠebˆÅÀwˆƒûƒ#É!‚%Ê  \f ‰ƒDÏ@ \"„DA‰„1)ƒU Љ”O ‚)\fƒmÏ\f@ \"„m\fA‰\f„Z\f*„ûÑÒŠÓÔ!…}Õˆ`)Ö#ƒû×Àwˆ`ÑÒŠÀˆ`)Ö#ƒûØuˆ×Àxˆ`\fbˆŠÑÙ Ö#)ƒðÖÓÛ!ƒ¾Ð•b†ÃÜÝ Ö#)ƒû×Àwˆ`ÑÞ Ö#ƒÛßuˆ‚Þ bˆ×Àxˆà\f`{—áP! B‚¯à\f {—áP! B) ƒâã \"ˆÖ\n?…½…½Ö$ É ! $…¼À$%À&'(é>&„~'ƒ~Ï'@@ \"ƒv'@A:ƒmÕ'@8ƒm'@A@& Љ”O Ö$‚v'@A&À$'A'‚3)&ƒ‹& ˆ‚¸ŠebˆÓê!ƒë”ë•{‚žì)À-.ïð.!1\"‰-ƒ·-A ˆ**‚*,‡" [nil modes done end beg " \n" enable-local-variables inhibit-first-line-modes-regexps buffer-file-name file-name-sans-versions buffer-name name temp inhibit-first-line-modes-suffixes sufs string-match 0 search-forward "-*-" looking-at "^#!" 2 t " " -3 ":" case-fold-search "mode:" re-search-forward "[ ;]mode:" ";" -1 intern "-mode" mapcar funcall keep-going auto-mode-alist mode alist system-type (vax-vms windows-nt) "#! *\\([^ \n]+\\)" 1 "" elt interpreter assoc file-name-nondirectory interpreter-mode-alist] 5 (#$ . 29452)]) (defalias 'hack-local-variables-prop-line #[nil "ŠebˆÀŠÁÂ!… È`)ÆÇ\fÈ#ƒwÁÉ!„wŠÆÇ\fÈ#ƒ1`ÊZ‚5ËÌ!ˆ)`\fWƒtÁÍ!„FËÎ!ˆÏ•bˆÐєѕ{!Œ`\f}ˆÒp!)‰Õ=„lB BÖÀwˆ*‚6 Ÿ …¡È=„Œ…¡Ø‹…¡ …¡Ù @@ @A\"ˆ A‰„À+‡" [nil looking-at "^#!" 2 end result search-forward "-*-" t "[ ]*\\([^ \n :;]+\\)\\([ ]*-\\*-\\)" 3 error "-*- not terminated before end of line" "[ ]*\\([^ \n:]+\\)[ ]*:[ ]*" "malformed -*- line" 0 intern 1 read val key mode " ;" enable-local-variables ((byte-code "ÀÁˆÃÄÅÆ!\"!‡" [nil (byte-code "Àp!‡" [switch-to-buffer] 2) ((error (byte-code "ÀÁ‡" [nil (byte-code "Àp!‡" [switch-to-buffer-other-window] 2) ((error (byte-code "Àp!‡" [switch-to-buffer-other-frame] 2)))] 3))) y-or-n-p format "Set local variables as specified in -*- line of %s? " file-name-nondirectory buffer-file-name] 5)) hack-one-local-variable] 5]) #@192 Normal hook run after processing a file's local variables specs. Major modes can use this to examine user-specified local variables in order to initialize other data structure based on them. (defvar hack-local-variables-hook nil (#$ . 31807)) #@63 Parse and put into effect this buffer's local variables spec. (defalias 'hack-local-variables #[nil "À ˆŠdbˆÁÂdÃZe]Ä#ˆÅÇÈÉÅ#…*\nÅ=†*\n…*Ë‹)ƒÅɉ‰‰\f\f ÒÉwˆl„Q`Ɉ`{Ó”bˆn„a`Óyˆ`{ƒqGÔ!ƒ~Ô!ÕPƒƒ×Ø!ˆ‚’Ùyˆƒ©Ú!ƒ¥uˆ‚©ÛÜ!ˆÒÉwˆ` ÝÉwˆlƒ¼ÛÞ!ˆÒÉxˆ `{à!!É\"—㘃ÝÉ‚\fäÉwˆÙuˆàp!\"åÉxˆÒÉwˆƒýÚ!‚þl„Ûæ!ˆç!\"\"ˆ+‚~.)èé!‡" [hack-local-variables-prop-line search-backward "\n\f" 3000 move t case-fold-search search-forward "Local Variables:" nil enable-local-variables ((byte-code "Àp!ˆŠÁyˆÂà `\"ˆ)ÄÅƃÈ!‚\"ÉÊ P\"!‡" [switch-to-buffer 0 set-window-start selected-window y-or-n-p format "Set local variables as specified at end of %s? " buffer-file-name file-name-nondirectory "buffer " buffer-name] 5)) enable-local-eval beg suffix prefixlen prefix continue " " 0 regexp-quote "$" selective-display re-search-forward "[\n ]" 1 looking-at error "Local variables entry is missing the prefix" "^:\n" "Missing colon in local variables entry" str read var val "end" "^:" "\n" "Local variables entry is terminated incorrectly" hack-one-local-variable run-hooks hack-local-variables-hook] 6 (#$ . 32056)]) #@58 Variables to be ignored in a file's local variable spec. (defconst ignored-local-variables (quote (enable-local-eval)) (#$ . 33236)) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#ˆÀÉÂÃ#ˆÀÊÂÃ#ˆÀËÂÃ#ˆÀÌÂÃ#ˆÀÍÂÃ#ˆÀÎÂÃ#ˆÀÏÂÃ#ˆÀÐÂÃ#ˆÀÑÂÃ#ˆÀÒÂÃ#ˆÀÓÔÃ#‡" [put debugger risky-local-variable t enable-local-eval ignored-local-variables eval file-name-handler-alist minor-mode-map-alist after-load-alist buffer-file-name buffer-auto-save-file-name buffer-file-truename exec-path load-path exec-directory process-environment outline-level rmail-output-file-alist compile-command safe-local-variable] 4) (defalias 'hack-one-local-variable-quotep #[(exp) ":…@Á=…A:‡" [exp quote] 2]) (defalias 'hack-one-local-variable #[(var val) "Á=ƒÂÃ\f!—ÅP! ‡>ƒLJÈN„.ÉÊÃ!\"ƒ™ËN„™Ì=ƒi\f:ƒi\f@Í=ƒiÎ\fA@!ƒiÎÏ\f8!ƒiÐ\f8§„_Ð\f8ÑšƒiÏ\f8A@Ò>„Ó ÔU„•Ö=„ƒ•×‹ƒ•Ì=ƒŠÌ\f!)‡Ø!ˆ\fL‡ÙÚ!‡Ø!ˆ\fL‡" [var mode intern symbol-name val "-mode" ignored-local-variables nil risky-local-variable string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$" safe-local-variable eval put hack-one-local-variable-quotep 2 3 (quote defun) (lisp-indent-hook) user-uid 0 enable-local-eval t ((byte-code "Àp!ˆŠÁyˆÂà `\"ˆ)ÄÅÆÇ!\"!‰ ‡" [switch-to-buffer 0 set-window-start selected-window y-or-n-p format "Process `eval' or hook local variables in file %s? " file-name-nondirectory buffer-file-name enable-local-eval] 5)) make-local-variable message "Ignoring `eval:' in file's local variables"] 4]) #@321 Change name of file visited in current buffer to FILENAME. The next time the buffer is saved it will go in the newly specified file. nil or empty string as argument means make buffer not be visiting any file. Remember to delete the initial contents of the minibuffer if you wish to pass an empty string as the argument. (defalias 'set-visited-file-name #[(filename) "À ƒ ÁÂ!ˆÃ ƒ Ƙ?…Ç ! ƒ)È ! ƒ)\f \nš„; ƒ8Ë !ˆÌ ˆ \n ƒsÍ\n!‰ƘƒRÁÏ!ˆÑ=ƒ^—Ò\n!Ô ˜„rÕÖ\"ˆ)ÃØ ˆ\fƒ‹Ù\f! ƒ‹\n …•ÛÜ\n!›)Þß!ˆÞà!ˆÞá!ˆÞâ!ˆ#ƒ°Ã$Þã!ˆ%\n!„Ãæâ!ˆÖ\"'('„Ý\nƒá)ƒáêÖ!ˆ‚áë '(ƒú'ƒúì(!ƒúí('Ö#ˆ)\n…îÖ!‡" [buffer-base-buffer error "An indirect buffer cannot visit a file" nil truename filename "" expand-file-name file-truename find-file-visit-truename buffer-file-name lock-buffer unlock-buffer file-name-nondirectory new-name "Empty file name" system-type vax-vms file-name-directory default-directory buffer-name rename-buffer t buffer-backed-up clear-visited-file-modtime abbreviate-file-name buffer-file-truename 10 file-attributes buffer-file-number kill-local-variable write-file-hooks local-write-file-hooks revert-buffer-function backup-inhibited vc-mode buffer-read-only backup-enable-predicate make-local-variable buffer-auto-save-file-name oauto auto-save-default auto-save-mode make-auto-save-file-name file-exists-p rename-file set-buffer-modified-p] 5 (#$ . 34745) "FSet visited file name: "]) #@341 Write current buffer into file FILENAME. Makes buffer visit that file, and marks it not modified. If the buffer is already visiting a file, you can specify a directory name as FILENAME, to write a file of the same old name in that directory. If optional second arg CONFIRM is non-nil, ask for confirmation for overwriting an existing file. (defalias 'write-file #[(filename &optional confirm) "ƒ8Á˜„8Â!ƒ ƒÄ!Å !Pƒ4Ç!ƒ4ÈÉÊ\"!„4ËÌ!ˆÍ!ˆÎÏ!ˆÐ ‡" [filename "" file-directory-p buffer-file-name file-name-as-directory file-name-nondirectory confirm file-exists-p y-or-n-p format "File `%s' exists; overwrite? " error "Canceled" set-visited-file-name set-buffer-modified-p t save-buffer] 4 (#$ . 36199) (list (if buffer-file-name (read-file-name "Write file: " nil nil nil nil) (read-file-name "Write file: " (cdr (assq (quote default-directory) (buffer-local-variables))) nil nil (buffer-name))) t)]) #@344 Make a backup of the disk file visited by the current buffer, if appropriate. This is normally done before saving the buffer the first time. If the value is non-nil, it is the result of `file-modes' on the original file; this means that the caller, after saving the buffer, should change the modes of the new file to agree with the old modes. (defalias 'backup-buffer #[nil "…N ?…N\n?…NÃ\f!…NÅ\f!ÆœÇHÈ>…N\fɉ‰‰\n \f Ï!Ð!‰ @\f A  …MÉÑÒ-‡" [make-backup-files backup-inhibited buffer-backed-up file-exists-p buffer-file-name file-attributes 8 0 (45 108) nil setmodes targets backupname backup-info real-file-name file-chase-links find-backup-file-name (byte-code "… Â=„ Ã=… †ÄÅÆ\"!ÃÈɈÂ\n ƒ8ƒ8ÃË̈A‰„, )‡" [targets delete-old-versions t nil y-or-n-p format "Delete excess backup versions of %s? " real-file-name (byte-code "„- „-\nƒÃ\f!ÅV„-ƒ5Ç\f!É8†)Ê\f!?)ƒ5ËÌ͈‚BÎ\fÐ#ˆÑ!ˇ" [file-precious-flag backup-by-copying backup-by-copying-when-linked file-nlinks real-file-name 1 backup-by-copying-when-mismatch file-attributes attr 9 file-ownership-preserved-p nil (byte-code "À \nÉ$‡" [copy-file real-file-name backupname t] 5) ((file-error (byte-code "À !ƒ !„à !ˆÄ Ɖ$‡" [file-exists-p backupname file-writable-p delete-file copy-file real-file-name t] 5))) rename-file backupname t file-modes setmodes] 4) ((file-error (byte-code "ÀÁ!ÃÄ!ˆÅÆ!ˆÇÈɇ" [expand-file-name "~/%backup%~" backupname message "Cannot write backup file; backing up in ~/%%backup%%~" sleep-for 1 nil (byte-code "À \nÉ$‡" [copy-file real-file-name backupname t] 5) ((file-error (byte-code "À !ƒ !„à !ˆÄ Ɖ$‡" [file-exists-p backupname file-writable-p delete-file copy-file real-file-name t] 5)))] 3))) buffer-backed-up (byte-code "À @!‡" [delete-file targets] 2) ((file-error)) setmodes] 5) ((file-error))] 6 (#$ . 37119)]) #@260 Return FILENAME sans backup versions or strings. This is a separate procedure so your site-init or startup file can redefine it. If the optional argument KEEP-BACKUP-VERSION is non-nil, we do not remove backup version numbers, only true file version numbers. (defalias 'file-name-sans-versions #[(name &optional keep-backup-version) "À Â\"‰ƒ  \f#‚L ÅÇ=ƒ2ÈÉ \"†KÈÊ \"ƒ-Ë”†K G‚K\fƒ; G‚KÈÌ \"†KÈÍ \"†K GO)‡" [find-file-name-handler name file-name-sans-versions handler keep-backup-version 0 system-type vax-vms string-match ";[-+]?[0-9]*\\'" "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'" 1 "\\.~[0-9.]+~\\'" "~\\'"] 6 (#$ . 39000)]) #@71 Returns t if deleting FILE and rewriting it would preserve the owner. (defalias 'file-ownership-preserved-p #[(file) "À Â\"‰ƒ  \"‚ Ä !‰?†Æ 8Ç U))‡" [find-file-name-handler file file-ownership-preserved-p handler file-attributes attributes 2 user-uid] 4 (#$ . 39642)]) #@111 Return FILENAME sans final "extension". The extension, in a file name, is the part that follows the last `.'. (defalias 'file-name-sans-extension #[(filename) "À ÂŽÃÄ !!ÆÉÊ\"ƒ6Ë !‰ƒ-Ì͉”O\"‚7͉”O‚7 ,‡" [match-data match-data ((store-match-data match-data)) file-name-sans-versions file-name-nondirectory filename nil directory file string-match "\\.[^.]*\\'" file-name-directory expand-file-name 0] 4 (#$ . 39925)]) #@121 Create the non-numeric backup file name for FILE. This is a separate function so you can redefine it for customization. (defalias 'make-backup-file-name #[(file) "Á=ƒ !Å !ÆÇ\f\"…\fÈÉ•OÊQ)‡ ËP‡" [system-type ms-dos file-name-nondirectory file fn file-name-directory string-match "\\([^.]*\\)\\(\\..*\\)?" 0 1 ".bak" "~"] 4 (#$ . 40367)]) #@194 Return non-nil if FILE is a backup file name (numeric or not). This is a separate function so you can redefine it for customization. You may need to redefine `file-name-sans-versions' as well. (defalias 'backup-file-name-p #[(file) "Á=ƒ ÂÃ\f\"‡ÂÅ\f\"‡" [system-type ms-dos string-match "\\.bak$" file "~$"] 3 (#$ . 40718)]) #@181 Given the name of a numeric backup file, return the backup number. Uses the free variable `bv-length', whose value should be the index in the name where the version number begins. (defalias 'backup-extract-version #[(fn) "ÀÁ\n #ƒÄ” UƒÅ\n ÆO!‡Ä‡" [string-match "[0-9]+~$" fn bv-length 0 string-to-int -1] 4 (#$ . 41051)]) #@235 Find a file name for a backup file, and suggestions for deletions. Value is a list whose car is the name for the backup file and whose cdr is a list of old versions to consider deleting now. If the value is nil, don't make a backup. (defalias 'find-backup-file-name #[(fn) "À Â\"‰ƒ  \"‚}\fÅ=ƒÆ !C‚}Ç !ÈP‰ G\nË\fË ÎËÎËÒÓˆ„HÆ !C‚{ ÈÔT!ÕRÎV…zØ\\\\ÎY…zÙÚ ›S›Ë¡ˆ)\"B.)‡" [find-file-name-handler fn find-backup-file-name handler version-control never make-backup-file-name file-name-nondirectory ".~" base-versions bv-length nil possibilities versions 0 high-water-mark deserve-versions-p number-to-delete (byte-code "À  !\"ÅÆÇ\f\"È\" ÊËÌ # †! ÌV GZZÒZÀ‡" [file-name-all-completions base-versions file-name-directory fn possibilities sort mapcar backup-extract-version < versions apply max 0 high-water-mark version-control deserve-versions-p kept-old-versions kept-new-versions -1 number-to-delete] 4) ((file-error (byte-code "ÀÀ‡" [nil possibilities] 1))) int-to-string "~" kept-new-versions kept-old-versions -1 mapcar #[(n) "Á !ÄR‡" [fn ".~" int-to-string n "~"] 4] v] 6 (#$ . 41383)]) #@43 Return number of names file FILENAME has. (defalias 'file-nlinks #[(filename) "À !A@‡" [file-attributes filename] 2 (#$ . 42540)]) #@76 Convert FILENAME to be relative to DIRECTORY (default: default-directory). (defalias 'file-relative-name #[(filename &optional directory) "À !ÂÀ † \f!!ÅÇÈÉ !P \"„,Ê ËÌO!ÍP‚ Ë•ÎOP)‡" [expand-file-name filename file-name-as-directory directory default-directory "" ancestor string-match "^" regexp-quote file-name-directory 0 -1 "../" nil] 4 (#$ . 42677)]) #@1266 Save current buffer in visited file if modified. Versions described below. By default, makes the previous version into a backup file if previously requested or if this is the first save. With 1 or 3 \[universal-argument]'s, marks this version to become a backup when the next save is done. With 2 or 3 \[universal-argument]'s, unconditionally makes the previous version into a backup file. With argument of 0, never makes the previous version into a backup file. If a file's name is FOO, the names of its numbered backup versions are FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. Numeric backups (rather than FOO~) will be made if value of `version-control' is not the atom `never' and either there are already numeric versions of the file being backed up, or `version-control' is non-nil. We don't want excessive versions piling up, so there are variables `kept-old-versions', which tells Emacs how many oldest versions to keep, and `kept-new-versions', which tells how many newest versions to keep. Defaults are 2 old versions and 2 new. `dired-kept-versions' controls dired's clean-directory (.) command. If `delete-old-versions' is nil, system will query user before trimming versions. Otherwise it does it silently. (defalias 'save-buffer #[(&optional args) "À Á ÂV ƒ\fÅ=?†\fÆ>‰ƒ&\fÉ>ƒ&Ê ƒ6ƒ6ÌÍÎ \"ˆÏ ˆ…H\fÐ>…Hʉ +‡" [buffer-modified-p buffer-size 50000 make-backup-files args 0 (16 64) large modp (16 64) nil buffer-backed-up message "Saving file %s..." buffer-file-name basic-save-buffer (4 64)] 5 (#$ . 43055) "p"]) #@213 Delete auto-save file for current buffer if `delete-auto-save-files' is t. Normally delete only if the file was written by this Emacs since the last real save, but optional arg FORCE non-nil means delete anyway. (defalias 'delete-auto-save-file-if-necessary #[(&optional force) "… …\n˜?… „Ä …ÅÆÇˆÈ ‡" [buffer-auto-save-file-name delete-auto-save-files buffer-file-name force recent-auto-save-p nil (delete-file buffer-auto-save-file-name) ((file-error)) set-buffer-auto-saved] 3 (#$ . 44653)]) #@62 Normal hook that is run after a buffer is saved to its file. (defvar after-save-hook nil (#$ . 45166)) #@119 Save the current buffer in its visited file, if it has been modified. After saving the buffer, run `after-save-hook'. (defalias 'basic-save-buffer #[nil "ŠÀ ƒ\nÀ qˆÁ ƒ ÉÈ=ƒJ Ê !˜„JÃ Ê ! Ì —! Î ! Ï !ˆ)Ð !ˆ) „rÑÒÓ!Ã\"Õ!ƒlÖ×Ø\"!„lÙÚ!ˆÛ!ˆ)Üp!„Õ !ƒÝ×Þß !\"!„Ùà!ˆŒ~ˆdáVƒÍdSfâU„Í#ä=ƒ¯dSfåU„Í&ä=„Å&ƒÍÖ×çÎ \"!ƒÍŠdbˆâcˆ)èé!„âèê!„âèë!„âì âí !›. ƒóÃïðˆ)ñ!ˆò ˆóô!+‚õö!)‡" [buffer-base-buffer buffer-modified-p recent-auto-save-p nil tempsetmodes setmodes recent-save system-type vax-vms buffer-file-name file-name-sans-versions buffer-new-name create-file-buffer buf buffer-name kill-buffer rename-buffer expand-file-name read-file-name "File to save in: " filename file-exists-p y-or-n-p format "File `%s' exists; overwrite? " error "Canceled" set-visited-file-name verify-visited-file-modtime yes-or-no-p "%s has changed since visited or saved. Save anyway? " file-name-nondirectory "Save not confirmed" 1 10 selective-display t 13 require-final-newline "Buffer %s does not end in newline. Add one? " run-hook-with-args-until-success write-contents-hooks local-write-file-hooks write-file-hooks basic-save-buffer-1 file-attributes buffer-file-number (set-file-modes buffer-file-name setmodes) ((error)) delete-auto-save-file-if-necessary vc-after-save run-hooks after-save-hook message "(No changes need to be saved)"] 5 (#$ . 45276) nil]) (defalias 'basic-save-buffer-1 #[nil "À‰Ã\f!„CÅ\f!Ç!„ÈÉ\"ˆ‚BÊ\f!„.ÈË\"ˆ‚BÌÍÎÏ\f!\"!ƒ>ЂBÈÑ!ˆ)„KÓ Å\f!ƒºÃ!ƒº\fÀ‰‰‰‰Õ ÝЃ”ÍÞ#Ê!T‚xßŽà ˆáedÀ\"&ˆÐ)ã\f!ä\fÐ#ˆ.‚Ö\nƒË „Ëã\f!å\fæ\"ˆáed\fÀÐ\"&ˆ) *‡" [nil setmodes tempsetmodes file-writable-p buffer-file-name file-name-directory dir file-directory-p error "%s is not a directory" file-exists-p "Directory %s write-protected" yes-or-no-p format "File %s is write-protected; try to save anyway? " file-name-nondirectory t "Attempt to save to a file which you aren't allowed to write" buffer-backed-up backup-buffer file-precious-flag visited-file-modtime old-modtime succeed i nogood temp tempname realname 0 "%s#tmp#%d" ((byte-code "„\fÁ\n!ˆÃ\f!ˆÁ‡" [succeed delete-file tempname set-visited-file-modtime old-modtime] 2)) clear-visited-file-modtime write-region buffer-file-truename file-modes rename-file set-file-modes 511] 7]) #@249 Save some modified file-visiting buffers. Asks user about each one. Optional argument (the prefix) non-nil means save all with no questions. Optional second argument EXITING means ask about certain non-file buffers as well as about file buffers. (defalias 'save-some-buffers #[(&optional arg exiting) "À‹‡" [((byte-code "ÀÁÂà ÄÅÆÇEC%…- …-\n„%ËÌÍ\"!ƒ)ÏÐ!ˆÐ щÔV†?†?ÕÖ!*‡" [map-y-or-n-p #[(buffer) "À !…? !?…?à !„%\f…? qˆ …?Æ ÇV…?ƒ,ɇà !ƒ9ÊËà !\"‡ÊÌÍ !\"‡" [buffer-modified-p buffer buffer-base-buffer buffer-file-name exiting buffer-offer-save buffer-size 0 arg t format "Save file %s? " "Save buffer %s? " buffer-name] 4] #[(buffer) "qˆÁ ‡" [buffer save-buffer] 1] buffer-list ("buffer" "buffers" "save") 18 #[(buf) "À !ˆÂÄ ˆÅ‡" [view-buffer buf (lambda (ignore) (exit-recursive-edit)) view-exit-action recursive-edit nil] 2] "display the current buffer" save-abbrevs abbrevs-changed arg y-or-n-p format "Save abbrevs in %s? " abbrev-file-name write-abbrev-file nil t abbrevs-done files-done 0 message "(No files need saving)"] 9))] 1 (#$ . 47638) "P"]) #@280 Mark current buffer as unmodified, not needing to be saved. With prefix arg, mark buffer as modified, so \[save-buffer] will save. It is not a good idea to use this function in Lisp programs, because it prints a message in the minibuffer. Instead, use `set-buffer-modified-p'. (defalias 'not-modified #[(&optional arg) "À ƒ ‚\nÃ!ˆÄ !‡" [message arg "Modification-flag set" "Modification-flag cleared" set-buffer-modified-p] 2 (#$ . 48733) "P"]) #@105 Change whether this buffer is visiting its file read-only. With arg, set read-only iff arg is positive. (defalias 'toggle-read-only #[(&optional arg) "„ ?‚Â!ÃVÄ ‡" [arg buffer-read-only prefix-numeric-value 0 force-mode-line-update] 2 (#$ . 49190) "P"]) #@278 Insert contents of file FILENAME into buffer after point. Set mark after the inserted text. This function is meant for the user to run interactively. Don't call it from programs! Use `insert-file-contents' instead. (Its calling sequence is different; see its documentation). (defalias 'insert-file #[(filename) "À !ƒÂÃÄÅ E\"ˆÆ !È`A@\\!)‡" [file-directory-p filename signal file-error "Opening input file" "file is a directory" insert-file-contents tem push-mark] 5 (#$ . 49458) "*fInsert file: "]) #@206 Append the contents of the region to the end of file FILENAME. When called from a function, expects three arguments, START, END and FILENAME. START and END are buffer positions saying what text to write. (defalias 'append-to-file #[(start end filename) "À \n Ä$‡" [write-region start end filename t] 5 (#$ . 49971) "r\nFAppend to file: "]) #@73 Return most recent backup file for FILENAME or nil if no backups exist. (defalias 'file-newest-backup #[(filename) "À ! !Ä !Æ \"È ƒ> @PAÊ !ƒ ƒ8Ë  \"ƒ  ‚ -‡" [expand-file-name filename file-name-nondirectory file file-name-directory dir file-name-all-completions comp nil newest backup-file-name-p file-newer-than-file-p] 3 (#$ . 50318)]) #@159 Rename current buffer to a similar name not already taken. This function is useful for creating multiple shell process buffers or multiple mail buffers, etc. (defalias 'rename-uniquely #[nil "À ÂŽÃÄÅ \"ƒ%ƒÅ Ç!˜„%Šȉ”O‚'Å  Ê ! Å !\fÍ !ˆÎ\f!ˆÏ -‡" [match-data match-data ((store-match-data match-data)) string-match "<[0-9]+>\\'" buffer-name buffer-file-name file-name-nondirectory 0 base-name generate-new-buffer new-buf name kill-buffer rename-buffer force-mode-line-update] 3 (#$ . 50692) nil]) #@358 Create the directory DIR and any nonexistent parent dirs. Interactively, the default choice of directory to create is the current default directory for file names. That is useful when you have visited a file in a nonexistint directory. Noninteractively, the second (optional) argument PARENTS says whether to create parent directories if they don't exist. (defalias 'make-directory #[(dir &optional parents) "À Â\"‰ƒ  \f#‚O\f„Å !‚OÆÇ !!È Ê !„9  B ÆË !!‚$ …NÅ @!ˆ A‰ „>È*)‡" [find-file-name-handler dir make-directory handler parents make-directory-internal directory-file-name expand-file-name nil create-list file-exists-p file-name-directory] 5 (#$ . 51213) (list (read-file-name "Make directory: " default-directory default-directory nil nil) t)]) (put (quote revert-buffer-function) (quote permanent-local) t) #@184 Function to use to revert this buffer, or nil to do the default. The function receives two arguments IGNORE-AUTO and NOCONFIRM, which are the arguments that `revert-buffer' received. (defvar revert-buffer-function nil (#$ . 52056)) (put (quote revert-buffer-insert-file-contents-function) (quote permanent-local) t) #@160 Function to use to insert contents when reverting this buffer. Gets two args, first the nominal file name to use, and second, t if reading the auto-save file. (defvar revert-buffer-insert-file-contents-function nil (#$ . 52379)) #@158 Normal hook for `revert-buffer' to run before reverting. If `revert-buffer-function' is used to override the normal revert mechanism, this hook is not used. (defvar before-revert-hook nil (#$ . 52615)) #@311 Normal hook for `revert-buffer' to run after reverting. Note that the hook value that it runs is the value that was in effect before reverting; that makes a difference if you have buffer-local hook functions. If `revert-buffer-function' is used to override the normal revert mechanism, this hook is not used. (defvar after-revert-hook nil (#$ . 52824)) #@804 Replace the buffer text with the text of the visited file on disk. This undoes all changes since the file was visited or saved. With a prefix argument, offer to revert from latest auto-save file, if that is more recent than the visited file. When called from Lisp, the first argument is IGNORE-AUTO; only offer to revert from the auto-save file when this is nil. Note that the sense of this argument is the reverse of the prefix argument, for the sake of backward compatibility. IGNORE-AUTO is optional, defaulting to nil. Optional second argument NOCONFIRM means don't ask for confirmation at all. If the value of `revert-buffer-function' is non-nil, it is called to do the work. The default revert function runs the hook `before-revert-hook' at the beginning and `after-revert-hook' at the end. (defalias 'revert-buffer #[(&optional ignore-auto noconfirm) "ƒ  \n\"‡` ?…\"Ä …\" …\"Æ !…\"ÇÈ!‰ ƒ, ‚.\n‰ „:ÌÍ!‚é\n„HÎÏÐ \"!…éÑÒ!ˆ „ZÓp!„ZÔ×=„dÔØÙ!ÚÙ!ÚÙ!…rÔ׃Ž  \"ˆ‚´à !„›Ìá \"ˆÔ\n „¦â ˆ)~ˆã  ?Ô‰×%ˆ* d^bˆäå\n!!&çԉ׉$ˆèé\"ˆƒßêé!ˆ)‚ãëé!ˆÑé!ˆ+×+‡" [revert-buffer-function ignore-auto noconfirm opoint recent-auto-save-p buffer-auto-save-file-name file-readable-p y-or-n-p "Buffer has been auto-saved recently. Revert from auto-save file? " auto-save-p buffer-file-name file-name error "Buffer does not seem to be associated with any file" yes-or-no-p format "Revert buffer from file %s? " run-hooks before-revert-hook verify-visited-file-modtime nil buffer-backed-up buffer-undo-list t default-value after-revert-hook local-variable-p local-hook local-hook-p global-hook buffer-read-only revert-buffer-insert-file-contents-function file-exists-p "File %s no longer exists!" unlock-buffer insert-file-contents abbreviate-file-name file-truename buffer-file-truename after-find-file set-default revert-buffer-internal-hook make-local-variable kill-local-variable] 7 (#$ . 53185) (list (not current-prefix-arg))]) #@65 Visit file FILE, but get contents from its last auto-save file. (defalias 'recover-file #[(file) "À !Âà !!ƒÄÅ \"ˆ Ç )É !ƒ(Ê \"?‚-É!?ƒ8ÄË\"‚\\Ì‹ƒYÍÎ Ï\"!ˆÐÒ ˆÓÐ\"ˆ)ÔЉÏ#‚\\ÄÕ!)‡" [expand-file-name file auto-save-file-name-p file-name-nondirectory error "%s is an auto-save file" buffer-file-name make-auto-save-file-name file-name file-exists-p file-newer-than-file-p "Auto-save file %s not current" ((byte-code "Á=„%ÂÃ\f!ˆÅÆÇ\fÇÈ !ƒÊ‚Ë \f&‘ˆÍÎÏ\f\"!‡" [system-type vax-vms "*Directory*" buffer-disable-undo standard-output call-process "ls" nil file-symlink-p file "-lL" "-l" file-name yes-or-no-p format "Recover auto save file %s? "] 9)) switch-to-buffer find-file-noselect t nil buffer-read-only erase-buffer insert-file-contents after-find-file "Recover-file cancelled."] 4 (#$ . 55171) "fRecover file: "]) #@287 Recover auto save files from a previous Emacs session. This command first displays a Dired buffer showing you the previous sessions that you could recover from. To choose one, move point to the proper line and then type C-c C-c. Then you'll be asked about a number of files to recover. (defalias 'recover-session #[nil "À ÂP!ˆebˆÃÄ!„ÅÇÈÉʱˆ)ËÌ Í ¤!ˆÎÍ ÏÐ#‡" [dired auto-save-list-file-prefix "*" looking-at "Move to the session you want to recover," t inhibit-read-only "Move to the session you want to recover,\n" "then type C-c C-c to select it.\n\n" "You can also delete some of these files;\n" "type d on a line to mark that file for deletion.\n\n" use-local-map make-sparse-keymap current-local-map define-key "" recover-session-finish] 4 (#$ . 56024) nil]) #@139 Choose one saved session to recover auto-save files from. This command is used in the special Dired buffer created by \[recover-session]. (defalias 'recover-session-finish #[nil "À ÁÂÃ!ÇÈ!ˆÉŽŠ\fqˆÊ ˆË!ˆm„uÁ‰\f lƒMÎyˆÏ`ŠÁˆ`)\"\fÐÑ\f!ÎÒOÓ\f!\" Îyˆ‚eÏ`Áˆ`\" ÎyˆÏ`Áˆ`\"\fÎyˆÔ\f!ƒq B*‚ Ÿ‰ƒ…ÕÖ× Ø$‚ˆÙÚ!-‡" [dired-get-filename nil get-buffer-create " *recover*" buffer files file dired-do-flagged-delete t ((kill-buffer buffer)) erase-buffer insert-file-contents autofile thisfile 1 buffer-substring-no-properties expand-file-name file-name-nondirectory -1 file-name-directory file-exists-p map-y-or-n-p "Recover %s? " #[(file) "ÀÁ‡" [nil (byte-code "ŠÀ !)‡" [recover-file file] 2) ((error file))] 3] ("file" "files" "recover") message "No files can be recovered from this session now"] 6 (#$ . 56801) nil]) #@42 For each buffer, ask whether to kill it. (defalias 'kill-some-buffers #[nil "À ‰…= @Ã\n!‰Ř„4\fÆHÇU„4ÈÉÊ\fË\n!ƒ*Ì‚+Í#!ƒ4Î\n!ˆ* A‰„Ï)‡" [buffer-list list buffer buffer-name name "" 0 32 yes-or-no-p format "Buffer %s %s. Kill? " buffer-modified-p "HAS BEEN EDITED" "is unmodified" kill-buffer nil] 7 (#$ . 57640) nil]) #@120 Toggle auto-saving of contents of current buffer. With prefix argument ARG, turn auto-saving on if positive, else off. (defalias 'auto-save-mode #[(arg) "„ ƒ$\nÃW‚!Ä=„$<„$¨…8ÃV…8 ƒ6ƒ6„6 ‚8È \nÃWƒAÃtƒRÉÊ ƒOË‚PÌ\"ˆ ‡" [arg buffer-auto-save-file-name buffer-saved-size 0 t buffer-file-name auto-save-visited-file-name buffer-read-only make-auto-save-file-name message "Auto-save %s (in this buffer)" "on" "off"] 3 (#$ . 57977) "P"]) #@142 Adjust current buffer's auto save file name for current conditions. Also rename any existing auto save file, if it was made in this session. (defalias 'rename-auto-save-file #[nil "  …+…+ ˜?…+ ˜?…+Ä !…+Å …+Æ Ç#)‡" [buffer-auto-save-file-name osave make-auto-save-file-name buffer-file-name file-exists-p recent-auto-save-p rename-file t] 4 (#$ . 58441)]) #@241 Return file name to use for auto-saves of current buffer. Does not consider `auto-save-visited-file-name' as that variable is checked before calling this function. You can redefine this for customization. See also `auto-save-file-name-p'. (defalias 'make-auto-save-file-name #[nil "ƒÁ!ÂÃ!ÂR‡Ä ÅÇÈ\f#ƒA\fʼn”O\fŔŕOɘƒ1Ê‚2Ë\fÅ•ÌOQÅ•T‚ÍÎÏ\fÐÑ!#!*‡" [buffer-file-name file-name-directory "#" file-name-nondirectory buffer-name 0 limit string-match "[/\\]" "/" "\\!" "\\\\" nil expand-file-name format "#%s#%s#" make-temp-name ""] 6 (#$ . 58817)]) #@146 Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. FILENAME should lack slashes. You can redefine this for customization. (defalias 'auto-save-file-name-p #[(filename) "ÀÁ\n\"‡" [string-match "^#.*#$" filename] 3 (#$ . 59387)]) #@65 *Switches for list-directory to pass to `ls' for brief listing, (defconst list-directory-brief-switches (byte-code "Á=ƒ‡Ç" [system-type vax-vms "" "-CF"] 2) (#$ . -59644)) #@67 *Switches for list-directory to pass to `ls' for verbose listing, (defconst list-directory-verbose-switches (byte-code "Á=ƒ‡Ç" [system-type vax-vms "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)" "-l"] 2) (#$ . -59827)) #@283 Display a list of files in or matching DIRNAME, a la `ls'. DIRNAME is globbed by the shell if necessary. Prefix arg (second arg if noninteractive) means supply -l switch to `ls'. Actions controlled by variables `list-directory-brief-switches' and `list-directory-verbose-switches'. (defalias 'list-directory #[(dirname &optional verbose) "ƒ ‚ \n\f„ Æ\f!ÇÈ !ˆÊË!ˆÊ\f!ˆÌ ˆŠÇqˆÍ\f!Î\f!?Ð\f ‰?$*‘)‡" [verbose list-directory-verbose-switches list-directory-brief-switches switches dirname default-directory expand-file-name "*Directory*" buffer-disable-undo standard-output princ "Directory " terpri file-name-directory file-directory-p wildcard insert-directory] 6 (#$ . 60058) (byte-code " ƒ Â\fÄÅÅ$ )D‡" [current-prefix-arg pfx read-file-name "List directory (verbose): " "List directory (brief): " nil default-directory] 5)]) #@75 Absolute or relative name of the `ls' program used by `insert-directory'. (defvar insert-directory-program "ls" (#$ . 60913)) #@539 Insert directory listing for FILE, formatted according to SWITCHES. Leaves point after the inserted text. SWITCHES may be a string of options, or a list of strings. Optional third arg WILDCARD means treat FILE as shell wildcard. Optional fourth arg FULL-DIRECTORY-P means file is a directory and switches do not contain `d', so that a full listing is expected. This works by running a directory listing program whose name is in the variable `insert-directory-program'. If WILDCARD, it also runs the shell specified by `shell-file-name'. (defalias 'insert-directory #[(file switches &optional wildcard full-directory-p) "ÀÁ\n!Ã\"‰ƒ\fÃ\n %‚ÝÉ=ƒ&Ê\n p#‚݃ŒË\n!ƒ7Ì\n!‚<ÌÁ\n!!Í\n!ÎÒÓ#ƒhΉ”OÔΔÕOQΕT‚FÖÕØÕÙÔÛ ;ƒ| ‚ÜÝ Þ#Þ°&+‚ÝßÖÕØÕ‰ <ƒ¡  ‚Ç áš„ÇÒÞ \"ƒÁ Ή”O B ΕÕO‚§  B â ƒ×ã\n!äP‚Ø\nC\")&)‡" [find-file-name-handler expand-file-name file insert-directory handler switches wildcard full-directory-p system-type vax-vms vms-read-directory file-name-absolute-p file-name-directory file-name-nondirectory 0 beg pattern default-directory string-match "[ \n;<>&|()#$]" "\\" nil call-process shell-file-name t "-c" insert-directory-program " -d " mapconcat identity " " apply list "" append file-name-as-directory "."] 14 (#$ . 61046)]) #@293 Functions to call with no arguments to query about killing Emacs. If any of these functions returns nil, killing Emacs is cancelled. `save-buffers-kill-emacs' (\[save-buffers-kill-emacs]) calls these functions, but `kill-emacs', the low level primitive, does not. See also `kill-emacs-hook'. (defvar kill-emacs-query-functions nil (#$ . 62351)) #@127 Offer to save each buffer, then kill this Emacs process. With prefix arg, silently save all file-visiting buffers, then kill. (defalias 'save-buffers-kill-emacs #[(&optional arg) "À Â\"ˆÂÃÄÅ \">ƒÆÇ!…fÈÉ!ƒ^É Ê ‰\fƒQÍ\f@!Î>ƒHÏ\f@!Ï\f@\"ˆ)ƒH \fA‰\f„& ?†ZÆÑ!*…fÒÓ!…fÔ ‡" [save-some-buffers arg t mapcar #[(buf) "À !…  !‡" [buffer-file-name buf buffer-modified-p] 2] buffer-list yes-or-no-p "Modified buffers exist; exit anyway? " fboundp process-list nil active processes process-status (run stop open) process-kill-without-query val "Active processes exist; kill them and exit anyway? " run-hook-with-args-until-failure kill-emacs-query-functions kill-emacs] 5 (#$ . 62703) "P"]) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀÓÔ#ˆÀ ÕÖ#ˆÀ ×Ø#ˆÀÚÛ#ˆÀÜÝ#ˆÀÂÛ#ˆÀÞß#ˆÀàá#ˆÀ\"Þã#ˆÀ\"Úä#ˆÀ\"Âä#ˆÀ\"Üå#‡" [define-key ctl-x-map "" find-file "" toggle-read-only "" find-file-read-only "" find-alternate-file "" save-buffer "s" save-some-buffers "" write-file "i" insert-file esc-map "~" not-modified "" list-directory "" save-buffers-kill-emacs ctl-x-4-map "f" find-file-other-window "r" find-file-read-only-other-window "b" switch-to-buffer-other-window "" display-buffer ctl-x-5-map switch-to-buffer-other-frame find-file-other-frame find-file-read-only-other-frame] 4) emacs-19.30/lisp/fill.elc100666 13437 1 41272 6053423365 13660 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 18 13:33:06 1995 ;;; from file /home/fsf/rms/e19/lisp/fill.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`fill.el' was compiled for Emacs 19.29 or later")) #@331 *Controls criterion for a new paragraph in `fill-individual-paragraphs'. Non-nil means changing indent doesn't end a paragraph. That mode can handle paragraphs with extra indentation on the first line, but it requires separator lines between paragraphs. A value of nil means that any change in indentation starts a new paragraph. (defconst fill-individual-varying-indent nil (#$ . -467)) #@56 *Non-nil means a single space does not end a sentence. (defconst sentence-end-double-space t (#$ . -861)) #@59 *Non-nil means put two spaces after a colon when filling. (defconst colon-double-space nil (#$ . -973)) #@45 Mode-specific function to fill a paragraph. (defvar fill-paragraph-function nil (#$ . 1083)) #@160 Set the fill prefix to the current line up to point. Filling expects lines to start with the fill prefix and reinserts the fill prefix in each resulting line. (defalias 'set-fill-prefix #[nil "ŠÀ ˆ`)`{‰šƒÃ ƒÄÅ \"‡ÄÆ!‡" [move-to-left-margin fill-prefix "" nil message "fill-prefix: \"%s\"" "fill-prefix cancelled"] 4 (#$ . 1183) nil]) #@67 *Non-nil means determine a paragraph's fill prefix from its text. (defconst adaptive-fill-mode t (#$ . -1530)) #@306 *Regexp to match text at start of line that constitutes indentation. If Adaptive Fill mode is enabled, whatever text matches this pattern on the second line of a paragraph is used as the standard indentation for the paragraph. If the paragraph has just one line, the indentation is taken from that line. (defconst adaptive-fill-regexp "[ ]*\\([#;>*]+ +\\)?" (#$ . -1648)) #@126 *Function to call to choose a fill prefix for a paragraph. This function is used when `adaptive-fill-regexp' does not match. (defvar adaptive-fill-function nil (#$ . -2029)) #@377 Return the fill-column to use for this line. The fill-column to use for a buffer is stored in the variable `fill-column', but can be locally modified by the `right-margin' text property, which is subtracted from `fill-column'. The fill column to use for a line is the first column at which the column number equals or exceeds the local fill-column - right-margin difference. (defalias 'current-fill-column #[nil "Š…XÁyˆ`ÁĈ`ÄÄÄÄ Ê\nË\"†*ÁZÌ\n Ë$‰ƒRSbˆi‰ WƒR ‚ ].)‡" [fill-column 0 here here-col nil eol margin fill-col change col get-text-property right-margin text-property-not-all] 6 (#$ . 2210)]) #@144 Remove extra spaces between words in region. Puts one space between words in region; two between sentences. Remove indentation from each line. (defalias 'canonically-space-region #[(beg end) "ŠbˆÁ\nÃÄ$ˆ`\nWƒSÅÆ\nÇ#ƒSÈ”ŠÉÊxˆ ƒ/hÌ>ƒ/Í‚Jƒ>hÏUƒ>Í‚JÐhÑ\"ƒIÈ‚JÒ)\\È•|ˆ‚ bˆ`\nW…kÅÓ\nÇ#…kÔÄ!ˆ‚V)‡" [beg subst-char-in-region end 9 32 re-search-forward " *" t 0 " ]})\"'" nil sentence-end-double-space (46 63 33) 2 colon-double-space 58 char-equal 10 1 "[.?!][])}\"']*$" insert-and-inherit] 5 (#$ . 2860) "r"]) #@254 Compute a fill prefix from the text between FROM and TO. This uses the variables `adapive-fill-prefix' and `adaptive-fill-function'. If FIRST-LINE-REGEXP is non-nil, then when taking a prefix from the first line, insist it must match FIRST-LINE-REGEXP. (defalias 'fill-context-prefix #[(from to &optional first-line-regexp) "Šbˆlƒ Áyˆ`‰Áyˆ`Yƒ! bˆ‚#ÇÈ ˆ`ŠÂˆ`) \nË\f!?…V ƒNË !ƒNÎ\nÏ•\"‚V…V ‰…m\f„lƒlÒ \"…m .‡" [from 1 nil result at-second firstline to t move-to-left-margin eol start looking-at paragraph-start adaptive-fill-regexp buffer-substring-no-properties 0 adaptive-fill-function first-line-regexp string-match] 4 (#$ . 3390)]) #@751 Fill the region as one paragraph. It removes any paragraph breaks in the region and extra newlines at the end, indents and fills lines between the margins given by the `current-left-margin' and `current-fill-column' functions. It leaves point at the beginning of the line following the paragraph. Normally performs justification according to the `current-justification' function, but with a prefix arg, does full justification instead. From a program, optional third arg JUSTIFY can specify any type of justification, and fourth arg NOSQUEEZE non-nil means not to make spaces between words canonical before filling. If `sentence-end-double-space' is non-nil, then period followed by one space does not end a sentence, so don't break a line there. (defalias 'fill-region-as-paragraph #[(from to &optional justify nosqueeze) "ƒÁ=„`B\n ^bˆ\n ]ÄÅwˆ`ÅÈyˆ` bˆ`\nVƒZ`SfÉ=ƒZƒP\nƒIË`SÌ\"„PÍÎ!ˆ‚)ÏÎ!ˆÁ‚)`„k VƒkÐ ˆbˆ* `V…„Ò ƒšƒ”Õ˜ƒšÖ\n \"Œ\nbˆÈyˆ` }ˆ„Æ\nbˆm„ül„À× Ø WƒÀÙ ˆÎyˆ‚­\nƒÑÚ\ndÛ#ˆÜ>„à× Ø WƒãÙ ˆ\nbˆ…úÕš?…úÝÞ!ÝQ‰ƒ<Ø G\\à Yƒáâ!ˆ\nbˆÎyˆm„,ã!ƒ&`È•|ˆÎyˆ‚\nbˆã!ƒ:È•bˆ`)Îyˆä`dÈ#ˆ\nbˆåæÅÁ#ƒ\\m„Içè!ˆ‚I\nbˆéÅwˆê\ndÉè$ˆ+ƒvì=ƒ…í`d\"ˆdbˆî ˆçï!ˆebˆÈÅ01m„û`0òà T!ˆmƒª+„Ôî ˆ‚Ôó0xˆ4ƒÝ`0õ\\VƒÝhè=ƒÝgè=„Ý`õZfö=ƒÝ÷uˆó0xˆ‚´1ÈUƒïŠé0xˆn)‚ó1iYƒ4Á8ò1!ˆm„08„\"o„04ƒ0Šùuˆãú!…ãû!?)ƒ0éÅwˆüÅwˆÅ8‚þ)‚7ùuˆ1ÈUƒ©`Å=>Šÿ ˆ>`Z‰=ÈW†m…m=GW…m`>{È=O˜+ƒ©Á8m„¨8„˜o„¨4ƒ¨Šùuˆãú!…”ãû!?)ƒ¨éÅwˆ@ÅwˆÅ8‚t)éÅxˆÉcˆA`S`B`!#ˆÙ ˆƒÔÕš„Ôç!ˆi1ƒŽmƒéCÁ‰#ˆ‚ŽùyˆCÅÁ#ˆÎyˆ‚Ž*dbˆ)Îu)‡" [buffer-undo-list t from to " \n" nil oneleft from-plus-indent 0 10 use-hard-newlines get-text-property hard delete-backward-char 1 backward-char newline justify current-justification fill-prefix adaptive-fill-mode "" fill-context-prefix current-indentation current-left-margin indent-to-left-margin remove-text-properties (hard nil) (right center) "[ ]*" regexp-quote fpre current-fill-column error "fill-prefix too long for specified width" looking-at indent-region re-search-forward "[.?!][])}\"']*$" insert-and-inherit 32 " " subst-char-in-region nosqueeze full canonically-space-region delete-horizontal-space " " linebeg prefixcol move-to-column "^ \n" sentence-end-double-space 2 46 -2 first -1 "\\. " "\\. " "^ \n " nchars fill-point move-to-left-margin "^ \n" set-text-properties text-properties-at justify-current-line] 6 (#$ . 4068) (list (region-beginning) (region-end) (if current-prefix-arg (quote full)))]) #@339 Fill paragraph at or after point. Prefix arg means justify as well. If `sentence-end-double-space' is non-nil, then period followed by one space does not end a sentence, so don't break a line there. If `fill-paragraph-function' is non-nil, we call it (passing our argument to it), and if it returns non-nil, we simply return its value. (defalias 'fill-paragraph #[(arg) "ƒÁ‰ !*†@`ŠÅ ˆn„ÆÇ!ˆ`È ˆ` \n\fbˆ ƒ8Ì \n #‚?Í \n #,‡" [fill-paragraph-function nil function arg before forward-paragraph newline 1 backward-paragraph beg end use-hard-newlines fill-region fill-region-as-paragraph] 5 (#$ . 6625) (list (if current-prefix-arg (quote full)))]) #@495 Fill each of the paragraphs in the region. Prefix arg (non-nil third arg, if called from program) means justify as well. Noninteractively, fourth arg NOSQUEEZE non-nil means to leave whitespace other than line breaks untouched, and fifth arg TO-EOP non-nil means to keep filling to the end of the paragraph (or next hard newline, if `use-hard-newlines' is on). If `sentence-end-double-space' is non-nil, then period followed by one space does not end a sentence, so don't break a line there. (defalias 'fill-region #[(from to &optional justify nosqueeze to-eop) "À‰Œ \f]bˆ ƒÆÀxˆÇ ˆ` \f^‰bˆÈyˆ`\n}ˆm?…”`À \nƒgË`dÌÍ$‰ƒS\nfÎU„S\ndU„S\nTbˆ‚4\nƒ^d\nT^‚_d bˆ‚qÇÏ!ˆ`ÇÐ!ˆ` Wƒz bˆ` YƒÑ`\n$ˆ‚\nbˆ*‚%+‡" [nil beg end from to to-eop "\n" forward-paragraph 0 initial use-hard-newlines text-property-any hard t 10 1 -1 fill-region-as-paragraph justify nosqueeze] 5 (#$ . 7296) (list (region-beginning) (region-end) (if current-prefix-arg (quote full)))]) #@335 *Method of justifying text not otherwise specified. Possible values are `left', `right', `full', `center', or `none'. The requested kind of justification is done whenever lines are filled. The `justification' text-property can locally override this variable. This variable automatically becomes buffer-local when set in any fashion. (defconst default-justification (quote left) (#$ . -8279)) (make-variable-buffer-local (quote default-justification)) #@233 How should we justify this line? This returns the value of the text-property `justification', or the variable `default-justification' if there is no text-property. However, it returns nil rather than `none' to mean "don't justify". (defalias 'current-justification #[nil "ÀŠÁÂwˆmƒo„`S‚`)Ã\"†\f‰Æ=?…$ )‡" [get-text-property " " nil justification default-justification j none] 4 (#$ . 8738)]) #@660 Set the region's justification style. The kind of justification to use is prompted for. If the mark is not active, this command operates on the current paragraph. If the mark is active, the region is used. However, if the beginning and end of the region are not at paragraph breaks, they are moved to the beginning and end of the paragraphs they are in. If `use-hard-newlines' is true, all hard newlines are taken to be paragraph breaks. When calling from a program, operates just on region between BEGIN and END, unless optional fourth arg WHOLE-PAR is non-nil. In that case bounds are extended to include entire paragraphs as in the interactive command. (defalias 'set-justification #[(begin end value &optional whole-par) "ŠŒƒB ƒ‚ ƒÄ‚ bˆnƒ,m„,Çuˆ‚È ˆ` bˆÊxˆË ˆ` *e }ˆÌd\"ˆÍdÎ$ˆÐdÑÄ$*‡" [whole-par use-hard-newlines "." paragraph-start t paragraph-ignore-fill-prefix begin 1 backward-paragraph end " \n" forward-paragraph unjustify-region put-text-property justification value fill-region nil] 5 (#$ . 9147) (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)) (let ((s (completing-read "Set justification to: " (quote (("left") ("right") ("full") ("center") ("none"))) nil t))) (if (equal s "") (error "")) (intern s)) t)]) #@123 Disable automatic filling for paragraphs in the region. If the mark is not active, this applies to the current paragraph. (defalias 'set-justification-none #[(b e) "À \nÃÄ$‡" [set-justification b e none t] 5 (#$ . 10455) (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))]) #@188 Make paragraphs in the region left-justified. This is usually the default, but see the variable `default-justification'. If the mark is not active, this applies to the current paragraph. (defalias 'set-justification-left #[(b e) "À \nÃÄ$‡" [set-justification b e left t] 5 (#$ . 10774) (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))]) #@164 Make paragraphs in the region right-justified: Flush at the right margin and ragged on the left. If the mark is not active, this applies to the current paragraph. (defalias 'set-justification-right #[(b e) "À \nÃÄ$‡" [set-justification b e right t] 5 (#$ . 11158) (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))]) #@188 Make paragraphs in the region fully justified: This makes lines flush on both margins by inserting spaces between words. If the mark is not active, this applies to the current paragraph. (defalias 'set-justification-full #[(b e) "À \nÃÄ$‡" [set-justification b e full t] 5 (#$ . 11520) (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))]) #@107 Make paragraphs in the region centered. If the mark is not active, this applies to the current paragraph. (defalias 'set-justification-center #[(b e) "À \nÃÄ$‡" [set-justification b e center t] 5 (#$ . 11904) (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))]) #@669 Do some kind of justification on this line. Normally does full justification: adds spaces to the line to make it end at the column given by `current-fill-column'. Optional first argument HOW specifies alternate type of justification: it can be `left', `right', `full', `center', or `none'. If HOW is t, will justify however the `current-justification' function says to. If HOW is nil or missing, full justification is done by default. Second arg EOP non-nil means that this is the last line of the paragraph, so it will not be stretched by full justification. Third arg NOSQUEEZE non-nil means to leave interior whitespace unchanged, otherwise it is made canonical. (defalias 'justify-current-line #[(&optional how eop nosqueeze) "Á=ƒ †\fÂ!„Ä‚!Å>„!ÄÆ>„ñÇ È É‰‰‰‰‰\n \f ɈƒX„XÔ`Õ\"ƒXÁÖÉxˆn„å×>ƒmiU„å` ØyˆÖÉwˆƒšÚ˜„š`dG`\\^{šƒšGuˆ‚ªƒªÜ!ƒªØ•bˆ`ÖÉwˆi\f` bˆi Þ=ƒ Z‰\nØWƒôbˆi\f\n\\Wƒèß\f\n\\Á\"ˆ`ß\f!ˆ`|ˆ‚åbˆ\f\n\\jˆUƒå`É“ˆ‚åà=ƒeá á Z \fZZâ¥\\‰\n\fWƒLbˆi\nWƒ@ß\nÁ\"ˆ`ß\f!ˆ`|ˆ‚åbˆ\njˆUƒå`É“ˆ‚åÄ=ƒáŒ }ˆ#„~ä \"ˆdbˆ Z‰\nØVƒÝ„ÝåæÉÁ#ƒÝ\nØVƒÝçè!è\\‰)ØVƒËåæÉÁ#„¾dbˆåæ!ˆæÉxˆ)S‰)‚ª)êæ!ˆæÉxˆ\nS‰\n‚)‚åëì!ˆbˆɉ“ˆ.ɇ" [how t current-justification none full (none left right center) (none left) current-fill-column point-marker nil ncols endcol indent end beg fp-end pos fc use-hard-newlines eop get-text-property hard " " (full right) 0 fill-prefix "" adaptive-fill-mode looking-at adaptive-fill-regexp right move-to-column center current-left-margin 2 nosqueeze canonically-space-region search-backward " " random 3 nmove insert-and-inherit error "Unknown justification value"] 9 (#$ . 12211) nil]) #@275 Remove justification whitespace from current line. If the line is centered or right-justified, this function removes any indentation past the left margin. If the line is full-jusitified, it removes extra spaces between words. It does nothing in other justification modes. (defalias 'unjustify-current-line #[nil "À ‰Â=ƒ Â` Ã=ƒÂ` Ä=ƒ,Å ˆÆ`ŠÃˆ`)\"‚` Ç>…`ŠÈÃÉ\"ˆ\nƒX\n˘„X\n`d\nG`\\^{šƒX\nGuˆ`ÌÃwˆ`|))‡" [current-justification justify left nil full beginning-of-line-text canonically-space-region (center right) move-to-left-margin t fill-prefix "" " "] 6 (#$ . 13968)]) #@344 Remove justification whitespace from region. For centered or right-justified regions, this function removes any indentation past the left margin from each line. For full-jusitified lines, it removes extra spaces between words. It does nothing in other justification modes. Arguments BEGIN and END are optional; default is the whole buffer. (defalias 'unjustify-region #[(&optional begin end) "ŠŒƒ\ne}ˆ †ebˆm?… ˆÃyˆ‚*‡" [end begin unjustify-current-line 1] 2 (#$ . 14566)]) #@508 Fill paragraphs within the region, allowing varying indentation within each. This command divides the region into "paragraphs", only at paragraph-separator lines, then fills each paragraph using as the fill prefix the smallest indentation of any line in the paragraph. When calling from a program, pass range to fill as first two arguments. Optional third and fourth arguments JUSTIFY and MAIL-FLAG: JUSTIFY to justify paragraphs (prefix arg), MAIL-FLAG for a mail message, i. e. don't fill header lines. (defalias 'fill-nonuniform-paragraphs #[(min max &optional justifyp mailp) "À \f $)‡" [t fill-individual-varying-indent fill-individual-paragraphs min max justifyp mailp] 5 (#$ . 15059) (list (region-beginning) (region-end) (if current-prefix-arg (quote full)))]) #@491 Fill paragraphs of uniform indentation within the region. This command divides the region into "paragraphs", treating every change in indentation level as a paragraph boundary, then fills each paragraph using its indentation level as the fill prefix. When calling from a program, pass range to fill as first two arguments. Optional third and fourth arguments JUSTIFY and MAIL-FLAG: JUSTIFY to justify paragraphs (prefix arg), MAIL-FLAG for a mail message, i. e. don't fill header lines. (defalias 'fill-individual-paragraphs #[(min max &optional justify mailp) "ŒŠbˆÁyˆ`\n}ˆ ƒ5m„5ÄÅ!„ ÄÆ!ƒ5ÄÅ!ƒ/ÇÈÉÊ#ˆ‚Ëyˆ‚`\n}ˆÌÉwˆm?…ãÍ ˆ`ɉƒZÄ!„‚ƒqƒqÄ!ƒqÓÁ!‚z`ŠÔÉwˆ`){Õ!ËyˆÍ ˆm„˃®Ä!„ËŠÄ!…©GuˆÄ!)?‚ÈÄ!ƒËŠGuˆÄ!†ÆÄ!)?„NnÚ`#ˆ„ßÜÝ!ˆ,‚9*‡" [min 0 max mailp looking-at "[ ]*[^ \n]+:" "[ ]*$" search-forward "\n\n" nil move 1 " \n" move-to-left-margin fill-prefix-regexp fill-prefix start adaptive-fill-mode adaptive-fill-regexp match-string " " regexp-quote fill-individual-varying-indent paragraph-separate paragraph-start had-newline fill-region-as-paragraph justify delete-char -1] 4 (#$ . 15841) (list (region-beginning) (region-end) (if current-prefix-arg (quote full)))]) emacs-19.30/lisp/find-dired.elc100666 13437 1 10161 5775440632 14736 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Jul 2 02:49:55 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/find-dired.el ;;; emacs version 19.29.4. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`find-dired.el' was compiled for Emacs 19.29 or later")) (require (quote dired)) #@297 *Description of the option to `find' to produce an `ls -l'-type listing. This is a cons of two strings (FIND-OPTION . LS-SWITCHES). FIND-OPTION gives the option (or options) to `find' that produce the desired output. LS-SWITCHES is a list of `ls' switches to tell dired how to parse the output. (defvar find-ls-option (byte-code "Á=ƒ‡Ç" [system-type berkeley-unix ("-ls" . "-gilsb") ("-exec ls -ld {} \\;" . "-ld")] 2) (#$ . -504)) #@183 *Option to grep to be as silent as possible. On Berkeley systems, this is `-s'; on Posix, and with GNU grep, `-q' does it. On other systems, the closest you can come is to use `-l'. (defvar find-grep-options (byte-code "Á=ƒ‡Ç" [system-type berkeley-unix "-s" "-q"] 2) (#$ . -949)) #@50 Last arguments given to `find' by \[find-dired]. (defvar find-args nil (#$ . 1241)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp find-args-history nil current-load-list] 2) #@134 Run `find' and go into dired-mode on a buffer of the output. The command run (after changing into DIR) is find . \( ARGS \) -ls (defalias 'find-dired #[(dir args) "ÀÁ\n!!Ã\n!„ÄÅ\n\"ˆÆÇÈ!!ˆ~ˆÉ ˆÊ Ì ˆ\n Ðјƒ5Ñ‚:ÒÓQ@QÕ\nA\"ˆÖ×Ø Ù \"!ˆÚÙ ÛÜ#ˆÝÞ!ƒcÞ ˆ‚nßà! á BCLˆÊ â\n㱈â䱈åæp#'è'é\"ˆê'ë\"ˆì'!íp“ˆ)î‰/‡" [file-name-as-directory expand-file-name dir file-directory-p error "find-dired needs a directory: %s" switch-to-buffer get-buffer-create "*Find*" kill-all-local-variables nil buffer-read-only erase-buffer default-directory args find-args "find . " "" "\\( " " \\) " find-ls-option dired-mode use-local-map append make-sparse-keymap current-local-map define-key "g" undefined fboundp dired-simple-subdir-alist make-local-variable dired-subdir-alist point-min-marker " " ":\n" "\n" start-process-shell-command "find" proc set-process-filter find-dired-filter set-process-sentinel find-dired-sentinel process-mark 1 (":%s") mode-line-process] 4 (#$ . 1412) (list (read-file-name "Run find in directory: " nil "" t) (read-string "Run find (with args): " find-args (quote (find-args-history . 1))))]) #@254 Search DIR recursively for files matching the globbing pattern PATTERN, and run dired on those files. PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted. The command run (after changing into DIR) is find . -name 'PATTERN' -ls (defalias 'find-name-dired #[(dir pattern) "À  ÄQ\"‡" [find-dired dir "-name '" pattern "'"] 5 (#$ . 2559) "DFind-name (directory): \nsFind-name (filename wildcard): "]) (defalias (quote lookfor-dired) (quote find-grep-dired)) #@207 Find files in DIR containing a regexp ARG and start Dired on output. The command run (after changing into DIR) is find . -exec grep -s ARG {} \; -ls Thus ARG can also contain additional grep options. (defalias 'find-grep-dired #[(dir args) "À Â Ä Æ°\"‡" [find-dired dir "! -type d -exec grep " find-grep-options " " args " {} \\; "] 7 (#$ . 3047) "DFind-grep (directory): \nsFind-grep (grep regexp): "]) (defalias 'find-dired-filter #[(proc string) "À !Ã\n!ƒoŠ\nqˆŒ~ˆŠÄd bˆcˆ bˆÈÉ!„*ÊyˆÈÉ!ƒ9ËcˆÊyˆ‚* ÌZbˆÍÎÄÏ#ƒO``ÐZ|ˆ‚> bˆÑÒÓ !Ï#…kÔÓ !`T\"ˆÓ !`TÄ“-‚rÕ !)‡" [process-buffer proc buf buffer-name nil end buffer-read-only string looking-at "^" 1 " " 3 search-forward " ./" t 2 search-backward "\n" process-mark dired-insert-set-properties delete-process] 4]) (defalias 'find-dired-sentinel #[(proc state) "À !Ã\n!…?Š\nqˆÄŠdbˆÆ±ˆÈuˆÉÊ ËÌO±ˆÍuˆÎÏÐ !!PÒ !ˆÓ ˆ*ÔÕp\"))‡" [process-buffer proc buf buffer-name nil buffer-read-only "\nfind " state -1 " at " current-time-string 0 19 1 ":" symbol-name process-status mode-line-process delete-process force-mode-line-update message "find-dired %s finished."] 4]) (provide (quote find-dired)) emacs-19.30/lisp/find-file.elc100666 12120 1 40604 6021171057 14422 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Aug 30 19:19:56 1995 ;;; from file /home/fsf/rms/e19/lisp/find-file.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`find-file.el' was compiled for Emacs 19.29 or later")) #@72 *List of functions to be called before the search for the file starts. (defvar ff-pre-find-hooks nil (#$ . -473)) #@66 *List of functions to be called before the other file is loaded. (defvar ff-pre-load-hooks nil (#$ . -593)) #@65 *List of functions to be called after the other file is loaded. (defvar ff-post-load-hooks nil (#$ . -707)) #@71 *List of functions to be called if the other file could not be found. (defvar ff-not-found-hooks nil (#$ . -821)) #@72 *List of functions to be called if the other file needs to be created. (defvar ff-file-created-hooks nil (#$ . -941)) #@139 *Non-nil means ignore cases in matches (see `case-fold-search'). If you have extensions in different cases, you will want this to be nil. (defvar ff-case-fold-search nil (#$ . -1066)) #@132 *If non-nil, find the corresponding file in another window by default. To override this, give an argument to `ff-find-other-file'. (defvar ff-always-in-other-window nil (#$ . -1257)) #@39 *If non-nil, ignore `#include' lines. (defvar ff-ignore-include nil (#$ . -1446)) #@75 *If non-nil, always attempt to create the other file if it was not found. (defvar ff-always-try-to-create t (#$ . -1534)) #@58 *If non-nil, trace which directories are being searched. (defvar ff-quiet-mode nil (#$ . -1662)) #@182 *A list of regular expressions specifying how to recognise special constructs such as include files etc, and an associated method for extracting the filename from that construct. (defvar ff-special-constructs (quote (("^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]" lambda nil (setq fname (buffer-substring (match-beginning 2) (match-end 2)))) ("^with[ ]+\\([a-zA-Z0-9_\\.]+\\)" lambda nil (setq fname (buffer-substring (match-beginning 1) (match-end 1))) (require (quote ada-mode)) (setq fname (concat (ada-make-filename-from-adaname fname) ada-spec-suffix))))) (#$ . -1766)) #@392 *Alist of extensions to find given the current file's extension. This list should contain the most used extensions before the others, since the search algorithm searches sequentially through each directory specified in `ff-search-directories'. If a file is not found, a new one is created with the first matching extension (`.cc' yields `.hh'). This alist should be set by the major mode. (defvar ff-other-file-alist (quote cc-other-file-alist) (#$ . -2360)) #@786 *List of directories to search for a specific file. Set by default to `cc-search-directories', expanded at run-time. This list is searched through with each extension specified in `ff-other-file-alist' that matches this file's extension. So the longer the list, the longer it'll take to realise that a file may not exist. A typical format is '("." "/usr/include/*" "$PROJECT/*/include") Environment variables can be inserted between slashes (`/'). They will be replaced by their definition. If a variable does not exist, it is replaced (silently) with an empty string. The stars are *not* wildcards: they are searched for together with the preceding slash. The star represents all the subdirectories except `..', and each of these subdirectories will be searched in turn. (defvar ff-search-directories (quote cc-search-directories) (#$ . -2828)) #@63 *See the description of the `ff-search-directories' variable. (defvar cc-search-directories (quote ("." "/usr/include/*" "/usr/local/include/*")) (#$ . -3693)) #@348 *Alist of extensions to find given the current file's extension. This list should contain the most used extensions before the others, since the search algorithm searches sequentially through each directory specified in `ff-search-directories'. If a file is not found, a new one is created with the first matching extension (`.cc' yields `.hh'). (defvar cc-other-file-alist (quote (("\\.cc$" (".hh" ".h")) ("\\.hh$" (".cc" ".C")) ("\\.c$" (".h")) ("\\.h$" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp")) ("\\.C$" (".H" ".hh" ".h")) ("\\.H$" (".C" ".CC")) ("\\.CC$" (".HH" ".H" ".hh" ".h")) ("\\.HH$" (".CC")) ("\\.cxx$" (".hh" ".h")) ("\\.cpp$" (".hh" ".h")))) (#$ . -3860)) #@64 *See the description for the `ff-search-directories' variable. (defvar ada-search-directories (quote ("." "/usr/adainclude" "/usr/local/adainclude")) (#$ . -4533)) #@352 *Alist of extensions to find given the current file's extension. This list should contain the most used extensions before the others, since the search algorithm searches sequentially through each directory specified in `ada-search-directories'. If a file is not found, a new one is created with the first matching extension (`.adb' yields `.ads').  (defvar ada-other-file-alist (quote (("\\.ads$" (".adb")) ("\\.adb$" (".ads")))) (#$ . -4704)) #@64 *See the description for the `ff-search-directories' variable. (defvar modula2-other-file-alist (quote (("\\.mi$" (".md")) ("\\.md$" (".mi")))) (#$ . -5156)) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÀÅ!ˆÀÆ!ˆÀÇ!ˆÀÈ!ˆÀÉ!ˆÀÊ!ˆÀË!‡" [make-variable-buffer-local ff-pre-find-hooks ff-pre-load-hooks ff-post-load-hooks ff-not-found-hooks ff-file-created-hooks ff-case-fold-search ff-always-in-other-window ff-ignore-include ff-quiet-mode ff-other-file-alist ff-search-directories] 2) #@187 Find the header or source file corresponding to this file. See also the documentation for `ff-find-other-file;. If optional IN-OTHER-WINDOW is non-nil, find the file in another window. (defalias 'ff-get-other-file #[(&optional in-other-window) "ÂÃ\f!ˆ ‰)‡" [ff-ignore-include ignore t ff-find-the-other-file in-other-window] 2 (#$ . 5627) "P"]) #@1777 Find the header or source file corresponding to this file. Being on a `#include' line pulls in that file. If optional IN-OTHER-WINDOW is non-nil, find the file in the other window. If optional IGNORE-INCLUDE is non-nil, ignore being on `#include' lines. Variables of interest include: - ff-case-fold-search Non-nil means ignore cases in matches (see case-fold-search). If you have extensions in different cases, you will want this to be nil. - ff-always-in-other-window If non-nil, always open the other file in another window, unless an argument is given to ff-find-other-file. - ff-ignore-include If non-nil, ignores #include lines. - ff-always-try-to-create If non-nil, always attempt to create the other file if it was not found. - ff-quiet-mode If non-nil, traces which directories are being searched. - ff-special-constructs A list of regular expressions specifying how to recognise special constructs such as include files etc, and an associated method for extracting the filename from that construct. - ff-other-file-alist Alist of extensions to find given the current file's extension. - ff-search-directories List of directories searched through with each extension specified in ff-other-file-alist that matches this file's extension. - ff-pre-find-hooks List of functions to be called before the search for the file starts. - ff-pre-load-hooks List of functions to be called before the other file is loaded. - ff-post-load-hooks List of functions to be called after the other file is loaded. - ff-not-found-hooks List of functions to be called if the other file could not be found. - ff-file-created-hooks List of functions to be called if the other file has been created. (defalias 'ff-find-other-file #[(&optional in-other-window ignore-include) "\nÃ\f!ˆ ‰)‡" [ff-ignore-include ignore ignore-include ff-find-the-other-file in-other-window] 2 (#$ . 5985) "P"]) (defalias 'ff-emacs-19 #[nil "ÀÁ\n\"‡" [string-match "^19\\.[0-9]+\\.[0-9]+$" emacs-version] 3]) (defalias 'ff-xemacs #[nil "ÀÁ\n\"† ÀÃ\n\"‡" [string-match "Lucid" emacs-version "XEmacs"] 3]) #@242 Find the header or source file corresponding to the current file. Being on a `#include' line pulls in that file, but see the help on the `ff-ignore-include' variable. If optional IN-OTHER-WINDOW is non-nil, find the file in another window. (defalias 'ff-find-the-other-file #[(&optional in-other-window) "À‰‰‰‰‰‰‰‰‰‰‰‰ \n \f ƒ+ÏÎ!ˆÐÑ!ˆ9ƒ=ÓJ!‚AÓ!ŠÔyˆÕ \n)„d\nƒd\n×\n\nÀ$‚A9ƒpJ‚rÚ ƒ~Ú ‚ÛÜÝ\"ˆÞ”Þ•O\nÀ@ ß @\n\"  ƒË ƒ± ÔY„Ë „ËA‰@ ß @\n\" ‚  „Õà‚A A@\f A@ À :„\ná !ƒ\n Ú !\f @\fCB À\f@‚7 ÔUƒââ‚.ã @PÜ\f\n\"ˆ\nÞ”Þ•O A@@P×\n\f$ ƒLÐâ!ˆ‚š „š$ƒYÏä!ˆ%ƒ”À‰&çèÄé \"* À$!&ë&!ƒ‚ì&! P‚†&‰íà#ˆ*‚šÐî\n\"ˆ . ‡" [nil no-match dirs found format default-name pathname alist stub pos fname action suffixes match ff-pre-find-hooks run-hooks message "Working..." ff-search-directories ff-list-replace-env-vars 0 ff-treat-as-special ff-ignore-include ff-get-file in-other-window ff-other-file-alist buffer-file-name "/none.none" string-match ".*/\\(.+\\)$" 1 ff-string-match t fboundp "" "\\(.+\\)" ff-not-found-hooks ff-always-try-to-create name expand-file-name read-file-name "Find or create %s in: " default-directory file-directory-p file-name-as-directory ff-find-file "no file found for %s"] 14 (#$ . 8155)]) #@351 Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub). If (optional) SUFFIXES is nil, search for fname, otherwise search for fname with each of the given suffixes. Gets the file or the buffer corresponding to the name of the first file found, or nil. Arguments: (search-dirs fname-stub &optional suffix-list in-other-window)  (defalias 'ff-get-file #[(search-dirs fname-stub &optional suffix-list other-window) "À \n #‰„Å‚2ÆÇ\f!!ƒ È\f \"ˆ\f‚2Ê\f!ƒ1Ë\f Å#ˆ\f‚2Å)‡" [ff-get-file-name search-dirs fname-stub suffix-list filename nil bufferp get-buffer ff-switch-to-buffer other-window file-exists-p ff-find-file] 5 (#$ . 9510)]) #@289 Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub). If (optional) SUFFIXES is nil, search for fname, otherwise search for fname with each of the given suffixes. Returns the name of the first file found. Arguments: (search-dirs fname-stub &optional suffix-list)  (defalias 'ff-get-file-name #[(search-dirs fname-stub &optional suffix-list) "ÀÀÀÀÀÀÀÀÀ À\n ‰ƒ(@‚.ÌÌCƒ”\n„” P„IÏÐ\"ˆÑÒ!!ƒV\nÓ Ô@! ƒ‰\n„‰ÕÖP \"ƒz \nAÔ@! ‚aA‰@‚.‰@\n„U ƒU \nƒøÕØ\n\"„øƒ¾@‚ÄÌÌCƒL\n„L P\nÙQ„äÏÚ \"ˆÛ !ƒí \nA‰@‚ÄÜ”ƒ\nܔܕO‚ Ì\nݔݕOÞ\nß\"À‰ !‰\"@!\"ƒ<ã !\fPC\" \"A‰\"@!‚  ƒKä   #\n+ A‰@‚š\nƒ`Ïå\n\"ˆ\n.\n‡" [nil dirs dir file rest this-suffix suffixes filename blist buf found suffix-list "" fname-stub ff-quiet-mode message "finding buffer %s..." bufferp get-buffer buffer-list buffer-name string-match "<[0-9]+>" search-dirs "\\([^*]*\\)/\\*\\(/.*\\)*" "/" "finding %s..." file-exists-p 2 1 ff-all-dirs-under ("..") compl-dirs this-dir dirlist append ff-get-file-name "%s found"] 5 (#$ . 10177)]) #@121 Like string-match (which see), but set `case-fold-search' temporarily. The value used comes from `ff-case-fold-search'. (defalias 'ff-string-match #[(regexp string &optional start) "\n… Ã\n\f #)‡" [ff-case-fold-search case-fold-search regexp string-match string start] 4 (#$ . 11332)]) #@71 Replace environment variables (of the form $VARIABLE) in SEARCH-LIST. (defalias 'ff-list-replace-env-vars #[(search-list) "À @ ƒ3ÄÅ\n\"ƒ&\nƔƕOÇ\nȔȕO!\nɔɕOQ A\n B @‚Ê !‰*‡" [nil search-list var list string-match "\\(.*\\)\\$[({]*\\([a-zA-Z0-9_]+\\)[)}]*\\(.*\\)" 1 getenv 2 3 reverse] 5 (#$ . 11627)]) #@148 Returns the file to look for if the construct was special, else nil. The construct is defined in the variable `ff-special-constructs' (which see). (defalias 'ff-treat-as-special #[nil "À\n‰@‰@\fA ƒ5 „5Ç !ƒ%ƒ%  A‰@‰@\fA‚ -‡" [nil fname ff-special-constructs list elem regexp match looking-at] 3 (#$ . 11952)]) #@34 Return the basename of PATHNAME. (defalias 'ff-basename #[(string) "À PÂà \"ˆ ĔĕO‰‡" ["/" string string-match ".*/\\([^/]+\\)$" 1] 3 (#$ . 12289)]) #@99 Get all the directory files under directory HERE. Exclude all files in the optional EXCLUDE list. (defalias 'ff-all-dirs-under #[(here &optional exclude) "À !…\nÂÃć" [file-directory-p here nil (byte-code "À Â\"ɉƒ.@Ç\f!ƒ%È\f! „%\f BA‰„Ê !‰+‡" [directory-files here t nil file dirlist files file-directory-p ff-basename exclude reverse] 4) ((error))] 3 (#$ . 12447)]) #@513 Call F1 or F2 on FILE, according to IN-OTHER-WINDOW. In addition, this runs various hooks. Either F1 or F2 receives FILE as the sole argument. The decision of which one to call is based on IN-OTHER-WINDOW and on the global variable `ff-always-in-other-window'. F1 and F2 are typically `find-file' / `find-file-other-window' or `switch-to-buffer' / `switch-to-buffer-other-window' function pairs. If optional NEW-FILE is t, then a special hook (`ff-file-created-hooks') is called before `ff-post-load-hooks'. (defalias 'ff-switch-file #[(f1 f2 file &optional in-other-window new-file) "ƒÁÀ!ˆ\nƒ ƒ\n„ ƒ\f !ˆ‚$ !ˆƒ2ƒ2ÁÈ!ˆ …:ÁÉ!‡" [ff-pre-load-hooks run-hooks in-other-window ff-always-in-other-window f2 file f1 new-file ff-file-created-hooks ff-post-load-hooks] 2 (#$ . 12845)]) #@71 Like `find-file' (which see), but may put the file in another window. (defalias 'ff-find-file #[(file &optional in-other-window new-file) "ÀÁ \f %‡" [ff-switch-file find-file find-file-other-window file in-other-window new-file] 6 (#$ . 13654)]) #@80 Like `switch-to-buffer' (which see), but may put the buffer in another window. (defalias 'ff-switch-to-buffer #[(file &optional in-other-window) "ÀÁ \fÅ%‡" [ff-switch-file switch-to-buffer switch-to-buffer-other-window file in-other-window nil] 6 (#$ . 13907)]) (byte-code "À ƒÁÂMˆÃÄMˆÅÆMˆÇÈMˆ‚%É ƒ%ÃÊMˆÅËMˆÌÍ!‡" [ff-emacs-19 ff-goto-click #[(event) "À  8:ƒ‚à 8)‰@)!qˆ  8:ƒ&‚'à 8)‰A@:ƒ9\fA@@‚<\fA@)b‡" [window-buffer event 2 1 position] 4] ff-mouse-find-other-file #[(event) "ŠÀ !ˆÂÃ!)‡" [ff-goto-click event ff-find-other-file nil] 2 "Visit the file you click on." "e"] ff-mouse-find-other-file-other-window #[(event) "ŠÀ !ˆÂÃ!)‡" [ff-goto-click event ff-find-other-file t] 2 "Visit the file you click on." "e"] locate-file #[(fname dirs &optional suffix-list ignore-perms) "À \n #‡" [ff-get-file dirs fname suffix-list] 4 "Defines XEmacs look-alike locate-file for GNU Emacs-19." nil] ff-xemacs #[(event) "ŠÀ !ˆÂÃ!)‡" [mouse-set-point event ff-find-other-file nil] 2 "Visit the file you click on." "@e"] #[(event) "ŠÀ !ˆÂÃ!)‡" [mouse-set-point event ff-find-other-file t] 2 "Visit the file you click on." "@e"] provide find-file] 2) #@100 Return t if this string is all uppercase. Given START and/or END, checks between these characters. (defalias 'ff-upcase-p #[(string &optional start end) "À‰ „\nÄ „G Uƒ T OÇÈ \"…@É ‰…@\n@ÄU…@\nA@ GU…@Ê*‡" [nil str match start 0 end string ff-string-match "[A-Z]+" match-data t] 3 (#$ . 15070)]) #@137 Discriminate file extensions. Build up a new file list based possibly on part of the directory name and the name of the file passed in. (defalias 'ff-cc-hh-converter #[(arg) "ÀÁ\n\"ˆÃ”…\nÔÕOÄ”…\nĔĕOÅ”…&\nŔŕOÆ”…1\nƔƕOÇ \n \f ͘ƒuÀÎ\n\"ƒu\nĔĕO\nÔÕO– ÐPÑP\nÐP\nÑPF)‚Õ Ò˜ƒ¦Ó !ƒ¦\nƒ¦ —\nP‰ÔPÕP\nÔP\nÕPF)‚Õ ͘ƒ¿\n‰ÐPÑPD)‚Õ Ò˜ƒÕ\n‰ÔPÕPD)-‡" [ff-string-match "\\(.*\\)/\\([^/]+\\)/\\([^.]+\\).\\([^/]+\\)$" arg 1 2 3 4 nil return-list extn file dire path "cc" "^\\([a-z]+\\)\\([A-Z].+\\)$" stub ".hh" ".h" "hh" ff-upcase-p ".cc" ".C"] 7 (#$ . 15393)]) #@33 Name of the function we are in. (defvar ff-function-name nil (#$ . 16023)) (byte-code "À B BÀ‡" [ada-procedure-start-regexp current-load-list ada-package-start-regexp] 2) #@122 Return the name of the function whose definition/declaration point is in. Also remember that name in `ff-function-name'. (defalias 'ff-which-function-are-we-in #[nil "ÀŠÂ ÀÄ#ƒŔŕ{‰‚%ÂÀÄ#…%Ŕŕ{‰)‡" [nil ff-function-name re-search-backward ada-procedure-start-regexp t 0 ada-package-start-regexp] 4 (#$ . 16204)]) #@122 Find the function specified in `ff-function-name'. That name was previously determined by `ff-which-function-are-we-in'. (defalias 'ff-set-point-accordingly #[nil "…\febˆÁÂÃ#‡" [ff-function-name search-forward nil t] 4 (#$ . 16534)]) emacs-19.30/lisp/find-gc.elc100666 13437 1 5037 5744576112 14225 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:39:53 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/find-gc.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/find-gc.el' was compiled for Emacs 19")) (defalias 'find-gc-unsafe #[nil "ÀÁ!ˆÂ ˆÃÄ!ˆÅÇ\"‰‡" [trace-call-tree nil trace-use-tree find-unsafe-funcs Fgarbage_collect sort unsafe-list #[(x y) "@ @™‡" [x y] 2]] 3]) (byte-code "À‡" ["/usr/gnu/src/dist/src" emacs-source-directory nil] 1) (defalias 'find-unsafe-funcs #[(target) "CCÂ!‡" [target unsafe-list trace-unsafe] 2]) (defalias 'trace-unsafe #[(func) " ž‰„ÃÄ @\"ˆ\nA‰…3\n@ ž„\n@>„\n@B BÇ\n@!ˆ‚)‡" [func subrs-used used error "No subrs-used for %s" unsafe-list noreturn-list trace-unsafe] 4]) (byte-code "À‡" [(Fsignal Fthrow wrong_type_argument) noreturn-list nil] 1) (defalias 'trace-call-tree #[(&optional already-setup) "ÀÁ!ˆ\n„*ÃÄʼn‰ÆÇ&ˆÃÄʼn‰ÆÈ&ˆÃÄʼn‰ÆÉÊ \"&ˆŠÌÍ!qˆÅÅʼn…ÓÀÔ@\"ˆÃÄʼn‰ÆÉÕ@\"&ˆÖ ˆ×Ø@ÙQ!ˆÚÛÅÜ#ƒÀ`ÝZfÞUƒœßà!ˆáâ”â•{!Àã@#ˆC‰B‚gßä!ƒgáå”å•{!‰A>„gAB¡ˆ‚gæØ@ÙQ!ˆA‰„EÅ-‡" [message "Setting up directories..." already-setup call-process "csh" nil "-c" "rm -rf /tmp/esrc" "mkdir /tmp/esrc" format "ln -s %s/*.[ch] /tmp/esrc" emacs-source-directory get-buffer-create "*Trace Call Tree*" subrs-called source-files entry name files case-fold-search "Compiling %s..." "gcc -dr -c /tmp/esrc/%s -o /dev/null" erase-buffer insert-file-contents "/tmp/esrc/" ".rtl" re-search-forward ";; Function \\|(call_insn " t 3 111 looking-at "[a-zA-Z0-9_]+" intern 0 "%s : %s" ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"" 1 delete-file] 10]) (byte-code "À‡" [("dispnew.c" "scroll.c" "xdisp.c" "window.c" "term.c" "cm.c" "emacs.c" "keyboard.c" "macros.c" "keymap.c" "sysdep.c" "buffer.c" "filelock.c" "insdel.c" "marker.c" "minibuf.c" "fileio.c" "dired.c" "filemode.c" "cmds.c" "casefiddle.c" "indent.c" "search.c" "regex.c" "undo.c" "alloc.c" "data.c" "doc.c" "editfns.c" "callint.c" "eval.c" "fns.c" "print.c" "lread.c" "abbrev.c" "syntax.c" "unexec.c" "mocklisp.c" "bytecode.c" "process.c" "callproc.c" "doprnt.c" "x11term.c" "x11fns.c") source-files nil] 1) (defalias 'trace-use-tree #[nil "ÀÁÀ \"\" ʼn‰…G@A‰ƒ=@\fž‰ƒ@@AB¡ˆ‚A‰„Å+‡" [mapcar list car subrs-called subrs-used nil found p2 ptr] 6]) emacs-19.30/lisp/finder-inf.elc100666 13437 1 55311 6055530433 14747 0ustar jimbdaemon;ELC ;;; compiled by rms@churchy.gnu.ai.mit.edu on Sat Nov 25 01:00:53 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/finder-inf.el ;;; emacs version 19.30.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`finder-inf.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÂÃ!‡" [(("default.el" nil nil) ("po-mode.el" nil nil) ("abbrev.el" "abbrev mode commands for Emacs" (abbrev)) ("abbrevlist.el" "list one abbrev table alphabetically ordered." (abbrev)) ("ada-mode.el" nil nil) ("add-log.el" "change log maintenance commands for Emacs" (maint)) ("advice.el" "an overloading mechanism for Emacs Lisp functions" (extensions lisp tools)) ("allout.el" nil (outline mode)) ("ange-ftp.el" "transparent FTP support for GNU Emacs" (comm)) ("appt.el" "appointment notification functions." (calendar)) ("apropos.el" "faster apropos commands." (help)) ("arc-mode.el" "simple editing of archives" (archives msdog editing major-mode)) ("array.el" "array editing commands for Gnu Emacs" (extensions)) ("asm-mode.el" "mode for editing assembler code" (tools languages)) ("assoc.el" "insert/delete/sort functions on association lists" (extensions)) ("auto-show.el" nil nil) ("autoinsert.el" "automatic mode-dependent insertion of text into new files" nil) ("autoload.el" "maintain autoloads in loaddefs.el." (maint)) ("avoid.el" nil (mouse)) ("awk-mode.el" "AWK code editing commands for Emacs" (unix languages)) ("backquote.el" nil (extensions internal)) ("bib-mode.el" "bib-mode, major mode for editing bib files." (bib)) ("bibtex.el" "BibTeX mode for GNU Emacs" (bibtex latex tex)) ("blackbox.el" "blackbox game in Emacs Lisp" (games)) ("blessmail.el" "Decide whether movemail needs special privileges." (internal)) ("bookmark.el" "set bookmarks, maybe annotate them, jump to them later." (bookmarks placeholders annotations)) ("buff-menu.el" "buffer menu main function and support functions." nil) ("byte-opt.el" "the optimization passes of the emacs-lisp byte compiler." (internal)) ("byte-run.el" "byte-compiler support for inlining" (internal)) ("bytecomp.el" "compilation of Lisp code into byte code." (internal)) ("bytecpat.el" nil nil) ("c-mode.el" "C code editing commands for Emacs" (c)) ("cal-dst.el" "calendar functions for daylight savings rules." (calendar)) ("cal-french.el" "calendar functions for the French Revolutionary calendar." (calendar)) ("cal-mayan.el" "calendar functions for the Mayan calendars." (calendar)) ("cal-menu.el" "calendar functions for menu bar and popup menu support" (calendar)) ("cal-x.el" "calendar windows in dedicated frames in x-windows" (calendar)) ("calendar.el" "Calendar functions. -*-byte-compile-dynamic: t;-*-" (calendar)) ("case-table.el" "code to extend the character set and support case tables." (i18n)) ("cc-mode.el" "major mode for editing C, C++, and Objective-C code" (c languages oop)) ("cdl.el" nil (data)) ("chistory.el" "list command history" nil) ("cl-compat.el" nil (extensions)) ("cl-extra.el" nil (extensions)) ("cl-indent.el" "enhanced lisp-indent mode" (lisp tools)) ("cl-macs.el" nil (extensions)) ("cl-seq.el" nil (extensions)) ("cl-specs.el" nil (lisp tools maint)) ("cl.el" nil (extensions)) ("cmacexp.el" "expand C macros in a region" (c)) ("cmuscheme.el" "Scheme process in a buffer. Adapted from tea.el." (processes lisp)) ("comint.el" "general command interpreter in a window stuff" (processes)) ("compare-w.el" "compare text between windows for Emacs." nil) ("compile.el" "run compiler as inferior of Emacs, parse error messages." (tools processes)) ("complete.el" nil (abbrev)) ("completion.el" "dynamic word-completion code" (abbrev)) ("cookie1.el" "retrieve random phrases from fortune cookie files" (games)) ("cplus-md.el" "C++ code editing commands for Emacs" (c languages oop)) ("cpp.el" "Highlight or hide text according to cpp conditionals." (c faces tools)) ("cust-print.el" "handles print-level and print-circle." (extensions)) ("dabbrev.el" "dynamic abbreviation package" (abbrev expand completion)) ("debug.el" "debuggers and related commands for Emacs" (lisp tools maint)) ("delsel.el" "delete selection if you insert" nil) ("derived.el" nil nil) ("desktop.el" "save partial status of Emacs when killed" (customization)) ("diary-ins.el" "calendar functions for adding diary entries." (diary calendar)) ("diary-lib.el" "diary functions." (calendar)) ("diff.el" "Run `diff' in compilation-mode." (unix tools)) ("dired-aux.el" "less commonly used parts of dired -*-byte-compile-dynamic: t;-*-" nil) ("dired-x.el" "Sebastian Kremer's Extra DIRED hacked up for GNU Emacs19" (dired extensions)) ("dired.el" "directory-browsing commands" nil) ("disass.el" "disassembler for compiled Emacs Lisp code" (internal)) ("disp-table.el" "functions for dealing with char tables." (i18n)) ("dissociate.el" "scramble text amusingly for Emacs." (games)) ("docref.el" nil (docs help lisp)) ("doctor.el" "psychological help for frustrated users." (games)) ("dos-fns.el" "MS-Dos specific functions." (internal)) ("double.el" nil (i18n)) ("dunnet.el" "Text adventure for Emacs" (games)) ("easymenu.el" "support the easymenu interface for defining a menu." (emulations)) ("ebuff-menu.el" "electric-buffer-list mode" nil) ("echistory.el" "Electric Command History Mode" nil) ("edebug.el" "a source-level debugger for Emacs Lisp" (lisp tools maint)) ("ediff-diff.el" "diff-related utilities" nil) ("ediff-init.el" "Macros, variables and defsubsts used by Ediff" nil) ("ediff-merg.el" "merging utilities" nil) ("ediff-util.el" "the core commands and utilities of ediff" nil) ("ediff-wind.el" "window manipulation utilities" nil) ("ediff.el" "a comprehensive visual interface to diff & patch" (comparing merging patching version control\.)) ("edmacro.el" "keyboard macro editor" (abbrev)) ("edt-lk201.el" nil (emulations)) ("edt-mapper.el" nil (emulations)) ("edt-pc.el" nil (emulations)) ("edt-vt100.el" nil (emulations)) ("edt.el" nil (emulations)) ("ehelp.el" "bindings for electric-help mode" (help extensions)) ("electric.el" "window maker and Command loop for `electric' modes." (extensions)) ("elp.el" "Emacs Lisp Profiler" (emacs lisp profile timing)) ("emacs-lock.el" nil nil) ("emacsbug.el" "command to report Emacs bugs to appropriate mailing list." (maint)) ("emerge.el" "merge diffs under Emacs control" (unix tools)) ("enriched.el" nil (wp faces)) ("env.el" "functions to manipulate environment variables." (processes unix)) ("etags.el" "etags facility for Emacs" (tools)) ("eval-reg.el" "Redefine eval-region, and subrs that use it, in Lisp" (lisp)) ("f90.el" nil (fortran f90 languages)) ("facemenu.el" nil (faces)) ("faces.el" "Lisp interface to the c \"face\" structure" nil) ("fast-lock.el" "Automagic text properties caching for fast Font Lock mode." (faces files)) ("files.el" "file input and output commands for Emacs" nil) ("fill.el" "fill commands for Emacs" (wp)) ("find-dired.el" "run a `find' command and dired the output" (unix)) ("find-file.el" "find a file corresponding to this one given a pattern" (c matching tools)) ("find-gc.el" "detect functions that call the garbage collector" nil) ("finder-inf.el" "keyword-to-package mapping" (help)) ("finder.el" "topic & keyword-based code finder" (help)) ("float-sup.el" "detect absence of floating-point support in Emacs runtime" nil) ("float.el" "floating point arithmetic package." (extensions)) ("flow-ctrl.el" "help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control" (hardware)) ("foldout.el" "Folding extensions for outline-mode and outline-minor-mode." (folding outline)) ("font-lock.el" nil (languages faces)) ("format.el" nil nil) ("forms-d2.el" nil nil) ("forms-pass.el" nil nil) ("forms.el" nil nil) ("fortran.el" "Fortran mode for GNU Emacs" (languages)) ("frame.el" "multi-frame management independent of window systems." (internal)) ("gnus-uu.el" "extract, view or save (uu)encoded files from gnus" (news)) ("gnus.el" "NNTP-based News Reader for GNU Emacs" (news)) ("gnusmail.el" "mail reply commands for GNUS newsreader" (news)) ("gnusmisc.el" "miscellaneous commands for GNUS newsreader" (news)) ("gnuspost.el" "post news commands for GNUS newsreader" (news)) ("gomoku.el" "Gomoku game between you and Emacs" (games)) ("gud.el" "Grand Unified Debugger mode for gdb, sdb, dbx, or xdb" (unix tools)) ("hanoi.el" "towers of hanoi in GNUmacs" (games)) ("help-macro.el" "Makes command line help such as help-for-help" nil) ("help.el" "help commands for Emacs" (help internal)) ("helper.el" "utility help package supporting help in electric modes" (help)) ("hexl.el" "edit a file in a hex dump format using the hexl filter." (data)) ("hideif.el" "hides selected code within ifdef." (c outlines)) ("hideshow.el" "minor mode cmds to selectively display blocks of code" nil) ("hilit19.el" nil (faces)) ("hippie-exp.el" "expand text trying various ways to find its expansion." (abbrev)) ("holidays.el" "holiday functions for the calendar package" (holidays calendar)) ("icomplete.el" nil nil) ("icon.el" "mode for editing Icon code" (languages)) ("ielm.el" "interaction mode for Emacs Lisp" (lisp)) ("imenu.el" "Framework for mode-specific buffer indexes." (tools)) ("indent.el" "indentation commands for Emacs" nil) ("inf-lisp.el" "an inferior-lisp mode" (processes lisp)) ("info.el" "info package for Emacs." (help)) ("informat.el" "info support functions package for Emacs" (help)) ("isearch.el" "incremental search minor mode." nil) ("iso-acc.el" nil (i18n)) ("iso-ascii.el" "set up char tables for ISO 8859/1 on ASCII terminals." (i18n)) ("iso-cvt.el" nil (tex iso latin i18n)) ("iso-insert.el" "insert functions for ISO 8859/1." (i18n)) ("iso-swed.el" "set up char tables for ISO 8859/1 for Swedish/Finnish ttys" (i18n)) ("iso-syntax.el" "set up case-conversion and syntax tables for ISO 8859/1" (i18n)) ("iso-transl.el" "keyboard input definitions for ISO 8859/1." (i18n)) ("ispell.el" nil nil) ("ispell4.el" "this is the GNU EMACS interface to GNU ISPELL version 4." (wp)) ("jka-compr.el" nil (data)) ("kermit.el" "additions to shell mode for use with kermit, etc." (comm)) ("ledit.el" "Emacs side of ledit interface" nil) ("levents.el" "emulate the Lucid event data type and associated functions." nil) ("life.el" "John Horton Conway's `Life' game for GNU Emacs" (games)) ("lisp-mnt.el" "minor mode for Emacs Lisp maintainers" (docs)) ("lisp-mode.el" "Lisp mode, and its idiosyncratic commands." (lisp languages)) ("lisp.el" "Lisp editing commands for Emacs" (lisp languages)) ("lmenu.el" "emulate Lucid's menubar support" (emulations)) ("loaddefs.el" "define standard autoloads and keys of other files" (internal)) ("loadhist.el" "lisp functions for working with feature groups" (internal)) ("loadup.el" "load up standardly loaded Lisp files for Emacs." (internal)) ("lpr.el" "print Emacs buffer on line printer." (unix)) ("ls-lisp.el" "emulate insert-directory completely in Emacs Lisp" (unix)) ("lselect.el" "Lucid interface to X Selections" (emulations)) ("lucid.el" "Emulate some Lucid Emacs functions." nil) ("lunar.el" "calendar functions for phases of the moon." (calendar)) ("macros.el" "non-primitive commands for keyboard macros." (abbrev)) ("mail-extr.el" "extract full name and address from RFC 822 mail header." (mail)) ("mail-hist.el" "Headers and message body history for outgoing mail." (mail history)) ("mail-utils.el" "utility functions used both by rmail and rnews" (mail news)) ("mailabbrev.el" "abbrev-expansion of mail aliases." (mail)) ("mailalias.el" "expand mailing address aliases defined in ~/.mailrc." (mail)) ("mailpost.el" "RMAIL coupler to /usr/uci/post mailer" (mail)) ("makefile.el" "makefile editing commands for Emacs" (unix tools)) ("makeinfo.el" nil nil) ("makesum.el" "generate key binding summary for Emacs" (help)) ("man.el" "browse UNIX manual pages" nil) ("map-ynp.el" "General-purpose boolean question-asker." (lisp extensions)) ("meese.el" "protect the impressionable young minds of America" (games)) ("menu-bar.el" "define a default menu bar." (internal)) ("metamail.el" "Metamail interface for GNU Emacs" (mail news mime multimedia)) ("mh-comp.el" "mh-e functions for composing messages" nil) ("mh-e.el" "GNU Emacs interface to the MH mail system" (mail)) ("mh-funcs.el" "mh-e functions not everyone will use right away" nil) ("mh-mime.el" "mh-e support for composing MIME messages" nil) ("mh-pick.el" "make a search pattern and search for a message in mh-e" nil) ("mh-seq.el" "mh-e sequences support" nil) ("mh-utils.el" "mh-e code needed for both sending and reading" nil) ("mhspool.el" "MH folder access using NNTP for GNU Emacs" (mail news)) ("misc.el" "basic editing commands for Emacs" nil) ("mlconvert.el" "convert buffer of Mocklisp code to real lisp." (emulations)) ("mldrag.el" nil (mouse)) ("mlsupport.el" "run-time support for mocklisp code." (extensions)) ("modula2.el" "Modula-2 editing support package" (languages)) ("mouse-sel.el" "Multi-click selection support for Emacs 19" (mouse)) ("mouse.el" "window system-independent mouse support." (hardware)) ("mpuz.el" "multiplication puzzle for GNU Emacs" (games)) ("msb.el" "Customizable buffer-selection with multiple menus." (mouse buffer menu)) ("nnspool.el" "spool access using NNTP for GNU Emacs" (news)) ("nntp.el" "NNTP (RFC977) Interface for GNU Emacs" (news)) ("noutline.el" "outline mode commands for Emacs" (outlines)) ("novice.el" "handling of disabled commands (\"novice mode\") for Emacs." (internal help)) ("nroff-mode.el" "GNU Emacs major mode for editing nroff source" (wp)) ("options.el" "edit Options command for Emacs." nil) ("outline.el" "outline mode commands for Emacs" (outlines)) ("page-ext.el" "extended page handling commands" nil) ("page.el" "page motion commands for emacs." nil) ("paragraphs.el" "paragraph and sentence parsing." (wp)) ("paren.el" "highlight matching paren." (languages faces)) ("pascal.el" nil nil) ("paths.el" "define pathnames for use by various Emacs commands." (internal)) ("pc-mode.el" nil nil) ("perl-mode.el" "Perl code editing commands for GNU Emacs" (languages)) ("picture.el" "\"Picture mode\" -- editing using quarter-plane screen model." nil) ("pp.el" nil nil) ("profile.el" "generate run time measurements of Emacs Lisp functions" (lisp tools)) ("prolog.el" "major mode for editing and running Prolog under Emacs" (languages)) ("ps-print.el" "Jim's Pretty-Good PostScript Generator for Emacs 19." (print postscript)) ("rcompile.el" nil (tools processes)) ("rect.el" "rectangle functions for GNU Emacs." (internal)) ("refbib.el" "convert refer-style references to ones usable by Latex bib" (bib tex)) ("refer.el" "look up references in bibliography files." (bib)) ("regi.el" "REGular expression Interpreting engine" (extensions matching)) ("register.el" "register commands for Emacs." (internal)) ("replace.el" "replace commands for Emacs." nil) ("reporter.el" "customizable bug reporting of lisp programs" (bug reports lisp)) ("reposition.el" "center a Lisp function or comment on the screen" nil) ("resume.el" "process command line args from within a suspended Emacs job" (processes)) ("rfc822.el" "hairy rfc822 parser for mail and news and suchlike" (mail)) ("ring.el" "handle rings of items" (extensions)) ("rlogin.el" "remote login interface" (unix comm)) ("rmail.el" "main code of \"RMAIL\" mail reader for Emacs." (mail)) ("rmailedit.el" "\"RMAIL edit mode\" Edit the current message." (mail)) ("rmailkwd.el" "part of the \"RMAIL\" mail reader for Emacs." (mail)) ("rmailmsc.el" "miscellaneous support functions for the RMAIL mail reader" (mail)) ("rmailout.el" "\"RMAIL\" mail reader for Emacs: output message to a file." (mail)) ("rmailsort.el" "Rmail: sort messages." (mail)) ("rmailsum.el" "make summary buffers for the mail reader" (mail)) ("rnews.el" "USENET news reader for gnu emacs" (news)) ("rnewspost.el" "USENET news poster/mailer for GNU Emacs" (mail news)) ("rot13.el" "display a buffer in rot13." nil) ("rsz-mini.el" "dynamically resize minibuffer to display entire contents" (minibuffer window frame display)) ("s-region.el" "set region using shift key." (terminals)) ("saveplace.el" "automatically save place in files." (bookmarks placeholders)) ("sc.el" nil nil) ("scheme.el" "Scheme mode, and its idiosyncratic commands." (languages lisp)) ("scribe.el" "scribe mode, and its idiosyncratic commands." (wp)) ("scroll-bar.el" "window system-independent scroll bar support." (hardware)) ("select.el" "lisp portion of standard selection support." (internal)) ("sendmail.el" "mail sending commands for Emacs." (mail)) ("server.el" "Lisp code for GNU Emacs running as server process." (processes)) ("sgml-mode.el" "SGML-editing mode" (wp)) ("sh-script.el" "shell-script editing commands for Emacs" (shell programming)) ("shadowfile.el" nil nil) ("shell.el" "specialized comint.el for running the shell." (processes)) ("simple.el" "basic editing commands for Emacs" nil) ("simula.el" "SIMULA 87 code editing commands for Emacs" (languages)) ("skeleton.el" "Metalanguage for writing statement skeletons" (shell programming)) ("solar.el" "calendar functions for solar events." (calendar)) ("sort.el" "commands to sort text in an Emacs buffer." (unix)) ("soundex.el" nil (matching)) ("spell.el" "spelling correction interface for Emacs." (wp unix)) ("spook.el" "spook phrase utility for overloading the NSA line eater" (games)) ("startup.el" "process Emacs shell arguments" (internal)) ("studly.el" "StudlyCaps (tm)(r)(c)(xxx)" (games)) ("subr.el" "basic lisp subroutines for Emacs" nil) ("sun-curs.el" "cursor definitions for Sun windows" (hardware)) ("sun-fns.el" "subroutines of Mouse handling for Sun windows" (hardware)) ("supercite.el" "minor mode for citing mail and news replies" (mail news)) ("swedish.el" "miscellaneous functions for dealing with Swedish." (i18n)) ("tabify.el" "tab conversion commands for Emacs" nil) ("talk.el" "Allow several users to talk to each other through Emacs." (comm frames)) ("tar-mode.el" "simple editing of tar files from GNU emacs" (unix)) ("tcl-mode.el" nil (languages processes tools)) ("tcp.el" nil nil) ("telnet.el" "run a telnet session from within an Emacs buffer" nil) ("tempo.el" "Flexible template insertion" (extensions languages tools)) ("term-nasty.el" "Damned Things from terminfo.el" nil) ("term.el" nil nil) ("terminal.el" "terminal emulator for GNU Emacs." (comm terminals)) ("tex-mode.el" "TeX, LaTeX, and SliTeX mode commands." (tex)) ("texinfmt.el" nil nil) ("texinfo.el" nil nil) ("texnfo-upd.el" nil (maint tex docs)) ("text-mode.el" "text mode, and its idiosyncratic commands." nil) ("thingatpt.el" "Get the `thing' at point" (extensions matching mouse)) ("time-stamp.el" "Maintain last change time stamps in files edited by Emacs" (tools)) ("time.el" "display time and load in mode line of Emacs." nil) ("timer.el" "run a function with args at some time in future" nil) ("timezone.el" nil nil) ("tmm.el" nil nil) ("tpu-edt.el" "Emacs emulating TPU emulating EDT" (emulations)) ("tpu-extras.el" "Scroll margins and free cursor mode for TPU-edt" (emulations)) ("tpu-mapper.el" nil (emulations)) ("tq.el" "utility to maintain a transaction queue" (extensions)) ("trace.el" "tracing facility for Emacs Lisp functions" (tools lisp)) ("two-column.el" "minor mode for editing of two-column text" nil) ("type-break.el" "encourage rests from typing at appropriate intervals" (extensions timers)) ("uncompress.el" "auto-decompression hook for visiting .Z files" nil) ("underline.el" "insert/remove underlining (done by overstriking) in Emacs." (wp)) ("undigest.el" "digest-cracking support for the RMAIL mail reader" (mail)) ("unrmail.el" "convert Rmail files to mailbox files." (mail)) ("unused.el" "editing commands in GNU Emacs that turned out not to be used." (emulations)) ("upd-copyr.el" "update the copyright notice in a GNU Emacs Lisp file" (maint)) ("userlock.el" "handle file access contention between multiple users" (internal)) ("vc-hooks.el" "resident support for version-control" nil) ("vc.el" "drive a version-control system from within Emacs" nil) ("version.el" "record version number of Emacs." (internal)) ("vi.el" "major mode for emulating \"vi\" editor under GNU Emacs." (emulations)) ("view.el" "peruse file or buffer without editing." nil) ("vip.el" "a VI Package for GNU Emacs" (emulations)) ("viper-ex.el" nil nil) ("viper-keym.el" nil nil) ("viper-macs.el" nil nil) ("viper-mous.el" nil nil) ("viper-util.el" "Utilities used by viper.el" nil) ("viper.el" "A full-featured Vi emulator for GNU Emacs 19 and XEmacs 19," nil) ("vms-patch.el" "override parts of files.el for VMS." (vms)) ("vms-pmail.el" "use Emacs as the editor within VMS mail." (vms)) ("vmsproc.el" "run asynchronous VMS subprocesses under Emacs" (vms)) ("vmsx.el" "run asynchronous VMS subprocesses under Emacs" (vms)) ("vt-control.el" "Common VTxxx control functions" (terminals)) ("vt100-led.el" "functions for LED control on VT-100 terminals & clones." (hardware)) ("window.el" "GNU Emacs window commands aside from those written in C." nil) ("winnt.el" nil nil) ("ws-mode.el" "WordStar emulation mode for GNU Emacs" (emulations)) ("x-apollo.el" "Apollo support functions" nil) ("x-menu.el" "menu support for X " nil) ("xscheme.el" "run Scheme under Emacs" (languages lisp)) ("yow.el" "quote random zippyisms" (games)) ("browse-url.el" "ask a WWW browser to load a URL" (hypertext)) ("cal-chinese.el" "calendar functions for the Chinese calendar." (calendar)) ("cal-coptic.el" "calendar functions for the Coptic/Ethiopic calendars." (calendar)) ("cal-hebrew.el" "calendar functions for the Hebrew calendar." (calendar)) ("cal-islamic.el" "calendar functions for the Islamic calendar." (calendar)) ("cal-iso.el" "calendar functions for the ISO calendar." (calendar)) ("cal-julian.el" "calendar functions for the Julian calendar." (calendar)) ("cal-move.el" "calendar functions for movement in the calendar" (calendar)) ("cal-tex.el" "calendar functions for printing calendars with LaTeX." (calendar)) ("cc-compat.el" "cc-mode compatibility with c-mode.el confusion" (c languages oop)) ("copyright.el" "update the copyright notice in current buffer" (maint tools)) ("diary.el" "diary functions." (calendar)) ("ediff-hook.el" "setup for Ediff's menus and autoloads" nil) ("ediff-meta.el" "support for multi-file/multi-buffer processing in Ediff" nil) ("executable.el" "base functionality for executable interpreter scripts" (languages unix)) ("goto-addr.el" "click to browse URL or to send to e-mail address" (mh-e www mouse mail)) ("iso02-acc.el" "electric accent keys for Eastern Europe (ISO latin2)" nil) ("iso02-syn.el" "set up case-conversion and syntax tables for ISO 8859-2" (i18n)) ("morse.el" "Convert text to morse code and back." nil) ("pc-select.el" "emulate mark, cut, copy and paste from motif" nil) ("site-load.el" nil nil) ("site-start.el" nil nil) ("solitaire.el" "game of solitaire in Emacs Lisp" (games)) ("subdirs.el" nil nil) ("uniquify.el" "unique buffer names dependent on pathname" nil) ("xt-mouse.el" "Support the mouse when emacs run in an xterm." (mouse terminals))) finder-package-info provide finder-inf] 2) emacs-19.30/lisp/finder.elc100666 13437 1 14776 6054022036 14201 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 20 01:45:30 1995 ;;; from file /home/fsf/rms/e19/lisp/finder.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`finder.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÄ BÆÇ!„ÈÇ BÆÉ!„&Ê É B „bË \fÍ\fÎÏ#ˆÍ\fÐÏ#ˆÍ\fÑÏ#ˆÍ\fÒÓ#ˆÍ\fÔÕ#ˆÍ\fÖ×#ˆ\f )ʇ" [require lisp-mnt finder-inf picture finder-headmark current-load-list boundp finder-known-keywords ((abbrev . "abbreviation handling, typing shortcuts, macros") (bib . "code related to the `bib' bibliography processor") (c . "support for the C language and related languages") (calendar . "calendar and time management support") (comm . "communications, networking, remote access to files") (data . "support editing files of data") (docs . "support for Emacs documentation") (emulations . "emulations of other editors") (extensions . "Emacs Lisp language extensions") (faces . "support for multiple fonts") (frames . "support for Emacs frames and window systems") (games . "games, jokes and amusements") (hardware . "support for interfacing with exotic hardware") (help . "support for on-line help systems") (hypermedia . "support for links between text or other media types") (i18n . "internationalization and alternate character-set support") (internal . "code for Emacs internals, build process, defaults") (languages . "specialized modes for editing programming languages") (lisp . "Lisp support, including Emacs Lisp") (local . "code local to your site") (maint . "maintenance aids for the Emacs development group") (mail . "modes for electronic-mail handling") (matching . "various sorts of searching and matching") (mouse . "mouse support") (news . "support for netnews reading and posting") (oop . "support for object-oriented programming") (outlines . "support for hierarchical outlining") (processes . "process, subshell, compilation, and job control support") (terminals . "support for terminal types") (tex . "code related to the TeX formatter") (tools . "programming tools") (unix . "front-ends/assistants for, or emulators of, UNIX features") (vms . "support code for vms") (wp . "word processing")) finder-mode-map nil make-sparse-keymap map define-key " " finder-select "f" " " "?" finder-summary "q" finder-exit "d" finder-list-keywords] 4) #@63 Assoc list mapping file names to description & keyword lists. (defvar finder-package-info nil (#$ . 2551)) #@186 Regenerate the keywords association list into the file `finder-inf.el'. Optional arguments are a list of Emacs Lisp directories to compile from; no arguments compiles from `load-path'. (defalias 'finder-compile-keywords #[(&rest dirs) "ŠÀÂÃ!ˆÄ ˆÅcˆÆcˆÇcˆÈcˆÉcˆÊcˆËÌ †%\"ˆÏcˆÐÑ!ˆÒ ˆÓ *‡" [nil processed find-file "finder-inf.el" erase-buffer ";;; finder-inf.el --- keyword-to-package mapping\n" ";; Keywords: help\n" ";;; Commentary:\n" ";; Don't edit this file. It's generated by finder.el\n\n" ";;; Code:\n" "\n(setq finder-package-info '(\n" mapcar #[(d) "ÀÁ †Ä!\"‡" [mapcar #[(f) "ÀÁ\n\"…f\n ?…fĉ‰\n BŠÈÉ!qˆÊp!ˆË ˆÌ͆/Ï!\nP!ˆÐ Ñ )ÒÓ\n\"cˆÔp\"ˆÕcˆ` ƒYÒÖ \"‚Z×رˆÙ`ÚÛ$+‡" [string-match "^[^=].*\\.el$" f processed nil keywords keystart summary get-buffer-create "*finder-scratch*" buffer-disable-undo erase-buffer insert-file-contents file-name-as-directory d "." lm-synopsis lm-keywords format " (\"%s\"\n " prin1 "\n " "(%s)" "nil" ")\n" subst-char-in-region 44 32] 5] directory-files d "."] 4] dirs load-path "))\n\n(provide 'finder-inf)\n\n;;; finder-inf.el ends here\n" kill-buffer "*finder-scratch*" eval-current-buffer basic-save-buffer] 3 (#$ . 2665)]) #@60 Display descriptions of the keywords in the Finder buffer. (defalias 'finder-list-keywords #[nil "À ˆÃÄ \"ˆebˆ`ÇÈÀ!ˆÉ ˆÊ ‡" [nil buffer-read-only erase-buffer mapcar #[(assoc) "@ !cˆÃÄAÅP\"ˆÂ ! )B‡" [assoc keyword symbol-name insert-at-column 14 "\n"] 4] finder-known-keywords finder-headmark t set-buffer-modified-p balance-windows finder-summary] 3 (#$ . 3884) nil]) (defalias 'finder-list-matches #[(key) "À ˆÃ\f!Æ\fDZˆ`ÉÊ \"ˆebˆÀyˆÌÍÀ!ˆÎ ˆÏ )‡" [nil buffer-read-only erase-buffer intern key id "The following packages match the keyword `" "':\n\n" finder-headmark mapcar #[(x) " AA@>… @cˆÂà A@ÄP\"‡" [id x insert-at-column 16 "\n"] 4] finder-package-info t set-buffer-modified-p shrink-window-if-larger-than-buffer finder-summary] 3]) (defalias 'finder-find-library #[(file) "À !ƒ ‡\nɃ@\f„@ÆÇ ÈP @\"!ƒ)Ç @\"‚9ÆÇ @\"!ƒ9Ç @\" A‰„\f*‡" [file-name-absolute-p file load-path nil found dirs file-exists-p expand-file-name ".el"] 5]) (defalias 'finder-commentary #[(file) "ÀÁ\n!!‰„ÄÅ!ˆÆÇ!ˆÈ Ê ˆ cˆebˆË ˆdbˆË ˆebˆÌÍÈÎ#ƒ;ÏÐȉ#ˆ‚*ebˆÎ ÑÈ!ˆÒ ˆÓ )‡" [lm-commentary finder-find-library file str error "Can't find any Commentary section" pop-to-buffer "*Finder*" nil buffer-read-only erase-buffer delete-blank-lines re-search-forward "^;+ ?" t replace-match "" set-buffer-modified-p shrink-window-if-larger-than-buffer finder-summary] 5 nil nil]) (defalias 'finder-current-item #[nil "ƒ`WƒÁÂ!‡ŠÃyˆÄ )‡" [finder-headmark error "No keyword or filename on this line" 0 current-word] 2]) (defalias 'finder-select #[nil "À Âà \"ƒÄ !‚Å !)‡" [finder-current-item key string-match "\\.el$" finder-commentary finder-list-matches] 3 nil nil]) #@41 Find packages matching a given keyword. (defalias 'finder-by-keyword #[nil "À ˆÁ ‡" [finder-mode finder-list-keywords] 1 (#$ . 5570) nil]) #@188 Major mode for browsing package documentation. \ \[finder-select] more help for the item on the current line \[finder-exit] exit Finder mode and kill the Finder buffer.  (defalias 'finder-mode #[nil "ÀÁ!ˆÂÄ ˆÅ!ˆÇ!ˆÉ\nË\fÍÎ!ˆÂ‰‡" [pop-to-buffer "*Finder*" nil buffer-read-only erase-buffer use-local-map finder-mode-map set-syntax-table emacs-lisp-mode-syntax-table "Finder" mode-name finder-mode major-mode make-local-variable finder-headmark] 2 (#$ . 5716) nil]) #@34 Summarize basic Finder commands. (defalias 'finder-summary #[nil "ÀÁÂ!!‡" [message substitute-command-keys "\\\\[finder-select] = select, \\[finder-list-keywords] = to finder directory, \\[finder-exit] = quit, \\[finder-summary] = help"] 3 (#$ . 6212) nil]) #@38 Exit Finder mode and kill the buffer (defalias 'finder-exit #[nil "À ˆÁÂ!‡" [delete-window kill-buffer "*Finder*"] 2 (#$ . 6493) nil]) (provide (quote finder)) emacs-19.30/lisp/float-sup.elc100666 13437 1 2322 5744576116 14626 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:39:58 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/float-sup.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/float-sup.el' was compiled for Emacs 19")) (byte-code "ÀÁ!„\nÂÃ!ˆÀ‡" [fboundp atan error "Floating point was disabled at compile time"] 2) #@32 The value of Pi (3.1415926...) (defconst pi (byte-code "ÀÁ!Â_‡" [atan 1 4] 2) (#$ . 584)) #@31 The value of e (2.7182818...) (defconst e (exp 1) (#$ . 680)) #@39 Degrees to radian conversion constant (defconst degrees-to-radians (/ pi 180.0) (#$ . 748)) #@38 Radian to degree conversion constant (defconst radians-to-degrees (/ 180.0 pi) (#$ . 846)) #@38 Convert ARG from degrees to radians. (defalias 'degrees-to-radians '(macro . #[(x) "À Â¥ E‡" [* pi 180.0 x] 3 (#$ . 943)])) #@38 Convert ARG from radians to degrees. (defalias 'radians-to-degrees '(macro . #[(x) "ÀÁ\n¥ E‡" [* 180.0 pi x] 3 (#$ . 1073)])) (provide (quote lisp-float-type)) emacs-19.30/lisp/float.elc100666 13437 1 20413 5744576122 14037 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:39:59 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/float.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/float.el' was compiled for Emacs 19")) #@57 Base of exponent in this floating point representation. (defconst exp-base 2 (#$ . 479)) #@67 Number of significant bits in this floating point representation. (defconst mantissa-bits 24 (#$ . 574)) #@51 Number of decimal digits expected to be accurate. (defconst decimal-digits 6 (#$ . 685)) #@61 Maximum permitted digits in a scientific notation exponent. (defconst expt-digits 2 (#$ . 780)) #@23 Number of highest bit (defconst maxbit (1- mantissa-bits) (#$ . 882)) #@39 Maximum permissible value of mantissa (defconst mantissa-maxval (byte-code "ÀÁ\n\"S‡" [ash 1 maxbit] 3) (#$ . 958)) #@39 Minimum permissible value of mantissa (defconst mantissa-minval (ash 1 maxbit) (#$ . 1080)) #@173 Regular expression to match floating point numbers. Extract matches: 1 - minus sign 2 - integer part 4 - fractional part 8 - minus sign for power of ten 9 - power of ten  (defconst floating-point-regexp "^[ ]*\\(-?\\)\\([0-9]*\\)\\(\\.\\([0-9]*\\)\\|\\)\\(\\(\\([Ee]\\)\\(-?\\)\\([0-9][0-9]*\\)\\)\\|\\)[ ]*$" (#$ . 1179)) #@50 Masks all bits except the high-order (sign) bit. (defconst high-bit-mask (ash 1 maxbit) (#$ . 1511)) #@55 Masks all bits except the highest-order magnitude bit (defconst second-bit-mask (byte-code "ÀÁ\nS\"‡" [ash 1 maxbit] 3) (#$ . 1618)) (byte-code "ÀÂÄÆÈ T \"‰\nËIˆ\nÌÍIˆ\nÎÏIˆ\nÐÑIˆ\nÒÓIˆ\nÔÕIˆ\n SH\n Hȇ" [(0 . 1) _f0 (4194304 . -23) _f1/2 (4194304 . -22) _f1 (5242880 . -19) _f10 make-vector decimal-digits powers-of-10 1 2 (6553600 . -16) 3 (8192000 . -13) 4 (5120000 . -9) 5 (6400000 . -6) 6 (8000000 . -3) all-decimal-digs-minval highest-power-of-10] 4) (defalias 'fashl #[(fnum) "À @Â\" ASB‡" [ash fnum 1] 3]) (defalias 'fashr #[(fnum) "À @Â\" ATB‡" [ash fnum -1] 3]) (defalias 'normalize #[(fnum) "@ÁVƒÂ@ \"ÁUƒ3Ä!‚@ÁWƒ0Â@ \"ÁUƒ3Ä!‚‡" [fnum 0 logand second-bit-mask fashl high-bit-mask _f0] 3]) (defalias 'abs #[(n) "ÁYƒ‡[‡" [n 0] 2]) (defalias 'fabs #[(fnum) "ÀÁ\n@!\nAB!‡" [normalize abs fnum] 3]) (defalias 'xor #[(a b) "„ …… ?‡" [a b] 1]) (defalias 'same-sign #[(a b) "ÀÁ\n@!Á @!\"?‡" [xor natnump a b] 4]) (defalias 'extract-match #[(str i) "ÀÁ‡" [nil (byte-code " ” •O‡" [str i] 3) ((error ""))] 3]) (byte-code "Á¥ÃÄ\n\"SÆ !ÃÄ\nÁ¥\"Á‡" [mantissa-bits 2 halfword-bits ash 1 masklo lognot maskhi round-limit] 4) (defalias 'hihalf #[(n) "ÀÁ\n \"\f[\"‡" [ash logand n maskhi halfword-bits] 4]) (defalias 'lohalf #[(n) "À \n\"‡" [logand n masklo] 3]) #@48 Returns the sum of two floating point numbers. (defalias 'f+ #[(a1 a2) "À \n\"à \n\"Æ \n\"ƒÇ !Ç\f!È @É\f@\fA AZ\"\\ AB!*‡" [fmax a1 a2 fmin f2 f1 same-sign fashr normalize ash] 6 (#$ . 2946)]) #@55 Returns the difference of two floating point numbers. (defalias 'f- #[(a1 &optional a2) "ƒ Á\nÃ!\"‡Ä\n@[\nAB!‡" [a2 f+ a1 f- normalize] 4 (#$ . 3151)]) #@52 Returns the product of two floating point numbers. (defalias 'f* #[(a1 a2) "À !@À !@Å \"?ÇÈ\n!È\f!_!ÈÇ\n!È\f!_!ȉ\n!Ç\f!_!\\\\ Ç\n!Ç\f!_lj\n!È\f!_!ÇÈ\n!Ç\f!_!Ç !\\\\\\\nÈ ! Vƒa\nT\ñm\n[‚o\nÀ !AÀ !A \\\\B!-‡" [fabs a1 i1 a2 i2 same-sign sign hihalf lohalf prodlo prodhi round-limit normalize mantissa-bits] 6 (#$ . 3312)]) #@53 Returns the quotient of two floating point numbers. (defalias 'f/ #[(a1 a2) "@ÁUƒÂÃÄ E\"‡SÁÇ !@Ç!@È \"? \n \f Î !ƒc \nZÁWƒEÏ\fÐ\"\f‚TÏ\fÐ\"T\f \nZ Ï Ð\"  S ‚*Ñ ƒo\f[‚q\fÇ !AÇ!AZSZB!-‡" [a2 0 signal arith-error "attempt to divide by zero" a1 maxbit fabs same-sign sign divisor dividend quotient bits natnump ash 1 normalize] 7 (#$ . 3662)]) #@73 Returns the remainder of first floating point number divided by second. (defalias 'f% #[(a1 a2) "À ÂÃÄ \"! \"\"‡" [f- a1 f* ftrunc f/ a2] 7 (#$ . 4047)]) #@67 Returns t if two floating point numbers are equal, nil otherwise. (defalias 'f= #[(a1 a2) " š‡" [a1 a2] 2 (#$ . 4208)]) #@81 Returns t if first floating point number is greater than second, nil otherwise. (defalias 'f> #[(a1 a2) "À @!ƒ\n@ÃWƒć @ÃVƒ \n@ÃXƒ ć @ÃXƒ0À\n@!ƒ0Ň A\nAU„> A\nAV‡ @\n@V‡" [natnump a1 a2 0 t nil] 2 (#$ . 4335)]) #@94 Returns t if first floating point number is greater than or equal to second, nil otherwise. (defalias 'f>= #[(a1 a2) "À \n\"† à \n\"‡" [f> a1 a2 f=] 3 (#$ . 4562)]) #@78 Returns t if first floating point number is less than second, nil otherwise. (defalias 'f< #[(a1 a2) "À \n\"?‡" [f>= a1 a2] 3 (#$ . 4735)]) #@90 Returns t if first floating point number is less than or equal to second, nil otherwise. (defalias 'f<= #[(a1 a2) "À \n\"?‡" [f> a1 a2] 3 (#$ . 4881)]) #@81 Returns t if first floating point number is not equal to second, nil otherwise. (defalias 'f/= #[(a1 a2) "À \n\"?‡" [f= a1 a2] 3 (#$ . 5039)]) #@52 Returns the minimum of two floating point numbers. (defalias 'fmin #[(a1 a2) "À \n\"ƒ ‡\n‡" [f< a1 a2] 3 (#$ . 5188)]) #@52 Returns the maximum of two floating point numbers. (defalias 'fmax #[(a1 a2) "À \n\"ƒ ‡\n‡" [f> a1 a2] 3 (#$ . 5315)]) #@64 Returns t if the floating point number is zero, nil otherwise. (defalias 'fzerop #[(fnum) "@ÁU‡" [fnum 0] 2 (#$ . 5442)]) #@65 Returns t if the arg is a floating point number, nil otherwise. (defalias 'floatp #[(fnum) ":…@¨…A¨‡" [fnum] 1 (#$ . 5571)]) #@73 Convert the integer argument to floating point, like a C cast operator. (defalias 'f #[(int) "À ÂB!‡" [normalize int 0] 3 (#$ . 5709)]) #@63 Convert the integer argument to a C-style hexadecimal string. (defalias 'int-to-hex-string #[(int) "ÀÁ‰ÆXƒ#\fÇ ÈÉ\n \"Ë\"H!P Ì\\‰‚\f+‡" [-20 "0x" "0123456789ABCDEF" hex-chars str shiftval 0 char-to-string logand lsh int 15 4] 8 (#$ . 5851)]) #@58 Truncate the fractional part of a floating point number. (defalias 'ftrunc #[(fnum) "À A!ƒ ‡ A\n[XƒÇ @ AÆÀ !ƒ+lj \f\"\f[\"‚5lj [\f\"\f[\"[\fB!*‡" [natnump fnum maxbit (0 . 1) exp mant normalize ash] 5 (#$ . 6109)]) #@89 Convert the floating point number to integer, with truncation, like a C cast operator. (defalias 'fint #[(fnum) "À !‰@\nA‰ Yƒ‚%\f [Xƒ!‚%È \f\"+‡" [ftrunc fnum tf tint texp mantissa-bits mantissa-maxval mantissa-minval ash] 4 (#$ . 6339)]) #@120 Convert the floating point number to a decimal string. Optional second argument non-nil means use scientific notation. (defalias 'float-to-string #[(fnum &optional sci) "À ! @ÃWÃÃÇà \n Ì  \"ƒ$΂ZÏ\n\n\"ƒ`ÐÑ \"‰ \n\"ƒG  \\‚,ÐÑ \"‰ \n\"ƒ‘  T‚GÕÖ \"‰ \n\"ƒ{  Z‚`Õ \n\"ƒ‘Ö \" S‚{ÑÖ\n \"\"Ø\n!ÙÕÛ\n\"\"ƒ¹Ý!T‚¿Ý!Þ!ßYƒÏ T) ƒëÃáOâáÙOãÞ !°‚M SYƒ Z$å$!ƒÎP$S$‚ù)‚M ÃWƒ= [æZ$å$!ƒ3ÎP$S$‚çP)‚Mà TOâ TÙOQ\fƒXèP‚Z.‡" [fabs fnum value 0 sign power result "" str temp _f1 pow10 f= _f0 "0" f>= f<= f* highest-power-of-10 decimal-digits _f10 f> f/ all-decimal-digs-minval ftrunc nil int f- _f1/2 fint int-to-string 1000000 sci 1 "." "E" zeroes natnump 2 "0." "-"] 6 (#$ . 6598)]) #@358 Convert the string to a floating point number. Accepts a decimal string in scientific notation, with exponent preceded by either E or e. Only the six most significant digits of the integer and fractional parts are used; only the first two digits of the exponent are used. Negative signs preceding both the decimal number and the exponent are recognized. (defalias 'string-to-float #[(str) "À \nÃ#ƒÄÆÇ\nÈ\" Ç\nÊ\"   P\fÇ\nÍ\"ΚÃÄ GZ\fGWƒO\fHÓUƒOT‰‚5 Z\fÄO‰\fGVƒx\fHÔY\fÃO\f‚ \fGZ\\ÕÖ\f!ƒÍ‚Ã\\ƒš×‚›Í_!.Ç\nØ\"Ç\nÚ\"ΚÃÃà Æ!ÖÃ\"G^O!ƒÒׂÓÍ_ \\‰ÃWƒæ[ã!¥¦ÃVƒ ! $\" S‰‚ö! %H\".\")‡&‡" [string-match floating-point-regexp str 0 nil power f* extract-match 2 int-subst 4 fract-subst digit-string 1 "-" mant-sign leading-0s round-up decimal-digits 48 53 f string-to-int -1 9 expt-subst 8 expt-sign expt chunks tens _f1 exponent func expt-digits f/ highest-power-of-10 powers-of-10 _f0] 8 (#$ . 7411)]) (provide (quote float)) emacs-19.30/lisp/flow-ctrl.elc100666 12120 1 4155 6043465400 14461 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:51:09 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/flow-ctrl.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`flow-ctrl.el' was compiled for Emacs 19.29 or later")) #@69 Character that replaces C-s, when flow control handling is enabled. (defvar flow-control-c-s-replacement 28 (#$ . 485)) #@69 Character that replaces C-q, when flow control handling is enabled. (defvar flow-control-c-q-replacement 30 (#$ . 611)) (put (quote keyboard-translate-table) (quote char-table-extra-slots) 0) #@173 Toggle flow control handling. When handling is enabled, user can type C-s as C-\, and C-q as C-^. With arg, enable flow control mode if arg is positive, otherwise disable. (defalias 'enable-flow-control #[(&optional argument) "ƒ\fÁ!ÂX‚à A@ƒ;ÄÅÆÇà 8#ˆ…Ä ÆIˆÊÆIˆ ÆIˆÌÆI‡ÄÆÅÇà 8#ˆ„RÍÈÆ\"‚‘Î!ƒbÏ!‚‘ÍÈÆ\"ÂG‰Wƒ‹œIˆT‰‚q*) ÊIˆÊ Iˆ ÌIˆÌ IˆÓÔÕÖ!×Ø !ÙØ !Ú°!ˆÛÇ!‡" [argument prefix-numeric-value 0 current-input-mode set-input-mode t nil 2 keyboard-translate-table flow-control-c-s-replacement 19 flow-control-c-q-replacement 17 make-char-table char-table-p copy-sequence the-table j i message "XON/XOFF adjustment for " getenv "TERM" ": use " single-key-description " for C-s, and use " " for C-q" sleep-for] 9 (#$ . 810) "P"]) #@287 Enable flow control if using one of a specified set of terminal types. Use `(enable-flow-control-on "vt100" "h19")' to enable flow control on VT-100 and H19 terminals. When flow control is enabled, you must type C-\ to get the effect of a C-s, and type C-^ to get the effect of a C-q. (defalias 'enable-flow-control-on #[(&rest losing-terminal-types) "ÀÁ!‰…$ÅÆ\f\"‰ƒ\fÇ O‚\n\f…$É *‡" [getenv "TERM" nil hyphend term string-match "[-_][^-_]+$" 0 losing-terminal-types enable-flow-control] 4 (#$ . 1610)]) (provide (quote flow-ctrl)) emacs-19.30/lisp/foldout.elc100666 12120 1 14040 5744576126 14255 0ustar rmsdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:40:03 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/foldout.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/foldout.el' was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!„ÄÅ!ˆÀ‡" [require outline boundp outline-minor-mode error "Can't find outline-minor-mode"] 2) #@124 List of start and end markers for the folds currently entered. An end marker of NIL means the fold ends after (point-max). (defconst foldout-fold-list nil (#$ . 599)) (make-variable-buffer-local (quote foldout-fold-list)) #@60 Modeline string announcing that we are in an outline fold. (defconst foldout-modeline-string nil (#$ . 827)) (byte-code "ÀÁ!ˆÁ\nž„%Ã\nž\n>ĉ„ÇÈ!ˆ A¤¡ˆ*À‡" [make-variable-buffer-local foldout-modeline-string minor-mode-alist outline-minor-mode ((foldout-modeline-string foldout-modeline-string)) foldout-entry outl-entry error "Can't find outline-minor-mode in minor-mode-alist"] 4) #@342 Open the subtree under the current heading and narrow to it. Normally the body and the immediate subheadings are exposed, but optional arg EXPOSURE (interactively with prefix arg) changes this:- EXPOSURE > 0 exposes n levels of subheadings (c.f. show-children) EXPOSURE < 0 exposes only the body EXPOSURE = 0 exposes the entire subtree (defalias 'foldout-zoom-subtree #[(&optional exposure) "Š~ˆÀ ˆÁ\n!`Å Ç ˆÈÉwˆ`\nm?…&Ë \nTÉ“\f\f\n}ˆ\fbˆ\n„=Í ˆÎ ˆ‚d ÏWƒIÍ ˆ‚d\n:ƒTÎ ˆ‚d ÏVƒaÎ !ˆ‚dÐ ˆ\fBBÒ .‡" [outline-back-to-heading prefix-numeric-value exposure exposure-value start point-marker start-marker outline-end-of-subtree "\n " nil end make-marker end-marker show-entry show-children 0 show-subtree foldout-fold-list foldout-update-modeline] 3 (#$ . 1226) "P"]) #@183 Return to the ARG'th enclosing fold view. With ARG = 0 exit all folds. Normally causes exited folds to be hidden, but with ARG < 0, -ARG folds are exited and text is left visible. (defalias 'foldout-exit-fold #[(&optional num-folds) "À‰Á „ÆÇ!ˆÉUƒ G‚*ÉWƒ*À[ G^~ˆÉU„§ @@ @A AS ƒ] bˆÊuˆhË>„]ÌcˆÉUƒ–` ƒyÊuˆhÍ>ƒuÊuˆ`‚zd\nƒ‰Ð\fÑ#ˆ ƒ•ÐÌ#ˆ*\fÀ‰“ˆ ƒ3 À‰“ˆ‚3 ƒÂ @@ @A\f ƒ¿Ò !S‚Àd}ˆÓ ˆÔ +‡" [nil t hide-fold end-marker start-marker foldout-fold-list error "Not in a fold!" num-folds 0 -1 (10 13) 10 (10 13) end-of-subtree beginning-of-heading outline-flag-region 13 marker-position recenter foldout-update-modeline] 4 (#$ . 2022) "p"]) #@53 Set the modeline string to indicate our fold depth. (defalias 'foldout-update-modeline #[nil "G‰ÂUƒ Â&\fƒÅÆ \"‚& ÇUƒ\"È‚&ÅÉ \"‰\n)‡" [foldout-fold-list depth 0 nil outline-minor-mode format ":%d" 1 " Inside 1 fold" " Inside %d folds" foldout-modeline-string] 4 (#$ . 2716)]) #@203 Zoom in on the heading clicked on. How much is exposed by the zoom depends on the number of mouse clicks:- 1 expose body 2 expose subheadings 3 expose body and subheadings 4 expose entire subtree (defalias 'foldout-mouse-zoom #[(event) "À ! !ˆÃ Ä 8¨ƒÄ 8‚Å)‰ÅUƒ&Ç‚=ÄUƒ1È‚=ÉUƒ<Ê‚=Ë)!‡" [foldout-mouse-swallow-events event foldout-mouse-goto-heading foldout-zoom-subtree 2 1 nclicks -1 (1) 3 nil 0] 4 (#$ . 3009) "@e"]) #@204 Show what is hidden under the heading clicked on. What gets exposed depends on the number of mouse clicks:- 1 expose body 2 expose subheadings 3 expose body and subheadings 4 expose entire subtree (defalias 'foldout-mouse-show #[(event) "À ! !ˆ à 8¨ƒà 8‚Ä)‰ÄUƒ%Æ ‚@ ÃUƒ0Ç ‚@ ÈUƒ>Æ ˆÇ ‚@É )‡" [foldout-mouse-swallow-events event foldout-mouse-goto-heading 2 1 nclicks show-entry show-children 3 show-subtree] 3 (#$ . 3458) "@e"]) #@227 Hide the subtree under the heading clicked on, or exit a fold. What happens depends on the number of mouse clicks:- 1 hide subtree 2 exit fold and hide text 3 exit fold without hiding text 4 exit all folds and hide text (defalias 'foldout-mouse-hide-or-exit #[(event) "À !‰ 8¨ƒ 8‚Ã)‰ÃUƒ%Å !ˆÆ ‚<Ç\fÂUƒ0Â;\fÈUƒ:É‚;Ê!)‡" [foldout-mouse-swallow-events event 2 1 nclicks foldout-mouse-goto-heading hide-subtree foldout-exit-fold 3 -1 0] 4 (#$ . 3914) "@e"]) #@145 Swallow intervening mouse events so we only get the final click-count. Signal an error if the final event isn't the same type as the first one. (defalias 'foldout-mouse-swallow-events #[(event) "À !ÃÄ Æ#„Ç ‚\nÀ !=„ÈÉ!ˆ) ‡" [event-basic-type event initial-event-type sit-for 0 double-click-time nodisplay read-event error ""] 4 (#$ . 4397)]) #@107 Go to the heading where the mouse event started. Signal an error if the event didn't occur on a heading. (defalias 'foldout-mouse-goto-heading #[(event) "‰A@)‰A@:ƒ A@@‚ A@)bˆÂ †,ŠÃyˆo)†,ÄÅ!‡" [event position outline-on-heading-p 0 error "Not a heading line"] 3 (#$ . 4753)]) #@61 Set non-NIL before loading foldout to inhibit key bindings. (defvar foldout-inhibit-key-bindings nil (#$ . 5044)) #@212 List of modifier keys to apply to foldout's mouse events. The default (meta control) makes foldout bind its functions to M-C-down-mouse-{1,2,3}. Valid modifiers are shift, control, meta, alt, hyper and super. (defvar foldout-mouse-modifiers (quote (meta control)) (#$ . 5165)) (byte-code "„zÁ\nÃÄ#ˆÁ\nÅÆ#ˆÁÉPÄ#ˆÁÊPÆ#ˆËÌÍÎ\"\"ÑÒÓP!!ÑÒÕP!!ÑÒ×P!!Á\nÙ#ˆÁ\nÚ#ˆÁ\nÛ#ˆÁÙ#ˆÁÚ#ˆÁÛ#ˆ,ÜÝ!‡" [foldout-inhibit-key-bindings define-key outline-mode-map "" foldout-zoom-subtree "" foldout-exit-fold outline-minor-mode-map outline-minor-mode-prefix "" "" apply concat mapcar #[(modifier) "À Â=ƒ ÂA Ä=ƒÅ‚A Æ=ƒÇ‚A È=ƒ)É‚A Ê=ƒ3Ë‚A Ì=ƒ=Í‚AÎÏ \"Ð\"‡" [vector modifier shift 83 control 67 meta 77 alt 65 hyper 72 super 115 error "invalid mouse modifier %s" 45] 4] foldout-mouse-modifiers modifiers vector intern "down-mouse-1" mouse-1 "down-mouse-2" mouse-2 "down-mouse-3" mouse-3 foldout-mouse-zoom foldout-mouse-show foldout-mouse-hide-or-exit provide foldout] 5) emacs-19.30/lisp/font-lock.elc100666 12120 1 112006 6055512014 14474 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 24 22:56:23 1995 ;;; from file /home/fsf/rms/e19/lisp/font-lock.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`font-lock.el' was compiled for Emacs 19.29 or later")) #@58 *If non-nil, means show status messages when fontifying. (defvar font-lock-verbose t (#$ . -476)) #@588 *If non-nil, the maximum decoration level for fontifying. If nil, use the default decoration (typically the minimum available). If t, use the maximum decoration available. If a number, use that level of decoration (or if not available the maximum). If a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL), where MAJOR-MODE is a symbol or t (meaning the default). For example: ((c++-mode . 2) (c-mode . t) (t . 1)) means use level 2 decoration for buffers in `c++-mode', the maximum decoration available for buffers in `c-mode', and level 1 decoration otherwise. (defvar font-lock-maximum-decoration nil (#$ . -581)) #@537 *If non-nil, the maximum size for buffers for fontifying. Only buffers less than this can be fontified when Font Lock mode is turned on. If nil, means size is irrelevant. If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), where MAJOR-MODE is a symbol or t (meaning the default). For example: ((c++-mode . 256000) (c-mode . 256000) (rmail-mode . 1048576)) means that the maximum size is 250K for buffers in `c++-mode' or `c-mode', one megabyte for buffers in `rmail-mode', and size is irrelevant otherwise. (defvar font-lock-maximum-size 256000 (#$ . -1229)) #@27 Face to use for comments. (defvar font-lock-comment-face (quote font-lock-comment-face) (#$ . 1823)) #@26 Face to use for strings. (defvar font-lock-string-face (quote font-lock-string-face) (#$ . 1930)) #@27 Face to use for keywords. (defvar font-lock-keyword-face (quote font-lock-keyword-face) (#$ . 2034)) #@33 Face to use for function names. (defvar font-lock-function-name-face (quote font-lock-function-name-face) (#$ . 2141)) #@33 Face to use for variable names. (defvar font-lock-variable-name-face (quote font-lock-variable-name-face) (#$ . 2266)) #@29 Face to use for type names. (defvar font-lock-type-face (quote font-lock-type-face) (#$ . 2391)) #@34 Face to use for reference names. (defvar font-lock-reference-face (quote font-lock-reference-face) (#$ . 2494)) #@3550 *A list of the keywords to highlight. Each element should be of the form: MATCHER (MATCHER . MATCH) (MATCHER . FACENAME) (MATCHER . HIGHLIGHT) (MATCHER HIGHLIGHT ...) where HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED. For highlighting single items, typically only MATCH-HIGHLIGHT is required. However, if an item or (typically) items is to be hightlighted following the instance of another item (the anchor) then MATCH-ANCHORED may be required. MATCH-HIGHLIGHT should be of the form: (MATCH FACENAME OVERRIDE LAXMATCH) Where MATCHER can be either the regexp to search for, or the function name to call to make the search (called with one argument, the limit of the search). MATCH is the subexpression of MATCHER to be highlighted. FACENAME is an expression whose value is the face name to use. FACENAME's default attributes may be defined in `font-lock-face-attributes'. OVERRIDE and LAXMATCH are flags. If OVERRIDE is t, existing fontification may be overwritten. If `keep', only parts not already fontified are highlighted. If `prepend' or `append', existing fontification is merged with the new, in which the new or existing fontification, respectively, takes precedence. If LAXMATCH is non-nil, no error is signalled if there is no MATCH in MATCHER. For example, an element of the form highlights (if not already highlighted): "\\\=" Discrete occurrences of "foo" in the value of the variable `font-lock-keyword-face'. ("fu\\(bar\\)" . 1) Substring "bar" within all occurrences of "fubar" in the value of `font-lock-keyword-face'. ("fubar" . fubar-face) Occurrences of "fubar" in the value of `fubar-face'. ("foo\\|bar" 0 foo-bar-face t) Occurrences of either "foo" or "bar" in the value of `foo-bar-face', even if already highlighted. MATCH-ANCHORED should be of the form: (MATCHER PRE-MATCH-FORM POST-MATCH-FORM MATCH-HIGHLIGHT ...) Where MATCHER is as for MATCH-HIGHLIGHT with one exception. The limit of the search is currently guaranteed to be (no greater than) the end of the line. PRE-MATCH-FORM and POST-MATCH-FORM are evaluated before the first, and after the last, instance MATCH-ANCHORED's MATCHER is used. Therefore they can be used to initialise before, and cleanup after, MATCHER is used. Typically, PRE-MATCH-FORM is used to move to some position relative to the original MATCHER, before starting with MATCH-ANCHORED's MATCHER. POST-MATCH-FORM might be used to move, before resuming with MATCH-ANCHORED's parent's MATCHER. For example, an element of the form highlights (if not already highlighted): ("\\\=" (0 anchor-face) ("\\\=" nil nil (0 item-face))) Discrete occurrences of "anchor" in the value of `anchor-face', and subsequent discrete occurrences of "item" (on the same line) in the value of `item-face'. (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil. Therefore "item" is initially searched for starting from the end of the match of "anchor", and searching for subsequent instance of "anchor" resumes from where searching for "item" concluded.) Note that the MATCH-ANCHORED feature is experimental; in the future, we may replace it with other ways of providing this functionality. 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 very careful composing regexps for this list; the wrong pattern can dramatically slow things down! (defvar font-lock-keywords nil (#$ . -2614)) (make-variable-buffer-local (quote font-lock-keywords)) #@145 If set by a major mode, should be the defaults for Font Lock mode. The value should be like the `cdr' of an item in `font-lock-defaults-alist'. (defvar font-lock-defaults nil (#$ . 6271)) #@1493 Alist of default major mode and Font Lock defaults. Each item should be a list of the form: (MAJOR-MODE . (KEYWORDS KEYWORDS-ONLY CASE-FOLD SYNTAX-ALIST SYNTAX-BEGIN)) where MAJOR-MODE is a symbol. KEYWORDS may be a symbol (a variable or function whose value is the keywords to use for fontification) or a list of symbols. If KEYWORDS-ONLY is non-nil, syntactic fontification (strings and comments) is not performed. If CASE-FOLD is non-nil, the case of the keywords is ignored when fontifying. If SYNTAX-ALIST is non-nil, it should be a list of cons pairs of the form (CHAR . STRING) used to set the local Font Lock syntax table, for keyword and syntactic fontification (see `modify-syntax-entry'). If SYNTAX-BEGIN is non-nil, it should be a function with no args used to move backwards outside any enclosing syntactic block, for syntactic fontification. Typical values are `beginning-of-line' (i.e., the start of the line is known to be outside a syntactic block), or `beginning-of-defun' for programming modes or `backward-paragraph' for textual modes (i.e., the mode-dependent function is known to move outside a syntactic block). If nil, the beginning of the buffer is used as a position outside of a syntactic block, in the worst case. These item elements are used by Font Lock mode to set the variables `font-lock-keywords', `font-lock-keywords-only', `font-lock-keywords-case-fold-search', `font-lock-syntax-table' and `font-lock-beginning-of-syntax-function', respectively. (defvar font-lock-defaults-alist (byte-code "ÀÁÂÃÄ Ê BË BÌBÍ BÎ BÏBÐBÑ BÒBÓBÔ BÕBÖB× BØ B¯-‡" [((c-font-lock-keywords c-font-lock-keywords-1 c-font-lock-keywords-2 c-font-lock-keywords-3) nil nil ((95 . "w")) beginning-of-defun) ((c++-font-lock-keywords c++-font-lock-keywords-1 c++-font-lock-keywords-2 c++-font-lock-keywords-3) nil nil ((95 . "w") (126 . "w")) beginning-of-defun) ((lisp-font-lock-keywords lisp-font-lock-keywords-1 lisp-font-lock-keywords-2) nil nil ((58 . "w") (45 . "w") (42 . "w") (43 . "w") (46 . "w") (60 . "w") (62 . "w") (61 . "w") (33 . "w") (63 . "w") (36 . "w") (37 . "w") (95 . "w") (38 . "w") (126 . "w") (94 . "w") (47 . "w")) beginning-of-defun) (scheme-font-lock-keywords nil t ((58 . "w") (45 . "w") (42 . "w") (43 . "w") (46 . "w") (60 . "w") (62 . "w") (61 . "w") (33 . "w") (63 . "w") (36 . "w") (37 . "w") (95 . "w") (38 . "w") (126 . "w") (94 . "w") (47 . "w")) beginning-of-defun) (tex-font-lock-keywords nil nil ((36 . "\""))) tex-mode-defaults scheme-mode-defaults lisp-mode-defaults c++-mode-defaults c-mode-defaults bibtex-mode c++-c-mode c++-mode c-mode elec-c-mode emacs-lisp-mode inferior-scheme-mode latex-mode lisp-mode lisp-interaction-mode plain-tex-mode scheme-mode scheme-interaction-mode slitex-mode tex-mode] 16) (#$ . 6467)) #@113 *Non-nil means Font Lock should not fontify comments or strings. This is normally set via `font-lock-defaults'. (defvar font-lock-keywords-only nil (#$ . -9275)) #@122 *Non-nil means the patterns in `font-lock-keywords' are case-insensitive. This is normally set via `font-lock-defaults'. (defvar font-lock-keywords-case-fold-search nil (#$ . -9444)) #@155 Non-nil means use this syntax table for fontifying. If this is nil, the major mode's syntax table is used. This is normally set via `font-lock-defaults'. (defvar font-lock-syntax-table nil (#$ . 9634)) #@197 *Non-nil means use this function to move back outside of a syntactic block. If this is nil, the beginning of the buffer is used (in the worst case). This is normally set via `font-lock-defaults'. (defvar font-lock-beginning-of-syntax-function nil (#$ . -9843)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÅÁ!ˆÅÄ!ˆÀÆ!„)ÂÆ BÀÇ!„6ÂÇ BÈÇÉÊ#‡" [boundp font-lock-cache-position nil current-load-list font-lock-cache-state make-variable-buffer-local font-lock-mode font-lock-fontified put permanent-local t] 4) #@58 Function or functions to run on entry to Font Lock mode. (defvar font-lock-mode-hook nil (#$ . 10353)) #@1448 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'; - Strings are displayed in `font-lock-string-face'; - Certain other expressions are displayed in other faces according to the value of the variable `font-lock-keywords'. You can enable Font Lock mode in any major mode automatically by turning on in the major mode's hook. For example, put in your ~/.emacs: (add-hook 'c-mode-hook 'turn-on-font-lock) Or for any visited file with the following in your ~/.emacs: (add-hook 'find-file-hooks 'turn-on-font-lock) The default Font Lock mode faces and their attributes are defined in the variable `font-lock-face-attributes', and Font Lock mode default settings in the variable `font-lock-defaults-alist'. You can set your own default settings for some mode, by setting a buffer local value for `font-lock-defaults', via its mode hook. Where modes support different levels of fontification, you can use the variable `font-lock-maximum-decoration' to specify which level you generally prefer. When you turn Font Lock mode on/off the buffer is fontified/defontified, though fontification occurs only if the buffer is less than `font-lock-maximum-size'. To fontify a buffer without turning on Font Lock mode, and regardless of buffer size, you can use \[font-lock-fontify-buffer]. (defalias 'font-lock-mode #[(&optional arg) "ƒ\fÁ!ÂV‚ ?\f:„\f‚! \fž† Æ\fžAÉ Êšƒ/Ë„=ÌÍÎÆ#ˆ‚HÏÍ!ˆÐÍÎËÆ$ˆÑÃ!Lˆƒ—Ò ˆÏÓ!ˆÏÔ!ˆÐÓÕËÆ$ˆÐÔÖËÆ$ˆ×Ø!ˆ„ŃƒÚ Xƒ‰Û ˆ‚ŃÅÝÞÉ \"ˆ‚ѶËÌÓÕÆ#ˆÌÔÖÆ#ˆßed\"ˆà ˆ‚ÅÌÓÕÆ#ˆÌÔÖÆ#ˆà ˆá *‡" [arg prefix-numeric-value 0 font-lock-mode font-lock-maximum-size major-mode t maximum-size on-p buffer-name " *Compiler Input*" nil remove-hook after-change-functions font-lock-after-change-function make-local-hook add-hook make-local-variable font-lock-set-defaults before-revert-hook after-revert-hook font-lock-revert-setup font-lock-revert-cleanup run-hooks font-lock-mode-hook font-lock-fontified buffer-size font-lock-fontify-buffer font-lock-verbose message "Fontifying %s... buffer too big." font-lock-unfontify-region font-lock-thing-lock-cleanup force-mode-line-update] 5 (#$ . 10464) "P"]) #@41 Unconditionally turn on Font Lock mode. (defalias 'turn-on-font-lock #[nil "ÀÁ!‡" [font-lock-mode 1] 2 (#$ . 12774)]) #@60 Fontify the current buffer the way `font-lock-mode' would. (defalias 'font-lock-fontify-buffer #[nil "„t… Á ÂU?ÄÅ!ÆLˆ ƒÇÈÉ \"ˆ\n„&Ë ˆÆÌ͈ ƒ>ÇÎÉ ƒ;Ï‚<Ð#ˆÑ )‡" [font-lock-verbose buffer-size 0 verbose make-local-variable font-lock-fontified nil message "Fontifying %s..." buffer-name font-lock-mode font-lock-set-defaults (byte-code "ŠÀ ÂŽÃed\f#ˆÅ+À‡" [match-data match-data ((store-match-data match-data)) font-lock-fontify-region verbose t font-lock-fontified] 4) ((quit (byte-code "Àed\"‡" [font-lock-unfontify-region] 3))) "Fontifying %s... %s." "done" "aborted" font-lock-after-fontify-buffer] 4 (#$ . 12898) nil]) (defalias 'font-lock-fontify-region #[(beg end &optional loudly) "À Á‰Â É ÊŽ ƒÌ !ˆ ƒ-Î\"ˆ‚6Ñ#ˆÓ#.‡" [buffer-modified-p t syntax-table nil buffer-file-truename buffer-file-name old-syntax-table inhibit-read-only buffer-undo-list modified ((byte-code "À !ˆ\n„à ƒÄÅ!ˆÅ‡" [set-syntax-table old-syntax-table modified buffer-modified-p set-buffer-modified-p nil] 2)) font-lock-syntax-table set-syntax-table font-lock-keywords-only font-lock-unfontify-region beg end font-lock-fontify-syntactically-region loudly font-lock-fontify-keywords-region] 6]) (defalias 'font-lock-unfontify-region #[(beg end) "À Á‰Â‰È \nË#ˆ?…#À …#ÌÂ!-‡" [buffer-modified-p t nil buffer-file-truename buffer-file-name inhibit-read-only buffer-undo-list modified remove-text-properties beg end (face nil) set-buffer-modified-p] 5]) (defalias 'font-lock-after-change-function #[(beg end old-len) "ŠÀ ÂŽÃ\fbˆÅyˆ`bˆÇyˆ`\"+‡" [match-data match-data ((store-match-data match-data)) font-lock-fontify-region beg 0 end 1] 3]) #@111 Put proper face on each string and comment between START and END. START should be at the beginning of a line. (defalias 'font-lock-fontify-syntactically-region #[(start end &optional loudly) "ƒ\nÁP‚ ƒÃP‚Äʼn‰ \n ƒ.ÌÍÎ \"ˆŒ~ˆbˆ=ƒD‚‚„oƒVWƒ`Óe\"‚zÓʼn%‚z ˆÓ`\"Ô8ƒ¸`ÖÂØ#ƒ£ÔÓ`ʼn%8„ŒÙ`Ú$ˆÓ`ʼn%)Ü8„ÆÝ8ƒê`Œe}ˆÅÞ߈)Ù`Ú $ˆÓ`ʼn%)`Wƒ–`‰ƒ–Ö\ná#ƒ–â`ã#ˆÓ`ʼn%‰ƒ–`$Ü8„-Ý8ƒX唉bˆŒe}ˆÅæçˆ)Ù`Ú $ˆÓ$`ʼn%)‚Ô8ƒå”ÖÂØ#ƒzÔÓ$`ʼn%8„cÙ`Ú$ˆÓ$`ʼn%))Å‚ê)…£âè#-‡" [comment-start-skip "\\s\"\\|" "\\s\"" "\\s<\\|" "\\s<" nil prevstate prev state comstart synstart loudly message "Fontifying %s... (syntactically...)" buffer-name start font-lock-cache-position font-lock-cache-state font-lock-beginning-of-syntax-function parse-partial-sexp 3 beg re-search-forward end move put-text-property face font-lock-string-face 4 7 (byte-code "À eÂ#ˆÃÄ!ˆÅÆx‡" [re-search-backward comstart move forward-comment 1 " " nil] 4) ((error (goto-char end))) font-lock-comment-face t remove-text-properties (face nil) here 0 (byte-code "ÀÁ!ˆÂÃx‡" [forward-comment 1 " " nil] 2) ((error (goto-char end))) (face nil)] 8 (#$ . 14580)]) #@276 Fill in one property of the text from START to END. Arguments PROP and VALUE specify the property and value to put where none are already in place. Therefore existing property values are not overwritten. Optional argument OBJECT is the string or buffer containing the text. (defalias 'font-lock-fillin-text-property #[(start end prop value &optional object) "À \n Ä %ĉ…/Ç \n$È   %ˆÀ\n Ä %‰„Ä*‡" [text-property-any start end prop nil object next next-single-property-change put-text-property value] 7 (#$ . 15859)]) (put (quote font-lock-fillin-text-property) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@121 Uniquify LIST, deleting elements using `delq'. Return the list with subsequent duplicate items removed by side effects. (defalias 'font-lock-unique #[(list) "‰ƒÁ@A\"¡‰„)‡" [list delq] 5 (#$ . 16503)]) (put (quote font-lock-unique) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@285 Prepend to one property of the text from START to END. Arguments PROP and VALUE specify the property and value to prepend to the value already in place. The resulting property values are always lists, and unique. Optional argument OBJECT is the string or buffer containing the text. (defalias 'font-lock-prepend-text-property #[(start end prop value &optional object) "<ƒ ‚ CÁ‰ U?…eÇ  $Ê  #Ë Ì\f\n<ƒ:\n‚<\nC\"‰ ‰ ƒW Î @ A\"¡‰ „F) ) %ˆ ‰‚+‡" [value nil prev next val start end next-single-property-change prop object get-text-property put-text-property append list delq] 10 (#$ . 16811)]) (put (quote font-lock-prepend-text-property) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@283 Append to one property of the text from START to END. Arguments PROP and VALUE specify the property and value to append to the value already in place. The resulting property values are always lists, and unique. Optional argument OBJECT is the string or buffer containing the text. (defalias 'font-lock-append-text-property #[(start end prop value &optional object) "<ƒ ‚ CÁ‰ U?…eÇ  $Ê  #Ë Ì\n<ƒ9\n‚;\nC\f\"‰ ‰ ƒW Î @ A\"¡‰ „F) ) %ˆ ‰‚+‡" [value nil prev next val start end next-single-property-change prop object get-text-property put-text-property append list delq] 10 (#$ . 17550)]) (put (quote font-lock-append-text-property) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@111 Apply HIGHLIGHT following a match. HIGHLIGHT should be of the form MATCH-HIGHLIGHT, see `font-lock-keywords'. (defalias 'font-lock-apply-highlight #[(highlight) "@‰” •Ä8\n„Æ8†¶ÇÈ #‚¶ „9É\n ÊË$†¶Ì\n ÊÍA@!$‚¶ Î=ƒLÌ\n ÊÍA@!$‚¶ Ï=ƒŸ\n ÊÍA@!ËÓ\n Ë%ˉ…šÕ\n $Ì\n%ˆÓ Ë%‰„tË.‚¶ Ö=ƒ,\n ÊÍA@!Ë<ƒÁ‚ÄCˉ\n U?…'Õ\n $Ù\n#Ì\nÚ<ƒú‚ýC\"‰‰ƒÜ@A\"¡‰„))%ˆ‰‚Í.‚¶ Ú=…¶\n ÊÍA@!Ë<ƒN‚QCˉ\n U?…´Õ\n $Ù\n#Ì\nÚ<ƒ…‚ˆC\"‰‰ƒ¥Ü@A\"¡‰„”))%ˆ‰‚Z.,‡" [highlight match start end 2 override 3 error "No match %d in highlight %S" text-property-not-all face nil put-text-property eval t keep object value prop text-property-any next next-single-property-change prepend prev val get-text-property append list delq] 11 (#$ . 18285)]) (put (quote font-lock-apply-highlight) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@117 Fontify according to KEYWORDS until LIMIT. KEYWORDS should be of the form MATCH-ANCHORED, see `font-lock-keywords'. (defalias 'font-lock-fontify-anchored-keywords #[(keywords limit) "@Á›ÂŠÂˆ`^)ÇA@!ˆÈ  ÊŽ ;ƒ.Ë Ì#‚2 !ƒ;\f‰ƒ @‰ @‰”•Ñ 8„hÁ 8†1ÓÔ #‚1„ˆÕÖÂ$†1×ÖÇ A@!$‚1Ì=ƒŸ×ÖÇ A@!$‚1Ø=ƒÖÇ A@!ÂÜÂ%‰…ûÞ$×%ˆÜÂ%‰„ÐÂ.‚1ß=ƒšÖÇ A@!Â<ƒ(‚+C‰ !U?…•Þ$â# ×ã! <ƒg ‚j C\"‰$‰$ƒ…$å$@$A\"¡‰$„t)$)%ˆ‰‚5.‚1ã=…1ÖÇ A@!Â<ƒÂ‚ÅC‰ !U?…/Þ$â# ×ã <ƒÿ ‚ C!\"‰$‰$ƒ$å$@$A\"¡‰$„)$)%ˆ‰‚Ï.,ˆ) A‰‚8*ÇÑ8!+‡" [keywords 3 nil highlights lowdarks matcher limit eval match-data match-data ((store-match-data match-data)) re-search-forward t highlight match start end 2 override error "No match %d in highlight %S" text-property-not-all face put-text-property keep object value prop text-property-any next next-single-property-change prepend prev val get-text-property append list delq] 12 (#$ . 19293)]) (put (quote font-lock-fontify-anchored-keywords) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@110 Fontify according to `font-lock-keywords' between START and END. START should be at the beginning of a line. (defalias 'font-lock-fontify-keywords-region #[(start end &optional loudly) " ¢Â=ƒ\f ‚à AÄ ÅƉ‰ \n \f \f…݃<ÏÐ Ñ\nT‰\nÒ\"#ˆ\f@‰ @bˆ;ƒYÔÂ#‚^!ƒÓ A‰ƒI@@§ƒo@‰@‰”•Ø8„ Ú8†iÛÜ#‚i„ÀÝÞÆ$†ißÞàA@!$‚iÂ=ƒ×ßÞàA@!$‚iá=ƒ8ÞàA@!Æ\"#$å$Æ\"%Æ&‰…3ç$\"$&ß&$#\"%ˆå&$Æ\"%‰„Æ.‚iè=ƒÒÞàA@!Æ\"#$#<ƒ`#‚c#CƉ)&*U?…Íç$\"$&ë$\"#)ß&$ì*)<ƒŸ)‚¢)C\"‰-‰-ƒ½-î-@-A\"¡‰-„¬)-)\"%ˆ&‰‚m.‚iì=…iÞàA@!Æ\"#$#<ƒú#‚ý#CƉ)&*U?…gç$\"$&ë$\"#)ß&$ì)<ƒ7)‚:)C*\"‰-‰-ƒW-î-@-A\"¡‰-„F)-)\"%ˆ&‰‚.,ˆ)‚Ê@/‰\f@Ú\f›Æ0ŠÆˆ/`^/)à\fA@!ˆñ 2óŽ;ƒ­Ô/Â#‚²/!ƒÀ0‰ƒ@‰@‰”•Ø8„ëÚ8†´ÛÜ#‚´„ ÝÞÆ$†´ßÞàA@!$‚´Â=ƒ\"ßÞàA@!$‚´á=ƒƒÞàA@!Æ\"#$å$Æ\"%Æ&‰…~ç$\"$&ß&$#\"%ˆå&$Æ\"%‰„SÆ.‚´è=ƒÞàA@!Æ\"#$#<ƒ«#‚®#CƉ)&*U?…ç$\"$&ë$\"#)ß&$ì*)<ƒê)‚í)C\"‰-‰-ƒ-î-@-A\"¡‰-„÷)-)\"%ˆ&‰‚¸.‚´ì=…´ÞàA@!Æ\"#$#<ƒE#‚H#CƉ)&*U?…²ç$\"$&ë$\"#)ß&$ì)<ƒ‚)‚…)C*\"‰-‰-ƒ¢-î-@-A\"¡‰-„‘)-)\"%ˆ&‰‚R.,ˆ)A‰‚º*àØ\f8!+ˆ*A‰‚g\fA‰\f„(Æ.‡" [font-lock-keywords-case-fold-search font-lock-keywords t font-lock-compile-keywords buffer-name 0 nil highlights matcher keyword count bufname keywords case-fold-search loudly message "Fontifying %s... (regexps..%s)" make-string 46 start re-search-forward end highlight match 2 override 3 error "No match %d in highlight %S" text-property-not-all face put-text-property eval keep object value prop text-property-any next next-single-property-change prepend prev val get-text-property append list delq limit lowdarks match-data match-data ((store-match-data match-data))] 13 (#$ . 20569)]) (defalias 'font-lock-thing-lock-cleanup #[nil "ÀÁ!ƒ ƒÁÂ!‡ÀÃ!… …ÃÂ!‡" [boundp fast-lock-mode -1 lazy-lock-mode] 2]) (defalias 'font-lock-after-fontify-buffer #[nil "ÀÁ!ƒ ƒ  ‡ÀÃ!… …Ä ‡" [boundp fast-lock-mode fast-lock-after-fontify-buffer lazy-lock-mode lazy-lock-after-fontify-buffer] 2]) (defalias 'font-lock-revert-setup #[nil "À‰‡" [nil font-lock-fontified] 2]) (defalias (quote font-lock-revert-cleanup) (quote turn-on-font-lock)) (defalias 'font-lock-compile-keywords #[(&optional keywords) "† ‰¢Â=ƒ‚ÂÃÄ\"B‰)‡" [keywords font-lock-keywords t mapcar #[(item) "<„ ÁD‡A§ƒ@AÂDD‡A9ƒ%@ÃADD‡A@<„2@AD‡‡" [item (0 font-lock-keyword-face) font-lock-keyword-face 0] 3]] 5]) (defalias 'font-lock-choose-keywords #[(keywords level) ":„ ‚ ž†ÂžA 9ƒ ‚>§ƒ/ 8†>Ä !@‚>Â=ƒ<Ä !@‚> @)‡" [level major-mode t keywords reverse] 2]) #@330 Set fontification defaults appropriately for this mode. Sets `font-lock-keywords', `font-lock-keywords-only', `font-lock-syntax-table', `font-lock-beginning-of-syntax-function' and `font-lock-keywords-case-fold-search' using `font-lock-defaults' (or, if nil, using `font-lock-defaults-alist') and `font-lock-maximum-decoration'. (defalias 'font-lock-set-defaults #[nil "À ˆ †€\n† \fžAÆ @\"É!ƒ% ‚)Ê! A@ƒ6ËÌ!ÍLˆÎ 8ƒBËÏ!ÍLˆÐ 8ƒrÐ 8ËÒ!ÓÔ !LˆƒqÕ@@@A#ˆA‰„[)Ö 8…Ë×!Ö 8L*‡" [font-lock-make-faces font-lock-keywords font-lock-defaults major-mode font-lock-defaults-alist defaults font-lock-choose-keywords font-lock-maximum-decoration keywords fboundp eval make-local-variable font-lock-keywords-only t 2 font-lock-keywords-case-fold-search 3 slist font-lock-syntax-table copy-syntax-table syntax-table modify-syntax-entry 4 font-lock-beginning-of-syntax-function] 5 (#$ . 23529)]) #@344 A symbol indicating the display Emacs is running under. The symbol should be one of `color', `grayscale' or `mono'. If Emacs guesses this display attribute wrongly, either set this variable in your `~/.emacs' or set the resource `Emacs.displayType' in your `~/.Xdefaults'. See also `font-lock-background-mode' and `font-lock-face-attributes'. (defvar font-lock-display-type nil (#$ . 24447)) #@326 A symbol indicating the Emacs background brightness. The symbol should be one of `light' or `dark'. If Emacs guesses this frame attribute wrongly, either set this variable in your `~/.emacs' or set the resource `Emacs.backgroundMode' in your `~/.Xdefaults'. See also `font-lock-display-type' and `font-lock-face-attributes'. (defvar font-lock-background-mode nil (#$ . 24846)) #@1229 A list of default attributes to use for face attributes. Each element of the list should be of the form (FACE FOREGROUND BACKGROUND BOLD-P ITALIC-P UNDERLINE-P) where FACE should be one of the face symbols `font-lock-comment-face', `font-lock-string-face', `font-lock-keyword-face', `font-lock-type-face', `font-lock-function-name-face', `font-lock-variable-name-face', and `font-lock-reference-face'. A form for each of these face symbols should be provided in the list, but other face symbols and attributes may be given and used in highlighting. See `font-lock-keywords'. Subsequent element items should be the attributes for the corresponding Font Lock mode faces. Attributes FOREGROUND and BACKGROUND should be strings (default if nil), while BOLD-P, ITALIC-P, and UNDERLINE-P should specify the corresponding face attributes (yes if non-nil). Emacs uses default attributes based on display type and background brightness. See variables `font-lock-display-type' and `font-lock-background-mode'. Resources can be used to over-ride these face attributes. For example, the resource `Emacs.font-lock-comment-face.attributeUnderline' can be used to specify the UNDERLINE-P attribute for face `font-lock-comment-face'. (defvar font-lock-face-attributes nil (#$ . 25231)) #@206 Make faces from `font-lock-face-attributes'. A default list is used if this is nil. If optional OVERRIDE is non-nil, faces that already exist are reset. See `font-lock-make-face' and `list-faces-display'. (defalias 'font-lock-make-faces #[(&optional override) "„)ÁÂÃ\"‰ƒÅ\f—!‚'Æ ƒÇ‚'È ƒ&É‚'Ê) „|ÁÌÍ\"Î ‰ƒDÅ—!‚yÒ=ƒ^ÓÔÕžA\"ƒZÖ‚yׂyØÙÚÕžA!\"ØÙÚÛ!\"Ü¥WƒxׂyÖ* „6 Ö=ß>ƒ¨àáâãÕÎ žAäÎ žAå扯çè鯂3ê>ƒ)ë惹삺íå‰æ¯îæƒÊï‚Ëðæåæ¯ñæƒÛò‚Üíå扯ãÕÎ žAäÎ žAå扯óæƒüò‚ýíå‰æ¯ôæƒ ì‚íåæå¯õæƒð‚ïåæ寯‚3ƒ2ö‚3÷)øù\"‡" [font-lock-display-type x-get-resource ".displayType" "DisplayType" display-resource intern x-display-color-p color x-display-grayscale-p grayscale mono font-lock-background-mode ".backgroundMode" "BackgroundMode" frame-parameters params bg-resource system-type ms-dos string-match "light" background-color light dark apply + x-color-values "white" 3 font-lock-face-attributes light-bg (mono monochrome) (font-lock-comment-face nil nil t t nil) (font-lock-string-face nil nil nil t nil) (font-lock-keyword-face nil nil t nil nil) font-lock-function-name-face foreground-color t nil (font-lock-variable-name-face nil nil t t nil) (font-lock-type-face nil nil t nil t) (font-lock-reference-face nil nil t nil t) (grayscale greyscale grayshade greyshade) font-lock-comment-face "Gray80" "DimGray" font-lock-string-face "Gray50" "LightGray" font-lock-keyword-face "Gray90" font-lock-variable-name-face font-lock-type-face font-lock-reference-face ((font-lock-comment-face "Firebrick") (font-lock-string-face "RosyBrown") (font-lock-keyword-face "Purple") (font-lock-function-name-face "Blue") (font-lock-variable-name-face "DarkGoldenrod") (font-lock-type-face "DarkOliveGreen") (font-lock-reference-face "CadetBlue")) ((font-lock-comment-face "OrangeRed") (font-lock-string-face "LightSalmon") (font-lock-keyword-face "LightSteelBlue") (font-lock-function-name-face "LightSkyBlue") (font-lock-variable-name-face "LightGoldenrod") (font-lock-type-face "PaleGreen") (font-lock-reference-face "Aquamarine")) mapcar #[(face-attributes) "@\nƒ Ã!‚-Ä !ƒÅ J!ƒÆ‚-Å !ƒ* ‰L‚-Ã!)‡" [face-attributes face override font-lock-make-face boundp facep nil] 2]] 13 (#$ . 26518)]) #@243 Make a face from FACE-ATTRIBUTES. FACE-ATTRIBUTES should be like an element `font-lock-face-attributes', so that the face name is the first item in the list. A variable with the same name as the face is also set; its value is the face name. (defalias 'font-lock-make-face #[(face-attributes) "@ !ÄÆÈ !ˆÉÊ \"ˆ Ë\"„!ÌÍΈ Ï\"„-ÌÐш Ò\"ƒE Ò\"ƒQÓ ÌÔ#ˆ‚QÕ8ƒQÓ ÌÔ#ˆ Ö\"ƒi Ö\"ƒu× ÌÔ#ˆ‚uØ8ƒu× ÌÔ#ˆ Ù\"„ƒÚ Û8\"ˆ ‰L,‡" [face-attributes face symbol-name face-name #[(face-name resource) "À  QÄ P\"‡" [x-get-resource face-name ".attribute" resource "Face.Attribute"] 4] set-p #[(face-name resource) " \n\"‰… —Ä)‡" [set-p face-name resource set ("on" "true")] 4] on-p make-face add-to-list facemenu-unlisted-faces "Foreground" nil (byte-code "À \nA@\"‡" [set-face-foreground face face-attributes] 3) ((error)) "Background" (byte-code "À  8\"‡" [set-face-background face 2 face-attributes] 4) ((error)) "Bold" make-face-bold t 3 "Italic" make-face-italic 4 "Underline" set-face-underline-p 5] 4 (#$ . 28782)]) #@40 Subdued level highlighting Lisp modes. (defconst lisp-font-lock-keywords-1 (byte-code "ÀÁÂÃÄÅÆ°ÇÈEC‡" ["^(\\(def\\(" "\\(const\\(\\|ant\\)\\|ine-key\\(\\|-after\\)\\|var\\)\\|" "\\(class\\|struct\\|type\\)\\|" "\\([^ \n()]+\\)" "\\)\\)\\>" "[ '(]*" "\\([^ \n)]+\\)?" (1 font-lock-keyword-face) (8 (cond ((match-beginning 3) font-lock-variable-name-face) ((match-beginning 6) font-lock-type-face) (t font-lock-function-name-face)) nil t)] 7) (#$ . 29823)) #@42 Gaudy level highlighting for Lisp modes. (defconst lisp-font-lock-keywords-2 (byte-code "À ÂÃÄÅÆÇÈÉ°ÊBËÌÍί\"‡" [append lisp-font-lock-keywords-1 "(\\(" "\\(c\\(atch\\|ond\\(\\|ition-case\\)\\)\\|do\\|" "eval-\\(a\\(fter-load\\|nd-compile\\)\\|when-compile\\)\\|flet\\|" "if\\|l\\(abels\\|et\\*?\\)\\|prog[nv12*]?\\|return\\(\\|-from\\)\\|" "save-\\(excursion\\|match-data\\|restriction\\|selected-window\\|" "window-excursion\\)\\|t\\(hrow\\|rack-mouse\\)\\|" "un\\(less\\|wind-protect\\)\\|wh\\(en\\|ile\\)\\)" "\\)\\>" 1 ("\\\\\\\\\\[\\(\\sw+\\)]" 1 font-lock-reference-face prepend) ("`\\(\\sw\\sw+\\)'" 1 font-lock-reference-face prepend) ("\\<:\\sw+\\>" 0 font-lock-reference-face prepend) ("\\<\\&\\(optional\\|rest\\|whole\\)\\>" . font-lock-type-face)] 10) (#$ . 30288)) #@49 Default expressions to highlight in Lisp modes. (defvar lisp-font-lock-keywords lisp-font-lock-keywords-1 (#$ . 31076)) #@51 Default expressions to highlight in Scheme modes. (defvar scheme-font-lock-keywords (quote (("(\\(define\\(\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)\\|\\(-syntax\\)\\|\\(-class\\)\\)\\)\\>[ ]*(?\\(\\sw+\\)?" (1 font-lock-keyword-face) (8 (cond ((match-beginning 3) font-lock-function-name-face) ((match-beginning 6) font-lock-variable-name-face) (t font-lock-type-face)) nil t)) ("(\\(and\\|begin\\|c\\(a\\(ll\\(-with-\\(current-continuation\\|input-file\\|output-file\\)\\|/cc\\)\\|se\\)\\|ond\\)\\|d\\(elay\\|o\\)\\|else\\|for-each\\|if\\|l\\(ambda\\|et\\(-syntax\\|\\*?\\|rec\\(\\|-syntax\\)\\)\\)\\|map\\|or\\|syntax\\(\\|-rules\\)\\)\\>" . 1) ("\\<<\\sw+>\\>" . font-lock-type-face) ("\\<:\\sw+\\>" . font-lock-reference-face))) (#$ . 31202)) #@41 Subdued level highlighting for C modes. (defconst c-font-lock-keywords-1 nil (#$ . 31967)) #@40 Medium level highlighting for C modes. (defconst c-font-lock-keywords-2 nil (#$ . 32064)) #@39 Gaudy level highlighting for C modes. (defconst c-font-lock-keywords-3 nil (#$ . 32160)) #@43 Subdued level highlighting for C++ modes. (defconst c++-font-lock-keywords-1 nil (#$ . 32255)) #@42 Medium level highlighting for C++ modes. (defconst c++-font-lock-keywords-2 nil (#$ . 32356)) #@41 Gaudy level highlighting for C++ modes. (defconst c++-font-lock-keywords-3 nil (#$ . 32456)) (defalias 'font-lock-match-c++-style-declaration-item-and-skip-to-next #[(limit) "ÀÁ!… ÄŽÅÆÇ*‡" [looking-at "[ *&]*\\(\\sw+\\)\\(::\\(\\sw+\\)\\)?[ ]*\\((\\)?" match-data match-data ((store-match-data match-data)) nil (byte-code "Œe}ˆÁ•bˆÂÃ!„Ä`Á\"†dbˆ‚ Å•b)‡" [limit 1 looking-at "[ ]*\\([,;]\\|$\\)" scan-sexps 0] 3) ((error t))] 3]) (byte-code "ÀÁÂÃÄRÅÆÇÈRÉÊËÌÍΰÓ°ÔÕEÖ×ØÙ¯ÛÜÝQÞBÜÝQßBàáF\"\"Û\"ÜÝãRäDåæE\"'ÛAèC\")Û)ÜÝQÞBêëìÜÝQßB¯\"-Û-ÜÝãRîDïðE\"1,Ô‡" ["break\\|continue\\|do\\|else\\|for\\|if\\|return\\|switch\\|while" "auto\\|c\\(har\\|onst\\)\\|double\\|e\\(num\\|xtern\\)\\|" "float\\|int\\|long\\|register\\|" "s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|typedef\\|" "un\\(ion\\|signed\\)\\|vo\\(id\\|latile\\)" "asm\\|break\\|c\\(atch\\|ontinue\\)\\|d\\(elete\\|o\\)\\|" "else\\|for\\|if\\|new\\|" "p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|return\\|" "s\\(izeof\\|witch\\)\\|t\\(h\\(is\\|row\\)\\|ry\\)\\|while" "auto\\|bool\\|c\\(har\\|lass\\|o\\(mplex\\|nst\\)\\)\\|" "double\\|e\\(num\\|xtern\\)\\|f\\(loat\\|riend\\)\\|" "in\\(line\\|t\\)\\|long\\|register\\|" "s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|" "t\\(emplate\\|ypedef\\)\\|un\\(ion\\|signed\\)\\|" "v\\(irtual\\|o\\(id\\|latile\\)\\)" c++-type-types c++-keywords c-type-types c-keywords "^\\(\\sw+\\)[ ]*(" 1 font-lock-function-name-face ("^#[ ]*include[ ]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) ("^#[ ]*define[ ]+\\(\\(\\sw+\\)(\\)" 2 font-lock-function-name-face) ("^#[ ]*if\\>" ("\\<\\(defined\\)\\>[ ]*(?\\(\\sw+\\)?" nil nil (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t))) ("^\\(#[ ]*[a-z]+\\)\\>[ ]*\\(\\sw+\\)?" (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t)) c-font-lock-keywords-1 append "\\<\\(" "\\)\\>" font-lock-type-face font-lock-keyword-face ("\\<\\(case\\|goto\\)\\>[ ]*\\([^ \n:;]+\\)?" (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) ("^[ ]*\\(\\sw+\\)[ ]*:" 1 font-lock-reference-face) c-font-lock-keywords-2 "\\([ *&]+\\sw+\\>\\)*" (font-lock-match-c++-style-declaration-item-and-skip-to-next (goto-char (or (match-beginning 8) (match-end 1))) (goto-char (match-end 1)) (1 (if (match-beginning 4) font-lock-function-name-face font-lock-variable-name-face))) ("\\(}\\)[ *]*\\sw" (font-lock-match-c++-style-declaration-item-and-skip-to-next (goto-char (match-end 1)) nil (1 (if (match-beginning 4) font-lock-function-name-face font-lock-variable-name-face)))) ("^\\(\\sw+\\)\\>\\([ *]+\\sw+\\>\\)*" (1 font-lock-type-face) (font-lock-match-c++-style-declaration-item-and-skip-to-next (goto-char (or (match-beginning 2) (match-end 1))) nil (1 (if (match-beginning 4) font-lock-function-name-face font-lock-variable-name-face)))) c-font-lock-keywords-3 ("^\\(\\sw+\\)\\(::\\(\\sw+\\)\\)?[ ]*(" (1 (if (match-beginning 2) font-lock-type-face font-lock-function-name-face)) (3 (if (match-beginning 2) font-lock-function-name-face) nil t)) c++-font-lock-keywords-1 ("\\<\\(operator\\)\\>[ ]*\\([][)(>[ ]*\\([^ \n:;]+\\)?" (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) ("^[ ]*\\(\\sw+\\)[ ]*:[^:]" 1 font-lock-reference-face) c++-font-lock-keywords-2 (font-lock-match-c++-style-declaration-item-and-skip-to-next (goto-char (or (match-beginning 13) (match-end 1))) (goto-char (match-end 1)) (1 (cond ((match-beginning 2) font-lock-type-face) ((match-beginning 4) font-lock-function-name-face) (t font-lock-variable-name-face))) (3 (if (match-beginning 4) font-lock-function-name-face font-lock-variable-name-face) nil t)) ("\\(}\\)[ *]*\\sw" (font-lock-match-c++-style-declaration-item-and-skip-to-next (goto-char (match-end 1)) nil (1 (if (match-beginning 4) font-lock-function-name-face font-lock-variable-name-face)))) ("^\\(\\sw+\\)\\>\\([ *]+\\sw+\\>\\)*" (1 font-lock-type-face) (font-lock-match-c++-style-declaration-item-and-skip-to-next (goto-char (or (match-beginning 2) (match-end 1))) nil (1 (cond ((match-beginning 2) font-lock-type-face) ((match-beginning 4) font-lock-function-name-face) (t font-lock-variable-name-face))) (3 (if (match-beginning 4) font-lock-function-name-face font-lock-variable-name-face) nil t))) c++-font-lock-keywords-3] 9) #@45 Default expressions to highlight in C mode. (defvar c-font-lock-keywords c-font-lock-keywords-1 (#$ . 36873)) #@47 Default expressions to highlight in C++ mode. (defvar c++-font-lock-keywords c++-font-lock-keywords-1 (#$ . 36989)) #@48 Default expressions to highlight in TeX modes. (defvar tex-font-lock-keywords (quote (("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}" 2 font-lock-function-name-face) ("\\\\\\(cite\\|label\\|pageref\\|ref\\){\\([^} \n]+\\)}" 2 font-lock-reference-face) ("^[ ]*\\\\def\\\\\\(\\(\\w\\|@\\)+\\)" 1 font-lock-function-name-face) "\\\\\\([a-zA-Z@]+\\|.\\)" ("\\\\emph{\\([^}]+\\)}" 1 (quote italic) keep) ("\\\\text\\(\\(bf\\)\\|it\\|sl\\){\\([^}]+\\)}" 3 (if (match-beginning 2) (quote bold) (quote italic)) keep) ("\\\\\\(\\(bf\\)\\|em\\|it\\|sl\\)\\>\\(\\([^}&\\]\\|\\\\[^\\]\\)+\\)" 3 (if (match-beginning 2) (quote bold) (quote italic)) keep))) (#$ . 37111)) (byte-code "À ž„\n BÃÄ!‡" [font-lock-mode minor-mode-alist (font-lock-mode " Font") provide font-lock] 2) emacs-19.30/lisp/format.elc100666 75424 12 45272 6054400114 14142 0ustar kwzhstaff;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Nov 21 11:37:15 1995 ;;; from file /home/fsf/rms/e19/lisp/format.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`format.el' was compiled for Emacs 19.29 or later")) (put (quote buffer-file-format) (quote permanent-local) t) #@1255 List of information about understood file formats. Elements are of the form (NAME DOC-STR REGEXP FROM-FN TO-FN MODIFY MODE-FN). NAME is a symbol, which is stored in `buffer-file-format'. DOC-STR should be a single line providing more information about the format. It is currently unused, but in the future will be shown to the user if they ask for more information. REGEXP is a regular expression to match against the beginning of the file; it should match only files in that format. FROM-FN is called to decode files in that format; it gets two args, BEGIN and END, and can make any modifications it likes, returning the new end. It must make sure that the beginning of the file no longer matches REGEXP, or else it will get called again. TO-FN is called to encode a region into that format; it is also passed BEGIN and END, and either returns a list of annotations like `write-region-annotate-functions', or modifies the region and returns the new end. MODIFY, if non-nil, means the TO-FN modifies the region. If nil, TO-FN may not make any changes and should return a list of annotations. MODE-FN, if specified, is called when visiting a file with that format. (defconst format-alist (quote ((text/enriched "Extended MIME text/enriched format." "Content-[Tt]ype:[ ]*text/enriched" enriched-decode enriched-encode t enriched-mode) (plain "Standard ASCII format, no text properties." nil nil nil nil nil))) (#$ . 531)) #@458 Returns annotations for writing region as FORMAT. FORMAT is a symbol naming one of the formats defined in `format-alist', it must be a single symbol, not a list like `buffer-file-format'. This function works like a function on `write-region-annotate-functions': it either returns a list of annotations, or returns with a different buffer current, which contains the modified text to write. For most purposes, consider using `format-encode-region' instead. (defalias 'format-annotate-function #[(format from to) " žÃ\n8Å\n8\f…?ƒ9ÇÈ! Ê  \f#ˆ qˆÍ \"ˆ\fed\"ˆ)Ï‚?\f \f\"+‡" [format format-alist info 4 to-fn 5 modify get-buffer-create " *Format Temp*" copy-buf copy-to-buffer from to format-insert-annotations write-region-annotations-so-far nil] 4 (#$ . 2049)]) #@705 Decode text from any known FORMAT. FORMAT is a symbol appearing in `format-alist' or a list of such symbols, or nil, in which case this function tries to guess the format of the data by matching against the regular expressions in `format-alist'. After a match is found and the region decoded, the alist is searched again from the beginning for another match. Second arg LENGTH is the number of characters following point to operate on. If optional third arg VISIT-FLAG is true, set `buffer-file-format' to the list of formats used, and call any mode functions defined for those formats. Returns the new length of the decoded region. For most purposes, consider using `format-decode-region' instead. (defalias 'format-decode #[(format length &optional visit-flag) "À `` \\ „yƒu@É8\n` \nƒlÌ\n!ƒlÍ• \\Wƒl@ BÎ8ƒNÎ8 \n\"ƒaÐ8ƒaÐ8Ñ!ˆ bˆ‚qA+‚)‚Ê <„ C Ò‰ƒÉ@ž‰„žÔÕ@\"ˆÎ8ƒ­Î8 \n\"ƒÀÐ8ƒÀÐ8Ñ!ˆA‰„‹*ƒÒ ×\f!ˆ\n Z+‡" [buffer-modified-p length end begin mod format format-alist try f 2 regexp p looking-at 0 3 visit-flag 6 1 nil do error "Unknown format" buffer-file-format set-buffer-modified-p] 5 (#$ . 2835)]) #@204 Translate the buffer from some FORMAT. If the format is not specified, this function attempts to guess. `buffer-file-format' is set to the format used, and any mode-functions for the format are called. (defalias 'format-decode-buffer #[(&optional format) "ŠebˆÀ  Ã#)‡" [format-decode format buffer-size t] 4 (#$ . 4039) (list (format-read "Translate buffer from format (default: guess): "))]) #@181 Decode the region from some format. Arg FORMAT is optional; if omitted the format will be determined by looking for identifying regular expressions at the beginning of the region. (defalias 'format-decode-region #[(from to &optional format) "ŠbˆÁ\n ZÄ#)‡" [from format-decode format to nil] 4 (#$ . 4441) (list (region-beginning) (region-end) (format-read "Translate region from format (default: guess): "))]) #@172 Translate the buffer into FORMAT. FORMAT defaults to `buffer-file-format'. It is a symbol naming one of the formats defined in `format-alist', or a list of such symbols. (defalias 'format-encode-buffer #[(&optional format) "Àed #‡" [format-encode-region format] 4 (#$ . 4860) (list (format-read (format "Translate buffer to format (default %s): " buffer-file-format)))]) #@176 Translate the region into some FORMAT. FORMAT defaults to `buffer-file-format', it is a symbol naming one of the formats defined in `format-alist', or a list of such symbols. (defalias 'format-encode-region #[(beg end &optional format) "„ 9ƒCŠ\nbˆpà …T@ žÇ8É8\nË\fƒM\nƒD \n\"‚MÎ \n\"!ˆA,‚+‡" [format buffer-file-format end point-marker cur-buf format-alist info 4 to-fn 5 modify nil result beg format-insert-annotations] 4 (#$ . 5239) (list (region-beginning) (region-end) (format-read (format "Translate region to format (default %s): " buffer-file-format)))]) #@276 Write current buffer into a FILE using some FORMAT. Makes buffer visit that file and sets the format as the default for future saves. If the buffer is already visiting a file, you can specify a directory name as FILE, to write a file of the same old name in that directory. (defalias 'format-write-file #[(filename format) " !‡" [format buffer-file-format write-file filename] 2 (#$ . 5849) (let* ((file (if buffer-file-name (read-file-name "Write file: " nil nil nil nil) (read-file-name "Write file: " (cdr (assq (quote default-directory) (buffer-local-variables))) nil nil (buffer-name)))) (fmt (format-read (format "Write file `%s' in format: " (file-name-nondirectory file))))) (list file fmt))]) #@101 Find the file FILE using data format FORMAT. If FORMAT is nil then do not do any format conversion. (defalias 'format-find-file #[(filename format) "À !ˆ)\f…Å\f!‡" [nil format-alist find-file filename format format-decode-buffer] 2 (#$ . 6562) (let* ((file (read-file-name "Find file: ")) (fmt (format-read (format "Read file `%s' in format: " (file-name-nondirectory file))))) (list file fmt))]) #@304 Insert the contents of file FILE using data format FORMAT. If FORMAT is nil then do not do any format conversion. The optional third and fourth arguments BEG and END specify the part of the file to read. The return value is like the value of `insert-file-contents': a list (ABSOLUTE-FILE-NAME . SIZE). (defalias 'format-insert-file #[(filename format &optional beg end) "À‰ÀÄ À$‰A@)ƒ$É \"\n@ B\n*‡" [nil size value format-alist insert-file-contents filename beg end format format-decode] 6 (#$ . 6970) (let* ((file (read-file-name "Find file: ")) (fmt (format-read (format "Read file `%s' in format: " (file-name-nondirectory file))))) (list file fmt))]) #@180 Read and return the name of a format. Return value is a list, like `buffer-file-format'; it may be nil. Formats are defined in `format-alist'. Optional arg is the PROMPT to use. (defalias 'format-read #[(&optional prompt) "ÀÁ\n\"Ä † Æ ÇÈ$‰ Êš?…Ë !C*‡" [mapcar #[(x) "À @!C‡" [symbol-name x] 2] format-alist table completing-read prompt "Format: " nil t ans "" intern] 6 (#$ . 7649)]) #@402 Do multiple replacements on the buffer. ALIST is a list of (from . to) pairs, which should be proper arguments to `search-forward' and `replace-match' respectively. Optional 2nd arg REVERSE, if non-nil, means the pairs are (to . from), so that you can use the same list in both directions if it contains only literal strings. Optional args BEGIN and END specify a region of the buffer to operate on. (defalias 'format-replace-strings #[(alist &optional reverse beg end) "ŠŒ„e ƒe }ˆ\n…a ƒ\n@A‚!\n@@ ƒ+\nA@‚.\n@AbˆÆ ÇÈ#ƒZÉ”bˆ\fcˆÊ`\fGZ`Ë`!#ˆ``É•É”Z\\|ˆ‚3\nA*‚*‡" [beg end alist reverse to from search-forward nil t 0 set-text-properties text-properties-at] 5 (#$ . 8047)]) #@217 Remove the given CONS from LIST by side effect, and return the new LIST. Since CONS could be the first element of LIST, write `(setq foo (format-delq-cons element foo))' to be sure of changing the value of `foo'. (defalias 'format-delq-cons #[(cons list) " =ƒ A‡ ‰A=„!\n„ÃÄ!ˆ\nA‰‚\f\nA¡ˆ )‡" [cons list p error "format-delq-cons: not an element."] 3 (#$ . 8746)]) #@82 Delete common elements of lists A and B, return as pair. Compares using `equal'. (defalias 'format-make-relatively-unique #[(a b) "À !À !\n ƒ. @\f A‰ƒ'È \n\"È\f\"*‚\n\n\f+B‡" [copy-sequence a acopy b bcopy tail next dup format-delq-cons] 4 (#$ . 9130)]) #@208 Given two lists that have a common tail, return it. Compares with `equal', and returns the part of A that is equal to the equivalent part of B. If even the last items of the two are not equal, returns nil. (defalias 'format-common-tail #[(a b) "G G‰\nVƒ \nZ›‚\n Z ›* š„+A A‚‡" [a b lb la] 3 (#$ . 9409)]) #@159 Arrange ITEMS to following partial ORDER. Elements of ITEMS equal to elements of ORDER will be rearranged to follow the ORDER. Unmatched items will go last. (defalias 'format-reorder #[(items order) "ƒ\"@ ‰ƒ\n@ÃÄ\n \"A\"B‚ à A\")‡ ‡" [order items item format-reorder format-delq-cons] 6 (#$ . 9740)]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put face format-list-valued t unknown] 4) #@2527 Translate annotations in the region into text properties. This sets text properties between FROM to TO as directed by the TRANSLATIONS and NEXT-FN arguments. NEXT-FN is a function that searches forward from point for an annotation. It should return a list of 4 elements: (BEGIN END NAME POSITIVE). BEGIN and END are buffer positions bounding the annotation, NAME is the name searched for in TRANSLATIONS, and POSITIVE should be non-nil if this annotation marks the beginning of a region with some property, or nil if it ends the region. NEXT-FN should return nil if there are no annotations after point. The basic format of the TRANSLATIONS argument is described in the documentation for the `format-annotate-region' function. There are some additional things to keep in mind for decoding, though: When an annotation is found, the TRANSLATIONS list is searched for a text-property name and value that corresponds to that annotation. If the text-property has several annotations associated with it, it will be used only if the other annotations are also in effect at that point. The first match found whose annotations are all present is used. The text property thus determined is set to the value over the region between the opening and closing annotations. However, if the text-property name has a non-nil `format-list-valued' property, then the value will be consed onto the surrounding value of the property, rather than replacing that value. There are some special symbols that can be used in the "property" slot of the TRANSLATIONS list: PARAMETER and FUNCTION (spelled in uppercase). Annotations listed under the pseudo-property PARAMETER are considered to be arguments of the immediately surrounding annotation; the text between the opening and closing parameter annotations is deleted from the buffer but saved as a string. The surrounding annotation should be listed under the pseudo-property FUNCTION. Instead of inserting a text-property for this annotation, the function listed in the VALUE slot is called to make whatever changes are appropriate. The function's first two arguments are the START and END locations, and the rest of the arguments are any PARAMETERs found in that region. Any annotations that are found by NEXT-FN but not defined by TRANSLATIONS are saved as values of the `unknown' text-property (which is list-valued). The TRANSLATIONS list should usually contain an entry of the form (unknown (nil format-annotate-value)) to write these unknown annotations back into the file. (defalias 'format-deannotate-region #[(from to translations next-fn) "ŠŒe}ˆ bˆÂ‰‰‰‰ ‰ƒX@A@ Ê8 Ì8 Â\f |ˆ ƒM \fDB‚TÏ \"„_ÐÑ \"ˆ‚T„T@‰@A@AA šƒŽÙ‚’ÐÚ!ˆƒ6@@@Aƒ,@@@Aƒ\"Âßà\"„\"ÂÂÙAá=ƒøƒðâ@\f{C\"AB\f|ˆ‚\"ã=ƒä\f$‰%ƒ% B)‚\"\fF B*A‰„¨*A‰„—„OA\fæF B B.‚_-‚ ƒ½ @‰'@'A@Ê'8Ì'8(é (§ƒŽ(ê \"†Šë\\‚³ìNƒ±ê \"-(-<ƒ©-‚¬-C)B‚³($ˆ- A‰„\\ …ÅÐî \".‡" [to from nil unknown-ans loc todo open-ans next next-fn end 2 name 3 positive found assoc message "Extra closing annotation (%s) in file" top top-name start params translations aalist matched t "Improper nesting in file." alist prop ans value mapcar #[(r) "À \n\"‡" [assoc r open-ans] 3] PARAMETER append FUNCTION apply rtn unknown item val put-text-property get-text-property 0 format-list-valued prev "Unknown annotations: %s"] 9 (#$ . 10129)]) #@397 Apply list of annotations to buffer as `write-region' would. Inserts each element of the given LIST of buffer annotations at its appropriate place. Use second arg OFFSET if the annotations' locations are not relative to the beginning of the buffer: annotations will be inserted at their location-OFFSET+1 (ie, the offset is treated as the character number of the first character in the buffer). (defalias 'format-insert-annotations #[(list &optional offset) "„ Á‚\fS !‰…(\f@@Zbˆ\f@Acˆ\fA‰„Å)‡" [offset 0 reverse list l nil] 3 (#$ . 13657)]) #@239 Return OLD and NEW as a (close . open) annotation pair. Useful as a default function for TRANSLATIONS alist when the value of the text property is the name of the annotation that you want to use, as it is for the `unknown' text property. (defalias 'format-annotate-value #[(old new) "…C …\f CB‡" [old new] 2 (#$ . 14219)]) #@1733 Generate annotations for text properties in the region. Searches for changes between FROM and TO, and describes them with a list of annotations as defined by alist TRANSLATIONS and FORMAT-FN. IGNORE lists text properties not to consider; any text properties that are neither ignored nor listed in TRANSLATIONS are warned about. If you actually want to modify the region, give the return value of this function to `format-insert-annotations'. Format of the TRANSLATIONS argument: Each element is a list whose car is a PROPERTY, and the following elements are VALUES of that property followed by the names of zero or more ANNOTATIONS. Whenever the property takes on that value, the annotations (as formatted by FORMAT-FN) are inserted into the file. When the property stops having that value, the matching negated annotation will be inserted (it may actually be closed earlier and reopened, if necessary, to keep proper nesting). If the property's value is a list, then each element of the list is dealt with separately. If a VALUE is numeric, then it is assumed that there is a single annotation and each occurrence of it increments the value of the property by that number. Thus, given the entry (left-margin (4 "indent")), if the left margin changes from 4 to 12, two annotations will be generated. If the VALUE is nil, then instead of annotations, a function should be specified. This function is used as a default: it is called for all transitions not explicitly listed in the table. The function is called with two arguments, the OLD and NEW values of the property. It should return lists of annotations like `format-annotate-location' does. The same structure can be used in reverse for reading files. (defalias 'format-annotate-region #[(from to trans format-fn ignore) "À‰‰‰\nƒÅ\nÀ#‰ƒÍ\nWƒÍ\n„%È\n‰U \n$ Ì ÍH \" ÏH ÑHÓ \"Ó \" ƒ¥@ „lÔÕ@\"ˆ‚œ@ @š„ @B\n @À\"B\fB A‚l A\n@À\"B\fBA‰„ZƒÉ@ B\n@Ø\"B\fBA‰„®-‚ ƒä @À\"B\fB A‰„Ñ ƒíÔÙ \"ˆ\fŸ,‡" [nil not-found loc open-ans all-ans next-property-change to from format-annotate-location ignore trans ans format-reorder 0 neg-ans 1 pos-ans 2 ignored append message "Can't close %s: not open." format-fn p t "These text properties could not be saved:\n %s"] 6 (#$ . 14555)]) #@473 Return annotation(s) needed at LOCATION. This includes any properties that change between LOC-1 and LOC. If ALL is true, don't look at previous location, but generate annotations for all non-nil properties. Third argument IGNORE is a list of text-properties not to consider. Return value is a vector of 3 elements: 1. List of names of the annotations to close 2. List of the names of annotations to open. 3. List of properties that were ignored or couldn't be annotated. (defalias 'format-annotate-location #[(loc all ignore trans) "S\n?… à !Ã!ÆÆÆ Æ\nÆ Æ\f\f‰ƒD@ >„:@ B AA‰„) ‰ƒf@ >„\\@ B AA‰„K ƒÈ @\n A \n >„f\n?…ˆ\n\f>A@\n >A@‰š„ÄÐ\n$‰„³\n\fB\f‚Ã@¤ A¤ )*‚fÓ \f#. ‡" [loc prev-loc all text-properties-at before-plist after-plist nil p negatives positives prop props not-found ignore after before format-annotate-single-property-change trans result vector] 6 (#$ . 16909)]) #@272 Return annotations for PROPERTY changing from OLD to NEW. These are searched for in the TRANSLATIONS alist. If NEW does not appear in the list, but there is a default function, then that function is called. Annotations to open and to close are returned as a dotted pair. (defalias 'format-annotate-single-property-change #[(prop old new trans) "À \n\"AÉ…®§ƒ„È‚+§ƒ+„+È:„7:ƒ§<ƒB‚EC<ƒR‚UCÉ\"\nà Ã\fƒÍÎ @Ã#@ \" A‰„jƒÍÎ Ã@#A\f\"\fA‰„†Ï \f\"-‚®Î #*‡" [assoc prop trans nil default prop-alist old new 0 format-common-tail tail close open append format-annotate-atomic-property-change format-make-relatively-unique] 6 (#$ . 17885)]) #@142 Internal function annotate a single property change. PROP-ALIST is the relevant segement of a TRANSLATIONS list. OLD and NEW are the values. (defalias 'format-annotate-atomic-property-change #[(prop-alist old new) "§ƒU §ƒU\n@@ƒ\n@@§„\nA‰‚ \n@\n@@ÅÆ Z!Æ\f!¥!\n@A@ÉVƒJÊË\"B‚SË[\"ÊB,‡…^Ì\n\"A …gÌ \n\"A ‰„t ƒ}Ï \"‚ŽÊ\nž‰…A@ \")*‡" [old new prop-alist entry increment ceiling float n anno 0 nil make-list assoc open close format-make-relatively-unique default] 5 (#$ . 18606)]) emacs-19.30/lisp/forms.elc100666 13437 13 73433 6052715217 13621 0ustar jimbuser;ELC ;;; compiled by jvromans@hill.gnu.ai.mit.edu on Thu Nov 16 15:08:59 1995 ;;; from file /home/gd/gnu/emacs/19.0/lisp/forms.el ;;; emacs version 19.29.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`forms.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [provide forms forms-mode] 2) #@131 The version number of forms-mode (as string). The complete RCS id is: $Id: forms.el,v 2.23 1995/11/16 20:04:57 jvromans Exp $ (defconst forms-version (substring "$Revision: 2.23 $" 11 -2) (#$ . 532)) #@52 Hook functions to be run upon entering Forms mode. (defvar forms-mode-hooks nil (#$ . 742)) #@36 Name of the file holding the data. (defvar forms-file nil (#$ . 840)) #@36 List of formatting specifications. (defvar forms-format-list nil (#$ . 916)) #@30 Number of fields per record. (defvar forms-number-of-fields nil (#$ . 999)) #@62 *If non-nil, warn about records with wrong number of fields. (defvar forms-check-number-of-fields t (#$ . -1081)) #@42 Field separator character (default TAB). (defvar forms-field-sep " " (#$ . 1201)) #@106 Non-nil means: visit the file in view (read-only) mode. (Defaults to the write access on the data file). (defvar forms-read-only nil (#$ . 1290)) #@77 If not nil: use this character to separate multi-line fields (default C-k). (defvar forms-multi-line " " (#$ . 1442)) #@121 *Non-nil means replace scroll-up/down commands in Forms mode. The replacement commands performs forms-next/prev-record. (defvar forms-forms-scroll nil (#$ . -1567)) #@123 *Non-nil means redefine beginning/end-of-buffer in Forms mode. The replacement commands performs forms-first/last-record. (defvar forms-forms-jump nil (#$ . -1739)) #@169 The name of a function that is called after reading the data file. This can be used to change the contents of the file to something more suitable for forms processing. (defvar forms-read-file-filter nil (#$ . 1911)) #@130 The name of a function that is called before writing the data file. This can be used to undo the effects of form-read-file-hook. (defvar forms-write-file-filter nil (#$ . 2134)) #@69 The name of a function that is called when a new record is created. (defvar forms-new-record-filter nil (#$ . 2318)) #@72 The name of a function that is called when a record has been modified. (defvar forms-modified-record-filter nil (#$ . 2441)) #@156 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-fields nil (#$ . 2573)) #@115 *Non-nil means: use emacs-19 text properties. Defaults to t if this emacs is capable of handling text properties. (defvar forms-use-text-properties (fboundp (quote set-text-properties)) (#$ . -2773)) #@75 The face (a symbol) that is used to display read-only text on the screen. (defvar forms-ro-face (quote default) (#$ . 2979)) #@76 The face (a symbol) that is used to display read-write text on the screen. (defvar forms-rw-face (quote region) (#$ . 3110)) #@34 Buffer which holds the file data (defvar forms--file-buffer nil (#$ . 3241)) #@43 Total number of records in the data file. (defvar forms--total-records 0 (#$ . 3324)) #@47 Number of the record currently on the screen. (defvar forms--current-record 0 (#$ . 3416)) #@25 Keymap for form buffer. (defvar forms-mode-map nil (#$ . 3513)) #@38 Keymap for form buffer in view mode. (defvar forms-mode-ro-map nil (#$ . 3583)) #@38 Keymap for form buffer in edit mode. (defvar forms-mode-edit-map nil (#$ . 3669)) #@30 Field markers in the screen. (defvar forms--markers nil (#$ . 3757)) #@62 Dynamic texts (resulting from function calls) on the screen. (defvar forms--dyntexts nil (#$ . 3832)) #@65 List of strings of the current record, as parsed from the file. (defvar forms--the-record-list nil (#$ . 3940)) #@45 Last regexp used by forms-search functions. (defvar forms--search-regexp nil (#$ . 4058)) #@21 Formatting routine. (defvar forms--format nil (#$ . 4154)) #@23 Forms parser routine. (defvar forms--parser nil (#$ . 4219)) #@43 To keep track of forms-mode being set-up. (defvar forms--mode-setup nil (#$ . 4286)) (make-variable-buffer-local (quote forms--mode-setup)) #@58 Array that holds dynamic texts to insert between fields. (defvar forms--dynamic-text nil (#$ . 4432)) #@57 Array with the order in which the fields are displayed. (defvar forms--elements nil (#$ . 4540)) #@54 Face used to represent read-only data on the screen. (defvar forms--ro-face nil (#$ . 4643)) #@55 Face used to represent read-write data on the screen. (defvar forms--rw-face nil (#$ . 4742)) #@751 Major mode to visit files in a field-structured manner using a form. Commands: Equivalent keys in read-only mode: TAB forms-next-field TAB \C-c TAB forms-next-field \C-c < forms-first-record < \C-c > forms-last-record > \C-c ? describe-mode ? \C-c \C-k forms-delete-record \C-c \C-q forms-toggle-read-only q \C-c \C-o forms-insert-record \C-c \C-l forms-jump-record l \C-c \C-n forms-next-record n \C-c \C-p forms-prev-record p \C-c \C-r forms-search-reverse r \C-c \C-s forms-search-forward s \C-c \C-x forms-exit x  (defalias 'forms-mode #[(&optional primary) "„ „; ˆÃÄ!ˆÃÅ!ˆÃÆ!ˆÃÇ!ˆÃÈ!ˆÃÉ!ˆÃÊ!ˆÃË!ˆÃÌ!ˆÃÍ!ˆÃÎ!ˆÃÏ!ˆÃÐ!ˆÑ ÑÑÑÒÓ!ƒYÃÔ!ˆÃÕ!ˆ×=„jØÙÚ ÛQ!ƒpÜ ˆ‚tÝÞ!ˆ\f„~ÝßàP!ˆ;„ŠÝßáP!ˆ ƒ¢ §ƒ™ âV„­ÝßãP!ˆ‚­ƒ­ÝßäP!ˆ„µå ˆ ƒß ;ƒÙ Gæ=ƒÙ ˜ƒßÝßçP!ˆ‚ßÝßèP!ˆÒé!„èÑ\fê ˆÃë!ˆÃì!ˆÃí!ˆÃî!ˆï ˆÃð!ˆñ ˆƒÒ!„ÝßòP!ˆƒ)Ò!„)ÝßóP!ˆÃô!ˆÃõ!ˆöÑ!ˆÑ7ø ˆ×ÒÓ!ƒcÃù!ˆÃú!ˆƒ[9:‚c9:Ãû!ˆÃü!ˆÃý!ˆÃþ!ˆÃÿ!ˆ@„A ˆBCDEF\f!; G‰HƒÖŠ;qˆ×I JKLH!ˆJ„¿MÑ!ˆ*GƒÒNO!ˆGCO)‚îGƒîŠ;qˆNO!ˆGCO)*ÑPŠ;qˆQp!ˆ7PRed\")<Pƒ×)ÃS!ˆÈTDCSU ˆV ˆMÑ!ˆ<âUƒŠWXYZ\f!ƒS[\f\\Q‚k]^\f ‰æUƒg_‚j`$abc!d±ˆæ=×7MÑ!ˆ‚›=æWƒ”æ=e=!ˆLf!ˆg ‡" [primary forms--mode-setup kill-all-local-variables make-local-variable forms-file forms-number-of-fields forms-format-list forms-field-sep forms-read-only forms-multi-line forms-forms-scroll forms-forms-jump forms-use-text-properties forms-read-file-filter forms-write-file-filter forms-new-record-filter forms-modified-record-filter nil fboundp make-face forms-ro-face forms-rw-face enable-local-eval t yes-or-no-p "Evaluate lisp code in buffer " buffer-name " to display forms " eval-current-buffer error "`enable-local-eval' inhibits buffer evaluation" "Forms control file error: " "'forms-file' has not been set" "'forms-field-sep' is not a string" 0 "'forms-number-of-fields' must be a number > 0" "'forms-number-of-fields' has not been set" forms--intuit-from-file 1 "'forms-multi-line' is equal to 'forms-field-sep'" "'forms-multi-line' must be nil or a one-character string" set-text-properties forms--process-format-list forms--format forms--markers forms--dyntexts forms--elements forms--make-format forms--parser forms--make-parser "'forms-new-record-filter' is not a function" "'forms-modified-record-filter' is not a function" forms-fields forms--dynamic-text set-visited-file-name buffer-read-only erase-buffer forms--ro-face forms--rw-face forms--file-buffer forms--total-records forms--current-record forms--the-record-list forms--search-regexp forms-mode-map forms--mode-commands forms-mode major-mode "Forms" mode-name find-file-noselect write-file-filter read-file-filter buffer-modified-p file-modified inhibit-read-only run-hooks set-buffer-modified-p make-variable-buffer-local local-write-file-hooks ro bury-buffer count-lines minor-mode-alist " View" forms--set-keymaps forms--change-commands "GNU Emacs Forms Mode version " forms-version "\n\n" file-exists-p "No records available in file \"" "\".\n\n" format "Creating new file \"%s\"\nwith %d field%s per record.\n\n" "" "s" "Use " substitute-command-keys "\\[forms-insert-record]" " to create new records.\n" forms-jump-record forms-mode-hooks forms--help] 10 (#$ . 4843) nil]) (defalias 'forms--process-format-list #[nil "„\nÁÂÃP!ˆ<„ÁÂÄP!ˆÅÇ\"ÉÇÉ\n \f Ç ƒ\n ¢ £‰9ƒKÐ!ƒKÑ!;ƒu ;ƒa P ‚ ƒnÒ CÇ# ‚§ƒËÉX„ŠVƒ”ÁÓÔP#ˆ\nGVƒ©ÕS\"‚²\nSIˆ\nT\n ƒÄÒ CÇ# ‚<ƒøÖ¢!„äÁÓ×Ø¢!Q!ˆ ƒñÒ CÇ# ‚ÁÓÙØ!Q!ˆ *‚* ƒ$Ò CÇ# §ƒ$ÒÚCÇ#,ÛÀÈ\"‡" [forms-format-list error "Forms control file error: " "'forms-format-list' has not been set" "'forms-format-list' is not a list" make-vector forms-number-of-fields nil forms--elements 0 field-num prev-item this-item the-list rem el boundp eval append "Forms format error: " "field number %d out of range 1..%d" vconcat fboundp "not a function " prin1-to-string "invalid element " "\n" forms--debug] 6]) #@39 Record start of modification command. (defvar forms--iif-start nil (#$ . 9150)) #@56 Original properties of the character being overridden. (defvar forms--iif-properties nil (#$ . 9236)) #@58 `insert-in-front-hooks' function for read-only segments. (defalias 'forms--iif-hook #[(begin end) "„ Á`T!ÂX„ÃÂZÄ\"ƒ8ÅS!ÇÉSÊ ÌÍF#ˆ)ÎÏC\"‰‡Ñ‰‡" [forms--iif-start copy-marker 2 get-text-property read-only text-properties-at forms--iif-properties t inhibit-read-only set-text-properties face forms--rw-face front-sticky (face) append forms--iif-post-command-hook post-command-hook nil] 7 (#$ . 9344)]) #@54 `post-command-hook' function for read-only segments. (defalias 'forms--iif-post-command-hook #[nil "ÀÁ\n\" ƒÄÆ S #ˆ)ȉ‡" [delq forms--iif-hook-post-command-hook post-command-hook forms--iif-start t inhibit-read-only set-text-properties forms--iif-properties nil] 4 (#$ . 9769)]) (byte-code "À B BÀ‡" [forms--marker current-load-list forms--dyntext] 2) #@72 Generate `forms--format' using the information in `forms-format-list'. (defalias 'forms--make-format #[nil "À‰ ƒ)ÄÅÆÇÈÉÈÊË\f\"\"\f@§?…ÍÎ#BBÏBBB‚5ÄÐÉÈÊÑ\f\"\"BBÓ\nÔ\"Ó Ô\"*×Ò!‡" [0 forms--dyntext forms--marker forms-use-text-properties lambda (arg) let ((inhibit-read-only t)) append apply mapcar forms--make-format-elt-using-text-properties forms-format-list ((add-text-properties (point-min) (1+ (point-min)) (quote (front-sticky (read-only intangible))))) ((remove-text-properties (1- (point)) (point) (quote (rear-nonsticky)))) ((setq forms--iif-start nil)) (arg) forms--make-format-elt forms--format make-vector nil forms--markers forms--dyntexts forms--debug] 10 (#$ . 10137)]) #@45 Helper routine to generate format function. (defalias 'forms--make-format-elt-using-text-properties #[(el) ";ƒ ÁÂÃÄDÅBBÆÇÈÉÊ TCÌ\"BBBBFC‡§ƒAÍÎÏÐ ‰T ÑBBBÄÒÓSEDÔBBBBC‡<…iÁÕÃÄÏÖ‰TFDØBBÆÙÈÚÊ TCÛ\"BBBBFC‡" [el set-text-properties (point) progn insert ((point)) list (quote face) forms--ro-face (quote read-only) append forms--marker ((quote intangible) t (quote insert-in-front-hooks) (quote (forms--iif-hook)) (quote rear-nonsticky) (quote (face read-only insert-in-front-hooks intangible))) let ((here (point))) aset forms--markers ((point-marker)) elt arg ((or (= (point) here) (set-text-properties here (point) (list (quote face) forms--rw-face (quote front-sticky) (quote (face)))))) (point) forms--dyntexts forms--dyntext ((point)) (quote face) (quote read-only) ((quote intangible) t (quote insert-in-front-hooks) (quote (forms--iif-hook)) (quote rear-nonsticky) (quote (read-only face insert-in-front-hooks intangible)))] 10 (#$ . 10841)]) #@45 Helper routine to generate format function. (defalias 'forms--make-format-elt #[(el) ";ƒ\nÁDC‡§ƒ\"ÂÃ\fÅBBBÁÆÇSEDD\fT‡<…5ÁÂÈ FDC T ‡" [el insert aset forms--markers forms--marker ((point-marker)) elt arg forms--dyntexts forms--dyntext] 5 (#$ . 11807)]) (byte-code "À B Bà BÀ‡" [forms--field current-load-list forms--recordv forms--seen-text] 2) #@71 Generate `forms--parser' from the information in `forms-format-list'. (defalias 'forms--make-parser #[nil "ƒÁ‚%‰ÃÇÂÈÉÊËÌÍÎÌÂC\"\"\"BBBE+ÑÐ!‡" [forms-use-text-properties forms--parser-using-text-properties nil 0 forms--dyntext forms--seen-text forms--field lambda let (here) (goto-char (point-min)) apply append mapcar forms--make-parser-elt forms-format-list forms--parser forms--debug] 12 (#$ . 12174)]) #@59 Extract field info from forms when using text properties. (defalias 'forms--parser-using-text-properties #[nil "ÀÁ‰‰ GW…R \fH‰bˆÆ Ç\"ƒ' \fHÁIˆ‚KÊ Ç\"‰ƒ? \fHË \n\"Iˆ‚K \fHË d\"Iˆ\fT‰‚+‡" [0 nil there here i forms--markers get-text-property read-only forms--recordv forms--elements next-single-property-change buffer-substring-no-properties] 6 (#$ . 12598)]) #@51 Helper routine to generate forms parser function. (defalias 'forms--make-parser-elt #[(el) ";ƒ@ ƒ(ÂÃÄÅÆBBDÇÈEEÉÊ SËÌÍÎGEEFE‚:ÃÄÏÐ!DDÇÑEEÒGDDÓÕ‡§ƒS ƒOÇÖ #‡Õ‡„e …ÉÊ S×BBBC‡<… ƒ†ØÙÚÛÜEDDÝÉÊ SÞBBBFC‚“ØÚÛÜEDCßBBCTÓÕ‡" [el forms--field (setq here (point)) if not search-forward (nil t nil) error "Parse error: cannot find \"%s\"" aset forms--recordv buffer-substring-no-properties here - (point) looking-at regexp-quote "Parse error: not looking at \"%s\"" forward-char t forms--seen-text nil "Cannot parse adjacent fields %d and %d" ((buffer-substring-no-properties (point) (point-max))) let (here (point)) forms--dyntext aref forms--dyntexts (if (not (search-forward forms--dyntext nil t nil)) (error "Parse error: cannot find \"%s\"" forms--dyntext)) ((buffer-substring-no-properties here (- (point) (length forms--dyntext)))) ((if (not (looking-at (regexp-quote forms--dyntext))) (error "Parse error: not looking at \"%s\"" forms--dyntext)) (forward-char (length forms--dyntext)))] 10 (#$ . 12983)]) #@62 Get number of fields and a default form using the data file. (defalias 'forms--intuit-from-file #[nil "„dÁ\n!„ÃÄ!ˆ‚dÅ\n!È \nŠqˆË\fÍÊ!ˆ)ebˆÎ ) Ï!ˆÈÐÈGÖ× #‰ƒbT\\‚G.Ø\nÙEÐT‰X…ŠÜÝÞ\"ßE\"‚m)‡" [forms-number-of-fields file-exists-p forms-file error "Need existing file or explicit 'forms-number-of-records'." find-file-noselect forms--file-buffer forms-read-file-filter nil the-record read-file-filter t inhibit-read-only run-hooks forms--get-record kill-buffer 0 forms-field-sep field-sep-length found-pos start-pos the-result 1 string-match "Forms file \"" "\".\n\n" forms-format-list i append format "%4d: " "\n"] 5 (#$ . 14026)]) #@36 Set the keymaps used in this mode. (defalias 'forms--set-keymaps #[nil "À ƒ \n‚\n !‡" [use-local-map forms-read-only forms-mode-ro-map forms-mode-edit-map] 2 (#$ . 14725)]) #@30 Fill the Forms mode keymaps. (defalias 'forms--mode-commands #[nil "À  ÃÄ#ˆÂ ÅÆ#ˆÂ ÇÈ#ˆÂ ÉÊ#ˆÂ ËÌ#ˆÂ ÍÎ#ˆÂ ÏÐ#ˆÂ ÑÒ#ˆÂ ÓÔ#ˆÂ ÕÖ#ˆÂ ×Ø#ˆÂ ÙÚ#ˆÂ ÛÐ#ˆÀ Ý!ˆÂÞ #ˆÂÃÄ#ˆÂßÈ#ˆÂàÌ#ˆÂáÎ#ˆÂâÐ#ˆÂãÒ#ˆÂäÔ#ˆÂåÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂæç#ˆÂèÎ#ˆé!ˆê!ˆÀ +Â+ÃÄ#ˆÂ+Þ #ˆé+!ˆì+!‡" [make-keymap forms-mode-map define-key " " forms-next-field " " forms-delete-record "" forms-toggle-read-only "" forms-insert-record "\f" forms-jump-record "" forms-next-record "" forms-prev-record "" forms-search-backward "" forms-search-forward "" forms-exit "<" forms-first-record ">" forms-last-record "" forms-mode-ro-map suppress-keymap "" "q" "l" "n" "p" "r" "s" "x" "?" describe-mode " " forms--mode-commands1 forms--mode-menu-ro forms-mode-edit-map forms--mode-menu-edit] 4 (#$ . 14906)]) (defalias 'forms--mode-menu-ro #[(map) "À ÂÃÄÃ!B#ˆÀ ÅÆ#ˆÀ ÇÈ#ˆÀ ÉÊ#ˆÀ ËÌ#ˆÀ ÍÎ#ˆÀ ÏÐ#ˆÀ ÑÒ#ˆÀ ÓÔ#ˆÀ ÕÖ#ˆÀ ×Ø#ˆÀ ÙÚ#ˆÀ ÛÜ#ˆÀ ÝÞ#ˆÀ ßà#ˆÀ áâ#ˆÀ ãä#ˆÀ åæ#ˆÀ çè#ˆÀ éê#ˆëìíî#ˆëïíð#‡" [define-key map [menu-bar forms] "Forms" make-sparse-keymap [menu-bar forms menu-forms-exit] ("Exit" . forms-exit) [menu-bar forms menu-forms-sep1] ("----") [menu-bar forms menu-forms-save] ("Save Data" . forms-save-buffer) [menu-bar forms menu-forms-print] ("Print Data" . forms-print) [menu-bar forms menu-forms-describe] ("Describe Mode" . describe-mode) [menu-bar forms menu-forms-toggle-ro] ("Toggle View/Edit" . forms-toggle-read-only) [menu-bar forms menu-forms-jump-record] ("Jump" . forms-jump-record) [menu-bar forms menu-forms-search-backward] ("Search Backward" . forms-search-backward) [menu-bar forms menu-forms-search-forward] ("Search Forward" . forms-search-forward) [menu-bar forms menu-forms-delete-record] ("Delete" . forms-delete-record) [menu-bar forms menu-forms-insert-record] ("Insert" . forms-insert-record) [menu-bar forms menu-forms-sep2] ("----") [menu-bar forms menu-forms-last-record] ("Last Record" . forms-last-record) [menu-bar forms menu-forms-first-record] ("First Record" . forms-first-record) [menu-bar forms menu-forms-prev-record] ("Previous Record" . forms-prev-record) [menu-bar forms menu-forms-next-record] ("Next Record" . forms-next-record) [menu-bar forms menu-forms-sep3] ("----") [menu-bar forms menu-forms-prev-field] ("Previous Field" . forms-prev-field) [menu-bar forms menu-forms-next-field] ("Next Field" . forms-next-field) put forms-insert-record menu-enable (not forms-read-only) forms-delete-record (not forms-read-only)] 6]) (defalias 'forms--mode-menu-edit #[(map) "À ÂÃÄÃ!B#ˆÀ ÅÆ#ˆÀ ÇÈ#ˆÀ ÉÊ#ˆÀ ËÌ#ˆÀ ÍÎ#ˆÀ ÏÐ#ˆÀ ÑÒ#ˆÀ ÓÔ#ˆÀ ÕÖ#ˆÀ ×Ø#ˆÀ ÙÚ#ˆÀ ÛÜ#ˆÀ ÝÞ#ˆÀ ßà#ˆÀ áâ#ˆÀ ãä#ˆÀ åæ#ˆÀ çè#ˆÀ éê#ˆëìíî#ˆëïíð#‡" [define-key map [menu-bar forms] "Forms" make-sparse-keymap [menu-bar forms menu-forms-edit--exit] ("Exit" . forms-exit) [menu-bar forms menu-forms-edit-sep1] ("----") [menu-bar forms menu-forms-edit-save] ("Save Data" . forms-save-buffer) [menu-bar forms menu-forms-edit-print] ("Print Data" . forms-print) [menu-bar forms menu-forms-edit-describe] ("Describe Mode" . describe-mode) [menu-bar forms menu-forms-edit-toggle-ro] ("Toggle View/Edit" . forms-toggle-read-only) [menu-bar forms menu-forms-edit-jump-record] ("Jump" . forms-jump-record) [menu-bar forms menu-forms-edit-search-backward] ("Search Backward" . forms-search-backward) [menu-bar forms menu-forms-edit-search-forward] ("Search Forward" . forms-search-forward) [menu-bar forms menu-forms-edit-delete-record] ("Delete" . forms-delete-record) [menu-bar forms menu-forms-edit-insert-record] ("Insert" . forms-insert-record) [menu-bar forms menu-forms-edit-sep2] ("----") [menu-bar forms menu-forms-edit-last-record] ("Last Record" . forms-last-record) [menu-bar forms menu-forms-edit-first-record] ("First Record" . forms-first-record) [menu-bar forms menu-forms-edit-prev-record] ("Previous Record" . forms-prev-record) [menu-bar forms menu-forms-edit-next-record] ("Next Record" . forms-next-record) [menu-bar forms menu-forms-edit-sep3] ("----") [menu-bar forms menu-forms-edit-prev-field] ("Previous Field" . forms-prev-field) [menu-bar forms menu-forms-edit-next-field] ("Next Field" . forms-next-field) put forms-insert-record menu-enable (not forms-read-only) forms-delete-record (not forms-read-only)] 6]) #@32 Helper routine to define keys. (defalias 'forms--mode-commands1 #[(map) "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÅ#‡" [define-key map [TAB] forms-next-field [S-tab] forms-prev-field [next] forms-next-record [prior] forms-prev-record [begin] forms-first-record [last] forms-last-record [backtab]] 4 (#$ . 19130)]) #@40 Localize some commands for Forms mode. (defalias 'forms--change-commands #[nil "ƒÁÂÃÄ Å $ˆÁÆÇÄ Å $ˆƒ-ÁÉÊÄ Å $ˆÁËÌÄ Å $ˆÍÎÏ\"ˆÐÑ!ˆÒÓ‡" [forms-forms-scroll substitute-key-definition scroll-up forms-next-record current-local-map current-global-map scroll-down forms-prev-record forms-forms-jump beginning-of-buffer forms-first-record end-of-buffer forms-last-record local-set-key "" forms-save-buffer make-local-variable revert-buffer-function forms--revert-buffer t] 5 (#$ . 19448)]) #@30 Initial help for Forms mode. (defalias 'forms--help #[nil "ÀÁÂÃÄÅÆ°!!‡" [message substitute-command-keys "\\[forms-next-record]:next" " \\[forms-prev-record]:prev" " \\[forms-first-record]:first" " \\[forms-last-record]:last" " \\[describe-mode]:help"] 7 (#$ . 19946)]) #@93 Translate in SUBJ all chars ARG into char REP. ARG and REP should be single-char strings. (defalias 'forms--trans #[(subj arg rep) "À G !Ä ! Ê  #‰ …-  Iˆ T ‚,‡" [0 subj regexp-quote arg string-to-char rep k re x i string-match] 5 (#$ . 20231)]) #@41 Internal exit from forms mode function. (defalias 'forms--exit #[(query &optional save) "À !à ˆ\fƒÅ !ƒÆ ˆŠ qˆÇ ˆÈp!ˆ)É\n!ƒ3\f…9Ê ˆËÌ!‚9Ç ˆÈp!)‡" [buffer-name forms--file-buffer buf forms--checkmod save buffer-modified-p forms-save-buffer delete-auto-save-file-if-necessary kill-buffer get-buffer beep message "Problem saving buffers?"] 2 (#$ . 20504)]) #@48 Fetch the current record from the file buffer. (defalias 'forms--get-record #[nil "n„Àyˆ`ˆà `\" bˆ)‡" [0 here nil buffer-substring-no-properties] 3 (#$ . 20871)]) #@57 Format THE-RECORD and display it in the current buffer. (defalias 'forms--show-record #[(the-record) "ÀÁÀ\nGƒÈ Ê#ˆ \nP Ë\n #‰ƒ@ \fO\fÍ\fC\" \f\\)‚,ÀƒWÑÓedÀ#ˆ)Ô ˆGU„Œƒt× ˆØÙG#ˆGWƒŒÍÚGZÛ\"\"ÍÀCÀ#!ˆebˆÞÀ!ˆà!â#R‰$‡" [nil 0 forms-field-sep field-sep-length found-pos start-pos the-result forms-multi-line forms--trans the-record "\n" string-match ent append forms--the-record-list buffer-read-only forms-use-text-properties t inhibit-read-only set-text-properties erase-buffer forms-number-of-fields forms-check-number-of-fields beep message "Warning: this record has %d fields instead of %d" make-list "" forms-fields forms--format set-buffer-modified-p forms-read-only " " forms--current-record "/" forms--total-records mode-line-process] 5 (#$ . 21045)]) #@46 Parse contents of form into list of strings. (defalias 'forms--parse-form #[nil "À !\f ˆ)ƒ(ÂÇ \"!ÉÀ\"A)‚,É À\")‡" [nil forms--recordv vconcat forms--the-record-list forms--dynamic-text forms--parser forms-modified-record-filter [nil] the-fields append] 3 (#$ . 21884)]) #@95 Update current record with contents of form. As a side effect: sets `forms--the-record-list'. (defalias 'forms--update #[nil "ƒ ÁÂ!ˆÃ ‡ÄÆ ÈÉ\n#ËÌ\n!ÈÉÍ#\"ƒ,ÎÏ!ˆƒ8Ñ Ò#ˆËÒ \"ƒHÁÓ!ˆÃ ‚cŠqˆŠÕyˆ`)ŠÄˆ`)|ˆ cˆÕyˆ)Ä)‡" [forms-read-only message "Read-only buffer!" beep nil the-record forms--parse-form forms--the-record-list mapconcat identity forms-field-sep string-match regexp-quote "" error "Field separator occurs in record - update refused!" forms-multi-line forms--trans "\n" "Multi-line fields in this record - update refused!" forms--file-buffer 0] 6 (#$ . 22179)]) #@69 Check if this form has been modified, and call forms--update if so. (defalias 'forms--checkmod #[nil "ÀÁ!…`à ˆÄÁ!ˆ\nb)‡" [buffer-modified-p nil here forms--update set-buffer-modified-p] 2 (#$ . 22774)]) #@29 Visit a file in Forms mode. (defalias 'forms-find-file #[(fn) "À‰Ã\f!ˆ †ÆÀ!*‡" [t enable-local-variables enable-local-eval find-file-read-only fn forms--mode-setup forms-mode] 2 (#$ . 22986) "fForms file: "]) #@45 Visit a file in Forms mode in other window. (defalias 'forms-find-file-other-window #[(fn) "À‰Ã\f!ˆ †ÆÀ!*‡" [t enable-local-variables enable-local-eval find-file-other-window fn forms--mode-setup forms-mode] 2 (#$ . 23205) "fFbrowse file in other window: "]) #@59 Normal exit from Forms mode. Modified buffers are saved. (defalias 'forms-exit #[(query) "À Â\"‡" [forms--exit query t] 3 (#$ . 23474) "P"]) #@46 Exit from Forms mode without saving buffers. (defalias 'forms-exit-no-save #[(query) "À Â\"‡" [forms--exit query nil] 3 (#$ . 23622) "P"]) #@40 Advance to the ARGth following record. (defalias 'forms-next-record #[(arg) "À  !\\Ä\"‡" [forms-jump-record forms--current-record prefix-numeric-value arg t] 4 (#$ . 23767) "P"]) #@39 Advance to the ARGth previous record. (defalias 'forms-prev-record #[(arg) "À  !ZÄ\"‡" [forms-jump-record forms--current-record prefix-numeric-value arg t] 4 (#$ . 23953) "P"]) #@26 Jump to a random record. (defalias 'forms-jump-record #[(arg &optional relative) " V„\fÂXƒà ˆ\f?…sÅÆ #‡Ç ˆZ \nËŠ\fqˆÂyˆ\fƒL\nÂU„X \n‰y[\\\\ ‚X \nÍ![\\\\ Î )!ˆ U?…r à ˆÅÏ \"*‡" [arg forms--total-records 0 beep relative message "Record number %d out of range 1..%d" forms--checkmod forms--current-record cur disp forms--show-record forms--file-buffer goto-line forms--get-record "Stuck at record %d"] 5 (#$ . 24137) "NRecord number: "]) #@23 Jump to first record. (defalias 'forms-first-record #[nil "ÀÁ!‡" [forms-jump-record 1] 2 (#$ . 24615) nil]) #@94 Jump to last record. As a side effect: re-calculates the number of records in the data file. (defalias 'forms-last-record #[nil "ŠqˆÁed\")‰ U„Ä ˆ\nÅÆ \"ˆ)Ç !‡" [forms--file-buffer count-lines numrec forms--total-records beep message "Warning: number of records changed to %d" forms-jump-record] 4 (#$ . 24729) nil]) #@180 Toggles read-only mode of a forms mode buffer. With an argument, enables read-only mode if the argument is positive. Otherwise enables edit mode if the visited file is writeable. (defalias 'forms-toggle-read-only #[(arg) "ƒ\fÁ!ÂX‚ ƒ7 Š qˆ)ƒ*ÇÈÉ\n\"ˆË ˆ‚,Ì\f š?…5Í )‡ ?…CÎ ˆÇÍ ‡" [arg prefix-numeric-value 0 forms-read-only ro forms--file-buffer buffer-read-only t message "No write access to \"%s\"" forms-file beep nil forms-mode forms--checkmod] 3 (#$ . 25057) "P"]) #@221 Create a new record before the current one. With ARG: store the record after the current one. If `forms-new-record-filter' contains the name of a function, it is called to fill (some of) the fields with default values. (defalias 'forms-insert-record #[(arg) "ƒÁÂ!ˆ ƒ\fT‚\fʼnÉ ˆ\nƒ=Ë\fTÂ\" \n ! Î Å\"A)‚DÏ\fÂ\"ÐÑ#ŠqˆÔ!ˆÕÖ!ˆcˆ×yˆ)+TÙ\f!‡" [forms-read-only error "" arg forms--current-record nil the-record the-list ln forms--checkmod forms-new-record-filter make-vector forms-number-of-fields the-fields append make-list mapconcat identity forms-field-sep forms--file-buffer goto-line open-line 1 0 forms--total-records forms-jump-record] 4 (#$ . 25550) "P"]) #@55 Deletes a record. With a prefix argument: don't ask. (defalias 'forms-delete-record #[(arg) "ƒÁÂ!ˆÃ ˆ\f„ÅÆ!ƒEŠ qˆÊ!ˆËyˆ`Ìyˆ`|ˆ) S  Vƒ? Î!ˆ)ÏÂ!‡" [forms-read-only error "" forms--checkmod arg y-or-n-p "Really delete this record? " forms--current-record ln forms--file-buffer goto-line 0 1 forms--total-records forms-jump-record message] 2 (#$ . 26261) "P"]) #@46 Search forward for record containing REGEXP. (defalias 'forms-search-forward #[(regexp) "Ášƒ\nà ˆÄ‰‰  Š\nqˆ`ĈËÄÌ#„9bˆÍÎÏQ!ˆÄ‚EÐ Ñe`\"T‰ )ƒX Ó!ˆËÄÌ#ˆ,‰‡" [regexp "" forms--search-regexp forms--checkmod nil forms-field-sep fld-sep here the-record the-line forms--file-buffer re-search-forward t message "\"" "\" not found." forms--get-record count-lines forms--current-record forms--show-record] 4 (#$ . 26649) (list (read-string (concat "Search forward for" (if forms--search-regexp (concat " (" forms--search-regexp ")")) ": ")))]) #@47 Search backward for record containing REGEXP. (defalias 'forms-search-backward #[(regexp) "Ášƒ\nà ˆÄ‰‰  Š\nqˆ`ËyˆÌÄÍ#„9bˆÎÏÐQ!ˆÄ‚EÑ Òe`\"T‰ )ƒX Ô!ˆÕÄÍ#ˆ,‰‡" [regexp "" forms--search-regexp forms--checkmod nil forms-field-sep fld-sep here the-record the-line forms--file-buffer 0 re-search-backward t message "\"" "\" not found." forms--get-record count-lines forms--current-record forms--show-record re-search-forward] 4 (#$ . 27221) (list (read-string (concat "Search backward for" (if forms--search-regexp (concat " (" forms--search-regexp ")")) ": ")))]) #@156 Forms mode replacement for save-buffer. It saves the data buffer instead of the forms buffer. Calls `forms-write-file-filter' before writing out the data. (defalias 'forms-save-buffer #[(&optional args) "À ˆ Š qˆÄÆ!ˆ\nƒÈÂ!ˆÉÊ!ˆ+ć" [forms--checkmod forms-read-file-filter read-file-filter forms--file-buffer t inhibit-read-only save-buffer args run-hooks set-buffer-modified-p nil] 2 (#$ . 27818) "p"]) #@38 Reverts current form to un-modified. (defalias 'forms--revert-buffer #[(&optional arg noconfirm) "„\nÁÂ!…ÃÄ!ˆÅ!‡" [noconfirm yes-or-no-p "Revert form to unmodified? " set-buffer-modified-p nil forms-jump-record forms--current-record] 2 (#$ . 28233) "P"]) #@28 Jump to ARG-th next field. (defalias 'forms-next-field #[(arg) "À`ÁÀÂÀUƒÉ‚\f\\ÊË?…)\fÀHb-‡" [0 nil t inhibit-point-motion-hooks cnt there here i arg 1 done (byte-code " GW…- H‰ƒ&\n X„&\fS‰ÅXƒ&\nbˆÆÇÈ\"ˆT‰‚‡" [i forms--markers there here cnt 0 throw done t] 4) forms--markers] 5 (#$ . 28500) "p"]) #@32 Jump to ARG-th previous field. (defalias 'forms-prev-field #[(arg) "G`ÁÂà ÂUƒÊ‚  \\ËÌ?…,‰GSHb-‡" [forms--markers nil 0 t inhibit-point-motion-hooks cnt there here i arg 1 done (byte-code "ÁV…+S\nH‰ƒ \fY„ S‰ÁXƒ bˆÆÇÈ\"ˆ‚‡" [i 0 forms--markers there here cnt throw done t] 3)] 5 (#$ . 28835) "p"]) #@75 Send the records to the printer with 'print-buffer', one record per page. (defalias 'forms-print #[nil "À Âà Xƒ;É !ˆÊ ŠËÌ!qˆÍÂ!bˆ\fcˆÃ Wƒ3Ïcˆ) T‰‚ ŠÌqˆÐ ˆÑÃ!ˆÒp!ˆ)É!,‡" [t forms--current-record 1 nil record nb-record save-record inhibit-read-only forms--total-records forms-jump-record buffer-string get-buffer-create "*forms-print*" buffer-end buffer-read-only "\n\f\n" print-buffer set-buffer-modified-p kill-buffer] 5 (#$ . 29172) nil]) #@273 Take a quoted list of symbols, and set their values to sequential numbers. The first symbol gets number 1, the second 2 and so on. It returns the higest number. Usage: (setq forms-number-of-fields (forms-enumerate '(field1 field2 field2 ...))) (defalias 'forms-enumerate #[(the-fields) "À\nƒ T\n¢\n£ Lˆ)‚ )‡" [0 the-index the-fields el] 2 (#$ . 29638)]) #@43 *Enables forms-mode debugging if not nil. (defvar forms--debug nil (#$ . -30035)) #@29 Internal debugging routine. (defalias 'forms--debug #[(&rest args) "…gÁ ƒQ ¢ £\f;ƒ\n\fP‚M\nÅ\f!ÆQÇ\f!ƒ:È\f! \nÅ !ÊQ)‚?\nËÊQÌ\f!ƒM\nÅ\fK!ÊQ)‚ŠÍÎ!qˆÏ ÐUƒaÑ ˆdbˆ\nc*‡" [forms--debug nil ret args el prin1-to-string " = " boundp eval vel "\n" "" fboundp get-buffer-create "*forms-mode debug*" buffer-size 0 emacs-lisp-mode] 3 (#$ . 30123)]) emacs-19.30/lisp/fortran.elc100666 13437 1 102222 6044071330 14405 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Oct 27 01:48:34 1995 ;;; from file /home/fsf/rms/e19/lisp/fortran.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`fortran.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ\nBÁ‡" ["version 1.30.6" fortran-mode-version current-load-list] 2) #@228 *Default tabbing/carriage control style for empty files in Fortran mode. A value of t specifies tab-digit style of continuation control. A value of nil specifies that continuation lines are marked with a character in column 6. (defvar fortran-tab-mode-default nil (#$ . -559)) #@59 String to appear in mode line when TAB format mode is on. (defvar fortran-tab-mode-string nil (#$ . 842)) #@42 *Extra indentation applied to DO blocks. (defvar fortran-do-indent 3 (#$ . -954)) #@42 *Extra indentation applied to IF blocks. (defvar fortran-if-indent 3 (#$ . -1042)) #@75 *Extra indentation applied to STRUCTURE, UNION, MAP and INTERFACE blocks. (defvar fortran-structure-indent 3 (#$ . -1131)) #@59 *Extra indentation applied to Fortran continuation lines. (defvar fortran-continuation-indent 5 (#$ . -1260)) #@380 *nil forces comment lines not to be touched, 'fixed makes fixed comment indentation to `fortran-comment-line-extra-indent' columns beyond `fortran-minimum-statement-indent-fixed' (for `indent-tabs-mode' of nil) or `fortran-minimum-statement-indent-tab' (for `indent-tabs-mode' of t), and 'relative indents to current Fortran indentation plus `fortran-comment-line-extra-indent'. (defvar fortran-comment-indent-style (quote fixed) (#$ . -1377)) #@66 *Amount of extra indentation for text within full-line comments. (defvar fortran-comment-line-extra-indent 0 (#$ . -1827)) #@53 *Delimiter inserted to start new full-line comment. (defvar comment-line-start nil (#$ . -1956)) #@52 *Regexp to match the start of a full-line comment. (defvar comment-line-start-skip nil (#$ . -2059)) #@69 *Minimum statement indentation for fixed format continuation style. (defvar fortran-minimum-statement-indent-fixed 6 (#$ . -2166)) #@67 *Minimum statement indentation for TAB format continuation style. (defvar fortran-minimum-statement-indent-tab (max tab-width 6) (#$ . -2303)) #@86 *Single-character string inserted for Fortran comment indentation. Normally a space. (defvar fortran-comment-indent-char " " (#$ . -2452)) #@107 *Maximum indentation for Fortran line numbers. 5 means right-justify them within their five-column field. (defvar fortran-line-number-indent 1 (#$ . -2598)) #@76 *Non-nil causes all numbered lines to be treated as possible DO loop ends. (defvar fortran-check-all-num-for-matching-do nil (#$ . -2761)) #@154 *Non-nil causes \[fortran-indent-line] on ENDIF statement to blink on matching IF. Also, from an ENDDO statement blink on matching DO [WHILE] statement. (defvar fortran-blink-matching-if nil (#$ . -2907)) #@352 *Single-character string used for Fortran continuation lines. In fixed format continuation style, this character is inserted in column 6 by \[fortran-split-line] to begin a continuation line. Also, if \[fortran-indent-line] finds this at the beginning of a line, it will convert the line into a continuation line of the appropriate style. Normally $. (defvar fortran-continuation-string "$" (#$ . -3119)) #@80 *String inserted by \[fortran-comment-region] at start of each line in region. (defvar fortran-comment-region "c$$$" (#$ . -3530)) #@80 *Non-nil causes line number digits to be moved to the correct column as typed. (defvar fortran-electric-line-number t (#$ . -3667)) #@72 *Non-nil displays a startup message when Fortran mode is first called. (defvar fortran-startup-message t (#$ . -3805)) #@107 *String displayed above current line by \[fortran-column-ruler]. This variable used in fixed format mode. (defvar fortran-column-ruler-fixed "0 4 6 10 20 30 40 5 60 70\n[ ]|{ | | | | | | | | | | | | |}\n" (#$ . -3931)) #@105 *String displayed above current line by \[fortran-column-ruler]. This variable used in TAB format mode. (defvar fortran-column-ruler-tab "0 810 20 30 40 5 60 70\n[ ]| { | | | | | | | | | | | | |}\n" (#$ . -4243)) #@48 Address of mailing list for Fortran mode bugs. (defconst bug-fortran-mode "bug-fortran-mode@erl.mit.edu" (#$ . 4550)) #@46 Syntax table in use in Fortran mode buffers. (defvar fortran-mode-syntax-table nil (#$ . 4674)) #@80 Number of lines to scan to determine whether to use fixed or TAB format style. (defvar fortran-analyze-depth 100 (#$ . 4776)) #@66 *Non-nil causes `fortran-fill' to break lines before delimiters. (defvar fortran-break-before-delimiters t (#$ . -4908)) (byte-code "„[Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÈ#ˆÂÊÈ#ˆÂËÈ#ˆÂÌÈ#ˆÂÍÎ#ˆÂÏÎ#ˆÂÐÑ#ˆÂÒÄ#ˆÂÓÄ#ˆÂÔÕ#ˆÂÖ×#ˆÁ‡" [fortran-mode-syntax-table make-syntax-table modify-syntax-entry 59 "w" 13 " " 43 "." 45 61 42 47 39 "\"" 34 92 "/" 46 95 33 "<" 10 ">"] 4) #@46 Subdued level highlighting for Fortran mode. (defconst fortran-font-lock-keywords-1 nil (#$ . 5282)) #@45 Medium level highlighting for Fortran mode. (defconst fortran-font-lock-keywords-2 nil (#$ . 5389)) #@44 Gaudy level highlighting for Fortran mode. (defconst fortran-font-lock-keywords-3 nil (#$ . 5495)) (byte-code "ÀÁÂÃÄÅÆÇÈÉÊËÌ°\fÍÎÏÐRÑÖ×QØBÙÚÛÜÝÞ\"ß°àDáâãPäåE¯&ç&èéQêBèéQëìQíîïEðñB¯\"2ç&èóQôõECö÷øE&G2›A$9,؇" ["c!*" "byte\\|c\\(haracter\\|om\\(mon\\|plex\\)\\)\\|" "d\\(ata\\|imension\\|ouble" "[ ]*\\(complex\\|precision\\)\\)\\|" "e\\(nd[ ]*\\(map\\|structure\\|union\\)\\|" "quivalence\\|xternal\\)\\|" "i\\(mplicit[ ]*\\(byte\\|" "c\\(haracter\\|omplex\\)\\|" "double[ ]*\\(complex\\|precision\\)\\|" "integer\\|logical\\|none\\|real\\)\\|" "nt\\(eger\\|rinsic\\)\\)\\|" "logical\\|map\\|none\\|parameter\\|re\\(al\\|cord\\)\\|" "s\\(ave\\|tructure\\)\\|union" "c\\(lose\\|ontinue\\)\\|" "e\\(lse\\(\\|if\\)\\|nd\\(\\|do\\|if\\)\\)\\|format\\|" "i\\(f\\|n\\(clude\\|quire\\)\\)\\|open\\|print\\|" "re\\(ad\\|turn\\)\\|stop\\|then\\|w\\(hile\\|rite\\)" "and\\|eq\\|false\\|g[et]\\|l[et]\\|n\\(e\\|ot\\)\\|or\\|true" fortran-logicals fortran-keywords fortran-type-types comment-chars "^[" "].*" font-lock-comment-face (fortran-match-!-comment . font-lock-comment-face) "^[^" " \n]" make-string 71 46 "\\(.*\\)" (1 font-lock-comment-face) ("'[^'\n]*'?" . font-lock-string-face) "\\<\\(block[ ]*data\\|call\\|entry\\|function\\|" "program\\|subroutine\\)\\>[ ]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t) fortran-font-lock-keywords-1 append "\\<\\(" "\\)\\>" font-lock-type-face "\\.\\(" "\\)\\." "\\<\\(do\\|go *to\\)\\>[ ]*\\([0-9]+\\)?" (1 font-lock-keyword-face) (2 font-lock-reference-face nil t) "^ *\\([0-9]+\\)" font-lock-reference-face fortran-font-lock-keywords-2 "\\)\\>[ (/]*\\(*\\)?" (1 font-lock-type-face) (font-lock-match-c++-style-declaration-item-and-skip-to-next (and (match-beginning 15) (forward-sexp 1)) nil (1 font-lock-variable-name-face nil t)) (", *\\(e\\(nd\\|rr\\)\\)\\> *\\(= *\\([0-9]+\\)\\)?" (1 font-lock-keyword-face) (4 font-lock-reference-face nil t)) ("^ \\([^ 0]\\)" 1 font-lock-string-face) ("^ \\([1-9]\\)" 1 font-lock-string-face) fortran-font-lock-keywords-3] 13) #@51 Default expressions to highlight in Fortran mode. (defvar fortran-font-lock-keywords fortran-font-lock-keywords-1 (#$ . 7583)) #@30 Keymap used in Fortran mode. (defvar fortran-mode-map nil (#$ . 7716)) (byte-code "„—Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆÂáà#ˆÂâà#ˆÂãà#ˆÂäà#ˆÂåà#ˆÂæà#ˆÂçà#ˆÂèà#ˆÂéà#ˆêë!„ ì+ë-B-+„U./ðëì\"ˆñ+òóì$ˆñ+ôõì$ˆñ+ö÷ì$ˆñ+øùì$ˆñ+úûì$ˆñ+üýì$ˆñ+þÿì$ˆñ+@Aì$ˆñ+BCì$ˆñ+DEì$ˆñ+FGì$ˆñ+HIì$ˆñ+JKì$ˆñ+LMì$ˆñ+NOì$ˆñ+PQì$ˆñ+RSì$ˆñ+TUì$ˆñ+VWì$ˆñ+XYì$ˆñ+Z[ì$ˆñ+\\]ì$ˆñ+^_ì$ˆñ+`aì$ˆñ+bcì$ˆñ+deì$ˆñ+fgì$ˆñ+hiì$ˆñ+jkì$ˆñ+lmì$ˆñ+noì$ˆñ+pqì$ˆñ+rsì$ˆñ+tuì$ˆñ+vwì$ˆñ+xyì$ˆñ+z{ì$ˆñ+|}ì$ˆñ+~ì$ˆñ+€ì$ˆñ+‚ƒì$ˆñ+„…ì$ˆñ+†‡ì$ˆñ+ˆ‰ì$ˆñ+Š‹ì$ˆñ+Œì$ˆñ+Žì$ˆñ+‘ì$ˆñ+’“ì$ˆñ+”•ì$ˆñ+–—ì$ˆñ+˜™ì$ˆñ+š›ì$ˆñ+œì$ˆñ+žŸì$ˆñ+ ¡ì$ˆñ+¢£ì$ˆñ+¤¥ì$ˆ/.)ì‡" [fortran-mode-map make-sparse-keymap define-key ";" fortran-abbrev-start ";" fortran-comment-region "" beginning-of-fortran-subprogram "" end-of-fortran-subprogram ";" fortran-indent-comment "" mark-fortran-subprogram "\n" fortran-split-line "\n" fortran-indent-new-line "" fortran-indent-subprogram "" fortran-window-create-momentarily "" fortran-column-ruler "" fortran-previous-statement "" fortran-next-statement " " fortran-indent-line "0" fortran-electric-line-number "1" "2" "3" "4" "5" "6" "7" "8" "9" boundp fortran-mode-abbrev-table nil current-load-list abbrevs-changed ac define-abbrev-table define-abbrev ";au" "automatic" ";b" "byte" ";bd" "block data" ";ch" "character" ";cl" "close" ";c" "continue" ";cm" "common" ";cx" "complex" ";df" "define" ";di" "dimension" ";do" "double" ";dc" "double complex" ";dp" "double precision" ";dw" "do while" ";e" "else" ";ed" "enddo" ";el" "elseif" ";en" "endif" ";eq" "equivalence" ";ew" "endwhere" ";ex" "external" ";ey" "entry" ";f" "format" ";fa" ".false." ";fu" "function" ";g" "goto" ";im" "implicit" ";ib" "implicit byte" ";ic" "implicit complex" ";ich" "implicit character" ";ii" "implicit integer" ";il" "implicit logical" ";ir" "implicit real" ";inc" "include" ";in" "integer" ";intr" "intrinsic" ";l" "logical" ";n" "namelist" ";o" "open" ";pa" "parameter" ";pr" "program" ";ps" "pause" ";p" "print" ";rc" "record" ";re" "real" ";r" "read" ";rt" "return" ";rw" "rewind" ";s" "stop" ";sa" "save" ";st" "structure" ";sc" "static" ";su" "subroutine" ";tr" ".true." ";ty" "type" ";vo" "volatile" ";w" "write" ";wh" "where"] 5) #@3103 Major mode for editing Fortran code. \[fortran-indent-line] indents the current Fortran line correctly. DO statements must not share a common CONTINUE. Type ;? or ;\[help-command] to display a list of built-in abbrevs for Fortran keywords. Key definitions: \{fortran-mode-map} Variables controlling indentation style and extra features: comment-start Normally nil in Fortran mode. If you want to use comments starting with `!', set this to the string "!". fortran-do-indent Extra indentation within do blocks. (default 3) fortran-if-indent Extra indentation within if blocks. (default 3) fortran-structure-indent Extra indentation within structure, union, map and interface blocks. (default 3) fortran-continuation-indent Extra indentation applied to continuation statements. (default 5) fortran-comment-line-extra-indent Amount of extra indentation for text within full-line comments. (default 0) fortran-comment-indent-style nil means don't change indentation of text in full-line comments, fixed means indent that text at `fortran-comment-line-extra-indent' beyond the value of `fortran-minimum-statement-indent-fixed' (for fixed format continuation style) or `fortran-minimum-statement-indent-tab' (for TAB format continuation style). relative means indent at `fortran-comment-line-extra-indent' beyond the indentation for a line of code. (default 'fixed) fortran-comment-indent-char Single-character string to be inserted instead of space for full-line comment indentation. (default " ") fortran-minimum-statement-indent-fixed Minimum indentation for Fortran statements in fixed format mode. (def.6) fortran-minimum-statement-indent-tab Minimum indentation for Fortran statements in TAB format mode. (default 9) fortran-line-number-indent Maximum indentation for line numbers. A line number will get less than this much indentation if necessary to avoid reaching column 5. (default 1) fortran-check-all-num-for-matching-do Non-nil causes all numbered lines to be treated as possible "continue" statements. (default nil) fortran-blink-matching-if Non-nil causes \[fortran-indent-line] on an ENDIF statement to blink on matching IF. Also, from an ENDDO statement, blink on matching DO [WHILE] statement. (default nil) fortran-continuation-string Single-character string to be inserted in column 5 of a continuation line. (default "$") fortran-comment-region String inserted by \[fortran-comment-region] at start of each line in region. (default "c$$$") fortran-electric-line-number Non-nil causes line number digits to be moved to the correct column as typed. (default t) fortran-break-before-delimiters Non-nil causes `fortran-fill' breaks lines before delimiters. (default t) fortran-startup-message Set to nil to inhibit message first time Fortran mode is used. Turning on Fortran mode calls the value of the variable `fortran-mode-hook' with no args, if that value is non-nil. (defalias 'fortran-mode #[nil "À ˆ ƒ ÂÃ\f #ˆÆÉ\n!ˆËÌ!ˆÍ\fËÎ!ˆÏËÐ!ˆÑËÒ!ˆÓËÔ!ˆÕËÖ!ˆ×ËØ!ˆÙËÚ!ˆÆËÛ!ˆÏËÜ!ˆÏËÝ!ˆÆÞà!!ˆâ#ä%Ëæ!ˆËç!ˆËè!ˆËé!ˆËê!ˆËë!ˆì+í îï!‡" [kill-all-local-variables fortran-startup-message message "Emacs Fortran mode %s. Bugs to %s" fortran-mode-version bug-fortran-mode nil fortran-mode-abbrev-table local-abbrev-table set-syntax-table fortran-mode-syntax-table make-local-variable font-lock-defaults ((fortran-font-lock-keywords fortran-font-lock-keywords-1 fortran-font-lock-keywords-2 fortran-font-lock-keywords-3) t t ((47 . "$/"))) fortran-break-before-delimiters t indent-line-function fortran-indent-line comment-indent-function fortran-comment-hook comment-line-start-skip "^[Cc*]\\(\\([^ \n]\\)\\2\\2*\\)?[ ]*\\|^#.*" comment-line-start "c" comment-start-skip "![ ]*" comment-start require-final-newline abbrev-all-caps indent-tabs-mode 72 fill-column use-local-map fortran-mode-map "Fortran" mode-name fortran-mode major-mode fortran-comment-line-extra-indent fortran-minimum-statement-indent-fixed fortran-minimum-statement-indent-tab fortran-column-ruler-fixed fortran-column-ruler-tab fortran-tab-mode-string " TAB-format" fortran-analyze-file-format run-hooks fortran-mode-hook] 4 (#$ . 10270) nil]) (defalias 'fortran-comment-hook #[nil "ŠÀÁxˆiÂ\\ ])‡" [" " nil 1 comment-column] 2]) #@351 Align or create comment on current line. Existing comments of all types are recognized and aligned. If the line has no comment, a side-by-side comment is inserted and aligned if the value of comment-start is not nil. Otherwise, a separate-line comment is inserted, on this line or on a new line inserted before this line if this line is not blank. (defalias 'fortran-indent-comment #[nil "ÀyˆÁ\n!ƒ\fà ‡Ä ƒ+ ƒ(À”bˆiÆ U?…*Ç ˆÆ j‡È‡ ƒDÁÊ!„DÈˆÇ ˆÆ jˆ c‡ÁÊ!ƒPÇ ˆ‚YÀyˆËcˆÌuˆ cˆÎ;ƒkÀH‚mÐ iZ\"‡" [0 looking-at comment-line-start-skip fortran-indent-line fortran-find-comment-start-skip comment-start-skip fortran-comment-hook delete-horizontal-space nil comment-start "^[ ]*$" "\n" -1 comment-line-start insert-char fortran-comment-indent-char calculate-fortran-indent] 4 (#$ . 14731) nil]) #@225 Comments every line in the region. Puts fortran-comment-region at the beginning of every line in the region. BEG-REGION and END-REGION are args which specify the region boundaries. With non-nil ARG, uncomments the region. (defalias 'fortran-comment-region #[(beg-region end-region arg) "À Á ‰\fÅ“ˆbˆÇyˆ„/ cˆÊyÇUƒ^` Wƒ^ cˆ‚Ë !\fÍ\f!ƒA`Ç•|ˆÊyÇUƒ]` Wƒ]Í\f!ƒA`Ç•|ˆ‚A)\nbˆ ʼn“ˆ\nʼn“*‡" [make-marker point-marker save-point end-region-mark end-region nil beg-region 0 arg fortran-comment-region 1 regexp-quote com looking-at] 4 (#$ . 15545) "*r\nP"]) #@111 Typing ;\[help-command] or ;? lists all the Fortran abbrevs. Any other key combination is executed normally. (defalias 'fortran-abbrev-start #[nil "À\ncˆÃ ‰Ä=„ =ƒÆ ‚ C‰)‡" [nil c last-command-char read-event 63 help-char fortran-abbrev-help unread-command-events] 2 (#$ . 16121) nil]) #@53 List the currently defined abbrevs in Fortran mode. (defalias 'fortran-abbrev-help #[nil "ÀÁ!ˆÂà !ˆÀÄ!‡" [message "Listing abbrev table..." display-buffer fortran-prepare-abbrev-list-buffer "Listing abbrev table...done"] 2 (#$ . 16424) nil]) (defalias 'fortran-prepare-abbrev-list-buffer #[nil "ŠÀÁ!qˆÂ ˆÃÄÅ\"ˆebˆÆÇ!ˆÈ ˆ)ÀÁ!‡" [get-buffer-create "*Abbrevs*" erase-buffer insert-abbrev-table-description fortran-mode-abbrev-table t set-buffer-modified-p nil edit-abbrevs-mode] 3]) #@270 Inserts a column ruler momentarily above current line, till next keystroke. The ruler is defined by the value of `fortran-column-ruler-fixed' when in fixed format mode, and `fortran-column-ruler-tab' when in TAB format mode. The key typed is executed unless it is SPC. (defalias 'fortran-column-ruler #[nil "À ƒ \n‚\n ŠÄyˆÅÆ !ÇÆ !=ƒ!Èyˆ`‚\"`)ÈÉ$‡" [momentary-string-display indent-tabs-mode fortran-column-ruler-tab fortran-column-ruler-fixed 0 window-start selected-window window-point nil "Type SPC or any command to erase ruler."] 5 (#$ . 16911) nil]) #@81 Makes the window 72 columns wide. See also `fortran-window-create-momentarily'. (defalias 'fortran-window-create #[nil "ÀÁ‡" [error (byte-code "À à WƒÄà  ZÅZ!ˆÆÇ!ˆÈÅ!ˆÉÊË\"ˆÌÍ !)‡" [2 window-min-width window-width frame-width enlarge-window-horizontally 1 split-window-horizontally 73 other-window switch-to-buffer " fortran-window-extra" t select-window previous-window] 3) ((error (byte-code "ÀÁ!ˆÂ‡" [message "No room for Fortran window." error] 2)))] 3 (#$ . 17476) nil]) #@148 Momentarily makes the window 72 columns wide. Optional ARG non-nil and non-unity disables the momentary feature. See also `fortran-window-create'. (defalias 'fortran-window-create-momentarily #[(&optional arg) "ƒ\nÁUƒ ‹‡Ã ‡" [arg 1 ((byte-code "À Áš?…ÂÃ!ˆÄ ‰ÆÇ!š† C‰)‡" [fortran-window-create error message "Type SPC to continue editing." read-event char string-to-char " " unread-command-events] 4)) fortran-window-create] 2 (#$ . 17966) "p"]) #@67 Break line at point and insert continuation marker and alignment. (defalias 'fortran-split-line #[nil "À ˆŠÁyˆÂ !)ƒÄ Ʊˆ‚.ƒ(ÈcˆÉÊ Ë\"ˆ‚.Ì ±ˆÎ ‡" [delete-horizontal-space 0 looking-at comment-line-start-skip "\n" comment-line-start " " indent-tabs-mode "\n " insert-char fortran-numerical-continuation-char 1 "\n " fortran-continuation-string fortran-indent-line] 3 (#$ . 18429) nil]) #@180 Return a digit for tab-digit style of continuation lines. If, previous line is a tab-digit continuation line, returns that digit plus one. Otherwise return 1. Zero not allowed. (defalias 'fortran-numerical-continuation-char #[nil "ŠÀyˆÁÂ!ƒ`Ã\\fÄZŦÆ\\‚Æ)‡" [-1 looking-at " [1-9]" 1 48 9 49] 2 (#$ . 18830)]) #@159 Delete all characters in CHARS around point. CHARS is like the inside of a [...] in a regular expression except that ] is never special and quotes ^, - or . (defalias 'delete-horizontal-regexp #[(chars) "Áxˆ`Áwˆ`|‡" [chars nil] 3 (#$ . 19152) "*s"]) #@130 Self insert, but if part of a Fortran line number indent it automatically. Auto-indent does not happen if a numeric arg is used. (defalias 'fortran-electric-line-number #[(arg) "„ „ƒÂÃ!!‡ÂÄ!‡iÅUƒ'ŠÆyˆÇÈ!)„f ƒ1\n‚3 iUƒQŠÆyˆÇÌ!)ƒQ Î=„Q Ï=ƒfŠÐÑŠÆyˆ`)Ò#)„fÇÓ!ƒlÂÃ!!‡ÔÕxˆcˆÎ ‡" [arg fortran-electric-line-number self-insert-command prefix-numeric-value 1 5 0 looking-at " " indent-tabs-mode fortran-minimum-statement-indent-tab fortran-minimum-statement-indent-fixed " " last-command fortran-indent-line fortran-indent-new-line re-search-backward "[^ 0-9]" t "[0-9]" " " nil last-command-char] 4 (#$ . 19412) "P"]) #@65 Moves point to the beginning of the current Fortran subprogram. (defalias 'beginning-of-fortran-subprogram #[nil "ÀÂyˆÃÄÅÆ#ˆÇÄ!…Èy)‡" [t case-fold-search -2 re-search-backward "^[ 0-9]*end\\b[ ]*[^ =(a-z]" nil move looking-at 1] 4 (#$ . 20061) nil]) #@59 Moves point to the end of the current Fortran subprogram. (defalias 'end-of-fortran-subprogram #[nil "ÀÂyˆÃÄÅÆ#ˆÇ”bˆÂy)‡" [t case-fold-search 1 re-search-forward "^[ 0-9]*end\\b[ ]*[^ =(a-z]" nil move 0] 4 (#$ . 20323) nil]) #@83 Put mark at end of Fortran subprogram, point at beginning. The marks are pushed. (defalias 'mark-fortran-subprogram #[nil "À ˆÁ`!ˆÂ ‡" [end-of-fortran-subprogram push-mark beginning-of-fortran-subprogram] 2 (#$ . 20558) nil]) #@180 Moves point to beginning of the previous Fortran statement. Returns `first-statement' if that statement is the first non-comment Fortran statement in the file, and nil otherwise. (defalias 'fortran-previous-statement #[nil "À‰ÃyˆÄ !?…\"ÄÆÇ!P!†\"ÄÉ!†\"ÄÊ!ËyÃU‰ƒMÄ !„#ÄÌ!„#ÄÉ!„#ÄÊ!„#ÄÆ P!„# ƒ[\n„[ÎÏ!‚j ƒdÐ ‚j\n?…jÑ*‡" [nil continue-test not-first-statement 0 looking-at comment-line-start-skip "[ ]*" regexp-quote fortran-continuation-string " [^ 0\n]" " [1-9]" -1 "[ ]*$" comment-start-skip message "Incomplete continuation statement." fortran-previous-statement first-statement] 4 (#$ . 20792) nil]) #@174 Moves point to beginning of the next Fortran statement. Returns `last-statement' if that statement is the last non-comment Fortran statement in the file, and nil otherwise. (defalias 'fortran-next-statement #[nil "ÀÂyˆÃyÂU…m?‰ƒ4Ä !„ÄÆ!„ÄÇ!„ÄÈ!„ÄÉ\nP!„ ?…:Ë)‡" [nil not-last-statement 0 1 looking-at comment-line-start-skip "[ ]*$" " [^ 0\n]" " [1-9]" "[ ]*" comment-start-skip last-statement] 3 (#$ . 21428) nil]) (defalias 'fortran-blink-matching-if #[nil "À Á`ÁŠÆyˆÇÁwˆÈÉ!)…OÊ ‰„$Ë‚;\f Wƒ;Š\fbˆÆyˆÌ`Áˆ`{P)\nƒFÂÍ\n\"‚O\fbˆÎÏ!ˆ b,‡" [window-start nil message endif-point matching-if top-of-window 0 " 0-9" looking-at "end[ ]*if\\b" fortran-beginning-if "No matching if." "Matches " "%s" sit-for 1] 4]) (defalias 'fortran-blink-matching-do #[nil "À Á`ÁŠÆyˆÇÁwˆÈÉ!)…OÊ ‰„$Ë‚;\f Wƒ;Š\fbˆÆyˆÌ`Áˆ`{P)\nƒFÂÍ\n\"‚O\fbˆÎÏ!ˆ b,‡" [window-start nil message enddo-point matching-do top-of-window 0 " 0-9" looking-at "end[ ]*do\\b" fortran-beginning-do "No matching do." "Matches " "%s" sit-for 1] 4]) #@99 Put mark at end of Fortran DO [WHILE]-ENDDO construct, point at beginning. The marks are pushed. (defalias 'fortran-mark-do #[nil "À‰à ‰… Ä ‰„ÅÆ!‚ \nbˆÇ ˆ b*‡" [nil do-point enddo-point fortran-end-do fortran-beginning-do message "No matching do." push-mark] 2 (#$ . 22479) nil]) (defalias 'fortran-end-do #[nil "ŠÀyˆÁÂwˆÃÄ!)ƒÀ”‡ŠÅÀU„NÇ È=„NÃÉ!„NÁÂwˆÃÄ!ƒ>ÅZ‰‚ÃÊ!ƒÅ\\‰‚ÀU…V`*‡" [0 " 0-9" nil looking-at "end[ ]*do\\b" 1 count fortran-next-statement last-statement "^[ 0-9]*end\\b[ ]*[^ =(a-z]" "do[ ]+[^0-9]"] 3]) (defalias 'fortran-beginning-do #[nil "ŠÀyˆÁÂwˆÃÄ!)ƒÀ”‡ŠÅÀU„NÇ È=„NÃÉ!„NÁÂwˆÃÊ!ƒ>ÅZ‰‚ÃË!ƒÅ\\‰‚ÀU…V`*‡" [0 " 0-9" nil looking-at "do[ ]+" 1 count fortran-previous-statement first-statement "^[ 0-9]*end\\b[ ]*[^ =(a-z]" "do[ ]+[^0-9]" "end[ ]*do\\b"] 3]) #@90 Put mark at end of Fortran IF-ENDIF construct, point at beginning. The marks are pushed. (defalias 'fortran-mark-if #[nil "À‰à ‰… Ä ‰„ÅÆ!‚ \nbˆÇ ˆ b*‡" [nil if-point endif-point fortran-end-if fortran-beginning-if message "No matching if." push-mark] 2 (#$ . 23327) nil]) (defalias 'fortran-end-if #[nil "ŠÀyˆÁÂwˆÃÄ!)ƒÀ”‡ŠÅÀU„zÇ È=„zÃÉ!„zÁÂwˆÃÄ!ƒ>ÅZ‰‚ÃÊ!ƒŠÃË!„pÂ\fÅyÀUƒjÃÍ!„aÃÎ!ƒjÃÏ!‰\fƒN\f)ƒvÅ\\)‚ÀU…‚`*‡" [0 " 0-9" nil looking-at "end[ ]*if\\b" 1 count fortran-next-statement last-statement "^[ 0-9]*end\\b[ ]*[^ =(a-z]" "if[ ]*(" ".*)[ ]*then\\b[ ]*[^ (=a-z0-9]" then-test " [^ 0\n]" " [1-9]" ".*then\\b[ ]*[^ (=a-z0-9]"] 3]) (defalias 'fortran-beginning-if #[nil "ŠÀ Á=„  ˆÃÄwˆÅÆ!…DÇ ÉŽÅÊ!†CÄ ÌyÍUƒ@ÅÎ!„7ÅÏ!ƒ@ÅÐ!‰ ƒ$ )*)ƒKÍ”‡ŠÌÍU„³À Á=„³ÅÒ!„³ÃÄwˆÅÆ!ƒ£ŠÅÊ!„™Ä ÌyÍUƒ“ÅÎ!„ŠÅÏ!ƒ“ÅÐ!‰ ƒw )ƒŸÌZ)‚OÅÓ!ƒOÌ\\‰‚QÍU…»`*‡" [fortran-previous-statement first-statement fortran-next-statement " 0-9" nil looking-at "if[ ]*(" match-data match-data ((store-match-data match-data)) ".*)[ ]*then\\b[ ]*[^ (=a-z0-9]" then-test 1 0 " [^ 0\n]" " [1-9]" ".*then\\b[ ]*[^ (=a-z0-9]" count "^[ 0-9]*end\\b[ ]*[^ =(a-z]" "end[ ]*if\\b"] 3]) #@75 Indents current Fortran line based on its contents and on previous lines. (defalias 'fortran-indent-line #[nil "À ŠÂyˆ à UƒÄÅ`Æ\\Ç#ƒ$È „$É !ˆ‚6ÂyˆÊ !„6Ì ƒ6Í ˆ)i WƒAÎ !ˆƒZŠÐˆi)VƒZŠÐˆÒ ˆ)…dÓ ˆÔ )‡" [calculate-fortran-indent cfi 0 fortran-current-line-indentation re-search-forward "^[ ]*[0-9]+" 4 t fortran-line-number-indented-correctly-p fortran-indent-to-column looking-at comment-line-start-skip fortran-find-comment-start-skip fortran-indent-comment move-to-column auto-fill-function nil fill-column fortran-fill fortran-blink-matching-if fortran-blink-matching-do] 4 (#$ . 24571) nil]) #@141 Reindent the current Fortran line, insert a newline and indent the newline. An abbrev before point is expanded if `abbrev-mode' is non-nil. (defalias 'fortran-indent-new-line #[nil "ƒÁ ˆŠÂyˆÃÄwˆÅÆ!„*ÅÇ!„*ÅÈ!„*ÅÉ\n!!ƒ-Ë ˆ)Ì ˆË ‡" [abbrev-mode expand-abbrev 0 " " nil looking-at "[0-9]" "end" "else" regexp-quote fortran-continuation-string fortran-indent-line newline] 3 (#$ . 25190) nil]) #@63 Properly indents the Fortran subprogram which contains point. (defalias 'fortran-indent-subprogram #[nil "ŠÀ ˆÁÂ!ˆÃ`Ä Å#ˆ)ÁÆ!‡" [mark-fortran-subprogram message "Indenting subprogram..." indent-region mark nil "Indenting subprogram...done."] 4 (#$ . 25594) nil]) #@63 Calculates the Fortran indent column based on previous lines. (defalias 'calculate-fortran-indent #[nil "À‰Á\nƒ ‚\f\fŠÉ ‰ƒ\" ‚ú`eUƒ. ‚2Ê ËÀwˆÌÍ!ƒqÌÎ!„gÀÐyÑUƒaÌÒ!„XÌÓ!ƒaÌÔ!‰ƒE)ƒú\\‚úÌÖ!ƒ\\‚úÌ×!ƒ‘\\‚úÌØ!ƒ¡\\‚úÌÙ!ƒ±\\‚úÌÚ!ƒÁ\\‚úÌÛ!ƒÑ\\‚úÌÜ!ƒá\\‚úÌÞ!ƒñ\\‚úÌà!ƒú )ŠÑyˆÌá!„8Ì\"!ƒ/#ä=ƒ%\\‚*#æ=ƒ* %\\Ñ‚8Ìçè)!P!„FÌÒ!„FÌÓ!ƒP*\\‚8Ìë!ƒ^ÑÑ‚8„8,ƒ}Ìí!ƒ}î ƒ}Z‚8ËÀwˆÌï!ƒ‘Z‚8ÌÖ!ƒ¡Z‚8ÌØ!ƒ±Z‚8ÌÙ!ƒÁZ‚8ÌÚ!ƒÑZ‚8Ìð!ƒáZ‚8Ìñ!ƒöî ƒöZ‚8Ìò!ƒZ‚8Ìó!ƒZ‚8Ìô!ƒ&Z‚8Ìà!ƒ8 U„8õö \"ˆ) ],‡" [nil t indent-tabs-mode fortran-minimum-statement-indent-tab fortran-minimum-statement-indent-fixed fortran-minimum-statement-indent case-fold-search first-statement icol fortran-previous-statement fortran-current-line-indentation " 0-9" looking-at "if[ ]*(" ".*)[ ]*then\\b[ ]*[^ _$(=a-z0-9]" then-test 1 0 " [^ 0\n]" " [1-9]" ".*then\\b[ ]*[^ _$(=a-z0-9]" fortran-if-indent "\\(else\\|elseif\\)\\b" "select[ ]*case[ ](.*)\\b" "case[ ]*(.*)[ ]*\n" "case[ ]*default\\b" "\\(otherwise\\|else[ ]*where\\)\\b" "where[ ]*(.*)[ ]*\n" "do\\b" fortran-do-indent "\\(structure\\|union\\|map\\|interface\\)\\b[ ]*[^ =(a-z]" fortran-structure-indent "end\\b[ ]*[^ =(a-z]" "[ ]*$" comment-line-start-skip fortran-comment-indent-style relative fortran-comment-line-extra-indent fixed "[ ]*" regexp-quote fortran-continuation-string fortran-continuation-indent "[ ]*#" fortran-check-all-num-for-matching-do "[ ]*[0-9]+" fortran-check-for-matching-do "end[ ]*if\\b" "end[ ]*where\\b" "continue\\b" "end[ ]*do\\b" "end[ ]*\\(structure\\|union\\|map\\|interface\\)\\b[ ]*[^ =(a-z]" "end[ ]*select\\b[ ]*[^ =(a-z]" message "Warning: `end' not in column %d. Probably an unclosed block."] 5 (#$ . 25863)]) #@309 Indentation of current line, ignoring Fortran line number or continuation. This is the column position of the first non-whitespace character aside from the line number and/or column 5/8 line-continuation character. For comment lines, returns indentation of the first non-indentation text within the comment. (defalias 'fortran-current-line-indentation #[nil "ŠÀyˆÁ\n!ƒ À•bˆ ;ƒ ‚Ä !Åwˆ‚7ÁÆ!„,ÁÇ!ƒ3À•bˆ‚7ÈÅwˆÉÅwˆi)‡" [0 looking-at comment-line-start-skip fortran-comment-indent-char char-to-string nil " [^ 0\n]" " [1-9]" "[ 0-9]" " "] 2 (#$ . 27794)]) #@512 Indents current line with spaces to column COL. notes: 1) A non-zero/non-blank character in column 5 indicates a continuation line, and this continuation character is retained on indentation; 2) If `fortran-continuation-string' is the first non-whitespace character, this is a continuation line; 3) A non-continuation line which has a number as the first non-whitespace character is a numbered line. 4) A TAB followed by a digit indicates a continuation line. (defalias 'fortran-indent-to-column #[(col) "ŠÀyˆÁ\n!ƒ2 …ö\f;ƒ\fÀH‚\fÀ•bˆÆÇÈ !P!ˆÉ \niZ\")‚öÁË!ƒR\fƒDÀ•bˆ‚ÓÍÎ!ˆÏcˆcˆ‚ÓÁÑ!ƒs\fƒmÍÒ!ˆÓcˆÉÔ Õ\"ˆ‚ÓÒuˆ‚ÓÖ ˆm„ÓÁ×!!ƒ¬\fƒ£\fƒ’‚”jˆÍÕ!ˆÉÔ Õ\"ˆ‚ÓÚjˆÕuˆ‚ÓÁÛ!ƒÓÚÀ•`ZZ‰ÀWƒÇÝÞ!ˆ‚Î^jˆ)àáwˆÖ ˆ\njˆ\"…öã …öÀ”bˆiä U?…öÖ ˆä j)‡" [0 looking-at comment-line-start-skip fortran-comment-indent-style fortran-comment-indent-char char delete-horizontal-regexp " " char-to-string insert-char col " [1-9]" indent-tabs-mode delete-char 2 " " fortran-continuation-string " [^ 0\n]" 6 " " fortran-numerical-continuation-char 1 delete-horizontal-space regexp-quote fortran-minimum-statement-indent-tab fortran-minimum-statement-indent-fixed 5 "[0-9]+" extra-space message "Warning: line number exceeds 5-digit limit." fortran-line-number-indent "0-9" nil comment-start-skip fortran-find-comment-start-skip fortran-comment-hook] 5 (#$ . 28367)]) #@103 Return t if current line's line number is correctly indented. Do not call if there is no line number. (defalias 'fortran-line-number-indented-correctly-p #[nil "ŠÀyˆÁÂwˆi X…i U†ÄÂwˆiÅU)‡" [0 " " nil fortran-line-number-indent "0-9" 5] 2 (#$ . 29807)]) #@99 When called from a numbered statement, returns t if matching DO is found. Otherwise return a nil. (defalias 'fortran-check-for-matching-do #[nil "ÀÁŠÄyˆÅÆ!…6ÇÀwˆÈÀwˆ`ÉÀwˆ`{ÄyˆÊËÌ ÍÎ Ï°ÀÁ#…6ÅÐ P!+‡" [nil t case-fold-search charnum 0 looking-at "[ ]*[0-9]+" " " "0" "0-9" re-search-backward "\\(^[ 0-9]*end\\b[ ]*[^ =(a-z]\\)\\|" "\\(^[ 0-9]*do[ ]*0*" "\\b\\)\\|" "\\(^[ ]*0*" "\\b\\)" "^[ 0-9]*do[ ]*0*"] 8 (#$ . 30070)]) #@110 Move to past `comment-start-skip' found on current line. Return t if `comment-start-skip' found, nil if not. (defalias 'fortran-find-comment-start-skip #[nil "ŠÀ ŠÂˆ`)Ã#)…<ĔĕÇÄ”!ƒ'Š bˆÈ )‚;bˆÀ ŠÂˆ`)Ã#ˆÄ•bˆÃ*‡" [re-search-forward comment-start-skip nil t 0 save-match-end save-match-beginning fortran-is-in-string-p fortran-find-comment-start-skip] 4 (#$ . 30514) nil]) (defalias 'fortran-match-!-comment #[(limit) "ÀÂÃ\fÅ#‰ƒÆ`!„ ??…%Ç`SÀˆ`\f^D!ˆÅ)‡" [nil found search-forward "!" limit t fortran-is-in-string-p store-match-data] 4]) #@81 Return non-nil if POS (a buffer position) is inside a Fortran string, nil else. (defalias 'fortran-is-in-string-p #[(where) "Šbˆnƒ\fÁ‚ÙŠÂyˆÃ\f!)ƒÁ‚ÙÅ…%Ç!ÈÁ‰ \n \f Î ˆÏ ˆ ƒÔÃ\f!„\\l„\\Ð 8„nƒnÑh!šƒnÒyÂV„gmƒ8Á‰ ‚:nƒvÓÁwˆiÔUƒ‚Òuˆ‚”iÔWƒ”Ñg!šƒ”ÒuˆŠÁˆ`)  ^\nƒ¹ŠÖ\f È#ƒ¸`\n^\n)`WƒÍ×`\nÁ‰ % ‚8Á‰ „=Ð 8-)‡" [where nil 0 looking-at comment-line-start-skip (0 nil nil nil nil nil 0) comment-start regexp-quote t end-of-line parse-limit not-done quoted-comment-start parse-state fortran-next-statement fortran-previous-statement 3 char-to-string 1 " 0-9" 5 fortran-continuation-string re-search-forward parse-partial-sexp] 7 (#$ . 31073)]) #@227 Toggle fortran-auto-fill mode. With ARG, turn `fortran-auto-fill' mode on iff ARG is positive. In `fortran-auto-fill' mode, inserting a space at a column beyond `fill-column' automatically breaks the line at a previous space. (defalias 'fortran-auto-fill-mode #[(arg) "„ ?‚Â!ÃV…ĉÅ ˆ‡" [arg auto-fill-function prefix-numeric-value 0 fortran-do-auto-fill force-mode-line-update] 2 (#$ . 31769) "P"]) (defalias 'fortran-do-auto-fill #[nil "iV…Á ‡" [fill-column fortran-indent-line] 2]) (defalias 'fortran-fill #[nil "`ŠÁyˆ`)ŠÃˆ`)‰\nÅ \\^Š\nbˆÇ!?…FÉ\n!ˆË`!ƒEŠÌÍ\nÎ#ˆƒ?`‚A`T)‚FÃ)‰†ŠÉ\nT!ˆÑÃxˆ`TXƒqÉ\nT!ˆÒÓ\fÎ#„q\nbˆnƒ~ÒÔÎ#ˆ‚‘ÕuˆÇÖ!ƒ×uˆ‚‘ØÃxˆƒš`‚œ`T)ŠÌ\nÎ#…¹Ë`!?…¹ÛÃxˆi\nTW)†ÄŠbˆn)?…÷Šbˆi)\nTVƒßbˆÜ ‚÷ŠŠbˆi)Ý \\V…öbˆÜ ).‡" [opoint 0 bol nil eol fortran-current-line-indentation bos looking-at comment-line-start-skip move-to-column fill-column fortran-is-in-string-p re-search-backward "[^']'[^']" t fortran-break-before-delimiters quote "^ \n,'+-/*=)" re-search-forward "[ \n,'+-/*)=]" "[ ]" -1 "'" 1 " *" fill-point comment-start-skip " " fortran-break-line calculate-fortran-indent fortran-continuation-indent] 5 nil nil]) (defalias 'fortran-break-line #[nil "`ŠÀyˆ`)ŠÁˆ`)ÁŠƒ,Ç ƒ,È\fÉ#ˆ` {` |ˆ)ŠÊyˆËÌ!†:ËÍ!)ƒOÁˆ`À•|ˆÎ ˆÏ ˆ‚RÐ ˆ\n…gŠ\fbˆÁˆÎ ˆÑ jˆ\nc),‡" [0 nil comment-string eol bol opoint comment-start-skip fortran-find-comment-start-skip re-search-backward t 1 looking-at " [^ 0\n]" " [1-9]" delete-horizontal-space fortran-fill fortran-split-line fortran-comment-hook] 4]) #@208 Returns nil if fixed format is used, t if TAB formatting is used. Use `fortran-tab-mode-default' if no non-comment statements are found in the file before the end or the first `fortran-analyze-depth' lines. (defalias 'fortran-analyze-file-format #[nil "ÀŠebˆÀm„'ÂÃ!„'ÂÄ!„' V„'Æyˆ T‚ÂÃ!ƒ1Ç‚EÂÄ!ƒ;Æ‚EƒDÇ‚EÆ*‡" [0 i looking-at " " " " fortran-analyze-depth nil t fortran-tab-mode-default] 2 (#$ . 33351)]) (byte-code "À ž„\n BÃÄ!‡" [fortran-tab-mode-string minor-mode-alist (fortran-tab-mode-string (indent-tabs-mode fortran-tab-mode-string)) provide fortran] 2) emacs-19.30/lisp/frame.elc100666 13437 1 40443 5770240300 14012 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hill.gnu.ai.mit.edu on Fri Jun 16 04:28:28 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/frame.el ;;; emacs version 19.28.94.4. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`frame.el' was compiled for Emacs 19.29 or later")) #@202 Window-system dependent function to call to create a new frame. The window system startup file should set this to its frame creation function, which should take an alist of parameters as its argument. (defvar frame-creation-function nil (#$ . 474)) #@1056 Alist of frame parameters for creating the initial X window frame. You can set this in your `.emacs' file; for example, (setq initial-frame-alist '((top . 1) (left . 1) (width . 80) (height . 55))) Parameters specified here supersede the values given in `default-frame-alist'. If the value calls for a frame without a minibuffer, and you have not created a minibuffer frame on your own, one is created according to `minibuffer-frame-alist'. You can specify geometry-related options for just the initial frame by setting this variable in your `.emacs' file; however, they won't take effect until Emacs reads `.emacs', which happens after first creating the frame. If you want the frame to have the proper geometry as soon as it appears, you need to use this three-step process: * Specify X resources to give the geometry you want. * Set `default-frame-alist' to override these options so that they don't affect subsequent frames. * Set `initial-frame-alist' in a way that matches the X resources, to override what you put in `default-frame-alist'. (defvar initial-frame-alist (quote ((minibuffer . t))) (#$ . 731)) #@286 Alist of frame parameters for initially creating a minibuffer frame. You can set this in your `.emacs' file; for example, (setq minibuffer-frame-alist '((top . 1) (left . 1) (width . 80) (height . 2))) Parameters specified here supersede the values given in `default-frame-alist'. (defvar minibuffer-frame-alist (quote ((width . 80) (height . 2))) (#$ . 1860)) #@293 Alist of frame parameters used when creating pop-up frames. Pop-up frames are used for completions, help, and the like. This variable can be set in your init file, like this: (setq pop-up-frame-alist '((width . 80) (height . 20))) These supersede the values given in `default-frame-alist'. (defvar pop-up-frame-alist nil (#$ . 2232)) (byte-code "À‡" [#[nil "À !‡" [make-frame pop-up-frame-alist] 2] pop-up-frame-function nil] 1) #@425 *Alist of frame parameters used when creating special frames. Special frames are used for buffers whose names are in `special-display-buffer-names' and for buffers whose names match one of the regular expressions in `special-display-regexps'. This variable can be set in your init file, like this: (setq special-display-frame-alist '((width . 80) (height . 20))) These supersede the values given in `default-frame-alist'. (defvar special-display-frame-alist (quote ((height . 14) (width . 80) (unsplittable . t))) (#$ . -2672)) (defalias 'special-display-popup-frame #[(buffer &optional args) "ƒ@9ƒÁ@\nA#‡Ã\nÄ\"‰ƒ/Æ !È!ˆÉ!ˆ )‚MÊË\f\"!ÍÎ!\n\"ˆÏÎ!Ä\"ˆÎ!))‡" [args apply buffer get-buffer-window t window window-frame frame make-frame-visible raise-frame make-frame append special-display-frame-alist set-window-buffer frame-selected-window set-window-dedicated-p] 5]) (defalias 'handle-delete-frame #[(event) "‰A@)‰@)Âà \fƒ.Ç\f@!ƒ'\f@=„' T\fA‰„ ÂVƒ<ÈÉ\"‚>Ê +‡" [event position 0 frame-list tail i frame frame-visible-p delete-frame t kill-emacs] 4 nil "e"]) (byte-code "ÀÁ!„ÂÁ BÄ BÀÅ!„ÂÅ B‡" [boundp frame-initial-frame nil current-load-list frame-initial-frame-alist frame-initial-geometry-arguments] 2) (defalias 'frame-initialize #[nil "ƒK „KÂÄ Æ \"„CÇ \"\nË\nž„'Ì\nB\nÍ\nž„4Î\nB\nÏ!‰Ò!Ó !ˆÔ‰‡ÕÖ!ƒUÖ‚V׉‡" [window-system noninteractive special-display-popup-frame special-display-function delq terminal-frame minibuffer-frame-list append initial-frame-alist default-frame-alist frame-initial-frame-alist vertical-scroll-bars (vertical-scroll-bars . t) horizontal-scroll-bars (horizontal-scroll-bars . t) make-frame frame-initial-frame default-minibuffer-frame frame-remove-geometry-params delete-frame nil fboundp make-terminal-frame #[(parameters) "ÀÁ!‡" [error "Can't create multiple frames without a window system"] 2] frame-creation-function] 3]) (defalias 'frame-notice-user-settings #[nil "ÀÁ!ƒ& ž‰ƒ\fAÅ=?‚% ƒ Æ‚!ÅB B)pÈ !ƒÅÊ ž†>Ê ž†>ÌAÍ=„ΉÑÒ !žA„[ÓÆ!ˆ‚JÒ !Ôž„rÖÔž\"× Î$ØÖÙž\"BÚžƒ–ÜÚ\"Ýžƒ¤ÜÝ\"Þžƒ²ÜÞ\"ßžƒÀÜß\"à×á#!Ö â \"„ØãÎ!ˆäå!‰&„é' =ƒ äè!†ñâ @)ê)!+' =ƒ)'ìí&\"ˆ*)î \"ˆï Í\"ˆ*‚ÅΉ‰012× \"1Úžƒ=ÜÚ1\"1ÝžƒKÜÝ1\"1ÞžƒYÜÞ1\"1ßžƒgÜß1\"11‰0ƒ¬Ή340@@ž30@@1žA43ƒ–3A4=„¢0@@4B2B2*0A‰0„o2Ÿ2õ 2\"ˆö2žƒÄ÷ !ˆ+qˆÎ‰ )‡" [boundp menu-bar-mode menu-bar-lines default-frame-alist default 0 1 old-buffer frame-live-p frame-initial-frame minibuffer initial-frame-alist (minibuffer . t) t nil new parms visibility frame-parameters sleep-for name frame-initial-frame-alist delq append (reverse) reverse height frame-initial-geometry-arguments frame-delete-all width left top make-frame ((user-size . t) (user-position . t)) minibuffer-frame-list make-initial-minibuffer-frame filtered-frame-list #[(frame) " =?…ÂÃ!! =‡" [frame frame-initial-frame window-frame minibuffer-window] 3] users-of-initial default-minibuffer-frame #[(frame) "ÀÁ\n!žAÃ=‡" [minibuffer frame-parameters frame only] 3] new-surrogate minibuffer-window new-minibuffer mapcar #[(frame) "À  BC\"‡" [modify-frame-parameters frame minibuffer new-minibuffer] 4] redirect-frame-focus delete-frame tail allparms newparms oldval newval modify-frame-parameters font frame-update-faces] 6]) (defalias 'make-initial-minibuffer-frame #[(display) "À Â\"\fƒÅ\f \"‚Æ !)‡" [append minibuffer-frame-alist ((minibuffer . only)) parms display make-frame-on-display make-frame] 3]) (defalias 'frame-delete-all #[(key alist) "À !‰‰ƒ\n@@ =ƒÄ\n@ \"\nA‰„\n )‡" [copy-sequence alist tail key delq] 4]) (defalias 'get-other-frame #[nil "ÀÁ !Á šƒ  ‡ÀÁ !‡" [next-frame selected-frame make-frame] 3]) #@61 Select the next window, regardless of which frame it is on. (defalias 'next-multiframe-window #[nil "ÀÁ à ÄVÅ#!‡" [select-window next-window selected-window minibuffer-depth 0 t] 5 (#$ . 6484) nil]) #@65 Select the previous window, regardless of which frame it is on. (defalias 'previous-multiframe-window #[nil "ÀÁ à ÄVÅ#!‡" [select-window previous-window selected-window minibuffer-depth 0 t] 5 (#$ . 6690) nil]) #@113 Make a frame on display DISPLAY. The optional second argument PARAMETERS specifies additional frame parameters. (defalias 'make-frame-on-display #[(display &optional parameters) "ÀÁ B\nB!‡" [make-frame display parameters] 3 (#$ . 6909) "sMake frame on display: "]) (defalias (quote new-frame) (quote make-frame)) #@861 Create a new frame, displaying the current buffer. Optional argument PARAMETERS is an alist of parameters for the new frame. Specifically, PARAMETERS is a list of pairs, each having the form (NAME . VALUE). Here are some of the parameters allowed (not a complete list): (name . STRING) - The frame should be named STRING. (height . NUMBER) - The frame should be NUMBER text lines high. If this parameter is present, the width parameter must also be given. (width . NUMBER) - The frame should be NUMBER characters in width. If this parameter is present, the height parameter must also be given. (minibuffer . t) - the frame should have a minibuffer (minibuffer . nil) - the frame should have no minibuffer (minibuffer . only) - the frame should contain only a minibuffer (minibuffer . WINDOW) - the frame should use WINDOW as its minibuffer window. (defalias 'make-frame #[(&optional parameters) "ÀÂÃ!ˆ\f !ÂÆ!ˆ )‡" [nil nframe run-hooks before-make-frame-hook frame-creation-function parameters after-make-frame-hook] 2 (#$ . 7229) nil]) #@59 Return a list of all live frames which satisfy PREDICATE. (defalias 'filtered-frame-list #[(predicate) "À Á‰:ƒ\f @!ƒ @\nB A‰‚\n*‡" [frame-list nil good-frames frames predicate] 3 (#$ . 8286)]) #@57 Return a list of all frames with their own minibuffers. (defalias 'minibuffer-frame-list #[nil "ÀÁ!‡" [filtered-frame-list #[(frame) "ÁÂ!!=‡" [frame window-frame minibuffer-window] 4]] 2 (#$ . 8495)]) #@289 Return the parameter list PARAM-LIST, but with geometry specs removed. This deletes all bindings in PARAM-LIST for `top', `left', `width', `height', `user-size' and `user-position' parameters. Emacs uses this to avoid overriding explicit moves and resizings from the user during startup. (defalias 'frame-remove-geometry-params #[(param-list) "À B‰\nA:ƒ2\nA@:ƒ+\nA@@Ã>ƒ+\nA@\fB\n‰AA¡ˆ‚\nA‰‚)\fŸ A‡" [nil param-list tail (height width top left user-position user-size) frame-initial-geometry-arguments] 3 (#$ . 8705)]) #@206 Select the ARG'th different visible frame, and raise it. All frames are arranged in a cyclic order. This command selects the frame ARG steps away in that order. A negative ARG moves in the opposite order. (defalias 'other-frame #[(arg) "À \nÃVƒ#Ä !Å !Æ=„Ä !‚ \nS‰‚\nÃWƒCÇ !Å !Æ=„<Ç !‚-\nT‰‚$È !ˆÉ !ˆÊÀ Ë SÃ#ˆÌÍ!…\\Í )‡" [selected-frame frame arg 0 next-frame frame-visible-p t previous-frame raise-frame select-frame set-mouse-position frame-width fboundp unfocus-frame] 5 (#$ . 9242) "p"]) #@342 Return a list describing the positions and states of all frames. Its car is `frame-configuration'. Each element of the cdr is a list of the form (FRAME ALIST WINDOW-CONFIG), where FRAME is a frame object, ALIST is an association list specifying some of FRAME's parameters, and WINDOW-CONFIG is a window configuration object for FRAME. (defalias 'current-frame-configuration #[nil "ÀÁÂà \"B‡" [frame-configuration mapcar #[(frame) "Á!Â!E‡" [frame frame-parameters current-window-configuration] 4] frame-list] 4 (#$ . 9758)]) #@388 Restore the frames to the state described by CONFIGURATION. Each frame listed in CONFIGURATION has its position, size, window configuration, and other parameters set as specified in CONFIGURATION. Ordinarily, this function deletes all existing frames not listed in CONFIGURATION. But if optional second argument NODELETE is given and non-nil, the unwanted frames are iconified instead. (defalias 'set-frame-configuration #[(configuration &optional nodelete) "À !„ ÂÃÀ D\"ˆ AÄÇÈÉ \"ˆ\nƒ%ÇË \"‚)ÇÌ \"*‡" [frame-configuration-p configuration signal wrong-type-argument nil frames-to-delete config-alist mapcar #[(frame) " ž‰ƒ)Ã\nA@Å\fž‰ƒÇ\f\"\f*\"ˆÈÉ\n8!‚0\nB‰\n)‡" [frame config-alist parameters modify-frame-parameters parms minibuffer mini delq set-window-configuration 2 frames-to-delete] 6] frame-list nodelete iconify-frame delete-frame] 4 (#$ . 10298)]) #@116 Return number of lines available for display on FRAME. If FRAME is omitted, describe the currently selected frame. (defalias 'frame-height #[(&optional frame) "ÀÁ\n!žA‡" [height frame-parameters frame] 3 (#$ . 11187)]) #@118 Return number of columns available for display on FRAME. If FRAME is omitted, describe the currently selected frame. (defalias 'frame-width #[(&optional frame) "ÀÁ\n!žA‡" [width frame-parameters frame] 3 (#$ . 11413)]) #@112 Set the font of the selected frame to FONT. When called interactively, prompt for the name of the font to use. (defalias 'set-default-font #[(font-name) "ÀÁ  BC\"ˆÄÁ !‡" [modify-frame-parameters selected-frame font font-name frame-update-faces] 4 (#$ . 11639) "sFont name: "]) #@126 Set the background color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use. (defalias 'set-background-color #[(color-name) "ÀÁ  BC\"ˆÄÁ !‡" [modify-frame-parameters selected-frame background-color color-name frame-update-face-colors] 4 (#$ . 11924) "sColor: "]) #@126 Set the foreground color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use. (defalias 'set-foreground-color #[(color-name) "ÀÁ  BC\"ˆÄÁ !‡" [modify-frame-parameters selected-frame foreground-color color-name frame-update-face-colors] 4 (#$ . 12243) "sColor: "]) #@127 Set the text cursor color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use. (defalias 'set-cursor-color #[(color-name) "ÀÁ  BC\"‡" [modify-frame-parameters selected-frame cursor-color color-name] 4 (#$ . 12562) "sColor: "]) #@136 Set the color of the mouse pointer of the selected frame to COLOR. When called interactively, prompt for the name of the color to use. (defalias 'set-mouse-color #[(color-name) "ÀÁ  BC\"‡" [modify-frame-parameters selected-frame mouse-color color-name] 4 (#$ . 12844) "sColor: "]) #@129 Set the color of the border of the selected frame to COLOR. When called interactively, prompt for the name of the color to use. (defalias 'set-border-color #[(color-name) "ÀÁ  BC\"‡" [modify-frame-parameters selected-frame border-color color-name] 4 (#$ . 13133) "sColor: "]) #@393 Toggle whether or not the selected frame should auto-raise. With arg, turn auto-raise mode on if and only if arg is positive. Note that this controls Emacs's own auto-raise feature. Some window managers allow you to enable auto-raise for certain windows. You can use that for Emacs windows if you wish, but if you do, that is beyond the control of Emacs and this command has no effect on it. (defalias 'auto-raise-mode #[(arg) "„ÁÂà !žAƒÄ‚ÅÆà ÁÇVBC\"‡" [arg auto-raise frame-parameters selected-frame -1 1 modify-frame-parameters 0] 5 (#$ . 13417) "P"]) #@393 Toggle whether or not the selected frame should auto-lower. With arg, turn auto-lower mode on if and only if arg is positive. Note that this controls Emacs's own auto-lower feature. Some window managers allow you to enable auto-lower for certain windows. You can use that for Emacs windows if you wish, but if you do, that is beyond the control of Emacs and this command has no effect on it. (defalias 'auto-lower-mode #[(arg) "„ÁÂà !žAƒÄ‚ÅÆà ÁÇVBC\"‡" [arg auto-lower frame-parameters selected-frame -1 1 modify-frame-parameters 0] 5 (#$ . 13987) "P"]) #@139 Toggle whether or not the selected frame has vertical scroll bars. With arg, turn vertical scroll bars on if and only if arg is positive. (defalias 'toggle-scroll-bar #[(arg) "„ÁÂà !žAƒÄ‚ÅÆà ÁÇVBC\"‡" [arg vertical-scroll-bars frame-parameters selected-frame -1 1 modify-frame-parameters 0] 5 (#$ . 14557) "P"]) #@190 Toggle whether or not the selected frame has horizontal scroll bars. With arg, turn horizontal scroll bars on if and only if arg is positive. Horizontal scroll bars aren't implemented yet. (defalias 'toggle-horizontal-scroll-bar #[(arg) "ÀÁ!‡" [error "Horizontal scroll bars aren't implemented yet"] 2 (#$ . 14885) "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias screen-height frame-height screen-width frame-width] 3) #@327 Obsolete function to change the size of the screen to COLS columns. Optional second arg non-nil means that redisplay should use COLS columns but that the idea of the actual width of the frame should not be changed. This function is provided only for compatibility with Emacs 18; new code should use `set-frame-width instead'. (defalias 'set-screen-width #[(cols &optional pretend) "ÀÁ \n #‡" [set-frame-width selected-frame cols pretend] 4 (#$ . 15305)]) #@329 Obsolete function to change the height of the screen to LINES lines. Optional second arg non-nil means that redisplay should use LINES lines but that the idea of the actual height of the screen should not be changed. This function is provided only for compatibility with Emacs 18; new code should use `set-frame-width' instead. (defalias 'set-screen-height #[(lines &optional pretend) "ÀÁ \n #‡" [set-frame-height selected-frame lines pretend] 4 (#$ . 15767)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [make-obsolete screen-height frame-height screen-width frame-width set-screen-width set-frame-width set-screen-height set-frame-height] 3) #@28 Keymap for frame commands. (defvar ctl-x-5-map (make-sparse-keymap) (#$ . 16411)) (byte-code "ÀÁ\n\"ˆÃ\fÅÁ#ˆÃ\nÆÇ#ˆÃ\nÈÉ#ˆÃ\nÊË#ˆÌÍ!‡" [defalias ctl-x-5-prefix ctl-x-5-map define-key ctl-x-map "5" "2" make-frame "0" delete-frame "o" other-frame provide frame] 4) emacs-19.30/lisp/gnus-cache.elc100666 23053 1 15642 6046561265 15141 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:29:14 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/gnus-cache.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus-cache.el' was compiled for Emacs 19.29 or later")) (require (quote gnus)) #@54 *The directory where cached articles will be stored. (defvar gnus-cache-directory (concat gnus-article-save-directory "cache/") (#$ . -508)) #@47 *Classes of articles to enter into the cache. (defvar gnus-cache-enter-articles (quote (ticked dormant)) (#$ . -655)) #@48 *Classes of articles to remove from the cache. (defvar gnus-cache-remove-articles (quote (read)) (#$ . -779)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-cache-buffer nil current-load-list] 2) (defalias 'gnus-cache-change-buffer #[(group) "ƒ @˜„ ˆ†8Š ÃÄ!qBÅp!ˆÆ ˆÇ È\" Ê !ƒ3Ë !ˆ)ÌÍ!)‡" [gnus-cache-buffer group gnus-cache-save-buffers get-buffer-create " *gnus-cache-overview*" buffer-disable-undo erase-buffer gnus-cache-file-name ".overview" file file-exists-p insert-file-contents set-buffer-modified-p nil] 3]) (defalias 'gnus-cache-save-buffers #[nil "…ZAÁ@Â\"Å\f!ƒ?Š\fqˆÆ ÇVƒ/ÈÉ !!ˆÊed ËÌ%ˆ‚>Í !ƒ9Î !ˆËÏЈ)\fƒV\f;ƒLÑ‚MÒ\f!ƒVÓ\f!ˆË‰*‡" [gnus-cache-buffer gnus-cache-file-name ".overview" overview-file buffer buffer-modified-p buffer-size 0 gnus-make-directory file-name-directory write-region nil quietly file-exists-p delete-file (byte-code "ÀÁ\n!!‡" [delete-directory file-name-directory overview-file] 3) ((error)) get-buffer buffer-name kill-buffer] 6]) (defalias 'gnus-cache-member-of-class #[(class ticked dormant unread) "ƒ\nÀ >†&\nƒ >†& ƒà >†& ?…&Ä >‡" [ticked class dormant unread read] 2]) (defalias 'gnus-cache-file-name #[(group article) "À !ÂÃ!ƒ \f‚$\fÅPÆÇ\f\"ƒ\fÈ”ÉIˆÊ\fËÉ#)Ì ;ƒ0 ‚4Î !R‡" [file-name-as-directory gnus-cache-directory gnus-use-long-file-name not-cache group "" string-match ":" 0 47 gnus-replace-chars-in-string 46 "/" article int-to-string] 5]) (defalias 'gnus-cache-possibly-enter-article #[(group article headers ticked dormant unread) "ÁH‰Æ!?†- ÁW†-Ç \n $?†-ÌÍ\"‰!?…ÖÌÐ\f!‰!„?Ñ !ˆÌ\f!ƒIÒ‚ÖÂÔ ˆ)ŠqˆŒ~ˆÖed\fÂ×%ˆ)Ø!ˆAqˆdbˆÚyˆÂÛ܃~Úyˆ‚qoƒm„—ÁyˆÝp! Wƒ Þyˆ‚ Áyˆ‚ ÞyˆÁyˆßàÁHÞHáHâHãHäH†»åæH†ÂåçH†ÉåèH†Ðå&\ncˆ)Ò+‡" [headers 0 nil dir file number vectorp gnus-cache-member-of-class gnus-cache-enter-articles ticked dormant unread file-exists-p gnus-cache-file-name group article file-name-directory gnus-make-directory t gnus-use-cache gnus-summary-select-article gnus-article-buffer write-region quiet gnus-cache-change-buffer gnus-cache-buffer -1 (byte-code "o?…\nÀp! V‡" [read number] 2) ((error (byte-code "Àyˆ`Áyˆ`|ˆÂ‡" [0 1 t] 2))) read 1 format "%s %s %s %s %s %s %s %s %s \n" 2 3 4 5 "" 6 7 8] 12]) (defalias 'gnus-cache-enter-remove-article #[(article) " B‰‡" [article gnus-cache-removeable-articles] 2]) (defalias 'gnus-cache-possibly-remove-article #[(article ticked dormant unread) "À \n\"Ä !?†Å $??…IŠÊ !ˆ AqˆebˆÌÍ\n!ÎP!„?ÏÐÍ\n!ÎQdÑ#…HÒyˆ`Óyˆ`|))‡" [gnus-cache-file-name gnus-newsgroup-name article file file-exists-p gnus-cache-member-of-class gnus-cache-remove-articles ticked dormant unread delete-file gnus-cache-buffer looking-at int-to-string " " search-forward "\n" t 0 1] 5]) (put (quote gnus-cache-possibly-remove-article) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'gnus-cache-possibly-remove-articles #[nil "Á\n!ÃÇ\n!ˆƒŽ@A\f >ƒ \f‰>\f >\f\n>†5\f >\f Ï\n\f\"Ñ!?†UÒ \f$??…ˆŠÔ!ˆAqˆebˆÖ×\f!ØP!„~ÙÚ×\f!ØQdÛ#…‡Üyˆ`Ýyˆ`|))ˆ,‚ +Þ ‡" [gnus-cache-removeable-articles gnus-cache-articles-in-group gnus-newsgroup-name nil article cache-articles articles gnus-cache-change-buffer gnus-newsgroup-marked gnus-newsgroup-dormant gnus-newsgroup-unreads gnus-newsgroup-unselected unread dormant ticked gnus-cache-file-name file file-exists-p gnus-cache-member-of-class gnus-cache-remove-articles delete-file gnus-cache-buffer looking-at int-to-string " " search-forward "\n" t 0 1 gnus-cache-save-buffers] 5]) (defalias 'gnus-cache-request-article #[(article group) "À \n\"Ä !…2Å ˆÆcˆÇe!‰ƒ)É@!ˆA‰„)Å ˆÊ !ˆË)‡" [gnus-cache-file-name group article file file-exists-p erase-buffer "i" overlays-at overlays delete-overlay insert-file-contents t] 4]) (defalias 'gnus-cache-articles-in-group #[(group) "ÀÁ\nÃ\"!ÄÇ!…$ÈÄÉÊ$‰…$ËÌÍ \"Î\"*‡" [file-name-directory gnus-cache-file-name group 1 nil articles dir file-exists-p directory-files "^[0-9]+$" t sort mapcar #[(name) "À !‡" [string-to-int name] 2] <] 6]) (defalias 'gnus-cache-active-articles #[(group) "À !‰…\n@Ã\n!B)‡" [gnus-cache-articles-in-group group articles gnus-last-element] 4]) (defalias 'gnus-cache-possibly-alter-active #[(group active) "À !‰ƒ\n@ @Wƒ \n@ ˆ\n…%\nA AV…% \nA¡)‡" [gnus-cache-active-articles group cache-active active] 3]) (defalias 'gnus-cache-retrieve-headers #[(articles group) "À !Ã\f\n\"Å Æ\"È È\n\f…Ë\f \" )Ì ˆŠÍ!„0 ‚] „EqˆÏ ˆÐ!ˆÑ‚] Ñ=ƒVÒ \n\"ˆ ‚]Ó \n\"ˆ -‡" [gnus-cache-articles-in-group group cached gnus-sorted-complement articles gnus-cache-file-name ".overview" cache-file nil type gnus-use-cache gnus-retrieve-headers gnus-cache-save-buffers file-exists-p nntp-server-buffer erase-buffer insert-file-contents nov gnus-cache-braid-nov gnus-cache-braid-heads] 3]) (defalias 'gnus-cache-braid-nov #[(group cached) "ÀÁ!‰Æ ˆŠ qˆÇp!ˆÈ ˆÉÊ Ì\"!ˆebˆÍcˆebˆ)qˆebˆƒ„m„HÐp!@WƒHÑyˆ‚4ÒyˆŠ qˆÓÍÔ@!ÕQÂÖ#ƒkÒyˆ`ˆ`‚mÂ)\fƒ{× \f #ˆÍcˆA‰„4Ø !+‡" [get-buffer-create " *gnus-cache*" nil end beg cache-buf gnus-cache-save-buffers buffer-disable-undo erase-buffer insert-file-contents gnus-cache-file-name group ".overview" "\n" nntp-server-buffer cached read 1 0 search-forward int-to-string " " t insert-buffer-substring kill-buffer] 5]) (defalias 'gnus-cache-braid-heads #[(group cached) "ÀÁ!Š\nqˆÃp!ˆÄ ˆ) qˆebˆƒ{m„<ÇÈ!ƒ<É”bˆÊp!@Wƒ<ËÌÍÎ#ˆ‚ÏyˆŠ\nqˆÄ ˆÐÑ@\"!ˆebˆÓÔ@!Õ±ˆËÖÍÎ#ˆ`d|ˆ×uˆØcˆ)Ù\n!ˆA‰„Ú\n!)‡" [get-buffer-create " *gnus-cache*" cache-buf buffer-disable-undo erase-buffer nntp-server-buffer cached looking-at "2.. +\\([0-9]+\\) " 1 read search-forward "\n.\n" nil move 0 insert-file-contents gnus-cache-file-name group "220 " int-to-string " Article retrieved.\n" "\n\n" -1 "." insert-buffer-substring kill-buffer] 5]) #@60 Go through all groups and put the articles into the cache. (defalias 'gnus-jog-cache #[nil "AÁÂÉ…EÉ@@!ˆ\nË=ƒ;\fƒ7ÍÉÂ\f@$ˆ\fA‰\f„%Îp!ˆA‰„Â-‡" [gnus-newsrc-alist (unread) nil t gnus-large-newsgroup gnus-expert-user gnus-mark-article-hook gnus-cache-enter-articles newsrc gnus-summary-read-group major-mode gnus-summary-mode gnus-newsgroup-unreads gnus-summary-select-article kill-buffer] 6 (#$ . 6609) nil]) (provide (quote gnus-cache)) emacs-19.30/lisp/gnus-cite.elc100666 23053 1 21331 6046561277 15015 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:29:18 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/gnus-cite.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus-cite.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÄÅÆ\"‡" [require gnus gnus-msg gnus-ems autoload gnus-article-add-button "gnus-vis"] 3) #@106 Maximum article size (in bytes) where parsing citations is allowed. Set it to nil to parse all articles. (defvar gnus-cite-parse-max-size 25000 (#$ . 596)) #@65 Regexp matching the longest possible citation prefix on a line. (defvar gnus-cite-prefix-regexp "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>" (#$ . 758)) #@48 Maximal possible length for a citation prefix. (defvar gnus-cite-max-prefix 20 (#$ . 911)) #@124 Regexp matching normal SuperCite attribution lines. The first regexp group should match a prefix added by another package. (defvar gnus-supercite-regexp (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" ">>>>> +\"\\([^\"\n]+\\)\" +==") (#$ . 1009)) #@117 Regexp matching mangled SuperCite attribution lines. The first regexp group should match the SuperCite attribution. (defvar gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +==" (#$ . 1263)) #@75 Minimal number of identical prefix'es before we believe it is a citation. (defvar gnus-cite-minimum-match-count 2 (#$ . 1466)) #@55 Regexp matching the beginning of an attribution line. (defvar gnus-cite-attribution-prefix "in article\\|in <" (#$ . 1599)) #@112 Regexp matching the end of an attribution line. The text matching the first grouping will be used as a button. (defvar gnus-cite-attribution-postfix "\\(wrote\\|writes\\|said\\|says\\):[ ]*$" (#$ . 1730)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ B‡" [boundp gnus-article-length nil current-load-list gnus-cite-prefix-alist gnus-cite-attribution-alist gnus-cite-loose-prefix-alist gnus-cite-loose-attribution-alist] 2) #@527 Highlight cited text. Each citation in the article will be highlighted with a different face. The faces are taken from `gnus-cite-face-list'. Attribution lines are highlighted with the same face as the corresponding citation merged with `gnus-cite-attribution-face'. Text is considered cited if at least `gnus-cite-minimum-match-count' lines matches `gnus-cite-prefix-regexp' with the same prefix. Lines matching `gnus-cite-attribution-postfix' and perhaps `gnus-cite-attribution-prefix' are considered attribution lines. (defalias 'gnus-article-highlight-citation #[(&optional force) "Á=ƒÂÃ\f\"‚Å=ƒÂÃ\"ŠqˆÈ !ˆÊ Ìʉ‰‰‰‰‰ ƒ¢@A@A@A†kB B ƒF@Až„wž„wÚ#ˆ‚wƒ@A@AÛ!Ü \"AÝ!ˆÞŠàˆ`)Ì#ƒëáà”à•â$ˆÚ#ˆÚ##ˆ‚¦…*@A@Û!Ú##ˆ‚.\f‡" [gnus-cite-face-list light mapcar gnus-make-face gnus-face-light-name-list dark gnus-face-dark-name-list gnus-article-buffer gnus-cite-parse-maybe force nil gnus-cite-prefix-alist t face-alist number numbers skip prefix entry face inhibit-point-motion-hooks faces alist buffer-read-only gnus-cite-attribution-alist gnus-cite-loose-attribution-alist gnus-cite-add-face gnus-cite-find-prefix assoc goto-line re-search-forward gnus-cite-attribution-postfix 1 gnus-article-add-button gnus-cite-toggle gnus-cite-attribution-face] 11 (#$ . 2189) (list (quote force))]) #@108 Hide all cited text except attribution lines. See the documentation for `gnus-article-highlight-citation'. (defalias 'gnus-article-hide-citation #[(&optional force) "ŠqˆÁ\n!ˆÃ\fÅÉ \n …P @A A ƒ@AË!ˆ\fž„'Í`Îyˆ`#ˆ‚'.‡" [gnus-article-buffer gnus-cite-parse-maybe force nil gnus-cite-prefix-alist t number numbers inhibit-point-motion-hooks alist buffer-read-only goto-line gnus-cite-attribution-alist add-text-properties 1 gnus-hidden-properties] 5 (#$ . 3657) (list (quote force))]) #@337 Hide cited text that has an attribution line. This will do nothing unless at least `gnus-cite-hide-percentage' percent and at least `gnus-cite-hide-absolute' lines of the body is cited text with attributions. When called interactively, these two variables are ignored. See also the documentation for `gnus-article-highlight-citation'. (defalias 'gnus-article-hide-citation-maybe #[(&optional force) "ŠqˆÁ\n!ˆebˆÃÄÅÆ#ˆ`ÅÆÈÅ \n \f dbˆÏÅÆ#ˆÑ`\"  ƒR\nÒ @A\"AG\\\n A‰ „:\n„k\nÔ_ _V…­\nV…­  …­Ò @A\"A  A  ƒo @\n A ×\n!ˆ\nž„„Ø`Ùyˆ`#ˆ‚„.‡" [gnus-article-buffer gnus-cite-parse-maybe force search-forward "\n\n" nil t gnus-cite-attribution-alist 0 total hiden inhibit-point-motion-hooks buffer-read-only atts start re-search-backward gnus-signature-separator count-lines assoc gnus-cite-prefix-alist 100 gnus-cite-hide-percentage gnus-cite-hide-absolute goto-line add-text-properties 1 gnus-hidden-properties] 7 (#$ . 4183) (list (quote force))]) (defalias 'gnus-cite-parse-maybe #[(&optional force) "deZ=?…+ÁÁÁÁ?…!…!È V?…+deZÉ ‡" [gnus-article-length nil gnus-cite-prefix-alist gnus-cite-attribution-alist gnus-cite-loose-prefix-alist gnus-cite-loose-attribution-alist force gnus-cite-parse-max-size buffer-size gnus-cite-parse] 3]) (defalias 'gnus-cite-parse #[nil "ebˆÀÁÂÃ#„dbˆÄe`\"TÊdbˆÅÂÃ#ˆ`)‰‰‰‰‰‰ \n \f `WƒÒ`\nÑyˆ`‰  \nbˆÒ!ƒlÑ•ƒgÑ•T ‚l\nT  `\\Vƒ|`\\ Õ SÃ#ƒÆו \n {Ø×GÂ$ˆÙ \"‰\fƒµ\f\fAB¡ˆ‚¿D B \nbˆ‚| bˆT‚<Ú Û\"  ƒ8 @‰\f@\fA A ƒÙGWƒ \fB‚Ù\fB ƒ4@AàA\"¡ˆ‚*‚Ù.\náÂ\"\"ebˆÀÁÂÃ#ˆÕ#dÃ#ƒ¿×” ו Äe \"$å$!×yˆÒ&!…wєѕ{' bˆÅ(Šéyˆ`)Ã#…›Õ# Ã#?…›Äe`T\"*$*=ƒ¨Â* bˆ$*'F+B+.‚JìíÂî#ˆìíÃï#ˆìíÂð#ˆìñÃò#ˆìíÂó#ˆ\"Â\f  ƒ @\f A \fAGWƒäô\f\"ô\f\"\"\"‚ä*ìõÃÂ#ˆìõ‰#‡" [search-forward "\n\n" nil t count-lines re-search-backward gnus-signature-separator prefix numbers end begin start entry alist max case-fold-search line 1 looking-at gnus-supercite-regexp gnus-cite-max-prefix re-search-forward gnus-cite-prefix-regexp 0 set-text-properties assoc sort #[(a b) "@G @GV‡" [a b] 2] gnus-cite-minimum-match-count gnus-cite-prefix-alist current loop gnus-set-difference append gnus-cite-loose-prefix-alist gnus-cite-attribution-postfix wrote gnus-cite-find-prefix gnus-supercite-secondary-regexp tag gnus-cite-attribution-prefix -1 in gnus-cite-loose-attribution-alist gnus-cite-match-attributions small #[(prefix tag) "…Á !ÄÂ!Å°‡" [tag "\\`" regexp-quote prefix "[ ]*" ">"] 5] #[(prefix tag) "…\nÁÂ!ÃQ‡" [tag "\\<" regexp-quote "\\>"] 3] #[(prefix tag) "…\nÁÂ!ÃQ‡" [tag "\\<" regexp-quote "\\>"] 3] small-if-unique #[(prefix tag) "ÀÁ\n!ÃQ‡" ["\\`" regexp-quote prefix ".+"] 3] #[(prefix tag) "ÀÁ\n!ÃQ‡" ["\\`" regexp-quote prefix ".+"] 3] delq first] 11]) (defalias 'gnus-cite-match-attributions #[(sort after fun) "Á‰‰‰‰‰‰‰‰‰ \n \f …k@\fA\f@ \fA@\nÏ\f8 Ð\f8ƒV \"‚WÒÔ=ƒdÁ‚vÕ=ƒo‚vÖ !GÏWƒ ‚‚ØÙ‰‰‰‰ƒï@A@Aàá\" ƒÅG‚ÇVƒ›ƒ›â\"ƒ› Wƒ›‚›.\fƒ!ã\f\" \f@B$B$\nƒ\n\f@B$B$\f>ƒ!%\fAÂ&'ã\f\"'ƒg'@&'A'&\f=„-&è&A\"¡ˆ&A„-ã&\"ã&\"‚-+‚!.\f‡" [gnus-cite-loose-attribution-alist t nil size best smallest limit regexp tag prefix in wrote att case-fold-search atts 2 3 fun "" sort small first gnus-cite-find-loose after -1 1000000 gnus-cite-loose-prefix-alist compare numbers candidate cite cites apply min string-match delq gnus-cite-attribution-alist gnus-cite-prefix-alist current loop gnus-set-difference] 12]) (defalias 'gnus-cite-find-loose #[(prefix) " ƒ% @‰@ AÆ\f!˜ƒ\f B‚ ,‡" [gnus-cite-loose-attribution-alist atts nil att line lines gnus-cite-find-prefix prefix] 3]) (defalias 'gnus-cite-add-face #[(number prefix face) "…2Á‰Æ!ˆGuˆÉÂwˆ`ʈÉÂxˆ`\f W…1ËÌ\f \"À#+‡" [face t nil to from inhibit-point-motion-hooks goto-line number prefix " " 1 gnus-overlay-put gnus-make-overlay] 4]) (defalias 'gnus-cite-toggle #[(prefix) "ŠqˆÁ \f\"AÅÁ …Q@AÊ!ˆË`Ì\"ƒ<Í`Îyˆ`#ˆ‚ž„Ñ`Îyˆ`#ˆ‚-‡" [gnus-article-buffer nil assoc prefix gnus-cite-prefix-alist t number inhibit-point-motion-hooks numbers buffer-read-only goto-line get-text-property invisible remove-text-properties 1 gnus-hidden-properties gnus-cite-attribution-alist add-text-properties] 4]) (defalias 'gnus-cite-find-prefix #[(line) "Á ƒ @ A A>ƒ @‚\f+‡" [gnus-cite-prefix-alist "" nil entry prefix alist line] 3]) (byte-code "À ˆÁÂ!‡" [gnus-ems-redefine provide gnus-cite] 2) emacs-19.30/lisp/gnus-cus.elc100666 23053 1 35637 6046561311 14666 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:29:20 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/gnus-cus.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus-cus.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require custom gnus-ems] 2) (defalias 'gnus-make-face #[(color) "À ‰‰‰‰&‡" [custom-face-lookup color nil] 7]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÆÇÈ\"‡" [boundp gnus-face-light-name-list ("light blue" "light cyan" "light yellow" "light pink" "pale green" "beige" "orange" "magenta" "violet" "medium purple" "turquoise") current-load-list gnus-face-dark-name-list ("RoyalBlue" "firebrick" "dark green" "OrangeRed" "dark khaki" "dark violet" "SteelBlue4") custom-declare nil ((tag . "GNUS") (doc . "The coffe-brewing, all singing, all dancing, kitchen sink newsreader.") (type . group) (data ((tag . "Visual") (doc . "GNUS can be made colorful and fun or grey and dull as you wish.") (type . group) (data ((tag . "Visual") (doc . "Enable visual features.\nIf `visual' is disabled, there will be no menus and few faces. Most of\nthe visual customization options below will be ignored. GNUS will use\nless space and be faster as a result.") (default . t) (name . gnus-visual) (type . toggle)) ((tag . "WWW Browser") (doc . "WWW Browser to call when clicking on an URL button in the article buffer.\n\nYou can choose between one of the predefined browsers, or `Other'.") (name . gnus-button-url) (calculate cond ((boundp (quote browse-url-browser-function)) browse-url-browser-function) ((fboundp (quote w3-fetch)) (quote w3-fetch)) ((eq window-system (quote x)) (quote gnus-netscape-open-url))) (type . choice) (data ((tag . "W3") (type . const) (default . w3-fetch)) ((tag . "Netscape") (type . const) (default . gnus-netscape-open-url)) ((prompt . "Other") (doc . "You must specify the name of a Lisp function here. The lisp function\nshould open a WWW browser when called with an URL (a string).\n") (default . __uninitialized__) (type . symbol)))) ((tag . "Mouse Face") (doc . "Face used for group or summary buffer mouse highlighting.\nThe line beneath the mouse pointer will be highlighted with this\nface.") (name . gnus-mouse-face) (calculate if (boundp (quote gnus-mouse-face)) gnus-mouse-face (quote highlight)) (type . face)) ((tag . "Article Display") (doc . "Controls how the article buffer will look.\n\nThe list below contains various filters you can use to change the look\nof the article. If you leave the list empty, the article will appear\nexactly as it is stored on the disk. The list entries will hide or\nhighlight various parts of the article, making it easier to find the\ninformation you want.") (name . gnus-article-display-hook) (type . list) (default gnus-article-hide-headers-if-wanted gnus-article-treat-overstrike gnus-article-maybe-highlight) (data ((type . repeat) (header) (data (tag . "Filter") (type . choice) (data ((tag . "Treat Overstrike") (doc . "Convert use of overstrike into bold and underline.\n\nTwo identical letters separated by a backspace are displayed as a\nsingle bold letter, while a letter followed by a backspace and an\nunderscore will be displayed as a single underlined letter. This\ntechnique was developed for old line printers (think about it), and is\nstill in use on some newsgroups, in particular the ClariNet\nhierearchy.\n") (type . const) (default . gnus-article-treat-overstrike)) ((tag . "Word Wrap") (doc . "Format too long lines.\n") (type . const) (default . gnus-article-word-wrap)) ((tag . "Remove CR") (doc . "Remove carriage returns from an article.\n") (type . const) (default . gnus-article-remove-cr)) ((tag . "Display X-Face") (doc . "Look for an X-Face header and display it if present.\n\nSee also `X Face Command' for a definition of the external command\nused for decoding and displaying the face.\n") (type . const) (default . gnus-article-display-x-face)) ((tag . "Unquote Printable") (doc . "Tranform MIME quoted printable into 8-bit characters.\n\nQuoted printable is often seen by strings like `=EF' where you would\nexpect a non-English letter.\n") (type . const) (default . gnus-article-de-quoted-unreadable)) ((tag . "Universal Time") (doc . "Convert date header to universal time.\n") (type . const) (default . gnus-article-date-ut)) ((tag . "Local Time") (doc . "Convert date header to local timezone.\n") (type . const) (default . gnus-article-date-local)) ((tag . "Lapsed Time") (doc . "Replace date header with a header showing the articles age.\n") (type . const) (default . gnus-article-date-lapsed)) ((tag . "Highlight") (doc . "Highlight headers, citations, signature, and buttons.\n") (type . const) (default . gnus-article-highlight)) ((tag . "Maybe Highlight") (doc . "Highlight headers, signature, and buttons if `Visual' is turned on.\n") (type . const) (default . gnus-article-maybe-highlight)) ((tag . "Highlight Some") (doc . "Highlight headers, signature, and buttons.\n") (type . const) (default . gnus-article-highlight-some)) ((tag . "Highlight Headers") (doc . "Highlight headers as specified by `Article Header Highligting'.\n") (type . const) (default . gnus-article-highlight-headers)) ((tag . "Highlight Signature") (doc . "Highlight the signature as specified by `Article Signature Face'.\n") (type . const) (default . gnus-article-highlight-signature)) ((tag . "Citation") (doc . "Highlight the citations as specified by `Citation Faces'.\n") (type . const) (default . gnus-article-highlight-citation)) ((tag . "Hide") (doc . "Hide unwanted headers, excess citation, and the signature.\n") (type . const) (default . gnus-article-hide)) ((tag . "Hide Headers If Wanted") (doc . "Hide headers, but allow user to display them with `t' or `v'.\n") (type . const) (default . gnus-article-hide-headers-if-wanted)) ((tag . "Hide Headers") (doc . "Hide unwanted headers and possibly sort them as well.\nMost likely you want to use `Hide Headers If Wanted' instead.\n") (type . const) (default . gnus-article-hide-headers)) ((tag . "Hide Signature") (doc . "Hide the signature.\n") (type . const) (default . gnus-article-hide-signature)) ((tag . "Hide Excess Citations") (doc . "Hide excess citation.\n\nExcess is defined by `Citation Hide Percentage' and `Citation Hide Absolute'.\n") (type . const) (default . gnus-article-hide-citation-maybe)) ((tag . "Hide Citations") (doc . "Hide all cited text.\n") (type . const) (default . gnus-article-hide-citation)) ((tag . "Add Buttons") (doc . "Make URL's into clickable buttons.\n") (type . const) (default . gnus-article-add-buttons)) ((prompt . "Other") (doc . "Name of Lisp function to call.\n\nPush the `Filter' button to select one of the predefined filters.\n") (type . symbol))))))) ((tag . "Article Button Face") (doc . "Face used for highlighting buttons in the article buffer.\n\nAn article button is a piece of text that you can activate by pressing\n`RET' or `mouse-2' above it.") (name . gnus-article-button-face) (default . bold) (type . face)) ((tag . "Article Mouse Face") (doc . "Face used for mouse highlighting in the article buffer.\n\nArticle buttons will be displayed in this face when the cursor is\nabove them.") (name . gnus-article-mouse-face) (default . highlight) (type . face)) ((tag . "Article Signature Face") (doc . "Face used for highlighting a signature in the article buffer.") (name . gnus-signature-face) (default . italic) (type . face)) ((tag . "Article Header Highlighting") (doc . "Controls highlighting of article header.\n\nBelow is a list of article header names, and the faces used for\ndisplaying the name and content of the header. The `Header' field\nshould contain the name of the header. The field actually contains a\nregular expression that should match the beginning of the header line,\nbut if you don't know what a regular expression is, just write the\nname of the header. The second field is the `Name' field, which\ndetermines how the the header name (i.e. the part of the header left\nof the `:') is displayed. The third field is the `Content' field,\nwhich determines how the content (i.e. the part of the header right of\nthe `:') is displayed. \n\nIf you leave the last `Header' field in the list empty, the `Name' and\n`Content' fields will determine how headers not listed above are\ndisplayed. \n\nIf you only want to change the display of the name part for a specific\nheader, specify `None' in the `Content' field. Similarly, specify\n`None' in the `Name' field if you only want to leave the name part\nalone.") (name . gnus-header-face-alist) (type . list) (calculate cond ((not (eq gnus-display-type (quote color))) (quote (("" bold italic)))) ((eq gnus-background-mode (quote dark)) (list (list "From" nil (custom-face-lookup "dark blue" nil nil t t nil)) (list "Subject" nil (custom-face-lookup "pink" nil nil t t nil)) (list "Newsgroups:.*," nil (custom-face-lookup "yellow" nil nil t t nil)) (list "" (custom-face-lookup "cyan" nil nil t nil nil) (custom-face-lookup "forestgreen" nil nil nil t nil)))) (t (list (list "From" nil (custom-face-lookup "RoyalBlue" nil nil t t nil)) (list "Subject" nil (custom-face-lookup "firebrick" nil nil t t nil)) (list "Newsgroups:.*," nil (custom-face-lookup "indianred" nil nil t t nil)) (list "" (custom-face-lookup "DarkGreen" nil nil t nil nil) (custom-face-lookup "DarkGreen" nil nil nil t nil))))) (data ((type . repeat) (header) (data (type . list) (compact . t) (data ((type . string) (prompt . "Header") (tag . "Header ")) "\n " ((type . face) (prompt . "Name") (tag . "Name ")) "\n " ((type . face) (tag . "Content")) "\n"))))) ((tag . "Attribution Face") (doc . "Face used for attribution lines.\nIt is merged with the face for the cited text belonging to the attribution.") (name . gnus-cite-attribution-face) (default . underline) (type . face)) ((tag . "Citation Faces") (doc . "List of faces used for highlighting citations. \n\nWhen there are citations from multiple articles in the same message,\nGnus will try to give each citation from each article its own face.\nThis should make it easier to see who wrote what.") (name . gnus-cite-face-list) (import . gnus-custom-import-cite-face-list) (type . list) (calculate cond ((not (eq gnus-display-type (quote color))) (quote (italic))) ((eq gnus-background-mode (quote dark)) (mapcar (quote gnus-make-face) gnus-face-light-name-list)) (t (mapcar (quote gnus-make-face) gnus-face-dark-name-list))) (data ((type . repeat) (header) (data (type . face) (tag . "Face"))))) ((tag . "Citation Hide Percentage") (doc . "Only hide excess citation if above this percentage of the body.") (name . gnus-cite-hide-percentage) (default . 50) (type . integer)) ((tag . "Citation Hide Absolute") (doc . "Only hide excess citation if above this number of lines in the body.") (name . gnus-cite-hide-absolute) (default . 10) (type . integer)) ((tag . "Summary Selected Face") (doc . "Face used for highlighting the current article in the summary buffer.") (name . gnus-summary-selected-face) (default . underline) (type . face)) ((tag . "Summary Line Highlighting") (doc . "Controls the higlighting of summary buffer lines. \n\nBelow is a list of `Form'/`Face' pairs. When deciding how a a\nparticular summary line should be displayed, each form is\nevaluated. The content of the face field after the first true form is\nused. You can change how those summary lines are displayed, by\nediting the face field. \n\nIt is also possible to change and add form fields, but currently that\nrequires an understanding of Lisp expressions. Hopefully this will\nchange in a future release. For now, you can use the following\nvariables in the Lisp expression:\n\nscore: The article's score\ndefault: The default article score.\nbelow: The score below which articles are automatically marked as read. \nmark: The article's mark.") (name . gnus-summary-highlight) (type . list) (calculate cond ((not (eq gnus-display-type (quote color))) (quote (((> score default) . bold) ((< score default) . italic)))) ((eq gnus-background-mode (quote dark)) (list (cons (quote (= mark gnus-canceled-mark)) (custom-face-lookup "yellow" "black" nil nil nil nil)) (cons (quote (and (> score default) (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark)))) (custom-face-lookup "pink" nil nil t nil nil)) (cons (quote (and (< score default) (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark)))) (custom-face-lookup "pink" nil nil nil t nil)) (cons (quote (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark))) (custom-face-lookup "pink" nil nil nil nil nil)) (cons (quote (and (> score default) (= mark gnus-ancient-mark))) (custom-face-lookup "dark blue" nil nil t nil nil)) (cons (quote (and (< score default) (= mark gnus-ancient-mark))) (custom-face-lookup "SkyBlue" nil nil nil t nil)) (cons (quote (= mark gnus-ancient-mark)) (custom-face-lookup "SkyBlue" nil nil nil nil nil)) (cons (quote (and (> score default) (= mark gnus-unread-mark))) (custom-face-lookup "white" nil nil t nil nil)) (cons (quote (and (< score default) (= mark gnus-unread-mark))) (custom-face-lookup "white" nil nil nil t nil)) (cons (quote (= mark gnus-unread-mark)) (custom-face-lookup "white" nil nil nil nil nil)) (cons (quote (> score default)) (quote bold)) (cons (quote (< score default)) (quote italic)))) (t (list (cons (quote (= mark gnus-canceled-mark)) (custom-face-lookup "yellow" "black" nil nil nil nil)) (cons (quote (and (> score default) (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark)))) (custom-face-lookup "firebrick" nil nil t nil nil)) (cons (quote (and (< score default) (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark)))) (custom-face-lookup "firebrick" nil nil nil t nil)) (cons (quote (or (= mark gnus-dormant-mark) (= mark gnus-ticked-mark))) (custom-face-lookup "firebrick" nil nil nil nil nil)) (cons (quote (and (> score default) (= mark gnus-ancient-mark))) (custom-face-lookup "RoyalBlue" nil nil t nil nil)) (cons (quote (and (< score default) (= mark gnus-ancient-mark))) (custom-face-lookup "RoyalBlue" nil nil nil t nil)) (cons (quote (= mark gnus-ancient-mark)) (custom-face-lookup "RoyalBlue" nil nil nil nil nil)) (cons (quote (and (> score default) (/= mark gnus-unread-mark))) (custom-face-lookup "DarkGreen" nil nil t nil nil)) (cons (quote (and (< score default) (/= mark gnus-unread-mark))) (custom-face-lookup "DarkGreen" nil nil nil t nil)) (cons (quote (/= mark gnus-unread-mark)) (custom-face-lookup "DarkGreen" nil nil nil nil nil)) (cons (quote (> score default)) (quote bold)) (cons (quote (< score default)) (quote italic))))) (data ((type . repeat) (header) (data (type . pair) (compact . t) (data ((type . sexp) (width . 60) (tag . "Form")) "\n " ((type . face) (tag . "Face")) "\n")))))))))] 3) (defalias 'gnus-custom-import-cite-face-list #[(custom alist) "Á=ƒÂÃ\f\"‚Å=ƒÂÃ\"ÇÉ\"\"‡" [alist light mapcar gnus-make-face gnus-face-light-name-list dark gnus-face-dark-name-list custom-super custom import] 3]) (provide (quote gnus-cus)) emacs-19.30/lisp/gnus-edit.elc100666 23053 1 44775 6046561330 15025 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:29:20 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/gnus-edit.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus-edit.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÃÄ BÆÇ BÀ‡" [require custom gnus-score ((tag . "Score") (doc . "Customization of Gnus SCORE files.\n\nSCORE files allow you to assign a score to each article when you enter\na group, and automatically mark the articles as read or delete them\nbased on the score. In the summary buffer you can use the score to\nsort the articles by score (`C-c C-s C-s') or to jump to the unread\narticle with the highest score (`,').") (type . group) (data "\n" ((header) (doc . "Name of SCORE file to customize.\n\nEnter the name in the `File' field, then push the [Load] button to\nload it. When done editing, push the [Save] button to save the file.\n\nSeveral score files may apply to each group, and several groups may\nuse the same score file. This is controlled implicitly by the name of\nthe score file and the value of the global variable\n`gnus-score-find-score-files-function', and explicitly by the the\n`Files' and `Exclude Files' entries.") (compact . t) (type . group) (data ((tag . "Load") (type . button) (query . gnus-score-custom-load)) ((tag . "Save") (type . button) (query . gnus-score-custom-save)) ((name . file) (tag . "File") (directory . "~/News/") (default-file . "SCORE") (type . file)))) ((name . files) (tag . "Files") (doc . "List of score files to load when the the current score file is loaded.\nYou can use this to share score entries between multiple score files.\n\nPush the `[INS]' button add a score file to the list, or `[DEL]' to\ndelete a score file from the list.") (type . list) (data ((type . repeat) (header) (data (type . file) (directory . "~/News/"))))) ((name . exclude-files) (tag . "Exclude Files") (doc . "List of score files to exclude when the the current score file is loaded.\nYou can use this if you have a score file you want to share between a\nnumber of newsgroups, except for the newsgroup this score file\nmatches. [ Did anyone get that? ]\n\nPush the `[INS]' button add a score file to the list, or `[DEL]' to\ndelete a score file from the list.") (type . list) (data ((type . repeat) (header) (data (type . file) (directory . "~/News/"))))) ((name . mark) (tag . "Mark") (doc . "Articles below this score will be automatically marked as read.\n\nThis means that when you enter the summary buffer, the articles will\nbe shown but will already be marked as read. You can then press `x'\nto get rid of them entirely.\n\nBy default articles with a negative score will be marked as read. To\nchange this, push the `Mark' button, and choose `Integer'. You can\nthen enter a value in the `Mark' field.") (type . gnus-score-custom-maybe-type)) ((name . expunge) (tag . "Expunge") (doc . "Articles below this score will not be shown in the summary buffer.") (type . gnus-score-custom-maybe-type)) ((name . mark-and-expunge) (tag . "Mark and Expunge") (doc . "Articles below this score will be marked as read, but not shown.\n\nSomeone should explain me the difference between this and `expunge'\nalone or combined with `mark'.") (type . gnus-score-custom-maybe-type)) ((name . eval) (tag . "Eval") (doc . "Evaluate this lisp expression when the entering summary buffer.") (type . sexp)) ((name . read-only) (tag . "Read Only") (doc . "Read-only score files will not be updated or saved.\nExcept from this buffer, of course!") (type . toggle)) ((type . doc) (doc . "Each news header has an associated list of score entries. \nYou can use the [INS] buttons to add new score entries anywhere in the\nlist, or the [DEL] buttons to delete specific score entries.\n\nEach score entry should specify a string that should be matched with\nthe content actual header in order to determine whether the entry\napplies to that header. Enter that string in the `Match' field.\n\nIf the score entry matches, the articles score will be adjusted with\nsome amount. Enter that amount in the in the `Score' field. You\nshould specify a positive amount for score entries that matches\narticles you find interesting, and a negative amount for score entries\nmatching articles you would rather avoid. The final score for the\narticle will be the sum of the score of all score entries that match\nthe article. \n\nThe score entry can be either permanent or expirable. To make the\nentry permanent, push the `Date' button and choose the `Permanent'\nentry. To make the entry expirable, choose instead the `Integer'\nentry. After choosing the you can enter the date the score entry was\nlast matched in the `Date' field. The date will be automatically\nupdated each time the score entry matches an article. When the date\nbecome too old, the the score entry will be removed.\n\nFor your convenience, the date is specified as the number of days\nelapsed since the (imaginary) Gregorian date Sunday, December 31, 1\nBC.\n\nFinally, you can choose what kind of match you want to perform by\npushing the `Type' button. For most entries you can choose between\n`Exact' which mean the header content must be exactly identical to the\nmatch string, or `Substring' meaning the match string should be\nsomewhere in the header content, or even `Regexp' to use Emacs regular\nexpression matching. The last choice is `Fuzzy' which is like `Exact'\nexcept that whitespace derivations, a beginning `Re:' or a terminating\nparenthetical remark are all ignored. Each of the four types have a\nvariant which will ignore case in the comparison. That variant is\nindicated with a `(fold)' after its name.")) ((name . from) (tag . "From") (doc . "Scoring based on the authors email address.") (type . gnus-score-custom-string-type)) ((name . subject) (tag . "Subject") (doc . "Scoring based on the articles subject.") (type . gnus-score-custom-string-type)) ((name . followup) (tag . "Followup") (doc . "Scoring based on who the article is a followup to.\n\nIf you want to see all followups to your own articles, add an entry\nwith a positive score matching your email address here. You can also\nput an entry with a negative score matching someone who is so annoying\nthat you don't even want to see him quoted in followups.") (type . gnus-score-custom-string-type)) ((name . xref) (tag . "Xref") (doc . "Scoring based on article crossposting.\n\nIf you want to score based on which newsgroups an article is posted\nto, this is the header to use. The syntax is a little different from\nthe `Newsgroups' header, but scoring in `Xref' is much faster. As an\nexample, to match all crossposted articles match on `:.*:' using the\n`Regexp' type.") (type . gnus-score-custom-string-type)) ((name . references) (tag . "References") (doc . "Scoring based on article references.\n\nThe `References' header gives you an alternative way to score on\nfollowups. If you for example want to see follow all discussions\nwhere people from `iesd.auc.dk' school participate, you can add a\nsubstring match on `iesd.auc.dk>' on this header.") (type . gnus-score-custom-string-type)) ((name . message-id) (tag . "Message-ID") (doc . "Scoring based on the articles message-id.\n\nThis isn't very useful, but Lars like completeness. You can use it to\nmatch all messaged generated by recent Gnus version with a `Substring'\nmatch on `.fsf@'.") (type . gnus-score-custom-string-type)) ((type . doc) (doc . "WARNING: Scoring on the following three pseudo headers is very slow!\nScoring on any of the real headers use a technique that avoids\nscanning the entire article, only the actual headers you score on are\nscanned, and this scanning has been heavily optimized. Using just a\nsingle entry for one the three pseudo-headers `Head', `Body', and\n`All' will require GNUS to retrieve and scan the entire article, which\ncan be very slow on large groups. However, if you add one entry for\nany of these headers, you can just as well add several. Each\nsubsequent entry cost relatively little extra time.")) ((name . head) (tag . "Head") (doc . "Scoring based on the article header.\n\nInstead of matching the content of a single header, the entire header\nsection of the article is matched. You can use this to match on\narbitrary headers, foe example to single out TIN lusers, use a substring\nmatch on `Newsreader: TIN'. That should get 'em!") (type . gnus-score-custom-string-type)) ((name . body) (tag . "Body") (doc . "Scoring based on the article body.\n\nIf you think any article that mentions `Kibo' is inherently\ninteresting, do a substring match on His name. You Are Allowed.") (type . gnus-score-custom-string-type)) ((name . all) (tag . "All") (doc . "Scoring based on the whole article.") (type . gnus-score-custom-string-type)) ((name . date) (tag . "Date") (doc . "Scoring based on article date.\n\nYou can change the score of articles that have been posted before,\nafter, or at a specific date. You should add the date in the `Match'\nfield, and then select `before', `after', or `at' by pushing the\n`Type' button. Imagine you want to lower the score of very old\narticles, or want to raise the score of articles from the future (such\nthings happen!). Then you can't use date scoring for that. In fact,\nI can't imagine anything you would want to use this for. \n\nFor your convenience, the date is specified in Usenet date format.") (type . gnus-score-custom-date-type)) ((type . doc) (doc . "The Lines and Chars headers use integer based scoring. \n\nThis means that you should write an integer in the `Match' field, and\nthe push the `Type' field to if the `Chars' or `Lines' header should\nbe larger, equal, or smaller than the number you wrote in the match\nfield.")) ((name . chars) (tag . "Characters") (doc . "Scoring based on the number of characters in the article.") (type . gnus-score-custom-integer-type)) ((name . lines) (tag . "Lines") (doc . "Scoring based on the number of lines in the article.") (type . gnus-score-custom-integer-type)) ((name . orphan) (tag . "Orphan") (doc . "Score to add to articles with no parents.") (type . gnus-score-custom-maybe-type)) ((name . adapt) (tag . "Adapt") (doc . "Adapting the score files to your newsreading habits.\n\nWhen you have finished reading a group GNUS can automatically create\nnew score entries based on which articles you read and which you\nskipped. This is normally controled by the two global variables\n`gnus-use-adaptive-scoring' and `gnus-default-adaptive-score-alist',\nThe first determines whether adaptive scoring should be enabled or\nnot, while the second determines what score entries should be created.\n\nYou can overwrite the setting of `gnus-use-adaptive-scoring' by\nselecting `Enable' or `Disable' by pressing the `Adapt' button.\nSelecting `Custom' will allow you to specify the exact adaption\nrules (overwriting `gnus-default-adaptive-score-alist').") (type . choice) (data ((tag . "Default") (default) (type . const)) ((tag . "Enable") (default . t) (type . const)) ((tag . "Disable") (default . ignore) (type . const)) ((tag . "Custom") (doc . "Customization of adaptive scoring.\n\nEach time you read an article it will be marked as read. Likewise, if\nyou delete it it will be marked as deleted, and if you tick it it will\nbe marked as ticked. When you leave a group, GNUS can automatically\ncreate score file entries based on these marks, so next time you enter\nthe group articles with subjects that you read last time have higher\nscore and articles with subjects that deleted will have lower score. \n\nBelow is a list of such marks. You can insert new marks to the list\nby pushing on one of the `[INS]' buttons in the left margin to create\na new entry and then pushing the `Mark' button to select the mark.\nFor each mark there is another list, this time of article headers,\nwhich determine how the mark should affect that header. The `[INS]'\nbuttons of this list are indented to indicate that the belong to the\nmark above. Push the `Header' button to choose a header, and then\nenter a score value in the `Score' field. \n\nFor each article that are marked with `Mark' when you leave the\ngroup, a temporary score entry for the articles `Header' with the\nvalue of `Score' will be added the adapt file. If the score entry\nalready exists, `Score' will be added to its value. If you understood\nthat, you are smart.\n\nYou can select the special value `Other' when pressing the `Mark' or\n`Header' buttons. This is because Lars might add more useful values\nthere. If he does, it is up to you to figure out what they are named.") (type . list) (default (__uninitialized__)) (data ((type . repeat) (header) (data (type . list) (header) (compact . t) (data ((type . choice) (tag . "Mark") (data ((tag . "Unread") (default . gnus-unread-mark) (type . const)) ((tag . "Ticked") (default . gnus-ticked-mark) (type . const)) ((tag . "Dormant") (default . gnus-dormant-mark) (type . const)) ((tag . "Deleted") (default . gnus-del-mark) (type . const)) ((tag . "Read") (default . gnus-read-mark) (type . const)) ((tag . "Expirable") (default . gnus-expirable-mark) (type . const)) ((tag . "Killed") (default . gnus-killed-mark) (type . const)) ((tag . "Kill-file") (default . gnus-kill-file-mark) (type . const)) ((tag . "Low-score") (default . gnus-low-score-mark) (type . const)) ((tag . "Catchup") (default . gnus-catchup-mark) (type . const)) ((tag . "Ancient") (default . gnus-ancient-mark) (type . const)) ((tag . "Canceled") (default . gnus-canceled-mark) (type . const)) ((prompt . "Other") (default . 63) (type . sexp)))) ((type . repeat) (prefix . " ") (data (type . list) (compact . t) (data ((tag . "Header") (type . choice) (data ((tag . "Subject") (default . subject) (type . const)) ((prompt . "From") (tag . "From ") (default . from) (type . const)) ((prompt . "Other") (width . 7) (default) (type . symbol)))) ((tag . "Score") (type . integer)))))))))))) ((name . local) (tag . "Local") (doc . "List of local variables to set when this score file is loaded.\n\nUsing this entry can provide a convenient way to set variables that\nwill affect the summary mode for only some specific groups, i.e. those\ngroups matched by the current score file.") (type . list) (data ((type . repeat) (header) (data (type . list) (compact . t) (data ((tag . "Name") (width . 26) (type . symbol)) ((tag . "Value") (width . 26) (type . sexp))))))))) gnus-score-custom-data current-load-list ((gnus-score-custom-maybe-type (type . choice) (data ((type . integer) (default . 0)) ((tag . "Default") (type . const) (default)))) (gnus-score-custom-string-type (type . list) (data ((type . repeat) (header) (data (type . list) (compact . t) (data ((tag . "Match") (width . 59) (type . string)) "\n " ((tag . "Score") (type . integer)) ((tag . "Date") (type . choice) (data ((type . integer) (default . 0) (width . 9)) ((tag . "Permanent") (type . const) (default)))) ((tag . "Type") (type . choice) (data ((tag . "Exact") (default . E) (type . const)) ((tag . "Substring") (default . S) (type . const)) ((tag . "Regexp") (default . R) (type . const)) ((tag . "Fuzzy") (default . F) (type . const)) ((tag . "Exact (fold)") (default . e) (type . const)) ((tag . "Substring (fold)") (default . s) (type . const)) ((tag . "Regexp (fold)") (default . r) (type . const)) ((tag . "Fuzzy (fold)") (default . f) (type . const))))))))) (gnus-score-custom-integer-type (type . list) (data ((type . repeat) (header) (data (type . list) (compact . t) (data ((tag . "Match") (type . integer)) ((tag . "Score") (type . integer)) ((tag . "Date") (type . choice) (data ((type . integer) (default . 0) (width . 9)) ((tag . "Permanent") (type . const) (default)))) ((tag . "Type") (type . choice) (data ((tag . "<") (default . <) (type . const)) ((tag . ">") (default . >) (type . const)) ((tag . "=") (default . =) (type . const)) ((tag . ">=") (default . >=) (type . const)) ((tag . "<=") (default . <=) (type . const))))))))) (gnus-score-custom-date-type (type . list) (data ((type . repeat) (header) (data (type . list) (compact . t) (data ((tag . "Match") (width . 59) (type . string)) "\n " ((tag . "Score") (type . integer)) ((tag . "Date") (type . choice) (data ((type . integer) (default . 0) (width . 9)) ((tag . "Permanent") (type . const) (default)))) ((tag . "Type") (type . choice) (data ((tag . "Before") (default . before) (type . const)) ((tag . "After") (default . after) (type . const)) ((tag . "At") (default . at) (type . const)))))))))) gnus-score-custom-type-properties] 2) #@38 Name of SCORE file being customized. (defvar gnus-score-custom-file nil (#$ . 16855)) #@47 Create a buffer for editing gnus SCORE files. (defalias 'gnus-score-customize #[nil "ÀÂÃ\f ÆÇÈ&ˆ)ÉÊ!ˆËÌÍ\"\nÉÁ!ˆÀÎ ‡" [nil gnus-score-alist custom-buffer-create "*Score Edit*" gnus-score-custom-data gnus-score-custom-type-properties gnus-score-custom-set gnus-score-custom-get gnus-score-custom-save make-local-variable gnus-score-custom-file expand-file-name "SCORE" "~/News" custom-reset-all] 7 (#$ . 16947) nil]) (defalias 'gnus-score-custom-get #[(name) "Á=ƒ\n‡ÃÄ! \"‰ƒÇÈA\"‚Aà \"É>„7Ê=ƒ=A@9„=A‚AA@)‡" [name file gnus-score-custom-file assoc symbol-name gnus-score-alist entry mapcar gnus-score-custom-sanify (files exclude-files local) adapt] 4]) (defalias 'gnus-score-custom-set #[(name value) "Á=ƒ\n\n‰‡ÄÅ!\"ƒ1\nƒ\"ÄÅ!\"\n¡‡ÇÄÅ!\"\"‰‡ÄÅ!\"ƒK\n…¤Å!\nBB‰‡Ä\"ƒ€\n„dÇÄ\"\"‰‡\n<ƒwÉ=„wÄ\"\n¡‡Ä\"\nC¡‡\n?†¤\n<ƒšÉ=„š\nBB‰‡\nCBB‰‡" [name file value gnus-score-custom-file assoc symbol-name gnus-score-alist delq gnus-header-index eval] 4]) (defalias 'gnus-score-custom-sanify #[(entry) "@A@† Â8Ã8„Ä‚.Ã8Å>ƒ$Ã8‚.ÆÇÃ8!ÈÉO!F‡" [entry gnus-score-interactive-default-score 2 3 s (before after at >= <=) intern symbol-name 0 1] 7]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-score-cache nil current-load-list] 2) (defalias 'gnus-score-custom-load #[nil "ÀÁ!‰\n=ƒÃÄ!ˆÅ Æ\"Ç !ˆ É ˆÊË!)‡" [custom-name-value file custom-nil error "You must specify a file name" expand-file-name "~/News" gnus-score-load gnus-score-custom-file custom-reset-all message "Loaded"] 4 nil nil]) (defalias 'gnus-score-custom-save #[nil "À ˆÁ\n!ˆ\n ÄŠÈÉ!qˆÊp!ˆË ˆÌp\"ˆÍÎ!!ˆÏedÄÐ%ˆÑp!ˆ,ÒÓ!‡" [custom-apply-all gnus-score-remove-from-cache gnus-score-custom-file gnus-score-alist nil emacs-lisp-mode-hook score file get-buffer-create "*Score*" buffer-disable-undo erase-buffer pp gnus-make-directory file-name-directory write-region silent kill-buffer message "Saved"] 6 nil nil]) (provide (quote gnus-edit)) emacs-19.30/lisp/gnus-ems.elc100666 23053 1 37114 6046561341 14653 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:29:22 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/gnus-ems.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus-ems.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÅÆ BÀÇ!„.ÅÇ BÈÉÊ\"ˆÈËÌ\"ˆÈÍÎ\"ˆÏÐ!„KÐÑMˆÒ BÓ BÔ BÕ BÖ B× BØ BÙ BÚ BÛ BÜ BÝ BÞ Bß Bà Bá Bâ Bã Bä Bå Bæ Bç Bè Bé Bê Bë BŇ" [boundp gnus-mouse-2 [mouse-2] current-load-list gnus-group-mode-hook nil gnus-summary-mode-hook gnus-article-mode-hook defalias gnus-make-overlay make-overlay gnus-overlay-put overlay-put gnus-move-overlay move-overlay fboundp mail-file-babyl-p rmail-file-p gnus-active-hashtb gnus-article-buffer gnus-auto-center-summary gnus-buffer-list gnus-current-headers gnus-level-killed gnus-level-zombie gnus-newsgroup-bookmarks gnus-newsgroup-dependencies gnus-newsgroup-headers-hashtb-by-number gnus-newsgroup-selected-overlay gnus-newsrc-hashtb gnus-read-mark gnus-refer-article-method gnus-reffed-article-number gnus-unread-mark gnus-version gnus-view-pseudos gnus-view-pseudos-separately gnus-visual gnus-zombie-list gnus-article-copy gnus-check-before-posting gnus-article-button-face gnus-article-mouse-face gnus-summary-selected-face] 3) #@137 You should NEVER use this function. It is ideologically blasphemous. It is provided only to ease porting of broken FSF Emacs programs. (defalias 'gnus-set-text-properties-xemacs #[(start end props &optional buffer) ";… Á!‰??…!ÂÃ\f ƉÇ&ˆÈ\f  $‡" [buffer get-buffer map-extents #[(extent ignored) "À \nÃ\fÅ\"ÆD$‡" [remove-text-properties start end extent-property extent text-prop nil buffer] 6] start end nil text-prop add-text-properties props] 8 (#$ . 1519)]) (progn (if (string-match "XEmacs\\|Lucid" emacs-version) nil (defvar gnus-display-type (condition-case nil (let ((display-resource (x-get-resource ".displayType" "DisplayType"))) (cond (display-resource (intern (downcase display-resource))) ((x-display-color-p) (quote color)) ((x-display-grayscale-p) (quote grayscale)) (t (quote mono)))) (error (quote mono))) "A symbol indicating the display Emacs is running under.\nThe symbol should be one of `color', `grayscale' or `mono'. If Emacs\nguesses this display attribute wrongly, either set this variable in\nyour `~/.emacs' or set the resource `Emacs.displayType' in your\n`~/.Xdefaults'. See also `gnus-background-mode'.\n\nThis is a meta-variable that will affect what default values other\nvariables get. You would normally not change this variable, but\npounce directly on the real variables themselves.") (defvar gnus-background-mode (condition-case nil (let ((bg-resource (x-get-resource ".backgroundMode" "BackgroundMode")) (params (frame-parameters))) (cond (bg-resource (intern (downcase bg-resource))) ((and (cdr (assq (quote background-color) params)) (< (apply (quote +) (x-color-values (cdr (assq (quote background-color) params)))) (/ (apply (quote +) (x-color-values "white")) 3))) (quote dark)) (t (quote light)))) (error (quote light))) "A symbol indicating the Emacs background brightness.\nThe symbol should be one of `light' or `dark'.\nIf Emacs guesses this frame attribute wrongly, either set this variable in\nyour `~/.emacs' or set the resource `Emacs.backgroundMode' in your\n`~/.Xdefaults'.\nSee also `gnus-display-type'.\n\nThis is a meta-variable that will affect what default values other\nvariables get. You would normally not change this variable, but\npounce directly on the real variables themselves.")) (cond ((string-match "XEmacs\\|Lucid" emacs-version) (setq gnus-mouse-2 [button2]) (or (memq (quote underline) (list-faces)) (and (fboundp (quote make-face)) (funcall (intern "make-face") (quote underline)))) (or (face-differs-from-default-p (quote underline)) (funcall (quote set-face-underline-p) (quote underline) t)) (defalias (quote gnus-make-overlay) (quote make-extent)) (defalias (quote gnus-overlay-put) (quote set-extent-property)) (defun gnus-move-overlay (extent start end &optional buffer) (set-extent-endpoints extent start end)) (require (quote text-props)) (fset (quote set-text-properties) (quote gnus-set-text-properties-xemacs)) (or (boundp (quote standard-display-table)) (setq standard-display-table nil)) (or (boundp (quote read-event)) (fset (quote read-event) (quote next-command-event))) (defvar gnus-display-type (device-class) "A symbol indicating the display Emacs is running under.\nThe symbol should be one of `color', `grayscale' or `mono'. If Emacs\nguesses this display attribute wrongly, either set this variable in\nyour `~/.emacs' or set the resource `Emacs.displayType' in your\n`~/.Xdefaults'. See also `gnus-background-mode'.\n\nThis is a meta-variable that will affect what default values other\nvariables get. You would normally not change this variable, but\npounce directly on the real variables themselves.") (or (fboundp (quote x-color-values)) (fset (quote x-color-values) (lambda (color) (color-instance-rgb-components (make-color-instance color))))) (defvar gnus-background-mode (let ((bg-resource (condition-case nil (x-get-resource ".backgroundMode" "BackgroundMode" (quote string)) (error nil))) (params (frame-parameters))) (cond (bg-resource (intern (downcase bg-resource))) ((and (assq (quote background-color) params) (< (apply (quote +) (x-color-values (cdr (assq (quote background-color) params)))) (/ (apply (quote +) (x-color-values "white")) 3))) (quote dark)) (t (quote light)))) "A symbol indicating the Emacs background brightness.\nThe symbol should be one of `light' or `dark'.\nIf Emacs guesses this frame attribute wrongly, either set this variable in\nyour `~/.emacs' or set the resource `Emacs.backgroundMode' in your\n`~/.Xdefaults'.\nSee also `gnus-display-type'.\n\nThis is a meta-variable that will affect what default values other\nvariables get. You would normally not change this variable, but\npounce directly on the real variables themselves.") (defun gnus-install-mouse-tracker nil (require (quote mode-motion)) (setq mode-motion-hook (quote mode-motion-highlight-line)))) ((and (not (string-match "28.9" emacs-version)) (not (string-match "29" emacs-version))) (let ((props (and (boundp (quote gnus-hidden-properties)) gnus-hidden-properties))) (while (and props (not (eq (car (cdr props)) (quote intangible)))) (setq props (cdr props))) (and props (setcdr props (cdr (cdr (cdr props)))))) (or (fboundp (quote buffer-substring-no-properties)) (defun buffer-substring-no-properties (beg end) (format "%s" (buffer-substring beg end))))) ((boundp (quote MULE)) (provide (quote gnusutil))))) (byte-code "„ÁÂMˆÃÅ\f@!„\f@ÁMˆ\fA‰„\n)ÅÆ!„(ÆÇMˆÅÈ!„2ÈÉMˆÁ‡" [window-system gnus-dummy-func #[(&rest args) "À‡" [nil] 1] (mouse-set-point set-face-foreground set-face-background x-popup-menu) funcs fboundp file-regular-p #[(file) "À !?… !?…à !‡" [file-directory-p file file-symlink-p file-exists-p] 2] face-list #[(&rest args) "À‡" [nil] 1]] 3) (defalias 'gnus-highlight-selected-summary-xemacs #[nil "…' ƒ\f !ˆÃ`Åyˆ`\fbˆ)`ƈ`\fbˆ)\"Ç \"‡" [gnus-summary-selected-face gnus-newsgroup-selected-overlay delete-extent make-extent p 0 nil set-extent-face] 4]) (defalias 'gnus-summary-recenter-xemacs #[nil "À ÁWƒ ‚À ÃWƒÄ‚ÅÀ ÅZŠdbˆ[yˆ`)Ép!\n …LÉ\f!…LÍ\nŠ[yˆ`)^\",‡" [window-height 4 0 7 1 2 top height bottom get-buffer-window window gnus-auto-center-summary gnus-article-buffer set-window-start] 4]) (defalias 'gnus-group-insert-group-line-info-xemacs #[(group) "À \n\"J`ɉƒ,È8Éà \fA@Ê\f8@Ë\f8&ˆ‚WÀ \f\"JÉà ‰ ƒB‚Dà ƒR AT @Z‚SÐÃ&ˆŠbˆÑ`Ðyˆ`bˆ)T`È`bˆ)TÓ#-‡" [intern-soft group gnus-newsrc-hashtb nil info active beg entry 2 gnus-group-insert-group-line 3 4 gnus-active-hashtb gnus-zombie-list gnus-level-zombie gnus-level-killed 0 remove-text-properties p (gnus-group nil)] 9]) #@119 Refer article specified by MESSAGE-ID. NOTE: This command only works with newsgroups that use real or simulated NNTP. (defalias 'gnus-summary-refer-article-xemacs #[(message-id) ";?†\nGÁU?…ýÂÃ\"„ÄPÂÅ\"„$ÆPÇ—\"J@‰ ƒ~Ê ÁH!†ü` ÌÍ ÁÍ͉ ÏH&ˆŠ bˆÐ`Áyˆ`bˆ)T`͈`bˆ)TÒ#ˆ)Óyˆ ÁH)‚üÕÖ!!͉ƒžÝ!ˆŠqˆÞß!ƒ­àß!ˆáß!)âÍã!#ƒÜ$ÁHå!ˆæ!ˆç ˆè)žA!ˆ‚ûŠà!ˆqˆá!ˆÍ*…úëÖp!\"*-)‡" [message-id 0 string-match "^<" "<" ">$" ">" intern-soft gnus-newsgroup-dependencies header gnus-summary-goto-article beg gnus-summary-insert-line nil gnus-read-mark 1 remove-text-properties p (gnus-number nil gnus-mark nil gnus-level nil) -1 gnus-refer-article-method window-start get-buffer-window gnus-article-buffer tmp-buf number tmp-point gnus-ancient-mark gnus-override-method gnus-check-server get-buffer " *temp Article*" kill-buffer rename-buffer gnus-article-prepare gnus-read-header gnus-current-headers gnus-rebuild-thread gnus-summary-goto-subject gnus-summary-recenter gnus-article-set-window-start gnus-newsgroup-bookmarks buffer-read-only set-window-start] 11 (#$ . 8118) "sMessage-ID: "]) (defalias 'gnus-summary-insert-pseudos-xemacs #[(pslist &optional not-view) "ÀÁ`Ãyˆ`\nbˆ)Ä\"† ÀÉ!„(ÊËÌ\"!ˆ „0Î ˆÏ ˆ„ÛÑÓ\"‰À‰‰ƒÚÔ@žA×@žACƒ“Aƒ“†nØÔA@žA†yÙ˜ƒ“×A@žAB‰AA¡ˆ‚]ƒÑÚÛ\"„¦ÜBÜBÝ@žƒÑÝ@žÚÛ\"ƒÅË‚ÆÞßàÜ#\"¡ˆA‰„L+!ƒ\"„…˜Ý@žƒÿãÝ@žA!ä=\"ˆA‰‚犅—ÉÇ@žA†)Á`Ãyˆ`\nbˆ)Ä\"†) !ˆåyˆ`æç×@žA!èÝ@žA†Eé걈ë‰TÄ,í.ïÃð@¯#ˆbˆñÃ!ˆòT`Àˆ`\nbˆ)Tó#ˆôyˆõö,! \"@Lˆ,S,A‰„À)+‡" [nil get-text-property p 0 gnus-number gnus-current-article b article buffer-read-only gnus-summary-goto-subject error format "No such article: %d" gnus-newsgroup-headers-hashtb-by-number gnus-make-headers-hashtable-by-number gnus-summary-position-cursor gnus-view-pseudos-separately sort pslist gnus-pseudos< action files ps name "1" "2" string-match "%s" " " execute concat mapconcat #[(f) "‡" [f] 1] gnus-view-pseudos not-view gnus-execute-command not-confirm 1 " " file-name-nondirectory ": " "" "\n" add-text-properties gnus-reffed-article-number gnus-mark gnus-unread-mark gnus-level gnus-pseudo sit-for remove-text-properties (gnus-number nil gnus-mark nil gnus-level nil) -1 intern int-to-string] 12]) (defalias 'gnus-copy-article-buffer-xemacs #[(&optional article-buffer) "ÀÁ!Ã\n!ˆ\n\f>„\n\fB †ÇÉ !…BÊÉ !!…BŠ qˆ~ˆed{\nqˆË ˆÌÍ\"c)*‡" [get-buffer-create " *gnus article copy*" gnus-article-copy buffer-disable-undo gnus-buffer-list article-buffer gnus-article-buffer nil buf get-buffer buffer-name erase-buffer format "%s"] 3]) #@186 Check text under the mouse pointer for a callback function. If the text under the mouse pointer has a `gnus-callback' property, call it with the value of the `gnus-data' text property. (defalias 'gnus-article-push-button-xemacs #[(event) "ÀÁ\n!!qˆÃ\n!Å\fÆ\"Å\fÈ\"‰ …  !+‡" [window-buffer event-window event event-closest-point pos get-text-property gnus-data data gnus-callback fun] 4 (#$ . 10837) "e"]) (defalias 'gnus-rebuild-thread-xemacs #[(id) "Á‰‰‰‰‰ ƒDÊ —\"J‰@‰ƒD\n ËH‰…>ÌÍ\f\"…>\fΔΕO‰ „Ï@!Ð !ˆ`Ò CÓ\"ˆŠ`Yƒ‹o„‹m„…Ô`Óyˆ`bˆ)T`Áˆ`bˆ)TÖ#ˆ×yˆ‚X)Ø`\".‡" [gnus-newsgroup-dependencies nil art thread refs headers parent buffer-read-only dep id intern-soft 5 string-match "\\(<[^>]+>\\) *$" 1 gnus-make-sub-thread gnus-rebuild-remove-articles beg gnus-summary-prepare-threads 0 remove-text-properties p (gnus-number nil gnus-mark nil gnus-level nil) -1 gnus-summary-update-lines] 8]) #@70 Create a button between FROM and TO with callback FUN and data DATA. (defalias 'gnus-article-add-button-xemacs #[(from to fun &optional data) "ƒ Á \f\"Å#ˆÆ \fÇ…ÉDÊ D\f…'Í\fDÎÏD$#‡" [gnus-article-button-face gnus-overlay-put gnus-make-overlay from to face add-text-properties append gnus-article-mouse-face mouse-face gnus-callback fun data gnus-data highlight t] 9 (#$ . 11785)]) (defalias 'gnus-window-top-edge-xemacs #[(&optional window) "À !A@‡" [window-pixel-edges window] 2]) (defalias 'gnus-appt-select-lowest-window-xemacs #[nil "À  AAA@Ä Æ…GÈ   !AAA@\n \nWƒ0\n Ë !ˆ  =ƒCË !ˆÌ*‚,‡" [selected-window lowest-window window-pixel-edges bottom-edge previous-window last-window t window-search next-window this-window next-bottom-edge select-window nil] 2]) (defalias 'gnus-ems-redefine #[nil "ÀÁ\n\"ƒyÃÄMˆÅÆMˆÇÄMˆÈÉMˆÊËMˆÌÍMˆÎÏMˆÐÑMˆÒÓMˆÔÕMˆÖ×MˆØÙMˆÚÛMˆÜÝMˆÞß!„IßàMˆ!ƒ`â#B#ä%B%æ'B'èé!„mêëì!!)é-B-îïMˆî‡èð!…«Þñ!„‰ñòMˆóôñ\"ˆõöMˆ÷øMˆÅùMˆèú!…«ûüûý:\"\"‰:‡" [string-match "XEmacs\\|Lucid" emacs-version gnus-mouse-face-function identity gnus-summary-make-display-table #[nil "À‡" [nil] 1] gnus-visual-turn-off-edit-menu gnus-highlight-selected-summary gnus-highlight-selected-summary-xemacs gnus-summary-recenter gnus-summary-recenter-xemacs gnus-group-insert-group-line-info gnus-group-insert-group-line-info-xemacs gnus-copy-article-buffer gnus-copy-article-buffer-xemacs gnus-summary-refer-article gnus-summary-refer-article-xemacs gnus-summary-insert-pseudos gnus-summary-insert-pseudos-xemacs gnus-article-push-button gnus-article-push-button-xemacs gnus-rebuild-thread gnus-rebuild-thread-xemacs gnus-article-add-button gnus-article-add-button-xemacs gnus-window-top-edge gnus-window-top-edge-xemacs set-text-properties gnus-set-text-properties-xemacs fboundp appt-select-lowest-window gnus-appt-select-lowest-window-xemacs gnus-visual (lambda nil (easy-menu-add gnus-group-reading-menu) (easy-menu-add gnus-group-group-menu) (easy-menu-add gnus-group-misc-menu) (gnus-install-mouse-tracker)) gnus-group-mode-hook (lambda nil (easy-menu-add gnus-summary-article-menu) (easy-menu-add gnus-summary-thread-menu) (easy-menu-add gnus-summary-misc-menu) (easy-menu-add gnus-summary-post-menu) (easy-menu-add gnus-summary-kill-menu) (gnus-install-mouse-tracker)) gnus-summary-mode-hook (lambda nil (easy-menu-add gnus-article-article-menu) (easy-menu-add gnus-article-treatment-menu)) gnus-article-mode-hook boundp gnus-logo make-glyph make-specifier image current-load-list gnus-group-startup-xmessage #[(&optional x y) "À ˆÁÂ!ƒZÃ\fÅÆ#ˆÇ\fÆÈÉ$ˆÊcˆËÌ``\"\f\"ˆÍcˆebˆm„CÎÏ  †4ÐZÑ]Ò¥Ó\"cˆÔyˆ‚'ebˆÕÖ× †PÙZÑ]Ò¥\"ˆ‚‡ÚÛ\"cˆÝedÏ  †lÞZÑ]Ò¥#ˆebˆÕÖ× †€ßZÑ]Ò¥\"ˆebˆàá!ˆâєѕãä$ˆeb‡" [erase-buffer featurep xpm set-glyph-property gnus-logo image "~/tmp/gnus.xpm" set-glyph-image global x " " set-extent-begin-glyph make-extent "\n Gnus * A newsreader for Emacsen\n A Praxis Release * larsi@ifi.uio.no" make-string window-width 35 0 2 32 1 insert-char 10 window-height y 24 format "\n %s\n A newsreader \n for GNU Emacs\n\n Based on GNUS \n written by \n Masanobu UMEDA\n\n A Praxis Release\n larsi@ifi.uio.no\n" gnus-version indent-rigidly 28 12 search-forward "Praxis" put-text-property face bold] 5 "Insert startup message in current buffer."] MULE truncate-string #[(str width) "À !‰‰Ã‰ Xƒ ‚N Wƒ= HÊ\f!\\Ë\f!\\‚  UƒL‚M O-‡" [string-width str 0 nil chr p-idx idx col w width char-width char-bytes] 6] defalias gnus-truncate-string gnus-cite-add-face #[(number prefix face) "…AÁ‰Æ!ˆÈÉ!ƒÊ !uˆ‚# GuˆÌÂwˆ`͈ÌÂxˆ`\f W…@ÎÏ\f \"À#+‡" [face t nil to from inhibit-point-motion-hooks goto-line number boundp MULE chars-in-string prefix " " 1 gnus-overlay-put gnus-make-overlay] 4] gnus-max-width-function #[(el max-width) "ÀÁ DDÄBÅÆÇEÉÊEËBBBE‡" [let* val eval el ((valstr (if (numberp val) (int-to-string val) val))) if > (length valstr) max-width truncate-string valstr (valstr)] 7] #[nil "À‡" [nil] 1] gnus-check-before-posting delq long-lines control-chars] 5]) (provide (quote gnus-ems)) emacs-19.30/lisp/gnus-kill.elc100666 23053 1 34172 6046561354 15027 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:29:24 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/gnus-kill.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus-kill.el' was compiled for Emacs 19.29 or later")) (require (quote gnus)) #@34 *A hook for Gnus kill file mode. (defvar gnus-kill-file-mode-hook nil (#$ . -506)) #@59 *Number of days before expiring unused kill file entries. (defvar gnus-kill-expiry-days 7 (#$ . -595)) #@58 *If non-nil, will save kill files after processing them. (defvar gnus-kill-save-kill-file nil (#$ . -704)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-winconf-kill-file nil current-load-list] 2) (defalias 'gnus-raise '(macro . #[(field expression level) "À \nÃÄ DDÆBBBB‡" [gnus-kill field expression function gnus-summary-raise-score level (t)] 6])) (defalias 'gnus-lower '(macro . #[(field expression level) "À \nÃÄÅDDDÇBBBB‡" [gnus-kill field expression function gnus-summary-raise-score - level (t)] 7])) (byte-code "ÀÁ!„ÂÁ B „>Ä !Æ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÌ#ˆÆ ÍÎ#ˆÆ ÏÐ#ˆÆ ÑÒ#ˆÆ ÓÔ#ˆÂ‡" [boundp gnus-kill-file-mode-map nil current-load-list copy-keymap emacs-lisp-mode-map define-key " " gnus-kill-file-kill-by-subject " " gnus-kill-file-kill-by-author " " gnus-kill-file-kill-by-thread " " gnus-kill-file-kill-by-xref "" gnus-kill-file-apply-buffer "" gnus-kill-file-apply-last-sexp "" gnus-kill-file-exit] 4) #@2807 Major mode for editing kill files. If you are using this mode - you probably shouldn't. Kill files perform badly and paint with a pretty broad brush. Score files, on the other hand, are vastly faster (40x speedup) and give you more control over what to do. In addition to Emacs-Lisp Mode, the following commands are available: \{gnus-kill-file-mode-map} A kill file contains Lisp expressions to be applied to a selected newsgroup. The purpose is to mark articles as read on the basis of some set of regexps. A global kill file is applied to every newsgroup, and a local kill file is applied to a specified newsgroup. Since a global kill file is applied to every newsgroup, for better performance use a local one. A kill file can contain any kind of Emacs Lisp expressions expected to be evaluated in the Summary buffer. Writing Lisp programs for this purpose is not so easy because the internal working of Gnus must be well-known. For this reason, Gnus provides a general function which does this easily for non-Lisp programmers. The `gnus-kill' function executes commands available in Summary Mode by their key sequences. `gnus-kill' should be called with FIELD, REGEXP and optional COMMAND and ALL. FIELD is a string representing the header field or an empty string. If FIELD is an empty string, the entire article body is searched for. REGEXP is a string which is compared with FIELD value. COMMAND is a string representing a valid key sequence in Summary mode or Lisp expression. COMMAND defaults to '(gnus-summary-mark-as-read nil "X"). Make sure that COMMAND is executed in the Summary buffer. If the second optional argument ALL is non-nil, the COMMAND is applied to articles which are already marked as read or unread. Articles which are marked are skipped over by default. For example, if you want to mark articles of which subjects contain the string `AI' as read, a possible kill file may look like: (gnus-kill "Subject" "AI") If you want to mark articles with `D' instead of `X', you can use the following expression: (gnus-kill "Subject" "AI" "d") In this example it is assumed that the command `gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode. It is possible to delete unnecessary headers which are marked with `X' in a kill file as follows: (gnus-expunge "X") If the Summary buffer is empty after applying kill files, Gnus will exit the selected newsgroup normally. If headers which are marked with `D' are deleted in a kill file, it is impossible to read articles which are marked as read in the previous Gnus sessions. Marks other than `D' should be used for articles which should really be deleted. Entry to this mode calls emacs-lisp-mode-hook and gnus-kill-file-mode-hook with no arguments, if that value is non-nil. (defalias 'gnus-kill-file-mode #[nil "À ˆÁ\n!ˆÃ\f!ˆÅÇÉÊ!ˆËÌÍ\"‡" [kill-all-local-variables use-local-map gnus-kill-file-mode-map set-syntax-table emacs-lisp-mode-syntax-table gnus-kill-file-mode major-mode "Kill" mode-name lisp-mode-variables nil run-hooks emacs-lisp-mode-hook gnus-kill-file-mode-hook] 3 (#$ . 1635) nil]) #@97 Begin editing a kill file for NEWSGROUP. If NEWSGROUP is nil, the global kill file is selected. (defalias 'gnus-kill-file-edit-file #[(newsgroup) "À !ÃÄ\n!!ˆÅ\n!ƒÆÅ\n!!„Ç É\n!\nÆ\n!ƒ0Ë\n!ˆ‚d\fÍ=ƒCÎÏ!ˆË\n!ˆ‚d\fÐ=ƒ`ÎÑ!ˆË!ˆÓ!ˆÔ\n!ˆ‚dÕ\n!ˆ)Ö )‡" [gnus-newsgroup-kill-file newsgroup file gnus-make-directory file-name-directory get-file-buffer get-buffer-window current-window-configuration gnus-winconf-kill-file find-file-noselect buffer pop-to-buffer major-mode gnus-group-mode gnus-configure-windows group gnus-summary-mode article gnus-article-buffer bury-buffer switch-to-buffer find-file-other-window gnus-kill-file-mode] 3 (#$ . 4775) "sNewsgroup: "]) (defalias 'gnus-kill-set-kill-buffer #[nil "À !Ã\n!‰qˆÅ ˆÆ\f!*‡" [gnus-newsgroup-kill-file gnus-newsgroup-name file find-file-noselect buffer gnus-kill-file-mode bury-buffer] 3]) (defalias 'gnus-kill-file-enter-kill #[(field regexp) "ŠÀ\nÃ=„\fÄ ˆdbˆÅÆ#‰cˆÉ !*‡" [nil string major-mode gnus-kill-file-mode gnus-kill-set-kill-buffer format "(gnus-kill %S %S)\n" field regexp gnus-kill-file-apply-string] 4]) #@18 Kill by subject. (defalias 'gnus-kill-file-kill-by-subject #[nil "ÀÁ !ƒÄÅ ÆH!!‚Ç\"‡" [gnus-kill-file-enter-kill "Subject" vectorp gnus-current-headers regexp-quote gnus-simplify-subject 1 ""] 6 (#$ . 5875) nil]) #@17 Kill by author. (defalias 'gnus-kill-file-kill-by-author #[nil "ÀÁ !ƒÄ ÅH!‚Æ\"‡" [gnus-kill-file-enter-kill "From" vectorp gnus-current-headers regexp-quote 2 ""] 5 (#$ . 6098) nil]) #@17 Kill by author. (defalias 'gnus-kill-file-kill-by-thread #[nil "ÀÁ !ƒÄ ÅH!‚Æ\"‡" [gnus-kill-file-enter-kill "References" vectorp gnus-current-headers regexp-quote 4 ""] 5 (#$ . 6292) "p"]) #@15 Kill by Xref. (defalias 'gnus-kill-file-kill-by-xref #[nil "À !… ÂHÃĉƒ>ÈÉ#…BÕʔʕO‰ ˜„ÌÍÎÏ !ÐQ\"ˆ‚ÌÍÑ\"+‡" [vectorp gnus-current-headers 8 0 nil group start xref string-match " \\([^ ]+\\):" 1 gnus-newsgroup-name gnus-kill-file-enter-kill "Xref" " " regexp-quote ":" ""] 6 (#$ . 6492) nil]) #@54 Raise score for all followups to the current author. (defalias 'gnus-kill-file-raise-followups-to-author #[(level) "ÁHŠŠˆebˆÆÇÉQÊ\f!\"ËÌÍ\f$‰cˆÎ !ˆ)ÏÐ\f\"*‡" [gnus-current-headers 2 nil string name gnus-kill-set-kill-buffer read-string "Add " level " to followup articles to: " regexp-quote format "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n" "From" gnus-kill-file-apply-string message "Added temporary score file entry for followups to %s."] 6 (#$ . 6815) "p"]) #@44 Apply current buffer to current newsgroup. (defalias 'gnus-kill-file-apply-buffer #[nil "ƒÁ\n!ƒÃÄ !‡Å ˆÆÇ!‡" [gnus-current-kill-article get-buffer gnus-summary-buffer gnus-kill-file-apply-string buffer-string ding message "No newsgroup is selected."] 2 (#$ . 7319) nil]) #@36 Apply STRING to current newsgroup. (defalias 'gnus-kill-file-apply-string #[(string) "À ÂQŠÃ‹*‡" ["(progn \n" string "\n)" ((byte-code "À !ˆÂÃ\f!@!‡" [pop-to-buffer gnus-summary-buffer eval read-from-string string] 3))] 3 (#$ . 7601) nil]) #@65 Apply sexp before point in current buffer to current newsgroup. (defalias 'gnus-kill-file-apply-last-sexp #[nil "ƒÁ\n!ƒŠÃÄ!ˆ`)`{ŠÆ‹*‡Ç ˆÈÉ!‡" [gnus-current-kill-article get-buffer gnus-summary-buffer forward-sexp -1 string ((byte-code "À !ˆÂÃ\f!@!‡" [pop-to-buffer gnus-summary-buffer eval read-from-string string] 3)) ding message "No newsgroup is selected."] 2 (#$ . 7848) nil]) #@55 Save a kill file, then return to the previous buffer. (defalias 'gnus-kill-file-exit #[nil "À ˆp !ƒÄ !ˆÅ !ˆƒÇ!ˆÈÉ !)‡" [save-buffer killbuf get-buffer gnus-article-buffer bury-buffer delete-windows-on gnus-winconf-kill-file set-window-configuration nil kill-buffer] 2 (#$ . 8241) nil]) #@105 Return the name of a kill file for NEWSGROUP. If NEWSGROUP is nil, return the global kill file instead. (defalias 'gnus-Newsgroup-kill-file #[(newsgroup) "ƒ\nÁ˜ƒ \f†Å\"‡ƒ&ÂÇ!È Q\f†$Å\"‡ÂÉ!Ê Q\f†2Å\"‡" [newsgroup "" expand-file-name gnus-kill-file-name gnus-kill-files-directory "~/News" gnus-use-long-file-name gnus-capitalize-newsgroup "." gnus-newsgroup-directory-form "/"] 4 (#$ . 8546)]) #@33 Remove lines marked with MARKS. (defalias 'gnus-expunge #[(marks) "ŠqˆÁ\n!)‡" [gnus-summary-buffer gnus-summary-remove-lines-marked-with marks] 2 (#$ . 8959)]) #@92 Apply a kill file to the current newsgroup. Returns the number of articles marked as read. (defalias 'gnus-apply-kill-file-internal #[nil "ÀÁ!À\n!D\fGÆÁÁ \n„Ë ˆ \f\fƒsÍ\f@!ƒjƒ?ÑÒ\" ‚cƒcÓ@ÔH\"„Z@ÔH B A‰„DÁ\f)‚\fA‰\f„$) …žÖ‹ˆ×Ø!ˆƒ \fGZ‰Ô=„—ÚÛ\"ˆ)‚žÔ,‡" [gnus-newsgroup-kill-file nil gnus-newsgroup-name kill-files gnus-newsgroup-unreads unreads t gnus-summary-inhibit-highlight beg gnus-newsgroup-kill-headers gnus-newsgroup-headers-hashtb-by-number gnus-make-headers-hashtable-by-number files file-exists-p gnus-newsgroup-headers headers gnus-kill-killed mapcar #[(header) "ÁH‡" [header 0] 2] gnus-member-of-range 0 gnus-newsgroup-killed ((byte-code "Šƒ;Á@!ƒ4ÂÃ@\"ˆÄ@!ˆÅ ˆebˆÆÇÈ:ƒ+É ˆ‚.Ê ˆÂË@\"ˆA‰„)Ƈ" [kill-files file-exists-p message "Processing kill file %s..." find-file gnus-add-current-to-buffer-list nil (byte-code "Àp!‡" [read] 2) ((error)) gnus-kill-parse-gnus-kill-file gnus-kill-parse-rn-kill-file "Processing kill file %s...done"] 4)) gnus-set-mode-line summary nunreads message "Marked %d articles as read"] 4 (#$ . 9126)]) (defalias 'gnus-score-insert-help #[(string alist idx) "ŠÀÁ!ˆÂp!ˆÃ ˆ\fűˆ…/ÇÈ@@ @8#cˆA‰„Ê)‡" [pop-to-buffer "*Score Help*" buffer-disable-undo erase-buffer string ":\n\n" alist format " %c: %s\n" idx nil] 6]) (defalias 'gnus-kill-parse-gnus-kill-file #[nil "ebˆÀ ˆÁ‰`ÁÄʼnƒR\n<„ÆÇ\n\"ˆ\n@È=„4\n@É=„4\n@Ê=ƒD `|ˆË\n!†?Ìcˆ‚\nŠ qˆÁÎψ)‚\nÐ ƒ_ƒ_Ò ˆÓÁ!*‡" [gnus-kill-file-mode nil form beg (byte-code "Àp!‡" [read] 2) ((error)) error "Illegal kill entry (possibly rn kill file?): %s" gnus-kill gnus-raise gnus-lower eval "" gnus-summary-buffer (eval form) ((error)) buffer-modified-p gnus-kill-save-kill-file save-buffer set-buffer-modified-p] 3]) (defalias 'gnus-kill-parse-rn-kill-file #[nil "ebˆÀ ˆÁÂɉm?…hÉÊ!ƒb˔˕{Ì”ƒ0Ì”f‚1ÍΔΕ{ÏÐ\f\"ƒFÑÒÓ\"ˆÔÑ žA†PÕÏÔ\f\"ƒ]Ö‚^×ÃØ%ˆËyˆ‚-‡" [gnus-kill-file-mode ((97 . "") (104 . "") (102 . "from") (58 . "subject")) ((109 . " ") (106 . "X")) nil commands modifier pattern com-to-com mod-to-header looking-at "[ ]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)" 1 2 115 3 string-match "\\+" gnus-kill "from" "." "m" "subject" (gnus-summary-mark-as-unread nil " ") (gnus-summary-mark-as-read nil "X") t] 6]) #@367 If FIELD of an article matches REGEXP, execute COMMAND. Optional 1st argument COMMAND is default to (gnus-summary-mark-as-read nil "X"). If optional 2nd argument ALL is non-nil, articles marked are also applied to. If FIELD is an empty string (or nil), entire article body is searched for. COMMAND must be a lisp expression or a string representing a key sequence. (defalias 'gnus-kill #[(field regexp &optional exe-command all silent) "pŠÁ‹ˆ)Â!ˆ Ä=…E …E?…EÇÈ :ƒ*Ê D‚+ E „6\f…;Ê DC¤\f…CÍC¤!)‡" [old-buffer ((byte-code "À Â\"ˆebˆ Ä †Ælj‰ \n \f‰ <ƒÂ A:„XÎ @ Ç?%ÑUƒOÒ\f A\"VƒÏÇ‚Ï \f¡ˆ‚Ï @‰\nƒÏ\n:ƒ¨\nA Î\n@ Ç?%ÑUƒŸÒ\f \"Vƒµƒ™ A¡ˆ‚µ A‚µ\n\f¡ˆ‚µÎ\n Ç?%ˆ  A‰ ‚ZÎ  Ç?%ˆ.LJ" [switch-to-buffer gnus-summary-buffer norecord regexp current-time-string exe-command (gnus-summary-mark-as-read nil gnus-kill-file-mark) nil prev kdate kill command date kill-list gnus-execute field all 0 gnus-days-between gnus-kill-expiry-days] 7)) switch-to-buffer major-mode gnus-kill-file-mode regexp silent gnus-pp-gnus-kill gnus-kill field quote exe-command all t] 5 (#$ . 11447)]) (defalias 'gnus-pp-gnus-kill #[(object) "À 8:ƒ\"À 8A:ƒ\"À 8@Â=ƒ(À 8A@A:„(ÃÄ !P‡ŠÅÆ!qˆÇp!ˆÈ ˆÉÊ @ A@#cˆÀ 8A@Ë\f‰ ƒk\fƒYÎ\fÏ‚ZÐÄ @!±ˆ A‰ „M*ÑcˆÒ 8ƒ“ÓÒ 8:ƒŠÒ 8@Â=„ŠÔ‚‹ÏÄÒ 8!±ˆÕ 8ƒœÖcˆÑcˆed{×p!ˆ)‡" [2 object quote "\n" prin1-to-string get-buffer-create "*Gnus PP*" buffer-disable-undo erase-buffer format "\n(%S %S\n '(" t first klist nil "" "\n " ")" 3 "\n " "'" 4 "\n t" kill-buffer] 6]) (defalias 'gnus-execute-1 #[(function regexp form header) "ŠÀ\nƒƒ ƒ>À\nƒ: \n!‰;„Å\f!Æ\f\"‰ƒ:;ƒ6É!ˆ‚: ˆ)‚ƒÀ‰‰‰\n \f ÎÏ\nÐH\"ˆÑ ˆÒ\nÐHÓ\"ˆŠqˆebˆÕÀÓ#‰)ƒ‚;ƒ}É!ˆ‚‚Ö!ˆ, *‡" [nil did-kill header function value prin1-to-string string-match regexp form execute-kbd-macro gnus-mark-article-hook gnus-break-pages gnus-last-article gnus-current-article message "Searching for article: %d..." 0 gnus-article-setup-buffer gnus-article-prepare t gnus-article-buffer re-search-forward eval] 5]) #@327 If FIELD of article header matches REGEXP, execute lisp FORM (or a string). If FIELD is an empty string (or nil), entire article body is searched for. If optional 1st argument BACKWARD is non-nil, do backward instead. If optional 2nd argument IGNORE-MARKED is non-nil, articles which are marked as read or ticked are ignored. (defalias 'gnus-execute #[(field regexp form &optional backward ignore-marked) "ŠÀÁ‰‰ƒǘƒÁ‚MÈÉ—P!‰ƒ2Ê\f!ƒ2\fK‚8ËÌ\"ˆ <ƒM @Î=„MÎÁ E „jÏ`Àyˆ`bˆ)Ñ\"†e‰„vÓ?\"‰ƒƒ‚ >ƒM×Ø !‰!ƒMÙ\f \n$ƒM T‚M -‡" [0 nil header article function killed-no field "" intern-soft "gnus-header-" fboundp error "Unknown header field: \"%s\"" form lambda get-text-property p gnus-number gnus-current-article gnus-summary-search-subject backward ignore-marked gnus-newsgroup-kill-headers vectorp gnus-get-header-by-number gnus-execute-1 regexp] 6 (#$ . 13542)]) emacs-19.30/lisp/gnus-mh.elc100666 23053 1 11615 6046561364 14476 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:29:26 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/gnus-mh.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus-mh.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!‡" [require mh-e mh-comp gnus gnus-msg] 2) #@253 Append the current article to an mh folder. If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead. (defalias 'gnus-summary-save-article-folder #[(&optional arg) "À !)‡" [gnus-summary-save-in-folder gnus-default-article-saver gnus-summary-save-article arg] 2 (#$ . 550) "P"]) #@114 Save this article to MH folder (using `rcvstore' in MH library). Optional argument FOLDER specifies folder name. (defalias 'gnus-summary-save-in-folder #[(&optional folder) "À ˆ †ÂÃ\f #È#ÉÊ! Ì  ÎŽÏ!ˆŒ~ˆÑŽÒedÓÔ\"Ö Ö &ˆ, ‰*‡" [mh-find-path folder mh-prompt-for-folder "Save article in" gnus-folder-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-folder t get-buffer-create " *Gnus rcvstore*" errbuf selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer ((byte-code "qˆÁ ÂUƒÃÄ \"ˆ‚ÃÆÇ \"ˆÈ!‡" [errbuf buffer-size 0 message "Article saved in folder: %s" folder "%s" buffer-string kill-buffer] 3)) call-process-region expand-file-name "rcvstore" mh-lib nil] 8 (#$ . 987)]) #@162 Compose reply mail using mh-e. Optional argument YANK means yank original article. The command \[mh-yank-cur-msg] yank the original message into current buffer. (defalias 'gnus-mail-reply-using-mhe #[(&optional yank) "À‰‰‰‰‰‰‰‰‰Á À \n \f Î!ˆpŠŒ„:ÑÒ!†8ÑÓ!Ô ˆÕÖ!†D× ÕØ!†MÙ‰ ƒbÚÛ \"„bÜ P‚d ) ÕÝ!ÕÞ!\fÕß!†x×Õà!\nÕá!Õâ!†Ž  ã!Úä\"„®ÚåÚæ\"O\"„À\fƒº\fçP‚»×P\f\n(*é ˆê †Î×\f†Ô× †ÚÙ $ˆppÀ+,-.„óïðñ\"ˆ‚øïòñ\"ˆ,+Î+!ˆó-!ˆ+Šôõ åÚö \"O÷\nQ\"ˆø \f\"ˆ)\n9ú;\n( <.\f.ƒ=`=þ ˆ=bˆ)ÿ@!‡" [nil current-window-configuration buffer config message-id references orig-to to-userid reply-to to date subject cc from pop-to-buffer gnus-article-buffer gnus-user-login-name getenv "USER" "LOGNAME" gnus-article-show-all-headers gnus-fetch-field "from" "" "subject" "(None)" string-match "^[Rr][Ee]:.+$" "Re: " "reply-to" "cc" "to" "date" "references" "message-id" mail-strip-quoted-names "," 0 "@" ", " mh-show-buffer mh-find-path mh-send-sub mail-buf gnus-mail-buffer draft yank gnus-configure-windows reply force reply-yank switch-to-buffer mh-insert-fields "In-reply-to:" " *at \\| *@ \\| *(\\| *<" "'s message of " nnheader-insert-references mh-sent-from-folder 1 mh-sent-from-msg mh-previous-window-config last mh-yank-cur-msg run-hooks gnus-mail-hook] 13 (#$ . 1766)]) #@57 Forward the current message to another user using mh-e. (defalias 'gnus-mail-forward-using-mhe #[(&optional buffer) "ÀÁ!ÀÃ! †Ç É !\n  Ì ˆÍ\n\f†%Î\n†+Ï$ˆppÐÔÕÖ\"ˆ×ØžA!Ú!ˆÛ!ˆ+ŠdbˆÜcˆÝ !ˆdbˆÞcˆ à!\"ãä!.‡" [read-string "To: " to "Cc: " cc buffer gnus-article-buffer current-window-configuration config gnus-forward-make-subject subject mh-show-buffer mh-find-path mh-send-sub "" "(None)" nil mail-buf gnus-mail-buffer draft gnus-configure-windows reply-yank force eval mail gnus-window-to-buffer pop-to-buffer switch-to-buffer "\n------- Forwarded Message\n\n" insert-buffer "\n------- End of Forwarded Message\n" mh-sent-from-folder 1 mh-sent-from-msg mh-previous-window-config run-hooks gnus-mail-hook] 5 (#$ . 3117)]) #@39 Compose mail other window using mh-e. (defalias 'gnus-mail-other-window-using-mhe #[nil "ÀÁ!ÀÂ!ÀÃ!Ç ˆpÉ ˆÊ \f#ˆp Ì ÎÏ!+‡" [read-string "To: " "Cc: " "Subject: " subject cc to gnus-article-show-all-headers mh-show-buffer mh-find-path mh-send-other-window mh-sent-from-folder 1 mh-sent-from-msg run-hooks gnus-mail-hook] 4 (#$ . 3877)]) #@173 Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. If variable `gnus-use-long-file-name' is nil, it is +News.group. Otherwise, it is like +news/group. (defalias 'gnus-Folder-save-name #[(newsgroup headers &optional last-folder) "†Á\nƒÃ\f!‚Å\f!P‡" [last-folder "+" gnus-use-long-file-name gnus-capitalize-newsgroup newsgroup gnus-newsgroup-directory-form] 3 (#$ . 4229)]) #@173 Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. If variable `gnus-use-long-file-name' is nil, it is +news.group. Otherwise, it is like +news/group. (defalias 'gnus-folder-save-name #[(newsgroup headers &optional last-folder) "†Á\nƒ ‚Ä !P‡" [last-folder "+" gnus-use-long-file-name newsgroup gnus-newsgroup-directory-form] 3 (#$ . 4635)]) emacs-19.30/lisp/gnus-msg.elc100666 23053 1 114532 6046561404 14675 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:29:27 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/gnus-msg.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus-msg.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!‡" [require gnus sendmail gnus-ems] 2) #@32 *Local news organization file. (defvar gnus-organization-file "/usr/lib/news/organization" (#$ . -543)) #@198 *A hook called after preparing body, but before preparing header headers. The default hook (`gnus-inews-insert-signature') inserts a signature file specified by the variable `gnus-signature-file'. (defvar gnus-prepare-article-hook (list (quote gnus-inews-insert-signature)) (#$ . -654)) #@297 *Function that is run after a post buffer has been prepared. It is called with the name of the newsgroup that is posted to. It might be used, for instance, for inserting signatures based on the newsgroup name. (In that case, `gnus-signature-file' and `mail-signature' should both be set to nil). (defvar gnus-post-prepare-function nil (#$ . -948)) #@153 *Hook that is run after a post buffer has been prepared. If you want to insert the signature, you might put `gnus-inews-insert-signature' in this hook. (defvar gnus-post-prepare-hook nil (#$ . -1303)) #@232 *Specifies what to do with Followup-To header. If nil, ignore the header. If it is t, use its value, but ignore `poster'. If it is the symbol `ask', query the user before posting. If it is the symbol `use', always use the value. (defvar gnus-use-followup-to t (#$ . -1511)) #@659 *A variable that contains a function that returns a followup address. The function will be called in the buffer of the article that is being followed up. The buffer will be narrowed to the headers of the article. To pick header headers, one might use `mail-fetch-field'. The function will be called with the name of the current newsgroup as the argument. Here's an example `gnus-followup-to-function': (setq gnus-followup-to-function (lambda (group) (cond ((string= group "mail.list") (or (mail-fetch-field "sender") (mail-fetch-field "from"))) (t (or (mail-fetch-field "reply-to") (mail-fetch-field "from")))))) (defvar gnus-followup-to-function nil (#$ . -1794)) #@446 *A variable that contains a function that returns a reply address. See the `gnus-followup-to-function' variable for an explanation of how this variable is used. This function should return a string that will be used to fill in the header. This function may also return a list. In that case, every list element should be a cons where the first car should be a string with the header name, and the cdr should be a string with the header value. (defvar gnus-reply-to-function nil (#$ . -2511)) #@451 *Save outgoing articles in this file. Initialized from the AUTHORCOPY environment variable. If this variable begins with the character "|", outgoing articles will be piped to the named program. It is possible to save an article in an MH folder as follows: (setq gnus-author-copy "|/usr/local/lib/mh/rcvstore +Article") If the first character is not a pipe, articles are saved using the function specified by the `gnus-author-copy-saver' variable. (defvar gnus-author-copy (getenv "AUTHORCOPY") (#$ . -3012)) #@262 *Non-nil means insert a BCC header in all outgoing articles. This will result in having a copy of the article mailed to yourself. The BCC header is inserted when the post buffer is initialized, so you can remove or alter the BCC header to override the default. (defvar gnus-mail-self-blind nil (#$ . -3530)) #@202 *A function called to save outgoing articles. This function will be called with the same of the file to store the article in. The default function is `rmail-output' which saves in Unix mailbox format. (defvar gnus-author-copy-saver (quote rmail-output) (#$ . -3845)) #@84 *The login name of the user. Got from the function `user-login-name' if undefined. (defvar gnus-user-login-name nil (#$ . -4118)) #@82 *The full name of the user. Got from the NAME environment variable if undefined. (defvar gnus-user-full-name nil (#$ . -4254)) #@350 *Your full, complete e-mail address. Overrides the other Gnus variables if it is non-nil. Here are two example values of this variable: "Lars Magne Ingebrigtsen " and "larsi@ifi.uio.no (Lars Magne Ingebrigtsen)" The first version is recommended, but the name has to be quoted if it contains non-alphanumerical characters. (defvar gnus-user-from-line nil (#$ . -4388)) #@117 *Your signature file. If the variable is a string that doesn't correspond to a file, the string itself is inserted. (defvar gnus-signature-file "~/.signature" (#$ . -4790)) #@316 *A function that should return a signature file name. The function will be called with the name of the newsgroup being posted to. If the function returns a string that doesn't correspond to a file, the string itself is inserted. If the function returns nil, the `gnus-signature-file' variable will be used instead. (defvar gnus-signature-function nil (#$ . -4970)) #@262 *Headers to be generated or prompted for when posting an article. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID. Organization, Lines and X-Newsreader are optional. If you want Gnus not to insert some header, remove it from this list. (defvar gnus-required-headers (quote (From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader)) (#$ . -5342)) #@86 *Headers to be deleted if they already exists and were generated by Gnus previously. (defvar gnus-deletable-headers (quote (Message-ID Date)) (#$ . -5735)) #@56 *Headers to be removed unconditionally before posting. (defvar gnus-removable-headers (quote (NNTP-Posting-Host Bcc Xref)) (#$ . -5897)) #@195 In non-nil, Gnus will attempt to run some checks on outgoing posts. If this variable is t, Gnus will check everything it can. If it is a list, then those elements in that list will be checked. (defvar gnus-check-before-posting (quote (subject-cmsg multiple-headers sendsys message-id from long-lines control-chars size new-text signature)) (#$ . 6041)) #@153 *Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before posting to avoid any confusion. (defvar gnus-delete-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Supersedes:" (#$ . -6402)) #@337 *If non-nil, mail the authors of articles a copy of your follow-ups. If this variable is `ask', the user will be prompted for whether to mail a copy. The string given by `gnus-mail-courtesy-message' will be inserted at the beginning of the mail copy. Mail is sent using the function specified by the `gnus-mail-send-method' variable. (defvar gnus-auto-mail-to-author nil (#$ . -6668)) #@135 *This is inserted at the start of a mailed copy of a posted message. If this variable is nil, no such courtesy message will be added. (defvar gnus-mail-courtesy-message "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n" (#$ . -7062)) #@169 *Function to compose a reply. Three pre-made functions are `gnus-mail-reply-using-mail' (sendmail); `gnus-mail-reply-using-mhe' (MH-E); and `gnus-mail-reply-using-vm'. (defvar gnus-mail-reply-method (quote gnus-mail-reply-using-mail) (#$ . -7344)) #@203 *Function to forward the current message to another user. Three pre-made functions are `gnus-mail-forward-using-mail' (sendmail); `gnus-mail-forward-using-mhe' (MH-E); and `gnus-mail-forward-using-vm'. (defvar gnus-mail-forward-method (quote gnus-mail-forward-using-mail) (#$ . -7599)) #@207 *Function to compose mail in the other window. Three pre-made functions are `gnus-mail-other-window-using-mail' (sendmail); `gnus-mail-other-window-using-mhe' (MH-E); and `gnus-mail-other-window-using-vm'. (defvar gnus-mail-other-window-method (quote gnus-mail-other-window-using-mail) (#$ . -7892)) #@173 *Function to mail a message which is also being posted as an article. The message must have To or Cc header. The default is copied from the variable `send-mail-function'. (defvar gnus-mail-send-method send-mail-function (#$ . -8199)) #@31 *Function to post an article. (defvar gnus-inews-article-function (quote gnus-inews-article) (#$ . -8440)) #@145 *A hook called before finally posting an article. The default hook (`gnus-inews-do-fcc') does FCC processing (ie. saves the article to a file). (defvar gnus-inews-article-hook (list (quote gnus-inews-do-fcc)) (#$ . -8554)) #@145 *A hook called after inserting the headers in an article to be posted. The hook is called from the *post-news* buffer, narrowed to the headers. (defvar gnus-inews-article-header-hook nil (#$ . -8784)) #@66 *A hook called as the last thing after setting up a mail buffer. (defvar gnus-mail-hook nil (#$ . -8991)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÇÆ BÀÈ!„.ÇÈ BÀÉ!„;Ç É BÊËÌÇÍ$ˆÊÎÏ\"ˆÐÆ!ˆÑÓÆ#ˆÑÔÕ#ˆÑÖ×#ˆÑØÙ#ˆÑÚÛ#ˆÑÜÝ#ˆÑÞß#ˆÑàá#ˆÑâã#ˆÑäå#ˆÑæç#ˆÑèË#ˆÑéê#ˆÑëì#ˆÑíî#ˆÑïð#‡" [boundp gnus-post-news-buffer "*post-news*" current-load-list gnus-mail-buffer "*mail*" gnus-summary-send-map nil gnus-article-copy gnus-reply-subject autoload gnus-uu-post-news "gnus-uu" t rmail-output "rmailout" define-prefix-command define-key gnus-summary-mode-map "S" "p" gnus-summary-post-news "f" gnus-summary-followup "F" gnus-summary-followup-with-original "b" gnus-summary-followup-and-reply "B" gnus-summary-followup-and-reply-with-original "c" gnus-summary-cancel-article "s" gnus-summary-supersede-article "r" gnus-summary-reply "R" gnus-summary-reply-with-original "m" gnus-summary-mail-other-window "u" "om" gnus-summary-mail-forward "op" gnus-summary-post-forward "Om" gnus-uu-digest-mail-forward "Op" gnus-uu-digest-post-forward] 5) (defalias 'gnus-number-base36 #[(num len) "ÁWƒ\f\nÁX‚ÁUƒÇÄ\nÅ¥S\"ÆÇ\nŦH!P‡" [len 0 num "" gnus-number-base36 36 char-to-string "zyxwvutsrqponmlkjihgfedcba9876543210"] 5]) #@25 Start composing a mail. (defalias 'gnus-group-mail #[nil " ‡" [gnus-mail-other-window-method] 1 (#$ . 10240) nil]) #@18 Post an article. (defalias 'gnus-group-post-news #[nil "ÀÂÃÀ‰\f$)‡" [nil gnus-newsgroup-name gnus-post-news post gnus-article-buffer] 5 (#$ . 10362) nil]) #@18 Post an article. (defalias 'gnus-summary-post-news #[nil "À ˆÁ \"‡" [gnus-set-global-variables gnus-post-news post gnus-newsgroup-name] 3 (#$ . 10524) nil]) #@113 Compose a followup to an article. If prefix argument YANK is non-nil, original article is yanked automatically. (defalias 'gnus-summary-followup #[(yank &optional yank-articles) "À ˆ ƒ\f @!ˆÃ‹ˆÄÅ`Çyˆ`bˆ)È\"†$ !\n\n \fqˆ ƒPÎÏ!ИƒP Ñ>ƒIÒÓ!„PÔ!‚aÖ×\n \f †`??%*‡" [gnus-set-global-variables yank-articles gnus-summary-goto-subject ((gnus-summary-select-article)) gnus-get-header-by-number get-text-property p 0 gnus-number gnus-current-article gnus-newsgroup-name headers gnus-article-buffer gnus-use-followup-to gnus-fetch-field "followup-to" "poster" (t ask) gnus-y-or-n-p "Do you want to ignore `Followup-To: poster'? " gnus-summary-reply yank gnus-post-news nil] 6 (#$ . 10689) "P"]) #@68 Compose a followup to an article and include the original article. (defalias 'gnus-summary-followup-with-original #[(n) "ÀÁ !\"‡" [gnus-summary-followup t gnus-summary-work-articles n] 4 (#$ . 11406) "P"]) #@51 Compose a followup and do an auto mail to author. (defalias 'gnus-summary-followup-and-reply #[(yank &optional yank-articles) "À ˆÁÃ\f \")‡" [gnus-set-global-variables t gnus-auto-mail-to-author gnus-summary-followup yank yank-articles] 3 (#$ . 11619) "P"]) #@74 Compose a followup, include the original, and do an auto mail to author. (defalias 'gnus-summary-followup-and-reply-with-original #[(n) "ÀÁ !\"‡" [gnus-summary-followup-and-reply t gnus-summary-work-articles n] 4 (#$ . 11884) "P"]) #@31 Cancel an article you posted. (defalias 'gnus-summary-cancel-article #[(n) "À ˆÁ\n!‰…;ÄÅƉ @$ˆÇ ÉŽÊ !ˆÌ *ƒ+Í @\"ˆÏ @!ˆÐ ˆ A‰„ Æ)‡" [gnus-set-global-variables gnus-summary-work-articles n articles gnus-summary-select-article t nil selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer gnus-cancel-news gnus-summary-mark-as-read gnus-canceled-mark gnus-summary-remove-process-mark gnus-article-hide-headers-if-wanted] 6 (#$ . 12123) "P"]) #@167 Compose an article that will supersede a previous article. This is done simply by taking the old article and adding a Supersedes header line with the old Message-ID. (defalias 'gnus-summary-supersede-article #[nil "À ˆÁÂ!ˆÃ\fÅH!—ÃÆ !—˜„ÇÈ!ˆŠ qˆÊ ebˆÌÍÊÂ#ˆÎÏÊÂ#„7ÇÐ!ˆ*ÑÒ\"…Ô ˆÕ !ˆÌÍÊÂ#ƒVÖuˆ‚Ydbˆe`}ˆebˆƒjØ!ˆebˆÙÏÊÂ#„|ÇÐ!ˆ‚‚ÚÛ‰#ˆdbˆcˆ~ˆÝy‡" [gnus-set-global-variables gnus-summary-select-article t mail-strip-quoted-names gnus-current-headers 2 gnus-inews-user-name error "This article is not yours." gnus-article-buffer nil buffer-read-only search-forward "\n\n" re-search-backward "^Message-ID: " "No Message-ID in this article" gnus-post-news post gnus-newsgroup-name erase-buffer insert-buffer -1 gnus-delete-supersedes-headers delete-matching-lines re-search-forward replace-match "Supersedes: " mail-header-separator 1] 4 (#$ . 12635) nil]) (byte-code "ÀÁÂ\"ˆÀÃÂ\"‡" [defalias sendnews gnus-post-news postnews] 3) (defalias 'gnus-copy-article-buffer #[(&optional article-buffer) "ÀÁ!Ã\n!ˆ\n\f>„\n\fB †Ç !…:ÈÇ !!…:Š qˆ~ˆÉ\ned#ˆÊedË\n$))‡" [get-buffer-create " *gnus article copy*" gnus-article-copy buffer-disable-undo gnus-buffer-list article-buffer gnus-article-buffer get-buffer buffer-name copy-to-buffer set-text-properties nil] 5]) #@118 Begin editing a new USENET news article to be posted. Type \[describe-mode] in the buffer to get a list of commands. (defalias 'gnus-post-news #[(post &optional group header article-buffer yank subject) "À !ˆ\nƒ: „:ÄÅÆÇ!@\" \"A@Ê=ƒ: ƒ4ÌÍÎÏ \"J88ž„:ÑÒ!ƒ—\n?…JŠqˆp)B…SÎHÖ ×ƒ… „…\nƒ… „…ÝÞ\"‰  „…áâ! #$ †”†”å& …Ÿç !è\n #Î …¹Ï \"J8éÍÎÏ&\"J88žA†æêë!…æ+…æ#…æŠ#qˆ+ !),&-\nƒùîÊï\"ˆ‚ 0ƒîñï\"ˆ‚ îòï\"ˆó ˆôõ!ˆôö!ˆô÷!ˆ…#øH75\n?…O9ú=ƒ<ûü!‚>9…OŠ#qˆýþ!)†O‰?ƒ~@A!ƒrByˆC?D±ˆ‚~EA!ˆ?cˆ)Fƒ§@G!„§EH!ˆF;ƒ¡F‚¥I cˆJƒ¸EK!ˆJcˆebˆ\nƒ „×LM×N#ˆ×ˆ‚y „îLO×N#ˆ×ˆ‚yLPQR!SQ!ˆøyˆ‚yLPQR!SQ!ˆøyˆ0ƒyŠ0<„0T×!ˆ‚xU0!00ƒxŠV‹ˆ#$À ˆŠ#qˆ@W!)Š#qˆ@X!)YZT×!ˆ*0A0*‚8)[ƒ„[ !ˆ\\]!ˆô^!ˆ^-_ ` B6aå!ˆN‡" [gnus-copy-article-buffer article-buffer gnus-novice-user gnus-expert-user assoc format "%s" gnus-find-method-for-group gnus-newsgroup-name gnus-valid-select-methods post group to-address 5 2 intern-soft gnus-newsrc-hashtb gnus-y-or-n-p "Are you sure you want to post to all of USENET? " gnus-summary-buffer gnus-current-article header current-window-configuration nil real-group winconf from sumart gnus-interactive-post completing-read "Group: " gnus-active-hashtb subject read-string "Subject: " gnus-article-copy mail-reply-buffer "" newsgroup-name gnus-group-real-name gnus-request-post-buffer to-group boundp gnus-followup-to-function gnus-use-followup-to gnus-post-news-buffer gnus-configure-windows force yank followup-yank followup gnus-overload-functions make-local-variable gnus-article-reply gnus-article-check-size gnus-reply-subject 1 gnus-auto-mail-to-author ask y-or-n-p "Also send mail to author? " gnus-fetch-field "reply-to" to mail-fetch-field "To" 0 "Cc: " "\n" mail-position-on-field gnus-mail-self-blind "bcc" "Bcc" user-login-name gnus-author-copy "Fcc" re-search-forward "^Newsgroup:" t "^Subject:" "^" regexp-quote mail-header-separator "$" news-reply-yank-original reverse ((byte-code "qˆÁ‰‰ @$ˆÄ @!‡" [gnus-summary-buffer gnus-summary-select-article nil yank gnus-summary-remove-process-mark] 5)) "message-id" "from" news-reply-yank-from news-reply-yank-message-id gnus-post-prepare-function run-hooks gnus-post-prepare-hook gnus-prev-winconf buffer-size gnus-article-checksum message] 14 (#$ . 13916) (list t)]) #@149 Send a news message. If given a prefix, and the group is a foreign group, this function will attempt to use the foreign server to post the article. (defalias 'gnus-inews-news #[(&optional use-group-method) "„ ÂÄ! ŠÊ ˆ~ˆebˆËÌ!ˆŒeebˆÍÎÏ!ÑQ!ˆÒ”}ˆebˆÍÓÂÔ#ƒŒ`ÍÕÂÔ#ƒPÒ”‚TÖyˆ`}ˆebˆÍ×ÂÔ#ƒjØÙÔ‰#ˆ‚YebˆÍÚÂÔ#ƒ~ØÛÔ‰#ˆ‚mebˆÍÜÂÔ#ƒØÝÔ‰#ˆ)„÷ßà!ßá!‰\"#$‰%ƒöæÛ%\"ƒö$„öæÛ%\"ƒÕ%Ò‰”OC#B#%Ò•ÂO%‚¶%C#BŸ#çè#\"‰\"GÒVƒöebˆé\"걈,ebˆëìÂÔ#ƒ%Œ`ÍÕÂí#ƒÒ”‚d}ˆebˆî×Ù\"ˆebˆîÚÛ\"ˆ)ï0ï1Â21ƒOß1@ÂÔ#„Fó1@0\"01A‰1„30ƒ@4„hõ ˆöÖ÷\"ˆøÖ!ˆ‚@ŠebˆÍùÂÔ#ƒŒÒyˆ`Öyˆ`{2úyˆÒyˆ`Öyˆ`|ˆßû!„£ü=>ƒ£dbˆþÿ 걈Œ~ˆö@A\"ˆBƒñC0„ÆD0ƒñebˆÍÎÏ!ÑQ!ˆÖyˆBcˆ4 ˆebˆEB!ˆØÝÔ‰#ˆ‚õ4 ˆö@F\"ˆebˆ`ÍÎÏ!ÑQ!}ˆebˆÍGÂÔ#ƒ2Ò”ÍÕÂÔ#ƒ)Ò”‚-Öyˆ`|ˆ‚)2ƒ?dbˆ2cˆ),ö@H\"ˆIJ!‰ K=ƒbÔõ ˆ‚¶ ƒ¤ö@L\"ˆ¢ƒ›¢;ƒƒM‚†N¢!ƒ›ŠOqˆPA!ˆ)QÂ!ˆ‚¶Ôõ ˆöÖRS !#ˆ) „ÆTUV!!ˆWX?…àY ˆX…àZX!.‡" [gnus-current-select-method gnus-select-method nil case-fold-search gnus-server-opened server-running gnus-article-reply reply error post-result gnus-start-news-server run-hooks news-inews-hook re-search-forward "^" regexp-quote mail-header-separator "$" 0 "^Newsgroups: +" t "^[^ ]" 1 "\n[ ]+" replace-match " " "[ \n]*,[ \n]*\\|[ ]+" "," ",$" "" gnus-expert-user mail-fetch-field "newsgroups" "followup-to" to groups followup-to newsgroups string-match completing-read "Followups to: (default all groups) " "Followup-To: " "\n" search-forward-regexp "^Followup-To: +" end replace-regexp ("to" "bcc" "cc") types ty fcc-line delete gnus-mail-send-method ding gnus-message "No mailer defined. To: and/or Cc: fields ignored." sit-for "^Fcc: " -1 "message-id" Message-ID gnus-required-headers "Message-ID: " gnus-inews-message-id 5 "Sending via mail..." gnus-mail-courtesy-message "to" "cc" search-forward "Sending via mail...done" "^BCC:" "Posting to USENET..." gnus-inews-article-function use-group-method illegal "Posting to USENET...done" get-buffer buffer-name gnus-summary-buffer gnus-summary-mark-article-as-replied set-buffer-modified-p "Article rejected: %s" gnus-status-message gnus-close-server gnus-find-method-for-group gnus-newsgroup-name gnus-prev-winconf conf bury-buffer set-window-configuration] 6 (#$ . 16373) "P"]) #@34 Check whether the post looks ok. (defalias 'gnus-inews-check-post #[nil "?†ÃŠŒebˆ`ÁÂÃ\f!ÅQ!ˆÆ”}ˆebˆÀÇ!„6ŠÈÉÊË!\"ƒ1ÌÍ!‚2Î)…\fÀÏ!„|ŠÐ„hÁÒÐÎ#ƒhŠÁÂƔƕÓZ{‰PÐÎ#„dÐ)‚@ƒwÌÔÕ\"!‚xÎ*…\fÀÖ!„žŠÁ×ÐÎ#ƒ™ÌÔØƔƕS{\"!‚šÎ)…\fÀÙ!„ÍŠÎÊÛ!‰?†ÉÈÜ\"ƒÂÈÝ\"†ÉÌÔÞ\"!+…\fÀß!†\fŠÎÊà!‰„æÌá!‚ ÈÝ\"„øÌÔâ\"!‚ Èã\"ƒ\nÌÔä\"!‚ Î+*…ÃÀå!„DŠebˆÁÂÃ\f!ÅQ!ˆÐˆiæWƒ3çyÆU„#n†@m†@ÌÔè!!)…ÃÀé!„^ŠÁêÐÎ#ƒYÌë!‚ZÎ)…ÃÀì!„yí îVƒuÌÔïí \"!‚vÎ…ÃÀð!„›í 1@Uƒ—ò 1AUƒ—Ìó!‚˜Î…ÃÀô!†Ãdbˆõ6ÐÎ#„¯·÷`d\"øVƒÂÌÔù÷`d\"\"!‡Î‡" [gnus-check-before-posting re-search-forward "^" regexp-quote mail-header-separator "$" 0 subject-cmsg string-match "^cmsg " mail-fetch-field "subject" gnus-y-or-n-p "The control code \"cmsg \" is in the subject. Really post? " t multiple-headers nil found "^[^ :]+: " 2 format "Multiple %s headers. Really post? " sendsys "^Sendsys:\\|^Version:" "The article contains a %s command. Really post? " message-id case-fold-search "message-id" "@" "@[^\\.]*\\." "The Message-ID looks strange: \"%s\". Really post? " from "from" "There is no From line. Really post? " "The address looks strange: \"%s\". Really post? " "(.*).*(.*)" "The From header looks strange: \"%s\". Really post? " long-lines 80 1 "You have lines longer than 79 characters. Really post? " control-chars "[- -€-Ÿ]" "The article contains control characters. Really post? " size buffer-size 60000 "The article is %d octets long. Really post? " new-text gnus-article-check-size gnus-article-checksum "It looks like there's no new text in your article. Really post? " signature re-search-backward gnus-signature-separator count-lines 5 "Your .sig is %d lines; it should be max 4. Really post? "] 7 (#$ . 18679)]) (defalias 'gnus-article-checksum #[nil "ÀŠm„ g\"Ãuˆ‚) )‡" [0 sum logxor 1] 3]) (defalias 'gnus-check-before-posting #[(type) "?†<ƒ >‚Â?‡" [gnus-check-before-posting type t] 2]) #@31 Cancel an article you posted. (defalias 'gnus-cancel-news #[nil "„\nÁÂ!…¯Ã‰‰‰ÈÉ\n\"„ ËÌ!ˆŠŒÍ ˆebˆÎÏÃÐ#ˆe`}ˆÑÒ!ÑÓ!ÑÔ!ÑÕ!)Ö!—Ö× !—˜„_Ø ˆÙÚÛ\"ˆÃ‚®ÜÝ!qˆÞp!ˆß ˆàáâ áã á\fƒ€ä\fáQ‚å&áç豈Ùéê\"ˆ+ ƒÙéì\"‚ªØ ˆÙíîï\n!#ˆðñp!ˆ-‡" [gnus-expert-user gnus-yes-or-no-p "Do you really want to cancel this article? " nil distribution message-id newsgroups from gnus-member-of-valid post gnus-newsgroup-name error "This backend does not support canceling" gnus-article-show-all-headers search-forward "\n\n" move mail-fetch-field "from" "newsgroups" "message-id" "distribution" mail-strip-quoted-names gnus-inews-user-name ding gnus-message 3 "This article is not yours." get-buffer-create " *Gnus-canceling*" buffer-disable-undo erase-buffer "Newsgroups: " "\n" "Subject: cancel " "Control: cancel " "Distribution: " "" mail-header-separator "This is a cancel message from " ".\n" 5 "Canceling your article..." gnus-inews-article-function "Canceling your article...done" 1 "Cancel failed; %s" gnus-status-message t kill-buffer] 15 (#$ . 20608) nil]) #@56 Post an article in current buffer using NNTP protocol. (defalias 'gnus-inews-article #[(&optional use-group-method) "pÀÁ!~ˆdbˆhÄU„ÄcˆŒebˆeŠÅÆÇ!ÉQ!ˆÊ”)}ˆË ˆÌ ˆÍÎ!ˆ~ˆ)ƒDÐ „DÑ‚”Š\nqˆÒp!ˆÓ ˆÔ !ˆebˆÅÆÇ!ÉQ!ˆÕÖ׉#ˆŠebˆØÙ!†rÍÛ!ˆ*ÍÜ!ˆÝƒŠß!‚Œ \"áp!ˆ)*‡" [get-buffer-create " *Gnus-posting*" tmpbuf artbuf 10 re-search-forward "^" regexp-quote mail-header-separator "$" 0 gnus-inews-remove-headers gnus-inews-insert-headers run-hooks gnus-inews-article-header-hook gnus-article-check-size gnus-inews-check-post illegal buffer-disable-undo erase-buffer insert-buffer-substring replace-match "" t mail-fetch-field "newsgroups" gnus-newsgroup-name gnus-prepare-article-hook gnus-inews-article-hook gnus-request-post use-group-method gnus-find-method-for-group gnus-select-method kill-buffer] 5 (#$ . 21680)]) (defalias 'gnus-inews-remove-headers #[nil "À \n…,ebˆÄÅÆÇ\n@\"—PÈÀ#ƒ$Éyˆ`Êyˆ`|ˆ\nA‰„È*‡" [t gnus-removable-headers headers case-fold-search re-search-forward "^" format "%s" nil 0 1] 6]) #@137 Prepare article headers. Headers already prepared in the buffer are not modified. Headers in `gnus-required-headers' will be generated. (defalias 'gnus-inews-insert-headers #[nil "À Á Â Ã Ä Å‰‰Æ Éʼn‰\n \f ‰ƒkebˆÚÛÜ@!ÝQÅÉ#ƒbÞß”Tà\"ƒbßyˆ`áyˆ`|ˆA‰„=)âã!ƒÁä%!ƒÁâæ!'É èé'\"ƒ’'ß•ÅO‚”'*‰*ƒª+ƒªì+!*˜„Àèí\"ˆ߉”Oîß”ÅOQ)ƒxebˆ@‰\n:ƒÛ\n@\f‚ß\n\fÚÛÜ\f!—ïQÅÉ#ƒýgðU„÷ñcˆòó!ƒo\n:ƒ\nA;ƒ\nA†3ô\nA!ƒ,\nA ‚)õ\f!ƒ,\fJ†3ö÷ø\f\"! ŠnƒNdbˆÜ\f!ù ú±ˆûyˆ‚Uü ɉ#ˆ\f>ƒnßyˆòý!ƒnþ`ß•ÿp$ˆ)A‰„Æâ@!âA!B‰C…ÕDC!@—E —˜?…ÕBƒ³DB!@—E —˜?…ÕebˆÚFÅÉ#ƒËßyˆGcˆßyˆHE ú±.‡" [gnus-inews-date gnus-inews-message-id gnus-inews-organization gnus-inews-user-name gnus-inews-path nil gnus-inews-lines gnus-version gnus-required-headers t elem value header case-fold-search headers X-Newsreader Lines Distribution Newsgroups Subject Path From Organization Message-ID Date gnus-deletable-headers re-search-forward "^" symbol-name ": *" get-text-property 0 gnus-deletable 1 mail-fetch-field "references" get-buffer gnus-article-buffer "subject" subject string-match "^re: *" psubject gnus-reply-subject gnus-simplify-subject-re "@" "_-_" ":" 32 " " looking-at "[ ]*$" fboundp boundp read-from-minibuffer format "Empty header for %s; enter value: " ": " "\n" -1 replace-match "[^:]+: " add-text-properties (gnus-deletable t face italic) "from" "sender" sender from gnus-extract-address-components gnus-inews-real-user-address "^Sender:" "Original-" "Sender: "] 16 (#$ . 22703)]) #@367 Insert a signature file. If `gnus-signature-function' is bound and returns a string, this string is used instead of the variable `gnus-signature-file'. In either case, if the string is a file name, this file is inserted. If the string is not a file name, the string itself is inserted. If you never want any signature inserted, set both of these variables to nil. (defalias 'gnus-inews-insert-signature #[nil "Šƒ  !†\f\n‰…hÄ !„(ÅÆ \"„(ÅÇÈ !\"?…hdbˆ …5ÊËÌÍ#?…hÊËÌÍ#ƒE`d|ˆl„LÎcˆÏcˆÄ !ƒ\\Ð !ˆ‚_ cˆdbˆn†hÎc*‡" [gnus-signature-function gnus-newsgroup-name gnus-signature-file signature file-exists-p string-match " " "^/[^/]+/" expand-file-name mail-signature search-backward "\n-- \n" nil t "\n" "-- \n" insert-file-contents] 5 (#$ . 24282)]) (defalias 'gnus-inews-insert-mime-headers #[nil "ÀÂÃ!†?Äc†?ŠÅ ˆÆÇÈÉ#)ƒ.ÂÊ!„#ËcˆÂÌ!†?Íc‚?ÂÊ!„7ÎcˆÂÌ!†?Ïc)‡" ["" mail-header-separator mail-position-on-field "Mime-Version" "1.0" beginning-of-buffer re-search-forward "[€-ÿ]" nil t "Content-Type" "text/plain; charset=ISO-8859-1" "Content-Transfer-Encoding" "8bit" "text/plain; charset=US-ASCII" "7bit"] 4]) #@389 Process FCC: fields in current article buffer. Unless the first character of the field is `|', the article is saved to the specified file using the function specified by the variable gnus-author-copy-saver. The default function rmail-output saves in Unix mailbox format. If the first character is `|', the contents of the article is send to a program specified by the rest of the value. (defalias 'gnus-inews-do-fcc #[nil "À‰ÁŠŒebˆÅÆ!ˆe`}ˆebˆÇÈÀÁ#ƒ6`ÀˆÉÀxˆ`{\fBÊ”Ëyˆ`|ˆ‚~ˆ\f…š\f@\fAÌÍ \"ƒc ˔˕OÏedÀ‰‰Ñ&ˆ)‚8ÒÓ !!ˆƒ}Õ=„} !ˆ‚8Ö !ƒ× !ƒØ !ˆ‚8Õ ËÁ‰$ˆ‚8-‡" [nil t case-fold-search fcc-file fcc-list search-forward "\n\n" re-search-forward "^FCC:[ ]*" " " 0 1 string-match "^[ ]*|[ ]*\\(.*\\)[ ]*$" program call-process-region shell-file-name "-c" gnus-make-directory file-name-directory gnus-author-copy-saver rmail-output file-readable-p mail-file-babyl-p gnus-output-to-rmail] 9 (#$ . 25411)]) #@19 Return uucp path. (defalias 'gnus-inews-path #[nil "À \n„ A@Ä Q‚\n;ƒ\nÄ Q‚ )‡" [gnus-inews-login-name login-name gnus-use-generic-path gnus-select-method "!"] 3 (#$ . 26348)]) #@61 Return user's network address as "NAME@DOMAIN (FULL-NAME)". (defalias 'gnus-inews-user-name #[nil "À „\n„ „ÄÅ!ƒÆ ÇÈ\n!Q‚  \n \f†L\n ͘ƒ:ÎÏ ÐQ‚KÑÒ\n\"ƒFÓ‚KÎ ÐQP*‡" [gnus-inews-full-name gnus-user-login-name gnus-use-generic-from gnus-local-domain getenv "DOMAINNAME" gnus-inews-login-name "@" gnus-inews-domain-name user-mail-address address full-name gnus-user-from-line "&" " (" user-login-name ")" string-match "[^ ]+@[^ ]+ +(.*)" ""] 5 (#$ . 26539)]) #@132 Return the "real" user address. This function tries to ignore all user modifications, and give as trustworthy answer as possible. (defalias 'gnus-inews-real-user-address #[nil "À Á Q‡" [user-login-name "@" gnus-inews-full-address] 3 (#$ . 27023)]) #@20 Return login name. (defalias 'gnus-inews-login-name #[nil "†\fÁÂ!†\fà ‡" [gnus-user-login-name getenv "LOGNAME" user-login-name] 2 (#$ . 27279)]) #@24 Return full user name. (defalias 'gnus-inews-full-name #[nil "†\fÁÂ!†\fà ‡" [gnus-user-full-name getenv "NAME" user-full-name] 2 (#$ . 27434)]) #@285 Return user's domain name. If optional argument GENERICFROM is a string, use it as the domain name; if it is non-nil, strip off local host name from the domain name. If the function `system-name' returns full internet name and the domain is undefined, the domain name is got from it. (defalias 'gnus-inews-domain-name #[(&optional genericfrom) "„ „ÂÃ!ƒlÄ ;ƒ†6ÂÃ!†6 †6ÅÆ\f\"ƒ3\fÇ•ÈO†6ÉÊ! ÅÆ\f\"ƒG\flj”O†H\f\f ÇÍOΘƒ[ ÍÈO „h\fÎ Q‚j +‡ÅÆÄ \"ƒwÄ ‡ÅÐ\"TÈO‡" [genericfrom gnus-local-domain getenv "DOMAINNAME" system-name string-match "\\." 0 nil read-string "Domain name (no host): " domain host 1 "." user-mail-address "@"] 4 (#$ . 27588)]) (defalias 'gnus-inews-full-address #[nil "À Á ÂÆÇ\f\"ƒ\f‚&ÆÈÉ\f!P \"ƒ\" ‚&\fÊ Q+‡" [gnus-inews-domain-name system-name t case-fold-search system domain string-match "\\." "^" regexp-quote "."] 4]) #@38 Generate unique Message-ID for user. (defalias 'gnus-inews-message-id #[nil "ÀÁ Âà ݇" ["<" gnus-inews-unique-id "@" gnus-inews-full-address ">"] 5 (#$ . 28471)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-unique-id-char nil current-load-list] 2) (defalias 'gnus-inews-unique-id #[nil "†ÁÂÃ!ÄÅÆ\"S\"TǦÈÉ!ƒÉ ‚Ê \fÍ>ƒDÎ —ÐÑ\"ƒ>Ò”ÓIˆ‚,)‚IÔÕ Ö\"Ô @ÄצØ\"\\Ù\"Ô A@Ä×¥Ø\"\\Ù\"ÚR)‡" [gnus-unique-id-char logand random t lsh 1 20 625 fboundp current-time (12191 46742 287898) tm system-type (ms-dos emx vax-vms) gnus-inews-login-name user string-match "[^a-z0-9_]" 0 95 gnus-number-base36 user-uid -1 25 16 4 ".fsf"] 7]) #@22 Current time string. (defalias 'gnus-inews-date #[nil "ÀÁ  \"‡" [timezone-make-date-arpa-standard current-time-string current-time-zone] 3 (#$ . 29117)]) #@333 Return user's organization. The ORGANIZATION environment variable is used if defined. If not, the variable `gnus-local-organization' is used instead. If it is a function, the function will be called with the current newsgroup name as the argument. If this is a file name, the contents of this file will be used as the organization. (defalias 'gnus-inews-organization #[nil "ÀÁ!†$\nƒ\n9ƒÃ\n!ƒ\n\f!‚\n†$ †$Ɖ;…zGÈV…zÉ!„KÊË\"„KÊÌ\"?…zŠÍ ˆÉ!ƒ^Î!ˆ‚bcˆebˆÏÐÑÒ#ƒvÓËÒ‰#ˆ‚eed{))‡" [getenv "ORGANIZATION" gnus-local-organization fboundp gnus-newsgroup-name gnus-organization-file "~/.organization" organization 0 file-exists-p string-match " " "^/usr/lib/" gnus-set-work-buffer insert-file-contents re-search-forward " *\n *" nil t replace-match] 5 (#$ . 29279)]) #@54 Count the number of lines and return numeric string. (defalias 'gnus-inews-lines #[nil "ŠŒ~ˆebˆÀÁ !ÄQ!ˆÅyˆÆÇ`d\"!*‡" [re-search-forward "^" regexp-quote mail-header-separator "$" 1 int-to-string count-lines] 4 (#$ . 30075)]) #@175 Reply mail to news author. If prefix argument YANK is non-nil, original article is yanked automatically. Customize the variable gnus-mail-reply-method to use another mailer. (defalias 'gnus-summary-reply #[(yank &optional yank-articles) "À ˆ ƒ\f @!ˆÃ ˆ\fÅ!ˆ † ??!)‡" [gnus-set-global-variables yank-articles gnus-summary-goto-subject gnus-summary-select-article gnus-newsgroup-name bury-buffer gnus-article-buffer gnus-mail-reply-method yank] 2 (#$ . 30308) "P"]) #@119 Reply mail to news author with original article. Customize the variable gnus-mail-reply-method to use another mailer. (defalias 'gnus-summary-reply-with-original #[(n) "ÀÁ !\"‡" [gnus-summary-reply t gnus-summary-work-articles n] 4 (#$ . 30789) "P"]) #@117 Forward the current message to another user. Customize the variable gnus-mail-forward-method to use another mailer. (defalias 'gnus-summary-mail-forward #[(post) "À ˆÁ ˆÂ ˆ \fƒÅ!‚!)‡" [gnus-set-global-variables gnus-summary-select-article gnus-copy-article-buffer gnus-newsgroup-name post gnus-forward-using-post gnus-article-copy gnus-mail-forward-method] 2 (#$ . 31048) "P"]) #@45 Forward the current article to a newsgroup. (defalias 'gnus-summary-post-forward #[nil "ÀÁ!‡" [gnus-summary-mail-forward t] 2 (#$ . 31443) nil]) #@89 Format string to insert in nastygrams. The current group name will be inserted at "%s". (defvar gnus-nastygram-message "The following article was inappropriately posted to %s.\n" (#$ . 31594)) #@56 Send a nastygram to the author of the current article. (defalias 'gnus-summary-mail-nastygram #[(n) "„\nÁÂ!… Å!ˆqˆÈ \f\"cˆÊ )‡" [gnus-expert-user gnus-y-or-n-p "Really send a nastygram to the author of the current article? " gnus-newsgroup-name group gnus-summary-reply-with-original n gnus-mail-buffer format gnus-nastygram-message gnus-mail-send-and-exit] 3 (#$ . 31793) "P"]) #@109 Compose mail in other window. Customize the variable `gnus-mail-other-window-method' to use another mailer. (defalias 'gnus-summary-mail-other-window #[nil "À ˆ \n )‡" [gnus-set-global-variables gnus-newsgroup-name gnus-mail-other-window-method] 1 (#$ . 32189) nil]) (defalias 'gnus-mail-reply-using-mail #[(&optional yank to-address) "ŠqˆÁ\n!p ABÄ Å‰‰‰‰‰‰‰‰‰‰ \n \f Ô!qˆÖ ˆ×Ø!ˆ×Ù!ˆÚ …]Û ÜV…]ÝÞ!??…eß ˆŠà ˆŒ!qˆâ ˆãä!ƒ‚$ƒ‚$!åæ!åç!†‘(éHƒµêë\"‰,ƒ¬Ü,O‚®íQ\f)åî! åï!†Áðêñ\"„ÑòPåó! åô! åõ!\n~ˆ)†éö7)\n†òø9ƒ\"<ƒ\"úû\"‰ƒ\"‰…üAQý\"‚ÿþ?†Oƒ8;„8‚O†O †O†O †O@\fÅ!Å&ˆAB!ˆCDE!!ˆFGH\"ˆƒ¸<ƒ¸ebˆIJÅK#ˆÜyˆLyˆƒ¸@@M@AN±ˆA‰„žO \n\"ˆebˆIPQR!SQ!ˆLyˆT„îUVW\"ˆ‚^`ÅXYT<„ŠZÅ!ˆ)[„N\\„N]^!ˆ‚NTƒN_‹ˆŠà ˆZÅ!ˆ`X)[„A\\„A]^!ˆXbˆTA‰T„Ybˆ*U`W\"ˆ]a!.‡" [gnus-summary-buffer gnus-group-real-name gnus-newsgroup-name gnus-article-current current-window-configuration nil elt sendto follow-to sender message-id references message-of reply-to date subject from winconf cur group get-buffer-create gnus-mail-buffer mail-mode make-local-variable gnus-article-reply gnus-prev-winconf buffer-modified-p buffer-size 0 gnus-y-or-n-p "Unsent article being composed; erase it? " erase-buffer gnus-copy-article-buffer gnus-article-copy gnus-narrow-to-headers boundp gnus-reply-to-function mail-fetch-field "from" "date" gnus-current-headers 3 string-match " *at \\| *@ \\| *(\\| *<" stop-pos "'s message of " "sender" "subject" "Re: none" "^[Rr][Ee]:" "Re: " "reply-to" "references" "message-id" "(nobody)" news-reply-yank-from "(unknown Message-ID)" news-reply-yank-message-id assoc "To" ", " delq mail-setup to-address "" auto-save-mode auto-save-default use-local-map copy-keymap mail-mode-map local-set-key "" gnus-mail-send-and-exit re-search-forward "^To:" t 1 ": " "\n" nnheader-insert-references "^" regexp-quote mail-header-separator "$" yank gnus-configure-windows reply force end last mail-yank-original mail-yank-hooks mail-citation-hook run-hooks news-reply-header-hook ((byte-code "qˆÁ‰‰ @$ˆÄ @!‡" [gnus-summary-buffer gnus-summary-select-article nil yank gnus-summary-remove-process-mark] 5)) reply-yank gnus-mail-hook] 15]) (defalias 'gnus-mail-yank-original #[nil "ŠÀÁ!ˆ)\n† †ÄÅ!‡" [mail-yank-original nil mail-yank-hooks mail-citation-hook run-hooks news-reply-header-hook] 2 nil nil]) (defalias 'gnus-mail-send-and-exit #[nil " ÄÅ!ˆÆ!…: ¢ƒ3 ¢;ƒÆ‚È ¢!ƒ3 @qˆ Aƒ3É A!ˆ\n…:Ê\n!*‡" [gnus-article-reply gnus-prev-winconf winconf reply mail-send-and-exit nil get-buffer gnus-group-buffer buffer-name gnus-summary-mark-article-as-replied set-window-configuration] 2 nil nil]) (defalias 'gnus-forward-make-subject #[(buffer) "ŠqˆÁÂÃÄÅ!@!\">ƒÈÉ!‚ÊÈË!†%ÌR)‡" [buffer "[" mail assoc symbol-name gnus-find-method-for-group gnus-newsgroup-name gnus-valid-select-methods gnus-fetch-field "From" "] " "Subject" ""] 6]) (defalias 'gnus-forward-insert-buffer #[(buffer) "dbÁcˆÂ !ˆdbˆÄcˆbˆÅ`Æ\"‰…-bˆÅ`Æ\"†(d|ˆ‚)‡" [beg "------- Start of forwarded message -------\n" insert-buffer buffer "------- End of forwarded message -------\n" next-single-property-change invisible] 4]) #@57 Forward the current message to another user using mail. (defalias 'gnus-mail-forward-using-mail #[(&optional buffer) "†p Ä ! qˆÆlj #ˆÈÉÊ !!ˆËÌÍ\"ˆÎÏ!ˆ Ð !ˆebˆÑÒÇÓ#ˆÔÕÖ\"ˆ×Ø!ˆ×Ù!+‡" [buffer forward-buffer current-window-configuration winconf gnus-forward-make-subject subject mail nil use-local-map copy-keymap current-local-map local-set-key "" gnus-mail-send-and-exit make-local-variable gnus-prev-winconf gnus-forward-insert-buffer re-search-forward "^To: " t gnus-configure-windows mail-forward force run-hooks gnus-mail-forward-hook gnus-mail-hook] 4 (#$ . 35525)]) (defalias 'gnus-forward-using-post #[(&optional buffer) "Š†p !ÄÆÇĉ‰‰ &ˆŠÈ !ˆÉÊ!-‡" [buffer forward-buffer gnus-forward-make-subject subject nil gnus-newsgroup-name gnus-post-news post gnus-forward-insert-buffer run-hooks gnus-mail-forward-hook] 7]) #@39 Compose mail other window using mail. (defalias 'gnus-mail-other-window-using-mail #[nil "À Âɉ‰‰Ä !&ˆÆÇÈ !!ˆÉÊË\"ˆÌÍ!ˆ  ÎÏ!ˆÐÑÒ\")‡" [current-window-configuration winconf mail-other-window nil get-buffer gnus-article-buffer use-local-map copy-keymap current-local-map local-set-key "" gnus-mail-send-and-exit make-local-variable gnus-prev-winconf run-hooks gnus-mail-hook gnus-configure-windows summary-mail force] 8 (#$ . 36370)]) #@91 Send a reply to the address near point. If YANK is non-nil, include the original article. (defalias 'gnus-article-mail #[(yank) "ŠÀÁÂÃ#ˆ`T)ŠÄÁÂÃ#ˆ`S){‰…%Æ!ˆ \")‡" [re-search-backward "[ \n]" nil t re-search-forward address switch-to-buffer gnus-summary-buffer gnus-mail-reply-method yank] 6 (#$ . 36815) "P"]) #@44 Send a bug report to the Gnus maintainers. (defalias 'gnus-bug #[nil "À  ˆÃÄ!ˆÅ ˆcˆebˆÇÈ!ˆÅ ˆÉ ˆÊ ̉‰‰‰&ˆÍ!ˆÏÐ!ˆ ÑÒ!!ˆÔÕÖ\"ˆebˆ×ØÙ!ÛQ!ˆÜyˆÝÞß à #cˆá ˆebˆâãÌä#ˆåæ!)‡" [current-window-configuration winconf delete-other-windows switch-to-buffer "*Gnus Help Bug*" erase-buffer gnus-bug-message pop-to-buffer "*Gnus Bug*" mail-mode mail-setup gnus-maintainer nil auto-save-mode auto-save-default make-local-variable gnus-prev-winconf use-local-map copy-keymap mail-mode-map local-set-key "" gnus-bug-mail-send-and-exit re-search-forward "^" regexp-quote mail-header-separator "$" 1 format "%s\n%s\n\n\n\n\n" gnus-version emacs-version gnus-debug search-forward "Subject: " t message ""] 7 (#$ . 37140) nil]) #@32 Send the bug message and exit. (defalias 'gnus-bug-mail-send-and-exit #[nil "ÀÁ!ƒ\nÂÁ!ˆÃ ‡" [get-buffer "*Gnus Help Bug*" kill-buffer gnus-mail-send-and-exit] 2 (#$ . 37865) nil]) #@139 Attemps to go through the Gnus source file and report what variables have been changed. The source file has to be in the Emacs load path. (defalias 'gnus-debug #[nil "ÀÁ‰‰‰‰ÈÉ!ˆÊË!ˆŠÌÍ!qˆÎp!ˆƒŠÏ ˆ ƒ @ƒJ @;ƒJÑÒ @!@P‰!„Q A‰‚,ÁÓ!ˆebˆÔÕÁÖ#„i×Ø\"ˆe`}ˆebˆÁÙÚ‰ƒ+ÁÛ܈‚pA‰„%Ýp!ˆ)Þcˆ ƒÝß @!ƒÍàá @! @J‰:„¼\n9ƒÀ\nÁ=„À\nÖ=„Àâ‚Áãä @J!屈‚Öæá @!屈 A‰„–çcˆebˆÔèÁÖ#…ôéêÖ‰#ˆ‚ã.‡" [("gnus.el" "gnus-msg.el" "gnus-score.el") nil sym olist expr dirs file files message "Please wait while we snoop your variables..." sit-for 0 get-buffer-create " *gnus bug info*" buffer-disable-undo erase-buffer load-path file-exists-p file-name-as-directory insert-file-contents re-search-forward "^;;* *Internal variables" t error "Malformed sources in file %s" (byte-code "Àp!‡" [read] 2) ((error)) (byte-code "@Á=ƒ+Â8;ƒ+ÃÄ8!ƒ#ÅÆ8!Ä8Jš„+A@BÁ‡" [expr defvar 3 boundp 1 eval 2 olist] 3) ((error)) kill-buffer "------------------- Environment follows -------------------\n\n" boundp "(setq " symbol-name " '" " " prin1-to-string ")\n" ";; (makeunbound '" "\n\n" "[€]" replace-match ""] 7 (#$ . 38053) nil]) (byte-code "À ˆÁÂ!‡" [gnus-ems-redefine provide gnus-msg] 2) emacs-19.30/lisp/gnus-score.elc100666 23053 1 65253 6046561431 15207 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:29:32 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/gnus-score.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus-score.el' was compiled for Emacs 19.29 or later")) (require (quote gnus)) #@63 *Number of days before unused score file entries are expired. (defvar gnus-score-expiry-days 7 (#$ . -508)) #@59 *All orphans get this score added. Set in the score file. (defvar gnus-orphan-score nil (#$ . -622)) #@29 *Alist of marks and scores. (defvar gnus-default-adaptive-score-alist (quote ((gnus-kill-file-mark) (gnus-unread-mark) (gnus-read-mark (from 3) (subject 30)) (gnus-catchup-mark (subject -10)) (gnus-killed-mark (from -1) (subject -20)) (gnus-del-mark (from -2) (subject -15)))) (#$ . -729)) #@65 *Have the score entry functions pretend that they are a keymap. (defvar gnus-score-mimic-keymap nil (#$ . -1025)) #@395 *Number that says how long a match has to be before using substring matching. When doing adaptive scoring, one normally uses fuzzy or substring matching. However, if the header one matches is short, the possibility for false positives is great, so if the length of the match is less than this variable, exact matching will be used. If this variable is nil, exact matching will always be used. (defvar gnus-score-exact-adapt-limit 10 (#$ . -1146)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ Ä BÀÆ!„!ÂÆ BÀÇ!„.ÂÇ B‡" [boundp gnus-score-help-winconf nil current-load-list gnus-adaptive-score-alist gnus-default-adaptive-score-alist gnus-score-trace gnus-score-edit-buffer] 2) #@685 Alist containing score information. The keys can be symbols or strings. The following symbols are defined. touched: If this alist has been modified. mark: Automatically mark articles below this. expunge: Automatically expunge articles below this. files: List of other score files to load when loading this one. eval: Sexp to be evaluated when the score file is loaded. String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) where HEADER is the header being scored, MATCH is the string we are looking for, TYPE is a flag indicating whether it should use regexp or substring matching, SCORE is the score to add and DATE is the date of the last successful match. (defvar gnus-score-alist nil (#$ . 1825)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÇÈɉÊ%ˆÇËÌ\"ˆÀÍ!„GÂ Í BÎÍ!ˆÏÑÍ#ˆÏ ÒÓ#ˆÏ ÔÕ#ˆÏ Ö×#ˆÏ ØÙ#ˆÏ ÚÛ#ˆÏ ÜÝ#ˆÏ Þß#ˆÏ àá#ˆÏ âã#ˆÏ äå#‡" [boundp gnus-score-cache nil current-load-list gnus-scores-articles gnus-header-index gnus-score-index autoload gnus-uu-ctl-map "gnus-uu" keymap appt-select-lowest-window "appt.el" gnus-summary-score-map define-prefix-command define-key gnus-summary-mode-map "V" "s" gnus-summary-set-score "a" gnus-summary-score-entry "S" gnus-summary-current-score "c" gnus-score-change-score-file "m" gnus-score-set-mark-below "x" gnus-score-set-expunge-below "e" gnus-score-edit-alist "f" gnus-score-edit-file "t" gnus-score-find-trace "C" gnus-score-customize] 6) #@196 Make a score entry based on the current article. The user will be prompted for header to score on, match type, permanence, and the string to be used. The numerical prefix will be used as score. (defalias 'gnus-summary-lower-score #[(&optional score) "ÀÁ\n![!‡" [gnus-summary-increase-score gnus-score-default score] 3 (#$ . 3281) "P"]) #@196 Make a score entry based on the current article. The user will be prompted for header to score on, match type, permanence, and the string to be used. The numerical prefix will be used as score. (defalias 'gnus-summary-increase-score #[(&optional score) "À ˆÁ\n!‰ÄWƒÅ‚Æ ÄVÉ\nË\fÍÎ ÏEÐÑEÕÕÕÕÕÕÕ„‹ƒYÝÞ!ˆßà\"ˆ‚mßáƒdâ‚eãäå\næ##ˆç ‰èU„~éUƒBÕêë\nÞ#ˆ‚Bìí!ƒŸîí!ˆ/ƒŸð/!ˆ—\nž‰„Åñ ˆòƒÁßó#ˆ‚Åßæ!ˆ„Ó—U„ñƒãßó#ˆ‚çßæ!ˆÕÎ ‚K„@ƒ\nÝÞ!ˆßô#ˆ‚\"ßõƒâ‚ãA@äö\fæ#$ˆç ‰èU„3éUƒñÕê÷\fø#ˆ‚ñìí!ƒT/ƒPð/!ˆîí!ˆÞ—\fž8‰„|ñ ˆƒußó#ˆ‚yßæ!ˆò„Š—U„§ƒœßù$ˆ‚ ßæ!ˆÎ ‚K„ôƒÂÝÞ!ˆßú$ˆ‚ÖßûƒÍâ‚Îãäüæ##ˆç ‰èU„çéUƒ§Õêýø#ˆ‚§ìí!ƒ/ƒð/!ˆîí!ˆƒßù%ˆ‚ ßæ!ˆžA@‰„Kñ ˆòƒGßþ%ˆ‚Kßæ!ˆ?…“ÿA@ø8昃cæ‚r@ø8†qA@!\nA=?…~\nB=?…ŠC8?&.‡" [gnus-set-global-variables gnus-score-default score nscore 0 76 73 prefix increase ((97 "from" nil nil string) (115 "subject" nil nil string) (98 "body" "" nil body-string) (104 "head" "" nil body-string) (105 "message-id" nil t string) (116 "references" "message-id" t string) (120 "xref" nil nil string) (108 "lines" nil nil number) (100 "date" nil nil date) (102 "followup" nil nil string)) char-to-header ((115 s "substring" string) (101 e "exact string" string) (102 f "fuzzy string" string) (114 r "regexp string" string) (115 s "substring" body-string) (114 s "regexp string" body-string) (98 before "before date" date) (97 at "at date" date) (110 now "this date" date) (60 < "less than number" number) (62 > "greater than number" number) (61 = "equal to number" number)) char-to-type 116 current-time-string "temporary" (112 perm "permanent") (105 now "immediate") char-to-perm gnus-score-mimic-keymap mimic nil hchar entry temporary tchar pchar end type sit-for 1 message "%c-" "%s header (%s?): " "Increase" "Lower" mapconcat #[(s) "À @!‡" [char-to-string s] 2] "" read-char 63 8 gnus-score-insert-help "Match on header" get-buffer "*Score Help*" kill-buffer gnus-score-help-winconf set-window-configuration ding t "%c %c" "%c %c-" "%s header '%s' with match type (%s?): " #[(s) "À 8 8=ƒÄ @!‡Å‡" [4 entry 3 s char-to-string ""] 3] "Match type" 2 "%c %c %c" "%c %c %c-" "%s permanence (%s?): " #[(s) "À @!‡" [char-to-string s] 2] "Match permanence" "%c %c %c %c" gnus-summary-score-entry gnus-summary-header s perm 3] 9 (#$ . 3625) "P"]) (defalias 'gnus-score-insert-help #[(string alist idx) "À ŠÂÃ!qˆÄp!ˆÅp!ˆÆ ˆȱˆÉ\nË̉‰‰ ƒS@8GV„JA‰„5Õ\\Ö ¥Ö ¥\nƒªW„~Ë×É!ˆØcˆÙZÚÛ!ÜQ Í \n@@\n@8#cˆ\nA\nT‚g.Ý ˆÞ ˆßÃ!ˆà ˆáâ#!!)‡" [current-window-configuration gnus-score-help-winconf get-buffer-create "*Score Help*" buffer-disable-undo delete-windows-on erase-buffer string ":\n\n" -1 alist 0 nil format pad width n i list max idx 4 window-width delete-char "\n" 3 "%c: %-" int-to-string "s" appt-select-lowest-window split-window pop-to-buffer shrink-window-if-larger-than-buffer select-window get-buffer-window gnus-summary-buffer] 8]) (defalias 'gnus-summary-header #[(header &optional no-err) "À`Âyˆ` bˆ)Ã\"†\fʼnƒEÈ!‰ƒ9É!ƒ9Ê \f\"A@H‚M ?…MÎÏ!‚M …MÎÐ!*‡" [get-text-property p 0 gnus-number gnus-current-article nil headers article gnus-get-header-by-number vectorp assoc header gnus-header-index no-err error "Pseudo-articles can't be scored" "No article on current line"] 5]) #@395 Enter score file entry. HEADER is the header being scored. MATCH is the string we are looking for. TYPE is the match type: substring, regexp, exact, fuzzy. SCORE is the score to add. DATE is the expire date, or nil for no expire, or 'now for immediate expire. If optional argument `PROMPT' is non-nil, allow user to edit match. If optional argument `SILENT' is nil, show effect of score entry. (defalias 'gnus-summary-score-entry #[(header match type score date &optional prompt silent) "Á=ƒÂÂ=„Ã=„Ä=ƒ@ ƒ; ÁÈÉ\"ƒ5Ê•ÄO‚7*‚<Ë‚JÌ=ƒJÍ !Î!—ƒÒÓÔÖ=ƒhׂs;ƒrØ‚sÙÊWƒ€Ú‚Û$ §ƒÜ !‚Ž \"ÝÞ\"8ÊYƒ¸àÞ\"8á=ƒ¸\"„¸ã $ˆàÞ\"8ä=ƒÉå !Ö=?…‰&UƒÜăñ …ìç!F‚ƒ ç!E‚ƒ  D‚ Cè!Ä)*+*ƒoÞ *\"‰)ƒoì)8ì+8=ƒoà)8§ƒFà+8§„Tà)8„oà+8„o)A)A@†`&+A@†i&\\ ˆ‚„í*ƒ+*B‚‚+C\"ˆ+íîï\"*‡" [type t r s nil match subject case-fold-search string-match "^re: *" 0 "" f gnus-simplify-subject-fuzzy gnus-score-default score header prompt read-string format "Match %s on %s, %s: " date now "now" "temp" "permanent" "lower" "raise" int-to-string 1 assoc gnus-header-index 2 gnus-score-string silent gnus-summary-score-effect gnus-score-integer string-to-int gnus-score-interactive-default-score gnus-day-number gnus-score-get elem old new 3 gnus-score-set touched (t)] 7 (#$ . 7149) (list (completing-read "Header: " gnus-header-index (lambda (x) (fboundp (nth 2 x))) t) (read-string "Match: ") (if (y-or-n-p "Use regexp match? ") (quote r) (quote s)) (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) (cond ((not (y-or-n-p "Add to score file? ")) (quote now)) ((y-or-n-p "Expire kill? ") (current-time-string)) (t nil)))]) #@204 Simulate the effect of a score file entry. HEADER is the header being scored. MATCH is the string we are looking for. TYPE is a flag indicating if it is a regexp or substring. SCORE is the score to add. (defalias 'gnus-summary-score-effect #[(header match type score) "Š;ƒ GÁV„ÂÃ!ˆebˆ\fÅ=ƒ Æ!‚.\fƒ(‚.ÇÈ!ÉQ\nm?…hË\fÍ\"Ήƒa\fÅ=ƒSÆ!\n˜‚YÑ\n\"ƒaÒ!ˆ*Ôyˆ‚0*‡" [match 0 error "No match" type f gnus-simplify-subject-fuzzy "\\`.*" regexp-quote ".*\\'" regexp gnus-summary-header header noerr t case-fold-search content string-match gnus-summary-raise-score score 1] 4 (#$ . 8895) (list (completing-read "Header: " gnus-header-index (lambda (x) (fboundp (nth 2 x))) t) (read-string "Match: ") (y-or-n-p "Use regexp match? ") (prefix-numeric-value current-prefix-arg))]) (defalias 'gnus-summary-score-crossposting #[(score date) "ÀÁ!ÂÉ„ÇÈ!ˆÉÊ #…>•˔˕O‰\f˜„ÍÁÎ\fÏQÃÒ&ˆ‚+‡" [gnus-summary-header "xref" 0 nil group start xref error "This article is not crossposted" string-match " \\([^ ]+\\):" 1 gnus-newsgroup-name gnus-summary-score-entry " " ":" score date t] 8]) #@61 Automatically mark articles with score below SCORE as read. (defalias 'gnus-score-set-mark-below #[(score) "† † ÂÃÄC\"ˆÃÅÆ\"ˆÈ ‡" [score gnus-summary-default-score 0 gnus-score-set mark touched (t) gnus-summary-mark-below gnus-summary-update-lines] 3 (#$ . 10015) (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) (string-to-int (read-string "Mark below: "))))]) #@56 Automatically expunge articles with score below SCORE. (defalias 'gnus-score-set-expunge-below #[(score) "† † ÂÃÄC\"ˆÃÅÆ\"‡" [score gnus-summary-default-score 0 gnus-score-set expunge touched (t)] 3 (#$ . 10420) (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) (string-to-int (read-string "Expunge below: "))))]) (defalias 'gnus-score-set #[(symbol value &optional alist) "† †ÂÃ\f!!ˆ Å\"ÈÉ\"†?ƒ+\n¡‚?„5ËÌ!‚?\nBAB¡*‡" [alist gnus-score-alist gnus-score-load gnus-score-file-name gnus-newsgroup-name assoc symbol entry gnus-score-get read-only value error "Empty alist"] 3]) (defalias 'gnus-score-get #[(symbol &optional alist) "À \n† †ÄÅ!!ˆ \"A‡" [assoc symbol alist gnus-score-alist gnus-score-load gnus-score-file-name gnus-newsgroup-name] 5]) #@29 Change current score alist. (defalias 'gnus-score-change-score-file #[(file) "À !ˆÂÃ!‡" [gnus-score-load-file file gnus-set-mode-line summary] 2 (#$ . 11239) (list (read-file-name "Edit score file: " gnus-kill-files-directory))]) #@31 Edit the current score alist. (defalias 'gnus-score-edit-alist #[(file) "À  !ƒ\fÄ ˆÅ!ÈÉ!ˆÊ ˆËÌ!ˆ \f)ÍÎÏÐ!\"‡" [current-window-configuration winconf buffer-name gnus-summary-buffer gnus-score-save find-file-noselect file gnus-score-edit-buffer gnus-configure-windows edit-score gnus-score-mode make-local-variable gnus-prev-winconf gnus-message 4 substitute-command-keys "\\\\[gnus-score-edit-done] to save edits"] 4 (#$ . 11475) (list gnus-current-score-file)]) #@20 Edit a score file. (defalias 'gnus-score-edit-file #[(file) "À !ƒ  ˆÃ Å!ÈÉ!ˆÊ ˆËÌ!ˆ\f\f)ÍÎÏÐ!\"‡" [buffer-name gnus-summary-buffer gnus-score-save current-window-configuration winconf find-file-noselect file gnus-score-edit-buffer gnus-configure-windows edit-score gnus-score-mode make-local-variable gnus-prev-winconf gnus-message 4 substitute-command-keys "\\\\[gnus-score-edit-done] to save edits"] 4 (#$ . 11972) (list (read-file-name "Edit score file: " gnus-kill-files-directory))]) (defalias 'gnus-score-load-file #[(file) "†ÁÂÃÄÂ!P !\"ƒ † P!Æ \"  \nË\fË ƒ=A ‚qËÏ ! Ð ž„TÐËD B \nƒhÑ ž„hÑÒD B  BBÒÓÔ \">ƒ€ C\fÕÖ \"@Õ× \"@ÕØ \"@ÕÙ \"ÕÚ \"ÕÛ \"@ÕÜ \"ÕÝ \"ÕÞ \"@ƒÚ\n„Úßà\fÓá\"#\fƒé\n„éÞ!ˆÓâ\"#¤#ƒ-Š$qˆƒ,@:ƒ#@@9ƒ#å@@!ˆ@@@A@LˆA‰„)ƒ6&皃EÒ()‚cꚃSˉ(‚c:ƒaÒ(‚c)+†q†q,,††--. . \f-‡" [gnus-kill-files-directory "~/News/" expand-file-name string-match "^" file assoc gnus-score-cache cached gnus-internal-global-score-files global nil lists alist gnus-score-alist gnus-score-load-score-alist touched read-only t mapcar #[(e) "@;‡" [e] 1] gnus-score-get mark expunge mark-and-expunge files exclude-files orphan adapt local eval apply append #[(file) "À !‡" [gnus-score-load-file file] 2] #[(sfile) "À  !\"‡" [expand-file-name sfile file-name-directory file] 4] gnus-scores-exclude-files gnus-summary-buffer make-local-variable gnus-orphan-score (t) gnus-newsgroup-adaptive gnus-default-adaptive-score-alist (ignore) gnus-adaptive-score-alist gnus-summary-mark-below gnus-summary-expunge-below gnus-current-score-file] 12]) (defalias 'gnus-score-load #[(file) "À \n\"‰ƒ A‰‚%ÅÆ !ˆ\f„ÇÈ! \fB\nB‰)‡" [assoc file gnus-score-cache cache gnus-score-alist nil gnus-score-load-score-alist copy-alist ((touched nil))] 4]) (defalias 'gnus-score-remove-from-cache #[(file) "ÀÁ\n \" \"‰‡" [delq assoc file gnus-score-cache] 4]) (defalias 'gnus-score-load-score-alist #[(file) "À !ƒ@ŠÄ ˆÅ !ˆebˆŠÆÇÀÈ#)ƒ\"ÀÉÊ) @Ë=ƒ2Ì ! ‚5  Î \"‰ ‚DÀ‰ )‡" [nil alist file-readable-p file gnus-set-work-buffer insert-file-contents re-search-forward "[()0-9a-zA-Z]" t (byte-code "Àp!‡" [read] 2) ((error (byte-code "ÀÁ #ˆÄ ˆÅÆ!ˆÇ‡" [gnus-message 3 "Problem with score file %s" file ding sit-for 2 nil] 4))) setq gnus-score-transform-old-to-new gnus-score-alist gnus-score-check-syntax] 4]) (defalias 'gnus-score-check-syntax #[(alist file) "„Á‡:„ÂÃÄ #ˆÆ ˆÁ‡Áƒg„g@<„<ÂÉÊ@ $ˆË‚@@;ƒ^@A@<„^ÂÉÌ@A@ $ˆË‚A‰„!ƒsÆ ˆÁ‚t*‡" [alist nil gnus-message 1 "Score file is not a list: %s" file ding err a 3 "Illegal score element %s in %s" t "Illegal header match %s in %s"] 6]) (defalias 'gnus-score-transform-old-to-new #[(alist) "À 8 @Å=ƒ A@ ƒ| @‰@;ƒc\fA\f Bƒ_‰@@À@8Ç@8…FÈÇ@8!@A@ƒRÉ‚SÊF ˆA‰„-)‚u\fA<„q\f@\fAD‚r\f B A‰„ËÌD Ÿ+B‡" [2 alist nil out entry quote scor 3 gnus-day-number r s touched t] 7]) (defalias 'gnus-score-save #[nil "ŠÂÄÅ!qˆÆp!ˆÂ‰‰ ƒ¦ @ A @ AÊË\"ÌšƒÊÍ\"„Î!ƒLÏ!ƒ ÐËž\"¡Ñ ˆÂÓÕP\"ƒtÖ×\"cˆ‚zØp\"ˆ)ÙÚ!!ƒÛ ÜUƒ“Ý!ˆ‚Ï!ƒÞedÂß%ˆ‚+àp!*‡" [gnus-score-cache cache nil gnus-score-alist get-buffer-create "*Score*" buffer-disable-undo file score entry gnus-score-get touched (t) read-only file-exists-p file-writable-p delq erase-buffer emacs-lisp-mode-hook string-match gnus-adaptive-file-suffix "$" format "%S" pp gnus-make-directory file-name-directory buffer-size 0 delete-file write-region silent kill-buffer] 6]) (defalias 'gnus-score-headers #[(score-files &optional trace) "ÀÀÀÀ ƒ( @;ƒÆ @! ¤‚! @ ¤ A‰„\f\fƒ\\ À‰ƒ[É@\n\"‰ƒR@\fƒRË@ \"A‰„6*\f…A …A GGV…AÑÒ !‰Z ÀÀÛÜÝ\"ˆƒº@AÞHž„’\f†³ÞB B‚’Šßà!qˆáp!ˆ\nƒÙâã\"A@$å\n!ˆƒ@‰@Aâ\"A@$Þæçèé \"\"WƒÙê8 +%ˆ‚Ùìp!ˆ) ƒ;\f @AU„4 @@ÞH @ABB A‰„ÛÜí\".)‡" [nil scores gnus-orphan-score gnus-scores-articles gnus-scores-exclude-files score-files gnus-score-load-file c s rassq gnus-score-cache delq gnus-summary-default-score gnus-newsgroup-headers gnus-newsgroup-scored gnus-header-index entries gnus-day-number current-time-string now gnus-score-expiry-days expire headers gnus-current-score-file current-score-file entry header gnus-message 5 "Scoring..." 0 get-buffer-create "*Headers*" buffer-disable-undo assoc "references" gnus-score-index gnus-score-orphans apply max mapcar #[(score) "À \n\"G‡" [gnus-score-get header score] 3] 2 trace kill-buffer "Scoring...done"] 7]) (defalias 'gnus-get-new-thread-ids #[(articles) "ÀÁ\n\"A@ ĉ‰‰ \n ƒC @‰@\nH@ H A ̘ƒB‚.‡" [assoc "message-id" gnus-header-index gnus-score-index nil tref this art id-list refind index articles ""] 7]) (defalias 'gnus-score-orphans #[(score) "À !‰‰‰‰‰‰ \nË Ì\"‰Í ˆƒi@‰@HA Ϙ„\"\f šƒM B ‚\"\fƒ_\fбˆÑ`S`È $ˆC ‚\"\fƒ{\fбˆÑ`S`È $ˆ\nƒž\n@\nA\nebˆÒ ÂÓ#ƒ{ÔyˆÕÖ!ˆ‚ŒebˆÂˆ×`È\"ƒÆ@AA\\¡ˆ‚ªÂyÔ=…Ђ¡.‡" [gnus-get-new-thread-ids gnus-scores-articles nil this-id last this arts art articles alike new-thread-ids sort gnus-score-string< erase-buffer gnus-score-index "" 10 put-text-property search-forward t 0 kill-line 1 get-text-property score] 9]) (defalias 'gnus-score-integer #[(scores header now expire &optional trace) "À \n\"A@É…û@AÀ \f\" Aƒ\f A‰@‰ @\nË 8†8Ì  A@†CÐ 8à Ì=„q Ó=„q Ô=„q Õ=„q Ö=ƒv ‚{×Ø \"‰ƒÁ@@H†’Ü\n\"ƒ¸ƒ©@@ BBß@@A\\¡ˆA‰„…ƒóƒÜàáâ\f#ˆ AA# ˆ‚ó$Wƒóàáå\f#ˆ A¡ˆ . ‚+‡" [assoc header gnus-header-index nil alist entries gnus-score-index scores rest kill match 3 > type gnus-score-interactive-default-score score 2 date found < <= >= = error "Illegal match type: %s" match-func gnus-scores-articles articles 0 trace gnus-score-trace t gnus-score-set touched (t) now expire (t)] 5]) (defalias 'gnus-score-date #[(scores header now expire &optional trace) "À \n\"A@É…@AÀ \f\" Aƒ\f A‰@ Ê @! Ì 8†;Í A@†FÑ 8ÃÔ=ƒ\\Õ‚wÍ=ƒgÖ‚w×=ƒrØ‚wÙÚ\"ÃÇ@@H‰ƒ¾ Ê!\"ƒ¾ƒ¯@@ B B á@@A\\¡ˆA‰„…ƒùƒââãä\f#ˆ AA% ˆ‚ù&Wƒùâãç\f#ˆ A¡ˆ .\n‚+‡" [assoc header gnus-header-index nil alist entries gnus-score-index scores rest kill timezone-make-date-sortable match 3 before type gnus-score-interactive-default-score score 2 date found after string< gnus-string> at string= error "Illegal match type: %s" match-func gnus-scores-articles articles l trace gnus-score-trace t gnus-score-set touched (t) now expire (t)] 5]) (defalias 'gnus-score-body #[(scores header now expire &optional trace) "ŠqˆŒÁ  @@ÅH —ʘƒ Ë‚- —̘ƒ,Í‚-ÎÁÁÁÁÔÕÖ×!\"…PØ×!Å•ÁO!\"„]Î\f…Ç\f@@ÅHÚÛÜ$ˆ\"ƒ¿~ˆebˆƒ§Ë=ƒ›`ÝÞÁß#†–d}ˆ‚§ÝÞÁß#†¤`d}ˆƒ¿@Aà \"Aƒ«A‰!@‰\"@#ä\"8†Ýå&\"A@†è'(é\"8*Á+&ì=†\f&í=†\f&î=†\f&ï=?0&ñ=„+&ì=„+&ò=„+&î=ƒ/ó‚T&å=„K&í=„K&ô=„K&ï=ƒOÝ‚Tõö&\"7ebˆ7#Áß#ƒ€\f@(\f@A\\¡ˆß+8ƒ€\f@@\"B9B9*ƒ¶+ƒœúûü#ˆ\"AA= ˆ‚¶*>Wƒ¶úûÿ#ˆ!A¡ˆ!!. ‚Â\fA‰„aÁ. ‡" [nntp-server-buffer nil buffer-read-only gnus-scores-articles articles 0 last scores all-scores header "head" gnus-request-head "body" gnus-request-body gnus-request-article request-func entries alist ofunc article gnus-check-backend-function string-match "^gnus-" symbol-name intern gnus-newsgroup-name gnus-message 7 "Scoring on article %s of %s..." search-forward "\n\n" t assoc rest kill match 3 s type gnus-score-interactive-default-score score 2 date found R S Regexp String case-fold-search r regexp re-search-forward string error "Illegal match type: %s" search-func trace gnus-score-trace gnus-score-set touched (t) now expire (t)] 6]) (defalias 'gnus-score-followup #[(scores header now expire &optional trace) "À \n\"A@ \fʼn‰‰‰‰‰ \n \f ÐÑ\"!ˆÔÖ\"‰× ˆƒ@‰ @H\nA \nšƒa \fB\f‚9 ƒu رˆÙ`S`Æ\f$ˆ C\f\n ‚9 ƒ• رˆÙ`S`Æ\f$ˆ\fƒð\f@\fAÀ \"Aƒ•A‰@‰@Ý8†ÂÞA@†Í !â8#Å$å!æH‰'èU†ø'éU†ø'êU†ø'ëU?,'—‰-îUƒ\nï‚(-ðU„-ñU„-òUƒ#ó‚(ôõ\"6Å7Å ebˆ-ðUƒ}6Åø#ƒ¯æyˆ`æ”Uƒ:ň`æ•Uƒ:ù`Æ\"‰7$7ƒ:7@ 7A7ú @! #ˆ‚a6Åø#ƒ¯Åˆù`Æ\"‰7$7ƒ}7@ 7A7ú @! #ˆ‚“#ƒç$ƒËûüý#ˆAA> ˆ‚ç#?Wƒçûü@#ˆA¡ˆ. ‚§Ð!.\n‡" [assoc header gnus-header-index gnus-current-score-file scores nil articles alist entries art this last alike all-scores current-score-file gnus-score-index gnus-score-load-file gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix sort gnus-scores-articles gnus-score-string< erase-buffer 10 put-text-property rest kill match 3 s type gnus-score-interactive-default-score score 2 date found symbol-name 0 mt 82 83 69 70 case-fold-search dmt 114 re-search-forward 101 115 102 search-forward error "Illegal match type: %s" search-func arts t get-text-property gnus-score-add-followups gnus-score-set touched (t) now expire (t)] 11]) (defalias 'gnus-score-add-followups #[(header score scores) "Šqˆ ÂH\f@ÅÅ\fƒF\f@‰@Èšƒ?ÉA@8ƒ4ÉA@8Ê=ƒ?Ë \"ƒ?Ì\fA‰„†WÍÈ ÊÏ ÅÌ&-‡" [gnus-summary-buffer header 4 id scores nil entry dont "references" 3 s assoc t gnus-summary-score-entry score current-time-string] 9]) (defalias 'gnus-score-string #[(score-list header now expire &optional trace) "À \n\"A@ɉ‰‰‰‰‰‰ \n \f ÎÐ\"‰Ñ ˆƒv@‰ @ H\nA \nšƒV \fB\f‚. ƒj Ò±ˆÓ`S`Æ\f$ˆ C\f\n ‚. ƒŠ Ò±ˆÓ`S`Æ\f$ˆ ƒp @ AÀ \"AƒA‰@‰@Ø8†ºÙA@†ÅÝ8Ãà!áH‰\"ãU†ð\"äU†ð\"åU†ð\"æU?'\"—‰(éUƒê‚ (ëU„(ìU„(íUƒî‚ ïð\"1Ã2à (íUƒ4ó‚gebˆ(ëUƒ¹m„11Ãó#ƒ1áyˆ`á”Uƒ³Ãˆ`á•Uƒ³ô`Æ\"‰25ƒ—2ƒ³2@ 2A2  A\\¡ˆ @áHB6B6‚n2ƒ³2@ 2A2  A\\¡ˆ‚—÷yˆ‚>ø˜ƒÃùm„11Ãó#ƒ1á”bˆÃˆô`Æ\"‰25ƒ2ƒ+2@ 2A2  A\\¡ˆ @áHB6B6‚æ2ƒ+2@ 2A2  A\\¡ˆ‚÷yˆ‚ÃgƒMúûü#ˆAA= ˆ‚g>Wƒgúûÿ#ˆA¡ˆ. ‚Ÿ\f…v\fƒ€@ ˆ …ã @ AÀ \"Aƒ€A‰@‰@Ø8†­ÙA@†¸Ý8Ãà!áH‰\"ãU†ã\"äU†ã\"åU†ã\"æU?'\"—‰(éUƒõê‚(ëU„\n(ìU„\n(íUƒî‚ïð\"1Ã2à (íUƒÚebˆm„ 1Ãó#ƒ áyˆ`á”UƒšÃˆ`á•Uƒšô`Æ\"‰25ƒ~2ƒš2@ 2A2  A\\¡ˆ @áHB6B6‚U2ƒš2@ 2A2  A\\¡ˆ‚~÷yˆ‚%ƒÚƒ¾úûA#ˆAA= ˆ‚Ú>WƒÚúûB#ˆA¡ˆ. ‚’.\n‡" [assoc header gnus-header-index nil fuzzy scores articles alist entries art this last alike gnus-score-index sort gnus-scores-articles gnus-score-string< erase-buffer 10 put-text-property score-list rest kill match 3 s type gnus-score-interactive-default-score score 2 date found symbol-name 0 mt 82 83 69 70 case-fold-search dmt 114 re-search-forward 101 115 102 search-forward error "Illegal match type: %s" search-func arts t get-text-property trace gnus-score-trace 1 "" "\n" gnus-score-set touched (t) now expire (t) gnus-simplify-buffer-fuzzy (t) (t)] 11]) (defalias 'gnus-score-string< #[(a1 a2) "@ H\n@ H™‡" [a1 gnus-score-index a2] 3]) (defalias 'gnus-score-build-cons #[(article) "@ÁHAB‡" [article 0] 2]) (byte-code "ÀÁ\nBÁ‡" [(("number" 0 gnus-score-integer) ("subject" 1 gnus-score-string) ("from" 2 gnus-score-string) ("date" 3 gnus-score-date) ("message-id" 4 gnus-score-string) ("references" 5 gnus-score-string) ("chars" 6 gnus-score-integer) ("lines" 7 gnus-score-integer) ("xref" 8 gnus-score-string) ("head" -1 gnus-score-body) ("body" -1 gnus-score-body) ("all" -1 gnus-score-body) ("followup" 2 gnus-score-followup)) gnus-header-index current-load-list] 2) (defalias 'gnus-current-score-file-nondirectory #[(&optional score-file) "† ‰ƒÂÃ!!‚Ä)‡" [score-file gnus-current-score-file gnus-short-group-name file-name-nondirectory "none"] 4]) (defalias 'gnus-score-adaptive #[nil "ŠÀ !‰Ä ÆÆÆ \nƒa\n@‰@9ƒ(‰@J ˆA‰ƒZ@Ê@@!@AB¡ˆ@ËÌÊ@@!—P! ˆA‰„1\nA‰„ÍÎ\"!ˆebˆm?…Ñ`Óyˆ`bˆ)Ô\" žA‰ƒÑ`Õ\"„ÖÑ`Óyˆ`bˆ)×\"†¦!ƒƒ@@! Ù@A@ ‰§ƒÍÚ‚ü@A@ÛšƒÛÜ‚üƒé GWƒíÞ‚ü@A@ßšƒûà‚üáâ@8 Æã&ˆA‰„®äyˆ‚m.‡" [gnus-copy-sequence gnus-adaptive-score-alist malist alist current-time-string date nil elem headers match symbol-name intern "gnus-header-" gnus-score-load-file gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix get-text-property p 0 gnus-mark gnus-pseudo gnus-get-header-by-number gnus-number gnus-current-article gnus-summary-score-entry = "date" a gnus-score-exact-adapt-limit e "subject" f s 2 t 1] 9]) (defalias 'gnus-score-remove-lines-adaptive #[(marks) "ŠÀ !‰Ä È È\nÈ \nƒe\n@‰ @9ƒ, ‰@J ˆ A‰ ƒ^ @Ì @@! @AB¡ˆ @ÍÎÌ @@!—P! ˆ A‰ „5\nA‰„ebˆÏÐ\"!ˆÓÈÕ#ƒÖyˆ×`Öyˆ`bˆ)Ù\" žA‰ ƒü×`Öyˆ`bˆ)Ú\"„üÛ×`Öyˆ`bˆ)Ü\"†¼!\n ƒü @@\n! Þ @A@ ƒã GWƒçà‚èáâ @8 ÈÕ&ˆ A‰ „Ä`ãyˆ`|ˆ‚qÏ!.‡" [gnus-copy-sequence gnus-adaptive-score-alist malist alist current-time-string date gnus-current-score-file cur-score nil elem headers match symbol-name intern "gnus-header-" gnus-score-load-file gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix re-search-forward marks t 0 get-text-property p gnus-mark gnus-pseudo gnus-get-header-by-number gnus-number gnus-current-article gnus-summary-score-entry gnus-score-exact-adapt-limit e s 2 1] 9]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B „-Å!Ç ÈÉ#ˆÇ ÊË#ˆÂ‡" [boundp gnus-score-mode-map nil current-load-list gnus-score-mode-hook copy-keymap emacs-lisp-mode-map define-key "" gnus-score-edit-done "" gnus-score-edit-insert-date] 4) #@97 Mode for editing score files. This mode is an extended emacs-lisp mode. \{gnus-score-mode-map} (defalias 'gnus-score-mode #[nil "À ˆÁ\n!ˆÃ\f!ˆÅÇÉÊ!ˆËÌÍ\"‡" [kill-all-local-variables use-local-map gnus-score-mode-map set-syntax-table emacs-lisp-mode-syntax-table gnus-score-mode major-mode "Score" mode-name lisp-mode-variables nil run-hooks emacs-lisp-mode-hook gnus-score-mode-hook] 3 (#$ . 25807) nil]) #@34 Insert date in numerical format. (defalias 'gnus-score-edit-insert-date #[nil "ÀÁ !!c‡" [int-to-string gnus-day-number current-time-string] 3 (#$ . 26223) nil]) #@55 Save the score file and return to the summary buffer. (defalias 'gnus-score-edit-done #[nil "Àp! ÄÅÀ !!ˆÆ ˆÇp!ˆÈ !ˆÉ !ˆ\n…#Ê\n!*‡" [buffer-file-name gnus-prev-winconf winconf bufnam gnus-make-directory file-name-directory save-buffer kill-buffer gnus-score-remove-from-cache gnus-score-load-file set-window-configuration] 3 (#$ . 26391) nil]) #@47 Find all score rules applied to this article. (defalias 'gnus-score-find-trace #[nil "ÀÁ`Ãyˆ`\nbˆ)Ä\"† !CÆpÆ \nÆ ÌÇ!ˆ ‰„2ÍÎ!ˆÏÐ!ˆÑ ˆÒ ˆƒSÓÔ@A\"cˆA‰„AebˆÏ!,‡" [gnus-get-header-by-number get-text-property p 0 gnus-number gnus-current-article nil trace buf gnus-newsgroup-scored gnus-newsgroup-headers gnus-score-trace gnus-possibly-score-headers error "No score rules apply to the current article." pop-to-buffer "*Gnus Scores*" gnus-add-current-to-buffer-list erase-buffer format "%S\n"] 5 (#$ . 26743) nil]) (provide (quote gnus-score)) emacs-19.30/lisp/gnus-uu.elc100666 23053 1 114040 6046561453 14536 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:29:39 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/gnus-uu.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus-uu.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require gnus gnus-msg] 2) #@1216 *Default actions to be taken when the user asks to view a file. To change the behaviour, you can either edit this variable or set `gnus-uu-user-view-rules' to something useful. For example: To make gnus-uu use 'xli' to display JPEG and GIF files, put the following in your .emacs file: (setq gnus-uu-user-view-rules '(("jpg$\\|gif$" "xli"))) Both these variables are lists of lists with two string elements. The first string is a regular expression. If the file name matches this regular expression, the command in the second string is executed with the file as an argument. If the command string contains "%s", the file name will be inserted at that point in the command string. If there's no "%s" in the command string, the file name will be appended to the command string before executing. There are several user variables to tailor the behaviour of gnus-uu to your needs. First we have `gnus-uu-user-view-rules', which is the variable gnus-uu first consults when trying to decide how to view a file. If this variable contains no matches, gnus-uu examines the default rule variable provided in this package. If gnus-uu finds no match here, it uses `gnus-uu-user-view-rules-end' to try to make a match. (defvar gnus-uu-default-view-rules (quote (("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/ //g") ("\\.pas$" "cat %s | sed s/ //g") ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/.//g") ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") ("\\.tga$" "tgatoppm %s | xv -") ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" "sox -v .5 %s -t .au -u - > /dev/audio") ("\\.au$" "cat %s > /dev/audio") ("\\.mod$" "str32") ("\\.ps$" "ghostview") ("\\.dvi$" "xdvi") ("\\.html$" "xmosaic") ("\\.mpe?g$" "mpeg_play") ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" "gnus-uu-archive"))) (#$ . -530)) #@147 *Variable detailing what actions are to be taken to view a file. See the documentation on the `gnus-uu-default-view-rules' variable for details. (defvar gnus-uu-user-view-rules nil (#$ . -2528)) #@162 *Variable saying what actions are to be taken if no rule matched the file name. See the documentation on the `gnus-uu-default-view-rules' variable for details. (defvar gnus-uu-user-view-rules-end (quote (("" "file"))) (#$ . -2731)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÆDÄ BÀ‡" [boundp gnus-uu-default-archive-rules (("\\.tar$" "tar xf") ("\\.zip$" "unzip -o") ("\\.ar$" "ar x") ("\\.arj$" "unarj x") ("\\.zoo$" "zoo -e") ("\\.\\(lzh\\|lha\\)$" "lha x") ("\\.Z$" "uncompress") ("\\.gz$" "gunzip") ("\\.arc$" "arc -x")) current-load-list gnus-uu-destructive-archivers "uncompress" "gunzip"] 2) #@271 *A list that can be set to override the default archive unpacking commands. To use, for instance, 'untar' to unpack tar files and 'zip -x' to unpack zip files, say the following: (setq gnus-uu-user-archive-rules '(("\\.tar$" "untar") ("\\.zip$" "zip -x"))) (defvar gnus-uu-user-archive-rules nil (#$ . -3328)) #@336 *A regular expression saying what files should not be viewed based on name. If, for instance, you want gnus-uu to ignore all .au and .wav files, you could say something like (setq gnus-uu-ignore-files-by-name "\\.au$\\|\\.wav$") Note that this variable can be used in conjunction with the `gnus-uu-ignore-files-by-type' variable. (defvar gnus-uu-ignore-files-by-name nil (#$ . -3658)) #@361 *A regular expression saying what files that shouldn't be viewed, based on MIME file type. If, for instance, you want gnus-uu to ignore all audio files and all mpegs, you could say something like (setq gnus-uu-ignore-files-by-type "audio/\\|video/mpeg") Note that this variable can be used in conjunction with the `gnus-uu-ignore-files-by-name' variable. (defvar gnus-uu-ignore-files-by-type nil (#$ . -4055)) (byte-code "ÀÁ\nBÁ‡" [(("\\.gif$" "image/gif") ("\\.jpe?g$" "image/jpeg") ("\\.tiff?$" "image/tiff") ("\\.xwd$" "image/xwd") ("\\.pbm$" "image/pbm") ("\\.pgm$" "image/pgm") ("\\.ppm$" "image/ppm") ("\\.xbm$" "image/xbm") ("\\.pcx$" "image/pcx") ("\\.tga$" "image/tga") ("\\.ps$" "image/postscript") ("\\.fli$" "video/fli") ("\\.wav$" "audio/wav") ("\\.aiff$" "audio/aiff") ("\\.hcom$" "audio/hcom") ("\\.voc$" "audio/voc") ("\\.smp$" "audio/smp") ("\\.mod$" "audio/mod") ("\\.dvi$" "image/dvi") ("\\.mpe?g$" "video/mpeg") ("\\.au$" "audio/basic") ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain") ("\\.\\(c\\|h\\)$" "text/source") ("read.*me" "text/plain") ("\\.html$" "text/html") ("\\.bat$" "text/bat") ("\\.[1-6]$" "text/man") ("\\.flc$" "video/flc") ("\\.rle$" "video/rle") ("\\.pfx$" "video/pfx") ("\\.avi$" "video/avi") ("\\.sme$" "video/sme") ("\\.rpza$" "video/prza") ("\\.dl$" "video/dl") ("\\.qt$" "video/qt") ("\\.rsrc$" "video/rsrc") ("\\..*$" "unknown/unknown")) gnus-uu-ext-to-mime-list current-load-list] 2) #@71 *Variable saying where gnus-uu is to do its work. Default is "/tmp/". (defvar gnus-uu-tmp-dir "/tmp/" (#$ . -5498)) #@102 *Non-nil means that gnus-uu won't peek inside archives looking for files to dispay. Default is nil. (defvar gnus-uu-do-not-unpack-archives nil (#$ . -5621)) #@192 *Non-nil means that the user will always be asked to save a file after viewing it. If the variable is nil, the user will only be asked to save if the viewing is unsuccessful. Default is nil. (defvar gnus-uu-view-and-save nil (#$ . -5786)) #@131 *Non-nil means that gnus-uu will ignore the default viewing rules. Only the user viewing rules will be consulted. Default is nil. (defvar gnus-uu-ignore-default-view-rules nil (#$ . -6032)) #@151 *Non-nil means that gnus-uu will ignore the default archive unpacking commands. Only the user unpacking commands will be consulted. Default is nil. (defvar gnus-uu-ignore-default-archive-rules nil (#$ . -6229)) #@90 *Non-nil means that gnus-uu will strip all carriage returns from articles. Default is t. (defvar gnus-uu-kill-carriage-return t (#$ . -6448)) #@196 *Non-nil means that files will be viewed with metamail. The gnus-uu viewing functions will be ignored and gnus-uu will try to guess at a content-type based on file name suffixes. Default it nil. (defvar gnus-uu-view-with-metamail nil (#$ . -6597)) #@109 *Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. Default is nil. (defvar gnus-uu-unmark-articles-not-decoded nil (#$ . -6852)) #@119 *Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. Default is nil. (defvar gnus-uu-correct-stripped-uucode nil (#$ . -7029)) #@332 *Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. If this variable is nil, gnus-uu will just save everything in a file without any embellishments. The digesting almost conforms to RFC1153 - no easy way to specify any meaningful volume and issue numbers were found, so I simply dropped them. (defvar gnus-uu-save-in-digest nil (#$ . -7212)) #@129 *List of regexps to match headers included in digested messages. The headers will be included in the sequence they are matched. (defvar gnus-uu-digest-headers (quote ("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" "^Summary:" "^References:")) (#$ . -7599)) #@67 *Non-nil means that gnus-uu will save articles in separate files. (defvar gnus-uu-save-separate-articles nil (#$ . -7887)) (byte-code "ÀÁ!„ÂÁ BÄÅ BÆÇ BÈ É BÊ  S‰ ÌVƒ7 ÍP ‚# ÎP )ÏÐ BÀÑ!„NÂÑ BÒÓ BÔÕ BÖ× BÀØ!„pÂØ BÂÙ BÀÚ!„„ÂÚ BÀÛ!„‘ÂÛ BÀÜ!„žÂÜ BÝÞ BÀß!„³ ß BÀá!„ÀÂ!á BÀâ!„ÍÂ\"â BÀã!„ÚÂ#ã Bäã!ˆå&çã#ˆå#èé#ˆå#êë#ˆå#ìí#ˆå#îï#ˆå#ðñ#ˆå#òó#ˆå#ôõ#ˆå#ö÷#ˆå#øù#ˆäá!ˆå:ûá#ˆå!êü#ˆå!ìý#ˆå!îþ#ˆå!øÿ#ˆå!@A#ˆå!BA#ˆå!CD#ˆå!ED#ˆå!èF#ˆå!çG#ˆäâ!ˆå!Hâ#ˆå\"êI#ˆå\"ìJ#ˆå\"îK#ˆå\"øL#ˆå\"@M#ˆå\"BM#ˆå\"CN#ˆå\"EN#ˆå\"èO#ˆå\"çP#‡" [boundp gnus-uu-saved-article-name nil current-load-list "^begin[ ]+[0-7][0-7][0-7][ ]+\\(.*\\)$" gnus-uu-begin-string "^end[ ]*$" gnus-uu-end-string "^M" gnus-uu-body-line 61 i 0 "[^a-z]" ".?$" "^#! */bin/sh" gnus-uu-shar-begin-string gnus-uu-shar-file-name "begin [0-7][0-7][0-7][ ]+\\(\\(\\w\\|\\.\\)*\\b\\)" gnus-uu-shar-name-marker "^%!PS-" gnus-uu-postscript-begin-string "^%%EOF$" gnus-uu-postscript-end-string gnus-uu-file-name gnus-uu-uudecode-process gnus-uu-binhex-article-name gnus-uu-generated-file-list gnus-uu-work-dir " *Gnus UU Output*" gnus-uu-output-buffer-name gnus-uu-default-dir default-directory gnus-uu-extract-map gnus-uu-extract-view-map gnus-uu-mark-map define-prefix-command define-key gnus-summary-mark-map "P" "p" gnus-summary-mark-as-processable "u" gnus-summary-unmark-as-processable "U" gnus-summary-unmark-all-processable "s" gnus-uu-mark-series "r" gnus-uu-mark-region "R" gnus-uu-mark-by-regexp "t" gnus-uu-mark-thread "a" gnus-uu-mark-all "S" gnus-uu-mark-sparse gnus-summary-mode-map "X" gnus-uu-decode-uu gnus-uu-decode-uu-and-save gnus-uu-decode-unshar gnus-uu-decode-unshar-and-save "o" gnus-uu-decode-save "O" "b" gnus-uu-decode-binhex "B" gnus-uu-decode-postscript gnus-uu-decode-postscript-and-save "v" gnus-uu-decode-uu-view gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view gnus-uu-decode-binhex-view gnus-uu-decode-postscript-view gnus-uu-decode-postscript-and-save-view] 4) #@32 Uudecodes the current article. (defalias 'gnus-uu-decode-uu #[(n) "ÀÁ\n\"‡" [gnus-uu-decode-with-method gnus-uu-uustrip-article n] 3 (#$ . 10045) "P"]) #@39 Decodes and saves the resulting file. (defalias 'gnus-uu-decode-uu-and-save #[(n dir) "ÀÁ\n #‡" [gnus-uu-decode-with-method gnus-uu-uustrip-article n dir] 4 (#$ . 10203) (list current-prefix-arg (file-name-as-directory (read-file-name "Uudecode and save in dir: " gnus-uu-default-dir gnus-uu-default-dir t)))]) #@30 Unshars the current article. (defalias 'gnus-uu-decode-unshar #[(n) "ÀÁ\nÉÄ%‡" [gnus-uu-decode-with-method gnus-uu-unshar-article n nil scan] 6 (#$ . 10520) "P"]) #@40 Unshars and saves the current article. (defalias 'gnus-uu-decode-unshar-and-save #[(n dir) "ÀÁ\n ÄÅ%‡" [gnus-uu-decode-with-method gnus-uu-unshar-article n dir nil scan] 6 (#$ . 10690) (list current-prefix-arg (file-name-as-directory (read-file-name "Unshar and save in dir: " gnus-uu-default-dir gnus-uu-default-dir t)))]) #@28 Saves the current article. (defalias 'gnus-uu-decode-save #[(n file) "ÂÃ\fÅÆ$ˆÇ\"‰‡" [file gnus-uu-saved-article-name gnus-uu-decode-with-method gnus-uu-save-article n nil t delete gnus-uu-generated-file-list] 5 (#$ . 11020) (list current-prefix-arg (read-file-name (if gnus-uu-save-separate-articles "Save articles is dir: " "Save articles in file: ") gnus-uu-default-dir gnus-uu-default-dir))]) #@33 Unbinhexes the current article. (defalias 'gnus-uu-decode-binhex #[(n dir) "À ÂP!ÄÅ#‡" [make-temp-name gnus-uu-work-dir "binhex" gnus-uu-binhex-article-name gnus-uu-decode-with-method gnus-uu-binhex-article n dir] 4 (#$ . 11430) (list current-prefix-arg (file-name-as-directory (read-file-name "Unbinhex and save in dir: " gnus-uu-default-dir gnus-uu-default-dir)))]) #@42 Uudecodes and views the current article. (defalias 'gnus-uu-decode-uu-view #[(n) "†Á !)‡" [gnus-view-pseudos automatic gnus-uu-decode-uu n] 2 (#$ . 11809) "P"]) #@46 Decodes, views and saves the resulting file. (defalias 'gnus-uu-decode-uu-and-save-view #[(n dir) "†Á \f\")‡" [gnus-view-pseudos automatic gnus-uu-decode-uu-and-save n dir] 3 (#$ . 11981) (list current-prefix-arg (read-file-name "Uudecode, view and save in dir: " gnus-uu-default-dir gnus-uu-default-dir t))]) #@40 Unshars and views the current article. (defalias 'gnus-uu-decode-unshar-view #[(n) "†Á !)‡" [gnus-view-pseudos automatic gnus-uu-decode-unshar n] 2 (#$ . 12302) "P"]) #@40 Unshars and saves the current article. (defalias 'gnus-uu-decode-unshar-and-save-view #[(n dir) "†Á \f\")‡" [gnus-view-pseudos automatic gnus-uu-decode-unshar-and-save n dir] 3 (#$ . 12480) (list current-prefix-arg (read-file-name "Unshar, view and save in dir: " gnus-uu-default-dir gnus-uu-default-dir t))]) #@38 Saves and views the current article. (defalias 'gnus-uu-decode-save-view #[(n file) "†Á \f\")‡" [gnus-view-pseudos automatic gnus-uu-decode-save n file] 3 (#$ . 12801) (list current-prefix-arg (read-file-name (if gnus-uu-save-separate-articles "Save articles is dir: " "Save articles in file: ") gnus-uu-default-dir gnus-uu-default-dir))]) #@43 Unbinhexes and views the current article. (defalias 'gnus-uu-decode-binhex-view #[(n file) "À ÂP!\f† ÅÆ\")‡" [make-temp-name gnus-uu-work-dir "binhex" gnus-uu-binhex-article-name gnus-view-pseudos automatic gnus-uu-decode-binhex n file] 3 (#$ . 13152) (list current-prefix-arg (read-file-name "Unbinhex, view and save in dir: " gnus-uu-default-dir gnus-uu-default-dir))]) #@51 Digests and forwards all articles in this series. (defalias 'gnus-uu-digest-mail-forward #[(n &optional post) "ÀÁ\nÃP!ÄÈ \"ˆÊ!ˆËÌÍ!!Î ˆÏ ˆÐ ˆÑ!ˆebˆÒÓ!ƒG``Ĉ`bˆ)|ˆÕcˆebˆÒÖ!ƒb``Ĉ`bˆ)|ˆ×cˆƒmÙ ˆ‚q ˆÛ!ˆÜ !+‡" [t make-temp-name gnus-uu-tmp-dir "forward" nil buf file gnus-uu-save-in-digest gnus-uu-decode-save n gnus-uu-add-file switch-to-buffer get-buffer-create " *gnus-uu-forward*" gnus-add-current-to-buffer-list erase-buffer delete-other-windows insert-file re-search-forward "^Subject: " p "Digested Articles" "^From: " "Various" post gnus-forward-using-post gnus-mail-forward-method delete-file kill-buffer] 4 (#$ . 13537) "P"]) #@36 Digest and forward to a newsgroup. (defalias 'gnus-uu-digest-post-forward #[(n) "À Â\"‡" [gnus-uu-digest-mail-forward n t] 3 (#$ . 14207) "P"]) #@83 Ask for a regular expression and set the process mark on all articles that match. (defalias 'gnus-uu-mark-by-regexp #[(regexp) "À ˆÁ\n!‰ƒÄ @!ˆ A‰„ ÅÆ!ˆ)Ç ‡" [gnus-set-global-variables gnus-uu-find-articles-matching regexp articles gnus-summary-set-process-mark message "" gnus-summary-position-cursor] 3 (#$ . 14357) (list (read-from-minibuffer "Mark (regexp): "))]) #@48 Mark the current series with the process mark. (defalias 'gnus-uu-mark-series #[nil "À ˆÁ ‰ƒÃ\n@!ˆ\nA‰„\nÄÅ!ˆ)Æ ‡" [gnus-set-global-variables gnus-uu-find-articles-matching articles gnus-summary-set-process-mark message "" gnus-summary-position-cursor] 3 (#$ . 14735) nil]) #@44 Marks all articles between point and mark. (defalias 'gnus-uu-mark-region #[(beg end) "À ˆŠ bˆ`\nWƒ(ÃÄ`Æyˆ` bˆ)Ç\"† !ˆÉyˆ‚)Ê ‡" [gnus-set-global-variables beg end gnus-summary-set-process-mark get-text-property p 0 gnus-number gnus-current-article 1 gnus-summary-position-cursor] 4 (#$ . 15020) "r"]) #@46 Marks all articles downwards in this thread. (defalias 'gnus-uu-mark-thread #[nil "À ˆÁ`Ãyˆ`\nbˆ)Ä\"†ÃÆÁ`Ãyˆ`\nbˆ)Ç\"†(!ƒJÉÊ!ÃUƒJÁ`Ãyˆ`\nbˆ)Ä\"†Eà V„)Ë ‡" [gnus-set-global-variables get-text-property p 0 gnus-level level gnus-summary-set-process-mark gnus-number gnus-current-article gnus-summary-next-subject 1 gnus-summary-position-cursor] 4 (#$ . 15334) nil]) #@49 Mark all series that have some articles marked. (defalias 'gnus-uu-mark-sparse #[nil "À ˆ ŸÂ‰‰‰‰„ÈÉ!ˆÂŠƒ^Ê@!‰ƒ: ËHÌÍ!!\f ¤ ƒUÎ @!ˆÏ @A\"¡ˆ A‰„>A‰„ \fŸ)Ð -‡" [gnus-set-global-variables gnus-newsgroup-processable nil headers total articles subject marked error "No articles marked with the process mark" gnus-get-header-by-number 1 gnus-uu-find-articles-matching gnus-uu-reginize-string gnus-summary-set-process-mark delq gnus-summary-position-cursor] 6 (#$ . 15717) nil]) #@38 Mark all articles in "series" order. (defalias 'gnus-uu-mark-all #[nil "À ˆÁŠebˆÁm„7Ä`Æyˆ` bˆ)Ç\"†!‰ƒ7 \n>„1ŠÉ ˆ)Êyˆ‚ *Ë ‡" [gnus-set-global-variables nil gnus-newsgroup-processable number get-text-property p 0 gnus-number gnus-current-article gnus-uu-mark-series 1 gnus-summary-position-cursor] 3 (#$ . 16230) nil]) #@41 Gets postscript of the current article. (defalias 'gnus-uu-decode-postscript #[(n) "ÀÁ\n\"‡" [gnus-uu-decode-with-method gnus-uu-decode-postscript-article n] 3 (#$ . 16564) "P"]) #@37 Gets and views the current article. (defalias 'gnus-uu-decode-postscript-view #[(n) "†Á !)‡" [gnus-view-pseudos automatic gnus-uu-decode-postscript n] 2 (#$ . 16749) "P"]) #@52 Extracts postscript and saves the current article. (defalias 'gnus-uu-decode-postscript-and-save #[(n dir) "ÀÁ\n #‡" [gnus-uu-decode-with-method gnus-uu-decode-postscript-article n dir] 4 (#$ . 16932) (list current-prefix-arg (file-name-as-directory (read-file-name "Save in dir: " gnus-uu-default-dir gnus-uu-default-dir t)))]) #@46 Decodes, views and saves the resulting file. (defalias 'gnus-uu-decode-postscript-and-save-view #[(n dir) "†Á \f\")‡" [gnus-view-pseudos automatic gnus-uu-decode-postscript-and-save n dir] 3 (#$ . 17267) (list current-prefix-arg (read-file-name "Where do you want to save the file(s)? " gnus-uu-default-dir gnus-uu-default-dir t))]) (defalias 'gnus-uu-decode-with-method #[(method n &optional save not-insert scan) "À !ˆ\nƒ\n\nÄ !ÆÉ\nË#@\f ƒ*Í!)\nƒ5Ï\n\"ˆÐ!ÑÒÓ\"!ˆÔ!Ÿ†TÖ\n\"*‡" [gnus-uu-initialize scan save gnus-uu-default-dir gnus-uu-get-list-of-articles n nil files articles gnus-uu-grab-articles method t gnus-current-article gnus-uu-scan-directory gnus-uu-work-dir gnus-uu-save-files gnus-uu-unpack-files gnus-uu-add-file mapcar #[(file) "À žA‡" [name file] 2] gnus-uu-get-actions not-insert gnus-summary-insert-pseudos] 4]) (defalias 'gnus-uu-scan-directory #[(dir) "À Â\"ɉƒ>ÇÈ@\"„5É@!ƒ(@ B‚5Ê@BË\fBD\fBA‰„ÍÎ\fÏÐ \"#+‡" [directory-files dir t nil out dirs files string-match "/\\.\\.?$" file-directory-p name article gnus-current-article apply nconc mapcar #[(d) "À !‡" [gnus-uu-scan-directory d] 2]] 7]) (defalias 'gnus-uu-save-files #[(files dir) "GÁ‰ƒKÅ@žA‰ƒDÆ\n!ƒDÇ!ƒ+É\n!P‚-Æ !ƒ=ÊËÌ \"!ƒDÍ\n Ή$ˆA‰„ ÏÐ\f‰ÑVƒXÒ‚YÓ#+‡" [files nil file to-file len name file-exists-p file-directory-p dir file-name-nondirectory gnus-y-or-n-p format "%s exists; overwrite? " copy-file t message "Saved %d file%s" 1 "s" ""] 6]) (defalias 'gnus-uu-save-article #[(buffer in-state) "ƒ;Š qˆÂÃd\f P#ˆÇ=ƒ\fÈD‚9É=ƒ+\fÈÊE‚9Ë=ƒ7ÊC‚9ÌC)‡ „vŠ qˆÂÃd\fÎ$ˆÇ=ƒX\fÈD‚tÉ=ƒf\fÈÊE‚tË=ƒrÊC‚tÌC)‡Ï\f!Љ‰‰‰‰‰‰Ç=„¡É=ƒÆÈCŠÚÛ!qˆÜ ˆ)ŠÚÝ!qˆÜ ˆÞßà ‰$cˆ)‚ÑÊ=„ÑÌCŠáÛ!qˆd‰bˆŠŒ qˆÐ\"ãedÐ#ˆäedåÐ$ˆäedæÐ$ˆ)ebˆçè!ˆ`Sd{Ã`}ˆ)‰„ed{‚RƒR@AebˆçÐÎ#ƒê”çëÐÎ#ƒG`S†KÃyˆ`{P‚~ˆ*cˆdbˆcˆdbˆìíîï\"èQcˆbˆçðÐÎ#ƒÔÕ{ŠáÝ!qˆÞñ\"cˆ))Ë=„œÉ=ƒëŠáÝ!qˆÞòíóï\"\"cˆÂÃd\f#ˆ)ŠáÛ!qˆdbˆÞô\"‰ìPcˆíGõ\"ìPcˆÂÃd\fÎ$ˆ)öáÝ!!ˆöáÛ!!ˆÊBÈ>ƒù\fB‚û. ‡" [gnus-uu-save-separate-articles buffer write-region 1 gnus-uu-saved-article-name gnus-current-article in-state first begin first-and-last end last middle gnus-uu-save-in-digest t file-name-nondirectory nil state end-string body sorthead headline headers subj beg name get-buffer-create "*gnus-uu-body*" erase-buffer "*gnus-uu-pre*" format "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" current-time-string get-buffer buffer-read-only set-text-properties put-text-property invisible intangible re-search-forward "\n\n" gnus-uu-digest-headers 0 "^[^ ]" "\n" make-string 30 45 "^Subject: \\(.*\\)$" " %s\n" "\n\n%s\n\n" 70 "End of %s Digest" 42 kill-buffer] 9]) (byte-code "ÀÁ\nBÃÄ\nBÅÆ\nBÁ‡" ["^[^:]...............................................................$" gnus-uu-binhex-body-line current-load-list "^:...............................................................$" gnus-uu-binhex-begin-line ":$" gnus-uu-binhex-end-line] 2) (defalias 'gnus-uu-binhex-article #[(buffer in-state) "À‰Š qˆ~ˆebˆÄ ÀÆ#„!ÄÀÆ#„!ÈCÈ\n>„zÉyˆ`Ê !ƒ?ËCÌ͉#ˆ‚BÏCdbˆÐÑQÀÆ#ˆÊ!ƒfË\n>ƒcÓ\nB‚eÓCÉyˆÍyˆÔ!ƒzÕ `#ˆ)Ë\n>ƒˆ\nB‚‰\n*‡" [nil start-char state buffer re-search-forward gnus-uu-binhex-begin-line t gnus-uu-binhex-body-line wrong-type 0 looking-at begin write-region 1 gnus-uu-binhex-article-name middle re-search-backward "\\|" gnus-uu-binhex-end-line end file-exists-p append-to-file] 4]) (defalias 'gnus-uu-decode-postscript-article #[(process-buffer in-state) "ÀCÁ‰‰ŠqˆebˆÇÁÉ#„ ÊC‚VËyˆ`Ç\fÁÉ#„4ÊC‚V`Í!qˆÏ\f #ˆAÒQÓed\n#ˆ\nÔÕE) ,‡" [ok nil file-name end-char start-char state process-buffer re-search-forward gnus-uu-postscript-begin-string t wrong-type 0 gnus-uu-postscript-end-string get-buffer-create gnus-uu-output-buffer-name insert-buffer-substring gnus-uu-work-dir gnus-article-current ".ps" write-region begin end] 4]) (defalias 'gnus-uu-get-actions #[(files) "Á‰ƒIÂ@žAÅ\n!‰ƒB Ƙƒ%ÃÇB‚(à BÈÉÊ \"ƒ7Ë \n\"‚; Ì\nQBD@¤ ˆA‰„\n\f+‡" [files nil name action ofiles gnus-uu-get-action "gnus-uu-archive" "file" execute string-match "%" format " "] 7]) (defalias 'gnus-uu-get-action #[(file-name) "ÀÂ Ä ?…#\"‰†Éʘ„1 ƒ1 \f\"‰ƒ1ÍÎ \" )‡" [nil action gnus-uu-choose-action file-name append gnus-uu-user-view-rules gnus-uu-ignore-default-view-rules gnus-uu-default-view-rules gnus-uu-user-view-rules-end "" "gnus-uu-archive" gnus-uu-view-with-metamail gnus-uu-ext-to-mime-list format "metamail -d -b -c \"%s\""] 7]) (defalias 'gnus-uu-reginize-string #[(string) "ÀÁŠÆ!qˆÈp!ˆÉ ˆÊ !cˆÌ ebˆÎ\f!ƒ1Ï\fЉ#ˆ\fG bˆÑÒÂÐ#ƒCÏÓ!ˆ‚ˆ bˆÑÔÂÐ#ƒUÏÕ!ˆ‚ˆÂˆÖ×ÂÐ#ƒˆ ØVƒˆÎ×!ƒtÌ`SbW„fÑÙÂÐ#ˆÏÙ!ˆÚÛ!ˆ S‚X bˆÑÜÂÐ#ƒœÏÝЉ#ˆ‚‹Ìd{,‡" [2 "v[0-9]+[a-z][0-9]+:" nil beg vernum count get-buffer-create gnus-uu-output-buffer-name buffer-disable-undo erase-buffer regexp-quote string 1 case-fold-search looking-at replace-match t re-search-forward "[ ]*[0-9]+/[0-9]+" " [0-9]+/[0-9]+" "[0-9]+[ ]*of[ ]*[0-9]+" "[0-9]+ of [0-9]+" re-search-backward "[0-9]" 0 "[0-9]+" backward-char 5 "[ ]+" "[ ]*"] 4]) (defalias 'gnus-uu-get-list-of-articles #[(n) "À\nƒF\nÃWÄ\n!Š\nÃVƒ?Æ`Ãyˆ`bˆ)È\"†) B‰ƒ?Ê À‰#ƒ?\nS‰‚) Ÿ*‚T ƒRÌ !‚TÍ )‡" [nil articles n 0 abs backward get-text-property p gnus-number gnus-current-article gnus-summary-search-subject gnus-newsgroup-processable reverse gnus-uu-find-articles-matching] 5]) (defalias 'gnus-uu-string< #[(l1 l2) "@ @™‡" [l1 l2] 2]) (defalias 'gnus-uu-find-articles-matching #[(&optional subject only-unread do-not-translate) "†Á !Ê…ŠÅÉebˆm„} ‰ƒwÉ\"ƒw\nƒ]Ë`\fÍyˆ`\fbˆ)Î\"‰U„]U„]UƒwË`\fÍyˆ`\fbˆ)Ò\"†sB\fBÔyˆ‚+ÕÖ×Ø\f?\"Ú\"\"+‡" [subject gnus-uu-reginize-string gnus-summary-subject-string nil list-of-subjects t mark subj case-fold-search string-match only-unread get-text-property p 0 gnus-mark gnus-unread-mark gnus-ticked-mark gnus-dormant-mark gnus-number gnus-current-article 1 mapcar #[(sub) "A‡" [sub] 1] sort gnus-uu-expand-numbers do-not-translate gnus-uu-string<] 6]) (defalias 'gnus-uu-expand-numbers #[(string-list &optional translate) "ÁŠÄ !qˆÆp!ˆƒpÇ ˆ@@cˆebˆÈÉÁÊ#ƒ,ËÌ!ˆ‚ebˆ ƒEÈÎÁÊ#ƒEËÏʉ#ˆ‚4ebˆÈÐÁÊ#ƒ`ËÑÒÓÔ”Ô•{!\"!ˆ‚HÕd{@\n ˆA‰„) *‡" [string-list nil string out-list get-buffer-create gnus-uu-output-buffer-name buffer-disable-undo erase-buffer re-search-forward "[ ]+" t replace-match " " translate "[A-Za-z]" "a" "[0-9]+" format "%06d" string-to-int 0 1] 7]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-uu-has-been-grabbed nil current-load-list] 2) (defalias 'gnus-uu-unmark-list-of-grabbed #[(&optional dont-unmark-last-article) "À\n…- …-\fƒ\n@\nA\nƒ%Å\n@Æ\"ˆ\nA‰„\f…- C‰)‡" [nil art gnus-uu-has-been-grabbed gnus-uu-unmark-articles-not-decoded dont-unmark-last-article gnus-summary-tick-article t] 4]) (defalias 'gnus-uu-grab-articles #[(articles process-function &optional sloppy limit no-errors) "ÀÁ‰‰‰‰‰É\n!„ Ë ˆÌ !ˆÁƒ†Ð >„†„9Ò >„†@ABÁ=ƒaÀ=ƒ^Ó‚aÔÕÖ×!#ˆ†qÙU„§ÁÛ #ˆ B;ƒž‚£ß!)‚­à ˆ!â\n!ˆ#>ƒ¾ä!ˆåæ!ˆ'\n\"è >„ãÀ=„ÝÓ=ƒé >ƒƒö ƒöê !ƒöë !ˆè >ƒÿ @ìÒ >ƒ)Áí BÆBD\fBÁ.ƒ)\fG.Uƒ)ÁÔ=„7Ó=ƒKÒ >„K ƒKê !ƒKë !ˆï >ƒ\\0ƒ\\ñì\"ˆ„€„€Ò >„rò >ƒ€ÐCÕó!ˆôõ!ˆ‚#ò‚#\n!˜„¨Šö!!qˆÁ7~ˆø ˆù\n!ˆúÆ!ˆebˆ*úû!ˆ\f„é„Á<„éÕý!ˆ‚éÐ >ƒÌÁ‚éé >„æÒ >„æ<„áÕþ!ˆÁ‚éÿ ˆ\f.‡" [first nil article-buffer process-state result-files result-file article has-been-begin state gnus-server-opened gnus-current-select-method gnus-start-news-server gnus-request-group gnus-newsgroup-name gnus-uu-has-been-grabbed articles error sloppy end first-and-last last message "Getting article %d, %s" gnus-uu-part-number gnus-current-article 0 nntp-async-number gnus-request-article nntp-server-buffer gnus-last-article gnus-article-current buffer-name gnus-summary-stop-page-breaking gnus-article-buffer buffer-disable-undo gnus-newsgroup-processable gnus-summary-remove-process-mark run-hooks gnus-mark-article-hook process-function begin ok file-exists-p delete-file t name limit wrong-type gnus-uu-unmark-articles-not-decoded gnus-summary-tick-article middle "No begin part at the beginning" sleep-for 2 get-buffer-create buffer-read-only erase-buffer insert-buffer-substring gnus-set-mode-line summary no-errors "Wrong type file" "End of articles reached before end of file" gnus-uu-unmark-list-of-grabbed] 7]) (defalias 'gnus-uu-part-number #[(article) "À !ÂHÄÅ \"ƒ ƔƕO‚Ç)‡" [gnus-get-header-by-number article 1 subject string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" 0 ""] 3]) (defalias 'gnus-uu-uudecode-sentinel #[(process event) "ÀÁ\n!!‡" [delete-process get-process process] 3]) (defalias 'gnus-uu-uustrip-article #[(process-buffer in-state) "ÀCÁ‰‰‰‰ŠqˆÁ‰ \nebˆ ƒ4ÌÍÁÎ#ƒ1ÏÐ!ˆ‚\"ebˆÑÁÎ#„JÑÁÎ#„JÔCÔ>„„Õyˆ`Ö!ƒЕДÐyˆÖ!„wÕyˆ`Ðyˆ`|ˆ bˆÑ×\nÎ#ƒ‰ØÙ!ˆ‚z bˆÑÚ\nÎ#ƒ›ØÛ!ˆ‚Œ bˆÑÜ\nÎ#ƒªØÝ!ˆ \n{ƒÖà†»á!‰ƒÖ\fâ=„Í\fã=ƒÖä!ˆåÎ!ˆæç!ƒàäç!ˆèçé*!ëìíî/\"%ðñ\"ˆòCó/P!ˆ‚ ôCdbˆõö7QÁÎ#ˆÕyˆÖ7!ƒ'øBÐyˆƒ{à†6á!‰ƒ{\fã=„H\fâ=ƒw9ƒcú `\"ˆdbˆõö7QÁÎ#ˆÐyˆÁûüˆø>ƒ{ý!ˆ‚{ÔC„„ÔC*ò>ƒ—/PB‚™.‡" [ok nil name-end name-beg pst start-char process-connection-type state process-buffer buffer-read-only case-fold-search gnus-uu-kill-carriage-return search-forward " " t delete-backward-char 1 re-search-forward gnus-uu-begin-string gnus-uu-body-line wrong-type 0 looking-at "/" replace-match "," " " "_" "_*$" "" gnus-uu-file-name gnus-uu-uudecode-process process-status "nevair" stop run delete-process gnus-uu-unmark-list-of-grabbed get-process "*uudecode*" start-process get-buffer-create gnus-uu-output-buffer-name "sh" "-c" format "cd %s ; uudecode" gnus-uu-work-dir set-process-sentinel gnus-uu-uudecode-sentinel begin gnus-uu-add-file middle re-search-backward "\\|" gnus-uu-end-string end gnus-uu-correct-stripped-uucode gnus-uu-check-correct-stripped-uucode (byte-code "À \n`#‡" [process-send-region gnus-uu-uudecode-process start-char] 4) ((error (byte-code "À !ˆÂÃ!ˆÄCÀ‡" [delete-process gnus-uu-uudecode-process message "gnus-uu: Couldn't uudecode" wrong-type state] 2))) accept-process-output] 8]) (defalias 'gnus-uu-unshar-article #[(process-buffer in-state) "ÀCÁŠ\fqˆebˆÅÁÇ#„ÈC‚3Éyˆ`Ê\ndËÁÌ !ÁÎÏÑQ&ˆ) *‡" [ok nil start-char state process-buffer re-search-forward gnus-uu-shar-begin-string t wrong-type 0 call-process-region "sh" get-buffer-create gnus-uu-output-buffer-name "-c" "cd " gnus-uu-work-dir " ; sh"] 11]) (defalias 'gnus-uu-find-name-in-shar #[nil "`ÀebˆÃ\fÀÅ#ƒƔƕ{\nbˆ *‡" [nil res oldpoint re-search-forward gnus-uu-shar-name-marker t 1] 4]) (defalias 'gnus-uu-choose-action #[(file-name file-action-list &optional no-ignore) "À !ÂÉ„6 ƒÊ  \"„Z\fƒ6Ê\fÍ Â#†2Ï\"„ZÃ=„Z\f„Z@AÊ @ \"ƒ6 A@‚6\f,‡" [copy-sequence file-action-list t nil action rule case-fold-search action-list no-ignore gnus-uu-ignore-files-by-name string-match file-name gnus-uu-ignore-files-by-type gnus-uu-choose-action gnus-uu-ext-to-mime-list ""] 6]) (defalias 'gnus-uu-treat-archive #[(file-path) "ÀÁ‰‰ÆÈ \n?… \"\"‰„#ÌÍ\"ˆÎÏ\"ˆЉ”O\fƒ@Ò‰ÓPÀ#ˆÔÕ\nÖ\f\"#Š×!qˆÙ ˆ)ÚÛÖ\f\"\"ˆÜÝÁ×!ÁÞ &ÐUƒvÚß!ˆ‚|Úà!ˆÁ\fƒáÓPÀ#ˆ ,‡" [t nil dir command action did-unpack gnus-uu-choose-action file-path append gnus-uu-user-archive-rules gnus-uu-ignore-default-archive-rules gnus-uu-default-archive-rules error "No unpackers for the file %s" string-match "/[^/]*$" 0 gnus-uu-destructive-archivers copy-file "~" format "cd %s ; %s" gnus-uu-command get-buffer-create gnus-uu-output-buffer-name erase-buffer message "Unpacking: %s..." call-process "sh" "-c" "" "Error during unpacking of archive" rename-file] 8]) (defalias 'gnus-uu-dir-files #[(dir) "À ÂÃ#ĉ‰ƒ5È@‰!ƒ&ÉÊ !\"‚, BA‰„+‡" [directory-files dir t "[^/][^\\.][^\\.]?$" nil file files dirs file-directory-p append gnus-uu-dir-files] 5]) (defalias 'gnus-uu-unpack-files #[(files &optional ignore) "À ! ÅÅÅÉ\n!ˆ ƒ‚Ê @ž‰A‰ „{ÌÍ!!Κƒ{BÏ!„GÐÑ\"ˆÀ !‰É!ˆƒw@\n„nÊ@BÔBD\fBA‰„Y* A‰„ƒ“Õ\fÖ \"\"‚”\f-‡" [gnus-uu-ls-r gnus-uu-work-dir totfiles files ofiles nil file did-unpack file-entry gnus-uu-add-file name ignore gnus-uu-get-action file-name-nondirectory "gnus-uu-archive" gnus-uu-treat-archive message "Error during unpacking of %s" newfiles nfiles original gnus-uu-unpack-files append] 6]) (defalias 'gnus-uu-ls-r #[(dir) "À Â\"‰ ƒ'Å @!ƒ Æ @\f\"Ç\fÈ @!\" A‰„ \f*‡" [gnus-uu-directory-files dir t files ofiles file-directory-p delete append gnus-uu-ls-r] 5]) (defalias 'gnus-uu-directory-files #[(dir &optional full) "À‰‰Ä \" ƒ$ @ AÇÈ \"„\f \nB‚\f\nŸ‰+‡" [nil file out files directory-files dir full string-match "/\\.\\.?$"] 4]) (defalias 'gnus-uu-check-correct-stripped-uucode #[(start end) "À‰‰\f…p bˆÆÇÉ#ƒ. bˆm?…pÊË!ƒ(ÌÍ!ˆÎyˆ‚m?…pÊÐQ!„j „NÒyˆ`Àˆ`\nZÉÒyˆ`Àˆ `\nZU„jÓ `\nZZÔ\"cˆÎyˆ‚.+‡" [nil length beg found gnus-uu-correct-stripped-uucode start re-search-forward " \\|`" end t looking-at "\n" replace-match "" 1 gnus-uu-begin-string "\\|" gnus-uu-end-string 0 make-string 32] 4]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-uu-tmp-alist nil current-load-list] 2) (defalias 'gnus-uu-initialize #[(&optional scan) "À\n„+Ã\f \"‰ƒ+Æ A!ƒ A‰‚$È \"Àƒ+É‚}ÊË\f!!\fÍ\f!„CÎÏ\f\"ˆ‚PÐ\f!„PÎÑ\f\"ˆÒ\fÓP!Ô!ˆÍ!„iÕ!ˆÖ×\"ˆÊ!\fB B‰)‡" [nil entry scan assoc gnus-newsgroup-name gnus-uu-tmp-alist file-exists-p gnus-uu-work-dir delq t file-name-as-directory expand-file-name gnus-uu-tmp-dir file-directory-p error "Temp directory %s doesn't exist" file-writable-p "Temp directory %s can't be written to" make-temp-name "gnus" gnus-uu-add-file gnus-make-directory set-file-modes 448] 3]) (defalias 'gnus-uu-clean-up #[nil "À‰ ƒ$Ä †Å!‰ƒ$ Æ=„ Ç=ƒ$È !ˆÉ\n!‰…0Ë\n!*‡" [nil pst buf gnus-uu-uudecode-process process-status "nevair" stop run delete-process get-buffer gnus-uu-output-buffer-name kill-buffer] 2]) (defalias 'gnus-uu-check-for-generated-files #[nil "À‰ ƒ/ @ AÄÅ\n\"„Æ\n!ƒ\"\n B‚Ç\n!ƒÈ\n!ˆ‚ Ÿ …[ @ AÆ\n!ƒ2ÄÉ\n\"ƒTÊ\nˉ”O!ˆ‚2Ê\n!ˆ‚2*‡" [nil dirs file gnus-uu-generated-file-list string-match "/\\.[\\.]?$" file-directory-p file-exists-p delete-file "/$" delete-directory 0] 4]) (defalias 'gnus-uu-add-file #[(file) ";ƒ  B‰‡Â \"‰‡" [file gnus-uu-generated-file-list append] 3]) (defalias 'gnus-uu-command #[(action file) "ÀÂÃ\f\"ƒ\" \fʼn”OÆ\fŔŕOR\fÅ”TÇO‚È \fÈRÂÉ\n\"ƒ8Ë\n \"‚=\nÌ Q)‡" ["" ofile string-match "!\\|`\\|\"\\|\\$\\|\\\\\\|&" file 0 "\\" nil "\"" "%s" action format " "] 6]) (byte-code "ÀÁÂ\"ˆÀÁÃ\"ˆÄÅ!ˆÄÆ!‡" [add-hook gnus-exit-group-hook gnus-uu-clean-up gnus-uu-check-for-generated-files require sendmail rnews] 3) #@345 Function used for encoding binary files. There are three functions supplied with gnus-uu for encoding files: `gnus-uu-post-encode-uuencode', which does straight uuencoding; `gnus-uu-post-encode-mime', which encodes with base64 and adds MIME headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with uuencode and adds MIME headers. (defvar gnus-uu-post-encode-method (quote gnus-uu-post-encode-uuencode) (#$ . 32286)) #@254 Non-nil means that gnus-uu will ask for a file to encode before you compose the article. If this variable is t, you can either include an encoded file with \[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article. (defvar gnus-uu-post-include-before-composing nil (#$ . 32723)) #@119 Maximum length of an article. The encoded file will be split into how many articles it takes to post the entire file. (defvar gnus-uu-post-length 990 (#$ . 33047)) #@303 Non-nil means that gnus-uu will post the encoded file in a thread. This may not be smart, as no other decoder I have seen are able to follow threads when collecting uuencoded articles. (Well, I have seen one package that does that - gnus-uu, but somehow, I don't think that counts...) Default is nil. (defvar gnus-uu-post-threaded nil (#$ . 33218)) #@285 Non-nil means that the description will be posted in a separate article. The first article will typically be numbered (0/x). If this variable is nil, the description the user enters will be included at the beginning of the first article, which will be numbered (1/x). Default is t. (defvar gnus-uu-post-separate-description t (#$ . 33575)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÅÆ BÀÇ!„.ÅÇ BŇ" [boundp gnus-uu-post-binary-separator "--binary follows this line--" current-load-list gnus-uu-post-message-id nil gnus-uu-post-inserted-file-name gnus-uu-winconf-post-news] 2) #@46 Compose an article and post an encoded file. (defalias 'gnus-uu-post-news #[nil "À Ä ˆÅÆÇ !!ˆÈÉÊ\"ˆÈÉË\"ˆÈÌË\"ˆÈÍÎ\"ˆ….ŠÐ ‰)‡" [nil gnus-uu-post-inserted-file-name current-window-configuration gnus-uu-winconf-post-news gnus-summary-post-news use-local-map copy-keymap current-local-map local-set-key "" gnus-summary-edit-article-done gnus-uu-post-news-inews "" " " gnus-uu-post-insert-binary-in-article gnus-uu-post-include-before-composing gnus-uu-post-insert-binary] 3 (#$ . 34166) nil]) #@80 Inserts an encoded file in the buffer. The user will be asked for a file name. (defalias 'gnus-uu-post-insert-binary-in-article #[nil "pÀ !=„\fÂÃ!ˆŠÄ ‰)‡" [get-buffer gnus-post-news-buffer error "Not in post-news buffer" gnus-uu-post-insert-binary gnus-uu-post-inserted-file-name] 3 (#$ . 34674) nil]) (defalias 'gnus-uu-post-encode-uuencode #[(path file-name) "ÀÁ\n #…ebˆÄyˆÅÆÇÈ#ƒÉÊ!ˆ‚ȇ" [gnus-uu-post-encode-file "uuencode" path file-name 1 re-search-forward " " nil t replace-match "`"] 4]) (defalias 'gnus-uu-post-encode-mime-uuencode #[(path file-name) "À \n\"… Ã\nÄ\"ˆÅ‡" [gnus-uu-post-encode-uuencode path file-name gnus-uu-post-make-mime "x-uue" t] 3]) (defalias 'gnus-uu-post-encode-mime #[(path file-name) "ÀÁ\n #…Ä Å\"ˆÆ‡" [gnus-uu-post-encode-file "mmencode" path file-name gnus-uu-post-make-mime "base64" t] 4]) (defalias 'gnus-uu-post-make-mime #[(file-name encoding) "ebˆÀÁ \f\" #cˆÀÅ\"cˆŒqˆebˆÈÉÊ !ÌQ!ˆÍyˆÎ`}ˆÏÐ!„8~ˆÑcˆ~)‡" [format "Content-Type: %s; name=\"%s\"\n" gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list "Content-Transfer-Encoding: %s\n\n" encoding gnus-post-news-buffer re-search-forward "^" regexp-quote mail-header-separator "$" -1 1 mail-fetch-field "mime-version" "MIME-Version: 1.0\n"] 5]) (defalias 'gnus-uu-post-encode-file #[(command path file-name) "ÀÁÂÃÂÄÅÆ $&ÊU‡" [call-process "sh" nil t "-c" format "%s %s %s" command path file-name 0] 11]) #@116 Posts the composed news article and encoded file. If no file has been included, the user will be asked for a file. (defalias 'gnus-uu-post-news-inews #[nil "pÀ !=„\fÂÃ!ˆÄƒ‚Ç ƒUÉ\n>ƒ-\n‚1É\nBÄ \n <ƒA ‚D C Ì B Í Î\"ˆ*‚ZÍ Ä\"ˆ)Ä…gÐ!‡" [get-buffer gnus-post-news-buffer error "Not in post news buffer" nil file-name gnus-uu-post-inserted-file-name gnus-uu-post-insert-binary gnus-uu-post-threaded Message-ID gnus-required-headers gnus-inews-article-hook (lambda nil (save-excursion (goto-char (point-min)) (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t) (setq gnus-uu-post-message-id (buffer-substring (match-beginning 1) (match-end 1))) (setq gnus-uu-post-message-id nil)))) gnus-uu-post-encoded t gnus-uu-winconf-post-news set-window-configuration] 3 (#$ . 36096) nil]) (defalias 'gnus-uu-post-insert-binary #[nil "ÀÁ‰‰ÆÇ!È\f!„ÉÊ\f\"ˆdbˆËÌ \"cˆÎÏ\f\"ƒ/Ð\fÑÁOPÎÒ\f\"ƒ@\fÓ”TÁO‚B\fÔŽŠÕ !‰qˆÖ ˆ\f\n\")ƒ_Ø !ˆ‚cÉÙ!ˆ)\n,‡" ["*uuencode buffer*" nil file-name uubuf file-path uuencode-buffer-name read-file-name "What file do you want to encode? " file-exists-p error "%s: No such file" format "\n%s\n" gnus-uu-post-binary-separator string-match "^~/" "$HOME" 1 "/[^/]*$" 0 ((kill-buffer uubuf)) get-buffer-create erase-buffer gnus-uu-post-encode-method insert-buffer "Encoding unsuccessful"] 4]) (defalias 'gnus-uu-post-encoded #[(file-name &optional threaded) "ÀÁ ÄPʼn‰‰‰‰‰‰‰‰‰‰‰‰ \n \f p ebˆØƒNÚÛ!ÝQ‚TÚÛ !ÝQÅÞ#„^ßà!ˆáyˆâyˆ`dŠã!‰qˆä ˆå #ˆebˆæâd\"‰'¥'¦èW„žT)ƒ§éyˆê`d\"ˆebˆØÚÛ !ÝQÅÞ#ˆáyˆâ`{ebˆƒä+„áØìÅÞ#ƒáňíî\"cˆï ˆŠââ V„ã!qˆä ˆcˆ+ƒ0ƒíñ0\"cˆcˆòíó4ó&GZâõ¥‰ Vƒ6â íö ÷\"4öõ¦áUƒT S‚V ÷\"&\febˆØìÅÞ#ƒ—+„{ňíø#cˆ‚—õUƒ‡„“âUƒ—„—ùú!ˆdbˆŠqˆ bˆUƒ±dbˆ‚µ'yˆTUƒÊæ`d\"èWƒÊûyˆ`)å #ˆ\fcˆücˆ TebˆØÚÛ !ÝQÅÞ#ˆáyˆõyˆØÚÛ!ÝQÅÞ#ƒùó!ˆâyˆ\fcˆücˆï ˆ‚ë)ý!‰\nƒ-þ\n!ˆý!‰\nƒ<þ\n!ˆ?…TÿÅ!ˆ@A!…TA .‡" ["*uuencode send buffer*" "*encoded buffer*" "[ cut here %s (%s %d/%d) %s gnus-uu ]" mail-header-separator "\n\n" nil end-binary beg-binary whole-len post-buf buf minlen beg-line beg end i header parts length uubuf separator top-string encoded-buffer-name send-buffer-name re-search-forward gnus-uu-post-separate-description "^" regexp-quote gnus-uu-post-binary-separator "$" t error "Internal error: No binary/header separator" 0 1 get-buffer-create erase-buffer insert-buffer-substring count-lines gnus-uu-post-length 4 -1 kill-region threaded "^Subject: " format " (0/%d)" gnus-inews-news gnus-uu-post-message-id "References: %s\n" 62 "" file-name 2 make-string 45 " (%d/%d)" replace-match "Subject: Re: " -4 "\n" get-buffer kill-buffer set-buffer-modified-p fboundp bury-buffer] 19]) (provide (quote gnus-uu)) emacs-19.30/lisp/gnus-vis.elc100666 23053 1 71510 6046561467 14677 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:29:45 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/gnus-vis.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus-vis.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!‡" [require gnus gnus-ems easymenu custom] 2) #@54 *Hook run after the creation of the group mode menu. (defvar gnus-group-menu-hook nil (#$ . -554)) #@56 *Hook run after the creation of the summary mode menu. (defvar gnus-summary-menu-hook nil (#$ . -659)) #@56 *Hook run after the creation of the article mode menu. (defvar gnus-article-menu-hook nil (#$ . -768)) #@55 *Hook run after the creation of the server mode menu. (defvar gnus-server-menu-hook nil (#$ . -877)) #@55 *Hook run after the creation of the browse mode menu. (defvar gnus-browse-menu-hook nil (#$ . -984)) #@586 Alist of regexps matching buttons in an article. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where REGEXP: is the string matching text around the button, BUTTON: is the number of the regexp grouping actually matching the button, FORM: is a lisp expression which must eval to true for the button to be added, CALLBACK: is the function to call when the user push this button, and each PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. CALLBACK can also be a variable, in that case the value of that variable it the real callback function. (defvar gnus-button-alist (quote (("in\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 (assq (count-lines (point-min) (match-end 0)) gnus-cite-attribution-alist) gnus-button-message-id 3) ("]*\\)>" 0 t gnus-button-url 1) ("\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]" 0 t gnus-button-url 0))) (#$ . 1092)) (byte-code "ÀÁÂ\"ˆÀÃÄÅÆ$‡" [autoload nnkiboze-generate-groups "nnkiboze" gnus-cite-parse-maybe "gnus-cite" nil t] 5) (defalias 'gnus-visual-turn-off-edit-menu #[(type) "ÀÁÂÃ\f\"!JÅÆ#‡" [define-key intern format "gnus-%s-mode-map" type [menu-bar edit] undefined] 5]) (defalias 'gnus-group-make-menu-bar #[nil "ÀÁ!ˆÂÃ!†]ÂÃ!„Äà BÆÃÇÈ#ˆÉÃ\nÈË$ˆÂÌ!„-Ä\fÌ BÆÌÇÈ#ˆÉÌ\nÈÍ$ˆÂÎ!„HÄÎ BÆÎÇÈ#ˆÉÎ\nÈÏ$ˆÐÑ!‡" [gnus-visual-turn-off-edit-menu group boundp gnus-group-reading-menu nil current-load-list put variable-documentation "" easy-menu-do-define gnus-group-mode-map ("Group" ["Read" gnus-group-read-group t] ["Select" gnus-group-select-group t] ["See old articles" gnus-group-select-group-all t] ["Catch up" gnus-group-catchup-current t] ["Catch up all articles" gnus-group-catchup-current-all t] ["Check for new articles" gnus-group-get-new-news-this-group t] ["Toggle subscription" gnus-group-unsubscribe-current-group t] ["Kill" gnus-group-kill-group t] ["Yank" gnus-group-yank-group t] ["Describe" gnus-group-describe-group t] ["Fetch FAQ" gnus-group-fetch-faq t] ["Edit kill file" gnus-group-edit-local-kill t] ["Expire articles" gnus-group-expire-articles t] ["Set group level" gnus-group-set-current-level t]) gnus-group-group-menu ("Groups" ("Listing" ["List subscribed groups" gnus-group-list-groups t] ["List all groups" gnus-group-list-all-groups t] ["List groups matching..." gnus-group-list-matching t] ["List killed groups" gnus-group-list-killed t] ["List zombie groups" gnus-group-list-zombies t] ["Describe all groups" gnus-group-describe-all-groups t] ["Group apropos" gnus-group-apropos t] ["Group and description apropos" gnus-group-description-apropos t] ["List groups matching..." gnus-group-list-matching t]) ("Mark" ["Mark group" gnus-group-mark-group t] ["Unmark group" gnus-group-unmark-group t] ["Mark region" gnus-group-mark-region t]) ("Subscribe" ["Subscribe to random group" gnus-group-unsubscribe-group t] ["Kill all newsgroups in region" gnus-group-kill-region t] ["Kill all zombie groups" gnus-group-kill-all-zombies t]) ("Foreign groups" ["Make a foreign group" gnus-group-make-group t] ["Add a directory group" gnus-group-make-directory-group t] ["Add the help group" gnus-group-make-help-group t] ["Add the archive group" gnus-group-make-archive-group t] ["Make a doc group" gnus-group-make-doc-group t] ["Make a kiboze group" gnus-group-make-kiboze-group t] ["Make a virtual group" gnus-group-make-empty-virtual t] ["Add a group to a virtual" gnus-group-add-to-virtual t]) ("Editing groups" ["Parameters" gnus-group-edit-group-parameters t] ["Select method" gnus-group-edit-group-method t] ["Info" gnus-group-edit-group t]) ["Read a directory as a group" gnus-group-enter-directory t] ["Jump to group" gnus-group-jump-to-group t] ["Best unread group" gnus-group-best-unread-group t]) gnus-group-misc-menu ("Misc" ["Send a bug report" gnus-bug t] ["Send a mail" gnus-group-mail t] ["Post an article" gnus-group-post-news t] ["Customize score file" gnus-score-customize (not (string-match "XEmacs" emacs-version))] ["Check for new news" gnus-group-get-new-news t] ["Delete bogus groups" gnus-group-check-bogus-groups t] ["Find new newsgroups" gnus-find-new-newsgroups t] ["Restart Gnus" gnus-group-restart t] ["Read init file" gnus-group-read-init-file t] ["Browse foreign server" gnus-group-browse-foreign-server t] ["Enter server buffer" gnus-group-enter-server-mode t] ["Expire expirable articles" gnus-group-expire-all-groups t] ["Generate any kiboze groups" nnkiboze-generate-groups t] ["Gnus version" gnus-version t] ["Save .newsrc files" gnus-group-save-newsrc t] ["Suspend Gnus" gnus-group-suspend t] ["Clear dribble buffer" gnus-group-clear-dribble t] ["Exit from Gnus" gnus-group-exit t] ["Exit without saving" gnus-group-quit t] ["Edit global kill file" gnus-group-edit-global-kill t] ["Sort group buffer" gnus-group-sort-groups t]) run-hooks gnus-group-menu-hook] 5]) (defalias 'gnus-server-make-menu-bar #[nil "ÀÁ!ˆÂÃ!†'ÂÃ!„Äà BÆÃÇÈ#ˆÉÃ\nÈË$ˆÌÍ!‡" [gnus-visual-turn-off-edit-menu server boundp gnus-server-menu nil current-load-list put variable-documentation "" easy-menu-do-define gnus-server-mode-map ("Server" ["Add" gnus-server-add-server t] ["Browse" gnus-server-read-server t] ["List" gnus-server-list-servers t] ["Kill" gnus-server-kill-server t] ["Yank" gnus-server-yank-server t] ["Copy" gnus-server-copy-server t] ["Edit" gnus-server-edit-server t] ["Exit" gnus-server-exit t]) run-hooks gnus-server-menu-hook] 5]) (defalias 'gnus-browse-make-menu-bar #[nil "ÀÁ!ˆÂÃ!†'ÂÃ!„Äà BÆÃÇÈ#ˆÉÃ\nÈË$ˆÌÍ!‡" [gnus-visual-turn-off-edit-menu browse boundp gnus-browse-menu nil current-load-list put variable-documentation "" easy-menu-do-define gnus-browse-mode-map ("Browse" ["Subscribe" gnus-browse-unsubscribe-current-group t] ["Read" gnus-group-read-group t] ["Exit" gnus-browse-exit t]) run-hooks gnus-browse-menu-hook] 5]) (defalias 'gnus-summary-make-menu-bar #[nil "ÀÁ!ˆÂÃ!† ÂÃ!„Äà BÆÃÇÈ#ˆÉÃ\nÈË$ˆÂÌ!„-Ä\fÌ BÆÌÇÈ#ˆÉÌ\nÈÍÎCÏÐ!¤ÏÑ!¤Ò¤B$ˆÂÓ!„UÄÓ BÆÓÇÈ#ˆÉÓ\nÈÔ$ˆÂÕ!„pÄÕ BÆÕÇÈ#ˆÉÕ\nÈÖ$ˆÂ×!„‹Ä× BÆ×ÇÈ#ˆÉ×\nÈØ$ˆÙÚ!‡" [gnus-visual-turn-off-edit-menu summary boundp gnus-summary-misc-menu nil current-load-list put variable-documentation "" easy-menu-do-define gnus-summary-mode-map ("Misc" ("Mark" ("Read" ["Mark as read" gnus-summary-mark-as-read-forward t] ["Mark same subject and select" gnus-summary-kill-same-subject-and-select t] ["Mark same subject" gnus-summary-kill-same-subject t] ["Catchup" gnus-summary-catchup t] ["Catchup all" gnus-summary-catchup-all t] ["Catchup to here" gnus-summary-catchup-to-here t] ["Catchup region" gnus-summary-mark-region-as-read t]) ("Various" ["Tick" gnus-summary-tick-article-forward t] ["Mark as dormant" gnus-summary-mark-as-dormant t] ["Remove marks" gnus-summary-clear-mark-forward t] ["Set expirable mark" gnus-summary-mark-as-expirable t] ["Set bookmark" gnus-summary-set-bookmark t] ["Remove bookmark" gnus-summary-remove-bookmark t]) ("Display" ["Remove lines marked as read" gnus-summary-remove-lines-marked-as-read t] ["Remove lines marked with..." gnus-summary-remove-lines-marked-with t] ["Show dormant articles" gnus-summary-show-all-dormant t] ["Hide dormant articles" gnus-summary-hide-all-dormant t] ["Show expunged articles" gnus-summary-show-all-expunged t]) ("Process mark" ["Set mark" gnus-summary-mark-as-processable t] ["Remove mark" gnus-summary-unmark-as-processable t] ["Remove all marks" gnus-summary-unmark-all-processable t] ["Mark series" gnus-uu-mark-series t] ["Mark region" gnus-uu-mark-region t] ["Mark by regexp" gnus-uu-mark-by-regexp t] ["Mark all" gnus-uu-mark-all t] ["Mark sparse" gnus-uu-mark-sparse t] ["Mark thread" gnus-uu-mark-thread t])) ("Move" ["Scroll article forwards" gnus-summary-next-page t] ["Next unread article" gnus-summary-next-unread-article t] ["Previous unread article" gnus-summary-prev-unread-article t] ["Next article" gnus-summary-next-article t] ["Previous article" gnus-summary-prev-article t] ["Next article same subject" gnus-summary-next-same-subject t] ["Previous article same subject" gnus-summary-prev-same-subject t] ["First unread article" gnus-summary-first-unread-article t] ["Go to subject number..." gnus-summary-goto-subject t] ["Go to the last article" gnus-summary-goto-last-article t] ["Pop article off history" gnus-summary-pop-article t]) ("Sort" ["Sort by number" gnus-summary-sort-by-number t] ["Sort by author" gnus-summary-sort-by-author t] ["Sort by subject" gnus-summary-sort-by-subject t] ["Sort by date" gnus-summary-sort-by-date t] ["Sort by score" gnus-summary-sort-by-score t]) ("Exit" ["Catchup and exit" gnus-summary-catchup-and-exit t] ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] ["Exit group" gnus-summary-exit t] ["Exit group without updating" gnus-summary-exit-no-update t] ["Reselect group" gnus-summary-reselect-current-group t] ["Rescan group" gnus-summary-rescan-group t]) ["Fetch group FAQ" gnus-summary-fetch-faq t] ["Filter articles" gnus-summary-execute-command t] ["Toggle line truncation" gnus-summary-toggle-truncation t] ["Expire expirable articles" gnus-summary-expire-articles t] ["Describe group" gnus-summary-describe-group t] ["Edit local kill file" gnus-summary-edit-local-kill t]) gnus-summary-kill-menu "Score" ["Enter score" gnus-summary-score-entry t] gnus-visual-score-map increase lower (["Current score" gnus-summary-current-score t] ["Set score" gnus-summary-set-score t] ["Customize score file" gnus-score-customize t] ["Switch current score file" gnus-score-change-score-file t] ["Set mark below" gnus-score-set-mark-below t] ["Set expunge below" gnus-score-set-expunge-below t] ["Edit current score file" gnus-score-edit-alist t] ["Edit score file" gnus-score-edit-file t] ["Trace score" gnus-score-find-trace t] ["Increase score" gnus-summary-increase-score t] ["Lower score" gnus-summary-lower-score t]) gnus-summary-article-menu ("Article" ("Hide" ["All" gnus-article-hide t] ["Headers" gnus-article-hide-headers t] ["Signature" gnus-article-hide-signature t] ["Citation" gnus-article-hide-citation t]) ("Highlight" ["All" gnus-article-highlight t] ["Headers" gnus-article-highlight-headers t] ["Signature" gnus-article-highlight-signature t] ["Citation" gnus-article-highlight-citation t]) ("Date" ["Local" gnus-article-date-local t] ["UT" gnus-article-date-ut t] ["Lapsed" gnus-article-date-lapsed t]) ("Filter" ["Overstrike" gnus-article-treat-overstrike t] ["Word wrap" gnus-article-word-wrap t] ["CR" gnus-article-remove-cr t] ["Show X-Face" gnus-article-display-x-face t] ["Quoted-Printable" gnus-article-de-quoted-unreadable t] ["Rot 13" gnus-summary-caesar-message t] ["Add buttons" gnus-article-add-buttons t] ["Stop page breaking" gnus-summary-stop-page-breaking t] ["Toggle MIME" gnus-summary-toggle-mime t] ["Toggle header" gnus-summary-toggle-header t]) ("Output" ["Save in default format" gnus-summary-save-article t] ["Save in file" gnus-summary-save-article-file t] ["Save in Unix mail format" gnus-summary-save-article-mail t] ["Save in MH folder" gnus-summary-save-article-folder t] ["Save in VM folder" gnus-summary-save-article-vm t] ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] ["Pipe through a filter" gnus-summary-pipe-output t]) ("Backend" ["Respool article" gnus-summary-respool-article t] ["Move article" gnus-summary-move-article t] ["Copy article" gnus-summary-copy-article t] ["Import file" gnus-summary-import-article t] ["Edit article" gnus-summary-edit-article t] ["Delete article" gnus-summary-delete-article t]) ("Extract" ["Uudecode" gnus-uu-decode-uu t] ["Uudecode and save" gnus-uu-decode-uu-and-save t] ["Unshar" gnus-uu-decode-unshar t] ["Unshar and save" gnus-uu-decode-unshar-and-save t] ["Save" gnus-uu-decode-save t] ["Binhex" gnus-uu-decode-binhex t]) ["Enter digest buffer" gnus-summary-enter-digest-group t] ["Isearch article" gnus-summary-isearch-article t] ["Search all articles" gnus-summary-search-article-forward t] ["Beginning of the article" gnus-summary-beginning-of-article t] ["End of the article" gnus-summary-end-of-article t] ["Fetch parent of article" gnus-summary-refer-parent-article t] ["Fetch article with id..." gnus-summary-refer-article t] ["Redisplay" gnus-summary-show-article t]) gnus-summary-thread-menu ("Threads" ["Toggle threading" gnus-summary-toggle-threads t] ["Display hidden thread" gnus-summary-show-thread t] ["Hide thread" gnus-summary-hide-thread t] ["Go to next thread" gnus-summary-next-thread t] ["Go to previous thread" gnus-summary-prev-thread t] ["Go down thread" gnus-summary-down-thread t] ["Go up thread" gnus-summary-up-thread t] ["Mark thread as read" gnus-summary-kill-thread t] ["Lower thread score" gnus-summary-lower-thread t] ["Raise thread score" gnus-summary-raise-thread t]) gnus-summary-post-menu ("Post" ["Post an article" gnus-summary-post-news t] ["Followup" gnus-summary-followup t] ["Followup and yank" gnus-summary-followup-with-original t] ["Supersede article" gnus-summary-supersede-article t] ["Cancel article" gnus-summary-cancel-article t] ["Reply" gnus-summary-reply t] ["Reply and yank" gnus-summary-reply-with-original t] ["Mail forward" gnus-summary-mail-forward t] ["Post forward" gnus-summary-post-forward t] ["Digest and mail" gnus-uu-digest-mail-forward t] ["Digest and post" gnus-uu-digest-post-forward t] ["Send a mail" gnus-summary-mail-other-window t] ["Reply & followup" gnus-summary-followup-and-reply t] ["Reply & followup and yank" gnus-summary-followup-and-reply-with-original t] ["Uuencode and post" gnus-uu-post-news t]) run-hooks gnus-summary-menu-hook] 8]) (defalias 'gnus-score-set-default #[(var value) " LˆÂÃ!‡" [var value message ""] 2]) #@240 Default header when entering new scores. Should be one of the following symbols. a: from s: subject b: body h: head i: message-id t: references x: xref l: lines d: date f: followup If nil, the user will be asked for a header. (defvar gnus-score-default-header nil (#$ . 14809)) #@311 Default match type when entering new scores. Should be one of the following symbols. s: substring e: exact string f: fuzzy string r: regexp string b: before date a: at date n: this date <: less than number >: greater than number =: equal to number If nil, the user will be asked for a match type. (defvar gnus-score-default-type nil (#$ . 15107)) #@58 Use case folding for new score file entries iff not nil. (defvar gnus-score-default-fold nil (#$ . 15473)) #@44 Toggle folding for new score file entries. (defalias 'gnus-score-default-fold-toggle #[nil "?‰ƒ ÁÂ!‡ÁÃ!‡" [gnus-score-default-fold message "New score file entries will be case insensitive." "New score file entries will be case sensitive."] 3 (#$ . 15586) nil]) #@186 Default duration of effect when entering new scores. Should be one of the following symbols. t: temporary p: permanent i: immediate If nil, the user will be asked for a duration. (defvar gnus-score-default-duration nil (#$ . 15857)) (defalias 'gnus-visual-score-map #[(type) "À‡" [nil] 1]) (defalias 'gnus-article-make-menu-bar #[nil "ÀÁ!ˆÂÃ!†BÂÃ!„Äà BÆÃÇÈ#ˆÉÃ\nÈË$ˆÂÌ!„-Ä\fÌ BÆÌÇÈ#ˆÉÌ\nÈÍ$ˆÎÏ!‡" [gnus-visual-turn-off-edit-menu summary boundp gnus-article-article-menu nil current-load-list put variable-documentation "" easy-menu-do-define gnus-article-mode-map ("Article" ["Scroll forwards" gnus-article-next-page t] ["Scroll backwards" gnus-article-prev-page t] ["Show summary" gnus-article-show-summary t] ["Fetch Message-ID at point" gnus-article-refer-article t] ["Mail to address at point" gnus-article-mail t]) gnus-article-treatment-menu ("Treatment" ["Hide headers" gnus-article-hide-headers t] ["Hide signature" gnus-article-hide-signature t] ["Hide citation" gnus-article-hide-citation t] ["Treat overstrike" gnus-article-treat-overstrike t] ["Remove carriage return" gnus-article-remove-cr t] ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]) run-hooks gnus-article-menu-hook] 5]) (defalias 'gnus-highlight-selected-summary #[nil "…dŠÁyˆ`È`Å\nÆ\"ƒ\n‚%Ç\nÆÃ\f$†$\nTÇÆÃ\f$†2\fS‰ Ê\\UƒD\n\f  ƒUÌ  p$‚cÍ \" Î Ï#-‡" [gnus-summary-selected-face 0 beg nil end get-text-property mouse-face next-single-property-change from to 2 gnus-newsgroup-selected-overlay gnus-move-overlay gnus-make-overlay gnus-overlay-put face] 6]) #@63 Highlight current line according to `gnus-summary-highlight'. (defalias 'gnus-summary-highlight-line #[nil "`È`Åyˆ`ÇÈ\"† \nžA†& †&Å\f  ÇÎ\"Ð ƒIÒ @@!„I A‰„: …P @Am„wÇÓ\"=„wÔ\fÓÕ!ƒsJ‚u$ˆ)\nb.‡" [gnus-summary-highlight list p nil end 0 beg get-text-property gnus-number gnus-current-article gnus-newsgroup-scored gnus-summary-default-score score default gnus-mark mark t inhibit-read-only eval face put-text-property boundp] 7 (#$ . 17459)]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÇÆ BÀÈ!„.ÉÈ BÀÊ!„;Ë\nÊ BÀÌ!„HÍ\fÌ BÀÎ!„UÏÎ BÀÐ!„bÑÐ BÀÒ!„oÓÒ BÓ‡" [boundp gnus-carpal-group-buffer-buttons (("next" . gnus-group-next-unread-group) ("prev" . gnus-group-prev-unread-group) ("read" . gnus-group-read-group) ("select" . gnus-group-select-group) ("catch-up" . gnus-group-catchup-current) ("new-news" . gnus-group-get-new-news-this-group) ("toggle-sub" . gnus-group-unsubscribe-current-group) ("subscribe" . gnus-group-unsubscribe-group) ("kill" . gnus-group-kill-group) ("yank" . gnus-group-yank-group) ("describe" . gnus-group-describe-group) "list" ("subscribed" . gnus-group-list-groups) ("all" . gnus-group-list-all-groups) ("killed" . gnus-group-list-killed) ("zombies" . gnus-group-list-zombies) ("matching" . gnus-group-list-matching) ("post" . gnus-group-post-news) ("mail" . gnus-group-mail) ("rescan" . gnus-group-get-new-news) ("browse-foreign" . gnus-group-browse-foreign) ("exit" . gnus-group-exit)) current-load-list gnus-carpal-summary-buffer-buttons ("mark" ("read" . gnus-summary-mark-as-read-forward) ("tick" . gnus-summary-tick-article-forward) ("clear" . gnus-summary-clear-mark-forward) ("expirable" . gnus-summary-mark-as-expirable) "move" ("scroll" . gnus-summary-next-page) ("next-unread" . gnus-summary-next-unread-article) ("prev-unread" . gnus-summary-prev-unread-article) ("first" . gnus-summary-first-unread-article) ("best" . gnus-summary-best-unread-article) "article" ("headers" . gnus-summary-toggle-header) ("uudecode" . gnus-uu-decode-uu) ("enter-digest" . gnus-summary-enter-digest-group) ("fetch-parent" . gnus-summary-refer-parent-article) "mail" ("move" . gnus-summary-move-article) ("copy" . gnus-summary-copy-article) ("respool" . gnus-summary-respool-article) "threads" ("lower" . gnus-summary-lower-thread) ("kill" . gnus-summary-kill-thread) "post" ("post" . gnus-summary-post-news) ("mail" . gnus-summary-mail) ("followup" . gnus-summary-followup-with-original) ("reply" . gnus-summary-reply-with-original) ("cancel" . gnus-summary-cancel-article) "misc" ("exit" . gnus-summary-exit) ("fed-up" . gnus-summary-catchup-and-goto-next-group)) gnus-carpal-server-buffer-buttons (("add" . gnus-server-add-server) ("browse" . gnus-server-browse-server) ("list" . gnus-server-list-servers) ("kill" . gnus-server-kill-server) ("yank" . gnus-server-yank-server) ("copy" . gnus-server-copy-server) ("exit" . gnus-server-exit)) gnus-carpal-browse-buffer-buttons (("subscribe" . gnus-browse-unsubscribe-current-group) ("exit" . gnus-browse-exit)) gnus-carpal-group-buffer "*Carpal Group*" gnus-carpal-summary-buffer "*Carpal Summary*" gnus-carpal-server-buffer "*Carpal Server*" gnus-carpal-browse-buffer "*Carpal Browse*" gnus-carpal-attached-buffer nil] 2) #@35 *Hook run in carpal mode buffers. (defvar gnus-carpal-mode-hook nil (#$ . -20724)) #@31 *Face used on carpal buttons. (defvar gnus-carpal-button-face (quote bold) (#$ . -20813)) #@38 *Face used on carpal buffer headers. (defvar gnus-carpal-header-face (quote bold-italic) (#$ . -20909)) (byte-code "ÀÁ!„ÂÁ BÄÅÆÇ#ˆ „0È É !ˆÊ ËÌ#ˆÊ ÍÌ#ˆÊ Ï#ˆÂ‡" [boundp gnus-carpal-mode-map nil current-load-list put gnus-carpal-mode mode-class special make-keymap suppress-keymap define-key " " gnus-carpal-select " " gnus-mouse-2 gnus-carpal-mouse-select] 4) #@168 Major mode for clicking buttons. All normal editing commands are switched off. \ The following commands are available: \{gnus-carpal-mode-map} (defalias 'gnus-carpal-mode #[nil "À ˆÁÃÅÇÉ\n!ˆËp!ˆÌ ÎÏ!ˆÐÑ!‡" [kill-all-local-variables "-- " mode-line-modified gnus-carpal-mode major-mode "Gnus Carpal" mode-name nil mode-line-process use-local-map gnus-carpal-mode-map buffer-disable-undo t buffer-read-only make-local-variable gnus-carpal-attached-buffer run-hooks gnus-carpal-mode-hook] 2 (#$ . 21283) nil]) (defalias 'gnus-carpal-setup-buffer #[(type) "ÀÁ \"!JÅ\f!?…ˆŠÆ\f!qˆÇ ˆÀÁÈ \"! Ê ˆÀÁË \"!J̉ ƒu@ A ;ƒZÐ` cˆ`ÑcˆÒD#ˆ‚2Ð` @cˆ`ÑcˆÔ AÒÖׯ#ˆ‚2Ø ÙZÛed\"ˆ)ÜÝp!e\",)‡" [intern format "gnus-carpal-%s-buffer" type buffer get-buffer get-buffer-create gnus-carpal-mode "gnus-%s-buffer" gnus-carpal-attached-buffer gnus-add-current-to-buffer-list "gnus-carpal-%s-buffer-buttons" nil button buffer-read-only buttons set-text-properties " " face gnus-carpal-header-face gnus-callback gnus-carpal-button-face mouse-face highlight window-width 2 fill-column fill-region set-window-point get-buffer-window] 9]) #@32 Select the button under point. (defalias 'gnus-carpal-select #[nil "À`Á\"‰…Ã\fJ!ˆÅ\n!)‡" [get-text-property gnus-callback func pop-to-buffer gnus-carpal-attached-buffer call-interactively] 4 (#$ . 22454) nil]) #@44 Select the button under the mouse pointer. (defalias 'gnus-carpal-mouse-select #[(event) "À !ˆÂ ‡" [mouse-set-point event gnus-carpal-select] 2 (#$ . 22673) "e"]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp gnus-button-regexp nil current-load-list gnus-button-last] 2) #@186 Check text under the mouse pointer for a callback function. If the text under the mouse pointer has a `gnus-callback' property, call it with the value of the `gnus-data' text property. (defalias 'gnus-article-push-button #[(event) "À ‰A@)‰@)!qˆ ‰A@)‰A@:ƒ#\nA@@‚&\nA@)Ä Å\"Ä Ç\"‰…=!+‡" [window-buffer event position pos get-text-property gnus-data data gnus-callback fun] 4 (#$ . 22953) "e"]) #@156 Check text at point for a callback function. If the text at point has a `gnus-callback' property, call it with the value of the `gnus-data' text property. (defalias 'gnus-article-press-button #[nil "À`Á\"À`Ã\"‰…\f\n!*‡" [get-text-property gnus-data data gnus-callback fun] 4 (#$ . 23368) nil]) #@28 Move point to next button. (defalias 'gnus-article-next-button #[nil "À`Á\"ƒÂ`ÁÃd$bˆÂ`Á\"‰ƒ\fb‚.ÂeÁ\"‰ƒ+\fb‚.ÅÆ!)‡" [get-text-property gnus-callback next-single-property-change nil pos error "No buttons found"] 6 (#$ . 23672) nil]) #@253 Highlight current article. This function calls `gnus-article-highlight-headers', `gnus-article-highlight-citation', `gnus-article-highlight-signature', and `gnus-article-add-buttons' to do the highlighting. See the documentation for those functions. (defalias 'gnus-article-highlight #[(&optional force) "À ˆÁ\n!ˆÃ ˆÄ\n!‡" [gnus-article-highlight-headers gnus-article-highlight-citation force gnus-article-highlight-signature gnus-article-add-buttons] 2 (#$ . 23920) (list (quote force))]) #@217 Highlight current article. This function calls `gnus-article-highlight-headers', `gnus-article-highlight-signature', and `gnus-article-add-buttons' to do the highlighting. See the documentation for those functions. (defalias 'gnus-article-highlight-some #[(&optional force) "À ˆÁ ˆÂ ‡" [gnus-article-highlight-headers gnus-article-highlight-signature gnus-article-add-buttons] 1 (#$ . 24419) (list (quote force))]) #@204 Hide current article. This function calls `gnus-article-hide-headers', `gnus-article-hide-citation-maybe', and `gnus-article-hide-signature' to do the hiding. See the documentation for those functions. (defalias 'gnus-article-hide #[(&optional force) "À ˆÁ\n!ˆÃ ‡" [gnus-article-hide-headers gnus-article-hide-citation-maybe force gnus-article-hide-signature] 2 (#$ . 24842) (list (quote force))]) #@69 Highlight article headers as specified by `gnus-header-face-alist'. (defalias 'gnus-article-highlight-headers #[nil "ŠqˆebˆÁÂÃÄ#…»Åyˆo?…»ÃÄ`Äɉ‰‰‰‰ \n \f ÓÔÃÄ#ˆ` ƒ¶@‰\f@ \fA@\nÕ\f8 AÖ !ƒ¯`ØÃwˆ„ˆ\nƒˆÙ`Ú\n$ˆÄ„® ƒ®ÛÃwˆ`bˆÜÃxˆÙ`Ú $ˆÄ)) bˆ‚E.\f‚)‡" [gnus-article-buffer search-forward "\n\n" nil t -1 gnus-header-face-alist field-found header-found field-face header-face regexp entry begin inhibit-point-motion-hooks end case-fold-search buffer-read-only alist re-search-backward "^[^ ]" 2 looking-at from "^:\n" put-text-property face ": " " "] 13 (#$ . 25247) nil]) #@142 Highlight the signature in an article. It does this by highlighting everything after `gnus-signature-separator' using `gnus-signature-face'. (defalias 'gnus-article-highlight-signature #[nil "ŠqˆÁÂdbˆÅÁÂ#…6…6Ȕȕ \nË\n Ì $ˆÍÎ d\"Ï#*+‡" [gnus-article-buffer nil t inhibit-point-motion-hooks buffer-read-only re-search-backward gnus-signature-separator gnus-signature-face 0 end start gnus-article-add-button gnus-signature-toggle gnus-overlay-put gnus-make-overlay face] 5 (#$ . 25894) nil]) #@113 Hide the signature in an article. It does this by making everything after `gnus-signature-separator' invisible. (defalias 'gnus-article-hide-signature #[nil "ŠqˆÁdbˆÃ\fÁÅ#……ÇÈ•d #*‡" [gnus-article-buffer nil buffer-read-only re-search-backward gnus-signature-separator t gnus-signature-face add-text-properties 0 gnus-hidden-properties] 4 (#$ . 26409) nil]) #@160 Find external references in article and make them to buttons. External references are things like message-ids and URLs, as specified by `gnus-button-alist'. (defalias 'gnus-article-add-buttons #[(&optional force) " =„Âà Ä# ŠqˆÇ!ˆÉʉ \f ebˆÎÏÉÊ#„/dbˆÐ ÉÊ#…Ñ”bˆ`Ó ‰…KA@”…WA@•×8ƒ}Ñ•bˆÙ!ƒ}ÚÛÜ É“$ˆ-‚/,‡" [gnus-button-last gnus-button-alist mapconcat car "\\|" gnus-button-regexp gnus-article-buffer gnus-cite-parse-maybe force nil t case-fold-search inhibit-point-motion-hooks buffer-read-only search-forward "\n\n" re-search-forward 0 from gnus-button-entry entry start end 2 form eval gnus-article-add-button gnus-button-push make-marker] 8 (#$ . 26783) (list (quote force))]) #@52 Open URL in netscape, or start new scape with URL. (defalias 'gnus-netscape-open-url #[(url) "ÀÁ\nPÃÄÅÆ\nÇQ%ÉÊËÌÍÎ\nDEE\")‡" [start-process "netscape " url nil "netscape" "-remote" "openUrl(" ")'" process set-process-sentinel lambda (process change) or (eq (process-exit-status process) 0) gnus-netscape-start-url] 8 (#$ . 27514)]) #@26 Start netscape with URL. (defalias 'gnus-netscape-start-url #[(url) "ÀÁ\nPÃÁ\n$‡" [start-process "netscape" url nil] 5 (#$ . 27856)]) #@70 Create a button between FROM and TO with callback FUN and data DATA. (defalias 'gnus-article-add-button #[(from to fun &optional data) "ƒ Á \f\"Å#ˆÆ \fÇ…ÉDÊ D\f…'Í\fD##‡" [gnus-article-button-face gnus-overlay-put gnus-make-overlay from to face add-text-properties append gnus-article-mouse-face mouse-face gnus-callback fun data gnus-data] 8 (#$ . 27996)]) (defalias 'gnus-signature-toggle #[(end) "ŠqˆÁÃ\fÅ\"ƒÆ\fd#‚È\fd#*‡" [gnus-article-buffer nil buffer-read-only get-text-property end invisible remove-text-properties gnus-hidden-properties add-text-properties] 4]) (defalias 'gnus-button-entry #[nil "Á ƒ @ AÄ\n@!ƒÁ‰‚Á‚\n*‡" [gnus-button-alist nil entry alist looking-at] 3]) (defalias 'gnus-button-push #[(marker) "Šqˆ bˆÂ ÄÆ 8ÈÉÊ ›\" Ì!ƒ)Í \"‚JÎ!ƒBÌJ!ƒBÍJ \"‚JÏÐ B\"-‡" [gnus-article-buffer marker gnus-button-entry entry t inhibit-point-motion-hooks 3 fun mapcar #[(group) "”•{Âà GÄ $ˆ )‡" [group string set-text-properties 0 nil] 5] 4 args fboundp apply boundp message "You must define `%S' to use this button"] 4]) (defalias 'gnus-button-message-id #[(message-id) "ŠqˆÁ\n!)‡" [gnus-summary-buffer gnus-summary-refer-article message-id] 2]) (byte-code "ÀÁ!„\nÁÂMˆÃ ˆÄÅ!‡" [fboundp rassoc #[(elt list) "À\nƒ\n@‰A šƒÀ‰‚À\nA‰„ )‡" [nil result list elt] 3 "Return non-nil if ELT is `equal' to the cdr of an element of LIST.\nThe value is actually the element of LIST whose cdr is ELT."] gnus-ems-redefine provide gnus-vis] 2) emacs-19.30/lisp/gnus-vm.elc100666 23053 1 13564 6046561500 14511 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:29:47 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/gnus-vm.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus-vm.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!‡" [require sendmail gnus gnus-msg] 2) #@92 Inhibit loading `win-vm' if using a window-system. Has to be set before gnus-vm is loaded. (defvar gnus-vm-inhibit-window-system nil (#$ . 541)) (byte-code "„ ÁÂÈÄÅ!„ÆÇ!ˆÁ‡" [gnus-vm-inhibit-window-system nil (byte-code "ƒÁÂ!ˆÁ‡" [window-system require win-vm] 2) ((error)) featurep vm load "vm"] 3) (defalias 'gnus-vm-make-folder #[(&optional buffer) "†pÁÂ!ed qˆÇ\f #ˆebˆÈÉ!ƒ,ÊËÌ P!ˆ‚6ÍÏÌ Ð±ˆÑÒÓÔ#ƒEÊÕ!ˆ‚6dbˆÐcˆÖ ˆ ,‡" [buffer generate-new-buffer " *tmp-folder*" end start tmp-folder article insert-buffer-substring looking-at "^\\(From [^ ]+ \\).*$" replace-match "\\1" current-time-string "From " gnus-newsgroup-name " " "\n" re-search-forward "\n\nFrom " nil t "\n\n>From " vm-mode] 5]) #@252 Append the current article to a vm folder. If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead. (defalias 'gnus-summary-save-article-vm #[(&optional arg) "À !)‡" [gnus-summary-save-in-vm gnus-default-article-saver gnus-summary-save-article arg] 2 (#$ . 1265) "P"]) (defalias 'gnus-summary-save-in-vm #[(&optional folder) " \n # „ÆÇÈ\f!ÉQÊ\f!\f#Ë \f… Ê\f!\"ÌÊ !!ˆ qˆŠŒ~ˆÎ Ð !ˆÑ!ˆ+ ‰)‡" [gnus-mail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-mail default-name folder read-file-name "Save article in VM folder: (default " file-name-nondirectory ") " file-name-directory expand-file-name gnus-make-directory gnus-article-buffer gnus-vm-make-folder vm-folder vm-save-message kill-buffer] 4 nil nil]) #@55 Forward the current message to another user using vm. (defalias 'gnus-mail-forward-using-vm #[(&optional buffer) "†p !ÄÅ!„\"ƒÇ!ˆ‚\"É!ˆÊ ˆ qˆŠŒ~ˆÌ ÍÎJÏ\"Ñ ˆÒ !ˆÓÔ!ˆÕ!.‡" [buffer gnus-buffer gnus-forward-make-subject subject featurep win-vm gnus-use-full-window pop-to-buffer gnus-article-buffer switch-to-buffer gnus-copy-article-buffer gnus-article-copy gnus-vm-make-folder append vm-forward-message-hook ((lambda nil (save-excursion (mail-position-on-field "Subject") (beginning-of-line) (looking-at "^\\(Subject: \\).*$") (replace-match (concat "\\1" subject))))) vm-folder vm-forward-message gnus-vm-init-reply-buffer run-hooks gnus-mail-hook kill-buffer] 4 (#$ . 2163)]) (defalias 'gnus-vm-init-reply-buffer #[(buffer) "ÀÁ!ˆ\nÃÄLˆÅÆÇ !!ˆÈÉÊ\"‡" [make-local-variable gnus-summary-buffer buffer vm-mail-buffer nil use-local-map copy-keymap current-local-map local-set-key "" gnus-yank-article] 3]) #@160 Compose reply mail using vm. Optional argument YANK means yank original article. The command \[vm-yank-message] yank the original message into current buffer. (defalias 'gnus-mail-reply-using-vm #[(&optional yank) "pÁ ˆ\nqˆŠŒ~ˆÃ\n!ÅÆ!ˆÇ!ˆpƒ#ÉÊ!ˆË\f!ˆ+ÌÍ!„2Î!ˆÏÐ!)‡" [gnus-buffer gnus-copy-article-buffer gnus-article-copy gnus-vm-make-folder vm-folder vm-reply 1 gnus-vm-init-reply-buffer yank gnus-yank-article nil kill-buffer featurep win-vm pop-to-buffer run-hooks gnus-mail-hook] 2 (#$ . 3097)]) #@44 Compose mail in the other window using VM. (defalias 'gnus-mail-other-window-using-vm #[nil "pÁ ˆÂ!ˆ)ÃÄ!‡" [gnus-buffer vm-mail gnus-vm-init-reply-buffer run-hooks gnus-mail-hook] 2 (#$ . 3612) nil]) #@797 Yank article number N into the current buffer at point. When called interactively N is read from the minibuffer. This command is meant to be used in GNUS created Mail mode buffers; the yanked article comes from the newsgroup containing the article you are replying to or forwarding. All article headers are yanked along with the text. Point is left before the inserted text, the mark after. Any hook functions bound to `mail-citation-hook' are run, after inserting the text and setting point and mark. Prefix arg means to ignore `mail-citation-hook', don't set the mark, prepend the value of `vm-included-text-prefix' to every yanked line. For backwards compatibility, if `mail-citation-hook' is set to nil, `mail-yank-hooks' is run instead. If that is also nil, a default action is taken. (defalias 'gnus-yank-article #[(article &optional prefix) "…¶Šp`ÁÂÃ!qˆÈÉ\n!!„*ËÉ\n!!ˆÌ\nÍ\"ˆ;ƒ:Ñ!ˆ)Ò†B\n\f#ˆ\fqˆÔÕ!ˆƒ]×Ø!ƒ] ˆÁÔÛ!ˆ)Üed#ˆÝ\f!ˆqˆ`bˆ„‰„ž „žŠ` W…šáJcˆâyˆ‚Š)‚µã !ˆƒ­Ôß!‚µ …µÔà!-‡" [gnus-summary-buffer nil generate-new-buffer " *tmp-yank*" tmp end start message gnus-server-opened gnus-find-method-for-group gnus-newsgroup-name gnus-check-server gnus-request-group t article gnus-refer-article-method gnus-override-method gnus-read-header gnus-request-article gnus-current-article run-hooks gnus-article-prepare-hook gnus-show-mime gnus-fetch-field "Mime-Version" gnus-show-mime-method buffer-read-only gnus-article-display-hook append-to-buffer kill-buffer prefix mail-citation-hook mail-yank-hooks vm-included-text-prefix 1 push-mark] 5 (#$ . 3821) (list (let ((result 0) default prompt) (setq default (and gnus-summary-buffer (save-excursion (set-buffer gnus-summary-buffer) (and gnus-current-article (int-to-string gnus-current-article)))) prompt (if default (format "Yank article number: (default %s) " default) "Yank article number: ")) (while (and (not (stringp result)) (zerop result)) (setq result (read-string prompt)) (and (string= result "") default (setq result default)) (or (string-match "^<.*>$" result) (setq result (string-to-int result)))) result) current-prefix-arg)]) (provide (quote gnus-vm)) emacs-19.30/lisp/gnus.elc100666 23053 1 1211400 6053340476 14124 0ustar larsidaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Sat Nov 18 06:06:31 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/gnus.el ;;; emacs version 19.29.91.4. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`gnus.el' was compiled for Emacs 19.29 or later")) (run-hooks (quote gnus-load-hook)) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!‡" [require mail-utils timezone nnheader] 2) #@222 Specify a default NNTP server. This variable should be defined in paths.el, and should never be set by the user. If you want to change servers, you should use `gnus-select-method'. See the documentation to that variable. (defvar gnus-default-nntp-server nil (#$ . 577)) #@125 Default default new newsgroups the first time Gnus is run. Should be set in paths.el, and shouldn't be touched by the user. (defconst gnus-backup-default-subscribed-newsgroups (quote ("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")) (#$ . 854)) #@211 Local domain name without a host name. The DOMAINNAME environment variable is used instead if it is defined. If the `system-name' function returns the full Internet name, there is no need to set this variable. (defvar gnus-local-domain nil (#$ . 1125)) #@490 String with a description of what organization (if any) the user belongs to. The ORGANIZATION environment variable is used instead if it is defined. If this variable contains a function, this function will be called with the current newsgroup name as the argument. The function should return a string. In any case, if the string (either in the variable, in the environment variable, or returned by the function) is a file name, the contents of this file will be used as the organization. (defvar gnus-local-organization nil (#$ . 1385)) #@227 If nil, the full host name will be the system name prepended to the domain name. If this is a string, the full host name will be this string. If this is non-nil, non-string, the domain name will be used as the full host name. (defvar gnus-use-generic-from nil (#$ . 1930)) #@123 If nil, use the NNTP server name in the Path header. If stringp, use this; if non-nil, use no host name (user name only). (defvar gnus-use-generic-path nil (#$ . 2210)) #@303 *NNTP service name ("nntp" or 119). This is an obsolete variable, which is scarcely used. If you use an nntp server for your newsgroup and want to change the port number used to 899, you would say something along these lines: (setq gnus-select-method '(nntp "my.nntp.server" (nntp-port-number 899))) (defvar gnus-nntp-service "nntp" (#$ . -2386)) #@570 *Default method for selecting a newsgroup. This variable should be a list, where the first element is how the news is to be fetched, the second is the address. For instance, if you want to get your news via NNTP from "flab.flab.edu", you could say: (setq gnus-select-method '(nntp "flab.flab.edu")) If you want to use your local spool, say: (setq gnus-select-method (list 'nnspool (system-name))) If you use this variable, you must set `gnus-nntp-server' to nil. There is a lot more to know about select methods and virtual servers - see the manual for details. (defvar gnus-select-method (byte-code "ÀÁÂ!† ƒ Ę„ †Å D?†\"Çš?…)C¤‡" [nntp getenv "NNTPSERVER" gnus-default-nntp-server "" system-name gnus-nntp-service "nntp"] 3) (#$ . -2742)) #@381 *Preferred method for posting USENET news. If this variable is nil, Gnus will use the current method to decide which method to use when posting. If it is non-nil, it will override the current method. This method will not be used in mail groups and the like, only in "real" newsgroups. The value must be a valid method as discussed in the documentation of `gnus-select-method'. (defvar gnus-post-method nil (#$ . -3512)) #@362 *Preferred method for fetching an article by Message-ID. If you are reading news from the local spool (with nnspool), fetching articles by Message-ID is painfully slow. By setting this method to an nntp method, you might get acceptable results. The value of this variable must be a valid select method as discussed in the documentation of `gnus-select-method' (defvar gnus-refer-article-method nil (#$ . -3942)) #@307 *A list of secondary methods that will be used for reading news. This is a list where each element is a complete select method (see `gnus-select-method'). If, for instance, you want to read your mail with the nnml backend, you could set this variable: (setq gnus-secondary-select-methods '((nnml ""))) (defvar gnus-secondary-select-methods nil (#$ . -4362)) #@181 *List of NNTP servers that the user can choose between interactively. To make Gnus query you for a server, you have to give `gnus' a non-numeric prefix - `C-u M-x gnus', in short. (defvar gnus-secondary-servers nil (#$ . -4731)) #@127 *The name of the host running the NNTP server. This variable is semi-obsolete. Use the `gnus-select-method' variable instead. (defvar gnus-nntp-server nil (#$ . -4967)) #@77 *Your `.newsrc' file. `.newsrc-SERVER' will be used instead if that exists. (defvar gnus-startup-file "~/.newsrc" (#$ . -5142)) #@104 *Your Gnus elisp startup file. If a file with the .el or .elc suffixes exist, it will be read instead. (defvar gnus-init-file "~/.gnus" (#$ . -5277)) #@944 *Directory where the group FAQs are stored. This will most commonly be on a remote machine, and the file will be fetched by ange-ftp. Note that Gnus uses an aol machine as the default directory. If this feels fundamentally unclean, just think of it as a way to finally get something of value back from them. If the default site is too slow, try one of these: North America: ftp.uu.net /usenet/news.answers mirrors.aol.com /pub/rtfm/usenet ftp.seas.gwu.edu /pub/rtfm rtfm.mit.edu /pub/usenet/news.answers Europe: ftp.uni-paderborn.de /pub/FAQ ftp.Germany.EU.net /pub/newsarchive/news.answers ftp.sunet.se /pub/usenet Asia: nctuccca.edu.tw /USENET/FAQ hwarang.postech.ac.kr /pub/usenet/news.answers ftp.hk.super.net /mirror/faqs (defvar gnus-group-faq-directory "/ftp@mirrors.aol.com:/pub/rtfm/usenet/" (#$ . -5434)) #@38 *The address of the (ding) archives. (defvar gnus-group-archive-directory "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" (#$ . -6471)) #@50 *The address of the most recent (ding) articles. (defvar gnus-group-recent-archive-directory "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" (#$ . -6609)) #@257 *This variable lists what newsgroups should be subscribed the first time Gnus is used. It should be a list of strings. If it is `t', Gnus will not do anything special the first time it is started; it'll just use the normal newsgroups subscription methods. (defvar gnus-default-subscribed-newsgroups nil (#$ . -6774)) #@213 *Non-nil means that cross referenced articles will be marked as read. If nil, ignore cross references. If t, mark articles as read in subscribed newsgroups. If neither t nor nil, mark as read in all newsgroups. (defvar gnus-use-cross-reference t (#$ . -7098)) #@189 *Non-nil means that Gnus will use a dribble file to store user updates. If Emacs should crash without saving the .newsrc files, complete information can be restored from the dribble file. (defvar gnus-use-dribble-file t (#$ . -7366)) #@85 *If non-nil, Gnus will supply backends with data needed for async article fetching. (defvar gnus-asynchronous nil (#$ . -7606)) #@56 *Function for picking articles to pre-fetch, possibly. (defvar gnus-asynchronous-article-function nil (#$ . -7740)) #@514 *Alist mapping regexps to lists of score files. Each element of this alist should be of the form ("REGEXP" [ "SCORE-FILE-1" ] [ "SCORE-FILE-2" ] ... ) If the name of a group is matched by REGEXP, the corresponding scorefiles will be used for that group. The first match found is used, subsequent matching entries are ignored (to use multiple matches, see gnus-score-file-multiple-match-alist). These score files are loaded in addition to any files returned by gnus-score-find-score-files-function (which see). (defvar gnus-score-file-single-match-alist nil (#$ . -7863)) #@539 *Alist mapping regexps to lists of score files. Each element of this alist should be of the form ("REGEXP" [ "SCORE-FILE-1" ] [ "SCORE-FILE-2" ] ... ) If the name of a group is matched by REGEXP, the corresponding scorefiles will be used for that group. If multiple REGEXPs match a group, the score files corresponding to each match will be used (for only one match to be used, see gnus-score-file-single-match-alist). These score files are loaded in addition to any files returned by gnus-score-find-score-files-function (which see). (defvar gnus-score-file-multiple-match-alist nil (#$ . -8444)) #@29 *Suffix of the score files. (defvar gnus-score-file-suffix "SCORE" (#$ . -9051)) #@38 *Suffix of the adaptive score files. (defvar gnus-adaptive-file-suffix "ADAPT" (#$ . -9138)) #@648 *Function used to find score files. The function will be called with the group name as the argument, and should return a list of score files to apply to that group. The score files do not actually have to exist. Predefined values are: gnus-score-find-single: Only apply the group's own score file. gnus-score-find-hierarchical: Also apply score files from parent groups. gnus-score-find-bnews: Apply score files whose names matches. See the documentation to these functions for more information. This variable can also be a list of functions to be called. Each function should either return a list of score files, or a list of score alists. (defvar gnus-score-find-score-files-function (quote gnus-score-find-bnews) (#$ . -9238)) #@79 *Scoring commands will raise/lower the score with this number as the default. (defvar gnus-score-interactive-default-score 1000 (#$ . -9980)) #@183 *The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than this value, confirmation is required for selecting the newsgroup. (defvar gnus-large-newsgroup 200 (#$ . -10129)) #@58 *Message displayed by Gnus when no groups are available. (defvar gnus-no-groups-message "No news is horrible news" (#$ . -10365)) #@456 *Non-nil means that the default name of a file to save articles in is the group name. If it's nil, the directory form of the group name is used instead. If this variable is a list, and the list contains the element `not-score', long file names will not be used for score files; if it contains the element `not-save', long file names will not be used for saving; and if it contains the element `not-kill', long file names will not be used for kill files. (defvar gnus-use-long-file-name (byte-code "Á>?‡" [system-type (usg-unix-v xenix)] 2) (#$ . -10502)) #@121 *Name of the directory articles will be saved in (default "~/News"). Initialized from the SAVEDIR environment variable. (defvar gnus-article-save-directory (byte-code "ÀÁ!†‡" [getenv "SAVEDIR" "~/News/"] 2) (#$ . -11066)) #@127 *Name of the directory where kill files will be stored (default "~/News"). Initialized from the SAVEDIR environment variable. (defvar gnus-kill-files-directory (byte-code "ÀÁ!†‡" [getenv "SAVEDIR" "~/News/"] 2) (#$ . -11298)) #@418 *A function to save articles in your favorite format. The function must be interactively callable (in other words, it must be an Emacs command). Gnus provides the following functions: * gnus-summary-save-in-rmail (Rmail format) * gnus-summary-save-in-mail (Unix mail format) * gnus-summary-save-in-folder (MH folder) * gnus-summary-save-in-file (article format). * gnus-summary-save-in-vm (use VM's folder format). (defvar gnus-default-article-saver (quote gnus-summary-save-in-rmail) (#$ . -11534)) #@142 *A function generating a file name to save articles in Rmail format. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE. (defvar gnus-rmail-save-name (quote gnus-plain-save-name) (#$ . -12043)) #@146 *A function generating a file name to save articles in Unix mail format. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE. (defvar gnus-mail-save-name (quote gnus-plain-save-name) (#$ . -12264)) #@141 *A function generating a file name to save articles in MH folder. The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER. (defvar gnus-folder-save-name (quote gnus-folder-save-name) (#$ . -12488)) #@144 *A function generating a file name to save articles in article format. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE. (defvar gnus-file-save-name (quote gnus-numeric-save-name) (#$ . -12710)) #@411 *Variable used to suggest where articles are to be saved. The syntax of this variable is the same as `nnmail-split-methods'. For instance, if you would like to save articles related to Gnus in the file "gnus-stuff", and articles related to VM in "vm-stuff", you could set this variable to something like: '(("^Subject:.*gnus\|^Newsgroups:.*gnus" "gnus-stuff") ("^Subject:.*vm\|^Xref:.*vm" "vm-stuff")) (defvar gnus-split-methods nil (#$ . -12934)) #@39 *If non-nil, save group scoring info. (defvar gnus-save-score nil (#$ . -13396)) #@48 *If non-nil, use some adaptive scoring scheme. (defvar gnus-use-adaptive-scoring nil (#$ . -13483)) #@55 *If non-nil, Gnus will cache (some) articles locally. (defvar gnus-use-cache nil (#$ . -13589)) #@30 *If non-nil, enable scoring. (defvar gnus-use-scoring t (#$ . -13691)) #@534 *Non-nil means that Gnus will try to build threads by grabbing old headers. If an unread article in the group refers to an older, already read (or just marked as read) article, the old article will not normally be displayed in the Summary buffer. If this variable is non-nil, Gnus will attempt to grab the headers to the old articles, and thereby build complete threads. If it has the value `some', only enough headers to connect otherwise loose threads will be displayed. The server has to support XOVER for any of this to work. (defvar gnus-fetch-old-headers nil (#$ . -13769)) #@127 *Non-nil means that you are a usenet novice. If non-nil, verbose messages may be displayed and confirmations may be required. (defvar gnus-novice-user t (#$ . -14359)) #@105 *Non-nil means that you will never be asked for confirmation about anything. And that means *anything*. (defvar gnus-expert-user nil (#$ . -14534)) #@272 *Integer that says how verbose Gnus should be. The higher the number, the more messages Gnus will flash to say what it's doing. At zero, Gnus will be totally mute; at five, Gnus will display most important messages; and at ten, Gnus will keep on jabbering all the time. (defvar gnus-verbose 7 (#$ . -14689)) #@603 *Non-nil means that the next newsgroup after the current will be on the same level. When you type, for instance, `n' after reading the last article in the current newsgroup, you will go to the next newsgroup. If this variable is nil, the next newsgroup will be the next from the group buffer. If this variable is non-nil, Gnus will either put you in the next newsgroup with the same level, or, if no such newsgroup is available, the next newsgroup with the lowest possible level higher than the current level. If this variable is `best', Gnus will make the next newsgroup the one with the best level. (defvar gnus-keep-same-level nil (#$ . -15005)) #@1029 *nil means that Gnus won't gather loose threads. If the root of a thread has expired or been read in a previous session, the information necessary to build a complete thread has been lost. Instead of having many small sub-threads from this original thread scattered all over the summary buffer, Gnus can gather them. If non-nil, Gnus will try to gather all loose sub-threads from an original thread into one large thread. If this variable is non-nil, it should be one of `none', `adopt', `dummy' or `empty'. If this variable is `none', Gnus will not make a false root, but just present the sub-threads after another. If this variable is `dummy', Gnus will create a dummy root that will have all the sub-threads as children. If this variable is `adopt', Gnus will make one of the "children" the parent and mark all the step-children as such. If this variable is `empty', the "children" are printed with empty subject fields. (Or rather, they will be printed with a string given by the `gnus-summary-same-subject' variable.) (defvar gnus-summary-make-false-root (quote adopt) (#$ . -15663)) #@468 *Maximum length of subject comparisons when gathering loose threads. Use nil to compare full subjects. Setting this variable to a low number will help gather threads that have been corrupted by newsreaders chopping off subject lines, but it might also mean that unrelated articles that have subject that happen to begin with the same few characters will be incorrectly gathered. If this variable is `fuzzy', Gnus will use a fuzzy algorithm when comparing subjects. (defvar gnus-summary-gather-subject-limit nil (#$ . -16764)) #@174 *String indicating that the current article has the same subject as the previous. This variable will only be used if the value of `gnus-summary-make-false-root' is `empty'. (defvar gnus-summary-same-subject "" (#$ . -17299)) #@67 *If non-nil, marking commands will go to the next unread article. (defvar gnus-summary-goto-unread t (#$ . -17530)) #@81 *If non-nil, movement commands will go to the next unread and subscribed group. (defvar gnus-group-goto-unread t (#$ . -17652)) #@701 *Non-nil means that Gnus will add new newsgroups at startup. If this variable is `ask-server', Gnus will ask the server for new groups since the last time it checked. This means that the killed list is no longer necessary, so you could set `gnus-save-killed-list' to nil. A variant is to have this variable be a list of select methods. Gnus will then use the `ask-server' method on all these select methods to query for new groups from all those servers. Eg. (setq gnus-check-new-newsgroups '((nntp "some.server") (nntp "other.server"))) If this variable is nil, then you have to tell Gnus explicitly to check for new newsgroups with \\[gnus-find-new-newsgroups]. (defvar gnus-check-new-newsgroups t (#$ . -17787)) #@230 *Non-nil means that Gnus will check and remove bogus newsgroup at startup. If this variable is nil, then you have to tell Gnus explicitly to check for bogus newsgroups with \\[gnus-group-check-bogus-groups]. (defvar gnus-check-bogus-newsgroups nil (#$ . -18545)) #@634 *Non-nil means that Gnus will read the entire active file at startup. If this variable is nil, Gnus will only know about the groups in your `.newsrc' file. If this variable is `some', Gnus will try to only read the relevant parts of the active file from the server. Not all servers support this, and it might be quite slow with other servers, but this should generally be faster than both the t and nil value. If you set this variable to nil or `some', you probably still want to be told about new newsgroups that arrive. To do that, set `gnus-check-new-newsgroups' to `ask-server'. This may not work properly with all servers. (defvar gnus-read-active-file t (#$ . -18836)) #@73 *Groups with levels less than or equal to this variable are subscribed. (defvar gnus-level-subscribed 5 (#$ . -19522)) #@186 *Groups with levels less than or equal to this variable are unsubscribed. Groups with levels less than `gnus-level-subscribed', which should be less than this variable, are subscribed. (defvar gnus-level-unsubscribed 7 (#$ . -19648)) #@44 *Groups with this level are zombie groups. (defvar gnus-level-zombie 8 (#$ . -19888)) #@37 *Groups with this level are killed. (defvar gnus-level-killed 9 (#$ . -19980)) #@58 *New subscribed groups will be subscribed at this level. (defvar gnus-level-default-subscribed 3 (#$ . -20065)) #@62 *New unsubscribed groups will be unsubscribed at this level. (defvar gnus-level-default-unsubscribed 6 (#$ . -20183)) #@569 *If nil, Gnus will not check foreign newsgroups at startup. If it is non-nil, it should be a number between one and nine. Foreign newsgroups that have a level lower or equal to this number will be activated on startup. For instance, if you want to active all subscribed newsgroups, but not the rest, you'd set this variable to `gnus-level-subscribed'. If you subscribe to lots of newsgroups from different servers, startup might take a while. By setting this variable to nil, you'll save time, but you won't be told how many unread articles there are in the groups. (defvar gnus-activate-foreign-newsgroups 4 (#$ . -20308)) #@321 *Non-nil means that Gnus will save the `.newsrc' file. Gnus always saves its own startup file, which is called ".newsrc.eld". The file called ".newsrc" is in a format that can be readily understood by other newsreaders. If you don't plan on using other newsreaders, set this variable to nil to save some time on exit. (defvar gnus-save-newsrc-file t (#$ . -20941)) #@422 *If non-nil, save the list of killed groups to the startup file. This will save both time (when starting and quitting) and space (both memory and disk), but it will also mean that Gnus has no record of which groups are new and which are old, so the automatic new newsgroups subscription methods become meaningless. You should always set `gnus-check-new-newsgroups' to `ask-server' or nil if you set this variable to nil. (defvar gnus-save-killed-list t (#$ . -21315)) #@66 *If non-nil, require your confirmation when catching up a group. (defvar gnus-interactive-catchup t (#$ . -21789)) #@57 *If non-nil, group name will be asked for when posting. (defvar gnus-interactive-post t (#$ . -21910)) #@59 *If non-nil, require your confirmation when exiting Gnus. (defvar gnus-interactive-exit t (#$ . -22019)) #@221 *If non-nil, Gnus will apply kill files to already killed articles. If it is nil, Gnus will never apply kill files to articles that have already been through the scoring process, which might very well save lots of time. (defvar gnus-kill-killed t (#$ . -22131)) #@274 *Function for extracting address components from a From header. Two pre-defined function exist: `gnus-extract-address-components', which is the default, quite fast, and too simplistic solution, and `mail-extract-address-components', which works much better, but is slower. (defvar gnus-extract-address-components (quote gnus-extract-address-components) (#$ . -22400)) #@82 *Default article score level. If this variable is nil, scoring will be disabled. (defvar gnus-summary-default-score 0 (#$ . -22774)) #@146 *Fuzziness factor for the zcore in the summary buffer. Articles with scores closer than this to `gnus-summary-default-score' will not be marked. (defvar gnus-summary-zcore-fuzz 0 (#$ . -22914)) #@108 *Regular expression that will be removed from subject strings if fuzzy subject simplification is selected. (defvar gnus-simplify-subject-fuzzy-regexp nil (#$ . -23115)) #@83 *Default listing level. Ignored if `gnus-group-use-permanent-levels' is non-nil. (defvar gnus-group-default-list-level gnus-level-subscribed (#$ . -23290)) #@62 *If non-nil, once you set a level, Gnus will use this level. (defvar gnus-group-use-permanent-levels nil (#$ . -23453)) #@128 *If non-nil, do mime processing of articles. The articles will simply be fed to the function given by `gnus-show-mime-method'. (defvar gnus-show-mime nil (#$ . -23580)) #@70 *If nil, decode MIME header even if there is not Mime-Version field. (defvar gnus-strict-mime t (#$ . -23755)) #@86 *Function to process a MIME message. The function is called from the article buffer. (defvar gnus-show-mime-method (quote metamail-buffer) (#$ . -23872)) #@47 *If non-nil, display threads in summary mode. (defvar gnus-show-threads t (#$ . -24032)) #@188 *If non-nil, hide all threads initially. If threads are hidden, you have to run the command `gnus-summary-show-thread' by hand or use `gnus-select-article-hook' to expose hidden threads. (defvar gnus-thread-hide-subtree nil (#$ . -24128)) #@49 *If non-nil, hide killed threads automatically. (defvar gnus-thread-hide-killed t (#$ . -24373)) #@198 *If non-nil, ignore subjects and do all threading based on the Reference header. If nil, which is the default, articles that have different subjects from their parents will start separate threads. (defvar gnus-thread-ignore-subject nil (#$ . -24477)) #@64 *Number that says how much each sub-thread should be indented. (defvar gnus-thread-indent-level 4 (#$ . -24734)) #@242 *A regexp to match uninteresting newsgroups in the active file. Any lines in the active file matching this regular expression are removed from the newsgroup list before anything else is done to it, thus making them effectively non-existent. (defvar gnus-ignored-newsgroups (byte-code "ÀÁÂÃÄ#!‡" [purecopy mapconcat identity ("^to\\." "^[0-9. ]+ " "[][\"#'()]") "\\|"] 5) (#$ . -24854)) #@122 *All headers that match this regexp will be hidden. If `gnus-visible-headers' is non-nil, this variable will be ignored. (defvar gnus-ignored-headers "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:" (#$ . -25248)) #@129 *All headers that do not match this regexp will be hidden. If this variable is non-nil, `gnus-ignored-headers' will be ignored. (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:" (#$ . -25659)) #@194 *This variable is a list of regular expressions. If it is non-nil, headers that match the regular expressions will be placed first in the article buffer in the sequence specified by this list. (defvar gnus-sorted-header-list (quote ("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" "^Cc:" "^Date:" "^Organization:")) (#$ . -25968)) #@38 *If non-nil, don't hide any headers. (defvar gnus-show-all-headers nil (#$ . -26325)) #@54 *If non-nil, don't remove any headers before saving. (defvar gnus-save-all-headers t (#$ . -26417)) #@57 *If non-nil, the startup message will not be displayed. (defvar gnus-inhibit-startup-message nil (#$ . -26523)) #@38 Regexp matching signature separator. (defvar gnus-signature-separator "^-- *$" (#$ . 26641)) #@68 *If non-nil, extend newsgroup forward and backward when requested. (defvar gnus-auto-extend-newsgroup t (#$ . -26740)) #@213 *If non-nil, select the first unread article when entering a group. If you want to prevent automatic selection of the first unread article in some newsgroups, set the variable to nil in `gnus-select-group-hook'. (defvar gnus-auto-select-first t (#$ . -26866)) #@389 *If non-nil, offer to go to the next group from the end of the previous. If the value is t and the next newsgroup is empty, Gnus will exit summary mode and go back to group mode. If the value is neither nil nor t, Gnus will select the following unread newsgroup. In particular, if the value is the symbol `quietly', the next unread newsgroup will be selected without any confirmations. (defvar gnus-auto-select-next t (#$ . -27133)) #@61 *If non-nil, select the next article with the same subject. (defvar gnus-auto-select-same nil (#$ . -27574)) #@148 *If non-nil, consider the current article when moving. The "unread" movement commands will stay on the same line if the current article is unread. (defvar gnus-summary-check-current nil (#$ . -27690)) #@56 *If non-nil, always center the current summary buffer. (defvar gnus-auto-center-summary t (#$ . -27897)) #@115 *If non-nil, do page breaking on articles. The page delimiter is specified by the `gnus-page-delimiter' variable. (defvar gnus-break-pages t (#$ . -28009)) #@140 *Regexp describing what to use as article page delimiters. The default value is "^ ", which is a form linefeed at the beginning of a line. (defvar gnus-page-delimiter "^\f" (#$ . -28172)) #@43 *If non-nil, use the entire Emacs screen. (defvar gnus-use-full-window t (#$ . -28366)) #@54 Obsolete variable. See `gnus-buffer-configuration'. (defvar gnus-window-configuration nil (#$ . 28460)) #@781 Window configuration for all possible Gnus buffers. This variable is a list of lists. Each of these lists has a NAME and a RULE. The NAMEs are commonsense names like `group', which names a rule used when displaying the group buffer; `summary', which names a rule for what happens when you enter a group and do not display an article buffer; and so on. See the value of this variable for a complete list of NAMEs. Each RULE is a list of vectors. The first element in this vector is the name of the buffer to be displayed; the second element is the percentage of the screen this buffer is to occupy (a number in the 0.0-0.99 range); the optional third element is `point', which should be present to denote which buffer point is to go to after making this buffer configuration. (defvar gnus-buffer-configuration (quote ((group ([group 1.0 point] (if gnus-carpal [group-carpal 4]))) (summary ([summary 1.0 point] (if gnus-carpal [summary-carpal 4]))) (article ([summary .25 point] (if gnus-carpal [summary-carpal 4]) [article 1.0])) (server ([server 1.0 point] (if gnus-carpal [server-carpal 2]))) (browse ([browse 1.0 point] (if gnus-carpal [browse-carpal 2]))) (group-mail ([mail 1.0 point])) (summary-mail ([mail 1.0 point])) (summary-reply ([article .5] [mail 1.0 point])) (info ([nil 1.0 point])) (summary-faq ([summary .25] [faq 1.0 point])) (edit-group ([group .5] [edit-group 1.0 point])) (edit-server ([server .5] [edit-server 1.0 point])) (edit-score ([summary .25] [edit-score 1.0 point])) (post ([post 1.0 point])) (reply ([article .5] [mail 1.0 point])) (mail-forward ([mail 1.0 point])) (post-forward ([post 1.0 point])) (reply-yank ([mail 1.0 point])) (followup ([article .5] [post 1.0 point])) (followup-yank ([post 1.0 point])))) (#$ . 28572)) #@65 Mapping from short symbols to buffer names or buffer variables. (defvar gnus-window-to-buffer (quote ((group . gnus-group-buffer) (summary . gnus-summary-buffer) (article . gnus-article-buffer) (server . gnus-server-buffer) (browse . "*Gnus Browse Server*") (edit-group . gnus-group-edit-buffer) (edit-server . gnus-server-edit-buffer) (group-carpal . gnus-carpal-group-buffer) (summary-carpal . gnus-carpal-summary-buffer) (server-carpal . gnus-carpal-server-buffer) (browse-carpal . gnus-carpal-browse-buffer) (edit-score . gnus-score-edit-buffer) (mail . gnus-mail-buffer) (post . gnus-post-news-buffer) (faq . gnus-faq-buffer))) (#$ . 30340)) #@39 *If non-nil, display clickable icons. (defvar gnus-carpal nil (#$ . -30993)) #@406 *Function called with a group name when new group is detected. A few pre-made functions are supplied: `gnus-subscribe-randomly' inserts new groups at the beginning of the list of groups; `gnus-subscribe-alphabetically' inserts new groups in strict alphabetic order; `gnus-subscribe-hierarchically' inserts new groups in hierarchical newsgroup order; `gnus-subscribe-interactively' asks for your decision. (defvar gnus-subscribe-newsgroup-method (quote gnus-subscribe-zombies) (#$ . -31077)) #@361 *This function is called to subscribe newsgroups mentioned on "options -n" lines. If, for instance, you want to subscribe to all newsgroups in the "no" and "alt" hierarchies, you'd put the following in your .newsrc file: options -n no.all alt.all Gnus will the subscribe all new newsgroups in these hierarchies with the subscription method in this variable. (defvar gnus-subscribe-options-newsgroup-method (quote gnus-subscribe-alphabetically) (#$ . -31575)) #@346 *If non-nil, Gnus will offer to subscribe hierarchically. When a new hierarchy appears, Gnus will ask the user: 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys): If the user pressed `d', Gnus will descend the hierarchy, `y' will subscribe to all newsgroups in the hierarchy and `s' will skip this hierarchy in its entirety. (defvar gnus-subscribe-hierarchical-interactive nil (#$ . -32043)) #@263 *Function used for sorting the group buffer. This function will be called with group info entries as the arguments for the groups to be sorted. Pre-made functions include `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread' and `gnus-group-sort-by-level' (defvar gnus-group-sort-function (quote gnus-group-sort-by-alphabet) (#$ . -32462)) #@33 *Mark used for unread articles. (defvar gnus-unread-mark 32 (#$ . -32814)) #@33 *Mark used for ticked articles. (defvar gnus-ticked-mark 33 (#$ . -32895)) #@34 *Mark used for dormant articles. (defvar gnus-dormant-mark 63 (#$ . -32976)) #@32 *Mark used for del'd articles. (defvar gnus-del-mark 114 (#$ . -33059)) #@31 *Mark used for read articles. (defvar gnus-read-mark 82 (#$ . -33137)) #@36 *Mark used for expirable articles. (defvar gnus-expirable-mark 69 (#$ . -33214)) #@33 *Mark used for killed articles. (defvar gnus-killed-mark 75 (#$ . -33301)) #@47 *Mark used for articles killed by kill files. (defvar gnus-kill-file-mark 88 (#$ . -33382)) #@43 *Mark used for articles with a low score. (defvar gnus-low-score-mark 89 (#$ . -33480)) #@45 *Mark used for articles that are caught up. (defvar gnus-catchup-mark 67 (#$ . -33574)) #@52 *Mark used for articles that have been replied to. (defvar gnus-replied-mark 65 (#$ . -33668)) #@16 *Process mark. (defvar gnus-process-mark 35 (#$ . -33769)) #@34 *Mark used for ancient articles. (defvar gnus-ancient-mark 79 (#$ . -33834)) #@35 *Mark used for canceled articles. (defvar gnus-canceled-mark 71 (#$ . -33917)) #@49 *Score mark used for articles with high scores. (defvar gnus-score-over-mark 43 (#$ . -34002)) #@48 *Score mark used for articles with low scores. (defvar gnus-score-below-mark 45 (#$ . -34103)) #@40 *There is no thread under the article. (defvar gnus-empty-thread-mark 32 (#$ . -34204)) #@39 *There is a thread under the article. (defvar gnus-not-empty-thread-mark 61 (#$ . -34298)) #@27 *This is a dummy article. (defvar gnus-dummy-mark 90 (#$ . -34395)) #@61 *If non-nil, Gnus will view pseudo-articles asynchronously. (defvar gnus-view-pseudo-asynchronously nil (#$ . -34469)) #@175 *If `automatic', pseudo-articles will be viewed automatically. If `not-confirm', pseudos will be viewed automatically, and the user will not be asked to confirm the command. (defvar gnus-view-pseudos nil (#$ . -34595)) #@184 *If non-nil, one pseudo-article will be created for each file to be viewed. If nil, all files that use the same viewing command will be given as a list of parameters to that command. (defvar gnus-view-pseudos-separately t (#$ . -34821)) #@2031 *Format of group lines. It works along the same lines as a normal formatting string, with some simple extensions. %M Only marked articles (character, "*" or " ") %S Whether the group is subscribed (character, "U", "K", "Z" or " ") %L Level of subscribedness (integer) %N Number of unread articles (integer) %I Number of dormant articles (integer) %i Number of ticked and dormant (integer) %T Number of ticked articles (integer) %R Number of read articles (integer) %t Total number of articles (integer) %y Number of unread, unticked articles (integer) %G Group name (string) %g Qualified group name (string) %D Group description (string) %s Select method (string) %o Moderated group (char, "m") %p Process mark (char) %O Moderated group (string, "(m)" or "") %n Select from where (string) %z A string that look like `<%s:%n>' if a foreign select method is used %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, where X is the letter following %u. The function will be passed the current header as argument. The function should return a string, which will be inserted into the buffer just like information from any other group specifier. Text between %( and %) will be highlighted with `gnus-mouse-face' when the mouse point move inside the area. There can only be one such area. Note that this format specification is not always respected. For reasons of efficiency, when listing killed groups, this specification is ignored altogether. If the spec is changed considerably, your output may end up looking strange when listing both alive and killed groups. If you use %o or %O, reading the active file will be slower and quite a bit of extra memory will be used. %D will also worsen performance. Also note that if you change the format specification to include any of these specs, you must probably re-start Gnus to see them go into effect. (defvar gnus-group-line-format "%M%S%p%5y: %(%g%)\n" (#$ . -35066)) #@2507 *The format specification of the lines in the summary buffer. It works along the same lines as a normal formatting string, with some simple extensions. %N Article number, left padded with spaces (string) %S Subject (string) %s Subject if it is at the root of a thread, and "" otherwise (string) %n Name of the poster (string) %a Extracted name of the poster (string) %A Extracted address of the poster (string) %F Contents of the From: header (string) %x Contents of the Xref: header (string) %D Date of the article (string) %d Date of the article (string) in DD-MMM format %M Message-id of the article (string) %r References of the article (string) %c Number of characters in the article (integer) %L Number of lines in the article (integer) %I Indentation based on thread level (a string of spaces) %T A string with two possible values: 80 spaces if the article is on thread level two or larger and 0 spaces on level one %R "A" if this article has been replied to, " " otherwise (character) %U Status of this article (character, "R", "K", "-" or " ") %[ Opening bracket (character, "[" or "<") %] Closing bracket (character, "]" or ">") %> Spaces of length thread-level (string) %< Spaces of length (- 20 thread-level) (string) %i Article score (number) %z Article zcore (character) %t Number of articles under the current thread (number). %e Whether the thread is empty or not (character). %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, where X is the letter following %u. The function will be passed the current header as argument. The function should return a string, which will be inserted into the summary just like information from any other summary specifier. Text between %( and %) will be highlighted with `gnus-mouse-face' when the mouse point is placed inside the area. There can only be one such area. The %U (status), %R (replied) and %z (zcore) specs have to be handled with care. For reasons of efficiency, Gnus will compute what column these characters will end up in, and "hard-code" that. This means that it is illegal to have these specs after a variable-length spec. Well, you might not be arrested, but your summary buffer will look strange, which is bad enough. The smart choice is to have these specs as for to the left as possible. This restriction may disappear in later versions of Gnus. (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" (#$ . -37172)) #@177 *The format specification for the dummy roots in the summary buffer. It works along the same lines as a normal formatting string, with some simple extensions. %S The subject (defvar gnus-summary-dummy-line-format "* : : %S\n" (#$ . -39770)) #@54 *The format specification for the summary mode line. (defvar gnus-summary-mode-line-format "Gnus %G/%A %Z" (#$ . -40045)) #@54 *The format specification for the article mode line. (defvar gnus-article-mode-line-format "Gnus %G/%A %S" (#$ . -40174)) #@52 *The format specification for the group mode line. (defvar gnus-group-mode-line-format "Gnus List of groups {%M:%S} " (#$ . -40303)) #@387 An alist of valid select methods. The first element of each list lists should be a string with the name of the select method. The other elements may be be the category of this method (ie. `post', `mail', `none' or whatever) or other properties that this method has (like being respoolable). If you implement a new select method, all you should have to change is this variable. I think. (defvar gnus-valid-select-methods (quote (("nntp" post address prompt-address) ("nnspool" post) ("nnvirtual" none virtual prompt-address) ("nnmbox" mail respool) ("nnml" mail respool) ("nnmh" mail respool) ("nndir" none prompt-address address) ("nneething" none prompt-address) ("nndigest" none) ("nndoc" none prompt-address) ("nnbabyl" mail respool) ("nnkiboze" post virtual) ("nnfolder" mail respool))) (#$ . 40447)) #@297 *List of buffers that should update their mode lines. The list may contain the symbols `group', `article' and `summary'. If the corresponding symbol is present, Gnus will keep that mode line updated with information that may be pertinent. If this variable is nil, screen refresh may be quicker. (defvar gnus-updated-mode-lines (quote (group article summary)) (#$ . -41259)) #@139 *Max length of mode-line non-string contents. If this is nil, Gnus will take space as is needed, leaving the rest of the modeline intact. (defvar gnus-mode-non-string-length 21 (#$ . -41641)) #@143 *Mark all articles with a score below this variable as read. This variable is local to each summary buffer and usually set by the score file. (defvar gnus-summary-mark-below nil (#$ . -41840)) #@558 *List of functions used for sorting threads in the summary buffer. By default, threads are sorted by article number. Each function takes two threads and return non-nil if the first thread should be sorted before the other. If you use more than one function, the primary sort function should be the last. Ready-mady functions include `gnus-thread-sort-by-number', `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). (defvar gnus-thread-sort-functions (quote (gnus-thread-sort-by-number)) (#$ . -42040)) #@237 *Function used for calculating the total score of a thread. The function is called with the scores of the article and each subthread and should then return the score of the thread. Some functions you can use are `+', `max', or `min'. (defvar gnus-thread-score-function (quote +) (#$ . -42691)) #@177 *All new groups matching this regexp will be subscribed unconditionally. Note that this variable deals only with new newsgroups. This variable does not affect old newsgroups. (defvar gnus-options-subscribe nil (#$ . -42994)) #@179 *All new groups matching this regexp will be ignored. Note that this variable deals only with new newsgroups. This variable does not affect old (already subscribed) newsgroups. (defvar gnus-options-not-subscribe nil (#$ . -43227)) #@206 *Groups in which to automatically mark read articles as expirable. If non-nil, this should be a regexp that should match all groups in which to perform auto-expiry. This only makes sense for mail groups. (defvar gnus-auto-expirable-newsgroups nil (#$ . -43466)) #@39 Property list to use for hiding text. (defvar gnus-hidden-properties (quote (invisible t intangible t)) (#$ . 43735)) #@132 *Non-nil means .newsrc should be deleted prior to save. Its use is due to the bogus appearance that .newsrc was modified on disc. (defvar gnus-modtime-botch nil (#$ . -43860)) #@30 *A hook for Gnus group mode. (defvar gnus-group-mode-hook nil (#$ . -44043)) #@101 *A hook for Gnus summary mode. This hook is run before any variables are set in the summary buffer. (defvar gnus-summary-mode-hook nil (#$ . -44127)) #@32 *A hook for Gnus article mode. (defvar gnus-article-mode-hook nil (#$ . -44283)) #@116 *A hook called when preparing to exit from the summary buffer. It calls `gnus-summary-expire-articles' by default. (defalias 'gnus-summary-prepare-exit-hook #[nil "À‡" [nil] 1 (#$ . -44371)]) (add-hook (quote gnus-summary-prepare-exit-hook) (quote gnus-summary-expire-articles)) #@49 *A hook called on exit from the summary buffer. (defalias 'gnus-summary-exit-hook #[nil "À‡" [nil] 1 (#$ . -44656)]) #@67 *A hook called just before opening connection to the news server. (defvar gnus-open-server-hook nil (#$ . -44779)) #@35 *A hook run while Gnus is loaded. (defvar gnus-load-hook nil (#$ . -44900)) #@92 *A hook called at startup. This hook is called after Gnus is connected to the NNTP server. (defvar gnus-startup-hook nil (#$ . -44982)) #@51 *A hook run just before Gnus checks for new news. (defvar gnus-get-new-news-hook nil (#$ . -45124)) #@438 *A function that is called to generate the group buffer. The function is called with three arguments: The first is a number; all group with a level less or equal to that number should be listed, if the second is non-nil, empty groups should also be displayed. If the third is non-nil, it is a number. No groups with a level lower than this number should be displayed. The only current function implemented is `gnus-group-prepare-flat'. (defvar gnus-group-prepare-function (quote gnus-group-prepare-flat) (#$ . -45231)) #@122 *A hook called after the group buffer has been generated. If you want to modify the group buffer, you can use this hook. (defvar gnus-group-prepare-hook nil (#$ . -45758)) #@126 *A hook called after the summary buffer has been generated. If you want to modify the summary buffer, you can use this hook. (defvar gnus-summary-prepare-hook nil (#$ . -45937)) #@145 *A hook called after an article has been prepared in the article buffer. If you want to run a special decoding program like nkf, use this hook. (defvar gnus-article-prepare-hook nil (#$ . -46122)) #@194 String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command. (defvar gnus-article-x-face-command "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" (#$ . 46326)) #@70 Regexp matching posters whose face shouldn't be shown automatically. (defvar gnus-article-x-face-too-ugly nil (#$ . 46652)) #@412 *A hook called when a newsgroup is selected. If you'd like to simplify subjects like the `gnus-summary-next-same-subject' command does, you can use the following hook: (setq gnus-select-group-hook (list (lambda () (mapcar (lambda (header) (mail-header-set-subject header (gnus-simplify-subject (mail-header-subject header) 're-only))) gnus-newsgroup-headers)))) (defvar gnus-select-group-hook nil (#$ . -46783)) #@169 *A hook called when an article is selected. The default hook shows conversation thread subtrees of the selected article automatically using `gnus-summary-show-thread'. (defvar gnus-select-article-hook (quote (gnus-summary-show-thread)) (#$ . -47251)) #@629 *A hook called to apply kill files to a group. This hook is intended to apply a kill file to the selected newsgroup. The function `gnus-apply-kill-file' is called by default. Since a general kill file is too heavy to use only for a few newsgroups, I recommend you to use a lighter hook function. For example, if you'd like to apply a kill file to articles which contains a string `rmgroup' in subject in newsgroup `control', you can use the following hook: (setq gnus-apply-kill-hook (list (lambda () (cond ((string-match "control" gnus-newsgroup-name) (gnus-kill "Subject" "rmgroup") (gnus-expunge "X")))))) (defvar gnus-apply-kill-hook (quote (gnus-apply-kill-file)) (#$ . -47509)) #@166 *Hook run after selecting an article in the summary buffer. It is meant to be used for highlighting the article in some way. It is not run if `gnus-visual' is nil. (defvar gnus-visual-mark-article-hook (list (quote gnus-highlight-selected-summary)) (#$ . -48219)) #@58 *A hook called when exiting (not quitting) summary mode. (defvar gnus-exit-group-hook nil (#$ . -48490)) #@52 *A hook called when suspending (not exiting) Gnus. (defvar gnus-suspend-gnus-hook nil (#$ . -48601)) #@35 *A hook called when exiting Gnus. (defvar gnus-exit-gnus-hook nil (#$ . -48708)) #@45 *A hook called when saving the newsrc file. (defvar gnus-save-newsrc-hook nil (#$ . -48795)) #@229 *A hook called when a summary line is changed. The hook will not be called if `gnus-visual' is nil. The default function `gnus-summary-highlight-line' will highlight the line according to the `gnus-summary-highlight' variable. (defvar gnus-summary-update-hook (list (quote gnus-summary-highlight-line)) (#$ . -48895)) #@159 *A hook called when an article is selected for the first time. The hook is intended to mark an article as read (or unread) automatically when it is selected. (defvar gnus-mark-article-hook (list (quote gnus-summary-mark-unread-as-read)) (#$ . -49221)) (byte-code "ÀÁÂ\"ˆÃÄ!„ ÅÄBÃÇ!„ÅÇBÃÈ!„+ÅÈBÃÉ!„:Å ÉBÃÊ!„IÅ\nÊBÃË!„XÅ ËBÃÌ!„gÅ\fÌBÃÍ!„vÅ ÍBÃÎ!„…ÅÎBÃÏ!„”ÅÏBÃÐ!„£ÅÐBÃÑ!„²ÅÑBÃÒ!„ÁÅÒBÃÓ!„ÐÅÓBÃÔ!„ßÅÔBÃÕ!„îÅÕBÖ×BÃØ!„ÅØBÃÙ!„ÅÙBÚÛÜEÝÞÜEßàáEâãäEåæáEçèáEéêäEëìáEíîäEïðáEñòäEóôäEõöäE÷øÜEùúäEûüÜEäýäEþÿäE@AäEBCäE¯DDBŇ" [add-hook gnus-startup-hook #[nil "ÀÁÂ\"ˆÀÁÃ\"ˆÄÀÆÂ\"‡" [remove-hook gnus-summary-prepare-hook hilit-rehighlight-buffer-quietly hilit-install-line-hooks (gnus-summary-mark-unread-as-read) gnus-mark-article-hook gnus-article-prepare-hook] 3] boundp gnus-summary-inhibit-highlight nil current-load-list gnus-newsgroup-selected-overlay gnus-article-mode-map gnus-dribble-buffer gnus-headers-retrieved-by gnus-article-reply gnus-override-method gnus-article-check-size gnus-current-score-file gnus-internal-global-score-files gnus-score-file-list gnus-scores-exclude-files gnus-current-move-group gnus-newsgroup-dependencies gnus-newsgroup-threads gnus-newsgroup-async "*Gnus edit newsgroup*" gnus-group-edit-buffer gnus-newsgroup-adaptive gnus-summary-display-table 77 marked 99 83 subscribed 76 level 100 78 number 115 73 number-of-dormant 84 number-of-ticked 82 number-of-read 116 number-total 121 number-of-unread-unticked 105 number-of-ticked-and-dormant 103 group 71 qualified-group 68 newsgroup-description 111 moderated 79 moderated-string 112 process-marked news-server 110 news-method 122 news-method-string 117 user-defined gnus-group-line-format-alist] 22) #@181 An alist of format specifications that can appear in summary lines, and what variables they correspond with, along with the type of the variable (string, integer, character, etc). (defconst gnus-summary-line-format-alist (byte-code "ÀÁÂEÃÄÅEÅÆÅEÇÈÅEÉÊÅEËÌÅEÍÎÅEÏÐÑ!ÅEÒÐÓ!ÅEÂÔÅEÕÐÖ!ÅE×ÐØ!ÅEÙÚÂEÛÜÂEÝÞÅEßàÅEáâÙEãäÙEåæÙEçèÅEéêÅEëìÂEíîÙEïðÙEñòÂEóôÙEõöÅE¯‡" [78 number 100 83 subject 115 subject-or-nil 110 name 65 (car (cdr (funcall gnus-extract-address-components from))) 97 (or (car (funcall gnus-extract-address-components from)) from) 70 from 120 macroexpand (mail-header-xref header) 68 (mail-header-date header) (gnus-dd-mmm (mail-header-date header)) 77 (mail-header-id header) 114 (mail-header-references header) 99 (or (mail-header-chars header) 0) 76 lines 73 indentation 84 (if (= level 0) "" (make-string (frame-width) 32)) 82 replied 91 opening-bracket 93 closing-bracket 62 (make-string level 32) 60 (make-string (max 0 (- 20 level)) 32) 105 score 122 score-char 85 unread 116 (gnus-summary-number-of-articles-in-thread (and (boundp (quote thread)) (car thread))) 101 (gnus-summary-number-of-articles-in-thread (and (boundp (quote thread)) (car thread)) t) 117 user-defined] 29) (#$ . 51048)) (byte-code "ÀÁÂEÃÄÅEÆÇÂEEÈ B ÊËÂEÌÍÂEÎÏÅEÐÑÂEÒÓÂEÔÕÅEÀÁÂEÖ×ÅEÆÇÂEÂØÂE¯\nÙ B ÀÚÂEÛÜÂEÆÇÂEEÝ B Þß!„eàß B à‡" [83 subject 115 78 number 100 117 user-defined gnus-summary-dummy-line-format-alist current-load-list 71 group-name 103 (gnus-short-group-name group-name) 65 article-number 90 unread-and-unselected 86 gnus-version 85 unread 101 unselected (gnus-current-score-file-nondirectory) gnus-summary-mode-line-format-alist news-server 77 news-method gnus-group-mode-line-format-alist boundp gnus-have-read-active-file nil] 12) #@43 The mail address of the Gnus maintainers. (defconst gnus-maintainer "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" (#$ . 52800)) #@42 Version number for this version of Gnus. (defconst gnus-version "Gnus v5.1" (#$ . 52944)) #@51 Assoc list of major modes and related Info nodes. (defvar gnus-info-nodes (quote ((gnus-group-mode "(gnus)The Group Buffer") (gnus-summary-mode "(gnus)The Summary Buffer") (gnus-article-mode "(gnus)The Article Buffer"))) (#$ . 53040)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÇÆ BÀÈ!„.ÉÈ BÀÊ!„;Ë\nÊ BÀ‡" [boundp gnus-group-buffer "*Group*" current-load-list gnus-summary-buffer "*Summary*" gnus-article-buffer "*Article*" gnus-server-buffer "*Server*" gnus-work-buffer " *gnus work*"] 2) #@45 Gnus buffers that should be killed on exit. (defvar gnus-buffer-list nil (#$ . 53545)) #@28 List of available servers. (defvar gnus-server-alist nil (#$ . 53638)) #@49 Gnus variables saved in the quick startup file. (defvar gnus-variable-list (quote (gnus-newsrc-options gnus-newsrc-options-n gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist gnus-killed-list gnus-zombie-list)) (#$ . 53715)) #@85 Functions overloaded by gnus. It is a list of `(original overload &optional file)'. (defvar gnus-overload-functions (quote ((news-inews gnus-inews-news "rnewspost"))) (#$ . 53962)) #@35 Options line in the .newsrc file. (defvar gnus-newsrc-options nil (#$ . 54149)) #@79 List of regexps representing groups to be subscribed/ignored unconditionally. (defvar gnus-newsrc-options-n nil (#$ . 54235)) #@49 Date Gnus last asked server for new newsgroups. (defvar gnus-newsrc-last-checked-date nil (#$ . 54367)) #@104 Assoc list of read articles. gnus-newsrc-hashtb should be kept so that both hold the same information. (defvar gnus-newsrc-alist nil (#$ . 54478)) #@33 Hashtable of gnus-newsrc-alist. (defvar gnus-newsrc-hashtb nil (#$ . 54631)) #@28 List of killed newsgroups. (defvar gnus-killed-list nil (#$ . 54714)) #@44 Hash table equivalent of gnus-killed-list. (defvar gnus-killed-hashtb nil (#$ . 54790)) #@33 List of almost dead newsgroups. (defvar gnus-zombie-list nil (#$ . 54884)) #@29 Descriptions of newsgroups. (defvar gnus-description-hashtb nil (#$ . 54965)) #@64 List of newsgroups that have recently been killed by the user. (defvar gnus-list-of-killed-groups nil (#$ . 55049)) #@31 Hashtable of active articles. (defvar gnus-active-hashtb nil (#$ . 55171)) #@31 List of moderated newsgroups. (defvar gnus-moderated-list nil (#$ . 55252)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-group-marked nil current-load-list] 2) #@36 Startup file for the current host. (defvar gnus-current-startup-file nil (#$ . 55414)) #@44 Default regexp for article search command. (defvar gnus-last-search-regexp nil (#$ . 55507)) #@35 Default shell command on article. (defvar gnus-last-shell-command nil (#$ . 55606)) #@47 The current method for selecting a newsgroup. (defvar gnus-current-select-method nil (#$ . 55696)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ BÀÈ!„GÂÈ BÀÉ!„TÂ É BÀÊ!„aÂ\nÊ BÀË!„nÂ Ë BÀÌ!„{Â\fÌ BÀÍ!„ˆÂ Í B‡" [boundp gnus-group-list-mode nil current-load-list gnus-article-internal-prepare-hook gnus-newsgroup-name gnus-newsgroup-begin gnus-newsgroup-end gnus-newsgroup-last-rmail gnus-newsgroup-last-mail gnus-newsgroup-last-folder gnus-newsgroup-last-file gnus-newsgroup-auto-expire gnus-newsgroup-active] 2) #@51 List of unread articles in the current newsgroup. (defvar gnus-newsgroup-unreads nil (#$ . 56261)) #@62 List of unselected unread articles in the current newsgroup. (defvar gnus-newsgroup-unselected nil (#$ . 56366)) #@68 Alist of read articles and article marks in the current newsgroup. (defvar gnus-newsgroup-reads nil (#$ . 56485)) #@76 List of ticked articles in the current newsgroup (a subset of unread art). (defvar gnus-newsgroup-marked nil (#$ . 56605)) #@72 List of ranges of articles that have been through the scoring process. (defvar gnus-newsgroup-killed nil (#$ . 56734)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-newsgroup-kill-headers nil current-load-list] 2) #@70 List of articles that have been replied to in the current newsgroup. (defvar gnus-newsgroup-replied nil (#$ . 56949)) #@64 List of articles in the current newsgroup that can be expired. (defvar gnus-newsgroup-expirable nil (#$ . 57073)) #@66 List of articles in the current newsgroup that can be processed. (defvar gnus-newsgroup-processable nil (#$ . 57193)) #@64 List of articles in the current newsgroup that have bookmarks. (defvar gnus-newsgroup-bookmarks nil (#$ . 57317)) #@52 List of dormant articles in the current newsgroup. (defvar gnus-newsgroup-dormant nil (#$ . 57437)) #@51 List of scored articles in the current newsgroup. (defvar gnus-newsgroup-scored nil (#$ . 57543)) #@51 List of article headers in the current newsgroup. (defvar gnus-newsgroup-headers nil (#$ . 57647)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-newsgroup-headers-hashtb-by-number nil current-load-list] 2) #@69 List of `gnus-fetch-old-headers' articles in the current newsgroup. (defvar gnus-newsgroup-ancient nil (#$ . 57854)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ BÀÈ!„GÂÈ BÀÉ!„TÂ É BÀÊ!„aÂ\nÊ BÀË!„nÂ Ë BÀÌ!„{Â\fÌ BÀÍ!„ˆÂ Í BÀÎ!„•ÂÎ BÀÏ!„¢ÂÏ BÀÐ!„¯ÂÐ BÀÑ!„¼ÂÑ BÀÒ!„ÉÂÒ BÀÓ!„ÖÂÓ BÀÔ!„ãÂÔ BÕ BÀÖ!„ôÂÖ B‡" [boundp gnus-current-article nil current-load-list gnus-article-current gnus-current-headers gnus-have-all-headers gnus-last-article gnus-newsgroup-history gnus-current-kill-article gnus-prev-winconf gnus-summary-line-format-spec gnus-summary-dummy-line-format-spec gnus-group-line-format-spec gnus-summary-mode-line-format-spec gnus-article-mode-line-format-spec gnus-group-mode-line-format-spec gnus-summary-mark-positions gnus-group-mark-positions gnus-summary-expunge-below gnus-reffed-article-number rmail-default-rmail-file gnus-cache-removeable-articles] 2) #@57 Variables that are buffer-local to the summary buffers. (defconst gnus-summary-local-variables (quote (gnus-newsgroup-name gnus-newsgroup-begin gnus-newsgroup-end gnus-newsgroup-last-rmail gnus-newsgroup-last-mail gnus-newsgroup-last-folder gnus-newsgroup-last-file gnus-newsgroup-auto-expire gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked gnus-newsgroup-reads gnus-newsgroup-replied gnus-newsgroup-expirable gnus-newsgroup-processable gnus-newsgroup-killed gnus-newsgroup-bookmarks gnus-newsgroup-dormant gnus-newsgroup-headers gnus-newsgroup-headers-hashtb-by-number gnus-current-article gnus-current-headers gnus-have-all-headers gnus-last-article gnus-article-internal-prepare-hook gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay gnus-newsgroup-scored gnus-newsgroup-kill-headers gnus-newsgroup-threads gnus-newsgroup-async gnus-score-alist gnus-current-score-file gnus-summary-expunge-below gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files gnus-newsgroup-history gnus-newsgroup-ancient (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) gnus-cache-removeable-articles)) (#$ . 58808)) (byte-code "ÀÁ\nBÃÄÅ\"ˆÃÆÇ\"ˆÃÈÉ\"ˆÃÊË\"ˆÃÌË\"ˆÃÍË\"ˆÃÎÏ\"ˆÃÐÑ\"ˆÃÒÓ\"ˆÃÔÕ\"ˆÃÖÕ\"ˆÃ×Õ\"ˆÃØÕ\"ˆÃÙÚ\"ˆÃÛÚ\"ˆÃÜÝ\"ˆÃÞß\"ˆÃàß\"ˆÃáß\"ˆÃâã\"ˆÃäã\"ˆÃåã\"ˆÃæç\"ˆÃèç\"ˆÃéç\"ˆÃêçëì$ˆÃíç\"ˆÃîç\"ˆÃïç\"ˆÃðñ\"ˆÃòñ\"ˆÃóñ\"ˆÃôñ\"ˆÃõñ\"ˆÃöñ\"ˆÃ÷ñ\"ˆÃøñ\"ˆÃùñëì$ˆÃúñëì$ˆÃûñëì$ˆÃüñëì$ˆÃýñëì$ˆÃþñëì$ˆÃÿñëì$ˆÃ@ñëì$ˆÃAñëì$ˆÃBñëì$ˆÃCñ\"ˆÃDEëì$ˆÃFEëì$ˆÃGEëì$ˆÃHI\"ˆÃJI\"ˆÃKI\"ˆÃLI\"ˆÃMI\"ˆÃNI\"ˆÃOP\"ˆÃQP\"ˆÃRP\"ˆÃSP\"ˆÃTP\"ˆÃUP\"ˆÃVPëì$ˆÃWP\"ˆÃXYëì$ˆÃZYëì$ˆÃ[Yë‰\\%ˆÃ]Y\"ˆÃ^Y\"ˆÃ_Y\"ˆÃ`Y\"ˆÃaY\"ˆÃbY\"ˆÃcdëì$ˆÃefë‰\\%ˆÃgfë‰\\%ˆÃhfëì$ˆÃifëì$ˆÃjfëì$ˆÃkfëì$ˆÃlfëì$ˆÃmfëì$ˆÃnfëì$ˆÃofëì$ˆÃpfëì$ˆÃqfëì$ˆÃrfëì$ˆÃsfëì$ˆÃtfëì$ˆÃufëì$ˆÃvfëì$ˆÃwfëì$ˆÃxfëì$ˆÃyfëì$ˆÃzfëì$ˆÃ{fëì$ˆÃ|}ë‰\\%ˆÃ~}ëì$ˆÃ}ëì$ˆÃ€}ëì$ˆÃ}ëì$ˆÃ‚}ëì$ˆÃƒ}ëì$ˆÃ„}ëì$ˆÃ…}ëì$ˆÃ†}ëì$ˆÃ‡}ëì$ˆÃˆ}ëì$ˆÃ‰}ëì$ˆÃŠ}ëì$ˆÃ‹}ëì$ˆÃŒ}ëì$ˆÃ}ëì$ˆÃŽ}\"ˆÃ}\"ˆÃ}\"ˆÃ‘}\"ˆÃ’}\"ˆÃ“}\"ˆÃ”}ëì$ˆÃ•–ëì$ˆÃ—–ëì$ˆÃ˜–\"ˆÃ™–\"ˆÃš–ëì$ˆÃ›–ëì$ˆœž\"ˆœŸž\"‡" ["Sending a bug report to the Gnus Towers.\n========================================\n\nThe buffer below is a mail buffer. When you press `C-c C-c', it will\nbe sent to the Gnus Bug Exterminators. \n\nAt the bottom of the buffer you'll see lots of variable settings.\nPlease do not delete those. They will tell the Bug People what your\nenvironment is, so that it will be easier to locate the bugs.\n\nIf you have found a bug that makes Emacs go \"beep\", set\ndebug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') \nand include the backtrace in your bug report.\n\nPlease describe the bug in annoying, painstaking detail.\n\nThank you for your help in stamping out bugs.\n" gnus-bug-message current-load-list autoload metamail-buffer "metamail" Info-goto-node "info" hexl-hex-string-to-integer "hexl" pp "pp" pp-to-string pp-eval-expression mail-extract-address-components "mail-extr" nnmail-split-fancy "nnmail" nnvirtual-catchup-group "nnvirtual" timezone-make-date-arpa-standard "timezone" timezone-fix-time timezone-make-sortable-date timezone-make-time-string mail-position-on-field "sendmail" mail-setup rmail-output "rmailout" news-mail-other-window "rnewspost" news-reply-yank-original news-caesar-buffer-body rmail-insert-rmail-file-header "rmail" rmail-count-new-messages rmail-show-message gnus-mail-reply-using-mhe "gnus-mh" gnus-mail-forward-using-mhe gnus-mail-other-window-using-mhe gnus-summary-save-in-folder nil t gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name gnus-group-make-menu-bar "gnus-vis" gnus-summary-make-menu-bar gnus-server-make-menu-bar gnus-article-make-menu-bar gnus-browse-make-menu-bar gnus-highlight-selected-summary gnus-summary-highlight-line gnus-carpal-setup-buffer gnus-article-push-button gnus-article-press-button gnus-article-highlight gnus-article-highlight-some gnus-article-hide gnus-article-hide-signature gnus-article-highlight-headers gnus-article-highlight-signature gnus-article-add-buttons gnus-article-next-button gnus-article-add-button gnus-article-highlight-citation "gnus-cite" gnus-article-hide-citation-maybe gnus-article-hide-citation gnus-kill "gnus-kill" gnus-apply-kill-file-internal gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author gnus-execute gnus-expunge gnus-cache-possibly-enter-article "gnus-cache" gnus-cache-save-buffers gnus-cache-possibly-remove-articles gnus-cache-request-article gnus-cache-retrieve-headers gnus-cache-possibly-alter-active gnus-jog-cache gnus-cache-enter-remove-article gnus-summary-increase-score "gnus-score" gnus-summary-lower-score gnus-summary-score-map keymap gnus-score-save gnus-score-headers gnus-current-score-file-nondirectory gnus-score-adaptive gnus-score-remove-lines-adaptive gnus-score-find-trace gnus-score-customize "gnus-edit" gnus-uu-extract-map "gnus-uu" gnus-uu-mark-map gnus-uu-digest-mail-forward gnus-uu-digest-post-forward gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-by-regexp gnus-uu-mark-all gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu gnus-uu-decode-uu-and-save gnus-uu-decode-unshar gnus-uu-decode-unshar-and-save gnus-uu-decode-save gnus-uu-decode-binhex gnus-uu-decode-uu-view gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view gnus-uu-decode-binhex-view gnus-summary-send-map "gnus-msg" gnus-group-post-news gnus-group-mail gnus-summary-post-news gnus-summary-followup gnus-summary-followup-with-original gnus-summary-followup-and-reply gnus-summary-followup-and-reply-with-original gnus-summary-cancel-article gnus-summary-supersede-article gnus-post-news gnus-inews-news gnus-cancel-news gnus-summary-reply gnus-summary-reply-with-original gnus-summary-mail-forward gnus-summary-mail-other-window gnus-mail-reply-using-mail gnus-mail-yank-original gnus-mail-send-and-exit gnus-mail-forward-using-mail gnus-mail-other-window-using-mail gnus-article-mail gnus-bug gnus-summary-save-in-vm "gnus-vm" gnus-summary-save-article-vm gnus-mail-forward-using-vm gnus-mail-reply-using-vm gnus-mail-other-window-using-vm gnus-yank-article defalias gnus-summary-position-cursor gnus-goto-colon gnus-group-position-cursor] 6) #@69 Pop to BUFFER, evaluate FORMS, and then returns to original window. (defalias 'gnus-eval-in-buffer-window '(macro . #[(buffer &rest forms) "ÀÁÂÃÄ DBBÇBBE‡" [let ((GnusStartBufferWindow (selected-window))) unwind-protect progn pop-to-buffer buffer forms ((select-window GnusStartBufferWindow))] 6 (#$ . 65375)])) #@40 Get hash value of STRING in HASHTABLE. (defalias 'gnus-gethash '(macro . #[(string hashtable) "ÀÁ\n ED‡" [symbol-value intern-soft string hashtable] 4 (#$ . 65695)])) #@61 Set hash value. Arguments are STRING, VALUE, and HASHTABLE. (defalias 'gnus-sethash '(macro . #[(string value hashtable) "ÀÁ\n E\fE‡" [set intern string hashtable value] 4 (#$ . 65868)])) (defalias 'gnus-buffer-substring #[(beg end) "” •{‡" [beg end] 2]) (put (quote gnus-buffer-substring) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'gnus-truncate-string #[(str width) "Á\nO‡" [str 0 width] 3]) (defalias 'gnus-limit-string #[(str width) "G Vƒ\f O‡‡" [str width 0] 3]) (put (quote gnus-limit-string) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@34 Remove "Re:" from subject lines. (defalias 'gnus-simplify-subject-re #[(subject) "ÀÂÃ\f\"ƒ\fÅ•ÆO‚\f)‡" [t case-fold-search string-match "^re: *" subject 0 nil] 3 (#$ . 66466)]) (put (quote gnus-simplify-subject-re) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'gnus-goto-char #[(point) "…b‡" [point] 1]) (put (quote gnus-goto-char) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'gnus-buffer-exists-p '(macro . #[(buffer) "À ÂÃÄ DÅBB EE‡" [and buffer funcall if stringp ((quote get-buffer) (quote buffer-name))] 6])) (defalias 'gnus-kill-buffer '(macro . #[(buffer) "ÀÁ\nDÃ\nDE‡" [if gnus-buffer-exists-p buffer kill-buffer] 4])) #@40 Return point at the beginning of line. (defalias 'gnus-point-at-bol #[nil "`Áyˆ`bˆ)‡" [p 0] 2 (#$ . 67157)]) (put (quote gnus-point-at-bol) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@40 Return point at the beginning of line. (defalias 'gnus-point-at-eol #[nil "`Áˆ`bˆ)‡" [p nil] 2 (#$ . 67364)]) (put (quote gnus-point-at-eol) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'gnus-delete-line '(macro . #[(&optional n) "ÀÁÂÃ\f† ÅDÆBBE‡" [delete-region (progn (beginning-of-line) (point)) progn forward-line n 1 ((point))] 5])) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-init-inhibit nil current-load-list] 2) (defalias 'gnus-read-init-file #[(&optional inhibit-next) "ƒÁ‰‡\n …/Ä !ƒÅ !ƒ*Ä ÆP!„*Ä ÇP!…/È ÁÉ#‡" [gnus-init-inhibit nil inhibit-next gnus-init-file file-exists-p file-directory-p ".el" ".elc" load t] 4]) (byte-code "ÀÁ!ˆÀÂ!‡" [require gnus-cus gnus-ems] 2) (defalias 'gnus-extract-address-components #[(from) "À‰ÃÄ \"ƒ ƔƕO ƒ:ÃÇÈ !ÉQ \"ƒ: Ɖ”O‰ƒ:ÃÊ\n\"ƒ:\nËÆ•SO\n„nÃÌ \"ƒR Æ”TÆ•SO‰„nÃÍ \"ƒ_ ‰„nÃÎ \"ƒn Æ”TÆ•O\n†s †x *D‡" [nil address name string-match "\\b[^@ <>]+[!@][^@ <>]+\\b" from 0 "[ ]*<" regexp-quote ">" "\".*\"" 1 "(.+)" "()" "(.*"] 4]) #@58 Return the value of the header FIELD of current article. (defalias 'gnus-fetch-field #[(field) "ŠŒÀ ˆÃ\f!+‡" [t case-fold-search gnus-narrow-to-headers mail-fetch-field field] 2 (#$ . 68403)]) (defalias 'gnus-goto-colon #[nil "ÀyˆÁÂ`Ĉ` bˆ)Å#‡" [0 search-forward ":" p nil t] 4]) (defalias 'gnus-narrow-to-headers #[nil "~ˆŠebÀÁÂÃ#ƒ`S‚d})‡" [search-forward "\n\n" nil t] 5]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-old-specs nil current-load-list] 2) (defalias 'gnus-update-format-specifications #[nil "À ˆÁ‰‰ƒZÆÇÈ @\"!J @ žA‰ƒ'\f š„FÆÇÊ @\"!Ë ÆÇÌ @Í=ƒ>΂@ @\"!J\"Lˆ @ BÏ @ \"B A‰„ +Ð ˆÑ ˆÒÓ\"…v?…v…v× ‡" [gnus-make-thread-indent-array (summary summary-dummy group summary-mode group-mode article-mode) nil new-format old-format formats intern format "gnus-%s-line-format" gnus-old-specs "gnus-%s-line-format-spec" gnus-parse-format "gnus-%s-line-format-alist" article-mode summary-mode delq gnus-update-group-mark-positions gnus-update-summary-mark-positions string-match "%D" gnus-group-line-format gnus-description-hashtb gnus-read-active-file gnus-read-all-descriptions-files] 9]) (defalias 'gnus-update-summary-mark-positions #[nil "ŠÀÁ‰Â‰È ˆÉÂÊËÂÌÍÂÎÂÏ&\nˆebˆÐÑÒÂÍ#…-`ÓZBCebˆÔÑÕÂÍ#…?`ÓZB BebˆÖÑ×ÂÍ#…R`ÓZB B‰‰.‡" [129 130 nil pos thread gnus-score-over-mark gnus-score-below-mark gnus-replied-mark gnus-set-work-buffer gnus-summary-insert-line [0 "" "" "" "" "" 0 0 ""] 0 128 t "" 1 unread search-forward "€" 2 replied "" score "‚" gnus-summary-mark-positions] 12]) (defalias 'gnus-update-group-mark-positions #[nil "ŠÀÁÄÅ\"ÇLˆÈ ˆÉÊÅËÊËÊ&ˆebˆÌÍÎÊÏ#…)`ÐZBC‰+‡" [128 ("dummy.group") gnus-group-marked gnus-process-mark intern "dummy.group" gnus-active-hashtb (0 . 0) gnus-set-work-buffer gnus-group-insert-group-line nil 0 process search-forward "€" t 2 gnus-group-mark-positions] 7]) (defalias 'gnus-mouse-face-function #[(form) "ÀÁ\nDCÃBB‡" [let string form ((put-text-property 0 (length string) (quote mouse-face) gnus-mouse-face string) string)] 3]) (defalias 'gnus-max-width-function #[(el max-width) "§„\nÁÂÃ\"ˆÄÅÆDDÈBÉÊËEÌÍÎFÏBBBE‡" [max-width signal wrong-type-argument (numberp max-width) let* val eval el ((valstr (if (numberp val) (int-to-string val) val))) if > (length valstr) substring valstr 0 (valstr)] 8]) (defalias 'gnus-parse-format #[(format spec-alist) "ÀÁ\n\"ƒW ƒ?\fƒ?\nŔŕO\nƔƕO\nǔǕO \nËÌ\n \"ÎÌ  \"!Ì \"F+‡Ì\nŔŕO\nƔƕO\nǔǕOQ \"‡Ì\n \"‡" [string-match "\\`\\(.*\\)%(\\(.*\\)%)\\(.*\n?\\)\\'" format gnus-visual gnus-mouse-face 1 2 3 post button pre concat gnus-parse-simple-format spec-alist gnus-mouse-face-function] 6]) (defalias 'gnus-parse-simple-format #[(format spec-alist) "ÀÁ‰‰‰‰‰ŠÉ ˆ\ncˆebˆËÌÁÍ#ƒÇÎϔϕ{!Д‰ƒAÑДTЕ{!‚GÀÏ”žA‰„TÓ @Ô=ƒsÕÖהו{P!ØDÙD‰ƒsהו|ˆÀU„® @ A@ÛUƒÜD‚ A@ÝUƒÞDß\"BÙ)‚¹ @B A@\nÏ•|ˆ\nbˆ\fcˆ‚Ðd{)Ê Ÿ.BB‡" [0 nil beg elem newspec fstring flist spec max-width gnus-set-work-buffer format re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?" t string-to-char 2 1 string-to-int spec-alist ("*" 115) user-defined intern "gnus-user-format-function-" 3 header 115 el 99 char-to-string 100 int-to-string gnus-max-width-function] 7]) (defalias 'gnus-set-work-buffer #[nil "À !ƒ\f qˆÂ ‡Ã !qˆÄ ˆÅp!ˆÆ ‡" [get-buffer gnus-work-buffer erase-buffer get-buffer-create kill-all-local-variables buffer-disable-undo gnus-add-current-to-buffer-list] 2]) #@189 Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num. Otherwise, it is like ~/News/news/group/num. (defalias 'gnus-Numeric-save-name #[(newsgroup headers &optional last-file) "ÀÁÂ!ƒ Ã\f!‚Å\f!ÆÇÉH!Q\n†Ë\"\f ƒAÎ\f!Î !˜ƒAÏÐÑ !\"ƒA\f‚H †H\f)‡" [expand-file-name gnus-use-long-file-name not-save gnus-capitalize-newsgroup newsgroup gnus-newsgroup-directory-form "/" int-to-string headers 0 gnus-article-save-directory "~/News" default last-file file-name-directory string-match "^[0-9]+$" file-name-nondirectory] 6 (#$ . 71871)]) #@194 Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is non-nil, it is ~/News/news.group/num. Otherwise, it is like ~/News/news/group/num. (defalias 'gnus-numeric-save-name #[(newsgroup headers &optional last-file) "ÀÁÂ!ƒ ‚Ä !ÅÆÈH!Q †Ê\" \fƒ?Í !Í\f!˜ƒ?ÎÏÐ\f!\"ƒ? ‚F\f†F )‡" [expand-file-name gnus-use-long-file-name not-save newsgroup gnus-newsgroup-directory-form "/" int-to-string headers 0 gnus-article-save-directory "~/News" default last-file file-name-directory string-match "^[0-9]+$" file-name-nondirectory] 6 (#$ . 72513)]) #@191 Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is non-nil, it is ~/News/News.group. Otherwise, it is like ~/News/news/group/news. (defalias 'gnus-Plain-save-name #[(newsgroup headers &optional last-file) "†ÁÂÃ!ƒÄ !‚Æ !ÇP†É\"‡" [last-file expand-file-name gnus-use-long-file-name not-save gnus-capitalize-newsgroup newsgroup gnus-newsgroup-directory-form "/news" gnus-article-save-directory "~/News"] 3 (#$ . 73129)]) #@191 Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is non-nil, it is ~/News/news.group. Otherwise, it is like ~/News/news/group/news. (defalias 'gnus-plain-save-name #[(newsgroup headers &optional last-file) "†ÁÂÃ!ƒ\f‚Å\f!ÆP†È\"‡" [last-file expand-file-name gnus-use-long-file-name not-save newsgroup gnus-newsgroup-directory-form "/news" gnus-article-save-directory "~/News"] 3 (#$ . 73624)]) (defalias 'gnus-subscribe-hierarchical-interactive #[(groups) "À Â\"ɉ‰‰‰  …_ÊC ƒ ƒË @ @\"„8 A ‚& @‰GSËÌ @#ƒ AƒÊ @͉•OP‰ƒË A@\"ƒ B ÎÏÐGSO\"ˆÑ ‰ÒUƒ° ƒªË @‰\"ƒª BÔ \" Lˆ A‰„Š\fA‚ÖUƒà ƒÚË @‰\"ƒÚÔ \" Lˆ× @!ˆ A‰„»\fA‚ØUƒ ƒ @‰BÔ \" Lˆ A‰‚èÎÙ @\"ˆÑ  @ÚUƒ'× @!ˆÔ \" Lˆ‚XØUƒJ ƒX @‰BÔ \" Lˆ A‰‚/ BÔ \" Lˆ A‰‚.‡" [sort groups string< nil starts group ans start prefix prefixes "^" string-match "[^\\.]\\." 0 message "Descend hierarchy %s? ([y]nsq): " 1 read-char 110 gnus-killed-list intern gnus-killed-hashtb 115 gnus-subscribe-alphabetically 113 "Subscribe %s? ([n]yq)" 121] 8]) #@59 Subscribe new NEWSGROUP by making it the first newsgroup. (defalias 'gnus-subscribe-randomly #[(newsgroup) "À !‡" [gnus-subscribe-newsgroup newsgroup] 2 (#$ . 74794)]) #@62 Subscribe new NEWSGROUP and insert it in alphabetical order. (defalias 'gnus-subscribe-alphabetically #[(newgroup) "AÁ\n„# ƒ#\f @@™ƒ @@‰‚ A‚Å\f\n\"*‡" [gnus-newsrc-alist nil before groups newgroup gnus-subscribe-newsgroup] 4 (#$ . 74968)]) #@72 Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order. (defalias 'gnus-subscribe-hierarchically #[(newgroup) "ŠÀ !qˆ\nÃ\f„D ƒDebˆÆÇ !ÈQ Ê ÃË#ƒ2̔̕{‰\n™„)ÍÎ \"…@ ̔̕O‚\nÏ\n\f\"+‡" [find-file-noselect gnus-current-startup-file newgroup nil before groupkey "^\\(" regexp-quote ".*\\)[!:]" groupkey-re re-search-forward t 1 string-match "^\\(.*\\)\\.[^.]+$" gnus-subscribe-newsgroup] 5 (#$ . 75227)]) #@124 Subscribe new NEWSGROUP interactively. It is inserted in hierarchical newsgroup order if subscribed. If not, it is killed. (defalias 'gnus-subscribe-interactively #[(newsgroup) "ÀÁ \"!ƒ Ä !‡ B‰‡" [gnus-y-or-n-p format "Subscribe new newsgroup: %s " newsgroup gnus-subscribe-hierarchically gnus-killed-list] 4 (#$ . 75662)]) #@36 Make new NEWSGROUP a zombie group. (defalias 'gnus-subscribe-zombies #[(newsgroup) " B‰‡" [newsgroup gnus-zombie-list] 2 (#$ . 75996)]) #@116 Subscribe new NEWSGROUP. If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made the first newsgroup. (defalias 'gnus-subscribe-newsgroup #[(newsgroup &optional next) "À \n Ä †\nÆ\"J$ˆÈÉÊ #‡" [gnus-group-change-level newsgroup gnus-level-default-subscribed gnus-level-killed intern-soft next "dummy.group" gnus-newsrc-hashtb gnus-message 5 "Subscribe newsgroup: %s"] 7 (#$ . 76141)]) #@55 Make hierarchical directory name from NEWSGROUP name. (defalias 'gnus-newsgroup-directory-form #[(newsgroup) "À ! GÂÅÆ \"‰ƒ ÇIˆ‚È \fWƒ6 HÉUƒ/ ÇIˆ T‰‚ +‡" [gnus-newsgroup-saveable-name newsgroup nil idx len string-match ":" 47 0 46] 4 (#$ . 76547)]) (defalias 'gnus-newsgroup-saveable-name #[(group) "À ÂÃ#‡" [gnus-replace-chars-in-string group 47 46] 4]) #@29 Make DIRECTORY recursively. (defalias 'gnus-make-directory #[(dir) "À \n\"ÃÃÆÇ \"ƒ ȉ”OÉ !„. \fBÆÊ \"ˆ ȉ”O‚\fƒB „BÃË̈\fA‰„2\f+?‡" [expand-file-name dir default-directory nil dirs err string-match "/$" 0 file-exists-p "/[^/]+$" (byte-code "À @!‡" [make-directory dirs] 2) ((error (byte-code "ÀÀ‡" [t err] 1)))] 4 (#$ . 76925)]) #@28 Capitalize NEWSGROUP name. (defalias 'gnus-capitalize-newsgroup #[(newsgroup) "GÁU?…ÂÁH–!ÃÄOP‡" [newsgroup 0 char-to-string 1 nil] 4 (#$ . 77277)]) #@99 Remove `Re:' and words in parentheses. If optional argument RE-ONLY is non-nil, strip `Re:' only. (defalias 'gnus-simplify-subject #[(subject &optional re-only) "ÀÂÃ\f\"ƒ\fÅ•ÆO„$ÂÈ\f\"ƒ$\fʼn”O‚\f)‡" [t case-fold-search string-match "^re:[ ]*" subject 0 nil re-only "[ \n]*([^()]*)[ \n]*\\'"] 3 (#$ . 77436)]) (defalias 'gnus-simplify-subject-fuzzy #[(subject) "ÀŠÂ ˆ cˆÄ ˆÅ *‡" [t case-fold-search gnus-set-work-buffer subject gnus-simplify-buffer-fuzzy buffer-string] 1]) (defalias 'gnus-simplify-buffer-fuzzy #[nil "ebˆÀÁÂÃ#ƒÄÅÉ#ˆ‚ebˆÀÆÂÃ#ƒ(ÄÅÉ#ˆ‚ebˆÀÇÂÃ#ƒ<ÄÈÉ#ˆ‚+ebˆÀÉÂÃ#ƒPÄÅÉ#ˆ‚?ebˆÀÊÂÃ#ƒdÄÅÉ#ˆ‚S …{À ÂÃ#…{ÄÅÉ#ˆ‚i‡" [re-search-forward "^[ ]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ ]*" nil t replace-match "" "[ \n]*([^()]*)[ \n]*$" "[ ]+" " " "[ ]+$" "^[ ]+" gnus-simplify-subject-fuzzy-regexp] 4]) (defalias 'gnus-add-current-to-buffer-list #[nil "p>† pB‰‡" [gnus-buffer-list] 2]) (defalias 'gnus-string> #[(s1 s2) " ™†  ˜?‡" [s1 s2] 2]) (defalias 'gnus-header-number #[(header) "ÁH‡" [header 0] 2]) (defalias 'gnus-header-subject #[(header) "ÁH‡" [header 1] 2]) (defalias 'gnus-header-from #[(header) "ÁH‡" [header 2] 2]) (defalias 'gnus-header-xref #[(header) "ÁH‡" [header 8] 2]) (defalias 'gnus-header-lines #[(header) "ÁH‡" [header 7] 2]) (defalias 'gnus-header-date #[(header) "ÁH‡" [header 3] 2]) (defalias 'gnus-header-id #[(header) "ÁH‡" [header 4] 2]) (defalias 'gnus-header-message-id #[(header) "ÁH‡" [header 4] 2]) (defalias 'gnus-header-chars #[(header) "ÁH‡" [header 6] 2]) (defalias 'gnus-header-references #[(header) "ÁH‡" [header 5] 2]) #@34 Clear all variables and buffers. (defalias 'gnus-clear-system #[nil "‰ƒ @ÂLˆ A‰„) Â\n Â\f ÂÂÂÂÒÓ!ƒGÓÂLˆÒÔ!ƒQÔÂLˆƒdÖ!ƒd×Ö!!ˆƒlÙ ˆÚ ˆÖÛÂ!!ƒ×ÖÛÂ!!!ˆƒš;ƒŽÝ‚Þ!ƒš×!ˆ…È@ƒ¾@;ƒ°Ý‚±Þ@!ƒ¾×@!ˆA‰„ŸÂ‡" [gnus-variable-list variables nil gnus-list-of-killed-groups gnus-have-read-active-file gnus-newsrc-alist gnus-newsrc-hashtb gnus-killed-list gnus-zombie-list gnus-killed-hashtb gnus-active-hashtb gnus-moderated-list gnus-description-hashtb gnus-newsgroup-headers gnus-newsgroup-headers-hashtb-by-number gnus-newsgroup-name gnus-server-alist gnus-current-select-method boundp gnus-score-cache gnus-internal-global-score-files gnus-current-startup-file get-file-buffer kill-buffer gnus-use-cache gnus-cache-save-buffers gnus-dribble-clear gnus-newsgroup-kill-file nntp-server-buffer get-buffer buffer-name gnus-buffer-list] 5 (#$ . 79061)]) (defalias 'gnus-windows-old-to-new #[(setting) "9ƒ%Á>ƒ‚$Ã>ƒÄ‚$Å>ƒ#Æ‚$<„5ƒ5È>„7‡Æ=ƒLÉžƒHÉ‚MÊ‚M‰žA@ ÌÍ \"ÏÊ=ƒjÆ‚kÄÒÔÔ×WƒÉ 8§ƒÀ 8ÒU„ÀØ @_¥8=ƒ²Ù8Ú#‚»Ù8\"BT‰‚xŸ.C‡" [setting (SelectArticle) article (SelectSubject ExpandSubject) summary (SelectNewsgroup ExitNewsgroup) group gnus-window-configuration (group summary article) newsgroup newsgroups elem apply + total (group summary article) types pbuf 0 i nil perc out 3 1.0 vector point] 5]) (defalias 'gnus-add-configuration #[(conf) "Á@\nž\n\"B‰‡" [conf delq gnus-buffer-configuration] 4]) (defalias 'gnus-configure-windows #[(setting &optional force) "À !‰9ƒ \nžA‚ pɉ‰‰‰‰‰‰‰‰‰‰ \n \f ‰„DÓÔ \"ˆ„[Ö!‰ƒ[×Ø\fÙ\"!‚'ƒfÛ ˆ‚nÜ ˆÝ!ˆƒ@\fà \f@<ƒ³\f@@ß=ƒ³àÃ\f@A@¨ƒž\f@A@‚«á âá \f@A@_!ZÙ#ˆ\fA\f\fƒã\f@!ƒÆ\f@‚Ëä\f@!‰ƒùåH‰&žA‰ƒòçèéê\"\"‰åIˆ B \fA‰\f„¸ ŸBA‰„sŸë ƒ@‰\f@<ƒ:\f@@ß=ƒ:\fA\få \fƒ\f@ìHí!ƒ[îUƒ[ï‚o¨ƒf‚oâ_!ð]\nB\n \n@§ƒƒ\n@‚„å\\ \fA‰\f„B\nŸ\n@\f\nƒ \n@ \nA\n ï=ƒ· Z \nƒÂàà \"ˆ\f@åHÝ „Ò‚å 9ƒà\f@åHJ‚å\f@åH!ˆ\f@GñVƒý\f@ñHò=ƒýpóì!ˆ\fA\f‚šA‰„!„Óô \"ˆ×ØÙ\"!ˆq.‡" [gnus-windows-old-to-new setting gnus-buffer-configuration nil all-visible to-buf total rel jump-buffer sub heights ohor hor height w val rule in-buf r error "No such setting: %s" force gnus-all-windows-visible-p select-window get-buffer-window t gnus-use-full-window delete-other-windows gnus-remove-some-windows switch-to-buffer nntp-server-buffer horizontal split-window frame-width floor vectorp eval 0 gnus-window-to-buffer apply vector mapcar identity window-height 1 floatp 1.0 x 4 2 point other-window "Missing `point' in spec for %s"] 16]) (defalias 'gnus-all-windows-visible-p #[(rule) "À‰‰‰‰ƒ€ „€@A\fƒ\n „\nÇ\f@!ƒ0\f@‚=\f@@È=?…=É\f@!‰ƒv\nÊH žA†O\nÊH‰9ƒZ J‚[ \nGÌVƒmÍ\nÌH=ƒm  …tÎ !?\fA‰„ ‚\n ?…† -‡" [nil buffer val jump-buffer hor invisible rule vectorp horizontal eval 0 gnus-window-to-buffer 2 point get-buffer-window] 6]) (defalias 'gnus-window-top-edge #[(&optional window) "À !A@‡" [window-edges window] 2]) (defalias 'gnus-remove-some-windows #[nil "Á‰‰‰ŠƒO@A‰9ƒ$Ç !…# J ƒFÈ !ƒF \fBÉ !ˆ\nƒAÊ \nWƒFÊ  A‰„Á ÌÍ!ˆ) ƒdÉ !ˆÎ!ˆ\f…|\f@ =„tÐ\f@!ˆ\fA‰„hÁ.‡" [gnus-window-to-buffer nil lowest lowest-buf bufs buf buffers boundp get-buffer-window pop-to-buffer gnus-window-top-edge wins walk-windows #[(win) "À !ÃÄÅ\n!\"…,\nBÇ\n!ˆƒ$É W…,\n\nÉ ‰)‡" [window-buffer win buf string-match "^\\*Summary" buffer-name bufs pop-to-buffer lowest gnus-window-top-edge lowest-buf] 4] switch-to-buffer nntp-server-buffer delete-windows-on] 6]) #@42 Version numbers of this version of Gnus. (defalias 'gnus-version #[nil " ‰ƒ+Æ @@ÇP!È !ƒ$ J;ƒ$\fÉ JQ A‰„\nÊË\f\"+‡" [gnus-valid-select-methods gnus-version nil meth mess methods intern "-version" boundp "; " gnus-message 2] 4 (#$ . 82818) nil]) #@34 Find Info documentation of Gnus. (defalias 'gnus-info-find-node #[nil "ÂÃ!ˆÄ žA@!)‡" [major-mode mode gnus-configure-windows info Info-goto-node gnus-info-nodes] 3 (#$ . 83080) nil]) #@129 Overload functions specified by optional argument OVERLOADS. If nothing is specified, use the variable gnus-overload-functions. (defalias 'gnus-overload-functions #[(&optional overloads) "À †\n …3 @ AÄ @!„) AA@ƒ)Å AA@ÀÆ#ˆ @ A@Mˆ‚*‡" [nil overloads gnus-overload-functions defs fboundp load nomessage] 4 (#$ . 83273)]) #@47 Replace characters in STRING from FROM to TO. (defalias 'gnus-replace-chars-in-string #[(string &rest pairs) "ÁÂOGÁ‰ÇGɦ!„ÊË!ˆÌÄ\"ˆ Wƒ@Ä HN‰ƒ9 Iˆ T‰‚$-‡" [string 0 nil to sym idx len zerop pairs 2 error "Odd number of translation pairs" setplist] 6 (#$ . 83608)]) (defalias 'gnus-days-between #[(date1 date2) "À !À\n!Z‡" [gnus-day-number date1 date2] 3]) (defalias 'gnus-day-number #[(date) "ÀÁ !\"Å\fA@Æ\f8\f@#)‡" [mapcar #[(s) "…Á!‡" [s string-to-int] 2] timezone-parse-date date dat timezone-absolute-from-gregorian 2] 4]) (defalias 'gnus-seconds-since-epoch #[(date) "ÀÁ !\"ÀÅÆ !ÇH!\"ÀÉÂÊ!\" Ì\fA@Í\f8\f@#Ì A@Í 8 @#ZÍ8A@Ï_\\Ð@_Ñ_\\Ò_Ó_\\,‡" [mapcar #[(ti) "…Á!‡" [ti string-to-int] 2] timezone-parse-date date tdate #[(ti) "…Á!‡" [ti string-to-int] 2] timezone-parse-time 3 ttime #[(ti) "…Á!‡" [ti string-to-int] 2] "Jan 1 12:00:00 1970" edate timezone-absolute-from-gregorian 2 tday 60 1.0 3600 1.0 86400] 5]) (defalias 'gnus-file-newer-than #[(file date) "ÀÁ\n!8‰@\f@V† @\f@U… A@\fA@V)‡" [5 file-attributes file fdate date] 4]) #@175 Check whether GROUP supports editing or not. If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note that that variable is buffer-local to the summary buffers. (defalias 'gnus-group-read-only-p #[(&optional group) "† ÂÃ\")?‡" [group gnus-newsgroup-name gnus-check-backend-function request-replace-article] 3 (#$ . 84717)]) (defalias 'gnus-y-or-n-p #[(prompt) "À !ÂÃ!ˆ‡" [y-or-n-p prompt message ""] 3]) (defalias 'gnus-yes-or-no-p #[(prompt) "À !ÂÃ!ˆ‡" [yes-or-no-p prompt message ""] 3]) (defalias 'gnus-use-long-file-name #[(symbol) "…?‡" [gnus-use-long-file-name symbol] 2]) #@53 Return a string like DD-MMM from a big messy string (defalias 'gnus-dd-mmm #[(messy-date) "À !ÃÄ\nÅH† ÆÇÈ\nÉH!S\n8@†Ë!#)‡" [timezone-parse-date messy-date datevec format "%2s-%s" 2 "??" capitalize string-to-number 1 timezone-months-assoc "???"] 7 (#$ . 85332)]) (defalias 'gnus-make-hashtable #[(&optional hashsize) "À ƒ  !Ã]‚ÃÄ\"‡" [make-vector hashsize gnus-create-hash-size 255 0] 3]) (defalias 'gnus-create-hash-size #[(min) "ÀÀ\nWƒ ‰\\‰‚ S)‡" [1 i min] 3]) (defalias 'gnus-message #[(level &rest args) " Xƒ ÂÃ\f\"‡ÂÅ\f\"‡" [level gnus-verbose apply message args format] 3]) (defalias 'gnus-generate-new-group-name #[(leaf) "ÁÄ \"JƒÆÇ\nT‰!ÈR‚ *‡" [leaf 0 num name intern-soft gnus-newsrc-hashtb "<" int-to-string ">"] 5]) #@40 Say whether GROUP is ephemeral or not. (defalias 'gnus-ephemeral-group-p #[(group) "ÀÁ !\"‡" [assoc quit-config gnus-find-method-for-group group] 4 (#$ . 86092)]) #@34 Return the quit-config of GROUP. (defalias 'gnus-group-quit-config #[(group) "ÀÁ !\"A@‡" [assoc quit-config gnus-find-method-for-group group] 4 (#$ . 86262)]) #@30 Return last element of LIST. (defalias 'gnus-last-element #[(list) "Aƒ\fA‰‚@‡" [list] 2 (#$ . 86428)]) #@38 Do a complete, total copy of a list. (defalias 'gnus-copy-sequence #[(list) ":ƒA:„@AB‡ÁÂ\"‡" [list mapcar #[(elem) ":ƒA:ƒÁ!‡@AB‡‡" [elem gnus-copy-sequence] 2]] 3 (#$ . 86544)]) #@65 Return a list of elements of LIST1 that do not appear in LIST2. (defalias 'gnus-set-difference #[(list1 list2) "À !\nƒÃ\n@ \"\nA‰„ )‡" [copy-sequence list1 list2 delq] 4 (#$ . 86747)]) #@102 Return a list of elements of LIST1 that do not appear in LIST2. Both lists have to be sorted over <. (defalias 'gnus-sorted-complement #[(list1 list2) "À\nƒ\n „\n†R ‚R\nƒJ ƒJ\n@ @Uƒ+\nA A‚\n@ @Wƒ?\n@ B\nA‰‚ @ B A‚ Ÿ\n†Q ¤)‡" [nil out list1 list2] 3 (#$ . 86946)]) (defalias 'gnus-intersection #[(list1 list2) "À\nƒ\n@ >ƒ\n@ B\nA‰„ )‡" [nil result list2 list1] 3]) (defalias 'gnus-sorted-intersection #[(list1 list2) "À\nƒ5 ƒ5\n@ @Uƒ \n@ B\nA A‚\n@ @Wƒ/\nA‰‚ A‚ Ÿ)‡" [nil out list1 list2] 3]) (defalias 'gnus-set-sorted-intersection #[(list1 list2) "À B‰ ƒ;\fƒ; @\f@Uƒ!  A\fA‚ @\f@Wƒ5 A¡ˆ A‰‚\fA‚ À¡ˆ\nA*‡" [nil list1 top prev list2] 3]) #@143 Convert list of numbers to a list of ranges or a single range. If ALWAYS-LIST is non-nil, this function will always release a list of ranges. (defalias 'gnus-compress-sequence #[(numbers &optional always-list) "@@Ã…uA<„‚uƒL\n@U„E\nT@Uƒ/@‚E \nUƒ9 ‚< \nB\fB@@A‰„ „e\f„e \nUƒ_ C‚u \nB‚u \nUƒo ‚r \nB\fBŸ+‡" [numbers first last nil result always-list] 3 (#$ . 87656)]) (defalias (quote gnus-uncompress-sequence) (quote gnus-uncompress-range)) #@134 Expand a list of ranges into a list of numbers. RANGES is either a single range on the form `(num . num)' or a list of these ranges. (defalias 'gnus-uncompress-range #[(ranges) "À‰‰\f„À‚j\fA<„0\f@\fA \nXƒ+ B T‰‚ Ÿ‚j\fƒh\f@:„H\f@§ƒa\f@ B‚a\f@@\f@A \nXƒa B T‰‚Q\fA‰„4 Ÿ+‡" [nil result last first ranges] 4 (#$ . 88141)]) #@112 Return a list of ranges that has all articles from both RANGES and LIST. Note: LIST has to be sorted over `<'. (defalias 'gnus-add-to-range #[(ranges list) "„ Á\nÃ\"‡Ä\n!A<„Cʼn‰‰ \nƒ¡\nƒ¡\n @:„;@†>@@\nƒY\nAƒY\nA@WƒY\nA‰„D @Wƒw\n\nAÅ¡ˆÁ Ã\"\n¤\n@:„‚@†…@A\nƒš\n@Xƒš\nA‰„‹A‰„)\nƒ®Á\nÃ\"\n¤\nË\nÌ\"‰\n‰ƒR@:„\nAƒKA@:„é@TA@UƒK‰@A@B ˆ‰AA¡ˆ‚K@TA@@UƒKA@@ ˆ‰A@ ˆ‰AA¡ˆ‚KAƒKA@:„1@ATA@UƒK@A@¡ˆ‰AA¡ˆ‚K@ATA@@UƒK@A@A¡ˆ‰AA¡ˆA‰„»\n-‡" [ranges gnus-compress-sequence list t copy-sequence nil temp highest lowest ilist out sort #[(r1 r2) ":„ † @ :„ † @W‡" [r1 r2] 2]] 6 (#$ . 88497)]) #@116 Return a list of ranges that has all articles from LIST removed from RANGES. Note: LIST has to be sorted over `<'. (defalias 'gnus-remove-from-range #[(ranges list) "ÀÁ !\f\"!‡" [gnus-compress-sequence gnus-sorted-complement gnus-uncompress-range ranges list] 4 (#$ . 89190)]) (defalias 'gnus-member-of-range #[(number ranges) "A<„ @Y…Z AX‡ÂƒW@§ƒ% @Y‚* @@YƒW ƒW@§ƒ> @U‚K @@YƒP @AXƒPÄA‰„ )?‡" [ranges number t not-stop nil] 3]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ BÈÉÊË#ˆ „“Ì Í !ˆÎ ÏÐ#ˆÎ ÑÒ#ˆÎ ÓÒ#ˆÎ ÔÕ#ˆÎ Ö×#ˆÎ ØÙ#ˆÎ ÚÙ#ˆÎ ÛÜ#ˆÎ ÝÞ#ˆÎ ßà#ˆÎ áâ#ˆÎ ãä#ˆÎ åæ#ˆÎ çè#ˆÎ éê#ˆÎ ëì#ˆÎ íî#ˆÎ ïð#ˆÎ ñò#ˆÎ óô#ˆÎ õö#ˆÎ ÷ø#ˆÎ ùú#ˆÎ ûü#ˆÎ ýþ#ˆÎ ÿ@#ˆÎ AB#ˆÎ CD#ˆÎ EF#ˆÎ GH#ˆÎ IJ#ˆÎ KL#ˆÎ MN#ˆÎ OP#ˆÎ QR#ˆÎ ST#ˆÎ UV#ˆÎ WX#ˆÎ YZ#ˆÎ [\\#ˆÎ ]^#ˆÎ _`#ˆÎ ab#ˆÎ cd#ˆÎ ef#ˆÎ gh#ˆÎ ij#ˆÎ kl#ˆÎ mn#ˆÎ op#ˆÎ qr#ˆÎ st#ˆÎ uv#ˆÎ wx#ˆÎ yz#ˆÎ {|#ˆÎ }~#ˆÎ €#ˆÎ ‚#ˆƒÅ!ˆÎ „Å#ˆÎ ó€#ˆÎ ç‚#ˆÎ …†#ˆƒÄ!ˆÎ ‡Ä#ˆÎ\fˆ‰#ˆÎ\fŠ‹#ˆÎ\fKŒ#ˆÎ\fŽ#ˆÎ\fó#ˆÎ\f‘#ˆÎ\f’r#ˆÎ\fØ“#ˆÎ\f”•#ˆÎ\f_–#ˆÎ\f—˜#ˆÎ\f™š#ˆƒÆ!ˆÎ ›Æ#ˆÎZ#ˆÎcœ#ˆÎað#ˆÎçò#ˆÎKH#ˆÎˆJ#ˆÎó#ˆÎ„ž#ˆƒÇ!ˆÎ ŸÇ#ˆÎï #ˆÎ¡è#ˆÎaê#ˆÎR#ˆÎ¢T#ˆÎ…V#ˆÎc£#ˆÂ‡" [boundp gnus-group-mode-map nil current-load-list gnus-group-group-map gnus-group-mark-map gnus-group-list-map gnus-group-sub-map put gnus-group-mode mode-class special make-keymap suppress-keymap define-key " " gnus-group-read-group "=" gnus-group-select-group " " "j" gnus-group-jump-to-group "n" gnus-group-next-unread-group "p" gnus-group-prev-unread-group "" "N" gnus-group-next-group "P" gnus-group-prev-group "î" gnus-group-next-unread-group-same-level "ð" gnus-group-prev-unread-group-same-level "," gnus-group-best-unread-group "." gnus-group-first-unread-group "u" gnus-group-unsubscribe-current-group "U" gnus-group-unsubscribe-group "c" gnus-group-catchup-current "C" gnus-group-catchup-current-all "l" gnus-group-list-groups "L" gnus-group-list-all-groups "m" gnus-group-mail "g" gnus-group-get-new-news "ç" gnus-group-get-new-news-this-group "R" gnus-group-restart "r" gnus-group-read-init-file "B" gnus-group-browse-foreign-server "b" gnus-group-check-bogus-groups "F" gnus-find-new-newsgroups "" gnus-group-describe-group "ä" gnus-group-describe-all-groups "" gnus-group-apropos "" gnus-group-description-apropos "a" gnus-group-post-news "k" gnus-group-edit-local-kill "K" gnus-group-edit-global-kill " " gnus-group-kill-group "" gnus-group-yank-group "" gnus-group-kill-region "" gnus-group-transpose-groups "\f" gnus-group-list-killed "" gnus-group-expire-articles "˜" gnus-group-expire-all-groups "V" gnus-version "s" gnus-group-save-newsrc "z" gnus-group-suspend "Z" gnus-group-clear-dribble "q" gnus-group-exit "Q" gnus-group-quit "æ" gnus-group-fetch-faq "?" gnus-group-describe-briefly " " gnus-info-find-node "å" gnus-group-edit-group-method "^" gnus-group-enter-server-mode gnus-mouse-2 gnus-mouse-pick-group "<" beginning-of-buffer ">" end-of-buffer "" gnus-bug "" gnus-group-sort-groups "#" gnus-group-mark-group "£" gnus-group-unmark-group define-prefix-command "M" "w" gnus-group-mark-region "G" "d" gnus-group-make-directory-group "h" gnus-group-make-help-group gnus-group-make-archive-group "k" gnus-group-make-kiboze-group gnus-group-make-group "E" gnus-group-edit-group "e" gnus-group-edit-group-parameters "v" gnus-group-add-to-virtual gnus-group-make-empty-virtual "D" gnus-group-enter-directory "f" gnus-group-make-doc-group "A" gnus-group-list-zombies gnus-group-list-matching gnus-group-list-all-matching "S" gnus-group-set-current-level "t" "y" gnus-group-kill-all-zombies] 4) #@623 Major mode for reading news. All normal editing commands are switched off. \ The group buffer lists (some of) the groups available. For instance, `\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\[gnus-group-list-zombies]' lists all zombie groups. Groups that are displayed can be entered with `\[gnus-group-read-group]'. To subscribe to a group not displayed, type `\[gnus-group-unsubscribe-group]'. For more in-depth information on this mode, read the manual (`\[gnus-info-find-node]'). The following commands are available: \{gnus-group-mode-map} (defalias 'gnus-group-mode #[nil "ƒÁ ˆÂ ˆÃÅÆ!ˆÇ!È8Éšƒ&țʠˆË\fÍÏ ˆÐÒ!ˆÔp!ˆÕÕØÙ!‡" [gnus-visual gnus-group-make-menu-bar kill-all-local-variables "-- " mode-line-modified make-local-variable mode-line-format copy-sequence 3 " " "" gnus-group-mode major-mode "Group" mode-name gnus-group-set-mode-line nil mode-line-process use-local-map gnus-group-mode-map buffer-disable-undo t truncate-lines buffer-read-only run-hooks gnus-group-mode-hook] 2 (#$ . 93036) nil]) (defalias 'gnus-mouse-pick-group #[(e) "À !ˆÂÃ!‡" [mouse-set-point e gnus-group-read-group nil] 2 nil "e"]) (defalias 'gnus-group-default-level #[(&optional level number-or-nil) "ƒ † \n‰† ‡\fƒ ‡ †\n† ‡" [gnus-group-use-permanent-levels level gnus-group-default-list-level gnus-level-subscribed number-or-nil] 2]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-tmp-prev-perm nil current-load-list] 2) #@322 Read network news. If ARG is a positive number, Gnus will use that as the startup level. If ARG is nil, Gnus will be started at level 2. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use. As opposed to `gnus', this command will not connect to the local server. (defalias 'gnus-no-server #[(&optional arg) " BÃÅƆSÅ\"ˆ\n‰)‡" [gnus-group-use-permanent-levels gnus-group-default-list-level perm nil gnus-tmp-prev-perm t gnus arg gnus-level-default-subscribed] 3 (#$ . 94561) "P"]) #@212 Read network news. If ARG is non-nil and a positive number, Gnus will use that as the startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use. (defalias 'gnus #[(&optional arg dont-connect) "À !ƒ  !ˆÃ ‡Ä ˆÅ ˆƒ%@AÉÊ ˆË ˆÉ\fÍ ˆ„=Ï ˆÐÑ!ˆ)…R§…RÑV…RÉÕŽ†k×…g?!‰+‡" [get-buffer gnus-group-buffer switch-to-buffer gnus-group-get-new-news gnus-clear-system nnheader-init-server-buffer gnus-tmp-prev-perm gnus-group-use-permanent-levels gnus-group-default-list-level nil gnus-read-init-file gnus-group-setup-buffer buffer-read-only erase-buffer gnus-inhibit-startup-message gnus-group-startup-message sit-for 0 arg did-connect level ((byte-code "„ „ ˆ‚2ÃÄ!ˆÅ!ƒ É ˆÊ ˆËÌ \"ˆÎ !ˆÏÐ!ˆÌ‡" [dont-connect did-connect gnus-group-quit run-hooks gnus-startup-hook gnus-make-newsrc-file gnus-startup-file gnus-current-startup-file gnus-use-dribble-file gnus-dribble-read-file gnus-summary-make-display-table gnus-setup-news nil level gnus-group-list-groups gnus-configure-windows group] 3)) dont-connect gnus-start-news-server] 2 (#$ . 95117) "P"]) #@27 Unload all Gnus features. (defalias 'gnus-unload #[nil "ÀÁ!„\nÂÃ!ˆ ĉ…7ÇÈ@@\"ƒ-É@žA‰ƒ-Ê Ë\"ˆA‰„Ä*‡" [boundp load-history error "Sorry, `gnus-unload' is not implemented in this Emacs version." nil feature history string-match "^gnus" provide unload-feature force] 4 (#$ . 96280) nil]) #@43 Insert startup message in current buffer. (defalias 'gnus-group-startup-message #[(&optional x y) "À ˆÁ \"cˆÄedÅ †ÇZÈ]É¥#ˆebˆÊed\" Ì ‰  ZÏÈÐ¥É_]Ñ\"cˆ+ebˆÒÓ!ˆÔȔȕÕÖ$ˆeb‡" [erase-buffer format "\n _ ___ _ _ \n _ ___ __ ___ __ _ ___ \n __ _ ___ __ ___ \n _ ___ _ \n _ _ __ _ \n ___ __ _ \n __ _ \n _ _ _ \n _ _ _ \n _ _ _ \n __ ___ \n _ _ _ _ \n _ _ \n _ _ \n _ _ \n _ \n __ \n\n\n Gnus * A newsreader for Emacsen\n A Praxis release * larsi@ifi.uio.no\n" gnus-version indent-rigidly window-width x 46 0 2 count-lines pheight window-height wheight rest make-string 3 10 search-forward "Praxis" put-text-property face bold] 6 (#$ . 96588)]) #@43 Insert startup message in current buffer. (defalias 'gnus-group-startup-message-old #[(&optional x y) "À ˆÁ \"cˆÄedÅ †ÇZÈ]É¥#ˆebˆÊËÌ  †(ÎZÈ]É¥\"ˆebˆÏÐ!ˆÑȔȕÒÓ$ˆeb‡" [erase-buffer format "\n %s\n A newsreader \n for GNU Emacs\n\n Based on GNUS \n written by \n Masanobu UMEDA\n\n A Praxis Release\n larsi@ifi.uio.no\n" gnus-version indent-rigidly window-width x 28 0 2 insert-char 10 window-height y 12 search-forward "Praxis" put-text-property face bold] 5 (#$ . 97784)]) (defalias 'gnus-group-setup-buffer #[nil "À !† !ˆÃ ˆÄ ˆ …ÆÇ!‡" [get-buffer gnus-group-buffer switch-to-buffer gnus-add-current-to-buffer-list gnus-group-mode gnus-carpal gnus-carpal-setup-buffer group] 2]) #@183 List newsgroups with level LEVEL or lower that have unread articles. Default is all subscribed groups. If argument UNREAD is non-nil, groups with no unread articles are also listed. (defalias 'gnus-group-list-groups #[(&optional level unread) "„\n @ AÃ!Ä ˆÅÆ  \nÅ#ˆÊ ËUƒ.ÌÍ\"‚”ebˆ„@Ïʼn‰Ð$ˆ‚’ÑedÒÓ!$‰…Rb)„’ÕÖ\"J›‰ƒ†ÑedÒÓ@@!$‰…yb)„†A‰„e„‘dbˆÙyˆ)Ú *‡" [level gnus-group-list-mode unread gnus-group-default-level gnus-group-setup-buffer nil gnus-group-group-name group case-fold-search gnus-group-prepare-function buffer-size 0 gnus-message 5 gnus-no-groups-message gnus-group-search-forward t text-property-any gnus-group intern point 3 intern-soft gnus-newsrc-hashtb newsrc -1 gnus-group-position-cursor] 7 (#$ . 98535) (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) (or (gnus-group-default-level nil t) gnus-group-default-list-level gnus-level-subscribed)))]) #@242 List all newsgroups with unread articles of level LEVEL or lower. If ALL is non-nil, list groups that have no unread articles. If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. If REGEXP, only list groups matching REGEXP. (defalias 'gnus-group-prepare-flat #[(level &optional all lowest regexp) "qˆÁ\nA † ÄÁ‰‰‰ \nË ˆ \fWƒ™ ƒ™ @‰@ A Í \"J@‰ƒ%ƒQÐ \"ƒ%A@‰Xƒ% Yƒ%„‚Ó=„‚ÔV„‚ÕÖ8žAƒ%×Á A@Ö8Ø8&ˆ‚%\fYƒ¸ \fXƒ¸ÙÚÜ\"‰\fÝ$ˆYƒ× Xƒ×ÙÚÜ\"‰à$ˆá ˆB\"ãä!.‡" [gnus-group-buffer nil gnus-newsrc-alist lowest 1 group unread clevel info newsrc buffer-read-only erase-buffer gnus-level-zombie intern-soft gnus-newsrc-hashtb regexp string-match level all t 0 tick 3 gnus-group-insert-group-line 4 gnus-group-prepare-flat-list-dead sort gnus-zombie-list string< 90 gnus-level-killed gnus-killed-list 75 gnus-group-set-mode-line gnus-group-list-mode run-hooks gnus-group-prepare-hook] 9 (#$ . 99476)]) (defalias 'gnus-group-prepare-flat-list-dead #[(groups level mark regexp) "À‰ …7 @ A\fƒÅ\f\n\"ƒ`ÆÇ\n#cˆÉ ‰TÊË\n!ÌÍί#ˆ‚*‡" [nil beg group groups regexp string-match format " %c *: %s\n" mark add-text-properties gnus-group intern gnus-unread t gnus-level level] 9]) #@44 Find the real name of a foreign newsgroup. (defalias 'gnus-group-real-name #[(group) "ÀÁ\n\"ƒ\nÔTÄO‡\n‡" [string-match ":[^:]+$" group 0 nil] 3 (#$ . 100763)]) #@46 Return the whole name from GROUP and METHOD. (defalias 'gnus-group-prefixed-name #[(group method) ";ƒ Á!ÂÃ@\"ÄÂÃ@\"ÅÆ!\"…)A@ǘ?…)ÈA@PÉ\nR‡" [method gnus-server-to-method format "%s" assoc gnus-methods-using address "" "+" ":" group] 5 (#$ . 100932)]) #@46 Return the prefix of the current group name. (defalias 'gnus-group-real-prefix #[(group) "ÀÁ\n\"ƒ \nÉ•O‡Ä‡" [string-match "^[^:]+:" group 0 ""] 3 (#$ . 101200)]) #@45 Return the method used for selecting GROUP. (defalias 'gnus-group-method-name #[(group) "À !‰Úƒ\f‚2ÅÆ\n\"ƒ(Ç\nȉ•SO!\nÈ•\nGSOD‚2Ç\nÈ\nGSO!ÃD)‡" [gnus-group-real-prefix group prefix "" gnus-select-method string-match "^[^\\+]+\\+" intern 0] 5 (#$ . 101370)]) #@58 Return nil if GROUP is native, non-nil if it is foreign. (defalias 'gnus-group-foreign-p #[(group) "ÀÁ\n\"‡" [string-match ":" group] 3 (#$ . 101641)]) (defalias 'gnus-group-set-info #[(info &optional method-only-group part) "À †\n@ \"J\n ƒÆ\f8‚\n ƒW\f„&ÇÈ \"ˆ\nG Ê=ƒ3Ë‚4Ì ‰ WƒNS\n›Ï ZÐ\"¡ˆ S\n›  ˆ*ÐÒ\n8‰ƒ—ƒ—@@Ó=„Ž@@Ô=„Ž@@Õ=„Ž@Ö@A!¡ˆA‰„h)\f„ÚŠqˆØ\n8ƒ¼ÙÚ\n@!ÛØ\n8@!Ø\n8A@#ˆ‚ÁÙ\n@!ˆÜÌÝ\"ˆÀÞÚ\n@!Ø\n8†Ô\" \"J)\fƒ\fAA\n ˆ\f@à=?…À\n@!\"J…Ò\n8\fâã\n@!GäžAGZåžAGZ] )‚Çæ\n@\"+‡" [intern-soft method-only-group info gnus-newsrc-hashtb entry part-info 2 error "Trying to change non-existent group %s" part method 5 6 total len make-list nil marked 3 score bookmark killed gnus-uncompress-range gnus-group-buffer 4 gnus-group-make-group gnus-group-real-name prin1-to-string gnus-message "Note: New group created" gnus-group-prefixed-name gnus-select-method t gnus-active-hashtb 0 gnus-list-of-unread-articles tick dormant "No such group: %s"] 6]) (defalias 'gnus-group-set-method-info #[(group select-method) "À \nÃ#‡" [gnus-group-set-info select-method group method] 4]) (defalias 'gnus-group-set-params-info #[(group params) "À \nÁ#‡" [gnus-group-set-info params group] 4]) #@98 This function updates the current line in the newsgroup buffer and moves the point to the colon. (defalias 'gnus-group-update-group-line #[nil "À ‰…Ä \"J‰ƒ&Ç !„&ÈÉÊË8!ÌQ!ˆÍyˆ`Îyˆ`|ˆÏ !ˆÐyˆÑ +‡" [nil buffer-read-only gnus-group-group-name group intern-soft gnus-newsrc-hashtb entry gnus-ephemeral-group-p gnus-dribble-enter "(gnus-group-set-info '" prin1-to-string 2 ")" 0 1 gnus-group-insert-group-line-info -1 gnus-group-position-cursor] 6 (#$ . 102888)]) (defalias 'gnus-group-insert-group-line-info #[(group) "À \n\"Jɉƒ(Ç8Èà \fA@É\f8@Ê\f8&‚RÀ  \"JÈà ‰\fƒ> ‚@à ƒN AT @Z‚OÏÃ&+‡" [intern-soft group gnus-newsrc-hashtb nil info active entry 2 gnus-group-insert-group-line 3 4 gnus-active-hashtb gnus-zombie-list gnus-level-zombie gnus-level-killed 0] 9]) (defalias 'gnus-group-insert-group-line #[(gformat group level marked number method) "†  \f\"J‰ƒ A @ZT‚ÆÈ žAG\nË žAG‰\f\n\\ §ƒAÏÆ]!‚BЧƒTÆZ]‚UÐXƒcÕ‚|Xƒoׂ|Uƒ{Ù‚|ÚÜ !ƒ•Â \"J†–ß‚–ß !ƒ£â‚¤Õ‰#â=ƒ°ä‚±ß%æ '\"‰'A@†Áß('@†Êß)'ƒÞêë'@'A@#‚ßß,§ƒùÆUƒù\fÆVƒùí‚úÕ î=ƒЂ\n\\\f\\ /ƒ0‚Õ1ò3ò4ò5Æyˆ`5ö!cˆ÷5‰Tøù !ú§ƒKû!‚Lîü ý¯#.‡" [gformat gnus-group-line-format-spec intern-soft group gnus-active-hashtb active 0 number-total dormant marked number-of-dormant tick number-of-ticked number-of-ticked-and-dormant number int-to-string "*" number-of-unread-unticked number-of-read level gnus-level-subscribed 32 gnus-level-unsubscribed 85 gnus-level-zombie 90 75 subscribed gnus-group-real-name qualified-group gnus-description-hashtb "" newsgroup-description gnus-moderated-list 109 moderated "(m)" moderated-string gnus-server-get-method method news-server news-method format "(%s:%s)" news-method-string 42 t gnus-group-marked gnus-process-mark process-marked nil buffer-read-only header b eval add-text-properties gnus-group intern gnus-unread string-to-int gnus-marked gnus-level] 12]) #@111 Update newsgroup info of GROUP. If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already. (defalias 'gnus-group-update-group #[(group &optional visible-only) "ŠqˆÁ‰Ä \"J‰ƒ&È !„&ÉÊËÌ8!ÍQ!ˆ)Œ~ˆÎyˆÏ`Ð\"Ñ !=„MÒedÐÑ !$‰…Ib)ƒ\\ÔÎyˆ`Õyˆ`|ˆ‚Ÿ„ŸÄ \"JAA‰ƒ–@ƒ–ÒedÐÑ@@!$‰…‰b)„–A‰„o„ždbˆ))\n„©„­× !ˆØ +‡" [gnus-group-buffer nil visible buffer-read-only intern-soft group gnus-newsrc-hashtb entry gnus-ephemeral-group-p gnus-dribble-enter "(gnus-group-set-info '" prin1-to-string 2 ")" 0 get-text-property gnus-group intern text-property-any point t 1 visible-only gnus-group-insert-group-line-info gnus-group-set-mode-line] 7 (#$ . 104888)]) (defalias 'gnus-group-set-mode-line #[nil "À >…F\n†Ã\f \"‰A@@ Ê Ì! Ì!‰ G Vƒ> Î ÏZO  ÑÒ!-‡" [group gnus-updated-mode-lines gnus-group-mode-line-format-spec gnus-parse-format gnus-group-mode-line-format gnus-group-mode-line-format-alist gformat gnus-select-method news-server news-method 60 max-len eval mode-string 0 4 mode-line-buffer-identification set-buffer-modified-p t] 5]) #@52 Get the name of the newsgroup on the current line. (defalias 'gnus-group-group-name #[nil "À`Âyˆ` bˆ)Ã\"‰…Å\f!)‡" [get-text-property p 0 gnus-group group symbol-name] 4 (#$ . 106001)]) #@53 Get the level of the newsgroup on the current line. (defalias 'gnus-group-group-level #[nil "À`Âyˆ` bˆ)Ã\"‡" [get-text-property p 0 gnus-level] 3 (#$ . 106196)]) #@73 Get the number of unread articles of the newsgroup on the current line. (defalias 'gnus-group-group-unread #[nil "À`Âyˆ` bˆ)Ã\"‡" [get-text-property p 0 gnus-unread] 3 (#$ . 106365)]) #@298 Find the next newsgroup with unread articles. If BACKWARD is non-nil, find the previous newsgroup instead. If ALL is non-nil, just find any newsgroup. If LEVEL is non-nil, find group with level LEVEL, or higher if no such group exists. If FIRST-TOO, the current line is also eligible as a target. (defalias 'gnus-group-search-forward #[(&optional backward all level first-too) "ƒÁ‚  `ĉ‰ \nƒ Ëyˆ\f„)\nyˆm„” „[Î`Ï\"‰Ñ=†G…GËV)…†Î`Ò\"‰…† X…†?††Î`Ò\"‰…† U††  W…† W…†  `ĉ„”\nyËU„)ƒ Õ ˆÑ‚¯†§bˆ…¯Ñ.‡" [backward -1 1 gnus-level-killed nil lev found pos beg low way 0 first-too all get-text-property gnus-unread unread t gnus-level gnus-level-subscribed level gnus-group-position-cursor] 7 (#$ . 106557)]) #@25 Mark the current group. (defalias 'gnus-group-mark-group #[(n &optional unmark no-advance) "À‰ ÄVƒUÅ ‰ƒUÄyˆÆžA†ÈuˆÉÊ!ˆ ƒ5ÌcˆÍ \"‚AÏcˆ Í \"B„NÑÊ!ÄUƒU S‰‚Ò ˆ *‡" [nil group buffer-read-only n 0 gnus-group-group-name process gnus-group-mark-positions 2 delete-char 1 unmark " " delete gnus-group-marked "#" no-advance gnus-group-next-group gnus-summary-position-cursor] 5 (#$ . 107331) "p"]) #@41 Remove the mark from the current group. (defalias 'gnus-group-unmark-group #[(n) "À Â\"‡" [gnus-group-mark-group n unmark] 3 (#$ . 107753) "p"]) #@77 Mark all groups between point and mark. If UNMARK, remove the mark instead. (defalias 'gnus-group-mark-region #[(unmark beg end) "À \n\"Š bˆ Ä \"Z*‡" [count-lines beg end num gnus-group-mark-group unmark] 4 (#$ . 107904) "P\nr"]) (defalias 'gnus-group-remove-mark #[(group) "À !… ŠÂÃÄÅ#)‡" [gnus-group-goto-group group gnus-group-mark-group 1 unmark t] 4]) (defalias 'gnus-group-process-prefix #[(n) "ƒEÁ!‰ÂWƒÂÄÅ!Ɖ ŠÂVƒ?Ê ‰ƒ?BS yˆ‚ )Ÿ,‡ ƒOÌ !‡Ê ‰…ZC)‡" [n prefix-numeric-value 0 -1 1 abs nil groups group way gnus-group-group-name gnus-group-marked reverse] 5]) #@207 Read news in this newsgroup. If the prefix argument ALL is non-nil, already read articles become readable. If the optional argument NO-ARTICLE is non-nil, no article will be auto-selected upon group entry. (defalias 'gnus-group-read-group #[(&optional all no-article group) "†Á ‰‰‰‰„ÇÈ!ˆÉÊË\f\"J‰88 ƒ0 @‚CË \"J‰ƒC AT @ZΆ`§…`Ð\fžAG\\Ñ\fžAG\\ÒU#-‡" [group gnus-group-group-name nil entry marked active number error "No group on current line" 3 2 intern-soft gnus-newsrc-hashtb gnus-active-hashtb gnus-summary-read-group all tick dormant 0 no-article] 6 (#$ . 108518) "P"]) #@129 Select this newsgroup. No article is selected automatically. If argument ALL is non-nil, already read articles become readable. (defalias 'gnus-group-select-group #[(&optional all) "À Â\"‡" [gnus-group-read-group all t] 3 (#$ . 109134) "P"]) #@58 Select the current group and display all articles in it. (defalias 'gnus-group-select-group-all #[nil "ÀÁ!‡" [gnus-group-select-group all] 2 (#$ . 109382) nil]) (defalias 'gnus-group-read-ephemeral-group #[(group method &optional activate quit-config) "À !ƒ\n ‚ \"Ä \"ÆÇ Ç‰É Ê\nƒ'\n‚*pËBDC\"¯ELˆ\fqˆÍ !„CÎÏÐ !\"ˆƒRÒ !„RÎÓ!ˆÇÔÕˆ)ך?‡" [gnus-group-foreign-p group gnus-group-prefixed-name method intern gnus-newsrc-hashtb t nil gnus-level-default-subscribed append quit-config summary gnus-group-buffer gnus-check-server error "Unable to contact server: %s" gnus-status-message activate gnus-request-group "Couldn't request group" (byte-code "ÀÁ‰\n#‡" [gnus-group-read-group t group] 4) ((error) (quit)) major-mode gnus-group-mode] 12]) #@26 Jump to newsgroup GROUP. (defalias 'gnus-group-jump-to-group #[(group) "Ášƒ\nÂÃ!ˆÄedÅÆ!$‰ƒbˆ‚DÈ \"J„6Ê!„6ÂËÌ!#ˆÍ!ˆÄedÅÆ!$bˆ)Î ‡" [group "" error "Empty group name" text-property-any gnus-group intern b intern-soft gnus-active-hashtb gnus-activate-group "%s error: %s" gnus-status-message gnus-group-update-group gnus-group-position-cursor] 7 (#$ . 110146) (list (completing-read "Group: " gnus-active-hashtb nil (memq gnus-select-method gnus-have-read-active-file)))]) #@26 Goto to newsgroup GROUP. (defalias 'gnus-group-goto-group #[(group) "ÀedÁ !$‰…\fb)‡" [text-property-any gnus-group intern group b] 7 (#$ . 110640)]) #@143 Go to next N'th newsgroup. If N is negative, search backward instead. Returns the difference between N and the number of skips actually done. (defalias 'gnus-group-next-group #[(n) "À Â\"‡" [gnus-group-next-unread-group n t] 3 (#$ . 110800) "p"]) #@349 Go to next N'th unread newsgroup. If N is negative, search backward instead. If ALL is non-nil, choose any newsgroup, unread or not. If LEVEL is non-nil, choose the next group with level LEVEL, or, if no such group can be found, the next group with a level higher than LEVEL. Returns the difference between N and the number of skips actually made. (defalias 'gnus-group-next-unread-group #[(n &optional all level) "ÁWÂ!ÁVƒ$Ä ?†#ƒ$S‰‚ ÁU„CÈÉʃ6Ë‚7̃@Í‚AË$ˆ*‡" [n 0 abs backward gnus-group-search-forward gnus-group-goto-unread all level gnus-message 7 "No more%s newsgroups%s" "" " unread" " on this level or higher"] 6 (#$ . 111054) "p"]) #@104 Go to previous N'th newsgroup. Returns the difference between N and the number of skips actually done. (defalias 'gnus-group-prev-group #[(n) "À [Â\"‡" [gnus-group-next-unread-group n t] 3 (#$ . 111728) "p"]) #@111 Go to previous N'th unread newsgroup. Returns the difference between N and the number of skips actually done. (defalias 'gnus-group-prev-unread-group #[(n) "À [!‡" [gnus-group-next-unread-group n] 2 (#$ . 111944) "p"]) #@168 Go to next N'th unread newsgroup on the same level. If N is negative, search backward instead. Returns the difference between N and the number of skips actually done. (defalias 'gnus-group-next-unread-group-same-level #[(n) "À Âà #ˆÄ ‡" [gnus-group-next-unread-group n t gnus-group-group-level gnus-group-position-cursor] 4 (#$ . 112170) "p"]) #@125 Go to next N'th unread newsgroup on the same level. Returns the difference between N and the number of skips actually done. (defalias 'gnus-group-prev-unread-group-same-level #[(n) "À [Âà #ˆÄ ‡" [gnus-group-next-unread-group n t gnus-group-group-level gnus-group-position-cursor] 4 (#$ . 112521) "p"]) #@84 Go to the group with the highest level. If EXCLUDE-GROUP, do not go to that group. (defalias 'gnus-group-best-unread-group #[(&optional exclude-group) "ebˆÀÁ‰Å`Æ\"‰ƒ@ §ƒ: ÇVƒ:Å`È\"\fWƒ: ƒ3 Ê š„:Å`È\"`Ëyˆ‚ \nƒG\nbˆÌ ˆ\n…PÊ +‡" [100000 nil best-point unread best get-text-property gnus-unread 0 gnus-level exclude-group gnus-group-group-name 1 gnus-summary-position-cursor] 3 (#$ . 112829) nil]) #@45 Go to the first group with unread articles. (defalias 'gnus-group-first-unread-group #[nil "`ÀebˆÃ ‰Ä=„ ÅUƒÆÇ!ÅUƒ\"`‚&\nbˆÀ*È ˆ‡" [nil unread opoint gnus-group-group-unread t 0 gnus-group-next-unread-group 1 gnus-group-position-cursor] 2 (#$ . 113246) nil]) #@28 Jump to the server buffer. (defalias 'gnus-group-enter-server-mode #[nil "À ˆÁÂ!ˆÃ ‡" [gnus-server-setup-buffer gnus-configure-windows server gnus-server-prepare] 2 (#$ . 113519) nil]) #@97 Add a new newsgroup. The user will be prompted for a NAME, for a select METHOD, and an ADDRESS. (defalias 'gnus-group-make-group #[(name &optional method address) "… ƒÂ! D‚ƒÄ \"‚ ÇÉ\n\"Jƒ3ËÌ\"ˆÍÎlj ¯‰Ñ …QÉÑ \n\"JÎ%ˆÂ\"ÓÔBLˆÕ !„pÖ×ØA!ÙQ!ˆÚ!ˆÛ\"ƒƒÝÂ!!ˆÞß\"…à!+‡" [method address intern meth gnus-group-prefixed-name name nname nil info intern-soft gnus-newsrc-hashtb error "Group %s already exists" gnus-group-change-level t gnus-level-default-subscribed gnus-level-killed gnus-group-group-name gnus-active-hashtb 1 0 gnus-ephemeral-group-p gnus-dribble-enter "(gnus-group-set-info '" prin1-to-string ")" gnus-group-insert-group-line-info assoc gnus-valid-select-methods require gnus-check-backend-function request-create-group gnus-request-create-group] 7 (#$ . 113710) (byte-code "ÀÁ!ÂÃÄ \"ÇÈ$ Ê \"ƒ. ËÊ \">ƒ)ÀÌ!‚*ÍD‚2 ÇD)B‡" [read-string "Group name: " completing-read "Method: " append gnus-valid-select-methods gnus-server-alist nil t method assoc prompt-address "Address: " ""] 6)]) #@37 Edit the group on the current line. (defalias 'gnus-group-edit-group #[(group &optional part) "À †Âà Ä„ÈÉ!ˆÊË\f\"J8‰„)ÈÍ!ˆÎ!qˆÐÑ!ˆÒ ˆÓ ˆÔÕ!!ˆ×Ø\"ˆÙÚ!ˆ Û8AÜ D ˆÛ8AA ˆÝ ˆ Þ=ƒnß‚ à=ƒxá‚ Â=…âcˆã\n!Ä$%æ%8‰$ƒÔ$ƒÔ$@@ç=„Ë$@@è=„Ë$@@é=„Ë$@A@§ƒË$@êë$@Aì\"í\"¡ˆ$A‰$„˜î Þ=ƒåÛ\n8†óï‚ó à=ƒñð\n8‚ó%!ñ±.‡" [(lambda nil "Exit editing mode and update the information." (interactive) (gnus-group-edit-group-done (quote part) (quote group))) part info current-window-configuration nil winconf done-func group error "No group on current line" 2 intern-soft gnus-newsrc-hashtb "Killed group; can't be edited" get-buffer-create gnus-group-edit-buffer gnus-configure-windows edit-group gnus-add-current-to-buffer-list emacs-lisp-mode use-local-map copy-keymap emacs-lisp-mode-map local-set-key "" make-local-variable gnus-prev-winconf 4 quote erase-buffer method ";; Type `C-c C-c' after editing the select method.\n\n" params ";; Type `C-c C-c' after editing the group parameters.\n\n" ";; Type `C-c C-c' after editing the group info.\n\n" gnus-copy-sequence marked cinfo 3 score bookmark killed gnus-compress-sequence sort < t pp-to-string "native" 5 "\n"] 6 (#$ . 114775) (list (gnus-group-group-name))]) #@34 Edit the select method of GROUP. (defalias 'gnus-group-edit-group-method #[(group) "À Â\"‡" [gnus-group-edit-group group method] 3 (#$ . 116032) (list (gnus-group-group-name))]) #@37 Edit the group parameters of GROUP. (defalias 'gnus-group-edit-group-parameters #[(group) "À Â\"‡" [gnus-group-edit-group group params] 3 (#$ . 116216) (list (gnus-group-group-name))]) #@70 Get info from buffer, update variables and jump to the group buffer. (defalias 'gnus-group-edit-group-done #[(part group) "À !qˆebˆÂp! Ç=ƒÈ !ˆ‚$È  #ˆÊp!ˆ\fƒ0Ë\f!ˆ\fqˆÍÎ !ˆÏ *‡" [get-buffer-create gnus-group-edit-buffer read gnus-prev-winconf winconf form part info gnus-group-set-info group kill-buffer set-window-configuration gnus-group-buffer gnus-group-update-group gnus-group-group-name gnus-group-position-cursor] 4 (#$ . 116407)]) #@38 Create the Gnus documentation group. (defalias 'gnus-group-make-help-group #[nil "ÁP\nBÃÄÅ\"Æ Ê \"JƒÌÍ!ˆ ƒ;ÎÏ @!ÐP‰!„; A‰ „# „GÑÒ!ˆ‚YÓÔ!ÕÖD×ØDF\"ˆ+Ù ‡" [installation-directory "etc/" load-path gnus-group-prefixed-name "gnus-help" (nndoc "gnus-help") nil file name path intern-soft gnus-newsrc-hashtb error "Documentation group already exists" file-exists-p file-name-as-directory "gnus-tut.txt" message "Couldn't find doc group" gnus-group-make-group gnus-group-real-name nndoc nndoc-address nndoc-article-type mbox gnus-group-position-cursor] 8 (#$ . 116863) nil]) #@55 Create a group that uses a single file as the source. (defalias 'gnus-group-make-doc-group #[(file type) "À !ÂÃÄ !Å\"!ÇÈ!ÉÊ DË\fDF\"*‡" [expand-file-name file gnus-generate-new-group-name gnus-group-prefixed-name file-name-nondirectory (nndoc "") name gnus-group-make-group gnus-group-real-name nndoc nndoc-address nndoc-article-type type] 7 (#$ . 117464) (list (read-file-name "File name: ") (let ((err "") found char) (while (not found) (message "%sFile type (mbox, babyl, digest) [mbd]: " err) (setq found (cond ((= (setq char (read-char)) 109) (quote mbox)) ((= char 98) (quote babyl)) ((= char 100) (quote digest)) (t (setq err (format "%c unknown. " char)) nil)))) found))]) #@104 Create the (ding) Gnus archive group of the most recent articles. Given a prefix, create a full group. (defalias 'gnus-group-make-archive-group #[(&optional all) "À ƒ ‚\nÃÄ\"Æ \"JƒÈÉ!ˆÊË !Ì ƒ( ‚*#ˆ)Ï ‡" [gnus-group-prefixed-name all "ding.archives" "ding.recent" (nndir "") group intern-soft gnus-newsrc-hashtb error "Archive group already exists" gnus-group-make-group gnus-group-real-name "nndir" gnus-group-archive-directory gnus-group-recent-archive-directory gnus-group-position-cursor] 4 (#$ . 118160) "P"]) #@221 Create an nndir group. The user will be prompted for a directory. The contents of this directory will be used as a newsgroup. The directory should contain mail messages or news articles in files that have numeric names. (defalias 'gnus-group-make-directory-group #[(dir) "À !„\nÂÃ!ˆÄ !„ÂÅ!ˆÆ Ç #ˆÈ ‡" [file-exists-p dir error "No such directory" file-directory-p "Not a directory" gnus-group-make-group "nndir" gnus-group-position-cursor] 4 (#$ . 118694) (list (read-file-name "Create group from directory: "))]) #@152 Create an nnkiboze group. The user will be prompted for a name, a regexp to match groups, and score file entries for articles to include in the group. (defalias 'gnus-group-make-kiboze-group #[(group address scores) "À  #ˆŠÄ ˆÅÇp\"ˆ)Éed\n†ËÌ Í°#ˆ)Ï ‡" [gnus-group-make-group group "nnkiboze" address gnus-set-work-buffer nil emacs-lisp-mode-hook pp scores write-region gnus-kill-files-directory "~/News" "nnkiboze:" "." gnus-score-file-suffix gnus-group-position-cursor] 8 (#$ . 119217) (list (read-string "nnkiboze group name: ") (read-string "Source groups (regexp): ") (let ((headers (mapcar (lambda (group) (list group)) (quote ("subject" "from" "number" "date" "message-id" "references" "chars" "lines" "xref")))) scores header regexp regexps) (while (not (equal "" (setq header (completing-read "Match on header: " headers nil t)))) (setq regexps nil) (while (not (equal "" (setq regexp (read-string (format "Match on %s (string): " header))))) (setq regexps (cons (list regexp nil nil (quote r)) regexps))) (setq scores (cons (cons header regexps) scores))) scores))]) #@43 Add the current group to a virtual group. (defalias 'gnus-group-add-to-virtual #[(n vgroup) "À !@Â=„ÃÄ \"ˆÅ!ÈÉÊ  \"J88‰\fA\fA@ÍÎÏÍ#Q ˆ*Ð ‡" [gnus-find-method-for-group vgroup nnvirtual error "%s is not an nnvirtual group" gnus-group-process-prefix n groups 4 2 intern-soft gnus-newsrc-hashtb method "\\|" mapconcat #[(s) "À !ˆÂà !ÄQ‡" [gnus-group-remove-mark s "\\(^" regexp-quote "$\\)"] 3] gnus-group-position-cursor] 8 (#$ . 120310) (list current-prefix-arg (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t "nnvirtual:"))]) #@43 Create a new, fresh, empty virtual group. (defalias 'gnus-group-make-empty-virtual #[(group) "ÀÁDÃ\f\n\"Æ \"JƒÈÉ \"ˆÊ Ë \n#ˆÌ !ˆÍyˆÎ *‡" [nnvirtual "^$" method gnus-group-prefixed-name group pgroup intern-soft gnus-newsrc-hashtb error "Group %s already exists." gnus-subscribe-group gnus-group-group-name gnus-group-update-group -1 gnus-group-position-cursor] 4 (#$ . 120872) "sCreate new, empty virtual group: "]) #@37 Enter an ephemeral nneething group. (defalias 'gnus-group-enter-directory #[(dir) "À DÃÄÅ !!\n\"Ç!É\nË\nÉp\fÍ=ƒ(΂)ÏB$†2ÐÑ \",‡" [nneething dir method gnus-group-prefixed-name file-name-nondirectory directory-file-name leaf gnus-generate-new-group-name name t nneething-read-only gnus-group-read-ephemeral-group major-mode gnus-summary-mode summary group error "Couldn't enter %s"] 7 (#$ . 121299) "DDirectory to read: "]) #@57 Sort the group buffer using `gnus-group-sort-function'. (defalias 'gnus-group-sort-groups #[nil "À A\n\"à ˆÄ ‡" [sort gnus-newsrc-alist gnus-group-sort-function gnus-make-hashtable-from-newsrc-alist gnus-group-list-groups] 3 (#$ . 121742) nil]) (defalias 'gnus-group-sort-by-alphabet #[(info1 info2) "@ @™‡" [info1 info2] 2]) (defalias 'gnus-group-sort-by-unread #[(info1 info2) "À @\n\"J@À @\n\"J@‰§ƒ †Æ\f§ƒ#\f†$ÆW*‡" [intern-soft info1 gnus-newsrc-hashtb info2 n2 n1 0] 5]) (defalias 'gnus-group-sort-by-level #[(info1 info2) "A@ A@W‡" [info1 info2] 2]) #@357 Mark all articles not marked as unread in current newsgroup as read. If prefix argument N is numeric, the ARG next newsgroups will be caught up. If ALL is non-nil, marked articles will also be marked as read. Cross references (Xref: header) of articles are ignored. The difference between N and actual number of newsgroups that were caught up is returned. (defalias 'gnus-group-catchup-current #[(&optional n all) "ƒ „ ƒÄ‚Å!„‡Ç!È ‰\nƒkË\n@!‰\f@Í=ƒAÎÏ\n@!\fA@ #ˆ)Ð\n@!ˆÑ\n@!Ò\n@ \"ˆƒ]Ó ˆ‚b T \nA‰\n„&ÔÕ!ˆ *‡" [gnus-interactive-catchup gnus-expert-user gnus-y-or-n-p all "Do you really want to mark all articles as read? " "Mark all unread articles as read? " n gnus-group-process-prefix 0 ret groups gnus-find-method-for-group method nnvirtual nnvirtual-catchup-group gnus-group-real-name gnus-group-remove-mark gnus-group-goto-group gnus-group-catchup gnus-group-update-group-line gnus-group-next-unread-group 1] 5 (#$ . 122316) "P"]) #@106 Mark all articles in current newsgroup as read. Cross references (Xref: header) of articles are ignored. (defalias 'gnus-group-catchup-current-all #[(&optional n) "À Â\"‡" [gnus-group-catchup-current n all] 3 (#$ . 123293) "P"]) #@194 Mark all articles in GROUP as read. If ALL is non-nil, all articles are marked as read. The return value is the number of articles that were marked as read, or nil if no action could be taken. (defalias 'gnus-group-catchup #[(group &optional all) "À \n\"J‰@ÅÆ 88 @§„ÈÉÊ\"ˆ‚f ƒfË \f?…6ÍΞAÏžA\"Ð\f?…BΞA$ˆ\fƒfÅÆ 88‰ƒfÅÆ 8›ÑÏžÅÆ 88\" ˆ\f+‡" [intern-soft group gnus-newsrc-hashtb entry num 3 2 marked gnus-message 1 "Can't catch up; non-active group" gnus-update-read-articles all append tick dormant nil delq] 7 (#$ . 123529)]) #@57 Expire all expirable articles in the current newsgroup. (defalias 'gnus-group-expire-articles #[(&optional n) "À !‰„ÅÆ!ˆ\f…X\f@\fAÇ !ˆÈÉ \"ƒÊË \f\"J8 ÎÏ 8>ƒ>ÂÐ !B‚DÑÒ 8ž‰ƒTÔA \"¡ˆ*‚*‡" [gnus-group-process-prefix n nil group groups error "No groups to expire" gnus-group-remove-mark gnus-check-backend-function request-expire-articles 2 intern-soft gnus-newsrc-hashtb info total-expire 5 gnus-list-of-read-articles expire 3 expirable gnus-request-expire-articles] 5 (#$ . 124086) "P"]) #@50 Expire all expirable articles in all newsgroups. (defalias 'gnus-group-expire-all-groups #[nil "ŠÀÁÂ\"ˆÃÄ A\"ÇÈ!ˆ*É ˆÀÁÊ\"‡" [gnus-message 5 "Expiring..." mapcar #[(info) "@‡" [info] 1] gnus-newsrc-alist gnus-group-marked gnus-group-expire-articles nil gnus-group-position-cursor "Expiring...done"] 3 (#$ . 124602) nil]) #@46 Set the level of the next N groups to LEVEL. (defalias 'gnus-group-set-current-level #[(n level) "ÁYƒ\f\nX„ÃÄ\"ˆÅ!Ç  ƒF @ A Ê!ˆËÌÍÎ %ˆÏÎ #ˆÐ ˆ‚*Ñ ‡" [level 1 gnus-level-killed error "Illegal level: %d" gnus-group-process-prefix n nil group groups gnus-group-remove-mark gnus-message 6 "Changed level of %s from %d to %d" gnus-group-group-level gnus-group-change-level gnus-group-update-group-line gnus-group-position-cursor] 6 (#$ . 124932) "P\nnLevel: "]) #@96 Toggle subscription of the current group. If given numerical prefix, toggle the N next groups. (defalias 'gnus-group-unsubscribe-current-group #[(&optional n) "À !Â\fƒ-\f@\fAÅ !ˆÆ Ç Xƒ# ‚%\n\"ˆË ˆ‚ÌÍ!*‡" [gnus-group-process-prefix n nil group groups gnus-group-remove-mark gnus-group-unsubscribe-group gnus-group-group-level gnus-level-subscribed gnus-level-default-unsubscribed gnus-level-default-subscribed gnus-group-update-group-line gnus-group-next-group 1] 4 (#$ . 125423) "P"]) #@94 Toggle subscribe from/to unsubscribe GROUP. New newsgroup is added to .newsrc automatically. (defalias 'gnus-group-unsubscribe-group #[(group &optional level) "À \n\"JÄÅ \"ƒÆÇ!ˆ‚‹ ƒ@È  ƒ$ ‚7Ê 8A@ Xƒ5 T‚7\f\"ˆÍ !ˆ‚‹ ;ƒ†>ƒVÀ \"Jƒ†È  ƒb ‚d\f ƒp†rÔ …}ÀÔ \n\"J$ˆÍ !ˆ‚‹ÆÕ \"ˆÖ )‡" [intern-soft group gnus-newsrc-hashtb newsrc string-match "^[ ]$" error "Empty group name" gnus-group-change-level level 2 gnus-level-subscribed gnus-level-default-subscribed gnus-group-update-group gnus-select-method gnus-have-read-active-file gnus-active-hashtb gnus-zombie-list gnus-level-zombie gnus-level-killed gnus-group-group-name "No such newsgroup: %s" gnus-group-position-cursor] 7 (#$ . 125927) (list (completing-read "Group: " gnus-active-hashtb nil (memq gnus-select-method gnus-have-read-active-file)))]) #@156 Move the current newsgroup up N places. If given a negative prefix, move down instead. The difference between N and the number of steps taken is returned. (defalias 'gnus-group-transpose-groups #[(n) "À „ ÁÂ!ˆÃÄ!ˆ [yÆ ˆÇ ˆ‡" [gnus-group-group-name error "No group on current line" gnus-group-kill-group 1 n gnus-group-yank-group gnus-group-position-cursor] 2 (#$ . 126770) "p"]) #@29 Kill all zombie newsgroups. (defalias 'gnus-group-kill-all-zombies #[nil " ¤Âà ‡" [gnus-zombie-list gnus-killed-list nil gnus-group-list-groups] 2 (#$ . 127156) nil]) #@133 Kill newsgroups in current region (excluding current point). The killed newsgroups can be yanked by using \[gnus-group-yank-group]. (defalias 'gnus-group-kill-region #[(begin end) "ŠÀ bˆÂyˆ` bˆÂyˆ`\") bˆÂyˆÅ\f!)‡" [count-lines begin 0 end lines gnus-group-kill-group] 3 (#$ . 127333) "r"]) #@270 The the next N groups. The killed newsgroups can be yanked by using \[gnus-group-yank-group]. However, only groups that were alive can be yanked; already killed groups or zombie groups can't be yanked. The return value is the name of the (last) group that was killed. (defalias 'gnus-group-kill-group #[(&optional n) "ÀÁ\n!À‰‰ƒZ@AÈ !ˆÉ Êyˆ`Ëyˆ`|ˆÌ  \"J‰ƒC\f@Î\f8BBÐ\fƒL\f‚M \f?…U #ˆ‚Ò ˆ -‡" [nil gnus-group-process-prefix n level entry group groups buffer-read-only gnus-group-remove-mark gnus-group-group-level 0 1 intern-soft gnus-newsrc-hashtb 2 gnus-list-of-killed-groups gnus-group-change-level gnus-level-killed gnus-group-position-cursor] 5 (#$ . 127631) "P"]) #@226 Yank the last newsgroups killed with \[gnus-group-kill-group], inserting it before the current newsgroup. The numeric ARG specifies how many newsgroups are to be yanked. The name of the (last) newsgroup yanked is returned. (defalias 'gnus-group-yank-group #[(&optional arg) "„Á‰‰S‰ÆYƒJ@‰„!ÈÉ!ˆÊ 8Ë Ì Ê 8 …9Î \"JÐ%ˆÑ A@!ˆA‚\fÒyˆÓ ˆ\f+‡" [arg 1 nil prev group info 0 gnus-list-of-killed-groups error "No more newsgroups to yank" 2 gnus-group-group-name gnus-group-change-level gnus-level-killed intern-soft gnus-newsrc-hashtb t gnus-group-insert-group-line-info -1 gnus-group-position-cursor] 7 (#$ . 128339) "p"]) #@139 List all newsgroups with level ARG or lower. Default is gnus-level-unsubscribed, which lists all subscribed and most unsubscribed groups. (defalias 'gnus-group-list-all-groups #[(&optional arg) "À †\nÃ\"‡" [gnus-group-list-groups arg gnus-level-unsubscribed t] 3 (#$ . 128988) "P"]) #@49 List all killed newsgroups in the group buffer. (defalias 'gnus-group-list-killed #[nil "„\fÁÂÃ\"ˆ‚ÄÈ#ˆ)ebˆÉ ‡" [gnus-killed-list gnus-message 6 "No killed groups" nil gnus-group-list-mode gnus-group-prepare-function gnus-level-killed t gnus-group-position-cursor] 4 (#$ . 129279) nil]) #@49 List all zombie newsgroups in the group buffer. (defalias 'gnus-group-list-zombies #[nil "„\fÁÂÃ\"ˆ‚ÄÈ#ˆ)ebˆÉ ‡" [gnus-zombie-list gnus-message 6 "No zombie groups" nil gnus-group-list-mode gnus-group-prepare-function gnus-level-zombie t gnus-group-position-cursor] 4 (#$ . 129583) nil]) #@150 Get newly arrived articles. If ARG is non-nil, it should be a number between one and nine to specify which levels you are interested in re-scanning. (defalias 'gnus-group-get-new-news #[(&optional arg) "ÀÁ!ˆÂ Ä\" ƒ! „!Å ˆÆ †T!ˆ‚3 ?…' Æ †0T!ˆ)È ‡" [run-hooks gnus-get-new-news-hook gnus-group-default-level arg t gnus-read-active-file gnus-get-unread-articles gnus-level-subscribed gnus-group-list-groups] 3 (#$ . 129889) "P"]) #@226 Check for newly arrived news in the current group (and the N-1 next groups). The difference between N and the number of newsgroup checked is returned. If N is negative, this group and the N-1 previous groups will be checked. (defalias 'gnus-group-get-new-news-this-group #[(&optional n) "À ! §ƒ \nGZ‚ÃÅ\nƒ@\n@\nAÇ!ˆÈ!„É ˆÊËÌ!#ˆÍÎ!ˆ‚ÏÐÑ\"ˆÒ ˆ\f+‡" [gnus-group-process-prefix n groups 0 ret nil group gnus-group-remove-mark gnus-get-new-news-in-group ding message "%s error: %s" gnus-status-message sit-for 2 gnus-group-next-unread-group 1 t gnus-summary-position-cursor] 5 (#$ . 130336) "P"]) (defalias 'gnus-get-new-news-in-group #[(group) "…Á!…ÂÃÄ \"J8Ä\"J\"ˆÇ ˆÈ‡" [group gnus-activate-group gnus-get-unread-articles-in-group 2 intern-soft gnus-newsrc-hashtb gnus-active-hashtb gnus-group-update-group-line t] 5]) #@38 Fetch the FAQ for the current group. (defalias 'gnus-group-fetch-faq #[(group) "„ÁÂ!ˆ Ä!PÆ !„ÁÇ \"‚È !)‡" [group error "No group name given" gnus-group-faq-directory gnus-group-real-name file file-exists-p "No such file: %s" find-file] 3 (#$ . 131192) (list (gnus-group-real-name (gnus-group-group-name)))]) #@49 Display a description of the current newsgroup. (defalias 'gnus-group-describe-group #[(force &optional group) "ƒÁÃ\f!Á\f„ÇÈ!ˆ\nƒ%ÉÊË\"\n\"J„4Ì\f!‰„4Í!…CÎ †BÉ\f\n\"J†BÏ!*‡" [force nil gnus-description-hashtb gnus-find-method-for-group group desc method error "No group name given" intern-soft gnus-group-prefixed-name "" gnus-group-get-description gnus-read-descriptions-file message "No description available"] 4 (#$ . 131515) (list current-prefix-arg (gnus-group-group-name))]) #@54 Pop up a buffer with descriptions of all newsgroups. (defalias 'gnus-group-describe-all-groups #[(&optional force) "ƒÁ\n„à „ÄÅ!ˆÁ‰È ˆÉÊ\n\"ˆebˆË *‡" [force nil gnus-description-hashtb gnus-read-all-descriptions-files error "Couldn't request descriptions file" b buffer-read-only erase-buffer mapatoms #[(group) "`ÁÂÃ\f!\fJ#cˆÅ‰TÆ\fÇÈÉÊË\fT¯#‡" [b format " *: %-20s %s\n" symbol-name group add-text-properties gnus-group gnus-unread t gnus-marked nil gnus-level gnus-level-subscribed] 11] gnus-group-position-cursor] 3 (#$ . 132021) "P"]) #@58 List all newsgroups that have names that match a regexp. (defalias 'gnus-group-apropos #[(regexp &optional search-description) "ÀpÁ‰ÆÇ\"ˆ ƒÆÊ \"ˆ „'ÌÍÎ#ˆ‚mŠÐÑ!ˆÒp!ˆÓ ˆÔ Õ\"‰ƒi @ ˜„b @‰Ö±ˆ ƒb× @ \"J‰ƒbØ\nÖ±ˆ A‰„<ebˆ)Ð\f!,‡" ["" nil des groups obuf prev mapatoms #[(group) "À !… À !\"…À !\fB‰‡" [symbol-name group string-match regexp groups] 4] gnus-active-hashtb search-description #[(group) "À \nJ\"…ÃÄ\n! \"J…Ä\n!B‰‡" [string-match regexp group intern-soft symbol-name gnus-active-hashtb groups] 3] gnus-description-hashtb gnus-message 3 "No groups matched \"%s\"." regexp pop-to-buffer "*Gnus Help*" buffer-disable-undo erase-buffer sort string< "\n" intern-soft " "] 5 (#$ . 132586) "sGnus apropos (regexp): "]) #@74 List all newsgroups that have names or descriptions that match a regexp. (defalias 'gnus-group-description-apropos #[(regexp) "„ Á „ ÂÃ!ˆÄ Æ\"‡" [gnus-description-hashtb gnus-read-all-descriptions-files error "Couldn't request descriptions file" gnus-group-apropos regexp t] 3 (#$ . 133349) "sGnus description apropos (regexp): "]) #@270 List all groups with unread articles that match REGEXP. If the prefix LEVEL is non-nil, it should be a number that says which level to cut off listing groups. If ALL, also list groups with no unread articles. If LOWEST, don't list groups with level lower than LOWEST. (defalias 'gnus-group-list-matching #[(level regexp &optional all lowest) "À †\n \f†\fÅ$ˆebˆÇ ‡" [gnus-group-prepare-flat level gnus-level-subscribed all lowest 1 regexp gnus-group-position-cursor] 5 (#$ . 133691) "P\nsList newsgroups matching: "]) #@199 List all groups that match REGEXP. If the prefix LEVEL is non-nil, it should be a number that says which level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST. (defalias 'gnus-group-list-all-matching #[(level regexp &optional lowest) "À †\n Ä $‡" [gnus-group-list-matching level gnus-level-killed regexp t lowest] 5 (#$ . 134221) "P\nsList newsgroups matching: "]) #@30 Save the Gnus startup files. (defalias 'gnus-group-save-newsrc #[nil "À ‡" [gnus-save-newsrc-file] 1 (#$ . 134632) nil]) #@38 Force Gnus to read the .newsrc file. (defalias 'gnus-group-restart #[(&optional arg) "À ˆÁÂ!ˆÃ\f!‡" [gnus-save-newsrc-file gnus-setup-news force gnus-group-list-groups arg] 2 (#$ . 134759) "P"]) #@32 Read the Gnus elisp init file. (defalias 'gnus-group-read-init-file #[nil "À ‡" [gnus-read-init-file] 1 (#$ . 134960) nil]) #@102 Check bogus newsgroups. If given a prefix, don't ask for confirmation before removing a bogus group. (defalias 'gnus-group-check-bogus-groups #[(&optional silent) "À ?…\n?!ˆÃ ‡" [gnus-check-bogus-newsgroups silent gnus-expert-user gnus-group-list-groups] 2 (#$ . 135091) "P"]) #@73 Edit the global kill file. If GROUP, edit that local kill file instead. (defalias 'gnus-group-edit-global-kill #[(&optional article group) " !ˆÄÅÆÇ!\"‡" [article gnus-current-kill-article gnus-kill-file-edit-file group gnus-message 6 substitute-command-keys "Editing a global kill file (Type \\[gnus-kill-file-exit] to exit)"] 4 (#$ . 135376) "P"]) #@25 Edit a local kill file. (defalias 'gnus-group-edit-local-kill #[(article group) "À \n\"‡" [gnus-group-edit-global-kill article group] 3 (#$ . 135734) (list nil (gnus-group-group-name))]) #@24 Update `.newsrc' file. (defalias 'gnus-group-force-update #[nil "À ‡" [gnus-save-newsrc-file] 1 (#$ . 135927) nil]) #@160 Suspend the current Gnus session. In fact, cleanup buffers except for group mode buffer. The hook gnus-suspend-gnus-hook is called before actually suspending. (defalias 'gnus-group-suspend #[nil "ÀÁ!ˆÂ !Å\fÅÇÉ\"\"\"‰ƒB@ƒ9@;ƒ+‚,Ê@!ƒ9Ë@!ˆA‰„)\f…S\fCÌ\f!ˆÍ\fÎ\")‡" [run-hooks gnus-suspend-gnus-hook get-buffer gnus-group-buffer group-buf delq gnus-dribble-buffer append gnus-buffer-list nil buffer-name kill-buffer bury-buffer delete-windows-on t] 8 (#$ . 136050) nil]) #@48 Clear all information from the dribble buffer. (defalias 'gnus-group-clear-dribble #[nil "À ‡" [gnus-dribble-clear] 1 (#$ . 136553) nil]) #@125 Quit reading news after updating .newsrc.eld and .newsrc. The hook `gnus-exit-gnus-hook' is called before actually exiting. (defalias 'gnus-group-exit #[nil "„Á\n!ƒ ƒ\f„ÅÆ!…'ÇÈ!ˆÉ ˆÊ ˆË ˆÌ ‡" [noninteractive gnus-server-opened gnus-select-method gnus-interactive-exit gnus-expert-user gnus-y-or-n-p "Are you sure you want to quit reading news? " run-hooks gnus-exit-gnus-hook gnus-offer-save-summaries gnus-save-newsrc-file gnus-close-backends gnus-clear-system] 2 (#$ . 136698) nil]) (defalias 'gnus-close-backends #[nil "Á‰…!ÄÅ @@ÆP!‰!ƒ\n ˆ A‰„Á*‡" [gnus-valid-select-methods nil func methods fboundp intern "-request-close"] 5]) #@126 Quit reading news without updating .newsrc.eld or .newsrc. The hook `gnus-exit-gnus-hook' is called before actually exiting. (defalias 'gnus-group-quit #[nil "„&Á ÂU„&Ã\f!ƒ& „&ƒ&ÇÈÉÊ!\"!…@ËÌ!ˆ ƒ5Î ˆ‚8Ï ˆÐ ˆÑ ˆÒ ‡" [noninteractive buffer-size 0 gnus-server-opened gnus-select-method gnus-expert-user gnus-current-startup-file gnus-yes-or-no-p format "Quit reading news without saving %s? " file-name-nondirectory run-hooks gnus-exit-gnus-hook gnus-use-full-window delete-other-windows gnus-remove-some-windows gnus-dribble-save gnus-close-backends gnus-clear-system] 5 (#$ . 137357) nil]) (defalias 'gnus-offer-save-summaries #[nil "ŠÀ Á‰‰ƒ3Å\f@!‰ƒ,ÆÇ\n\"ƒ,Š\nqˆ)É=ƒ,\n B\fA‰„\f …<ÊËÌ #,‡" [buffer-list nil bufname buffers buflist buffer-name string-match "Summary" major-mode gnus-summary-mode map-y-or-n-p "Update summary buffer %s? " #[(buf) "qˆÁ ‡" [buf gnus-summary-exit] 1]] 5]) #@57 Give a one line description of the group mode commands. (defalias 'gnus-group-describe-briefly #[nil "ÀÁÂÃ!\"‡" [gnus-message 7 substitute-command-keys "\\\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"] 4 (#$ . 138276) nil]) #@276 Browse a foreign news server. If called interactively, this function will ask for a select method (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). If not, METHOD should be a list where the first element is the method and the second element is the address. (defalias 'gnus-group-browse-foreign-server #[(method) "À !‡" [gnus-browse-foreign-server method] 2 (#$ . 138704) (list (let ((how (completing-read "Which backend: " (append gnus-valid-select-methods gnus-server-alist) nil t "nntp"))) (if (assoc how gnus-valid-select-methods) (list (intern how) (completing-read "Address: " (mapcar (lambda (server) (list server)) gnus-secondary-servers))) (gnus-server-to-method how))))]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÅÆÇÈ#ˆ\f„•É Ê\f!ˆË\fÌÍ#ˆË\fÎÏ#ˆË\fÐÑ#ˆË\fÒÓ#ˆË\fÔÓ#ˆË\fÕÑ#ˆË\fÖÓ#ˆË\f×Ñ#ˆË\fØÓ#ˆË\fÙÏ#ˆË\fÚÛ#ˆË\fÜÝ#ˆË\fÞÝ#ˆË\fßÝ#ˆË\fàÝ#ˆË\fáÝ#ˆË\fâã#ˆË\fäå#ˆÀæ!„žÂ&æ BÀç!„«Â'ç BÀè!„¸é(è B‡" [boundp gnus-browse-mode-hook nil current-load-list gnus-browse-mode-map put gnus-browse-mode mode-class special make-keymap suppress-keymap define-key " " gnus-browse-read-group "=" gnus-browse-select-group "n" gnus-browse-next-group "p" gnus-browse-prev-group "" "N" "P" "î" "ð" " " "u" gnus-browse-unsubscribe-current-group "l" gnus-browse-exit "L" "q" "Q" "" "?" gnus-browse-describe-briefly " " gnus-info-find-node gnus-browse-current-method gnus-browse-return-buffer gnus-browse-buffer "*Gnus Browse Server*"] 4) (defalias 'gnus-browse-foreign-server #[(method &optional return-buffer) "\nĉÈÉÊA@#ˆË!„!ÌÍÎ!\"ˆÏ!„.ÌÐÎ!\"ˆÑ!ˆÓ ˆƒ?ÕÖ!ˆ×Ö!ˆØp!ˆÄÚ ˆ)Û ˆÜÝ@A@#Šqˆp ebˆ!☄rã!!ˆäåÄæ#ƒ˜ç•bˆç”ç•{èé !Té !Z]BB‚r*êë\"ă¾@Üì A @#cˆA‰„¨)íp!ˆebˆî +‡" [method gnus-browse-current-method return-buffer gnus-browse-return-buffer nil group groups gnus-select-method gnus-message 5 "Connecting to %s..." gnus-check-server error "Unable to contact server: %s" gnus-status-message gnus-request-list "Couldn't request list: %s" get-buffer-create gnus-browse-buffer gnus-add-current-to-buffer-list gnus-carpal gnus-carpal-setup-buffer browse gnus-configure-windows buffer-disable-undo buffer-read-only erase-buffer gnus-browse-mode format "Gnus Browse Server {%s:%s}" mode-line-buffer-identification nntp-server-buffer cur gnus-ignored-newsgroups "" delete-matching-lines re-search-forward "\\(^[^ ]+\\)[ ]+[0-9]+[ ]+[0-9]+" t 1 0 read sort #[(l1 l2) "@ @™‡" [l1 l2] 2] "K%7d: %s\n" switch-to-buffer gnus-group-position-cursor] 6]) #@429 Major mode for browsing a foreign server. All normal editing commands are switched off. \ The only things you can do in this buffer is 1) `\[gnus-browse-unsubscribe-current-group]' to subscribe to a group. The group will be inserted into the group buffer upon exit from this buffer. 2) `\[gnus-browse-read-group]' to read a group ephemerally. 3) `\[gnus-browse-exit]' to return to the group buffer. (defalias 'gnus-browse-mode #[nil "À ˆ ƒ\n ˆÃÅÆ!ˆÇ!È8Éšƒ&țʠˆË\fÍÏÑ!ˆÓp!ˆÔÔ×Ø!‡" [kill-all-local-variables gnus-visual gnus-browse-make-menu-bar "-- " mode-line-modified make-local-variable mode-line-format copy-sequence 3 " " "" gnus-browse-mode major-mode "Browse Server" mode-name nil mode-line-process use-local-map gnus-browse-mode-map buffer-disable-undo t truncate-lines buffer-read-only run-hooks gnus-browse-mode-hook] 2 (#$ . 141216) nil]) #@38 Enter the group at the current line. (defalias 'gnus-browse-read-group #[(&optional no-article) "À  ÄpÅB$†ÆÇ \")‡" [gnus-browse-group-name group gnus-group-read-ephemeral-group gnus-browse-current-method nil browse error "Couldn't enter %s"] 6 (#$ . 142126) nil]) #@27 Select the current group. (defalias 'gnus-browse-select-group #[nil "ÀÁ!‡" [gnus-browse-read-group no] 2 (#$ . 142401) nil]) #@23 Go to the next group. (defalias 'gnus-browse-next-group #[(n) "yÁ ˆ‡" [n gnus-group-position-cursor] 2 (#$ . 142532) "p"]) #@23 Go to the next group. (defalias 'gnus-browse-prev-group #[(n) "À [!‡" [gnus-browse-next-group n] 2 (#$ . 142662) "p"]) #@39 (Un)subscribe to the next ARG groups. (defalias 'gnus-browse-unsubscribe-current-group #[(arg) "mƒÀÁ!ˆ\nÃWƒÄ‚ÅÆ\n!\nÃVƒ8m„8È ƒ8É!ÃUƒ8\nS‰‚Ê ˆ\nÃU„FËÌÍ\"ˆ\n*‡" [error "No group at current line." arg 0 -1 1 abs ward gnus-browse-unsubscribe-group gnus-browse-next-group gnus-group-position-cursor gnus-message 7 "No more newsgroups"] 4 (#$ . 142787) "p"]) (defalias 'gnus-browse-group-name #[nil "ŠÀyˆÁÂ`Ĉ` bˆ)Å#…ÆǔǕ{\")‡" [0 re-search-forward ": \\(.*\\)$" p nil t gnus-group-prefixed-name 1 gnus-browse-current-method] 4]) #@64 Toggle subscription of the current group in the browse buffer. (defalias 'gnus-browse-unsubscribe-group #[nil "À‰‰ŠÄyˆgÅUƒÆÇ ÈÉ!ˆ ƒGÊÆ  À‰\f¯  A@@…>ÏA@@\"JÆ%ˆÑcˆ‚RÊ   #ˆÅcˆ,Ƈ" [nil group buffer-read-only sub 0 75 t gnus-browse-group-name delete-char 1 gnus-group-change-level gnus-level-default-subscribed gnus-browse-current-method gnus-level-killed gnus-newsrc-alist intern-soft gnus-newsrc-hashtb 32] 7 (#$ . 143343)]) #@47 Quit browsing and return to the group buffer. (defalias 'gnus-browse-exit #[nil "Á=ƒ\nÂp!ˆ ƒÄÅÆ\"‡ÄÇÆ\"ˆÈÉ!‡" [major-mode gnus-browse-mode kill-buffer gnus-browse-return-buffer gnus-configure-windows server force group gnus-group-list-groups nil] 3 (#$ . 143795) nil]) #@57 Give a one line description of the group mode commands. (defalias 'gnus-browse-describe-briefly #[nil "ÀÁÂÃ!\"‡" [gnus-message 6 substitute-command-keys "\\\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"] 4 (#$ . 144074) nil]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ BÀÈ!„GÂÈ BÀÉ!„TÂ É BÀÊ!„aÂ\nÊ BÀË!„nÂ Ë BÀÌ!„{Â\fÌ BÀÍ!„ˆÂ Í BÀÎ!„•ÂÎ BÀÏ!„¢ÂÏ BÀÐ!„¯ÂÐ BÀÑ!„¼ÂÑ BÀÒ!„ÉÂÒ BÓÔÕÖ#ˆ „° × Ø !ˆÙ ÚÛ#ˆÙ ÜÝ#ˆÙ Þß#ˆÙ àá#ˆÙ âã#ˆÙ äå#ˆÙ æç#ˆÙ èé#ˆÙ êë#ˆÙ ìí#ˆÙ îï#ˆÙ ðñ#ˆÙ òó#ˆÙ ôõ#ˆÙ ö÷#ˆÙ øù#ˆÙ úû#ˆÙ üý#ˆÙ þÿ#ˆÙ @A#ˆÙ BC#ˆÙ DC#ˆÙ EF#ˆÙ GH#ˆÙ IJ#ˆÙ KL#ˆÙ MN#ˆÙ OP#ˆÙ QR#ˆÙ ST#ˆÙ UV#ˆÙ WX#ˆÙ YZ#ˆÙ [\\#ˆÙ ]^#ˆÙ _`#ˆÙ ab#ˆÙ cd#ˆÙ ef#ˆÙ gh#ˆÙ ij#ˆÙ kl#ˆÙ mn#ˆÙ op#ˆÙ qr#ˆÙ st#ˆÙ uv#ˆÙ wx#ˆÙ yz#ˆÙ {|#ˆÙ }~#ˆÙ €#ˆÙ ‚#ˆÙ ƒ„#ˆÙ …†#ˆÙ ‡ˆ#ˆÙ ‰Š#ˆÙ ‹Œ#ˆÙ Ž#ˆÙ #ˆÙ ‘’#ˆÙ “”#ˆÙ •–#ˆÙ —˜#ˆÙ ™š#ˆÙ ›œ#ˆÙ ž#ˆÙ Ÿ #ˆÙ ¡¢#ˆÙ £¤#ˆÙ ¥¦#ˆÙ §¨#ˆÙ ©ª#ˆÙ «¬#ˆÙ ­®#ˆÙ ¯°#ˆÙ ±²#ˆÙ ³´#ˆÙ µ¶#ˆÙ ·¸#ˆÙ ¹º#ˆÙ »¼#ˆÙ ½¾#ˆÙ ¿À#ˆÙ ÁÂ#ˆÙ ÃÄ#ˆÙ ÅÆ#ˆÇÄ!ˆÙ ÈÄ#ˆÙ\f¹C#ˆÙ\fDC#ˆÙ\fGH#ˆÙ\f•H#ˆÙ\foN#ˆÙ\fÚN#ˆÙ\fYL#ˆÙ\fµL#ˆÙ\fuv#ˆÙ\fÉÊ#ˆÙ\fËÌ#ˆÙ\f[\\#ˆÙ\f]^#ˆÙ\fö¶#ˆÙ\fÍÎ#ˆÙ\fIÏ#ˆÙ\fÐÑ#ˆÙ\fÒx#ˆÙ\f“Ó#ˆÙ\fÔÕ#ˆÙ\fÖ×#ˆÙ\fQR#ˆÙ\fØT#ˆÇÅ!ˆÙ\f¥Å#ˆÙ oÙ#ˆÙ BÚ#ˆÙ ±Û#ˆÙ QÜ#ˆÙ\fæÝ#ˆÙ ÒÞ#ˆÇÈ!ˆÙ ßÈ#ˆÙàá#ˆÙâã#ˆÙäå#ˆÙæç#ˆÙàé#ˆÙáë#ˆÙìí#ˆÙîï#ˆÙñ#ˆÙÉó#ˆÙ»ý#ˆÙ½¾#ˆÙââ#ˆÇÇ!ˆÙ ãÇ#ˆÙQV#ˆÙ½X#ˆÙäå#ˆÙã`#ˆÙ·b#ˆÙÒæ#ˆÙçd#ˆÙÔè#ˆÙàf#ˆÙâh#ˆÙBj#ˆÙGl#ˆÙ[é#ˆÇÉ!ˆÙ êÉ#ˆÙ op#ˆÙ “ë#ˆÙ K¬#ˆÙ «ª#ˆÙ êª#ˆÙ àì#ˆÙ —†#ˆÙ ߈#ˆÙ äí#ˆÙ æî#ˆÇÆ!ˆÙ ïÆ#ˆÙÚÛ#ˆÙàÛ#ˆÙÜÝ#ˆÙâÝ#ˆÙÞß#ˆÙøù#ˆÙúû#ˆÙÉù#ˆÙYû#ˆÙþÿ#ˆÙ•ÿ#ˆÙ»¼#ˆÙ·¸#ˆÇÎ!ˆÙ ðÎ#ˆÇÏ!ˆÙðÏ#ˆÙ³ñ#ˆÙçò#ˆÙ·ó#ˆÙoô#ˆÙÖõ#ˆÇÐ!ˆÙÔÐ#ˆÙ³ö#ˆÙç÷#ˆÙoø#ˆÙ·ù#ˆÇÑ!ˆÙãÑ#ˆÙúû#ˆÙBû#ˆÙ½ü#ˆÙYý#ˆÙÉþ#ˆÙ›ÿ#ˆÙ‰#ˆÙo#ˆÙ©#ˆÙ#ˆÙ½Š#ˆÙ•Œ#ˆÙ¹º#ˆÙ±Ž#ˆÇÒ!ˆÙ ÔÒ#ˆÙæ#ˆÙ#ˆÙG¨#ˆÙç#ˆÙä®#ˆÇÌ!ˆÙ ËÌ#ˆÙ\fY#ˆÙ\f#ˆÙ\fÜ #ˆÙ\f±\n#ˆÙ\f• #ˆÙ\f‰Z#ˆÙ\fo\f#ˆÙ\f© #ˆÙ\fä#ˆÇÍ!ˆÙ Í#ˆÙ ›œ#ˆÙ ±ž#ˆÙ •#ˆÙ #ˆÙ ç#ˆÙ Ã#ˆÙ â #ˆÙ #ˆÙ #ˆÙIÂ#ˆÙ ¥#ˆÙ #ˆÙ #ˆÂ‡" [boundp gnus-summary-mode-map nil current-load-list gnus-summary-mark-map gnus-summary-mscore-map gnus-summary-article-map gnus-summary-thread-map gnus-summary-goto-map gnus-summary-exit-map gnus-summary-interest-map gnus-summary-sort-map gnus-summary-backend-map gnus-summary-save-map gnus-summary-wash-map gnus-summary-wash-hide-map gnus-summary-wash-highlight-map gnus-summary-wash-time-map gnus-summary-help-map put gnus-summary-mode mode-class special make-keymap suppress-keymap define-key " " gnus-summary-next-page "" gnus-summary-prev-page " " gnus-summary-scroll-up "n" gnus-summary-next-unread-article "p" gnus-summary-prev-unread-article "N" gnus-summary-next-article "P" gnus-summary-prev-article "Ž" gnus-summary-next-same-subject "" gnus-summary-prev-same-subject "î" gnus-summary-next-unread-subject "ð" gnus-summary-prev-unread-subject "." gnus-summary-first-unread-article "," gnus-summary-best-unread-article "ó" gnus-summary-search-article-forward "ò" gnus-summary-search-article-backward "<" gnus-summary-beginning-of-article ">" gnus-summary-end-of-article "j" gnus-summary-goto-subject "^" gnus-summary-refer-parent-article "Þ" gnus-summary-refer-article "u" gnus-summary-tick-article-forward "!" "U" gnus-summary-tick-article-backward "d" gnus-summary-mark-as-read-forward "D" gnus-summary-mark-as-read-backward "E" gnus-summary-mark-as-expirable "õ" gnus-summary-clear-mark-forward "Õ" gnus-summary-clear-mark-backward "k" gnus-summary-kill-same-subject-and-select " " gnus-summary-kill-same-subject "‹" gnus-summary-kill-thread "Œ" gnus-summary-lower-thread "e" gnus-summary-edit-article "#" gnus-summary-mark-as-processable "£" gnus-summary-unmark-as-processable "”" gnus-summary-toggle-threads "“" gnus-summary-show-thread "ˆ" gnus-summary-hide-thread "†" gnus-summary-next-thread "‚" gnus-summary-prev-thread "•" gnus-summary-up-thread "„" gnus-summary-down-thread "&" gnus-summary-execute-command "c" gnus-summary-catchup-and-exit "" gnus-summary-mark-region-as-read "" gnus-summary-toggle-truncation "?" gnus-summary-mark-as-dormant "“" gnus-summary-show-all-expunged "" gnus-summary-sort-by-number "" gnus-summary-sort-by-author "" gnus-summary-sort-by-subject "" gnus-summary-sort-by-date " " gnus-summary-sort-by-score "=" gnus-summary-expand-window "" gnus-summary-reselect-current-group "ç" gnus-summary-rescan-group "w" gnus-summary-stop-page-breaking "" gnus-summary-caesar-message "ô" gnus-summary-toggle-mime "f" gnus-summary-followup "F" gnus-summary-followup-with-original "C" gnus-summary-cancel-article "r" gnus-summary-reply "R" gnus-summary-reply-with-original "" gnus-summary-mail-forward "o" gnus-summary-save-article "" gnus-summary-save-article-mail "|" gnus-summary-pipe-output "ë" gnus-summary-edit-local-kill "Ë" gnus-summary-edit-global-kill "V" gnus-version "" gnus-summary-describe-group "q" gnus-summary-exit "Q" gnus-summary-exit-no-update " " gnus-info-find-node gnus-mouse-2 gnus-mouse-pick-article "m" gnus-summary-mail-other-window "a" gnus-summary-post-news "x" gnus-summary-remove-lines-marked-as-read "s" gnus-summary-isearch-article "t" gnus-summary-toggle-header "g" gnus-summary-show-article "l" gnus-summary-goto-last-article "" gnus-uu-decode-uu-view "" gnus-summary-enter-digest-group "v" gnus-summary-verbose-headers "" gnus-bug define-prefix-command "M" "b" gnus-summary-set-bookmark "B" gnus-summary-remove-bookmark "’" gnus-summary-remove-lines-marked-with gnus-summary-show-all-dormant "Ä" gnus-summary-hide-all-dormant "S" gnus-summary-catchup "H" gnus-summary-catchup-to-here "" gnus-summary-catchup-all "K" gnus-summary-clear-above gnus-summary-tick-above gnus-summary-mark-above gnus-summary-kill-below gnus-uu-mark-map gnus-summary-send-map "G" "" "" gnus-summary-pop-article "T" "i" gnus-summary-raise-thread gnus-summary-show-all-threads "h" gnus-summary-hide-all-threads gnus-uu-mark-thread "Z" gnus-summary-catchup-all-and-exit gnus-summary-catchup-and-goto-next-group gnus-summary-next-group gnus-summary-prev-group "A" "W" gnus-article-hide gnus-article-hide-headers gnus-article-hide-signature gnus-article-hide-citation gnus-article-hide-citation-maybe gnus-article-highlight gnus-article-highlight-headers gnus-article-highlight-citation gnus-article-highlight-signature "z" gnus-article-date-ut gnus-article-date-local gnus-article-date-lapsed gnus-article-add-buttons gnus-article-treat-overstrike gnus-article-word-wrap gnus-article-remove-cr gnus-article-de-quoted-unreadable gnus-article-display-x-face gnus-summary-fetch-faq gnus-summary-describe-briefly gnus-summary-expire-articles "…" gnus-summary-expire-articles-now gnus-summary-delete-article gnus-summary-move-article gnus-summary-respool-article gnus-summary-copy-article gnus-summary-fancy-query gnus-summary-import-article "O" gnus-summary-save-article-rmail gnus-summary-save-article-file gnus-summary-save-article-folder gnus-summary-save-article-vm "X" gnus-uu-extract-map "¦" gnus-summary-universal-argument gnus-summary-score-map "I" gnus-summary-increase-score "L" gnus-summary-lower-score] 4) #@800 Major mode for reading articles. All normal editing commands are switched off. \ Each line in this buffer represents one article. To read an article, you can, for instance, type `\[gnus-summary-next-page]'. To move forwards and backwards while displaying articles, type `\[gnus-summary-next-unread-article]' and `\[gnus-summary-prev-unread-article]', respectively. You can also post articles and send mail from this buffer. To follow up an article, type `\[gnus-summary-followup]'. To mail a reply to the author of an article, type `\[gnus-summary-reply]'. There are approx. one gazillion commands you can execute in this buffer; read the info pages for more information (`\[gnus-info-find-node]'). The following commands are available: \{gnus-summary-mode-map} (defalias 'gnus-summary-mode #[(&optional group) "ƒÁ ˆÂ ˆ ‰ƒ:\f@:ƒ)Å\f@@!ˆ\f@@Æ\f@A!Lˆ‚3Å\f@!ˆ\f@ÇLˆ\fA‰„)È ˆÉ\nÅË!ˆÌ ! Í 8Κƒ[Í ›Ï ˆÐÒÅÔ!ˆÕ!ˆ×p!ˆØØØØ áâ!‡" [gnus-visual gnus-summary-make-menu-bar kill-all-local-variables gnus-summary-local-variables locals make-local-variable eval nil gnus-make-thread-indent-array "-- " mode-line-modified mode-line-format copy-sequence 3 " " "" gnus-summary-mode major-mode "Summary" mode-name minor-mode-alist use-local-map gnus-summary-mode-map buffer-disable-undo t buffer-read-only truncate-lines selective-display selective-display-ellipses gnus-summary-display-table buffer-display-table group gnus-newsgroup-name run-hooks gnus-summary-mode-hook] 4 (#$ . 152088) nil]) (defalias 'gnus-summary-make-display-table #[nil "À !† Ä S‰ÆYƒ ÇIˆ‚ ) ÈÉIˆ ÊÉIˆË S‰ÌY…@ H„) ÍIˆ‚))‡" [copy-sequence standard-display-table make-display-table gnus-summary-display-table 32 i 0 [63] 10 nil 13 256 127 [63]] 3]) (defalias 'gnus-summary-clear-local-variables #[nil "‰…1 @:ƒ @@!ƒ) @@ÃLˆ‚) @!ƒ) @ÃLˆ A‰„Ã)‡" [gnus-summary-local-variables locals vectorp nil] 3]) (defalias 'gnus-get-header-by-number #[(number) "Šqˆ „  ˆÃÄ ! \"J)‡" [gnus-summary-buffer gnus-newsgroup-headers-hashtb-by-number gnus-make-headers-hashtable-by-number intern-soft int-to-string number] 3]) (defalias 'gnus-get-header-by-num '(macro . #[(number) "ÀÁ\nDÃBB‡" [gnus-gethash int-to-string number (gnus-newsgroup-headers-hashtb-by-number)] 3])) #@243 Search for article forward. If UNREAD is non-nil, only unread articles are selected. If SUBJECT is non-nil, the article which has the same subject will be searched for. If BACKWARD is non-nil, the search will be performed backwards instead. (defalias 'gnus-summary-search-forward '(macro . #[(&optional unread subject backward) "À \n F‡" [gnus-summary-search-subject backward unread subject] 4 (#$ . 154407)])) #@213 Search for article backward. If 1st optional argument UNREAD is non-nil, only unread article is selected. If 2nd optional argument SUBJECT is non-nil, the article which has the same subject will be searched for. (defalias 'gnus-summary-search-backward '(macro . #[(&optional unread subject) "À \nÃBBB‡" [gnus-summary-search-forward unread subject (t)] 4 (#$ . 154826)])) #@138 The article number of the article on the current line. If there isn's an article number here, then we return the current article number. (defalias 'gnus-summary-article-number '(macro . #[(&optional number-or-nil) "ƒÁ‡Â‡" [number-or-nil (get-text-property (gnus-point-at-bol) (quote gnus-number)) (or (get-text-property (gnus-point-at-bol) (quote gnus-number)) gnus-current-article)] 1 (#$ . 155204)])) #@54 The thread level of the article on the current line. (defalias 'gnus-summary-thread-level '(macro . #[nil "À‡" [(or (get-text-property (gnus-point-at-bol) (quote gnus-level)) 0)] 1 (#$ . 155616)])) #@31 The mark on the current line. (defalias 'gnus-summary-article-mark '(macro . #[nil "À‡" [(get-text-property (gnus-point-at-bol) (quote gnus-mark))] 1 (#$ . 155820)])) #@50 Return current subject string or nil if nothing. (defalias 'gnus-summary-subject-string #[nil "À`Âyˆ` bˆ)Ã\"†\fʼn…4ÈÉ!\n\"J‰…4Ë!…4ÌH*‡" [get-text-property p 0 gnus-number gnus-current-article nil header article intern-soft int-to-string gnus-newsgroup-headers-hashtb-by-number vectorp 1] 4 (#$ . 155993)]) (defalias 'gnus-mouse-pick-article #[(e) "À !ˆÂÃÄ\"‡" [mouse-set-point e gnus-summary-next-page nil t] 3 nil "e"]) #@28 Initialize summary buffer. (defalias 'gnus-summary-setup-buffer #[(group) "À ÂQÄ !ƒ qˆ ?‚-Æ !qÈ ˆÉ !ˆ\nƒ)ËÌ!ˆ  Î)‡" ["*Summary " group "*" buffer get-buffer gnus-newsgroup-begin get-buffer-create gnus-summary-buffer gnus-add-current-to-buffer-list gnus-summary-mode gnus-carpal gnus-carpal-setup-buffer summary gnus-newsgroup-name t] 3 (#$ . 156439)]) (defalias 'gnus-set-global-variables #[nil "Á=…2p \f  \n \fŠ qˆ\f \n ‰.‡" [major-mode gnus-summary-mode gnus-summary-buffer gnus-newsgroup-name gnus-newsgroup-marked gnus-newsgroup-unreads gnus-current-headers gnus-current-score-file score-file headers unread marked name gnus-group-buffer] 5]) (defalias 'gnus-summary-insert-dummy-line #[(sformat subject number) "„ ÂÄyˆ`Å!cˆÆ ‰TÇÉ\nËį#)‡" [sformat gnus-summary-dummy-line-format-spec nil b 0 eval add-text-properties gnus-number number gnus-mark gnus-dummy-mark gnus-level] 9]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ Ä B‡" [boundp gnus-thread-indent-array nil current-load-list gnus-thread-indent-array-level gnus-thread-indent-level] 2) (defalias 'gnus-make-thread-indent-array #[nil "À\n… \fU?…+ÅÆÇ\"  ÈY…+\n É _Ê\"Iˆ S‰‚)‡" [200 n gnus-thread-indent-array gnus-thread-indent-level gnus-thread-indent-array-level make-vector 201 "" 0 make-string 32] 6]) (defalias 'gnus-summary-insert-line #[(sformat header level current unread replied expirable subject-or-nil &optional dummy score process) "„ \n H ÆH† †Ê ƒ.Ë Z!\fXƒ2Í‚A Wƒ?‚AƒM‚YƒW‚Y ÖHØÙ\"ƒtÊ”TÊ•SO‚ ØÚ\"ƒžÊ”ØÜ\"ƒ”Ê”TÊ•SO†šÊO)‚  ÞH ÊH !ƒµâ‚¶ã$!ƒÁå‚Âæ'è)Êyˆ`*§„ÖÊë!cˆì*‰Tí î/†ëð ¯#. ‡" [sformat gnus-summary-line-format-spec gnus-thread-indent-array level indentation header 7 lines score gnus-summary-default-score 0 abs gnus-summary-zcore-fuzz 32 gnus-score-below-mark gnus-score-over-mark score-char process gnus-process-mark replied gnus-replied-mark gnus-unread-mark 2 from string-match "(.+)" "<[^>]+> *$" beg "^\"[^\"]*\"" name 1 subject number dummy 60 91 opening-bracket 62 93 closing-bracket nil buffer-read-only b eval add-text-properties gnus-number gnus-mark unread gnus-level] 9]) (defalias 'gnus-summary-update-line #[(&optional dont-update) "?†j †jÂÃ`Åyˆ`\fbˆ)Æ\"† „a\nƒQË \nWƒQ\f>„a >„a>ƒaÏ!ˆ‚aÃÑ Ò\"=ƒaÓ!ˆ…iÖ×!*‡" [gnus-summary-default-score gnus-summary-inhibit-highlight t get-text-property p 0 gnus-number gnus-current-article article dont-update gnus-summary-mark-below gnus-summary-article-score gnus-newsgroup-marked gnus-newsgroup-dormant gnus-newsgroup-unreads gnus-summary-mark-article-as-read gnus-low-score-mark gnus-point-at-bol gnus-mark gnus-summary-mark-article-as-unread gnus-unread-mark gnus-visual run-hooks gnus-summary-update-hook] 4]) (defalias 'gnus-summary-update-lines #[(&optional beg end) "†e †\nd\n?† ?…ŽÄÅŠqˆbˆÈyˆm?…` W… ƒoÊ`Ë\"‰\fžA†I\n†IÈ Wƒo >„~>„~>ƒ~Ð!ˆ‚~Ê`Ò\"=ƒ~Ó!ˆƒ‡Ö×!ˆØyˆ‚&+*‡" [beg end gnus-summary-default-score gnus-summary-inhibit-highlight t nil article gnus-summary-buffer 0 gnus-summary-mark-below get-text-property gnus-number gnus-newsgroup-scored gnus-newsgroup-marked gnus-newsgroup-dormant gnus-newsgroup-unreads gnus-summary-mark-article-as-read gnus-low-score-mark gnus-mark gnus-summary-mark-article-as-unread gnus-unread-mark gnus-visual run-hooks gnus-summary-update-hook 1] 3]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-tmp-gathered nil current-load-list] 2) (defalias 'gnus-summary-number-of-articles-in-thread #[(thread &optional char) ":ƒAƒÁÂÃÄÅA\"#‚Ã/ÃVƒ*‚1 ‚1)‡" [thread apply + 1 mapcar gnus-summary-number-of-articles-in-thread number char gnus-not-empty-thread-mark gnus-empty-thread-mark] 6]) #@163 Start reading news in newsgroup GROUP. If SHOW-ALL is non-nil, already read articles are also listed. If NO-ARTICLE is non-nil, no article is selected initially. (defalias 'gnus-summary-read-group #[(group &optional show-all no-article kill-buffer) "ÀÁ #ˆÄ !Æ ! …È  \"\n „PË ˆ\fƒ<\f;ƒ0Í‚1Î\f!ƒ<Ì\f!ˆÏÐÑ\"ˆÒÐ!ˆÓ ˆÔÕ!ˆÖ‚4\n„¨Ø=ƒ p\fš„ Ìp!ˆ„{qˆÚ !ˆÛÜ!ˆ‚ Î@!„‹ÏÃÑ\"ˆ‚ @qˆØ=ƒšË ˆÏA!ˆÔÝ!ˆÞ‚4\nß=ƒ!Ø=ƒÁp\fš„ÁÌp!ˆ\fƒÜ\f;ƒÐÍ‚ÑÎ\f!ƒÜÌ\f!ˆ„õqˆÚ !ˆÛÜ!ˆÏÃÑ\"ˆ‚Î@!„ÏÃÑ\"ˆ‚@qˆØ=ƒË ˆÏA!ˆàßÞ\"‚4Ë ˆáâ#$\"J!%æç!ˆ(ƒ;é ˆê ˆë ˆì íUƒ`.ƒSï ˆ‚`0ƒ` ƒ`ñ ˆæò!ˆì íUƒ“óÞÖ\"ˆÀôõ\"ˆ\fƒ3\f;ƒ„Í‚…Î\f!ƒ3Ì\f!ˆ‚36ƒ 7ƒ ø ˆebˆ9„²:ƒ²û „·ÏÐÑ\"ˆÒÐ!ˆÓ ˆ<ƒé=Ÿ‰=ƒéþ#?ƒå@?!ƒå?=!‚ç=\"ˆ\fƒ\f;ƒøÍ‚ùÎ\f!ƒÌ\f!ˆA!ƒ3B CDA!!ˆE !ƒ+F ˆDC!ˆ)Ö+‡" [gnus-message 5 "Retrieving newsgroup: %s..." group gnus-summary-setup-buffer new-group gnus-group-quit-config quit-config gnus-select-newsgroup show-all did-select gnus-set-global-variables kill-buffer get-buffer buffer-name gnus-configure-windows summary force gnus-set-mode-line gnus-summary-position-cursor message "" t major-mode gnus-summary-mode gnus-group-buffer gnus-group-jump-to-group gnus-group-next-unread-group 1 "Can't select group" nil quit signal gnus-copy-sequence intern-soft gnus-newsgroup-name gnus-active-hashtb gnus-newsgroup-active run-hooks gnus-select-group-hook gnus-use-scoring gnus-possibly-score-headers gnus-update-format-specifications gnus-summary-prepare buffer-size 0 gnus-newsgroup-dormant gnus-summary-show-all-dormant gnus-newsgroup-scored gnus-summary-show-all-expunged gnus-apply-kill-hook gnus-summary-catchup-and-exit 6 "No unread news" gnus-show-threads gnus-thread-hide-subtree gnus-summary-hide-all-threads no-article gnus-auto-select-first gnus-summary-first-unread-article gnus-newsgroup-async gnus-newsgroup-threads gnus-request-asynchronous gnus-asynchronous-article-function fboundp get-buffer-window selected-window owin select-window gnus-group-goto-group recenter] 4 (#$ . 160258)]) (defalias 'gnus-summary-prepare #[nil "À ˆÃ\fƒ\"Åƃ„É ‚Ê !!‚$ Ì\"ˆÍ ˆÎ ˆebˆÏÐ!)‡" [nil buffer-read-only erase-buffer gnus-summary-prepare-threads gnus-show-threads gnus-gather-threads gnus-sort-threads gnus-summary-expunge-below gnus-fetch-old-headers gnus-make-threads-and-expunge gnus-make-threads gnus-newsgroup-headers cull gnus-summary-update-lines gnus-make-headers-hashtable-by-number run-hooks gnus-summary-prepare-hook] 4]) #@44 Gather threads that have lost their roots. (defalias 'gnus-gather-threads #[(threads) "„ ‡ÂÃ! ‰Ä‰‰ \n ƒ½ @@ËH‰\fƒV\f§ƒFG\fVƒFÍ\fO‰„s\fÎ=ƒsÏ!‚sÐÒÓ\"ƒnÍ•ÄO‚p*Ô\n\"J‰ƒª@@;„‘ @D ˆ@@A @C¤¡ˆ A¡ˆ ‚³Õ\n\" Lˆ  A‰„.‡" [gnus-summary-make-false-root threads gnus-make-hashtable 1023 nil whole-subject hthread subject result prev hashtb 1 gnus-summary-gather-subject-limit 0 fuzzy gnus-simplify-subject-fuzzy t case-fold-search string-match "^re: *" intern-soft intern] 7 (#$ . 162798)]) (defalias 'gnus-make-threads #[nil "ÀÁÂ\"ˆÃ‰ƒÈ=ƒÉ ˆÊË\f\"ˆ\f‰ ƒ@Î @ÏHÐP\f\"à @DLˆ A‰ „%)\f ¤ÑÒÓÔÑÕÑÖ \"\"\"\"ÀÁ×\"ˆ*‡" [gnus-message 6 "Threading..." nil new-roots roots gnus-fetch-old-headers gnus-headers-retrieved-by nov gnus-build-old-threads mapatoms #[(refs) "J@„ÁJA\n\"‰‡ †€J‰@ÅHÇÉÊ\"ƒ0Ë•ÌO‚2*\fA‰ … @ÅHÇÉÊ\"ƒZË•ÌO‚\\*˜„r @B\f A¡ˆ‚u  A‰ „=Ì+‡" [refs append roots gnus-thread-ignore-subject prev 1 subject t case-fold-search string-match "^re: *" 0 nil headers new-roots] 5] gnus-newsgroup-dependencies r intern 4 ".boo" mapcar gnus-trim-thread apply append gnus-cut-thread gnus-make-sub-thread "Threading...done"] 10]) (defalias 'gnus-make-threads-and-expunge #[nil "ÀÁÂ\"ˆ †\nÄ Æ‰‰ \n \fƒ' Î=ƒ'Ï ˆÐÑ\"ˆ‰ƒPÔ@ÕHÖP\"Æ@DLˆA‰„5) ¤ ×ØÙÚ×Û×Ü \"\"\"\"ÀÁÝ\"ˆ-‡" [gnus-message 6 "Threading..." gnus-summary-default-score 0 gnus-summary-expunge-below nil new-roots article roots below default gnus-fetch-old-headers gnus-headers-retrieved-by nov gnus-build-old-threads mapatoms #[(refs) "J@„HJA‰…F @ÂH žA†\f W„( @B‚>Ç @ÂH\" @ÂH B\nB\n A‰„Ë)‡\f„ßJ‰ @ÎHÐÒÓ\"ƒk•ËO‚m* A‰ƒÞ @ÎHÐÒÓ\"ƒ”•ËO‚–*˜„Ô @ÂH žA†¦\f W„µ @B‚ËÇ @ÂH\" @ÂH B\nB\n A¡ˆ‚×  A‰„x+J@ÂH žA†ë\f Wƒ=J‰ A‰…; @ÂH‰ žA† \f W„ @B  ‚3Ç\" B\nB\n A¡ˆ A‰„ûË*‡J‰ AË …„ @ÂH‰ žA†Y\f W„d  ‚|Ç\" B\nB\n A¡ˆ A‰„KË+‡" [refs headers 0 gnus-newsgroup-scored default below roots delq gnus-newsgroup-unreads gnus-low-score-mark gnus-newsgroup-reads nil gnus-thread-ignore-subject prev 1 subject t case-fold-search string-match "^re: *" new-roots article] 5] gnus-newsgroup-dependencies r intern 4 ".boo" mapcar gnus-trim-thread apply append gnus-cut-thread gnus-make-sub-thread "Threading...done"] 10]) (defalias 'gnus-cut-thread #[(thread) "@ÁÂÃÄA\"\" ?…\\ÇH‰ >†[\n>†[ …[\fÍ=…[žA†B†BÇ W…[Ð\"BBÔ)?…e BC*‡" [thread apply append mapcar gnus-cut-thread tail head 0 number gnus-newsgroup-ancient gnus-newsgroup-dormant gnus-summary-expunge-below gnus-fetch-old-headers some gnus-newsgroup-scored gnus-summary-default-score delq gnus-newsgroup-unreads gnus-low-score-mark gnus-newsgroup-reads t] 7]) (defalias 'gnus-trim-thread #[(thread) "Á=ƒ\n@ÃH\f>ƒ\nGÅUƒÆ\nA@!‡\n‡" [gnus-fetch-old-headers some thread 0 gnus-newsgroup-ancient 2 gnus-trim-thread] 2]) (defalias 'gnus-make-sub-thread #[(root) "ÀÁ\nÃH—\f\"JA!\nÆÇ \")B‡" [reverse intern-soft root 4 gnus-newsgroup-dependencies children mapcar gnus-make-sub-thread] 4]) (defalias 'gnus-build-old-threads #[nil "À‰ÃÄ \"*‡" [nil heads id mapatoms #[(refs) "J@?…<JA‰…< @ÂH >„4Ä!Æ !‰ƒ.Ç \"J@ƒɉ‚\f A‰„ɇ" [refs heads 0 gnus-newsgroup-dormant symbol-name id gnus-build-get-header intern-soft gnus-newsgroup-dependencies nil] 4] gnus-newsgroup-dependencies] 3]) (defalias 'gnus-build-get-header #[(id) "Á‰Š qˆebˆ „1ÆÁÈ#ƒ1ÉyˆÊËÌÍ!\"!‰„ Îyˆ‚ …_ÁÉyˆÐÑp!\f\"‰…^\nÒH‰…^ÓÔ\"…^ΔΕO))\nƒr\nB\nÉHB+‡" [gnus-newsgroup-dependencies nil header found deps nntp-server-buffer search-forward id t 0 looking-at format "^[^ ]* [^ ]* [^ ]* [^ ]* %s" regexp-quote 1 ref gnus-nov-parse-line read 5 string-match "\\(<[^>]+>\\) *$" gnus-newsgroup-headers gnus-newsgroup-ancient] 6]) (defalias 'gnus-rebuild-thread #[(id) "Á‰‰‰‰‰ ƒDÊ —\"J‰@‰ƒD\n ËH‰…>ÌÍ\f\"…>\fΔΕO‰ „Ï@!Ð !ˆ`Ò C!ˆÓ`\".‡" [gnus-newsgroup-dependencies nil art thread refs headers parent buffer-read-only dep id intern-soft 5 string-match "\\(<[^>]+>\\) *$" 1 gnus-make-sub-thread gnus-rebuild-remove-articles beg gnus-summary-prepare-threads gnus-summary-update-lines] 8]) (defalias 'gnus-rebuild-remove-articles #[(thread) "À @ÂH!ƒÂyˆ`Ãyˆ`|ˆÄÅ A\"‡" [gnus-summary-goto-subject thread 0 1 mapcar #[(th) "À !‡" [gnus-rebuild-remove-articles th] 2]] 3]) (defalias 'gnus-sort-threads #[(threads) "‰ƒÂÃÄ #ˆÅ @\" A‰„)ƒ%ÂÃÇ\"ˆ‡" [gnus-thread-sort-functions fun gnus-message 6 "Sorting with %S..." sort threads "Sorting...done"] 5]) (defalias 'gnus-thread-header '(macro . #[(thread) "9„\nÁÂÃ\"ˆÄÅÆ!ÇF‡" [thread signal wrong-type-argument (symbolp thread) byte-code "‰:ƒ‰@;ƒA@@‡" vector 2] 4])) #@38 Sort threads by root article number. (defalias 'gnus-thread-sort-by-number #[(h1 h2) "‰:ƒ‰@;ƒA@@ÁH\n‰:ƒ ‰@;ƒA@@ÁHW‡" [h1 0 h2] 3 (#$ . 167692)]) #@30 Sort threads by root author. (defalias 'gnus-thread-sort-by-author #[(h1 h2) " ‰:ƒ‰@;ƒA@@ÂH!‰@† A)\f‰:ƒ,‰@;ƒ+A@@ÂH!‰@†7 A)™‡" [gnus-extract-address-components h1 2 extract h2] 5 (#$ . 167851)]) #@31 Sort threads by root subject. (defalias 'gnus-thread-sort-by-subject #[(h1 h2) "‰:ƒ‰@;ƒA@@ÁHÃÅÆ\n\"ƒ#\nÇ•ÈO‚$\n*— ‰:ƒ6‰@;ƒ5A@@ÁHÃÅÆ\n\"ƒJ\nÇ•ÈO‚K\n*—™‡" [h1 1 subject t case-fold-search string-match "^re: *" 0 nil h2] 4 (#$ . 168064)]) #@36 Sort threads by root article date. (defalias 'gnus-thread-sort-by-date #[(h1 h2) "À ‰:ƒ‰@;ƒA@@ÂH!À ‰:ƒ#‰@;ƒ\"A@@ÂH!™‡" [gnus-sortable-date h1 3 h2] 4 (#$ . 168322)]) #@98 Sort threads by root article score. Unscored articles will be counted as having a score of zero. (defalias 'gnus-thread-sort-by-score #[(h1 h2) "‰:ƒ‰@;ƒA@@ÁH\nžA† †Á\f‰:ƒ+‰@;ƒ*A@@ÁH\nžA†8 †8ÁV‡" [h1 0 gnus-newsgroup-scored gnus-summary-default-score h2] 3 (#$ . 168500)]) #@115 Sort threads by the sum of all scores in the thread. Unscored articles will be counted as having a score of zero. (defalias 'gnus-thread-sort-by-total-score #[(h1 h2) "À !À\n!V‡" [gnus-thread-total-score h1 h2] 3 (#$ . 168792)]) (defalias 'gnus-thread-total-score #[(thread) ":ƒ@;ƒÁ\nÃÄÅA\"#‡Å!‡ÅC!‡" [thread apply gnus-thread-score-function 0 mapcar gnus-thread-total-score-1] 6]) (defalias 'gnus-thread-total-score-1 #[(root) "@Á\nÃH\fžA† †ÃÆÇÈÉH—\n\"JA\"#‡" [root apply gnus-thread-score-function 0 gnus-newsgroup-scored gnus-summary-default-score mapcar gnus-thread-total-score intern-soft 4 gnus-newsgroup-dependencies] 8]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp gnus-tmp-prev-subject "" current-load-list] 2) #@170 Prepare summary buffer from THREADS and indentation LEVEL. THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' or a straight list of headers. (defalias 'gnus-summary-prepare-threads #[(threads &optional cull) "ÀÁ!ˆÂɉ‰‰‰‰ \n Ì @!ƒ,Î \"ˆ‚r „6ƒr ƒG ‰\n@@ ‚^@‰@ A\nA\n@@  ;ƒØÑ=ƒ¢\n@A@‰Aƒ€A‰‚s\n@AA¡ˆÓÔ\n@AA\"\f¤\n@Aáˆ)Õ ‚OÖ=ƒºÓ×\n@AA\"\f¤Õ ‚OØ=ƒÒÙà \n@A@@ÂH#ˆ‚OÕ ‚O ÂH ÚHƒõ ÜHBBƒH ÂUƒH ÂH‰>ƒ\n„à ‚HƒH žA†-!†-ÂWƒHà â#\"#$B%B% ƒOà  Ã&>ƒ`'‚’>ƒm(‚’#>ƒz)‚’*>ƒ‡+‚’%žA†’,->*>.ƒà/ð1òó\"ƒ¹•ÃO‚»*ð1òó\"ƒÔ•ÃO‚Ö*˜„à‚ ÂUƒÿÖ=ƒú\f>ƒú4‚‚4Ñ=…\f\f> žA5>6789:;<  ‰=„5>=? H@ ÜHA7†M!†MÂ7!ƒcB7!Z!CXƒiD‚x7!WƒvE‚xFG6ƒ„H‚:ƒŽI‚): JHKòLK\"ƒ°K”T•SO‚àòMK\"ƒÞ”NòOK\"ƒÔK”T•SO†ÚKÂNO)‚àKP ÚH ÂHƒùQ‚üRSƒ T‚\fUVÃWÂyˆ`XA§„ ÂAY=!cˆZX‰T[\\;†>)] ¯#. ˆ. /\nA@ƒc ]\nABB T \n@A‰ ‚..À^!‡" [message "Generating summary..." 0 nil gnus-tmp-gathered state stack subject number header thread level vectorp threads gnus-summary-prepare-unthreaded cull gnus-summary-make-false-root adopt th mapcar #[(h) "@ÁH‡" [h 0] 2] -1 empty #[(h) "@ÁH‡" [h 0] 2] dummy gnus-summary-insert-dummy-line 1 gnus-newsgroup-async 7 gnus-newsgroup-threads gnus-newsgroup-dormant gnus-summary-expunge-below gnus-newsgroup-scored gnus-summary-default-score delq gnus-newsgroup-unreads gnus-low-score-mark gnus-newsgroup-reads gnus-newsgroup-marked gnus-ticked-mark gnus-dormant-mark gnus-unread-mark gnus-newsgroup-expirable gnus-expirable-mark gnus-ancient-mark gnus-newsgroup-replied gnus-thread-ignore-subject gnus-tmp-prev-subject t case-fold-search string-match "^re: *" gnus-summary-same-subject gnus-newsgroup-processable process score subject-or-nil expirable replied unread current sformat gnus-summary-line-format-spec gnus-thread-indent-array indentation lines abs gnus-summary-zcore-fuzz 32 gnus-score-below-mark gnus-score-over-mark score-char gnus-process-mark gnus-replied-mark 2 from "(.+)" "<[^>]+> *$" beg "^\"[^\"]*\"" name 60 91 opening-bracket 62 93 closing-bracket buffer-read-only b eval add-text-properties gnus-number gnus-mark gnus-level "Generating summary...done"] 13 (#$ . 169529)]) (defalias 'gnus-summary-prepare-unthreaded #[(headers &optional cull) "À‰ ƒÄÅ\"…¼@A\nÈH ƒ1\nÈH‰\n>„ ƒb ƒb \fžA†I †IÈ WƒbÎ \" BB‚ÒÀ\nÈÀ >ƒs‚¡ \n>ƒ‚¡ >ƒ‹‚¡ >ƒ—‚¡ žA†¡ > >\nÛHÀ \fžA >& ˆ‚*‡" [nil number header gnus-newsgroup-async mapcar #[(h) "ÁHÂHB‡" [h 0 7] 3] headers gnus-newsgroup-threads 0 cull gnus-newsgroup-dormant gnus-summary-expunge-below gnus-newsgroup-scored gnus-summary-default-score delq gnus-newsgroup-unreads gnus-low-score-mark gnus-newsgroup-reads gnus-summary-insert-line gnus-newsgroup-marked gnus-ticked-mark gnus-dormant-mark gnus-unread-mark gnus-newsgroup-expirable gnus-expirable-mark gnus-ancient-mark gnus-newsgroup-replied 1 gnus-newsgroup-processable] 13]) #@89 Select newsgroup GROUP. If READ-ALL is non-nil, all articles in the group are selected. (defalias 'gnus-select-newsgroup #[(group &optional read-all) "À \n\"JÄ 8ÆÈÉ !‰\n!„ËÌ!ˆ ƒ' @Í=ƒ9Î !„9Ïp!ˆËÐ Ñ !#ˆ ÆÔ !ƒW×Ø\"ƒWÙ!Û \"‰„kÝÞß\"ˆà‚ˆá=ƒvÆ‚ˆâG!#Ýäå\"ˆ&ƒ£Æ'è@é=„šéB‚œ\")‚©è\"‰*ë=ƒ¸ì!‚Þ&ƒÜ@é=„ÜŠ-qˆebˆîï!ƒÛ`ðñÆÍ#|ˆ)ò 3Ýäô\"ˆõö÷3\"\" ƒJÆ8ù !ˆúûÞ 8‰8žA!<úý8žA!>úÿ8žA!@úA8žA!BúC8žA!DúE8žA!FúG8žA!HÆI)J;ƒZKJ \"†aLä 8>M3ƒ}3@áH‰Nƒ}O3!áHPQR3†ˆÍ+‡" [intern-soft group gnus-newsrc-hashtb entry 2 info nil articles gnus-check-server gnus-find-method-for-group gnus-current-select-method error "Couldn't open server" t gnus-activate-group kill-buffer "Couldn't request group %s: %s" gnus-status-message gnus-newsgroup-name gnus-newsgroup-unselected gnus-list-of-unread-articles gnus-newsgroup-unreads gnus-asynchronous gnus-check-backend-function request-asynchronous gnus-request-asynchronous gnus-newsgroup-async gnus-articles-to-read read-all gnus-message 3 "Couldn't select newsgroup" quit 0 gnus-make-hashtable gnus-newsgroup-dependencies 5 "Fetching headers..." gnus-fetch-old-headers nntp-nov-gap gnus-retrieve-headers 1 gnus-headers-retrieved-by nov gnus-get-newsgroup-headers-xover nntp-server-buffer looking-at "[0-9]+[ ]+1[ ]" search-forward "\n.\n" gnus-get-newsgroup-headers gnus-newsgroup-headers "Fetching headers...done" gnus-set-sorted-intersection mapcar #[(headers) "ÁH‡" [headers 0] 2] marked gnus-adjust-marked-articles copy-sequence tick gnus-newsgroup-marked reply gnus-newsgroup-replied expire gnus-newsgroup-expirable killed gnus-newsgroup-killed bookmark gnus-newsgroup-bookmarks dormant gnus-newsgroup-dormant score gnus-newsgroup-scored gnus-newsgroup-processable gnus-auto-expirable-newsgroups string-match auto-expire gnus-newsgroup-auto-expire gnus-newsgroup-begin gnus-last-element gnus-newsgroup-end -1 gnus-reffed-article-number] 6 (#$ . 172764)]) (defalias 'gnus-articles-to-read #[(group read-all) "„\f G\nGUƒÃÄ \"J!‚ È \"‰\nG G\f G\nG\\§ƒ<‚@ÏÐщ;ƒNÓ!‚P‰ƒ]ÔUƒb‚¼ ÔU„Õ! XƒÖ\n×\"‰G\f‚‡Ø!Õ!\fWƒ°ÔWƒ¦Õ!S›Ï¡ˆ‚°\fZ›Ù Ú \"\".‡" [read-all gnus-newsgroup-unreads gnus-newsgroup-dormant gnus-uncompress-range intern-soft group gnus-active-hashtb articles gnus-killed-articles gnus-newsgroup-killed scored-list scored number gnus-newsgroup-marked marked nil (byte-code " X„\f\nUƒ1 §ƒ1\n Vƒ1ÄÅÆ\n#!ÉÊ\"ƒ-\n‚/)‡ VƒY\nWƒYÄÅËÌ \n%!ÉÊ\"ƒU\n‚W)‡\n‡" [scored marked number gnus-large-newsgroup read-string format "How many articles from %s (default %d): " gnus-newsgroup-name input string-match "^[ ]*$" "%s %s (%d scored, %d total): " "How many articles from" group] 7) ((quit)) select string-to-number 0 abs sort < copy-sequence gnus-sorted-intersection gnus-sorted-complement gnus-newsgroup-unselected] 6]) (defalias 'gnus-killed-articles #[(killed articles) "À\nƒ{\n@ \fA<„ \f@Y…k \fAX‚kÆ\fƒg\f@§ƒ3 \f@Y‚8 \f@@Yƒgƒg\f@§ƒM \f@U‚Z \f@@Yƒ` \f@AXƒ`À\fA‰„&)?*ƒt\n@ B\nA‰„ )‡" [nil out articles killed ranges number t not-stop] 4]) #@54 Remove all marked articles that are no longer legal. (defalias 'gnus-adjust-marked-articles #[(info &optional active) "À 8\n† à @\f\"Jʼn‰ƒk@‰A@É=„3@Ê=ƒaƒb@ >„J@\f>ƒQ‚XA¡ˆA‰‚5@Í=ƒ™ƒb@@ >„‚@@ >ƒ‰‚A¡ˆA‰‚k@Î=ƒÇƒb@@\n@WƒºA¡ˆ‚¾A‰‚£@Ï=ƒ-ƒû@§ƒá@†å@A\n@WƒûA¡ˆA‰„Ôƒb@§ƒ @†@@\n@Wƒb@§ƒ#‚&@\n@ ˆ‚b@Ð=„=@Ñ=ƒbƒb@\n@WƒUA¡ˆ‚YA‰„BA‰„À 8‰ƒ¹@GÒUƒ†A‰‚v‰A‰ƒ²@GÒUƒ¥A¡ˆ‚©A‰„’À › ˆ„ÊÓ ›„Ê AAÅ¡ˆ, ‡" [3 info active intern-soft gnus-active-hashtb nil prev m marked-lists tick dormant gnus-newsgroup-unreads gnus-newsgroup-unselected score bookmark killed reply expire 1 4] 5 (#$ . 175978)]) #@74 Enter the various lists of marked articles into the newsgroup info list. (defalias 'gnus-set-marked-articles #[(info ticked replied expirable killed dormant bookmark score) "À\nƒ\fÃ\nBÀB\fƒÅ\fB Bƒ\"ÇB Bƒ.ÈB B ƒ:É B B\nƒFÊ\nB B ƒRË B BÌ ›ƒvÌ ›  ˆ ?…Î ›?… AAÀ¡‚ … AA C¡)‡" [nil newmarked ticked tick replied reply expirable expire killed dormant bookmark score 3 info 4] 2 (#$ . 176765)]) (defalias 'gnus-add-marked-articles #[(group type articles &optional info force) "† Á \f\"J8ʼn‰?†[È›‰„.AA \nBCC¡†[ @ž‰„I \nB@B †[ ƒV\n¡‚[\n¤+‡" [info 2 intern-soft group gnus-newsrc-hashtb nil m marked 3 type articles force] 5]) #@135 This function sets the mode line of the article or summary buffers. If WHERE is `summary', the summary mode line format will be used. (defalias 'gnus-set-mode-line #[(where) " >…ÁŠ\fqˆÅ=ƒ‚ \n †%Ì GGZ‰GZGÌUƒNÌUƒNÕ‚dÌUƒ]Ö×\"‚dÖØ#ƒrÛH‚sÕ…Þ Z á!§„“ GâWƒâ GVƒ¯ã äZ\"åPÖ‰æ\" \". 'èé!)‡" [where gnus-updated-mode-lines nil mode-string gnus-summary-buffer article gnus-article-mode-line-format-spec gnus-summary-mode-line-format-spec mformat gnus-newsgroup-name group-name gnus-current-article 0 article-number gnus-newsgroup-unreads gnus-newsgroup-dormant unread gnus-newsgroup-marked unread-and-unticked gnus-newsgroup-unselected unselected "" format "{%d more}" "{%d(+%d) more}" unread-and-unselected gnus-current-headers 1 subject gnus-mode-non-string-length frame-width max-len header eval 4 gnus-truncate-string 3 "..." "%%-%ds" mode-line-buffer-identification set-buffer-modified-p t] 5 (#$ . 177471)]) #@133 Go through the HEADERS list and add all Xrefs to a hash table. The resulting hash table is returned, or nil if no Xrefs were found. (defalias 'gnus-create-xref-hashtb #[(from-newsgroup headers unreads) "À !à !…ÄÅÆ\n@!\">?…È ! ÊËÌ\" ÎÎÎÎÎ΃¬@‰ÖH‰ƒ£ÌH>„£ÌØÙ#ƒ£Ì• Ú”Ú•OPÛܔܕO!Ý \"J‰ƒ”AB¡ˆ‚UÞ \"ÎBLˆ‚UA‰„:…³ . ‡" [gnus-find-method-for-group from-newsgroup from-method gnus-group-foreign-p virtual assoc symbol-name gnus-valid-select-methods gnus-group-real-prefix prefix make-vector 63 0 xref-hashtb nil start group entry number xrefs header headers 8 unreads string-match "\\([^ ]+\\):\\([0-9]+\\)" 1 string-to-int 2 intern-soft intern] 5 (#$ . 178476)]) #@58 Look through all the headers and mark the Xrefs as read. (defalias 'gnus-mark-xrefs-as-read #[(from-newsgroup headers unreads expirable) "ÀÁÂÃ\f!@! \">Ɖ‰‰‰‰‰ \n \f ŠqˆÏ\f#‰\n…8ÒÓ\n\". ‡" [virtual assoc symbol-name gnus-find-method-for-group from-newsgroup gnus-valid-select-methods nil nth4 method idlist xref-hashtb info entry name gnus-group-buffer gnus-create-xref-hashtb headers unreads mapatoms #[(group) "Á\n!‰˜?…ƒ\nJÅ \"JÈ8‰ Ê 8‰ ;ƒ.Ì ! …ƒÍ Î!\"„b„b Î!‰š„b @@š…ƒ A@A@š…ƒ…ƒÒ=ƒ}„} A@X…ƒÔ \f#‡" [from-newsgroup symbol-name group name idlist intern-soft gnus-newsrc-hashtb entry 2 info 4 nth4 gnus-server-to-method gnus-methods-equal-p gnus-find-method-for-group virtual method gnus-use-cross-reference t gnus-level-subscribed gnus-group-make-articles-read expirable] 4]] 8 (#$ . 179217)]) (defalias 'gnus-group-make-articles-read #[(group articles expirable) "À \f\"JÆ 8 \"J Ê Ê\fÊ  ƒ§ÏÐ8žAÑÐ8žAʉÊ ƒ¦@ƒd AVƒdÖ !†b   AV„† @W„†>„†>ƒŽ×\"\f>ƒ B A‰„G-ØÊÌ $ˆ ƒÐÆ8„Ð @ÙVƒÐAAÙ @SB ˆAAÚÆ8ÛÜ\"‰\"‰  ˆ …^ „ý AT @Z‚B A<„ A AT @ZZ‚B ƒ< @§ƒ& T‚3  @AT @@Z\\ A‰ „ A Z À ÏÐ8žAGZÑÐ8žAGZ] ˆÝ Þ\".‡" [0 num intern-soft group gnus-newsrc-hashtb entry 2 info gnus-active-hashtb active nil exps expirable range articles tick 3 dormant first id ticked ids gnus-activate-group delq gnus-add-marked-articles 1 gnus-add-to-range sort < gnus-group-update-group t] 7]) (defalias 'gnus-methods-equal-p #[(m1 m2) "† \n†\n ‰\nš†/@\n@=…/ÃÄÅ@!\">?†/A@\nA@š*‡" [m1 gnus-select-method m2 address assoc symbol-name gnus-valid-select-methods] 5]) (defalias 'gnus-header-value #[nil "À•`ˆ` bˆ){‡" [0 p nil] 3]) (byte-code "ÀÁÂÃ#ˆÄÅ!„ÆÅBÀ‡" [put gnus-header-value byte-optimizer byte-compile-inline-expand boundp gnus-newsgroup-none-id 0 current-load-list] 4) (defalias 'gnus-get-newsgroup-headers #[nil "À\n À‰‰‰‰ \nŠ\nqˆebˆËÌÀÍ#ƒ*ÎÏÀ\"Í`ÀÀÀÔÕ\n!IˆŒ`ŠÖ×ÀÍ#)†N`}ˆÖØÀÍ#ƒoÙÔ•`Àˆ`bˆ){Iˆ‚uÙÚIˆbˆÖÛÀÍ#ƒ˜ÜÔ•`Àˆ`bˆ){Iˆ‚žÜÝIˆbˆÖÞÀÍ#ƒ¾ßÔ•`Àˆ`bˆ){IˆbˆÖàÀÍ#…ÒáÕ\n!I§„ÜáÔIˆbˆÖâÀÍ#ƒüãÔ•`Àˆ`bˆ){IˆbˆÖäÀÍ#ƒ\"åÔ•`Àˆ`bˆ){‰Iˆ‚4åæç(T‰(!P‰IˆbˆÖéÀÍ#ƒqêÔ•`Àˆ`bˆ){IˆÔ•ŠÀˆëì Í#ˆ`Tëí Í#ˆ`{—)‚¬ÖîÀÍ#ƒªÔ•`Àˆ`bˆ){‰ƒªïð\"ƒªêÔ”Ô•O‰Iˆ\f—‚¬ñòó— \"‰!ƒìJ@ƒâJ@ßJ@ßH†ÑôßH†ÙôPIˆÀ‚óJ ˆ‚óCLˆƒ#òó\f \"‰!ƒJJAB¡ˆ‚ÀDLˆBdbˆ-‚)Ÿ.‡" [nil gnus-article-internal-prepare-hook nntp-server-buffer gnus-newsgroup-dependencies ref end dep id headers dependencies cur re-search-forward "^[23][0-9]+ " t make-vector 9 in-reply-to p case-fold-search header 0 read search-forward "\n.\n" "\nfrom: " 2 "(nobody)" "\nsubject: " 1 "(none)" "\nxref: " 8 "\nlines: " 7 "\ndate: " 3 "\nmessage-id: " 4 "none+" int-to-string gnus-newsgroup-none-id "\nreferences: " 5 search-backward ">" "<" "\nin-reply-to: " string-match "<[^>]+>" "none" boundp intern ""] 7]) (defalias 'gnus-nov-read-integer '(macro . #[nil "À‡" [(prog1 (if (= (following-char) 9) 0 (let ((num (condition-case nil (read buffer) (error nil)))) (if (numberp num) num 0))) (or (eobp) (forward-char 1)))] 1])) (defalias 'gnus-nov-skip-field '(macro . #[nil "À‡" [(search-forward " " eol (quote move))] 1])) (defalias 'gnus-nov-field '(macro . #[nil "À‡" [(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))] 1])) #@132 Parse the news overview data in the server buffer, and return a list of headers that match SEQUENCE (see `nntp-retrieve-headers'). (defalias 'gnus-get-newsgroup-headers-xover #[(sequence) "À\n ĉ‰ Š\nqˆebˆ\nƒgm„gË !\nƒ=\n@Wƒ=\nA‰\n„+\nƒa\n@=ƒa\nA\nÌ\"‰ƒa BÍyˆ‚Ÿ)-‡" [(gnus-article-get-xrefs) gnus-article-internal-prepare-hook nntp-server-buffer gnus-newsgroup-dependencies nil header headers number dependencies cur sequence read gnus-nov-parse-line 1] 6 (#$ . 182754)]) (defalias 'gnus-nov-parse-line #[(number dependencies) "À`ˆ` bˆ)p‰‰‰ `}ˆm„'ÂuˆÂÊˈ~ˆƒsÌÍ\f—\"‰!ƒm J@ƒd J@Ï J@ÏH†SÐÏH†[ÐPIˆÂ‚s J ˆ‚s CLˆƒœÌÍ †Ñ\"‰!ƒ• J JAB¡ˆ‚œ ÂDLˆ.‡" [0 p nil dep id ref header buffer eol none (byte-code "À `ÂÃ\fÅ#ƒ`S‚\f{`ÂÃ\fÅ#ƒ `S‚!\f{`ÂÃ\fÅ#ƒ0`S‚1\f{`ÂÃ\fÅ#ƒ@`S‚A\f{†OÆÇT‰!P‰ Š`\nÂÃ\f\"ˆËÌ\nÍ#ƒu`TËÎ\nÍ#ˆ`{—‚xÐ*`ÂÃ\fÅ#ƒ‡`S‚ˆ\f{gÑUƒ“Ò‚¥ÐÓÔ‰§ƒ£‚¤Ò)m„¬ÖuˆgÑUƒ¶Ò‚ÈÐ×؉§ƒÆ‚ÇÒ)m„ÏÖuˆgÙU?…æ`ÂÃ\fÅ#ƒä`S‚å\f{& Ї" [vector number search-forward " " eol move "none+" int-to-string none id beg search-backward ">" t "<" ref nil 9 0 (read buffer) ((error)) num 1 (read buffer) ((error)) 10 header] 15) ((error (byte-code "À ˆÁÂ!ˆÃ b‡" [ding message "Strange nov line." nil header eol] 2))) boundp intern dependencies 8 "" "none"] 7]) #@133 Fill in the Xref value in `gnus-current-headers', if necessary. This is meant to be called in `gnus-article-internal-prepare-hook'. (defalias 'gnus-article-get-xrefs #[nil "Šqˆ ) ?†U\n?†U\nÄHƒ \nÄHŘ?†UÆÇ ŒÊ ˆebˆg—Ë=ƒ:ÌÍ!„BÎÏÇÆ#…TЕTbˆ`Lj`{\nÄI+)‡" [gnus-summary-buffer gnus-current-headers headers gnus-use-cross-reference 8 "" t nil xref case-fold-search gnus-narrow-to-headers 120 looking-at "Xref:" search-forward "\nXref:" 0] 4 (#$ . 184132)]) (byte-code "ÀÁÂ\"ˆÃÁÂ\"‡" [defalias gnus-find-header-by-number gnus-get-header-by-number make-obsolete] 3) #@67 Make hashtable for the variable gnus-newsgroup-headers by number. (defalias 'gnus-make-headers-hashtable-by-number #[nil "Šqˆ ÂÅ\fG!\f…)\f@ÇÈ ÉH!\" Lˆ\fA‰„Â+‡" [gnus-summary-buffer gnus-newsgroup-headers nil header headers gnus-make-hashtable gnus-newsgroup-headers-hashtb-by-number intern int-to-string 0] 5 (#$ . 184711)]) #@27 Find new header backward. (defalias 'gnus-more-header-backward #[nil "À \n\"J@ Ä „'Vƒ'SÈ!‰ƒ +‡" [intern-soft gnus-newsgroup-name gnus-active-hashtb gnus-newsgroup-begin nil header artnum first gnus-read-header] 4 (#$ . 185054)]) #@73 Find new header forward. If BACKWARD, find new header backward instead. (defalias 'gnus-more-header-forward #[(&optional backward) "ƒÁ ‡Â \f\"JA Æ „1 Wƒ1TÊ!‰ƒ+‡" [backward gnus-more-header-backward intern-soft gnus-newsgroup-name gnus-active-hashtb gnus-newsgroup-end nil header artnum last gnus-read-header] 4 (#$ . 185309)]) #@98 Extend newsgroup selection with HEADER. Optional argument BACKWARD means extend toward backward. (defalias 'gnus-extend-newsgroup #[(header &optional backward) "…,ÁH ƒ\fB‚\fC¤Å\n\"\n^\n]‰)‡" [header 0 artnum backward gnus-newsgroup-headers delq gnus-newsgroup-unselected gnus-newsgroup-begin gnus-newsgroup-end] 3 (#$ . 185669)]) #@162 Return a list of articles to be worked upon. The prefix argument, the list of process marked articles, and the current article will be taken into consideration. (defalias 'gnus-summary-work-articles #[(n) "À\nƒM\n§ƒM\nÃWÄ\n!Š\nÃVƒDÆ`Ãyˆ`bˆ)È\"†. B‰ƒDÊ À‰#ƒD\nS‰‚)Ë Ì\"*‚iÍ!†iÆ`Ãyˆ`bˆ)È\"†h C)‡" [nil articles n 0 abs backward get-text-property p gnus-number gnus-current-article gnus-summary-search-subject sort < reverse gnus-newsgroup-processable] 5 (#$ . 186029)]) #@102 Search for next unread newsgroup. If optional argument BACKWARD is non-nil, search backward instead. (defalias 'gnus-summary-search-group #[(&optional backward use-level) "ŠqˆÁ\nÃ\f… Å #…Æ )‡" [gnus-group-buffer gnus-group-search-forward backward nil use-level gnus-group-group-level gnus-group-group-name] 4 (#$ . 186533)]) #@84 Find the name of the best unread group. If EXCLUDE-GROUP, do not go to this group. (defalias 'gnus-summary-best-group #[(&optional exclude-group) "ŠqˆŠÁ\n!*‡" [gnus-group-buffer gnus-group-best-unread-group exclude-group] 2 (#$ . 186868)]) (defalias 'gnus-subject-equal #[(s1 s2) "„1 ÃÅÆ\n\"ƒ\nÇ•ÈO‚\n* ÃÅÆ\n\"ƒ-\nÇ•ÈO‚.\n*š‡Ê=ƒ@Ë !Ë !š‡§ƒ| \f‰ G\fVƒ\\ Ç\fO‚^ * \f‰ G\fVƒw Ç\fO‚y *š‡  š‡" [gnus-summary-gather-subject-limit s1 subject t case-fold-search string-match "^re: *" 0 nil s2 fuzzy gnus-simplify-subject-fuzzy width str] 5]) #@211 Search for article forward. If BACKWARD is non-nil, search backward. If UNREAD is non-nil, only unread articles are selected. If SUBJECT is non-nil, the article which has the same subject will be searched for. (defalias 'gnus-summary-search-subject #[(&optional backward unread subject) "ƒÁ‚ Â`Ãĉ Êyˆ ƒ0\fƒ0Í`Î\"=ƒ0ă}ƒEoƒAÊ‚NЂNmƒMÊ‚NÑuˆ `Ò\"‰ƒ}ƒeS‚gbƒ}\fƒzÍ`Î\"=…^?†^Í`Êyˆ`bˆ)Ò\"†”ĉ…·ØÙ!\"J‰…·Û!…·ÑH*‰…^ „Ãàá\"ƒáÊ•ÄO‚ã*Ãàá\"ƒüÊ•ÄO‚þ*š‚]â=ƒã!ã!š‚]§ƒX$‰%G$Vƒ5%Ê$O‚7%*$‰%G$VƒQ%Ê$O‚S%*š‚]š*?‰ƒ}ƒso„}Ðuˆ‚Pm„}Ñuˆ‚PƒŠbˆÄ‚”Í`Ò\"æ ˆç ˆ-‡" [backward previous-single-property-change next-single-property-change t nil psubject pos did beg func 0 gnus-summary-check-current unread get-text-property gnus-mark gnus-unread-mark -1 1 gnus-number subject p gnus-current-article header article intern-soft int-to-string gnus-newsgroup-headers-hashtb-by-number vectorp s2 s1 gnus-summary-gather-subject-limit case-fold-search string-match "^re: *" fuzzy gnus-simplify-subject-fuzzy width str gnus-summary-show-thread gnus-summary-position-cursor] 5 (#$ . 187448)]) #@54 The thread level of the article on the current line. (defalias 'gnus-summary-pseudo-article #[nil "À`Âyˆ` bˆ)Ã\"‡" [get-text-property p 0 gnus-pseudo] 3 (#$ . 188676)]) (byte-code "ÀÁÂ\"ˆÃÁÂ\"‡" [defalias gnus-summary-score gnus-summary-article-score make-obsolete] 3) #@31 Return current article score. (defalias 'gnus-summary-article-score #[nil "À`Âyˆ` bˆ)Ã\"†\f žA††‡" [get-text-property p 0 gnus-number gnus-current-article gnus-newsgroup-scored gnus-summary-default-score] 3 (#$ . 188952)]) #@146 Center point in the summary window. If `gnus-auto-center-summary' is nil, or the article buffer isn't displayed, no centering will be performed. (defalias 'gnus-summary-recenter #[nil "À ÁWƒ ‚À ÃWƒÄ‚ÅÀ SŠdbˆ[yˆ`)Ép!\n …KÉ\f!…KÍ\nŠ[yˆ`)^\",‡" [window-height 4 0 7 1 2 top height bottom get-buffer-window window gnus-auto-center-summary gnus-article-buffer set-window-start] 4 (#$ . 189192)]) #@29 Collapse GROUP name LEVELS. (defalias 'gnus-short-group-name #[(group &optional levels) "ÀÀÃņ$ÈÉ\n#ƒ#Ë•\fÅ\\‚\fÈÌ\n\"ƒ=\nˉ•O\nË•ÍO\n\nƒ{ÈÉ\n\"ƒnËVƒn \nËÅOP\nË•ÍO\nÅZ ÎP‚=\n \nQ͉\n„B -‡" ["" name foreign -1 depth 1 skip levels string-match "\\." group 0 ":" nil "."] 5 (#$ . 189615)]) #@47 Move point to NEWSGROUP in group mode buffer. (defalias 'gnus-summary-jump-to-group #[(newsgroup) "pÀ !=ƒ ‹‡ŠÃ !ƒÄ !ˆ‚ qˆÅ!)‡" [get-buffer gnus-group-buffer ((byte-code "À !ƒ\n !ˆÃ\f!‡" [get-buffer-window gnus-group-buffer pop-to-buffer gnus-group-jump-to-group newsgroup] 2)) get-buffer-window pop-to-buffer gnus-group-jump-to-group newsgroup] 3 (#$ . 189954)]) (defalias 'gnus-list-of-unread-articles #[(group) "À‰Á\n \"J88Á\n \"J‰AÈ È\nÈ \f„*@ ‚\fA<„8\fAT ‚\f@§ƒC\f@†F\f@@‰\nÌU„QÌ \fƒ ƒr \nWƒr  B  T‰ ‚\\\f@:„}\f@‚€\f@AT \fA@:„\fA@‚”\fA@@\n\fA‰„U Xƒµ  B  T‰ ‚Ÿ Ÿ.‡" [2 intern-soft group gnus-newsrc-hashtb read gnus-active-hashtb active last nil first nlast unread 1] 6]) (defalias 'gnus-list-of-read-articles #[(group) "ÀÁ\n \"J8Á\n\f\"J‰… …ÇÈ !É\n!\"*‡" [2 intern-soft group gnus-newsrc-hashtb gnus-active-hashtb active info gnus-sorted-complement gnus-uncompress-range gnus-list-of-unread-articles] 5]) #@69 Perform any operation on all articles marked with the process mark. (defalias 'gnus-summary-universal-argument #[nil "À ˆÁ\n!É„ÆÇ!ˆÈÉÊ!!‰„ÆË!ˆ …9Ì @!ˆÍ\f!ˆÎ @!ˆ A‰„#Ã*‡" [gnus-set-global-variables reverse gnus-newsgroup-processable nil func articles error "No articles marked" key-binding read-key-sequence "C-c C-u" "Undefined key" gnus-summary-goto-subject command-execute gnus-summary-remove-process-mark] 4 (#$ . 190943) nil]) #@92 Toggle truncation of summary lines. With arg, turn line truncation on iff arg is positive. (defalias 'gnus-summary-toggle-truncation #[(&optional arg) "„ ?‚Â!ÃVÄ ‡" [arg truncate-lines prefix-numeric-value 0 redraw-display] 2 (#$ . 191391) "P"]) #@106 Once exit and then reselect the current newsgroup. The prefix argument ALL means to select all articles. (defalias 'gnus-summary-reselect-current-group #[(&optional all) "À ˆÁ`Ãyˆ`\nbˆ)Ä\"† É\nËÌ!ˆÍ!ˆÎÌ\"ˆÐ!*‡" [gnus-set-global-variables get-text-property p 0 gnus-number gnus-current-article gnus-newsgroup-name group current-subject nil gnus-newsgroup-begin gnus-summary-exit t gnus-summary-jump-to-group gnus-group-read-group all gnus-summary-goto-subject] 3 (#$ . 191651) "P"]) #@69 Exit the newsgroup, ask for new articles, and select the newsgroup. (defalias 'gnus-summary-rescan-group #[(&optional all) "À ˆ à ˆÄ\n!ˆŠ qˆÆÇ!ˆ)Ä\n!ˆÈ !)‡" [gnus-set-global-variables gnus-newsgroup-name group gnus-summary-exit gnus-summary-jump-to-group gnus-group-buffer gnus-group-get-new-news-this-group 1 gnus-group-read-group all] 2 (#$ . 192155) "P"]) (defalias 'gnus-summary-update-info #[nil "\nƒ\"ÃÄÅ!ÇÉ\"‰\"Ç\nÉ\"‰\n¤Ë\"A<„.C\f Î !ˆÏÐ!ˆÑ \nË…T& ˆƒfÚ  \n$ˆƒnÜ ˆƒ|Þß!ƒ|ß ˆ qˆá!†‰â !*‡" [gnus-newsgroup-name group gnus-newsgroup-kill-headers gnus-compress-sequence gnus-set-sorted-intersection gnus-uncompress-range gnus-newsgroup-killed sort gnus-newsgroup-unselected < gnus-newsgroup-unreads t gnus-newsgroup-headers headers gnus-close-group run-hooks gnus-exit-group-hook gnus-update-read-articles gnus-newsgroup-marked gnus-newsgroup-replied gnus-newsgroup-expirable gnus-newsgroup-dormant gnus-newsgroup-bookmarks gnus-save-score gnus-newsgroup-scored gnus-use-cross-reference gnus-mark-xrefs-as-read gnus-newsgroup-adaptive gnus-score-adaptive gnus-use-scoring fboundp gnus-score-save gnus-group-buffer gnus-ephemeral-group-p gnus-group-update-group] 12]) #@149 Exit reading current newsgroup, and then return to group selection mode. gnus-exit-group-hook is called with no arguments if that value is non-nil. (defalias 'gnus-summary-exit #[(&optional temporary) "À ˆÁ ˆ\nÄ\n!pÉÊ!ˆË ˆqˆ\fƒ&Í ˆqˆ „6Ï !ˆÐÑ!ˆ?…¶qˆÓ ˆÔÃÕ\"ˆÓ ˆÖ=ƒmƒm;ƒaׂbØ!ƒmÙ!ˆ×!ƒyÛ!ˆÞ!ˆ „‘Ï !ˆÐÑ!ˆ‚³Ø @!„ ÔÃÕ\"ˆ‚³ @qˆÖ=ƒ®À ˆÔ A!ˆÉß!,‡" [gnus-set-global-variables gnus-kill-save-kill-buffer gnus-newsgroup-name group gnus-group-quit-config quit-config major-mode mode buf run-hooks gnus-summary-prepare-exit-hook gnus-summary-update-info gnus-use-cache gnus-cache-possibly-remove-articles gnus-group-buffer gnus-group-jump-to-group gnus-group-next-unread-group 1 temporary gnus-summary-clear-local-variables gnus-configure-windows force gnus-summary-mode get-buffer buffer-name kill-buffer gnus-article-buffer bury-buffer gnus-select-method gnus-current-select-method pop-to-buffer gnus-summary-exit-hook] 3 (#$ . 193393) nil]) (defalias (quote gnus-summary-quit) (quote gnus-summary-exit-no-update)) #@68 Quit reading current newsgroup without updating read article info. (defalias 'gnus-summary-exit-no-update #[(&optional no-questions) "À ˆ Ã\n! „„ÇÈ!…rÉ\n!ˆÊ ˆ qˆÊ ˆÌÂÍ\"ˆÎ!ƒ7Ð!ˆÎ!ƒCÒ!ˆÓ \nšƒNÔÕ!ˆ\f…rÖ\f@!„`ÌÂÍ\"‚r\f@qˆØ=ƒnÀ ˆÌ\fA!*‡" [gnus-set-global-variables gnus-newsgroup-name group gnus-group-quit-config quit-config no-questions gnus-expert-user gnus-y-or-n-p "Do you really wanna quit reading this group? " gnus-close-group gnus-summary-clear-local-variables gnus-group-buffer gnus-configure-windows force get-buffer gnus-summary-buffer kill-buffer gnus-article-buffer bury-buffer gnus-group-group-name gnus-group-next-unread-group 1 buffer-name major-mode gnus-summary-mode] 3 (#$ . 194456) nil]) #@38 Fetch the FAQ for the current group. (defalias 'gnus-summary-fetch-faq #[(group) "À !‰… ÄÅ!)‡" [nil gnus-faq-buffer gnus-group-fetch-faq group gnus-configure-windows summary-faq] 2 (#$ . 195194) (list gnus-newsgroup-name)]) #@33 Describe the current newsgroup. (defalias 'gnus-summary-describe-group #[(&optional force) "À \n\"‡" [gnus-group-describe-group force gnus-newsgroup-name] 3 (#$ . 195428) "P"]) #@41 Describe summary mode commands briefly. (defalias 'gnus-summary-describe-briefly #[nil "ÀÁÂÃ!\"‡" [gnus-message 6 substitute-command-keys "\\\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"] 4 (#$ . 195611) nil]) #@215 Exit current newsgroup and then select next unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected initially. If NEXT-GROUP, go to this group. If BACKWARD, go to previous group instead. (defalias 'gnus-summary-next-group #[(&optional no-article target-group backward) "À ˆ pÂÆÇ!ˆ ?…}qˆÉ !ˆ\n†2 Ì=ƒ,Í !‚2Î \"‰\n„HÐÑÒ\"ˆÇ\fqˆÆ ˆ‚ É\n!ˆÓ ‰Ç=„cƒsÕU„sÖ\nÂ\f$ƒsÇ‚y\nÂ\n)‚ +‡" [gnus-set-global-variables gnus-newsgroup-name nil entered current-buffer current-group gnus-summary-exit t gnus-group-buffer gnus-group-jump-to-group target-group gnus-keep-same-level best gnus-summary-best-group gnus-summary-search-group backward gnus-message 5 "Returning to the group buffer" gnus-group-group-unread unreads 0 gnus-summary-read-group no-article] 6 (#$ . 196040) "P"]) #@182 Exit current newsgroup and then select next unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected initially. If BACKWARD, go to previous group instead. (defalias 'gnus-summary-next-group-old #[(&optional no-article group backward) "À ˆ pÂqˆƒ5È \"J@‰§ƒ& ÊW„* „5Ë!ˆÂ‚9Ë !ˆÌ !ˆ†GÌ !\fqˆÎÏ!ˆ„[ÐÏ!‚ûË !ˆÌ !ÑÒÓ#ˆqˆË!ˆÕ=„£ÖÂ\f$ˆ ˜…ûØ\f!…ûÙ\f!…û\f‰qˆÐÏ!‚ûË !ˆÌ !ÖÂ\f$ˆ ˜ƒçØ\f!ƒçÙ\f!ƒçÜ ˜„çqˆÖÜ ‰Â\f$ˆ‚ºÜ ˜…úÙ\f!…ú\fqˆÎ ),‡" [gnus-set-global-variables gnus-newsgroup-name nil num sumbuf ingroup gnus-group-buffer group intern-soft gnus-newsrc-hashtb 1 gnus-group-jump-to-group gnus-summary-search-group backward gnus-summary-exit t gnus-summary-exit-no-update gnus-message 5 "Selecting %s..." gnus-auto-select-next quietly gnus-summary-read-group no-article bufferp buffer-name gnus-summary-buffer prevgroup gnus-group-group-name] 5 (#$ . 196871) "P"]) #@143 Exit current newsgroup and then select previous unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected initially. (defalias 'gnus-summary-prev-group #[(&optional no-article) "À ÂÃ#‡" [gnus-summary-next-group no-article nil t] 4 (#$ . 197834) "P"]) #@132 Go to the first unread subject. If UNREAD is non-nil, go to the first unread article. Returns nil if there are no unread articles. (defalias 'gnus-summary-first-subject #[(&optional unread) "„ eb‚$Áed $‰…\fb)ƒÅ‚$ÆÇÈ\"ˆÉÊ ˆ‡" [unread text-property-any gnus-mark gnus-unread-mark point t gnus-message 3 "No more unread articles" nil gnus-summary-position-cursor] 6 (#$ . 198117) "P"]) #@219 Go to next N'th summary line. If N is negative, go to the previous N'th subject line. If UNREAD is non-nil, only unread articles are selected. The difference between N and the actual number of steps taken is returned. (defalias 'gnus-summary-next-subject #[(n &optional unread dont-display) "ÁWÂ!ÁVƒÄ Æ#ƒS‰‚ ÁU„1ÇÈÉ ƒ.Ê‚/Ë#ˆ\f„<Í ˆÎ ˆ*‡" [n 0 abs backward gnus-summary-search-subject unread nil gnus-message 7 "No more%s articles" " unread" "" dont-display gnus-summary-recenter gnus-summary-position-cursor] 5 (#$ . 198517) "p"]) #@38 Go to next N'th unread summary line. (defalias 'gnus-summary-next-unread-subject #[(n) "À Â\"‡" [gnus-summary-next-subject n t] 3 (#$ . 199074) "p"]) #@108 Go to previous N'th summary line. If optional argument UNREAD is non-nil, only unread article is selected. (defalias 'gnus-summary-prev-subject #[(n &optional unread) "À [\n\"‡" [gnus-summary-next-subject n unread] 3 (#$ . 199231) "p"]) #@42 Go to previous N'th unread summary line. (defalias 'gnus-summary-prev-unread-subject #[(n) "À [Â\"‡" [gnus-summary-next-subject n t] 3 (#$ . 199474) "p"]) #@33 Go the subject line of ARTICLE. (defalias 'gnus-summary-goto-subject #[(article) "„ÁÂ!ˆ`ÄedÅ$‰…b)…GÇ ˆÈ` Êyˆ` bˆ)Ë\"\f=ƒ8Íyˆm„@‚D bˆÎÏ ˆ)‡" [article error "No article number" b text-property-any gnus-number point gnus-summary-show-thread get-text-property p 0 gnus-mark gnus-dummy-mark 1 nil gnus-summary-position-cursor] 6 (#$ . 199635) (list (string-to-int (completing-read "Article number: " (mapcar (lambda (headers) (list (int-to-string (mail-header-number headers)))) gnus-newsgroup-headers) nil (quote require-match))))]) #@119 Make the summary buffer take up the entire Emacs frame. Given a prefix, will force an `article' buffer configuration. (defalias 'gnus-summary-expand-window #[(&optional arg) "À ˆ ƒ\fÂÃÄ\"‡ÂÅÄ\"‡" [gnus-set-global-variables arg gnus-configure-windows article force summary] 3 (#$ . 200190) "P"]) #@36 Display ARTICLE in article buffer. (defalias 'gnus-summary-display-article #[(article &optional all-header) "À ˆ …? \"Ä ˆÅ`Çyˆ`bˆ)È\" =ƒ)ÊyˆË ˆÌÍ!ˆÎ ˆÏ !ˆÐ ˆÑ žA!ˆ‡" [gnus-set-global-variables article gnus-article-prepare all-header gnus-summary-show-thread get-text-property p 0 gnus-mark gnus-dummy-mark 1 gnus-summary-position-cursor run-hooks gnus-select-article-hook gnus-summary-recenter gnus-summary-goto-subject gnus-summary-update-line gnus-article-set-window-start gnus-newsgroup-bookmarks] 4 (#$ . 200492)]) #@246 Select the current article. If ALL-HEADERS is non-nil, show all header fields. If FORCE is non-nil, the article will be re-fetched even if it already present in the article buffer. If PSEUDO is non-nil, pseudo-articles will also be displayed. (defalias 'gnus-summary-select-article #[(&optional all-headers force pseudo article) "„ Á ƒ ÂÃ!ˆ\f†%Å`Çyˆ`bˆ)È\"†% \n??Ë\f\nŠ qˆ ƒ[ƒ[Ï!ƒ[\fA=ƒ[@šƒ[ƒhÓ\f\n\"ˆ\f‰\f‚v\n„rƒuÕ ˆË)\fƒ„Ö\fžA!ˆ+‡" [pseudo gnus-summary-pseudo-article error "This is a pseudo-article." article get-text-property p 0 gnus-number gnus-current-article all-headers nil did gnus-summary-buffer gnus-article-current get-buffer gnus-article-buffer gnus-newsgroup-name force gnus-summary-display-article gnus-show-all-headers gnus-article-show-all-headers gnus-article-set-window-start gnus-newsgroup-bookmarks] 4 (#$ . 201029)]) #@20 Obsolete function. (defalias 'gnus-summary-set-current-mark #[(&optional current-mark) "À‡" [nil] 1 (#$ . 201923)]) #@192 Select the next article. If UNREAD, only unread articles are selected. If SUBJECT, only articles with SUBJECT are selected. If BACKWARD, the previous article is selected instead of the next. (defalias 'gnus-summary-next-article #[(&optional unread subject backward) "À ˆÁÃ\f #ƒAÇÈ` Êyˆ` bˆ)Ë\"†#\f!„<È` Êyˆ` bˆ)Í\"=ƒAÏ ‚èƒoƒoÑ „eÈ` Êyˆ` bˆ)Í\"=ƒoÏ ˆÒÓÔ\"‚胮 „®„®Ö\f!‰ƒ®×\n\f\"ˆÁ\fƒ•e‚–dbˆÙ\nC!ˆ)Ú\fƒ¨‚ª!‚èÝ!„ºß!ˆ !â=ƒÊã!‚Ïä\f!\"%&çèp!!ˆ)„îÒêë ƒéì‚êí#‚ç)î=ƒ%Ý!ƒï ‚çÒêð ƒ\fì‚ í%ƒñ%P‚ò$ˆóÁ%\f#‚çôÁ565ƒ856>ƒºÒê÷ ƒCì‚Dí%ƒdÝ!„døùú&!%û%<\"J@$‚møýú&!#$ˆþ ‰?<ƒ~?@‚€?‰56>ƒ¶p@AB!ˆ%ƒŸC%!ˆÁDEˆF %A@!ˆ))‚+5&šƒÜ%ƒÎÝ!ƒÓï ‚æóÁ%\f#‚æGH5!!**)‡" [gnus-set-global-variables nil header gnus-summary-search-subject backward unread subject gnus-summary-display-article get-text-property p 0 gnus-number gnus-current-article gnus-mark gnus-canceled-mark gnus-summary-position-cursor gnus-auto-select-same gnus-summary-first-unread-article gnus-message 6 "Wrapped" gnus-auto-extend-newsgroup gnus-more-header-forward gnus-extend-newsgroup buffer-read-only gnus-summary-prepare-threads gnus-summary-goto-article gnus-newsgroup-begin gnus-newsgroup-end gnus-ephemeral-group-p gnus-newsgroup-name gnus-summary-jump-to-group last-command-char gnus-keep-same-level best gnus-summary-best-group gnus-summary-search-group group cmd select-window get-buffer-window gnus-auto-select-next 7 "No more%s articles" " unread" "" quietly gnus-summary-exit "No more%s articles (%s)..." "selecting " "exiting" gnus-summary-next-group (14 16) key keystrokes "No more%s articles%s" format " (Type %s for %s [%s])" single-key-description intern-soft gnus-newsrc-hashtb " (Type %s to exit %s)" read-char event obuf switch-to-buffer gnus-group-buffer gnus-group-jump-to-group (byte-code "ÀÁ\n!!‡" [execute-kbd-macro char-to-string key] 3) ((error (ding))) gnus-group-group-name execute-kbd-macro char-to-string] 12 (#$ . 202046) "P"]) #@42 Select unread article after current one. (defalias 'gnus-summary-next-unread-article #[nil "ÀÁ\n…à \"‡" [gnus-summary-next-article t gnus-auto-select-same gnus-summary-subject-string] 3 (#$ . 204091) nil]) #@100 Select the article after the current one. If UNREAD is non-nil, only unread articles are selected. (defalias 'gnus-summary-prev-article #[(&optional unread subject) "À \nÃ#‡" [gnus-summary-next-article unread subject t] 4 (#$ . 204306) "P"]) #@42 Select unred article before current one. (defalias 'gnus-summary-prev-unread-article #[nil "ÀÁ\n…à \"‡" [gnus-summary-prev-article t gnus-auto-select-same gnus-summary-subject-string] 3 (#$ . 204554) nil]) #@278 Show next page of selected article. If end of article, select next article. Argument LINES specifies lines to be scrolled up. If CIRCULAR is non-nil, go to the start of the article instead of instead of selecting the next article when reaching the end of the current article. (defalias 'gnus-summary-next-page #[(&optional lines circular) "pÁ ˆÂ`Äyˆ` bˆ)Å\"†Ç ÊÉ!ˆƒ< ƒ<  AUƒ< @\fš„DÍ !ˆ‚{Î ÐŽÑ!ˆÓ!*ƒ{ƒfÖ ˆ‚{ƒs×ØÙ\"ˆ‚{„{Ú ˆÛ ˆÜ *‡" [gnus-summary-buffer gnus-set-global-variables get-text-property p 0 gnus-number gnus-current-article nil endp article gnus-configure-windows gnus-article-current gnus-newsgroup-name gnus-summary-display-article selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer gnus-article-next-page lines circular gnus-summary-beginning-of-article gnus-message 3 "End of message" gnus-summary-next-unread-article gnus-summary-recenter gnus-summary-position-cursor] 3 (#$ . 204769) "P"]) #@93 Show previous page of selected article. Argument LINES specifies lines to be scrolled down. (defalias 'gnus-summary-prev-page #[(&optional lines) "À ˆÁ`Ãyˆ`\nbˆ)Ä\"† ÇÆ!ˆ ƒ5ƒ5AUƒ5@ š„=Ê!ˆ‚QË ˆÌ  ÎŽÏ!ˆÑ!ˆ*)Ó ‡" [gnus-set-global-variables get-text-property p 0 gnus-number gnus-current-article article gnus-configure-windows gnus-article-current gnus-newsgroup-name gnus-summary-display-article gnus-summary-recenter selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer gnus-article-prev-page lines gnus-summary-position-cursor] 3 (#$ . 205786) "P"]) #@119 Scroll up (or down) one line current article. Argument LINES specifies lines to be scrolled up (or down if negative). (defalias 'gnus-summary-scroll-up #[(lines) "À ˆÁÂ!ˆÃĉÅ#„>Æ ÈŽÉ\n!ˆ ÌVƒ0Í !ƒ=ÎÏÐ\"ˆ‚= ÌWƒ=Ñ [!ˆ*Ò ˆÓ ‡" [gnus-set-global-variables gnus-configure-windows article gnus-summary-select-article nil pseudo selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer lines 0 gnus-article-next-page gnus-message 3 "End of message" gnus-article-prev-page gnus-summary-recenter gnus-summary-position-cursor] 4 (#$ . 206427) "p"]) #@64 Select next article which has the same subject as current one. (defalias 'gnus-summary-next-same-subject #[nil "À ˆÁÂà \"‡" [gnus-set-global-variables gnus-summary-next-article nil gnus-summary-subject-string] 3 (#$ . 207037) nil]) #@68 Select previous article which has the same subject as current one. (defalias 'gnus-summary-prev-same-subject #[nil "À ˆÁÂà \"‡" [gnus-set-global-variables gnus-summary-prev-article nil gnus-summary-subject-string] 3 (#$ . 207275) nil]) #@71 Select next unread article which has the same subject as current one. (defalias 'gnus-summary-next-unread-same-subject #[nil "À ˆÁÂà \"‡" [gnus-set-global-variables gnus-summary-next-article t gnus-summary-subject-string] 3 (#$ . 207517) nil]) #@75 Select previous unread article which has the same subject as current one. (defalias 'gnus-summary-prev-unread-same-subject #[nil "À ˆÁÂà \"‡" [gnus-set-global-variables gnus-summary-prev-article t gnus-summary-subject-string] 3 (#$ . 207767) nil]) #@79 Select the first unread article. Return nil if there are no unread articles. (defalias 'gnus-summary-first-unread-article #[nil "À ˆÁÂ!…&à ˆÁÂ!ˆÄÅ`Çyˆ`bˆ)È\"†% !Ê ˆ‡" [gnus-set-global-variables gnus-summary-first-subject t gnus-summary-show-thread gnus-summary-display-article get-text-property p 0 gnus-number gnus-current-article gnus-summary-position-cursor] 4 (#$ . 208021) nil]) #@51 Select the unread article with the highest score. (defalias 'gnus-summary-best-unread-article #[nil "À ˆÁ‰ŠÆÇ!„ÈÉ!ˆÊ ‰ Vƒ4 Ë`\fÍyˆ`\fbˆ)Î\"†3ÐÂÇ\"„)\f„GÈÉ!ˆ‚KÑ\f!ˆÒ +‡" [gnus-set-global-variables -1000000 nil score article best gnus-summary-first-subject t error "No unread articles" gnus-summary-article-score get-text-property p 0 gnus-number gnus-current-article gnus-summary-search-subject gnus-summary-goto-article gnus-summary-position-cursor] 3 (#$ . 208419) nil]) #@99 Fetch ARTICLE and display it if it exists. If ALL-HEADERS is non-nil, no header lines are hidden. (defalias 'gnus-summary-goto-article #[(article &optional all-headers) "À !…\n \"Ä ˆ‡" [gnus-summary-goto-subject article gnus-summary-display-article all-headers gnus-summary-position-cursor] 3 (#$ . 208916) (list (string-to-int (completing-read "Article number: " (mapcar (lambda (headers) (list (int-to-string (mail-header-number headers)))) gnus-newsgroup-headers) nil (quote require-match))))]) #@36 Go to the previously read article. (defalias 'gnus-summary-goto-last-article #[nil "…Á! ˆ‡" [gnus-last-article gnus-summary-goto-article gnus-summary-position-cursor] 2 (#$ . 209423) nil]) #@93 Pop one article off the history and go to the previous. NUMBER articles will be popped off. (defalias 'gnus-summary-pop-article #[(number) "À\n ›‰A ƒÄ @!ˆ‚ÅÆ!ˆ)Ç ‡" [nil to number gnus-newsgroup-history gnus-summary-goto-article error "Article history empty" gnus-summary-position-cursor] 2 (#$ . 209623) "p"]) #@104 Refer parent article N times. The difference between N and the number of articles fetched is returned. (defalias 'gnus-summary-refer-parent-article #[(n) "À ˆ ÂVƒlÃÄÅ`Âyˆ`bˆ)Ç\"†! \"JÊH‰ ƒG Ìš„GÍÎ \"ƒGÏ ”•O!‚aÐÑÒÅ`Âyˆ`bˆ)Ç\"†^#ˆÓ)ƒl S‰‚Ô ˆ ‡" [gnus-set-global-variables n 0 intern-soft int-to-string get-text-property p gnus-number gnus-current-article gnus-newsgroup-headers-hashtb-by-number 5 ref "" string-match "<[^<>]*>[ ]*$" gnus-summary-refer-article gnus-message 1 "No references in article %d" nil gnus-summary-position-cursor] 7 (#$ . 209948) "p"]) #@119 Refer article specified by MESSAGE-ID. NOTE: This command only works with newsgroups that use real or simulated NNTP. (defalias 'gnus-summary-refer-article #[(message-id) ";?†\nGÁU?…íÂÃ\"„ÄPÂÅ\"„$ÆPÇ—\"J@‰ ƒVÊ ÁH!†ìËÌ ÁÌ ̉ ÎH&ˆÏyˆ ÁH‚ì ÑÒ!!̉ƒvÙ!ˆŠÚ qˆÛÜ!ƒ…ÝÜ!ˆÞÜ!)ßÌà!#ƒÌ!ÁHâ!ˆã!ˆ$„³å!ˆæçè\"ˆé ˆê+žA!ˆ,ƒÈíî!ˆ‚ëŠÝ!ˆqˆÞ!ˆÌ/…êðÒp!\"*-)‡" [message-id 0 string-match "^<" "<" ">$" ">" intern-soft gnus-newsgroup-dependencies header gnus-summary-goto-article gnus-summary-insert-line nil gnus-read-mark 1 -1 gnus-refer-article-method window-start get-buffer-window gnus-article-buffer tmp-buf number tmp-point gnus-ancient-mark gnus-override-method gnus-check-server gnus-article-setup-buffer get-buffer " *temp Article*" kill-buffer rename-buffer gnus-article-prepare gnus-read-header gnus-current-headers gnus-rebuild-thread gnus-summary-goto-subject gnus-use-full-window delete-windows-on gnus-configure-windows article force gnus-summary-recenter gnus-article-set-window-start gnus-newsgroup-bookmarks gnus-visual run-hooks gnus-visual-mark-article-hook buffer-read-only set-window-start] 11 (#$ . 210546) "sMessage-ID: "]) #@52 Enter a digest group based on the current article. (defalias 'gnus-summary-enter-digest-group #[nil "À ˆÁ ˆÂ ˆÃÄÅÇÈD\" #p\n \fÍ\fÇ\fÎÏ!DÑFÒ#ƒFÓÔÕ\f\"J8›× BCC¡‚VØ\n!ˆÀ ˆÙÚ!ˆÛÜÝ\"+‡" [gnus-set-global-variables gnus-summary-select-article gnus-summary-stop-page-breaking format "%s-%d" gnus-group-prefixed-name gnus-newsgroup-name nndoc "" gnus-current-article buf ogroup name gnus-group-read-ephemeral-group nndoc-address get-buffer gnus-article-buffer (nndoc-article-type digest) t 4 2 intern-soft gnus-newsrc-hashtb to-group switch-to-buffer gnus-configure-windows summary gnus-message 3 "Article not a digest?"] 7 (#$ . 211757) nil]) #@51 Do incremental search forward on current article. (defalias 'gnus-summary-isearch-article #[nil "À ˆÁ ˆÂ ÄŽÅ!ˆÇ *‡" [gnus-set-global-variables gnus-summary-select-article selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer isearch-forward] 2 (#$ . 212417) nil]) #@88 Search for an article containing REGEXP forward. If BACKWARD, search backward instead. (defalias 'gnus-summary-search-article-forward #[(regexp &optional backward) "À ˆ ˜ƒ †Â‚ Ä \"ƒ6ÆÇ`Éyˆ`bˆ)Ê\"†0 \fžA!‡ÍÎ \"‡" [gnus-set-global-variables regexp "" gnus-last-search-regexp gnus-summary-search-article backward gnus-article-set-window-start get-text-property p 0 gnus-number gnus-current-article gnus-newsgroup-bookmarks error "Search failed: \"%s\""] 4 (#$ . 212748) (list (read-string (format "Search article %s (regexp%s): " (if current-prefix-arg "backward" "forward") (if gnus-last-search-regexp (concat ", default " gnus-last-search-regexp) ""))) current-prefix-arg)]) #@51 Search for an article containing REGEXP backward. (defalias 'gnus-summary-search-article-backward #[(regexp) "À Â\"‡" [gnus-summary-search-article-forward regexp backward] 3 (#$ . 213446) (list (read-string (format "Search article backward (regexp%s): " (if gnus-last-search-regexp (concat ", default " gnus-last-search-regexp) ""))))]) #@157 Search for an article containing REGEXP. Optional argument BACKWARD means do search for backward. gnus-select-article-hook is not called during the search. (defalias 'gnus-summary-search-article #[(regexp &optional backward) "À‰ ƒ\n‚ ÃÀ‰É ˆmƒÊyˆË ˆÌÍÎ#ˆÐ ÒŽÓ!ˆŒ~ˆÀÖ#+ „}×Ø À‰#!ƒ}ÌÍÎ#ˆÐ ÙŽÓ!ˆŒ~ˆ ƒnd‚oebˆÀÖ#+‚CÚÛ!ˆ\f=„‹\f -‡" [nil backward re-search-backward re-search-forward last found re-search gnus-mark-article-hook gnus-select-article-hook gnus-summary-show-all-threads -1 gnus-summary-select-article gnus-message 9 "Searching article: %d..." gnus-current-article selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer regexp t gnus-summary-display-article gnus-summary-search-subject ((select-window GnusStartBufferWindow)) message "" gnus-last-article] 5 (#$ . 213790)]) #@222 Search forward for an article whose HEADER matches REGEXP and execute COMMAND. If HEADER is an empty string (or nil), the match is done on the entire article. If BACKWARD (the prefix) is non-nil, search backward instead. (defalias 'gnus-summary-execute-command #[(header regexp command &optional backward) "À ˆÁ ˆŠÂ‹)‡" [gnus-set-global-variables gnus-summary-show-all-threads ((byte-code "ÀÁÂÃ\f!#ˆÅÈÉÊËÌ\f!DDE $ˆÀÁÎÃ\f!#‡" [gnus-message 6 "Executing %s..." key-description command gnus-execute header regexp lambda nil call-interactively quote key-binding backward "Executing %s...done"] 9))] 1 (#$ . 214680) (list (let ((completion-ignore-case t)) (completing-read "Header name: " (mapcar (lambda (string) (list string)) (quote ("Number" "Subject" "From" "Lines" "Date" "Message-ID" "Xref" "References"))) nil (quote require-match))) (read-string "Regexp: ") (read-key-sequence "Command: ") current-prefix-arg)]) #@43 Scroll the article back to the beginning. (defalias 'gnus-summary-beginning-of-article #[nil "À ˆÁ ˆÂÃ!ˆÄ ÆŽÇ!ˆ~ˆebˆ … Ê *‡" [gnus-set-global-variables gnus-summary-select-article gnus-configure-windows article selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer gnus-break-pages gnus-narrow-to-page] 2 (#$ . 215607) nil]) #@35 Scroll to the end of the article. (defalias 'gnus-summary-end-of-article #[nil "À ˆÁ ˆÂÃ!ˆÄ ÆŽÇ!ˆ~ˆdbˆÉÊ!ˆ …$Ì *‡" [gnus-set-global-variables gnus-summary-select-article gnus-configure-windows article selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer recenter -3 gnus-break-pages gnus-narrow-to-page] 2 (#$ . 216001) nil]) #@43 Force re-fetching of the current article. (defalias 'gnus-summary-show-article #[nil "À ˆÁÂÃ\"ˆÄÅ!ˆÆ ‡" [gnus-set-global-variables gnus-summary-select-article nil force gnus-configure-windows article gnus-summary-position-cursor] 3 (#$ . 216397) nil]) #@146 Toggle permanent full header display. If ARG is a positive number, turn header display on. If ARG is a negative number, turn header display off. (defalias 'gnus-summary-verbose-headers #[(&optional arg) "À ˆÁ\n!ˆ\n§ƒ\nÃUƒ\f?‚Å\n!…Ɖ‡" [gnus-set-global-variables gnus-summary-toggle-header arg 0 gnus-show-all-headers natnump t] 2 (#$ . 216656) "P"]) #@184 Show the headers if they are hidden, or hide them if they are shown. If ARG is a positive number, show the entire header. If ARG is a negative number, hide the unwanted header lines. (defalias 'gnus-summary-toggle-header #[(&optional arg) "À ˆŠ qˆÂ\f§ƒ+\fÅVƒÆed#ˆ‚X\fÅWƒXÈÉ!ˆ‚XÊedËÌ$ƒ>Æed#ˆ‚X ŠqˆÂ Š qˆÈÉ!ˆ) *ÐÑp!e\"*‡" [gnus-set-global-variables gnus-article-buffer nil buffer-read-only arg 0 remove-text-properties gnus-hidden-properties run-hooks gnus-article-display-hook text-property-any invisible t gnus-have-all-headers have gnus-summary-buffer set-window-point get-buffer-window] 5 (#$ . 217022) "P"]) #@32 Make all header lines visible. (defalias 'gnus-summary-show-all-headers #[nil "À ˆÁ ‡" [gnus-set-global-variables gnus-article-show-all-headers] 1 (#$ . 217661) nil]) #@79 Toggle MIME processing. If ARG is a positive number, turn MIME processing on. (defalias 'gnus-summary-toggle-mime #[(&optional arg) "À ˆ „\f\n?‚à !ÄVÅÆÇ\"‡" [gnus-set-global-variables arg gnus-show-mime prefix-numeric-value 0 gnus-summary-select-article t force] 3 (#$ . 217834) "P"]) #@120 Caesar rotate the current article by 13. The numerical prefix specifies how manu places to rotate each letter forward. (defalias 'gnus-summary-caesar-message #[(&optional arg) "À ˆÁ ˆÂÄ ÆŽÇ!ˆŒ~ˆÉ \nË\f!ˆÍÎp!\n\"-‡" [gnus-set-global-variables gnus-summary-select-article "" mail-header-separator selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer window-start start news-caesar-buffer-body arg set-window-start get-buffer-window] 3 (#$ . 218130) "P"]) #@44 Stop page breaking in the current article. (defalias 'gnus-summary-stop-page-breaking #[nil "À ˆÁ ˆÂ ÄŽÅ!ˆ~*‡" [gnus-set-global-variables gnus-summary-select-article selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer] 2 (#$ . 218655) nil]) #@625 Move the current article to a different newsgroup. If N is a positive number, move the N next articles. If N is a negative number, move the N previous articles. If N is nil and any articles have been marked with the process mark, move those articles instead. If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. If SELECT-METHOD is symbol, do not move to a specific newsgroup, but re-spool using this method. For this function to work, both the current newsgroup and the newsgroup that you want to move to have to support the `request-move' and `request-accept' functions. (Ie. mail newsgroups at present.) (defalias 'gnus-summary-move-article #[(&optional n to-newsgroup select-method) "À ˆÁ \"„ÄÅ!ˆÆ!È !ɉ‰\n \f „Y„YÑÒÓGÔVƒ@ÒÕG\"‚AÖƒNÒØ\"‚OÙ#ɉ %ƒÙ˜„m ˜ƒu†sÙÛ\"J„ŒÜ!„ŒÄÝ\"ˆƒœÙD‚ Þ! Áß @\"„²Äà @\"ˆá !„ÀÄâ @\"ˆãäå†Ê$ˆƒÊæ@ Þ !A@çƒêèD‚ìA?EA?%‰\fƒ³É)Û\f@*\"J†$Ûë\f@ƒÙD‚Þ!\"*\"J,í,8.@/ð/!ˆñyˆ`Ôyˆ`|ˆ.ƒ/2>„].AAóí.8\fAC\" ˆô\fA5‰6ƒŒ/6@AJ>ƒƒ÷.@6@@5C.$ˆ6A‰6„i*ø/9\"9ø/2\"2ø/:\":/;B„C-AAðì-8 AC\" ˆñ A2‰3ƒr.3@AJ>ƒiô-@3@@2C-$ˆ3A‰3„O*+‚äÓõ\f@#ˆö\f@!ˆ\fA‰\f„Á÷ !-‡" [gnus-set-global-variables gnus-summary-work-articles n get-buffer-create "*copy work*" gnus-group-real-prefix gnus-newsgroup-name nil to-method art-group prefix copy-buf articles buffer-disable-undo to-newsgroup select-method completing-read format "Where do you want to copy %s? %s" 1 "these %d articles" "this article" gnus-current-move-group "(%s default) " "" gnus-active-hashtb intern-soft gnus-activate-group error "No such group: %s" gnus-find-method-for-group gnus-check-backend-function request-accept-article "%s does not support article copying" gnus-check-server "Can't open server %s" gnus-message 6 "Copying to %s: %s..." gnus-request-article-this-buffer gnus-request-accept-article gnus-newsrc-hashtb gnus-group-prefixed-name entry 2 info article gnus-newsgroup-unreads gnus-add-to-range ((tick . gnus-newsgroup-marked) (dormant . gnus-newsgroup-dormant) (expire . gnus-newsgroup-expirable) (bookmark . gnus-newsgroup-bookmarks) (reply . gnus-newsgroup-replied)) to-article marks gnus-add-marked-articles "Couldn't copy article %s" gnus-summary-remove-process-mark kill-buffer] 8 (#$ . 222609) "P"]) #@45 Import a random file into a mail newsgroup. (defalias 'gnus-summary-import-article #[(file) "ÁÄÅ \"„ÆÇ \"ˆÈ !„$Ê !ƒ$ÆË \"ˆŠÌÍ!qˆÎp!ˆÏ ˆÐ !ˆebˆÑ „^Ò !ÓÔÓ!ÕÖÔÖ!Õ×ØÙ\n8!ÕÚÛÜ\n8!ݱ\fˆÞ ß\"ˆàp!+‡" [gnus-newsgroup-name nil atts group gnus-check-backend-function request-accept-article error "%s does not support article importing" file-readable-p file file-regular-p "Can't read %s" get-buffer-create " *import file*" buffer-disable-undo erase-buffer insert-file-contents nnheader-article-p file-attributes "From: " read-string "\n" "Subject: " "Date: " current-time-string 5 "Chars: " int-to-string 7 "\n\n" gnus-request-accept-article t kill-buffer] 13 (#$ . 224840) "fImport file: "]) #@72 Expire all articles that are marked as expirable in the current group. (defalias 'gnus-summary-expire-articles #[nil "ÀÁ\n\"…yÃÄ\n \"J8ÇÈ8>‰ ƒ\"Ê\n!‚*Ë\fÍ\"‰\fÏ…xÑÒÓ\"ˆÔ\n\" „I\f=„tσs@>„jÖ@\"ˆA‰„Y)ÑÒØ\",‡" [gnus-check-backend-function request-expire-articles gnus-newsgroup-name 2 intern-soft gnus-newsrc-hashtb info total-expire 5 total gnus-list-of-read-articles sort gnus-newsgroup-expirable < expirable nil es gnus-message 6 "Expiring articles..." gnus-request-expire-articles gnus-use-cache gnus-summary-mark-article gnus-canceled-mark "Expiring articles...done"] 5 (#$ . 225542) nil]) #@150 Expunge all expirable articles in the current group. This means that *all* articles that are marked as expirable will be deleted forever, right now. (defalias 'gnus-summary-expire-articles-now #[nil "„ÁÂ!„ÃÄ!ˆÅÆÉ *‡" [gnus-expert-user gnus-y-or-n-p "Are you really, really, really sure you want to expunge? " error "Phew!" -1 nil nnmail-expiry-wait-function nnmail-expiry-wait gnus-summary-expire-articles] 2 (#$ . 226191) nil]) #@298 Delete the N next (mail) articles. This command actually deletes articles. This is not a marking command. The article will disappear forever from you life, never to return. If N is negative, delete backwards. If N is nil and articles have been marked with the process mark, delete these instead. (defalias 'gnus-summary-delete-article #[(&optional n) "ÀÁ\n\"„ ÃÄ!ˆÅ!Ç \nƒ.ËÌÍ GÎVƒ(Ï‚)Ð\"!ƒ[Ñ \nÒ# ƒ[Ó @!ˆ @>„RÔ @\"ˆ A‰ „;Ö ˆ×Ø!ˆ*‡" [gnus-check-backend-function request-expire-articles gnus-newsgroup-name error "The current newsgroup does not support article deletion." gnus-summary-work-articles n nil not-deleted articles gnus-novice-user gnus-y-or-n-p format "Do you really want to delete %s forever? " 1 "these articles" "this article" gnus-request-expire-articles force gnus-summary-remove-process-mark gnus-summary-mark-article gnus-canceled-mark gnus-summary-position-cursor gnus-set-mode-line summary] 6 (#$ . 226636) "P"]) #@177 Enter into a buffer and edit the current article. This will have permanent effect only in mail groups. If FORCE is non-nil, allow editing of articles even in read-only groups. (defalias 'gnus-summary-edit-article #[(&optional force) "„ Á ƒ ÂÃ!ˆÄÅ!ˆÆÇ!ˆÈÉ\n!!ˆËÌÍ\"ˆÎÐ ˆÑÒÓ !!ˆÔÕÖ\"ˆ× ˆ~ˆebˆØÙÎÅ#‡" [force gnus-group-read-only-p error "The current newsgroup does not support article editing." gnus-summary-select-article t gnus-configure-windows article select-window get-buffer-window gnus-article-buffer gnus-message 6 "C-c C-c to end edits" nil buffer-read-only text-mode use-local-map copy-keymap current-local-map local-set-key "" gnus-summary-edit-article-done buffer-enable-undo search-forward "\n\n"] 4 (#$ . 227606) "P"]) #@46 Make edits to the current article permanent. (defalias 'gnus-summary-edit-article-done #[nil "À ƒÁ ˆÂÃ!ˆÄ ‡Åed\"Ç ˆcˆÈ A @p#„/ÊË!ˆ‚BÌ ˆÍ!ˆÏÑp!ˆÒÓ!ˆ…JÕÖ!)‡" [gnus-group-read-only-p gnus-summary-edit-article-postpone message "The current newsgroup does not support article editing." ding buffer-substring-no-properties buf erase-buffer gnus-request-replace-article gnus-article-current error "Couldn't replace article." gnus-article-mode use-local-map gnus-article-mode-map t buffer-read-only buffer-disable-undo gnus-configure-windows summary gnus-visual run-hooks gnus-visual-mark-article-hook] 4 (#$ . 228350) nil]) #@42 Postpone changes to the current article. (defalias 'gnus-summary-edit-article-postpone #[nil "À ˆÁ\n!ˆÃÅp!ˆÆÇ!ˆ…ÉÊ!‡" [gnus-article-mode use-local-map gnus-article-mode-map t buffer-read-only buffer-disable-undo gnus-configure-windows summary gnus-visual run-hooks gnus-visual-mark-article-hook] 2 (#$ . 228990) nil]) #@65 Query where the fancy respool algorithm would put this article. (defalias 'gnus-summary-fancy-query #[nil "À ˆŠ qˆŒebˆÂÃ!ˆe`}ˆÄÅÆ D!*‡" [gnus-summary-select-article gnus-article-buffer search-forward "\n\n" pp-eval-expression quote nnmail-split-fancy] 3 (#$ . 229319) nil]) #@46 Raise the score of the current article by N. (defalias 'gnus-summary-raise-score #[(n) "ÀÁ \n\\!‡" [gnus-summary-set-score gnus-summary-article-score n] 3 (#$ . 229599) "p"]) #@44 Set the score of the current article to N. (defalias 'gnus-summary-set-score #[(n) "ŠÀ ˆÁ`Ãyˆ`\nbˆ)Ä\" =ƒÆyˆÇÉ\n †%ÃUƒ-Ì‚@\n †5ÃWƒ> ‚@Ï\"ˆ)Á`Ãyˆ`\nbˆ)Ð\"†V‰ž‰ƒk\n¡ˆ‚u\nBB*Ô )‡" [gnus-summary-show-thread get-text-property p 0 gnus-mark gnus-dummy-mark 1 nil buffer-read-only gnus-summary-update-mark n gnus-summary-default-score 32 gnus-score-below-mark gnus-score-over-mark score gnus-number gnus-current-article article gnus-newsgroup-scored gnus-summary-update-line] 4 (#$ . 229780) "p"]) #@42 Return the score of the current article. (defalias 'gnus-summary-current-score #[nil "ÀÁ \"‡" [message "%s" gnus-summary-article-score] 3 (#$ . 230317) nil]) #@75 Raise articles which has the same subject with SCORE and select the next. (defalias 'gnus-summary-raise-same-subject-and-select #[(score) "À  !ˆÄʼn #ƒ !ˆ‚ÆÇ!)‡" [gnus-summary-subject-string subject gnus-summary-raise-score score gnus-summary-search-subject nil gnus-summary-next-article t] 4 (#$ . 230482) "p"]) #@55 Raise articles which has the same subject with SCORE. (defalias 'gnus-summary-raise-same-subject #[(score) "À  !ˆÄʼn #ƒ !ˆ‚ÆÇÈ\")‡" [gnus-summary-subject-string subject gnus-summary-raise-score score gnus-summary-search-subject nil gnus-summary-next-subject 1 t] 4 (#$ . 230807) "p"]) (defalias 'gnus-score-default #[(level) "ƒÁ!‡\n‡" [level prefix-numeric-value gnus-score-interactive-default-score] 2]) #@67 Raise the score of the articles in the current thread with SCORE. (defalias 'gnus-summary-raise-thread #[(&optional score) "À !ŠÄ`Æyˆ` bˆ)Ç\"†ÆÉ !ˆÊËÂÌ#ÆUƒFÄ`Æyˆ` bˆ)Ç\"†9ÆVƒFÉ !ˆ‚`*Ì ÎÊËÌ\"!„X bˆ*Ï ˆÐ ˆÑÒ!‡" [gnus-score-default score nil e get-text-property p 0 gnus-level level gnus-summary-raise-score gnus-summary-next-subject 1 t gnus-summary-check-current zerop gnus-summary-recenter gnus-summary-position-cursor gnus-set-mode-line summary] 4 (#$ . 231229) "P"]) #@75 Raise articles which has the same subject with SCORE and select the next. (defalias 'gnus-summary-lower-same-subject-and-select #[(score) "À [!‡" [gnus-summary-raise-same-subject-and-select score] 2 (#$ . 231723) "p"]) #@55 Raise articles which has the same subject with SCORE. (defalias 'gnus-summary-lower-same-subject #[(score) "À [!‡" [gnus-summary-raise-same-subject score] 2 (#$ . 231948) "p"]) #@59 Lower score of articles in the current thread with SCORE. (defalias 'gnus-summary-lower-thread #[(&optional score) "ÀÁ\n!S[!‡" [gnus-summary-raise-thread gnus-score-default score] 3 (#$ . 232131) "P"]) #@163 Mark articles which has the same subject as read, and then select the next. If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles. (defalias 'gnus-summary-kill-same-subject-and-select #[(&optional unmark) "ƒÁ!Âà \"ÅÆ…à \"ˆÈÉÊ\f‰ËUƒ'Ì‚(̓0΂1Ï%)‡" [unmark prefix-numeric-value gnus-summary-mark-same-subject gnus-summary-subject-string count gnus-summary-next-article t gnus-auto-select-same gnus-message 7 "%d article%s marked as %s" 1 " is" "s are" "unread" "read"] 6 (#$ . 232340) "P"]) #@138 Mark articles which has the same subject as read. If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles. (defalias 'gnus-summary-kill-same-subject #[(&optional unmark) "ƒÁ!Âà \"„ÅÆÇ\"ˆÈÉÊ\fƒ#Ë‚$Ì$)‡" [unmark prefix-numeric-value gnus-summary-mark-same-subject gnus-summary-subject-string count gnus-summary-next-subject 1 t gnus-message 7 "%d articles are marked as %s" "unread" "read"] 5 (#$ . 232883) "P"]) #@210 Mark articles with same SUBJECT as read, and return marked number. If optional argument UNMARK is positive, remove any kinds of marks. If optional argument UNMARK is negative, mark articles as unread instead. (defalias 'gnus-summary-mark-same-subject #[(subject &optional unmark) "ÀŠ\n„Ã\f!ˆÅ ˆÆlj#ƒQ T‚\nÉVƒ:Ê !ˆÅ ˆÆlj#ƒQ T‚#Ê\f!ˆÅ ˆÆlj#ƒQ T‚:ÍÎ!ˆ *‡" [1 count unmark gnus-summary-mark-article-as-read gnus-killed-mark gnus-summary-show-thread gnus-summary-search-subject nil subject 0 gnus-summary-mark-article-as-unread gnus-ticked-mark gnus-unread-mark gnus-set-mode-line summary] 4 (#$ . 233344)]) #@223 Set the process mark on the next N articles. If N is negative, mark backward instead. If UNMARK is non-nil, remove the process mark instead. The difference between N and the actual number of articles marked is returned. (defalias 'gnus-summary-mark-as-processable #[(n &optional unmark) "ÁWÂ!ÁVƒ]\fƒ+ÅÆ`Áyˆ`bˆ)È\"†' !‚AÊÆ`Áyˆ`bˆ)È\"†@ !ƒ]Ë ƒMÌ‚NÍÎÏ#ÁUƒ]S‰‚ ÁU„hÐÑÒ\"ˆÓ ˆÔ ˆ*‡" [n 0 abs backward unmark gnus-summary-remove-process-mark get-text-property p gnus-number gnus-current-article gnus-summary-set-process-mark gnus-summary-next-subject -1 1 nil t gnus-message 7 "No more articles" gnus-summary-recenter gnus-summary-position-cursor] 5 (#$ . 233976) "p"]) #@172 Remove the process mark from the next N articles. If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned. (defalias 'gnus-summary-unmark-as-processable #[(n) "À Â\"‡" [gnus-summary-mark-as-processable n t] 3 (#$ . 234678) "p"]) #@44 Remove the process mark from all articles. (defalias 'gnus-summary-unmark-all-processable #[nil "Šƒ Á@!ˆ‚) ‡" [gnus-newsgroup-processable gnus-summary-remove-process-mark gnus-summary-position-cursor] 2 (#$ . 234977) nil]) #@159 Mark N articles forward as expirable. If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned. (defalias 'gnus-summary-mark-as-expirable #[(n) "À \n\"‡" [gnus-summary-mark-forward n gnus-expirable-mark] 3 (#$ . 235213) "p"]) #@51 Mark ARTICLE replied and update the summary line. (defalias 'gnus-summary-mark-article-as-replied #[(article) " BÂÄ!…ÅÇ\"ˆÈ)‡" [article gnus-newsgroup-replied nil buffer-read-only gnus-summary-goto-subject gnus-summary-update-mark gnus-replied-mark replied t] 3 (#$ . 235507)]) #@36 Set a bookmark in current article. (defalias 'gnus-summary-set-bookmark #[(article) "À !ƒ\nƒ ƒ\f @š„ÅÆ!ˆž‰ ƒ,Ê \")Š qˆË`ŠebˆÌÍÎÏ#ˆ`)^`\")BBÐÑÒ\"‡" [get-buffer gnus-article-buffer gnus-current-article gnus-article-current gnus-newsgroup-name error "No current article selected" article gnus-newsgroup-bookmarks old delq count-lines search-forward "\n\n" nil t gnus-message 6 "A bookmark has been added to the current article."] 8 (#$ . 235799) (list (gnus-summary-article-number))]) #@47 Remove the bookmark from the current article. (defalias 'gnus-summary-remove-bookmark #[(article) " ž‰ƒÃ\n \"ÄÅÆ\"‚ÄÅÇ\")‡" [article gnus-newsgroup-bookmarks old delq gnus-message 6 "Removed bookmark." "No bookmark in current article."] 4 (#$ . 236312) (list (gnus-summary-article-number))]) #@158 Mark N articles forward as dormant. If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned. (defalias 'gnus-summary-mark-as-dormant #[(n) "À \n\"‡" [gnus-summary-mark-forward n gnus-dormant-mark] 3 (#$ . 236618) "p"]) #@62 Set the process mark on ARTICLE and update the summary line. (defalias 'gnus-summary-set-process-mark #[(article) " BÂÄ!…$Å ˆÆÇ È\" =ƒÊyˆË\fÍ\"ˆÎ)‡" [article gnus-newsgroup-processable nil buffer-read-only gnus-summary-goto-subject gnus-summary-show-thread get-text-property gnus-point-at-bol gnus-mark gnus-dummy-mark 1 gnus-summary-update-mark gnus-process-mark replied t] 3 (#$ . 236907)]) #@67 Remove the process mark from ARTICLE and update the summary line. (defalias 'gnus-summary-remove-process-mark #[(article) "À \n\"ÃÅ !…1Æ ˆÇÈ É\"\n=ƒËyˆÌÍÎ\"ˆ >ƒ0ÌÎ\"ˆÑ)‡" [delq article gnus-newsgroup-processable nil buffer-read-only gnus-summary-goto-subject gnus-summary-show-thread get-text-property gnus-point-at-bol gnus-mark gnus-dummy-mark 1 gnus-summary-update-mark 32 replied gnus-newsgroup-replied gnus-replied-mark t] 3 (#$ . 237315)]) #@233 Mark N articles as read forwards. If N is negative, mark backwards instead. Mark with MARK. If MARK is ? , ?! or ??, articles will be marked as unread. The difference between N and the actual number of articles marked is returned. (defalias 'gnus-summary-mark-forward #[(n &optional mark no-expire) "À ˆ ÂW …\f E>?È !\f† \n ÂVƒJËÌ\f #ƒJÎ\nƒ:Ï‚;Ð Ñ#ÂUƒJ S‰‚\" ÂU„^ÒÓÔ\fƒ[Õ‚\\Ö#ˆ× ˆØ ˆÙÚ!ˆ ,‡" [gnus-set-global-variables n 0 gnus-summary-goto-unread mark gnus-unread-mark gnus-ticked-mark gnus-dormant-mark abs gnus-del-mark backward gnus-summary-mark-article nil no-expire gnus-summary-next-subject -1 1 t gnus-message 7 "No more %sarticles" "" "unread " gnus-summary-recenter gnus-summary-position-cursor gnus-set-mode-line summary] 6 (#$ . 237779) "p"]) #@53 Mark the current article quickly as read with MARK. (defalias 'gnus-summary-mark-article-as-read #[(mark) "À`Âyˆ` bˆ)Ã\"†\fÆ \"Æ \"Æ  \" \nB B \fƒ9Í !ˆƒp\nU„f\nU„f\nU„f\nU„f\nUƒp\n BÀ`Âyˆ` bˆ)Ö\"=ƒ‰Øyˆ‚pÙ\nÚ\"ˆ)Û‡" [get-text-property p 0 gnus-number gnus-current-article article delq gnus-newsgroup-unreads gnus-newsgroup-marked gnus-newsgroup-dormant mark gnus-newsgroup-reads gnus-use-cache gnus-cache-enter-remove-article gnus-newsgroup-auto-expire gnus-killed-mark gnus-del-mark gnus-catchup-mark gnus-low-score-mark gnus-read-mark gnus-expirable-mark gnus-newsgroup-expirable gnus-mark gnus-dummy-mark 1 gnus-summary-update-mark unread t] 3 (#$ . 238566)]) #@55 Mark the current article quickly as unread with MARK. (defalias 'gnus-summary-mark-article-as-unread #[(mark) "À`Âyˆ` bˆ)Ã\"†\f‰>„ BÇ \"Ç  \" Ç \n\"\nÇ  ž \" \f UƒL B\fUƒZ  B ƒŒÐÑÒ !\"J!ƒŒŠÔ ÑÒ !\"J\f U\fU\fU&ˆ)À`Âyˆ` bˆ)×\"=ƒ¥Ùyˆ‚ŒÚ\fÛ\"ˆ)܇" [get-text-property p 0 gnus-number gnus-current-article article gnus-newsgroup-unreads delq gnus-newsgroup-marked gnus-newsgroup-dormant gnus-newsgroup-expirable gnus-newsgroup-reads mark gnus-ticked-mark gnus-dormant-mark gnus-use-cache vectorp intern-soft int-to-string gnus-newsgroup-headers-hashtb-by-number gnus-cache-possibly-enter-article gnus-newsgroup-name gnus-unread-mark gnus-mark gnus-dummy-mark 1 gnus-summary-update-mark unread t] 9 (#$ . 239290)]) #@281 Mark ARTICLE with MARK. MARK can be any character. Four MARK strings are reserved: `? ' (unread), `?!' (ticked), `??' (dormant) and `?E' (expirable). If MARK is nil, then the default character `?D' is used. If ARTICLE is nil, then the article on the current line will be marked. (defalias 'gnus-summary-mark-article #[(&optional article mark no-expire) ";ƒ ÁH\n„> ƒ>ƒ;§ƒ>\fU„; U„;U„;U„;Uƒ> †C \n†]Ë`\fÁyˆ`\fbˆ)Í\"†]‰\n„gÏÐ!ˆU„|U„|Uƒ…Ô\n\"ˆ‚‹Õ\n\"ˆƒÄU„ÄØÙÚ\n!\"J!ƒÄŠÜ\nÙÚ\n!\"JUUU&ˆ)Þ\n!…æß á ˆËâ ã\"$=ƒßåyˆæç\"ˆ)è*‡" [mark 0 no-expire gnus-newsgroup-auto-expire gnus-killed-mark gnus-del-mark gnus-catchup-mark gnus-low-score-mark gnus-read-mark gnus-expirable-mark article get-text-property p gnus-number gnus-current-article error "No article on current line" gnus-unread-mark gnus-ticked-mark gnus-dormant-mark gnus-mark-article-as-unread gnus-mark-article-as-read gnus-use-cache gnus-canceled-mark vectorp intern-soft int-to-string gnus-newsgroup-headers-hashtb-by-number gnus-cache-possibly-enter-article gnus-newsgroup-name gnus-summary-goto-subject nil buffer-read-only gnus-summary-show-thread gnus-point-at-bol gnus-mark gnus-dummy-mark 1 gnus-summary-update-mark unread t] 9 (#$ . 240066)]) (defalias 'gnus-summary-update-mark #[(mark type) "Àyˆ \nžAɉ…CuˆÇ`!ÈÉ!ˆ\ncˆ\fƒ,Ë`S`\f#ˆ Ì=…CË`S`Í\nD#ˆÎ\n=!+‡" [0 type gnus-summary-mark-positions nil plist buffer-read-only forward text-properties-at delete-char 1 mark add-text-properties unread gnus-mark gnus-summary-update-line gnus-unread-mark] 6]) #@65 Enter ARTICLE in the pertinent lists and remove it from others. (defalias 'gnus-mark-article-as-read #[(article &optional mark) "† ‰\nUƒ \fB‚Å \f\"Å \"Å \"Å \" B B \n…=Ë !)‡" [mark gnus-del-mark gnus-expirable-mark article gnus-newsgroup-expirable delq gnus-newsgroup-unreads gnus-newsgroup-marked gnus-newsgroup-dormant gnus-newsgroup-reads gnus-use-cache gnus-cache-enter-remove-article] 4 (#$ . 241685)]) #@65 Enter ARTICLE in the pertinent lists and remove it from others. (defalias 'gnus-mark-article-as-unread #[(article &optional mark) "† \n >„\n BÄ\n \"Ä\n\"Ä\n\"Ä\nž\" Uƒ7\n B U…E\nB‰)‡" [mark gnus-ticked-mark article gnus-newsgroup-unreads delq gnus-newsgroup-marked gnus-newsgroup-dormant gnus-newsgroup-expirable gnus-newsgroup-reads gnus-dormant-mark] 3 (#$ . 242126)]) (byte-code "ÀÁÂ\"ˆÃÁÂ\"‡" [defalias gnus-summary-mark-as-unread-forward gnus-summary-tick-article-forward make-obsolete] 3) #@141 Tick N articles forwards. If N is negative, tick backwards instead. The difference between N and the number of articles ticked is returned. (defalias 'gnus-summary-tick-article-forward #[(n) "À \n\"‡" [gnus-summary-mark-forward n gnus-ticked-mark] 3 (#$ . 242660) "p"]) (byte-code "ÀÁÂ\"ˆÃÁÂ\"‡" [defalias gnus-summary-mark-as-unread-backward gnus-summary-tick-article-backward make-obsolete] 3) #@100 Tick N articles backwards. The difference between N and the number of articles ticked is returned. (defalias 'gnus-summary-tick-article-backward #[(n) "À [\n\"‡" [gnus-summary-mark-forward n gnus-ticked-mark] 3 (#$ . 243063) "p"]) (byte-code "ÀÁÂ\"ˆÃÁÂ\"‡" [defalias gnus-summary-mark-as-unread gnus-summary-tick-article make-obsolete] 3) #@171 Mark current article as unread. Optional 1st argument ARTICLE specifies article number to be marked as unread. Optional 2nd argument CLEAR-MARK remove any kinds of mark. (defalias 'gnus-summary-tick-article #[(&optional article clear-mark) "À \nƒ\n ‚ \f\"‡" [gnus-summary-mark-article article clear-mark gnus-unread-mark gnus-ticked-mark] 3 (#$ . 243409)]) #@156 Mark N articles as read forwards. If N is negative, mark backwards instead. The difference between N and the actual number of articles marked is returned. (defalias 'gnus-summary-mark-as-read-forward #[(n) "À \nÃ#‡" [gnus-summary-mark-forward n gnus-del-mark t] 4 (#$ . 243775) "p"]) #@119 Mark the N articles as read backwards. The difference between N and the actual number of articles marked is returned. (defalias 'gnus-summary-mark-as-read-backward #[(n) "À [\nÃ#‡" [gnus-summary-mark-forward n gnus-del-mark t] 4 (#$ . 244066) "p"]) #@152 Mark current article as read. ARTICLE specifies the article to be marked as read. MARK specifies a string to be inserted at the beginning of the line. (defalias 'gnus-summary-mark-as-read #[(&optional article mark) "À \n\"‡" [gnus-summary-mark-article article mark] 3 (#$ . 244322)]) #@150 Clear marks from N articles forward. If N is negative, clear backward instead. The difference between N and the number of marks cleared is returned. (defalias 'gnus-summary-clear-mark-forward #[(n) "À \n\"‡" [gnus-summary-mark-forward n gnus-unread-mark] 3 (#$ . 244613) "p"]) #@109 Clear marks from N articles backward. The difference between N and the number of marks cleared is returned. (defalias 'gnus-summary-clear-mark-backward #[(n) "À [\n\"‡" [gnus-summary-mark-forward n gnus-unread-mark] 3 (#$ . 244897) "p"]) #@58 Intended to be used by `gnus-summary-mark-article-hook'. (defalias 'gnus-summary-mark-unread-as-read #[nil " >†\n>† >†Ä \"‡" [gnus-current-article gnus-newsgroup-marked gnus-newsgroup-dormant gnus-newsgroup-expirable gnus-summary-mark-article gnus-read-mark] 3 (#$ . 245141)]) #@157 Mark all unread articles between point and mark as read. If given a prefix, mark all articles between point and mark as read, even ticked and dormant ones. (defalias 'gnus-summary-mark-region-as-read #[(point mark all) "ŠbˆÁyˆ`\nW…T „1ÄÅ Æ\"†>„JÄÅ Æ\"†+ >„JÊÄ` Áyˆ` bˆ)Æ\"†F\f\"ˆÍyÁU…T‚)‡" [point 0 mark all get-text-property gnus-point-at-bol gnus-number gnus-current-article gnus-newsgroup-marked gnus-newsgroup-dormant gnus-summary-mark-article p gnus-del-mark 1] 4 (#$ . 245435) "r\nP"]) (byte-code "ÀÁÂ\"ˆÃÁÂ\"‡" [defalias gnus-summary-delete-marked-as-read gnus-summary-remove-lines-marked-as-read make-obsolete] 3) #@39 Remove lines that are marked as read. (defalias 'gnus-summary-remove-lines-marked-as-read #[nil "ÀÁÂÃÄ#°!‡" [gnus-summary-remove-lines-marked-with mapconcat #[(char) "À J!‡" [char-to-string char] 2] (gnus-del-mark gnus-read-mark gnus-ancient-mark gnus-killed-mark gnus-kill-file-mark gnus-low-score-mark gnus-expirable-mark gnus-canceled-mark gnus-catchup-mark) ""] 5 (#$ . 246087) nil]) (byte-code "ÀÁÂ\"ˆÃÁÂ\"‡" [defalias gnus-summary-delete-marked-with gnus-summary-remove-lines-marked-with make-obsolete] 3) #@54 Remove lines that are marked with MARKS (e.g. "DK"). (defalias 'gnus-summary-remove-lines-marked-with #[(marks) "À ˆÁÂ`Äyˆ` bˆ)Å\"†ÇÉQ\n ebˆ\fƒ1Í!ˆ‚GÎÁÏ#ƒGÄyˆ`Ðyˆ`|ˆ‚1Ò=ƒebˆÇÓ!ÉQÎÁÏ#ƒÕÖ ÐyˆÖ \"„Z×yˆÄyˆ`Ðyˆ`|ˆ‚ZØ ÄU†™Ù\n!†™mƒ—ÚÐ!‚™Û +‡" [gnus-set-global-variables nil get-text-property p 0 gnus-number gnus-current-article "^[" marks "]" orig-article buffer-read-only gnus-newsgroup-adaptive gnus-score-remove-lines-adaptive re-search-forward t 1 gnus-summary-make-false-root dummy char-to-string gnus-dummy-mark gnus-subject-equal gnus-summary-subject-string -1 buffer-size gnus-summary-goto-subject gnus-summary-prev-subject gnus-summary-position-cursor] 5 (#$ . 246606) "sMarks: "]) #@45 Remove articles with score less than SCORE. (defalias 'gnus-summary-expunge-below #[(&optional score) "À ˆ ƒ  !‚ †ÄŠ qˆebˆÆ‰m„?É Wƒ9`Êyˆ`|ˆ‚ Êyˆ‚ Ë ÄU†RmƒPÌÊ!‚RÍ +‡" [gnus-set-global-variables score prefix-numeric-value gnus-summary-default-score 0 gnus-summary-buffer nil beg buffer-read-only gnus-summary-article-score 1 buffer-size gnus-summary-prev-subject gnus-summary-position-cursor] 2 (#$ . 247336) "P"]) #@53 Mark articles with score less than SCORE with MARK. (defalias 'gnus-summary-mark-below #[(score mark) "À ˆ ƒ  !‚ †ÄŠ qˆebˆm?…2Æ Wƒ,ÇÈ \"ˆÊyˆ‚)‡" [gnus-set-global-variables score prefix-numeric-value gnus-summary-default-score 0 gnus-summary-buffer gnus-summary-article-score gnus-summary-mark-article nil mark 1] 3 (#$ . 247778) "P\ncMark: "]) #@47 Mark articles with score below SCORE as read. (defalias 'gnus-summary-kill-below #[(&optional score) "À ˆÁ\n \"‡" [gnus-set-global-variables gnus-summary-mark-below score gnus-killed-mark] 3 (#$ . 248141) "P"]) #@55 Clear all marks from articles with score above SCORE. (defalias 'gnus-summary-clear-above #[(&optional score) "À ˆÁ\n \"‡" [gnus-set-global-variables gnus-summary-mark-above score gnus-unread-mark] 3 (#$ . 248358) "P"]) #@43 Tick all articles with score above SCORE. (defalias 'gnus-summary-tick-above #[(&optional score) "À ˆÁ\n \"‡" [gnus-set-global-variables gnus-summary-mark-above score gnus-ticked-mark] 3 (#$ . 248584) "P"]) #@48 Mark articles with score over SCORE with MARK. (defalias 'gnus-summary-mark-above #[(score mark) "À ˆ ƒ  !‚ †ÄŠ qˆebˆm?…8Æ Vƒ2ÇÈ \"ˆÊyˆ‚Êyˆ‚)‡" [gnus-set-global-variables score prefix-numeric-value gnus-summary-default-score 0 gnus-summary-buffer gnus-summary-article-score gnus-summary-mark-article nil mark 1] 3 (#$ . 248797) "P\ncMark: "]) #@68 Display all the hidden articles that were expunged for low scores. (defalias 'gnus-summary-show-all-expunged #[nil "À ˆÁ Á‰‰ƒ@Ç@@!„7ÈÉ@@!\n\"J‰ƒ7@A Wƒ7\f BA‰„ „HÌÍ!ˆebˆŠÎ`Ï Ÿ!ˆ`\"ˆ,ebˆÐ )‡" [gnus-set-global-variables nil buffer-read-only gnus-newsgroup-scored h headers scored gnus-summary-goto-subject intern-soft int-to-string gnus-newsgroup-headers-hashtb-by-number gnus-summary-expunge-below error "No expunged articles hidden." gnus-summary-update-lines gnus-summary-prepare-unthreaded gnus-summary-position-cursor] 5 (#$ . 249161) nil]) #@61 Display all the hidden articles that are marked as dormant. (defalias 'gnus-summary-show-all-dormant #[nil "À ˆÁ Á‰‰ƒ4Ç@!„+ÈÉ@!\n\"J‰ƒ+\f BA‰„ „<ËÌ!ˆebˆŠÍ`Î Ÿ!ˆ`\"ˆ,ebˆÏ )‡" [gnus-set-global-variables nil buffer-read-only gnus-newsgroup-dormant h headers dormant gnus-summary-goto-subject intern-soft int-to-string gnus-newsgroup-headers-hashtb-by-number error "No dormant articles hidden." gnus-summary-update-lines gnus-summary-prepare-unthreaded gnus-summary-position-cursor] 5 (#$ . 249736) nil]) #@28 Hide all dormant articles. (defalias 'gnus-summary-hide-all-dormant #[nil "À ˆÁ !!ˆÄ ‡" [gnus-set-global-variables gnus-summary-remove-lines-marked-with char-to-string gnus-dormant-mark gnus-summary-position-cursor] 3 (#$ . 250265) nil]) #@351 Mark all articles not marked as unread in this newsgroup as read. If prefix argument ALL is non-nil, all articles are marked as read. If QUIETLY is non-nil, no questions will be asked. If TO-HERE is non-nil, it should be a point in the buffer. All articles before this point will be marked as read. The number of articles marked as read is returned. (defalias 'gnus-summary-catchup #[(&optional all quietly to-here not-mark) "À ˆ „\nƒ „Ä ƒÆ‚Ç!…yƒB „B\n„B ƒ6Ë\fË Î\f \"‰‚yÐ ˆÑ ?!ƒkƒX`W‚YÓƒkÔ!ƒkÖË ?\"„L†yÎ\f \"‰×!„˜@Ú=ƒ˜ÛÜ!A@ #ˆ)Ý ˆ‡" [gnus-set-global-variables quietly gnus-interactive-catchup gnus-expert-user gnus-y-or-n-p all "Mark absolutely all articles as read? " "Mark all unread articles as read? " not-mark gnus-newsgroup-adaptive gnus-newsgroup-auto-expire nil gnus-newsgroup-marked gnus-newsgroup-dormant append gnus-newsgroup-unreads gnus-summary-show-all-threads gnus-summary-first-subject to-here t gnus-summary-mark-article-as-read gnus-catchup-mark gnus-summary-search-subject gnus-find-method-for-group gnus-newsgroup-name method nnvirtual nnvirtual-catchup-group gnus-group-real-name gnus-summary-position-cursor] 5 (#$ . 250511) "P"]) #@126 Mark all unticked articles before the current one as read. If ALL is non-nil, also mark ticked and dormant articles as read. (defalias 'gnus-summary-catchup-to-here #[(&optional all) "À ˆŠÁÂy!ƒÃˆÄ Æ`#ˆÇÈ!ˆ)É ‡" [gnus-set-global-variables zerop -1 nil gnus-summary-catchup all t gnus-set-mode-line summary gnus-summary-position-cursor] 4 (#$ . 251731) "P"]) #@46 Mark all articles in this newsgroup as read. (defalias 'gnus-summary-catchup-all #[(&optional quietly) "À ˆÁ \"‡" [gnus-set-global-variables gnus-summary-catchup t quietly] 3 (#$ . 252097) "P"]) #@146 Mark all articles not marked as unread in this newsgroup as read, then exit. If prefix argument ALL is non-nil, all articles are marked as read. (defalias 'gnus-summary-catchup-and-exit #[(&optional all quietly) "À ˆÁ\n ÄÅ$ˆÃ=ƒÇ!„ÉÄ!‡Ê ‡" [gnus-set-global-variables gnus-summary-catchup all quietly nil fast gnus-auto-select-next gnus-ephemeral-group-p gnus-newsgroup-name gnus-summary-next-group gnus-summary-exit] 5 (#$ . 252300) "P"]) #@61 Mark all articles in this newsgroup as read, and then exit. (defalias 'gnus-summary-catchup-all-and-exit #[(&optional quietly) "À ˆÁ \"‡" [gnus-set-global-variables gnus-summary-catchup-and-exit t quietly] 3 (#$ . 252752) "P"]) #@141 Mark all articles in this group as read and select the next group. If given a prefix, mark all articles, unread as well as ticked, as read. (defalias 'gnus-summary-catchup-and-goto-next-group #[(&optional all) "À ˆÁ\n!ˆÃ ‡" [gnus-set-global-variables gnus-summary-catchup all gnus-summary-next-group] 2 (#$ . 252988) "P"]) #@103 Toggle showing conversation threads. If ARG is positive number, turn showing conversation threads on. (defalias 'gnus-summary-toggle-threads #[(&optional arg) "À ˆÁ`Ãyˆ`\nbˆ)Ä\"† †„& ?‚,Ê!ÃV Ë ˆÌ!ˆÍ )‡" [gnus-set-global-variables get-text-property p 0 gnus-number gnus-current-article gnus-newsgroup-end current arg gnus-show-threads prefix-numeric-value gnus-summary-prepare gnus-summary-goto-subject gnus-summary-position-cursor] 3 (#$ . 253318) "P"]) #@19 Show all threads. (defalias 'gnus-summary-show-all-threads #[nil "À ˆŠÁÃedÄÅÆ%ˆ*Ç ‡" [gnus-set-global-variables nil buffer-read-only subst-char-in-region 13 10 t gnus-summary-position-cursor] 6 (#$ . 253797) nil]) #@71 Show thread subtrees. Returns nil if no thread was there to be shown. (defalias 'gnus-summary-show-thread #[nil "À ˆÁ` ˆÁˆ`Ãyˆ`ÈÉ Ê#Ë\f ÌÍÊ%ˆbˆÎ ˆ,‡" [gnus-set-global-variables nil gnus-summary-hide-thread 0 beg end orig buffer-read-only search-forward " " t subst-char-in-region 13 10 gnus-summary-position-cursor] 7 (#$ . 254018) nil]) #@27 Hide all thread subtrees. (defalias 'gnus-summary-hide-all-threads #[nil "À ˆŠebˆÁ ˆm„ÂyÃUƒÁ ˆ‚\n)Ä ‡" [gnus-set-global-variables gnus-summary-hide-thread 1 0 gnus-summary-position-cursor] 2 (#$ . 254372) nil]) #@74 Hide thread subtrees. Returns nil if no threads were there to be hidden. (defalias 'gnus-summary-hide-thread #[nil "À ˆÁ`Â`Äyˆ` bˆ)Å\"†Ä` m?…dÊyÄUƒHÂ`Äyˆ` bˆ)Å\"†<ÄVƒH`‚$ŠbˆËÌÍ#)ÎÏÐÍ%ˆÑyˆÒ ˆ,‡" [gnus-set-global-variables nil get-text-property p 0 gnus-level end level start buffer-read-only 1 search-backward "\n" t subst-char-in-region 10 13 -1 gnus-summary-position-cursor] 7 (#$ . 254594) nil]) #@169 Go to the same level (or less) next thread. If PREVIOUS is non-nil, go to previous thread instead. Return the article number moved to, or nil if moving was impossible. (defalias 'gnus-summary-go-to-next-thread #[(&optional previous) "À`Âyˆ` bˆ)Ã\"†ÂÀ`Âyˆ` bˆ)Ä\"†\" ƒLÉyÂUƒsÀ`Âyˆ` bˆ)Ã\"†CÂV„+‚sŠÊyˆm)„sÊyÂUƒsÀ`Âyˆ` bˆ)Ã\"†mÂV„LË ˆÌ ˆÀ`Âyˆ` bˆ)Ä\"†Š ‰ U?…– +‡" [get-text-property p 0 gnus-level gnus-number gnus-current-article article level previous -1 1 gnus-summary-recenter gnus-summary-position-cursor oart] 5 (#$ . 255027)]) #@155 Go to the same level next N'th thread. If N is negative, search backward instead. Returns the difference between N and the number of skips actually done. (defalias 'gnus-summary-next-thread #[(n) "À ˆ ÂWà ! ÂVƒÅ\f!ƒ S‰‚\fÆ ˆ ÂU„,ÇÈÉ\"ˆ *‡" [gnus-set-global-variables n 0 abs backward gnus-summary-go-to-next-thread gnus-summary-position-cursor gnus-message 7 "No more threads"] 4 (#$ . 255598) "p"]) #@116 Go to the same level previous N'th thread. Returns the difference between N and the number of skips actually done. (defalias 'gnus-summary-prev-thread #[(n) "À ˆÁ\n[!‡" [gnus-set-global-variables gnus-summary-next-thread n] 2 (#$ . 256014) "p"]) #@103 Go down one level in the current thread. If SAME is non-nil, also move to articles of the same level. (defalias 'gnus-summary-go-down-thread #[(&optional same) "À`Âyˆ` bˆ)Ã\"†Â`ÆyÂUƒ5À`Âyˆ` bˆ)Ã\"†, Vƒ5Ç‚9\fbˆÈ*‡" [get-text-property p 0 gnus-level start level 1 t nil] 3 (#$ . 256267)]) #@40 Go up one level in the current thread. (defalias 'gnus-summary-go-up-thread #[nil "À`Âyˆ` bˆ)Ã\"†Â`ÆyÂUƒ1À`Âyˆ` bˆ)Ã\"†, Y„À`Âyˆ` bˆ)Ã\"†B YƒN\fbˆÇ‚OÈ*‡" [get-text-property p 0 gnus-level start level -1 nil t] 3 (#$ . 256571)]) #@132 Go down thread N steps. If N is negative, go up instead. Returns the difference between N and how many steps down that were taken. (defalias 'gnus-summary-down-thread #[(n) "À ˆ ÂWà ! ÂVƒ&\fƒÅ ‚Æ ƒ& S‰‚\fÇ ˆ ÂU„4ÈÉÊ\"ˆ *‡" [gnus-set-global-variables n 0 abs up gnus-summary-go-up-thread gnus-summary-go-down-thread gnus-summary-position-cursor gnus-message 7 "Can't go further"] 4 (#$ . 256822) "p"]) #@130 Go up thread N steps. If N is negative, go up instead. Returns the difference between N and how many steps down that were taken. (defalias 'gnus-summary-up-thread #[(n) "À ˆÁ\n[!‡" [gnus-set-global-variables gnus-summary-down-thread n] 2 (#$ . 257241) "p"]) #@167 Mark articles under current thread as read. If the prefix argument is positive, remove any kinds of marks. If the prefix argument is negative, tick articles instead. (defalias 'gnus-summary-kill-thread #[(&optional unmark) "À ˆ ƒ  !ÃÄ`Æyˆ` bˆ)Ç\"†Æ ŠÊ ˆ ƒn „6Ë\f!ˆ‚I ÆVƒDÍ!ˆ‚IÍ!ˆÐyÆUƒgÄ`Æyˆ` bˆ)Ç\"†aÆV„%щ „*) „{ƒ{Ó ˆ „„ÔÐÃ\"ˆ*ÕÖ!‡" [gnus-set-global-variables unmark prefix-numeric-value t get-text-property p 0 gnus-level level killing gnus-summary-show-thread gnus-summary-mark-article-as-read gnus-killed-mark gnus-summary-mark-article-as-unread gnus-unread-mark gnus-ticked-mark 1 nil gnus-thread-hide-killed gnus-summary-hide-thread gnus-summary-next-subject gnus-set-mode-line summary] 5 (#$ . 257506) "P"]) #@78 Sort summary buffer by article number. Argument REVERSE means reverse order. (defalias 'gnus-summary-sort-by-number #[(&optional reverse) "À ˆÁÂÃB\f\"‡" [gnus-set-global-variables gnus-summary-sort #[nil "À`Âyˆ` bˆ)Ã\"†\f‡" [get-text-property p 0 gnus-number gnus-current-article] 3] gnus-thread-sort-by-number reverse] 3 (#$ . 258260) "P"]) #@150 Sort summary buffer by author name alphabetically. If case-fold-search is non-nil, case of letters is ignored. Argument REVERSE means reverse order. (defalias 'gnus-summary-sort-by-author #[(&optional reverse) "À ˆÁÂÃB\f\"‡" [gnus-set-global-variables gnus-summary-sort #[nil "ÀÁÂ`Äyˆ` bˆ)Å\"†!\"J ÊH!‰ @†, AÌÁÄH!ÌÍH°*‡" [intern-soft int-to-string get-text-property p 0 gnus-number gnus-current-article gnus-newsgroup-headers-hashtb-by-number header gnus-extract-address-components 2 extract " " 1] 7] gnus-thread-sort-by-author reverse] 3 (#$ . 258612) "P"]) #@166 Sort summary buffer by subject alphabetically. `Re:'s are ignored. If case-fold-search is non-nil, case of letters is ignored. Argument REVERSE means reverse order. (defalias 'gnus-summary-sort-by-subject #[(&optional reverse) "À ˆÁÂÃB\f\"‡" [gnus-set-global-variables gnus-summary-sort #[nil "ÀÁÂ`Äyˆ` bˆ)Å\"†!\"J ÊH! ÌÍ Î\"—ÏÁÄH!Ï @†; A°*‡" [intern-soft int-to-string get-text-property p 0 gnus-number gnus-current-article gnus-newsgroup-headers-hashtb-by-number header gnus-extract-address-components 2 extract gnus-simplify-subject gnus-summary-subject-string t " "] 5] gnus-thread-sort-by-subject reverse] 3 (#$ . 259199) "P"]) #@68 Sort summary buffer by date. Argument REVERSE means reverse order. (defalias 'gnus-summary-sort-by-date #[(&optional reverse) "À ˆÁÂÃB\f\"‡" [gnus-set-global-variables gnus-summary-sort #[nil "ÀÁÂÃ`Åyˆ`\fbˆ)Æ\"†!\"JÉH!‡" [gnus-sortable-date intern-soft int-to-string get-text-property p 0 gnus-number gnus-current-article gnus-newsgroup-headers-hashtb-by-number 3] 6] gnus-thread-sort-by-date reverse] 3 (#$ . 259857) "P"]) #@69 Sort summary buffer by score. Argument REVERSE means reverse order. (defalias 'gnus-summary-sort-by-score #[(&optional reverse) "À ˆÁÂÃB\f?\"‡" [gnus-set-global-variables gnus-summary-sort #[nil "À ‡" [gnus-summary-article-score] 1] gnus-thread-sort-by-score reverse] 3 (#$ . 260294) "P"]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-summary-already-sorted nil current-load-list] 2) (defalias 'gnus-summary-sort #[(predicate reverse) "?…]Á „ebˆÄ ÆÇ@$‚\\ACÁ‰ \nË ˆ ƒ3\fƒ3Í ˆ…[Ÿ‰…[ЃXÓ!ƒX!‚Z\"+)‡" [gnus-summary-already-sorted nil buffer-read-only gnus-show-threads sort-subr reverse forward-line end-of-line predicate gnus-summary-prepare-hook gnus-thread-sort-functions gnus-summary-prepare gnus-thread-hide-subtree gnus-summary-hide-all-threads gnus-newsgroup-async gnus-newsgroup-threads gnus-request-asynchronous gnus-newsgroup-name gnus-asynchronous-article-function fboundp] 5]) #@75 Make sortable string by string-lessp from DATE. Timezone package is used. (defalias 'gnus-sortable-date #[(date) "À ‰#‰ÃH ÅH ÇHÉ\fÊ ËH ÌH ÍH#$,‡" [timezone-fix-time date nil 0 year 1 month 2 day timezone-make-sortable-date timezone-make-time-string 3 4 5] 10 (#$ . 261220)]) #@340 Save the current article using the default saver function. If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead. The variable `gnus-default-article-saver' specifies the saver function. (defalias 'gnus-summary-save-article #[(&optional n) "À ˆÁ\n!‰ƒ…ÄÅ @!\"JÈ!ƒ_É‹ˆ\n„)ËÌ!ˆŠŒ qˆÎebˆ`ÐÑÎÌ#†?d}ˆÒÓÎÌ#ƒVÔyˆ`Õyˆ`|ˆ‚A~ˆ+Ö‹ˆ‚xמƒqØמA!ˆ‚xÙÕÚ @#ˆ)Û @!ˆ A‰„ Ü ˆ\n)‡" [gnus-set-global-variables gnus-summary-work-articles n articles intern-soft int-to-string gnus-newsgroup-headers-hashtb-by-number header vectorp ((byte-code "ÀÁ‰ @$‡" [gnus-summary-select-article t nil articles] 5)) gnus-save-all-headers gnus-article-hide-headers t gnus-article-buffer nil buffer-read-only search-forward "\n\n" re-search-forward "^X-Gnus" 0 1 ((byte-code "ƒ\n ˆ‚ÁÂ!ˆÁ‡" [gnus-default-article-saver error "No default saver is defined."] 2)) name gnus-copy-file gnus-message "Article %d is unsaveable" gnus-summary-remove-process-mark gnus-summary-position-cursor] 6 (#$ . 261513) "P"]) #@251 Pipe the current article to a subprocess. If N is a positive number, pipe the N next articles. If N is a negative number, pipe the N previous articles. If N is nil and any articles have been marked with the process mark, pipe those articles instead. (defalias 'gnus-summary-pipe-output #[(&optional arg) "À ˆÁÃ\f!)‡" [gnus-set-global-variables gnus-summary-save-in-pipe gnus-default-article-saver gnus-summary-save-article arg] 2 (#$ . 262668) "P"]) #@253 Append the current article to an mail file. If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead. (defalias 'gnus-summary-save-article-mail #[(&optional arg) "À ˆÁÃ\f!)‡" [gnus-set-global-variables gnus-summary-save-in-mail gnus-default-article-saver gnus-summary-save-article arg] 2 (#$ . 263126) "P"]) #@254 Append the current article to an rmail file. If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead. (defalias 'gnus-summary-save-article-rmail #[(&optional arg) "À ˆÁÃ\f!)‡" [gnus-set-global-variables gnus-summary-save-in-rmail gnus-default-article-saver gnus-summary-save-article arg] 2 (#$ . 263592) "P"]) #@247 Append the current article to a file. If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead. (defalias 'gnus-summary-save-article-file #[(&optional arg) "À ˆÁÃ\f!)‡" [gnus-set-global-variables gnus-summary-save-in-file gnus-default-article-saver gnus-summary-save-article arg] 2 (#$ . 264061) "P"]) (defalias 'gnus-read-save-file-name #[(prompt default-name) "Áƒ.Š\fqˆÅ ˆ ƒ+ebˆÁÆǃ$ @A@\nB A‰„~ˆ)\n„FÈ ÊË\f!ÍRÎ\f!\f#‚ƒ\nGÏUƒ_È Ê\n@ÍR‰\n@P#‚ƒÑÒ\nŸ\"Ó ÔP\nÁ‰$Ö˜ƒ\n@@‚P)*‡" [gnus-split-methods nil split-name methods gnus-article-buffer gnus-narrow-to-headers (byte-code "À @@ÂÃ#‡" [re-search-forward methods nil t] 4) ((error)) read-file-name prompt " (default " file-name-nondirectory default-name ") " file-name-directory 1 gnus-article-save-directory mapcar #[(el) "C‡" [el] 1] completing-read " " result ""] 6]) #@209 Append this article to Rmail file. Optional argument FILENAME specifies file name. Directory to save to is default to `gnus-article-save-directory' which is initialized from the SAVEDIR environment variable. (defalias 'gnus-summary-save-in-rmail #[(&optional filename) "À ˆ \n \f#„ÇÈ \"ÉÊ!!ˆË \fÍŽÎ!ˆŠŒ~ˆÐ!ˆ,‰)‡" [gnus-set-global-variables gnus-rmail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-rmail default-name filename gnus-read-save-file-name "Save in rmail file:" gnus-make-directory file-name-directory selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer gnus-output-to-rmail] 4 (#$ . 265074) nil]) #@213 Append this article to Unix mail file. Optional argument FILENAME specifies file name. Directory to save to is default to `gnus-article-save-directory' which is initialized from the SAVEDIR environment variable. (defalias 'gnus-summary-save-in-mail #[(&optional filename) "À ˆ \n \f#„ÇÈ \"É …Ê !\"ËÊ!!ˆÌ  ÎŽÏ!ˆŠŒ~ˆÑ!ƒMÒ!ƒMÓ!ˆ‚UÔÕÖ‰$ˆ,‰)‡" [gnus-set-global-variables gnus-mail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-mail default-name filename gnus-read-save-file-name "Save in Unix mail file:" expand-file-name file-name-directory gnus-make-directory selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer file-readable-p mail-file-babyl-p gnus-output-to-rmail rmail-output 1 t] 5 (#$ . 265791) nil]) #@203 Append this article to file. Optional argument FILENAME specifies file name. Directory to save to is default to `gnus-article-save-directory' which is initialized from the SAVEDIR environment variable. (defalias 'gnus-summary-save-in-file #[(&optional filename) "À ˆ \n \f#„ÇÈ \"ÉÊ!!ˆË \fÍŽÎ!ˆŠŒ~ˆÐ!ˆ,‰)‡" [gnus-set-global-variables gnus-file-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-file default-name filename gnus-read-save-file-name "Save in file:" gnus-make-directory file-name-directory selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer gnus-output-to-file] 4 (#$ . 266619) nil]) #@34 Pipe this article to subprocess. (defalias 'gnus-summary-save-in-pipe #[(&optional command) "À ˆÁ \"‰Řƒ Æ ÈŽÉ\n!ˆŒ~ˆËed\fÌ$ˆ+\f‰)‡" [gnus-set-global-variables read-string "Shell command on article: " gnus-last-shell-command command "" selected-window GnusStartBufferWindow ((select-window GnusStartBufferWindow)) pop-to-buffer gnus-article-buffer shell-command-on-region nil] 6 (#$ . 267319) nil]) (defalias 'gnus-summary-insert-pseudos #[(pslist &optional not-view) "ÀÁ`Ãyˆ`\nbˆ)Ä\"† ÀÉ!„(ÊËÌ\"!ˆÍ ˆ„ÓÏÑ\"‰À‰‰ƒÒÒ@žAÕ@žACƒ‹Aƒ‹†fÖÒA@žA†qטƒ‹ÕA@žAB‰AA¡ˆ‚UƒÉØÙ\"„žÚBÚBÛ@žƒÉÛ@žØÙ\"ƒ½Ë‚¾ÜÝÞÚ#\"¡ˆA‰„D+ƒ „…}Û@žƒ÷áÛ@žAâ=\"ˆA‰‚ߊ…|ÉÇ@žA†!Á`Ãyˆ`\nbˆ)Ä\"†! !ˆãyˆ`äåÕ@žA!æÛ@žA†=ç豈é‰TÄ*ë,íÃî@¯#ˆïyˆðñ*!2\"@Lˆ*3B3*S*A‰„À)+‡" [nil get-text-property p 0 gnus-number gnus-current-article b article buffer-read-only gnus-summary-goto-subject error format "No such article: %d" gnus-summary-position-cursor gnus-view-pseudos-separately sort pslist gnus-pseudos< action files ps name "1" "2" string-match "%s" " " execute concat mapconcat #[(f) "‡" [f] 1] gnus-view-pseudos not-view gnus-execute-command not-confirm 1 " " file-name-nondirectory ": " "" "\n" add-text-properties gnus-reffed-article-number gnus-mark gnus-unread-mark gnus-level gnus-pseudo -1 intern int-to-string gnus-newsgroup-headers-hashtb-by-number gnus-newsgroup-unreads] 12]) (defalias 'gnus-pseudos< #[(p1 p2) "À žAÀ\nžA‰… …\f ™*‡" [action p1 p2 c2 c1] 4]) (defalias 'gnus-request-pseudo-article #[(props) "À žƒ ÂÀ žA!ˆÃ`Åyˆ`\fbˆ)Æ\"†ÈÉ!)‡" [execute props gnus-execute-command get-text-property p 0 gnus-number gnus-current-article run-hooks gnus-mark-article-hook] 3]) (defalias 'gnus-execute-command #[(command &optional automatic) "ŠÀ ˆ qˆ\nƒ ‚ÄÅ \"ÆÈ ˆÉ ʱˆ ƒ/ÌÍÆÎÏ %‚8ÐÎÆÑÆÏ &+‡" [gnus-article-setup-buffer gnus-article-buffer automatic command read-string "Command: " nil buffer-read-only erase-buffer "$ " "\n\n" gnus-view-pseudo-asynchronously start-process "gnus-execute" "sh" "-c" call-process t] 7]) #@18 Copy FILE to TO. (defalias 'gnus-copy-file #[(file &optional to) "À ˆ „\fÂÃ\f\"Å !ƒÆ !Ç!PÉ \"‡" [gnus-set-global-variables to read-file-name "Copy file to: " default-directory file-directory-p file-name-as-directory file-name-nondirectory file copy-file] 3 (#$ . 269488) (list (read-file-name "Copy file: " default-directory) (read-file-name "Copy file to: " default-directory))]) #@30 Edit the "global" kill file. (defalias 'gnus-summary-edit-global-kill #[(article) "À ˆÁ\n!‡" [gnus-set-global-variables gnus-group-edit-global-kill article] 2 (#$ . 269884) (list (gnus-summary-article-number))]) #@58 Edit a local kill file applied to the current newsgroup. (defalias 'gnus-summary-edit-local-kill #[nil "À ˆÁÂÃ`Åyˆ`\fbˆ)Æ\"†!\"J À ˆÊÃ`Åyˆ`\fbˆ)Æ\"†4 \"‡" [gnus-set-global-variables intern-soft int-to-string get-text-property p 0 gnus-number gnus-current-article gnus-newsgroup-headers-hashtb-by-number gnus-current-headers gnus-group-edit-local-kill gnus-newsgroup-name] 5 (#$ . 270102) nil]) (byte-code "ÀÁÂÃ#ˆÄÅ!„ÆÅB„iÉ Ê!ˆËÌÍ#ˆËÎÏ#ˆËÐÑ#ˆËÒÓ#ˆËÔÓ#ˆËÕÖ#ˆË×Ø#ˆËÚ#ˆËÛÜ#ˆËÝÞ#ˆËßà#ˆáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ@ABCDEFG×HIJKLMNOPQRSTUVWXYZ[\\]^_×`abc¯Ed ƒdƒËd@e#ˆdAd‚)fghijklmnopqrs¯d ƒhdƒhËd@t#ˆdAd‚L)Ƈ" [put gnus-article-mode mode-class special boundp gnus-boogaboo nil current-load-list gnus-article-mode-map make-keymap suppress-keymap define-key " " gnus-article-next-page "" gnus-article-prev-page "^" gnus-article-refer-article "h" gnus-article-show-summary "s" " " gnus-article-mail "?" gnus-article-describe-briefly gnus-mouse-2 gnus-article-push-button " " gnus-article-press-button " " gnus-article-next-button "" gnus-bug "p" "N" "P" "Ž" "" "î" "ð" "." "," "ó" "ò" "<" ">" "j" "u" "!" "U" "d" "D" "E" "õ" "Õ" "k" " " "‹" "Œ" "e" "#" "£" "”" "“" "ˆ" "†" "‚" "•" "„" "&" "" "" "“" "" "" "" "" " " "" "ç" "w" "" "ô" "C" "o" "" "|" "ë" "Ë" "V" "" " " "x" "X" "t" "g" "l" "" "" "v" commands gnus-article-summary-command "q" "Q" "c" "r" "R" "" "m" "a" "f" "F" "=" "n" "^" "Þ" gnus-article-summary-command-nosave] 69) #@604 Major mode for displaying an article. All normal editing commands are switched off. The following commands are available: \ \[gnus-article-next-page] Scroll the article one page forwards \[gnus-article-prev-page] Scroll the article one page backwards \[gnus-article-refer-article] Go to the article referred to by an article id near point \[gnus-article-show-summary] Display the summary buffer \[gnus-article-mail] Send a reply to the address near point \[gnus-article-describe-briefly] Describe the current mode briefly \[gnus-info-find-node] Go to the Gnus info node (defalias 'gnus-article-mode #[nil "ƒÁ ˆÂ ˆÃÅÆ!ˆÇ!È8Éšƒ&țʠˆË\fÍÅÏ!ˆÐž„?ÐÑDBÒ!ˆÅÔ!ˆÖp!ˆ×ÙÚ!‡" [gnus-visual gnus-article-make-menu-bar kill-all-local-variables "-- " mode-line-modified make-local-variable mode-line-format copy-sequence 3 " " "" "Article" mode-name gnus-article-mode major-mode minor-mode-alist gnus-show-mime " MIME" use-local-map gnus-article-mode-map page-delimiter gnus-page-delimiter buffer-disable-undo t buffer-read-only run-hooks gnus-article-mode-hook] 2 (#$ . 271749) nil]) #@33 Initialize article mode buffer. (defalias 'gnus-article-setup-buffer #[nil "À !ƒ Š qˆÂp!ˆÃÅ ˆÇ=„Ç ˆp)‡ŠÈ !qˆÅ ˆÇ ˆp)‡" [get-buffer gnus-article-buffer buffer-disable-undo t buffer-read-only gnus-add-current-to-buffer-list major-mode gnus-article-mode get-buffer-create] 2 (#$ . 272891)]) (defalias 'gnus-article-set-window-start #[(&optional line) "ÀÁ\n!Š\nqˆebˆ „e‚\"ÄÅÆ\"ˆÇÈÉÊ#ˆ yˆ`)\"‡" [set-window-start get-buffer-window gnus-article-buffer line gnus-message 6 "Moved to bookmark" search-forward "\n\n" nil t] 6]) #@48 Get an article and insert it into this buffer. (defalias 'gnus-request-article-this-buffer #[(article group) "† ÂÃ!!ˆ\f;ƒ Ç\f!ˆ)\f§ƒrŠqˆÉÊ\f! \"J\f\fÍWƒIÎ\f!ƒB\fÏH‚IÐÑ\f!ˆÃ !‰@Ó=ƒqÔA@!\fÕHP×!ƒpÓØ!ˆ)+ƒ…\f§ƒ…Ú\f\"ƒ…ć\f;„\f§ƒÄÛ ˆÜcˆÝe!‰ƒ­ß@!ˆA‰„ž)Û ˆ\f;…· à\fp#…ÂÄ)‡\f‡" [group gnus-newsgroup-name gnus-check-server gnus-find-method-for-group article gnus-refer-article-method gnus-override-method gnus-read-header gnus-summary-buffer intern-soft int-to-string gnus-newsgroup-headers-hashtb-by-number header 0 vectorp 4 pseudo gnus-request-pseudo-article method nneething file-name-as-directory 1 dir file-directory-p gnus-group-enter-directory gnus-use-cache gnus-cache-request-article erase-buffer "i" overlays-at overlays delete-overlay gnus-request-article] 5 (#$ . 273425)]) #@69 Read the headers of article ID and enter them into the Gnus system. (defalias 'gnus-read-header #[(id) "ÀÂÄ C\")…Ç @‰…A ;ƒ! È Iˆ \nB\nËÌ ÈH! \" Lˆ ;ƒ= S  )‡" [nil header t gnus-nov-is-evil gnus-retrieve-headers id gnus-newsgroup-name gnus-get-newsgroup-headers 0 gnus-reffed-article-number gnus-newsgroup-headers intern int-to-string gnus-newsgroup-headers-hashtb-by-number gnus-current-headers] 4 (#$ . 274269)]) #@210 Prepare ARTICLE in article mode buffer. ARTICLE should either be an article number or a Message-ID. If ARTICLE is an id, HEADER should be the article headers. If ALL-HEADERS is non-nil, no headers are hidden. (defalias 'gnus-article-prepare #[(article &optional all-headers header) "ŠÁ=„\n\nqˆpÃÄ !!„ÆÄ !!ˆÇ È\"ˆ ƒ+ ÊH‚-  p\f  ÐŠÒ ˆqˆÐÕ \")‰„|Š §ƒo  B\nqˆ Ø \"ˆÚÛÜ\"ˆÝ ˆ)ЂyÞ=„Šß=ƒ¿Š\fqˆ !B!ÊÐ\"Ðß=ƒ±ãä!ˆ‚µãË!ˆå ˆ)æË!‚y §ƒ< =„<Š\fqˆ !B! çè!)\"J\" Bê ˆëì!ˆæä!ˆ-ƒëî!ˆå ˆ/†012ƒ;óô !!ƒ;õ ô ! 6> 7> 8>&ˆ)ÐëÎ!ˆëù!ˆ:ƒ[;ƒWüý!ƒ[> ˆëÿ!ˆ)ebˆ@ƒmA ˆæË!ˆãË!ˆebˆÈ.‡" [major-mode gnus-summary-mode gnus-summary-buffer gnus-server-opened gnus-find-method-for-group gnus-newsgroup-name gnus-check-server gnus-request-group t header 0 article summary-buffer gnus-article-internal-prepare-hook internal-hook group nil result gnus-article-setup-buffer gnus-article-buffer buffer-read-only gnus-request-article-this-buffer gnus-article-current gnus-current-article gnus-summary-mark-article gnus-canceled-mark gnus-message 1 "No such article (may be canceled)" ding pseudo nneething gnus-last-article gnus-newsgroup-history gnus-current-headers gnus-configure-windows summary gnus-set-global-variables gnus-set-mode-line intern-soft int-to-string gnus-newsgroup-headers-hashtb-by-number gnus-summary-show-thread run-hooks gnus-mark-article-hook gnus-visual gnus-visual-mark-article-hook all-headers gnus-show-all-headers gnus-have-all-headers gnus-use-cache vectorp gnus-get-header-by-number gnus-cache-possibly-enter-article gnus-newsgroup-marked gnus-newsgroup-dormant gnus-newsgroup-unreads gnus-article-prepare-hook gnus-show-mime gnus-strict-mime gnus-fetch-field "Mime-Version" gnus-show-mime-method gnus-article-display-hook gnus-break-pages gnus-narrow-to-page] 8 (#$ . 274709)]) #@50 Show all article headers in article mode buffer. (defalias 'gnus-article-show-all-headers #[nil "ŠÀ ˆ qˆÂÄed #*‡" [gnus-article-setup-buffer gnus-article-buffer nil buffer-read-only remove-text-properties gnus-hidden-properties] 4 (#$ . 276607)]) #@96 Hide unwanted headers if `gnus-have-all-headers' is nil. Provided for backwards compatability. (defalias 'gnus-article-hide-headers-if-wanted #[nil "Šqˆ )†  ‡" [gnus-summary-buffer gnus-have-all-headers gnus-article-hide-headers] 1 (#$ . 276861)]) #@55 Hide unwanted headers and possibly sort them as well. (defalias 'gnus-article-hide-headers #[(&optional delete) "ŠqˆŒ ‰‰‰~ˆebˆÈÉ!ƒ\"Êyˆ‚o„-Ëe`\f#ˆ`ÍÎÂÏ#ˆÐyˆ`}ˆebˆÑÒÂÏ#ƒŒÓyˆ;ƒUÈ!„h;„†;ƒ†È!„†`ÊyˆÑÒÂÏ#ˆÓyˆ\f`{ B\f`|ˆ\fbˆ‚=Êyˆ‚=ebˆƒÆ ƒÆ ‰ƒ¯Ö@ @\"„¯ A‰„ž ƒ½ @cˆ× @ \"A‰„” ƒÕ @cˆ A‰„ʃà`d|‚æË`d\f#.‡" [gnus-article-buffer gnus-sorted-header-list nil want-l beg want-list buffer-read-only sorted looking-at "From " 1 add-text-properties gnus-hidden-properties search-forward "\n\n" t -1 re-search-forward "^[^ ]*:" 0 gnus-visible-headers gnus-ignored-headers string-match delq delete] 6 (#$ . 277118) "P"]) #@39 Translate overstrikes into bold text. (defalias 'gnus-article-treat-overstrike #[nil "ŠqˆÁÃÄÁÅ#…ig`ÆZf‰=ƒ2É`ÆZ`ÊÅ$ˆÉ``TËÌ$ˆ‚eÍ=ƒMÉ`S`TÊÅ$ˆÉ`S`ËÎ$ˆ‚eÍ=ƒeÉ`ÆZ`ÊÅ$ˆÉ``TËÎ$ˆ*‚*‡" [gnus-article-buffer nil buffer-read-only search-forward "" t 2 previous next put-text-property invisible face bold 95 underline] 6 (#$ . 277786) nil]) #@24 Format too long lines. (defalias 'gnus-article-word-wrap #[nil "ŠqˆÁebˆÃÄÁÅ#ˆÆˆÇÈÅ \n m?…:i\fÍ ^Yƒ4hÎU„4ÏÁ!ˆÐˆ‚-‡" [gnus-article-buffer nil buffer-read-only search-forward "\n\n" t 1 "^[>|#:<;* ]*[ ]*$" "[ ]*\\([|#:<;>*]+ *\\)?" adaptive-fill-mode adaptive-fill-regexp paragraph-start fill-column window-width 58 fill-paragraph 2] 4 (#$ . 278140) nil]) #@42 Remove carriage returns from an article. (defalias 'gnus-article-remove-cr #[nil "ŠqˆÁebˆÃÄÁÅ#…ÆÇʼn#ˆ‚ *‡" [gnus-article-buffer nil buffer-read-only search-forward " " t replace-match ""] 4 (#$ . 278514) nil]) #@54 Look for an X-Face header and display it if present. (defalias 'gnus-article-display-x-face #[(&optional force) "ŠqˆÁ‰ŒebˆÆÇ!ˆe`}ˆebˆÈÉ!\n…‚ „>\fƒ>\f…‚ …‚Í\f \"?…‚ebˆÎÏÂÁ#…‚`ÎÐÂÁ#S\n9ƒsÓ\n!„iÔÕ\n\"…\n\"‚Ö×ÂØÂÙ\n&*-‡" [gnus-article-buffer t nil from case-fold-search inhibit-point-motion-hooks search-forward "\n\n" mail-fetch-field "from" gnus-article-x-face-command force gnus-article-x-face-too-ugly string-match re-search-forward "^X-Face: " "^\\($\\|[^ ]\\)" end beg fboundp error "%s is not a function" call-process-region "sh" 0 "-c"] 9 (#$ . 278735) (list (quote force))]) #@287 Do a naive translation of a quoted-printable-encoded article. This is in no way, shape or form meant as a replacement for real MIME processing, but is simply a stop-gap measure until MIME support is written. If FORCE, decode the article whether it is marked as quoted-printable or not. (defalias 'gnus-article-de-quoted-unreadable #[(&optional force) "ŠqˆÁÂÃÄ!„ …+ÉÊ \"…+ebˆËÌÂÍ#ˆÎ`d\",‡" [gnus-article-buffer t nil gnus-fetch-field "content-transfer-encoding" type buffer-read-only case-fold-search force string-match "quoted-printable" search-forward "\n\n" move gnus-mime-decode-quoted-printable] 4 (#$ . 279365) (list (quote force))]) (defalias 'gnus-mime-decode-quoted-printable #[(from to) "ŠbˆÁ Ä#…LgÅ=ƒÆÇ!ˆÆÈ!ˆ‚ÉÊ!ƒ7ÆÇ!ˆË``Ì\\{!cˆÆÌ!ˆ‚ÉÂ!ƒDÆÈ!ˆ‚ÍÎÏ\"ˆ‚)‡" [from search-forward "=" to t 10 delete-char -1 1 looking-at "[0-9A-F][0-9A-F]" hexl-hex-string-to-integer 2 gnus-message 3 "Malformed MIME quoted-printable message"] 4]) (byte-code "ÀÁ!„ÂÃÄ_BÅÆBÇÄBÈÉBÊËBÌÍB¯ÁBÀ‡" [boundp gnus-article-time-units year 365.25 86400 week 604800 day hour 3600 minute 60 second 1 current-load-list] 7) #@167 Convert DATE date to universal time in the current article. If TYPE is `local', convert to local time; if it is `lapsed', output how much time has lapsed since DATE. (defalias 'gnus-article-date-ut #[(&optional type) "†ÁÂ`Äyˆ` bˆ)Å\"†!†ÇÈHÉ\n‰ ?†, ǘ?…ÑŠ\fqˆÍebˆÏ\nÍÐ#ƒbÄyˆÑ\n!ƒb`Äyˆ` bˆ)͈`T|ˆ‚lebˆÒÓ!ÔZbˆÖ=ƒ}×ÍØÙÚQ‚ÏÛ=ƒŽ×ÍÜÝÚQ‚ÏÞ=ƒÊÍßà!â!!#Í$Í%#ÄUƒ²æ‚Æçèé*Ç#!ÄVƒÄë‚ÅìQ,‚Ïíî\"c**‡" [gnus-current-headers gnus-get-header-by-number get-text-property p 0 gnus-number gnus-current-article "" 3 "^Date: \\|^X-Sent: " date-regexp date gnus-article-buffer nil buffer-read-only re-search-forward t looking-at search-forward "\n\n" 2 type local "Date: " (timezone-make-date-arpa-standard date) ((error date)) "\n" ut (timezone-make-date-arpa-standard date nil "UT") ((error date)) lapsed (byte-code "ÀÁ à Ä#!ÀÁ ÆÄ#!Z‡" [gnus-seconds-since-epoch timezone-make-date-arpa-standard current-time-string current-time-zone "UT" date nil] 6) ((error 0)) real-sec abs sec num prev "X-Sent: Now\n" "X-Sent: " mapconcat #[(unit) "À \nA¥!‰ÄUƒŇ \nA_ZƒÇ‚ ÅÈÉ !!ÊË\n@! ÌVƒ4Í‚5Ű·" [ffloor sec unit num 0 "" prev ", " int-to-string floor " " symbol-name 1 "s" t] 6] gnus-article-time-units " ago\n" " in the future\n" error "Unknown conversion type: %s"] 6 (#$ . 280502) (list (quote ut))]) #@57 Convert the current article date to the local timezone. (defalias 'gnus-article-date-local #[nil "ÀÁ!‡" [gnus-article-date-ut local] 2 (#$ . 281847) nil]) #@68 Convert the current article date to time lapsed since it was sent. (defalias 'gnus-article-date-lapsed #[nil "ÀÁ!‡" [gnus-article-date-ut lapsed] 2 (#$ . 282008) nil]) #@59 Do some article highlighting if `gnus-visual' is non-nil. (defalias 'gnus-article-maybe-highlight #[nil "…Á ‡" [gnus-visual gnus-article-highlight-some] 1 (#$ . 282182)]) #@62 Append the current article to an Rmail file named FILE-NAME. (defalias 'gnus-output-to-rmail #[(file-name) "ÀÁ!ˆÂ !‰pÅÆ!ŠÉ !„NÊ !„NËÌ ÍQ!ƒJÎ !ŠqˆÐ ˆÑÓed ÔÕ%ˆ*Ö!ˆ)‚N×Ø!ˆqˆÙp!ˆÚ ˆÛ!ˆÜ ˆÉ !‰„sÞed #ˆ‚´qˆÑßà!…€àJ!\"!ƒ~ˆdd}ˆÛ!ˆ!ƒ³ebˆ~ˆãä!ˆ`d}ˆeTbˆåÔ!ˆæ!!ˆ**Ö!*‡" [require rmail expand-file-name file-name rmail-default-rmail-file get-buffer-create " *Gnus-output*" tmpbuf artbuf get-file-buffer file-exists-p gnus-yes-or-no-p "\"" "\" does not exist, create it? " create-file-buffer file-buffer rmail-insert-rmail-file-header nil require-final-newline write-region t 1 kill-buffer error "Output file does not exist" buffer-disable-undo erase-buffer insert-buffer-substring gnus-convert-article-to-rmail outbuf append-to-file boundp rmail-current-message msg buffer-read-only search-backward "" rmail-count-new-messages rmail-show-message] 7 (#$ . 282362)]) #@55 Append the current article to a file named FILE-NAME. (defalias 'gnus-output-to-file #[(file-name) "À !pÂÃ!Š\fqˆÆp!ˆÇ ˆÈ !ˆdbˆÉcˆÊed #ˆ)Ë\f!*‡" [expand-file-name file-name get-buffer-create " *Gnus-output*" tmpbuf artbuf buffer-disable-undo erase-buffer insert-buffer-substring "\n" append-to-file kill-buffer] 4 (#$ . 283261)]) #@60 Convert article in current buffer to Rmail message format. (defalias 'gnus-convert-article-to-rmail #[nil "ÀebˆÂcˆÃÄÀÅ#ƒÆÇʼn#ˆ‚dbˆÈc)‡" [nil buffer-read-only "\f\n0, unseen,,\n*** EOOH ***\n" search-forward "\n" t replace-match "\n^_" ""] 4 (#$ . 283599)]) #@205 Make text outside current page invisible except for page delimiter. A numeric arg specifies to move forward or backward by that many pages, thus showing a page other than the one point was originally in. (defalias 'gnus-narrow-to-page #[(&optional arg) "ƒ\nÁ!‚ ŠÃÄ!ˆ~ˆÂVƒ Ã!ˆ‚+ÂWƒ+ÃS!ˆÃ ˆ`ÃÄ!ˆlƒ>o„>Åyˆ`})‡" [arg prefix-numeric-value 0 forward-page -1 1] 3 (#$ . 283870) "P"]) #@118 Rewrite Date header described in GMT to local in current buffer. Intended to be used with gnus-article-prepare-hook. (defalias 'gnus-gmt-to-local #[nil "ŠŒ~ˆebˆeÀÁÂÃ#ˆ`}ˆebˆÄÅÂÆ#…6ÂÇȔȕ\" \nȔȕ|ˆË ÂÌ #c**‡" [search-forward "\n\n" nil move re-search-forward "^Date:[ ]\\(.*\\)$" t buffer-substring-no-properties 1 date buffer-read-only timezone-make-date-arpa-standard current-time-zone] 5 (#$ . 284269)]) #@143 Show next page of current article. If end of article, return non-nil. Otherwise return nil. Argument LINES specifies lines to be scrolled up. (defalias 'gnus-article-next-page #[(&optional lines) "ÀÁ!ˆŠÂˆÃ …m)ƒ*\fƒ\"ŠŒ~ˆÅyˆm*ƒ$ƇÇÅ!ˆÂ‡ÂÈɈ‡" [move-to-window-line -1 nil pos-visible-in-window-p gnus-break-pages 1 t gnus-narrow-to-page (scroll-up lines) ((end-of-buffer (byte-code "db‡" [] 1)))] 3 (#$ . 284688) "P"]) #@92 Show previous page of current article. Argument LINES specifies lines to be scrolled down. (defalias 'gnus-article-prev-page #[(&optional lines) "ÀÁ!ˆ\nƒoƒŒ~ˆo)„ÃÄ!ˆdbˆÅÄ!‡Æ!‡" [move-to-window-line 0 gnus-break-pages gnus-narrow-to-page -1 recenter scroll-down lines] 2 (#$ . 285119) "P"]) #@52 Read article specified by message-id around point. (defalias 'gnus-article-refer-article #[nil "ÀÁÂÃ#ˆÄÅÂÃ#ƒƔƕ{qˆÉ!)‡ÊË!‡" [search-forward ">" nil t re-search-backward "\\(<[^<> \n]+>\\)" 1 message-id gnus-summary-buffer gnus-summary-refer-article error "No references around point"] 4 (#$ . 285423) nil]) #@45 Reconfigure windows to show summary buffer. (defalias 'gnus-article-show-summary #[nil "ÀÁ!ˆÂ !‡" [gnus-configure-windows article gnus-summary-goto-subject gnus-current-article] 2 (#$ . 285746) nil]) #@41 Describe article mode commands briefly. (defalias 'gnus-article-describe-briefly #[nil "ÀÁÂÃ!\"‡" [gnus-message 6 substitute-command-keys "\\\\[gnus-article-next-page]:Next page \\[gnus-article-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"] 4 (#$ . 285952) nil]) #@51 Execute the last keystroke in the summary buffer. (defalias 'gnus-article-summary-command #[nil "pÀ ÁÅÇ\"ˆÈÉ Ê \"Ë\n!ˆ\fqˆÌ !ˆÍÎp!`\"+‡" [current-window-configuration nil func owin obuf switch-to-buffer gnus-summary-buffer norecord lookup-key current-local-map this-command-keys call-interactively set-window-configuration set-window-point get-buffer-window] 3 (#$ . 286344) nil]) #@51 Execute the last keystroke in the summary buffer. (defalias 'gnus-article-summary-command-nosave #[nil "À Ä\"ˆÅÆ Ç \"È !)‡" [nil func pop-to-buffer gnus-summary-buffer norecord lookup-key current-local-map this-command-keys call-interactively] 3 (#$ . 286737) nil]) (defalias (quote gnus-batch-kill) (quote gnus-batch-score)) #@272 Run batched scoring. Usage: emacs -batch -l gnus -f gnus-batch-score ... Newsgroups is a list of strings in Bnews format. If you want to score the comp hierarchy, you'd say "comp.all". If you would not like to score the alt hierarchy, you'd say "!alt.all". (defalias 'gnus-batch-score #[nil "ÀÁÂÃÄ \"\"!ÇÉ\nÉ @\fA ÉÉÉÉÉÉÓ ˆA‰ƒ§@@Õ\"J@A@Xƒž@ƒž@Ç=„k@ØU„ž\fƒyÙ\f\"‚zǃž ƒ‹Ù \"„žÚÉÇ#ˆpÛ!=ƒžÝ ˆA‰„;Þ!ˆà . ‡" [gnus-newsrc-parse-options apply concat mapcar #[(g) "ÁP‡" [g " "] 2] command-line-args-left yes-and-no t gnus-expert-user nil nnmail-spool-file gnus-use-dribble-file yes no group newsrc entry gnus-novice-user gnus-large-newsgroup gnus gnus-newsrc-alist intern-soft gnus-newsrc-hashtb gnus-level-subscribed 0 string-match gnus-summary-read-group get-buffer gnus-summary-buffer gnus-summary-exit switch-to-buffer gnus-group-buffer gnus-group-save-newsrc] 7 (#$ . 287073) nil]) #@92 Apply a kill file to the current newsgroup. Returns the number of articles marked as read. (defalias 'gnus-apply-kill-file #[nil "ÀÁÂ!!„ÀÁ !!ƒÄ ‡Å‡" [file-exists-p gnus-newsgroup-kill-file nil gnus-newsgroup-name gnus-apply-kill-file-internal 0] 3 (#$ . 288050)]) (defalias 'gnus-kill-save-kill-buffer #[nil "ŠÀ !Ã\n!…Ã\n!qˆÄ ƒÅ ˆÆp!*‡" [gnus-newsgroup-kill-file gnus-newsgroup-name file get-file-buffer buffer-modified-p save-buffer kill-buffer] 2]) #@27 Suffix of the kill files. (defvar gnus-kill-file-name "KILL" (#$ . 288516)) #@115 Return the name of a kill file name for NEWSGROUP. If NEWSGROUP is nil, return the global kill file name instead. (defalias 'gnus-newsgroup-kill-file #[(newsgroup) "ƒ\nÁ˜ƒ \f†Å\"‡ÆÇ!ƒ'ÂÈ!É Q\f†%Å\"‡ÂÊ!Ë Q\f†3Å\"‡" [newsgroup "" expand-file-name gnus-kill-file-name gnus-kill-files-directory "~/News" gnus-use-long-file-name not-kill gnus-newsgroup-saveable-name "." gnus-newsgroup-directory-form "/"] 4 (#$ . 288599)]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp gnus-dribble-ignore nil current-load-list gnus-dribble-eval-file] 2) (defalias 'gnus-dribble-file-name #[nil "ÁP‡" [gnus-current-startup-file "-dribble"] 2]) (defalias 'gnus-dribble-enter #[(string) "?…# …# !…#p qˆ\fűˆÆÇp!d\"ˆ q)‡" [gnus-dribble-ignore gnus-dribble-buffer buffer-name obuf string "\n" set-window-point get-buffer-window] 3]) (defalias 'gnus-dribble-read-file #[nil "À ŠÂà !!‰qˆÅ ˆÆ ˆÇ !ˆÈp!ˆÉp!ˆÊË!ˆÌ ÍÐ!„7Ð !…[Ñ \"ƒBÒ !ˆÓ ÔU„QÊÍ!ˆÕÖ!…[͉,‡" [gnus-dribble-file-name dribble-file get-buffer-create file-name-nondirectory gnus-dribble-buffer gnus-add-current-to-buffer-list erase-buffer set-visited-file-name buffer-disable-undo bury-buffer set-buffer-modified-p nil make-auto-save-file-name t gnus-dribble-ignore auto file-exists-p file-newer-than-file-p insert-file-contents buffer-size 0 gnus-y-or-n-p "Auto-save file exists. Do you want to read it? " gnus-dribble-eval-file] 3]) (defalias 'gnus-dribble-eval-file #[nil "…ÁŠÂ\fqˆÅp!*‡" [gnus-dribble-eval-file nil t gnus-dribble-ignore gnus-dribble-buffer eval-buffer] 2]) (defalias 'gnus-dribble-delete-file #[nil "ÀÁ !ƒ\fÂÁ !ˆ …(Š qˆÄ À !ƒ! !ˆÆ ˆÇÈ!*‡" [file-exists-p gnus-dribble-file-name delete-file gnus-dribble-buffer make-auto-save-file-name auto erase-buffer set-buffer-modified-p nil] 2]) (defalias 'gnus-dribble-save #[nil "…Á!…ŠqˆÂ )‡" [gnus-dribble-buffer buffer-name save-buffer] 2]) (defalias 'gnus-dribble-clear #[nil "Š…#;ƒÁ‚Â!…#qˆÃ ˆÄÅ!ˆÆ ‰)‡" [gnus-dribble-buffer get-buffer buffer-name erase-buffer set-buffer-modified-p nil buffer-size buffer-saved-size] 2]) #@99 Open a method for getting news. If CONFIRM is non-nil, the user will be asked for an NNTP server. (defalias 'gnus-start-news-server #[(&optional confirm) "À\n?…Á „ À ƒ ÆÇÈÉ\fC\nB\"À‰\f%\fƒc\f;ƒc\f˘„c\f˘„;\f̘ƒBÍÎ D‚aÏÐ\f\"ƒ^Ñ\fÒÓÔÕ\fÖÀOP!!D×ÀDF‚aØ\fD@‰Í=ƒyÚÍ!ˆÛÜÝ\"ˆ‚ Ñ=ƒ‹ÚÑ!ˆÛÜÞ\"ˆ‚ÚØ!ˆßà!ˆá!†Áâ!†ÁãäåA@æ!#!†ÁÛÖçA@#ˆè ˆÀ)‡" [nil how gnus-current-select-method gnus-nntp-service gnus-nntp-server confirm completing-read "NNTP server: " mapcar #[(server) "C‡" [server] 1] gnus-secondary-servers "" "::" nnspool system-name string-match "^:" nnmh nnmh-directory file-name-as-directory expand-file-name "~/" 1 nnmh-get-new-mail nntp gnus-select-method require gnus-message 5 "Looking up local news spool..." "Looking up mh spool..." run-hooks gnus-open-server-hook gnus-server-opened gnus-open-server gnus-y-or-n-p format "%s open error: '%s'. Continue? " gnus-status-message "Couldn't open server on %s" ding] 10 (#$ . 290691)]) #@48 If the news server is down, start it up again. (defalias 'gnus-check-server #[(&optional method) "ƒ‚ ‰;ƒÂ!Ã!ƒÄ‚2ÅÆÇ@A@$ˆÈÉ!ˆÊ!ËÌ!ˆ)‡" [method gnus-select-method gnus-server-to-method gnus-server-opened t gnus-message 5 "Opening server %s on %s..." run-hooks gnus-open-server-hook gnus-open-server message ""] 6 (#$ . 291669)]) #@148 Check the status of the NNTP server. If the status of the server is clear and MESSAGE is non-nil, MESSAGE is returned insted of the status string. (defalias 'gnus-nntp-message #[(&optional message) "ÀÁ\n!! †\nĉ;ƒ GÆVƒ ‚ *‡" [gnus-status-message gnus-find-method-for-group gnus-newsgroup-name message "" status 0] 4 (#$ . 292021)]) (defalias 'gnus-get-function #[(method function) ";ƒ Á!ÂÃÄ@ #!Ç!„,È@!ˆÇ!„,ÉÊ\"ˆ)‡" [method gnus-server-to-method intern format "%s-%s" function func fboundp require error "No such function: %s"] 5]) (defalias 'gnus-open-server #[(method) "À Â\" A@ AA\"‡" [gnus-get-function method open-server] 3]) (defalias 'gnus-close-server #[(method) "À Â\" A@!‡" [gnus-get-function method close-server] 3]) (defalias 'gnus-request-list #[(method) "À Â\" A@!‡" [gnus-get-function method request-list] 3]) (defalias 'gnus-request-list-newsgroups #[(method) "À Â\" A@!‡" [gnus-get-function method request-list-newsgroups] 3]) (defalias 'gnus-request-newgroups #[(date method) "À Â\" A@\"‡" [gnus-get-function method request-newgroups date] 3]) (defalias 'gnus-server-opened #[(method) "À Â\" A@!‡" [gnus-get-function method server-opened] 3]) (defalias 'gnus-status-message #[(method) ";ƒ Á!‚\fÂÃ\"A@!)‡" [method gnus-find-method-for-group gnus-get-function status-message] 3]) (defalias 'gnus-request-group #[(group &optional dont-check) "À !Ã\nÄ\"Å !\nA@#)‡" [gnus-find-method-for-group group method gnus-get-function request-group gnus-group-real-name dont-check] 4]) (defalias 'gnus-request-asynchronous #[(group &optional articles) "À !Ã\nÄ\"Å !\nA@#)‡" [gnus-find-method-for-group group method gnus-get-function request-asynchronous gnus-group-real-name articles] 4]) (defalias 'gnus-list-active-group #[(group) "À !ÂÅ \"…Æ\f \"Ç !\fA@\"*‡" [gnus-find-method-for-group group list-active-group func method gnus-check-backend-function gnus-get-function gnus-group-real-name] 3]) (defalias 'gnus-request-group-description #[(group) "À !ÂÅ \"…Æ\f \"Ç !\fA@\"*‡" [gnus-find-method-for-group group request-group-description func method gnus-check-backend-function gnus-get-function gnus-group-real-name] 3]) (defalias 'gnus-close-group #[(group) "À !Ã\nÄ\"Å !\nA@\")‡" [gnus-find-method-for-group group method gnus-get-function close-group gnus-group-real-name] 3]) (defalias 'gnus-retrieve-headers #[(articles group) "À ! ƒ\f@§ƒÅ\f \"‚!Æ\nÇ\"\fÈ !\nA@#)‡" [gnus-find-method-for-group group method gnus-use-cache articles gnus-cache-retrieve-headers gnus-get-function retrieve-headers gnus-group-real-name] 4]) (defalias 'gnus-retrieve-groups #[(groups method) "À Â\" A@\"‡" [gnus-get-function method retrieve-groups groups] 3]) (defalias 'gnus-request-article #[(article group &optional buffer) "À !Ã\nÄ\" Æ !\nA@$)‡" [gnus-find-method-for-group group method gnus-get-function request-article article gnus-group-real-name buffer] 5]) (defalias 'gnus-request-head #[(article group) "À !Ã\nÄ\" Æ !\nA@#)‡" [gnus-find-method-for-group group method gnus-get-function request-head article gnus-group-real-name] 4]) (defalias 'gnus-request-body #[(article group) "À !Ã\nÄ\" Æ !\nA@#)‡" [gnus-find-method-for-group group method gnus-get-function request-body article gnus-group-real-name] 4]) (defalias 'gnus-request-post-buffer #[(post group subject header artbuf info follow-to respect-poster) "† …Âà \f\"J8 ƒ)ÆÇÈÉÊ !@\"\f\">ƒ) ‚-Ê ! Î !„AÏÐ @ A@#ˆÑ‰Ô Õ\" &,‡" [info group 2 intern-soft gnus-newsrc-hashtb gnus-post-method post assoc format "%s" gnus-find-method-for-group gnus-newsgroup-name gnus-valid-select-methods method gnus-check-server error "Can't open server %s:%s" nil mail-archive-file-name mail-self-blind gnus-get-function request-post-buffer subject header artbuf follow-to respect-poster] 9]) (defalias 'gnus-request-post #[(method &optional force) ";ƒ Á!\n„! ƒ!ÄÅÆÇ@\"\">ƒ! ÉÊ\"A@!‡" [method gnus-server-to-method force gnus-post-method post assoc format "%s" gnus-valid-select-methods gnus-get-function request-post] 5]) (defalias 'gnus-request-expire-articles #[(articles group &optional force) "À !Ã\nÄ\" Æ !\nA@$)‡" [gnus-find-method-for-group group method gnus-get-function request-expire-articles articles gnus-group-real-name force] 5]) (defalias 'gnus-request-move-article #[(article group server accept-function &optional last) "À !Ã\nÄ\" Æ !\nA@%)‡" [gnus-find-method-for-group group method gnus-get-function request-move-article article gnus-group-real-name accept-function last] 6]) (defalias 'gnus-request-accept-article #[(group &optional last) "9ƒ ‚ Á!@ÃÄÅ\n\"!;ƒÆ!‚ \")‡" [group gnus-find-method-for-group func intern format "%s-request-accept-article" gnus-group-real-name last] 4]) (defalias 'gnus-request-replace-article #[(article group buffer) "À !@ÃÄÅ\n\"!Ç !#)‡" [gnus-find-method-for-group group func intern format "%s-request-replace-article" article gnus-group-real-name buffer] 4]) (defalias 'gnus-request-create-group #[(group) "À !Ã\nÄ\"Å !\nA@\")‡" [gnus-find-method-for-group group method gnus-get-function request-create-group gnus-group-real-name] 3]) (defalias 'gnus-member-of-valid #[(symbol group) "ÁÂÃÄ !@\"\">‡" [symbol assoc format "%s" gnus-find-method-for-group group gnus-valid-select-methods] 6]) (defalias 'gnus-secondary-method-p #[(method) "Á \"‰ƒÁ @\"\fš„ A‰„ *‡" [gnus-secondary-select-methods gnus-server-get-method nil method gmethod methods] 5]) (defalias 'gnus-find-method-for-group #[(group &optional info) "†T „\f\n†T †ÄÅ \"J8ljƒ)É 8‰„/\n‚O;ƒ<Ê!‚M@;ƒKË \"‚MÌ!*‡" [gnus-override-method group gnus-select-method info 2 intern-soft gnus-newsrc-hashtb nil method 4 gnus-server-to-method gnus-server-extend-method gnus-server-add-address] 5]) (defalias 'gnus-check-backend-function #[(func group) ";ƒ\fÁ!@‚ ÃÄÅÆ\n#!!)‡" [group gnus-find-method-for-group method fboundp intern format "%s-%s" func] 6]) (defalias 'gnus-methods-using #[(method) "Á‰ƒ\f @>ƒ @\nB A‰„\n*‡" [gnus-valid-select-methods nil outs valids method] 3]) #@145 Setup news information. If RAWFILE is non-nil, the .newsrc file will also be read. If LEVEL is non-nil, the news will be set up at level LEVEL. (defalias 'gnus-setup-news #[(&optional rawfile level) "…\n …\n\n??‰ƒÄÄ ƒÅ\n!ˆƒ(Ç=ƒ+È ˆƒ8 „8Æ ˆ „AÊËÌ\" ƒM ƒMÎ ˆÏ ˆ ƒmƒmƒm „mÑ!ƒmÓ ˆ ?…uÔ †€T!ˆ) … … …  ?… Ñ!… Ö )‡" [gnus-newsrc-alist gnus-active-hashtb rawfile init nil gnus-read-newsrc-file gnus-read-active-file some gnus-update-active-hashtb-from-killed level make-vector 4095 0 gnus-use-dribble-file gnus-dribble-eval-file gnus-update-format-specifications gnus-check-new-newsgroups gnus-server-opened gnus-select-method gnus-find-new-newsgroups gnus-get-unread-articles gnus-level-subscribed gnus-check-bogus-newsgroups] 4 (#$ . 298141)]) #@164 Search for new newsgroups and add them. Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' The `-n' option line from .newsrc is respected. (defalias 'gnus-find-new-newsgroups #[nil "À †e :„ Â=ƒà ‡ÄʼnÉÊË\"ˆ\f„)Í ˆÎ „5Ñ ˆÒÓ\"ˆƒEÕ!ˆÄVƒ`ÉÖ׉ØVƒ[Ù‚\\Ú$‚dÉÖÛ\"+‡" [gnus-check-first-time-used gnus-check-new-newsgroups ask-server gnus-ask-server-for-new-groups 0 nil new-newsgroups group groups gnus-message 5 "Looking for new newsgroups..." gnus-have-read-active-file gnus-read-active-file current-time-string gnus-newsrc-last-checked-date gnus-killed-hashtb gnus-make-hashtable-from-killed mapatoms #[(sym) "À !‰?† J?†Ã\n\f\"J†Ã\n \"J?…iÆ\n!‰È=ƒ> T Ê\n\f\"\nLˆ \n!‚hÌ=ƒIÍ‚h T Ê\n\f\"\nLˆƒd\nB‰‚h\n!)‡" [symbol-name sym group intern-soft gnus-killed-hashtb gnus-newsrc-hashtb gnus-matches-options-n do-sub subscribe groups intern gnus-subscribe-options-newsgroup-method ignore nil gnus-subscribe-hierarchical-interactive new-newsgroups gnus-subscribe-newsgroup-method] 4] gnus-active-hashtb gnus-subscribe-hierarchical-interactive 6 "%d new newsgroup%s arrived." 1 "s have" " has" "No new newsgroups."] 6 (#$ . 298946) nil]) (defalias 'gnus-matches-options-n #[(group) "ƒ Á\n\"ƒ Ç\fƒÁ\f\n\"ƒŇ‰ƒ5Á@@\n\"„5A‰„\"…>@A)‡" [gnus-options-subscribe string-match group subscribe gnus-options-not-subscribe ignore gnus-newsrc-options-n regs] 4]) (defalias 'gnus-ask-server-for-new-groups #[nil "†Á  Ä :… \"BÈ Á \nËÌ! ÎÎÎ΃cÓÎ@\"Ô!ƒZÕ\n\"ƒZŠÖqˆØ Ù#ˆ)A‰„2ƒk\nÚÛ \"ˆƒ{Ü!ˆ ÈVƒ”ÝÞß ‰àVƒ‘á‚’â$ˆ. ‡" [gnus-newsrc-last-checked-date current-time-string date gnus-select-method append gnus-check-new-newsgroups gnus-secondary-select-methods methods 0 groups new-date gnus-make-hashtable 100 hashtb nil group new-newsgroups got-new method gnus-server-get-method gnus-check-server gnus-request-newgroups t nntp-server-buffer gnus-active-to-gnus-format ignore mapatoms #[(group-sym) "À !‰?†! J?†!Ã\n\f\"J†!\n †!\n?…~ Jƒ3Ç\n\" JLˆÉ\n!‰\nË=ƒR\fT\fÇ\n \"\nLˆ\n!‚}\nÏ=ƒ]Ђ}\fT\fÇ\n \"\nLˆƒy\nB‰‚}\n!)‡" [symbol-name group-sym group intern-soft gnus-newsrc-hashtb gnus-zombie-list gnus-killed-list intern gnus-active-hashtb gnus-matches-options-n do-sub subscribe groups gnus-killed-hashtb gnus-subscribe-options-newsgroup-method ignore nil gnus-subscribe-hierarchical-interactive new-newsgroups gnus-subscribe-newsgroup-method] 4] gnus-subscribe-hierarchical-interactive gnus-message 6 "%d new newsgroup%s arrived." 1 "s have" " has"] 7]) (defalias 'gnus-check-first-time-used #[nil "GÁV† !† ÄP!† ÅP!?…|ÆÇÈ\"ˆ „+Ê ˆË \f ΉÑ=?…{†DÓÔ\"ˆƒoÖ@\"Jƒf×@#ˆA‰„QÚ ˆ…{ÆÜÝ\"*‡" [gnus-newsrc-alist 1 file-exists-p gnus-startup-file ".el" ".eld" gnus-message 6 "First time user; subscribing you to default groups" gnus-have-read-active-file gnus-read-active-file current-time-string gnus-newsrc-last-checked-date gnus-default-subscribed-newsgroups nil group groups t gnus-backup-default-subscribed-newsgroups mapatoms #[(sym) "À !‰…3Ã\n!‰Å=ƒ!Æ\n\"\nLˆ\n!‚2\fÉ=ƒ+Ê‚2\n B‰ )‡" [symbol-name sym group gnus-matches-options-n do-sub subscribe intern gnus-killed-hashtb gnus-subscribe-options-newsgroup-method ignore nil gnus-killed-list] 4] gnus-active-hashtb intern-soft gnus-group-change-level gnus-level-default-subscribed gnus-level-killed gnus-group-make-help-group gnus-novice-user 7 "`A k' to list killed groups"] 5]) (defalias 'gnus-subscribe-group #[(group previous &optional method) "À ƒ \fʼn ¯‚ \fÂ%‡" [gnus-group-change-level method t group gnus-level-default-subscribed nil gnus-level-killed previous] 7]) (defalias 'gnus-group-change-level #[(entry level &optional oldlevel previous fromkilled) "À‰‰‰ :ƒ!ƒ A@‚#Ç 8@‚#  ;ƒ<ƒ< Wƒ<Ê  \"J„M :ƒMÇ 8A@\f;ƒ\\Ê\f \"J\f Y…jÊ\f \"J?…ÅÍ\f!„‡ÎÏÐ\fÇ\f8@&!ˆ Yƒ« Uƒ¡Ò\f\"‚ÝÒ\f\"‚Ý YƒÝ ƒÝÕÇ 8@ \"ÀLˆÖ 8ƒÕÊÖ 8@ \"J A¡ˆ A AAA¡ˆ YƒÕ\f \"ÀLˆ×\f!†Å Uƒ\fB‰‚Å\fB‰‚Å Yƒ½ <ƒ% A @‚[Ê\f\"J‰ƒ9\nAT\n@Z‚:ÙÚ\f!‰=ƒP\fÀE‚Z\fÀ‰¯)\f„x‰AAƒsA‰‚e)\f \fAAB\fAƒš\fA ¡ˆÕ\f \" \fABLˆ‚ª\f ¡ˆÕ\f \" \fBLˆ A…ÅÊ A@@ \"J ¡‚Å AA@A ,‡" [nil num active info group entry fromkilled 2 oldlevel gnus-level-zombie intern-soft gnus-newsrc-hashtb previous gnus-ephemeral-group-p gnus-dribble-enter format "(gnus-group-change-level %S %S %S %S %S)" level delete gnus-zombie-list gnus-killed-list intern 3 gnus-group-foreign-p gnus-active-hashtb t gnus-group-method-name method gnus-select-method gnus-newsrc-alist p] 9]) #@39 Obsolete function. Kills a newsgroup. (defalias 'gnus-kill-newsgroup #[(newsgroup) "ÀÁ\n \"J\f\"‡" [gnus-group-change-level intern-soft newsgroup gnus-newsrc-hashtb gnus-level-killed] 4 (#$ . 303676)]) #@106 Remove bogus newsgroups. If CONFIRM is non-nil, the user has to confirm the deletion of every newsgroup. (defalias 'gnus-check-bogus-newsgroups #[(&optional confirm) "AÁ‰‰ÆÇÈ\"ˆ „Ê ˆ ƒG @@Ë \f\"J„@Í @8„@ƒ<ÏÐÑ \"!ƒ@ \fB A‰„\fƒlË\f@\"J‰ƒeÓ\n\"ˆÕ\f@\"\fA‰„K×Á‰ƒ«@J‰ƒ¢@Ë \f\"J„™@Õ @J\"LˆA‰„€A‰„v*ÆÇÚ\",‡" [gnus-newsrc-alist nil entry group bogus newsrc gnus-message 5 "Checking bogus newsgroups..." gnus-have-read-active-file gnus-read-active-file intern-soft gnus-active-hashtb 4 confirm gnus-y-or-n-p format "Remove bogus newsgroup: %s " gnus-newsrc-hashtb gnus-group-change-level gnus-level-killed delete gnus-killed-list (gnus-killed-list gnus-zombie-list) killed dead-lists "Checking bogus newsgroups...done"] 5 (#$ . 303885)]) #@51 Remove duplicates from the list of killed groups. (defalias 'gnus-check-duplicate-killed-groups #[nil "‰…ÂÃÄ G#ˆ Å @ A\"¡ˆ A‰„Æ)‡" [gnus-killed-list killed gnus-message 9 "%d" delete nil] 5 (#$ . 304683) nil]) (defalias 'gnus-get-unread-articles #[(&optional level) "A\n† T\fƒ\f§„ T‚\"\f§ƒ!\f‚\"Å\n^ÇÇ Ç\nÇ Ç\fÍÎÏ\"ˆ ƒò @‰@ Ð \"J\nÒ8‰\fƒªÓÕÇ\f\"\"„ªÖ\f!„ªA@XƒÉ\f;ƒƒ×\f!‚‡Ò8@Ø=ƒ— B ‚ÉÙ@!‰\nƒÉÚ !ˆ‚É„ÉA@\nXƒÉ„ÂÜ\f!ˆÙ@!\n\nƒØÝ\n\"ˆ‚ëÞ \"ÇLˆÐ \"Jà ˆ A‰„> ƒÙ @@!‰\nƒ Ý @\n\"ˆ A‰ „÷ÍÎá\".‡" [gnus-newsrc-alist newsrc level gnus-level-subscribed gnus-activate-foreign-newsgroups 0 foreign-level nil info group active virtuals method gnus-message 5 "Checking new news..." intern-soft gnus-active-hashtb 4 gnus-server-equal gnus-select-method gnus-server-get-method gnus-secondary-method-p gnus-server-to-method nnvirtual gnus-activate-group gnus-close-group gnus-read-active-file gnus-check-server gnus-get-unread-articles-in-group intern gnus-newsrc-hashtb t "Checking new news...done"] 6]) (defalias 'gnus-make-hashtable-from-newsrc-alist #[nil " ÂÆ G!@@Çšƒ‚ÇÈÂE B‰‰‰…FÉ @@ \"\f…8Ê @@\f\"J@ BLˆ  A‰„&Â+‡" [gnus-newsrc-alist gnus-newsrc-hashtb nil prev ohashtb alist gnus-make-hashtable "dummy.group" 0 intern intern-soft] 5]) #@55 Create a hash table from the killed and zombie lists. (defalias 'gnus-make-hashtable-from-killed #[nil "ÀÁÄ GG\\! …. @J A\nƒÈ\n@\"\n@Lˆ\nA‰‚*‡" [(gnus-killed-list gnus-zombie-list) nil list lists gnus-make-hashtable gnus-killed-list gnus-zombie-list gnus-killed-hashtb intern] 4 (#$ . 306035)]) (defalias 'gnus-get-unread-articles-in-group #[(info active) "À 8ÃÅ 8ƒÈ @ \"ˆ AÃUƒ$Âb\n„4 AT @Z‚b\nA<„i\nA @WƒJ\n @S¡ˆ\nA AVƒY\n A¡ˆÃ A\nAT\n@ZZ]‚b\nAƒÄ @\nA@:„~\nA@†‚\nA@@YƒÄ\n@§ƒ¦\n‰@\nA@§ƒœ\nA@† \nA@AB ˆ‚»\n@\nA@§ƒµ\nA@†¹\nA@A¡ˆ\n‰AA¡ˆ‚i\n@:ƒÜ\n@A @WƒÜ\n@ @S¡ˆ\n‰\nAƒ\nA@:„ó\nA@†ø\nA@@ AXƒ\nA‰\n‚à\nAƒ\nË¡ˆ\n@:ƒ-\n@A AVƒ-\n@ A¡ˆ)\nƒZ\f\n@:„>\n@†A\n@AT\n@:„M\n@†P\n@@Z\\\nA‰„2à A\fZ] ƒ¤ÌžƒwÍÌžÀ 8\"ˆÎžƒˆÍΞÀ 8\"ˆÏ @\"JÃ\fÌžAGZΞAGZ]‰ ˆ\f+‡" [2 info range 0 num 3 marked gnus-use-cache gnus-cache-possibly-alter-active active srange nil tick gnus-remove-illegal-marked-articles dormant intern-soft gnus-newsrc-hashtb] 6]) (defalias 'gnus-remove-illegal-marked-articles #[(marked ranges) "A‰…! @ \"ƒ A¡ˆ‚  A‰„Ä)‡" [marked m gnus-member-of-range ranges nil] 4]) (defalias 'gnus-activate-group #[(group) "À !ÂÅ\f!…9ÂÆÇ…9ŠqˆebˆÉÊ!…8Ë”bˆÌ  \"Îp!Îp!B‰L…8 )*‡" [gnus-find-method-for-group group nil active method gnus-check-server (gnus-request-group group) ((error) (quit)) nntp-server-buffer looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+" 1 intern gnus-active-hashtb read] 4]) #@178 Update the list of read and ticked articles in GROUP using the UNREAD and TICKED lists. Note: UNSELECTED has to be sorted over `<'. Returns whether the updating was successful. (defalias 'gnus-update-read-articles #[(group unread unselected ticked &optional domarks replied expirable killed dormant bookmark score) "† Á\n \"JÁ\n \"JÇ8É8\nË\fÍÎ!Ð\"Ñ?†4\f??…jƒN@ÓWƒNA‰„=ƒe@\f@WƒeA‰„Sƒ|@\f@Wƒ|A‰„jƒ“@\f@Wƒ“A‰„ÍÖ\"Ð\"‰ƒÕ@\fU„Æ\f@SUƒº\f‚Á\f@SBB@T\fA‰„¢\f\fAXƒç\f\fABBAAGËVƒùŸ‚û ˆØƒ\f‚Û\nžAƒ‚ Ý\nžAƒ*‚/Þ\nžAƒ9‚>Õ\nžAƒH‚Mß\nžAƒW ‚\\à\nžA&ˆáÁ\n \"J\"ˆâ.‡" [gnus-newsgroup-active intern-soft group gnus-active-hashtb active gnus-newsrc-hashtb entry 2 info 3 marked 1 prev sort copy-sequence unread < nil read 0 ticked dormant append unselected gnus-set-marked-articles domarks replied reply expirable expire killed bookmark score gnus-get-unread-articles-in-group t] 11 (#$ . 307548)]) #@35 Mark ARTICLES in GROUP as unread. (defalias 'gnus-make-articles-unread #[(group articles) "ÀÁ\n \"J†ÁÄ\n! \"J8À 8Ç ƒ:Ê @\"ƒ1 @B A‰ „…P AAËÀ 8Ÿ\" ˆÌ\nÍ\"+‡" [2 intern-soft group gnus-newsrc-hashtb gnus-group-real-name info ranges nil news articles gnus-member-of-range gnus-remove-from-range gnus-group-update-group t] 5 (#$ . 308599)]) (defalias 'gnus-update-active-hashtb-from-killed #[nil "ÀÁÂ\"‰\f DÆ …;@‰ƒ1Ê@ \"ÆLˆA‰„A‰„Æ+‡" [make-vector 4095 0 gnus-active-hashtb gnus-killed-list gnus-zombie-list nil killed lists hashtb intern] 4]) (defalias 'gnus-read-active-file #[nil "À ˆÁ\n!ƒ\n B‚ ÄÄŠqˆ…ÉÄ@\"‰\nA@ ÌÍ ƒD GÎU„DÏ P‚EÐ\n@#ÒÓ\"ˆÁ\n!ƒÕ=ƒÜÖ×\n@\"ƒÜAÉÄ\n\"ĉƒŸÜÝ@@@\"\"ƒ–Þ@@!BA‰„{Á\n!ˆß\n\"‰„ÁÒàá\n@#ˆâ ˆãä!ˆ‚Ø å=ƒÑæ\n'\"ˆ‚Øè\n'\"ˆ+‚é\n!„ñÒàê\n@#ˆâ ˆ‚æ\n!ˆ\nBÒÓë#ˆ+A‰„!Ä+‡" [gnus-group-set-mode-line gnus-check-server gnus-select-method gnus-secondary-select-methods nil list-type methods gnus-have-read-active-file nntp-server-buffer gnus-server-get-method method where format "Reading active file%s via %s..." 0 " from " "" mesg gnus-message 5 gnus-read-active-file some gnus-check-backend-function retrieve-groups gnus-newsrc-alist groups gmethod newsrc gnus-server-equal gnus-find-method-for-group gnus-group-real-name gnus-retrieve-groups 1 "Cannot read partial active file from %s server." ding sit-for 2 active gnus-active-to-gnus-format gnus-active-hashtb gnus-groups-to-gnus-format gnus-request-list "Cannot read active file from %s server." "%sdone"] 5]) (defalias 'gnus-active-to-gnus-format #[(method &optional hashtb ignore-errors) "p†' ƒ\n š„ ‚'\n šƒ\"ÄÅed\"!‚%ÄÆ!‰ÄÇ! ebˆÊËÌÍ#ƒFΔTÏyˆ`|ˆ‚2ј„UebˆÒ!ˆdbˆÓÔÌÍ#ƒfÕcˆ‚X\nƒÖ×Ì\n\"×Ì \"\"„ØÑ\n\"ebˆm„cˆÏyÎU„€)ebˆÚÛ\"ƒÇÝÞÎ\"àá\"\"Ì#Ì$Ì%m?…ÃÌæçˆ~ˆÏyˆ‚±-‚ã̉‰%$#m?…âÌèéˆ~ˆÏyˆ‚Ð++‡" [hashtb gnus-active-hashtb method gnus-select-method gnus-make-hashtable count-lines 4096 60 flag-hashtb cur search-forward "\nto." nil t 0 1 gnus-ignored-newsgroups "" delete-matching-lines re-search-backward "[][';?()#]" 92 gnus-server-equal gnus-server-get-method gnus-group-prefixed-name prefix string-match "%[oO]" gnus-group-line-format make-vector 7 mod-hashtb intern "m" m group max min (byte-code "``Áˆ`bˆ)}ˆ\nÄ !)Ä !‰§ƒKÄ !‰§ƒKÉÁwˆgÊU„KgËU„KgÌU„KBLˆ‚PÁLˆ Ä !)=ƒfÏ!BÁ‡" [p nil hashtb obarray read cur group max min " " 61 120 106 mod-hashtb m symbol-name gnus-moderated-list] 3) ((error (byte-code "ƒ 9ƒ ÁLˆÁ‡" [group nil] 2))) (byte-code "``Áˆ`bˆ)}ˆ\nÄ !)Ä !‰§ƒKÄ !‰§ƒKÉÁwˆgÊU„KgËU„KgÌU„KBLˆ‚PÁLˆÁ‡" [p nil hashtb obarray read cur group max min " " 61 120 106] 3) ((error (byte-code "ƒ 9ƒ ÁLˆ\n„/ÃÄÅ`Çyˆ`bˆ)`Áˆ`bˆ){#ˆÁ‡" [group nil ignore-errors gnus-message 3 "Warning - illegal active: %s" p 0] 6)))] 5]) (defalias 'gnus-groups-to-gnus-format #[(method &optional hashtb) "p† ƒ\nƒ\n‚ÃÄed\"!‰ …0ÅÆÇ \"ÆÇ\"\"?…0ÉÊ \" \febˆ ƒ]lj‰‰ m?…YÇÑÒˆÓyˆ‚I,‚wlj‰ m?…vÇÔÕˆÓyˆ‚f++‡" [hashtb method gnus-active-hashtb gnus-make-hashtable count-lines gnus-server-equal gnus-server-get-method nil gnus-select-method gnus-group-prefixed-name "" prefix cur group opoint max min (byte-code "À !ˆÀ !ˆÀ !À !`ÅÆwˆcˆ\fbˆ À !)\n BL‡" [read cur min max opoint " " nil prefix hashtb obarray] 3) ((error (byte-code "ƒ 9ƒ ÁLˆÁ‡" [group nil] 2))) 1 (byte-code "gÀUƒ%Á\n!ˆÁ\n!ˆÁ\n!Á\n! Á\n!)‰ \fBLˆÀ‡" [50 read cur min max hashtb obarray group] 3) ((error (byte-code "ƒ 9ƒ ÁLˆÁ‡" [group nil] 2)))] 7]) #@67 Read startup file. If FORCE is non-nil, the .newsrc file is read. (defalias 'gnus-read-newsrc-file #[(&optional force) "‰ƒ @ÂLˆ A‰„) ‰ÅPŠÇ!ˆ„=É\f\"ƒ7É\fÊP\"„= ?…ZŠÌÍÎ\f#ˆÏ\f!qˆÐp!ˆÑ ˆÒp!ˆÌÍÓ\f#)+‡" [gnus-variable-list variables nil gnus-current-startup-file newsrc-file ".el" quick-file gnus-read-newsrc-el-file force file-newer-than-file-p "d" gnus-newsrc-alist gnus-message 5 "Reading %s..." find-file-noselect buffer-disable-undo gnus-newsrc-to-gnus-format kill-buffer "Reading %s...done"] 5 (#$ . 312281)]) (defalias 'gnus-read-newsrc-el-file #[(file) "ÁPÃÄÅ\n#ˆÆÆÈɈƒ\n)Ë\fÍ ˆ)Î ˆÏ\n\"…6ÃÄÅ#ˆÐ!)‡" [file "d" ding-file gnus-message 5 "Reading %s..." nil gnus-newsrc-assoc (byte-code "À ‰‰$‡" [load ding-file t] 5) ((error)) gnus-newsrc-alist t inhibit-quit gnus-uncompress-newsrc-alist gnus-make-hashtable-from-newsrc-alist file-newer-than-file-p gnus-read-old-newsrc-el-file] 4]) (defalias 'gnus-read-old-newsrc-el-file #[(file) "À‰‰‰‰À‰‰‰ ÀÊˈ ,À ƒ @ÌÍ\n@\"J8‰ƒcAA\nAA ˆA\nA@ƒU‚W ˆB‚~\n@\nA@ƒp‚r\nAAE‰BÒ\n@ \"‰ƒ•AAÓ ABCÀB¡ˆ) A‰„,\f‰ƒ° ‰@@ ˆ A‰„£\fƒàÖ×\"„ÆØPÖÙ\"„ÔÚPÛ˜„àÜ!ˆŸÝ -‡" [nil m group marked killed newsrc gnus-newsrc-assoc gnus-newsrc-alist gnus-marked-assoc gnus-killed-assoc (byte-code "À ‰‰$‡" [load file t] 5) ((error)) 2 intern-soft gnus-newsrc-hashtb info gnus-level-default-subscribed gnus-level-default-unsubscribed assoc tick gnus-killed-list gnus-newsrc-options string-match "^ *options" "options " "\n$" "\n" "" gnus-newsrc-parse-options gnus-make-hashtable-from-newsrc-alist] 6]) #@74 Make server dependent file name by catenating FILE and server host name. (defalias 'gnus-make-newsrc-file #[(file) "À Â\"‰Ã\fA@QÆ !„\"Æ ÇP!„\"Æ ÈP!ƒ& ‚' *‡" [expand-file-name file nil "-" gnus-select-method real-file file-exists-p ".el" ".eld"] 4 (#$ . 313933)]) (defalias 'gnus-uncompress-newsrc-alist #[nil "Á‰…EÄ @8‰ƒ=\nƒ=\n@@Å=„6\n@@Æ=„6\n@@Ç=„6\n@È\n@A!¡ˆ\nA‰„ A‰„Á*‡" [gnus-newsrc-alist nil marked newsrc 3 score bookmark killed gnus-uncompress-range] 4]) (defalias 'gnus-compress-newsrc-alist #[nil "Á‰…DÄ @8‰ƒ<\nƒ<\n@@Å=„5\n@@Æ=„5\n@@Ç=„5\n@ÁÈÉ¡ˆ\nA‰„ A‰„Á*‡" [gnus-newsrc-alist nil marked newsrc 3 score bookmark killed (byte-code "ÀÁ\n@AÃ\"Ä\"‡" [gnus-compress-sequence sort marked < t] 4) ((error (byte-code "@A‡" [marked] 1)))] 5]) (defalias 'gnus-newsrc-to-gnus-format #[nil "ÀÂ\f„ ÅÆÇ\"pGÉV‰‰‰‰‰‰‰\n \f ebˆÔÕ\f\"‰ÂLˆÔÖ\f\"‰ ÂLˆm„æ`×Âwˆ`}ˆebˆedU?…d\fÙ!)\f~ˆ\f=„x\f =ƒž `Çyˆ`bˆ)ÛÜÂÝ#ƒ”Çyˆ`†•`{PÞyˆ‚à\fƒàß\f!„¯\fÂLˆgàUá\f! lƒÇÇyˆ‚ËâÂwˆãä!ƒǔǕ}ˆÙ!\n~ˆgåUƒÉuˆãä!„ø\n B ‚\nǔǕ}ˆÙ!B B ~ˆ‚\n B gæU?‚PgæU„Zm„OÂçèé`Çyˆ`bˆ)`ˆ`bˆ){#ˆê ˆëÉ!ˆÂƒZìÂwˆ‚˃àíî/\"J8Â0‰1ƒ¹1AA Ÿ ˆ1A@‰02Xƒž„ž ƒ–3‚™3T0‚¯02Vƒ¯ƒ¯401A0 ˆ‚؃Å4‚Ò ƒÐ2T‚Ò3 ŸE11B*Éyˆ‚FŸƒNA‰567‰8ƒMù8@8ƒ@ú8@@\"„@ú7@@\"‰6ƒ86>‰58@5AB¡ˆ‚@8@B878A‰8„,û ˆ À˜†^ü !.\n‡" ["" gnus-newsrc-options nil gnus-newsrc-options-n gnus-active-hashtb make-vector 4095 0 gnus-newsrc-alist 1 num1 reads symbol Options-symbol newsrc options-symbol subscribed group already-read buf intern "options" "Options" "^ !:\n" obarray read p re-search-forward "^[^ ]" move -1 boundp 58 symbol-name "!: " looking-at "[0-9]+" 45 10 gnus-message 3 "Mangled line: %s" ding sit-for ", " 2 intern-soft gnus-newsrc-hashtb level info gnus-level-subscribed gnus-level-default-unsubscribed gnus-level-default-subscribed mentry entry prev rc 4 assoc gnus-make-hashtable-from-newsrc-alist gnus-newsrc-parse-options] 11]) (defalias 'gnus-newsrc-parse-options #[(options) "À‰ŠÃ ˆÄ !cˆebˆÆÇÀÈ#ƒ!ÉÊȉ#ˆ‚ebˆÆËÀÈ#ƒ5ÉÌȉ#ˆ‚$ebˆÆÍÀÈ#ƒJÉÊ!ˆÎuˆ‚8ebˆÆÏÀÈ#ƒ¬ŠÆÏ`Àˆ`bˆ)È#…l`ÑZ)†|`Àˆ`bˆ)ÆÒ È#ƒMÓ”fÔUƒÕÓ”TÓ•{PÖB\nB‚}ÕÓ”Ó•{P×B\nB‚}\n‰+‡" [nil eol out gnus-set-work-buffer regexp-quote options re-search-forward "\n[ ]+" t replace-match " " "\\ball\\b" ".+" "[ ]-[^n][^-]*" -1 "[ ]-n" p 2 "[^ ,\n]+" 0 33 "^" ignore subscribe gnus-newsrc-options-n] 4]) #@20 Save .newsrc file. (defalias 'gnus-save-newsrc-file #[nil "„ …v\n…vÃÄ!ˆŠ ƒ5ƒ.Ç!ƒ.ŠqˆÈ )ÉUƒ5ÊËÌ\"‚u ƒIÊÎÏ\n#ˆÐ ˆÊÎÑ\n#ˆÒÓ!qˆ\nÔPÖ ˆ×p!ˆØ ˆÊÎÙ\n#ˆÚ ˆÛ ˆÜp!ˆÊÎÝ\n#ˆÞ )‡" [gnus-newsrc-alist gnus-killed-list gnus-current-startup-file run-hooks gnus-save-newsrc-hook gnus-use-dribble-file gnus-dribble-buffer buffer-name buffer-size 0 gnus-message 4 "(No changes need to be saved)" gnus-save-newsrc-file 5 "Saving %s..." gnus-gnus-to-newsrc-format "Saving %s...done" get-buffer-create " *Gnus-newsrc*" ".eld" buffer-file-name gnus-add-current-to-buffer-list buffer-disable-undo erase-buffer "Saving %s.eld..." gnus-gnus-to-quick-newsrc-format save-buffer kill-buffer "Saving %s.eld...done" gnus-dribble-delete-file] 4 (#$ . 316472)]) #@65 Insert Gnus variables such as gnus-newsrc-alist in lisp format. (defalias 'gnus-gnus-to-quick-newsrc-format #[nil "ÀcˆÁcˆÂcˆÃÄ !ƱˆÈ AÊ  \f Î ˆ ƒ^ @ Ï !ƒU JƒU„F Ñ=„UÒÓ !ÔÄ J!Ʊˆ A‰ „(Õ ,‡" [";; Gnus startup file.\n" ";; Never delete this file - touch .newsrc instead to force Gnus\n" ";; to read .newsrc.\n" "(setq gnus-newsrc-file-version " prin1-to-string gnus-version ")\n" gnus-variable-list t gnus-newsrc-alist nil variable inhibit-quit variables gnus-compress-newsrc-alist boundp gnus-save-killed-list gnus-killed-list "(setq " symbol-name " '" gnus-uncompress-newsrc-alist] 6 (#$ . 317226)]) (defalias 'gnus-gnus-to-newsrc-format #[nil "AÁ‰‰ŠÆ!qˆÉp!ˆÊ ˆ ƒ$ cˆ ƒ¾ @Ì\f8„·\f@\fA@ Vƒ@΂AϱˆÐ\f8‰ƒ´Ñcˆ A<„u @ AUƒfÒ @!cˆ‚´Ò @!ÓÒ A!±ˆ‚´ ƒ´ @ A\n:ƒŒ\n@\nAUƒžÒ\n:„–\n†˜\n@!cˆ‚ªÒ\n@!ÓÒ\nA!±ˆ ƒuÔcˆ‚uÕcˆ A‰„(ƒË×!ˆ‚ÎÙ ˆÚ ˆÛp!-‡" [gnus-newsrc-alist nil range ranges info newsrc create-file-buffer gnus-current-startup-file buffer-file-name buffer-disable-undo erase-buffer gnus-newsrc-options 4 gnus-level-subscribed "!" ":" 2 " " int-to-string "-" "," "\n" gnus-modtime-botch delete-file gnus-startup-file clear-visited-file-modtime save-buffer kill-buffer] 5]) (defalias 'gnus-read-all-descriptions-files #[nil " B‰ƒÃ\n@!ˆ\nA‰„)ć" [gnus-select-method gnus-secondary-select-methods methods gnus-read-descriptions-file t] 3]) (defalias 'gnus-read-descriptions-file #[(&optional method) "† \n„Ã\fG!ÅÆÇ\"\n\"ÈLˆÉÊË@#ˆÌ!„/ÉÍÎ\"ˆÏ‚Ð!„>ÉÍÑ\"ˆÏ‚ÏŠŒqˆebˆÔÕÏÖ#„Wdbƒ^×yˆe`}ˆebˆm„…ÏØÙÚÏwˆ9ƒ`ψ`{LˆÍyˆ‚a*ÉÊÛ\"ˆ)Ö)‡" [method gnus-select-method gnus-description-hashtb gnus-make-hashtable gnus-active-hashtb intern gnus-group-prefixed-name "" "Has read" gnus-message 5 "Reading descriptions file via %s..." gnus-check-server 1 "Couldn't open server" nil gnus-request-list-newsgroups "Couldn't read newsgroups descriptions" group nntp-server-buffer search-forward "\n.\n" t 0 (byte-code " !)‡" [gnus-description-hashtb obarray read nntp-server-buffer] 2) ((error 0)) " " "Reading descriptions file...done"] 4]) (defalias 'gnus-group-get-description #[(group) "À !…Š\nqˆebˆÃÄ!…Ŕŕ{)‡" [gnus-request-group-description group nntp-server-buffer looking-at "[^ ]+[ ]+\\(.*\\)" 1] 2]) #@41 Hook run in `gnus-server-mode' buffers. (defvar gnus-server-mode-hook nil (#$ . 319520)) #@115 Format of server lines. It works along the same lines as a normal formatting string, with some simple extensions. (defconst gnus-server-line-format " {%(%h:%w%)}\n" (#$ . 319616)) #@52 The format specification for the server mode line. (defvar gnus-server-mode-line-format "Gnus List of servers" (#$ . 319806)) (byte-code "ÀÁÂEÃÄÂEÅÆÂEEÇBÉÊÂEËÌÂEÍÎÂEEÏBÐÑ!„3ÒÑBÐÓ!„BÒÓBÐÔ!„QÒÔBÐÕ!„`ÒÕBÖ×ØÙ#ˆ„ÁÚ Û!ˆÜÝÞ#ˆÜßÞ#ˆÜ á#ˆÜâã#ˆÜäå#ˆÜæç#ˆÜèé#ˆÜêë#ˆÜìí#ˆÜîï#ˆÒ‡" [104 how 115 110 name 119 where gnus-server-line-format-alist current-load-list 83 news-server 77 news-method 117 user-defined gnus-server-mode-line-format-alist boundp gnus-server-line-format-spec nil gnus-server-mode-line-format-spec gnus-server-killed-servers gnus-server-mode-map put gnus-server-mode mode-class special make-sparse-keymap suppress-keymap define-key " " gnus-server-read-server " " gnus-mouse-2 gnus-server-pick-server "q" gnus-server-exit "l" gnus-server-list-servers "k" gnus-server-kill-server "y" gnus-server-yank-server "c" gnus-server-copy-server "a" gnus-server-add-server "e" gnus-server-edit-server] 5) #@270 Major mode for listing and editing servers. All normal editing commands are switched off. \ For more in-depth information on this mode, read the manual (`\[gnus-info-find-node]'). The following commands are available: \{gnus-server-mode-map} (defalias 'gnus-server-mode #[nil "ƒÁ ˆÂ ˆÃÅÆ!ˆÇ!È8Éšƒ&țʠˆË\fÍÏÑ!ˆÓp!ˆÔÔ×Ø!‡" [gnus-visual gnus-server-make-menu-bar kill-all-local-variables "-- " mode-line-modified make-local-variable mode-line-format copy-sequence 3 " " "" gnus-server-mode major-mode "Server" mode-name nil mode-line-process use-local-map gnus-server-mode-map buffer-disable-undo t truncate-lines buffer-read-only run-hooks gnus-server-mode-hook] 2 (#$ . 320781) nil]) (defalias 'gnus-server-insert-server-line #[(sformat name method) "† \n@\nA@ÅÇyˆ`È!cˆÉ‰TÊË\f!D#,‡" [sformat gnus-server-line-format-spec method how where nil b 0 eval add-text-properties gnus-server intern name] 6]) (defalias 'gnus-server-setup-buffer #[nil "À !?…ŠÂ !qˆÃ ˆ\f…ÅÆ!)‡" [get-buffer gnus-server-buffer get-buffer-create gnus-server-mode gnus-carpal gnus-carpal-setup-buffer server] 2]) (defalias 'gnus-server-prepare #[nil "À \n\"À\f \"È \nË ˆ\nƒ/ÌÈ\n@@\n@A#ˆ\nA‰\n„*ebˆÍ ‡" [gnus-parse-format gnus-server-mode-line-format gnus-server-mode-line-format-alist gnus-server-mode-line-format-spec gnus-server-line-format gnus-server-line-format-alist gnus-server-line-format-spec gnus-server-alist nil buffer-read-only alist erase-buffer gnus-server-insert-server-line gnus-server-position-cursor] 5]) (defalias 'gnus-server-server-name #[nil "À`Âyˆ` bˆ)Ã\"‰…Å\f!)‡" [get-text-property p 0 gnus-server server symbol-name] 4]) (byte-code "ÀÁÂ\"ˆÃÄ BÀ‡" [defalias gnus-server-position-cursor gnus-goto-colon "*Gnus edit server*" gnus-server-edit-buffer current-load-list] 3) (defalias 'gnus-server-update-server #[(server) "ŠqˆÁ \f\"AÇÈ ÉÊ !Ë°!ˆŒ~ˆÌ !ƒ,Íyˆ`Îyˆ`|ˆÂ \f\"ÐÁ@A#ˆÑ -‡" [gnus-server-buffer nil assoc server gnus-server-alist info buffer-read-only gnus-dribble-enter "(gnus-server-set-info \"" "\" '" prin1-to-string ")" gnus-server-goto-server 0 1 entry gnus-server-insert-server-line gnus-server-position-cursor] 6]) (defalias 'gnus-server-set-info #[(server info) "ÀÁ\nÃÄ !Æ°!ˆ A@Ç\n\"‰ ƒ\" ¡‚,\n BC¤‰*‡" [gnus-dribble-enter "(gnus-server-set-info \"" server "\" '" prin1-to-string info ")" assoc gnus-server-alist entry] 7]) (defalias 'gnus-server-to-method #[(server) "Ášƒ\n\n†Ã\f\"A‡" [server "native" gnus-select-method assoc gnus-server-alist] 3]) (defalias 'gnus-server-extend-method #[(group method) "À @šƒ\f ‚Ä @ \"A!‰AA@ÇQ ˆ A¤)‡" [gnus-copy-sequence method "native" gnus-select-method assoc gnus-server-alist entry "+" group] 5]) (defalias 'gnus-server-get-method #[(group method) ";ƒ Á!‡@;ƒ\nƒÃ\n\"‡Ä!‡" [method gnus-server-to-method group gnus-server-extend-method gnus-server-add-address] 3]) (defalias 'gnus-server-add-address #[(method) "À @!ÃÄ\n \">ƒ(Æ\nÇP! ž„(È Æ\nÇP! A@DC\"‚) )‡" [symbol-name method method-name address assoc gnus-valid-select-methods intern "-address" append] 5]) (defalias 'gnus-server-equal #[(s1 s2) " š†\"G GU…\"ƒ @ ƒ A‰„?‡" [s1 s2] 3]) #@38 Kill the server on the current line. (defalias 'gnus-server-kill-server #[(server) "À !„ ƒÂà \"ˆ‚ÂÄ!ˆÅÆ!ˆÇÉyˆ`Êyˆ`|ˆ)Ë \f\" B Î @\f\"\fÏ ‡" [gnus-server-goto-server server error "No such server: %s" "No server on the current line" gnus-dribble-enter "" nil buffer-read-only 0 1 assoc gnus-server-alist gnus-server-killed-servers delq gnus-server-position-cursor] 3 (#$ . 324030) (list (gnus-server-server-name))]) #@36 Yank the previously killed server. (defalias 'gnus-server-yank-server #[nil "„ÁÂ!ˆ Ä @„ C¤‚R @@˜ƒ/ B‚RAƒIA@@˜„IA‰‚1 AB¡ˆÈ @!ˆAÉ +‡" [gnus-server-killed-servers error "No killed servers to be yanked" gnus-server-alist gnus-server-server-name killed server alist gnus-server-update-server gnus-server-position-cursor] 4 (#$ . 324464) nil]) #@29 Return to the group buffer. (defalias 'gnus-server-exit #[nil "Àp!ˆÁ\n!‡" [kill-buffer switch-to-buffer gnus-group-buffer] 2 (#$ . 324849) nil]) #@29 List all available servers. (defalias 'gnus-server-list-servers #[nil "À  ˆ ƒà !ˆ‚dbˆÄyˆÅ )‡" [gnus-server-server-name cur gnus-server-prepare gnus-server-goto-server -1 gnus-server-position-cursor] 2 (#$ . 325000) nil]) (defalias 'gnus-server-copy-server #[(from to) "„ÁÂ!ˆ ƒ ĘƒÁÅ!ˆÆ \"ƒ#ÁÈ \"ˆÆ\"„0ÁÉ\"ˆÊÆ\"!‰  ˆ AA  ˆ \fB\fÍ )‡" [from error "No server on current line" to "" "No name to copy to" assoc gnus-server-alist "%s already exists" "%s: no such server" gnus-copy-sequence to-entry gnus-server-killed-servers gnus-server-yank-server] 5 nil (list (or (gnus-server-server-name) (error "No server on the current line")) (read-string "Copy to: "))]) (defalias 'gnus-server-add-server #[(how where) " E\nBà ‡" [where how gnus-server-killed-servers gnus-server-yank-server] 3 nil (list (intern (completing-read "Server method: " gnus-valid-select-methods nil t)) (read-string "Server name: "))]) #@24 Jump to a server line. (defalias 'gnus-server-goto-server #[(server) "ÀedÁ !$‰…\fbˆÅ )‡" [text-property-any gnus-server intern server to gnus-server-position-cursor] 7 (#$ . 325940) (list (completing-read "Goto server: " gnus-server-alist nil t))]) #@38 Edit the server on the current line. (defalias 'gnus-server-edit-server #[(server) "„ÁÂ!ˆÃ Å!ˆÇÈ!ˆÉ ˆÊ ˆËÌ!ˆ\f\fÍÎÏ !!ˆÐÒ8A ˆÓÔ\"ˆ)Õ ˆÖcˆ×Ø\"A!c)‡" [server error "No server on current line" current-window-configuration winconf get-buffer-create gnus-server-edit-buffer gnus-configure-windows edit-server gnus-add-current-to-buffer-list emacs-lisp-mode make-local-variable gnus-prev-winconf use-local-map copy-keymap current-local-map (lambda nil "Exit editing mode and update the information." (interactive) (gnus-server-edit-server-done (quote group))) done-func 4 local-set-key "" erase-buffer ";; Type `C-c C-c' after you have edited the server.\n\n" pp-to-string assoc gnus-server-alist] 4 (#$ . 326199) (list (gnus-server-server-name))]) (defalias 'gnus-server-edit-server-done #[(server) "À !qˆebˆÂp! Æ \"ˆÈp!ˆ\fƒ É\f!ˆ\nqˆËÌ !ˆÍ ˆÎ *‡" [get-buffer-create gnus-server-edit-buffer read gnus-prev-winconf winconf form gnus-server-set-info server kill-buffer set-window-configuration gnus-server-buffer gnus-server-update-server gnus-server-server-name gnus-server-list-servers gnus-server-position-cursor] 3 nil nil]) #@18 Browse a server. (defalias 'gnus-server-read-server #[(server) "ÀÁ\n!p\"‡" [gnus-browse-foreign-server gnus-server-to-method server] 3 (#$ . 327352) (list (gnus-server-server-name))]) (defalias 'gnus-mouse-pick-server #[(e) "À !ˆÂà !‡" [mouse-set-point e gnus-server-read-server gnus-server-server-name] 2 nil "e"]) #@549 *List of global score files and directories. Set this variable if you want to use people's score files. One entry for each score file or each score file directory. Gnus will decide by itself what score files are applicable to which group. Say you want to use the single score file "/ftp.ifi.uio.no@ftp:/pub/larsi/ding/score/soc.motss.SCORE" and all score files in the "/ftp.some-where:/pub/score" directory. (setq gnus-global-score-files '("/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE" "/ftp.some-where:/pub/score")) (defvar gnus-global-score-files nil (#$ . -327675)) #@44 Return a list of all possible score files. (defalias 'gnus-score-score-files #[(group) "ƒ\f „\fÂ!ˆÃ\f†Å!ÆÇ\f!!„!ȉ ‡ÊË!ƒM ƒ; @ƒ;Ì\f @\"ƒÖÍÎ\f!8Ï\fÐÑ #ŸB ‚ÖÇ\f!GDȉ‰ƒÎÇ\fÙÛÜ#P!ÙÝÜ#@AÆÞQ!ƒœÞQBGTYƒcÆßQ!ƒ¼ßQBàá\"ˆ≔O‰‚žÈŸB - A‡" [gnus-global-score-files gnus-internal-global-score-files gnus-score-search-global-directories file-name-as-directory gnus-kill-files-directory "~/News/" file-exists-p expand-file-name nil gnus-score-file-list gnus-use-long-file-name not-score gnus-file-newer-than 5 file-attributes directory-files t gnus-score-file-regexp gnus-score-file-suffix gnus-adaptive-file-suffix suffix files dir suffixes mdir gnus-replace-chars-in-string group 46 47 58 "/" "/all/" string-match "/[^/]*$" 0] 7 (#$ . 328281)]) (defalias 'gnus-score-file-regexp #[nil "À  İ‡" ["\\(" gnus-score-file-suffix "\\|" gnus-adaptive-file-suffix "\\)$"] 5]) #@146 Return a list of score files for GROUP. The score files are those files in the ~/News directory which matches GROUP using BNews sys file syntax. (defalias 'gnus-score-find-bnews #[(group) "ÀÁ\n! \"ÅÆ!!‰G Ê Ê\fÊ ŠÎÏ!qˆÐp!ˆ\fƒôÑ ˆ\f@cˆebˆÒÓÔ P!ˆÕÖ׉#ˆebˆØÙ!!ƒXÚdS ^!ˆ‚ddbˆÛÜ!ˆ`Te|ˆebˆÒÝÊ×#ƒxÕÓ׉#ˆ‚gebˆØÞ!ƒ‹ßà!ˆáuˆâcˆßãÊ×#ƒœÕä׉#ˆ‚‹ebˆßåÊ×#ƒ°Õæ׉#ˆ‚ŸebˆØç!ƒÄ×\fèd{ ‚Ìéd{ Ê\f\fƒÙê \n\"ƒæ\f„íê \n\"ƒí\f@ B \fA‰„*ëp!ˆÆìí!ƒ \nÓ.R‚ï\nðñòñ%Ü.R!‰3ô3 \"B ) Ÿ.‡" [append gnus-score-score-files group gnus-internal-global-score-files sfiles file-name-as-directory expand-file-name gnus-kill-files-directory kill-dir klen nil ofiles not-match regexp get-buffer-create "*gnus score files*" buffer-disable-undo erase-buffer re-search-forward "." gnus-score-file-regexp replace-match "" t looking-at regexp-quote delete-char search-backward "/" "[/:]" "nn[a-z]+\\+" search-forward "+" -1 "\\" ".all" "[./:].*" "all" ".*" "not." 5 1 string-match kill-buffer gnus-use-long-file-name not-score gnus-score-file-suffix gnus-replace-chars-in-string 46 47 58 localscore delete] 9 (#$ . 329236)]) #@50 Return list containing the score file for GROUP. (defalias 'gnus-score-find-single #[(group) "À \n\"À !D‡" [gnus-score-file-name group gnus-adaptive-file-suffix] 3 (#$ . 330370)]) #@103 Return list of score files for GROUP. This includes the score file for the group and all its parents. (defalias 'gnus-score-find-hierarchical #[(group) "ÀÁ!ÂÅÆ T#ƒ” O\fB‚\fBÈÉ\fŸ‰\"ÈÊ\f\"¤*‡" [copy-sequence (nil) 0 start all string-match "\\." group mapcar #[(newsgroup) "À \n\"‡" [gnus-score-file-name newsgroup gnus-adaptive-file-suffix] 3] gnus-score-file-name] 4 (#$ . 330557)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gnus-score-file-alist-cache nil current-load-list] 2) #@103 Return list of score files for GROUP. The list is determined from the variable gnus-score-file-alist. (defalias 'gnus-score-find-alist #[(group) "ÁÄ \"‰ƒ\nA‚Y ƒ/Ç @@ \"ƒ(\nÈ @A!¤ A‰„ ‰ƒPÇ @@ \"ƒI\nÈ @A!¤Á A‰„6 \nBB\n*‡" [gnus-score-file-multiple-match-alist nil score-files alist assoc group gnus-score-file-alist-cache string-match copy-sequence gnus-score-file-single-match-alist] 4 (#$ . 331055)]) (defalias 'gnus-possibly-score-headers #[(&optional trace) "Á‰ƒ <„ CÄ ! ƒ3 @9ƒ,Æ @!ƒ,\n @ !¤ A‰„\n…<Ç\n\"*‡" [gnus-score-find-score-files-function nil score-files func gnus-score-find-alist gnus-newsgroup-name fboundp gnus-score-headers trace] 4]) #@48 Return the name of a score file for NEWSGROUP. (defalias 'gnus-score-file-name #[(newsgroup &optional suffix) "† \nƒ\n؃Ä †Æ\"‚>ÇÈ!ƒ1ÄÉ\n!ÊQ †-Æ\"‚>ÄË\n!ÌQ †=Æ\")‡" [suffix gnus-score-file-suffix newsgroup "" expand-file-name gnus-kill-files-directory "~/News" gnus-use-long-file-name not-score gnus-newsgroup-saveable-name "." gnus-newsgroup-directory-form "/"] 4 (#$ . 331756)]) #@52 Scan all global score directories for score files. (defalias 'gnus-score-search-global-directories #[(files) "À\nƒ'ÃÄ\n@\"ƒÅ\n@ÆÇ ÈP#‚ \n@ B\nA‰„ ‰ )‡" [nil out files string-match "/$" directory-files t gnus-score-file-regexp "$" gnus-internal-global-score-files] 6 (#$ . 332162) (list gnus-global-score-files)]) (byte-code "À ˆÁÂ!‡" [gnus-ems-redefine provide gnus] 2) emacs-19.30/lisp/gomoku.elc100666 74777 1 54641 5754705225 14132 0ustar esrdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri May 12 12:18:36 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/gomoku.el ;;; emacs version 19.28.91.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/gomoku.el' was compiled for Emacs 19")) #@58 If non-nil, its value is called on entry to Gomoku mode. (defvar gomoku-mode-hook nil (#$ . 486)) #@37 Local keymap to use in Gomoku mode. (defvar gomoku-mode-map nil (#$ . 590)) (byte-code "„£Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÐ#ˆÂÔÒ#ˆÂÕÎ#ˆÂÖÌ#ˆÂ×Ø#ˆÂÙØ#ˆÂÚØ#ˆÂÛØ#ˆÂÜÝ#ˆÂÞß#ˆÂàá#ˆÂâÒ#ˆÂãÐ#ˆÂäÌ#ˆÂåÎ#ˆÂæØ#ˆÂçè#ˆÂéØ#ˆÁ‡" [gomoku-mode-map make-sparse-keymap define-key "y" gomoku-move-nw "u" gomoku-move-ne "b" gomoku-move-sw "n" gomoku-move-se "h" gomoku-move-left "l" gomoku-move-right "j" gomoku-move-down "k" gomoku-move-up "" "" "" "" "X" gomoku-human-plays "x" " " "" "" gomoku-human-takes-back "" gomoku-human-resigns "" gomoku-emacs-plays [up] [down] [left] [right] [kp-enter] [mouse-2] gomoku-click [insert]] 4) #@460 Major mode for playing Gomoku against Emacs. You and Emacs play in turn by marking a free square. You mark it with X and Emacs marks it with O. The winner is the first to get five contiguous marks horizontally, vertically or in diagonal. You play by moving the cursor over the square you choose and hitting \[gomoku-human-plays]. Other useful commands: \{gomoku-mode-map} Entry to this mode calls the value of `gomoku-mode-hook' if that value is non-nil. (defalias 'gomoku-mode #[nil "ÀÂÄ ˆÅ!ˆÇÈ!‡" [gomoku-mode major-mode "Gomoku" mode-name gomoku-display-statistics use-local-map gomoku-mode-map run-hooks gomoku-mode-hook] 2 (#$ . 1263) nil]) #@40 Number of columns on the Gomoku board. (defvar gomoku-board-width nil (#$ . 1923)) #@38 Number of lines on the Gomoku board. (defvar gomoku-board-height nil (#$ . 2012)) #@56 Vector recording the actual state of the Gomoku board. (defvar gomoku-board nil (#$ . 2100)) #@32 Length of gomoku-board vector. (defvar gomoku-vector-length nil (#$ . 2199)) #@47 After how many moves will Emacs offer a draw? (defvar gomoku-draw-limit nil (#$ . 2282)) #@69 Translate X, Y cartesian coords into the corresponding board index. (defalias 'gomoku-xy-to-index #[(x y) " _\n\\\\‡" [y gomoku-board-width x] 3 (#$ . 2377)]) #@46 Return corresponding x-coord of board INDEX. (defalias 'gomoku-index-to-x #[(index) " T¦‡" [index gomoku-board-width] 2 (#$ . 2544)]) #@46 Return corresponding y-coord of board INDEX. (defalias 'gomoku-index-to-y #[(index) " T¥‡" [index gomoku-board-width] 2 (#$ . 2685)]) #@65 Create the gomoku-board vector and fill it with initial values. (defalias 'gomoku-init-board #[nil "À Â\" S Xƒ$ ÇIˆ \fÇIˆ T\fS‚\n* W…= ÇIˆ È\\\\‰‚()‡" [make-vector gomoku-vector-length 0 gomoku-board ii i gomoku-board-width -1 1] 4 (#$ . 2826)]) #@56 Vector recording the actual score of the free squares. (defvar gomoku-score-table nil (#$ . 3098)) #@27 Score of an empty qtuple. (defconst nil-score 7 (#$ . 3203)) #@37 Score of a qtuple containing one X. (defconst Xscore 15 (#$ . 3270)) #@39 Score of a qtuple containing two X's. (defconst XXscore 400 (#$ . 3345)) #@41 Score of a qtuple containing three X's. (defconst XXXscore 1800 (#$ . 3424)) #@40 Score of a qtuple containing four X's. (defconst XXXXscore 100000 (#$ . 3507)) #@37 Score of a qtuple containing one O. (defconst Oscore 35 (#$ . 3592)) #@39 Score of a qtuple containing two O's. (defconst OOscore 800 (#$ . 3667)) #@41 Score of a qtuple containing three O's. (defconst OOOscore 15000 (#$ . 3746)) #@40 Score of a qtuple containing four O's. (defconst OOOOscore 800000 (#$ . 3830)) #@52 Vector associating qtuple contents to their score. (defconst gomoku-score-trans-table (byte-code "À \n \f ÆƉ‰‰‰Ɖ‰‰‰ Ɖ‰‰‰\nƉ‰‰‰‰&‡" [vector nil-score Xscore XXscore XXXscore XXXXscore 0 Oscore OOscore OOOscore OOOOscore] 32) (#$ . 3915)) #@56 Threshold score beyond which an Emacs move is winning. (defconst gomoku-winning-threshold OOOOscore (#$ . 4169)) #@55 Threshold score beyond which a human move is winning. (defconst gomoku-loosing-threshold XXXXscore (#$ . 4288)) #@66 Compute index of free square with highest score, or nil if none. (defalias 'gomoku-strongest-square #[nil "À‰Á‰\"Á \f\"ʼn \n  Xƒ\f H W„„\f H‰ Vƒ[  HÀUƒQÂ\n  ‚„\f ÎIˆ‚„  HÀU„o\f ÎIˆ‚„Ï\nT‰\n!ÀUƒ„   T‰ ‚.‡" [0 gomoku-xy-to-index 1 gomoku-board-width gomoku-board-height nil score best-square end square count score-max gomoku-score-table gomoku-board -1 random] 7 (#$ . 4406)]) #@49 Recorded initial value of previous score table. (defvar gomoku-saved-score-table nil (#$ . 4849)) #@41 Recorded value of previous board width. (defvar gomoku-saved-board-width nil (#$ . 4953)) #@42 Recorded value of previous board height. (defvar gomoku-saved-board-height nil (#$ . 5049)) #@64 Create the score table vector and fill it with initial values. (defalias 'gomoku-init-score-table #[nil "ƒ \nUƒ \fUƒÅ!‰‡Ç Ê_\"ˉ‰‰‰‰\f  TÒ¥ TÒ¥Ó^ Ó^\fÔÔ XƒxÔÔXƒoÕ\"ˆT‰‚YT‰‚OXƒ£ÔÔ\fXƒšÕ\"ˆT‰‚„T‰‚z.Å!  ‰‡" [gomoku-saved-score-table gomoku-board-width gomoku-saved-board-width gomoku-board-height gomoku-saved-board-height copy-sequence gomoku-score-table make-vector gomoku-vector-length nil-score 20 nil maxj2 maxi2 maxj maxi j i 2 4 1 gomoku-init-square-score] 7 (#$ . 5147)]) #@53 Return the number of qtuples containing square I,J. (defalias 'gomoku-nb-qtuples #[(i j) "À S^À\n Z^À S^À\f Z^‰\\É]Ê^ \\É]Ê^^ ^\\É]Ê^^ ^\\É]Ê^Ë\\\\\\\\,‡" [4 i gomoku-board-width j gomoku-board-height down up right left 3 8 -12] 7 (#$ . 5717)]) #@60 Give initial score to square I,J and to its mirror images. (defalias 'gomoku-init-square-score #[(i j) " ZT\n ZTÄ \" ÆH_ \nË \"Iˆ\nË \"Iˆ\nË \"Iˆ\nË \"I+‡" [gomoku-board-width i gomoku-board-height j gomoku-nb-qtuples gomoku-score-trans-table 0 sc jj ii gomoku-score-table gomoku-xy-to-index] 5 (#$ . 5991)]) #@60 Update score table after SQUARE received a DVAL increment. (defalias 'gomoku-update-score-table #[(square dval) "À !à !ÅÆ\nZ]ÅÆ\fZ]É\n\nZËZ^\fÉ \fZËZ^Ï\f ÆÉ&ˆÏ ÉÆ&ˆÏ]\f^ Ɖ&ˆÏÆ\fZÅ\n\nZ]]É\nÑZ \fZËZ^^ ÒÆ&.‡" [gomoku-index-to-x square x gomoku-index-to-y y -4 1 imin jmin 0 gomoku-board-width 4 imax gomoku-board-height jmax gomoku-update-score-in-direction dval 5 -1] 7 (#$ . 6333)]) #@187 Update scores for all squares in the qtuples starting between the LEFTth square and the RIGHTth after SQUARE, along the DX, DY direction, considering that DVAL has been added on SQUARE. (defalias 'gomoku-update-score-in-direction #[(left right square dx dy dval) " V†¾Â‰‰‰‰‰É\n \"\f_\\\f _\\Í_\\\fÎ\f XƒW\f\fH\\\f\\‰\f‚?X…¼\fH\fZHZ‰ÎU„ž‰\f Xƒž\fHÎUƒ“\f\fH \\Iˆ\f\\‰\f‚w \\\fH[ H\\\\\\‰‚Y.‡" [left right nil delta count square2 square1 square0 depl gomoku-xy-to-index dx dy square 4 0 gomoku-board gomoku-score-trans-table dval gomoku-score-table] 7 (#$ . 6764)]) #@35 Non-nil if a game is in progress. (defvar gomoku-game-in-progress nil (#$ . 7429)) #@66 A record of all moves that have been played during current game. (defvar gomoku-game-history nil (#$ . 7518)) #@49 Number of moves already played in current game. (defvar gomoku-number-of-moves nil (#$ . 7634)) #@58 Number of moves already played by human in current game. (defvar gomoku-number-of-human-moves nil (#$ . 7736)) #@32 Non-nil if Emacs played first. (defvar gomoku-emacs-played-first nil (#$ . 7853)) #@52 Non-nil if Human took back a move during the game. (defvar gomoku-human-took-back nil (#$ . 7941)) #@49 Non-nil if Human refused Emacs offer of a draw. (defvar gomoku-human-refused-draw nil (#$ . 8046)) #@53 Non-nil if Emacs is in the middle of a computation. (defvar gomoku-emacs-is-computing nil (#$ . 8151)) #@43 Initialize a new game on an N by M board. (defalias 'gomoku-start-game #[(n m) "ÀÀ   Ç\\ T_T É__Ê¥ Ì ÎÎÌÌÌÔ \"ˆÕ ˆÖ ˆÌ‰‡" [t gomoku-emacs-is-computing gomoku-game-in-progress n gomoku-board-width m gomoku-board-height 2 gomoku-vector-length 7 10 gomoku-draw-limit nil gomoku-game-history 0 gomoku-number-of-moves gomoku-number-of-human-moves gomoku-emacs-played-first gomoku-human-took-back gomoku-human-refused-draw gomoku-init-display gomoku-init-score-table gomoku-init-board] 3 (#$ . 8260)]) #@47 Go to SQUARE, play VAL and update everything. (defalias 'gomoku-play-move #[(square val &optional dont-update-score) "À\nÃUƒ\fT‚ ÆUƒÀ HB\nB\n TË\n\"ˆ\f\nIˆ „FÎ\n\"ˆ ÏIˆÐ‰‡" [t gomoku-emacs-is-computing val 1 gomoku-number-of-human-moves gomoku-number-of-moves 0 gomoku-emacs-played-first square gomoku-score-table gomoku-game-history gomoku-plot-square gomoku-board dont-update-score gomoku-update-score-table -1 nil] 3 (#$ . 8784)]) #@44 Take back last move and update everything. (defalias 'gomoku-take-back #[nil "À\n@‰@ \fH‰ÇUƒS\nA S Ê\fË\"ˆ \fËIˆÌ\f[\"ˆ \f AIˆ+Ή‡" [t gomoku-emacs-is-computing gomoku-game-history last-move square gomoku-board oldval 1 gomoku-number-of-human-moves gomoku-number-of-moves gomoku-plot-square 0 gomoku-update-score-table gomoku-score-table nil] 4 (#$ . 9255)]) #@44 Number of games Emacs won in this session. (defvar gomoku-number-of-emacs-wins 0 (#$ . 9638)) #@42 Number of games you won in this session. (defvar gomoku-number-of-human-wins 0 (#$ . 9738)) #@48 Number of games already drawn in this session. (defvar gomoku-number-of-draws 0 (#$ . 9836)) #@41 Terminate the current game with RESULT. (defalias 'gomoku-terminate-game #[(result) "À\nÃ=ƒM\fT ÆWƒÇ‚IƒÉ‚I\nƒ'Ë‚I\f„0Í‚IÏUƒHÏUƒH\fÑVƒHÒ‚IÓ‚É\nÔ=ƒoT\nƒaÕ‚k\fƒjÖ‚kׂÉ\nØ=ƒ}\fTÙ‚É\nÚ=ƒŸT\nƒ‘Û‚›\fƒšÜ‚›Ý‚É\nÞ=ƒÁT\nƒ³ß‚½\fƒ¼à‚½á‚É\nâ=ƒÉãä ˆ ƒÔÁ !ˆå ˆÀ‰&)‡" [nil message result emacs-won gomoku-number-of-emacs-wins gomoku-number-of-moves 20 "This was a REALLY QUICK win." gomoku-human-refused-draw "I won... Too bad you refused my offer of a draw !" gomoku-human-took-back "I won... Taking moves back will not help you !" gomoku-emacs-played-first "I won... Playing first did not help you much !" gomoku-number-of-human-wins 0 gomoku-number-of-draws 1 "I'm becoming tired of winning..." "I won." human-won "OK, you won this one. I, for one, never take my moves back..." "OK, you won this one... so what ?" "OK, you won this one. Now, let me play first just once." human-resigned "So you resign. That's just one more win for me." nobody-won "This is a draw. I, for one, never take my moves back..." "This is a draw. Just chance, I guess." "This is a draw. Now, let me play first just once." draw-agreed "Draw agreed. I, for one, never take my moves back..." "Draw agreed. You were lucky." "Draw agreed. Now, let me play first just once." crash-game "Sorry, I have been interrupted and cannot resume that game..." gomoku-display-statistics ding gomoku-game-in-progress] 2 (#$ . 9935)]) #@56 What to do when Emacs detects it has been interrupted. (defalias 'gomoku-crash-game #[nil "ÀÂÃ!ˆÄÅ!ˆÆ ‡" [nil gomoku-emacs-is-computing gomoku-terminate-game crash-game sit-for 4 gomoku-prompt-for-other-game] 2 (#$ . 11402)]) #@515 Start a Gomoku game between you and Emacs. If a game is in progress, this command allow you to resume it. If optional arguments N and M are given, an N by M board is used. You and Emacs play in turn by marking a free square. You mark it with X and Emacs marks it with O. The winner is the first to get five contiguous marks horizontally, vertically or in diagonal. You play by moving the cursor over the square you choose and hitting \\[gomoku-human-plays]. Use \[describe-mode] for more info. (defalias 'gomoku #[(&optional n m) "À ˆ ƒ\n ‡ „ˆÄ Å „ „( ÊWƒ6ËÌ!ˆ‚R ÊWƒDËÍ!ˆ‚RVƒRËÎ\"ˆ Vƒp š„pÐÑÒ \"!„p *ÓÔ!ˆÕ \"ˆÐÖ!ƒ…× ‡Ø ‡ÐÙ!ƒ‘Ø ‡Ú ‡" [gomoku-switch-to-window gomoku-emacs-is-computing gomoku-crash-game gomoku-game-in-progress gomoku-max-width gomoku-max-height max-height max-width n m 1 error "I need at least 1 column" "I need at least 1 row" "I cannot display %d columns in that window" gomoku-saved-board-height y-or-n-p format "Do you really want %d rows " message "One moment, please..." gomoku-start-game "Do you allow me to play first " gomoku-emacs-plays gomoku-prompt-for-move "Shall we continue our game " gomoku-human-resigns] 4 (#$ . 11636) nil]) #@38 Compute Emacs next move and play it. (defalias 'gomoku-emacs-plays #[nil "À ˆ ƒ\n ‡ „Ä ‡ÅÆ!ˆÇ‰ Ê ‰ „)ËÌ!‚t  HÎ Ï\"ˆYƒMÑ Ï\"ˆÒ ˆËÓ!‚tÔUƒZËÌ!‚tVƒr„rØ ƒrËÙ!‚tÚ *‡" [gomoku-switch-to-window gomoku-emacs-is-computing gomoku-crash-game gomoku-game-in-progress gomoku-prompt-for-other-game message "Let me think..." nil score square gomoku-strongest-square gomoku-terminate-game nobody-won gomoku-score-table gomoku-play-move 6 gomoku-winning-threshold gomoku-find-filled-qtuple gomoku-cross-winning-qtuple emacs-won 0 gomoku-number-of-moves gomoku-draw-limit gomoku-human-refused-draw gomoku-offer-a-draw draw-agreed gomoku-prompt-for-move] 4 (#$ . 12874) nil]) #@37 Play at the square where you click. (defalias 'gomoku-click #[(click) "À !ˆÂ ‡" [mouse-set-point click gomoku-human-plays] 2 (#$ . 13572) "e"]) #@184 Signal to the Gomoku program that you have played. You must have put the cursor on the square where you want to play. If the game is finished, this command requests for another game. (defalias 'gomoku-human-plays #[nil "À ˆ ƒ\n ‡ „Ä ‡Å‰È ‰„%ÉÊ!‚] HÌU„5ÉÍ!‚]HÏÐ\"ˆYƒ[ÒÐ\"ƒ[Ó ˆÔÕ!‚]Ö *‡" [gomoku-switch-to-window gomoku-emacs-is-computing gomoku-crash-game gomoku-game-in-progress gomoku-prompt-for-other-game nil score square gomoku-point-square error "Your point is not on a square. Retry !" gomoku-board 0 "Your point is not on a free square. Retry !" gomoku-score-table gomoku-play-move 1 gomoku-loosing-threshold gomoku-find-filled-qtuple gomoku-cross-winning-qtuple gomoku-terminate-game human-won gomoku-emacs-plays] 4 (#$ . 13723) nil]) #@73 Signal to the Gomoku program that you wish to take back your last move. (defalias 'gomoku-human-takes-back #[nil "À ˆ ƒ\n ‡ „ÄÅ!ˆÆÇ!ˆÈ ‡ ÊUƒ$ÄË!‡ÄÌ!ˆÍ  Uƒ=Ð ˆ‚/)Ñ ‡" [gomoku-switch-to-window gomoku-emacs-is-computing gomoku-crash-game gomoku-game-in-progress message "Too late for taking back..." sit-for 4 gomoku-prompt-for-other-game gomoku-number-of-human-moves 0 "You have not played yet... Your move ?" "One moment, please..." t gomoku-human-took-back number gomoku-take-back gomoku-prompt-for-move] 2 (#$ . 14506) nil]) #@59 Signal to the Gomoku program that you may want to resign. (defalias 'gomoku-human-resigns #[nil "À ˆ ƒ\n ‡ „ÄÅ!‡ÆÇ!ƒÈÉ!‡ÆÊ!ƒ%Ë ‡ÈÉ!‡" [gomoku-switch-to-window gomoku-emacs-is-computing gomoku-crash-game gomoku-game-in-progress message "There is no game in progress" y-or-n-p "You mean, you resign " gomoku-terminate-game human-resigned "You mean, we continue " gomoku-prompt-for-move] 2 (#$ . 15054) nil]) #@44 Display a message asking for Human's move. (defalias 'gomoku-prompt-for-move #[nil "À ÂUƒ Â\fÄ!ˆŠÅ q)‡" [message gomoku-number-of-human-moves 0 "Your move ? (move to a free square and hit X, RET ...)" "Your move ?" other-buffer] 3 (#$ . 15473)]) #@37 Ask for another game, and start it. (defalias 'gomoku-prompt-for-other-game #[nil "ÀÁ!ƒ  \f\"‡ÅÆ!‡" [y-or-n-p "Another game " gomoku gomoku-board-width gomoku-board-height message "Chicken !"] 3 (#$ . 15728)]) #@49 Offer a draw and return T if Human accepted it. (defalias 'gomoku-offer-a-draw #[nil "ÀÁ!† ‰‡" [y-or-n-p "I offer you a draw. Do you accept it " t gomoku-human-refused-draw] 2 (#$ . 15946)]) #@58 *Horizontal spacing between squares on the Gomoku board. (defconst gomoku-square-width 4 (#$ . -16146)) #@56 *Vertical spacing between squares on the Gomoku board. (defconst gomoku-square-height 2 (#$ . -16256)) #@73 *Number of columns between the Gomoku board and the side of the window. (defconst gomoku-x-offset 3 (#$ . -16365)) #@70 *Number of lines between the Gomoku board and the top of the window. (defconst gomoku-y-offset 1 (#$ . -16486)) #@54 Largest possible board width for the current window. (defalias 'gomoku-max-width #[nil "ÀÁ !\nZ\nZÃZ\f¥T‡" [window-width selected-window gomoku-x-offset 1 gomoku-square-width] 2 (#$ . 16604)]) #@55 Largest possible board height for the current window. (defalias 'gomoku-max-height #[nil "ÀÁ !\nZ\nZÃZ\f¥T‡" [window-height selected-window gomoku-y-offset 2 gomoku-square-height] 2 (#$ . 16803)]) #@77 Return the board column where point is, or nil if it is not a board column. (defalias 'gomoku-point-x #[nil "iZ‰ÂY… ¦ÂU… ¥T‰\fX… )‡" [gomoku-x-offset col 0 gomoku-square-width gomoku-board-width] 3 (#$ . 17006)]) #@71 Return the board row where point is, or nil if it is not a board row. (defalias 'gomoku-point-y #[nil "ÀÁ`\"\nZÁZ‰ÄY…$ ¦ÄU…$ ¥T‰X…$ )‡" [count-lines 1 gomoku-y-offset row 0 gomoku-square-height gomoku-board-height] 4 (#$ . 17236)]) #@73 Return the index of the square point is on, or nil if not on the board. (defalias 'gomoku-point-square #[nil "À‰à ‰…Ä ‰…Å\n \"*‡" [nil y x gomoku-point-x gomoku-point-y gomoku-xy-to-index] 3 (#$ . 17483)]) #@36 Move point to square number INDEX. (defalias 'gomoku-goto-square #[(index) "ÀÁ\n!Ã\n!\"‡" [gomoku-goto-xy gomoku-index-to-x index gomoku-index-to-y] 4 (#$ . 17703)]) #@38 Move point to square at X, Y coords. (defalias 'gomoku-goto-xy #[(x y) "À \n S_Ä\\\\!ˆÅS_\\!‡" [goto-line gomoku-y-offset gomoku-square-height y 1 move-to-column gomoku-x-offset gomoku-square-width x] 4 (#$ . 17875)]) #@73 Draw 'X', 'O' or '.' on SQUARE (depending on VALUE), leave point there. (defalias 'gomoku-plot-square #[(square value) "À !ˆÂ ÄUƒÅ‚ ÆUƒÇ‚È!ˆÉÊ!‡" [gomoku-goto-square square gomoku-put-char value 1 88 6 79 46 sit-for 0] 3 (#$ . 18105)]) #@33 Draw CHAR on the Gomoku screen. (defalias 'gomoku-put-char #[(char) "À\ncˆÃÄ!ˆÅÄ!)‡" [t inhibit-read-only char delete-char 1 backward-char] 2 (#$ . 18355)]) #@33 Display an N by M Gomoku board. (defalias 'gomoku-init-display #[(n m) "Àp!ˆÁà ˆÄ‰‰‰É\nSË\"ÌPÍÎÏS\"\"ÉË\"ÌÒRÉS\n_Ó\\\\Ë\"‰ÒPÍÎÏS\"\"‰PÍÎÏS\"\"ÍÎÏ\"\"‰±ˆ,×TØ¥TØ¥\"ˆÙÚ!)‡" [buffer-disable-undo t inhibit-read-only erase-buffer nil string4 string3 string2 string1 make-string gomoku-square-width 32 "." apply concat make-list n gomoku-x-offset "\n" 1 gomoku-square-height m gomoku-y-offset gomoku-goto-xy 2 sit-for 0] 6 (#$ . 18519)]) #@72 Obnoxiously display some statistics about previous games in mode line. (defalias 'gomoku-display-statistics #[nil "ÁU„ÂÃ\f $‚ÂÆ\f #È ‡" [gomoku-number-of-draws 0 format ": Won %d, lost %d, drew %d" gomoku-number-of-human-wins gomoku-number-of-emacs-wins ": Won %d, lost %d" mode-line-process force-mode-line-update] 5 (#$ . 19018)]) #@51 Find or create the Gomoku buffer, and display it. (defalias 'gomoku-switch-to-window #[nil "ÀÁ!‰ƒÃ\n!‚\fƒÅ ˆÃÁ!ˆÆ )‡" [get-buffer "*Gomoku*" buff switch-to-buffer gomoku-game-in-progress gomoku-crash-game gomoku-mode] 3 (#$ . 19365) nil]) #@37 First square of the winning qtuple. (defvar gomoku-winning-qtuple-beg nil (#$ . 19617)) #@36 Last square of the winning qtuple. (defvar gomoku-winning-qtuple-end nil (#$ . 19711)) #@53 Direction of the winning qtuple (along the X axis). (defvar gomoku-winning-qtuple-dx nil (#$ . 19804)) #@53 Direction of the winning qtuple (along the Y axis). (defvar gomoku-winning-qtuple-dy nil (#$ . 19913)) #@60 Return T if SQUARE belongs to a qtuple filled with VALUEs. (defalias 'gomoku-find-filled-qtuple #[(square value) "À \nÃÄ$†!À \nÄÃ$†!À \nÉ$†!À \nÅÃ$‡" [gomoku-check-filled-qtuple square value 1 0 -1] 5 (#$ . 20022)]) #@74 Return T if SQUARE belongs to a qtuple filled with VALUEs along DX, DY. (defalias 'gomoku-check-filled-qtuple #[(square value dx dy) "À‰ ‰Â \f\"Å \n‰ ÌVƒ5  Z‰ HUƒ5 S‰ ‚ Ï\\\nWƒ] \\‰HUƒ]\nT‰\n‚=\nU…~  _\\ \n_\\ \fÔ.‡" [0 square gomoku-xy-to-index dx dy nil a+4 depl right left b a -4 value gomoku-board 4 gomoku-winning-qtuple-beg gomoku-winning-qtuple-end gomoku-winning-qtuple-dx gomoku-winning-qtuple-dy t] 8 (#$ . 20248)]) #@64 Cross winning qtuple, as found by `gomoku-find-filled-qtuple'. (defalias 'gomoku-cross-winning-qtuple #[nil "À \n \f$‡" [gomoku-cross-qtuple gomoku-winning-qtuple-beg gomoku-winning-qtuple-end gomoku-winning-qtuple-dx gomoku-winning-qtuple-dy] 5 (#$ . 20742)]) #@73 Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction. (defalias 'gomoku-cross-qtuple #[(square1 square2 dx dy) "ŠÀ \n\"\f U„ªÆ\f!ˆ\f \\ ÇUƒ>\nÈUƒ>Ç  \nWƒ: T ÇuˆËÌ!ˆ‚#)‚ ÈUƒi\nÇUƒiÇ   Wƒe T ÎÇ!ˆËÏ!ˆ‚M)‚ ÐUƒŠ\nÇUƒŠÑ\nÒ¥!ˆÎ Ò¥!ˆËÓ!ˆ‚ ÇUƒ\nÇUƒ\nÒ¥uˆÎ Ò¥!ˆËÔ!ˆ‚*ÕÈ!‡" [gomoku-xy-to-index dx dy depl square1 square2 gomoku-goto-square 1 0 n gomoku-square-width gomoku-put-char 45 gomoku-square-height next-line 124 -1 backward-char 2 47 92 sit-for] 3 (#$ . 21009)]) #@53 Move point backward one column on the Gomoku board. (defalias 'gomoku-move-left #[nil "À  „\f ÃVƒ\f‚Å!)‡" [gomoku-point-x x backward-char 1 gomoku-square-width 0] 3 (#$ . 21532) nil]) #@52 Move point forward one column on the Gomoku board. (defalias 'gomoku-move-right #[nil "À ‰„ ‚ Wƒ\f‚Åu)‡" [gomoku-point-x x 1 gomoku-board-width gomoku-square-width 0] 3 (#$ . 21733) nil]) #@46 Move point down one row on the Gomoku board. (defalias 'gomoku-move-down #[nil "À  „\f \fWƒ ‚Æ!)‡" [gomoku-point-y y next-line 1 gomoku-board-height gomoku-square-height 0] 3 (#$ . 21937) nil]) #@44 Move point up one row on the Gomoku board. (defalias 'gomoku-move-up #[nil "À  „\f ÃVƒ\f‚Å!)‡" [gomoku-point-y y previous-line 1 gomoku-square-height 0] 3 (#$ . 22148) nil]) #@44 Move point North East on the Gomoku board. (defalias 'gomoku-move-ne #[nil "À ˆÁ ‡" [gomoku-move-up gomoku-move-right] 1 (#$ . 22339) nil]) #@44 Move point South East on the Gomoku board. (defalias 'gomoku-move-se #[nil "À ˆÁ ‡" [gomoku-move-down gomoku-move-right] 1 (#$ . 22485) nil]) #@44 Move point North West on the Gomoku board. (defalias 'gomoku-move-nw #[nil "À ˆÁ ‡" [gomoku-move-up gomoku-move-left] 1 (#$ . 22633) nil]) #@44 Move point South West on the Gomoku board. (defalias 'gomoku-move-sw #[nil "À ˆÁ ‡" [gomoku-move-down gomoku-move-left] 1 (#$ . 22778) nil]) (provide (quote gomoku)) emacs-19.30/lisp/goto-addr.elc100666 12120 1 11037 6053157203 14445 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 17 14:11:59 1995 ;;; from file /home/fsf/rms/e19/lisp/goto-addr.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`goto-addr.el' was compiled for Emacs 19.29 or later")) (require (quote browse-url)) #@116 *If t, URL's and e-mail addresses in buffer are fontified. But only if `goto-address-highlight-p' is also non-nil. (defvar goto-address-fontify-p t (#$ . -506)) #@62 *If t, URL's and e-mail addresses in buffer are highlighted. (defvar goto-address-highlight-p t (#$ . -673)) #@67 *Maximum size of file in which to fontify and/or highlight URL's. (defvar goto-address-fontify-maximum-size 30000 (#$ . -788)) #@59 A regular expression probably matching an e-mail address. (defvar goto-address-mail-regexp "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" (#$ . 921)) #@47 A regular expression probably matching a URL. (defvar goto-address-url-regexp (concat "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|" "telnet\\|wais\\):\\(//[-a-zA-Z0-9_.]+:" "[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*" "[-a-zA-Z0-9_=#$@~`%&*+|\\/]") (#$ . 1085)) #@140 *Function to compose mail. Two pre-made functions are `goto-address-send-using-mail' (sendmail); and `goto-address-send-using-mhe' (MH-E). (defvar goto-address-mail-method (quote goto-address-send-using-mail) (#$ . -1356)) #@145 Fontify the URL's and e-mail addresses in the current buffer. This function implements `goto-address-highlight-p' and `goto-address-fontify-p'. (defalias 'goto-address-fontify #[nil "ŠÀ‰Á ebˆd`Z WƒdÆÈÀ#ƒ:É•bˆ\nƒ.ËɔɕÌÍ$ˆËɔɕÎÏ$ˆ‚ebˆÆÈÀ#ƒdÉ•bˆ\nƒXËɔɕÌÑ$ˆËɔɕÎÒ$ˆ‚=Á …q\n?…qÓÈ!,‡" [t buffer-modified-p modified inhibit-point-motion-hooks inhibit-read-only goto-address-fontify-maximum-size re-search-forward goto-address-url-regexp nil 0 goto-address-fontify-p put-text-property face bold mouse-face highlight goto-address-mail-regexp italic secondary-selection set-buffer-modified-p] 5 (#$ . 1586)]) #@273 Send to the e-mail address or load the URL clicked with the mouse. Send mail to address at position of mouse click. See documentation for `goto-address-find-address-at-point'. If no address is found there, then load the URL at or before the position of the mouse click. (defalias 'goto-address-at-mouse #[(event) "Š‰A@) ‰@)!qˆ ‰A@:ƒ! A@@‚$ A@)bˆŠÄ )‰ƘƒKÇ ‰ƘƒBÉÊ!‚G !)‚O\f !+‡" [event posn window-buffer position goto-address-find-address-at-point address "" browse-url-url-at-point url error "No e-mail address or URL found" browse-url-browser-function goto-address-mail-method] 3 (#$ . 2216) "e"]) #@215 Send to the e-mail address or load the URL at point. Send mail to address at point. See documentation for `goto-address-find-address-at-point'. If no address is found there, then load the URL at or before point. (defalias 'goto-address-at-point #[nil "ŠŠÀ )‰˜ƒ#à ‰˜ƒÅÆ!‚\f!)‚' !*‡" [goto-address-find-address-at-point address "" browse-url-url-at-point url error "No e-mail address or URL found" browse-url-browser-function goto-address-mail-method] 3 (#$ . 2845) nil]) #@178 Find e-mail address around or before point. Then search backwards to beginning of line for the start of an e-mail address. If no e-mail address found, return the empty string. (defalias 'goto-address-find-address-at-point #[nil "ŠÀyˆ`)Âà Ä#ˆÅ!„-ŠÇˆ`)ÉÄ#…)À”b)ƒ5À”À•{‚6Ê)‡" [0 bol re-search-backward "[^-_A-z0-9.@]" lim looking-at goto-address-mail-regexp nil eol re-search-forward ""] 4 (#$ . 3338)]) (defalias 'goto-address-send-using-mhe #[(to) "À ˆÁÂ!ÃÄ!Å É ˆÊ $+‡" [mh-find-path mh-read-address "Cc: " read-string "Subject: " current-window-configuration config subject cc delete-other-windows mh-send-sub to] 5]) (defalias 'goto-address-send-using-mail #[(to) "ÀÁ\n\"ˆeb…\fÇ" [mail-other-window nil to 2] 3]) #@326 Sets up goto-address functionality in the current buffer. Allows user to use mouse/keyboard command to click to go to a URL or to send e-mail. By default, goto-address binds to S-mouse-2 and C-c RET. Also fontifies the buffer appropriately (see `goto-address-fontify-p' and `goto-address-highlight-p' for more information). (defalias 'goto-address #[nil "ÀÁÂ\"ˆÀÃÄ\"ˆ …Æ ‡" [local-set-key [S-mouse-2] goto-address-at-mouse " " goto-address-at-point goto-address-highlight-p goto-address-fontify] 3 (#$ . 4090) nil]) (provide (quote goto-addr)) emacs-19.30/lisp/gud.elc100666 13437 1 100221 6043465464 13524 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:51:13 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/gud.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`gud.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require comint etags] 2) #@48 Prefix of all GUD commands valid in C buffers. (defvar gud-key-prefix "" (#$ . 521)) (byte-code "À ÂPÃ\"ˆÄ ÆÇ#ˆÈÉ!„Ê É B ÌÉÍÎ#ˆÈÏ!„+ÊÏ B ÌÏÍÎ#‡" [global-set-key gud-key-prefix "\f" gud-refresh define-key ctl-x-map " " gud-break boundp gud-marker-filter nil current-load-list put permanent-local t gud-find-file] 4) (defalias 'gud-marker-filter #[(&rest args) "À \n\"‡" [apply gud-marker-filter args] 3]) (defalias 'gud-find-file #[(file) "ÀÁ\n\"ƒÃÄʼn\n$‚\n!‡" [string-match "//+" file replace-match "/" t gud-find-file] 5]) (byte-code "ÀÁ!„\nÂÃ!Á\fBÅ ÆÇ#ˆÅ ÈÉ#ˆÅ ÊË#ˆÅ ÌÍ#ˆÅ ÎË#ˆÅ ÏË#ˆÅ ÐÑ#ˆÅ ÒË#ˆÅ ÓÔ#ˆÅ ÕÖ#ˆÅ ×Ø#ˆÅ ÙÚ#‡" [boundp gud-menu-map make-sparse-keymap "Gud" current-load-list define-key [refresh] ("Refresh" . gud-refresh) [remove] ("Remove Breakpoint" . gud-remove) [tbreak] nil [break] ("Set Breakpoint" . gud-break) [up] [down] [print] ("Print Expression" . gud-print) [finish] [stepi] ("Step Instruction" . gud-stepi) [step] ("Step Line" . gud-step) [next] ("Next Line" . gud-next) [cont] ("Continue" . gud-cont)] 4) #@828 Define FUNC to be a command sending STR and bound to KEY, with optional doc string DOC. Certain %-escapes in the string arguments are interpreted specially if present. These are: %f name (without directory) of current source file. %d directory of current source file. %l number of current source line %e text of the C lvalue or function-call expression surrounding point. %a text of the hexadecimal address surrounding point %p prefix argument to the command (if any) as a number The `current' source file is the file of the current buffer (if we're in a C file) or the source file current at the last break or step (if we're in the GUD buffer). The `current' line is that of the current buffer (if we're in a source file) or the source line number at the last break or step (if we're in the GUD buffer). (defalias 'gud-def '(macro . #[(func cmd key &optional doc) "ÀÁ\nÃ\f† ÅÆÇÉE¯\n… ËÌÍ\nPÎ\nDF\n…/ÏÐÑ\nEÎ\nDEF‡" [progn defun func (arg) doc "" (interactive "p") gud-call cmd arg key define-key (current-local-map) "" quote global-set-key concat gud-key-prefix] 9 (#$ . 1582)])) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ B‡" [boundp gud-last-frame nil current-load-list gud-last-last-frame gud-gdb-history] 2) (defalias 'gud-gdb-massage-args #[(file args) "À B‡" ["-fullname" args] 2]) (byte-code "ÀÁ!„Â Ä Å Æ°ÁBÀÈ!„ÉÈBÊÈ!‡" [boundp gud-gdb-marker-regexp "\\([^" path-separator "\n]*\\)" "\\([0-9]*\\)" ".*\n" current-load-list gud-marker-acc "" make-variable-buffer-local] 7) (defalias 'gud-gdb-marker-filter #[(string) " PÂÄ \"ƒ/ƔƕOÇȔȕO!B ʉ”OPÊ•ËO‚ÄÌ\"ƒG ʉ”OPÊ”ËO‚M P )‡" [gud-marker-acc string "" output string-match gud-gdb-marker-regexp 1 string-to-int 2 gud-last-frame 0 nil ".*\\'"] 5]) #@65 Return a new keymap which inherits from MAP and has name `Gud'. (defalias 'gud-new-keymap #[(map) "ÀÁ!\n¤‡" [make-sparse-keymap "Gud" map] 2 (#$ . 3373)]) #@165 Make sure the current local map has a [menu-bar debug] submap. If it doesn't, replace it with a new map that inherits it, and create such a submap in that new map. (defalias 'gud-make-debug-menu #[nil "À …\nÁÀ Â\"?… ÃÄÀ !!ˆÅÀ ÆÇÄ!B#‡" [current-local-map lookup-key [menu-bar debug] use-local-map gud-new-keymap define-key [menu-bar debug] "Gud" gud-menu-map] 6 (#$ . 3535)]) (defalias 'gud-gdb-find-file #[(f) "ŠÀ !‰qˆÃ ˆÄÅÆ\"ˆÄÇÈ\"ˆÄÉÊ\"ˆÄËÌ\"ˆ\n*‡" [find-file-noselect f buf gud-make-debug-menu local-set-key [menu-bar debug tbreak] ("Temporary Breakpoint" . gud-tbreak) [menu-bar debug finish] ("Finish Function" . gud-finish) [menu-bar debug up] ("Up Stack" . gud-up) [menu-bar debug down] ("Down Stack" . gud-down)] 4]) #@57 Keymap for minibuffer prompting of gdb startup command. (defvar gdb-minibuffer-local-map nil (#$ . 4271)) (byte-code "„Á\n!ÃÄÅ#ˆÁ‡" [gdb-minibuffer-local-map copy-keymap minibuffer-local-map define-key " " comint-dynamic-complete-filename] 4) #@160 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. (defalias 'gdb #[(command-line) "À ÂÃÄ$ˆÅÆMˆÇÈ ÉÅ#ˆÊ ÌPÅ\"ˆÍÎMˆÇÈ ÏÍ#ˆÊ ÐPÍ\"ˆÑÒMˆÇÈ ÓÑ#ˆÊ ÔPÑ\"ˆÕÖMˆÇÈ ×Õ#ˆÊ ØPÕ\"ˆÙÚMˆÇÈ ÛÙ#ˆÊ ÜPÙ\"ˆÝÞMˆÇÈ ßÝ#ˆÊ àPÝ\"ˆáâMˆÇÈ ãá#ˆÊ äPá\"ˆåæMˆÇÈ çå#ˆÊ èPå\"ˆéêMˆÇÈ ëé#ˆÊ ìPé\"ˆíîMˆÇÈ ïí#ˆÊ ðPí\"ˆñòMˆÇÈ óñ#ˆÊ ôPñ\"ˆõÜö\"ˆõ÷ø\"ˆõùú\"ˆõûü\"ˆõýþ\"ˆÿ@ÿABC!‡" [gud-common-init command-line gud-gdb-massage-args gud-gdb-marker-filter gud-gdb-find-file gud-break #[(arg) "ÀÁ\n\"‡" [gud-call "break %f:%l" arg] 3 "Set breakpoint at current line." "p"] define-key current-local-map "" global-set-key gud-key-prefix "" gud-tbreak #[(arg) "ÀÁ\n\"‡" [gud-call "tbreak %f:%l" arg] 3 "Set temporary breakpoint at current line." "p"] "" "" gud-remove #[(arg) "ÀÁ\n\"‡" [gud-call "clear %f:%l" arg] 3 "Remove breakpoint at current line" "p"] "" "" gud-step #[(arg) "ÀÁ\n\"‡" [gud-call "step %p" arg] 3 "Step one source line with display." "p"] "" "" gud-stepi #[(arg) "ÀÁ\n\"‡" [gud-call "stepi %p" arg] 3 "Step one instruction with display." "p"] " " " " gud-next #[(arg) "ÀÁ\n\"‡" [gud-call "next %p" arg] 3 "Step one line (skip functions)." "p"] "" "" gud-cont #[(arg) "ÀÁ\n\"‡" [gud-call "cont" arg] 3 "Continue with display." "p"] "" "" gud-finish #[(arg) "ÀÁ\n\"‡" [gud-call "finish" arg] 3 "Finish executing current function." "p"] "" "" gud-up #[(arg) "ÀÁ\n\"‡" [gud-call "up %p" arg] 3 "Up N stack frames (numeric arg)." "p"] "<" "<" gud-down #[(arg) "ÀÁ\n\"‡" [gud-call "down %p" arg] 3 "Down N stack frames (numeric arg)." "p"] ">" ">" gud-print #[(arg) "ÀÁ\n\"‡" [gud-call "print %e" arg] 3 "Evaluate C expression at point." "p"] "" "" local-set-key gud-gdb-complete-command [menu-bar debug tbreak] ("Temporary Breakpoint" . gud-tbreak) [menu-bar debug finish] ("Finish Function" . gud-finish) [menu-bar debug up] ("Up Stack" . gud-up) [menu-bar debug down] ("Down Stack" . gud-down) "^(.*gdb[+]?) *" comint-prompt-regexp paragraph-start run-hooks gdb-mode-hook] 5 (#$ . 4526) (list (read-from-minibuffer "Run gdb (like this): " (if (consp gud-gdb-history) (car gud-gdb-history) "gdb ") gdb-minibuffer-local-map nil (quote (gud-gdb-history . 1))))]) (byte-code "À B Bà BÄ BÅÆ!„ÇÆ BLJ" [gud-gdb-complete-in-progress current-load-list gud-gdb-complete-string gud-gdb-complete-break gud-gdb-complete-list boundp gud-comint-buffer nil] 2) #@159 Perform completion on the GDB command preceding point. This is implemented using the GDB `complete' command which isn't available with older versions of GDB. (defalias 'gud-gdb-complete-command #[nil "`ŠÁyˆÂ !ƒÁ•bˆ`{)ÅÇÈ\f\"ˆÉ”\n\f\nÅOË\fÍÎ\fP!ˆÏÅŃIÓÔ!!ˆ‚:)ƒ\\ÇÖ@\"ƒ\\×Ø!ˆÙÚ\"‰‰Aƒ“@@˜ƒ†A‰¡ˆ‚jA‰„o*GÝUƒÏ@Á‰ Çá #ƒ½TÁ•‚§âÉ\"ÝUƒÎ ãPC+ä\"+‡" [end 0 looking-at comint-prompt-regexp command nil command-word string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" 2 gud-gdb-complete-break gud-gdb-complete-filter gud-marker-filter gud-basic-call "complete " t gud-gdb-complete-in-progress gud-gdb-complete-string gud-gdb-complete-list accept-process-output get-buffer-process gud-comint-buffer "^Undefined command: \"complete\"" error "This version of GDB doesn't support the `complete' command." sort string-lessp second first 1 count pos str "\\([^'\\]\\|\\\\'\\)*'" mod "'" comint-dynamic-simple-complete] 5 (#$ . 7011) nil]) (defalias 'gud-gdb-complete-filter #[(string) " PÂà \"ƒ \fÅ”OB Å•ÇO‚ \"ƒ+Ç ‡ ʇ" [gud-gdb-complete-string string string-match "\n" gud-gdb-complete-break 0 gud-gdb-complete-list nil comint-prompt-regexp gud-gdb-complete-in-progress ""] 3]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gud-sdb-history nil current-load-list] 2) #@69 If nil, we're on a System V Release 4 and don't need the tags hack. (defvar gud-sdb-needs-tags (byte-code "ÀÁ!?‡" [file-exists-p "/var"] 2) (#$ . 8356)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gud-sdb-lastfile nil current-load-list] 2) (defalias 'gud-sdb-massage-args #[(file args) "‡" [args] 1]) (defalias 'gud-sdb-marker-filter #[(string) "ƒ\n P‚ ÂÄÅ #ƒ+ƔƕOÇȔȕO!B‰ ‚ÄÊ #ƒKƔƕO‰ ÇȔȕO!B‰ ‚ÄÌ #ƒ_ƔƕO‰ ‚ ƒ}ÄÍ #ƒ} ÇΔΕO!B‰ ‚‰ ƒŠÏ•‚ÄÐ #ƒ˜Ï•‚Š GU…£ ÂO) ‡" [gud-marker-acc string nil start string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n" 2 string-to-int 3 gud-last-frame "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n\\([0-9]+\\):" gud-sdb-lastfile "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n" "^\\([0-9]+\\):" 1 0 "\n"] 6]) (defalias 'gud-sdb-find-file #[(f) "Šƒ Á\n!‚Ã\n!‰qˆÅ ˆÆÇÈ\"ˆ\f*‡" [gud-sdb-needs-tags find-tag-noselect f find-file-noselect buf gud-make-debug-menu local-set-key [menu-bar debug tbreak] ("Temporary Breakpoint" . gud-tbreak)] 4]) #@160 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. (defalias 'sdb #[(command-line) "ƒÁÂ!ƒ\n;ƒÃ\n!„ÄÅ!ˆÆÈÉÊ$ˆËÌMˆÍÎ ÏË#ˆÐÒPË\"ˆÓÔMˆÍÎ ÕÓ#ˆÐÖPÓ\"ˆ×ØMˆÍÎ Ù×#ˆÐÚP×\"ˆÛÜMˆÍÎ ÝÛ#ˆÐÞPÛ\"ˆßàMˆÍÎ áß#ˆÐâPß\"ˆãäMˆÍÎ åã#ˆÐæPã\"ˆçèMˆÍÎ éç#ˆÐêPç\"ˆëìMˆÍÎ íë#ˆÐîPë\"ˆï0ï1òóô\"ˆõö!‡" [gud-sdb-needs-tags boundp tags-file-name file-exists-p error "The sdb support requires a valid tags table to work." gud-common-init command-line gud-sdb-massage-args gud-sdb-marker-filter gud-sdb-find-file gud-break #[(arg) "ÀÁ\n\"‡" [gud-call "%l b" arg] 3 "Set breakpoint at current line." "p"] define-key current-local-map "" global-set-key gud-key-prefix "" gud-tbreak #[(arg) "ÀÁ\n\"‡" [gud-call "%l c" arg] 3 "Set temporary breakpoint at current line." "p"] "" "" gud-remove #[(arg) "ÀÁ\n\"‡" [gud-call "%l d" arg] 3 "Remove breakpoint at current line" "p"] "" "" gud-step #[(arg) "ÀÁ\n\"‡" [gud-call "s %p" arg] 3 "Step one source line with display." "p"] "" "" gud-stepi #[(arg) "ÀÁ\n\"‡" [gud-call "i %p" arg] 3 "Step one instruction with display." "p"] " " " " gud-next #[(arg) "ÀÁ\n\"‡" [gud-call "S %p" arg] 3 "Step one line (skip functions)." "p"] "" "" gud-cont #[(arg) "ÀÁ\n\"‡" [gud-call "c" arg] 3 "Continue with display." "p"] "" "" gud-print #[(arg) "ÀÁ\n\"‡" [gud-call "%e/" arg] 3 "Evaluate C expression at point." "p"] "" "" "\\(^\\|\n\\)\\*" comint-prompt-regexp paragraph-start local-set-key [menu-bar debug tbreak] ("Temporary Breakpoint" . gud-tbreak) run-hooks sdb-mode-hook] 5 (#$ . 9455) (list (read-from-minibuffer "Run sdb (like this): " (if (consp gud-sdb-history) (car gud-sdb-history) "sdb ") nil nil (quote (gud-sdb-history . 1))))]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gud-dbx-history nil current-load-list] 2) #@244 *A list of directories that dbx should search for source code. If nil, only source files in the program directory will be known to dbx. The file names should be absolute, or relative to the directory containing the executable being debugged. (defvar gud-dbx-directories nil (#$ . -11337)) (defalias 'gud-dbx-massage-args #[(file args) "Á‰ƒ @Ä\nBB A‰„\nŸ* ¤‡" [gud-dbx-directories nil result directories "-I" args] 4]) #@67 Transform a relative file name to an absolute file name, for dbx. (defalias 'gud-dbx-file-name #[(f) "À !ƒÄ !‚8 ‰ƒ7@Ç QÂ!ƒ-Ä!À)A‰„) )‡" [nil result file-exists-p f expand-file-name gud-dbx-directories directories "/" path] 4 (#$ . 11771)]) (defalias 'gud-dbx-marker-filter #[(string) "ƒ\n P‚ ÂÄÅ #„ÄÆ #ƒ5ǔǕOÈɔɕO!B\nË•‚ÄÌ #ƒCË•‚5ÄÍ #…PË”ÂO) ‡" [gud-marker-acc string nil start string-match "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" 2 string-to-int 1 gud-last-frame 0 "\n" "\\(stopped\\|signal\\)"] 5]) #@69 Non-nil to assume the MIPS/OSF dbx conventions (argument `-emacs'). (defvar gud-mips-p (byte-code "ÀÁ\n\"†ÀÃ\n\"†ÀÄ\n\"†ÀÅ\n\"‡" [string-match "^mips-[^-]*-ultrix" system-configuration "^mips-[^-]*-riscos" "^mips-[^-]*-osf1" "^alpha-[^-]*-osf"] 3) (#$ . 12419)) (defalias 'gud-mipsdbx-massage-args #[(file args) "À B‡" ["-emacs" args] 2]) (defalias 'gud-mipsdbx-marker-filter #[(string) " PÂÄÅ\"ƒ/ƔƕOÇȔȕO!B ʉ”OPÊ•ËO‚ÄÌ\"ƒG ʉ”OPÊ”ËO‚M P )‡" [gud-marker-acc string "" output string-match "[][ 0-9]*\\([^:\n]*\\):\\([0-9]*\\):.*\n" 1 string-to-int 2 gud-last-frame 0 nil "[][ 0-9]*.*\\'"] 5]) #@90 Non-nil to assume the interface appropriate for IRIX dbx. This works in IRIX 4, 5 and 6. (defvar gud-irix-p (string-match "^mips-[^-]*-irix" system-configuration) (#$ . 13056)) (defalias 'gud-irixdbx-marker-filter #[(string) "À‰Ã\f \"„ÃÆ \"ƒ PÈ‚# P\nƒ”ÃÉ\n\"ƒ9ÊË\f!Í\"ˆ‚”ÃÎ\n\"ƒd\nϔϕOÑ!ƒ`\nϔϕOÒ\nÓ”Ó•O!B)‚”ÃÕ\n\"ƒ”Ö\nÓ”Ó•O!‰ƒÑ!ƒÒ\nϔϕO!B)\n׉”O\n†™È*‡" [nil case-fold-search result string-match comint-prompt-regexp string ".*\n" gud-marker-acc "" "^\\(\\[[0-9]+] \\)?Process +[0-9]+ ([^)]*) [^[]+\\[[^]\n]*]\n" process-send-string get-buffer-process gud-comint-buffer "printf \"%1d:\",(long)$curline;file\n" "^[^ ][^[]*\\[\"\\([^\"]+\\)\":\\([0-9]+\\), [^]]+]\n" 1 file file-exists-p string-to-int 2 gud-last-frame "\\([0-9]*\\):\\(.*\\)\n" gud-dbx-file-name 0] 6]) (defalias 'gud-dbx-find-file #[(f) "ŠÀ !‰…à !‰qˆÅ ˆÆÇÈ\"ˆÆÉÊ\"ˆ\f)*‡" [gud-dbx-file-name f realf find-file-noselect buf gud-make-debug-menu local-set-key [menu-bar debug up] ("Up Stack" . gud-up) [menu-bar debug down] ("Down Stack" . gud-down)] 4]) #@160 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. (defalias 'dbx #[(command-line) "ƒÁ\nÃÄÅ$ˆ‚$ƒÁ\nÇÈÅ$ˆ‚$Á\nÇÉÅ$ˆƒwÊËMˆÌÍ ÎÊ#ˆÏÑPÊ\"ˆÒÓMˆÌÍ ÔÒ#ˆÏÕPÒ\"ˆÖ×MˆÌÍ ØÖ#ˆÏÙPÖ\"ˆÚÛMˆÌÍ ÜÚ#ˆÏÝPÚ\"ˆ‚\fƒÓÖÞMˆÌÍ ØÖ#ˆÏÙPÖ\"ˆÚßMˆÌÍ ÜÚ#ˆÏÝPÚ\"ˆÊàMˆÌÍ ÎÊ#ˆÏÑPÊ\"ˆÒáMˆÌÍ ÔÒ#ˆÏÕPÒ\"ˆâã$!å\"ˆ‚\fÊæMˆÌÍ ÎÊ#ˆÏÑPÊ\"ˆÒçMˆÌÍ ÔÒ#ˆÏÕPÒ\"ˆÖèMˆÌÍ ØÖ#ˆÏÙPÖ\"ˆéêMˆÌÍ ëé#ˆÏìPé\"ˆíîMˆÌÍ ïí#ˆÏðPí\"ˆñòMˆÌÍ óñ#ˆÏôPñ\"ˆõöMˆÌÍ ÷õ#ˆÏøPõ\"ˆùúMˆÌÍ ûù#ˆÏüPù\"ˆýþMˆÌÍ ÿý#ˆÏ@Pý\"ˆABACDEF\"ˆDGH\"ˆIJ!‡" [gud-mips-p gud-common-init command-line gud-mipsdbx-massage-args gud-mipsdbx-marker-filter gud-dbx-find-file gud-irix-p gud-dbx-massage-args gud-irixdbx-marker-filter gud-dbx-marker-filter gud-up #[(arg) "ÀÁ\n\"‡" [gud-call "up %p" arg] 3 "Up (numeric arg) stack frames." "p"] define-key current-local-map "<" global-set-key gud-key-prefix "<" gud-down #[(arg) "ÀÁ\n\"‡" [gud-call "down %p" arg] 3 "Down (numeric arg) stack frames." "p"] ">" ">" gud-break #[(arg) "ÀÁ\n\"‡" [gud-call "stop at \"%f\":%l" arg] 3 "Set breakpoint at current line." "p"] "" "" gud-finish #[(arg) "ÀÁ\n\"‡" [gud-call "return" arg] 3 "Finish executing current function." "p"] "" "" #[(arg) "ÀÁ\n\"‡" [gud-call "stop at \"%d%f\":%l" arg] 3 "Set breakpoint at current line." "p"] #[(arg) "ÀÁ\n\"‡" [gud-call "return" arg] 3 "Finish executing current function." "p"] #[(arg) "ÀÁ\n\"‡" [gud-call "up %p; printf \"%1ld:\",(long)$curline;file\n" arg] 3 "Up (numeric arg) stack frames." "p"] #[(arg) "ÀÁ\n\"‡" [gud-call "down %p; printf \"%1ld:\",(long)$curline;file\n" arg] 3 "Down (numeric arg) stack frames." "p"] process-send-string get-buffer-process gud-comint-buffer "printf \"%1d:\",(long)$curline;file\n" #[(arg) "ÀÁ\n\"‡" [gud-call "up %p" arg] 3 "Up (numeric arg) stack frames." "p"] #[(arg) "ÀÁ\n\"‡" [gud-call "down %p" arg] 3 "Down (numeric arg) stack frames." "p"] #[(arg) "ÀÁ\n\"‡" [gud-call "file \"%d%f\"\nstop at %l" arg] 3 "Set breakpoint at current line." "p"] gud-remove #[(arg) "ÀÁ\n\"‡" [gud-call "clear %l" arg] 3 "Remove breakpoint at current line" "p"] "" "" gud-step #[(arg) "ÀÁ\n\"‡" [gud-call "step %p" arg] 3 "Step one line with display." "p"] "" "" gud-stepi #[(arg) "ÀÁ\n\"‡" [gud-call "stepi %p" arg] 3 "Step one instruction with display." "p"] " " " " gud-next #[(arg) "ÀÁ\n\"‡" [gud-call "next %p" arg] 3 "Step one line (skip functions)." "p"] "" "" gud-cont #[(arg) "ÀÁ\n\"‡" [gud-call "cont" arg] 3 "Continue with display." "p"] "" "" gud-print #[(arg) "ÀÁ\n\"‡" [gud-call "print %e" arg] 3 "Evaluate C expression at point." "p"] "" "" "^[^)\n]*dbx) *" comint-prompt-regexp paragraph-start local-set-key [menu-bar debug up] ("Up Stack" . gud-up) [menu-bar debug down] ("Down Stack" . gud-down) run-hooks dbx-mode-hook] 5 (#$ . 14136) (list (read-from-minibuffer "Run dbx (like this): " (if (consp gud-dbx-history) (car gud-dbx-history) "dbx ") nil nil (quote (gud-dbx-history . 1))))]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gud-xdb-history nil current-load-list] 2) #@244 *A list of directories that xdb should search for source code. If nil, only source files in the program directory will be known to xdb. The file names should be absolute, or relative to the directory containing the executable being debugged. (defvar gud-xdb-directories nil (#$ . -17289)) (defalias 'gud-xdb-massage-args #[(file args) "Á‰ƒ @Ä\nBB A‰„\nŸ* ¤‡" [gud-xdb-directories nil result directories "-d" args] 4]) #@62 Transform a relative pathname to a full pathname in xdb mode (defalias 'gud-xdb-file-name #[(f) "À !ƒÄ !‚8 ‰ƒ7@Ç QÂ!ƒ-Ä!À)A‰„) )‡" [nil result file-exists-p f expand-file-name gud-xdb-directories directories "/" path] 4 (#$ . 17723)]) (defalias 'gud-xdb-marker-filter #[(string) "À \f\"„ÂÅ\f\"ƒ\fPÇ‚!\fP ƒTÂÈ \"„3ÂÉ \"ƒTÊ Ë”Ë•O!Ì Í”Í•O!ƒSB* †YÇ)‡" [nil result string-match comint-prompt-regexp string ".*\n" gud-marker-acc "" "\\([^\n :]+\\): [^:]+: \\([0-9]+\\)[: ]" "[^: ]+:[ ]+\\([^:]+\\): [^:]+: \\([0-9]+\\):" string-to-int 2 gud-xdb-file-name 1 file line gud-last-frame] 5]) (defalias 'gud-xdb-find-file #[(f) "ŠÀ !‰…)Ã\n!‰qˆÅ ˆÆÇÈ\"ˆÆÉÊ\"ˆÆËÌ\"ˆÆÍÎ\"ˆ\f)*‡" [gud-xdb-file-name f realf find-file-noselect buf gud-make-debug-menu local-set-key [menu-bar debug tbreak] ("Temporary Breakpoint" . gud-tbreak) [menu-bar debug finish] ("Finish Function" . gud-finish) [menu-bar debug up] ("Up Stack" . gud-up) [menu-bar debug down] ("Down Stack" . gud-down)] 4]) #@311 Run xdb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger. You can set the variable 'gud-xdb-directories' to a list of program source directories if your program contains sources from more than one directory. (defalias 'xdb #[(command-line) "À ÂÃÄ$ˆÅÆMˆÇÈ ÉÅ#ˆÊ ÌPÅ\"ˆÍÎMˆÇÈ ÏÍ#ˆÊ ÐPÍ\"ˆÑÒMˆÇÈ ÓÑ#ˆÊ ÔPÑ\"ˆÕÖMˆÇÈ ×Õ#ˆÊ ØPÕ\"ˆÙÚMˆÇÈ ÛÙ#ˆÊ ÜPÙ\"ˆÝÞMˆÇÈ ßÝ#ˆÊ àPÝ\"ˆáâMˆÇÈ ãá#ˆÊ äPá\"ˆåæMˆÇÈ çå#ˆÊ èPå\"ˆéêMˆÇÈ ëé#ˆÊ ìPé\"ˆíîMˆÇÈ ïí#ˆÊ ðPí\"ˆñ2ñ3ôõö\"ˆô÷ø\"ˆôùú\"ˆôûü\"ˆýþ!‡" [gud-common-init command-line gud-xdb-massage-args gud-xdb-marker-filter gud-xdb-find-file gud-break #[(arg) "ÀÁ\n\"‡" [gud-call "b %f:%l" arg] 3 "Set breakpoint at current line." "p"] define-key current-local-map "" global-set-key gud-key-prefix "" gud-tbreak #[(arg) "ÀÁ\n\"‡" [gud-call "b %f:%l\\t" arg] 3 "Set temporary breakpoint at current line." "p"] "" "" gud-remove #[(arg) "ÀÁ\n\"‡" [gud-call "db" arg] 3 "Remove breakpoint at current line" "p"] "" "" gud-step #[(arg) "ÀÁ\n\"‡" [gud-call "s %p" arg] 3 "Step one line with display." "p"] "" "" gud-next #[(arg) "ÀÁ\n\"‡" [gud-call "S %p" arg] 3 "Step one line (skip functions)." "p"] "" "" gud-cont #[(arg) "ÀÁ\n\"‡" [gud-call "c" arg] 3 "Continue with display." "p"] "" "" gud-up #[(arg) "ÀÁ\n\"‡" [gud-call "up %p" arg] 3 "Up (numeric arg) stack frames." "p"] "<" "<" gud-down #[(arg) "ÀÁ\n\"‡" [gud-call "down %p" arg] 3 "Down (numeric arg) stack frames." "p"] ">" ">" gud-finish #[(arg) "ÀÁ\n\"‡" [gud-call "bu\\t" arg] 3 "Finish executing current function." "p"] "" "" gud-print #[(arg) "ÀÁ\n\"‡" [gud-call "p %e" arg] 3 "Evaluate C expression at point." "p"] "" "" "^>" comint-prompt-regexp paragraph-start local-set-key [menu-bar debug tbreak] ("Temporary Breakpoint" . gud-tbreak) [menu-bar debug finish] ("Finish Function" . gud-finish) [menu-bar debug up] ("Up Stack" . gud-up) [menu-bar debug down] ("Down Stack" . gud-down) run-hooks xdb-mode-hook] 5 (#$ . 18759) (list (read-from-minibuffer "Run xdb (like this): " (if (consp gud-xdb-history) (car gud-xdb-history) "xdb ") nil nil (quote (gud-xdb-history . 1))))]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gud-perldb-history nil current-load-list] 2) (defalias 'gud-perldb-massage-args #[(file args) "À @ ABBB‡" ["-d" args "-emacs"] 4]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp gud-perldb-marker-acc "" current-load-list] 2) (defalias 'gud-perldb-marker-filter #[(string) " PÂÄÅ\"ƒ/ƔƕOÇȔȕO!B ʉ”OPÊ•ËO‚ÄÌ\"ƒG ʉ”OPÊ”ËO‚M P )‡" [gud-marker-acc string "" output string-match "\\([^:\n]*\\):\\([0-9]*\\):.*\n" 1 string-to-int 2 gud-last-frame 0 nil ".*\\'"] 5]) (defalias 'gud-perldb-find-file #[(f) "ŠÀ !‰qˆÃ ˆ\n*‡" [find-file-noselect f buf gud-make-debug-menu] 3]) #@163 Run perldb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger. (defalias 'perldb #[(command-line) "À ÂÃÄ$ˆÅÆMˆÇÈ ÉÅ#ˆÊ ÌPÅ\"ˆÍÎMˆÇÈ ÏÍ#ˆÊ ÐPÍ\"ˆÑÒMˆÇÈ ÓÑ#ˆÊ ÔPÑ\"ˆÕÖMˆÇÈ ×Õ#ˆÊ ØPÕ\"ˆÙÚMˆÇÈ ÛÙ#ˆÊ ÜPÙ\"ˆÝÞMˆÇÈ ßÝ#ˆÊ àPÝ\"ˆá\"á#äå!‡" [gud-common-init command-line gud-perldb-massage-args gud-perldb-marker-filter gud-perldb-find-file gud-break #[(arg) "ÀÁ\n\"‡" [gud-call "b %l" arg] 3 "Set breakpoint at current line." "p"] define-key current-local-map "" global-set-key gud-key-prefix "" gud-remove #[(arg) "ÀÁ\n\"‡" [gud-call "d %l" arg] 3 "Remove breakpoint at current line" "p"] "" "" gud-step #[(arg) "ÀÁ\n\"‡" [gud-call "s" arg] 3 "Step one source line with display." "p"] "" "" gud-next #[(arg) "ÀÁ\n\"‡" [gud-call "n" arg] 3 "Step one line (skip functions)." "p"] "" "" gud-cont #[(arg) "ÀÁ\n\"‡" [gud-call "c" arg] 3 "Continue with display." "p"] "" "" gud-print #[(arg) "ÀÁ\n\"‡" [gud-call "%e" arg] 3 "Evaluate perl expression at point." "p"] "" "" "^ DB<[0-9]+> " comint-prompt-regexp paragraph-start run-hooks perldb-mode-hook] 5 (#$ . 21591) (list (read-from-minibuffer "Run perldb (like this): " (if (consp gud-perldb-history) (car gud-perldb-history) "perl ") nil nil (quote (gud-perldb-history . 1))))]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp gud-delete-prompt-marker nil current-load-list] 2) #@2157 Major mode for interacting with an inferior debugger process. You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx, or M-x xdb. Each entry point finishes by executing a hook; `gdb-mode-hook', `sdb-mode-hook', `dbx-mode-hook' or `xdb-mode-hook' respectively. After startup, the following commands are available in both the GUD interaction buffer and any source buffer GUD visits due to a breakpoint stop or step operation: \[gud-break] sets a breakpoint at the current file and line. In the GUD buffer, the current file and line are those of the last breakpoint or step. In a source buffer, they are the buffer's file and current line. \[gud-remove] removes breakpoints on the current file and line. \[gud-refresh] displays in the source window the last line referred to in the gud buffer. \[gud-step], \[gud-next], and \[gud-stepi] do a step-one-line, step-one-line (not entering function calls), and step-one-instruction and then update the source window with the current file and position. \[gud-cont] continues execution. \[gud-print] tries to find the largest C lvalue or function-call expression around point, and sends it to the debugger for value display. The above commands are common to all supported debuggers except xdb which does not support stepping instructions. Under gdb, sdb and xdb, \[gud-tbreak] behaves exactly like \[gud-break], except that the breakpoint is temporary; that is, it is removed when execution stops on it. Under gdb, dbx, and xdb, \[gud-up] pops up through an enclosing stack frame. \[gud-down] drops back down through one. If you are using gdb or xdb, \[gud-finish] runs execution to the return from the current function and stops. All the keystrokes above are accessible in the GUD buffer with the prefix C-c, and in all buffers through the prefix C-x C-a. All pre-defined functions for which the concept make sense repeat themselves the appropriate number of times if you give a prefix argument. You may use the `gud-def' macro in the initialization hook to define other commands. Other commands for interacting with the debugger process are inherited from comint mode, which see. (defalias 'gud-mode #[nil "À ˆÁÃÅÇ!ˆÉ ˆÊË ÌÍ#ˆÎÏ!ˆÐÎÑ!ˆÎÒ!ˆÎÓ!ˆÔ ÕÖ!‡" [comint-mode gud-mode major-mode "Debugger" mode-name (":%s") mode-line-process use-local-map comint-mode-map gud-make-debug-menu define-key current-local-map "\f" gud-refresh make-local-variable gud-last-frame nil comint-prompt-regexp paragraph-start gud-delete-prompt-marker make-marker run-hooks gud-mode-hook] 4 (#$ . 23031) nil]) (defalias 'gud-chop-words #[(string) "À‰ G‰\fWƒK HÇ>ƒB O BT‰\fWƒ: HÈ>ƒ: T‰‚& T‰‚ T‰‚ \fWƒX ÂO B Ÿ,‡" [0 string nil words len beg i (9 32) (9 32)] 5]) (defalias 'gud-common-init #[(command-line massage-args marker-filter find-file) "À !‰@\nA‰ƒ\f@ÅHÆUƒ\fA‰„\f…(\f@\fÇ ˆ)‰…3É!\n\nA …NÌ\n!ƒLÍ\n!‚N\n…[ÏÐ!PÒÓÔQ!ˆƒwÌ!ƒwÌ!n„~Ö ˆ×رˆ ‰ƒš\f@Ç=„š\fA‰„Œ\fƒ£\f ˆ)ÙÚÛP Ü \"%ˆ.Þ ˆßà!ˆ! ßâ!ˆ#\"äåp!æ\"ˆçåp!è\"ˆé ‡" [gud-chop-words command-line words program w 0 45 t file-word substitute-in-file-name file-subst args file-name-directory expand-file-name file "-" file-name-nondirectory filepart switch-to-buffer "*gud" "*" default-directory newline "Current directory is " "\n" apply make-comint "gud" nil massage-args gud-mode make-local-variable gud-marker-filter marker-filter gud-find-file find-file set-process-filter get-buffer-process gud-filter set-process-sentinel gud-sentinel gud-set-buffer] 9]) (defalias 'gud-set-buffer #[nil "Á=… p‰‡" [major-mode gud-mode gud-comint-buffer] 2]) #@110 Non-nil means don't process anything from the debugger right now. It is saved for when this flag is not set. (defvar gud-filter-defer-flag nil (#$ . 26698)) #@75 Non-nil means this is text that has been saved for later in `gud-filter'. (defvar gud-filter-pending-text nil (#$ . 26861)) (defalias 'gud-filter #[(proc string) "À‰ÃÄ !!…„ƒ †È P‰‚„ŠÊƒ3 P ÀÄ !qˆË\f!ƒLÍ !\f|ˆ\fÀ‰“ˆÎ !…a`Í !Y…aÐp!) ƒuÑ ÓŽÔ !ˆÕ ˆ*Ö \n\"ˆ…ƒ× È\")*‡" [nil process-window output buffer-name process-buffer proc gud-filter-defer-flag gud-filter-pending-text "" string t marker-buffer gud-delete-prompt-marker process-mark gud-marker-filter gud-last-frame get-buffer-window selected-window save-selected-window-window ((select-window save-selected-window-window)) select-window gud-display-frame comint-output-filter gud-filter] 3]) (defalias 'gud-sentinel #[(proc msg) "ÀÁ\n!!„ÃÅ\nÃ\"‡Æ\n!Ç>…QÃÈÉÆ\n!!P\np ÌŽÁ\n!qˆÍ ˆmƒ?Îбˆ‚MŠdbˆÎбˆ)Ò\n!*‡" [buffer-name process-buffer proc nil overlay-arrow-position set-process-buffer process-status (signal exit) ":" symbol-name mode-line-process obuf ((set-buffer obuf)) force-mode-line-update 10 mode-name " " msg delete-process] 4]) #@143 Find and obey the last filename-and-line marker from the debugger. Obeying it means displaying in another window the specified file and line. (defalias 'gud-display-frame #[nil "…Á ˆÂ@A\"ˆĉ‡" [gud-last-frame gud-set-buffer gud-display-line gud-last-last-frame nil] 3 (#$ . 27913) nil]) (defalias 'gud-display-line #[(true-file line) "À !Å\f!ÇŠ\fqˆŒ~ˆÉ\n!ˆ`Ë\f „)Î   `p“ˆ)eW„>dVƒD~ˆbˆ)Ï \",‡" [t last-nonmenu-event gud-find-file true-file buffer display-buffer window nil pos goto-line line "=>" overlay-arrow-string overlay-arrow-position make-marker set-window-point] 3]) (defalias 'gud-format-command #[(str arg) "p=? † \nÃÉÈÉ\"ƒÉÊË”ÃO!Ã\f‰ Î=ƒAσ9Ð ‚; @!\f‚° Ñ=ƒ[ÒƒSÐ ‚U @!\f‚° Ó=ƒ~ƒwŠÔyˆŒ~ˆÕÖ`\"T*‚y A\f‚° ×=ƒŒØ \f‚° Ù=ƒšÚ \f‚° Û=ƒ°ƒ­Ý!‚®Þ\f\fÖ”Ö•O\fQ*Ë•ÃO‰„\fP+‡" [gud-comint-buffer gud-last-frame gud-last-last-frame nil result frame insource str string-match "\\([^%]*\\)%\\([adeflp]\\)" string-to-char 2 subst key 102 file-name-nondirectory buffer-file-name 100 file-name-directory 108 0 count-lines 1 101 find-c-expr 97 gud-read-address 112 arg int-to-string ""] 5]) #@75 Return a string containing the core-address found in the buffer at point. (defalias 'gud-read-address #[nil "Š`À‰ÄÅ ÆZÇ#…`‰ƒ'Èuˆ\nÉÊ!ˆËuˆ`{‚=ÌÍ!ˆÎuˆ`ÎuˆÉÍ!ˆËuˆ `{,‡" [nil begin found pt search-backward "0x" 7 t 2 re-search-forward "[^0-9a-f]" -1 re-search-backward "[^0-9]" 1] 5 (#$ . 29099)]) (defalias 'gud-call #[(fmt &optional arg) "À \n\"ÄÅ \"ˆÆÇ!ˆÈ !)‡" [gud-format-command fmt arg msg message "Command: %s" sit-for 0 gud-basic-call] 3]) #@64 Invoke the debugger COMMAND displaying source in other window. (defalias 'gud-basic-call #[(command) "À ˆ ÂPÃ\f! „ÆÇ!ˆŠ\fqˆÈ !bˆÉyˆÊ !ƒ,\f`Í“ˆ)Î \"*‡" [gud-set-buffer command "\n" get-buffer-process gud-comint-buffer proc error "Current buffer has no process" process-mark 0 looking-at comint-prompt-regexp gud-delete-prompt-marker nil process-send-string] 3 (#$ . 29559) nil]) #@58 Fix up a possibly garbled display, and redraw the arrow. (defalias 'gud-refresh #[(&optional arg) "À !ˆ\n„\n Ä ‡" [recenter arg gud-last-frame gud-last-last-frame gud-display-frame] 2 (#$ . 29951) "P"]) #@42 Returns the C expr that surrounds point. (defalias 'find-c-expr #[nil "ŠÀ‰‰`Ä Å Æ \n\"ƒ& @\nAB‰@bˆÅ ‚ bˆÇ Æ\n \"ƒ?\n@ ABÇ ‚,\n@\nA{,‡" [nil test-expr expr p expr-cur expr-prev expr-compound expr-next] 4 (#$ . 30162) nil]) #@268 Returns the expr that point is in; point is set to beginning of expr. The expr is represented as a cons cell, where the car specifies the point in the current buffer that marks the beginning of the expr and the cdr specifies the character after the end of the expr. (defalias 'expr-cur #[nil "`À‰Ä ˆ`Å ˆ` Yƒ  bˆÅ ˆ`\nbˆ\n +B‡" [nil end begin p expr-backward-sexp expr-forward-sexp] 3 (#$ . 30407)]) #@49 Version of `backward-sexp' that catches errors. (defalias 'expr-backward-sexp #[nil "ÀÁ‡" [nil (backward-sexp) ((error t))] 3 (#$ . 30823)]) #@48 Version of `forward-sexp' that catches errors. (defalias 'expr-forward-sexp #[nil "ÀÁ‡" [nil (forward-sexp) ((error t))] 3 (#$ . 30972)]) #@264 Returns the previous expr, point is set to beginning of that expr. The expr is represented as a cons cell, where the car specifies the point in the current buffer that marks the beginning of the expr and the cdr specifies the character after the end of the expr (defalias 'expr-prev #[nil "À‰à ˆ`Ä ˆ`\nbˆ\n *B‡" [nil end begin expr-backward-sexp expr-forward-sexp] 2 (#$ . 31119)]) #@266 Returns the following expr, point is set to beginning of that expr. The expr is represented as a cons cell, where the car specifies the point in the current buffer that marks the beginning of the expr and the cdr specifies the character after the end of the expr. (defalias 'expr-next #[nil "À‰à ˆÃ ˆ`Ä ˆ`‰ *B‡" [nil end begin expr-forward-sexp expr-backward-sexp] 3 (#$ . 31513)]) #@93 Returns '.' for '->' & '.', returns ' ' for white space, returns '?' for other punctuation. (defalias 'expr-compound-sep #[(span-start span-end) "ÀÁ\f WƒL\ffz‰ÀU„D\nÆUƒD\ff‰ÆUƒ(Æ‚D\nÇUƒ@\fÈ\\fÉUƒ@Æ\fÈ\\‚D Ê\fÈ\\‰‚ *‡" [32 nil syntax result span-start span-end 46 45 1 62 63] 3 (#$ . 31906)]) #@405 Non-nil if concatenating FIRST and SECOND makes a single C token. The two exprs are represented as a cons cells, where the car specifies the point in the current buffer that marks the beginning of the expr and the cdr specifies the character after the end of the expr. Link exprs of the form: Expr -> Expr Expr . Expr Expr (Expr) Expr [Expr] (Expr) Expr [Expr] Expr (defalias 'expr-compound #[(first second) "A @ÂÆ \f\"@ @Uƒ‚jA AUƒ%‚j ÇUƒ/È‚j ÉUƒi ÊZf\ff ËUƒGÈ‚j ÌUƒQÈ‚j\fÍUƒ[È‚j\fÎUƒeÈ‚j‚jÂ+‡" [first second nil syntax span-end span-start expr-compound-sep 46 t 32 1 41 93 40 91] 3 (#$ . 32225)]) (provide (quote gud)) emacs-19.30/lisp/hanoi.elc100666 13437 1 4761 5747270430 14014 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue Apr 25 18:00:51 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/hanoi.el ;;; emacs version 19.28.90.40. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/hanoi.el' was compiled for Emacs 19")) (defalias 'hanoi-topos #[(row col) "À !ˆÂyˆ u‡" [goto-line row 0 col] 2]) #@58 Towers of Hanoi diversion. Argument is number of rings. (defalias 'hanoi #[(nrings) "ÁXƒ\nÂÃ!ˆÄÄÇÈ !ÉÈ ! Ê Ë¥Ì\" Î\\TYƒ= V„eÑ ˆÇÈ !‰Yƒ]Ê Ë¥Ì\"‰ V„eÂÒ#ˆÓZVƒvÓZ‚x* ZÔZ B Ó_ B Õ_ BÖÄ\"ÁÁWƒÍÜÄ݉Ó\\\\Þ\\\"݉Ó\\\\ß\"#IˆT‰‚¡)àá!ˆÄ\"ãp!ˆä ˆÁ WƒøTåß S\"ˆæcˆ‚ß)åç S\"ˆÔ((ËWƒ@é( _\"ˆ(ê\\( Wƒ<TëÔ!ˆìcˆíÔ!ˆîÔ!ˆ‚)‚)ÁÄ/‰Wƒ…ZÔZH‰/Á ZIˆéA@ZZ\"ˆð/ñÄ#ˆ‰AS¡ˆT‰‚H*ñ\"òÁ!ˆóS$ˆebˆôõ!ˆñ\"ö ˆòÁ!.\n‡" [nrings 0 error "Negative number of rings" nil floor-row fly-row window-height selected-window window-width logand 6 -2 pole-spacing 4 w h delete-other-windows "Screen is too small (need at least %dx%d)" 3 1 5 make-vector rings pole-3 pole-2 pole-1 i vector make-string 48 32 switch-to-buffer "*Hanoi*" buffer-read-only buffer-disable-undo erase-buffer insert-char 10 61 n hanoi-topos 2 next-line 124 delete-char backward-char ring hanoi-draw-ring t sit-for hanoi0 message "Done" force-mode-line-update] 10 (#$ . 553) (list (if (null current-prefix-arg) 3 (prefix-numeric-value current-prefix-arg)))]) (defalias 'hanoi0 #[(n from to work) "À ƒ ÁÂÃC\"‡\fÅW†.Æ\fS $ˆÊ\f #ˆÆ\fS $‡" [input-pending-p signal quit "I can tell you've had enough" n 0 hanoi0 from work to hanoi-move-ring] 5]) (defalias 'hanoi-move-ring #[(n from to) " H‰ÅH@ ZÇZ@ ZÇZA \n \fÍ\f \"ˆ\fVƒNÏ\fÂÐ#ˆÑÇ!ˆÏ\fÐÂ#ˆÒÅ!ˆ\fS‰\f‚+‰AT¡ˆ\n š„¥\n VƒÇˆÓÔ!ˆÅyˆÕ‰±ˆÒÅ!ˆ TT ‚U\n WƒUÅyˆÖÔ!ˆÇˆÕ‰±ˆÒÅ!ˆ SS ‚UÍ\n\"ˆ\f WƒÕÏ\fÂ\fV#ˆ×Ç!ˆÏ\fÐÂ#ˆÒÅ!ˆ\fT‰\f‚®\fÅ Iˆ‰AS¡.‡" [rings n nil buffer-read-only ring 0 from 1 to dst-row dst-col col row hanoi-topos fly-row hanoi-draw-ring t previous-line sit-for delete-backward-char 2 32 delete-char next-line] 6]) (defalias 'hanoi-draw-ring #[(ring f1 f2) "Šƒ ÂH‚ ÃH‰GÆ !ˆ\fcˆ…,È Â\\Ã¥!ˆÆÂ!ˆÉc+‡" [f1 ring 1 2 string len delete-char f2 backward-char 124] 4]) (provide (quote hanoi)) emacs-19.30/lisp/help-macro.elc100666 12120 1 6540 5775440642 14613 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Jul 2 02:50:08 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/help-macro.el ;;; emacs version 19.29.4. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`help-macro.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!‡" [provide help-macro require backquote] 2) #@297 *Non-nil means give more info about Help command in three steps. The three steps are simple prompt, prompt with all options, and window listing and describing the options. A value of nil means skip the middle step, so that \[help-command] \[help-command] gives the window that lists the options. (defvar three-step-help nil (#$ . -544)) #@318 Construct help-menu function name FNAME. When invoked, FNAME shows HELP-LINE and reads a command using HELPED-MAP. If the command is the help character, FNAME displays HELP-TEXT and continues trying to read a command using HELPED-MAP. When FNAME finally does get a command, it executes that command and then returns. (defalias 'make-help-screen '(macro . #[(fname help-line help-text helped-map) "À  ÄÅÆÇDDCÉÊËÌÍ DDDÎBÏÐÑÒEÔBBÕBBEF¯‡" [defun fname nil help-text (interactive) let line-prompt substitute-command-keys help-line (if three-step-help (message line-prompt)) let* help-screen documentation quote ((local-map (make-sparse-keymap)) (minor-mode-map-alist nil) (prev-frame (selected-frame)) config new-frame key char) unwind-protect progn setcdr local-map helped-map ((define-key local-map [t] (quote undefined)) (if three-step-help (progn (setq key (let ((overriding-local-map local-map)) (read-key-sequence nil))) (if (lookup-key function-key-map key) (setq key (lookup-key function-key-map key))) (setq char (aref key 0))) (setq char 63)) (if (or (eq char 63) (eq char help-char) (memq char help-event-list)) (progn (setq config (current-window-configuration)) (switch-to-buffer-other-window "*Help*") (and (fboundp (quote make-frame)) (not (eq (window-frame (selected-window)) prev-frame)) (setq new-frame (window-frame (selected-window)) config nil)) (erase-buffer) (insert help-screen) (help-mode) (goto-char (point-min)) (while (or (memq char (append help-event-list (cons help-char (quote (63 22 32 127 delete backspace -134217610))))) (eq (car-safe char) (quote switch-frame)) (equal key "ö")) (condition-case nil (progn (if (eq (car-safe char) (quote switch-frame)) (handle-switch-frame char)) (if (memq char (quote (22 32))) (scroll-up)) (if (or (memq char (quote (127 -134217610 delete backspace))) (equal key "ö")) (scroll-down))) (error nil)) (let ((cursor-in-echo-area t) (overriding-local-map local-map)) (setq key (read-key-sequence (format "Type one of the options listed%s: " (if (pos-visible-in-window-p (point-max)) "" " or Space to scroll"))) char (aref key 0)))))) (if (listp char) (setq unread-command-events (cons char unread-command-events) config nil) (let ((defn (lookup-key local-map key))) (if defn (progn (if config (progn (set-window-configuration config) (setq config nil))) (if new-frame (progn (iconify-frame new-frame) (setq new-frame nil))) (call-interactively defn)) (ding))))) ((if new-frame (iconify-frame new-frame)) (if config (set-window-configuration config)))] 15 (#$ . 888)])) emacs-19.30/lisp/help.elc100666 12120 1 37533 6045270476 13537 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 19:43:27 1995 ;;; from file /home/fsf/rms/e19/lisp/help.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`help.el' was compiled for Emacs 19.29 or later")) #@47 Keymap for characters following the Help key. (defvar help-map (make-sparse-keymap) (#$ . 468)) #@23 Keymap for help mode. (defvar help-mode-map (make-sparse-keymap) (#$ . 570)) (byte-code "À  !Ä#ˆÀ ÅÄ#ˆÀ ÆÄ#ˆÄMˆÀ !È#ˆÀÉÈ#ˆÀÊÈ#ˆÀËÈ#ˆÀÌÍ#ˆÀÎÏ#ˆÀÐÑ#ˆÀÒÓ#ˆÀÔÕ#ˆÀÖ×#ˆÀØÙ#ˆÀÚÛ#ˆÀÜÝ#ˆÀÞÝ#ˆÀßà#ˆÀáâ#ˆÀãä#ˆÀåæ#ˆÀçè#ˆÀéê#ˆÀëì#ˆÀíì#ˆÀîï#‡" [define-key global-map char-to-string help-char help-command [help] [f1] help-map help-for-help [help] [f1] "?" "" describe-copying "" describe-distribution "" describe-no-warranty "" describe-project "a" command-apropos "b" describe-bindings "c" describe-key-briefly "k" describe-key "d" describe-function "f" "F" view-emacs-FAQ "i" info "" Info-goto-emacs-command-node " " Info-goto-emacs-key-command-node "l" view-lossage "m" describe-mode "" view-emacs-news "n" "p" finder-by-keyword] 4) #@41 Find packages matching a given keyword. (autoload (quote finder-by-keyword) "finder" '(#$ . 1353) t) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#‡" [define-key help-map "s" describe-syntax "t" help-with-tutorial "w" where-is "v" describe-variable "q" help-quit] 4) #@48 Default expressions to highlight in Help mode. (defvar help-font-lock-keywords (byte-code "ÀÁÄ ÅQÆDÇ\n‰ÈRÉÊËFÌ\nÍQÎÊËFE*‡" ["[-+a-zA-Z0-9_*]" "[-+a-zA-Z0-9_:*]" sym-char name-char "\\`\\(" "+\\)\\(:\\)?" (1 (if (match-beginning 2) font-lock-function-name-face font-lock-variable-name-face) nil t) "`\\(" "+\\)'" 1 font-lock-reference-face t "\\<:" "+\\>" 0] 6) (#$ . 1621)) #@120 Major mode for viewing help text. Entry to this mode runs the normal hook `help-mode-hook'. Commands: \{help-mode-map} (defalias 'help-mode #[nil "À ˆÁ\n!ˆÃÅÇÈ!ˆÉÊ ˆËÌ!‡" [kill-all-local-variables use-local-map help-mode-map "Help" mode-name help-mode major-mode make-local-variable font-lock-defaults (help-font-lock-keywords) view-mode run-hooks help-mode-hook] 2 (#$ . 2004) nil]) (defalias 'help-quit #[nil "À‡" [nil] 1 nil nil]) #@43 Select the Emacs learn-by-doing tutorial. (defalias 'help-with-tutorial #[nil "ÀÁ!à ˆÄ\n!ƒÅÄ\n!!‚vÅÆ\n!!ˆ\nÀÈ! Ê ÌÀÍ\"!ˆebˆÏÐ!ˆÑyˆ`ʈ`|ˆÒÓ !Ôe`\"ZÕZ‰×WƒZØ!ˆ‚oØÙ¥!ˆÚÛ±ˆØ‰Ù¥Z!ˆ)ebˆÜÊ!)‡" [expand-file-name "~/TUTORIAL" file delete-other-windows get-file-buffer switch-to-buffer create-file-buffer buffer-file-name "~/" default-directory nil buffer-auto-save-file-name insert-file-contents "TUTORIAL" data-directory search-forward "\n<<" 0 window-height selected-window count-lines 6 n 12 newline 2 "[Middle of page left blank for didactic purposes. " "Text continues below]" set-buffer-modified-p] 5 (#$ . 2449) nil]) #@63 Print the name of the function KEY invokes. KEY is a string. (defalias 'describe-key-briefly #[(key) "‰GSH‰<ƒ @ 9ƒÂà !>ƒÄ ˆ)ŠÃÅH!Ɖ Ê >„B >„BË >ƒsÅH‰\fA@)‰@)ÅH‰\fA@)‰A@:ƒlA@@‚pA@)Í!ƒ„Î!qˆbˆÏ!‰ƒ“¨ƒœÑÒÓ!\"‚¼ÑÍ!ƒ¨Ô‚©ÕÓ!9ƒ·‚»Ö!#-‡" [key type down event-modifiers read-event 0 nil position window modifiers click drag event windowp window-buffer key-binding defn message "%s is undefined" key-description "%s at that spot runs the command %s" "%s runs the command %s" prin1-to-string] 6 (#$ . 3093) "kDescribe key briefly: "]) #@209 Display or return message saying how to restore windows after help command. Computes a message and applies the optional argument FUNCTION to it. If FUNCTION is nil, applies `message' to it, thus printing it. (defalias 'print-help-return-message #[(&optional function) "À !?…ß ! „cÄ ! \"„cÅ ! ƒ] „]@:ƒ@Ê@@\"„Q@;ƒTÊ@\"ƒTË A‰„) +ƒgÅ‚{ÌË!„qÍ‚{ƒzÏ‚{ІƒÓƒÔ!‚Õƒ™Ö‚šÕ ! †²Ä ! \"†²Ë×Ø\">?…Ü !„ÓÄ !\"„ÓË×Ú\">ƒÙÔÜ!‚ÜÔÝ!Q!)‡" [get-buffer-window standard-output buffer-name special-display-buffer-names assoc nil special-display-regexps name tail found string-match t one-window-p "Type \\[switch-to-buffer-other-window] RET to restore the other window." pop-up-windows "Type \\[delete-other-windows] to remove help window." "Type \\[switch-to-buffer] RET to remove help window." first-message function message substitute-command-keys "" " " mapcar #[(elt) ":ƒ@Á !\"‡" [elt string-match buffer-name standard-output] 4] same-window-buffer-names #[(elt) ":ƒ@Á !\"‡" [elt string-match buffer-name standard-output] 4] same-window-regexps "\\[scroll-up] to scroll the help." "\\[scroll-other-window] to scroll the help."] 8 (#$ . 3692)]) #@73 Display documentation of the function invoked by KEY. KEY is a string. (defalias 'describe-key #[(key) "‰GSH‰<ƒ @ 9ƒÂà !>ƒÄ ˆ)ŠÃÅH!Ɖ Ê >„B >„BË >ƒsÅH‰\fA@)‰@)ÅH‰\fA@)‰A@:ƒlA@@‚pA@)Í!ƒ„Î!qˆbˆÏ!‰ƒ“¨ƒœÑÒÓ!\"‚âÔÕÓ!!ˆÍ!ƒ¯ÕÖ!ˆÕ×!ˆØ!ˆÕÙ!ˆÚ!‰ƒÑÜ ˆÕ!ˆ‚ÕÕÝ!ˆ)Šqˆß ˆ)à ‘-‡" [key type down event-modifiers read-event 0 nil position window modifiers click drag event windowp window-buffer key-binding defn message "%s is undefined" key-description "*Help*" princ " at that spot" " runs the command " prin1 ":\n" documentation doc terpri "not documented" standard-output help-mode print-help-return-message] 5 (#$ . 4921) "kDescribe key: "]) #@238 Display documentation of current major mode and minor modes. For this to work correctly for a minor mode, the mode's indicator variable (listed in `minor-mode-alist') must also be a function whose documentation describes the minor mode. (defalias 'describe-mode #[nil "À  ‰ƒr\f@@\f@A@ ž‰ƒjAƒjÈ !ƒj  ÊËÌ !\"ƒAÍÌ !Ή”O! ƒU9ƒUJ‰„FÏÐÑ #!ˆÏÒ !!ˆÏÓ!ˆ)+\fA‰„ *Ï!ˆÏÕ!ˆÏÒ!!ˆŠqˆØ ˆ)Ù ‘‡" ["*Help*" minor-mode-alist buffer-local-variables locals minor-modes minor-mode indicator local-binding fboundp pretty-minor-mode string-match "-mode$" symbol-name capitalize 0 princ format "%s minor mode (indicator%s):\n" documentation "\n\n" mode-name " mode:\n" major-mode standard-output help-mode print-help-return-message] 7 (#$ . 5631) nil]) (byte-code "ÀÁKM‡" [defining-kbd-macro start-kbd-macro] 2) #@64 Display info on how to obtain the latest version of GNU Emacs. (defalias 'describe-distribution #[nil "ÀÁ \"!‡" [find-file-read-only expand-file-name "DISTRIB" data-directory] 4 (#$ . 6464) nil]) #@63 Display info on how you may redistribute copies of GNU Emacs. (defalias 'describe-copying #[nil "ÀÁ \"!ˆeb‡" [find-file-read-only expand-file-name "COPYING" data-directory] 4 (#$ . 6667) nil]) #@34 Display info on the GNU project. (defalias 'describe-project #[nil "ÀÁ \"!ˆeb‡" [find-file-read-only expand-file-name "GNU" data-directory] 4 (#$ . 6867) nil]) #@64 Display info on all the kinds of warranty Emacs does NOT have. (defalias 'describe-no-warranty #[nil "À ˆÁÃÄ!ˆÅÆ!)‡" [describe-copying nil case-fold-search search-forward "NO WARRANTY" recenter 0] 2 (#$ . 7034) nil]) #@164 Describe the bindings of the prefix used to reach this command. The prefix described consists of all but the last event of the key sequence that ran this command. (defalias 'describe-prefix-bindings #[nil "À  ;ƒ à GSO‚<Ä GSÅ\"ÃGWƒ9 HIˆT‰‚*!)‡" [this-command-keys key describe-bindings 0 make-vector nil i prefix] 6 (#$ . 7259) nil]) (byte-code "ÀÀ‡" [describe-prefix-bindings prefix-help-command] 1) #@42 Display info on recent changes to Emacs. (defalias 'view-emacs-news #[nil "ÀÁ \"!‡" [find-file-read-only expand-file-name "NEWS" data-directory] 4 (#$ . 7694) nil]) #@58 Display the Emacs Frequently Asked Questions (FAQ) file. (defalias 'view-emacs-FAQ #[nil "ÀÁ \"!‡" [find-file-read-only expand-file-name "FAQ" data-directory] 4 (#$ . 7866) nil]) #@36 Display last 100 input keystrokes. (defalias 'view-lossage #[nil "ÀÁÂÃÄ Å#!ˆŠqˆebˆÇÈ!ˆm„'ÉÅÊË#ˆÌcˆ‚Í ˆ)Î ‘‡" ["*Help*" princ mapconcat #[(key) "¨„9„<ƒÁ!‡ÂÃ\"‡" [key single-key-description prin1-to-string nil] 3] recent-keys " " standard-output move-to-column 50 search-forward nil t "\n" help-mode print-help-return-message] 6 (#$ . 8052) nil]) (defalias (quote help) (quote help-for-help)) #@1849 You have typed \[help-command], the help character. Type a Help option: (Use SPC or DEL to scroll through this text. Type \\[help-quit] to exit the Help command.) a command-apropos. Give a substring, and see a list of commands (functions interactively callable) that contain that substring. See also the apropos command. b describe-bindings. Display table of all key bindings. c describe-key-briefly. Type a command key sequence; it prints the function name that sequence runs. f describe-function. Type a function name and get documentation of it. C-f Info-goto-emacs-command-node. Type a function name; it takes you to the Info node for that command. F view-emacs-FAQ. Shows emacs frequently asked questions file. i info. The info documentation reader. k describe-key. Type a command key sequence; it displays the full documentation. C-k Info-goto-emacs-key-command-node. Type a command key sequence; it takes you to the Info node for the command bound to that key. l view-lossage. Shows last 100 characters you typed. m describe-mode. Print documentation of current major mode, which describes the commands peculiar to it. n view-emacs-news. Shows emacs news file. p finder-by-keyword. Find packages matching a given topic keyword. s describe-syntax. Display contents of syntax table, plus explanations t help-with-tutorial. Select the Emacs learn-by-doing tutorial. v describe-variable. Type name of a variable; it displays the variable's documentation and value. w where-is. Type command name; it prints which keystrokes invoke that command. C-c print Emacs copying permission (General Public License). C-d print Emacs ordering information. C-n print news of recent Emacs changes. C-p print information about the GNU project. C-w print information on absence of warranty for GNU Emacs. (defalias 'help-for-help #[nil "ÀÁ! ƒ\fÄ\n!ˆÅÆ!È  Ê Ì  ÊÊÊÊÒŽ ¡ˆÔ ÕÖ#ˆ ƒ_ ØÊ!)Ù\"ƒVÙ\"ÛH‚bÜÜ=„q=ƒßÞ ßà!ˆáâ!ƒ’ãä ! =„’ãä !Êå ˆcˆæ ˆebˆçB>„¸¢è=„¸隃ßÊêëˆì -Øîïðd!ƒÑñ‚Òò\"!‰ÛH*‚Ÿ<ƒó3B3ʉ‚#Ù \"‰4ƒ ƒ\fõ!ˆÊƒö!ˆÊ÷4!‚\"ø ).\n‡" [substitute-command-keys "a b c f C-f i k C-k l m n p s t v w C-c C-d C-n C-w, or ? for more help:" line-prompt three-step-help message documentation help-for-help help-screen make-sparse-keymap local-map nil minor-mode-map-alist selected-frame prev-frame config new-frame key char ((byte-code "ƒÁ!ˆ\nƒÃ\n!ˆÁ‡" [new-frame iconify-frame config set-window-configuration] 2)) help-map define-key [t] undefined overriding-local-map read-key-sequence lookup-key function-key-map 0 63 help-char current-window-configuration switch-to-buffer-other-window "*Help*" fboundp make-frame window-frame selected-window erase-buffer help-mode (63 22 32 127 delete -134217610) switch-frame "ö" (byte-code "¢Á=ƒ Â!ˆÃ>ƒÄ ˆÅ>„!Çšƒ$È ˆÁ‡" [char switch-frame handle-switch-frame (22 32) scroll-up (127 -134217610 delete) key "ö" scroll-down] 2) ((error)) t cursor-in-echo-area format "Type one of the options listed%s: " pos-visible-in-window-p "" " or Space to scroll" unread-command-events defn set-window-configuration iconify-frame call-interactively ding] 6 (#$ . 8468) nil]) (defalias 'function-called-at-point #[nil "ÀÁ† ÀÃć" [nil (byte-code "ŠŒe`ÀZ]d}ˆÁÂ!ˆÂuˆÃÅp!‰9…#Æ\f!…#\f+‡" [1000 backward-up-list 1 nil obj read fboundp] 4) ((error)) (byte-code "À ÂŽŠÃ\f!ˆÅÆÇ!!ƒ$gzÈ=„$gzÉ=„$ÊË!ˆÌÍwˆÎp!‰9…;Ð!…;,‡" [syntax-table stab ((set-syntax-table stab)) set-syntax-table emacs-lisp-mode-syntax-table zerop skip-syntax-backward "_w" 119 95 forward-sexp -1 "'" nil read obj fboundp] 4) ((error))] 3]) (defalias 'describe-function-find-file #[(function) "Á‰‰ƒ \f@A>ƒ\f@@Á\fA‰„\n +‡" [load-history nil functions file files function] 4]) #@56 Display the full documentation of FUNCTION (a symbol). (defalias 'describe-function #[(function) "ÀÁ\n!ˆÃÄ!ˆ\nKÆÈ !ƒÉ‚Ê à ;„)Ì !ƒ-Í‚ Î !ƒ: ÏP‚ Ð !ƒG ÑP‚  9ƒSÒÓ \"‚  ¢Ô=ƒa ÕP‚  ¢Ö=ƒlׂ  ¢Ø=ƒwÙ‚  ¢Ú=ƒŸ A@ÒÛÈ !ƒÜ‚ÝÞ 8ƒšß‚›à#‚ á!ˆ„¬â\n!ƒ¾Ãã!ˆÃ!ˆÃä!ˆÃå!ˆæ ˆÐ !ƒÓç Æ\"@‚á ¢Ô=ƒà A@‚áè‰)<ƒõÃ\nêë)\"B!ˆæ ˆ)ì\n!‰-ƒ\næ ˆÃ-!ˆ‚Ãî!ˆ,ï ˆŠ0qˆñ ˆò )‘‡" ["*Help*" prin1 function princ ": " def nil file-name commandp "an interactive " "a " beg vectorp "a keyboard macro" subrp "built-in function" byte-code-function-p "compiled Lisp function" format "alias for `%s'" lambda "Lisp function" macro "a Lisp macro" mocklisp "a mocklisp function" autoload "%s autoloaded Lisp %s" "an interactive" "an" 4 "macro" "function" "" describe-function-find-file " in `" "'" "." terpri append t arglist mapcar #[(arg) "Á>ƒ‡ÂÃ!–!‡" [arg (&optional &rest) intern symbol-name] 3] documentation doc "not documented" print-help-return-message standard-output help-mode buffer-string] 8 (#$ . 12323) (byte-code "À ÁÂÆ ƒÇÈ \"‚É\nËÁ$‰Ìšƒ$ ‚'Í !+C‡" [function-called-at-point t nil val enable-recursive-minibuffers fn completing-read format "Describe function (default %s): " "Describe function: " obarray fboundp "" intern] 6)]) (defalias 'variable-at-point #[nil "ÀÁ‡" [nil (byte-code "À ÂŽŠÃ\f!ˆÅÆÇ!!ƒ$gzÈ=„$gzÉ=„$ÊË!ˆÌÍwˆÎp!‰9…;Ð!…;,‡" [syntax-table stab ((set-syntax-table stab)) set-syntax-table emacs-lisp-mode-syntax-table zerop skip-syntax-backward "_w" 119 95 forward-sexp -1 "'" nil read obj boundp] 4) ((error))] 3]) #@101 Display the full documentation of VARIABLE (a symbol). Returns the documentation as a string, also. (defalias 'describe-variable #[(variable) "ÀÁ\n!ˆÃ\n!„ÄÅ!ˆ‚ÄÆ!ˆÁ\nJ!ˆÇ ˆÈ\n!ƒGÄÉÊË \"!ˆÌ\n!„:ÄÍ!ˆ‚DÄÎ!ˆÁÏ\n!!ˆÇ ˆÇ ˆÄÐ!ˆÇ ˆÑ\nÒ\"Ć^Ô!ˆ)Õ ˆŠqˆ× ˆØ )‘‡" ["*Help*" prin1 variable boundp princ " is void" "'s value is " terpri local-variable-p format "Local in buffer %s; " buffer-name default-boundp "globally void" "global value is " default-value "Documentation:" documentation-property variable-documentation doc "not documented as a variable." print-help-return-message standard-output help-mode buffer-string] 5 (#$ . 13908) (byte-code "À ÁÂÆ ƒÇÈ \"‚É\nËÁ$‰Ìšƒ$ ‚'Í !+C‡" [variable-at-point t nil val enable-recursive-minibuffers v completing-read format "Describe variable (default %s): " "Describe variable: " obarray boundp "" intern] 6)]) #@147 Print message listing key sequences that invoke specified command. Argument is a command definition, usually a symbol with a function definition. (defalias 'where-is #[(definition) "À \nÉ$ÅÆ\fÇ#‰GÉVƒÊË #ˆ‚$ÊÌ \"ˆ*Ç" [where-is-internal definition overriding-local-map nil keys mapconcat key-description ", " keys1 0 message "%s is on %s" "%s is not on any key"] 6 (#$ . 14786) (byte-code "À ÁÂÆ ƒÇÈ \"‚É\nËÁ$‰Ìšƒ$ ‚'Í !+C‡" [function-called-at-point t nil val enable-recursive-minibuffers fn completing-read format "Where is command (default %s): " "Where is command: " obarray fboundp "" intern] 6)]) #@354 Show the full path name of Emacs library LIBRARY. This command searches the directories in `load-path' like `M-x load-library' to find the file that `M-x load-library RET LIBRARY RET' would load. Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el' to the specified name LIBRARY (a la calling `load' instead of `load-library'). (defalias 'locate-library #[(library &optional nosuffix) "ÀÁ‡" [answer (byte-code "ÀÁ\n\"ˆÃÄ \"ˆÆ‡" [mapcar #[(dir) "ÀÁ\nƒ\n Ä\"‡" [mapcar #[(suf) "À \nP \"Å\f!…Æ\f!?…ÇÈ\f\"ˆÉÊ\f\")‡" [expand-file-name library suf dir try file-readable-p file-directory-p message "Library is file %s" throw answer] 3] nosuffix ("") (".elc" ".el" "")] 3] load-path message "No library %s in search path" library nil] 3)] 2 (#$ . 15415) "sLocate library: "]) emacs-19.30/lisp/helper.elc100666 13437 1 6134 5754705235 14175 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri May 12 12:19:35 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/helper.el ;;; emacs version 19.28.91.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/helper.el' was compiled for Emacs 19")) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B\f„JÅ Æ\fÇÈ#ˆÆ\fÉÊ#ˆÆ\fËÌ#ˆÆ\fÍÎ#ˆÆ\fÏÐ#ˆÆ\fÑ!Ð#ˆÄ\fMˆÂ‡" [boundp Helper-return-blurb nil current-load-list Helper-help-map make-keymap define-key "m" Helper-describe-mode "b" Helper-describe-bindings "c" Helper-describe-key-briefly "k" Helper-describe-key "?" Helper-help-options char-to-string help-char] 4) (defalias 'Helper-help-scroller #[nil "ÀÁ!ƒ\n † ÂÄ‹)‡" [boundp Helper-return-blurb "return" blurb ((byte-code "ÀÁ !bˆÂÃ!ƒÄÃ!ˆ‚ÅÃ!ˆebˆÆÇ  …‹Êd!ƒ/Ë‚0ÌÍ_Êe!ƒ<Ë‚=Ì\\ÎÏ8\"ˆÑ ‰ Ò>ƒ`ÍWƒ`Ó ˆ‚  ÔUƒmÕ ˆ‚  ÖUƒƒͦÌUƒƒ× ˆ‚ lj „%Ç*‡" [window-start selected-window get-buffer-window "*Help*" pop-to-buffer switch-to-buffer t nil state continue pos-visible-in-window-p 1 0 2 message ("Space forward, Delete back. Other keys %s" "Space scrolls forward. Other keys %s" "Delete scrolls back. Other keys %s" "Type anything to %s") blurb read-char (32 22) scroll-up 12 recenter 127 scroll-down] 4))] 2]) #@24 Describe help options. (defalias 'Helper-help-options #[nil "ÀÁ!ˆÂÃ!‡" [message "c (key briefly), m (mode), k (key), b (bindings)" sit-for 4] 2 (#$ . 1458) nil]) #@34 Briefly describe binding of KEY. (defalias 'Helper-describe-key-briefly #[(key) "À !ˆÂÃ!‡" [describe-key-briefly key sit-for 4] 2 (#$ . 1626) "kDescribe key briefly: "]) #@26 Describe binding of KEY. (defalias 'Helper-describe-key #[(key) "À‹ˆÁ ‡" [((describe-key key)) Helper-help-scroller] 1 (#$ . 1802) "kDescribe key: "]) #@48 Describe a function. Name read interactively. (defalias 'Helper-describe-function #[nil "À‹ˆÁ ‡" [((byte-code "ÀÁ!‡" [call-interactively describe-function] 2)) Helper-help-scroller] 1 (#$ . 1959) nil]) #@48 Describe a variable. Name read interactively. (defalias 'Helper-describe-variable #[nil "À‹ˆÁ ‡" [((byte-code "ÀÁ!‡" [call-interactively describe-variable] 2)) Helper-help-scroller] 1 (#$ . 2168) nil]) #@28 Describe the current mode. (defalias 'Helper-describe-mode #[nil "Á\n!ŠÄÅ!qˆÆ ˆ Ç ±ˆÈ ˆ+É ‡" [mode-name documentation major-mode name get-buffer-create "*Help*" erase-buffer " Mode\n" help-mode Helper-help-scroller] 3 (#$ . 2377) nil]) #@46 Describe local key bindings of current mode. (defalias 'Helper-describe-bindings #[nil "ÀÁ!ˆÂ‹ˆÃ ‡" [message "Making binding list..." ((describe-bindings)) Helper-help-scroller] 2 (#$ . 2623) nil]) #@32 Provide help for current mode. (defalias 'Helper-help #[nil "ÀÁ …<ÄÅ!ˆÆÁ!Ç\n\"‰É=ƒ\"É ˆ‚Ê\n!ƒ2Ë\n!ˆÁ‰‚Ì ˆÁ‰„Á*‡" [t nil c continue message "Help (Type ? for further options)" read-key-sequence lookup-key Helper-help-map Helper-help-options commandp call-interactively ding] 4 (#$ . 2827) nil]) (provide (quote helper)) emacs-19.30/lisp/hexl.elc100666 13437 1 43254 6054022070 13661 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 20 01:45:55 1995 ;;; from file /home/fsf/rms/e19/lisp/hexl.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`hexl.el' was compiled for Emacs 19.29 or later")) #@157 The program that will hexlify and de-hexlify its stdin. `hexl-program' will always be concatenated with `hexl-options' and "-de" when dehexlfying a buffer. (defvar hexl-program "hexl" (#$ . 467)) #@98 If your emacs can handle ISO characters, this should be set to "-iso" otherwise it should be "". (defvar hexl-iso "" (#$ . 669)) #@47 Options to hexl-program that suit your needs. (defvar hexl-options (format "-hex %s" hexl-iso) (#$ . 804)) #@41 The command to use to hexlify a buffer. (defvar hexlify-command (format "%s%s %s" exec-directory hexl-program hexl-options) (#$ . 917)) #@43 The command to use to unhexlify a buffer. (defvar dehexlify-command (format "%s%s -de %s" exec-directory hexl-program hexl-options) (#$ . 1059)) #@34 Maximum offset into hexl buffer. (defvar hexl-max-address 0 (#$ . 1210)) (byte-code "ÀÁ!„ÂÁ BÄ BÅ BÆ B‡" [boundp hexl-mode-map nil current-load-list hexl-mode-old-local-map hexl-mode-old-mode-name hexl-mode-old-major-mode] 2) #@3278 \ A major mode for editing binary files in hex dump format. This function automatically converts a buffer into the hexl format using the function `hexlify-buffer'. Each line in the buffer has an "address" (displayed in hexadecimal) representing the offset into the file that the characters on this line are at and 16 characters from the file (displayed as hexadecimal values grouped every 16 bits) and as their ASCII values. If any of the characters (displayed as ASCII characters) are unprintable (control or meta characters) they will be replaced as periods. If `hexl-mode' is invoked with an argument the buffer is assumed to be in hexl format. A sample format: HEX ADDR: 0001 0203 0405 0607 0809 0a0b 0c0d 0e0f ASCII-TEXT -------- ---- ---- ---- ---- ---- ---- ---- ---- ---------------- 00000000: 5468 6973 2069 7320 6865 786c 2d6d 6f64 This is hexl-mod 00000010: 652e 2020 4561 6368 206c 696e 6520 7265 e. Each line re 00000020: 7072 6573 656e 7473 2031 3620 6279 7465 presents 16 byte 00000030: 7320 6173 2068 6578 6164 6563 696d 616c s as hexadecimal 00000040: 2041 5343 4949 0a61 6e64 2070 7269 6e74 ASCII.and print 00000050: 6162 6c65 2041 5343 4949 2063 6861 7261 able ASCII chara 00000060: 6374 6572 732e 2020 416e 7920 636f 6e74 cters. Any cont 00000070: 726f 6c20 6f72 206e 6f6e 2d41 5343 4949 rol or non-ASCII 00000080: 2063 6861 7261 6374 6572 730a 6172 6520 characters.are 00000090: 6469 7370 6c61 7965 6420 6173 2070 6572 displayed as per 000000a0: 696f 6473 2069 6e20 7468 6520 7072 696e iods in the prin 000000b0: 7461 626c 6520 6368 6172 6163 7465 7220 table character 000000c0: 7265 6769 6f6e 2e0a region.. Movement is as simple as movement in a normal emacs text buffer. Most cursor movement bindings are the same (ie. Use \[hexl-backward-char], \[hexl-forward-char], \[hexl-next-line], and \[hexl-previous-line] to move the cursor left, right, down, and up). Advanced cursor movement commands (ala \[hexl-beginning-of-line], \[hexl-end-of-line], \[hexl-beginning-of-buffer], and \[hexl-end-of-buffer]) are also supported. There are several ways to change text in hexl mode: ASCII characters (character between space (0x20) and tilde (0x7E)) are bound to self-insert so you can simply type the character and it will insert itself (actually overstrike) into the buffer. \[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if it isn't bound to self-insert. An octal number can be supplied in place of another key to insert the octal number's ASCII representation. \[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF) into the buffer at the current point. \[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377) into the buffer at the current point. \[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255) into the buffer at the current point. \[hexl-mode-exit] will exit hexl-mode. Note: saving the file with any of the usual Emacs commands will actually convert it back to binary format while saving. You can use \[hexl-find-file] to visit a file in hexl-mode. \[describe-bindings] for advanced commands. (defalias 'hexl-mode #[(&optional arg) "Á=ƒ\nÂÃ!‡Ä ˆÅÆ!ˆÇ È !ˆÅÊ!ˆ \nÌ ÅÍ!ˆ ÁÅÎ!ˆÏÎÐ\"ˆÑÒ!ˆÏÒÓÔÕ$ˆÅÖ!ˆÅ×!ˆÏ×Ø\"ˆÅÙ!ˆÔÚ Õ`Smƒno„nSß=„‰ƒ‰à Sá¥â_ã\\‰‚šà Sä ˆå!ˆæ!+‡" [major-mode hexl-mode error "You are already in hexl mode." kill-all-local-variables make-local-variable hexl-mode-old-local-map current-local-map use-local-map hexl-mode-map hexl-mode-old-mode-name mode-name "Hexl" hexl-mode-old-major-mode write-contents-hooks add-hook hexl-save-buffer make-local-hook after-revert-hook hexl-after-revert-hook nil t hexl-max-address change-major-mode-hook hexl-maybe-dehexlify-buffer require-final-newline buffer-modified-p original-point inhibit-read-only modified arg 1 buffer-size 68 16 15 hexlify-buffer set-buffer-modified-p hexl-goto-address] 5 (#$ . 1452) "p"]) (defalias 'hexl-after-revert-hook #[nil "À ˆÁÂ!‡" [hexlify-buffer set-buffer-modified-p nil] 2]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp hexl-in-save-buffer nil current-load-list] 2) #@66 Save a hexl format buffer as binary in visited file if modified. (defalias 'hexl-save-buffer #[nil "?…cÁ ƒ[ŠÃÄ!Å Æ edÇ \n \f‰ qˆÎ\f\n #ˆ\fqˆÏ ˆÐ‰Ò ˆ* ed|ˆÎ \n #ˆÓ !ˆ.‚`ÔÕ!ˆÇ!ˆÐ‡" [hexl-in-save-buffer set-buffer-modified-p buffer-modified-p generate-new-buffer " hexl" buffer-name buffer-file-name nil modified end start file-name name buf insert-buffer-substring dehexlify-buffer t buffer-file-type save-buffer kill-buffer message "(No changes need to be saved)"] 8 (#$ . 5721) nil]) #@106 Edit file FILENAME in hexl-mode. Switch to a buffer visiting file FILENAME, creating one in none exists. (defalias 'hexl-find-file #[(filename) "Á=„\fÂ=ƒÃ\f!ˆ‚Å\f!ˆÇ=?…!Ç ‡" [system-type ms-dos windows-nt find-file-binary filename find-file major-mode hexl-mode] 2 (#$ . 6241) "fFilename: "]) #@79 Exit Hexl mode, returning to previous mode. With arg, don't unhexlify buffer. (defalias 'hexl-mode-exit #[(&optional arg) "Á=„\n„& ÃÄ TÈ ˆÉÊË\"ˆÌ!ˆ bˆ+ Ï!ˆÓ ‡" [arg 1 buffer-modified-p t hexl-current-address original-point inhibit-read-only modified dehexlify-buffer remove-hook write-contents-hook hexl-save-buffer set-buffer-modified-p hexl-mode-old-mode-name mode-name use-local-map hexl-mode-old-local-map hexl-mode-old-major-mode major-mode force-mode-line-update] 3 (#$ . 6550) "p"]) #@72 Convert a hexl format buffer to binary. Ask the user for confirmation. (defalias 'hexl-maybe-dehexlify-buffer #[nil "ÀÁ!…! ÃÄ TÈ ˆÉÊË\"ˆÌ!ˆ b+‡" [y-or-n-p "Convert contents back to binary format? " buffer-modified-p t hexl-current-address original-point inhibit-read-only modified dehexlify-buffer remove-hook write-contents-hook hexl-save-buffer set-buffer-modified-p] 3 (#$ . 7067)]) #@30 Return current hexl-address. (defalias 'hexl-current-address #[(&optional validate) "`À¦ÁZ‰ÂWƒ ƒÆÇ!ˆ‚Â`À¥È_\fÉYƒ,\fÉZ‚3\f‰Ê¥ZË¥\\‰*‡" [68 11 0 hexl-address current-column validate error "Point is not on a character in the file" 16 41 5 2] 5 (#$ . 7468) nil]) #@28 Return marker for ADDRESS. (defalias 'hexl-address-to-marker #[(address) "Á¥Â_Á¦Ã_Ä¥\\Å\\‡" [address 16 68 5 2 11] 3 (#$ . 7746) "nAddress: "]) #@81 Goto hexl-mode (decimal) address ADDRESS. Signal error if ADDRESS out of range. (defalias 'hexl-goto-address #[(address) "ÁW„\f\nVƒÃÄ!ˆÅ!b‡" [address 0 hexl-max-address error "Out of hexl region." hexl-address-to-marker] 2 (#$ . 7898) "nAddress: "]) #@96 Go to hexl-mode address (hex string) HEX-ADDRESS. Signal error if HEX-ADDRESS is out of range. (defalias 'hexl-goto-hex-address #[(hex-address) "ÀÁ\n!!‡" [hexl-goto-address hexl-hex-string-to-integer hex-address] 3 (#$ . 8160) "sHex Address: "]) #@40 Return decimal integer for HEX-STRING. (defalias 'hexl-hex-string-to-integer #[(hex-string) "À\nÚ„ Ä_ÅÆ\n!!\\\nÇÈO‰‚ )‡" [0 hex-num hex-string "" 16 hexl-hex-char-to-integer string-to-char 1 nil] 5 (#$ . 8412) "sHex number: "]) #@42 Return decimal integer for OCTAL-STRING. (defalias 'hexl-octal-string-to-integer #[(octal-string) "À\nÚ„ Ä_ÅÆ\n!!\\\nÇÈO‰‚ )‡" [0 oct-num octal-string "" 8 hexl-oct-char-to-integer string-to-char 1 nil] 5 (#$ . 8654) "sOctal number: "]) #@62 Move to left ARG bytes (right if ARG negative) in hexl-mode. (defalias 'hexl-backward-char #[(arg) "ÀÁ \nZ!‡" [hexl-goto-address hexl-current-address arg] 3 (#$ . 8905) "p"]) #@59 Move right ARG bytes (left if ARG negative) in hexl-mode. (defalias 'hexl-forward-char #[(arg) "ÀÁ \n\\!‡" [hexl-goto-address hexl-current-address arg] 3 (#$ . 9086) "p"]) #@63 Move to left ARG shorts (right if ARG negative) in hexl-mode. (defalias 'hexl-backward-short #[(arg) "ÀÁ  ÄWƒj [‰ÄVƒQ\nÅ\nÆ\"š„5\nVƒ-ÈÉ!ˆ‚JÅ\nÆ\"‚J\nVƒFÈÉ!ˆ‚J\nÊ\\ S‰‚\nVƒbÈÉ!ˆ‚™Å\nÆ\"‚™ ÄVƒ™\nË\nÌ\"š„Ë\nÌ\"‚’\nÄš„Ž\nÊZ‚’ÈÍ!ˆ S‰‚k\n)!‡" [hexl-goto-address hexl-current-address address arg 0 logior 3 hexl-max-address message "End of buffer." 4 logand -4 "Beginning of buffer."] 6 (#$ . 9264) "p"]) #@60 Move right ARG shorts (left if ARG negative) in hexl-mode. (defalias 'hexl-forward-short #[(arg) "À [!‡" [hexl-backward-short arg] 2 (#$ . 9712) "p"]) #@62 Move to left ARG words (right if ARG negative) in hexl-mode. (defalias 'hexl-backward-word #[(arg) "ÀÁ  ÄWƒj [‰ÄVƒQ\nÅ\nÆ\"š„5\nVƒ-ÈÉ!ˆ‚JÅ\nÆ\"‚J\nVƒFÈÉ!ˆ‚J\nÊ\\ S‰‚\nVƒbÈÉ!ˆ‚™Å\nÆ\"‚™ ÄVƒ™\nË\nÌ\"š„Ë\nÌ\"‚’\nÄš„Ž\nÊZ‚’ÈÍ!ˆ S‰‚k\n)!‡" [hexl-goto-address hexl-current-address address arg 0 logior 7 hexl-max-address message "End of buffer." 8 logand -8 "Beginning of buffer."] 6 (#$ . 9869) "p"]) #@59 Move right ARG words (left if ARG negative) in hexl-mode. (defalias 'hexl-forward-word #[(arg) "À [!‡" [hexl-backward-word arg] 2 (#$ . 10315) "p"]) #@153 Move vertically up ARG lines [16 bytes] (down if ARG negative) in hexl-mode. If there is byte at the target address move to the last byte in that line. (defalias 'hexl-previous-line #[(arg) "À [!‡" [hexl-next-line arg] 2 (#$ . 10471) "p"]) #@156 Move vertically down ARG lines [16 bytes] (up if ARG negative) in hexl-mode. If there is no byte at the target address move to the last byte in that line. (defalias 'hexl-next-line #[(arg) "ÀÁ \nÃ_\\\nÅWƒ \fÅWƒ ÆÇ!ˆÁ æ‚N\fVƒ8æ\fæWƒ8‚N\fVƒNÆÇ!ˆÉÊ\"Á æ\\\f)!‡" [hexl-goto-address hexl-current-address arg 16 address 0 message "Out of hexl region." hexl-max-address logand -16] 4 (#$ . 10718) "p"]) #@158 Move to the beginning of the hexl buffer. Leaves `hexl-mark' at previous position. With prefix arg N, puts point N bytes of the way from the true beginning. (defalias 'hexl-beginning-of-buffer #[(arg) "À`!ˆÁ\nS!‡" [push-mark hexl-goto-address arg] 2 (#$ . 11146) "p"]) #@37 Go to `hexl-max-address' minus ARG. (defalias 'hexl-end-of-buffer #[(arg) "À`!ˆÁ\n SZ!‡" [push-mark hexl-goto-address hexl-max-address arg] 3 (#$ . 11421) "p"]) #@38 Goto beginning of line in hexl mode. (defalias 'hexl-beginning-of-line #[nil "`À¥À_Á\\b‡" [68 11] 2 (#$ . 11588) nil]) #@32 Goto end of line in hexl mode. (defalias 'hexl-end-of-line #[nil "ÀÁ Ã\"‰ Vƒ \f)!‡" [hexl-goto-address logior hexl-current-address 15 address hexl-max-address] 5 (#$ . 11713) nil]) #@76 Scroll hexl buffer window upward ARG lines; or near full window if no ARG. (defalias 'hexl-scroll-down #[(arg) "„ Á S‚Â!Ã[!‡" [arg window-height prefix-numeric-value hexl-scroll-up] 2 (#$ . 11905) "P"]) #@76 Scroll hexl buffer window upward ARG lines; or near full window if no ARG. (defalias 'hexl-scroll-up #[(arg) "„ Á S‚Â!Ã_Ä  \\V„* \\ÈWƒ0ÉÊ!‚:Ë \\!ˆÌÈ!*‡" [arg window-height prefix-numeric-value 16 hexl-current-address address movement hexl-max-address 0 message "Out of hexl region." hexl-goto-address recenter] 3 (#$ . 12122) "P"]) #@34 Goto to beginning of 1k boundry. (defalias 'hexl-beginning-of-1k-page #[nil "ÀÁ Ã\"!‡" [hexl-goto-address logand hexl-current-address -1024] 4 (#$ . 12482) nil]) #@28 Goto to end of 1k boundry. (defalias 'hexl-end-of-1k-page #[nil "ÀÁ Ã\"‰ Vƒ \f)!‡" [hexl-goto-address logior hexl-current-address 1023 address hexl-max-address] 5 (#$ . 12651) nil]) #@40 Goto to beginning of 512 byte boundry. (defalias 'hexl-beginning-of-512b-page #[nil "ÀÁ Ã\"!‡" [hexl-goto-address logand hexl-current-address -512] 4 (#$ . 12844) nil]) #@34 Goto to end of 512 byte boundry. (defalias 'hexl-end-of-512b-page #[nil "ÀÁ Ã\"‰ Vƒ \f)!‡" [hexl-goto-address logior hexl-current-address 511 address hexl-max-address] 5 (#$ . 13020) nil]) #@160 Read next input character and insert it. Useful for inserting control characters. You may also type up to 3 octal digits, to insert a character with that code (defalias 'hexl-quoted-insert #[(arg) "ÀÁ \n\"‡" [hexl-insert-char read-quoted-char arg] 3 (#$ . 13221) "p"]) #@41 Convert a binary buffer to hexl format. (defalias 'hexlify-buffer #[nil "ÀÁÄed Á$*‡" [nil t binary-process-input binary-process-output shell-command-on-region hexlify-command] 5 (#$ . 13496) nil]) #@41 Convert a hexl format buffer to binary. (defalias 'dehexlify-buffer #[nil "ÀÁÄed À$*‡" [t nil binary-process-input binary-process-output shell-command-on-region dehexlify-command] 5 (#$ . 13701) nil]) #@44 Return char for ASCII hex digits at point. (defalias 'hexl-char-after-point #[nil "À`f`Tf\"‡" [hexl-htoi] 3 (#$ . 13910)]) #@37 Hex (char) LH (char) RH to integer. (defalias 'hexl-htoi #[(lh rh) "À !Â_À !\\‡" [hexl-hex-char-to-integer lh 16 rh] 3 (#$ . 14039)]) #@60 Take a char and return its value as if it was a hex digit. (defalias 'hexl-hex-char-to-integer #[(character) "ÁYƒÂXƒÁZ‡ÃÄ\"‰ÆYƒ' ÇXƒ' ÈZ‚-ÉÊË \"!)‡" [character 48 57 logior 32 ch 97 102 87 error format "Invalid hex digit `%c'."] 5 (#$ . 14179)]) #@62 Take a char and return its value as if it was a octal digit. (defalias 'hexl-oct-char-to-integer #[(character) "ÁYƒÂXƒÁZ‡ÃÄÅ\"!‡" [character 48 55 error format "Invalid octal digit `%c'."] 4 (#$ . 14443)]) #@47 Return a displayable string for character CH. (defalias 'hexl-printable-character #[(ch) "ÀÁ\nƒ ÄW„ ÅYƒ ÆWƒÇ‚1 ‚1 ÄW„, ÅYƒ0Ç‚1 \"‡" [format "%c" hexl-iso ch 32 127 160 46] 4 (#$ . 14663)]) #@24 Insert this character. (defalias 'hexl-self-insert-command #[(arg) "À \n\"‡" [hexl-insert-char last-command-char arg] 3 (#$ . 14871) "p"]) #@38 Insert a character in a hexl buffer. (defalias 'hexl-insert-char #[(ch num) "ÀÁ! ÄV…|\nÅ¥Æ_\nŦÇ_\\\nŦǥ\\È\\\nÅ¥Æ_\nŦ\\É\\Ê \f `\fUƒ9Á  bˆÎÇ!ˆÏÐ\"cˆ\fbˆÎÒ!ˆÓ!cˆ\n=„`\nTÕ\n!ˆ ƒtÄyˆÖuˆ\nŦuˆ+ S‰‚)‡" [hexl-current-address t address num 0 16 68 2 11 52 nil at-ascii-position ascii-position hex-position delete-char format "%02x" ch 1 hexl-printable-character hexl-max-address hexl-goto-address 51] 5 (#$ . 15016)]) #@72 Insert a ASCII char ARG times at point for a given hexadecimal number. (defalias 'hexl-insert-hex-char #[(arg) "ÀÁÂ!!‰ÄV„ ÅWƒÆÇ!‚È  \")‡" [hexl-hex-string-to-integer read-string "Hex number: " num 255 0 error "Hex number out of range." hexl-insert-char arg] 4 (#$ . 15459) "p"]) #@68 Insert a ASCII char ARG times at point for a given decimal number. (defalias 'hexl-insert-decimal-char #[(arg) "ÀÁÂ!!‰ÄV„ ÅWƒÆÇ!‚È  \")‡" [string-to-int read-string "Decimal Number: " num 255 0 error "Decimal number out of range." hexl-insert-char arg] 4 (#$ . 15752) "p"]) #@66 Insert a ASCII char ARG times at point for a given octal number. (defalias 'hexl-insert-octal-char #[(arg) "ÀÁÂ!!‰ÄV„ ÅWƒÆÇ!‚È  \")‡" [hexl-octal-string-to-integer read-string "Octal Number: " num 255 0 error "Decimal number out of range." hexl-insert-char arg] 4 (#$ . 16040) "p"]) (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÄ#ˆÂÖ×#ˆÂØÙ#ˆÂÚÆ#ˆÛÜ!!Þ=„iÂÜ!×#ˆÂßà#ˆÂáà#ˆÂâ×#ˆÂãà#ˆÂäÊ#ˆÂå×#ˆÂæÈ#ˆÂçè#ˆÂé×#ˆÂêÐ#ˆÂë×#ˆÂì×#ˆí.íïWƒÍÂðñ.\"à#ˆ.T‰.‚µ)Âòó#ˆÂôÌ#ˆÂõ×#ˆÂö÷#ˆÂøù#ˆÂúÎ#ˆÂû×#ˆÂü×#ˆÂý×#ˆÂþ×#ˆÂÿ×#ˆÂ@×#ˆÂA×#ˆÂB×#ˆÂCD#ˆÂE×#ˆÂF×#ˆÂG×#ˆÂH×#ˆÂI×#ˆÂJ×#ˆÂK×#ˆÂLM#ˆÂN×#ˆÂO×#ˆÂPQ#ˆÂR×#ˆÂS×#ˆÂT×#ˆÂUV#ˆÂWX#ˆÂY×#ˆÂZ×#ˆÂ[\\#ˆÂ]×#ˆÂ^×#ˆÂ_×#ˆÂ`×#ˆÂa×#ˆÂb×#ˆÂc×#ˆÂd×#ˆÂe×#ˆÂf×#ˆÂg×#ˆÂhÒ#ˆÂi×#ˆÂj×#ˆÂkl#ˆÂmn#ˆÂop#ˆÂqr#ˆÂst#ˆÂu×#ˆÂvw#ˆÂx×#ˆÁ‡" [hexl-mode-map make-sparse-keymap define-key [left] hexl-backward-char [right] hexl-forward-char [up] hexl-previous-line [down] hexl-next-line [M-left] hexl-backward-short [M-right] hexl-forward-short [next] hexl-scroll-up [prev] hexl-scroll-down "" hexl-beginning-of-line "" "" undefined "" hexl-end-of-line "" key-binding char-to-string help-char help-command " " hexl-self-insert-command "\n" " " " " "" "" "" "" hexl-quoted-insert "" "" "" "" 32 ch 127 format "%c" "" hexl-beginning-of-512b-page "" "" "" hexl-insert-decimal-char "" hexl-end-of-512b-page "" "" "" " " "\n" " " "\f" " " "" "" hexl-insert-octal-char "" "" "" "" "" "" "" "" hexl-insert-hex-char "" "a" "b" hexl-backward-word "c" "d" "e" "f" hexl-forward-word "g" hexl-goto-hex-address "h" "i" "j" hexl-goto-address "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" "y" "z" "<" hexl-beginning-of-buffer ">" hexl-end-of-buffer "" hexl-mode-exit "[" hexl-beginning-of-1k-page "]" hexl-end-of-1k-page "" "" hexl-save-buffer ""] 6) emacs-19.30/lisp/hideif.elc100666 13437 1 44551 6044071711 14157 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Oct 27 01:52:58 1995 ;;; from file /home/fsf/rms/e19/lisp/hideif.el ;;; emacs version 19.29.1.4. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`hideif.el' was compiled for Emacs 19.29 or later")) (require (quote cc-mode)) #@35 Keymap used with Hide-Ifdef mode. (defvar hide-ifdef-mode-submap nil (#$ . 498)) #@35 Keymap used with Hide-Ifdef mode. (defvar hide-ifdef-mode-map nil (#$ . 585)) #@46 Prefix key for all Hide-Ifdef mode commands. (defconst hide-ifdef-mode-prefix-key "@" (#$ . 669)) (byte-code "„PÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÕÖ×Ø#‰ƒOÂÚ#ˆ)„aÁ Â#ˆÁ‡" [hide-ifdef-mode-submap make-sparse-keymap define-key "d" hide-ifdef-define "u" hide-ifdef-undef "D" hide-ifdef-set-define-alist "U" hide-ifdef-use-define-alist "h" hide-ifdefs "s" show-ifdefs "" hide-ifdef-block "" show-ifdef-block "" hide-ifdef-toggle-read-only where-is-internal toggle-read-only (keymap) t where hide-ifdef-toggle-outside-read-only hide-ifdef-mode-map hide-ifdef-mode-prefix-key] 5) #@44 Non-nil when hide-ifdef-mode is activated. (defvar hide-ifdef-mode nil (#$ . 1293)) #@34 Non-nil when text may be hidden. (defvar hide-ifdef-hiding nil (#$ . 1383)) (byte-code "À ž„\fÀ\nB BÃ\fž„Å\fBÀ\fž„ Æ\fBÀ‡" [hide-ifdef-mode minor-mode-map-alist hide-ifdef-mode-map hide-ifdef-hiding minor-mode-alist (hide-ifdef-hiding " Hiding") (hide-ifdef-mode " Ifdef")] 2) #@51 Syntax table used for tokenizing #if expressions. (defvar hide-ifdef-syntax-table (copy-syntax-table c-mode-syntax-table) (#$ . 1673)) (byte-code "ÀÁ #ˆÀÄÅ #ˆÀÆÅ #‡" [modify-syntax-entry 95 "w" hide-ifdef-syntax-table 38 "." 124] 4) #@1130 Toggle Hide-Ifdef mode. This is a minor mode, albeit a large one. With ARG, turn Hide-Ifdef mode on iff arg is positive. In Hide-Ifdef mode, code within #ifdef constructs that the C preprocessor would eliminate may be hidden from view. Several variables affect how the hiding is done: hide-ifdef-env An association list of defined and undefined symbols for the current buffer. Initially, the global value of `hide-ifdef-env' is used. hide-ifdef-define-alist An association list of defined symbol lists. Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env' and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env' from one of the lists in `hide-ifdef-define-alist'. hide-ifdef-lines Set to non-nil to not show #if, #ifdef, #ifndef, #else, and #endif lines when hiding. hide-ifdef-initially Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode is activated. hide-ifdef-read-only Set to non-nil if you want to make buffers read only while hiding. After `show-ifdefs', read-only status is restored to previous value. \{hide-ifdef-mode-map} (defalias 'hide-ifdef-mode #[(arg) "ÀÁ!ˆ\n„ ?‚Ã\n!ÄVÅ ˆ ƒJÀÆ!ˆÇÆ!ÀÈ!ˆÇÈ!ÀÉ!ˆ\n ËÌ!ˆ ƒCÎ ˆ‚FÏ ˆÐÑ!‡ƒRÏ ˆÐÒ!‡" [make-local-variable hide-ifdef-mode arg prefix-numeric-value 0 force-mode-line-update hide-ifdef-env default-value hide-ifdef-hiding hif-outside-read-only buffer-read-only run-hooks hide-ifdef-mode-hook hide-ifdef-initially hide-ifdefs show-ifdefs message "Enter hide-ifdef-mode." "Exit hide-ifdef-mode."] 2 (#$ . 1915) "P"]) #@166 Hides or shows lines from FROM to TO, according to FLAG. If FLAG is \n (newline character) then text is shown, while if FLAG is \^M (control-M) the text is hidden. (defalias 'hif-outline-flag-region #[(from to flag) "À ÂŽÃ\f ÇUƒÈ‚ÇÉ%*‡" [buffer-modified-p modp ((set-buffer-modified-p modp)) subst-char-in-region from to flag 10 13 t] 6 (#$ . 3505)]) #@45 Show all of the text in the current buffer. (defalias 'hif-show-all #[nil "ÀedÁ#‡" [hif-outline-flag-region 10] 4 (#$ . 3872) nil]) #@121 START is the start of a #if or #else form. END is the ending part. Everything including these lines is made invisible. (defalias 'hide-ifdef-region #[(start end) "À \nÃ#‡" [hif-outline-flag-region start end 13] 4 (#$ . 4011)]) #@51 Everything between START and END is made visible. (defalias 'hif-show-ifdef-region #[(start end) "À \nÃ#‡" [hif-outline-flag-region start end 10] 4 (#$ . 4245)]) #@100 The evaluator is given a canonical form and returns T if text under that form should be displayed. (defvar hide-ifdef-evaluator (quote eval) (#$ . 4414)) #@42 ...is by default considered to be false. (defvar hif-undefined-symbol nil (#$ . 4574)) #@47 An alist of defined symbols and their values. (defvar hide-ifdef-env nil (#$ . 4667)) #@45 Prepend (var value) pair to hide-ifdef-env. (defalias 'hif-set-var #[(var value) " B\nB‰‡" [var value hide-ifdef-env] 2 (#$ . 4759)]) (defalias 'hif-lookup #[(var) "À \n\"‰ƒ A‚\f)‡" [assoc var hide-ifdef-env val hif-undefined-symbol] 4]) (defalias 'hif-defined #[(var) "À !‡" [hif-lookup var] 2]) (byte-code "ÀÁ\nB ÃPÄ\nB ÅPÆ\nB ÇPÈ\nB ÉP\nÊ\nBËË\n°\fÌ\nBÁ‡" ["\\(^\\| \\)[ ]*#[ ]*" hif-cpp-prefix current-load-list "ifndef" hif-ifndef-regexp "if\\(n?def\\)?[ ]+" hif-ifx-regexp "else" hif-else-regexp "endif" hif-endif-regexp "\\|" hif-ifx-else-endif-regexp] 5) #@50 Convert list of tokens in infix into prefix list (defalias 'hif-infix-to-prefix #[(token-list) "GÁUƒÂÃ@DD‡Ä!‡" [token-list 1 hif-lookup quote hif-parse-if-exp] 3 (#$ . 5358)]) (byte-code "ÀÁ\nBÃÄ\nBÁ‡" ["^\\(!\\|&&\\|||\\|[!=]=\\|[()+-]\\|\\w+\\)" hif-token-regexp current-load-list "\\*/" hif-end-of-comment] 2) #@39 Separate string into a list of tokens (defalias 'hif-tokenize #[(expr-string) "ÀÁ\nGà ÈŽÉ\n!ˆ WƒËÌ\n#ƒ1Á•\nSÍIˆ‚ËÎ\n#ƒdÁ•\nSÍIˆË\n#„VËÐ\n#ˆÁ•\nSÍIˆ‚ËÑ\n#ƒ|ËÐ\n#ˆÁ•‰‚Ë\n#ƒ\nÁ•OÁ•\nSÍIˆÔ˜ƒ¤Õ‚ Ö˜ƒ¯×‚ ؘƒºÙ‚ Ú˜ƒÅÛ‚ ܘƒÐÝ‚ Þ˜ƒÛß‚ à˜ƒæá‚ ☃ñã‚ 䘃üå‚ 昃ç‚ è!B)‚éê\n\"ˆ‚)Ÿ,‡" [nil 0 expr-string syntax-table current-syntax-table expr-length expr-start token-list ((set-syntax-table current-syntax-table)) set-syntax-table hide-ifdef-syntax-table string-match "^[ ]+" 10 "^/\\*" hif-end-of-comment "$" "^//" hif-token-regexp token "||" or "&&" and "==" equal "!=" hif-notequal "!" not "defined" hif-defined "(" lparen ")" rparen "+" hif-plus "-" hif-minus intern error "Bad #if expression: %s"] 5 (#$ . 5686)]) #@63 Parse the TOKEN-LIST. Return translated list in prefix form. (defalias 'hif-parse-if-exp #[(token-list) "À ˆÁ \nƒÃÄ\n\"ˆ‡" [hif-nexttoken hif-expr token error "Error: unexpected token: %s"] 4 (#$ . 6514)]) #@67 Pop the next token from token-list into the let variable "token". (defalias 'hif-nexttoken #[nil "@A ‡" [token-list token] 1 (#$ . 6729)]) #@71 Parse and expression of the form expr : term | expr '||' term. (defalias 'hif-expr #[nil "À \nÃ=ƒÄ ˆÃ À E‚ )‡" [hif-term result token or hif-nexttoken] 3 (#$ . 6878)]) #@69 Parse a term of the form term : eq-expr | term '&&' eq-expr. (defalias 'hif-term #[nil "À \nÃ=ƒÄ ˆÃ À E‚ )‡" [hif-eq-expr result token and hif-nexttoken] 3 (#$ . 7065)]) #@74 Parse a term of the form eq-expr : math | eq-expr '=='|'!=' math. (defalias 'hif-eq-expr #[nil "À Á\fÅ=„\fÆ=ƒ\fÇ ˆ\n À E‚ *‡" [hif-math nil eq-token result token equal hif-notequal hif-nexttoken] 3 (#$ . 7254)]) #@75 Parse an expression of the form math : factor | math '+|-' factor. (defalias 'hif-math #[nil "À Á\fÅ=„\fÆ=ƒ\fÇ ˆ\n À E‚ *‡" [hif-factor nil math-op result token hif-plus hif-minus hif-nexttoken] 3 (#$ . 7489)]) #@96 Parse a factor of the form factor : '!' factor | '(' expr ')' | 'defined(' id ')' | id. (defalias 'hif-factor #[nil "Á=ƒ ˆÁà D‡Ä=ƒ/ ˆÅ Ç=„(ÈÉ\"‚- ˆ)‡Ê=ƒk ˆÄ=„BÈË!ˆÂ ˆ\fÍ>ƒSÈÎ\"ˆÂ ˆÇ=„`ÈÏ!ˆÂ ˆÊÐ\f)DD‡‰\fÑ>ƒxÈÒ!ˆÂ ˆÓÐ\f)DD‡" [token not hif-nexttoken hif-factor lparen hif-expr result rparen error "Bad token in parenthesized expression: %s" hif-defined "Error: expected \"(\" after \"defined\"" ident (or and not hif-defined lparen rparen) "Error: unexpected token: %s" "Error: expected \")\" after identifier" quote (or and) "Error: missing identifier" hif-lookup] 4 (#$ . 7723)]) #@54 Treat VAL as a number: if it's t or nil, use 1 or 0. (defalias 'hif-mathify #[(val) "Á=ƒ‡„LJ" [val t 1 0] 2 (#$ . 8349)]) #@52 Like ordinary plus but treat t and nil as 1 and 0. (defalias 'hif-plus #[(a b) "À !À\n!\\‡" [hif-mathify a b] 3 (#$ . 8486)]) #@53 Like ordinary minus but treat t and nil as 1 and 0. (defalias 'hif-minus #[(a b) "À !À\n!Z‡" [hif-mathify a b] 3 (#$ . 8618)]) #@43 Like (not (equal A B)) but as one symbol. (defalias 'hif-notequal #[(a b) " š?‡" [a b] 2 (#$ . 8751)]) #@94 When at beginning of #ifX, returns a canonical (evaluatable) form for the expression. (defalias 'hif-canonicalize #[nil "ŠÀ !Ã\f!ˆ`ÅÆwˆ`{ÈÉ!!\n\nƒ%Ë\nD‚'\n,‡" [looking-at hif-ifndef-regexp negate re-search-forward hif-ifx-regexp "^\n " nil expr-string hif-infix-to-prefix hif-tokenize expr not] 3 (#$ . 8861)]) #@84 Position at beginning of next #if, #ifdef, or #ifndef, including one on this line. (defalias 'hif-find-any-ifX #[nil "À dÂ#Ãyˆ‡" [re-search-forward hif-ifx-regexp t 0] 4 (#$ . 9195)]) #@95 Position at beginning of next #ifdef, #ifndef, #else, #endif, NOT including one on this line. (defalias 'hif-find-next-relevant #[nil "ÀˆÁ\ndÃ#…ÄyˆÀ‡" [nil re-search-forward hif-ifx-else-endif-regexp t 0] 4 (#$ . 9385)]) #@99 Position at beginning of previous #ifdef, #ifndef, #else, #endif, NOT including one on this line. (defalias 'hif-find-previous-relevant #[nil "ÀyˆÁ\neÃ#…ÀyˆÄ‡" [0 re-search-backward hif-ifx-else-endif-regexp t nil] 4 (#$ . 9615)]) (defalias 'hif-looking-at-ifX #[nil "À !‡" [looking-at hif-ifx-regexp] 2]) (defalias 'hif-looking-at-endif #[nil "À !‡" [looking-at hif-endif-regexp] 2]) (defalias 'hif-looking-at-else #[nil "À !‡" [looking-at hif-else-regexp] 2]) #@68 If positioned at #ifX or #else form, skip to corresponding #endif. (defalias 'hif-ifdef-to-endif #[nil "À ˆÁ ƒ ˆÂ ‡Ã ƒ ‡Ä ƒŇÆÇ!‡" [hif-find-next-relevant hif-looking-at-ifX hif-ifdef-to-endif hif-looking-at-else hif-looking-at-endif done error "Mismatched #ifdef #endif pair"] 2 (#$ . 10085)]) #@68 If positioned at #endif form, skip backward to corresponding #ifX. (defalias 'hif-endif-to-ifdef #[nil "`Á ˆ`UƒÂÃ!ˆ)Ä ƒÅ ˆÅ ‡Æ ƒ#Å ‡Ç ƒ*ȇɇ" [start hif-find-previous-relevant error "Mismatched #ifdef #endif pair" hif-looking-at-endif hif-endif-to-ifdef hif-looking-at-else hif-looking-at-ifX done t] 2 (#$ . 10394)]) #@98 Move point to beginning of line of the next ifdef-endif. With argument, do this that many times. (defalias 'forward-ifdef #[(&optional arg) "„ÁÂWƒÃ[!ˆÂW…:[`Å „$Æ ˆÅ ƒ/Ç ˆ‚6\fbˆÈÉ!ˆ)‚‡" [arg 1 0 backward-ifdef start hif-looking-at-ifX hif-find-next-relevant hif-ifdef-to-endif error "No following #ifdef"] 2 (#$ . 10726) "p"]) #@94 Move point to beginning of the previous ifdef-endif. With argument, do this that many times. (defalias 'backward-ifdef #[(&optional arg) "„ÁÂWƒÃ[!ˆÂW…=SÂyˆ`Å „'Æ ˆÅ ƒ2Ç ˆ‚9\fbˆÈÉ!ˆ)‚‡" [arg 1 0 forward-ifdef start hif-looking-at-endif hif-find-previous-relevant hif-endif-to-ifdef error "No previous #ifdef"] 2 (#$ . 11076) "p"]) #@55 Move point to beginning of nested ifdef or else-part. (defalias 'down-ifdef #[nil "`Á ˆÂ †\fà ?…bˆÄÅ!)‡" [start hif-find-next-relevant hif-looking-at-ifX hif-looking-at-else error "No following #ifdef"] 2 (#$ . 11430) nil]) #@58 Move point to beginning of enclosing ifdef or else-part. (defalias 'up-ifdef #[nil "Àyˆ` „ à ˆÂ ƒÄ ˆ `U…ÅÆ!)‡" [0 start hif-looking-at-endif hif-find-previous-relevant hif-endif-to-ifdef error "No previous #ifdef"] 2 (#$ . 11665) nil]) #@99 Move to the beginning of the next #ifX, #else, or #endif. With argument, do this that many times. (defalias 'next-ifdef #[(&optional arg) "„ÁÂWƒÃ[!ˆÂW…+SÄ ˆlƒÂyˆÅÆ!ˆ‚‡" [arg 1 0 previous-ifdef hif-find-next-relevant error "No following #ifdefs, #elses, or #endifs"] 2 (#$ . 11914) "p"]) #@103 Move to the beginning of the previous #ifX, #else, or #endif. With argument, do this that many times. (defalias 'previous-ifdef #[(&optional arg) "„ÁÂWƒÃ[!ˆÂW…-S`Å ˆ\f`Uƒ)ÆÇ!ˆ)‚‡" [arg 1 0 next-ifdef start hif-find-previous-relevant error "No previous #ifdefs, #elses, or #endifs"] 2 (#$ . 12224) "p"]) (defalias 'hif-make-range #[(else-p start end &optional else) " \n F‡" [else-p start else end] 4]) (defalias 'hif-range-else-p #[(range) "Áœ‡" [range 0] 2]) (defalias 'hif-range-start #[(range) "Áœ‡" [range 1] 2]) (defalias 'hif-range-else #[(range) "Áœ‡" [range 2] 2]) (defalias 'hif-range-end #[(range) "Áœ‡" [range 3] 2]) #@87 Returns a Range structure describing the current #if region. Point is left unchanged. (defalias 'hif-find-range #[nil "ŠÀyˆ`Á‰‰Æ ˆÇ ƒÈ ˆÆ ˆ‚É ƒ)Ê`‚+`\fƒKÆ ˆÇ ƒ@È ˆÆ ˆ‚2É ƒIËÌ!ˆ`Í\f \n $-‡" [0 nil end else else-p start hif-find-next-relevant hif-looking-at-ifX hif-ifdef-to-endif hif-looking-at-else t error "Found two elses in a row? Broken!" hif-make-range] 5 (#$ . 12879)]) #@77 Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil. (defalias 'hif-hide-line #[(point) "…Š bˆÂ ÄŽÅyˆ`ÆU?…Ç`S`\"+‡" [hide-ifdef-lines point buffer-modified-p modp ((set-buffer-modified-p modp)) 0 1 hide-ifdef-region] 3 (#$ . 13280)]) #@75 Call `hide-ifdef-guts' after narrowing to end of START line and END line. (defalias 'hif-recurse-on #[(start end) "ŠŒbˆÁˆ`\n}ˆÃ *‡" [start nil end hide-ifdef-guts] 2 (#$ . 13549)]) #@124 Called at #ifX expression, this hides those parts that should be hidden, according to judgement of `hide-ifdef-evaluator'. (defalias 'hif-possibly-hide #[nil "À Á ÄÅ\n!!ˆ !ƒAÇ\n!ƒ5ÄÈ\n!!ˆÉÈ\n!Å\n!S\"ˆÊË\n!È\n!\"ˆ‚kÊË\n!Å\n!\"ˆ‚kÇ\n!ƒcÄÈ\n!!ˆÉË\n!È\n!S\"ˆÊÈ\n!Å\n!\"ˆ‚kÉ`Å\n!S\"ˆÄË\n!!ˆÅ\n!bˆÌ*‡" [hif-canonicalize hif-find-range range test hif-hide-line hif-range-end hide-ifdef-evaluator hif-range-else-p hif-range-else hide-ifdef-region hif-recurse-on hif-range-start nil] 4 (#$ . 13739)]) #@100 Does the work of `hide-ifdefs', except for the work that's pointless to redo on a recursive entry. (defalias 'hide-ifdef-guts #[nil "ŠebˆÀ …Á ˆ‚)‡" [hif-find-any-ifX hif-possibly-hide] 1 (#$ . 14249)]) #@85 *Non-nil if `hide-ifdefs' should be called when Hide-Ifdef mode is first activated. (defvar hide-ifdef-initially nil (#$ . -14461)) #@71 *Set to non-nil if you want buffer to be read-only while hiding text. (defvar hide-ifdef-read-only nil (#$ . -14599)) #@73 Internal variable. Saves the value of `buffer-read-only' while hiding. (defvar hif-outside-read-only nil (#$ . 14723)) #@71 *Set to t if you don't want to see the #ifX, #else, and #endif lines. (defvar hide-ifdef-lines nil (#$ . -14849)) #@30 Toggle hide-ifdef-read-only. (defalias 'hide-ifdef-toggle-read-only #[nil "?Áƒ ÂÄ\"ˆ ƒ†È ‡" [hide-ifdef-read-only message "Hide-Read-Only %s" "ON" "OFF" hide-ifdef-hiding hif-outside-read-only buffer-read-only force-mode-line-update] 3 (#$ . 14969) nil]) #@60 Replacement for `toggle-read-only' within Hide Ifdef mode. (defalias 'hide-ifdef-toggle-outside-read-only #[nil "?Áƒ ÂÄ\"ˆ ƒ†È ‡" [hif-outside-read-only message "Read only %s" "ON" "OFF" hide-ifdef-hiding hide-ifdef-read-only buffer-read-only force-mode-line-update] 3 (#$ . 15247) nil]) #@52 Define a VAR so that #ifdef VAR would be included. (defalias 'hide-ifdef-define #[(var) "À Â\"ˆ … Ä ‡" [hif-set-var var 1 hide-ifdef-hiding hide-ifdefs] 3 (#$ . 15558) "SDefine what? "]) #@58 Undefine a VAR so that #ifdef VAR would not be included. (defalias 'hide-ifdef-undef #[(var) "À Â\"ˆ … Ä ‡" [hif-set-var var nil hide-ifdef-hiding hide-ifdefs] 3 (#$ . 15752) "SUndefine what? "]) #@279 Hide the contents of some #ifdefs. Assume that defined symbols have been added to `hide-ifdef-env'. The text hidden is the text that would not be included by the C preprocessor if it were given the file with those symbols defined. Turn off hiding by calling `show-ifdefs'. (defalias 'hide-ifdefs #[nil "ÀÁ!ˆ\n„\fÂÃ!ˆ\fƒÅ ˆÆÆÆÉ ˆ)\n†& \fÀÍ!‡" [message "Hiding..." hide-ifdef-mode 1 hide-ifdef-hiding show-ifdefs t inhibit-read-only selective-display hide-ifdef-guts hide-ifdef-read-only hif-outside-read-only buffer-read-only "Hiding done"] 2 (#$ . 15956) nil]) #@76 Cancel the effects of `hide-ifdef'. The contents of all #ifdefs is shown. (defalias 'show-ifdefs #[nil "ÂÄÆ ˆ)‰‡" [hif-outside-read-only buffer-read-only nil selective-display t inhibit-read-only hif-show-all hide-ifdef-hiding] 2 (#$ . 16540) nil]) #@77 Utility for hide and show `ifdef-block'. Set top and bottom of ifdef block. (defalias 'hif-find-ifdef-block #[nil "ÀŠÂyˆÃ „Ä „Å ˆ`Ç ˆ`S)ŠÂyˆÈ „)É ˆÄ ƒ7Ç ˆÉ ˆ‚) `S^‰\n*‡" [nil max-bottom 0 hif-looking-at-else hif-looking-at-ifX up-ifdef top hif-ifdef-to-endif hif-looking-at-endif hif-find-next-relevant bottom] 2 (#$ . 16803)]) #@75 Hide the ifdef block (true or false part) enclosing or before the cursor. (defalias 'hide-ifdef-block #[nil "„ÀÁ!ˆÂĉÂÈ ˆÉ\"ˆ\nƒ,Ë!ˆËT!ˆÂ\f+ †7‰‡" [hide-ifdef-mode 1 t selective-display nil inhibit-read-only bottom top hif-find-ifdef-block hide-ifdef-region hide-ifdef-lines hif-hide-line hide-ifdef-hiding hide-ifdef-read-only hif-outside-read-only buffer-read-only] 3 (#$ . 17149) nil]) #@75 Show the ifdef block (true or false part) enclosing or before the cursor. (defalias 'show-ifdef-block #[nil "À\nƒŠÃyˆÄ`Sň`\")‚'ʼnÈ ˆÄS\"*)‡" [t inhibit-read-only hide-ifdef-lines 0 hif-show-ifdef-region nil bottom top hif-find-ifdef-block] 3 (#$ . 17570) nil]) #@49 A global assoc list of pre-defined symbol lists (defvar hide-ifdef-define-alist nil (#$ . 17851)) #@67 Compress the define list ENV into a list of defined symbols only. (defalias 'hif-compress-define-list #[(env) "ÀÁ\n\"Ƀ @ƒ @\fB A‰„ \f*‡" [mapcar #[(arg) "À @!… @‡" [hif-lookup arg] 2] env nil new-defs defs] 4 (#$ . 17955)]) #@51 Set the association for NAME to `hide-ifdef-env'. (defalias 'hide-ifdef-set-define-alist #[(name) "Á\n!B B‰‡" [name hif-compress-define-list hide-ifdef-env hide-ifdef-define-alist] 3 (#$ . 18198) "SSet define list: "]) #@60 Set `hide-ifdef-env' to the define list specified by NAME. (defalias 'hide-ifdef-use-define-alist #[(name) "À \n\"‰ƒÄÅ A\"‚ÇÈ \"ˆ …Ê )‡" [assoc name hide-ifdef-define-alist define-list mapcar #[(arg) "ÁB‡" [arg t] 2] hide-ifdef-env error "No define list for %s" hide-ifdef-hiding hide-ifdefs] 4 (#$ . 18425) "SUse define list: "]) (provide (quote hideif)) emacs-19.30/lisp/hideshow.elc100666 22543 1 26146 5762727435 14444 0ustar ttndaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 30 19:49:48 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/hideshow.el ;;; emacs version 19.28.92.13. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`hideshow.el' was compiled for Emacs 19.29 or later")) #@600 *Symbol representing how "unbalanced parentheses" should be handled. This error is usually signalled by hs-show-block. One of four values: `top-level', `next-line', `signal' or `ignore'. Default is `top-level'. - `top-level' -- Show top-level block containing the currently troublesome block. - `next-line' -- Use the fact that, for an already hidden block, its end will be on the next line. Attempt to show this block. - `signal' -- Pass the error through, stopping execution. - `ignore' -- Ignore the error, continuing execution. Values other than these four will be interpreted as `signal'. (defvar hs-unbalance-handler-method (quote top-level) (#$ . -480)) #@717 *Alist of the form (MODE START-RE END-RE FORWARD-SEXP-FUNC). If present, hideshow will use these values for the start and end regexps, respectively. Since Algol-ish languages do not have single-character block delimiters, the function `forward-sexp' which is used by hideshow doesn't work. In this case, if a similar function is provided, you can register it and have hideshow use it instead of `forward-sexp'. To add more values, use (pushnew '(new-mode st-re end-re function-name) hs-special-modes-alist :test 'equal) For example: (pushnew '(simula-mode "begin" "end" simula-next-statement) hs-special-modes-alist :test 'equal) Note that the regexps should not contain leading or trailing whitespace. (defvar hs-special-modes-alist (quote ((c-mode "{" "}") (c++-mode "{" "}"))) (#$ . -1153)) #@60 *Hooks called at the end of hs-hide-all and hs-hide-block. (defvar hs-hide-hooks nil (#$ . -1966)) #@76 *Hooks called at the end of hs-show-all, hs-show-block and hs-show-region. (defvar hs-show-hooks nil (#$ . -2071)) #@66 *Prefix key to use for hideshow commands in hideshow minor mode. (defvar hs-minor-mode-prefix "" (#$ . -2192)) #@125 Non-nil if using hideshow mode as a minor mode of some other mode. Use the command `hs-minor-mode' to toggle this variable. (defvar hs-minor-mode nil (#$ . 2311)) #@35 Mode map for hideshow minor mode. (defvar hs-minor-mode-map nil (#$ . 2480)) #@49 Menu bar for hideshow minor mode (Xemacs only). (defvar hs-menu-bar nil (#$ . 2563)) #@137 Regexp for beginning of comments. Buffer-local. Differs from mode-specific comment regexps in that surrounding whitespace is stripped. (defvar hs-c-start-regexp nil (#$ . 2655)) #@69 Regexp for end of comments. Buffer-local. See `hs-c-start-regexp'. (defvar hs-c-end-regexp nil (#$ . 2840)) #@47 Regexp for beginning of block. Buffer-local. (defvar hs-block-start-regexp nil (#$ . 2955)) #@41 Regexp for end of block. Buffer-local. (defvar hs-block-end-regexp nil (#$ . 3054)) #@312 Function used to do a forward-sexp. Should change for Algol-ish modes. For single-character block delimiters -- ie, the syntax table regexp for the character is either `(' or `)' -- `hs-forward-sexp-func' would just be `forward-sexp'. For other modes such as simula, a more specialized function is necessary. (defvar hs-forward-sexp-func (quote forward-sexp) (#$ . 3146)) #@44 Used to support both FSF Emacs and Xemacs. (defvar hs-emacs-type (quote fsf) (#$ . 3526)) #@165 Hides or shows lines from FROM to TO, according to FLAG. If FLAG is \n (newline character) then text is shown, while if FLAG is \^M (control-M) the text is hidden. (defalias 'hs-flag-region #[(from to flag) "À ÁÄŽÅÉUƒÊ‚ÉË%+‡" [buffer-modified-p nil buffer-read-only modp ((set-buffer-modified-p modp)) subst-char-in-region from to flag 10 13 t] 6 (#$ . 3623)]) #@74 Hide block iff on block beginning, optional END means reposition at end. (defalias 'hs-hide-block-at-point #[(&optional end) "À !…5` Ä!ˆ`ÆyˆÇˆ\n`Wƒ)È\n \"ÄVƒ)É\n`Ê#ˆ ƒ2 ‚3\nb*‡" [looking-at hs-block-start-regexp p hs-forward-sexp-func 1 q -1 nil count-lines hs-flag-region 13 end] 4 (#$ . 4004)]) #@75 Show block iff on block beginning. Optional END means reposition at end. (defalias 'hs-show-block-at-point #[(&optional end) "À !…\"`ÃÄÅÇ\nÈ#ˆ ƒ`T‚ \nb*‡" [looking-at hs-block-start-regexp p error (byte-code "Á!ˆ`‡" [hs-forward-sexp-func 1] 2) ((error (byte-code "Á=ƒ`‡Â=ƒ%iÃU„Ä ˆ`ÆÇPdÉÊ$ˆ`‡Ë=ƒ5Ãyˆ`ʈ`‡Ì @ A\"‡" [hs-unbalance-handler-method ignore top-level 0 beginning-of-defun p re-search-forward "^" hs-block-start-regexp t 2 next-line signal error] 5))) q hs-flag-region 10 end] 4 (#$ . 4316)]) #@66 Warns if selective-display or selective-display-ellipses is nil. (defalias 'hs-safety-is-job-n #[nil "À\n„Ã\f„ ÅP GÆU?… ÇÈ \"ˆÉÊ!)‡" ["" str selective-display "selective-display nil " selective-display-ellipses "selective-display-ellipses nil" 0 message "warning: %s" sit-for 2] 3 (#$ . 4851)]) #@189 Returns non-nil if point is inside a comment, otherwise nil. Actually, for multi-line-able comments, returns a list containing the buffer position of the start and the end of the comment. (defalias 'hs-inside-comment-p #[nil "Š`À Ęƒ%ÀÆyˆÇ\nÉ#‰…!ÊË\nÉ#?)‚GÇ\fdÍ#ˆ`ÎÏ!ˆÇdÍ#ˆ`GZ\nW…GÆ” D+‡" [nil q p comment-end "" found 0 re-search-forward hs-c-start-regexp t search-forward "\"" hs-c-end-regexp 1 forward-comment -1 comment-start] 5 (#$ . 5161)]) #@51 Setup variables for new buffers where applicable. (defalias 'hs-grok-mode-type #[nil "ÀÁ!…dÀÂ!…dà !ÅÆ\f\"ƒ\flj•SO\nȘƒ(É‚+Ã\n!\nÅË\n\"ƒ=\nÇ•ÌO\nÍ\"‰A@†LÑÓ8†VÔÖ8†`׉)‡" [boundp comment-start comment-end regexp-quote hs-c-start-regexp string-match " +$" 0 "" "\n" hs-c-end-regexp "^ +" nil assoc major-mode hs-special-modes-alist lookup "\\s(" hs-block-start-regexp 2 "\\s)" hs-block-end-regexp 3 forward-sexp hs-forward-sexp-func] 4 (#$ . 5630)]) #@71 Repositions point at block-start. Return point, or nil if top-level. (defalias 'hs-find-block-beginning #[nil "À`Á\nÃ\fÅ°„6ÉeÊ#ƒ6Ë”ƒ*Ë”‰‚Ì•bˆ Î!ˆ‚†=bˆ+‡" [nil "\\(" hs-block-start-regexp "\\)\\|\\(" hs-block-end-regexp "\\)" both-regexps here done re-search-backward t 1 2 hs-forward-sexp-func -1] 8 (#$ . 6114)]) #@65 Executes optional BODY iff variable `hs-minor-mode' is non-nil. (defalias 'hs-life-goes-on '(macro . #[(&rest body) "ÀÁ BE‡" [if hs-minor-mode progn body] 4 (#$ . 6463)])) #@195 Hides all top-level blocks, displaying only first and last lines. When done, point is repositioned at the beginning of the line, and hs-hide-hooks is called. See documentation for `run-hooks'. (defalias 'hs-hide-all #[nil "…MÁÂ!ˆŠÃedÄ#ˆebˆÅÆP ÊË !ˆÌdÍ#ƒ>Å”bˆÎÍ!ˆÁÏ T‰ \"ˆ‚*Ð ˆ)ÅyˆÁÑ!ˆÒÓ!‡" [hs-minor-mode message "hiding all blocks ..." hs-flag-region 10 0 "^" hs-block-start-regexp top-level-re count forward-comment buffer-size re-search-forward t hs-hide-block-at-point "hiding ... %d" hs-safety-is-job-n "hiding all blocks ... done" run-hooks hs-hide-hooks] 4 (#$ . 6643) nil]) #@125 Shows all top-level blocks. When done, point is unchanged, and hs-show-hooks is called. See documentation for `run-hooks'. (defalias 'hs-show-all #[nil "…ÁÂ!ˆÃedÄ#ˆÁÅ!ˆÆÇ!‡" [hs-minor-mode message "showing all blocks ..." hs-flag-region 10 "showing all blocks ... done" run-hooks hs-show-hooks] 4 (#$ . 7247) nil]) #@273 Selects a block and hides it. With prefix arg, reposition at end. Block is defined as a sexp for lispish modes, mode-specific otherwise. Comments are blocks, too. Upon completion, point is at repositioned and hs-hide-hooks is called. See documentation for `run-hooks'. (defalias 'hs-hide-block #[(&optional end) "…hÁ ‰ƒP ĘƒÅÆ!‚gÇ\n@\nA@\"ÈWƒ)ÅÉ!‚g\nA@bˆÊyˆË\n@`Ì#ˆ ƒC\nA@‚E\n@bˆÎ ˆÏÐ!‚gÑ!„\\Ó …gÔ !ˆÎ ˆÏÐ!)‡" [hs-minor-mode hs-inside-comment-p c-reg comment-end "" message "can't hide a single-line comment" count-lines 2 "not enougn comment lines to hide" -1 hs-flag-region 13 end hs-safety-is-job-n run-hooks hs-hide-hooks looking-at hs-block-start-regexp hs-find-block-beginning hs-hide-block-at-point] 5 (#$ . 7573) "P"]) #@188 Selects a block and shows it. With prefix arg, reposition at end. Upon completion, point is repositioned hs-show-hooks are called. See documetation for `hs-hide-block' and `run-hooks'. (defalias 'hs-show-block #[(&optional end) "…IÁ ‰ƒ1 ĘƒÅÆ!‚HÇ\n@\nA@È#ˆ ƒ+\nA@‚-\n@b‚HÊ !„=Ì …HÍ !ˆÎ ˆÏÐ!)‡" [hs-minor-mode hs-inside-comment-p c-reg comment-end "" message "already looking at the entire comment" hs-flag-region 10 end looking-at hs-block-start-regexp hs-find-block-beginning hs-show-block-at-point hs-safety-is-job-n run-hooks hs-show-hooks] 5 (#$ . 8328) "P"]) #@275 Shows all lines from BEG to END, without doing any block analysis. Note: hs-show-region is intended for use when when hs-show-block signals `unbalanced parentheses' and so is an emergency measure only. You may become very confused if you use this command indiscriminately. (defalias 'hs-show-region #[(beg end) "…Á\n Ä#ˆÅ ˆÆÇ!‡" [hs-minor-mode hs-flag-region beg end 10 hs-safety-is-job-n run-hooks hs-show-hooks] 4 (#$ . 8916) "r"]) #@518 Toggle hideshow minor mode. With ARG, turn hideshow minor mode on if ARG is positive, off otherwise. When hideshow minor mode is on, the menu bar is augmented with hideshow commands and the hideshow commands are enabled. The variables selective-display selective-display-ellipses are set to t. Lastly, the hooks set in hs-minor-mode-hook are called. See documentation for `run-hooks'. Turning hideshow minor mode off reverts the menu bar and the variables to default values and disables the hideshow commands. (defalias 'hs-minor-mode #[(&optional arg) "„ ?‚Â!ÃV‰ƒ7\fÅ=ƒ*ÆÇ!!ˆÉÊ @ A#ˆÌ ÌÏ ˆÐÑ!‡\fÅ=ƒFÆÒ \"!ˆÓÍ!ˆÓÎ!‡" [arg hs-minor-mode prefix-numeric-value 0 hs-emacs-type lucid set-buffer-menubar copy-sequence current-menubar add-menu nil hs-menu-bar t selective-display selective-display-ellipses hs-grok-mode-type run-hooks hs-minor-mode-hook delete kill-local-variable] 5 (#$ . 9361) "P"]) (byte-code "ÀÁ\n\"ƒ Â\fÄ„Ç ‚S Ã=ƒ%È ‚SÊËÌÇÌ!B#ˆÊÍÎ#ˆÊÏÐ#ˆÊÑÒ#ˆÊÓÔ#ˆÊÕÖ#ˆ×ž„c×BBמ„rÚÛC\"Ü×!ˆÜÝ!ˆÜÞ!ˆÜß!ˆÜà!ˆÜá!ˆâ×ãä#ˆâÝãä#ˆâÞãä#ˆâßãä#ˆâàãä#ˆâáãä#ˆåæ!‡" [string-match "xemacs\\|lucid" emacs-version lucid fsf hs-emacs-type hs-minor-mode-map make-sparse-keymap ("hideshow" ["Hide Block" hs-hide-block t] ["Show Block" hs-show-block t] ["Hide All" hs-hide-all t] ["Show All" hs-show-all t] ["Show Region" hs-show-region t]) hs-menu-bar define-key [menu-bar hideshow] "hideshow" [menu-bar hideshow hs-show-region] ("Show Region" . hs-show-region) [menu-bar hideshow hs-show-all] ("Show All" . hs-show-all) [menu-bar hideshow hs-hide-all] ("Hide All" . hs-hide-all) [menu-bar hideshow hs-show-block] ("Show Block" . hs-show-block) [menu-bar hideshow hs-hide-block] ("Hide Block" . hs-hide-block) hs-minor-mode minor-mode-map-alist minor-mode-alist append (hs-minor-mode " hs") make-variable-buffer-local hs-c-start-regexp hs-c-end-regexp hs-block-start-regexp hs-block-end-regexp hs-forward-sexp-func put permanent-local t provide hideshow] 6) emacs-19.30/lisp/hilit19.elc100666 12120 1 74051 6051027312 14050 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 00:03:41 1995 ;;; from file /home/fsf/rms/e19/lisp/hilit19.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`hilit19.el' was compiled for Emacs 19.29 or later")) #@69 * If non-nil, this inhibits progress indicators during highlighting (defvar hilit-quietly nil (#$ . -474)) #@119 * T if we should highlight all buffers as we find 'em, nil to disable automatic highlighting by the find-file hook. (defvar hilit-auto-highlight t (#$ . -588)) #@58 * auto-highlight is disabled in buffers larger than this (defvar hilit-auto-highlight-maxout 60000 (#$ . -756)) #@356 * If this is non-nil, then hilit-redraw and hilit-recenter will also rehighlight part or all of the current buffer. T will rehighlight the whole buffer, a NUMBER will rehighlight that many lines before and after the cursor, and the symbol 'visible' will rehighlight only the visible portion of the current buffer. This variable is buffer-local. (defvar hilit-auto-rehighlight t (#$ . -875)) (make-variable-buffer-local (quote hilit-auto-rehighlight)) #@164 * Cons of the form (THRESHOLD . FALLBACK), where FALLBACK is assigned to hilit-auto-rehighlight if the size of a newly opened buffer is larger than THRESHOLD. (defvar hilit-auto-rehighlight-fallback (quote (20000 . 100)) (#$ . -1343)) #@283 * T slows down highlighting but permits the user to change fonts without losing bold and italic faces... T causes hilit-lookup-face-create to dig through the frame parameters for the current window every time it's called. If you never change fonts in emacs, set this to NIL. (defvar hilit-face-check t (#$ . -1589)) #@72 If non-nil, this inhibits replacement of recenter, yank, and yank-pop. (defvar hilit-inhibit-rebinding nil (#$ . 1918)) #@71 If non-nil, this inhibits installation of hooks for Info, gnus, & vm. (defvar hilit-inhibit-hooks nil (#$ . 2044)) #@75 'mono inhibits color, 'dark or 'light indicate the background brightness. (defvar hilit-background-mode (quote light) (#$ . 2165)) #@301 If a list of modes to exclusively enable or specifically disable. The sense of the list is negated if it begins with the symbol 'not'. Set this variable before you load hilit19. Ex: (perl-mode jargon-mode c-mode) ; just perl, C, and jargon modes (not text-mode) ; all modes except text mode (defvar hilit-mode-enable-list nil (#$ . 2303)) #@187 alist of major-mode values and parsers called by hilit-rehighlight-buffer. Parsers for a given mode are IGNORED for partial rehighlights...maybe you'd like to make this more universal? (defvar hilit-parser-alist nil (#$ . 2658)) #@479 alist of major-mode values and default highlighting patterns A highlighting pattern is a list of the form (start end face), where start is a regex, end is either a regex or a match number for start, and face is the name of an entry in hilit-face-translation-table, the name of a face, or nil (which disables the pattern). Each entry in the alist is of the form: (mode . (case-fold pattern [pattern ...])) See the hilit-lookup-face-create documentation for valid face names. (defvar hilit-patterns-alist nil (#$ . 2895)) #@159 List of faces with which hilit-lookup-face-create will NOT tamper. If hilit19 is dumped into emacs at your site, you may have to set this in your init file. (defvar hilit-predefined-face-list (face-list) (#$ . 3426)) #@60 Submit feedback on hilit19 to the author: stig@hackvan.com (defalias 'hilit-submit-feedback #[nil "ÀÁ!ˆÂÃ!…7ÄÅÆÂÇ!…#ÈÉÂÊ!…\"ËÌ!…\"Í\"ÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝ°&‡" [require reporter y-or-n-p "Do you really want to submit a report on hilit19? " reporter-submit-bug-report "Jonathan Stigelman " "hilit19.el (Release 2.19)" "Do you need to include a dump hilit variables? " append (hilit-quietly hilit-inhibit-hooks hilit-background-mode hilit-mode-enable-list hilit-auto-highlight hilit-auto-highlight-maxout hilit-auto-rehighlight hilit-auto-rehighlight-fallback hilit-face-check) "Have you modified the standard patterns? " yes-or-no-p "Are your patterns *REALLY* relevant? " (hilit-parser-alist hilit-patterns-alist hilit-predefined-face-list) #[nil "ÀÁ!…ÂÃÄÅ!!Ʊ‡" [y-or-n-p "Is this a problem with font display? " "\nFrame Configuration:\n====================\n" prin1-to-string frame-configuration-to-register 70 "\n"] 4] nil "This is (check all that apply, and delete what's irrelevant):\n" " [ ] a _MASSIVE_THANK_YOU_ for writing hilit19.el\n" " [ ] An invitation to attend the next Hackers Conference\n" " [ ] You're a RIGHTEOUS HACKER, what are your rates?\n" " [ ] I've used the force and read the source, but I'M CONFUSED\n" " [ ] a PATCH. (output of 'diff -uw old.el new.el' or 'diff -cw')\n" " [ ] a SERIOUS AND REPRODUCABLE BUG that is not an EMACS bug\n" " - I *swear* that it's not already mentioned in the KNOWN BUGS\n" " - I HAVE CHECKED ftp.hackvan.com:/pub/stig/src/elisp/hilit19.el.gz\n" " for a newer release that fixes the problem.\n" " >> I HAVE ALSO CHECKED ftp.hackvan.com:/pub/stig/src/elisp/hl319.el.gz\n" " This is the alpha version...what will become hilit19 (Beta 3.0).\n" "\n" "Hey Stig, I *know* you're busy but...\n"] 20 (#$ . 3650) nil]) #@331 alist of default faces (face . (light-default dark-default mono-default)) There is no way for the user to modify this table such that it will have any effect upon the translations used by hilit19. Instead, use the function hilit-translate AFTER hilit19 has been loaded. See also the documentation for hilit-lookup-face-create. (defconst hilit-default-face-table (quote ((comment firebrick-italic moccasin italic) (include purple Plum1 bold-italic) (define ForestGreen-bold green bold) (defun blue-bold cyan-bold bold-italic) (decl RoyalBlue cyan bold) (type nil yellow nil) (keyword RoyalBlue cyan bold-italic) (label red-underline orange-underlined underline) (string grey40 orange underline) (struct black-bold white-bold bold) (glob-struct magenta Plum1 default-bold-underline) (named-param DarkGoldenrod Goldenrod underline) (crossref DarkGoldenrod Goldenrod underline) (formula Goldenrod DarkGoldenrod underline) (active-error default/pink-bold default/DeepPink-bold default-underline) (error red-bold yellow bold) (warning blue-italic green italic) (rule blue-bold-underline cyan-underline default-bold-underline) (msg-subject blue-bold yellow bold) (msg-from purple-bold green bold) (msg-header firebrick-bold cyan italic) (msg-separator black/tan-bold black/lightblue nil) (msg-quote ForestGreen pink italic) (summary-seen grey40 white nil) (summary-killed grey50 white nil) (summary-Xed OliveDrab2 green nil) (summary-deleted firebrick white italic) (summary-unread RoyalBlue yellow bold) (summary-new blue-bold yellow-bold bold-italic) (summary-current default/skyblue-bold green/dimgrey-bold reverse-default) (gnus-group-unsubscribed grey50 white nil) (gnus-group-empty nil nil nil) (gnus-group-full ForestGreen green italic) (gnus-group-overflowing firebrick red bold-italic) (dired-directory blue-bold cyan bold) (dired-link firebrick-italic green italic) (dired-ignored ForestGreen moccasin nil) (dired-deleted red-bold-italic orange bold-italic) (dired-marked purple Plum1 nil) (jargon-entry blue-bold cyan bold) (jargon-xref purple-bold Plum1 italic) (jargon-keyword firebrick-underline yellow underline))) (#$ . 5475)) #@56 alist that maps symbolic face-names to real face names (defconst hilit-face-translation-table (byte-code "À ƒ\f žA† ÃÅÆ\")‡" [x-display-color-p hilit-background-mode ((light . 1) (dark . 2)) 3 index mapcar #[(x) "@ 8B‡" [x index] 3] hilit-default-face-table] 3) (#$ . 7620)) #@339 (hilit-translate FROM TO FROM TO ...): translate each face FROM to the value of its TO face. This is like setq for faces. The function hilit-lookup-face-create will repeatedly translate until no more translations for the face exist in the translation table. See the documentation for hilit-lookup-face-create for names of valid faces. (defalias 'hilit-translate '(macro . #[(&rest args) "À G¦!„ ÃÄ!ˆÅ‰‰ ƒ8 @ A@ AAÉÊËDFB‚Ì+B‡" [zerop args 2 error "wrong number of args" nil to from cmdl hilit-associate (quote hilit-face-translation-table) quote progn] 4 (#$ . 7910)])) #@647 Get a FACE, or create it if it doesn't exist. In order for it to properly create the face, the followwing naming convention must be used: [reverse-](fgcolor[/bgcolor])[-bold][-italic][-underline] Example: (hilit-lookup-face-create 'comment-face) might create and return 'red Each color is either the name of an X color (see .../X11/lib/X11/rgb.txt), a hexadecimal specification of the form "hex-[0-9A-Fa-f]+", or "default". An optional argument, FORCE, will cause the face to be recopied from the default...which is probably of use only if you've changed fonts. See the documentation for hilit-translate and hilit-face-translation-table. (defalias 'hilit-lookup-face-create #[(face &optional force) "ÀÁ ƒ)\f\n>ƒÅÆ\n\"ˆ‚\f\nB\fž‰ƒ A‚*È\f! Ê  ÌÍ !žAÁÁÁ\fƒ\f>„„i\fÓ >ƒiƒ\fÎN˜„ÕÖ×\"ˆØÙ \"ƒ‚Ú×!ˆ Û•ÁO ØÜ \"ƒ¥Ý”…Þ ߔߕOP Û•ÁO ‚ªÅà\f\"ˆØá \"ƒÊÝ”…¸Þ ߔߕOP Û•ÁO ☃ÔÁ☃ÞÁÁãäˆ „å\fÁ #ˆæ\fØç \"\"ˆØè \"ƒé\fÁê#ˆØë \"ƒì\fÁê#ˆ.\f‡" [t nil visited trec face error "face translation loop: %S" hilit-face-translation-table symbol-name fn selected-frame frame font frame-parameters basefont fgcolor bgcolor hilit-predefined-face-list force face-list hilit-face-check copy-face default scratch-face string-match "^reverse-?" invert-face 0 "^\\(hex-\\)?\\([A-Za-z0-9]+\\)" 1 "#" 2 "bad face name %S" "^/\\(hex-\\)?\\([A-Za-z0-9]+\\)" "default" (byte-code "ÀÁ\n\"ˆÃÁ\f\"ˆÅÁ\"ˆÇÈ#‡" [set-face-foreground scratch-face fgcolor set-face-background bgcolor copy-face face put basefont] 4) ((error (byte-code "ÀÁ !\"ˆÄÅÀ‡" [message "couldn't allocate color for '%s'" symbol-name face default t error] 4))) set-face-font set-face-underline-p "underline" ".*bold" make-face-bold noerr ".*italic" make-face-italic] 6 (#$ . 8515)]) #@137 Highlight region from START to END using FACE and, optionally, PRIO. The optional 5th arg, PROP is a property to set instead of 'hilit. (defalias 'hilit-region-set-face #[(start end face-name &optional prio prop) "À \n\"Ä Å#ˆÄ †ÈÉ#ˆ\n…\"Ä Ë\n#)‡" [make-overlay start end overlay overlay-put face face-name prop hilit t prio priority] 4 (#$ . 10331)]) (put (quote hilit-region-set-face) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@70 Unhighlights the region from START to END, optionally in a QUIET way (defalias 'hilit-unhighlight-region #[(start end &optional quietly) "„\f „\fÂÃ!ˆÄƒ7 Vƒ7Wƒ7ÈÉÊ!\"ˆË!‰„)†C †CÂÌ!‡" [quietly hilit-quietly message "Unhighlighting" 0 lstart start end mapcar #[(ovr) "À Â\"…\nà !‡" [overlay-get ovr hilit delete-overlay] 3] overlays-at next-overlay-change "Done unhighlighting"] 5 (#$ . 10792) "r"]) #@297 Highlights the area of the buffer between START and END (the region when interactive). Without the optional PATTERNS argument, the pattern for major-mode is used. If PATTERNS is a symbol, then the patterns associated with that symbol are used. QUIETLY suppresses progress messages if non-nil. (defalias 'hilit-highlight-region #[(start end &optional patterns quietly) "„\f \nžA‚9ƒ\nžA@GSɉ‰‰Ä \n \fAŠŒ }ˆƒ@‰\n@ \nA@ÏÐ\n8!‰ƒ„y„yÓÔ  ;ƒvÕP‚wÖ$ˆebˆ×ØÙˆ S A‰„?*†›†›ÓÖ!.‡" [patterns major-mode hilit-patterns-alist nil 0 puke-count mstart face pend pstart p prio case-fold-search start end hilit-lookup-face-create 2 quietly hilit-quietly message "highlighting %d: %s%s" " ... " "" msg (byte-code "9ƒOÁ !‰ƒK\n@\nA\f Á Ê \" Ì Ä#ˆÌ †8ÍÎ#ˆ …EÌ Ï #)ˆ-‚)‚ ;ƒ¯ÐÁÎÁ$ƒÑ”‰bˆÐ ÁÎÁ$ƒ©Ñ•\f Á Ê \" Ì Ä#ˆÌ †–ÍÎ#ˆ …£Ì Ï #)ˆ-‚TÓuˆ‚T §ƒýÐÁÎÁ$ƒ •bˆ ” •\f Á Ê \" Ì Ä#ˆÌ †êÍÎ#ˆ …÷Ì Ï #)ˆ-‚´ÔÕ!ˆÁ‡" [pstart nil region pend face prio prop face-name end start make-overlay overlay overlay-put hilit t priority re-search-forward 0 mstart 1 error "malformed pattern"] 5) ((error (byte-code "T‰ÁVƒ !ˆ‚ÄÅ \"ˆÆ ˆÇÈ!ˆÁ‡" [puke-count 1 error msg message "Error: '%s'" ding sit-for 4] 3)))] 9 (#$ . 11226) "r"]) #@53 Re-highlights the region, optionally in a QUIET way (defalias 'hilit-rehighlight-region #[(start end &optional quietly) "Œ~ˆÀÁ\nÃÄÅ\n!\"#ÀÆÃÈÅ!\"#É\n\n#ˆË\nÌ\n$)‡" [apply min start mapcar overlay-start overlays-at max end overlay-end hilit-unhighlight-region quietly hilit-highlight-region nil] 7 (#$ . 12576) "r"]) #@53 Re-highlights the buffer, optionally in a QUIET way (defalias 'hilit-rehighlight-buffer #[(&optional quietly) " žA‰ƒ\n !ˆ‚Äed #ˆ)Ň" [major-mode hilit-parser-alist parse-fn quietly hilit-rehighlight-region nil] 5 (#$ . 12911) ""]) (defalias 'hilit-rehighlight-buffer-quietly #[nil "ÀÁ!‡" [hilit-rehighlight-buffer t] 2]) #@63 Highlight a buffer containing a news article or mail message. (defalias 'hilit-rehighlight-message #[(quietly) "ŠebˆÀÁÂÃ#ˆÄed #ˆÆe`Ç $ˆÆ`dÈ $)‡" [re-search-forward "^$" nil noerr hilit-unhighlight-region quietly hilit-highlight-region msg-header msg-body] 5 (#$ . 13244)]) (defalias (quote hilit-highlight-buffer) (quote hilit-rehighlight-buffer)) #@75 Find-file hook for hilit package. See the variable hilit-auto-highlight. (defalias 'hilit-find-file-hook #[nil "…( \nž…( \f@Vƒ\fA V?…(Ç É ˆÊ!)‡" [hilit-auto-highlight major-mode hilit-patterns-alist buffer-saved-size hilit-auto-rehighlight-fallback hilit-auto-rehighlight hilit-auto-highlight-maxout buffer-modified-p bm hilit-rehighlight-buffer set-buffer-modified-p] 2 (#$ . 13598)]) #@367 Rehighlights according to the value of hilit-auto-rehighlight, or the prefix argument if that is specified. \[hilit-repaint-command] repaint according to hilit-auto-rehighlight ^U \[hilit-repaint-command] repaint entire buffer ^U - \[hilit-repaint-command] repaint visible portion of buffer ^U n \[hilit-repaint-command] repaint n lines to either side of point (defalias 'hilit-repaint-command #[(arg) "À‰‰\f„\f \fÆ=„\fÇ=ƒ#È É Ê‚A\f§ƒ:Š\f[yˆ`)Š\fyˆ`)‚A\fƒAË ˆ …JÌ \n #+‡" [nil quietly en st arg hilit-auto-rehighlight visible - window-start window-end t hilit-rehighlight-buffer hilit-rehighlight-region] 4 (#$ . 14005) "P"]) #@183 Recenter, then rehighlight according to hilit-auto-rehighlight. If called with an unspecified prefix argument (^U but no number), then a rehighlight of the entire buffer is forced. (defalias 'hilit-recenter #[(arg) "À !ˆÂÃ!ˆÄ :!‡" [recenter arg sit-for 0 hilit-repaint-command] 2 (#$ . 14661) "P"]) #@26 Yank with rehighlighting (defalias 'hilit-yank #[(arg) "À !ˆ\fƒÅÆ Ç È#ˆÂ‰ )‡" [nil transient-mark-mode yank arg hilit-auto-rehighlight hilit-rehighlight-region region-beginning region-end t this-command] 4 (#$ . 14967) "*P"]) #@30 Yank-pop with rehighlighting (defalias 'hilit-yank-pop #[(arg) "À !ˆ\fƒÅÆ Ç È#ˆÉ‰\n)‡" [nil transient-mark-mode yank-pop arg hilit-auto-rehighlight hilit-rehighlight-region region-beginning region-end t yank this-command] 4 (#$ . 15204) "*p"]) (byte-code "„ ƒÂÃÄÅ #ˆÂÆÇÅ #ˆÂÈÉÅ #ˆÊËÌ\"ˆ ƒ,ÍÎÏÐ#ˆ„: ƒ:ÒÓÔˆÕÕ‡" [hilit-inhibit-rebinding window-system substitute-key-definition yank hilit-yank current-global-map yank-pop hilit-yank-pop recenter hilit-recenter global-set-key [33554444] hilit-repaint-command add-hook find-file-hooks hilit-find-file-hook t hilit-inhibit-hooks c (byte-code "ÀÁÂ\"‡" [mapcar #[(hook) "À Â\"‡" [add-hook hook hilit-rehighlight-buffer-quietly] 3] (Info-selection-hook vm-summary-pointer-hook vm-preview-message-hook vm-show-message-hook rmail-show-message-hook mail-setup-hook mh-show-mode-hook dired-after-readin-hook)] 3) ((error (byte-code "ÀÁ\n\"ˆÃ ˆÄÅ!‡" [message "Error loading highlight hooks: %s" c ding sit-for 1] 3))) nil hilit-patterns-alist] 4) #@67 creates, or destructively replaces, the pair (key . val) in alist (defalias 'hilit-associate #[(alist key val) "Á\n!ž‰ƒ \f¡‚\n\fBÁ\n!BL)‡" [key eval alist oldentry val] 5 (#$ . 16211)]) #@153 Sets the default highlighting patterns for MODE to PATTERNS. See the variable hilit-mode-enable-list. Takes optional arguments PARSE-FN and CASE-FOLD. (defalias 'hilit-set-mode-patterns #[(modelist patterns &optional parse-fn case-fold) "ÀÁ\n\"ˆ \nB\f:„\fCÅ@Ç= ÀÊ\f\"*‡" [mapcar #[(p) "@;…A@?…AÁ ‡" [p 0] 2] patterns case-fold modelist nil hilit-mode-enable-list not flip ok #[(m) "?† > ƒ\n?\n…$\fƒÅÆ \f#ˆÅÇ #‡" [hilit-mode-enable-list m ok flip parse-fn hilit-associate hilit-parser-alist hilit-patterns-alist patterns] 4]] 3 (#$ . 16411)]) #@116 Highlight pstart with face for the current major-mode. Optionally, place the new pattern first in the pattern list (defalias 'hilit-add-pattern #[(pstart pend face &optional mode first) "Ášƒ\nÂÃ!ˆ\fÁšƒÅ‚ ÆÇ\f\"ƒ È\f! „)\n   žA\f\fE ‰„GÏ  C\"ˆ‚`ƒY AB¡ˆ‚` C¤ˆ*t…gÑ ‡" [pstart "" error "Must specify starting regex" pend 0 string-match "^[0-9]+$" string-to-int mode major-mode hilit-patterns-alist face new-pat old-patterns hilit-set-mode-patterns first hilit-rehighlight-buffer] 5 (#$ . 16990) "sPattern start regex: \nsPattern end regex (default none): \nxFace: "]) #@322 looks for a string and returns (start . end) or NIL. The argument QCHAR is the character that would precede a character constant double quote. Finds strings delimited by double quotes. The first double quote may not be preceded by QCHAR and the closing double quote may not be preceded by an odd number of backslashes. (defalias 'hilit-string-find #[(qchar) "À‰ÃÄÀÅ#ƒÇ”‰Sf=„ÃÄÀÅ#ƒ8Š`ÈuˆÉÀxˆÊuˆ `Z˦ÇU)ƒ …?\n B*‡" [nil en st search-forward "\"" t qchar 0 -1 "\\\\" 1 2] 4 (#$ . 17598)]) (byte-code "ÀÁÂÃÈÉÊ \fË$\"ˆÈÌÊ \fÍ%\"ˆÈÎÊ \fÏ%\"ˆ,ÈÐÑ\"ˆÈÒÓ\"ˆÈÔÕÖ×$ˆÈØÙÖ×$ˆÈÚÛ\"ˆÈÜÝ\"ˆÈÞß\"ˆÈàá\"ˆÈâã\"ˆä%æ'Ê%'\"(Èé%\"ˆÈê'\"ˆÈë(ì#ˆ+Èíî\"ˆÈïð\"ˆÈñò\"ˆÈóô\"ˆÈõö\"ˆÈ÷øÖ×$ˆÈùú\"ˆÈûÊüýþÿ@A#BQCBC\"\"ˆÈDE\"ˆÈFG\"ˆÈHI\"ˆÈJK\"ˆÈLMÖ×$ˆÈNO\"ˆPQ!‡" [(("/\\*" "\\*/" comment)) (("//.*$" nil comment) ("^/.*$" nil comment)) ((hilit-string-find 39 string)) (("^#[ ]*\\(undef\\|define\\).*$" "[^\\]$" define) ("^#.*$" nil include)) preprocessor strings c++-comments comments hilit-set-mode-patterns (c-mode c++-c-mode elec-c-mode) append (("^\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) ("^\\(typedef\\|struct\\|union\\|enum\\).*$" nil decl) ("[ \n ({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\)\\([ ]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n ;()]\\)" nil type) ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\)\\>[^_]" 1 keyword)) c++-mode (("^\\(\\(\\w\\|[$_]\\)+::\\)?\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) ("^\\(\\(\\w\\|[$_]\\)+[ ]*::[ ]*\\)?\\(\\(\\w\\|[$_]\\)+\\|operator.*\\)\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) ("^\\(template\\|typedef\\|struct\\|union\\|class\\|enum\\|public\\|private\\|protected\\).*$" nil decl) ("[ \n ({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\|class\\)\\([ ]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n ;()]\\)" nil type) ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\|public\\|protected\\|private\\|delete\\|new\\)\\>[^_]" 1 keyword)) (objc-mode objective-C-mode) (("^\\(\\(\\w\\|[$_]\\)+::\\)?\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) ("^\\(\\(\\w\\|[$_]\\)+[ ]*::[ ]*\\)?\\(\\(\\w\\|[$_]\\)+\\|operator.*\\)\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) ("^\\(template\\|typedef\\|struct\\|union\\|class\\|enum\\|public\\|private\\|protected\\).*$" nil decl) ("[ \n ({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\|class\\)\\([ ]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n ;()]\\)" nil type) ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\|public\\|protected\\|private\\|interface\\|implementation\\|end\\|super\\|self\\)\\>[^_]" 1 keyword)) perl-mode (("\\s #.*$" nil comment) ("^#.*$" nil comment) ("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string) ("^\\(__....?__\\|\\s *\\sw+:\\)" nil label) ("^require.*$" nil include) ("^package.*$" nil decl) ("^\\s *sub\\s +\\(\\w\\|[_']\\)+" nil defun) ("\\b\\(do\\|if\\|unless\\|while\\|until\\|else\\|elsif\\|for\\|foreach\\|continue\\|next\\|redo\\|last\\|goto\\|return\\|die\\|exit\\)\\b" nil keyword)) ada-mode (("--.*$" nil comment) ("[ \n]procedure[ ]" "\\([ ]\\(is\\|renames\\)\\|);\\)" glob-struct) ("[ \n]task[ ]" "[ ]is" glob-struct) ("[ \n]function[ ]" "return[ ]+[A-Za-z_0-9]+[ ]*\\(is\\|;\\|renames\\)" glob-struct) ("[ \n]package[ ]" "[ ]\\(is\\|renames\\)" glob-struct) ("^[ ]*private[ \n]" nil glob-struct) ("^end.*$" ";" glob-struct) ("[ \n ]\\(in\\|out\\|select\\|if\\|else\\|case\\|when\\|and\\|or\\|not\\|accept\\|loop\\|do\\|then\\|elsif\\|else\\|for\\|while\\|exit\\)[ \n ;]" nil struct) ("[ \n ]\\(begin\\|end\\|declare\\|exception\\|generic\\|raise\\|return\\|package\\|body\\)[ \n ;]" nil struct) ("^[ ]*\\(type\\|subtype\\).*$" ";" decl) ("[ ]+is record.*$" "end record;" decl) ("^[ ]*\\(with\\|pragma\\|use\\)" ";" include) ("[A-Za-z_0-9.]+[ ]*=>" nil named-param) ("\"" ".*\"" string)) fortran-mode (("^[*Cc].*$" nil comment) ("'[^'\n]*'" nil string) ("\\(^[ ]*[0-9]+\\|[ ]continue[ \n]\\|format\\)" nil define) ("[ ]\\(do\\|do[ ]*[0-9]+\\|go[ ]*to[ ]*[0-9]+\\|end[ ]*do\\|if\\|else[ ]*if\\|then\\|else\\|end[ ]*if\\)[ \n(]" nil define) ("[ ]\\(call\\|program\\|subroutine\\|function\\|stop\\|return\\|end\\|include\\)[ \n]" nil include) ("[ ]\\(parameter[ \n ]*([^)]*)\\|data\\|save\\|common[ \n]*/[^/]*/\\)" nil decl) ("^ ." nil type) ("implicit[ ]*none" nil decl) ("\\([ ]\\|implicit[ ]*\\)\\(dimension\\|integer\\|real\\|double[ ]*precision\\|character\\|logical\\|complex\\|double[ ]*complex\\)\\([*][0-9]*\\|[ \n]\\)" nil keyword)) nil case-insensitive (m2-mode modula-2-mode) (("(\\*" "\\*)" comment) (hilit-string-find 92 string) ("^[ ]*PROCEDURE[ ]+\\w+[^ (;]*" nil defun) ("\\<\\(RECORD\\|ARRAY\\|OF\\|POINTER\\|TO\\|BEGIN\\|END\\|FOR\\|IF\\|THEN\\|ELSE\\|ELSIF\\|CASE\\|WHILE\\|DO\\|MODULE\\|FROM\\|RETURN\\|IMPORT\\|EXPORT\\|VAR\\|LOOP\\|UNTIL\\|\\DEFINITION\\|IMPLEMENTATION\\|AND\\|OR\\|NOT\\|CONST\\|TYPE\\|QUALIFIED\\)\\>" nil keyword)) prolog-mode (("/\\*" "\\*/" comment) ("%.*$" nil comment) (":-" nil defun) ("!" nil label) ("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string) ("\\b\\(is\\|mod\\)\\b" nil keyword) ("\\(->\\|-->\\|;\\|==\\|\\\\==\\|=<\\|>=\\|<\\|>\\|=\\|\\\\=\\|=:=\\|=\\.\\.\\|\\\\\\+\\)" nil decl) ("\\(\\[\\||\\|\\]\\)" nil include)) (LaTeX-mode japanese-LaTeX-mode SliTeX-mode japanese-SliTeX-mode FoilTeX-mode latex-mode) (("[^\\]%.*$" nil comment) ("\\\\\\(sub\\)*\\(paragraph\\|section\\)\\(*\\|\\[.*\\]\\)?{" "}" keyword) ("\\\\\\(chapter\\|part\\)\\(*\\|\\[.*\\]\\)?{" "}" keyword) ("\\\\footnote\\(mark\\|text\\)?{" "}" keyword) ("\\\\[a-z]+box" nil keyword) ("\\\\\\(v\\|h\\)space\\(*\\)?{" "}" keyword) ("\\\\\\(re\\)?new\\(environment\\|command\\){" "}" defun) ("\\\\new\\(length\\|theorem\\|counter\\){" "}" defun) ("\\\\\\(setlength\\|settowidth\\|addtolength\\|setcounter\\|addtocounter\\)" nil define) ("\\\\\\(title\\|author\\|date\\|thanks\\){" "}" define) ("\\\\documentstyle\\(\\[.*\\]\\)?{" "}" decl) ("\\\\\\(begin\\|end\\|nofiles\\|includeonly\\){" "}" decl) ("\\\\\\(raggedright\\|makeindex\\|makeglossary\\|maketitle\\)\\b" nil decl) ("\\\\\\(pagestyle\\|thispagestyle\\|pagenumbering\\){" "}" decl) ("\\\\\\(normalsize\\|small\\|footnotesize\\|scriptsize\\|tiny\\|large\\|Large\\|LARGE\\|huge\\|Huge\\)\\b" nil decl) ("\\\\\\(appendix\\|tableofcontents\\|listoffigures\\|listoftables\\)\\b" nil decl) ("\\\\\\(bf\\|em\\|it\\|rm\\|sf\\|sl\\|ss\\|tt\\)\\b" nil decl) ("\\\\item\\(\\[[^]]*\\]\\)?" nil label) ("\\\\caption\\(\\[[^]]*\\]\\)?{" "}" label) ("[^\\]\\\\(" "\\\\)" formula) ("[^\\]\\\\\\[" "\\\\\\]" formula) ("[^\\$]\\($\\($[^$]*\\$\\|[^$]*\\)\\$\\)" 1 formula) ("\\\\\\(include\\|input\\|bibliography\\){" "}" include) ("``" "''" string) ("\\\\\\(\\(no\\)?cite\\|\\(page\\)?ref\\|label\\|index\\|glossary\\){" "}" crossref)) bibtex-mode (("%.*$" nil comment) ("@[a-zA-Z]+" nil keyword) ("{[ ]*[-a-z:_A-Z0-9]+," nil label) ("^[ ]*[a-zA-Z]+[ ]*=" nil define)) compilation-mode (("^[-_.\"A-Za-z0-9]+\\(:\\|, line \\)[0-9]+: warning:.*$" nil warning) ("^[-_.\"A-Za-z0-9]+\\(:\\|, line \\)[0-9]+:.*$" nil error)) makefile-mode (("^#.*$" nil comment) ("[^$]#.*$" nil comment) ("^[^ \n]*%[^ \n]*[ ]*::?[ ]*[^ \n]*[ ]*\\(#.*\\)?$" nil rule) ("^[.][A-Za-z][A-Za-z]?..*$" nil rule) ("^[_A-Za-z0-9]+[ ]*+?=" nil define) ("\\( \\|:=\\)[_A-Za-z0-9]+[ ]*\\+=" nil define) ("\\$\\([^ \n{(]\\|[{(]@?[_A-Za-z0-9:.,%/=]+[)}]\\)" nil keyword) ("^[A-Za-z0-9.,/_-]+[ ]*:.*$" nil defun) ("^include " nil include)) (("^Subject:.*$" nil msg-subject) ("^From:.*$" nil msg-from) ("^--text follows this line--$" nil msg-separator) ("^[A-Za-z][A-Za-z0-9-]+:" nil msg-header)) header-patterns (("^\\(In article\\|[ ]*\\w*[]<>}|]\\).*$" nil msg-quote)) body-patterns message-patterns msg-header msg-body (vm-mode text-mode mail-mode rmail-mode gnus-article-mode news-reply-mode mh-show-mode) hilit-rehighlight-message gnus-group-mode (("^ U.*$" nil gnus-group-unsubscribed) ("^\\*? +[01]?[0-9]:.*$" nil gnus-group-empty) ("^ +[2-9][0-9]:.*$" nil gnus-group-full) ("^ +[0-9][0-9][0-9]+:.*$" nil gnus-group-overflowing)) vm-summary-mode (("^ .*$" nil summary-seen) ("^->.*$" nil summary-current) ("^ D.*$" nil summary-deleted) ("^ U.*$" nil summary-unread) ("^ N.*$" nil summary-new)) (emacs-lisp-mode lisp-interaction-mode) ((";.*" nil comment) (hilit-string-find 92 string) ("^\\s *(def\\(un\\|macro\\|advice\\|alias\\|subst\\)[ \n]" "\\()\\|nil\\)" defun) ("^\\s *(defvar\\s +\\S +" nil decl) ("^\\s *(defconst\\s +\\S +" nil define) ("^\\s *(\\(provide\\|require\\|\\(auto\\)?load\\).*$" nil include) ("\\s *\\&\\(rest\\|optional\\)\\s *" nil keyword) ("(\\(let\\*?\\|cond\\|if\\|or\\|and\\|map\\(car\\|concat\\)\\|prog[n1*]?\\|while\\|lambda\\|function\\|set\\([qf]\\|car\\|cdr\\)?\\|nconc\\|eval-when-compile\\|condition-case\\|unwind-protect\\|catch\\|throw\\|error\\)[ \n]" 1 keyword)) (lisp-mode ilisp-mode) ((";.*" nil comment) ("#|" "|#" comment) (hilit-string-find 92 string) ("^\\s *(def\\(un\\|macro\\|advice\\|subst\\|method\\)\\s " "\\()\\|nil\\)" defun) ("^\\s *(\\(def\\(var\\|type\\|parameter\\)\\|declare\\)\\s +\\S +" nil decl) ("^\\s *(def\\(const\\(ant\\)?\\|class\\|struct\\)\\s \\S +[ \n]+" nil define) ("^\\s *(\\(provide\\|require\\|\\(auto\\)?load\\).*$" nil include) ("[ ]\\&\\(key\\|rest\\|optional\\|aux\\)\\s *" nil keyword) ("(\\(let\\*?\\|locally\\|cond\\|if\\*?\\|or\\|and\\|map\\(car\\|c[ao]n\\)?\\|prog[nv1*]?\\|while\\|when\\|unless\\|do\\(\\*\\|list\\|times\\)\\|list\\|lambda\\|function\\|values\\|set\\([qf]\\|car\\|cdr\\)?\\|rplac[ad]\\|nconc\\|block\\|go\\|return\\(-from\\)?\\|[ec]?\\(type\\)?case\\|multiple-value-\\(bind\\|setq\\|list\\|call\\|prog1\\)\\|unwind-protect\\|handler-case\\|catch\\|throw\\|eval-when\\(-compile\\)?\\)[ \n]" 1 keyword)) plain-tex-mode (("^%%.*$" nil comment) ("{\\\\em\\([^}]+\\)}" nil comment) ("\\(\\\\\\w+\\)" nil keyword) ("{\\\\bf\\([^}]+\\)}" nil keyword) ("^[ \n]*\\\\def[\\\\@]\\(\\w+\\)" nil defun) ("\\\\\\(begin\\|end\\){\\([A-Za-z0-9\\*]+\\)}" nil defun) ("\\$\\([^$]*\\)\\$" nil string)) nroff-mode (("^\\.[\\][\\\"].*$" nil comment) ("^\\.so .*$" nil include) ("^\\.[ST]H.*$" nil defun) ("\"" "[^\\]\"" string) ("^\\.[A-Z12\\\\].*$" nil define) ("\\([\\][^ ]*\\)" nil keyword) ("^\\.[A-Z].*$" nil keyword)) texinfo-mode (("^\\(@c\\|@comment\\)\\>.*$" nil comment) ("@\\(emph\\|strong\\|b\\|i\\){[^}]+}" nil comment) ("@\\(file\\|kbd\\|key\\){[^}]+}" nil string) ("^\\*.*$" nil defun) ("@\\(if\\w+\\|format\\|item\\)\\b.*$" nil defun) ("@end +[A-Za-z0-9]+[ ]*$" nil defun) ("@\\(samp\\|code\\|var\\){[^}]+}" nil defun) ("@\\w+\\({[^}]+}\\)?" nil keyword)) dired-mode (("^D.*$" nil dired-deleted) ("^\\*.*$" nil dired-marked) ("^ d.*$" nil dired-directory) ("^ l.*$" nil dired-link) ("^ -.*#.*#$" nil dired-ignored)) "^ .*\\(" mapconcat regexp-quote completion-ignored-extensions "\\|" "\\)$" (nil dired-ignored) jargon-mode (("^:[^:]*:" nil jargon-entry) ("{[^}]*}+" nil jargon-xref)) Info-mode (("^\\* [^:]+:+" nil jargon-entry) ("\\*[Nn]ote\\b[^:]+:+" nil jargon-xref) (" \\(Next\\|Prev\\|Up\\):" nil jargon-xref) ("- \\(Variable\\|Function\\|Macro\\|Command\\|Special Form\\|User Option\\):.*$" nil jargon-keyword)) calendar-mode (("[A-Z][a-z]+ [0-9]+" nil define) ("S M Tu W Th F S" nil label)) asm-mode (("/\\*" "\\*/" comment) ("^#[ ]*\\(undef\\|define\\).*$" "[^\\]$" define) ("^#.*$" nil include) ("^.+:" nil defun) ("^[ ]*\\..*$" nil decl) ("\\$[a-z0-9]+" nil string) ("^[ ]*[a-z]+" nil struct)) pascal-mode (("(\\*" "\\*)" comment) ("{" "}" comment) ("^#.*$" nil include) ("^[ ]*\\(procedure\\|function\\)[ ]+\\w+[^ (;]*" nil defun) ("\\<\\(program\\|begin\\|end\\)\\>" nil defun) ("\\<\\(external\\|forward\\)\\>" nil include) ("\\<\\(label\\|const\\|type\\|var\\)\\>" nil define) ("\\<\\(record\\|array\\|file\\)\\>" nil type) ("\\<\\(of\\|to\\|for\\|if\\|then\\|else\\|case\\|while\\|do\\|until\\|and\\|or\\|not\\|with\\|repeat\\)\\>" nil keyword)) icon-mode (("#.*$" nil comment) ("\"[^\\\"]*\\(\\\\.[^\\\"]*\\)*\"" nil string) ("^[ ]*procedure[ ]+\\w+[ ]*(" ")" defun) ("^[ ]*record.*(" ")" include) ("^[ ]*\\(global\\|link\\)[ \n]+[A-Za-z_0-9]+\\([ \n]*,[ \n]*[A-Za-z_0-9]+\\)*" nil include) ("^[ ]*\\(local\\|static\\)[ \n]+[A-Za-z_0-9]+\\([ \n]*,[ \n]*[A-Za-z_0-9]+\\)*" nil decl) ("\\<\\(initial\\|end\\)\\>" nil glob-struct) ("\\<\\(while\\|until\\|return\\|every\\|if\\|then\\|else\\|to\\|case\\|of\\|suspend\\|create\\|do\\|repeat\\|break\\)\\>" nil keyword)) provide hilit19] 9) emacs-19.30/lisp/hippie-exp.elc100666 13437 1 45227 6043465560 15010 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:52:27 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/hippie-exp.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`hippie-exp.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!„ÂÁ BÀÄ!„Å Ä BÀÆ!„#Å Æ BÀÇ!„0ÈÇ BÀÉ!„=È É BÀÊ!„JÈ\nÊ BÀË!„XÅ  Ë BÀÌ!„eÈ\fÌ BÀÍ!„rÈ Í BÀÎ!„ÈÎ BÀÏ!„ŒÈÏ BÀÐ!„™ÈÐ Bȇ" [boundp he-num -1 current-load-list he-string-beg make-marker he-string-end he-search-string nil he-expand-list he-tried-table he-search-loc he-search-loc2 he-search-bw he-search-bufs he-searched-n-bufs he-search-window] 2) #@174 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-try-functions-list (quote (try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol)) (#$ . 887)) #@68 *Non-nil makes `hippie-expand' output which function it is trying. (defvar hippie-expand-verbose t (#$ . -1379)) #@101 *The maximum number of buffers (apart from the current) searched. If nil, all buffers are searched. (defvar hippie-expand-max-buffers nil (#$ . -1499)) #@153 *A list specifying which buffers not to search (if not current). Can contain both regexps matching buffer names (as strings) and major modes (as atoms) (defvar hippie-expand-ignore-buffers (quote ("^ \\*.*\\*$" dired-mode)) (#$ . -1658)) #@430 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. (defalias 'hippie-expand #[(arg) "ƒ¨ƒ˜ÁVƒ˜\nÃU†\f š?‰ƒ$Ãǃ3„5É ˆ‚5Á\n\\Á]‰\n GY„\\Ì\n 8\n\nUC\"„\\\nT‰\n‚=\n)\n GYƒÃƒvÍÎ!ˆ‚zÍÏ!ˆÐ ‚–…–ÒÓ !?…–ÍÔÕ\n 8!P!)‡\nÁY…¼Ö!p=…¼ÃÉ ˆ…¼ÒÓ !?…¼ÍØ!‡" [arg 0 he-num -1 this-command last-command first nil he-tried-table he-reset-string i hippie-expand-try-functions-list apply message "No expansion found" "No further expansions found" ding hippie-expand-verbose window-minibuffer-p selected-window "Using " prin1-to-string marker-buffer he-string-beg "Undoing expansions"] 6 (#$ . 1903) "P"]) (defalias 'he-init-string #[(beg end) " “ˆ \f“ˆ \f{‰‡" [he-string-beg beg nil he-string-end end he-search-string] 3]) (defalias 'he-reset-string #[nil "À \nbˆ cˆ`\f|ˆ b)‡" [point-marker newpos he-string-beg he-search-string he-string-end] 2]) (defalias 'he-substitute-string #[(str &optional trans-case) "… … \nà Äbˆƒ!È \n\"‚#\n‰ B cˆ`\f|ˆb+‡" [trans-case case-replace case-fold-search point-marker nil subst newpos he-string-beg he-transfer-case he-search-string str he-tried-table he-string-end] 4]) (defalias 'he-capitalize-first #[(str) "À ÂŽÃÄ \"ƒ$ —Æ”‰ H–Iˆ*‚% *‡" [match-data match-data ((store-match-data match-data)) string-match "\\Sw*\\(\\sw\\).*" str 1 no res] 5]) (defalias 'he-ordinary-case-p #[(str) "‰—˜†‰–˜†Á!˜†Â!˜‡" [str capitalize he-capitalize-first] 3]) (defalias 'he-transfer-case #[(from-str to-str) " ÂG G^O˜ƒ ‡Ã !„ ‡‰—˜ƒ! —‡‰–˜ƒ+ –‡Ä!˜ƒ7Ä !‡Å!˜ƒCÅ !‡ ‡" [from-str to-str 0 he-ordinary-case-p he-capitalize-first capitalize] 5]) (defalias 'he-string-member #[(str lst &optional trans-case) "… ƒ\nƒ ƒÄ \"‚‡" [str trans-case case-replace case-fold-search he-transfer-case he-search-string lst] 3]) (defalias 'he-regexp-member #[(str lst) "ƒ@;ƒÁ@\n\"„A‰„‡" [lst string-match str] 4]) #@172 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. (defalias 'make-hippie-expand-function '(macro . #[(try-list &optional verbose) "ÀÁÂÃÄÅÆ!È#PÉÊËDÌ DDÎBB¯D‡" [function lambda (arg) "Try to expand text before point, using the following functions: \n" mapconcat prin1-to-string eval try-list ", " (interactive "P") let hippie-expand-try-functions-list hippie-expand-verbose verbose ((hippie-expand arg))] 9 (#$ . 4227)])) #@243 Try to complete text as a file name. 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. (defalias 'try-complete-file-name #[(old) "„IÁ `\"ˆÃ\f!ÅÆ\f!†Ç! Ê  \"„*  B \fÇš„EÌ!ƒEÍÎ \"Ï\"‚HÑ*ƒaÊ@ \"ƒaA‰„N„oƒmÒ ˆÑ‡ÓÆ\f!@\"Õ!ˆ@ AB A)Ö‡" [old he-init-string he-file-name-beg he-file-name-nondirectory he-search-string expand-file-name he-file-name-directory "" dir-part name-part he-string-member he-tried-table he-file-directory-p sort file-name-all-completions string-lessp he-expand-list nil he-reset-string he-concat-directory-file-name filename he-substitute-string t] 5 (#$ . 4781)]) #@214 Try to complete text as a file name, as many characters as unique. The argument OLD has to be nil the first call of this function. It returns t if a unique, possibly partial, completion is found, nil otherwise. (defalias 'try-complete-file-name-partially #[(old) "À\n„KÃÄ `\"ˆÅ!ÇÈ!†É!\n Éš„3Ì\n!ƒ3Í \n\" Î=„H  ˜„HÏ \"ƒJÀ* „Z\nƒVÑ ˆÀ‚qÒÈ! \"Ô!ˆ AB)Î)‡" [nil expansion old he-init-string he-file-name-beg he-file-name-nondirectory he-search-string expand-file-name he-file-name-directory "" dir-part name-part he-file-directory-p file-name-completion t he-string-member he-tried-table he-reset-string he-concat-directory-file-name filename he-substitute-string] 4 (#$ . 5580)]) #@65 Characters that are considered part of the file name to expand. (defvar he-file-name-chars (byte-code "Á>ƒ‡Ã>ƒćŇ" [system-type (vax-vms axp-vms) "-a-zA-Z0-9_/.,~^#$+=:\\[\\]" (ms-dos ms-windows) "-a-zA-Z0-9_/.,~^#$+=:\\\\" "-a-zA-Z0-9_/.,~^#$+="] 2) (#$ . 6302)) (defalias 'he-file-name-beg #[nil "ŠÁxˆ`)‡" [he-file-name-chars nil] 2]) #@72 Fix to make `file-name-nondirectory' work for hippie-expand under VMS. (defalias 'he-file-name-nondirectory #[(file) "Á>ƒ !ÅÆ\f\"ƒÇ\fȔȕOP‚\f)‡Â !‡" [system-type (axp-vms vax-vms) file-name-nondirectory file n string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" "[." 2] 4 (#$ . 6654)]) #@69 Fix to make `file-name-directory' work for hippie-expand under VMS. (defalias 'he-file-name-directory #[(file) "Á>ƒ' !Ä !ÇÈ\"ƒ$ ɔɕOÊQ‚% *‡Ä !‡" [system-type (axp-vms vax-vms) file-name-nondirectory file file-name-directory d n string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" 1 "]"] 4 (#$ . 6949)]) #@66 Fix to make `file-directory-p' work for hippie-expand under VMS. (defalias 'he-file-directory-p #[(file) "Á>ƒ !† ÄP!‡Â !‡" [system-type (vax-vms axp-vms) file-directory-p file "[000000]" dir-part] 3 (#$ . 7264)]) #@77 Try to slam together two parts of a file specification, system dependently. (defalias 'he-concat-directory-file-name #[(dir-part name-part) "Á>ƒ)\nÃÄOŘƒ$ÇÈOɘƒ$\nÇÃOÊÄOP‡\nP‡Ë>ƒUÌÍ\n\"ƒPÌÎ\n\"„P‰GSHÏUƒP‰GSÐIˆ\nP‡\nP‡" [system-type (axp-vms vax-vms) dir-part -1 nil "]" name-part 0 2 "[." 1 (ms-dos ms-windows) string-match "\\\\" "/" 47 92] 4 (#$ . 7490)]) #@252 Try to complete word as an Emacs Lisp symbol. 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. (defalias 'try-complete-lisp-symbol #[(old) "„'Á `\"ˆÃ\f \"„\f B\fÆš?…%ÇÈ\f Ê#Ë\"\f\fƒ>Ã\f@ \"ƒ>\fA‰\f„,\f„LƒJÍ ˆÎ‡Ï\f@!ˆ\fA\fЇ" [old he-init-string he-lisp-symbol-beg he-string-member he-search-string he-tried-table "" sort all-completions obarray #[(sym) "À !† !†à !‡" [boundp sym fboundp symbol-plist] 2] string-lessp he-expand-list he-reset-string nil he-substitute-string t] 6 (#$ . 7878)]) #@218 Try to complete as an Emacs Lisp symbol, as many characters as unique. The argument OLD has to be nil the first call of this function. It returns t if a unique, possibly partial, completion is found, nil otherwise. (defalias 'try-complete-lisp-symbol-partially #[(old) "À\n„/ÃÄ `\"ˆ Ƙ„Ç É# Ê=„- ˜„-Ë \f\"ƒ/À „>\nƒ:Í ˆÀ‚CÎ !ˆÊ)‡" [nil expansion old he-init-string he-lisp-symbol-beg he-search-string "" try-completion obarray #[(sym) "À !† !†à !‡" [boundp sym fboundp symbol-plist] 2] t he-string-member he-tried-table he-reset-string he-substitute-string] 4 (#$ . 8561)]) (defalias 'he-lisp-symbol-beg #[nil "ÀŠ Âxˆ`*‡" ["-a-zA-Z0-9_." skips nil] 2]) #@272 Try to complete the current line to an entire line in the buffer. 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. (defalias 'try-expand-line #[(old) "ÀÁp!…\n „ÆÇ !`\"ˆ À“ˆÊ \fÍš„aŠ ƒKbˆÎ\f Ê#`À“ˆ\f„KÀ“ˆÀ \f„`bˆÎ\f À#`À“ˆ)\f„p ƒlÐ ˆÀ‚vÑ\fÊ\"ˆÊ*‡" [nil get-buffer-process comint-prompt-regexp strip-prompt expansion old he-init-string he-line-beg he-search-loc he-string-beg t he-search-bw he-search-string "" he-line-search he-string-end he-reset-string he-substitute-string] 4 (#$ . 9244)]) #@269 Try to complete the current line, 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. (defalias 'try-expand-line-all-buffers #[(old) "ÀÁp!…\np „,ÉÊ!`\"ˆË \fÍÐ\f@“ˆÒš„±\fƒ±„±ƒJWƒ±\f@qˆp =„¡>„¡Ö× \"„¡ŠbˆÁp!…r\n\fØÀ#)`À“ˆ„\fA\fTÐ\f@“ˆ)‚3\fA\fÐ\f@“ˆ‚3 qˆ„ŃÁÙ ˆÀ‚ÌÚÛ\"ˆÛ,‡" [nil get-buffer-process comint-prompt-regexp case-fold-search orig-case-fold-search buf strip-prompt expansion old he-init-string he-line-beg buffer-list he-search-bufs 0 he-searched-n-bufs he-search-loc 1 he-search-string "" hippie-expand-max-buffers major-mode hippie-expand-ignore-buffers he-regexp-member buffer-name he-line-search he-reset-string he-substitute-string t] 4 (#$ . 9935)]) (defalias 'he-line-search #[(str strip-prompt reverse) "À „7\nƒÃÄ \"ÀÇ#‚ÈÄ \"ÀÇ#ƒ7ɔɕ{Ê  Ç#ƒÀ‰ƒ )‡" [nil result reverse re-search-backward he-line-search-regexp str strip-prompt t re-search-forward 2 he-string-member he-tried-table] 5]) (defalias 'he-line-beg #[(strip-prompt) "ŠÀÁ \"ŠÄyˆ`)Å#ƒÆ”‚`)‡" [re-search-backward he-line-search-regexp "" strip-prompt 0 t 2] 4]) (defalias 'he-line-search-regexp #[(pat strip-prompt) "ƒÁ\nÃÄ !Æ°‡ÇÄ !ÆQ‡" [strip-prompt "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\(" regexp-quote pat "[^\n]*[^ \n]\\)" "^\\(\\s-*\\)\\("] 5]) #@255 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. (defalias 'try-expand-list #[(old) "À\n„ÃÄ `\"ˆ À“ˆÇ Êš„PŠƒ= bˆË Ç\" `À“ˆ „= \fÀ“ˆÀ „O bˆË À\" `À“ˆ) „_\nƒ[Í ˆÀ‚eÎ Ç\"ˆÇ)‡" [nil expansion old he-init-string he-list-beg he-search-loc he-string-beg t he-search-bw he-search-string "" he-list-search he-string-end he-reset-string he-substitute-string] 3 (#$ . 11465)]) #@269 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. (defalias 'try-expand-list-all-buffers #[(old) "Àp  „ÆÇ `\"ˆÈ  Ê \fÍ @“ˆÏš„– ƒ–\f„–ƒ< Wƒ– @qˆp =„†>„†ÓÔ \"„†Š\fbˆ\nÕÀ\")\f`À“ˆ\f„‚ A  T \fÍ @“ˆ)‚& A \fÍ @“ˆ‚& qˆ\f„¨ ƒ¤Ö ˆÀ‚®×\fØ\"ˆØ+‡" [nil case-fold-search orig-case-fold-search buf expansion old he-init-string he-list-beg buffer-list he-search-bufs 0 he-searched-n-bufs he-search-loc 1 he-search-string "" hippie-expand-max-buffers major-mode hippie-expand-ignore-buffers he-regexp-member buffer-name he-list-search he-reset-string he-substitute-string t] 3 (#$ . 12067)]) (defalias 'he-list-search #[(str reverse) "À‰‰‰\f„W ƒÆÀÈ#‚ÉÀÈ#ƒW`Ê”‰bˆÀÀË̈ ƒ>` Vƒ>È „Q `{Î\fÈ#ƒQÀ\nbˆ‚\f,‡" [nil err pos beg result reverse search-backward str t search-forward 0 (forward-list 1) ((error (byte-code "ÀÀ‡" [t err] 1))) he-string-beg he-string-member he-tried-table] 5]) (defalias 'he-list-beg #[nil "ŠÀÁˆ`)‡" [nil (backward-up-list 1) ((error))] 3]) #@268 Try to expand word before point according to all abbrev tables. The argument OLD has to be nil the first call of this function, and t for subsequent calls (for further possible expansions of the same string). It returns t if a new expansion is found, nil otherwise. (defalias 'try-expand-all-abbrevs #[(old) "„Á `\"ˆ Äš?…ÅÆÇÈ \"\"\n\nƒ:\n@ƒ1Ë\n@\fÍ#ƒ:\nA‰\n„ \n„HƒFÎ ˆÏ‡Ð\n@Í\"ˆ\nA\n͇" [old he-init-string he-dabbrev-beg he-search-string "" mapcar #[(sym) "À !…Âà !!…Ä —à !\"‡" [boundp sym vectorp eval abbrev-expansion he-search-string] 4] append (local-abbrev-table global-abbrev-table) abbrev-table-name-list he-expand-list he-string-member he-tried-table t he-reset-string nil he-substitute-string] 6 (#$ . 13321)]) #@268 Try to expand word "dynamically", searching the current buffer. The argument OLD has to be nil the first call of this function, and t for subsequent calls (for further possible expansions of the same string). It returns t if a new expansion is found, nil otherwise. (defalias 'try-expand-dabbrev #[(old) "À\n„ÃÄ `\"ˆ À“ˆÇ Êš„PŠƒ= bˆË Ç\" `À“ˆ „= \fÀ“ˆÀ „O bˆË À\" `À“ˆ) „_\nƒ[Í ˆÀ‚eÎ Ç\"ˆÇ)‡" [nil expansion old he-init-string he-dabbrev-beg he-search-loc he-string-beg t he-search-bw he-search-string "" he-dabbrev-search he-string-end he-reset-string he-substitute-string] 3 (#$ . 14079)]) #@269 Tries to expand word "dynamically", 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 expansions of the same string). It returns t if a new expansion is found, nil otherwise. (defalias 'try-expand-dabbrev-all-buffers #[(old) "Àp  „ÆÇ `\"ˆÈ  Ê \fÍ @“ˆÏš„– ƒ–\f„–ƒ< Wƒ– @qˆp =„†>„†ÓÔ \"„†Š\fbˆ\nÕÀ\")\f`À“ˆ\f„‚ A  T \fÍ @“ˆ)‚& A \fÍ @“ˆ‚& qˆ\f„¨ ƒ¤Ö ˆÀ‚®×\fØ\"ˆØ+‡" [nil case-fold-search orig-case-fold-search buf expansion old he-init-string he-dabbrev-beg buffer-list he-search-bufs 0 he-searched-n-bufs he-search-loc 1 he-search-string "" hippie-expand-max-buffers major-mode hippie-expand-ignore-buffers he-regexp-member buffer-name he-dabbrev-search he-reset-string he-substitute-string t] 3 (#$ . 14703)]) #@270 Try to expand word "dynamically", searching visible window parts. The argument OLD has to be nil the first call of this function, and t for subsequent calls (for further possible expansions of the same string). It returns t if a new expansion is found, nil otherwise. (defalias 'try-expand-dabbrev-visible #[(old) "ÀpÁÂà !!ƒÄ‚Å „1ÊË `\"ˆÃ \f Î\f!Ï\f!“ˆÑš„°Ò !ƒ°„°ŠÓ !qˆ bˆÔÀÕ\f!#‰ƒ|Ó!p=ƒ|Ò!×”=ƒ|ÔÀÕ\f!# `p“ˆ)„1Ø\fÀ#‰\fà =ƒ¡ À‰“ˆ‚1 Î\f!Ï\f!“ˆ‚1qˆ„Å ƒÁÙ ˆÀ‚ÌÚÅ\"ˆÅ+‡" [nil frame-visible-p window-frame selected-window visible t flag buf expansion old he-init-string he-dabbrev-beg he-search-window he-search-loc window-start window-buffer he-search-string "" marker-position marker-buffer he-dabbrev-search window-end he-string-beg 0 next-window he-reset-string he-substitute-string] 6 (#$ . 15567)]) (defalias 'he-dabbrev-search #[(pattern &optional reverse limit) "À ÂHzÃ=ƒÄ !ÅP‚ÆÄ !ÅQ„c ƒ0Ê Ì#‚7Í Ì#ƒc”•{”eVƒR”SfzÎ>„\\ÏÌ#ƒÀ‰ƒ!*‡" [nil pattern 0 95 regexp-quote "\\(\\sw\\|\\s_\\)+" "\\<" regpat result reverse re-search-backward limit t re-search-forward (95 119) he-string-member he-tried-table] 5]) #@71 Non-NIL means tolerate trailing spaces in the abbreviation to expand. (defvar he-dabbrev-skip-space nil (#$ . 16784)) (defalias 'he-dabbrev-beg #[nil "`Š ƒ ÂÃ!ˆÂÄ!ÅUƒ‚`*‡" [op he-dabbrev-skip-space skip-syntax-backward ". " "w_" 0] 2]) #@265 Try to expand word "dynamically", searching the kill ring. 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. (defalias 'try-expand-dabbrev-from-kill #[(old) "À\n„ÃÄ `\"ˆ Æš?…É\n Æš„$Ë ! „3\nƒ/Ì ˆÀ‚9Í Î\"ˆÎ)‡" [nil expansion old he-init-string he-dabbrev-beg he-search-string "" kill-ring he-expand-list 0 he-search-loc2 he-dabbrev-kill-search he-reset-string he-substitute-string t] 3 (#$ . 17034)]) (defalias 'he-dabbrev-kill-search #[(pattern) "À ÂHzÃ=ƒÄ !ÅP‚ÆÄ !ÅQ@ \n\n„†ƒ†\n„mË \f#ƒm”•O\n”T\f”ÂVƒ\\”SHzÍ>„fÎ\nÐ#ƒ+À‰\nƒ0\n„!ƒ!A‰@Â\f‚!\n+‡" [nil pattern 0 95 regexp-quote "\\(\\sw\\|\\s_\\)+" "\\<" he-expand-list killstr regpat result string-match he-search-loc2 (95 119) he-string-member he-tried-table t] 5]) #@262 Try to complete text with something from the kill ring. 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. (defalias 'try-expand-whole-kill #[(old) "À\n„+ÃÄ `\"ˆÅ\"„BÈš?…& \nÀ Èš„7Ì! „F\nƒBÍ ˆÀ‚KÎ !ˆÏ)‡" [nil expansion old he-init-string he-kill-beg he-string-member he-search-string he-tried-table "" kill-ring he-expand-list he-search-loc2 he-whole-kill-search he-reset-string he-substitute-string t] 3 (#$ . 17981)]) (defalias 'he-whole-kill-search #[(str) "À‰Á\n! @Ä„Ÿ ƒŸ „3Ê\n T#‰ƒ3  B ‚„Š ƒŠ @ A Š bˆ` ZeYƒt` ZfÌH=ƒtÍÌ O` ZÎ#ƒt ÀO)ƒ3Ï\"ƒ3À‰ƒ8„ ƒ A‰@Ä‚-‡" [nil regexp-quote str he-expand-list -1 pos killstr result case-fold-search he-search-loc2 string-match he-string-beg 0 search-backward t he-string-member he-tried-table] 6]) (defalias 'he-kill-beg #[nil "`ŠÁÂ!ˆÁÃ!ÄUƒ‚`*‡" [op skip-syntax-backward "^w_" "w_" 0] 2]) (provide (quote hippie-exp)) emacs-19.30/lisp/holidays.elc100666 13437 1 22300 6032176136 14533 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Sep 27 03:25:03 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/holidays.el ;;; emacs version 19.29.12. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`holidays.el' was compiled for Emacs 19.29 or later")) (require (quote calendar)) #@48 Holiday on MONTH, DAY (Julian) called STRING. (autoload (quote holiday-julian) "cal-julian" '(#$ . 509) t) #@47 Holiday on MONTH, DAY (Hebrew) called STRING. (autoload (quote holiday-hebrew) "cal-hebrew" '(#$ . 623) t) #@72 List of dates related to Rosh Hashanah, as visible in calendar window. (autoload (quote holiday-rosh-hashanah-etc) "cal-hebrew" '(#$ . 736) t) #@67 List of dates related to Hanukkah, as visible in calendar window. (autoload (quote holiday-hanukkah) "cal-hebrew" '(#$ . 885) t) #@67 List of dates related to Passover, as visible in calendar window. (autoload (quote holiday-passover-etc) "cal-hebrew" '(#$ . 1020) t) #@65 List of dates around Tisha B'Av, as visible in calendar window. (autoload (quote holiday-tisha-b-av-etc) "cal-hebrew" '(#$ . 1160) t) #@48 Holiday on MONTH, DAY (Islamic) called STRING. (autoload (quote holiday-islamic) "cal-islamic" '(#$ . 1300) t) #@27 Date of Chinese New Year. (autoload (quote holiday-chinese-new-year) "cal-chinese" '(#$ . 1417) t) #@103 Date and time of equinoxes and solstices, if visible in the calendar window. Requires floating point. (autoload (quote solar-equinoxes-solstices) "solar" '(#$ . 1523) t) #@197 Display the holidays for last month, this month, and next month. If called with an optional prefix argument, prompts for month and year. This function is suitable for execution in a .emacs file. (defalias 'holidays #[(&optional arg) "ŠÀ\nƒ ÃÀ!‚Ä ‰‰@) ‰AA@)È -‡" [t completion-ignore-case arg calendar-read-date calendar-current-date date displayed-month displayed-year list-calendar-holidays] 3 (#$ . 1700) "P"]) #@184 Check the list of holidays for any that occur on DATE. The value returned is a list of strings of relevant holiday descriptions. The holidays are those in the list calendar-holidays. (defalias 'check-calendar-holidays #[(date) "‰@)‰AA@)à Å\fƒ1Ç\f@@\"ƒ*È\f@A\"\fA‰„,‡" [date displayed-month displayed-year calendar-holiday-list h nil holiday-list calendar-date-equal append] 4 (#$ . 2132)]) #@76 Find holidays for the date specified by the cursor in the calendar window. (defalias 'calendar-cursor-holidays #[nil "ÀÁ!ˆÂÃ!Å\f!Ç\f!ÉÊË#\fÍÎ\f#„0ÀÐ\"‚kGÑ Xƒ@À!‚kÒ!qˆÔÖ!ˆ× ˆÉÊØ#cˆebˆÙÔ!ˆÃÚ!ˆÀÛ!-‡" [message "Checking holidays..." calendar-cursor-to-date t date calendar-date-string date-string check-calendar-holidays holiday-list mapconcat identity "; " holiday-string format "%s: %s" msg "No holidays known for %s" frame-width get-buffer-create holiday-buffer nil buffer-read-only calendar-set-mode-line erase-buffer "\n" set-buffer-modified-p display-buffer "Checking holidays...done"] 4 (#$ . 2549) nil]) #@43 Mark notable days in the calendar window. (defalias 'mark-calendar-holidays #[nil "ÀÂÃ!ˆÄ ‰ƒÆ @@\"ˆ A‰„ )ÂÈ!‡" [t mark-holidays-in-calendar message "Marking holidays..." calendar-holiday-list holiday-list mark-visible-calendar-date calendar-holiday-marker "Marking holidays...done"] 4 (#$ . 3202) nil]) #@182 Create a buffer containing the holidays for the current calendar window. The holidays are those in the list calendar-notable-days. Returns t if any holidays are found, nil if not. (defalias 'list-calendar-holidays #[nil "ÀÁ!ˆÂ \f \f‰ „ÀÊ!ˆË‚šÌ !qˆËÏ_Ð\\\\‰ϦTÏ¥) Ï_\\‰ϦTÏ¥)Ò UƒkÓÔÕ!Õ! $‚yÓÖÕ!Õ! %!ˆ× ˆØÙ Ú#cˆebˆÛË!ˆÜÝ !ˆÀÞ!ˆÜ-‡" [message "Looking up holidays..." calendar-holiday-list displayed-month displayed-year y2 m2 y1 m1 holiday-list "Looking up holidays...none found" nil get-buffer-create holiday-buffer buffer-read-only 12 -2 macro-y calendar-set-mode-line format "Notable Dates from %s to %s, %d%%-" calendar-month-name "Notable Dates from %s, %d to %s, %d%%-" erase-buffer mapconcat #[(x) "À @! A@Q‡" [calendar-date-string x ": "] 3] "\n" set-buffer-modified-p t display-buffer "Looking up holidays...done"] 8 (#$ . 3520) nil]) #@125 Form the list of holidays that occur on dates in the calendar window. The holidays are those in the list calendar-holidays. (defalias 'calendar-holiday-list #[nil "Á‰ƒ/\fƒÅÇ @!)‚ÁÈɉ\nƒ'Ë\n\n\") A‰„Ì\nÍ\"‰*‡" [calendar-holidays nil holiday-list p calendar-debug-sexp t stack-trace-on-error eval (byte-code "À @!‡" [eval p] 2) ((error (byte-code "À ˆÁ @\"ˆÄÅ!‡" [beep message "Bad holiday list item: %s" p sleep-for 2] 3))) holidays append sort calendar-date-compare] 4 (#$ . 4424)]) #@202 Holiday on MONTH, DAY (Gregorian) called STRING. If MONTH, DAY is visible, the value returned is the list (((MONTH DAY year) STRING)). Returns nil if it is not visible in the current calendar window. (defalias 'holiday-fixed #[(month day string) " \nÄ_ ÅZÇ\\\\\\‰ĦTÄ¥) ÉV…-\n\nE DC*‡" [displayed-month displayed-year y m 12 11 month -1 macro-y 9 day string] 5 (#$ . 4934)]) #@356 Holiday on MONTH, DAYNAME (Nth occurrence, Gregorian) called STRING. If the Nth DAYNAME in MONTH is visible, the value returned is the list (((MONTH DAY year) STRING)). If N<0, count backward from the end of MONTH. An optional parameter DAY means the Nth DAYNAME after/before MONTH DAY. Returns nil if it is not visible in the current calendar window. (defalias 'holiday-float #[(month dayname n string &optional day) " \nÄ_ ÅZÇ\\\\\\‰ĦTÄ¥) ÉV…2Ê \f\n %DC*‡" [displayed-month displayed-year y m 12 11 month -1 macro-y 9 calendar-nth-named-day n dayname day string] 7 (#$ . 5333)]) #@349 Sexp holiday for dates in the calendar window. SEXP is an expression in variable `year' evaluates to `date'. STRING is an expression in `date' that evaluates to the holiday description of `date'. If `date' is visible in the calendar window, the holiday STRING is on that date. If date is nil, or if the date is not visible, there is no holiday. (defalias 'holiday-sexp #[(sexp string) " \nÄ_ Å\\\\‰ĦTÄ¥)ÇÈ\n Ê !‰\f…+Ê ! \f +DC\nT Ê !‰\f…FÊ ! \f +DC\"!*‡" [displayed-month displayed-year y m 12 -2 macro-y filter-visible-calendar-holidays append year eval sexp date string] 6 (#$ . 5944)]) #@48 Date of Advent, if visible in calendar window. (defalias 'holiday-advent #[nil " ‰Ä_\nÅ\\\\‰ĦTÄ¥)ÇÈÉÄÊ E‰ ‰ AA@)S\f ‰ ‰ @) ‰ A@)  ‰ AA@) \nSÎ_\\\nÐVƒ‡\nÑ_Ò\\Ó¥Z ‰ѦÉU…~ Ô¦ÉU?†~ Õ¦ÉU)ƒ‡T-\fÖ_\fÑ¥\fÔ¥[\fÕ¥\\\\\\\\*\"!Ø!…°ÙDC+‡" [displayed-year displayed-month month year 12 -2 macro-y calendar-gregorian-from-absolute calendar-dayname-on-or-before 0 3 date prior-years day 31 day-of-year 2 4 23 10 100 400 365 advent calendar-date-is-visible-p "Advent"] 11 (#$ . 6568)]) #@65 List of dates related to Easter, as visible in calendar window. (defalias 'holiday-easter-etc #[nil "ÁV…\n??…• Ä¥T ƦÇ_ È_É¥[ Ê_Á\\Ë¥ Ì_Í\\\\\\\\̦‰ÏU„DÐUƒJÑ Æ¦WƒJT‚LÉÆ E‰‰AA@)S‰‰@)‰A@)‰AA@)SØ_\\ÚVƒÃÉ_Û\\Ñ¥Z‰ɦÏU…ºĦÏU?†ºܦÏU)ƒÃT-Ý_ɥĥ[Ü¥\\\\\\\\*ZßÏà\\\"!â!!ãDâ!ÚZ!äDâ!åZ!æDE'â!èZ!éDâ!êZ!ëDâ!ìZ!íDâ!îZ!ïDâ!ðZ!ñDâ!ÍZ!òDâ!àZ!óDâ!ÈZ!ôDâ!õ\\!öDâ!÷\\!øDâ!ì\\!ùDâ!ú\\!ûDâ!ê\\!üDâ!ý\\!þD¯?@'!A\nƒ‘B@?!A\"AA.‡" [displayed-month 5 all-christian-calendar-holidays displayed-year 100 century 19 11 3 4 8 25 30 14 shifted-epact 0 1 10 adjusted-epact date prior-years month day year 31 day-of-year 2 23 400 365 paschal-moon calendar-dayname-on-or-before 7 abs-easter calendar-gregorian-from-absolute "Easter Sunday" "Good Friday" 46 "Ash Wednesday" mandatory 63 "Septuagesima Sunday" 56 "Sexagesima Sunday" 49 "Shrove Sunday" 48 "Shrove Monday" 47 "Shrove Tuesday" "Passion Sunday" "Palm Sunday" "Maundy Thursday" 35 "Rogation Sunday" 39 "Ascension Day" "Pentecost (Whitsunday)" 50 "Whitmunday" "Trinity Sunday" 60 "Corpus Christi" optional filter-visible-calendar-holidays output-list append] 17 (#$ . 7095)]) #@64 Date of Easter according to the rule of the Council of Nicaea. (defalias 'holiday-greek-orthodox-easter #[nil " \nÄ_ \\‰ĦT Ä¥)Æ ‰\n‰ÉUƒF‰ʦËU…>̦ËU?†>ͦËU)ƒF΂KÏSH*\nE‰‰AA@)S‰‰@)‰A@)‰AA@)SÓ_\\ÉVƒ¿Ê_Õ\\Ö¥Z‰ʦËU…¶̦ËU?†¶ͦËU)ƒ¿T-×_ʥ̥[Í¥\\\\\\\\*!‰AA@)‰Ù¦Ú_Û\\ܦÞÊÙE!ZàáËâ\\\"!#ä#!…#åDC.‡" [displayed-month displayed-year y m 12 macro-y calendar-julian-from-absolute year month 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] date prior-years day 31 day-of-year 23 10 365 julian-year 19 11 14 30 shifted-epact calendar-absolute-from-julian paschal-moon calendar-gregorian-from-absolute calendar-dayname-on-or-before 7 nicaean-easter calendar-date-is-visible-p "Pascha (Greek Orthodox Easter)"] 9 (#$ . 8327)]) #@54 Return a list of all visible holidays of those on L. (defalias 'filter-visible-calendar-holidays #[(l) "À \nƒ$\n@@ƒÄ\n@@!ƒÅ\n@C \"\nA‰„ *‡" [nil l p visible calendar-date-is-visible-p append] 4 (#$ . 9161)]) (provide (quote holidays)) emacs-19.30/lisp/icomplete.elc100666 12120 1 13047 6045213657 14560 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:21:31 1995 ;;; from file /home/fsf/rms/e19/lisp/icomplete.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`icomplete.el' was compiled for Emacs 19.29 or later")) (provide (quote icomplete)) #@531 *Icomplete-specific customization of minibuffer setup. This hook is run during minibuffer setup iff icomplete will be active. It is intended for use in customizing icomplete for interoperation with other packages. For instance: (add-hook 'icomplete-minibuffer-setup-hook (function (lambda () (make-local-variable 'resize-minibuffer-window-max-height) (setq resize-minibuffer-window-max-height 3)))) will constrain rsz-mini to a maximum minibuffer height of 3 lines when icompletion is occurring. (defvar icomplete-minibuffer-setup-hook nil (#$ . -507)) #@105 Non-nil enables incremental minibuffer completion, once `\[icomplete-mode]' function has set things up. (defvar icomplete-mode t (#$ . 1101)) #@63 Point where minibuffer input ends and completion info begins. (defvar icomplete-eoinput 1 (#$ . 1249)) (make-variable-buffer-local (quote icomplete-eoinput)) #@218 Incremental-minibuffer-completion pre-command-hook. Is run in minibuffer before user input when `icomplete-mode' is non-nil. Use `icomplete-mode' function to set it up properly for incremental minibuffer completion. (defvar icomplete-pre-command-hook nil (#$ . 1414)) (add-hook (quote icomplete-pre-command-hook) (quote icomplete-tidy)) #@218 Incremental-minibuffer-completion post-command-hook. Is run in minibuffer after user input when `icomplete-mode' is non-nil. Use `icomplete-mode' function to set it up properly for incremental minibuffer completion. (defvar icomplete-post-command-hook nil (#$ . 1759)) (add-hook (quote icomplete-post-command-hook) (quote icomplete-exhibit)) #@108 Activate incremental minibuffer completion for this emacs session, or deactivate with negative prefix arg. (defalias 'icomplete-mode #[(&optional prefix) "„ÁÁYƒÂÄÅÆ\"‡Ç‰‡" [prefix 0 t icomplete-mode add-hook minibuffer-setup-hook icomplete-minibuffer-setup nil] 3 (#$ . 2109) "p"]) #@364 Non-nil if current window is minibuffer that's doing simple completion. Conditions are: the selected window is a minibuffer, and not in the middle of macro execution, and minibuffer-completion-table is not a symbol (which would indicate some non-standard, non-simple completion mechansm, like file-name and other custom-func completions). (defalias 'icomplete-simple-completing-p #[nil "ÀÁ !…\n?… 9?‡" [window-minibuffer-p selected-window executing-macro minibuffer-completion-table] 2 (#$ . 2407)]) #@123 Run in minibuffer on activation to establish incremental completion. Usually run by inclusion in `minibuffer-setup-hook'. (defalias 'icomplete-minibuffer-setup #[nil "…\"Á …\"ÂÃ!ˆÄÃÅÆÇ$ˆÂÈ!ˆÄÈÉÆÇ$ˆÊË!‡" [icomplete-mode icomplete-simple-completing-p make-local-hook pre-command-hook add-hook #[nil "ÀÁ!‡" [run-hooks icomplete-pre-command-hook] 2] nil t post-command-hook #[nil "ÀÁ!‡" [run-hooks icomplete-post-command-hook] 2] run-hooks icomplete-minibuffer-setup-hook] 5 (#$ . 2942)]) #@168 Remove completions display (if any) prior to new user input. Should be run in on the minibuffer `pre-command-hook'. See `icomplete-mode' and `minibuffer-setup-hook'. (defalias 'icomplete-tidy #[nil "À …'ÁÂ!ƒ \nƒ \ndVƒd‰‡ \nd|)‡ÄÂ!ˆÅ‰‡" [icomplete-simple-completing-p boundp icomplete-eoinput buffer-undo-list make-local-variable 1] 2 (#$ . 3437)]) #@140 Insert icomplete completions display. Should be run via minibuffer `post-command-hook'. See `icomplete-mode' and `minibuffer-setup-hook'. (defalias 'icomplete-exhibit #[nil "À ….ed{ÁŠdbˆÄÅ!„ÆÅ!ˆ`dÇV…-ÈÉ \n \f?$!+‡" [icomplete-simple-completing-p t buffer-undo-list contents boundp icomplete-eoinput make-local-variable 1 insert-string icomplete-completions minibuffer-completion-table minibuffer-completion-predicate minibuffer-completion-confirm] 6 (#$ . 3801)]) #@699 Identify prospective candidates for minibuffer completion. The display is updated with each minibuffer keystroke during minibuffer completion. Prospective completion suffixes (if any) are displayed, bracketed by one of (), [], or {} pairs. The choice of brackets is as follows: (...) - a single prospect is identified and matching is enforced, [...] - a single prospect is identified but matching is optional, or {...} - multiple prospects, separated by commas, are indicated, and further input is required to distingish a single one. The displays for disambiguous matches have ` [Matched]' appended (whether complete or not), or ` [No matches]', if no eligible matches exist. (defalias 'icomplete-completions #[(name candidates predicate require-match) "À \n #\fƒ Å‚Æ\fƒÇ‚ÈÉÊ \f ‰„1ÐÑ #‚™A„V@G GVƒP@ GÒO Q‚QÓÔP‚™Õ \n #‰GÒÙÚÙÛÜÝ\"\"A\" GV…… GÒO Q\fƒ“ßP‚• R,-‡" [all-completions name candidates predicate require-match "(" "[" ")" "]" "{" "}" close-bracket-prospects open-bracket-prospects close-bracket-determined open-bracket-determined comps format " %sNo matches%s" nil "" " [Matched]" try-completion most most-len most-is-exact apply concat nconc mapcar #[(com) "G Uƒ ÂćÅ ÄOD‡" [com most-len t most-is-exact nil ","] 4] alternatives ","] 8 (#$ . 4283)]) (byte-code "ƒÀ ˆÀ‡" [icomplete-mode] 1) emacs-19.30/lisp/icon.elc100666 13437 1 23016 6016151403 13644 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Aug 21 14:39:47 1995 ;;; from file /home/fsf/rms/e19/lisp/icon.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`icon.el' was compiled for Emacs 19.29 or later")) #@43 Abbrev table in use in Icon-mode buffers. (defvar icon-mode-abbrev-table nil (#$ . 463)) (define-abbrev-table (quote icon-mode-abbrev-table) nil) #@27 Keymap used in Icon mode. (defvar icon-mode-map nil (#$ . 615)) (byte-code "„7Á ÂÃÄ#ˆÂÅÄ#ˆÂÆÇ#ˆÂÈÉ#ˆÂÊË#ˆÂÌÍ#ˆÂÎÏ#ˆÂÐÑ#ˆÁ‡" [icon-mode-map make-sparse-keymap define-key "{" electric-icon-brace "}" "" mark-icon-function "" beginning-of-icon-defun "" end-of-icon-defun "" indent-icon-exp "" backward-delete-char-untabify " " icon-indent-command] 4) #@43 Syntax table in use in Icon-mode buffers. (defvar icon-mode-syntax-table nil (#$ . 988)) (byte-code "„aÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÊ#ˆÂÌÊ#ˆÂÍÊ#ˆÂÎÊ#ˆÂÏÊ#ˆÂÐÊ#ˆÂÑÊ#ˆÂÒÊ#ˆÂÓÊ#ˆÂÔÊ#ˆÂÕÖ#ˆÁ‡" [icon-mode-syntax-table make-syntax-table modify-syntax-entry 92 "\\" 35 "<" 10 ">" 36 "." 47 42 43 45 61 37 60 62 38 124 39 "\""] 4) #@67 *Indentation of Icon statements with respect to containing block. (defvar icon-indent-level 4 (#$ . -1330)) #@79 *Imagined indentation of a Icon open brace that actually follows a statement. (defvar icon-brace-imaginary-offset 0 (#$ . -1444)) #@74 *Extra indentation for braces, compared with other text in same context. (defvar icon-brace-offset 0 (#$ . -1580)) #@54 *Extra indent for lines not starting new statements. (defvar icon-continued-statement-offset 4 (#$ . -1701)) #@118 *Extra indent for substatements that start with open-braces. This is in addition to icon-continued-statement-offset. (defvar icon-continued-brace-offset 0 (#$ . -1817)) #@85 *Non-nil means automatically newline before and after braces inserted in Icon code. (defvar icon-auto-newline nil (#$ . -1992)) #@145 *Non-nil means TAB in Icon mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. (defvar icon-tab-always-indent t (#$ . -2127)) #@1381 Major mode for editing Icon code. Expression and list commands understand all Icon brackets. Tab indents for Icon code. Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \{icon-mode-map} Variables controlling indentation style: icon-tab-always-indent Non-nil means TAB in Icon mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. icon-auto-newline Non-nil means automatically newline before and after braces inserted in Icon code. icon-indent-level Indentation of Icon statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. icon-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. icon-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to `icon-continued-statement-offset'. icon-brace-offset Extra indentation for line if it starts with an open brace. icon-brace-imaginary-offset An open brace following other text is treated as if it were this far to the right of the start of its line. Turning on Icon mode calls the value of the variable `icon-mode-hook' with no args, if that value is non-nil. (defalias 'icon-mode #[nil "À ˆÁ\n!ˆÃÅÉ\n!ˆËÌ!ˆÍP\fËÏ!ˆ\fËÐ!ˆÑËÒ!ˆÓËÔ!ˆÕËÖ!ˆ×ËØ!ˆÙËÚ!ˆÛËÜ!ˆÝÞß!‡" [kill-all-local-variables use-local-map icon-mode-map icon-mode major-mode "Icon" mode-name icon-mode-abbrev-table local-abbrev-table set-syntax-table icon-mode-syntax-table make-local-variable paragraph-start "$\\|" page-delimiter paragraph-separate indent-line-function icon-indent-line require-final-newline t comment-start "# " comment-end "" comment-column 32 comment-start-skip "# *" comment-indent-function icon-comment-indent run-hooks icon-mode-hook] 2 (#$ . 2326) nil]) (defalias 'icon-comment-indent #[nil "ÀÁ!ƒ‡ŠÃÄxˆnƒ‚iT ])‡" [looking-at "^#" 0 " " nil comment-column] 2]) #@50 Insert character and correct line's indentation. (defalias 'electric-icon-brace #[(arg) "À\n„AlƒAŠÃÀxˆn)„\fƒAÅ ˆÆ ˆcˆÅ ˆ\fƒ3Æ ˆ`ÈZÅ ˆŠ ƒ< TbˆÉÊ!ˆ) ƒRŠ bˆËÌ\n!!)‚WËÌ\n!!)‡" [nil insertpos arg " " icon-auto-newline icon-indent-line newline last-command-char 2 delete-char -1 self-insert-command prefix-numeric-value] 3 (#$ . 4433) "P"]) (defalias 'icon-indent-command #[(&optional whole-exp) "ƒ3Á ‰ŠƒÇyˆ`ÈÉ!ˆ`\fbˆÉyˆ`) \fV…1Ê\f Ë$+‡„EŠÌÂxˆn)„EÍ ‡Á ‡" [whole-exp icon-indent-line nil end beg shift-amt icon-tab-always-indent 0 forward-sexp 1 indent-code-rigidly "#" " " insert-tab] 5 nil "P"]) #@81 Indent current line as Icon code. Return the amount the indentation changed by. (defalias 'icon-indent-line #[nil "ÀÁ!Á‰‰d`ZÇyˆ`Á=ƒ\"È ‚†É=ƒ0Ê ‚†ËÌ!ƒ<Ç‚†ÍÁwˆ<ƒK@ËÎ!ƒcËÏ!„cŠÐ ˆÈ )‚†gÑU„oËÒ!ƒyZ‚†gÔUƒ†\\ÍÁwˆiZ‰ÇUƒ¥d\nZ`Vƒºd\nZbˆ‚º `|ˆjˆd\nZ`Vƒºd\nZbˆ\f-‡" [calculate-icon-indent nil pos case-fold-search shift-amt beg indent 0 current-indentation t calculate-icon-indent-within-comment looking-at "[ ]*#" " " "else\\b" "else\\s_" icon-backward-to-start-of-if 125 "end\\b" icon-indent-level 123 icon-brace-offset] 7 (#$ . 5064)]) #@185 Return appropriate indentation for current line as Icon code. In usual case returns an integer: the column to indent to. Returns nil if line starts inside a string, t if in a comment. (defalias 'calculate-icon-indent #[(&optional parse-start) "ŠÀyˆ`Á‰‰‰ƒbˆ‚È `Wƒ6`É`À#‰A@‚Ê\f8„BË\f8ƒHË\f8‚ ƒ[ fÌU„[ Tbˆi‚\nƒqÍe!ˆÎ ƒm‚À‚ „zÈ ˆ`bˆÍ !ˆÎ ƒ©Ð !ˆiŠbˆÑÁwˆg)Ì=ƒ£‚¤À\\\\‚ bˆŠÓÔ!ƒºÕÊ!ˆ‚½Öuˆ×ÁwˆÓØ!ƒÍÖyˆ‚½`W…Õi)†nƒìÀUƒì\\‚îÑÁxˆnƒúÀ‚üÜ \\\\.‡" [0 nil toplevel containing-sexp state case-fold-search indent-point parse-start beginning-of-icon-defun parse-partial-sexp 3 4 123 icon-backward-to-noncomment icon-is-continuation-line icon-continued-statement-offset icon-backward-to-start-of-continued-exp " " icon-continued-brace-offset looking-at "procedure\\s " forward-sexp 1 " \n" "#" icon-indent-level icon-brace-offset icon-brace-imaginary-offset current-indentation] 6 (#$ . 5659)]) (byte-code "ÀÁ\nBÁ‡" [(("by" . t) ("case" . t) ("create") ("do") ("dynamic" . t) ("else") ("every" . t) ("if" . t) ("global" . t) ("initial" . t) ("link" . t) ("local" . t) ("of") ("record" . t) ("repeat" . t) ("static" . t) ("then") ("to" . t) ("until" . t) ("while" . t)) icon-resword-alist current-load-list] 2) (defalias 'icon-is-continuation-line #[nil "h‰z‰Â=ƒÃÄvˆ`Åvˆ`{\"‚Ç>?*‡" [ch ch-syntax 119 assoc -1 1 icon-resword-alist (0 59 125 123 41 93 34 39 10)] 4]) (defalias 'icon-backward-to-noncomment #[(lim) "À‰ ?….Ã\fxˆ`ÅyˆÆÇ`\n\"8ƒ(\f`Wƒ(ÈÉ!ˆ‚ʉ‚*‡" [nil stop opoint " \n\f" lim 0 5 parse-partial-sexp search-backward "#" t] 5]) (defalias 'icon-backward-to-start-of-continued-exp #[(lim) "hÀ>ƒ\nÁÂ!ˆÃyˆÄÅwˆ`XƒTb‡Ç „$ÇgzÈ=ƒ=É`ŠÊvˆ`){ \"Aƒ=ÇÈÌ!‡" [(41 93) forward-sexp -1 0 " " nil lim icon-is-continued-line 119 assoc 1 icon-resword-alist icon-backward-to-start-of-continued-exp] 3]) (defalias 'icon-is-continued-line #[nil "ŠÀˆÁ )‡" [0 icon-is-continuation-line] 1]) #@48 Move to the start of the last "unbalanced" if. (defalias 'icon-backward-to-start-of-if #[(&optional limit) "„ ŠÁ ˆ`)Âà ÆU?…BÇÂ!ˆÈÉ!ƒ' T‰‚ÈÊ!ƒ4 S‰‚`WƒÆbˆ‚*‡" [limit beginning-of-icon-defun 1 nil case-fold-search if-level 0 backward-sexp looking-at "else\\b" "if\\b"] 3 (#$ . 7642)]) #@55 Put mark at end of Icon function, point at beginning. (defalias 'mark-icon-function #[nil "À`!ˆÁ ˆÀ`!ˆÂyˆÃ ‡" [push-mark end-of-icon-defun -1 beginning-of-icon-defun] 2 (#$ . 7951) nil]) #@71 Go to the start of the enclosing procedure; return t if at top level. (defalias 'beginning-of-icon-defun #[nil "ÀÁeÂ#ƒ\fÃÄ!‡Å‡" [re-search-backward "^procedure\\s \\|^end[ \n]" move looking-at "e" t] 4 (#$ . 8144) nil]) (defalias 'end-of-icon-defun #[nil "o„ÀuˆÁÂdÃ#ˆÀvˆÄy‡" [-1 re-search-forward "\\(\\s \\|^\\)end\\(\\s \\|$\\)" move 1] 4 nil nil]) #@56 Indent each line of the Icon grouping following point. (defalias 'indent-icon-exp #[nil "ÀC`CÀ‰‰‰‰‰‰‰‰‰‰`Á \n \f ŠÑÒ!ˆ)ŠÀ\fm?…ß\f?…ß\nÀ„¡mƒVÕ‰\f„¡\n Ö`Àˆ`À‰\n%‰\n@\nAA@ƒƒ\nAA@ÁYƒƒ\nAA@× 8ƒØ ˆÙ\n8ƒšÒyˆ‚FÕ‰ƒK\nÁXƒªÕ\f\f„5\nU„¹À\nVƒÓAAS‰‚»\nWƒïÀBÀBT‰‚Õ@„\nA@†ŠÑÚ!ˆ`) ˆÒyˆÛÀwˆl„5@ƒw@ÁYƒw@fÜU„1@‚ŠÝÞ!gÜUß !ˆà ƒ^á@!ˆ\"i ƒV#‚WÁ\\\\‚sƒnä !ˆå ‚s@)‚æ@…‚@[!''‰ ˆ)gèU„›Ýé!ƒ¢*ZgÜUƒ¯+\\iU„Á`Áyˆ`|ˆjˆÝ,!„5í,ŠÀˆ`)Õ#ƒ5î ˆÁyˆ‚5.‡" [nil 0 next-depth opoint at-do at-brace at-else last-sexp this-indent ostate state inner-loop-done outer-loop-done restart case-fold-search contain-stack indent-stack forward-sexp 1 last-depth innerloop-done t parse-partial-sexp 4 icon-indent-line 3 -1 " " 123 looking-at "else\\W" icon-backward-to-noncomment icon-is-continuation-line icon-backward-to-start-of-continued-exp icon-continued-statement-offset icon-continued-brace-offset icon-backward-to-start-of-if current-indentation calculate-icon-indent val 125 "end\\b" icon-indent-level icon-brace-offset comment-start-skip re-search-forward indent-for-comment] 16 (#$ . 8505) nil]) emacs-19.30/lisp/ielm.elc100666 12120 1 24564 5775440655 13544 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Jul 2 02:50:13 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/ielm.el ;;; emacs version 19.29.4. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`ielm.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require comint pp] 2) #@39 *If non-nil, IELM will beep on error. (defvar ielm-noisy t (#$ . -512)) #@22 Prompt used in IELM. (defvar ielm-prompt "ELISP> " (#$ . 590)) #@232 *Controls whether \\[ielm-return] has intelligent behaviour in IELM. If non-nil, \[ielm-return] evaluates input for complete sexps, or inserts a newline and indents for incomplete sexps. If nil, always inserts newlines. (defvar ielm-dynamic-return t (#$ . -660)) #@321 *Force multiline inputs to start from column zero? If non-nil, after entering the first line of an incomplete sexp, a newline will be inserted after the prompt, moving the input to the next line. This gives more frame width for large indented sexps, and allows functions such as `edebug-defun' to work with such inputs. (defvar ielm-dynamic-multiline-inputs t (#$ . -941)) #@69 *Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started. (defvar ielm-mode-hook nil (#$ . -1320)) #@78 Buffer in which IELM sexps will be evaluated. This variable is buffer-local. (defvar ielm-working-buffer nil (#$ . 1435)) #@42 Message to display when IELM is started. (defvar ielm-header (byte-code "ÀÁÂÃOÄÅR‡" ["*** Welcome to IELM version " "$Revision: 1.5 $" 11 -2 " *** Type (describe-mode) for help.\n" "IELM has ABSOLUTELY NO WARRANTY; type (describe-no-warranty) for details.\n"] 4) (#$ . 1563)) (byte-code "ÀÁ!„ÂÁ B „kÄÅ\"ƒ$Ç È  \"ˆ‚)Ê BË ÌÍ#ˆË ÎÏ#ˆË ÐÑ#ˆË ÒÓ#ˆË ÔÕ#ˆË Ö×#ˆË ØÙ#ˆË ÚÛ#ˆË ÜÝ#ˆË Þß#ˆË àá#ˆÂ‡" [boundp ielm-map nil current-load-list string-match "Lucid" emacs-version make-sparse-keymap set-keymap-parent comint-mode-map keymap define-key " " comint-dynamic-complete " " ielm-return "\n" ielm-send-input "" eval-defun " " lisp-complete-symbol "" indent-sexp "q" lisp-fill-paragraph "" backward-delete-char-untabify "" ielm-change-working-buffer "" ielm-display-working-buffer "" ielm-print-working-buffer] 4) #@54 Additional expressions to highlight in ielm buffers. (defvar ielm-font-lock-keywords (byte-code "ÀÁ\n!PÃBÄD‡" ["^" regexp-quote ielm-prompt font-lock-keyword-face ("\\(^\\*\\*\\*[^*]+\\*\\*\\*\\)\\(.*$\\)" (1 font-lock-comment-face) (2 font-lock-reference-face))] 3) (#$ . 2399)) #@48 Possibly indent the current line as lisp code. (defalias 'ielm-tab #[nil "hÀ=„ hzÁ=… ˆÃ‡" [10 32 ielm-indent-line t] 2 (#$ . 2685) nil]) #@40 Complete the lisp symbol before point. (defalias 'ielm-complete-symbol #[nil "À ÂÃ!‰…À\f!Æ ˆ À U?†*\fƒ' À\f!U?‚*ÂÃ!+‡" [buffer-modified-tick btick get-buffer "*Completions*" cbuffer ctick lisp-complete-symbol] 4 (#$ . 2832)]) #@61 Dynamically complete filename before point, if in a string. (defalias 'ielm-complete-filename #[nil "ÀÁ\n`\"8… à ‡" [3 parse-partial-sexp comint-last-input-start comint-dynamic-complete-filename] 4 (#$ . 3072)]) #@66 Indent the current line as Lisp code if it is not a prompt line. (defalias 'ielm-indent-line #[nil "ŠÀyˆÁ\n!)?…à ‡" [0 looking-at comint-prompt-regexp lisp-indent-line] 2 (#$ . 3291)]) #@64 Print the current IELM working buffer's name in the echo area. (defalias 'ielm-print-working-buffer #[nil "ÀÁ !\"‡" [message "The current working buffer is: %s" buffer-name ielm-working-buffer] 4 (#$ . 3484) nil]) #@147 Display the current IELM working buffer. Don't forget that selecting that buffer will change its value of `point' to its value of `window-point'! (defalias 'ielm-display-working-buffer #[nil "À !ˆÂ ‡" [display-buffer ielm-working-buffer ielm-print-working-buffer] 2 (#$ . 3706) nil]) #@209 Change the current IELM working buffer to BUF. This is the buffer in which all sexps entered at the IELM prompt are evaluated. You can achieve the same effect with a call to `set-buffer' at the IELM prompt. (defalias 'ielm-change-working-buffer #[(buf) "À !† ÂÃ!Å ‡" [get-buffer buf error "No such buffer" ielm-working-buffer ielm-print-working-buffer] 2 (#$ . 3997) "bSet working buffer to: "]) #@223 Newline and indent, or evaluate the sexp before the prompt. Complete sexps are evaluated; for incomplete sexps inserts a newline and indents. If however `ielm-dynamic-return' is nil, this always simply inserts a newline. (defalias 'ielm-return #[nil "ƒ@ŠÁˆÂà `\")‰@ÅWƒ!Æ\f8„!Ç ‚>ƒ<ŠÉyˆÊ !)ƒ<ŠÃ bˆÌÅ!ˆ)Í )‡Ì ‡" [ielm-dynamic-return nil parse-partial-sexp ielm-pm state 1 3 ielm-send-input ielm-dynamic-multiline-inputs 0 looking-at comint-prompt-regexp newline newline-and-indent] 4 (#$ . 4403) nil]) (defalias 'ielm-input-sender #[(proc input) "‰‡" [input ielm-input] 2]) #@54 Evaluate the Emacs Lisp expression after the prompt. (defalias 'ielm-send-input #[nil "pÀà ˆÄ !*‡" [nil ielm-input buf comint-send-input ielm-eval-input] 2 (#$ . 4996) nil]) #@45 Return non-nil if STRING is all whitespace. (defalias 'ielm-is-whitespace #[(string) "Á˜†\nÂÃ\"‡" [string "" string-match "\\`[ \n]+\\'"] 3 (#$ . 5178)]) (defalias 'ielm-format-errors #[(errlist) "À\nƒ Ã\n@!ÄQ\nA‰„ ÅÆO)‡" ["" result errlist prin1-to-string ", " 0 -2] 4]) (defalias 'ielm-format-error #[(err) "ÀÁ\n@ÃN†\nÄ\nAƒÀÅÆ\nA!\"‚Ç#‡" [format "%s%s" err error-message "Peculiar error" ": %s" ielm-format-errors ""] 7]) #@72 Evaluate the Lisp expression IELM-STRING, and pretty-print the result. (defalias 'ielm-eval-input #[(ielm-string) "À‰‰‰Á\nà  \nË\f!„«ÍÎψ„`Ð\n!„6ÑÒp‚`Ë\f ÀO!ƒZŠ\nqˆÍÙÚˆ,‚`ÛÜ \n=„mÝÞ \"ˆ \fbˆ„zÍßàˆƒ™!ƒ‡â ˆãäR‰P‚¥åP&Pçè \".‡" [nil "" ielm-working-buffer ielm-pm ielm-pmark ielm-wbuf ielm-output ielm-error-type ielm-result ielm-pos ielm-form ielm-is-whitespace ielm-string err (byte-code "À !‰@ A)À‡" [nil rout read-from-string ielm-string ielm-form ielm-pos] 3) ((error (byte-code "À !ÃÀ‡" [ielm-format-error err ielm-result "Read error" ielm-error-type] 2))) buffer-name "Working buffer has been killed" "IELM Error" : :: ::: :::save ::save :save (byte-code " \npÇ! p\n qˆ,LJ" [:save ::save :::save ielm-obuf ::: :: : eval ielm-form ielm-result ielm-wbuf] 4) ((error (byte-code "À !ÃÀ‡" [ielm-format-error err ielm-result "Eval error" ielm-error-type] 2)) (quit (byte-code "ÀÂć" ["Quit during evaluation" ielm-result "Eval error" ielm-error-type nil] 1))) "IELM error" "More than one sexp in input" message "current buffer is now: %s" (byte-code "Á\n!PÁ‡" [ielm-output pp-to-string ielm-result] 3) ((error (byte-code "ÀÂć" ["IELM Error" ielm-error-type "Error during pretty-printing (bug in pp)" ielm-result nil] 1)) (quit (byte-code "ÀÂć" ["IELM Error" ielm-error-type "Quit during pretty-printing" ielm-result nil] 1))) ielm-noisy ding "*** " " *** " "\n" ielm-prompt comint-output-filter ielm-process] 8 (#$ . 5624)]) (defalias 'ielm-process #[nil "Àp!‡" [get-buffer-process] 2]) (defalias 'ielm-pm #[nil "ÀÁp!!‡" [process-mark get-buffer-process] 3]) (defalias 'ielm-set-pm #[(pos) "ÀÁp!!\nÓ‡" [process-mark get-buffer-process pos nil] 3]) #@1741 Major mode for interactively evaluating Emacs Lisp expressions. Uses the interface provided by `comint-mode' (which see). * \\[ielm-send-input] evaluates the sexp following the prompt. There must be at most one top-level sexp per prompt. * \[ielm-return] inserts a newline and indents, or evaluates a complete expression (but see variable `ielm-dynamic-return'). Inputs longer than one line are moved to the line following the prompt (but see variable `ielm-dynamic-multiline-inputs'). * \[comint-dynamic-complete] completes Lisp symbols (or filenames, within strings), or indents the line if there is nothing to complete. During evaluations, the values of the variables `:', `::', and `:::' are the results of the previous, second previous and third previous evaluations respectively. The current working buffer may be changed (with a call to `set-buffer', or with \[ielm-change-working-buffer]), and its value is preserved between successive evaluations. In this way, expressions may be evaluated in a different buffer than the *ielm* buffer. Display the name of the working buffer with \[ielm-print-working-buffer], or the buffer itself with \[ielm-display-working-buffer]. Expressions evaluated by IELM are not subject to `debug-on-quit' or `debug-on-error'. The behaviour of IELM may be customised with the following variables: * To stop beeping on error, set `ielm-noisy' to nil * If you don't like the prompt, you can change it by setting `ielm-prompt'. * Set `ielm-dynamic-return' to nil for bindings like `lisp-interaction-mode' * Entry to this mode runs `comint-mode-hook' and `ielm-mode-hook' (in that order). Customised bindings may be defined in `ielm-map', which currently contains: \{ielm-map} (defalias 'inferior-emacs-lisp-mode #[nil "À ˆÁ !PÅÆ!ˆ\fÇÉ\nË\fÍÏÑÓ!ˆÕ!ˆÅ×!ˆÅØ!ˆpÙÉÅÚ!ˆÉÅÛ!ˆÉÅÜ!ˆÅÝ!ˆÞßp!„†àápâ#ˆãä !ˆdbˆ%cˆæd!ˆçä \"ˆ(é É“ˆêëp!ç\"ˆìí!‡" [comint-mode "^" regexp-quote ielm-prompt comint-prompt-regexp make-local-variable paragraph-start ielm-input-sender comint-input-sender nil comint-process-echoes (ielm-tab comint-replace-by-expanded-history ielm-complete-filename ielm-complete-symbol) comint-dynamic-complete-functions ielm-get-old-input comint-get-old-input inferior-emacs-lisp-mode major-mode "IELM" mode-name use-local-map ielm-map set-syntax-table emacs-lisp-mode-syntax-table indent-line-function ielm-working-buffer ielm-indent-line : :: ::: font-lock-defaults (ielm-font-lock-keywords nil nil ((58 . "w") (45 . "w") (42 . "w"))) comint-check-proc start-process "ielm" "cat" process-kill-without-query ielm-process ielm-header ielm-set-pm comint-output-filter comint-last-input-start ielm-pm set-process-filter get-buffer-process run-hooks ielm-mode-hook] 4 (#$ . 7398) nil]) (defalias 'ielm-get-old-input #[nil "ŠÀyˆÁ\n!„Ã\n!ˆÄ ˆ`ÅÆ!ˆ`{)‡" [0 looking-at comint-prompt-regexp re-search-backward comint-skip-prompt forward-sexp 1] 3]) #@117 Interactively evaluate Emacs Lisp expressions. Switches to the buffer `*ielm*', or creates it if it does not exist. (defalias 'ielm #[nil "ÀÁ!„ŠÂÁ!qˆÃ ˆ)ÄÁ!‡" [comint-check-proc "*ielm*" get-buffer-create inferior-emacs-lisp-mode pop-to-buffer] 2 (#$ . 10343) nil]) emacs-19.30/lisp/imenu.elc100666 12120 1 37001 6055512050 13676 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 24 22:57:05 1995 ;;; from file /home/fsf/rms/e19/lisp/imenu.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`imenu.el' was compiled for Emacs 19.29 or later")) #@57 *Non-nil means use a keymap when making the mouse menu. (defvar imenu-use-keymap-menu nil (#$ . -468)) #@56 *Non-nil means Imenu should always rescan the buffers. (defvar imenu-auto-rescan nil (#$ . -577)) #@87 * auto-rescan is disabled in buffers larger than this. This variable is buffer-local. (defvar imenu-auto-rescan-maxout 60000 (#$ . -681)) #@287 *Set this to non-nil for displaying the index in a completion buffer. Non-nil means always display the index in a completion buffer. Nil means display the index as a mouse menu when the mouse was used to invoke `imenu'. `never' means never automatically display a listing of any kind. (defvar imenu-always-use-completion-buffer-p nil (#$ . -826)) #@501 *The function to use for sorting the index mouse-menu. Affects only the mouse index menu. Set this to nil if you don't want any sorting (faster). The items in the menu are then presented in the order they were found in the buffer. Set it to `imenu--sort-by-name' if you want alphabetic sorting. The function should take two arguments and return T if the first element should come before the second. The arguments are cons cells; (NAME . POSITION). Look at `imenu--sort-by-name' for an example. (defvar imenu-sort-function nil (#$ . -1181)) #@53 *Maximum number of elements in an index mouse-menu. (defvar imenu-max-items 25 (#$ . -1733)) #@231 *Progress message during the index scanning of the buffer. If non-nil, user gets a message during the scanning of the buffer Relevant only if the mode-specific function that creates the buffer index use `imenu-progress-message'. (defvar imenu-scanning-message "Scanning buffer for index (%3d%%)" (#$ . -1833)) #@140 *The replacement string for spaces in index names. Used when presenting the index in a completion-buffer to make the names work as tokens. (defvar imenu-space-replacement "^" (#$ . -2151)) #@150 *The separator between index names of different levels. Used for making mouse-menu titles and for flattening nested indexes with name concatenation. (defvar imenu-level-separator ":" (#$ . -2347)) #@40 *The format for making a submenu name. (defvar imenu-submenu-name-format "%s..." (#$ . -2550)) #@1065 The regex pattern to use for creating a buffer index. If non-nil this pattern is passed to `imenu-create-index-with-pattern' to create a buffer index. It is an alist with elements that look like this: (MENU-TITLE REGEXP INDEX). MENU-TITLE is a string used as the title for the submenu or nil if the entries are not nested. REGEXP is a regexp that should match a construct in the buffer that is to be displayed in the menu; i.e., function or variable definitions, etc. It contains a substring which is the name to appear in the menu. See the info section on Regexps for more information. INDEX points to the substring in REGEXP that contains the name (of the function, variable or type) that is to appear in the menu. For emacs-lisp-mode for example PATTERN would look like: '((nil "^\\s-*(def\\(un\\|subst\\|macro\\|advice\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2) ("*Vars*" "^\\s-*(def\\(var\\|const\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2) ("*Types*" "^\\s-*(def\\(type\\|struct\\|class\\|ine-condition\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2)) The variable is buffer-local. (defvar imenu-generic-expression nil (#$ . 2653)) (make-variable-buffer-local (quote imenu-generic-expression)) #@370 The function to use for creating a buffer index. It should be a function that takes no arguments and returns an index of the current buffer as an alist. The elements in the alist look like: (INDEX-NAME . INDEX-POSITION). You may also nest index list like (INDEX-NAME . INDEX-ALIST). This function is called within a `save-excursion'. The variable is buffer-local. (defvar imenu-create-index-function (quote imenu-default-create-index-function) (#$ . 3836)) (make-variable-buffer-local (quote imenu-create-index-function)) #@374 Function for finding the next index position. If `imenu-create-index-function' is set to `imenu-default-create-index-function', then you must set this variable to a function that will find the next index, looking backwards in the file. The function should leave point at the place to be connected to the index and it should return nil when it doesn't find another index. (defvar imenu-prev-index-position-function (quote beginning-of-defun) (#$ . 4370)) (make-variable-buffer-local (quote imenu-prev-index-position-function)) #@138 Function for extracting the index name. This function is called after the function pointed out by `imenu-prev-index-position-function'. (defvar imenu-extract-index-name-function nil (#$ . 4905)) (make-variable-buffer-local (quote imenu-extract-index-name-function)) (defalias 'imenu-progress-message '(macro . #[(prevpos &optional relpos reverse) "ÀÁÂÃ\fƒ\f\f‚ÅDDCÇ\fƒÈ‚#ÉÃÊË\fEEÍÎÏ\fÐBBEEEE‡" [and imenu-scanning-message let pos relpos imenu--relative-position reverse if t > + 5 prevpos progn (message imenu-scanning-message pos) setq (pos)] 11])) (defalias 'imenu-example--name-and-position #[nil "ŠÀÁ!ˆ`À ˆ`  Æ“ˆ \f{ ,B‡" [forward-sexp -1 make-marker marker end beg nil] 3]) (defalias 'imenu-example--lisp-extract-index-name #[nil "À ÂŽÃÄ!…ÅÆÇ*‡" [match-data match-data ((store-match-data match-data)) looking-at "(def" nil (byte-code "ÀÁ!ˆÂÃ!ˆ`ÂÄ!ˆ`‰ {*‡" [down-list 1 forward-sexp 2 -1 end beg] 4) ((error))] 3]) (defalias 'imenu-example--create-lisp-index #[nil "À‰‰‰‰dbˆƒ ÇÉ\"ˆ)Ê ƒ«ƒBËÌ!‰ Í\\VƒAÉ\"ˆ)Î ÐŽÑÒ!ƒ§ŠÓÔ!ˆÑÕ!ƒeÖ×!ˆØ \fB‚¦ÑÙ!ƒwÖ×!ˆØ B‚¦ÑÚ!ƒÖ×!ˆ`SfÛUƒ•ÖÜ!ˆÓÔ!ˆÖÔ!ˆØ B‚¦Ö×!ˆØ \nB)*‚ ƒ¾ÝÉ\"ˆ)\fƒÊÞß!\fB B ƒÖÞà! B B\nƒâÞá!\nB B -‡" [nil prev-pos index-unknown-alist index-type-alist index-var-alist index-alist imenu-scanning-message 0 pos message beginning-of-defun imenu--relative-position t 5 match-data match-data ((store-match-data match-data)) looking-at "(def" down-list 1 "def\\(var\\|const\\)" forward-sexp 2 imenu-example--name-and-position "def\\(un\\|subst\\|macro\\|advice\\)" "def\\(type\\|struct\\|class\\|ine-condition\\)" 41 -1 100 imenu-create-submenu-name "Variables" "Types" "Syntax-unknown"] 6]) (byte-code "ÀÁ!„ÂÉÄÅ°ÁBÀ‡" [boundp imenu-example--function-name-regexp-c "^[a-zA-Z0-9]+[ ]?" "\\([a-zA-Z0-9_*]+[ ]+\\)?" "\\([*&]+[ ]*\\)?" "\\([a-zA-Z0-9_*]+\\)[ ]*(" current-load-list] 5) (defalias 'imenu-example--create-c-index #[(&optional regexp) "À‰‰ebˆ\fƒÅÇ\f\"ˆ)È  ÊŽË\f†( ÀÎ#ƒe\fƒIÏÀ!‰\nÐ\\VƒHÇ\f\"ˆ)ÑÒ!ˆŠÓ`Ò\"bˆg) Ô=„ Õ B‚ *\fƒwÖÇ\f\"ˆ) Ÿ+‡" [nil char prev-pos index-alist imenu-scanning-message 0 pos message match-data match-data ((store-match-data match-data)) re-search-forward regexp imenu-example--function-name-regexp-c t imenu--relative-position 5 backward-up-list 1 scan-sexps 59 imenu-example--name-and-position 100] 5]) (byte-code "ÀÁ\nBÃÄ!„ÅÄ\nBÆÄ!ˆÃÇ!„ÅÇ\nBŇ" [("*Rescan*" . -99) imenu--rescan-item current-load-list boundp imenu--index-alist nil make-variable-buffer-local imenu--history-list] 2) (defalias 'imenu--sort-by-name #[(item1 item2) "@ @™‡" [item1 item2] 2]) (defalias 'imenu--relative-position #[(&optional reverse) "`À  ƒ \nZ ÄVƒ\nS Å¥Æ]¥‚&\nSÅ_ Æ]¥*‡" [buffer-size total pos reverse 50000 100 1] 3]) (defalias 'imenu-create-submenu-name #[(name) "À \n\"‡" [format imenu-submenu-name-format name] 3]) (defalias 'imenu--split #[(list n) "Á‰Âƒ.‰A@\fB T‰Uƒ \fŸ BÂÁ‚ \fƒ7\fŸ B Ÿ,‡" [list nil 0 i sublist result remain n] 5]) (defalias 'imenu--split-menu #[(menulist title) "ÀÁÂÃ\f \"\"B‡" ["Index menu" mapcar #[(menu) "ÀÁ\n\" B‡" [format "(%s)" title menu] 3] imenu--split menulist imenu-max-items] 6]) (defalias 'imenu--make-index-alist #[nil "ƒ ƒ ƒ V„Š\f )„ ÅÆ!ˆB‡" [imenu--index-alist imenu-auto-rescan buffer-size imenu-auto-rescan-maxout imenu-create-index-function error "No items suitable for an index found in this buffer" imenu--rescan-item] 2]) (defalias 'imenu--cleanup #[(&optional alist) "„ …ÂÃ\"…ć" [alist imenu--index-alist mapcar #[(item) "À A!ƒ A‰“‡ A:…à A!‡" [markerp item nil imenu--cleanup] 3] t] 3]) (defalias 'imenu--create-keymap-2 #[(alist counter) "ÀÂÃ\f\")‡" [nil map mapcar #[(item) "A<ƒÁ\nT‰@Ã@FÄA\nÅ\\\"\"‡ÆÇB@@)BB‡" [item append counter keymap imenu--create-keymap-2 10 (nil) t end] 6] alist] 3]) (defalias 'imenu--create-keymap-1 #[(title alist) "ÀÁ\nDÃ\fÅ\"\"‡" [append keymap title imenu--create-keymap-2 alist 0] 5]) #@65 Check whether the string STR is contained in multi-level ALIST. (defalias 'imenu--in-alist #[(str alist) "À‰‰‰À ƒ= @‰A A\f@ ˜ƒ(À\f‚\n\n<ƒ\nÇ\n\"‰ƒ\nÀ‰„ ,‡" [nil res tail head elt alist str imenu--in-alist] 5 (#$ . 8959)]) #@223 *Wrapper for index searching functions. Moves point to end of buffer and then repeatedly calls `imenu-prev-index-position-function' and `imenu-extract-index-name-function'. Their results are gathered into an index alist. (defalias 'imenu-default-create-index-function #[nil "À !ƒwÀ\n!ƒwɉdbˆƒ)È Ê \"ˆ ) ƒ`ƒKËÌ!‰ Í\\VƒJÊ \"ˆ )Š\n )\f;ƒ)\f`BB‚)ƒsÎ Ê \"ˆ )+‡ƒÐ!‡ÑÒ\"‡" [fboundp imenu-prev-index-position-function imenu-extract-index-name-function nil name prev-pos index-alist imenu-scanning-message 0 pos message imenu--relative-position t 5 100 imenu-generic-expression imenu--generic-function error "The mode \"%s\" does not take full advantage of imenu.el yet." mode-name] 4 (#$ . -9212)]) (defalias 'imenu--replace-spaces #[(name replacement) "ÀÁ\nÃ#‡" [mapconcat #[(ch) "À Â\"ƒ ‡Ä !‡" [char-equal ch 32 replacement char-to-string] 3] name ""] 4]) (defalias 'imenu--flatten-index-alist #[(index-alist &optional concat-names prefix) "ÀÁ\n\"‡" [mapcan #[(item) "@A …\fƒ\f Q‚ Ç\n!„#\n§ƒ+\nBC‚0È\n\"+‡" [item name pos concat-names prefix imenu-level-separator new-prefix markerp imenu--flatten-index-alist] 3] index-alist] 3]) #@1184 Return an index of the current buffer as an alist. PATTERN is an alist with elements that look like this: (MENU-TITLE REGEXP INDEX). MENU-TITLE is a string used as the title for the submenu or nil if the entries are not nested. REGEXP is a regexp that should match a construct in the buffer that is to be displayed in the menu; i.e., function or variable definitions, etc. It contains a substring which is the name to appear in the menu. See the info section on Regexps for more information. INDEX points to the substring in REGEXP that contains the name (of the function, variable or type) that is to appear in the menu. For emacs-lisp-mode for example PATTERN would look like: '((nil "^\\s-*(def\\(un\\|subst\\|macro\\|advice\\)\\s-+\\([-A-Za-z0-9]+\\)" 2) ("*Vars*" "^\\s-*(def\\(var\\|const\\)\\s-+\\([-A-Za-z0-9]+\\)" 2) ("*Types*" "^\\s-*(def\\(type\\|struct\\|class\\|ine-condition\\)\\s-+\\([-A-Za-z0-9]+\\)" 2))' Returns an index of the current buffer as an alist. The elements in the alist look like: (INDEX-NAME . INDEX-POSITION). They may also be nested index lists like (INDEX-NAME . INDEX-ALIST) depending on pattern. (imenu--generic-function PATTERN). (defalias 'imenu--generic-function #[(patterns) "ÀCÁÂÃÄ Æ#ÇQÁ \n dbˆ\fƒ+ÍÏ\f\"ˆ)Ð ÒŽÓ ÁÔ#ƒj\fƒYÕÔ!‰Ö\\VƒXÏ\f\"ˆ)Á\nŠÍ”bˆ×Ø \"ˆ)‚1*\fƒÙÏ\f\"ˆ)ÚÀ \",‡" [dummy nil "\\(" mapconcat #[(pattern) "A@‡" [pattern] 1] patterns "\\)\\|\\(" "\\)" prev-pos global-regexp found index-alist imenu-scanning-message 0 pos message match-data match-data ((store-match-data match-data)) re-search-backward t imenu--relative-position 5 mapcar #[(pat) "@A@AA@\f?…VÅ\n!…V ” •È{B ;„5\n†KËÌ !\n\"†KÌ !ÍB\nB‰\n@‰ AB¡,+‡" [pat index regexp menu-title found looking-at end beg t --arg1--89602 index-alist assoc imenu-create-submenu-name nil G89600] 4] 100 delete] 8 (#$ . 10423)]) #@129 Let the user select from INDEX-ALIST in a completion buffer with PROMPT. Returns t for rescan and otherwise a position number. (defalias 'imenu--completion-buffer #[(index-alist &optional prompt) "À‰Á \"È=ƒ$É\n†Ë\fÀÌÀÍ&‚'΋ˆ;„1À‚T@˜ƒ>Ì‚TÐ\f\"‰A<ƒSÑ A\n\"‚T +‡" [nil mapcar #[(item) "À @\n\" AB‡" [imenu--replace-spaces item imenu-space-replacement] 3] index-alist prepared-index-alist choice name imenu-always-use-completion-buffer-p never completing-read prompt "Index item: " t imenu--history-list ((byte-code "ÀÁÂÃ\f\"!‘ˆÅdžÉ\fÊËÊÌ& )ʇ" ["*Completions*" display-completion-list all-completions "" prepared-index-alist #[nil "pŠÁqˆ‰*‡" [buffer "*Completions*" completion-reference-buffer] 2] minibuffer-setup-hook completing-read prompt "Index item: " nil t imenu--history-list name] 7)) imenu--rescan-item assoc imenu--completion-buffer] 8 (#$ . 12349)]) #@176 Let the user select from a buffer index from a mouse menu. INDEX-ALIST is the buffer index and EVENT is a mouse event. Returns t for rescan and otherwise a position number. (defalias 'imenu--mouse-menu #[(index-alist event &optional title) "À ƒ+ÂÃ\f :ƒ ‰A@B‚ Ÿ ¡ˆ* \"‚,\f†3È \" Ã\n ƒYÌ @Í AGWƒQ A‚V A@A\" Î \"\n ƒœ\n<ƒŠ\n@§ƒŠ\nGS\n8;ƒŠ\nGS\n8\n‚œ\n@;ƒœ\nA„œ\n@\n\nÃ=ƒ¨\n‚\n<ƒÐÐ\nƒÆÒ\n\f\"@Q‚ÌÒ\n\f\"@#‚\n;ƒç\n@˜†Ô\n\f\"‚\nAU„ÿ\n;ƒ\n@˜ƒÕ‚Ò\n\f\"*‡" [imenu--split-menu imenu-sort-function sort nil index-alist oldlist res title buffer-name menu position imenu-use-keymap-menu imenu--create-keymap-1 1 x-popup-menu event imenu--mouse-menu imenu-level-separator rassq imenu--rescan-item imenu--in-alist t] 8 (#$ . 13259)]) #@619 Let the user select from a buffer index and return the chosen index. If the user originally activated this function with the mouse, a mouse menu is used. Otherwise a completion buffer is used and the user is prompted with PROMPT. If you call this function with index alist ALIST, then it lets the user select from ALIST. With no index alist ALIST, it calls `imenu--make-index-alist' to create the index alist. If `imenu-always-use-completion-buffer-p' is non-nil, then the completion buffer is always used, no matter if the mouse was used or not. The returned value is on the form (INDEX-NAME . INDEX-POSITION). (defalias 'imenu-choose-buffer-index #[(&optional prompt alist) "À <Â\fƒ1 Æš„1 ‰A@)‰@) Ê !„0 ƒ0Ë !ˆ) Â=ƒk\fƒA\f‚CÍ \fƒT„TÏ \"‚YÐ \"‰Â=ƒ1Ò ƒ1À‚1 +‡" [nil last-nonmenu-event t result mouse-triggered index-alist (menu-bar) event position window framep select-window alist imenu--make-index-alist imenu-always-use-completion-buffer-p imenu--mouse-menu imenu--completion-buffer prompt imenu--cleanup imenu--index-alist] 4 (#$ . 14088)]) #@150 Adds an "imenu" entry to the menubar for the current local keymap. NAME is the string naming the menu to be added. See 'imenu' for more information. (defalias 'imenu-add-to-menubar #[(name) "…\fÁ Ã\fÅB#‡" [window-system define-key current-local-map [menu-bar index] name imenu] 5 (#$ . 15180) "sMenu name: "]) #@127 Jump to a place in the buffer chosen using a buffer menu or mouse menu. See `imenu-choose-buffer-index' for more information. (defalias 'imenu #[(index-item) "…;Á ˆÂA!ƒ(ÃA!eV„ ÃA!dWƒ\"~ˆÃA!b‡AeV„6AdWƒ8~ˆAb‡" [index-item push-mark markerp marker-position] 2 (#$ . 15500) (list (save-restriction (widen) (imenu-choose-buffer-index)))]) (provide (quote imenu)) emacs-19.30/lisp/indent.elc100666 13437 1 27701 6053340522 14205 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Sat Nov 18 06:19:28 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/indent.el ;;; emacs version 19.29.91.4. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`indent.el' was compiled for Emacs 19.29 or later")) #@68 Default number of columns for margin-changing functions to indent. (defvar standard-indent 4 (#$ . 477)) #@34 Function to indent current line. (defvar indent-line-function (quote indent-to-left-margin) (#$ . 588)) #@51 Indent line in proper way for current major mode. (defalias 'indent-according-to-mode #[nil " ‡" [indent-line-function] 1 (#$ . 698) nil]) #@51 Indent line in proper way for current major mode. (defalias 'indent-for-tab-command #[(&optional prefix-arg) "Á=ƒ  ‡ ƒ !‡ ‡" [indent-line-function indent-to-left-margin insert-tab prefix-arg] 2 (#$ . 844) "P"]) (defalias 'insert-tab #[nil "ƒÁ ˆ\nƒÃc‡\fi\f¥T_j‡" [abbrev-mode expand-abbrev indent-tabs-mode 9 tab-width] 3]) #@132 Indent all lines starting in the region sideways by ARG columns. Called from a program, takes three arguments, START, END and ARG. (defalias 'indent-rigidly #[(start end arg) "ŠbˆÁ \nbˆn„Ãyˆ`WƒFÄ ÅŠÈÅwˆl)„7ÉÊ \\]Ê\"ˆ`ÈÅwˆ`|ˆ*Ãyˆ‚ʼn“)‡" [end point-marker start 1 current-indentation nil eol-flag indent " " indent-to 0 arg] 4 (#$ . 1186) "r\np"]) #@158 Indent current line to COLUMN. This function removes or adds spaces and tabs at beginning of line only if necessary. It leaves point at end of indentation. (defalias 'indent-line-to #[(column) "À ˆi‰\nWƒ$\n ¥ _Z Vƒ`ÄÅxˆ`|ˆ\nj‚5 \nV…5Æ\nÇ\"ˆ`À ˆ`|)‡" [back-to-indentation cur-col column tab-width " " nil move-to-column t] 4 (#$ . 1561)]) #@183 Return the left margin to use for this line. This is the value of the buffer-local variable `left-margin' plus the value of the `left-margin' text-property at the start of the line. (defalias 'current-left-margin #[nil "ŠÀ ˆÁ\nÃmƒo„`S‚`Â\"†Á\\])‡" [back-to-indentation 0 left-margin get-text-property] 5 (#$ . 1914)]) #@315 Move to the left margin of the current line. With optional argument, move forward N-1 lines first. The column moved to is the one given by the `current-left-margin' function. If the line's indentation appears to be wrong, and this command is called interactively or with optional argument FORCE, it will be fixed. (defalias 'move-to-left-margin #[(&optional n force) "À !ˆÂÃwˆÄ i Vƒ'Ç\"V…5ÉÊ!‚5…5 W…5Ë *‡" [beginning-of-line n " " nil current-left-margin cc lm move-to-column force backward-char 1 indent-to-left-margin] 3 (#$ . 2247) (list (prefix-numeric-value current-prefix-arg) t)]) #@67 Indent current line to the column given by `current-left-margin'. (defalias 'indent-to-left-margin #[nil "ÀÁ !‡" [indent-line-to current-left-margin] 2 (#$ . 2862)]) #@208 Remove left margin indentation from a region. This deletes to the column given by `current-left-margin'. In no case will it delete non-whitespace. Args FROM and TO are optional; default is the whole buffer. (defalias 'delete-to-left-margin #[(&optional from to) "Š†dbˆÁ \n†ebˆn„Ãyˆ`Wƒ.`ÄÅÆ\"ˆ`|ˆÃyˆ‚ʼn“)‡" [to point-marker from 1 move-to-left-margin nil t] 4 (#$ . 3035)]) #@118 Set the left margin of the region to WIDTH. If `auto-fill-mode' is active, re-fill the region to fit the new margin. (defalias 'set-left-margin #[(from to lm) "tƒÀ !Š\nbˆÃÄxˆnƒ` bˆÃÄwˆÆ )Ç\n \"ˆÈ\n É $ˆÊ\n #ˆ ƒBŠÌ\n Ä͉%ˆ) ĉ“‡" [prefix-numeric-value lm from " " nil to point-marker delete-to-left-margin put-text-property left-margin indent-rigidly auto-fill-function fill-region t] 6 (#$ . 3428) "r\nNSet left margin to column: "]) #@119 Set the right margin of the region to WIDTH. If `auto-fill-mode' is active, re-fill the region to fit the new margin. (defalias 'set-right-margin #[(from to lm) "tƒÀ !Š\nbˆÃÄxˆnƒ`)Å\nÇ $ˆ….ŠÉ\nÄʉ%)‡" [prefix-numeric-value lm from " " nil put-text-property to right-margin auto-fill-function fill-region t] 6 (#$ . 3880) "r\nNSet right margin to width: "]) #@279 Programmatically change value of a text-property. For each region between FROM and TO that has a single value for PROPERTY, apply FUNCTION to that value and sets the property to the function's result. Optional fifth argument OBJECT specifies the string or buffer to operate on. (defalias 'alter-text-property #[(from to prop func &optional object) "Á‰Å\f#È\f \n%‰ƒ/Ê\f  \n!%ˆ ‚\f W…CÊ\f  \n!%+‡" [from nil val end begin get-text-property prop object text-property-not-all to put-text-property func] 6 (#$ . 4258)]) #@311 Increase or decrease the left-margin of the region. With no prefix argument, this adds `standard-indent' of indentation. A prefix arg (optional third arg INC noninteractively) specifies the amount to change the margin by, in characters. If `auto-fill-mode' is active, re-fill the region to fit the new margin. (defalias 'increase-left-margin #[(from to inc) "ƒ\nÁ!‚ \nŠ bˆÄÅxˆnƒ`bˆÇ )È ÉÊ$ˆË #ˆ\fƒBŠÍ ÅΉ%ˆ)ʼn“‡" [inc prefix-numeric-value standard-indent from " " nil to point-marker alter-text-property left-margin #[(v) "[ \n†Ã\\]‡" [left-margin inc v 0] 3] indent-rigidly auto-fill-function fill-region t] 6 (#$ . 4812) "*r\nP"]) #@306 Make the left margin of the region smaller. With no prefix argument, decrease the indentation by `standard-indent'. A prefix arg (optional third arg INC noninteractively) specifies the amount to change the margin by, in characters. If `auto-fill-mode' is active, re-fill the region to fit the new margin. (defalias 'decrease-left-margin #[(from to inc) "ƒ\nÁ!‚ \nÃ\f [#‡" [inc prefix-numeric-value standard-indent increase-left-margin from to] 4 (#$ . 5479) "*r\nP"]) #@359 Increase the right-margin of the region. With no prefix argument, increase the right margin by `standard-indent'. A prefix arg (optional third arg INC noninteractively) specifies the amount to change the margin by, in characters. A negative argument decreases the right margin width. If `auto-fill-mode' is active, re-fill the region to fit the new margin. (defalias 'increase-right-margin #[(from to inc) "tƒƒÁ\n!‚ ŠÄ ÇÈ$ˆ …&Ê Ë̉%)‡" [inc prefix-numeric-value current-prefix-arg standard-indent alter-text-property from to right-margin #[(v) " †Â\\‡" [inc v 0] 2] auto-fill-function fill-region nil t] 6 (#$ . 5960) "r\nP"]) #@354 Make the right margin of the region smaller. With no prefix argument, decrease the right margin by `standard-indent'. A prefix arg (optional third arg INC noninteractively) specifies the amount of width to remove, in characters. A negative argument increases the right margin width. If `auto-fill-mode' is active, re-fills region to fit in new margin. (defalias 'decrease-right-margin #[(from to inc) "ƒ\nÁ!‚ \nÃ\f [#‡" [inc prefix-numeric-value standard-indent increase-right-margin from to] 4 (#$ . 6612) "*r\nP"]) #@391 Move to the beginning of the text on this line. With optional argument, move forward N-1 lines first. From the beginning of the line, moves past the left-margin indentation, the fill-prefix, and any indentation used for centering or right-justifying the line, but does not move past any whitespace that was explicitly inserted (such as a tab used to indent the first line of a paragraph). (defalias 'beginning-of-line-text #[(&optional n) "À !ˆÂÃwˆ\fƒ&\fŘ„&\f`d\fG`\\^{šƒ6\fGuˆ‚6ƒ6Ç!ƒ6É•bˆÊ Ë>…@ÂÃw‡" [beginning-of-line n " " nil fill-prefix "" adaptive-fill-mode looking-at adaptive-fill-regexp 0 current-justification (center right)] 5 (#$ . 7143) "p"]) #@144 Short cut function to indent region using `indent-according-to-mode'. A value of nil means really run `indent-according-to-mode' on each line. (defvar indent-region-function nil (#$ . 7820)) #@374 Indent each nonblank line in the region. With no argument, indent each line using `indent-according-to-mode', or use `indent-region-function' to do the whole region if that's non-nil. If there is a fill prefix, make each line start with the fill prefix. With argument COLUMN, indent each line to that column. Called from a program, takes three args: START, END and COLUMN. (defalias 'indent-region #[(start end column) "„q ƒ7Š\nbˆÃ \fbˆÅ !`\nW…5Ç!„/nƒ,l„/ cˆÈyˆ‚*‡ ƒB \f\n\"‡Š\nbˆÃ \fbˆn„SÈyˆ`\nWƒknƒal„e\n ˆÈyˆ‚S\nˉ“)‡Ì!Š\nbˆÃ \fbˆn„†Èyˆ`\nWƒ£`ÍËwˆ`|ˆl„ÎÏ\"ˆÈyˆ‚†\nˉ“)‡" [column fill-prefix end point-marker start regexp-quote regexp looking-at 1 indent-region-function indent-line-function nil prefix-numeric-value " " indent-to 0] 3 (#$ . 8018) "r\nP"]) #@48 Indent a new line like previous nonblank line. (defalias 'indent-relative-maybe #[nil "ÀÁ!‡" [indent-relative t] 2 (#$ . 8817) nil]) #@254 Space out to under next indent point in previous nonblank line. An indent point is a non-whitespace character following whitespace. If the previous nonblank line has no indent points beyond the column point starts at, `tab-to-tab-stop' is done instead. (defalias 'indent-relative #[(&optional unindented-ok) "ƒÁ ˆiŠÅyˆÆÇÂÈ#ƒLŠÉyˆ`)\nË\f!ˆi\fVƒ-ÌÉ!ˆÍÎ!„=„=Ð\nwˆÑ\nwˆ`\nU„Ki)) ƒvÒ `ÑÂxˆ`|ˆÔ Å\"ˆ`Vƒmbˆ‰“)‚xÕ *‡" [abbrev-mode expand-abbrev nil indent start-column 0 re-search-backward "^[^\n]" t 1 end move-to-column backward-char looking-at "[ ]" unindented-ok "^ " " " point-marker opoint indent-to tab-to-tab-stop] 4 (#$ . 8957) "P"]) #@126 *List of tab stop positions used by `tab-to-tab-stops'. This should be a list of integers, ordered from smallest to largest. (defvar tab-stop-list (quote (8 16 24 32 40 48 56 64 72 80 88 96 104 112 120)) (#$ . -9632)) #@34 Keymap used in `edit-tab-stops'. (defvar edit-tab-stops-map nil (#$ . 9856)) (byte-code "„Á ÂÃÄ#ˆÂÅÄ#ˆÁ‡" [edit-tab-stops-map make-sparse-keymap define-key "" edit-tab-stops-note-changes ""] 4) #@104 Buffer whose tab stops are being edited--in case the variable `tab-stop-list' is local in that buffer. (defvar edit-tab-stops-buffer nil (#$ . 10067)) #@294 Edit the tab stops used by `tab-to-tab-stop'. Creates a buffer *Tab Stops* containing text describing the tab stops. A colon indicates a column where there is a tab stop. You can add or remove colons and then do \\[edit-tab-stops-note-changes] to make changes take effect. (defalias 'edit-tab-stops #[nil "pÁÂÃ!!ˆÄ !ˆÆÇ!ˆÈÉÊ!ˆË\fÍ ˆ‰ƒ8Ð@Ñ\"ˆÒcˆA‰„%)ÑÔcˆÕWƒXÖ\\cˆ×cˆT‰‚AÔcˆÑVƒnØcˆS‰‚])Ùcˆeb‡" [edit-tab-stops-buffer switch-to-buffer get-buffer-create "*Tab Stops*" use-local-map edit-tab-stops-map make-local-variable indent-tabs-mode nil overwrite-mode 1 t truncate-lines erase-buffer tab-stop-list tabs indent-to 0 58 count 10 8 48 " " "0123456789" "\nTo install changes, type C-c C-c"] 4 (#$ . 10225) nil]) #@35 Put edited tab stops into effect. (defalias 'edit-tab-stops-note-changes #[nil "ÀŠÂbˆÀˆÃÄÀÅ#ƒi B‚ )ÆpÇ!ˆ!ˆ  )ÊË!‡" [nil tabs 1 search-backward ":" t bury-buffer switch-to-buffer edit-tab-stops-buffer tab-stop-list message "Tab stops installed"] 4 (#$ . 11004) nil]) #@186 Insert spaces or tabs to next defined tab-stop column. The variable `tab-stop-list' is a list of columns at which there are tab stops. Use \[edit-tab-stops] to edit them interactively. (defalias 'tab-to-tab-stop #[nil "ƒhzÁUƒ ˆ ‰ƒ\"i\f@Yƒ\"\fA‰„\fƒ7`ÆÇxˆ` |ˆ\f@j)‚9Èc)‡" [abbrev-mode 119 expand-abbrev tab-stop-list tabs opoint " " nil 32] 3 (#$ . 11286) nil]) #@175 Move point to next defined tab-stop column. The variable `tab-stop-list' is a list of columns at which there are tab stops. Use \[edit-tab-stops] to edit them interactively. (defalias 'move-to-tab-stop #[nil "‰ƒi @Yƒ A‰„ …Q`à @Ä\"ˆŠ\nbˆhÅ=…PgÆ=…Pi¥_iVƒLhÅ=ƒLÉuˆ‚9`\n|)*)‡" [tab-stop-list tabs before move-to-column t 32 9 tab-width tabend -1] 4 (#$ . 11670) nil]) (byte-code "À ÂÃ#ˆÀ\fÅÆ#ˆÀÂÈ#ˆÀ\fÉÊ#‡" [define-key global-map " " indent-for-tab-command esc-map "" indent-region ctl-x-map indent-rigidly "i" tab-to-tab-stop] 4) emacs-19.30/lisp/inf-lisp.elc100666 74777 1 36331 6055512062 14334 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 24 22:57:29 1995 ;;; from file /home/fsf/rms/e19/lisp/inf-lisp.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`inf-lisp.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require comint lisp-mode] 2) #@229 *What not to save on inferior Lisp's input history. Input matching this regexp is not saved on the input history in Inferior Lisp mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword (as in :a, :c, etc.) (defvar inferior-lisp-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'" (#$ . -527)) (byte-code "ÀÁ!„ÂÁ B „CÄ !‰¤Ç ÈÉ#ˆÇ ÊË#ˆÇ ÌÍ#ˆÇ ÎÏ#ˆÇ ÐÑ#ˆÇ ÒÓ#ˆÇ ÔÕ#ˆÇ×Ø#ˆÇÈÉ#ˆÇÙØ#ˆÇÚÛ#ˆÇÜÝ#ˆÇÞß#ˆÇÊË#ˆÇÌÍ#ˆÇÎÏ#ˆÇÐÑ#ˆÇÒÓ#ˆÇÔÕ#‡" [boundp inferior-lisp-mode-map nil current-load-list copy-keymap comint-mode-map shared-lisp-mode-map define-key "" lisp-eval-last-sexp "\f" lisp-load-file " " lisp-compile-file "" lisp-show-arglist "" lisp-describe-sym "" lisp-show-function-documentation "" lisp-show-variable-documentation lisp-mode-map "˜" lisp-eval-defun "" "" lisp-eval-region "" lisp-compile-defun "" switch-to-lisp] 5) (defalias 'inferior-lisp-install-letter-bindings #[nil "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀÊË#ˆÀÌÍ#ˆÀÎÏ#ˆÀÐÑ#ˆÀÒÓ#ˆÀÔÕ#‡" [define-key lisp-mode-map "e" lisp-eval-defun-and-go "r" lisp-eval-region-and-go "c" lisp-compile-defun-and-go "z" switch-to-lisp "l" lisp-load-file "k" lisp-compile-file "a" lisp-show-arglist "d" lisp-describe-sym "f" lisp-show-function-documentation "v" lisp-show-variable-documentation inferior-lisp-mode-map] 4]) #@74 *Program name for invoking an inferior Lisp with for Inferior Lisp mode. (defvar inferior-lisp-program "lisp" (#$ . -1918)) #@425 *Format-string for building a Lisp expression to load a file. This format string should use `%s' to substitute a file name and should result in a Lisp expression that will command the inferior Lisp to load that file. The default works acceptably on most Lisps. The string "(progn (load \"%s\" :verbose nil :print t) (values))\n" produces cosmetically superior output for this application, but it works only in Common Lisp. (defvar inferior-lisp-load-command "(load \"%s\")\n" (#$ . -2049)) #@391 Regexp to recognise prompts in the Inferior Lisp mode. Defaults to "^[^> \n]*>+:? *", which works pretty good for Lucid, kcl, and franz. This variable is used to initialize `comint-prompt-regexp' in the Inferior Lisp buffer. More precise choices: Lucid Common Lisp: "^\\(>\\|\\(->\\)+\\) *" franz: "^\\(->\\|<[0-9]*>:\\) *" kcl: "^>+ *" This is a fine thing to set in your .emacs file. (defvar inferior-lisp-prompt "^[^> \n]*>+:? *" (#$ . 2547)) #@1668 *The current inferior-lisp process buffer. MULTIPLE PROCESS SUPPORT =========================================================================== To run multiple Lisp processes, you start the first up with \[inferior-lisp]. It will be in a buffer named `*inferior-lisp*'. Rename this buffer with \[rename-buffer]. You may now start up a new process with another \[inferior-lisp]. It will be in a new buffer, named `*inferior-lisp*'. You can switch between the different process buffers with \[switch-to-buffer]. Commands that send text from source buffers to Lisp processes -- like `lisp-eval-defun' or `lisp-show-arglist' -- have to choose a process to send to, when you have more than one Lisp process around. This is determined by the global variable `inferior-lisp-buffer'. Suppose you have three inferior Lisps running: Buffer Process foo inferior-lisp bar inferior-lisp<2> *inferior-lisp* inferior-lisp<3> If you do a \[lisp-eval-defun] command on some Lisp source code, what process do you send it to? - If you're in a process buffer (foo, bar, or *inferior-lisp*), you send it to that process. - If you're in some other buffer (e.g., a source file), you send it to the process attached to buffer `inferior-lisp-buffer'. This process selection is performed by function `inferior-lisp-proc'. Whenever \[inferior-lisp] fires up a new process, it resets `inferior-lisp-buffer' to be the new process's buffer. If you only run one process, this does the right thing. If you run multiple processes, you can change `inferior-lisp-buffer' to another process buffer with \[set-variable]. (defvar inferior-lisp-buffer nil (#$ . -3005)) #@43 *Hook for customising Inferior Lisp mode. (defvar inferior-lisp-mode-hook nil (#$ . -4725)) #@1829 Major mode for interacting with an inferior Lisp process. Runs a Lisp interpreter as a subprocess of Emacs, with Lisp I/O through an Emacs buffer. Variable `inferior-lisp-program' controls which Lisp interpreter is run. Variables `inferior-lisp-prompt', `inferior-lisp-filter-regexp' and `inferior-lisp-load-command' can customize this mode for different Lisp interpreters. For information on running multiple processes in multiple buffers, see documentation for variable `inferior-lisp-buffer'. \{inferior-lisp-mode-map} Customisation: Entry to this mode runs the hooks on `comint-mode-hook' and `inferior-lisp-mode-hook' (in that order). You can send text to the inferior Lisp process from other buffers containing Lisp source. switch-to-lisp switches the current buffer to the Lisp process buffer. lisp-eval-defun sends the current defun to the Lisp process. lisp-compile-defun compiles the current defun. lisp-eval-region sends the current region to the Lisp process. lisp-compile-region compiles the current region. Prefixing the lisp-eval/compile-defun/region commands with a \[universal-argument] causes a switch to the Lisp process buffer after sending the text. Commands: Return after the end of the process' output sends the text from the end of process to point. Return before the end of the process' output copies the sexp ending at point to the end of the process' output, and sends it. Delete converts tabs to spaces as it moves back. Tab indents for Lisp; with argument, shifts rest of expression rigidly with the current line. C-M-q does Tab on each line starting within following expression. Paragraphs are separated only by blank lines. Semicolons start comments. If you accidentally suspend your process, use \[comint-continue-subjob] to continue it. (defalias 'inferior-lisp-mode #[nil "À ˆ ÃÅÇÉÊ!ˆË\f!ˆÍÏÑÓÔ!‡" [comint-mode inferior-lisp-prompt comint-prompt-regexp inferior-lisp-mode major-mode "Inferior Lisp" mode-name (":%s") mode-line-process lisp-mode-variables t use-local-map inferior-lisp-mode-map lisp-get-old-input comint-get-old-input lisp-input-filter comint-input-filter ignore comint-input-sentinel run-hooks inferior-lisp-mode-hook] 2 (#$ . 4825) nil]) #@54 Return a string containing the sexp ending at point. (defalias 'lisp-get-old-input #[nil "Š`Á ˆ`{*‡" [end backward-sexp] 2 (#$ . 7092)]) #@56 t if STR does not match `inferior-lisp-filter-regexp'. (defalias 'lisp-input-filter #[(str) "À \n\"?‡" [string-match inferior-lisp-filter-regexp str] 3 (#$ . 7237)]) #@420 Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'. If there is a process already running in `*inferior-lisp*', just switch to that buffer. With argument, allows you to edit the command line (default is value of `inferior-lisp-program'). Runs the hooks from `inferior-lisp-mode-hook' (after the `comint-mode-hook' is run). (Type \[describe-mode] in the process buffer for a list of commands.) (defalias 'inferior-lisp #[(cmd) "ÀÁ!„ !ÅÆÇ\f@È\fA%qˆÉ ˆ)Á\nËÁ!‡" [comint-check-proc "*inferior-lisp*" inferior-lisp-args-to-list cmd cmdlist apply make-comint "inferior-lisp" nil inferior-lisp-mode inferior-lisp-buffer pop-to-buffer] 6 (#$ . 7410) (list (if current-prefix-arg (read-string "Run lisp: " inferior-lisp-program) inferior-lisp-program))]) (defalias (quote run-lisp) (quote inferior-lisp)) (defalias 'inferior-lisp-args-to-list #[(string) "ÀÁ\n\"‰„\nC‚8 ÄU„%\nÄ OÅ\n Æ\\\nGO!B‚8ÀÇ\n\"‰…7Å\n\nGO!))‡" [string-match "[ ]" string where 0 inferior-lisp-args-to-list 1 "[^ ]" pos] 6]) #@115 Send the current region to the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards. (defalias 'lisp-eval-region #[(start end &optional and-go) "ÀÁ \n #ˆÄÁ Å\"ˆ…ÇÈ!‡" [comint-send-region inferior-lisp-proc start end comint-send-string "\n" and-go switch-to-lisp t] 4 (#$ . 8447) "r\nP"]) #@114 Send the current defun to the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards. (defalias 'lisp-eval-defun #[(&optional and-go) "ŠÀ ˆÁÂxˆ`Ä ˆÅ` \"ˆ*…ÇÈ!‡" [end-of-defun " \n \f" nil end beginning-of-defun lisp-eval-region and-go switch-to-lisp t] 3 (#$ . 8775) "P"]) #@114 Send the previous sexp to the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards. (defalias 'lisp-eval-last-sexp #[(&optional and-go) "ÀŠÁ ˆ`)`\n#‡" [lisp-eval-region backward-sexp and-go] 4 (#$ . 9088) "P"]) #@118 Compile the current region in the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards. (defalias 'lisp-compile-region #[(start end &optional and-go) "ÀÁ ÂÃ\f {\"\"ˆ…ÇÈ!‡" [comint-send-string inferior-lisp-proc format "(funcall (compile nil `(lambda () (progn 'compile %s))))\n" start end and-go switch-to-lisp t] 6 (#$ . 9335) "r\nP"]) #@117 Compile the current defun in the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards. (defalias 'lisp-compile-defun #[(&optional and-go) "ŠÀ ˆÁÂxˆ`Ä ˆÅ` \"ˆ*…ÇÈ!‡" [end-of-defun " \n \f" nil e beginning-of-defun lisp-compile-region and-go switch-to-lisp t] 3 (#$ . 9712) "P"]) #@95 Switch to the inferior Lisp process buffer. With argument, positions cursor at end of buffer. (defalias 'switch-to-lisp #[(eob-p) "À !ƒ  !ˆ‚ÃÄ!ˆ …Æ ˆdb‡" [get-buffer inferior-lisp-buffer pop-to-buffer error "No current inferior Lisp buffer" eob-p push-mark] 2 (#$ . 10031) "P"]) #@73 Send the current region to the inferior Lisp, and switch to its buffer. (defalias 'lisp-eval-region-and-go #[(start end) "À \nÃ#‡" [lisp-eval-region start end t] 4 (#$ . 10322) "r"]) #@72 Send the current defun to the inferior Lisp, and switch to its buffer. (defalias 'lisp-eval-defun-and-go #[nil "ÀÁ!‡" [lisp-eval-defun t] 2 (#$ . 10511) nil]) #@76 Compile the current region in the inferior Lisp, and switch to its buffer. (defalias 'lisp-compile-region-and-go #[(start end) "À \nÃ#‡" [lisp-compile-region start end t] 4 (#$ . 10676) "r"]) #@75 Compile the current defun in the inferior Lisp, and switch to its buffer. (defalias 'lisp-compile-defun-and-go #[nil "ÀÁ!‡" [lisp-compile-defun t] 2 (#$ . 10874) nil]) #@187 Record last directory and file used in loading or compiling. This holds a cons cell of the form `(DIRECTORY . FILE)' describing the last `lisp-load-file' or `lisp-compile-file' command. (defvar lisp-prev-l/c-dir/file nil (#$ . 11049)) #@251 *Used to determine if a buffer contains Lisp source code. If it's loaded into a buffer that is in one of these major modes, it's considered a Lisp source file by `lisp-load-file' and `lisp-compile-file'. Used by these commands to determine defaults. (defvar lisp-source-modes (quote (lisp-mode)) (#$ . -11291)) #@50 Load a Lisp file into the inferior Lisp process. (defalias 'lisp-load-file #[(file-name) "À !ˆÂ !à !BÅÆ Ç \"\"ˆÉÊ!‡" [comint-check-source file-name file-name-directory file-name-nondirectory lisp-prev-l/c-dir/file comint-send-string inferior-lisp-proc format inferior-lisp-load-command switch-to-lisp t] 5 (#$ . 11608) (comint-get-source "Load Lisp file: " lisp-prev-l/c-dir/file lisp-source-modes nil)]) #@51 Compile a Lisp file in the inferior Lisp process. (defalias 'lisp-compile-file #[(file-name) "À !ˆÂ !à !BÅÆ Ç ÈQ\"ˆÉÊ!‡" [comint-check-source file-name file-name-directory file-name-nondirectory lisp-prev-l/c-dir/file comint-send-string inferior-lisp-proc "(compile-file \"" "\")\n" switch-to-lisp t] 5 (#$ . 12022) (comint-get-source "Compile Lisp file: " lisp-prev-l/c-dir/file lisp-source-modes nil)]) #@64 Command to query inferior Lisp for a function's documentation. (defvar lisp-function-doc-command "(let ((fn '%s))\n (format t \"Documentation for ~a:~&~a\"\n fn (documentation fn 'function))\n (values))\n" (#$ . 12434)) #@64 Command to query inferior Lisp for a variable's documentation. (defvar lisp-var-doc-command "(let ((v '%s))\n (format t \"Documentation for ~a:~&~a\"\n v (documentation v 'variable))\n (values))\n" (#$ . 12673)) #@58 Command to query inferior Lisp for a function's arglist. (defvar lisp-arglist-command "(let ((fn '%s))\n (format t \"Arglist for ~a: ~a\" fn (arglist fn))\n (values))\n" (#$ . 12904)) #@64 Command to query inferior Lisp for a variable's documentation. (defvar lisp-describe-sym-command "(describe '%s)\n" (#$ . 13102)) (defalias 'lisp-symprompt #[(prompt default) "ƒ\fÁ #‚ ÄPÅ !‰GÇUƒ ‚\"*C‡" [default format "%s (default %s): " prompt ": " read-string ans 0] 5]) #@101 Returns the name of the function called in the current call. The value is nil if it can't find one. (defalias 'lisp-fn-called-at-pt #[nil "ÀÁ‡" [nil (byte-code "ŠŒe`ÀZ]d}ˆÁÂ!ˆÂuˆÃp!‰9…\f+‡" [1000 backward-up-list 1 read obj] 4) ((error))] 3 (#$ . 13397)]) (defalias 'lisp-var-at-pt #[nil "ÀÁ‡" [nil (byte-code "ŠÀÁ!ˆÂÃwˆÄp!‰9… *‡" [forward-sexp -1 "'" nil read obj] 3) ((error))] 3]) #@118 Send a command to the inferior Lisp to give documentation for function FN. See variable `lisp-function-doc-command'. (defalias 'lisp-show-function-documentation #[(fn) "ÀÁ  \f\"\"‡" [comint-proc-query inferior-lisp-proc format lisp-function-doc-command fn] 5 (#$ . 13798) (byte-code "ÀÁ \"‡" [lisp-symprompt "Function doc" lisp-fn-called-at-pt] 3)]) #@113 Send a command to the inferior Lisp to give documentation for function FN. See variable `lisp-var-doc-command'. (defalias 'lisp-show-variable-documentation #[(var) "ÀÁ  \f\"\"‡" [comint-proc-query inferior-lisp-proc format lisp-var-doc-command var] 5 (#$ . 14157) (byte-code "ÀÁ \"‡" [lisp-symprompt "Variable doc" lisp-var-at-pt] 3)]) #@105 Send a query to the inferior Lisp for the arglist for function FN. See variable `lisp-arglist-command'. (defalias 'lisp-show-arglist #[(fn) "ÀÁ  \f\"\"‡" [comint-proc-query inferior-lisp-proc format lisp-arglist-command fn] 5 (#$ . 14502) (byte-code "ÀÁ \"‡" [lisp-symprompt "Arglist" lisp-fn-called-at-pt] 3)]) #@103 Send a command to the inferior Lisp to describe symbol SYM. See variable `lisp-describe-sym-command'. (defalias 'lisp-describe-sym #[(sym) "ÀÁ  \f\"\"‡" [comint-proc-query inferior-lisp-proc format lisp-describe-sym-command sym] 5 (#$ . 14823) (byte-code "ÀÁ \"‡" [lisp-symprompt "Describe" lisp-var-at-pt] 3)]) (defalias 'inferior-lisp-proc #[nil "À Â=ƒ p‚\f !‰†ÅÆ!)‡" [get-buffer-process major-mode inferior-lisp-mode inferior-lisp-buffer proc error "No Lisp subprocess; see variable `inferior-lisp-buffer'"] 4]) #@98 This hook is run when the library `inf-lisp' is loaded. This is a good place to put keybindings. (defvar inferior-lisp-load-hook nil (#$ . 15351)) (byte-code "ÀÁ!ˆÂÃ!‡" [run-hooks inferior-lisp-load-hook provide inf-lisp] 2) emacs-19.30/lisp/info.elc100666 13437 1 111621 6054601020 13664 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 22 05:56:12 1995 ;;; from file /home/fsf/rms/e19/lisp/info.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`info.el' was compiled for Emacs 19.29 or later")) #@100 List of info nodes user has visited. Each element of list is a list (FILENAME NODENAME BUFFERPOS). (defvar Info-history nil (#$ . 467)) #@320 *Non-nil means the \\[Info-edit] command in Info can edit the current node. This is convenient if you want to write info files by hand. However, we recommend that you not do this. It is better to write a Texinfo file and generate the Info file from that, because that gives you a printed manual as well. (defvar Info-enable-edit nil (#$ . -610)) #@118 Non-nil allows Info to execute Lisp code associated with nodes. The Lisp code is executed when the node is selected. (defvar Info-enable-active-nodes t (#$ . 978)) #@56 *Non-nil enables highlighting and fonts in Info nodes. (defvar Info-fontify t (#$ . -1148)) #@64 *Maximum size of menu to fontify if `Info-fontify' is non-nil. (defvar Info-fontify-maximum-menu-size 30000 (#$ . -1246)) #@646 List of directories to search for Info documentation files. nil means not yet initialized. In this case, Info uses the environment variable INFOPATH to initialize it, or `Info-default-directory-list' if there is no INFOPATH variable in the environment. The last element of `Info-default-directory-list' is the directory where Emacs installs the Info files that come with it. If you run the Emacs executable from the `src' directory in the Emacs source tree, the `info' directory in the source tree is used as the last element, in place of the installation Info directory. This is useful when you run a version of Emacs without installing it. (defvar Info-directory-list (byte-code "ÀÁ!ÂÃ!ƒ ‚\fÅ=ƒÆ‚ÇÈÉ\n\" …'ÈÉ \"Ì ‰ƒs̉GÓVƒlÔ \"†NGÓOBTG^ÌO‰‚=Ÿ*‚¿ƒ†Õ!ƒ† ‚Š  „°Õ !ƒ°\fÅ=„µ\f×=„µÈÙ \"˜„µ‚¿Ú Ú!AB!-‡" [getenv "INFOPATH" boundp path-separator system-type ms-dos ";" ":" expand-file-name "info/" source-directory installation-directory nil alternative sibling source path idx list 0 string-match file-exists-p Info-default-directory-list windows-nt exec-directory "lib-src/" reverse] 7) (#$ . 1375)) #@135 List of additional directories to search for Info documentation files. These directories are not searched for merging the `dir' file. (defvar Info-additional-directory-list nil (#$ . 2567)) #@193 Info file that Info is now looking at, or nil. This is the name that was specified in Info, not the actual file name. It doesn't contain directory names or file name extensions added by Info. (defvar Info-current-file nil (#$ . 2764)) #@113 Info subfile that is actually in the *info* buffer now, or nil if current info file is not split into subfiles. (defvar Info-current-subfile nil (#$ . 3006)) #@51 Name of node that Info is now looking at, or nil. (defvar Info-current-node nil (#$ . 3170)) #@112 Marker pointing at beginning of current Info file's tag table. Marker points nowhere if file has no tag table. (defvar Info-tag-table-marker (make-marker) (#$ . 3270)) #@47 Cached completion list for current Info file. (defvar Info-current-file-completions nil (#$ . 3444)) #@55 List of possible matches for last Info-index command. (defvar Info-index-alternatives nil (#$ . 3551)) #@57 Non-nil if Emacs was started solely as an Info browser. (defvar Info-standalone nil (#$ . 3660)) #@280 List of file name suffixes and associated decoding commands. Each entry should be (SUFFIX . STRING); the file is given to the command as standard input. If STRING is nil, no decoding is done. Because the SUFFIXes are tried in order, the empty string should be last in the list. (defvar Info-suffix-list (byte-code "Á=ƒ‡Ç" [system-type ms-dos ((".gz" . "gunzip") (".z" . "gunzip") (".inf") ("")) ((".info.Z" . "uncompress") (".info.Y" . "unyabba") (".info.gz" . "gunzip") (".info.z" . "gunzip") (".info") (".Z" . "uncompress") (".Y" . "unyabba") (".gz" . "gunzip") (".z" . "gunzip") (""))] 2) (#$ . 3764)) (defalias 'info-insert-file-contents-1 #[(filename suffix) "Á=„\n\n P‡Ä\n!Æ\nG GZÇZ]É\nÆXƒ-\n‰GSHË=ƒ2 ÇÉOÆÌ GZ]^\n\nÆ\nG\nZZO P+‡" [system-type ms-dos filename suffix file-name-sans-extension sans-exts 0 1 ext-len nil ext-left 46 3] 5]) #@122 Insert the contents of an info file in the current buffer. Do the right thing if the file has been compressed or zipped. (defalias 'info-insert-file-contents #[(filename &optional visit) "Á‰Å!ƒ0\fƒ&ÇÈ\f@@!ÉP\"„&\fA‰„\f@A‚]\fƒGÅÊ\f@@\"!„G\fA‰„4Ê\f@@\"\f@A\f„]ËÌ\"ˆÍÎ!ƒpÏ ƒpÐ !ƒpÁÑ \"ˆ\n…ÁÓ !†ƒÖed\n׉%*+‡" [Info-suffix-list nil decoder fullname tail file-exists-p filename string-match regexp-quote "$" info-insert-file-contents-1 error "Can't find %s or any compressed version of it" featurep jka-compr jka-compr-installed-p jka-compr-get-compression-info insert-file-contents visit file-name-directory default-directory buffer-read-only call-process-region t] 7 (#$ . 4636)]) #@243 Enter Info, the documentation browser. Optional argument FILE specifies the file to examine; the default is the top-level directory of Info. In interactive use, a prefix argument directs this command to read a file name from the minibuffer. (defalias 'info #[(&optional file) "ƒ ÁÂÃQ!‡ÄÅ!ƒÆÅ!‡Ç ‡" [file Info-goto-node "(" ")" get-buffer "*info*" pop-to-buffer Info-directory] 4 (#$ . 5367) (byte-code "… ÁÂÉÄ$C‡" [current-prefix-arg read-file-name "Info file name: " nil t] 5)]) #@153 Run Emacs as a standalone Info reader. Usage: emacs -f info-standalone [filename] In standalone mode, \\[Info-exit] exits Emacs itself. (defalias 'info-standalone #[nil "À\nƒÃÄ\n@\"„ÅÆÇ‡È ‡" [t Info-standalone command-line-args-left string-match "^-" err (byte-code "À @!ˆ A‰‡" [info command-line-args-left] 2) ((error (byte-code "ÀÁ ¢Ä=ƒ A@‚ \"!ˆÅ ‡" [send-string-to-terminal format "%s\n" err error save-buffers-kill-emacs] 5))) info] 3 (#$ . 5863)]) (defalias 'Info-find-node #[(filename nodename &optional no-going-back) "ƒ¨Á‰‰Å!Æ!—ǘƒÈ‚™ÉÊ\"ƒ'Ë‚AÌ!ƒ1Í‚Aƒ?Ï\"‚A‰ƒ˜\n„˜Ò@\"Ò—@\"‰ƒŽ\n„ŽÕÖ\f@@\"!ƒw\f‚…ÕÖ @@\"!ƒ… A‰„b)A‰„G)\nƒ¢\n‚§×Ø\"ˆ+ƒ½„½`EBÝÞ!ˆßp!ˆ á=„Ïá ˆ~ˆÁ⎃yš„yÁ#ÁÁ$Á%Á&Á'è ˆÈ=ƒé ˆ‚\fêÈ\"ˆë!,íÁ!ˆ.Á‰“ˆdbˆïyˆ0ñ˜„kòóÁÈ#ƒkÁ4õö!ˆ`4Š÷yˆøù!)ƒcŠp:ûü!qˆßp!ˆÈ=è ˆþ:!ˆ.ÿ•Á“ˆ*‚j.4Á“ˆ)È=ƒuÇ‚v)0ñ˜ƒŒ0@ ˆ‚üeAB0!CQDEF.!ƒäŠG.!qˆ.bˆHDÁÈ#ƒÛIp!EpJÞ!=„ãKE!E‚ã×L0\"ˆ)eEMZ]bˆNOˆ*P ˆ)eb‡" [filename nil found temp-downcase temp substitute-in-file-name file-name-nondirectory "dir" t string-match "^\\./" ("./") file-name-absolute-p (nil) Info-additional-directory-list append Info-directory-list dirs expand-file-name Info-suffix-list suffix-list file-exists-p info-insert-file-contents-1 error "Info file %s does not exist" Info-current-file no-going-back Info-current-node Info-history switch-to-buffer "*info*" buffer-disable-undo major-mode Info-mode ((byte-code "„! „!\nƒ!\n@\nAÄ @ A@Å#ˆÆ 8bˆ)ć" [Info-current-node no-going-back Info-history hist Info-find-node t 2] 4)) buffer-read-only Info-current-subfile Info-current-file-completions Info-index-alternatives buffer-file-name erase-buffer Info-insert-dir info-insert-file-contents file-name-directory default-directory set-buffer-modified-p Info-tag-table-marker -8 nodename "*" search-forward "\nEnd tag table\n" pos search-backward "\nTag table:\n" 2 looking-at "(Indirect)\n" buf get-buffer-create " *info tag table*" case-fold-search insert-buffer-substring 0 Info-set-mode-line "Node: *" regexp-quote " *[, \n]" regexp guesspos marker-position marker-buffer re-search-forward read get-buffer Info-read-subfile "No such node: \"%s\"" 1000 foo (byte-code "ÀÁÂÃ#ƒ\"Äyˆ`ÄyˆÆ Ã#ƒÈÉÃ\"ˆ)‚ÊË\f\"‡" [search-forward "\n" nil t 1 beg re-search-backward regexp throw foo error "No such node: %s" nodename] 4) Info-select-node] 5]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ B‡" [boundp Info-dir-contents nil current-load-list Info-dir-contents-directory Info-dir-file-attributes] 2) (defalias 'Info-insert-dir #[nil "ƒ ƒÂÃÄÅ \"B!ƒcˆ‚\nlj‰‰‰ \n \f Ç ƒÅÎÏ @!!‰„¼Ñ!„¼ÇÏÓ\"Ô!†…ÏÕ\"Ô!†…ÏÖ\"Ô!†…Ï×\"Ô!Ñ!BBƒ»Š\f„¢ÙÚ!ˆÛÜ!qˆÝ!ˆp\fB\fB B)* A )‚.\f„ÎÞß!ˆ\f@ \fA\nà !ˆŠ qˆ!)\"\nƒD\n@#Š#qˆebˆäåÇæ#ƒ:lj‰'()êyˆ`)ëì!ˆíî!ˆï (íìÇð#ˆñyˆ`'(#)'F B +‚ù*\nA‰\n„ìäå!ˆêyˆò æŠíóÇæ#ˆ`)'4 5 ƒ @@(Š(—5„“äö÷(!øQ'æ#„“ù(øú±ˆ(5B5* A‰ „e, ƒç @@(ebˆäû÷(!üQÇæ#ƒÉíìÇð#ˆñyˆúcˆ‚Ódbˆý(þ±ˆÿ@ @A\"ˆ) A‰ „£\fƒýA\f@!ˆ\fA‰\f„ìÙB!ˆ.C \"‰!‡" [Info-dir-contents Info-dir-file-attributes eval and mapcar #[(elt) "À @!‰ƒÃ\n›Ä ˆÃ A›Ä ˆ A\n)š‡" [file-attributes elt curr 4 0] 3] Info-directory-list nil dirs-done nodes others buffer buffers dirs file-truename expand-file-name truename directory-file-name file "dir" file-attributes "DIR" "dir.info" "DIR.INFO" attrs message "Composing main Info directory..." generate-new-buffer "info dir" insert-file-contents error "Can't find the info directory node" insert-buffer default-directory Info-dir-contents-directory other re-search-forward "^\\* Menu:" t end nodename beg 1 search-backward "\n" search-forward "Node: " Info-following-node-name move 0 ("top") "" case-fold-search menu-items "^\\* " regexp-quote "::" "* " "\n" "\n.*\n.*Node: " "[,\n ]" "\nFile: dir Node: " "\n\n* Menu:\n\n" apply insert-buffer-substring kill-buffer "Composing main Info directory...done" buffer-string] 8]) (defalias 'Info-read-subfile #[(nodepos) "À !qˆebˆÂÃ!ˆÄ‰ÇyˆÈɈÊË!qˆ\f š„;Ä Ä~ˆÏ ˆÐ !ˆÑÄ!ˆ \f)ebˆÂÃ!ˆZ`\\*‡" [marker-buffer Info-tag-table-marker search-forward "\n" nil lastfilename lastfilepos 2 foo (byte-code "ÀÁ!„=l„7`‰ÆÇ!ˆ `ÈZ{Ép!Êyˆ\f Vƒ-ÌÍÎ\"ˆ \f+‚Êyˆ‚‡" [looking-at "" nil thisfilename thisfilepos beg search-forward ": " 2 read 1 nodepos throw foo t lastfilename lastfilepos] 3) get-buffer "*info*" Info-current-subfile buffer-read-only buffer-file-name erase-buffer info-insert-file-contents set-buffer-modified-p nodepos] 2]) (defalias 'Info-select-node #[nil "ŠÀÁ!ˆÂyˆÃÄ!ˆÅ`ÆÇwˆ`\"É ˆÊyˆÇ `ÃÌÇÍ#ƒ<`SÎÏ!ƒ=Ê•bˆÐp! ‚=d}ˆƒIÒ !ˆƒQÔ ˆÕÖ!*‡" [search-backward "\n" 2 re-search-forward "Node:[ ]*" buffer-substring-no-properties "^, \n" nil Info-current-node Info-set-mode-line 0 active-expression "\n[\f]" t looking-at "[\n\f]*execute: " read Info-enable-active-nodes eval Info-fontify Info-fontify-node run-hooks Info-selection-hook] 5]) (defalias 'Info-set-mode-line #[nil "À ƒ  !‚\fÃÄ †ÃR‰‡" ["Info: (" Info-current-file file-name-nondirectory "" ")" Info-current-node mode-line-buffer-identification] 4]) #@72 Go to info node named NAME. Give just NODENAME or (FILENAME)NODENAME. (defalias 'Info-goto-node #[(nodename) "ÀÂÃ\f\"ˆÅ”Å•UƒÆ‚\fǔǕO\fȔȕOÂÉ \"‰\nƒ1 Ë\nO)ÂÉ\f\"‰\nƒB\fË\nO)\fƒT\fƒTÀ ÎÏ!ˆÐ Æš?…] \fÆšƒgÑ‚h\f\")‡" [nil filename string-match "\\s *\\((\\s *\\([^ )]*\\)\\s *)\\s *\\|\\)\\(.*\\)" nodename 1 "" 2 3 "\\s *\\'" trim 0 transient-mark-mode mark-active run-hooks deactivate-mark-hook Info-find-node "Top"] 5 (#$ . 11187) (list (Info-read-node-name "Goto node: "))]) (defalias 'Info-read-node-name-1 #[(string predicate code) "GÁV…\fÁHÂ=\fÅ=ƒ% ƒ‚MÆ#‚M\fÉ=ƒ: ?…MÊ#‚M\fË=…M ƒHÉ‚MÌ\")‡" [string 0 40 no-completion code nil try-completion completion-table predicate t all-completions lambda assoc] 4]) (defalias 'Info-read-node-name #[(prompt &optional default) "À Ä Æ\"‰Èšƒ †Ê !‚+‡" [t completion-ignore-case Info-build-node-completions completion-table completing-read prompt Info-read-node-name-1 nodename "" default Info-read-node-name] 4]) (defalias 'Info-build-node-completions #[nil "†]ÁŠŒÃ\f!ƒ,Ã\f!qˆ~ˆ\fbˆÅÆÁÇ#ƒXȔȕ{C\nB‚~ˆebˆÉÊÁÇ#ƒXÈyˆ` ÈyˆÌÍ Ç#ƒTȔȕ{C\nB)‚1*\n‰)‡" [Info-current-file-completions nil compl marker-buffer Info-tag-table-marker re-search-forward "\nNode: \\(.*\\)" t 1 search-forward "\n" beg re-search-backward "Node: *\\([^,\n]*\\) *[,\n ]"] 4]) #@70 If this node has been visited, restore the point value when we left. (defalias 'Info-restore-point #[(hl) "…)@@ šƒ!@A@\n˜ƒ!Ã@8bˆÄ‰‚A‰„ć" [hl Info-current-file Info-current-node 2 nil] 3 (#$ . 12556)]) #@74 Default regexp for \\[Info-search] command to search for. (defvar Info-last-search nil (#$ . 12778)) #@72 Search for REGEXP, starting from point, and select node it's found in. (defalias 'Info-search #[(regexp) "ƒƒÁÃÄ!ˆ Æšƒ‚ Á‰ `\n \f ŠŒ~ˆ\n„EÑ !ˆ`‚JÒÓÔˆ*„ìÕŽÁ×!qˆebˆÙÚ!ˆŒ`ÙÛ!ˆ`S}ˆebˆÙÜ ÝQ!ˆÞyˆm„žÑß!ˆà•á\\bˆâp!à”à•{BBÞ•Tbˆ‚zŸ‰@@A)ƒÙãä@A\"ˆå@@!ˆAÑ Áæ#ƒ®`Á‰„³ƒåãÆ!ˆ‚ëçè C\"ˆ*~ˆbˆé ˆ˜ƒ  š† \fE*B‰*.‡" [transient-mark-mode nil mark-active run-hooks deactivate-mark-hook regexp "" Info-last-search Info-current-node Info-current-file Info-current-subfile osubfile opoint ofile onode current found re-search-forward err (byte-code "À !ˆ`À‡" [re-search-forward regexp found] 2) ((search-failed)) ((byte-code "„Á\n!ˆ\nbˆÃ ˆÁ‡" [found Info-read-subfile opoint Info-select-node] 2)) list marker-buffer Info-tag-table-marker search-forward "\n\nIndirect:" "\n" "\n" ": " 0 "\\(^.*\\): [0-9]+$" 1 2 read message "Searching subfile %s..." Info-read-subfile t signal search-failed Info-select-node Info-history] 7 (#$ . 12900) "sSearch (regexp): "]) (defalias 'Info-extract-pointer #[(name &optional errorname) "ŠebˆÀyˆÁ\nÃPÄÅ#ƒÆ•bˆÇ ‚.Å=?….Éʈ+\n!P!)‡" [1 re-search-backward name ":" nil t 0 Info-following-node-name errorname error "Node has no " capitalize] 4]) (defalias 'Info-following-node-name #[(&optional allowedchars) "ÀÁwˆÂ`ÃÄ † ÆÇQ!ƒ* †ÆÈPÁwˆÃÈ!ƒÉÁwˆ‚ÊÁxˆ`\"‡" [" " nil buffer-substring-no-properties looking-at "[" allowedchars "^, \n" "]" "(" "^)" " "] 6]) #@35 Go to the next node of this node. (defalias 'Info-next #[nil "ÀÁÂ!!‡" [Info-goto-node Info-extract-pointer "next"] 3 (#$ . 14382) nil]) #@39 Go to the previous node of this node. (defalias 'Info-prev #[nil "ÀÁÂÃ\"!‡" [Info-goto-node Info-extract-pointer "prev[ious]*" "previous"] 4 (#$ . 14524) nil]) #@39 Go to the superior node of this node. (defalias 'Info-up #[nil "ÀÁÂ!!ˆÃ\f!‡" [Info-goto-node Info-extract-pointer "up" Info-restore-point Info-history] 3 (#$ . 14690) nil]) #@35 Go back to the last node visited. (defalias 'Info-last #[nil "„ÁÂ!ˆÃ‰‰@@@A@@AA@AÇ \"ˆA\fb+‡" [Info-history error "This is the first Info node you looked at" nil opoint nodename filename Info-find-node] 3 (#$ . 14869) nil]) #@32 Go to the Info directory node. (defalias 'Info-directory #[nil "ÀÁÂ\"‡" [Info-find-node "dir" "top"] 3 (#$ . 15118) nil]) #@112 Follow cross reference named NAME to the node it refers to. NAME may be an abbreviation of the reference name. (defalias 'Info-follow-reference #[(footnotename) "À‰‰Á !PÈÉ\f #‰ƒ+\fÊ OË\f TÀOQ Ì\\‚ŠebˆÍ\fÀÎ#„<ÏÐ \"ˆÊ”Ñ\\bˆÒÓÎ\")ÈË #‰ƒjÊ OÉÊ•ÀOQ Ô\\‚IÕ!,‡" [nil "\\*note " regexp-quote footnotename str i beg target string-match " " 0 "[ \n]+" 6 re-search-forward t error "No cross-reference named %s" 5 Info-extract-menu-node-name "Bad format cross reference" 1 Info-goto-node] 6 (#$ . 15247) (byte-code "ÀÁ‰‰`Á‰‰‰ \nŠÁˆ`Ëyˆ`ebˆÌÍÁÀ#ƒœÎ”`S{„JË”XƒJ`XƒJÀ„_ Ë”Xƒ_`\nXƒ_ÀËÏÐ \f#‰ƒ} Ë\fOÑ Ë•ÁOQ\fT‚aÀ=ƒ‡ À=ƒ‘  ÁB B ‚%)„¦ GÎ=ƒ´ @@ ƒáÒƒÇÓÔQ‚ÈÕ ÁÀ$‰ךƒÚ‚Ü)C‚äØÙ!. ‡" [t nil eol bol i str start-point alt-default default completions completion-ignore-case 0 re-search-forward "\\*note[ \n ]*\\([^:]*\\):" 1 string-match "[ \n ]+" " " completing-read "Follow reference named: (" ") " "Follow reference named: " input "" error "No cross-references in this node"] 10)]) (defalias 'Info-extract-menu-node-name #[(&optional errmessage multi-line) "ÀÁwˆ`Á‰ÅÁwˆÆuˆÇÈ!ƒÉ\f`S\"‚/ÀÁwˆÊ ƒ-Ì‚.Í!ÎÏ \n#‰ƒB \nÐIˆ‚0ÎÑ \"ƒSÒÓÔ‰ $‚B +‡" [" \n" nil i str beg "^:" 1 looking-at ":" buffer-substring-no-properties Info-following-node-name multi-line "^., " "^., \n" string-match "\n" 32 " +" replace-match " " t] 5]) (defalias 'Info-complete-menu-item #[(string predicate action) "À\nÃ=ƒIÃÄÅ!ÇQ Š\nqˆebˆËÌ!ˆÍÃÀ#ƒ<ÎÏДЕ{\"ДB B ‚ )Ñ #*‚¨\nÀ=ƒÃÄÅ!ÇQ Š\nqˆebˆËÌ!ˆÍÃÀ#ƒƒÎÏДЕ{\"ДB B ‚g)Ó #*‚¨Š\nqˆebˆËÌ!ˆÍÔÅ!ÕQÃÀ#))‡" [t case-fold-search action nil "\n\\* \\(" regexp-quote string "[^: \n]*\\):" pattern completions Info-complete-menu-buffer search-forward "\n* Menu:" re-search-forward format "%s" 1 try-completion predicate all-completions "\n\\* " ":"] 4]) #@124 Go to node for menu item named (or abbreviated) NAME. Completion is allowed, and the menu item point is on is the default. (defalias 'Info-menu #[(menu-item) "ÀÁ\n!!‡" [Info-goto-node Info-extract-menu-item menu-item] 3 (#$ . 17159) (let ((completions (quote nil)) (default nil) (p (point)) beg (last nil)) (save-excursion (goto-char (point-min)) (if (not (search-forward "\n* menu:" nil t)) (error "No menu in this node")) (setq beg (point)) (and (< (point) p) (save-excursion (goto-char p) (end-of-line) (re-search-backward "\n\\* \\([^: \n]*\\):" beg t) (setq default (format "%s" (buffer-substring (match-beginning 1) (match-end 1))))))) (let ((item nil)) (while (null item) (setq item (let ((completion-ignore-case t) (Info-complete-menu-buffer (current-buffer))) (completing-read (if default (format "Menu item (default %s): " default) "Menu item: ") (quote Info-complete-menu-item) nil t))) (if (string= item "") (if default (setq item default) (setq item nil)))) (list item)))]) (defalias 'Info-extract-menu-item #[(menu-item) "À !ŠebˆÂÃÄÅ#„ÆÇ!ˆÈÉ ÊQÄÅ#„-ÈÉ PÄÅ#„-ÆË!ˆÌyˆÍuˆÎ )‡" [regexp-quote menu-item search-forward "\n* menu:" nil t error "No menu in this node" re-search-forward "\n\\* " ":" "No such item in menu" 0 2 Info-extract-menu-node-name] 4]) (defalias 'Info-extract-menu-counting #[(count) "ŠebˆÀÁÂÃ#„ÄÅ!ˆƒ&ÀÇÂÃ$„.ÄÈ!ˆ‚.ÀÇÂÃ#„&É )‡" [search-forward "\n* menu:" nil t error "No menu in this node" count "\n* " "Too few items in menu" Info-extract-menu-node-name] 5]) #@91 Go to the node of the Nth menu item. N is the digit argument used to invoke this command. (defalias 'Info-nth-menu-item #[nil "ÀÁ  GSHÃZ!!‡" [Info-goto-node Info-extract-menu-counting this-command-keys 48] 4 (#$ . 18669) nil]) #@34 Go to the Top node of this file. (defalias 'Info-top-node #[nil "ÀÁ!‡" [Info-goto-node "Top"] 2 (#$ . 18904) nil]) #@36 Go to the final node in this file. (defalias 'Info-final-node #[nil "ÀÁ!ˆÂÀÄÂ!!ˆÅƉ\"„\fÇÈ \"?…/ŠÊËÂÆ#)…/ÀÄÂ!!ˆ‚)‡" [Info-goto-node "Top" nil Info-history Info-extract-menu-counting Info-forward-node t string-match "\\" Info-current-node search-forward "\n* Menu:"] 4 (#$ . 19025) nil]) #@69 Go forward one node, considering all nodes as forming one sequence. (defalias 'Info-forward-node #[(&optional not-down no-error) "ebˆÀyˆ „$ŠÂÃÄÅ#)ƒ$ÆÇ\"„$ÉÊÀ!!ˆÅ‡ŠËÌÄÅ#)ƒ3Í ˆÅ‡ŠËÎÄÅ#)ƒ_ÏÐ!—ј„_Ó ˆÄ‰ÖŽ×Å\"‰,‡ƒfćÙÚ!‡" [1 not-down search-forward "\n* menu:" nil t string-match "\\" Info-current-node Info-goto-node Info-extract-menu-counting search-backward "next:" Info-next "up:" Info-extract-pointer "up" "top" old-node Info-up success Info-history ((byte-code "„Á\n!ˆÁ‡" [success Info-goto-node old-node] 2)) Info-forward-node no-error error "No pointer forward from this node"] 4 (#$ . 19334) nil]) #@70 Go backward one node, considering all nodes as forming one sequence. (defalias 'Info-backward-node #[nil "ÀÁÂ\"ÀÃÂ\"\fƒÆÇ\f\"ƒÈÉ!‚]\fƒ0 ƒ+ —\f—˜ƒ0Ê ‚] ƒZË ˆÌ ÆÎ\"?…VŠÐÑÌÂ#)…VÒÓÌ!!ˆ‚:)‚]ÈÔ!*‡" [Info-extract-pointer "prev[ious]*" t "up" upnode prevnode string-match "(" error "First node in file" Info-up Info-prev nil Info-history "\\" Info-current-node search-forward "\n* Menu:" Info-goto-node Info-extract-menu-counting "No pointer backward from this node"] 4 (#$ . 19977) nil]) #@43 Exit Info by selecting some other buffer. (defalias 'Info-exit #[nil "ƒÁ ‡ÂÃp!Äp!ˆ!‡" [Info-standalone save-buffers-kill-emacs switch-to-buffer other-buffer bury-buffer] 4 (#$ . 20492) nil]) (defalias 'Info-next-menu-item #[nil "ŠÀyˆÁÂÃÄ#ˆÁÅÃÄ#„ÆÇ!ˆÈÉ !)‡" [-1 search-forward "\n* menu:" nil t "\n* " error "No more items in menu" Info-goto-node Info-extract-menu-node-name] 4 nil nil]) (defalias 'Info-last-menu-item #[nil "ŠÀyˆŠÁÂÃÄ#…`)‰ƒÁÆ Ä#„ ÇÈ!ˆ)ÉŠÊ•bˆË )!)‡" [1 search-backward "\n* menu:" nil t beg "\n* " error "No previous items in menu" Info-goto-node 0 Info-extract-menu-node-name] 5 nil nil]) (defalias 'Info-no-error '(macro . #[(&rest body) "ÀÁÂÃ\fÅ\"BÆF‡" [condition-case nil progn append body (t) (error nil)] 6])) #@60 Go to the next subnode or the next node, or go up a level. (defalias 'Info-next-preorder #[nil "ÀÁ†ÀÃĆÀÅƃdb‡ÇÈ!‡" [nil (byte-code "À ˆÁ‡" [Info-next-menu-item t] 1) ((error)) (byte-code "À ˆÁ‡" [Info-next t] 1) ((error)) (byte-code "À ˆÁ‡" [Info-up t] 1) ((error)) error "No more nodes"] 3 (#$ . 21241) nil]) #@59 Go to the last node, popping up a level if there is none. (defalias 'Info-last-preorder #[nil "ÀÁƒ ÃÄ!‡ÀÅƃdbˆÃÄ!‡ÀÇȃ.ebˆÉÊÀË#†1db‡ÌÍ!‡" [nil (byte-code "À ˆdbˆÁ‡" [Info-last-menu-item t] 1) ((error)) recenter -1 (byte-code "À ˆÁ‡" [Info-prev t] 1) ((error)) (byte-code "À ˆÁ‡" [Info-up t] 1) ((error)) search-forward "\n* Menu:" t error "No previous nodes"] 4 (#$ . 21568) nil]) #@297 Scroll one screenful forward in Info, considering all nodes as one sequence. Once you scroll far enough in a node that its menu appears on the screen, the next scroll moves into its first subnode. When you scroll past the end of a node, that goes to the next node or back up to the parent node. (defalias 'Info-scroll-up #[nil "À eW„À dVƒÁ `\"ˆŠebˆÃÄÅÆ#ƒ$`‚%d)‰À W„6È!ƒ;É ‚=Ê )‡" [window-start set-window-start selected-window search-forward "\n* Menu:" nil t virtual-end pos-visible-in-window-p Info-next-preorder scroll-up] 5 (#$ . 21965) nil]) #@241 Scroll one screenful back in Info, considering all nodes as one sequence. Within the menu of a node, this goes to its last subnode. When you scroll past the beginning of a node, that goes to the previous node or back up to the parent node. (defalias 'Info-scroll-down #[nil "À eW„À dVƒÁ `\"ˆŠebˆÃÄÅÆ#)‰„*Èe!ƒ/É ‚1Ê )‡" [window-start set-window-start selected-window search-forward "\n* Menu:" nil t virtual-end pos-visible-in-window-p Info-last-preorder scroll-down] 5 (#$ . 22534) nil]) #@67 Move cursor to the next cross-reference or menu item in the node. (defalias 'Info-next-reference #[nil "À`m„ ÃuˆÄ\nÅÆ#„%ebˆÄ\nÅÆ#„% bˆÇÈ!ˆÉ”bˆÊË!…1Ì *‡" ["\\*note[ \n ]*\\([^:]*\\):\\|^\\* .*:" old-pt pat 1 re-search-forward nil t error "No cross references in this node" 0 looking-at "\\* Menu:" Info-next-reference] 4 (#$ . 23038) nil]) #@71 Move cursor to the previous cross-reference or menu item in the node. (defalias 'Info-prev-reference #[nil "À`Ã\nÄÅ#„dbˆÃ\nÄÅ#„ bˆÆÇ!ˆÈ”bˆÉÊ!…*Ë *‡" ["\\*note[ \n ]*\\([^:]*\\):\\|^\\* .*:" old-pt pat re-search-backward nil t error "No cross references in this node" 0 looking-at "\\* Menu:" Info-prev-reference] 4 (#$ . 23389) nil]) #@460 Look up a string in the index for this file. The index is defined as the first node in the top-level menu whose name contains the word "Index", plus any immediately following nodes whose names also contain the word "Index". If there are no exact matches to the specified topic, this chooses the first match which is a case-insensitive substring of a topic. Use the `,' command to see the other matches. Give a blank topic name to go to the Index node itself. (defalias 'Info-index #[(topic) "ÁÂÃÄ !\"Á ÊË!ˆÌÍÁÎ#„!ÏÐ!ˆÑÒÁÎ#„-ÏÐ!ˆÓ”bˆÁÊÕ !ˆ) Öš†ÅÁ‰‰‰ebˆÑÁÎ#ƒuÓ”Ó•{Ú”Ú•{ÛÜݔݕ{P!FB‚OÞßÎ\"‰ƒàá\"ƒÊ!ˆ‚L„œâ ˆÏã \"ˆä \"‰ƒ¹Bå\"‚œŸ¤&çè!,,‡" [Info-current-node nil format "\n\\* \\([^\n:]*%s[^\n:]*\\):[ ]*\\([^.\n]*\\)\\.[ ]*\\([0-9]*\\)" regexp-quote topic node pattern rnode orignode Info-goto-node "Top" search-forward "\n* menu:" t error "No index" re-search-forward "\n\\* \\(.*\\\\)" 1 Info-history Info-extract-menu-node-name "" found exact matches 2 string-to-int "0" 3 Info-extract-pointer "next" string-match "\\" Info-last "No \"%s\" in index" assoc delq Info-index-alternatives Info-index-next 0] 7 (#$ . 23737) "sIndex topic: "]) #@63 Go to the next matching index item from the last `i' command. (defalias 'Info-index-next #[(num) "„ÁÂ!ˆ ÄWƒ G\\‰‚ ÄVƒ+A@C¤ S‰‚Å@A@!ˆÆ@8ÄVƒDÆ@8yˆ‚‘Æyˆ@@ÈÉÊË!\"ÌÍ#„‡ÎÉÏ\"ÌÍ#„‡ÐÑ\"ƒ~ÎÉÏÄÒ”O\"ÌÍ#„‡ÎÌÍ#ƒÄyˆ‚ebˆ)ÓÔ@@Õ@8Aƒ£Ö‚¤×$‡" [Info-index-alternatives error "No previous `i' command in this file" num 0 Info-goto-node 3 name re-search-forward format "\\(Function\\|Command\\): %s\\( \\|$\\)" regexp-quote nil t search-forward "`%s'" string-match "\\`.*\\( (.*)\\)\\'" 1 message "Found \"%s\" in %s. %s" 2 "(Press `,' for more)" "(Only match)"] 7 (#$ . 24964) "p"]) #@36 Make command be undefined in Info. (defalias 'Info-undefined #[nil "À ‡" [ding] 1 (#$ . 25580) nil]) #@26 Enter the Info tutorial. (defalias 'Info-help #[nil "À ˆÁÂà ÄWƒÅ‚Æ\"‡" [delete-other-windows Info-find-node "info" window-height 23 "Help-Small-Screen" "Help"] 4 (#$ . 25687) nil]) #@47 Display a brief summary of all Info commands. (defalias 'Info-summary #[nil "À‹‡" [((byte-code "ÀÁ!ˆÂ ˆÃÄ!cˆÅ ˆebˆÆ‰Éd!?ʃ(Ë‚)Ì!ˆÍ ‰Î=„=C‚HƒHÐ ˆ‚*ÑÁ!‡" [switch-to-buffer "*Help*" erase-buffer documentation Info-mode help-mode nil flag ch pos-visible-in-window-p message "Type Space to see more" "Type Space to return to Info" read-event 32 unread-command-events scroll-up bury-buffer] 2))] 1 (#$ . 25878) nil]) #@486 Return the token around POS, POS must be somewhere inside the token START is a regular expression which will match the beginning of the tokens delimited string ALL is a regular expression with a single parenthized subpattern which is the token to be returned. E.g. '{(.*)}' would return any string enclosed in braces around POS. SIG optional fourth argument, controls action on no match nil: return nil t: beep a string: signal an error, using that string. (defalias 'Info-get-token #[(pos start all &optional errorstring) "ŠbˆÁ\neÃZ]Ä#ˆÅÇdÃ\\^Ä#ƒ/É”X…)É•V‰ƒƒJÉ”XƒJÉ•VƒJʔʕ{‚g „SÅ‚g Ì=ƒaÍ ˆÅ‚gÎÏ #*‡" [pos re-search-backward start 200 yes nil found re-search-forward all 0 1 errorstring t beep error "No %s around position %d"] 5 (#$ . 26319)]) #@244 \Follow a node reference near point. Like \[Info-menu], \[Info-follow-reference], \[Info-next], \[Info-prev] or \[Info-up] command, depending on where you click. At end of the node's text, moves to the next node, or up if none. (defalias 'Info-mouse-follow-nearest-node #[(click) "‰A@)‰@\nA@Å !ˆ\fbˆ+Æ ?…'ŠÇyˆm)…'È ‡" [click event start window pos select-window Info-try-follow-nearest-node 1 Info-next-preorder] 3 (#$ . 27131) "e"]) #@243 \Follow a node reference near point. Like \[Info-menu], \[Info-follow-reference], \[Info-next], \[Info-prev] or \[Info-up] command, depending on where point is. If no reference to follow, moves to the next node, or up if none. (defalias 'Info-follow-nearest-node #[nil "À †Á ‡" [Info-try-follow-nearest-node Info-next-preorder] 1 (#$ . 27594) nil]) #@68 Follow a node reference near point. Return non-nil if successful. (defalias 'Info-try-follow-nearest-node #[nil "ÀÂ`ÃÄ#‰ƒÅ !ˆ‚vÂ`ÆÇ#‰ƒ$È !ˆ‚vÂ`ÆÉ#‰ƒ5Ê !ˆ‚vÂ`ËÌ#‰ƒFÈ !ˆ‚vÂ`ÍÎ#‰ƒWÈ !ˆ‚vÂ`ÏÐ#‰ƒhÈÑ!ˆ‚vÂ`ÒÓ#‰ƒvÈ !ˆ )‡" [nil node Info-get-token "\\*note[ \n]" "\\*note[ \n]\\([^:]*\\):" Info-follow-reference "\\* " "\\* \\([^:]*\\)::" Info-goto-node "\\* \\([^:]*\\):" Info-menu "Up: " "Up: \\([^,\n ]*\\)" "Next: " "Next: \\([^,\n ]*\\)" "File: " "File: \\([^,\n ]*\\)" "Top" "Prev: " "Prev: \\([^,\n ]*\\)"] 4 (#$ . 27966)]) #@34 Keymap containing Info commands. (defvar Info-mode-map nil (#$ . 28517)) (byte-code "„Á Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÃÐÏ#ˆÃÑÏ#ˆÃÒÏ#ˆÃÓÏ#ˆÃÔÏ#ˆÃÕÏ#ˆÃÖÏ#ˆÃ×Ï#ˆÃØÙ#ˆÃÚÛ#ˆÃÜÝ#ˆÃÞß#ˆÃàá#ˆÃâã#ˆÃäÅ#ˆÃåæ#ˆÃçè#ˆÃéê#ˆÃëì#ˆÃíî#ˆÃïð#ˆÃñò#ˆÃóô#ˆÃõö#ˆÃ÷ø#ˆÃùú#ˆÃûü#ˆÃýü#ˆÃþá#ˆÃÿ@#ˆÃAB#ˆÃCD#ˆÃEF#ˆGHIJ#‡" [Info-mode-map make-keymap suppress-keymap define-key "." beginning-of-buffer " " Info-scroll-up " " Info-follow-nearest-node " " Info-next-reference " " Info-prev-reference "1" Info-nth-menu-item "2" "3" "4" "5" "6" "7" "8" "9" "0" undefined "?" Info-summary "]" Info-forward-node "[" Info-backward-node "<" Info-top-node ">" Info-final-node "b" "d" Info-directory "e" Info-edit "f" Info-follow-reference "g" Info-goto-node "h" Info-help "i" Info-index "l" Info-last "m" Info-menu "n" Info-next "p" Info-prev "q" Info-exit "s" Info-search "ó" "t" "u" Info-up "," Info-index-next "" Info-scroll-down [mouse-2] Info-mouse-follow-nearest-node put info-mode mode-class special] 4) #@2233 \ Info mode provides commands for browsing through the Info documentation tree. Documentation in Info is divided into "nodes", each of which discusses one topic and contains references to other nodes which discuss related topics. Info has commands to follow the references and show you other nodes. \[Info-help] Invoke the Info tutorial. Selecting other nodes: \[Info-mouse-follow-nearest-node] Follow a node reference you click on. This works with menu items, cross references, and the "next", "previous" and "up", depending on where you click. \[Info-next] Move to the "next" node of this node. \[Info-prev] Move to the "previous" node of this node. \[Info-up] Move "up" from this node. \[Info-menu] Pick menu item specified by name (or abbreviation). Picking a menu item causes another node to be selected. \[Info-directory] Go to the Info directory node. \[Info-follow-reference] Follow a cross reference. Reads name of reference. \[Info-last] Move to the last node you were at. \[Info-index] Look up a topic in this file's Index and move to that node. \[Info-index-next] (comma) Move to the next match from a previous `i' command. Moving within a node: \[Info-scroll-up] Normally, scroll forward a full screen. If the end of the buffer is already visible, try to go to the next menu entry, or up if there is none. \[Info-scroll-down] Normally, scroll backward. If the beginning of the buffer is already visible, try to go to the previous menu entry, or up if there is none. \[beginning-of-buffer] Go to beginning of node. Advanced commands: \[Info-exit] Quit Info: reselect previously selected buffer. \[Info-edit] Edit contents of selected node. 1 Pick first item in node's menu. 2, 3, 4, 5 Pick second ... fifth item in node's menu. \[Info-goto-node] Move to node specified by name. You may include a filename as well, as (FILENAME)NODENAME. \[universal-argument] \[info] Move to new Info file with completion. \[Info-search] Search through this Info file for specified regexp, and select the node in which the next occurrence is found. \[Info-next-reference] Move cursor to next cross-reference or menu item. \[Info-prev-reference] Move cursor to previous cross-reference or menu item. (defalias 'Info-mode #[nil "À ˆÁÃÅ!ˆÇ!ˆ \nË\fË ÎÏ!ˆÎÐ!ˆÎÑ!ˆÎÒ!ˆÎÓ!ˆÎÔ!ˆÕÖ !×>ƒzØÙ!ˆØÚ!ˆØÛ!ˆÜÙ!„aÜÝ!ƒ\\ÞÝÙ\"ˆ‚aÞßÙ\"ˆÜÚ!„làÚË\"ˆÜÛ!„}ÞßÛ\"ˆ‚}á\"ã ˆäå!‡" [kill-all-local-variables Info-mode major-mode "Info" mode-name use-local-map Info-mode-map set-syntax-table text-mode-syntax-table text-mode-abbrev-table local-abbrev-table t case-fold-search buffer-read-only make-local-variable Info-current-file Info-current-subfile Info-current-node Info-tag-table-marker Info-history Info-index-alternatives framep selected-frame (x pc) make-face info-node info-menu-5 info-xref face-differs-from-default-p bold-italic copy-face bold set-face-underline-p nil Info-fontify Info-set-mode-line run-hooks Info-mode-hook] 3 (#$ . 29565)]) #@47 Local keymap used within `e' command of Info. (defvar Info-edit-map nil (#$ . 32545)) (byte-code "„Á \n¤ÃÄÅ#ˆÆÇÈÉ#‡" [Info-edit-map make-sparse-keymap text-mode-map define-key "" Info-cease-edit put info-edit-mode mode-class special] 4) #@166 Major mode for editing the contents of an Info node. Like text mode with the addition of `Info-cease-edit' which returns to Info mode for browsing. \{Info-edit-map} (defalias 'Info-edit-mode #[nil "À !ˆÂÄÆÇ!ˆÈ Ê ˆËp!ˆÌÍ!‡" [use-local-map Info-edit-map Info-edit-mode major-mode "Info Edit" mode-name kill-local-variable mode-line-buffer-identification nil buffer-read-only force-mode-line-update buffer-enable-undo run-hooks Info-edit-mode-hook] 2 (#$ . 32796)]) #@94 Edit the contents of this Info node. Allowed only if variable `Info-enable-edit' is non-nil. (defalias 'Info-edit #[nil "„ÁÂ!ˆÃ ˆÄÅÆ!!‡" [Info-enable-edit error "Editing info nodes is not enabled" Info-edit-mode message substitute-command-keys "Editing: Type \\\\[Info-cease-edit] to return to info"] 3 (#$ . 33268) nil]) #@55 Finish editing Info node; switch back to Info proper. (defalias 'Info-cease-edit #[nil "À ƒÁÂ!ƒà ˆÄ !ˆÆÈ Ê ˆË\fÍ ˆÎ!…0À …0ÐÑ!‡" [buffer-modified-p y-or-n-p "Save the file? " save-buffer use-local-map Info-mode-map Info-mode major-mode "Info" mode-name Info-set-mode-line t buffer-read-only force-mode-line-update marker-position Info-tag-table-marker message "Tags may have changed. Use Info-tagify if necessary"] 2 (#$ . 33614) nil]) #@259 List of Info files that describe Emacs commands. An element can be a file name, or a list of the form (PREFIX . FILE) where PREFIX is a name prefix and FILE is the file to look in. If the element is just a file name, the file name also serves as the prefix. (defvar Info-file-list-for-emacs (quote ("ediff" "forms" "gnus" "info" ("mh" . "mh-e") "sc")) (#$ . 34069)) #@326 Return a list of locations documenting COMMAND. The `info-file' property of COMMAND says which Info manual to search. If COMMAND has no property, the variable `Info-file-list-for-emacs' defines heuristics for which Info manual to try. The locations are of the format used in Info-history, i.e. (FILENAME NODENAME BUFFERPOS). (defalias 'Info-find-emacs-command-nodes #[(command) "ÀÁÂÃ\f!!ÅQÆ \fÇNƒ\fÇN‚o\n  ƒn @‰\f:ƒ7\f@‚9\f \f:ƒG\fA‚I\fÏ !ÐQÒÃ\f!\"ƒeÀ  A ,‚\")ŠÀÓÔˆAdbˆÖÀ×#ƒ—Ù”Ù•{ÚE B ‚} ,‡" [nil "^\\* " regexp-quote symbol-name command ":\\s *\\(.*\\)\\.$" "emacs" info-file cmd-desc where Info-file-list-for-emacs file-list elt name file "\\`" "\\(\\'\\|-\\)" regexp string-match (Info-find-node info-file "Command Index") ((error (Info-find-node info-file "Index"))) Info-history re-search-backward t Info-current-file 1 0] 6 (#$ . 34442)]) #@235 Go to the Info node in the Emacs manual for command COMMAND. The command is found by looking up in Emacs manual's Command Index or in another manual found via COMMAND's `info-file' property or the variable `Info-file-list-for-emacs'. (defalias 'Info-goto-emacs-command-node #[(command) "À !„ ÂÃÀ D\"ˆÄ !‰ƒ\\ GÇ‹ˆÈÉ!ˆÊ @@ @A@\"ˆËV…X A\f¤\fÍÎÏ!SÐVƒJÑ‚KÒÐVƒVÓ‚WÔ$)‚`ÕÖ \")‡" [commandp command signal wrong-type-argument Info-find-emacs-command-nodes where num-matches ((info)) pop-to-buffer "*info*" Info-find-node 1 Info-history message substitute-command-keys "Found %d other entr%s. Use \\[Info-last] to see %s." 2 "ies" "y" "them" "it" error "Couldn't find documentation for %s."] 7 (#$ . 35351) "CFind documentation for command: "]) #@328 Go to the Info node in the Emacs manual the command bound to KEY, a string. Interactively, if the binding is execute-extended-command, a command is read. The command is found by looking up in Emacs manual's Command Index or in another manual found via COMMAND's `info-file' property or the variable `Info-file-list-for-emacs'. (defalias 'Info-goto-emacs-key-command-node #[(key) "À !‰„ÃÄÅ !\"‚&tƒ#\nÆ=ƒ#ÇÈÉ!!‚&Ç\n!)‡" [key-binding key command message "%s is undefined" key-description execute-extended-command Info-goto-emacs-command-node read-command "Find documentation for command: "] 5 (#$ . 36115) "kFind documentation for key:"]) #@146 *Alist of face or list of faces to use for pseudo-underlined titles. The alist key is the character the title is underlined with (?*, ?= or ?-). (defvar Info-title-face-alist (quote ((42 bold underline) (61 bold-italic underline) (45 italic underline))) (#$ . -36765)) (defalias 'Info-fontify-node #[nil "ŠÀebˆÂÃ!ƒ/Ä•bˆÂÅ!ƒ/Ä•bˆÆǔǕÈÉ$ˆÆǔǕÊË$ˆ‚ebˆÌÍÀÎ#ƒSÆǔǕÈhžA$ˆÆǕЕÑÎ$ˆ‚2ebˆÌÒÀÎ#ƒ|Ä”SfÓU„VÆǔǕÈÉ$ˆÆǔǕÊË$ˆ‚VebˆÔÕÀÎ#ƒÎÖ×\"„Îd`ZWƒÎÄÌÛÀÎ#ƒÍT‰Ü>ƒ¸ÆĔĔTÈÝ$ˆÆǔǕÈÞ$ˆÆǔǕÊË$ˆ‚›)ßÀ!*‡" [nil buffer-read-only looking-at "^File: [^,: ]+,?[ ]+" 0 "[ ]*[^:, \n]+:[ ]+\\([^:, \n]+\\),?" put-text-property 1 face info-xref mouse-face highlight re-search-forward "\n\\([^ \n].+\\)\n\\(\\*+\\|=+\\|-+\\)$" t Info-title-face-alist 2 invisible "\\*Note[ \n ]+\\([^:]*\\):" 34 search-forward "\n* Menu:" string-match "\\" Info-current-node Info-fontify-maximum-menu-size n "^\\* \\([^: \n]*\\):" (5 9) info-menu-5 info-node set-buffer-modified-p] 7]) (provide (quote info)) emacs-19.30/lisp/informat.elc100666 13437 1 15267 6043465675 14567 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:54:02 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/informat.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`informat.el' was compiled for Emacs 19.29 or later")) (require (quote info)) #@57 Create or update Info-file tag table in current buffer. (defalias 'Info-tagify #[nil "ÀÁÂà !\"ˆeddÄ TU`ÉŽ~ˆebˆÊËÌÍ#ƒ-ÀÎ!ˆ‚¹ÏÍÌÊÓÌÍ#ƒaÔ”Öyˆ×Í#ƒ]ØÙ”Ù•\"DB)‚6dbˆÚyˆÌÊÜÌÍ#ƒ‚`Þß!ˆÔyˆ`|ˆ)dbˆàcˆ!`Ì“ˆŸ‰ƒµâ@@㱈ä@A@p\"ˆåcˆA‰„—Ücˆ,-ÀæÂà !\"‡" [message "Tagifying %s ..." file-name-nondirectory buffer-file-name buffer-size opoint nomax omax omin ((byte-code "bˆ \nƒà T‚\fd^}‡" [opoint omin nomax buffer-size omax] 3)) search-forward "\nIndirect:\n" nil t "Cannot tagify split info file" "Node:[ ]*\\([^,\n ]*\\)[, \n]" list case-fold-search regexp "\n" 0 beg 2 re-search-backward buffer-substring-no-properties 1 -8 buffer-read-only "\nEnd tag table\n" end search-backward "\nTag table:\n" "\f\nTag table:\n" Info-tag-table-marker "Node: " 127 princ 10 "Tagifying %s ... done"] 5 (#$ . 506) nil]) #@590 Split an info file into an indirect file plus bounded-size subfiles. Each subfile will be up to 50,000 characters plus one node. To use this command, first visit a large Info file that has a tag table. The buffer is modified into a (small) indirect info file which should be saved in place of the original visited file. The subfiles are written in the same directory the original file is in, with names generated by appending `-' and a number to the original file name. The indirect file still functions as an Info file, but it contains just the tag table and a directory of subfiles. (defalias 'Info-split #[nil "À ÁWƒ ÂÃ!ˆebˆÄÅ!ˆÆuˆ`ÇÈÉÊË\f! dbˆÓyˆÈÄÕÈÊ#„?ÂÖ!ˆ×Ø!ˆÙÚ!ƒMÂÛ!ˆÇyˆÉuˆŒe`}ˆebˆ`TdWƒ²`Ü\\d^bˆÄÅÈÝ#ˆ\\Þ !ßà\"PDBácˆâe` ßà\"P#ˆ`S`|ˆÆuˆ`Z\\`|ˆT‚[)ƒÖbˆ@A@ßã@@S\"᱈A‰„¸bˆäcˆÄå!ˆæc.‡" [buffer-size 70000 error "This is too small to be worth splitting" search-forward "" -1 0 nil 1 t file-name-sans-versions buffer-file-name filename case-fold-search subfile-number subfiles chars-deleted start -8 buffer-read-only "\nEnd tag table\n" "Tag table required; use M-x Info-tagify" search-backward "\nTag table:\n" looking-at "\nTag table:\n" "Tag table is just a skeleton; use M-x Info-tagify" 50000 move file-name-nondirectory format "-%d" "\n" write-region ": %d" "\nIndirect:\n" "\nTag Table:\n" "(Indirect)\n"] 8 (#$ . 1363) nil]) #@110 Check current buffer for validity as an Info file. Check that every node pointer points to an existing node. (defalias 'Info-validate #[nil "ŠŒ~ˆebˆÀÁÂÃ#ƒÄÅÆp!\"ˆebˆÇÈÉ \n \f ÀÎÂÃ#ƒ‹Ïyˆ`ÏyˆÑ\fÃ#ƒ‡ÒϔϕbˆÓÂxˆ`\"—Õ \"ƒiÖÂE B ‚†ÂˆÑ×Ã#…~Ø•bˆÙ —E B ))‚(ebˆÀÎÂÃ#ƒ¢Ïyˆ`‰ÏyˆÑ\fÃ#ƒžŒÀÎÂÜ#ˆ`}ˆÒϔϕbˆÓÂxˆ`\"—ˆÝÞÂÃ#ƒ3ßà!‰ƒ3Õ \"ƒ3Õ \"A@šƒ( ‰!ƒ$!@A@⚃!@@šƒã!@ \" !A‰!„þ)‚3âE B ˆÑ×ÂÃ#ƒBßä!ˆÂˆÝåÂÃ#ƒQßæ!ˆçèÂÃ#ƒtçéÂÃ#ƒtßê`ŠëÂwˆ`){Pì \"ˆ‚YebˆçíÂÃ#ƒØ”î\\bˆïÂwˆßð`ŠëÂwˆ`){Pìñ!\"ˆ‚w)+‚Žò ?\n „±\nƒ5ó ƒ)ôõ!ˆô @@!ˆôö!ˆ @A@!÷ø!\"ƒæô!؉”O!ˆôù!ˆ‚ëô!!ˆ)ú @8ƒôû!ˆú @8!÷ø!\"ƒô!؉”O!ˆôù!ˆ‚ô!!ˆ)ü ˆ A‰ „¸\n…1ôý!‘‚KŠþó!ƒCóqˆÿp!ˆ)@A!.‡" [search-forward "\nTag table:\n(Indirect)\n" nil t error "Don't yet know how to validate indirect info files: \"%s\"" buffer-name (("*")) "Node:[ ]*\\([^,\n ]*\\)[, \n]" lossages tags-losing case-fold-search regexp allnodes "\n" 1 beg re-search-backward buffer-substring-no-properties " " name assoc "Duplicate node-name" "prev[ious]*:" 0 Info-following-node-name next thisnode move search-backward "next:" Info-validate-node-name "invalid Next" tem "should have Previous" delq "invalid Previous" "up:" "invalid Up" re-search-forward "\n* Menu:" "\n\\* " "invalid menu item " "^:" Info-extract-menu-node-name "\\*note[ \n]*[^: ]*:" 5 " \n" "invalid reference " "Bad format cross-reference" Info-validate-tags-table " *problems in info file*" princ "In node \"" "\", " string-match "\n" "..." 2 ": " terpri "\nTags table must be recomputed\n" get-buffer kill-buffer message "File appears valid"] 6 (#$ . 2776) nil]) (defalias 'Info-validate-node-name #[(kind &optional name) "„Á•bˆÂÃwˆgÄU„Å`ÆÃwˆÇÃxˆ`\"ƒH—‰GÁVƒ5ÁHÄU„HÈ \"„H\n E\fB\f‡" [name 0 " " nil 40 buffer-substring-no-properties "^, \n" " " assoc allnodes thisnode kind lossages] 5]) (defalias 'Info-validate-tags-table #[nil "ebˆÀÁÂÃ#„ ÇÄÅ?‡" [search-forward "\nEnd tag table\n" nil t losing (byte-code "À”ÂÃ!ˆÀ•Sʼnƒ>\fbˆ@@Èš„5ÉÊ@@ËQ Ì#„5ÍÎÏ\"ˆA‰„\fTbˆÐÑ!ƒŠÒÓ”Ó•\"—Ô\"‰ƒÕÖ”bˆAA@×p!Z‰ÀVƒx‚{[Wƒ„ÍÎØ\"ˆÓyˆ‚B+ÐÙ!ƒ”ÓyˆÐÚ!„ŸÍÎÛ\"ˆÅ‡" [0 end search-backward "\nTag table:\n" start nil tem allnodes "*" search-forward "Node: " "" t throw losing x looking-at ".*Node: \\(.*\\)\\([0-9]+\\)$" buffer-substring-no-properties 1 assoc 1000 2 read y "\n" "End tag table\n" z] 5)] 4]) #@268 Runs `Info-validate' on the files remaining on the command line. Must be used only with -batch, and kills Emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke "emacs -batch -f batch-info-validate $info/ ~/*.info" (defalias 'batch-info-validate #[nil "„ÁÂ!ˆÃĉʼn \nËĉ\f ƒhÏ@! Ð !„CÑÒ \"ˆÓA‰‚!Ô !ƒXÕ !A¤‰‚! \fB\fA‰„$\fƒƒ\f@ \fA\fÄ×ØÙˆ)‚hÚ !.‡" [noninteractive error "batch-info-validate may only be used -batch." t nil 259259 kept-new-versions kept-old-versions find-file-run-dired auto-save-default version-control 0 files file command-line-args-left expand-file-name file-exists-p message ">> %s does not exist!" 1 file-directory-p directory-files lose err (byte-code "ƒÁp!ˆÂ !ˆÄp!ˆÅÆ!ˆÇ ˆÆdbˆÉÊÆË#ƒ-ÌÍ \"ˆ‚>dÎWƒ;ÌÏ \"ˆ‚>Ð ˆ)ÑÌÓ \"ˆÔ!ƒSÁ!ˆÕ ˆÔ!ƒ}ÌÖ!ˆÌ× \"ˆŠqˆØÙed\"!ˆ)ÌÖ!ˆÚË)Ý ƒ„ÌÞ \"ˆß ˆÆ‡" [buffer-file-name kill-buffer find-file file buffer-disable-undo set-buffer-modified-p nil fundamental-mode case-fold-search search-backward "\n\f\nTag table:\n" t message "%s already tagified" 30000 "%s too small to bother tagifying" Info-tagify " *problems in info file*" loss-name "Checking validity of info file %s..." get-buffer Info-validate "----------------------------------------------------------------------" ">> PROBLEMS IN INFO FILE %s" princ buffer-substring-no-properties 1 error lose buffer-modified-p "Saving modified %s" save-buffer] 4) ((error (byte-code "ÀÁ !\"‡" [message ">> Error: %s" prin1-to-string err] 4))) kill-emacs] 6 (#$ . 5239)]) emacs-19.30/lisp/isearch.elc100666 13437 13 66024 6043465763 14117 0ustar jimbuser;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:54:21 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/isearch.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`isearch.el' was compiled for Emacs 19.29 or later")) #@72 *Non-nil means random control characters terminate incremental search. (defconst search-exit-option t (#$ . -481)) #@251 *Number of lines in slow search display windows. These are the short windows used during incremental search on slow terminals. Negative means put the slow search window at the top (normally it's at bottom) and the value is minus the number of lines. (defvar search-slow-window-lines 1 (#$ . -603)) #@173 *Highest terminal speed at which to use "slow" style incremental search. This is the style where a one-line window is created to show the line that the search has reached. (defvar search-slow-speed 1200 (#$ . -908)) #@296 *If non-nil, upper case chars disable case fold searching. That is, upper and lower case chars must match exactly. This applies no matter where the chars come from, but does not apply to chars in regexps that are prefixed with `\'. If this value is `not-yanks', yanked text is always downcased. (defvar search-upper-case (quote not-yanks) (#$ . -1131)) #@212 *If non-nil, do a nonincremental search instead if exiting immediately. Actually, `isearch-edit-string' is called to let you enter the search string, and RET terminates editing and does a nonincremental search. (defvar search-nonincremental-instead t (#$ . -1491)) #@133 *If non-nil, regular expression to match a sequence of whitespace chars. You might want to use something like "[ \t\r\n]+" instead. (defconst search-whitespace-regexp "\\s-+" (#$ . -1763)) #@65 *Non-nil means incremental search highlights the current match. (defvar search-highlight nil (#$ . -1958)) #@62 Function(s) to call after starting up an incremental search. (defvar isearch-mode-hook nil (#$ . 2071)) #@62 Function(s) to call after terminating an incremental search. (defvar isearch-mode-end-hook nil (#$ . 2181)) #@34 List of search string sequences. (defvar search-ring nil (#$ . 2295)) #@53 List of regular expression search string sequences. (defvar regexp-search-ring nil (#$ . 2371)) #@72 *Maximum length of search ring before oldest elements are thrown away. (defconst search-ring-max 16 (#$ . -2473)) #@79 *Maximum length of regexp search ring before oldest elements are thrown away. (defconst regexp-search-ring-max 16 (#$ . -2593)) #@64 Index in `search-ring' of last string reused. nil if none yet. (defvar search-ring-yank-pointer nil (#$ . 2727)) #@71 Index in `regexp-search-ring' of last string reused. nil if none yet. (defvar regexp-search-ring-yank-pointer nil (#$ . 2846)) #@128 *Non-nil if advancing or retreating in the search ring should cause search. Default value, nil, means edit the string instead. (defvar search-ring-update nil (#$ . -2980)) #@26 Keymap for isearch-mode. (defvar isearch-mode-map nil (#$ . 3158)) (byte-code "„Áà ÅÆ\f8!„ÇÈ!ˆ\fAÉÊË\" ˆÌ\fÍÎ#ˆ\nÏWƒ9Ì\fÐÆ\n\"Î#ˆ\nT‰‚$ÏÏ\fA@GWƒSÌ\fÑ\n!Ò#ˆ\nT‰‚<Ó Ì\fÕ!#ˆÌ\f×#ˆ)Ì\fÑØ\"Ù#ˆÌ\fÚÛ#ˆÌ\fÜÝ#ˆÌ\fÞß#ˆÌ\fàá#ˆâU„–Çã!ˆÌ\fäå#ˆÌ\fæå#ˆÌ\fçè#ˆÌ\féê#ˆÌ\fëÒ#ˆÌ\fìÒ#ˆÌ\fíî#ˆÌ\fïð#ˆÌ\fñò#ˆÌ\fóô#ˆÌ\fõô#ˆÌ\fö÷#ˆÌ\føù#ˆÌ\fúû#ˆÌ\füý#ˆÌ\fþÿ#ˆÌ\f@Ë#ˆÌ\fAË#ˆÌ\fBË#ˆÌ\fCË#ˆ\f*ˇ" [isearch-mode-map 0 i make-keymap map vectorp 1 error "The initialization of isearch-mode-map must be updated" make-vector 256 nil define-key [t] isearch-other-control-char 32 make-string vector isearch-printing-char make-sparse-keymap meta-map char-to-string meta-prefix-char [escape] t isearch-other-meta-char "" isearch-repeat-forward "" isearch-repeat-backward "" isearch-delete-char "" isearch-abort 27 "Inconsistency in isearch.el" "" isearch-cancel [escape escape escape] "" isearch-quote-char " " isearch-exit "\n" " " " " isearch-whitespace-chars "" isearch-yank-word "" isearch-yank-line "*" isearch-*-char "?" "|" isearch-|-char "î" isearch-ring-advance "ð" isearch-ring-retreat "ù" isearch-yank-kill "‰" isearch-complete [switch-frame] [delete-frame] [iconify-frame] [make-frame-visible]] 6) #@55 Keymap for editing isearch strings in the minibuffer. (defvar minibuffer-local-isearch-map nil (#$ . 4384)) (byte-code "„/Á\n!Ä ÅÆ#ˆÄ ÇÈ#ˆÄ ÉÊ#ˆÄ ËÌ#ˆÄ ÍÎ#ˆÄ ÏÐ#ˆ )ÑÒ!„8ÓÒBÑÕ!„GÓÕBÑÖ!„VÓÖBÑ×!„eÓ×BÑØ!„tÙØBÑÚ!„ƒÙÚBÑÛ!„’ÜÛBÑÝ!„¡ÓÝBÑÞ!„°ÓÞBÑß!„¿ÓßBÑà!„ÎÓ àBÑá!„Ýâ!áBÑã!„ìÓ#ãBÑä!„ûÓ$äBÑå!„\nÓ%åBÑæ!„Ó&æBÑç!„(â'çBÑè!„7Ó(èBÑé!„FÓ)éBÑê!„UÓ*êBÑë!„dÓ+ëBÑì!„sÓ,ìBÑí!„‚Ó-íBî/ž„•/ðC¤ˆÑî!„žÓ.îBñî!ˆÄ2ÍÒ#ˆÄ3Íô#ˆÄ2Ïõ#ˆÄ3Ïö#‡" [minibuffer-local-isearch-map copy-keymap minibuffer-local-map map define-key " " isearch-nonincremental-exit-minibuffer "î" isearch-ring-advance-edit "ð" isearch-ring-retreat-edit "‰" isearch-complete-edit "" isearch-forward-exit-minibuffer "" isearch-reverse-exit-minibuffer boundp isearch-forward nil current-load-list isearch-regexp isearch-word isearch-cmds isearch-string "" isearch-message isearch-success t isearch-invalid-regexp isearch-within-brackets isearch-other-end isearch-wrapped isearch-barrier 0 isearch-case-fold-search isearch-adjusted isearch-slow-terminal-mode isearch-small-window isearch-opoint isearch-window-configuration isearch-yank-flag isearch-op-fun isearch-recursive-edit isearch-nonincremental isearch-new-forward isearch-mode minor-mode-alist (isearch-mode isearch-mode) make-variable-buffer-local global-map esc-map isearch-forward-regexp isearch-backward isearch-backward-regexp] 4) #@1731 Do incremental search forward. With a prefix argument, do an incremental regular expression search instead. \ As you type characters, they add to the search string and are found. The following non-printing keys are bound in `isearch-mode-map'. Type \[isearch-delete-char] to cancel characters from end of search string. Type \[isearch-exit] to exit, leaving point at location found. Type LFD (C-j) to match end of line. Type \[isearch-repeat-forward] to search again forward, \[isearch-repeat-backward] to search again backward. Type \[isearch-yank-word] to yank word from buffer onto end of search string and search for it. Type \[isearch-yank-line] to yank rest of line onto end of search string and search for it. Type \[isearch-quote-char] to quote control character to search for it. \[isearch-abort] while searching or when search has failed cancels input back to what has been found successfully. \[isearch-abort] when search is successful aborts and moves point to starting point. Also supported is a search ring of the previous 16 search strings. Type \[isearch-ring-advance] to search for the next item in the search ring. Type \[isearch-ring-retreat] to search for the previous item in the search ring. Type \[isearch-complete] to complete the search string using the search ring. The above keys, bound in `isearch-mode-map', are often controlled by options; do M-x apropos on search-.* to find them. Other control and meta characters terminate the search and are then executed normally (depending on `search-exit-option'). Likewise for function keys and mouse button events. If this function is called non-interactively, it does not return to the calling function until the search is done. (defalias 'isearch-forward #[(&optional regexp-p no-recursive-edit) "ÀÁ\n??Ã\f?$‡" [isearch-mode t regexp-p nil no-recursive-edit] 5 (#$ . 5889) "P\np"]) #@234 Do incremental search forward for regular expression. With a prefix argument, do a regular string search instead. Like ordinary incremental search except that your input is treated as a regexp. See \[isearch-forward] for more info. (defalias 'isearch-forward-regexp #[(&optional not-regexp no-recursive-edit) "ÀÁ\n?Ã\f?$‡" [isearch-mode t not-regexp nil no-recursive-edit] 5 (#$ . 7780) "P\np"]) #@142 Do incremental search backward. With a prefix argument, do a regular expression search instead. See \[isearch-forward] for more information. (defalias 'isearch-backward #[(&optional regexp-p no-recursive-edit) "ÀÁ\n??Á ?$‡" [isearch-mode nil regexp-p no-recursive-edit] 5 (#$ . 8184) "P\np"]) #@235 Do incremental search backward for regular expression. With a prefix argument, do a regular string search instead. Like ordinary incremental search except that your input is treated as a regexp. See \[isearch-forward] for more info. (defalias 'isearch-backward-regexp #[(&optional not-regexp no-recursive-edit) "ÀÁ\n?Á ?$‡" [isearch-mode nil not-regexp no-recursive-edit] 5 (#$ . 8484) "P\np"]) (defalias 'isearch-mode-help #[nil "ÀÁ!ˆÂ ‡" [describe-function isearch-forward isearch-update] 2 nil nil]) #@83 Start isearch minor mode. Called by `isearch-forward', etc. \{isearch-mode-map} (defalias 'isearch-mode #[(forward &optional regexp op-fun recursive-edit word-p) "\n\f Ê Ê\fÍÏÍ`ÍÍÍÍX…;Ù Û_VÍÍ`Í Í!…Sâ #ä%æ ˆç ˆ()ê ˆëì!ˆí./ƒxÏ0ï ˆ)‡" [forward isearch-forward regexp isearch-regexp word-p isearch-word op-fun isearch-op-fun case-fold-search isearch-case-fold-search "" isearch-string isearch-message nil isearch-cmds t isearch-success isearch-wrapped isearch-barrier isearch-adjusted isearch-yank-flag isearch-invalid-regexp isearch-within-brackets baud-rate search-slow-speed window-height search-slow-window-lines 4 isearch-slow-terminal-mode isearch-other-end isearch-small-window isearch-opoint search-ring-yank-pointer regexp-search-ring-yank-pointer current-window-configuration isearch-window-configuration " Isearch" isearch-mode force-mode-line-update isearch-push-state isearch-mode-map overriding-terminal-local-map isearch-update run-hooks isearch-mode-hook (isearch-done) mouse-leave-buffer-hook recursive-edit isearch-recursive-edit] 3 (#$ . 8994)]) (defalias 'isearch-update #[nil "„Á „\f ˆ ƒk\f„kÅ „k`ÇÈÉ!ˆÊ ÌÍÉWƒ5[T‚;Ï TZ\"ˆ)ÉWƒbÐÊZ!ˆÑÒ `\"ˆÓÒ Ô \"ˆÓÕ É\"ˆ‚fÖÊ!ˆbˆ)ƒ‰`Wƒ€Ø`\"ˆ‚Ø`\"ˆ‚ÙÍ!ˆÍ͉‡" [unread-command-events input-pending-p isearch-message isearch-slow-terminal-mode isearch-small-window pos-visible-in-window-p found-point t move-to-window-line 0 1 window-min-height split-window nil search-slow-window-lines window-height vertical-motion set-window-start next-window set-window-hscroll window-hscroll selected-window other-window isearch-other-end isearch-highlight isearch-dehighlight isearch-adjusted isearch-yank-flag] 4]) (defalias 'isearch-done #[(&optional nopush edit) "ÀÀÃÄ!ˆÅÆ !` ƒÊ !ˆ ƒ'bˆ‚/ÌÆ Ä#ˆ` U„Vƒ@„VÐ Ä\"ˆ„VÒ ÓV„VÔÕ!ˆ*À× ˆGÓVƒq„qÚ\"ˆÜÝ!ˆ?…‚…‚à ‡" [nil mouse-leave-buffer-hook overriding-terminal-local-map isearch-dehighlight t window-start selected-window found-point found-start isearch-window-configuration set-window-configuration isearch-small-window set-window-start isearch-opoint transient-mark-mode mark-active push-mark executing-macro minibuffer-depth 0 message "Mark saved where search started" isearch-mode force-mode-line-update isearch-string nopush isearch-update-ring isearch-regexp run-hooks isearch-mode-end-hook edit isearch-recursive-edit exit-recursive-edit] 4]) #@80 Add STRING to the beginning of the search ring. REGEXP says which ring to use. (defalias 'isearch-update-ring #[(string &optional regexp) "ƒ\" ƒ\n @˜?…D\n B‰G V…!\fS ›Å¡‡ƒ0\n@˜?…D\nB‰G\fV…D\fS›Å¡‡" [regexp regexp-search-ring string regexp-search-ring-max search-ring-max nil search-ring] 3 (#$ . 11481)]) (defalias 'isearch-switch-frame-handler #[nil "À ˆÁ A@!‡" [isearch-done handle-switch-frame isearch-last-command-char] 2 nil nil]) #@205 Exit search normally. However, if this is the first command after starting incremental search and `search-nonincremental-instead' is non-nil, do a nonincremental search instead via `isearch-edit-string'. (defalias 'isearch-exit #[nil "ƒ GÂUƒÃÅ ˆ)Æ ‡" [search-nonincremental-instead isearch-string 0 t isearch-nonincremental isearch-edit-string isearch-done] 2 (#$ . 11945) nil]) #@792 Edit the search string in the minibuffer. The following additional command keys are active while editing. \ \[exit-minibuffer] to resume incremental searching with the edited string. \[isearch-nonincremental-exit-minibuffer] to do one nonincremental search. \[isearch-forward-exit-minibuffer] to resume isearching forward. \[isearch-reverse-exit-minibuffer] to resume isearching backward. \[isearch-ring-advance-edit] to replace the search string with the next item in the search ring. \[isearch-ring-retreat-edit] to replace the search string with the previous item in the search ring. \[isearch-complete-edit] to complete the search string using the search ring. \ If first char entered is \[isearch-yank-word], then do word search instead. (defalias 'isearch-edit-string #[nil "ÀÁ‡" [err (byte-code " \n \f  \n \f Ó  \f \n ÙÚۈ ˆÜŽÝß ) á\"á#äåá‰Ý#!ˆæ'è !\"é=ƒ}ÝÝ‚‚ê !ˆáá+ìåá‰# -áë%)îïð#, GñUƒ´ ƒ°2‚²3@ô ˆõ ˆö ˆ…Ã÷ .‡" [isearch-nonincremental isearch-string isearch-message isearch-forward isearch-word isearch-regexp isearch-op-fun isearch-cmds isearch-success isearch-wrapped isearch-barrier isearch-adjusted isearch-yank-flag isearch-invalid-regexp isearch-within-brackets isearch-opoint isearch-slow-terminal-mode isearch-small-window isearch-recursive-edit current-window-configuration isearch-window-configuration isearch-new-word isearch-new-forward isearch-new-message isearch-new-string err (byte-code "ÀÁ‰\"‡" [isearch-done t] 3) ((exit)) ((byte-code "À \n Ä %ˆ \n ć" [isearch-mode isearch-forward isearch-regexp isearch-op-fun nil isearch-word isearch-new-string isearch-string isearch-new-message isearch-message isearch-new-forward isearch-new-word] 6)) t cursor-in-echo-area read-event e nil minibuffer-history-symbol message-log-max message isearch-message-prefix lookup-key isearch-mode-map vector isearch-yank-word isearch-unread junk-ring read-from-minibuffer minibuffer-local-isearch-map mapconcat isearch-text-char-description "" 0 regexp-search-ring search-ring isearch-push-state isearch-search isearch-update isearch-done] 20) ((quit (isearch-abort)))] 3 (#$ . 12337) nil]) (defalias 'isearch-nonincremental-exit-minibuffer #[nil "À ‡" [t isearch-nonincremental exit-minibuffer] 1 nil nil]) (defalias 'isearch-forward-exit-minibuffer #[nil "À ‡" [t isearch-new-forward exit-minibuffer] 1 nil nil]) (defalias 'isearch-reverse-exit-minibuffer #[nil "À ‡" [nil isearch-new-forward exit-minibuffer] 1 nil nil]) #@57 Terminate the search and go back to the starting point. (defalias 'isearch-cancel #[nil "bˆÁÂ!ˆÃÄÅ\"‡" [isearch-opoint isearch-done t signal quit nil] 3 (#$ . 14933) nil]) #@195 Abort incremental search mode if searching is successful, signalling quit. Otherwise, revert to previous successful search and continue searching. Use `isearch-exit' to quit without signalling. (defalias 'isearch-abort #[nil "À ˆ ƒ\nbˆÃÄÅ!ˆÆÇÃ\"‡ ƒƒ$É ˆ‚Ê ‡" [discard-input isearch-success isearch-opoint nil isearch-done t signal quit isearch-invalid-regexp isearch-pop-state isearch-update] 3 (#$ . 15113) nil]) (defalias 'isearch-repeat #[(direction) " Â==ƒ@ Äšƒ* ƒ@‚@†ÄÈÉ Ä#\n‚C „Cƒ7e‚8dbˆÌ ‚C?` ÄšƒRÌ ‚ˆ ƒ…Ï•Ï”šƒ…ƒgm‚hoƒtÐ Ñ ˆ‚ˆƒ|Ò‚}ÓuˆÔ ˆ‚ˆÔ ˆÕ ˆÖ ‡" [isearch-forward direction forward isearch-string "" isearch-regexp regexp-search-ring search-ring mapconcat isearch-text-char-description isearch-message isearch-success t isearch-wrapped isearch-barrier 0 nil ding 1 -1 isearch-search isearch-push-state isearch-update] 4]) #@37 Repeat incremental search forwards. (defalias 'isearch-repeat-forward #[nil "ÀÁ!‡" [isearch-repeat forward] 2 (#$ . 16004) nil]) #@38 Repeat incremental search backwards. (defalias 'isearch-repeat-backward #[nil "ÀÁ!‡" [isearch-repeat backward] 2 (#$ . 16139) nil]) #@36 Toggle regexp searching on or off. (defalias 'isearch-toggle-regexp #[nil "?‰ƒ Áà ‡" [isearch-regexp nil isearch-word isearch-update] 2 (#$ . 16277) nil]) #@45 Toggle case folding in searching on or off. (defalias 'isearch-toggle-case-fold #[nil "?…ÁÂÄÅƉ#ƒÉ‚Ê$ˆ)Ë\fÍÎ!ˆÏ ‡" [isearch-case-fold-search yes nil message-log-max message "%s%s [case %ssensitive]" isearch-message-prefix isearch-nonincremental isearch-message "in" "" t isearch-adjusted sit-for 1 isearch-update] 6 (#$ . 16442) nil]) #@90 Discard last input item and move point back. If no previous match was done, just beep. (defalias 'isearch-delete-char #[nil "A„ Á ˆ‚ ˆÃ ‡" [isearch-cmds ding isearch-pop-state isearch-update] 1 (#$ . 16799) nil]) (defalias 'isearch-yank #[(chunk) "Á=ƒ\fÂÃ!‚3Š\f„ ƒ bˆ`ŠÆ=ƒ&Çvˆ‚/È=ƒ/Ɉ`){)\n ƒF\fÍ=ƒF\n—\nƒQÏ\n!\n\nPÒÓ\nÔ#PÕ)× ‡" [chunk kill current-kill 0 isearch-forward isearch-other-end word 1 line nil string isearch-case-fold-search search-upper-case not-yanks isearch-regexp regexp-quote isearch-string isearch-message mapconcat isearch-text-char-description "" t isearch-yank-flag isearch-search-and-update] 5]) #@48 Pull string from kill ring into search string. (defalias 'isearch-yank-kill #[nil "ÀÁ!‡" [isearch-yank kill] 2 (#$ . 17468) nil]) #@48 Pull next word from buffer into search string. (defalias 'isearch-yank-word #[nil "ÀÁ!‡" [isearch-yank word] 2 (#$ . 17604) nil]) #@51 Pull rest of line from buffer into search string. (defalias 'isearch-yank-line #[nil "ÀÁ!‡" [isearch-yank line] 2 (#$ . 17740) nil]) (defalias 'isearch-search-and-update #[nil "„ ƒV\n„6 „6ÄÅƃ6„'È• \n^Xƒ6ËÄ\fÄ È•‚VƒS „S\nƒH‚Q \nT^^bˆÏ ˆÐ ˆƒb ˆÒ ‡" [isearch-success isearch-regexp isearch-forward isearch-adjusted nil (byte-code "À ƒ \n‚\fÃ\n!!‡" [looking-at isearch-regexp isearch-string regexp-quote] 3) ((error)) isearch-yank-flag 0 isearch-opoint isearch-barrier t isearch-invalid-regexp isearch-within-brackets isearch-other-end isearch-search isearch-push-state isearch-op-fun isearch-update] 3]) #@38 Handle * and ? specially in regexps. (defalias 'isearch-*-char #[nil "ƒ2Á ƒÄ‚ÅA@8‰† ƒ*]‚/^bˆ)ÉÊ !‡" [isearch-regexp t isearch-adjusted isearch-forward 5 2 isearch-cmds cs isearch-barrier isearch-process-search-char isearch-last-command-char] 3 (#$ . 18387) nil]) #@43 If in regexp search, jump to the barrier. (defalias 'isearch-|-char #[nil "ƒ Á bˆÄÅ !‡" [isearch-regexp t isearch-adjusted isearch-barrier isearch-process-search-char isearch-last-command-char] 2 (#$ . 18683) nil]) (defalias (quote isearch-other-control-char) (quote isearch-other-meta-char)) #@263 Exit the search normally and reread this key sequence. But only if `search-exit-option' is non-nil, the default. If it is the symbol `edit', the search string is edited in the minibuffer and the meta character is unread so that it applies to editing the string. (defalias 'isearch-other-meta-char #[nil "À ‰ÂHÄ ! GÆUƒGÇ \"‰ ?†! ¨)„GÊ ˆÇ \"ƒ:Ì ˆÍÎ \"‚ÍÎÄÇ \"!\"‚Ï ! ¨…sÑ>…sÒ>…sÇÔ !‰ ÖZIˆ)×#)ƒ‡ ÖZ ˆÊ ˆÍÎ \"‚Ù=ƒ˜ÍÎ \"ˆÚ ‚ƒ×Ê ˆÍÎ \"ˆ GÆVƒä ÂH9ƒä ÆH<ƒäÜÝ ÆH!!§„äA‰@‰‰A@)A ‰A@)A@@ ˆ <ƒ ‰A@)‰ @)‰ƒá!ƒŠâ!qˆÌ )‚Ì )‚ã ‰\"+‡" [this-command-keys key 0 main-event listify-key-sequence keylist 1 lookup-key function-key-map lookup cancel-kbd-macro-events global-map isearch-done apply isearch-unread event-modifiers mods shift control isearch-mode-map copy-sequence copy 33554432 nil search-exit-option edit isearch-edit-string window posn-point event-start unread-command-events event position windowp window-buffer isearch-process-search-string] 7 (#$ . 18986) nil]) #@50 Quote special characters for incremental search. (defalias 'isearch-quote-char #[nil "ÀÁÂÃ!!!‡" [isearch-process-search-char read-quoted-char isearch-message t] 4 (#$ . 20030) nil]) #@63 Convert return into newline for incremental search. Obsolete. (defalias 'isearch-return-char #[nil "ÀÁ!‡" [isearch-process-search-char 10] 2 (#$ . 20218) nil]) #@71 Add this ordinary printing character to the search string and search. (defalias 'isearch-printing-char #[nil "ÀÁ !‡" [isearch-process-search-char isearch-last-command-char] 2 (#$ . 20384) nil]) #@102 Match all whitespace chars, if in regexp mode. If you want to search for just a space, type C-q SPC. (defalias 'isearch-whitespace-chars #[nil "ƒ ƒ\n„à Ä\"‡Å ‡Å ‡" [isearch-regexp search-whitespace-regexp isearch-within-brackets isearch-process-search-string " " isearch-printing-char] 3 (#$ . 20585) nil]) (defalias 'isearch-process-search-char #[(char) "ÀÁ\n!Ã\n!\"‡" [isearch-process-search-string isearch-char-to-string char isearch-text-char-description] 4]) (defalias 'isearch-process-search-string #[(string message) " P\n PÄ ‡" [isearch-string string isearch-message message isearch-search-and-update] 2]) (defalias 'isearch-ring-adjust1 #[(advance) "ƒ ‚ \n‰GƒÅ‚ÆÈ! \fÊU?…OË †.Ê\fƒ7Í‚8Î\\\f\"‰ Lˆ 8ÐÑÒ#‰,‡" [isearch-regexp regexp-search-ring search-ring ring length regexp-search-ring-yank-pointer search-ring-yank-pointer yank-pointer-name eval yank-pointer 0 mod advance -1 1 isearch-string mapconcat isearch-text-char-description "" isearch-message] 5]) (defalias 'isearch-ring-adjust #[(advance) "AƒÁ ˆÂ !ˆÄ ˆ ƒÆ ˆÇ ‡È ‡" [isearch-cmds isearch-pop-state isearch-ring-adjust1 advance isearch-push-state search-ring-update isearch-search isearch-update isearch-edit-string] 2]) #@48 Advance to the next search string in the ring. (defalias 'isearch-ring-advance #[nil "ÀÁ!‡" [isearch-ring-adjust advance] 2 (#$ . 21827) nil]) #@52 Retreat to the previous search string in the ring. (defalias 'isearch-ring-retreat #[nil "ÀÁ!‡" [isearch-ring-adjust nil] 2 (#$ . 21976) nil]) #@68 Insert the next element of the search history into the minibuffer. (defalias 'isearch-ring-advance-edit #[(n) "ƒÁ‚ ÂÄ !ƒ‚‰G‰ ÊU?…B Ë †-Ê\fZ \"‰LˆÍ ˆ 8cˆdb,‡" [isearch-regexp regexp-search-ring-yank-pointer search-ring-yank-pointer yank-pointer-name eval yank-pointer regexp-search-ring search-ring ring length 0 mod n erase-buffer] 5 (#$ . 22125) "p"]) #@73 Inserts the previous element of the search history into the minibuffer. (defalias 'isearch-ring-retreat-edit #[(n) "À [!‡" [isearch-ring-advance-edit n] 2 (#$ . 22509) "p"]) (defalias 'isearch-complete1 #[nil "ƒ ‚ \nÄÅ \"É\n\"‰ Ì=ƒ&Ì‚\\ „3\nGÍUƒW \nšƒOƒSÏÐÑ\n\"!‘ˆ‚S \nÌ‚\\ÒÓ!ˆÔ,‡" [isearch-regexp regexp-search-ring search-ring ring mapcar #[(string) "C‡" [string] 1] alist case-fold-search completion-ignore-case try-completion isearch-string completion t 0 completion-auto-help "*Isearch completions*" display-completion-list all-completions message "No completion" nil] 6]) #@189 Complete the search string from the strings on the search ring. The completed string is then editable in the minibuffer. If there is no completion possible, say so and continue searching. (defalias 'isearch-complete #[nil "À ƒÁ ‡ÂÃ!ˆÄ ‡" [isearch-complete1 isearch-edit-string sit-for 1 isearch-update] 2 (#$ . 23130) nil]) #@54 Same as `isearch-complete' except in the minibuffer. (defalias 'isearch-complete-edit #[nil "À  … à ˆ c‡" [buffer-string isearch-string isearch-complete1 erase-buffer] 1 (#$ . 23462) nil]) (defalias 'isearch-top-state #[nil "@‰@ A@Ä 8Æ 8È 8 Ê 8 Ì 8 Î 8Ð 8Ò 8Ô 8 AA@b)‡" [isearch-cmds cmd isearch-string isearch-message 3 isearch-success 4 isearch-forward 5 isearch-other-end 6 isearch-word 7 isearch-invalid-regexp 8 isearch-wrapped 9 isearch-barrier 10 isearch-within-brackets 11 isearch-case-fold-search] 3]) (defalias 'isearch-pop-state #[nil "AÁ ‡" [isearch-cmds isearch-top-state] 1]) (defalias 'isearch-push-state #[nil " `\n \f  \n¯\f B‰ ‡" [isearch-string isearch-message isearch-success isearch-forward isearch-other-end isearch-word isearch-invalid-regexp isearch-wrapped isearch-barrier isearch-within-brackets isearch-case-fold-search isearch-cmds] 12]) (defalias 'isearch-message #[(&optional c-q-hack ellipsis) "Á\n #\fÅ\n\"Q\nƒ‚\"È ÊË\")*‡" [ellipsis isearch-message-prefix c-q-hack isearch-nonincremental isearch-message isearch-message-suffix m cursor-in-echo-area nil message-log-max message "%s"] 6]) (defalias 'isearch-message-prefix #[(&optional c-q-hack ellipsis nonincremental) "ƒ ƒ ÂÃĈ „ ƒÆ‚Ç…5 ƒ-`\nV‚1`\nW…5Ë…;Ì ƒD΂EƃNЂOƃXÒ‚YÓ ƒbÔ‚cÕ°‰××H–Iˆ)‡" [isearch-invalid-regexp ellipsis nil (byte-code "À `Â#ˆÃÃÇ" [re-search-forward isearch-string t nil isearch-invalid-regexp isearch-within-brackets] 4) ((error)) isearch-success "" "failing " isearch-wrapped isearch-forward isearch-opoint "over" "wrapped " isearch-word "word " isearch-regexp "regexp " nonincremental "search" "I-search" ": " " backward: " m 0] 8]) (defalias 'isearch-message-suffix #[(&optional c-q-hack ellipsis) "ƒÁ‚  ƒÄ ÅQ‚ÂP‡" [c-q-hack "^Q" "" isearch-invalid-regexp " [" "]"] 4]) (defalias 'isearch-search #[nil "ÀÁÂ\"ˆ Â=ƒ\fƒÅ\"ÈÉʈ ?…2Ì @8ƒ,Î ˆÏ @8b‡" [isearch-message nil t isearch-case-fold-search search-upper-case isearch-no-upper-case-p isearch-string isearch-regexp lossage (byte-code "À \fƒ\nÀÀƒƒÉ‚:Ê‚:\fƒ0ƒ,Ë‚:Ì‚:ƒ9Í‚:ÎÀÐ#‰ƒSƒOÒ”‚QÒ•*À‡" [nil isearch-case-fold-search case-fold-search inhibit-quit isearch-regexp isearch-invalid-regexp isearch-within-brackets isearch-word isearch-forward word-search-forward word-search-backward re-search-forward re-search-backward search-forward search-backward isearch-string t isearch-success 0 isearch-other-end] 5) ((quit (byte-code "ÀÁ!ˆÂ‡" [isearch-unread 7 nil isearch-success] 2)) (invalid-regexp (byte-code "A@Âà \"ÂÅ \"ƒÆ‡" [lossage isearch-invalid-regexp string-match "\\`Unmatched \\[" isearch-within-brackets "\\`Premature \\|\\`Unmatched \\|\\`Invalid " "incomplete input"] 3)) (error (byte-code "A@‡" [lossage isearch-invalid-regexp nil] 1))) isearch-success 3 isearch-cmds ding 2] 3]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp isearch-overlay nil current-load-list] 2) (defalias 'isearch-highlight #[(beg end) "?† ??…+\n„Ã\f \"Æ\n\f p$ˆÇ\nÈÉÊË\"ƒ)Ê‚*Ì#‡" [search-highlight window-system isearch-overlay make-overlay beg end move-overlay overlay-put face internal-find-face isearch nil region] 6]) (defalias 'isearch-dehighlight #[(totally) "…Á!‡" [isearch-overlay delete-overlay] 2]) #@176 Return t if there are no upper case chars in STRING. If REGEXP-FLAG is non-nil, disregard letters preceeded by `\' (but not `\\') since they have special meaning in a regexp. (defalias 'isearch-no-upper-case-p #[(string regexp-flag) "À ƒ Ä‚\fÅ\")?‡" [nil case-fold-search string-match regexp-flag "\\(^\\|\\\\\\\\\\|[^\\]\\)[A-Z]" "[A-Z]" string] 3 (#$ . 26792)]) (byte-code "À B Bà BÀ‡" [unread-command-event current-load-list unread-command-events last-command-event] 2) (defalias 'isearch-char-to-string #[(c) "ÀÁ\n\"‡" [make-string 1 c] 3]) (defalias 'isearch-text-char-description #[(c) "¨ƒÁW„ÂUƒÃ!‡Ä!‡" [c 32 127 text-char-description isearch-char-to-string] 2]) (defalias 'isearch-unread #[(&rest char-or-events) "À \n\"‰‡" [append char-or-events unread-command-events] 3]) (defalias 'isearch-last-command-char #[nil "‡" [last-command-char] 1]) emacs-19.30/lisp/iso-acc.elc100666 12120 1 17130 6043466023 14105 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:55:18 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/iso-acc.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`iso-acc.el' was compiled for Emacs 19.29 or later")) (provide (quote iso-acc)) #@399 List of language-specific customizations for the ISO Accents mode. Each element of the list is of the form (LANGUAGE ENABLE LIST). LANGUAGE is a string naming the language. ENABLE is a list of characters that will be used as accent prefixes. It will be the value of the iso-accents-enable variable. LIST is a list of accent translations. It will be the value of the iso-accents-list variable. (defvar iso-languages (quote (("portuguese" (39 96 94 34 126) (((39 65) 193) ((39 69) 201) ((39 73) 205) ((39 79) 211) ((39 85) 218) ((39 67) 199) ((39 97) 225) ((39 101) 233) ((39 105) 237) ((39 111) 243) ((39 117) 250) ((39 99) 231) ((39 32) 39) ((96 65) 192) ((96 97) 224) ((96 32) 96) ((94 65) 194) ((94 69) 202) ((94 79) 212) ((94 97) 226) ((94 101) 234) ((94 111) 244) ((94 32) 94) ((34 85) 220) ((34 117) 252) ((34 32) 34) ((126 65) 195) ((126 79) 213) ((126 97) 227) ((126 111) 245) ((126 32) 126))) ("french" (39 96 94 34 126) (((39 65) 193) ((39 69) 201) ((39 73) 205) ((39 79) 211) ((39 85) 218) ((39 67) 199) ((39 97) 225) ((39 101) 233) ((39 105) 237) ((39 111) 243) ((39 117) 250) ((39 99) 231) ((39 32) 39) ((96 65) 192) ((96 69) 200) ((96 97) 224) ((96 101) 232) ((96 32) 96) ((94 65) 194) ((94 69) 202) ((94 73) 206) ((94 79) 212) ((94 85) 219) ((94 97) 226) ((94 101) 234) ((94 105) 238) ((94 111) 244) ((94 117) 251) ((94 32) 94) ((34 85) 220) ((34 117) 252) ((34 32) 34) ((126 65) 195) ((126 79) 213) ((126 97) 227) ((126 111) 245) ((126 32) 126))) ("default" (39 96 94 34 126 47) (((39 65) 193) ((39 69) 201) ((39 73) 205) ((39 79) 211) ((39 85) 218) ((39 89) 221) ((39 97) 225) ((39 101) 233) ((39 105) 237) ((39 111) 243) ((39 117) 250) ((39 121) 253) ((39 39) 180) ((39 32) 39) ((96 65) 192) ((96 69) 200) ((96 73) 204) ((96 79) 210) ((96 85) 217) ((96 97) 224) ((96 101) 232) ((96 105) 236) ((96 111) 242) ((96 117) 249) ((96 32) 96) ((96 96) 96) ((94 65) 194) ((94 69) 202) ((94 73) 206) ((94 79) 212) ((94 85) 219) ((94 97) 226) ((94 101) 234) ((94 105) 238) ((94 111) 244) ((94 117) 251) ((94 32) 94) ((94 94) 94) ((34 65) 196) ((34 69) 203) ((34 73) 207) ((34 79) 214) ((34 85) 220) ((34 97) 228) ((34 101) 235) ((34 105) 239) ((34 111) 246) ((34 115) 223) ((34 117) 252) ((34 121) 255) ((34 32) 34) ((34 34) 168) ((126 65) 195) ((126 67) 199) ((126 68) 208) ((126 78) 209) ((126 79) 213) ((126 84) 222) ((126 97) 227) ((126 99) 231) ((126 100) 240) ((126 110) 241) ((126 111) 245) ((126 116) 254) ((126 62) 187) ((126 60) 171) ((126 32) 126) ((126 126) 184) ((47 65) 197) ((47 69) 198) ((47 79) 216) ((47 97) 229) ((47 101) 230) ((47 111) 248) ((47 32) 47) ((47 47) 176))))) (#$ . 508)) #@115 Language for which ISO Accents mode is currently customized. Change it with the `iso-accents-customize' function. (defvar iso-language nil (#$ . 3130)) #@72 Association list for ISO accent combinations, for the chosen language. (defvar iso-accents-list nil (#$ . 3288)) #@133 *Non-nil enables ISO Accents mode. Setting this variable makes it local to the current buffer. See the function `iso-accents-mode'. (defvar iso-accents-mode nil (#$ . -3408)) (make-variable-buffer-local (quote iso-accents-mode)) #@59 Modify the following character by adding an accent to it. (defalias 'iso-accents-accent-key #[(prompt) "ƒÁ\n!‡Ã\f!‡" [iso-accents-mode iso-accents-compose prompt char-to-string last-input-char] 2 (#$ . 3643)]) #@59 Modify the following character by adding an accent to it. (defalias 'iso-accents-compose-key #[(prompt) "À ! ƒ ÅÆÇÈ\nÉH!È\f@!#ˆ)\n)‡" [iso-accents-compose prompt combined unread-command-events unread nil error "Characters %s and %s cannot be composed" single-key-description 0] 5 (#$ . 3862)]) (defalias 'iso-accents-compose #[(prompt) "\n„ÃÄ!Å=ƒƒ\"ÇÈ\n†É #ˆÊ ‚, cˆÊ `S`|ˆ Ì  D \"‰ƒFA@C°‚N CÐ !+‡" [last-input-char first-char prompt key-binding "a" self-insert-command this-command message "%s%c" "Compose with " read-event second-char assoc iso-accents-list entry unread-command-events vector] 5]) #@248 *List of accent keys that become prefixes in ISO Accents mode. The default is (?' ?` ?^ ?" ?~ ?/), which contains all the supported accent keys. For certain languages, you might want to remove some of those characters that are not actually used. (defvar iso-accents-enable nil (#$ . -4498)) #@902 Toggle ISO Accents mode, in which accents modify the following letter. This permits easy insertion of accented characters according to ISO-8859-1. When Iso-accents mode is enabled, accent character keys (`, ', ", ^, / and ~) do not self-insert; instead, they modify the following letter key so that it inserts an ISO accented letter. The variable `iso-accents-enable' specifies the list of characters to enable as accents. If you don't need all of them, remove the ones you don't need from that list. Special combinations: ~c gives a c with cedilla, ~d gives an Icelandic eth (d with dash). ~t gives an Icelandic thorn. "s gives German sharp s. /a gives a with ring. /e gives an a-e ligature. ~< and ~> give guillemets. ~! gives an inverted exclamation mark. ~? gives an inverted question mark. With an argument, a positive argument enables ISO Accents mode, and a negative argument disables it. (defalias 'iso-accents-mode #[(&optional arg) "ƒ\fÁ!ÂX‚ ƒĉ‡Å‰‡" [arg prefix-numeric-value 0 iso-accents-mode nil t] 2 (#$ . 4797) "P"]) #@154 Customize the ISO accents machinery for a particular language. It selects the customization based on the specifications in the `iso-languages' variable. (defalias 'iso-accents-customize #[(language) "À \n\"É„ÆÇ!‚K  A@ AA@\n ƒ.ÌÍà #ˆ‚2Î   ‰…KÏ Ð\f@!Í#ˆ\fA‰„9Ã*‡" [assoc language iso-languages nil c table error "Unknown language" iso-language iso-accents-enable iso-accents-list key-translation-map substitute-key-definition iso-accents-accent-key make-sparse-keymap define-key char-to-string] 5 (#$ . 5851) (list (completing-read "Language: " iso-languages nil t))]) #@198 Convert two-character sequences in region into accented characters. Noninteractively, this operates on text from START to END. This uses the same conversion that ISO Accents mode uses for type-in. (defalias 'iso-accentuate #[(start end) "ŠŒ }ˆbˆÂuˆÃ` W…Jh >ƒDÆgXƒDgÇXƒDÈhgD \"‰ƒDÊuˆËÌ!ˆ\fA@cˆ S‚Âuˆ‚+‡" [start end 1 nil entry iso-accents-enable 65 122 assoc iso-accents-list -1 delete-char 2] 3 (#$ . 6447) "r"]) (defalias 'iso-accent-rassoc-unit #[(value alist) "ƒ@A@ =„A‰„…@‡" [alist value] 3]) #@211 Convert accented characters in the region into two-character sequences. Noninteractively, this operates on text from START to END. This uses the opposite of the conversion done by ISO Accents mode for type-in. (defalias 'iso-unaccentuate #[(start end) "ŠŒ }ˆbˆÂ` W…;gÄVƒ5Åg\"‰ƒ5ÇÈ!ˆ @@ @A@±ˆ T‚ Èuˆ‚ +‡" [start end nil entry 127 iso-accent-rassoc-unit iso-accents-list delete-char 1] 3 (#$ . 6980) "r"]) #@130 Convert accented characters in the region into unaccented characters. Noninteractively, this operates on text from START to END. (defalias 'iso-deaccentuate #[(start end) "ŠŒ }ˆbˆÂ` W…4gÄVƒ.Åg\"‰ƒ.ÇÈ!ˆ @A@cˆ‚ Èuˆ‚ +‡" [start end nil entry 127 iso-accent-rassoc-unit iso-accents-list delete-char 1] 3 (#$ . 7404) "r"]) (iso-accents-customize "default") emacs-19.30/lisp/iso-ascii.elc100666 13437 1 4635 5744576517 14612 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:44:14 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/iso-ascii.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/iso-ascii.el' was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃÄ\"ˆÂÅÆ\"ˆÂÇÈ\"ˆÂÉÊ\"ˆÂËÌ\"ˆÂÍÎ\"ˆÂÏÐ\"ˆÂÑÒ\"ˆÂÓÔ\"ˆÂÕÖ\"ˆÂ×Ø\"ˆÂÙÚ\"ˆÂÛÜ\"ˆÂÝÞ\"ˆÂßà\"ˆÂáâ\"ˆÂãä\"ˆÂåæ\"ˆÂçè\"ˆÂéê\"ˆÂëì\"ˆÂíî\"ˆÂïð\"ˆÂñò\"ˆÂóô\"ˆÂõö\"ˆÂ÷ø\"ˆÂùú\"ˆÂûü\"ˆÂýþ\"ˆÂÿ@\"ˆÂAB\"ˆÂCD\"ˆÂEF\"ˆÂGH\"ˆÂIJ\"ˆÂKL\"ˆÂMN\"ˆÂOP\"ˆÂQR\"ˆÂST\"ˆÂUV\"ˆÂWX\"ˆÂYZ\"ˆÂ[\\\"ˆÂ]^\"ˆÂ_`\"ˆÂab\"ˆÂcd\"ˆÂef\"ˆÂgh\"ˆÂij\"ˆÂkl\"ˆÂmn\"ˆÂop\"ˆÂqr\"ˆÂst\"ˆÂuv\"ˆÂwx\"ˆÂyz\"ˆÂ{|\"ˆÂ}~\"ˆÂ€\"ˆÂ‚\"ˆÂƒ„\"ˆÂ…†\"ˆÂ‡ˆ\"ˆÂ‰Š\"ˆÂ‹Œ\"ˆÂŽ\"ˆÂ\"ˆÂ‘’\"ˆÂ“”\"ˆÂ•–\"ˆÂ—˜\"ˆÂ™š\"ˆÂ›œ\"ˆÂž\"ˆÂŸ \"ˆÂ¡¢\"ˆÂ£¤\"ˆÂ¥¦\"ˆÂ§¨\"ˆÂ©ª\"ˆÂ«¬\"ˆÂ­®\"ˆÂ¯°\"ˆÂ±²\"ˆÂ³´\"ˆÂµ¶\"ˆÂ·¸\"ˆÂ¹º\"ˆÂ»¼\"ˆÂ½¾\"ˆÂ¿À\"ˆÂÁÂ\"ˆÃÄ!‡" [require disp-table standard-display-ascii 160 "{_}" 161 "{!}" 162 "{c}" 163 "{GBP}" 164 "{$}" 165 "{JPY}" 166 "{|}" 167 "{S}" 168 "{\"}" 169 "{C}" 170 "{_a}" 171 "{<<}" 172 "{~}" 173 "{-}" 174 "{R}" 175 "{=}" 176 "{o}" 177 "{+-}" 178 "{2}" 179 "{3}" 180 "{'}" 181 "{u}" 182 "{P}" 183 "{.}" 184 "{,}" 185 "{1}" 186 "{_o}" 187 "{>>}" 188 "{1/4}" 189 "{1/2}" 190 "{3/4}" 191 "{?}" 192 "{`A}" 193 "{'A}" 194 "{^A}" 195 "{~A}" 196 "{\"A}" 197 "{AA}" 198 "{AE}" 199 "{,C}" 200 "{`E}" 201 "{'E}" 202 "{^E}" 203 "{\"E}" 204 "{`I}" 205 "{'I}" 206 "{^I}" 207 "{\"I}" 208 "{-D}" 209 "{~N}" 210 "{`O}" 211 "{'O}" 212 "{^O}" 213 "{~O}" 214 "{\"O}" 215 "{x}" 216 "{/O}" 217 "{`U}" 218 "{'U}" 219 "{^U}" 220 "{\"U}" 221 "{'Y}" 222 "{TH}" 223 "{ss}" 224 "{`a}" 225 "{'a}" 226 "{^a}" 227 "{~a}" 228 "{\"a}" 229 "{aa}" 230 "{ae}" 231 "{,c}" 232 "{`e}" 233 "{'e}" 234 "{^e}" 235 "{\"e}" 236 "{`i}" 237 "{'i}" 238 "{^i}" 239 "{\"i}" 240 "{-d}" 241 "{~n}" 242 "{`o}" 243 "{'o}" 244 "{^o}" 245 "{~o}" 246 "{\"o}" 247 "{/}" 248 "{/o}" 249 "{`u}" 250 "{'u}" 251 "{^u}" 252 "{\"u}" 253 "{'y}" 254 "{th}" 255 "{\"y}" provide iso-ascii] 3) emacs-19.30/lisp/iso-cvt.elc100666 12120 1 31435 6045213670 14157 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:21:37 1995 ;;; from file /home/fsf/rms/e19/lisp/iso-cvt.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`iso-cvt.el' was compiled for Emacs 19.29 or later")) (provide (quote iso-cvt)) #@28 Spanish translation table. (defvar iso-spanish-trans-tab (quote (("~n" "ñ") ("([a-zA-Z])#" "\\1ñ") ("~N" "Ñ") ("\\([-a-zA-Z\"`]\\)\"u" "\\1ü") ("\\([-a-zA-Z\"`]\\)\"U" "\\1Ü") ("\\([-a-zA-Z]\\)'o" "\\1ó") ("\\([-a-zA-Z]\\)'O" "\\Ó") ("\\([-a-zA-Z]\\)'e" "\\1é") ("\\([-a-zA-Z]\\)'E" "\\1É") ("\\([-a-zA-Z]\\)'a" "\\1á") ("\\([-a-zA-Z]\\)'A" "\\1A") ("\\([-a-zA-Z]\\)'i" "\\1í") ("\\([-a-zA-Z]\\)'I" "\\1Í"))) (#$ . 500)) #@70 Use the translation table TRANS-TAB to translate the current buffer. (defalias 'iso-translate-conventions #[(trans-tab) "ŠebˆÁ‰\f….Š\f@Æ @ÁÇ#ƒ&È A@ÇÁ#ˆ‚)\fA)‚\n,‡" [trans-tab nil case-fold-search buffer-read-only work-tab trans-this re-search-forward t replace-match] 4 (#$ . 927)]) #@54 Translate net conventions for Spanish to ISO 8859-1. (defalias 'iso-spanish #[nil "À !‡" [iso-translate-conventions iso-spanish-trans-tab] 2 (#$ . 1227) nil]) #@119 German translation table. This table uses an aggressive translation approach and may erroneously translate too much. (defvar iso-aggressive-german-trans-tab (quote (("\"a" "ä") ("\"A" "Ä") ("\"o" "ö") ("\"O" "Ö") ("\"u" "ü") ("\"U" "Ü") ("\"s" "ß") ("\\\\3" "ß"))) (#$ . 1393)) #@110 German translation table. This table uses a conservative translation approach and may translate too little. (defvar iso-conservative-german-trans-tab (quote (("\\([-a-zA-Z\"`]\\)\"a" "\\1ä") ("\\([-a-zA-Z\"`]\\)\"A" "\\1Ä") ("\\([-a-zA-Z\"`]\\)\"o" "\\1ö") ("\\([-a-zA-Z\"`]\\)\"O" "\\1Ö") ("\\([-a-zA-Z\"`]\\)\"u" "\\1ü") ("\\([-a-zA-Z\"`]\\)\"U" "\\1Ü") ("\\([-a-zA-Z\"`]\\)\"s" "\\1ß") ("\\([-a-zA-Z\"`]\\)\\\\3" "\\1ß"))) (#$ . 1679)) #@48 Currently active translation table for German. (defvar iso-german-trans-tab iso-aggressive-german-trans-tab (#$ . 2125)) #@53 Translate net conventions for German to ISO 8859-1. (defalias 'iso-german #[nil "À !‡" [iso-translate-conventions iso-german-trans-tab] 2 (#$ . 2252) nil]) #@75 Translation table for translating ISO 8859-1 characters to TeX sequences. (defvar iso-iso2tex-trans-tab (quote (("ä" "{\\\\\"a}") ("à" "{\\\\`a}") ("á" "{\\\\'a}") ("ã" "{\\\\~a}") ("â" "{\\\\^a}") ("ë" "{\\\\\"e}") ("è" "{\\\\`e}") ("é" "{\\\\'e}") ("ê" "{\\\\^e}") ("ï" "{\\\\\"\\\\i}") ("ì" "{\\\\`\\\\i}") ("í" "{\\\\'\\\\i}") ("î" "{\\\\^\\\\i}") ("ö" "{\\\\\"o}") ("ò" "{\\\\`o}") ("ó" "{\\\\'o}") ("õ" "{\\\\~o}") ("ô" "{\\\\^o}") ("ü" "{\\\\\"u}") ("ù" "{\\\\`u}") ("ú" "{\\\\'u}") ("û" "{\\\\^u}") ("Ä" "{\\\\\"A}") ("À" "{\\\\`A}") ("Á" "{\\\\'A}") ("Ã" "{\\\\~A}") ("Â" "{\\\\^A}") ("Ë" "{\\\\\"E}") ("È" "{\\\\`E}") ("É" "{\\\\'E}") ("Ê" "{\\\\^E}") ("Ï" "{\\\\\"I}") ("Ì" "{\\\\`I}") ("Í" "{\\\\'I}") ("Î" "{\\\\^I}") ("Ö" "{\\\\\"O}") ("Ò" "{\\\\`O}") ("Ó" "{\\\\'O}") ("Õ" "{\\\\~O}") ("Ô" "{\\\\^O}") ("Ü" "{\\\\\"U}") ("Ù" "{\\\\`U}") ("Ú" "{\\\\'U}") ("Û" "{\\\\^U}") ("ñ" "{\\\\~n}") ("Ñ" "{\\\\~N}") ("ç" "{\\\\c c}") ("Ç" "{\\\\c C}") ("ß" "{\\\\ss}") ("Æ" "{\\\\AE}") ("æ" "{\\\\ae}") ("Å" "{\\\\AA}") ("å" "{\\\\aa}") ("©" "{\\\\copyright}") ("£" "{\\\\pounds}") ("¶" "{\\\\P}") ("§" "{\\\\S}") ("¿" "{?`}") ("¡" "{!`}"))) (#$ . 2414)) #@51 Translate ISO 8859-1 characters to TeX sequences. (defalias 'iso-iso2tex #[nil "À !‡" [iso-translate-conventions iso-iso2tex-trans-tab] 2 (#$ . 3579) nil]) #@186 Translation table for translating TeX sequences to ISO 8859-1 characters. This table is not exhaustive (and due to TeX's power can never be). It only contains commonly used sequences. (defvar iso-tex2iso-trans-tab (quote (("{\\\\\"a}" "ä") ("{\\\\`a}" "à") ("{\\\\'a}" "á") ("{\\\\~a}" "ã") ("{\\\\^a}" "â") ("{\\\\\"e}" "ë") ("{\\\\`e}" "è") ("{\\\\'e}" "é") ("{\\\\^e}" "ê") ("{\\\\\"\\\\i}" "ï") ("{\\\\`\\\\i}" "ì") ("{\\\\'\\\\i}" "í") ("{\\\\^\\\\i}" "î") ("{\\\\\"i}" "ï") ("{\\\\`i}" "ì") ("{\\\\'i}" "í") ("{\\\\^i}" "î") ("{\\\\\"o}" "ö") ("{\\\\`o}" "ò") ("{\\\\'o}" "ó") ("{\\\\~o}" "õ") ("{\\\\^o}" "ô") ("{\\\\\"u}" "ü") ("{\\\\`u}" "ù") ("{\\\\'u}" "ú") ("{\\\\^u}" "û") ("{\\\\\"A}" "Ä") ("{\\\\`A}" "À") ("{\\\\'A}" "Á") ("{\\\\~A}" "Ã") ("{\\\\^A}" "Â") ("{\\\\\"E}" "Ë") ("{\\\\`E}" "È") ("{\\\\'E}" "É") ("{\\\\^E}" "Ê") ("{\\\\\"I}" "Ï") ("{\\\\`I}" "Ì") ("{\\\\'I}" "Í") ("{\\\\^I}" "Î") ("{\\\\\"O}" "Ö") ("{\\\\`O}" "Ò") ("{\\\\'O}" "Ó") ("{\\\\~O}" "Õ") ("{\\\\^O}" "Ô") ("{\\\\\"U}" "Ü") ("{\\\\`U}" "Ù") ("{\\\\'U}" "Ú") ("{\\\\^U}" "Û") ("{\\\\~n}" "ñ") ("{\\\\~N}" "Ñ") ("{\\\\c c}" "ç") ("{\\\\c C}" "Ç") ("\\\\\"a" "ä") ("\\\\`a" "à") ("\\\\'a" "á") ("\\\\~a" "ã") ("\\\\^a" "â") ("\\\\\"e" "ë") ("\\\\`e" "è") ("\\\\'e" "é") ("\\\\^e" "ê") ("\\\\\"\\\\i" "ï") ("\\\\`\\\\i" "ì") ("\\\\'\\\\i" "í") ("\\\\^\\\\i" "î") ("\\\\\"i" "ï") ("\\\\`i" "ì") ("\\\\'i" "í") ("\\\\^i" "î") ("\\\\\"o" "ö") ("\\\\`o" "ò") ("\\\\'o" "ó") ("\\\\~o" "õ") ("\\\\^o" "ô") ("\\\\\"u" "ü") ("\\\\`u" "ù") ("\\\\'u" "ú") ("\\\\^u" "û") ("\\\\\"A" "Ä") ("\\\\`A" "À") ("\\\\'A" "Á") ("\\\\~A" "Ã") ("\\\\^A" "Â") ("\\\\\"E" "Ë") ("\\\\`E" "È") ("\\\\'E" "É") ("\\\\^E" "Ê") ("\\\\\"I" "Ï") ("\\\\`I" "Ì") ("\\\\'I" "Í") ("\\\\^I" "Î") ("\\\\\"O" "Ö") ("\\\\`O" "Ò") ("\\\\'O" "Ó") ("\\\\~O" "Õ") ("\\\\^O" "Ô") ("\\\\\"U" "Ü") ("\\\\`U" "Ù") ("\\\\'U" "Ú") ("\\\\^U" "Û") ("\\\\~n" "ñ") ("\\\\~N" "Ñ") ("\\\\\"{a}" "ä") ("\\\\`{a}" "à") ("\\\\'{a}" "á") ("\\\\~{a}" "ã") ("\\\\^{a}" "â") ("\\\\\"{e}" "ë") ("\\\\`{e}" "è") ("\\\\'{e}" "é") ("\\\\^{e}" "ê") ("\\\\\"{\\\\i}" "ï") ("\\\\`{\\\\i}" "ì") ("\\\\'{\\\\i}" "í") ("\\\\^{\\\\i}" "î") ("\\\\\"{i}" "ï") ("\\\\`{i}" "ì") ("\\\\'{i}" "í") ("\\\\^{i}" "î") ("\\\\\"{o}" "ö") ("\\\\`{o}" "ò") ("\\\\'{o}" "ó") ("\\\\~{o}" "õ") ("\\\\^{o}" "ô") ("\\\\\"{u}" "ü") ("\\\\`{u}" "ù") ("\\\\'{u}" "ú") ("\\\\^{u}" "û") ("\\\\\"{A}" "Ä") ("\\\\`{A}" "À") ("\\\\'{A}" "Á") ("\\\\~{A}" "Ã") ("\\\\^{A}" "Â") ("\\\\\"{E}" "Ë") ("\\\\`{E}" "È") ("\\\\'{E}" "É") ("\\\\^{E}" "Ê") ("\\\\\"{I}" "Ï") ("\\\\`{I}" "Ì") ("\\\\'{I}" "Í") ("\\\\^{I}" "Î") ("\\\\\"{O}" "Ö") ("\\\\`{O}" "Ò") ("\\\\'{O}" "Ó") ("\\\\~{O}" "Õ") ("\\\\^{O}" "Ô") ("\\\\\"{U}" "Ü") ("\\\\`{U}" "Ù") ("\\\\'{U}" "Ú") ("\\\\^{U}" "Û") ("\\\\~{n}" "ñ") ("\\\\~{N}" "Ñ") ("\\\\c{c}" "ç") ("\\\\c{C}" "Ç") ("{\\\\ss}" "ß") ("{\\\\AE}" "Æ") ("{\\\\ae}" "æ") ("{\\\\AA}" "Å") ("{\\\\aa}" "å") ("{\\\\copyright}" "©") ("\\\\copyright{}" "©") ("{\\\\pounds}" "£") ("{\\\\P}" "¶") ("{\\\\S}" "§") ("\\\\pounds{}" "£") ("\\\\P{}" "¶") ("\\\\S{}" "§") ("{\\?`}" "¿") ("{!`}" "¡") ("\\?`" "¿") ("!`" "¡"))) (#$ . 3742)) #@51 Translate TeX sequences to ISO 8859-1 characters. (defalias 'iso-tex2iso #[nil "À !‡" [iso-translate-conventions iso-tex2iso-trans-tab] 2 (#$ . 6878) nil]) #@182 Translation table for translating German TeX sequences to ISO 8859-1. This table is not exhaustive (and due to TeX's power can never be). It only contains commonly used sequences. (defvar iso-gtex2iso-trans-tab (quote (("{\\\\\"a}" "ä") ("{\\\\`a}" "à") ("{\\\\'a}" "á") ("{\\\\~a}" "ã") ("{\\\\^a}" "â") ("{\\\\\"e}" "ë") ("{\\\\`e}" "è") ("{\\\\'e}" "é") ("{\\\\^e}" "ê") ("{\\\\\"\\\\i}" "ï") ("{\\\\`\\\\i}" "ì") ("{\\\\'\\\\i}" "í") ("{\\\\^\\\\i}" "î") ("{\\\\\"i}" "ï") ("{\\\\`i}" "ì") ("{\\\\'i}" "í") ("{\\\\^i}" "î") ("{\\\\\"o}" "ö") ("{\\\\`o}" "ò") ("{\\\\'o}" "ó") ("{\\\\~o}" "õ") ("{\\\\^o}" "ô") ("{\\\\\"u}" "ü") ("{\\\\`u}" "ù") ("{\\\\'u}" "ú") ("{\\\\^u}" "û") ("{\\\\\"A}" "Ä") ("{\\\\`A}" "À") ("{\\\\'A}" "Á") ("{\\\\~A}" "Ã") ("{\\\\^A}" "Â") ("{\\\\\"E}" "Ë") ("{\\\\`E}" "È") ("{\\\\'E}" "É") ("{\\\\^E}" "Ê") ("{\\\\\"I}" "Ï") ("{\\\\`I}" "Ì") ("{\\\\'I}" "Í") ("{\\\\^I}" "Î") ("{\\\\\"O}" "Ö") ("{\\\\`O}" "Ò") ("{\\\\'O}" "Ó") ("{\\\\~O}" "Õ") ("{\\\\^O}" "Ô") ("{\\\\\"U}" "Ü") ("{\\\\`U}" "Ù") ("{\\\\'U}" "Ú") ("{\\\\^U}" "Û") ("{\\\\~n}" "ñ") ("{\\\\~N}" "Ñ") ("{\\\\c c}" "ç") ("{\\\\c C}" "Ç") ("\\\\\"a" "ä") ("\\\\`a" "à") ("\\\\'a" "á") ("\\\\~a" "ã") ("\\\\^a" "â") ("\\\\\"e" "ë") ("\\\\`e" "è") ("\\\\'e" "é") ("\\\\^e" "ê") ("\\\\\"\\\\i" "ï") ("\\\\`\\\\i" "ì") ("\\\\'\\\\i" "í") ("\\\\^\\\\i" "î") ("\\\\\"i" "ï") ("\\\\`i" "ì") ("\\\\'i" "í") ("\\\\^i" "î") ("\\\\\"o" "ö") ("\\\\`o" "ò") ("\\\\'o" "ó") ("\\\\~o" "õ") ("\\\\^o" "ô") ("\\\\\"u" "ü") ("\\\\`u" "ù") ("\\\\'u" "ú") ("\\\\^u" "û") ("\\\\\"A" "Ä") ("\\\\`A" "À") ("\\\\'A" "Á") ("\\\\~A" "Ã") ("\\\\^A" "Â") ("\\\\\"E" "Ë") ("\\\\`E" "È") ("\\\\'E" "É") ("\\\\^E" "Ê") ("\\\\\"I" "Ï") ("\\\\`I" "Ì") ("\\\\'I" "Í") ("\\\\^I" "Î") ("\\\\\"O" "Ö") ("\\\\`O" "Ò") ("\\\\'O" "Ó") ("\\\\~O" "Õ") ("\\\\^O" "Ô") ("\\\\\"U" "Ü") ("\\\\`U" "Ù") ("\\\\'U" "Ú") ("\\\\^U" "Û") ("\\\\~n" "ñ") ("\\\\~N" "Ñ") ("\\\\\"{a}" "ä") ("\\\\`{a}" "à") ("\\\\'{a}" "á") ("\\\\~{a}" "ã") ("\\\\^{a}" "â") ("\\\\\"{e}" "ë") ("\\\\`{e}" "è") ("\\\\'{e}" "é") ("\\\\^{e}" "ê") ("\\\\\"{\\\\i}" "ï") ("\\\\`{\\\\i}" "ì") ("\\\\'{\\\\i}" "í") ("\\\\^{\\\\i}" "î") ("\\\\\"{i}" "ï") ("\\\\`{i}" "ì") ("\\\\'{i}" "í") ("\\\\^{i}" "î") ("\\\\\"{o}" "ö") ("\\\\`{o}" "ò") ("\\\\'{o}" "ó") ("\\\\~{o}" "õ") ("\\\\^{o}" "ô") ("\\\\\"{u}" "ü") ("\\\\`{u}" "ù") ("\\\\'{u}" "ú") ("\\\\^{u}" "û") ("\\\\\"{A}" "Ä") ("\\\\`{A}" "À") ("\\\\'{A}" "Á") ("\\\\~{A}" "Ã") ("\\\\^{A}" "Â") ("\\\\\"{E}" "Ë") ("\\\\`{E}" "È") ("\\\\'{E}" "É") ("\\\\^{E}" "Ê") ("\\\\\"{I}" "Ï") ("\\\\`{I}" "Ì") ("\\\\'{I}" "Í") ("\\\\^{I}" "Î") ("\\\\\"{O}" "Ö") ("\\\\`{O}" "Ò") ("\\\\'{O}" "Ó") ("\\\\~{O}" "Õ") ("\\\\^{O}" "Ô") ("\\\\\"{U}" "Ü") ("\\\\`{U}" "Ù") ("\\\\'{U}" "Ú") ("\\\\^{U}" "Û") ("\\\\~{n}" "ñ") ("\\\\~{N}" "Ñ") ("\\\\c{c}" "ç") ("\\\\c{C}" "Ç") ("{\\\\ss}" "ß") ("{\\\\AE}" "Æ") ("{\\\\ae}" "æ") ("{\\\\AA}" "Å") ("{\\\\aa}" "å") ("{\\\\copyright}" "©") ("\\\\copyright{}" "©") ("{\\\\pounds}" "£") ("{\\\\P}" "¶") ("{\\\\S}" "§") ("\\\\pounds{}" "£") ("\\\\P{}" "¶") ("\\\\S{}" "§") ("?`" "¿") ("!`" "¡") ("{?`}" "¿") ("{!`}" "¡") ("\"a" "ä") ("\"A" "Ä") ("\"o" "ö") ("\"O" "Ö") ("\"u" "ü") ("\"U" "Ü") ("\"s" "ß") ("\\\\3" "ß"))) (#$ . 7041)) #@72 Translation table for translating ISO 8859-1 characters to German TeX. (defvar iso-iso2gtex-trans-tab (quote (("ä" "\"a") ("à" "{\\\\`a}") ("á" "{\\\\'a}") ("ã" "{\\\\~a}") ("â" "{\\\\^a}") ("ë" "{\\\\\"e}") ("è" "{\\\\`e}") ("é" "{\\\\'e}") ("ê" "{\\\\^e}") ("ï" "{\\\\\"\\\\i}") ("ì" "{\\\\`\\\\i}") ("í" "{\\\\'\\\\i}") ("î" "{\\\\^\\\\i}") ("ö" "\"o") ("ò" "{\\\\`o}") ("ó" "{\\\\'o}") ("õ" "{\\\\~o}") ("ô" "{\\\\^o}") ("ü" "\"u") ("ù" "{\\\\`u}") ("ú" "{\\\\'u}") ("û" "{\\\\^u}") ("Ä" "\"A") ("À" "{\\\\`A}") ("Á" "{\\\\'A}") ("Ã" "{\\\\~A}") ("Â" "{\\\\^A}") ("Ë" "{\\\\\"E}") ("È" "{\\\\`E}") ("É" "{\\\\'E}") ("Ê" "{\\\\^E}") ("Ï" "{\\\\\"I}") ("Ì" "{\\\\`I}") ("Í" "{\\\\'I}") ("Î" "{\\\\^I}") ("Ö" "\"O") ("Ò" "{\\\\`O}") ("Ó" "{\\\\'O}") ("Õ" "{\\\\~O}") ("Ô" "{\\\\^O}") ("Ü" "\"U") ("Ù" "{\\\\`U}") ("Ú" "{\\\\'U}") ("Û" "{\\\\^U}") ("ñ" "{\\\\~n}") ("Ñ" "{\\\\~N}") ("ç" "{\\\\c c}") ("Ç" "{\\\\c C}") ("ß" "\"s") ("Æ" "{\\\\AE}") ("æ" "{\\\\ae}") ("Å" "{\\\\AA}") ("å" "{\\\\aa}") ("©" "{\\\\copyright}") ("£" "{\\\\pounds}") ("¶" "{\\\\P}") ("§" "{\\\\S}") ("¿" "{?`}") ("¡" "{!`}"))) (#$ . 10268)) #@58 Translate German TeX sequences to ISO 8859-1 characters. (defalias 'iso-gtex2iso #[nil "À !‡" [iso-translate-conventions iso-gtex2iso-trans-tab] 2 (#$ . 11391) nil]) #@58 Translate ISO 8859-1 characters to German TeX sequences. (defalias 'iso-iso2gtex #[nil "À !‡" [iso-translate-conventions iso-iso2gtex-trans-tab] 2 (#$ . 11563) nil]) #@38 Check if tex buffer is German LaTeX. (defalias 'iso-german-tex-p #[nil "ŠŒ~ˆebˆÀÁÂÃ#*‡" [re-search-forward "\\\\documentstyle\\[.*german.*\\]" nil t] 4 (#$ . 11735)]) #@122 Turn ISO 8859-1 (aka. ISO Latin-1) buffer into TeX sequences. If German TeX is used, German TeX sequences are generated. (defalias 'iso-fix-iso2tex #[nil "Áš„\fšƒà ƒÄ ˆ‚Å ˆÆš„,Çš„,Èš….Å ‡" [major-mode latex-mode LaTeX-mode iso-german-tex-p iso-iso2gtex iso-iso2tex tex-mode TeX-mode plain-tex-mode] 2 (#$ . 11909)]) #@112 Turn TeX sequences into ISO 8859-1 (aka. ISO Latin-1) characters. This function recognices German TeX buffers. (defalias 'iso-fix-tex2iso #[nil "Áš„\fšƒà ƒÄ ˆ‚Å ˆÆš„,Çš„,Èš….Å ‡" [major-mode latex-mode Latex-mode iso-german-tex-p iso-gtex2iso iso-tex2iso tex-mode TeX-mode plain-tex-mode] 2 (#$ . 12248)]) #@32 find-file-hook for iso-cvt.el. (defalias 'iso-cvt-ffh #[nil "À ˆÁÂ!‡" [iso-fix-tex2iso set-buffer-modified-p nil] 2 (#$ . 12576)]) #@33 write file hook for iso-cvt.el. (defalias 'iso-cvt-wfh #[nil "À ‡" [iso-fix-iso2tex] 1 (#$ . 12713)]) #@33 after save hook for iso-cvt.el. (defalias 'iso-cvt-ash #[nil "À ˆÁÂ!‡" [iso-fix-tex2iso set-buffer-modified-p nil] 2 (#$ . 12821)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [add-hook find-file-hooks iso-cvt-ffh write-file-hooks iso-cvt-wfh after-save-hook iso-cvt-ash] 3) emacs-19.30/lisp/iso-insert.elc100666 13437 1 22702 5744576526 15041 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:44:17 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/iso-insert.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/iso-insert.el' was compiled for Emacs 19")) (defalias 'insert-no-break-space #[nil "Àc‡" [160] 1 nil "*"]) (defalias 'insert-inverted-exclamation-mark #[nil "Àc‡" [161] 1 nil "*"]) (defalias 'insert-cent-sign #[nil "Àc‡" [162] 1 nil "*"]) (defalias 'insert-pound-sign #[nil "Àc‡" [163] 1 nil "*"]) (defalias 'insert-general-currency-sign #[nil "Àc‡" [164] 1 nil "*"]) (defalias 'insert-yen-sign #[nil "Àc‡" [165] 1 nil "*"]) (defalias 'insert-broken-vertical-line #[nil "Àc‡" [166] 1 nil "*"]) (defalias 'insert-section-sign #[nil "Àc‡" [167] 1 nil "*"]) (defalias 'insert-diaeresis #[nil "Àc‡" [168] 1 nil "*"]) (defalias 'insert-copyright-sign #[nil "Àc‡" [169] 1 nil "*"]) (defalias 'insert-ordinal-indicator-feminine #[nil "Àc‡" [170] 1 nil "*"]) (defalias 'insert-angle-quotation-mark-left #[nil "Àc‡" [171] 1 nil "*"]) (defalias 'insert-not-sign #[nil "Àc‡" [172] 1 nil "*"]) (defalias 'insert-soft-hyphen #[nil "Àc‡" [173] 1 nil "*"]) (defalias 'insert-registered-sign #[nil "Àc‡" [174] 1 nil "*"]) (defalias 'insert-macron #[nil "Àc‡" [175] 1 nil "*"]) (defalias 'insert-degree-sign #[nil "Àc‡" [176] 1 nil "*"]) (defalias 'insert-plus-or-minus-sign #[nil "Àc‡" [177] 1 nil "*"]) (defalias 'insert-superscript-two #[nil "Àc‡" [178] 1 nil "*"]) (defalias 'insert-superscript-three #[nil "Àc‡" [179] 1 nil "*"]) (defalias 'insert-acute-accent #[nil "Àc‡" [180] 1 nil "*"]) (defalias 'insert-micro-sign #[nil "Àc‡" [181] 1 nil "*"]) (defalias 'insert-pilcrow #[nil "Àc‡" [182] 1 nil "*"]) (defalias 'insert-middle-dot #[nil "Àc‡" [183] 1 nil "*"]) (defalias 'insert-cedilla #[nil "Àc‡" [184] 1 nil "*"]) (defalias 'insert-superscript-one #[nil "Àc‡" [185] 1 nil "*"]) (defalias 'insert-ordinal-indicator-masculine #[nil "Àc‡" [186] 1 nil "*"]) (defalias 'insert-angle-quotation-mark-right #[nil "Àc‡" [187] 1 nil "*"]) (defalias 'insert-fraction-one-quarter #[nil "Àc‡" [188] 1 nil "*"]) (defalias 'insert-fraction-one-half #[nil "Àc‡" [189] 1 nil "*"]) (defalias 'insert-fraction-three-quarters #[nil "Àc‡" [190] 1 nil "*"]) (defalias 'insert-inverted-question-mark #[nil "Àc‡" [191] 1 nil "*"]) (defalias 'insert-A-grave #[nil "Àc‡" [192] 1 nil "*"]) (defalias 'insert-A-acute #[nil "Àc‡" [193] 1 nil "*"]) (defalias 'insert-A-circumflex #[nil "Àc‡" [194] 1 nil "*"]) (defalias 'insert-A-tilde #[nil "Àc‡" [195] 1 nil "*"]) (defalias 'insert-A-umlaut #[nil "Àc‡" [196] 1 nil "*"]) (defalias 'insert-A-ring #[nil "Àc‡" [197] 1 nil "*"]) (defalias 'insert-AE #[nil "Àc‡" [198] 1 nil "*"]) (defalias 'insert-C-cedilla #[nil "Àc‡" [199] 1 nil "*"]) (defalias 'insert-E-grave #[nil "Àc‡" [200] 1 nil "*"]) (defalias 'insert-E-acute #[nil "Àc‡" [201] 1 nil "*"]) (defalias 'insert-E-circumflex #[nil "Àc‡" [202] 1 nil "*"]) (defalias 'insert-E-umlaut #[nil "Àc‡" [203] 1 nil "*"]) (defalias 'insert-I-grave #[nil "Àc‡" [204] 1 nil "*"]) (defalias 'insert-I-acute #[nil "Àc‡" [205] 1 nil "*"]) (defalias 'insert-I-circumflex #[nil "Àc‡" [206] 1 nil "*"]) (defalias 'insert-I-umlaut #[nil "Àc‡" [207] 1 nil "*"]) (defalias 'insert-D-stroke #[nil "Àc‡" [208] 1 nil "*"]) (defalias 'insert-N-tilde #[nil "Àc‡" [209] 1 nil "*"]) (defalias 'insert-O-grave #[nil "Àc‡" [210] 1 nil "*"]) (defalias 'insert-O-acute #[nil "Àc‡" [211] 1 nil "*"]) (defalias 'insert-O-circumflex #[nil "Àc‡" [212] 1 nil "*"]) (defalias 'insert-O-tilde #[nil "Àc‡" [213] 1 nil "*"]) (defalias 'insert-O-umlaut #[nil "Àc‡" [214] 1 nil "*"]) (defalias 'insert-multiplication-sign #[nil "Àc‡" [215] 1 nil "*"]) (defalias 'insert-O-slash #[nil "Àc‡" [216] 1 nil "*"]) (defalias 'insert-U-grave #[nil "Àc‡" [217] 1 nil "*"]) (defalias 'insert-U-acute #[nil "Àc‡" [218] 1 nil "*"]) (defalias 'insert-U-circumflex #[nil "Àc‡" [219] 1 nil "*"]) (defalias 'insert-U-umlaut #[nil "Àc‡" [220] 1 nil "*"]) (defalias 'insert-Y-acute #[nil "Àc‡" [221] 1 nil "*"]) (defalias 'insert-THORN #[nil "Àc‡" [222] 1 nil "*"]) (defalias 'insert-ss #[nil "Àc‡" [223] 1 nil "*"]) (defalias 'insert-a-grave #[nil "Àc‡" [224] 1 nil "*"]) (defalias 'insert-a-acute #[nil "Àc‡" [225] 1 nil "*"]) (defalias 'insert-a-circumflex #[nil "Àc‡" [226] 1 nil "*"]) (defalias 'insert-a-tilde #[nil "Àc‡" [227] 1 nil "*"]) (defalias 'insert-a-umlaut #[nil "Àc‡" [228] 1 nil "*"]) (defalias 'insert-a-ring #[nil "Àc‡" [229] 1 nil "*"]) (defalias 'insert-ae #[nil "Àc‡" [230] 1 nil "*"]) (defalias 'insert-c-cedilla #[nil "Àc‡" [231] 1 nil "*"]) (defalias 'insert-e-grave #[nil "Àc‡" [232] 1 nil "*"]) (defalias 'insert-e-acute #[nil "Àc‡" [233] 1 nil "*"]) (defalias 'insert-e-circumflex #[nil "Àc‡" [234] 1 nil "*"]) (defalias 'insert-e-umlaut #[nil "Àc‡" [235] 1 nil "*"]) (defalias 'insert-i-grave #[nil "Àc‡" [236] 1 nil "*"]) (defalias 'insert-i-acute #[nil "Àc‡" [237] 1 nil "*"]) (defalias 'insert-i-circumflex #[nil "Àc‡" [238] 1 nil "*"]) (defalias 'insert-i-umlaut #[nil "Àc‡" [239] 1 nil "*"]) (defalias 'insert-d-stroke #[nil "Àc‡" [240] 1 nil "*"]) (defalias 'insert-n-tilde #[nil "Àc‡" [241] 1 nil "*"]) (defalias 'insert-o-grave #[nil "Àc‡" [242] 1 nil "*"]) (defalias 'insert-o-acute #[nil "Àc‡" [243] 1 nil "*"]) (defalias 'insert-o-circumflex #[nil "Àc‡" [244] 1 nil "*"]) (defalias 'insert-o-tilde #[nil "Àc‡" [245] 1 nil "*"]) (defalias 'insert-o-umlaut #[nil "Àc‡" [246] 1 nil "*"]) (defalias 'insert-division-sign #[nil "Àc‡" [247] 1 nil "*"]) (defalias 'insert-o-slash #[nil "Àc‡" [248] 1 nil "*"]) (defalias 'insert-u-grave #[nil "Àc‡" [249] 1 nil "*"]) (defalias 'insert-u-acute #[nil "Àc‡" [250] 1 nil "*"]) (defalias 'insert-u-circumflex #[nil "Àc‡" [251] 1 nil "*"]) (defalias 'insert-u-umlaut #[nil "Àc‡" [252] 1 nil "*"]) (defalias 'insert-y-acute #[nil "Àc‡" [253] 1 nil "*"]) (defalias 'insert-thorn #[nil "Àc‡" [254] 1 nil "*"]) (defalias 'insert-y-umlaut #[nil "Àc‡" [255] 1 nil "*"]) #@44 Keymap for ISO 8859/1 character insertion. (defvar 8859-1-map nil (#$ . 6195)) (byte-code "„ÐÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ #ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆÂáÈ #ˆÂâã#ˆÂäå#ˆÂæç#ˆÂèé#ˆÂêë#ˆÂìí#ˆÂîï#ˆÂðñ#ˆÂòó#ˆÂôõ#ˆÂö÷#ˆÂøù#ˆÂúû#ˆÂüý#ˆÂþÿ#ˆÂ@È #ˆÂAB#ˆÂCD#ˆÂEF#ˆÂGH#ˆÂIJ#ˆÂKÈ #ˆÂLM#ˆÂNO#ˆÂPQ#ˆÂRÈ #ˆÂSÈ #ˆÂTU#ˆÂVW#ˆÂXÈ #ˆÂYÈ #ˆÂZ[#ˆÂ\\]#ˆÂ^_#ˆÂ`a#ˆÂbc#ˆÂde#ˆÂfg#ˆÂhi#ˆÂjk#ˆÂlm#ˆÂno#ˆÂpq#ˆÂrs#ˆÂtu#ˆÂvw#ˆÂxÈ #ˆÂyz#ˆÂ{|#ˆÂ}~#ˆÂ€#ˆÂ‚#ˆÂƒ„#ˆÂ…†#ˆÂ‡ˆ#ˆÂ‰Š#ˆÂ‹Œ#ˆÂŽ#ˆÂ#ˆÂ‘’#ˆÂ“È #ˆÂ”•#ˆÂ–—#ˆÂ˜È #ˆÂ™š#ˆÂ›œ#ˆÂž#ˆÂŸ #ˆÂ¡¢#ˆÂ£¤#ˆÂ¥¦#ˆÂ§¨#ˆÂ©ª#ˆÂ«¬#ˆÂ­®#ˆÂ¯°#ˆÂ±²#ˆÂ³´#ˆÂµ¶#ˆÂ·¸#ˆÂ¹º#ˆÂ»¼#ˆÂ½¾#ˆÂ¿À#ˆÂÁÈ #ˆÂÂÃ#ˆÂÄÅ#ˆÂÆÇ#ˆÂÈÉ#ˆÂÊË#ˆÂÌÍ#ˆÂÎÏ#ˆÐÑÒ\"„ÐÂÑÒ#ˆÓÔ!‡" [8859-1-map make-keymap define-key " " insert-no-break-space "!" insert-inverted-exclamation-mark "\"" make-sparse-keymap "\"\"" insert-diaeresis "\"A" insert-A-umlaut "\"E" insert-E-umlaut "\"I" insert-I-umlaut "\"O" insert-O-umlaut "\"U" insert-U-umlaut "\"a" insert-a-umlaut "\"e" insert-e-umlaut "\"i" insert-i-umlaut "\"o" insert-o-umlaut "\"u" insert-u-umlaut "\"y" insert-y-umlaut "'" "''" insert-acute-accent "'A" insert-A-acute "'E" insert-E-acute "'I" insert-I-acute "'O" insert-O-acute "'U" insert-U-acute "'Y" insert-Y-acute "'a" insert-a-acute "'e" insert-e-acute "'i" insert-i-acute "'o" insert-o-acute "'u" insert-u-acute "'y" insert-y-acute "$" insert-general-currency-sign "+" insert-plus-or-minus-sign "," ",," insert-cedilla ",C" insert-C-cedilla ",c" insert-c-cedilla "-" insert-soft-hyphen "." insert-middle-dot "/" "//" insert-division-sign "/O" insert-O-slash "/o" insert-o-slash "1" "1/" "1/2" insert-fraction-one-half "1/4" insert-fraction-one-quarter "3" "3/" "3/4" insert-fraction-three-quarters "<" insert-angle-quotation-mark-left "=" insert-macron ">" insert-angle-quotation-mark-right "?" insert-inverted-question-mark "A" insert-A-ring "E" insert-AE "C" insert-copyright-sign "D" insert-D-stroke "L" insert-pound-sign "P" insert-pilcrow "R" insert-registered-sign "S" insert-section-sign "T" insert-THORN "Y" insert-yen-sign "^" "^1" insert-superscript-one "^2" insert-superscript-two "^3" insert-superscript-three "^A" insert-A-circumflex "^E" insert-E-circumflex "^I" insert-I-circumflex "^O" insert-O-circumflex "^U" insert-U-circumflex "^a" insert-a-circumflex "^e" insert-e-circumflex "^i" insert-i-circumflex "^o" insert-o-circumflex "^u" insert-u-circumflex "_" "_a" insert-ordinal-indicator-feminine "_o" insert-ordinal-indicator-masculine "`" "`A" insert-A-grave "`E" insert-E-grave "`I" insert-I-grave "`O" insert-O-grave "`U" insert-U-grave "`a" insert-a-grave "`e" insert-e-grave "`i" insert-i-grave "`o" insert-o-grave "`u" insert-u-grave "a" insert-a-ring "e" insert-ae "c" insert-cent-sign "d" insert-d-stroke "o" insert-degree-sign "s" insert-ss "t" insert-thorn "u" insert-micro-sign "x" insert-multiplication-sign "|" insert-broken-vertical-line "~" "~A" insert-A-tilde "~N" insert-N-tilde "~O" insert-O-tilde "~a" insert-a-tilde "~n" insert-n-tilde "~o" insert-o-tilde "~~" insert-not-sign lookup-key global-map "8" provide iso-insert] 4) emacs-19.30/lisp/iso-swed.elc100666 13437 1 4603 5744576527 14460 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:44:22 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/iso-swed.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/iso-swed.el' was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃÄ\"ˆÂÅÆ\"ˆÂÇÈ\"ˆÂÉÊ\"ˆËÌÍ\"ˆÂÎÏ\"ˆÂÐÑ\"ˆÂÒÓ\"ˆÂÔÕ\"ˆÂÖ×\"ˆÂØÙ\"ˆÂÚÛ\"ˆÂÜÝ\"ˆÂÞß\"ˆÂàá\"ˆÂâã\"ˆÂäå\"ˆÂæç\"ˆÂèé\"ˆÂêë\"ˆÂìí\"ˆÂîï\"ˆÂðñ\"ˆÂòó\"ˆÂôõ\"ˆÂö÷\"ˆÂøù\"ˆÂúû\"ˆÂüý\"ˆÂþÿ\"ˆÂ@A\"ˆÂBC\"ˆÂDE\"ˆÂFG\"ˆÂHI\"ˆÂJK\"ˆËLM\"ˆËNO\"ˆÂPQ\"ˆÂRS\"ˆÂTU\"ˆËVW\"ˆÂXY\"ˆÂZ[\"ˆÂ\\]\"ˆÂ^_\"ˆÂ`a\"ˆÂbc\"ˆÂde\"ˆÂfg\"ˆÂhi\"ˆÂjk\"ˆÂlm\"ˆÂno\"ˆËpq\"ˆÂrs\"ˆÂtu\"ˆÂvw\"ˆÂxy\"ˆÂz{\"ˆË|}\"ˆÂ~\"ˆÂ€\"ˆÂ‚ƒ\"ˆÂ„…\"ˆÂ†‡\"ˆÂˆ‰\"ˆÂŠ‹\"ˆËŒ\"ˆËŽ\"ˆÂ‘\"ˆÂ’“\"ˆÂ”•\"ˆË–—\"ˆÂ˜™\"ˆÂš›\"ˆÂœ\"ˆÂžŸ\"ˆÂ ¡\"ˆÂ¢£\"ˆÂ¤¥\"ˆÂ¦§\"ˆÂ¨©\"ˆÂª«\"ˆÂ¬­\"ˆÂ®¯\"ˆË°±\"ˆÂ²³\"ˆÂ´µ\"ˆÂ¶·\"ˆÂ¸¹\"ˆÂº»\"ˆË¼½\"ˆÂ¾¿\"ˆÂÀÁ\"ˆÂÂÃ\"ˆÄÅ!‡" [require disp-table standard-display-ascii 160 "{_}" 161 "{!}" 162 "{c}" 163 "{GBP}" standard-display-g1 164 36 165 "{JPY}" 166 "{|}" 167 "{S}" 168 "{\"}" 169 "{C}" 170 "{_a}" 171 "{<<}" 172 "{~}" 173 "{-}" 174 "{R}" 175 "{=}" 176 "{o}" 177 "{+-}" 178 "{2}" 179 "{3}" 180 "{'}" 181 "{u}" 182 "{P}" 183 "{.}" 184 "{,}" 185 "{1}" 186 "{_o}" 187 "{>>}" 188 "{1/4}" 189 "{1/2}" 190 "{3/4}" 191 "{?}" 192 "{`A}" 193 "{'A}" 194 "{^A}" 195 "{~A}" 196 91 197 93 198 "{AE}" 199 "{,C}" 200 "{`E}" 201 64 202 "{^E}" 203 "{\"E}" 204 "{`I}" 205 "{'I}" 206 "{^I}" 207 "{\"I}" 208 "{-D}" 209 "{~N}" 210 "{`O}" 211 "{'O}" 212 "{^O}" 213 "{~O}" 214 92 215 "{x}" 216 "{/O}" 217 "{`U}" 218 "{'U}" 219 "{^U}" 220 94 221 "{'Y}" 222 "{TH}" 223 "{ss}" 224 "{`a}" 225 "{'a}" 226 "{^a}" 227 "{~a}" 228 123 229 125 230 "{ae}" 231 "{,c}" 232 "{`e}" 233 96 234 "{^e}" 235 "{\"e}" 236 "{`i}" 237 "{'i}" 238 "{^i}" 239 "{\"i}" 240 "{-d}" 241 "{~n}" 242 "{`o}" 243 "{'o}" 244 "{^o}" 245 "{~o}" 246 124 247 "{/}" 248 "{/o}" 249 "{`u}" 250 "{'u}" 251 "{^u}" 252 126 253 "{'y}" 254 "{th}" 255 "{\"y}" provide iso-swed] 3) emacs-19.30/lisp/iso-syntax.elc100666 13437 1 2761 6043466042 15026 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:55:49 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/iso-syntax.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`iso-syntax.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂ ÄÅÆ #ˆÄÇÈ #ˆÄÉÊ #ˆÄËÊ #ˆÄÌÊ #ˆÄÍÊ #ˆÄÎÏ #ˆÄÐÊ #ˆÄÑÊ #ˆÄÒÏ #ˆÄÓÊ #ˆÔÕÖ #ˆÄ×Ï #ˆÄØÏ #ˆÄÙÏ #ˆÄÚÊ #ˆÄÛÏ #ˆÄÜÏ #ˆÄÝÊ #ˆÄÞÊ #ˆÄßÊ #ˆÄàÏ #ˆÄáÊ #ˆÄâÏ #ˆÄãÊ #ˆÄäÊ #ˆÄåÊ #ˆÄæÏ #ˆÄçÏ #ˆÄèÏ #ˆÄéÈ #ˆêëì #ˆêíî #ˆêïð #ˆêñò #ˆêóô #ˆêõö #ˆê÷ø #ˆêùú #ˆêûü #ˆêýþ #ˆêÿ@ #ˆêAB #ˆêCD #ˆêEF #ˆêGH #ˆêIJ #ˆêKL #ˆêMN #ˆêOP #ˆêQR #ˆêST #ˆêUV #ˆêWX #ˆÄYÏ #ˆêZ[ #ˆê\\] #ˆê^_ #ˆê`a #ˆêbc #ˆêde #ˆêfg #ˆÄhÊ #ˆÄiÏ #ˆÄjÊ #ˆ)kl!‡" [require case-table standard-case-table downcase set-case-syntax 160 " " 161 "." 162 "w" 163 164 165 166 "_" 167 168 169 170 set-case-syntax-delims 171 187 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 188 189 190 191 set-case-syntax-pair 192 224 193 225 194 226 195 227 196 228 197 229 198 230 199 231 200 232 201 233 202 234 203 235 204 236 205 237 206 238 207 239 208 240 209 241 210 242 211 243 212 244 213 245 214 246 215 216 248 217 249 218 250 219 251 220 252 221 253 222 254 223 247 255 provide iso-syntax] 4) emacs-19.30/lisp/iso-transl.elc100666 12120 1 11207 6043466055 14666 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:56:03 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/iso-transl.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`iso-transl.el' was compiled for Emacs 19.29 or later")) #@70 Mapping of ASCII characters to their corresponding dead-key symbols. (defvar iso-transl-dead-key-alist (quote ((39 . mute-acute) (96 . mute-grave) (34 . mute-diaeresis) (67108896 . mute-asciicircum) (126 . mute-asciitilde))) (#$ . 487)) (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#‡" [key-translation-map make-sparse-keymap define-key [dead-acute] [mute-acute] [dead-grave] [mute-grave] [dead-diaeresis] [mute-diaeresis] [dead-asciicircum] [mute-asciicircum] [dead-asciitilde] [mute-asciitilde] [S-dead-acute] [mute-acute] [S-dead-grave] [mute-grave] [S-dead-diaeresis] [mute-diaeresis] [S-dead-asciicircum] [mute-asciicircum] [S-dead-asciitilde] [mute-asciitilde]] 4) #@221 Alist of character translations for entering ISO characters. Each element has the form (STRING . VECTOR). The sequence STRING of ASCII chars translates into the sequence VECTOR. (VECTOR is normally one character long.) (defvar iso-transl-char-map (quote (("* " . [160]) (" " . [160]) ("*!" . [161]) ("!" . [161]) ("\"\"" . [168]) ("\"A" . [196]) ("\"E" . [203]) ("\"I" . [207]) ("\"O" . [214]) ("\"U" . [220]) ("\"a" . [228]) ("\"e" . [235]) ("\"i" . [239]) ("\"o" . [246]) ("\"s" . [223]) ("\"u" . [252]) ("\"y" . [255]) ("''" . [180]) ("'A" . [193]) ("'E" . [201]) ("'I" . [205]) ("'O" . [211]) ("'U" . [218]) ("'Y" . [221]) ("'a" . [225]) ("'e" . [233]) ("'i" . [237]) ("'o" . [243]) ("'u" . [250]) ("'y" . [253]) ("*$" . [164]) ("$" . [164]) ("*+" . [177]) ("+" . [177]) (",," . [184]) (",C" . [199]) (",c" . [231]) ("*-" . [173]) ("-" . [173]) ("*." . [183]) ("." . [183]) ("//" . [247]) ("/A" . [197]) ("/E" . [198]) ("/O" . [216]) ("/a" . [229]) ("/e" . [230]) ("/o" . [248]) ("1/2" . [189]) ("1/4" . [188]) ("3/4" . [190]) ("*<" . [171]) ("<" . [171]) ("*=" . [175]) ("=" . [175]) ("*>" . [187]) (">" . [187]) ("*?" . [191]) ("?" . [191]) ("*C" . [169]) ("C" . [169]) ("*L" . [163]) ("L" . [163]) ("*P" . [182]) ("P" . [182]) ("*R" . [174]) ("R" . [174]) ("*S" . [167]) ("S" . [167]) ("*Y" . [165]) ("Y" . [165]) ("^1" . [185]) ("^2" . [178]) ("^3" . [179]) ("^A" . [194]) ("^E" . [202]) ("^I" . [206]) ("^O" . [212]) ("^U" . [219]) ("^a" . [226]) ("^e" . [234]) ("^i" . [238]) ("^o" . [244]) ("^u" . [251]) ("_a" . [170]) ("_o" . [186]) ("`A" . [192]) ("`E" . [200]) ("`I" . [204]) ("`O" . [210]) ("`U" . [217]) ("`a" . [224]) ("`e" . [232]) ("`i" . [236]) ("`o" . [242]) ("`u" . [249]) ("*c" . [162]) ("c" . [162]) ("*o" . [176]) ("o" . [176]) ("*u" . [181]) ("u" . [181]) ("*m" . [181]) ("m" . [181]) ("*x" . [215]) ("x" . [215]) ("*|" . [166]) ("|" . [166]) ("~A" . [195]) ("~D" . [208]) ("~N" . [209]) ("~O" . [213]) ("~T" . [222]) ("~a" . [227]) ("~d" . [240]) ("~n" . [241]) ("~o" . [245]) ("~t" . [254]) ("~~" . [172]))) (#$ . 1197)) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp iso-transl-language-alist (("Esperanto" ("C" . [198]) ("G" . [216]) ("H" . [166]) ("J" . [172]) ("S" . [222]) ("U" . [221]) ("c" . [230]) ("g" . [248]) ("h" . [182]) ("j" . [188]) ("s" . [254]) ("u" . [253])) ("French" ("C" . [199]) ("c" . [231])) ("German" ("A" . [196]) ("O" . [214]) ("U" . [220]) ("a" . [228]) ("o" . [246]) ("s" . [223]) ("u" . [252])) ("Portuguese" ("C" . [199]) ("c" . [231])) ("Spanish" ("!" . [161]) ("?" . [191]) ("N" . [241]) ("n" . [209]))) current-load-list] 2) #@26 Keymap for C-x 8 prefix. (defvar iso-transl-ctl-x-8-map nil (#$ . 3781)) (byte-code "„Á \n„Á Ã\nÄ#‡" [iso-transl-ctl-x-8-map make-sparse-keymap key-translation-map define-key "8"] 4) (defalias 'iso-transl-define-keys #[(alist) "…qÁ\n@@@A#ˆÃ@@!@@ÄH ž‰ÄÈÄHÉ\"IˆÁ\n@A#ˆÁ ÌÄH!Í#ˆƒhÎ!‰ÄAIˆÁ ÌÄH!Í#ˆÁ\n@A#ˆ)*A‰„͇" [alist define-key iso-transl-ctl-x-8-map vconcat 0 iso-transl-dead-key-alist deadpair vec logior 4194304 key-translation-map isearch-mode-map vector nil copy-sequence deadvec] 6]) (defalias 'iso-transl-set-language #[(lang) "ÀÁ\n \"A!‡" [iso-transl-define-keys assoc lang iso-transl-language-alist] 4 nil (list (let ((completion-ignore-case t)) (completing-read "Set which language? " iso-transl-language-alist nil t)))]) (byte-code "À !ˆÂ ÄÅ#ˆÂ ÆÇ#ˆÂ ÈÅ#ˆÉÊ!‡" [iso-transl-define-keys iso-transl-char-map define-key isearch-mode-map "" nil [24 t] isearch-other-control-char "8" provide iso-transl] 4) emacs-19.30/lisp/ispell.elc100666 13437 1 127152 6045213765 14246 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:21:46 1995 ;;; from file /home/fsf/rms/e19/lisp/ispell.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`ispell.el' was compiled for Emacs 19.29 or later")) #@42 *Highlight spelling errors when non-nil. (defvar ispell-highlight-p t (#$ . -472)) #@316 *The face used for Ispell highlighting. For Emacses with overlays. Possible values are `highlight', `modeline', `secondary-selection', `region', and `underline'. This variable can be set by the user to whatever face they desire. It's most convenient if the cursor color and highlight color are slightly different. (defvar ispell-highlight-face (quote highlight) (#$ . -562)) #@45 *Spelling of comments checked when non-nil. (defvar ispell-check-comments nil (#$ . -944)) #@108 *Corrections made throughout region when non-nil. Uses `query-replace' (\[query-replace]) for corrections. (defvar ispell-query-replace-choices nil (#$ . -1042)) #@361 *Does not spell check `tib' bibliography references when non-nil. Skips any text between strings matching regular expressions `ispell-tib-ref-beginning' and `ispell-tib-ref-end'. TeX users beware: Any field starting with [. will skip until a .] -- even your whole buffer -- unless you set `ispell-skip-tib' to nil. That includes a [.5mm] type of number.... (defvar ispell-skip-tib nil (#$ . -1211)) #@51 Regexp matching the beginning of a Tib reference. (defvar ispell-tib-ref-beginning "[[<]\\." (#$ . 1619)) #@45 Regexp matching the end of a Tib reference. (defvar ispell-tib-ref-end "\\.[]>]" (#$ . 1731)) #@105 *When not nil, the `*Choices*' window remains for spelling session. This minimizes redisplay thrashing. (defvar ispell-keep-choices-win t (#$ . -1832)) #@93 *The default size of the `*Choices*' window, including status line. Must be greater than 1. (defvar ispell-choices-win-default-height 2 (#$ . -1990)) #@66 Program invoked by \[ispell-word] and \[ispell-region] commands. (defvar ispell-program-name "ispell" (#$ . 2146)) #@42 *Alternate dictionary for spelling help. (defvar ispell-alternate-dictionary (byte-code "ÀÁ!ƒÁ‡ÀÂ!ƒ‡ÀÃ!ƒÇÀÄ!ƒ ćÀÅ!ƒ(ŇÀÆ!ƒ0ƇÇ" [file-exists-p "/usr/dict/web2" "/usr/share/dict/web2" "/usr/dict/words" "/usr/lib/dict/words" "/usr/share/dict/words" "/sys/dict"] 2) (#$ . -2267)) #@39 *Dictionary used for word completion. (defvar ispell-complete-word-dict ispell-alternate-dictionary (#$ . -2563)) #@48 Name of the grep command for search processes. (defvar ispell-grep-command "egrep" (#$ . 2683)) #@159 String of options to use when running the program in `ispell-grep-command'. Should probably be "-i" or "-e". Some machines (like the NeXT) don't support "-i" (defvar ispell-grep-options "-i" (#$ . 2786)) #@84 Name of the look command for search processes. This must be an absolute file name. (defvar ispell-look-command "look" (#$ . 2996)) #@105 *Non-nil means use `look' rather than `grep'. Default is based on whether `look' seems to be available. (defvar ispell-look-p (file-exists-p ispell-look-command) (#$ . -3134)) #@66 *Non-nil means use the `-r' option (regexp) when running `look'. (defvar ispell-have-new-look nil (#$ . -3316)) #@54 String of command options for `ispell-look-command'. (defvar ispell-look-options (byte-code "ƒÁ‡Â‡" [ispell-have-new-look "-dfr" "-df"] 1) (#$ . 3434)) #@87 When non-nil, Emacs uses ptys to communicate with Ispell. When nil, Emacs uses pipes. (defvar ispell-use-ptys-p nil (#$ . 3595)) #@120 *Non-nil means `ispell-word' checks the word around or after point. Otherwise `ispell-word' checks the preceding word. (defvar ispell-following-word nil (#$ . -3731)) #@91 *Non-nil means display interactive keymap help in a buffer. Otherwise use the minibuffer. (defvar ispell-help-in-bufferp nil (#$ . -3904)) #@52 *Non-nil means suppress messages in `ispell-word'. (defvar ispell-quietly nil (#$ . -4049)) #@127 *Formatting function for displaying word being spell checked. The function must take one string argument and return a string. (defvar ispell-format-word (quote upcase) (#$ . -4148)) #@184 *File name of your personal spelling dictionary, or nil. If nil, the default personal dictionary, "~/.ispell_DICTNAME" is used, where DICTNAME is the name of your default dictionary. (defvar ispell-personal-dictionary nil (#$ . -4337)) #@67 *When non-nil, save the personal dictionary without confirmation. (defvar ispell-silently-savep nil (#$ . -4579)) #@433 If non-nil, a dictionary to use instead of the default one. This is passed to the ispell process using the `-d' switch and is used as key in `ispell-dictionary-alist' (which see). You should set this variable before your first use of Emacs spell-checking commands in the Emacs session, or else use the \[ispell-change-dictionary] command to change it. Otherwise, this variable only takes effect in a newly started Ispell process. (defvar ispell-dictionary nil (#$ . 4700)) #@241 *If non-nil, a list of extra switches to pass to the Ispell program. For example, '("-W" "3") to cause it to accept all 1-3 character words as correct. See also `ispell-dictionary-alist', which may be used for language-specific arguments. (defvar ispell-extra-args nil (#$ . -5182)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀ‡" [boundp ispell-dictionary-alist-1 ((nil "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil) ("english" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil) ("british" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B" "-d" "british") nil) ("deutsch" "[a-zA-Z\"]" "[^a-zA-Z\"]" "[']" t ("-C") "~tex") ("deutsch8" "[a-zA-ZÄÖÜäößü]" "[^a-zA-ZÄÖÜäößü]" "[']" t ("-C" "-d" "deutsch") "~latin1") ("nederlands" "[A-Za-zÀ-ÅÇÈ-ÏÒ-ÖÙ-Üà-åçè-ïñò-öù-ü]" "[^A-Za-zÀ-ÅÇÈ-ÏÒ-ÖÙ-Üà-åçè-ïñò-öù-ü]" "[']" t ("-C") nil) ("nederlands8" "[A-Za-zÀ-ÅÇÈ-ÏÒ-ÖÙ-Üà-åçè-ïñò-öù-ü]" "[^A-Za-zÀ-ÅÇÈ-ÏÒ-ÖÙ-Üà-åçè-ïñò-öù-ü]" "[']" t ("-C") nil)) current-load-list ispell-dictionary-alist-2 (("svenska" "[A-Za-z}{|\\133\\135\\\\]" "[^A-Za-z}{|\\133\\135\\\\]" "[']" nil ("-C") nil) ("svenska8" "[A-Za-zåäöÅÄö]" "[^A-Za-zåäöÅÄö]" "[']" nil ("-C" "-d" "svenska") "~list") ("francais7" "[A-Za-z]" "[^A-Za-z]" "[`'^---]" t nil nil) ("francais" "[A-Za-zÀÂÆÇÈÉÊËÎÏÔÙÛÜàâçèéêëîïôùûü]" "[^A-Za-zÀÂÆÇÈÉÊËÎÏÔÙÛÜàâçèéêëîïôùûü]" "[---']" t nil "~list") ("francais-tex" "[A-Za-zÀÂÆÇÈÉÊËÎÏÔÙÛÜàâçèéêëîïôùûü\\]" "[^A-Za-zÀÂÆÇÈÉÊËÎÏÔÙÛÜàâçèéêëîïôùûü\\]" "[---'^`\"]" t nil "~tex") ("dansk" "[A-ZÆØÅa-zæøå]" "[^A-ZÆØÅa-zæøå]" "" nil ("-C") nil))] 2) #@1661 An alist of dictionaries and their associated parameters. Each element of this list is also a list: (DICTIONARY-NAME CASECHARS NOT-CASECHARS OTHERCHARS MANY-OTHERCHARS-P ISPELL-ARGS EXTENDED-CHARACTER-MODE) DICTIONARY-NAME is a possible value of variable `ispell-dictionary', nil means the default dictionary. CASECHARS is a regular expression of valid characters that comprise a word. NOT-CASECHARS is the opposite regexp of CASECHARS. OTHERCHARS is a regular expression of other characters that are valid in word constructs. Otherchars cannot be adjacent to each other in a word, nor can they begin or end a word. This implies we can't check "Stevens'" as a correct possessive and other correct formations. Hint: regexp syntax requires the hyphen to be declared first here. MANY-OTHERCHARS-P is non-nil if many otherchars are to be allowed in a word instead of only one. ISPELL-ARGS is a list of additional arguments passed to the ispell subprocess. EXTENDED-CHARACTER-MODE should be used when dictionaries are used which have been configured in an Ispell affix file. (For example, umlauts can be encoded as \"a, a\", "a, ...) Defaults are ~tex and ~nroff in English. This has the same effect as the command-line `-T' option. The buffer Major Mode controls Ispell's parsing in tex or nroff mode, but the dictionary can control the extended character mode. Both defaults can be overruled in a buffer-local fashion. See `ispell-parsing-keyword' for details on this. Note that the CASECHARS and OTHERCHARS slots of the alist should contain the same character set as casechars and otherchars in the language.aff file (e.g., english.aff). (defvar ispell-dictionary-alist (append ispell-dictionary-alist-1 ispell-dictionary-alist-2) (#$ . 6687)) #@25 Key map for ispell menu (defvar ispell-menu-map nil (#$ . 8459)) #@32 Spelling menu for Lucid Emacs. (defvar ispell-menu-lucid nil (#$ . 8530)) (byte-code "?…\nÁ \"?Ä B\fƒWÆÇÈB B!È\n ÌÍ! ƒV @@\n A \n;ƒ$ÎÏÐ\n!!ÑÒ\n!PÓÈÔÕ\nDFB#ˆ‚$*\fƒyÎÖ×#ˆÎØÙ#ˆÎÚÛ#ˆÎÜÝ#ˆÎÞß#ˆ\fƒ•Îàá#ˆÎâã#ˆÎäå#ˆÎæç#ˆ\fƒ°Îèé#ˆÎêë#ˆìíîï#ˆÀ‰JMˆð ™ƒÁ \"ƒÇÈB B1†Ê2óÈ\n41  ƒ @@\n A \n;ƒÔõ4ÏÑÒ\n!PÕ\nDö#C\"4‚Ô471ƒøù!ˆúûÍ7#ˆ,ȇ" [ispell-menu-map string-match "Lucid" emacs-version ispell-menu-map-needed current-load-list reverse "default" nil ispell-dictionary-alist name dicts make-sparse-keymap "Spell" define-key vector intern "Select " capitalize lambda (interactive) ispell-change-dictionary [ispell-change-dictionary] ("Change Dictionary" . ispell-change-dictionary) [ispell-kill-ispell] ("Kill Process" . ispell-kill-ispell) [ispell-pdict-save] ("Save Dictionary" lambda nil (interactive) (ispell-pdict-save t t)) [ispell-complete-word] ("Complete Word" . ispell-complete-word) [ispell-complete-word-interior-frag] ("Complete Word Frag" . ispell-complete-word-interior-frag) [ispell-continue] ("Continue Check" . ispell-continue) [ispell-word] ("Check Word" . ispell-word) [ispell-region] ("Check Region" . ispell-region) [ispell-buffer] ("Check Buffer" . ispell-buffer) [ispell-message] ("Check Message" . ispell-message) [ispell-help] ("Help" lambda nil (interactive) (describe-function (quote ispell-help))) put ispell-region menu-enable mark-active "19" current-menubar default-menubar (["Help" (describe-function (quote ispell-help)) t] ["Check Message" ispell-message t] ["Check Buffer" ispell-buffer t] ["Check Word" ispell-word t] ["Check Region" ispell-region (or (not zmacs-regions) (mark))] ["Continue Check" ispell-continue t] ["Complete Word Frag" ispell-complete-word-interior-frag t] ["Complete Word" ispell-complete-word t] ["Kill Process" ispell-kill-ispell t] "-" ["Save Dictionary" (ispell-pdict-save t t) t] ["Change Dictionary" ispell-change-dictionary t]) menu append t ispell-menu-lucid delete-menu-item ("Edit" "Spell") add-menu ("Edit")] 9) #@72 Ispell versions with which this version of ispell.el is known to work. (defconst ispell-required-version (quote ("3.1." 12)) (#$ . 10568)) #@68 Offset that maps protocol differences between ispell 3.1 versions. (defvar ispell-offset 1 (#$ . 10713)) (defalias 'ispell-get-casechars #[nil "À \n\"A@‡" [assoc ispell-dictionary ispell-dictionary-alist] 3]) (defalias 'ispell-get-not-casechars #[nil "ÀÁ\n \"8‡" [2 assoc ispell-dictionary ispell-dictionary-alist] 4]) (defalias 'ispell-get-otherchars #[nil "ÀÁ\n \"8‡" [3 assoc ispell-dictionary ispell-dictionary-alist] 4]) (defalias 'ispell-get-many-otherchars-p #[nil "ÀÁ\n \"8‡" [4 assoc ispell-dictionary ispell-dictionary-alist] 4]) (defalias 'ispell-get-ispell-args #[nil "ÀÁ\n \"8‡" [5 assoc ispell-dictionary ispell-dictionary-alist] 4]) (defalias 'ispell-get-extended-character-mode #[nil "ÀÁ\n \"8‡" [6 assoc ispell-dictionary ispell-dictionary-alist] 4]) #@32 The process object for Ispell. (defvar ispell-process nil (#$ . 11487)) #@66 Non-nil means personal dictionary has modifications to be saved. (defvar ispell-pdict-modified-p nil (#$ . 11565)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp ispell-quit nil current-load-list] 2) #@43 Output filter from piped calls to Ispell. (defvar ispell-filter nil (#$ . 11760)) #@46 Control variable for Ispell filter function. (defvar ispell-filter-continue nil (#$ . 11848)) #@51 The directory where `ispell-process' was started. (defvar ispell-process-directory nil (#$ . 11948)) #@40 Marker for `query-replace' processing. (defvar ispell-query-replace-marker (make-marker) (#$ . 12055)) #@44 Non-nil when we're checking a mail message (defvar ispell-checking-message nil (#$ . 12164)) (byte-code "ÀÁ\nBÁ‡" ["*Choices*" ispell-choices-buffer current-load-list] 2) #@43 Overlay variable for Ispell highlighting. (defvar ispell-overlay nil (#$ . 12343)) #@453 If non-nil, a dictionary to use for Ispell commands in this buffer. The value must be a string dictionary name in `ispell-dictionary-alist'. This variable becomes buffer-local when set in any fashion. Setting ispell-local-dictionary to a value has the same effect as calling \[ispell-change-dictionary] with that value. This variable is automatically set when defined in the file with either `ispell-dictionary-keyword' or the Local Variable syntax. (defvar ispell-local-dictionary nil (#$ . 12433)) (byte-code "ÀÁ!ˆÂÁÃ\"‡" [make-variable-buffer-local ispell-local-dictionary set-default nil] 3) #@175 The keyword for local oddly-spelled words to accept. The keyword will be followed by any number of local word spellings. There can be multiple of these keywords in the file. (defconst ispell-words-keyword "LocalWords: " (#$ . 13038)) #@197 The keyword for local dictionary definitions. There should be only one dictionary keyword definition per file, and it should be followed by a correct dictionary name in `ispell-dictionary-alist'. (defconst ispell-dictionary-keyword "Local IspellDict: " (#$ . 13279)) #@419 The keyword for overriding default Ispell parsing. Determined by the buffer's major mode and extended-character mode as well as the default dictionary. The above keyword string should be followed by `latex-mode' or `nroff-mode' to put the current buffer into the desired parsing mode. Extended character mode can be changed for this buffer by placing a `~' followed by an extended-character mode -- such as `~.tex'. (defconst ispell-parsing-keyword "Local IspellParsing: " (#$ . 13553)) #@135 Skips spell checking of SGML tags and entity references when non-nil. This variable is set when major-mode is sgml-mode or html-mode. (defvar ispell-skip-sgml nil (#$ . 14049)) #@437 A buffer local variable containing the current personal dictionary. If non-nil, the value must be a string, which is a file name. If you specify a personal dictionary for the current buffer which is different from the current personal dictionary, the effect is similar to calling \[ispell-change-dictionary]. This variable is automatically set when defined in the file with either `ispell-pdict-keyword' or the local variable syntax. (defvar ispell-local-pdict ispell-personal-dictionary (#$ . 14233)) (make-variable-buffer-local (quote ispell-local-pdict)) #@53 The keyword for defining buffer local dictionaries. (defconst ispell-pdict-keyword "Local IspellPersDict: " (#$ . 14799)) #@128 Contains the buffer name if local word definitions were used. Ispell is then restarted because the local words could conflict. (defvar ispell-buffer-local-name nil (#$ . 14928)) #@357 *Indicates whether ispell should parse the current buffer as TeX Code. Special value `use-mode-name' tries to guess using the name of major-mode. Default parser is 'nroff. Currently the only other valid parser is 'tex. You can set this variable in hooks in your init file -- eg: (add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex)))) (defvar ispell-parser (quote use-mode-name) (#$ . -15113)) #@44 Marker that allows spelling continuations. (defvar ispell-region-end (make-marker) (#$ . 15534)) #@61 If non-nil, `ispell-word' does not try to correct the word. (defvar ispell-check-only nil (#$ . 15637)) (byte-code "À ™ƒÂÃ!„ÄÅÆ\"ˆÇÉÊ#‡" ["19" emacs-version boundp epoch::version defalias ispell ispell-buffer define-key global-map "¤" ispell-word] 4) #@812 Check spelling of word under or before the cursor. If the word is not found in dictionary, display possible corrections in a window allowing you to choose one. With a prefix argument (or if CONTINUE is non-nil), resume interrupted spell-checking of a buffer or region. If optional argument FOLLOWING is non-nil or if `ispell-following-word' is non-nil when called interactively, then the following word (rather than preceding) is checked when the cursor is not over a word. When the optional argument QUIETLY is non-nil or `ispell-quietly' is non-nil when called interactively, non-corrective messages are suppressed. Word syntax described by `ispell-dictionary-alist' (which see). This will check or reload the dictionary. Use \[ispell-change-dictionary] or \[ispell-region] to update the Ispell process. (defalias 'ispell-word #[(&optional following quietly continue) "ƒÁ ‡tƒ\n\fÆ ˆ`Ç !ȉ‰‰ \n \f  A@\f AA@  @ „EÏÐ !\"ˆÒÔ\"ˆÒÕ ÖQ\"ˆ×!ˆ@Ù˜ƒUA‰<ƒsÚ@!\n\nÛ=ƒŠ „ÏÜ !\"ˆ‚\n;ƒ¥ „ÏÝ !\n!#ˆ‚\n„±ÏÞ!ˆ‚ƒ¼à ˆ‚ወ ⚃Ïã\n@!ˆ‚ ƒ :„ß ‚â @‰ G \fZZ\\ \n@š„\f |ˆ cˆ :ƒbˆä \"ˆå&!ƒç&!ˆbˆè)!ˆ*…1ȉ*.‡" [continue ispell-continue ispell-following-word following ispell-quietly quietly ispell-accept-buffer-local-defs ispell-get-word nil replace poss end start word cursor-location message "Checking spelling of %s..." ispell-format-word process-send-string ispell-process "%\n" "^" "\n" accept-process-output ispell-filter "" ispell-parse-output t "%s is correct" "%s is correct because of root %s" "Error in ispell process" ispell-check-only beep ((byte-code "À AA@ AAA@ @\n %À‡" [ispell-command-loop poss start end replace] 6)) 0 ispell-add-per-file-word-list ispell-word get-buffer ispell-choices-buffer kill-buffer ispell-pdict-save ispell-silently-savep ispell-quit] 7 (#$ . 15901) (list nil nil current-prefix-arg)]) #@420 Return the word for spell-checking according to ispell syntax. If optional argument FOLLOWING is non-nil or if `ispell-following-word' is non-nil when called interactively, then the following word (rather than preceding) is checked when the cursor is not over a word. Optional second argument contains otherchars that can be included in word many times. Word syntax described by `ispell-dictionary-alist' (which see). (defalias 'ispell-get-word #[(following &optional extra-otherchars) "À  Ä Æ  È É\n…\nÉP Ë„&\nƒ*Ì‚+É° ÎÎÎÎÓ !„UƒOÕ dÖ#ˆ‚U× eÖ#ˆ× eÐ#ˆÓ !„m\nƒ·Ó\n!ƒ·o„·ƒ{ƒ·\nƒšÓ\n!ƒšØÙ!ˆÓ !ƒ[× eÚ#ˆ‚[ÖØÙ!ˆÓ !ƒ°× eÚ#ˆ‚[ØÛ!ˆ‚[Õ dÖ#„ÄÜÝ!ˆÞ”`{‰E. ‡" [ispell-get-casechars ispell-casechars ispell-get-not-casechars ispell-not-casechars ispell-get-otherchars ispell-otherchars ispell-get-many-otherchars-p ispell-many-otherchars-p "+\\(" "?" extra-otherchars "+\\)" "*" word-regexp nil did-it-once start end word looking-at following re-search-forward t re-search-backward backward-char 1 move -1 error "No word found to check!" 0] 9 (#$ . 17834)]) #@96 Check to see if the personal dictionary has been modified. If so, ask if it needs to be saved. (defalias 'ispell-pdict-save #[(&optional no-query force-save) "ƒ\f<ƒ\f@„ ƒ(\n„ÃÄ!ƒ(ÅÇ\"ˆÈÉ!ˆÊ‰‡" [ispell-pdict-modified-p force-save no-query y-or-n-p "Personal dictionary modified. Save? " process-send-string ispell-process "#\n" message "Personal dictionary saved." nil] 3 (#$ . 18953) (list ispell-silently-savep t)]) #@496 Display possible corrections from list MISS. GUESS lists possibly valid affix construction of WORD. Returns nil to keep word. Returns 0 to insert locally into buffer-local dictionary. Returns string for new chosen word. Returns list for new replacement word (will be rechecked). Highlights the word, which is assumed to run from START to END. Global `ispell-pdict-modified-p' becomes a list where the only value indicates whether the dictionary has been modified when option `a' or `i' is used. (defalias 'ispell-command-loop #[(miss guess word start end) "pÀÁ ÃZ\f ^ÇÈɉ‰‰‰\n \f ŠÖ!qˆØPÛ ˆƒ…ÝÞ±ˆƒqi@GÃ\\\\ß VƒaàcˆT@᱈A‰„Kâ㱈ƒä‚‚Á\\ƒæi@GåVƒšä‚›Èæ\\\\\\ß Vƒ±çcˆT‰‚³Wƒæ>ƒÎTT‚¹èé@걈AT‚…ZÀZ)ë,!„ûíÈ!ˆî!‰/ƒdÂ/!Uƒð/!ˆ‚lÂ/!Zñyˆ`23Wƒ83Z\\3ôÈ!ˆ3yˆõö `2VƒO2‚P`\"ˆ,bˆð÷ !ˆø3!ˆ*‚lù]!ˆú!ˆebˆ)ðû ‰ !ˆüŽ=ƒŽþ?,@#ˆA ˆBCDP!ˆ@EFG!ƒµG ‚¹H ÈI„ÊæUƒÒJÉI)‰KƒúK@ÀVƒñK@WƒñTKA‰K„ÛZÀZ )LUƒÉ‚MUƒ1NOPçQ\"ˆQRÉ‚SU„CTUƒhNOUçQ\"ˆR„[RCRTU…È‚VU„zWUƒ¦WU„ˆXƒ˜YZ\"@D‚Y[\"ÉB‚\\U„À]U„À^UƒË_ ˆ@‚`Uƒìab!ˆBc!ˆ@dÉ‚JUƒab!ˆBefgP!!ˆe`GZ]dÉ‚hUƒJij!ƒDk@!ˆl?†;`dɉR‚@‚mUƒfYn\"Áo‰pƒ_ŠÖ!qˆÛ ˆÀÈØpPqp!‰ƒæi@GåVƒšä‚›Èæ\\\\\\ß Vƒ±çcˆoT‰o‚³oWƒæ>ƒÎTT‚¹èé@걈AT‚…ZÀZ)ð÷ !ˆoU„Zo]VƒZrrWƒrZ‚ÈsorWƒ/roZ‚0ÈtoVƒHøoZsZ!ˆ‚UuoZtZ!ˆo+ðû !ˆ*@‚vUƒ‡NOP—çQ\"ˆwRÉ‚xUƒ±NOPYy\"çQ\"ˆzRÉB‚ ÈYƒ× Wƒ×XƒÐ \f8{D‚ \f8‚|Uƒë} ˆ@‚~Uƒÿ‹ˆ@‚€Uƒ‚! ˆ@‚ƒ ˆ@‰\f@=„Ž\f.‡" [48 2 window-height 4 miss window-min-height ispell-choices-win-default-height (32 105 97 65 114 82 63 120 88 113 108 117 109) 0 nil highlighted textwin result num char skipped command-characters choices max-lines line count textbuf get-buffer-create ispell-choices-buffer "-- %b -- word: " word mode-line-format erase-buffer guess "Affix rules generate and capitalize " "this word as shown below:\n " window-width "\n " " " "\nUse option `i' if this is a correct composition" " from the derivative root.\n" 3 126 7 "\n" "(" ") " " " pos-visible-in-window-p end sit-for get-buffer-window choices-window select-window -1 visible window-line move-to-window-line set-window-start selected-window previous-window enlarge-window ispell-overlay-window switch-to-buffer next-window ((byte-code "ƒÁ‹ˆÂ‡" [ispell-highlight-p ((byte-code "À !ˆÂ \f\"‡" [select-window textwin ispell-highlight-spelling-error start end] 3)) nil] 1)) ispell-highlight-p ispell-highlight-spelling-error start t undo-boundary message "C-h or ? for more options; SPC to leave " "unchanged, Character to replace word" inhibit-quit fboundp read-char-exclusive read-char quit-flag 88 com-chars 32 105 process-send-string ispell-process "*" (t) ispell-pdict-modified-p 97 65 "@" 114 82 ispell-query-replace-choices read-string "Query-replacement for: " "Replacement for: " 63 help-char 8 ispell-help 120 ispell-pdict-save ispell-silently-savep "Exited spell-checking" ispell-quit substitute-command-keys "Spell-checking suspended;" " use C-u \\[ispell-word] to resume" 113 y-or-n-p "Really kill Ispell process? " ispell-kill-ispell ispell-checking-message 108 "Lookup string (`*' is wildcard): " new-line new-word lookup-words minh gr-bl shr-bl shrink-window 117 (t) 109 "Insert: " (t) query-replace 12 redraw-display 18 ((recursive-edit)) 26 key-binding "" ding] 14 (#$ . 19394)]) #@1038 Display a list of the options available when a misspelling is encountered. Selections are: DIGIT: Replace the word with a digit offered in the *Choices* buffer. SPC: Accept word this time. `i': Accept word and insert into private dictionary. `a': Accept word for this session. `A': Accept word and place in `buffer-local dictionary'. `r': Replace word with typed-in value. Rechecked. `R': Replace word with typed-in value. Query-replaced in buffer. Rechecked. `?': Show these commands. `x': Exit spelling buffer. Move cursor to original point. `X': Exit spelling buffer. Leaves cursor at the current point, and permits the aborted check to be completed later. `q': Quit spelling session (Kills ispell process). `l': Look up typed-in replacement in alternate dictionary. Wildcards okay. `u': Like `i', but the word is lower-cased first. `m': Like `i', but allows one to include dictionary completion information. `C-l': redraws screen `C-r': recursive edit `C-z': suspend emacs or iconify frame (defalias 'ispell-help #[nil "ÀÁPÂÃPÄÅPÉ‹+‡" ["[r/R]eplace word; [a/A]ccept for this session; " "[i]nsert into private dictionary" "[l]ook a word up in alternate dictionary; " "e[x/X]it; [q]uit session" "[u]ncapitalized insert into dictionary. " "Type 'C-h d ispell-help' for more help" help-3 help-2 help-1 ((byte-code "ƒ\"ÁÂ!ˆÃÄÅ!!ˆÇÇ °cˆÊË!ˆÌÅ!‡ÍÎ !ˆÏ ˆÐÑ\"ƒOÓ !ˆÔÕ!ˆÓ!ˆÔÕ!ˆÓ!ˆebˆ‚jÖ™ƒZÓ×!ˆÔØ!ˆÇÇ °cˆÊË!ˆÏ ‡" [ispell-help-in-bufferp ispell-overlay-window 4 switch-to-buffer get-buffer-create "*Ispell Help*" help-1 "\n" help-2 help-3 sit-for 5 kill-buffer select-window minibuffer-window erase-buffer string-match "Lucid" emacs-version message enlarge-window 1 "19" nil 2] 5))] 4 (#$ . 23170)]) #@332 Look up word in word-list dictionary. A `*' serves as a wild card. If no wild cards, `look' is used if it exists. Otherwise the variable `ispell-grep-command' contains the command used to search for the words (usually egrep). Optional second argument contains the dictionary to use; the default is `ispell-alternate-dictionary'. (defalias 'lookup-words #[(word &optional lookup-dict) "„ \nÄÅ\"… †?\nËÌ! \nƒ-‚/\nƒ;‚=ÔÔÔØŽÙ‹ˆ). ‡" [lookup-dict ispell-alternate-dictionary ispell-use-ptys-p process-connection-type string-match "\\*" word wild-p ispell-look-p ispell-have-new-look look-p get-buffer-create "*Ispell-Temp*" ispell-grep-buffer ispell-look-command ispell-grep-command prog ispell-look-options ispell-grep-options args nil status results loc ((byte-code "À !ˆ\nƒÃÄ\n@\"ƒÅÆ\n@#ˆÀ‡" [kill-buffer ispell-grep-buffer results string-match ".+: " error "%s error: %s" ispell-grep-command] 4)) ((byte-code "ÀÁ !\"ˆ\fqˆ „*ÆȱˆÉÊËÌ#ƒ#Ícˆ‚Î Ï ˆÐ ËÌË&‰;ƒNÔÕ !#B‚udbˆo„^h×U„^×cˆo„u`Ùyˆ`S{B‚^ˇ" [message "Starting \"%s\" process..." file-name-nondirectory prog ispell-grep-buffer look-p "^" word "$" search-backward "*" nil t "." buffer-string erase-buffer call-process args lookup-dict status format "error: %s exited with signal %s" results 10 loc -1] 9))] 3 (#$ . 24947)]) #@52 Output filter function for ispell, grep, and look. (defalias 'ispell-filter #[(process output) "ÀÁÂ\f…`ÆÇ # ƒ0\nƒ0\n<ƒ0\n‰@ OP ˆ‚: O\nB\n „GÁ ‰‚ T‰GUƒ[‰‚ ‚+‡" [0 t nil end continue start string-match "\n" output ispell-filter-continue ispell-filter] 6 (#$ . 26320)]) #@182 Highlight the word from START to END with a kludge using `inverse-video'. When the optional third arg HIGHLIGHT is set, the word is highlighted; otherwise it is displayed normally. (defalias 'ispell-highlight-spelling-error-generic #[(start end &optional highlight) "À Á\n {ĉ \n |ˆÊË \nZ\"ˆÌÍ!ˆƒ*?\n |ˆcˆÌÍ!ˆƒ@?Ð !-‡" [buffer-modified-p nil start end t buffer-undo-list inhibit-quit text buffer-read-only modified insert-char 32 sit-for 0 highlight inverse-video set-buffer-modified-p] 5 (#$ . 26637)]) #@172 Highlight the word from START to END using `isearch-highlight'. When the optional third arg HIGHLIGHT is set, the word is highlighted, otherwise it is displayed normally. (defalias 'ispell-highlight-spelling-error-lucid #[(start end &optional highlight) "ƒ Á\n \"‡ÄÅ!‡" [highlight isearch-highlight start end isearch-dehighlight t] 3 (#$ . 27173)]) #@240 Highlight the word from START to END using overlays. When the optional third arg HIGHLIGHT is set, the word is highlighted otherwise it is displayed normally. The variable `ispell-highlight-face' selects the face to use for highlighting. (defalias 'ispell-highlight-spelling-error-overlay #[(start end &optional highlight) "ƒÁ\n \"Å\fÆ#‡È\f!‡" [highlight make-overlay start end ispell-overlay overlay-put face ispell-highlight-face delete-overlay] 4 (#$ . 27531)]) (defalias 'ispell-highlight-spelling-error #[(start end &optional highlight) "ÀÁ\n\"ƒÃ\f #‡Ç\n™ƒ&ÈÉ!ƒ&\nƒ&Ë\f #‡Ì\f #‡" [string-match "Lucid" emacs-version ispell-highlight-spelling-error-lucid start end highlight "19" featurep faces window-system ispell-highlight-spelling-error-overlay ispell-highlight-spelling-error-generic] 4]) #@202 Create a window covering the top HEIGHT lines of the current window. Ensure that the line above point is still visible but otherwise avoid scrolling the current window. Leave the new window selected. (defalias 'ispell-overlay-window #[(height) "ŠŠÀyˆ`)ŠÁ\n!ˆ`)‰ Wƒ\fÅÆÇ \"ƒ#\nTÈÉ\n\"ˆÊË \"+‡" [-1 move-to-window-line height top oldot string-match "19.9.*Lucid" emacs-version split-window nil set-window-start next-window] 4 (#$ . 28355)]) #@445 Parse the OUTPUT string from Ispell and return: 1: t for an exact match. 2: A string containing the root word for a match via suffix removal. 3: A list of possible correct spellings of the format: '("ORIGINAL-WORD" OFFSET MISS-LIST GUESS-LIST) ORIGINAL-WORD is a string of the possibly misspelled word. OFFSET is an integer giving the line offset of the word. MISS-LIST and GUESS-LIST are possibly null lists of guesses and misses. (defalias 'ispell-parse-output #[(output) "Á˜ƒ‡؃‡Ęƒ‡ÅÆOǘƒ&ÈÉO‡ÅÆOÈÊËÈ#OÅɉ‰‰\f Å•ÉOÓ˜ƒXÅ‚gÔ!ÊËÆ#TÉOÔ!\fÓ˜ƒxÉ‚‚ÊËÆ#TÉOƒÅÊÕ\"T‰Vƒ¥ÅO B ‚¯ÅOBÆ•ƒ¹É‚ÁÈ\\ÉO)‚‚\f F.‡" [output "" t "*" "-" 0 1 "+" 2 nil string-match " " offset guess-list miss-list count cur-count original-word type "#" string-to-int ", \\|\\($\\)" end] 8 (#$ . 28810)]) (defalias 'check-ispell-version #[nil "ŠÀÁÂÆÇ!qˆÈ ˆÉ\nÂÀÂË%ebˆ Ì>„2ÍÎ\n ;ƒ.Ï‚/Ð $ˆÑÒÓ@!ÕQÂÀ#„MÍÖ\n@#ˆ‚`×ؔؕ{!@A@Wƒ`ÙÛp!,‡" [t fundamental-mode nil status default-major-mode case-fold-search get-buffer-create " *ispell-tmp*" erase-buffer call-process ispell-program-name "-v" (0 nil) error "%s exited with %s %s" "signal" "code" re-search-forward "\\b\\(" regexp-quote ispell-required-version "\\)\\([0-9]*\\)\\b" "%s version %s* is required: try renaming ispell4.el to ispell.el" read-from-string 2 0 ispell-offset kill-buffer] 6]) #@56 Check status of Ispell process and start if necessary. (defalias 'ispell-init-process #[nil "ƒÁ!Â=ƒ ƒ\f šƒÆƉ‡ÉÊ!ˆËÌ!ˆÍÎ!ˆÏ ˆÒÓÔÆÖ×ƃEÛ ƒXÜÝD\" ƒgÜÞß !D\"Ü \"‰)&)ÆÆ áÇ\"ˆâ!ˆ„”ãä\"ˆ‚Ñ@;ƒÀåæ@\"ƒ°âç\"ˆ@;‚´A?ƒÀåè@\"„Ñéê!ˆâ ˆãëìíî#\"ˆÆï ‰0ƒäñ0îP\"ˆ)ò!‡" [ispell-process process-status run ispell-personal-dictionary ispell-process-directory default-directory nil ispell-filter ispell-filter-continue ispell-kill-ispell t message "Starting new Ispell process..." sit-for 0 check-ispell-version ispell-use-ptys-p process-connection-type apply start-process "ispell" ispell-program-name "-a" "-m" args ispell-local-dictionary ispell-dictionary ispell-get-ispell-args append "-d" "-p" expand-file-name ispell-extra-args set-process-filter accept-process-output error "%s did not output version line" string-match "warning: " 5 "^@(#) " sleep-for 1 "%s" mapconcat identity "\n" ispell-get-extended-character-mode extended-char-mode process-send-string process-kill-without-query] 13 (#$ . 30243)]) #@133 Kill current Ispell process (so that you may start a fresh one). With NO-ERROR, just return non-nil if there was no Ispell running. (defalias 'ispell-kill-ispell #[(&optional no-error) "ƒ\fÁ!Â=„ †ÄÅ!‡Æ!ˆÇÈÉ!ˆÇ‡" [ispell-process process-status run no-error error "There is no ispell process running!" kill-process nil message "Ispell process killed"] 2 (#$ . 31328) nil]) #@234 Change `ispell-dictionary' (q.v.) and kill old Ispell process. A new one will be started as soon as necessary. By just answering RET you can find out what the current dictionary is. With prefix argument, set the default directory. (defalias 'ispell-change-dictionary #[(dict &optional arg) "ÁšƒÂÚƒÄņ†Á\"‡šƒ=ƒ0šƒ=t…–ÄȆ;Á\"‡É\n\"ƒ\\ „N„Q „a‚aÌÍ\"ˆÎÏ!ˆÄКƒsÂ} ƒ|Ñ‚}Òš„Š „‚‘†•Á#‡" [dict "default" nil "" message "Using %s dictionary" ispell-local-dictionary ispell-dictionary "No change, using %s dictionary" assoc ispell-dictionary-alist arg error "Illegal dictionary: %s" ispell-kill-ispell t "(Next %sIspell command will use %s dictionary)" "global " "local "] 5 (#$ . 31715) (list (completing-read "Use new dictionary (RET for current, SPC to complete): " (cons (cons "default" nil) ispell-dictionary-alist) nil t) current-prefix-arg)]) #@51 Interactively check a region for spelling errors. (defalias 'ispell-region #[(reg-start reg-end) "À ˆÁŽŠÂÃ\feUƒ dUƒÆ ‚dž É#ˆÊ‹ˆ *?‡" [ispell-accept-buffer-local-defs ((byte-code "À !ƒ\n !ˆ ƒ9 §„\fʼn“ˆ‚$\fÅ“ˆ bˆƒ4 §ƒ4ÅÈÉ!ˆÅ‚G\fʼn“ˆÊ !ˆÌÍ!ˆÅ‡" [get-buffer ispell-choices-buffer kill-buffer ispell-quit ispell-region-end nil reg-end ispell-checking-message error "Message send aborted." ispell-pdict-save ispell-silently-savep message "Spell-checking done"] 3)) message "Spell checking %s using %s dictionary..." reg-start reg-end buffer-name "region" ispell-dictionary "default" ((byte-code "bˆÁ‰\f„f` Wƒf`ÆŠÁˆ` ^)Ç Á \n \flƒ2Íuˆ‚¿„ƒÂÐ\nÑ#ƒÂ`\fZGUƒhÓ˜ƒ^Íyˆ‚¿Ð Ô#ˆ‚¿`GZ‰SbˆÕÖ!ƒ’\fSUƒG\\‚’S\fbˆ× Ñ#„©×ØÑ#ƒºÙ\f{ÚQ Z bˆ)‚¿ÕÜ!ƒÎÍuˆ‚¿ƒã×\nÑ#ƒã߉„÷ ƒ‘Ðá\nÑ#ƒ‘≃‘\nß=ƒ`ãZ\fU„\nâ=ƒR`ÍZ\fUƒR\nß=ƒ$×$ Ñ#ƒ2\nâ=ƒ¿Ðå Ñ#„¿æ'!ˆè ˆéê\nß=ƒFë‚GìíQ!ˆ`ãZ‚¿`\nß=ƒ]ã‚^ÍZ\fbˆ× Ñ#„x×ØÑ#ƒ‰Ù\f{ÚQ Z bˆ)‚¿× \nÑ#„¤×Ø\nÑ#ƒ¼Ù\f\n{ÚQ Z \nbˆ‚¿Íyˆ`\nƒ^Á.ï0\"ˆñ0!ˆ2@Ó˜ƒÑ2AŸ2\f„]2ƒ]ó2@!‰.<ƒU\f .A@\\\\‰4.@G\\5Á64bˆ÷ ˆ5bˆ÷ ˆ4bˆ÷ ˆ5Ð.@5Ñ#ˆ`U„@øùúP.@4#ˆû „IüÆ!ˆ=ƒgþ.AA@.AAA@.@45%6‚jÿ‹ˆ6ƒ×6<ƒ×Á245{6@G.@GZ@ @\\ @\\ )6@.@š„¬45|ˆ6@cˆ6A@A=„ÀB6@G!ˆ`\n6A@ƒ:CŽD‹ˆ)‚:6ƒã6Æšƒ 6ÆšƒóE.@ \"Fƒ:F<ƒ:F@FÁ24\n‚:6ƒ:45|ˆ6cˆ6G.@GZ@ @\\ @\\ \n@\\\n)\f„PéGH†JIJQ!ˆüÆ!ˆ+2A2‚ä)\nbˆ-‚*Á‡" [reg-start nil ref-type transient-mark-mode ispell-quit reg-end 0 ispell-get-casechars string ispell-casechars end offset-change start 1 ispell-check-comments comment-start search-forward t comment-end "" limit looking-at "\\\\" re-search-forward "[][()$]" "^" "\n" ispell-offset "[---#@*+!%~^]" ispell-skip-tib ispell-tib-ref-beginning tib ispell-skip-sgml "[<&]" sgml 2 ispell-tib-ref-end "[>;]" ispell-pdict-save ispell-silently-savep ding message "Open tib or SGML command. Fix buffer or set " "ispell-skip-tib" "ispell-skip-sgml" " to nil" poss process-send-string ispell-process accept-process-output ispell-filter ispell-parse-output word-start word-end replace ispell-horiz-scroll error "Ispell misalignment: word " "`%s' point %d; please retry" pos-visible-in-window-p sit-for ispell-keep-choices-win ispell-command-loop ((byte-code "À AA@ AAA@ @\n %À‡" [ispell-command-loop poss word-start word-end replace] 6)) change query-replace backward-char ((byte-code "À ! É“‡" [marker-position ispell-query-replace-marker reg-end nil] 3)) ((byte-code " “ˆÃ\f @Æ#‡" [ispell-query-replace-marker reg-end nil query-replace string replace t] 4)) ispell-add-per-file-word-list ispell-pdict-modified-p "Continuing spelling check using " ispell-dictionary "default" " dictionary..."] 7)) ispell-quit] 4 (#$ . 32633) "r"]) #@61 Check the current buffer for spelling errors interactively. (defalias 'ispell-buffer #[nil "Àed\"‡" [ispell-region] 3 (#$ . 35498) nil]) (defalias 'ispell-continue #[nil "À !„\nÂÃ!‡Ä !pš„ÂÅÆÄ !!\"‡Ç`À !\"‡" [marker-position ispell-region-end message "No session to continue. Use 'X' command when checking!" marker-buffer "Must continue ispell from buffer %s" buffer-name ispell-region] 5 nil nil]) #@67 Places point within the horizontal visibility of its window area. (defalias 'ispell-horiz-scroll #[nil "…5iÁ Â]Z‰ÄWƒ!Á ÄVƒ!Å [Æ]!‚4 Ç ÈZY…4É Ç ZÊZÆ]!)‡" [truncate-lines window-hscroll 1 column 0 scroll-right 10 window-width 2 scroll-left -3] 4 (#$ . 35906)]) #@244 Look up word before or under point in dictionary (see lookup-words command) and try to complete it. If optional INTERIOR-FRAG is non-nil then the word may be a character sequence inside of a word. Standard ispell choices are then available. (defalias 'ispell-complete-word #[(&optional interior-frag) "`ÀÁÀÂ\"À‰‰‰ A@AA@@‰ʘ†:Ë\f…3ÍÍQ\"‰Ï=ƒHÐÑ!ˆ‚Ó\f„UÐÒ\"ˆ‚ÓÓÔ\"ƒeÕÖ\f\"‚‚Ó×\"ƒuÕØ\f\"‚‚ÓÙ\"ƒ‚ÕÚ\f\"Û‹ˆ Üšƒ“Ý!ˆ‚Ç ƒÇ |ˆ :„¥ ‚§ @‰G ZZ \\ cˆ :ƒÇ bˆÞÀÏ\"ˆß !ƒÓá !ˆâ#!ˆ b.‡" [nil ispell-get-word "\\*" replacement possibilities end start word case-fold-search cursor-location "" lookup-words interior-frag "*" ispell-complete-word-dict t message "No word to complete" "No match for \"%s\"" string-match "^[^A-Z]+$" mapcar downcase "^[^a-z]+$" upcase "^[A-Z]" capitalize ((byte-code "À  \f %‡" [ispell-command-loop possibilities nil word start end replacement] 6)) 0 ispell-add-per-file-word-list ispell-word get-buffer ispell-choices-buffer kill-buffer ispell-pdict-save ispell-silently-savep] 8 (#$ . 36179) "P"]) #@59 Completes word matching character sequence inside a word. (defalias 'ispell-complete-word-interior-frag #[nil "ÀÁ!‡" [ispell-complete-word t] 2 (#$ . 37273) nil]) #@42 Non-nil if Ispell minor mode is enabled. (defvar ispell-minor-mode nil (#$ . 37442)) (byte-code "ÀÁ!ˆÁ\nž„Ã\nBÀ‡" [make-variable-buffer-local ispell-minor-mode minor-mode-alist (ispell-minor-mode " Spell")] 2) #@36 Keymap used for Ispell minor mode. (defvar ispell-minor-keymap (byte-code "À  ÃÄ#ˆÂ ÅÄ#ˆ )‡" [make-sparse-keymap map define-key " " ispell-minor-check " "] 4) (#$ . 37661)) (byte-code "ÀÁ!ƒÂà \"„Ã\fB BÀ‡" [boundp minor-mode-map-alist assoc ispell-minor-mode ispell-minor-keymap] 3) #@190 Toggle Ispell minor mode. With prefix arg, turn Ispell minor mode on iff arg is positive. In Ispell minor mode, pressing SPC or RET warns you if the previous word is incorrectly spelled. (defalias 'ispell-minor-mode #[(&optional arg) "„ † Â!ÃX?Ä ‡" [arg ispell-minor-mode prefix-numeric-value 0 force-mode-line-update] 2 (#$ . 37957) "P"]) (defalias 'ispell-minor-check #[nil "ÀÁŒe`}ˆÄÀÁ\"ˆ)ÅÆÇ !!*‡" [nil t ispell-check-only ispell-minor-mode ispell-word call-interactively key-binding this-command-keys] 3 nil "*"]) #@195 *End of text which will be checked in ispell-message. If it is a string, limit at first occurrence of that regular expression. Otherwise, it must be a function which is called to get the limit. (defvar ispell-message-text-end (mapconcat (quote identity) (quote ("^%!PS-Adobe-[123].0" "^begin [0-9][0-9][0-9] .*\nM.*\nM.*\nM" "^#! /bin/[ck]?sh" "\\(diff -c .*\\)?\n\\*\\*\\* .*\n--- .*\n\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*" "^current state:\n==============\n" "^[-=_]+\\s ?\\(cut here\\|Start of forwarded message\\)")) "\\|") (#$ . -38492)) #@118 Spelling is skipped inside these start/end groups by ispell-message. Assumed that blocks are not mutually inclusive. (defvar ispell-message-start-skip (mapconcat (quote identity) (quote ("^---* Forwarded Message" "^---*BEGIN PGP [A-Z ]*--*")) "\\|") (#$ . 39050)) #@118 Spelling is skipped inside these start/end groups by ispell-message. Assumed that blocks are not mutually inclusive. (defvar ispell-message-end-skip (mapconcat (quote identity) (quote ("^--- End of Forwarded Message" "^---*END PGP [A-Z ]*--*")) "\\|") (#$ . 39321)) #@821 Check the spelling of a mail message or news post. Don't check spelling of message headers except the Subject field. Don't check included messages. To abort spell checking of a message REGION and send the message anyway, use the `x' or `q' command. (Any subsequent regions will be checked.) The `X' command aborts the message send so that you can edit the buffer. To spell-check whenever a message is sent, include the appropriate lines in your .emacs file: (add-hook 'news-inews-hook 'ispell-message) (add-hook 'mail-send-hook 'ispell-message) (add-hook 'mh-before-send-letter-hook 'ispell-message) You can bind this to the key C-c i in GNUS or mail by adding to `news-reply-mode-hook' or `mail-mode-hook' the following lambda expression: (function (lambda () (local-set-key "\C-ci" 'ispell-message))) (defalias 'ispell-message #[nil "ŠebˆŠÀÁ !ÄQÅÆ#)È „d‚:Ê !ƒ5À ÅÆ#ƒ1Ë”‚:d‚:d ^!\fÍÎ!ƒQÏÐ ÑÒÓ!°‚¹ÍÕ!ƒeÏÑÒÓ!°‚¹ךƒØÒƒzÓ!‚{ÚQ‚¹ÛšƒÓ!‚¹„œÝÒÞÒß°‚¹àá!ƒ¬âÒÓ!!Q‚¹ƒ¸Ó!‚¹Ú#ä#P%æ#ÑQ'()Æ(Æ*ebˆƒá`W‚éëì!ƒ!m?ƒ!ëí!ƒË•bˆëî!„ëï!„)(ð`ňëñ!ƒòˆ‚ `\"ˆ)óyˆ‚ÕÅ(ë !ÄP!ƒ1óyˆ`\fWƒÌë%!ƒM`\fWƒMóyËU„8`\fWƒ1`4À'\fõ#…cË”64b…yÀ7\fõ#…yËyˆ`86ƒ8ƒ68^†›6†›8†›ù\f!54bˆð45\"ˆ8ƒÄ58UƒÄ5bˆÀ:\fõ#ˆ‚È5bˆ,‚1\fʼn“. ‡" [re-search-forward "^" regexp-quote mail-header-separator "$" nil t internal-messagep copy-marker ispell-message-text-end char-or-string-p 0 limit featurep supercite "\\(" sc-cite-regexp "\\)" "\\|" ispell-non-empty-string sc-reference-tag-string sc major-mode news-reply-mode "In article <" mail-yank-prefix "^ \\|^ " mh-letter-mode mh-ins-buf-prefix "In [a-zA-Z.]+ you write:" "In <[^,;&+=]+> [^,;&+=]+ writes:" " *> *" boundp vm-included-text-prefix "[^,;&+=]+ writes:" cite-regexp "^[ ]*$\\|" cite-regexp-start "^\\(" cite-regexp-end case-fold-search old-case-fold-search ispell-checking-message looking-at "[a-zA-Z---]+:\\| \\| " "Subject: *" ".*Re\\>" "\\[" ispell-region "\n[ ]" 2 1 start end end-c ispell-message-start-skip end-fwd marker-position ispell-message-end-skip] 6 (#$ . 39594) nil]) (defalias 'ispell-non-empty-string #[(string) "ƒ\nÁ˜ƒ\f‡Ã!‡" [string "" "\\'\\`" regexp-quote] 2]) #@70 Load all buffer-local information, restarting ispell when necessary. (defalias 'ispell-accept-buffer-local-defs #[nil "À ˆÁ ˆÂ ‡" [ispell-buffer-local-dict ispell-buffer-local-words ispell-buffer-local-parsing] 1 (#$ . 41845)]) #@141 Place Ispell into parsing mode for this buffer. Overrides the default parsing mode. Includes latex/nroff modes and extended character mode. (defalias 'ispell-buffer-local-parsing #[nil "À Â\"ˆ Ä=ƒÅÆÇ!\"„ É=ƒ#À Ê\"ˆ‚(À Ë\"ˆÌ> Î ‰ƒ>À ÐP\"ˆ)ŠebˆÑÓÔ#…¬ŠÓˆ`)ÔÓØÙÔ#ƒ¨Ú”Ú•{ÅÛ\"ƒzÀ Ü\"ˆ‚ZÅÝ\"ƒŠÀ Þ\"ˆ‚ZÅß\"ƒÀ ÐP\"ˆ‚Zàá!ˆâã!ˆ‚Z+‚C)‡" [process-send-string ispell-process "!\n" ispell-parser use-mode-name string-match "[Tt][Ee][Xx]-mode" symbol-name major-mode tex "+\n" "-\n" (sgml-mode html-mode) ispell-skip-sgml ispell-get-extended-character-mode extended-char-mode "\n" search-forward ispell-parsing-keyword nil t string case-fold-search end re-search-forward " *\\([^ \"]+\\)" 1 "latex-mode" "+\n~tex\n" "nroff-mode" "-\n~nroff" "~" message "Illegal Ispell Parsing argument!" sit-for 2] 5 (#$ . 42080)]) #@248 Initializes local dictionary. When a dictionary is defined in the buffer (see variable `ispell-dictionary-keyword'), it will override the local setting from \[ispell-change-dictionary]. Both should not be used to define a buffer-local dictionary. (defalias 'ispell-buffer-local-dict #[nil "ŠebˆÀ ÀÄ#ƒ'ŠÀˆ`)ÅÆ Ä#ƒǔǕ{‚ebˆÂ ÀÄ#ƒLŠÀˆ`)ÅÆ Ä#ƒ*ǔǕ{\n‚**\nƒb\n š„bÌÄ!ˆ\n …t š?…tÎ!‡" [nil end search-forward ispell-dictionary-keyword t re-search-forward " *\\([^ \"]+\\)" 1 ispell-local-dictionary ispell-pdict-keyword ispell-local-pdict ispell-personal-dictionary ispell-kill-ispell ispell-dictionary ispell-change-dictionary] 4 (#$ . 42935)]) #@58 Loads the buffer-local dictionary in the current buffer. (defalias 'ispell-buffer-local-words #[nil "ƒÁ š„ÂÃ!ˆÄÅ ˆŠebˆÆÄÃ#…T„(Á ŠÄˆ`)Ä ÊË Ã#ƒP̔̕{ÍÏÐQ\"ˆ‚3*‚)‡" [ispell-buffer-local-name buffer-name ispell-kill-ispell t nil ispell-init-process search-forward ispell-words-keyword string end re-search-forward " *\\([^ ]+\\)" 1 process-send-string ispell-process "@" "\n"] 5 (#$ . 43615)]) #@42 Adds new word to the per-file word list. (defalias 'ispell-add-per-file-word-list #[(word &optional reg-end) "„Á \n„ ÊebˆÄ‰‰‰‰ „šÊ ÄÌ# GĈiÎ\\\\ÏWƒD„I„ЄƒÑÎ!ˆÓ Q\n`Vƒg\n G\\ cˆƒƒÕš„ƒŠÑÎ!ˆÎyˆcˆ)\n`Vƒ‘\n GÎ\\\\Ó Pcˆ‚.\n‡" [ispell-buffer-local-name buffer-name reg-end 0 nil string done search line-okay case-fold-search search-forward ispell-words-keyword move word 1 80 t open-line comment-start " " comment-end ""] 5 (#$ . 44039)]) (byte-code "ÀÁ\nBÃÄ!‡" ["2.37 -- Tue Jun 13 12:05:28 EDT 1995" ispell-version current-load-list provide ispell] 2) emacs-19.30/lisp/ispell4.elc100666 12120 1 43071 5762433011 14144 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Mon May 29 16:59:55 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/ispell4.el ;;; emacs version 19.28.92.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/ispell4.el' was compiled for Emacs 19")) #@56 Non-nil means use the `-r' option when running `look'. (defvar ispell-have-new-look t (#$ . 488)) #@73 Non-nil enables experimental TeX parser in Ispell for TeX-mode buffers. (defvar ispell-enable-tex-parser nil (#$ . 592)) #@28 The process running Ispell (defvar ispell-process nil (#$ . 719)) #@74 An integer: where in `*ispell*' buffer to find next message from Ispell. (defvar ispell-next-message nil (#$ . 791)) #@29 Command for running Ispell. (defvar ispell-command "ispell" (#$ . 914)) #@236 *String (or list of strings) to pass to Ispell as command arguments. You can specify your private dictionary via the -p option. The -S option is always passed to Ispell as the last parameter, and need not be mentioned here. (defvar ispell-command-options nil (#$ . -993)) #@28 *Command for running look. (defvar ispell-look-command "look" (#$ . -1282)) #@72 A list of markers reflecting the output of the Ispell `:file' command. (defvar ispell-bad-words nil (#$ . 1364)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ B‡" [boundp ispell-recently-accepted nil current-load-list ispell-window-configuration ispell-dump-needed] 2) (defalias 'ispell-flush-bad-words #[nil "ƒÁ@!ƒ@‰“ˆA‰„‰‡" [ispell-bad-words markerp nil ispell-recently-accepted] 4]) #@113 Kill the Ispell process. Any changes in your private dictionary that have not already been dumped will be lost. (defalias 'kill-ispell #[nil "ƒÁ!ˆÂà ‡" [ispell-process delete-process nil ispell-flush-bad-words] 2 (#$ . 1773) nil]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put ispell-startup-error error-conditions (ispell-startup-error error) error-message "Problem starting ispell - see buffer *ispell*"] 4) (defalias 'start-ispell #[nil "ÀÁ!ˆÂÃ!‰ƒÅ\f!ˆ)ÆÇȈÉ\n!ˆËÌ\n!!ˆÍ\n!ˆÎŠÌ\n!qˆÐp!ˆdÑZ‰fÒ=„`Ó\n!Ô=„RÕ ˆÖ×Î\"ˆÍ\n!ˆdÑZ‰‚;ebˆØp!‰@ÑU„vÚÛ@\"ˆÀA@!ˆ)e|*‡" [message "Starting ispell ..." get-buffer "*ispell*" buf kill-buffer err (byte-code "ÀÁÂÃ\fÅ<ƒ‚CÇ\"%À‡" [apply start-process "ispell" "*ispell*" ispell-command append ispell-command-options ("-S") ispell-process] 8) ((file-error (byte-code "ÀÁÂ\"‡" [signal ispell-startup-error nil] 3))) process-kill-without-query ispell-process buffer-disable-undo process-buffer accept-process-output nil last-char bury-buffer 1 61 process-status run kill-ispell signal ispell-startup-error read greeting error "Bad ispell version: wanted 1, got %d"] 4]) (defalias 'ispell-sync #[(intr) "ƒ\fÁ!Â=„à ˆ\fƒÅ!ˆÆÈ!qˆÉp!ˆdÊZ‰fË=„<Ì!ˆdÊZ‰‚)b)‡" [ispell-process process-status run start-ispell intr interrupt-process nil last-char process-buffer bury-buffer 1 61 accept-process-output] 3]) (defalias 'ispell-cmd #[(&rest strings) "ŠÀÁ!ˆÂ !qˆÄp!ˆÅ ˆeƒ)È @\"ˆA‰„È É\"ˆÊ !ˆÀË!)‡" [ispell-sync t process-buffer ispell-process bury-buffer erase-buffer ispell-next-message strings process-send-string "\n" accept-process-output nil] 4]) (defalias 'ispell-dump #[nil "… ÁÂÃ!‡" [ispell-dump-needed nil ispell-cmd ":dump"] 2]) (defalias 'ispell-insert #[(word) "ÀÁ\n\"ˆ ƒ \n\fBʼn‡" [ispell-cmd ":insert " word ispell-bad-words ispell-recently-accepted t ispell-dump-needed] 3]) (defalias 'ispell-accept #[(word) "ÀÁ\n\"ˆ …\n\fB‰‡" [ispell-cmd ":accept " word ispell-bad-words ispell-recently-accepted] 3]) (defalias 'ispell-next-message #[nil "ŠÀ !qˆÂp!ˆŒ bˆ`ÄÅ!ˆ`}ˆ`ebˆÆp!*‡" [process-buffer ispell-process bury-buffer ispell-next-message forward-sexp 1 read] 3]) (defalias 'ispell-tex-buffer-p #[nil "Á>‡" [major-mode (plain-tex-mode latex-mode slitex-mode)] 2]) (byte-code "ÀÁ!„\nÂÃ!Á\fBÅÁ \"ˆÆ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÌ#ˆÆ ÍÎ#ˆÆ ÏÐ#ˆÆ ÑÒ#ˆÆ ÓÔ#ˆÆ ÕÖ#‡" [boundp ispell-menu-map make-sparse-keymap "Spell" current-load-list defalias define-key [ispell-complete-word-interior-frag] ("Complete Interior Fragment" . ispell-complete-word-interior-frag) [ispell-complete-word] ("Complete Word" . ispell-complete-word) [reload-ispell] ("Reload Dictionary" . reload-ispell) [ispell-next] ("Continue Check" . ispell-next) [ispell-message] ("Check Message" . ispell-message) [ispell-word] ("Check Word" . ispell-word) [ispell-region] ("Check Region" . ispell-region) [ispell-buffer] ("Check Buffer" . ispell)] 4) #@902 Run Ispell over current buffer's visited file. First the file is scanned for misspelled words, then Ispell enters a loop with the following commands for every misspelled word: DIGIT Near miss selector. If the misspelled word is close to some words in the dictionary, they are offered as near misses. r Replace. Replace the word with a string you type. Each word of your new string is also checked. i Insert. Insert this word in your private dictionary (by default, `$HOME/ispell.words'). a Accept. Accept this word for the rest of this editing session, but don't put it in your private dictionary. l Lookup. Look for a word in the dictionary by fast binary search, or search for a regular expression in the dictionary using grep. SPACE Accept the word this time, but complain if it is seen again. q, \[keyboard-quit] Leave the command loop. You can come back later with \[ispell-next]. (defalias 'ispell #[(&optional buf start end) "„Á\n„\fÁ „pÄ !‰„ÅÆ!ˆƒ*È ÊË!ˆŠ qˆ\fÈ ÏŽƒDÐ\fÈ\"ƒVÑÒ!Ó Ôed#ˆ‚iÕ !ƒiÖ×Ø\"!ƒiÙ ˆÚÛ!ˆƒ~Ý ƒ~Þß!ˆ‚‚Þà!ˆÞ×á\n$!ˆ+Úâ!ˆã ˆÈ‰$%æ ‰%§ƒÀ\nÁU„°%\nWƒšç %è\\È“$B$‚š%$B‰$Ÿ)+ê)@!„ÝÈ)Úë!ˆÓ‡Úì!ˆí ‡" [start 0 end buf get-buffer error "Can't find buffer" transient-mark-mode nil mark-active run-hooks deactivate-mark-hook buffer-file-name delete-temp filename ((byte-code "ƒ ÁÂÈÁ‡" [delete-temp nil (delete-file filename) ((file-error))] 3)) find-file-name-handler make-temp-name "/usr/tmp/ispell" t write-region buffer-modified-p y-or-n-p format "Save file %s? " save-buffer message "Ispell scanning file..." ispell-enable-tex-parser ispell-tex-buffer-p ispell-cmd ":tex" ":generic" ":file %s %d %d" "Parsing ispell output ..." ispell-flush-bad-words bad-words pos ispell-next-message make-marker 1 ispell-bad-words markerp "No misspellings." "Ispell parsing done." ispell-next] 7 (#$ . 4677) nil]) (defalias (quote ispell-buffer) (quote ispell)) #@105 Resume command loop for most recent Ispell command. Return value is t unless exit is due to typing `q'. (defalias 'ispell-next #[nil "ÀÂŽÃÄ)Å ˆ‡" [nil ispell-window-configuration ((byte-code "À ˆ ƒ  !ˆ „ÄÅ!ˆ‚LÆ @!ƒ&ÇÈÉ!!ˆ‚L @Ê=ƒ6ÊÇË!ˆ‚L @Ì=ƒFÊÇÍ!ˆ‚LÊÇÎ!ˆÊ‡" [ispell-dehighlight ispell-window-configuration set-window-configuration ispell-bad-words error "Ispell has not yet been run" markerp message substitute-command-keys "Type \\[ispell-next] to continue" nil "No more misspellings (but checker was interrupted)" t "Ispell done" "Bad ispell internal list"] 3)) ispell-quit (byte-code "À @‰!ƒ$ÄÅ !!ˆÆ ˆÇ È\"ˆ A À‰“ˆ‚)ɇ" [nil next markerp ispell-bad-words switch-to-buffer marker-buffer push-mark ispell-point "at saved position." t] 3) ispell-dump] 2 (#$ . 6623) nil]) #@169 Check the spelling of the word under the cursor. See the command `ispell' for more information. With a prefix argument, resume handling of the previous Ispell command. (defalias 'ispell-word #[(&optional resume) "ƒÁ ‡ÂÃć" [resume ispell-next err (byte-code "ÀŽÁÂ)‡" [((ispell-dehighlight)) ispell-quit (byte-code "À‹ˆÁ ‡" [((byte-code "À`Á\"‡" [ispell-point "at point."] 3)) ispell-dump] 1)] 2) ((ispell-startup-error (byte-code "ÀÁ!…ÂÃ!ˆÄ ÆÇ#ˆÇ ‡" [y-or-n-p "Problem starting ispell, use old-style spell instead? " load-library "spell" define-key esc-map "$" spell-word] 4)))] 3 (#$ . 7425) "P"]) #@56 Check the spelling for all of the words in the region. (defalias 'ispell-region #[(start &optional end) "Àp \n#‡" [ispell start end] 4 (#$ . 8037) "r"]) (defalias 'ispell-letterp #[(c) "…ÁYƒÂX†ÃYƒÄX†ÅY‡" [c 65 90 97 122 128] 2]) (defalias 'ispell-letter-or-quotep #[(c) "…%ÁYƒÂX†%ÃYƒÄX†%ÅU†%ÆY‡" [c 65 90 97 122 39 128] 2]) (defalias 'ispell-find-word-start #[nil "À`f!„o„À`ÁZf!„ ˆ‚Ã`ÁZf!ƒ) ˆ‚ÄÅw‡" [ispell-letterp 1 backward-char ispell-letter-or-quotep "'" nil] 3]) (defalias 'ispell-find-word-end #[nil "À`f!ƒ Áuˆ‚ÂÁx‡" [ispell-letter-or-quotep nil "'"] 2]) (defalias 'ispell-next-word #[nil "m?…À`f!?…Áuˆ‚‡" [ispell-letterp nil] 2]) (defalias 'ispell-point #[(start message) "À Á‰ bˆÆ ˆÇ È ˆÇ  \nWƒ‹ \nWƒ‹ bˆÈ ˆ\f`Á“ˆÁ \f{ Ê !ƒyËÌÍ \"!ˆÎ !ˆÏ ‰ Ð=ƒ[ËÑ \"ˆ‚x ƒf :ƒrÒ \f $‚xÓÔ \"ˆ) „\fbˆÕ ˆ `Á“ˆ‚Ö×!‰ƒ›qˆÙ ˆ) Á‰“ˆ\nÁ‰“ˆ\fÁ‰“+‡" [make-marker nil end rescan wend start ispell-find-word-start point-marker ispell-find-word-end word ispell-still-bad message format "Ispell checking %s" ispell-cmd ispell-next-message t "%s: ok" ispell-command-loop error "unknown ispell response %s" ispell-next-word get-buffer "*ispell choices*" buf erase-buffer] 6]) (defalias 'ispell-still-bad #[(word) "Á‰‰ƒ Å\f@\"Ç=ƒÈÈ\fA‰„\n +‡" [ispell-recently-accepted t case-fold-search ret words string-match word 0 nil] 4]) (defalias 'ispell-show-choices #[(word message first-line) "À ‰ =ÄÅ!Ç „Ê  Ë!Ì!ˆ ƒ9ÍŽÎ!ˆÏÐÑ!Z!ˆ)ŠqˆÒ!ˆÓe\"ˆÔe\"ˆÕ ˆ×±ˆØcˆ??…·ÚÚÜW…¶ÚÚÜWƒ¨Ü_\\‰8‰ƒàá#‰\"cˆãäå\"GZ\"ˆ)*æ\\‰‚o)×cˆæ\\‰‚f)-‡" [selected-window selwin next-window resize get-buffer-create "*ispell choices*" buf nil w ispell-window-configuration current-window-configuration display-buffer buffer-disable-undo ((select-window selwin)) select-window enlarge-window 6 window-height bury-buffer set-window-point set-window-start erase-buffer first-line "\n" "SPC skip; A accept; I insert; DIGIT select; R replace; L lookup; Q quit\n" message 0 i 3 j n choice format "%d %s" str insert-char 32 20 1] 5]) (defalias 'ispell-command-loop #[(word start end message) "ÀÁ‰ „ÆÈQ‚ÉÈQÊ \f\"ˆ\fƒüÍ \n#ˆÅÎ!ˆÏ ˆÐ —Á‰ÓYƒaÔXƒaÓZ 8‰ƒaÕ \f#ˆÁ‚øÖUƒp×ØÁ\"ˆ‚øÙÚ 8Uƒ€Û ˆ‚øÜUƒŒÁ‚øÝUƒ¤Õ \fÞß!#ˆÀÁ‚øàUƒµá!ˆÁ‚øâUƒÆã!ˆÁ‚øäUƒÞå!‰&@&A)‚øçUƒðÅè!ˆéê!ˆ‚øÅë!ˆéê!ˆ*‚ +‡" [t nil first-line rescan flag message "No near misses for '" word "'" "Near misses for '" ispell-highlight start end ispell-show-choices "Ispell command: " undo-boundary read-char replacement c 48 57 ispell-replace 113 throw ispell-quit 3 current-input-mode keyboard-quit 32 114 read-string "Replacement: " 105 ispell-insert 97 ispell-accept 108 ispell-do-look val 63 "Type 'C-h d ispell' to the emacs main loop for more help" sit-for 2 "Bad ispell command"] 6]) (defalias 'ispell-do-look #[(bad-word) "À‰‰\f„ÅÆ!‚ÅÇÈ\"ÉÊ!Š\nqˆed|ˆ\fƒ4Ë\fÀ\nÀÍ &ˆ‚=Ë\fÀ\nÀ %ˆebˆÎyˆ`d|ˆebˆedU„cÀˆe`{ BÀyˆe`|ˆ‚JÏ\n!ˆÐÑ \"Ò !,B‡" [nil words buf regex ispell-have-new-look read-string "Lookup: " "Lookup (regex): " "^" get-buffer-create "*ispell look*" call-process ispell-look-command "-r" 10 kill-buffer format "Lookup '%s'" reverse] 7]) (defalias 'ispell-replace #[(start end new) "bˆ cˆ`\n|‡" [start new end] 2]) #@49 Tell Ispell to re-read your private dictionary. (defalias 'reload-ispell #[nil "ÀÁ!‡" [ispell-cmd ":reload"] 2 (#$ . 11409) nil]) (defalias 'batch-make-ispell #[nil "ÀÁ!ˆÂÃ!ˆ\fÅÇ ˆ*È ˆÉÊ!ƒËÌ!ˆÍedÎ#‡" [byte-compile-file "ispell.el" find-file "ispell.texinfo" default-directory "/tmp" old-dir texinfo-format-buffer Info-validate get-buffer " *problems in info file*" kill-emacs 1 write-region "ispell.info"] 4]) #@43 *Non-nil means to highlight ispell words. (defvar ispell-highlight t (#$ . -11830)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp ispell-overlay nil current-load-list] 2) (defalias 'ispell-dehighlight #[nil "… Á!ˆÂ‰‡" [ispell-overlay delete-overlay nil] 2]) (defalias 'ispell-highlight #[(start end) "…' …'\n„!Ã\f \"Æ\nÇÈÉ!ƒÉ‚Ê#ˆË\n\f p$‡" [ispell-highlight window-system ispell-overlay make-overlay start end overlay-put face internal-find-face ispell region move-overlay] 5]) #@186 *If non-nil then spelling dictionary as string for `ispell-complete-word'. Overrides default dictionary file such as "/usr/dict/words" or GNU look's "${prefix}/lib/ispell/ispell.words" (defvar ispell-look-dictionary nil (#$ . -12318)) #@442 *t if GNU look -r can give different results with and without trialing `.*'. Example: `look -dfr "^ya" foo' returns nothing, while `look -dfr "^ya.*" foo' returns `yacc', where `foo' is a dictionary file containing the three lines y y's yacc Both commands should return `yacc'. If `ispell-complete-word' erroneously states that no completions exist for a string, then setting this variable to t will help find those completions. (defvar ispell-gnu-look-still-broken-p nil (#$ . -12560)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÆÅ!ˆÇÅÈÉ#ˆÀÊ!„7Â\nÊ BÆÊ!ˆÇÊÈÉ#‡" [boundp ispell-lookup-completions-alist nil current-load-list ispell-lookup-last-word ispell-lookup-last-interior-p make-variable-buffer-local put permanent-local t ispell-lookup-last-bow] 4) #@296 Complete word using letters at point to word beginning using `look'. With optional argument INTERIOR-FRAG, word fragment at point is assumed to be an interior word fragment in which case `ispell-have-new-look' should be t. See also `ispell-look-dictionary' and `ispell-gnu-look-still-broken-p'. (defalias 'ispell-complete-word #[(&optional interior-frag) "ƒ „ÂÃÄP!ˆÅŠÇÈxˆ`)‰ `{\nƒ+Ë\nÌQ‚5Í\n…4ÌQƒ?ЂA\n…M š†f?†fÅ×ÍP\n\")?È\nИƒÚPŠÛvˆ`)`{˜ƒ‰ÂÜ!ˆ‚ÂÝ!ˆ„ŸƒŸÞ\n\"à\"\n Å=ƒÂÚcˆáâ!‚!„Òáã\n\"ˆä ‚!И„ýÅ×ÍåQ\n\")„ýæ\n \"ˆçÈÅ#ˆáè!‚!áé!ˆИƒ  `|ˆê\"+ìí+!‘ˆ)áî!.‡" [interior-frag ispell-have-new-look error "Sorry, `ispell-have-new-look' is nil. " "You also will need GNU Ispell's `look'." t completion-ignore-case "a-zA-Z'" nil bow string "^.*" ".*" "^" ispell-gnu-look-still-broken-p regexp "" prefix ispell-lookup-last-interior-p ispell-lookup-last-bow continuing-an-interior-frag-p ispell-lookup-last-word case-fold-search string-match new-unique-string-p completion " " -1 "Perfect match already" "No word fragment at point" ispell-lookup-build-list ispell-lookup-completions-alist try-completion message "Perfect match." "Can't find completion for \"%s\"" beep "$" search-backward replace-match "Proposed unique substring. Repeat for completions list." "Making completion list..." all-completions list "*Completions*" display-completion-list "Making completion list...done"] 5 (#$ . 13342) "P"]) #@200 Runs `ispell-complete-word' with a non-nil INTERIOR-FRAG. A completion list is built for word fragment at point which is assumed to be an interior word fragment. `ispell-have-new-look' should be t. (defalias 'ispell-complete-word-interior-frag #[nil "ÀÁ!‡" [ispell-complete-word t] 2 (#$ . 14856) nil]) (defalias 'ispell-lookup-build-list #[(string regexp) "ŠÀÁ!ˆÂÃ!qˆÄ ˆ ;ƒ7ƒ'ÇÉÊÉË\f &ˆ‚WÇÉÊÉÍ &ˆ‚WƒKÇÉÊÉË\f&ˆ‚WÇÉÊÉÍ&ˆÉebˆedU„xɈe`{BÉyˆe`|ˆ‚]Ä ˆÀÐ!ˆÑÏŸ\"*‡" [message "Building list..." get-buffer-create " *ispell look*" erase-buffer ispell-look-dictionary ispell-have-new-look call-process ispell-look-command nil t "-fr" regexp "-f" string list "Building list...done" mapcar] 8]) (defalias 'ispell-non-empty-string #[(string) "ƒ\nÁ˜ƒ\f‡Ã!‡" [string "" "\\'\\`" regexp-quote] 2]) #@73 *Regular expression to match lines cited from one message into another. (defvar ispell-message-cite-regexp "^ \\|^ " (#$ . -15690)) #@194 *End of text which will be checked in ispell-message. If it is a string, limit at first occurence of that regular expression. Otherwise, it must be a function which is called to get the limit. (defvar ispell-message-text-end (byte-code "ÀÁÂÃÄ#ÅQ‡" ["^\\(" mapconcat identity ("%!PS-Adobe-2.0" "begin [0-9][0-9][0-9] .*\nM.*\nM.*\nM" "#! /bin/sh" "diff -c .*\n\\*\\*\\* .*\n--- " "[-=]+\\s cut here") "\\|" "\\)"] 5) (#$ . -15831)) #@68 *Ispell-message will check no more than this number of characters. (defvar ispell-message-limit 8000 (#$ . -16268)) #@449 Check the spelling of a mail message or news post. Don't check spelling of message headers (except subject) or included messages. To spell-check whenever a message is sent, include this line in .emacs: (setq news-inews-hook (setq mail-send-hook 'ispell-message)) Or you can bind the function to C-c i in gnus or mail with: (setq mail-mode-hook (setq news-reply-mode-hook (function (lambda () (local-set-key "\C-ci" 'ispell-message))))) (defalias 'ispell-message #[nil "ŠÀ ÀebˆÄ ÀÆ#ƒÇyˆ‚*ÈÉ!ƒ(m„(Çyˆ‚ÆÊË!ƒ>ÌÍ ÎÏÐ!°‚¦ÊÒ!ƒRÌ ÎÏÐ!°‚¦ ƒ`ÓÏÔÏÕ°‚¦ךƒ{ØσuÐ!‚wQ‚¦ÛÜ!ƒ‹ÝÏÐ!Q‚¦ÛÞ!ƒ˜Ð!‚¦ƒ¤Ð!‚¦Æ e!\\dŠ\"„ºd‚Öã\"!ƒÓä\"Àå#ƒÏ攂Öd‚Ö\" )^^‰'G\\(ŠÆ`)ebˆäê)Æ#ƒÈë!„ì`ÇZÀˆÈí!ƒ `\" +`'W…i …iÈïP!ƒ4`'Wƒ4Çyˆ‚`'Wƒ`0äñÎQ(å#ƒNæyˆ`'VƒY'bˆ\nŠì0ÇZ`\" +‚.‡" [nil case-fold-search old-case-fold-search non-internal-message search-forward mail-header-separator t 1 looking-at "[a-zA-Z-]+:\\| \\| " featurep supercite "\\(" sc-cite-regexp "\\)" "\\|" ispell-non-empty-string sc-reference-tag-string sc "In [a-zA-Z.]+ you write:" "In <[^,;&+=]+> [^,;&+=]+ writes:" " *> *" major-mode news-reply-mode "In article <" mail-yank-prefix ispell-message-cite-regexp boundp vm-included-text-prefix "[^,;&+=]+ writes:" mh-ins-buf-prefix cite-regexp continue ispell-message-limit ispell-message-text-end char-or-string-p re-search-forward end 0 limit search-limit message-begin "^Subject:[ ]*" "re\\>" ispell-region "\n[ ]" 2 "^[ ]*$\\|" start "^\\("] 7 (#$ . 16391) nil]) (provide (quote ispell)) emacs-19.30/lisp/jka-compr.elc100666 12120 1 34151 6054601047 14453 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 22 05:57:23 1995 ;;; from file /home/fsf/rms/e19/lisp/jka-compr.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`jka-compr.el' was compiled for Emacs 19.29 or later")) #@229 *Shell to be used for calling compression programs. The value of this variable only matters if you want to discard the stderr of a compression/decompression program (see the documentation for `jka-compr-compression-info-list'). (defvar jka-compr-shell "sh" (#$ . -477)) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp jka-compr-use-shell t current-load-list] 2) #@1390 List of vectors that describe available compression techniques. Each element, which describes a compression technique, is a vector of the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS APPEND-FLAG EXTENSION], where: regexp is a regexp that matches filenames that are compressed with this format compress-msg is the message to issue to the user when doing this type of compression (nil means no message) compress-program is a program that performs this compression compress-args is a list of args to pass to the compress program uncompress-msg is the message to issue to the user when doing this type of uncompression (nil means no message) uncompress-program is a program that performs this compression uncompress-args is a list of args to pass to the uncompress program append-flag is non-nil if this compression technique can be appended auto-mode flag non-nil means strip the regexp from file names before attempting to set the mode. Because of the way `call-process' is defined, discarding the stderr output of a program adds the overhead of starting a shell each time the program is invoked. (defvar jka-compr-compression-info-list (quote (["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'" "compressing" "compress" ("-c") "uncompressing" "uncompress" ("-c") nil t] ["\\.tgz\\'" "zipping" "gzip" ("-c" "-q") "unzipping" "gzip" ("-c" "-q" "-d") t nil] ["\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'" "zipping" "gzip" ("-c" "-q") "unzipping" "gzip" ("-c" "-q" "-d") t t])) (#$ . 835)) #@72 A list of pairs to add to auto-mode-alist when jka-compr is installed. (defvar jka-compr-mode-alist-additions (byte-code "ÀÁBC‡" ["\\.tgz\\'" tar-mode] 2) (#$ . 2589)) #@77 The entry in `file-name-handler-alist' used by the jka-compr I/O functions. (defvar jka-compr-file-name-handler-entry nil (#$ . 2763)) (defalias 'jka-compr-info-regexp #[(info) "ÁH‡" [info 0] 2]) (defalias 'jka-compr-info-compress-message #[(info) "ÁH‡" [info 1] 2]) (defalias 'jka-compr-info-compress-program #[(info) "ÁH‡" [info 2] 2]) (defalias 'jka-compr-info-compress-args #[(info) "ÁH‡" [info 3] 2]) (defalias 'jka-compr-info-uncompress-message #[(info) "ÁH‡" [info 4] 2]) (defalias 'jka-compr-info-uncompress-program #[(info) "ÁH‡" [info 5] 2]) (defalias 'jka-compr-info-uncompress-args #[(info) "ÁH‡" [info 6] 2]) (defalias 'jka-compr-info-can-append #[(info) "ÁH‡" [info 7] 2]) (defalias 'jka-compr-info-strip-extension #[(info) "ÁH‡" [info 8] 2]) #@198 Return information about the compression scheme of FILENAME. The determination as to which compression scheme, if any, to use is based on the filename itself and `jka-compr-compression-info-list'. (defalias 'jka-compr-get-compression-info #[(filename) "ÀÁ‡" [compression-info (byte-code "ÀÂÃ\f\"ˆ)À‡" [nil case-fold-search mapcar #[(x) "ÀÁ\n! \"… ÄÅ\n\"‡" [string-match jka-compr-info-regexp x filename throw compression-info] 3] jka-compr-compression-info-list] 3)] 2 (#$ . 3536)]) (byte-code "ÀÁÂÃ#ˆÄÅ!„ÆÅBÀ‡" [put compression-error error-conditions (compression-error file-error error) boundp jka-compr-acceptable-retval-list (0 2 141) current-load-list] 4) (defalias 'jka-compr-error #[(prog args infile message &optional errfile) "ÀÁ!p‰qˆ~ˆÄ ˆÅÆÈÉ\nË#\f$cˆ ƒ'Î !ˆ\nqˆÏ !ˆ*ÐÑÒÅÓ\"\fE\"‡" [get-buffer-create " *jka-compr-error*" curbuf errbuf erase-buffer format "Error while executing \"%s %s < %s\"\n\n" prog mapconcat identity args " " infile errfile insert-file-contents display-buffer signal compression-error "Opening input file" "error %s" message] 8]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀ‡" [boundp jka-compr-dd-program "/bin/dd" current-load-list jka-compr-dd-blocksize 256] 2) #@187 Call program PROG with ARGS args taking input from INFILE. Fourth and fifth args, BEG and LEN, specify which part of the output to keep: LEN chars starting BEG chars from the beginning. (defalias 'jka-compr-partial-uncompress #[(prog message args infile beg len) " ¥\n _Z\f…\f \\ ¥T`Ç ÉÊ ÌÍÏ# \n ƒ7Ñ TP‚8Ò&ÔŽÕØÙÚ&>„]Ü %ˆ)\fƒv \\\f\\`Wƒv \\\f\\`|ˆ‰ \\|.‡" [beg jka-compr-dd-blocksize skip prefix len count start jka-compr-make-temp-name err-file format "%s %s 2> %s | %s bs=%d skip=%d %s 2> /dev/null" prog mapconcat identity args " " jka-compr-dd-program "count=" "" run-string ((jka-compr-delete-temp-file err-file)) call-process jka-compr-shell infile t nil "-c" jka-compr-acceptable-retval-list jka-compr-error message] 10 (#$ . 4756)]) (defalias 'jka-compr-call-process #[(prog message infile output temp args) "ƒGÁ ÃŽÄ ;?…ÈÉÊË\fÍÎÐ#\n;ƒ0ÑP‚1Ò%&>†EÔ\f\n%*‡Ö×Ä\f;ƒY‚[È&!„oÔ\f$ˆ;…ŠpqˆÚed#ˆÛ ˆq)‡" [jka-compr-use-shell jka-compr-make-temp-name err-file ((jka-compr-delete-temp-file err-file)) call-process jka-compr-shell infile output nil "-c" format "%s %s 2> %s %s" prog mapconcat identity args " " "> " "" jka-compr-acceptable-retval-list jka-compr-error message zerop apply temp cbuf write-region erase-buffer] 13]) #@120 Prefix added to all temp files created by jka-compr. There should be no more than seven characters after the final `/' (defvar jka-compr-temp-name-template "/tmp/jka-com" (#$ . 6100)) (byte-code "ÀÁ!„ ÂÃÄ\"Á Bć" [boundp jka-compr-temp-name-table make-vector 31 nil current-load-list] 3) #@50 This routine will return the name of a new file. (defalias 'jka-compr-make-temp-name #[(&optional local-copy) "ÀÀ ÄP‰GSÇÉ\nÉ ƒr  IˆÌ !ÍP\nÎ\n\"‰ ÐN„=Ñ\n!ƒb T‰ÒVƒ\nTÀ\nÒVƒXÓÔ!ˆ‚ S\nIˆ‚Õ Ð?#ˆÉ‰„\n.‡" [97 lastchar prevchar jka-compr-temp-name-template "aa" template lastpos t not-done nil file entry make-temp-name "#" intern jka-compr-temp-name-table active file-exists-p 122 error "Can't allocate temp file." put local-copy] 5 (#$ . 6397)]) (defalias 'jka-compr-delete-temp-file #[(temp) "ÀÁ\n \"ÄÅ#ˆÅÆLJ" [put intern temp jka-compr-temp-name-table active nil (delete-file temp) ((error))] 4]) (defalias 'jka-compr-write-region #[(start end file &optional append visit) "À ! ;ƒÀ !‚\nÅ\f!‰ƒ#Ç!È!É!Ê!Ë!Ì!Í!Î\f!ω‰pÛÜ!‰qˆ~ˆÝ ˆqˆƒ‰„‰ß\n!ƒ‰à\n!‰!†€\n‰\"*‚ã ƒšäå#ˆæç()êë¯\"ˆìíQÏ&ˆqˆæçed\n…Ëë¯\"ˆÝ ˆqˆî!ˆƒéäï#ˆ ê=ƒø\n0ñ ˆ‚ ;ƒ 0\n0ñ ˆ) ê=„ Ï=„ ;ƒäò\f\"ˆ. Ï‚0æç()\n ¯\"+‡" [expand-file-name file filename visit visit-file jka-compr-get-compression-info info jka-compr-info-can-append jka-compr-info-compress-program jka-compr-info-compress-message jka-compr-info-uncompress-program jka-compr-info-uncompress-message jka-compr-info-compress-args jka-compr-info-uncompress-args file-name-nondirectory nil temp-buffer cbuf temp-file base-name uncompress-args compress-args uncompress-message uncompress-program compress-message compress-program can-append get-buffer-create " *jka-compr-wr-temp*" erase-buffer append file-exists-p file-local-copy local-copy local-file jka-compr-make-temp-name message "%s %s..." jka-compr-run-real-handler write-region start end t dont jka-compr-call-process " " jka-compr-delete-temp-file "%s %s...done" buffer-file-name set-visited-file-modtime "Wrote %s"] 12]) (defalias 'jka-compr-insert-file-contents #[(file &optional visit beg end replace) "À ˆ „ \nƒ ƒÄÅ!ˆÆ!É!‰\nƒáË\n!Ì\n!Í\n!Î!ÏÐÑC\"ω‰†V ƒ`ÜŽƒoÝÞ#ˆßàáˆ) ƒƒâ ˆã ˆƒÝä#ˆ ƒ£ƒ£åæçè8B\"ˆ)*‰+ƒÖ+@!‰*ƒÍ*¨„Éåìí*D\"ˆ*+A‰+„¯*. D‚íÐî \n/¯\"*‡" [barf-if-buffer-read-only beg end visit error "Attempt to visit less than an entire file" expand-file-name file filename jka-compr-get-compression-info info jka-compr-info-uncompress-message jka-compr-info-uncompress-program jka-compr-info-uncompress-args file-name-nondirectory nil jka-compr-run-real-handler file-local-copy start size local-file local-copy notfound base-name uncompress-args uncompress-program uncompress-message buffer-file-name ((byte-code "ƒÁ!ƒÂ!ˆÁ‡" [local-copy file-exists-p delete-file] 2)) message "%s %s..." error-code (byte-code "ƒebˆ`\n„ ƒ7Ä ÇQ \n\n†\"Ë\nƒ0 ƒ0 \nZ‚1 &ˆ‚S\f?…?  Î ÇQ\nÏÐ &ˆ)` Zƒn`‰\\d^|ˆ* b‡" [replace start beg end jka-compr-partial-uncompress uncompress-program uncompress-message " " base-name uncompress-args local-file 0 visit buffer-file-name jka-compr-call-process t nil size del-beg del-end] 9) ((error (byte-code "@Á=ƒ$Â8 =ƒ$\fƒ‚+ÆÁÇAAB\"ˆ‚+Æ@A\"ˆÁ‡" [error-code file-error 3 local-file visit notfound signal "Opening input file"] 4))) unlock-buffer set-visited-file-modtime "%s %s...done" signal file-error "Opening input file" 2 after-insert-file-functions insval p wrong-type-argument integerp insert-file-contents replace] 10]) (defalias 'jka-compr-file-local-copy #[(file) "À !Ã\n!‰ƒ…Å\f!Æ\f!Ç\f!È\n!ÉÊ\nC\"ËÌ!ÍÎ!Ïpφ@\nÚŽƒQÛÜ#ˆqˆÝÞQÌÏ&ˆƒtÛß#ˆàedÏá%ˆ).\n‚ŠÉÊ\nC\"*‡" [expand-file-name file filename jka-compr-get-compression-info info jka-compr-info-uncompress-message jka-compr-info-uncompress-program jka-compr-info-uncompress-args file-name-nondirectory jka-compr-run-real-handler file-local-copy jka-compr-make-temp-name t get-buffer-create " *jka-compr-flc-temp*" nil local-file cbuf notfound temp-buffer temp-file local-copy base-name uncompress-args uncompress-program uncompress-message ((byte-code "ƒÁ!ƒÂ!ˆ qˆÄ !‡" [local-copy file-exists-p delete-file cbuf kill-buffer temp-buffer] 2)) message "%s %s..." jka-compr-call-process " " "%s %s...done" write-region dont] 11]) #@25 Documented as original. (defalias 'jka-compr-load #[(file &optional noerror nomessage nosuffix) "À !‰† Ďʼn„ÉÊ \"ˆË\fÍ ˉ$ˆ)„2ÉÏ \"ˆ-ˇ" [jka-compr-file-local-copy file local-copy load-file ((jka-compr-delete-temp-file local-copy)) nil inhibit-file-name-handlers inhibit-file-name-operation nomessage message "Loading %s..." t load-force-doc-strings load noerror "Loading %s...done."] 6 (#$ . 10669)]) (defalias 'jka-compr-byte-compiler-base-file-name #[(file) "À !‰ƒ Ã\n!ƒ Ä ÆŽ ÇÈÉ\n! \"O*‚! )‡" [jka-compr-get-compression-info file info jka-compr-info-strip-extension match-data match-data ((store-match-data match-data)) 0 string-match jka-compr-info-regexp] 6]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#ˆÀÈÂÉ#ˆÀÊÂË#‡" [put write-region jka-compr jka-compr-write-region insert-file-contents jka-compr-insert-file-contents file-local-copy jka-compr-file-local-copy load jka-compr-load byte-compiler-base-file-name jka-compr-byte-compiler-base-file-name] 4) (defalias 'jka-compr-handler #[(operation &rest args) "À ÂŽ ÄN‰ƒÆ \"‚È \"+‡" [match-data match-data ((store-match-data match-data)) operation jka-compr jka-op apply args jka-compr-run-real-handler] 4]) (defalias 'jka-compr-run-real-handler #[(operation args) "À \n=… B\nÄ\n \"*‡" [jka-compr-handler inhibit-file-name-operation operation inhibit-file-name-handlers apply args] 3]) #@191 Toggle automatic file compression and uncompression. With prefix argument ARG, turn auto compression on if positive, else off. Returns the new status of auto compression (non-nil means on). (defalias 'auto-compression-mode #[(&optional arg) "À \n„\f ?‚\nÃ=†\n<†\n¨…\nÄV‰ƒ( „= „0 ƒ= ƒ:Æ ˆ‚=Ç ˆtƒP ƒLÈÉ!ˆ‚PÈÊ!ˆ *‡" [jka-compr-installed-p installed arg t 0 flag jka-compr-install jka-compr-uninstall message "Automatic file (de)compression is now ON." "Automatic file (de)compression is now OFF."] 3 (#$ . 12040) "P"]) (defalias (quote toggle-auto-compression) (quote auto-compression-mode)) (defalias 'jka-compr-build-file-regexp #[nil "ÀÁ Ä#ÅQ‡" ["\\(" mapconcat jka-compr-info-regexp jka-compr-compression-info-list "\\)\\|\\(" "\\)"] 5]) #@130 Install jka-compr. This adds entries to `file-name-handler-alist' and `auto-mode-alist' and `inhibit-first-line-modes-suffixes'. (defalias 'jka-compr-install #[nil "À ÁB‰ BÄÅ\"ˆÇ \"‰‡" [jka-compr-build-file-regexp jka-compr-handler jka-compr-file-name-handler-entry file-name-handler-alist mapcar #[(x) "À !… !ÃÄE B‰… !B‰‡" [jka-compr-info-strip-extension x jka-compr-info-regexp nil jka-compr auto-mode-alist inhibit-first-line-modes-suffixes] 3] jka-compr-compression-info-list append auto-mode-alist jka-compr-mode-alist-additions] 4 (#$ . 12807)]) #@180 Uninstall jka-compr. This removes the entries in `file-name-handler-alist' and `auto-mode-alist' and `inhibit-first-line-modes-suffixes' that were added by `jka-compr-installed'. (defalias 'jka-compr-uninstall #[nil "ÀÁ\n\"ˆÃ\fB‰Aƒ/A@AÇ=ƒ&‰AA¡ˆ‚\fA‰‚ A*ÃB‰ Ã\nAƒuA@‰\n „b\nA:ƒlÌ\n8Í=ƒl‰AA¡ˆ‚?A‰‚A A‰+‡" [mapcar #[(x) "À !…Âà !\f\"‰‡" [jka-compr-info-strip-extension x delete jka-compr-info-regexp inhibit-first-line-modes-suffixes] 3] jka-compr-compression-info-list nil file-name-handler-alist fnha last jka-compr-handler auto-mode-alist ama entry jka-compr-mode-alist-additions 2 jka-compr] 4 (#$ . 13386)]) #@117 Return non-nil if jka-compr is installed. The return value is the entry in `file-name-handler-alist' for jka-compr. (defalias 'jka-compr-installed-p #[nil "Á‰ƒ\n„ @AÄ=ƒ @ A‰„\n*‡" [file-name-handler-alist nil installed fnha jka-compr-handler] 3 (#$ . 14055)]) (byte-code "À ƒÁ ˆÂ ˆÃÄ!‡" [jka-compr-installed-p jka-compr-uninstall jka-compr-install provide jka-compr] 2) emacs-19.30/lisp/kermit.elc100666 13437 1 5215 5744576567 14225 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:44:54 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/kermit.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/kermit.el' was compiled for Emacs 19")) (require (quote shell)) #@23 *Kermit's escape char (defvar kermit-esc-char "" (#$ . -505)) #@65 For sending escape sequences to a kermit running in shell mode. (defalias 'kermit-esc #[nil "ÀÁp!\nÃÄ !P\"‡" [process-send-string get-buffer-process kermit-esc-char char-to-string read-char] 5 (#$ . 574) nil]) #@57 Send an arbitrary character to a program in shell mode. (defalias 'kermit-send-char #[nil "ÀÁp!Âà !\"‡" [process-send-string get-buffer-process char-to-string read-char] 4 (#$ . 790) nil]) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÃ#‡" [define-key shell-mode-map "" kermit-esc "" kermit-send-char "\\"] 4) #@66 Like \[comint-send-input] but end the line with carriage-return. (defalias 'kermit-send-input-cr #[nil "À ˆÁÂp!Ã\"‡" [comint-send-input comint-send-string get-buffer-process " "] 3 (#$ . 1091) nil]) (define-key shell-mode-map "\n" (quote kermit-send-input-cr)) #@180 Make RETURN end the line with carriage-return and LFD end it with a newline. This is useful for talking to other systems on which carriage-return is the normal way to end a line. (defalias 'kermit-default-cr #[nil "À ÂÃ#ˆÀ ÄÅ#‡" [define-key shell-mode-map " " kermit-send-input-cr "\n" comint-send-input] 4 (#$ . 1359) nil]) #@148 Make RETURN end the line with a newline char. This is the default state. In this state, use LFD to send a line and end it with a carriage-return. (defalias 'kermit-default-nl #[nil "À ÂÃ#ˆÀ ÄÅ#‡" [define-key shell-mode-map "\n" kermit-send-input-cr " " comint-send-input] 4 (#$ . 1691) nil]) #@49 Strip ^M and ^@ characters from process output. (defalias 'kermit-clean-filter #[(proc str) "ŠÀ !à !qˆ\nbˆÄ !ˆÆÇ\nÈ#… ÉÊ!ˆ‚*‡" [process-mark proc beg process-buffer insert-before-markers str re-search-backward "[ ]+" t replace-match ""] 4 (#$ . 1990)]) #@158 Delete all null characters and ^M's from the kermit output. Note that another (perhaps better) way to do this is to use the command `kermit | tr -d '\015''. (defalias 'kermit-clean-on #[nil "ÀÁp!Â\"‡" [set-process-filter get-buffer-process kermit-clean-filter] 3 (#$ . 2255) nil]) #@50 Cancel a previous kermit-clean-shell-on command. (defalias 'kermit-clean-off #[nil "ÀÁp!Â\"‡" [set-process-filter get-buffer-process nil] 3 (#$ . 2542) nil]) emacs-19.30/lisp/ledit.elc100666 13437 1 10056 5744576570 14044 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:44:55 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/ledit.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/ledit.el' was compiled for Emacs 19")) (byte-code "ÀÁ!„ÂÁ B‡" [boundp ledit-mode-map nil current-load-list] 2) #@43 File name for data sent to Lisp by Ledit. (defconst ledit-zap-file (byte-code "ÀÁ ÂQ‡" ["/tmp/" user-login-name ".l1"] 3) (#$ . 556)) #@43 File name for data sent to Ledit by Lisp. (defconst ledit-read-file (byte-code "ÀÁ ÂQ‡" ["/tmp/" user-login-name ".l2"] 3) (#$ . 696)) #@52 File name for data sent to Lisp compiler by Ledit. (defconst ledit-compile-file (byte-code "ÀÁ ÂQ‡" ["/tmp/" user-login-name ".l4"] 3) (#$ . 837)) #@65 Name of buffer in which Ledit accumulates data to send to Lisp. (defconst ledit-buffer "*LEDIT*" (#$ . 990)) #@69 *Non-nil means Ledit should save files before transferring to Lisp. (defconst ledit-save-files t (#$ . -1105)) #@48 *Shell commands to execute to resume Lisp job. (defconst ledit-go-to-lisp-string "%?lisp" (#$ . -1222)) #@57 *Shell commands to execute to resume Lisp compiler job. (defconst ledit-go-to-liszt-string "%?liszt" (#$ . -1332)) #@44 Save the current defun in the ledit buffer (defalias 'ledit-save-defun #[nil "ŠÀ ˆ` ˆÃ\f` #ˆ)ÅÆ!)‡" [end-of-defun end beginning-of-defun append-to-buffer ledit-buffer message "Current defun saved for Lisp"] 4 (#$ . 1453) nil]) #@45 Save the current region in the ledit buffer (defalias 'ledit-save-region #[(beg end) "À \n #ˆÄÅ!‡" [append-to-buffer ledit-buffer beg end message "Region saved for Lisp"] 4 (#$ . 1688) "r"]) #@34 Carry the current defun to Lisp. (defalias 'ledit-zap-defun-to-lisp #[nil "À ˆÁ ‡" [ledit-save-defun ledit-go-to-lisp] 1 (#$ . 1885) nil]) #@35 Carry the current defun to liszt. (defalias 'ledit-zap-defun-to-liszt #[nil "À ˆÁ ‡" [ledit-save-defun ledit-go-to-liszt] 1 (#$ . 2030) nil]) #@35 Carry the current region to Lisp. (defalias 'ledit-zap-region-to-lisp #[(beg end) "À \n\"ˆÃ ‡" [ledit-save-region beg end ledit-go-to-lisp] 3 (#$ . 2178) "r"]) #@47 Suspend Emacs and restart a waiting Lisp job. (defalias 'ledit-go-to-lisp #[nil "ƒÁ ˆÂ !ƒŠ qˆebˆÄed #ˆÆ ˆ)Ç!ˆÉ\nˉ#‡" [ledit-save-files save-some-buffers get-buffer ledit-buffer write-region ledit-zap-file erase-buffer suspend-emacs ledit-go-to-lisp-string load ledit-read-file t] 4 (#$ . 2344) nil]) #@48 Suspend Emacs and restart a waiting Liszt job. (defalias 'ledit-go-to-liszt #[nil "ƒÁ ˆÂ !ƒ\"Š qˆebˆÄcˆÅed#ˆÇ ˆ)È !ˆÊ ̉#‡" [ledit-save-files save-some-buffers get-buffer ledit-buffer "(declare (macros t))\n" write-region ledit-compile-file erase-buffer suspend-emacs ledit-go-to-liszt-string load ledit-read-file t] 4 (#$ . 2659) nil]) #@51 Set up key bindings for the Lisp/Emacs interface. (defalias 'ledit-setup #[nil "„ Á \n¤ÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#‡" [ledit-mode-map make-sparse-keymap shared-lisp-mode-map define-key "" ledit-save-defun "" ledit-save-region "z" ledit-go-to-lisp "" ledit-go-to-liszt] 4 (#$ . 3010)]) (ledit-setup) #@577 \Major mode for editing text and stuffing it to a Lisp job. Like Lisp mode, plus these special commands: \[ledit-save-defun] -- record defun at or after point for later transmission to Lisp job. \[ledit-save-region] -- record region for later transmission to Lisp job. \[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text. \[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job and transmit saved text. \{ledit-mode-map} To make Lisp mode automatically change to Ledit mode, do (setq lisp-mode-hook 'ledit-from-lisp-mode) (defalias 'ledit-mode #[nil "À ˆÁ ‡" [lisp-mode ledit-from-lisp-mode] 1 (#$ . 3321) nil]) (defalias 'ledit-from-lisp-mode #[nil "À !ˆÂÄÆÇ!‡" [use-local-map ledit-mode-map "Ledit" mode-name ledit-mode major-mode run-hooks ledit-mode-hook] 2]) emacs-19.30/lisp/levents.elc100666 12120 1 17160 6021171234 14243 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Aug 30 19:21:59 1995 ;;; from file /home/fsf/rms/e19/lisp/levents.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`levents.el' was compiled for Emacs 19.29 or later")) (defalias 'next-command-event #[(event) "ÀÁ!‡" [error "You must rewrite to use `read-command-event' instead of `next-command-event'"] 2]) (defalias 'next-event #[(event) "ÀÁ!‡" [error "You must rewrite to use `read-event' instead of `next-event'"] 2]) (defalias 'dispatch-event #[(event) "ÀÁ!‡" [error "`dispatch-event' not supported"] 2]) (byte-code "À ÂÃ#ˆÀ ÄÃ#ˆÀ ÅÃ#‡" [define-key global-map [menu] execute-eval-event [timeout] [eval]] 4) (defalias 'execute-eval-event #[(event) "A@Á8!‡" [event 2] 3 nil "e"]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#‡" [put eval event-symbol-elements (eval) menu (eval) timeout (eval)] 4) #@70 Returns an empty event structure. In this emulation, it returns nil. (defalias 'allocate-event #[nil "À‡" [nil] 1 (#$ . 1086)]) #@60 True if the argument is a mouse-button-press event object. (defalias 'button-press-event-p #[(obj) ":…@9…Á@ÂN>‡" [obj down event-symbol-elements] 3 (#$ . 1220)]) #@62 True if the argument is a mouse-button-release event object. (defalias 'button-release-event-p #[(obj) ":…@9…Á@ÂN>†Ã@ÂN>‡" [obj click event-symbol-elements drag] 3 (#$ . 1395)]) #@497 Converts a numeric ASCII value to an event structure, replete with bucky bits. The character is the first argument, and the event to fill in is the second. This function contains knowledge about what the codes mean -- for example, the number 9 is converted to the character Tab, not the distinct character Control-I. Beware that character-to-event and event-to-character are not strictly inverse functions, since events contain much more information than the ASCII character set can encode. (defalias 'character-to-event #[(ch &optional event) "‡" [ch] 1 (#$ . 1590)]) #@99 Make a copy of the given event object. In this emulation, `copy-event' just returns its argument. (defalias 'copy-event #[(event1 &optional event2) "‡" [event1] 1 (#$ . 2171)]) #@472 Allow the given event structure to be reused. In actual Lucid Emacs, you MUST NOT use this event object after calling this function with it. You will lose. It is not necessary to call this function, as event objects are garbage- collected like all other objects; however, it may be more efficient to explicitly deallocate events when you are sure that that is safe. This emulation does not actually deallocate or reuse events except via garbage collection and `cons'. (defalias 'deallocate-event #[(event) "À‡" [nil] 1 (#$ . 2356)]) #@102 Add an eval event to the back of the queue. It will be the next event read after all pending events. (defalias 'enqueue-eval-event: #[(function object) "Á\n EC¤‰‡" [unread-command-events eval function object] 4 (#$ . 2899)]) #@55 True if the argument is an eval or menu event object. (defalias 'eval-event-p #[(obj) "¢Á=‡" [obj eval] 2 (#$ . 3132)]) #@65 Return the button-number of the given mouse-button-press event. (defalias 'event-button #[(event) "@ÁN@‰ÞA)‡" [event event-symbol-elements sym ((mouse-1 . 1) (mouse-2 . 2) (mouse-3 . 3) (mouse-4 . 4) (mouse-5 . 5))] 3 (#$ . 3259)]) #@73 Return the callback function of the given timeout, menu, or eval event. (defalias 'event-function #[(event) "A@‡" [event] 1 (#$ . 3500)]) #@121 Returns the KeySym of the given key-press event. The value is an ASCII printing character (not upper case) or a symbol. (defalias 'event-key #[(event) "9ƒ\nÁN@‡ÂÃÄÅ\"S\"‰ÇWƒ\"ÈÉ\"‚$—)‡" [event event-symbol-elements logand lsh 1 18 base 32 logior 64] 6 (#$ . 3646)]) #@74 Returns the function argument of the given timeout, menu, or eval event. (defalias 'event-object #[(event) "À 8‡" [2 event] 2 (#$ . 3930)]) #@238 Returns the character position of the given mouse-related event. If the event did not occur over a window, or did not occur over text, then this returns nil. Otherwise, it returns an index into the buffer visible in the event's window. (defalias 'event-point #[(event) "Á8:ƒ Á‚Â8)‰A@:ƒ A@@‚# A@)‡" [event 2 1 position] 3 (#$ . 4077)]) #@56 Returns the process of the given process-output event. (defalias 'event-process #[(event) "A@‡" [event] 1 (#$ . 4430)]) #@164 Returns the timestamp of the given event object. In Lucid Emacs, this works for any kind of event. In this emulation, it returns nil for non-mouse-related events. (defalias 'event-timestamp #[(event) "<…Á8:ƒÁ‚Â8)Ä 8)‡" [event 2 1 position 3] 2 (#$ . 4558)]) #@535 Returns the closest ASCII approximation to the given event object. If the event isn't a keypress, this returns nil. If the second argument is non-nil, then this is lenient in its translation; it will ignore modifier keys other than control and meta, and will ignore the shift modifier on those characters which have no shifted ASCII equivalent (Control-Shift-A for example, will be mapped to the same ASCII code as Control-A.) If the second arg is nil, then nil will be returned for events which have no direct ASCII equivalent. (defalias 'event-to-character #[(event &optional lenient) "9ƒ …žA‡¨…‡" [event lenient ((backspace . 8) (delete . 127) (tab . 9) (return . 10) (enter . 10))] 2 (#$ . 4835)]) #@61 Returns the window of the given mouse-related event object. (defalias 'event-window #[(event) "Á8:ƒ Á‚Â8)‰@)‡" [event 2 1 position] 3 (#$ . 5559)]) #@72 Returns the X position in characters of the given mouse-related event. (defalias 'event-x #[(event) "À  8:ƒ‚à 8)!@ÄÅÆ !!!¥‡" [posn-col-row event 2 1 frame-char-width window-frame event-window] 5 (#$ . 5721)]) #@68 Returns the X position in pixels of the given mouse-related event. (defalias 'event-x-pixel #[(event) "À  8:ƒ‚à 8)!@‡" [posn-col-row event 2 1] 3 (#$ . 5943)]) #@72 Returns the Y position in characters of the given mouse-related event. (defalias 'event-y #[(event) "À  8:ƒ‚à 8)!AÄÅÆ !!!¥‡" [posn-col-row event 2 1 frame-char-height window-frame event-window] 5 (#$ . 6116)]) #@68 Returns the Y position in pixels of the given mouse-related event. (defalias 'event-y-pixel #[(event) "À  8:ƒ‚à 8)!A‡" [posn-col-row event 2 1] 3 (#$ . 6339)]) #@50 True if the argument is a keyboard event object. (defalias 'key-press-event-p #[(obj) "¨† 9… ÁN‡" [obj event-symbol-elements] 2 (#$ . 6512)]) #@46 True if the argument is a menu event object. (defalias 'menu-event-p #[(obj) "¢Á=‡" [obj menu] 2 (#$ . 6665)]) #@54 True if the argument is a mouse-motion event object. (defalias 'motion-event-p #[(obj) "¢Á=‡" [obj mouse-movement] 2 (#$ . 6783)]) #@225 Return the next keyboard or mouse event; execute other events. This is similar to the function `next-command-event' of Lucid Emacs, but different in that it returns the event rather than filling in an existing event object. (defalias 'read-command-event #[nil "À à !„CÄ !„CÅ !„CÆ !„C ¢‰È=ƒ2 A@É 8!ˆ‚?Ê=ƒ?Ë A@!ˆ)‚ )‡" [nil event read-event key-press-event-p button-press-event-p button-release-event-p menu-event-p type eval 2 switch-frame select-frame] 4 (#$ . 6922)]) #@120 True if the argument is a process-output event object. GNU Emacs 19 does not currently generate process-output events. (defalias 'process-event-p #[(obj) "¢Á=‡" [obj process] 2 (#$ . 7414)]) #@106 True if the argument is a timeout event object. GNU Emacs 19 does not currently generate timeout events. (defalias 'timeout-event-p #[(obj) "¢Á=‡" [obj timeout] 2 (#$ . 7613)]) emacs-19.30/lisp/life.elc100666 13437 1 12610 6021171244 13632 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Aug 30 19:22:05 1995 ;;; from file /home/fsf/rms/e19/lisp/life.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`life.el' was compiled for Emacs 19.29 or later")) #@61 Vector of rectangles containing some Life startup patterns. (defconst life-patterns [("@@@" " @@" "@@@") ("@@@ @@@" "@@ @@ " "@@@ @@@") ("@@@ @@@" "@@ @@" "@@@ @@@") ("@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@") ("@@@@@@@@@@") (" @@@@@@@@@@ " " @@@@@@@@@@ " " @@@@@@@@@@ " "@@@@@@@@@@ " "@@@@@@@@@@ ") ("@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@") ("@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @") ("@@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@") ("@@@@@@@@@" "@ @ @" "@ @@@@@ @" "@ @ @ @" "@@@ @@@" "@ @ @ @" "@ @@@@@ @" "@ @ @" "@@@@@@@@@")] (#$ . 463)) (defalias 'life-life-char '(macro . #[nil "À‡" [64] 1])) (defalias 'life-death-char '(macro . #[nil "À‡" [65] 1])) (defalias 'life-birth-char '(macro . #[nil "À‡" [3] 1])) (defalias 'life-void-char '(macro . #[nil "À‡" [32] 1])) (defalias 'life-life-string '(macro . #[nil "ÀÁ!‡" [char-to-string 64] 2])) (defalias 'life-death-string '(macro . #[nil "ÀÁ!‡" [char-to-string 65] 2])) (defalias 'life-birth-string '(macro . #[nil "ÀÁ!‡" [char-to-string 3] 2])) (defalias 'life-void-string '(macro . #[nil "ÀÁ!‡" [char-to-string 32] 2])) (defalias 'life-not-void-regexp '(macro . #[nil "ÀÁÂQ‡" ["[^" " " "\n]"] 3])) (defalias 'life-increment '(macro . #[(variable) "À  DE‡" [setq variable 1+] 4])) (byte-code "ÀÁ\nBÀÃ\nBÀÄ\nBÀÅ\nBÀ‡" [nil life-neighbor-deltas current-load-list life-window-start life-current-generation life-generation-string] 2) #@47 Non-nil if `life' has been run at least once. (defvar life-initialized nil (#$ . 2466)) #@206 Run Conway's Life simulation. The starting pattern is randomly selected. Prefix arg (optional first arg non-nil from a program) is the number of seconds to sleep between generations (this defaults to 1). (defalias 'life #[(&optional sleeptime) "„ÁÂ!ˆÂ „ÄÅ ˆÆ !ˆÇȇ" [life-initialized random t sleeptime 1 life-setup life-display-generation life-exit (byte-code "À ˆÃ ˆÄ ˆÅ!ˆ)‚" [t inhibit-quit life-grim-reaper life-expand-plane-if-needed life-increment-generation life-display-generation sleeptime] 2)] 2 (#$ . 2561) "p"]) (byte-code "ÀÁÂ\"ˆÃÁÄÅ#‡" [defalias life-mode life put mode-class special] 4) (defalias 'life-setup #[nil "ÀÂÃÄ!Å\"ˆÆ ˆÇ ˆÀÉ\nË\fÅ ÎÐÒÔ SÖØp!ˆÙ ˆebˆÚÛÀÅ#ƒGÜÝʼn#ˆ‚6ebˆŠÀˆ`)ZÞ¥m„c jˆÀyˆ‚Vß Sàed\"ZÞ¥ebˆá !ˆdbˆá !ˆebˆm„œÀˆjˆâ!ˆ`Àˆ`|ˆÀyˆ‚ãed\"ˆä ˆå )‡" [nil n switch-to-buffer get-buffer-create "*Life*" t erase-buffer kill-all-local-variables case-fold-search "Life" mode-name life-mode major-mode truncate-lines 0 life-current-generation "0" life-generation-string ("Life: generation " life-generation-string) mode-line-buffer-identification window-width fill-column 1 life-window-start buffer-disable-undo life-insert-random-pattern re-search-forward "[^ \n]" replace-match "@" 2 window-height count-lines newline move-to-column untabify life-expand-plane-if-needed life-compute-neighbor-deltas] 4]) (defalias 'life-compute-neighbor-deltas #[nil "À [ T[ Â\\[à ‰T Â\\¯‰‡" [-1 fill-column 2 1 life-neighbor-deltas] 9]) (defalias 'life-insert-random-pattern #[nil "À  G!œ!ˆÃc‡" [insert-rectangle life-patterns random 10] 4]) (defalias 'life-increment-generation #[nil "TÁ!‰‡" [life-current-generation int-to-string life-generation-string] 2]) (defalias 'life-grim-reaper #[nil "ÀÁ!ˆebˆÁ‰‰‰‰ÇÈÁÉ#ƒ‹\nË`S\nƒy\f\n@\\‰f‰Ì=ƒB͉TÌÎÉ%ˆ‚r ÏWƒV͉T ‰TÉ%ˆ‚r ÐWƒi͉T ÐÉ%ˆ‚r ÑYƒr T\nA‰„& Ò>„Í\f‰TÑÓÉ%ˆ‚-Ë”„”Ô ˆÍÎdÐÌÉ%ˆÍÎdÎÌÉ%ˆÍÎdÕÌÉ%ˆÍÎdÏÑÉ%ˆÍÎdÓÌÉ%‡" [store-match-data nil list living-neighbors pivot char point search-forward "@" t life-neighbor-deltas 0 32 subst-char-in-region 1 3 9 64 (2 3) 65 life-extinct-quit 2] 7]) (defalias 'life-expand-plane-if-needed #[nil "ÀÁˆebˆÂÃ`\f‰Å\\\\\\Æ#ƒ0ebˆÇÈ\f\"ˆÉcˆÇÈ\f\"ˆÉcˆ\n\fË\\\\\ndbˆÌÃ`\fZ\fZÅZÆ#…]dbˆÇÈ\f\"ˆÉcˆÇÈ\f\"ˆÉcˆ\n\fË\\\\‰\n‡" [done (byte-code "ebˆm„BgÀ=„ÁˆhÀ=ƒ<ebˆm„,ÂcˆÁˆÂcˆÁuˆ‚ Ä\\ÅÆ!ˆÇ ˆÈÉÊ\"ˆÁyˆ‚Á‡" [64 nil 32 fill-column 2 scroll-left 1 life-compute-neighbor-deltas throw done t] 3) search-forward "@" fill-column 2 t insert-char 32 10 life-window-start 1 search-backward] 6]) (defalias 'life-display-generation #[(sleeptime) "bˆÁÂ!ˆÃ\f!Å=†ÆÇÈ\"‡" [life-window-start recenter 0 sit-for sleeptime t throw life-exit nil] 3]) (defalias 'life-extinct-quit #[nil "ÀÁ!ˆÂÃÄ\"‡" [life-display-generation 0 signal life-extinct nil] 3]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#ˆÆÇ!‡" [put life-extinct error-conditions (life-extinct quit) error-message "All life has perished" provide life] 4) emacs-19.30/lisp/lisp-mnt.elc100666 13437 1 12100 5770131641 14457 0ustar jimbdaemon;ELC ;;; compiled by kwzh@nutrimat.gnu.ai.mit.edu on Thu Jun 15 18:26:36 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/lisp-mnt.el ;;; emacs version 19.28.94.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`lisp-mnt.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require picture emacsbug] 2) (defalias 'lm-section-mark #[(hd &optional after) "ŠÀebˆÂÃ\fÅQÆÀ#…ÇyˆƒÉyˆ`*‡" [t case-fold-search re-search-forward "^;;;;* " hd ":[ ]*$" nil 0 after 1] 4]) (defalias 'lm-code-mark #[nil "ÀÁ!‡" [lm-section-mark "Code"] 2]) (defalias 'lm-header #[(hd) "ebˆÀÂÃ\fÅQÆ À#…ǔǕ{)‡" [t case-fold-search re-search-forward "^;; " hd ": \\(.*\\)" lm-code-mark 1] 4]) (defalias 'lm-header-multiline #[(hd) "ŠebˆŠÀ !)‰ƒ(Ãyˆ\nCÄÅ!ƒ(ÔÕ{\nBÃyˆ‚\n*‡" [lm-header hd res 1 looking-at "^;; \\(.*\\)"] 3]) (defalias 'lm-summary #[(&optional file) "Šƒ Á!ˆebˆÂÃ!…Ĕĕ{ƒÅp!ˆ)‡" [file find-file looking-at "^;;; [^ ]+ --- \\(.*\\)" 1 kill-buffer] 3]) (defalias 'lm-crack-address #[(x) "ÀÁ\n\"ƒ\nÔÕO\nĔĕOB‡ÀÅ\n\"ƒ*\nĔĕO\nÔÕOB‡ÀÆ\n\"ƒ5Ç\nB‡\nÇB‡" [string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x 1 2 "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" "\\S-+@\\S-+" nil] 4]) (defalias 'lm-authors #[(&optional file) "Šƒ Á!ˆÂÃ!ÅÆ\f\"ƒÇp!ˆ*‡" [file find-file lm-header-multiline "author" authorlist mapcar lm-crack-address kill-buffer] 3]) (defalias 'lm-maintainer #[(&optional file) "Šƒ Á!ˆÂÃ!‰ƒÅ\f!‚Æ @)ƒ#Çp!ˆ)‡" [file find-file lm-header "maintainer" maint lm-crack-address lm-authors kill-buffer] 4]) (defalias 'lm-creation-date #[(&optional file) "Šƒ Á!ˆÂÃ!ƒÄp!ˆ)‡" [file find-file lm-header "created" kill-buffer] 3]) (defalias 'lm-last-modified-date #[(&optional file) "Šƒ Á!ˆebˆÂÃÄ Å#…+ÆÇȔȕ{Éʔʕ{!Ë8̔̕{$ƒ3Íp!ˆ)‡" [file find-file re-search-forward "\\$Id: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) " lm-code-mark t format "%s %s %s" 3 string-to-int 2 ("" "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") 1 kill-buffer] 6]) (defalias 'lm-version #[(&optional file) "Šƒ Á!ˆÂÃ!†AÄ ebˆÆÇ È#ƒ%ɔɕ{‚@ÆÊË!ÊÌÍ !!ÎQ È#ƒ?ɔɕ{‚@Ï)ƒIÐp!ˆ)‡" [file find-file lm-header "version" lm-code-mark header-max re-search-forward "\\$Id: [^ ]+ \\([^ ]+\\) " t 1 regexp-quote "@(#)" file-name-nondirectory buffer-file-name " \\([012345679.]*\\)" nil kill-buffer] 5]) (defalias 'lm-keywords #[(&optional file) "Šƒ Á!ˆÂÃ!‰…\f—)ƒÅp!ˆ)‡" [file find-file lm-header "keywords" keywords kill-buffer] 4]) (defalias 'lm-adapted-by #[(&optional file) "Šƒ Á!ˆÂÃ!ƒÄp!ˆ)‡" [file find-file lm-header "adapted-by" kill-buffer] 3]) (defalias 'lm-commentary #[(&optional file) "Šƒ Á!ˆÂÃÄ\"ÂÅ!ÂÆ!‰ …/ƒ* {‚/ {+ƒ8Êp!ˆ)‡" [file find-file lm-section-mark "Commentary" t "Change Log" "Code" code change-log commentary kill-buffer] 5]) (defalias 'insert-at-column #[(col &rest pieces) "iVƒ ÁcˆÂ!ˆÃÄ \"‡" [col "\n" move-to-column-force apply insert pieces] 3]) (byte-code "ÀÁ\nBÀ‡" [16 lm-comment-column current-load-list] 2) #@163 Check that the current buffer (or FILE if given) is in proper format. If FILE is a directory, recurse on its files and generate a report into a temporary buffer. (defalias 'lm-verify #[(&optional file showok) "ƒÁ!ƒÂÃÄ!!ˆÅ ˆÆÇÈ!\"‡Šƒ#É!ˆÊ „,Ë‚EÌ „5Í‚EdbˆÎyˆÏÐÑQ!…EÒƒMÓp!ˆ)‡" [file file-directory-p switch-to-buffer get-buffer-create "*lm-verify*" erase-buffer mapcar #[(f) "ÀÁ\n\"…-Ã\n!‰ƒ\nűˆÆ\fÈ#‚, …,\nűˆÆÊ\")‡" [string-match ".*\\.el$" f lm-verify status ":" insert-at-column lm-comment-column "\n" showok "OK\n"] 5] directory-files find-file lm-summary "Can't find a package summary" lm-code-mark "Can't find a code section marker" -1 looking-at ";;; " "ends here" "Can't find a footer line" kill-buffer] 4 (#$ . 3239)]) #@260 Generate a synopsis listing for the buffer or the given FILE if given. If FILE is a directory, recurse on its files and generate a report into a temporary buffer. If SHOWALL is on, also generate a line for files which do not include a recognizable synopsis. (defalias 'lm-synopsis #[(&optional file showall) "ƒÁ!ƒÂÃÄ!!ˆÅ ˆÆÇÈ!\"‡Šƒ#É!ˆÊ ƒ-Ëp!ˆ)‡" [file file-directory-p switch-to-buffer get-buffer-create "*lm-verify*" erase-buffer mapcar #[(f) "ÀÁ\n\"…-Ã\n!‰ƒ\nűˆÆ\fÈ#‚, …,\nűˆÆÊ\")‡" [string-match ".*\\.el$" f lm-synopsis syn ":" insert-at-column lm-comment-column "\n" showall "NA\n"] 5] directory-files find-file lm-summary kill-buffer] 4 (#$ . 4003)]) #@127 Report a bug in the package currently being visited to its maintainer. Prompts for bug subject. Leaves you in a mail buffer. (defalias 'lm-report-bug #[(topic) "À Á  ÆÇ\fƒ\f@È\fAÉR‚\n #ˆdbˆÌ ƒ.Í P‚/ÎϱˆÐÑÒ!!+‡" [buffer-name lm-maintainer lm-version version addr package mail nil " <" ">" bug-gnu-emacs topic "\nIn " " version " "" "\n\n" message substitute-command-keys "Type \\[mail-send] to send bug report."] 6 (#$ . 4696) "sBug Subject: "]) (provide (quote lisp-mnt)) emacs-19.30/lisp/lisp-mode.elc100666 13437 1 32652 6051034247 14620 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 00:45:57 1995 ;;; from file /home/fsf/rms/e19/lisp/lisp-mode.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`lisp-mode.el' was compiled for Emacs 19.29 or later")) #@2  (defvar lisp-mode-syntax-table nil (#$ . 477)) #@2  (defvar emacs-lisp-mode-syntax-table nil (#$ . 530)) #@2  (defvar lisp-mode-abbrev-table nil (#$ . 589)) (byte-code "„¼Áà \nÄWƒÅ\nÆ#ˆ\nT‰‚\nÇÇÈWƒ1Å\nÆ#ˆ\nT‰‚ÉÉÊWƒFÅ\nÆ#ˆ\nT‰‚4ËËÌWƒ[Å\nÆ#ˆ\nT‰‚IÅÍÎ#ˆÅÏÎ#ˆÅÐÑ#ˆÅÒÑ#ˆÅÓÔ#ˆÅÕÖ#ˆÅ×Ö#ˆÅØÖ#ˆÅÙÆ#ˆÅÚÖ#ˆÅÛÜ#ˆÅÝÞ#ˆÅßà#ˆÅáâ#ˆÅÉã#ˆÅäå#ˆ)&„Ûç!&Åèé&#ˆÅÉÆ&#ˆÅäÆ&#ˆêëì\"‡" [emacs-lisp-mode-syntax-table 0 i make-syntax-table 48 modify-syntax-entry "_ " 58 65 91 97 123 128 32 " " 9 10 "> " 13 59 "< " 96 "' " 39 44 46 35 34 "\" " 92 "\\ " 40 "() " 41 ")( " "(] " 93 ")[ " lisp-mode-syntax-table copy-syntax-table 124 "\" " define-abbrev-table lisp-mode-abbrev-table nil] 5) #@74 Imenu generic expression for Lisp mode. See `imenu-generic-expression'. (defvar lisp-imenu-generic-expression (quote ((nil "^\\s-*(def\\(un\\|subst\\|macro\\|advice\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2) ("Variables" "^\\s-*(def\\(var\\|const\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2) ("Types" "^\\s-*(def\\(type\\|struct\\|class\\|ine-condition\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2))) (#$ . 1215)) (defalias 'lisp-mode-variables #[(lisp-syntax) "ƒÁ\n!ˆ ÅÆ!ˆÈPÅÉ!ˆ ÅÊ!ˆË\nÅÌ!ˆÍ\fÅÎ!ˆÏÅÐ!ˆÑÅÒ!ˆËÅÓ!ˆÔÅÕ!ˆÖÅ×!ˆØÅÙ!ˆÚÅÛ!ˆÜÅÝ!ˆ‰‡" [lisp-syntax set-syntax-table lisp-mode-syntax-table lisp-mode-abbrev-table local-abbrev-table make-local-variable paragraph-start page-delimiter "\\|$" paragraph-separate paragraph-ignore-fill-prefix t fill-paragraph-function lisp-fill-paragraph indent-line-function lisp-indent-line indent-region-function lisp-indent-region parse-sexp-ignore-comments outline-regexp ";;; \\|(...." comment-start ";" comment-start-skip ";+ *" comment-column 40 comment-indent-function lisp-comment-indent imenu-generic-expression lisp-imenu-generic-expression] 2]) #@56 Keymap for commands shared by all sorts of Lisp modes. (defvar shared-lisp-mode-map nil (#$ . 2309)) (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÁ‡" [shared-lisp-mode-map make-sparse-keymap define-key "" indent-sexp "" backward-delete-char-untabify] 4) #@95 Keymap for Emacs Lisp mode. All commands in `shared-lisp-mode-map' are inherited by this map. (defvar emacs-lisp-mode-map nil (#$ . 2558)) (byte-code "„}ÁÂ!Á \f¤ÅÆÇ#ˆÅÈÉ#ˆÅÊÁ #ˆÅË B#ˆÅ ÌÍ#ˆÅ ÎÏ#ˆÅ ÐÑ#ˆÅ ÒÓ#ˆÅ ÔÕ#ˆÅ Ö×#ˆÅ ØÙ#ˆÅ ÚÛ#ˆÅ ÜÝ#ˆÅ Þß#ˆÅ àá#ˆâãäå#ˆâæäå#ˆâçäå#ˆ)Á‡" [emacs-lisp-mode-map make-sparse-keymap "Emacs-Lisp" map shared-lisp-mode-map define-key " " lisp-complete-symbol "" eval-defun [menu-bar] [menu-bar emacs-lisp] [edebug-defun] ("Instrument Function for Debugging" . edebug-defun) [byte-recompile] ("Byte-recompile Directory..." . byte-recompile-directory) [byte-compile] ("Byte-compile This File" . emacs-lisp-byte-compile) [separator-eval] ("--") [eval-buffer] ("Evaluate Buffer" . eval-current-buffer) [eval-region] ("Evaluate Region" . eval-region) [eval-sexp] ("Evaluate Last S-expression" . eval-last-sexp) [separator-format] ("--") [comment-region] ("Comment Out Region" . comment-region) [indent-region] ("Indent Region" . indent-region) [indent-line] ("Indent Line" . lisp-indent-line) put eval-region menu-enable mark-active comment-region indent-region] 5) #@54 Byte compile the file containing the current buffer. (defalias 'emacs-lisp-byte-compile #[nil "ƒÁ!‡ÂÃ!‡" [buffer-file-name byte-compile-file error "The buffer must be saved in a file first."] 2 (#$ . 3664) nil]) #@281 Major mode for editing Lisp code to run in Emacs. Commands: Delete converts tabs to spaces as it moves back. Blank lines separate paragraphs. Semicolons start comments. \{emacs-lisp-mode-map} Entry to this mode calls the value of `emacs-lisp-mode-hook' if that value is non-nil. (defalias 'emacs-lisp-mode #[nil "À ˆÁ\n!ˆÃ\f!ˆÅÇÉÊ!ˆËÌ!‡" [kill-all-local-variables use-local-map emacs-lisp-mode-map set-syntax-table emacs-lisp-mode-syntax-table emacs-lisp-mode major-mode "Emacs-Lisp" mode-name lisp-mode-variables nil run-hooks emacs-lisp-mode-hook] 2 (#$ . 3887) nil]) #@98 Keymap for ordinary Lisp mode. All commands in `shared-lisp-mode-map' are inherited by this map. (defvar lisp-mode-map nil (#$ . 4468)) (byte-code "„Á \n¤ÃÄÅ#ˆÃÆÇ#ˆÁ‡" [lisp-mode-map make-sparse-keymap shared-lisp-mode-map define-key "" lisp-eval-defun "" run-lisp] 4) #@398 Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp. Commands: Delete converts tabs to spaces as it moves back. Blank lines separate paragraphs. Semicolons start comments. \{lisp-mode-map} Note that `run-lisp' may be used either to start an inferior Lisp job or to switch back to an existing one. Entry to this mode calls the value of `lisp-mode-hook' if that value is non-nil. (defalias 'lisp-mode #[nil "À ˆÁ\n!ˆÃÅÇÈ!ˆÉ\n!ˆËÌ!‡" [kill-all-local-variables use-local-map lisp-mode-map lisp-mode major-mode "Lisp" mode-name lisp-mode-variables t set-syntax-table lisp-mode-syntax-table run-hooks lisp-mode-hook] 2 (#$ . 4754) nil]) #@65 Send the current defun to the Lisp process made by \[run-lisp]. (defalias 'lisp-eval-defun #[nil "ÀÁ!‡" [error "Process lisp does not exist"] 2 (#$ . 5414) nil]) #@100 Keymap for Lisp Interaction moe. All commands in `shared-lisp-mode-map' are inherited by this map. (defvar lisp-interaction-mode-map nil (#$ . 5583)) (byte-code "„Á \n¤ÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÁ‡" [lisp-interaction-mode-map make-sparse-keymap shared-lisp-mode-map define-key "" eval-defun " " lisp-complete-symbol "\n" eval-print-last-sexp] 4) #@451 Major mode for typing and evaluating Lisp forms. Like Lisp mode except that \[eval-print-last-sexp] evals the Lisp expression before point, and prints its value into the buffer, advancing point. Commands: Delete converts tabs to spaces as it moves back. Paragraphs are separated only by blank lines. Semicolons start comments. \{lisp-interaction-mode-map} Entry to this mode calls the value of `lisp-interaction-mode-hook' if that value is non-nil. (defalias 'lisp-interaction-mode #[nil "À ˆÁ\n!ˆÃÅÇ!ˆÉÊ!ˆËÌ!‡" [kill-all-local-variables use-local-map lisp-interaction-mode-map lisp-interaction-mode major-mode "Lisp Interaction" mode-name set-syntax-table emacs-lisp-mode-syntax-table lisp-mode-variables nil run-hooks lisp-interaction-mode-hook] 2 (#$ . 5934) nil]) #@62 Evaluate sexp before point; print value into current buffer. (defalias 'eval-print-last-sexp #[nil "pÁ ˆÂÃ!ˆÁ )‡" [standard-output terpri eval-last-sexp t] 2 (#$ . 6714) nil]) #@105 Evaluate sexp before point; print value in minibuffer. With argument, print output into current buffer. (defalias 'eval-last-sexp #[(eval-last-sexp-arg-internal) "ƒp‚ Á`ÄÅ ÇÈŽŠÉ\n!ˆËÌ!ˆŒe\n}ˆÍp!+!)!*‡" [eval-last-sexp-arg-internal t opoint standard-output prin1 syntax-table stab eval ((set-syntax-table stab)) set-syntax-table emacs-lisp-mode-syntax-table forward-sexp -1 read] 4 (#$ . 6898) "P"]) #@134 Evaluate defun that point is in or before. Print value in minibuffer. With argument, insert value in current buffer after the defun. (defalias 'eval-defun #[(eval-defun-arg-internal) "ƒp‚ ÁŠÂ ˆÃ ˆÄp!) @Ç=ƒ) ££ƒ)È ABÉÊ !!*‡" [eval-defun-arg-internal t end-of-defun beginning-of-defun read form standard-output defvar defconst prin1 eval] 3 (#$ . 7313) "P"]) (defalias 'lisp-comment-indent #[nil "ÀÁ!ƒi‡ÀÂ!ƒà ‰<ƒ\f@‚\f)‡ÅÆxˆnƒ*Ç‚,iT]‡" [looking-at "\\s<\\s<\\s<" "\\s<\\s<" calculate-lisp-indent tem " " nil 0 comment-column] 3]) #@2  (defconst lisp-indent-offset nil (#$ . 7870)) #@2  (defconst lisp-indent-function (quote lisp-indent-function) (#$ . 7922)) #@130 Indent current line as Lisp code. With argument, indent any additional lines of the same expression rigidly along with this one. (defalias 'lisp-indent-line #[(&optional whole-exp) "À Á‰‰d`ZÇyˆ`ÈÁwˆÉÊ!ƒ$d\nZb‚ŽÉË!ƒ9ÉÌ!„9Í ˆÎuˆ‚W<ƒD@iZ‰ÇU„W\f`|ˆjˆd\nZ`Vƒdd\nZbˆ…Ž ÇU?…ŽŠ\fbˆÐÑ!ˆ`\fbˆÑyˆ` \fV)…ŽÒ\f #-‡" [calculate-lisp-indent nil pos end beg shift-amt indent 0 " " looking-at "\\s<\\s<\\s<" "\\s<" "\\s<\\s<" indent-for-comment -1 whole-exp forward-sexp 1 indent-code-rigidly] 7 (#$ . 8003) "P"]) (byte-code "À BÀ‡" [calculate-lisp-indent-last-sexp current-load-list] 2) #@398 Return appropriate indentation for current line as Lisp code. In usual case returns an integer: the column to indent to. Can instead return a list, whose car is the column to indent to. This means that following lines at the same level of indentation should not necessarily be indented the same way. The second element of the list is the buffer position of the start of the containing expression. (defalias 'calculate-lisp-indent #[(&optional parse-start) "ŠÀyˆ`Á‰‰ÂÁ‰ \nƒ\"\nbˆ‚%Ë ˆ` Wƒ7Ì` À#‚% ƒ~ƒ~Àœ‰ÀVƒ~Á͜Μ‰Tbˆ\fƒ7\f`Vƒ7Ì\f À#‰A@‰ƒz)‚7 „Ï Tbˆ\f„i‚ÏÌ`\fÀÂ$ˆÐÑ!„ÏŠÎyˆ`)\fVƒ¿`\fU„¹ÒÎ!ˆÌ`\fÀÂ$ˆÓ ˆ‚Ï\fbˆÀyˆÌ`\fÀÂ$ˆÓ ˆiÕœƒå bˆÖÁwˆi‚¨ƒù ƒù bˆi\\‚†ØÙ!ƒƒ „ \"†‚. ‡" [0 nil t containing-sexp calculate-lisp-indent-last-sexp retry desired-indent paren-depth state indent-point parse-start beginning-of-defun parse-partial-sexp 2 1 peek looking-at "\\s(" forward-sexp backward-prefix-chars normal-indent 3 " " lisp-indent-offset boundp lisp-indent-function] 8 (#$ . 8616)]) (defalias 'lisp-indent-function #[(indent-point state) "i ÂœTbˆÃ`\fÅÆ$ˆ Çœƒ:ÈÉ!„:ŠÂyˆ`)\fV„3\fbˆÅyˆÃ`\fÅÆ$ˆÊ ˆi‚—`ËÂ!ˆ`{Ì Ï!ÐN†UÏ!ÑN‰ Ò=„r „zGÓVƒzÔÕ\"ƒzÖ \"‚– ¨ƒ‹Ø $‚– …– \"*)‡" [normal-indent state 1 parse-partial-sexp calculate-lisp-indent-last-sexp 0 t 2 looking-at "\\sw\\|\\s_" backward-prefix-chars forward-sexp nil method function intern-soft lisp-indent-function lisp-indent-hook defun 3 string-match "\\`def" lisp-indent-defform indent-point lisp-indent-specform] 6]) #@67 Number of columns to indent the second line of a `(def...)' form. (defconst lisp-body-indent 2 (#$ . 10208)) (defalias 'lisp-indent-specform #[(count state indent-point normal-indent) "Áœ\nɉbˆi\f\\ÁuˆÉÁ!ˆÊ` ÁÌ$ˆ` Wƒ3ÃÍ΄%\nÏVƒV\nZÁXƒN\f‰\\\\D‚vD‚vÏUƒc\nÏU„p\nÏUƒt Xƒt ‚v,‡" [state 1 count nil containing-form-column body-indent i containing-form-start lisp-body-indent forward-sexp parse-partial-sexp indent-point t (byte-code "SÁÂ!ˆÃ`\fÂÅ$‡" [count forward-sexp 1 parse-partial-sexp indent-point t] 5) ((error)) 0 normal-indent] 6]) (defalias 'lisp-indent-defform #[(state indent-point) "A@bˆÁyˆ`AA@V…A@bˆ\ni\\‡" [state 1 lisp-body-indent] 2]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÆ#ˆÀÇÂÈ#ˆÀÉÂÊ#ˆÀËÂÆ#ˆÀÌÂÆ#ˆÀÍÂÆ#ˆÀÎÂÆ#ˆÀÏÂÆ#ˆÀÐÂÈ#ˆÀÑÂÈ#ˆÀÒÂÈ#ˆÀÓÂÊ#ˆÀÔÂÈ#ˆÀÕÂÊ#ˆÀÖÂÈ#ˆÀ×ÂÈ#‡" [put lambda lisp-indent-function defun autoload progn 0 prog1 1 prog2 2 save-excursion save-window-excursion save-selected-window save-restriction save-match-data let let* while if catch condition-case unwind-protect with-output-to-temp-buffer] 4) #@145 Indent each line of the list starting just after point. If optional arg ENDPOS is given, indent each line, stopping when ENDPOS is encountered. (defalias 'indent-sexp #[(&optional endpos) "ÀCÁ\n?… ``À‰‰‰‰‰ \n \f\n„+ŠÍÎ!ˆ)ŠÀ\nƒ9`\nW‚<?…p À „‹m‰„‹Ï`Àˆ`À‰\f%‰@ Ð\f›@ƒrÑ ˆÀˆÐ\f›À ˆÒ\f›@ƒ…ÎyˆÓ\f›À ˆ‚EÔ‰ƒI\nƒ¬ ÁXƒ¬Õ\fÖ [À\"\"\f ZÁ „»\n„» ÁXƒÆÎyˆ‚[ VƒÜ\fA\fS‰‚È WƒóÀ\fB\fT‰‚ÞÎyˆ`×Àwˆm„[ØÙ!„[\f@ƒ\f@ÁYƒ\f@‚MÚ\f@ƒ*\f@[‚,\n!‰¨ƒ?\f‰ ˆ‚L\fA@[ ˆ@)i U„[`|ˆ jˆ„/` U‰„/` ‚/. ‡" [nil 0 endpos this-indent state inner-loop-done outer-loop-done bol last-depth last-point starting-point next-depth indent-stack forward-sexp 1 parse-partial-sexp 4 indent-for-comment 3 5 t append make-list " " looking-at "\\s<\\|\n" calculate-lisp-indent val] 11 (#$ . 11280) nil]) (defalias 'lisp-indent-region #[(start end) "ŠÀ ! bˆnƒl„Ä ˆÅ\n!ˆ\nƉ“*‡" [copy-marker end endmark start lisp-indent-line indent-sexp nil] 3]) #@217 Like \[fill-paragraph], but handle Emacs Lisp comments. If any of the current line is a comment, fill the comment or the paragraph of it that point is in, preserving the comment's indentation and initial semicolons. (defalias 'lisp-fill-paragraph #[(&optional justify) "À‰ŠÃyˆÄÅ!ƒÆÔÕ{‚QÄÇ!„>ÈÀwˆ`fÉ=ƒ0Êuˆ‚`fË>ƒÌÍ!ˆ‚ÄÎ!ƒQÆÏiÐ\"ÔÕ{P)\n„^Ñ!ˆ‚›ŒŠÓyÃUƒmÄÔ!„`ÄÔ!„vÍyˆ`)ŠÍyˆÄÔ!„y`)}ˆÖPÖP Ñ!ˆ,*Ƈ" [nil comment-fill-prefix has-comment 0 looking-at "[ ]*;[; ]*" t ";\\|$" "^;\n\"\\\\?" 92 2 (34 63) forward-sexp 1 ";+[ ]*" make-string 32 fill-paragraph justify -1 "^[ ]*;" paragraph-start "\\|[ ;]*$" fill-prefix paragraph-separate] 3 (#$ . 12309) "P"]) #@366 Indent all lines of code, starting in the region, sideways by ARG columns. Does not affect lines starting inside comments or strings, assuming that the start of the region is not inside them. Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP. The last is a regexp which, if matched at the beginning of a line, means don't indent that line. (defalias 'indent-code-rigidly #[(start end arg &optional nochange-regexp) "ÀŠ\nbˆÃ \fbˆn„Å`Æyˆ`À‰ %`\nW…^Ç ›@„Pƒ4É!„PÊ  `ÌÀwˆ`|ˆl„OÍÎ \\]Î\"ˆ)Å`Æyˆ`À‰ %‚*‡" [nil state end point-marker start parse-partial-sexp 1 3 nochange-regexp looking-at current-indentation indent " " indent-to 0 arg] 6 (#$ . 13008) "r\np"]) (provide (quote lisp-mode)) emacs-19.30/lisp/lisp.elc100666 13437 1 16761 5744576607 13724 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:45:09 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/lisp.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/lisp.el' was compiled for Emacs 19")) #@172 *Non-nil => regexp to ignore, before the character that starts a defun. This is only necessary if the opening paren or brace is not in column 0. See `beginning-of-defun'. (defvar defun-prompt-regexp nil (#$ . -478)) (make-variable-buffer-local (quote defun-prompt-regexp)) #@69 Non-nil => `insert-parentheses' should insert whitespace as needed. (defvar parens-require-spaces t (#$ . 757)) #@159 Move forward across one balanced expression (sexp). With argument, do it that many times. Negative arg -N means move backward across N balanced expressions. (defalias 'forward-sexp #[(&optional arg) "„ÁÂ`\"†Ã!bˆÄW…Å ‡" [arg 1 scan-sexps buffer-end 0 backward-prefix-chars] 3 (#$ . 876) "p"]) #@159 Move backward across one balanced expression (sexp). With argument, do it that many times. Negative arg -N means move forward across N balanced expressions. (defalias 'backward-sexp #[(&optional arg) "„ÁÂ[!‡" [arg 1 forward-sexp] 2 (#$ . 1187) "p"]) #@124 Set mark ARG sexps from point. The place mark goes is the same place \[forward-sexp] would move to with the same argument. (defalias 'mark-sexp #[(arg) "ÀŠÁ\n!ˆ`)ÃÄ#‡" [push-mark forward-sexp arg nil t] 4 (#$ . 1450) "p"]) #@162 Move forward across one balanced group of parentheses. With argument, do it that many times. Negative arg -N means move backward across N groups of parentheses. (defalias 'forward-list #[(&optional arg) "„ÁÂ`Ã#†Ä!b‡" [arg 1 scan-lists 0 buffer-end] 4 (#$ . 1680) "p"]) #@162 Move backward across one balanced group of parentheses. With argument, do it that many times. Negative arg -N means move forward across N groups of parentheses. (defalias 'backward-list #[(&optional arg) "„ÁÂ[!‡" [arg 1 forward-list] 2 (#$ . 1964) "p"]) #@195 Move forward down one level of parentheses. With argument, do this that many times. A negative argument means move backward but still go down a level. In Lisp programs, an argument is required. (defalias 'down-list #[(arg) "ÁVƒ\n‚ ÃÁU?…(Å`\fÃ#†Æ!bˆ\fZ‰‚ )‡" [arg 0 1 -1 inc scan-lists buffer-end] 5 (#$ . 2230) "p"]) #@201 Move backward out of one level of parentheses. With argument, do this that many times. A negative argument means move forward but still to a less deep spot. In Lisp programs, an argument is required. (defalias 'backward-up-list #[(arg) "À [!‡" [up-list arg] 2 (#$ . 2567) "p"]) #@201 Move forward out of one level of parentheses. With argument, do this that many times. A negative argument means move backward but still to a less deep spot. In Lisp programs, an argument is required. (defalias 'up-list #[(arg) "ÁVƒ\n‚ ÃÁU?…(Å`\fÂ#†Æ!bˆ\fZ‰‚ )‡" [arg 0 1 -1 inc scan-lists buffer-end] 5 (#$ . 2852) "p"]) #@167 Kill the sexp (balanced expression) following the cursor. With argument, kill that many sexps after the cursor. Negative arg -N means kill N sexps before the cursor. (defalias 'kill-sexp #[(arg) "`Á\n!ˆÃ`\")‡" [opoint forward-sexp arg kill-region] 3 (#$ . 3193) "p"]) #@167 Kill the sexp (balanced expression) preceding the cursor. With argument, kill that many sexps before the cursor. Negative arg -N means kill N sexps after the cursor. (defalias 'backward-kill-sexp #[(arg) "À [!‡" [kill-sexp arg] 2 (#$ . 3470) "p"]) #@484 Move backward to the beginning of a defun. With argument, do it that many times. Negative arg -N means move forward to Nth following beginning of defun. Returns t unless search stops due to beginning or end of buffer. Normally a defun starts when there is an char with open-parenthesis syntax at the beginning of a line. If `defun-prompt-regexp' is non-nil, then a string which matches that regexp may precede the open-parenthesis, and point ends up at the beginning of the line. (defalias 'beginning-of-defun #[(&optional arg) "À !…\nÂyˆÃ‡" [beginning-of-defun-raw arg 0 t] 2 (#$ . 3725) "p"]) #@191 Move point to the character that starts a defun. This is identical to beginning-of-defun, except that point does not move to the beginning of the line when `defun-prompt-regexp' is non-nil. (defalias 'beginning-of-defun-raw #[(&optional arg) "ƒÁWƒm„ÂuˆÃ\fƒÅÆ\fÇR‚ÈÉʆ&Â$…2Á•Sb…2ˇ" [arg 0 1 re-search-backward defun-prompt-regexp "^\\s(\\|" "\\(" "\\)\\s(" "^\\s(" nil move t] 5 (#$ . 4331) "p"]) (defalias 'buffer-end #[(arg) "ÁVƒd‡e‡" [arg 0] 2]) #@284 Move forward to next end of defun. With argument, do it that many times. Negative argument -N means move back to Nth preceding end of defun. An end of a defun occurs right after the close-parenthesis that matches the open-parenthesis that starts a defun; see `beginning-of-defun'. (defalias 'end-of-defun #[(&optional arg) "ƒ\nÁUƒ\fÂÃÁVƒZ`dWƒZ`Å\fƒ-ˆÈÂ!„8o„4ÉuˆÈÉ!ˆÅÊÂ!ˆËÅwˆÌÍ!ƒKÂyˆ`X„ *S‰‚ÁW…š`ÈÂ!ˆÎÂ!ˆÂyˆ`Yƒ’ÈÏ!ƒÊÂ!ˆËÅwˆÌÍ!ƒ’Âyˆ‚’ebˆ)T‰‚[)‡" [arg 0 1 t first nil npos pos beginning-of-defun-raw -1 forward-list " " looking-at "\\s<\\|\n" forward-sexp 2] 3 (#$ . 4806) "p"]) #@118 Put mark at end of this defun, point at beginning. The defun marked is the one that contains point or follows point. (defalias 'mark-defun #[nil "À`!ˆÁ ˆÀ`ÂÃ#ˆÄ ˆÅÆ`ÇZÃ#‡" [push-mark end-of-defun nil t beginning-of-defun re-search-backward "^\n" 1] 4 (#$ . 5433) nil]) #@280 Put parentheses around next ARG sexps. Leave point after open-paren. No argument is equivalent to zero: just insert `()' and leave point between. If `parens-require-spaces' is non-nil, this command also inserts a space before and after, depending on the surrounding characters. (defalias 'insert-parentheses #[(arg) "ƒ Á!‚ ÂÂ=„ÃÄwˆ ƒ)o„)hzÆ>ƒ)ÇcˆÈcˆŠÂ=„7É!ˆÊcˆ …Lm?…LgzË>…LÇc)‡" [arg prefix-numeric-value 0 " " nil parens-require-spaces (119 95 41) " " 40 forward-sexp 41 (119 95 40)] 2 (#$ . 5709) "P"]) #@73 Move past next `)', delete indentation before it, then indent after it. (defalias 'move-past-close-and-reindent #[nil "ÀÁ!ˆÂuˆŠ`Ä ˆ` U*ƒÅ ˆ‚ÁuˆÆ ‡" [up-list 1 -1 before-paren back-to-indentation delete-indentation newline-and-indent] 2 (#$ . 6240) nil]) #@354 Perform completion on Lisp symbol preceding point. Compare that symbol against the known Lisp symbols. The context determines which symbols are considered. If the symbol starts just after an open-parenthesis, only symbols with function definitions are considered. Otherwise, all symbols with function definitions, values or properties are considered. (defalias 'lisp-complete-symbol #[nil "`Á ÃŽŠÄ !ˆÆÇ!ˆgzÈUƒÇuˆ‚`*‰ {\n SfË=ƒ3Ì‚4ÍÏ\n#‰Ò=†¿„VÓÔ\n\"ˆÕ ‚¿\n˜„i |ˆc‚¿ÓÖ!ˆ×\n#ØÌ=„²Ûƒ¬ÌÝ@!!ƒ›@ÞD‚ž@BA‰„‰Ÿ)ßà!‘ˆ*Óáâ\".‡" [end syntax-table buffer-syntax ((set-syntax-table buffer-syntax)) set-syntax-table emacs-lisp-mode-syntax-table backward-sexp 1 39 beg pattern 40 fboundp #[(sym) "À !† !†à !‡" [boundp sym fboundp symbol-plist] 2] predicate try-completion obarray completion t message "Can't find completion for \"%s\"" ding "Making completion list..." all-completions #[nil "Še`ÀZ]bˆÁÂ!)…Ãu‡" [4 looking-at " " -4] 3] completion-fixup-function list nil new intern " " "*Completions*" display-completion-list "Making completion list...%s" "done"] 5 (#$ . 6506) nil]) emacs-19.30/lisp/lmenu.elc100666 13437 1 32063 5754705664 14064 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri May 12 12:23:57 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/lmenu.el ;;; emacs version 19.28.91.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/lmenu.el' was compiled for Emacs 19")) (byte-code "À BÂÀ‡" [current-menubar current-load-list recompute-lucid-menubar] 2) (defalias 'recompute-lucid-menubar #[nil "À ÂÃÄÅ#ˆÃ‰‡" [define-key lucid-menubar-map [menu-bar] nil (make-lucid-menu-keymap "menu-bar" current-menubar) ((error (byte-code "ÀÁ!ˆÂÃ!ˆ\fƉ‡" [message "Invalid data in current-menubar moved to lucid-failing-menubar" sit-for 1 current-menubar lucid-failing-menubar nil] 2))) lucid-menu-bar-dirty-flag] 6]) (byte-code "ÀÁ!„  Á BÄ ž„Ä B BÀ‡" [boundp lucid-menubar-map make-sparse-keymap current-load-list current-menubar minor-mode-map-alist] 2) (defalias 'set-menubar-dirty-flag #[nil "À ˆÁ‰‡" [force-mode-line-update t lucid-menu-bar-dirty-flag] 2]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BŇ" [boundp add-menu-item-count 0 current-load-list make-lucid-menu-keymap-disable nil] 2) (defalias 'make-lucid-menu-keymap #[(menu-name menu-items) "À !Ã\f!‰ƒ‚\f@ʼn‰‰ ;ƒ4ÅÊË \"ƒ-Ì‚/ ‚T :ƒLÍ @ A\" @‚TÎ !ƒTÏÐÑ\"!T ÓH ÔH‰9ƒ{Mˆ‚…ÕÅÖFMˆ× GWƒS HÙ=ƒµÚÛ TH†©Ü#ˆ×\\‰‚Š HÝ=ƒÉ×\\‰‚Š HÞ=ƒÝ×\\‰‚Š Hß=ƒñ×\\‰‚Š Hà=ƒ×\\‰‚Š H9ƒ(áâ H!!ãUƒ(äå H\"ˆ‚ˆ×UƒGÚÛ H†<Ü#ˆ G‰‚Šäæ H\"ˆ‚ˆ)„f\nÅD\nAB¡ˆ‚zƒzç\nèé!!B#ˆ,\fA‰„\f\n)‡" [make-sparse-keymap menu-name menu reverse menu-items nil callback name command item string-match "^-+$" "" make-lucid-menu-keymap vectorp make-symbol format "menu-function-%d" add-menu-item-count 0 1 lambda (interactive) 2 i :active put menu-enable make-lucid-menu-keymap-disable :suffix :keys :style :selected string-to-char symbol-name 58 error "Unrecognized menu item keyword: %S" "Unexpected menu item value: %S" define-key vector intern] 6]) #@2728 Pop up the given menu. A menu is a list of menu items, strings, and submenus. The first element of a menu must be a string, which is the name of the menu. This is the string that will be displayed in the parent menu, if any. For toplevel menus, it is ignored. This string is not displayed in the menu itself. A menu item is a vector containing: - the name of the menu item (a string); - the `callback' of that item; - a list of keywords with associated values: - :active active-p a form specifying whether this item is selectable; - :suffix suffix a string to be appended to the name as an `argument' to the command, like `Kill Buffer NAME'; - :keys command-keys a string, suitable for `substitute-command-keys', to specify the keyboard equivalent of a command when the callback is a form (this is not necessary when the callback is a symbol, as the keyboard equivalent is computed automatically in that case); - :style style a symbol: nil for a normal menu item, `toggle' for a toggle button (a single option that can be turned on or off), or `radio' for a radio button (one of a group of mutually exclusive options); - :selected form for `toggle' or `radio' style, a form that specifies whether the button will be in the selected state. Alternately, the vector may contain exactly 3 or 4 elements, with the third element specifying `active-p' and the fourth specifying `suffix'. If the `callback' of a menu item is a symbol, then it must name a command. It will be invoked with `call-interactively'. If it is a list, then it is evaluated with `eval'. If an element of a menu is a string, then that string will be presented in the menu as unselectable text. If an element of a menu is a string consisting solely of hyphens, then that item will be presented as a solid horizontal line. If an element of a menu is a list, it is treated as a submenu. The name of that submenu (the first element in the list) will be used as the name of the item representing this menu on the parent. The syntax, more precisely: form := command := callback := command | form active-p := text := name := suffix := command-keys := object-style := 'nil' | 'toggle' | 'radio' keyword := ':active' active-p | ':suffix' suffix | ':keys' command-keys | ':style' object-style | ':selected' form menu-item := '[' name callback active-p [ suffix ] ']' | '[' name callback [ keyword ]+ ']' menu := '(' name [ menu-item | menu | text ]+ ')' (defalias 'popup-menu #[(menu-desc) "À @ A\" É…OÈA@AAD@D\"‰…OÉÊË \"\"Ã\fƒÌ\f!ƒH\f‰‚Í\f!ˆ‚,‡" [make-lucid-menu-keymap menu-desc mouse-pixel-position nil cmd answer pos menu x-popup-menu lookup-key apply vector keymapp call-interactively] 6 (#$ . 2222)]) #@1159 Pop up a dialog box. A dialog box description is a list. - The first element of the list is a string to display in the dialog box. - The rest of the elements are descriptions of the dialog box's buttons. Each one is a vector of three elements: - The first element is the text of the button. - The second element is the `callback'. - The third element is t or nil, whether this button is selectable. If the `callback' of a button is a symbol, then it must name a command. It will be invoked with `call-interactively'. If it is a list, then it is evaluated with `eval'. One (and only one) of the buttons may be `nil'. This marker means that all following buttons should be flushright instead of flushleft. The syntax, more precisely: form := command := callback := command | form active-p := name := partition := 'nil' button := '[' name callback active-p ']' dialog := '(' name [ button ]+ [ partition [ button ]+ ] ')' (defalias 'popup-dialog-box #[(data) "@AÁ‰‰ ƒI @„Á\fB‚B @ÇH @ÈH @ÉH\n \f\nƒ<\f B‚>\f\fB+ A‰„ÍÎ\fŸB\"‰…d 9ƒaÏ !‚dÐ !-‡" [data nil meaning choice converted tail name 0 1 2 enable callback item x-popup-dialog t call-interactively eval] 6 (#$ . 5245)]) (byte-code "ÀÁ\nBÀ‡" [nil default-menubar current-load-list] 2) #@40 Set the default menubar to be menubar. (defalias 'set-menubar #[(menubar) "ÀÁ !\"ˆÄ ‡" [set-default current-menubar copy-sequence menubar set-menubar-dirty-flag] 4 (#$ . 6756)]) #@45 Set the buffer-local menubar to be menubar. (defalias 'set-buffer-menubar #[(menubar) "ÀÁ!ˆÂ !Ä ‡" [make-local-variable current-menubar copy-sequence menubar set-menubar-dirty-flag] 2 (#$ . 6941)]) #@177 Searches MENUBAR for item given by ITEM-PATH-LIST. Returns (ITEM . PARENT), where PARENT is the immediate parent of the item found. Signals an error if the item is not found. (defalias 'find-menu-item #[(menubar item-path-list &optional parent) "„ Á \"\f:??…’\fʼnƒ]@ƒT @È@!ƒ2@ÉH‚C@;ƒ?@‚C@@—šƒT@ʼn‚A‰„ Aƒ:ƒtÊA A#‚‘ƒƒËÌÍD\"‚‘ËÌÎ @D\"‚‘B*‡" [parent mapcar downcase item-path-list menubar nil result rest vectorp 0 find-menu-item signal error "not a submenu" "no such submenu"] 5 (#$ . 7147)]) #@312 Make the named menu item be unselectable. PATH is a list of strings which identify the position of the menu item in the menu hierarchy. ("File" "Save") means the menu item called "Save" under the toplevel "File" menu. ("Menu" "Foo" "Item") means the menu item called "Item" under the "Foo" submenu of "Menu". (defalias 'disable-menu-item #[(path) " \"‰@\fA „\"ÇÈƒÉ‚Ê D\"ˆ :ƒ+ÈË!ˆ ÌÍIˆÎ ˆ ,‡" [current-menubar menubar find-menu-item path pair item menu signal error "No such menu item" "No such menu" "can't disable menus, only menu items" 2 nil set-menubar-dirty-flag] 5 (#$ . 7707)]) #@310 Make the named menu item be selectable. PATH is a list of strings which identify the position of the menu item in the menu hierarchy. ("File" "Save") means the menu item called "Save" under the toplevel "File" menu. ("Menu" "Foo" "Item") means the menu item called "Item" under the "Foo" submenu of "Menu". (defalias 'enable-menu-item #[(path) " \"‰@\fA „\"ÇÈƒÉ‚Ê D\"ˆ :ƒ,ÈË \"ˆ ÌÍIˆÎ ˆ ,‡" [current-menubar menubar find-menu-item path pair item menu signal error "No such menu item" "No such menu" "%S is a menu, not a menu item" 2 t set-menubar-dirty-flag] 5 (#$ . 8317)]) (defalias 'add-menu-item-1 #[(item-p menu-path item-name item-data enabled-p before) "ƒ— ÃÄʼn<ƒ ÇAC\"@‚'ÉÊË\fD\" „\f\n‰ƒœ\n=ƒLÇ@C\"@‚VÇA@C\"@‰„‰„hÊÑ!ˆAƒ~A@ƒ~A‰‚j@C‰CA¤¡ˆ)A‰„9*„¥\n „(ƒ¼Ó# ‚ÃB ƒÏÇC\"@ÃA@=ƒ÷ AB¡ˆÃׂÖA‰„Û„'\n=ƒ @=ƒ  B‰‚' C¤ˆ*ƒ@ ØIˆ Ù??Iˆ‚L  ˆ ¡ˆÚ ˆ +‡" [before current-menubar menubar nil (byte-code "À \n\"@‡" [find-menu-item menubar menu-path] 3) ((error)) menu find-menu-item item-name signal error "not a submenu" menu-path item so-far rest rest2 "Trying to modify a menu that doesn't exist" item-p vector item-data enabled-p added-before t 1 2 set-menubar-dirty-flag] 5]) #@884 Add a menu item to some menu, creating the menu first if necessary. If the named item exists already, it is changed. MENU-PATH identifies the menu under which the new menu item should be inserted. It is a list of strings; for example, ("File") names the top-level "File" menu. ("File" "Foo") names a hypothetical submenu of "File". ITEM-NAME is the string naming the menu item to be added. FUNCTION is the command to invoke when this menu item is selected. If it is a symbol, then it is invoked with `call-interactively', in the same way that functions bound to keys are invoked. If it is a list, then the list is simply evaluated. ENABLED-P controls whether the item is selectable or not. BEFORE, if provided, is the name of a menu item before which this item should be added, if this item is not on the menu already. If the item is already present, it will not be moved. (defalias 'add-menu-item #[(menu-path item-name function enabled-p &optional before) "„ÁÂ!ˆ „ÁÄ!ˆÅÆ  &‡" [menu-path error "must specify a menu path" item-name "must specify an item name" add-menu-item-1 t function enabled-p before] 7 (#$ . 9679)]) #@322 Remove the named menu item from the menu hierarchy. PATH is a list of strings which identify the position of the menu item in the menu hierarchy. ("File" "Save") means the menu item called "Save" under the toplevel "File" menu. ("Menu" "Foo" "Item") means the menu item called "Item" under the "Foo" submenu of "Menu". (defalias 'delete-menu-item #[(path) " \"‰@\fA†  ??…2=ƒ(Ç \"‚.Ç \"ˆÈ ˆ ,‡" [current-menubar menubar find-menu-item path pair item menu delq set-menubar-dirty-flag] 4 (#$ . 10829)]) #@390 Change the string of the specified menu item. PATH is a list of strings which identify the position of the menu item in the menu hierarchy. ("File" "Save") means the menu item called "Save" under the toplevel "File" menu. ("Menu" "Foo" "Item") means the menu item called "Item" under the "Foo" submenu of "Menu". NEW-NAME is the string that the menu item will be printed as from now on. (defalias 'relabel-menu-item #[(path new-name) ";„\fÁÂÃD\"\fÆ \"‰@ A\n „4ÁË\nƒ.Ì‚/ÍD\"ˆ :ƒI @;ƒI  ˆ‚O ÎIˆÏ ˆ ,‡" [new-name signal wrong-type-argument stringp current-menubar menubar find-menu-item path pair item menu error "No such menu item" "No such menu" 0 set-menubar-dirty-flag] 5 (#$ . 11359)]) #@893 Add a menu to the menubar or one of its submenus. If the named menu exists already, it is changed. MENU-PATH identifies the menu under which the new menu should be inserted. It is a list of strings; for example, ("File") names the top-level "File" menu. ("File" "Foo") names a hypothetical submenu of "File". If MENU-PATH is nil, then the menu will be added to the menubar itself. MENU-NAME is the string naming the menu to be added. MENU-ITEMS is a list of menu item descriptions. Each menu item should be a vector of three elements: - a string, the name of the menu item; - a symbol naming a command, or a form to evaluate; - and a form whose value determines whether this item is selectable. BEFORE, if provided, is the name of a menu before which this menu should be added, if this menu is not on its parent already. If the menu is already present, it will not be moved. (defalias 'add-menu #[(menu-path menu-name menu-items &optional before) "„ÁÂ!ˆ „ÁÄ!ˆÅÆ È &‡" [menu-name error "must specify a menu name" menu-items "must specify some menu items" add-menu-item-1 nil menu-path t before] 7 (#$ . 12086)]) (byte-code "ÀÁ!„ÂÁ BÄ !ˆÆÇ!‡" [boundp put-buffer-names-in-file-menu t current-load-list set-menubar default-menubar provide lmenu] 2) emacs-19.30/lisp/loadhist.elc100666 13437 1 6141 6006763111 14507 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Jul 30 16:06:25 1995 ;;; from file /home/fsf/rms/e19/lisp/loadhist.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`loadhist.el' was compiled for Emacs 19.29 or later")) #@132 Return the input source from which SYM was loaded. This is a file name, or nil if the source was a buffer with no associated file. (defalias 'symbol-file #[(sym) "ÀÁ‡" [foundit (byte-code "ÀÁ\n\"ˆÃ‡" [mapcar #[(x) " A>…\fÂà @\"‡" [sym x throw foundit] 3] load-history nil] 3)] 2 (#$ . 475)]) #@70 Return the file and list of symbols associated with a given FEATURE. (defalias 'feature-symbols #[(feature) "ÀÁ‡" [foundit (byte-code "ÀÁ\n\"ˆÃ‡" [mapcar #[(x) "À B\nA… ÃÄ\n\"‡" [provide feature x throw foundit] 3] load-history nil] 3)] 2 (#$ . 776)]) #@278 Return the file name from which a given FEATURE was loaded. Actually, return the load argument, if any; this is sometimes the name of a Lisp file without an extension. If the feature came from an eval-buffer on a buffer with no associated file, or an eval-region, return nil. (defalias 'feature-file #[(feature) "À !„ ÂÃÄ !\"‡Å !@‡" [featurep feature error "%s is not a currently loaded feature" symbol-name feature-symbols] 4 (#$ . 1038)]) #@47 Return the list of features provided by FILE. (defalias 'file-provides #[(file) "À \n\"AÃÆÇ \"ˆ\f*‡" [assoc file load-history nil provides symbols mapcar #[(x) ":…@Á=…A\nB‰‡" [x provide provides] 2]] 3 (#$ . 1487)]) #@47 Return the list of features required by FILE. (defalias 'file-requires #[(file) "À \n\"AÃÆÇ \"ˆ\f*‡" [assoc file load-history nil requires symbols mapcar #[(x) ":…@Á=…A\nB‰‡" [x require requires] 2]] 3 (#$ . 1719)]) (defalias 'file-set-intersect #[(p q) "ÀÂÃ\f\"ˆ )‡" [nil ret mapcar #[(x) " >… \nB‰‡" [x q ret] 2] p] 3]) #@88 Return the list of loaded libraries that depend on FILE. This can include FILE itself. (defalias 'file-dependents #[(file) "À !ÂÅÆ\"ˆ *‡" [file-provides file nil dependents provides mapcar #[(x) "À  @!\"… @\fB‰‡" [file-set-intersect provides file-requires x dependents] 4] load-history] 3 (#$ . 2062)]) #@168 Unload the library that provided FEATURE, restoring all its autoloads. If the feature is required by any other loaded code, and optional FORCE is nil, raise an error. (defalias 'unload-feature #[(feature &optional force) "À !„ ÂÃÄ !\"ˆ „1Æ !ÈÉÊ!!\"‰ ƒ0ÂÌÍ !#ˆ*Î !‰@ÐÑA\"ˆÒ\"Õ\"‰+‡" [featurep feature error "%s is not a currently loaded feature" symbol-name force feature-file file delete copy-sequence file-dependents dependents "Loaded libraries %s depend on %s" prin1-to-string feature-symbols flist mapcar #[(x) ";ƒÁ‡:ƒ@Â=…?ÃA\f\"‰‡Å!ƒ%Æ!‡Ç!…?È!ˆÉN‰\n…>É\nBM)‡" [x nil provide delq features boundp makunbound fboundp fmakunbound autoload aload] 4] assoc load-history elt delq] 6 (#$ . 2380) "SFeature: "]) (provide (quote loadhist)) emacs-19.30/lisp/lpr.elc100666 13437 1 7301 5756316750 13512 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Wed May 17 02:55:36 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/lpr.el ;;; emacs version 19.28.91.22. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/lpr.el' was compiled for Emacs 19")) #@76 *List of strings to pass as extra switch args to `lpr' when it is invoked. (defvar lpr-switches nil (#$ . -475)) #@59 *Non-nil means construct -T and -J options for the `lpr'. (defvar lpr-add-switches (eq system-type (quote berkeley-unix)) (#$ . -594)) #@39 *Name of program for printing a file. (defvar lpr-command (byte-code "Á>ƒ‡Ç" [system-type (usg-unix-v dgux hpux irix) "lp" "lpr"] 2) (#$ . -735)) #@157 *List of strings to use as options for `lpr' to request page headings. If nil, we run `lpr-page-header-program' to make page headings and print the result. (defvar lpr-headers-switches nil (#$ . -893)) #@112 Function to call to print the region on a printer. See definition of `print-region-1' for calling conventions. (defvar print-region-function nil (#$ . 1102)) #@53 *Name of program for adding page headers to a file. (defvar lpr-page-header-program "pr" (#$ . -1266)) #@67 *List of strings to use as options for `lpr-page-header-program'. (defvar lpr-page-header-switches (quote ("-f")) (#$ . -1375)) #@120 Print buffer contents as with Unix command `lpr'. `lpr-switches' is a list of extra switches (strings) to pass to lpr. (defalias 'lpr-buffer #[nil "Àed Â$‡" [print-region-1 lpr-switches nil] 5 (#$ . 1510) nil]) #@123 Print buffer contents as with Unix command `lpr -p'. `lpr-switches' is a list of extra switches (strings) to pass to lpr. (defalias 'print-buffer #[nil "Àed Â$‡" [print-region-1 lpr-switches t] 5 (#$ . 1728) nil]) #@120 Print region contents as with Unix command `lpr'. `lpr-switches' is a list of extra switches (strings) to pass to lpr. (defalias 'lpr-region #[(start end) "À \n Ä$‡" [print-region-1 start end lpr-switches nil] 5 (#$ . 1949) "r"]) #@123 Print region contents as with Unix command `lpr -p'. `lpr-switches' is a list of extra switches (strings) to pass to lpr. (defalias 'print-region #[(start end) "À \n Ä$‡" [print-region-1 start end lpr-switches t] 5 (#$ . 2186) "r"]) (defalias 'print-region-1 #[(start end switches page-headers) "À ÁPÀ ÁP\nʃ/ ƒ/Ê ;ƒ( C‚*  \"  ƒ?ÌÍÎ Ï#P‚@ÐÑÒ\f\"ˆ\nÓU„oÔ\"‰@A ŠbˆØ )Ùed\"ˆ)ƒ« „«Ô\"‰@A)ÚÛ݉Ã…ŸßD ¤&ˆedÚ!†²Û\"ɉ¯…ÆãD…Ô …ÔäD¤ ¤¤\"ˆå!ƒèÉ“ˆÑæ\f\"-‡" [buffer-name " Emacs buffer" tab-width nil switch-string width title name page-headers lpr-headers-switches append switches " with options " mapconcat identity " " "" message "Spooling%s..." 8 print-region-new-buffer start end new-coords point-marker untabify apply call-process-region lpr-page-header-program t lpr-add-switches "-h" lpr-page-header-switches print-region-function lpr-command "-J" "-T" markerp "Spooling%s...done"] 11]) (defalias 'print-region-new-buffer #[(ostart oend) "À Á˜ƒ \n B‡pÅÁ!qˆ~ˆÆ ˆÇ\f\n #ˆed)B‡" [buffer-name " *spool temp*" ostart oend oldbuf get-buffer-create erase-buffer insert-buffer-substring] 4]) #@156 Turn nonprinting characters (other than TAB, LF, SPC, RET, and FF) in the current buffer into printable representations as control or hexadecimal escapes. (defalias 'printify-region #[(begin end) "ŠbˆÁÃÄ Æ#…,hÇÈ!ˆ\nÉWƒ#ÊË\nÌ\\\"‚'ÊÍ\n\"cˆ‚*‡" [begin nil c re-search-forward "[- --ÿ]" end t delete-backward-char 1 32 format "\\^%c" 64 "\\%02x"] 4 (#$ . 3377) "r"]) (provide (quote lpr)) emacs-19.30/lisp/ls-lisp.elc100666 13437 1 6130 5770131646 14272 0ustar jimbdaemon;ELC ;;; compiled by kwzh@nutrimat.gnu.ai.mit.edu on Thu Jun 15 18:26:43 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/ls-lisp.el ;;; emacs version 19.28.94.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`ls-lisp.el' was compiled for Emacs 19.29 or later")) #@514 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. Optional fourth arg FULL-DIRECTORY-P means file is a directory and switches do not contain `d', so that a full listing is expected. This version of the function comes from `ls-lisp.el'. It does not support ordinary shell wildcards; instead, it allows regular expressions to match file names. The switches that work are: A a c i r S s t u (defalias 'insert-directory #[(file &optional switches wildcard full-directory-p) "À Â\"‰ƒ  \f %‚ÛÇ\fÈ\" ƒ%É !Ê ! „.ƒÏË !‰\f ÎÈÈÒ\fÈ #ÈÈÈ×\f>ƒ`ØÙ\"‚mÚ\f>„mØÛ\"ÜÝ\"Þcˆß\f\"ƒ´@A@A‰ƒ~à8\\‰ƒ~á\f#cˆ‚~Šâã!ˆÎ•bˆäå!ˆæçè¥T\"c.\n‚ÛÉ !á é !\f#c)‡" [find-file-name-handler file insert-directory handler switches wildcard full-directory-p append nil file-name-nondirectory file-name-directory file-name-as-directory dir default-directory 0 sum elt short directory-files file-list file-alist fil attr 65 ls-lisp-delete-matching "^\\.\\.?$" 97 "^\\." mapcar #[(x) "ÁÂ!!B‡" [x file-attributes expand-file-name] 4] "total \n" ls-lisp-handle-switches 7 ls-lisp-format search-backward "total " delete-char -1 format "%d" 1024 file-attributes] 7 (#$ . 482)]) (defalias 'ls-lisp-delete-matching #[(regexp list) "À\nƒÃ\f\n@\"„\n@ B\nA‰„ )‡" [nil result list string-match regexp] 4]) (defalias 'ls-lisp-handle-switches #[(file-alist switches) "ÀÂ Ä >ƒÆ‚Ç >ƒÈ !É‚Ê\")Ë >ƒ) Ÿ ‡" [nil index sort file-alist 83 switches #[(x y) "À A8À\nA8W‡" [7 y x] 3] 116 ls-lisp-time-index #[(x y) "À \nA8 A8\"‡" [ls-lisp-time-lessp index y x] 4] #[(x y) "@ @™‡" [x y] 2] 114] 4]) (defalias 'ls-lisp-time-lessp #[(time0 time1) "@ @A@ A@‰\fW† \fU… \nW,‡" [time0 time1 lo1 lo0 hi1 hi0] 5]) (defalias 'ls-lisp-format #[(file-name file-attr &optional switches) "@ >…ÄÅÆ8\"Ç >…ÄÈÉ8Ê¥T\"Ë8ÄÌA@Í Î8Uƒ4Ï ‚9ÐÎ8!Ò=ƒDÓ‚IÐÔ8!É8%Õ \"Ö ;ƒ_Ø P‚`ÙÚ° )‡" [file-attr file-type 105 switches format "%6d " 10 115 "%4d " 7 1024 8 " %3d %8s %8s %8d " user-uid 2 user-login-name int-to-string system-type ms-dos "root" 3 ls-lisp-format-time " " file-name " -> " "" "\n"] 10]) (defalias 'ls-lisp-time-index #[(switches) "À >ƒ‡à >ƒćŇ" [99 switches 6 117 4 5] 2]) (defalias 'ls-lisp-format-time #[(file-attr switches) "ÀÁ‡" [error-data (byte-code "ÀÁ\n! 8!‰ÅÆO\fÆÈO \fÊËO‰\fÀ ÊËOš  ƒ/ ‚1\fP-‡" [current-time-string ls-lisp-time-index switches file-attr time 4 11 date 16 clock 19 24 year same-year] 5) ((error "Jan 00 00:00"))] 3]) (provide (quote ls-lisp)) emacs-19.30/lisp/lselect.elc100666 13437 1 13023 5744576620 14367 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:45:19 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/lselect.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/lselect.el' was compiled for Emacs 19")) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆ!„ÇÆ!ˆÅÈ!„ÇÈ!ˆÀ‡" [defalias x-get-cutbuffer x-get-cut-buffer x-store-cutbuffer x-set-cut-buffer find-face primary-selection make-face secondary-selection] 3) #@42 Return text selected from some X window. (defalias 'x-get-secondary-selection #[nil "ÀÁÂ\"‡" [x-get-selection-internal SECONDARY STRING] 3 (#$ . 671)]) #@54 The extent of the primary selection; don't use this. (defvar primary-selection-extent nil (#$ . 829)) #@56 The extent of the secondary selection; don't use this. (defvar secondary-selection-extent nil (#$ . 937)) (defalias 'x-select-make-extent-for-selection #[(selection previous-extent face) "ÀÁ\n!…Ã\n!…ÄÃ\n!!À‰ ;ƒ'À‚ :ƒX @ A^ @ A]…LÊ @!Ã\n!=Ê @!‚Á !ƒË !Ì !…wà !Ã\n!=à !„œÁ\n!ƒœÃ\n!ƒœÄÃ\n!!ƒœÍ\n!ˆ??…ă±Î\n #‚ÄÏ #Ð\n\"ˆÒ\n\",‡" [nil extentp previous-extent extent-buffer buffer-name end start valid buffer selection marker-buffer extent-start-position extent-end-position delete-extent set-extent-endpoints make-extent set-extent-priority mouse-highlight-priority set-extent-face face] 4]) #@241 Make a primary X Selection of the given argument. The argument may be a string, a cons of two markers, or an extent. In the latter cases the selection is considered to be the text between the markers, or the between extents endpoints. (defalias 'x-own-selection #[(selection &optional type) "„Á \"ˆÁ=ƒÄ Æ#‚(Ç=ƒ(Ä É# ‡" [type PRIMARY x-set-selection selection x-select-make-extent-for-selection primary-selection-extent primary-selection SECONDARY secondary-selection-extent secondary-selection] 4 (#$ . 1608) (byte-code "„ ÁÂ!C‡ÃÄ !ÃÅ !BC‡" [current-prefix-arg read-string "Store text for pasting: " copy-marker point-marker mark-marker] 3)]) #@191 Make a secondary X Selection of the given argument. The argument may be a string or a cons of two markers (in which case the selection is considered to be the text between those markers.) (defalias 'x-own-secondary-selection #[(selection &optional type) "À Â\"‡" [x-own-selection selection SECONDARY] 3 (#$ . 2283) (byte-code "„ ÁÂ!C‡ÃÄ !ÃÅ !BC‡" [current-prefix-arg read-string "Store text for pasting: " copy-marker point-marker mark-marker] 3)]) #@44 Paste the given string to the X Clipboard. (defalias 'x-own-clipboard #[(string) "À Â\"‡" [x-own-selection string CLIPBOARD] 3 (#$ . 2742)]) #@128 Assuming we own the selection, disown it. With an argument, discard the secondary selection instead of the primary selection. (defalias 'x-disown-selection #[(&optional secondary-p) "À ƒ ‚\nÃ!‡" [x-disown-selection-internal secondary-p SECONDARY PRIMARY] 2 (#$ . 2890)]) #@47 for use as a value of x-lost-selection-hooks. (defalias 'x-dehilight-selection #[(selection) "Á=ƒ\nƒÃÅ\n!ˆÆ)ƒ4È ˆ‚4É=ƒ4\nƒ4ÃÅ\n!ˆÆ\n)Ƈ" [selection PRIMARY primary-selection-extent t inhibit-quit delete-extent nil zmacs-regions zmacs-deactivate-region SECONDARY secondary-selection-extent] 2 (#$ . 3171)]) (byte-code "ÀÀ‡" [x-dehilight-selection x-lost-selection-hooks] 1) #@58 for possible use as the value of x-sent-selection-hooks. (defalias 'x-notice-selection-requests #[(selection type successful) "„\nÁ \f#‡ÁÅ \f#‡" [successful message "Selection request failed to convert %s to %s" selection type "Sent selection %s as %s"] 4 (#$ . 3569)]) #@58 for possible use as the value of x-sent-selection-hooks. (defalias 'x-notice-selection-failures #[(selection type successful) "† Á \f#‡" [successful message "Selection request failed to convert %s to %s" selection type] 4 (#$ . 3848)]) #@107 If there is a selection, delete the text it covers, and copy it to both the kill ring and the Clipboard. (defalias 'x-kill-primary-selection #[nil "À „ ÁÂ!ˆÃ „ÁÆ!ˆŠÇ !qˆÈÉ !Ê !\"ˆ)ËÃ!‡" [x-selection-owner-p error "emacs does not own the primary selection" nil last-command primary-selection-extent "the primary selection is not an extent?" extent-buffer kill-region extent-start-position extent-end-position x-disown-selection] 4 (#$ . 4094) nil]) #@108 If there is a selection, delete the text it covers *without* copying it to the kill ring or the Clipboard. (defalias 'x-delete-primary-selection #[nil "À „ ÁÂ!ˆÃ „ÁÆ!ˆŠÇ !qˆÈ !É !|ˆ)ÊÃ!‡" [x-selection-owner-p error "emacs does not own the primary selection" nil last-command primary-selection-extent "the primary selection is not an extent?" extent-buffer extent-start-position extent-end-position x-disown-selection] 3 (#$ . 4554) nil]) #@75 If there is a selection, copy it to both the kill ring and the Clipboard. (defalias 'x-copy-primary-selection #[nil "À „ ÃÄ!ˆ „ÃÆ!ˆŠÇ !qˆÈÉ !Ê !\")‡" [nil last-command x-selection-owner-p error "emacs does not own the primary selection" primary-selection-extent "the primary selection is not an extent?" extent-buffer copy-region-as-kill extent-start-position extent-end-position] 4 (#$ . 5002) nil]) #@60 If someone owns a Clipboard selection, insert it at point. (defalias 'x-yank-clipboard-selection #[nil "À ‰„ ÄÅ!ˆÆ ˆ c)‡" [nil last-command x-get-clipboard clip error "there is no clipboard selection" push-mark] 3 (#$ . 5414) nil]) emacs-19.30/lisp/lucid.elc100666 13437 1 12607 5744576622 14045 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:45:20 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/lucid.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/lucid.el' was compiled for Emacs 19")) (defalias 'add-timeout #[(secs function object &optional resignal) "À \n \f$‡" [run-at-time secs resignal function object] 5]) (defalias 'disable-timeout #[(timeout) "À !‡" [cancel-timer timeout] 2]) (defalias 'copy-tree #[(tree) ":ƒÁ@!ÁA!B‡Â!ƒ6Ã!‰GS‰ÆYƒ3\f Á\f H!Iˆ S‰‚\f*‡‡" [tree copy-tree vectorp copy-sequence new i 0] 6]) (defalias (quote current-time-seconds) (quote current-time)) (defalias 'keymap-parent #[(keymap) "A‰ƒ @À=„ A‰„ )‡" [keymap tail] 3]) (defalias 'set-keymap-parent #[(keymap new-parent) "‰ƒ Aƒ A@À=„ A‰„ …! \n¡)‡" [keymap tail new-parent] 3]) (defalias 'remprop #[(symbol prop) "À !\n@ =ƒÄ \nAA‰\"ˆ‚\n…3Å\n8 =ƒ*\nAÆ\n›¡ˆ\nAA‰„Ç)‡" [symbol-plist symbol plist prop setplist 2 4 nil] 5]) #@520 Call FUNCTION for every binding in KEYMAP. This includes bindings inherited from a parent keymap. FUNCTION receives two arguments each time it is called: the character (more generally, the event type) that is bound, and the binding it has. Note that passing the event type directly to `define-key' does not work in Emacs 19. We do not emulate that particular feature of Lucid Emacs. If your code does that, modify it to make a vector containing the event type that you get. That will work in both versions of Emacs. (defalias 'map-keymap #[(function keymap &optional sort-first) "ƒ(ÁÃÄ \"ˆÆ\nÇ\"‰…&\n@@\n@A\"ˆ\nA‰„Á)‡ :…s @:ƒ@ @@ @A\"ˆ‚lÉ @!ƒl @GS @\n‰ ÌYƒk \n H\"ˆ S‰ ‚R* A‰‚)‡" [sort-first nil list map-keymap #[(a b) " B\nB‰‡" [a b list] 2] keymap sort #[(a b) "@ @¨ƒ ¨ƒ W‡Â‡ ¨ƒ‡ ™‡" [a b t] 2] function vectorp vector i 0] 5 (#$ . 1237)]) #@165 Read a number from the minibuffer. Keep reentering the minibuffer until we get suitable input. If optional argument INTEGERS-ONLY is non-nil, insist on an integer. (defalias 'read-number #[(prompt &optional integers-only) "À‰ ƒ\n‚ ÄDÇ! ÀÊˈ\f !ƒ+Ì‚@Ì ÎÏ ƒ8Ђ9Ñ\"ˆÒÓ!ˆ))‚ +‡" [nil integers-only integerp numberp predicate number success read-string prompt input-string (byte-code "À !À‡" [read input-string number] 2) ((error)) t cursor-in-echo-area message "Please type %s" "an integer" "a number" sit-for 1] 3 (#$ . 2134) nil]) (defalias 'real-path-name #[(name &optional default) "ÀÁ\n \"!‡" [file-truename expand-file-name name default] 4]) (defalias 'read-mouse-position #[(frame) "À ‰@\n=…\f A)‡" [mouse-position pos frame] 3]) #@171 Switch to the previous buffer. With a numeric arg N, switch to the Nth most recent buffer. With an arg of 0, buries the current buffer at the bottom of the buffer stack. (defalias 'switch-to-other-buffer #[(arg) "Á=ƒ\nÂp!ˆÃÄXƒÅp!‚!ÆÇÈÉÊ \"\"8!‡" [arg 0 bury-buffer switch-to-buffer 1 other-buffer apply nconc mapcar #[(buf) "ÀÁ\n!!ÃU?… \nC‡" [string-to-char buffer-name buf 32] 3] buffer-list] 7 (#$ . 2901) "p"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias find-face internal-find-face get-face internal-get-face try-face-font internal-try-face-font] 3) (defalias 'make-extent #[(beg end &optional buffer) "À \n #‡" [make-overlay beg end buffer] 4]) (defalias 'set-extent-property #[(extent prop value) "Á=ƒ@\nƒ#Ã\f\"„#ÅÆ\f!Ç\f!È\f!É\f!$ˆ‚U\n„UÃ\f\"ƒUÊÆ\f!Ç\f!È\f!É\f!$ˆ‚UÃ\fÁ\"ƒUËÆ\f!Ç\f!\nÉ\f!%ˆÌ\f\n#‡" [prop duplicable value overlay-get extent add-text-properties overlay-start overlay-end overlay-properties overlay-buffer remove-text-properties put-text-property overlay-put] 7]) (defalias 'set-extent-face #[(extent face) "À Â\n#‡" [set-extent-property extent face] 4]) (defalias 'delete-extent #[(extent) "À ÂÃ#ˆÄ !‡" [set-extent-property extent duplicable nil delete-overlay] 4]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"ˆÀãä\"ˆÀåæ\"ˆÀçè\"ˆÀéê\"ˆÀëì\"ˆÀíî\"ˆÀïð\"ˆÀñò\"ˆÀóô\"ˆÀõö\"ˆÀ÷ø\"ˆÀùú\"ˆÀûü\"ˆÀýþ\"ˆÀÿ@\"ˆÀAB\"ˆCD!‡" [defalias current-screen-configuration current-frame-configuration delete-screen delete-frame find-file-new-screen find-file-other-frame find-file-read-only-new-screen find-file-read-only-other-frame find-tag-new-screen find-tag-other-frame iconify-screen iconify-frame mail-new-screen mail-other-frame make-screen-invisible make-frame-invisible make-screen-visible make-frame-visible modify-screen-parameters modify-frame-parameters next-screen next-frame redraw-screen redraw-frame screen-height frame-height screen-list frame-list screen-parameters frame-parameters screen-pixel-height frame-pixel-height screen-pixel-width frame-pixel-width screen-root-window frame-root-window screen-selected-window frame-selected-window lower-screen lower-frame raise-screen raise-frame screen-visible-p frame-visible-p screen-width frame-width screenp framep select-screen select-frame selected-screen selected-frame set-screen-position set-frame-position set-screen-size set-frame-size switch-to-buffer-new-screen switch-to-buffer-other-frame visible-screen-list visible-frame-list window-screen window-frame x-create-screen x-create-frame x-new-screen make-frame provide lucid] 3) emacs-19.30/lisp/lunar.elc100666 13437 1 24151 6032176257 14052 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Sep 27 03:26:06 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/lunar.el ;;; emacs version 19.29.12. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`lunar.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ƒ ÂÃ!ˆ‚ÄÅ!ˆÂÆ!‡" [fboundp atan require lisp-float-type error "Lunar calculations impossible since floating point is unavailable." solar] 2) #@76 List of lunar phases for three months starting with Gregorian MONTH, YEAR. (defalias 'lunar-phase-list #[(month year) "  \fÆ_ Ç\\\\‰ƦTÆ¥)\nÆ_ É\\\\‰ƦTÆ¥) Ê\fEC ‰\n‰ÇUƒb ‰̦ÍU…Z ΦÍU?†Z ϦÍU)ƒbЂfÑSH*\nECÓ Ê E‰‰@)‰A@)‰AA@)SÖ_\\ÇVƒËÌ_Ø\\Ù¥Z ‰̦ÍU… ΦÍU?†Â ϦÍU)ƒËT-Ú¥Û\\\\Ü_!Ì_Þ!à!â \"ƒ\fâ\"ƒþã!C\"!TÞ!‚ã!. ‡" [month year start-year start-month end-year end-month 12 2 macro-y -2 1 end-date 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] start-date truncate date day 31 day-of-year 23 10 366.0 -1900 12.368499999999999 index lunar-phase new-moon nil list calendar-date-compare append] 7 (#$ . 634)]) #@210 Local date and time of lunar phase INDEX. Integer below INDEX/4 gives the lunation number, counting from Jan 1, 1900; remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon, 3 last quarter. (defalias 'lunar-phase #[(index) "À Â\" Ä¥‰Å¥ÇljAA@)S ‰‰@)\n‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒ€\nÂ_Ð\\Ñ¥Z\f‰\f¦ÒU…w\fÓ¦ÒU?†w\fÔ¦ÒU)ƒ€T- Õ_ Â¥ Ó¥[ Ô¥\\\\\\\\* Ö_‰×__‰‰Ø___Ù_‰Ú__Û\\\\ÝÞ_!)ß_à\\\\\\\\\\À á_‰â__‰‰ã___ä\\\\\\å\"&À ç_‰è__‰‰é___ê\\\\\\ë\",À í_‰î__‰‰ï___ð\\\\\\ñ\"2 ó>ƒôõ_Z&ÝÞ_!)_&‰\\ÝÞ_!)ö_,ÝÞ_!)÷_,‰\\ÝÞ_!)ø_,ù_ÝÞ_!)ú_2‰\\ÝÞ_!)û_&,\\ÝÞ_!)ü_&,ZÝÞ_!)ý_2‰\\&\\ÝÞ_!)þ_2‰\\&ZÝÞ_!)ÿ_2‰\\,\\ÝÞ_!)@_2‰\\,ZÝÞ_!)A_,‰\\&\\ÝÞ_!)B_\\\\\\\\\\\\\\\\\\\\\\\\‚/CD_Z&ÝÞ_!)_&‰\\ÝÞ_!)E_,ÝÞ_!)F_,‰\\ÝÞ_!)G_,ù_ÝÞ_!)H_2‰\\ÝÞ_!)I_&,\\ÝÞ_!)J_&,ZÝÞ_!)K_2‰\\&\\ÝÞ_!)L_2‰\\&ZÝÞ_!)M_2‰\\,\\ÝÞ_!)N_2‰\\,ZÝÞ_!)O_,‰\\&\\ÝÞ_!)P_&,‰\\ZÝÞ_!)Q_&‰\\,\\ÝÞ_!)R_\\\\\\\\\\\\\\\\\\\\\\\\\\\\S&TU_!)V_,TU_!)W_X\\\\Y ZUƒnSY\\‚~ ÏUƒ|SYZ‚~SSS\\‰[\\]^!!‰AA@)!Z_¥\\‰^!Z`_]^!!a\"‰Y@bcYA\" E.‡" [mod index 4 phase 4.0 1236.8499999999999 time (1 .5 1900) date prior-years month day year 31 day-of-year 2 23 10 0 100 400 365 29.530588680000001 .00011779999999999999 -1.55e-007 132.87 -.009173 166.56 x sin .017453292519943295 .00033000000000000003 .75932999999999993 29.105356 -3.3300000000000001e-005 -3.4700000000000002e-006 359.2242 360.0 sun-anomaly 385.81691805999998 .010730599999999999 1.2359999999999998e-005 306.02530000000002 360.0 moon-anomaly 390.67050646000001 -.0016528 -2.3899999999999997e-006 21.296399999999998 360.0 moon-lat (0 2) .1734 .00039300000000000001 .0020999999999999996 -.40679999999999996 .016100000000000001 3 -.0004 .0104 -.0050999999999999996 -.0074000000000000012 .0004 -.0004 -.00059999999999999982 .001 .0005 .17210000000000001 .0004 .0020999999999999996 -.62800000000000002 .0088999999999999986 -.0004 .0079000000000000012 -.011900000000000002 -.0046999999999999993 .00029999999999999991 -.0004 -.00059999999999999982 .0020999999999999996 .00029999999999999991 .0004 -.00029999999999999991 adjustment cos .017453292519943295 -.0004 .00029999999999999991 .0028000000000000004 adj 1 calendar-time-zone solar-ephemeris-correction calendar-gregorian-from-absolute truncate 1440.0 24 dst-adjust-time apply solar-time-string] 18 (#$ . 1348)]) #@88 Name of lunar PHASE. 0 = new moon, 1 = first quarter, 2 = full moon, 3 = last quarter. (defalias 'lunar-phase-name #[(phase) "ÁUƒ‡ÃUƒćÅUƒƇÇU…ȇ" [phase 0 "New Moon" 1 "First Quarter Moon" 2 "Full Moon" 3 "Last Quarter Moon"] 2 (#$ . 3959)]) #@72 Create a buffer with the lunar phases for the current calendar window. (defalias 'calendar-phases-of-moon #[nil "ÀÁ!ˆ\n \n È_É\\\\‰\nȦT\nÈ¥)\fÈ_ \\‰\nȦT\nÈ¥)Ë\f!qˆÍÏ\fUƒWÐÑÒ!Ò !\f$‚dÐÓÒ!Ò !\f%!ˆÔ ˆÕÖ×\"Ø#cˆebˆÙÍ!ˆÚÛ\f!ˆÀÜ!,‡" [message "Computing phases of the moon..." displayed-month displayed-year y2 m2 y1 m1 12 -2 macro-y get-buffer-create lunar-phases-buffer nil buffer-read-only calendar-set-mode-line format "Phases of the Moon from %s to %s, %d%%-" calendar-month-name "Phases of the Moon from %s, %d to %s, %d%%-" erase-buffer mapconcat #[(x) "@A@AA@Ä !ÅÆ !Ç\n°+‡" [x phase time date calendar-date-string ": " lunar-phase-name " "] 5] lunar-phase-list "\n" set-buffer-modified-p t display-buffer "Computing phases of the moon...done"] 8 (#$ . 4221) nil]) #@209 Display the quarters of the moon for last month, this month, and next month. If called with an optional prefix argument, prompts for month and year. This function is suitable for execution in a .emacs file. (defalias 'phases-of-moon #[(&optional arg) "Šƒ ÁÂ!‚ à ‰‰@)\f‰AA@)Ç ,‡" [arg calendar-read-date t calendar-current-date date displayed-month displayed-year calendar-phases-of-moon] 3 (#$ . 5041) "P"]) #@26 Moon phases diary entry. (defalias 'diary-phases-of-moon #[nil "À ‰AA@) ‰‰@) ‰A@) ‰AA@) \nSÅ_\\\nÇVƒZ\nÈ_É\\Ê¥Z\f‰ȦËU…Q\f̦ËU?†Q\fͦËU)ƒZT-Î¥Ï\\\\Ð_!È_Ò!Ô C\"ƒ†TÒ!‚oÕ@ \"…œÖAA@!×A@Q*‡" [truncate date month day year 31 day-of-year 2 4 23 10 0 100 400 366.0 -1900 12.368499999999999 index lunar-phase phase calendar-date-compare calendar-date-equal lunar-phase-name " "] 7 (#$ . 5465)]) #@52 Astronomical (Julian) day number of K th new moon. (defalias 'lunar-new-moon-time #[(k) "Á¥‰‰_\n‰‰__ ‰_Æ_ Ç_\fÈ_ É_Ê\\\\\\\\ Ì\nÍ_Z Î_ZÐ_ Ñ_\fÒ_Ó\\\\\\Õ_ Ö_\f×_ Ø_Ù\\\\\\\\Û_ Ü_\fÝ_ Þ_ß\\\\\\\\ á_ â_\fã_ä\\\\\\%æ_ ç_è\\\\)ê_ë\\,í_î\\/ð_ñ\\2ó_ô\\5ö_÷\\8ù_ú\\;ü_ý\\>ÿ_@\\AB_C\\DE_F\\GH_I\\JK_L\\MN_O\\PQRQS_!)T_QRQS_!)U__‰\\QRQS_!)V_ ‰\\QRQS_!)W_ZQRQS_!)X__\\QRQS_!)Y__‰‰\\QRQS_!)Z___ ‰\\ZQRQS_!)[_ ‰\\\\QRQS_!)\\_‰\\\\QRQS_!)]__^_QRQS_!)__ ‰\\\\QRQS_!)`__ ‰\\ZQRQS_!)a__‰\\ZQRQS_!)b__%QRQS_!)c_‰\\\\QRQS_!)d_‰\\ ‰\\ZQRQS_!)e_^_QRQS_!)f_ g_\\\\QRQS_!)h_‰\\ ‰\\\\QRQS_!)i_ ‰\\\\\\QRQS_!)j_Z g_ZQRQS_!)k_Z ‰\\ZQRQS_!)l_^_\\QRQS_!)m_n_QRQS_!)o_\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\p)QRQS_!)q_,QRQS_!)r_/QRQS_!)s_2QRQS_!)t_5QRQS_!)u_8QRQS_!)v_;QRQS_!)w_>QRQS_!)x_AQRQS_!)y_DQRQS_!)z_GQRQS_!){_JQRQS_!)|_MQRQS_!)}_PQRQS_!)~_\\\\\\\\\\\\\\\\\\\\\\\\\\ p\\\\‰€‚ƒ„€!!!‰…AA@)![†‡¥\\\\.‡" [k 1236.8499999999999 T T2 T3 T4 29.530588853000001 .00013369999999999997 -1.5e-007 7.2999999999999972e-010 2451550.0976499999 JDE 1 .0025160000000000005 7.4000000000000012e-006 E 29.105356690000001 -2.1800000000000002e-005 -1.0999999999999999e-007 2.5533999999999999 sun-anomaly 385.81693528 .010743799999999999 1.2390000000000001e-005 -5.7999999999999998e-008 201.5643 moon-anomaly 390.67050274000002 -.0016341000000000001 -2.2699999999999996e-006 1.0999999999999999e-008 160.71080000000001 moon-argument -1.5637558 .0020691000000000002 2.1499999999999995e-006 124.77460000000001 omega .10740799999999999 -.009173 299.76999999999998 A1 .016320999999999999 251.88 A2 26.641886 251.83000000000001 A3 36.412478 349.42000000000002 A4 18.206239 84.659999999999997 A5 53.303770999999998 141.74000000000001 A6 2.453732 207.13999999999999 A7 7.3068600000000004 154.84 A8 27.261239 34.520000000000003 A9 .121824 207.19 A10 1.844379 291.33999999999997 A11 24.198153999999999 161.72 A12 25.513099 239.56 A13 3.5925180000000001 331.55000000000001 A14 x sin .017453292519943295 -.40720000000000001 .17241 .016080000000000001 .010389999999999999 .0073899999999999988 -.0051399999999999988 .0020800000000000001 -.0011100000000000001 -.00057000000000000011 .00055999999999999996 3 -.00042000000000000011 .00042000000000000011 .00038000000000000007 -.00023999999999999999 -.00017000000000000002 -7e-005 4e-005 4e-005 -2 3e-005 3e-005 -3e-005 3e-005 -2e-005 -2e-005 4 2e-005 correction .000325 .00016500000000000002 .00016399999999999997 .000126 .00011000000000000001 6.2000000000000002e-005 6e-005 5.5999999999999996e-005 4.6999999999999993e-005 4.1999999999999993e-005 4e-005 3.7000000000000006e-005 3.5e-005 2.2999999999999998e-005 additional newJDE solar-ephemeris-correction calendar-gregorian-from-absolute floor calendar-absolute-from-astro date calendar-time-zone 1440.0] 28 (#$ . 5907)]) #@440 Astronomical (Julian) day number of first new moon on or after astronomical (Julian) day number d. The fractional part is the time of day. The date and time are local time, including any daylight savings rules, as governed by the values of calendar-daylight-savings-starts, calendar-daylight-savings-starts-time, calendar-daylight-savings-ends, calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and calendar-time-zone. (defalias 'lunar-new-moon-on-or-after #[(d) "ÀÁ !!!‰‰AA@)\f‰‰@)\f‰A@)\f‰AA@) SÈ_\\ ÊVƒh Ë_Ì\\Í¥Z ‰˦ÎU…_ϦÎU?†_ЦÎU)ƒh T  -Ñ¥\\ÁÒZÓ_!Õ!‰ Wƒ“TÕ!‰‚€Â\f!‰×!ZØ_À×!!Ú\f\"Ü@‰‰AA@)S\f‰‰@)\f‰A@)\f‰AA@) SÈ_\\ ÊVƒ Ë_Ì\\Í¥Z ‰˦ÎU…ϦÎU?†ЦÎU)ƒ T  -Þ_˥ϥ[Ð¥\\\\\\\\*A@ߥ\\!.‡" [calendar-gregorian-from-absolute floor calendar-absolute-from-astro d date month day year 31 day-of-year 2 4 23 10 0 100 400 365.25 2000.0 12.368499999999999 k lunar-new-moon-time a-date truncate 24 time dst-adjust-time adj calendar-astro-from-absolute prior-years 365 24.0] 9 (#$ . 9207)]) (provide (quote lunar)) emacs-19.30/lisp/macros.elc100666 74777 1 13764 6016151531 14101 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Aug 21 14:41:19 1995 ;;; from file /home/fsf/rms/e19/lisp/macros.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`macros.el' was compiled for Emacs 19.29 or later")) #@238 Assign a name to the last keyboard macro defined. Argument SYMBOL is the name to define. The symbol's function definition becomes the keyboard macro string. Such a "function" cannot be called from Lisp, but it is a valid editor command. (defalias 'name-last-kbd-macro #[(symbol) "„ÁÂ!ˆÃ\f!ƒ \fK;„ Å\fK!„ ÁÆ\f\"ˆ\fM‡" [last-kbd-macro error "No keyboard macro defined" fboundp symbol vectorp "Function %s is already defined and not a keyboard macro."] 3 (#$ . 468) "SName for last kbd macro: "]) #@584 Insert in buffer the definition of kbd macro NAME, as Lisp code. Optional second arg KEYS means also record the keys it is on (this is the prefix argument, when calling interactively). This Lisp code will, when executed, define the kbd macro with the same definition it has now. If you say to record the keys, the Lisp code will also rebind those keys to the macro. Only global key bindings are recorded since executing this Lisp code always makes global bindings. To save a kbd macro, visit a file of Lisp code such as your `~/.emacs', use this command, and then save the file. (defalias 'insert-kbd-macro #[(macroname &optional keys) "À !ĘƒÅ Æcˆ‚ KÇcˆÈ p\"ˆÉcˆ ;ƒJ`À\n È p\"ˆÌ \n bˆ`\nWƒFg‰ ÎUƒU``T|ˆÏcˆ‚B ÐWƒl``T|ˆÑ Ò\\±ˆ‚B ÓUƒ~``T|ˆÔcˆ‚B ÕWƒ•``T|ˆÑ Ö\\±ˆ‚B ×Wƒ¢Øuˆ‚B ×Uƒ´``T|ˆÙcˆ‚B ÚUƒÆ``T|ˆÛcˆ‚B ÜÎHUƒÚ``T|ˆÝcˆ‚B ÞWƒñ``T|ˆß ÕZ±ˆ‚B àWƒ``T|ˆß ÖZ±ˆ‚B áÎHUƒ``T|ˆâcˆ‚B ãWƒ3``T|ˆä ÚZ±ˆ‚B ãUƒB``T|ˆåcˆ)‚:*‚Yæ !ƒT GÎÀ‰' ()()WƒM(ÎUƒpê‚qÕcˆ (H (T( §„È p\"ˆ‚]ëcˆì !'í ! 'ƒ'@î=ƒ¯Ñcˆ‚'@ï=ƒ½äcˆ‚'@ð=ƒËñcˆ‚'@ò=ƒÙócˆ‚'@ô=ƒçõcˆ‚'@ö=ƒ ÷Yƒ øXƒ – ‚'@ö=ƒùcˆ'A‰'„¡ úUƒ&ûcˆ‚] ×Uƒ3Ùcˆ‚] ×WƒA cˆ‚]üýþ \"±ˆ‚]ÿcˆ,‚YÈ p\"ˆ@cˆA…—B C\"‰A…–DcˆÈA@p\"ˆEcˆÈ p\"ˆ@cˆAA‰A„qÀ))‡" [nil definition symbol-name macroname "" last-kbd-macro "(setq " "(fset '" prin1 "\n " end beg point-marker char 0 "\\C-@" 27 "\\C-" 96 28 "\\C-\\\\" 32 64 127 1 "\\C-?" 128 "\\M-\\C-@" "œ" "\\M-\\C-\\\\" 155 "\\M-\\C-" 160 "Ü" "\\M-\\\\" 255 "\\M-" "\\M-\\C-?" vectorp mods i len 91 "?" event-modifiers event-basic-type control meta hyper "\\H-" super "\\s-" alt "\\A-" shift 97 122 "\\S-" 92 "\\\\" "\\" format "%o" 93 ")\n" keys where-is-internal (keymap) "(global-set-key " " '"] 5 (#$ . 976) "CInsert kbd macro (name): \nP"]) #@596 Query user during kbd macro execution. With prefix argument, enters recursive edit, reading keyboard commands even within a kbd macro. You can give different commands each time the macro executes. Without prefix argument, asks whether to continue running the macro. Your options are: \ \[act] Finish this iteration normally and continue with the next. \[skip] Skip the rest of this iteration, and start the next. \[exit] Stop the macro entirely right now. \[recenter] Redisplay the screen, then ask again. \[edit] Enter recursive edit; ask again when you exit from that. (defalias 'kbd-macro-query #[(flag) "„\f „\fÂÃ!ˆ\fƒʼnÆ *‡…ÀÇÈÉ!\n  …¿Å‰Ì\n!ˆÍ *ÅÐ!Ñ\"‰Ó=ƒTÅ ‚»Ô=ƒcÅ Õ‚»Ö=ƒrÅ Ç‚»×=ƒ€×Å!ˆ‚»Ø=ƒ’ʼnÆ ˆ*‚»Ù=ƒŸÇ‚»Û=„©Ü ˆÝÞÈß!!ˆŠ qˆá )‘ˆ*‚$*‡" [executing-macro defining-kbd-macro error "Not defining or executing kbd macro" flag nil recursive-edit t substitute-command-keys "Proceed with macro?\\ (\\[act], \\[skip], \\[exit], \\[recenter], \\[edit]) " msg loop message read-event def key vector lookup-key query-replace-map act skip "" exit recenter edit quit quit-flag help ding "*Help*" princ "Specify how to proceed with keyboard macro execution.\nPossibilities: \\\n\\[act] Finish this iteration normally and continue with the next.\n\\[skip] Skip the rest of this iteration, and start the next.\n\\[exit] Stop the macro entirely right now.\n\\[recenter] Redisplay the screen, then ask again.\n\\[edit] Enter recursive edit; ask again when you exit from that." standard-output help-mode] 5 (#$ . 2837) "P"]) #@1314 For each complete line between point and mark, move to the beginning of the line, and run the last keyboard macro. When called from lisp, this function takes two arguments TOP and BOTTOM, describing the current region. TOP must be before BOTTOM. The optional third argument MACRO specifies a keyboard macro to execute. This is useful for quoting or unquoting included text, adding and removing comments, or producing tables where the entries are regular. For example, in Usenet articles, sections of text quoted from another author are indented, or have each line start with `>'. To quote a section of text, define a keyboard macro which inserts `>', put point and mark at opposite ends of the quoted section, and use `\[apply-macro-to-region-lines]' to mark the entire section. Suppose you wanted to build a keyword table in C where each entry looked like this: { "foo", foo_data, foo_function }, { "bar", bar_data, bar_function }, { "baz", baz_data, baz_function }, You could enter the names in this format: foo bar baz and write a macro to massage a word into a table entry: \C-x ( \M-d { "\C-y", \C-y_data, \C-y_function }, \C-x ) and then select the region of un-tablified names and use `\[apply-macro-to-region-lines]' to build the table from the names.  (defalias 'apply-macro-to-region-lines #[(top bottom &optional macro) "„ „\fÂÃ!ˆ Š\fbˆÅyˆÆ Ç \nbˆn„'ËyˆÆ  WƒObˆŠËyˆ`Ç“ˆ)ŠÌ†I !ˆ)‚+ lj“ˆlj“+‡" [macro last-kbd-macro error "No keyboard macro has been defined." bottom 0 point-marker nil next-line-marker end-marker top 1 execute-kbd-macro] 3 (#$ . 4485) "r"]) emacs-19.30/lisp/mail-extr.elc100666 13437 1 52231 5762433344 14635 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Mon May 29 17:01:26 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mail-extr.el ;;; emacs version 19.28.92.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/mail-extr.el' was compiled for Emacs 19")) #@188 *Whether to try to guess middle initial from mail address. If true, then when we see an address like "John Smith " we will assume that "John Q. Smith" is the fellow's name. (defvar mail-extr-guess-middle-initial nil (#$ . -493)) #@190 *Whether to ignore a name that is just a single word. If true, then when we see an address like "Idiot " we will act as though we couldn't find a full name in the address. (defvar mail-extr-ignore-single-names t (#$ . -743)) #@176 *Matches prefixes to the full name that identify a person's position. These are stripped from the full name because they do not contribute to uniquely identifying the person. (defvar mail-extr-full-name-prefixes (purecopy "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \n]") (#$ . -992)) #@62 *Whether the local mail transport agent looks at ! before @. (defvar mail-extr-@-binds-tighter-than-! nil (#$ . -1301)) #@121 *Whether to throw away information in UUCP addresses by translating things like "foo!bar!baz@host" into "baz@bar.UUCP". (defvar mail-extr-mangle-uucp nil (#$ . -1428)) (byte-code "ÀÁ! BÀ\nÄP!Å BÀÆ!Ç BÀÈ! É BÀÊË\"!\fÌ BÀÊÍ  $!Î BÀÊÏ ‰#!Ð BÀÑ!Ò BÀÓ!Ô BÀÕ!Ö BÀ×!Ø BÀÊÙ  $!Ú BÀÊÛ\"!Ü BÀÝ!Þ BÀß! à BÀÊá\n $!\"â BÀã\"äåæ°!'ç BÀè!)é BÀê!+ë BÀì!-í BÀî!/ï BÀð!1ñ BÀÊ1ò\"!3ó BÀÊ1ô\"!5õ BÀÊ1ö\"!7÷ Bø 9ù Bø :ú Bø ;û Bø <ü Bø =ý Bþÿ@\"‡" [purecopy "][A-Za-z{|}'~0-9`€-ÿ" mail-extr-all-letters-but-separators current-load-list "---" mail-extr-all-letters "A-Za-z€-ÿ" mail-extr-first-letters "A-Za-z€-ÿ`'." mail-extr-last-letters format "[^%s]+" mail-extr-leading-garbage "\\([%s][%s]\\)\\.+\\([%s]\\)" mail-extr-bad-dot-pattern "\\(,? ?\\([JjSs][Rr]\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)" mail-extr-full-name-suffix-pattern "V?I+V?\\b" mail-extr-roman-numeral-pattern "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)" mail-extr-weird-acronym-pattern "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]" mail-extr-alternative-address-pattern " [-{]\\|--\\|[+@#>„\nÂÃ!ˆÄÅDÇBÈÅÉÊËÌÍEÏÍEEÑ?…(ÒÓ\"BDÔBBBBÕÖ×EEF‡" [no-replace (t nil) error "no-replace must be t or nil, evalable at macroexpand-time." let temp list-symbol (ch) while (setq ch (car temp)) cond or > ch end-symbol < beg-symbol append ((mail-extr-nuke-char-at ch)) ((setcar temp nil)) ((setq temp (cdr temp))) setq delq nil] 11])) (defalias 'mail-extr-demarkerize #[(marker) "À !ƒ ! ĉ“ˆ )‡ ‡" [markerp marker marker-position temp nil] 3]) (defalias 'mail-extr-markerize #[(pos) "À !„\n „\f ‡Â !‡" [markerp pos copy-marker] 2]) (defalias 'mail-extr-last '(macro . #[(list) "ÀÁ DCÂBB‡" [let list ((while (not (null (cdr list))) (setq list (cdr list))) (car list))] 3])) (defalias 'mail-extr-safe-move-sexp '(macro . #[(arg) "ÀÁÂÃÄÅEDÇBBÈBBB‡" [condition-case error progn goto-char scan-sexps (point) arg (t) ((error (if (string-equal (nth 1 error) "Unbalanced parentheses") nil (while t (signal (car error) (cdr error))))))] 7])) (byte-code "À B Bà BÀ‡" [disable-initial-guessing-flag current-load-list cbeg cend] 2) #@618 Given an RFC-822 ADDRESS, extract full name and canonical address. Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). If no name can be extracted, FULL-NAME will be nil. ADDRESS may be a string or a buffer. If it is a buffer, the visible (narrowed) portion of the buffer will be interpreted as the address. (This feature exists so that the clever caller might be able to avoid consing a string.) If ADDRESS contains more than one RFC-822 address, only the first is returned. Some day this function may be extended to extract multiple addresses, or perhaps return the position at which parsing stopped. (defalias 'mail-extract-address-components #[(address) "ÀÁ!ÀÂ!ɉ‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰ \n \f  !\"#$%&'()*Š)qˆë ˆì ˆí)!ˆî/!ˆ~ˆð ˆÃ1òcˆ3;ƒ¤3cˆ‚¹ô3!ƒ³õ3!ˆ‚¹ö÷3\"ˆebˆøùÃú#ƒÌûüú\"ˆ‚¼ebˆýÃwˆm„U`f(„ê(þ=„ê`(þ=ƒ7î?!ˆ„Š@uˆýÃwˆ`f)A=„`öBC„\"@uˆî/!ˆƒ;„;`‚;(D=ƒ|„\\Š@uˆýÃwˆ`f)D=„\\`öEF„l@uˆƒ;„;`‚;(G=ƒ¢îH!ˆöIJ„š@uˆî/!ˆ‚;(K=ƒæ'„º`TfL=ƒÜ&ƒæ'‰MAƒÑMA‰M‚ÄM@)&@Wƒæ`d|ˆþ(‚;(NžA‰ƒ`JBLˆ@uˆ‚;(O=ƒ@uˆ‚;(P>ƒ6Š`bˆ``@\\|ˆòcˆ)@uˆ‚;@vˆ(þ=„Ï(K=ƒOm„Ï`‚Ï'AƒvŠ'@bˆ``@\\|ˆòcˆ)'A‰'‚W&Aƒ™Š&A@bˆ``@\\|ˆòcˆ)&‰AA¡ˆ‚v%G@VƒË$G@=ƒË „Ë'„Ëebˆ``@\\|ˆ`C'Qcˆ'ƒá&„ádbˆ`C&Rcˆ&ƒ'„Š&@bˆ``@\\|ˆòcˆ)Ã&&@&'@‰'ƒ³%ÃS‰ƒ;@‰S&V„-S'Wƒ2àˆA‰„TÃ%\"%*\"ÃS‰ƒr@‰S&V„dS'WƒiàˆA‰„PTÃ\"\"\"*!ÃS‰ƒ©@‰S&V„›S'Wƒ àˆA‰„‡TÃ!\"!*$ƒ2$@$A$'ƒ&ƒ'Vƒ&Wƒ„þ%GUW„þ%@V„þ%A@WƒŠbˆ``@\\|ˆòcˆ)‚³‚³'ƒ+'ƒ³'Wƒ³‚³ ƒˆ @ A 'ƒo&ƒo'Vƒo&WƒoŠbˆ``@\\|ˆòcˆ)‚2ƒ|Vƒ2„2‚2ƒ¦„¦Šbˆ``@\\|ˆòcˆ)ÃĄĊbˆ``@\\|ˆòcˆ)ÃÞ\"ÃS‰ƒö@‰SV„èSWƒíàˆA‰„ÔTÃ\"\"\"*%ÃS‰ƒ-@‰SV„SWƒ$àˆA‰„ TÃ%\"%*!ÃS‰ƒd@‰SV„VSWƒ[àˆA‰„BTÃ!\"!*#ÃS‰ƒ›@‰SV„SWƒ’àˆA‰„yTÃ#\"#*ƒ¸TVƒ¸TƒËVƒËÃÃÞVƒÞÃÃ#ÃS‰ƒ@‰S@V„ÿS@WƒŠSbˆ``@\\|ˆòcˆ)àˆA‰„éTÃ#\"#*'ƒO'bˆýÃxˆ`ebˆýÃwˆ`WƒL`‚OÃýÃ\"Ã!V&!&V!&bˆWX!ˆ%@bˆ%A‰%ƒ¿``@\\|ˆY !B!Zcˆ&SbˆŠõ)%@#ˆ%@|ˆ)%A„{`C‚{%&bˆ``[\\|ˆŠbˆ``@\\|ˆòcˆ)\\!ˆÃ\\&!&]\\!\"!%@%*qˆë ˆì ˆí*!ˆî/!ˆÃ1~ˆð ˆõ)!ˆ'ƒ9'TbˆýÃwˆ`&}ˆ‚PƒLƒL}ˆ‚Pdd}ˆ%ƒ¡!ƒ¡!ÃS‰ƒ—@‰S%V„xSeWƒŽŠSbˆ``@\\|ˆòcˆ)àˆA‰„eTÃ!\"!*!ƒó\"ƒó\"ÃS‰ƒé@‰S!@V„ÊSeWƒàŠSbˆ``@\\|ˆòcˆ)àˆA‰„¶TÃ\"\"\"*%ƒI\"ƒI!„I\"ÃS‰ƒ?@‰S%V„ SeWƒ6ŠSbˆ``@\\|ˆòcˆ)àˆA‰„ TÃ\"\"\"*!ƒm%„m!@bˆ``@\\|ˆ`%^cˆ!A!_ƒ¸ \"ƒ¸ Œ%ƒ¡`ƒ¡%bˆ`!B!Ã%``@\\|ˆZcˆd‚õ`ƒ«d‚õ!ƒà!‰MAƒÂMA‰M‚µM@)]a!\"\nÃ!a%!%‚õ%ƒó%a%!%‚õde }ˆ\"@ \"ƒ“ dbˆ%„ \"A„ `%Wb!ˆ‚- `!B!Wc!ˆd@!ˆõp\"A@ƒF \"A@T‚G e\"@#ˆ``@\\|ˆŠöefˆýÃxˆh)O=„Š WŠýÃxˆh)O=ƒ‚ g‚… hi\"ˆ\"A‰\"„ )\nƒª j]\\\n\"!\"!\\%!% Td}ˆ!ƒÜ %„Ü !@bˆ``@\\|ˆ`%^cˆ!A!!Ÿ!k!@†ð %†ð dd\"ˆ!ƒ\n!lmˆe!ƒ\n!@‚\n%†\nd)qˆƒh\n=ƒh\nXƒh\nTS}ˆŠŒed}ˆebˆnoÃú#ƒd\n``[\\|ˆm„D\n@uˆ‚D\n*‚E\fƒv\n}ˆ‚E\fƒ³\nTS}ˆŠŒed}ˆebˆnoÃú#ƒ¬\n``[\\|ˆm„Œ\n@uˆ‚Œ\n*ebˆ‚E\fdbˆ``}ˆõ*#ˆebˆøpÃú#ebˆ_„æ\nqrst #ˆýÃwˆm„1\f`f‰(D=ƒp `öuv„ @uˆ`UZŠd@!ˆ``@\\|ˆbˆ``@\\|ˆ)ŠŒ}ˆebˆnoÃú#ƒ] ``[\\|ˆm„= @uˆ‚= *ò`f=„j wcˆú‚æ\n(O=ƒ² `Tfx>ƒ– @uˆ``@\\|ˆòcˆ‚æ\nƒ¢ e`}ˆ‚æ\n``@\\|ˆwcˆ‚æ\n(zy>ƒÌ ``@\\|ˆwcˆ‚æ\n`@vˆ`bˆŒ}ˆz{!ƒ\f]|}~E\"ˆýÃxˆ`d|ˆø€Ãú#ƒ-\fûú\"ˆ‚\febˆø‚Ãú#ƒ*\fûüú\"ˆ‚\fdbˆ)‚æ\n_„E\fqrht #ˆîƒ!ˆ„*#ˆebˆebˆ…ƒÐ\f\f„Ð\fZ†=ƒÐ\febˆz‡!ƒÐ\fˆ”f †”f Š*qˆú1‰ f\"ƒ±\f‰ Sf\"ƒ±\fTf\f*\fƒÐ\f\fzŠ=ƒÐ\f†”bˆ\f–‹±ˆdeZˆúŒ‰ŽˆVƒ7 ŽZ=ƒ7 dbˆõ*#ˆŒƒ' ŽWƒ' e\\f—Že\\\\f—=„ ÃŒT‚ü\feŽ\\d|ˆŒƒ7 ``}ˆ+ebˆƒN øÃú#„N ``}ˆedU?…Y ‘ *qˆedU?…h ‘ .(D‡" [get-buffer-create " *canonical address*" " *extract address components*" nil disable-initial-guessing-flag insert-point \.-pos domain-pos saved-@-pos saved-!-pos saved-%-pos li mi fi temp \.-ends-name mbox-end mbox-beg atom-end atom-beg quote-end quote-beg cend cbeg phrase-end phrase-beg last-real-pos first-real-pos record-pos-symbol route-addr-:-pos group-\;-pos group-:-pos \;-pos %-pos !-pos \,-pos :-pos @-pos >-pos <-pos char extraction-buffer canonicalization-buffer fundamental-mode kill-all-local-variables buffer-disable-undo set-syntax-table mail-extr-address-syntax-table erase-buffer case-fold-search 32 address bufferp insert-buffer-substring error "Illegal address: %s" re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ ]" t replace-match "\\1 " " \n  " 40 mail-extr-address-comment-syntax-table 1 41 (byte-code "À`Á\"bˆÂ‡" [scan-sexps 1 t] 3) ((error (byte-code "A@Á˜?…Â@A\"ˆ‚ ‡" [error "Unbalanced parentheses" signal] 3))) 34 (byte-code "À`Á\"bˆÂ‡" [scan-sexps 1 t] 3) ((error (byte-code "A@Á˜?…Â@A\"ˆ‚ ‡" [error "Unbalanced parentheses" signal] 3))) 91 mail-extr-address-domain-literal-syntax-table (byte-code "À`Á\"bˆÂ‡" [scan-sexps 1 t] 3) ((error (byte-code "A@Á˜?…Â@A\"ˆ‚ ‡" [error "Unbalanced parentheses" signal] 3))) 44 64 list ((60 . <-pos) (62 . >-pos) (64 . @-pos) (58 . :-pos) (44 . \,-pos) (33 . !-pos) (37 . %-pos) (59 . \;-pos)) 46 (41 93 92) 60 62 ch delq 2 copy-marker insert-before-markers 88 point-marker "%" -1 mail-extr-demarkerize mapcar "@" mail-extr-mangle-uucp mail-extr-@-binds-tighter-than-! mail-extr-markerize "@ " "% " backward-char (byte-code "À`Á\"b‡" [scan-sexps -1] 3) ((error (byte-code "A@Á˜„Â@A\"ˆ‚Ç" [error "Unbalanced parentheses" signal t] 3))) "" "." "uucp" append downcase-region truncated (byte-code "ƒiA@† bˆÂÃxˆŠÄÅƈ`ÂÃxˆhÈ= ) ƒbÊ`{ \"‰\f…;\fÍN)ƒbe`}ˆ@bˆ``Î\\|ˆ`áˆÏ \"ÑcˆÒÓÔ\"ˆA‰„Ç" [temp @-pos " \n  " nil error (byte-code "À`Á\"b‡" [scan-sexps -1] 3) ((error (byte-code "A@Á˜„Â@A\"ˆ‚Ç" [error "Unbalanced parentheses" signal t] 3))) domain-pos 46 \.-pos intern-soft mail-extr-all-top-level-domains s domain-name 1 delq %-pos "@" throw truncated t] 4) search-forward "\\" "[_0-9]" modify-syntax-entry 33 "w" syntax-table (byte-code "À`Á\"bˆÂ‡" [scan-sexps 1 t] 3) ((error (byte-code "A@Á˜?…Â@A\"ˆ‚ ‡" [error "Unbalanced parentheses" signal] 3))) " " (95 61) (46 92) looking-at mail-extr-x400-encoded-address-pattern #[(field-pattern) "ŠÀ ÂÃ#)…ÄpŔŕ#ˆÆc‡" [re-search-forward field-pattern nil t insert-buffer-substring 1 " "] 4] mail-extr-x400-encoded-address-given-name-pattern mail-extr-x400-encoded-address-surname-pattern mail-extr-x400-encoded-address-full-name-pattern mail-extr-bad-dot-pattern "\\1 \\2" "\\([^_=]+\\)[_=]" mail-extr-address-text-syntax-table mail-extr-voodoo mail-extr-guess-middle-initial 3 mail-extr-two-name-pattern 0 char-equal 119 ". " names-match-flag i buffer-length mail-extr-ignore-single-names "[- ]" buffer-string] 40 (#$ . 6944)]) (defalias 'mail-extr-voodoo #[(mbox-beg mbox-end canonicalization-buffer) "ÀÁ‰‰‰‰‰‰‰‰‰‰‰‰‰‰ \n \f ŠÒ!ˆÔÕÁÖ#„tebˆÔ×ÁÖ#ƒXebˆÔ×ÁÖ#ƒtØÕÖ\"ˆ‚HÔÙÁÖ#ƒtebˆÚÁÖ#ƒtØÜÖ\"ˆ‚cebˆ\n„bƒŠ Á\nƒ ÀÁÁÁÁÁ\nÝÁwˆÀ=ƒ¯`d}ˆ`Á À=ƒÎÞ!ƒÎÀ•bˆ`d}ˆ‚UàYƒ'Þ!!ƒ'ÝÁxˆ` gâ=ƒïãuˆ‚òâcˆäg=„ûäcˆÝÁwˆgå>ƒæã!ˆgç=ƒãuˆ‚çcˆ‚èã!ˆÖÖ‚UÞé!ƒ;ã”bˆ`d}ˆÖ\n‚Ugâ=ƒZã=ƒZãuˆÖ\fgä=„Uäcˆ‚Ugê>ƒ`+Ò,!ˆgí>ƒŠÔîÁÖïg=ƒ|à‚}ã$„”``ã\\|ˆ‚”ðñò„”dbˆÒ!ˆ`3À=ƒÁÞô!ƒÁ3+ZàYƒÁ+T3S}ˆebˆ‚U3+ZõU„ß3+ZöUƒî+à\\fç=ƒîÞô!„î+Tf ‚ñÁ +3|ˆ ƒU ÷±ˆ‚Uo„hä=ƒ2Þø!ƒ2``ã\\|ˆù`ú;<=#ˆ`\"ˆÖ>Ö‚UÞ?!ƒCØ@Ö\"ˆ‚UÞA!ƒTÀ•bˆÖ‚UÀ=ƒmÞB!ƒmÀ•bˆ`d}ˆ‚UàYƒ‡ƒ‡ÞC!ƒ‡ÞD!ƒœÞE!„œÞF!„œÞG!ƒ¡Ö‚UÞH!ƒ±À”À•|ˆ‚UÞI!ƒãgg–=„ÂÖãuˆgç=ƒÑãuˆ‚Ôçcˆäg=„ÝäcˆÖ‚UÀ=ƒÿÞJ!ƒÿã”ã•}ˆÖÖ‚UÞK!ƒS`À•àYƒ*„*ÞL!„'ç Sf=ƒ*Ö ÚM Ö#ƒJ\fbˆÚN Ö#ƒGÖ‚JÖ bˆÖ‚UÖƒwT‚w „uÞO!ƒud‰ bˆeƒ †€`}ˆ „›ebˆÖÞP!ƒšQ ˆ)\fƒÐebˆÔR!ˆ`S †²dbˆäh=„½äcˆúpe #ˆ bˆSÁwˆ`d}ˆebˆÚTÁÖ#…ïØmƒè@‚éÕÖ\"ˆ‚Ó.‡" [0 nil name-done-flag name-end name-beg last-word-beg this-word-beg word-found-flag drop-last-word-if-trailing-flag drop-this-word-if-trailing-flag begin-again-flag initial last-name-comma-flag suffix-flag lower-case-flag mixed-case-flag case-fold-search word-count set-syntax-table mail-extr-address-text-syntax-table search-forward " " t "_" replace-match "." re-search-forward mail-extr-bad-dot-pattern "\\1 \\2" " \n  " looking-at mail-extr-full-name-prefixes 2 mail-extr-full-name-suffix-pattern 44 1 32 (106 74 115 83) capitalize-word 46 upcase-word "MKA \\(.+\\)" (40 123 91 34 39 96) cbeg mail-extr-address-text-comment-syntax-table (39 96) "'" 39 error (byte-code "À`Á\"bˆÂ‡" [scan-sexps 1 t] 3) ((error (byte-code "A@Á˜?…Â@A\"ˆ‚ ‡" [error "Unbalanced parentheses" signal] 3))) cend " *\\'" 3 4 ". " "&\\( \\|\\'\\)" capitalize-region insert-buffer-substring canonicalization-buffer mbox-beg mbox-end disable-initial-guessing-flag mail-extr-stupid-vms-date-stamp-pattern "" mail-extr-hz-embedded-gb-encoded-chinese-pattern mail-extr-leading-garbage mail-extr-weird-acronym-pattern mail-extr-roman-numeral-pattern mail-extr-alternative-address-pattern mail-extr-trailing-comment-start-pattern mail-extr-telephone-extension-pattern mail-extr-ham-call-sign-pattern mail-extr-initial-pattern mail-extr-listserv-list-name-pattern mail-extr-name-pattern "[a-z][a-z][a-z][a-z]+[ ]*\\'" "[a-z]" "[A-Z]" "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'" "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'" erase-buffer "," " ," "[ \n]+"] 16]) (byte-code "ÀÁÂ\"ÄÅÆ\"ˆ )ÇBÀ‡" [make-vector 509 0 ob mapcar #[(x) "ÀÁ\n@— \"ÄÅ\n8ƒÆÅ\n8\nA@\"‚\nA@#‡" [put intern x ob domain-name 2 format] 6] (("ae" "United Arab Emirates") ("ag" "Antigua and Barbuda") ("al" "Albania") ("ao" "Angola") ("aq" "Antarctica") ("ar" "Argentina" "Argentine Republic") ("at" "Austria" "The Republic of %s") ("au" "Australia") ("az" "Azerbaijan") ("bb" "Barbados") ("bd" "Bangladesh") ("be" "Belgium" "The Kingdom of %s") ("bf" "Burkina Faso") ("bg" "Bulgaria") ("bh" "Bahrain") ("bm" "Bermuda") ("bo" "Bolivia" "Republic of %s") ("br" "Brazil" "The Federative Republic of %s") ("bs" "Bahamas") ("bw" "Botswana") ("by" "Belarus") ("bz" "Belize") ("ca" "Canada") ("cg" "Congo") ("ch" "Switzerland" "The Swiss Confederation") ("ci" "Ivory Coast") ("cl" "Chile" "The Republic of %s") ("cm" "Cameroon") ("cn" "China" "The People's Republic of %s") ("co" "Colombia") ("cr" "Costa Rica" "The Republic of %s") ("cs" "Czechoslovakia") ("cu" "Cuba") ("cy" "Cyprus") ("cz" "Czech Republic") ("de" "Germany") ("dk" "Denmark") ("dm" "Dominica") ("do" "Dominican Republic" "The %s") ("dz" "Algeria") ("ec" "Ecuador" "The Republic of %s") ("ee" "Estonia") ("eg" "Egypt" "The Arab Republic of %s") ("er" "Eritrea") ("es" "Spain" "The Kingdom of %s") ("fi" "Finland" "The Republic of %s") ("fj" "Fiji") ("fo" "Faroe Islands") ("fr" "France") ("gb" "Great Britain") ("gd" "Grenada") ("ge" "Georgia") ("gf" "Guyana (Fr.)") ("gp" "Guadeloupe (Fr.)") ("gr" "Greece" "The Hellenic Republic (%s)") ("gt" "Guatemala") ("gu" "Guam (U.S.)") ("hk" "Hong Kong") ("hn" "Honduras") ("hr" "Croatia") ("ht" "Haiti") ("hu" "Hungary" "The Hungarian Republic") ("id" "Indonesia") ("ie" "Ireland") ("il" "Israel" "The State of %s") ("in" "India" "The Republic of %s") ("ir" "Iran") ("is" "Iceland" "The Republic of %s") ("it" "Italy" "The Italian Republic") ("jm" "Jamaica") ("jp" "Japan") ("ke" "Kenya") ("kn" "St. Kitts, Nevis, and Anguilla") ("kp" "Korea (North)") ("kr" "Korea (South)") ("kw" "Kuwait") ("kz" "Kazachstan") ("lb" "Lebanon") ("lc" "St. Lucia") ("li" "Liechtenstein") ("lk" "Sri Lanka" "The Democratic Socialist Republic of %s") ("ls" "Lesotho") ("lt" "Lithuania") ("lu" "Luxembourg") ("lv" "Latvia") ("ma" "Morocco") ("md" "Moldova") ("mg" "Madagascar") ("mk" "Macedonia") ("ml" "Mali") ("mo" "Macau") ("mt" "Malta") ("mu" "Mauritius") ("mw" "Malawi") ("mx" "Mexico" "The United Mexican States") ("my" "Malaysia" "%s (changed to Myanmar?)") ("mz" "Mozambique") ("na" "Namibia") ("nc" "New Caledonia (Fr.)") ("ne" "Niger") ("ni" "Nicaragua" "The Republic of %s") ("nl" "Netherlands" "The Kingdom of the %s") ("no" "Norway" "The Kingdom of %s") ("np" "Nepal") ("nz" "New Zealand") ("pa" "Panama") ("pe" "Peru") ("pf" "Polynesia (Fr.)") ("pg" "Papua New Guinea") ("ph" "Philippines" "The Republic of the %s") ("pk" "Pakistan") ("pl" "Poland") ("pr" "Puerto Rico (U.S.)") ("pt" "Portugal" "The Portugese Republic") ("py" "Paraguay") ("re" "Reunion (Fr.)") ("ro" "Romania") ("ru" "Russian Federation") ("sa" "Saudi Arabia") ("sc" "Seychelles") ("sd" "Sudan") ("se" "Sweden" "The Kingdom of %s") ("sg" "Singapore" "The Republic of %s") ("si" "Slovenia") ("sj" "Svalbard and Jan Mayen Is.") ("sk" "Slovakia" "The Slovak Republic") ("sn" "Senegal") ("sr" "Suriname") ("su" "Soviet Union") ("sz" "Swaziland") ("tg" "Togo") ("th" "Thailand" "The Kingdom of %s") ("tm" "Turkmenistan") ("tn" "Tunisia") ("tr" "Turkey" "The Republic of %s") ("tt" "Trinidad and Tobago") ("tw" "Taiwan") ("ua" "Ukraine") ("uk" "United Kingdom" "The %s of Great Britain and Northern Ireland") ("us" "United States" "The %s of America") ("uy" "Uruguay" "The Eastern Republic of %s") ("vc" "St. Vincent and the Grenadines") ("ve" "Venezuela" "The Republic of %s") ("vi" "Virgin Islands (U.S.)") ("vn" "Vietnam") ("vu" "Vanuatu") ("yu" "Yugoslavia" "The Socialist Federal Republic of %s") ("za" "South Africa" "The Republic of %s (or Zambia? Zaire?)") ("zw" "Zimbabwe" "Republic of %s") ("arpa" t "Advanced Research Projects Agency (U.S. DoD)") ("bitnet" t "Because It's Time NET") ("com" t "Commercial") ("edu" t "Educational") ("gov" t "Government (U.S.)") ("int" t "International (NATO)") ("mil" t "Military (U.S.)") ("nato" t "North Atlantic Treaty Organization") ("net" t "Network") ("org" t "Non-profit Organization") ("uucp" t "Unix to Unix CoPy")) mail-extr-all-top-level-domains current-load-list] 3) #@62 Convert mail domain DOMAIN to the country it corresponds to. (defalias 'what-domain #[(domain) "À —\n\"‰„ÃÄ!ˆÅÆÇ !– ÈN#‡" [intern-soft domain mail-extr-all-top-level-domains error "no such domain" message "%s: %s" symbol-name domain-name] 5 (#$ . 21250) (byte-code "ÀÂÃ\fÅÀ$)C‡" [t completion-ignore-case completing-read "Domain: " mail-extr-all-top-level-domains nil] 5)]) (provide (quote mail-extr)) emacs-19.30/lisp/mail-hist.elc100666 12120 1 24661 5773627234 14501 0ustar rmsdaemon;ELC ;;; compiled by kwzh@nutrimat.gnu.ai.mit.edu on Mon Jun 26 18:02:59 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mail-hist.el ;;; emacs version 19.29.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`mail-hist.el' was compiled for Emacs 19.29 or later")) (require (quote ring)) #@67 Define keys for accessing mail header history. For use in hooks. (defalias 'mail-hist-define-keys #[nil "ÀÁÂ\"ˆÀÃÄ\"‡" [local-set-key "ð" mail-hist-previous-input "î" mail-hist-next-input] 3 (#$ . 505)]) (defalias 'mail-hist-enable #[nil "ÀÁÂ\"ˆÀÃÄ\"‡" [add-hook mail-mode-hook mail-hist-define-keys mail-send-hook mail-hist-put-headers-into-history] 3]) #@136 Alist of form (header-name . history-ring). Used for knowing which history list to look in when the user asks for previous/next input. (defvar mail-hist-header-ring-alist nil (#$ . 868)) #@94 *The maximum number of elements in a mail field's history. Oldest elements are dumped first. (defvar mail-hist-history-size (byte-code "†Á‡" [kill-ring-max 1729] 1) (#$ . -1061)) #@70 *Non-nil means keep a history for headers and text of outgoing mail. (defvar mail-hist-keep-history t (#$ . -1249)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BŇ" [boundp mail-hist-access-count 0 current-load-list mail-hist-last-bounds nil] 2) #@60 Regular expression for matching headers in a mail message. (defvar mail-hist-header-regexp "^[^:]*:" (#$ . 1492)) #@150 Get name of mail header point is currently in, without the colon. Returns nil if not in a header, implying that point is in the body of the message. (defalias 'mail-hist-current-header-name #[nil "ŠÀÁ !ÄQÅÆ#)?…CŠŠÇÁ !ÄQÅÆ#)À ÅÆ#\nËÌÆ#ˆ`S \n…B …B\n {—,‡" [re-search-backward "^" regexp-quote mail-header-separator "$" nil t re-search-forward body-start mail-hist-header-regexp name-start search-forward ":" name-end] 4 (#$ . 1613)]) (put (quote mail-hist-current-header-name) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@293 Move forward COUNT headers (backward if COUNT is negative). If last/first header is encountered first, stop there and returns nil. Places point on the first non-whitespace on the line following the colon after the header name, or on the second space following that if the header is empty. (defalias 'mail-hist-forward-header #[(count) "ŠÀÁ !ÄQÅÆ#)‰…rÆŠbˆÉyˆ`S)\nÉVƒB\nÉVƒfÀ Æ#\nS‰\n‚+\nS‰\nÉWƒ^Ì ÅÆ#\nT‰\n‚HÀ Æ#ˆÍÎ!ƒoÏuˆ))‡" [re-search-forward "^" regexp-quote mail-header-separator "$" nil t boundary unstopped 0 count mail-hist-header-regexp re-search-backward looking-at "\\s-" 1] 5 (#$ . 2170)]) (put (quote mail-hist-forward-header) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@176 Move to the start of the current header. The start of the current header is defined as one space after the colon, or just after the colon if it is not followed by whitespace. (defalias 'mail-hist-beginning-of-header #[nil "ÀŠÂÃÄ !ÆQÇÈ#)‰ …lÈ\nŠ bˆËyˆ`S) ËVƒ@ ËVƒ`Â\f È#\n S‰‚+ S‰ËWƒXÍ\fÇÈ#\n T‰‚DÂ\f È#ˆÎÏ!ƒiÐuˆ\n)*ƒÞЊÂÃÄ !ÆQÇÈ#)‰ …ÜÈ\nŠ bˆËyˆ`S) ËVƒ° ËVƒÐÂ\f È#\n S‰‚› S‰ËWƒÈÍ\fÇÈ#\n T‰‚´Â\f È#ˆÎÏ!ƒÙÐuˆ\n)*‡ÐŠÂÃÄ !ÆQÇÈ#)‰ …JÈ\nŠ bˆËyˆ`S) ËVƒ ËVƒ>Â\f È#\n S‰‚  S‰ËWƒ6Í\fÇÈ#\n T‰‚\"Â\f È#ˆÎÏ!ƒGÐuˆ\n))ˆ)ÀŠÂÃÄ !ÆQÇÈ#)‰ …¹È\nŠ bˆËyˆ`S) ËVƒ ËVƒ­Â\f È#\n S‰‚x S‰ËWƒ¥Í\fÇÈ#\n T‰‚‘Â\f È#ˆÎÏ!ƒ¶Ðuˆ\n)*‡" [-1 count re-search-forward "^" regexp-quote mail-header-separator "$" nil t boundary unstopped 0 mail-hist-header-regexp re-search-backward looking-at "\\s-" 1] 5 (#$ . 2914)]) (put (quote mail-hist-beginning-of-header) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@64 Get the contents of the mail header in which point is located. (defalias 'mail-hist-current-header-contents #[nil "ŠÀŠÂÃÄ !ÆQÇÈ#)‰ …mÈ\nŠ bˆËyˆ`S) ËVƒA ËVƒaÂ\f È#\n S‰‚, S‰ËWƒYÍ\fÇÈ#\n T‰‚EÂ\f È#ˆÎÏ!ƒjÐuˆ\n)*ƒáЊÂÃÄ !ÆQÇÈ#)‰ …ÝÈ\nŠ bˆËyˆ`S) ËVƒ± ËVƒÑÂ\f È#\n S‰‚œ S‰ËWƒÉÍ\fÇÈ#\n T‰‚µÂ\f È#ˆÎÏ!ƒÚÐuˆ\n)*‚½ÐŠÂÃÄ !ÆQÇÈ#)‰ …MÈ\nŠ bˆËyˆ`S) ËVƒ! ËVƒAÂ\f È#\n S‰‚\f S‰ËWƒ9Í\fÇÈ#\n T‰‚%Â\f È#ˆÎÏ!ƒJÐuˆ\n))ˆ)ÀŠÂÃÄ !ÆQÇÈ#)‰ …¼È\nŠ bˆËyˆ`S) ËVƒ ËVƒ°Â\f È#\n S‰‚{ S‰ËWƒ¨Í\fÇÈ#\n T‰‚”Â\f È#ˆÎÏ!ƒ¹Ðuˆ\n)*ˆ`ÒÐ!„ÐÂÃÄ !ÆQ!ˆËyˆ`S{*‡" [-1 count re-search-forward "^" regexp-quote mail-header-separator "$" nil t boundary unstopped 0 mail-hist-header-regexp re-search-backward looking-at "\\s-" 1 start mail-hist-forward-header] 5 (#$ . 3897)]) (put (quote mail-hist-current-header-contents) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@82 Get HEADER's history ring, or nil if none. HEADER is a string without the colon. (defalias 'mail-hist-get-header-ring #[(header) "—Á\n\"A‡" [header assoc mail-hist-header-ring-alist] 3 (#$ . 4838)]) (put (quote mail-hist-get-header-ring) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@125 *Don't store any header or body with more than this many characters. If the value is nil, that means no limit on text size. (defvar mail-hist-text-size-limit nil (#$ . -5145)) #@119 Return t if TEXT does not exceed mail-hist's size limit. The variable `mail-hist-text-size-limit' defines this limit. (defalias 'mail-hist-text-too-long-p #[(text) "… GV‡" [mail-hist-text-size-limit text] 2 (#$ . 5328)]) #@167 Add the contents of HEADER to the header history ring. Optional argument CONTENTS is a string which will be the contents (instead of whatever's found in the header). (defalias 'mail-hist-add-header-contents-to-ring #[(header &optional contents) "— †åŠÂŠÄÅÆ!ÈQÉÊ#)‰ …uÊ\fŠ bˆÍyˆ`S) ÍVƒI ÍVƒiÄ Ê#\f S‰‚4 S‰ÍWƒaÏÉÊ#\f T‰‚MÄ Ê#ˆÐÑ!ƒrÒuˆ\f)*ƒêÒŠÄÅÆ!ÈQÉÊ#)‰ …æÊ\fŠ bˆÍyˆ`S) ÍVƒº ÍVƒÚÄ Ê#\f S‰‚¥ S‰ÍWƒÒÏÉÊ#\f T‰‚¾Ä Ê#ˆÐÑ!ƒãÒuˆ\f)*‚ÈÒŠÄÅÆ!ÈQÉÊ#)‰ …WÊ\fŠ bˆÍyˆ`S) ÍVƒ+ ÍVƒKÄ Ê#\f S‰‚ S‰ÍWƒCÏÉÊ#\f T‰‚/Ä Ê#ˆÐÑ!ƒTÒuˆ\f))ˆ)ŠÄÅÆ!ÈQÉÊ#)‰ …ÇÊ\fŠ bˆÍyˆ`S) ÍVƒ› ÍVƒ»Ä Ê#\f S‰‚† S‰ÍWƒ³ÏÉÊ#\f T‰‚ŸÄ Ê#ˆÐÑ!ƒÄÒuˆ\f)*ˆ`ÔÒ!„ÜÄÅÆ!ÈQ!ˆÍyˆ`S{*Õ\"AÙ!ƒùÚ„ Û!BBÝ\"*‡" [header contents -1 count re-search-forward "^" regexp-quote mail-header-separator "$" nil t boundary unstopped 0 mail-hist-header-regexp re-search-backward looking-at "\\s-" 1 start mail-hist-forward-header assoc mail-hist-header-ring-alist ring ctnts mail-hist-text-too-long-p "" make-ring mail-hist-history-size ring-insert] 5 (#$ . 5560)]) (put (quote mail-hist-add-header-contents-to-ring) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@213 Put headers and contents of this message into mail header history. Each header has its own independent history, as does the body of the message. This function normally would be called when the message is sent. (defalias 'mail-hist-put-headers-into-history #[nil "…ŠebˆÁŠÃÄÅ!ÇQÈÉ#)‰\n…uÉ Š\nbˆÌyˆ`S)\n\nÌVƒI\nÌVƒià \nÉ# \nS‰‚4\nS‰ÌWƒaÎ ÈÉ# \nT‰‚Mà \nÉ#ˆÏÐ!ƒrÁuˆ )*ƒàŠÎÄÅ!ÇQÈÉ#)?…¾ŠŠÃÄÅ!ÇQÈÉ#)Î ÈÉ#ÓÔÉ#ˆ`S…½…½{—,ȉ—†ªŠØŠÃÄÅ!ÇQÈÉ#)‰\n…:É Š\nbˆÌyˆ`S)\n\nÌVƒ\nÌVƒ.à \nÉ# \nS‰‚ù\nS‰ÌWƒ&Î ÈÉ# \nT‰‚à \nÉ#ˆÏÐ!ƒ7Áuˆ )*ƒ¯ÁŠÃÄÅ!ÇQÈÉ#)‰\n…«É Š\nbˆÌyˆ`S)\n\nÌVƒ\nÌVƒŸÃ \nÉ# \nS‰‚j\nS‰ÌWƒ—Î ÈÉ# \nT‰‚ƒÃ \nÉ#ˆÏÐ!ƒ¨Áuˆ )*‚ÁŠÃÄÅ!ÇQÈÉ#)‰\n…É Š\nbˆÌyˆ`S)\n\nÌVƒð\nÌVƒÃ \nÉ# \nS‰‚Û\nS‰ÌWƒÎ ÈÉ# \nT‰‚ôà \nÉ#ˆÏÐ!ƒÁuˆ ))ˆ)ØŠÃÄÅ!ÇQÈÉ#)‰\n…ŒÉ Š\nbˆÌyˆ`S)\n\nÌVƒ`\nÌVƒ€Ã \nÉ# \nS‰‚K\nS‰ÌWƒxÎ ÈÉ# \nT‰‚dà \nÉ#ˆÏÐ!ƒ‰Áuˆ )*ˆ`ÚÁ!„¡ÃÄÅ!ÇQ!ˆÌyˆ`S{*Û\"Aß!ƒ¿à„Ôá\"!BBã\"*ˆ*‚ŠebˆÃÄÅ!ÇQÈ\"ˆÁyˆ`d{)$å$‰—†æŠØŠÃÄÅ!ÇQÈÉ#)‰\n…vÉ Š\nbˆÌyˆ`S)\n\nÌVƒJ\nÌVƒjà \nÉ# \nS‰‚5\nS‰ÌWƒbÎ ÈÉ# \nT‰‚Nà \nÉ#ˆÏÐ!ƒsÁuˆ )*ƒëÁŠÃÄÅ!ÇQÈÉ#)‰\n…çÉ Š\nbˆÌyˆ`S)\n\nÌVƒ»\nÌVƒÛà \nÉ# \nS‰‚¦\nS‰ÌWƒÓÎ ÈÉ# \nT‰‚¿Ã \nÉ#ˆÏÐ!ƒäÁuˆ )*‚ÉÁŠÃÄÅ!ÇQÈÉ#)‰\n…XÉ Š\nbˆÌyˆ`S)\n\nÌVƒ,\nÌVƒLà \nÉ# \nS‰‚\nS‰ÌWƒDÎ ÈÉ# \nT‰‚0à \nÉ#ˆÏÐ!ƒUÁuˆ ))ˆ)ØŠÃÄÅ!ÇQÈÉ#)‰\n…ÈÉ Š\nbˆÌyˆ`S)\n\nÌVƒœ\nÌVƒ¼Ã \nÉ# \nS‰‚‡\nS‰ÌWƒ´Î ÈÉ# \nT‰‚ Ã \nÉ#ˆÏÐ!ƒÅÁuˆ )*ˆ`ÚÁ!„ÝÃÄÅ!ÇQ!ˆÌyˆ`S{*Û\"Aß!ƒûà„á\"!BBã\".‡" [mail-hist-keep-history 1 count re-search-forward "^" regexp-quote mail-header-separator "$" nil t boundary unstopped 0 mail-hist-header-regexp re-search-backward looking-at "\\s-" body-start name-start search-forward ":" name-end contents header -1 start mail-hist-forward-header assoc mail-hist-header-ring-alist ring ctnts mail-hist-text-too-long-p "" make-ring mail-hist-history-size ring-insert body-contents "body"] 6 (#$ . 6820)]) #@281 Insert the previous contents of this mail header or message body. Moves back through the history of sent mail messages. Each header has its own independent history, as does the body of the message. The history only contains the contents of outgoing messages, not received mail. (defalias 'mail-hist-previous-input #[(header) "—Á\n\"AÄ !Ç=‰ƒ!É\n \"\n‚$Ë\n „2Ì ˆÍÎ\"‚aÏ !ƒ?ÐÑ\"‚aƒL@A|ˆ`Ô \n\"cˆ`Blj)+‡" [header assoc mail-hist-header-ring-alist ring ring-length len last-command mail-hist-input-access repeat ring-plus1 mail-hist-access-count 0 ding message "No history for \"%s\"." ring-empty-p error "\"%s\" ring is empty." mail-hist-last-bounds start ring-ref this-command] 4 (#$ . 8934) (list (or (mail-hist-current-header-name) "body"))]) #@427 Insert next contents of this mail header or message body. Moves back through the history of sent mail messages. Each header has its own independent history, as does the body of the message. Although you can do so, it does not make much sense to call this without having called `mail-hist-previous-header' first (\[mail-hist-previous-header]). The history only contains the contents of outgoing messages, not received mail. (defalias 'mail-hist-next-input #[(header) "—Á\n\"AÄ !Ç=‰ƒ!É\n \"\n‚$Ë\n „2Ì ˆÍÎ\"‚aÏ !ƒ?ÐÑ\"‚aƒL@A|ˆ`Ô \n\"cˆ`Blj)+‡" [header assoc mail-hist-header-ring-alist ring ring-length len last-command mail-hist-input-access repeat ring-minus1 mail-hist-access-count 0 ding message "No history for \"%s\"." ring-empty-p error "\"%s\" ring is empty." mail-hist-last-bounds start ring-ref this-command] 4 (#$ . 9721) (list (or (mail-hist-current-header-name) "body"))]) (provide (quote mail-hist)) emacs-19.30/lisp/mail-utils.elc100666 13437 1 10320 6054022104 14763 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 20 01:46:22 1995 ;;; from file /home/fsf/rms/e19/lisp/mail-utils.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`mail-utils.el' was compiled for Emacs 19.29 or later")) (require (quote lisp-mode)) #@148 *If non-nil, use a full, hairy RFC822 parser on mail addresses. Otherwise, (the default) use a smaller, somewhat faster, and often correct parser. (defvar mail-use-rfc822 nil (#$ . -507)) (defalias 'mail-file-babyl-p #[(file) "ÀÁ!ÃŽŠ\nqˆÄ ÆÇÈ$ˆÉÊ!+‡" [generate-new-buffer " *rmail-file-p*" buf ((kill-buffer buf)) insert-file-contents file nil 0 100 looking-at "BABYL OPTIONS:"] 5]) #@102 Returns a string containing all of STRING except the part from START (inclusive) to END (exclusive). (defalias 'mail-string-delete #[(string start end) "„  O‡  O ÄOP‡" [end string 0 start nil] 4 (#$ . 898)]) #@173 Delete comments and quoted strings in an address list ADDRESS. Also delete leading/trailing whitespace and replace FOO with just BAR. Return a modified address list. (defalias 'mail-strip-quoted-names #[(address) "…Ý ƒÂÃ!ˆÄÅÆ!Ç#‡È ÊË\"ˆÌ•ÊÍÌ•#OÊÎ\"ƒiŠÏÐ!qˆÑ ˆcˆÒ!ˆÔbˆÕÖÈ×#ƒ_ØuˆÙÈxˆ`ŠÈÚÛˆ`)|ˆ‚BÜ Ñ ˆ)‚~ÊÝ\"‰ ƒ~Þ Ì•#‚iÌ Êß #‰ ƒ°GÌ•Vƒ¥Ì•HàUƒ¥Ì• ‚Þ Ì•#‚Êá\"‰ ƒÛÔ•â”Ì•#$%Þ#S##Þ%$#+‚°)‡" [address mail-use-rfc822 require rfc822 mapconcat identity rfc822-addresses ", " nil pos string-match "\\`[ \n]*" 0 "[ \n]*\\'" "[ ]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*(" get-buffer-create " *temp*" erase-buffer set-syntax-table lisp-mode-syntax-table 1 search-forward "(" t -1 " " (forward-sexp 1) ((error (byte-code "db‡" [] 1))) buffer-string "[ ]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*)" mail-string-delete "[ ]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \n]*" 64 "\\(,\\s-*\\|\\`\\)[^,]*<\\([^>,]*>\\)" 2 close junk-end junk-beg] 6 (#$ . 1119)]) (byte-code "ÀÁ!ƒ\n „\fÂÀ‡" [boundp rmail-default-dont-reply-to-names "info-"] 2) #@184 Returns string of mail addresses USERIDS sans any recipients that start with matches for `rmail-dont-reply-to-names'. Usenet paths ending in an element that matches are removed also. (defalias 'rmail-dont-reply-to #[(userids) "„ ƒ ÂP‚ÃÄÅ !ÆPPÇÈQÉʉ \f Ï\"‰\fƒ^\fÑVƒ=Ò”\fÏÓÑ•#ƒLÑ•‚OG Ô\f #‚&ÏÕ\"‰\fƒqÑ\fOÏÖ\"ƒ‚Ñ•ÊO‚„,‡" [rmail-dont-reply-to-names rmail-default-dont-reply-to-names "\\|" "" regexp-quote user-login-name "\\>" "\\(^\\|,\\)[ \n]*\\([^,\n]*!\\|\\)\\(" "\\)" t nil epos pos case-fold-search match string-match userids 0 2 "[ \n,]+" mail-string-delete "[ , \n]*\\'" "\\s *"] 4 (#$ . 2203)]) #@279 Return the value of the header field FIELD-NAME. The buffer is expected to be narrowed to just the headers of the message. If second arg LAST is non-nil, use the last such field if there are several. If third arg ALL is non-nil, concatenate all such fields with commas between. (defalias 'mail-fetch-field #[(field-name &optional last all) "ŠebˆÀÁ !ÄQƒ`È Ê ËÀ#ƒR`\fÍyˆÎÏ!„!Ðuˆhу9Ðuˆ‚- ‰È˜ƒEÈ‚FÒÓ\f`\"Q )‚ Ș?…\\ )‚–Ê ËÀ#…–ƒuÊ ËÀ#„m`\fÍyˆÎÏ!„xÐuˆhÕƒÐuˆ‚„Ó\f`\")+‡" [t "^" regexp-quote field-name "[ ]*:[ ]*" name case-fold-search all "" value re-search-forward nil opoint 1 looking-at "[ ]" -1 (32 9) ", " buffer-substring-no-properties last (32 9)] 5 (#$ . 2867)]) (defalias 'mail-parse-comma-list #[nil "À‰ÃÀwˆm„'`ÄÀwˆÃÀxˆ `{\nBÄÀwˆÅÀwˆ‚\n*‡" [nil beg accumulated " " "^," ", "] 2]) (defalias 'mail-comma-list-regexp #[(labels) "ÀÂÃ\f\"†\nÅ\f ÂÆ\f #OÂÇ\f\"‰ƒ,\fÅ OÈ\fÅ•ÀOQ‚)\f‡" [nil pos string-match "[^ ]" labels 0 "[ ]*$" "[ ]*,[ ]*" "\\|"] 6]) (defalias 'mail-rfc822-time-zone #[(time) "À !@†ÂÄ !Å¥ÇÈ ÂWƒÉ‚ÊÅ¥Ŧ$*‡" [current-time-zone time 0 sec abs 60 absmin format "%c%02d%02d" 45 43] 6]) (defalias 'mail-rfc822-date #[nil "À  !ÄÅ \"ˆ ƔƕOÇ È”È•OÇ É”É•OÇ Ê”Ê•OÇË !° *‡" [current-time time current-time-string s string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" 2 " " 1 4 3 mail-rfc822-time-zone] 10]) (provide (quote mail-utils)) emacs-19.30/lisp/makesum.elc100666 13437 1 3037 5744576711 14363 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:46:16 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/makesum.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/makesum.el' was compiled for Emacs 19")) #@116 Make a summary of current key bindings in the buffer *Summary*. Previous contents of that buffer are killed first. (defalias 'make-command-summary #[nil "ÀÁ!ˆÂ‹ˆÃŠ\fqˆÇ ˆÈÉ!ˆebˆ`Êyˆ`|ˆËÌÍÎ#ƒ0ÏÐ!ˆ‚!ebˆËÑÍÎ#ƒBÏÒ!ˆ‚3ebˆËÓÍÎ#ƒTÏÔ!ˆ‚EebˆËÕÍÎ#ƒfÏÖ!ˆ‚WebˆË×ÍÎ#ƒxÏØ!ˆ‚iebˆÙÚÍÎ#ƒžÛuˆÜ ݱˆËÞÍÎ#ƒž`Ûyˆ`|ˆ‚Œebˆßà áâO㱈`äyˆ`|ˆÊyˆm„Ô`%ÙæÍÎ#„Çdbˆç%`\"ˆÊyˆ)‚µeb*‘ˆÀè!‡" [message "Making command summary..." ((describe-bindings)) "*Summary*" mode-name cur-mode standard-output erase-buffer insert-buffer-substring "*Help*" 1 search-forward " " nil t replace-match " " "-@ " "-SP" " .. ~ " "SP .. ~" "C-?" "DEL" "C-i" "TAB" re-search-forward "^Local Bindings:" -1 " for " " Mode" "??\n" "Emacs command summary, " current-time-string 0 10 ".\n" 2 beg "^$" double-column "Making command summary...done"] 5 (#$ . 484) nil]) (defalias 'double-column #[(start end) "À‰‰‰‰d ZÈ \"‰ÊX„j TË¥ bˆŠyˆ WƒNT`ŠÀˆ`){‰\fB`Êyˆ`|ˆ‚+)\fŸ‰ƒjÀˆÌjˆ\f@cˆÊyˆ\fA‰„Vd\nZb.‡" [nil end from-end nlines lines line cnt half count-lines start 1 2 41] 8 nil "r"]) emacs-19.30/lisp/mailabbrev.elc100666 13437 13 22627 6045302451 14570 0ustar jimbuser;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 21:08:35 1995 ;;; from file /home/fsf/rms/e19/lisp/mailabbrev.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`mailabbrev.el' was compiled for Emacs 19.29 or later")) (require (quote sendmail)) #@262 Word-abbrev table of mail address aliases. If this is nil, it means the aliases have not yet been initialized and should be read from the .mailrc file. (This is distinct from there being no aliases, which is represented by this being a table with no entries.) (defvar mail-abbrevs nil (#$ . 508)) (defalias 'mail-abbrevs-setup #[nil "À !„ !ƒÄ ˆÅÆ!ˆÇÆÈÉÊ$ˆËÌ!‡" [vectorp mail-abbrevs file-exists-p mail-personal-alias-file build-mail-abbrevs make-local-hook pre-abbrev-expand-hook add-hook sendmail-pre-abbrev-expand-hook nil t abbrev-mode 1] 5]) #@142 Read mail aliases from personal mail alias file and set `mail-abbrevs'. By default this is the file specified by `mail-personal-alias-file'. (defalias 'build-mail-abbrevs #[(&optional file recursivep) "À †\n!Ã\f!„ÅÆÄÅ\"ˆÇÈ \"ˆÅp \nËŽÌÍ!\nÎ\n!ˆ\nqˆÏ !ƒEŠÏ !qˆed{)cˆ‚OÐ !ƒOÑ !ˆdbˆhÒ=„[Ó ˆebˆÔÕÅÖ#ƒw`×Zň`|ˆ)‚^ebˆm„›ÅˆhÙUƒ•ÚÛ!ˆÚÜ!ˆÝcˆ‚zÜuˆ‚zebˆÞßÅÖ#ƒãàyˆáâ!ƒÀňãäܔܕ{!Ö\"ˆ‚žÞå!ˆÜ”Ü•{&çÅwˆ`(ňé&(`{Ö#ˆ*‚ž*„ëë ˆ+Çì \"‡" [expand-file-name file mail-personal-alias-file vectorp mail-abbrevs nil define-abbrev-table message "Parsing %s..." obuf buffer ((byte-code "ƒÁ!ˆ\nq‡" [buffer kill-buffer obuf] 2)) generate-new-buffer "mailrc" buffer-disable-undo get-file-buffer file-exists-p insert-file-contents 10 newline search-forward "# " t 2 p 92 delete-char -1 1 32 re-search-forward "^\\(a\\(lias\\)?\\|g\\(roup\\)?\\|source\\)[ ]+" 0 looking-at "source[ ]+\\([^ \n]+\\)" build-mail-abbrevs substitute-in-file-name "[ ]+\\([^ \n]+\\)" name " " start define-mail-abbrev recursivep mail-resolve-all-aliases "Parsing %s... done"] 4 (#$ . 1067)]) #@213 *A string inserted between addresses in multi-address mail aliases. This has to contain a comma, so ", " is a reasonable value. You might also want something like ",\n " to get each address on its own line. (defvar mail-alias-separator-string ", " (#$ . -2159)) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp mail-abbrev-aliases-need-to-be-resolved t current-load-list] 2) #@137 Define NAME as a mail alias abbrev that translates to DEFINITION. If DEFINITION contains multiple addresses, separate them with commas. (defalias 'define-mail-abbrev #[(name definition &optional from-mailrc-file) "À !„ÂÃÁÂ\"ˆÄ !ƒÆ ˆÇÈ \"ƒ& Ê•ÂO ÇË \"ƒ6 ʉ”O Â\f G‰ ÊV…Eʃ¦ƒ{ HÑ=ƒoTÇÒ #‚„ÇÓ #‚„ÇÔ # O\fB\f… Ê• U?… Ê•‰„OÕÖ\fŸ# ,Ø—Ü  Ý$)‡" [vectorp mail-abbrevs nil define-abbrev-table file-exists-p mail-personal-alias-file build-mail-abbrevs string-match "\\`[ \n,]+" definition 0 "[ \n,]+\\'" result L start end from-mailrc-file 34 "\"[ ,]*" "[ ,]+" "[ \n,]*,[ \n,]*" mapconcat identity mail-alias-separator-string t mail-abbrev-aliases-need-to-be-resolved name abbrevs-changed define-abbrev mail-abbrev-expand-hook] 6 (#$ . 2533) "sDefine mail alias: \nsDefine %s as mail alias for: "]) #@59 Resolve all forward references in the mail aliases table. (defalias 'mail-resolve-all-aliases #[nil "…Á\n!ƒÃÄ\n\"ˆÅ‰‡" [mail-abbrev-aliases-need-to-be-resolved vectorp mail-abbrevs mapatoms mail-resolve-all-aliases-1 nil] 3 (#$ . 3418)]) (defalias 'mail-resolve-all-aliases-1 #[(sym &optional so-far) " >ƒÂÃÄÅ BÆ#\"ˆÇ!…J‰ƒ\\ÉÊ \f ƒLÍÎ # O\fB\f…FÊ• )‚%ÄÐ\fŸ#Lˆ*)J‡" [sym so-far error "mail alias loop detected: %s" mapconcat symbol-name " <- " boundp definition nil 0 start result string-match "[ \n]*,[, \n]*" end #[(x) "ÀÁ\n— \"\f B\"†\n‡" [mail-resolve-all-aliases-1 intern-soft x mail-abbrevs sym so-far] 4] mail-alias-separator-string] 7]) #@198 For use as the fourth arg to `define-abbrev'. After expanding a mail-abbrev, if Auto Fill mode is on and we're past the fill-column, break the line at the previous comma, and indent the next line. (defalias 'mail-abbrev-expand-hook #[nil "Š`À‰‰Åyˆ`\fbˆ…TiY…TÈÉ Ê#…T`ËuˆÌcˆÍ ˆ`Î ˆ\f`{ÀˆiVƒN †HÏÑ ˆ)\nbˆ‚-‡" [nil fp comma bol p 0 auto-fill-function fill-column search-backward "," t 1 "\n" delete-horizontal-space indent-relative " " fill-prefix do-auto-fill] 4 (#$ . 4120)]) #@387 *Regexp to select mail-headers in which mail abbrevs should be expanded. This string will be handed to `looking-at' with point at the beginning of the current line; if it matches, abbrev mode will be turned on, otherwise it will be turned off. (You don't need to worry about continuation lines.) This should be set to match those mail fields in which you want abbreviations turned on. (defvar mail-abbrev-mode-regexp "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):" (#$ . -4625)) #@171 The syntax table used in send-mail mode when in a mail-address header. `mail-mode-syntax-table' is used when the cursor is in the message body or in non-address headers. (defvar mail-mode-header-syntax-table (byte-code "À !ÃÄÅ\n#ˆÃÆÅ\n#ˆÃÇÅ\n#ˆÃÈÅ\n#ˆÃÉÅ\n#ˆÃÊÅ\n#ˆÃËÌ\n#ˆÃÍÎ\n#ˆ\n)‡" [copy-syntax-table text-mode-syntax-table tab modify-syntax-entry 64 "_" 37 33 46 95 45 60 "(>" 62 ")<"] 4) (#$ . 5120)) #@211 The syntax-table used for abbrev-expansion purposes. This is not actually made the current syntax table of the buffer, but simply controls the set of characters which may be a part of the name of a mail alias. (defvar mail-abbrev-syntax-table (byte-code "À !à ÄHà ÆHÈÉ\n\"ˆ\n+‡" [copy-syntax-table mail-mode-header-syntax-table tab standard-syntax-table 95 _ 119 w map-char-table #[(key value) " š…  \f #‡" [value _ set-char-table-range tab key w] 4]] 3) (#$ . 5534)) #@50 Whether point is in a mail-address header field. (defalias 'mail-abbrev-in-expansion-header-p #[nil "ÀŠÂyˆÃÄ!ƒ`eU„Åyˆ‚Ã!)…2`ŠebˆÇÈ ÈQÊÂ#ˆ`)W)‡" [t case-fold-search 0 looking-at "^[ ]" -1 mail-abbrev-mode-regexp search-forward "\n" mail-header-separator nil] 5 (#$ . 6015)]) (byte-code "À BÀ‡" [mail-mode-abbrev-table current-load-list] 2) (defalias 'sendmail-pre-abbrev-expand-hook #[nil "…RÁ=?…R ƒE ƒÄ ˆÆ!ˆ¨ƒ,zÉ=„=Ê Æ\f!ˆÍ ˆÆ!ˆ)dp‰‡ÐÑ!…MÆ!‡" [mail-abbrevs t mail-abbrev-in-expansion-header-p mail-abbrev-aliases-need-to-be-resolved mail-resolve-all-aliases local-abbrev-table set-syntax-table mail-mode-header-syntax-table last-command-char 95 nil pre-abbrev-expand-hook mail-abbrev-syntax-table expand-abbrev abbrev-start-location abbrev-start-location-buffer boundp mail-mode-abbrev-table mail-mode-syntax-table] 2]) #@60 Merge mail aliases from the given file with existing ones. (defalias 'merge-mail-abbrevs #[(file) "À !‡" [build-mail-abbrevs file] 2 (#$ . 6886) (list (let ((insert-default-directory t) (default-directory (expand-file-name "~/")) (def mail-personal-alias-file)) (read-file-name (format "Read additional aliases from file: (default %s) " def) default-directory (expand-file-name def default-directory) t)))]) #@51 Rebuild all the mail aliases from the given file. (defalias 'rebuild-mail-abbrevs #[(&optional file) "„ ÂÄ!‡" [file buffer-file-name nil mail-abbrevs build-mail-abbrevs] 2 (#$ . 7300) (list (let ((insert-default-directory t) (default-directory (expand-file-name "~/")) (def mail-personal-alias-file)) (read-file-name (format "Read mail aliases from file: (default %s) " def) default-directory (expand-file-name def default-directory) t)))]) #@37 Prompt for and insert a mail alias. (defalias 'mail-interactive-insert-alias #[(&optional alias) "À !„  ˆ ƒÄ \"J†ÅcˆÆ ‡" [vectorp mail-abbrevs mail-abbrevs-setup alias intern-soft "" mail-abbrev-expand-hook] 3 (#$ . 7753) (byte-code "À !„  ˆÃÄ ÅÆ$C‡" [vectorp mail-abbrevs mail-abbrevs-setup completing-read "Expand alias: " nil t] 5)]) #@832 Expand any mail abbrev, then move cursor vertically down ARG lines. If there is no character in the target line exactly under the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. If there is no line in the buffer after this one, a newline character is inserted to create a line and the cursor moves to that line. The command \[set-goal-column] can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically. This goal column is stored in `goal-column', which is nil when there is none. If you are thinking of using this in a Lisp program, consider using `forward-line' instead. It is usually easier to use and more reliable (no dependence on goal column, etc.). (defalias 'mail-abbrev-next-line #[(&optional arg) "ÀÁ!ƒ  ˆÃà !‡" [looking-at "[ ]*\n" expand-abbrev next-line this-command arg] 2 (#$ . 8106) "p"]) #@257 Expand any mail abbrev, then move point to end of buffer. Leave mark at previous position. With arg N, put point N/10 of the way from the true end. Don't use this command in Lisp programs! (goto-char (point-max)) is faster and avoids clobbering the mark. (defalias 'mail-abbrev-end-of-buffer #[(&optional arg) "ÀÁ!ƒ  ˆÃà !‡" [looking-at "[ ]*\n" expand-abbrev end-of-buffer this-command arg] 2 (#$ . 9097) "P"]) (byte-code "À ÂÃ#ˆÄÅ!‡" [define-key mail-mode-map "" mail-interactive-insert-alias provide mailabbrev] 4) emacs-19.30/lisp/mailalias.elc100666 13437 1 6606 6001044025 14631 0ustar jimbdaemon;ELC ;;; compiled by kwzh@kropotkin.gnu.ai.mit.edu on Wed Jul 12 18:09:22 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mailalias.el ;;; emacs version 19.29.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`mailalias.el' was compiled for Emacs 19.29 or later")) (require (quote sendmail)) #@285 Expand all mail aliases in suitable header fields found between BEG and END. Suitable header fields are `To', `From', `CC' and `BCC', `Reply-to', and their `Resent-' variants. Optional second arg EXCLUDE may be a regular expression defining text to be removed from alias expansions. (defalias 'expand-mail-aliases #[(beg end &optional exclude) "À ˆ Â=ƒÃÄ ˆ bˆÆ ÓÃÂÉÊÂ#)ƒ ËÃwˆ`ɉ‰‰\f ÉÒÓ#ˆÔyˆÕÃxˆÖ bˆ`Wƒ`\fƒz\f@AZVƒz\fA‰\f„dÉ×Â#ƒÔ”`Z ‚™Ø!Ô ÃÙ\"Ü\f\"„ Ü \"A‰ƒ ZB\fB\fbˆcˆƒøÞßQÖ  bˆÉ Â#ƒóáâ!ˆ‚âbˆ*``Z\\|ˆbˆ‚bˆ uˆ*‚UÉ“ˆ.‚É“)‡" [sendmail-synch-aliases mail-aliases t nil build-mail-aliases beg make-marker end case-fold-search re-search-forward "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):" " " disabled-aliases seplen epos pos end1 beg1 "^[^ ]" move 0 " \n" point-marker "[ ]*[\n,][ ]*" marker-position buffer-substring-no-properties string translation assoc exclude "\\b\\(" "\\)\\b" regexp replace-match ""] 7 (#$ . 511)]) #@140 Read mail aliases from personal aliases file and set `mail-aliases'. By default, this is the file specified by `mail-personal-alias-file'. (defalias 'build-mail-aliases #[(&optional file) "À †\n!ÃpÆŽÇÈ!É !ˆ qˆ ƒ©Ê !ƒ2ŠÊ !qˆed{)cˆ‚RË !ƒ?Ì !ˆ‚RËÍ P‰!ƒPÌ !ˆ‚RÃdbˆhÎ=„^Ï ˆebˆm„‚ÈhÐUƒ|ÑÒ!ˆÑÓ!ˆÔcˆ‚aÓuˆ‚aebˆÕÖÃ×#ƒ£ÕØ!ˆÙ”Ù•{ÙyˆÚcˆÙyˆ‚É„ebˆÕÛÃ×#ƒÑÜÝ!ßÃwˆ` Èá `{×#ˆ*‚¬\"+‡" [expand-file-name file mail-personal-alias-file nil obuf buffer ((byte-code "ƒÁ!ˆ\nq‡" [buffer kill-buffer obuf] 2)) generate-new-buffer "mailrc" buffer-disable-undo get-file-buffer file-exists-p insert-file-contents "~/" 10 newline 92 delete-char -1 1 32 re-search-forward "^source[ ]+" t "\\S-+" 0 "# " "^\\(a\\|alias\\|g\\|group\\)[ ]+\\([^ ]+\\)" match-string 2 name " " start define-mail-alias mail-aliases] 5 (#$ . 1586)]) #@360 Define NAME as a mail alias that translates to DEFINITION. This means that sending a message to NAME will actually send to DEFINITION. Normally, the addresses in DEFINITION must be separated by commas. If FROM-MAILRC-FILE is non-nil, then addresses in DEFINITION can be separated by spaces; an address can contain spaces if it is quoted with double-quotes. (defalias 'define-mail-alias #[(name definition &optional from-mailrc-file) "À ˆ Â=ƒÃÄ !ƒÆ ˆÇÈ \"ƒ$ Ê•ÃO ÇË \"ƒ4 ʉ”O à ̚?…>Ê GÉ ƒ©ƒ~ HÓ=ƒrTÇÔ #‚‡ÇÕ #‚‡ÇÖ # OB…£Ê•U?…£Ê•‰„R×ØŸÙ# Ú \"‰ ƒÅ  ¡‚Î B B‰-‡" [sendmail-synch-aliases mail-aliases t nil file-exists-p mail-personal-alias-file build-mail-aliases string-match "\\`[ \n,]+" definition 0 "[ \n,]+\\'" "" tem end L start result from-mailrc-file 34 "\"[ ,]*" "[ ,]+" "[ \n,]*,[ \n,]*" mapconcat identity ", " assoc name] 6 (#$ . 2436) "sDefine mail alias: \nsDefine %s as mail alias for: "]) (provide (quote mailalias)) emacs-19.30/lisp/mailpost.elc100666 13437 1 3370 5744576700 14547 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:46:07 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mailpost.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/mailpost.el' was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!‡" [require mailalias sendmail] 2) #@130 The MH -post interface for `rmail-mail' to call. To use it, include "(setq send-mail-function 'post-mail-send-it)" in site-init. (defalias 'post-mail-send-it #[nil "ƒ\nÁÂ!‚ ÃÄÁÅ!Ɖp \n \fÍŽŠ\nqˆÎ ˆÏ!ˆdbˆhÐU„9ÐcˆebˆÑÒÒQ!ˆÔÕ!ˆÖ×!ˆØ ƒ[Úe\"ˆebˆÛÜÝ#ƒu`WƒuÔÒ!ˆ‚^Ý ebˆÛÞÝ#ƒ‰ß!ˆebˆÛàÝ#ƒ­ŠebˆÛáÝ#)„­×yˆâã Ò±ˆebˆÛäÝ#ƒ½Ôå!ˆƒÊŠ\fqˆÎ ˆ))æç !‰ !ˆè é\"ˆêëìíî!ƒé.‚êïÆ\fÆðñ¯ƒúò‚ûó C#\"ˆ…+Š\fqˆebˆÛôÆÝ#ƒÔõ!ˆ‚ ö ÃU?…*÷øed{\").‡" [mail-interactive generate-new-buffer " post-mail errors" 0 "/tmp/,rpost" " post-mail temp" nil mailbuf delimline case-fold-search tembuf temfile errbuf ((byte-code "À !ˆÂ !ƒÄ !ˆÀ‡" [kill-buffer tembuf bufferp errbuf switch-to-buffer] 2)) erase-buffer insert-buffer-substring 10 search-forward "\n" mail-header-separator replace-match "\n\n" backward-char 1 point-marker mail-aliases expand-mail-aliases re-search-forward "\n\n\n*" t "^FCC:" mail-do-fcc "^From:" "^Sender:" "Sender: " user-login-name "^Subject:[ ]*\n" "" write-file make-temp-name set-file-modes 384 apply call-process append boundp post-mail-program "/usr/uci/lib/mh/post" "-nofilter" "-msgid" ("-watch") ("-nowatch") "\n\n* *" "; " buffer-size error "Sending...failed to %s"] 9 (#$ . 540)]) emacs-19.30/lisp/make-mode.elc100666 13437 1 73323 6051027351 14564 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 00:04:19 1995 ;;; from file /home/fsf/rms/e19/lisp/make-mode.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`make-mode.el' was compiled for Emacs 19.29 or later")) (provide (quote makefile)) #@47 Name of the macro- and target browser buffer. (defvar makefile-browser-buffer-name "*Macros and Targets*" (#$ . 505)) #@107 String to append to all target names inserted by `makefile-insert-target'. ":" or "::" are common values. (defvar makefile-target-colon ":" (#$ . 630)) #@286 String to append to all macro names inserted by `makefile-insert-macro'. The normal value should be " = ", since this is what standard make expects. However, newer makes such as dmake allow a larger variety of different macro assignments, so you might prefer to use " += " or " := " . (defvar makefile-macro-assign " = " (#$ . 789)) #@59 If non-nil, install electric keybindings. Default is nil. (defvar makefile-electric-keys nil (#$ . 1128)) #@179 Controls the style of generated macro references. t (actually non-nil) means macro references should use curly braces, like `${this}'. nil means use parentheses, like `$(this)'. (defvar makefile-use-curly-braces-for-macros-p nil (#$ . 1241)) #@98 If non-nil, insert a TAB after a target colon. Otherwise, a space is inserted. The default is t. (defvar makefile-tab-after-target-colon t (#$ . 1489)) #@61 Number of blanks to the left of the browser selection mark. (defvar makefile-browser-leftmost-column 10 (#$ . 1647)) #@83 Column in which the cursor is positioned when it moves up or down in the browser. (defvar makefile-browser-cursor-column 10 (#$ . 1770)) #@67 *Column in which `makefile-backslash-region' inserts backslashes. (defvar makefile-backslash-column 48 (#$ . -1913)) #@54 String used to mark selected entries in the browser. (defvar makefile-browser-selected-mark "+ " (#$ . 2036)) #@56 String used to mark unselected entries in the browser. (defvar makefile-browser-unselected-mark " " (#$ . 2153)) #@65 If non-nil, cursor will move after item is selected in browser. (defvar makefile-browser-auto-advance-after-selection-p t (#$ . 2274)) #@160 If non-nil, `makefile-pickup-everything' picks up filenames as targets. (i.e. it calls `makefile-find-filenames-as-targets'). Otherwise filenames are omitted. (defvar makefile-pickup-everything-picks-up-filenames-p nil (#$ . 2416)) #@312 If non-nil, automatically clean up continuation lines when saving. A line is cleaned up by removing all whitespace following a trailing backslash. This is done silently. IMPORTANT: Please note that enabling this option causes makefile-mode to MODIFY A FILE WITHOUT YOUR CONFIRMATION when 'it seems necessary'. (defvar makefile-cleanup-continuations-p t (#$ . 2655)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp makefile-browser-hook nil current-load-list] 2) #@162 List of special targets. You will be offered to complete on one of those in the minibuffer whenever you enter a "." at the beginning of a line in makefile-mode. (defvar makefile-special-targets-list (quote (("DEFAULT") ("DONE") ("ERROR") ("EXPORT") ("FAILED") ("GROUPEPILOG") ("GROUPPROLOG") ("IGNORE") ("IMPORT") ("INCLUDE") ("INCLUDEDIRS") ("INIT") ("KEEP_STATE") ("MAKEFILES") ("MAKE_VERSION") ("NO_PARALLEL") ("PARALLEL") ("PHONY") ("PRECIOUS") ("REMOVE") ("SCCS_GET") ("SILENT") ("SOURCE") ("SUFFIXES") ("WAIT") ("c.o") ("C.o") ("m.o") ("el.elc") ("y.c") ("s.o"))) (#$ . 3113)) #@235 List of macros that are resolved by make at runtime. If you insert a macro reference using makefile-insert-macro-ref, the name of the macro is checked against this list. If it can be found its name will not be enclosed in { } or ( ). (defvar makefile-runtime-macros-list (quote (("@") ("&") (">") ("<") ("*") ("^") ("?") ("%") ("$"))) (#$ . 3703)) #@52 Regex used to find dependency lines in a makefile. (defconst makefile-dependency-regex "^\\([^ \n #:]+\\([ ]+[^ \n#:]+\\)*\\)[ ]*:\\([ ]*$\\|\\([^=\n].*$\\)\\)" (#$ . 4057)) #@58 Regex used to find macro assignment lines in a makefile. (defconst makefile-macroassign-regex "^\\([^ \n ][^:#= \n]*\\)[ ]*[*:+]?:?=" (#$ . 4241)) #@67 Regex for filenames that will NOT be included in the target list. (defconst makefile-ignored-files-in-pickup-regex "\\(^\\..*\\)\\|\\(.*~$\\)\\|\\(.*,v$\\)\\|\\(\\.[chy]\\)" (#$ . 4396)) (add-to-list (quote facemenu-unlisted-faces) (quote makefile-space-face)) #@64 Face to use for highlighting leading spaces in Font-Lock mode. (defvar makefile-space-face (quote makefile-space-face) (#$ . 4663)) (byte-code "ÁÂEÃ\fÁÅEÆÇȯ É\nB\nÁ‡" [makefile-macroassign-regex 1 font-lock-variable-name-face ("\\$[({]\\([a-zA-Z0-9_]+\\)[})]" 1 font-lock-reference-face t) makefile-dependency-regex font-lock-function-name-face ("^[ ]+$" . makefile-space-face) ("^ +#" makefile-space-face t) ("^\\( +\\) " 1 makefile-space-face) makefile-font-lock-keywords current-load-list] 6) #@41 A make that can handle the `-q' option. (defvar makefile-brave-make "make" (#$ . 5172)) #@530 Function to call to determine whether a make target is up to date. The function must satisfy this calling convention: * As its first argument, it must accept the name of the target to be checked, as a string. * As its second argument, it may accept the name of a makefile as a string. Depending on what you're going to do you may not need this. * It must return the integer value 0 (zero) if the given target should be considered up-to-date in the context of the given makefile, any nonzero integer value otherwise. (defvar makefile-query-one-target-method (quote makefile-query-by-make-minus-q) (#$ . 5267)) #@41 Name of the Up-to-date overview buffer. (defvar makefile-up-to-date-buffer-name "*Makefile Up-to-date overview*" (#$ . 5895)) #@43 The keymap that is used in Makefile mode. (defvar makefile-mode-map nil (#$ . 6027)) (byte-code "„‡Á ÂÃÄ#ˆ ƒ)ÂÆÇ#ˆÂÈÉ#ˆÂÊË#ˆÂÌÍ#ˆÂÎÏ#ˆÂÐÑ#ˆÂÒÓ#ˆÂÔÕ#ˆÂÖ×#ˆÂØÙ#ˆÂÚÛ#ˆÂÜÝ#ˆÂÞß#ˆÂàáÁá!B#ˆÂâã#ˆÂäå#ˆÂæç#ˆÂèé#ˆÂêë#ˆÁ‡" [makefile-mode-map make-sparse-keymap define-key ":" makefile-insert-target-ref makefile-electric-keys "$" makefile-insert-macro-ref ":" makefile-electric-colon "=" makefile-electric-equal "." makefile-electric-dot "" makefile-pickup-filenames-as-targets "" makefile-switch-to-browser "" makefile-pickup-everything "" makefile-create-up-to-date-overview " " makefile-insert-gmake-function "" makefile-backslash-region "ð" makefile-previous-dependency "î" makefile-next-dependency " " makefile-complete [menu-bar makefile-mode] "Makefile" [menu-bar makefile-mode browse] ("Pop up Makefile Browser" . makefile-switch-to-browser) [menu-bar makefile-mode complete] ("Complete Target or Macro" . makefile-complete) [menu-bar makefile-mode pickup] ("Find Targets and Macros" . makefile-pickup-everything) [menu-bar makefile-mode prev] ("Move to Previous Dependency" . makefile-previous-dependency) [menu-bar makefile-mode next] ("Move to Next Dependency" . makefile-next-dependency)] 6) #@59 The keymap that is used in the macro- and target browser. (defvar makefile-browser-map nil (#$ . 7263)) (byte-code "„IÁ ÂÃÄ#ˆÂÅÄ#ˆÂÆÇ#ˆÂÈÇ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÔ#ˆÖ×!„RØ×B„§Ú ÛÜÝ#ˆÛÞß#ˆÛàá#ˆÛâã#ˆÛäå#ˆÛæç#ˆÛèé#ˆÛêé#ˆÛëì#ˆÛíî#ˆØ‡" [makefile-browser-map make-sparse-keymap define-key "n" makefile-browser-next-line "" "p" makefile-browser-previous-line "" " " makefile-browser-toggle "i" makefile-browser-insert-selection "I" makefile-browser-insert-selection-and-quit " " makefile-browser-insert-continuation "q" makefile-browser-quit "" undefined "" boundp makefile-mode-syntax-table nil current-load-list make-syntax-table modify-syntax-entry 40 "() " 41 ")( " 91 "(] " 93 ")[ " 123 "(} " 125 "){ " 39 "\" " 96 35 "< " 10 "> "] 4) #@50 Table of all target names known for this buffer. (defvar makefile-target-table nil (#$ . 8093)) #@49 Table of all macro names known for this buffer. (defvar makefile-macro-table nil (#$ . 8195)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÅÆ BÀÇ!„.ÈÇ BÀÉ!„;È É BÀÊ!„HÅ\nÊ BË\fÌ BŇ" [boundp makefile-browser-client "A buffer in Makefile mode that is currently using the browser." current-load-list makefile-browser-selection-vector nil makefile-has-prereqs makefile-need-target-pickup t makefile-need-macro-pickup makefile-mode-hook (("subst" "From" "To" "In") ("patsubst" "Pattern" "Replacement" "In") ("strip" "Text") ("findstring" "Find what" "In") ("filter" "Pattern" "Text") ("filter-out" "Pattern" "Text") ("sort" "List") ("dir" "Names") ("notdir" "Names") ("suffix" "Names") ("basename" "Names") ("addsuffix" "Suffix" "Names") ("join" "List 1" "List 2") ("word" "Index" "Text") ("words" "Text") ("firstword" "Text") ("wildcard" "Pattern") ("foreach" "Variable" "List" "Text") ("origin" "Variable") ("shell" "Command")) makefile-gnumake-functions-alist] 2) #@2689 Major mode for editing Makefiles. This function ends by invoking the function(s) `makefile-mode-hook'. \{makefile-mode-map} In the browser, use the following keys: \{makefile-browser-map} Makefile mode can be configured by modifying the following variables: makefile-browser-buffer-name: Name of the macro- and target browser buffer. makefile-target-colon: The string that gets appended to all target names inserted by `makefile-insert-target'. ":" or "::" are quite common values. makefile-macro-assign: The string that gets appended to all macro names inserted by `makefile-insert-macro'. The normal value should be " = ", since this is what standard make expects. However, newer makes such as dmake allow a larger variety of different macro assignments, so you might prefer to use " += " or " := " . makefile-tab-after-target-colon: If you want a TAB (instead of a space) to be appended after the target colon, then set this to a non-nil value. makefile-browser-leftmost-column: Number of blanks to the left of the browser selection mark. makefile-browser-cursor-column: Column in which the cursor is positioned when it moves up or down in the browser. makefile-browser-selected-mark: String used to mark selected entries in the browser. makefile-browser-unselected-mark: String used to mark unselected entries in the browser. makefile-browser-auto-advance-after-selection-p: If this variable is set to a non-nil value the cursor will automagically advance to the next line after an item has been selected in the browser. makefile-pickup-everything-picks-up-filenames-p: If this variable is set to a non-nil value then `makefile-pickup-everything' also picks up filenames as targets (i.e. it calls `makefile-find-filenames-as-targets'), otherwise filenames are omitted. makefile-cleanup-continuations-p: If this variable is set to a non-nil value then makefile-mode will assure that no line in the file ends with a backslash (the continuation character) followed by any whitespace. This is done by silently removing the trailing whitespace, leaving the backslash itself intact. IMPORTANT: Please note that enabling this option causes makefile-mode to MODIFY A FILE WITHOUT YOUR CONFIRMATION when "it seems necessary". makefile-browser-hook: A function or list of functions to be called just before the browser is entered. This is executed in the makefile buffer. makefile-special-targets-list: List of special targets. You will be offered to complete on one of those in the minibuffer whenever you enter a `.'. at the beginning of a line in Makefile mode. (defalias 'makefile-mode #[nil "À ˆÁÂ!ˆÃÁÄ!ˆÁÅ!ˆÁÆ!ˆÁÇ!ˆÁÈ!ˆÉÊ!ƒ&Ê ˆÁË!ˆÌ ÁÍ!ˆÎ ÁÏ!ˆÐÁÑ!ˆÒÁÓ!ˆÔÁÕ!ˆÖÁ×!ˆØÙÛÝ!ˆß !ˆá\"ãä!‡" [kill-all-local-variables make-local-variable local-write-file-hooks (makefile-cleanup-continuations makefile-warn-suspicious-lines) makefile-target-table makefile-macro-table makefile-has-prereqs makefile-need-target-pickup makefile-need-macro-pickup fboundp makefile-define-space-face font-lock-defaults (makefile-font-lock-keywords) add-log-current-defun-function makefile-add-log-defun imenu-create-index-function makefile-menu-index-function dabbrev-abbrev-skip-leading-regexp "\\$" comment-start "#" comment-end "" comment-start-skip "#+[ ]*" makefile-mode major-mode "Makefile" mode-name use-local-map makefile-mode-map set-syntax-table makefile-mode-syntax-table t indent-tabs-mode run-hooks makefile-mode-hook] 2 (#$ . 9178) nil]) #@58 Move point to the beginning of the next dependency line. (defalias 'makefile-next-dependency #[nil "`ÁˆÂ dÄ#ƒÅyˆÄ‚bˆÁ)‡" [here nil re-search-forward makefile-dependency-regex t 0] 4 (#$ . 12758) nil]) #@62 Move point to the beginning of the previous dependency line. (defalias 'makefile-previous-dependency #[nil "`ÁyˆÂ eÄ#ƒÁyˆÄ‚bˆÅ)‡" [here 0 re-search-backward makefile-dependency-regex t nil] 4 (#$ . 12972) nil]) #@136 Prompt for the name of a special target to insert. Only does electric insertion at beginning of line. Anywhere else just self-inserts. (defalias 'makefile-electric-dot #[(arg) "nƒÀ ‡Á\n!‡" [makefile-insert-special-target self-insert-command arg] 2 (#$ . 13196) "p"]) #@84 Propmt for and insert a special target name. Uses `makefile-special-targets' list. (defalias 'makefile-insert-special-target #[nil "À ˆÁ ĉ‰%‰GÆU?…Ç È±ˆÉ )‡" [makefile-pickup-targets completing-read "Special target: " makefile-special-targets-list nil special-target 0 "." ":" makefile-forward-after-target-colon] 7 (#$ . 13471) nil]) #@126 Prompt for name of a macro to insert. Only does prompting if point is at beginning of line. Anywhere else just self-inserts. (defalias 'makefile-electric-equal #[(arg) "À ˆnƒ ÁÂ!‡Ã\f!‡" [makefile-pickup-macros call-interactively makefile-insert-macro self-insert-command arg] 2 (#$ . 13818) "p"]) #@36 Prepare definition of a new macro. (defalias 'makefile-insert-macro #[(macro-name) "À ˆ GÂU?…Âyˆ ±ˆÄÆ !‡" [makefile-pickup-macros macro-name 0 makefile-macro-assign t makefile-need-macro-pickup makefile-remember-macro] 2 (#$ . 14122) "sMacro Name: "]) #@72 Complete on a list of known macros, then insert complete ref at point. (defalias 'makefile-insert-macro-ref #[(macro-name) "À !‡" [makefile-do-macro-insertion macro-name] 2 (#$ . 14385) (list (progn (makefile-pickup-macros) (completing-read "Refer to macro: " makefile-macro-table nil nil nil)))]) #@55 Prepare definition of a new target (dependency line). (defalias 'makefile-insert-target #[(target-name) "GÁU?…Áyˆ\n±ˆÃ ˆÄˆÅÇ!‡" [target-name 0 makefile-target-colon makefile-forward-after-target-colon nil t makefile-need-target-pickup makefile-remember-target] 2 (#$ . 14689) "sTarget: "]) #@71 Complete on a list of known targets, then insert target-ref at point. (defalias 'makefile-insert-target-ref #[(target-name) "GÁU?…\f±‡" [target-name 0 " "] 2 (#$ . 14994) (list (progn (makefile-pickup-targets) (completing-read "Refer to target: " makefile-target-table nil nil nil)))]) #@110 Prompt for name of new target. Prompting only happens at beginning of line. Anywhere else just self-inserts. (defalias 'makefile-electric-colon #[(arg) "nƒÀÁ!‡Â !‡" [call-interactively makefile-insert-target self-insert-command arg] 2 (#$ . 15292) "p"]) #@53 Notice names of all target definitions in Makefile. (defalias 'makefile-pickup-targets #[nil "??…\"ÁÁÁŠebˆÄ dÆ#ƒÇ ˆ‚)ÈÉ!‡" [makefile-need-target-pickup nil makefile-target-table makefile-has-prereqs re-search-forward makefile-dependency-regex t makefile-add-this-line-targets message "Read targets OK."] 4 (#$ . 15554) nil]) (defalias 'makefile-add-this-line-targets #[nil "ŠÀyˆÁÂe`\"T\f?…JÅÁwˆl†Æ`fÇ\"‰„\f`ÉÁwˆ`{\nËÌ!? Î\n \"ƒFÏÐ\n #ˆ+‚\f+‡" [0 nil count-lines line-number done-with-line " " char-equal 58 start-of-target-name "^ :#" target-name looking-at ":[ ]*$" has-prereqs makefile-remember-target message "Picked up target \"%s\" from line %d"] 4]) #@52 Notice names of all macro definitions in Makefile. (defalias 'makefile-pickup-macros #[nil "??…#ÁÁŠebˆÃ\fdÅ#ƒÆ ˆÇyˆ‚)ÈÉ!‡" [makefile-need-macro-pickup nil makefile-macro-table re-search-forward makefile-macroassign-regex t makefile-add-this-line-macro 1 message "Read macros OK."] 4 (#$ . 16246) nil]) (defalias 'makefile-add-this-line-macro #[nil "ŠÀyˆÁÂwˆl?…,`Äe`\"TÆÂwˆ `{È!…+ÉÊ #+)‡" [0 " " nil start-of-macro-name count-lines line-number "^ :#=*" macro-name makefile-remember-macro message "Picked up macro \"%s\" from line %d"] 4]) #@98 Notice names of all macros and targets in Makefile. Prefix arg means force pickups to be redone. (defalias 'makefile-pickup-everything #[(arg) "ƒÁÁÄ ˆÅ ˆ…Ç ‡" [arg t makefile-need-target-pickup makefile-need-macro-pickup makefile-pickup-macros makefile-pickup-targets makefile-pickup-everything-picks-up-filenames-p makefile-pickup-filenames-as-targets] 1 (#$ . 16810) "P"]) #@191 Scan the current directory for filenames to use as targets. Checks each filename against `makefile-ignored-files-in-pickup-regex' and adds all qualifying names to the list of known targets. (defalias 'makefile-pickup-filenames-as-targets #[nil "ÀÁ !‰ƒÃÄ\n\"‚Ãĉ\"ÆÇ \"*‡" [file-name-directory buffer-file-name dir file-name-all-completions "" raw-filename-list mapcar #[(name) "À !?… \"?…Ä !…ÅÆ \"‡" [file-directory-p name string-match makefile-ignored-files-in-pickup-regex makefile-remember-target message "Picked up file \"%s\" as target"] 3]] 4 (#$ . 17201) nil]) #@144 Perform completion on Makefile construct preceding point. Can complete variable and target names. The context determines which are considered. (defalias 'makefile-complete #[nil "ŠÀÁxˆ`)‰`{ÁÁŠ\nbˆhn„GÇUƒ'È‚GÉU„5ÊUƒGË ˆn„GhÇUƒGÈ*Ì\f?…P \"Ð \"‰È=ƒ†\fƒt É=ƒpÒ‚‚Ó‚‚Š\nbˆn)ƒÔ‚‚Õc‚ä„•Ö× \"ˆØ ‚ä ˜„Í\n`|ˆ\f„­Ù\"ƒÇ É=†µÛÜ!ˆÝ!ˆÛÞ!)‚äc‚äÖß!ˆà \"!âã!!‘ˆ)Öä!.‡" ["^$(){}:#= \n" nil beg try do-macros paren pc 36 t 123 40 backward-char append makefile-target-table makefile-macro-table table try-completion completion 125 41 ":" " " message "Can't find completion for \"%s\"" ding assoc makefile-use-curly-braces-for-macros-p delete-backward-char 2 makefile-do-macro-insertion 1 "Making completion list..." all-completions list "*Completions*" display-completion-list "Making completion list...done"] 4 (#$ . 17790) nil]) (defalias 'makefile-backslashify-current-line #[(doit) "Àˆ ƒBŠÂuˆ`f)Ã=?…bi\fYƒÅc‡i\fXƒ,ÆcˆÀˆ‚ÇÂ!ˆi\fWƒ?ÈcˆÀˆ‚0Éc‡n?…bÂuˆ`fÃ=…bŠÀˆ`)\nËÀxˆ`\n|)‡" [nil doit -1 92 makefile-backslash-column " \\" " " delete-char " " "\\" saved " "] 2]) #@157 Insert backslashes at end of every line in region. Useful for defining multi-line rules. If called with a prefix argument, trailing backslahes are removed. (defalias 'makefile-backslash-region #[(beg end arg) "Šbˆn?Œ\n}ˆebˆŠÃyˆm)„#Ä ?!ˆÃyˆ‚) …/bˆÄ ?!*‡" [end do-lastline-p beg 1 makefile-backslashify-current-line arg] 2 (#$ . 18931) "r\nP"]) (defalias 'makefile-browser-format-target-line #[(target selected) "ÀÁ\nÃ\"\fƒ ‚ÇQ #‡" [format make-string makefile-browser-leftmost-column 32 selected makefile-browser-selected-mark makefile-browser-unselected-mark "%s%s" target makefile-target-colon] 4]) (defalias 'makefile-browser-format-macro-line #[(macro selected) "ÀÁ\nÃ\"\fƒ ‚Ç!Q!‡" [format make-string makefile-browser-leftmost-column 32 selected makefile-browser-selected-mark makefile-browser-unselected-mark makefile-format-macro-ref macro] 5]) (defalias 'makefile-browser-fill #[(targets macros) "ÀebˆÂ ˆÃÄ Æ#ˆÃÇÆ#ˆÉÊed#ˆdSbˆËÌ!ˆebˆ u)‡" [t inhibit-read-only erase-buffer mapconcat #[(item) "À @Â\"ñ‡" [makefile-browser-format-target-line item nil "\n"] 3] targets "" #[(item) "À @Â\"ñ‡" [makefile-browser-format-macro-line item nil "\n"] 3] macros sort-lines nil delete-char 1 makefile-browser-cursor-column] 4]) #@53 Move the browser selection cursor to the next line. (defalias 'makefile-browser-next-line #[nil "À ?… Áyˆ\nu‡" [makefile-last-line-p 1 makefile-browser-cursor-column] 1 (#$ . 20191) nil]) #@57 Move the browser selection cursor to the previous line. (defalias 'makefile-browser-previous-line #[nil "À ?… Áyˆ\nu‡" [makefile-first-line-p -1 makefile-browser-cursor-column] 1 (#$ . 20386) nil]) #@54 Leave the browser and return to the makefile buffer. (defalias 'makefile-browser-quit #[nil "ÂÃÂ!ˆÄp!ˆÅ !)‡" [makefile-browser-client my-client nil set-buffer-modified-p kill-buffer pop-to-buffer] 2 (#$ . 20591) nil]) #@72 Toggle the selection state of the browser item at the cursor position. (defalias 'makefile-browser-toggle #[nil "Àe`\" ]à !ˆÄ !ˆÅÇyˆÈ ƒ0É \nË ˆÌ\nÍ !\"cˆ)‚AÎ Ë ˆÐÍ !\"cˆ))Çyˆuˆ…PÓ )‡" [count-lines this-line 1 makefile-browser-toggle-state-for-line goto-line t inhibit-read-only 0 makefile-browser-on-macro-line-p makefile-browser-this-line-macro-name macro-name kill-line makefile-browser-format-macro-line makefile-browser-get-state-for-line makefile-browser-this-line-target-name target-name makefile-browser-format-target-line makefile-browser-cursor-column makefile-browser-auto-advance-after-selection-p makefile-browser-next-line] 4 (#$ . 20818) nil]) #@351 Insert a makefile continuation. In the makefile buffer, go to (end-of-line), insert a '\' character, insert a new blank line, go to that line and indent by one TAB. This is most useful in the process of creating continued lines when copying large dependencies from the browser to the client buffer. (point) advances accordingly in the client buffer. (defalias 'makefile-browser-insert-continuation #[nil "ŠqˆÁˆÂc)‡" [makefile-browser-client nil "\\\n "] 1 (#$ . 21501) nil]) #@99 Insert all selected targets and/or macros in the makefile buffer. Insertion takes place at point. (defalias 'makefile-browser-insert-selection #[nil "ŠÀÁ!ˆÁm?…Ã\n!ƒÄ ˆÁyˆ\nT‚*‡" [goto-line 1 current-line makefile-browser-get-state-for-line makefile-browser-send-this-line-item] 2 (#$ . 21984) nil]) (defalias 'makefile-browser-insert-selection-and-quit #[nil "À ˆÁ ‡" [makefile-browser-insert-selection makefile-browser-quit] 1 nil nil]) (defalias 'makefile-browser-send-this-line-item #[nil "À ƒŠÁ  qˆÄ\n!ű*‡ŠÆ  qˆű*‡" [makefile-browser-on-macro-line-p makefile-browser-this-line-macro-name macro-name makefile-browser-client makefile-format-macro-ref " " makefile-browser-this-line-target-name target-name] 2]) (defalias 'makefile-browser-start-interaction #[nil "À !ˆÂ‰‡" [use-local-map makefile-browser-map t buffer-read-only] 2]) (defalias 'makefile-browse #[(targets macros) "G G\\ÂUƒà ˆÄÅ!‡Æ!É!ˆÊË!ˆÌ \"ˆÍ ˆÎG G\\Ï\" Ð )‡" [targets macros 0 beep message "No macros or targets to browse! Consider running 'makefile-pickup-everything'" get-buffer-create makefile-browser-buffer-name browser-buffer pop-to-buffer make-variable-buffer-local makefile-browser-selection-vector makefile-browser-fill shrink-window-if-larger-than-buffer make-vector nil makefile-browser-start-interaction] 3 nil nil]) (defalias 'makefile-switch-to-browser #[nil "ÀÁ!ˆpà ˆÄ ˆÅ\"‡" [run-hooks makefile-browser-hook makefile-browser-client makefile-pickup-targets makefile-pickup-macros makefile-browse makefile-target-table makefile-macro-table] 3 nil nil]) #@242 Create a buffer containing an overview of the state of all known targets. Known targets are targets that are explicitly defined in that makefile; in other words, all targets that appear on the left hand side of a dependency in the makefile. (defalias 'makefile-create-up-to-date-overview #[nil "ÀÁ!…c\npÃ\f!Å Æ ˆ\n \n \f  qˆÎÐ ˆÑ\n #ˆÒ ÓUƒAÔp!ˆÕÖ!ˆ\fqˆ ×\f!…aØ×\f!!ˆÙ ˆÚÎed#ˆÛ‰.‡" [y-or-n-p "Are you sure that the makefile being edited is consistent? " makefile-target-table get-buffer-create makefile-up-to-date-buffer-name makefile-save-temporary makefile-pickup-targets makefile-has-prereqs prereqs real-targets filename makefile-up-to-date-buffer this-buffer saved-target-table nil buffer-read-only erase-buffer makefile-query-targets buffer-size 0 kill-buffer message "No overview created!" get-buffer pop-to-buffer shrink-window-if-larger-than-buffer sort-lines t] 6 (#$ . 23566) nil]) #@59 Create a temporary file from the current makefile buffer. (defalias 'makefile-save-temporary #[nil "À Âed ÃÄ%ˆ )‡" [makefile-generate-temporary-filename filename write-region nil 0] 6 (#$ . 24489)]) #@159 Create a filename suitable for use in `makefile-save-temporary'. Be careful to allow brain-dead file systems (DOS, SYSV ...) to cope with the generated name! (defalias 'makefile-generate-temporary-filename #[nil "À Á !Å\fGÆVƒ\fÇÆO‚\fÈ GÆVƒ' ÇÆO‚( R*‡" [user-login-name int-to-string user-uid my-uid my-name "mktmp" 3 0 "."] 6 (#$ . 24696)]) #@168 Fill the up-to-date overview buffer. Checks each target in TARGET-TABLE using `makefile-query-one-target-method' and generates the overview, one line per target name. (defalias 'makefile-query-targets #[(filename target-table prereq-list) "ÀÁ\nÃ#cˆebˆÄ !‡" [mapconcat #[(item) "@‰\n?‰†\f \"ÇÈ ƒÉ‚'ƒ&Ê‚'Ë#+‡" [item target-name prereq-list no-prereqs makefile-query-one-target-method filename needs-rebuild format " %s%s" " .. has no prerequisites" " .. NEEDS REBUILD" " .. is up to date"] 5] target-table "\n" delete-file filename] 4 (#$ . 25053)]) (defalias 'makefile-query-by-make-minus-q #[(target &optional filename) "À ‰‰Ã\fÅ&ÇU?‡" [call-process makefile-brave-make nil "-f" filename "-q" target 0] 9]) (defalias 'makefile-cleanup-continuations #[nil "Á=…%\n…% ?…%ŠebˆÄÅdÆ#…$ÇÈƉ#ˆ‚)‡" [major-mode makefile-mode makefile-cleanup-continuations-p buffer-read-only re-search-forward "\\\\[ ]+$" t replace-match "\\"] 4]) (defalias 'makefile-warn-suspicious-lines #[nil "À\nÃ=ƒ*ŠebˆÄÅdÆ#)‰ƒ)Èe\" ÊËÌ \"!?)) )‡" [nil dont-save major-mode makefile-mode re-search-forward "\\(^[ ]+$\\)\\|\\(^[ ]+[ ]\\)" t suspicious count-lines line-nr y-or-n-p format "Suspicious line %d. Save anyway "] 5]) #@136 Insert a GNU make function call. Asks for the name of the function to use (with completion). Then prompts for all required parameters. (defalias 'makefile-insert-gmake-function #[nil "ÀÁ\nÃÄÃ%Æ \n\"A GÈU?…$É ÊË \"Q!ʱ*‡" [completing-read "Function: " makefile-gnumake-functions-alist nil t gm-function-name assoc gm-function-prompts 0 makefile-format-macro-ref " " makefile-prompt-for-gmake-funargs] 6 (#$ . 26292) nil]) (defalias 'makefile-prompt-for-gmake-funargs #[(function-name prompt-list) "ÀÁ\nÃ#‡" [mapconcat #[(one-prompt) "ÀÁ \f#Å\"‡" [read-string format "[%s] %s: " function-name one-prompt nil] 5] prompt-list ","] 4]) #@27 Insert a macro reference. (defalias 'makefile-do-macro-insertion #[(macro-name) "GÁU?… \"ƒÄ±‡Å!c‡" [macro-name 0 assoc makefile-runtime-macros-list "$" makefile-format-macro-ref] 3 (#$ . 26937)]) #@74 Remember a given target if it is not already remembered for this buffer. (defalias 'makefile-remember-target #[(target-name &optional has-prereqs) "GÁU?… \"„C B\f… B‰‡" [target-name 0 assoc makefile-target-table has-prereqs makefile-has-prereqs] 3 (#$ . 27149)]) #@73 Remember a given macro if it is not already remembered for this buffer. (defalias 'makefile-remember-macro #[(macro-name) "GÁU?… \"?…C B‰‡" [macro-name 0 assoc makefile-macro-table] 3 (#$ . 27431)]) #@142 Move point forward after inserting the terminating colon of a target. This acts according to the value of `makefile-tab-after-target-colon'. (defalias 'makefile-forward-after-target-colon #[nil "ƒÁc‡Âc‡" [makefile-tab-after-target-colon " " " "] 1 (#$ . 27646)]) #@55 Determine if point is on a macro line in the browser. (defalias 'makefile-browser-on-macro-line-p #[nil "ŠÀyˆÁÂà Ä#)‡" [0 re-search-forward "\\$[{(]" makefile-end-of-line-point t] 4 (#$ . 27918)]) #@53 Extract the target name from a line in the browser. (defalias 'makefile-browser-this-line-target-name #[nil "ŠÀˆÁÀxˆ` S{)‡" [nil "^ " makefile-end-of-line-point] 2 (#$ . 28121)]) #@52 Extract the macro name from a line in the browser. (defalias 'makefile-browser-this-line-macro-name #[nil "ŠÀyˆÁÂà Ä#ˆ`ÆÇwˆ `{*‡" [0 re-search-forward "\\$[{(]" makefile-end-of-line-point t macro-start "^})" nil] 4 (#$ . 28309)]) #@74 Format a macro reference. Uses `makefile-use-curly-braces-for-macros-p'. (defalias 'makefile-format-macro-ref #[(macro-name) "ÀÁ !\"„ÀÄ !\"ƒÅÆ \"‡ƒ!ÅÈ \"‡ÅÉ \"‡" [char-equal 40 string-to-char macro-name 123 format "$%s" makefile-use-curly-braces-for-macros-p "${%s}" "$(%s)"] 4 (#$ . 28546)]) (defalias 'makefile-browser-get-state-for-line #[(n) " SH‡" [makefile-browser-selection-vector n] 2]) (defalias 'makefile-browser-set-state-for-line #[(n to-state) " S\nI‡" [makefile-browser-selection-vector n to-state] 3]) (defalias 'makefile-browser-toggle-state-for-line #[(n) "À  !?\"‡" [makefile-browser-set-state-for-line n makefile-browser-get-state-for-line] 4]) (defalias 'makefile-beginning-of-line-point #[nil "ŠÀyˆ`)‡" [0] 1]) (defalias 'makefile-end-of-line-point #[nil "ŠÀˆ`)‡" [nil] 1]) (defalias 'makefile-last-line-p #[nil "À dU‡" [makefile-end-of-line-point] 2]) (defalias 'makefile-first-line-p #[nil "À eU‡" [makefile-beginning-of-line-point] 2]) (defalias 'makefile-add-log-defun #[nil "ŠÀyˆÁ\n!ƒÔÕ{‚+m„ÄuˆÅÄÇ#ƒ*ÔÕ{‚+Ä)‡" [0 looking-at makefile-macroassign-regex 1 nil re-search-backward makefile-dependency-regex t] 4]) (defalias 'makefile-menu-index-function #[nil "À‰  QƒÈ Ê \"ˆ )ebˆË\fÀÌ#ƒdƒEÍÀ!‰ Î\\VƒDÊ \"ˆ )Ï”ƒNÏ‚OΉ”•{”BB)‚ ƒwÑ Ê \"ˆ )Ÿ+‡" [nil makefile-dependency-regex "\\|" makefile-macroassign-regex re stupid alist imenu-scanning-message 0 pos message re-search-forward t imenu--relative-position 5 1 n 100] 6]) (defalias 'makefile-define-space-face #[nil "ÀÁ!ˆ\nÃ=?†\\ÄÁ!†\\Å ÇžAÉžAÊ=ƒ3ƒ/Ë‚TÌ‚TÉžAÍ=ƒJƒFË‚TÌ‚TƒS΂TÎÐÁ\"+‡" [make-face makefile-space-face window-system x face-differs-from-default-p frame-parameters params background-mode light-bg display-type mono "black" "white" grayscale "hotpink" bg-color set-face-background] 3]) emacs-19.30/lisp/makeinfo.elc100666 13437 1 7766 6045214053 14506 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:23:36 1995 ;;; from file /home/fsf/rms/e19/lisp/makeinfo.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`makeinfo.el' was compiled for Emacs 19.29 or later")) (require (quote compile)) #@112 *Command used to run `makeinfo' subjob. The name of the file is appended to this string, separated by a space. (defvar makeinfo-run-command "makeinfo" (#$ . -503)) #@215 *String containing options for running `makeinfo'. Do not include `--footnote-style' or `--paragraph-indent'; the proper way to specify those is with the Texinfo commands `@footnotestyle` and `@paragraphindent'. (defvar makeinfo-options "--fill-column=70" (#$ . -674)) (require (quote texinfo)) #@54 Process that runs `makeinfo'. Should start out nil. (defvar makeinfo-compilation-process nil (#$ . 977)) #@70 Temporary file name used for text being sent as input to `makeinfo'. (defvar makeinfo-temp-file nil (#$ . 1089)) #@52 Info file name used for text output by `makeinfo'. (defvar makeinfo-output-file-name nil (#$ . 1208)) #@248 Make Info file from region of current Texinfo file, and switch to it. This command does not offer the `next-error' feature since it would apply to a temporary file, not the original; use the `makeinfo-buffer' command to gain use of `next-error'. (defalias 'makeinfo-region #[(region-beginning region-end) "À‰‰ÄÅ ÆÇÈÅ \"†Å GO!ÉP\nŠŒ~ˆebˆŠËyˆ`)\fÍÎ\fÏ#ƒ=ДЕ{‚AÒÓ!ˆebˆÔ\fÏ#Æyˆ`ƒpÔÀÏ#Æyˆ`ƒp×\n^ \nÀ‰%ˆ‚ebˆÔÙ\fÏ#ˆÆyˆ`Ðyˆ`×\n^ \nÀ‰%ˆ× ]\nÏÀ%ˆŠÛÝÝ\n°ßÀ#.‡" [nil filename-or-header-end filename-or-header-beginning filename-or-header make-temp-name buffer-file-name 0 string-match "\\.tex" ".texinfo" makeinfo-temp-file 100 search-end re-search-forward "^@setfilename[ ]+\\([^ \n]+\\)[ ]*" t 1 makeinfo-output-file-name error "The texinfo file needs a line saying: @setfilename " search-forward tex-start-of-header tex-end-of-header write-region region-beginning "@setfilename" region-end makeinfo-compile makeinfo-run-command " " makeinfo-options "Use `makeinfo-buffer' to gain use of the `next-error' command"] 6 (#$ . 1317) "r"]) (defalias 'makeinfo-compile #[(command error-message parse-errors) "À \nÃ\f?…\nÅ$ÇÈ!É\")‡" [compile-internal command error-message nil parse-errors (lambda (&rest ignore) (setq compilation-error-list nil)) buffer set-process-sentinel get-buffer-process makeinfo-compilation-sentinel] 5]) (defalias 'makeinfo-compilation-sentinel #[(proc msg) "À \n\"ˆ ƒÄ !ƒÅ !ˆÆ!ƒ&qˆÈɉ\"ˆ‚+Ê!ˆeb‡" [compilation-sentinel proc msg makeinfo-temp-file file-exists-p delete-file get-file-buffer makeinfo-output-file-name revert-buffer t find-file] 3]) #@118 Make Info file from current buffer. Use the \[next-error] command to move to the next error (if there are errors). (defalias 'makeinfo-buffer #[nil "„ ÁÂ!ˆ‚à ƒÄÅ!ƒÆ ˆŠebˆŠÇyˆ`)ÉÊË#ƒ8̔̕{ ‚<ÁÎ!ˆ*ŠÏÑÑ°ÓË#)‡" [buffer-file-name error "Buffer not visiting any file" buffer-modified-p y-or-n-p "Buffer modified; do you want to save it? " save-buffer 100 search-end re-search-forward "^@setfilename[ ]+\\([^ \n]+\\)[ ]*" t 1 makeinfo-output-file-name "The texinfo file needs a line saying: @setfilename " makeinfo-compile makeinfo-run-command " " makeinfo-options "No more errors."] 6 (#$ . 2952) nil]) #@166 Redisplay `*compilation*' buffer so most recent output can be seen. The last line of the buffer is displayed on line LINE of the window, or centered if LINE is nil. (defalias 'makeinfo-recenter-compilation-buffer #[(linenum) "ÀÁ!p‰„ÄÅ!‚1Æ !ˆÇ !ˆdbˆÈ ƒ(Ê !‚,Ë Ì¥!ˆÆ\n!*‡" [get-buffer "*compilation*" old-buffer makeinfo-buffer message "No *compilation* buffer" pop-to-buffer bury-buffer recenter linenum prefix-numeric-value window-height 2] 4 (#$ . 3588) "P"]) (provide (quote makeinfo)) emacs-19.30/lisp/man.elc100666 74777 1 64677 6055512123 13402 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 24 22:57:44 1995 ;;; from file /home/fsf/rms/e19/lisp/man.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`man.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂ BÄ BÅ BÆ BÇ BÈ BÉ BÊ BË BÌ BÍ BÀ‡" [require assoc Man-notify current-load-list Man-current-page Man-page-list Man-filter-list Man-original-frame Man-arguments Man-sections-alist Man-refpages-alist Man-uses-untabify-flag Man-page-mode-string Man-sed-script] 2) #@34 *Make up the manpage with fonts. (defvar Man-fontify-manpage-flag t (#$ . -753)) #@42 *Face to use when fontifying overstrike. (defvar Man-overstrike-face (quote bold) (#$ . -840)) #@43 *Face to use when fontifying underlining. (defvar Man-underline-face (quote underline) (#$ . -941)) #@842 *Selects the behavior when manpage is ready. This variable may have one of the following values, where (sf) means that the frames are switched, so the manpage is displayed in the frame where the man command was called from: newframe -- put the manpage in its own frame (see `Man-frame-parameters') pushy -- make the manpage the current buffer in the current window bully -- make the manpage the current buffer and only window (sf) aggressive -- make the manpage the current buffer in the other window (sf) friendly -- display manpage in the other window but don't make current (sf) polite -- don't display manpage, but prints message and beep when ready quiet -- like `polite', but don't beep meek -- make no indication that the manpage is ready Any other value of `Man-notify-method' is equivalent to `meek'. (defvar Man-notify-method (byte-code "ÀÁ!ƒ ‡Â‡" [boundp Man-notify friendly] 2) (#$ . -1048)) #@67 *Frame parameter list for creating a new frame for a manual page. (defvar Man-frame-parameters nil (#$ . -1991)) #@364 *Letters in sections are converted to lower case. Some Un*x man commands can't handle uppercase letters in sections, for example "man 2V chmod", but they are often displayed in the manpage with the upper case letter. When this variable is t, the section letter (e.g., "2V") is converted to lowercase (e.g., "2v") before being sent to the man background process. (defvar Man-downcase-section-letters-flag t (#$ . -2111)) #@63 *If t, the manpage list is treated as circular for traversal. (defvar Man-circular-pages-flag t (#$ . -2538)) #@292 *Association list of bogus sections to real section numbers. Some manpages (e.g. the Sun C++ 2.1 manpages) have section numbers in their references which Un*x `man' does not recognize. This association list is used to translate those sections, when found, to the associated section number. (defvar Man-section-translations-alist (list (quote ("3C++" . "3")) (quote ("3X11" . "3")) (quote ("1-UCB" . ""))) (#$ . -2655)) #@50 The name of the program that produces man pages. (defvar manual-program "man" (#$ . 3081)) #@31 Command used for untabifying. (defvar Man-untabify-command "pr" (#$ . 3178)) #@69 List of arguments to be passed to Man-untabify-command (which see). (defvar Man-untabify-command-args (list "-t" "-e") (#$ . 3261)) #@42 Command used for processing sed scripts. (defvar Man-sed-command "sed" (#$ . 3399)) #@42 Command used for processing awk scripts. (defvar Man-awk-command "awk" (#$ . 3489)) #@42 Mode line format for manual mode buffer. (defvar Man-mode-line-format (quote ("" mode-line-modified mode-line-buffer-identification " " global-mode-string " " Man-page-mode-string " %[(" mode-name mode-line-process minor-mode-alist ")%]----" (-3 . "%p") "-%-")) (#$ . 3579)) #@22 Keymap for Man mode. (defvar Man-mode-map nil (#$ . 3862)) #@36 Hook run when Man mode is enabled. (defvar Man-mode-hook nil (#$ . 3927)) #@68 Hook run after removing backspaces but before Man-mode processing. (defvar Man-cooked-hook nil (#$ . 4007)) #@72 Regular expression describing the name of a manpage (without section). (defvar Man-name-regexp "[-a-zA-Z0-9_][-a-zA-Z0-9_.]*" (#$ . 4121)) #@69 Regular expression describing a manpage section within parentheses. (defvar Man-section-regexp "[0-9][a-zA-Z+]*\\|[LNln]" (#$ . 4266)) #@54 Regular expression describing the heading of a page. (defvar Man-page-header-regexp (concat "^[ ]*\\(" Man-name-regexp "(\\(" Man-section-regexp "\\))\\).*\\1") (#$ . 4407)) #@56 Regular expression describing a manpage heading entry. (defvar Man-heading-regexp "^\\([A-Z][A-Z ]+\\)$" (#$ . 4588)) #@114 Regular expression for SEE ALSO heading (or your equivalent). This regexp should not start with a `^' character. (defvar Man-see-also-regexp "SEE ALSO" (#$ . 4713)) #@118 Regular expression describing first heading on a manpage. This regular expression should start with a `^' character. (defvar Man-first-heading-regexp "^[ ]*NAME$\\|^[ ]*No manual entry fo.*$" (#$ . 4885)) #@68 Regular expression describing a reference in the SEE ALSO section. (defvar Man-reference-regexp (concat "\\(" Man-name-regexp "\\)(\\(" Man-section-regexp "\\))") (#$ . 5098)) #@57 Switches passed to the man command, as a single string. (defvar Man-switches "" (#$ . 5280)) #@58 Option that indicates a specified a manual section name. (defvar Man-specified-section-option (byte-code "ÀÁ\n\"ƒ Çć" [string-match "-solaris[0-9.]*$" system-configuration "-s" ""] 3) (#$ . 5379)) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÀÅ!ˆÀÆ!ˆÀÇ!ˆÈÁÉ\"ˆÈÂÉ\"ˆÈÃÉ\"ˆÈÄÊ\"ˆÈÅË\"‡" [make-variable-buffer-local Man-sections-alist Man-refpages-alist Man-page-list Man-current-page Man-page-mode-string Man-original-frame Man-arguments set-default nil 0 "1 of 1"] 3) #@75 Script for sysV-like sed to nuke backspaces and ANSI codes from manpages. (defconst Man-sysv-sed-script "// { s/_//g\n s/_//g\n s/o+/o/g\n s/+o/o/g\n :ovstrk\n s/\\(.\\)\\1/\\1/g\n t ovstrk\n }\n/\\[[0-9][0-9]*m/ s///g" (#$ . 5839)) #@79 Script for berkeley-like sed to nuke backspaces and ANSI codes from manpages. (defconst Man-berkeley-sed-script "// { s/_//g\\\n s/_//g\\\n s/o+/o/g\\\n s/+o/o/g\\\n :ovstrk\\\n s/\\(.\\)\\1/\\1/g\\\n t ovstrk\\\n }\\\n/\\[[0-9][0-9]*m/ s///g" (#$ . 6099)) (byte-code "„qÁ Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÃÐÑ#ˆÃÒÓ#ˆÃÔÓ#ˆÃÕÖ#ˆÃ×Ø#ˆÃÙÚ#ˆÃÛÜ#ˆÃÝÞ#ˆÃßà#ˆÃáâ#ˆÃãä#ˆÁ‡" [Man-mode-map make-keymap suppress-keymap define-key " " scroll-up "" scroll-down "n" Man-next-section "p" Man-previous-section "n" Man-next-manpage "p" Man-previous-manpage ">" end-of-buffer "<" beginning-of-buffer "." "r" Man-follow-manual-reference "t" toggle-truncate-lines "g" Man-goto-section "s" Man-goto-see-also-section "k" Man-kill "q" Man-quit "m" man "?" describe-mode] 4) #@128 Used for initialising variables based on the value of window-system. This is necessary if one wants to dump man.el with emacs. (defalias 'Man-init-defvars #[nil "… ÂÃ\fBÅÃÆÇ#ˆƒÈ‚AÉ\nȉ‰ %ÌUƒ- ‚AÉ\nȉ‰ %ÌUƒ@ ‚AÈÎ\fBÅÎÆÏ#ˆÐÑ!„Œ\nƒbÒÓQ‚cÔÕÖ×ØÙÚÛÜÝÞßàá¯B\"ãäåæçèÓ¯B ?…‰)*BEÑ\fBÅÑÆë#ˆÑ‡" [Man-fontify-manpage-flag window-system t Man-uses-untabify-flag current-load-list put variable-documentation "When non-nil use `untabify' instead of Man-untabify-command." nil call-process Man-sed-command Man-sysv-sed-script 0 Man-berkeley-sed-script Man-sed-script "Script for sed to nuke backspaces and ANSI codes from manpages." boundp Man-filter-list "-e '" "'" "" "-e '/^[-][-]*$/d'" "-e '/[789]/s///g'" "-e '/Reformatting page. Wait/d'" "-e '/Reformatting entry. Wait/d'" "-e '/^[ ]*Hewlett-Packard[ ]Company[ ]*-[ ][0-9]*[ ]-/d'" "-e '/^[ ]*Hewlett-Packard[ ]*-[ ][0-9]*[ ]-.*$/d'" "-e '/^[ ][ ]*-[ ][0-9]*[ ]-[ ]*Formatted:.*[0-9]$/d'" "-e '/^[ ]*Page[ ][0-9]*.*(printed[ ][0-9\\/]*)$/d'" "-e '/^Printed[ ][0-9].*[0-9]$/d'" "-e '/^[ ]*X[ ]Version[ ]1[01].*Release[ ][0-9]/d'" "-e '/^[A-za-z].*Last[ ]change:/d'" "-e '/^Sun[ ]Release[ ][0-9].*[0-9]$/d'" "-e '/[ ]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'" Man-awk-command "'\n" "BEGIN { blankline=0; anonblank=0; }\n" "/^$/ { if (anonblank==0) next; }\n" "{ anonblank=1; }\n" "/^$/ { blankline++; next; }\n" "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n" Man-untabify-command Man-untabify-command-args "*Manpage cleaning filter command phrases.\nThis variable contains a list of the following form:\n\n'((command-string phrase-string*)*)\n\nEach phrase-string is concatenated onto the command-string to form a\ncommand filter. The (standard) output (and standard error) of the Un*x\nman command is piped through each command filter in the order the\ncommands appear in the association list. The final output is placed in\nthe manpage buffer."] 15 (#$ . 6901)]) (put (quote Man-init-defvars) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@233 Return the substring matched by the last search. Optional arg N means return the substring matched by the Nth paren grouping. Optional second arg STRING means return a substring from that string instead of from the current buffer. (defalias 'Man-match-substring #[(&optional n string) "„Á\nƒ\n”•O‡”•{‡" [n 0 string] 3 (#$ . 9002)]) (put (quote Man-match-substring) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@45 Formats part of the mode line for Man mode. (defalias 'Man-make-page-mode-string #[nil "ÀÁ S\f88†\fÅ \fG$‡" [format "%s page %d of %d" 2 Man-current-page Man-page-list ""] 5 (#$ . 9443)]) (put (quote Man-make-page-mode-string) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@60 Builds the entire background manpage and cleaning command. (defalias 'Man-build-man-command #[nil "Á\nÃR\f ƒ3 @ƒ3 @@ @AÉÁÊËÁ#° A*‚ *‡" [manual-program " " Man-switches " %s 2>/dev/null" Man-filter-list flist command pargs pcom " | " mapconcat #[(phrase) ";„ ÁÂ!ˆ‡" [phrase error "Malformed Man-filter-list"] 2]] 8 (#$ . 9737)]) (put (quote Man-build-man-command) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@234 Translates REF from "chmod(2V)" to "2v chmod" style. Leave it as is if already in that style. Possibly downcase and translate the section (see the Man-downcase-section-letters-flag and the Man-section-translations-alist variables). (defalias 'Man-translate-references #[(ref) "À‰ ÅÆÈQ \"ƒeÊ  ‰\f„ Í\f ƒ1 \f”\f•O‚8\f”\f•{*Î  ‰\f„HÍ\f ƒY \f”\f•O‚`\f”\f•{*‚ÅÅÏÑÓ° \"ƒÅÎ  ‰\f„ƒÍ\f ƒ” \f”\f•O‚›\f”\f•{*Ê  ‰\f„«Í\f ƒ¼ \f”\f•O‚Ã\f”\f•{*\fÀ˜ƒÐ ‚ƒØ —\nƒ\n@@\n@A\nAƒó— ˜ƒ\nƒ—‚×*‚Ø Ù\fR+‡" ["" Man-section-translations-alist slist section name string-match "^" Man-reference-regexp "$" ref 1 string n 0 2 "^\\(" Man-section-regexp "\\) +\\(" Man-name-regexp "\\)$" Man-downcase-section-letters-flag s2 s1 nil Man-specified-section-option " "] 7 (#$ . 10192)]) #@171 Make a guess at a default manual entry. This guess is based on the text surrounding the cursor, and the default section number is selected from `Man-auto-section-alist'. (defalias 'Man-default-man-entry #[nil "ÀŠÂÃ!„ ÄÀxˆÅÀxˆÂÆ!ƒÇuˆ`ÈÀwˆ`{‰ÂÉ\nËQ!…VÌÍÇÀ‰„<ЃM”•O‚T”•{*\"PÒÐGÀ$ˆ+‡" [nil default-title looking-at "[-a-zA-Z_.]" "^a-zA-Z" "-(a-zA-Z_0-9_." "(" 1 "-a-zA-Z0-9_." "[ ]*([ ]*\\(" Man-section-regexp "\\)[ ]*)" format "(%s)" string n 0 result set-text-properties] 7 (#$ . 11060)]) (byte-code "ÀÁÂÃ#ˆÄÅÆ\"‡" [put Man-default-man-entry byte-optimizer byte-compile-inline-expand defalias manual-entry man] 4) #@396 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-method' for what happens when the buffer is ready. If a buffer already exists for this man page, it will display immediately. (defalias 'man #[(man-args) "… ÂÃ\fBÅÃÆÇ#ˆƒÈ‚AÉ\nȉ‰ %ÌUƒ- ‚AÉ\nȉ‰ %ÌUƒ@ ‚AÈÎ\fBÅÎÆÏ#ˆÐÑ!„Œ\nƒbÒÓQ‚cÔÕÖ×ØÙÚÛÜÝÞßàá¯B\"ãäåæçèÓ¯B ?…‰)*BEÑ\fBÅÑÆë#ˆì-!-î-!‡" [Man-fontify-manpage-flag window-system t Man-uses-untabify-flag current-load-list put variable-documentation "When non-nil use `untabify' instead of Man-untabify-command." nil call-process Man-sed-command Man-sysv-sed-script 0 Man-berkeley-sed-script Man-sed-script "Script for sed to nuke backspaces and ANSI codes from manpages." boundp Man-filter-list "-e '" "'" "" "-e '/^[-][-]*$/d'" "-e '/[789]/s///g'" "-e '/Reformatting page. Wait/d'" "-e '/Reformatting entry. Wait/d'" "-e '/^[ ]*Hewlett-Packard[ ]Company[ ]*-[ ][0-9]*[ ]-/d'" "-e '/^[ ]*Hewlett-Packard[ ]*-[ ][0-9]*[ ]-.*$/d'" "-e '/^[ ][ ]*-[ ][0-9]*[ ]-[ ]*Formatted:.*[0-9]$/d'" "-e '/^[ ]*Page[ ][0-9]*.*(printed[ ][0-9\\/]*)$/d'" "-e '/^Printed[ ][0-9].*[0-9]$/d'" "-e '/^[ ]*X[ ]Version[ ]1[01].*Release[ ][0-9]/d'" "-e '/^[A-za-z].*Last[ ]change:/d'" "-e '/^Sun[ ]Release[ ][0-9].*[0-9]$/d'" "-e '/[ ]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'" Man-awk-command "'\n" "BEGIN { blankline=0; anonblank=0; }\n" "/^$/ { if (anonblank==0) next; }\n" "{ anonblank=1; }\n" "/^$/ { blankline++; next; }\n" "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n" Man-untabify-command Man-untabify-command-args "*Manpage cleaning filter command phrases.\nThis variable contains a list of the following form:\n\n'((command-string phrase-string*)*)\n\nEach phrase-string is concatenated onto the command-string to form a\ncommand filter. The (standard) output (and standard error) of the Un*x\nman command is piped through each command filter in the order the\ncommands appear in the association list. The final output is placed in\nthe manpage buffer." Man-translate-references man-args Man-getpage-in-background] 15 (#$ . 11719) (list (let* ((default-entry (Man-default-man-entry)) (input (read-string (format "Manual entry%s: " (if (string= default-entry "") "" (format " (default %s)" default-entry)))))) (if (string= input "") (if (string= default-entry "") (error "No man args given") default-entry) input)))]) #@68 Uses TOPIC to build and fire off the manpage and cleaning command. (defalias 'Man-getpage-in-background #[(topic) " ÃQÅ\f!‰ƒÇ!‚ŽÈÉ!ˆÊË\f #ˆÍ\f!ŠqˆÎ  )Ñ!ÓÔÕ\"ˆÖ×\fØÙÚ\fÛÝR ƒ…@ƒ…@@@A!\" ã\"Ûäå!Û#° A*‚U * \"%æ\")+‡" [topic man-args "*Man " "*" bufname get-buffer buffer Man-notify-when-ready require env message "Invoking %s %s in the background" manual-program generate-new-buffer selected-frame Man-original-frame Man-arguments copy-sequence process-environment setenv "TERM" "dumb" set-process-sentinel start-process "sh" "-c" format " " Man-switches " %s 2>/dev/null" Man-filter-list flist command pargs pcom " | " mapconcat #[(phrase) ";„ ÁÂ!ˆ‡" [phrase error "Malformed Man-filter-list"] 2] Man-bgproc-sentinel] 16 (#$ . 14346)]) #@122 Notify the user when MAN-BUFFER is ready. See the variable `Man-notify-method' for the different notification behaviors. (defalias 'Man-notify-when-ready #[(man-buffer) "Šqˆ ) Ä=ƒŠqˆÅ!)‚ž Ç=ƒ%È!‚ž É=ƒC\nƒ:Ë\n!ƒ:Ì\n!ˆÍ!ˆÎ ‚ž Ï=ƒ^\nƒXË\n!ƒXÌ\n!ˆÍ!‚ž Ð=ƒz\nƒsË\n!ƒsÌ\n!ˆÑÒ\"‚ž Ó=ƒŒÔ ˆÕÖ×!\"‚ž Ø=ƒ›ÕÖ×!\"‚žÕÙ!)‡" [man-buffer Man-original-frame saved-frame Man-notify-method newframe make-frame Man-frame-parameters pushy switch-to-buffer bully window-system frame-live-p select-frame pop-to-buffer delete-other-windows aggressive friendly display-buffer not-this-window polite beep message "Manual buffer %s is ready" buffer-name quiet ""] 4 (#$ . 15147)]) #@112 Convert overstriking and underlining to the correct fonts. Same for the ANSI bold and normal escape sequences. (defalias 'Man-fontify-manpage #[nil "ÀÁ\n\"ˆebˆÃÄÅÆ#ƒ+ÇÈ!ˆÉ`ÃÊÅË#ƒ\"ÇÈ!ˆ`Ì $ˆ‚ebˆÃÎÅÆ#ƒFÏÐ!ˆÉ``TÌ$ˆ‚.ebˆÃÒÅÆ#ƒaÏÐ!ˆÉ`S`Ì$ˆ‚IebˆÓÔÅÆ#ƒ|ÕÖ!ˆÉ`S`Ì $ˆ‚debˆÓ×ÅÆ#ƒ–ÕØ!ˆÉ`S`ÌÙ$ˆ‚ebˆÓÚÅÆ#ƒ°ÕÛ!ˆÉ`S`ÌÙ$ˆ‚™ebˆÃÜÅÆ#ƒÂÕÝ!ˆ‚³ÀÞ\n\"‡" [message "Please wait: making up the %s man page..." Man-arguments search-forward "" nil t delete-backward-char 4 put-text-property "" move face Man-overstrike-face "_" backward-delete-char 2 Man-underline-face "_" re-search-forward "\\(.\\)\\(\\1\\)+" replace-match "\\1" "o\\+\\|\\+o" "o" bold "[-|]\\([-|]\\)+" "+" "­" "-" "%s man page made up"] 6 (#$ . 15842) nil]) #@62 Remove overstriking and underlining from the current buffer. (defalias 'Man-cleanup-manpage #[nil "ÀÁ\n\"ˆt„ „gebˆÄÅÆÇ#ƒÈÉ!ˆ‚ebˆÄÊÆÇ#ƒ1ÈÉ!ˆ‚\"ebˆËÌÆÇ#ƒCÍÎ!ˆ‚4ebˆËÏÆÇ#ƒUÍÐ!ˆ‚FebˆËÑÆÇ#ƒgÍÒ!ˆ‚XebˆËÓÆÇ#ƒyÍÔ!ˆ‚jebˆÄÕÆÇ#ƒ‹ÍÖ!ˆ‚|À×\n\"‡" [message "Please wait: cleaning up the %s man page..." Man-arguments Man-sed-script search-forward "_" nil t backward-delete-char 2 "_" re-search-forward "\\(.\\)\\(\\1\\)+" replace-match "\\1" "\\[[0-9]+m" "" "o\\+\\|\\+o" "o" "[-|]\\([-|]\\)+" "+" "­" "-" "%s man page cleaned up"] 4 (#$ . 16587) nil]) #@38 Manpage background process sentinel. (defalias 'Man-bgproc-sentinel #[(process msg) "À !‰Æ !„Ç Â\"‚¨Š qˆÂebˆÉÊ!„+ÉË!ƒ7`ˆ`{Ì‚sÍ !Î=ƒGÏ !ÐU„sÆ !ÑGSHÔUƒdÐO‚f)QdbˆÕÖ\"cˆ\fƒ~× !ˆ‚—ƒ‰Ù ˆ‚ŒÚ ˆÛÜ!ˆÝ ˆÞÂ!ˆ)\f„ ß !ˆ …§à !)+‡" [process-buffer process nil err-mess delete-buff Man-buffer buffer-name set-process-buffer case-fold-search looking-at "No \\(manual \\)*entry for" "[^\n]*: nothing appropriate$" t process-status exit process-exit-status 0 ": process " msg eos 10 format "\nprocess %s" kill-buffer Man-fontify-manpage-flag Man-fontify-manpage Man-cleanup-manpage run-hooks Man-cooked-hook Man-mode set-buffer-modified-p Man-notify-when-ready error] 5 (#$ . 17155)]) #@2093 A mode for browsing Un*x manual pages. The following man commands are available in the buffer. Try "\[describe-key] RET" for more information: \[man] Prompt to retrieve a new manpage. \[Man-follow-manual-reference] Retrieve reference in SEE ALSO section. \[Man-next-manpage] Jump to next manpage in circular list. \[Man-previous-manpage] Jump to previous manpage in circular list. \[Man-next-section] Jump to next manpage section. \[Man-previous-section] Jump to previous manpage section. \[Man-goto-section] Go to a manpage section. \[Man-goto-see-also-section] Jumps to the SEE ALSO manpage section. \[Man-quit] Deletes the manpage window, bury its buffer. \[Man-kill] Deletes the manpage window, kill its buffer. \[describe-mode] Prints this help text. The following variables may be of some use. Try "\[describe-variable] RET" for more information: Man-notify-method What happens when manpage formatting is done. Man-downcase-section-letters-flag Force section letters to lower case. Man-circular-pages-flag Treat multiple manpage list as circular. Man-auto-section-alist List of major modes and their section numbers. Man-section-translations-alist List of section numbers and their Un*x equiv. Man-filter-list Background manpage filter command. Man-mode-line-format Mode line format for Man mode buffers. Man-mode-map Keymap bindings for Man mode buffers. Man-mode-hook Normal hook run on entry to Man mode. Man-section-regexp Regexp describing manpage section letters. Man-heading-regexp Regexp describing section headers. Man-see-also-regexp Regexp for SEE ALSO section (or your equiv). Man-first-heading-regexp Regexp for first heading on a manpage. Man-reference-regexp Regexp matching a references in SEE ALSO. Man-switches Background `man' command switches. The following key bindings are currently in effect in the buffer: \{Man-mode-map} (defalias 'Man-mode #[nil "ÀÂÄÈ È\nËp!ˆÌÍ!ˆÎ!ˆÐ ˆÑ ˆÒ ˆÓÔ!ˆÕÖ!‡" [Man-mode major-mode "Man" mode-name nil buffer-auto-save-file-name Man-mode-line-format mode-line-format t truncate-lines buffer-read-only buffer-disable-undo auto-fill-mode -1 use-local-map Man-mode-map Man-build-page-list Man-strip-page-headers Man-unindent Man-goto-page 1 run-hooks Man-mode-hook] 2 (#$ . 17873) nil]) #@49 Build the association list of manpage sections. (defalias 'Man-build-section-alist #[nil "ÀebˆÀÃ\fdÅ#…?ÆÁÇÀ‰ „Ê ƒ/ ” •O‚6 ” •{*\"ˆÇyˆ‚)‡" [nil Man-sections-alist case-fold-search re-search-forward Man-heading-regexp t aput 1 string n 0] 6 (#$ . 20370)]) (put (quote Man-build-section-alist) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@69 Build the association list of references (in the SEE ALSO section). (defalias 'Man-build-references-alist #[nil "ÀŠÂ !…£Äyˆ`ÅÄ!ˆ`ÀÆ \nŒ\n }ˆebˆË ˆm?…¢`U?…¢`Ì  Î#ƒ›ÏÀ‰„Pσa”•O‚h”•{*‰GSƒPÀHÔUƒ”ÏO‚šÕÁ\"ˆ*ÖÀwˆ‚)-)‡" [nil Man-refpages-alist Man-find-section Man-see-also-regexp 1 Man-next-section -1 runningpoint hyphenated end start back-to-indentation re-search-forward Man-reference-regexp t 0 string n word len 45 aput " \n,"] 5 (#$ . 20747)]) (put (quote Man-build-references-alist) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@52 Build the list of separate manpages in the buffer. (defalias 'Man-build-page-list #[nil "Àed‰bˆm?…wÆ!…=ÈÀ ‰\n„$Ë\n ƒ5 \n”\n•O‚<\n”\n•{*Ì ÀÎÏ$ƒcËyˆ`ÑÒÀÓÔ$ˆÌÎ#ƒbËyˆ)`Õ Ö !Ö\f! EC\"\f‚ +‡" [nil Man-page-list "" header page-end page-start looking-at Man-page-header-regexp 1 string n 0 re-search-forward Man-first-heading-regexp move 2 p search-backward "\n\n" t 3 append copy-marker] 6 (#$ . 21367)]) #@60 Strip all the page headers but the first from the manpage. (defalias 'Man-strip-page-headers #[nil "À‰ À …K @È\f8ƒC\f@bƒCÉ\nÀË#ƒC\f@Ì”{‰ƒCÍ \fA@Ë#ƒCÎÂ!ˆ‚2 A‰„À-‡" [nil Man-page-list "" header page page-list case-fold-search buffer-read-only 2 re-search-forward Man-first-heading-regexp t 0 search-forward replace-match] 6 (#$ . 21806)]) #@52 Delete the leading spaces that indent the manpage. (defalias 'Man-unindent #[nil "À‰ \n…F\n@ÅƉ @ A@}ˆ\nƒ&Ëed\"ˆÌ̓?m„?l„9Î!ˆÏyˆ‚,\nA+‚+‡" [nil Man-page-list page-list case-fold-search buffer-read-only "" 0 nindent indent page Man-uses-untabify-flag untabify unindent (byte-code "ebˆÀ ÂÃ#„ÄÅÂ\"ˆÆyˆ`ÇÂwˆ`{‰G‰ ÆUƒ+ÄÅÂ\"ˆÊPebˆm„MË!ƒEÌyˆ‚4ÄÅÂ\"ˆ‚4eb‡" [re-search-forward Man-first-heading-regexp nil t throw unindent 0 " " indent nindent "\\|$" looking-at 1] 5) delete-char 1] 4 (#$ . 22170)]) #@45 Move point to Nth next section (default 1). (defalias 'Man-next-section #[(n) "À !ƒ ÄyˆÅ dÆ$ƒÈyˆÀ‚db)‡" [nil case-fold-search looking-at Man-heading-regexp 1 re-search-forward t n 0] 5 (#$ . 22705) "p"]) #@49 Move point to Nth previous section (default 1). (defalias 'Man-previous-section #[(n) "À !ƒ ÄyˆÅ eÆ$ƒÈyˆÀ‚eb)‡" [nil case-fold-search looking-at Man-heading-regexp -1 re-search-backward t n 0] 5 (#$ . 22924) "p"]) #@111 Move point to SECTION if it exists, otherwise don't move point. Returns t if section is found, nil otherwise. (defalias 'Man-find-section #[(section) "`ÀebˆÃÄ PdÆ#ƒÇyˆÆ‚\nbˆÀ*‡" [nil case-fold-search curpos re-search-forward "^" section t 0] 4 (#$ . 23154)]) #@37 Query for section to move point to. (defalias 'Man-goto-section #[nil "ÀÁ !ÄÆÈ ÉQ\nË\n \"‰ƒ#̘ƒ' ‚),\"ˆÍ !!‡" [aput Man-sections-alist aheadsym default t completion-ignore-case nil chosen "Go to section: (default " ") " prompt completing-read "" Man-find-section] 6 (#$ . 23425) nil]) #@109 Move point the the "SEE ALSO" section. Actually the section moved to is described by `Man-see-also-regexp'. (defalias 'Man-goto-see-also-section #[nil "À !?… Âà ÄQ!‡" [Man-find-section Man-see-also-regexp error "No " " section found in the current manpage"] 4 (#$ . 23734) nil]) #@131 Get one of the manpages referred to in the "SEE ALSO" section. Specify which reference to use; default is based on word at point. (defalias 'Man-follow-manual-reference #[(reference) "„ÁÂ!‡ÃÀ\f\"ˆÅÆÇ!!!‡" [Man-refpages-alist error "Can't find any references in the current manpage" aput reference Man-getpage-in-background Man-translate-references aheadsym] 4 (#$ . 24021) (byte-code "„ÁÂ!‡ÃŠÄÅ!ˆÆÇwˆÈ  ÊË \"ƒ' ̉”O‚) *\"@†3Í!ÇÐÑQÓÇÔ$‰ƒSÕ˜ƒX‚Z+C‡" [Man-refpages-alist error "There are no references in the current man page" all-completions skip-syntax-backward "w()" " " nil current-word word string-match "-$" 0 aheadsym default chosen "Refer to: (default " ") " prompt completing-read t ""] 6)]) #@41 Kill the buffer containing the manpage. (defalias 'Man-kill #[nil "pÁ!ˆÂ!ˆ) …\"\fÅ=„ …\"\fÇ=…\"È ‡" [buff delete-windows-on kill-buffer window-system Man-notify-method newframe pop-up-frames bully delete-frame] 2 (#$ . 24764) nil]) #@41 Bury the buffer containing the manpage. (defalias 'Man-quit #[nil "pÁ!ˆÂ!ˆ) …\"\fÅ=„ …\"\fÇ=…\"È ‡" [buff delete-windows-on bury-buffer window-system Man-notify-method newframe pop-up-frames bully delete-frame] 2 (#$ . 25011) nil]) #@37 Go to the manual page on page PAGE. (defalias 'Man-goto-page #[(page) "„ Ãp!ˆÄÅ\n\"ˆ)ÇW„GVƒ%ÄÈ\"ˆS8‰ @\n A@ \fÍÎÏ\fS88†GÐ\fG$~ˆ\nbˆ\n }ˆÒebˆÒÕd×#…œØÓÇÒ‰„{ÛƒŒ”•O‚“”•{*\"ˆÇyˆ‚c)ˆÒŠÝ!…CÇyˆ`ßÇ!ˆ`Òà!\"#$Œ$#}ˆebˆå ˆm?…B`!U?…B`!Õ&#×#ƒ;ÛÒ‰„ðÛƒ”•O‚”•{*‰'GS(\"ƒ\"'P'Ò\"'(HéUƒ4'Û(O\"‚:ØÜ'\"ˆ*êÒwˆ‚É-)ˆeb+‡" [Man-page-list Man-arguments args kill-buffer error "Can't find the %s manpage" page 1 "No manpage %d found" page-range page-start page-end Man-current-page format "%s page %d of %d" 2 "" Man-page-mode-string nil Man-sections-alist case-fold-search re-search-forward Man-heading-regexp t aput string n 0 Man-refpages-alist Man-find-section Man-see-also-regexp Man-next-section -1 runningpoint hyphenated end start back-to-indentation Man-reference-regexp word len 45 " \n,"] 7 (#$ . 25258) (byte-code "„ Ãp!ˆÄÅ\n\")‡GÆUƒÄÇ!‡ÈÉÊG\"!C‡" [Man-page-list Man-arguments args kill-buffer error "Can't find the %s manpage" 1 "You're looking at the only manpage in the buffer" read-minibuffer format "Go to manpage [1-%d]: "] 4)]) #@44 Find the next manpage entry in the buffer. (defalias 'Man-next-manpage #[nil "GÁUƒ ÂÃ!ˆ\fGWƒÅ\fT!‡ƒ ÅÁ!‡ÂÇ!‡" [Man-page-list 1 error "This is the only manpage in the buffer" Man-current-page Man-goto-page Man-circular-pages-flag "You're looking at the last manpage in the buffer"] 2 (#$ . 26413) nil]) #@48 Find the previous manpage entry in the buffer. (defalias 'Man-previous-manpage #[nil "GÁUƒ ÂÃ!ˆ\fÁVƒÅ\fS!‡ƒ ÅG!‡ÂÇ!‡" [Man-page-list 1 error "This is the only manpage in the buffer" Man-current-page Man-goto-page Man-circular-pages-flag "You're looking at the first manpage in the buffer"] 2 (#$ . 26729) nil]) (provide (quote man)) emacs-19.30/lisp/map-ynp.elc100666 12062 1 11170 5765727146 14134 0ustar bobdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Thu Jun 8 22:13:53 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/map-ynp.el ;;; emacs version 19.28.93.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`map-ynp.el' was compiled for Emacs 19.29 or later")) #@1922 Ask a series of boolean questions. Takes args PROMPTER ACTOR LIST, and optional args HELP and ACTION-ALIST. LIST is a list of objects, or a function of no arguments to return the next object or nil. If PROMPTER is a string, the prompt is (format PROMPTER OBJECT). If not a string, PROMPTER is a function of one arg (an object from LIST), which returns a string to be used as the prompt for that object. If the return value is not a string, it may be nil to ignore the object or non-nil to act on the object without asking the user. ACTOR is a function of one arg (an object from LIST), which gets called with each object that the user answers `yes' for. If HELP is given, it is a list (OBJECT OBJECTS ACTION), where OBJECT is a string giving the singular noun for an elt of LIST; OBJECTS is the plural noun for elts of LIST, and ACTION is a transitive verb describing ACTOR. The default is ("object" "objects" "act on"). At the prompts, the user may enter y, Y, or SPC to act on that object; n, N, or DEL to skip that object; ! to act on all following objects; ESC or q to exit (skip all following objects); . (period) to act on the current object and then exit; or \[help-command] to get help. If ACTION-ALIST is given, it is an alist (KEY FUNCTION HELP) of extra keys that will be accepted. KEY is a character; FUNCTION is a function of one arg (an object from LIST); HELP is a string. When the user hits KEY, FUNCTION is called. If it returns non-nil, the object is considered "acted upon", and the next object from LIST is processed. If it returns nil, the prompt is repeated for the same object. Final optional argument NO-CURSOR-IN-ECHO-AREA non-nil says not to set `cursor-in-echo-area' while prompting. This function uses `query-replace-map' to define the standard responses, but not all of the responses which `query-replace' understands are meaningful here. Returns the number of actions taken. (defalias 'map-y-or-n-p #[(prompter actor list &optional help action-alist no-cursor-in-echo-area) "À Â\n \fƒ%\f9„AÍ\f!„AÎ\f!„A\f:ƒE\f@Ï=ƒEЂFÑ<ƒÔ@!ÔA@!ÔÖ8!ÚÛ܃wÝÞR‚xßàBƒˆáQ‚‰âãBäå&\"BBBBB+‚»&ƒ­çè&é#ÝP‚®êëìäí&\".\"BïŽ0;ƒÎÏñò0óBBE0 ƒ0!‰;ƒÂ4\fƒ÷õ\f B\"†òö\n‚17?Â89úû üý>!!$ˆÿ ú@ üý>!!A!%ˆ*B ý!\"\n\nC=ƒCD‰‚Ð\nE=ƒXF!ˆ T‚Î\nG=„Î\nà=ƒzF!ˆ TH‰‚Ð\nö=„Š\nI=ƒ©J4ÏÂKÒLDELDF‰‚Ð\nã=ƒÛ0!ƒÁF!ˆ T ƒÎ0!ƒÁF!ˆ T‚Á\nÕ=ƒoMNƒô@‚÷OƒA@‚PƒÖ8‚QòR‰&çS&T#&…<TòU#R+!ˆŠVqˆW )‘ˆÏÂKÒLDELDF‰‚ÐX\n!ƒ¢\nÀH!ƒˆ T‚ÎÏÂKÒLDELDF‰‚Ð:ƒÐ@Y=ƒÐ ÏÂKÒLDELDF‰‚ÐúZüý>!!\"ˆ[ ˆ\\]!ˆÏÂKÒLDELDF‰‚ЃÎF!ˆ T‚Î)Â8úê!ˆ) . ‡" [0 actions nil user-keys mouse-event map prompt char elt tail def delayed-switch-frame list subrp byte-code-function-p lambda #[nil " ‰‡" [list elt] 2] #[nil "… @A‡" [list elt t] 1] next last-nonmenu-event capitalize help 2 action objects object ("Yes" . act) ("No" . skip) ("Quit" . exit) " " " And Quit" "Do it and Quit" act-and-exit " All " "Do All" automatic mapcar #[(elt) "ÀÁ\n8!Ã\nA@!B‡" [capitalize 2 elt vector] 3] action-alist mapconcat #[(elt) "ÀÁ\n@!!‡" [key-description char-to-string elt] 3] ", " "" keymap append #[(elt) "@ÁA@!B‡" [elt vector] 3] query-replace-map ((byte-code "ƒ B‡" [delayed-switch-frame unread-command-events nil] 2)) prompter (object) format (object) quit-flag x-popup-dialog quit no-cursor-in-echo-area message-log-max cursor-in-echo-area message "%s(y, n, !, ., q, %sor %s) " key-description vector help-char read-event "%s(y, n, !, ., q, %sor %s) %s" single-key-description lookup-key exit #[nil "À‡" [nil] 1] act actor skip #[nil "À‡" [nil] 1] exit-prefix t setq quote "*Help*" princ "object" "objects" "act on" "Type SPC or `y' to %s the current %s;\nDEL or `n' to skip the current %s;\n! to %s all remaining %s;\nESC or `q' to exit;\n" #[(elt) "ÀÁ\n@Ã\n8#‡" [format "%c to %s" elt 2] 5] ";\n" "or . (period) to %s the current %s and exit." standard-output help-mode vectorp switch-frame "Type %s for help." beep sit-for 1] 10 (#$ . 478)]) emacs-19.30/lisp/meese.elc100666 13437 1 1620 5744576723 14016 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:46:27 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/meese.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/meese.el' was compiled for Emacs 19")) (defalias 'protect-innocence-hook #[nil "À ! ÃÄ\n\"š…3Å !…3ÆÇ!?…3È ˆÃÉ\n\"Ê Ì ˆÍ Ê\"ˆ)ÎÏ !!)‡" [file-name-directory buffer-file-name dir expand-file-name "sex.6" file-exists-p y-or-n-p "Are you over 18? " clear-visited-file-modtime "celibacy.1" t inhibit-read-only erase-buffer insert-file-contents rename-buffer file-name-nondirectory] 4]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [add-hook find-file-hooks protect-innocence-hook provide meese] 3) emacs-19.30/lisp/menu-bar.elc100666 12120 1 34430 6053157301 14274 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 17 14:12:46 1995 ;;; from file /home/fsf/rms/e19/lisp/menu-bar.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`menu-bar.el' was compiled for Emacs 19.29 or later")) (byte-code "À Â\"„à ÄÅÆ!#ˆÇÈ!„ÅÉ!È\nB\nË\fà ÍÉB#ˆÇÎ!„7ÅÏ!Î\nB\nà ÐÏB#ˆÇÑ!„QÅÒ!Ñ\nB\nà ÓÒB#ˆÇÔ!„kÅÕ!Ô\nB\nà ÖÕB#ˆÇ×!„…ÅØ!×\nB\nà ÙØB#ˆÇÚ!„žÚ\nB\nÇÛ!„¯ÅÜ!Û\nB\nÃÝÞ#ˆÃßà#ˆÃáâ#ˆÃãä#ˆÃåÜB#ˆÃæç#ˆÃèé#ˆÃêë#ˆÃìí#ˆÃîï#ˆðñòó#ˆðôòó#ˆÃõö#ˆÃ÷ø#ˆÃùú#ˆÃûü#ˆÃýþ#ˆÃÿ@#ˆÃAB#ˆÃCD#ˆEF!ƒwÃGH#ˆÃIJ#ˆÃKL#ˆÃMN#ˆÃOP#ˆÃQR#ˆÃST#ˆÃUV#ˆÃWX#ˆÃYZ#ˆÃ[\\#‡" [lookup-key global-map [menu-bar] define-key [menu-bar] make-sparse-keymap "menu-bar" boundp menu-bar-help-menu "Help" current-load-list (help-menu) menu-bar-final-items [menu-bar help-menu] menu-bar-search-menu "Search" [menu-bar search] menu-bar-edit-menu "Edit" [menu-bar edit] menu-bar-tools-menu "Tools" [menu-bar tools] menu-bar-files-menu "Files" [menu-bar files] menu-bar-file-menu vc-menu-map "Version Control" [calendar] ("Display Calendar" . calendar) [rmail] ("Read Mail" . rmail) [gnus] ("Read Net News" . gnus) [separator-vc] ("--") [vc-menu] [separator-compare] ("--") [epatch] ("Apply Patch" . menu-bar-epatch-menu) [ediff-merge] ("Merge" . menu-bar-ediff-merge-menu) [compare] ("Compare" . menu-bar-ediff-menu) [separator-print] ("--") put print-region menu-enable mark-active ps-print-region-with-faces [ps-print-region] ("Postscript Print Region" . ps-print-region-with-faces) [ps-print-buffer] ("Postscript Print Buffer" . ps-print-buffer-with-faces) [print-region] ("Print Region" . print-region) [print-buffer] ("Print Buffer" . print-buffer) [exit-emacs] ("Exit Emacs" . save-buffers-kill-emacs) [separator-exit] ("--") [one-window] ("One Window" . delete-other-windows) [split-window] ("Split Window" . split-window-vertically) fboundp delete-frame [delete-this-frame] ("Delete Frame" . delete-frame) [make-frame-on-display] ("Open New Display..." . make-frame-on-display) [make-frame] ("Make New Frame" . make-frame) [separator-buffers] ("--") [kill-buffer] ("Kill Current Buffer" . kill-this-buffer) [insert-file] ("Insert File..." . insert-file) [revert-buffer] ("Revert Buffer" . revert-buffer) [write-file] ("Save Buffer As..." . write-file) [save-buffer] ("Save Buffer" . save-buffer) [dired] ("Open Directory..." . dired) [open-file] ("Open File..." . find-file)] 5) #@51 Read a string and search for it nonincrementally. (defalias 'nonincremental-search-forward #[(string) "Ášƒ  @!‡ÄÅ\"ˆÂ!‡" [string "" search-forward search-ring isearch-update-ring nil] 3 (#$ . 2766) "sSearch for string: "]) #@60 Read a string and search backward for it nonincrementally. (defalias 'nonincremental-search-backward #[(string) "Ášƒ  @!‡ÄÅ\"ˆÂ!‡" [string "" search-backward search-ring isearch-update-ring nil] 3 (#$ . 3000) "sSearch for string: "]) #@63 Read a regular expression and search for it nonincrementally. (defalias 'nonincremental-re-search-forward #[(string) "Ášƒ  @!‡ÄÅ\"ˆÂ!‡" [string "" re-search-forward regexp-search-ring isearch-update-ring t] 3 (#$ . 3245) "sSearch for regexp: "]) #@72 Read a regular expression and search backward for it nonincrementally. (defalias 'nonincremental-re-search-backward #[(string) "Ášƒ  @!‡ÄÅ\"ˆÂ!‡" [string "" re-search-backward regexp-search-ring isearch-update-ring t] 3 (#$ . 3502) "sSearch for regexp: "]) #@48 Search forward for the previous search string. (defalias 'nonincremental-repeat-search-forward #[nil "À @!‡" [search-forward search-ring] 2 (#$ . 3770) nil]) #@49 Search backward for the previous search string. (defalias 'nonincremental-repeat-search-backward #[nil "À @!‡" [search-backward search-ring] 2 (#$ . 3934) nil]) #@53 Search forward for the previous regular expression. (defalias 'nonincremental-repeat-re-search-forward #[nil "À @!‡" [re-search-forward regexp-search-ring] 2 (#$ . 4101) nil]) #@54 Search backward for the previous regular expression. (defalias 'nonincremental-repeat-re-search-backward #[nil "À @!‡" [re-search-backward regexp-search-ring] 2 (#$ . 4283) nil]) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆÀ ØÙ#ˆÀ ÚÛ#ˆÀ ÜÝ#ˆÞß!ƒaÀ áâ#ˆÀ ãä#ˆÀ åæ#ˆÀ çè#ˆÀ éê#ˆÀ ëì#ˆíî!„ïðB.î1B1îò.BMˆÀ óô#ˆÀ õö#ˆÀ ÷ø#ˆÀ ùú#‡" [define-key menu-bar-search-menu [query-replace-regexp] ("Query Replace Regexp..." . query-replace-regexp) [query-replace] ("Query Replace..." . query-replace) [find-tag] ("Find Tag..." . find-tag) [bookmark] ("Bookmarks" . menu-bar-bookmark-map) [separator-search] ("--") [nonincremental-repeat-re-search-back] ("Repeat Regexp Backwards" . nonincremental-repeat-re-search-backward) [nonincremental-repeat-search-back] ("Repeat Backwards" . nonincremental-repeat-search-backward) [nonincremental-repeat-re-search-fwd] ("Repeat Regexp" . nonincremental-repeat-re-search-forward) [nonincremental-repeat-search-fwd] ("Repeat Search" . nonincremental-repeat-search-forward) [separator-repeat] ("--") [re-search-back] ("Regexp Search Backwards..." . nonincremental-re-search-backward) [search-back] ("Search Backwards..." . nonincremental-search-backward) [re-search-fwd] ("Regexp Search..." . nonincremental-re-search-forward) [search-fwd] ("Search..." . nonincremental-search-forward) fboundp start-process menu-bar-edit-menu [spell] ("Spell" . ispell-menu-map) [fill] ("Fill" . fill-region) [props] ("Text Properties" . facemenu-menu) [separator-edit] ("--") [clear] ("Clear" . delete-region) [paste] ("Paste Most Recent" . yank) boundp yank-menu "Select Yank" nil current-load-list keymap [select-paste] ("Select and Paste" . yank-menu) [copy] ("Copy" . menu-bar-kill-ring-save) [cut] ("Cut" . kill-region) [undo] ("Undo" . undo)] 4) (defalias 'menu-bar-kill-ring-save #[(beg end) "À ƒ ÁÂ!‡Ã\f \"‡" [mouse-region-match message "Select a region with the mouse does `copy' automatically" kill-ring-save beg end] 3 nil "r"]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#ˆÀÈÂÉ#ˆÀÊÂË#ˆÀÌÂÍ#ˆÀÎÂÏ#ˆÀÐÂÑ#ˆÀÒÂÓ#ˆÔÕÖ×ØÙ%ˆÀÚÂÇ#ˆÀÛÂÇ#ˆÀÜÂÝ#‡" [put fill-region menu-enable (and mark-active (not buffer-read-only)) kill-region (and mark-active (not buffer-read-only)) menu-bar-kill-ring-save mark-active yank (and (x-selection-exists-p) (not buffer-read-only)) yank-menu (and (cdr yank-menu) (not buffer-read-only)) delete-region (and mark-active (not buffer-read-only) (not (mouse-region-match))) undo (and (not buffer-read-only) (if (eq last-command (quote undo)) pending-undo-list (consp buffer-undo-list))) query-replace (not buffer-read-only) query-replace-regexp (not buffer-read-only) autoload ispell-menu-map "ispell" nil t keymap clipboard-kill-region clipboard-kill-ring-save clipboard-yank (or (x-selection-exists-p) (x-selection-exists-p (quote CLIPBOARD)))] 6) #@70 Reinsert the last stretch of killed text, or the clipboard contents. (defalias 'clipboard-yank #[nil "À )‡" [t x-select-enable-clipboard yank] 1 (#$ . 7111) nil]) #@56 Copy region to kill ring, and save in the X clipboard. (defalias 'clipboard-kill-ring-save #[(beg end) "À \f\")‡" [t x-select-enable-clipboard kill-ring-save beg end] 3 (#$ . 7282) "r"]) #@50 Kill the region, and save it in the X clipboard. (defalias 'clipboard-kill-region #[(beg end) "À \f\")‡" [t x-select-enable-clipboard kill-region beg end] 3 (#$ . 7477) "r"]) #@114 Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard. Do the same for the keys of the same name. (defalias 'menu-bar-enable-clipboard #[nil "À ÂÃÄB#ˆÀ ÅÆÇB#ˆÀ ÈÉÊB#ˆÀ ÌÊ#ˆÀ ÍÇ#ˆÀ ÎÄ#ˆÀ ÏÊ#ˆÀ ÐÇ#ˆÀ ÑÄ#‡" [define-key menu-bar-edit-menu [paste] "Paste" clipboard-yank [copy] "Copy" clipboard-kill-ring-save [cut] "Cut" clipboard-kill-region global-map [f20] [f16] [f18] [cut] [copy] [paste]] 5 (#$ . 7661) nil]) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆÀ ØÙ#ˆÀ ÚÛ#ˆÀ ÜÝ#‡" [define-key menu-bar-help-menu [emacs-version] ("Show Version" . emacs-version) [report-emacs-bug] ("Send Bug Report..." . report-emacs-bug) [finder-by-keyword] ("Find Lisp Packages..." . finder-by-keyword) [emacs-tutorial] ("Emacs Tutorial" . help-with-tutorial) [man] ("Man..." . manual-entry) [describe-variable] ("Describe Variable..." . describe-variable) [describe-function] ("Describe Function..." . describe-function) [describe-key] ("Describe Key..." . describe-key) [list-keybindings] ("List Keybindings" . describe-bindings) [command-apropos] ("Command Apropos..." . command-apropos) [describe-mode] ("Describe Mode" . describe-mode) [info] ("Browse Manuals" . info) [emacs-faq] ("Emacs FAQ" . view-emacs-FAQ) [emacs-news] ("Emacs News" . view-emacs-news)] 4) #@27 Kills the current buffer. (defalias 'kill-this-buffer #[nil "Àp!‡" [kill-buffer] 2 (#$ . 8967) nil]) (defalias 'kill-this-buffer-enabled-p #[nil "ÀÁ \nƒÄÅÆ\n@!\"„ T\nA‰„ ÇÈ !?…( ÉV*‡" [0 buffer-list buffers count string-match "^ " buffer-name window-minibuffer-p selected-window 1] 5]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#ˆÀÈÂÉ#ˆÀÊÂË#ˆÀÌÂÍ#ˆÀÎÂÏ#ˆÀÐÂÑ#‡" [put kill-this-buffer menu-enable (kill-this-buffer-enabled-p) save-buffer (and (buffer-modified-p) (not (window-minibuffer-p (selected-window)))) write-file (not (window-minibuffer-p (selected-window))) find-file (not (window-minibuffer-p (selected-window))) dired (not (window-minibuffer-p (selected-window))) insert-file (not (window-minibuffer-p (selected-window))) revert-buffer (or revert-buffer-function revert-buffer-insert-file-contents-function (and (buffer-file-name) (or (buffer-modified-p) (not (verify-visited-file-modtime (current-buffer)))))) delete-frame (delete-frame-enabled-p)] 4) #@69 Return non-nil if `delete-frame' should be enabled in the menu bar. (defalias 'delete-frame-enabled-p #[nil "À Á‰ƒÄ @!ƒ\nT A‰„ \nÅV*‡" [frame-list 0 count frames frame-visible-p 1] 3 (#$ . 9932)]) (put (quote advertised-undo) (quote menu-enable) (quote (and (not (eq t buffer-undo-list)) (if (eq last-command (quote undo)) (and (boundp (quote pending-undo-list)) pending-undo-list) buffer-undo-list)))) #@46 *Maximum length to display in the yank-menu. (defvar yank-menu-length 20 (#$ . -10350)) (defalias 'menu-bar-update-yank-menu #[(string old) "A@ G\nXƒ ‚ Ã\nÄ¥OÅ \nÄ¥[ÆOQÉÊ\"ƒ/ËP\fƒU\f@=„F\f@˜ƒU  ˆA ˆ‚a ÍBBAB¡ˆ*AGV…q›Æ¡‡" [yank-menu string yank-menu-length 0 2 "..." nil menu-string front string-match "\\`-+\\'" " " old menu-bar-select-yank kill-ring-max] 6]) (defalias 'menu-bar-select-yank #[nil "À`!ˆ c‡" [push-mark last-command-event] 2 nil "*"]) (byte-code "À ÂÃÄÃ!B#‡" [define-key global-map [menu-bar buffer] "Buffers" make-sparse-keymap] 6) #@239 *Maximum number of entries which may appear on the Buffers menu. If this is 10, then only the ten most-recently-selected buffers are shown. If this is nil, then all buffers are shown. A large number or nil slows down menu responsiveness. (defvar buffers-menu-max-size 10 (#$ . -10949)) (byte-code "ÀÁ!„ÂÁ BÄ B‡" [boundp list-buffers-directory nil current-load-list menu-bar-update-buffers-maxbuf] 2) (defalias 'menu-bar-select-buffer #[nil "À !‡" [switch-to-buffer last-command-event] 2 nil nil]) (defalias 'menu-bar-select-frame #[nil "À !ˆÂ !ˆÃ !‡" [make-frame-visible last-command-event raise-frame select-frame] 2 nil nil]) (defalias 'menu-bar-update-buffers-1 #[(elt) "À‰Á\n\" AÄ @!ƒÅ‚ÆŠ @qˆƒ!È‚\"Æ)É @!†6Š @qˆ\n)†6Ë\fÍ\f!†@ˉ\fGÎVƒRÏ\fÐÑOP\f\f)% @B‡" [format "%%%ds %%s%%s %%s" menu-bar-update-buffers-maxbuf elt buffer-modified-p "*" " " buffer-read-only "%" buffer-file-name list-buffers-directory "" file file-name-directory 20 "..." -17 nil] 10]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp menu-bar-buffers-menu-list-buffers-entry nil current-load-list] 2) (defalias 'menu-bar-update-buffers #[nil "ÀÁ Â\"…pà …pÄ Å Æ‰ \n ¨ƒ9 ÌVƒ9\nG Vƒ9 \n›Æ¡ˆÍÎÏ\n\"ÆÑÑÆÆ\f‰ƒ†Ö@@!@GØVƒxÑÙOÚÛÆOQ‚z¡ˆ)A‰„V\f‰ƒ«@AÑHÜ=„¢@AG]A‰„\f‰ƒë@ÜAÑH=„ÊÞ!Bƒá@@GVƒá@@G)A‰„²Ÿ„üàáàBBAâã¥äZÑ]Ü\"åP ˆÎæ\"C¤.B Aƒ+çÎè \"Bƒ6éBƒAéBêÁ ëìƒbƒbéíÊìBBÉîBBF‚m†m†mïB#,‡" [lookup-key current-global-map [menu-bar buffer] frame-or-buffer-changed-p buffer-list frame-list nil frames-menu buffers-menu frames buffers buffers-menu-max-size 1 "Select Buffer" mapcar list tail 0 menu-bar-update-buffers-maxbuf maxlen alist head buffer-name name 27 12 "..." -12 32 elt menu-bar-update-buffers-1 menu-bar-buffers-menu-list-buffers-entry list-buffers "" make-string 2 8 "List All Buffers" #[(pair) "À A! @‰BEä‡" [buffer-name pair nil menu-bar-select-buffer] 4] "Select Frame" #[(frame) "ÁÂ!žAÉBEĤ‡" [frame name frame-parameters nil menu-bar-select-frame] 4] keymap define-key [menu-bar buffer] "Buffers" "Buffers and Frames" "Frames" undefined] 11]) (byte-code "ÀÁÂ\"ˆÂ ˆÃÄ  ¯\"ˆÃÊ D\"ˆÃË  ¯\"ˆÌÍ!„8Î ÍB·" [add-hook menu-bar-update-hook menu-bar-update-buffers mapcar #[(map) "À ÂÃÄÃ!B#‡" [define-key map [menu-bar minibuf] "Minibuf" make-sparse-keymap] 6] minibuffer-local-ns-map minibuffer-local-must-match-map minibuffer-local-isearch-map minibuffer-local-map minibuffer-local-completion-map #[(map) "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#‡" [define-key map [menu-bar minibuf 63] ("List Completions" . minibuffer-completion-help) [menu-bar minibuf space] ("Complete Word" . minibuffer-complete-word) [menu-bar minibuf tab] ("Complete" . minibuffer-complete)] 4] #[(map) "À ÂÃ#ˆÀ ÄÅ#‡" [define-key map [menu-bar minibuf quit] ("Quit" . keyboard-escape-quit) [menu-bar minibuf return] ("Enter" . exit-minibuffer)] 4] boundp menu-bar-mode nil current-load-list] 7) #@235 Toggle display of a menu bar on each frame. This command applies to all frames that exist and frames to be created in the future. With a numeric argument, if the argument is negative, turn off menu bars; otherwise, turn on menu bars. (defalias 'menu-bar-mode #[(flag) "À ž‰ƒ\nAÃ=?‚À\fƒÅ‚ÃB B)„*\f?‚0Ç!ÃVÀ ž‰:ƒK\fƒEÅ‚FሂYÀ\fƒTÅ‚UÃB B)É ‰\n…”ËÌ\n@!žA Í\n@À\fƒyÅ‚zÃBC\"ˆÍ\n@Ë BC\"ˆ)\nA‰\n„bÎ)‡" [menu-bar-lines default-frame-alist default 0 menu-bar-mode 1 flag prefix-numeric-value parameter frame-list frames height frame-parameters modify-frame-parameters nil] 5 (#$ . 13963) "P"]) (provide (quote menu-bar)) emacs-19.30/lisp/metamail.elc100666 13437 1 3633 5744576730 14515 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:46:32 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/metamail.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/metamail.el' was compiled for Emacs 19")) #@25 *Metamail program name. (defvar metamail-program-name "metamail" (#$ . -485)) #@114 *Environment variables passed to `metamail'. It must ba a list of strings that have the format ENVVARNAME=VALUE. (defvar metamail-environment (quote ("KEYHEADS=*")) (#$ . -570)) #@70 *Switches for `metamail' program. -z is required to remove zap file. (defvar metamail-switches (quote ("-m" "emacs" "-x" "-d" "-z")) (#$ . -754)) #@221 Process current buffer through `metamail'. Optional 1st argument BUFFER specifies a buffer to be filled (nil means current). Optional 2nd argument NODISPLAY non-nil means buffer is not redisplayed as output is inserted. (defalias 'metamail-buffer #[(&optional buffer nodisplay) "Àed \n$‡" [metamail-region buffer nodisplay] 5 (#$ . 907) nil]) #@221 Process current region through 'metamail'. Optional 1st argument BUFFER specifies a buffer to be filled (nil means current). Optional 2nd argument NODISPLAY non-nil means buffer is not redisplayed as output is inserted. (defalias 'metamail-region #[(beg end &optional buffer nodisplay) "pÀÁÂ!ŠÆ ÀÉ%ˆ\nƒ\nqˆÀ p=ƒ-|ˆ‚1ed|ˆË\f \" ÎÏÀÑ?Ë C\"&ˆ)ÔÕÖ,‡" [nil make-temp-name "/tmp/metamail" metafile buffer-read-only curbuf write-region beg end nomessage buffer append metamail-environment process-environment apply call-process metamail-program-name t nodisplay metamail-switches error (delete-file metafile) ((error))] 9 (#$ . 1257) "r"]) (provide (quote metamail)) emacs-19.30/lisp/mh-comp.elc100666 12120 1 66362 6046535466 14155 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 20:00:17 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mh-comp.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`mh-comp.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!‡" [provide mh-comp require mh-utils] 2) #@89 Name of the MH send program. Some sites need to change this because of a name conflict. (defvar mh-send-prog "send" (#$ . 539)) #@212 Non-nil if the `dist' command needs whole letter for redistribution. This is the case only when `send' is compiled with the BERK option. If MH will not allow you to redist a previously redist'd msg, set to nil. (defvar mh-redist-full-contents nil (#$ . 674)) #@69 String whose first character is used to notate replied to messages. (defvar mh-note-repl "-" (#$ . 939)) #@68 String whose first character is used to notate forwarded messages. (defvar mh-note-forw "F" (#$ . 1050)) #@72 String whose first character is used to notate redistributed messages. (defvar mh-note-dist "R" (#$ . 1161)) #@352 Obsolete hook for modifying a citation just inserted in the mail buffer. Each hook function can find the citation between point and mark. And each hook function should leave point and mark around the citation text as modified. This is a normal hook, misnamed for historical reasons. It is semi-obsolete and is only used if mail-citation-hook is nil. (defvar mh-yank-hooks nil (#$ . 1277)) #@450 *Hook for modifying a citation just inserted in the mail buffer. Each hook function can find the citation between point and mark. And each hook function should leave point and mark around the citation text as modified. If this hook is entirely empty (nil), the text of the message is inserted with mh-ins-buf-prefix prefixed to each line. See also the variable mh-yank-from-start-of-msg, which controls how much of the message passed to the hook. (defvar mail-citation-hook nil (#$ . -1674)) #@76 *Line used by MH to separate headers from text in messages being composed. (defvar mail-header-separator "--------" (#$ . -2174)) #@199 *Controls window display when a message is yanked by \\[mh-yank-cur-msg]. If non-nil, yanking the current message into a draft letter deletes any windows displaying the message. (defvar mh-delete-yanked-msg-window nil (#$ . -2311)) #@319 *Controls which part of a message is yanked by \\[mh-yank-cur-msg]. If non-nil, include the entire message. If the symbol `body', then yank the message minus the header. If nil, yank only the portion of the message following the point. If the show buffer has a region, this variable is ignored. (defvar mh-yank-from-start-of-msg t (#$ . -2570)) #@201 *String to put before each non-blank line of a yanked or inserted message. \Used when the message is inserted into an outgoing letter by \[mh-insert-letter] or \[mh-yank-cur-msg]. (defvar mh-ins-buf-prefix "> " (#$ . -2945)) #@261 *Sets the person or persons to whom a reply will be sent. If nil, prompt for recipient. If non-nil, then \`\[mh-reply]' will use this value and it should be one of "from", "to", "cc", or "all". The values "cc" and "all" do the same thing. (defvar mh-reply-default-reply-to nil (#$ . -3197)) #@118 *Name of file containing the user's signature. Inserted into message by \\[mh-insert-signature]. (defvar mh-signature-file-name "~/.signature" (#$ . -3516)) #@182 *Format to generate the Subject: line contents for a forwarded message. The two string arguments to the format are the sender of the original message and the original subject line. (defvar mh-forward-subject-format "%s: %s" (#$ . -3700)) #@214 Name of file to be used as a skeleton for composing messages. Default is "components". If not a complete path name, the file is searched for first in the user's MH directory, then in the system MH lib directory. (defvar mh-comp-formfile "components" (#$ . 3945)) #@215 Name of file to be used as a skeleton for replying to messages. Default is "replcomps". If not a complete path name, the file is searched for first in the user's MH directory, then in the system MH lib directory. (defvar mh-repl-formfile "replcomps" (#$ . 4216)) #@46 Invoked in `mh-letter-mode' on a new letter. (defvar mh-letter-mode-hook nil (#$ . 4486)) #@114 Invoked when setting up a letter draft. It is passed three arguments: TO recipients, SUBJECT, and CC recipients. (defvar mh-compose-letter-function nil (#$ . 4583)) #@81 Invoked at the beginning of the \\[mh-send-letter] command. (defvar mh-before-send-letter-hook nil (#$ . 4754)) #@144 Regexp specifying the beginning of the wrapper around a returned letter. This wrapper is generated by the mail system when rejecting a letter. (defvar mh-rejected-letter-start (concat "^ ----- Unsent message follows -----$" "\\|^ ----- Original message follows -----$" "\\|^------- Unsent Draft$" "\\|^---------- Original Message ----------$" "\\|^ --- The unsent message follows ---$" "\\|^ Your message follows:$" "\\|^Content-Description: Returned Content$") (#$ . 4893)) #@172 Regexp of header lines to remove before offering a message as a new draft. Used by the \`\[mh-edit-again]' and `\[mh-extract-rejected-mail]' commands. (defvar mh-new-draft-cleaned-headers "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:" (#$ . 5385)) #@66 Alist of (final-character . field-name) choices for mh-to-field. (defvar mh-to-field-choices (quote (("t" . "To:") ("s" . "Subject:") ("c" . "Cc:") ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:") ("d" . "Dcc:"))) (#$ . 5717)) #@28 Keymap for composing mail. (defvar mh-letter-mode-map (copy-keymap text-mode-map) (#$ . 5947)) #@52 Syntax table used by mh-e while in MH-Letter mode. (defvar mh-letter-mode-syntax-table nil (#$ . 6048)) (byte-code "„Á\n!ÃÄÅ#ˆÁ‡" [mh-letter-mode-syntax-table make-syntax-table text-mode-syntax-table modify-syntax-entry 37 "."] 4) #@203 Compose and send mail with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. See documentation of `\[mh-send]' for more details on composing mail. (defalias 'mh-smail #[nil "À ˆÁÂ!‡" [mh-find-path call-interactively mh-send] 2 (#$ . 6291) nil]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp mh-error-if-no-draft nil current-load-list] 2) #@329 Set up a mail composition draft with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. This function does not prompt the user for any header fields, and thus is suitable for use by programs that want to create a mail buffer. Users should use `\[mh-smail]' to compose mail. (defalias 'mh-smail-batch #[nil "À ˆÁÃĉ‰#)‡" [mh-find-path t mh-error-if-no-draft mh-send ""] 4 (#$ . 6681)]) #@228 Clean-up a draft or a message previously sent and make it resendable. Default is the current message. The variable mh-new-draft-cleaned-headers specifies the headers to remove. See also documentation for `\[mh-send]' function. (defalias 'mh-edit-again #[(msg) " \fƒ& \fšƒ&ÅÆÇ!!É\"ˆÊËÌ\"!ˆÍ ‚.ÎÏÇ!Ð#ÒeÐ#ˆebˆÔ ˆÕÖ Ð‰‰‰‰‰ &\n+‡" [mh-current-folder from-folder current-window-configuration config mh-draft-folder pop-to-buffer find-file-noselect mh-msg-filename msg t rename-buffer format "draft-%d" buffer-name mh-read-draft "clean-up" nil draft mh-clean-msg-header mh-new-draft-cleaned-headers save-buffer mh-compose-and-send-mail ""] 11 (#$ . 7128) (list (mh-get-msg-num t))]) #@251 Extract a letter returned by the mail system and make it resendable. Default is the current message. The variable mh-new-draft-cleaned-headers gives the headers to clean out of the original message. See also documentation for `\[mh-send]' function. (defalias 'mh-extract-rejected-mail #[(msg) "Á ÂÃÄ !Æ# ebˆÊ ÆÌ#ƒ.ÍÆwˆe`|ˆÎeÆ#ˆ‚2ÐÑ!ˆebˆÒ ˆÓÔ ÕÖ!Õ×!ÕØ!Ɖ&\n+‡" [mh-current-folder current-window-configuration mh-read-draft "extraction" mh-msg-filename msg nil draft config from-folder re-search-forward mh-rejected-letter-start t " \n" mh-clean-msg-header mh-new-draft-cleaned-headers message "Does not appear to be a rejected letter." save-buffer mh-compose-and-send-mail "" mh-get-header-field "To:" "From:" "Cc:"] 11 (#$ . 7830) (list (mh-get-msg-num t))]) #@198 Forward a message or message sequence. Defaults to displayed message. If optional prefix argument provided, then prompt for the message sequence. See also documentation for `\[mh-send]' function. (defalias 'mh-forward #[(to cc &optional msg-or-seq) "„ÁÂ! Å ÇÈ \"\nË\n!ƒ\"ÌÍ!ƒ>ÎÏÐ $ˆÑÒ\nÂ#ÓÔÖ$ˆØ ˆ‚DÑÒ\nÙ#Ù‰ebˆÝÞ!ˆßyˆàÙwˆŒ`d}ˆáâ!áã!)ä\"%Óã%\"ˆebˆÝÞ!ˆæyˆç ˆ§ƒ“èéÂ#ˆ‚›èê!éÂ#ˆëÒ\f%,í&\n.‡" [msg-or-seq mh-get-msg-num t mh-current-folder folder current-window-configuration config expand-file-name "draft" mh-user-path draft-name file-exists-p y-or-n-p "The file 'draft' exists. Discard it? " mh-exec-cmd "forw" "-build" mh-read-draft "" mh-insert-fields "To:" to "Cc:" cc save-buffer nil draft orig-subject orig-from re-search-forward "^------- Forwarded Message" 1 " \n" mh-get-header-field "From:" "Subject:" mh-forwarded-letter-subject forw-subject -1 delete-other-windows mh-add-msgs-to-seq forwarded mh-seq-to-msgs mh-compose-and-send-mail mh-note-forw "Forwarded:"] 11 (#$ . 8615) (list (mh-read-address "To: ") (mh-read-address "Cc: ") (if current-prefix-arg (mh-read-seq-default "Forward" t) (mh-get-msg-num t)))]) (defalias 'mh-forwarded-letter-subject #[(from subject) "ÀÁ\n\"ÀÃ\n\"‰ƒ ÆVƒ\nÆ SO‚)\fƒ)\n\fT\nGSO*Ç\n #‡" [string-match "<" from "(" comment addr-start 0 format mh-forward-subject-format subject] 5]) #@219 Compose and send mail in other window with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. See documentation of `\[mh-send]' for more details on composing mail. (defalias 'mh-smail-other-window #[nil "À ˆÁÂ!‡" [mh-find-path call-interactively mh-send-other-window] 2 (#$ . 10010) nil]) #@171 Redistribute a letter. Depending on how your copy of MH was compiled, you may need to change the setting of the variable mh-redist-full-contents. See its documentation. (defalias 'mh-redistribute #[(to cc &optional msg) "„ÁÂ!ˇ" [msg mh-get-msg-num t ((byte-code "Á …\nÄ !Æ#ÉÊ!ˆË\fͱˆÏš„)ÐͱˆÑeÒÆ#ˆÓ ˆÔÕ!ˆ ƒSÖ×ÆÊÆØÙÚÜ\"$&ˆ‚lÖ×ÆÊÆØÙßÄ \"Ü\"$&ˆà !âãäÙå\f#&ˆæ!ˆÔç!*‡" [mh-current-folder mh-read-draft "redistribution" mh-redist-full-contents mh-msg-filename msg nil draft folder mh-goto-header-end 0 "Resent-To: " to "\n" cc "" "Resent-cc: " mh-clean-msg-header "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:" save-buffer message "Redistributing..." call-process "/bin/sh" "-c" format "mhdist=1 mhaltmsg=%s %s -push %s" buffer-file-name expand-file-name mh-send-prog mh-progs "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s" mh-annotate-msg mh-note-dist "-component" "Resent:" "-text" "\"%s %s\"" kill-buffer "Redistributing...done"] 12))] 2 (#$ . 10360) (list (mh-read-address "Redist-To: ") (mh-read-address "Redist-Cc: ") (mh-get-msg-num t))]) #@462 Reply to MESSAGE (default: current message). If optional prefix argument INCLUDEP provided, then include the message in the reply using filter mhl.reply in your MH directory. Prompts for type of addresses to reply to: from sender only, to sender and primary recipients, cc/all sender and all recipients. If the file named by `mh-repl-formfile' exists, it is used as a skeleton for the reply. See also documentation for `\[mh-send]' function. (defalias 'mh-reply #[(message &optional includep) "À\n†\fÃÄÅÆÇ$ Ê  \f ÏÐ!ˆÑÒÓÔÕ;…-×DØš„?ÙšƒCÚ‚]ÛšƒNÜ‚]Ýš„\\Þš…]ß …cá& ˆâãäã%\"Ç#&ç ˆè ˆéê!éë!éì!-./ebˆðñ!ˆ „®ò 3ô\f!ˆ5ƒ¤öp!ˆ÷Žø \"ˆ*ùúÇ#ˆÏû!ˆü&Ù /.-=þ &\n. ‡" ["from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients" minibuffer-help-form mh-reply-default-reply-to completing-read "Reply to whom: " (("from") ("to") ("cc") ("all")) nil t mh-current-folder mh-show-buffer current-window-configuration config show-buffer folder reply-to message "Composing a reply..." mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder" mh-repl-formfile "-form" "from" "" ("-nocc" "all") "to" ("-cc" "to") "cc" "all" ("-cc" "all" "-nocc" "me") includep ("-filter" "mhl.reply") mh-read-draft "reply" expand-file-name mh-user-path draft delete-other-windows save-buffer mh-get-header-field "To:" "Subject:" "Cc:" cc subject to mh-goto-header-end 1 selected-window mh-in-show-buffer-saved-window switch-to-buffer-other-window mh-bury-show-buffer bury-buffer ((select-window mh-in-show-buffer-saved-window)) mh-display-msg mh-add-msgs-to-seq answered "Composing a reply...done" mh-compose-and-send-mail mh-note-repl "Replied:"] 11 (#$ . 11485) (list (mh-get-msg-num t) current-prefix-arg)]) #@364 Compose and send a letter. The file named by `mh-comp-formfile' will be used as the form. Do not call this function from outside mh-e; use \[mh-smail] instead. The letter is composed in mh-letter-mode; see its documentation for more details. If `mh-compose-letter-function' is defined, it is called on the draft and passed three arguments: to, subject, and cc. (defalias 'mh-send #[(to cc subject) "À  ˆÃ\f  $)‡" [current-window-configuration config delete-other-windows mh-send-sub to cc subject] 5 (#$ . 13278) (list (mh-read-address "To: ") (mh-read-address "Cc: ") (read-string "Subject: "))]) #@179 Compose and send a letter in another window. Do not call this function from outside mh-e; use \[mh-smail-other-window] instead. See also documentation for `\[mh-send]' function. (defalias 'mh-send-other-window #[(to cc subject) "À \f Æ $)‡" [t pop-up-windows mh-send-sub to cc subject current-window-configuration] 5 (#$ . 13889) (list (mh-read-address "To: ") (mh-read-address "Cc: ") (read-string "Subject: "))]) (defalias 'mh-send-sub #[(to cc subject config) "ÁÂ!ÅÆ!ˆÇÈ ÊË\f \"‰ !ƒ\" ‚<ÊË\f\"‰ !ƒ5 ‚<ÏÐÑ \"!)Â#ÓÔÖØ&ˆdbˆÅÚ!ˆÛÜ\f ‰&\n+‡" [mh-current-folder mh-get-msg-num nil msg-num folder message "Composing a message..." mh-read-draft "message" components file-exists-p expand-file-name mh-comp-formfile mh-user-path mh-lib error format "Can't find components file \"%s\"" draft mh-insert-fields "To:" to "Subject:" subject "Cc:" cc "Composing a message...done" mh-compose-and-send-mail "" config] 11]) (defalias 'mh-read-draft #[(use initial-contents delete-contents-file) "ƒ  ÅÆÇÈÉ !\"!!ˆÊË̈\f*‚dÍÎ\"ÅÎ!ˆÑ ƒ@ÒÓ!ƒ<ÔÊ!ˆ‚@ÕÖ!ˆØ ˆÙ ˆÚ!ƒcš„cÜ!ˆÝ!ˆ)ƒ›Þ ßU„‰ÒÇà!\"!ƒ…\"ƒ›Õã!‚†äƒ›å ˆÜ!ˆ&ƒ›Ý!ˆçè!ˆƒ¦é ˆê ‡" [mh-draft-folder default-directory mh-new-draft-name draft-file-name orig-default-dir pop-to-buffer generate-new-buffer format "draft-%s" file-name-nondirectory nil (insert-file-contents draft-file-name t) ((file-error)) expand-file-name "draft" mh-user-path draft-name buffer-modified-p y-or-n-p "Draft has been modified; kill anyway? " set-buffer-modified-p error "Draft preserved" buffer-file-name clear-visited-file-modtime unlock-buffer file-exists-p initial-contents insert-file-contents delete-file buffer-size 0 "A draft exists. Use for %s? " use mh-error-if-no-draft "A prior draft exists." t erase-buffer delete-contents-file auto-save-mode 1 save-buffer buffer-name] 6]) (defalias 'mh-new-draft-name #[nil "ŠÀÁ Ä$ˆedS{)‡" [mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new"] 5]) (defalias 'mh-annotate-msg #[(msg buffer note &rest args) "ÀÁ \f %ˆŠÆ !…* qˆ\f9ƒ\"Ç\f T#‚*Ê\f T#)‡" [apply mh-exec-cmd "anno" buffer msg args get-buffer mh-notate-seq note mh-cmd-note mh-notate] 6]) (defalias 'mh-insert-fields #[(&rest name-values) "À\n…0\n@\nA@ Åš„(Æ\f!ƒ!Ç ±ˆ‚(\fÇ È±ˆ\nAA*‚)‡" [t case-fold-search name-values value field-name "" mh-position-on-field " " "\n"] 4]) (defalias 'mh-position-on-field #[(field &optional ignore) "À !…\n ˆÃ‡" [mh-goto-header-field field mh-header-field-end t] 2]) (defalias 'mh-get-header-field #[(field) "À !ƒÂÃwˆ`Å ˆ\f`{)‡Æ‡" [mh-goto-header-field field " " nil start mh-header-field-end ""] 2]) (fset (quote mh-get-field) (quote mh-get-header-field)) (defalias 'mh-goto-header-field #[(field) "ebˆÀŠÁÂ!ˆ`)ÅÆÇ\" À#*‡" [t mh-goto-header-end 0 headers-end case-fold-search re-search-forward format "^%s" field] 4]) (defalias 'mh-header-field-end #[nil "ÀyˆÁÂ!ƒÀyˆ‚ÃÀ!‡" [1 looking-at "^[ ]" backward-char] 2]) (defalias 'mh-goto-header-end #[(arg) "ÀÁ‰#…\n y‡" [re-search-forward "^-*$" nil arg] 4]) (defalias 'mh-read-address #[(prompt) "À !‡" [read-string prompt] 2]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ BÈÉÊË#‡" [boundp mh-sent-from-folder nil current-load-list mh-sent-from-msg mh-send-args mh-annotate-char mh-annotate-field put mh-letter-mode mode-class special] 4) #@1107 Mode for composing letters in mh-e.\ When you have finished composing, type \[mh-send-letter] to send the message using the MH mail handling system. See the documentation for \[mh-edit-mhn] for information on composing MIME messages. \{mh-letter-mode-map} Variables controlling this mode (defaults in parentheses): mh-delete-yanked-msg-window (nil) If non-nil, \[mh-yank-cur-msg] will delete any windows displaying the yanked message. mh-yank-from-start-of-msg (t) If non-nil, \[mh-yank-cur-msg] will include the entire message. If `body', just yank the body (no header). If nil, only the portion of the message following the point will be yanked. If there is a region, this variable is ignored. mh-ins-buf-prefix ("> ") String to insert before each non-blank line of a message as it is inserted in a draft letter. mh-signature-file-name ("~/.signature") File to be inserted into message by \[mh-insert-signature]. Upon invoking mh-letter-mode, text-mode-hook and mh-letter-mode-hook are invoked with no args, if those values are non-nil. (defalias 'mh-letter-mode #[nil "„Á ˆÂÃ!ˆÄ PÂÅ!ˆÄ PÂÆ!ˆÂÇ!ˆÂÈ!ˆÂÉ!ˆÂÊ!ˆÂË!ˆÂÌ!ˆÍ\fÎ!ˆÐÒÓ!ˆÔ!ˆÖ×!ˆØÙ!ƒ]ƒ]ÂÙ!ˆÚØÛ!ƒoƒoÂÛ!ˆÚÖÜ!‡" [mh-user-path mh-find-path make-local-variable paragraph-start "^[ ]*[-_][-_][-_]+$\\|" paragraph-separate mh-send-args mh-annotate-char mh-annotate-field mh-previous-window-config mh-sent-from-folder mh-sent-from-msg mail-header-separator "--------" use-local-map mh-letter-mode-map mh-letter-mode major-mode mh-set-mode-name "MH-Letter" set-syntax-table mh-letter-mode-syntax-table run-hooks text-mode-hook boundp auto-fill-hook mh-auto-fill-for-letter auto-fill-function mh-letter-mode-hook] 2 (#$ . 17280) nil]) (defalias 'mh-auto-fill-for-letter #[nil "À ƒ Áà )‡Ã ‡" [mh-in-header-p " " fill-prefix do-auto-fill] 1]) (defalias 'mh-in-header-p #[nil "Š`ebˆÁÂÃÄ#ˆ`W*‡" [cur-point re-search-forward "^-*$" nil t] 4]) #@273 Move point to the end of a specified header field. The field is indicated by the previous keystroke (the last keystroke of the command) according to the list in the variable mh-to-field-choices. Create the field if it does not exist. Set the mark to point before moving. (defalias 'mh-to-field #[nil "À ˆÁÂÃ\fÅ\"!\"†ÁÃ\fÅ\"\"AÇ Ê ˆË !ƒT`\fÍÎxˆ`\f|ˆ)Ã\fÅ\"Ï=„OŠÐÑ!ˆÒÓ!)„OÔc‚gÕc‚gËÖ!ƒ]Ñyˆ×Ø \"cˆÐÑ!*‡" [expand-abbrev assoc char-to-string logior last-input-char 96 mh-to-field-choices t case-fold-search target push-mark mh-position-on-field eol " " nil 115 backward-char 1 looking-at "[:,]" ", " " " "To:" format "%s \n"] 5 (#$ . 19268) nil]) #@126 Insert an Fcc: FOLDER field in the current message. Prompt for the field name with a completion list of the current folders. (defalias 'mh-to-fcc #[(&optional folder) "„Á ƒŠebˆ )†ÄÅ#ÆÈ ˆŠÉ ˆÊ!ƒ/ËÌO‚0c*‡" [folder mh-prompt-for-folder "Fcc" mh-default-folder-for-message-function "" t 6 last-input-char expand-abbrev mh-to-field mh-folder-name-p 1 nil] 4 (#$ . 19937) nil]) #@71 Insert the file named by mh-signature-file-name at the current point. (defalias 'mh-insert-signature #[nil "À !ˆÂ ‡" [insert-file-contents mh-signature-file-name force-mode-line-update] 2 (#$ . 20332) nil]) #@76 Verify recipients of the current letter, showing expansion of any aliases. (defalias 'mh-check-whom #[nil " ˆÃÄ!ˆÅ ÇÈ!ˆ ƒÊp!ˆËŽÊp!ˆÌ ˆÍÎÏ #ˆ*ÃÐ!)‡" [buffer-file-name file-name save-buffer message "Checking recipients..." selected-window mh-in-show-buffer-saved-window switch-to-buffer-other-window "*Recipients*" mh-bury-show-buffer bury-buffer ((select-window mh-in-show-buffer-saved-window)) erase-buffer mh-exec-cmd-output "whom" t "Checking recipients...done"] 4 (#$ . 20545) nil]) (defalias 'mh-compose-and-send-mail #[(draft send-args sent-from-folder sent-from-msg to subject cc annotate-char annotate-field config) "À !ˆÂ ˆ   \n \f ÏCÑÒ!…_…_‰<ƒU@Ô=„U…^@#ˆA‰‚>#)‡" [pop-to-buffer draft mh-letter-mode sent-from-folder mh-sent-from-folder sent-from-msg mh-sent-from-msg send-args mh-send-args annotate-char mh-annotate-char annotate-field mh-annotate-field config mh-previous-window-config "{%b}" mode-line-buffer-identification boundp mh-compose-letter-function value lambda to subject cc] 5]) #@159 Send the draft letter in the current buffer. If optional prefix argument is provided, monitor delivery. Run mh-before-send-letter-hook before doing anything. (defalias 'mh-send-letter #[(&optional arg) "ÀÁ!ˆÂ ˆÃÄ!ˆp  \nƒ=ËÌ!ˆÍ ˆÎÐÑÒÓ&ˆdbˆÕÖ!ˆ qˆ‚H×ÓØ%ˆƒdÚÝßàáâã!âä!#&ˆ\nƒoåæ!ƒ~ç !ˆƒ~è!ˆ\nƒ‰Ãé!‚ŒÃê!+‡" [run-hooks mh-before-send-letter-hook save-buffer message "Sending..." buffer-file-name mh-previous-window-config config file-name draft-buffer arg pop-to-buffer "MH mail delivery" erase-buffer mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" "-nodraftfolder" mh-send-args recenter -1 mh-exec-cmd-daemon "-noverbose" mh-annotate-char mh-annotate-msg mh-sent-from-msg mh-sent-from-folder "-component" mh-annotate-field "-text" format "\"%s %s\"" mh-get-header-field "To:" "Cc:" y-or-n-p "Kill draft buffer? " kill-buffer set-window-configuration "Sending...done" "Sending...backgrounded"] 12 (#$ . 21613) "P"]) #@323 Insert a message into the current letter. Removes the message's headers using mh-invisible-headers. Prefixes each non-blank line with mh-ins-buf-prefix. Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do not indent and do not delete headers. Leaves the mark before the letter and point after it. (defalias 'mh-insert-letter #[(folder message verbatim) "Œ``}ˆe šƒÃ\f!ÅÆÇÈÉ Ê !\"$ˆ\f?…4Í#ˆÐ!ˆÑ!*‡" [start message "" int-to-string mh-sent-from-msg mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" expand-file-name mh-expand-file-name folder verbatim mh-clean-msg-header mh-invisible-headers mh-visible-headers set-mark mh-insert-prefix-string mh-ins-buf-prefix] 8 (#$ . 22584) (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) (read-input (format "Message number%s: " (if mh-sent-from-msg (format " [%d]" mh-sent-from-msg) ""))) current-prefix-arg)]) #@500 Insert the current message into the draft buffer. Prefix each non-blank line in the message with the string in `mh-ins-buf-prefix'. If a region is set in the message's buffer, then only the region will be inserted. Otherwise, the entire message will be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable is nil, the portion of the message following the point will be yanked. If `mh-delete-yanked-msg-window' is non-nil, any window displaying the yanked message will be deleted. (defalias 'mh-yank-cur-msg #[nil "ƒr ƒr`pqˆ\fƒÅ!ˆqˆÇÈ!ƒ'‚)É ƒ4Ê Ë {‚X\fÍ=ƒJŠebˆÎÏ!ˆ`)d{‚X\fƒUed{‚X`d{\nqˆŒ ‰}ˆÑ ˆcˆÒ!ˆÔc,‡ÕÖ!‡" [mh-sent-from-folder mh-sent-from-msg to-buffer to-point mh-delete-yanked-msg-window delete-windows-on mh-show-buffer boundp mark-active mark region-beginning region-end mh-yank-from-start-of-msg body mh-goto-header-end 1 mh-ins-str push-mark mh-insert-prefix-string mh-ins-buf-prefix "\n" error "There is no current message"] 2 (#$ . 23500) nil]) (defalias 'mh-insert-prefix-string #[(mh-ins-string) "Àd!ˆebˆ ƒÂÁ!‡ ƒÂÃ!‡n„ÄyˆÅ`Ç W…2cˆÄyˆ‚!)‡" [set-mark mail-citation-hook run-hooks mh-yank-hooks 1 nil zmacs-regions mark mh-ins-string] 2]) #@130 Kill the draft message file and the draft message buffer. Use \[kill-buffer] if you don't want to delete the draft message file. (defalias 'mh-fully-kill-draft #[nil "ÀÁ!ƒ(\nÄ !ƒÆ !ˆÇÈ!ˆÉÊ !ˆËÌ!ˆ …&Í !)‡ÎÏ!‡" [y-or-n-p "Kill draft message? " mh-previous-window-config config file-exists-p buffer-file-name delete-file set-buffer-modified-p nil kill-buffer buffer-name message "" set-window-configuration error "Message not killed"] 2 (#$ . 24717) nil]) (byte-code "À ÂÃ#ˆÀ ÄÃ#ˆÀ ÅÃ#ˆÀ ÆÇ#ˆÀ ÈÃ#ˆÀ ÉÃ#ˆÀ ÊÃ#ˆÀ ËÃ#ˆÀ ÌÃ#ˆÀ ÍÃ#ˆÀ ÎÇ#ˆÀ ÏÃ#ˆÀ ÐÃ#ˆÀ ÑÃ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ ÖÕ#ˆÀ ×Ø#ˆÀ ÙØ#ˆÀ ÚÛ#ˆÀ ÜÝ#ˆÀ Þß#ˆÀ àá#ˆÀ âã#ˆÀ äå#ˆÀ æç#ˆÀ èé#ˆÀ êë#‡" [define-key mh-letter-mode-map "" mh-to-field "" "" "" mh-to-fcc "" "" "" "b" "c" "d" "f" "r" "s" "t" " " mh-insert-letter "" mh-fully-kill-draft "" "" mh-insert-signature "" "" mh-check-whom "" mh-yank-cur-msg "" mh-send-letter " " mh-mhn-compose-forw " " mh-mhn-compose-anon-ftp " " mh-mhn-compose-external-compressed-tar " " mh-mhn-compose-insertion "" mh-edit-mhn " " mh-revert-mhn-edit] 4) #@148 Add a directive to insert a MIME message part from a file. This is the typical way to insert non-text parts in a message. See also \[mh-edit-mhn]. (autoload (quote mh-mhn-compose-insertion) "mh-mime" '(#$ . 25821) t) #@196 Add a directive for a MIME anonymous ftp external body part. This directive tells MH to include a reference to a message/external-body part retrievable by anonymous FTP. See also \[mh-edit-mhn]. (autoload (quote mh-mhn-compose-anon-ftp) "mh-mime" '(#$ . 26045) t) #@225 Add a directive to include a MIME reference to a compressed tar file. The file should be available via anonymous ftp. This directive tells MH to include a reference to a message/external-body part. See also \[mh-edit-mhn]. (autoload (quote mh-mhn-compose-external-compressed-tar) "mh-mime" '(#$ . 26316) t) #@160 Add a forw directive to this message, to forward a message with MIME. This directive tells MH to include another message in this one. See also \[mh-edit-mhn]. (autoload (quote mh-mhn-compose-forw) "mh-mime" '(#$ . 26631) t) #@771 Format the current draft for MIME, expanding any mhn directives. Process the current draft with the mhn program, which, using directives already inserted in the draft, fills in all the MIME components and header fields. This step should be done last just before sending the message. The mhn program is part of MH version 6.8 or later. The `\[mh-revert-mhn-edit]' command undoes this command. For assistance with creating mhn directives to insert various types of components in a message, see \[mh-mhn-compose-insertion] (generic insertion from a file), \[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp), \[mh-mhn-compose-external-compressed-tar] (reference to compressed tar file via anonymous ftp), and \[mh-mhn-compose-forw] (forward message). (autoload (quote mh-edit-mhn) "mh-mime" '(#$ . 26862) t) #@130 Undoes the effect of \[mh-edit-mhn] by reverting to the backup file. Optional non-nil argument means don't ask for confirmation. (autoload (quote mh-revert-mhn-edit) "mh-mime" '(#$ . 27696) t) emacs-19.30/lisp/mh-e.elc100666 13437 1 112147 6046535520 13577 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 20:00:39 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mh-e.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`mh-e.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ\nBÁ‡" ["Time-stamp: <95/10/30 19:14:06 gildea>" mh-e-time-stamp current-load-list] 2) #@42 Version numbers of this version of mh-e. (defconst mh-e-version "5.0.2" (#$ . 576)) (byte-code "ÀÁ\nBÃÄ!ˆÅÆ!‡" ["$Id: mh-e.el,v 1.9 1995/11/03 02:28:26 kwzh Exp $" mh-e-RCS-id current-load-list provide mh-e require mh-utils] 2) #@44 Invoked in MH-Folder mode on a new folder. (defvar mh-folder-mode-hook nil (#$ . 812)) #@92 Invoked by \`\[mh-inc-folder]' after incorporating mail into a folder. (defvar mh-inc-folder-hook nil (#$ . 905)) #@66 Invoked after \`\[mh-show]' shows a message. (defvar mh-show-hook nil (#$ . 1045)) #@42 Invoked in MH-Show mode on each message. (defvar mh-show-mode-hook nil (#$ . 1154)) #@50 Invoked after marking each message for deletion. (defvar mh-delete-msg-hook nil (#$ . 1244)) #@50 Invoked after marking each message for refiling. (defvar mh-refile-msg-hook nil (#$ . 1343)) #@93 Invoked by \`\[mh-quit]' before quitting mh-e. See also mh-quit-hook. (defvar mh-before-quit-hook nil (#$ . 1442)) #@93 Invoked after \`\[mh-quit]' quits mh-e. See also mh-before-quit-hook. (defvar mh-quit-hook nil (#$ . 1585)) #@283 *Format for Unix command that prints a message. The string should be a Unix command line, with the string '%s' where the job's name (folder and message number) should appear. The formatted message text is piped to this command when you type \`\[mh-print-msg]'. (defvar mh-lpr-command-format "lpr -J '%s'" (#$ . -1722)) #@275 *Program to run to generate one-line-per-message listing of a folder. Normally "scan" or a file name linked to scan. This file is searched for relative to the mh-progs directory unless it is an absolute pathname. Automatically becomes buffer-local when set in any fashion. (defvar mh-scan-prog "scan" (#$ . -2069)) (make-variable-buffer-local (quote mh-scan-prog)) #@169 *Program to run to incorporate new mail into a folder. Normally "inc". This file is searched for relative to the mh-progs directory unless it is an absolute pathname. (defvar mh-inc-prog "inc" (#$ . -2442)) #@152 *Print messages in the background if non-nil. WARNING: do not delete the messages until printing is finished; otherwise, your output may be truncated. (defvar mh-print-background nil (#$ . -2657)) #@74 *Recenter summary window when the show window is toggled off if non-nil. (defvar mh-recenter-summary-p nil (#$ . -2860)) #@150 *Non-nil means do not prompt for confirmation before some mh-e commands. Affects non-recoverable commands such as mh-kill-folder and mh-undo-folder. (defvar mh-do-not-confirm nil (#$ . -2988)) #@124 *Last directory used by \[mh-store-msg]; default for next store. A directory name string, or nil to use current directory. (defvar mh-store-default-directory nil (#$ . -3188)) #@61 Regexp specifiying the scan lines that are 'good' messages. (defvar mh-good-msg-regexp "^....[^D^]" (#$ . 3370)) #@49 Regexp matching scan lines of deleted messages. (defvar mh-deleted-msg-regexp "^....D" (#$ . 3489)) #@49 Regexp matching scan lines of refiled messages. (defvar mh-refiled-msg-regexp "^....\\^" (#$ . 3595)) #@63 Regexp matching scan lines for messages (not error messages). (defvar mh-valid-scan-line "^ *[0-9]" (#$ . 3703)) #@48 Regexp matching scan line for the cur message. (defvar mh-cur-scan-msg-regexp "^....\\+" (#$ . 3822)) #@66 String whose first character is used to notate deleted messages. (defvar mh-note-deleted "D" (#$ . 3930)) #@66 String whose first character is used to notate refiled messages. (defvar mh-note-refiled "^" (#$ . 4042)) #@69 String whose first character is used to notate the current message. (defvar mh-note-cur "+" (#$ . 4154)) #@119 Annotation when displaying part of a folder. The string is displayed after the folder's name. NIL for no annotation. (defvar mh-partial-folder-mode-line-annotation "select" (#$ . 4266)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp mh-last-destination nil current-load-list] 2) #@24 Keymap for MH folders. (defvar mh-folder-mode-map (make-keymap) (#$ . 4541)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÆÅ BÀÇ!„-ÂÇ BÀÈ!„:ÂÈ BÀÉ!„GÂ É BÀÊ!„TÂ\nÊ B‡" [boundp mh-delete-list nil current-load-list mh-refile-list mh-next-direction forward mh-narrowed-to-seq mh-first-msg-num mh-last-msg-num mh-mode-line-annotation] 2) (defalias 'mh-mapc #[(func list) "… @!ˆA‰„‡" [list func nil] 3]) #@155 Inc(orporate) new mail with MH, or, with arg, scan an MH mail folder. This function is an entry point to mh-e, the Emacs front end to the MH mail system. (defalias 'mh-rmail #[(&optional arg) "À ˆ ƒ ÂÃ!‡Ä ‡" [mh-find-path arg call-interactively mh-visit-folder mh-inc-folder] 2 (#$ . 4970) "P"]) #@132 Compose and send mail with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. (defalias 'mh-smail #[nil "À ˆÁÂ!ˆÃÄ!‡" [mh-find-path require mh-comp call-interactively mh-send] 2 (#$ . 5274) nil]) #@148 Compose and send mail in other window with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. (defalias 'mh-smail-other-window #[nil "À ˆÁÂ!ˆÃÄ!‡" [mh-find-path require mh-comp call-interactively mh-send-other-window] 2 (#$ . 5530) nil]) #@187 Mark the specified MESSAGE(s) for subsequent deletion and move to the next. Default is the displayed message. If optional prefix argument is given then prompt for the message sequence. (defalias 'mh-delete-msg #[(msg-or-seq) "À !ˆÂ ‡" [mh-delete-msg-no-motion msg-or-seq mh-next-msg] 2 (#$ . 5828) (list (if current-prefix-arg (mh-read-seq-default "Delete" t) (mh-get-msg-num t)))]) #@170 Mark the specified MESSAGE(s) for subsequent deletion. Default is the displayed message. If optional prefix argument is provided, then prompt for the message sequence. (defalias 'mh-delete-msg-no-motion #[(msg-or-seq) "§ƒ Á!‡ÂÁ\"‡" [msg-or-seq mh-delete-a-msg mh-map-to-seq-msgs] 3 (#$ . 6219) (list (if current-prefix-arg (mh-read-seq-default "Delete" t) (mh-get-msg-num t)))]) #@49 Process outstanding delete and refile requests. (defalias 'mh-execute-commands #[nil "ƒÁ ˆÂ !ˆÄ ˆÅ ˆÆ ˆÇ‡" [mh-narrowed-to-seq mh-widen mh-process-commands mh-current-folder mh-set-scan-mode mh-goto-cur-msg mh-make-folder-mode-line t] 2 (#$ . 6609) nil]) #@28 Move to the first message. (defalias 'mh-first-msg #[nil "ebˆm?…À !?…Âyˆ‚‡" [looking-at mh-valid-scan-line 1] 2 (#$ . 6873) nil]) #@311 Show the current message with all its headers. Displays headers that might have been suppressed by setting the variables `mh-clean-message-header' or `mhl-formfile', or by the fallback behavior of scrolling uninteresting headers off the top of the window. Type "\[mh-show]" to show the message normally again. (defalias 'mh-header-display #[nil "„ „\f\nƒà ˆÄ‰ÅÄ!ˆÆ È !ˆ\nƒ)Ëp!ˆÌŽebˆÍÎ!ˆ*ω*‡" [mh-showing-with-headers mhl-formfile mh-clean-message-header mh-invalidate-show-buffer nil mh-show-msg selected-window mh-in-show-buffer-saved-window switch-to-buffer-other-window mh-show-buffer mh-bury-show-buffer bury-buffer ((select-window mh-in-show-buffer-saved-window)) mh-recenter 0 t] 2 (#$ . 7016) nil]) #@372 Inc(orporate)s new mail into the Inbox folder. Optional prefix argument specifies an alternate maildrop from the default. If the prefix argument is given, incorporates mail into the current folder, otherwise uses the folder named by `mh-inbox'. Runs `mh-inc-folder-hook' after incorporating new mail. Do not call this function from outside mh-e; use \[mh-rmail] instead. (defalias 'mh-inc-folder #[(&optional maildrop-name) "À \n„&Ã\f!„Å\f!ˆ ‚&pÃ\f!=„&Ç\f!ˆ )È\n!ˆÉÊ!‡" [current-window-configuration config maildrop-name get-buffer mh-inbox mh-make-folder mh-previous-window-config switch-to-buffer mh-get-new-mail run-hooks mh-inc-folder-hook] 3 (#$ . 7744) (list (if current-prefix-arg (expand-file-name (read-file-name "inc mail from file: " mh-user-path))))]) #@27 Move to the last message. (defalias 'mh-last-msg #[nil "dbˆo?…ÀÁ!…Âyˆ‚‡" [looking-at "^$" -1] 2 (#$ . 8524) nil]) #@51 Move to the NTH next undeleted message in window. (defalias 'mh-next-undeleted-msg #[(&optional arg) "ÀÂyˆÃ\fÅÆ$ƒÆyˆÈ ‡ÉyˆÊ !…#Ì !‡" [forward mh-next-direction 1 re-search-forward mh-good-msg-regexp nil 0 arg mh-maybe-show -1 get-buffer mh-show-buffer delete-windows-on] 5 (#$ . 8650) "p"]) #@133 Refile MESSAGE(s) (default: displayed message) into FOLDER. If optional prefix argument provided, then prompt for message sequence. (defalias 'mh-refile-msg #[(msg-or-seq folder) "À B §ƒÄ \"ˆ‚ÅÄ #ˆÆ ‡" [refile folder mh-last-destination msg-or-seq mh-refile-a-msg mh-map-to-seq-msgs mh-next-msg] 4 (#$ . 8956) (list (if current-prefix-arg (mh-read-seq-default "Refile" t) (mh-get-msg-num t)) (intern (mh-prompt-for-folder "Destination" (or (and mh-default-folder-for-message-function (let ((refile-file (mh-msg-filename (mh-get-msg-num t)))) (save-excursion (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) (insert-file-contents refile-file) (let ((buffer-file-name refile-file)) (funcall mh-default-folder-for-message-function))))) (and (eq (quote refile) (car mh-last-destination)) (symbol-name (cdr mh-last-destination))) "") t)))]) #@171 Re-execute the last refile or write command on the given MESSAGE. Default is the displayed message. Use the same folder or file as the previous refile or write command. (defalias 'mh-refile-or-write-again #[(message) "„ÁÂ!ˆ@Ã=ƒÄ A\"ˆÅÆA\"ˆ‚+ÇÈ A#ˆÅÉA\"ˆÊ ‡" [mh-last-destination error "No previous refile or write" refile mh-refile-a-msg message "Destination folder: %s" apply mh-write-msg-to-file "Destination: %s" mh-next-msg] 4 (#$ . 9820) (list (mh-get-msg-num t))]) #@161 Quit the current mh-e folder. Start by running mh-before-quit-hook. Restore the previous window configuration, if one exists. Finish by running mh-quit-hook. (defalias 'mh-quit #[nil "ÀÁ!ˆÂ ˆÃ ˆÄp!ˆÅ!ƒÄ!ˆƒ$È!ˆÀÉ!‡" [run-hooks mh-before-quit-hook mh-update-sequences mh-invalidate-show-buffer bury-buffer get-buffer mh-show-buffer mh-previous-window-config set-window-configuration mh-quit-hook] 2 (#$ . 10310) nil]) #@101 Page the displayed message forwards. Scrolls ARG lines or a full screen if no argument is supplied. (defalias 'mh-page-msg #[(&optional arg) "À !‡" [scroll-other-window arg] 2 (#$ . 10746) "P"]) #@102 Page the displayed message backwards. Scrolls ARG lines or a full screen if no argument is supplied. (defalias 'mh-previous-page #[(&optional arg) "À  !ˆ\fƒÅp!ˆÆŽÇ!*‡" [selected-window mh-in-show-buffer-saved-window switch-to-buffer-other-window mh-show-buffer mh-bury-show-buffer bury-buffer ((select-window mh-in-show-buffer-saved-window)) scroll-down arg] 2 (#$ . 10948) "P"]) #@55 Move to the NTH previous undeleted message in window. (defalias 'mh-previous-undeleted-msg #[(&optional arg) "ÀÂyˆÃ\fÅÂ$ƒÇ ‡È !…Ê !‡" [backward mh-next-direction 0 re-search-backward mh-good-msg-regexp nil arg mh-maybe-show get-buffer mh-show-buffer delete-windows-on] 5 (#$ . 11340) "p"]) #@192 Rescan a folder after optionally processing the outstanding commands. If optional prefix argument is provided, prompt for the range of messages to display. Otherwise show the entire folder. (defalias 'mh-rescan-folder #[(&optional range) "À \f† Å\"‡" [forward mh-next-direction mh-scan-folder mh-current-folder range "all"] 3 (#$ . 11646) (list (if current-prefix-arg (mh-read-msg-range "Range to scan [all]? ") nil))]) #@169 Append MESSAGE to the end of a FILE. If NO-HEADERS (prefix argument) is provided, write only the message body. Otherwise send the entire message including the headers. (defalias 'mh-write-msg-to-file #[(msg file no-headers) "À ! !Æ …ÇEŠÉ\n!qˆË ˆÌ !ˆebˆƒ-ÍÎ!ˆÏ`d\f#+‡" [mh-msg-filename msg mh-expand-file-name file output-file msg-file-to-output write no-headers mh-last-destination get-buffer-create mh-temp-buffer erase-buffer insert-file-contents search-forward "\n\n" append-to-file] 4 (#$ . 12077) (list (mh-get-msg-num t) (let ((default-dir (if (eq (quote write) (car mh-last-destination)) (file-name-directory (car (cdr mh-last-destination))) default-directory))) (read-file-name (format "Save message%s in file: " (if current-prefix-arg " body" "")) default-dir (if (eq (quote write) (car mh-last-destination)) (car (cdr mh-last-destination)) (expand-file-name "mail.out" default-dir)))) current-prefix-arg)]) #@63 Toggle the scanning mode/showing mode of displaying messages. (defalias 'mh-toggle-showing #[nil "ƒÁ ‡Â ‡" [mh-showing mh-set-scan-mode mh-show] 1 (#$ . 13013) nil]) #@180 Undo the pending deletion or refile of the specified MESSAGE(s). Default is the displayed message. If optional prefix argument is provided, then prompt for the message sequence. (defalias 'mh-undo #[(msg-or-seq) "§ƒe`ÂyˆÃ\f!„Bà !„BÇ=ƒ!o„BÈ=ƒ1ŠÉyˆm)„BÇ=ƒ<Ê‚=Ëyˆ‚\nÃ\f!„Nà !ƒZÌÍÎ!!ˆÏ ˆ‚a bˆÐÑ!ˆ)‚jÒÌ\"ˆÓÔ\"ˆÖ ?…y×É!‡" [msg-or-seq original-position 0 looking-at mh-deleted-msg-regexp mh-refiled-msg-regexp mh-next-direction forward backward nil -1 1 mh-undo-msg mh-get-msg-num t mh-maybe-show error "Nothing to undo" mh-map-to-seq-msgs mh-mapc #[(elt) "À !?…  \"‰‡" [mh-seq-to-msgs elt delq mh-refile-list] 3] mh-refile-list mh-outstanding-commands-p mh-set-folder-modified-p] 3 (#$ . 13189) (list (if current-prefix-arg (mh-read-seq-default "Undo" t) (mh-get-msg-num t)))]) #@73 Display version information about mh-e and the MH mail handling system. (defalias 'mh-version #[nil "À ˆÁ\n!qˆÃ ˆÄ ÆÈ ÊË\f!ͱ ˆÎÏЈÑÒÓ\"Õ±ˆ`×ØÙˆbˆÚÛÎÜ#ˆÝyˆ`|ˆebˆ)Þ\n!‡" [mh-find-progs get-buffer-create mh-temp-buffer erase-buffer " mh-e info:\n\nversion: " mh-e-version "\n" mh-e-time-stamp "\nEmacs: " emacs-version " on " symbol-name system-type " " nil (call-process "uname" nil t nil "-a") ((file-error)) "\n\n MH info:\n\n" expand-file-name "inc" mh-progs ":\n" help-start err-data (mh-exec-cmd-output "inc" nil "-help") ((file-error (byte-code "ÀÁ\nAÃ#c‡" [mapconcat concat err-data ": "] 4))) search-forward "version: " t 0 display-buffer] 9 (#$ . 13998) nil]) #@115 Visit FOLDER and display RANGE of messages. Do not call this function from outside mh-e; see \[mh-rmail] instead. (defalias 'mh-visit-folder #[(folder &optional range) "À  \f†\nÅ\"ˆ )LJ" [current-window-configuration config mh-scan-folder folder range "all" mh-previous-window-config nil] 3 (#$ . 14690) (list (mh-prompt-for-folder "Visit" mh-inbox t) (mh-read-msg-range "Range [all]? "))]) #@67 The "b" key is obsolescent; will assume you want "\[mh-quit]" ... (defalias 'mh-compat-quit #[nil "ÀÁ !\"ˆÄÅ!ˆÆÇ!‡" [message "%s" documentation this-command sit-for 1 call-interactively mh-quit] 4 (#$ . 15092) nil]) #@135 Update MH's Unseen sequence and current folder and message. Flush mh-e's state out to MH. The message at the cursor becomes current. (defalias 'mh-update-sequences #[nil "À ÁÂ! ƒ4ÅÆ!È ˆ C¡ˆÉÆ C\"ˆÊyˆË\f!…0ÍÂ#)‚A\f†AŠÐÑÒÔ$)*‡" [mh-update-unseen mh-get-msg-num nil new-cur folder-set mh-find-seq cur seq-entry mh-remove-cur-notation mh-define-sequence 0 looking-at mh-good-msg-regexp mh-notate mh-note-cur mh-cmd-note mh-exec-cmd-quiet t "folder" mh-current-folder "-fast"] 5 (#$ . 15316) nil]) (defalias 'mh-delete-a-msg #[(msg) "ŠÀ ÂÃ#ˆÄ !ƒÆÇ \"ˆÄ!?…5ÉÃ!ˆ \nB\nË ÌÃ#ˆÍ #ˆÐÑ!)‡" [mh-goto-msg msg nil t looking-at mh-refiled-msg-regexp error "Message %d is refiled. Undo refile before deleting." mh-deleted-msg-regexp mh-set-folder-modified-p mh-delete-list mh-add-msgs-to-seq deleted mh-notate mh-note-deleted mh-cmd-note run-hooks mh-delete-msg-hook] 4]) (defalias 'mh-refile-a-msg #[(msg destination) "ŠÀ ÂÃ#ˆÄ !ƒÆÇ \"‚lÄ!ƒ>ÉÊË \f#!ƒ8ÍÎÏÃ!ÐÑÓ\f!&‚lÔÕ!‚lÖÃ!ˆ\f>„Q\fB Ø\f!>„aÙ \fÃ#ˆÚ #ˆÝÞ!)‡" [mh-goto-msg msg nil t looking-at mh-deleted-msg-regexp error "Message %d is deleted. Undo delete before moving." mh-refiled-msg-regexp y-or-n-p format "Message %d already refiled. Copy to %s as well? " destination mh-exec-cmd "refile" mh-get-msg-num "-link" "-src" mh-current-folder symbol-name message "Message not copied." mh-set-folder-modified-p mh-refile-list mh-seq-to-msgs mh-add-msgs-to-seq mh-notate mh-note-refiled mh-cmd-note run-hooks mh-refile-msg-hook] 8]) (defalias 'mh-next-msg #[nil "Á=ƒ\nÂÃ!‡ÄÃ!‡" [mh-next-direction forward mh-next-undeleted-msg 1 mh-previous-undeleted-msg] 2]) (defalias 'mh-set-scan-mode #[nil "À !ƒ\n !ˆÃÅ ˆ…ÇÃ!‡" [get-buffer mh-show-buffer delete-windows-on nil mh-showing force-mode-line-update mh-recenter-summary-p mh-recenter] 2]) (defalias 'mh-undo-msg #[(msg) " >ƒÂ \"ÃÄÅ#ˆ‚ÆÇ\"ˆÉÊ #‡" [msg mh-delete-list delq mh-delete-msg-from-seq deleted t mh-mapc #[(dest) "À \nÃ#‡" [mh-delete-msg-from-seq msg dest t] 4] mh-refile-list mh-notate 32 mh-cmd-note] 4]) (defalias 'mh-make-folder #[(name) "À !ˆÂÄ ˆÅÆ ˆÇÂ!ˆ Ê ‡" [switch-to-buffer name nil buffer-read-only erase-buffer t mh-folder-mode mh-set-folder-modified-p mh-folder-filename buffer-file-name mh-make-folder-mode-line] 2]) (put (quote mh-folder-mode) (quote mode-class) (quote special)) #@3285 Major mh-e mode for "editing" an MH folder scan listing.\ You can show the message the cursor is pointing to, and step through the messages. Messages can be marked for deletion or refiling into another folder; these commands are executed all at once with a separate command. A prefix argument (\[universal-argument]) to delete, refile, list, or undo applies the action to a message sequence. Here is a list of the standard keys for mh-e commands, grouped by function. This list is purposefully not customized; mh-e has a long history, and many alternate key bindings as a result. This list is to encourage users to use standard keys so the other keys can perhaps someday be put to new uses. t toggle show or scan-only mode RET show message, or back to top if already showing SPC page message forward DEL page message back n next message p previous message g go to message by number d mark for deletion o, ^ mark for output (refile) to another folder ? show folder of pending refile u undo delete or refile marking x execute marked deletes and refiles i incorporate new mail m mail a new message r reply to a message f forward a message q quit mh-e M-f visit new folder M-r rescan this folder Here are all the commands with their current binding, listed in key order: \{mh-folder-mode-map} Variables controlling mh-e operation are (defaults in parentheses): mh-recursive-folders (nil) Non-nil means commands which operate on folders do so recursively. mh-bury-show-buffer (t) Non-nil means that the buffer used to display message is buried. It will never be offered as the default other buffer. mh-clean-message-header (nil) Non-nil means remove header lines matching the regular expression specified in mh-invisible-headers from messages. mh-visible-headers (nil) If non-nil, it contains a regexp specifying the headers that are shown in a message if mh-clean-message-header is non-nil. Setting this variable overrides mh-invisible-headers. mh-do-not-confirm (nil) Non-nil means do not prompt for confirmation before executing some non-recoverable commands such as mh-kill-folder and mh-undo-folder. mhl-formfile (nil) Name of format file to be used by mhl to show messages. A value of T means use the default format file. Nil means don't use mhl to format messages. mh-lpr-command-format ("lpr -p -J '%s'") Format for command used to print a message on a system printer. mh-scan-prog ("scan") Program to run to generate one-line-per-message listing of a folder. Normally "scan" or a file name linked to scan. This file is searched for relative to the mh-progs directory unless it is an absolute pathname. Automatically becomes buffer-local when set in any fashion. mh-print-background (nil) Print messages in the background if non-nil. WARNING: do not delete the messages until printing is finished; otherwise, your output may be truncated. mh-recenter-summary-p (nil) If non-nil, then the scan listing is recentered when the window displaying a messages is toggled off. mh-summary-height (4) Number of lines in the summary window including the mode line. The value of mh-folder-mode-hook is called when a new folder is set up. (defalias 'mh-folder-mode #[nil "À ˆÁ\n!ˆÃÅÆ!ˆÇÈÉ ÊËÌÉ \"ÍÎÏÉ !!ÐÑÒÑÓÑÔÑÕÑÖ×ØÑÙÑÚÑÛÑÜÑÝÑ&ˆÞàá!ˆÞ\"ãä!ƒOå$‚Væç!ˆè'æé!ˆê)Ð+ž„jì+B+íî!‡" [kill-all-local-variables use-local-map mh-folder-mode-map mh-folder-mode major-mode mh-set-mode-name "MH-Folder" mh-make-local-vars mh-current-folder buffer-name mh-show-buffer format "show-%s" mh-folder-filename file-name-as-directory mh-expand-file-name mh-showing nil mh-delete-list mh-refile-list mh-seq-list mh-seen-list mh-next-direction forward mh-narrowed-to-seq mh-first-msg-num mh-last-msg-num mh-msg-count mh-mode-line-annotation mh-previous-window-config t truncate-lines auto-save-mode -1 buffer-offer-save boundp local-write-file-hooks (mh-execute-commands) make-local-variable write-file-hooks (mh-execute-commands) revert-buffer-function mh-undo-folder minor-mode-alist (mh-showing " Show") run-hooks mh-folder-mode-hook] 31 (#$ . 17693)]) (defalias 'mh-make-local-vars #[(&rest pairs) "…Á@!ˆ@A@LˆAA‰„‡" [pairs make-variable-buffer-local nil] 3]) (defalias 'mh-scan-folder #[(folder range) "À !„  !ˆ‚à !ˆÄ !ˆÅ!ˆÇ ÈUƒ;Éšƒ0ÊË \"ˆ‚7ÊÌ #ˆÍÎ!ˆÏ ‡" [get-buffer folder mh-make-folder mh-process-or-undo-commands switch-to-buffer mh-regenerate-headers range buffer-size 0 "all" message "Folder %s is empty" "No messages in %s, range %s" sit-for 5 mh-goto-cur-msg] 4]) (defalias 'mh-regenerate-headers #[(range &optional update) "ÁÄÅ \"ˆÆ Á‰ \nƒdbˆ‚!Ë ˆ`Ì ÁÎÏÐÑ &ˆ\nbˆÓÔ!ƒCÕ!ˆ‚NÓ×!„NÕ!ˆØ Á\"Ú ˆ\n„hÛš?…fÞ ˆß !ˆ+ßÁ!ˆÄà \"*‡" [mh-current-folder nil scan-start folder message "Scanning %s..." buffer-modified-p buffer-file-name buffer-read-only mh-folder-updating-mod-flag update erase-buffer mh-exec-cmd-output mh-scan-prog "-noclear" "-noheader" "-width" window-width range looking-at "scan: no messages in" keep-lines mh-valid-scan-line "scan: " mh-read-folder-sequences mh-seq-list mh-notate-user-sequences "all" mh-partial-folder-mode-line-annotation mh-mode-line-annotation mh-make-folder-mode-line mh-set-folder-modified-p "Scanning %s...done"] 9]) (defalias 'mh-get-new-mail #[(maildrop-name) "`ÁÅ Á‰É\nƒËÌ \n#‚#ËÍ \"!ˆÎdbˆ`\nƒGÑÁ ÓÔ\n!ÕÖ ×&ˆ‚PÑÁÕÖ $ˆÉ\nƒ_ËØ \n#‚cËÙ \"!ˆbˆŠÚÛÁÜ#)ƒÉÝ\nƒ~Þ‚ß\nƒ‰\n‚Šß#ˆ‚£ÚàÁÜ#ƒžáâ!ˆ‚£ã ˆÜä%!ˆæ Ü\"'è ˆ\nƒ½é ˆê ‚¿\fb)ë!ˆ.‡" [mh-current-folder nil new-mail-p folder point-before-inc buffer-modified-p buffer-file-name buffer-read-only mh-folder-updating-mod-flag message maildrop-name format "inc %s -file %s..." "inc %s..." forward mh-next-direction start-of-inc mh-exec-cmd-output mh-inc-prog "-file" expand-file-name "-width" window-width "-truncate" "inc %s -file %s...done" "inc %s...done" re-search-forward "^inc: no mail" t "No new mail%s%s" " in " "" "^inc:" error "inc error" mh-remove-cur-notation keep-lines mh-valid-scan-line mh-read-folder-sequences mh-seq-list mh-notate-user-sequences mh-make-folder-mode-line mh-goto-cur-msg mh-set-folder-modified-p] 9]) (defalias 'mh-make-folder-mode-line #[(&optional ignored) "ŠÀ ˆÁÂ!Ä ˆÁÂ!Æed\"ÈÉ\nƒ$ÈË\n\"‚%̉ÍUƒ1΂DÏVƒ@ÈÐ #‚DÈÑ \"$C‰)‡" [mh-first-msg mh-get-msg-num nil mh-first-msg-num mh-last-msg mh-last-msg-num count-lines mh-msg-count format "{%%b%s} %d msg%s" mh-mode-line-annotation "/%s" "" 0 "s" 1 "s (%d-%d)" " (%d)" mode-line-buffer-identification] 8]) (defalias 'mh-unmark-all-headers #[(remove-all-flags) "ŠÀdSÀÄ ˆ`\nX…[ uˆgƒ- ÈH=„6  ÈH=„6 \nÈH=ƒ=ËÌ!ˆÍcˆƒUÌuˆgÈH=ƒUËÌ!ˆÍcˆÀyˆ‚ ,‡" [nil char last-line case-fold-search mh-first-msg mh-cmd-note remove-all-flags mh-note-deleted 0 mh-note-refiled mh-note-cur delete-char 1 " " mh-note-seq] 3]) (defalias 'mh-remove-cur-notation #[nil "ÀÁ!@Š\n…Ã\nĉ#…Å!…ÇÈÉ\n#*‡" [mh-seq-to-msgs cur cur-msg mh-goto-msg t looking-at mh-cur-scan-msg-regexp mh-notate nil 32 mh-cmd-note] 4]) (defalias 'mh-goto-cur-msg #[nil "ÀÁ!@‰ƒ#Ã\nĉ#ƒ#ÅÆ#ˆÉÊ!ˆË\n!‚)Ì ˆÍÎ!)‡" [mh-seq-to-msgs cur cur-msg mh-goto-msg t mh-notate nil mh-note-cur mh-cmd-note mh-recenter 0 mh-maybe-show mh-last-msg message "No current message"] 5]) (defalias 'mh-process-or-undo-commands #[(folder) "qˆÁ ƒ\n„ÃÄ!ƒÅ!ˆ‚Æ ˆÇ ˆÈ ‡" [folder mh-outstanding-commands-p mh-do-not-confirm y-or-n-p "Process outstanding deletes and refiles (or lose them)? " mh-process-commands mh-undo-folder mh-update-unseen mh-invalidate-show-buffer] 2]) (defalias 'mh-process-commands #[(folder) "ÀÁ\n\"ˆ\nqˆÃ ĉÈ ˆÉÊ \"ˆÄ \fƒ4ÍÎÏ\nÐ\f!$ˆÑ\f!ˆÄ\fÒ ÓVƒGÔÕÖÄ!†D×C\"ˆÅØ!!ƒ^ÚÅØ!!!„^Û ˆÜÄ\"ßà!ˆá ˆÀâ\n\"ã!ˆ+ãÄ!ˆ‡" [message "Processing deletes and refiles for %s..." folder buffer-modified-p nil buffer-file-name buffer-read-only mh-folder-updating-mod-flag mh-update-unseen mh-mapc #[(dest) "À !‰…ÃÄÅÆÈ !É\n!&ˆÊ\n!)‡" [mh-seq-to-msgs dest msgs apply mh-exec-cmd "refile" "-src" folder symbol-name mh-coalesce-msg-list mh-delete-scan-msgs] 9] mh-refile-list mh-delete-list apply mh-exec-cmd "rmm" mh-coalesce-msg-list mh-delete-scan-msgs buffer-size 0 mh-define-sequence cur mh-get-msg-num "last" get-buffer mh-show-buffer file-exists-p mh-invalidate-show-buffer mh-read-folder-sequences mh-current-folder mh-seq-list mh-unmark-all-headers t mh-notate-user-sequences "Processing deletes and refiles for %s...done" mh-set-folder-modified-p] 6]) (defalias 'mh-update-unseen #[nil "…1Á\n!‰A‰ƒ-Å\n\"ˆƒ%Æ@\f\"A‰„ \f¡ˆÇ‚0ȉ*‡" [mh-seen-list mh-find-seq mh-unseen-seq unseen-seq unseen-msgs mh-undefine-sequence delq t nil] 4]) (defalias 'mh-delete-scan-msgs #[(msgs) "Š…Á@‰#ƒÃÄ!ˆA‰„Å)‡" [msgs mh-goto-msg t mh-delete-line 1 nil] 5]) (defalias 'mh-outstanding-commands-p #[nil "† ‡" [mh-delete-list mh-refile-list] 1]) (defalias 'mh-coalesce-msg-list #[(messages) "ÀÁ\n!Ã\"ÄÅÄ ƒcƒL§ƒ+ @S=„L=ƒ=B‚IÊË#BÄ„V @ @ A ‚,‡" [sort copy-sequence messages mh-greaterp nil -1 ranges prev range-high msgs format "%s-%s"] 4]) (defalias 'mh-greaterp #[(msg1 msg2) "§ƒ §ƒ V‡Â‡ §?… ™‡" [msg1 msg2 t] 2]) (defalias 'mh-delete-seq-locally #[(seq) "À !Ã\n\f\"‰)‡" [mh-find-seq seq entry delq mh-seq-list] 3]) (defalias 'mh-read-folder-sequences #[(folder save-refiles) "À\nƒ ÃÄ \"ˆŠÆÀÇÉ$Ê=ƒ4ËÌÀÍ#ƒ0Îʔʕ{!Ï B B‚e`|ˆ) )‡" [nil seqs save-refiles mh-mapc #[(seq) "À @!…\f \nB‰‡" [mh-folder-name-p seq seqs] 2] mh-seq-list mh-exec-cmd-quiet "mark" folder "-list" 0 re-search-forward "^[^: ]+" t intern mh-read-msg-list] 5]) (defalias 'mh-read-msg-list #[nil "ÀŠÀˆ`)ÀÄÅ\nÆ#ƒcÇȔȕ{!ÉÊ!ƒVËuˆÄÅ\nÆ#ˆÇȔȕ{!‰\f Wƒ@ÍÎ \f#ˆ \fXƒR B T‰‚A)‚ ÈU„ B‚ +‡" [nil num end-of-line msgs re-search-forward "[0-9]+" t string-to-int 0 looking-at "-" 1 num2 error "Bad message range: %d-%d"] 5]) (defalias 'mh-notate-user-sequences #[nil "Á‰…# @@Ä\n!„Å\nT#ˆ A‰„Á*‡" [mh-seq-list nil name seqs mh-internal-seq mh-notate-seq mh-note-seq mh-cmd-note] 5]) (defalias 'mh-internal-seq #[(name) "Á>†\n=† =†Ä!‡" [name (answered cur deleted forwarded printed) mh-unseen-seq mh-previous-seq mh-folder-name-p] 2]) #@161 Delete MESSAGE from SEQUENCE. MESSAGE defaults to displayed message. From Lisp, optional third arg INTERNAL-FLAG non-nil means do not inform MH of the change. (defalias 'mh-delete-msg-from-seq #[(message sequence &optional internal-flag) "À !‰…#Ã\fÅT $ˆ„È \fC\"ˆ\nÉ\f\nA\"¡)‡" [mh-find-seq sequence entry mh-notate-if-in-one-seq message 32 mh-cmd-note internal-flag mh-undefine-sequence delq] 6 (#$ . 28036) (list (mh-get-msg-num t) (mh-read-seq-default "Delete from" t) nil)]) (defalias 'mh-undefine-sequence #[(seq msgs) "ÀÁ\nÃÄÅ!Ç!&‡" [mh-exec-cmd "mark" mh-current-folder "-delete" "-sequence" symbol-name seq mh-coalesce-msg-list msgs] 8]) (defalias 'mh-define-sequence #[(seq msgs) "…Á\n!?…ŠÃÄÅÇÈÉÊ\n!Ë!&)‡" [msgs mh-folder-name-p seq mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero" "-sequence" symbol-name mh-coalesce-msg-list] 10]) (defalias 'mh-map-over-seqs #[(func seq-list) "… @@@A\"ˆA‰„‡" [seq-list func nil] 4]) (defalias 'mh-notate-if-in-one-seq #[(msg notation offset seq) "À Â\"\f @=… A?…Å #)‡" [mh-seq-containing-msg msg nil in-seqs seq mh-notate notation offset] 4]) (defalias 'mh-seq-containing-msg #[(msg &optional include-internal-p) "Á‰ƒ)\f @A>ƒ\" „Æ @@!„\" @@\nB A‰„\n*‡" [mh-seq-list nil seqs l msg include-internal-p mh-internal-seq] 3]) (defalias 'mh-read-msg-range #[(prompt) "À !‰GÄÆ Wƒ(È\n #‰ @B A)‚\fŸ,‡" [read-string prompt buf buf-size 0 start nil input read-from-string next] 5]) (byte-code "À !ˆÂ ÃÄ#ˆÂ ÅÆ#ˆÂ ÇÈ#ˆÂ ÉÊ#ˆÂ ËÌ#ˆÂ ÍÎ#ˆÂ ÏÐ#ˆÂ ÑÒ#ˆÂ ÓÔ#ˆÂ ÕÖ#ˆÂ ×Ø#ˆÂ ÙÚ#ˆÂ ÛÜ#ˆÂ ÝÞ#ˆÂ ßà#ˆÂ áâ#ˆÂ ãä#ˆÂ åæ#ˆÂ çè#ˆÂ éê#ˆÂ ëì#ˆÂ íî#ˆÂ ïð#ˆÂ ñò#ˆÂ óô#ˆÂ õö#ˆÂ ÷ø#ˆÂ ùú#ˆÂ ûü#ˆÂ ýü#ˆÂ þÿ#ˆÂ @A#ˆÂ BA#ˆÂ CD#ˆÂ ED#ˆÂ FG#ˆÂ HG#ˆÂ IJ#ˆÂ KL#ˆÂ MN#ˆÂ OP#ˆÂ QR#ˆÂ SR#ˆÂ TU#ˆÂ VW#ˆÂ XY#ˆÂ Z[#ˆÂ \\]#ˆÂ ^_#ˆÂ `a#ˆÂ ba#ˆÂ cd#ˆÂ ed#ˆÂ fg#‡" [suppress-keymap mh-folder-mode-map define-key "q" mh-quit "b" mh-compat-quit "?" mh-msg-is-in-seq "%" mh-put-msg-in-seq "|" mh-pipe-msg "a" mh-edit-again "%" mh-delete-msg-from-seq "#" mh-delete-seq "n" mh-narrow-to-seq "w" mh-widen "b" mh-burst-digest "u" mh-undo-folder " " mh-page-digest "" mh-page-digest-backwards "d" mh-redistribute "e" mh-extract-rejected-mail "f" mh-visit-folder "k" mh-kill-folder "l" mh-list-folders "n" mh-store-msg "p" mh-pack-folder "q" mh-list-sequences "s" mh-search-folder "r" mh-rescan-folder "l" mh-print-msg "t" mh-toggle-showing "c" mh-copy-msg "i" mh-inc-folder "x" mh-execute-commands "e" "f" mh-forward "m" mh-send "s" "r" mh-reply "a" "j" mh-goto-msg "g" "<" mh-first-msg ">" mh-last-msg "" mh-previous-page " " mh-page-msg " " mh-show "." "," mh-header-display "u" mh-undo "d" mh-delete-msg "" mh-delete-msg-no-motion "p" mh-previous-undeleted-msg "n" mh-next-undeleted-msg "o" mh-refile-msg "^" "" mh-write-msg-to-file ">" "!" mh-refile-or-write-again] 4) #@202 Compose and send mail with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. See documentation of `\[mh-send]' for more details on composing mail. (autoload (quote mh-smail) "mh-comp" '(#$ . 31003) t) #@218 Compose and send mail in other window with the MH mail system. This function is an entry point to mh-e, the Emacs front end to the MH mail system. See documentation of `\[mh-send]' for more details on composing mail. (autoload (quote mh-smail-other-window) "mh-comp" '(#$ . 31265) t) #@228 Clean-up a draft or a message previously sent and make it resendable. Default is the current message. The variable mh-new-draft-cleaned-headers specifies the headers to remove. See also documentation for `\[mh-send]' function. (autoload (quote mh-edit-again) "mh-comp" '(#$ . 31556) t) #@251 Extract a letter returned by the mail system and make it resendable. Default is the current message. The variable mh-new-draft-cleaned-headers gives the headers to clean out of the original message. See also documentation for `\[mh-send]' function. (autoload (quote mh-extract-rejected-mail) "mh-comp" '(#$ . 31849) t) #@198 Forward a message or message sequence. Defaults to displayed message. If optional prefix argument provided, then prompt for the message sequence. See also documentation for `\[mh-send]' function. (autoload (quote mh-forward) "mh-comp" '(#$ . 32176) t) #@171 Redistribute a letter. Depending on how your copy of MH was compiled, you may need to change the setting of the variable mh-redist-full-contents. See its documentation. (autoload (quote mh-redistribute) "mh-comp" '(#$ . 32436) t) #@466 Reply to a MESSAGE (default: displayed message). If optional prefix argument INCLUDEP provided, then include the message in the reply using filter mhl.reply in your MH directory. Prompts for type of addresses to reply to: from sender only, to sender and primary recipients, cc/all sender and all recipients. If the file named by `mh-repl-formfile' exists, it is used as a skeleton for the reply. See also documentation for `\[mh-send]' function. (autoload (quote mh-reply) "mh-comp" '(#$ . 32674) t) #@363 Compose and send a letter. The file named by `mh-comp-formfile' will be used as the form. Do not call this function from outside mh-e; use \[mh-smail] instead. The letter is composed in mh-letter-mode; see its documentation for more details. If `mh-compose-letter-function' is defined, it is called on the draft and passed three arguments: to, subject, and cc. (autoload (quote mh-send) "mh-comp" '(#$ . 33200) t) #@179 Compose and send a letter in another window. Do not call this function from outside mh-e; use \[mh-smail-other-window] instead. See also documentation for `\[mh-send]' function. (autoload (quote mh-send-other-window) "mh-comp" '(#$ . 33622) t) #@102 Mode for composing letters in mh-e. For more details, type \[describe-mode] while in MH-Letter mode. (autoload (quote mh-letter-mode) "mh-comp" '(#$ . 33873) t) #@191 Burst apart the current message, which should be a digest. The message is replaced by its table of contents and the messages from the digest are inserted into the folder after that message. (autoload (quote mh-burst-digest) "mh-funcs" '(#$ . 34041) t) #@186 Copy to another FOLDER the specified MESSAGE(s) without deleting them. Default is the displayed message. If optional prefix argument is provided, then prompt for the message sequence. (autoload (quote mh-copy-msg) "mh-funcs" '(#$ . 34300) t) #@28 Remove the current folder. (autoload (quote mh-kill-folder) "mh-funcs" '(#$ . 34549) t) #@20 List mail folders. (autoload (quote mh-list-folders) "mh-funcs" '(#$ . 34643) t) #@253 Renumber the messages of a folder to be 1..n. First, offer to execute any outstanding commands for the current folder. If optional prefix argument provided, prompt for the range of messages to display after packing. Otherwise, show the entire folder. (autoload (quote mh-pack-folder) "mh-funcs" '(#$ . 34731) t) #@194 Pipe the current message through the given shell COMMAND. If INCLUDE-HEADERS (prefix argument) is provided, send the entire message. Otherwise just send the message's body without the headers. (autoload (quote mh-pipe-msg) "mh-funcs" '(#$ . 35051) t) #@53 Advance displayed message to next digested message. (autoload (quote mh-page-digest) "mh-funcs" '(#$ . 35308) t) #@57 Back up displayed message to previous digested message. (autoload (quote mh-page-digest-backwards) "mh-funcs" '(#$ . 35427) t) #@276 Print MESSAGE(s) (default: displayed message) on printer. If optional prefix argument provided, then prompt for the message sequence. The variable mh-lpr-command-format is used to generate the print command. The messages are formatted by mhl. See the variable mhl-formfile. (autoload (quote mh-print-msg) "mh-funcs" '(#$ . 35561) t) #@195 Sort the messages in the current folder by date. Calls the MH program sortm to do the work. The arguments in the list mh-sortm-args are passed to sortm if this function is passed an argument. (autoload (quote mh-sort-folder) "mh-funcs" '(#$ . 35902) t) #@38 Undo all commands in current folder. (autoload (quote mh-undo-folder) "mh-funcs" '(#$ . 36163) t) #@249 Store the file(s) contained in the current message into DIRECTORY. The message can contain a shar file or uuencoded file. Default directory is the last directory used, or initially the value of mh-store-default-directory or the current directory. (autoload (quote mh-store-msg) "mh-funcs" '(#$ . 36268) t) #@248 Store the file(s) contained in the current buffer into DIRECTORY. The buffer can contain a shar file or uuencoded file. Default directory is the last directory used, or initially the value of `mh-store-default-directory' or the current directory. (autoload (quote mh-store-buffer) "mh-funcs" '(#$ . 36582) t) #@103 Search FOLDER for messages matching a pattern. Add the messages found to the sequence named `search'. (autoload (quote mh-search-folder) "mh-pick" '(#$ . 36898) t) #@22 Delete the SEQUENCE. (autoload (quote mh-delete-seq) "mh-seq" '(#$ . 37068) t) #@39 List the sequences defined in FOLDER. (autoload (quote mh-list-sequences) "mh-seq" '(#$ . 37153) t) #@74 Display the sequences that contain MESSAGE (default: displayed message). (autoload (quote mh-msg-is-in-seq) "mh-seq" '(#$ . 37259) t) #@100 Restrict display of this folder to just messages in SEQUENCE Use \[mh-widen] to undo this command. (autoload (quote mh-narrow-to-seq) "mh-seq" '(#$ . 37400) t) #@134 Add MESSAGE(s) (default: displayed message) to SEQUENCE. If optional prefix argument provided, then prompt for the message sequence. (autoload (quote mh-put-msg-in-seq) "mh-seq" '(#$ . 37567) t) #@72 Remove restrictions from current folder, thereby showing all messages. (autoload (quote mh-widen) "mh-seq" '(#$ . 37768) t) #@35 Rename SEQUENCE to have NEW-NAME. (autoload (quote mh-rename-seq) "mh-seq" '(#$ . 37898) t) emacs-19.30/lisp/mh-funcs.elc100666 12120 1 22703 6046535532 14316 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 20:01:05 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mh-funcs.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`mh-funcs.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!‡" [provide mh-funcs require mh-e] 2) #@296 Extra arguments to have \[mh-sort-folder] pass to the "sortm" command. The arguments are passed to sortm if \[mh-sort-folder] is given a prefix argument. Normally default arguments to sortm are specified in the MH profile. For example, '("-nolimit" "-textfield" "subject") is a useful setting. (defvar mh-sortm-args nil (#$ . 539)) #@65 String whose first character is used to notate copied messages. (defvar mh-note-copied "C" (#$ . 878)) #@66 String whose first character is used to notate printed messages. (defvar mh-note-printed "P" (#$ . 987)) #@191 Burst apart the current message, which should be a digest. The message is replaced by its table of contents and the messages from the digest are inserted into the folder after that message. (defalias 'mh-burst-digest #[nil "ÀÁ!Ã\f!ˆÅÁ!ˆÆÇ!ˆÈÉ\f\nÊ$ˆË ̉ Ðyˆ`d|ˆÅ!ˆ+ÑÒÓ\n\"Á\"ˆÔ ˆÆÕ!)‡" [mh-get-msg-num t digest mh-process-or-undo-commands mh-current-folder mh-set-folder-modified-p message "Bursting digest..." mh-exec-cmd "burst" "-inplace" buffer-modified-p nil buffer-file-name buffer-read-only mh-folder-updating-mod-flag 0 mh-regenerate-headers format "%d-last" mh-goto-cur-msg "Bursting digest...done"] 5 (#$ . 1099) nil]) #@186 Copy the specified MESSAGE(s) to another FOLDER without deleting them. Default is the displayed message. If optional prefix argument is provided, then prompt for the message sequence. (defalias 'mh-copy-msg #[(msg-or-seq folder) "ÀÁ\nÃÄ &ˆ\n§ƒÇ\n #‡Ê\n #‡" [mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder folder mh-notate mh-note-copied mh-cmd-note mh-notate-seq] 7 (#$ . 1743) (list (if current-prefix-arg (mh-read-seq-default "Copy" t) (mh-get-msg-num t)) (mh-prompt-for-folder "Copy to" "" t))]) #@28 Remove the current folder. (defalias 'mh-kill-folder #[nil "„ ÁÂÃ\f\"!ƒI\f„Ç ˆÈÉ!ˆÊË \"ˆÌÍ \"\"ÎÏ!ˆÐÑ \"ˆÈÒ!ˆÓ!ƒDÕ!ˆÕ !)‡ÐÖ!‡" [mh-do-not-confirm yes-or-no-p format "Remove folder %s? " mh-current-folder folder mh-folder-list mh-set-folder-list mh-set-folder-modified-p t mh-exec-cmd-daemon "rmf" delq assoc run-hooks mh-folder-list-change-hook message "Folder %s removed" nil get-buffer mh-show-buffer kill-buffer "Folder not removed"] 4 (#$ . 2278) nil]) #@20 List mail folders. (defalias 'mh-list-folders #[nil "ŠÁ!ˆÂ ˆÃÄ!ˆÅÆǃɂÊ#ˆebˆÃË!)‘‡" [mh-temp-buffer switch-to-buffer erase-buffer message "Listing folders..." mh-exec-cmd-output "folders" t mh-recursive-folders "-recurse" "-norecurse" "Listing folders...done"] 5 (#$ . 2760) nil]) #@253 Renumber the messages of a folder to be 1..n. First, offer to execute any outstanding commands for the current folder. If optional prefix argument provided, prompt for the RANGE of messages to display after packing. Otherwise, show the entire folder. (defalias 'mh-pack-folder #[(range) "À !ˆÂ ˆÃÄ!‡" [mh-pack-folder-1 range mh-goto-cur-msg message "Packing folder...done"] 2 (#$ . 3057) (list (if current-prefix-arg (mh-read-msg-range "Range to scan after packing [all]? ") "all"))]) (defalias 'mh-pack-folder-1 #[(range) "À !ˆÂÃ!ˆÄÅ!ˆŠÆÅÇ ÈÉÊ&ˆ)Ë\f!‡" [mh-process-or-undo-commands mh-current-folder message "Packing folder..." mh-set-folder-modified-p t mh-exec-cmd-quiet "folder" "-pack" "-norecurse" "-fast" mh-regenerate-headers range] 7]) #@194 Pipe the current message through the given shell COMMAND. If INCLUDE-HEADERS (prefix argument) is provided, send the entire message. Otherwise just send the message's body without the headers. (defalias 'mh-pipe-msg #[(command include-headers) "ÀÁÂ!! ŠÆ!qˆÈ ˆÉ !ˆebˆ\n„\"ËÌ!ˆ\fÍ`dÏ$,‡" [mh-msg-filename mh-get-msg-num t default-directory message-directory msg-file-to-pipe get-buffer-create mh-temp-buffer erase-buffer insert-file-contents include-headers search-forward "\n\n" shell-command-on-region command nil] 5 (#$ . 3812) (list (read-string "Shell command on message: ") current-prefix-arg)]) #@53 Advance displayed message to next digested message. (defalias 'mh-page-digest #[nil "À  !ˆ\fƒÅp!ˆÆŽÇÈ!ˆÉ\nËÌÉÍ#ƒ(ÎÏÉÍ#„,ÐÑ!ˆ)ÒÌÉÍ#ˆÓyˆÔÈ!*‡" [selected-window mh-in-show-buffer-saved-window switch-to-buffer-other-window mh-show-buffer mh-bury-show-buffer bury-buffer ((select-window mh-in-show-buffer-saved-window)) move-to-window-line 0 nil case-fold-search search-forward "\n\n" t re-search-forward "^From:" error "No more messages in digest" search-backward 2 mh-recenter] 4 (#$ . 4427) nil]) #@57 Back up displayed message to previous digested message. (defalias 'mh-page-digest-backwards #[nil "À  !ˆ\fƒÅp!ˆÆŽÇÈ!ˆÉ\nÈyˆËÌÉÍ#ƒ+ÎÏÉÍ#„/ÐÑ!ˆ)ËÌÉÍ#ƒ;ÒyˆÓÈ!*‡" [selected-window mh-in-show-buffer-saved-window switch-to-buffer-other-window mh-show-buffer mh-bury-show-buffer bury-buffer ((select-window mh-in-show-buffer-saved-window)) move-to-window-line 0 nil case-fold-search search-backward "\n\n" t re-search-backward "^From:" error "No previous message in digest" 2 mh-recenter] 4 (#$ . 4935) nil]) #@276 Print MESSAGE(s) (default: displayed message) on printer. If optional prefix argument provided, then prompt for the message sequence. The variable mh-lpr-command-format is used to generate the print command. The messages are formatted by mhl. See the variable mhl-formfile. (defalias 'mh-print-msg #[(msg-or-seq) "§ƒ\fÁÂ!ˆ‚ÁÃ!ˆ§ƒIÄÅÆÇ\"É!\n;ƒ-ÄË\n\"‚.ÌÄ §ƒ?ÄÎ#‚DÄÐ\"\"%‚€ÄÑÒÓÔ#ÆÇ\"\n;ƒcÄË\n\"‚dÌÕ!Ä §ƒxÄÎ#‚}ÄÐ\"\"&ƒ’ØÚ#ˆ‚žÛ܉‰Ú&ˆ§ƒ®Ý#ˆ‚¶à#ˆáâã#ˆ§ƒÇÁä!‚ÊÁå!)‡" [msg-or-seq message "Printing message..." "Printing sequence..." format "%s -nobell -clear %s %s | %s" expand-file-name "mhl" mh-lib mh-msg-filename mhl-formfile "-form %s" "" mh-lpr-command-format "%s/%d" mh-current-folder "Sequence from %s" "(scan -clear %s ; %s -nobell -clear %s %s) | %s" mapconcat #[(msg) "‡" [msg] 1] " " mh-msg-filenames print-command mh-print-background mh-exec-cmd-daemon shell-file-name "-c" call-process nil mh-notate mh-note-printed mh-cmd-note mh-notate-seq mh-add-msgs-to-seq printed t "Printing message...done" "Printing sequence...done"] 12 (#$ . 5452) (list (if current-prefix-arg (reverse (mh-seq-to-msgs (mh-read-seq-default "Print" t))) (mh-get-msg-num t)))]) (defalias 'mh-msg-filenames #[(msgs &optional folder) "ÀÁ\nÃ#‡" [mapconcat #[(msg) "À \n\"‡" [mh-msg-filename msg folder] 3] msgs " "] 4]) #@195 Sort the messages in the current folder by date. Calls the MH program sortm to do the work. The arguments in the list mh-sortm-args are passed to sortm if this function is passed an argument. (defalias 'mh-sort-folder #[(&optional extra-args) "À !ˆÂÄÅ!ˆÆÇ!ˆÈÉ \n… #ˆÆÌ!ˆÍ Î\"‡" [mh-process-or-undo-commands mh-current-folder forward mh-next-direction mh-set-folder-modified-p t message "Sorting folder..." mh-exec-cmd "sortm" extra-args mh-sortm-args "Sorting folder...done" mh-scan-folder "all"] 4 (#$ . 6830) "P"]) #@57 Undo all pending deletes and refiles in current folder. (defalias 'mh-undo-folder #[(&rest ignore) "„\nÁÂ!ƒ,ÃÃÃÇÉ Ã‰\n \fÍÎ!Ï\f!ˆ+ÏÃ!ˆ‡ÐÑ!ˆÒÓ!‡" [mh-do-not-confirm yes-or-no-p "Undo all commands in folder? " nil mh-delete-list mh-refile-list mh-seq-list forward mh-next-direction buffer-modified-p buffer-file-name buffer-read-only mh-folder-updating-mod-flag mh-unmark-all-headers t mh-set-folder-modified-p message "Commands not undone." sit-for 2] 3 (#$ . 7360) nil]) #@249 Store the file(s) contained in the current message into DIRECTORY. The message can contain a shar file or uuencoded file. Default directory is the last directory used, or initially the value of mh-store-default-directory or the current directory. (defalias 'mh-store-msg #[(directory) "ÀÁÂ!!ŠÄ !qˆÆ ˆÇ !ˆÈ !*‡" [mh-msg-filename mh-get-msg-num t msg-file-to-store get-buffer-create mh-temp-buffer erase-buffer insert-file-contents mh-store-buffer directory] 3 (#$ . 7851) (list (let ((udir (or mh-store-default-directory default-directory))) (read-file-name "Store message in directory: " udir udir nil)))]) #@248 Store the file(s) contained in the current buffer into DIRECTORY. The buffer can contain a shar file or uuencoded file. Default directory is the last directory used, or initially the value of `mh-store-default-directory' or the current directory. (defalias 'mh-store-buffer #[(directory) "À !ŠebˆÂÃÄÅ#…#ÆÇ!ƒÈyˆÉyˆÆÊ!?…#`)ËÌ!Í΄MŠebˆÂÔÄÅ#ƒL`Ĉ`{)ŠqˆÕ ˆÖ!„l× Ø±ˆÙÚÄÅ%ˆÛ رˆ „ƒÝÞ±ˆ)ßà!É\"ˆÄ!â!#ädÄÅ&!)qˆå!\"ˆ)æc-‡" [expand-file-name directory re-search-forward "^#![ ]*/bin/sh\\|^#\\|^: " nil t looking-at "^[^a-z0-9\"]*cut here\\b" 1 0 "^[#:]....+\n\\( ?\n\\)?end$" get-buffer-create "*Store Output*" "sh" "(unknown filename)" uudecode-filename command log-buffer sh-start store-directory "^begin [0-7]+ " erase-buffer file-directory-p "mkdir " "\n" call-process "mkdir" "cd " mh-store-default-directory "uudecode" " being uudecoded...\n" set-window-start display-buffer value file-name-as-directory default-directory call-process-region mh-handle-process-error "\n(mh-store finished)\n"] 7 (#$ . 8468) (list (let ((udir (or mh-store-default-directory default-directory))) (read-file-name "Store buffer in directory: " udir udir nil)))]) emacs-19.30/lisp/mh-mime.elc100666 12120 1 15203 6046535537 14131 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 20:01:15 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mh-mime.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`mh-mime.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!‡" [provide mh-mime require mh-comp] 2) #@213 Extra arguments to have \[mh-edit-mhn] pass to the "mhn" command. The arguments are passed to mhn if \[mh-edit-mhn] is given a prefix argument. Normally default arguments to mhn are specified in the MH profile. (defvar mh-mhn-args nil (#$ . 539)) #@73 Invoked on the formatted letter by \\[mh-edit-mhn]. (defvar mh-edit-mhn-hook nil (#$ . 793)) #@66 Legal MIME content types. See documentation for \[mh-edit-mhn]. (defvar mh-mime-content-types (quote (("text/plain") ("text/richtext") ("multipart/mixed") ("multipart/alternative") ("multipart/digest") ("multipart/parallel") ("message/rfc822") ("message/partial") ("message/external-body") ("application/octet-stream") ("application/postscript") ("image/jpeg") ("image/gif") ("audio/basic") ("video/mpeg"))) (#$ . 912)) #@306 Add a directive to insert a MIME message part from a file. This is the typical way to insert non-text parts in a message. Arguments are PATHNAME, which tells where to find the file, TYPE, the MIME content type, and DESCRIPTION, a line of text for the Content-description header. See also \[mh-edit-mhn]. (defalias 'mh-mhn-compose-insertion #[(pathname type description) "À \n #‡" [mh-mhn-compose-type pathname type description] 4 (#$ . 1340) (list (read-file-name "Insert contents of: ") (completing-read "Content-type: " mh-mime-content-types nil nil nil) (read-string "Content-description: "))]) (defalias 'mh-mhn-compose-type #[(pathname type &optional description attributes comment) "ÀyˆÁ\n±ˆ ƒÄ ±ˆ ƒÆ DZˆÈcˆ ƒ' cˆÊË\f!±ˆÍc‡" [0 "#" type attributes "; " comment " (" ")" " [" description "] " expand-file-name pathname "\n"] 3]) #@363 Add a directive for a MIME anonymous ftp external body part. This directive tells MH to include a reference to a message/external-body part retrievable by anonymous FTP. Arguments are HOST and PATHNAME, which tell where to find the file, TYPE, the MIME content type, and DESCRIPTION, a line of text for the Content-description header. See also \[mh-edit-mhn]. (defalias 'mh-mhn-compose-anon-ftp #[(host pathname type description) "ÀÁ\n \f %‡" [mh-mhn-compose-external-type "anon-ftp" host pathname type description] 6 (#$ . 2194) (list (read-string "Remote host: ") (read-string "Remote pathname: ") (completing-read "External Content-type: " mh-mime-content-types nil nil nil) (read-string "External Content-description: "))]) #@361 Add a directive to include a MIME reference to a compressed tar file. The file should be available via anonymous ftp. This directive tells MH to include a reference to a message/external-body part. Arguments are HOST and PATHNAME, which tell where to find the file, and DESCRIPTION, a line of text for the Content-description header. See also \[mh-edit-mhn]. (defalias 'mh-mhn-compose-external-compressed-tar #[(host pathname description) "ÀÁ\n Ä ÆÇ&‡" [mh-mhn-compose-external-type "anon-ftp" host pathname "application/octet-stream" description "type=tar; conversions=x-compress" "mode=image"] 8 (#$ . 2931) (list (read-string "Remote host: ") (read-string "Remote pathname: ") (read-string "Tar file Content-description: "))]) (defalias 'mh-mhn-compose-external-type #[(access-type host pathname type &optional description attributes extra-params comment) "ÀyˆÁ\n±ˆ ƒÄ ±ˆ ƒÆ DZˆÈcˆ ƒ' cˆÊcˆË\fıˆÍ±ˆÏÐ!±ˆÒÓ!Ô±ˆƒSıˆÖc‡" [0 "#@" type attributes "; " comment " (" ") " " [" description "] " "access-type=" access-type "site=" host "; name=" file-name-nondirectory pathname "; directory=\"" file-name-directory "\"" extra-params "\n"] 3]) #@309 Add a forw directive to this message, to forward a message with MIME. This directive tells MH to include the named messages in this one. Arguments are DESCRIPTION, a line of text for the Content-description header, and FOLDER and MESSAGES, which name the message(s) to be forwarded. See also \[mh-edit-mhn]. (defalias 'mh-mhn-compose-forw #[(&optional description folder messages) "ÀyˆÁcˆ\nƒ\nØ„\ncˆÄcˆ ƒ% Ø„%Æ ±ˆƒFØ„F`ƱˆÉ`ÊË$ˆ)‚S\fƒSÆÍ\f!±ˆÎc‡" [0 "#forw [" description "" "]" folder " " messages start subst-char-in-region 44 32 mh-sent-from-msg int-to-string "\n"] 5 (#$ . 4106) (list (read-string "Forw Content-description: ") (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) (read-string (format "Messages%s: " (if mh-sent-from-msg (format " [%d]" mh-sent-from-msg) ""))))]) #@870 Format the current draft for MIME, expanding any mhn directives. Process the current draft with the mhn program, which, using directives already inserted in the draft, fills in all the MIME components and header fields. This step should be done last just before sending the message. The mhn program is part of MH version 6.8 or later. The `\[mh-revert-mhn-edit]' command undoes this command. The arguments in the list `mh-mhn-args' are passed to mhn if this function is passed an argument. For assistance with creating mhn directives to insert various types of components in a message, see \[mh-mhn-compose-insertion] (generic insertion from a file), \[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp), \[mh-mhn-compose-external-compressed-tar] (reference to compressed tar file via anonymous ftp), and \[mh-mhn-compose-forw] (forward message). (defalias 'mh-edit-mhn #[(&optional extra-args) "À ˆÁÂ!ˆÃÄÅ\"Ç… $ˆÊˉ\"ˆÁÌ!ˆÍÎ!‡" [save-buffer message "mhn editing..." mh-exec-cmd-error format "mhdraft=%s" buffer-file-name "mhn" extra-args mh-mhn-args revert-buffer t "mhn editing...done" run-hooks mh-edit-mhn-hook] 5 (#$ . 4935) "*P"]) #@130 Undoes the effect of \[mh-edit-mhn] by reverting to the backup file. Optional non-nil argument means don't ask for confirmation. (defalias 'mh-revert-mhn-edit #[(noconfirm) "„ÁÂ!ˆÃĉƒ,ÇÈ!@É!ÊR‰!„,A‰„„6ÁË\"ˆ\f„HÍÎÏ \"!„HÁÐ!ˆÄÒ ˆÓ !ˆ)ÔÄ!*‡" [buffer-file-name error "Buffer does not seem to be associated with any file" ("," "#") nil backup-file backup-strings file-exists-p file-name-directory file-name-nondirectory ".orig" "mhn backup file for %s no longer exists!" noconfirm yes-or-no-p format "Revert buffer from file %s? " "mhn edit revert not confirmed." buffer-read-only erase-buffer insert-file-contents after-find-file] 6 (#$ . 6110) "*P"]) emacs-19.30/lisp/mh-pick.elc100666 12120 1 7514 6046535543 14113 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 20:01:19 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mh-pick.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`mh-pick.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!‡" [provide mh-pick require mh-e] 2) #@45 Invoked in `mh-pick-mode' on a new pattern. (defvar mh-pick-mode-hook nil (#$ . 535)) #@30 Keymap for searching folder. (defvar mh-pick-mode-map (make-sparse-keymap) (#$ . 627)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp mh-searching-folder nil current-load-list] 2) #@103 Search FOLDER for messages matching a pattern. Add the messages found to the sequence named `search'. (defalias 'mh-search-folder #[(folder) "ÀÁ!ˆÂ ÃU„ÄÅ!„Æ ˆ‚ÇÈ!ˆ ‰\n‡" [switch-to-buffer-other-window "pick-pattern" buffer-size 0 y-or-n-p "Reuse pattern? " mh-make-pick-template message "" folder mh-searching-folder] 2 (#$ . 803) (list (mh-prompt-for-folder "Search" mh-current-folder t))]) (defalias 'mh-make-pick-template #[nil "À ˆÁÂÃÄÅƱˆÇ ˆebˆÈ‡" [erase-buffer "From: \n" "To: \n" "Cc: \n" "Date: \n" "Subject: \n" "---------\n" mh-pick-mode nil] 6]) (put (quote mh-pick-mode) (quote mode-class) (quote special)) #@592 Mode for creating search templates in mh-e.\ After each field name, enter the pattern to search for. If a field's value does not matter for the search, leave it empty. To search the entire message, supply the pattern in the "body" of the template. Each non-empty field must be matched for a message to be selected. To effect a logical "or", use \[mh-search-folder] multiple times. When you have finished, type \[mh-do-pick-search] to do the search. \{mh-pick-mode-map} Turning on mh-pick-mode calls the value of the variable mh-pick-mode-hook if that value is non-nil. (defalias 'mh-pick-mode #[nil "À ˆÁÂ!ˆÃ\f!ˆÅÇÈ!ˆÉÊ!‡" [kill-all-local-variables make-local-variable mh-searching-folder use-local-map mh-pick-mode-map mh-pick-mode major-mode mh-set-mode-name "MH-Pick" run-hooks mh-pick-mode-hook] 2 (#$ . 1439) nil]) #@201 Find messages that match the qualifications in the current pattern buffer. Messages are searched for in the folder named in mh-searching-folder. Add the messages found to the sequence named `search'. (defalias 'mh-do-pick-search #[nil "À ‰Ã‰ \nŠË !ƒ- qˆÌÍ#C‚7Ð !ˆÑÃ)ÒÓ!ˆebˆƒhÔ\n!‰ƒhÕ Ö×Ø  ÙÚ!¯!#‰‰„DÒÛ!ˆ\fƒzÜ \"ˆ‚Ý !ˆÞÖ\"ˆß .‡" [buffer-name mh-searching-folder nil t new-buffer pattern finding-messages msgs range searching-buffer pattern-buffer get-buffer format "%d-%d" mh-first-msg-num mh-last-msg-num mh-make-folder ("all") message "Searching..." mh-next-pick-field mh-seq-from-command search mh-list-to-string "pick" "-list" mh-coalesce-msg-list "Searching...done" mh-scan-folder switch-to-buffer mh-add-msgs-to-seq delete-other-windows] 11 (#$ . 2290) nil]) (defalias 'mh-seq-from-command #[(folder seq seq-command) "À‰ÁŠÅ‹ˆqˆ Ÿ‰,‡" [nil t case-fold-search msgs msg ((byte-code "ÀÁ #Ä=ƒ Å @‰ƒ BÈyˆ‚\n‡" [apply mh-exec-cmd-quiet nil seq-command 0 mh-read-msg-list msg msgs 1] 4)) folder] 4]) (defalias 'mh-next-pick-field #[(buffer) "qˆÁmƒ Â[ÄÅÃÁ#ƒ3ÆÇȔȕ{—\" ʔʕ{ Èyˆ  *D‚[ÄÌÃÁ#ƒZÈuˆ`d{‰ GÎV…V Ïš?…VÐ D)‚[Ã)‡" [buffer t case-fold-search nil re-search-forward "^\\([a-z][^: \n]*\\):[ ]*\\([a-z0-9].*\\)$" format "--%s" 1 component 2 pat "^-*$" body 0 "\n" "-search"] 5]) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÅ#ˆÀ ÇÅ#ˆÀ ÈÅ#ˆÀ ÉÅ#ˆÀ ÊÅ#ˆÀ ËÅ#ˆÀ ÌÅ#ˆÀ ÍÅ#ˆÀ ÎÅ#ˆÀ ÏÅ#ˆÀ ÐÅ#ˆÀ ÑÅ#ˆÀ ÒÅ#‡" [define-key mh-pick-mode-map "" mh-do-pick-search "" mh-to-field "" "" "" "" "" "" "b" "c" "d" "f" "r" "s" "t"] 4) emacs-19.30/lisp/mh-seq.elc100666 12120 1 11637 6046535550 13774 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 20:01:23 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mh-seq.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`mh-seq.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!ˆÄÅ!„ÆÅBÄÈ!„ÆÈBƇ" [provide mh-seq require mh-e boundp mh-last-seq-used nil current-load-list mh-non-seq-mode-line-annotation] 2) #@22 Delete the SEQUENCE. (defalias 'mh-delete-seq #[(sequence) "ÀÁ\nÃ\fT\n%ˆÅ\nÆ\"ˆÇ\n!‡" [mh-map-to-seq-msgs mh-notate-if-in-one-seq sequence 32 mh-cmd-note mh-undefine-sequence ("all") mh-delete-seq-locally] 6 (#$ . 641) (list (mh-read-seq-default "Delete" t))]) #@39 List the sequences defined in FOLDER. (defalias 'mh-list-sequences #[(folder) " ‰Š qˆÄ ˆÅÆ!ˆÇɱˆ\nƒo\n@@ÊË\n@A!Ì\"Í ÎZÏÔÕ\"‰cˆƒdiVƒSÖcˆ×G!ˆÔØ@\"cˆA‰„CÖcˆ,\nA‰„ebˆÅÙ!)‘*‡" [mh-temp-buffer mh-seq-list seq-list temp-buffer erase-buffer message "Listing sequences ..." "Sequences in folder " folder ":\n" sort copy-sequence < window-width 4 nil name-spec last-col sorted-seq-msgs name format "%20s:" "\n" move-to-column " %s" "Listing sequences...done"] 6 (#$ . 908) (list (mh-prompt-for-folder "List sequences in" mh-current-folder t))]) #@72 Display the sequences that contain MESSAGE (default: current message). (defalias 'mh-msg-is-in-seq #[(message) "ÀÁÂÃÄÅÆ\"!Ç##‡" [message "Message %d is in sequences: %s" mapconcat concat mh-list-to-string mh-seq-containing-msg t " "] 9 (#$ . 1487) (list (mh-get-msg-num t))]) #@122 Restrict display of this folder to just messages in SEQUENCE. Use \\[mh-widen] to undo this command. (defalias 'mh-narrow-to-seq #[(sequence) "À Á‰Å!ƒ>Ç ˆdÉ\"ˆd}ˆÊË!ˆ\f Í!\fÎ ˆÏÁ!ˆ‰)‚EÑÒÍ!\"Ó\f!ˆ+‡" [buffer-modified-p nil buffer-file-name buffer-read-only mh-folder-updating-mod-flag mh-seq-to-msgs sequence mh-widen eob mh-copy-seq-to-point make-variable-buffer-local mh-non-seq-mode-line-annotation mh-mode-line-annotation symbol-name mh-make-folder-mode-line mh-recenter mh-narrowed-to-seq error "No messages in sequence `%s'" mh-set-folder-modified-p] 4 (#$ . 1772) (list (mh-read-seq "Narrow to" t))]) #@134 Add MESSAGE(s) (default: displayed message) to SEQUENCE. If optional prefix argument provided, then prompt for the message sequence. (defalias 'mh-put-msg-in-seq #[(msg-or-seq sequence) "À !„ Ã\f§ƒ\f‚Å\f! \"‡" [mh-internal-seq sequence mh-last-seq-used mh-add-msgs-to-seq msg-or-seq mh-seq-to-msgs] 3 (#$ . 2432) (list (if current-prefix-arg (mh-read-seq-default "Add messages from" t) (mh-get-msg-num t)) (mh-read-seq-default "Add to" nil))]) #@72 Remove restrictions from current folder, thereby showing all messages. (defalias 'mh-widen #[nil "ƒÁ ‰ed|ˆ~ˆÈ ˆÉ !ˆ+‰‡" [mh-narrowed-to-seq buffer-modified-p nil buffer-file-name buffer-read-only mh-folder-updating-mod-flag mh-non-seq-mode-line-annotation mh-mode-line-annotation mh-make-folder-mode-line mh-set-folder-modified-p] 3 (#$ . 2889) nil]) (defalias 'mh-read-seq-default #[(prompt not-empty) "À \n †\f†ÅÆÇ!Ç\"@#‡" [mh-read-seq prompt not-empty mh-narrowed-to-seq mh-last-seq-used mh-seq-containing-msg mh-get-msg-num nil] 6]) (defalias 'mh-read-seq #[(prompt not-empty &optional default) "ÀÁÂ Ä ƒÁÆ \"‚Ç$È !\"‰\nËšƒ)ÌÍÎ!Ï\"@‚8\nÇšƒ4 ‚8Ð\n!Ò!‰„QƒQÕÁÖ\"!ˆ+‡" [completing-read format "%s %s %s" prompt "sequence:" default "[%s] " "" mh-seq-names mh-seq-list input "%" mh-seq-containing-msg mh-get-msg-num t nil intern seq mh-seq-to-msgs msgs not-empty error "No messages in sequence `%s'"] 9]) (defalias 'mh-seq-names #[(seq-list) "ÀÁ\n\"‡" [mapcar #[(entry) "À @!C‡" [symbol-name entry] 2] seq-list] 3]) #@35 Rename SEQUENCE to have NEW-NAME. (defalias 'mh-rename-seq #[(sequence new-name) "À !‰„ ÃÄ \"ˆÅ\nA\"ˆÇ \nA\"ˆ\n )‡" [mh-find-seq sequence old-seq error "Sequence %s does not exist" mh-define-sequence new-name mh-undefine-sequence] 4 (#$ . 3951) (list (mh-read-seq "Old" t) (intern (read-string "New sequence name: ")))]) (defalias 'mh-map-to-seq-msgs #[(func seq &rest args) "ŠÀ !‰…#Ã\n@ĉ#ƒÅ\n@#ˆ\nA‰„ È*‡" [mh-seq-to-msgs seq msgs mh-goto-msg t apply func args nil] 5]) (defalias 'mh-notate-seq #[(seq notation offset) "ÀÁ\n \f$‡" [mh-map-to-seq-msgs mh-notate seq notation offset] 5]) (defalias 'mh-add-to-sequence #[(seq msgs) "À !?…\n…ÃÄÅÇÈÉ !Ê\n!&‡" [mh-folder-name-p seq msgs apply mh-exec-cmd "mark" mh-current-folder "-add" "-sequence" symbol-name mh-coalesce-msg-list] 9]) (defalias 'mh-copy-seq-to-point #[(seq location) "ÀÁ\n #‡" [mh-map-to-seq-msgs mh-copy-line-to-point seq location] 4]) (defalias 'mh-copy-line-to-point #[(msg location) "ÀyˆŠ`ÁÄyˆ` bˆÆp \n#+‡" [0 nil end beginning-of-line 1 location insert-buffer-substring] 4]) emacs-19.30/lisp/mh-utils.elc100666 12120 1 45560 6046535575 14355 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 20:01:28 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mh-utils.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`mh-utils.el' was compiled for Emacs 19.29 or later")) #@63 Directory containing MH commands, such as inc, repl, and rmm. (defvar mh-progs nil (#$ . 481)) #@124 Directory containing the MH library. This directory contains, among other things, the mhl program and the components file. (defvar mh-lib nil (#$ . 583)) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put mh-progs risky-local-variable t mh-lib] 4) #@181 *Whether to start collecting MH folder names immediately in the background. Non-nil means start a background process collecting the names of all folders as soon as mh-e is loaded. (defvar mh-auto-folder-collect t (#$ . -818)) #@72 *If non-nil, then commands which operate on folders do so recursively. (defvar mh-recursive-folders nil (#$ . -1050)) #@161 *Non-nil means clean headers of messages that are displayed or inserted. The variables `mh-visible-headers' and `mh-invisible-headers' control what is removed. (defvar mh-clean-message-header nil (#$ . -1175)) #@186 *If non-nil, contains a regexp specifying the headers to keep when cleaning. Only used if `mh-clean-message-header' is non-nil. Setting this variable overrides `mh-invisible-headers'. (defvar mh-visible-headers nil (#$ . -1392)) #@149 Regexp matching lines in a message header that are not to be shown. If `mh-visible-headers' is non-nil, it is used instead to specify what to keep. (defvar mh-invisible-headers "^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|^Return-Path: \\|^Delivery-Date: \\|^In-Reply-To: \\|^Resent-" (#$ . 1629)) #@71 *Non-nil means that the displayed show buffer for a folder is buried. (defvar mh-bury-show-buffer t (#$ . -1956)) #@65 *Number of lines in MH-Folder window (including the mode line). (defvar mh-summary-height 4 (#$ . -2076)) #@107 Regexp to find the number of a message in a scan line. The message's number must be surrounded with \( \) (defvar mh-msg-number-regexp "^ *\\([0-9]+\\)" (#$ . 2189)) #@136 Format string containing a regexp matching the scan listing for a message. The desired message's number will be an argument to format. (defvar mh-msg-search-regexp "^[^0-9]*%d[^0-9]" (#$ . 2362)) #@407 *Name of format file to be used by mhl to show and print messages. A value of T means use the default format file. Nil means don't use mhl to format messages when showing; mhl is still used, with the default format file, to format messages when printing them. The format used should specify a non-zero value for overflowoffset so the message continues to conform to RFC 822 and mh-e can parse the headers. (defvar mhl-formfile nil (#$ . -2565)) (put (quote mhl-formfile) (quote info-file) "mh-e") #@598 Function to select a default folder for refiling or Fcc. If set to a function, that function is called with no arguments by `\[mh-refile-msg]' and `\[mh-to-fcc]' to get a default when prompting the user for a folder. The function is called from within a save-excursion, with point at the start of the message. It should return the folder to offer as the refile or Fcc folder, as a string with a leading `+' sign. It can also return an empty string to use no default, or NIL to calculate the default the usual way. NOTE: This variable is not an ordinary hook; It may not be a list of functions. (defvar mh-default-folder-for-message-function nil (#$ . 3069)) #@62 Invoked by mh-find-path while reading the user's MH profile. (defvar mh-find-path-hook nil (#$ . 3736)) #@70 Invoked whenever the cached folder list `mh-folder-list' is changed. (defvar mh-folder-list-change-hook nil (#$ . 3846)) #@136 Format string to produce `mode-line-buffer-identification' for show buffers. First argument is folder name. Second is message number. (defvar mh-show-buffer-mode-line-buffer-id "{show-%s} %d" (#$ . 3974)) #@28 Offset to insert notation. (defvar mh-cmd-note 4 (#$ . 4186)) #@72 String whose first character is used to notate messages in a sequence. (defvar mh-note-seq "%" (#$ . 4254)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ BÀÈ!„GÂÈ BÉ\nÊ BÀË!„[Â Ë BÀÌ!„hÂ\fÌ BÀÍ!„uÂ Í BÀÎ!„‚ÂÎ BÀÏ!„ÂÏ BÀÐ!„œÂÐ B‡" [boundp mh-folder-list nil current-load-list mh-user-path mh-draft-folder mh-unseen-seq mh-previous-seq mh-inbox " *mh-temp*" mh-temp-buffer mh-previous-window-config mh-current-folder mh-show-buffer mh-folder-filename mh-msg-count mh-showing] 2) #@92 When moving to a new message in the Folder window, also show it in a separate Show window. (defalias 'mh-showing #[nil "À‡" [nil] 1 (#$ . 4793)]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ B‡" [boundp mh-seq-list nil current-load-list mh-seen-list mh-showing-with-headers] 2) (defalias 'with-mh-folder-updating '(macro . #[(save-modification-flag-p &rest body) "@ÁÂÃÁÄ BÆBBE?…ÇBB‡" [save-modification-flag-p prog1 let ((mh-folder-updating-mod-flag (buffer-modified-p)) (buffer-read-only nil) (buffer-file-name nil)) progn body ((mh-set-folder-modified-p mh-folder-updating-mod-flag)) ((mh-set-folder-modified-p nil))] 6])) (put (quote with-mh-folder-updating) (quote lisp-indent-hook) 1) (defalias 'mh-in-show-buffer '(macro . #[(show-buffer &rest body) "@ÁÂÃDÄÅÆBÈBB¯‡" [show-buffer let ((mh-in-show-buffer-saved-window (selected-window))) switch-to-buffer-other-window (if mh-bury-show-buffer (bury-buffer (current-buffer))) unwind-protect progn body ((select-window mh-in-show-buffer-saved-window))] 7])) (put (quote mh-in-show-buffer) (quote lisp-indent-hook) 1) (defalias 'mh-make-seq '(macro . #[(name msgs) "À \nE‡" [cons name msgs] 3])) (defalias 'mh-seq-name '(macro . #[(pair) "À D‡" [car pair] 2])) (defalias 'mh-seq-msgs '(macro . #[(pair) "À D‡" [cdr pair] 2])) (put (quote mh-show-mode) (quote mode-class) (quote special)) #@116 Major mode for showing messages in mh-e. The value of mh-show-mode-hook is called when a new message is displayed. (defalias 'mh-show-mode #[nil "À ˆÁÃÄ!ˆÅÆ!‡" [kill-all-local-variables mh-show-mode major-mode mh-set-mode-name "MH-Show" run-hooks mh-show-mode-hook] 2 (#$ . 6153)]) (defalias 'mh-maybe-show #[(&optional msg) "…Á\n!‡" [mh-showing mh-show msg] 2]) #@487 Show MESSAGE (default: message at cursor). Force a two-window display with the folder window on top (size mh-summary-height) and the show buffer below it. If the message is already visible, display the start of the message. Display of the message is controlled by setting the variables `mh-clean-message-header' and `mhl-formfile'. The default behavior is to scroll uninteresting headers off the top of the window. Type "\[mh-header-display]" to see the message with all its headers. (defalias 'mh-show #[(&optional message) "ƒ „\f\nƒà ˆÄ !‡" [mh-showing-with-headers mhl-formfile mh-clean-message-header mh-invalidate-show-buffer mh-show-msg message] 2 (#$ . 6527) nil]) (defalias 'mh-show-msg #[(msg) "„ÁÂ!Â\f Æ! \nËÌ !Í =„#Î ˆÍ Ð!ˆƒ5Òp!ˆÓŽƒUÔ\n\"šƒUebˆ „[Ö ˆ‚[×\n\"ˆ-Ø TÙ U„mÚØ Z!ˆÜÝ!ˆ>„~Bßà!‡" [msg mh-get-msg-num t mh-showing mh-current-folder mh-clean-message-header get-buffer-window mh-show-buffer show-window clean-message-header folder next-window minibuffer-window selected-window delete-other-windows mh-in-show-buffer-saved-window switch-to-buffer-other-window mh-bury-show-buffer bury-buffer ((select-window mh-in-show-buffer-saved-window)) mh-msg-filename buffer-file-name mh-start-of-uncleaned-message mh-display-msg window-height screen-height shrink-window mh-summary-height mh-recenter nil mh-seen-list run-hooks mh-show-hook] 4]) (defalias 'mh-display-msg #[(msg-num folder) "qˆ \n \fÅ! \n \f Î !„&ÏÐ\"ˆqˆ š?…®Ò ˆÓ ˆÔÕ!ƒBÖ ƒ\\×ØÙÚ ;…UÛ D %ˆ‚aÜ !ˆebˆ\fƒwÝe \n#ˆebˆ‚zÞ ˆà=„„ÖáÖ!ˆâ ˆ Ö#äå!ˆæÖ!ˆç ˆè)#C*qˆÖ‰+.‡" [folder mhl-formfile mh-clean-message-header mh-invisible-headers mh-visible-headers mh-msg-filename msg-num mh-show-buffer show-buffer msg-filename visible-headers invisible-headers clean-message-header formfile file-exists-p error "Message %d does not exist" buffer-file-name mh-unvisit-file erase-buffer boundp write-contents-hooks nil mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" "-form" insert-file-contents mh-clean-msg-header mh-start-of-uncleaned-message buffer-undo-list t set-buffer-modified-p set-buffer-auto-saved buffer-backed-up auto-save-mode 1 set-mark mh-show-mode format mh-show-buffer-mode-line-buffer-id mode-line-buffer-identification mh-showing-with-headers] 6]) (defalias 'mh-start-of-uncleaned-message #[nil "ÀÂÃÄÀ#ˆÅyˆÆÅ!)‡" [t case-fold-search re-search-forward "^To:\\|^Cc:\\|^From:\\|^Subject:\\|^Date:" nil 0 mh-recenter] 4]) (defalias 'mh-invalidate-show-buffer #[nil "À !… Š qˆÂ )‡" [get-buffer mh-show-buffer mh-unvisit-file] 2]) (defalias 'mh-unvisit-file #[nil "À ƒ ƒÂÃÄÅ !\"!„ÆÇ!ˆÈ ˆÉ ˆÊ‰‡" [buffer-modified-p buffer-file-name yes-or-no-p format "Message %s modified; flush changes? " file-name-nondirectory error "Flushing changes not confirmed" clear-visited-file-modtime unlock-buffer nil] 5]) (defalias 'mh-get-msg-num #[(error-if-no-message) "ŠÀyˆÁ\n!ƒÃĔĕ{!‚ ƒÆÇ!‚È)‡" [0 looking-at mh-msg-number-regexp string-to-int 1 error-if-no-message error "Cursor not pointing to message" nil] 3]) (defalias 'mh-msg-filename #[(msg &optional folder) "ÀÁ\n! ƒÄ !‚ \"‡" [expand-file-name int-to-string msg folder mh-expand-file-name mh-folder-filename] 4]) (defalias 'mh-clean-msg-header #[(start invisible-headers visible-headers) "ÀŒ\nbˆÃÄÅÆ#ƒÇÈ!ˆ\n`}ˆebˆ ƒK`dWƒhÊ !ƒ:ÈyˆÊË!ƒÈyˆ‚.ÌÈ!ˆÊË!ƒÌÈ!ˆ‚>ÍÅÀ#ƒhÏyˆÌÈ!ˆÊË!ƒKÌÈ!ˆ‚[Ð *‡" [t case-fold-search start search-forward "\n\n" nil move backward-char 1 visible-headers looking-at "[ ]" mh-delete-line re-search-forward invisible-headers 0 unlock-buffer] 4]) (defalias 'mh-recenter #[(arg) "Àp!Á =… ƒ ‚Ä!‡" [get-buffer-window selected-window recenter arg (t)] 2]) (defalias 'mh-delete-line #[(lines) "`yˆ`|‡" [lines] 2]) (defalias 'mh-notate #[(msg notation offset) "Šƒ Á‰#…*à ĉÈyˆ uˆÊË!ˆ\fcÍ!ˆ+)‡" [msg mh-goto-msg t buffer-modified-p nil buffer-file-name buffer-read-only mh-folder-updating-mod-flag 0 offset delete-char 1 notation mh-set-folder-modified-p] 4]) (defalias 'mh-find-msg-get-num #[(step) "ÀÁ!†9Á‰„7 ÅWƒ7mƒ!Æ T‚+oƒ+È TyˆÀÁ!‰ƒ\f*‡" [mh-get-msg-num nil 0 nreverses msg-num 2 -1 step 1] 3]) #@280 Position the cursor at message NUMBER. Optional non-nil second argument means return nil instead of signaling an error if message does not exist; in this case, the cursor is positioned near where the message would have been. Non-nil third argument means not to show the message. (defalias 'mh-goto-msg #[(number &optional no-error-if-no-message dont-show) "À !ÂÃ!\f ÇVƒQƒQ =„Q Wƒ: ZÈ TÃ\"^‰yˆÂÇ!‚  ZÈ TÃ\"^‰[yˆÂÃ!‚  =ƒjÉyˆ\n†tË !†tÌ‚t ?…tÎÏ \"*‡" [prefix-numeric-value number mh-find-msg-get-num -1 mh-msg-count jump-size cur-msg 1 ash 0 dont-show mh-maybe-show t no-error-if-no-message error "No message %d"] 5 (#$ . 10736) "NGo to message: "]) (defalias 'mh-msg-search-pat #[(n) "À \n\"‡" [format mh-msg-search-regexp n] 3]) (defalias 'mh-get-profile-field #[(field) "ÀebˆÂÃÄ \"ÆÀ#„Æ‚0ÇÈ!ƒÆ‚0ÂÉÆÀ#ˆÊ” ƈ `{))‡" [t case-fold-search re-search-forward format "^%s" field nil looking-at "[ ]*$" "[ ]*\\([^ \n].*\\)$" 1 start] 4]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp mua-paradigm "MH-E" current-load-list] 2) (defalias 'mh-find-path #[nil "À ˆŠÁÂÃ!†\fÄ!Æ!qˆÈ Ê ˆËÌ͈ÎÏ!‰„+ÑÒÁÁÓ!\"!ÎÔ!‰ƒ^Ö!„M×Ø\"ÙÚ!!„^ÛÜÚ!\"ˆÎÝ!‰„mß‚{Ö!„{×Ø\"Îà!‰!ƒâ!!!‚ã!Îä!‰%ƒŸâ%!%æ'èé!*‡" [mh-find-progs expand-file-name getenv "MH" "~/.mh_profile" profile get-buffer-create mh-temp-buffer nil buffer-offer-save erase-buffer err (insert-file-contents profile) ((file-error (mh-install profile err))) mh-get-profile-field "Path:" mh-user-path "Mail" file-name-as-directory "~" "Draft-Folder:" mh-draft-folder mh-folder-name-p format "+%s" file-exists-p mh-expand-file-name error "Draft folder \"%s\" not found. Create it and try again." "Inbox:" mh-inbox "+inbox" "Unseen-Sequence:" mh-unseen-seq intern unseen "Previous-Sequence:" mh-previous-seq "MH-E" mua-paradigm run-hooks mh-find-path-hook] 6]) (defalias 'mh-find-progs #[nil "ÀÁ \"!„Ä Â\"†ÄÆÂ\"† †ÇÀÁÈ \"!†>ÄÊÈ\"†;Ä È\"†; †;ˉ ‡" [file-exists-p expand-file-name "inc" mh-progs mh-path-search exec-path ("/usr/local/bin/mh/" "/usr/local/mh/" "/usr/bin/mh/" "/usr/new/mh/" "/usr/contrib/mh/bin/" "/usr/local/bin/") "/usr/local/bin/" "mhl" mh-lib ("/usr/local/lib/mh/" "/usr/local/mh/lib/" "/usr/local/bin/mh/" "/usr/lib/mh/" "/usr/new/lib/mh/" "/usr/contrib/mh/lib/") "/usr/local/lib/mh/"] 4]) (defalias 'mh-path-search #[(path file) "ƒÁ @\"!„A‰„@‡" [path file-exists-p expand-file-name file] 5]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp mh-no-install nil current-load-list] 2) (defalias 'mh-install #[(profile error-val) "ÀÁ!„ !„\fƒ Å@ÇÈ \"AA@D\"ˆÉÊË\f\"Í\"ˆÎ ˆÏÐч" [getenv "MH" file-exists-p profile mh-no-install signal error-val format "Cannot read MH profile \"%s\"" mh-exec-cmd expand-file-name "install-mh" mh-lib "-auto" erase-buffer err (insert-file-contents profile) ((file-error (byte-code "À @ÂÃ\f\" AA@D\"‡" [signal err format "Cannot read MH profile \"%s\"" profile] 5)))] 5]) (defalias 'mh-set-folder-modified-p #[(flag) "À !‡" [set-buffer-modified-p flag] 2]) (defalias 'mh-find-seq #[(name) "À \n\"‡" [assoc name mh-seq-list] 3]) (defalias 'mh-seq-to-msgs #[(seq) "À !A‡" [mh-find-seq seq] 2]) (defalias 'mh-add-msgs-to-seq #[(msgs seq &optional internal-flag) "À ! ƒ :„ C\n„ B\fB‚) ƒ)\nÅ \nA\"¡ˆ?…<Ç \"ˆÈ  \nT#)‡" [mh-find-seq seq entry msgs mh-seq-list append internal-flag mh-add-to-sequence mh-notate-seq mh-note-seq mh-cmd-note] 4]) (byte-code "ÀÁÂ\"ˆÀÃÂ\"ˆÀÄÂ\"ˆÀÅÂ\"‡" [autoload mh-add-to-sequence "mh-seq" mh-notate-seq mh-read-seq-default mh-map-to-seq-msgs] 3) (defalias 'mh-set-mode-name #[(mode-name-string) "ÂÃ!‡" [mode-name-string mode-name force-mode-line-update t] 2]) (defalias 'mh-prompt-for-folder #[(prompt default can-create) "„ÁÂÃ\fÁšƒÅ‚ÂÆ\"#ÇÇ \n„'Ë ˆÌ\f\nljÍ%‰ƒBÁšƒBÁš„'Áš„PÍšƒV‚dÎ!„dÂÏ\"‰ GÐVƒ ‰GSHÑ=ƒ ÐÒO ÓÔ !!?‰ƒ¾ÖÂ× \"!ƒ¾ØÙ \"ˆÚÛlj‰Ô !%ˆØÜ \"ˆC\nB\nÝÞ!ˆ‚ƒÌßà \"ˆ‚áÔ !!„àßâÔ !\"ˆ‚ã\n\"„ãäP\n\"„C\nB\nÝÞ!ˆ) +‡" [default "" format "%s folder%s" prompt "? " " [%s]? " nil read-name folder-name mh-folder-list mh-set-folder-list completing-read "+" mh-folder-name-p "+%s" 0 47 -1 file-exists-p mh-expand-file-name new-file-p y-or-n-p "Folder %s does not exist. Create it? " message "Creating %s" call-process "mkdir" "Creating %s...done" run-hooks mh-folder-list-change-hook error "Folder %s is not created" file-directory-p "\"%s\" is not a directory" assoc "/"] 8]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÆÅ B‡" [boundp mh-make-folder-list-process nil current-load-list mh-folder-list-temp mh-folder-list-partial-line ""] 2) (defalias 'mh-set-folder-list #[nil "ÀÁ!ˆ\n„ à ˆÄ\n!Å=ƒÆ\n!ˆ‚ ÉÊ!ˆËÌ\n!ˆËÀÍ!‡" [message "Collecting folder names..." mh-make-folder-list-process mh-make-folder-list-background process-status run accept-process-output mh-folder-list-temp mh-folder-list run-hooks mh-folder-list-change-hook nil delete-process "Collecting folder names...done"] 2]) (defalias 'mh-make-folder-list-background #[nil "?…(Á ˆÂÄÅÂÆÅ\"È ƒÊ‚Ë%ÌÍ\"ˆÎ!)‡" [mh-make-folder-list-process mh-find-path nil process-connection-type start-process "folders" expand-file-name mh-progs "-fast" mh-recursive-folders "-recurse" "-norecurse" set-process-filter mh-make-folder-list-filter process-kill-without-query] 6]) (defalias 'mh-make-folder-list-filter #[(process output) "ÀÁ‰Â ÇŽÈÉ\n#‰ƒ[ËÌ \n O#Î ƒMÈÐ@@ÑP!\f\"ƒM\fC@@ÑPCABB‚T\fCB T‚\f)\nÁO‰ ,‡" [0 nil match-data prevailing-match-data new-folder line-end position ((store-match-data prevailing-match-data)) string-match "\n" output format "+%s%s" mh-folder-list-partial-line "" mh-folder-list-temp regexp-quote "/"] 6]) (defalias 'mh-folder-name-p #[(name) "9ƒ Á!ÂHÃ=‡GÂV…ÂHÃ=‡" [name symbol-name 0 43] 2]) (defalias 'mh-exec-cmd #[(command &rest args) "ŠÀ !qˆÂ ˆÃÄÅ\"ÈÉÈÊ !&ˆÌ ÍV…$΋)‡" [get-buffer-create mh-temp-buffer erase-buffer apply call-process expand-file-name command mh-progs nil t mh-list-to-string args buffer-size 0 ((byte-code "À !ˆÂÃ!‡" [switch-to-buffer-other-window mh-temp-buffer sit-for 5] 2))] 8]) (defalias 'mh-exec-cmd-error #[(env command &rest args) "ŠÀ !qˆÂ ˆ ƒ)ÄÅÆÇÈÇÉÊË Ì \"# Ï!& ‚:ÄÅÌ \"ÇÈÇÏ!&Ò \"*‡" [get-buffer-create mh-temp-buffer erase-buffer env apply call-process "/bin/sh" nil t "-c" format "%s %s ${1+\"$@\"}" expand-file-name command mh-progs mh-list-to-string args status mh-handle-process-error] 13]) (defalias 'mh-exec-cmd-daemon #[(command &rest args) "ŠÀ !qˆÂ ˆ)ÃÅÆÃÈ \"Ê !%\fÍ\fÎ\"*‡" [get-buffer-create mh-temp-buffer erase-buffer nil process-connection-type apply start-process command expand-file-name mh-progs mh-list-to-string args process set-process-filter mh-process-daemon] 7]) (defalias 'mh-process-daemon #[(process output) "À !qˆÂ !ˆÄ !‡" [get-buffer-create mh-temp-buffer insert-before-markers output display-buffer] 2]) (defalias 'mh-exec-cmd-quiet #[(raise-error command &rest args) "À !qˆÂ ˆÃÄÅ\"ÈÉÈ\n& ebˆ\fƒ*Í \"‚, )‡" [get-buffer-create mh-temp-buffer erase-buffer apply call-process expand-file-name command mh-progs nil t args value raise-error mh-handle-process-error] 7]) (defalias 'mh-exec-cmd-output #[(command display &rest args) "À`Á\"ˆÂÃÄ \"ÇÁÉ\n!&ˆË ‡" [push-mark t apply call-process expand-file-name command mh-progs nil display mh-list-to-string args exchange-point-and-mark] 8]) (defalias 'mh-exec-lib-cmd-output #[(command &rest args) "ÀÁ \f\"Å$‡" [apply mh-exec-cmd-output expand-file-name command mh-lib nil args] 5]) (defalias 'mh-handle-process-error #[(command status) "Á=ƒ‡;ƒÂÃÄ #!‡Æ ÁUƒ$ÂÃÇ #!‡ÈÉ!ˆÆ Ê Wƒ@mƒ@ÂˉbˆÌˆ`{!‡Íp!ˆÂÃÎ #!‡" [status 0 error format "%s: %s" command buffer-size "%s: exit code %d" goto-line 2 screen-width 1 nil display-buffer "%s failed with status %d. See error message in other window."] 5]) (defalias 'mh-expand-file-name #[(filename &optional default) "À !ƒ ÃÄO \"‡Â \"‡" [mh-folder-name-p filename expand-file-name 1 nil mh-user-path default] 4]) (defalias 'mh-list-to-string #[(l) "À !Ÿ‡" [mh-list-to-string-1 l] 2]) (defalias 'mh-list-to-string-1 #[(l) "À\nƒ]\n@ƒV\n@9ƒÃ\n@! B‚V\n@§ƒ+Ä\n@! B‚V\n@Åš„V\n@;ƒ@\n@ B‚V\n@<ƒPÆ\n@! ¤‚VÇÈ\n@\"ˆ\nA‰„ )‡" [nil new-list l symbol-name int-to-string "" mh-list-to-string-1 error "Bad element in mh-list-to-string: %s"] 4]) (byte-code "ÀÁ!ˆ\n„ ƒÄÆÇȈ)À‡" [provide mh-utils noninteractive mh-auto-folder-collect t mh-no-install err (mh-make-folder-list-background) ((file-error))] 3) emacs-19.30/lisp/misc.elc100666 13437 1 1757 5744576767 13676 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:47:02 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/misc.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/misc.el' was compiled for Emacs 19")) #@248 Copy characters from previous nonblank line, starting just above point. Copy ARG characters, but not past the end of that line. If no argument given, copy the entire rest of the line. The characters copied are inserted in the buffer before point. (defalias 'copy-from-above-command #[(&optional arg) "iÀÁŠÅyˆÆÇ!ˆÈÀxˆÉ\f!ˆ\nƒ\"Ë\n!‚#d\fiWƒHhÌUƒDÍ i\fZ^Î\" ‰i\fZ^Z‚HÆÇ!ˆ\n`ŠÀˆ`) `\\^{P)\nc+‡" [nil "" string n cc 0 backward-char 1 " \n" move-to-column arg prefix-numeric-value 9 make-string 32] 5 (#$ . 478) "P"]) emacs-19.30/lisp/mlconvert.elc100666 13437 1 15701 5744576771 14761 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:47:03 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mlconvert.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/mlconvert.el' was compiled for Emacs 19")) #@70 Convert buffer of Mocklisp code to real Lisp that GNU Emacs can run. (defalias 'convert-mocklisp-buffer #[nil "À ˆÁÂà !!ˆÄÅÆ\"ˆÇÈ!ˆebˆÉ ˆebˆÊË̈ebˆÍcˆÎcˆÏ ˆebˆÇÐ!‡" [emacs-lisp-mode set-syntax-table copy-sequence syntax-table modify-syntax-entry 124 "w" message "Converting mocklisp (ugh!)..." fix-mlisp-syntax ignore (byte-code "`Àp! <ƒ! @Ã=„!ÄcˆŠ\nbˆÅÆwˆÇcˆ)*‚" [read form opt defun "))\n\n(ml-foo)\n\n" "\n" nil "(defun (ml-foo \n "] 3) ((end-of-file)) ";;; GNU Emacs code converted from Mocklisp\n" "(require 'mlsupport)\n\n" fix-mlisp-symbols "Converting mocklisp...done"] 3 (#$ . 487) nil]) (defalias 'fix-mlisp-syntax #[nil "ÀÁÂÃ#…DhÄUƒÅuˆÆÇ!ˆ‚ÈÅ!ˆÉcˆgÊU„+gËUƒ1Çuˆ‚:ÌÍ!ƒ:ÊcˆÇuˆÈÇ!ˆ‚‡" [re-search-forward "['\"]" nil t 34 -1 forward-sexp 1 delete-char "?" 92 94 looking-at "[^a-zA-Z]"] 4]) (defalias 'fix-mlisp-symbols #[nil "ÀÁwˆm?…`gÂU„gÃUƒÄÅ!ˆ‚gÆUƒ(Åyˆ‚`ÁÄÅ!ˆÉ`{!ÊN‰ƒ\\;ƒR`|ˆcˆ‚\\Šbˆ ˆ)*‚‡" [" \n()" nil 63 34 forward-sexp 1 59 prop start intern-soft mocklisp] 4]) (defalias 'ml-expansion #[(ml-name lisp-string) "À  #‡" [put ml-name mocklisp lisp-string] 4]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"ˆÀãä\"ˆÀåæ\"ˆÀçè\"ˆÀéê\"ˆÀëì\"ˆÀíî\"ˆÀïð\"ˆÀñò\"ˆÀóô\"ˆÀõö\"ˆÀ÷ø\"ˆÀùú\"ˆÀûü\"ˆÀýþ\"ˆÀÿ@\"ˆÀAB\"ˆÀCD\"ˆÀEF\"ˆÀGH\"ˆÀIJ\"ˆÀKL\"ˆÀMN\"ˆÀOP\"ˆÀQR\"ˆÀST\"ˆÀUV\"ˆÀWX\"ˆÀYZ\"ˆÀ[\\\"ˆÀ]^\"ˆÀ_`\"ˆÀab\"ˆÀcd\"ˆÀef\"ˆÀgh\"ˆÀij\"ˆÀkl\"ˆÀmn\"ˆÀop\"ˆÀqr\"ˆÀst\"ˆÀuv\"ˆÀwx\"ˆÀyz\"ˆÀ{|\"ˆÀ}~\"ˆÀ€\"ˆÀ‚\"ˆÀƒ„\"ˆÀ…†\"ˆÀ‡†\"ˆÀˆ‰\"ˆÀŠ‹\"ˆÀŒ\"ˆÀŽ\"ˆÀ‘\"ˆÀ’“\"ˆÀ”•\"ˆÀ–—\"ˆÀ˜™\"ˆÀš›\"ˆÀœ\"ˆÀžŸ\"ˆÀ ¡\"ˆÀ¢£\"ˆÀ¤¥\"ˆÀ¦§\"ˆÀ¨©\"ˆÀª«\"ˆÀ¬­\"ˆÀ®¯\"ˆÀ°±\"ˆÀ²³\"ˆÀ´µ\"ˆÀ¶·\"ˆÀ¸¹\"ˆÀº»\"ˆÀ¼½\"ˆÀ¾¿\"ˆÀÀÁ\"ˆÀÂÃ\"ˆÀÄÅ\"ˆÀÆÇ\"ˆÀÈÉ\"ˆÀÊÉ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"ˆÀãä\"ˆÀåæ\"ˆÀçè\"ˆÀéê\"ˆÀëì\"ˆÀíî\"ˆÀïð\"ˆÀñò\"ˆÀóô\"ˆÀõö\"ˆÀ÷ø\"ˆÀùú\"ˆÀûü\"ˆÀýþ\"ˆÀÿ\"ˆÀ\"ˆÀ\"‡" [ml-expansion defun "ml-defun" if "ml-if" setq (lambda nil (if (looking-at "setq[ \n]+buffer-modified-p") (replace-match "set-buffer-modified-p"))) arg "ml-arg" nargs "ml-nargs" interactive "ml-interactive" message "ml-message" print "ml-print" set "ml-set" set-default "ml-set-default" provide-prefix-argument "ml-provide-prefix-argument" prefix-argument-loop "ml-prefix-argument-loop" prefix-argument "ml-prefix-arg" use-local-map "ml-use-local-map" use-global-map "ml-use-global-map" modify-syntax-entry "ml-modify-syntax-entry" error-message "error" dot "point-marker" mark "mark-marker" beginning-of-file "beginning-of-buffer" end-of-file "end-of-buffer" exchange-dot-and-mark "exchange-point-and-mark" set-mark "set-mark-command" argument-prefix "universal-arg" previous-page "ml-previous-page" next-page "ml-next-page" next-window "ml-next-window" previous-window "ml-previous-window" newline "ml-newline" next-line "ml-next-line" previous-line "ml-previous-line" self-insert "self-insert-command" meta-digit "digit-argument" meta-minus "negative-argument" newline-and-indent "ml-newline-and-indent" yank-from-killbuffer "yank" yank-buffer "insert-buffer" copy-region "copy-region-as-kill" delete-white-space "delete-horizontal-space" widen-region "widen" forward-word (lambda nil (if (looking-at "forward-word[ \n]*)") (replace-match "forward-word 1)"))) backward-word (lambda nil (if (looking-at "backward-word[ \n]*)") (replace-match "backward-word 1)"))) forward-paren "forward-list" backward-paren "backward-list" search-reverse "ml-search-backward" re-search-reverse "ml-re-search-backward" search-forward "ml-search-forward" re-search-forward "ml-re-search-forward" quote "regexp-quote" re-query-replace "query-replace-regexp" re-replace-string "replace-regexp" get-tty-character "read-char" get-tty-input "read-input" get-tty-string "read-string" get-tty-buffer "read-buffer" get-tty-command "read-command" get-tty-variable "read-variable" get-tty-no-blanks-input "read-no-blanks-input" get-tty-key "read-key" concat "ml-concat" c= "char-equal" goto-character "goto-char" substr "ml-substr" variable-apropos "apropos" execute-mlisp-buffer "eval-current-buffer" execute-mlisp-file "load" visit-file "find-file" read-file write-modified-files "save-some-buffers" backup-before-writing "make-backup-files" write-file-exit "save-buffers-kill-emacs" write-named-file "write-file" change-file-name "set-visited-file-name" change-buffer-name "rename-buffer" buffer-exists "get-buffer" delete-buffer "kill-buffer" unlink-file "delete-file" unlink-checkpoint-files "delete-auto-save-files" file-exists "file-exists-p" write-current-file "save-buffer" change-directory "cd" temp-use-buffer "set-buffer" fast-filter-region "filter-region" pending-input "input-pending-p" execute-keyboard-macro "call-last-kbd-macro" start-remembering "start-kbd-macro" end-remembering "end-kbd-macro" define-keyboard-macro "name-last-kbd-macro" define-string-macro "ml-define-string-macro" current-column "ml-current-column" current-indent "ml-current-indent" insert-character "insert" users-login-name "user-login-name" users-full-name "user-full-name" current-time "current-time-string" current-numeric-time "current-numeric-time-you-lose" current-buffer-name "buffer-name" current-file-name "buffer-file-name" local-binding-of "local-key-binding" global-binding-of "global-key-binding" remove-key-binding "global-unset-key" remove-binding remove-local-binding "local-unset-key" remove-all-local-bindings "use-local-map nil" autoload "ml-autoload" checkpoint-frequency "auto-save-interval" mode-string "mode-name" right-margin "fill-column" tab-size "tab-width" default-right-margin "default-fill-column" default-tab-size "default-tab-width" buffer-is-modified "(buffer-modified-p)" file-modified-time "you-lose-on-file-modified-time" needs-checkpointing "you-lose-on-needs-checkpointing" lines-on-screen "set-frame-height" columns-on-screen "set-frame-width" dumped-emacs "t" buffer-size "ml-buffer-size" dot-is-visible "pos-visible-in-window-p" track-eol-on-^N-^P "track-eol" ctlchar-with-^ "ctl-arrow" help-on-command-completion-error "completion-auto-help" dump-stack-trace "backtrace" pause-emacs "suspend-emacs" compile-it "compile" != "/=" & "logand" | "logior" ^ "logxor" ! "ml-not" << "lsh"] 3) emacs-19.30/lisp/mldrag.elc100666 12120 1 6414 6045214064 14016 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:23:43 1995 ;;; from file /home/fsf/rms/e19/lisp/mldrag.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`mldrag.el' was compiled for Emacs 19.29 or later")) (provide (quote mldrag)) #@279 Change the height of the current window with the mouse. This command should be bound to a down-mouse- event, and is most usefully bound with the `mode-line' prefix. Holding down a mouse button and moving the mouse up and down will make the clicked-on window taller or shorter. (defalias 'mldrag-drag-mode-line #[(start-event) "ÀÁ A@@! A@@ÄÅ!Æ À‰‰‰‰‰‰‰‰‰‰ \n \f Ø ÎžA‰„WÙÅ!ƒWÚÛ!ˆÜŽÝ .‡" [nil 0 window-frame start-event count-windows t selected-window growth params wconfig edges bot top y minibuffer mouse event should-enlarge-minibuffer old-selected-window start-nwindows start-event-window start-event-frame echo-keystrokes done frame-parameters one-window-p error "Attempt to resize sole window" ((select-window old-selected-window)) (lambda nil (track-mouse (byte-code "À !ˆ\n…ÃÄ!?…Å\n!A@ÆÅ 8U?…èÉ \nË \f\n¨ƒ6ĉ‚\n@Í=„\n@Î>„Mĉ‚\f@=ƒ\fA@ƒ\fAAÅ ‰A@Æ8ZÔZWƒˆÔ\\\\ZÔZ× ƒÃÀ\n!ˆÙVƒ¶Ú\n!ZÛWƒ¶Ú\n!SÜ[!ˆÀ !ˆ‚ÈÜ!ˆÞÄ!Uƒà„Å A@U„ß!ˆ‚‡" [select-window start-event-window minibuffer one-window-p t window-edges 3 should-enlarge-minibuffer done read-event event mouse-position mouse switch-frame (mouse-movement scroll-bar-movement) start-event-frame y edges top bot -1 window-min-height growth current-window-configuration wconfig 0 window-height 1 enlarge-window start-nwindows count-windows set-window-configuration] 4)))] 17 (#$ . 498) "e"]) #@313 Change the width of the current window with the mouse. This command should be bound to a down-mouse- event, and is most usefully bound with the `vertical-line' or the `vertical-scroll-bar' prefix. Holding down a mouse button and moving the mouse left and right will make the clicked-on window thinner or wider. (defalias 'mldrag-drag-vertical-line #[(start-event) "ÀÁ A@@! A@@ÄÅ!Æ À‰‰‰‰‰‰‰ \n \f ÕÅ!ƒ?Ö×!ˆØÙ!8Ú!UƒQÖÛ!ˆÜŽÝ .‡" [nil 0 window-frame start-event count-windows t selected-window growth wconfig edges right left x mouse event old-selected-window start-nwindows start-event-window start-event-frame echo-keystrokes done one-window-p error "Attempt to resize sole ordinary window" 2 window-edges frame-width "Attempt to drag rightmost scrollbar" ((select-window old-selected-window)) (lambda nil (track-mouse (byte-code "À !ˆ\n?…–à Å \f¨ƒlj‚\f@È=„\f@É>„/lj‚@\n=ƒA@ƒA@ Ì ‰ @Ï 8 ZÑZWƒiÑ\\\\  ZÑZÔ ÖÇ\"ˆØÇ!UƒŽÌ @U„Ù!ˆ‚‡" [select-window start-event-window done read-event event mouse-position mouse t switch-frame (mouse-movement scroll-bar-movement) start-event-frame x window-edges edges left 2 right -1 window-min-width growth current-window-configuration wconfig enlarge-window start-nwindows count-windows set-window-configuration] 4)))] 14 (#$ . 1975) "e"]) emacs-19.30/lisp/mlsupport.elc100666 13437 1 23345 5744576776 15025 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:47:07 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mlsupport.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/mlsupport.el' was compiled for Emacs 19")) (defalias 'ml-defun '(macro . #[(&rest defs) "ÀÁ\nDD‡" [ml-defun-1 quote defs] 3])) (defalias 'ml-defun-1 #[(args) "…@@Á@ABMˆA‰„‡" [args mocklisp nil] 4]) (defalias 'declare-buffer-specific '(macro . #[(&rest vars) "ÀÁ \"B‡" [progn mapcar #[(var) "ÀÁ\nDD‡" [make-variable-buffer-local quote var] 3] vars] 4])) (defalias 'ml-set-default #[(varname value) "ÀÁ\n! \"‡" [set-default intern varname value] 3]) (defalias '>> #[(val count) "À \n[\"‡" [lsh val count] 3]) (defalias 'novalue #[nil "À‡" [nil] 1]) (defalias 'ml-not #[(arg) "ÁUƒ‡Á‡" [arg 0 1] 2]) (defalias 'provide-prefix-arg #[(arg form) "@ !‡" [form arg] 2]) (defalias 'define-keymap #[(name) "À ! M‡" [intern name make-keymap] 2]) (byte-code "ÀMˆÁ M‡" [esc-map ctl-x-map] 2) (defalias 'ml-use-local-map #[(name) "ÀÁ\nÃP!!‡" [use-local-map intern name "-map"] 4]) (defalias 'ml-use-global-map #[(name) "ÀÁ\nÃP!!‡" [use-global-map intern name "-map"] 4]) (defalias 'local-bind-to-key #[(name key) "À „\nÁ !ˆÃÀ \f¨ƒ+\fÅYƒ%Æ!Æ\fÅZ!P‚,Æ\f!‚,\fÈ !#‡" [current-local-map use-local-map make-keymap define-key key 128 char-to-string meta-prefix-char intern name] 6]) (defalias 'bind-to-key #[(name key) "À \n¨ƒ Ã\n!‚\nÄ !#‡" [define-key global-map key char-to-string intern name] 5]) (defalias 'ml-autoload #[(name file) "ÀÁ\n! \"‡" [autoload intern name file] 3]) (defalias 'ml-define-string-macro #[(name defn) "À !\nM‡" [intern name defn] 2]) (defalias 'push-back-character #[(char) "C‰‡" [char unread-command-events] 2]) (defalias 'to-col #[(column) "À Â\"‡" [indent-to column 0] 3]) (defalias 'is-bound '(macro . #[(&rest syms) "ÀÁ \"B‡" [and mapcar #[(sym) "ÀÁ\nDD‡" [boundp quote sym] 3] syms] 4])) (defalias 'declare-global '(macro . #[(&rest syms) "ÀÁ \"B‡" [progn mapcar #[(sym) "À ÂE‡" [defvar sym nil] 3] syms] 4])) (defalias 'error-occurred '(macro . #[(&rest body) "ÀÁÂÃ\fÅ\"BÆF‡" [condition-case nil progn append body (nil) (error t)] 6])) (defalias 'return-prefix-argument #[(value) "‰‡" [value prefix-arg] 2]) (defalias 'ml-prefix-argument #[nil "„Á‡<ƒ@‡Â=ƒÇ‡" [current-prefix-arg 1 - -1] 2]) (defalias 'ml-print #[(varname) "À !ƒÂÃÄ ! J#‡ÂÅÄ !\"‡" [boundp varname message "%s => %s" symbol-name "%s has no value"] 4 nil "vPrint variable: "]) (defalias 'ml-set #[(str val) "À !\nL‡" [intern str val] 2]) (defalias 'ml-message #[(&rest args) "ÀÁÂÃ\f\"\"‡" [message "%s" apply concat args] 5]) (defalias 'kill-to-end-of-line #[nil "Àlƒ Á``T\"‚Á`ÂÃÄÅ#ƒ`S‚d\"!‡" [ml-prefix-argument-loop kill-region search-forward 10 nil t] 7]) (defalias 'set-auto-fill-hook #[(arg) "À !‰‡" [intern arg auto-fill-function] 2]) (defalias 'auto-execute #[(function pattern) "ÁHÂU„\fÃÄ!ˆÅÆÇOÈQ B\nB‰\n‡" [pattern 0 42 error "Only patterns starting with * supported in auto-execute" "\\." 1 nil "\\'" function auto-mode-alist] 4]) (defalias 'move-to-comment-column #[nil "j‡" [comment-column] 1]) (defalias 'erase-region #[nil "`À |‡" [mark] 2]) (defalias 'delete-region-to-buffer #[(bufname) "À ` #ˆ` |‡" [copy-to-buffer bufname mark] 4]) (defalias 'copy-region-to-buffer #[(bufname) "À ` #‡" [copy-to-buffer bufname mark] 4]) (defalias 'append-region-to-buffer #[(bufname) "À ` #‡" [append-to-buffer bufname mark] 4]) (defalias 'prepend-region-to-buffer #[(bufname) "À ` #‡" [prepend-to-buffer bufname mark] 4]) (defalias 'delete-next-character #[nil "ÀÁ !‡" [delete-char ml-prefix-argument] 2]) (defalias 'delete-next-word #[nil "`À vˆ`|‡" [ml-prefix-argument] 2]) (defalias 'delete-previous-word #[nil "`ÀÁ !ˆ`|‡" [backward-word ml-prefix-argument] 3]) (defalias 'delete-previous-character #[nil "ÀÁ !‡" [delete-backward-char ml-prefix-argument] 2]) (defalias 'forward-character #[nil "À u‡" [ml-prefix-argument] 1]) (defalias 'backward-character #[nil "ÀÁ !‡" [backward-char ml-prefix-argument] 2]) (defalias 'ml-newline #[nil "ÀÁ !‡" [newline ml-prefix-argument] 2]) (defalias 'ml-next-line #[nil "ÀÁ !‡" [next-line ml-prefix-argument] 2]) (defalias 'ml-previous-line #[nil "ÀÁ !‡" [previous-line ml-prefix-argument] 2]) (defalias 'delete-to-kill-buffer #[nil "À`Á \"‡" [kill-region mark] 3]) (defalias 'narrow-region #[nil "`À }‡" [mark] 2]) (defalias 'ml-newline-and-indent #[nil "À Âà !ˆ j)‡" [current-indentation column newline ml-prefix-argument] 2]) (defalias 'newline-and-backup #[nil "ÀÁ !‡" [open-line ml-prefix-argument] 2]) (defalias 'quote-char #[nil "ÀÁ !‡" [quoted-insert ml-prefix-argument] 2]) (defalias 'ml-current-column #[nil "iT‡" [] 1]) (defalias 'ml-current-indent #[nil "À T‡" [current-indentation] 1]) (defalias 'region-around-match #[(&optional n) "À ”!ˆ •b‡" [set-mark n] 2]) (defalias 'region-to-string #[nil "`À ^`À ]{‡" [mark] 3]) (defalias 'use-abbrev-table #[(name) "À ÂP!Ä !„Å Æ\"ˆ J)‡" [intern name "-abbrev-table" symbol boundp define-abbrev-table nil] 3]) (defalias 'define-hooked-local-abbrev #[(name exp hook) "À \nÃ\f!#‡" [define-local-abbrev name exp intern hook] 5]) (defalias 'define-hooked-global-abbrev #[(name exp hook) "À \nÃ\f!#‡" [define-global-abbrev name exp intern hook] 5]) (defalias 'case-word-lower #[nil "ÀÁ!‡" [ml-casify-word downcase-region] 2]) (defalias 'case-word-upper #[nil "ÀÁ!‡" [ml-casify-word upcase-region] 2]) (defalias 'case-word-capitalize #[nil "ÀÁ!‡" [ml-casify-word capitalize-region] 2]) (defalias 'ml-casify-word #[(fun) "ŠÀuˆÁvˆ\n`à vˆ`\")‡" [1 -1 fun ml-prefix-argument] 3]) (defalias 'case-region-lower #[nil "À`Á \"‡" [downcase-region mark] 3]) (defalias 'case-region-upper #[nil "À`Á \"‡" [upcase-region mark] 3]) (defalias 'case-region-capitalize #[nil "À`Á \"‡" [capitalize-region mark] 3]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp saved-command-line-args nil current-load-list] 2) (defalias 'argc #[nil "„  G‡" [saved-command-line-args command-line-args nil] 1]) (defalias 'argv #[(i) "„  8‡" [saved-command-line-args command-line-args nil i] 2]) (defalias 'invisible-argc #[nil "† G‡" [saved-command-line-args command-line-args] 1]) (defalias 'invisible-argv #[(i) " †\n8‡" [i saved-command-line-args command-line-args] 2]) (defalias 'exit-emacs #[nil "ÀÁ‡" [nil (exit-recursive-edit) ((error (kill-emacs)))] 3 nil nil]) (defalias 'ml-buffer-size #[nil "deZ‡" [] 2]) (defalias 'previous-command #[nil "‡" [last-command] 1]) (defalias 'beginning-of-window #[nil "À b‡" [window-start] 1]) (defalias 'end-of-window #[nil "À bˆÁ ÃZ!‡" [window-start vertical-motion window-height 2] 3]) (defalias 'ml-search-forward #[(string) "À ‰à $‡" [search-forward string nil ml-prefix-argument] 5]) (defalias 'ml-re-search-forward #[(string) "À ‰à $‡" [re-search-forward string nil ml-prefix-argument] 5]) (defalias 'ml-search-backward #[(string) "À ‰à $‡" [search-backward string nil ml-prefix-argument] 5]) (defalias 'ml-re-search-backward #[(string) "À ‰à $‡" [re-search-backward string nil ml-prefix-argument] 5]) #@93 Mocklisp compatibility variable; 1 means use shell from SHELL env var. 0 means use /bin/sh. (defvar use-users-shell 1 (#$ . 7318)) #@68 Mocklisp compatibility variable; 1 means pass -f when calling csh. (defvar use-csh-option-f 1 (#$ . 7455)) (defalias 'filter-region #[(command) "ÁU„\n\n‚ ÃÄ !ÆšÈ`É Ê‰Ëƒ)\fƒ)Í‚*ÎÏP&*‡" [use-users-shell 0 shell-file-name "/bin/sh" file-name-nondirectory shell "csh" csh call-process-region mark t nil use-csh-option-f "-cf" "-c" "exec " command] 10]) (defalias 'execute-monitor-command #[(command) "ÁU„\n\n‚ ÃÄ !ÆšÈ Éʉƒ& ƒ&Ì‚'ÍÎP&*‡" [use-users-shell 0 shell-file-name "/bin/sh" file-name-nondirectory shell "csh" csh call-process nil t use-csh-option-f "-cf" "-c" "exec " command] 8]) (defalias 'use-syntax-table #[(name) "ÀÁ\nÃP!J!‡" [set-syntax-table intern name "-syntax-table"] 4]) (defalias 'line-to-top-of-window #[nil "ÀÁ S!‡" [recenter ml-prefix-argument] 2]) (defalias 'ml-previous-page #[(&optional arg) "†Á ‰ÃVƒÄÅ!ˆ\nS‰‚\nÃW…)ÆÅ!ˆ\nT‰‚)‡" [arg ml-prefix-argument count 0 scroll-down nil scroll-up] 3]) (defalias 'ml-next-page #[nil "ÀÁ [!‡" [previous-page ml-prefix-argument] 2]) (defalias 'page-next-window #[(&optional arg) "†Á ‰ÃVƒÄÅ!ˆ\nS‰‚\nÃW…)ÄÆ!ˆ\nT‰‚)‡" [arg ml-prefix-argument count 0 scroll-other-window nil -] 3]) (defalias 'ml-next-window #[nil "ÀÁ !‡" [select-window next-window] 2]) (defalias 'ml-previous-window #[nil "ÀÁ !‡" [select-window previous-window] 2]) (defalias 'scroll-one-line-up #[nil "ÀÁ !‡" [scroll-up ml-prefix-argument] 2]) (defalias 'scroll-one-line-down #[nil "ÀÁ !‡" [scroll-down ml-prefix-argument] 2]) (defalias 'split-current-window #[nil "ÀÁ !‡" [split-window selected-window] 2]) (defalias 'last-key-struck #[nil "‡" [last-command-char] 1]) (defalias 'execute-mlisp-line #[(string) "ÀÁ\n!!‡" [eval read string] 3]) (defalias 'move-dot-to-x-y #[(x y) "ÀÁ !bˆÂ S!ˆÄ S!‡" [window-start selected-window vertical-motion y move-to-column x] 2]) (defalias 'ml-modify-syntax-entry #[(string) "À G ÂÃO ÂHÇUƒ\fÂÈIˆ ÃHÉUƒ4 ÊHÈUƒ0\fÂËIˆ‚4ÌÍ!ˆ ÎHÏUƒP ÊHÈUƒL\fÂÐIˆ‚PÌÍ!ˆ W…¡Ñ H\f\"ˆT‰ WƒP HÇUƒP SH TH‰Xƒ—Ñ\f\"ˆT‰‚‚Ã\\*‚P+‡" [5 string 0 2 datastring len i 45 32 123 4 60 error "Two-char comment delimiter: use modify-syntax-entry directly" 3 125 62 modify-syntax-entry lim c] 6]) (defalias 'ml-substr #[(string from to) "G\nÃWƒ \n \\\fÃWƒ\f \\\n‰\f\\O)‡" [string length from 0 to] 4]) (defalias 'ml-concat #[(&rest args) "À‰ ƒ @‰§ƒÄ ! \nB A‰„ÅÆ\nŸ\"*‡" [nil this newargs args number-to-string apply concat] 4]) (provide (quote mlsupport)) emacs-19.30/lisp/modula2.elc100666 13437 1 22102 6021171331 14250 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Aug 30 19:22:55 1995 ;;; from file /home/fsf/rms/e19/lisp/modula2.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`modula2.el' was compiled for Emacs 19.29 or later")) #@42 Syntax table in use in Modula-2 buffers. (defvar m2-mode-syntax-table nil (#$ . 469)) #@38 Command to compile Modula-2 programs (defvar m2-compile-command "m2c" (#$ . 561)) #@35 Command to link Modula-2 programs (defvar m2-link-command "m2l" (#$ . 649)) #@25 Name of the executable. (defvar m2-link-name nil (#$ . 731)) (byte-code "„LÁ ÃÄÅ\n#ˆÃÆÇ\n#ˆÃÈÉ\n#ˆÃÊË\n#ˆÃÌÍ\n#ˆÃÎÍ\n#ˆÃÏÍ\n#ˆÃÐÍ\n#ˆÃÑÍ\n#ˆÃÒÍ\n#ˆÃÓÔ\n#ˆ\n)Á‡" [m2-mode-syntax-table make-syntax-table table modify-syntax-entry 92 "\\" 40 ". 1" 41 ". 4" 42 ". 23" 43 "." 45 61 37 60 62 39 "\""] 4) #@31 Keymap used in Modula-2 mode. (defvar m2-mode-map nil (#$ . 1038)) (byte-code "„¸Á Ã\nÄÅ#ˆÃ\nÆÇ#ˆÃ\nÈÉ#ˆÃ\nÊË#ˆÃ\nÌÍ#ˆÃ\nÎÏ#ˆÃ\nÐÑ#ˆÃ\nÒÓ#ˆÃ\nÔÕ#ˆÃ\nÖ×#ˆÃ\nØÙ#ˆÃ\nÚÛ#ˆÃ\nÜÝ#ˆÃ\nÞß#ˆÃ\nàá#ˆÃ\nâã#ˆÃ\näå#ˆÃ\næç#ˆÃ\nèé#ˆÃ\nêë#ˆÃ\nìí#ˆÃ\nîï#ˆÃ\nðñ#ˆÃ\nòó#ˆÃ\nôõ#ˆÃ\nö÷#ˆÃ\nøù#ˆÃ\núû#ˆÃ\nüý#ˆ\n)Á‡" [m2-mode-map make-sparse-keymap map define-key " " m2-tab "b" m2-begin "c" m2-case "d" m2-definition "e" m2-else "f" m2-for "h" m2-header "i" m2-if "m" m2-module "l" m2-loop "o" m2-or "p" m2-procedure "" m2-with "r" m2-record "s" m2-stdio "t" m2-type "u" m2-until "v" m2-var "w" m2-while "x" m2-export "y" m2-import "{" m2-begin-comment "}" m2-end-comment "\n" m2-newline "" suspend-emacs "" m2-visit "" m2-toggle "\f" m2-link "" m2-compile] 4) #@55 *This variable gives the indentation in Modula-2-Mode (defvar m2-indent 5 (#$ . -1818)) #@1074 This is a mode intended to support program development in Modula-2. All control constructs of Modula-2 can be reached by typing C-c followed by the first character of the construct. \ \[m2-begin] begin \[m2-case] case \[m2-definition] definition \[m2-else] else \[m2-for] for \[m2-header] header \[m2-if] if \[m2-module] module \[m2-loop] loop \[m2-or] or \[m2-procedure] procedure Control-c Control-w with \[m2-record] record \[m2-stdio] stdio \[m2-type] type \[m2-until] until \[m2-var] var \[m2-while] while \[m2-export] export \[m2-import] import \[m2-begin-comment] begin-comment \[m2-end-comment] end-comment \[suspend-emacs] suspend Emacs \[m2-toggle] toggle \[m2-compile] compile \[m2-next-error] next-error \[m2-link] link `m2-indent' controls the number of spaces for each indentation. `m2-compile-command' holds the command to compile a Modula-2 program. `m2-link-command' holds the command to link a Modula-2 program. (defalias 'modula-2-mode #[nil "À ˆÁ\n!ˆÃÅÇÈ!ˆÉÇÊ!ˆË\nÌ !ˆÇÎ!ˆÏPÇÑ!ˆÇÒ!ˆÓÇÔ!ˆÓÇÕ!ˆÖÇ×!ˆØÇÈ!ˆÉÇÙ!ˆÚÇÛ!ˆÜÇÝ!ˆÓÞß!‡" [kill-all-local-variables use-local-map m2-mode-map modula-2-mode major-mode "Modula-2" mode-name make-local-variable comment-column 41 end-comment-column 75 set-syntax-table m2-mode-syntax-table paragraph-start "$\\|" page-delimiter paragraph-separate paragraph-ignore-fill-prefix t require-final-newline comment-start "(* " comment-end " *)" comment-start-skip "/\\*+ *" comment-indent-function c-comment-indent parse-sexp-ignore-comments run-hooks m2-mode-hook] 2 (#$ . 1914) nil]) #@64 Insert a newline and indent following line like previous line. (defalias 'm2-newline #[nil "À  ˆ j)‡" [current-indentation hpos newline] 1 (#$ . 3623) nil]) #@26 Indent to next tab stop. (defalias 'm2-tab #[nil "À ¥T _j‡" [current-indentation m2-indent] 2 (#$ . 3788) nil]) #@54 Insert a BEGIN keyword and indent for the next line. (defalias 'm2-begin #[nil "ÀcˆÁ ˆÂ ‡" ["BEGIN" m2-newline m2-tab] 1 (#$ . 3907) nil]) #@63 Build skeleton CASE statment, prompting for the . (defalias 'm2-case #[nil "ÀÁ!Ã\nıˆÅ ˆÅ ˆÆ\nDZˆ)ÈˆÉ ‡" [read-string "Case-Expression: " name "CASE " " OF" m2-newline "END (* case " " *);" 0 m2-tab] 3 (#$ . 4052) nil]) #@68 Build skeleton DEFINITION MODULE, prompting for the . (defalias 'm2-definition #[nil "ÀcˆÁÂ!‰Ä űˆ)ÆÇ!‡" ["DEFINITION MODULE " read-string "Name: " name ";\n\n\n\nEND " ".\n" previous-line 3] 5 (#$ . 4294) nil]) #@47 Insert ELSE keyword and indent for next line. (defalias 'm2-else #[nil "À ˆÁ\nÃ\"ˆÄcˆÀ ˆÅ ‡" [m2-newline backward-delete-char-untabify m2-indent nil "ELSE" m2-tab] 3 (#$ . 4527) nil]) #@70 Build skeleton FOR loop statment, prompting for the loop parameters. (defalias 'm2-for #[nil "ÀcˆÁÂ!ɉDZˆÁÈ!‰cˆÁÉ!‰ʘ„'Ë\f±ˆÌcˆÍ ˆÍ ˆÎÏ Ð±ˆ+ÑˆÒ ‡" ["FOR " read-string "Loop Initialiser: " nil by limit name " TO " "Limit: " "Step: " "" " BY " " DO" m2-newline "END (* for " " to " " *);" 0 m2-tab] 6 (#$ . 4717) nil]) #@66 Insert a comment block containing the module title, author, etc. (defalias 'm2-header #[nil "ÀcˆÁÂ!cˆÃcˆÄ cˆÅcˆÆ cˆÇÈ ÉÊ Ë°cˆÌc‡" ["(*\n Title: " read-string "Title: " "\n Created: " current-time-string "\n Author: " user-full-name "\n <" user-login-name "@" system-name ">\n" "*)\n\n"] 5 (#$ . 5054) nil]) #@66 Insert skeleton IF statment, prompting for . (defalias 'm2-if #[nil "ÀcˆÁÂ!‰ıˆÅ ˆÅ ˆÆ DZˆ)ÈˆÉ ‡" ["IF " read-string ": " thecondition " THEN" m2-newline "END (* if " " *);" 0 m2-tab] 4 (#$ . 5380) nil]) #@33 Build skeleton LOOP (with END). (defalias 'm2-loop #[nil "ÀcˆÁ ˆÁ ˆÂcˆÃˆÄ ‡" ["LOOP" m2-newline "END (* loop *);" 0 m2-tab] 1 (#$ . 5634) nil]) #@68 Build skeleton IMPLEMENTATION MODULE, prompting for . (defalias 'm2-module #[nil "ÀcˆÁÂ!‰Ä űˆÆÇ!ˆÈ ˆÉ ˆÊ ˆË ˆÊ ˆÌ ˆÍ ˆÎ ϱˆ)Ð ˆÊ ˆÑ ‡" ["IMPLEMENTATION MODULE " read-string "Name: " name ";\n\n\n\nEND " ".\n" previous-line 3 m2-header m2-type newline m2-var m2-begin m2-begin-comment " Module " " Initialisation Code " m2-end-comment m2-tab] 5 (#$ . 5785) nil]) (defalias 'm2-or #[nil "À ˆÁ\n!ˆÃcˆÀ ˆÄ ‡" [m2-newline backward-delete-char-untabify m2-indent "|" m2-tab] 2 nil nil]) (defalias 'm2-procedure #[nil "ÀcˆÁÂ!ÉƱˆÁÇ!ȱˆÁÉ!‰ʘ„$Ë\f±ˆÌcˆÍ ˆÎcˆÍ ˆÍ ˆÏcˆ cˆÌcˆÐˆÑ *‡" ["PROCEDURE " read-string "Name: " nil args name " (" "Arguments: " ")" "Result Type: " "" " : " ";" m2-newline "BEGIN" "END " 0 m2-tab] 3 nil nil]) (defalias 'm2-with #[nil "ÀcˆÁÂ!‰cˆÄcˆÅ ˆÅ ˆÆ DZˆ)ÈˆÉ ‡" ["WITH " read-string "Record-Type: " name " DO" m2-newline "END (* with " " *);" 0 m2-tab] 4 nil nil]) (defalias 'm2-record #[nil "ÀcˆÁ ˆÁ ˆÂcˆÃˆÄ ‡" ["RECORD" m2-newline "END (* record *);" 0 m2-tab] 1 nil nil]) (defalias 'm2-stdio #[nil "Àc‡" ["\nFROM TextIO IMPORT \n WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,\n WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,\n WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,\n WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,\n WriteString, ReadString, WhiteSpace, EndOfLine;\n\nFROM SysStreams IMPORT sysIn, sysOut, sysErr;\n\n"] 1 nil nil]) (defalias 'm2-type #[nil "ÀcˆÁ ˆÂ ‡" ["TYPE" m2-newline m2-tab] 1 nil nil]) (defalias 'm2-until #[nil "ÀcˆÁ ˆÁ ˆÂcˆÃÄ!űˆÆˆÇ ‡" ["REPEAT" m2-newline "UNTIL " read-string ": " ";" 0 m2-tab] 2 nil nil]) (defalias 'm2-var #[nil "À ˆÁcˆÀ ˆÂ ‡" [m2-newline "VAR" m2-tab] 1 nil nil]) (defalias 'm2-while #[nil "ÀcˆÁÂ!‰ıˆÅ ˆÅ ˆÆ DZˆ)ÈˆÉ ‡" ["WHILE " read-string ": " name " DO" m2-newline "END (* while " " *);" 0 m2-tab] 4 nil nil]) (defalias 'm2-export #[nil "Àc‡" ["EXPORT QUALIFIED "] 1 nil nil]) (defalias 'm2-import #[nil "ÀcˆÁÂ!cˆÃc‡" ["FROM " read-string "Module: " " IMPORT "] 2 nil nil]) (defalias 'm2-begin-comment #[nil "n„ À Â\"ˆÃc‡" [indent-to comment-column 0 "(* "] 3 nil nil]) (defalias 'm2-end-comment #[nil "n„jˆÁc‡" [end-comment-column "*)"] 1 nil nil]) (defalias 'm2-compile #[nil "À Â Ä Q!‡" [buffer-name modulename compile m2-compile-command " "] 4 nil nil]) (defalias 'm2-link #[nil "À \nƒÃ\fÅ\nQ!‡Ã\fÅÆÇ \"‰Q!‡" [buffer-name modulename m2-link-name compile m2-link-command " " read-string "Name of executable: "] 6 nil nil]) (defalias 'm2-execute-monitor-command #[(command) " !ÚÅ ÆljÈÉ\nP&*‡" [shell-file-name shell file-name-nondirectory "csh" csh call-process nil t "-cf" "exec " command] 8]) (defalias 'm2-visit #[nil "À‰‰ŠÄÅ!ÆÇ!ˆÈÉ P!ˆebˆÀÊˈÀÌ͈ „/\n„/ÎÏ \"ˆ) ƒDÐ !ˆ\n…KŠÐ\n!)‚K\n…KÐ\n!+‡" [nil modulename modfile deffile read-string "Module name: " switch-to-buffer "*Command Execution*" m2-execute-monitor-command "m2whereis " (byte-code "ÀÁ!ˆÂ”•{À‡" [re-search-forward "\\(.*\\.def\\) *$" 1 deffile] 2) ((search-failed)) (byte-code "ÀÁ!ˆÂ”•{À‡" [re-search-forward "\\(.*\\.mod\\) *$" 1 modfile] 2) ((search-failed)) error "I can find neither definition nor implementation of %s" find-file] 3 nil nil]) #@52 Toggle between .mod and .def files for the module. (defalias 'm2-toggle #[nil "À ÁÂO؃ÄÀ ÅÁOÆP!‡À ÁÂOƘƒ(ÄÀ ÅÁOÃP!‡À ÇÂOȘƒ<ÄÀ ÅÇOÉP!‡À ÇÂOɘ…OÄÀ ÅÇOÈP!‡" [buffer-name -4 nil ".def" find-file-other-window 0 ".mod" -3 ".mi" ".md"] 4 (#$ . 9025) nil]) emacs-19.30/lisp/mouse-sel.elc100666 12120 1 32440 6052425624 14503 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 15 13:03:32 1995 ;;; from file /home/fsf/rms/e19/lisp/mouse-sel.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`mouse-sel.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!ˆÂÄ!‡" [provide mouse-sel require mouse thingatpt] 2) #@235 *Leave point near last mouse position. If non-nil, \[mouse-select] and \[mouse-extend] will leave point at the end of the region nearest to where the mouse last was. If nil, point will always be placed at the beginning of the region. (defvar mouse-sel-leave-point-near-mouse t (#$ . -550)) #@70 *If non-nil, \[mouse-select] cycles the click-counts after 4 clicks. (defvar mouse-sel-cycle-clicks t (#$ . -846)) #@74 Set to nil before loading `mouse-sel' to prevent default mouse bindings. (defvar mouse-sel-default-bindings t (#$ . 967)) #@46 Type of PRIMARY selection in current buffer. (defvar mouse-sel-primary-thing nil (#$ . 1095)) (make-variable-buffer-local (quote mouse-sel-primary-thing)) #@48 Type of SECONDARY selection in current buffer. (defvar mouse-sel-secondary-thing nil (#$ . 1256)) (byte-code "ÀÁ!ˆÂ !„Äʼn\"Æ ÇÈ#ˆÀ‡" [make-variable-buffer-local mouse-sel-secondary-thing overlayp mouse-secondary-overlay make-overlay 1 overlay-put face secondary-selection] 4) #@386 Alist associating selections with variables. Each element is of the form: (SELECTION-NAME OVERLAY-SYMBOL SELECTION-THING-SYMBOL) where SELECTION-NAME = name of selection OVERLAY-SYMBOL = name of variable containing overlay to use SELECTION-THING-SYMBOL = name of variable where the current selection type for this selection should be stored. (defconst mouse-sel-selection-alist (quote ((PRIMARY mouse-drag-overlay mouse-sel-primary-thing) (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing))) (#$ . 1542)) #@146 Function to call to set selection. Called with two arguments: SELECTION, the name of the selection concerned, and VALUE, the text to store. (defvar mouse-sel-set-selection-function (byte-code "ÀÁ!…Á‡" [fboundp x-set-selection] 2) (#$ . 2108)) #@118 Function to call to get the selection. Called with one argument: SELECTION: the name of the selection concerned. (defvar mouse-sel-get-selection-function (byte-code "ÀÁ!…Á‡" [fboundp x-get-selection] 2) (#$ . 2365)) #@519 Determine what `thing' `mouse-sel' should operate on. The first argument is NCLICKS, is the number of consecutive mouse clicks at the same position. Double-clicking on word constituents selects words. Double-clicking on symbol constituents selects symbols. Double-clicking on quotes or parentheses selects sexps. Double-clicking on whitespace selects whitespace. Triple-clicking selects lines. Quad-clicking selects paragraphs. Feel free to re-define this function to support your own desired multi-click semantics. (defalias 'mouse-sel-determine-selection-thing #[(nclicks) "`f‰… z\nƒ SĦT ÅUƒÆ‚W ÇUƒ(È‚W ÄYƒ2É‚W Ê>ƒ<Ë‚WÌ>ƒFÍ‚W Î=ƒPÏ‚W Ð=…WÑ*‡" [next-char char-syntax mouse-sel-cycle-clicks nclicks 4 1 nil 3 line paragraph (40 41 34 39) sexp (32 9 10) whitespace 95 symbol 119 word] 3 (#$ . 2594)]) #@39 Set the specified SELECTION to VALUE. (defalias 'mouse-sel-set-selection #[(selection value) "ƒ  \n\"‡ÃÄ \n#‡" [mouse-sel-set-selection-function selection value put mouse-sel-internal-selection] 4 (#$ . 3425)]) #@43 Get the value of the specified SELECTION. (defalias 'mouse-sel-get-selection #[(selection) "ƒ !‡Â N‡" [mouse-sel-get-selection-function selection mouse-sel-internal-selection] 2 (#$ . 3645)]) #@44 Return overlay corresponding to SELECTION. (defalias 'mouse-sel-selection-overlay #[(selection) "À \n\"A@‰„ÄÅ \"ˆ J)‡" [assoc selection mouse-sel-selection-alist symbol error "No overlay corresponding to %s selection"] 4 (#$ . 3847)]) #@44 Return overlay corresponding to SELECTION. (defalias 'mouse-sel-selection-thing #[(selection) "ÀÁ\n \"8‰„ÅÆ\n\"ˆ\f)‡" [2 assoc selection mouse-sel-selection-alist symbol error "No symbol corresponding to %s selection"] 5 (#$ . 4091)]) #@225 Convert region to PRIMARY overlay and deactivate region. Argument ORIG-WINDOW specifies the window the cursor was in when the originating command was issued, and is used to determine whether the region was visible or not. (defalias 'mouse-sel-region-to-primary #[(orig-window) "…>ÁÂ!\fƒ$ „Ç =ƒ$È É Ê p$ˆ‚:Ç =ƒ6È ``p$ˆ‚:Ë !ˆÌ‰)‡" [transient-mark-mode mouse-sel-selection-overlay PRIMARY overlay mark-active highlight-nonselected-windows orig-window selected-window move-overlay region-beginning region-end delete-overlay nil] 5 (#$ . 4336)]) #@205 Convert PRIMARY overlay to region. Optional argument DIRECTION specifies the mouse drag direction: a value of 1 indicates that the mouse was dragged left-to-right, otherwise it was dragged right-to-left. (defalias 'mouse-sel-primary-to-region #[(&optional direction) "ÀÁ!Ã\n!Å\n!\f=ƒ*\fƒ\fbˆƒMÈ ÊË!ˆ‚M\fƒC Î=ƒCbˆÏ\fÐÑ#ˆ‚M\fbˆÏÐÑ#ˆ…UÒ\n!+‡" [mouse-sel-selection-overlay PRIMARY overlay overlay-start start overlay-end end transient-mark-mode nil mark-active run-hooks deactivate-mark-hook mouse-sel-leave-point-near-mouse direction 1 push-mark nomsg active delete-overlay] 4 (#$ . 4901)]) #@124 Evaluate forms at mouse position. Move to the end position of EVENT, execute FORMS, and restore original point and window. (defalias 'mouse-sel-eval-at-event-end '(macro . #[(event &rest forms) "ÀÁ DDCÄÁÅ DEÆÀÇÈÉÊËÌÍBÏBB¯¯‡" [let posn event-end event if mouse-minibuffer-check (if (and posn (not (windowp (posn-window posn)))) (error "Cursor not in text area of window")) (orig-window orig-point-marker) (setq orig-window (selected-window)) (if posn (select-window (posn-window posn))) (setq orig-point-marker (point-marker)) (if (and posn (numberp (posn-point posn))) (goto-char (posn-point posn))) unwind-protect progn forms ((goto-char (marker-position orig-point-marker)) (move-marker orig-point-marker nil) (select-window orig-window))] 13 (#$ . 5522)])) (put (quote mouse-sel-eval-at-event-end) (quote lisp-indent-hook) 1) #@392 Set region/selection using the mouse. Click sets point & mark to click position. Dragging extends region/selection. Multi-clicking selects word/lines/paragraphs, as determined by 'mouse-sel-determine-selection-thing. Clicking mouse-2 while selecting copies selected text to the kill-ring. Clicking mouse-1 or mouse-3 kills the selected text. This should be bound to a down-mouse event. (defalias 'mouse-select #[(event) "ÀÂŽÃÄ \"‰*‡" [nil direction ((mouse-sel-primary-to-region direction)) mouse-select-internal PRIMARY event] 3 (#$ . 6363) "@e"]) #@426 Set secondary selection using the mouse. Click sets the start of the secondary selection to click position. Dragging extends the secondary selection. Multi-clicking selects word/lines/paragraphs, as determined by 'mouse-sel-determine-selection-thing. Clicking mouse-2 while selecting copies selected text to the kill-ring. Clicking mouse-1 or mouse-3 kills the selected text. This should be bound to a down-mouse event. (defalias 'mouse-select-secondary #[(event) "ÀÁ\n\"‡" [mouse-select-internal SECONDARY event] 3 (#$ . 6926) "e"]) #@32 Set SELECTION using the mouse. (defalias 'mouse-select-internal #[(selection event) "Á8:ƒ Á‚Â8)‰ƒÄ!ˆ ƒ-Å ‰@)!„-ÇÈ!ˆÉ‰\n Ì  ƒDÍ ‰@)!ˆÎ \n ƒ€ ‰A@:ƒ^A@@‚bA@)§ƒ€ ‰A@:ƒyA@@‚}A@)bˆÏŽÐ!Ò!‰ÕÁ8¨ƒŸÁ8‚ Â)!LˆÖJ!‰ƒ¾Ø@Ap$ˆ‚ÆØ``p$ˆ+Ù!,‡" [event 2 1 posn mouse-minibuffer-check windowp position error "Cursor not in text area of window" nil orig-point-marker orig-window selected-window select-window point-marker ((byte-code "À !bˆ ‰“ˆÃ\f!‡" [marker-position orig-point-marker nil select-window orig-window] 3)) mouse-sel-selection-thing selection mouse-sel-selection-overlay overlay thing-symbol mouse-sel-determine-selection-thing bounds-of-thing-at-point object-bounds move-overlay mouse-extend-internal] 6 (#$ . 7471)]) #@42 Extend region/selection using the mouse. (defalias 'mouse-extend #[(event) "À ÁÄ Æ 8:ƒÆ‚Ç 8)‰@)!ˆÉŽÊ !ˆËÌ \"‰+‡" [selected-window nil direction orig-window select-window event 2 1 position ((mouse-sel-primary-to-region direction)) mouse-sel-region-to-primary mouse-extend-internal PRIMARY] 4 (#$ . 8258) "e"]) #@45 Extend secondary selection using the mouse. (defalias 'mouse-extend-secondary #[(event) "À‹‡" [((byte-code "ÀÁ\n\"‡" [mouse-extend-internal SECONDARY event] 3))] 1 (#$ . 8584) "e"]) #@258 Extend specified SELECTION using the mouse. Track mouse-motion events, adjusting the SELECTION appropriately. Optional argument INITIAL-EVENT specifies an initial down-mouse event to process. See documentation for mouse-select-internal for more details. (defalias 'mouse-extend-internal #[(selection &optional initial-event) " 8:ƒ ‚à 8)‰ƒÅ!ˆ\fƒ-Æ\f‰@)!„-ÈÉ!ˆÊ‰ \fÍ \f\fƒDÎ\f‰@)!ˆÏ  \fƒ€\f‰A@:ƒ^A@@‚bA@)§ƒ€\f‰A@:ƒyA@@‚}A@)bˆÐŽÑÒÓÔ !\"AÖŽ×!Ú!Í \fÜ\f!Þ\f!A@àÞ\f!8!Ê\"ã$Ê%Ê&Ê'Êè!p=ƒÝé!%ê!&‚è`‰%&ÊLˆëì!ƒôìÔ í\"ˆî ˆé!ê!*‰)*=„ï)*{\"ˆÊ0ñ2!ó=ƒ0ô)*\"ˆõ ˆõ ˆ‚{ñ2!ö>ƒZ÷ø2!>ƒZù)*\"ˆú)‰#ˆõ ˆõ ˆ‚{ñ2!û=ƒ{üø2!>ƒ{ù)*\"ˆú)‰#ˆ+'.‡" [initial-event event 2 1 posn mouse-minibuffer-check windowp position error "Cursor not in text area of window" nil orig-point-marker orig-window selected-window select-window point-marker ((byte-code "À !bˆ ‰“ˆÃ\f!‡" [marker-position orig-point-marker nil select-window orig-window] 3)) assoc cursor-type frame-parameters selected-frame orig-cursor-type ((byte-code "ÀÁ!ƒÁ Ã\fBC\"ˆÀ‡" [fboundp modify-frame-parameters selected-frame cursor-type orig-cursor-type] 4)) mouse-sel-selection-thing selection thing-symbol mouse-sel-selection-overlay overlay window-frame orig-window-frame window-edges top 3 bottom mark-active 0 echo-keystrokes min max direction overlay-buffer overlay-start overlay-end fboundp modify-frame-parameters ((cursor-type . bar)) (lambda nil (track-mouse (byte-code "ƒ\f‰Â‚à ‰:…™ @Ä>…™ J Æ 8:ƒ*Æ‚+Ç 8) ¢Ê=„‰ @)ƒe‰ @)\fÍ\f!ƒZÎ\f!‚\\\f)Î!=ƒ‰ @)=„½Ð AA‰ƒ™o„™Wƒ™ÓZ$ˆ‚¹ƒ¹m„¹Yƒ¹ÓZT$ˆ)‚‰ A@:ƒÐ A@@‚Ô A@)Ø=ƒçÓÇ$ˆ‚‰ A@:ƒú A@@‚þ A@)bˆ„$=„$`\\Æ¥WƒÚ‚Ç‚IÚ=„8`Xƒ8Ú‚IÇ=„I`YƒIÇ ƒuÇ=ƒ\\m„\\Çuˆ`Ç=ƒk‚mbˆÂÜ݈)ÞÇ=ƒ„‚…`Ú=ƒ‘‚’`p$ˆ*‚‡" [initial-event event nil read-event (mouse-movement switch-frame) thing-symbol 2 1 end selection-thing switch-frame position posn-w windowp window-frame orig-window mouse-position end-row top mouse-scroll-subr overlay max bottom min mode-line direction -1 goal (byte-code " `Z_ÂVƒÃ\f\"ˆ‚`Ã\f[\"ˆ `Z_ÂVƒ( ‚)`bˆ)‡" [direction goal 0 forward-thing selection-thing end] 3) ((error)) move-overlay] 6))) mouse-sel-set-selection this-command event-basic-type last-input-event mouse-2 copy-region-as-kill read-event (mouse-1 mouse-3) down event-modifiers kill-region move-overlay mouse-3 double] 5 (#$ . 8773)]) #@124 Insert the contents of the PRIMARY selection at mouse click. If `mouse-yank-at-point' is non-nil, insert at point instead. (defalias 'mouse-insert-selection #[(event) "ÀÁ\n\"‡" [mouse-insert-selection-internal PRIMARY event] 3 (#$ . 11347) "e"]) #@126 Insert the contents of the SECONDARY selection at mouse click. If `mouse-yank-at-point' is non-nil, insert at point instead. (defalias 'mouse-insert-secondary #[(event) "ÀÁ\n\"‡" [mouse-insert-selection-internal SECONDARY event] 3 (#$ . 11600) "e"]) #@122 Insert the contents of the named SELECTION at mouse click. If `mouse-yank-at-point' is non-nil, insert at point instead. (defalias 'mouse-insert-selection-internal #[(selection event) "„Á\n!ˆ …Ä`Å\"ˆ !†Çc‡" [mouse-yank-at-point mouse-set-point event mouse-sel-get-selection-function push-mark nomsg selection ""] 3 (#$ . 11857)]) #@42 Remove the overlay for a lost selection. (defalias 'mouse-sel-lost-selection-hook #[(selection) "À !Ã\n!)‡" [mouse-sel-selection-overlay selection overlay delete-overlay] 2 (#$ . 12202)]) (byte-code "ÀÁÂ\"ˆ ƒKÄÅ!ˆÄÆ!ˆÄÇ!ˆÈÉÊ\"ˆÈËÌ\"ˆÄÍ!ˆÄÎ!ˆÄÏ!ˆÈÐÑ\"ˆÈÒÓ\"ˆ Ô=„FÈÕÖ\"ˆ××ÈÚÛ\"ˆÜÝBׇ" [add-hook x-lost-selection-hooks mouse-sel-lost-selection-hook mouse-sel-default-bindings global-unset-key [mouse-1] [drag-mouse-1] [mouse-3] global-set-key [down-mouse-1] mouse-select [down-mouse-3] mouse-extend [M-mouse-1] [M-drag-mouse-1] [M-mouse-3] [M-down-mouse-1] mouse-select-secondary [M-down-mouse-3] mouse-extend-secondary interprogram-cut-paste [mouse-2] mouse-insert-selection nil interprogram-cut-function interprogram-paste-function [M-mouse-2] mouse-insert-secondary "mikew@gopher.dosli.govt.nz" mouse-sel-maintainer-address current-load-list] 3) #@47 Submit a bug report on mouse-sel.el via mail. (defalias 'mouse-sel-submit-bug-report #[nil "ÀÁ!ˆÂ ÄÅÆdžÈPÉÊËÌÍÎÏÐѯ #‡" [require reporter reporter-submit-bug-report mouse-sel-maintainer-address "mouse-sel.el " nil mouse-sel-version ((error)) "(distributed with Emacs)" transient-mark-mode delete-selection-mode mouse-sel-default-bindings mouse-sel-leave-point-near-mouse mouse-sel-cycle-clicks mouse-sel-selection-alist mouse-sel-set-selection-function mouse-sel-get-selection-function mouse-yank-at-point] 12 (#$ . 13067) nil]) emacs-19.30/lisp/mouse.elc100666 13437 13 67254 6054601215 13621 0ustar jimbuser;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 22 05:58:26 1995 ;;; from file /home/fsf/rms/e19/lisp/mouse.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`mouse.el' was compiled for Emacs 19.29 or later")) (put (quote track-mouse) (quote lisp-indent-function) 0) #@69 *If non-nil, mouse yank commands yank at point instead of at click. (defvar mouse-yank-at-point nil (#$ . -525)) #@48 Pop up a mode-specific menu of mouse commands. (defalias 'mouse-major-mode-menu #[(event) "À CÄ Å @!ÀÆ!ÇÈ …ÉÈ Ê\"!¤#ˆË !ˆÌ B B ÎÏЉ…9É \"‰…CÓ!-‡" [make-sparse-keymap event unread-command-events newmap define-key vector "Menu" mouse-major-mode-menu-1 current-local-map lookup-key [menu-bar] mouse-major-mode-menu-compute-equiv-keys t minor-mode-map-alist nil (read-key-sequence "") ((quit)) keyseq command command-execute] 9 (#$ . 644) "@e"]) (defalias 'mouse-major-mode-menu-compute-equiv-keys #[(menu) "@Á=ƒ\fÂÃ\"ˆ…F@:ƒ>@A:ƒ>@A‰:ƒ4\f@Á=„4\fA‰‚\"\f:ƒ=Å\f!ˆ)A‰„Ç" [menu keymap x-popup-menu nil tail mouse-major-mode-menu-compute-equiv-keys] 4]) (defalias 'mouse-major-mode-menu-1 #[(menubar) "…2Á‰ƒ& @:ƒ\nƒÄ‚ @A A‰„\f\nÄ=ƒ0‚1\n*‡" [menubar nil submap tail t] 3]) (defalias 'mouse-minibuffer-check #[(event) "‰A@)‰@)Ã\n!ƒÄ\n!„ÅÆ!ˆ)ÇÈ!‡" [event position w window-minibuffer-p minibuffer-window-active-p error "Minibuffer window is not active" run-hooks mouse-leave-buffer-hook] 3]) #@70 Delete the window you click on. This must be bound to a mouse click. (defalias 'mouse-delete-window #[(click) "À !ˆÂ ‰A@)‰@)!‡" [mouse-minibuffer-check click delete-window event position] 3 (#$ . 1695) "e"]) #@49 Select the window clicked on; don't move point. (defalias 'mouse-select-window #[(click) "À !ˆÂ à ‰A@)‰@)!È ‰A@)‰@)!ˆÉ!ˆÊ!ˆ=„>ËÂ Ì SÍ#ˆÎ *‡" [mouse-minibuffer-check click selected-frame window-frame event position frame oframe select-window raise-frame select-frame set-mouse-position frame-width 0 unfocus-frame] 5 (#$ . 1911) "e"]) #@77 Delete the window clicked on, and create a new frame displaying its buffer. (defalias 'mouse-tear-off-window #[(click) "À !ˆ ‰A@)‰@)Å\f!Ç É!ˆÊ!ˆË\f!+‡" [mouse-minibuffer-check click event position window window-buffer buf make-frame frame select-frame switch-to-buffer delete-window] 3 (#$ . 2268) "e"]) #@48 Delete all window except the one you click on. (defalias 'mouse-delete-other-windows #[nil "À ‡" [delete-other-windows] 1 (#$ . 2589) "@"]) #@157 Select Emacs window mouse is on, then split it vertically in half. The window is split at the line clicked on. This command must be bound to a mouse click. (defalias 'mouse-split-window-vertically #[(click) "À !ˆ ‰A@)Ä ‰@)!ˆÆ Ç\n8:ƒ!Ç‚\"È\n8)!AT Ê  Z \f  \fWƒCÎÏ!‚MÐ \f] ^!,‡" [mouse-minibuffer-check click event start select-window position posn-col-row 2 1 window-min-height window-height last-line first-line new-height error "Window too short to split" split-window-vertically] 5 (#$ . 2736) "@e"]) #@161 Select Emacs window mouse is on, then split it horizontally in half. The window is split at the column clicked on. This command must be bound to a mouse click. (defalias 'mouse-split-window-horizontally #[(click) "À !ˆ ‰A@)Ä ‰@)!ˆÆ Ç\n8:ƒ!Ç‚\"È\n8)!@T Ê  Z \f  \fWƒCÎÏ!‚MÐ \f] ^!,‡" [mouse-minibuffer-check click event start select-window position posn-col-row 2 1 window-min-width window-width last-col first-col new-width error "Window too narrow to split" split-window-horizontally] 5 (#$ . 3264) "@e"]) #@61 Change the height of a window by dragging on the mode line. (defalias 'mouse-drag-mode-line #[(start-event) "ÀÁ!ˆÂÃÄ A@@! A@@ÆÇ!È Â‰‰‰‰‰‰‰‰‰‰ \n \f Ú \nÐ\nžA‰„[ÛÇ!ƒ[ÜÝ!ˆÞ .‡" [run-hooks mouse-leave-buffer-hook nil 0 window-frame start-event count-windows t selected-window growth params wconfig edges bot top y minibuffer mouse event should-enlarge-minibuffer old-selected-window start-nwindows start-event-window start-event-frame echo-keystrokes done frame-parameters one-window-p error "Attempt to resize sole window" (lambda nil (track-mouse (byte-code "À !ˆ\n…ÃÄ!?…Å\n!A@ÆÅ 8U?…õÉ \nË \f\n¨ƒ6ĉ‚\n@Í=„\n@Î>„Z\n:ƒS\nBĉ‚\f@=ƒ\fA@ƒ\fAAÅ ‰A@Æ8ZÕZWƒ•\\Õ\\ZÕZØ ƒÐÀ\n!ˆÚVƒÃÛ\n!ZÜWƒÃÛ\n!SÝ[!ˆÀ !ˆ‚ÕÝ!ˆßÄ!Uƒí„Å A@U„à!ˆ‚‡" [select-window start-event-window minibuffer one-window-p t window-edges 3 should-enlarge-minibuffer done read-event event mouse-position mouse switch-frame (mouse-movement scroll-bar-movement) unread-command-events start-event-frame y edges top bot -1 window-min-height growth current-window-configuration wconfig 0 window-height 1 enlarge-window start-nwindows count-windows set-window-configuration] 4)))] 17 (#$ . 3795) "e"]) #@64 Change the width of a window by dragging on the vertical line. (defalias 'mouse-drag-vertical-line #[(start-event) "ÀÁ!ˆÂÃÄ A@@! A@@ÆÇ!È Â‰‰‰‰‰‰‰ \n \f ×Ç!ƒCØÙ!ˆÚÛ!8Ü!UƒUØÝ!ˆÞ .‡" [run-hooks mouse-leave-buffer-hook nil 0 window-frame start-event count-windows t selected-window growth wconfig edges right left x mouse event old-selected-window start-nwindows start-event-window start-event-frame echo-keystrokes done one-window-p error "Attempt to resize sole ordinary window" 2 window-edges frame-width "Attempt to drag rightmost scrollbar" (lambda nil (track-mouse (byte-code "À !ˆ\n?…¡Ã Å \f¨ƒlj‚\f@È=„\f@É>„:\f:ƒ4\f\nB\nlj‚@ =ƒA@ƒA@\fÍ ‰@Ð8\fZÒZWƒt\\Ò\\\f\fZÒZÕ ×Ç\"ˆÙÇ!Uƒ™Í @U„Ú!ˆ‚‡" [select-window start-event-window done read-event event mouse-position mouse t switch-frame (mouse-movement scroll-bar-movement) unread-command-events start-event-frame x window-edges edges left 2 right -1 window-min-width growth current-window-configuration wconfig enlarge-window start-nwindows count-windows set-window-configuration] 4)))] 14 (#$ . 5090) "e"]) #@105 Move point to the position clicked on with the mouse. This should be bound to a mouse click event type. (defalias 'mouse-set-point #[(event) "À !ˆ  8:ƒ‚à 8)Å\f‰@)!„%ÇÈ!ˆÉ\f‰@)!ˆ\f‰A@:ƒ@A@@‚DA@)§…a\f‰A@:ƒ[A@@‚_A@)b)‡" [mouse-minibuffer-check event 2 1 posn windowp position error "Cursor not in text area of window" select-window] 3 (#$ . 6249) "e"]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ B‡" [boundp mouse-last-region-beg nil current-load-list mouse-last-region-end mouse-last-region-tick] 2) #@73 Return non-nil if there's an active region that was set with the mouse. (defalias 'mouse-region-match #[nil "ÀÁ!…\n… Ä =… Æ =…È =‡" [mark t mark-active mouse-last-region-beg region-beginning mouse-last-region-end region-end mouse-last-region-tick buffer-modified-tick] 2 (#$ . 6788)]) #@109 Set the region to the text dragged over, and copy to kill ring. This should be bound to a mouse drag event. (defalias 'mouse-set-region #[(click) "À !ˆ ‰A@) Ã\n8:ƒÂÄ\n8)lj@)!ˆ‰A@:ƒ;A@@‚?A@)§ƒ^‰A@:ƒWA@@‚[A@)bˆ „‚ÊË !Ì=„‚ÊË !Í=„‚ÊË !Î=„‚ÏÄ!ˆÐ ˆÑ`!ˆ ‰A@:ƒ›A@@‚ŸA@)§ƒ½ ‰A@:ƒ¶A@@‚ºA@)bˆÒ‰ÕÖ `\"ˆ*× *‡" [mouse-minibuffer-check click event 2 1 end posn select-window position transient-mark-mode framep selected-frame x pc win32 sit-for push-mark set-mark nil last-command this-command copy-region-as-kill mark mouse-set-region-1] 4 (#$ . 7090) "e"]) (defalias 'mouse-set-region-1 #[nil "À  Ä ‰‡" [region-beginning mouse-last-region-beg region-end mouse-last-region-end buffer-modified-tick mouse-last-region-tick] 2]) #@438 *The pause between scroll steps caused by mouse drags, in seconds. If you drag the mouse beyond the edge of a window, Emacs scrolls the window to bring the text beyond that edge into view, with a delay of this many seconds between scroll steps. Scrolling stops when you move the mouse back into the window, or release the button. This variable's value may be non-integral. Setting this to zero causes Emacs to scroll as fast as it can. (defvar mouse-scroll-delay .25 (#$ . -7874)) #@379 *The minimum number of lines scrolled by dragging mouse out of window. Moving the mouse out the top or bottom edge of the window begins scrolling repeatedly. The number of lines scrolled per repetition is normally equal to the number of lines beyond the window edge that the mouse has moved. However, it always scrolls at least the number of lines specified by this variable. (defvar mouse-scroll-min-lines 1 (#$ . -8363)) #@232 Scroll the window WINDOW, JUMP lines at a time, until new input arrives. If OVERLAY is an overlay, let it stretch from START to the far edge of the newly visible text. Upon exit, point is at the far edge of the newly visible text. (defalias 'mouse-scroll-subr #[(window jump &optional overlay start) "ÁVƒ\nWƒ\n‚!ÁWƒ![\nWƒ!\n[`Ä !bˆÆ \"ÁU„mÇ `\"ˆÈ!ƒJÉ !bˆÆS \"ˆ‚OÄ !bˆ\nƒ\\Ë\n\f`#ˆ Í =„f bˆÎ!„# Í =†v b)‡" [jump 0 mouse-scroll-min-lines opoint window-start window vertical-motion set-window-start natnump window-end overlay move-overlay start selected-window sit-for mouse-scroll-delay] 4 (#$ . 8795)]) (byte-code "ÀÁ!„ ÂÉ\"Á\fBÅ !ˆÆ ÇÈ#ˆÀÉ!„\"Ê É\fBÀË!„/Ì Ë\fḂ" [boundp mouse-drag-overlay make-overlay 1 current-load-list delete-overlay overlay-put face region mouse-selection-click-count 0 mouse-selection-click-count-buffer nil] 4) #@265 Set the region to the text that the mouse is dragged over. Highlight the drag area as you move the mouse. This must be bound to a button-down mouse event. In Transient Mark mode, the highlighting remains once you release the mouse button. Otherwise, it does not. (defalias 'mouse-drag-region #[(start-event) "À !ˆ ‰A@)‰‰A@:ƒ\fA@@‚\fA@) ‰@)Ç!É!‰\nA@ Ì!ƒFÍ\n8‚KÍ\n8S Ï\n8¨ƒ\\Ï\n8‚]Ð)S‰pÔ !ˆ` Wƒt bˆ`Õ ‰#×@A@Ù!$ˆ)ƒ›ÛÝÞ!ˆÛ‰‰` !â ˆ\n:ƒ4ãä\n@!!%æÍ\"çUƒðè%!ƒð\nÏ\n8:ƒÔÏ‚ÕÐ\n8)‰!A ˆé!ˆ\n*B‰*)‚0ë!ì!U„#Û‰-.ïë!ð‰#ˆì!bˆé!ˆñ`òð!\"ˆó *‚0ì!bˆÔ-é!)‚8é!.\f‡" [mouse-minibuffer-check start-event event start-posn position start-point start-window window-frame start-frame window-edges bounds top window-minibuffer-p 3 bottom 2 1 click-count mouse-selection-click-count mouse-selection-click-count-buffer mouse-set-point mouse-start-end range move-overlay mouse-drag-overlay window-buffer transient-mark-mode nil mark-active run-hooks deactivate-mark-hook end-of-range end-point end (lambda nil (track-mouse (byte-code "À ‰‰:…\n@Ã=)„ ¢Ä=…× ¢Ä=„ Å 8:ƒ-Å‚.Æ 8)‰‰A@:ƒEA@@‚IA@) ‰@)\n=ƒË !ƒ\fbˆ bˆ ΦÏUƒt`Ñ\f` #Ó@A@#ˆ)‚Õ AA‰ƒÓWƒ¶Ø\nZ\f$ˆÙ!‚ÓYƒÓØ\nZT\f$ˆÛ!)‚‡" [read-event event object mouse-movement switch-frame 2 1 end position end-point start-window integer-or-marker-p start-point click-count 3 0 end-of-range mouse-start-end range move-overlay mouse-drag-overlay mouse-position mouse-row top mouse-scroll-subr overlay-start bottom overlay-end] 6))) key-binding vector fun mod 0 fboundp delete-overlay unread-command-events overlay-start overlay-end this-command last-command push-mark t copy-region-as-kill mark mouse-set-region-1] 7 (#$ . 9677) "e"]) #@126 Skip over word, over whitespace, or over identical punctuation. If DIR is positive skip forward; if negative, skip backward. (defalias 'mouse-skip-word #[(dir) "gÁz!‰Ø„\nĘƒ% ÆWƒÇ\n!‚eÈ\n!‚e\nɘƒ= ÆWƒ7ÇÊ!‚eÈÊ!‚e ÆWƒTo?…ehU…eËuˆ‚Cm?…egU…eÌuˆ‚T*‡" [char char-to-string syntax "w" " " dir 0 skip-syntax-backward skip-syntax-forward "_" "w_" -1 1] 3 (#$ . 11510)]) (defalias 'mouse-start-end #[(start end mode) " Vƒ  \n)Ã\fÅ\"‰ÆUƒ D‡\fÇUƒB UƒBfƒBfzÈUƒBŠbˆÉÇ!ˆ`)D‡\fÇUƒj UƒjfƒjfzÊUƒjŠTbˆËÇ!ˆ`)TD‡\fÇUƒ†ŠbˆÌÍ!ˆ`)Š bˆÌÇ!ˆ`)D‡\fÎU…ŸŠbˆÆyˆ`)Š bˆÇyˆ`)D‡" [start end temp mod mode 3 0 1 40 forward-sexp 41 backward-sexp mouse-skip-word -1 2] 4]) (defalias 'mouse-set-mark-fast #[(click) "À !ˆ ‰A@)Ä ‰@)!ˆ ‰A@:ƒ# A@@‚& A@)§…CÆ ‰A@:ƒ< A@@‚? A@)lj#)‡" [mouse-minibuffer-check click event posn select-window position push-mark t] 5]) (defalias 'mouse-show-mark #[nil "†ŠÁÂ!bˆÃÄ!)‡" [transient-mark-mode mark t sit-for 1] 2]) #@136 Set mark at the position clicked on with the mouse. Display cursor at that position for a second. This must be bound to a mouse click. (defalias 'mouse-set-mark #[(click) "À !ˆÂ ‰A@)‰@)!ˆ`ÆŽÇ !ˆÈÉʉ#ˆ †'ÌÍ!*‡" [mouse-minibuffer-check click select-window event position point-save ((goto-char point-save)) mouse-set-point push-mark nil t transient-mark-mode sit-for 1] 5 (#$ . 12496) "e"]) #@112 Kill the region between point and the mouse click. The text is saved in the kill ring, as with \[kill-region]. (defalias 'mouse-kill #[(click) "À !ˆ ‰A@)‰‰A@:ƒ\fA@@‚\fA@)Æ ‰@)!ˆ §…5Ç` ^` ]\"*‡" [mouse-minibuffer-check click event posn position click-posn select-window kill-region] 5 (#$ . 12897) "e"]) #@275 Insert the last stretch of killed text at the position clicked on. Also move point to one end of the text thus inserted (normally the end). Prefix arguments are interpreted as with \[yank]. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click. (defalias 'mouse-yank-at-click #[(click arg) "ÀÁ!ˆ\n„\fÃ\f!ˆÅÇÅ !‡" [run-hooks mouse-leave-buffer-hook mouse-yank-at-point mouse-set-point click yank this-command 0 mouse-selection-click-count arg] 2 (#$ . 13217) "e\nP"]) #@134 Copy the region between point and the mouse click in the kill ring. This does not delete the region; it acts like \[kill-ring-save]. (defalias 'mouse-kill-ring-save #[(click) "À !ˆÂ‰Å`ÆÇ!\"ˆ*È ‡" [mouse-set-mark-fast click nil last-command this-command kill-ring-save mark t mouse-show-mark] 4 (#$ . 13726) "e"]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp mouse-save-then-kill-posn nil current-load-list] 2) (defalias 'mouse-save-then-kill-delete-region #[(beg end) "À ˆ \nU„ Ä=ƒ \n|ˆ‚ŠÅ‰‰‰ ‰\n Vƒ.Ê‚/Ë\\|ˆ, ʼn‰‰ ÌÊ \"ˆ,Ä @G\n ]\n ^ZU„\\ÎÏ!ˆ \n|ˆ) ‰ƒy@@;„yA‰„hƒ‰ @ \n^B ˆ)À ‡" [undo-boundary beg end buffer-undo-list t nil after-change-functions before-change-functions after-change-function before-change-function 1 -1 primitive-undo kill-ring error "Lossage in mouse-save-then-kill-delete-region" tail] 5]) #@563 Save text to point in kill ring; the second time, kill the text. If the text between point and the mouse is the same as what's at the front of the kill ring, this deletes the text. Otherwise, it adds the text to the kill ring, like \[kill-ring-save], which prepares for a second click to delete the text. If you have selected words or lines, this command extends the selection through the word or line clicked on. If you do this again in a different position, it extends the selection again. If you do this twice in the same position, the selection is killed. (defalias 'mouse-save-then-kill #[(click) " !ˆ ‰A@)‰A@:ƒ A@@‚ A@)ŠÈ ‰A@)‰@)!qˆÉÊ!…HË\fÍ\"ÎV…Hp=)ƒ³Ñ=ƒ^££@š„£Ó‰\f#ÕÉÊ!Z!Õ`Z!Wƒ‚Ö@!ˆ‚ˆA@bˆ×`ÉÊ!{Ê\"ˆØ ˆ@`EÚ )‚‰ÛÉ `\"ˆÎ\f܉‚‰Ñ=ƒáƒá@@=ƒáA`DšƒáÛ`É \"ˆÜ‰‚‰Ñ=ƒí„ƒ÷„ß>ƒf „„f ‰A@)‰!‰A@:ƒ  A@@‚# A@)\"ã!‰@)!ˆ\"§ƒVÕ\"`Z!Õ\"ÉÊ!Z!WƒN\"bˆ‚SÖ\"!ˆÜ$×`ÉÊ!{Ê\"ˆÚ ˆ*‚|å !ˆ ƒq bˆæ ˆ×`ÉÊ!{!ˆØ ˆ@`E‰+‡" [point-before-scroll before-scroll mouse-minibuffer-check click event position this-command click-posn window-buffer mark t mod mouse-selection-click-count 3 0 mouse-selection-click-count-buffer last-command mouse-save-then-kill mouse-save-then-kill-posn mouse-start-end range abs set-mark kill-new mouse-set-region-1 kill-ring mouse-show-mark mouse-save-then-kill-delete-region nil mark-active transient-mark-mode (mouse-drag-region mouse-set-region) mark-even-if-inactive posn new select-window deactivate-mark mouse-set-mark-fast exchange-point-and-mark] 6 (#$ . 14580) "e"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆËÌ!„\"Í\fÌBËÏ!„1ÐÏBËÑ!„@ÍÑB͇" [global-set-key [M-mouse-1] mouse-start-secondary [M-drag-mouse-1] mouse-set-secondary [M-down-mouse-1] mouse-drag-secondary [M-mouse-3] mouse-secondary-save-then-kill [M-mouse-2] mouse-yank-secondary boundp mouse-secondary-overlay nil current-load-list mouse-secondary-click-count 0 mouse-secondary-start] 3) #@165 Set one end of the secondary selection to the position clicked on. Use \[mouse-secondary-save-then-kill] to set the other end and complete the secondary selection. (defalias 'mouse-start-secondary #[(click) "À !ˆ ‰A@)ŠÄ ‰@)!qˆƒÇ!ˆ ‰A@:ƒ/ A@@‚2 A@)§…X„@É  ‰A@:ƒR A@@‚U A@)Ê“*‡" [mouse-minibuffer-check click event posn window-buffer position mouse-secondary-overlay delete-overlay mouse-secondary-start make-marker nil] 4 (#$ . 16585) "e"]) #@115 Set the secondary selection to the text that the mouse is dragged over. This must be bound to a mouse drag event. (defalias 'mouse-set-secondary #[(click) "À !ˆ ‰A@)à Ä\n8:ƒÄ‚Å\n8)ŠÉ‰\n@)!qˆ‰\nA@:ƒA\nA@@‚E\nA@)§ƒd‰\nA@:ƒ]\nA@@‚a\nA@) ƒ‹Ì ‰\nA@:ƒ\nA@@‚…\nA@)#ˆ‚©Í‰\nA@:ƒ¡\nA@@‚¥\nA@)\" Î ÏÐ#,‡" [mouse-minibuffer-check click event nil 2 1 end beg posn window-buffer position mouse-secondary-overlay move-overlay make-overlay overlay-put face secondary-selection] 5 (#$ . 17055) "e"]) #@169 Set the secondary selection to the text that the mouse is dragged over. Highlight the drag area as you move the mouse. This must be bound to a button-down mouse event. (defalias 'mouse-drag-secondary #[(start-event) "À !ˆ ‰A@)‰‰A@:ƒ\fA@@‚\fA@) ‰@)Ç!É!‰\nA@ Ì!ƒFÍ\n8‚KÍ\n8S Ï\n8¨ƒ\\Ï\n8‚]Ð)SŠÒ!qˆ„wÕ``\"Ö×Ø#ˆÙÍ\"ÚVƒµÛ ‰#Þ‰“ˆßЉÒ!$ˆß@A@Ò!$ˆ)‚É„¾à  Þ“ˆá!ˆÞ‰‰\"#ä ˆ\n:…ñå!ƒåæ‹‚ñçèé!ê!{\".\f‡" [mouse-minibuffer-check start-event event start-posn position start-point start-window window-frame start-frame window-edges bounds top window-minibuffer-p 3 bottom 2 1 click-count window-buffer mouse-secondary-click-count mouse-secondary-overlay make-overlay overlay-put face secondary-selection mod 0 mouse-start-end range mouse-secondary-start nil move-overlay make-marker delete-overlay end-point end (lambda nil (track-mouse (byte-code "À ‰‰:…\n@Ã=)„ ¢Ä=…Í ¢Ä=„ Å 8:ƒ-Å‚.Æ 8)‰‰A@:ƒEA@@‚IA@) ‰@)\n=ƒË !ƒÌ  #  UƒyÐ!„‹Ò‰“ˆÓ@A@#ˆ)‚Õ AA‰ƒÉWƒ²Ø\nZ $ˆ‚ÉYƒÉØ\nZT $ˆ)‚‡" [read-event event object mouse-movement switch-frame 2 1 end position end-point start-window integer-or-marker-p mouse-start-end start-point click-count range marker-position mouse-secondary-start nil move-overlay mouse-secondary-overlay mouse-position mouse-row top mouse-scroll-subr bottom] 6))) marker-position ((byte-code "À !ˆÂÃÄ\"ˆÅ!ˆŠbˆÈÉ!)‡" [delete-overlay mouse-secondary-overlay x-set-selection SECONDARY nil select-window start-window mouse-secondary-start sit-for 1] 3)) x-set-selection SECONDARY overlay-start overlay-end] 7 (#$ . 17602) "e"]) #@188 Insert the secondary selection at the position clicked on. Move point to the end of the inserted text. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click. (defalias 'mouse-yank-secondary #[(click) "ÀÁ!ˆ\n„\fÃ\f!ˆÅÆ!c‡" [run-hooks mouse-leave-buffer-hook mouse-yank-at-point mouse-set-point click x-get-selection SECONDARY] 2 (#$ . 19302) "e"]) #@310 Kill the text in the secondary selection. This is intended more as a keyboard command than as a mouse command but it can work as either one. The current buffer (in case of keyboard use), or the buffer clicked on, must be the one that the secondary selection is in. This requirement is to prevent accidents. (defalias 'mouse-kill-secondary #[nil "À ‰‰GSœÃ\f!\n<ƒÅÆÇ\n!!!‚p=„$ÈÉ!ˆ*Ê ŠÃ\f!qˆÌÍ\f!Î\f!\"ˆ*Ï\f!ˆÊ‰‡" [this-command-keys keys click overlay-buffer mouse-secondary-overlay window-buffer posn-window event-start error "Select or click on the buffer where the secondary selection is" nil this-command kill-region overlay-start overlay-end delete-overlay] 6 (#$ . 19686) nil]) #@737 Save text to point in kill ring; the second time, kill the text. You must use this in a buffer where you have recently done \[mouse-start-secondary]. If the text between where you did \[mouse-start-secondary] and where you use this command matches the text at the front of the kill ring, this command deletes the text. Otherwise, it adds the text to the kill ring, like \[kill-ring-save], which prepares for a second click with this command to delete the text. If you have already made a secondary selection in that buffer, this command extends or retracts the selection to where you click. If you do this again in a different position, it extends or retracts again. If you do this twice in the same position, it kills the selection. (defalias 'mouse-secondary-save-then-kill #[(click) "À !ˆ ‰A@) ‰A@)‰A@:ƒ A@@‚\" A@)\fÇÈ!! ƒ:Ê !†C …CÌ !=„KÍÎ!ˆŠÇ‰@)!qˆÏÑ\"ÒVƒÛÔ=ƒq ££@š„ÂÖ ‰#Ø Ù !Z!Ø Ú !Z!WƒœÛ @Ú !#ˆ‚©Û Ù !A@#ˆÜÙ !Ú !{Ý\"ˆ@` E)‚¦ßÙ !Ú !\"ˆàÒá !ˆ‚¦Ô=ƒƒ@@=ƒA` DšƒßÙ !Ú !\"ˆàá !ˆ‚¦Ù !ƒp §ƒKØ Ù !Z!Ø Ú !Z!Wƒ>Û Ú !#ˆ‚HÛ Ù ! #ˆà\"Ô=ƒbÜÙ !Ú !{Ý\"ˆ‚žãÙ !Ú !\"ˆ‚ž ƒž $å$ \"ˆ ƒÛ $ #ˆ‚–æ$ \" ç èé#ˆ)@` EÊ !…¹êëÙ !Ú !{\",‡" [mouse-minibuffer-check click event position this-command click-posn posn window-buffer posn-window mouse-secondary-overlay overlay-buffer mouse-secondary-start marker-buffer error "Wrong buffer" mod mouse-secondary-click-count 3 0 last-command mouse-secondary-save-then-kill mouse-save-then-kill-posn mouse-start-end range abs overlay-start overlay-end move-overlay kill-new t kill-ring mouse-save-then-kill-delete-region nil delete-overlay deactivate-mark copy-region-as-kill start kill-ring-save make-overlay overlay-put face secondary-selection x-set-selection SECONDARY] 6 (#$ . 20385) "e"]) #@138 Pop up a menu of buffers for selection with the mouse. This switches buffers in the window that you clicked on, and selects that window. (defalias 'mouse-buffer-menu #[(event) "À !ˆÂÃÄ ÅƉ ƒ4Ê @!ÅHË=„+Ê @!G] A‰ „Ä ‰ ƒž @\fÍÎÊ\f!\"„”ωÐ\"Ê\f!Ñ\f!ƒ`Ò‚aÓŠ\fqˆƒoÕ‚pÓ)Ö\f!†‹Š\fqˆ…†Ø!)†‹Ù%\fBB) A‰ „<Ú!+BDÜ \" ‰A@)‰@)‰…Ïà!„Ëá!ˆâ!+‡" [mouse-minibuffer-check event "Buffer Menu" "Select Buffer" buffer-list 0 nil head maxbuf tail buffer-name 32 elt string-match "^ " format "%%%ds %%s%%s %%s" buffer-modified-p "*" " " buffer-read-only "%" buffer-file-name list-buffers-directory expand-file-name "" reverse menu x-popup-menu position window buf framep select-window switch-to-buffer] 10 (#$ . 22235) "e"]) #@69 Click on an alternative in the `*Completions*' buffer to choose it. (defalias 'mouse-choose-completion #[(event) "ÀÁ!ˆÂ Ɋ‰A@)‰@)!qˆ ƒ' \nŠ‰A@)‰A@:ƒDA@@‚HA@)bˆÃ‰ \fm„cÍ`Î\"ƒc` `T\f\f„lÏÐ!ˆÑ\fÎ\"\fÒ Î\"†|d \f {,Ó Õ‰A@)‰@)!ˆÖ×Ø\"ƒ¯ÙÓ !ƒ¯ÚØ !ˆ‚¹ÙÓ !„¹Û ˆÕ!ˆ)Ü \f#+‡" [run-hooks mouse-leave-buffer-hook window-buffer nil base-size choice buffer event position completion-reference-buffer completion-base-size end beg get-text-property mouse-face error "No completion here" previous-single-property-change next-single-property-change selected-window owindow select-window one-window-p t selected-frame window-dedicated-p iconify-frame bury-buffer choose-completion-string] 5 (#$ . 23014) "e"]) (defalias 'font-menu-add-default #[nil "ÀÁ !žA\fÆÇ \"† A@ÆÉ\"ƒ(ÊÆÉ\"\"ˆÉÀÁ !žADAB¡+‡" [font frame-parameters selected-frame default x-fixed-font-alist font-alist assoc "Misc" elt "Default" delete] 5]) #@36 X fonts suitable for use in Emacs. (defvar x-fixed-font-alist (quote ("Font menu" ("Misc" ("fixed" "fixed") ("6x10" "-misc-fixed-medium-r-normal--10-*-*-*-c-60-iso8859-1" "6x10") ("6x12" "-misc-fixed-medium-r-semicondensed--12-*-*-*-c-60-iso8859-1" "6x12") ("6x13" "-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1" "6x13") ("7x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-70-iso8859-1" "7x13") ("7x14" "-misc-fixed-medium-r-normal--14-*-*-*-c-70-iso8859-1" "7x14") ("8x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-80-iso8859-1" "8x13") ("9x15" "-misc-fixed-medium-r-normal--15-*-*-*-c-90-iso8859-1" "9x15") ("10x20" "-misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1" "10x20") ("11x18" "-misc-fixed-medium-r-normal--18-*-*-*-c-110-iso8859-1" "11x18") ("12x24" "-misc-fixed-medium-r-normal--24-*-*-*-c-120-iso8859-1" "12x24") ("") ("clean 5x8" "-schumacher-clean-medium-r-normal--8-*-*-*-c-50-iso8859-1") ("clean 6x8" "-schumacher-clean-medium-r-normal--8-*-*-*-c-60-iso8859-1") ("clean 8x8" "-schumacher-clean-medium-r-normal--8-*-*-*-c-80-iso8859-1") ("clean 8x10" "-schumacher-clean-medium-r-normal--10-*-*-*-c-80-iso8859-1") ("clean 8x14" "-schumacher-clean-medium-r-normal--14-*-*-*-c-80-iso8859-1") ("clean 8x16" "-schumacher-clean-medium-r-normal--16-*-*-*-c-80-iso8859-1") ("") ("sony 8x16" "-sony-fixed-medium-r-normal--16-*-*-*-c-80-iso8859-1")) ("Courier" ("8" "-adobe-courier-medium-r-normal--*-80-*-*-m-*-iso8859-1") ("10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-iso8859-1") ("12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1") ("14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-iso8859-1") ("18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-iso8859-1") ("24" "-adobe-courier-medium-r-normal--*-240-*-*-m-*-iso8859-1") ("8 bold" "-adobe-courier-bold-r-normal--*-80-*-*-m-*-iso8859-1") ("10 bold" "-adobe-courier-bold-r-normal--*-100-*-*-m-*-iso8859-1") ("12 bold" "-adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1") ("14 bold" "-adobe-courier-bold-r-normal--*-140-*-*-m-*-iso8859-1") ("18 bold" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-iso8859-1") ("24 bold" "-adobe-courier-bold-r-normal--*-240-*-*-m-*-iso8859-1") ("8 slant" "-adobe-courier-medium-o-normal--*-80-*-*-m-*-iso8859-1") ("10 slant" "-adobe-courier-medium-o-normal--*-100-*-*-m-*-iso8859-1") ("12 slant" "-adobe-courier-medium-o-normal--*-120-*-*-m-*-iso8859-1") ("14 slant" "-adobe-courier-medium-o-normal--*-140-*-*-m-*-iso8859-1") ("18 slant" "-adobe-courier-medium-o-normal--*-180-*-*-m-*-iso8859-1") ("24 slant" "-adobe-courier-medium-o-normal--*-240-*-*-m-*-iso8859-1") ("8 bold slant" "-adobe-courier-bold-o-normal--*-80-*-*-m-*-iso8859-1") ("10 bold slant" "-adobe-courier-bold-o-normal--*-100-*-*-m-*-iso8859-1") ("12 bold slant" "-adobe-courier-bold-o-normal--*-120-*-*-m-*-iso8859-1") ("14 bold slant" "-adobe-courier-bold-o-normal--*-140-*-*-m-*-iso8859-1") ("18 bold slant" "-adobe-courier-bold-o-normal--*-180-*-*-m-*-iso8859-1") ("24 bold slant" "-adobe-courier-bold-o-normal--*-240-*-*-m-*-iso8859-1")))) (#$ . 23992)) #@54 Select an emacs font from a list of known good fonts (defalias 'mouse-set-font #[(&rest fonts) "…ÁƒÁÃĈ‚\n?…ÅÆ!)‡" [fonts nil font (byte-code "À @!ˆ @ÃÇ" [set-default-font fonts font nil] 2) ((error (byte-code "AÁ‡" [fonts nil] 1))) error "Font not found"] 3 (#$ . 27057) (x-popup-menu last-nonmenu-event x-fixed-font-alist)]) (byte-code "À ÂÃ#ˆÄÅÆ\"ˆÄÇÈ\"ˆÄÉÆ\"ˆÄÊÆ\"ˆÄËÌ\"ˆÄÍÎ\"ˆÄÏÐ\"ˆÒ=„5ÄÓÔ\"ˆÄÕÖ\"ˆÄ×Ø\"ˆÄÙØ\"ˆÄÚÛ\"ˆÄÜÝ\"ˆÄÞß\"ˆÄàá\"ˆÄâã\"ˆÄäã\"ˆÄåæ\"ˆÄçØ\"ˆèé!‡" [define-key global-map [down-mouse-1] mouse-drag-region global-set-key [mouse-1] mouse-set-point [drag-mouse-1] mouse-set-region [double-mouse-1] [triple-mouse-1] [mouse-2] mouse-yank-at-click [mouse-3] mouse-save-then-kill [C-down-mouse-1] mouse-buffer-menu system-type ms-dos [S-down-mouse-1] mouse-set-font [C-down-mouse-3] mouse-major-mode-menu [mode-line mouse-1] mouse-select-window [mode-line drag-mouse-1] [mode-line down-mouse-1] mouse-drag-mode-line [mode-line mouse-2] mouse-delete-other-windows [mode-line mouse-3] mouse-delete-window [mode-line C-mouse-2] mouse-split-window-horizontally [vertical-scroll-bar C-mouse-2] mouse-split-window-vertically [vertical-line C-mouse-2] [vertical-line down-mouse-1] mouse-drag-vertical-line [vertical-line mouse-1] provide mouse] 4) emacs-19.30/lisp/mpuz.elc100666 13437 1 23242 5744577022 13730 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:47:27 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/mpuz.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/mpuz.el' was compiled for Emacs 19")) (random t) #@51 *Set this to T if you don't want dings on inputs. (defvar mpuz-silent nil (#$ . -488)) #@57 Dings, unless global variable `mpuz-silent' forbids it. (defalias 'mpuz-ding #[nil "†ÁÂ!‡" [mpuz-silent ding t] 2 (#$ . 581)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp mpuz-mode-hook nil current-load-list] 2) #@37 Local keymap to use in Mult Puzzle. (defvar mpuz-mode-map nil (#$ . 794)) (byte-code "„‹Á ÂÃÄ#ˆÂÅÄ#ˆÂÆÄ#ˆÂÇÄ#ˆÂÈÄ#ˆÂÉÄ#ˆÂÊÄ#ˆÂËÄ#ˆÂÌÄ#ˆÂÍÄ#ˆÂÎÄ#ˆÂÏÄ#ˆÂÐÄ#ˆÂÑÄ#ˆÂÒÄ#ˆÂÓÄ#ˆÂÔÄ#ˆÂÕÄ#ˆÂÖÄ#ˆÂ×Ä#ˆÂØÙ#ˆÂÚÛ#ˆÁ‡" [mpuz-mode-map make-sparse-keymap define-key "a" mpuz-try-letter "b" "c" "d" "e" "f" "g" "h" "i" "j" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "" mpuz-offer-abort "?" describe-mode] 4) #@454 Multiplication puzzle mode. You have to guess which letters stand for which digits in the multiplication displayed inside the `*Mult Puzzle*' buffer. You may enter a guess for a letter's value by typing first the letter, then the digit. Thus, to guess that A=3, type A 3. To leave the game to do other editing work, just switch buffers. Then you may resume the game with M-x mpuz. You may abort a game by typing \\[mpuz-offer-abort]. (defalias 'mpuz-mode #[nil "ÀÂÄ !ˆÆÇ!‡" [mpuz-mode major-mode "Mult Puzzle" mode-name use-local-map mpuz-mode-map run-hooks mpuz-mode-hook] 2 (#$ . 1214) nil]) #@40 Number of errors made in current game. (defvar mpuz-nb-errors 0 (#$ . 1835)) #@28 Number of games completed. (defvar mpuz-nb-completed-games 0 (#$ . 1918)) #@42 Number of errors made in previous games. (defvar mpuz-nb-cumulated-errors 0 (#$ . 1998)) #@42 True if a game is currently in progress. (defvar mpuz-in-progress nil (#$ . 2093)) #@54 A vector recording which digits have been decrypted. (defvar mpuz-found-digits (make-vector 10 nil) (#$ . 2182)) (defalias 'mpuz-digit-solved-p '(macro . #[(digit) "ÀÁ\nE‡" [aref mpuz-found-digits digit] 3])) #@38 A permutation from [0..9] to [0..9]. (defvar mpuz-digit-to-letter (make-vector 10 0) (#$ . 2397)) #@38 The inverse of mpuz-digit-to-letter. (defvar mpuz-letter-to-digit (make-vector 10 0) (#$ . 2501)) (defalias 'mpuz-to-digit '(macro . #[(letter) "ÀÁ\nE‡" [aref mpuz-letter-to-digit letter] 3])) (defalias 'mpuz-to-letter '(macro . #[(digit) "ÀÁ\nE‡" [aref mpuz-digit-to-letter digit] 3])) #@53 Initialize puzzle coding with a random permutation. (defalias 'mpuz-build-random-perm #[nil "ÀÁÂÃÄÅÆÇÈɯ\nÊË\f …BÏ !8\fÐ\f\" S  \fIˆ\f Iˆ‚+‡" [0 1 2 3 4 5 6 7 8 9 10 nil elem index letters random delq mpuz-digit-to-letter mpuz-letter-to-digit] 10 (#$ . 2794)]) #@73 The board associates to any digit the list of squares where it appears. (defvar mpuz-board (make-vector 10 nil) (#$ . 3089)) #@59 Put (last digit of) NUMBER on SQUARE of the puzzle board. (defalias 'mpuz-put-digit-on-board #[(number square) "Á¦\n \nHBI‡" [number 10 mpuz-board square] 5 (#$ . 3220)]) #@61 Check whether all digits have been solved. Return t if yes. (defalias 'mpuz-check-all-solved #[nil "ÀÁ‡" [found (byte-code "À T‰Vƒ H„\f HƒÅÆÇ\"ˆ‚)ȇ" [-1 digit 10 mpuz-found-digits mpuz-board throw found nil t] 3)] 2 (#$ . 3401)]) #@50 Draw random values to be multiplied in a puzzle. (defalias 'mpuz-random-puzzle #[nil "À ˆÁ\nÃ\"ˆÃ‰‰‰‰ÉÊ!ÉË!̦_Ì¥__ÊW„ ÊW„ÍÎ\"ˆÍÌ¥Ï\"ˆÍË¥Ð\"ˆÍÑ\"ˆÍÌ¥Ò\"ˆÍÓ\"ˆÍÌ¥Ô\"ˆÍË¥Õ\"ˆÍÊ¥Ö\"ˆÍ ×\"ˆÍ Ì¥Ø\"ˆÍ Ë¥Ù\"ˆÍ Ê¥Ú\"ˆÍ\fÛ\"ˆÍ\fÌ¥Ü\"ˆÍ\fË¥Ý\"ˆÍ\fÊ¥Þ\"ˆÍ\fߥà\"-‡" [mpuz-build-random-perm fillarray mpuz-board nil E D C B A random 1000 100 10 mpuz-put-digit-on-board (2 . 9) (2 . 7) (2 . 5) (4 . 9) (4 . 7) (6 . 9) (6 . 7) (6 . 5) (6 . 3) (8 . 7) (8 . 5) (8 . 3) (8 . 1) (10 . 9) (10 . 7) (10 . 5) (10 . 3) 10000 (10 . 1)] 5 (#$ . 3651)]) #@56 The general picture of the puzzle screen, as a string. (defconst mpuz-framework "\n . . .\n Number of errors (this game): 0\n x . .\n -------\n . . . .\n Number of completed games: 0\n . . . .\n --------- Average number of errors: 0.00\n . . . . ." (#$ . 4237)) #@52 Create (or recreate) the puzzle buffer. Return it. (defalias 'mpuz-create-buffer #[nil "ÀÁ!Š\nqˆÃÅ ˆcˆÇ ˆÈ ˆÉ ˆ*\n)‡" [get-buffer-create "*Mult Puzzle*" buff nil buffer-read-only erase-buffer mpuz-framework mpuz-paint-board mpuz-paint-errors mpuz-paint-statistics] 2 (#$ . 4571)]) #@41 Paint error count on the puzzle screen. (defalias 'mpuz-paint-errors #[nil "À ˆÁÃÄ!ˆÅÆ!ˆÇ ˆÈ !c)‡" [mpuz-switch-to-window nil buffer-read-only goto-line 3 move-to-column 49 mpuz-delete-line prin1-to-string mpuz-nb-errors] 2 (#$ . 4862)]) #@61 Paint statistics about previous games on the puzzle screen. (defalias 'mpuz-paint-statistics #[nil "ÁUƒ\nÁ‚\nÃ_\\‰\\¥‰ŦÇÉÊ!ˆËÌ!ˆÍ ˆÎ!cˆÉÏ!ˆËÐ!ˆÍ ˆÑÒ\fÅ¥Ó¥Ó¦$c+‡" [mpuz-nb-completed-games 0 mpuz-nb-cumulated-errors 200 mean 100 frac-part nil buffer-read-only goto-line 7 move-to-column 51 mpuz-delete-line prin1-to-string 9 50 format "%d.%d%d" 10] 7 (#$ . 5108)]) #@45 Paint board situation on the puzzle screen. (defalias 'mpuz-paint-board #[nil "À ˆÁÃ\nT‰VƒÄ \nH!ˆ‚)eb‡" [mpuz-switch-to-window -1 letter 10 mpuz-paint-digit mpuz-letter-to-digit] 3 (#$ . 5494)]) #@53 Paint all occurrences of DIGIT on the puzzle board. (defalias 'mpuz-paint-digit #[(digit) " Hƒ\f Â\\‚ HÄ\\ HÈ …DÊ@@!ˆË@A!ˆcˆÌÍ!ˆÎÍ!ˆA‰„ È+‡" [mpuz-found-digits digit 48 mpuz-digit-to-letter 65 mpuz-board square-l char nil buffer-read-only goto-line move-to-column delete-char 1 backward-char] 4 (#$ . 5701)]) #@35 Clear from point to next newline. (defalias 'mpuz-delete-line #[nil "`fÀU?…ÁÂ!ˆ‚‡" [10 delete-char 1] 2 (#$ . 6041)]) #@37 Get the puzzle buffer if it exists. (defalias 'mpuz-get-buffer #[nil "ÀÁ!‡" [get-buffer "*Mult Puzzle*"] 2 (#$ . 6169)]) #@56 Find or create the Mult-Puzzle buffer, and display it. (defalias 'mpuz-switch-to-window #[nil "À ‰„\n à !ˆ\f„Å ˆÆ )‡" [mpuz-get-buffer buff mpuz-create-buffer switch-to-buffer buffer-read-only toggle-read-only mpuz-mode] 3 (#$ . 6296)]) #@31 Abort any puzzle in progress. (defalias 'mpuz-abort-game #[nil "ÀÁ!ˆÂÄÆÂ\"ˆÈ ‰ …Ê !)‡" [message "Mult Puzzle aborted." nil mpuz-in-progress 0 mpuz-nb-errors fillarray mpuz-board mpuz-get-buffer buff kill-buffer] 4 (#$ . 6545)]) #@21 Start a new puzzle. (defalias 'mpuz-start-new-game #[nil "ÀÁ!ˆÂÄÆÈ\"ˆÉ ˆÊ ˆË ˆÌ ˆÍ ‡" [message "Here we go..." 0 mpuz-nb-errors t mpuz-in-progress fillarray mpuz-found-digits nil mpuz-random-puzzle mpuz-switch-to-window mpuz-paint-board mpuz-paint-errors mpuz-ask-for-try] 3 (#$ . 6787)]) #@42 Ask if user wants to start a new puzzle. (defalias 'mpuz-offer-new-game #[nil "ÀÁ!ƒ  ‡ÃÄ!‡" [y-or-n-p "Start a new game " mpuz-start-new-game message "OK. I won't."] 2 (#$ . 7086)]) #@39 Multiplication puzzle with GNU Emacs. (defalias 'mpuz #[nil "À ˆ ƒ\n ‡Ã ‡" [mpuz-switch-to-window mpuz-in-progress mpuz-offer-abort mpuz-start-new-game] 1 (#$ . 7276) nil]) #@44 Ask if user wants to abort current puzzle. (defalias 'mpuz-offer-abort #[nil "ÀÁ!ƒ  ‡Ã ‡" [y-or-n-p "Abort game " mpuz-abort-game mpuz-ask-for-try] 2 (#$ . 7457) nil]) #@34 Ask for user proposal in puzzle. (defalias 'mpuz-ask-for-try #[nil "ÀÁ!‡" [message "Your try ?"] 2 (#$ . 7633)]) #@41 Propose a digit for a letter in puzzle. (defalias 'mpuz-try-letter #[nil "ƒbÁ‰‰‰– ÈZH \fHƒ%ÂÊ \"‚` \fH„3ÂÌ \"‚`ÂÍ \"ˆÎ ‰Ï=ƒDÎ ÂÐ #ˆ ÑV„V ÒWƒ\\ÓÔ!‚`Õ \",‡Ö ‡" [mpuz-in-progress nil message digit-char digit letter-char last-command-char mpuz-letter-to-digit 65 mpuz-found-digits "%c already solved." mpuz-board "%c does not appear." "%c = " read-char 61 "%c = %c" 57 48 ding t mpuz-try-proposal mpuz-offer-new-game] 5 (#$ . 7752) nil]) #@45 Propose LETTER-CHAR as code for DIGIT-CHAR. (defalias 'mpuz-try-proposal #[(letter-char digit-char) "ÁZ ÄZ\nHHƒÉÊ!‚B Uƒ2ÉË #ˆÌ ˆÍ !‚BÉÎ #ˆÌ ˆTÐ +‡" [letter-char 65 letter digit-char 48 digit mpuz-letter-to-digit correct-digit mpuz-found-digits message "%c has already been found." "%c = %c correct !" mpuz-ding mpuz-correct-guess "%c = %c incorrect !" mpuz-nb-errors mpuz-paint-errors] 4 (#$ . 8218)]) #@35 Handle correct guessing of DIGIT. (defalias 'mpuz-correct-guess #[(digit) " ÂIˆÃ !ˆÄ …Å ‡" [mpuz-found-digits digit t mpuz-paint-digit mpuz-check-all-solved mpuz-close-game] 3 (#$ . 8650)]) #@44 Housecleaning when puzzle has been solved. (defalias 'mpuz-close-game #[nil "À\n \\\fTÅ ˆÆ Ç!ˆÈÉ!ˆÊËP!ƒ'Ì ‚*ÇÍ!)‡" [nil mpuz-in-progress mpuz-nb-cumulated-errors mpuz-nb-errors mpuz-nb-completed-games mpuz-paint-statistics mpuz-congratulate message sit-for 4 y-or-n-p " Start a new game " mpuz-start-new-game "Good Bye !"] 3 (#$ . 8849)]) #@55 Build a congratulation message when puzzle is solved. (defalias 'mpuz-congratulate #[nil "ÀÁ\n‰ÃUƒ Ä‚\\\nÅUƒÆ‚\\\nÇUƒ!È‚\\\nÉUƒ+Ê‚\\\nËUƒ5Ì‚\\\nÍYƒE\nÎWƒEÏ‚\\\nÎYƒU\nÐWƒUÑ‚\\\nÐY…\\Ò#‡" [format "Puzzle solved with %d errors. %s" mpuz-nb-errors 0 "That's perfect !" 1 "That's very good !" 2 "That's good." 3 "That's not bad." 4 "That's not too bad..." 5 10 "That's bad !" 15 "That's awful." "That's not serious."] 5 (#$ . 9206)]) #@42 Display solution for debugging purposes. (defalias 'mpuz-show-solution #[nil "À ˆÁ‰ÄÅ T‰Vƒ  H„ \nB‚ ÇÈ\n\"*‡" [mpuz-switch-to-window nil list digit -1 10 mpuz-found-digits mapcar mpuz-correct-guess] 3 (#$ . 9659) nil]) emacs-19.30/lisp/msb.elc100666 12120 1 46350 6046535633 13365 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 20:01:50 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/msb.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`msb.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ\fBÅÆ\fBÇÈ!„È\fBÀ‡" [require cl (((and (boundp (quote server-buffer-clients)) server-buffer-clients (quote multi)) 3030 "Clients (%d)") ((and msb-display-invisible-buffers-p (msb-invisible-buffer-p) (quote multi)) 3090 "Invisible buffers (%d)") ((eq major-mode (quote dired-mode)) 2010 "Dired (%d)" msb-dired-item-handler msb-sort-by-directory) ((eq major-mode (quote Man-mode)) 4090 "Manuals (%d)") ((eq major-mode (quote w3-mode)) 4020 "WWW (%d)") ((or (memq major-mode (quote (rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode))) (memq major-mode (quote (mh-letter-mode mh-show-mode mh-folder-mode))) (memq major-mode (quote (gnus-summary-mode news-reply-mode gnus-group-mode gnus-article-mode gnus-kill-file-mode gnus-browse-killed-mode)))) 4010 "Mail (%d)") ((not buffer-file-name) 4099 "Buffers (%d)") ((quote no-multi) 1099 "Files (%d)")) msb--few-menus current-load-list (((and (boundp (quote server-buffer-clients)) server-buffer-clients (quote multi)) 1010 "Clients (%d)") ((and (boundp (quote vc-mode)) vc-mode (quote multi)) 1020 "Version Control (%d)") ((and buffer-file-name (buffer-modified-p) (quote multi)) 1030 "Changed files (%d)") ((and (get-buffer-process (current-buffer)) (quote multi)) 1040 "Processes (%d)") ((and msb-display-invisible-buffers-p (msb-invisible-buffer-p) (quote multi)) 1090 "Invisible buffers (%d)") ((eq major-mode (quote dired-mode)) 2010 "Dired (%d)" msb-dired-item-handler msb-sort-by-directory) ((eq major-mode (quote Man-mode)) 4030 "Manuals (%d)") ((eq major-mode (quote w3-mode)) 4020 "WWW (%d)") ((or (memq major-mode (quote (rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode))) (memq major-mode (quote (mh-letter-mode mh-show-mode mh-folder-mode))) (memq major-mode (quote (gnus-summary-mode news-reply-mode gnus-group-mode gnus-article-mode gnus-kill-file-mode gnus-browse-killed-mode)))) 4010 "Mail (%d)") ((and (not buffer-file-name) (quote no-multi)) 4099 "Other non-file buffers (%d)") ((and (string-match "/\\.[^/]*$" buffer-file-name) (quote multi)) 3090 "Hidden Files (%d)") ((memq major-mode (quote (c-mode c++-mode))) 3010 "C/C++ Files (%d)") ((eq major-mode (quote emacs-lisp-mode)) 3020 "Elisp Files (%d)") ((eq major-mode (quote latex-mode)) 3030 "LaTex Files (%d)") ((quote no-multi) 3099 "Other files (%d)")) msb--very-many-menus boundp msb--many-menus] 2) #@137 *Non-nil means use separators. The separators will appear between all menus that have a sorting key that differs by this value or more. (defvar msb-separator-diff 100 (#$ . -2848)) #@45 *The sort key for files sorted by directory (defvar msb-files-by-directory-sort-key 0 (#$ . -3035)) #@170 *The maximum number of items in a menu. If this variable is set to 15 for instance, then the submenu will be split up in minor parts, 15 items each. Nil means no limit. (defvar msb-max-menu-items 15 (#$ . -3142)) #@340 *The maximum number of items from different directories. When the menu is of type `file by directory', this is the maximum number of buffers that are clumped togehter from different directories. Set this to 1 if you want one menu per directory instead of clumping them together. If the value is not a number, then the value 10 is used. (defvar msb-max-file-menu-items 10 (#$ . -3362)) #@71 *Where should the menu with the most recently used buffers be placed? (defvar msb-most-recently-used-sort-key -1010 (#$ . -3756)) #@123 *How many buffers should be in the most-recently-used menu. No buffers at all if less than 1 or nil (or any non-number). (defvar msb-display-most-recently-used 15 (#$ . -3893)) #@45 *The title for the most-recently-used menu. (defvar msb-most-recently-used-title "Most recently used (%d)" (#$ . -4077)) #@96 *Function that specifies a number of pixels by which the top menu should be shifted leftwards. (defvar msb-horizontal-shift-function (quote (lambda nil 0)) (#$ . -4204)) #@143 *Show invisible buffers or not. Non-nil means that the buffer menu should include buffers that have names that starts with a space character. (defvar msb-display-invisible-buffers-p nil (#$ . -4381)) #@499 *The appearance of a buffer menu. The default function to call for handling the appearance of a menu item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH, where the latter is the max length of all buffer names. The function should return the string to use in the menu. When the function is called, BUFFER is the current buffer. This function is called for items in the variable `msb-menu-cond' that have nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more information. (defvar msb-item-handling-function (quote msb-item-handler) (#$ . -4588)) #@398 *The order of items in a buffer menu. The default function to call for handling the order of items in a menu item. This function is called like a sort function. The items look like (ITEM-NAME . BUFFER). ITEM-NAME is the name of the item that will appear in the menu. BUFFER is the buffer, this is not necessarily the current buffer. Set this to nil or t if you don't want any sorting (faster). (defvar msb-item-sort-function (quote msb-sort-by-name) (#$ . -5167)) #@97 *Non-nil means that files should be sorted by directory instead of the groups in msb-menu-cond. (defvar msb-files-by-directory nil (#$ . -5640)) #@1990 *List of criterias for splitting the mouse buffer menu. The elements in the list should be of this type: (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN). When making the split, the buffers are tested one by one against the CONDITION, just like a lisp cond: When hitting a true condition, the other criterias are *not* tested and the buffer name will appear in the menu with the menu-title corresponding to the true condition. If the condition returns the symbol `multi', then the buffer will be added to this menu *and* tested for other menus too. If it returns `no-multi', then the buffer will only be added if it hasn't been added to any other menu. During this test, the buffer in question is the current buffer, and the test is surrounded by calls to `save-excursion' and `save-match-data'. The categories are sorted by MENU-SORT-KEY. Smaller keys are on top. nil means don't display this menu. MENU-TITLE is really a format. If you add %d in it, the %d is replaced with the number of items in that menu. ITEM-HANDLING-FN, is optional. If it is supplied and is a function, than it is used for displaying the items in that particular buffer menu, otherwise the function pointed out by `msb-item-handling-function' is used. ITEM-SORT-FN, is also optional. If it is not supplied, the function pointed out by `msb-item-sort-function' is used. If it is nil, then no sort takes place and the buffers are presented in least-recently-used order. If it is t, then no sort takes place and the buffers are presented in most-recently-used order. If it is supplied and non-nil and not t than it is used for sorting the items in that particular buffer menu. Note1: There should always be a `catch-all' as last element, in this list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION). Note2: A buffer menu appears only if it has at least one buffer in it. Note3: If you have a CONDITION that can't be evaluated you will get an error every time you do \[msb]. (defvar msb-menu-cond msb--very-many-menus (#$ . -5793)) #@56 Hooks to be run after the msb package has been loaded. (defvar msb-after-load-hooks nil (#$ . 7845)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp msb--last-buffer-menu nil current-load-list msb--error] 2) #@265 Create one string item, concerning BUFFER, for the buffer menu. The item looks like: *% The `*' appears only if the buffer is marked as modified. The `%' appears only if the buffer is read-only. Optional second argument MAXBUF is completely ignored. (defalias 'msb-item-handler #[(buffer &optional maxbuf) "À Á ƒ ‚\fÃ\fƒÅ‚ÃÉÊ$+‡" [buffer-name buffer-modified-p "*" " " buffer-read-only "%" read-only modified name format "%s%s %s"] 5 (#$ . 8060)]) (defalias 'msb--dired-directory #[nil ";ƒ ÁÂ!!‡:ƒÁÂ@!!‡ÃÄÅ \"‡" [dired-directory abbreviate-file-name expand-file-name error "Unknown type of `dired-directory' in buffer %s" buffer-name] 3]) #@273 Create one string item, concerning a dired BUFFER, for the buffer menu. The item looks like: *% The `*' appears only if the buffer is marked as modified. The `%' appears only if the buffer is read-only. Optional second argument MAXBUF is completely ignored. (defalias 'msb-dired-item-handler #[(buffer &optional maxbuf) "À Á ƒ ‚\fÃ\fƒÅ‚ÃÉÊ$+‡" [msb--dired-directory buffer-modified-p "*" " " buffer-read-only "%" read-only modified name format "%s%s %s"] 5 (#$ . 8746)]) #@257 Create one string item for the buffer menu. The item looks like: *%# The `*' appears only if the buffer is marked as modified. The `%' appears only if the buffer is read-only. The `#' appears only version control file (SCCS/RCS). (defalias 'msb-alon-item-handler #[(buffer maxbuf) "À‰Á\n\"Ã\f!Å ƒÆ‚ǃɂÇÊË!ƒ+ ƒ+Ì‚,Ç †2Î&‡" [format "%%%ds %%s%%s%%s %%s" maxbuf buffer-name buffer buffer-modified-p "*" " " buffer-read-only "%" boundp vc-mode "#" buffer-file-name ""] 7 (#$ . 9257)]) #@83 Sorts the items depending on their buffer-name An item look like (NAME . BUFFER). (defalias 'msb-sort-by-name #[(item1 item2) "À A!À\nA!™‡" [buffer-name item1 item2] 3 (#$ . 9790)]) #@99 Sorts the items depending on their directory. Made for dired. An item look like (NAME . BUFFER). (defalias 'msb-sort-by-directory #[(item1 item2) "ŠAqˆÁ )Š\nAqˆÁ )™‡" [item1 msb--dired-directory item2] 2 (#$ . 9978)]) #@278 Pop up several menus of buffers for selection with the mouse. This command switches buffers in the window that you clicked on, and selects that window. See the function `mouse-select-buffer' and the variable `msb-menu-cond' for more information about how the menus are split. (defalias 'msb #[(event) "À ‰A@)‰@)Å !„Æ !ˆÇ !‰ƒ)É!ˆ‚-Æ\f!ˆ+ʇ" [selected-window event position window old-window framep select-window mouse-select-buffer buffer switch-to-buffer nil] 3 (#$ . 10205) "e"]) #@130 Return t if optional BUFFER is an "invisible" buffer. If the argument is left out or nil, then the current buffer is considered. (defalias 'msb-invisible-buffer-p #[(&optional buffer) "À !GÂV…À !ÂHÃ=‡" [buffer-name buffer 0 32] 2 (#$ . 10707)]) (defalias 'msb--strip-path #[(path) "À ÂŽÃÄ \"ƒ ƔƕO‚Ç*‡" [match-data match-data ((store-match-data match-data)) string-match "\\(.+\\)/[^/]+$" path 1 "/"] 3]) (defalias 'msb--init-file-alist #[(list) "ÀÁ \"Ä\"Ɖ‰ ÊÁË \" BC\",‡" [sort mapcan #[(buffer) "À !‰…Ã\n! BC)‡" [buffer-file-name buffer file-name msb--strip-path] 3] list #[(item1 item2) "@ @™‡" [item1 item2] 2] buffer-alist nil result buffers path append #[(item) "ƒ @˜ƒ A\nBǃ\nB @ AC\f…'\fC‡" [path item buffers nil result] 2]] 4]) (defalias 'msb--choose-file-menu #[(list) "À ! §ƒ ‚ĉ‰‰‰‰ \n \f‰ @ A@AƒY‰@ƒŠ G XƒŠ@GGYƒŠ@ÒGO˜ƒŠÓÔ A\"A‰@‚N G VƒÐ@ Õ\nƒ¡Ö‚¢×@AG#ABÂ\n\fB\f@A@A‚UƒâÓ\n BØ!A ƒUG GYƒ Ò GO˜„G GWƒU ÒGO˜ƒUÕ\nƒ)Ö‚*×@AG#ABÂ\n\fB\f@A@A,‚7Õ\nƒcÖ‚d×@AG#ABÂ\n\fB‰\fŸ. ‡" [msb--init-file-alist list nil msb-max-file-menu-items 10 buffers path rest first last-path top-found-p max-clumped-together final-list buffer-alist item new-path tmp-rest found-p 0 t append format "%s/... (%d)" "%s (%d)" msb--strip-path] 10]) (defalias 'msb--create-function-info #[(menu-cond-elt) "ÀÁ! GÄV…Ä 8‰ƒÆ !ƒ ‚ GÉVƒ.É 8‚0\n Æ !„E ƒE Ì=ƒJ ‚L\n GÄWƒYÎÏ!ˆ GÄVƒlÆ !„lÐÑ C\"ˆ GÉVƒ ƒÆ !„ Ì=„ÐÑ C\"ˆ\nÒLˆÓ\n @ A@Ô 8 &-‡" [make-symbol "-msb-buffer-list" list-symbol menu-cond-elt 3 tmp-ih fboundp msb-item-handling-function item-handler 4 msb-item-sort-function tmp-s t sorter error "Wrong format of msb-menu-cond." signal invalid-function nil vector 2] 8]) (defalias 'msb--collect #[(function-info-vector) "À‰‰\fÆÀÀ T‰ GWƒQ HÊËH!‰ƒG Ì=ƒ8\n„G Í=ƒ@Î B ƒ Í=„ Ÿ,‰„b „bÏÐ!ˆ +‡" [nil function-info-list multi-flag result function-info-vector G30900 -1 G30901 fi G30902 eval 1 no-multi multi t error "No catch-all in msb-menu-cond!"] 4]) (put (quote msb--collect) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'msb--add-to-menu #[(buffer function-info max-buffer-name-length) "ÁH‰ÃH\f \"\fBÆ\n!BL)‡" [function-info 0 list-symbol 4 buffer max-buffer-name-length eval] 5]) (defalias 'msb--choose-menu #[(buffer function-info-vector max-buffer-name-length) "?…Á\n!?…ÃÄŇ" [msb-display-invisible-buffers-p msb-invisible-buffer-p buffer nil (byte-code "ŠqˆÁ ĉ‰ É\nÄ Ä\f\nT‰\nGWƒe\nH Í ÎH!‰ƒYÏ=ƒH„YÐ=ƒRÑ \fB\fƒÐ=„\fŸ,‰„w„wÒÓ!ˆ ,\")‡" [buffer mapc #[(function-info) "À \n #‡" [msb--add-to-menu buffer function-info max-buffer-name-length] 4] function-info-vector nil function-info-list multi-flag result G30900 -1 G30901 fi G30902 eval 1 no-multi multi t error "No catch-all in msb-menu-cond!"] 6) ((error (byte-code "?…ÁÂÃ\f!\"Å!‡" [msb--error format "In msb-menu-cond, error for buffer `%s'." buffer-name buffer error] 4)))] 3]) (put (quote msb--choose-menu) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'msb--create-sort-item #[(function-info) "À ÂH!‰…? ÄH ÅH…>È ÉH G\"„+ ‚<Ê=ƒ7 Ÿ‚<Ë \"BB*)‡" [eval function-info 0 buffer-list 5 2 sort-key sorter format 3 t sort] 6]) (defalias 'msb--most-recently-used-menu #[(max-buffer-name-length) "§…{ÁV…{ AÁ ÆÆ :ƒ[ @ŠqˆÉ ?…2\nË=?)ƒNŠqˆ\f \")BB\fT\fY„[ A‰‚Ÿ,;ƒqÐG\"‚wÑÒC\"*B‡" [msb-display-most-recently-used 0 buffer-list buffers n G30903 nil buffer G30904 msb-invisible-buffer-p major-mode dired-mode msb-item-handling-function max-buffer-name-length most-recently-used msb-most-recently-used-title format signal wrong-type-argument] 4]) (defalias 'msb--create-buffer-menu-2 #[nil "ÀÁ‰ÅÆÇ \"ˆÈÉÊË\f\"\"ÅÍÇ \"ˆ ƒ&ÊÎÏ !\"ÁÑ\f!Ó \nÕÁÁÁT‰GWƒgHÚ!‰ƒ?B‚?Ÿ-\"ÊÜÝÞAƒƒBB‚…à\"!\"Óáâ!#…šäåDCæ'ƒ¤è‚¥éêBBC$.‡" [0 nil function-info-vector file-buffers max-buffer-name-length mapc #[(buffer) "„\nÁ ?…\nÃ\f!G]‰‡" [msb-display-invisible-buffers-p msb-invisible-buffer-p max-buffer-name-length buffer-name buffer] 3] buffer-list apply vector mapcar msb--create-function-info msb-menu-cond #[(buffer) "ƒÁ\n!ƒ\n B‰‡\n\f ?…Ç\n!?…'ÈÉÊ+‡" [msb-files-by-directory buffer-file-name buffer file-buffers function-info-vector max-buffer-name-length msb-display-invisible-buffers-p msb-invisible-buffer-p nil (byte-code "ŠqˆÁ ĉ‰ É\nÄ Ä\f\nT‰\nGWƒe\nH Í ÎH!‰ƒYÏ=ƒH„YÐ=ƒRÑ \fB\fƒÐ=„\fŸ,‰„w„wÒÓ!ˆ ,\")‡" [buffer mapc #[(function-info) "À \n #‡" [msb--add-to-menu buffer function-info max-buffer-name-length] 4] function-info-vector nil function-info-list multi-flag result G30900 -1 G30901 fi G30902 eval 1 no-multi multi t error "No catch-all in msb-menu-cond!"] 6) ((error (byte-code "?…ÁÂÃ\f!\"Å!‡" [msb--error format "In msb-menu-cond, error for buffer `%s'." buffer-name buffer error] 4)))] 3] #[(buffer-list) " @ÂÃÄ A\"Å\"BB‡" [msb-files-by-directory-sort-key buffer-list sort mapcar #[(buffer) "Šqˆ \n\")B‡" [buffer msb-item-handling-function max-buffer-name-length] 3] #[(item1 item2) "@ @™‡" [item1 item2] 2]] 6] msb--choose-file-menu menu msb--most-recently-used-menu most-recently-used append G30905 -1 G30906 elt value G30907 msb--create-sort-item others cdr msb--add-separators sort msb-most-recently-used-sort-key #[(elt1 elt2) "@ @W‡" [elt1 elt2] 2] (keymap "Select Buffer") msb--make-keymap-menu msb-separator-diff separator "---" toggle msb-files-by-directory "*Files by type*" "*Files by directory*" msb--toggle-menu-type] 7]) (defalias 'msb--create-buffer-menu #[nil "À ÂŽŠÃ +‡" [match-data match-data ((store-match-data match-data)) msb--create-buffer-menu-2] 1]) (defalias 'msb--toggle-menu-type #[nil "?ÁÂ!‡" [msb-files-by-directory menu-bar-update-buffers t] 2 nil nil]) #@215 Pop up several menus of buffers, for selection with the mouse. Returns the selected buffer or nil if no buffer is selected. The way the buffers are split is conveniently handled with the variable `msb-menu-cond'. (defalias 'mouse-select-buffer #[(event) "„ ƒÂÃ!ƒà ƒÄÅ ÄÂÉ!ƒoÂÊ!ƒo‰A@)Ë8)@‰A@)Ë8)A‰A@)‰@)\f ‰ Z‰ D\fD+ÐÑÒ\"ˆÓ \"‰@Ô=ƒŒÕ ˆÖ!‚Û@§ƒ©A„©×@ ž›Ö!)‚Û@§ƒ¹A‰‚«@;ƒÌA„Ì@‚Û„Ö‚ÛØÙ\"*‡" [msb--error msb--last-buffer-menu fboundp frame-or-buffer-changed-p nil msb--create-buffer-menu event choice position posn-x-y posn-window 2 posWind posY posX msb-horizontal-shift-function sit-for 0 100 x-popup-menu toggle msb--toggle-menu-type mouse-select-buffer 3 error "Unknown form for buffer: %s"] 4 (#$ . 16868)]) (defalias 'msb--add-separators #[(sorted-list) "ƒ §„ ‡ÂÄÅ \")‡" [msb-separator-diff sorted-list nil last-key mapcan #[(item) "ƒ ƒ\n@ ZVƒ\n@‰ÃB\nD‡\n@\nC‡" [msb-separator-diff last-key item separator] 3]] 3]) (defalias 'msb--split-menus-2 #[(list mcount result) "G VƒFÂɉ Wƒ%‰A@\fBT‰‚\fŸ‰@@ÇPÈ Ê F\f\" B +Ì T #‡ „M‡Ã@@ÇPÈ Ê F\" B ) Ÿ‡" [list msb-max-menu-items 0 nil tmp-list sub-name count "..." append mcount keymap result msb--split-menus-2] 6]) (defalias 'msb--split-menus #[(list) "À ÂÃ#‡" [msb--split-menus-2 list 0 nil] 4]) (defalias 'msb--make-keymap-menu #[(raw-menu) "ÀÁBÂÅÆ\"*‡" [(nil) menu-bar-select-buffer 0 mcount end mapcar #[(sub-menu) "Á=ƒ\nÁÂD‡ÃÄA\"ÆT‰@È@FÉ !\")‡" [sub-menu separator "---" mapcar #[(item) "@Aà !\n\f*BB‡" [item buffer string buffer-name end] 3] buffers append mcount keymap msb--split-menus] 5] raw-menu] 3]) (defalias 'menu-bar-update-buffers #[(&optional arg) "ÀÁ Â\"…”ÃÄ!ƒÄ „ …”Æ Ç‰ \nË ‰\f \nAƒi\nG ÎÏ \"¨ƒWÒVƒW VƒW\n›Ç¡ˆÓÔÕ¯Ö×\n\"¤*ØÁ ÙÚ ƒ‹ƒ‹ÕÛ…‚ÝF AA¤‚‘ †‘ÞB#+‡" [lookup-key current-global-map [menu-bar buffer] fboundp frame-or-buffer-changed-p arg frame-list nil frames-menu buffers-menu frames msb--create-buffer-menu msb--last-buffer-menu frame-length format "Frames (%d)" f-title msb-max-menu-items 1 frame (nil) keymap mapcar #[(frame) "ÁÂ!žAÉBEĤ‡" [frame name frame-parameters nil menu-bar-select-frame] 4] define-key [menu-bar buffer] "Buffers" "Buffers and Frames" msb-separator-diff (separator "---") undefined] 9]) (byte-code "ÀÁ!ƒÂÃ!„ÀÄ!„ÅÄBÃÇMˆÀÁ!ƒ/È >„/ÉÁÈ\"ˆÂÊ!ƒ<ËÊÌÍ #ˆÎÌ!ˆÏÌÐÑ!\"‡" [boundp menu-bar-update-hook fboundp frame-or-buffer-changed-p msb--buffer-count 0 current-load-list #[nil "À G‰\nU?… Ã)‡" [buffer-list count msb--buffer-count t] 3] menu-bar-update-buffers add-hook mouse-buffer-menu substitute-key-definition msb current-global-map provide eval-after-load run-hooks msb-after-load-hooks] 4) emacs-19.30/lisp/nnbabyl.elc100666 23053 1 25115 6046561605 14543 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:30:36 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/nnbabyl.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nnbabyl.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!‡" [require nnheader rmail nnmail] 2) #@61 The name of the rmail box file in the users home directory. (defvar nnbabyl-mbox-file (expand-file-name "~/RMAIL") (#$ . 540)) #@48 The name of the active file for the rmail box. (defvar nnbabyl-active-file (expand-file-name "~/.rmail-active") (#$ . 673)) #@75 If non-nil, nnbabyl will check the incoming mail file and split the mail. (defvar nnbabyl-get-new-mail t (#$ . 803)) #@48 Hook run narrowed to an article before saving. (defvar nnbabyl-prepare-save-mail-hook nil (#$ . 926)) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp nnbabyl-mail-delimiter "" current-load-list] 2) #@18 nnbabyl version. (defconst nnbabyl-version "nnbabyl 1.0" (#$ . 1119)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÆÅ BÀÇ!„-ÂÇ BÀÈ!„:ÂÈ BÀÉ!„GÂ É BÀÊ!„TÂ\nÊ BÀË!„qÌ\fDÍ DÎDÏÐѯ Ë B‡" [boundp nnbabyl-mbox-buffer nil current-load-list nnbabyl-current-group nnbabyl-status-string "" nnbabyl-group-alist nnbabyl-active-timestamp nnbabyl-current-server nnbabyl-server-alist nnbabyl-server-variables nnbabyl-mbox-file nnbabyl-active-file nnbabyl-get-new-mail (nnbabyl-current-group nil) (nnbabyl-status-string "") (nnbabyl-group-alist nil)] 6) (defalias 'nnbabyl-retrieve-headers #[(sequence &optional newsgroup server) "ŠqˆÁ ˆ\nGÃĉ‰‰ \nË\f!ˆ\n@;ƒ(Í‚é\nƒº\n@Î!qˆÐÄÑ#„LÒÄÑ#ƒˆÓÔPÄÑ#ˆÖ×!„bØyÃU„U`ÐÙÄÑ#ˆ`SqˆÚÛ!ܱˆÝ #ˆdbˆÞcˆ\nA T §ƒ(\nVƒ( à¦ÃUƒ(!ƒ(âã ä_\n¥\"ˆ‚(§ƒÑ\nVƒÑ!ƒÑâå!ˆqˆebˆæçÄÑ#ƒèèéщ#ˆ‚×Í.‡" [nntp-server-buffer erase-buffer sequence 0 nil stop start art-string article count number nnbabyl-possibly-change-newsgroup newsgroup headers nnbabyl-article-string nnbabyl-mbox-buffer search-forward t search-backward re-search-backward "^" nnbabyl-mail-delimiter looking-at ".+:" 1 "\n\n" "221 " int-to-string " Article retrieved.\n" insert-buffer-substring ".\n" nnmail-large-newsgroup 20 gnus-verbose-backends message "nnbabyl: Receiving headers... %d%%" 100 "nnbabyl: Receiving headers...done" re-search-forward "\\( ?\n[ ]+\\)+" replace-match " "] 6]) (defalias 'nnbabyl-open-server #[(server &optional defs) "À ˆ \nšƒ Ç\nƒ\nÄ !DBÇ \"‰ƒ6ÉA@!ˆÊ\"‚<Ë \f\"ˆ) ‰‡" [nnheader-init-server-buffer server nnbabyl-current-server t nnheader-save-variables nnbabyl-server-variables nnbabyl-server-alist assoc state nnheader-restore-variables delq nnheader-set-init-variables defs] 4]) (defalias 'nnbabyl-close-server #[(&optional server) "À‡" [t] 1]) (defalias 'nnbabyl-server-opened #[(&optional server) " š…\n…Ã\n!…\f…Ã\f!‡" [server nnbabyl-current-server nnbabyl-mbox-buffer buffer-name nntp-server-buffer] 2]) (defalias 'nnbabyl-status-message #[(&optional server) "‡" [nnbabyl-status-string] 1]) (defalias 'nnbabyl-request-article #[(article &optional newsgroup server buffer) "À !ˆ\n;?…›Š qˆebˆÄÅ\n!ÆÇ#…šÆ‰‰ \nËÌ PÆÇ#ˆÎÏ!„:ÐyÑU„-`\nÒÌ PÆÇ#ƒMÓy„Pdbˆ` †Z‰qˆÖ ˆ× \n #ˆebˆÎØ!ÄÙÆÇ#ƒ˜ƒ‰eÐyˆ`|ˆ‚˜Ñyˆ`ÄÚÆÇ#†–`|ˆ,Ç)‡" [nnbabyl-possibly-change-newsgroup newsgroup article nnbabyl-mbox-buffer search-forward nnbabyl-article-string nil t summary-line stop start re-search-backward "^" nnbabyl-mail-delimiter looking-at ".+:" 1 0 re-search-forward -1 buffer nntp-server-buffer erase-buffer insert-buffer-substring "Summary-line:" "\n*** EOOH ***" "\n\n"] 6]) (defalias 'nnbabyl-request-group #[(group &optional server dont-check) "ŠÀ !…A\nƒÂAÄ !ˆŠ qˆÆ ˆÇ \" ÊË A@A A@@ZT A@@ A@A @%cˆ*Ã)‡" [nnbabyl-possibly-change-newsgroup group dont-check t nnbabyl-get-new-mail nntp-server-buffer erase-buffer assoc nnbabyl-group-alist active format "211 %d %d %d %s\n"] 6]) (defalias 'nnbabyl-close-group #[(group &optional server) "À‡" [t] 1]) (defalias 'nnbabyl-request-create-group #[(group &optional server) "ÀÁ!ˆÂ \f\"„ Å ÇÈB‰D\fBÉ\f\n\"ˆ)ˇ" [nnmail-activate nnbabyl assoc group nnbabyl-group-alist nil active 1 0 nnmail-save-active nnbabyl-active-file t] 3]) (defalias 'nnbabyl-request-list #[(&optional server) "ƒÁ ˆŠÂ !†Ä Æ \"ˆÂ !)‡" [server nnbabyl-get-new-mail nnmail-find-file nnbabyl-active-file nnmail-get-active nnbabyl-group-alist nnmail-save-active] 3]) (defalias 'nnbabyl-request-newgroups #[(date &optional server) "À !‡" [nnbabyl-request-list server] 2]) (defalias 'nnbabyl-request-list-newsgroups #[(&optional server) "À‡" ["nnbabyl: LIST NEWSGROUPS is not implemented." nnbabyl-status-string nil] 1]) (defalias 'nnbabyl-request-post #[(&optional server) "ÀÁ!‡" [mail-send-and-exit nil] 2]) (defalias (quote nnbabyl-request-post-buffer) (quote nnmail-request-post-buffer)) (defalias 'nnbabyl-request-expire-articles #[(articles newsgroup &optional server force) "À !ˆ\nƒ\n !† ÅÇÉÊ!ˆŠ qˆÌedÇ#ˆ ƒxƒxebˆÎÏ @!ÇÅ#ƒo„UÑÒ `Lj`{\"\fV‰ƒgƒaÔÕ @\"ˆÖ ˆ‚o @B A‰ „*× ˆØ \"A@ebˆÎÏ@!ÇÅ#„ª@AXƒª‰@T ˆebˆ‚‡)Û\"ˆ ¤,‡" [nnbabyl-possibly-change-newsgroup newsgroup nnmail-expiry-wait-function nnmail-expiry-wait days t is-old nil rest nnmail-activate nnbabyl nnbabyl-mbox-buffer set-text-properties articles search-forward nnbabyl-article-string force nnmail-days-between current-time-string gnus-verbose-backends message "Deleting article %s..." nnbabyl-delete-mail save-buffer assoc nnbabyl-group-alist active nnmail-save-active nnbabyl-active-file] 5]) (defalias 'nnbabyl-request-move-article #[(article group server accept-form &optional last) "À !ˆÂÃ!ÄÇ  #ƒiŠqˆÊ !ˆebˆÌÍŠÎÏÄÐ#ˆ`)Ð#ƒ<Ñyˆ`Òyˆ`|ˆÓ!Õp!ˆ )ƒiŠqˆebˆÎ×!ÄÐ#ƒ`Ø ˆƒhÚ ˆ) *‡" [nnbabyl-possibly-change-newsgroup group get-buffer-create " *nnbabyl move*" nil result buf nnbabyl-request-article article server insert-buffer-substring nntp-server-buffer re-search-forward "^X-Gnus-Newsgroup:" search-forward "\n\n" t 0 1 eval accept-form kill-buffer nnbabyl-mbox-buffer nnbabyl-article-string nnbabyl-delete-mail last save-buffer] 6]) (defalias 'nnbabyl-request-accept-article #[(group &optional last) "pÀ‰ÄÅ!…hŠebˆÆÇÀÈ#ˆÉyˆŠÊË È#ƒ,`Ìyˆ`|ˆ‚) ;ƒ; ÎDC‚=Ð @)qˆdbˆÒÓ!ˆÔ•bˆÕ !ˆƒf× ˆØ\"ˆ\n)+‡" [nil beg result buf nnmail-activate nnbabyl search-forward "\n\n" t -1 re-search-backward "^X-Gnus-Newsgroup: " 1 group "" nnmail-split-methods nnbabyl-save-mail nnbabyl-mbox-buffer search-backward "\n" 0 insert-buffer last save-buffer nnmail-save-active nnbabyl-group-alist nnbabyl-active-file] 4]) (defalias 'nnbabyl-request-replace-article #[(article group buffer) "À !ˆŠ\nqˆebˆÃÄ !ÆÇ#…#Èlj\"ˆÉ\n!ˆË ˆÇ)‡" [nnbabyl-possibly-change-newsgroup group nnbabyl-mbox-buffer search-forward nnbabyl-article-string article nil t nnbabyl-delete-mail insert-buffer-substring buffer save-buffer] 4]) (defalias 'nnbabyl-delete-mail #[(&optional force leave-delim) "„Áyˆ`Âyˆ`|ˆŠŒ~ˆŠÃÄ PÆÇ#ˆƒ'Âyˆ`‚)Á”)ÂyˆÉÄ PÆÇ#ƒLo„GƒGÊyˆ`‚IÁ”†Md}ˆebˆ„_ÉËÆÇ#?…bed|*‡" [force 0 1 re-search-backward "^" nnbabyl-mail-delimiter nil t leave-delim re-search-forward -2 "^X-Gnus-Newsgroup: "] 5]) (defalias 'nnbabyl-possibly-change-newsgroup #[(newsgroup) "ƒ\nÁ!„ŠÂ ˆ) „ÄÅ!ˆ….Ç \"ƒ*‰‡É\nˇ" [nnbabyl-mbox-buffer buffer-name nnbabyl-read-mbox nnbabyl-group-alist nnmail-activate nnbabyl newsgroup assoc nnbabyl-current-group "No such group in file" nnbabyl-status-string nil] 3]) (defalias 'nnbabyl-article-string #[(article) "À ÂÃ\f!Å°‡" ["\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" int-to-string article " "] 5]) #@68 Insert how many lines and chars there are in the body of the mail. (defalias 'nnbabyl-insert-lines #[nil "À‰ŠebˆÃÄÀÅ#…KÆÇ!ƒÃÄÀÅ#ˆd`ZÈ`d\"ÉZebˆÃÄÀÅ#ˆÊuˆŠËÌÀÅ#ƒC`Éyˆ`|ˆ)ÍÎ\n\"cˆ +‡" [nil chars lines search-forward "\n\n" t looking-at "\\*\\*\\* EOOH \\*\\*\\*" count-lines 1 -1 re-search-backward "^Lines: " format "Lines: %d\n"] 4 (#$ . 7853)]) (defalias 'nnbabyl-save-mail #[nil "ÀÁ!Ÿà ˆÄ\n!ˆÅ\n!ˆÆÇ!ˆ\n)‡" [nnmail-article-group nnbabyl-active-number group-art nnbabyl-insert-lines nnmail-insert-xref nnbabyl-insert-newsgroup-line run-hooks nnbabyl-prepare-save-mail-hook] 2]) (defalias 'nnbabyl-insert-newsgroup-line #[(group-art) "ŠebˆÀÁ!ƒÂÃĉ#ˆÅyˆ‚ebˆÀÆ!„*ŠÇcˆdbˆÈcˆ)ÉÊËÄ#ƒRÌuˆ ƒRÎÏ @@ @AÐ $cˆ A‰ „:)ć" [looking-at "From " replace-match "Mail-from: From " t 1 "\f" "\f\n0, unseen,,\n*** EOOH ***\n" "\n" search-forward "\n\n" nil -1 group-art format "X-Gnus-Newsgroup: %s:%d %s\n" current-time-string] 6]) (defalias 'nnbabyl-active-number #[(group) "À \n\"A@‰ƒ ‰AT¡ˆ‚ ĉB‰D\nB A)‡" [assoc group nnbabyl-group-alist active 1] 4]) (defalias 'nnbabyl-read-mbox #[nil "ÀÁ!ˆÂ !„!ŠÄ !‰qˆ ÇcˆÈed ÉÊ%ˆ) …8Ë !…8Š qˆÌ ÍÎ !8U)?…³ŠÏPщÕ ÑÖ#‰qˆ×p!ˆ~ˆÑÙ ˆebˆÚÑÉ#ˆÛ•ÚÑÉ#ƒ£Û•ÜÝÉ#„™bˆŠŒbˆ}ˆÞ ˆd*‰bˆ‚lßp!ƒ¬à ˆá\"#\",‡" [nnmail-activate nnbabyl file-exists-p nnbabyl-mbox-file create-file-buffer nnbabyl-mbox-buffer buffer-file-name "BABYL OPTIONS:\n\n" write-region t nomesg buffer-name buffer-size 7 file-attributes "^" nnbabyl-mail-delimiter nil end start delim nnheader-find-file-noselect raw buffer-disable-undo buffer-read-only fundamental-mode re-search-forward 0 search-backward "\nX-Gnus-Newsgroup: " nnbabyl-save-mail buffer-modified-p save-buffer nnmail-save-active nnbabyl-group-alist nnbabyl-active-file] 6]) (defalias 'nnbabyl-remove-incoming-delims #[nil "ebˆÀÁÂÃ#…ÄÅÉ#ˆ‚‡" [search-forward "" nil t replace-match "?"] 4]) #@25 Read new incoming mail. (defalias 'nnbabyl-get-new-mail #[(&optional group) "À ! ÄÄÇ ˆ?† ??…å\nƒÊ\n@!ƒ–ËÌ\n@!8ÍVƒ–ƒ:ÏÐ!ˆÑ\n@ÓP\"‰ƒ– BŠÔ\n@ \"ÕBÄØ ÙÚ $‰qˆebˆÛÜÄÚ#ƒzÝÞ!ˆ‚kqˆdbˆàáÄÚ#ˆÍ•bˆâ!ˆã!ˆ+\nA‰„ä!ƒ´Šå&'\"ˆqˆè ˆ)ƒ½éê!ˆ…å@+ƒÛÊ !ƒÛì !ƒÛí !ˆA‰„ÂÄ,‡" [nnmail-get-spool-files group spools group-in nil incoming incomings nnbabyl-read-mbox nnbabyl-get-new-mail nnmail-spool-file file-exists-p 7 file-attributes 0 gnus-verbose-backends message "nnbabyl: Reading incoming mail..." nnmail-move-inbox nnbabyl-mbox-file "-Incoming" nnmail-get-split-group nnbabyl-remove-incoming-delims nnmail-prepare-incoming-hook in-buf nnmail-split-incoming nnbabyl-save-mail t search-forward "\n\n" delete-char -1 nnbabyl-mbox-buffer search-backward "\n" insert-buffer-substring kill-buffer buffer-modified-p nnmail-save-active nnbabyl-group-alist nnbabyl-active-file save-buffer run-hooks nnmail-read-incoming-hook nnmail-delete-incoming file-writable-p delete-file] 6 (#$ . 9768)]) (provide (quote nnbabyl)) emacs-19.30/lisp/nndir.elc100666 23053 1 7174 6046561616 14217 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:30:39 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/nndir.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nndir.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÄÅÆ\"ˆÇÈ B À‡" [require nnheader nnmh nnml autoload mail-send-and-exit "sendmail" "nndir 1.0" nndir-version current-load-list] 3) #@31 Current news group directory. (defvar nndir-current-directory nil (#$ . 633)) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp nndir-status-string "" current-load-list] 2) #@60 *Non-nil means that nndir will never retrieve NOV headers. (defvar nndir-nov-is-evil nil (#$ . -798)) (defalias 'nndir-retrieve-headers #[(sequence &optional newsgroup server) "ÀÁ\n\"‡" [nndir-execute-nnml-command (nnml-retrieve-headers sequence group server) server] 3]) #@21 Open nndir backend. (defalias 'nndir-open-server #[(host &optional service) "À ‡" ["" nndir-status-string nnheader-init-server-buffer] 1 (#$ . 1076)]) #@20 Close news server. (defalias 'nndir-close-server #[(&optional server) "À‡" [t] 1 (#$ . 1235)]) #@98 Return server process status, T or NIL. If the stream is opened, return T, otherwise return NIL. (defalias 'nndir-server-opened #[(&optional server) "…Á!‡" [nntp-server-buffer get-buffer] 2 (#$ . 1336)]) #@42 Return server status response as string. (defalias 'nndir-status-message #[(&optional server) "‡" [nndir-status-string] 1 (#$ . 1550)]) (defalias 'nndir-request-article #[(id &optional newsgroup server buffer) "ÀÁ\n\"‡" [nndir-execute-nnmh-command (nnmh-request-article id group server buffer) server] 3]) #@20 Select news GROUP. (defalias 'nndir-request-group #[(group &optional server dont-check) "ÀÁ\n\"‡" [nndir-execute-nnmh-command (nnmh-request-group group "" dont-check) server] 3 (#$ . 1863)]) #@48 Get list of active articles in all newsgroups. (defalias 'nndir-request-list #[(&optional server dir) "ÀÁ\n\"‡" [nndir-execute-nnmh-command (nnmh-request-list nil dir) server] 3 (#$ . 2060)]) (defalias 'nndir-request-newgroups #[(date &optional server) "ÀÁ\n\"‡" [nndir-execute-nnmh-command (nnmh-request-newgroups date server) server] 3]) #@36 Post a new news in current buffer. (defalias 'nndir-request-post #[(&optional server) "ÀÁ!‡" [mail-send-and-exit nil] 2 (#$ . 2406)]) (defalias (quote nndir-request-post-buffer) (quote nnmail-request-post-buffer)) #@58 Expire all articles in the ARTICLES list in group GROUP. (defalias 'nndir-request-expire-articles #[(articles newsgroup &optional server force) "À‡" ["nndir: expire not possible" nndir-status-string nil] 1 (#$ . 2626)]) (defalias 'nndir-close-group #[(group &optional server) "À‡" [t] 1]) (defalias 'nndir-request-move-article #[(article group server accept-form) "À‡" ["nndir: move not possible" nndir-status-string nil] 1]) (defalias 'nndir-request-accept-article #[(group) "À‡" ["nndir: accept not possible" nndir-status-string nil] 1]) (defalias 'nndir-execute-nnmh-command #[(command server) "À !ÃÄ\n\"ƒ\nʼn”OÃÆ\n\"ˆ\nÅ”TÇO\nʼn”TOÇ \nË\f!,‡" [expand-file-name server dir string-match "/$" 0 "/[^/]+$" nil nnmh-get-new-mail nnmh-directory group eval command] 4]) (defalias 'nndir-execute-nnml-command #[(command server) "À !ÃÄ\n\"ƒ\nʼn”OÃÆ\n\"ˆ\nÅ”TÇO\nʼn”TOÇ \n \fÍ!-‡" [expand-file-name server dir string-match "/$" 0 "/[^/]+$" nil nndir-nov-is-evil nnml-get-new-mail nnml-nov-is-evil nnml-directory group eval command] 4]) (provide (quote nndir)) emacs-19.30/lisp/nndoc.elc100666 23053 1 16301 6046561630 14212 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:30:40 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/nndoc.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nndoc.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!‡" [require nnheader rmail nnmail] 2) #@57 *Type of the file - one of `mbox', `babyl' or `digest'. (defvar nndoc-article-type (quote mbox) (#$ . -536)) #@282 Type of the last digest. Auto-detected from the article header. Possible values: `traditional' -- the "lots of dashes" (30+) rules used; we currently also do unconditional RFC 934 unquoting. `rfc1341' -- RFC 1341 digest (MIME, unique boundary, no quoting). (defvar nndoc-digest-type (quote traditional) (#$ . 652)) #@56 Regular expressions for articles of the various types. (defconst nndoc-type-to-regexp (byte-code "ÀÁ\nPÁ\nPÃÄɉ¯ÅÆÇÈÄÉɯÊˉÃÌËÍïE‡" [mbox "^" rmail-unix-mail-delimiter nil "^$" babyl "\f *\n" "" "^[0-9].*\n" "\\*\\*\\* EOOH \\*\\*\\*\n\\(^.+\n\\)*" digest "^------------------------------*[\n ]+" "^ ?$" "^End of"] 10) (#$ . 997)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ BÀÈ!„GÂÈ BÀÉ!„TÂ É BÀÊ!„aÂ\nÊ BÀË!„nÂ Ë BÀÌ!„ŠÍ DÎÏÐÑÒÓÔÕÖׯ \fÌ B‡" [boundp nndoc-article-begin nil current-load-list nndoc-article-end nndoc-head-begin nndoc-head-end nndoc-first-article nndoc-end-of-file nndoc-body-begin nndoc-current-server nndoc-server-alist nndoc-server-variables nndoc-article-type (nndoc-article-begin nil) (nndoc-article-end nil) (nndoc-head-begin nil) (nndoc-head-end nil) (nndoc-first-article nil) (nndoc-current-buffer nil) (nndoc-group-alist nil) (nndoc-end-of-file nil) (nndoc-body-begin nil) (nndoc-address nil)] 11) #@16 nndoc version. (defconst nndoc-version "nndoc 1.0" (#$ . 1983)) #@28 Current nndoc news buffer. (defvar nndoc-current-buffer nil (#$ . 2053)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÂÆ B‡" [boundp nndoc-address nil current-load-list nndoc-status-string "" nndoc-group-alist] 2) (defalias 'nndoc-retrieve-headers #[(sequence &optional newsgroup server) "ŠqˆÁ ˆÂɉ‰É\n \"ˆ\f@;ƒ&Í‚âqˆ~ˆebˆÏ†7ÃÒ#ˆƒGÏÃÒ#ˆÏÃÒ#ˆ\fƒÊ\f@qˆÕÖZ]!ƒ½`×ÃÒ#ƒyÖ•†zebˆØ`ÏÃÒ#ƒÖ”b†’db\"qˆÚÛ\"cˆÜ #ˆdbˆ`SfÝU„´ÞcˆÚß\f\"cˆàcˆ\fA‰\f„SqˆebˆÏáÃÒ#ƒáâãÒ‰#ˆ‚ÐÍ.‡" [nntp-server-buffer erase-buffer 2 nil lines beg p article prev nndoc-possibly-change-buffer newsgroup server sequence headers nndoc-current-buffer re-search-forward nndoc-first-article nndoc-article-begin t nndoc-head-begin nndoc-head-end nndoc-forward-article 0 re-search-backward count-lines nndoc-article-end format "221 %d Article retrieved.\n" insert-buffer-substring 10 "\n" "Lines: %d\n" ".\n" "\\( ?\n[ ]+\\)+" replace-match " "] 7]) (defalias 'nndoc-open-server #[(server &optional defs) "À ˆ \nšƒ Ç\nƒ\nÄ !DBÇ \"‰ƒ6ÉA@!ˆÊ\"‚<Ë \f\"ˆ)  žA‰\f@\fA@Ñ\f8Ó\f8Õ\f8×\f8Ù\f8)Ç" [nnheader-init-server-buffer server nndoc-current-server t nnheader-save-variables nndoc-server-variables nndoc-server-alist assoc state nnheader-restore-variables delq nnheader-set-init-variables defs nndoc-article-type nndoc-type-to-regexp nndoc-article-begin nndoc-article-end 2 nndoc-head-begin 3 nndoc-head-end 4 nndoc-first-article 5 nndoc-end-of-file 6 nndoc-body-begin] 4]) (defalias 'nndoc-close-server #[(&optional server) "À‡" [t] 1]) (defalias 'nndoc-server-opened #[(&optional server) " š… \n… Ã\n!‡" [server nndoc-current-server nntp-server-buffer buffer-name] 2]) (defalias 'nndoc-status-message #[(&optional server) "‡" [nndoc-status-string] 1]) (defalias 'nndoc-request-article #[(article &optional newsgroup server buffer) "À \n\"ˆŠ † \f‰qˆÅ ˆ;?…mÇ!ˆÉ=ƒ@\nË=ƒ@ebˆÌÍÎÏ#ƒ@ÐÑω#ˆ‚/ebˆÒÓÎÏ#„lÌÔÎÏ#ƒ\\ÐÕω#ˆ‚lÖ×!ƒiØyÙU„\\ÓcˆÏ*‡" [nndoc-possibly-change-buffer newsgroup server buffer nntp-server-buffer erase-buffer article nndoc-insert-article nndoc-article-type digest nndoc-digest-type traditional re-search-forward "^- -" nil t replace-match "-" search-forward "\n\n" "^[ ]+$" "" looking-at "[^ ]+:" 1 0] 5]) #@20 Select news GROUP. (defalias 'nndoc-request-group #[(group &optional server dont-check) "ŠÀ \n\"„ÃÅ‚AÆ ˆƒÈ‚AŠ qˆÊ ˆË ‰\fÍUƒ4Î !ˆÅ‚@ÏÐ\fÑ\f %cˆÈ*)‡" [nndoc-possibly-change-buffer group server "No such file or buffer" nndoc-status-string nil nndoc-set-header-dependent-regexps dont-check t nntp-server-buffer erase-buffer nndoc-number-of-articles number 0 nndoc-close-group format "211 %d %d %d %s\n" 1] 7 (#$ . 4370)]) (defalias 'nndoc-close-group #[(group &optional server) "À \n\"ˆÃ\f!ˆÅÆ \"\"ÈÈ ʇ" [nndoc-possibly-change-buffer group server kill-buffer nndoc-current-buffer delq assoc nndoc-group-alist nil nndoc-current-server t] 4]) (defalias 'nndoc-request-list #[(&optional server) "À‡" [nil] 1]) (defalias 'nndoc-request-newgroups #[(date &optional server) "À‡" [nil] 1]) (defalias 'nndoc-request-list-newsgroups #[(&optional server) "À‡" [nil] 1]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias nndoc-request-post nnmail-request-post nndoc-request-post-buffer nnmail-request-post-buffer] 3) (defalias 'nndoc-possibly-change-buffer #[(group source) "À\nƒ\nÃ\f \"A‰=†t ƒ ‰‚tÆ!ƒ*È!„?;…tÉ!…tÊ!?…t\fËÌ\fÍQ!‰B BŠ\nqˆÎp!ˆÏ ˆ;ƒeÐ!ˆ‚rŠqˆ~ˆ)Ñ!ˆ)Ò)‡" [nil buf nndoc-current-buffer assoc group nndoc-group-alist bufferp nndoc-address buffer-name file-exists-p file-directory-p get-buffer-create " *nndoc " "*" buffer-disable-undo erase-buffer insert-file-contents insert-buffer-substring t] 5]) (defalias 'nndoc-set-header-dependent-regexps #[nil "Á=…PÂÉŠqˆebˆÈÉÊPÃÂ#ƒKË”ƒKÌ ÎÏ˔˕{\"Ð ÑQ‰Ð ÓQ\fÐ ÖQ‰‚O؉ ,‡" [nndoc-article-type digest t nil b-delimiter boundary-id case-fold-search nndoc-current-buffer re-search-forward "\n\n\\|^Content-Type: *multipart/digest;[ \n]*[ ]" "boundary=\"\\([^\"\n]*[^\" \n]\\)\"" 1 rfc1341 nndoc-digest-type format "%s" "\n--" "[\n ]+" nndoc-article-begin "\\(--\\)?[\n ]+" nndoc-article-end nndoc-first-article "--[ ]*$" nndoc-end-of-file traditional] 5]) (defalias 'nndoc-forward-article #[(n) "ÁVƒ, ÄÅ#ƒ,ƒÂÄÅ#ƒ,ÂÄÅ#ƒ,S‰‚ÁU‡" [n 0 re-search-forward nndoc-article-begin nil t nndoc-head-begin nndoc-head-end] 5]) (defalias 'nndoc-number-of-articles #[nil "Šqˆ~ˆebˆÁÃ\f† ÆÇ#ƒJÈà ÆÇ#ƒJ ƒ-Ê !„J ƒ;à ÆÇ#ƒJÃ\fÆÇ#ƒJ\nT‚\n*‡" [nndoc-current-buffer 0 num re-search-forward nndoc-first-article nndoc-article-begin nil t 1 nndoc-end-of-file looking-at nndoc-head-begin nndoc-head-end] 4]) (defalias 'nndoc-narrow-to-article #[(article) "Šqˆ~ˆebˆÁ\nÃÄ#ƒ S‰ÆUƒ ÆU…4Æ•ÁÃÄ#ƒ0Æ”†1d}ˆÄ)‡" [nndoc-current-buffer re-search-forward nndoc-article-begin nil t article 0 nndoc-article-end] 5]) (defalias 'nndoc-insert-article #[(article) "pŠ qˆ~ˆebˆÂ ÄÅ#ƒS‰ÇUƒ ÇU…rÇ•ÂÄÅ#ƒ5Ç”†6d}ˆebˆ ƒM ÄÅ#ƒM`d}ˆÂ\nÄÅ#„YdbˆËe`#ˆ\fƒkÂ\fÄÅ#ˆË`d#ˆÅ*‡" [ibuf nndoc-current-buffer re-search-forward nndoc-article-begin nil t article 0 nndoc-article-end nndoc-head-begin nndoc-head-end append-to-buffer nndoc-body-begin] 5]) (provide (quote nndoc)) emacs-19.30/lisp/nneething.elc100666 23053 1 14416 6046561640 15076 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:30:41 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/nneething.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nneething.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require nnheader nnmail] 2) #@23 *Map files directory. (defvar nneething-map-file-directory "~/.nneething/" (#$ . -534)) #@54 *Regexp saying what files to exclude from the group. (defvar nneething-exclude-files "~$" (#$ . -628)) #@21 *Name of map files. (defvar nneething-map-file ".nneething" (#$ . -737)) #@20 nneething version. (defconst nneething-version "nneething 1.0" (#$ . 816)) #@31 Current news group directory. (defvar nneething-current-directory nil (#$ . 897)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÅÆ BÀÇ!„.ÅÇ BÀÈ!„;ÅÈ BÀÉ!„HÅ É BÀÊ!„UÅ\nÊ BÀË!„iÆDÌÍÎF Ë BŇ" [boundp nneething-status-string "" current-load-list nneething-group-alist nil nneething-directory nneething-group nneething-map nneething-read-only nneething-active nneething-server-variables (nneething-current-directory nil) (nneething-status-string "") (nneething-group-alist)] 4) (defalias 'nneething-retrieve-headers #[(sequence &optional newsgroup server) "À !ˆŠ\nqˆÃ ˆ\fGƧ… V Ê Ê\f\f@;ƒ-Í‚\fƒ\f@ Î !\fÏ\f!ƒ\\ÐÑ\f!8ÆU„\\ÒÓ \"cˆÔ\f!ˆÕcˆ\fAT ƒ-Ö¦ÆUƒ-×ØÙ_ ¥\"ˆ‚- ƒˆ×Ú!ˆebˆÛÜÊÝ#ƒœÞß݉#ˆ‚‹Í.‡" [nneething-possibly-change-directory newsgroup nntp-server-buffer erase-buffer sequence number 0 count nnmail-large-newsgroup large nil article file headers nneething-file-name file-exists-p 7 file-attributes format "221 %d Article retrieved.\n" nneething-insert-head ".\n" 20 message "nneething: Receiving headers... %d%%" 100 "nneething: Receiving headers...done" re-search-forward "\\( ?\n[ ]+\\)+" t replace-match " "] 4]) (defalias 'nneething-open-server #[(server &optional defs) "À ‡" ["" nneething-status-string nnheader-init-server-buffer] 1]) (defalias 'nneething-close-server #[(&optional server) "À‡" [t] 1]) (defalias 'nneething-server-opened #[(&optional server) "À‡" [t] 1]) (defalias 'nneething-status-message #[(&optional server) "‡" [nneething-status-string] 1]) (defalias 'nneething-request-article #[(id &optional newsgroup server buffer) "À !ˆ\n;?… Ã\n!\f† ‰;…AÇ!…AÈ!?…AŠÉ!ˆÊ „?ebˆË!ˆÌcˆ)Í*‡" [nneething-possibly-change-directory newsgroup id nneething-file-name buffer nntp-server-buffer file file-exists-p file-directory-p nnmail-find-file nnheader-article-p nneething-make-head "\n" t] 3]) (defalias 'nneething-request-group #[(group &optional dir dont-check) "À \n\"ˆ „\fÄ ˆŠ qˆÆ ˆ@AVƒ&ÈÉ \"cˆ‚:ÈÊAT@Z@A %cˆ)ˇ" [nneething-possibly-change-directory group dir dont-check nneething-create-mapping nntp-server-buffer erase-buffer nneething-active format "211 0 1 0 %s\n" "211 %d %d %d %s\n" t] 6]) (defalias 'nneething-request-list #[(&optional server dir) "ŠqˆÁ ˆ)‡" [nntp-server-buffer erase-buffer nil] 1]) (defalias 'nneething-request-newgroups #[(date &optional server) "ŠqˆÁ ˆ)‡" [nntp-server-buffer erase-buffer nil] 1]) (defalias 'nneething-request-post #[(&optional server) "ÀÁ!‡" [mail-send-and-exit nil] 2]) (defalias (quote nneething-request-post-buffer) (quote nnmail-request-post-buffer)) (defalias 'nneething-close-group #[(group &optional server) "À‡" [t] 1]) (defalias 'nneething-possibly-change-directory #[(group &optional dir) "…Q ƒ ˜ƒ‡ÃÅ\"‰ƒ1\fA@È\f8 Ê\f8‰ ‚P\fà ÍÎB Ï ˆ\f  FB‰)‡" [group nneething-group t nil entry assoc nneething-group-alist nneething-directory 2 nneething-map 3 nneething-active dir 1 0 nneething-create-mapping] 4]) (defalias 'nneething-map-file #[nil "À Â\"ˆÃ !\f Q‡" [make-directory nneething-map-file-directory parents file-name-as-directory nneething-group nneething-map-file] 3]) (defalias 'nneething-create-mapping #[nil "À Á\n!ÃÇ!ƒÃÈɈ\n„ ËÌB\n à ‰ƒVÏ@\"ƒI ƒC A¡ˆ‚M A‚M A‰„**à ‰ƒ‘@@ ƒr ‚ˆÓ ƒƒ A¡ˆ‚ˆAA‰„b* ƒºÔ @\"„³Ó\n‰AT¡ˆ @\nABB A‰„–\f?†Á?…îŠÖ×!qˆØp!ˆÙ ˆÚÛ!ÜÝÛ\n!ܱˆÞedÃß%ˆàp!)+‡" [nneething-map-file directory-files nneething-directory nil touched files map-file file-exists-p (byte-code "À ÂÉ$‡" [load map-file nil t] 5) ((error)) nneething-active 1 0 prev f string-match nneething-exclude-files nneething-map map t assoc nneething-read-only get-buffer-create " *nneething map*" buffer-disable-undo erase-buffer "(setq nneething-map '" prin1-to-string ")\n" "(setq nneething-active '" write-region nomesg kill-buffer] 7]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀ‡" [boundp nneething-message-id-number 0 current-load-list nneething-work-buffer " *nneething work*"] 2) (defalias 'nneething-insert-head #[(file) "À !…  !‡" [nneething-get-head file insert-buffer-substring nneething-work-buffer] 2]) (defalias 'nneething-make-head #[(file) "À !ÃÄ !ÅÆÇT‰!ÉÊ ËÌÍÎ\n8!ÅÏÐ\n8!ÑÇÒ\n8!ű)‡" [file-attributes file atts "Subject: " file-name-nondirectory "\n" "Message-ID: \n" "Date: " current-time-string 5 nneething-from-line 2 "Chars: " 7] 16]) (defalias 'nneething-from-line #[(uid) "ÀÁÂÀÃÄÇÈÉ ƒÊ ËQ‚ÌÍ°*‡" [nil (user-login-name uid) ((error (byte-code "Á Uƒ\n ‡ÃUƒćÅ!‡" [uid user-uid user-login-name 0 "root" int-to-string] 2))) (user-full-name uid) ((error (byte-code "Á Uƒ\n ‡ÃU…ć" [uid user-uid user-full-name 0 "Ms. Root"] 2))) name login "From: " "@" system-name " (" ")" "" "\n"] 7]) (defalias 'nneething-get-head #[(file) "ŠÀ !qˆÂÄp!ˆÅ ˆÆ!„‚[È!„(É!ƒ1Ê!ˆË‚[Ì!ˆÍ ƒRebˆÎÏÂË#ƒK`S†Ldd|ˆ‚ZÅ ˆÊ!ˆË)‡" [get-buffer-create nneething-work-buffer nil case-fold-search buffer-disable-undo erase-buffer file-exists-p file file-directory-p file-symlink-p nneething-make-head t nnheader-insert-head nnheader-article-p search-forward "\n\n"] 4]) (defalias 'nneething-number-to-file #[(number) "À \n\"@‡" [rassq number nneething-map] 3]) (defalias 'nneething-file-name #[(article) "À !\n§ƒÃ\n!‚\nP‡" [file-name-as-directory nneething-directory article nneething-number-to-file] 3]) (provide (quote nneething)) emacs-19.30/lisp/nnfolder.elc100666 23053 1 31573 6046561652 14734 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:30:43 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/nnfolder.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nnfolder.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!‡" [require nnheader rmail nnmail] 2) #@60 The name of the mail box file in the users home directory. (defvar nnfolder-directory (expand-file-name "~/Mail/") (#$ . 542)) #@30 The name of the active file. (defvar nnfolder-active-file (byte-code "À !ÂP‡" [file-name-as-directory nnfolder-directory "active"] 2) (#$ . 675)) #@254 If non-nil, causes nnfolder to do some extra work in order to determine the true active ranges of an mbox file. Note that the active file is still saved, but it's values are not used. This costs some extra time when scanning an mbox when opening it. (defvar nnfolder-ignore-active-file nil (#$ . 828)) #@457 If non-nil, nnfolder attempts to only ever have one mbox open at a time. This is a straight space/performance trade off, as the mboxes will have to be scanned every time they are read in. If nil (default), nnfolder will attempt to keep the buffers around (saving the nnfolder's buffer upon group close, but not killing it), speeding some things up tremendously, especially such things as moving mail. All buffers always get killed upon server close. (defvar nnfolder-always-close nil (#$ . 1140)) #@35 Mail newsgroups description file. (defvar nnfolder-newsgroups-file (byte-code "À !ÂP‡" [file-name-as-directory nnfolder-directory "newsgroups"] 2) (#$ . 1649)) #@76 If non-nil, nnfolder will check the incoming mail file and split the mail. (defvar nnfolder-get-new-mail t (#$ . 1815)) #@48 Hook run narrowed to an article before saving. (defvar nnfolder-prepare-save-mail-hook nil (#$ . 1941)) #@19 nnfolder version. (defconst nnfolder-version "nnfolder 1.0" (#$ . 2051)) #@68 String used to demarcate what the article number for a message is. (defconst nnfolder-article-marker "X-Gnus-Article-Number: " (#$ . 2130)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÆÅ BÀÇ!„-ÂÇ BÀÈ!„:ÂÈ BÀÉ!„GÂ É B‡" [boundp nnfolder-current-group nil current-load-list nnfolder-current-buffer nnfolder-status-string "" nnfolder-group-alist nnfolder-buffer-alist nnfolder-active-timestamp] 2) (defalias 'nnfolder-article-string '(macro . #[(article) "ÀÁÂÃ\fDÅBBBB‡" [concat "\n" nnfolder-article-marker int-to-string article (" ")] 5])) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„7ÆDÇDÈDÉ DÊËÌÍÎϯ\nÅ B‡" [boundp nnfolder-current-server nil current-load-list nnfolder-server-alist nnfolder-server-variables nnfolder-directory nnfolder-active-file nnfolder-newsgroups-file nnfolder-get-new-mail (nnfolder-current-group nil) (nnfolder-current-buffer nil) (nnfolder-status-string "") (nnfolder-group-alist nil) (nnfolder-buffer-alist nil) (nnfolder-active-timestamp nil)] 10) (defalias 'nnfolder-retrieve-headers #[(sequence &optional newsgroup server) "ŠqˆÁ ˆÂ Pĉ‰‰ Ê !ˆ\fqˆebˆ @;ƒ.΂§ ƒ @ÏÑ!ÒR\fqˆÓÄÔ#„YÕÄÔ#ƒ†Ö ÄÔ#†c`Ó×ÄÔ#ˆ`SqˆØÙ\"cˆÚ\f #ˆdbˆÛcˆ A‰ „3qˆebˆÜÝÄÔ#ƒ¦ÞÒÔ‰#ˆ‚•Î.‡" [nntp-server-buffer erase-buffer "^" rmail-unix-mail-delimiter nil stop start art-string article delim-string nnfolder-possibly-change-group newsgroup nnfolder-current-buffer sequence headers "\n" nnfolder-article-marker int-to-string " " search-forward t search-backward re-search-backward "\n\n" format "221 %d Article retrieved.\n" insert-buffer-substring ".\n" re-search-forward "\\( ?\n[ ]+\\)+" replace-match] 6]) (defalias 'nnfolder-open-server #[(server &optional defs) "À ˆ \nšƒ Ç\nƒ\nÄ !DBÇ \"‰ƒ6ÉA@!ˆÊ\"‚<Ë \f\"ˆ) ‰‡" [nnheader-init-server-buffer server nnfolder-current-server t nnheader-save-variables nnfolder-server-variables nnfolder-server-alist assoc state nnheader-restore-variables delq nnheader-set-init-variables defs] 4]) (defalias 'nnfolder-close-server #[(&optional server) "À‡" [t] 1]) (defalias 'nnfolder-server-opened #[(&optional server) " š… \n… Ã\n!‡" [server nnfolder-current-server nntp-server-buffer buffer-name] 2]) (defalias 'nnfolder-request-close #[nil "‰ƒ @@ÃÄ#ˆ A‰„)Ãɇ" [nnfolder-buffer-alist alist nnfolder-close-group nil t nnfolder-group-alist] 5]) (defalias 'nnfolder-status-message #[(&optional server) "‡" [nnfolder-status-string] 1]) (defalias 'nnfolder-request-article #[(article &optional newsgroup server buffer) "À !ˆ\n;?…{Š qˆebˆÄÅÇ\n!ÈRÉÊ#…zɉ \fÍÎPÉÊ#ˆ`\fÐyˆÑÎPÉÊ#ƒEÒy„Hdbˆ` †R‰qˆÕ ˆÖ \f #ˆebˆ×Ø!ƒxÙÚ!ˆÛcˆÐyˆ‚e+Ê)‡" [nnfolder-possibly-change-group newsgroup article nnfolder-current-buffer search-forward "\n" nnfolder-article-marker int-to-string " " nil t stop start re-search-backward "^" rmail-unix-mail-delimiter 1 re-search-forward -1 buffer nntp-server-buffer erase-buffer insert-buffer-substring looking-at "From " delete-char 5 "X-From-Line: "] 6]) (defalias 'nnfolder-request-group #[(group &optional server dont-check) "ŠÀÁ!ˆÂ !ˆÄ \"…SƒÇ‚SÈ !ˆÄ \"‰ @ A@‰\n@ \nA\f qˆÎ ˆ …RÏÐ\f ZT \f %cˆÇ-)‡" [nnmail-activate nnfolder nnfolder-possibly-change-group group assoc nnfolder-group-alist dont-check t nnfolder-get-new-mail active range minactive maxactive nntp-server-buffer erase-buffer format "211 %d %d %d %s\n"] 7]) (defalias 'nnfolder-close-group #[(group &optional server force) "À \n\"„ šƒ4Ä !ˆŠ qˆÆ ƒÇ ˆ„' ƒ3Êp!ˆËÀ \n\"\n\")ÌÌ͇" [assoc group nnfolder-buffer-alist nnfolder-current-group nnfolder-possibly-change-group nnfolder-current-buffer buffer-modified-p save-buffer force nnfolder-always-close kill-buffer delq nil t] 4]) (defalias 'nnfolder-request-create-group #[(group &optional server) "ÀÁ!ˆÂ \f\"„ Å ÇÈB‰D\fBÉ\f\n\"ˆ)ˇ" [nnmail-activate nnfolder assoc group nnfolder-group-alist nil active 1 0 nnmail-save-active nnfolder-active-file t] 3]) (defalias 'nnfolder-request-list #[(&optional server) "ƒÁ ˆŠÂ !ˆÄ ‰)‡" [server nnfolder-get-new-mail nnmail-find-file nnfolder-active-file nnmail-get-active nnfolder-group-alist] 2]) (defalias 'nnfolder-request-newgroups #[(date &optional server) "À !‡" [nnfolder-request-list server] 2]) (defalias 'nnfolder-request-list-newsgroups #[(&optional server) "ŠÀ !)‡" [nnmail-find-file nnfolder-newsgroups-file] 2]) (defalias 'nnfolder-request-post #[(&optional server) "ÀÁ!‡" [mail-send-and-exit nil] 2]) (defalias (quote nnfolder-request-post-buffer) (quote nnmail-request-post-buffer)) (defalias 'nnfolder-request-expire-articles #[(articles newsgroup &optional server force) "À !ˆ\nƒ\n !† ÅÇÉÊ!ˆŠ qˆ\fƒwƒwebˆÍÎÐ\f@!ÑRÇÅ#ƒn„TÓÔ `Lj`{\"\fV‰ƒfƒ`Ö×\f@\"ˆØ ˆ‚n\f@B\fA‰\f„$Ù ƒÚ ˆÛ \"A@ÎPß A!ebˆÍÇÅ#ƒºâ ÇÅ#ƒº!ãä”ä•{!^!‚™! ˆ,å&\"ˆ\f¤,‡" [nnfolder-possibly-change-group newsgroup nnmail-expiry-wait-function nnmail-expiry-wait days t is-old nil rest nnmail-activate nnfolder nnfolder-current-buffer articles search-forward "\n" nnfolder-article-marker int-to-string " " force nnmail-days-between current-time-string gnus-verbose-backends message "Deleting article %s..." nnfolder-delete-mail buffer-modified-p save-buffer assoc nnfolder-group-alist active marker "[0-9]+" number activemin re-search-forward string-to-number 0 nnmail-save-active nnfolder-active-file] 6]) (defalias 'nnfolder-request-move-article #[(article group server accept-form &optional last) "À !ˆÂÃ!ÄÇ  #ƒ…ŠqˆÊp!ˆË ˆÌ !ˆebˆÎÏPŠÑÒÄÓ#ˆ`)Ó#ƒIÔyˆ`Õyˆ`|ˆ‚)Ö!Ø!ˆ )ƒ…ŠÀ !ˆqˆebˆÑÚÛ!ÜRÄÓ#ƒwÝ ˆƒ„ß ƒ„à ˆ) *‡" [nnfolder-possibly-change-group group get-buffer-create " *nnfolder move*" nil result buf nnfolder-request-article article server buffer-disable-undo erase-buffer insert-buffer-substring nntp-server-buffer re-search-forward "^" nnfolder-article-marker search-forward "\n\n" t 0 1 eval accept-form kill-buffer nnfolder-current-buffer "\n" int-to-string " " nnfolder-delete-mail last buffer-modified-p save-buffer] 6]) (defalias 'nnfolder-request-accept-article #[(group &optional last) ";ƒ Á!ˆpÂebˆÅÆ!ƒÇÈ!ˆ‚*ÅÈ!„*ÉÊ Ë±ˆÌ ƒvŠ\fqˆebˆÍÎÂÏ#ˆÐyˆÑÒPÂÏ#ƒT`Ôyˆ`|ˆ‚?Õ;…[!@‰)ƒvŠqˆƒuØ ƒuÙ ˆ)Ú\"ˆ *‡" [group nnfolder-possibly-change-group nil result buf looking-at "X-From-Line: " replace-match "From " "From nobody " current-time-string "\n" nnfolder-request-list search-forward "\n\n" t -1 re-search-backward "^" nnfolder-article-marker 1 nnfolder-save-mail nnfolder-current-buffer last buffer-modified-p save-buffer nnmail-save-active nnfolder-group-alist nnfolder-active-file] 4]) (defalias 'nnfolder-request-replace-article #[(article group buffer) "À !ˆŠ\nqˆebˆÃÄ Æ!ÈRÉÊ#…-Ëʉ\"ˆÌ !ˆÎ ƒ,Ï ˆÊ)‡" [nnfolder-possibly-change-group group nnfolder-current-buffer search-forward "\n" nnfolder-article-marker int-to-string article " " nil t nnfolder-delete-mail insert-buffer-substring buffer buffer-modified-p save-buffer] 5]) (defalias 'nnfolder-delete-mail #[(&optional force leave-delim) "ŠŒŠÀÁ\nPÃÄ#ˆ ƒÆyˆ`‚Ç”)ÆyˆÈÁ\nPÃÄ#ƒ:o„5 ƒ5Éyˆ`‚7Ç”†;d}ˆed|*‡" [re-search-backward "^" rmail-unix-mail-delimiter nil t leave-delim 1 0 re-search-forward -2] 5]) (defalias 'nnfolder-possibly-change-group #[(group) "À !„\fÂà !!ˆÄÅ!ˆÆ\"„6ÀÉ !P!ƒ6ÊËBDBÌ \"ˆÅ‰šƒPƒPÒ!„ÛÆ\"‰ƒfA@ƒ€Ò!ƒ€Ô!ƒ€Õ!„£ƒ˜Ò!ƒ˜Ô!ƒ˜Ö!ˆ×\"Å„ÛŠÉ !PØÙ!!„ÚÀ!„ÊÚʉÛÜ%ˆÝ!qpDB)*‰‡" [file-exists-p nnfolder-directory make-directory directory-file-name nnfolder-possibly-activate-groups nil assoc group nnfolder-group-alist file-name-as-directory 1 0 nnmail-save-active nnfolder-active-file file inf nnfolder-current-group nnfolder-current-buffer buffer-name nnfolder-buffer-alist bufferp verify-visited-file-modtime kill-buffer delq file-directory-p file-truename write-region t nomesg nnfolder-read-folder] 6]) #@32 Called narrowed to an article. (defalias 'nnfolder-save-mail #[(&optional group) "ƒ ÁDC‚\f\nÃÄ!ŸÆÆ É ˆÊ !ˆËÌ!ˆ ƒ @ AebˆÍÎÆÏ#ˆÐyˆÑÒPÆÏ#ƒS`TÔyˆ`|ˆ‚=Õ@!ˆÖ!ˆedpqˆdbˆÛ#ˆqˆ+‚&,‡" [group "" nnmail-split-methods nnmail-article-group nnfolder-active-number group-art-list nil save-list group-art nnmail-insert-lines nnmail-insert-xref run-hooks nnfolder-prepare-save-mail-hook search-forward "\n\n" t -1 search-backward "\n" nnfolder-article-marker 2 nnfolder-possibly-change-group nnfolder-insert-newsgroup-line obuf end beg nnfolder-current-buffer insert-buffer-substring] 4 (#$ . 10078)]) (defalias 'nnfolder-insert-newsgroup-line #[(group-art) "ŠebˆÀÁÂÃ#…ÄuˆÅÇPAÉ #c)‡" [search-forward "\n\n" nil t -1 format nnfolder-article-marker "%d %s\n" group-art current-time-string] 4]) (defalias 'nnfolder-possibly-activate-groups #[(&optional group) "Šƒ Á!ˆÂÃ!)‡" [group nnfolder-possibly-change-group nnmail-activate nnfolder] 2]) (defalias 'nnfolder-active-number #[(group) "ŠÀ \n\"A@‰ƒ ‰AT¡ˆ‚ ĉB‰D\nB A)Å\n\"ˆÇ !ˆ)‡" [assoc group nnfolder-group-alist active 1 nnmail-save-active nnfolder-active-file nnfolder-possibly-activate-groups] 5]) (defalias 'nnfolder-read-folder #[(file) "ŠÀÁ!ˆÂ ÁÄ#‰qˆÆp!ˆÇPÉ\nPËÌ \"A@Á‰‰‰ebˆA„KØWƒ£ÙÚÛ\"SÙÚÜ\"SÙÚÝ\"S]]ÞÁß#ƒ‹àÁß#ƒ‹áâ”â•{!##]#^)‚^Ú^] ˆA]¡ˆebˆä ‰àÁß#ƒ¶â”†·dÁ“ˆdU„å!bˆæ!ƒØÚyˆ‚ËàÁß#ƒè┆édÁ“ˆbˆÞß#„º}ˆç ˆèÁé !B!ˆ~ˆ‚ºê+\"ˆp. ‡" [nnfolder-possibly-activate-groups nil nnheader-find-file-noselect file raw nnfolder-current-buffer buffer-disable-undo "^" rmail-unix-mail-delimiter "\n" nnfolder-article-marker "[0-9]+" assoc nnfolder-current-group nnfolder-group-alist end start activemin activenumber active number marker delim nnfolder-ignore-active-file 2 lsh 1 23 24 25 search-forward t re-search-forward string-to-number 0 newnum point-marker marker-position looking-at nnmail-insert-lines nnfolder-insert-newsgroup-line nnfolder-active-number nnmail-save-active nnfolder-active-file] 9]) #@25 Read new incoming mail. (defalias 'nnfolder-get-new-mail #[(&optional group) "À ! ÄÄ?†??…ßÉÄ!ˆ\nƒeÊ\n@!ƒ^ËÌ\n@!8ÍVƒ^ƒ;ÏÐ!ˆÑ\n@Ò!ÔP\"‰ƒ^ BÕ\n@ \"Ö×Ä $ˆ\nA‰„ ƒ~Ø\"ˆÛÜ!ˆƒ~ÏÝ!ˆŠƒ¶à@A@!„žá@\"‚­@A@qˆâ ƒ­ã ˆA‰„ˆ* …ß @$ƒ×å!ƒ×Ê!ƒ×æ!ˆ A‰„»Ä,‡" [nnmail-get-spool-files group spools group-in nil incomings incoming nnfolder-get-new-mail nnmail-spool-file nnfolder-possibly-activate-groups file-exists-p 7 file-attributes 0 gnus-verbose-backends message "nnfolder: Reading incoming mail..." nnmail-move-inbox file-name-as-directory nnfolder-directory "Incoming" nnmail-get-split-group nnmail-split-incoming nnfolder-save-mail nnmail-save-active nnfolder-group-alist nnfolder-active-file run-hooks nnmail-read-incoming-hook "nnfolder: Reading incoming mail...done" nnfolder-buffer-alist bufs buffer-name delq buffer-modified-p save-buffer nnmail-delete-incoming file-writable-p delete-file] 6 (#$ . 12176)]) (provide (quote nnfolder)) emacs-19.30/lisp/nnheader.elc100666 23053 1 20512 6046561662 14701 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:30:45 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/nnheader.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nnheader.el' was compiled for Emacs 19.29 or later")) (defalias (quote nntp-header-number) (quote mail-header-number)) #@34 Return article number in HEADER. (defalias 'mail-header-number '(macro . #[(header) "À ÂBB‡" [aref header (0)] 3 (#$ . 546)])) (defalias (quote nntp-set-header-number) (quote mail-header-set-number)) #@41 Set article number of HEADER to NUMBER. (defalias 'mail-header-set-number '(macro . #[(header number) "À  F‡" [aset header 0 number] 4 (#$ . 752)])) (defalias (quote nntp-header-subject) (quote mail-header-subject)) #@34 Return subject string in HEADER. (defalias 'mail-header-subject '(macro . #[(header) "À ÂBB‡" [aref header (1)] 3 (#$ . 975)])) (defalias (quote nntp-set-header-subject) (quote mail-header-set-subject)) #@43 Set article subject of HEADER to SUBJECT. (defalias 'mail-header-set-subject '(macro . #[(header subject) "À  F‡" [aset header 1 subject] 4 (#$ . 1184)])) (defalias (quote nntp-header-from) (quote mail-header-from)) #@33 Return author string in HEADER. (defalias 'mail-header-from '(macro . #[(header) "À ÂBB‡" [aref header (2)] 3 (#$ . 1407)])) (defalias (quote nntp-set-header-from) (quote mail-header-set-from)) #@39 Set article author of HEADER to FROM. (defalias 'mail-header-set-from '(macro . #[(header from) "À  F‡" [aset header 2 from] 4 (#$ . 1607)])) (defalias (quote nntp-header-date) (quote mail-header-date)) #@24 Return date in HEADER. (defalias 'mail-header-date '(macro . #[(header) "À ÂBB‡" [aref header (3)] 3 (#$ . 1817)])) (defalias (quote nntp-set-header-date) (quote mail-header-set-date)) #@37 Set article date of HEADER to DATE. (defalias 'mail-header-set-date '(macro . #[(header date) "À  F‡" [aset header 3 date] 4 (#$ . 2008)])) (defalias (quote nntp-header-id) (quote mail-header-id)) #@22 Return Id in HEADER. (defalias 'mail-header-id '(macro . #[(header) "À ÂBB‡" [aref header (4)] 3 (#$ . 2212)])) (defalias (quote nntp-set-header-id) (quote mail-header-set-id)) #@33 Set article Id of HEADER to ID. (defalias 'mail-header-set-id '(macro . #[(header id) "À  F‡" [aset header 4 id] 4 (#$ . 2395)])) (defalias (quote nntp-header-references) (quote mail-header-references)) #@30 Return references in HEADER. (defalias 'mail-header-references '(macro . #[(header) "À ÂBB‡" [aref header (5)] 3 (#$ . 2605)])) (defalias (quote nntp-set-header-references) (quote mail-header-set-references)) #@42 Set article references of HEADER to REF. (defalias 'mail-header-set-references '(macro . #[(header ref) "À  F‡" [aset header 5 ref] 4 (#$ . 2820)])) (defalias (quote nntp-header-chars) (quote mail-header-chars)) #@46 Return number of chars of article in HEADER. (defalias 'mail-header-chars '(macro . #[(header) "À ÂBB‡" [aref header (6)] 3 (#$ . 3039)])) (defalias (quote nntp-set-header-chars) (quote mail-header-set-chars)) #@52 Set number of chars in article of HEADER to CHARS. (defalias 'mail-header-set-chars '(macro . #[(header chars) "À  F‡" [aset header 6 chars] 4 (#$ . 3255)])) (defalias (quote nntp-header-lines) (quote mail-header-lines)) #@25 Return lines in HEADER. (defalias 'mail-header-lines '(macro . #[(header) "À ÂBB‡" [aref header (7)] 3 (#$ . 3483)])) (defalias (quote nntp-set-header-lines) (quote mail-header-set-lines)) #@39 Set article lines of HEADER to LINES. (defalias 'mail-header-set-lines '(macro . #[(header lines) "À  F‡" [aset header 7 lines] 4 (#$ . 3678)])) (defalias (quote nntp-header-xref) (quote mail-header-xref)) #@31 Return xref string in HEADER. (defalias 'mail-header-xref '(macro . #[(header) "À ÂBB‡" [aref header (8)] 3 (#$ . 3891)])) (defalias (quote nntp-set-header-xref) (quote mail-header-set-xref)) #@37 Set article xref of HEADER to xref. (defalias 'mail-header-set-xref '(macro . #[(header xref) "À  F‡" [aset header 8 xref] 4 (#$ . 4089)])) (byte-code "ÀÁ!„ÂÁ B‡" [boundp nntp-server-buffer nil current-load-list] 2) #@60 *If non-nil, Gnus backends will generate lots of comments. (defvar gnus-verbose-backends t (#$ . -4317)) #@72 If non-nil, Gnus backends will never output headers in the NOV format. (defvar gnus-nov-is-evil nil (#$ . 4428)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp news-reply-yank-from nil current-load-list news-reply-yank-message-id] 2) (defalias 'nnheader-init-server-buffer #[nil "ŠÀÁ!‰qˆÃp!ˆÄ ˆÅ ˆÆ)Ƈ" [get-buffer-create " *nntpd*" nntp-server-buffer buffer-disable-undo erase-buffer kill-all-local-variables t case-fold-search] 3]) (defalias 'nnheader-set-init-variables #[(server defs) "Á‰ƒ( @@ @@\fž‰ƒ\nA@‚ @A@Lˆ A‰„\f…_\f@@ž„W\f@@\f@A@9ƒOÅ\f@A@!„O\f@A@‚UÆ\f@A@!Lˆ\fA‰„,Á*‡" [server nil val s defs boundp eval] 4]) (defalias 'nnheader-save-variables #[(server) "À\nƒ\n@@\n@@JD B\nA‰„ Ÿ)‡" [nil out server] 3]) (defalias 'nnheader-restore-variables #[(state) "…@@@A@LˆA‰„Á‡" [state nil] 3]) (defalias 'nnheader-insert-head #[(file) "ÀÁ\nÄ Æ \n \\‰$A@=…$ÇÈÆÉ#?dbˆ…$‚*‡" [0 1024 chop beg nnheader-insert-file-contents-literally file nil search-backward "\n\n" t] 7]) (defalias 'nnheader-article-p #[nil "ebˆÀÁÂÃ#…#e`S}ˆebˆÄÅ!ƒ Æ•bˆ‚m~ˆ‡" [search-forward "\n\n" nil t looking-at "[A-Z][^ ]+:.*\n\\([ ].*\n\\)*\\|From .*\n" 0] 4]) #@308 Like `insert-file-contents', q.v., but only reads in the file. A buffer may be modified in several ways after reading into the buffer due to advanced Emacs features, such as file-name-handlers, format decoding, find-file-hooks, etc. This function ensures that none of these modifications will take place. (defalias 'nnheader-insert-file-contents-literally #[(filename &optional visit beg end replace) "À‰ÁÂ!…\nÂKÆŽÂÇMˆÈ \n \f %,‡" [nil fboundp find-buffer-file-type find-buffer-file-type-function after-insert-file-functions format-alist ((byte-code "ƒ ÁMˆ‚ÂÁ!ˆÁ‡" [find-buffer-file-type-function find-buffer-file-type fmakunbound] 2)) #[(filename) "À‡" [t] 1] insert-file-contents filename visit beg end replace] 6 (#$ . 5618)]) #@234 Read file FILENAME into a buffer and return the buffer. If a buffer exists visiting FILENAME, return that one, but verify that the file has not changed since visited or saved. The buffer is not selected, just returned to the caller. (defalias 'nnheader-find-file-noselect #[(filename &optional nowarn rawfile) "ÀÁ\n!!Ã\n!ƒ\fƒÅ\n!‡ÆÇ\n\"‡È\n! ÀÊ\n!! ÌÍ !› ?…BÏÐ!ƒ?Ð\n!‚BÈ\n!Òƒw„c\nÔ!˜„cÕÖ\nÔ!#ˆ×Ø!ƒn„sƒw  ƒÝ„[Ú !„[Û\n!„–ÆÜ\n\"ˆ‚[ÝÞ\n!ß !˜ƒ¶àá !ƒ®â‚¯ãÞ\n!\"‚Ëàá !ƒÂä‚ÃåÞ\n!ß !#!ƒ[Š qˆæç‰\"ˆ)‚[Šè\n!‰ qˆé ˆ*ƒöÒë숂ûÒíîˆ /01ò=ƒ,Ò3ôõö\n!\"ƒö\n!÷‰”O338)„,/ƒ9Á/!‰ö\n!9:!„Mûü!ˆç<*„Zý?\"ˆ) -‡" [abbreviate-file-name expand-file-name filename file-directory-p find-file-run-dired dired-noselect error "%s is a directory." get-file-buffer buf file-truename truename 10 file-attributes number fboundp find-buffer-visiting other nil nowarn buffer-file-name message "%s and %s are the same file" boundp find-file-existing-other-name find-file-visit-truename verify-visited-file-modtime file-exists-p "File %s no longer exists!" yes-or-no-p file-name-nondirectory buffer-name format buffer-modified-p "File %s changed on disk. Discard your edits? " "File %s changed on disk. Reread from disk? " "File %s changed on disk. Discard your edits in %s? " "File %s changed on disk. Reread from disk into %s? " revert-buffer t create-file-buffer erase-buffer rawfile (nnheader-insert-file-contents-literally filename t) ((file-error (byte-code "ÀÀ‡" [t error] 1))) (insert-file-contents filename t) ((file-error)) buffer-file-truename buffer-file-number system-type vax-vms logical string-match ":" file-name-directory 0 find-file-not-true-dirname-list default-directory backup-enable-predicate make-local-variable backup-inhibited after-find-file] 7 (#$ . 6371)]) (defalias 'nnheader-insert-references #[(references message-id) "?… ??…AÂÃ!ˆ`Åyˆ`\fbˆ)ÆÇ \nƒ(cˆƒ3 ƒ3Ëcˆ ƒ: cˆÌ\n`T\"+‡" [references message-id mail-position-on-field "References" p 0 78 " " fill-prefix fill-column begin " " fill-region-as-paragraph] 3]) (provide (quote nnheader)) emacs-19.30/lisp/nnkiboze.elc100666 23053 1 16403 6046561676 14745 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:30:46 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/nnkiboze.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nnkiboze.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!‡" [require nntp nnheader gnus gnus-score] 2) #@48 nnkiboze will put its files in this directory. (defvar nnkiboze-directory (byte-code "À †Â!‡" [expand-file-name gnus-article-save-directory "~/News/"] 2) (#$ . 554)) #@46 Version numbers of this version of nnkiboze. (defconst nnkiboze-version "nnkiboze 1.0" (#$ . 728)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÅÆ B‡" [boundp nnkiboze-current-group nil current-load-list nnkiboze-current-score-group "" nnkiboze-status-string] 2) (defalias 'nnkiboze-retrieve-headers #[(articles &optional group server) "À !ˆ\n?… @;ƒć @ Aƒ A‰‚ @Å É!…~Š\nqˆË ˆÌ!ˆebˆm„SÍp!WƒSÎyˆ‚@Ïyˆm„^Î`|ˆm„qÍp!YƒqÎyˆ‚^Ïyˆm„|`d|ˆ)Æ+‡" [nnkiboze-possibly-change-newsgroups group gnus-nov-is-evil articles headers nnkiboze-nov-file-name nov last first file-exists-p nntp-server-buffer erase-buffer insert-file-contents read 1 0] 4]) #@52 Open a virtual newsgroup that contains NEWSGROUPS. (defalias 'nnkiboze-open-server #[(newsgroups &optional something) "À !ˆÂ ‡" [gnus-make-directory nnkiboze-directory nnheader-init-server-buffer] 2 (#$ . 1400)]) #@20 Close news server. (defalias 'nnkiboze-close-server #[(&rest dum) "À‡" [t] 1 (#$ . 1619)]) (byte-code "ÀÁÂK\"‡" [defalias nnkiboze-request-quit nnkiboze-close-server] 3) #@98 Return server process status, T or NIL. If the stream is opened, return T, otherwise return NIL. (defalias 'nnkiboze-server-opened #[(&optional server) "…Á!‡" [nntp-server-buffer get-buffer] 2 (#$ . 1795)]) #@42 Return server status response as string. (defalias 'nnkiboze-status-message #[(&optional server) "‡" [nnkiboze-status-string] 1 (#$ . 2012)]) #@35 Select article by message number. (defalias 'nnkiboze-request-article #[(article &optional newsgroup server buffer) "À !ˆ\n§„Ã\n \f $‡Æ\n!‰ÈH Ê Ê\f „)ÍÎ!ˆÏÐ \"„5ÍÑ!ˆ Ò”Ò•O Ó Ô”Ô•O!\fÕ Ö\"…X×\f #,‡" [nnkiboze-possibly-change-newsgroups newsgroup article nntp-request-article gnus-nntp-server buffer gnus-get-header-by-number header 8 xref nil igroup iarticle error "nnkiboze: No xref" string-match " \\([^ ]+\\):\\([0-9]+\\)" "nnkiboze: Malformed xref" 1 string-to-int 2 gnus-request-group t gnus-request-article] 6 (#$ . 2161)]) #@35 Make GROUP the current newsgroup. (defalias 'nnkiboze-request-group #[(group &optional server dont-check) "À !ˆ\n„sà ĉ‰Š qˆÊ ˆË!„,ÌÍ \"cˆ‚rÎ!ˆÏ ÐUƒAÌÍ \"cˆ‚rebˆÑÒ!ƒOÓp!dbˆÔÕÄÖ#ƒ_Óp!×ed\"Ê ˆÌØ  %cˆ-Ö‡" [nnkiboze-possibly-change-newsgroups group dont-check nnkiboze-nov-file-name nil total end beg nov-file nntp-server-buffer erase-buffer file-exists-p format "211 0 0 0 %s\n" insert-file-contents buffer-size 0 looking-at "[0-9]+" read re-search-backward "^[0-9]" t count-lines "211 %d %d %d %s\n"] 6 (#$ . 2716)]) (defalias 'nnkiboze-close-group #[(group &optional server) "À !ˆÂà !…hŠ\f ÈÉ!qˆÊp!ˆË ˆpÌ Ïà !ˆebˆÐÑ!ƒZÒ!‰ >„G >ƒMÓyˆ‚,Ôyˆ`Óyˆ`|ˆ‚,Õà !ˆÖp!ˆ-̉‡" [nnkiboze-possibly-change-newsgroups group file-exists-p nnkiboze-nov-file-name gnus-newsgroup-unreads gnus-newsgroup-unselected unselected unreads get-buffer-create "*nnkiboze work*" buffer-disable-undo erase-buffer nil article cur insert-file-contents looking-at "[0-9]+" read 1 0 write-file kill-buffer nnkiboze-current-group] 2]) (defalias 'nnkiboze-request-list #[(&optional server) "À‡" ["nnkiboze: LIST is not implemented." nnkiboze-status-string nil] 1]) #@18 List new groups. (defalias 'nnkiboze-request-newgroups #[(date &optional server) "À‡" ["NEWGROUPS is not supported." nnkiboze-status-string nil] 1 (#$ . 3898)]) (defalias 'nnkiboze-request-list-newsgroups #[(&optional server) "À‡" ["nnkiboze: LIST NEWSGROUPS is not implemented." nnkiboze-status-string nil] 1]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias nnkiboze-request-post nntp-request-post nnkiboze-request-post-buffer nntp-request-post-buffer] 3) (defalias 'nnkiboze-possibly-change-newsgroups #[(group) "‰‡" [group nnkiboze-current-group] 2]) (defalias 'nnkiboze-prefixed-name #[(group) "À Â\"‡" [gnus-group-prefixed-name group (nnkiboze "")] 3]) #@124 Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups Finds out what articles are to be part of the nnkiboze groups. (defalias 'nnkiboze-generate-groups #[nil "À‰Á‰Æ ˆ,Ç!‰‰ …4ÊË @@\"ƒ*Ì @@!ˆ A‰ „À*‡" [nil t gnus-expert-user gnus-read-active-file gnus-use-dribble-file nnmail-spool-file gnus gnus-copy-sequence gnus-newsrc-alist newsrc string-match "nnkiboze" nnkiboze-generate-group] 5 (#$ . 4558) nil]) (defalias 'nnkiboze-score-file #[(group) "À \nÃ\fR!C‡" [expand-file-name gnus-kill-files-directory nnkiboze-current-score-group "." gnus-score-file-suffix] 5]) (defalias 'nnkiboze-generate-group #[(group) "ÀÁ\n \"J8 \nÆQ \nÈQ Ê\f8A@ Ì ÎÐÎÎÎÎÎÎÎÎÎÎÎÎÎ\n\f„Wàá\n\"ˆâ!ƒcã!ˆŠä !‰qˆåp!ˆ)æç(\"ˆ‰ƒ;Á@@(\"J‰„›é@\"‚*ê+!ˆì@@!ˆÀÁí \"J8‰ƒÃî8ƒÃî›Î ˆƒÓï@!GðVƒ*ñÎ!ˆ2ó=ƒ*@Aô5!‰6=ƒôÎ7ƒ'7@@Vƒøù7@@!ƒú5\"‚5#ˆ7A‰7„ùû ˆ@@¡ˆA‰„€qˆü ˆýp!ˆþÿ!qˆåp!ˆ@ ˆAB!C±ˆD!ˆýp!ˆê+!ˆEFÎ\".‡" [2 intern-soft group gnus-newsrc-hashtb info nnkiboze-directory ".newsrc" newsrc-file ".nov" nov-file 4 regexp t gnus-expert-user nil gnus-large-newsgroup nnkiboze-score-file gnus-score-find-score-files-function gnus-select-group-hook gnus-summary-prepare-hook gnus-thread-sort-functions gnus-show-threads gnus-visual method nnkiboze-newsrc nov-buffer gname newsrc active ginfo lowest nnkiboze-current-score-group error "No such group: %s" file-exists-p load find-file-noselect buffer-disable-undo mapatoms #[(group) "À  !‰\"…/Å\f\"?…/ J@§…/ÀÇ\f\"?…/\f J@SBB‰‡" [string-match regexp symbol-name group gname assoc nnkiboze-newsrc "^nnkiboze:"] 4] gnus-active-hashtb delq switch-to-buffer gnus-group-buffer gnus-group-jump-to-group gnus-group-group-name 3 gnus-list-of-unread-articles 0 gnus-group-select-group major-mode gnus-summary-mode gnus-find-method-for-group gnus-newsgroup-name gnus-select-method gnus-newsgroup-scored nnkiboze-enter-nov gnus-get-header-by-number gnus-group-prefixed-name gnus-summary-quit save-buffer kill-buffer get-buffer-create "*nnkiboze work*" erase-buffer "(setq nnkiboze-newsrc '" prin1-to-string ")\n" write-file gnus-group-list-groups 5] 7]) (defalias 'nnkiboze-enter-nov #[(buffer header group) "Šqˆdbˆ ÂHÃ\f!ÅÆ \nËyÌUƒ*Íp!TÎyˆ‚-ÎÏ!Ð ÎH†9ÑÐ ÒH†AÑÐ ÓH†IÑÐ ÔH†QÑÐ ÕH†YÑÐÏ ÖH†bÌ!ÐÏ ×H†lÌ!бˆ\nƒ}\nÑšƒŽØÙ Ú\fÛÏ ÌH!ܱ‚Ö ÂHܱˆÝÐÆÅ#ˆÝÐÆÅ#ˆÞߊƈ`)Å#…փɊ̔bˆ \fÛÏ ÌH!Ú±ˆÆ)ŠÌ”bˆ cˆ)‚¡-‡" [buffer header 8 gnus-group-real-prefix group t nil article first prefix xref -1 0 read 1 int-to-string " " "" 2 3 4 5 6 7 "Xref: " system-name " " ":" " \n" search-backward re-search-forward "[^ ]+:[0-9]+"] 17]) (defalias 'nnkiboze-nov-file-name #[nil "Á\n!ÃQ‡" [nnkiboze-directory nnkiboze-prefixed-name nnkiboze-current-group ".nov"] 3]) (provide (quote nnkiboze)) emacs-19.30/lisp/nnmail.elc100666 23053 1 44203 6046561710 14370 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:30:48 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/nnmail.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nnmail.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!‡" [require nnheader rmail timezone sendmail] 2) #@1036 *Incoming mail will be split according to this variable. If you'd like, for instance, one mail group for mail from the "4ad-l" mailing list, one group for junk mail and one for everything else, you could do something like this: (setq nnmail-split-methods '(("mail.4ad" "From:.*4ad") ("mail.junk" "From:.*Lars\\|Subject:.*buy") ("mail.misc" ""))) As you can see, this variable is a list of lists, where the first element in each "rule" is the name of the group (which, by the way, does not have to be called anything beginning with "mail", "yonka.zow" is a fine, fine name), and the second is a regexp that nnmail will try to match on the header to find a fit. The second element can also be a function. In that case, it will be called narrowed to the headers with the first element of the rule as the argument. It should return a non-nil value if it thinks that the mail belongs in that group. The last element should always have "" as the regexp. This variable can also have a function as its value. (defvar nnmail-split-methods (quote (("mail.misc" ""))) (#$ . -555)) #@115 *If non-nil, do crossposting if several split methods match the mail. If nil, the first match found will be used. (defvar nnmail-crosspost t (#$ . -1666)) #@207 *If non-nil, nnmail will never delete the last expired article in a directory. You may need to set this variable if other programs are putting new mail into folder numbers that Gnus has marked as expired. (defvar nnmail-keep-last-article nil (#$ . -1828)) #@74 *Articles that are older than `nnmail-expiry-wait' days will be expired. (defvar nnmail-expiry-wait 7 (#$ . -2091)) #@490 *Variable that holds function to specify how old articles should be before they are expired. The function will be called with the name of the group that the expiry is to be performed in, and it should return an integer that says how many days an article can be stored before it is considered 'old'. Eg.: (setq nnmail-expiry-wait-function (lambda (newsgroup) (cond ((string-match "private" newsgroup) 31) ((string-match "junk" newsgroup) 1) (t 7)))) (defvar nnmail-expiry-wait-function nil (#$ . -2214)) #@271 Where the mail backends will look for incoming mail. This variable is "/usr/spool/mail/$user" by default. If this variable is nil, no mail backends will read incoming mail. If this variable is a list, all files mentioned in this list will be used as incoming mailboxes. (defvar nnmail-spool-file (byte-code "ÀÁ!†\nÂà P‡" [getenv "MAIL" "/usr/spool/mail/" user-login-name] 2) (#$ . 2764)) #@144 *If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files. The file(s) in `nnmail-spool-file' will also be read. (defvar nnmail-use-procmail nil (#$ . -3160)) #@141 *When using procmail (and the like), incoming mail is put in this directory. The Gnus mail backends will read the mail from this directory. (defvar nnmail-procmail-directory "~/incoming/" (#$ . -3356)) #@154 *Suffix of files created by procmail (and the like). This variable might be a suffix-regexp to match the suffixes of several files - eg. ".spool[0-9]*". (defvar nnmail-procmail-suffix ".spool" (#$ . -3565)) #@54 *If non-nil, re-split incoming procmail sorted mail. (defvar nnmail-resplit-incoming nil (#$ . -3778)) #@83 *A command to be executed to move mail from the inbox. The default is "movemail". (defvar nnmail-movemail-program "movemail" (#$ . -3887)) #@500 *Hook that will be run after the incoming mail has been transferred. The incoming mail is moved from `nnmail-spool-file' (which normally is something like "/usr/spool/mail/$user") to the user's home directory. This hook is called after the incoming mail box has been emptied, and can be used to call any mail box programs you have running ("xwatch", etc.) Eg. (add-hook 'nnmail-read-incoming-hook (lambda () (start-process "mailsend" nil "/local/bin/mailsend" "read" "mbox"))) (defvar nnmail-read-incoming-hook nil (#$ . -4033)) #@106 *Hook called before treating incoming mail. The hook is run in a buffer with all the new, incoming mail. (defvar nnmail-prepare-incoming-hook nil (#$ . -4591)) #@83 *If non-nil, use this directory for temporary storage when reading incoming mail. (defvar nnmail-tmp-directory nil (#$ . -4757)) #@184 *The number of the articles which indicates a large newsgroup. If the number of the articles is greater than the value, verbose messages will be shown to indicate the current status. (defvar nnmail-large-newsgroup 50 (#$ . -4893)) #@1856 *Incoming mail can be split according to this fancy variable. To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'. The format is this variable is SPLIT, where SPLIT can be one of the following: GROUP: Mail will be stored in GROUP (a string). (FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains VALUE (a regexp), store the messages as specified by SPLIT. (| SPLIT...): Process each SPLIT expression until one of them matches. A SPLIT expression is said to match if it will cause the mail message to be stored in one or more groups. (& SPLIT...): Process each SPLIT expression. FIELD must match a complete field name. VALUE must match a complete word according to the fundamental mode syntax table. You can use .* in the regexps to match partial field names or words. FIELD and VALUE can also be lisp symbols, in that case they are expanded as specified in `nnmail-split-abbrev-alist'. Example: (setq nnmail-split-methods 'nnmail-split-fancy nnmail-split-fancy ;; Messages from the mailer deamon are not crossposted to any of ;; the ordinary groups. Warnings are put in a separate group ;; from real errors. '(| ("from" mail (| ("subject" "warn.*" "mail.warning") "mail.misc")) ;; Non-error messages are crossposted to all relevant ;; groups, but we don't crosspost between the group for the ;; (ding) list and the group for other (ding) related mail. (& (| (any "ding@ifi\\.uio\\.no" "ding.list") ("subject" "ding" "ding.misc")) ;; Other mailing lists... (any "procmail@informatik\\.rwth-aachen\\.de" "procmail.list") (any "SmartList@informatik\\.rwth-aachen\\.de" "SmartList.list") ;; People... (any "larsi@ifi\\.uio\\.no" "people.Lars Magne Ingebrigtsen")) ;; Unmatched mail goes to the catch all group. "misc.misc")) (defvar nnmail-split-fancy "mail.misc" (#$ . -5132)) #@58 *Alist of abbreviations allowed in `nnmail-split-fancy'. (defvar nnmail-split-abbrev-alist (quote ((any . "from\\|to\\|cc\\|sender\\|apparently-to") (mail . "mailer-daemon\\|postmaster"))) (#$ . -7046)) #@76 *If non-nil, the mail backends will delete incoming files after splitting. (defvar nnmail-delete-incoming t (#$ . -7255)) #@148 *The approximate number of Message-IDs nnmail will keep in its cache. If this variable is nil, no checking on duplicate messages will be perfomed. (defvar nnmail-message-id-cache-length 1000 (#$ . -7384)) #@48 *The file name of the nnmail Message-ID cache. (defvar nnmail-message-id-cache-file "~/.nnmail-cache" (#$ . -7595)) #@62 *If non-nil, nnmail will delete any duplicate mails it sees. (defvar nnmail-delete-duplicates nil (#$ . -7717)) #@17 nnmail version. (defconst nnmail-version "nnmail 1.0" (#$ . 7835)) (defalias 'nnmail-request-post #[(&optional server) "ÀÁ!‡" [mail-send-and-exit nil] 2]) (defalias 'nnmail-request-post-buffer #[(post group subject header article-buffer info follow-to respect-poster) "ÀÁ\n8žAɉ‰‰‰‰‰‰‰‰ \n \f ‰;…0И?…6ŠÑÒ!qˆÓ ˆÔÕÖ\"ˆ× ƒXØ ÙVƒXÚÛ!ƒíÜ ˆƒtÞɉ‰&ˆà!!ˆ‚íŠ\"qˆebˆeãä!ˆ`}ˆÃ%æedÃ#ˆ)'èH'éH ƒ¼êë\"‰,ƒ³Ù,O‚µí Q\n)îïð!†ÄÐ!îïñ!†ÏÐ!\fò\f†ÙЃî\fƒçó‚èÐP‚ïÐP!ôî† ††Ð!!5ò!)'öHê÷\"„$øPïù! 'ÁH 'úH~ˆ);<=ƒk=<ƒkþÿ=\"‰ƒk ‰…[ó\fAQ@\f=\"=‚KÞ=ƒ{=<ƒ{ ‚‹†‹ †‹†‹Ð\nGÙU?…š\"Ã&ˆà!!ˆ=ƒä=<ƒäebˆABÃC#ˆÙyˆöyˆ=ƒä=@@D=@AE±ˆ=A‰=„ÊF \"ˆp. ‡" [to-address 5 info nil elt sendto new-cc cc message-id references message-of reply-to to date from method-address "" get-buffer-create "*mail*" mail-mode local-set-key "" gnus-mail-send-and-exit buffer-modified-p buffer-size 0 y-or-n-p "Unsent mail being composed; erase it? " erase-buffer post mail-setup subject auto-save-mode auto-save-default article-buffer search-forward "\n\n" buffer-read-only set-text-properties header 2 3 string-match " *at \\| *@ \\| *(\\| *<" stop-pos "'s message of " mail-strip-quoted-names mail-fetch-field "cc" "to" rmail-dont-reply-to ", " regexp-quote rmail-dont-reply-to-names 1 "^[Rr][Ee]:" "Re: " "reply-to" 4 news-reply-yank-from news-reply-yank-message-id follow-to assoc "To" delq re-search-forward "^To:" t ": " "\n" nnheader-insert-references] 13]) #@38 Insert FILE in server buffer safely. (defalias 'nnmail-find-file #[(file) "qˆÁ ˆÂÃć" [nntp-server-buffer erase-buffer nil (byte-code "À !ˆÂ‡" [insert-file-contents file t] 2) ((file-error))] 3 (#$ . 9423)]) #@26 Make pathname for GROUP. (defalias 'nnmail-article-pathname #[(group mail-dir) "ÀÁ\n!!Ã\fÅÆ#ÇQ‡" [file-name-as-directory expand-file-name mail-dir nnmail-replace-chars-in-string group 46 47 "/"] 5 (#$ . 9639)]) #@47 Replace characters in STRING from FROM to TO. (defalias 'nnmail-replace-chars-in-string #[(string from to) "ÁÂOGÁ \fWƒ% H Uƒ Iˆ T‰‚ +‡" [string 0 nil idx len from to] 4 (#$ . 9856)]) (defalias 'nnmail-days-between #[(date1 date2) "ÀÁ !\"ÀÄ !\"ÈA@É8@#ÈA@É8@#Z*‡" [mapcar #[(s) "…Á!‡" [s string-to-int] 2] timezone-parse-date date1 #[(s) "…Á!‡" [s string-to-int] 2] date2 d2 d1 timezone-absolute-from-gregorian 2] 5]) (defalias 'nnmail-move-inbox #[(inbox tofile) "ÀÁ !!!ĉ‰ƒ É!Ê !P ÌÁ !! ÍÎ !!„7Ï Ð\"ˆÑÒÊ !\"‰„FÓƒOÊ !ƒ`Ô !ƒ`ÁÕ \"ƒlÖ×!ˆ‚“Í !ƒ~ØÙ !8ÚUƒŽÍ !ƒ“ØÙ !8ÚU„“ÖÛ \"ˆÍ !„„¥Í !ƒ„¼„¼ÄÜ݈ÄÞ߈‚ÄŽŠàá!â !ˆãÁ$%\"Ä Ä  &ˆæ !ƒ qˆçedèé$ˆdbˆêÄxˆ`d|ˆebˆëì!ƒeÚ•|ˆíÓ!ˆÖìed{P!ˆîï!ˆ* ƒð !ƒñ !ˆ ,‡" [file-truename expand-file-name substitute-in-file-name inbox nil errors popmail movemail nnmail-tmp-directory file-name-as-directory file-name-nondirectory tofile nnmail-make-complex-temp-name file-exists-p file-name-directory make-directory parents string-match "^po:" t file-directory-p user-login-name message "Getting mail from post office ..." 7 file-attributes 0 "Getting mail from %s..." (copy-file inbox tofile nil) ((error (rename-file inbox tofile t))) (byte-code "À`` #‡" [write-region inbox] 4) ((file-error)) generate-new-buffer " *nnmail loss*" buffer-disable-undo call-process nnmail-movemail-program exec-directory buffer-modified-p subst-char-in-region 10 32 " " looking-at "movemail: " beep sit-for 3 buffer-name kill-buffer] 7]) #@123 Returns an assoc of group names and active ranges. nn*-request-list should have been called before calling this function. (defalias 'nnmail-get-active #[nil "ÀŠ\nqˆebˆÃÄÀÅ#ƒ,Ɣƕ{ÇȔȕ{!Çɔɕ{!BD B‚ ) )‡" [nil group-assoc nntp-server-buffer re-search-forward "^\\([^ ]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+\\)" t 1 string-to-int 3 2] 5 (#$ . 11415)]) (defalias 'nnmail-save-active #[(group-assoc file-name) "ÀŠÂÃ!qˆÄp!ˆÅ ˆƒ0@ÇÈ @ A@A A@@$cˆA‰„ÉÊdË\f!ÀÍ%ˆÎp!*‡" [nil group get-buffer-create " *nnmail active*" buffer-disable-undo erase-buffer group-assoc format "%s %d %d y\n" write-region 1 expand-file-name file-name nomesg kill-buffer] 7]) (defalias 'nnmail-get-split-group #[(file group) "Á=„\n\nƒ2 ƒ ‡ÄÅÆÇ!!É\nË°Æ\f!\"ƒ0Æ\f!͔͕O‡ ‡ ‡" [nnmail-spool-file procmail nnmail-use-procmail group string-match "^" expand-file-name file-name-as-directory nnmail-procmail-directory "\\(.*\\)" nnmail-procmail-suffix "$" file 1] 6]) #@131 Go through the entire INCOMING file and pick out each individual mail. FUNC will be called with the buffer narrowed to each mail. (defalias 'nnmail-split-incoming #[(incoming func &optional dont-kill group) "À P\nƒ Ä=„ ƒ„\nÇDC‚ɉ‰‰‰\n \f ŠÐ ˆÑÒ!qˆÓp!ˆÔ ˆÕ!ˆebˆŠ×Ø!ˆ)ÙÉÚ#ƒ\"Û”bƒ\"m„\"`ÜÝÉÚ#„qÞyˆŠßàÉÚ#ƒ„Þ”Þ•{\n‚‘áyˆâã ‰\n䱈)ŠßåÚ#…­æÞ”Þ•{!‰\f…­çcˆÚ)„·Ú ‚Þ`\f\\dU„ÏŠ`\f\\bˆè!)ƒÛ`\f\\bˆÉ ‚ÞÚ  ƒöÙÉÚ#ƒóÛ”bˆ‚ödbˆŠŒ`}ˆebˆé\n!ƒed|ˆ‚ê\n!ˆ+ ˆd * bˆ‚_ì ˆ-ƒ.p‚1îp!.‡" ["^" rmail-unix-mail-delimiter group nnmail-spool-file procmail nnmail-use-procmail nnmail-resplit-incoming "" nnmail-split-methods nil message-id do-search content-length end start delim nnmail-cache-open get-buffer-create " *nnmail incoming*" buffer-disable-undo erase-buffer insert-file-contents incoming run-hooks nnmail-prepare-incoming-hook re-search-forward t 0 search-forward "\n\n" 1 re-search-backward "^Message-ID:[ ]*\\(<[^>]*>\\)" -1 "Message-ID: " nnmail-message-id "\n" "^Content-Length: \\([0-9]+\\)" string-to-int "X-" looking-at nnmail-cache-id-exists-p nnmail-cache-insert func nnmail-cache-close dont-kill kill-buffer] 7 (#$ . 12377)]) #@136 Look at the headers and return an alist of groups that match. FUNC will be called with the group name to determine the article number. (defalias 'nnmail-article-group #[(func) "peÁ‰Ç!ƒ,GÈUƒ,@@ @@!BC‰‚ߊ\fbˆÊËÁÌ#ƒ<`‚=dÍÎ!qˆÏp!ˆÐ ˆÑ \f #ˆebˆÒÓÁÌ#ƒdÔÕ̉#ˆ‚S9ƒzÖ!ƒz×ØÁÙÚ\"‚كلˆ\n„ÙdbˆA„›@A@Üš„¾ÁÝÞƒÐß@@\n\"„Ð@@ @@!B\nB‚Ð\n„Ð@@ @@!BCA‰„àp!ˆ\n)-‡" [nnmail-split-methods nil group-art end beg obuf methods sequencep 1 func search-forward "\n\n" t get-buffer-create " *nnmail work*" buffer-disable-undo erase-buffer insert-buffer-substring re-search-forward "\\( ?\n[ ]+\\)+" replace-match " " fboundp mapcar #[(group) " !B‡" [group func] 3] (funcall nnmail-split-methods) ((error (byte-code "ÀÁ!ˆÂÃ!ˆÄ‡" [message "Problems with `nnmail-split-methods', using `bogus' mail group" sit-for 1 ("bogus")] 2))) nnmail-crosspost "" (byte-code "@A@;ƒÁ@A@ÂÃ#‡@A@@@!‡" [methods re-search-backward nil t] 4) ((error)) assoc kill-buffer] 6 (#$ . 13577)]) #@68 Insert how many lines and chars there are in the body of the mail. (defalias 'nnmail-insert-lines #[nil "À‰ŠebˆÃÄÀÅ#…6d`ZÆ`d\"ÇZÈuˆŠÉÊÀÅ#ƒ.`Çyˆ`|ˆ)ËÌ\n\"cˆ +‡" [nil chars lines search-forward "\n\n" t count-lines 1 -1 re-search-backward "^Lines: " format "Lines: %d\n"] 4 (#$ . 14598)]) #@59 Insert an Xref line based on the (group . article) alist. (defalias 'nnmail-insert-xref #[(group-alist) "ŠebˆÀÁÂÃ#…CÄuˆÅÆÂÃ#ƒÇ”Èyˆ`|ˆÉÊË \"cˆ\fƒAÉÍ\f@@\f@A#cˆ\fA‰\f„+Îc)‡" [search-forward "\n\n" nil t -1 re-search-backward "^Xref: " 0 1 format "Xref: %s" system-name group-alist " %s:%d" "\n"] 5 (#$ . 14897)]) (defalias 'nnmail-make-complex-temp-name #[(prefix) "À ! Ä !ƒ\nÅPÀ\n!‚ *‡" [make-temp-name prefix newprefix newname file-exists-p "x"] 2]) #@104 Fancy splitting method. See the documentation for the variable `nnmail-split-fancy' for documentation. (defalias 'nnmail-split-fancy #[nil "À !‡" [nnmail-split-it nnmail-split-fancy] 2 (#$ . 15372)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp nnmail-split-cache nil current-load-list] 2) (defalias 'nnmail-split-it #[(split) ";ƒC‡@Á=ƒÂÃÄÅA\"\"‡@Æ=ƒ8ÇAƒ4AÅ@!‰ƒ\")‡ žƒTdbˆÊ žAÇË#…¡ÅÌ8!‡@ A@Ï 9ƒm žA‚o Ñ9ƒžA‚Ò°B B dbˆÊÇË#… ÅÌ8!+‡" [split & apply nconc mapcar nnmail-split-it | nil done nnmail-split-cache re-search-backward t 2 field value "^\\(" nnmail-split-abbrev-alist "\\):.*\\<\\(" "\\>\\)" regexp] 6]) (defalias 'nnmail-get-spool-files #[(&optional group) "À !… Ã\fƒ\f‚ÅÇQÃ$‰‰ ƒCÊ @!„1Ë @!ƒ:Ì @\" A‰ „! <ƒRÎ \"‚b ;ƒ` B‚b*‡" [file-exists-p nnmail-procmail-directory directory-files t group "" nnmail-procmail-suffix "$" procmails p file-directory-p file-symlink-p delete nnmail-spool-file append] 7]) (defalias 'nnmail-activate #[(backend &optional force) "À‰‰ÄÅÆ\"!JƒW„WÀÉʉƒ~ËÌ !8‰ƒ~ÀÍΉƒW\n:ƒW\nÏš„W @\n@V„W @\n@Uƒ~ A@\nA@Vƒ~Š\nÐ=„iÄÅÑ\"!Ò LˆÄÅÓ\"! ˆÄÅÆ\"!Ô Lˆ)+Õ‡" [nil file-time timestamp file intern format "%s-group-alist" backend force (byte-code "ÀÁ \"!J‡" [intern format "%s-active-file" backend] 4) ((error)) 5 file-attributes (byte-code "ÀÁ \"!J‡" [intern format "%s-active-timestamp" backend] 4) ((error (quote none))) (0 0) none "%s-active-timestamp" current-time "%s-request-list" nnmail-get-active t] 4]) (defalias 'nnmail-message-id #[nil "ÀÁ ÂQ‡" ["<" nnmail-unique-id "@totally-fudged-out-message-id>"] 3]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp nnmail-unique-id-char nil current-load-list] 2) (defalias 'nnmail-number-base36 #[(num len) "ÁWƒ\f\nÁX‚ÁUƒÇÄ\nÅ¥S\"ÆÇ\nŦH!P‡" [len 0 num "" nnmail-number-base36 36 char-to-string "zyxwvutsrqponmlkjihgfedcba9876543210"] 5]) (defalias 'nnmail-unique-id #[nil "†ÁÂÃ!ÄÅÆ\"S\"TǦÈÉ!ƒÉ ‚Ê Ì @ÄͦÎ\"\\Ï\"Ì A@ÄÍ¥Î\"\\Ï\"P)‡" [nnmail-unique-id-char logand random t lsh 1 20 625 fboundp current-time (12191 46742 287898) tm nnmail-number-base36 25 16 4] 6]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp nnmail-cache-buffer nil current-load-list] 2) (defalias 'nnmail-cache-open #[nil "?†\f …\f !?…*ŠÃÄ!‰qˆÅp!ˆÆ!ƒ(È!ˆp)‡" [nnmail-delete-duplicates nnmail-cache-buffer buffer-name get-buffer-create " *nnmail message-id cache*" buffer-disable-undo file-exists-p nnmail-message-id-cache-file insert-file-contents] 2]) (defalias 'nnmail-cache-close #[nil "?† ?†Â!?†Ã!??…OŠqˆdbˆÄÅÆÇ$ƒ1Éyˆe`|ˆÊË\f!!„BÍË\f!Ç\"ˆÎed\fÆÏ%ˆÐÆ!)‡" [nnmail-cache-buffer nnmail-delete-duplicates buffer-name buffer-modified-p search-backward "\n" nil t nnmail-message-id-cache-length 0 file-exists-p file-name-directory nnmail-message-id-cache-file make-directory write-region silent set-buffer-modified-p] 6]) (defalias 'nnmail-cache-insert #[(id) "…Š qˆdbˆ\nñ)‡" [nnmail-delete-duplicates nnmail-cache-buffer id "\n"] 2]) (defalias 'nnmail-cache-id-exists-p #[(id) "…Š qˆdbˆÂ ÄÅ#)‡" [nnmail-delete-duplicates nnmail-cache-buffer search-backward id nil t] 4]) (provide (quote nnmail)) emacs-19.30/lisp/nnmbox.elc100666 23053 1 22512 6046561721 14414 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:30:51 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/nnmbox.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nnmbox.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!‡" [require nnheader rmail nnmail] 2) #@61 The name of the mail box file in the user's home directory. (defvar nnmbox-mbox-file (expand-file-name "~/mbox") (#$ . 538)) #@47 The name of the active file for the mail box. (defvar nnmbox-active-file (expand-file-name "~/.mbox-active") (#$ . 669)) #@74 If non-nil, nnmbox will check the incoming mail file and split the mail. (defvar nnmbox-get-new-mail t (#$ . 796)) #@48 Hook run narrowed to an article before saving. (defvar nnmbox-prepare-save-mail-hook nil (#$ . 917)) #@17 nnmbox version. (defconst nnmbox-version "nnmbox 1.0" (#$ . 1024)) #@38 Current nnmbox news group directory. (defvar nnmbox-current-group nil (#$ . 1097)) (byte-code "ÀÁ\nBÃÄ!„ÅÄ\nBÃÆ!„ÀÆ\nBÃÇ!„(ÀÇ\nBÃÈ!„5ÀÈ\nBÃÉ!„BÀ É\nBÃÊ!„_Ë DÌ\fDÍ DÎÏЯ\nÊ\nBÀ‡" [nil nnmbox-mbox-buffer current-load-list boundp nnmbox-status-string "" nnmbox-group-alist nnmbox-active-timestamp nnmbox-current-server nnmbox-server-alist nnmbox-server-variables nnmbox-mbox-file nnmbox-active-file nnmbox-get-new-mail (nnmbox-current-group nil) (nnmbox-status-string "") (nnmbox-group-alist nil)] 6) (defalias 'nnmbox-retrieve-headers #[(sequence &optional newsgroup server) "ŠqˆÁ ˆ\nGÃĉ‰‰ \nË\f!ˆ\n@;ƒ(Í‚ß\nƒ°\n@Î!qˆÐÄÑ#„OebˆÐÄÑ#ƒ~ŠÒÓPÄÑ#ˆ`)ÐÕÄÑ#ˆ`SqˆÖ×\"cˆØ #ˆdbˆÙcˆ\nA T §ƒ(\nVƒ( Û¦ÃUƒ(ƒ(ÝÞ ß_\n¥\"ˆ‚(§ƒÇ\nVƒÇƒÇÝà!ˆqˆebˆáâÄÑ#ƒÞãäщ#ˆ‚ÍÍ.‡" [nntp-server-buffer erase-buffer sequence 0 nil stop start art-string article count number nnmbox-possibly-change-newsgroup newsgroup headers nnmbox-article-string nnmbox-mbox-buffer search-forward t re-search-backward "^" rmail-unix-mail-delimiter "\n\n" format "221 %d Article retrieved.\n" insert-buffer-substring ".\n" nnmail-large-newsgroup 20 gnus-verbose-backends message "nnmbox: Receiving headers... %d%%" 100 "nnmbox: Receiving headers...done" re-search-forward "\\( ?\n[ ]+\\)+" replace-match " "] 6]) (defalias 'nnmbox-open-server #[(server &optional defs) "À ˆ \nšƒ Ç\nƒ\nÄ !DBÇ \"‰ƒ6ÉA@!ˆÊ\"‚<Ë \f\"ˆ) ‰‡" [nnheader-init-server-buffer server nnmbox-current-server t nnheader-save-variables nnmbox-server-variables nnmbox-server-alist assoc state nnheader-restore-variables delq nnheader-set-init-variables defs] 4]) (defalias 'nnmbox-close-server #[(&optional server) "À‡" [t] 1]) (defalias 'nnmbox-server-opened #[(&optional server) " š…\n…Ã\n!…\f…Ã\f!‡" [server nnmbox-current-server nnmbox-mbox-buffer buffer-name nntp-server-buffer] 2]) (defalias 'nnmbox-status-message #[(&optional server) "‡" [nnmbox-status-string] 1]) (defalias 'nnmbox-request-article #[(article &optional newsgroup server buffer) "À !ˆ\n;?…vŠ qˆebˆÄÅ\n!ÆÇ#…uƉ ÊË\fPÆÇ#ˆ` ÍyˆÎË\fPÆÇ#ƒ@Ïy„Cdbˆ`†M‰qˆÒ ˆÓ  #ˆebˆÔÕ!ƒsÖ×!ˆØcˆÍyˆ‚`+Ç)‡" [nnmbox-possibly-change-newsgroup newsgroup article nnmbox-mbox-buffer search-forward nnmbox-article-string nil t stop start re-search-backward "^" rmail-unix-mail-delimiter 1 re-search-forward -1 buffer nntp-server-buffer erase-buffer insert-buffer-substring looking-at "From " delete-char 5 "X-From-Line: "] 5]) (defalias 'nnmbox-request-group #[(group &optional server dont-check) "ŠÀ !…A\nƒÂAÄ !ˆŠ qˆÆ ˆÇ \" ÊË A@A A@@ZT A@@ A@A @%cˆ*Ã)‡" [nnmbox-possibly-change-newsgroup group dont-check t nnmbox-get-new-mail nntp-server-buffer erase-buffer assoc nnmbox-group-alist active format "211 %d %d %d %s\n"] 6]) (defalias 'nnmbox-close-group #[(group &optional server) "À‡" [t] 1]) (defalias 'nnmbox-request-list #[(&optional server) "ƒÁ ˆŠÂ !†Ä Æ \"ˆÂ !)‡" [server nnmbox-get-new-mail nnmail-find-file nnmbox-active-file nnmail-get-active nnmbox-group-alist nnmail-save-active] 3]) (defalias 'nnmbox-request-newgroups #[(date &optional server) "À !‡" [nnmbox-request-list server] 2]) (defalias 'nnmbox-request-list-newsgroups #[(&optional server) "À‡" ["nnmbox: LIST NEWSGROUPS is not implemented." nnmbox-status-string nil] 1]) (defalias 'nnmbox-request-post #[(&optional server) "ÀÁ!‡" [mail-send-and-exit nil] 2]) (defalias (quote nnmbox-request-post-buffer) (quote nnmail-request-post-buffer)) (defalias 'nnmbox-request-expire-articles #[(articles newsgroup &optional server force) "À !ˆ\nƒ\n !† ÅÇÉÊ!ˆŠ qˆ\fƒrƒrebˆÍÎ\f@!ÇÅ#ƒi„OÐÑ `Lj`{\"\fV‰ƒaƒ[ÓÔ\f@\"ˆÕ ˆ‚i\f@B\fA‰\f„$Ö ˆ× \"A@ebˆÍÎ@!ÇÅ#„¤@AXƒ¤‰@T ˆebˆ‚)Ú\"ˆ\f¤,‡" [nnmbox-possibly-change-newsgroup newsgroup nnmail-expiry-wait-function nnmail-expiry-wait days t is-old nil rest nnmail-activate nnmbox nnmbox-mbox-buffer articles search-forward nnmbox-article-string force nnmail-days-between current-time-string gnus-verbose-backends message "Deleting article %s..." nnmbox-delete-mail save-buffer assoc nnmbox-group-alist active nnmail-save-active nnmbox-active-file] 5]) (defalias 'nnmbox-request-move-article #[(article group server accept-form &optional last) "À !ˆÂÃ!ÄÇ  #ƒtŠqˆÊp!ˆË ˆÌ !ˆebˆÎÏŠÐÑÄÒ#ˆ`)Ò#ƒFÓyˆ`Ôyˆ`|ˆ‚)Õ!×!ˆ )ƒtŠqˆebˆÐÙ!ÄÒ#ƒkÚ ˆƒsÜ ˆ) *‡" [nnmbox-possibly-change-newsgroup group get-buffer-create " *nnmbox move*" nil result buf nnmbox-request-article article server buffer-disable-undo erase-buffer insert-buffer-substring nntp-server-buffer re-search-forward "^X-Gnus-Newsgroup:" search-forward "\n\n" t 0 1 eval accept-form kill-buffer nnmbox-mbox-buffer nnmbox-article-string nnmbox-delete-mail last save-buffer] 6]) (defalias 'nnmbox-request-accept-article #[(group &optional last) "pÀebˆÃÄ!ƒÅÆ!ˆ‚ÇÈ É±ˆÊË!ƒn\nqˆebˆÌÍÀÎ#ˆÏyˆÐÑÀÎ#ƒB`Òyˆ`|ˆ‚0Ó;…K!‰ƒnŠqˆÖ\n!ˆƒbØ ˆ )ƒnÙ\"ˆ @*‡" [nil result buf looking-at "X-From-Line: " replace-match "From " "From nobody " current-time-string "\n" nnmail-activate nnmbox search-forward "\n\n" t -1 re-search-backward "^X-Gnus-Newsgroup: " 1 nnmbox-save-mail group nnmbox-mbox-buffer insert-buffer-substring last save-buffer nnmail-save-active nnmbox-group-alist nnmbox-active-file] 4]) (defalias 'nnmbox-request-replace-article #[(article group buffer) "À !ˆŠ\nqˆebˆÃÄ !ÆÇ#…#Èlj\"ˆÉ\n!ˆË ˆÇ)‡" [nnmbox-possibly-change-newsgroup group nnmbox-mbox-buffer search-forward nnmbox-article-string article nil t nnmbox-delete-mail insert-buffer-substring buffer save-buffer] 4]) (defalias 'nnmbox-delete-mail #[(&optional force leave-delim) "„Áyˆ`Âyˆ`|ˆŠŒŠÃÄ PÆÇ#ˆƒ%Âyˆ`‚'Á”)ÂyˆÉÄ PÆÇ#ƒJo„EƒEÊyˆ`‚GÁ”†Kd}ˆebˆ„]ÉËÆÇ#?…`ed|*‡" [force 0 1 re-search-backward "^" rmail-unix-mail-delimiter nil t leave-delim re-search-forward -2 "^X-Gnus-Newsgroup: "] 5]) (defalias 'nnmbox-possibly-change-newsgroup #[(newsgroup) "ƒ\nÁ!„ŠÂ ÄÅ#‰qˆÆp!ˆ)„\"ÈÉ!ˆ\n…5Ë\n\"…5\n‰\f‡" [nnmbox-mbox-buffer buffer-name nnheader-find-file-noselect nnmbox-mbox-file nil raw buffer-disable-undo nnmbox-group-alist nnmail-activate nnmbox newsgroup assoc nnmbox-current-group] 4]) (defalias 'nnmbox-article-string #[(article) "À ÂÃ\f!Å°‡" ["\nX-Gnus-Newsgroup: " nnmbox-current-group ":" int-to-string article " "] 5]) #@32 Called narrowed to an article. (defalias 'nnmbox-save-mail #[(&optional group) "ƒ ÁDC‚\f\nÃÄ!ŸÆ ˆÇ !ˆÈ !ˆÉÊ!ˆ *‡" [group "" nnmail-split-methods nnmail-article-group nnmbox-active-number group-art nnmail-insert-lines nnmail-insert-xref nnmbox-insert-newsgroup-line run-hooks nnml-prepare-save-mail-hook] 2 (#$ . 7491)]) (defalias 'nnmbox-insert-newsgroup-line #[(group-art) "ŠebˆÀÁÂÃ#ƒ'Äuˆ ƒ'ÆÇ @@ @AÈ $cˆ A‰„)Ç" [search-forward "\n\n" nil t -1 group-art format "X-Gnus-Newsgroup: %s:%d %s\n" current-time-string] 6]) (defalias 'nnmbox-active-number #[(group) "À \n\"A@‰ƒ ‰AT¡ˆ‚ ĉB‰D\nB A)‡" [assoc group nnmbox-group-alist active 1] 4]) (defalias 'nnmbox-read-mbox #[nil "ÀÁ!ˆÂ !„Äʼn ÆÇ%ˆ…,É!…,ŠqˆÊ ËÌ !8U)?…ŠŠÍPωÓ ÏÔ#‰qˆÕp!ˆebˆÖÏÆ#…‰×”ØÙŠÖÏÆ#ƒl×”†md‰)Æ#„‚ŠŒ}ˆÚ ˆ*bˆ‚N,‡" [nnmail-activate nnmbox file-exists-p nnmbox-mbox-file write-region 1 t nomesg nnmbox-mbox-buffer buffer-name buffer-size 7 file-attributes "^" rmail-unix-mail-delimiter nil end start delim nnheader-find-file-noselect raw buffer-disable-undo re-search-forward 0 search-forward "\nX-Gnus-Newsgroup: " nnmbox-save-mail] 6]) #@25 Read new incoming mail. (defalias 'nnmbox-get-new-mail #[(&optional group) "À ! ÄÄÇ ˆ?† ??…½\nƒuÊ\n@!ƒnËÌ\n@!8ÍVƒnƒ:ÏÐ!ˆÑ\n@ÓP\"‰ƒn BŠÔ\n@ \"Õ Ö× $qˆdbˆÚ!ˆÛ!ˆ*\nA‰„Ü!ƒŒŠÝ\"ˆqˆà ˆ)ƒ•áâ!ˆ…½@#ƒ³Ê !ƒ³ä !ƒ³å !ˆA‰„šÄ,‡" [nnmail-get-spool-files group spools group-in nil incoming incomings nnmbox-read-mbox nnmbox-get-new-mail nnmail-spool-file file-exists-p 7 file-attributes 0 gnus-verbose-backends message "nnmbox: Reading incoming mail..." nnmail-move-inbox nnmbox-mbox-file "-Incoming" nnmail-get-split-group nnmail-split-incoming nnmbox-save-mail t in-buf nnmbox-mbox-buffer insert-buffer-substring kill-buffer buffer-modified-p nnmail-save-active nnmbox-group-alist nnmbox-active-file save-buffer run-hooks nnmail-read-incoming-hook nnmail-delete-incoming file-writable-p delete-file] 6 (#$ . 8655)]) (provide (quote nnmbox)) emacs-19.30/lisp/nnmh.elc100666 23053 1 22736 6046561736 14071 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:30:53 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/nnmh.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nnmh.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!‡" [require nnheader rmail nnmail gnus] 2) #@24 *Mail spool directory. (defvar nnmh-directory "~/Mail/" (#$ . -543)) #@73 *If non-nil, nnmh will check the incoming mail file and split the mail. (defvar nnmh-get-new-mail t (#$ . -618)) #@49 *Hook run narrowed to an article before saving. (defvar nnmh-prepare-save-mail-hook nil (#$ . -737)) #@85 *If non-nil, nnmh will check all articles to make sure whether they are new or not. (defvar nnmh-be-safe nil (#$ . -844)) #@15 nnmh version. (defconst nnmh-version "nnmh 1.0" (#$ . 972)) #@31 Current news group directory. (defvar nnmh-current-directory nil (#$ . 1038)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÅÆ BÀÇ!„.ÅÇ BÀÈ!„GÉ DÊ\nDËÌͯÈ BŇ" [boundp nnmh-status-string "" current-load-list nnmh-group-alist nil nnmh-current-server nnmh-server-alist nnmh-server-variables nnmh-directory nnmh-get-new-mail (nnmh-current-directory nil) (nnmh-status-string "") (nnmh-group-alist)] 5) (defalias 'nnmh-retrieve-headers #[(sequence &optional newsgroup server) "ŠqˆÁ ˆÂ\fG§… VÈ Â\nÂ Ì !ˆ\f@;ƒ0΂º\fƒœ\f@ Ð !PÑ !ƒyÒ !„yÓÔ \"cˆ`\nÕ !ˆ\nbˆÖ×ÂØ#ƒlÙuˆ‚rdbˆ×cˆÚcˆ`d|ˆ\fA T ƒ0 Û¦ÈUƒ0ÜÝ Þ_ ¥\"ˆ‚0ƒ¥Üß!ˆebˆàáÂØ#ƒ¹âã؉#ˆ‚¨Î.‡" [nntp-server-buffer erase-buffer nil file sequence number nnmail-large-newsgroup large 0 count beg article nnmh-possibly-change-directory newsgroup headers nnmh-current-directory int-to-string file-exists-p file-directory-p format "221 %d Article retrieved.\n" nnheader-insert-head search-forward "\n\n" t -1 ".\n" 20 message "nnmh: Receiving headers... %d%%" 100 "nnmh: Receiving headers...done" re-search-forward "\\( ?\n[ ]+\\)+" replace-match " "] 4]) (defalias 'nnmh-open-server #[(server &optional defs) "À ˆ \nšƒ Ç\nƒ\nÄ !DBÇ \"‰ƒ6ÉA@!ˆÊ\"‚<Ë \f\"ˆ) ‰‡" [nnheader-init-server-buffer server nnmh-current-server t nnheader-save-variables nnmh-server-variables nnmh-server-alist assoc state nnheader-restore-variables delq nnheader-set-init-variables defs] 4]) (defalias 'nnmh-close-server #[(&optional server) "À‡" [t] 1]) (defalias 'nnmh-server-opened #[(&optional server) " š… \n… Ã\n!‡" [server nnmh-current-server nntp-server-buffer buffer-name] 2]) (defalias 'nnmh-status-message #[(&optional server) "‡" [nnmh-status-string] 1]) (defalias 'nnmh-request-article #[(id &optional newsgroup server buffer) "À !ˆ\n;?… Ä\n!P †‰;…3È!…3É!?…3ŠÊ!)*‡" [nnmh-possibly-change-directory newsgroup id nnmh-current-directory int-to-string buffer nntp-server-buffer file file-exists-p file-directory-p nnmail-find-file] 4]) (defalias 'nnmh-request-group #[(group &optional server dont-check) "ƒ\f „\fÀ\n!ˆÃ\n\f\"ÅÈ!ƒy ƒ-\nƒ-Ë\n!ˆ „uÌÍÎÏÅÐÑ$\"Ò\"ŠqˆÔ ˆƒnÕÖG@AƒdA‰‚W@\n%cˆ‚tÕ×\n\"cˆ)Ñ‚}ØÅ*‡" [nnmh-get-new-mail dont-check group nnmh-article-pathname nnmh-directory nil dir pathname file-directory-p nnmh-current-directory nnmh-be-safe nnmh-update-gnus-unreads sort mapcar #[(name) "À !‡" [string-to-int name] 2] directory-files "^[0-9]+$" t < nntp-server-buffer erase-buffer format "211 %d %d %d %s\n" "211 0 1 0 %s\n" "No such group" nnmh-status-string] 9]) (defalias 'nnmh-request-list #[(&optional server dir) "„Š qˆÂ ˆÃÄ !!)Æ!Ç!….ÈÉ!!A@ÊV….ËÌÍÌ$‰ƒ]ÏÐ@\"„TÑ@!ƒTÇ@!ƒTÒÍ@\"ˆA‰„4)Æ !˜„¡ÓÔËÍÕÌ$\"‰ƒ Š qˆdbˆ×ØÏÃÄÆ !!!\"ˆÙÚ•ÍOÛÜ#ÝÞ\"Ýß\"$cˆ))à !\"ƒ²#ƒ²ã ˆÌ‡" [dir nntp-server-buffer erase-buffer file-truename file-name-as-directory nnmh-directory expand-file-name file-readable-p file-attributes file-chase-links 2 directory-files t nil dirs string-match "/\\.\\.?$" file-directory-p nnmh-request-list mapcar #[(name) "À !‡" [string-to-int name] 2] "^[0-9]+$" files format "%s %d %d y\n" nnmail-replace-chars-in-string 0 47 46 apply max min nnmail-get-active nnmh-group-alist server nnmh-get-new-mail] 8]) (defalias 'nnmh-request-newgroups #[(date &optional server) "À !‡" [nnmh-request-list server] 2]) (defalias 'nnmh-request-post #[(&optional server) "ÀÁ!‡" [mail-send-and-exit nil] 2]) (defalias (quote nnmh-request-post-buffer) (quote nnmail-request-post-buffer)) (defalias 'nnmh-request-expire-articles #[(articles newsgroup &optional server force) "À !ˆ\nƒ\n !† ÅÆÇÉÊË$\"‰\f…%ÍÎ\f\"ËÉÉÉÔÕ!ˆƒªƒª×@!PØÙ!8‰ƒ¡ƒjƒj@U„™Ûš„™„†ÝÞ Þ!\"\fV‰ƒ™ƒ‘àá\"ˆÉâ㈂¡@BA‰„<àä!ˆ¤.‡" [nnmh-possibly-change-directory newsgroup nnmail-expiry-wait-function nnmail-expiry-wait days mapcar #[(name) "À !‡" [string-to-int name] 2] directory-files nnmh-current-directory nil "^[0-9]+$" t active-articles apply max max-article is-old article rest mod-time nnmail-activate nnmh articles int-to-string 5 file-attributes nnmail-keep-last-article (0 0) force nnmail-days-between current-time-string gnus-verbose-backends message "Deleting article %s..." (delete-file article) ((file-error (byte-code "@ B‡" [articles rest nil] 2))) ""] 8]) (defalias 'nnmh-close-group #[(group &optional server) "À‡" [t] 1]) (defalias 'nnmh-request-move-article #[(article group server accept-form &optional last) "ÀÁ!ÂÅ#ƒ-Š\fqˆÉ\n!ˆË\f!Íp!ˆ )ƒ-ÂÎψ *‡" [get-buffer-create " *nnmh move*" nil result buf nnmh-request-article article group server insert-buffer-substring nntp-server-buffer eval accept-form kill-buffer (byte-code "À  !P!‡" [delete-file nnmh-current-directory int-to-string article] 4) ((file-error))] 4]) (defalias 'nnmh-request-accept-article #[(group &optional last) ";ƒÁÂ!…ÃDCÅ @)‡ÁÂ!…Å @‡" [group nnmail-activate nnmh "" nnmail-split-methods nnmh-save-mail] 2]) (defalias 'nnmh-request-replace-article #[(article group buffer) "À !ˆŠ\nqˆÃ !ˆÄÅÆ)‡" [nnmh-possibly-change-directory group buffer nnmh-possibly-create-directory nil (byte-code "Àed  !PÄ ?…Æ%ˆÇ‡" [write-region nnmh-current-directory int-to-string article nil gnus-verbose-backends nomesg t] 6) ((error))] 3]) (defalias 'nnmh-possibly-change-directory #[(newsgroup) "…Á\n\"Ä !ƒ ‰‚ÆÇ\")‡" [newsgroup nnmh-article-pathname nnmh-directory pathname file-directory-p nnmh-current-directory error "No such newsgroup: %s"] 3]) (defalias 'nnmh-possibly-create-directory #[(group) "À‰Ã\f \"Æ\n!„\n BÇÈ\n!!‚ …BÉÈ @!!ƒ/ÊË @\"ˆ\fƒ:ÍÎ @\"ˆ A‰„ À*‡" [nil dirs dir nnmh-article-pathname group nnmh-directory file-directory-p file-name-directory directory-file-name make-directory error "Could not create directory %s" gnus-verbose-backends message "Creating mail directory %s"] 4]) #@32 Called narrowed to an article. (defalias 'nnmh-save-mail #[nil "ÀÁ!Ÿà ˆÄ\n!ˆÅÆ!ˆebˆÇÈ!ƒ#ÉÊ!ˆËyˆ‚\nÌ ‰ƒlÏ@@!ˆÐ@@\"Ò@A!P ƒUÔ Õ#ˆ‚bÖed̉%ˆ )A‰„-*\n)‡" [nnmail-article-group nnmh-active-number group-art nnmail-insert-lines nnmail-insert-xref run-hooks nnmh-prepare-save-mail-hook looking-at "From " replace-match "X-From-Line: " 1 nil first ga nnmh-possibly-create-directory nnmh-article-pathname nnmh-directory int-to-string file add-name-to-file t write-region] 7 (#$ . 6997)]) #@43 Compute the next article number in GROUP. (defalias 'nnmh-active-number #[(group) "À \n\"A@‰„ÄÅB D\nB ‰AT¡ˆÆÇ \"É A!P!ƒ3 ‰AT¡ˆ‚ A)‡" [assoc group nnmh-group-alist active 1 0 file-exists-p nnmh-article-pathname nnmh-directory int-to-string] 5 (#$ . 7513)]) #@26 Make pathname for GROUP. (defalias 'nnmh-article-pathname #[(group mail-dir) "ÀÁ\n!!Ã\n\fP!ƒ\n\fÅQ‚\nÆ\fÇÈ#ÅQ)‡" [file-name-as-directory expand-file-name mail-dir file-directory-p group "/" nnmail-replace-chars-in-string 46 47] 5 (#$ . 7786)]) #@25 Read new incoming mail. (defalias 'nnmh-get-new-mail #[(&optional group) "À ! ÄÄ?†??…˜ „ Ê ˆ\nƒhË\n@!ƒaÌÍ\n@!8ÎVƒaƒ?ÐÑ!ˆÒ\n@Ó!ÕP\"‰ƒa BÖ\n@ \"× ØÄ $ˆ\nA‰„$ ƒpÐÙ!ˆ…˜@ƒŽË !ƒŽÛ !ƒŽÜ !ˆA‰„uÄ,‡" [nnmail-get-spool-files group spools group-in nil incoming incomings nnmh-get-new-mail nnmail-spool-file nnmh-group-alist nnmh-request-list file-exists-p 7 file-attributes 0 gnus-verbose-backends message "nnmh: Reading incoming mail..." nnmail-move-inbox file-name-as-directory nnmh-directory "Incoming" nnmail-get-split-group nnmail-split-incoming nnmh-save-mail "nnmh: Reading incoming mail...done" nnmail-delete-incoming file-writable-p delete-file] 6 (#$ . 8041)]) (defalias 'nnmh-update-gnus-unreads #[(group) "ÂÃÄÅÆÇÈ$\"É\"\n ËP\fÆ ÆÏ\f!ƒ/ÆÆÑÒˆ)\n‰ƒQ@ž„H@ B A‰„7)‰ƒv@@\n>„mÔ@\"A‰„Z)‰ƒ®ÕÖ ×@@!P!8@Aš„®Ô@\"@@ B A‰„) ‰ƒÔ@ÕÖ ×@!P!8BBA‰„·)Ù G!„ïÚÛÝÞD\" É\"‰ \"ˆÂß\"Šàá!qˆâ㱈äcˆå!汈çed\fÆè%ˆép!.‡" [nnmh-current-directory dir sort mapcar #[(name) "À !‡" [string-to-int name] 2] directory-files nil "^[0-9]+$" t < files ".nnmh-articles" nnmh-file new articles file-exists-p nnmh-newsgroup-articles (byte-code "À ÂÉ$‡" [load nnmh-file nil t] 5) ((error)) art delq 5 file-attributes int-to-string n zerop gnus-make-articles-unread gnus-group-prefixed-name group nnmh "" #[(art1 art2) "@ @V‡" [art1 art2] 2] get-buffer-create "*nnmh out*" ";; Gnus article active file for " "\n\n" "(setq nnmh-newsgroup-articles '" prin1-to-string ")\n" write-region nomesg kill-buffer] 9]) (provide (quote nnmh)) emacs-19.30/lisp/nnml.elc100666 23053 1 32227 6046561747 14073 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:30:55 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/nnml.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nnml.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require nnheader nnmail] 2) #@23 Mail spool directory. (defvar nnml-directory "~/Mail/" (#$ . 524)) #@19 Mail active file. (defvar nnml-active-file (concat nnml-directory "active") (#$ . 597)) #@35 Mail newsgroups description file. (defvar nnml-newsgroups-file (concat nnml-directory "newsgroups") (#$ . 691)) #@72 If non-nil, nnml will check the incoming mail file and split the mail. (defvar nnml-get-new-mail t (#$ . 809)) #@451 If non-nil, Gnus will never generate and use nov databases for mail groups. Using nov databases will speed up header fetching considerably. This variable shouldn't be flipped much. If you have, for some reason, set this to t, and want to set it to nil again, you should always run the `nnml-generate-nov-databases' command. The function will go through all nnml directories and generate nov databases for them all. This may very well take some time. (defvar nnml-nov-is-evil nil (#$ . 927)) #@48 Hook run narrowed to an article before saving. (defvar nnml-prepare-save-mail-hook nil (#$ . 1424)) #@15 nnml version. (defconst nnml-version "nnml 1.0" (#$ . 1530)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÇÆ BÀÈ!„.ÅÈ BÀÉ!„;Å É BÀÊ!„HÅ\nÊ BÀË!„UÅ Ë BÀÌ!„bÅ\fÌ BÀÍ!„ŒÎDÏDÐDÑDÒDÁ DÓÔÕÖׯ  Í BŇ" [boundp nnml-nov-file-name ".overview" current-load-list nnml-current-directory nil nnml-status-string "" nnml-nov-buffer-alist nnml-group-alist nnml-active-timestamp nnml-current-server nnml-server-alist nnml-server-variables nnml-directory nnml-active-file nnml-newsgroups-file nnml-get-new-mail nnml-nov-is-evil (nnml-current-directory nil) (nnml-status-string "") (nnml-nov-buffer-alist nil) (nnml-group-alist nil) (nnml-active-timestamp nil)] 11) (defalias 'nnml-retrieve-headers #[(sequence &optional newsgroup server) "ŠqˆÁ ˆÂ Gĉ @;ƒ Ê‚×Ë\f!ˆÍ !ƒ/Î‚× ƒ« @Ð !P Ñ !ƒyÒ !„yÓÔ \"cˆ`Õ !ˆbˆÖ×ÂØ#ƒlÙuˆ‚rdbˆ×cˆÚcˆ`d|ˆ AT§ƒ/Vƒ/ܦÄUƒ/ƒ/Þßà_¥\"ˆ‚/§ƒÂVƒÂƒÂÞá!ˆebˆâãÂØ#ƒÖäå؉#ˆ‚ÅÊ.‡" [nntp-server-buffer erase-buffer nil sequence 0 article beg count number file headers nnml-possibly-change-directory newsgroup nnml-retrieve-headers-with-nov nov nnml-current-directory int-to-string file-exists-p file-directory-p format "221 %d Article retrieved.\n" nnheader-insert-head search-forward "\n\n" t -1 ".\n" nnmail-large-newsgroup 20 gnus-verbose-backends message "nnml: Receiving headers... %d%%" 100 "nnml: Receiving headers...done" re-search-forward "\\( ?\n[ ]+\\)+" replace-match " "] 5]) (defalias 'nnml-open-server #[(server &optional defs) "À ˆ \nšƒ Ç\nƒ\nÄ !DBÇ \"‰ƒ6ÉA@!ˆÊ\"‚<Ë \f\"ˆ) ‰‡" [nnheader-init-server-buffer server nnml-current-server t nnheader-save-variables nnml-server-variables nnml-server-alist assoc state nnheader-restore-variables delq nnheader-set-init-variables defs] 4]) (defalias 'nnml-close-server #[(&optional server) "À‡" [t] 1]) (defalias 'nnml-server-opened #[(&optional server) " š… \n… Ã\n!‡" [server nnml-current-server nntp-server-buffer buffer-name] 2]) (defalias 'nnml-status-message #[(&optional server) "‡" [nnml-status-string] 1]) (defalias 'nnml-request-article #[(id &optional newsgroup server buffer) "À !ˆ\n;?… Ä\n!P †‰;…3È!…3É!?…3ŠÊ!)*‡" [nnml-possibly-change-directory newsgroup id nnml-current-directory int-to-string buffer nntp-server-buffer file file-exists-p file-directory-p nnmail-find-file] 4]) (defalias 'nnml-request-group #[(group &optional server dont-check) "À !„\nÂć ƒÆ‡Ç !ˆÈÉ!ˆÊ  \"A@\fŠ qˆÎ ˆ\f…EÏÐ\fA\f@ZTÑ]\f@\fA %cˆÆ*‡" [nnml-possibly-change-directory group "Invalid group (no such directory)" nnml-status-string nil dont-check t nnml-get-new-mail nnmail-activate nnml assoc nnml-group-alist active nntp-server-buffer erase-buffer format "211 %d %d %d %s\n" 0] 6]) (defalias 'nnml-close-group #[(group &optional server) "À‡" [t] 1]) (defalias 'nnml-request-close #[nil "ÀÀÇ" [nil nnml-current-server nnml-server-alist t] 1]) (defalias 'nnml-request-create-group #[(group &optional server) "ÀÁ!ˆÂ \f\"„JÅ ÇÈB‰D\fBÉ !ˆÊ !ˆËÌÍÅÏ#\"‰ƒBÑÒ\" ˆÑÓ\"¡ˆ)Ô\f\"ˆ)Ö‡" [nnmail-activate nnml assoc group nnml-group-alist nil active 1 0 nnml-possibly-create-directory nnml-possibly-change-directory mapcar #[(file) "À !‡" [string-to-int file] 2] directory-files nnml-current-directory "^[0-9]+$" articles apply min max nnmail-save-active nnml-active-file t] 7]) (defalias 'nnml-request-list #[(&optional server) "ƒÁ ˆŠÂ !ˆÄ ‰)‡" [server nnml-get-new-mail nnmail-find-file nnml-active-file nnmail-get-active nnml-group-alist] 2]) (defalias 'nnml-request-newgroups #[(date &optional server) "À !‡" [nnml-request-list server] 2]) (defalias 'nnml-request-list-newsgroups #[(&optional server) "ŠÀ !)‡" [nnmail-find-file nnml-newsgroups-file] 2]) (defalias 'nnml-request-post #[(&optional server) "ÀÁ!‡" [mail-send-and-exit nil] 2]) (defalias (quote nnml-request-post-buffer) (quote nnmail-request-post-buffer)) (defalias 'nnml-request-expire-articles #[(articles newsgroup &optional server force) "À !ˆ\nƒ\n !† ÅÆÇÉÊË$\"‰\f…%ÍÎ\f\"ËÉÉÉÔÕ!ˆƒºƒº×@!PØÙ!8‰ƒ±ƒjƒj@U„©„†Üš„©ÝÞ Þ!\"\fV‰ƒ©ƒ‘àá\"ˆÉâãˆä@\f\"\få @\"ˆ‚±@BA‰„<æ '\"A@‰(ƒÙ(\fƒÖÍé\f\"†×ê ˆë',\"ˆ)í ˆàî!ˆ¤.‡" [nnml-possibly-change-directory newsgroup nnmail-expiry-wait-function nnmail-expiry-wait days mapcar #[(name) "À !‡" [string-to-int name] 2] directory-files nnml-current-directory nil "^[0-9]+$" t active-articles apply max max-article is-old article rest mod-time nnmail-activate nnml articles int-to-string 5 file-attributes nnmail-keep-last-article force (0 0) nnmail-days-between current-time-string gnus-verbose-backends message "Deleting article %s..." (delete-file article) ((file-error (byte-code "@ B‡" [articles rest nil] 2))) delq nnml-nov-delete-article assoc nnml-group-alist active min 0 nnmail-save-active nnml-active-file nnml-save-nov ""] 8]) (defalias 'nnml-request-move-article #[(article group server accept-form &optional last) "ÀÁ!ÂÅ#ƒ<Š\fqˆÉ\n!ˆË\f!Íp!ˆ )ƒ<ÂÎψÐ\"ˆƒ<Ò ˆ *‡" [get-buffer-create " *nnml move*" nil result buf nnml-request-article article group server insert-buffer-substring nntp-server-buffer eval accept-form kill-buffer (byte-code "À  !P!‡" [delete-file nnml-current-directory int-to-string article] 4) ((file-error)) nnml-nov-delete-article last nnml-save-nov] 4]) (defalias 'nnml-request-accept-article #[(group &optional last) "À\n;ƒ.ÃÄ!ƒK\nÅDCÇ @‰)ƒKÈ \n\"ˆ ƒKÌ ˆ‚KÃÄ!ƒKÇ @‰ƒKÈ \n\"ˆ ƒKÌ ˆ )‡" [nil result group nnmail-activate nnml "" nnmail-split-methods nnml-save-mail nnmail-save-active nnml-group-alist nnml-active-file last nnml-save-nov] 3]) (defalias 'nnml-request-replace-article #[(article group buffer) "À !ˆŠ\nqˆÃ !ˆÄÅÆ…{Ç È !ÊPÄ \f Î ! ŠÏ !qˆebˆÐ\f!„CÑÒ\fPÄÓ#ƒPÔyˆ`Õyˆ`|ˆ‚jÐÖ!ƒj×Ô”Ô•{! WƒjÕyÔU„PÔyˆÈ ! ±ˆØ ˆ,Ó)‡" [nnml-possibly-change-directory group buffer nnml-possibly-create-directory nil (byte-code "Àed  !PÄ ?…Æ%ˆÇ‡" [write-region nnml-current-directory int-to-string article nil gnus-verbose-backends nomesg t] 6) ((error)) nnmail-insert-lines int-to-string article " " nov-line art chars nnml-make-nov-line nnml-open-nov looking-at search-forward "\n" t 0 1 "[0-9]+ " string-to-int nnml-save-nov] 4]) (defalias 'nnml-retrieve-headers-with-nov #[(articles) "† ?…u\n@\nAƒ\nA‰‚\f\n@ \fPÈ !…tŠ qˆÊ ˆË !ˆebˆm„IÌp!WƒIÍyˆ‚6Îyˆm„TÍ`|ˆm„gÌp!YƒgÍyˆ‚TÎyˆm„r`d|ˆ)Ï+‡" [gnus-nov-is-evil nnml-nov-is-evil articles nnml-current-directory nnml-nov-file-name nov last first file-exists-p nntp-server-buffer erase-buffer insert-file-contents read 1 0 t] 5]) (defalias 'nnml-possibly-change-directory #[(newsgroup &optional force) "ƒÁ\n\"\f„Å !… ‰)‡Ç‡" [newsgroup nnmail-article-pathname nnml-directory pathname force file-directory-p nnml-current-directory t] 3]) (defalias 'nnml-possibly-create-directory #[(group) "À‰Ã\f \"Æ\n!„\n BÇÈ\n!!‚ …:ÉÈ @!!ˆ\nƒ2ËÌ @\"ˆ A‰„ À*‡" [nil dirs dir nnmail-article-pathname group nnml-directory file-directory-p file-name-directory directory-file-name make-directory gnus-verbose-backends message "Creating mail directory %s"] 4]) #@32 Called narrowed to an article. (defalias 'nnml-save-mail #[nil "ÀÁ!ŸÂ‰Æ Ç !ˆÈÉ!ˆebˆÊË!ƒ'ÌÍ!ˆÎyˆ‚ ‰ƒvÑ@@!ˆÒ@@\"Ô@A!PƒYÖ×#ˆ‚lØedÂ?…fÚ%ˆ)A‰„1*Û\f! ‰ƒ—Ü@@@A #ˆA‰„‚) +‡" [nnmail-article-group nnml-active-number nil nov-line chars group-art nnmail-insert-lines nnmail-insert-xref run-hooks nnml-prepare-save-mail-hook looking-at "From " replace-match "X-From-Line: " 1 first ga nnml-possibly-create-directory nnmail-article-pathname nnml-directory int-to-string file add-name-to-file t write-region gnus-verbose-backends nomesg nnml-make-nov-line nnml-add-nov] 7 (#$ . 8753)]) #@43 Compute the next article number in GROUP. (defalias 'nnml-active-number #[(group) "À \n\"A@‰„ÄÅB D\nB ‰AT¡ˆÆÇ \"É A!P!ƒ3 ‰AT¡ˆ‚ A)‡" [assoc group nnml-group-alist active 1 0 file-exists-p nnmail-article-pathname nnml-directory int-to-string] 5 (#$ . 9388)]) #@25 Read new incoming mail. (defalias 'nnml-get-new-mail #[(&optional group) "À ! ÄÄ?†??…¥ÉÊ!ˆ\nƒbË\n@!ƒ[ÌÍ\n@!8ÎVƒ[ƒ;ÐÑ!ˆÒ\n@ÔP\"‰ƒ[Õ\n@ \"Ö ×Ä $ˆ B\nA‰„ ƒ}Ø\"ˆÛ ˆÜÝ!ˆƒ}ÐÞ!ˆ…¥@ƒ›Ë !ƒ›à !ƒ›á !ˆA‰„‚Ä,‡" [nnmail-get-spool-files group spools group-in nil incoming incomings nnml-get-new-mail nnmail-spool-file nnmail-activate nnml file-exists-p 7 file-attributes 0 gnus-verbose-backends message "nnml: Reading incoming mail..." nnmail-move-inbox nnml-directory "Incoming" nnmail-get-split-group nnmail-split-incoming nnml-save-mail nnmail-save-active nnml-group-alist nnml-active-file nnml-save-nov run-hooks nnmail-read-incoming-hook "nnml: Reading incoming mail...done" nnmail-delete-incoming file-writable-p delete-file] 6 (#$ . 9663)]) #@36 Add a nov line for the GROUP base. (defalias 'nnml-add-nov #[(group article line) "ŠÀ !qˆdbˆÂ !\f±)‡" [nnml-open-nov group int-to-string article line] 2 (#$ . 10456)]) (defalias 'nnml-header-value #[nil "À•ŠÁˆ`){‡" [0 nil] 2]) (put (quote nnml-header-value) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@40 Create a nov from the current headers. (defalias 'nnml-make-nov-line #[(chars) "ÀÁ‰‰‰‰‰‰‰‰ \n ŠŒebˆ`ÌÍÁÀ#†)dS}ˆebˆÎÏÁÀ#ƒ@ÐÑÀ‰#ˆ‚/ÒedÓÔ$ˆŠebˆÎÕÁÀ#ƒüÖyˆg—‰×=ƒmÖ•ŠÁˆ`){\n‚ö\nØ=ƒÖ•ŠÁˆ`){ ‚ö\nÙ=ƒ”Ö•ŠÁˆ`){‚ö\nÚ=ƒ§Ö•ŠÁˆ`){‚ö\nÛ=ƒ»Ö•ŠÁˆ`){‚ö\nÜ=ƒÒÖ•ŠÁˆ`){‰‚ö\nÝ=ƒæÖ•ŠÁˆ`){‚ö\nÞ=ƒöÖ•ŠÁˆ`){ßyˆ‚K„ ƒàá \"ƒ Ö”Ö•O)âã\n†ä †#å†)æ†6çèéê ë#P†<æ,†BÖ †Gí\f†Læ& .\f‡" [t nil char in-reply-to xref lines references id date from subject case-fold-search search-forward "\n\n" re-search-forward "\\( ?\n[ ]+\\)+" replace-match " " subst-char-in-region 9 32 "^\\(from\\|subject\\|message-id\\|date\\|lines\\|xref\\|references\\|in-reply-to\\): " 0 115 102 120 108 100 109 114 105 1 string-match "<[^>]+>" format " %s %s %s %s %s %d %s %s \n" "(none)" "(nobody)" "" "nnml-dummy-id-" mapconcat #[(time) "À !‡" [int-to-string time] 2] current-time "-" chars "0"] 11 (#$ . 10781)]) (defalias 'nnml-open-nov #[(group) "À \n\"A†'ÃÄ \"P!ŠqˆÈp!ˆ) B\nB)‡" [assoc group nnml-nov-buffer-alist find-file-noselect nnmail-article-pathname nnml-directory nnml-nov-file-name buffer buffer-disable-undo] 4]) (defalias 'nnml-save-nov #[nil "Š…0Á@A!ƒ(@AqˆÂ ƒ ÃÄdÅ ÆÇ%ˆÈÆ!ˆÉp!ˆA‰„Æ)‡" [nnml-nov-buffer-alist buffer-name buffer-modified-p write-region 1 buffer-file-name nil nomesg set-buffer-modified-p kill-buffer] 7]) #@53 Generate nov databases in all nnml mail newsgroups. (defalias 'nnml-generate-nov-databases #[(dir) "À †Â!ˆÃ\fÅÆÅ$‰ƒ=ÈÉ@\"„4ÈÊ@\"„4Ë@!ƒ4Ì@!ˆA‰„)ÍÎÏÃ\fÆÐÅ$\"Ñ\"\fÒQÔÕ!Ɖ‰ƒÛÜ\f!Ü!GÆOÞß#@‰ Aƒ… A‰ ‚x @)BD!B!ƒŠ\"qˆã!ƒ¦ä!ˆŠqˆåp!ˆæ ˆ)ƒæ ˆç\fÒè@!Q!ˆebˆéŠêëÆÅ#ˆd`Z`)}ˆìU„úí!Šqˆdbˆè@!±ˆ)~ˆA‰„¸ŠqˆîédÜ!Æï%ˆðp!ˆ*ñ!2\"-‡" [nnml-open-server nnml-current-server "" directory-files dir t nil dirs string-match "/\\.\\.$" "/\\.$" file-directory-p nnml-generate-nov-databases sort mapcar #[(name) "À !‡" [string-to-int name] 2] "^[0-9]+$" < "/" nnml-nov-file-name get-buffer-create "*nov*" chars nov-line nov-buffer nov files nnmail-replace-chars-in-string expand-file-name nnml-directory 47 46 f nnml-group-alist nntp-server-buffer file-exists-p delete-file buffer-disable-undo erase-buffer insert-file-contents int-to-string 1 search-forward "\n\n" 0 nnml-make-nov-line write-region nomesg kill-buffer nnmail-save-active nnml-active-file] 9 (#$ . 12171) (byte-code "À\nC‡" [nil nnml-group-alist nnml-directory] 1)]) (defalias 'nnml-nov-delete-article #[(group article) "ŠÀ !qˆebˆÂÃÄ !ÆQÇÈ#ƒÉ”Êyˆ`|ˆ)ȇ" [nnml-open-nov group re-search-forward "^" int-to-string article " " nil t 0 1] 4]) (provide (quote nnml)) emacs-19.30/lisp/nnspool.elc100666 23053 1 25273 6046561760 14615 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 05:07:17 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/nnspool.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nnspool.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!‡" [require nnheader nntp timezone] 2) #@67 Program to post news. This is most commonly `inews' or `injnews'. (defvar nnspool-inews-program news-inews-program (#$ . 541)) #@142 Switches for nnspool-request-post to pass to `inews' for posting news. If you are using Cnews, you probably should set this variable to nil. (defvar nnspool-inews-switches (quote ("-h")) (#$ . 675)) #@29 Local news spool directory. (defvar nnspool-spool-directory news-path (#$ . 880)) #@27 Local news nov directory. (defvar nnspool-nov-directory (concat nnspool-spool-directory "over.view/") (#$ . 968)) #@48 Where the local news library files are stored. (defvar nnspool-lib-dir "/usr/lib/news/" (#$ . 1088)) #@25 Local news active file. (defvar nnspool-active-file (concat nnspool-lib-dir "active") (#$ . 1195)) #@29 Local news newsgroups file. (defvar nnspool-newsgroups-file (concat nnspool-lib-dir "newsgroups") (#$ . 1300)) #@32 Local news distributions file. (defvar nnspool-distributions-file (concat nnspool-lib-dir "distributions") (#$ . 1417)) #@26 Local news history file. (defvar nnspool-history-file (concat nnspool-lib-dir "history") (#$ . 1543)) #@30 Local news active date file. (defvar nnspool-active-times-file (concat nnspool-lib-dir "active.times") (#$ . 1651)) #@183 The number of the articles which indicates a large newsgroup. If the number of the articles is greater than the value, verbose messages will be shown to indicate the current status. (defvar nnspool-large-newsgroup 50 (#$ . 1774)) #@76 Non-nil means that nnspool will never return NOV lines instead of headers. (defvar nnspool-nov-is-evil nil (#$ . 2010)) #@151 If non-nil, use sed to get the relevant portion from the overview file. If nil, nnspool will load the entire file into a buffer and process it there. (defconst nnspool-sift-nov-with-sed nil (#$ . 2137)) #@45 Version numbers of this version of NNSPOOL. (defconst nnspool-version "nnspool 2.0" (#$ . 2346)) #@31 Current news group directory. (defvar nnspool-current-directory nil (#$ . 2449)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÂÆ BÀÇ!„.ÂÇ BÀÈ!„sÉ DÊ\nDË DÌ\fDÍ DÎDÏDÐDÑDÒDÓDÔDÕDÖ×دÈ B‡" [boundp nnspool-current-group nil current-load-list nnspool-status-string "" nnspool-current-server nnspool-server-alist nnspool-server-variables nnspool-inews-program nnspool-inews-switches nnspool-spool-directory nnspool-nov-directory nnspool-lib-dir nnspool-active-file nnspool-newsgroups-file nnspool-distributions-file nnspool-history-file nnspool-active-times-file nnspool-large-newsgroup nnspool-nov-is-evil nnspool-sift-nov-with-sed (nnspool-current-directory nil) (nnspool-current-group nil) (nnspool-status-string "")] 16) #@109 Retrieve the headers for the articles in SEQUENCE. Newsgroup must be selected before calling this function. (defalias 'nnspool-retrieve-headers #[(sequence &optional newsgroup server) "ŠqˆÁ ˆ\nGħ… VÈ È\nÈ Ì !…Æ\n@§ƒ8Î\n!ƒ8Ï‚Æ\nƒ¨\n@‰ ;ƒQÐ ! Ä ‚ZÒ !P  ƒ‰Ó !ƒ‰ÔÕ \"cˆ`\nÖ !ˆ\nbˆ×ØÈÙ#ˆÚuˆÛcˆ`d|ˆ\nAƒ8 T‰ܦÄUƒ8ÝÞ ß_ ¥\"ˆ‚8ƒ±Ýà!ˆebˆáâÈÙ#ƒÅãäÙ‰#ˆ‚´å.‡" [nntp-server-buffer erase-buffer sequence number 0 count nnspool-large-newsgroup do-message nil file beg article nnspool-possibly-change-directory newsgroup nnspool-retrieve-headers-with-nov nov nnspool-find-article-by-message-id nnspool-current-directory int-to-string file-exists-p format "221 %d Article retrieved.\n" nnheader-insert-head search-forward "\n\n" t -1 ".\n" 20 message "NNSPOOL: Receiving headers... %d%%" 100 "NNSPOOL: Receiving headers...done" re-search-forward "\\( ?\n[ ]+\\)+" replace-match " " headers] 5 (#$ . 3207)]) (defalias 'nnspool-open-server #[(server &optional defs) "À ˆ \nšƒ Ç\nƒ\nÄ !DBÇ \"‰ƒ6ÉA@!ˆÊ\"‚<Ë \f\"ˆ) ‰‡" [nnheader-init-server-buffer server nnspool-current-server t nnheader-save-variables nnspool-server-variables nnspool-server-alist assoc state nnheader-restore-variables delq nnheader-set-init-variables defs] 4]) (defalias 'nnspool-close-server #[(&optional server) "À‡" [t] 1]) (defalias 'nnspool-server-opened #[(&optional server) " š… \n… Ã\n!‡" [server nnspool-current-server nntp-server-buffer buffer-name] 2]) #@42 Return server status response as string. (defalias 'nnspool-status-message #[(&optional server) "‡" [nnspool-status-string] 1 (#$ . 4706)]) #@43 Select article by message ID (or number). (defalias 'nnspool-request-article #[(id &optional newsgroup server buffer) "À !ˆ\n;ƒÃ\n!‚\fÅ\n!P†‰;…9É!…9Ê!?…9ŠË!)*‡" [nnspool-possibly-change-directory newsgroup id nnspool-find-article-by-message-id nnspool-current-directory prin1-to-string buffer nntp-server-buffer file file-exists-p file-directory-p nnspool-find-file] 4 (#$ . 4853)]) #@48 Select article body by message ID (or number). (defalias 'nnspool-request-body #[(id &optional newsgroup server) "À !ˆÂ !…Š\fqˆebˆÅÆÇÈ#ƒe`|ˆ)ȇ" [nnspool-possibly-change-directory newsgroup nnspool-request-article id nntp-server-buffer search-forward "\n\n" nil t] 4 (#$ . 5265)]) #@48 Select article head by message ID (or number). (defalias 'nnspool-request-head #[(id &optional newsgroup server) "À !ˆÂ !… Š\fqˆebˆÅÆÇÈ#ƒ`Sd|ˆ)ȇ" [nnspool-possibly-change-directory newsgroup nnspool-request-article id nntp-server-buffer search-forward "\n\n" nil t] 4 (#$ . 5556)]) #@20 Select news GROUP. (defalias 'nnspool-request-group #[(group &optional server dont-check) "ÀÁ\nÃÄ#!ÅÈ!„É\nÅ‚s Ì\n „rÎÅÏÐ$‰ƒ=ÑÒÓ\"Ô\"ŠqˆÖ ˆƒk×ØG@AƒaA‰‚T@\n%cˆ‚q×Ù\n\"cˆ)Ð*‡" [nnspool-article-pathname nnspool-replace-chars-in-string group 46 47 nil dir pathname file-directory-p "Invalid group name (no such directory)" nnspool-status-string nnspool-current-directory "" dont-check directory-files "^[0-9]+$" t sort mapcar #[(name) "À !‡" [string-to-int name] 2] < nntp-server-buffer erase-buffer format "211 %d %d %d %s\n" "211 0 0 0 %s\n"] 7 (#$ . 5848)]) (defalias 'nnspool-close-group #[(group &optional server) "À‡" [t] 1]) #@25 List active newsgroups. (defalias 'nnspool-request-list #[(&optional server) "ŠÀ !)‡" [nnspool-find-file nnspool-active-file] 2 (#$ . 6526)]) #@37 List newsgroups (defined in NNTP2). (defalias 'nnspool-request-list-newsgroups #[(&optional server) "ŠÀ !)‡" [nnspool-find-file nnspool-newsgroups-file] 2 (#$ . 6674)]) #@40 List distributions (defined in NNTP2). (defalias 'nnspool-request-list-distributions #[(&optional server) "ŠÀ !)‡" [nnspool-find-file nnspool-distributions-file] 2 (#$ . 6849)]) #@33 List groups created after DATE. (defalias 'nnspool-request-newgroups #[(date &optional server) "À !…jŠdbˆÂÃ!„ÄyÅU„\nÆ!È \nÂË!ƒPÅ•SbˆÌcˆÍ•bˆÎp!\nVƒP͔͕{ B‰ ƒPÄyÅU„ Ï ˆ ƒh @бˆ A‰ „X+ч" [nnspool-find-file nnspool-active-times-file looking-at "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] " -1 0 nnspool-seconds-since-epoch date nil groups seconds "\\([^ ]+\\) +[0-9]+ " ".0" 1 read erase-buffer " 0 0 y\n" t] 3 (#$ . 7033)]) #@36 Post a new news in current buffer. (defalias 'nnspool-request-post #[(&optional server) "ŠÀÂÃ!ÅÆÇ\f %\nË\nÌ\"ˆÍ\ned#ˆÀÎψ,Ї" [nil process-connection-type generate-new-buffer " *nnspool post*" inews-buffer apply start-process "*nnspool inews*" nnspool-inews-program nnspool-inews-switches proc set-process-sentinel nnspool-inews-sentinel process-send-region (process-send-eof proc) ((error)) t] 6 (#$ . 7482)]) (defalias 'nnspool-inews-sentinel #[(proc status) "ŠÀ !qˆebˆÂ ÃU„ÄÅÆÇ#ƒÈp!‚/ÉedÊËÌ%ˆÍ ÏÐ\")‡" [process-buffer proc buffer-size 0 search-forward "spooled" nil t kill-buffer subst-char-in-region 10 92 noundo buffer-string nnspool-status-string message "nnspool: %s"] 6]) (defalias (quote nnspool-request-post-buffer) (quote nntp-request-post-buffer)) (defalias 'nnspool-retrieve-headers-with-nov #[(articles) "† ?…°Â !Ä ÆÇ#ÈQÉ\n Ì !…¯Š qˆÎ ˆƒ5Ï \"‚®Ñ !ˆƒgÒ@!ÓP‰\nƒgÔ\n!„gÕÖ\nPÉ×#„gA‰„?ƒ¥Øyˆe`|ˆÙ!dbˆƒ™ÚÖÒ@!ÓQÉ×#„™A‰„ƒ¥Ûyˆ`d|ˆ†®Î ˆÉ)*‡" [gnus-nov-is-evil nnspool-nov-is-evil file-name-as-directory nnspool-nov-directory nnspool-replace-chars-in-string nnspool-current-group 46 47 "/.overview" nil article nov file-exists-p nntp-server-buffer erase-buffer nnspool-sift-nov-with-sed articles insert-file-contents int-to-string " " looking-at search-forward "\n" t 0 reverse search-backward 2] 6]) (defalias 'nnspool-sift-nov-with-sed #[(articles file) "@AƒA‰‚@ÃÄÅÆÅÇÈ\nS T# &*‡" [articles last first call-process "awk" nil t format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}" file] 10]) #@62 Return full pathname of an article identified by message-ID. (defalias 'nnspool-find-article-by-message-id #[(id) "ŠÀÁ!‰qˆÃ ˆÄÅÆÇÆ &ˆebˆÊË!…,\fÍΔΕ{ÏÐ#P*‡" [get-buffer-create " *nnspool work*" buf erase-buffer call-process "grep" nil t id nnspool-history-file looking-at "<[^>]+>[ ]+[-0-9~]+[ ]+\\([^ \n]*\\)" nnspool-spool-directory nnspool-replace-chars-in-string 1 46 47] 8 (#$ . 9104)]) #@38 Insert FILE in server buffer safely. (defalias 'nnspool-find-file #[(file) "qˆÁ ˆÂÃć" [nntp-server-buffer erase-buffer nil (byte-code "À !ˆÂ‡" [insert-file-contents file t] 2) ((file-error))] 3 (#$ . 9512)]) (defalias 'nnspool-possibly-change-directory #[(newsgroup) "ƒ%ÁÂÃÄ#!Æ !ƒ ‰‚#ÉÊ\" Ì)‡Í‡" [newsgroup nnspool-article-pathname nnspool-replace-chars-in-string 46 47 pathname file-directory-p nnspool-current-directory nnspool-current-group format "No such newsgroup: %s" nnspool-status-string nil t] 5]) #@26 Make pathname for GROUP. (defalias 'nnspool-article-pathname #[(group) "À !\nÃQ‡" [file-name-as-directory nnspool-spool-directory group "/"] 3 (#$ . 10043)]) #@47 Replace characters in STRING from FROM to TO. (defalias 'nnspool-replace-chars-in-string #[(string from to) "ÁÂOGÁ \fWƒ% H Uƒ Iˆ T‰‚ +‡" [string 0 nil idx len from to] 4 (#$ . 10207)]) (defalias 'nnspool-number-base-10 #[(num pos) "ÁXƒ‡ ‰@ĦÅ_ A\\¡ˆÆÇÈÉÊ AĦH! ‰AÄ¥¡ˆ ‰@Ä¥ ˆË S\"D!\"‡" [pos 0 "" num 10 65536 apply concat reverse char-to-string "0123456789" nnspool-number-base-10] 7]) (defalias 'nnspool-seconds-since-epoch #[(date) "ÀÁ !\"ÀÅÆ !ÇH!\"ÉÊ8A@@Ê\f8\fA@\f@Ë\f8&‰\f@Í_\fA@\\+‡" [mapcar #[(ti) "…Á!‡" [ti string-to-int] 2] timezone-parse-date date tdate #[(ti) "…Á!‡" [ti string-to-int] 2] timezone-parse-time 3 ttime encode-time 2 4 unix 65536.0] 10]) (provide (quote nnspool)) emacs-19.30/lisp/nntp.elc100666 23053 1 64563 6054022155 14076 0ustar larsidaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 20 01:46:34 1995 ;;; from file /home/fsf/rms/e19/lisp/nntp.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nntp.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÄÅÆ\"ˆÄÇÆ\"ˆÄÈÉ\"ˆÄÊË\"ˆÄÌÍÎÏ$ˆÄÐÍÎÏ$ˆÄÑÒ\"‡" [require rnews sendmail nnheader autoload news-setup "rnewspost" news-reply-mode nnmail-request-post-buffer "nnmail" cancel-timer "timer" telnet "telnet" nil t telnet-send-input timezone-parse-date "timezone"] 5) #@491 *Hooks for the NNTP server. If the kanji code of the NNTP server is different from the local kanji code, the correct kanji code of the buffer associated with the NNTP server must be specified as follows: (setq nntp-server-hook (function (lambda () ;; Server's Kanji code is EUC (NEmacs hack). (make-local-variable 'kanji-fileio-code) (setq kanji-fileio-code 0)))) If you'd like to change something depending on the server in this hook, use the variable `nntp-address'. (defvar nntp-server-hook nil (#$ . -750)) #@383 *Hook used for sending commands to the server at startup. The default value is `nntp-send-mode-reader', which makes an innd server spawn an nnrpd server. Another useful function to put in this hook might be `nntp-send-authinfo', which will prompt for a password to allow posting from the server. Note that this is only necessary to do on servers that use strict access control. (defvar nntp-server-opened-hook nil (#$ . -1289)) (add-hook (quote nntp-server-opened-hook) (quote nntp-send-mode-reader)) #@438 *Function used for connecting to a remote system. It will be called with the address of the remote system. Two pre-made functions are `nntp-open-network-stream', which is the default, and simply connects to some port or other on the remote system (see nntp-port-number). The other is `nntp-open-rlogin', which does an rlogin on the remote system, and then does a telnet to the NNTP server available there (see nntp-rlogin-parameters). (defvar nntp-open-server-function (quote nntp-open-network-stream) (#$ . -1801)) #@167 *Parameters to `nntp-open-login'. That function may be used as `nntp-open-server-function'. In that case, this list will be used as the parameter list given to rsh. (defvar nntp-rlogin-parameters (quote ("telnet" "${NNTPSERVER:=localhost}" "nntp")) (#$ . -2326)) #@67 *User name on remote system when using the rlogin connect method. (defvar nntp-rlogin-user-name nil (#$ . -2596)) #@31 *The name of the NNTP server. (defvar nntp-address nil (#$ . -2716)) #@29 *Port number to connect to. (defvar nntp-port-number "nntp" (#$ . -2791)) #@184 *The number of the articles which indicates a large newsgroup. If the number of the articles is greater than the value, verbose messages will be shown to indicate the current status. (defvar nntp-large-newsgroup 50 (#$ . -2872)) #@263 *t if your select routine is buggy. If the select routine signals error or fall into infinite loop while waiting for the server response, the variable must be set to t. In case of Fujitsu UTS, it is set to T since `accept-process-output' doesn't work properly. (defvar nntp-buggy-select (memq system-type (quote (fujitsu-uts))) (#$ . -3108)) #@153 *The maximum number of the requests sent to the NNTP server at one time. If Emacs hangs up while retrieving headers, set the variable to a lower value. (defvar nntp-maximum-request 400 (#$ . -3458)) #@131 *Display '...' every 10Kbytes of a message being received if it is non-nil. If it is a number, dots are displayed per the number. (defvar nntp-debug-read 10000 (#$ . -3664)) #@79 *If non-nil, nntp will never attempt to use XOVER when talking to the server. (defvar nntp-nov-is-evil nil (#$ . -3844)) #@225 *List of strings that are used as commands to fetch NOV lines from a server. The strings are tried in turn until a positive response is gotten. If none of the commands are successful, nntp will just grab headers one by one. (defvar nntp-xover-commands (quote ("XOVER" "XOVERVIEW")) (#$ . -3972)) #@161 *Maximum allowed gap between two articles. If the gap between two consecutive articles is bigger than this variable, split the XOVER request into two requests. (defvar nntp-nov-gap 20 (#$ . -4275)) #@131 *Number of seconds to wait before an nntp connection times out. If this variable is nil, which is the default, no timers are set. (defvar nntp-connection-timeout nil (#$ . -4480)) #@65 *If non-nil, override `mail-default-headers' when posting news. (defvar nntp-news-default-headers nil (#$ . -4666)) #@347 *Hook run before a server is opened. If can be used to set up a server remotely, for instance. Say you have an account at the machine "other.machine". This machine has access to an NNTP server that you can't access locally. You could then use this hook to rsh to the remote machine and start a proxy NNTP server there that you can connect to. (defvar nntp-prepare-server-hook nil (#$ . -4789)) #@68 *How many articles should be prefetched when in asynchronous mode. (defvar nntp-async-number 5 (#$ . -5192)) #@42 Version numbers of this version of NNTP. (defconst nntp-version "nntp 4.0" (#$ . 5307)) #@49 Buffer associated with the NNTP server process. (defvar nntp-server-buffer nil (#$ . 5401)) #@126 The NNTP server process. You'd better not use this variable in NNTP front-end program, but instead use `nntp-server-buffer'. (defvar nntp-server-process nil (#$ . 5500)) #@167 Save the server response message. You'd better not use this variable in NNTP front-end program but instead call function `nntp-status-message' to get status message. (defvar nntp-status-string nil (#$ . 5677)) #@36 All (possibly) opened connections. (defvar nntp-opened-connections nil (#$ . 5893)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÆÅ BÀÇ!„-ÈÇ BÀÉ!„:È É BÀÊ!„GÈ\nÊ BÀË!„TÈ Ë BÀÌ!„aÈ\fÌ BÀÍ!„nÈ Í BÀÎ!„{ÈÎ BÀÏ!„ˆÈÏ BÀÐ!„ØÑDÒDÓDÔDÕDÖD×DØDÙDÚDÛDÜDÝDÞDßàáâãäåæçè¯Ð Bȇ" [boundp nntp-server-xover try current-load-list nntp-server-list-active-group nntp-current-group "" nntp-timeout-servers nil nntp-async-process nntp-async-buffer nntp-async-articles nntp-async-fetched nntp-async-group-alist nntp-current-server nntp-server-alist nntp-server-variables nntp-server-hook nntp-server-opened-hook nntp-port-number nntp-address nntp-large-newsgroup nntp-buggy-select nntp-maximum-request nntp-debug-read nntp-nov-is-evil nntp-xover-commands nntp-connection-timeout nntp-news-default-headers nntp-prepare-server-hook nntp-async-number (nntp-async-process nil) (nntp-async-buffer nil) (nntp-async-articles nil) (nntp-async-fetched nil) (nntp-async-group-alist nil) (nntp-server-process nil) (nntp-status-string nil) (nntp-server-xover try) (nntp-server-list-active-group try) (nntp-current-group "")] 24) #@51 Retrieve the headers to the articles in SEQUENCE. (defalias 'nntp-retrieve-headers #[(sequence &optional newsgroup server) "À \n\"ˆŠ qˆÄ ˆ „ „ Ç!ƒ É‚Gʉe \f ƒ¬ÏÐ@§ƒDÑ@!‚G@\"ˆA T ƒb ¦ÊUƒ.Ó ˆ bˆÔÕÖ×#ƒy\fT\f‚i` \f Wƒ.§ƒ¦Vƒ¦\fÙ¦ÊUƒ¦ÚÛ\fÜ_¥\"ˆÓ ˆ‚edbˆÝÕÖ×#ˆÞß!ƒÌdàZbˆÞá!„ÌÓ ˆ‚»§ƒÞVƒÞÚâ!ˆ\febˆÔãÖ×#ƒôäå!ˆ‚åebˆæçÖ×#ƒäè!ˆ‚÷,é)‡" [nntp-possibly-change-server newsgroup server nntp-server-buffer erase-buffer gnus-nov-is-evil nntp-nov-is-evil nntp-retrieve-headers-with-xover sequence nov 0 last-point received count number nntp-send-strings-to-server "HEAD" int-to-string nntp-maximum-request nntp-accept-response re-search-forward "^[0-9]" nil t nntp-large-newsgroup 20 message "NNTP: Receiving headers... %d%%" 100 re-search-backward looking-at "^[23]" 3 "^\\. ?\n" "NNTP: Receiving headers...done" "\\( ?\n[ ]+\\)+" replace-match " " search-forward " " "" headers] 4 (#$ . 7051)]) (defalias 'nntp-retrieve-groups #[(groups &optional server) "ÀÁ\n\"ˆŠ qˆ\fÅ=ƒÆ@!ˆÈ ˆÉ‰e\fƒ#Ê‚$Ë\f ƒzÐ\f@\"ˆATƒR¦ÉUƒ,Ò ˆ bˆÓÔÁÕ#ƒiT‚Y` Wƒ,Ò ˆ‚U\fƒždbˆÖÔÁÕ#ˆ×Ø!ƒždÙZbˆ×Ú!„žÒ ˆ‚ebˆÛÜÁÕ#ƒ²ÝÞÕ‰#ˆ‚¡\fƒÐebˆÓßÁÕ#ƒÌÉ”àyˆ`|ˆ‚¹á‚Ñâ-‡" [nntp-possibly-change-server nil server nntp-server-buffer nntp-server-list-active-group try nntp-try-list-active groups erase-buffer 0 "LIST ACTIVE" "GROUP" command last-point received count nntp-send-strings-to-server nntp-maximum-request nntp-accept-response re-search-forward "^[0-9]" t re-search-backward looking-at "^[23]" 3 "^\\. ?\n" search-forward " " replace-match "" "^[.2-5]" 1 active group] 4]) #@113 Open the virtual server SERVER. If CONNECTIONLESS is non-nil, don't attempt to connect to any physical servers. (defalias 'nntp-open-server #[(server &optional defs connectionless) "À ˆÁ\n!ƒ Ç\f@;„\f@§ƒÅ\f@D\fABÆ\fž„-Ç\fÆ\nDC\"ƒE\nš„EÉ\n!D B Ì\n \"‰ ƒbÎ A@!ˆÏ  \" ‚hÐ\n\f\"ˆ)\nÁ\n!†t?…Š?…ŠÓÔ!ˆÕ \"‡" [nnheader-init-server-buffer nntp-server-opened server t defs nntp-port-number nntp-address append nntp-current-server nnheader-save-variables nntp-server-variables nntp-server-alist assoc state nnheader-restore-variables delq nnheader-set-init-variables connectionless nntp-timeout-servers run-hooks nntp-prepare-server-hook nntp-open-server-semi-internal] 5 (#$ . 8707)]) #@29 Close connection to SERVER. (defalias 'nntp-close-server #[(&optional server) "ÀÁ\nÃ#ˆÄŽ ƒÆÇ !=ƒÈ Á\"ˆÉ …\"ÊÁË\")‡" [nntp-possibly-change-server nil server t ((byte-code "À !ˆÂ \"À‡" [nntp-close-server-internal server delete nntp-timeout-servers] 3)) nntp-server-process nntp-default-sentinel process-sentinel set-process-sentinel nntp-server-opened nntp-send-command "QUIT"] 4 (#$ . 9430)]) (byte-code "ÀÁÂK\"‡" [defalias nntp-request-quit nntp-close-server] 3) #@31 Close all server connections. (defalias 'nntp-request-close #[nil "À\nƒ\n‰A@‰ƒà !ˆ‚\fƒ%Å\f!ƒ%Æ\f!ˆƒIÄ@žA@‰ƒ@È !ƒ@Æ !ˆA‰„*À À\nÀ‰ )‡" [nil proc nntp-opened-connections delete-process nntp-async-buffer get-buffer kill-buffer nntp-server-alist buffer-name nntp-current-server nntp-timeout-servers nntp-async-group-alist] 3 (#$ . 9906)]) #@53 Say whether a connection to SERVER has been opened. (defalias 'nntp-server-opened #[(&optional server) " š…\n…Ã\n!…\f…Å\f!Æ>‡" [server nntp-current-server nntp-server-buffer buffer-name nntp-server-process process-status (open run)] 2 (#$ . 10273)]) #@35 Return server status as a string. (defalias 'nntp-status-message #[(&optional server) "ƒÁÂ\"ƒÔÕO‡†ć" [nntp-status-string string-match "[0-9][0-9][0-9][ ]+\\([^ ]*\\).*$" 1 ""] 3 (#$ . 10538)]) #@44 Request article ID (message-id or number). (defalias 'nntp-request-article #[(id &optional newsgroup server buffer) "À \n\"ˆÃ §ƒŽƒŽ >ƒŽŠqˆ` §ƒ)É !‚* É\n \f ÎÏ\fPÃÐ#„NebˆÎÏ\fP Ð#ƒÑyˆ` ÎÒÃÐ#‰\nƒÐŠ†iqˆÕ ˆÖ \n#ˆp× ˆ* \n|ˆƒØ !ˆ-\fƒ–ЂÎÙŽƒ¤Ú\"ˆ†« §ƒ¶É !†· \fÜÒÝ\f#× ˆƒÍØ !ˆ+)‡" [nntp-possibly-change-server newsgroup server nil found id nntp-async-articles nntp-async-fetched nntp-async-buffer int-to-string end beg art opoint re-search-forward "^2.. +" t 0 "^\\. ?\n" buffer nntp-server-buffer erase-buffer insert-buffer-substring nntp-decode-text nntp-async-fetch-articles ((byte-code "ƒ Á\n \"ˆÁ‡" [buffer set-process-buffer nntp-server-process nntp-server-buffer] 3)) set-process-buffer nntp-server-process nntp-send-command "ARTICLE"] 4 (#$ . 10751)]) #@52 Request body of article ID (message-id or number). (defalias 'nntp-request-body #[(id &optional newsgroup server) "À \n\"ˆÃÄŧƒÇ!†#È ˆ‡" [nntp-possibly-change-server newsgroup server nntp-send-command "^\\. ?\n" "BODY" id int-to-string nntp-decode-text] 5 (#$ . 11578)]) #@52 Request head of article ID (message-id or number). (defalias 'nntp-request-head #[(id &optional newsgroup server) "À \n\"ˆÃÄŧƒÇ!†#È ˆ‡" [nntp-possibly-change-server newsgroup server nntp-send-command "^\\. ?\n" "HEAD" id int-to-string nntp-decode-text] 5 (#$ . 11865)]) #@52 Request STAT of article ID (message-id or number). (defalias 'nntp-request-stat #[(id &optional newsgroup server) "À \n\"ˆÃÄŧƒÇ!†#‡" [nntp-possibly-change-server newsgroup server nntp-send-command "^[23].* ?\n" "STAT" id int-to-string] 5 (#$ . 12152)]) #@15 Select GROUP. (defalias 'nntp-request-group #[(group &optional server dont-check) "ÀÁ #ˆ Š qˆebˆÆÇ!)‡" [nntp-send-command "^.* ?\n" "GROUP" group nntp-current-group nntp-server-buffer looking-at "[23]"] 4 (#$ . 12422)]) (defalias 'nntp-request-asynchronous #[(group &optional server articles) "ƒÁ\n!ˆ …:Ä „%Å „%ÆÇ\"ˆÉ ˆÊËÌ!‡ ÊŠqˆÐ ˆ)ÑÒ\n\"ˆÓ‡" [nntp-async-articles nntp-async-request-group group nntp-async-number nntp-async-server-opened nntp-async-open-server message "Can't open second connection to %s" nntp-address ding nil sit-for 2 articles nntp-async-fetched nntp-async-buffer erase-buffer nntp-async-send-strings "GROUP" t] 3]) (defalias 'nntp-list-active-group #[(group &optional server) "ÀÁ #‡" [nntp-send-command "^.* ?\n" "LIST ACTIVE" group] 4]) #@27 Get description of GROUP. (defalias 'nntp-request-group-description #[(group &optional server) "ÀÁ\n\"ˆÃÄÅ#Ç ˆ‡" [nntp-possibly-change-server nil server nntp-send-command "^.* ?\n" "XGTITLE" group nntp-decode-text] 4 (#$ . 13206)]) (defalias 'nntp-close-group #[(group &optional server) "À‡" [nil nntp-current-group t] 1]) #@21 List active groups. (defalias 'nntp-request-list #[(&optional server) "ÀÁ\n\"ˆÃÄÅ\"Æ ˆ‡" [nntp-possibly-change-server nil server nntp-send-command "^\\. ?\n" "LIST" nntp-decode-text] 3 (#$ . 13539)]) #@14 List groups. (defalias 'nntp-request-list-newsgroups #[(&optional server) "ÀÁ\n\"ˆÃÄÅ\"Æ ˆ‡" [nntp-possibly-change-server nil server nntp-send-command "^\\. ?\n" "LIST NEWSGROUPS" nntp-decode-text] 3 (#$ . 13745)]) #@18 List new groups. (defalias 'nntp-request-newgroups #[(date &optional server) "ÀÁ\n\"ˆÃ\f!ÅÆ\fÇHÈÁOÉ\fÊH!É\fÈH!\fËHÇÈO\fËHËÌO\fËHÍÎO&ÐÑÒ#Ó ˆ*‡" [nntp-possibly-change-server nil server timezone-parse-date date format "%s%02d%02d %s%s%s" 0 2 string-to-int 1 3 5 6 8 time-string nntp-send-command "^\\. ?\n" "NEWGROUPS" nntp-decode-text] 10 (#$ . 13966)]) #@21 List distributions. (defalias 'nntp-request-list-distributions #[(&optional server) "ÀÁ\n\"ˆÃÄÅ\"Æ ˆ‡" [nntp-possibly-change-server nil server nntp-send-command "^\\. ?\n" "LIST DISTRIBUTIONS" nntp-decode-text] 3 (#$ . 14330)]) #@39 Decrease the current article pointer. (defalias 'nntp-request-last #[(&optional newsgroup server) "À \n\"ˆÃÄÅ\"‡" [nntp-possibly-change-server newsgroup server nntp-send-command "^[23].* ?\n" "LAST"] 3 (#$ . 14564)]) #@38 Advance the current article pointer. (defalias 'nntp-request-next #[(&optional newsgroup server) "À \n\"ˆÃÄÅ\"‡" [nntp-possibly-change-server newsgroup server nntp-send-command "^[23].* ?\n" "NEXT"] 3 (#$ . 14787)]) #@26 Post the current buffer. (defalias 'nntp-request-post #[(&optional server) "ÀÁ\n\"ˆÃÄÅ\"…Æ ˆÇed\"ˆÈÉ!‡" [nntp-possibly-change-server nil server nntp-send-command "^[23].* ?\n" "POST" nntp-encode-text nntp-send-region-to-server nntp-wait-for-response "^[23].*\n"] 3 (#$ . 15009)]) #@433 Request a buffer suitable for composing an article. If POST, this is an original article; otherwise it's a followup. GROUP is the group to be posted to, the article should have subject SUBJECT. HEADER is a Gnus header vector. ARTICLE-BUFFER contains the article being followed up. INFO is a Gnus info list. If FOLLOW-TO, post to this group instead. If RESPECT-POSTER, heed the special "poster" value of the Followup-to header. (defalias 'nntp-request-post-buffer #[(post group subject header article-buffer info follow-to respect-poster) "ÀÁ\n8žƒÃ\f \n \n&‡ † \f͉‰‰‰‰‰‰‰\fŠ×Ø!qˆÙ ˆÚ ƒXÛ ÜVƒXÝÞ!ƒ‚ß ˆ\fƒkàÍÍ Í%ˆ‚‚Šqˆebˆeáâ!ˆ`}ˆãHäHƒ©åæ\"‰'ƒ Ü'O‚¢èQ)†²éHåê\"„ÂëPìí!\nƒððð\nð=ƒóƒóÝñòQ!„óÍ ††ìó!ÁHìô!‰;ƒåõ\"ƒÍöH~ˆ)78à;ƒ@‚Aî%ˆƒn<ƒnebˆƒn@@ù@Aú±ˆA‰„Xû\"ˆƒ‚üý!ˆcˆp. ‡" [to-address 5 info nnmail-request-post-buffer post group subject header article-buffer follow-to respect-poster nntp-news-default-headers mail-default-headers nil message-id distribution references message-of newsgroups followup-to to date from get-buffer-create "*post-news*" news-reply-mode buffer-modified-p buffer-size 0 y-or-n-p "Unsent article being composed; erase it? " erase-buffer news-setup search-forward "\n\n" 2 3 string-match " *at \\| *@ \\| *(\\| *<" stop-pos "'s message of " 1 "^[Rr][Ee]:" "Re: " mail-fetch-field "followup-to" "" "poster" ask "Followup to " "? " "newsgroups" "distribution" "world" 4 news-reply-yank-from news-reply-yank-message-id ": " "\n" nnheader-insert-references mail-position-on-field "Distribution"] 11 (#$ . 15298)]) #@203 Send the MODE READER command to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will make innd servers spawn an nnrpd process to allow actual article reading. (defalias 'nntp-send-mode-reader #[nil "ÀÁÂ\"‡" [nntp-send-command "^.* ?\n" "MODE READER"] 3 (#$ . 17019)]) #@141 Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password. (defalias 'nntp-send-authinfo #[nil "ÀÁÂà #ˆÀÁÄÅÆ!#‡" [nntp-send-command "^.* ?\n" "AUTHINFO USER" user-login-name "AUTHINFO PASS" read-string "NNTP password: "] 5 (#$ . 17337)]) #@141 Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password. (defalias 'nntp-send-authinfo-from-file #[nil "ÀÁ!…)ŠÂÃ!qˆÄÁ!ˆebˆÅÆÇÈ #ˆÅÆÉ`ʈ`{#ˆËp!)‡" [file-exists-p "~/.nntp-authinfo" get-buffer-create " *tull*" insert-file-contents nntp-send-command "^.* ?\n" "AUTHINFO USER" user-login-name "AUTHINFO PASS" nil kill-buffer] 5 (#$ . 17663)]) #@52 Default sentinel function for NNTP server process. (defalias 'nntp-default-sentinel #[(proc status) "Á\f šƒ‚* ƒ&\fÅ @žA@š„& A‰„ @@\n…5ÇÈ\n\"ˆÉ *‡" [nntp-server-alist nil server servers proc nntp-server-process nntp-address message "nntp: Connection closed to server %s" ding] 4 (#$ . 18093)]) (defalias 'nntp-kill-connection #[(server) "ÀÁ\n \"žA@‰ƒÅÆ\f!!ˆÇ\n!ˆ\nBÉÊ\n\" Ì ˆÍÎ!)‡" [nntp-server-process assoc server nntp-server-alist proc delete-process process-name nntp-close-server nntp-timeout-servers message "Connection timed out to server %s." nntp-status-string ding sit-for 1] 5]) #@175 Decode text transmitted by NNTP. 0. Delete status line. 1. Delete `^M' at end of line. 2. Delete `.' at end of buffer (end of text mark). 3. Delete `.' at beginning of line. (defalias 'nntp-decode-text #[nil "Šqˆdbˆn„Ácˆebˆ`Âyˆ`|ˆm„/ÈhÄUƒ)ÅÆ!ˆÂyˆ‚dbˆÆyˆÇÈ!ƒB`Âyˆ`|ˆebˆÉÊÃË#…TÅÆ!ˆ‚E)‡" [nntp-server-buffer "\n" 1 nil 13 delete-char -1 looking-at "^\\.\n" search-forward "\n.." t] 4 (#$ . 18713)]) #@141 Encode text in current buffer for NNTP transmission. 1. Insert `.' at beginning of line. 2. Insert `.' at end of buffer (end of text mark). (defalias 'nntp-encode-text #[nil "Šdbˆn„ ÀcˆebˆÁÂÃÄ#ƒÅcˆ‚dbˆÆc)‡" ["\n" search-forward "\n." nil t "." ". \n"] 4 (#$ . 19128)]) #@73 Wait for server RESPONSE after sending CMD and optional ARGS to server. (defalias 'nntp-send-command #[(response cmd &rest args) "ŠqˆÁ ˆÂÃ\f #ˆƒÇ!‚È)‡" [nntp-server-buffer erase-buffer apply nntp-send-strings-to-server cmd args response nntp-wait-for-response t] 4 (#$ . 19408)]) #@48 Wait for server response which matches REGEXP. (defalias 'nntp-wait-for-response #[(regexp &optional slow) "ŠÀ‰Á\n§ƒ \n‚ÃqˆÉ ˆƒ|ebˆ\nƒYËÌÍÀ#ƒ6Í‚JËÎÍÀ#ƒGÍÍ‚JÉ ˆ„eÁyˆ`|ˆ‚ÏÐ!ƒf͉‚ÏÑ!ƒvÍ͉‚É ˆ‚͈e`{…×ÀƒÈdbˆÓyˆÏ!ƒ¥Í‰‚Ž\nƒÂÕ \f¥ U„Á×ØÙ Ú\"\"ˆ)É ˆ‚Œ\nƒÖ ÁVƒÖ×Û!ˆÀ-‡" [t 0 nntp-debug-read 10000 dotsize dotnum wait status nntp-server-buffer nntp-accept-response slow re-search-forward "^[23][0-9][0-9]" nil "^[45][0-9][0-9]" looking-at "[23]" "[45]" nntp-status-string -1 regexp buffer-size newnum message "NNTP: Reading %s" make-string 46 ""] 6 (#$ . 19703)]) (defalias 'nntp-retrieve-headers-with-xover #[(sequence) "À ˆ ƒ\n„KÃ\f@Å\f!Æ#ˆebˆÇÈ!ƒ$`Éyˆ`|ˆÊËÌÍ#ƒ5ÎÏ͉#ˆ‚$dbˆÐyˆÇÑ!ƒ`Éyˆ`|ˆ‚\n§ƒÒ‰epÌ ƒÑ\fƒÑ\f@\fAƒ‚\fA@\f@Z\nWƒ‚\fA‰‚lÃ\f@\"ƒ_\fAT\fƒ¡¦ÒUƒ_Ù ˆqˆbˆÚÛÌÍ#ƒ¼T‚¬`Wƒ_Ù ˆqˆ‚¨ ƒdbˆÜÛÌÍ#ˆÇÝ!ƒödbˆÐyˆÇÞ!„öß ˆ‚äebˆÊËÌÍ#ƒàÐ!ˆ‚ùebˆáâ!ˆ- ‡" [erase-buffer nntp-server-xover nntp-nov-gap nntp-send-xover-command sequence nntp-last-element wait looking-at "[1-5][0-9][0-9] " 1 search-forward " " nil t replace-match "" -1 "\\." 0 first buf last-point received count nntp-maximum-request accept-process-output re-search-forward "^[0-9][0-9][0-9] " re-search-backward "^[23]" "^\\. ?\n" nntp-accept-response delete-char delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] "] 6]) (defalias 'nntp-send-xover-command #[(beg end &optional wait-for-reply) "ÀÁ\n # ;ƒ!ƒÇÈ \f#‚oÉ \f\"ˆÊ‚o ‰\fƒ\\ Í=ƒ\\ÇÈ\f@\f#ˆŠqˆebˆÏÐ!ƒRÑyˆÏÒ!ƒR\f@)\fA‰\f„) Í=ƒmŠqˆÓ ˆÔ) ))‡" [format "%d-%d" beg end range nntp-server-xover wait-for-reply nntp-send-command "^\\. ?\n" nntp-send-strings-to-server t nntp-xover-commands commands try nntp-server-buffer looking-at "[23]" 1 "[0-9]+ ..." erase-buffer nil] 5]) #@67 Send list of STRINGS to news server as command and its arguments. (defalias 'nntp-send-strings-to-server #[(&rest strings) "ÀÁ\nÃ#ÄPÆ!„È!„ÉÊ !ˆË\f \")‡" [mapconcat identity strings " " " \n" cmd nntp-server-opened nntp-current-server nntp-open-server error nntp-status-message process-send-string nntp-server-process] 4 (#$ . 21544)]) #@64 Send current buffer region (from BEGIN to END) to news server. (defalias 'nntp-send-region-to-server #[(begin end) "ŠÀ \n #ˆ qˆedÄÅŒ\n }ˆ\nbˆm„FŠ `\\^bˆm„0Èuˆ`)É\n`#ˆË ˆbˆ‚+\n |)‡" [copy-to-buffer nntp-server-buffer begin end nil 100 size last 1 process-send-region nntp-server-process accept-process-output] 4 (#$ . 21895)]) #@122 Open SERVER. If SERVER is nil, use value of environment variable `NNTPSERVER'. If SERVICE, this this as the port number. (defalias 'nntp-open-server-semi-internal #[(server &optional service) "†ÁÂ!Ã\f…$ÅÆ!ƒÆ\fÃÇ$‚$ÅÈ!…$ÉÊ! \fŠ qˆÎÐÑ\"ˆƒeÒ\"ƒeÃÕÖ‰\f„S×!ˆƒzÙÚ\"ˆÛÜ!ˆ‚z„oÝ‚zed{B ƒ„ß !ˆÐÎ!ˆ\f„“à Ã!\f,‡" [server getenv "NNTPSERVER" nil nntp-connection-timeout fboundp run-at-time nntp-kill-connection start-itimer eval (start-itimer "nntp-timeout" (lambda nil (nntp-kill-connection server)) nntp-connection-timeout nil) timer status nntp-server-buffer "" nntp-status-string message "nntp: Connecting to server on %s..." nntp-open-server-internal service nntp-address (byte-code "ÀÁÂ\"‡" [nntp-wait-for-response "^[23].* ?\n" slow] 3) ((error) (quit)) nntp-close-server-internal nntp-server-process set-process-sentinel nntp-default-sentinel run-hooks nntp-server-opened-hook "NNTP server is not specified." nntp-timeout-servers cancel-timer nntp-current-server nntp-async-number] 8 (#$ . 22247)]) #@72 Open connection to news server on SERVER by SERVICE (default is nntp). (defalias 'nntp-open-server-internal #[(server &optional service) "ÀŠÂÃ!„ ÄÅ!ˆÆ ˆqˆÀÈɉ…4 \nË !ˆ\f ÎÏ!ˆ B\n*‡" [nil proc fboundp open-network-stream require tcp nnheader-init-server-buffer nntp-server-buffer (funcall nntp-open-server-function server) ((error)) nntp-server-process process-kill-without-query server nntp-address run-hooks nntp-server-hook nntp-opened-connections] 3 (#$ . 23301)]) (defalias 'nntp-open-network-stream #[(server) "ÀÁ\n \f$‡" [open-network-stream "nntpd" nntp-server-buffer server nntp-port-number] 5]) (defalias 'nntp-open-rlogin #[(server) "ÀÁ\nÃ\f$Æ ÇÈ Ê#\"ˆÆ Ë\")‡" [start-process "nntpd" nntp-server-buffer "rsh" server proc process-send-string mapconcat identity nntp-rlogin-parameters " " "\n"] 6]) (defalias 'nntp-telnet-to-machine #[nil "ÀÂÃ!ˆebˆÄÅÀÆ#„ÇÈ!ˆebˆ‚ dbˆÉcˆÊ ˆ`ÄËÀÆ#„8ÇÈ!ˆ bˆ‚&dbˆÌcˆÊ )‡" [nil b telnet "localhost" re-search-forward "^login: *" t sit-for 1 "larsi" telnet-send-input ">" "ls"] 4]) #@34 Close connection to news server. (defalias 'nntp-close-server-internal #[(&optional server) "ÀÁ\n\"ˆ ƒ Ä !ˆÁʼn‡" [nntp-possibly-change-server nil server nntp-server-process delete-process "" nntp-address] 3 (#$ . 24348)]) #@130 Read response of server. It is well-known that the communication speed will be much improved by defining this function as macro. (defalias 'nntp-accept-response #[nil "p ƒ !Ã>„ÄÅÆ \"‚-ƒ)ÈÉ!ˆÊË!ˆÈÌ!‚-ÍÎÏqˆ)‡" [buf nntp-server-process process-status (open run) error "nntp: Process connection closed; %s" nntp-status-message nntp-buggy-select message "NNTP: Reading..." sleep-for 1 "" errorcode (accept-process-output nntp-server-process) ((error (byte-code "A@Á˜ƒ\n‡Ã@A\"‡" [errorcode "select error: Invalid argument" nil signal] 3)))] 3 (#$ . 24581)]) #@30 Return last element of LIST. (defalias 'nntp-last-element #[(list) "Aƒ\fA‰‚@‡" [list] 2 (#$ . 25157)]) #@50 Check whether the virtual server needs changing. (defalias 'nntp-possibly-change-server #[(newsgroup server &optional connectionless) "ƒÁ!„ÂÃÄ#ˆ … š?… Ç \"‡" [server nntp-server-opened nntp-open-server nil t newsgroup nntp-current-group nntp-request-group] 4 (#$ . 25273)]) (defalias 'nntp-try-list-active #[(group) "À !ˆŠ\nqˆebˆÃÄ!ƒʼn‚lj)‡" [nntp-list-active-group group nntp-server-buffer looking-at "5[0-9]+" nil nntp-server-list-active-group t] 2]) (defalias 'nntp-async-server-opened #[nil "… Á!Â>‡" [nntp-async-process process-status (open run)] 2]) (defalias 'nntp-async-open-server #[nil "ŠÀÁ!qˆpÃp!ˆ)Ä\nÇ \"ˆ‰\n„(ĉ ‚-Ì\n\n\"*‡" [generate-new-buffer " *async-nntp*" nntp-async-buffer buffer-disable-undo nil nntp-server-buffer nntp-server-process nntp-open-server-semi-internal nntp-address nntp-port-number nntp-async-process nntp-async-number set-process-buffer] 3]) (defalias 'nntp-async-fetch-articles #[(article) ";?…] ž >A\n§ƒ\n‚!\nÃ=ƒ G‚!ÄÅS‰ÄY…\\…\\@@‰ >„TÊËÌ!\"ˆ B A‚(+‡" [article nntp-async-articles nntp-async-number t 0 nil nart max articles nntp-async-fetched nntp-async-send-strings "ARTICLE " int-to-string] 4]) (defalias 'nntp-async-send-strings #[(&rest strings) "ÀÁ\nÃ#ÄPÆ „Ç „ÈÉ !ˆÊ \")‡" [mapconcat identity strings " " " \n" cmd nntp-async-server-opened nntp-async-open-server error nntp-status-message process-send-string nntp-async-process] 4]) (defalias 'nntp-async-request-group #[(group) " š?…- \" FÈ\f \"B\f…,\fA@É\f8Ê\f8‰)‡" [group nntp-current-group assoc nntp-async-group-alist asyncs nntp-async-articles nntp-async-fetched nntp-async-process delq 2 3] 4]) (provide (quote nntp)) emacs-19.30/lisp/nnvirtual.elc100666 23053 1 17750 6046562007 15143 0ustar larsidaemon;ELC ;;; compiled by larsi@narfi.ifi.uio.no on Fri Nov 3 03:31:04 1995 ;;; from file /home/menja/c/larsi/dgnus/lisp/nnvirtual.el ;;; emacs version 19.29.90.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`nnvirtual.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!‡" [require nntp nnheader gnus] 2) #@46 Version number of this version of nnvirtual. (defconst nnvirtual-version "nnvirtual 1.0" (#$ . 541)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ BÀÈ!„GÉÈ B‡" [boundp nnvirtual-group-alist nil current-load-list nnvirtual-current-group nnvirtual-current-groups nnvirtual-current-mapping nnvirtual-do-not-open nnvirtual-status-string ""] 2) #@52 Retrieve the headers for the articles in SEQUENCE. (defalias 'nnvirtual-retrieve-headers #[(sequence &optional newsgroup server) "À \nÃ#ˆŠÄÅ!qˆÆp!ˆÇ ˆ@;ƒÉ‚Æ\nË̉‰‰‰‰‰‰‰‰ ƒ²@@@Wƒb@@A‰‚J@@@A@Ù!Ú@8̃¤@Xƒ¤@\\ZBA‰„„Ÿ‰ƒ‘Û! Ü !„ÁÝ !…ÏÞÃ\"…Ïß\"‰ƒ‘Š qˆÉ=ƒäá ˆebˆÌm„`â !‰B`|ˆãZ\\!cˆËyˆäå!ˆË•bˆæçŠÌˆ`)Ã#„)̈`SfèUƒ;éuˆêë!ˆ‚)lƒ[̈`SfìU„Mìcˆíîï $cˆ‚Šð˜„|ñòŠÌˆ`)Ã#ƒ|ŠË”bˆcˆ)‚b̈`SfìU„Šìcˆëyˆ‚ê)dbˆó !ˆôŸ\"‰5ƒ®ö5Ì#ˆ)‚CŠ qˆÇ ˆóÅ!ˆ)÷øp!ˆ.\f)‡" [nnvirtual-possibly-change-newsgroups newsgroup server t get-buffer-create "*virtual headers*" buffer-disable-undo erase-buffer sequence headers nnvirtual-current-mapping 0 nil group-method fetched-articles prefix result article top active group beg articles offset map gnus-group-real-prefix 2 gnus-find-method-for-group gnus-server-opened gnus-open-server gnus-request-group gnus-retrieve-headers nntp-server-buffer nnvirtual-convert-headers read int-to-string looking-at "[^ ]* [^ ]* [^ ]* [^ ]* [^ ]* [^ ]* [^ ]* " search-forward " " 32 -1 delete-char 1 9 format "Xref: %s %s:%d " system-name "" re-search-forward "[^ ]+:[0-9]+" insert-buffer-substring gnus-sorted-complement unfetched gnus-group-make-articles-read nov kill-buffer] 13 (#$ . 919)]) #@52 Open a virtual newsgroup that contains NEWSGROUPS. (defalias 'nnvirtual-open-server #[(newsgroups &optional something) "À ‡" [nnheader-init-server-buffer] 1 (#$ . 2274)]) #@20 Close news server. (defalias 'nnvirtual-close-server #[(&rest dum) "À‡" [t] 1 (#$ . 2451)]) (defalias 'nnvirtual-request-close #[nil "ÀÀÀÀŇ" [nil nnvirtual-current-group nnvirtual-current-groups nnvirtual-current-mapping nnvirtual-group-alist t] 1]) #@98 Return server process status, T or NIL. If the stream is opened, return T, otherwise return NIL. (defalias 'nnvirtual-server-opened #[(&optional server) "…Á!‡" [nntp-server-buffer get-buffer] 2 (#$ . 2712)]) #@42 Return server status response as string. (defalias 'nnvirtual-status-message #[(&optional server) "‡" [nnvirtual-status-string] 1 (#$ . 2930)]) #@35 Select article by message number. (defalias 'nnvirtual-request-article #[(article &optional newsgroup server buffer) "À \nÃ#ˆ\f§…] ÆÇ ‰\n@@\fWƒ+\n@@ \nA‰\n‚Ë\n@A@!Ì!„@Í!ˆÎ\n@A@Ã\"ˆÏÐ\n@8\f\\ Z\n@A@#+‡" [nnvirtual-possibly-change-newsgroups newsgroup server t article nnvirtual-current-mapping 0 nil group-method offset map gnus-find-method-for-group gnus-server-opened gnus-open-server gnus-request-group gnus-request-article 2 buffer] 5 (#$ . 3081)]) #@35 Make GROUP the current newsgroup. (defalias 'nnvirtual-request-group #[(group &optional server dont-check) "À \n #ˆ\fŠqˆÇ ˆ ƒ0 Aƒ A‰‚ÈÉ @@ @@ $cˆÊ‚7Ë\fÍÍ*‡" [nnvirtual-possibly-change-newsgroups group server dont-check nnvirtual-current-mapping map nntp-server-buffer erase-buffer format "211 %d 1 %d %s\n" t "No component groups" nnvirtual-status-string nil nnvirtual-current-group] 6 (#$ . 3565)]) (defalias 'nnvirtual-close-group #[(group &optional server) "…!Á\n Ä#ˆÅ ˆÆÆÆÉÊ\n \" \"‰ ‡" [nnvirtual-current-group nnvirtual-possibly-change-newsgroups group server t nnvirtual-update-marked nil nnvirtual-current-groups nnvirtual-current-mapping delq assoc nnvirtual-group-alist] 4]) (defalias 'nnvirtual-request-list #[(&optional server) "À‡" ["nnvirtual: LIST is not implemented." nnvirtual-status-string nil] 1]) #@18 List new groups. (defalias 'nnvirtual-request-newgroups #[(date &optional server) "À‡" ["NEWGROUPS is not supported." nnvirtual-status-string nil] 1 (#$ . 4413)]) (defalias 'nnvirtual-request-list-newsgroups #[(&optional server) "À‡" ["nnvirtual: LIST NEWSGROUPS is not implemented." nnvirtual-status-string nil] 1]) (defalias (quote nnvirtual-request-post) (quote nntp-request-post)) (defalias 'nnvirtual-request-post-buffer #[(post group subject header article-buffer info follow-to respect-poster) "À  \f &‡" [nntp-request-post-buffer post "" subject header article-buffer info follow-to respect-poster] 9]) (defalias 'nnvirtual-convert-headers #[nil "ŠqˆÁÂÃ\"Å ÇÉ ˆ……@AÊÃH!ËÌH†1ÍËÎH†:ÍËÏH†CÍËÐH†LÍËÑH†UÍËÊÒH†_Ã!ËÊÓH†jÃ!ËÔHƒ}ÕÔHËQ‚~ÍÖ±ˆ‚,‡" [nntp-server-buffer make-vector 100 0 gnus-newsgroup-dependencies gnus-get-newsgroup-headers headers nil header erase-buffer int-to-string " " 1 "" 2 3 4 5 6 7 8 "Xref: " "\n"] 19]) (defalias 'nnvirtual-possibly-change-newsgroups #[(group regexp &optional check) "À\nƒ/ ƒ\n ˜„/Ä\n \"‰ƒ/Æ 8˜ƒ/ @ A@É 8\n ƒ8 „œ ƒAÌ \"Í\n\nÏ Ð\"̓Ó@@\"ƒv@@˜„v@@BA‰„X*ƒ—Ô\n!ˆ\n\nF B‚œÕÖ!)‡" [t inf group nnvirtual-current-group assoc nnvirtual-group-alist 3 regexp nnvirtual-current-groups 2 nnvirtual-current-mapping check delq nil gnus-newsrc-alist gnus-group-prefixed-name (nnvirtual "") virt-group newsrc string-match nnvirtual-create-mapping format "nnvirtual: No newsgroups for this virtual newsgroup" nnvirtual-status-string] 5]) (defalias 'nnvirtual-create-mapping #[(group) "À ÂÃD\"ÄÅ \"J8 Ê Ì ÌÌÌÌ„1ÒÓ \"ˆÌ ƒz @ÄÅ\"J8Å\"J„|×!ƒvØÅ\"J\"ˆÅ\"J‚|ÙÚ\"ˆƒqA@ZTÄ8‰ƒ]A<„ª@ABC‰‚±Û!‰@§ƒÀ@†Ä@A@WƒÓA‰ƒ@§ƒå@†é@@@Wƒ@§ƒü†ÿ@@T ˆƒU@§ƒ†@Ý@§ƒ'@‚+@@@Z] \\ ˆ@§„L@@A@Z \\¡ˆA‰„\n ¤ ) S\\‰ @EB A *‚4ŸÞ \"Ý SBLˆAA  ˆßỂ‰‰‰‰‰ !\"#$% &‰'ƒ'@A@Ä'@8èÄÅ\"J88 &‰)ƒÿ)@ žƒö)@êë)@ žA\")@J¤Lˆ)A‰)„Ù)'@@ 'A‰'„¶&Ì ‰)ƒ7)@Jƒ.)@)@JB B )A‰)„蛃Hè›  ‚PAA C¡.‡" [gnus-group-prefixed-name group nnvirtual "" 2 intern-soft gnus-newsrc-hashtb info nnvirtual-current-groups groups 0 offset nil reads unread igroup itotal ireads error "No such group: %s" nnvirtual-current-mapping gnus-active-hashtb active gnus-activate-group gnus-get-unread-articles-in-group message "Couldn't open component group %s" copy-alist itreads 1 intern (tick dormant reply expire score) marked score expire reply dormant tick marks map 3 m mapcar #[(art) "§ƒ Wƒ ‡ Z \\‡@ Z \\AB‡" [art active 0 offset] 2]] 11]) (defalias 'nnvirtual-update-marked #[nil "ÀÁ‰‰‰‰…@@J‰ƒ@Ç @!È\f@ \"‰ƒ1\n\fAC¤ˆ‚9\f@\fAD B A‰„ ‰\nƒaÈ\n@ \"„X\n@C B\nA‰\n„H) ƒƒË @@@A @AÁÌ%ˆÍ @@Ì\"ˆ A‰„fA‰„Á-‡" [((gnus-newsgroup-marked . tick) (gnus-newsgroup-dormant . dormant) (gnus-newsgroup-expirable . expire) (gnus-newsgroup-replied . reply)) nil g group-alist art-group marks mark-lists nnvirtual-art-group assoc nnvirtual-current-groups groups gnus-add-marked-articles t gnus-group-update-group] 7]) (defalias 'nnvirtual-art-group #[(article) "Á‰@@\f§ƒ\f‚\f@Wƒ! @@ A‰‚ @A@\f§ƒ5\fÅ @8\\\nZ‚A\f@Å @8\\\nZ\fAB*B‡" [nnvirtual-current-mapping 0 offset map article 2] 5]) (defalias 'nnvirtual-catchup-group #[(group &optional server all) "À \n\"ˆ ÄŠqˆÈÉ\n\"+‡" [nnvirtual-possibly-change-newsgroups group server nnvirtual-current-groups t gnus-expert-user gnus-group-marked gnus-group-buffer gnus-group-catchup-current nil all] 3]) (provide (quote nnvirtual)) emacs-19.30/lisp/noutline.elc100666 12120 1 37262 6043466307 14441 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 12:58:28 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/noutline.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`noutline.el' was compiled for Emacs 19.29 or later")) #@266 *Regular expression to match the beginning of a heading. Any line whose beginning matches this regexp is considered to start a heading. The recommended way to set this is with a Local Variables: list in the file it applies to. See also outline-heading-end-regexp. (defvar outline-regexp nil (#$ . -484)) (byte-code "ÀÁ!„ ÂÁÃ\"ˆÀ‡" [default-value outline-regexp set-default "[*\f]+"] 3) #@286 *Regular expression to match the end of a heading line. You can assume that point is at the beginning of a heading when this regexp is searched for. The heading ends at the end of the match. The recommended way to set this is with a `Local Variables:' list in the file it applies to. (defvar outline-heading-end-regexp "\n" (#$ . -879)) (byte-code "ÀÁ!„ÂÁ B „sÄ Å ÆÇ#ˆÅ ÈÉ#ˆÅ ÊË#ˆÅ ÌÍ#ˆÅ ÎÏ#ˆÅ ÐÑ#ˆÅ ÒÓ#ˆÅ ÔÕ#ˆÅ Ö×#ˆÅ ØÙ#ˆÅ ÚÛ#ˆÅ ÜÝ#ˆÅ Þß#ˆÅ àá#ˆÅ âã#ˆÅ äå#ˆÀæ!„|Â&æ B&„6Ä &Å&çèÄè!B#ˆÅ&éê#ˆÅ&ëì#ˆÅ&íî#ˆÅ&ïð#ˆÅ&ñò#ˆÅ&óô#ˆÅ&õöÄö!B#ˆÅ&÷ø#ˆÅ&ùú#ˆÅ&ûü#ˆÅ&ýþ#ˆÅ&ÿ@#ˆÅ&ABÄB!B#ˆÅ&CD#ˆÅ&EF#ˆÅ&GH#ˆÅ&IJ#ˆÅ&KL#ˆÂ‡" [boundp outline-mode-prefix-map nil current-load-list make-sparse-keymap define-key "" outline-next-visible-heading "" outline-previous-visible-heading " " show-children "" show-subtree "" hide-subtree "" outline-up-heading "" outline-forward-same-level "" outline-backward-same-level "" hide-body "" show-all "" hide-entry "" show-entry "\f" hide-leaves " " show-branches "" hide-sublevels "" hide-other outline-mode-menu-bar-map [hide] "Hide" [hide hide-other] ("Hide Other" . hide-other) [hide hide-sublevels] ("Hide Sublevels" . hide-sublevels) [hide hide-subtree] ("Hide Subtree" . hide-subtree) [hide hide-entry] ("Hide Entry" . hide-entry) [hide hide-body] ("Hide Body" . hide-body) [hide hide-leaves] ("Hide Leaves" . hide-leaves) [show] "Show" [show show-subtree] ("Show Subtree" . show-subtree) [show show-children] ("Show Children" . show-children) [show show-branches] ("Show Branches" . show-branches) [show show-entry] ("Show Entry" . show-entry) [show show-all] ("Show All" . show-all) [headings] "Headings" [headings outline-backward-same-level] ("Previous Same Level" . outline-backward-same-level) [headings outline-forward-same-level] ("Next Same Level" . outline-forward-same-level) [headings outline-previous-visible-heading] ("Previous" . outline-previous-visible-heading) [headings outline-next-visible-heading] ("Next" . outline-next-visible-heading) [headings outline-up-heading] ("Up" . outline-up-heading)] 6) #@2  (defvar outline-mode-map nil (#$ . 2998)) (byte-code "„Á \n¤ÃÄ #ˆÃÆ#ˆÁ‡" [outline-mode-map make-sparse-keymap text-mode-map define-key "" outline-mode-prefix-map [menu-bar] outline-mode-menu-bar-map] 4) #@67 Non-nil if using Outline mode as a minor mode of some other mode. (defvar outline-minor-mode nil (#$ . 3217)) (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÁ ž„Æ ÇC\"À‡" [make-variable-buffer-local outline-minor-mode put permanent-local t minor-mode-alist append (outline-minor-mode " Outl")] 4) #@54 Additional expressions to highlight in Outline mode. (defvar outline-font-lock-keywords (quote (("^\\(\\*+\\)[ ]*\\(.+\\)?[ ]*$" (1 font-lock-string-face) (2 (let ((len (- (match-end 1) (match-beginning 1)))) (or (cdr (assq len (quote ((1 . font-lock-function-name-face) (2 . font-lock-keyword-face) (3 . font-lock-comment-face))))) font-lock-variable-name-face)) nil t)) ("\\[\\([A-Z][A-Za-z]+\\)*[0-9]+\\]" . font-lock-type-face))) (#$ . 3498)) #@57 Normal hook to be run after outline visibility changes. (defvar outline-view-change-hook nil (#$ . 3953)) #@2063 Set major mode for editing outlines with selective display. Headings are lines which start with asterisks: one for major headings, two for subheadings, etc. Lines not starting with asterisks are body lines. Body text or subheadings under a heading can be made temporarily invisible, or visible again. Invisible lines are attached to the end of the heading, so they move with it, if the line is killed and yanked back. A heading with text hidden under it is marked with an ellipsis (...). Commands:\ \[outline-next-visible-heading] outline-next-visible-heading move by visible headings \[outline-previous-visible-heading] outline-previous-visible-heading \[outline-forward-same-level] outline-forward-same-level similar but skip subheadings \[outline-backward-same-level] outline-backward-same-level \[outline-up-heading] outline-up-heading move from subheading to heading \[hide-body] make all text invisible (not headings). \[show-all] make everything in buffer visible. The remaining commands are used when point is on a heading line. They apply to some of the body or subheadings of that heading. \[hide-subtree] hide-subtree make body and subheadings invisible. \[show-subtree] show-subtree make body and subheadings visible. \[show-children] show-children make direct subheadings visible. No effect on body, or subheadings 2 or more levels down. With arg N, affects subheadings N levels down. \[hide-entry] make immediately following body invisible. \[show-entry] make it visible. \[hide-leaves] make body under heading and under its subheadings invisible. The subheadings remain visible. \[show-branches] make all subheadings at all levels visible. The variable `outline-regexp' can be changed to control what is a heading. A line is a heading if `outline-regexp' matches something at the beginning of the line. The longer the match, the deeper the level. Turning on outline mode calls the value of `text-mode-hook' and then of `outline-mode-hook', if they are non-nil. (defalias 'outline-mode #[nil "À ˆÁ\n!ˆÃÅÇÈÉ\"ˆ\nË\f!ˆÍÎ!ˆÏÐÍÒ!ˆÓÕRÍÖ!ˆÍ×!ˆÓÕRÍØ!ˆÙÍÚ!ˆÛÚÜ\"ˆÝÞß\"‡" [kill-all-local-variables use-local-map outline-mode-map "Outline" mode-name outline-mode major-mode define-abbrev-table text-mode-abbrev-table nil local-abbrev-table set-syntax-table text-mode-syntax-table make-local-variable line-move-ignore-invisible t ((t . t)) buffer-invisibility-spec paragraph-start "\\|\\(" outline-regexp "\\)" auto-fill-inhibit-regexp paragraph-separate font-lock-defaults (outline-font-lock-keywords t) change-major-mode-hook add-hook show-all run-hooks text-mode-hook outline-mode-hook] 4 (#$ . 4067) nil]) #@202 *Prefix key to use for Outline commands in Outline minor mode. The value of this variable is checked as part of loading Outline mode. After that, changing the prefix key requires manipulating keymaps. (defvar outline-minor-mode-prefix "@" (#$ . -6802)) (byte-code "ÀÁ!„ÂÁ B „\"Ä Å Æ#ˆÅ  #ˆÊ ž„1Ê B B ‡" [boundp outline-minor-mode-map nil current-load-list make-sparse-keymap define-key [menu-bar] outline-mode-menu-bar-map outline-minor-mode-prefix outline-mode-prefix-map outline-minor-mode minor-mode-map-alist] 4) #@166 Toggle Outline minor mode. With arg, turn Outline minor mode on if arg is positive, off otherwise. See the command `outline-mode' for more information on this mode. (defalias 'outline-minor-mode #[(&optional arg) "„ ?‚Â!ÃV‰ƒ#ÄÅ!ˆÆÇÉÊ!ˆ‚(ËÆ „/Ì ˆÍ ‡" [arg outline-minor-mode prefix-numeric-value 0 make-local-variable line-move-ignore-invisible t ((t . t)) buffer-invisibility-spec run-hooks outline-minor-mode-hook nil show-all force-mode-line-update] 3 (#$ . 7343) "P"]) #@130 Function of no args to compute a header's nesting level in an outline. It can assume point is at the beginning of a header line. (defvar outline-level (quote outline-level) (#$ . 7838)) #@188 Return the depth to which a statement is nested in the outline. Point must be at the beginning of a header line. This is actually the number of characters that `outline-regexp' matches. (defalias 'outline-level #[nil "ŠÀ !ˆÂ•Â”Z)‡" [looking-at outline-regexp 0] 2 (#$ . 8031)]) #@140 Skip forward to just before the next heading line. If there's no following heading line, stop before the newline at the end of the buffer. (defalias 'outline-next-preface #[nil "ÀÁ\nÃQÄÅ#ƒÆ”bˆn…Çu‡" [re-search-forward "\n\\(" outline-regexp "\\)" nil move 0 -1] 4 (#$ . 8317)]) #@53 Move to the next (possibly invisible) heading line. (defalias 'outline-next-heading #[nil "ÀÁ\nÃQÄÅ#…Æ”Tb‡" [re-search-forward "\n\\(" outline-regexp "\\)" nil move 0] 4 (#$ . 8605) nil]) #@50 Non-nil if the character after point is visible. (defalias 'outline-visible #[nil "À`Á\"?‡" [get-char-property invisible] 3 (#$ . 8801)]) (put (quote outline-visible) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@114 Move to previous heading line, or beg of this line if it's a heading. Only visible heading lines are considered. (defalias 'outline-back-to-heading #[nil "ÀyˆÁ †(ÂÄÅÇQÂÈ#…É`Ê\"?‰ƒ\n )†(ËÌ!‡" [0 outline-on-heading-p nil found re-search-backward "^\\(" outline-regexp "\\)" t get-char-property invisible error "before first heading"] 5 (#$ . 9034)]) #@51 Return t if point is on a (visible) heading line. (defalias 'outline-on-heading-p #[nil "ŠÀyˆn…Á`Â\"?…Ã\f!)‡" [0 get-char-property invisible looking-at outline-regexp] 3 (#$ . 9397)]) (defalias 'outline-end-of-heading #[nil "À ÂÃ#…\nÄu‡" [re-search-forward outline-heading-end-regexp nil move -1] 4]) #@178 Move to the next visible heading line. With argument, repeats or can move backward if negative. A heading line is one that starts with a `*' (or that `outline-regexp' matches). (defalias 'outline-next-visible-heading #[(arg) "ÁWƒ\fÁyˆ‚ˆo„5ÁWƒ5o„/ÃÄ ÆQÂÇ#ƒ/È`É\"„T‚m„[ÁVƒ[m„UÊÄ ÆQÂÇ#ƒUÈ`É\"„?S‚5ÁyˆÂ‡" [arg 0 nil re-search-backward "^\\(" outline-regexp "\\)" move get-char-property invisible re-search-forward] 4 (#$ . 9710) "p"]) #@173 Move to the previous heading line. With argument, repeats or can move forward if negative. A heading line is one that starts with a `*' (or that `outline-regexp' matches). (defalias 'outline-previous-visible-heading #[(arg) "À [!‡" [outline-next-visible-heading arg] 2 (#$ . 10174) "p"]) #@132 Hides or shows lines from FROM to TO, according to FLAG. If FLAG is nil then text is shown, while if FLAG is t the text is hidden. (defalias 'outline-flag-region #[(from to flag) "ÀŠ\nbˆÃˆÄ` Æ#ˆƒ*È` \" Ê Ë#ˆÊ ÆÀ#ˆ)*ÌÍ!‡" [t inhibit-read-only from nil outline-discard-overlays to outline flag make-overlay o overlay-put invisible run-hooks outline-view-change-hook] 4 (#$ . 10469)]) (defalias 'outline-discard-overlays #[(beg end prop) " Wƒ\n Š bˆ`W…zÂ`!‰ƒq @Å\f\"ƒiÇ\f! WƒRÈ\f!VƒiÉ\f!\nË\nÇ\n! #ˆË\fÇ\f! #ˆ)‚iÈ\f!VƒeË\fÈ\f!#ˆ‚iÌ\f!ˆ) A‰„)Í`!bˆ‚)‡" [end beg overlays-at overlays o overlay-get prop overlay-start overlay-end outline-copy-overlay o1 move-overlay delete-overlay next-overlay-change] 6]) (defalias 'outline-copy-overlay #[(o) "ÀÁ\n!Ã\n!Ä\n!#Å\n!ƒ-È@A@#ˆAA‰„*‡" [make-overlay overlay-start o overlay-end overlay-buffer overlay-properties props o1 overlay-put] 6]) #@48 Hide the body directly following this heading. (defalias 'hide-entry #[nil "À ˆÁ ˆŠÂ`à ˆ`Ä#)‡" [outline-back-to-heading outline-end-of-heading outline-flag-region outline-next-preface t] 4 (#$ . 11410) nil]) #@48 Show the body directly following this heading. (defalias 'show-entry #[nil "ŠÀ`Á ˆ`Â#)‡" [outline-flag-region outline-next-preface nil] 4 (#$ . 11624) nil]) #@37 Hide all of buffer except headings. (defalias 'hide-body #[nil "Àed\"‡" [hide-region-body] 3 (#$ . 11787) nil]) #@54 Hide all body lines in the region, but not headings. (defalias 'hide-region-body #[(start end) "ŠŒ }ˆebˆÂ ƒà ˆm?…6Ä`Å ˆ`Æ#ˆm„ÇÈ!ƒ-É‚.ÊuˆÃ ˆ‚*‡" [start end outline-on-heading-p outline-end-of-heading outline-flag-region outline-next-preface t looking-at "\n\n" 2 1] 4 (#$ . 11905)]) #@37 Show all of the text in the buffer. (defalias 'show-all #[nil "ÀedÁ#‡" [outline-flag-region nil] 4 (#$ . 12203) nil]) #@54 Hide everything after this heading at deeper levels. (defalias 'hide-subtree #[nil "ÀÁ!‡" [outline-flag-subtree t] 2 (#$ . 12327) nil]) #@52 Hide all body after this heading at deeper levels. (defalias 'hide-leaves #[nil "À ˆÁ ˆÂ`à ˆ`\"‡" [outline-back-to-heading outline-end-of-heading hide-region-body outline-end-of-subtree] 3 (#$ . 12469) nil]) #@54 Show everything after this heading at deeper levels. (defalias 'show-subtree #[nil "ÀÁ!‡" [outline-flag-subtree nil] 2 (#$ . 12683) nil]) #@72 Hide everything but the top LEVELS levels of headers, in whole buffer. (defalias 'hide-sublevels #[(levels) "ÁWƒ\nÂÃ!ˆSŠebˆoƒÄ „Å …@ŠÆ ˆ`)È`É#ˆÊVƒ8Ë!ˆbˆ)‚)‡" [levels 1 error "Must keep at least one level of headers" outline-on-heading-p outline-next-heading outline-end-of-subtree end outline-flag-region t 0 show-children] 4 (#$ . 12827) "p"]) #@70 Hide everything except for the current body and the parent headings. (defalias 'hide-other #[nil "ÀÁ!ˆ``ŠÄ…Å`Æ\"??)…7ŠÄyˆ `=ƒ.Ç ˆÈ `É#ˆ‚3Ê ˆ`)‚*‡" [hide-sublevels 1 pos last 0 get-char-property invisible outline-next-heading outline-flag-region nil show-children] 4 (#$ . 13198) nil]) (defalias 'outline-flag-subtree #[(flag) "ŠÀ ˆÁ ˆÂ`à ˆ`\f#)‡" [outline-back-to-heading outline-end-of-heading outline-flag-region outline-end-of-subtree flag] 4]) (defalias 'outline-end-of-subtree #[nil "À ˆ`Á\n m„!\f„\n Vƒ!ÆÇ ˆ‚\nn….Èuˆn….Èu+‡" [outline-back-to-heading t outline-level level first opoint nil outline-next-heading -1] 3]) #@61 Show all subheadings of this heading, but not their bodies. (defalias 'show-branches #[nil "ÀÁ!‡" [show-children 1000] 2 (#$ . 13851) nil]) #@183 Show all direct subheadings of this heading. Prefix arg LEVEL is how many levels below the current level should be shown. Default is enough to cause the following heading to appear. (defalias 'show-children #[(&optional level) "ƒ\nÁ!‚#ŠÂ ˆ Å ˆmƒÆ‚\"Æ \fZ]*ŠŒÂ ˆ \\`Ç ˆmƒ:d‚<`T}ˆebˆm?…oÅ ˆm?…o XƒAŠÈŠÉuˆnƒbÉuˆ`)Ê ˆ`Ë#ˆ)‚A*‡" [level prefix-numeric-value outline-back-to-heading outline-level start-level outline-next-heading 1 outline-end-of-subtree outline-flag-region -1 outline-end-of-heading nil] 4 (#$ . 13998) "P"]) #@104 Move to the heading line of which the present line is a subheading. With argument, move up ARG levels. (defalias 'outline-up-heading #[(arg) "À ˆ Â=ƒÃÄ!ˆ ÂV…; ÆV…;o?…;  W„3ÈÂ!ˆ‚$ ÂZ)‚‡" [outline-back-to-heading outline-level 1 error "" arg 0 present-level outline-previous-visible-heading] 2 (#$ . 14548) "p"]) #@128 Move forward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading. (defalias 'outline-forward-same-level #[(arg) "À ˆ ÂV…%ŠÃ )‰ƒ\fbˆ S‚!ÂÅÆ!ˆ)‚‡" [outline-back-to-heading arg 0 outline-get-next-sibling point-to-move-to error ""] 3 (#$ . 14884) "p"]) #@74 Move to next heading of the same level, and return point or nil if none. (defalias 'outline-get-next-sibling #[nil " ÂÃ!ˆ Vƒm„ÂÃ!ˆ‚ W?…\"`)‡" [outline-level level outline-next-visible-heading 1] 2 (#$ . 15209)]) #@129 Move backward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading. (defalias 'outline-backward-same-level #[(arg) "À ˆ ÂV…%ŠÃ )‰ƒ\fbˆ S‚!ÂÅÆ!ˆ)‚‡" [outline-back-to-heading arg 0 outline-get-last-sibling point-to-move-to error ""] 3 (#$ . 15441) "p"]) #@74 Move to next heading of the same level, and return point or nil if none. (defalias 'outline-get-last-sibling #[nil " ÂÃ!ˆ Vƒo„ÂÃ!ˆ‚ W?…\"`)‡" [outline-level level outline-previous-visible-heading 1] 2 (#$ . 15768)]) (byte-code "ÀÁ!ˆÀÂ!‡" [provide outline noutline] 2) emacs-19.30/lisp/novice.elc100666 13437 1 5066 5744577047 14213 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:47:50 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/novice.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/novice.el' was compiled for Emacs 19")) (byte-code "ÀÀ‡" [disabled-command-hook] 1) (defalias 'disabled-command-hook #[(&rest ignore) "À‹ˆ ÃUƒ*\fƒ#\fŘ„#ÆÇ!ƒ#È !ˆ‚*Ê ËÀ#ˆ ÌU?…5Í !)‡" [nil char ((byte-code "ÀÁ ‰ÃH\n;ƒÄÃH‚Å=„0\nGÆYƒ7\nÃH=ƒ7\nÈHÉ=ƒ7ÊË!ˆ‚EÊÌ!ˆÊÍ\n!!ˆÊÎ!ˆ)Ê!ˆÊÐ!ˆÑN;ƒ^ÊÑN!ˆÊÒÓÔ†gÕ!ˆŠÀqˆebˆÖ×ÒØ#ƒ€`Sd|ˆ‚ƒdbˆ)Ê×!ˆÊÙ!ˆŠqˆÛ )‘ˆÜÝ!ˆØß —‰ á>„²â ˆÜã!ˆ‚)Ò‡" ["*Help*" this-command-keys keys 0 "ø" -134217608 2 meta-prefix-char 1 120 princ "You have invoked the disabled command " "You have typed " key-description ", invoking disabled command " this-command ":\n" disabled nil (documentation this-command) ((error)) "<< not documented >>" search-forward "\n\n" t "You can now type\nSpace to try the command just this once,\n but leave it disabled,\nY to try it and enable it (no questions if you use it again),\nN to do nothing (command remains disabled)." standard-output help-mode message "Type y, n or Space: " cursor-in-echo-area read-char char (32 121 110) ding "Please type y, n or Space: "] 6)) 121 user-init-file "" y-or-n-p "Enable command for future editing sessions also? " enable-command this-command put disabled 110 call-interactively] 4]) #@150 Allow COMMAND to be executed without special confirmation from now on. The user's .emacs file is altered so that this will apply to future sessions. (defalias 'enable-command #[(command) "À ÂÃ#ˆŠÄÅ!!qˆebˆÇÈÉ !ÊQÃË#ƒ)Ìyˆ`Íyˆ`|ˆdbˆÎÉ !ϱˆÐ )‡" [put command disabled nil find-file-noselect substitute-in-file-name user-init-file search-forward "(put '" symbol-name " " t 0 1 "\n(put '" " 'disabled nil)\n" save-buffer] 4 (#$ . 1649) "CEnable command: "]) #@140 Require special confirmation to execute COMMAND from now on. The user's .emacs file is altered so that this will apply to future sessions. (defalias 'disable-command #[(command) "À !„ Âà \"ˆÄ ÅÆ#ˆŠÇÈ !!qˆebˆÊËÌ !ÍQÎÆ#ƒ4Ïyˆ`Ðyˆ`|ˆdbˆÑÌ !Ò±ˆÓ )‡" [commandp command error "Invalid command name `%s'" put disabled t find-file-noselect substitute-in-file-name user-init-file search-forward "(put '" symbol-name " " nil 0 1 "\n(put '" " 'disabled t)\n" save-buffer] 4 (#$ . 2112) "CDisable command: "]) emacs-19.30/lisp/nroff-mode.elc100666 13437 1 12630 6003663473 14763 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Jul 21 04:37:10 1995 ;;; from file /home/fsf/rms/e19/lisp/nroff-mode.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`nroff-mode.el' was compiled for Emacs 19.29 or later")) #@40 Abbrev table used while in nroff mode. (defvar nroff-mode-abbrev-table nil (#$ . 478)) (define-abbrev-table (quote nroff-mode-abbrev-table) nil) #@35 Major mode keymap for nroff mode. (defvar nroff-mode-map nil (#$ . 629)) (byte-code "„+Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÁ‡" [nroff-mode-map make-sparse-keymap define-key " " tab-to-tab-stop "s" center-line "?" count-text-lines "\n" electric-nroff-newline "n" forward-text-line "p" backward-text-line] 4) #@40 Syntax table used while in nroff mode. (defvar nroff-mode-syntax-table nil (#$ . 951)) #@47 Font-lock highlighting control in nroff-mode. (defvar nroff-font-lock-keywords (byte-code "ÀÁÂÃÄÅÆ#ÇRD‡" ["^[.']\\s-*\\sw+" "\\\\" "\\(" mapconcat identity ("[f*n]*\\[.+]" "(.." "[^(\"]") "\\|" "\\)"] 7) (#$ . 1044)) #@269 Major mode for editing text intended for nroff to format. \{nroff-mode-map} Turning on Nroff mode runs `text-mode-hook', then `nroff-mode-hook'. Also, try `nroff-electric-mode', for automatically inserting closing requests for requests that are used in matched pairs. (defalias 'nroff-mode #[nil "À ˆÁ\n!ˆÃÅ„,È !ÊËÌ#ˆÊÍÎ#ˆÊÏÐ#ˆÑ!ˆÒÓ!ˆÔÒ×!ˆØÒÙ!ˆÚÒÛ!ˆÜÒÝ!ˆÞÒß!ˆàPÒá!ˆà!P!Òâ!ˆã\"Òä!ˆå$Òæ!ˆç&Òè!ˆé(êëì\"‡" [kill-all-local-variables use-local-map nroff-mode-map "Nroff" mode-name nroff-mode major-mode nroff-mode-syntax-table copy-syntax-table text-mode-syntax-table modify-syntax-entry 34 "\" 2" 92 "\\ 1" 10 "> 1" set-syntax-table make-local-variable font-lock-defaults (nroff-font-lock-keywords nil t) nroff-mode-abbrev-table local-abbrev-table nroff-electric-mode nil outline-regexp "\\.H[ ]+[1-7]+ " outline-level nroff-outline-level page-delimiter "^\\.\\(bp\\|SK\\|OP\\)" paragraph-start "[.']\\|" paragraph-separate comment-start "\\\" " comment-start-skip "\\\\\"[ ]*" comment-column 24 comment-indent-function nroff-comment-indent run-hooks text-mode-hook nroff-mode-hook] 4 (#$ . 1268) nil]) (defalias 'nroff-outline-level #[nil "ŠÀ !ˆÂÃwˆÄ``Å\\{!)‡" [looking-at outline-regexp ".H " nil string-to-int 1] 4]) #@102 Compute indent for an nroff/troff comment. Puts a full-stop before comments on a line by themselves. (defalias 'nroff-comment-indent #[nil "`ÁŽÂÃxˆnƒTÄcˆÅ‚0ŠÆÅ!ˆÇÈ!)ƒ&Å‚0 iÊ\\Ë¥Ë_]*‡" [pt ((goto-char pt)) " " nil 46 1 backward-char looking-at "^[.']" comment-column 9 8] 3 (#$ . 2535)]) #@223 Count lines in region, except for nroff request lines. All lines not starting with a period are counted up. Interactively, print result in echo area. Noninteractively, return number of non-request lines from START to END. (defalias 'count-text-lines #[(start end &optional print) "ƒ\fÁÂÃ\f \"\"‡ŠŒ\f }ˆebˆÆ ÇÆ !Z*‡" [print message "Region has %d text lines" count-text-lines start end buffer-size forward-text-line] 5 (#$ . 2839) "r\np"]) #@126 Go forward one nroff text line, skipping lines of nroff requests. An argument is a repeat count; if negative, move backward. (defalias 'forward-text-line #[(&optional cnt) "„ÁÂVƒ+m„+Áyˆm„#ÃÄ!ƒ#Áyˆ‚ÁZ‰‚ÂWƒPo„PÅyˆo„HÃÄ!ƒHÅyˆ‚8Á\\‰‚,‡" [cnt 1 0 looking-at "[.']." -1] 3 (#$ . 3287) "p"]) #@128 Go backward one nroff text line, skipping lines of nroff requests. An argument is a repeat count; negative means move forward. (defalias 'backward-text-line #[(&optional cnt) "À [!‡" [forward-text-line cnt] 2 (#$ . 3604) "p"]) (byte-code "ÀÁ\nBÁ‡" [((".(b" . ".)b") (".(l" . ".)l") (".(q" . ".)q") (".(c" . ".)c") (".(x" . ".)x") (".(z" . ".)z") (".(d" . ".)d") (".(f" . ".)f") (".LG" . ".NL") (".SM" . ".NL") (".LD" . ".DE") (".CD" . ".DE") (".BD" . ".DE") (".DS" . ".DE") (".DF" . ".DE") (".FS" . ".FE") (".KS" . ".KE") (".KF" . ".KE") (".LB" . ".LE") (".AL" . ".LE") (".BL" . ".LE") (".DL" . ".LE") (".ML" . ".LE") (".RL" . ".LE") (".VL" . ".LE") (".RS" . ".RE") (".TS" . ".TE") (".EQ" . ".EN") (".PS" . ".PE") (".BS" . ".BE") (".G1" . ".G2") (".na" . ".ad b") (".nf" . ".fi") (".de" . "..")) nroff-brace-table current-load-list] 2) #@208 Insert newline for nroff mode; special if electric-nroff mode. In `electric-nroff-mode', if ending a line containing an nroff opening request, automatically inserts the matching closing request after point. (defalias 'electric-nroff-newline #[(arg) "ŠÀyˆ ?…\n…`dÃZX…Ä``Ã\\{ \"A)ÆÇ!?‰ „3ÊË !!‚EŠÌ ±ˆƒBÍcˆ)Îu*‡" [0 arg nroff-electric-mode 3 assoc nroff-brace-table looking-at "[ ]*$" needs-nl completion newline prefix-numeric-value "\n\n" "\n" 1] 5 (#$ . 4449) "P"]) #@314 Toggle `nroff-electric-newline' minor mode. `nroff-electric-newline' forces Emacs to check for an nroff request at the beginning of the line, and insert the matching closing request if necessary. This command toggles that mode (off->on, on->off), with an argument, turns it on iff arg is positive, otherwise off. (defalias 'electric-nroff-mode #[(&optional arg) "Á=„\nÂÃ!ˆÄ ž„Æ ÇC\"„ \f?‚&É!ÊV‰‡" [major-mode nroff-mode error "Must be in nroff mode" nroff-electric-mode minor-mode-alist append (nroff-electric-mode " Electric") arg prefix-numeric-value 0] 3 (#$ . 4939) "P"]) emacs-19.30/lisp/options.elc100666 13437 1 6224 5744577052 14414 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:47:53 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/options.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/options.el' was compiled for Emacs 19")) #@70 Display a list of Emacs user options, with values and documentation. (defalias 'list-options #[nil "ŠÀÁ!qˆÂ ˆ)ÁÃÅÆ!ˆÇ\fÈ\"‰…L\f@ ÊË!ˆÌ !ˆÊÍ!ˆÌ J!ˆÎ ˆÊÏÐ Ñ\"!!ˆÊÒ!ˆ)\fA‰„Ã)‘ˆŠÁqˆÓ‰)‡" [get-buffer-create "*List Options*" Edit-options-mode nil vars mapatoms #[(sym) "À !… \nB‰‡" [user-variable-p sym vars] 2] sort string-lessp sym princ ";; " prin1 ":\n " terpri substitute-command-keys documentation-property variable-documentation "\n;;\n" t buffer-read-only] 7 (#$ . 483) nil]) #@198 Edit a list of Emacs user option values. Selects a buffer containing such a list, in which there are commands to set the option values. Type \[describe-mode] in that buffer for a list of commands. (defalias 'edit-options #[nil "À ˆÁÂ!‡" [list-options pop-to-buffer "*List Options*"] 2 (#$ . 984) nil]) #@2  (defvar Edit-options-mode-map (byte-code "À  ÃÄ#ˆÂ ÅÆ#ˆÂ ÇÈ#ˆÂ ÉÊ#ˆÂ ËÌ#ˆÂ ÍÎ#ˆÂ ÏÎ#ˆ )‡" [make-keymap map define-key "s" Edit-options-set "x" Edit-options-toggle "1" Edit-options-t "0" Edit-options-nil "p" backward-paragraph " " forward-paragraph "n"] 4) (#$ . 1291)) (put (quote Edit-options-mode) (quote mode-class) (quote special)) #@554 \Major mode for editing Emacs user option settings. Special commands are: \[Edit-options-set] -- set variable point points at. New value read using minibuffer. \[Edit-options-toggle] -- toggle variable, t -> nil, nil -> t. \[Edit-options-t] -- set variable to t. \[Edit-options-nil] -- set variable to nil. Changed values made by these commands take effect immediately. Each variable description is a paragraph. For convenience, the characters \[backward-paragraph] and \[forward-paragraph] move back and forward by paragraphs. (defalias 'Edit-options-mode #[nil "À ˆÁ\n!ˆÃ\f!ˆÅÆ!ˆÇÅÈ!ˆÉÊ Ì ÎÐÑ!‡" [kill-all-local-variables set-syntax-table emacs-lisp-mode-syntax-table use-local-map Edit-options-mode-map make-local-variable paragraph-separate "[^-]" paragraph-start " " t truncate-lines Edit-options-mode major-mode "Options" mode-name run-hooks Edit-options-mode-hook] 2 (#$ . 1637)]) (defalias 'Edit-options-set #[nil "ÀÁ!‡" [Edit-options-modify (lambda (var) (eval-minibuffer (concat "New " (symbol-name var) ": ")))] 2 nil nil]) (defalias 'Edit-options-toggle #[nil "ÀÁ!‡" [Edit-options-modify (lambda (var) (not (symbol-value var)))] 2 nil nil]) (defalias 'Edit-options-t #[nil "ÀÁ!‡" [Edit-options-modify (lambda (var) t)] 2 nil nil]) (defalias 'Edit-options-nil #[nil "ÀÁ!‡" [Edit-options-modify (lambda (var) nil)] 2 nil nil]) (defalias 'Edit-options-modify #[(modfun) "ŠÀ‰‰ÄÅ!ˆÆuˆ`Œ Àˆ`S}ˆ bˆÇp!) bˆÈyˆÈuˆŠ\n \n!Lˆ)ÊÈ!ˆË\nJp\",‡" [nil pos var buffer-read-only re-search-backward "^;; \\|\\`" 3 read 1 modfun kill-sexp prin1] 3]) emacs-19.30/lisp/outline.elc100666 13437 1 34747 5751351723 14424 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue May 2 02:40:07 1995 ;;; from file /home/fsf/rms/e19/lisp/outline.el ;;; emacs version 19.28.90.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/home/fsf/rms/e19/lisp/outline.el' was compiled for Emacs 19")) #@266 *Regular expression to match the beginning of a heading. Any line whose beginning matches this regexp is considered to start a heading. The recommended way to set this is with a Local Variables: list in the file it applies to. See also outline-heading-end-regexp. (defvar outline-regexp nil (#$ . -481)) (byte-code "ÀÁ!„ ÂÁÃ\"ˆÀ‡" [default-value outline-regexp set-default "[*\f]+"] 3) #@286 *Regular expression to match the end of a heading line. You can assume that point is at the beginning of a heading when this regexp is searched for. The heading ends at the end of the match. The recommended way to set this is with a "Local Variables:" list in the file it applies to. (defvar outline-heading-end-regexp "[\n ]" (#$ . -876)) (byte-code "ÀÁ!„ÂÁ B „sÄ Å ÆÇ#ˆÅ ÈÉ#ˆÅ ÊË#ˆÅ ÌÍ#ˆÅ ÎÏ#ˆÅ ÐÑ#ˆÅ ÒÓ#ˆÅ ÔÕ#ˆÅ Ö×#ˆÅ ØÙ#ˆÅ ÚÛ#ˆÅ ÜÝ#ˆÅ Þß#ˆÅ àá#ˆÅ âã#ˆÅ äå#ˆÀæ!„|Â&æ B&„6Ä &Å&çèÄè!B#ˆÅ&éê#ˆÅ&ëì#ˆÅ&íî#ˆÅ&ïð#ˆÅ&ñò#ˆÅ&óô#ˆÅ&õöÄö!B#ˆÅ&÷ø#ˆÅ&ùú#ˆÅ&ûü#ˆÅ&ýþ#ˆÅ&ÿ@#ˆÅ&ABÄB!B#ˆÅ&CD#ˆÅ&EF#ˆÅ&GH#ˆÅ&IJ#ˆÅ&KL#ˆÂ‡" [boundp outline-mode-prefix-map nil current-load-list make-sparse-keymap define-key "" outline-next-visible-heading "" outline-previous-visible-heading " " show-children "" show-subtree "" hide-subtree "" outline-up-heading "" outline-forward-same-level "" outline-backward-same-level "" hide-body "" show-all "" hide-entry "" show-entry "\f" hide-leaves " " show-branches "" hide-sublevels "" hide-other outline-mode-menu-bar-map [hide] "Hide" [hide hide-other] ("Hide Other" . hide-other) [hide hide-sublevels] ("Hide Sublevels" . hide-sublevels) [hide hide-subtree] ("Hide Subtree" . hide-subtree) [hide hide-entry] ("Hide Entry" . hide-entry) [hide hide-body] ("Hide Body" . hide-body) [hide hide-leaves] ("Hide Leaves" . hide-leaves) [show] "Show" [show show-subtree] ("Show Subtree" . show-subtree) [show show-children] ("Show Children" . show-children) [show show-branches] ("Show Branches" . show-branches) [show show-entry] ("Show Entry" . show-entry) [show show-all] ("Show All" . show-all) [headings] "Headings" [headings outline-backward-same-level] ("Previous Same Level" . outline-backward-same-level) [headings outline-forward-same-level] ("Next Same Level" . outline-forward-same-level) [headings outline-previous-visible-heading] ("Previous" . outline-previous-visible-heading) [headings outline-next-visible-heading] ("Next" . outline-next-visible-heading) [headings outline-up-heading] ("Up" . outline-up-heading)] 6) #@2  (defvar outline-mode-map nil (#$ . 2998)) (byte-code "„Á \n¤ÃÄ #ˆÃÆ#ˆÁ‡" [outline-mode-map make-sparse-keymap text-mode-map define-key "" outline-mode-prefix-map [menu-bar] outline-mode-menu-bar-map] 4) #@67 Non-nil if using Outline mode as a minor mode of some other mode. (defvar outline-minor-mode nil (#$ . 3217)) (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÁ ž„Æ ÇC\"À‡" [make-variable-buffer-local outline-minor-mode put permanent-local t minor-mode-alist append (outline-minor-mode " Outl")] 4) #@54 Additional expressions to highlight in Outline mode. (defvar outline-font-lock-keywords (quote (("^\\(\\*+\\)[ ]*\\(.+\\)?[ ]*$" (1 font-lock-string-face) (2 (let ((len (- (match-end 1) (match-beginning 1)))) (or (cdr (assq len (quote ((1 . font-lock-function-name-face) (2 . font-lock-keyword-face) (3 . font-lock-comment-face))))) font-lock-variable-name-face)) nil t)) ("\\[\\([A-Z][A-Za-z]+\\)*[0-9]+\\]" . font-lock-type-face))) (#$ . 3498)) #@2063 Set major mode for editing outlines with selective display. Headings are lines which start with asterisks: one for major headings, two for subheadings, etc. Lines not starting with asterisks are body lines. Body text or subheadings under a heading can be made temporarily invisible, or visible again. Invisible lines are attached to the end of the heading, so they move with it, if the line is killed and yanked back. A heading with text hidden under it is marked with an ellipsis (...). Commands:\ \[outline-next-visible-heading] outline-next-visible-heading move by visible headings \[outline-previous-visible-heading] outline-previous-visible-heading \[outline-forward-same-level] outline-forward-same-level similar but skip subheadings \[outline-backward-same-level] outline-backward-same-level \[outline-up-heading] outline-up-heading move from subheading to heading \[hide-body] make all text invisible (not headings). \[show-all] make everything in buffer visible. The remaining commands are used when point is on a heading line. They apply to some of the body or subheadings of that heading. \[hide-subtree] hide-subtree make body and subheadings invisible. \[show-subtree] show-subtree make body and subheadings visible. \[show-children] show-children make direct subheadings visible. No effect on body, or subheadings 2 or more levels down. With arg N, affects subheadings N levels down. \[hide-entry] make immediately following body invisible. \[show-entry] make it visible. \[hide-leaves] make body under heading and under its subheadings invisible. The subheadings remain visible. \[show-branches] make all subheadings at all levels visible. The variable `outline-regexp' can be changed to control what is a heading. A line is a heading if `outline-regexp' matches something at the beginning of the line. The longer the match, the deeper the level. Turning on outline mode calls the value of `text-mode-hook' and then of `outline-mode-hook', if they are non-nil. (defalias 'outline-mode #[nil "À ˆÁÃ\f!ˆÅÇÉÊË\"ˆ\n\fÍ!ˆÏÐ!ˆÑÓRÏÔ!ˆÏÕ!ˆÑÓRÏÖ!ˆ×ÏØ!ˆÙØÚ\"ˆÛÜÝ\"‡" [kill-all-local-variables t selective-display use-local-map outline-mode-map "Outline" mode-name outline-mode major-mode define-abbrev-table text-mode-abbrev-table nil local-abbrev-table set-syntax-table text-mode-syntax-table make-local-variable paragraph-start "\\|\\(" outline-regexp "\\)" auto-fill-inhibit-regexp paragraph-separate font-lock-defaults (outline-font-lock-keywords t) change-major-mode-hook add-hook show-all run-hooks text-mode-hook outline-mode-hook] 4 (#$ . 3955) nil]) #@202 *Prefix key to use for Outline commands in Outline minor mode. The value of this variable is checked as part of loading Outline mode. After that, changing the prefix key requires manipulating keymaps. (defvar outline-minor-mode-prefix "@" (#$ . -6639)) (byte-code "ÀÁ!„ÂÁ B „\"Ä Å Æ#ˆÅ  #ˆÊ ž„1Ê B B ‡" [boundp outline-minor-mode-map nil current-load-list make-sparse-keymap define-key [menu-bar] outline-mode-menu-bar-map outline-minor-mode-prefix outline-mode-prefix-map outline-minor-mode minor-mode-map-alist] 4) #@166 Toggle Outline minor mode. With arg, turn Outline minor mode on if arg is positive, off otherwise. See the command `outline-mode' for more information on this mode. (defalias 'outline-minor-mode #[(&optional arg) "„ ?‚Â!ÃV‰ƒÄÆÇ!ˆ‚È „(ÉedÊ#ˆË ‡" [arg outline-minor-mode prefix-numeric-value 0 t selective-display run-hooks outline-minor-mode-hook nil outline-flag-region 10 force-mode-line-update] 5 (#$ . 7180) "P"]) #@130 Function of no args to compute a header's nesting level in an outline. It can assume point is at the beginning of a header line. (defvar outline-level (quote outline-level) (#$ . 7618)) #@188 Return the depth to which a statement is nested in the outline. Point must be at the beginning of a header line. This is actually the number of characters that `outline-regexp' matches. (defalias 'outline-level #[nil "ŠÀ !ˆÂ•Â”Z)‡" [looking-at outline-regexp 0] 2 (#$ . 7811)]) #@140 Skip forward to just before the next heading line. If there's no following heading line, stop before the newline at the end of the buffer. (defalias 'outline-next-preface #[nil "ÀÁ\nÃQÄÅ#ƒÆ”bˆhÇ>…Èu‡" [re-search-forward "[\n ]\\(" outline-regexp "\\)" nil move 0 (10 13) -1] 4 (#$ . 8097)]) #@53 Move to the next (possibly invisible) heading line. (defalias 'outline-next-heading #[nil "ÀÁ\nÃQÄÅ#…Æ”Tb‡" [re-search-forward "[\n ]\\(" outline-regexp "\\)" nil move 0] 4 (#$ . 8398) nil]) #@114 Move to previous heading line, or beg of this line if it's a heading. Only visible heading lines are considered. (defalias 'outline-back-to-heading #[nil "ÀyˆÁ †ÂÃ\fÅQÆÇ#†ÈÉ!‡" [0 outline-on-heading-p re-search-backward "^\\(" outline-regexp "\\)" nil t error "before first heading"] 4 (#$ . 8598)]) #@51 Return t if point is on a (visible) heading line. (defalias 'outline-on-heading-p #[nil "ŠÀyˆn… Á\n!)‡" [0 looking-at outline-regexp] 2 (#$ . 8908)]) (defalias 'outline-end-of-heading #[nil "À ÂÃ#…\nÄu‡" [re-search-forward outline-heading-end-regexp nil move -1] 4]) #@178 Move to the next visible heading line. With argument, repeats or can move backward if negative. A heading line is one that starts with a `*' (or that `outline-regexp' matches). (defalias 'outline-next-visible-heading #[(arg) "ÁWƒ\fÁyˆ‚ˆÃÄ ÆQÂÇ$„ÈÉ!ˆÁyˆÂ‡" [arg 0 nil re-search-forward "^\\(" outline-regexp "\\)" t error ""] 5 (#$ . 9184) "p"]) #@173 Move to the previous heading line. With argument, repeats or can move forward if negative. A heading line is one that starts with a `*' (or that `outline-regexp' matches). (defalias 'outline-previous-visible-heading #[(arg) "À [!‡" [outline-next-visible-heading arg] 2 (#$ . 9545) "p"]) #@169 Hides or shows lines from FROM to TO, according to FLAG. If FLAG is `\n' (newline character) then text is shown, while if FLAG is `\^M' (control-M) the text is hidden. (defalias 'outline-flag-region #[(from to flag) "À \f ÆUƒÇ‚Æ È%)‡" [nil buffer-read-only subst-char-in-region from to flag 10 13 t] 6 (#$ . 9839)]) #@48 Hide the body directly following this heading. (defalias 'hide-entry #[nil "À ˆÁ ˆŠÂ`à ˆ`Ä#)‡" [outline-back-to-heading outline-end-of-heading outline-flag-region outline-next-preface 13] 4 (#$ . 10167) nil]) #@48 Show the body directly following this heading. (defalias 'show-entry #[nil "ŠÀ`Á ˆ`Â#)‡" [outline-flag-region outline-next-preface 10] 4 (#$ . 10382) nil]) #@37 Hide all of buffer except headings. (defalias 'hide-body #[nil "Àed\"‡" [hide-region-body] 3 (#$ . 10544) nil]) #@54 Hide all body lines in the region, but not headings. (defalias 'hide-region-body #[(start end) "ŠŒ }ˆebˆÂ ƒà ˆm?…6Ä`Å ˆ`Æ#ˆm„ÇÈ!ƒ-É‚.ÊuˆÃ ˆ‚*‡" [start end outline-on-heading-p outline-end-of-heading outline-flag-region outline-next-preface 13 looking-at "[\n ][\n ]" 2 1] 4 (#$ . 10662)]) #@37 Show all of the text in the buffer. (defalias 'show-all #[nil "ÀedÁ#‡" [outline-flag-region 10] 4 (#$ . 10967) nil]) #@54 Hide everything after this heading at deeper levels. (defalias 'hide-subtree #[nil "ÀÁ!‡" [outline-flag-subtree 13] 2 (#$ . 11090) nil]) #@52 Hide all body after this heading at deeper levels. (defalias 'hide-leaves #[nil "À ˆÁ ˆÂ`à ˆ`\"‡" [outline-back-to-heading outline-end-of-heading hide-region-body outline-end-of-subtree] 3 (#$ . 11233) nil]) #@54 Show everything after this heading at deeper levels. (defalias 'show-subtree #[nil "ÀÁ!‡" [outline-flag-subtree 10] 2 (#$ . 11447) nil]) #@72 Hide everything but the top LEVELS levels of headers, in whole buffer. (defalias 'hide-sublevels #[(levels) "ÁWƒ\nÂÃ!ˆSŠebˆoƒÄ „Å …@ŠÆ ˆ`)È`É#ˆÊVƒ8Ë!ˆbˆ)‚)‡" [levels 1 error "Must keep at least one level of headers" outline-on-heading-p outline-next-heading outline-end-of-subtree end outline-flag-region 13 0 show-children] 4 (#$ . 11590) "p"]) #@70 Hide everything except for the current body and the parent headings. (defalias 'hide-other #[nil "ÀÁ!ˆ``ŠÄÅÆÇ#…gÈ=)…7ŠÉyˆ `=ƒ.Ê ˆË `Ì#ˆ‚3Í ˆ`)‚*‡" [hide-sublevels 1 pos last re-search-backward "[\n ]" nil t 13 0 outline-next-heading outline-flag-region 10 show-children] 4 (#$ . 11962) nil]) (defalias 'outline-flag-subtree #[(flag) "ŠÀ ˆÁ ˆÂ`à ˆ`\f#)‡" [outline-back-to-heading outline-end-of-heading outline-flag-region outline-end-of-subtree flag] 4]) (defalias 'outline-end-of-subtree #[nil "À ˆ`Á\n m„!\f„\n Vƒ!ÆÇ ˆ‚\nhÈ>…2ÉuˆhÊ>…2Éu+‡" [outline-back-to-heading t outline-level level first opoint nil outline-next-heading (10 13) -1 (10 13)] 3]) #@61 Show all subheadings of this heading, but not their bodies. (defalias 'show-branches #[nil "ÀÁ!‡" [show-children 1000] 2 (#$ . 12641) nil]) #@183 Show all direct subheadings of this heading. Prefix arg LEVEL is how many levels below the current level should be shown. Default is enough to cause the following heading to appear. (defalias 'show-children #[(&optional level) "ƒ\nÁ!‚#ŠÂ ˆ Å ˆmƒÆ‚\"Æ \fZ]*ŠŒÂ ˆ \\`Ç ˆmƒ:d‚<`T}ˆebˆm?…qÅ ˆm?…q XƒAŠÈŠÉuˆhÊ>ƒdÉuˆ`)Ë ˆ`Ì#ˆ)‚A*‡" [level prefix-numeric-value outline-back-to-heading outline-level start-level outline-next-heading 1 outline-end-of-subtree outline-flag-region -1 (10 13) outline-end-of-heading 10] 4 (#$ . 12788) "P"]) #@104 Move to the heading line of which the present line is a subheading. With argument, move up ARG levels. (defalias 'outline-up-heading #[(arg) "À ˆ Â=ƒÃÄ!ˆ ÂV…; ÆV…;o?…;  W„3ÈÂ!ˆ‚$ ÂZ)‚‡" [outline-back-to-heading outline-level 1 error "" arg 0 present-level outline-previous-visible-heading] 2 (#$ . 13347) "p"]) #@128 Move forward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading. (defalias 'outline-forward-same-level #[(arg) "À ˆ ÂV…%ŠÃ )‰ƒ\fbˆ S‚!ÂÅÆ!ˆ)‚‡" [outline-back-to-heading arg 0 outline-get-next-sibling point-to-move-to error ""] 3 (#$ . 13683) "p"]) #@74 Move to next heading of the same level, and return point or nil if none. (defalias 'outline-get-next-sibling #[nil " ÂÃ!ˆ Vƒm„ÂÃ!ˆ‚ W?…\"`)‡" [outline-level level outline-next-visible-heading 1] 2 (#$ . 14008)]) #@129 Move backward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading. (defalias 'outline-backward-same-level #[(arg) "À ˆ ÂV…%ŠÃ )‰ƒ\fbˆ S‚!ÂÅÆ!ˆ)‚‡" [outline-back-to-heading arg 0 outline-get-last-sibling point-to-move-to error ""] 3 (#$ . 14240) "p"]) #@74 Move to next heading of the same level, and return point or nil if none. (defalias 'outline-get-last-sibling #[nil " ÂÃ!ˆ Vƒo„ÂÃ!ˆ‚ W?…\"`)‡" [outline-level level outline-previous-visible-heading 1] 2 (#$ . 14567)]) (provide (quote outline)) emacs-19.30/lisp/page-ext.elc100666 13437 1 27363 5744577060 14461 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:47:58 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/page-ext.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/page-ext.el' was compiled for Emacs 19")) #@68 *If non-nil, `pages-directory-goto' narrows pages buffer to entry. (defvar pages-directory-buffer-narrowing-p t (#$ . -485)) #@63 *If non-nil, `add-new-page' narrows page buffer to new entry. (defvar pages-directory-for-adding-page-narrowing-p t (#$ . -616)) #@67 *If non-nil, `add-new-page' inserts new page before current page. (defvar pages-directory-for-adding-new-page-before-current-page-p t (#$ . -751)) #@126 *Standard name for file of addresses. Entries separated by page-delimiter. Used by `pages-directory-for-addresses' function. (defvar pages-addresses-file-name "~/addresses" (#$ . -905)) #@72 *If non-nil, `pages-directory-goto' narrows addresses buffer to entry. (defvar pages-directory-for-addresses-goto-narrowing-p t (#$ . -1097)) #@65 *If nil, `pages-directory-for-addresses' deletes other windows. (defvar pages-directory-for-addresses-buffer-keep-windows-p t (#$ . -1245)) #@68 *If non-nil, `add-new-page' narrows addresses buffer to new entry. (defvar pages-directory-for-adding-addresses-narrowing-p t (#$ . -1391)) (global-unset-key "") #@65 Keymap for subcommands of C-x C-p, which are for page handling. (defvar ctl-x-ctl-p-map (make-sparse-keymap) (#$ . 1561)) (byte-code "À ÂÃ#ˆÃ\fMˆÀ\fÅÆ#ˆÀ\fÂÇ#ˆÀ\fÈÉ#ˆÀ\fÊË#ˆÀ\fÌÍ#ˆÀ\fÎÏ#ˆÀ\fÐÑ#ˆÀ\fÒÓ#ˆÀ\fÔÕ#‡" [define-key ctl-x-map "" ctl-x-ctl-p-prefix ctl-x-ctl-p-map "" next-page previous-page "" add-new-page " " mark-page "" search-pages "s" sort-pages-buffer "\f" set-page-delimiter "" pages-directory "d" pages-directory-for-addresses] 4) #@121 Move to the next page bounded by the `page-delimiter' variable. With arg (prefix if interactive), move that many pages. (defalias 'next-page #[(&optional count) "„Á~ˆÂVƒ$m„$Ã\fÅÆ#„dbˆS‰‚ ÁWƒGo„GÇ\fÅÆ#ƒ=”bˆ‚@ebˆT‰‚%È ˆebˆÉÂ!‡" [count 1 0 re-search-forward page-delimiter nil t re-search-backward narrow-to-page recenter] 5 (#$ . 2019) "p"]) #@125 Move to the previous page bounded by the `page-delimiter' variable. With arg (prefix if interactive), move that many pages. (defalias 'previous-page #[(&optional count) "„ÁÂ[!‡" [count 1 next-page] 2 (#$ . 2387) "p"]) #@563 Insert new page. Prompt for header line. If point is in the pages directory buffer, insert the new page in the buffer associated with the directory. Insert the new page just before current page if pages-directory-for-adding-new-page-before-current-page-p variable is non-nil. Else insert at exact location of point. Narrow to new page if pages-directory-for-adding-page-narrowing-p variable is non-nil. Page begins with a `^L' as the default page-delimiter. Use \[set-page-delimiter] to change the page-delimiter. Point is left in the body of page. (defalias 'add-new-page #[(header-line) "~ˆÁ=ƒ\nƒà ˆ‚à ˆÄ ˆm„Åyˆ~ˆ\nƒOÆÈÉ#ƒ5Ê”bˆ‚OebˆËÌÍ!@Î=…IÏÈO\"cˆebˆÐÑ!„XÏyˆËÒÍ!@Î=…iÏÈO#cˆÅyˆ…xÕ ‡" [major-mode pages-directory-mode pages-directory-for-adding-new-page-before-current-page-p pages-directory-goto forward-page -1 re-search-backward page-delimiter nil t 0 format "%s\n" read-from-string ^ 1 looking-at "^." "%s\n%s\n\n\n" header-line pages-directory-for-adding-page-narrowing-p narrow-to-page] 5 (#$ . 2617) "sHeader line: "]) #@53 Value of last regexp searched for. Initially, nil. (defvar pages-last-search nil (#$ . 3693)) #@70 Search for REGEXP, starting from point, and narrow to page it is in. (defalias 'search-pages #[(regexp) "Ášƒ \n‚ ~ˆÃ!ˆÄ ‡" [regexp "" pages-last-search re-search-forward narrow-to-page] 2 (#$ . 3794) (list (read-string (format "Search for `%s' (end with RET): " (or pages-last-search "regexp"))))]) #@31 Primary function for sorting. (autoload (quote sort-subr) "sort" '(#$ . 4106) t nil) #@193 Sort pages in region alphabetically. Prefix arg means reverse order. Called from a program, there are three arguments: REVERSE (non-nil means reverse order), BEG and END (region to sort). (defalias 'sort-pages-in-region #[(reverse beg end) "Œ }ˆebˆÂ ÄÅ#)‡" [beg end sort-subr reverse #[nil "À ÂÃ#ˆÄÂw‡" [re-search-forward page-delimiter nil t " \n"] 4] #[nil "À ÂÃ#ƒ\fÄ”b‡db‡" [re-search-forward page-delimiter nil t 0] 4]] 4 (#$ . 4198) "P\nr"]) #@106 Sort pages alphabetically in buffer. Prefix arg means reverse order. (Non-nil arg if not interactive.) (defalias 'sort-pages-buffer #[(&optional reverse) "„Á~ˆedÄ \n#*‡" [reverse nil end beginning sort-pages-in-region] 4 (#$ . 4659) "P"]) #@154 Value of previous regexp used by `pages-directory'. (This regular expression may be used to select only those pages that contain matches to the regexp.) (defvar pages-directory-previous-regexp nil (#$ . 4914)) #@74 The buffer for which the pages-directory function creates the directory. (defvar pages-buffer nil (#$ . 5130)) #@57 Prefix of name of temporary buffer for pages-directory. (defvar pages-directory-prefix "*Directory for:" (#$ . 5247)) #@65 List containing the positions of the pages in the pages-buffer. (defvar pages-pos-list nil (#$ . 5371)) #@40 Keymap for the pages-directory-buffer. (defvar pages-directory-map nil (#$ . 5481)) (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÁ‡" [pages-directory-map make-sparse-keymap define-key "" pages-directory-goto "" add-new-page] 4) #@25 Default page delimiter. (defvar original-page-delimiter "^\f" (#$ . 5706)) #@262 Set buffer local value of page-delimiter to REGEXP. Called interactively with a prefix argument, reset `page-delimiter' to its original value. In a program, non-nil second arg causes first arg to be ignored and resets the page-delimiter to the original value. (defalias 'set-page-delimiter #[(regexp reset-p) "ÀÁ!ˆÀÂ!ˆ † \n „\f‚ t…!ÅÆ\n\"‡" [make-local-variable original-page-delimiter page-delimiter reset-p regexp message "The value of `page-delimiter' is now: %s"] 3 (#$ . 5788) (byte-code "ƒ ÂD‡ÃÄ \"ÆD‡" [current-prefix-arg original-page-delimiter "^\f" read-string "Set page-delimiter to regexp: " page-delimiter nil] 3)]) #@1089 Display a directory of the page headers in a temporary buffer. A header is the first non-blank line after the page-delimiter. \[pages-directory-mode] You may move point to one of the lines in the temporary buffer, then use \ to go to the same line in the pages buffer. In interactive use: 1. With no prefix arg, display all headers. 2. With prefix arg, display the headers of only those pages that contain matches to a regular expression for which you are prompted. 3. With numeric prefix arg, for every page, print the number of lines within each page. 4. With negative numeric prefix arg, for only those pages that match a regular expression, print the number of lines within each page. When called from a program, non-nil first arg means list all headers; non-nil second arg means print numbers of lines in each page; if first arg is nil, optional third arg is regular expression. If the buffer is narrowed, the `pages-directory' command creates a directory for only the accessible portion of the buffer. (defalias 'pages-directory #[(pages-list-all-headers-p count-lines-p &optional regexp) "Ášƒ \n‚ tƒÃÄÅ \"ˆpÇÅ QÈ`É\n \f  ŠqˆÐ ˆÑÒ±ˆÔ)ƒŠebˆŒŠ×ÔÙ#)ƒcÉ”ÈUƒcÉ•bˆÚ ˆÛ!ˆ)×ÔÙ#ƒ}Û!ˆ‚l)‚ºŠebˆŒÚ ˆŠ×ÔÙ#)ƒ˜Û!ˆ)×ÔÙ#ƒ¹ŒÚ ˆŠ×ÔÙ#)ƒµÛ!ˆ)‚™)qˆŸt…ÑÃÝGÅ!#‘ˆÞ !ˆßÉ!ˆ\nÉUƒçÈ‚é\ny-‡" [regexp "" pages-directory-previous-regexp message "Creating directory for: %s " buffer-name pages-directory-prefix " " 1 0 pages-buffer-original-page pages-buffer-original-position linenum pages-directory-buffer target-buffer standard-output pages-directory-mode "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" 10 pages-buffer nil pages-pos-list pages-list-all-headers-p re-search-forward page-delimiter t narrow-to-page pages-copy-header-and-position count-lines-p "%d matching lines in: %s" pop-to-buffer sit-for] 6 (#$ . 6438) (byte-code "„ Á‰E‡<ƒ‰ÃÄņÇ\"!E‡È!ÉVƒ*Á‰ÂE‡È!ÉW…@ÂÁÃÄņ=Ç\"!E‡" [current-prefix-arg t nil read-string format "Select according to `%s' (end with RET): " pages-directory-previous-regexp "regexp" prefix-numeric-value 0] 6)]) #@159 Copy page header and its position to the Pages Directory. Only arg non-nil, count lines in page and insert before header. Used by `pages-directory' function. (defalias 'pages-copy-header-and-position #[(count-lines-p) "À‰ ƒŠŒÄ ˆÅed\"*`XƒTŠÈÀwˆÉ ‰`À“ˆ`ŠÀˆ`)\n \fqˆ\n B Î \n#ˆ* ƒZŠÐyˆÑÒ \"cˆ)Ó ˆ)Ô*‡" [nil line-count position count-lines-p narrow-to-page count-lines pages-buffer-original-position pages-buffer-original-page " \n" make-marker end start standard-output pages-pos-list insert-buffer-substring target-buffer 0 format "%3d: " terpri 1] 5 (#$ . 8659)]) #@172 Mode for handling the pages-directory buffer. Move point to one of the lines in this buffer, then use \[pages-directory-goto] to go to the same line in the pages buffer. (defalias 'pages-directory-mode #[nil "À ˆÁ\n!ˆÃÅÇÈ!ˆÇÉ!ˆÇÊ!‡" [kill-all-local-variables use-local-map pages-directory-map pages-directory-mode major-mode "Pages-Directory" mode-name make-local-variable pages-buffer pages-pos-list pages-directory-buffer-narrowing-p] 2 (#$ . 9256)]) #@51 Go to the corresponding line in the pages buffer. (defalias 'pages-directory-goto #[nil "ƒ\nÁ!„ÂÂÄÅ!ˆÆyˆÇe`\"S‰ 8 m\n \fÍ!ˆ~ˆ\nƒ9dbˆ‚?Î !bˆ\f…FÏ ,‡" [pages-buffer buffer-name nil pages-pos-list error "Buffer in which pages were found is deleted." 0 count-lines pages-number pos end-of-directory-p pages-directory-buffer-narrowing-p narrowing-p pop-to-buffer marker-position narrow-to-page] 4 (#$ . 9719) nil]) #@657 Find addresses file and display its directory. By default, create and display directory of `pages-addresses-file-name'. Optional argument is FILENAME. In interactive use, with prefix argument, prompt for file name and provide completion. Move point to one of the lines in the displayed directory, then use \[pages-directory-goto] to go to the same line in the addresses buffer. If pages-directory-for-addresses-goto-narrowing-p is non-nil, `pages-directory-goto' narrows addresses buffer to entry. If pages-directory-for-addresses-buffer-keep-windows-p is nil, this command deletes other windows when it displays the addresses directory. (defalias 'pages-directory-for-addresses #[(&optional filename) "tƒ ÀÁ\n† \"ˆÄ\n† !ƒNÅÆ\n† !!qˆ~ˆÇÈɉ#ˆÊ ˆ \f „9Î ˆŠebˆ`ŠÉˆ`)|ˆÏcˆÐÉ!)‡ÑÒ!‡" [message "Creating directory for: %s " filename pages-addresses-file-name file-exists-p find-file-noselect expand-file-name pages-directory t nil pages-directory-address-mode pages-directory-for-addresses-goto-narrowing-p pages-directory-buffer-narrowing-p pages-directory-for-addresses-buffer-keep-windows-p delete-other-windows "=== Address List Directory: use `C-c C-c' to go to page under cursor. ===" set-buffer-modified-p error "No addresses file found!"] 4 (#$ . 10156) (list (if current-prefix-arg (read-file-name "Filename: " pages-addresses-file-name)))]) #@176 Mode for handling the Addresses Directory buffer. Move point to one of the lines in this buffer, then use \[pages-directory-goto] to go to the same line in the pages buffer. (defalias 'pages-directory-address-mode #[nil "À !ˆÂÄÆÇ!ˆÆÈ!ˆÆÉ!‡" [use-local-map pages-directory-map pages-directory-address-mode major-mode "Addresses Directory" mode-name make-local-variable pages-buffer pages-pos-list pages-directory-buffer-narrowing-p] 2 (#$ . 11539)]) (provide (quote page-ext)) emacs-19.30/lisp/page.elc100666 13437 1 5020 5744577062 13627 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:48:00 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/page.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/page.el' was compiled for Emacs 19")) #@156 Move forward to page boundary. With arg, repeat, or go back if negative. A page boundary is any line whose beginning matches the regexp `page-delimiter'. (defalias 'forward-page #[(&optional count) "„ÁÂVƒ)m„)nƒÁuˆÃ\fÅÆ#„\"dbˆS‰‚ÂW…go?…gÇuˆÅ` Ê\fÅÆ#‰ ƒP•U„= ƒ\\•bˆ‚_ebˆ*T‰‚*‡" [count 1 0 re-search-forward page-delimiter nil t -1 end result re-search-backward] 5 (#$ . 478) "p"]) #@156 Move backward to page boundary. With arg, repeat, or go fwd if negative. A page boundary is any line whose beginning matches the regexp `page-delimiter'. (defalias 'backward-page #[(&optional count) "„ÁÂ[!‡" [count 1 forward-page] 2 (#$ . 898) "p"]) #@182 Put mark at end of page, point at beginning. A numeric arg specifies to move forward or backward by that many pages, thus marking a page other than the one point was originally in. (defalias 'mark-page #[(&optional arg) "ƒ\nÁ!‚ ‰ÂVƒÃ!ˆ‚$ÂWƒ$ÃS!ˆÃ ˆÄÅƉ#ˆÃÇ!‡" [arg prefix-numeric-value 0 forward-page push-mark nil t -1] 5 (#$ . 1161) "P"]) #@179 Make text outside current page invisible. A numeric arg specifies to move forward or backward by that many pages, thus showing a page other than the one point was originally in. (defalias 'narrow-to-page #[(&optional arg) "ƒ\nÁ!‚ Š~ˆÂVƒÃ!ˆ‚'ÂWƒ'ÃS!ˆÃ ˆŠÂ”bˆÄ !)ƒ9Âyˆ`ÃÆ!ˆlƒIo„IÇyˆ`})‡" [arg prefix-numeric-value 0 forward-page looking-at page-delimiter -1 1] 3 (#$ . 1522) "P"]) (put (quote narrow-to-page) (quote disabled) t) #@81 Report number of lines on current page, and how many are before or after point. (defalias 'count-lines-page #[nil "Š`À‰‰‰‰Ç ˆÈyˆÉ\n!„Àˆ`Ë ˆ`Ì \f\"Ì \"Ì\f\"ÍÎ \n $.‡" [nil after before total end beg opoint forward-page 0 looking-at page-delimiter backward-page count-lines message "Page has %d lines (%d + %d)"] 6 (#$ . 1972) nil]) #@38 Print page and line number of point. (defalias 'what-page #[nil "Œ~ˆŠÀyˆÁ`ÁbˆÄ \nÆ#ƒ T‚ÇÈ É`\n\"T#,‡" [0 1 opoint count re-search-forward page-delimiter t message "Page %d, line %d" count-lines] 6 (#$ . 2330) nil]) (provide (quote page)) emacs-19.30/lisp/paragraphs.elc100666 13437 1 17170 6012166055 15055 0ustar jimbdaemon;ELC ;;; compiled by kwzh@nutrimat.gnu.ai.mit.edu on Wed Aug 9 13:11:01 1995 ;;; from file /home/gd/gnu/emacs/19.0/lisp/paragraphs.el ;;; emacs version 19.29.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`paragraphs.el' was compiled for Emacs 19.29 or later")) #@486 Non-nil means to distinguish hard and soft newlines. When this is non-nil, the functions `newline' and `open-line' add the text-property `hard' to newlines that they insert. Also, a line is only considered as a candidate to match `paragraph-start' or `paragraph-separate' if it follows a hard newline. Newlines not marked hard are called "soft", and are always internal to paragraphs. The fill functions always insert soft newlines. Each buffer has its own value of this variable. (defvar use-hard-newlines nil (#$ . 490)) (make-variable-buffer-local (quote use-hard-newlines)) #@715 *Regexp for beginning of a line that starts OR separates paragraphs. This regexp should match lines that separate paragraphs and should also match lines that start a paragraph (and are part of that paragraph). This is matched against the text at the left margin, which is not necessarily the beginning of the line, so it should never use "^" as an anchor. This ensures that the paragraph functions will work equally well within a region of text indented by a margin setting. The variable `paragraph-separate' specifies how to distinguish lines that start paragraphs from lines that separate them. If the variable `use-hard-newlines' is nonnil, then only lines following a hard newline are considered to match. (defconst paragraph-start "[ \n\f]" (#$ . -1079)) #@385 *Regexp for beginning of a line that separates paragraphs. If you change this, you may have to change paragraph-start also. This is matched against the text at the left margin, which is not necessarily the beginning of the line, so it should not use "^" as an anchor. This ensures that the paragraph functions will work equally within a region of text indented by a margin setting. (defconst paragraph-separate "[ \f]*$" (#$ . -1851)) #@295 *Regexp describing the end of a sentence. All paragraph boundaries also end sentences, regardless. In order to be recognized as the end of a sentence, the ending period, question mark, or exclamation point must be followed by two spaces, unless it's inside some sort of quotes or parenthesis. (defconst sentence-end (purecopy "[.?!][]\"')}]*\\($\\| $\\| \\| \\)[ \n]*") (#$ . -2296)) #@57 *Regexp describing line-beginnings that separate pages. (defconst page-delimiter "^\f" (#$ . -2689)) #@148 Non-nil means the paragraph commands are not affected by `fill-prefix'. This is desirable in modes where blank lines are the paragraph delimiters. (defvar paragraph-ignore-fill-prefix nil (#$ . 2797)) #@410 Move forward to end of paragraph. With arg N, do it N times; negative arg -N means move backward N paragraphs. A line which `paragraph-start' matches either separates paragraphs (if `paragraph-separate' matches it also) or is the first line of a paragraph. A paragraph end is the beginning of a line which is not part of the paragraph to which the end of the previous line belongs, or the end of the buffer. (defalias 'forward-paragraph #[(&optional arg) "„Á\n…\nÚ?…\f?…Å\n!Ú„3ÈHÉšƒ3ÁÊO‚5‰Ú„N ÈHÉšƒN ÁÊO‚P  ƒa ÌÍR‚c  ÎÏQÊÈWƒvo„vÒ !„’ÓÔ`Se]Õ#ƒ’Ò !„o`ÖuˆÈyˆo„¯× ˆÒ !ƒ¯Öyˆ‚›o„oʈƒþÊÈyˆo„æ× ˆÒ !„æÒ!ƒæ`U„àÕÖyˆ‚¾× ˆÒ!„øƒøÁyˆo)?‚7ÓÊÁ#ƒ4o„4`× ˆÒ !„4Ò!ƒ-ƒ4ÚSÛ\"„4bˆ‚þ`eVƒlm„N× ˆÒ !ƒNÁyˆ‚:ȈiÜ Vƒ^Áuˆ‚oÝÊxˆn„oÁyˆ‚oebˆT‰‚pÈV…m?…m?…’× ˆm?…’Ò !Áyˆ„ƒ¼m„ÿ× ˆm„ÿÒ !„ÿÒ!ƒÿÁyˆ‚ÞÊÁ#ƒõÈ”‰bˆm„õ× ˆÒ !„õÒ!ƒïƒõÚSÛ\"„õÁuˆ‚¼`dWƒÿbˆS‰‚w.‡" [arg 1 fill-prefix "" paragraph-ignore-fill-prefix regexp-quote fill-prefix-regexp paragraph-start 0 94 nil paragraph-separate "\\|" "[ ]*$" "^[ ]*\\(" "\\)" sp-paragraph-start start looking-at re-search-backward "^\n" t -1 move-to-left-margin multiple-lines use-hard-newlines get-text-property hard current-left-margin " " re-search-forward] 5 (#$ . 3005) "p"]) #@427 Move backward to start of paragraph. With arg N, do it N times; negative arg -N means move forward N paragraphs. A paragraph start is the beginning of a line which is a `first-line-of-paragraph' or which is ordinary text and follows a paragraph-separating line; except: if the first real line of a paragraph is preceded by a blank line, the paragraph starts at that blank line. See `forward-paragraph' for more information. (defalias 'backward-paragraph #[(&optional arg) "„ÁÂ[!‡" [arg 1 forward-paragraph] 2 (#$ . 4364) "p"]) #@126 Put point at beginning of this paragraph, mark at end. The paragraph marked is the one that contains point or follows point. (defalias 'mark-paragraph #[nil "ÀÁ!ˆÂÃĉ#ˆÅÁ!‡" [forward-paragraph 1 push-mark nil t backward-paragraph] 4 (#$ . 4905) nil]) #@148 Kill forward to end of paragraph. With arg N, kill forward to Nth end of paragraph; negative arg -N means kill backward to Nth start of paragraph. (defalias 'kill-paragraph #[(arg) "À`Á\n!ˆ`\"‡" [kill-region forward-paragraph arg] 4 (#$ . 5163) "p"]) #@143 Kill back to start of paragraph. With arg N, kill back to Nth start of paragraph; negative arg -N means kill forward to Nth end of paragraph. (defalias 'backward-kill-paragraph #[(arg) "À`Á\n!ˆ`\"‡" [kill-region backward-paragraph arg] 4 (#$ . 5421) "p"]) #@57 Interchange this (or next) paragraph with previous one. (defalias 'transpose-paragraphs #[(arg) "ÀÁ\n\"‡" [transpose-subr forward-paragraph arg] 3 (#$ . 5683) "*p"]) (defalias 'start-of-paragraph-text #[nil "`ÀÃÄ!ˆ`ÅÀwˆ`\nY…% \nW…% bˆ eV…%Æ *‡" [nil npoint opoint forward-paragraph -1 " \n" start-of-paragraph-text] 2]) (defalias 'end-of-paragraph-text #[nil "`ÁÂ!ˆhÃ=ƒÄuˆ`X… Âuˆ`dW… Å )‡" [opoint forward-paragraph 1 10 -1 end-of-paragraph-text] 2]) #@283 Move forward to next `sentence-end'. With argument, repeat. With negative argument, move backward repeatedly to `sentence-beginning'. The variable `sentence-end' is a regular expression that matches ends of sentences. Also, every paragraph boundary terminates sentences as well. (defalias 'forward-sentence #[(&optional arg) "„ÁÂWƒ1ŠÃ ˆ`)ÅÇP\fÈ#ƒ&•Sbˆ‚)\fbˆ)T‰‚ÂV…\\ŠÉ ˆ`)\nË\nÈ#ƒPÌÍxˆ‚T\nbˆ)S‰‚2‡" [arg 1 0 start-of-paragraph-text par-beg re-search-backward sentence-end "[^ \n]" t end-of-paragraph-text par-end re-search-forward " \n" nil] 5 (#$ . 6154) "p"]) #@110 Move backward to start of sentence. With arg, do it arg times. See `forward-sentence' for more information. (defalias 'backward-sentence #[(&optional arg) "„ÁÂ[!‡" [arg 1 forward-sentence] 2 (#$ . 6756) "p"]) #@113 Kill from point to end of sentence. With arg, repeat; negative arg -N means kill back to Nth start of sentence. (defalias 'kill-sentence #[(&optional arg) "À`Á\n!ˆ`\"‡" [kill-region forward-sentence arg] 4 (#$ . 6978) "p"]) #@121 Kill back from point to start of sentence. With arg, repeat, or kill forward to Nth end of sentence if negative arg -N. (defalias 'backward-kill-sentence #[(&optional arg) "À`Á\n!ˆ`\"‡" [kill-region backward-sentence arg] 4 (#$ . 7209) "p"]) #@67 Put mark at end of sentence. Arg works as in `forward-sentence'. (defalias 'mark-end-of-sentence #[(arg) "ÀŠÁ\n!ˆ`)ÃÄ#‡" [push-mark forward-sentence arg nil t] 4 (#$ . 7457) "p"]) #@48 Interchange this (next) and previous sentence. (defalias 'transpose-sentences #[(arg) "ÀÁ\n\"‡" [transpose-subr forward-sentence arg] 3 (#$ . 7644) "*p"]) emacs-19.30/lisp/paren.elc100666 13437 1 3546 6051027465 14020 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 00:05:52 1995 ;;; from file /home/fsf/rms/e19/lisp/paren.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`paren.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ B‡" [boundp show-paren-overlay nil current-load-list show-paren-overlay-1 show-paren-mismatch-face] 2) #@54 *Name of face to use for showing the matching paren. (defvar show-paren-face (quote region) (#$ . -621)) (defalias 'show-paren-command-hook #[nil "…7Á‰‰`\nhzÈ=ƒÉ‚'gzÊ=ƒ'˃§ŠŒ\fƒAe`\fZ]d`\f\\^}ˆÁÍΈƒl\f^\f]‰fzÑU„kSfÒf!=?* ƒ¦„—Ô ƒ—ÕÖ×\"ˆØ×!ˆÙ×Ú\"„”Û×Ü\"ˆÝ×Þ\"ˆ×ƒ¢‚¦ßà!ˆ*ƒÉUƒÛ!ƒÆâ!`\\`p$ˆ‚ÑãZ\"!ä!à #ˆ‚ì!ƒìå!!ƒìæ!!ˆ'ƒâ'Zp$ˆ‚\fãZ\"'ä'à #‚6'ƒ&å'!ƒ&æ'!ˆ!…6å!!…6æ!!-‡" [window-system nil show-paren-face face oldpos mismatch dir pos 41 -1 40 1 blink-matching-paren-distance (byte-code "À` \"À‡" [scan-sexps dir pos] 3) ((error)) end beg 36 matching-paren show-paren-mismatch-face x-display-color-p add-to-list facemenu-unlisted-faces paren-mismatch make-face face-nontrivial-p t set-face-background "purple" set-face-foreground "white" message "Paren mismatch" show-paren-overlay-1 move-overlay make-overlay overlay-put overlay-buffer delete-overlay show-paren-overlay] 6]) (byte-code "ƒ ÁÃÄÅ\"ˆÃÆÇ\"ˆÈÉ!‡" [window-system nil blink-paren-function add-hook post-command-idle-hook show-paren-command-hook window-setup-hook #[nil "…\nÁÃÄÅ\"‡" [window-system nil blink-paren-function add-hook post-command-idle-hook show-paren-command-hook] 3] provide paren] 3) emacs-19.30/lisp/pascal.elc100666 12120 1 75131 6045214235 14035 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:24:38 1995 ;;; from file /home/fsf/rms/e19/lisp/pascal.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`pascal.el' was compiled for Emacs 19.29 or later")) #@45 Abbrev table in use in Pascal-mode buffers. (defvar pascal-mode-abbrev-table nil (#$ . 472)) (define-abbrev-table (quote pascal-mode-abbrev-table) nil) #@29 Keymap used in Pascal mode. (defvar pascal-mode-map nil (#$ . 630)) (byte-code "„yÁ ÂÃÄ#ˆÂÅÄ#ˆÂÆÇ#ˆÂÈÉ#ˆÂÊË#ˆÂÌÍ#ˆÂÎÏ#ˆÂÐÑ#ˆÂÒÓ#ˆÂÔÕ#ˆÂÖ×#ˆÂØÙ#ˆÂÚÛ#ˆÂÜÝ#ˆÂÞß#ˆÂàá#ˆÂâã#ˆÂäå#ˆÂæç#ˆÁ‡" [pascal-mode-map make-sparse-keymap define-key ";" electric-pascal-semi-or-dot "." ":" electric-pascal-colon "=" electric-pascal-equal "#" electric-pascal-hash " " electric-pascal-terminate-line " " electric-pascal-tab "‰" pascal-complete-word "¿" pascal-show-completions "" backward-delete-char-untabify "ˆ" pascal-mark-defun "" pascal-insert-block "ª" pascal-star-comment "" pascal-comment-area "" pascal-uncomment-area "" pascal-beg-of-defun "…" pascal-end-of-defun "" pascal-goto-defun "" pascal-outline] 4) #@68 Imenu expression for Pascal-mode. See `imenu-generic-expression'. (defvar pascal-imenu-generic-expression (quote ("^[ ]*\\(function\\|procedure\\)[ \n]+\\([a-zA-Z0-9_.:]+\\)" 2)) (#$ . 1365)) (byte-code "ÀÁ!„ÂÁ BÄÅ BÆÇ BÈ É BÊ Ë BÌ Í BÎÏ BÐÑ BÒÓ BÔÕ BÖ× BØÙ BÀ‡" [boundp pascal-keywords ("and" "array" "begin" "case" "const" "div" "do" "downto" "else" "end" "file" "for" "function" "goto" "if" "in" "label" "mod" "nil" "not" "of" "or" "packed" "procedure" "program" "record" "repeat" "set" "then" "to" "type" "until" "var" "while" "with" "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write" "writeln") current-load-list "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>" pascal-symbol-re "\\<\\(begin\\|case\\|record\\|repeat\\)\\>" pascal-beg-block-re "\\<\\(end\\|until\\)\\>" pascal-end-block-re "\\<\\(const\\|label\\|type\\|var\\)\\>" pascal-declaration-re "\\<\\(function\\|procedure\\|program\\)\\>" pascal-defun-re "\\<\\(if\\|else\\|for\\|while\\|with\\)\\>" pascal-sub-block-re "\\<\\(begin\\|end\\|until\\|else\\)\\>" pascal-noindent-re "\\<\\(begin\\|repeat\\|then\\|do\\|else\\)\\>" pascal-nosemi-re "\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>" pascal-autoindent-lines-re "{-----\\/----- EXCLUDED -----\\/-----" pascal-exclude-str-start " -----/\\----- EXCLUDED -----/\\-----}" pascal-exclude-str-end] 2) #@45 Syntax table in use in Pascal-mode buffers. (defvar pascal-mode-syntax-table nil (#$ . 2758)) (byte-code "„gÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÄ#ˆÂÐÄ#ˆÂÑÄ#ˆÂÒÄ#ˆÂÓÄ#ˆÂÔÄ#ˆÂÕÄ#ˆÂÖÄ#ˆÂ×Ø#ˆÂÙÚ#ˆÁ‡" [pascal-mode-syntax-table make-syntax-table modify-syntax-entry 92 "." 40 "()1" 41 ")(4" 42 ". 23" 123 "<" 125 ">" 43 45 61 37 60 62 38 124 95 "w" 39 "\""] 4) #@53 Additional expressions to highlight in Pascal mode. (defvar pascal-font-lock-keywords (byte-code "ÀÁÂPÃBÄÅÆÇÈÉRʯ‡" [("^[ ]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ ]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|" "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>" font-lock-type-face ("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-reference-face) ("\\<\\([0-9]+\\)[ ]*:" 1 font-lock-reference-face) "\\<\\(" "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|" "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)" "\\)\\>" ("\\<\\(goto\\)\\>[ ]*\\([0-9]+\\)?" (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))] 8) (#$ . 3136)) #@69 *Indentation of Pascal statements with respect to containing block. (defvar pascal-indent-level 3 (#$ . -3907)) #@35 *Indentation for case statements. (defvar pascal-case-indent 2 (#$ . -4025)) #@92 *Non-nil means automatically newline after simcolons and the punctation mark after an end. (defvar pascal-auto-newline nil (#$ . -4108)) #@147 *Non-nil means TAB in Pascal mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. (defvar pascal-tab-always-indent t (#$ . -4252)) #@153 *Non-nil means a comment { ... } is set after the ends which ends cases and functions. The name of the function or case will be set between the braces. (defvar pascal-auto-endcomments t (#$ . -4454)) #@374 *List of contexts where auto lineup of :'s or ='s should be done. Elements can be of type: 'paramlist', 'declaration' or 'case', which will do auto lineup in parameterlist, declarations or case-statements respectively. The word 'all' will do all lineups. '(case paramlist) for instance will do lineup in case-statements and parameterlist, while '(all) will do all lineups. (defvar pascal-auto-lineup (quote (all)) (#$ . -4661)) #@280 *Non-nil means \\[pascal-complete-word] should try all possible completions one by one. Repeated use of \[pascal-complete-word] will show you all of them. Normally, when there is more than one possible completion, it displays a list of all possible completions. (defvar pascal-toggle-completions nil (#$ . -5096)) #@216 *Keywords for types used when completing a word in a declaration or parmlist. (eg. integer, real, char.) The types defined within the Pascal program will be completed runtime, and should not be added to this list. (defvar pascal-type-keywords (quote ("array" "file" "packed" "char" "integer" "real" "string" "record")) (#$ . -5434)) #@234 *Keywords to complete when standing at the first word of a statement. (eg. begin, repeat, until, readln.) The procedures and variables defined within the Pascal program will be completed runtime and should not be added to this list. (defvar pascal-start-keywords (quote ("begin" "end" "function" "procedure" "repeat" "until" "while" "read" "readln" "reset" "rewrite" "write" "writeln")) (#$ . -5775)) #@230 *Keywords to complete when NOT standing at the first word of a statement. (eg. downto, else, mod, then.) Variables and function names defined within the Pascal program are completed runtime and should not be added to this list. (defvar pascal-separator-keywords (quote ("downto" "else" "mod" "div" "then")) (#$ . -6183)) (defalias 'pascal-get-beg-of-line #[(&optional arg) "ŠÀ !ˆ`)‡" [beginning-of-line arg] 2]) (put (quote pascal-get-beg-of-line) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'pascal-get-end-of-line #[(&optional arg) "Šˆ`)‡" [arg] 1]) (put (quote pascal-get-end-of-line) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'pascal-declaration-end #[nil "À ÂV…-ÃĊň`)Æ#…-À”ƒ! T‰‚Å”ƒ S‰‚)‡" [1 nest 0 re-search-forward "[:=]\\|\\(\\\\)\\|\\(\\\\)" 2 t] 5]) (defalias 'pascal-declaration-beg #[nil "À ÂVƒ;ÃÄÂŠÆ !ˆ`*Ç#ƒ;À”ƒ#‰‚È”ƒ/ S‰‚É”ƒ T‰‚ ÂU)‡" [1 nest 0 re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\\\)\\|\\(\\\\)" arg beginning-of-line t 2 3] 5]) (defalias 'pascal-within-string #[nil "ŠÀÁÂŠÄ !ˆ`*`\"8)‡" [3 parse-partial-sexp nil arg beginning-of-line] 4]) (put (quote pascal-within-string) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@1971 Major mode for editing Pascal code. \ TAB indents for Pascal code. Delete converts tabs to spaces as it moves back. \[pascal-complete-word] completes the word around current point with respect to position in code \[pascal-show-completions] shows all possible completions at this point. Other useful functions are: \[pascal-mark-defun] - Mark function. \[pascal-insert-block] - insert begin ... end; \[pascal-star-comment] - insert (* ... *) \[pascal-comment-area] - Put marked area in a comment, fixing nested comments. \[pascal-uncomment-area] - Uncomment an area commented with \[pascal-comment-area]. \[pascal-beg-of-defun] - Move to beginning of current function. \[pascal-end-of-defun] - Move to end of current function. \[pascal-goto-defun] - Goto function prompted for in the minibuffer. \[pascal-outline] - Enter pascal-outline-mode (see also pascal-outline). Variables controlling indentation/edit style: pascal-indent-level (default 3) Indentation of Pascal statements with respect to containing block. pascal-case-indent (default 2) Indentation for case statements. pascal-auto-newline (default nil) Non-nil means automatically newline after simcolons and the punctation mark after an end. pascal-tab-always-indent (default t) Non-nil means TAB in Pascal mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. pascal-auto-endcomments (default t) Non-nil means a comment { ... } is set after the ends which ends cases and functions. The name of the function or case will be set between the braces. pascal-auto-lineup (default t) List of contexts where auto lineup of :'s or ='s hould be done. See also the user variables pascal-type-keywords, pascal-start-keywords and pascal-separator-keywords. Turning on Pascal mode calls the value of the variable pascal-mode-hook with no args, if that value is non-nil. (defalias 'pascal-mode #[nil "À ˆÁ\n!ˆÃÅÉ\n!ˆËÌ!ˆÍ\fÎËÐ!ˆÑËÒ!ˆÓËÔ!ˆÕËÖ!ˆ×ËØ!ˆÙËÚ!ˆÛËÜ!ˆÞß!‡" [kill-all-local-variables use-local-map pascal-mode-map pascal-mode major-mode "Pascal" mode-name pascal-mode-abbrev-table local-abbrev-table set-syntax-table pascal-mode-syntax-table make-local-variable indent-line-function pascal-indent-line pascal-indent-comment comment-indent-function parse-sexp-ignore-comments nil case-fold-search t comment-start "{" comment-start-skip "(\\*+ *\\|{ *" comment-end "}" font-lock-defaults (pascal-font-lock-keywords nil t) imenu-generic-expression pascal-imenu-generic-expression run-hooks pascal-mode-hook] 2 (#$ . 7500) nil]) #@38 Terminate line and indent next line. (defalias 'electric-pascal-terminate-line #[nil "ŠÀyˆÁÂwˆÃ\f!ƒÅ ˆ)Æ ˆÇ ˆÅ ˆƒ#É ˆÂ\nŠËyˆÁÂwˆÃÌ!ƒ=ÍuˆÆ ˆ‚YÃÎ!ƒYŠÏЊˆ`*Ò#)„YÒ\n)\n„dÅ ‚fÓc)‡" [0 " " nil looking-at pascal-autoindent-lines-re pascal-indent-line delete-horizontal-space newline pascal-auto-endcomments pascal-set-auto-comments setstar -1 "\\*[ ]+)" 1 "(\\*\\|\\*[^)]" search-forward "*)" arg t "* "] 4 (#$ . 10163) nil]) #@52 Insert `;' or `.' character and reindent the line. (defalias 'electric-pascal-semi-or-dot #[nil "cˆŠÁyˆÂ ˆ) …Ä ‡" [last-command-char 0 pascal-indent-line pascal-auto-newline electric-pascal-terminate-line] 1 (#$ . 10611) nil]) #@67 Insert `:' and do all indentions except line indent on this line. (defalias 'electric-pascal-colon #[nil "cˆŠÁÂÊÅ\f!ˆ`*`\"8)?…%ŠÆyˆÇ ˆ)ÃÉ )‡" [last-command-char 3 parse-partial-sexp nil arg beginning-of-line 0 pascal-indent-line pascal-tab-always-indent pascal-indent-command] 4 (#$ . 10847) nil]) #@58 Insert `=', and do indention if within type declaration. (defalias 'electric-pascal-equal #[nil "cˆÁ @Â=…ÃÅ )‡" [last-command-char pascal-calculate-indent declaration nil pascal-tab-always-indent pascal-indent-command] 2 (#$ . 11157) nil]) #@64 Insert `#', and indent to coulmn 0 if this is a CPP directive. (defalias 'electric-pascal-hash #[nil "cˆŠÁyˆÂÃ!)…ŠÁyˆÄ )‡" [last-command-char 0 looking-at "^[ ]*#" delete-horizontal-space] 2 (#$ . 11407) nil]) #@53 Function called when TAB is pressed in Pascal mode. (defalias 'electric-pascal-tab #[nil "ŠÀÁÂŠÄ !ˆ`*`\"8)„\"n„%ŠÅyˆg)Æ=ƒ%Çc‡ƒ5ŠÅyˆÉ ˆ)‚8ÇcˆÊ ‡" [3 parse-partial-sexp nil arg beginning-of-line 0 35 " " pascal-tab-always-indent pascal-indent-line pascal-indent-command] 4 (#$ . 11627) nil]) #@72 Insert Pascal begin ... end; block in the code with right indentation. (defalias 'pascal-insert-block #[nil "À ˆÁcˆÂ ˆŠÂ ˆÃcˆÄyˆÀ )‡" [pascal-indent-line "begin" electric-pascal-terminate-line "end;" 0] 1 (#$ . 11931) nil]) #@38 Insert Pascal star comment at point. (defalias 'pascal-star-comment #[nil "À ˆÁcˆÂ ˆŠÂ ˆÃ ˆÄcˆ)Åc‡" [pascal-indent-line "(*" electric-pascal-terminate-line delete-horizontal-space ")" " "] 1 (#$ . 12161) nil]) #@109 Mark the current pascal function (or procedure). This puts the mark at the end, and point at the beginning. (defalias 'pascal-mark-defun #[nil "À`!ˆÁ ˆÀ`!ˆÂ ˆÃÄ!…Ä ‡" [push-mark pascal-end-of-defun pascal-beg-of-defun fboundp zmacs-activate-region] 2 (#$ . 12379) nil]) #@429 Put the region into a Pascal comment. The comments that are in this area are "deformed": `*)' becomes `!(*' and `}' becomes `!{'. These deformed comments are returned to normal if you use \[pascal-uncomment-area] to undo the commenting. The commented area starts with `pascal-exclude-str-start', and ends with `pascal-include-str-end'. But if you change these variables, \[pascal-uncomment-area] won't recognize the comments. (defalias 'pascal-comment-area #[(start end) "ŠbˆŠÁÂwˆl)ƒŠÁÂxˆn)„Ãyˆ‚!Äyˆ cˆ`Æ ˆbˆÄyˆcˆÆ ˆbˆŠÉÊË#ƒMÌÍˉ#ˆ‚;)ŠÉÎË#…aÌÏˉ#ˆ‚O*‡" [end " " nil 1 0 pascal-exclude-str-end newline start pascal-exclude-str-start re-search-backward "\\*)" t replace-match "!(*" "}" "!{"] 4 (#$ . 12658) "r"]) #@172 Uncomment a commented area; change deformed comments back to normal. This command does nothing if the pointer is not in a commented area. See also `pascal-comment-area'. (defalias 'pascal-uncomment-area #[nil "Š``ŠÂ ÄÅ#ˆ`ÆÄÅ#ˆ`) `š„$`Xƒ*ÈÉ!‚ubˆÊyˆ` Ĉ `T|ˆ)ŠÌÍ Å#ƒOÎÏʼn#ˆ‚>)ŠÌÐ Å#ƒbÎÑʼn#ˆ‚Q) bˆÊyˆ` Ĉ `T|)+‡" [end start search-backward pascal-exclude-str-start nil t search-forward pascal-exclude-str-end message "Not standing within commented area." 0 pos re-search-backward "!{" replace-match "}" "!(\\*" "*)"] 4 (#$ . 13399) nil]) #@70 Move backward to the beginning of the current function or procedure. (defalias 'pascal-beg-of-defun #[nil "ÀÁ‡" [found (byte-code "ÀÁ\nP!„\fÃÄ!ˆÅÆÅÈ È\n°\n \f Î\nÏÐ#ƒ¢ŠÑe`\")Ó8†<Ô8)„ Ä•ƒeÀÕ!ƒW\fÅYƒW S  T‰ \f]\f‚ Ö•ƒ† \fUƒ~\fÅYƒ~ T  S ‚ Ó•ƒ  ÅUƒš×ØÙ\"ˆ‚  S ‚ ,χ" [looking-at "\\s \\|\\s)\\|" pascal-defun-re forward-sexp 1 0 -1 pascal-beg-block-re "\\|" pascal-end-block-re reg func max nest re-search-backward nil move parse-partial-sexp state 3 4 "\\" 2 throw found t] 9)] 2 (#$ . 13962) nil]) #@63 Move forward to the end of the current function or procedure. (defalias 'pascal-end-of-defun #[nil "ÀÁ!ƒ\nÂÃ!ˆÀ\f!„Å ˆÃuˆÆÃÈ È\f°\n \f ÆU„”Í\nÎÏ#ƒ”ŠÐe`\")Ò8†JÓ8)„'Õƒm\fT\fŠÆ”bˆÀÔ!)ƒ' T‰ ‚)Õ•ƒ†\fS‰\fÆUƒ' S‰ ‚)Ò•ƒ' T‰ ‚)+Ãy‡" [looking-at "\\s " forward-sexp 1 pascal-defun-re pascal-beg-of-defun 0 pascal-beg-block-re "\\|" pascal-end-block-re reg func nest re-search-forward nil move parse-partial-sexp state 3 4 "\\" 2] 8 (#$ . 14523) nil]) #@43 Move forward to end of current statement. (defalias 'pascal-end-of-statement #[nil "ÀÁÂ Ä Æ° ÊË!„ÌÍ!ˆÊ !„$ÎÏ„/ÎЂ1+‡" [0 nil "\\(" pascal-beg-block-re "\\)\\|\\(" pascal-end-block-re "\\)" regexp pos nest looking-at "[ \n]" forward-sexp -1 found (byte-code "ÀÁ!ˆÂÃ!ƒÄÅwˆÁuˆÆÇ`\"ˆ‚ŠÀÈ!ˆÂ !)ƒ2Ê”bˆÆÇÅ\"ˆ‚mƒÆÇ`\"ˆ‚" [forward-sexp 1 looking-at "[ ]*;" "^;" nil throw found -1 pascal-beg-block-re 0] 3) (byte-code "À ÂÃ#ˆÄ•ƒ T‚ SmƒÆÇ`\"ˆ‚ ÈUƒÆÇÉ \"ˆ‚" [re-search-forward regexp nil move 1 nest throw found 0 pascal-end-of-statement] 4)] 7 (#$ . 15021) nil]) #@45 Downcase all Pascal keywords in the buffer. (defalias 'pascal-downcase-keywords #[nil "ÀÁ!‡" [pascal-change-keywords downcase-word] 2 (#$ . 15626) nil]) #@43 Upcase all Pascal keywords in the buffer. (defalias 'pascal-upcase-keywords #[nil "ÀÁ!‡" [pascal-change-keywords upcase-word] 2 (#$ . 15785) nil]) #@47 Capitalize all Pascal keywords in the buffer. (defalias 'pascal-capitalize-keywords #[nil "ÀÁ!‡" [pascal-change-keywords capitalize-word] 2 (#$ . 15938) nil]) (defalias 'pascal-change-keywords #[(change-word) "ŠÀÁ Ä#ÅQebˆÇÈÉ#…\nË!ˆ‚*‡" ["\\<\\(" mapconcat identity pascal-keywords "\\|" "\\)\\>" keyword-re re-search-forward nil t change-word -1] 5]) #@237 Insert `{ case }' or `{ NAME }' on this line if appropriate. Insert `{ case }' if there is an `end' on the line which ends a case block. Insert `{ NAME }' if there is an `end' on the line which ends a function or procedure named NAME. (defalias 'pascal-set-auto-comments #[nil "ŠÀyˆÁÂwˆÃÄ!…·ŠÂˆÅÆŠÈ!ˆ`*É#)?…·Ê @‰ Ì=?…¶ Í=ƒDˆΠˆÏc‚¶ÐŠÃ!„uo„uÓÐ!ˆÃ!ƒfS‚HÃ!ƒHT‚Hoƒ|Ð)ÖU…µÂˆÎ ˆ×cˆÂ‰ŠÚ ˆÛÂwˆÁÂwˆ`ÜÂwˆ`)Ýp#ˆ*Þc)))‡" [-1 " " nil looking-at "\\„Ä>ƒ'Ç ˆÇ ˆ‚^\nÈ=ƒAÅ>„;È>ƒAÉ ˆ‚^\nÊ=ƒ^ËÌ!„^Å>„[Ê>ƒ^Í ˆËÎ!…gÏÐw+‡" [pascal-calculate-indent indent-str type ind paramlist all pascal-auto-lineup pascal-indent-paramlist declaration pascal-indent-declaration case looking-at "^[ ]*$" pascal-indent-case "[ ]+$" " " nil] 3 (#$ . 17444)]) #@44 Indent current line as a Pascal statement. (defalias 'pascal-indent-line #[nil "À ‰@ A@ÄÅ!ƒÆÇÈÉ#ˆÊ ˆ\nË=ƒ&Ä\f!†0\nÍ=†0Ä!?…IÄ!ƒ@ j‚IÐÑ\n\"A!j+‡" [pascal-calculate-indent indent-str type ind looking-at "^[0-9a-zA-Z]+[ ]*:[^=]" search-forward ":" nil t delete-horizontal-space declaration pascal-declaration-re cpp pascal-defun-re pascal-noindent-re eval assoc pascal-indent-alist] 5 (#$ . 17854)]) #@109 Calculate the indent of the current Pascal line. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL). (defalias 'pascal-calculate-indent #[nil "Š`ŠÁe`\")ÃÃÆÇ!ÆÉ!\nËÌ ÃVƒ)Î D‚. Ï D.‡" [oldpos parse-partial-sexp state 0 nest par looking-at "[ ]*end\\>" complete "[ ]*else\\>" elsed nesting (byte-code "À 8ƒÂÃÄ\"ˆ‚BÅ 8ƒÂÃÆ\"ˆ‚B @ÇVƒ2È`É @#bˆiT\n‚BŠÇyˆg)Ë=ƒBÂÃÌ\"ˆÍÎ!ˆÏÐ!ƒ€„€ŠÒÓxˆn)ƒ€ŠÓˆÍ ˆ`)`Uƒ€ŠbˆÇyˆ`)`Vƒ€ÂÃÕ\"ˆ‚BÏ!ƒºÇUƒ²ÏØ!ƒœÂÃÙ\"ˆ‚BÏÚ!ƒªÂÃÛ\"ˆ‚BÂÃÜ\"ˆ‚BS‚BÏ!ƒáÏÞ!ƒÖƒÖ„ÖÂÃÜ\"ˆàT‚BÏ!!ƒ3\nÇUƒ÷ÂÃâ\"ˆ‚BÇ\nÇ#äåà#ƒΕƒ#T#‚ý#S#‚ý#ÇVƒ*ÂÃÛ\"ˆ‚/ÂÃæ\"ˆ)‚BÏ'!ƒYŠbˆÉyˆÏè!)ƒQÂÃé\"ˆ‚BÂÃÛ\"ˆ‚B„mÏ*!ƒmÂÃÜ\"ˆ‚BŠëÎ!ˆgìU)ƒà‚BoƒBÂÃé\"ˆ‚B" [3 state throw nesting string 4 comment 0 scan-lists -1 par 35 cpp backward-sexp 1 looking-at "[A-Za-z0-9]+[ ]*:[^=]" complete " " nil oldpos caseblock pascal-beg-block-re nest "case\\>" case "record\\>" declaration block pascal-end-block-re "end\\s " elsed t pascal-defun-re defun n re-search-forward "\\(\\\\)\\|\\" paramlist pascal-declaration-re "^[ ]*$" unknown pascal-sub-block-re forward-sexp 59] 4) type contexp pascal-indent-level] 3 (#$ . 18276)]) #@101 Return the indent-level the current statement has. Do not count labels, case-statements or records. (defalias 'pascal-indent-level #[nil "ŠÀyˆÁÂ!ƒÃÄÅÆ#ˆ‚ÁÇ!ƒÃÈÅÆ#ˆÉÅwˆi)‡" [0 looking-at "[ ]*[0-9a-zA-Z]+[ ]*:[^=]" search-forward ":" nil t ".*=[ ]*record\\>" "=" " "] 4 (#$ . 19498)]) #@123 Indent current line as comment. If optional arg is non-nil, just return the column number the line should be indented to. (defalias 'pascal-indent-comment #[(&optional arg) "ŠÀÁÂÃ#ˆiT) ƒ\f‚Æ ˆ\fj)‡" [re-search-backward "(\\*\\|{" nil t stcol arg delete-horizontal-space] 4 (#$ . 19799)]) #@32 Indent within case statements. (defalias 'pascal-indent-case #[nil "ÀÁwˆÁˆÂ ÃÄÁÅ#ˆ`ÁÆ \n`Ë\n!WƒDÌÍË\n!Î#ƒ1ÏuˆÐ ˆiVƒ>iÑ ˆ‚ bˆË\n!`Ë\n!Wƒ‚ÌÒË\n!Î#ƒeÏuˆTjˆgÓUƒyÔuˆÐ ˆÕcˆ`Ñ ˆ‚Nb,‡" [": " nil point-marker re-search-backward "\\" t 0 ind oldpos beg end marker-position re-search-forward "^[ ]*[^ ,:]+[ ]*\\(,[ ]*[^ ,:]+[ ]*\\)*:" move -1 delete-horizontal-space pascal-end-of-statement "^[ ]*[^][ ,\\.:]+[ ]*\\(,[ ]*[^ ,:]+[ ]*\\)*:" 58 1 " "] 5 (#$ . 20098)]) #@128 Indent current line in parameterlist. If optional arg is non-nil, just return the indent of the current line in parameterlist. (defalias 'pascal-indent-paramlist #[(&optional arg) "Š`Á`ÂÃ#bˆ`iTÆ ˆÇÈÉ\nŠË\n!ˆ`*Ì#ˆ` ÎÏ\fÌ#\nƒLbˆÑyˆƒBÒÓ!ƒF ‚k Ô\\‚k\fbˆÃuˆÕ ˆƒeÒÖ!„e Ô\\jˆ×É\f #.‡" [oldpos scan-lists -1 1 stpos stcol pascal-declaration-end search-backward ")" nil arg beginning-of-line t edpos re-search-backward "\\" usevar 0 looking-at "[ ]*var\\>" 4 delete-horizontal-space "var\\>" pascal-indent-declaration] 4 (#$ . 20615)]) #@66 Indent current lines as declaration, lining up the `:'s or `='s. (defalias 'pascal-indent-declaration #[(&optional arg start end) "À \n„ „Ä ƒ×ÅÆ!„\n„ ƒ\"Ç‚#È ƒ+ ‚3ÉvˆÊË!ˆ`Ì  ƒ? ‚EÎ ˆ` ]Ï“Ïbˆ\nƒ`Ô!XƒÕyˆÖ ˆÅ×!ƒs\njˆ‚y\n\\jˆËyˆ‚XÙ#bˆ`Ô!XƒÖÚÏŠ\nˆ`*Û#ƒ©ÜuˆÖ ˆjˆÅ!„½Ëyˆ‚ËuˆÖ ˆÝcˆÅÞ!ƒÐßi!ˆËyˆ‚,\nƒàÜy‚äÔ !b)‡" [point-marker pos arg start pascal-declaration-beg looking-at "\\\\|\\" ":" "=" 2 backward-word 1 make-marker end pascal-declaration-end nil ind edpos stpos lineup marker-position 0 delete-horizontal-space "end\\>" pascal-indent-level pascal-get-lineup-indent search-forward move -1 " " "record\\>" pascal-indent-declaration] 5 (#$ . 21179)]) (defalias 'pascal-get-lineup-indent #[(b e str) "ŠÀ ÂPÃbˆ`WƒOÉÊ Ë\fŠ\fˆ`*^Í#ƒÉ”ƒ6Î ˆ‚À”bˆÏÃxˆiVƒHiÀ•bˆ‚ÀVƒ\\T‚ibˆÃˆÏÃxˆiT,‡" [0 str "\\|\\(\\\\)" nil nest reg ind b e 1 re-search-forward 2 arg move pascal-declaration-end " "] 4]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ B‡" [boundp pascal-str nil current-load-list pascal-all pascal-pred pascal-buffer-to-use pascal-flag] 2) #@59 Return index of first letter where STR1 and STR2 differs. (defalias 'pascal-string-diff #[(str1 str2) "ÀÁ‡" [done (byte-code "ÀÀT\nGV„ T GVƒÄÅ \"ˆ\n H Hš„&ÄÅ \"ˆ T‰‚" [0 diff str1 str2 throw done] 4)] 2 (#$ . 22373)]) (defalias 'pascal-func-completion #[(type) "Á˜ƒÂ Ä=ƒÅ‚ Æ=ƒÇ‚ÈÉÊRË\fÍÎ!„1ÏÎËÐ#ˆÑuˆÒ …lÓËŠˆ`*Ð#ƒeÕ”Õ•{\fƒ^\f!ƒe\fBØ”bˆ‚4*‡" [pascal-str "" "[a-zA-Z_]" type procedure "\\<\\(procedure\\)\\s +" function "\\<\\(function\\)\\s +" "\\<\\(function\\|procedure\\)\\s +" "\\<\\(" "[a-zA-Z0-9_.]*\\)\\>" nil match looking-at "\\<\\(function\\|procedure\\)\\>" re-search-backward t 1 pascal-beg-of-defun re-search-forward arg 2 pascal-pred pascal-all 0] 4]) (defalias 'pascal-get-completion-decl #[nil "ŠÀ ˆ`)Á` W…|ÄÅÁŠˆ`*Ç#ƒ_ÈÉ\nPÁŠË!ˆ`*Ç#ƒ_Ì•„_͔͕{ÎÏP\n\"ƒ ƒV\n!ƒ \nB‚ ÄÓÁŠˆ`*Ç#ƒvÀ ˆ‚ Ìyˆ‚ *‡" [pascal-declaration-end nil match end re-search-forward "[:=]" arg t re-search-backward "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|" pascal-symbol-re beginning-of-line 1 0 string-match "\\<" pascal-str pascal-pred pascal-all "\\"] 4]) #@47 Calculate all possible completions for types. (defalias 'pascal-type-completion #[nil "`Àà „ ?‰…3Š\nŠÄ ˆ`)ÅuˆWƒ/ÆÇ\nÈ#ƒ/Å•„/É ˆ)‚*‡" [nil goon start pascal-beg-of-defun pascal-end-of-defun 1 re-search-forward "\\\\|\\<\\(begin\\|function\\|procedure\\)\\>" t pascal-get-completion-decl] 4 (#$ . 23516)]) #@66 Calculate all possible completions for variables (or constants). (defalias 'pascal-var-completion #[nil "`À‰Ä „\n?‰…aŠ ŠÅ ˆ`)V„]ÆÇÀŠˆ`*É#ƒ2Ê ˆË S‰ÌYƒ]ÍÎÏP É#ƒRË•„RÊ ˆ‚4Ë•ƒ4̉‚5)‚+‡" [nil twice goon start pascal-beg-of-defun pascal-end-of-defun search-forward "(" arg t pascal-get-completion-decl 2 0 re-search-forward "\\<\\(var\\|const\\)\\>\\|" "\\<\\(begin\\|function\\|procedure\\)\\>"] 5 (#$ . 23845)]) #@68 Give list of all possible completions of keywords in KEYWORD-LIST. (defalias 'pascal-keyword-completion #[(keyword-list) "ÀÁ\n\"‡" [mapcar #[(s) "ÀÁ\nP \"…\fƒ\f !… B‰‡" [string-match "\\<" pascal-str s pascal-pred pascal-all] 3] keyword-list] 3 (#$ . 24284)]) (defalias 'pascal-completion #[(pascal-str pascal-pred pascal-flag) "ŠÀ\nqˆÃ @‰Å=„0\fÆ=„0\fÇ=ƒJŠÈÉÀ\nŠË\n!ˆ`*Ì#)ƒJ\fÆ=„<\fÇ=ƒ?Í ˆÎ ˆÏ!ˆ‚Š\fÑ=„|ŠÒÀxˆÓÔ!ˆÕ!†g×Ô!ˆÕØ!)ƒ|ŠÙ ˆ)ÚÛ!ˆÏ!ˆ‚ŠŠÙ ˆ)ÚÝ!ˆÏ!ˆ)ß *‡" [nil pascal-all pascal-buffer-to-use pascal-calculate-indent state declaration paramlist defun re-search-backward ")[ ]*:" arg beginning-of-line t pascal-beg-of-defun pascal-type-completion pascal-keyword-completion pascal-type-keywords contexp "a-zA-Z0-9_." backward-sexp 1 looking-at pascal-nosemi-re forward-sexp "\\s *\\(;\\|:[^=]\\)" pascal-var-completion pascal-func-completion procedure pascal-start-keywords function pascal-separator-keywords pascal-completion-response] 5]) (defalias 'pascal-completion-response #[nil "Áš„\n„l\n??…q\nA\n@‰GÆÆ\f ˜ƒ+Ê‚[ ƒ[Ë\f @\"‰ WƒD\fÌ O @ ˜ƒTÊƉ‚, A‰„/Áš…e\fÊš??…j\f-‡…q\n‡" [pascal-flag lambda pascal-all elm match min nil exact tmp pascal-str t pascal-string-diff 0] 4]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÅÆ BŇ" [boundp pascal-last-word-numb 0 current-load-list pascal-last-word-shown nil pascal-last-completions] 2) #@154 Complete word at current point. (See also `pascal-toggle-completions', `pascal-type-keywords', `pascal-start-keywords' and `pascal-separator-keywords'.) (defalias 'pascal-complete-word #[nil "ŠÀÁxˆ`)ŠÀÁwˆ`)\n {pƒ'\f˜ƒ'‚+É\fÊ\" ƒ6Ì‚>Í\fÎÏ \"\"\n |ˆƒ  GSYƒ[Ò‚^T œ ƒṯ‚ÛÌ\f±ˆÓÔ!‚Ûƒ‹Õšƒ—Ì\f±ˆÓÔ!ˆ‚̱ˆÕšƒ¶ Aƒ°ÓÖ!‚ÛÓ×!‚Û A??…Û\fGGU…ÛØÙ !‘ˆÚÌ`\"ˆÛÜÝØ!!!.‡" ["a-zA-Z0-9_" nil b e pascal-str pascal-buffer-to-use pascal-toggle-completions pascal-last-word-shown pascal-last-completions all-completions pascal-completion allcomp "" try-completion mapcar #[(elm) "ÁB‡" [elm 0] 2] match pascal-last-word-numb 0 message "(No match)" t "(Complete but not unique)" "(Sole completion)" "*Completions*" display-completion-list momentary-string-display delete-window get-buffer-window get-buffer] 5 (#$ . 25693) nil]) #@49 Show all possible completions at current point. (defalias 'pascal-show-completions #[nil "ŠÀÁxˆ`)ŠÀÁwˆ`)\n {pƒ'\f˜ƒ'‚+É\fÊ\" ÌÍ !‘ˆÎÏ`\"ˆÐÑÒÌ!!!-‡" ["a-zA-Z0-9_" nil b e pascal-str pascal-buffer-to-use pascal-toggle-completions pascal-last-word-shown pascal-last-completions all-completions pascal-completion allcomp "*Completions*" display-completion-list momentary-string-display "" delete-window get-buffer-window get-buffer] 4 (#$ . 26578) nil]) #@49 Return symbol around current point as a string. (defalias 'pascal-get-default-symbol #[nil "ŠÀÁxˆÂÁxˆ`ÂÁwˆ`{)‡" [" " nil "a-zA-Z0-9_"] 3 (#$ . 27050)]) #@147 Return function/procedure starting with STR as regular expression. With optional second arg non-nil, STR is the complete name of the instruction. (defalias 'pascal-build-defun-re #[(str &optional arg) "ƒ Á\nÃQ‡Á\nÄQ‡" [arg "^\\(function\\|procedure\\)[ ]+\\(" str "\\)\\>" "[a-zA-Z0-9_]*\\)\\>"] 3 (#$ . 27210)]) (defalias 'pascal-comp-defun #[(pascal-str pascal-pred pascal-flag) "ŠÀ‰ qˆ\f‰ŘƒÆÇ!‚Æ\f!ebˆÈ\fÀÉ#ƒ?ʔʕ{ ƒ8 !ƒ \nB‚)Ì +‡" [nil match pascal-all pascal-buffer-to-use pascal-str "" pascal-build-defun-re "[a-zA-Z_]" re-search-forward t 2 pascal-pred pascal-completion-response] 5]) #@102 Move to specified Pascal function/procedure. The default is a name found in the buffer around point. (defalias 'pascal-goto-defun #[nil "À pà ÄÅ#ƒ ‚ƉƘ„&ÇÈ ÉQÃÄÊÆ%‚-ÇËÃÄÊÆ%‰\fƘƒ8 \f\fƘ†NebˆÍÎ\fÊ\"!ˆÏyˆÄ,‡" [pascal-get-default-symbol default pascal-buffer-to-use pascal-comp-defun nil lambda "" completing-read "Label: (default " ") " t "Label: " label re-search-forward pascal-build-defun-re 0] 7 (#$ . 27833) nil]) #@37 Keymap used in Pascal Outline mode. (defvar pascal-outline-map nil (#$ . 28273)) (byte-code "„BÁÂ!ƒÂÀ\"ˆÁÃ!„Ä !‚$Æ Ã \"ˆÇÈÉ#ˆÇÊË#ˆÇÌÍ#ˆÇÎÏ#ˆÇÐÑ#ˆÁ‡" [pascal-outline-map boundp set-keymap-name set-keymap-parent copy-keymap pascal-mode-map make-sparse-keymap define-key "" pascal-outline-prev-defun "…" pascal-outline-next-defun "" pascal-outline-goto-defun "" pascal-show-all "" pascal-hide-other-defuns] 4) #@42 Non-nil while using Pascal Outline mode. (defvar pascal-outline-mode nil (#$ . 28709)) (byte-code "ÀÁ!ˆÂÁÃ\"ˆÄÁ \"„Æ ÇC\"Ç" [make-variable-buffer-local pascal-outline-mode set-default nil assoc minor-mode-alist append (pascal-outline-mode " Outl")] 3) #@690 Outline-line minor mode for Pascal mode. When in Pascal Outline mode, portions of the text being edited may be made invisible. \ Pascal Outline mode provides some additional commands. \[pascal-outline-prev-defun] - Move to previous function/procedure, hiding everything else. \[pascal-outline-next-defun] - Move to next function/procedure, hiding everything else. \[pascal-outline-goto-defun] - Goto function/procedure prompted for in minibuffer, hide all other functions. \[pascal-show-all] - Show the whole buffer. \[pascal-hide-other-defuns] - Hide everything but the current function (function under the cursor). \[pascal-outline] - Leave pascal-outline-mode. (defalias 'pascal-outline #[(&optional arg) "„ ?‚\nÂÃÄ!ƒÄ ˆ ƒÂÆ!‡ÈÉ ˆÆ\n!‡" [arg pascal-outline-mode t boundp redraw-mode-line selective-display use-local-map pascal-outline-map nil pascal-show-all pascal-mode-map] 2 (#$ . 28972) "P"]) (defalias 'pascal-outline-change #[(b e pascal-flag) "À ÂŽÃ\f ÇUƒÈ‚Ç$*‡" [buffer-modified-p modp ((set-buffer-modified-p modp)) subst-char-in-region b e pascal-flag 10 13] 5]) #@37 Show all of the text in the buffer. (defalias 'pascal-show-all #[nil "ÀedÁ#‡" [pascal-outline-change 10] 4 (#$ . 30102) nil]) #@30 Show only the current defun. (defalias 'pascal-hide-other-defuns #[nil "ŠÀÁ!„\n ˆ`à ˆÄÅ!ˆÆÇÈÉ#ˆ`e\n \febˆÍÎ\fÏ#ƒIÐ\nÑ”SÒ#ˆ`\nà ˆ`\fVƒ#\nbˆ‚#\f\nVƒZÐ\n\fSÒ#ˆÐ\f Ó#ˆÅuˆÍÎ Ï#ƒ~`\nà ˆÐ\n`Ò#ˆ‚e bˆ \nÍÎÈÏ#ƒ Ð\nÑ”SÒ#ˆ`\nà ˆ‚†Ð\ndÒ#ˆÔyˆ` W…Á\fbˆÃ ˆÄÅ!ˆÐ`dÒ#,‡" [looking-at "\\(function\\|procedure\\)\\>" pascal-beg-of-defun pascal-end-of-defun backward-sexp 1 search-forward "\n\\| " nil t opoint end beg re-search-forward "^\\(function\\|procedure\\)\\>" move pascal-outline-change 0 13 10 -1] 5 (#$ . 30234) nil]) #@53 Move to next function/procedure, hiding all others. (defalias 'pascal-outline-next-defun #[nil "À ˆÁ ‡" [pascal-end-of-defun pascal-hide-other-defuns] 1 (#$ . 30785) nil]) #@57 Move to previous function/procedure, hiding all others. (defalias 'pascal-outline-prev-defun #[nil "À ˆÁ ‡" [pascal-beg-of-defun pascal-hide-other-defuns] 1 (#$ . 30963) nil]) #@58 Move to specified function/procedure, hiding all others. (defalias 'pascal-outline-goto-defun #[nil "À ˆÁ ‡" [pascal-goto-defun pascal-hide-other-defuns] 1 (#$ . 31145) nil]) emacs-19.30/lisp/pc-mode.elc100666 75424 1 2340 6045214236 14271 0ustar kwzhdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:25:33 1995 ;;; from file /home/fsf/rms/e19/lisp/pc-mode.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`pc-mode.el' was compiled for Emacs 19.29 or later")) #@352 Set up certain key bindings for PC compatibility. The keys affected are: Delete (and its variants) delete forward instead of backward. C-Backspace kills backward a word (as C-Delete normally would). M-Backspace does undo. Home and End move to beginning and end of line C-Home and C-End move to beginning and end of buffer. C-Escape does list-buffers. (defalias 'pc-bindings-mode #[nil "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÈÉÊ\"ˆÈËÌ\"ˆÈÍÎ\"ˆÈÏÐ\"ˆÈÑÒ\"ˆÈÓÔ\"ˆÈÕÖ\"ˆÈ×Ø\"‡" [define-key function-key-map [delete] "" [M-delete] [-134217628] [C-delete] [-134217628] global-set-key [C-M-delete] kill-sexp [C-backspace] backward-kill-word [M-backspace] undo [C-escape] list-buffers [home] beginning-of-line [end] end-of-line [C-home] beginning-of-buffer [C-end] end-of-buffer] 4 (#$ . 475) nil]) emacs-19.30/lisp/pc-select.elc100666 12120 1 36154 6051027476 14461 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 00:05:58 1995 ;;; from file /home/fsf/rms/e19/lisp/pc-select.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`pc-select.el' was compiled for Emacs 19.29 or later")) (provide (quote pc-select)) #@257 Save the region as if killed; but don't kill it; deactivate mark. If `interprogram-cut-function' is non-nil, also save the text for a window system cut and paste. Deactivating mark is to avoid confusion with delete-selection-mode and transient-mark-mode. (defalias 'copy-region-as-kill-nomark #[(beg end) "À \n\"ˆÃÅÆ!‡" [copy-region-as-kill beg end nil mark-active message "Region saved"] 3 (#$ . 507) "r"]) (defalias 'ensure-mark #[nil "?…ÁÂ!‡" [mark-active set-mark-command nil] 2]) #@130 Ensure mark is active; move point right ARG characters (left if ARG negative). On reaching end of buffer, stop and signal error. (defalias 'forward-char-mark #[(&optional arg) "À ˆ u‡" [ensure-mark arg] 1 (#$ . 1004) "p"]) #@180 Ensure mark is active; move point right ARG words (backward if ARG is negative). Normally returns t. If an edge of the buffer is reached, point is left there and nil is returned. (defalias 'forward-word-mark #[(&optional arg) "À ˆ v‡" [ensure-mark arg] 1 (#$ . 1234) "p"]) #@433 Ensure mark is active; move forward to end of paragraph. With arg N, do it N times; negative arg -N means move backward N paragraphs. A line which `paragraph-start' matches either separates paragraphs (if `paragraph-separate' matches it also) or is the first line of a paragraph. A paragraph end is the beginning of a line which is not part of the paragraph to which the end of the previous line belongs, or the end of the buffer. (defalias 'forward-paragraph-mark #[(&optional arg) "À ˆÁ\n!‡" [ensure-mark forward-paragraph arg] 2 (#$ . 1514) "p"]) #@826 Ensure mark is active; move cursor vertically down ARG lines. If there is no character in the target line exactly under the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. If there is no line in the buffer after this one, behavior depends on the value of `next-line-add-newlines'. If non-nil, it inserts a newline character to create a line, and moves the cursor to that line. Otherwise it moves the cursor to the end of the buffer (if already at the end of the buffer, an error is signaled). The command C-x C-n can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically. This goal column is stored in `goal-column', which is nil when there is none. (defalias 'next-line-mark #[(&optional arg) "À ˆÁ\n!‡" [ensure-mark next-line arg] 2 (#$ . 2072) "p"]) #@182 Ensure mark is active; move point to end of current line. With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error. (defalias 'end-of-line-mark #[(&optional arg) "À ˆ ‡" [ensure-mark arg] 1 (#$ . 3007) "p"]) #@252 Ensure mark is active; scroll down ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll upward. When calling from a program, supply a number as argument or nil. (defalias 'scroll-down-mark #[(&optional arg) "À ˆÁ\n!‡" [ensure-mark scroll-down arg] 2 (#$ . 3288) "P"]) #@328 Ensure mark is active; move point to the end of the buffer. With arg N, put point N/10 of the way from the end. If the buffer is narrowed, this command uses the beginning and size of the accessible part of the buffer. Don't use this command in Lisp programs! (goto-char (point-max)) is faster and avoids clobbering the mark. (defalias 'end-of-buffer-mark #[(&optional arg) "À ˆdeZ\nƒ'd ÃVƒÄ\n! Å¥_‚# Ä\n!_Å¥Z‚(dbˆ)\nƒ2Æy‡`ŠÈ bˆÉÊ !ˆ`W*…NË`!ˆÌÍ!‡" [ensure-mark size arg 10000 prefix-numeric-value 10 1 old-point window-start vertical-motion window-height overlay-recenter recenter -3] 4 (#$ . 3653) "P"]) #@124 Deactivate mark; move point right ARG characters (left if ARG negative). On reaching end of buffer, stop and signal error. (defalias 'forward-char-nomark #[(&optional arg) "À\nu‡" [nil mark-active arg] 1 (#$ . 4278) "p"]) #@174 Deactivate mark; move point right ARG words (backward if ARG is negative). Normally returns t. If an edge of the buffer is reached, point is left there and nil is returned. (defalias 'forward-word-nomark #[(&optional arg) "À\nv‡" [nil mark-active arg] 1 (#$ . 4508) "p"]) #@427 Deactivate mark; move forward to end of paragraph. With arg N, do it N times; negative arg -N means move backward N paragraphs. A line which `paragraph-start' matches either separates paragraphs (if `paragraph-separate' matches it also) or is the first line of a paragraph. A paragraph end is the beginning of a line which is not part of the paragraph to which the end of the previous line belongs, or the end of the buffer. (defalias 'forward-paragraph-nomark #[(&optional arg) "À !‡" [nil mark-active forward-paragraph arg] 2 (#$ . 4788) "p"]) #@820 Deactivate mark; move cursor vertically down ARG lines. If there is no character in the target line exactly under the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. If there is no line in the buffer after this one, behavior depends on the value of `next-line-add-newlines'. If non-nil, it inserts a newline character to create a line, and moves the cursor to that line. Otherwise it moves the cursor to the end of the buffer (if already at the end of the buffer, an error is signaled). The command C-x C-n can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically. This goal column is stored in `goal-column', which is nil when there is none. (defalias 'next-line-nomark #[(&optional arg) "À !‡" [nil mark-active next-line arg] 2 (#$ . 5344) "p"]) #@176 Deactivate mark; move point to end of current line. With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error. (defalias 'end-of-line-nomark #[(&optional arg) "À\n‡" [nil mark-active arg] 1 (#$ . 6277) "p"]) #@246 Deactivate mark; scroll down ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll upward. When calling from a program, supply a number as argument or nil. (defalias 'scroll-down-nomark #[(&optional arg) "À !‡" [nil mark-active scroll-down arg] 2 (#$ . 6558) "P"]) #@322 Deactivate mark; move point to the end of the buffer. With arg N, put point N/10 of the way from the end. If the buffer is narrowed, this command uses the beginning and size of the accessible part of the buffer. Don't use this command in Lisp programs! (goto-char (point-max)) is faster and avoids clobbering the mark. (defalias 'end-of-buffer-nomark #[(&optional arg) "ÀdeZ ƒ&d\nÄVƒÅ !\nÆ¥_‚\"\nÅ !_Æ¥Z‚'dbˆ) ƒ1Çy‡`ŠÉ bˆÊË !ˆ`W*…MÌ`!ˆÍÎ!‡" [nil mark-active size arg 10000 prefix-numeric-value 10 1 old-point window-start vertical-motion window-height overlay-recenter recenter -3] 4 (#$ . 6921) "P"]) #@150 Ensure mark is active; move point left ARG characters (right if ARG negative). On attempt to pass beginning or end of buffer, stop and signal error. (defalias 'backward-char-mark #[(&optional arg) "À ˆÁ\n!‡" [ensure-mark backward-char arg] 2 (#$ . 7545) "p"]) #@116 Ensure mark is active; move backward until encountering the end of a word. With argument, do this that many times. (defalias 'backward-word-mark #[(&optional arg) "À ˆÁ\n!‡" [ensure-mark backward-word arg] 2 (#$ . 7812) "p"]) #@450 Ensure mark is active; move backward to start of paragraph. With arg N, do it N times; negative arg -N means move forward N paragraphs. A paragraph start is the beginning of a line which is a `first-line-of-paragraph' or which is ordinary text and follows a paragraph-separating line; except: if the first real line of a paragraph is preceded by a blank line, the paragraph starts at that blank line. See `forward-paragraph' for more information. (defalias 'backward-paragraph-mark #[(&optional arg) "À ˆÁ\n!‡" [ensure-mark backward-paragraph arg] 2 (#$ . 8045) "p"]) #@624 Ensure mark is active; move cursor vertically up ARG lines. If there is no character in the target line exactly over the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. The command C-x C-n can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically. If you are thinking of using this in a Lisp program, consider using `forward-line' with a negative argument instead. It is usually easier to use and more reliable (no dependence on goal column, etc.). (defalias 'previous-line-mark #[(&optional arg) "À ˆÁ\n!‡" [ensure-mark previous-line arg] 2 (#$ . 8622) "p"]) #@188 Ensure mark is active; move point to beginning of current line. With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error. (defalias 'beginning-of-line-mark #[(&optional arg) "À ˆÁ\n!‡" [ensure-mark beginning-of-line arg] 2 (#$ . 9363) "p"]) #@256 Ensure mark is active; scroll upward ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll downward. When calling from a program, supply a number as argument or nil. (defalias 'scroll-up-mark #[(&optional arg) "À ˆÁ\n!‡" [ensure-mark scroll-up arg] 2 (#$ . 9676) "P"]) #@340 Ensure mark is active; move point to the beginning of the buffer. With arg N, put point N/10 of the way from the beginning. If the buffer is narrowed, this command uses the beginning and size of the accessible part of the buffer. Don't use this command in Lisp programs! (goto-char (point-min)) is faster and avoids clobbering the mark. (defalias 'beginning-of-buffer-mark #[(&optional arg) "À ˆdeZ\nƒ)e ÃVƒÄ\n! Å¥_‚% Ä\n!_Å\\Å¥\\‚*ebˆ)\n…3Æy‡" [ensure-mark size arg 10000 prefix-numeric-value 10 1] 4 (#$ . 10041) "P"]) #@144 Deactivate mark; move point left ARG characters (right if ARG negative). On attempt to pass beginning or end of buffer, stop and signal error. (defalias 'backward-char-nomark #[(&optional arg) "À !‡" [nil mark-active backward-char arg] 2 (#$ . 10578) "p"]) #@110 Deactivate mark; move backward until encountering the end of a word. With argument, do this that many times. (defalias 'backward-word-nomark #[(&optional arg) "À !‡" [nil mark-active backward-word arg] 2 (#$ . 10844) "p"]) #@444 Deactivate mark; move backward to start of paragraph. With arg N, do it N times; negative arg -N means move forward N paragraphs. A paragraph start is the beginning of a line which is a `first-line-of-paragraph' or which is ordinary text and follows a paragraph-separating line; except: if the first real line of a paragraph is preceded by a blank line, the paragraph starts at that blank line. See `forward-paragraph' for more information. (defalias 'backward-paragraph-nomark #[(&optional arg) "À !‡" [nil mark-active backward-paragraph arg] 2 (#$ . 11076) "p"]) #@415 Deactivate mark; move cursor vertically up ARG lines. If there is no character in the target line exactly over the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. The command C-x C-n can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically. (defalias 'previous-line-nomark #[(&optional arg) "À !‡" [nil mark-active previous-line arg] 2 (#$ . 11652) "p"]) #@182 Deactivate mark; move point to beginning of current line. With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error. (defalias 'beginning-of-line-nomark #[(&optional arg) "À !‡" [nil mark-active beginning-of-line arg] 2 (#$ . 12189) "p"]) #@250 Deactivate mark; scroll upward ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll downward. When calling from a program, supply a number as argument or nil. (defalias 'scroll-up-nomark #[(&optional arg) "À !‡" [nil mark-active scroll-up arg] 2 (#$ . 12501) "P"]) #@334 Deactivate mark; move point to the beginning of the buffer. With arg N, put point N/10 of the way from the beginning. If the buffer is narrowed, this command uses the beginning and size of the accessible part of the buffer. Don't use this command in Lisp programs! (goto-char (point-min)) is faster and avoids clobbering the mark. (defalias 'beginning-of-buffer-nomark #[(&optional arg) "ÀdeZ ƒ(e\nÄVƒÅ !\nÆ¥_‚$\nÅ !_Æ\\Æ¥\\‚)ebˆ) …2Çy‡" [nil mark-active size arg 10000 prefix-numeric-value 10 1] 4 (#$ . 12865) "P"]) #@429 Change mark behaviour to emulate motif, MAC or MS-Windows cut and paste style. This mode will switch on delete-selection-mode and transient-mark-mode. The cursor keys (and others) are bound to new functions which will modify the status of the mark. It will be possible to select regions with shift-cursorkeys. All this tries to emulate the look-and-feel of GUIs like motif, the MAC GUI or MS-Windows (sorry for the last one). (defalias 'pc-selection-mode #[nil "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÔÕÖ\"ˆÔ×Ø\"ˆÀ ÙÚ#ˆÀ ÛÜ#ˆÀ ÝÞ#ˆÀ ßà#ˆÀ áâ#ˆÀ ãä#ˆÀ åæ#ˆÀ çè#ˆÀ éê#ˆÀ ëì#ˆÔíî\"ˆÔïð\"ˆÀ ñò#ˆÀ óô#ˆÀ õö#ˆÀ ÷ø#ˆÀ ùú#ˆÀ ûö#ˆÀ üø#ˆÀ ýú#ˆÔþÿ\"ˆÔ@A\"ˆÔBC\"ˆÔDE\"ˆÔFG\"ˆÔHI\"ˆÔJK\"ˆÔLM\"ˆÔNO\"ˆÀPQR#ˆÔST\"ˆÔUV\"ˆÔWX\"ˆYZY[\\]!‡" [define-key global-map "÷" copy-region-as-kill-nomark [S-right] forward-char-mark [right] forward-char-nomark [C-S-right] forward-word-mark [C-right] forward-word-nomark [S-down] next-line-mark [down] next-line-nomark [S-end] end-of-line-mark [end] end-of-line-nomark global-set-key [S-C-end] end-of-buffer-mark [C-end] end-of-buffer-nomark [S-next] scroll-up-mark [next] scroll-up-nomark [S-left] backward-char-mark [left] backward-char-nomark [C-S-left] backward-word-mark [C-left] backward-word-nomark [S-up] previous-line-mark [up] previous-line-nomark [S-home] beginning-of-line-mark [home] beginning-of-line-nomark [S-C-home] beginning-of-buffer-mark [C-home] beginning-of-buffer-nomark [S-prior] scroll-down-mark [prior] scroll-down-nomark [S-insert] yank [C-insert] copy-region-as-kill [S-delete] kill-region [f16] [f18] [f20] [f1] help [f6] other-window [delete] delete-char [C-delete] kill-line [M-backspace] undo [C-down] forward-paragraph-nomark [C-up] backward-paragraph-nomark [S-C-down] forward-paragraph-mark [S-C-up] backward-paragraph-mark function-key-map [M-delete] [-134217628] [C-M-delete] kill-sexp [C-backspace] backward-kill-word [C-escape] list-buffers t transient-mark-mode mark-even-if-inactive delete-selection-mode 1] 4 (#$ . 13400) nil]) emacs-19.30/lisp/perl-mode.elc100666 74777 1 31426 6006763455 14511 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Jul 30 16:09:29 1995 ;;; from file /home/fsf/rms/e19/lisp/perl-mode.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`perl-mode.el' was compiled for Emacs 19.29 or later")) #@43 Abbrev table in use in perl-mode buffers. (defvar perl-mode-abbrev-table nil (#$ . 476)) (define-abbrev-table (quote perl-mode-abbrev-table) nil) #@27 Keymap used in Perl mode. (defvar perl-mode-map nil (#$ . 628)) (byte-code "„CÁ ÂÃÄ#ˆÂÅÄ#ˆÂÆÄ#ˆÂÇÄ#ˆÂÈÉ#ˆÂÊË#ˆÂÌÍ#ˆÂÎÏ#ˆÂÐÑ#ˆÂÒÓ#ˆÁ‡" [perl-mode-map make-sparse-keymap define-key "{" electric-perl-terminator "}" ";" ":" "" perl-beginning-of-function "" perl-end-of-function "" mark-perl-function "" indent-perl-exp "" backward-delete-char-untabify " " perl-indent-command] 4) #@141 Display the result of expanding all C macros occurring in the region. The expansion is entirely correct because it uses the C preprocessor. (autoload (quote c-macro-expand) "cmacexp" '(#$ . 1033) t) #@43 Syntax table in use in perl-mode buffers. (defvar perl-mode-syntax-table nil (#$ . 1238)) (byte-code "„iÁ !ÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌË#ˆÃÍÎ#ˆÃÏË#ˆÃÐË#ˆÃÑË#ˆÃÒË#ˆÃÓË#ˆÃÔË#ˆÃÕË#ˆÃÖ×#ˆÃØÎ#ˆÃÙË#ˆÁ‡" [perl-mode-syntax-table make-syntax-table standard-syntax-table modify-syntax-entry 10 ">" 35 "<" 36 "/" 37 "." 38 39 "\"" 42 43 45 47 60 61 62 92 "\\" 96 124] 4) #@74 Imenu generic expression for Perl mode. See `imenu-generic-expression'. (defvar perl-imenu-generic-expression (quote ((nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)\\(\\s-\\|\n\\)*{" 1) ("Variables" "^\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1))) (#$ . 1618)) #@51 Additional expressions to highlight in Perl mode. (defvar perl-font-lock-keywords (byte-code "ÀÁÂÃÄ°ÅÆPÇBÈÉʯ‡" ["\\<\\(" "continue\\|die\\|e\\(ls\\(e\\|if\\)\\|x\\(ec\\|it\\)\\)\\|" "for\\(\\|each\\)\\|goto\\|if\\|l\\(ast\\|ocal\\)\\|next\\|" "re\\(do\\|turn\\)\\|un\\(less\\|til\\)\\|while" "\\)\\>" "#\\(define\\|e\\(lse\\|ndif\\)\\|" "i\\(f\\(\\|def\\|ndef\\)\\|nclude\\)\\|undef\\)\\>" font-lock-reference-face ("^[ \n ]*sub[ ]+\\([^ {]+\\)[ ]*[{]" 1 font-lock-function-name-face) ("[ \n {]*\\(eval\\)[ \n (;]" 1 font-lock-function-name-face) ("\\(--- .* ---\\|=== .* ===\\)" . font-lock-string-face)] 5) (#$ . 1870)) #@67 *Indentation of Perl statements with respect to containing block. (defvar perl-indent-level 4 (#$ . -2504)) #@54 *Extra indent for lines not starting new statements. (defvar perl-continued-statement-offset 4 (#$ . -2618)) #@120 *Extra indent for substatements that start with open-braces. This is in addition to `perl-continued-statement-offset'. (defvar perl-continued-brace-offset -4 (#$ . -2734)) #@74 *Extra indentation for braces, compared with other text in same context. (defvar perl-brace-offset 0 (#$ . -2912)) #@75 *Imagined indentation of an open brace that actually follows a statement. (defvar perl-brace-imaginary-offset 0 (#$ . -3033)) #@60 *Offset of Perl label lines relative to usual indentation. (defvar perl-label-offset -2 (#$ . -3165)) #@165 *Non-nil means TAB in Perl mode always indents the current line. Otherwise it inserts a tab character if you type it past the first nonwhite character on the line. (defvar perl-tab-always-indent t (#$ . -3274)) #@219 *Non-nil means TAB moves to eol or makes a comment in some cases. For lines which don't need indenting, TAB either indents an existing comment, moves to end-of-line, or if at end-of-line already, create a new comment. (defvar perl-tab-to-comment nil (#$ . -3492)) #@69 *Lines starting with this regular expression are not auto-indented. (defvar perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:" (#$ . -3762)) #@2043 Major mode for editing Perl code. Expression and list commands understand all Perl brackets. Tab indents for Perl code. Comments are delimited with # ... \n. Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \{perl-mode-map} Variables controlling indentation style: perl-tab-always-indent Non-nil means TAB in Perl mode should always indent the current line, regardless of where in the line point is when the TAB command is used. perl-tab-to-comment Non-nil means that for lines which don't need indenting, TAB will either delete an empty comment, indent an existing comment, move to end-of-line, or if at end-of-line already, create a new comment. perl-nochange Lines starting with this regular expression are not auto-indented. perl-indent-level Indentation of Perl statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. perl-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. perl-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to `perl-continued-statement-offset'. perl-brace-offset Extra indentation for line if it starts with an open brace. perl-brace-imaginary-offset An open brace following other text is treated as if it were this far to the right of the start of its line. perl-label-offset Extra indentation for line that is a label. Various indentation styles: K&R BSD BLK GNU LW perl-indent-level 5 8 0 2 4 perl-continued-statement-offset 5 8 4 2 4 perl-continued-brace-offset 0 0 0 0 -4 perl-brace-offset -5 -8 0 0 0 perl-brace-imaginary-offset 0 0 4 0 0 perl-label-offset -5 -8 -2 -2 -2 Turning on Perl mode runs the normal hook `perl-mode-hook'. (defalias 'perl-mode #[nil "À ˆÁ\n!ˆÃÅÉ\n!ˆËÌ!ˆÍP\fËÏ!ˆ\fËÐ!ˆÑËÒ!ˆÓËÔ!ˆÑËÕ!ˆÖË×!ˆØËÙ!ˆÚËÛ!ˆÜËÝ!ˆÞËß!ˆÑËà!ˆá Ëâ!ˆ#\"äå!‡" [kill-all-local-variables use-local-map perl-mode-map perl-mode major-mode "Perl" mode-name perl-mode-abbrev-table local-abbrev-table set-syntax-table perl-mode-syntax-table make-local-variable paragraph-start "$\\|" page-delimiter paragraph-separate paragraph-ignore-fill-prefix t indent-line-function perl-indent-line require-final-newline comment-start "# " comment-end "" comment-column 32 comment-start-skip "\\(^\\|\\s-\\);?#+ *" comment-indent-function perl-comment-indent parse-sexp-ignore-comments font-lock-defaults (perl-font-lock-keywords) imenu-generic-expression perl-imenu-generic-expression run-hooks perl-mode-hook] 2 (#$ . 3913) nil]) (defalias 'perl-comment-indent #[nil "nƒ\nl„\nÀ‡ŠÁÂxˆnƒÀ‚iT ])‡" [0 " " nil comment-column] 2]) #@121 Insert character and adjust indentation. If at end-of-line, and not in a comment or a quote, correct the's indentation. (defalias 'electric-perl-terminator #[(arg) "` „PlƒPŠÂyˆÃ\fÅ#?…?ÇUƒ$ÈÉ!…?ÊË \"\fÍ\f8†=Î\f8†=Ï\f8)?)ƒPÐÑ\"ˆÒ ˆÓÔ!ˆ)ÕÖ !!‡" [insertpos arg 0 re-search-forward comment-start-skip t last-command-char 58 looking-at "\\s-*\\(\\w\\|\\s_\\)+$" parse-partial-sexp perl-beginning-of-function pps 3 4 5 insert-char 1 perl-indent-line delete-char -1 self-insert-command prefix-numeric-value] 4 (#$ . 6874) "P"]) #@824 Indent current line as Perl code, or optionally, insert a tab character. With an argument, indent the current line, regardless of other options. If `perl-tab-always-indent' is nil and point is not in the indentation area at the beginning of the line, simply insert a tab. Otherwise, indent the current line. If point was within the indentation area it is moved to the end of the indentation area. If the line was already indented properly and point was not within the indentation area, and if `perl-tab-to-comment' is non-nil (the default), then do the first possible action from the following list: 1) delete an empty comment 2) move forward to start of comment, indenting if necessary 3) move forward to end of line 4) create an empty comment 5) move backward to start of comment, indenting if necessary. (defalias 'perl-indent-command #[(&optional arg) "ƒÁÂ!‡ „iÄ VƒÅ ‡Æ‰‰` \nËyˆ` Ì \nbˆÁÍ\n\"…`U…<ƒXÏ8†R\n‰ ‚\\ËU…Ɖƈ`\nfÒUƒU…ÓÔ!‚Õ \"Ö8ƒ¢U…Ó×Ö8\"‚Ø8„¶U…Ù ‚ËyˆÚÜ#ƒðlƒ×Ë”bˆÝÆxˆÞ`\"‚`W„æUƒëÙ ‚Æ‚U„ýÆ‚Óß!ˆàá!*,‡" [arg perl-indent-line "\f" perl-tab-always-indent current-indentation insert-tab nil oldpnt delta lsexp bof 0 perl-beginning-of-function "\f\\|;?#" perl-tab-to-comment 2 state eol 61 message "In a format statement" parse-partial-sexp 3 "In a string which starts with a %c." 4 indent-for-comment re-search-forward comment-start-skip move " " kill-region "Use backslash to quote # characters." ding t] 4 (#$ . 7420) "P"]) #@134 Indent current line as Perl code. Return the amount the indentation changed by, or (parse-state) if line starts in a quoted string. (defalias 'perl-indent-line #[(&optional nochange parse-start) "Àd`Z †\fŠÂ )À‰‰Éyˆ`fÊUƒ)É‚wË!‰<ƒ7\f‚wÌ †?!ƒGÉ‚wÏÀwˆÌÐ!ƒ[Ñ\f\\]‚tgÓUƒi\fZ‚tgÕUƒt\f\\\fiZÏÀwˆ §ƒŽ ÉU„Ž `|ˆ\fjˆdZ`VƒdZbˆ .‡" [nil parse-start perl-beginning-of-function shift-amt indent beg bof pos case-fold-search 0 61 calculate-perl-indent looking-at nochange perl-nochange " \f" "\\(\\w\\|\\s_\\)+:" 1 perl-label-offset 125 perl-indent-level 123 perl-brace-offset] 6 (#$ . 8996)]) #@176 Return appropriate indentation for current line as Perl code. In usual case returns an integer: the column to indent to. Returns (parse-state) if line starts inside a string. (defalias 'calculate-perl-indent #[(&optional parse-start) "ŠÀyˆ`ÁÀÁ‰ƒbˆ‚È ˆ`Wƒ6`É`À#‰A@‚Ê 8ƒ@ ‚T\n„hËÁwˆgÌUƒRÀ‚TÍ ˆo„_hÎ>ƒcÀ‚T‚T\nfÌU„w\nTbˆi‚TÍ ˆhÐ=„hÑ=ƒ¦`ÒZfzÓ>ƒ¦hÐ=ƒÔ\n!ˆ‚ ÀyˆÍ ˆ‚zhÕ>„ÊÔ\n!ˆiŠbˆÖ×!)ƒÄ‚ÅÀ\\\\‚T\nbˆnƒâŠbˆÖÙ!)ƒâ†TŠÛuˆÜÁwˆÖÝ!ƒöÛyˆ‚æÖÞ!ƒ ŠÁˆ`)ßà!„æ`W…\f`Vƒá \"Z‚i)†Tnƒ6ÀUƒ6#\\‚8äÁxˆnƒDÀ‚F%hæ=ƒPçè!ˆá \\\\.‡" [0 nil containing-sexp state colon-line-end case-fold-search indent-point parse-start perl-beginning-of-function parse-partial-sexp 3 " \f" 123 perl-backward-to-noncomment (59 125) perl-continued-statement-offset 44 58 2 (119 95) perl-backward-to-start-of-continued-exp (59 125 123) looking-at "[ ]*{" perl-continued-brace-offset "[ ]*}" perl-indent-level 1 " \f\n" ";?#" "\\(\\w\\|\\s_\\)+:" search-forward ":" current-indentation perl-label-offset perl-brace-offset " " perl-brace-imaginary-offset 41 forward-sexp -1] 6 (#$ . 9632)]) #@76 Move point backward to after the first non-white-space, skipping comments. (defalias 'perl-backward-to-noncomment #[nil "À‰ ?…3`ÃyˆÄ \nÆÇ$ƒÇ•bˆÈÀwˆÉÀxˆo†.n?†.Êu‰‚*‡" [nil stop opoint 0 re-search-forward comment-start-skip move 1 ";" " \f" -1] 6 (#$ . 10772) nil]) (defalias 'perl-backward-to-start-of-continued-exp #[(lim) "hÀUƒ\nÁÂ!ˆÃyˆ`\fXƒ\fTbˆÅÆw‡" [41 forward-sexp -1 0 lim " \f" nil] 2]) #@56 Indent each line of the Perl grouping following point. (defalias 'indent-perl-exp #[nil "À ŠÄˆÅ ˆÂ )ÀÀÀ À\nË!fÌUƒ-ÍÎ!‚ËÍÏ!ˆŠÀˆ`)Šm„N`XƒNÐ`dÑ#ˆ‚: ) Ñyˆ`Ë!WƒÃÒÀË!\"‰\n§ƒ|lƒxÓ ˆÂ  Àˆ`ÔÐË !\"8ƒ½ÑyˆÕÖ!ƒ°\n<„°\nÑU„½× \nZUƒ½ÙÛ#ƒ½Ü ˆÝyˆ‚ZË !bˆÍÞ!.‡" [nil case-fold-search point-marker oldpnt 2 perl-beginning-of-function bof-mark eol last-mark lsexp-mark delta marker-position 61 message "Can't indent a format statement" "Indenting Perl expression..." parse-partial-sexp 0 perl-indent-line delete-horizontal-space 4 looking-at "\\s-*;?#" current-indentation comment-column re-search-forward comment-start-skip t indent-for-comment 1 "Indenting Perl expression...done"] 5 (#$ . 11188) nil]) #@177 Move backward to next beginning-of-function, or as far as possible. With argument, repeat that many times; negative args move forward. Returns new value of point in all cases. (defalias 'perl-beginning-of-function #[(&optional arg) "„ÁÂWƒÁuˆÂU„#ÃÄÅÆ$ƒ#•Sbˆ`‡" [arg 1 0 re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*=\\|^\\." nil move] 5 (#$ . 11940) "p"]) #@183 Move forward to next end-of-function. The end of a function is found by moving forward from the beginning of one. With argument, repeat that many times; negative args move backward. (defalias 'perl-end-of-function #[(&optional arg) "„ÁÂÄVƒV`dWƒV`Å ƒ)ÁuˆÈÁ!ˆoƒ4o„0ÉuˆÈÉ!ˆÅÊÁ!ˆËÅwˆÌÍ!ƒGÁyˆ`X„*S‰‚ ÄW…˜`ÈÁ!ˆÎÁ!ˆÁyˆ`YƒÈÏ!ˆo„ÊÁ!ˆËÅwˆÌÍ!ƒÁyˆ‚ebˆ)T‰‚W)‡" [arg 1 t first 0 nil npos pos perl-beginning-of-function -1 forward-list " " looking-at "[#\n]" forward-sexp 2] 3 (#$ . 12338) "p"]) #@55 Put mark at end of Perl function, point at beginning. (defalias 'mark-perl-function #[nil "À`!ˆÁ ˆÀ`!ˆÂ ˆÃ ‡" [push-mark perl-end-of-function perl-beginning-of-function backward-paragraph] 2 (#$ . 12867) nil]) emacs-19.30/lisp/picture.elc100666 12120 1 47645 5747270712 14270 0ustar rmsdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue Apr 25 18:03:46 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/picture.el ;;; emacs version 19.28.90.40. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/picture.el' was compiled for Emacs 19")) #@165 Move to column COLUMN in current line. Differs from `move-to-column' in that it creates or modifies whitespace if necessary to attain exactly the specified column. (defalias 'move-to-column-force #[(column) "À !„Âà !ˆi‰ Wƒ jˆ‚5\f U„5hÅUƒ5ÆÈÉ!ˆ\fjˆÃ !ˆ)Ê )‡" [natnump column 0 move-to-column col 9 nil indent-tabs-mode delete-char -1 hscroll-point-visible] 3 (#$ . 484)]) #@155 Position point at the beginning of the line. With ARG not nil, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error. (defalias 'picture-beginning-of-line #[(&optional arg) "ƒ\nÁ!SyˆÂyˆÃ ‡" [arg prefix-numeric-value 0 hscroll-point-visible] 2 (#$ . 873) "P"]) #@173 Position point after last non-blank character on current line. With ARG not nil, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error. (defalias 'picture-end-of-line #[(&optional arg) "ƒ\nÁ!SyˆÂyˆÃ`ĈxˆÅ ‡" [arg prefix-numeric-value 0 " " nil hscroll-point-visible] 3 (#$ . 1179) "P"]) #@91 Move cursor right, making whitespace if necessary. With argument, move that many columns. (defalias 'picture-forward-column #[(arg) "i\\ !ˆÃW…i V…Äu)‡" [arg target-column move-to-column-force 0 -1] 2 (#$ . 1513) "p"]) #@90 Move cursor left, making whitespace if necessary. With argument, move that many columns. (defalias 'picture-backward-column #[(arg) "À [!‡" [picture-forward-column arg] 2 (#$ . 1745) "p"]) #@92 Move vertically down, making whitespace if necessary. With argument, move that many lines. (defalias 'picture-move-down #[(arg) "iÁ\n!ˆÃ!)‡" [col picture-newline arg move-to-column-force] 2 (#$ . 1940) "p"]) #@65 Amount to move vertically after text character in Picture mode. (defconst picture-vertical-step 0 (#$ . 2156)) #@67 Amount to move horizontally after text character in Picture mode. (defconst picture-horizontal-step 1 (#$ . 2273)) #@90 Move vertically up, making whitespace if necessary. With argument, move that many lines. (defalias 'picture-move-up #[(arg) "À [!‡" [picture-move-down arg] 2 (#$ . 2394) "p"]) #@60 Move right after self-inserting character in Picture mode. (defalias 'picture-movement-right #[nil "ÀÁÂ\"‡" [picture-set-motion 0 1] 3 (#$ . 2576) nil]) #@59 Move left after self-inserting character in Picture mode. (defalias 'picture-movement-left #[nil "ÀÁÂ\"‡" [picture-set-motion 0 -1] 3 (#$ . 2735) nil]) #@57 Move up after self-inserting character in Picture mode. (defalias 'picture-movement-up #[nil "ÀÁÂ\"‡" [picture-set-motion -1 0] 3 (#$ . 2893) nil]) #@59 Move down after self-inserting character in Picture mode. (defalias 'picture-movement-down #[nil "ÀÁÂ\"‡" [picture-set-motion 1 0] 3 (#$ . 3047) nil]) #@66 Move up and left after self-inserting character in Picture mode. (defalias 'picture-movement-nw #[nil "ÀÁ‰\"‡" [picture-set-motion -1] 3 (#$ . 3204) nil]) #@67 Move up and right after self-inserting character in Picture mode. (defalias 'picture-movement-ne #[nil "ÀÁÂ\"‡" [picture-set-motion -1 1] 3 (#$ . 3365) nil]) #@68 Move down and left after self-inserting character in Picture mode. (defalias 'picture-movement-sw #[nil "ÀÁÂ\"‡" [picture-set-motion 1 -1] 3 (#$ . 3529) nil]) #@69 Move down and right after self-inserting character in Picture mode. (defalias 'picture-movement-se #[nil "ÀÁ‰\"‡" [picture-set-motion 1] 3 (#$ . 3694) nil]) #@129 Set VERTICAL and HORIZONTAL increments for movement in Picture mode. The mode line is updated to reflect the current direction. (defalias 'picture-set-motion #[(vert horiz) "\nÄÅ\nƦƦTÇ_È\\\\É›@\"\nË ˆÌÍ!‡" [vert picture-vertical-step horiz picture-horizontal-step format "Picture:%s" 2 3 1 (nw up ne left none right sw down se) mode-name force-mode-line-update message ""] 5 (#$ . 3858)]) #@77 Move in direction of `picture-vertical-step' and `picture-horizontal-step'. (defalias 'picture-move #[nil "À !ˆÂ !‡" [picture-move-down picture-vertical-step picture-forward-column picture-horizontal-step] 2 (#$ . 4260)]) #@259 Move point in direction of current picture motion in Picture mode. With ARG do it that many times. Useful for delineating rectangles in conjunction with diagonal picture motion. Do \[command-apropos] picture-movement to see commands which control motion. (defalias 'picture-motion #[(arg) "À \n_!ˆÃ \f_!‡" [picture-move-down arg picture-vertical-step picture-forward-column picture-horizontal-step] 3 (#$ . 4489) "p"]) #@268 Move point in direction opposite of current picture motion in Picture mode. With ARG do it that many times. Useful for delineating rectangles in conjunction with diagonal picture motion. Do \[command-apropos] `picture-movement' to see commands which control motion. (defalias 'picture-motion-reverse #[(arg) "À [!‡" [picture-motion arg] 2 (#$ . 4918) "p"]) #@271 Insert this character in place of character previously at the cursor. The cursor then moves in the direction you previously specified with the commands `picture-movement-right', `picture-movement-up', etc. Do \[command-apropos] `picture-movement' to see those commands. (defalias 'picture-self-insert #[(arg) "ÁV…SÂiT!ˆÃÄ!ˆ cˆÄuˆÆ ˆ‚‡" [arg 0 move-to-column-force delete-char -1 last-command-event picture-move] 2 (#$ . 5283) "p"]) #@51 Clear out ARG columns after point without moving. (defalias 'picture-clear-column #[(arg) "`i‰\n\\Ä !ˆ`|ˆŠ ]j,‡" [opoint original-col arg target-col move-to-column-force] 3 (#$ . 5728) "p"]) #@60 Clear out ARG columns before point, moving back over them. (defalias 'picture-backward-clear-column #[(arg) "À [!‡" [picture-clear-column arg] 2 (#$ . 5930) "p"]) #@219 Clear out rest of line; if at end of line, advance to next line. Cleared-out line text goes into the kill ring, as do newlines that are advanced over. With argument, clear out (and save in kill ring) that many lines. (defalias 'picture-clear-line #[(arg) "ƒÁ!Â!ˆÃÄVƒ‚[!‡ÅÆ!ƒ)Ç`Èyˆ`\"‡É`ʈ`\"‡" [arg prefix-numeric-value kill-line newline 0 looking-at "[ ]*$" kill-ring-save 1 kill-region nil] 3 (#$ . 6100) "P"]) #@152 Move to the beginning of the following line. With argument, moves that many lines (up, if negative argument); always moves to the beginning of a line. (defalias 'picture-newline #[(arg) "ÁWƒ\fyˆ‚)ÁVƒ)ˆmƒà ˆ‚\"ÄuˆS‰‚ Å ‡" [arg 0 nil newline 1 hscroll-point-visible] 3 (#$ . 6537) "p"]) #@93 Insert an empty line after the current line. With positive argument insert that many lines. (defalias 'picture-open-line #[(arg) "ŠÀˆÁ\n!ˆ)à ‡" [nil open-line arg hscroll-point-visible] 2 (#$ . 6842) "p"]) #@51 Insert a duplicate of the current line, below it. (defalias 'picture-duplicate-line #[nil "ŠÀyˆ`ÁÂ!ˆ`{Äyˆ c*‡" [0 picture-newline 1 contents -1] 3 (#$ . 7055) nil]) (defalias 'picture-replace-match #[(newtext fixedcase literal) "À‰‰Ä•‰bˆiÀ‰Ç \n#ˆi Z‰ƒ0ËÌ \"‰„'* bˆ\nÄVƒD`Í\ni\\!ˆ`|ˆÇ \n#ˆ\nÄW…XÎÏ\n[\"+‡" [nil pos change ocolumn 0 list1 buffer-undo-list replace-match newtext fixedcase literal primitive-undo 1 move-to-column-force insert-char 32] 5]) #@1180 *A character set which controls behavior of commands \[picture-set-tab-stops] and \[picture-tab-search]. It is NOT a regular expression, any regexp special characters will be quoted. It defines a set of "interesting characters" to look for when setting (or searching for) tab stops, initially "!-~" (all printing characters). For example, suppose that you are editing a table which is formatted thus: | foo | bar + baz | 23 * | bubbles | and + etc | 97 * and that `picture-tab-chars' is "|+*". Then invoking \[picture-set-tab-stops] on either of the previous lines would result in the following tab stops : : : : Another example - "A-Za-z0-9" would produce the tab stops : : : : Note that if you want the character `-' to be in the set, it must be included in a range or else appear in a context where it cannot be taken for indicating a range (e.g. "-A-Z" declares the set to be the letters `A' through `Z' and the character `-'). If you want the character `\' in the set it must be preceded by itself: "\\". The command \[picture-tab-search] is defined to move beneath (or to) a character belonging to this set independent of the tab stops list. (defvar picture-tab-chars "!-~" (#$ . -7541)) #@477 Set value of `tab-stop-list' according to context of this line. This controls the behavior of \[picture-tab]. A tab stop is set at every column occupied by an "interesting character" that is preceded by whitespace. Interesting characters are defined by the variable `picture-tab-chars', see its documentation for an example of usage. With ARG, just (re)set `tab-stop-list' to its default value. The tab stops computed are displayed in the minibuffer with `:' at each stop. (defalias 'picture-set-tab-stops #[(&optional arg) "ŠÀ\nƒÃÄ!‚BÅÆ!ÈQ Êyˆ` ÀˆÌ  Í#ƒ5ÎÀwˆi B‚ „AÏÐÆ!\"ˆ* Ñ GS 8TÒ\" ƒa @ÔIˆ A‰„SÕ!+‡" [nil tabs arg default-value tab-stop-list "[ ]+[" regexp-quote picture-tab-chars "]" regexp 0 bol re-search-backward t " " error "No characters in set %s on this line." make-string 32 blurb 58 message] 5 (#$ . 8773) "P"]) #@316 Move to column beneath next interesting char in previous line. With ARG move to column occupied by next interesting character in this line. The character must be preceded by whitespace. "interesting characters" are defined by variable `picture-tab-chars'. If no such character is found, move to beginning of line. (defalias 'picture-tab-search #[(&optional arg) "iŠ „ÂyˆÃÄ !Pexˆo„Æ!ˆÇÈÄ !ÉQŠÊˆ`)Ë#ƒ2iS‚4Ê)ƒ?Ì!‚CÂyˆÊ)‡" [target arg 0 "^" regexp-quote picture-tab-chars move-to-column re-search-forward "[ ]+[" "]" nil move move-to-column-force] 4 (#$ . 9640) "P"]) #@256 Tab transparently (just move point) to next tab stop. With prefix arg, overwrite the traversed text with spaces. The tab stop list can be changed by \[picture-set-tab-stops] and \[edit-tab-stops]. See also documentation for variable `picture-tab-chars'. (defalias 'picture-tab #[(&optional arg) "`Á ˆ\n…Ãi`|ˆ\fj*)‡" [opoint move-to-tab-stop arg nil column indent-tabs-mode] 2 (#$ . 10228) "P"]) #@134 Rectangle killed or copied by \[picture-clear-rectangle] in Picture mode. The contents can be retrieved by \[picture-yank-rectangle] (defconst picture-killed-rectangle nil (#$ . 10637)) #@282 Clear and save rectangle delineated by point and mark. The rectangle is saved for yanking by \[picture-yank-rectangle] and replaced with whitespace. The previously saved rectangle, if any, is lost. With prefix argument, the rectangle is actually killed, shifting remaining text. (defalias 'picture-clear-rectangle #[(start end &optional killp) "À \n #‰‡" [picture-snarf-rectangle start end killp picture-killed-rectangle] 4 (#$ . 10830) "r\nP"]) #@208 Clear rectangle delineated by point and mark into REGISTER. The rectangle is saved in REGISTER and replaced with whitespace. With prefix argument, the rectangle is actually killed, shifting remaining text. (defalias 'picture-clear-rectangle-to-register #[(start end register &optional killp) "À  \f #\"‡" [set-register register picture-snarf-rectangle start end killp] 6 (#$ . 11286) "r\ncRectangle to register: \nP"]) (defalias 'picture-snarf-rectangle #[(start end &optional killp) "iÀŠ ƒÄ \"‚Ç \"È \"ˆ)É\n!ˆ*‡" [nil indent-tabs-mode column killp delete-extract-rectangle start end extract-rectangle clear-rectangle move-to-column-force] 4]) #@317 Overlay rectangle saved by \[picture-clear-rectangle] The rectangle is positioned with upper left corner at point, overwriting existing text. With prefix argument, the rectangle is inserted instead, shifting existing text. Leaves mark at one corner of rectangle and point at the other (diagonally opposed) corner. (defalias 'picture-yank-rectangle #[(&optional insertp) ":„ ÁÂ!‡Ã\f\"‡" [picture-killed-rectangle error "No rectangle saved." picture-insert-rectangle insertp] 3 (#$ . 11951) "P"]) #@269 Insert the last killed rectangle at the position clicked on. Also move point to one end of the text thus inserted (normally the end). Prefix arguments are interpreted as with \[yank]. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click. (defalias 'picture-yank-at-click #[(click arg) "„Á\n!ˆÃ\f!‡" [mouse-yank-at-point mouse-set-point click picture-yank-rectangle arg] 2 (#$ . 12458) "e\nP"]) #@300 Overlay rectangle saved in REGISTER. The rectangle is positioned with upper left corner at point, overwriting existing text. With prefix argument, the rectangle is inserted instead, shifting existing text. Leaves mark at one corner of rectangle and point at the other (diagonally opposed) corner. (defalias 'picture-yank-rectangle-from-register #[(register &optional insertp) "À !‰:„ÃÄ \"‚Å\n\")‡" [get-register register rectangle error "Register %c does not contain a rectangle." picture-insert-rectangle insertp] 4 (#$ . 12892) "cRectangle from register: \nP"]) #@168 Overlay RECTANGLE with upper left corner at point. Optional argument INSERTP, if non-nil causes RECTANGLE to be inserted. Leaves the region surrounding the rectangle. (defalias 'picture-insert-rectangle #[(rectangle &optional insertp) "À\n„ŠÃ`Ä @G!ˆÆ GS!ˆ`\"ˆ)Ç ˆÈ !)‡" [nil indent-tabs-mode insertp delete-rectangle picture-forward-column rectangle picture-move-down push-mark insert-rectangle] 4 (#$ . 13472)]) (byte-code "ÀÁ\nBÀ‡" [nil picture-mode-map current-load-list] 2) (defalias 'picture-substitute #[(oldfun newfun) "À \n \f$‡" [substitute-key-definition oldfun newfun picture-mode-map global-map] 5]) (byte-code "„ÙÁÂÃÄ\"DÅÆÇ\"ˆÅÈÉ\"ˆÅÊË\"ˆÅÌÍ\"ˆÅÎÏ\"ˆÅÐÏ\"ˆÅÑÒ\"ˆÅÓÔ\"ˆÅÕÖ\"ˆÅ×Ø\"ˆÅÙÚ\"ˆÅÛÜ\"ˆÅÝÞ\"ˆÅßà\"ˆáâÌ#ˆáãä#ˆáåæ#ˆáãç#ˆáèé#ˆáêë#ˆáìí#ˆáîï#ˆáðñ#ˆáòó#ˆáôõ#ˆáö÷#ˆáøù#ˆáúû#ˆáüý#ˆáþÿ#ˆá@A#ˆáBC#ˆáDE#ˆáFG#ˆÄ‡" [picture-mode-map keymap make-vector 256 nil picture-substitute self-insert-command picture-self-insert forward-char picture-forward-column backward-char picture-backward-column delete-char picture-clear-column backward-delete-char-untabify picture-backward-clear-column delete-backward-char kill-line picture-clear-line open-line picture-open-line newline picture-newline newline-and-indent picture-duplicate-line next-line picture-move-down previous-line picture-move-up beginning-of-line picture-beginning-of-line end-of-line picture-end-of-line define-key "" " " picture-toggle-tab-state " " picture-tab picture-tab-search " " picture-set-tab-stops " " picture-clear-rectangle "" picture-clear-rectangle-to-register "" picture-yank-rectangle "" picture-yank-rectangle-from-register "" picture-mode-exit "" picture-motion "" picture-motion-reverse "<" picture-movement-left ">" picture-movement-right "^" picture-movement-up "." picture-movement-down "`" picture-movement-nw "'" picture-movement-ne "/" picture-movement-sw "\\" picture-movement-se] 4) #@115 If non-nil, its value is called on entry to Picture mode. Picture mode is invoked by the command \[picture-mode]. (defvar picture-mode-hook nil (#$ . 15424)) (byte-code "À B Bà BÄ BÀ‡" [picture-mode-old-local-map current-load-list picture-mode-old-mode-name picture-mode-old-major-mode picture-mode-old-truncate-lines] 2) #@3069 Switch to Picture mode, in which a quarter-plane screen model is used. Printing characters replace instead of inserting themselves with motion afterwards settable by these commands: C-c < Move left after insertion. C-c > Move right after insertion. C-c ^ Move up after insertion. C-c . Move down after insertion. C-c ` Move northwest (nw) after insertion. C-c ' Move northeast (ne) after insertion. C-c / Move southwest (sw) after insertion. C-c \ Move southeast (se) after insertion. The current direction is displayed in the mode line. The initial direction is right. Whitespace is inserted and tabs are changed to spaces when required by movement. You can move around in the buffer with these commands: \[picture-move-down] Move vertically to SAME column in previous line. \[picture-move-up] Move vertically to SAME column in next line. \[picture-end-of-line] Move to column following last non-whitespace character. \[picture-forward-column] Move right inserting spaces if required. \[picture-backward-column] Move left changing tabs to spaces if required. C-c C-f Move in direction of current picture motion. C-c C-b Move in opposite direction of current picture motion. Return Move to beginning of next line. You can edit tabular text with these commands: M-Tab Move to column beneath (or at) next interesting character. `Indents' relative to a previous line. Tab Move to next stop in tab stop list. C-c Tab Set tab stops according to context of this line. With ARG resets tab stops to default (global) value. See also documentation of variable picture-tab-chars which defines "interesting character". You can manually change the tab stop list with command \[edit-tab-stops]. You can manipulate text with these commands: C-d Clear (replace) ARG columns after point without moving. C-c C-d Delete char at point - the command normally assigned to C-d. \[picture-backward-clear-column] Clear (replace) ARG columns before point, moving back over them. \[picture-clear-line] Clear ARG lines, advancing over them. The cleared text is saved in the kill ring. \[picture-open-line] Open blank line(s) beneath current line. You can manipulate rectangles with these commands: C-c C-k Clear (or kill) a rectangle and save it. C-c C-w Like C-c C-k except rectangle is saved in named register. C-c C-y Overlay (or insert) currently saved rectangle at point. C-c C-x Like C-c C-y except rectangle is taken from named register. \[copy-rectangle-to-register] Copies a rectangle to a register. \[advertised-undo] Can undo effects of rectangle overlay commands commands if invoked soon enough. You can return to the previous mode with: C-c C-c Which also strips trailing whitespace from every line. Stripping is suppressed by supplying an argument. Entry to this mode calls the value of picture-mode-hook if non-nil. Note that Picture mode commands will work outside of Picture mode, but they are not defaultly assigned to keys. (defalias 'picture-mode #[nil "Á=ƒ\nÂÃ!‡ÄÅ!ˆÆ Ç!ˆÄÉ!ˆ\n ÄË!ˆ ÁÄÌ!ˆÍ\fÄÎ!ˆÏÎ!ÄÐ!ˆÏÐ!ÄÑ!ˆÄÒ!ˆÄÓ!ˆÕÖ×Ø\"ˆÙÚÛ\"ˆÜÝÞ! \"‡" [major-mode picture-mode error "You are already editing a picture." make-local-variable picture-mode-old-local-map current-local-map use-local-map picture-mode-map picture-mode-old-mode-name mode-name picture-mode-old-major-mode picture-killed-rectangle nil tab-stop-list default-value picture-tab-chars picture-vertical-step picture-horizontal-step picture-mode-old-truncate-lines truncate-lines t picture-set-motion 0 1 run-hooks edit-picture-hook picture-mode-hook message substitute-command-keys "Type \\[picture-mode-exit] in this buffer to return it to %s mode."] 3 (#$ . 15759) nil]) (defalias (quote edit-picture) (quote picture-mode)) #@172 Undo picture-mode and return to previous major mode. With no argument strips whitespace from end of every line in Picture buffer otherwise just return to previous mode. (defalias 'picture-mode-exit #[(&optional nostrip) "Á=„\nÂÃ!‡\f„Å ˆÈ !ˆ\nËÌ!ˆ Ï ‡" [major-mode picture-mode error "You aren't editing a Picture." nostrip picture-clean picture-mode-old-mode-name mode-name use-local-map picture-mode-old-local-map picture-mode-old-major-mode kill-local-variable tab-stop-list picture-mode-old-truncate-lines truncate-lines force-mode-line-update] 2 (#$ . 19618) "P"]) #@40 Eliminate whitespace at ends of lines. (defalias 'picture-clean #[nil "ŠebˆÀÁÂÃ#…Ä”`|ˆ‚)‡" [re-search-forward "[ ][ ]*$" nil t 0] 4 (#$ . 20209)]) (provide (quote picture)) emacs-19.30/lisp/pp.elc100666 12120 1 6142 6045214245 13166 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:25:36 1995 ;;; from file /home/fsf/rms/e19/lisp/pp.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`pp.el' was compiled for Emacs 19.29 or later")) #@57 *Value of print-escape-newlines used by pp-* functions. (defvar pp-escape-newlines t (#$ . -464)) #@197 Return a string containing the pretty-printed representation of OBJECT, any Lisp object. Quoting characters are used when needed to make output that `read' can handle, whenever this is possible. (defalias 'pp-to-string #[(object) "ŠÀÁ!qˆÂŽÃÄ!ˆ Çp\"ˆ)ebˆm„ØÉÊ!ƒ/ÉÊ!ƒËuˆ‚#ÉÌ!ƒ~Ë”ËVƒ~Ë”SfÍUƒ~ŠÎ”bˆÏ ˆÐÑ`f\")ƒ~Ë”SË•|ˆÒcˆÏË!ˆÉÓ!ƒsÔ”Ô•|ˆ‚wÕÖ!ˆ×Ë!ˆ‚ØÙÚƒ¤ÛË!ˆÜÝxˆ`ÜÝwˆ`|ˆÐÞ`Sf\"„ßcˆ‚ØàáƒÒÉâ!ƒ·Ëuˆ‚«ÜÝxˆ`ÜÝwˆ`|ˆÐÞ`Sf\"„ßcˆ‚dbˆ‚ebˆã ˆä *‡" [generate-new-buffer " pp-to-string" ((byte-code "Àp!‡" [kill-buffer] 2)) lisp-mode-variables t pp-escape-newlines print-escape-newlines prin1 object looking-at "\\s(" 1 "\\(quote[ ]+\\)\\([^.)]\\)" 40 2 forward-sexp char-equal 41 "'" "[ ]*)" 0 error "Malformed quote" backward-sexp err-var (byte-code "ÀÁÂ!ˆ‡" [t down-list 1] 3) ((error)) backward-char " " nil 39 10 (byte-code "ÀÁÂ!ˆ‡" [t up-list 1] 3) ((error)) "\\s)" indent-sexp buffer-string] 3 (#$ . 569)]) #@247 Output the pretty-printed representation of OBJECT, any Lisp object. Quoting characters are printed when needed to make output that `read' can handle, whenever this is possible. Output stream is STREAM, or value of `standard-output' (which see). (defalias 'pp #[(object &optional stream) "ÀÁ\n! † \f\"‡" [princ pp-to-string object stream standard-output] 3 (#$ . 1507)]) #@215 Evaluate EXPRESSION and pretty-print value into a new display buffer. If the pretty-printed value fits on one line, the message line is used instead. Value is also consed on to front of variable values 's value. (defalias 'pp-eval-expression #[(expression) "À !\nB ÅÆÇ\n@!‘ˆŠÆqˆÈ +‡" [eval expression values temp-buffer-show-function old-show-function #[(buf) "ŠqˆebˆÁˆ`TdW„`eZ Yƒ> Ä Å!ebˆÉÊ!!ˆËŽÌ!ˆÍÎ!,‚DÏÐe`{\")‡" [buf 1 screen-width old-show-function selected-window display-buffer window old-selected temp-buffer-show-function make-frame-visible window-frame ((select-window old-selected)) select-window run-hooks temp-buffer-show-hook message "%s"] 4] "*Pp Eval Output*" pp emacs-lisp-mode] 3 (#$ . 1886) "xPp-eval: "]) #@152 Run `pp-eval-expression' on sexp before point (which see). With argument, pretty-print output into current buffer. Ignores leading comment characters. (defalias 'pp-eval-last-sexp #[(arg) "À `Á‰Æ!ˆŠÈÉ!ˆŠÊyˆËÌ!)ƒC`\f{ÍÎ\n #ƒ<Ê”T\nÊ O\nÊ•ÁOP‚\"Ï\n!‚GÏp!)Æ !ˆƒZÑÒ\n!!c‚]Ó\n!,‡" [syntax-table nil exp start pt stab set-syntax-table emacs-lisp-mode-syntax-table forward-sexp -1 0 looking-at "[ ]*;" string-match "\n[ ]*;+" read arg pp-to-string eval pp-eval-expression] 4 (#$ . 2642) "P"]) (provide (quote pp)) emacs-19.30/lisp/profile.elc100666 13437 1 13571 5744577115 14404 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:48:27 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/profile.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/profile.el' was compiled for Emacs 19")) #@32 *List of functions to profile. (defvar profile-functions-list nil (#$ . -483)) #@37 *Name of the profile timer program. (defvar profile-timer-program (concat exec-directory "profile") (#$ . -568)) #@28 Process running the timer. (defvar profile-timer-process nil (#$ . 687)) #@55 List of accumulative time for each profiled function. (defvar profile-time-list nil (#$ . 766)) #@92 List of entry time for each function. Both how many times invoked and real time of start. (defvar profile-init-list nil (#$ . 868)) #@46 Max length of name of any function profiled. (defvar profile-max-fun-name 0 (#$ . 1007)) #@35 Should NOT be used anywhere else. (defvar profile-temp-result- nil (#$ . 1102)) #@38 Used to return result from a filter. (defvar profile-time (byte-code "À‰B‡" [0] 2) (#$ . 1188)) #@25 Name of profile buffer. (defvar profile-buffer "*profile*" (#$ . 1290)) #@112 Profile all the functions listed in `profile-functions-list'. With argument FLIST, use the list FLIST instead. (defalias 'profile-functions #[(&optional flist) "„ ÂÃ\"‡" [flist profile-functions-list mapcar profile-a-function] 3 (#$ . 1369) "*P"]) #@74 Filter for the timer process. Sets `profile-time' to the returned time. (defalias 'profile-filter #[(process input) "ÀÁ\n\"ÃUƒÄÅ\"‡È\nÉ”O! ˆÈ\nÕÉO!¡‡" [string-match "\\." input 0 error "Bad output from %s" profile-timer-program profile-time string-to-int nil] 5 (#$ . 1628)]) #@45 Print one ENTRY (from `profile-time-list'). (defalias 'profile-print #[(entry) "AÁÂÆÇ@\"±ˆÉ\n!ˆË @!‰cˆ\fG Y„8É\n!ˆ\fÍ \fGZOcˆ\fGuˆË A!ÎÏÍÐ\fGZO\fѱ+‡" [entry nil 5 offset str time format "%s" space move-to-column ref-column int-to-string spaces 0 "." "000000" 6 "\n"] 6 (#$ . 1921)]) (byte-code "ÀÁ\nBÁ‡" [" " spaces current-load-list] 2) #@101 Display profiling results in the buffer `*profile*'. (The buffer name comes from `profile-buffer'.) (defalias 'profile-results #[nil "Á\\ Ä\nOÆ!ˆÈ ˆÉ ±ˆÊ\n!ˆËÌ ±ˆÊ\n!ˆÍcˆÎÏ\"*‡" [profile-max-fun-name 8 ref-column spaces 0 space switch-to-buffer profile-buffer erase-buffer "Function" move-to-column "Time (Seconds.Useconds)\n" "========" "=======================\n" mapcar profile-print profile-time-list] 3 (#$ . 2340) nil]) (defalias 'profile-reset-timer #[nil "À Â\"‡" [process-send-string profile-timer-process "z\n"] 3]) #@44 If ENTRY has non zero time, give an error. (defalias 'profile-check-zero-init-times #[(entry) "AA‰@ÂU… AÂU?…ÃÄ!)‡" [entry time 0 error "Process timer died while making performance profile."] 3 (#$ . 2881)]) #@50 Get time from timer process into `profile-time'. (defalias 'profile-get-time #[nil "À !ƒ !Ã=„*ÄÅÆ!#É Ê\"ˆË !ˆÌ ˆÍÎ\"ˆÐ Ñ\"ˆÒ ‡" [processp profile-timer-process process-status run start-process "timer" get-buffer-create profile-buffer profile-timer-program set-process-filter profile-filter process-kill-without-query profile-reset-timer mapcar profile-check-zero-init-times profile-init-list process-send-string "p\n" accept-process-output] 4 (#$ . 3100)]) #@33 Linear search for FUN in FLIST. (defalias 'profile-find-function #[(fun flist) "??… @@=ƒ@A‡Â A\"‡" [flist fun profile-find-function] 3 (#$ . 3574)]) #@47 On entry, keep current time for function FUN. (defalias 'profile-start-function #[(fun) "À \n\"‰„ÄÅ \"ˆ @ÆU„ ‰@T ‚/ Ç ˆ A‰@ ˆ A¡)‡" [profile-find-function fun profile-init-list init-time error "Function %s missing from list" 0 1 profile-time] 4 (#$ . 3737)]) (byte-code "ÀÁ\nBÀ‡" [1000000 profile-million current-load-list] 2) #@66 When the call to the function FUN is finished, add its run time. (defalias 'profile-update-function #[(fun) "À \n\"À \"ĉ‰ƒ„ÉÊ \"ˆ‰@S ˆ@ËU??…ŒA\f@@Z\fAAZË ˆË¡ˆ ËY„`  \\S@\\ ˆ A\\¡ˆA W?…Œ‰@T ˆ‰A Z¡,‡" [profile-find-function fun profile-init-list profile-time-list nil usec sec accum init-time error "Function %s missing from list" 0 profile-time profile-million] 5 (#$ . 4083)]) #@27 Profile the function FUN. (defalias 'profile-a-function #[(fun) "KÁ!G‰@Ä=„ÅÆ\"ˆljBBBlj‰BBB B \n\nWƒ4\n\nË \"M*‡" [fun symbol-name funlen def lambda error "To profile: %s must be a user-defined function" 0 profile-time-list profile-init-list profile-max-fun-name profile-fix-fun] 5 (#$ . 4529) "aFunction to profile: "]) #@84 Take function FUN and return it fixed for profiling. DEF is (symbol-function FUN). (defalias 'profile-fix-fun #[(fun def) "À‰‰‰ÁÀ‰ GÊW?…  @ A@ AA@D ;…< GÊW?…  ;„J ‚YÊ C¤Ê ›@ <ƒo @Ë=ƒo C¤\fT\f ›‰@Ìš?… ÍC¤ÎÏDDC¤ÑÒÓC\n¤EC¤ÔC¤ÕÏDDC¤ÒC¤.‡" [nil 2 suffix inter count third second first prefix def 3 interactive (profile-get-time) (profile-get-time) profile-start-function quote fun setq profile-temp-result- progn (profile-get-time) profile-update-function] 8 (#$ . 4875)]) #@54 Restore profiled function FUN to its original state. (defalias 'profile-restore-fun #[(fun) "@KÁ‰‰A‰A@;ƒ\nA\nA@<ƒ(\nA@@Å=ƒ(\nAÆ\n›@‰<…A A@Ç=…A\n AA@A¡+‡" [fun nil index body def interactive 3 profile-temp-result-] 4 (#$ . 5405)]) #@52 Stop profiling functions. Clear all the settings. (defalias 'profile-finish #[nil "ÀÁ\n\"ˆÃÅʼn‡" [mapcar profile-restore-fun profile-time-list 0 profile-max-fun-name nil profile-init-list] 3 (#$ . 5655) nil]) #@25 Kill the timer process. (defalias 'profile-quit #[nil "À Â\"‡" [process-send-string profile-timer-process "q\n"] 3 (#$ . 5875) nil]) emacs-19.30/lisp/prolog.elc100666 13437 1 14254 5744577120 14241 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:48:30 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/prolog.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/prolog.el' was compiled for Emacs 19")) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ B‡" [boundp prolog-mode-syntax-table nil current-load-list prolog-mode-abbrev-table prolog-mode-map] 2) #@66 *Program name for invoking an inferior Prolog with `run-prolog'. (defvar prolog-program-name "prolog" (#$ . -633)) #@55 *(Re)Consult mode (for C-Prolog and Quintus Prolog).  (defvar prolog-consult-string "reconsult(user).\n" (#$ . -754)) #@37 *Compile mode (for Quintus Prolog). (defvar prolog-compile-string "compile(user).\n" (#$ . -878)) #@101 *String that represents end of file for prolog. nil means send actual operating system end of file. (defvar prolog-eof-string "end_of_file.\n" (#$ . -983)) (byte-code "ÀÁ!„ÂÁ B\f„lÅ ÇÈÉ#ˆÇÊË#ˆÇÌÍ#ˆÇÎÍ#ˆÇÏÍ#ˆÇÐÍ#ˆÇÑÍ#ˆÇÒÓ#ˆÇÔÕ#ˆÇÖÍ#ˆÇ×Í#ˆÇØÙ#ˆ)ÚÛÜ\"‡" [boundp prolog-indent-width 4 current-load-list prolog-mode-syntax-table make-syntax-table table modify-syntax-entry 95 "w" 92 "\\" 47 "." 42 43 45 61 37 "<" 10 ">" 60 62 39 "\"" define-abbrev-table prolog-mode-abbrev-table nil] 4) (defalias 'prolog-mode-variables #[nil "À !ˆ\nÄÅ!ˆÆPÄÈ!ˆ ÄÉ!ˆÊ ÄË!ˆÌ ÄÍ!ˆÎ ÄÏ!ˆÐÄÑ!ˆÒÄÓ!ˆÔ‰‡" [set-syntax-table prolog-mode-syntax-table prolog-mode-abbrev-table local-abbrev-table make-local-variable paragraph-start "%%\\|$\\|" page-delimiter paragraph-separate paragraph-ignore-fill-prefix t indent-line-function prolog-indent-line comment-start "%" comment-start-skip "%+ *" comment-column 48 comment-indent-function prolog-comment-indent] 2]) (defalias 'prolog-mode-commands #[(map) "À ÂÃ#ˆÀ ÄÅ#‡" [define-key map " " prolog-indent-line "" prolog-consult-region] 4]) (byte-code "„ Á Â!ˆÁ‡" [prolog-mode-map make-sparse-keymap prolog-mode-commands] 2) #@228 Major mode for editing Prolog code for Prologs. Blank lines and `%%...' separate paragraphs. `%'s start comments. Commands: \{prolog-mode-map} Entry to this mode calls the value of `prolog-mode-hook' if that value is non-nil. (defalias 'prolog-mode #[nil "À ˆÁ\n!ˆÃÅÇ ˆÈÉ!‡" [kill-all-local-variables use-local-map prolog-mode-map prolog-mode major-mode "Prolog" mode-name prolog-mode-variables run-hooks prolog-mode-hook] 2 (#$ . 2183) nil]) #@138 Indent current line as Prolog code. With argument, indent any additional lines of the same clause rigidly along with this one (not yet). (defalias 'prolog-indent-line #[(&optional whole-exp) "À d`ZÁÅyˆ`ÆÁwˆ\fiZÅU„!\n`|ˆ\fjˆd Z`V…-d Zb+‡" [prolog-indent-level nil beg pos indent 0 " "] 3 (#$ . 2637) "p"]) #@35 Compute prolog indentation level. (defalias 'prolog-indent-level #[nil "ŠÀyˆÁÂwˆÃÄ!ƒÀ‚áÃÅ!ƒ‚áoƒ%À‚álj‰ \n ÃÌ!ƒ=Ç‚@ ƒmÍyˆÀyˆoƒV‰ ‚BÁÂwˆÃÅ!„@ÃÎ!„@‰ „EoƒwÀ\n‚zi\nÃÏ!ƒ…\n‚àÃÐ!ƒ‘Ç ‚”Â Ñ ˆo„žÍuˆÃÒ!ƒ¿ ƒ·ÃÓ!ƒ·\n\\‚à\n]‚àÃÖ!ƒÊ‚à„ÕÃ×!ƒß\nZÀ]‚àÀ,)‡" [0 " " nil looking-at "%%%" "%[^%]" comment-column t less more ind empty ")" -1 "\n" "%%[^%]" "(" end-of-prolog-clause "[,(;>]" "[^,]" prolog-indent-width tab-width "-" "[^.]"] 5 (#$ . 2955)]) #@35 Go to end of clause in this line. (defalias 'end-of-prolog-clause #[nil "ÀyˆŠÁˆ`)Ã\f\nÅ#ƒÀ”bˆÆÁx)‡" [0 nil eolpos re-search-forward comment-start-skip move " "] 4 (#$ . 3464)]) #@37 Compute prolog comment indentation. (defalias 'prolog-comment-indent #[nil "ÀÁ!ƒ‡ÀÃ!ƒÄ ‡ŠÅÆxˆinƒ‚ Ç\\])‡" [looking-at "%%%" 0 "%%" prolog-indent-level " " nil 1 comment-column] 2 (#$ . 3652)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp inferior-prolog-mode-map nil current-load-list] 2) #@1013 Major mode for interacting with an inferior Prolog process. The following commands are available: \{inferior-prolog-mode-map} Entry to this mode calls the value of `prolog-mode-hook' with no arguments, if that value is non-nil. Likewise with the value of `comint-mode-hook'. `prolog-mode-hook' is called after `comint-mode-hook'. You can send text to the inferior Prolog from other buffers using the commands `send-region', `send-string' and \[prolog-consult-region]. Commands: Tab indents for Prolog; with argument, shifts rest of expression rigidly with the current line. Paragraphs are separated only by blank lines and '%%'. '%'s start comments. Return at end of buffer sends line as input. Return not at end copies rest of line to end and sends it. \[comint-kill-input] and \[backward-kill-word] are kill commands, imitating normal Unix input editing. \[comint-interrupt-subjob] interrupts the shell or its current subjob if any. \[comint-stop-subjob] stops. \[comint-quit-subjob] sends quit signal. (defalias 'inferior-prolog-mode #[nil "ÀÁ!ˆÂ ˆÃÅÇÉ ˆ\n„\"Ë\f!\nÍ\n!ˆÎ\n!ˆÏÐ!‡" [require comint comint-mode inferior-prolog-mode major-mode "Inferior Prolog" mode-name "^| [ ?][- ] *" comint-prompt-regexp prolog-mode-variables inferior-prolog-mode-map copy-keymap comint-mode-map prolog-mode-commands use-local-map run-hooks prolog-mode-hook] 2 (#$ . 3952) nil]) #@71 Run an inferior Prolog process, input and output via buffer *prolog*. (defalias 'run-prolog #[nil "ÀÁ!ˆÂÃÄ \"!ˆÆ ‡" [require comint switch-to-buffer make-comint "prolog" prolog-program-name inferior-prolog-mode] 4 (#$ . 5343) nil]) #@144 Send the region to the Prolog process made by "M-x run-prolog". If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode. (defalias 'prolog-consult-region #[(compile beg end) "Šƒ Á \"ˆ‚ÁÂ\f\"ˆÅÂ#ˆÁÂÈ\"ˆ ƒ,Á \"‚/ÊÂ!)‡" [compile send-string "prolog" prolog-compile-string prolog-consult-string send-region beg end "\n" prolog-eof-string process-send-eof] 4 (#$ . 5582) "P\nr"]) #@151 Send the region to the inferior Prolog, and switch to *prolog* buffer. If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode. (defalias 'prolog-consult-region-and-go #[(compile beg end) "À \n #ˆÄÅ!‡" [prolog-consult-region compile beg end switch-to-buffer "*prolog*"] 4 (#$ . 6000) "P\nr"]) emacs-19.30/lisp/ps-print.elc100666 12120 1 111275 6011352460 14362 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Aug 7 04:55:42 1995 ;;; from file /home/fsf/rms/e19/lisp/ps-print.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`ps-print.el' was compiled for Emacs 19.29 or later")) #@357 ps-print.el,v 2.8 1995/05/04 12:06:10 jct Exp Jim's last change version -- this file may have been edited as part of Emacs without changes to the version number. When reporting bugs, please also report the version of Emacs, if any, that ps-print was distributed with. Please send all bug fixes and enhancements to Jim Thompson . (defconst ps-print-version "2.8" (#$ . 475)) #@52 *The shell command for printing a PostScript file. (defvar ps-lpr-command lpr-command (#$ . -882)) #@56 *A list of extra switches to pass to `ps-lpr-command'. (defvar ps-lpr-switches lpr-switches (#$ . -987)) #@367 *Non-nil indicates spooling is for a two-sided printer. For a duplex printer, the `ps-spool-*' commands will insert blank pages as needed between print jobs so that the next buffer printed will start on the right page. Also, if headers are turned on, the headers will be reversed on duplex printers so that the page numbers fall to the left on even-numbered pages. (defvar ps-spool-duplex nil (#$ . -1099)) #@100 *Specifies the size of paper to format for. Should be one of `ps-letter', `ps-legal', or `ps-a4'. (defvar ps-paper-type (quote ps-letter) (#$ . -1514)) #@267 *Non-nil means print a header at the top of each page. By default, the header displays the buffer name, page number, and, if the buffer is visiting a file, the file's directory. Headers are customizable by changing variables `ps-header-left' and `ps-header-right'. (defvar ps-print-header t (#$ . -1674)) #@54 *Non-nil means draw a gaudy frame around the header. (defvar ps-print-header-frame t (#$ . -1986)) #@149 *Non-nil means show page numbers as N/M, meaning page N of M. Note: page numbers are displayed as part of headers, see variable `ps-print-headers'. (defvar ps-show-n-of-n t (#$ . -2092)) #@48 *If non-nil, print the buffer's text in color. (defvar ps-print-color-p (byte-code "ÀÁ!„\fÀÂ!…ÀÃ!‡" [fboundp x-color-values pixel-components float] 2) (#$ . -2285)) #@66 *RGB values of the default foreground color. Defaults to black. (defvar ps-default-fg (quote (0.0 0.0 0.0)) (#$ . -2459)) #@66 *RGB values of the default background color. Defaults to white. (defvar ps-default-bg (quote (1.0 1.0 1.0)) (#$ . -2588)) #@51 *Font size, in points, for generating Postscript. (defvar ps-font-size 10 (#$ . -2717)) #@66 *Font family name for ordinary text, when generating Postscript. (defvar ps-font "Courier" (#$ . -2811)) #@62 *Font family name for bold text, when generating Postscript. (defvar ps-font-bold "Courier-Bold" (#$ . -2922)) #@64 *Font family name for italic text, when generating Postscript. (defvar ps-font-italic "Courier-Oblique" (#$ . -3039)) #@69 *Font family name for bold italic text, when generating Postscript. (defvar ps-font-bold-italic "Courier-BoldOblique" (#$ . -3163)) #@330 *The average width, in points, of a character, for generating Postscript. This is the value that ps-print uses to determine the length, x-dimension, of the text it has printed, and thus affects the point at which long lines wrap around. If you change the font or font size, you will probably have to adjust this value to match. (defvar ps-avg-char-width (byte-code "ÀÁ!ƒ‡Ç" [fboundp float 5.5999999999999996 6] 2) (#$ . -3302)) #@109 *The width of a space character, for generating Postscript. This value is used in expanding tab characters. (defvar ps-space-width (byte-code "ÀÁ!ƒ‡Ç" [fboundp float 5.5999999999999996 6] 2) (#$ . -3742)) #@381 *The height of a line, for generating Postscript. This is the value that ps-print uses to determine the height, y-dimension, of the lines of text it has printed, and thus affects the point at which page-breaks are placed. If you change the font or font size, you will probably have to adjust this value to match. The line-height is *not* the same as the point size of the font. (defvar ps-line-height (byte-code "ÀÁ!ƒ‡Ç" [fboundp float 11.289999999999999 11] 2) (#$ . -3958)) #@164 *Non-nil means automatically detect bold/italic face attributes. nil means rely solely on the lists `ps-bold-faces', `ps-italic-faces', and `ps-underlined-faces'. (defvar ps-auto-font-detect t (#$ . -4447)) #@109 *A list of the (non-bold) faces that should be printed in bold font. This applies to generating Postscript. (defvar ps-bold-faces nil (#$ . -4661)) #@113 *A list of the (non-italic) faces that should be printed in italic font. This applies to generating Postscript. (defvar ps-italic-faces nil (#$ . -4816)) #@113 *A list of the (non-underlined) faces that should be printed underlined. This applies to generating Postscript. (defvar ps-underlined-faces nil (#$ . -4977)) #@73 *Number of lines to display in page header, when generating Postscript. (defvar ps-header-lines 2 (#$ . -5141)) (make-variable-buffer-local (quote ps-header-lines)) #@690 *The items to display on the right part of the page header. This applies to generating Postscript. The value should be a list of strings and symbols, each representing an entry in the PostScript array HeaderLinesLeft. Strings are inserted unchanged into the array; those representing PostScript string literals should be delimited with PostScript string delimiters '(' and ')'. For symbols with bound functions, the function is called and should return a string to be inserted into the array. For symbols with bound values, the value should be a string to be inserted into the array. In either case, function or variable, the string value has PostScript string delimiters added to it. (defvar ps-left-header (list (quote ps-get-buffer-name) (quote ps-header-dirpart)) (#$ . -5313)) (make-variable-buffer-local (quote ps-left-header)) #@184 *The items to display on the left part of the page header. This applies to generating Postscript. See the variable `ps-left-header' for a description of the format of this variable. (defvar ps-right-header (list "/pagenumberstring load" (quote time-stamp-yy/mm/dd) (quote time-stamp-hh:mm:ss)) (#$ . -6158)) (make-variable-buffer-local (quote ps-right-header)) #@57 *Non-nil means report progress while formatting buffer. (defvar ps-razzle-dazzle t (#$ . -6526)) #@191 *Contains the header line identifying the output as PostScript. By default, `ps-adobe-tag' contains the standard identifier. Some printers require slightly different versions of this line. (defvar ps-adobe-tag "%!PS-Adobe-1.0\n" (#$ . -6630)) #@457 *Non-nil means build the reference face lists. Ps-print sets this value to nil after it builds its internal reference lists of bold and italic faces. By settings its value back to t, you can force ps-print to rebuild the lists the next time you invoke one of the ...-with-faces commands. You should set this value back to t after you change the attributes of any face, or create new faces. Most users shouldn't have to worry about its setting, though. (defvar ps-build-face-reference t (#$ . -6881)) #@268 *Non-nil means always rebuild the reference face lists. If this variable is non-nil, ps-print will rebuild its internal reference lists of bold and italic faces *every* time one of the -with-faces commands is called. Most users shouldn't need to set this variable. (defvar ps-always-build-face-reference nil (#$ . -7392)) #@483 Generate and print a PostScript image of the buffer. When called with a numeric prefix argument (C-u), prompts the user for the name of a file to save the PostScript image in, instead of sending it to the printer. More specifically, the FILENAME argument is treated as follows: if it is nil, send the image to the printer. If FILENAME is a string, save the PostScript image in a file with that name. If FILENAME is a number, prompt the user for the name of the file to save in. (defalias 'ps-print-buffer #[(&optional filename) "ÀpedÁ$ˆÂ !‡" [ps-generate ps-generate-postscript ps-do-despool filename] 5 (#$ . 7723) (list (ps-print-preprint current-prefix-arg))]) #@155 Generate and print a PostScript image of the buffer. Like `ps-print-buffer', but includes font, color, and underline information in the generated image. (defalias 'ps-print-buffer-with-faces #[(&optional filename) "ÀpedÁ$ˆÂ !‡" [ps-generate ps-generate-postscript-with-faces ps-do-despool filename] 5 (#$ . 8398) (list (ps-print-preprint current-prefix-arg))]) #@115 Generate and print a PostScript image of the region. Like `ps-print-buffer', but prints just the current region. (defalias 'ps-print-region #[(from to &optional filename) "Àp \nÃ$ˆÄ !‡" [ps-generate from to ps-generate-postscript ps-do-despool filename] 5 (#$ . 8767) (list (point) (mark) (ps-print-preprint current-prefix-arg))]) #@155 Generate and print a PostScript image of the region. Like `ps-print-region', but includes font, color, and underline information in the generated image. (defalias 'ps-print-region-with-faces #[(from to &optional filename) "Àp \nÃ$ˆÄ !‡" [ps-generate from to ps-generate-postscript-with-faces ps-do-despool filename] 5 (#$ . 9106) (list (point) (mark) (ps-print-preprint current-prefix-arg))]) #@244 Generate and spool a PostScript image of the buffer. Like `ps-print-buffer' except that the PostScript image is saved in a local buffer to be sent to the printer later. Use the command `ps-despool' to send the spooled images to the printer. (defalias 'ps-spool-buffer #[nil "ÀpedÁ$‡" [ps-generate ps-generate-postscript] 5 (#$ . 9507) nil]) #@228 Generate and spool a PostScript image of the buffer. Like `ps-spool-buffer', but includes font, color, and underline information in the generated image. Use the command `ps-despool' to send the spooled images to the printer. (defalias 'ps-spool-buffer-with-faces #[nil "ÀpedÁ$‡" [ps-generate ps-generate-postscript-with-faces] 5 (#$ . 9857) nil]) #@196 Generate a PostScript image of the region and spool locally. Like `ps-spool-buffer', but spools just the current region. Use the command `ps-despool' to send the spooled images to the printer. (defalias 'ps-spool-region #[(from to) "Àp \nÃ$‡" [ps-generate from to ps-generate-postscript] 5 (#$ . 10213) "r"]) #@236 Generate a PostScript image of the region and spool locally. Like `ps-spool-region', but includes font, color, and underline information in the generated image. Use the command `ps-despool' to send the spooled images to the printer. (defalias 'ps-spool-region-with-faces #[(from to) "Àp \nÃ$‡" [ps-generate from to ps-generate-postscript-with-faces] 5 (#$ . 10531) "r"]) #@475 Send the spooled PostScript to the printer. When called with a numeric prefix argument (C-u), prompt the user for the name of a file to save the spooled PostScript in, instead of sending it to the printer. More specifically, the FILENAME argument is treated as follows: if it is nil, send the image to the printer. If FILENAME is a string, save the PostScript image in a file with that name. If FILENAME is a number, prompt the user for the name of the file to save in. (defalias 'ps-despool #[(&optional filename) "À !‡" [ps-do-despool filename] 2 (#$ . 10911) (list (ps-print-preprint current-prefix-arg))]) (byte-code "ÀÁ!„)ÂÃ\f\"ƒÅ‚(ÂÆ\f\"ƒÇ‚(ÂÈ\f\"ƒ'É‚(ÊÁ B Ç=„; Å=ƒH\fÍWƒL΂LÐÑ!ˆÐÒ!ˆÀÓ!„YÔÓ B ÀÕ!„hÎÕ B ÀÖ!„w×Ö B ÀØ!„†ÎØ B ÀÙ!„•ÎÙ B ÀÚ!„¤ÎÚ B ÀÛ!„³ÜÛ B ÀÝ!„ÂÜÝ B ÀÞ!„ÑÜÞ B Àß!„àÎß B Àà!„õ…ó! à B Àâ!„ \"â B Àã!„Î#ã B Àä!„#Ü$ä B Àå!„< Ê=ƒ9æ‚:ç%å B Àè!„Uéê!ƒRë‚Sì(è B Àí!„néê!ƒkî‚lï-í B Àð!„}ñ0ð B Àò!„Œó2ò B Àô!„›ó4ô B Àõ!„ªö5õ B À÷!„¹ó7÷ B Àø!„Èù8ø B Àú!„×û:ú B Àü!„æý<ü B Àþ!„õû>þ B Àÿ!„@?ÿ B ÀA!„BAA B ÀC!„DD:8EE> \f> >\n…Æ !\n…Ç !¯)‡" [face-differs-from-default-p face differs ps-ref-bold-faces ps-ref-italic-faces ps-ref-underlined-faces face-foreground face-background] 6]) (defalias 'ps-face-attribute-list #[(face-or-list) "<ƒbÁ‰‰‰‰‰‰ƒU@É\n!†( @†2 A@†<Ê 8 „FË 8\f„NÌ 8A‰„ \f¯.‡É!‡" [face-or-list nil face face-attr background foreground underline-p italic-p bold-p ps-face-attributes 2 3 4] 8]) (defalias 'ps-plot-with-face #[(from to face) "ƒvÁ!‰@\nA@Å\n8Ç\n8É\n8\n ƒ2ƒ2ÌÍÎ!\"‚4 …G\n…GÌÍÎ\n!\"Ò ƒZ\fƒZÇ‚k\fƒbÅ‚k ƒjÕ‚kÖ&.‡b‡" [face ps-face-attribute-list face-attr bold-p italic-p 2 underline-p 3 foreground 4 background ps-print-color-p mapcar ps-color-value ps-color-values ps-default-color fg-color bg-color ps-plot-region from to 1 0] 8]) (defalias 'ps-emacs-face-kind-p #[(face kind kind-regex kind-list) "À !À Â\" <ƒ >† >*‡" [face-font face t face-defaults frame-font kind kind-list] 4]) (defalias 'ps-xemacs-face-kind-p #[(face kind kind-regex kind-list) "À !† ÀÂ!\fÅ !ž‰£È ƒ&Ê \"†* \f>,‡" [face-font face default frame-font kind x-font-properties kind-cons kind-spec t case-fold-search string-match kind-regex kind-list] 4]) (defalias 'ps-face-bold-p #[(face) "Á=ƒ ÄÅ$‡Ç ÈÉ$‡" [ps-print-emacs-type emacs ps-emacs-face-kind-p face bold "-\\(bold\\|demibold\\)-" ps-bold-faces ps-xemacs-face-kind-p WEIGHT_NAME "bold\\|demibold"] 5]) (defalias 'ps-face-italic-p #[(face) "Á=ƒ ÄÅ$‡Ç ÈÉ$†Ç ÊÉ$‡" [ps-print-emacs-type emacs ps-emacs-face-kind-p face italic "-[io]-" ps-italic-faces ps-xemacs-face-kind-p ANGLE_NAME "i\\|o" SLANT] 5]) (defalias 'ps-face-underlined-p #[(face) "À !† \n>‡" [face-underline-p face ps-underlined-faces] 2]) (byte-code "ÀÁ!„ ÂÁÃ\"ˆÀ‡" [fboundp face-list defalias list-faces] 3) (defalias 'ps-build-reference-face-lists #[nil "ƒEÁ ÂÂÂÂ\fƒA\f@È !ƒ$ BÉ !ƒ. BÊ !ƒ: B\fA‰„*‚P \f ‰‡" [ps-auto-font-detect face-list nil the-face faces ps-ref-bold-faces ps-ref-italic-faces ps-ref-underlined-faces ps-face-italic-p ps-face-bold-p ps-face-underlined-p ps-bold-faces ps-italic-faces ps-underlined-faces ps-build-face-reference] 3]) (defalias 'ps-mapper #[(extent list) "Á\n!Ã\nEÄ\n!Å\nED¤ˆÆ‡" [list extent-start-position extent push extent-end-position pull nil] 5]) (defalias 'ps-sorter #[(a b) "@ @W‡" [a b] 2]) (defalias 'ps-extent-sorter #[(a b) "À !À\n!W‡" [extent-priority a b] 3]) (defalias 'ps-print-ensure-fontified #[(start end) "ÀÁ!… …ÂÃ!ƒÃ\f \"‡Æ ‡" [boundp lazy-lock-mode fboundp lazy-lock-fontify-region start end lazy-lock-fontify-buffer] 3]) (defalias 'ps-generate-postscript-with-faces #[(from to) "„ ƒÂÃ!ˆÄ ˆ ƒÆÇÈ!@!‚É\nŒ \f}ˆÍ\fÐ \f\"ˆÒ=„BÓ=ƒòÔÕBÕ‰‰‰ÛÜÕ \f%ˆAÝÞ\"Õƒî@‰@A‰@A‰@ eYƒ¤dXƒ¤ß #ˆà=ƒ¿á!ƒÑÝBâ\"‚Ñã=ƒÑÝä\"â\"ƒÞá@!‚ßÍ A‰„r-‚¸å=ƒ¸ ‰&' \fWƒ·'\fWƒè Õ\f#'&\fWƒ*é !\f^&'&^ê ë\"ƒ=Õ‚Fê Ï\"†FÍì !í.‰/ƒ¥/@0ñ0Ï\"2ñ0ë\"3ñ0ô\"†qõ63„}2ƒ›6.Vƒ›3ƒŽÕ‚•…•26.,/A‰/„U*ß #ˆ‰ ‚*ß \f#+‡" [ps-always-build-face-reference ps-build-face-reference message "Collecting face information..." ps-build-reference-face-lists ps-print-color-p float ps-color-values "white" 1.0 ps-print-color-scale from to default position face ps-print-ensure-fontified ps-print-emacs-type lucid xemacs dummy nil extent-list extent type record a map-extents ps-mapper sort ps-sorter ps-plot-with-face push extent-face ps-extent-sorter pull delq emacs overlay-change property-change next-property-change next-overlay-change get-text-property invisible overlays-at -1 face-priority overlays overlay overlay-get overlay-face overlay-invisible priority 0 overlay-priority] 7]) (defalias 'ps-generate-postscript #[(from to) "À \nÃÄ$‡" [ps-plot-region from to 0 nil] 5]) (defalias 'ps-generate #[(buffer from to genfunc) " ^ ]Œ }ˆ\nƒÃÄʼn\"ˆqˆÉ\n! Ì ˆÍ‰‰ÑŽ qˆÒ ‰dÍ“ˆebˆÓÔÕ!!„PÖŠqˆƒ]× ˆØ ˆÙ ˆ)qˆ \"ˆÛ ˆƒƒÝß\"àUƒƒá ˆâ ˆ qˆdbˆãäÍÖ#ƒ¡åæç\"Ö\"ˆ‚Ö,\n…¬Ãè!+‡" [to from ps-razzle-dazzle message "Formatting...%d%%" 0 ps-razchunk buffer ps-source-buffer get-buffer-create ps-spool-buffer-name ps-spool-buffer ps-init-output-queue nil needs-begin-file completed-safely safe-marker ((byte-code "À !ƒ\n„ qˆÄ !d|ˆÀ‡" [markerp safe-marker completed-safely ps-spool-buffer marker-position] 2)) make-marker looking-at regexp-quote "%!PS-Adobe-1.0" t ps-begin-file ps-begin-job ps-begin-page genfunc ps-end-page ps-spool-duplex mod ps-page-count 2 1 ps-dummy-page ps-flush-output re-search-backward "^/PageCount 0 def$" replace-match format "/PageCount %d def" "Formatting...done"] 5]) (defalias 'ps-do-despool #[(filename) "ÀÁ!ƒ\n „ÂÃ!‡Ä ˆÅ ˆƒBŠƒ#ÂÈ!ˆ qˆÉ!Êed#ˆƒ>ÂË\"ˆ)‚gƒKÂÌ!ˆŠ qˆÍÎedÐÑÐ&ˆ)ƒgÂÓ!ˆÔ !‡" [boundp ps-spool-buffer message "No spooled PostScript to print" ps-end-file ps-flush-output filename ps-razzle-dazzle "Saving..." expand-file-name write-region "Wrote %s" "Printing..." apply call-process-region ps-lpr-command nil 0 ps-lpr-switches "Printing...done" kill-buffer] 9]) (defalias 'ps-kill-emacs-check #[nil "À !‰ƒÄ !ƒÅÆ!ƒÇ ˆÂ !‰…1Ä !…1ÈÉ!?…1ÊË!)‡" [nil ps-buffer get-buffer ps-spool-buffer-name buffer-modified-p y-or-n-p "Unprinted PostScript waiting; print now? " ps-despool yes-or-no-p "Unprinted PostScript waiting; exit anyway? " error "Unprinted PostScript"] 2]) (byte-code "ÀÁ!ƒÁÂÃ\"ˆ‚\nƒÄÅ!ˆ‚ÃÀ‡" [fboundp add-hook kill-emacs-hook ps-kill-emacs-check message "Won't override existing kill-emacs-hook"] 3) (defalias 'ps-prsc '(macro . #[nil "ÀÁÂÃEÄÅF‡" [if eq ps-print-emacs-type (quote emacs) [f22] (quote f22)] 4])) (defalias 'ps-c-prsc '(macro . #[nil "ÀÁÂÃEÄÅF‡" [if eq ps-print-emacs-type (quote emacs) [C-f22] (quote (control f22))] 4])) (defalias 'ps-s-prsc '(macro . #[nil "ÀÁÂÃEÄÅF‡" [if eq ps-print-emacs-type (quote emacs) [S-f22] (quote (shift f22))] 4])) (defalias 'ps-article-subject #[nil "ŠebˆÀÁ!ƒ”•{‚Ã)‡" [re-search-forward "^Subject:[ ]+\\(.*\\)$" 1 "Subject ???"] 2]) (defalias 'ps-article-author #[nil "ŠebˆÀÁ!ƒ5”•{ÄÅ \"ƒ ”•O‚1ÄÆ \"ƒ0 ”•O‚1 )‚6Ç)‡" [re-search-forward "^From:[ ]+\\(.*\\)$" 1 fromstring string-match ".*[ ]+(\\(.*\\))" "\\(.*\\)[ ]+<.*>" "From ???"] 3]) (defalias 'ps-gnus-article-prepare-hook #[nil "ÀÂÃÄE‰‡" [3 ps-header-lines ps-article-subject ps-article-author gnus-newsgroup-name ps-left-header] 3]) (defalias 'ps-vm-mode-hook #[nil "À Â=ƒ Â\fÄÅ\"ˆÆÈÉÊE‰ ‡" [local-set-key ps-print-emacs-type emacs [f22] f22 ps-vm-print-message-from-summary 3 ps-header-lines ps-article-subject ps-article-author buffer-name ps-left-header] 3]) (defalias 'ps-gnus-print-article-from-summary #[nil "ÀÁ!… ŠÁqˆÂ )‡" [get-buffer "*Article*" ps-spool-buffer-with-faces] 2 nil nil]) (defalias 'ps-vm-print-message-from-summary #[nil "… ŠqˆÁ )‡" [vm-mail-buffer ps-spool-buffer-with-faces] 1 nil nil]) (defalias 'ps-gnus-summary-setup #[nil "À Â=ƒ Â\fÄÅ\"‡" [local-set-key ps-print-emacs-type emacs [f22] f22 ps-gnus-print-article-from-summary] 3]) (defalias 'ps-info-file #[nil "ŠebˆÀÁ!ƒ”•{‚Ã)‡" [re-search-forward "File:[ ]+\\([^, \n]*\\)" 1 "File ???"] 2]) (defalias 'ps-info-node #[nil "ŠebˆÀÁ!ƒ”•{‚Ã)‡" [re-search-forward "Node:[ ]+\\([^, \n]*\\)" 1 "Node ???"] 2]) (defalias 'ps-info-mode-hook #[nil "ÀÁD‰‡" [ps-info-node ps-info-file ps-left-header] 2]) (defalias 'ps-jts-ps-setup #[nil "À Â=ƒ Â\fÄÅ\"ˆÀ Â=ƒÆ‚ÇÈ\"ˆÀ Â=ƒ)É‚*ÊË\"ˆÌÍÎ\"ˆÌÏÐ\"ˆÌÑÒ\"ˆÌÓÒ\"ˆÌÔÕ\"ˆÖØÚ܉‡" [global-set-key ps-print-emacs-type emacs [f22] f22 ps-spool-buffer-with-faces [S-f22] (shift f22) ps-spool-region-with-faces [C-f22] (control f22) ps-despool add-hook gnus-article-prepare-hook ps-gnus-article-prepare-hook gnus-summary-mode-hook ps-gnus-summary-setup vm-mode-hook ps-vm-mode-hook vm-mode-hooks Info-mode-hook ps-info-mode-hook t ps-spool-duplex nil ps-print-color-p "lpr" ps-lpr-command ("-Jjct,duplex_long") ps-lpr-switches] 3]) (provide (quote ps-print)) emacs-19.30/lisp/rcompile.elc100666 12120 1 5145 6045214251 14360 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:25:42 1995 ;;; from file /home/fsf/rms/e19/lisp/rcompile.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`rcompile.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!‡" [provide rcompile require compile] 2) #@32 *Host for remote compilations. (defvar remote-compile-host nil (#$ . -536)) #@87 User for remote compilations. nil means use the value returned by \[user-login-name]. (defvar remote-compile-user nil (#$ . 618)) #@238 *Command to run before compilation. This can be used for setting up enviroment variables, since rsh does not invoke the shell as a login shell and files like .login (tcsh) and .bash_profile (bash) are not run. nil means run no commands. (defvar remote-compile-run-before nil (#$ . -755)) #@64 *Non-nil means prompt for host if not available from filename. (defvar remote-compile-prompt-for-host nil (#$ . -1049)) #@64 *Non-nil means prompt for user if not available from filename. (defvar remote-compile-prompt-for-user nil (#$ . -1175)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp remote-compile-host-history nil current-load-list remote-compile-user-history] 2) #@86 Compile the the current buffer's directory on HOST. Log in as USER. See \[compile]. (defalias 'remote-compile #[(host user command) "\nƒ \n‚ „Ä ÅÆ!…Ç! ÊË\f ƒ1ÏP‚2Ð ƒ>Ñ 8‚@ & ÓÔ‰\"ˆÕ Ö\"ˆŠqˆØ ÙQ‰+‡" [command compile-command user remote-compile-user user-login-name featurep ange-ftp ange-ftp-ftp-name default-directory parsed format "%s %s -l %s \"(%scd %s; %s)\"" remote-shell-program host remote-compile-run-before "; " "" 2 remote-compile-host save-some-buffers nil compile-internal "No more errors" compilation-last-buffer "/" ":" comint-file-name-prefix] 8 (#$ . 1431) (byte-code "ÀÁ!…  !ĉ‰‰‰ ƒ( @ A@‚l\n;ƒ6ËÌ\n\"‚7Í„B\n„LÏ ÐĉÑ%‚N\nƒhÏËÓ†_Õ \"ÐĉÖ%‚jÏ×ĉÙ%Иƒ‚\n‚„Иƒ‚’E-‡" [featurep ange-ftp ange-ftp-ftp-name default-directory nil prompt command user host parsed remote-compile-host format "Compile on host (default %s): " "Compile on host: " remote-compile-prompt-for-host read-from-minibuffer "" remote-compile-host-history remote-compile-prompt-for-user "Compile by user (default %s)" remote-compile-user user-login-name remote-compile-user-history "Compile command: " compile-command (compile-history . 1)] 7)]) emacs-19.30/lisp/rect.elc100666 13437 1 13334 5744577134 13677 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:48:42 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/rect.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/rect.el' was compiled for Emacs 19")) #@541 Call FUNCTION for each line of rectangle with corners at START, END. If COERCE-TABS is non-nil, convert multi-column characters that span the starting or ending columns on any line to multiple spaces before calling FUNCTION. FUNCTION is called with three arguments: position of start of segment of this line within the rectangle, number of columns that belong to rectangle but are before that position, number of columns that belong to rectangle but are after point. Point is at the end of the segment of this line within the rectangle. (defalias 'operate-on-rectangle #[(function start end coerce-tabs) "À‰‰‰Š bˆiÆyˆ`)ŠbˆiÈyˆÉ )\n\fWƒ,\n\fŠ bˆ` WƒzÀ‰‰\n \fÍ\f\"ˆi\fZ `\fÍ\n\"ˆ\niZ\n ÆWƒi\n \\\nÆ \f \n#ˆ+Èyˆ‚0)\n\fZ,‡" [nil endlinepos endcol startlinepos startcol start 0 end 1 point-marker endextra begextra startpos move-to-column coerce-tabs function] 4 (#$ . 478)]) (defalias 'delete-rectangle-line #[(startdelpos ignore ignore) "`|‡" [startdelpos] 2]) (defalias 'delete-extract-rectangle-line #[(startdelpos begextra endextra) "ŠÀ \n #ˆ) `|‡" [extract-rectangle-line startdelpos begextra endextra] 4]) (defalias 'extract-rectangle-line #[(startdelpos begextra endextra) "`{`bˆÃÄ Å#ƒ6iŠÆuˆi)Z\nÈ` ZÉZOÊ!\n‰G` Z\\ËOQ)‚ \fÈV„D ÈVƒOÊ\f!\nÊ !Q\nB‰*‡" [startdelpos end line search-forward " " t -1 width 0 1 spaces-string nil begextra endextra lines] 6]) (byte-code "ÀÁ\nBÁ‡" [["" " " " " " " " " " " " " " " " "] spaces-strings current-load-list] 2) (defalias 'spaces-string #[(n) "ÁXƒ\n\nH‡ÃÁVƒÅ\fPÁZ‰‚ \f\nHP)‡" [n 8 spaces-strings "" val " "] 4]) #@216 Delete (don't save) text in rectangle with point and mark as corners. The same range of columns is deleted in each line starting with the line where the region begins and ending with the line where the region ends. (defalias 'delete-rectangle #[(start end) "ÀÁ\n Ä$‡" [operate-on-rectangle delete-rectangle-line start end t] 5 (#$ . 2147) "r"]) #@190 Delete contents of rectangle and return it as a list of strings. Arguments START and END are the corners of the rectangle. The value is list of strings, one for each line of the rectangle. (defalias 'delete-extract-rectangle #[(start end) "ÀÂÃ\f Æ$ˆ Ÿ)‡" [nil lines operate-on-rectangle delete-extract-rectangle-line start end t] 5 (#$ . 2499)]) #@123 Return contents of rectangle with corners at START and END. Value is list of strings, one for each line of the rectangle. (defalias 'extract-rectangle #[(start end) "ÀÂÃ\f À$ˆ Ÿ)‡" [nil lines operate-on-rectangle extract-rectangle-line start end] 5 (#$ . 2853)]) #@41 Rectangle for yank-rectangle to insert. (defvar killed-rectangle nil (#$ . 3123)) #@214 Delete rectangle with corners at point and mark; save as last killed one. Calling from program, supply two args START and END, buffer positions. But in programs you might prefer to use `delete-extract-rectangle'. (defalias 'kill-rectangle #[(start end) "ƒ\fÁ\n \"Å ˆÆ\n \"‰‡" [buffer-read-only extract-rectangle start end killed-rectangle barf-if-buffer-read-only delete-extract-rectangle] 3 (#$ . 3212) "r"]) #@65 Yank the last killed rectangle with upper left corner at point. (defalias 'yank-rectangle #[nil "À !‡" [insert-rectangle killed-rectangle] 2 (#$ . 3632) nil]) #@308 Insert text of RECTANGLE with upper left corner at point. RECTANGLE's first line is inserted at point, its second line is inserted at a point vertically under point, etc. RECTANGLE should be a list of strings. After this command, the mark is at the upper left corner and point is at the lower right corner. (defalias 'insert-rectangle #[(rectangle) "iÁÅ ˆ\f….\n„ Æyˆn„ÇcˆÈ Á\"ˆÉ\f@cˆ\fA‰„ É+‡" [rectangle t first insertcolumn lines push-mark 1 10 move-to-column nil] 4 (#$ . 3798)]) #@194 Blank out rectangle with corners at point and mark, shifting text right. The text previously in the region is not overwritten by the blanks, but instead winds up to the right of the rectangle. (defalias 'open-rectangle #[(start end) "ÀÁ\n Ä$ˆ\nb‡" [operate-on-rectangle open-rectangle-line start end nil] 5 (#$ . 4299) "r"]) (defalias 'open-rectangle-line #[(startpos begextra endextra) "i\\Á\fbˆi ZÇÁwˆiZ)\f`|ˆ \n\\j*‡" [endextra nil whitewidth endcol startpos begextra begcol " "] 2]) #@267 Insert STRING on each line of the region-rectangle, shifting text right. The left edge of the rectangle specifies the column for insertion. This command does not delete or overwrite any existing text. Called from a program, takes three args; START, END and STRING. (defalias 'string-rectangle #[(start end string) "ÀÁ\n Ä$‡" [operate-on-rectangle string-rectangle-line start end t] 5 (#$ . 4802) "r\nsString rectangle: "]) (defalias 'string-rectangle-line #[(startpos begextra endextra) "À\nbˆiÄÀwˆi Z)\n`|ˆ cˆi \\j)‡" [nil whitespace startpos ocol " " string] 2]) #@190 Blank out rectangle with corners at point and mark. The text previously in the region is overwritten by the blanks. When called from a program, requires two args which specify the corners. (defalias 'clear-rectangle #[(start end) "ÀÁ\n Ä$‡" [operate-on-rectangle clear-rectangle-line start end t] 5 (#$ . 5379) "r"]) (defalias 'clear-rectangle-line #[(startpos begextra endextra) "ÀÁwˆi\n\\`\fbˆÀÁxˆ`|ˆ j)‡" [" " nil endextra column startpos] 3]) (provide (quote rect)) emacs-19.30/lisp/refbib.elc100666 13437 1 35666 5744577141 14205 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:48:44 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/refbib.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/refbib.el' was compiled for Emacs 19")) #@19 *trace conversion (defvar r2b-trace-on nil (#$ . -481)) #@685 Abbreviation list for journal names. If the car of an element matches a journal name exactly, it is replaced by the cadr when output. Braces must be included if replacement is a {string}, but not if replacement is a bibtex abbreviation. The cadr may be eliminated if is exactly the same as the car. Because titles are capitalized before matching, the abbreviation for the journal name should be listed as beginning with a capital letter, even if it really doesn't. For example, a value of '(("Aij" "{Artificial Intelligence}") ("Ijcai81" "ijcai7")) would expand Aij to the text string "Artificial Intelligence", but would replace Ijcai81 with the BibTeX macro "ijcai7". (defvar r2b-journal-abbrevs nil (#$ . 544)) #@682 Abbreviation list for book and proceedings names. If the car of an element matches a title or booktitle exactly, it is replaced by the cadr when output. Braces must be included if replacement is a {string}, but not if replacement is a bibtex abbreviation. The cadr may be eliminated if is exactly the same as the car. Because titles are capitalized before matching, the abbreviated title should be listed as beginning with a capital letter, even if it doesn't. For example, a value of '(("Aij" "{Artificial Intelligence}") ("Ijcai81" "ijcai7")) would expand Aij to the text string "Artificial Intelligence", but would replace Ijcai81 with the BibTeX macro "ijcai7". (defvar r2b-booktitle-abbrevs nil (#$ . 1279)) #@856 Assoc list of books or journals which are really conference proceedings, but whose name and whose abbrev expansion (as defined in `r2b-journal-abbrevs' and `r2b-booktitle-abbrevs') does not contain the words "conference" or "proceedings". (Those cases are handled automatically.) The entry must match the given data exactly. Because titles are capitalized before matching, the items in this list should begin with a capital letter. For example, suppose the title "Ijcai81" is used for the proceedings of a conference, and it's expansion is the BibTeX macro "ijcai7". Then `r2b-proceedings-list' should be '(("Ijcai81") ...). If instead its expansion were "Proceedings of the Seventh International Conference on Artificial Intelligence", then you would NOT need to include Ijcai81 in `r2b-proceedings-list' (although it wouldn't cause an error). (defvar r2b-proceedings-list nil (#$ . 2014)) #@104 Words other than the `capitialize-title-stop-words' which are not to be used to build the citation key (defvar r2b-additional-stop-words "Some\\|What" (#$ . 2922)) #@62 *If true, then use " to delimit fields, otherwise use braces (defvar r2b-delimit-with-quote t (#$ . -3092)) #@87 Words not to be capitialized in a title (unless they are the first word in the title) (defvar capitalize-title-stop-words (concat "the\\|and\\|of\\|is\\|a\\|an\\|of\\|for\\|in\\|to\\|in\\|on\\|at\\|" "by\\|with\\|that\\|its") (#$ . 3206)) (byte-code "ÀÁ!„  ÄQÁ BÀ‡" [boundp capitalize-title-stop-regexp "\\(" capitalize-title-stop-words "\\)\\(\\b\\|'\\)" current-load-list] 3) #@78 Like `capitalize-region', but don't capitalize stop words, except the first. (defalias 'capitalize-title-region #[(begin end) "ÀÁ ÄŽŒÅ!ˆ}ˆebˆÉÊ!ƒ\"Ëvˆ‚&ÌË!ˆÍÎÀÏ#…RÉÊ!ƒ:Ëvˆ‚&ÏÉ!)ƒKÑË!ˆ‚&ÌË!ˆ‚&,‡" [nil syntax-table orig-syntax-table case-fold-search ((set-syntax-table orig-syntax-table)) set-syntax-table text-mode-syntax-table begin end looking-at "[A-Z][a-z]*[A-Z]" 1 capitalize-word re-search-forward "\\<" t capitalize-title-stop-regexp downcase-word] 4 (#$ . 3594) "r"]) #@69 Like capitalize, but don't capitalize stop words, except the first. (defalias 'capitalize-title #[(s) "ŠÀÁ!qˆÂ ˆ cˆÄed\"ˆÅ )‡" [get-buffer-create "$$$Scratch$$$" erase-buffer s capitalize-title-region buffer-string] 3 (#$ . 4094)]) #@32 Unbind defvars, for debugging. (defalias 'r2b-reset #[nil "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÀÅ!ˆÀÆ!ˆÀÇ!‡" [makunbound r2b-journal-abbrevs r2b-booktitle-abbrevs r2b-proceedings-list capitalize-title-stop-words capitalize-title-stop-regexp r2b-additional-stop-words r2b-stop-regexp] 2 (#$ . 4332) nil]) (byte-code "ÀÁ!„Â Ä Æ°ÁBÀ‡" [boundp r2b-stop-regexp "\\`\\(\\(" r2b-additional-stop-words "\\|" capitalize-title-stop-words "\\)\\('\\w*\\)?\\W+\\)*\\([A-Z0-9]+\\)" current-load-list] 5) (defalias 'r2b-trace #[(&rest args) "…\fÁ \"ˆÄÅ!‡" [r2b-trace-on apply message args sit-for 0] 3]) #@43 Returns string matched in current buffer. (defalias 'r2b-match #[(exp) "”•{‡" [exp] 2 (#$ . 4919)]) #@30 *output from refer-to-bibtex (defvar r2b-out-buf-name "*Out*" (#$ . -5027)) #@35 *logs errors from refer-to-bibtex (defvar r2b-log-name "*Log*" (#$ . -5109)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BLJ" [boundp r2b-in-buf nil current-load-list r2b-out-buf r2b-log r2b-error-found (r2b-error-found r2bv-author r2bv-primary-author r2bv-date r2bv-year r2bv-decade r2bv-month r2bv-title r2bv-title-first-word r2bv-editor r2bv-annote r2bv-tr r2bv-address r2bv-institution r2bv-keywords r2bv-booktitle r2bv-journal r2bv-volume r2bv-number r2bv-pages r2bv-booktitle r2bv-kn r2bv-publisher r2bv-organization r2bv-school r2bv-type r2bv-where r2bv-note r2bv-ordering) r2b-variables] 2) #@41 Set all global vars used by r2b to nil. (defalias 'r2b-clear-variables #[nil "‰… @ÂLˆ A‰„Â)‡" [r2b-variables vars nil] 3 (#$ . 5733)]) (defalias 'r2b-warning #[(&rest args) "ÀÂÃÄ \"\"ˆÂÇ\"ˆÂÇ\"ˆÂÉ\"ˆÂÃÄ \"\"‡" [t r2b-error-found princ apply format args r2b-log "\n" r2b-out-buf "% "] 4]) #@460 Set VAR to string value of FIELD, if any. If none, VAR is set to nil. If multiple fields appear, then separate values with the '\nand\t\t', unless UNIQUE is non-nil, in which case log a warning and just concatenate the values. Trim off leading blanks and tabs on first line, and trailing blanks and tabs of every line. Log a warning and set VAR to the empty string if REQUIRED is true. Capitalize as a title if CAPITALIZE is true. Returns value of VAR. (defalias 'r2b-get-field #[(var field &optional unique required capitalize) "À‰ÁÅÆ\"ˆebˆ\nƒeÈÉÊQÀÁ#ƒeËÌ!ÌyÍU‰ƒ@ÎÏ!„@ÎÐ!ˆ\fÑËÌ!Q‚# „I\f‚ƒ]ÓÔ\f#ˆ Ñ\fQ‚ Õ\fQ‚ ƒrƒr× ! Lˆ ?…………Ú!+‡" [nil t not-past-end val item r2b-trace "snarfing %s" field re-search-forward "^" "\\b[ ]*\\(.*[^ \n]\\)[ ]*" r2b-match 1 0 looking-at "[ ]*$\\|%" "\\(.*[^ \n]\\)[ ]*$" "\n" unique r2b-warning "*Illegal multiple field %s %s" "\n and " capitalize capitalize-title var required r2b-require] 4 (#$ . 6046)]) #@76 Set VAR to the Nth subpattern in REGEXP matched by STRING, or nil if none. (defalias 'r2b-set-match #[(var n regexp string) " ;… \"… \f”\f•OL‡" [var string string-match regexp n] 4 (#$ . 7043)]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp r2b-month-abbrevs (("jan") ("feb") ("mar") ("apr") ("may") ("jun") ("jul") ("aug") ("sep") ("oct") ("nov") ("dec")) current-load-list] 2) #@58 Try to convert `r2bv-month' to a standard 3 letter name. (defalias 'r2b-convert-month #[nil "…T ÃÄ\"ƒ-\nƒ!Ã\n@@\"„!\nA‰„\n…S\n@@‰‚SÅ!@‰§ƒL\nÆVƒL\nÇWƒL\n 8@‰‚SÈÉ!ˆÊ‰)‡" [r2bv-month r2b-month-abbrevs months string-match "[^0-9]" read-from-string 0 13 r2b-warning "* Ridiculous month" nil] 4 (#$ . 7425)]) #@37 Parse buffer into global variables. (defalias 'r2b-snarf-input #[nil "ÀÂÃ!ˆÄÅ!ˆqˆebˆÇÈ \"ˆÇ`ʈ`{ \"ˆË !ˆÌÍÎ\"ˆÌÏÐ\"ˆ ƒAÑÒÓÔ $ˆ‚TƒQÑÒÓÔ$ˆ‚TÕÌÖ×À‰$ˆÑØÅÙ$ˆ„xÑØÓÚ$ƒxÛPÑÜÓÝ$ˆÑÞÅß$ˆ;ƒžàá\"ƒžÅÓ•Oâ ˆÌãäÀ‰‰%ˆÑåæ'#$ˆÌèéÀ#ˆÌêëÀ#ˆÌìíÀ#ˆÌîïÀ#ˆÌðñ\"ˆÌòóÀÊÀ%ˆÌôõÀÊÀ%ˆÌö÷À#ˆÌøùÀ#ˆÌúûÀ#ˆÌüýÀ#ˆÌþÿÀ#)‡" [t case-fold-search r2b-trace "snarfing..." sit-for 0 r2b-in-buf princ " " r2b-log nil terpri r2b-get-field r2bv-author "%A" r2bv-editor "%E" r2b-set-match r2bv-primary-author 1 "\\b\\(\\w+\\)[ ]*\\($\\|,\\)" "" r2bv-date "%D" r2bv-year "[12][0-9][0-9][0-9]" "[^0-9]\\([0-9][0-9]\\)$" "19" r2bv-decade "..\\(..\\)" r2bv-month "[0-9]+/\\|[a-zA-Z]+" string-match "\\(.*\\)/$" r2b-convert-month r2bv-title "%T" r2bv-title-first-word 4 r2b-stop-regexp r2bv-annote "%X" r2bv-tr "%R" r2bv-address "%C" r2bv-institution "%I" r2bv-keywords "%K" r2bv-booktitle "%B" r2bv-journal "%J" r2bv-volume "%V" r2bv-number "%N" r2bv-pages "%P" r2bv-where "%W" r2bv-ordering "%O"] 6 (#$ . 7756)]) #@160 Print bibtex FIELD = {DATA} if DATA not null; precede with a comma and newline; if ABBREVS list is given, then try to replace the {DATA} with an abbreviation. (defalias 'r2b-put-field #[(field data &optional abbrevs) "…ôÁ‰‰‰ƒ/Ç\"‰ƒ/ A„& @‚* A@È‚«Éš„AÊË\"„AÈ‚«ÌÊÍ\n#ƒh̉”OÎ̔̕OÏÌ•ÁO°Ì•Ð\\‚CÌÊÑ\n#ƒ‡̉”OÒÌ”ÁOQÌ•Ó\\‚j̃«ÊÕ\n#ƒ«̉”OÖÌ•ÁOQÌ•×\\‚ŽØÙ!ˆØ!ˆØÛ!ˆ\f„̃ÈØÕ!ˆ‚ÌØÜ!ˆÊÝ\"ˆÌ•ÞVƒÜØß!ˆØ!ˆ\f?…óƒðØÕ!‚óØà!,‡" [data nil index multi-line nodelim match abbrevs assoc t "" string-match "[^0-9]" 0 "[\\~^]" "\\verb+" "+" 7 "[$&%#_{}]" "\\" 1 r2b-delimit-with-quote "\"" "{\"}" 2 princ ", \n " field " = " "{" ".*" 59 "\n" "}"] 7 (#$ . 8776)]) #@60 If any of VARS is null, set to empty string and log error. (defalias 'r2b-require #[(vars) "?†\"<ƒÁ@!ˆÁA!‡J?…\"ÂÃ\"ˆÄL‡" [vars r2b-require r2b-warning "*Missing value for field %s" ""] 3 (#$ . 9488)]) #@36 Set NEW to OLD and set OLD to nil. (defalias 'r2b-moveq '(macro . #[(new old) "ÀÁ\n EÁ ÄEE‡" [progn setq new old nil] 5 (#$ . 9706)])) #@46 Return t if NAME is the name of proceedings. (defalias 'r2b-isa-proceedings #[(name) "…$ÁÂ\"†$Ã\f\"†$à \"‰…#ÁÂA@\")‡" [name string-match "proceedings\\|conference" assoc r2b-proceedings-list r2b-booktitle-abbrevs match] 4 (#$ . 9847)]) #@80 Return t if NAME is a university or similar organization, but not a publisher. (defalias 'r2b-isa-university #[(name) "…ÁÂ\"…ÁÃ\"?‡" [name string-match "university" "press"] 3 (#$ . 10101)]) #@44 Generate bibtex based on global variables. (defalias 'r2b-barf-output #[nil "ÁÂÆÇ!ˆÈÉ!ˆqˆ\n \fQ Î!ƒOÂÑ!ƒ9‚@ÂÂ×Ø!ˆÙ‚ÂÎ!ƒ}Ñ!ƒg‚nÂÂ×Ø!ˆÙ‚ƒÚÛ\"ƒÂ×Ü!ˆ×Ø!ˆÝ‚ƒ½ÚÞ\"ƒ½Â×Ü!ˆ×Ø!ˆß‚ƒÙÚà\"ƒÙÂ×Ø!ˆá‚ƒæ×Ø!ˆâ‚ƒÂÂ×Ô!ˆ×Ø!ˆã‚ƒ$„Úå&\"ƒç‚ÂÎ&!ƒEÑ!ƒ3‚:ÂÂè‚Â$„\\ƒ{ƒ\\Úé\"ƒ{ÂÂ×Ô!ˆ$„w×Ø!ˆê‚ƒ±×Ò!ˆÚë\"ƒ¢Éì•O-î”ÂO/‚©/Â×Ø!ˆð‚ƒÁÂñ‚Âç2×ó!ˆ4ƒÑõö!ˆõ÷!ˆõ2!ˆõø!ˆõ !ˆùú\"ˆùû&<#ˆùý>\"ˆùÿ@A#ˆùBC#ˆùDE\"ˆùF-\"ˆùG/\"ˆùH<#ˆùI$\"ˆùJ\"ˆùK\"ˆùL\"ˆùM\"ˆùNO\"ˆùPQ\"ˆùR\"ˆùST\"ˆùUV\"ˆùWX\"ˆùYZ\"ˆõ[!+‡" [r2b-out-buf t nil match case-fold-search standard-output r2b-trace "...barfing" sit-for 0 r2bv-primary-author r2bv-decade r2bv-title-first-word r2bv-kn r2b-isa-proceedings r2bv-journal r2bv-booktitle r2b-isa-university r2bv-institution r2bv-organization r2bv-publisher r2bv-tr r2bv-note r2b-require r2bv-author inproceedings string-match "phd" r2bv-school phdthesis "master" mastersthesis "draft\\|unpublish" unpublished article incollection r2bv-editor "\\`personal communication\\'" r2bv-title misc proceedings "\\bisbn\\b" book "\\`\\(\\(.\\|\n\\)+\\)[ \n]+\\([^ \n]\\)+\\'" 1 r2bv-type 3 r2bv-number techreport manual r2bv-entry-kind (r2bv-year) r2b-error-found princ "\n% Warning -- Errors During Conversion Next Entry\n" "\n@" "( " r2b-put-field "author" "title" r2b-booktitle-abbrevs "year" r2bv-year "month" r2bv-month r2b-month-abbrevs "journal" r2b-journal-abbrevs "volume" r2bv-volume "type" "number" "booktitle" "editor" "publisher" "institution" "organization" "school" "pages" r2bv-pages "address" r2bv-address "note" "keywords" r2bv-keywords "where" r2bv-where "ordering" r2bv-ordering "annote" r2bv-annote " )\n"] 4 (#$ . 10305)]) #@91 Transform current bib entry and append to buffer OUTPUT; do "M-x r2b-help" for more info. (defalias 'r2b-convert-record #[(output-name) "À‰‰\fÆ\f!pqˆdbˆÆ !‰\nqˆdbˆqˆËÌÀÍ#‰…_ÎÏÀÐ#ˆËÑ!ˆÒyˆ`ËÏÀÐ#ˆ`\n }ˆÓ ˆÔ ˆÕ ˆqˆ~ˆ bˆÍ+‡" [nil not-done rec-begin rec-end output-name r2b-out-buf-name get-buffer-create r2b-out-buf r2b-in-buf r2b-log-name r2b-log re-search-forward "[^ \n]" t re-search-backward "^[ ]*$" 2 "^%" 0 r2b-clear-variables r2b-snarf-input r2b-barf-output] 5 (#$ . 12225) (list (read-string "Output to buffer: " r2b-out-buf-name))]) #@88 Transform current buffer and append to buffer OUTPUT; do "M-x r2b-help" for more info. (defalias 'r2b-convert-buffer #[(output-name) "ŠÀ !‰qˆÃ ˆ)~ˆebˆÄÅ!ˆÆÇ!ˆÈ !„ÄÊ #‡" [get-buffer-create r2b-log-name r2b-log erase-buffer message "Working, please be patient..." sit-for 0 r2b-convert-record output-name "Done, results in %s, errors in %s" r2b-out-buf-name] 5 (#$ . 12791) (list (read-string "Output to buffer: " r2b-out-buf-name))]) #@39 *Don't print help message when loaded (defvar r2b-load-quietly nil (#$ . -13236)) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp r2b-help-message " Refer to Bibtex Bibliography Conversion\n\nA refer-style database is of the form:\n\n%A Joe Blow\n%T Great Thoughts I've Thought\n%D 1977\netc.\n\nThis utility converts these kind of databases to bibtex form, for\nusers of TeX and LaTex. Instructions:\n1. Visit the file containing the refer-style database.\n2. The command\n M-x r2b-convert-buffer\n converts the entire buffer, appending it's output by default in a\n buffer named *Out*, and logging progress and errors in a buffer\n named *Log*. The original file is never modified.\n Note that results are appended to *Out*, so if that buffer\n buffer already exists and contains material you don't want to\n save, you should kill it first.\n3. Switch to the buffer *Out* and save it as a named file.\n4. To convert a single refer-style entry, simply position the cursor\n at the entry and enter\n M-x r2b-convert-record\n Again output is appended to *Out* and errors are logged in *Log*.\n\nThis utility is very robust and pretty smart about determining the\ntype of the entry. It includes facilities for expanding refer macros\nto text, or substituting bibtex macros. Do M-x describe-variable on\n r2b-journal-abbrevs\n r2b-booktitle-abbrevs\n r2b-proceedings-list\nfor information on these features.\n\nIf you don't want to see this help message when you load this utility,\nthen include the following line in your .emacs file:\n (setq r2b-load-quietly t)\nTo see this message again, perform \n M-x r2b-help\nPlease send bug reports and suggestions to\n Henry Kautz\n kautz@research.att.com\n allegra!kautz" current-load-list] 2) #@21 Print help message. (defalias 'r2b-help #[nil "ÀÁ\n!ˆŠ qˆÄ )‘‡" ["*Help*" princ r2b-help-message standard-output help-mode] 3 (#$ . 15034) nil]) (byte-code "„Á ˆÂÃ!ˆÄÅ!‡" [r2b-load-quietly r2b-help message "r2b loaded" provide refer-to-bibtex] 2) emacs-19.30/lisp/refer.elc100666 13437 1 11452 6021171417 14023 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Aug 30 19:23:55 1995 ;;; from file /home/fsf/rms/e19/lisp/refer.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`refer.el' was compiled for Emacs 19.29 or later")) (provide (quote refer)) #@644 *List of \.bib files to search for references, or one of the following special values: nil = prompt for \.bib file (if visiting a \.bib file, use it as default) auto = read \.bib file names from appropriate command in buffer (see refer-bib-files-regexp) dir = use all \.bib files in current directory. If a specified file doesn't exist and has no extension, a \.bib extension is automatically tried. If refer-bib-files is nil, auto or dir, it is setq'd to the appropriate list of files when it is first used if refer-cache-bib-files is t. If refer-cache-bib-files is nil, the list of \.bib files to use is re-read each time it is needed. (defvar refer-bib-files (quote dir) (#$ . -490)) #@258 *Variable determining whether the value of refer-bib-files should be cached. If t, initialize the value of refer-bib-files the first time it is used. If nil, re-read the list of \.bib files depending on the value of refer-bib-files each time it is needed. (defvar refer-cache-bib-files t (#$ . -1189)) #@499 *Regexp matching a bibliography file declaration. The current buffer is expected to contain a line such as \bibliography{file1,file2,file3} which is read to set up refer-bib-files. The regexp must specify the command (such as \bibliography) that is used to specify the list of bib files. The command is expected to specify a file name, or a list of comma-separated file names, within curly braces. If a specified file doesn't exist and has no extension, a \.bib extension is automatically tried. (defvar refer-bib-files-regexp "\\\\bibliography" (#$ . -1499)) (byte-code "ÀÁ!ˆÀÂ!‡" [make-variable-buffer-local refer-bib-files refer-cache-bib-files] 2) #@248 Find entry in refer-bib-files containing KEYWORDS. If KEYWORDS is nil, prompt user for blank-separated list of keywords. If CONTINUE is t, or if called interactively with a prefix arg, look for next entry by continuing search from previous point. (defalias 'refer-find-entry #[(keywords &optional continue) "„ ƒ\f\n‚ÃÄ!Å \"‡" [keywords continue refer-previous-keywords read-string "Keywords: " refer-find-entry-internal] 3 (#$ . 2160) (list nil current-prefix-arg)]) #@74 Find next occurrence of entry in refer-bib-files. See refer-find-entry. (defalias 'refer-find-next-entry #[nil "À Â\"‡" [refer-find-entry-internal refer-previous-keywords t] 3 (#$ . 2643) nil]) (defalias 'refer-find-entry-internal #[(keywords continue) "À !\nƒ ‚ Ä ÇÈ*‡" [refer-convert-string-to-list-of-strings keywords continue refer-saved-state refer-get-bib-files files keywords-list found (byte-code "ƒQÁ@!ƒ@‚Á@ÂP!…@ÂP ƒ>Å #ƒ8ÈÉÊ !\"ˆ‚MA‚MËÌ@Í #ˆÎÏ!ˆA)‚ËÐÍ #‡" [files file-exists-p ".bib" file refer-saved-state refer-find-entry-in-file keywords-list continue throw found find-file message "Scanning %s... No such file" ding sit-for 1 "Keywords \"%s\" not found in any .bib file" keywords] 4)] 2]) (defalias 'refer-find-entry-in-file #[(keywords-list file &optional continue) "ÀÁ\n\"ˆÃ\n!qˆ\fƒÅÆ!ˆ‚ebˆ`ÇÈ \n  „Fm„FÅÆ!ˆ`\nÌÍ\"‰ „!\n‰ bˆ‚! ƒ\\ bˆÏÐÈÑ#ˆÀÒ\n\"‚bÀÓ\n\"ˆÈ+‡" [message "Scanning %s..." file find-file-noselect continue forward-paragraph 1 0 nil found end begin refer-every #[(keyword) "bˆÁ\n Ä#‡" [begin re-search-forward keyword end t] 4] keywords-list re-search-forward "\\W" t "Scanning %s... found" "Scanning %s... not found"] 5]) (defalias 'refer-every #[(pred l) "„Á‡\n@!…A?†Ã\nA\"‡" [l nil pred refer-every] 3]) (defalias 'refer-convert-string-to-list-of-strings #[(s) "pÀÁ!\nqˆÄ ˆÅ!cˆebˆÇcˆÈÉÊË#ƒ)ÌÍˉ#ˆ‚dbˆÎcˆebˆÏ\n! qˆ*‡" [get-buffer-create "*refer-temp*" temp-buffer current erase-buffer regexp-quote s "(\"" re-search-forward "[ ]+" nil t replace-match "\" \"" "\")" read] 4]) (defalias 'refer-get-bib-files #[nil "„+Á\nÃ=ƒ ÄÅÆÇÈ !\"ÉÈ !ÇÈ !Ê$‚&ÄË̉Ê$!C‚˜<ƒ4‚˜Í=ƒ†ŠebˆÎÐPÌÊ#ƒ`ÎÑÌÊ#ˆÒÓ!ˆ`{CÕÖ!„y×Óuˆ`ÎÑÌÊ#ˆÒÓ!ˆ`{C\"‚Y)‚‚ØÙ!)‚˜Ú=ƒ”ÛÜÊÝ#‚˜ØÞ\"ƒ¢)‡" [refer-bib-files expand-file-name major-mode bibtex-mode read-file-name format ".bib file: (default %s) " file-name-nondirectory buffer-file-name file-name-directory t ".bib file: " nil auto re-search-forward refer-bib-files-regexp "{" "[,}]" backward-char 1 files looking-at "}" append error "No \\\\bibliography command in this buffer, can't read refer-bib-files" dir directory-files "." "\\.bib$" "Illegal value for refer-bib-files: %s" refer-cache-bib-files] 7]) emacs-19.30/lisp/regi.elc100666 12120 1 13212 6014175350 13510 0ustar rmsdaemon;ELC ;;; compiled by kwzh@nutrimat.gnu.ai.mit.edu on Tue Aug 15 15:52:03 1995 ;;; from file /home/gd/gnu/emacs/19.0/lisp/regi.el ;;; emacs version 19.29.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`regi.el' was compiled for Emacs 19.29 or later")) #@361 Return the character position at various buffer positions. Optional POSITION can be one of the following symbols: `bol' == beginning of line `boi' == beginning of indentation `eol' == end of line [default] `bonl' == beginning of next line `bopl' == beginning of previous line Optional COL-P non-nil returns `current-column' instead of character position. (defalias 'regi-pos #[(&optional position col-p) "ŠÁ=ƒ Âyˆ‚4Ã=ƒÄ ˆ‚4Å=ƒ%Æyˆ‚4Ç=ƒ1Èyˆ‚4Ɉ\nƒ=i‚>`)‡" [position bol 0 boi back-to-indentation bonl 1 bopl -1 nil col-p] 2 (#$ . 478)]) #@204 Build a regi frame where each element of PREDLIST appears exactly once. The frame contains elements where each member of PREDLIST is associated with FUNC, and optionally NEGATE-P and CASE-FOLD-SEARCH-P. (defalias 'regi-mapcar #[(predlist func &optional negate-p case-fold-search-p) "À‰ „\f\fƒ C\fƒÅ \fC\"ƒA@D ƒ1Å \"Å\nC\"A)‚\n*‡" [nil tail frame negate-p case-fold-search-p append predlist func element] 3 (#$ . 1043)]) #@3343 Interpret the regi frame FRAME. If optional START and END are supplied, they indicate the region of interest, and the buffer is narrowed to the beginning of the line containing START, and beginning of the line after the line containing END. Otherwise, point and mark are not set and processing continues until your FUNC returns the `abort' symbol (see below). Beware! Not supplying a START or END could put you in an infinite loop. A regi frame is a list of entries of the form: (PRED FUNC [NEGATE-P [CASE-FOLD-SEARCH]]) PRED is a predicate against which each line in the region is tested, and if a match occurs, FUNC is `eval'd. Point is then moved to the beginning of the next line, the frame is reset and checking continues. If a match doesn't occur, the next entry is checked against the current line until all entries in the frame are checked. At this point, if no match occurred, the frame is reset and point is moved to the next line. Checking continues until every line in the region is checked. Optional NEGATE-P inverts the result of PRED before FUNC is called and `case-fold-search' is bound to the optional value of CASE-FOLD-SEARCH for the PRED check. PRED can be a string, variable, function or one of the following symbols: t, nil, `begin', `end', and `every'. If PRED is a string, or a variable or list that evaluates to a string, it is interpreted as a regular expression and is matched against the current line (from the beginning) using `looking-at'. If PRED does not evaluate to a string, it is interpreted as a binary value (nil or non-nil). PRED can also be one of the following symbols: t -- always produces a true outcome `begin' -- always executes before anything else `end' -- always executes after everything else `every' -- execute after frame is matched on a line Note that NEGATE-P and CASE-FOLD-SEARCH are meaningless if PRED is one of these special symbols. Only the first occurance of each symbol in a frame entry is used, the rest are ignored. Your FUNC can return values which control regi processing. If a list is returned from your function, it can contain any combination of the following elements: the symbol `continue' Tells regi to continue processing frame-entries after a match, instead of resetting to the first entry and advancing to the next line, as is the default behavior. When returning this symbol, you must take care not to enter an infinite loop. the symbol `abort' Tells regi to terminate processing this frame. any end frame-entry is still processed. the list `(frame . NEWFRAME)' Tells regi to use NEWFRAME as its current frame. In other words, your FUNC can modify the executing regi frame on the fly. the list `(step . STEP)' Tells regi to move STEP number of lines forward during normal processing. By default, regi moves forward 1 line. STEP can be negative, but be careful of infinite loops. You should usually take care to explicitly return nil from your function if no action is to take place. Your FUNC will always be `eval'ed. The following variables will be temporarily bound to some useful information: `curline' the current line in the buffer, as a string `curframe' the full, current frame being executed `curentry' the current frame entry being executed. (defalias 'regi-interpret #[(frame &optional start end) "ŠŒÀ‰‰‰‰‰ƒ:ƒ: ^‰]‰bˆÊË!bˆÊÌ!}ˆ+ÍÎ\"ˆÐ!ˆ\n „ym„y @‰@A@Ô8Ö8ÀÙÚˆ.Ð\f!ˆ‚GÐ !.‡" [nil donep working-frame current-frame every-tag end-tag begin-tag start end tstart regi-pos bonl bol mapcar #[(entry) "@A@‰Ã=ƒ ‰‚6\nÅ=ƒ ‰‚6\nÇ=ƒ- ‰‚6É\nC\"‰\n*‡" [entry func pred begin begin-tag end end-tag every every-tag append working-frame] 4] frame eval entry pred func 2 negate-p 3 case-fold-search match-p regi-throw-top (byte-code "„ ÂyˆÃÄÅ\"ˆ‚\"Æ!‰;ƒ\"É!\nƒ,?ƒ…ËÌ!ËÍ!{Æ!ÔžA†PÂÕžƒ_ÕžAÖ>ƒlA‚ryˆ ×>ƒÅÃÄÅ\"ˆ-‚ˆA‡" [current-frame working-frame 1 throw regi-throw-top t eval pred match-p looking-at negate-p regi-pos bol eol curline curframe entry curentry func result step frame continue abort donep] 3)] 7 (#$ . 1503)]) (provide (quote regi)) emacs-19.30/lisp/register.elc100666 13437 1 15136 6024240242 14543 0ustar jimbdaemon;ELC ;;; compiled by roland@whiz-bang.gnu.ai.mit.edu on Sat Sep 9 03:22:09 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/register.el ;;; emacs version 19.29.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`register.el' was compiled for Emacs 19.29 or later")) #@272 Alist of elements (NAME . CONTENTS), one for each Emacs register. NAME is a character (a number). CONTENTS is a string, number, frame configuration, mark or list. A list of strings represents a rectangle. A list of the form (file . NAME) represents the file named NAME. (defvar register-alist nil (#$ . 481)) #@62 Return contents of Emacs register named REG, or nil if none. (defalias 'get-register #[(reg) " žA‡" [reg register-alist] 2 (#$ . 797)]) #@148 Set contents of Emacs register named REGISTER to VALUE. Returns VALUE. See the documentation of the variable `register-alist' for possible VALUE. (defalias 'set-register #[(register value) " ž‰ƒ\n ¡ˆ‚ B‰ B )‡" [register register-alist aelt value] 3 (#$ . 941)]) #@236 Store current location of point in register REGISTER. With prefix argument, store current frame configuration. Use \[jump-to-register] to go to that location or restore that configuration. Argument is a character, naming the register. (defalias 'point-to-register #[(register &optional arg) "À \nƒ à ‚ Ä \"‡" [set-register register arg current-frame-configuration point-marker] 3 (#$ . 1220) "cPoint to register: \nP"]) #@176 Store the window configuration of the selected frame in register REGISTER. Use \[jump-to-register] to restore the configuration. Argument is a character, naming the register. (defalias 'window-configuration-to-register #[(register &optional arg) "À  \"‡" [set-register register current-window-configuration] 3 (#$ . 1649) "cWindow configuration to register: \nP"]) #@168 Store the window configuration of all frames in register REGISTER. Use \[jump-to-register] to restore the configuration. Argument is a character, naming the register. (defalias 'frame-configuration-to-register #[(register &optional arg) "À  \"‡" [set-register register current-frame-configuration] 3 (#$ . 2022) "cFrame configuration to register: \nP"]) (defalias (quote register-to-point) (quote jump-to-register)) #@546 Move point to location stored in a register. If the register contains a file name, find that file. (To put a file name in a register, you must use `set-register'.) If the register contains a window configuration (one frame) or a frame configuration (all frames), restore that frame or all frames accordingly. First argument is a character, naming the register. Optional second arg non-nil (interactively, prefix argument) says to delete any existing frames that the frame configuration doesn't mention. (Otherwise, these frames are iconified.) (defalias 'jump-to-register #[(register &optional delete) "À !ÃÄ!ƒÄ\n!ƒÅ\n?\"‚VÇ\n!ƒ%È\n!‚VÉ\n!ƒ@Ê\n!„5ËÌ!ˆÍÊ\n!!ˆ\nb‚V\n:ƒS\n@Î=ƒSÏ\nA!‚VËÐ!)‡" [get-register register val fboundp frame-configuration-p set-frame-configuration delete window-configuration-p set-window-configuration markerp marker-buffer error "That register's buffer no longer exists" switch-to-buffer file find-file "Register doesn't contain a buffer position or configuration"] 3 (#$ . 2446) "cJump to register: \nP"]) #@95 Display what is contained in register named REGISTER. The Lisp value REGISTER is a character. (defalias 'view-register #[(register) "À !‰„ÃÄÅ !\"‚¿ÆÇÈ!ˆÇÅ !!ˆÇÉ!ˆ\n¨ƒ,Ç\n!‚¾Ê\n!ƒYË\n!‰\f„AÇÍ!‚UÇÎ!ˆÇÏ\f!!ˆÇÐ!ˆÇÑ\n!!)‚¾Ò\n!ƒeÇÓ!‚¾Ô\n!ƒqÇÕ!‚¾\n:ƒŒ\n@Ö=ƒŒÇ×!ˆØ\nA!ˆÇÙ!‚¾\n:ƒ¨ÇÚ!ˆ\n…¾Ç\n@!ˆÛ ˆ\nA‰‚–\n;ƒ·ÇÜ!ˆÇ\n!‚¾ÇÝ!ˆØ\n!‘)‡" [get-register register val message "Register %s is empty" single-key-description "*Output*" princ "Register " " contains " markerp marker-buffer buf "a marker in no buffer" "a buffer position:\nbuffer " buffer-name ", position " marker-position window-configuration-p "a window configuration." frame-configuration-p "a frame configuration." file "the file " prin1 "." "the rectangle:\n" terpri "the text:\n" "Garbage:\n"] 5 (#$ . 3500) "cView register: "]) #@261 Insert contents of register REGISTER. (REGISTER is a character.) Normally puts point before and mark after the inserted text. If optional second arg is non-nil, puts mark before and point after. Interactively, second arg is non-nil if prefix arg is supplied. (defalias 'insert-register #[(register &optional arg) "À ˆÁ\n!‰:ƒÄ !ˆ‚E ;ƒ cˆ‚E ¨ƒ+Å p\"ˆ‚EÆ !ƒAÇ !ƒAÅÇ !p\"ˆ‚EÈÉ!ˆ)\n?…NË ‡" [push-mark get-register register val insert-rectangle princ markerp marker-position error "Register does not contain text" arg exchange-point-and-mark] 4 (#$ . 4312) "*cInsert register: \nP"]) #@207 Copy region into register REGISTER. With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to copy. (defalias 'copy-to-register #[(register start end &optional delete-flag) "À \n {\"ˆ\f…\n |‡" [set-register register start end delete-flag] 4 (#$ . 4912) "cCopy to register: \nr\nP"]) #@216 Append region to text in register REGISTER. With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to append. (defalias 'append-to-register #[(register start end &optional delete-flag) "À !;„ ÂÃ!ˆÄ À ! {P\"ˆ… |‡" [get-register register error "Register does not contain text" set-register start end delete-flag] 5 (#$ . 5310) "cAppend to register: \nr\nP"]) #@218 Prepend region to text in register REGISTER. With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to prepend. (defalias 'prepend-to-register #[(register start end &optional delete-flag) "À !;„ ÂÃ!ˆÄ {À !P\"ˆ… |‡" [get-register register error "Register does not contain text" set-register start end delete-flag] 5 (#$ . 5788) "cPrepend to register: \nr\nP"]) #@226 Copy rectangular region into register REGISTER. With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions giving two corners of rectangle. (defalias 'copy-rectangle-to-register #[(register start end &optional delete-flag) "À \nƒ Ã\f \"‚Æ\f \"\"‡" [set-register register delete-flag delete-extract-rectangle start end extract-rectangle] 5 (#$ . 6270) "cCopy rectangle to register: \nr\nP"]) emacs-19.30/lisp/replace.elc100666 13437 1 37627 6024240247 14350 0ustar jimbdaemon;ELC ;;; compiled by roland@whiz-bang.gnu.ai.mit.edu on Sat Sep 9 03:22:11 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/replace.el ;;; emacs version 19.29.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`replace.el' was compiled for Emacs 19.29 or later")) #@68 *Non-nil means query-replace should preserve case in replacements. (defconst case-replace t (#$ . -478)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp query-replace-history nil current-load-list] 2) #@98 Non-nil means `query-replace' uses the last search string. That becomes the "string to replace". (defvar query-replace-interactive nil (#$ . 673)) (defalias 'query-replace-read-args #[(string regexp-flag) "À‰ ƒ\fƒ ‚@‚#ÇÈÉ\n\"À‰‰Ë%ÇÈÌ\n\n#À‰‰Ë%\n  E*‡" [nil to from query-replace-interactive regexp-flag regexp-search-ring search-ring read-from-minibuffer format "%s: " string query-replace-history "%s %s with: " current-prefix-arg] 6]) #@803 Replace some occurrences of FROM-STRING with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \[help-command] at that time. If `query-replace-interactive' is non-nil, the last incremental search string is used as FROM-STRING--you don't have to specify it with the minibuffer. Preserves case in each replacement if `case-replace' and `case-fold-search' are non-nil and FROM-STRING has no uppercase letters. (Preserving case means that if the string matched is all caps, or capitalized, then its replacement is upcased or capitalized.) Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. To customize possible responses, change the "bindings" in `query-replace-map'. (defalias 'query-replace #[(from-string to-string &optional arg) "À \nÃÄ %‡" [perform-replace from-string to-string t nil arg] 6 (#$ . 1134) (query-replace-read-args "Query replace" nil)]) (define-key esc-map "%" (quote query-replace)) #@755 Replace some things after point matching REGEXP with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \[help-command] at that time. If `query-replace-interactive' is non-nil, the last incremental search regexp is used as REGEXP--you don't have to specify it with the minibuffer. Preserves case in each replacement if `case-replace' and `case-fold-search' are non-nil and REGEXP has no uppercase letters. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. In TO-STRING, `\&' stands for whatever matched the whole of REGEXP, and `\=\N' (where N is a digit) stands for whatever what matched the Nth `\(...\)' in REGEXP. (defalias 'query-replace-regexp #[(regexp to-string &optional arg) "À \nÉ\f%‡" [perform-replace regexp to-string t arg] 6 (#$ . 2179) (query-replace-read-args "Query replace regexp" t)]) #@654 Replace some matches for REGEXP with various strings, in rotation. The second argument TO-STRINGS contains the replacement strings, separated by spaces. This command works like `query-replace-regexp' except that each successive replacement uses the next successive replacement string, wrapping around from the last such string to the first. Non-interactively, TO-STRINGS may be a list of replacement strings. If `query-replace-interactive' is non-nil, the last incremental search regexp is used as REGEXP--you don't have to specify it with the minibuffer. A prefix argument N says to use each replacement string N times before rotating to the next. (defalias 'map-query-replace-regexp #[(regexp to-strings &optional arg) "À\n<ƒ\f\n‚?\nGÃU„?ÄÅ\n\"ƒ3Æ \nÃÄÅ\n\"OC\"\nÄÅ\n\"TÀO‰‚ Æ \nC\"lj‚ È ʉÀ &)‡" [nil replacements to-strings 0 string-match " " append "" perform-replace regexp t arg] 8 (#$ . 3128) (byte-code "À‰ ƒ \f@‚ÅÆÀ‰‰Ç%ÅÈÉ\n\"À‰‰Ç%\n \nE*‡" [nil to from query-replace-interactive regexp-search-ring read-from-minibuffer "Map query replace (regexp): " query-replace-history format "Query replace %s with (space-separated strings): " current-prefix-arg] 6)]) #@836 Replace occurrences of FROM-STRING with TO-STRING. Preserve case in each match if `case-replace' and `case-fold-search' are non-nil and FROM-STRING has no uppercase letters. (Preserving case means that if the string matched is all caps, or capitalized, then its replacement is upcased or capitalized.) Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. If `query-replace-interactive' is non-nil, the last incremental search string is used as FROM-STRING--you don't have to specify it with the minibuffer. This function is usually the wrong thing to use in a Lisp program. What you probably want is a loop like this: (while (search-forward FROM-STRING nil t) (replace-match TO-STRING nil t)) which will run faster and will not set the mark or print anything. (defalias 'replace-string #[(from-string to-string &optional delimited) "À \nÉ\f%‡" [perform-replace from-string to-string nil delimited] 6 (#$ . 4330) (query-replace-read-args "Replace string" nil)]) #@868 Replace things after point matching REGEXP with TO-STRING. Preserve case in each match if `case-replace' and `case-fold-search' are non-nil and REGEXP has no uppercase letters. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. In TO-STRING, `\&' stands for whatever matched the whole of REGEXP, and `\=\N' (where N is a digit) stands for whatever what matched the Nth `\(...\)' in REGEXP. If `query-replace-interactive' is non-nil, the last incremental search regexp is used as REGEXP--you don't have to specify it with the minibuffer. This function is usually the wrong thing to use in a Lisp program. What you probably want is a loop like this: (while (re-search-forward REGEXP nil t) (replace-match TO-STRING nil nil)) which will run faster and will not set the mark or print anything. (defalias 'replace-regexp #[(regexp to-string &optional delimited) "À \nÃÄ %‡" [perform-replace regexp to-string nil t delimited] 6 (#$ . 5374) (query-replace-read-args "Replace regexp" t)]) #@63 History list for some commands that read regular expressions. (defvar regexp-history nil (#$ . 6438)) (defalias (quote delete-non-matching-lines) (quote keep-lines)) #@159 Delete all lines except those containing matches for REGEXP. A match split across lines preserves all the lines it lies in. Applies to all lines after point. (defalias 'keep-lines #[(regexp) "Šn„Àyˆ`m?…P ÄÅ#„ d|ˆ‚7ŠÆ”bˆÆyˆ`) Wƒ6 |ˆ)ŠÀyˆ`)m„\nƔƕUƒ\nÀuˆ‚\n*‡" [1 start re-search-forward regexp nil move 0 end] 4 (#$ . 6611) (list (read-from-minibuffer "Keep lines (containing match for regexp): " nil nil nil (quote regexp-history)))]) (defalias (quote delete-matching-lines) (quote flush-lines)) #@147 Delete lines containing matches for REGEXP. If a match is split across lines, all the lines it lies in are deleted. Applies to lines after point. (defalias 'flush-lines #[(regexp) "Šm?…!À ÂÃ#…!ŠÄ”bˆÄyˆ`)Åyˆ`|ˆ‚)‡" [re-search-forward regexp nil t 0 1] 4 (#$ . 7134) (list (read-from-minibuffer "Flush lines (containing match for regexp): " nil nil nil (quote regexp-history)))]) (defalias (quote count-matches) (quote how-many)) #@53 Print number of matches for REGEXP following point. (defalias 'how-many #[(regexp) "ÀÁŠm„%`Ä ÁÆ#ƒ%\n`UƒÇuˆ‚ T‚ÈÉ \"+‡" [0 nil opoint count re-search-forward regexp t 1 message "%d occurrences"] 4 (#$ . 7572) (list (read-from-minibuffer "How many matches for (regexp): " nil nil nil (quote regexp-history)))]) (byte-code "ÀÁ!„ÂÁ B „%Ä Å ÆÇ#ˆÅ ÈÉ#ˆÅ ÊÉ#ˆÀË!„.Â Ë BÀÌ!„;Â\fÌ BÀÍ!„HÂ Í B‡" [boundp occur-mode-map nil current-load-list make-sparse-keymap define-key [mouse-2] occur-mode-mouse-goto "" occur-mode-goto-occurrence " " occur-buffer occur-nlines occur-pos-list] 4) #@279 Major mode for output from \[occur]. \Move point to one of the items in this buffer, then use \[occur-mode-goto-occurrence] to go to the occurrence that the item refers to. Alternatively, click \[occur-mode-mouse-goto] on an item to go to it. \{occur-mode-map} (defalias 'occur-mode #[nil "À ˆÁ\n!ˆÃÅÇÈ!ˆÇÉ!ˆÇÊ!ˆËÌ!‡" [kill-all-local-variables use-local-map occur-mode-map occur-mode major-mode "Occur" mode-name make-local-variable occur-buffer occur-nlines occur-pos-list run-hooks occur-mode-hook] 2 (#$ . 8181)]) #@62 In Occur mode, go to the occurrence whose line you click on. (defalias 'occur-mode-mouse-goto #[(event) "À‰ŠÃ\fÅ\f8:ƒÅ‚Æ\f8)‰@)!qˆŠ\fÅ\f8:ƒ-Å‚.Æ\f8)‰A@:ƒBA@@‚FA@)bˆÈ  *Ê\n!ˆË !b*‡" [nil pos buffer window-buffer event 2 1 position occur-mode-find-occurrence occur-buffer pop-to-buffer marker-position] 4 (#$ . 8724) "e"]) (defalias 'occur-mode-find-occurrence #[nil "ƒ\nÁ!„ÂÂÄÅ!ˆÆeŠÇyˆ`)\"ŠÇyˆS ÇWƒ2Ê Z‚C ÇVƒB ‰\\Ê\\‚CË¥)‰\f 8 ËWƒWÄÎ!ˆ „`ÄÎ!ˆ +‡" [occur-buffer buffer-name nil occur-pos-list error "Buffer in which occurrences were found is deleted" count-lines 0 line-count occur-nlines 2 1 occur-number pos "No occurrence on this line"] 4]) #@50 Go to the occurrence the current line describes. (defalias 'occur-mode-goto-occurrence #[nil "À  !ˆÄ !b)‡" [occur-mode-find-occurrence pos pop-to-buffer occur-buffer marker-position] 2 (#$ . 9422) nil]) #@227 *Default number of context lines to include around a `list-matching-lines' match. A negative number means to include that many lines before the match. A positive number means to include that many lines both before and after. (defvar list-matching-lines-default-context-lines 0 (#$ . -9634)) (defalias (quote list-matching-lines) (quote occur)) #@507 Show all lines in the current buffer containing a match for REGEXP. If a match spreads across multiple lines, all those lines are shown. Each line is displayed with NLINES lines before and after, or -NLINES before if NLINES is negative. NLINES defaults to `list-matching-lines-default-context-lines'. Interactively it is the prefix arg. The lines are shown in a buffer named `*Occur*'. It serves as a menu to find any of the occurrences in this buffer. \[describe-mode] in that buffer will explain how. (defalias 'occur #[(regexp &optional nlines) "ƒ\nÁ!‚ \nÃp\fÅeÆ  \n \fÍŠqˆ\nÏcˆÃÑ!ˆ)ÓÔ !ÕÖ±ˆ× ˆ Ú) =ƒXdbˆŠÜ ˆdU„¤ÝÚÃ#ƒ¤Þ”bˆÞyˆß  Ꭰâ`\"\\ *`Þ•bˆŠÞ”bˆÞWƒš‚œ[yˆ`)#ŠÞ•bˆÞVƒ´Tyˆ‚·Åyˆ`)$åæ \"'è'Gé\"*Ú+ŠÆ ‰+`Ú“ˆqˆ+B\f„ðì!„ðícˆÚ\fî #$#ˆ`$Þ•ZZÚ“ˆï$#Z!ˆ‰+ÞVƒ+*ð±ˆÅyˆ+S‰+‚ 1`Wƒg'„Båæ1\"''ð±ˆòŠÞyˆ`)ŠÚˆ`)óô$ˆÅyˆÚ'1T1‚/`Xƒ*ð±ˆÅyˆ1T1‚g)+Wƒ™*ð±ˆÅyˆ+T‰+‚‚dbˆ)Åyˆ-‚\\qˆŸebˆGÅUƒ¾õcˆ‚ÆåöG\"cˆt…Ð÷øG\")‘.‡" [nlines prefix-numeric-value list-matching-lines-default-context-lines t default-directory 1 make-marker final-context-start prevpos linenum dir buffer first "*Occur*" standard-output " matching " print-escape-newlines prin1 regexp " in buffer " buffer-name 46 10 occur-mode occur-buffer occur-nlines nil occur-pos-list beginning-of-buffer re-search-forward 0 match-data match-data ((store-match-data match-data)) count-lines start end format "%5d" tag make-string 32 empty tem zerop "--------\n" insert-buffer-substring backward-char 58 this-linenum put-text-property mouse-face highlight "1 line" "%d lines" message "%d matching lines."] 7 (#$ . 9986) (list (let* ((default (car regexp-history)) (input (read-from-minibuffer (if default (format "List lines matching regexp (default `%s'): " default) "List lines matching regexp: ") nil nil nil (quote regexp-history)))) (if (> (length input) 0) input (setcar regexp-history default))) current-prefix-arg)]) #@37 Help message while in query-replace (defconst query-replace-help "Type Space or `y' to replace one match, Delete or `n' to skip to next,\nRET or `q' to exit, Period to replace one match and exit,\nComma to replace but not move point immediately,\nC-r to enter recursive edit (\\[exit-recursive-edit] to get out again),\nC-w to delete match and recursive edit,\nC-l to clear the screen, redisplay, and offer same replacement again,\n! to replace all remaining matches with no more questions,\n^ to move point back to previous match." (#$ . 11990)) #@301 Keymap that defines the responses to questions in `query-replace'. The "bindings" in this map are not commands; they are answers. The valid answers include `act', `skip', `act-and-show', `exit', `act-and-exit', `edit', `delete-and-edit', `recenter', `automatic', `backup', `exit-prefix', and `help'. (defvar query-replace-map (make-sparse-keymap) (#$ . 12544)) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÅ#ˆÀ ÇÅ#ˆÀ ÈÃ#ˆÀ ÉÅ#ˆÀ ÊÃ#ˆÀ ËÅ#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÏ#ˆÀ ÑÏ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆÀ ØÙ#ˆÀ ÚÛ#ˆÀ ÜÝ#ˆÀ Þß#ˆÀ àß#ˆÀ áß#ˆÀ âß#ˆÀ ãä#ˆÀ åä#ˆÀ æç#ˆÀ èç#‡" [define-key query-replace-map " " act "" skip [delete] [backspace] "y" "n" "Y" "N" "," act-and-show "q" exit " " [return] "." act-and-exit "" edit "" delete-and-edit "\f" recenter "!" automatic "^" backup "" help [f1] [help] "?" "" quit "" "" exit-prefix [escape]] 4) #@373 Subroutine of `query-replace'. Its complexity handles interactive queries. Don't use this in your own program unless you want to query and set the mark just as `query-replace' does. Instead, write a simple loop like this: (while (re-search-forward "foo[ ]+bar" nil t) (replace-match "foobar" nil nil)) which will run faster and probably do exactly what you want. (defalias 'perform-replace #[(from-string replacements query-flag regexp-flag delimited-flag &optional repeat-count map) "„ \n… …\f‰—˜? ? ƒÆ‚Ç\fȉÉÊÈɉÈÊ …0ÌÍ!;ƒY‚a„aÞƒyÆà ƒr\f‚uá\f!àQ⠈㠈䎃ûm„ûÈÊ#ƒû`=„¬ ƒ½É”=ƒ½„½m„ûÞuˆÈÊ#‚¾Êƒûå  ƒÏæ!<ƒôUƒô\\8TG¦ „ç!ˆè#ˆT‚õ㠈ȉ‰‰)*+,,„Õç!ˆíɔɕ\"ˆÈ.Î\f#ˆ)ï *ð*!*ñ*\"‰)ò=ƒyóôõ ƒ^ö‚_÷\føùÌ:!°!ˆŠ;qˆü )‘ˆ‚)ý=ƒŠÈʉ,‚ )þ=ƒÐƒ¹@‰?@bˆ?AÊ=‰+„°ç?A!ˆA)‚Î@!ˆAB!ˆCÞ!ˆ‚)D=ƒð+„çè#ˆÊ,Ê+‚)E=ƒ+„è#ˆÈÊ,Ê+‚)F=ƒ0+„è#ˆÊ+‚)G=ƒS+„Gè#ˆÊ,È Ê+‚)H=ƒcʉ,‚ )I=ƒuIÈ!ˆ‚)J=ƒ—çå ŠK ˆ)!ˆ ƒæ!‚)L=ƒ¸ɔɕ|ˆçå ŠK ˆ)!ˆÊ+‚MNÈOP*!Q\"Qʉ,ƒ#`+†äRSå \"BB+ƒôT,`‚)Q„ÎT‰ÞUƒ÷‚U#ˆ….‡" [map query-replace-map case-fold-search case-replace from-string regexp-flag re-search-forward search-forward nil 0 t query-flag substitute-command-keys "Query replacing %s with %s: (\\\\[help] for help) " message match-again lastrepl replace-count next-rotate-count stack keep-going replacement-index next-replacement real-match-data search-string search-function literal nocasify replacements repeat-count 1 delimited-flag "\\b" regexp-quote push-mark undo-boundary ((replace-dehighlight)) match-data looking-at store-match-data replace-match def key replaced done replace-highlight message-log-max read-event vector lookup-key help "*Help*" princ "Query replacing " "regexp " "" " with " ".\n\n" query-replace-help standard-output help-mode exit backup elt "No previous match" ding no-terminate sit-for act act-and-exit act-and-show automatic skip recenter edit recursive-edit delete-and-edit mode-exited this-command append listify-key-sequence unread-command-events mapcar #[(elt) "…\fÁ!‰“ˆ‡" [elt marker-position nil] 4] "Replaced %d occurrence%s" "s"] 16 (#$ . 13357)]) #@61 *Non-nil means to highlight words during query replacement. (defvar query-replace-highlight nil (#$ . -15772)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp replace-overlay nil current-load-list] 2) (defalias 'replace-dehighlight #[nil "… Á!ˆÂ‰‡" [replace-overlay delete-overlay nil] 2]) (defalias 'replace-highlight #[(start end) "…# „ \f\"Å ÆÇÈ!ƒÈ‚É#ˆÊ \fp$‡" [query-replace-highlight replace-overlay make-overlay start end overlay-put face internal-find-face query-replace region move-overlay] 5]) emacs-19.30/lisp/reporter.elc100666 13437 1 14557 5744577155 14617 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:48:59 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/reporter.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/reporter.el' was compiled for Emacs 19")) #@251 *Mail package to use to generate bug report buffer. This can either be a function symbol or a list of function symbols. If a list, it tries to use each specified mailer in order until an existing one is found. MH-E users may want to use `mh-smail'. (defvar reporter-mailer (quote (vm-mail reporter-mail)) (#$ . -486)) #@449 Interface variable controlling prompting for problem summary. When non-nil, `reporter-submit-bug-report' prompts the user for a brief summary of the problem, and puts this summary on the Subject: line. Default behavior is to not prompt (i.e. nil). If you want reporter to prompt, you should `let' bind this variable to t before calling `reporter-submit-bug-report'. Note that this variable is not buffer-local so you should never just `setq' it. (defvar reporter-prompt-for-summary-p nil (#$ . 812)) #@565 Interface variable controlling compating of list values. When non-nil, this must be a list of variable symbols. When a variable containing a list value is formatted in the bug report mail buffer, it normally is compacted so that its value fits one the fewest number of lines. If the variable's symbol appears in this list, its value is printed in a more verbose style, specifically, one elemental sexp per line. Note that this variable is not buffer-local so you should never just `setq' it. If you want to changes its default value, you should `let' bind it. (defvar reporter-dont-compact-list nil (#$ . 1321)) #@184 Buffer to retrieve variable's value from. This is necessary to properly support the printing of buffer-local variables. Current buffer will always be the mail buffer being composed. (defvar reporter-eval-buffer nil (#$ . 1944)) #@26 Reporter version number. (defconst reporter-version "2.21" (#$ . 2179)) #@57 The automatically created initial text of a bug report. (defvar reporter-initial-text nil (#$ . 2257)) (byte-code "ÀÁ!ˆÂÃ!„\fÄà BÂÆ!„ÄÆ Bć" [make-variable-buffer-local reporter-initial-text boundp reporter-status-message nil current-load-list reporter-status-count] 2) (defalias 'reporter-update-status #[nil "Á¦ÂUƒÃ\f!ˆ\fÅPT‰‡" [reporter-status-count 10 0 message reporter-status-message "."] 2]) (defalias 'reporter-beautify-list #[(maxwidth compact-p) "À ˆÁ‰‰‰ÁÆÇ,‡" [reporter-update-status nil here indent-p indent-enclosing-p linebreak (byte-code "ÀÁ!ˆÂ`ÅÁ!ˆiXƒBƒ%bˆÈ ˆÉ‚\fbˆÊ \"\f\fbˆÅÁ!ˆ\fƒÈ ˆ‚ ƒM`‚È ˆ‚" [down-list 1 t indent-enclosing-p here forward-sexp maxwidth linebreak newline-and-indent nil reporter-beautify-list compact-p indent-p] 3) ((error indent-enclosing-p))] 4]) (defalias 'reporter-lisp-indent #[(indent-point state) "ŠA@Tbˆi)‡" [state] 1]) (defalias 'reporter-dump-variable #[(varsym mailbuf) "À ˆÁÂÇ" [reporter-update-status nil (byte-code "Šqˆ J) !ÃÄ S` ÊË Ì>ƒ'Í‚< <ƒ1΂< 9ƒ;΂<ÍÏ !±ˆÐ ˆ ƒn <ƒniXƒnŠ >?Ò bˆÕ\"ˆ+Öc-‡" [reporter-eval-buffer varsym symbol-name t window-width here maxwidth print-escape-newlines sym val " " " " (t nil) "" "'" prin1-to-string lisp-indent-line reporter-dont-compact-list reporter-lisp-indent lisp-indent-function compact-p reporter-beautify-list "\n"] 6) ((void-variable (byte-code "ŠqˆÁÂ!ˆÃˆÄ !Ʊ)‡" [mailbuf mail-position-on-field "X-Reporter-Void-Vars-Found" nil symbol-name varsym " "] 2)) (error (error)))] 3]) (defalias 'reporter-dump-state #[(pkgname varlist pre-hooks post-hooks) "p‰qˆÁ ñˆ\fƒÅ\fñˆÆÇ!ˆƒ'ÉcˆÊË̈ÆÍ!)‡" [buffer "Emacs : " emacs-version "\n" pkgname "Package: " run-hooks pre-hooks varlist "\ncurrent state:\n==============\n" fault (byte-code "pÀÁ!Š\nqˆÄ ˆÅ ˆÆcˆÇ ˆÈÉ\n\"ˆÇ ˆËcˆ)Ì\n!ˆ*À‡" [get-buffer-create " *tmp-reporter-buffer*" elbuf mailbuf emacs-lisp-mode erase-buffer "(setq\n" lisp-indent-line mapcar #[(varsym-or-cons-cell) "¢†£†\fÁ\n \f\"*‡" [varsym-or-cons-cell reporter-dump-variable printer varsym mailbuf] 3] varlist ")\n" insert-buffer] 3) ((error (byte-code "ÀÁ \"ı‡" ["State could not be dumped due to the following error:\n\n" format "%s" fault "\n\nYou should still send this bug report."] 4))) post-hooks] 4]) (defalias 'reporter-calculate-separator #[nil "ŠÀÁÂÃÄÅÆ!EÈ#ÉQÊË#ˆÌ”Ì•{)‡" [re-search-forward "^\\(" mapconcat identity "[ ]*" "-+" regexp-quote mail-header-separator "\\|" "\\)$" nil move 0] 8]) (defalias 'reporter-mail #[(&rest args) "ÀÁ\n\"†\nÃÄ!‡" [apply mail args error "Bug report aborted"] 3 nil "P"]) (defalias 'reporter-submit-bug-report #[(address pkgname varlist &optional pre-hooks post-hooks salutation) "pÀ‰Á …\fÄÅ!Æ<„‚MÀ‰ ƒ@Ê @!ƒ7 @À‰ ‚  A‰ „#„JËÌÍ\"ˆ*!ˆpÕÖ!ˆ×!ˆ×!ˆebˆØ ÚÛ!ˆcˆ ƒ•ƒ•ƒ•ÚÞ!ˆß±ˆà ˆáyˆ`\"ƒªã\"䱈åŽæ äcˆç()*$ˆbˆ*ëì!ƒáŠdbˆíÀxˆ`{.)ïð!ˆìðñ\"ˆò3ôõÀö#‰7ƒöø7!‚÷ù:ûü3:#.\n‡" [nil "Formatting bug report buffer..." 0 reporter-prompt-for-summary-p read-string "(Very) brief summary of problem: " call-interactively reporter-mailer mailer mlist commandp error "Variable `%s' does not contain a command for mailing" "reporter-mailer" mailbuf problem reporter-status-count reporter-status-message after-sep-pos final-resting-place reporter-eval-buffer require sendmail pop-to-buffer reporter-calculate-separator mail-header-separator mail-position-on-field "to" address pkgname "subject" "; " mail-text 1 salutation "\n" "\n\n" ((byte-code "Á‰“‡" [final-resting-place nil] 3)) point-marker reporter-dump-state varlist pre-hooks post-hooks fboundp add-hook " \n" reporter-initial-text make-variable-buffer-local mail-send-hook reporter-bug-hook "C-c C-c" sendkey where-is-internal kill-buffer t killkey-whereis key-description "M-x kill-buffer" killkey message "Please type in your report. Hit %s to send, %s to abort."] 11]) (defalias 'reporter-bug-hook #[nil "ŠÀ ˆÁ dÃ#ˆÄyˆ`)ŠdbˆÆÇxˆ` ZGU…/ `{˜…/ÉÊ!*‡" [beginning-of-buffer re-search-forward reporter-calculate-separator move 1 after-sep-pos " \n" nil reporter-initial-text error "Empty bug report cannot be sent"] 4]) (provide (quote reporter)) emacs-19.30/lisp/reposition.elc100666 12241 1 4653 5744577156 15453 0ustar rolanddaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:49:01 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/reposition.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/reposition.el' was compiled for Emacs 19")) #@1058 Make the current definition and/or comment visible. Further invocations move it to the top of the window or toggle the visibility of comments that precede it. Point is left unchanged unless prefix ARG is supplied. If the definition is fully onscreen, it is moved to the top of the window. If it is partly offscreen, the window is scrolled to get the definition (or as much as will fit) onscreen, unless point is in a comment which is also partly offscreen, in which case the scrolling attempts to get as much of the comment onscreen as possible. Initially `reposition-window' attempts to make both the definition and preceding comments visible. Further invocations toggle the visibility of the comment lines. If ARG is non-nil, point may move in order to make the whole defun visible (if only part could otherwise be made so), to make the defun line visible (if point is in code and it could not be made so, or if only comments, including the first comment line, are visible), or to make the first comment line visible (if point is in a comment). (defalias 'reposition-window #[(&optional arg) "`Á !ÃZÅÆ `\"ÈÉŠm„ÊuˆËÌ!ˆÍÎÏÐ#ƒ*ÑÊ!ˆ`)\"]ÉŠËÊ!ˆÓÊ!ˆ`)\"ÅŠËÊ!ˆ`)\"X…\\Z\fXU„z\fUƒœVƒœƒœƒ“\fTVƒ“Ë ˆÓ ˆØÈ!‚4ØÈ]!‚4U„ºÈU„ºWƒõÈWƒõ\fUƒÒƒÌË ˆÓ ˆØÈ!‚4ƒì\fWƒì[yˆÈyˆØÈ!‚4Ø\f^!‚4Ì\\\\\fVƒƒØÈ\fZT]]!‚4ƒ.\fWƒ.[yˆÈyˆÙ ‚4Ø\f^!.‡" [here window-height selected-window 2 ht repos-count-screen-lines window-start line 0 repos-count-screen-lines-signed 1 end-of-defun -1 re-search-forward "[^ \n\f]" nil t backward-char comment-height beginning-of-defun defun-height defun-depth defun-line-onscreen-p arg recenter reposition-window] 6 (#$ . 491) "P"]) (defalias 'repos-count-screen-lines #[(start end) "ŠŒ }ˆebˆÂdeZ!*‡" [start end vertical-motion] 3]) (defalias 'repos-count-screen-lines-signed #[(start end) "À \n\" \nWƒ ‚ [)‡" [repos-count-screen-lines start end lines] 3]) emacs-19.30/lisp/resume.elc100666 13437 1 3772 5770131700 14207 0ustar jimbdaemon;ELC ;;; compiled by kwzh@nutrimat.gnu.ai.mit.edu on Thu Jun 15 18:27:11 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/resume.el ;;; emacs version 19.28.94.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`resume.el' was compiled for Emacs 19.29 or later")) #@69 *This file is where arguments are placed for a suspended emacs job. (defvar resume-emacs-args-file (expand-file-name "~/.emacs_args") (#$ . -479)) #@45 Buffer that is used by resume-process-args. (defvar resume-emacs-args-buffer " *Command Line Args*" (#$ . 632)) #@60 Handler for command line args given when Emacs is resumed. (defalias 'resume-process-args #[nil "pÀ !‰ ÉŽqˆÊ ˆÂË̈ÍXƒ)‚Pebˆm„JÎÂwˆ`ÐÂwˆ`{ B)ÎÂwˆ‚, ŸÊ ˆÑp\"ˆ ƒbÓ @! AÔ !.‡" [get-buffer-create resume-emacs-args-buffer nil default-directory command-line-default-directory args length args-buffer start-buffer ((byte-code "p=ƒ qˆÂ‡" [args-buffer start-buffer nil] 2)) erase-buffer (byte-code "À !‰A@)À‡" [insert-file-contents resume-emacs-args-file result length] 3) ((file-error (byte-code "À ˆÁÀ‡" [erase-buffer 0 length] 1))) 0 " \n" begin "^ \n" resume-write-buffer-to-file resume-emacs-args-file file-name-as-directory command-line-1] 5 (#$ . 750)]) #@67 Clear out the file used for transmitting args when Emacs resumes. (defalias 'resume-suspend-hook #[nil "ŠÀ !qˆÂ ˆÃp\f\")‡" [get-buffer-create resume-emacs-args-buffer erase-buffer resume-write-buffer-to-file resume-emacs-args-file] 3 (#$ . 1447)]) #@64 Writes the contents of BUFFER into FILE, if permissions allow. (defalias 'resume-write-buffer-to-file #[(buffer file) "À !„ Âà \"ˆŠ\fqˆÅ ˆŒ~ˆÆed ÇÈ%ˆ)ÉÇ!)‡" [file-writable-p file error "No permission to write file %s" buffer clear-visited-file-modtime write-region nil quiet set-buffer-modified-p] 6 (#$ . 1701)]) (provide (quote resume)) emacs-19.30/lisp/rfc822.elc100666 13437 1 10501 5744577162 13742 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:49:03 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/rfc822.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/rfc822.el' was compiled for Emacs 19")) (defalias 'rfc822-bad-address #[(reason) "ŒÀcˆ ÂÃÄÅ#ƒe`S]‚d}ˆÆebˆÈ@ÄÅ#ƒ4ÉÊ!ˆËcˆÊuˆ‚A‰„)ebˆÌ αˆdbˆÏcˆ)Ð ˆÑÒ `{\"‡" ["_^_" address-start re-search-forward "[,;]" nil t ("\\" "(" ")" "\n") losers search-forward backward-char 1 92 "(Unparsable address -- " reason ":\n \"" "\")" rfc822-nuke-whitespace throw address] 6]) (defalias 'rfc822-nuke-whitespace #[(&optional leave-space) "Àm„mg‰ÂUƒ\\ÃuˆmƒÄÅ!‚!g‰ÆU?ƒRÇÈ!ƒ1ÉÊ!ˆ‚ ÂUƒ=Ë ˆ‚`dSWƒKÌÍ!ˆ‚ÄÎ!ˆ‚ÏuˆÌÍ!ˆ‚ Ð>ƒm`ÑÀwˆ`|ˆ‚?†ƒm†ƒo†ƒhÓU†ƒÓc)‡" [nil ch 40 1 rfc822-bad-address "Unbalanced comment (...)" 41 looking-at "[^()\\]+" replace-match "" rfc822-nuke-whitespace delete-char 2 "orphaned backslash" -1 (32 9 10) " \n" leave-space 32] 3]) (defalias 'rfc822-looking-at #[(regex &optional leave-space) ";ƒÁ!….•bˆ‚ m?….gU….ÃuˆÄ Æ!ˆÈ !ˆ)ɇ" [regex looking-at 0 1 match-data tem rfc822-nuke-whitespace leave-space store-match-data t] 2]) (defalias 'rfc822-snarf-word #[nil "gÀUƒÁÂ!†ÃÄ!‡ÁÅ!†ÃÆ!‡" [34 rfc822-looking-at "\"\\([^\"\\\n]\\|\\\\.\\|\\\\\n\\)*\"" rfc822-bad-address "Unterminated quoted string" "[^][--ÿ ()<>@,;:\\\".]+" "Rubbish in address"] 2]) (defalias 'rfc822-snarf-words #[nil "À ˆÁÂ!…À ˆ‚‡" [rfc822-snarf-word rfc822-looking-at 46] 2]) (defalias 'rfc822-snarf-subdomain #[nil "gÀUƒÁÂ!†ÃÄ!‡ÁÅ!†ÃÆ!‡" [91 rfc822-looking-at "\\[\\([^][\\\n]\\|\\\\.\\|\\\\\n\\)*\\]" rfc822-bad-address "Unterminated domain literal [...]" "[^][--ÿ ()<>@,;:\\\".]+" "Rubbish in host/domain specification"] 2]) (defalias 'rfc822-snarf-domain #[nil "À ˆÁÂ!…À ˆ‚‡" [rfc822-snarf-subdomain rfc822-looking-at 46] 2]) (defalias 'rfc822-snarf-frob-list #[(name separator terminator snarfer &optional return) "ÀÁ‰mƒÅÆÇ\"!‚7É\n!„]É !ƒ,É !„\"‚:\f„:ÅÆÌ\"!ƒ] Áƒ\nƒ\n<ƒVÏ\n! ¤‚Y\n B‚ Ÿ+‡" [t nil tem list first rfc822-bad-address format "End of addresses in middle of %s" name rfc822-looking-at terminator separator "Gubbish in middle of %s" snarfer return reverse] 4]) (defalias 'rfc822-addresses-1 #[(&optional allow-groups) "`ÀÃÄ*‡" [0 n address-start address (byte-code "ÀÁÂ\"ƒ(m„ÀÃ!ƒ(o„hÄUƒÅÆ!ˆÇÈ Ê•{\"ˆ bˆ ÌUƒGÀÍ!ƒGÎ ˆÇÈ `{\"ˆ‚,ÀÏ!ƒr„YÑÒ!ˆ‚d ÊUƒdÑÓ!ˆÇÈÔÕÃÖ×Â%\"ˆ‚,ÀØ!ƒê`ÂÀÛ!„·m„«gÍUƒ«ÔÜÃÏÝ$ˆÞ ˆÀÍ!„¢Ñß!ˆÎ ˆà‚·Þ ˆÀÍ!ƒ·Î ˆ`!ÀÛ!ƒâÇȃ̂ÏSƒÙ!‚Ü!T{\"ˆ‚æÑâ!ˆ+‚,ãä!ƒ\"Â% ÊU„o„hÄU„ÄcˆÞ ˆ T Àæ!†ãä!‰%„ó)‚, ÊUƒ1ÇÈà\"ˆ‚, ÌUƒCÇÈ `{\"ˆ‚, ÌVƒQÑç!ˆ‚,m„[gÃUƒbÑè!ˆ‚,Ñé!ˆ‚," [rfc822-looking-at "[^][--ÿ ()<>@,;:\\\"]+\\(\\|@[^][--ÿ ()<>@,;:\\\"]+\\)" t 44 32 delete-char -1 throw address address-start 0 n 1 64 rfc822-snarf-domain 58 allow-groups rfc822-bad-address "A group name may not appear here" "No name for :...; group" rfc822-snarf-frob-list ":...; group" 59 rfc822-addresses-1 60 strip start 62 "<...> address" #[nil "ÀÁ!ƒ  ‡ÃÄ!‡" [rfc822-looking-at 64 rfc822-snarf-domain rfc822-bad-address "Gubbish in route-addr"] 2] rfc822-snarf-words "Malformed <..@..> address" nil end "Unterminated <...> address" looking-at "[^][--ÿ ()<>@,;:\\.]" again 46 "Missing comma between addresses or badly-formatted address" "Missing comma or route-spec" "Strange character or missing comma"] 9)] 2]) (defalias 'rfc822-addresses #[(header-text) "ÀÁ\n\"ƒ\nÔÕOC‡ÄÅ!ÇŽŠqˆÈÉ!ˆÊ \ncˆebˆËÌÊÍ#ƒ8ÎÏÍ\"ˆ‚(ebˆÐ ˆÊ‰‰m„r`ÔÕ‰ƒG;ƒgB‚GŸ¤‚GŸ.‡" [string-match "\\`[ ]*\\([^][--ÿ ()<>@,;:\\\".]+\\)[ ]*\\'" header-text 1 generate-new-buffer " rfc822" buf ((byte-code "ƒÁ!ˆÁ‡" [buf kill-buffer] 2)) make-local-variable case-fold-search nil re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ ]" t replace-match "\\1 " rfc822-nuke-whitespace address-start tem list address (byte-code "ÀÁ!ƒ‡ÃÄ!ƒÂuˆÅÆÇh\"!‡ÈÉ!‡" [rfc822-looking-at 44 nil looking-at "[][--ÿ@;:\\.>)]" rfc822-bad-address format "Strange character \\%c found" rfc822-addresses-1 t] 4)] 5]) (provide (quote rfc822)) emacs-19.30/lisp/ring.elc100666 13437 1 5137 5744577163 13665 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:49:06 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/ring.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/ring.el' was compiled for Emacs 19")) #@42 Returns t if X is a ring; nil otherwise. (defalias 'ring-p #[(x) ":…@¨…A:…A@¨…ÁAA!‡" [x vectorp] 2 (#$ . 477)]) #@45 Make a ring that can contain SIZE elements. (defalias 'make-ring #[(size) "À‰Á\nÃ\"BB‡" [0 make-vector size nil] 5 (#$ . 608)]) #@66 Add to RING the item ITEM. Add it at the front (the early end). (defalias 'ring-insert-at-beginning #[(ring item) "AA‰G@A@\n\fT^Å \n\" Iˆ  ˆA\f ,‡" [ring vec veclen hd ln ring-minus1 item] 4 (#$ . 742)]) #@26 INDEX+1, with wraparound (defalias 'ring-plus1 #[(index veclen) "Á\\‰ UƒÄ‚\n)‡" [index 1 new-index veclen 0] 3 (#$ . 967)]) #@26 INDEX-1, with wraparound (defalias 'ring-minus1 #[(index veclen) "ÁUƒ\n\n‚ ÃZ‡" [index 0 veclen 1] 2 (#$ . 1103)]) #@33 Number of elements in the ring. (defalias 'ring-length #[(ring) "A@‡" [ring] 1 (#$ . 1228)]) (defalias 'ring-empty-p #[(ring) "A@ÁU‡" [ring 0] 2]) (defalias 'ring-index #[(index head ringlen veclen) "À \n\"À \n Z\\S\f\"‡" [mod index ringlen head veclen] 4]) #@121 Insert onto ring RING the item ITEM, as the newest (last) item. If the ring is full, dump the oldest item to make room. (defalias 'ring-insert #[(ring item) "AA‰G@A@ Å \f\\\n\"I\f\nUƒ(Ç \n\" ˆ‚.A\fT ˆ,‡" [ring vec veclen hd ln mod item ring-plus1] 6 (#$ . 1496)]) #@153 Remove an item from the RING. Return the removed item. If optional INDEX is nil, remove the oldest item. If it's numeric, remove the element indexed. (defalias 'ring-remove #[(ring &optional index) "À !ƒ\nÂÃ!‡ @ A@ AA‰GÈ\f \\S\" Ê \f„0 S\fÍ\f\f $\f\fH \f U„d\fÎ\f\"HIˆÎ\f\"‰\f‚C ÊIˆ A S ˆ .‡" [ring-empty-p ring error "Ring empty" hd ln vec veclen mod tl nil oldelt index ring-index ring-plus1] 7 (#$ . 1780)]) #@224 Returns RING's INDEX element. INDEX need not be <= the ring length, the appropriate modulo operation will be performed. Element 0 is the most recently inserted; higher indices correspond to older elements until they wrap. (defalias 'ring-ref #[(ring index) "À !ƒ\nÂÃ!‡ @ A@ AA‰Ç\f G$H+‡" [ring-empty-p ring error "indexed empty ring" hd ln vec ring-index index] 7 (#$ . 2243)]) (provide (quote ring)) emacs-19.30/lisp/rlogin.elc100666 13437 1 17565 6044554654 14242 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Sat Oct 28 21:32:22 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/rlogin.el ;;; emacs version 19.29.1.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`rlogin.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require comint shell] 2) #@35 *Name of program to invoke rlogin (defvar rlogin-program "rlogin" (#$ . -527)) #@59 *List of arguments to pass to rlogin on the command line. (defvar rlogin-explicit-args nil (#$ . -612)) #@60 *Hooks to run after setting current buffer to rlogin-mode. (defvar rlogin-mode-hook nil (#$ . -722)) #@343 *If non-`nil', use a pty for the local rlogin process. If `nil', use a pipe (if pipes are supported on the local system). Generally it is better not to waste ptys on systems which have a static number of them. On the other hand, some implementations of `rlogin' assume a pty is being used, and errors will result from using a pipe instead. (defvar rlogin-process-connection-type nil (#$ . -830)) #@664 *Control whether and how to do directory tracking in an rlogin buffer. nil means don't do directory tracking. t means do so using an ftp remote file name. Any other value means do directory tracking using local file names. This works only if the remote machine and the local one share the same directories (through NFS). This is the default. This variable becomes local to a buffer when set in any fashion for it. It is better to use the function of the same name to change the behavior of directory tracking in an rlogin session once it has begun, rather than simply setting this variable, since the function does the necessary re-synching of directories. (defvar rlogin-directory-tracking-mode (quote local) (#$ . -1235)) (make-variable-buffer-local (quote rlogin-directory-tracking-mode)) #@63 *The name of the remote host. This variable is buffer-local. (defvar rlogin-host nil (#$ . -2039)) #@214 *The username used on the remote host. This variable is buffer-local and defaults to your local user name. If rlogin is invoked with the `-l' option to specify the remote username, this variable is set from that. (defvar rlogin-remote-user nil (#$ . -2146)) (byte-code "ÀÁ!„ÂÁ B „C\f:ƒÅ\fB‚Æ\f!Ç ÈÉ#ˆÇ ÊË#ˆÇ ÌÍ#ˆÇ ÎÏ#ˆÇ ÐÑ#ˆÇ ÒÓ#ˆÀÔ!„LÂÔ B‡" [boundp rlogin-mode-map nil current-load-list shell-mode-map keymap copy-keymap define-key "" rlogin-send-Ctrl-C "" rlogin-send-Ctrl-D "" rlogin-send-Ctrl-Z "" rlogin-send-Ctrl-backslash "" rlogin-delchar-or-send-Ctrl-D " " rlogin-tab-or-complete rlogin-history] 4) #@1548 Open a network login connection to HOST via the `rlogin' program. Input is sent line-at-a-time to the remote connection. Communication with the remote host is recorded in a buffer `*rlogin-HOST*' (or `*rlogin-USER@HOST*' if the remote username differs). If a prefix argument is given and the buffer `*rlogin-HOST*' already exists, a new buffer with a different connection will be made. When called from a program, if the optional second argument is a string or buffer, it names the buffer to use. The variable `rlogin-program' contains the name of the actual program to run. It can be a relative or absolute path. The variable `rlogin-explicit-args' is a list of arguments to give to the rlogin when starting. They are added after any arguments given in INPUT-ARGS. If the default value of `rlogin-directory-tracking-mode' is t, then the default directory in that buffer is set to a remote (FTP) file name to access your home directory on the remote machine. Occasionally this causes an error, if you cannot access the home directory on that machine. This error is harmless as long as you don't try to use that default directory. If `rlogin-directory-tracking-mode' is neither t nor nil, then the default directory is initially set up to your (local) home directory. This is useful if the remote machine and your local machine share the same files via NFS. This is the default. If you wish to change directory tracking styles during a session, use the function `rlogin-directory-tracking-mode' rather than simply setting the variable. (defalias 'rlogin #[(input-args &optional buffer) "\nƒÃÄ !\n\"‚Ä !‰@ÈA@†#É ‰\nÉ ˜ƒ4ËÌ\"‚;ËÍ\n#σz;ƒR‚zÒ!ƒbÎ!‚z§ƒtËÓ#‚zÔ!Õ!Ö!ˆ×!†ãØÏ%ˆÚ!Û!dÏ“ˆÜ ˆÝÞß\"ˆàá!ˆ!àâ!ˆ\n\"#ä=ƒ×å\"æ!ç°(é(!‚ã#?†ãé(êP!.‡" [rlogin-process-connection-type process-connection-type rlogin-explicit-args append rlogin-parse-words input-args args host "-l" user-login-name user format "*rlogin-%s*" "*rlogin-%s@%s*" buffer-name nil proc buffer bufferp "%s<%d>" generate-new-buffer-name get-buffer-create pop-to-buffer comint-check-proc comint-exec rlogin-program get-buffer-process process-mark rlogin-mode add-hook comint-output-filter-functions rlogin-carriage-filter make-local-variable rlogin-host rlogin-remote-user rlogin-directory-tracking-mode t "/" "@" ":" comint-file-name-prefix cd-absolute "~/"] 7 (#$ . 2786) (list (read-from-minibuffer "rlogin arguments (hostname first): " nil nil nil (quote rlogin-history)) current-prefix-arg)]) #@75 Set major-mode for rlogin sessions. If `rlogin-mode-hook' is set, run it. (defalias 'rlogin-mode #[nil "À ˆÁ ˆÂÄÆ!ˆ ÊË!ˆÌÍ!‡" [kill-all-local-variables shell-mode rlogin-mode major-mode "rlogin" mode-name use-local-map rlogin-mode-map rlogin-directory-tracking-mode shell-dirtrackp make-local-variable comint-file-name-prefix run-hooks rlogin-mode-hook] 2 (#$ . 5350) nil]) #@673 Do remote or local directory tracking, or disable entirely. If called with no prefix argument or a unspecified prefix argument (just ``\[universal-argument]'' with no number) do remote directory tracking via ange-ftp. If called as a function, give it no argument. If called with a negative prefix argument, disable directory tracking entirely. If called with a positive, numeric prefix argument, e.g. ``\[universal-argument] 1 M-x rlogin-directory-tracking-mode'', then do directory tracking but assume the remote filesystem is the same as the local system. This only works in general if the remote machine and the local one share the same directories (through NFS). (defalias 'rlogin-directory-tracking-mode #[(&optional prefix) "ƒ :ƒÁÁÄ ÆÈ° ‚.ÊWƒ'ËË‚.ÌÍ Á …`Îp!Ð!‰d{`‰Y…PdZÕŽd|ˆdbˆÖ .‡" [prefix t rlogin-directory-tracking-mode shell-dirtrackp "/" rlogin-remote-user "@" rlogin-host ":" comint-file-name-prefix 0 nil local "" get-buffer-process proc process-mark proc-mark current-input orig-point offset ((byte-code "bˆ cˆ\nƒd\nZbˆ‚ bˆÄ‡" [proc-mark current-input offset orig-point nil] 2)) shell-resync-dirs] 6 (#$ . 5738) "P"]) (defalias 'rlogin-parse-words #[(line) "ÀÁ ÅÆ #ƒ Á”Á•O\fBÁ•‚È !ˆ\fŸ+‡" [nil 0 match-data posn list string-match "[^ \n]+" line store-match-data] 4]) (defalias 'rlogin-carriage-filter #[(string) "À ÁÂp!!ÄÅ!ƒ † GZ‰bˆÈÉ Ê#ƒ,ËÌ!ˆ‚b+‡" [point-marker process-mark get-buffer-process end boundp comint-last-output-start string beg search-forward " " t delete-char -1] 5]) (defalias 'rlogin-send-Ctrl-C #[nil "ÀÁÂ\"‡" [send-string nil ""] 3 nil nil]) (defalias 'rlogin-send-Ctrl-D #[nil "ÀÁÂ\"‡" [send-string nil ""] 3 nil nil]) (defalias 'rlogin-send-Ctrl-Z #[nil "ÀÁÂ\"‡" [send-string nil ""] 3 nil nil]) (defalias 'rlogin-send-Ctrl-backslash #[nil "ÀÁÂ\"‡" [send-string nil ""] 3 nil nil]) #@78 Delete ARG characters forward, or send a C-d to process if at end of buffer. (defalias 'rlogin-delchar-or-send-Ctrl-D #[(arg) "mƒÀ ‡Á\n!‡" [rlogin-send-Ctrl-D delete-char arg] 2 (#$ . 7646) "p"]) #@69 Complete file name if doing directory tracking, or just insert TAB. (defalias 'rlogin-tab-or-complete #[nil "ƒÁ ‡Âc‡" [rlogin-directory-tracking-mode comint-dynamic-complete " "] 1 (#$ . 7850) nil]) emacs-19.30/lisp/rmail.elc100666 12120 1 154621 6054601336 13722 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 22 05:59:33 1995 ;;; from file /home/fsf/rms/e19/lisp/rmail.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`rmail.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!„ÂÄ!ƒÅÃÄ\"ˆÀ‡" [require mail-utils fboundp buffer-disable-undo buffer-flush-undo defalias] 3) #@52 If non-nil, name of program for fetching new mail. (defvar rmail-movemail-program nil (#$ . 585)) #@108 *A regexp specifying names to prune of reply to messages. A value of nil means exclude your own name only. (defvar rmail-dont-reply-to-names nil (#$ . -690)) #@313 A regular expression specifying part of the value of the default value of the variable `rmail-dont-reply-to-names', for when the user does not set `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-default-dont-reply-to-names "info-" (#$ . 855)) #@65 *Regexp to match Header fields that Rmail should normally hide. (defvar rmail-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:\\|^\\(resent-\\|\\)message-id:\\|^summary-line:" (#$ . -1235)) #@142 *Regexp to match Header fields that Rmail should display. If nil, display all header fields except those matched by `rmail-ignored-headers'. (defvar rmail-displayed-headers nil (#$ . -1559)) #@66 *Headers that should be stripped when retrying a failed message. (defvar rmail-retry-ignored-headers nil (#$ . -1756)) #@141 *Regexp to match Header fields that Rmail should normally highlight. A value of nil means don't highlight. See also `rmail-highlight-face'. (defvar rmail-highlighted-headers "^From:\\|^Subject:" (#$ . -1882)) #@47 *Face used by Rmail for highlighting headers. (defvar rmail-highlight-face nil (#$ . -2097)) #@73 *Non-nil means automatically delete a message that is copied to a file. (defvar rmail-delete-after-output nil (#$ . -2196)) #@248 *List of files which are inboxes for user's primary mail file `~/RMAIL'. `nil' means the default, which is ("/usr/spool/mail/$USER") (the name varies depending on the operating system, and the value of the environment variable MAIL overrides it). (defvar rmail-primary-inbox-list nil (#$ . -2327)) #@69 *Non-nil means Rmail makes a new frame for composing outgoing mail. (defvar rmail-mail-new-frame nil (#$ . -2631)) #@50 *Directory for additional secondary Rmail files. (defvar rmail-secondary-file-directory "~/" (#$ . -2752)) #@52 *Regexp for which files are secondary Rmail files. (defvar rmail-secondary-file-regexp "\\.xmail$" (#$ . -2865)) #@50 List of functions to call when Rmail is invoked. (defvar rmail-mode-hook nil (#$ . 2984)) #@62 List of functions to call when Rmail has retrieved new mail. (defvar rmail-get-new-mail-hook nil (#$ . 3080)) #@58 List of functions to call when Rmail displays a message. (defvar rmail-show-message-hook nil (#$ . 3196)) #@174 List of functions to call when Rmail deletes a message. When the hooks are called, the message has been marked deleted but is still the current message in the Rmail buffer. (defvar rmail-delete-message-hook nil (#$ . 3309)) #@45 Regexp marking the start of an mmdf message (defvar mmdf-delim1 "^\n" (#$ . 3539)) #@43 Regexp marking the end of an mmdf message (defvar mmdf-delim2 "^\n" (#$ . 3632)) #@121 If non nil, a filter function for new messages in RMAIL. Called with region narrowed to the message, including headers. (defvar rmail-message-filter nil (#$ . 3724)) #@63 String to prepend to Subject line when replying to a message. (defvar rmail-reply-prefix "Re: " (#$ . 3896)) #@73 Regexp to delete from Subject line before inserting rmail-reply-prefix. (defvar rmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\^[0-9]+\\)?: *\\)*" (#$ . 4011)) #@53 If non nil, the summary buffer is always displayed. (defvar rmail-display-summary nil (#$ . 4174)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ BÀÈ!„GÂÈ BÀÉ!„TÂ É BÀÊ!„aÂ\nÊ B‡" [boundp rmail-mode-map nil current-load-list rmail-inbox-list rmail-keywords rmail-current-message rmail-total-messages rmail-message-vector rmail-deleted-vector rmail-overlay-list] 2) #@52 Additional expressions to highlight in Rmail mode. (defvar rmail-font-lock-keywords (quote (("^\\(From\\|Sender\\):" . font-lock-function-name-face) ("^Reply-To:.*$" . font-lock-function-name-face) ("^Subject:" . font-lock-comment-face) ("^\\(To\\|Apparently-To\\|Cc\\):" . font-lock-keyword-face) ("^[ ]*\\([A-Za-z]+[A-Za-z0-9_.@-]*\\)?[>|}].*" . font-lock-reference-face) ("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\|Date\\):.*$" . font-lock-string-face))) (#$ . 4582)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ B‡" [boundp rmail-summary-buffer nil current-load-list rmail-summary-vector rmail-last-label rmail-last-multi-labels rmail-last-regexp] 2) #@41 *Default file name for \[rmail-output]. (defvar rmail-default-file "~/xmail" (#$ . -5267)) #@55 *Default file name for \[rmail-output-to-rmail-file]. (defvar rmail-default-rmail-file "~/XMAIL" (#$ . -5364)) (byte-code "ÀÁ!„\"ÂÃÄÅRÇÈÉÊËÌÍÎÏÐÑÒÓ°)ÁBÀ‡" [boundp rmail-unix-mail-delimiter "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" "\\|[-+]?[0-9][0-9][0-9][0-9]" "\\|" "\\) *" time-zone-regexp "From " "\\(" "[^ \n]*" "\\(\\|\".*\"[^ \n]*\\)" "\\|<[^<>\n]+>" "\\) ?" "\\([^ \n]*\\) *" "\\([^ ]*\\) *" "\\([0-9]*\\) *" "\\([0-9:]*\\) *" " [0-9][0-9]\\([0-9]*\\) *" "\\(remote from .*\\)?" "\n" current-load-list] 15) (defalias 'rmail-select-summary '(macro . #[(&rest body) "ÀÁÂÃÀÄÅÆÇÈÀÉ\nBBEËBBDEÅÌÀÍ\nBBEFÎBBB‡" [let ((total rmail-total-messages)) if (rmail-summary-displayed) ((window (selected-window))) save-excursion unwind-protect progn (pop-to-buffer rmail-summary-buffer) ((rmail-total-messages total)) body ((select-window window)) (set-buffer rmail-summary-buffer) ((rmail-total-messages total)) ((rmail-maybe-display-summary))] 13])) #@538 Read and edit incoming mail. Moves messages into file named by `rmail-file-name' (a babyl format file) and edits that file in RMAIL Mode. Type \[describe-mode] once editing that file, for a list of RMAIL commands. May be called with file name as argument; then performs rmail editing on that file, but does not copy any new mail into the file. Interactively, if you supply a prefix argument, then you have a chance to specify a file name with the minibuffer. If `rmail-display-summary' is non-nil, make a summary for this RMAIL file. (defalias 'rmail #[(&optional file-name-arg) "À †\n!Ä !‰ƒ4Æ !„4ÇÉ !ˆ)Æ !ƒ<\nË=ƒ<Ì ˆÍ ˆ‚<ÇÉ !ˆ)\nÎ=ƒGÏÐ!ˆ ƒ_Ñ ÒVƒ_\nË=„sÓ ˆ‚sÓ ˆÔ ˆdbˆ„sÍ ˆÖ ˆ „|× „ÖØ !ˆƒ‰Ú ˆÛ *‡" [expand-file-name file-name-arg rmail-file-name file-name get-file-buffer existed verify-visited-file-modtime nil enable-local-variables find-file major-mode rmail-mode rmail-forget-messages rmail-set-message-counters rmail-edit-mode error "Exit Rmail Edit mode before getting new mail." buffer-size 0 rmail-mode-2 rmail-convert-file rmail-inbox-list rmail-show-message rmail-get-new-mail rmail-first-unseen-message rmail-display-summary rmail-summary rmail-construct-io-menu] 3 (#$ . 6328) (byte-code "… ÁÂÉÄ$C‡" [current-prefix-arg read-file-name "Run rmail on RMAIL file: " nil t] 5)]) (defalias 'rmail-convert-file #[nil "À~ˆebˆÂÃ!„-ÂÄ!ƒÀÆcˆ)‚-edšƒ(Ç ˆ‚-ÈÇ ˆ „CŠdbˆÉÊ!ˆËuˆÂÌ!)…]ÀÍÎ!ˆebˆÏÊÀÈ#ˆ`d}ˆÐ ˆÍÑ!))‡" [nil convert looking-at "BABYL OPTIONS:" "Version: 5\n" buffer-read-only "BABYL OPTIONS: -*- rmail -*-\n" rmail-insert-rmail-file-header t search-backward "\n" 2 "\n*From " message "Converting to Babyl format..." search-forward rmail-convert-to-babyl-format "Converting to Babyl format...done"] 4]) (defalias 'rmail-insert-rmail-file-header #[nil "ÀÂc)‡" [nil buffer-read-only "BABYL OPTIONS: -*- rmail -*-\nVersion: 5\nLabels:\nNote: This is the header of an rmail file.\nNote: If you are seeing it in rmail,\nNote: it means the file has no messages in it.\n"] 1]) (byte-code "„‹Á Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÃÐÑ#ˆÃÒÓ#ˆÃÔÕ#ˆÃÖ×#ˆÃØÙ#ˆÃÚÛ#ˆÃÜÝ#ˆÃÞÕ#ˆÃßÝ#ˆÃàá#ˆÃâã#ˆÃäå#ˆÃæç#ˆÃèé#ˆÃêë#ˆÃìí#ˆÃîï#ˆÃðñ#ˆÃòó#ˆÃôõ#ˆÃö÷#ˆÃøù#ˆÃúû#ˆÃüý#ˆÃþÿ#ˆÃ@A#ˆÃBC#ˆÃDE#ˆÃFÏ#ˆÃGH#ˆÃIJ#ˆÃKL#ˆÃMN#ˆÃOP#ˆÃQR#ˆÃST#ˆÃUV#ˆÃWX#ˆÃYZ#ˆÃ[\\#ˆÃ]^#ˆÃ_`#ˆÃab#ˆÃcd#ˆÃef#ˆÃgh #ˆÃijhj!B#ˆÃkl#ˆÃml#ˆÃno#ˆÃpq#ˆÃrs#ˆÃtu#ˆÃvwhw!B#ˆÃxy#ˆÃz{#ˆÃ|}#ˆÃ~#ˆÃ€#ˆÃ‚ƒ#ˆÃ„…h…!B#ˆÃ†‡#ˆÃˆ‰#ˆÃŠ‹#ˆÃŒ#ˆÃŽ#ˆÃ‘#ˆÃ’“#ˆÃ”•#ˆÃ–—h—!B#ˆÃ˜™#ˆÃš›#ˆÃœ#ˆÃžŸ#ˆÃ ¡h¡!B#ˆÃ¢£#ˆÃ¤¥#ˆÃ¦§#ˆÃ¨©#ˆÃª«#ˆÃ¬­#ˆÃ®¯#ˆÃ°±#ˆ²³´µ#‡" [rmail-mode-map make-keymap suppress-keymap define-key "a" rmail-add-label "b" rmail-bury "c" rmail-continue "d" rmail-delete-forward "" rmail-delete-backward "e" rmail-edit-current-message "f" rmail-forward "g" rmail-get-new-mail "h" rmail-summary "i" rmail-input "j" rmail-show-message "k" rmail-kill-label "l" rmail-summary-by-labels "" "\f" "" rmail-summary-by-recipients "" rmail-summary-by-regexp "" rmail-summary-by-topic "m" rmail-mail "m" rmail-retry-failure "n" rmail-next-undeleted-message "n" rmail-next-message "" rmail-next-labeled-message "o" rmail-output-to-rmail-file "" rmail-output "p" rmail-previous-undeleted-message "p" rmail-previous-message "" rmail-previous-labeled-message "q" rmail-quit "r" rmail-reply "s" rmail-expunge-and-save "s" rmail-search "t" rmail-toggle-header "u" rmail-undelete-previous-message "w" "x" rmail-expunge "." rmail-beginning-of-message "<" rmail-first-message ">" rmail-last-message " " scroll-up "" scroll-down "?" describe-mode "" rmail-sort-by-date "" rmail-sort-by-subject "" rmail-sort-by-author "" rmail-sort-by-recipient "" rmail-sort-by-correspondent "\f" rmail-sort-by-lines " " rmail-sort-by-keywords "" rmail-next-same-subject "" rmail-previous-same-subject [menu-bar] make-sparse-keymap [menu-bar classify] "Classify" [menu-bar classify input-menu] nil [menu-bar classify output-menu] [menu-bar classify output-inbox] ("Output (inbox)..." . rmail-output) [menu-bar classify output] ("Output (Rmail)..." . rmail-output-to-rmail-file) [menu-bar classify kill-label] ("Kill Label..." . rmail-kill-label) [menu-bar classify add-label] ("Add Label..." . rmail-add-label) [menu-bar summary] "Summary" [menu-bar summary senders] ("By Senders..." . rmail-summary-by-senders) [menu-bar summary labels] ("By Labels..." . rmail-summary-by-labels) [menu-bar summary recipients] ("By Recipients..." . rmail-summary-by-recipients) [menu-bar summary topic] ("By Topic..." . rmail-summary-by-topic) [menu-bar summary regexp] ("By Regexp..." . rmail-summary-by-regexp) [menu-bar summary all] ("All" . rmail-summary) [menu-bar mail] "Mail" [menu-bar mail rmail-get-new-mail] ("Get New Mail" . rmail-get-new-mail) [menu-bar mail lambda] ("----") [menu-bar mail continue] ("Continue" . rmail-continue) [menu-bar mail resend] ("Re-send..." . rmail-resend) [menu-bar mail forward] ("Forward" . rmail-forward) [menu-bar mail retry] ("Retry" . rmail-retry-failure) [menu-bar mail reply] ("Reply" . rmail-reply) [menu-bar mail mail] ("Mail" . rmail-mail) [menu-bar delete] "Delete" [menu-bar delete expunge/save] ("Expunge/Save" . rmail-expunge-and-save) [menu-bar delete expunge] ("Expunge" . rmail-expunge) [menu-bar delete undelete] ("Undelete" . rmail-undelete-previous-message) [menu-bar delete delete] ("Delete" . rmail-delete-forward) [menu-bar move] "Move" [menu-bar move search-back] ("Search Back..." . rmail-search-backwards) [menu-bar move search] ("Search..." . rmail-search) [menu-bar move previous] ("Previous Nondeleted" . rmail-previous-undeleted-message) [menu-bar move next] ("Next Nondeleted" . rmail-next-undeleted-message) [menu-bar move last] ("Last" . rmail-last-message) [menu-bar move first] ("First" . rmail-first-message) [menu-bar move previous] ("Previous" . rmail-previous-message) [menu-bar move next] ("Next" . rmail-next-message) put rmail-mode mode-class special] 6) (defalias 'rmail-mode-kill-summary #[nil "…Á!‡" [rmail-summary-buffer kill-buffer] 2]) #@3136 Rmail Mode is used by \\[rmail] for editing Rmail files. All normal editing commands are turned off. Instead, these commands are available: \[rmail-beginning-of-message] Move point to front of this message (same as \[beginning-of-buffer]). \[scroll-up] Scroll to next screen of this message. \[scroll-down] Scroll to previous screen of this message. \[rmail-next-undeleted-message] Move to Next non-deleted message. \[rmail-previous-undeleted-message] Move to Previous non-deleted message. \[rmail-next-message] Move to Next message whether deleted or not. \[rmail-previous-message] Move to Previous message whether deleted or not. \[rmail-first-message] Move to the first message in Rmail file. \[rmail-last-message] Move to the last message in Rmail file. \[rmail-show-message] Jump to message specified by numeric position in file. \[rmail-search] Search for string and show message it is found in. \[rmail-delete-forward] Delete this message, move to next nondeleted. \[rmail-delete-backward] Delete this message, move to previous nondeleted. \[rmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages till a deleted message is found. \[rmail-edit-current-message] Edit the current message. \[rmail-cease-edit] to return to Rmail. \[rmail-expunge] Expunge deleted messages. \[rmail-expunge-and-save] Expunge and save the file. \[rmail-quit] Quit Rmail: expunge, save, then switch to another buffer. \[save-buffer] Save without expunging. \[rmail-get-new-mail] Move new mail from system spool directory into this file. \[rmail-mail] Mail a message (same as \[mail-other-window]). \[rmail-continue] Continue composing outgoing message started before. \[rmail-reply] Reply to this message. Like \[rmail-mail] but initializes some fields. \[rmail-retry-failure] Send this message again. Used on a mailer failure message. \[rmail-forward] Forward this message to another user. \[rmail-output-to-rmail-file] Output this message to an Rmail file (append it). \[rmail-output] Output this message to a Unix-format mail file (append it). \[rmail-input] Input Rmail file. Run Rmail on that file. \[rmail-add-label] Add label to message. It will be displayed in the mode line. \[rmail-kill-label] Kill label. Remove a label from current message. \[rmail-next-labeled-message] Move to Next message with specified label (label defaults to last one specified). Standard labels: filed, unseen, answered, forwarded, deleted. Any other label is present only if you add it with \[rmail-add-label]. \[rmail-previous-labeled-message] Move to Previous message with specified label \[rmail-summary] Show headers buffer, with a one line summary of each message. \[rmail-summary-by-labels] Summarize only messages with particular label(s). \[rmail-summary-by-recipients] Summarize only messages with particular recipient(s). \[rmail-summary-by-regexp] Summarize only messages with particular regexp(s). \[rmail-summary-by-topic] Summarize only messages with subject line regexp(s). \[rmail-toggle-header] Toggle display of complete header. (defalias 'rmail-mode #[nil "À ˆÁ ˆÂ !‡" [rmail-mode-2 rmail-set-message-counters rmail-show-message rmail-total-messages] 2 (#$ . 12687) nil]) (defalias 'rmail-mode-2 #[nil "À ˆÁ ˆÂ ˆÃÄ!‡" [kill-all-local-variables rmail-mode-1 rmail-variables run-hooks rmail-mode-hook] 2]) (defalias 'rmail-mode-1 #[nil "ÀÂÄÆÈÉ!ƒÊ ‚ÊËÌ!AB\fÍ!ˆÏ!ˆ‰‡" [rmail-mode major-mode "RMAIL" mode-name t buffer-read-only nil buffer-auto-save-file-name boundp mode-line-modified "--- " default-value mode-line-format use-local-map rmail-mode-map set-syntax-table text-mode-syntax-table text-mode-abbrev-table local-abbrev-table] 3]) (defalias 'rmail-variables #[nil "ÀÁ!ˆÂÀÃ!ˆÄÀÅ!ˆÀÆ!ˆÀÇ!ˆÀÈ!ˆÀÉ!ˆÀÊ!ˆÀË!ˆÀÌ!ˆÍ\fÀÎ!ˆÍÀÏ!ˆÐÀÑ!ˆÒÑÓ\"ˆÀÔ!ˆÕÀÖ!ˆÀ×!ˆØ ‰„†Ú!š„sÝÞ!!šƒ††„àá!†ƒ\"ã PCÀä!ˆÍ‰$‡" [make-local-variable revert-buffer-function rmail-revert font-lock-defaults (rmail-font-lock-keywords t) rmail-last-label rmail-last-regexp rmail-deleted-vector rmail-summary-buffer rmail-summary-vector rmail-current-message rmail-total-messages require-final-newline nil rmail-overlay-list version-control never kill-buffer-hook add-hook rmail-mode-kill-summary file-precious-flag t rmail-message-vector rmail-inbox-list rmail-parse-file-inboxes buffer-file-name expand-file-name rmail-file-name buffer-file-truename abbreviate-file-name file-truename rmail-primary-inbox-list getenv "MAIL" rmail-spool-directory user-login-name rmail-keywords] 5]) (defalias 'rmail-revert #[(arg noconfirm) "ÀÁ! \f\"…Å ˆdbˆÆ )‡" [default-value revert-buffer-function revert-buffer arg noconfirm rmail-convert-file rmail-mode] 3]) (defalias 'rmail-parse-file-inboxes #[nil "ŠŒ~ˆÀbˆÁÂ!….ÃÄÅÆ#ˆÀ`}ˆÀbˆÃÇÅÈ#….`ň`}ˆebˆÉ *‡" [1 looking-at "BABYL OPTIONS:" search-forward "\n" nil move "\nMail:" t mail-parse-comma-list] 4]) #@30 Expunge and save RMAIL file. (defalias 'rmail-expunge-and-save #[nil "À ˆÁ ˆÂ …7 Å ƒ(Æ ŠÈŽÉ\n!ˆ\fËÌ!ˆ,‚4Š\nqˆ\fËÌ!ˆ*Í )‡" [rmail-expunge save-buffer rmail-summary-exists rmail-total-messages total rmail-summary-displayed selected-window window ((select-window window)) pop-to-buffer rmail-summary-buffer set-buffer-modified-p nil rmail-maybe-display-summary] 2 (#$ . 17648) nil]) #@20 Quit out of RMAIL. (defalias 'rmail-quit #[nil "À ˆ ƒ !ˆÃ !ˆpÂ\f!ˆÃ\f!)‡" [rmail-expunge-and-save rmail-summary-buffer replace-buffer-in-windows bury-buffer obuf] 2 (#$ . 18044) nil]) #@51 Bury current Rmail buffer and its summary buffer. (defalias 'rmail-bury #[nil "pÁ ƒ ÂÄ !‰ƒÆ Ç !\"ˆ‚ È !ˆ)ÉÇp!!ˆÈ!)‡" [buffer-to-bury rmail-summary-exists nil window get-buffer-window rmail-summary-buffer set-window-buffer other-buffer bury-buffer switch-to-buffer] 4 (#$ . 18238) nil]) #@124 Create a duplicated copy of the current message. The duplicate copy goes into the Rmail file just after the original copy. (defalias 'rmail-duplicate-message #[nil "~ˆÀ  !à !{à !bˆ\fcˆÇ ˆÈ !ˆÉÊ!+‡" [nil rmail-current-message rmail-msgbeg rmail-msgend string number buffer-read-only rmail-forget-messages rmail-show-message message "Message duplicated"] 5 (#$ . 18539) nil]) #@29 Run Rmail on file FILENAME. (defalias 'rmail-input #[(filename) "À !‡" [rmail filename] 2 (#$ . 18924) "FRun rmail on RMAIL file: "]) (defalias 'rmail-find-all-files #[(start) "À !ƒ6 Ã\fÃ$ʼnƒ/@AÉ!¤‚ÊË\"+‡Å\fÍ\f \"…DÎ !C)‡" [file-accessible-directory-p start directory-files t rmail-secondary-file-regexp nil file ret files rmail-find-all-files sort string< case-fold-search string-match file-name-nondirectory] 5]) (defalias 'rmail-list-to-menu #[(menu-name l action &optional full-name) "À !ÃÄÅ!\"ˆ\n)‡" [make-sparse-keymap menu-name menu mapcar #[(item) "À\n:ƒ$Ã\n@\nA\f ƒ Æ\n@Q‚\n@$\n@‚>\nÈÀÉ\fÊ ƒ7 Æ\nQ‚8\n \"DFÌ ÎÏ!! B#)‡" [nil command item rmail-list-to-menu action full-name "/" name lambda (interactive) expand-file-name rmail-secondary-file-directory define-key menu vector intern] 8] reverse l] 4]) (put (quote rmail-disable-menu) (quote menu-enable) (quote (quote nil))) (defalias 'rmail-construct-io-menu #[nil "À !‰ƒ\"Ã\fÅÆÇÆ\nÈ#B#ˆÃ\fÉÊÇÊ\nË#B#‚-Ã\fÌÍ#ˆÃ\fÎÏ#)‡" [rmail-find-all-files rmail-secondary-file-directory files define-key rmail-mode-map [menu-bar classify input-menu] "Input Rmail File" rmail-list-to-menu rmail-input [menu-bar classify output-menu] "Output Rmail File" rmail-output-to-rmail-file [menu-bar classify input-menu] ("Input Rmail File" . rmail-disable-menu) [menu-bar classify output-menu] ("Output Rmail File" . rmail-disable-menu)] 9]) #@684 Move any new mail from this RMAIL file's inbox files. The inbox files can be specified with the file's Mail: option. The variable `rmail-primary-inbox-list' specifies the inboxes for your primary RMAIL file if it has no Mail: option. By default, this is your /usr/spool/mail/$USER. You can also specify the file to get new mail from. In this case, the file of new mail is not changed or deleted. Noninteractively, you can pass the inbox file name as an argument. Interactively, a prefix argument causes us to read a file name and use that file as the inbox. This function runs `rmail-get-new-mail-hook' before saving the updated file. It returns t if it got any new messages. (defalias 'rmail-get-new-mail #[(&optional file-name) "Àp!„ Á !ˆÃ ˆ~ˆ\fÅ=„ÆÇŽ`ÈÆ …$Ê ÆÅ  \f dbˆÏÆxˆ`d|ˆŠŒ``}ˆƒQÑCÆ\"ˆ‚XÑÅ\"\febˆŠÓ  )Ô !„†Æ~ˆÖ×ÆÅ#ˆ`d}ˆeTbˆØ ˆÙÚ!ˆÛ ˆ)\fƒ™ÆÜ݈\fA‰\f„‹* ÈUƒ·bˆ„¯ƒ³Þß!ˆÆ‚à ƒí!\"ã ƒÜä %ŠæŽç(!ˆ\"!é ˆ,‚éŠ(qˆ\"!é ˆ*ê ˆ)Þë ‰ìUƒûí‚üî#ˆïð !ˆñò!ó=ƒô5í\"ˆÅ.‡" [verify-visited-file-modtime find-file buffer-file-name rmail-maybe-set-message-counters buffer-undo-list t nil ((rmail-show-message)) 0 make-backup-files buffer-modified-p buffer-read-only delete-files new-messages opoint " \n" file-name rmail-insert-inbox-text rmail-inbox-list rmail-convert-to-babyl-format zerop success search-backward "\n" rmail-count-new-messages run-hooks rmail-get-new-mail-hook save-buffer (byte-code "ÀÁ‡" [nil (byte-code "À @!‡" [delete-file delete-files] 2) ((file-error (byte-code "À`` @#‡" [write-region delete-files] 4)))] 3) ((file-error)) message "(No new mail has arrived)" rmail-summary-exists rmail-total-messages total rmail-summary-displayed selected-window window ((select-window window)) pop-to-buffer rmail-summary-buffer rmail-update-summary rmail-maybe-display-summary "%d new message%s read" 1 "" "s" rmail-show-message rmail-first-unseen-message process-status "display-time" run display-time-filter display-time-process] 7 (#$ . 20364) (list (if current-prefix-arg (read-file-name "Get new mail from file: ")))]) (defalias 'rmail-insert-inbox-text #[(files renamep) "À‰‰‰‰ƒJÇÈÉ@!!!ÈÊË !PÌÈ !!\"ÎÏÐË !\"‰ƒ;Ë !Î\nƒKÒ !ƒKÈÓ \" ƒVÔÕ!ˆ‚ƒÖ\f!ƒn×Ø\f!8ÙU„nÔÚ\f\"ˆ‚ƒÖ !ƒƒ×Ø !8ÙU„ƒÔÚ \"ˆ„ ‚Ö\f!„ „Ö !ƒ\n„² „²ÀÛ܈ÀÝÞˆ‚ÀàŽŠáâ!ã!ˆä%†ÍÈæ'\"ÀÀ \f&ˆè!ƒqˆéedêë$ˆdbˆìÀxˆ`d|ˆebˆíî!ƒeÙ•|ˆïÎ!ˆÔîed{P!ˆðñ!ˆ+Ö\f!ƒ=À2dbˆó\f!A@2dbˆhêU„8ô2!„8êcˆ\f B)Ôõ!ˆA‰„ -‡" [nil popmail movemail delete-files tofile file files file-truename expand-file-name substitute-in-file-name ".newmail-" file-name-nondirectory file-name-directory buffer-file-name t string-match "^po:" renamep file-directory-p user-login-name message "Getting mail from post office ..." file-exists-p 7 file-attributes 0 "Getting mail from %s..." (copy-file file tofile nil) ((error (rename-file file tofile t))) (byte-code "À`` #‡" [write-region file] 4) ((file-error)) errors ((byte-code "ƒÁ!ˆÁ‡" [errors kill-buffer] 2)) generate-new-buffer " *rmail loss*" buffer-disable-undo call-process rmail-movemail-program "movemail" exec-directory buffer-modified-p subst-char-in-region 10 32 " " looking-at "movemail: " beep sit-for 3 size insert-file-contents zerop ""] 8]) (defalias 'rmail-convert-to-babyl-format #[nil "ÀÁ‰ÂebˆŒm„—ÇÈ!ƒ0ÉÊÁË#ƒ&e`|ˆ‚ ˆe`|ˆ‚ ÇÌ!ƒWÉÊÁË#„A ˆT`ŠÍÁwˆ`)|ˆ`d}ˆ‚ ËÇ!)ƒ›ËÏÐ!ˆ`ÑÁË#ˆÏÓ!ˆ)ŠŒ `S}ˆebˆÉÊÁË#ƒŽÏÔ!ˆ‚*`d}ˆT‚ ÇÕ!ƒ…`ÐcˆÖ ˆŠÑ×ÁË#…´`S)ËŠÙuˆÉÚË#…×`Áˆ`Ý{!*)‰ƒ@ß!ƒ6\\dXƒ6Š\\bˆàÁwˆm†(ÇÈ!ƒ ÉÊÁË#†(ÇÌ!ƒÉÊÁË#†(ËÇ!)†(Çá!)ƒ6\\bˆ‚@âã!ˆäåÀË#ˆ+Ñæ'èèéê°ÁË#ƒZå”bˆ‚]dbˆTŠŒ `}ˆebˆÉÊÁË#ƒzÏÔ!ˆ‚k*ëcˆ`d}ˆ‚ lƒìå!ˆ‚ íî!ˆ‚ ),‡" [0 nil #[nil "ÀÁ!ˆÂÃ!ˆÄ ÆPÇÈ#ƒÉyˆÇ‡db‡" [message "Invalid Babyl format in inbox!" sit-for 1 re-search-forward mmdf-delim1 "\\|^From" nil t 0] 4] invalid-input-resync case-fold-search start count looking-at "BABYL OPTIONS:" search-forward "\n" t "\f" " \n" mmdf-delim1 replace-match "\f\n0, unseen,,\n*** EOOH ***\n" re-search-forward mmdf-delim2 "" "\n^_" "^From " rmail-nuke-pinhead-header "\n\n" header-end -1 "\ncontent-length: " eol beg string-to-int size natnump "\n" "From " message "Ignoring invalid Content-Length field" sit-for 1 "^[]?\\(" rmail-unix-mail-delimiter "\\|" "^BABYL OPTIONS:\\|" "\f\n[01],\\)" 31 delete-char error "Cannot convert to babyl format"] 9]) (defalias 'rmail-nuke-pinhead-header #[nil "ŠŒ`ÀÁˆ`À‰‰ }ˆÇbˆÉÊÀÇ#bˆÉËÀÇ#….`bˆ)ÀÌÍPÀÇ#…xÏÐ ƒLÑ‚lÒÓ”Ó•U„YÔ‚jÕ”Õ•U„iÕ”Õ•{‚jÖ×Q\fƒtÑ‚uØQÇ\".‡" [nil (search-forward "\n\n") ((error (byte-code "dbˆÀc‡" ["\n\n"] 1))) has-date has-from end start t case-fold-search search-forward "\nFrom:" "\nDate:" re-search-forward "^" rmail-unix-mail-delimiter replace-match "Mail-from: \\&" "" "Date: \\3, \\5 \\4 \\9 \\6 " 7 "\\7" 10 "EST" "\n" "From: \\1\n"] 6]) (defalias 'rmail-reformat-message #[(beg end) "bˆÁyˆgÂU„ÃÄ!ˆÅÆ Z ÊÁ!ˆËcˆÁyˆÌ ÎÏ!ƒ3Áyˆ‚')ÎÐ!ƒA`Áyˆ`|ˆ`ŠÑÒÓ#ˆ`){‰Õ±ˆ`Æ Z}ˆ)ebˆƒi ˆ„s…uÙ *‡" [beg 1 48 error "Bad format in RMAIL file." nil buffer-size end delta buffer-read-only delete-char 49 t case-fold-search looking-at "Summary-line:\\|Mail-From:" "\\*\\*\\* EOOH \\*\\*\\*\n" search-forward "\n\n" move str "*** EOOH ***\n" rmail-message-filter rmail-displayed-headers rmail-ignored-headers rmail-clear-headers] 6]) #@365 Delete all header fields that Rmail should not show. If the optional argument IGNORED-HEADERS is non-nil, delete all header fields whose names match that regexp. Otherwise, if `rmail-displayed-headers' is non-nil, delete all header fields *except* those whose names match that regexp. Otherwise, delete all header fields whose names match `rmail-ignored-headers'. (defalias 'rmail-clear-headers #[(&optional ignored-headers) "ÀÁÂÃ#…~\fƒP „PŒe`}ˆÂ‰ebˆŠÈÉ!ˆm?…-`S‰)ƒKŠÈ\fÃ#)ƒCbˆ‚`|ˆ‚*eb)‡ „W\nŒe`}ˆÂà ebˆÈ ÂÃ#)…}Ìyˆ`ÈÉ!ˆ`S|ˆ‚_*‡" [search-forward "\n\n" nil t rmail-displayed-headers ignored-headers lim buffer-read-only re-search-forward "\n[^ ]" rmail-ignored-headers case-fold-search 0] 4 (#$ . 25766)]) #@79 Show original message header if pruned header currently shown, or vice versa. (defalias 'rmail-toggle-header #[nil "À ˆÁ\n!d}ˆÃebˆÅyˆgÆUƒ]ÇÅ!ˆÈcˆÅyˆÉ\nËÌ!ƒ0Åyˆ‚$)ÍcˆÎuˆÏÐ!ˆÎyˆ`ÏÒÃÉ#ƒN`|ˆ)ebˆÏÐ!ˆ`d}ˆ‚bÓed\"ˆ)Ô ‡" [rmail-maybe-set-message-counters rmail-msgbeg rmail-current-message nil buffer-read-only 1 49 delete-char 48 t case-fold-search looking-at "Summary-Line:\\|Mail-From:" "*** EOOH ***\n" -1 search-forward "\n*** EOOH ***\n" temp "\n\n" rmail-reformat-message rmail-highlight-headers] 4 (#$ . 26507) nil]) (defalias 'rmail-display-labels #[nil "ÀÁ  ŠÆŽ~ˆÇ!bˆÉyˆÊË!ƒl`̈`}ˆÌ ebˆÎÏÌÐ#ƒAÊÑ!„)m„)Òcˆ‚))dbˆÓÔÌÕ#ƒl`eTVƒZeÉ\\`{d`ZÖVƒl ×`Ø\\dS{Q*ÙÚ \"ƒ„ Û‰”OÏ Û•ÌOQ‚mÙÜ \"ƒ› Û‰”OÏ Û•ÌOQ‚„ÝÞ $‰ +‡" ["" point-min-marker point-max-marker end beg blurb ((byte-code " }ˆ‰“ˆ ‰“‡" [beg end nil] 3)) rmail-msgbeg rmail-current-message 1 looking-at "[01]," nil buffer-read-only search-forward "," t "[ ,]" " " search-backward ",," move 2 ";" 3 string-match " +," 0 ", +" format " %d/%d%s" rmail-total-messages mode-line-process] 5]) (defalias 'rmail-set-attribute #[(attr state &optional msgnum) "À Á „ÈV…hÉŽŠ~ˆÊ!Ë\\bˆÌÍÏQ`ˆÐ#??‰??=„YƒL`È•S|ˆ‚YÈyˆÓuˆÔϱˆ)Õ˜…gÖ\"*+‡" [point-max-marker point-min-marker nil buffer-read-only omin omax msgnum rmail-current-message 0 ((byte-code " }ˆ‰“ˆ ‰“ˆ \fUƒÅ ˆÂ‡" [omin omax nil msgnum rmail-current-message rmail-display-labels] 3)) rmail-msgbeg 3 search-backward ", " attr "," t curstate state 2 " " "deleted" rmail-set-message-deleted-p] 5]) (defalias 'rmail-message-labels-p #[(msg labels) "ŠŒ~ˆÀ !bˆÂuˆÃ\f`ňÆ#*‡" [rmail-msgbeg msg 3 re-search-backward labels nil t] 4]) (defalias 'rmail-msgend #[(n) "À \nTH!‡" [marker-position rmail-message-vector n] 3]) (defalias 'rmail-msgbeg #[(n) "À \nH!‡" [marker-position rmail-message-vector n] 3]) #@343 Call FUNCTION with point at start of internal data of current message. Assumes that bounds were previously narrowed to display the message in Rmail. The bounds are widened enough to move point where desired, then narrowed again afterward. FUNCTION may not change the visible text of the message, but it may change the invisible header text. (defalias 'rmail-widen-to-current-msgbeg #[(function) "ŠdeZÁŽÂ !d}ˆebˆ\f +‡" [obeg ((byte-code "dZd}‡" [obeg] 2)) rmail-msgbeg rmail-current-message function] 2 (#$ . 28381)]) (defalias 'rmail-forget-messages #[nil "ÀŽÁ\n!…&Ã\n‰G\fW…% \fHlj“ˆ\fT‰‚+)‡" [((byte-code "ÀÀÀ‡" [nil rmail-message-vector rmail-deleted-vector] 1)) vectorp rmail-message-vector 0 i v n nil] 4]) (defalias 'rmail-maybe-set-message-counters #[nil "… … \n… ?…Ä ‡" [rmail-deleted-vector rmail-message-vector rmail-current-message rmail-total-messages rmail-set-message-counters] 1]) (defalias 'rmail-count-new-messages #[(&optional nomsg) "ÀÂÀÀ„ÇÈ!ˆdbˆÉÊ!ˆËuˆÌ CÍe!ˆT \\Ð\fA\"‰\f@Iˆ PÐÔ À\"\"ebˆ†YÇÕ \",‡" [nil case-fold-search 0 total-messages messages-head deleted-head nomsg message "Counting new messages..." search-backward "\n" 1 point-marker rmail-set-message-counters-counter rmail-total-messages rmail-current-message vconcat rmail-message-vector rmail-deleted-vector rmail-summary-vector make-vector "Counting new messages...done (%d)"] 6]) (defalias 'rmail-set-message-counters #[nil "À ˆŠŒ~ˆ`ÂÄÄÄÄÉÊ!ˆdbˆËÌÄÍ#ˆ`dU„,ÎuˆÏ CÐ` ^!ˆ Ð ˆ  Î Z]^ÓÔÕ B\"×PÙÄ\"ÉÛ!.‡" [rmail-forget-messages point-save 0 total-messages nil messages-after-point case-fold-search messages-head deleted-head message "Counting messages..." search-backward "\n" t 1 point-marker rmail-set-message-counters-counter rmail-total-messages rmail-current-message apply vector point-min-marker rmail-message-vector "D" rmail-deleted-vector make-vector rmail-summary-vector "Counting messages...done"] 4]) (defalias 'rmail-set-message-counters-counter #[(&optional stop) "ÀÁ\nÃ#…?ÄuˆÅ BŠÀÇ`ÈyˆÃ#ƒ\"É‚#Ê B )\fT‰\fͦÎUƒÏÐ\f\"ˆ‚‡" [search-backward "\n\f\n" stop t 1 point-marker messages-head ", deleted," 2 68 32 deleted-head total-messages 20 0 message "Counting messages...%d"] 4]) #@51 Show current message starting from the beginning. (defalias 'rmail-beginning-of-message #[nil "À !‡" [rmail-show-message rmail-current-message] 2 (#$ . 30661) nil]) #@148 Show message number N (prefix argument), counting from start of file. If summary buffer is currently displayed, update current message there also. (defalias 'rmail-show-message #[(&optional n no-summary) "À ˆ~ˆ ÂUƒedS}ˆebˆÃ‰‡Ã„%‚MÂXƒ7ÈÈÉ‚M VƒI  Ê‚MË!Ì! ‰bˆÈyˆgÏUƒtÐ \"ˆÑÒÃ\"ˆ‚€ÓÔ Õ#ˆ` }ˆebˆÖ ˆ× ˆƒšƒšÃÚÛ!ˆÚÜ!ˆÝ ƒâ„â  á ƒÎâ #ŠäŽå&!ˆ çÕ‰#ˆ,‚ÞŠ&qˆ çÕ‰#ˆ*è ˆ* …éé !+‡" [rmail-maybe-set-message-counters rmail-total-messages 0 nil mode-line-process blurb n rmail-current-message 1 "No previous message" "No following message" rmail-msgbeg rmail-msgend end beg 48 rmail-reformat-message rmail-set-attribute "unseen" search-forward "\n*** EOOH ***\n" t rmail-display-labels rmail-highlight-headers transient-mark-mode mark-active run-hooks deactivate-mark-hook rmail-show-message-hook rmail-summary-exists no-summary curr-msg total rmail-summary-displayed selected-window window ((select-window window)) pop-to-buffer rmail-summary-buffer rmail-summary-goto-msg rmail-maybe-display-summary message] 5 (#$ . 30833) "p"]) (defalias 'rmail-highlight-headers #[nil "ÀÁ!…\n…ŠÃÄÅÆ#ˆŒe`}ˆÇ‰†(ÉÊ!ƒ'Ê‚(Ë\f ebˆÑ\nÅÇ#…›ÒÅwˆ`ÅÕyˆÖ×!„GØuˆhÙƒ_Øuˆ‚S ƒ @ A ÚÎ#ˆÛ`#ˆ‚—Ü`\"ÚÎ#ˆ\fB\f*‚5.‡" [fboundp internal-find-face rmail-highlighted-headers search-forward "\n\n" nil move t rmail-highlight-face face-differs-from-default-p bold highlight rmail-overlay-list overlays face inhibit-read-only case-fold-search re-search-forward " " overlay beg 1 looking-at "[ ]" -1 (32 9) overlay-put move-overlay make-overlay] 4]) #@123 Show following message whether deleted or not. With prefix arg N, moves forward N messages, or backward if N is negative. (defalias 'rmail-next-message #[(n) "À ˆÁ\n \\!‡" [rmail-maybe-set-message-counters rmail-show-message rmail-current-message n] 3 (#$ . 32467) "p"]) #@122 Show previous message whether deleted or not. With prefix arg N, moves backward N messages, or forward if N is negative. (defalias 'rmail-previous-message #[(n) "À [!‡" [rmail-next-message n] 2 (#$ . 32745) "p"]) #@183 Show following non-deleted message. With prefix arg N, moves forward N non-deleted messages, or backward if N is negative. Returns t if a new message is being shown, nil otherwise. (defalias 'rmail-next-undeleted-message #[(n) "À ˆ ‰\fÅVƒ&\nWƒ&\nTÇ\n!„\n\fS‰‚\fÅWƒD\nÈVƒD\nSÇ\n!„&\n\fT‰‚' U„RÉ !ˆÊ‚g\fÅWƒ\\ËÌ!ˆ\fÅVƒfËÍ!ˆÎ*‡" [rmail-maybe-set-message-counters rmail-current-message current lastwin n 0 rmail-total-messages rmail-message-deleted-p 1 rmail-show-message t message "No previous nondeleted message" "No following nondeleted message" nil] 3 (#$ . 32965) "p"]) #@128 Show previous non-deleted message. With prefix argument N, moves backward N non-deleted messages, or forward if N is negative. (defalias 'rmail-previous-undeleted-message #[(n) "À [!‡" [rmail-next-undeleted-message n] 2 (#$ . 33568) "p"]) #@29 Show first message in file. (defalias 'rmail-first-message #[nil "À ˆÁÂ!‡" [rmail-maybe-set-message-counters rmail-show-message 1] 2 (#$ . 33813) nil]) #@28 Show last message in file. (defalias 'rmail-last-message #[nil "À ˆÁ\n!‡" [rmail-maybe-set-message-counters rmail-show-message rmail-total-messages] 2 (#$ . 33971) nil]) (defalias 'rmail-what-message #[nil "`À ‰Â¥\f ZÀVƒ.Ç !Yƒ! ‚#  \f ZÂ¥\\‚ Ç\f!Yƒ;\f‚< ,‡" [1 rmail-total-messages 2 mid high low where rmail-msgbeg] 5]) (defalias 'rmail-message-recipients-p #[(msg recipients &optional primary-only) "ŒÀ !bˆÂÃ!ˆ`ÂÄ!ˆ`}ˆÅÇÈ!†É\"†?ÅÇÊ!†*É\"†? ?…?ÅÇÌ!†>É\")‡" [rmail-msgbeg msg search-forward "\n*** EOOH ***\n" "\n\n" string-match recipients mail-fetch-field "To" "" "From" primary-only "Cc"] 4]) #@75 Return t, if for message number MSG, regexp REGEXP matches in the header. (defalias 'rmail-message-regexp-p #[(msg regexp) "À !bˆŠÂÃd\"ˆ`)Å\fÇ#)‡" [rmail-msgbeg msg search-forward "*** EOOH ***" end re-search-forward regexp t] 4 (#$ . 34605)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp rmail-search-last-regexp nil current-load-list] 2) #@221 Show message containing next match for REGEXP. Prefix argument gives repeat count; negative argument means search backwards (through earlier messages). Interactively, empty argument means use same regexp used last time. (defalias 'rmail-search #[(regexp &optional n) "„ÁÂÃÄWƒÅ‚Æ#ˆÈ ˆed`ÉÄW\n \f ÑŽ~ˆÄU?…›\fƒd „Š ÁVƒŠÒ S‰ !bˆÓÔ !Õ#‰ ‚A „Š WƒŠÒ T‰ !bˆÓÔ !Õ#‰ ƒi\fƒ”Á‚•×\\‰‚4.‡" [n 1 message "%sRmail search for %s..." 0 "Reverse " "" regexp rmail-maybe-set-message-counters nil rmail-current-message msg reversep win opoint omax omin ((byte-code "ƒ/ ƒ !bˆÄ Æ !Ç#ˆ`È !ˆÉÊ ƒ%Ë‚&Ì #ˆbˆ‚A bˆ}ˆÐ ˆÉÑ \"ˆÂ‡" [win reversep rmail-msgend msg re-search-backward regexp rmail-msgbeg t rmail-show-message message "%sRmail search for %s...done" "Reverse " "" opoint omin omax ding "Search failed: %s"] 4)) rmail-msgbeg re-search-forward rmail-msgend t rmail-total-messages -1] 7 (#$ . 34946) (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0)) (prompt (concat (if reversep "Reverse " "") "Rmail search (regexp): ")) regexp) (if rmail-search-last-regexp (setq prompt (concat prompt "(default " rmail-search-last-regexp ") "))) (setq regexp (read-string prompt)) (cond ((not (equal regexp "")) (setq rmail-search-last-regexp regexp)) ((not rmail-search-last-regexp) (error "No previous Rmail search string"))) (list rmail-search-last-regexp (prefix-numeric-value current-prefix-arg)))]) #@221 Show message containing previous match for REGEXP. Prefix argument gives repeat count; negative argument means search forward (through later messages). Interactively, empty argument means use same regexp used last time. (defalias 'rmail-search-backwards #[(regexp &optional n) "À \n†Ã[\"‡" [rmail-search regexp n 1] 3 (#$ . 36409) (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0)) (prompt (concat (if reversep "Reverse " "") "Rmail search (regexp): ")) regexp) (if rmail-search-last-regexp (setq prompt (concat prompt "(default " rmail-search-last-regexp ") "))) (setq regexp (read-string prompt)) (cond ((not (equal regexp "")) (setq rmail-search-last-regexp regexp)) ((not rmail-search-last-regexp) (error "No previous Rmail search string"))) (list rmail-search-last-regexp (prefix-numeric-value current-prefix-arg)))]) (defalias 'rmail-first-unseen-message #[nil "À ˆÁÂŒ~ˆ „#\f Xƒ#Æ\fÇ\"ƒ\f\fT‚\n) *‡" [rmail-maybe-set-message-counters 1 nil found current rmail-total-messages rmail-message-labels-p ", ?\\(unseen\\),"] 3]) #@142 Go to the next mail message having the same subject header. With prefix argument N, do this N times. If N is negative, go backwards instead. (defalias 'rmail-next-same-subject #[(n) "ÀÁ!ÃÄ\n!ÅQÈV \n Ì ÎÏ\n\"ƒ&\nÈ•ÌOŠŒ~ˆÈU„· ƒ> W‚B ÑVƒ·Ì„™ ƒZ W‚^ ÑVƒ™ ƒl T‚o S Ó !bˆÔÕ!ˆ`ÌÔØ!ˆ`bˆÙÚ#*‚Hƒ¢  ) ƒ®S‚±T‰‚,* ƒÄÛ !‚ÑÜÝ ƒÏÞ‚Ðß\"-‡" [mail-fetch-field "Subject" subject "^Subject: *\\(Re: *\\)?" regexp-quote "\n" search-regexp n 0 forward rmail-current-message i nil found string-match "Re:[ ]*" rmail-total-messages 1 done rmail-msgbeg search-forward "\n*** EOOH ***\n" end beg "\n\n" re-search-forward t rmail-show-message error "No %s message with same subject" "following" "previous"] 5 (#$ . 37471) "p"]) #@145 Go to the previous mail message having the same subject header. With prefix argument N, do this N times. If N is negative, go forwards instead. (defalias 'rmail-previous-same-subject #[(n) "À [!‡" [rmail-next-same-subject n] 2 (#$ . 38258) "p"]) (defalias 'rmail-message-deleted-p #[(n) " HÂU‡" [rmail-deleted-vector n 68] 2]) (defalias 'rmail-set-message-deleted-p #[(n state) " \nƒ\n ÄI‡" [rmail-deleted-vector n state 68 32] 3]) #@37 Delete this message and stay on it. (defalias 'rmail-delete-message #[nil "ÀÁÂ\"ˆÃÄ!‡" [rmail-set-attribute "deleted" t run-hooks rmail-delete-message-hook] 3 (#$ . 38702) nil]) #@57 Back up to deleted message, select it, and undelete it. (defalias 'rmail-undelete-previous-message #[nil "‰ÂVƒà !„ S‰‚ ÂUƒ!ÄÅ!‚A U„+Æ !ˆÇÈÉ\"ˆÊ ƒ?Š qˆÌ !ˆ)Í )‡" [rmail-current-message msg 0 rmail-message-deleted-p error "No previous deleted message" rmail-show-message rmail-set-attribute "deleted" nil rmail-summary-exists rmail-summary-buffer rmail-summary-mark-undeleted rmail-maybe-display-summary] 4 (#$ . 38886) nil]) #@258 Delete this message and move to next nondeleted one. Deleted messages stay in the file until the \[rmail-expunge] command is given. With prefix argument, delete and move backward. Returns t if a new message is displayed after the delete, or nil otherwise. (defalias 'rmail-delete-forward #[(&optional backward) "ÀÁÂ\"ˆÃÄ!ˆ Ç ƒF Ê ƒ3Ë \fŠÍŽÎ!ˆ Ð!ˆ,‚BŠqˆ Ð!ˆ*Ñ ˆ)ÒƒPÔ‚QÕ!Ñ ˆ)‡" [rmail-set-attribute "deleted" t run-hooks rmail-delete-message-hook rmail-current-message del-msg rmail-summary-exists rmail-total-messages total rmail-summary-displayed selected-window window ((select-window window)) pop-to-buffer rmail-summary-buffer rmail-summary-mark-deleted rmail-maybe-display-summary rmail-next-undeleted-message backward -1 1] 3 (#$ . 39332) "P"]) #@137 Delete this message and move to previous nondeleted one. Deleted messages stay in the file until the \[rmail-expunge] command is given. (defalias 'rmail-delete-backward #[nil "ÀÁ!‡" [rmail-delete-forward t] 2 (#$ . 40117) nil]) (defalias 'rmail-msg-number-after-expunge #[(deletedvec oldnum) "?†\n HÂU?…,ɉWƒ* HÂU„#\fT T‰‚\f*‡" [oldnum deletedvec 68 0 newnum i] 3]) #@50 Actually erase all deleted messages in the file. (defalias 'rmail-only-expunge #[nil "ÀÁ!ˆ\nÃ=„\fÄÅ ˆÆ dZÆ eZ ÊVƒ-Ë !ƒ-Ê‚0`eZ\f ÊHÄB‰ÃÄÑŽŠ~ˆebˆÊÒ ÄpÄ ÄÄ Ä ÄÄà ‰!ƒªŠ!@qˆâã!ƒ #=ƒ ä%\"%)!A‰!„„)Xƒ!HæUƒççH!çTH!|ˆHĉ“ˆVƒ S‚ THÄB¡U…SHBT‰è¦ÊUƒ«Àé\"ˆ‚«HÄB¡ êë\" ìTí\"îŸ!É.‡" [message "Expunging deleted messages..." buffer-undo-list t nil rmail-maybe-set-message-counters buffer-size omax omin rmail-current-message 0 rmail-message-deleted-p opoint rmail-message-vector messages-head messages-tail win ((byte-code "ÀÁ!ˆ\n„à \fZà Z}ˆÆÈU…É!ˆ\nu‡" [message "Expunging deleted messages...done" win buffer-size omin omax rmail-show-message rmail-current-message 0 1 opoint] 3)) 1 rmail-total-messages rmail-deleted-vector rmail-summary-vector summary deleted messages buffer-read-only rmailbuf new-summary new-message-number total number counter buffer-list bufs boundp rmail-send-actions-rmail-buffer rmail-msg-number-after-expunge rmail-send-actions-rmail-msg-number 68 marker-position 20 "Expunging deleted messages...%d" apply vector make-string 32 vconcat] 11 (#$ . 40504) nil]) #@60 Erase deleted messages from Rmail file and summary buffer. (defalias 'rmail-expunge #[nil "À ˆÁ …2\nÄ ƒ$Å ŠÇŽÈ !ˆ Ê ˆ,‚/Š qˆ Ê ˆ*Ë )‡" [rmail-only-expunge rmail-summary-exists rmail-total-messages total rmail-summary-displayed selected-window window ((select-window window)) pop-to-buffer rmail-summary-buffer rmail-update-summary rmail-maybe-display-summary] 2 (#$ . 41755) nil]) (defalias 'rmail-start-mail #[(&rest args) "ƒ ƒÂÃ\f\"ÅÆ Ç\"ˆ‡ÂÈ\f\"‡" [window-system rmail-mail-new-frame apply mail-other-frame args modify-frame-parameters selected-frame ((dedicated . t)) mail-other-window] 4]) #@123 Send mail in another window. While composing the message, use \[mail-yank-original] to yank the original message into it. (defalias 'rmail-mail #[nil "ÀÁ‰‰‰‰p&‡" [rmail-start-mail nil] 7 (#$ . 42372) nil]) #@64 Continue composing outgoing message previously being composed. (defalias 'rmail-continue #[nil "ÀÁ!‡" [rmail-start-mail t] 2 (#$ . 42585) nil]) #@224 Reply to the current message. Normally include CC: to all other recipients of original message; prefix argument means ignore them. While composing the reply, use \[mail-yank-original] to yank the original message into it. (defalias 'rmail-reply #[(just-sender) "À‰‰‰‰‰‰‰ p \n ŠŒ~ˆÌ !bˆÍyˆgÎUƒ>Ïyˆ`ÐÑÒ !Ó#ˆ`}ˆ‚I`ÐÔ!ˆÕyˆ`}ˆÖ×Ø\"ÖÙ! \f†aÖÚÀØ#†a \nƒlÀ‚|\fƒwÖÜØ\"‚|ÖÝÀØ# \fƒ‰ÖÞØ\"†ŒÖß!\fƒ™ÖàØ\"†œÖá!\fƒ«ÖâØ\"ˆã‚´ÖäÀØ#†´ã\fƒÁÖåØ\"‚ÄÖæ!*;ƒå'è)\"ƒàÕ•ÀO‚âPêÀë\n!ì  #?…íë „‚\fî Q!!‰/ã˜?…/)pðCC&ˆñò!ˆñó!ˆ\n2 ‰3.\n‡" [nil rmail-current-message rmail-buffer msgnum resent-reply-to message-id to date subject cc reply-to from rmail-msgbeg 1 48 2 search-forward "\n\n" rmail-msgend move "\n*** EOOH ***\n" 0 mail-fetch-field "resent-reply-to" t "from" "reply-to" just-sender "resent-cc" "cc" "resent-subject" "subject" "resent-date" "date" "resent-to" "" "to" "resent-message-id" "message-id" rmail-reply-prefix string-match rmail-reply-regexp rmail-start-mail mail-strip-quoted-names rmail-make-in-reply-to-field rmail-dont-reply-to ", " cc-list (lambda nil (let ((msgnum rmail-send-actions-rmail-msg-number)) (save-excursion (set-buffer rmail-send-actions-rmail-buffer) (if msgnum (rmail-set-attribute "answered" t msgnum))))) make-local-variable rmail-send-actions-rmail-buffer rmail-send-actions-rmail-msg-number] 11 (#$ . 42736) "P"]) (defalias 'rmail-make-in-reply-to-field #[(from date message-id) "„\n …  ‡\nƒsÃÄ!ˆÅ!@ ƒDÇÈÇÉ\"ƒ/ʉ”O‚1! \"ƒ; ‚q ËÌR‚qÍ!ÎÊGÏ$ˆÍ!Ð!ƒnÓQ‚p))‡ÔÖÇØÙÚÛ°\"†šÇÜÚÝÞ°\"*ƒߔߕ ‰! Wƒ¿!Hâ>ƒ¿!T‰!‚§! WƒÙ SHã>ƒÙ S ‚¿! OƒïäåR ƒü ËÌR‚þ+‡æç #)‡" [from message-id mail-use-rfc822 require rfc822 rfc822-addresses tem string-match regexp-quote "@[^@]*\\'" 0 " (" ")" copy-sequence set-text-properties nil prin1-to-string field date "'s message of " "[^][--ÿ()<>@,;:\\\" ]+" foo "[^][--ÿ()<>@,;:\\\"]+" bar "\\`[ ]*\\(" "\\)\\(<" "@" ">\\)?[ ]*\\'" "\\`[ ]*<" ">[ ]*(\\(" "\\))[ ]*\\'" 1 end start (9 32) (9 32) "message from " " on " t rmail-make-in-reply-to-field] 9]) #@156 Forward the current message to another user. With prefix argument, "resend" the message instead of forwarding it; see the documentation of `rmail-resend'. (defalias 'rmail-forward #[(resend) "ƒÁÂ!‡p ÄÅÆ!†ÅÇ!‰ƒ#É!ÊP‚$Ë)ÅÌ!†,ËÍR„CÒÓ!ƒCÔ‚DÕÖ‰Ö‰‰×CC&…‚ŠØÙ!ˆØÚ!ˆebˆÛÜÝ!ßQ!ˆàyˆácˆâ!ˆãcˆä )+‡" [resend call-interactively rmail-resend rmail-current-message "[" mail-fetch-field "From" ">From" from mail-strip-quoted-names ": " "" "Subject" "]" subject msgnum forward-buffer rmail-mail-new-frame one-window-p t mail rmail-start-mail nil #[nil "Š\nqˆ …ÃÄÅ #*‡" [rmail-send-actions-rmail-msg-number msgnum rmail-send-actions-rmail-buffer rmail-set-attribute "forwarded" t] 4] make-local-variable rmail-send-actions-rmail-buffer rmail-send-actions-rmail-msg-number search-forward-regexp "^" regexp-quote mail-header-separator "$" 1 "------- Start of forwarded message -------\n" insert-buffer-substring "------- End of forwarded message -------\n" push-mark] 9 (#$ . 44926) "P"]) #@493 Resend current message to ADDRESSES. ADDRESSES should be a single address, a string consisting of several addresses separated by commas, or a list of addresses. Optional FROM is the address to resend the message from, and defaults to the username of the person redistributing the message. Optional COMMENT is a string that will be inserted as a comment in the resent message. Optional ALIAS-FILE is alternate aliases file to be used by sendmail, typically for purposes of moderating a list. (defalias 'rmail-resend #[(address &optional from comment mail-alias-file) "ÀÁ!ˆÀÂ!ˆ „Ä ÅÆ!ÇÈp \n \fÍŽŠ\fqˆÎ !ˆebˆÏÐÈÑ#ˆÒÓÈÔ#ƒXÈ`Öyˆ×Ø!ƒOÖyˆ‚C`|ˆ)‚2ebˆÙ Ú±ˆÛÜ Ú±ˆ`ƒwßÄ Ú±ˆà!;ƒƒ!‚‰âã!ä#Ú±ˆŠåæ!ƒÚç (é *+,í(!„±î/!ƒ±ð ˆñ2!ˆbˆ`,WƒÑÖvˆ`,XƒÑó ˆ‚ºñ*!ˆ+‚àô`\"ˆ*õ6!ƒ6G÷U„`È86cˆl„Úcˆ`8bˆ`8WƒùcˆÖyˆ‚*È:; ˆ+üýÔ>#,‡" [require sendmail mailalias from user-login-name generate-new-buffer " sendmail temp" "" nil mailbuf case-fold-search mail-header-separator tembuf ((kill-buffer tembuf)) insert-buffer-substring re-search-forward "^$" move re-search-backward "^Sender:" t beg 1 looking-at "[ ]" "Resent-From: " "\n" "Resent-Date: " mail-rfc822-date before mail-self-blind "Resent-Bcc: " "Resent-To: " address mapconcat identity ",\n " featurep mailabbrev point-marker mail-abbrevs syntax-table old-syntax-table local-abbrev-table end vectorp file-exists-p mail-personal-alias-file build-mail-abbrevs set-syntax-table mail-abbrev-syntax-table expand-abbrev expand-mail-aliases sequencep comment 0 after "Resent-Comment: " mail-aliases send-mail-function rmail-set-attribute "resent" rmail-current-message] 5 (#$ . 45944) "sResend to: "]) #@74 A regexp that matches the separator before the text of a failed message. (defvar mail-unsent-separator (concat "^ *---+ +Unsent message follows +---+ *$\\|" "^ *---+ +Returned message +---+ *$\\|" "^Start of returned message$\\|" "^ *---+ +Original message +---+ *$\\|" "^ *--+ +begin message +--+ *$\\|" "^ *---+ +Original message follows +---+ *$\\|" "^|? *---+ +Message text follows: +---+ *|?$") (#$ . 47641)) #@430 Edit a mail message which is based on the contents of the current message. For a message rejected by the mail system, extract the interesting headers and the body of the original message. The variable `mail-unsent-separator' should match the string that delimits the returned original message. The variable `rmail-retry-ignored-headers' is a regular expression specifying headers which should not be copied into the new message. (defalias 'rmail-retry-failure #[nil "ÀÁ!ˆÂ‰‰‰‰ŠÈ ˆÉ\nËÌÂÉ#ƒbÍyˆ`ˆ`{Ï!ˆpË!ˆËÑÂÉ#„CÒÓ!ˆ`ŠdbˆÔ!ˆ`)ËÑÂÉ#„^ÒÕ!ˆ)‚³ÏÂÉ#„oÒÖ!ˆ×ÂwˆØÙ!ƒ‘`ÚÂwˆi[dbˆÛÜÂÉ#ˆ`‚°ØÝ!ƒŸËÑ!ˆ×Âwˆ`dËÑÂÉ#„°ÒÕ!ˆp*‰à‰‰‰‰&…-á ˆâ #ˆebˆ\fƒßãed\f#ˆä%!ˆäæ!ˆebˆŒËÑ!ˆçyˆe`}ˆèé!*ƒ ƒëì ×±ˆ‚íì ×±ˆ).cˆï ƒ#ð‚$ñÉ\"ˆqˆÈ .‡" [require mail-utils nil resending bounce-indent bounce-end bounce-start mail-buffer rmail-beginning-of-message t case-fold-search search-forward "This is a MIME-encapsulated message\n\n--" 0 codestring re-search-forward mail-unsent-separator "\n\n" error "Cannot find end of Mime data in failed message" search-backward "Cannot find end of header in failed message" "Cannot parse this as a failure message" "\n" looking-at " +Received:" " " re-search-backward "^End of returned message$" "^--" mail-setup-hook mail-signature rmail-start-mail erase-buffer insert-buffer-substring indent-rigidly rmail-clear-headers rmail-retry-ignored-headers "^sender:\\|^from:\\|^return-path:" -1 mail-fetch-field "resent-to" mail-self-blind "Resent-Bcc: " user-login-name "BCC: " mail-header-separator mail-position-on-field "Resent-To" "To"] 7 (#$ . 48062) nil]) #@139 Non-nil iff in an RMAIL buffer and an associated summary buffer exists. In fact, the non-nil value returned is the summary buffer itself. (defalias 'rmail-summary-exists #[nil "… Á!… ‡" [rmail-summary-buffer buffer-name] 2 (#$ . 49695)]) #@70 t iff in RMAIL buffer and an associated summary buffer is displayed. (defalias 'rmail-summary-displayed #[nil "…Á!‡" [rmail-summary-buffer get-buffer-window] 2 (#$ . 49944)]) #@115 *Non-nil means Rmail should show the summary when it changes. This has an effect only if a summary buffer exists. (defvar rmail-redisplay-summary nil (#$ . -50130)) #@64 *Non-nil means specify the height for an Rmail summary window. (defvar rmail-summary-window-size nil (#$ . -50301)) (defalias 'rmail-maybe-display-summary #[nil "À Á\fƒ5Å\f!ƒ5ƒ5Ç\fÈ\"ƒ1ÉÇ\fÈ\"!\nË\n!ˆÌ\n!ˆ)‚5Í\f!ˆ\f…eÅ\f!…e…eÇ\f!‰…e\nÏÉ\n!!=?…eÐŽÑ\n!ˆÒÓ Z!)*‡" [selected-window nil window selected rmail-summary-buffer buffer-name rmail-redisplay-summary get-buffer-window 0 window-frame frame make-frame-visible raise-frame display-buffer rmail-summary-window-size frame-root-window ((select-window selected)) select-window enlarge-window window-height] 4]) #@160 Set the inbox list of the current RMAIL file to FILE-NAME. This may be a list of file names separated by commas. If FILE-NAME is empty, remove any inbox list. (autoload (quote set-rmail-inbox-list) "rmailmsc" '(#$ . 50889) t) #@116 Add LABEL to labels associated with current RMAIL message. Completion is performed over known labels when reading. (autoload (quote rmail-add-label) "rmailkwd" '(#$ . 51122) t) #@121 Remove LABEL from labels associated with current RMAIL message. Completion is performed over known labels when reading. (autoload (quote rmail-kill-label) "rmailkwd" '(#$ . 51306) t) #@126 Show next message with LABEL. Defaults to last label used. With prefix argument N moves forward N messages with this label. (autoload (quote rmail-next-labeled-message) "rmailkwd" '(#$ . 51496) t) #@131 Show previous message with LABEL. Defaults to last label used. With prefix argument N moves backward N messages with this label. (autoload (quote rmail-previous-labeled-message) "rmailkwd" '(#$ . 51701) t) #@57 PROMPT and read with completion an Rmail message label. (autoload (quote rmail-read-label) "rmailkwd" '(#$ . 51914) t) #@42 Edit the contents of the current message (autoload (quote rmail-edit-current-message) "rmailedit" '(#$ . 52039) t) #@113 Sort messages of current Rmail file by date. If prefix argument REVERSE is non-nil, sort them in reverse order. (autoload (quote rmail-sort-by-date) "rmailsort" '(#$ . 52161) t) #@116 Sort messages of current Rmail file by subject. If prefix argument REVERSE is non-nil, sort them in reverse order. (autoload (quote rmail-sort-by-subject) "rmailsort" '(#$ . 52346) t) #@115 Sort messages of current Rmail file by author. If prefix argument REVERSE is non-nil, sort them in reverse order. (autoload (quote rmail-sort-by-author) "rmailsort" '(#$ . 52537) t) #@118 Sort messages of current Rmail file by recipient. If prefix argument REVERSE is non-nil, sort them in reverse order. (autoload (quote rmail-sort-by-recipient) "rmailsort" '(#$ . 52726) t) #@128 Sort messages of current Rmail file by other correspondent. If prefix argument REVERSE is non-nil, sort them in reverse order. (autoload (quote rmail-sort-by-correspondent) "rmailsort" '(#$ . 52921) t) #@124 Sort messages of current Rmail file by number of lines. If prefix argument REVERSE is non-nil, sort them in reverse order. (autoload (quote rmail-sort-by-lines) "rmailsort" '(#$ . 53130) t) #@161 Sort messages of current Rmail file by labels. If prefix argument REVERSE is non-nil, sort them in reverse order. KEYWORDS is a comma-separated list of labels. (autoload (quote rmail-sort-by-keywords) "rmailsort" '(#$ . 53327) t) #@58 Display a summary of all messages, one line per message. (autoload (quote rmail-summary) "rmailsum" '(#$ . 53563) t) #@138 Display a summary of all messages with one or more LABELS. LABELS should be a string containing the desired labels, separated by commas. (autoload (quote rmail-summary-by-labels) "rmailsum" '(#$ . 53687) t) #@260 Display a summary of all messages with the given RECIPIENTS. Normally checks the To, From and Cc fields of headers; but if PRIMARY-ONLY is non-nil (prefix arg given), only look in the To and From fields. RECIPIENTS is a string of regexps separated by commas. (autoload (quote rmail-summary-by-recipients) "rmailsum" '(#$ . 53901) t) #@251 Display a summary of all messages according to regexp REGEXP. If the regular expression is found in the header of the message (including in the date and other lines, as well as the subject line), Emacs will list the header line in the RMAIL-summary. (autoload (quote rmail-summary-by-regexp) "rmailsum" '(#$ . 54241) t) #@238 Display a summary of all messages with the given SUBJECT. Normally checks the Subject field of headers; but if WHOLE-MESSAGE is non-nil (prefix arg given), look in the whole message. SUBJECT is a string of regexps separated by commas. (autoload (quote rmail-summary-by-topic) "rmailsum" '(#$ . 54568) t) #@109 Display a summary of all messages with the given SENDERS. SENDERS is a string of names separated by commas. (autoload (quote rmail-summary-by-sender) "rmailsum" '(#$ . 54881) t) #@209 Append the current message to an Rmail file named FILE-NAME. If the file does not exist, ask if it should be created. If file is being visited, the message is appended to the Emacs buffer visiting that file. (autoload (quote rmail-output-to-rmail-file) "rmailout" '(#$ . 55066) t) #@56 Append this message to Unix mail file named FILE-NAME. (autoload (quote rmail-output) "rmailout" '(#$ . 55353) t) #@127 Break up a digest message into its constituent messages. Leaves original message, deleted, before the undigestified messages. (autoload (quote undigestify-rmail-message) "undigest" '(#$ . 55474) t) (provide (quote rmail)) emacs-19.30/lisp/rmailedit.elc100666 13437 1 5157 5747270766 14704 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue Apr 25 18:04:34 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/rmailedit.el ;;; emacs version 19.28.90.40. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/rmailedit.el' was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!„\fÄà B „&Æ ¤È ÉÊ#ˆÈ ËÌ#ˆÍÎÏÐ#‡" [require rmail boundp rmail-edit-map nil current-load-list make-sparse-keymap text-mode-map define-key "" rmail-cease-edit "" rmail-abort-edit put rmail-edit-mode mode-class special] 4) #@308 Major mode for editing the contents of an RMAIL message. The editing commands are the same as in Text mode, together with two commands to return to regular RMAIL: * rmail-abort-edit cancels the changes you have made and returns to RMAIL * rmail-cease-edit makes them permanent. \{rmail-edit-map} (defalias 'rmail-edit-mode #[nil "À !ˆÂÄÆÇ!ƒÈÇ!‚ÈÉ! Ê ƒ)Š qˆÌ ˆ)ÍÎÏ\"‡" [use-local-map rmail-edit-map rmail-edit-mode major-mode "RMAIL Edit" mode-name boundp mode-line-modified default-value mode-line-format rmail-summary-exists rmail-summary-buffer rmail-summary-disable run-hooks text-mode-hook rmail-edit-mode-hook] 3 (#$ . 737)]) #@36 Edit the contents of this message. (defalias 'rmail-edit-current-message #[nil "À ˆÁÂ!ˆed{ÃÅ ˆÆÇ!È=ƒ$ÆÉ!Ê=ƒ$ËÌ!‡ËÍÎ!!‡" [rmail-edit-mode make-local-variable rmail-old-text nil buffer-read-only force-mode-line-update key-binding "" rmail-cease-edit "" rmail-abort-edit message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort" substitute-command-keys "Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort"] 3 (#$ . 1396) nil]) #@54 Finish editing message; switch back to Rmail proper. (defalias 'rmail-cease-edit #[nil "À ƒ Š qˆÂ ˆ)ŠdbˆhÃU„Äcˆ TH`Ç“ˆ) Ê ˆË ˆ GdeZUƒA ed{˜„`Ç ÌÍÎ\"ˆÏÐ!ƒ`SÇIˆŠÑÒ!ˆÓ ˆ))Ή‡" [rmail-summary-exists rmail-summary-buffer rmail-summary-enable 10 "\n" rmail-message-vector rmail-current-message nil rmail-old-text old force-mode-line-update rmail-mode-1 rmail-set-attribute "edited" t boundp rmail-summary-vector rmail-widen-to-current-msgbeg #[nil "ÀyˆÁÂ!…Ã`Åyˆ`|)‡" [2 looking-at "Summary-line: " nil buffer-read-only 1] 2] rmail-show-message buffer-read-only] 3 (#$ . 1879) nil]) #@59 Abort edit of current message; restore original contents. (defalias 'rmail-abort-edit #[nil "ed|ˆcˆÁ ˆÂ ‡" [rmail-old-text rmail-cease-edit rmail-highlight-headers] 2 (#$ . 2484) nil]) emacs-19.30/lisp/rmailkwd.elc100666 13437 1 11503 5745606504 14543 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Thu Apr 20 21:41:21 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/rmailkwd.el ;;; emacs version 19.28.90.32. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/rmailkwd.el' was compiled for Emacs 19")) (byte-code "ÀÁ!„ ÂÃÄ\"Á BÆÇÈÉ\"B\nÊ BËÌ \" Í BÀÆ!„.ÎÆ B·" [boundp rmail-label-obarray make-vector 47 0 current-load-list rmail-keywords mapcar #[(s) "À \n\"‡" [intern s rmail-label-obarray] 3] ("deleted" "answered" "filed" "forwarded" "unseen" "edited" "resent") rmail-attributes intern "deleted" rmail-deleted-label nil] 4) #@116 Add LABEL to labels associated with current RMAIL message. Completion is performed over known labels when reading. (defalias 'rmail-add-label #[(string) "À Â\"‡" [rmail-set-label string t] 3 (#$ . 823) (list (rmail-read-label "Add label"))]) #@121 Remove LABEL from labels associated with current RMAIL message. Completion is performed over known labels when reading. (defalias 'rmail-kill-label #[(string) "À Â\"‡" [rmail-set-label string nil] 3 (#$ . 1072) (list (rmail-read-label "Remove label"))]) (defalias 'rmail-read-label #[(prompt) "„Á ˆÂ \fƒÅÆ\f!ÇQ‚ÈP ʉ$‰ ̘ƒ)\f‚0Í Î\"‰)‡" [rmail-keywords rmail-parse-file-keywords completing-read prompt rmail-last-label " (default " symbol-name "): " ": " rmail-label-obarray nil result "" rmail-make-label t] 6]) (defalias 'rmail-set-label #[(l state &optional n) "À ˆ „ \n SÄIˆÅ!‰?…%È!†%É!\n†.\n‰ …¿Ì dZÌ eZÄÍÒŽŠ~ˆÓ !bˆÔyˆÕÖ!??…½`TÄ`Ĉ`}ˆdÙÚÄÍ#ˆƒ~`T‚‚`TbˆÛÜÝ !ÞQß#ƒ¡ „¯áÞ!ˆ‚¯ ƒ¯âã !Þ±ˆ $=…¼å  \"*.+‡" [rmail-maybe-set-message-counters n rmail-current-message rmail-summary-vector nil rmail-attribute-p l attribute rmail-keyword-p rmail-install-keyword keyword label buffer-size t case-fold-search buffer-read-only omin omax ((byte-code "À ZÀ \nZ}ˆ \fUƒÅ ˆÀ‡" [buffer-size omin omax n rmail-current-message rmail-display-labels] 3)) rmail-msgbeg 1 looking-at "[01]," bound start search-backward ",," re-search-forward ", " rmail-quote-label-name "," move state replace-match " " symbol-name rmail-deleted-label rmail-set-message-deleted-p] 5]) (defalias 'rmail-attribute-p #[(s) "À !‰ A>…\f\n)‡" [rmail-make-label s symbol rmail-attributes] 3]) (defalias 'rmail-keyword-p #[(s) "À !‰à A>… \n)‡" [rmail-make-label s symbol rmail-keywords] 3]) (defalias 'rmail-make-label #[(s &optional forcep) "9ƒ‡ ƒÂ— \"‡Ä— \"‡" [s forcep intern rmail-label-obarray intern-soft] 3]) (defalias 'rmail-force-make-label #[(s) "À —\n\"‡" [intern s rmail-label-obarray] 3]) (defalias 'rmail-quote-label-name #[(label) "ÀÁ Ä\"!!‡" [regexp-quote symbol-name rmail-make-label label t] 5]) #@240 Show previous message with one of the labels LABELS. LABELS should be a comma-separated list of label names. If LABELS is empty, the last set of labels specified is used. With prefix argument N moves backward N messages with these labels. (defalias 'rmail-previous-labeled-message #[(n labels) "À [\n\"‡" [rmail-next-labeled-message n labels] 3 (#$ . 2935) "p\nsMove to previous msg with labels: "]) #@235 Show next message with one of the labels LABELS. LABELS should be a comma-separated list of label names. If LABELS is empty, the last set of labels specified is used. With prefix argument N moves forward N messages with these labels. (defalias 'rmail-next-labeled-message #[(n labels) "Á˜ƒ\n„ÃÄ!ˆÅ ˆ‰ÇÈ!ÉQ\n \fŒ~ˆ ÎVƒQ WƒQ T Ð \n\"ƒ' \f S‰ ‚) ÎWƒz ÑVƒz S Ð \n\"ƒQ \f T‰ ‚S)Ò\f!ˆ ÎWƒŒÓÔ\"ˆ ÎV…—ÓÕ\"+‡" [labels "" rmail-last-multi-labels error "No labels to find have been specified previously" rmail-maybe-set-message-counters rmail-current-message ", ?\\(" mail-comma-list-regexp "\\)," regexp current lastwin n 0 rmail-total-messages rmail-message-labels-p 1 rmail-show-message message "No previous message with labels %s" "No following message with labels %s"] 6 (#$ . 3342) "p\nsMove to next msg with labels: "]) (defalias 'rmail-keywords #[nil "†Á ‡" [rmail-keywords rmail-parse-file-keywords] 1]) (defalias 'rmail-parse-file-keywords #[nil "ŒŠ~ˆÀbˆÁÂÃÀ!Ä#…\"`ň`}ˆebˆÆÇÈÉ \"B‰*‡" [1 search-forward "\nLabels:" rmail-msgbeg t nil rmail-keywords mapcar rmail-force-make-label mail-parse-comma-list] 4]) (defalias 'rmail-install-keyword #[(word) "À Â\"à Æ !„bÇ !„bÈ eZÈ dZ \nËŽŠ~ˆÌbˆÂÍÐÑÍÂ#„<͈Ñcˆ`͈`|ˆ\f \fAB¡ˆ\fA‰ƒ\\Ò\f@!Ó±ˆ‚JÔÕ!ˆ. *‡" [rmail-make-label word t rmail-keywords keywords keyword rmail-attribute-p rmail-keyword-p buffer-size omax omin ((byte-code "À ZÀ \nZ}‡" [buffer-size omin omax] 3)) 1 nil buffer-read-only case-fold-search search-forward "\nLabels:" symbol-name "," delete-char -1] 4]) emacs-19.30/lisp/rmailmsc.elc100666 13437 1 2231 5744577220 14517 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:49:36 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/rmailmsc.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/rmailmsc.el' was compiled for Emacs 19")) #@184 Set the inbox list of the current RMAIL file to FILE-NAME. You can specify one file name, or several names separated by commas. If FILE-NAME is empty, remove any existing inbox list. (defalias 'set-rmail-inbox-list #[(file-name) "ŠÀ Á‰ƒÄÅÆÇ È#ÉQ!ƒHÁ\n~ˆebˆËÌ!ˆÍÎÁÏ#ˆÐyˆÑÒ!ƒ9`Óyˆ`|ˆÕ˜„GÖ×Ø#ˆ)+À Ú!‡" [rmail-parse-file-inboxes nil standard-output names y-or-n-p "Replace " mapconcat identity ", " "? " buffer-read-only search-forward "\n" re-search-backward "^Mail" t 0 looking-at "Mail:" 1 file-name "" insert-before-markers "Mail: " "\n" rmail-inbox-list rmail-show-message rmail-current-message] 7 (#$ . 486) "sSet mailbox list to (comma-separated list of filenames): "]) emacs-19.30/lisp/rmailout.elc100666 13437 1 14740 6032176475 14572 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Sep 27 03:28:47 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/rmailout.el ;;; emacs version 19.29.12. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`rmailout.el' was compiled for Emacs 19.29 or later")) (require (quote rmail)) #@73 *Non-nil means automatically delete a message that is copied to a file. (defvar rmail-delete-after-output nil (#$ . -506)) #@344 *Alist matching regexps to suggested output Rmail files. This is a list of elements of the form (REGEXP . NAME-EXP). The suggestion is taken if REGEXP matches anywhere in the message buffer. 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. (defvar rmail-output-file-alist nil (#$ . -636)) #@549 Append the current message to an Rmail file named FILE-NAME. If the file does not exist, ask if it should be created. 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. The default file name comes from `rmail-default-rmail-file', which is updated to the name you use in this command. A prefix argument N says to output N consecutive messages starting with the current one. Deleted messages are skipped and don't count. (defalias 'rmail-output-to-rmail-file #[(file-name &optional count) "„ÁÂ Ä !\"Æ !ƒÇ !„È \"‡É ˆÊ !Ë !„`Ì !„`ÍÎ ÏQ!ƒ\\Ð !ŠqˆÒ ˆÓÕed ÖÁ%ˆ*×!ˆ)‚`ØÙ!ˆÚV…®ÓÜŽÝ!ƒzÖßàÓ\"ˆŒ~ˆŠË !pá!Tâ!T#$%‰&„Ð'ƒÅp(éê!qˆë($##ˆì ˆíed #ˆ(qˆ×îê!!ˆ)‚…í$# #ˆ‚…&p=ƒÛØï!ˆ&qˆÓðÞ!…è121ƒm3„ÿ4ƒÿõÖ!ˆÉ ˆ~ˆdd}ˆë%$##ˆebˆ~ˆö÷!ˆ`d}ˆì ˆøÖ!ˆù ƒc:;ü ƒNý >ŠÿŽ@A!ˆ;:B ˆ,‚]ŠAqˆ;:B ˆ*C ˆ)D1!ˆ‚„eE T}ˆdbˆë%$##ˆì ˆ*.ßFÖ\"ˆ*SGƒŸH ˆ‚`ÚVƒ`IÁ!ˆ‚`‡" [count 1 expand-file-name file-name file-name-directory rmail-default-rmail-file file-readable-p mail-file-babyl-p rmail-output rmail-maybe-set-message-counters abbreviate-file-name get-file-buffer file-exists-p yes-or-no-p "\"" "\" does not exist, create it? " create-file-buffer file-buffer rmail-insert-rmail-file-header nil require-final-newline write-region t kill-buffer error "Output file does not exist" 0 redelete ((byte-code "ƒ ÁÂÃ\"ˆÁ‡" [redelete rmail-set-attribute "deleted" t] 3)) rmail-message-deleted-p rmail-current-message rmail-set-attribute "deleted" rmail-msgbeg rmail-msgend end beg cur buf rmail-fields-not-to-output obuf get-buffer-create " rmail-out-temp" insert-buffer-substring rmail-delete-unwanted-fields append-to-file get-buffer "Can't output message to same file it's already in" boundp msg buffer-read-only buffer-auto-save-file-name auto-save-default auto-save-mode search-backward "\n" rmail-count-new-messages rmail-summary-exists rmail-total-messages total rmail-summary-displayed selected-window window ((select-window window)) pop-to-buffer rmail-summary-buffer rmail-update-summary rmail-maybe-display-summary rmail-show-message buffer-size "filed" rmail-delete-after-output rmail-delete-forward rmail-next-undeleted-message] 7 (#$ . 1035) (byte-code "À‰  ƒ)\n„)ŠebˆÄ @@ÀÅ#ƒ\"Æ @A! A)‚\n†/*ÉÊË!ÌQÍ!#Ï!ƒUÐË!\"‚bІ]Í!\")‰Ñ!)D‡" [nil tail answer rmail-output-file-alist re-search-forward t eval rmail-default-rmail-file default-file read-file-name "Output message to Rmail file: (default " file-name-nondirectory ") " file-name-directory read-file file-directory-p expand-file-name prefix-numeric-value current-prefix-arg] 4)]) #@75 *Regexp describing fields to exclude when outputting a message to a file. (defvar rmail-fields-not-to-output nil (#$ . -3806)) (defalias 'rmail-delete-unwanted-fields #[(&optional not-rmail) "…;Šebˆ „ÂÃÄÅ#…:ÂÆÄÅ#…:Ç ebˆÉÅ#…9Êyˆ`Ëyˆ`|ˆ‚#))‡" [rmail-fields-not-to-output not-rmail search-forward "\n*** EOOH ***\n" nil t "\n\n" point-marker end re-search-forward 0 1] 4]) #@737 Append this message to system-inbox-format mail file named FILE-NAME. A prefix argument N says to output N consecutive messages starting with the current one. Deleted messages are skipped and don't count. When called from lisp code, N may be omitted. If the pruned message header is shown on the current message, then messages will be appended with pruned headers; otherwise, messages will be appended with their original headers. The default file name comes from `rmail-default-file', which is updated to the name you use in this command. The optional third argument NOATTRIBUTE, if non-nil, says not to set the `filed' attribute, and not to display a message. The optional fourth argument FROM-GNUS is set when called from GNUS. (defalias 'rmail-output #[(file-name &optional count noattribute from-gnus) "„Á \f…Å\f!\"Æ !ƒ\"Ç !ƒ\"È \"‡pÉÊË!\f?…AŠŒÍ!d}ˆebˆÁyˆgÏU*ЉØVƒG\f„xŠŒ~ˆÍ!bˆ`ÙÚ!ˆ`}ˆÛÜ!*ŠqˆÝ ˆÞ!ˆßÉ!ˆàcˆebˆƒà±ˆ‚ºáâÛã!†²Ûä!†²Ûå!†²æ!çè ైÐÙéÐÉ#ƒÎêuˆëcˆ‚½)ìed É-…Úî%ˆ)-„î/ðšƒîñòÉ\"ˆS\f„Q3ƒô ‚ ØV… õÁ!Z6‰7ƒƒø ˆØVƒC7„CùŠqˆúû6‰ÁUƒ<ü‚=ý#)!ˆØ*‚Qþ!.‡" [count 1 expand-file-name file-name rmail-default-file file-name-directory file-readable-p mail-file-babyl-p rmail-output-to-rmail-file t get-buffer-create " rmail-output" from-gnus rmail-msgbeg rmail-current-message 48 nil mail-from header-beginning original-headers-p tembuf case-fold-search rmailbuf orig-count 0 search-forward "\n*** EOOH ***\n" mail-fetch-field "Mail-From" erase-buffer insert-buffer-substring rmail-delete-unwanted-fields "\n" "From " mail-strip-quoted-names "from" "really-from" "sender" "unknown" " " current-time-string "\nFrom " -5 62 write-region noattribute nomsg major-mode rmail-mode rmail-set-attribute "filed" rmail-delete-after-output rmail-delete-forward rmail-next-undeleted-message num-appended next-message-p rmail-toggle-header error format "Only %d message%s appended" "" "s" kill-buffer] 8 (#$ . 4196) (byte-code "À‰  ƒ)\n„)ŠebˆÄ @@ÀÅ#ƒ\"Æ @A! A)‚\n†/*ÉÊË!ÌQÍ!#Ï!ƒUÐË!\"‚bІ]Í!\")‰Ñ!)D‡" [nil tail answer rmail-output-file-alist re-search-forward t eval rmail-default-file default-file read-file-name "Output message to Unix mail file: (default " file-name-nondirectory ") " file-name-directory read-file file-directory-p expand-file-name prefix-numeric-value current-prefix-arg] 4)]) emacs-19.30/lisp/rmailsort.elc100666 13437 1 12012 5744577225 14747 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:49:39 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/rmailsort.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/rmailsort.el' was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃÄ\"‡" [require sort autoload timezone-make-date-sortable "timezone"] 3) #@113 Sort messages of current Rmail file by date. If prefix argument REVERSE is non-nil, sort them in reverse order. (defalias 'rmail-sort-by-date #[(reverse) "À Â\"‡" [rmail-sort-messages reverse #[(msg) "ÀÁ\nÃ\"!‡" [rmail-make-date-sortable rmail-fetch-field msg "Date"] 4]] 3 (#$ . 578) "P"]) #@116 Sort messages of current Rmail file by subject. If prefix argument REVERSE is non-nil, sort them in reverse order. (defalias 'rmail-sort-by-subject #[(reverse) "À Â\"‡" [rmail-sort-messages reverse #[(msg) "À Â\"†ÃÄÇÈ\"ƒÉ•ÊO‚*‡" [rmail-fetch-field msg "Subject" "" t case-fold-search key string-match "^\\(re:[ ]*\\)*" 0 nil] 3]] 3 (#$ . 876) "P"]) #@115 Sort messages of current Rmail file by author. If prefix argument REVERSE is non-nil, sort them in reverse order. (defalias 'rmail-sort-by-author #[(reverse) "À Â\"‡" [rmail-sort-messages reverse #[(msg) "ÀÁ\nÃ\"†Á\nÄ\"†Å!—‡" [mail-strip-quoted-names rmail-fetch-field msg "From" "Sender" ""] 4]] 3 (#$ . 1248) "P"]) #@118 Sort messages of current Rmail file by recipient. If prefix argument REVERSE is non-nil, sort them in reverse order. (defalias 'rmail-sort-by-recipient #[(reverse) "À Â\"‡" [rmail-sort-messages reverse #[(msg) "ÀÁ\nÃ\"†Á\nÄ\"†Å!—‡" [mail-strip-quoted-names rmail-fetch-field msg "To" "Apparently-To" ""] 4]] 3 (#$ . 1576) "P"]) #@128 Sort messages of current Rmail file by other correspondent. If prefix argument REVERSE is non-nil, sort them in reverse order. (defalias 'rmail-sort-by-correspondent #[(reverse) "À Â\"‡" [rmail-sort-messages reverse #[(msg) "À Â\"‡" [rmail-select-correspondent msg ("From" "Sender" "To" "Apparently-To")] 3]] 3 (#$ . 1915) "P"]) (defalias 'rmail-select-correspondent #[(msg fields) "À\nƒ\" À˜ƒ\"ÃÄÅ\n@\"†À!!\nA‰„ )‡" ["" ans fields rmail-dont-reply-to mail-strip-quoted-names rmail-fetch-field msg] 6]) #@124 Sort messages of current Rmail file by number of lines. If prefix argument REVERSE is non-nil, sort them in reverse order. (defalias 'rmail-sort-by-lines #[(reverse) "À Â\"‡" [rmail-sort-messages reverse #[(msg) "ÀÁ\n!Ã\n!\"‡" [count-lines rmail-msgbeg msg rmail-msgend] 4]] 3 (#$ . 2436) "P"]) #@161 Sort messages of current Rmail file by labels. If prefix argument REVERSE is non-nil, sort them in reverse order. KEYWORDS is a comma-separated list of labels. (defalias 'rmail-sort-by-keywords #[(reverse labels) "ÀÁ\n\"„ ÃÄ!ˆ\nÅ”ÆOÇPÆÀÉ\n\"ƒ3Ê\nʼn”OËQB\nÅ•ÆO‚ÌÍŸ\"ÎÐ\")‡" [string-match "[^ ]" labels error "No labels specified" 0 nil "," labelvec "[ ]*,[ ]*" ", ?\\(" "\\)," apply vector rmail-sort-messages reverse #[(msg) "ÀÀ\nGWƒÃ\f\n H\"„ T‰‚ )‡" [0 n labelvec rmail-message-labels-p msg] 5]] 4 (#$ . 2738) "P\nsSort by labels: "]) #@180 Sort messages of current Rmail file. If 1st argument REVERSE is non-nil, sort them in reverse order. 2nd argument KEYFUN is called with a message number, and should return a key. (defalias 'rmail-sort-messages #[(reverse keyfun) "ŠÁ=ƒ\n\nqˆÃ‰‰ÇÈ!ˆ~ˆÉ\n \nYƒR\f\n! \n=\nH\nTHF\fB\nϦÐUƒJÇÑ\n\"ˆ\nT\n‚)„[\fŸ\f@@§ƒgÓ‚iÔÕ\fÖ\"ƒv\fŸÇ×!ˆØÃÉÃ\nÜp!ˆÝÉ!bˆÞß!ˆàÉ!ˆ\fƒÚ\f@ápâ8ã8#ˆâ8ã8|ˆA@ƒÀ\n\fA\nϦÐUƒÒÇä\n\"ˆ\nT\n‚—åÉ!ˆÃ&ç ˆè ˆé!ˆê …! +ì ƒí .ŠïŽð1!ˆ+ ò ˆ,‚Š1qˆ+ ò ˆ*ó ).‡" [major-mode rmail-summary-mode rmail-buffer nil sort-lists predicate buffer-read-only message "Finding sort keys..." 1 msgnum rmail-total-messages keyfun rmail-current-message rmail-message-vector 10 0 "Finding sort keys...%d" reverse < string-lessp sort #[(a b) " @\n@\"‡" [predicate a b] 3] "Reordering messages..." t msginfo current-message inhibit-quit buffer-disable-undo rmail-msgbeg insert-before-markers 90 backward-char insert-buffer-substring 2 3 "Reordering messages...%d" delete-char quit-flag buffer-enable-undo rmail-set-message-counters rmail-show-message rmail-summary-exists total rmail-summary-displayed selected-window window ((select-window window)) pop-to-buffer rmail-summary-buffer rmail-update-summary rmail-maybe-display-summary] 5 (#$ . 3311)]) #@75 Return the value of the header FIELD of MSG. Arguments are MSG and FIELD. (defalias 'rmail-fetch-field #[(msg field) "Œ~ˆÀ !à !bˆÄÅ\nÆ#ƒ`‚Çyˆ`ÄÈÉÆ#ˆ`}ˆÊ !*‡" [rmail-msgend msg next rmail-msgbeg search-forward "\n*** EOOH ***\n" t 1 "\n\n" nil mail-fetch-field field] 5 (#$ . 4643)]) #@53 Make DATE sortable using the function string-lessp. (defalias 'rmail-make-date-sortable #[(date) "À ‰#‡" [timezone-make-date-sortable date "GMT"] 4 (#$ . 4938)]) (provide (quote rmailsort)) emacs-19.30/lisp/rmailsum.elc100666 13437 1 100251 6051234524 14567 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 19:00:47 1995 ;;; from file /home/fsf/rms/e19/lisp/rmailsum.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`rmailsum.el' was compiled for Emacs 19.29 or later")) (require (quote rmail)) #@60 Additional expressions to highlight in Rmail Summary mode. (defvar rmail-summary-font-lock-keywords (quote (("^....D.*" . font-lock-string-face) ("^....-.*" . font-lock-type-face) ("^....[^D-] \\(......\\)" 1 font-lock-keyword-face) ("{ \\([^}]+\\),}" 1 font-lock-comment-face))) (#$ . 500)) (defalias 'rmail-update-summary #[(&rest ignore) "À @ A\"‡" [apply rmail-summary-redo] 3]) #@58 Display a summary of all messages, one line per message. (defalias 'rmail-summary #[nil "ÀÁÂÃ#‡" [rmail-new-summary "All" (rmail-summary) nil] 4 (#$ . 889) nil]) #@138 Display a summary of all messages with one or more LABELS. LABELS should be a string containing the desired labels, separated by commas. (defalias 'rmail-summary-by-labels #[(labels) "Á˜ƒ\n† ÃÄ!ÅÆPÇDÈÉÊ!ËQ$‡" [labels "" rmail-last-multi-labels error "No label specified" rmail-new-summary "labels " rmail-summary-by-labels rmail-message-labels-p ", \\(" mail-comma-list-regexp "\\),"] 7 (#$ . 1058) "sLabels to summarize by: "]) #@261 Display a summary of all messages with the given RECIPIENTS. Normally checks the To, From and Cc fields of headers; but if PRIMARY-ONLY is non-nil (prefix arg given), only look in the To and From fields. RECIPIENTS is a string of regexps separated by commas. (defalias 'rmail-summary-by-recipients #[(recipients &optional primary-only) "ÀÁ\nPÃ\n\fEÅÆ\n!\f%‡" [rmail-new-summary "recipients " recipients rmail-summary-by-recipients primary-only rmail-message-recipients-p mail-comma-list-regexp] 6 (#$ . 1504) "sRecipients to summarize by: \nP"]) #@251 Display a summary of all messages according to regexp REGEXP. If the regular expression is found in the header of the message (including in the date and other lines, as well as the subject line), Emacs will list the header line in the RMAIL-summary. (defalias 'rmail-summary-by-regexp #[(regexp) "Á˜ƒ\n† ÃÄ!ÅÆPÇDÈ$‡" [regexp "" rmail-last-regexp error "No regexp specified." rmail-new-summary "regexp " rmail-summary-by-regexp rmail-message-regexp-p] 5 (#$ . 2058) "sRegexp to summarize by: "]) #@238 Display a summary of all messages with the given SUBJECT. Normally checks the Subject field of headers; but if WHOLE-MESSAGE is non-nil (prefix arg given), look in the whole message. SUBJECT is a string of regexps separated by commas. (defalias 'rmail-summary-by-topic #[(subject &optional whole-message) "ÀÁ\nPÃ\n\fEÅÆ\n!\f%‡" [rmail-new-summary "about " subject rmail-summary-by-topic whole-message rmail-message-subject-p mail-comma-list-regexp] 6 (#$ . 2570) "sTopics to summarize by: \nP"]) (defalias 'rmail-message-subject-p #[(msg subject &optional whole-message) "ŒÀ !bˆÂÃ!ˆ`Â\fƒÅ‚Æ!ˆ`}ˆebˆ\fƒ*ÇÉÊ#‚5ËÌÍ!†4Î\")‡" [rmail-msgbeg msg search-forward "\n*** EOOH ***\n" whole-message "" "\n\n" re-search-forward subject nil t string-match mail-fetch-field "Subject" ""] 4]) #@109 Display a summary of all messages with the given SENDERS. SENDERS is a string of names separated by commas. (defalias 'rmail-summary-by-senders #[(senders) "ÀÁ\nPÃ\nDÄÅ\n!$‡" [rmail-new-summary "senders " senders rmail-summary-by-senders rmail-message-senders-p mail-comma-list-regexp] 6 (#$ . 3368) "sSenders to summarize by: "]) (defalias 'rmail-message-senders-p #[(msg senders) "ŒÀ !bˆÂÃ!ˆ`ÂÄ!ˆ`}ˆÅÇÈ!†É\")‡" [rmail-msgbeg msg search-forward "\n*** EOOH ***\n" "\n\n" string-match senders mail-fetch-field "From" ""] 4]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp rmail-summary-symbol-number 0 current-load-list] 2) #@268 Create a summary of selected messages. DESCRIPTION makes part of the mode line of the summary buffer. For each message, FUNCTION is applied to the message number and ARGS... and if the result is non-nil, that message is included. nil for FUNCTION means all messages. (defalias 'rmail-new-summary #[(description redo-form function &rest args) "ÀÁ!ˆÂ‰‰ŠÇ=ƒÈ qˆ\nƒ)Ë\n!ƒ)\n‚/ÌË ÍP!ÂÏÒÂÓ Ô Š~ˆebˆYƒzƒfÛB\"ƒrÝ!BBT‚MŸ)}ˆ,Â\nŠp qˆÂà ˆƒ±á@A \"ˆA‰„ ebˆ)ÈÇ ˆâã!ˆäC# %&- \n) „7ç ƒ(ƒ)„êë ,\"ˆíîï !!ˆð !ˆ ñï !=„\fò ˆ‚\fð !ˆ qˆó ƒ)ë 4ŠõŽð\n!ˆ+‚/Š\nqˆ)ö ˆ)\nqˆ÷\fȉ#ˆø ˆÀù!+‡" [message "Computing summary lines..." nil was-in-summary mesg sumbuf major-mode rmail-summary-mode t rmail-buffer rmail-summary-buffer buffer-name generate-new-buffer "-summary" rmail-current-message 0 new-summary-line-count summary-msgs 1 point-min-marker point-max-marker old-max old-min buffer-read-only msgnum rmail-total-messages function apply args rmail-make-summary-line total rbuf erase-buffer princ make-local-variable minor-mode-alist (t (concat ": " description)) redo-form rmail-summary-redo one-window-p pop-up-windows pop-up-frames split-window selected-window rmail-summary-window-size select-window next-window frame-first-window pop-to-buffer window-buffer delete-other-windows rmail-summary-displayed window ((select-window window)) rmail-maybe-display-summary rmail-summary-goto-msg rmail-summary-construct-io-menu "Computing summary lines...done"] 5 (#$ . 3992)]) (defalias 'rmail-make-summary-line #[(msg) " SH†\nT‰æÄUƒÅÆ\n\"ˆÇ !‰ÉÊ !ƒ(Ë‚8Ì !Í\\fÎUƒ7Ï‚8ÐIˆ)‡" [rmail-summary-vector msg new-summary-line-count 10 0 message "Computing summary lines...%d" rmail-make-summary-line-1 line 4 rmail-message-deleted-p 68 rmail-msgbeg 3 48 45 32] 5]) (defalias 'rmail-make-summary-line-1 #[(msg) "À !bˆŠÂyˆ`)ÄÆuˆÇÈ!ˆlƒÉ‚&Ê`Ĉ`{ËQ°\fÍyˆÎÏ!…@Еbˆ`Íyˆ`{‰‰ƒXÒÓ\"„X`Ôyˆ`|ˆÄ„¥Õ× !À !bˆÇÙÕ#ƒw`‚{Íyˆ`ÇÛÄÕ#ˆ`Œ}ˆbˆÝ )À !bˆÂyˆÏ±ˆ,ÒÓ\" Sßà \"Ð O\f TÄORI,‡" [rmail-msgbeg msg 2 lim nil pos 3 search-forward ",," "" "{" "} " labels 1 looking-at "Summary-line: " 0 line string-match "#" -1 t case-fold-search rmail-msgend next "\n*** EOOH ***\n" beg "\n\n" end rmail-make-basic-summary-line rmail-summary-vector format "%4d "] 9]) (defalias 'rmail-make-basic-summary-line #[nil "ebˆŠÀÁÂÃ#„Ä‚OÀŊˆ`)Ã#ƒ/ÆÇÈɔɕ{!ʔʕ{#‚OÀˊˆ`)Ã#ƒNÆÇÈʔʕ{!ɔɕ{#‚OÌ)ÍŠÀÎÂÃ#„^Ï‚Ð`S`ÒyˆÓÔ!„dÕuˆÖÂxˆ`){!ÂÂÂÛÜÝÞ !ßQ\"ƒ®ŠebˆÀàÂÃ#ƒ­áÐ`ˆÖÂxˆ`{!P)GÛâ\"ÆãƒÈäXƒÕåäZ]ÂO‚æZåWƒäå‚ùç\\WƒõäZ‚ùæZ‰ä\\^O\",)èÀéÂÃ#ƒÖÂwˆ`ˆ`{‚)ÀêÂÃ#ˆ`ˆ`{ë°‡" [re-search-forward "^Date:" nil t " " "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- _]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)" format "%2d-%3s" string-to-int 2 4 "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z _]*\\)\\([0-9][0-9]?\\)" "??????" " " "^From:[ ]*" " " mail-strip-quoted-names opoint 1 looking-at "[ ]" -1 " " from len mch lo string-match "^" regexp-quote user-login-name "\\($\\|@\\)" "^To:[ ]*" "to: " "[@%]" "%25s" 25 0 14 11 " #" "^Subject:" "[\n][\n]+" "\n"] 9]) (defalias 'rmail-summary-next-all #[(&optional number) "ƒ‚ ÁyˆmƒÂVƒÃyˆÄ !‡" [number 1 0 -1 display-buffer rmail-buffer] 2 nil "p"]) (defalias 'rmail-summary-previous-all #[(&optional number) "ƒ‚ Á[yˆmƒÂWƒÃyˆÄ !‡" [number 1 0 -1 display-buffer rmail-buffer] 2 nil "p"]) #@171 Display next non-deleted msg from rmail file. With optional prefix argument NUMBER, moves forward this number of non-deleted messages, or backward if NUMBER is negative. (defalias 'rmail-summary-next-msg #[(&optional number) "Àyˆ ÀVƒ\fˆ ÀWƒ [‚ ÀVƒ\"Â#ĉÀVƒGÈÂÉ#†9 ‰ƒGS‰‚*+ÀyˆÊ !‡" [0 number nil re-search-forward re-search-backward non-del-msg-found search count "^....[^D]" t display-buffer rmail-buffer] 5 (#$ . 7547) "p"]) (defalias 'rmail-summary-previous-msg #[(&optional number) "À ƒ ‚\nÂ[!‡" [rmail-summary-next-msg number 1] 2 nil "p"]) #@129 Show next message with LABEL. Defaults to last labels used. With prefix argument N moves forward N messages with these labels. (defalias 'rmail-summary-next-labeled-message #[(n labels) "ŠqˆÁ\n \")‡" [rmail-buffer rmail-next-labeled-message n labels] 3 (#$ . 8131) "p\nsMove to next msg with labels: "]) #@134 Show previous message with LABEL. Defaults to last labels used. With prefix argument N moves backward N messages with these labels. (defalias 'rmail-summary-previous-labeled-message #[(n labels) "ŠqˆÁ\n \")‡" [rmail-buffer rmail-previous-labeled-message n labels] 3 (#$ . 8444) "p\nsMove to previous msg with labels: "]) #@137 Go to the next message in the summary having the same subject. With prefix argument N, do this N times. If N is negative, go backwards. (defalias 'rmail-summary-next-same-subject #[(n) "À‰‰‰ ÂVŠqˆÉÊ!ËÌ!ÍQ)ÏÐ\"ƒ5•ÀOŠ ÂU„¼ ƒEm?‚Go?ƒ¼À„¤ ƒ[m?‚]o?ƒ¤ ƒhÒ‚iÓyˆÔ`d`Õ\\^{!ŠqˆŒ~ˆÖ !bˆ×Ø!ˆ`À×Û!ˆ`bˆÜÝ#,‚Mƒ« ) ƒµ S‚· T‰‚7)\fƒÇÞ\f!‚Óßà ƒÑá‚Òâ\"-‡" [nil n 0 forward found i search-regexp subject rmail-buffer mail-fetch-field "Subject" "^Subject: *\\(Re: *\\)?" regexp-quote "\n" rmail-current-message string-match "Re:[ ]*" done 1 -1 string-to-int 5 rmail-msgbeg search-forward "\n*** EOOH ***\n" end beg "\n\n" re-search-forward t rmail-summary-goto-msg error "No %s message with same subject" "following" "previous"] 7 (#$ . 8774) "p"]) #@148 Go to the previous message in the summary having the same subject. With prefix argument N, do this N times. If N is negative, go forwards instead. (defalias 'rmail-summary-previous-same-subject #[(n) "À [!‡" [rmail-summary-next-same-subject n] 2 (#$ . 9579) "p"]) #@181 Delete this message and move to next nondeleted one. Deleted messages stay in the file until the \[rmail-expunge] command is given. With prefix argument, delete and move backward. (defalias 'rmail-summary-delete-forward #[(&optional backward) "À ˆÃ\f!ˆÅ ˆÃ!ˆÉ!ˆ\nƒ#o‚$m„AŠËyˆÌÍ!)ƒA\nƒ;΂<Ïyˆ‚m…M\n?…MÎy*‡" [nil end rmail-summary-goto-msg pop-to-buffer rmail-buffer rmail-delete-message rmail-current-message del-msg rmail-summary-buffer rmail-summary-mark-deleted backward 0 looking-at " *[0-9]+D" -1 1] 2 (#$ . 9850) "P"]) #@137 Delete this message and move to previous nondeleted one. Deleted messages stay in the file until the \[rmail-expunge] command is given. (defalias 'rmail-summary-delete-backward #[nil "ÀÁ!‡" [rmail-summary-delete-forward t] 2 (#$ . 10404) nil]) (defalias 'rmail-summary-mark-deleted #[(&optional n undel) "ƒ\nÁ‰#ˆm„=Ã\fÅ\"ƒ=ÆÈÆwˆÉÆwˆ\nƒ5ËÌ!ƒ<ÍÎ!ˆÈcˆ‚<ÍÎ!ˆÌcˆ)ÏyˆÆ‡" [n rmail-summary-goto-msg t overlay-get rmail-summary-overlay face nil buffer-read-only " " "[0-9]" undel looking-at "D" delete-char 1 0] 4]) (defalias 'rmail-summary-mark-undeleted #[(n) "À Â\"‡" [rmail-summary-mark-deleted n t] 3]) (defalias 'rmail-summary-deleted-p #[(&optional n) "Šƒ ÁÂÃ#ˆÄÂwˆÅÂwˆÆÇ!)‡" [n rmail-summary-goto-msg nil t " " "[0-9]" looking-at "D"] 4]) #@85 Undelete current message. Optional prefix ARG means undelete ARG previous messages. (defalias 'rmail-summary-undelete #[(&optional arg) "ÁU„\nÂ!‡Ã`ÈÆÇÃÈ#ƒ6ÉÊ!ˆË ˆÌ !ˆÎ!ƒ/Ð ˆÌ!‚8\fb*‡" [arg 1 rmail-summary-undelete-many nil opoint buffer-read-only re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" t replace-match "\\1 " rmail-summary-goto-msg pop-to-buffer rmail-buffer rmail-message-deleted-p rmail-current-message rmail-undelete-previous-message rmail-summary-buffer] 4 (#$ . 11163) "p"]) #@78 Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs. (defalias 'rmail-summary-undelete-many #[(&optional n) "Šqˆ ƒ\f\n‚ ‰ † Å\nÅVƒ= Wƒ=Ç\n!ƒ6ÈÉÊ\"ˆT\nS‰‚ qˆ\fÅ\nÅVƒi WƒiÌ\n!ƒbÍ\n!ˆT\nS‰‚G,Î )‡" [rmail-buffer n rmail-current-message rmail-total-messages init-msg 0 msgs-undeled rmail-message-deleted-p rmail-set-attribute "deleted" nil rmail-summary-buffer rmail-summary-deleted-p rmail-summary-mark-undeleted rmail-summary-goto-msg] 4 (#$ . 11669) "P"]) (put (quote rmail-summary-mode) (quote mode-class) (quote special)) #@951 Rmail Summary Mode is invoked from Rmail Mode by using \\[rmail-summary]. As commands are issued in the summary buffer, they are applied to the corresponding mail messages in the rmail buffer. All normal editing commands are turned off. Instead, nearly all the Rmail mode commands are available, though many of them move only among the messages in the summary. These additional commands exist: \[rmail-summary-undelete-many] Undelete all or prefix arg deleted messages. \[rmail-summary-wipe] Delete the summary and go to the Rmail buffer. Commands for sorting the summary: \[rmail-summary-sort-by-date] Sort by date. \[rmail-summary-sort-by-subject] Sort by subject. \[rmail-summary-sort-by-author] Sort by author. \[rmail-summary-sort-by-recipient] Sort by recipient. \[rmail-summary-sort-by-correspondent] Sort by correspondent. \[rmail-summary-sort-by-lines] Sort by lines. \[rmail-summary-sort-by-keywords] Sort by keywords. (defalias 'rmail-summary-mode #[nil "À ˆÁÃÅÅÈ !ˆÊË!ˆÊÌ!ˆÊÍ!ˆÎ ÊÏ!ˆÎÊÐ!ˆÊÑ!ˆÊÒ!ˆÓÔ ˆÕÖ!‡" [kill-all-local-variables rmail-summary-mode major-mode "RMAIL Summary" mode-name t truncate-lines buffer-read-only set-syntax-table text-mode-syntax-table make-local-variable rmail-buffer rmail-total-messages rmail-current-message nil rmail-summary-redo revert-buffer-function post-command-hook font-lock-defaults (rmail-summary-font-lock-keywords t) rmail-summary-enable run-hooks rmail-summary-mode-hook] 2 (#$ . 12260) nil]) (defalias 'rmail-summary-disable #[nil "À !ˆÂÃÄ\"ˆÅ‰‡" [use-local-map text-mode-map remove-hook post-command-hook rmail-summary-rmail-update nil revert-buffer-function] 3]) (defalias 'rmail-summary-enable #[nil "À !ˆÂÃÄ\"ˆÅ‰‡" [use-local-map rmail-summary-mode-map add-hook post-command-hook rmail-summary-rmail-update rmail-update-summary revert-buffer-function] 3]) (defalias 'rmail-summary-rmail-update #[nil "ÀŠmƒ\nÂyˆÃyˆÄÀwˆÅ`ÆÀwˆ`{!=„iÉ\n!Ë \f gÎUƒ?ÏÐ!ˆÄcˆ ƒUÑŽÒ !ˆÓÔ\"ˆ)‚hÕ\n!ƒhŠ\nqˆÓÔ\"ˆ)*ÖÀ!+‡" [nil buffer-read-only -1 0 " " string-to-int "0-9" msg-num rmail-current-message get-buffer-window rmail-buffer selected-window owin window 45 delete-char 1 ((select-window owin)) select-window rmail-show-message t buffer-name rmail-summary-update-highlight] 4]) (byte-code "ÀÁ!„ÂÁ B „ŸÄ Å !ˆÆ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÌ#ˆÆ ÍÎ#ˆÆ ÏÐ#ˆÆ ÑÒ#ˆÆ ÓÔ#ˆÆ ÕÖ#ˆÆ ×Ø#ˆÆ ÙÚ#ˆÆ ÛÜ#ˆÆ ÝÞ#ˆÆ ßÖ#ˆÆ àÞ#ˆÆ áâ#ˆÆ ãä#ˆÆ åæ#ˆÆ çè#ˆÆ éê#ˆÆ ëì#ˆÆ íî#ˆÆ ïð#ˆÆ ñò#ˆÆ óô#ˆÆ õö#ˆÆ ÷ø#ˆÆ ùú#ˆÆ ûü#ˆÆ ýþ#ˆÆ ÿ@#ˆÆ AB#ˆÆ CD#ˆÆ EF#ˆÆ GH#ˆÆ IJ#ˆÆ KL#ˆÆ MN#ˆÆ OP#ˆÆ QR#ˆÆ ST#ˆÆ UV#ˆÆ WX#ˆÆ YZ#ˆÆ [\\#ˆÆ ]^#ˆÆ _`#ˆÆ ab#ˆÆ cd#ˆÆ ef#ˆÆ gh#ˆÆ ij#ˆÆ kl #ˆÆ mnln!B#ˆÆ op#ˆÆ qr#ˆÆ st#ˆÆ uv#ˆÆ wx#ˆÆ yz#ˆÆ {|#ˆÆ }~#ˆÆ €l€!B#ˆÆ ‚#ˆÆ ƒ„#ˆÆ …†#ˆÆ ‡ˆ#ˆÆ ‰Š#ˆÆ ‹ŒlŒ!B#ˆÆ Ž#ˆÆ #ˆÆ ‘’#ˆÆ “”#ˆÆ •–#ˆÆ —˜#ˆÆ ™š#ˆÆ ›œ#ˆÆ žlž!B#ˆÆ Ÿ #ˆÆ ¡¢#ˆÆ £¤#ˆÆ ¥¦#ˆÆ §¨l¨!B#ˆÆ ©ª#ˆÆ «¬#ˆÆ ­®#ˆÆ ¯°#ˆÆ ±²#ˆÆ ³´#ˆÆ µ¶#ˆÆ ·¸#ˆÀ¹!„Y¹¹ Bº¹»¼#‡" [boundp rmail-summary-mode-map nil current-load-list make-keymap suppress-keymap define-key "a" rmail-summary-add-label "c" rmail-summary-continue "d" rmail-summary-delete-forward "" rmail-summary-delete-backward "e" rmail-summary-edit-current-message "f" rmail-summary-forward "g" rmail-summary-get-new-mail "h" rmail-summary "i" rmail-summary-input "j" rmail-summary-goto-msg "k" rmail-summary-kill-label "l" rmail-summary-by-labels "" "\f" "" rmail-summary-by-recipients "" rmail-summary-by-regexp "" rmail-summary-by-topic "m" rmail-summary-mail "í" rmail-summary-retry-failure "n" rmail-summary-next-msg "n" rmail-summary-next-all "" rmail-summary-next-labeled-message "o" rmail-summary-output-to-rmail-file "" rmail-summary-output "p" rmail-summary-previous-msg "p" rmail-summary-previous-all "" rmail-summary-previous-labeled-message "q" rmail-summary-quit "r" rmail-summary-reply "s" rmail-summary-expunge-and-save "s" rmail-summary-search "t" rmail-summary-toggle-header "u" rmail-summary-undelete "õ" rmail-summary-undelete-many "w" rmail-summary-wipe "x" rmail-summary-expunge "." rmail-summary-beginning-of-message "<" rmail-summary-first-message ">" rmail-summary-last-message " " rmail-summary-scroll-msg-up "" rmail-summary-scroll-msg-down "?" describe-mode "" rmail-summary-next-same-subject "" rmail-summary-previous-same-subject "" rmail-summary-sort-by-date "" rmail-summary-sort-by-subject "" rmail-summary-sort-by-author "" rmail-summary-sort-by-recipient "" rmail-summary-sort-by-correspondent "\f" rmail-summary-sort-by-lines " " rmail-summary-sort-by-keywords [menu-bar] make-sparse-keymap [menu-bar classify] "Classify" [menu-bar classify output-menu] ("Output (Rmail Menu)..." . rmail-summary-output-menu) [menu-bar classify input-menu] ("Input Rmail File (menu)..." . rmail-input-menu) [menu-bar classify input-menu] (nil) [menu-bar classify output-menu] (nil) [menu-bar classify output-inbox] ("Output (inbox)..." . rmail-summary-output) [menu-bar classify output] ("Output (Rmail)..." . rmail-summary-output-to-rmail-file) [menu-bar classify kill-label] ("Kill Label..." . rmail-summary-kill-label) [menu-bar classify add-label] ("Add Label..." . rmail-summary-add-label) [menu-bar summary] "Summary" [menu-bar summary labels] ("By Labels..." . rmail-summary-by-labels) [menu-bar summary recipients] ("By Recipients..." . rmail-summary-by-recipients) [menu-bar summary topic] ("By Topic..." . rmail-summary-by-topic) [menu-bar summary regexp] ("By Regexp..." . rmail-summary-by-regexp) [menu-bar summary all] ("All" . rmail-summary) [menu-bar mail] "Mail" [menu-bar mail rmail-summary-get-new-mail] ("Get New Mail" . rmail-summary-get-new-mail) [menu-bar mail lambda] ("----") [menu-bar mail continue] ("Continue" . rmail-summary-continue) [menu-bar mail resend] ("Re-send..." . rmail-summary-resend) [menu-bar mail forward] ("Forward" . rmail-summary-forward) [menu-bar mail retry] ("Retry" . rmail-summary-retry-failure) [menu-bar mail reply] ("Reply" . rmail-summary-reply) [menu-bar mail mail] ("Mail" . rmail-summary-mail) [menu-bar delete] "Delete" [menu-bar delete expunge/save] ("Expunge/Save" . rmail-summary-expunge-and-save) [menu-bar delete expunge] ("Expunge" . rmail-summary-expunge) [menu-bar delete undelete] ("Undelete" . rmail-summary-undelete) [menu-bar delete delete] ("Delete" . rmail-summary-delete-forward) [menu-bar move] "Move" [menu-bar move search-back] ("Search Back..." . rmail-summary-search-backward) [menu-bar move search] ("Search..." . rmail-summary-search) [menu-bar move previous] ("Previous Nondeleted" . rmail-summary-previous-msg) [menu-bar move next] ("Next Nondeleted" . rmail-summary-next-msg) [menu-bar move last] ("Last" . rmail-summary-last-message) [menu-bar move first] ("First" . rmail-summary-first-message) [menu-bar move previous] ("Previous" . rmail-summary-previous-all) [menu-bar move next] ("Next" . rmail-summary-next-all) rmail-summary-overlay put permanent-local t] 6) (defalias 'rmail-summary-goto-msg #[(&optional n nowarn skip-rmail) ":ƒ Á!mƒÂyˆÃyˆp `È Ê`d`Ë\\^{!\fŠqˆ )„=\f‚|ÏWƒIÐÑ!ˆÏVƒZÐÒ!ˆdbˆÓ ˆebˆÔÕÖ\"È×#„|„rÐÙ\"ˆ\f× bˆÃyˆÚÈwˆÛÈwˆŠgÜUƒ™ÈÞÏ!ˆÚcˆ))ß !ˆÃyˆ ?…·á \"ãŽä!ˆå!*.‡" [n prefix-numeric-value -1 0 obuf rmail-buffer buf cur nil message-not-found string-to-int 5 curmsg rmail-total-messages total 1 message "No preceding message" "No following message" rmail-summary-goto-msg re-search-forward format "^%4d[^0-9]" t nowarn "Message %d not found" " " "0-9" 45 buffer-read-only delete-char rmail-summary-update-highlight skip-rmail selected-window selwin ((byte-code "À !ˆ\nq‡" [select-window selwin obuf] 2)) pop-to-buffer rmail-show-message] 5 nil "P"]) (defalias 'rmail-summary-update-highlight #[(not-found) "„ ÁÀ!ˆÂ``\" ƒÄÅÆ#‡ÇŠÈyˆÉÆwˆ`)ŠÆˆ`)#ˆÄÅÊ#‡" [rmail-summary-overlay make-local-variable make-overlay not-found overlay-put face nil move-overlay 0 " " highlight] 4]) #@119 Scroll the Rmail window forward. If the Rmail window is displaying the end of a message, advance to the next message. (defalias 'rmail-summary-scroll-msg-up #[(&optional dist) "Á=ƒ\nÂÃ!‡Ä !‰ƒLÇ É!ˆŠÊÇ ! Ì ÍZ!ˆÃˆm*É!ˆ)ƒBΆ>Ï!‚T Ñ!)‚TÒ !ˆÃ‰)‡" [dist - rmail-summary-scroll-msg-down nil get-buffer-window rmail-buffer rmail-buffer-window selected-window rmail-summary-window select-window window-height ht move-to-window-line 2 rmail-summary-next-msg 1 other-window-scroll-buffer scroll-other-window display-buffer rmail-current-message] 4 (#$ . 20414) "P"]) #@130 Scroll the Rmail window backward. If the Rmail window is displaying the beginning of a message, advance to the previous message. (defalias 'rmail-summary-scroll-msg-down #[(&optional dist) "Á=ƒ\nÂÃ!‡Ä !‰ƒCÇ É!ˆŠÊË!ˆËyˆo)É!ˆ)ƒ9̆5Í!‚K Ï!)‚KÐ !ˆÃ‰)‡" [dist - rmail-summary-scroll-msg-up nil get-buffer-window rmail-buffer rmail-buffer-window selected-window rmail-summary-window select-window move-to-window-line 0 rmail-summary-previous-msg 1 other-window-scroll-buffer scroll-other-window-down display-buffer rmail-current-message] 4 (#$ . 21001) "P"]) #@42 Show current message from the beginning. (defalias 'rmail-summary-beginning-of-message #[nil "À !ˆÂ ˆÀ !‡" [pop-to-buffer rmail-buffer beginning-of-buffer rmail-summary-buffer] 2 (#$ . 21581) nil]) #@38 Quit out of Rmail and Rmail summary. (defalias 'rmail-summary-quit #[nil "À ˆÁ ‡" [rmail-summary-wipe rmail-quit] 1 (#$ . 21785) nil]) #@59 Kill and wipe away Rmail summary, remaining within Rmail. (defalias 'rmail-summary-wipe #[nil "ŠqˆÁ)Äp!ˆÅ ÆÁÇ\"=„È ˆÉ !)‡" [rmail-buffer nil rmail-summary-buffer local-rmail-buffer kill-buffer selected-window next-window no-minibuf delete-window pop-to-buffer] 4 (#$ . 21926) nil]) #@68 Actually erase all deleted messages and recompute summary headers. (defalias 'rmail-summary-expunge #[nil "ŠqˆÁ ˆ) ‡" [rmail-buffer rmail-only-expunge rmail-update-summary] 1 (#$ . 22220) nil]) #@30 Expunge and save RMAIL file. (defalias 'rmail-summary-expunge-and-save #[nil "ŠqˆÁ ˆ) ˆŠqˆÃ ˆ)ÄÅ!‡" [rmail-buffer rmail-only-expunge rmail-update-summary save-buffer set-buffer-modified-p nil] 2 (#$ . 22422) nil]) #@45 Get new mail and recompute summary headers. (defalias 'rmail-summary-get-new-mail #[nil "ÀŠ\nqˆÃ ˆ\f)Å !)‡" [nil msg rmail-buffer rmail-get-new-mail rmail-current-message rmail-summary-goto-msg] 2 (#$ . 22645) nil]) #@29 Run Rmail on file FILENAME. (defalias 'rmail-summary-input #[(filename) "À !ˆÂ !‡" [pop-to-buffer rmail-buffer rmail filename] 2 (#$ . 22869) "FRun rmail on RMAIL file: "]) #@55 Show first message in Rmail file from summary buffer. (defalias 'rmail-summary-first-message #[nil "À ‡" [beginning-of-buffer] 1 (#$ . 23048) nil]) #@54 Show last message in Rmail file from summary buffer. (defalias 'rmail-summary-last-message #[nil "À ˆÁy‡" [end-of-buffer -1] 1 (#$ . 23202) nil]) (byte-code "ÀÁ!„ÂÁ B „!Ä ¤Æ ÇÈ#ˆÆ ÉÊ#ˆÂ‡" [boundp rmail-summary-edit-map nil current-load-list make-sparse-keymap text-mode-map define-key "" rmail-cease-edit "" rmail-abort-edit] 4) #@36 Edit the contents of this message. (defalias 'rmail-summary-edit-current-message #[nil "À !ˆÂ ˆÃ\f!‡" [pop-to-buffer rmail-buffer rmail-edit-current-message use-local-map rmail-summary-edit-map] 2 (#$ . 23548) nil]) #@63 Finish editing message, then go back to Rmail summary buffer. (defalias 'rmail-summary-cease-edit #[nil "À ˆÁ\n!‡" [rmail-cease-edit pop-to-buffer rmail-summary-buffer] 2 (#$ . 23770) nil]) #@86 Abort edit of current message; restore original contents. Go back to summary buffer. (defalias 'rmail-summary-abort-edit #[nil "À ˆÁ\n!‡" [rmail-abort-edit pop-to-buffer rmail-summary-buffer] 2 (#$ . 23966) nil]) #@221 Show message containing next match for REGEXP. Prefix argument gives repeat count; negative argument means search backwards (through earlier messages). Interactively, empty argument means use same regexp used last time. (defalias 'rmail-summary-search-backward #[(regexp &optional n) "pÁŽ\nqˆÃ\f [\"*‡" [buffer ((set-buffer buffer)) rmail-buffer rmail-search regexp n] 3 (#$ . 24186) (byte-code "À !ÂY‰ƒÄ‚ÅÆPÈ \nƒ$Ë\nÌRÍ!‰ Åš„7 \n‚@\n„@ÎÏ!ˆ\nÀ !+D‡" [prefix-numeric-value current-prefix-arg 0 reversep "Reverse " "" "Rmail search (regexp): " prompt nil regexp rmail-search-last-regexp "(default " ") " read-string error "No previous Rmail search string"] 5)]) #@221 Show message containing next match for REGEXP. Prefix argument gives repeat count; negative argument means search backwards (through earlier messages). Interactively, empty argument means use same regexp used last time. (defalias 'rmail-summary-search #[(regexp &optional n) "pÁŽ\nqˆÃ\f \"*‡" [buffer ((set-buffer buffer)) rmail-buffer rmail-search regexp n] 3 (#$ . 24879) (byte-code "À !ÂW‰ƒÄ‚ÅÆPÈ \nƒ$Ë\nÌRÍ!‰ Åš„7 \n‚@\n„@ÎÏ!ˆ\nÀ !+D‡" [prefix-numeric-value current-prefix-arg 0 reversep "Reverse " "" "Rmail search (regexp): " prompt nil regexp rmail-search-last-regexp "(default " ") " read-string error "No previous Rmail search string"] 5)]) #@79 Show original message header if pruned header currently shown, or vice versa. (defalias 'rmail-summary-toggle-header #[nil "ŠqˆÁ ˆ)Â!‰…Ä ÆŽÇ !ˆeb*)‡" [rmail-buffer rmail-toggle-header get-buffer-window window selected-window owin ((select-window owin)) select-window] 3 (#$ . 25561) nil]) #@116 Add LABEL to labels associated with current Rmail message. Completion is performed over known labels when reading. (defalias 'rmail-summary-add-label #[(label) "ŠqˆÁ\n!)‡" [rmail-buffer rmail-add-label label] 2 (#$ . 25863) (list (save-excursion (set-buffer rmail-buffer) (rmail-read-label "Add label")))]) #@121 Remove LABEL from labels associated with current Rmail message. Completion is performed over known labels when reading. (defalias 'rmail-summary-kill-label #[(label) "ŠqˆÁ\nÃ\")‡" [rmail-buffer rmail-set-label label nil] 3 (#$ . 26178) (list (save-excursion (set-buffer rmail-buffer) (rmail-read-label "Kill label")))]) #@123 Send mail in another window. While composing the message, use \[mail-yank-original] to yank the original message into it. (defalias 'rmail-summary-mail #[nil "À !‰ƒÃ\n!ˆ‚ qˆ)Äʼn‰‰‰p&ˆÆÇÈ !!ˆÉÈ ÊË#‡" [get-buffer-window rmail-buffer window select-window rmail-start-mail nil use-local-map copy-keymap current-local-map define-key "" rmail-summary-send-and-exit] 8 (#$ . 26506) nil]) #@64 Continue composing outgoing message previously being composed. (defalias 'rmail-summary-continue #[nil "À !‰ƒÃ\n!ˆ‚ qˆ)ÄÅ!‡" [get-buffer-window rmail-buffer window select-window rmail-start-mail t] 3 (#$ . 26901) nil]) #@224 Reply to the current message. Normally include CC: to all other recipients of original message; prefix argument means ignore them. While composing the reply, use \[mail-yank-original] to yank the original message into it. (defalias 'rmail-summary-reply #[(just-sender) "À !‰ƒÃ\n!ˆ‚ qˆ)Ä !ˆÆÇÈ !!ˆÉÈ ÊË#‡" [get-buffer-window rmail-buffer window select-window rmail-reply just-sender use-local-map copy-keymap current-local-map define-key "" rmail-summary-send-and-exit] 5 (#$ . 27132) "P"]) #@225 Edit a mail message which is based on the contents of the current message. For a message rejected by the mail system, extract the interesting headers and the body of the original message; otherwise copy the current message. (defalias 'rmail-summary-retry-failure #[nil "À !‰ƒÃ\n!ˆ‚ qˆ)Ä ˆÅÆÇ !!ˆÈÇ ÉÊ#‡" [get-buffer-window rmail-buffer window select-window rmail-retry-failure use-local-map copy-keymap current-local-map define-key "" rmail-summary-send-and-exit] 5 (#$ . 27637) nil]) #@47 Send mail reply and return to summary buffer. (defalias 'rmail-summary-send-and-exit #[nil "ÀÁ!‡" [mail-send-and-exit t] 2 (#$ . 28135) nil]) #@156 Forward the current message to another user. With prefix argument, "resend" the message instead of forwarding it; see the documentation of `rmail-resend'. (defalias 'rmail-summary-forward #[(resend) "ŠÀ !‰ƒÃ\n!ˆ‚ qˆ)Ä !ˆÆÇÈ !!ˆÉÈ ÊË#)‡" [get-buffer-window rmail-buffer window select-window rmail-forward resend use-local-map copy-keymap current-local-map define-key "" rmail-summary-send-and-exit] 5 (#$ . 28284) "P"]) #@46 Resend current message using 'rmail-resend'. (defalias 'rmail-summary-resend #[nil "ŠÀ !‰ƒÃ\n!ˆ‚ qˆ)ÄÅ!)‡" [get-buffer-window rmail-buffer window select-window call-interactively rmail-resend] 3 (#$ . 28716) nil]) #@209 Append the current message to an Rmail file named FILE-NAME. If the file does not exist, ask if it should be created. If file is being visited, the message is appended to the Emacs buffer visiting that file. (defalias 'rmail-summary-output-to-rmail-file #[(&optional file-name) "ŠqˆÁ ƒÄ !ˆ‚ÅÄ!ˆ*\n…ÆÁ!‡" [rmail-buffer nil rmail-delete-after-output file-name rmail-output-to-rmail-file call-interactively rmail-summary-delete-forward] 2 (#$ . 28942) nil]) #@269 Output current message to another Rmail file, chosen with a menu. Also set the default for subsequent \[rmail-output-to-rmail-file] commands. The variables `rmail-secondary-file-directory' and `rmail-secondary-file-regexp' control which files are offered in the menu. (defalias 'rmail-summary-output-menu #[nil "ŠqˆÁÃÄ!ˆ*\n…ÅÁ!‡" [rmail-buffer nil rmail-delete-after-output call-interactively rmail-output-menu rmail-summary-delete-forward] 2 (#$ . 29412) nil]) #@56 Append this message to Unix mail file named FILE-NAME. (defalias 'rmail-summary-output #[nil "ŠqˆÁÃÄ!ˆ*\n…ÅÁ!‡" [rmail-buffer nil rmail-delete-after-output call-interactively rmail-output rmail-summary-delete-forward] 2 (#$ . 29884) nil]) (defalias 'rmail-summary-construct-io-menu #[nil "À !‰ƒ\"Ã\fÅÆÇÆ\nÈ#B#ˆÃ\fÉÊÇÊ\nË#B#‚-Ã\fÌÍ#ˆÃ\fÎÏ#)‡" [rmail-find-all-files rmail-secondary-file-directory files define-key rmail-summary-mode-map [menu-bar classify input-menu] "Input Rmail File" rmail-list-to-menu rmail-summary-input [menu-bar classify output-menu] "Output Rmail File" rmail-summary-output-to-rmail-file [menu-bar classify input-menu] ("Input Rmail File" . rmail-disable-menu) [menu-bar classify output-menu] ("Output Rmail File" . rmail-disable-menu)] 9]) #@116 Sort messages of current Rmail summary by date. If prefix argument REVERSE is non-nil, sort them in reverse order. (defalias 'rmail-summary-sort-by-date #[(reverse) "ÀÁ\n\"‡" [rmail-sort-from-summary rmail-sort-by-date reverse] 3 (#$ . 30662) "P"]) #@119 Sort messages of current Rmail summary by subject. If prefix argument REVERSE is non-nil, sort them in reverse order. (defalias 'rmail-summary-sort-by-subject #[(reverse) "ÀÁ\n\"‡" [rmail-sort-from-summary rmail-sort-by-subject reverse] 3 (#$ . 30918) "P"]) #@118 Sort messages of current Rmail summary by author. If prefix argument REVERSE is non-nil, sort them in reverse order. (defalias 'rmail-summary-sort-by-author #[(reverse) "ÀÁ\n\"‡" [rmail-sort-from-summary rmail-sort-by-author reverse] 3 (#$ . 31183) "P"]) #@121 Sort messages of current Rmail summary by recipient. If prefix argument REVERSE is non-nil, sort them in reverse order. (defalias 'rmail-summary-sort-by-recipient #[(reverse) "ÀÁ\n\"‡" [rmail-sort-from-summary rmail-sort-by-recipient reverse] 3 (#$ . 31445) "P"]) #@131 Sort messages of current Rmail summary by other correspondent. If prefix argument REVERSE is non-nil, sort them in reverse order. (defalias 'rmail-summary-sort-by-correspondent #[(reverse) "ÀÁ\n\"‡" [rmail-sort-from-summary rmail-sort-by-correspondent reverse] 3 (#$ . 31716) "P"]) #@132 Sort messages of current Rmail summary by lines of the message. If prefix argument REVERSE is non-nil, sort them in reverse order. (defalias 'rmail-summary-sort-by-lines #[(reverse) "ÀÁ\n\"‡" [rmail-sort-from-summary rmail-sort-by-lines reverse] 3 (#$ . 32005) "P"]) #@166 Sort messages of current Rmail summary by keywords. If prefix argument REVERSE is non-nil, sort them in reverse order. KEYWORDS is a comma-separated list of labels. (defalias 'rmail-summary-sort-by-keywords #[(reverse labels) "ÀÁ\n\"‡" [rmail-sort-from-summary #[(reverse) "À \n\"‡" [rmail-sort-by-keywords reverse labels] 3] reverse] 3 (#$ . 32279) "P\nsSort by labels: "]) #@70 Sort Rmail messages from Summary buffer and update it after sorting. (defalias 'rmail-sort-from-summary #[(sortfun reverse) "ÀÁ!ˆÂ ÄŽÅ!ˆ!*‡" [require rmailsort selected-window selwin ((select-window selwin)) pop-to-buffer rmail-buffer sortfun reverse] 2 (#$ . 32660)]) emacs-19.30/lisp/rnews.elc100666 13437 1 55330 5744577250 14101 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:49:52 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/rnews.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/rnews.el' was compiled for Emacs 19")) (require (quote mail-utils)) #@56 Append this message to Unix mail file named FILE-NAME. (autoload (quote rmail-output) "rmailout" '(#$ . 508) t) #@151 Compose and post a reply to the current article on USENET. While composing the reply, use \[mail-yank-original] to yank the original message into it. (autoload (quote news-reply) "rnewspost" '(#$ . 627) t) #@123 Send mail in another window. While composing the message, use \[mail-yank-original] to yank the original message into it. (autoload (quote news-mail-other-window) "rnewspost" '(#$ . 840) t) #@55 Begin editing a new USENET news article to be posted. (autoload (quote news-post-news) "rnewspost" '(#$ . 1036) t) #@143 Mail a reply to the author of the current article. While composing the reply, use \[mail-yank-original] to yank the original message into it. (autoload (quote news-mail-reply) "rnewspost" '(#$ . 1158) t) #@149 Alist of (GROUP-REGEXP . HOOK) pairs. Just before displaying a message, each HOOK is called if its GROUP-REGEXP matches the current newsgroup name. (defvar news-group-hook-alist nil (#$ . 1369)) (byte-code "ÀÁ!„\nÂÃ!Á\fBÀ‡" [boundp rmail-last-file expand-file-name "~/mbox.news" current-load-list] 2) #@20 Contains ~/.newsrc (defvar news-startup-file "$HOME/.newsrc" (#$ . 1679)) #@24 Contains ~/.news-dates (defvar news-certification-file "$HOME/.news-dates" (#$ . 1759)) #@51 All random fields within the header of a message. (defvar news-ignored-headers "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:" (#$ . 1853)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÂÆ BÀÇ!„.ÂÇ BÀÈ!„;ÂÈ BÀÉ!„HÂ É B‡" [boundp news-mode-map nil current-load-list news-read-first-time-p t news-user-group-list news-current-news-group news-current-group-begin news-current-group-end] 2) #@99 An assoc list of a group name and the time at which it is known that the group had no new traffic (defvar news-current-certifications nil (#$ . 2421)) #@63 The time when the directory we are now working on was written (defvar news-current-certifiable nil (#$ . 2578)) #@89 User specifiable filter function that will be called during formatting of the news file (defvar news-message-filter nil (#$ . 2696)) #@91 Global variable in which we store the list of files associated with the current newsgroup (defvar news-list-of-files nil (#$ . 2835)) #@92 variable indicating we only are guessing at which files are available. Not currently used. (defvar news-list-of-files-possibly-bogus nil (#$ . 2975)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp news-group-article-assoc nil current-load-list] 2) #@26 Displayed Article Number (defvar news-current-message-number 0 (#$ . 3218)) #@31 Total no of messages in group (defvar news-total-current-group 0 (#$ . 3300)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp news-unsubscribe-groups nil current-load-list] 2) #@32 List of visited news messages. (defvar news-point-pdl nil (#$ . 3470)) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp news-no-jumps-p t current-load-list] 2) #@40 Buffer into which news files are read. (defvar news-buffer nil (#$ . 3623)) (defalias 'news-push '(macro . #[(item ref) "À  EE‡" [setq ref cons item] 5])) (defalias 'news-cadr '(macro . #[(x) "ÀÁ\nDD‡" [car cdr x] 3])) (defalias 'news-cdar '(macro . #[(x) "ÀÁ\nDD‡" [cdr car x] 3])) (defalias 'news-caddr '(macro . #[(x) "ÀÁ‰\nDDD‡" [car cdr x] 4])) (defalias 'news-cadar '(macro . #[(x) "ÀÁÀ\nDDD‡" [car cdr x] 4])) (defalias 'news-caadr '(macro . #[(x) "À‰Á\nDDD‡" [car cdr x] 4])) (defalias 'news-cdadr '(macro . #[(x) "ÀÁÀ\nDDD‡" [cdr car x] 4])) (defalias 'news-wins '(macro . #[(pfx index) "ÀÁ\nÃÄ DFD‡" [file-exists-p concat pfx "/" int-to-string index] 6])) #@189 * In an rnews directory, the maximum possible gap size. A gap is a sequence of missing messages between two messages that exist. An empty file does not contribute to a gap -- it ends one. (defvar news-max-plausible-gap 2 (#$ . -4298)) (defalias 'news-find-first-and-last #[(prefix base) "À ÂÃ\f!Q!…Å \fÆ#Å \fÇ#B‡" [file-exists-p prefix "/" int-to-string base news-find-first-or-last -1 1] 5]) (defalias 'news-/ '(macro . #[(a1 a2) "ÀÁ¥ÂUƒ Ã\f E‡ÆÇ\fÈBBÉÃÉ\fD EDÃ\f EF‡" [-1 2 0 / a1 a2 if < (0) -] 6])) (defalias 'news-find-first-or-last #[(pfx base dirn) " ÄÅ\\!Q!ƒ‰\\‚Ç¥‰Ç¥‰ÉU„F ÄÅ\\\\!Q!ƒ<\\Ç¥‰‚!)\n _‰ÉU„n ÄÅ\\\\!Q!„n Z‰‚NÉUƒ|\\‚‡Ë \\\\ #*‡" [dirn original-dir file-exists-p pfx "/" int-to-string base 2 offset 0 news-max-plausible-gap news-find-first-or-last] 8]) #@221 Read USENET news for groups for which you are a member and add or delete groups. You can reply to articles posted and send articles to any group. Type \[describe-mode] once reading news to get a list of rnews commands. (defalias 'rnews #[nil "À ÂÃ!ˆÄÅÆ!‰!ˆÈ ˆ  Ê Ì ˆÍ ÎÍ!ˆÏÐ!ˆÑÒ!ˆÓ ˆÔ ˆÕ )‡" [buffer-name last-buffer make-local-variable rmail-last-file switch-to-buffer get-buffer-create "*news*" news-buffer news-mode news-buffer-save nil buffer-read-only erase-buffer t set-buffer-modified-p sit-for 0 message "Getting new USENET news..." news-set-mode-line news-get-certifications news-get-new-news] 3 (#$ . 5138) nil]) (defalias 'news-group-certification #[(group) "À \n\"£‡" [assoc group news-current-certifications] 3]) (defalias 'news-set-current-certifiable #[nil "ÁÂÃ\f#PÆÇÈ !† !8‰ )‡" [news-path string-subst-char 47 46 news-current-news-group file 5 file-attributes file-symlink-p news-current-certifiable] 5]) (defalias 'news-get-certifications #[nil "ŠÀ‹)‡" [((byte-code "ÀÁ¢‰‡" [var (byte-code "À !Ã\n!Å\n!…Æ\fÇ\"ˆÈŽÉÊ !)*‡" [substitute-in-file-name news-certification-file file find-file-noselect buf file-exists-p switch-to-buffer norecord ((kill-buffer buf)) read-from-string buffer-string] 3) ((error)) news-current-certifications] 3))] 1]) (defalias 'news-write-certifications #[nil "ŠÀ‹)‡" [((byte-code "ÀÁ\n!‘ˆÃÀ!Å\f!ˆÆÇ!!ˆÉ\f!)‡" ["*CeRtIfIcAtIoNs*" print news-current-certifications get-buffer buf switch-to-buffer write-file substitute-in-file-name news-certification-file kill-buffer] 3))] 1]) (defalias 'news-set-current-group-certification #[nil "À \n\"‰ƒ \f¡‚ \fB\nB‰)‡" [assoc news-current-news-group news-current-certifications cgc news-current-certifiable] 4]) #@99 Creates a minor mode list that has group name, total articles, and attribute for current article. (defalias 'news-set-minor-modes #[nil "À Â Ä RBCÆÇ!† ‰‡" [foo news-current-message-number "/" news-total-current-group news-get-attribute-string news-minor-modes boundp minor-mode-alist minor-modes] 5 (#$ . 6865)]) #@132 Scan through current news-groups filelist to figure out how many messages are there. Set counters for use with minor mode display. (defalias 'news-set-message-counters #[nil "?…Á‰‡" [news-list-of-files 0 news-current-message-number] 2 (#$ . 7190)]) (byte-code "„­Á Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÃÐÑ#ˆÃÒÓ#ˆÃÔÓ#ˆÃÕÖ#ˆÃ×Ø#ˆÃÙÚ#ˆÃÛÜ#ˆÃÝÞ#ˆÃßà#ˆÃáâ#ˆÃãä#ˆÃåæ#ˆÃçè#ˆÃéê#ˆÃëì#ˆÃíî#ˆÃïð#ˆÃñò#ˆÃóô#ˆÃõö#ˆÃ÷ø#ˆÁ‡" [news-mode-map make-keymap suppress-keymap define-key "." beginning-of-buffer " " scroll-up "" scroll-down "n" news-next-message "c" news-make-link-to-message "p" news-previous-message "j" news-goto-message "q" news-exit "e" "j" news-goto-news-group "n" news-next-group "p" news-previous-group "l" news-list-news-groups "?" describe-mode "g" news-get-new-news "f" news-reply "m" news-mail-other-window "a" news-post-news "r" news-mail-reply "o" news-save-item-in-file "" rmail-output "t" news-show-all-headers "x" news-force-update "A" news-add-news-group "u" news-unsubscribe-current-group "U" news-unsubscribe-group "" news-caesar-buffer-body] 4) #@1641 News Mode is used by M-x rnews for reading USENET Newsgroups articles. New readers can find additional help in newsgroup: news.announce.newusers . All normal editing commands are turned off. Instead, these commands are available: . move point to front of this news article (same as Meta-<). Space scroll to next screen of this news article. Delete scroll down previous page of this news article. n move to next news article, possibly next group. p move to previous news article, possibly previous group. j jump to news article specified by numeric position. M-j jump to news group. M-n goto next news group. M-p goto previous news group. l list all the news groups with current status. ? print this help message. C-c C-r caesar rotate all letters by 13 places in the article's body (rot13). g get new USENET news. f post a reply article to USENET. a post an original news article. A add a newsgroup. o save the current article in the named file (append if file exists). C-o output this message to a Unix-format mail file (append it). c "copy" (actually link) current or prefix-arg msg to file. warning: target directory and message file must be on same device (UNIX magic) t show all the headers this news article originally had. q quit reading news after updating .newsrc file. e exit updating .newsrc file. m mail a news article. Same as C-x 4 m. x update last message seen to be the current message. r mail a reply to this news article. Like m but initializes some fields. u unsubscribe from current newsgroup. U unsubscribe from specified newsgroup. (defalias 'news-mode #[nil "À ˆÁÂ!ˆÃÁÄ!ˆÁÅ!ˆÆÁÇ!ˆÆÁÈ!ˆÁÉ!ˆÁÊ!ˆË\nÁÌ!ˆÍÏÑÓ ˆÔ!ˆÖ!ˆÚÛ!‡" [kill-all-local-variables make-local-variable news-read-first-time-p t news-current-news-group news-current-group-begin 0 news-current-message-number news-total-current-group news-buffer-save version-control never news-point-pdl news-mode major-mode (news-minor-modes) mode-line-process "NEWS" mode-name news-set-mode-line set-syntax-table text-mode-syntax-table use-local-map news-mode-map text-mode-abbrev-table local-abbrev-table run-hooks news-mode-hook] 2 (#$ . 8296) nil]) (defalias 'string-subst-char #[(new old string) "ÀÂÃ\f!! ÆÀOÇ\f \"‰ƒ Iˆ‚ ) ‡" [nil index regexp-quote char-to-string old string 0 string-match new] 3]) (defalias 'news-update-message-read '(macro . #[(ngroup nno) "ÀÁ ÄED E‡" [setcar news-cdadr assoc ngroup news-group-article-assoc nno] 5])) #@81 Parse string representing range of numbers of he form - to a list (a . b) (defalias 'news-parse-range #[(number-string) "ÀÁ\n\"‰ƒÄ\nÅ O!Ä\n TÆO!B‚!Ä\n!‰‰B)‡" [string-match "-" number-string n string-to-int 0 nil] 6 (#$ . 10830)]) #@60 Get new USENET news, if there is any for the current user. (defalias 'news-get-new-news #[nil "ƒÁ ˆÂÂÄÅ\"ˆÇ! ŠÊ !‰‰‰ \f ‰qˆÐbˆÑÒÂÓ#ƒˆ` Ðyˆ`ˆ`\f ÔZ{ Õ \f{!× \"ƒmÄØ \"ˆ‚„ B @AAED B)‚3Ù!ˆ.ŸÄÚ!ˆÛ!ˆƒ·Ý@Â\"„·A‰„¥„ÂÄÞ!‚ÅÄß!*‡" [news-user-group-list news-update-newsrc-file nil news-group-article-assoc message "Looking up %s file..." news-startup-file substitute-in-file-name temp-user-groups file find-file-noselect tem endofline end start newsrcbuf 0 search-forward ": " t 2 news-parse-range range assoc "You are subscribed twice to %s; I ignore second" kill-buffer "Prefrobnicating..." switch-to-buffer news-buffer news-read-files-into-buffer "No news is good news." ""] 6 (#$ . 11077) nil]) #@50 Display all the news groups to which you belong. (defalias 'news-list-news-groups #[nil "ÀŠ qˆÂcˆÃcˆ\fÅ…VÈ@ \"‰\n@cˆƒ-Ë‚.ÌjˆÍ\nA@A@!cˆƒEÎcˆ‚HÏjˆA?)‚+‘‡" ["*Newsgroups*" standard-output "News Group Msg No. News Group Msg No.\n" "------------------------- -------------------------\n" news-user-group-list nil flag temp assoc news-group-article-assoc item 52 20 int-to-string "\n" 33] 5 (#$ . 11854) nil]) #@43 Set mode line string to something useful. (defalias 'news-set-mode-line #[nil "À ¨ƒ\f !‚ ÃÄ ¨ƒ !‚ RÇÉʉËGZ]OQ\fÍÎ!ˆÏÊ!‡" [" " news-current-message-number int-to-string "??" "/" news-current-group-end mode-line-process "NEWS: " news-current-news-group " " 0 17 mode-line-buffer-identification set-buffer-modified-p t sit-for] 7 (#$ . 12321)]) #@45 Takes a string and goes to that news group. (defalias 'news-goto-news-group #[(gp) "ÀÁ\n\"ˆÃ\n!ˆÀÄ\n\"‡" [message "Jumping to news group %s..." gp news-select-news-group "Jumping to news group %s... done."] 3 (#$ . 12700) (list (completing-read "NewsGroup: " news-group-article-assoc))]) (defalias 'news-select-news-group #[(gp) "À \n\"‰„ÄÅ \"‚&À\n\"A@A@A ˆÈ @É\"ˆÊ )‡" [assoc gp news-group-article-assoc grp error "Group %s not subscribed to" news-current-news-group news-point-pdl news-read-files-into-buffer nil news-set-mode-line] 4]) #@47 Goes to the article ARG in current newsgroup. (defalias 'news-goto-message #[(arg) "„ ÁÂÃ\"Å\f!‡" [current-prefix-arg read-no-blanks-input "Go to article: " "" arg news-select-message] 3 (#$ . 13253) "p"]) (defalias 'news-select-message #[(arg) ";ƒ Á!\nÃÄÅ#ÇR @A\n>A@†#ËUƒ- @¡ˆ\fÍ!ƒEÎÐ!ˆÑ )‚LÑ ˆÒÓ\")‡" [arg string-to-int news-path string-subst-char 47 46 news-current-news-group "/" file news-point-pdl news-list-of-files 0 news-current-message-number file-exists-p nil buffer-read-only news-read-in-file news-set-mode-line error "Article %d nonexistent"] 5]) #@69 updates the position of last article read in the current news group (defalias 'news-force-update #[nil "@ ¡ˆÂà \"‡" [news-point-pdl news-current-message-number message "Updated to %d"] 3 (#$ . 13850) nil]) #@144 Move ARG messages forward within one newsgroup. Negative ARG moves backward. If ARG is 1 or -1, moves to next or previous newsgroup if at end. (defalias 'news-next-message #[(arg) " \\‰ W„\n\fVƒ/ÅUƒÆ ˆÇ ‚RÈUƒ)É ‚RÊË!‚RÌ  \"ÏWƒIÐ[SA@8!‚QÐS@8!))‡" [arg news-current-message-number no news-current-group-begin news-current-group-end 1 news-set-current-group-certification news-next-group -1 news-previous-group error "Article out of range" news-get-motion-lists news-list-of-files plist 0 news-select-message] 4 (#$ . 14064) "p"]) #@175 Move ARG messages backward in current newsgroup. With no arg or arg of 1, move one message and move to previous newsgroup if at beginning. A negative ARG means move forward. (defalias 'news-previous-message #[(arg) "À [!‡" [news-next-message arg] 2 (#$ . 14624) "p"]) #@56 Given arg move forward or backward to a new newsgroup. (defalias 'news-move-to-group #[(arg) " \"ÄÈWƒ&[SA@8‰„5ÉÊ!ˆ‚5@8‰„5ÉË!ˆÌ !+‡" [news-current-news-group cg news-get-motion-lists news-user-group-list nil ngrp plist arg 0 error "No previous news groups" "No more news groups" news-select-news-group] 3 (#$ . 14898)]) #@31 Moves to the next user group. (defalias 'news-next-group #[nil "ÀÁ!ˆ\n?…ÀÁ!ˆ‚‡" [news-move-to-group 0 news-list-of-files] 2 (#$ . 15246) nil]) #@35 Moves to the previous user group. (defalias 'news-previous-group #[nil "ÀÁ!ˆ\n?…ÀÁ!ˆ‚‡" [news-move-to-group -1 news-list-of-files] 2 (#$ . 15399) nil]) #@115 Given a msgnumber/group this will return a list of two lists; one for moving forward and one for moving backward. (defalias 'news-get-motion-lists #[(arg listy) "ÁÄÅ*‡" [listy nil result temp out (byte-code "…%@ šƒÂÃA\fCB\"ˆ‚@C\f¤A‰„Ň" [temp arg throw out result nil] 5)] 2 (#$ . 15562)]) (defalias 'news-read-in-file #[(filename) "À ˆ` !ˆÄ ˆ ‰ƒ0 bˆÇ@@\"ƒ'@A ˆA‰„) bˆÉyˆmƒAÊË!‚C b)‡" [erase-buffer start insert-file-contents filename news-convert-format news-group-hook-alist hooks string-match news-group-name 1 message "(Empty file?)"] 4]) (defalias 'news-convert-format #[nil "ŠŒ`ÁÂÃÁÁ\f…>\f}ˆbˆÇÈÁÉ#‰„8ƒ8bˆÇÊ!ˆËyˆÌ ˆÌ ˆÍ!ˆb.‡" [start nil (byte-code "ÀÁ!ˆ`‡" [search-forward "\n\n"] 2) ((error)) end has-from has-date search-forward "\nFrom:" t "\nDate:" 0 kill-line news-delete-headers] 5]) #@55 Redisplay current news item with all original headers (defalias 'news-show-all-headers #[nil "À‰à ˆÄ ˆÅÇÈÉ\n#ËÌ !R!*‡" [nil buffer-read-only news-ignored-headers erase-buffer news-set-mode-line news-read-in-file news-path string-subst-char 47 46 news-current-news-group "/" int-to-string news-current-message-number] 6 (#$ . 16420) nil]) (defalias 'news-delete-headers #[(pos) "bˆ ;…! ÃÄ#…!Åyˆ`ÂÆ!ˆÇuˆ`|ˆ‚‡" [pos news-ignored-headers re-search-forward nil t 0 "\n[^ ]" -1] 4]) #@56 Quit news reading session and update the .newsrc file. (defalias 'news-exit #[nil "ÀÁ!ƒ.ÂÃ\f\"ˆÅ ˆÆ ˆÂÇ\f\"ˆÂÈ!ˆÉÊ!ƒ$Êp!ˆË\f!ˆÍ‰‡ÂÏ!‡" [y-or-n-p "Do you really wanna quit reading news ? " message "Updating %s..." news-startup-file news-update-newsrc-file news-write-certifications "Updating %s... done" "Now do some real work" fboundp bury-buffer switch-to-buffer news-buffer-save nil news-user-group-list ""] 3 (#$ . 16916) nil]) #@49 Updates the .newsrc file in the users home dir. (defalias 'news-update-newsrc-file #[nil "ÀÁ\n!! ÄŠƒ!É\n\"A@A @A ˆqˆƒzÉ@\n\"‰A@A@ A@AA@U„qÌbˆÍ @ÎPÄÏ#ƒVÐÄ!ˆ‚` @ѱˆÒÓ!ˆÔ A@@!ÕÔ A@A@!±ˆA‰„*ƒ¸É@\n\"ÌbˆÍ @ÎPÄÏ#ƒ¯Ò×!ˆÐÄ!ˆØÔ A@@!ÕÔ A@A@!±ˆA‰„Ù ˆÚp!,‡" [find-file-noselect substitute-in-file-name news-startup-file news-user-group-list nil group tem newsrcbuf news-current-news-group assoc news-group-article-assoc news-point-pdl 0 search-forward ": " t kill-line ": \n" backward-char 1 int-to-string "-" news-unsubscribe-groups 2 "! " save-buffer kill-buffer] 6 (#$ . 17358)]) #@34 Removes you from newgroup GROUP. (defalias 'news-unsubscribe-group #[(group) "À !‡" [news-unsubscribe-internal group] 2 (#$ . 17980) (list (completing-read "Unsubscribe from group: " news-group-article-assoc))]) #@53 Removes you from the newsgroup you are now reading. (defalias 'news-unsubscribe-current-group #[nil "ÀÁ!…  !‡" [y-or-n-p "Do you really want to unsubscribe from this group ? " news-unsubscribe-internal news-current-news-group] 2 (#$ . 18198) nil]) (defalias 'news-unsubscribe-internal #[(group) "À \n\"‰ƒ) \fBÀ \n\"A@A @A ˆ šƒ#Ç ˆÈÉ!‚-ÊË \")‡" [assoc group news-group-article-assoc tem news-unsubscribe-groups news-point-pdl news-current-news-group news-next-group message "" error "Not subscribed to group: %s"] 4]) #@69 Save the current article that is being read by appending to a file. (defalias 'news-save-item-in-file #[(file) "Àed #‡" [append-to-file file] 4 (#$ . 18730) "FSave item in file: "]) #@153 Given a news group it finds all files in the news group. The arg must be in slashified format. Using ls was found to be too slow in a previous version. (defalias 'news-get-pruned-list-of-files #[(gp-list end-file-no) "…Á  !š…ÄƉ?…ÐÉÊË #P\fÄ …:Î\fÏÐ!Q!…:Ñ\fÒ#ÆăfÆVƒb BS‰‚O ‚ÏÕ\f!?†sÖ\f!??…Ï×ØÙ‰‰ ƒ²ÚÛ @\"ƒ¢Õ\fÏ @Q!„¢Ü @!Xƒ©Ý @ \" A‰ „ƒ „½ÞÄ‚ÏßÜ \"à á\"‰‰GSœ +‰\"†Úã ˆÄ)‡" [end-file-no news-set-current-certifiable news-group-certification gp-list nil news-list-of-files t news-list-of-files-possibly-bogus news-path string-subst-char 47 46 file-directory tem file-exists-p "/" int-to-string news-find-first-or-last 1 last-winner news-current-group-end file-directory-p file-readable-p error (directory-files file-directory) ((file-error (byte-code "À 8˜ƒÃÄ \"ˆ‚ÆÇ A\"ˆÈ‡" [2 error "permission denied" message "Newsgroup %s is read-protected" gp-list signal file-error nil] 3))) string-match "^[0-9]*$" string-to-int delq 0 mapcar sort < answer news-set-current-group-certification] 6 (#$ . 18919)]) (defalias 'news-read-files-into-buffer #[(group reversep) "À \n\"A@‰@ A@Æ Æ Æ\nË ˆÌ \"ˆË ˆ @ A@BC „FÏ ˆ \n   Ë ˆÆ‚ˆ@ƒW\n ‚k@ Vƒg @@¡ˆ Ò ˆË ˆÓÕÖ× #ØÙ !R!ˆÒ ˆË ˆÚ,‡" [assoc group news-group-article-assoc files-start-end start-file-no end-file-no nil buffer-read-only news-current-news-group news-current-message-number news-current-group-end news-set-mode-line news-get-pruned-list-of-files news-point-pdl news-list-of-files erase-buffer news-current-group-begin reversep news-set-message-counters news-read-in-file news-path string-subst-char 47 46 "/" int-to-string t] 7]) #@67 Resubscribe to or add a USENET news group named GROUP (a string). (defalias 'news-add-news-group #[(gp) "ÁÂÃ\f#PŠÆ\f\"„®ÈÉ\n!! Ì !ƒ¦Í !ˆÎbˆÏ\fÐPÑÒ#ƒDÓÔ\f\"ˆÕÖ!ˆ×Ø!ˆÙcˆ‚QÓÚ\f\"ˆÛ ˆ\fܱˆÝ\fÑÒ#ˆÑ‰‰‰ !ÏâÑÒ#ˆ` Îyˆ`!ш`! ÖZ{ã {!$$@$A$AEDB-å ˆæp!‚ªÓç\f\")‚²Óè\f\"*‡" [news-path string-subst-char 47 46 gp file-dir assoc news-group-article-assoc find-file-noselect substitute-in-file-name news-startup-file newsrcbuf file-directory-p switch-to-buffer 0 search-forward "! " nil t message "Re-subscribing to group %s." backward-char 2 delete-char 1 ":" "Added %s to your list of newsgroups." end-of-buffer ": 1-1\n" search-backward tem endofline end start ": " news-parse-range range save-buffer kill-buffer "Newsgroup %s doesn't exist." "Already subscribed to group %s."] 5 (#$ . 20622) "sAdd news group: "]) #@154 Forges a link to an rnews message numbered number (current if no arg) Good for hanging on to a message that might or might not be automatically deleted. (defalias 'news-make-link-to-message #[(number newname) "À ÂÃÄ #ƃÈ!‚ R\n\"‡" [add-name-to-file news-path string-subst-char 47 46 news-current-news-group "/" number prefix-numeric-value news-current-message-number newname] 6 (#$ . 21471) "P\nFName to link to message: "]) #@69 Caesar rotation of region by N, default 13, for decrypting netnews. (defalias 'caesar-region #[(&optional n) "§„\nÁ‚ÂÃ\"ÄU?…ÙÅÆ!ƒ'ÇHÇ\\U„ÄÈÉ\n \fÍÎ!ˆÏÐÄ\"\fÐWƒQ\f‰Iˆ\fT‰\f‚< ‰P‰ –\nÄ\fÄÃWƒ‹\fÇ\\ \f\\HIˆ\fÑ\\\n\f\\HIˆ\fT‰\f‚_ÍÒ!ˆ+Ó Ô Äɉ\f‰{‰G\fWƒÊ\f\fHHIˆ\fT‰\f‚­bˆÙ\"ˆc-‡" [n 13 mod 26 0 boundp caesar-translate-table 97 "abcdefghijklmnopqrstuvwxyz" nil upper lower i message "Building caesar-translate-table..." make-vector 256 65 "Building caesar-translate-table... done" region-beginning region-end len str to from kill-region] 6 (#$ . 21912) (byte-code "ƒ Á!C‡ÂC‡" [current-prefix-arg prefix-numeric-value nil] 2)]) #@264 Caesar rotates all letters in the current buffer by 13 places. Used to encode/decode possibly offensive messages (commonly in net.jokes). With prefix arg, specifies the number of places to rotate each letter forward. Mail and USENET news headers are not rotated. (defalias 'news-caesar-buffer-body #[(&optional rotnum) "ŠÂÃebˆÄÅÇšƒÈ‚ ÅQÂÊ#ƒ$`‚%e!ˆdbˆË\f!ˆ ‰*‡" [buffer-read-only buffer-status nil set-mark search-forward "\n" major-mode news-mode "" mail-header-separator t caesar-region rotnum] 5 (#$ . 22629) (byte-code "ƒ Á!C‡ÂC‡" [current-prefix-arg prefix-numeric-value nil] 2)]) (provide (quote rnews)) emacs-19.30/lisp/rnewspost.elc100666 13437 1 23567 5754706150 15010 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri May 12 12:26:56 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/rnewspost.el ;;; emacs version 19.28.91.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/rnewspost.el' was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!‡" [require sendmail rnews] 2) #@30 Mode map used by news-reply. (defvar news-reply-mode-map nil (#$ . 542)) (byte-code "„¸Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÚ#ˆÂÜÝ #ˆÂÞßÝß!B#ˆÂàá#ˆÂâã#ˆÂäå#ˆÂæç#ˆÂèé#ˆÂêë#ˆÂìí#ˆÂîïÝï!B#ˆÂðñ#ˆÂòó#ˆÂôõ#ˆÂö÷#ˆÂøù#ˆÁ‡" [news-reply-mode-map make-keymap define-key "" news-reply-distribution " " news-reply-keywords "" news-reply-newsgroups "" news-reply-followup-to "" mail-subject "" news-reply-summary "" mail-text "" news-caesar-buffer-body "" news-reply-signature "" news-reply-yank-original "" mail-fill-yanked-message "" news-inews "" [menu-bar] make-sparse-keymap [menu-bar fields] "Fields" [menu-bar fields news-reply-distribution] ("Distribution" . news-reply-distribution) [menu-bar fields news-reply-keywords] ("Keywords" . news-reply-keywords) [menu-bar fields news-reply-newsgroups] ("Newsgroups" . news-reply-newsgroups) [menu-bar fields news-reply-followup-to] ("Followup-to" . news-reply-followup-to) [menu-bar fields mail-subject] ("Subject" . mail-subject) [menu-bar fields news-reply-summary] ("Summary" . news-reply-summary) [menu-bar fields mail-text] ("Text" . mail-text) [menu-bar news] "News" [menu-bar news news-caesar-buffer-body] ("Rot13" . news-caesar-buffer-body) [menu-bar news news-reply-signature] ("Signature" . news-reply-signature) [menu-bar news news-reply-yank-original] ("Yank Original" . news-reply-yank-original) [menu-bar news mail-fill-yanked-message] ("Fill Yanked Messages" . mail-fill-yanked-message) [menu-bar news news-inews] ("Send" . news-inews)] 6) #@787 Major mode for editing news to be posted on USENET. First-time posters are asked to please read the articles in newsgroup: news.announce.newusers . Like Text Mode but with these additional commands: C-c C-s news-inews (post the message) C-c C-c news-inews C-c C-f move to a header field (and create it if there isn't): C-c C-f C-n move to Newsgroups: C-c C-f C-s move to Subj: C-c C-f C-f move to Followup-To: C-c C-f C-k move to Keywords: C-c C-f C-d move to Distribution: C-c C-f C-a move to Summary: C-c C-y news-reply-yank-original (insert current message, in NEWS). C-c C-q mail-fill-yanked-message (fill what was yanked). C-c C-r caesar rotate all letters by 13 places in the article's body (rot13). (defalias 'news-reply-mode #[nil "ÀÁ!„\nÂÃ!ˆÄ ˆÅÆ!ˆÇÈ !ˆÊ !ˆ\f ÎÐÅÒ!ˆÅÓ!ˆÔÕ!×RÔÕ!×RØÙÚ\"‡" [fboundp mail-setup load "sendmail" kill-all-local-variables make-local-variable mail-reply-buffer nil set-syntax-table text-mode-syntax-table use-local-map news-reply-mode-map text-mode-abbrev-table local-abbrev-table news-reply-mode major-mode "News Reply" mode-name paragraph-separate paragraph-start "^" regexp-quote mail-header-separator "$\\|" run-hooks text-mode-hook news-reply-mode-hook] 4 (#$ . 2132) nil]) #@2  (defvar news-reply-yank-from "Save `From:' field for `news-reply-yank-original'." (#$ . 3454)) #@2  (defvar news-reply-yank-message-id "Save `Message-Id:' field for `news-reply-yank-original'." (#$ . 3555)) #@249 Insert the message being replied to, if any (in Mail mode). Puts point before the text and mark after. Indents each nonblank line ARG spaces (default 3). Just \[universal-argument] as argument means don't indent and don't delete any header fields. (defalias 'news-reply-yank-original #[(arg) "À !ˆÂ ˆÃÄ!‡" [mail-yank-original arg exchange-point-and-mark run-hooks news-reply-header-hook] 2 (#$ . 3670) "P"]) #@61 Hook for inserting a header at the top of a yanked message. (defvar news-reply-header-hook (quote (lambda nil (insert "In article " news-reply-yank-message-id " " news-reply-yank-from " writes:\n\n"))) (#$ . 4084)) #@212 Move point to end of `Newsgroups:' field. RFC 850 constrains the `Newsgroups:' field to be a comma-separated list of valid newsgroup names at your site. For example, Newsgroups: news.misc,comp.misc,rec.misc (defalias 'news-reply-newsgroups #[nil "À ˆebˆÁÂ!‡" [expand-abbrev mail-position-on-field "Newsgroups"] 2 (#$ . 4306) nil]) #@412 Move point to end of `Followup-To:' field. Create the field if none. One usually requests followups to only one newsgroup. RFC 850 constrains the `Followup-To:' field to be a comma-separated list of valid newsgroups names at your site, and it must be a subset of the `Newsgroups:' field. For example: Newsgroups: news.misc,comp.misc,rec.misc,misc.misc,soc.misc Followup-To: news.misc,comp.misc,rec.misc (defalias 'news-reply-followup-to #[nil "À ˆÁÂÃ\"†ÁÄ!ˆÅc‡" [expand-abbrev mail-position-on-field "Followup-To" t "newsgroups" "\nFollowup-To: "] 3 (#$ . 4648) nil]) #@198 Move point to end of `Distribution:' optional field. Create the field if none. Without this field the posting goes to all of USENET. The field is used to restrict the posting to parts of USENET. (defalias 'news-reply-distribution #[nil "À ˆÁÂ!‡" [expand-abbrev mail-position-on-field "Distribution"] 2 (#$ . 5233) nil]) #@182 Move point to end of `Keywords:' optional field. Create the field if none. Used as an aid to the news reader, it can contain a few, well selected keywords identifying the message. (defalias 'news-reply-keywords #[nil "À ˆÁÂ!‡" [expand-abbrev mail-position-on-field "Keywords"] 2 (#$ . 5562) nil]) #@172 Move point to end of `Summary:' optional field. Create the field if none. Used as an aid to the news reader, it can contain a succinct summary (abstract) of the message. (defalias 'news-reply-summary #[nil "À ˆÁÂ!‡" [expand-abbrev mail-position-on-field "Summary"] 2 (#$ . 5867) nil]) #@57 The inews program appends `~/.signature' automatically. (defalias 'news-reply-signature #[nil "ÀÁ!‡" [message "`~/.signature' will be appended automatically."] 2 (#$ . 6159) nil]) #@75 Set up the news reply or posting buffer with the proper headers and mode. (defalias 'news-setup #[(to subject in-reply-to newsgroups replybuffer) "‰ „-‰È  \nÂÂ&ˆËyˆ`Ìyˆ`|ˆdbˆ*‚9È  \nÂÂ&ˆdbˆÍÏÐeÍ#)ƒeËyˆÑ†RÓÔ±ˆ„bÕÌ!ˆ‚edbˆÖ×!*‡" [replybuffer mail-reply-buffer nil mail-signature mail-setup-hook to mail-archive-file-name mail-self-blind mail-setup subject in-reply-to 0 1 t case-fold-search re-search-backward "^Subject:" "Newsgroups: " newsgroups "" "\n" backward-char run-hooks news-setup-hook] 7 (#$ . 6345)]) #@34 Send a news message using inews. (defalias 'news-inews #[nil "ÀÀÀŠŒebˆÄÅÅQ!ˆe`}ˆÇÈ!ÇÉ!)~ˆebˆÊË!ˆebˆÄÅÅQ!ˆÌÍ!ˆdbˆhÎU„DÎcˆÏÐ!ˆÑedÀÓÀÔ&ˆÏÕ!ˆebˆÄÍ!ˆÌÅÅQ!ˆÖÀ!ˆ)×Ø!…tØ +‡" [nil newsgroups subject case-fold-search search-forward "\n" mail-header-separator mail-fetch-field "newsgroups" "subject" run-hooks news-inews-hook replace-match "\n\n" 10 message "Posting to USENET..." call-process-region news-inews-program 0 "-h" "Posting to USENET... done" set-buffer-modified-p fboundp bury-buffer] 8 (#$ . 6892) nil]) #@149 Mail a reply to the author of the current article. While composing the reply, use \[news-reply-yank-original] to yank the original message into it. (defalias 'news-mail-reply #[nil "À‰‰‰‰‰pŒeÈe!ˆÉÊ!ˆ`ËZ}ˆÌÍ!ÌÎ!ÌÏ!ÌÐ!)ÑÒ!ˆÓÀ\nƒB\n‚C ÔÕ\"‰ƒX×O‚ZØ\fQ)À &.‡" [nil buffer reply-to to date subject cc from goto-line search-forward "\n\n" 1 mail-fetch-field "from" "subject" "reply-to" "date" pop-to-buffer "*mail*" mail string-match " *at \\| *@ \\| *(\\| *<" stop-pos 0 "'s message of "] 8 (#$ . 7422) nil]) #@177 Compose and post a reply (aka a followup) to the current article on USENET. While composing the followup, use \[news-reply-yank-original] to yank the original message into it. (defalias 'news-reply #[nil "ÀÁ!ƒ‰‰‰‰‰‰‰‰‰‰p \n \f ŒÏÐ U„FÒšƒFÓ ˆeebˆÔÕ!ˆ`ÖZ}ˆ×Ø!‰×Ú!\f×Û! ×Ü!‰ †d×Ý!×Þ!×ß!×à!‰!âã!ˆä ˆå …†Àæ!??…ç ˆ\fƒ²èé\f\"ƒ¬èé\f\"ƒ¬\fêÂO\f‚šë\fP\fƒÔèì\"‰-ƒËÏ-O‚Íî Q)ïÂ\f %ˆ ƒëð ˆ cˆ ƒöñò!ˆ cˆñó!ˆƒcˆƒ\fƒôcˆ\fƒ\fcˆdb. ‡õö!‡" [y-or-n-p "Are you sure you want to followup to all of USENET? " nil buffer message-id distribution references message-of newsgroups followup-to to date subject cc from 0 buffer-size major-mode news-mode news-show-all-headers search-forward "\n\n" 1 mail-fetch-field "from" news-reply-yank-from "subject" "date" "followup-to" "newsgroups" "references" "distribution" "message-id" news-reply-yank-message-id pop-to-buffer "*post-news*" news-reply-mode buffer-modified-p "Unsent article being composed; erase it? " erase-buffer string-match "\\`Re: " 4 "Re: " " *at \\| *@ \\| *(\\| *<" stop-pos "'s message of " news-setup news-reply-followup-to mail-position-on-field "Distribution" "References" " " message ""] 13 (#$ . 7968) nil]) #@129 Begin editing a new USENET news article to be posted. Type \[describe-mode] once editing the article to get a list of commands. (defalias 'news-post-news #[nil "ÀÁ!ƒQpŒÃÄ U„& Æšƒ&Ç ˆeebˆÈÉ!ˆ`ÊZ}ˆËÌ! ËÎ!)ÐÑ!ˆÒ ˆÓ …AÀÔ!??…OÕ ˆÖ׉‰‰\n%)‡ØÙ!‡" [y-or-n-p "Are you sure you want to post to all of USENET? " buffer 0 buffer-size major-mode news-mode news-show-all-headers search-forward "\n\n" 1 mail-fetch-field "from" news-reply-yank-from "message-id" news-reply-yank-message-id pop-to-buffer "*post-news*" news-reply-mode buffer-modified-p "Unsent article being composed; erase it? " erase-buffer news-setup nil message ""] 6 (#$ . 9221) nil]) #@129 Send mail in another window. While composing the message, use \[news-reply-yank-original] to yank the original message into it. (defalias 'news-mail-other-window #[nil "ÀÁ‰‰‰‰p&‡" [mail-other-window nil] 7 (#$ . 9877) nil]) emacs-19.30/lisp/rot13.elc100666 13437 1 2255 5744577254 13675 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:50:04 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/rot13.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/rot13.el' was compiled for Emacs 19")) #@32 Char table for rot 13 display. (defvar rot13-display-table (byte-code "À Á\nÄWƒ0 \nÅ\\Æ\nÇ\\ĦÅ\\!Iˆ \nÈ\\Æ\nÇ\\ĦÈ\\!Iˆ\nT‰‚ *‡" [make-display-table 0 i table 26 97 vector 13 65] 6) (#$ . 479)) #@105 Display current buffer in rot 13 in another window. To terminate the rot13 display, delete that window. (defalias 'rot13-other-window #[nil "ÀpÁ\"Ã\n\f\")‡" [display-buffer t w set-window-display-table rot13-display-table] 3 (#$ . 687) nil]) #@59 Toggle the use of rot 13 encoding for the current window. (defalias 'toggle-rot13-mode #[nil "ÀÁ !\n=ƒÃÁ Ä\"‡ÀÁ !?…ÃÁ \n\"‡" [window-display-table selected-window rot13-display-table set-window-display-table nil] 3 (#$ . 936) nil]) (provide (quote rot13)) emacs-19.30/lisp/rsz-mini.elc100666 12120 1 12052 6021171425 14330 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Aug 30 19:24:02 1995 ;;; from file /home/fsf/rms/e19/lisp/rsz-mini.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`rsz-mini.el' was compiled for Emacs 19.29 or later")) #@74 *If non-`nil', resize the minibuffer so its entire contents are visible. (defvar resize-minibuffer-mode nil (#$ . -471)) #@175 *Maximum size the minibuffer window is allowed to become. If less than 1 or not a number, the limit is the height of the frame in which the active minibuffer window resides. (defvar resize-minibuffer-window-max-height nil (#$ . -599)) #@219 *Allow making minibuffer exactly the size to display all its contents. If `nil', the minibuffer window can temporarily increase in size but never get smaller while it is active. Any other value allows exact resizing. (defvar resize-minibuffer-window-exactly t (#$ . -841)) #@161 *Allow changing the frame height of minibuffer frames. If non-`nil' and the active minibuffer is the sole window in its frame, allow changing the frame height. (defvar resize-minibuffer-frame nil (#$ . -1122)) #@109 *Maximum size the minibuffer frame is allowed to become. If less than 1 or not a number, there is no limit. (defvar resize-minibuffer-frame-max-height nil (#$ . -1339)) #@224 *Allow making minibuffer frame exactly the size to display all its contents. If `nil', the minibuffer frame can temporarily increase in size but never get smaller while it is active. Any other value allows exact resizing. (defvar resize-minibuffer-frame-exactly t (#$ . -1515)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp resize-minibuffer-frame-original-height nil current-load-list] 2) #@1110 Enable or disable resize-minibuffer mode. A negative prefix argument disables this mode. A positive argument or argument of 0 enables it. When this minor mode is enabled, the minibuffer is dynamically resized to contain the entire region of text put in it as you type. The variable `resize-minibuffer-mode' is set to t or nil depending on whether this mode is active or not. The maximum height to which the minibuffer can grow is controlled by the variable `resize-minibuffer-window-max-height'. The variable `resize-minibuffer-window-exactly' determines whether the minibuffer window should ever be shrunk to make it no larger than needed to display its contents. When using a window system, it is possible for a minibuffer to be the sole window in a frame. Since that window is already its maximum size, the only way to make more text visible at once is to increase the size of the frame. The variable `resize-minibuffer-frame' controls whether this should be done. The variables `resize-minibuffer-frame-max-height' and `resize-minibuffer-frame-exactly' are analogous to their window counterparts. (defalias 'resize-minibuffer-mode #[(&optional prefix) "„ÁÁYƒ‰‡Ä‰‡" [prefix 0 t resize-minibuffer-mode nil] 2 (#$ . 1904) "p"]) (defalias 'resize-minibuffer-setup #[nil "…R ƒ7Âà žAÄ=ƒ7 …RÆÇ!ˆÈ ÉÊ!ˆËÊÅÌÍ$ˆÉÎ!ˆËÎÏÐÍ$ˆÅ ‡ÆÊ!ˆÑ\n!\nËÊÒÌ#ˆÆÎ!ˆËÎÓ\"ˆÒ ‡" [resize-minibuffer-mode window-system minibuffer frame-parameters only resize-minibuffer-frame make-local-variable resize-minibuffer-frame-original-height frame-height make-local-hook post-command-hook add-hook append t minibuffer-exit-hook resize-minibuffer-frame-restore nil copy-sequence resize-minibuffer-window resize-minibuffer-window-restore] 5]) #@279 Return number of window lines occupied by text in region. The number of window lines may be greater than the number of actual lines in the buffer if any wrap on the display due to their length. Optional arguments START and END default to point-min and point-max, respectively. (defalias 'resize-minibuffer-count-window-lines #[(&optional start end) "„e „\fd Uƒ‡ŠŒ~ˆ }ˆbˆÃÄ !*‡" [start end 0 vertical-motion buffer-size] 2 (#$ . 3642)]) (defalias 'resize-minibuffer-window #[nil "À Á =…8 à T§ƒ!ÇVƒ!\f^ƒ,\f U‚/\f X†7É\f Z!*‡" [selected-window minibuffer-window window-height resize-minibuffer-count-window-lines lines height resize-minibuffer-window-max-height 0 resize-minibuffer-window-exactly enlarge-window] 3]) (defalias 'resize-minibuffer-window-restore #[nil "À Á =?† ÃV…ÄàZ!ˆÅÆ!‡" [minibuffer-window selected-window window-height 1 enlarge-window sit-for 0] 3]) (defalias 'resize-minibuffer-frame #[nil "À Á T\f§ƒ\fÅVƒ\n\f^\n Vƒ&ÆÇ È \n#‚? …? \nV…?\n W…?ÆÇ È \n#*‡" [frame-height resize-minibuffer-count-window-lines lines height resize-minibuffer-frame-max-height 0 set-frame-size selected-frame frame-width resize-minibuffer-frame-exactly resize-minibuffer-frame-original-height] 4]) (defalias 'resize-minibuffer-frame-restore #[nil "ÀÁ  #‡" [set-frame-size selected-frame frame-width resize-minibuffer-frame-original-height] 4]) (byte-code "ÀÁ!ˆÂÃÄ\"ˆÅ ‡" [provide rsz-mini add-hook minibuffer-setup-hook resize-minibuffer-setup resize-minibuffer-mode] 3) emacs-19.30/lisp/s-region.elc100666 12120 1 5334 5765727163 14314 0ustar rmsdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Thu Jun 8 22:14:12 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/s-region.el ;;; emacs version 19.28.93.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`s-region.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!„ ÂÉ\"Á\fBÅ ÆÇ#ˆÅ ÈÉ#‡" [boundp s-region-overlay make-overlay 1 current-load-list overlay-put face region priority 1000000] 4) #@72 Remove shift modifier from last keypress KEY and return that as a key. (defalias 's-region-unshift #[(key) "À !ƒA ‰GSH‰9ƒ;Ã\n!ÅÆ\f\"‰ƒ3ÈÉ\fÊO\fË\\ÌOP!!‚7ÍÎ \"*‚?ÍÏ \")‡ÍÐ \"‡" [vectorp key last symbol-name keyname string-match "S-" pos vector intern 0 2 nil error "Non-shifted key: %S" "Key does not end in a symbol: %S" "Non-vector key: %S"] 7 (#$ . 624)]) #@75 This is an overlay function to point-moving keys that are interactive "p" (defalias 's-region-move-p1 #[(&rest arg) "ÀÁ\n\"‡" [apply s-region-move arg] 3 (#$ . 1001) "p"]) #@75 This is an overlay function to point-moving keys that are interactive "P" (defalias 's-region-move-p2 #[(&rest arg) "ÀÁ\n\"‡" [apply s-region-move arg] 3 (#$ . 1179) "P"]) (defalias 's-region-move #[(&rest arg) "ƒ š?‚\fÃÄÅ!ˆ‚ÆÇ!ˆÂÉÊËÌ !! \"ˆÎÐ `p$ˆÑÒ!ˆÓ!‡" [mark-active last-command s-region-move t set-mark-command nil message "" this-command apply key-binding s-region-unshift this-command-keys arg move-overlay s-region-overlay mark sit-for 1 delete-overlay] 5]) #@298 Bind shifted keys in KEYLIST to s-region-move-p1 or s-region-move-p2. Each key in KEYLIST is shifted and bound to one of the s-region-move functions provided it is already bound to some command or other. Optional third argument MAP specifies keymap to add binding to, defaulting to global keymap. (defalias 's-region-bind #[(keylist &optional map) "ÀÁÂÃF „ …K@É!\nË\n!ƒ@Ì ÍÎÏÐÑH!P!!\n\f>ƒ=Ò‚>Ó#ˆ*A‰„Ô)‡" [scroll-up scroll-down beginning-of-buffer end-of-buffer p2 map global-map keylist key key-binding binding commandp define-key vector intern "S-" symbol-name 0 s-region-move-p2 s-region-move-p1 nil] 9 (#$ . 1669)]) (byte-code "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×د!ˆÙÚ!„(ÛÜÝ\"ˆÙÞ!„3Ûßà\"ˆÙá!„>Ûâã\"ˆäå!‡" [s-region-bind [right] [left] [up] [down] [C-left] [C-right] [C-up] [C-down] [M-left] [M-right] [M-up] [M-down] [next] [previous] [home] [end] [C-next] [C-previous] [C-home] [C-end] [M-next] [M-previous] [M-home] [M-end] global-key-binding [C-insert] global-set-key [C-insert] copy-region-as-kill [S-delete] [S-delete] kill-region [S-insert] [S-insert] yank provide s-region] 25) emacs-19.30/lisp/saveplace.elc100666 12120 1 10303 6054022167 14524 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 20 01:47:15 1995 ;;; from file /home/fsf/rms/e19/lisp/saveplace.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`saveplace.el' was compiled for Emacs 19.29 or later")) #@255 Alist of saved places to go back to when revisiting files. Each element looks like (FILENAME . POSITION); visiting file FILENAME goes automatically to position POSITION rather than the beginning of the buffer. This alist is saved between Emacs sessions. (defvar save-place-alist nil (#$ . 477)) #@359 *Non-nil means automatically save place in each file. This means when you visit a file, point goes to the last place where it was when you previously visited the same file. This variable is automatically buffer-local. If you wish your place in any file to always be automatically saved, simply put this in your `~/.emacs' file: (setq-default save-place t) (defvar save-place nil (#$ . -779)) (make-variable-buffer-local (quote save-place)) #@58 *Name of the file that records `save-place-alist' value. (defvar save-place-file "~/.emacs-places" (#$ . -1227)) #@297 *Controls whether to make numbered backups of master save-place file. It can have four values: t, nil, `never', and `nospecial'. The first three have the same meaning that they do for the variable `version-control', and the final value `nospecial' means just use the value of `version-control'. (defvar save-place-version-control (quote nospecial) (#$ . -1347)) #@59 Non-nil means that the `save-place-file' has been loaded. (defvar save-place-loaded nil (#$ . 1716)) #@428 Toggle whether to save your place in this file between sessions. If this mode is enabled, point is recorded when you kill the buffer or exit Emacs. Visiting this file again will go to that position, even in a later Emacs session. If called with a prefix arg, the mode is enabled if and only if the argument is positive. To save places automatically in all files, put this in your `.emacs' file: (setq-default save-place t) (defalias 'toggle-save-place #[(&optional parg) "„\fÁÂÃÄ \"!‡ ƒ$ƒÇXƒ$ÁÈ!ˆÉ‰‡ÁÊ!ˆË‰‡" [buffer-file-name message format "Buffer \"%s\" not visiting a file." buffer-name save-place parg 0 "No place will be saved in this file." nil "Place will be saved." t] 4 (#$ . 1824) "P"]) (defalias 'save-place-to-alist #[nil "„Á ˆ\n…3Ã\n\f\"‰ƒÆ \f\")…3\nÉ=„+`‚.Ê TB\fB‰‡" [save-place-loaded load-save-place-alist-from-file buffer-file-name assoc save-place-alist cell delq save-place major-mode hexl-mode hexl-current-address] 4]) (defalias 'save-place-alist-to-file #[nil "À !ŠÃÄÅ\n\"!ˆÆÇ!qˆed|ˆÈ\n!ƒÉ\n!ˆed|ˆebˆÊ p\"ˆ\f„5Í‚M\fÎ=ƒ@΂M\fÏ=ƒL‚MÑÒ\n!ˆÓp!ˆÃÄÔ\n\"!+‡" [expand-file-name save-place-file file message format "Saving places to %s..." get-buffer-create " *Saved Places*" file-readable-p insert-file-contents print save-place-alist save-place-version-control nil never nospecial version-control t write-file kill-buffer "Saving places to %s... done."] 4]) (defalias 'load-save-place-alist-from-file #[nil "?…?Á !Å\f!ƒ=ŠÆÇÈ \"!ˆÉÊ!qˆed|ˆË\f!ˆebˆÌed{!@ Îp!ˆÆÇÏ\f\"!ˆ))Ї" [save-place-loaded t expand-file-name save-place-file file file-readable-p message format "Loading places from %s..." get-buffer-create " *Saved Places*" insert-file-contents read-from-string save-place-alist kill-buffer "Loading places from %s... done." nil] 4]) (defalias 'save-places-to-alist #[nil "À  …Š @qˆ\nƒà ˆ A)‚)‡" [buffer-list buf-list buffer-file-name save-place-to-alist] 1]) (defalias 'save-place-find-file-hook #[nil "„Á ˆÂ \f\"‰…„ AbˆÇ‰)‡" [save-place-loaded load-save-place-alist-from-file assoc buffer-file-name save-place-alist cell after-find-file-from-revert-buffer t save-place] 4]) (defalias 'save-place-kill-emacs-hook #[nil "À ˆÁ ‡" [save-places-to-alist save-place-alist-to-file] 1]) (byte-code "ÀÁÂÃ#ˆÀÄÅ\"ˆÀÆÇ\"ˆÈÉ!‡" [add-hook find-file-hooks save-place-find-file-hook t kill-emacs-hook save-place-kill-emacs-hook kill-buffer-hook save-place-to-alist provide saveplace] 4) emacs-19.30/lisp/scheme.elc100666 13437 1 20313 5744577263 14204 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:50:07 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/scheme.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/scheme.el' was compiled for Emacs 19")) #@2  (defvar scheme-mode-syntax-table nil (#$ . 480)) (byte-code "„ÀÁà Ä!ˆ\nÅWƒÆ\nÇ\"ˆ\nT‰‚ÈÈÉXƒ3Æ\nÊ\"ˆ\nT‰‚\"ËËÌXƒGÆ\nÊ\"ˆ\nT‰‚6ÍÍÎXƒ[Æ\nÊ\"ˆ\nT‰‚JÆÏÐ\"ˆÆÑÒ\"ˆÆÓÐ\"ˆÆÔÐ\"ˆÆÕÐ\"ˆÆÖ×\"ˆÆØÙ\"ˆÆÚÛ\"ˆÆÜÝ\"ˆÆÞß\"ˆÆàá\"ˆÆâã\"ˆÆäå\"ˆÆæç\"ˆÆèé\"ˆÆêé\"ˆÆëì\"ˆÆíì\"ˆÆîï\"ˆÆðñ\"ˆ)Á‡" [scheme-mode-syntax-table 0 i make-syntax-table set-syntax-table 256 modify-syntax-entry "_ " 48 57 "w " 65 90 97 122 9 " " 10 "> " 12 13 32 91 "(] " 93 ")[ " 123 "(} " 125 "){ " 124 " 23" 40 "() " 41 ")( " 59 "< " 34 "\" " 39 " p" 96 44 "_ p" 64 35 "_ p14" 92 "\\ "] 4) #@2  (defvar scheme-mode-abbrev-table nil (#$ . 1072)) (define-abbrev-table (quote scheme-mode-abbrev-table) nil) (defalias 'scheme-mode-variables #[nil "À !ˆ\nÄÅ!ˆÆPÄÈ!ˆ ÄÉ!ˆÊ ÄË!ˆÌ ÄÍ!ˆÊ ÄÎ!ˆÏÄÐ!ˆÑÄÒ!ˆÓÄÔ!ˆÕÄÍ!ˆÊ Ö‰‡" [set-syntax-table scheme-mode-syntax-table scheme-mode-abbrev-table local-abbrev-table make-local-variable paragraph-start "$\\|" page-delimiter paragraph-separate paragraph-ignore-fill-prefix t indent-line-function scheme-indent-line parse-sexp-ignore-comments comment-start ";" comment-start-skip ";+[ ]*" comment-column 40 comment-indent-function scheme-comment-indent ("" scheme-mode-line-process) mode-line-process] 2]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp scheme-mode-line-process "" current-load-list] 2) (defalias 'scheme-mode-commands #[(map) "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#‡" [define-key map " " scheme-indent-line "" backward-delete-char-untabify "" scheme-indent-sexp] 4]) (byte-code "ÀÁ!„ÂÁ B „Ä Å !ˆÂ‡" [boundp scheme-mode-map nil current-load-list make-sparse-keymap scheme-mode-commands] 2) #@712 Major mode for editing Scheme code. Editing commands are similar to those of lisp-mode. In addition, if an inferior Scheme process is running, some additional commands will be defined, for evaluating expressions and controlling the interpreter, and the state of the process will be displayed in the modeline of all Scheme buffers. The names of commands that interact with the Scheme process start with "xscheme-". For more information see the documentation for xscheme-interaction-mode. Commands: Delete converts tabs to spaces as it moves back. Blank lines separate paragraphs. Semicolons start comments. \{scheme-mode-map} Entry to this mode calls the value of scheme-mode-hook if that value is non-nil. (defalias 'scheme-mode #[nil "À ˆÁ ˆÂ ˆÃÄ!‡" [kill-all-local-variables scheme-mode-initialize scheme-mode-variables run-hooks scheme-mode-hook] 2 (#$ . 2119) nil]) (defalias 'scheme-mode-initialize #[nil "À !ˆÂĉ‡" [use-local-map scheme-mode-map scheme-mode major-mode "Scheme" mode-name] 2]) #@109 If non-nil, scheme mode is specialized for MIT Scheme. Set this to nil if you normally use another dialect. (defvar scheme-mit-dialect t (#$ . 3132)) (defalias 'scheme-comment-indent #[(&optional pos) "ŠƒbˆÁÂ!ƒi‚;ÁÃ!ƒ*Ä ‰<ƒ% @‚& )‚;ÆÇxˆnƒ6È‚8iT ])‡" [pos looking-at ";;;" ";;" calculate-scheme-indent tem " " nil 0 comment-column] 3]) #@2  (defvar scheme-indent-offset nil (#$ . 3488)) #@2  (defvar scheme-indent-function (quote scheme-indent-function) (#$ . 3540)) #@132 Indent current line as Scheme code. With argument, indent any additional lines of the same expression rigidly along with this one. (defalias 'scheme-indent-line #[(&optional whole-exp) "À Á‰‰d`ZÇyˆ`ÈÁwˆÉÊ!?…s<ƒ)@iZ‰ÇU„<\f`|ˆjˆd\nZ`VƒId\nZbˆ …s ÇU?…sŠ\fbˆÌÍ!ˆ`\fbˆÍyˆ` \fV)…sÎ\f #-‡" [calculate-scheme-indent nil pos end beg shift-amt indent 0 " " looking-at "[ ]*;;;" whole-exp forward-sexp 1 indent-code-rigidly] 7 (#$ . 3623) "P"]) #@400 Return appropriate indentation for current line as scheme code. In usual case returns an integer: the column to indent to. Can instead return a list, whose car is the column to indent to. This means that following lines at the same level of indentation should not necessarily be indented the same way. The second element of the list is the buffer position of the start of the containing expression. (defalias 'calculate-scheme-indent #[(&optional parse-start) "ŠÀyˆ`Á‰‰ÂÁ‰‰ \n ƒ% bˆ‚(Ì ˆ`\nWƒ:Í`\nÀ# ‚(ƒÚ @‰ƒÚÀVƒÚÁÎ 8 A@‰Tbˆ ƒ€ `Vƒ€Í \nÀ#‰A@‰ƒ )„:\fTbˆ „“i‚:Í` ÀÂ$ˆÐÑ!ŠÒyˆ`) VƒÇÍ` ÀÂ$ˆ` U„ÁÓÒ!ˆÍ` ÀÂ$ˆÔ ˆ‚: bˆÀyˆÍ` ÀÂ$ˆÔ ˆ‚: ƒáiÕ ›@ƒ÷\nbˆÖÁwˆi‚2¨ƒ \fƒ \fbˆi\\‚2„2ØÙ!ƒ/ƒ/„/\n \"‰„2i. ‡" [0 nil t first-sexp-list-p containing-sexp last-sexp retry desired-indent paren-depth state indent-point parse-start beginning-of-defun parse-partial-sexp 2 peek looking-at "\\s(" 1 forward-sexp backward-prefix-chars 3 " " scheme-indent-offset boundp scheme-indent-function] 9 (#$ . 4095)]) (defalias 'scheme-indent-function #[(indent-point state) "iŠ A@TbˆÂÃ!ˆ` A@U?…fÄuˆ`ÅÆ!ˆ`{lj — Ê !ËN‰¨ƒ@Ì  #‚eƒN  \"‚e GÎV…e ÏÎOИ…eÑ  \"**‡" [normal-indent state re-search-forward "\\sw\\|\\s_" -1 forward-sexp 1 nil method function intern-soft scheme-indent-function scheme-indent-specform indent-point 3 0 "def" scheme-indent-defform] 5]) #@2  (defvar scheme-body-indent 2 (#$ . 5542)) (defalias 'scheme-indent-specform #[(count state indent-point) "A@ ‰‰bˆi \\ÈuˆÉÈ!ˆÊ` ÈÌ$ˆ` Wƒ2ÂÍ΄$ ÏVƒD ‰\\\\D‚] ÏUƒ[ ÏU„W\fXƒ[\f‚],‡" [state count nil containing-form-column body-indent i containing-form-start scheme-body-indent 1 forward-sexp parse-partial-sexp indent-point t (byte-code "SÁÂ!ˆÃ`\fÂÅ$‡" [count forward-sexp 1 parse-partial-sexp indent-point t] 5) ((error)) 0 normal-indent] 6]) (defalias 'scheme-indent-defform #[(state indent-point) "A@bˆÁyˆ`AA@V…A@bˆ\ni\\‡" [state 1 scheme-body-indent] 2]) (defalias 'would-be-symbol #[(string) "ÁÂOØ?‡" [string 0 1 "("] 3]) (defalias 'next-sexp-as-string #[nil "ÀÁ!ˆ`ÃÁ!ˆ`\n{)‡" [forward-sexp 1 the-end backward-sexp] 2]) (defalias 'scheme-let-indent #[(state indent-point) "ÀÁwˆÂÃ!ƒÄÅ#‡ÄÈ#‡" [" " nil looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]" scheme-indent-specform 2 state indent-point 1] 4]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÃ#ˆÀÇÂÈ#ˆÀÉÂÅ#ˆÀÊÂË#ˆÀÌÂÅ#ˆÀÍÂÅ#ˆÀÎÂÃ#ˆÀÏÂÅ#ˆÀÐÂÅ#ˆÀÑÂÅ#ˆÀÒÂÅ#ˆÀÓÂÅ#ˆÀÔÂÅ#ˆƒ7ÀÖÂÅ#ˆÀ×ÂÅ#ˆÀØÂÅ#ˆÀÙÂÅ#ˆÀÚÂÅ#ˆÀÛÂÃ#ˆÀÜÂÅ#ˆÀÝÂÅ#ˆÀÞÂÅ#ˆÀßÂÃ#ˆÀàÂÅ#ˆÀáÂÈ#ˆÀâÂÅ#ˆÀãÂÅ#ˆÀäÂÅ#ˆÀåÂÅ#ˆÀæÂÅ#ˆÀçÂÅ#ˆÀèÂÅ#ˆÀéÂÅ#ˆÀêÂÅ#ˆÀëÂÅ#ˆÀìÂÅ#ˆÀíÂÅ#ˆÀîÂÅ#ˆÀïÂÅ#ˆÀðÂÅ#ˆÀñÂÅ#ˆÀòÂÅ#ˆÀóÂÅ#ˆÀôÂÅ#ˆÀõÂÅ#ˆÀöÂÅ#ˆÀ÷ÂÅ#ˆÀøÂÅ#ˆÀùÂÅ#ˆÀ‡" [put begin scheme-indent-function 0 case 1 delay do 2 lambda let scheme-let-indent let* letrec sequence call-with-input-file with-input-from-file with-input-from-port call-with-output-file with-output-to-file with-output-to-port scheme-mit-dialect fluid-let in-package let-syntax local-declare macro make-environment named-lambda using-syntax with-input-from-string with-output-to-string with-values syntax-table-define list-transform-positive list-transform-negative list-search-positive list-search-negative access-components assignment-components combination-components comment-components conditional-components disjunction-components declaration-components definition-components delay-components in-package-components lambda-components lambda-components* lambda-components** open-block-components pathname-components procedure-components sequence-components unassigned\?-components unbound\?-components variable-components] 4) #@57 Indent each line of the list starting just after point. (defalias 'scheme-indent-sexp #[nil "ÀCÁÀ‰‰‰‰ŠÉÊ!ˆ)ŠÀ ?… À\f\f„nm‰„nÍ`Àˆ`À‰ %‰@Î ›@ƒTÏ ˆÀˆÎ ›À ˆÐ ›@ƒgÊyˆÑ ›À ˆ‚'Ò‰\fƒ,ÁX‰„ VƒA S‰ ‚y Wƒ¤ÀB T‰ ‚Êyˆ`ÓÀwˆm„ÔÕ!„@ƒÍ@ÁYƒÍ@‚ÿÖ@…Ø@[!‰¨ƒë‰ ˆ‚þAƒúA@[ ˆ@)i\nU„`|ˆ\njˆ‚.‡" [nil 0 this-indent state inner-loop-done outer-loop-done bol next-depth indent-stack forward-sexp 1 last-depth innerloop-done parse-partial-sexp 4 indent-for-comment 3 5 t " " looking-at "[;\n]" calculate-scheme-indent val] 8 (#$ . 7749) nil]) (provide (quote scheme)) emacs-19.30/lisp/scribe.elc100666 13437 1 16107 5752043547 14205 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed May 3 23:17:51 1995 ;;; from file /home/fsf/rms/e19/lisp/scribe.el ;;; emacs version 19.28.90.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/home/fsf/rms/e19/lisp/scribe.el' was compiled for Emacs 19")) #@41 Syntax table used while in scribe mode. (defvar scribe-mode-syntax-table nil (#$ . 478)) #@41 Abbrev table used while in scribe mode. (defvar scribe-mode-abbrev-table nil (#$ . 573)) #@75 *Non-NIL makes Scribe mode use a different style of paragraph separation. (defvar scribe-fancy-paragraphs nil (#$ . -668)) #@74 *Non-NIL makes insert of double quote use `` or '' depending on context. (defvar scribe-electric-quote nil (#$ . -797)) #@106 *Non-NIL makes parenthesis char ( (]}> ) automatically insert its close if typed after an @Command form. (defvar scribe-electric-parenthesis nil (#$ . -924)) #@41 Open parenthesis characters for Scribe. (defconst scribe-open-parentheses "[({<" (#$ . 1088)) #@96 Close parenthesis characters for Scribe. These should match up with `scribe-open-parenthesis'. (defconst scribe-close-parentheses "])}>" (#$ . 1188)) (byte-code "„DÁ ÃŽÄ !Æ!ˆÇÈÉ\"ˆÇÊÉ\"ˆÇËÌ\"ˆÇÍÎ\"ˆÇÏÐ\"ˆÇÑÒ\"ˆÇÓÔ\"ˆÇÕÖ\"ˆÇ×Ø\"ˆÇÙÌ\"ˆ*ÚÛ!„MÜÛB„òÞ ßàá#ˆßâã#ˆßäå#ˆßæç#ˆßèé#ˆßêë#ˆßìí#ˆßîí#ˆßïí#ˆßðí#ˆßñò#ˆßóô#ˆßõö#ˆß÷ø#ˆßùú#ˆßûü#ˆßýþ#ˆßÿ@#ˆßAB#ˆßCD#ˆÜ‡" [scribe-mode-syntax-table syntax-table st ((set-syntax-table st)) copy-syntax-table text-mode-syntax-table set-syntax-table modify-syntax-entry 34 " " 92 64 "w " 60 "(> " 62 ")< " 91 "(] " 93 ")[ " 123 "(} " 125 "){ " 39 boundp scribe-mode-map nil current-load-list make-sparse-keymap define-key " " scribe-tab " " tab-to-tab-stop "s" center-line "}" up-list "S" center-paragraph "\"" scribe-insert-quote "(" scribe-parenthesis "[" "{" "<" "" scribe-chapter "" scribe-section "" scribe-subsection "" scribe-insert-environment "" scribe-bracket-region-be "[" scribe-begin "]" scribe-end " " scribe-italicize-word "" scribe-bold-word "" scribe-underline-word] 4) #@526 Major mode for editing files of Scribe (a text formatter) source. Scribe-mode is similar text-mode, with a few extra commands added. \{scribe-mode-map} Interesting variables: scribe-fancy-paragraphs Non-nil makes Scribe mode use a different style of paragraph separation. scribe-electric-quote Non-nil makes insert of double quote use `` or '' depending on context. scribe-electric-parenthesis Non-nil makes an open-parenthesis char (one of `([<{') automatically insert its close if typed after an @Command form. (defalias 'scribe-mode #[nil "À ˆÁ\n!ˆÃÅÇÈÉ\"ˆ\nËÌ!ˆÍ\fËÎ!ˆÍÐQËÑ!ˆÒËÓ!ˆÐËÔ!ˆÕÖØ°ËÙ!ˆƒR‚SÛËÜ!ˆÝËÞ!ˆßà Pá\"!ˆãäå\"‡" [kill-all-local-variables use-local-map scribe-mode-map "Scribe" mode-name scribe-mode major-mode define-abbrev-table scribe-mode-abbrev-table nil local-abbrev-table make-local-variable comment-start "@Comment[" comment-start-skip scribe-open-parentheses "]" comment-column 0 comment-end paragraph-start "\\([\n\f]\\)\\|\\(@\\w+[" "].*[" scribe-close-parentheses "]$\\)" paragraph-separate scribe-fancy-paragraphs "$" sentence-end "\\([.?!]\\|@:\\)[]\"')}]*\\($\\| $\\| \\| \\)[ \n]*" compile-command "scribe " buffer-file-name set-syntax-table scribe-mode-syntax-table run-hooks text-mode-hook scribe-mode-hook] 5 (#$ . 2306) nil]) (defalias 'scribe-tab #[nil "Àc‡" ["@\\"] 1 nil nil]) #@35 Run Scribe on the current buffer. (defalias 'scribe #[nil "ÀÁ!‡" [call-interactively compile] 2 (#$ . 3676) nil]) #@145 Surround current word with Scribe construct @STRING[...]. COUNT specifies how many words to surround. A negative count means to skip backward. (defalias 'scribe-envelop-word #[(string count) "``ÀÁÀU„BhzÇUƒÈÉ^!ˆ`ÊË\fÍQ!ƒ/Îuˆ‚9\fbˆÏÁxˆÉuˆÈÐ]!ˆ` bˆ \fGWƒpŠÑÒ\f H!\fÓ#†eÑÒ H!\fÓ#)ƒp T‰„E \fGYƒŽ\fbˆÕ×±ˆ bˆØ×±‚®\fbˆ Hcˆ bˆÙ\f H±ˆ\fbˆÚuˆÁw,‡" [0 nil noparens ccoun epos spos count 119 forward-sexp -1 looking-at "@\\w[" scribe-open-parentheses "]" 2 "\\W" 1 search-forward char-to-string t scribe-close-parentheses "@end(" string ")" "@begin(" "@" 3] 4 (#$ . 3797)]) #@67 Underline COUNT words around point by means of Scribe constructs. (defalias 'scribe-underline-word #[(count) "ÀÁ\n\"‡" [scribe-envelop-word "u" count] 3 (#$ . 4409) "p"]) #@66 Boldface COUNT words around point by means of Scribe constructs. (defalias 'scribe-bold-word #[(count) "ÀÁ\n\"‡" [scribe-envelop-word "b" count] 3 (#$ . 4586) "p"]) #@67 Italicize COUNT words around point by means of Scribe constructs. (defalias 'scribe-italicize-word #[(count) "ÀÁ\n\"‡" [scribe-envelop-word "i" count] 3 (#$ . 4757) "p"]) (defalias 'scribe-begin #[nil "ÀcˆÁuˆÂÃÄ\"ˆÅÆÈQ!‡" ["\n" -1 scribe-envelop-word "Begin" 0 re-search-forward "[" scribe-open-parentheses "]"] 4 nil nil]) (defalias 'scribe-end #[nil "ÀcˆÁuˆÂÃÄ\"ˆÅÆÈQ!‡" ["\n" -1 scribe-envelop-word "End" 0 re-search-forward "[" scribe-open-parentheses "]"] 4 nil nil]) (defalias 'scribe-chapter #[nil "ÀcˆÁuˆÂÃÄ\"ˆÅÆÈQ!‡" ["\n" -1 scribe-envelop-word "Chapter" 0 re-search-forward "[" scribe-open-parentheses "]"] 4 nil nil]) (defalias 'scribe-section #[nil "ÀcˆÁuˆÂÃÄ\"ˆÅÆÈQ!‡" ["\n" -1 scribe-envelop-word "Section" 0 re-search-forward "[" scribe-open-parentheses "]"] 4 nil nil]) (defalias 'scribe-subsection #[nil "ÀcˆÁuˆÂÃÄ\"ˆÅÆÈQ!‡" ["\n" -1 scribe-envelop-word "SubSection" 0 re-search-forward "[" scribe-open-parentheses "]"] 4 nil nil]) (defalias 'scribe-bracket-region-be #[(env min max) "ŠbˆÁ\nñˆ\fbˆÅ\nñ)‡" [max "@end(" env ")\n" min "@begin("] 3 nil "sEnvironment: \nr"]) (defalias 'scribe-insert-environment #[(env) "À ``#ˆÂyˆÃcˆÄu‡" [scribe-bracket-region-be env 1 10 -1] 4 nil "sEnvironment: "]) #@217 Insert ``, '' or " according to preceding character. If `scribe-electric-quote' is non-NIL, insert ``, '' or " according to preceding character. With numeric arg N, always insert N " characters. Else just insert ". (defalias 'scribe-insert-quote #[(count) "„ „ÂÃ!!‡Ä‰‰hÈUƒ É‚ûoƒ(Ê‚ûŠËÊ`ÌZÍ#…4`)ŠËÎ`ÌZÍ#…C`)ŠËÏ`ÐZÍ#…R`)‰„z„aÊ‚û„j΂ûVƒv΂ûÊ‚û„ˆ„ˆÏ‚ûƒ„ VƒÏ‚ûƒ²„² Vƒ²Ê‚ûƒÇ„Ç VƒÇÏ‚ûƒÜ„Ü VƒÜ΂û Vƒî VƒîÏ‚ûVƒú΂ûÊc+‡" [count scribe-electric-quote self-insert-command prefix-numeric-value nil lastquote lastback lastfore 92 34 "``" search-backward 1000 t "''" "\"" 100] 5 (#$ . 5995) "P"]) #@184 If scribe-electric-parenthesis is non-NIL, insertion of an open-parenthesis character inserts the following close parenthesis character if the preceding text is of the form @Command. (defalias 'scribe-parenthesis #[(count) "ÀÁ\n!!ˆÃ‰‰\n†??…MŠÈuˆ`É\nPÃxˆgËš…0`\fSU?)…MÌÍÎh!!\n\"‰…MŠ Hc)+‡" [self-insert-command prefix-numeric-value count nil point-save paren-char at-command scribe-electric-parenthesis -1 "^ \n \f" scribe-open-parentheses 64 string-match regexp-quote char-to-string scribe-close-parentheses] 4 (#$ . 6687) "P"]) emacs-19.30/lisp/scroll-bar.elc100666 13437 1 10275 5763161671 14777 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Wed May 31 17:46:33 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/scroll-bar.el ;;; emacs version 19.28.93.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`scroll-bar.el' was compiled for Emacs 19.29 or later")) (require (quote mouse)) #@259 Given a scroll bar event EVENT, return the scroll bar position as a ratio. The value is a cons cell (PORTION . WHOLE) containing two integers whose ratio gives the event's vertical position in the scroll bar, with 0 referring to the top and 1 to the bottom. (defalias 'scroll-bar-event-ratio #[(event) "À 8‡" [2 event] 2 (#$ . 507)]) #@372 Given a pair (NUM . DENOM) and WHOLE, return (/ (* NUM WHOLE) DENOM). This is handy for scaling a position on a scroll bar into real units, like buffer positions. If SCROLL-BAR-POS is the (PORTION . WHOLE) pair from a scroll bar event, then (scroll-bar-scale SCROLL-BAR-POS (buffer-size)) is the position in the current buffer corresponding to that scroll bar position. (defalias 'scroll-bar-scale #[(num-denom whole) "ÀÁ\n@! _\nA¥!‡" [truncate float num-denom whole] 3 (#$ . 848)]) #@249 Toggle display of vertical scroll bars on each frame. This command applies to all frames that exist and frames to be created in the future. With a numeric argument, if the argument is negative, turn off scroll bars; otherwise, turn on scroll bars. (defalias 'scroll-bar-mode #[(flag) "ƒÁ! ž‰ƒ\fA‚Å)„#?‚,§?†,ÇYÈÉÊ\"ˆË ‰\f…TÍ\f@ÂBÎBD\"ˆ\fA‰\f„;Ï*‡" [flag prefix-numeric-value vertical-scroll-bars default-frame-alist assq t scroll-bar-mode 0 mapcar #[(param-name) " ž‰:ƒ\n ¡‚ B B‰)‡" [param-name default-frame-alist parameter scroll-bar-mode] 3] (vertical-scroll-bars horizontal-scroll-bars) frame-list frames modify-frame-parameters horizontal-scroll-bars nil] 6 (#$ . 1339) "P"]) #@118 Set the window start according to where the scroll bar is dragged. EVENT should be a scroll bar click or drag event. (defalias 'scroll-bar-set-window-start #[(event) "Á8:ƒ Á‚Â8)‰@Á 8ŠÆ\f!qˆŠeÇ deZ\"\\bˆÈyˆÉ\f`\"-‡" [event 2 1 end-position window portion-whole window-buffer scroll-bar-scale 0 set-window-start] 6 (#$ . 2067) "e"]) (defalias 'scroll-bar-drag-1 #[(event) "‰A@)‰@à 8ŠÅ\n!qˆeÆ\fdeZ\"\\bˆÇyˆÈ\n`\",‡" [event start-position window 2 portion-whole window-buffer scroll-bar-scale 0 set-window-start] 6]) #@133 Scroll the window by dragging the scroll bar slider. If you click outside the slider, the window scrolls to bring the slider there. (defalias 'scroll-bar-drag #[(event) "ÀÂ\f„\n`ÀÅ!ˆÇ ˆÈÂ!+‡" [nil done 0 echo-keystrokes point-before-scroll scroll-bar-drag-1 event (lambda nil (track-mouse (byte-code "?…&Á ‰¢Ã=ƒÁ \n¢Ä=ƒ Å\n!ˆ‚Ɖ‚‡" [done read-event event mouse-movement scroll-bar-movement scroll-bar-drag-1 t] 3))) sit-for] 2 (#$ . 2602) "e"]) #@112 Scroll the window's top line down to the location of the scroll bar click. EVENT should be a scroll bar click. (defalias 'scroll-bar-scroll-down #[(event) "À ÂŽ Ä 8:ƒÄ‚Å 8)‰@Ä8É\nË!ˆ)\n„3`\nÉ\nÌÍÎ S\"!.‡" [selected-window old-selected-window ((select-window old-selected-window)) event 2 1 end-position window portion-whole nil point-before-scroll select-window scroll-down scroll-bar-scale window-height] 5 (#$ . 3073) "e"]) #@108 Scroll the line next to the scroll bar click to the top of the window. EVENT should be a scroll bar click. (defalias 'scroll-bar-scroll-up #[(event) "À ÂŽ Ä 8:ƒÄ‚Å 8)‰@Ä8É\nË!ˆ)\n„3`\nÉ\nÌÍÎ S\"!.‡" [selected-window old-selected-window ((select-window old-selected-window)) event 2 1 end-position window portion-whole nil point-before-scroll select-window scroll-up scroll-bar-scale window-height] 5 (#$ . 3530) "e"]) (byte-code "ÀÁÂ\"ˆÀÃÂ\"ˆÀÄÅ\"ˆÀÆÇ\"ˆÀÈÇ\"ˆÉÊ!‡" [global-set-key [vertical-scroll-bar mouse-1] scroll-bar-scroll-up [vertical-scroll-bar drag-mouse-1] [vertical-scroll-bar down-mouse-2] scroll-bar-drag [vertical-scroll-bar mouse-3] scroll-bar-scroll-down [vertical-scroll-bar drag-mouse-3] provide scroll-bar] 3) emacs-19.30/lisp/select.elc100666 12120 1 15554 5744577273 14077 0ustar rmsdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:50:17 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/select.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/select.el' was compiled for Emacs 19")) (defalias (quote x-selection) (quote x-get-selection)) #@182 Return the value of an X Windows selection. The argument TYPE (default `PRIMARY') says which selection, and the argument DATA-TYPE (default `STRING') says how to convert the data. (defalias 'x-get-selection #[(&optional type data-type) "À † † Ä\"‡" [x-get-selection-internal type PRIMARY data-type STRING] 3 (#$ . 537)]) #@38 Return text pasted to the clipboard. (defalias 'x-get-clipboard #[nil "ÀÁÂ\"‡" [x-get-selection-internal CLIPBOARD STRING] 3 (#$ . 869)]) #@722 Make an X Windows selection of type TYPE and value DATA. The argument TYPE (default `PRIMARY') says which selection, and DATA specifies the contents. DATA may be a string, a symbol, an integer (or a cons of two integers or list of two integers). The selection may also be a cons of two markers pointing to the same buffer, or an overlay. In these cases, the selection is considered to be the text between the markers *at whatever time the selection is examined*. Thus, editing done in the buffer after you specify the selection can alter the effective value of the selection. The data may also be a vector of valid non-vector selection values. Interactively, the text of the region is used as the selection value. (defalias 'x-set-selection #[(type data) ";ƒ Á! !„FÄ !ƒ?Å GSÈYƒ9 H!„0ÉS‰‚*„FÊËÌ D\"ˆ„LÍ ƒXÎ \"ˆ‚\\Ï!ˆ ‡" [type intern x-valid-simple-selection-p data vectorp t i valid 0 nil signal error "invalid selection" PRIMARY x-own-selection-internal x-disown-selection-internal] 5 (#$ . 1014) (byte-code "„\nÁÂÃ!D‡ÁÄ Å ÆOD‡" [current-prefix-arg PRIMARY read-string "Set text for pasting: " region-beginning region-end nil] 4)]) (defalias 'x-valid-simple-selection-p #[(data) ";†o9†o¨†o:ƒ-@¨ƒ-A¨†oA:ƒ-A@¨†oÁ!†o:…oÂ@!…oÂA!…oÃ@!…oÃA!…oÃ@!ÃA!=…oÄÃ@!!…oÄÃA!!‡" [data overlayp markerp marker-buffer buffer-name] 3]) #@202 Returns the value of one of the 8 X server cut-buffers. Optional arg WHICH-ONE should be a number from 0 to 7, defaulting to 0. Cut buffers are considered obsolete; you should use selections instead. (defalias 'x-get-cut-buffer #[(&optional which-one) "À ƒ  H‚\fÃ!‡" [x-get-cut-buffer-internal which-one [CUT_BUFFER0 CUT_BUFFER1 CUT_BUFFER2 CUT_BUFFER3 CUT_BUFFER4 CUT_BUFFER5 CUT_BUFFER6 CUT_BUFFER7] CUT_BUFFER0] 3 (#$ . 2414)]) #@322 Store STRING into the X server's primary cut buffer. If PUSH is non-nil, also rotate the cut buffers: this means the previous value of the primary cut buffer moves the second cut buffer, and the second to the third, and so on (there are 8 buffers.) Cut buffers are considered obsolete; you should use selections instead. (defalias 'x-set-cut-buffer #[(string &optional push) "ƒÁÂ!ˆÃÄ \"‡" [push x-rotate-cut-buffers-internal 1 x-store-cut-buffer-internal CUT_BUFFER0 string] 3 (#$ . 2856)]) (defalias 'xselect-convert-to-string #[(selection type value) ";ƒ‡Á!ƒ(ŠÂÃ!!„ÄÅ!ˆÃ!qˆÆ!Ç!{)‡:ƒeÈ@!ƒeÈA!ƒeÉ@!ÉA!=„QÊÄË@AE\"ˆŠÉ@!†\\ÄÅ!qˆ@A{)‡Ì‡" [value overlayp buffer-name overlay-buffer error "selection is in a killed buffer" overlay-start overlay-end markerp marker-buffer signal "markers must be in the same buffer" nil] 5]) (defalias 'xselect-convert-to-length #[(selection type value) ";ƒ\nG‚LÁ!ƒÂÃ!Ä!Z!‚L:…LÅ@!…LÅA!…LÆ@!ÆA!=„EÇÈÉ@AE\"ˆÂ@AZ!‰…ZÊË\"ÌÍ\"B)‡" [value overlayp abs overlay-end overlay-start markerp marker-buffer signal error "markers must be in the same buffer" ash -16 logand 65535] 6]) (defalias 'xselect-convert-to-targets #[(selection type value) "ÀÁ \"B‰ ƒ9 @ A>ƒ! Æ @ A\"¡ˆ‚ A@Ç=ƒ2 ‰AA¡ˆ‚ A‰„ ÈÉ\f\"*‡" [TIMESTAMP mapcar car selection-converter-alist all rest delq _EMACS_INTERNAL apply vector] 5]) (defalias 'xselect-convert-to-delete #[(selection type value) "À !ˆÂ‡" [x-disown-selection-internal selection NULL] 2]) (defalias 'xselect-convert-to-filename #[(selection type value) "À !ƒÂà !†ÄÅ!!‡ :ƒ2Æ @!ƒ2Æ A!ƒ2ÂÇ @!†0ÄÅ!!‡È‡" [overlayp value buffer-file-name overlay-buffer error "selection is in a killed buffer" markerp marker-buffer nil] 3]) (defalias 'xselect-convert-to-charpos #[(selection type value) "À‰‰Ä !ƒÆ !Ç !‰‚2 :…]È @!…]È A!…] @ A‰…] S\nS‰ WƒG \n ÉÊË Ì\"Í Î\"BË\nÌ\"Í\nÎ\"B\"B+‡" [nil tmp b a overlayp value overlay-start overlay-end markerp SPAN vector ash -16 logand 65535] 8]) (defalias 'xselect-convert-to-lineno #[(selection type value) "À‰‰‰ :ƒ.Æ @!ƒ.Æ A!ƒ.Ç @!Ç A!È @!‰‚AÉ !…uÊ !Ë !Ì !‰…uŠ\nqˆÍÎ\f\"ÍÎ \") \fWƒ_\f  ÏÐÑ\fÒ\"Ó\fÔ\"BÑ Ò\"Ó Ô\"B\"B,‡" [nil tmp buf b a value markerp marker-position marker-buffer overlayp overlay-buffer overlay-start overlay-end count-lines 1 SPAN vector ash -16 logand 65535] 7]) (defalias 'xselect-convert-to-colno #[(selection type value) "À‰‰‰ :ƒ)Æ @!ƒ)Æ A!ƒ) @ AÇ\f!‰‚<È !…pÉ !Ê !Ë !‰…pŠ\nqˆ\fbˆi bˆi) \fWƒZ\f  ÌÍÎ\fÏ\"Ð\fÑ\"BÎ Ï\"Ð Ñ\"B\"B,‡" [nil tmp buf b a value markerp marker-buffer overlayp overlay-buffer overlay-start overlay-end SPAN vector ash -16 logand 65535] 7]) (defalias 'xselect-convert-to-os #[(selection type size) "À !‡" [symbol-name system-type] 2]) (defalias 'xselect-convert-to-host #[(selection type size) "À ‡" [system-name] 1]) (defalias 'xselect-convert-to-user #[(selection type size) "À ‡" [user-full-name] 1]) #@7 Emacs (defalias 'xselect-convert-to-class #[(selection type size) "À‡" [nil] 1 (#$ . 5817)]) #@7 emacs (defalias 'xselect-convert-to-name #[(selection type size) "À‡" [nil] 1 (#$ . 5915)]) (defalias 'xselect-convert-to-integer #[(selection type value) "¨…ÁÂ\"ÃÄ\"B‡" [value ash -16 logand 65535] 4]) (defalias 'xselect-convert-to-atom #[(selection type value) "9…‡" [value] 1]) (defalias 'xselect-convert-to-identity #[(selection type value) "À !‡" [vector value] 2]) (byte-code "ÀÂÃ!‡" [((TEXT . xselect-convert-to-string) (STRING . xselect-convert-to-string) (TARGETS . xselect-convert-to-targets) (LENGTH . xselect-convert-to-length) (DELETE . xselect-convert-to-delete) (FILE_NAME . xselect-convert-to-filename) (CHARACTER_POSITION . xselect-convert-to-charpos) (LINE_NUMBER . xselect-convert-to-lineno) (COLUMN_NUMBER . xselect-convert-to-colno) (OWNER_OS . xselect-convert-to-os) (HOST_NAME . xselect-convert-to-host) (USER . xselect-convert-to-user) (CLASS . xselect-convert-to-class) (NAME . xselect-convert-to-name) (ATOM . xselect-convert-to-atom) (INTEGER . xselect-convert-to-integer) (_EMACS_INTERNAL . xselect-convert-to-identity)) selection-converter-alist provide select] 2) emacs-19.30/lisp/sendmail.elc100666 12062 1 55474 6051027626 14347 0ustar bobdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 00:07:15 1995 ;;; from file /home/fsf/rms/e19/lisp/sendmail.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`sendmail.el' was compiled for Emacs 19.29 or later")) #@241 *Specifies how "From:" fields look. If `nil', they contain just the return address like: king@grassland.com If `parens', they look like: king@grassland.com (Elvis Parsley) If `angles', they look like: Elvis Parsley  (defvar mail-from-style (quote angles) (#$ . -477)) #@170 Non-nil means insert BCC to self in messages to be sent. This is done when the message is initialized, so you can remove or alter the BCC field to override the default. (defvar mail-self-blind nil (#$ . 776)) #@126 Non-nil means when sending a message wait for and display errors. nil means let mailer mail back a message to report errors. (defvar mail-interactive nil (#$ . 992)) #@70 Delete these headers from old message when it's inserted in a reply. (defvar mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" (#$ . 1164)) #@155 Function to call to send the current buffer as mail. The headers should be delimited by a line whose contents match the variable `mail-header-separator'. (defvar send-mail-function (quote sendmail-send-it) (#$ . 1439)) #@70 *Line used to separate headers from text in messages being composed. (defvar mail-header-separator "--text follows this line--" (#$ . -1664)) #@111 *Name of file to write all outgoing messages in, or nil for none. This can be an inbox file or an Rmail file. (defvar mail-archive-file-name nil (#$ . -1813)) #@163 *Address to insert as default Reply-to field of outgoing messages. If nil, it will be initialized from the REPLYTO environment variable when you first send mail. (defvar mail-default-reply-to nil (#$ . -1979)) #@299 *If non-nil, the name of a file to use instead of `/usr/lib/aliases'. This file defines aliases to be expanded by the mailer; this is a different feature from that of defining aliases in `.mailrc' to be expanded in Emacs. This variable has no effect unless your system uses sendmail as its mailer. (defvar mail-alias-file nil (#$ . -2196)) #@204 *If non-nil, the name of the user's personal mail alias file. This file typically should be in same format as the `.mailrc' file used by the `Mail' or `mailx' program. This file need not actually exist. (defvar mail-personal-alias-file "~/.mailrc" (#$ . -2543)) #@114 Normal hook, run each time a new outgoing mail message is initialized. The function `mail-setup' runs this hook. (defvar mail-setup-hook nil (#$ . 2812)) #@274 Alist of mail address aliases, or t meaning should be initialized from your mail aliases file. (The file's name is normally `~/.mailrc', but your MAILRC environment variable can override that name.) The alias definitions in the file have this form: alias ALIAS MEANING (defvar mail-aliases t (#$ . 2973)) #@74 The modification time of your mail alias file when it was last examined. (defvar mail-alias-modtime nil (#$ . 3288)) #@88 *Prefix insert on lines of yanked message being replied to. nil means use indentation. (defvar mail-yank-prefix nil (#$ . -3411)) #@117 *Number of spaces to insert at the beginning of each cited line. Used by `mail-yank-original' via `mail-yank-cite'. (defvar mail-indentation-spaces 3 (#$ . -3548)) #@352 Obsolete hook for modifying a citation just inserted in the mail buffer. Each hook function can find the citation between (point) and (mark t). And each hook function should leave point and mark around the citation text as modified. This is a normal hook, misnamed for historical reasons. It is semi-obsolete and mail agents should no longer use it. (defvar mail-yank-hooks nil (#$ . 3719)) #@313 *Hook for modifying a citation just inserted in the mail buffer. Each hook function can find the citation between (point) and (mark t). And each hook function should leave point and mark around the citation text as modified. If this hook is entirely empty (nil), a default action is taken instead of no action. (defvar mail-citation-hook nil (#$ . -4118)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp mail-abbrevs-loaded nil current-load-list mail-mode-map] 2) #@77 Read mail aliases from user's personal aliases file and set `mail-aliases'. (autoload (quote build-mail-aliases) "mailalias" '(#$ . 4589) nil) #@263 Expand all mail aliases in suitable header fields found between BEG and END. Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants. Optional second arg EXCLUDE may be a regular expression defining text to be removed from alias expansions. (autoload (quote expand-mail-aliases) "mailalias" '(#$ . 4739) nil) #@142 *Text inserted at end of mail buffer when a message is initialized. If t, it means to insert the contents of the file `mail-signature-file'. (defvar mail-signature nil (#$ . -5076)) #@59 *File containing the text inserted at end of mail buffer. (defvar mail-signature-file "~/.signature" (#$ . -5264)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp mail-reply-buffer nil current-load-list] 2) #@73 A list of actions to be performed upon successful sending of a message. (defvar mail-send-actions nil (#$ . 5465)) #@156 *A string containing header lines, to be inserted in outgoing messages. It is inserted before you edit the message, so you can edit or delete these lines. (defvar mail-default-headers nil (#$ . -5587)) #@223 *If non-nil, try to show RMAIL summary buffer after returning from mail. The functions \[mail-send-on-exit] or \[mail-dont-send] select the RMAIL summary buffer before returning, if it exists and this variable is non-nil. (defvar mail-bury-selects-summary t (#$ . -5796)) #@229 Set this non-nil if the system's mailer runs the header and body together. (This problem exists on Sunos 4 when sendmail is run in remote mode.) The value should be an expression to test whether the problem will actually occur. (defvar mail-mailer-swallows-blank-line (byte-code "ÀÁ\n\"…-ÃÄ!…-ÅÆ!ÈŽŠqˆÉÄ!ˆebˆÊ ÌÍÊÎ#,…-χ" [string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration file-readable-p "/etc/sendmail.cf" get-buffer-create " *temp*" buffer ((kill-buffer buffer)) insert-file-contents nil case-fold-search re-search-forward "^OR\\>" t (looking-at "[ ]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")] 4) (#$ . 6075)) #@39 Syntax table used while in mail mode. (defvar mail-mode-syntax-table nil (#$ . 6732)) (byte-code "„Á\n!ÃÄÅ#ˆÁ‡" [mail-mode-syntax-table copy-syntax-table text-mode-syntax-table modify-syntax-entry 37 ". "] 4) #@51 Additional expressions to highlight in Mail mode. (defvar mail-font-lock-keywords (byte-code "ÀÀÂPÄÅÆÇÈ !ÊQËÌEÍÎ Ï ÐÑ°ÒBÓ¯*‡" ["A-Za-z" cite-prefix "0-9_.@-" cite-suffix ("^To:" . font-lock-function-name-face) ("^B?CC:\\|^Reply-To:" . font-lock-keyword-face) ("^\\(Subject:\\)[ ]*\\(.+\\)?" (1 font-lock-comment-face) (2 font-lock-type-face nil t)) "^\\(" regexp-quote mail-header-separator "\\)$" 1 font-lock-comment-face "^[ ]*" "\\([" "]+[" "]*\\)?" "[>|}].*" font-lock-reference-face ("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*" . font-lock-string-face)] 11) (#$ . 6952)) #@52 Normal hook run before sending mail, in Mail mode. (defvar mail-send-hook nil (#$ . 7539)) (defalias 'sendmail-synch-aliases #[nil "ÀÁ\n!8\f š† ʼn)‡" [5 file-attributes mail-personal-alias-file modtime mail-alias-modtime t mail-aliases] 3]) (defalias 'mail-setup #[(to subject in-reply-to cc replybuffer actions) "„ÁÂ!à ˆ\fÅ=ƒÆÇ!ƒÉ ˆ\n \f ebˆÎcˆŠƒGÐ`Ó±ˆÔd\"ˆ*‚JÕ ˆƒeÐ×cˆ`Ó±ˆÔd\"ˆ*ƒÐÙ`ÛÓ±ˆÔd\"ˆ+܆ˆÞÓ±ˆƒ•cˆƒŸàÓ±ˆ!ƒ«âã Ó±ˆ$ƒ·å$Ó±ˆ&Ó±ˆƒÅ`'Å=ƒÞÇ(!ƒçécˆê(!ˆ‚ç'ƒç'cˆdbˆn„ñÕ ˆ)ƒûbˆ„„„ëÆ!ˆìí!‡" [mail-default-reply-to getenv "REPLYTO" sendmail-synch-aliases mail-aliases t nil file-exists-p mail-personal-alias-file build-mail-aliases actions mail-send-actions replybuffer mail-reply-buffer "To: " to " " address-start fill-prefix "\n" fill-region-as-paragraph newline cc "CC: " in-reply-to 78 fill-column "In-reply-to: " "Subject: " subject "" mail-default-headers "Reply-to: " mail-self-blind "BCC: " user-login-name mail-archive-file-name "FCC: " mail-header-separator mail-signature mail-signature-file "\n\n-- \n" insert-file-contents set-buffer-modified-p run-hooks mail-setup-hook] 3]) #@667 Major mode for editing mail to be sent. Like Text Mode but with these additional commands: C-c C-s mail-send (send the message) C-c C-c mail-send-and-exit C-c C-f move to a header field (and create it if there isn't): C-c C-f C-t move to To: C-c C-f C-s move to Subject: C-c C-f C-c move to CC: C-c C-f C-b move to BCC: C-c C-f C-f move to FCC: C-c C-t mail-text (move to beginning of message text). C-c C-w mail-signature (insert `mail-signature-file' file). C-c C-y mail-yank-original (insert current message, in Rmail). C-c C-q mail-fill-yanked-message (fill what was yanked). C-c C-v mail-sent-via (add a Sent-via field for each To or CC). (defalias 'mail-mode #[nil "À ˆÁÂ!ˆÃÁÄ!ˆÅ!ˆÇ!ˆ \nË\fÍÏÁÑ!ˆÒÁÓ!ˆÁÔ!ˆÕ!×QÕ!×QØÙÚ\"‡" [kill-all-local-variables make-local-variable mail-reply-buffer nil mail-send-actions set-syntax-table mail-mode-syntax-table use-local-map mail-mode-map text-mode-abbrev-table local-abbrev-table mail-mode major-mode "Mail" mode-name t buffer-offer-save font-lock-defaults (mail-font-lock-keywords t) paragraph-separate paragraph-start regexp-quote mail-header-separator "$\\|[ ]*[-_][-_][-_]+$\\|" run-hooks text-mode-hook mail-mode-hook] 3 (#$ . 8746) nil]) (byte-code "„]Á \n¤ÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÃÐÑ#ˆÃÒÓ#ˆÃÔÕ#ˆÃÖ×#ˆÃØÙ#ˆÃÚÛ#ˆÃÜÝ#ˆÃÞß#ˆÃàáÁá!B#ˆÃâã#ˆÃäå#ˆÃæç#ˆÃèé#ˆÃêë#ˆÃìí#ˆÃîïÁð!B#ˆÃñò#ˆÃóô#ˆÃõö#ˆÃ÷ø#ˆÃùú#ˆÃûü#ˆÃýþ#ˆÃÿ@#‡" [mail-mode-map make-sparse-keymap text-mode-map define-key "?" describe-mode "" mail-to "" mail-bcc "" mail-fcc "" mail-cc "" mail-subject "" mail-reply-to "" mail-text "" mail-yank-original "" mail-fill-yanked-message "" mail-signature "" mail-sent-via "" mail-send-and-exit "" mail-send [menu-bar mail] "Mail" [menu-bar mail fill] ("Fill Citation" . mail-fill-yanked-message) [menu-bar mail yank] ("Cite Original" . mail-yank-original) [menu-bar mail signature] ("Insert Signature" . mail-signature) [menu-bar mail cancel] ("Cancel" . mail-dont-send) [menu-bar mail send-stay] ("Send, Keep Editing" . mail-send) [menu-bar mail send] ("Send Message" . mail-send-and-exit) [menu-bar headers] "Headers" "Move to Header" [menu-bar headers reply-to] ("Reply-To" . mail-reply-to) [menu-bar headers sent-via] ("Sent Via" . mail-sent-via) [menu-bar headers text] ("Text" . mail-text) [menu-bar headers bcc] ("Bcc" . mail-bcc) [menu-bar headers fcc] ("Fcc" . mail-fcc) [menu-bar headers cc] ("Cc" . mail-cc) [menu-bar headers subject] ("Subject" . mail-subject) [menu-bar headers to] ("To" . mail-to)] 6) #@118 Send message like `mail-send', then, if no errors, exit from mail buffer. Prefix arg means don't delete this window. (defalias 'mail-send-and-exit #[(arg) "À ˆÁ\n!‡" [mail-send mail-bury arg] 2 (#$ . 11334) "P"]) #@90 Don't send the message you have been editing. Prefix arg means don't delete this window. (defalias 'mail-dont-send #[(arg) "À !‡" [mail-bury arg] 2 (#$ . 11553) "P"]) #@24 Bury this mail buffer. (defalias 'mail-bury #[(arg) "Àp!Âp!ˆÃÄ!ƒ&ÅÄ žAƒ&ÆÇ È \"ƒ&ÉÇ !‚„ʉ \f „jÎ „jŠÏÐÑ Ò\"!qˆÔ=\f…gÖ×!…g…gØ!…gÙ!?…g )\fƒ€ ƒ{Ú !‚ƒÛ ‚ƒÚ !*)‡" [other-buffer newbuf bury-buffer fboundp frame-parameters dedicated delq selected-frame visible-frame-list delete-frame nil summary-buffer rmail-flag arg one-window-p window-buffer next-window selected-window not major-mode rmail-mode mail-bury-selects-summary boundp rmail-summary-buffer buffer-name get-buffer-window switch-to-buffer delete-window] 4 (#$ . 11726)]) #@220 Send the message in the current buffer. If `mail-interactive' is non-nil, wait for success indication or error messages, and inform user. Otherwise any failure is reported in a message back to the user from the mailer. (defalias 'mail-send #[nil "ƒ\nÁÂ!‚à „ÁÄ!…DÅÆ!ˆÇÈ!ˆ ˆ\nƒ4ËÌ͈\nA‰\n„&ÇÎ!ˆ?…DÏË!ˆÐÑ!‡" [buffer-file-name y-or-n-p "Send buffer contents as mail message? " buffer-modified-p "Message already sent; resend? " run-hooks mail-send-hook message "Sending..." send-mail-function mail-send-actions nil (byte-code "À @@ @A\"‡" [apply mail-send-actions] 3) ((error)) "Sending...done" set-buffer-modified-p delete-auto-save-file-if-necessary t] 4 (#$ . 12295) nil]) (defalias 'sendmail-send-it #[nil "ÀÁ!ˆ\nƒÃÄ!‚ÅÃÆ!lj‰p \n \f ÎŽŠ\fqˆÏ ˆÐ!ˆdbˆhÑU„=ÑcˆebˆÒÓÔ!ÖQ!ˆ×Ö!ˆØÙ!ˆÚ  Û ˆƒdÝe \"ˆebˆÒÞ ß#ƒ~` Wƒ~×Ö!ˆ‚gß ebˆÒà ß#ƒ£Œ`ŠÇˆ`)}ˆáâ \n\")\n‚„ebˆÒã ß#ƒ³×ä!ˆebˆÒå ß#„j&'è )*ë=ƒì)±ˆeí\\Ú .‰/bˆÒð.Ù#ƒ/bˆñcˆÒò.Ù#ƒ×óß\"ˆ‚ðñcˆ*ô'õ±ˆ‚i*ö=ƒ]ì'÷±ˆ`/)cˆÚ ./bˆÒø.Ù#ƒ=×óß\"ˆ‚,/bˆÒù.Ù#ƒV×úß\"ˆ/bˆ‚A*ûcˆ‚i*„iì'Ö±ˆ* Tbˆü=!ƒyþ ˆebˆÒÿ ß#ƒŒ@ !ˆ\nƒ™Š qˆÏ ˆ))ABCDáedEF!ƒ·F‚ºGÇ ÇH¯IJ DK…×LKPC\n?…ßM\n†çN%\"ˆ)\n…Š qˆebˆÒOÇß#ƒ\n×P!ˆ‚÷Q ÅU?…RSed{\").‡" [require mail-utils mail-interactive generate-new-buffer " sendmail errors" 0 " sendmail temp" nil mailbuf delimline resend-to-addresses case-fold-search tembuf errbuf ((byte-code "À !ˆÂ !ƒÀ !ˆÀ‡" [kill-buffer tembuf bufferp errbuf] 2)) erase-buffer insert-buffer-substring 10 re-search-forward "^" regexp-quote mail-header-separator "\n" replace-match backward-char 1 point-marker sendmail-synch-aliases mail-aliases expand-mail-aliases "\n\n\n*" t "^Resent-to:" append mail-parse-comma-list "^Subject:\\([ ]*\n\\)+\\b" "" "^From:" user-mail-address login user-full-name fullname mail-from-style angles "From: " 6 fullname-end fullname-start "[^- !#-'*+/-9=?A-Z^-~]" "\"" "[\"\\]" "\\\\\\&" " <" ">\n" parens " (" "[()\\]" "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" "\\1(\\3)" ")\n" eval mail-mailer-swallows-blank-line newline "^FCC:" mail-do-fcc "/" default-directory apply call-process-region boundp sendmail-program "/usr/lib/sendmail" "-oi" "-f" user-login-name mail-alias-file "-oA" ("-oem" "-odb") ("-t") "\n\n* *" "; " buffer-size error "Sending...failed to %s"] 11]) (defalias 'mail-do-fcc #[(header-end) "ÀpÁ ÂÃ!Ä ŠebˆÊË\fÄ#ƒ8`ÀˆÍÀxˆ`{ B ΔÏyˆ`|ˆ‚qˆÐ ˆÑÒ ÓÔ!Õ±ˆÖuˆÖvˆ×Ø!ˆÙ!Ó±ˆdbˆÚ!ˆdbˆÛcˆÜbˆÀÝÑÀÄ#ƒÞuˆßcˆ‚p) ƒoà @!!p\"e#d$ŠebˆÜyˆ`)%!ƒŠ!qˆæ TdU?…¶d'èŽÀéê!…Ã*+,+ƒí ˆ~ˆdd}ˆîïð Õ±ˆÚ\"%$#ˆñcˆebˆ~ˆòñ!ˆ`d}ˆóÄ!ˆô+!ˆÀ'‚eæ T}ˆdbˆÚ\"#$#ˆ-‚eõ @!ƒ[ö @!ƒ[Š÷ø!qˆÀ,Ð ˆîïð Õ±ˆÚ\"%$#ˆñcˆùed @Ä$ˆÐ ˆ)‚eùeTd @Ä$ˆ- A‰ „‡)ú!-‡" [nil current-time generate-new-buffer " rmail output" t case-fold-search tembuf time rmailbuf fcc-list re-search-forward "^FCC:[ ]*" header-end " " 0 1 erase-buffer "\nFrom " user-login-name " " current-time-string "\n" -1 require mail-utils mail-rfc822-time-zone insert-buffer-substring 10 2 search-forward -5 62 find-buffer-visiting buffer curbuf beg end beg2 buffer-size max ((byte-code "ƒe}ˆÁ‡" [max nil] 2)) boundp rmail-current-message msg buffer-read-only rmail-maybe-set-message-counters "\f\n0, unseen,,\n*** EOOH ***\n" "Date: " mail-rfc822-date "\n" search-backward rmail-count-new-messages rmail-show-message file-exists-p mail-file-babyl-p get-buffer-create " mail-temp" write-region kill-buffer] 6]) #@61 Make a Sent-via header line from each To or CC header line. (defalias 'mail-sent-via #[nil "ŠebˆÀÁ\nÁQ!ˆÃyˆÄ ÅÆ ebˆÊË Å#…G`ÊÌ Å#ƒ5ÍÎ!ˆ‚9 bˆ`{ÏÐ\"ˆ)‚,‡" [search-forward "\n" mail-header-separator -1 point-marker t nil to-line case-fold-search end re-search-forward "^\\(to\\|cc\\):" "^[^ \n]" backward-char 1 insert-before-markers "Sent-via:"] 5 (#$ . 15844) nil]) #@32 Move point to end of To-field. (defalias 'mail-to #[nil "À ˆÁÂ!‡" [expand-abbrev mail-position-on-field "To"] 2 (#$ . 16232) nil]) #@37 Move point to end of Subject-field. (defalias 'mail-subject #[nil "À ˆÁÂ!‡" [expand-abbrev mail-position-on-field "Subject"] 2 (#$ . 16369) nil]) #@60 Move point to end of CC-field. Create a CC field if none. (defalias 'mail-cc #[nil "À ˆÁÂÃ\"†ÁÄ!ˆÅc‡" [expand-abbrev mail-position-on-field "cc" t "to" "\nCC: "] 3 (#$ . 16521) nil]) #@62 Move point to end of BCC-field. Create a BCC field if none. (defalias 'mail-bcc #[nil "À ˆÁÂÃ\"†ÁÄ!ˆÅc‡" [expand-abbrev mail-position-on-field "bcc" t "to" "\nBCC: "] 3 (#$ . 16713) nil]) #@49 Add a new FCC field, with file name completion. (defalias 'mail-fcc #[(folder) "À ˆÁÂÃ\"„ÁÄ!ˆÅ±‡" [expand-abbrev mail-position-on-field "fcc" t "to" "\nFCC: " folder] 3 (#$ . 16910) "FFolder carbon copy: "]) #@38 Move point to end of Reply-To-field. (defalias 'mail-reply-to #[nil "À ˆÁÂ!‡" [expand-abbrev mail-position-on-field "Reply-To"] 2 (#$ . 17129) nil]) (defalias 'mail-position-on-field #[(field &optional soft) "ÀÁebˆÄÅÆ!ÈQ!ˆÉ”ebˆÄÅÆ\n!ËQ Á#ƒ6ÄÌÀÍ#ˆÉyˆÎÀxˆÁ‚I„H bˆ\nбˆÎÀxˆÀ*‡" [nil t case-fold-search end re-search-forward "^" regexp-quote mail-header-separator "$" 0 field ":" "^[^ ]" move "\n" soft ": \n"] 4]) #@42 Move point to beginning of message text. (defalias 'mail-text #[nil "À ˆebˆÁ ÂQ!‡" [expand-abbrev search-forward "\n" mail-header-separator] 4 (#$ . 17560) nil]) #@102 Sign letter with contents of the file `mail-signature-file'. Prefix arg means put contents at point. (defalias 'mail-signature #[(atpoint) "Š„dbˆÁÂxˆÂˆ„`d|ˆÃcˆÄÅ!!)‡" [atpoint " \n" nil "\n\n-- \n" insert-file-contents expand-file-name mail-signature-file] 3 (#$ . 17730) "P"]) #@96 Fill the paragraphs of a message yanked into this one. Numeric argument means justify as well. (defalias 'mail-fill-yanked-message #[(&optional justifyp) "ŠebˆÀÁ\nÁQÃÄ#ˆÅ`dÄ$)‡" [search-forward "\n" mail-header-separator nil t fill-individual-paragraphs justifyp] 5 (#$ . 18024) "P"]) #@316 Modify text just inserted from a message to be cited. The inserted text should be the region. When this function returns, the region is again around the modified text. Normally, indent each nonblank line `mail-indentation-spaces' spaces. However, if `mail-yank-prefix' is non-nil, insert that prefix on each line. (defalias 'mail-indent-citation #[nil "`ÁÂÃ!\"ˆ\f„ÅÂÃ!#‚.Šbˆ`ÂÃ!W…-\fcˆÇyˆ‚))‡" [start mail-yank-clear-headers mark t mail-yank-prefix indent-rigidly mail-indentation-spaces 1] 4 (#$ . 18318)]) #@351 Insert the message being replied to, if any (in rmail). Puts point before the text and mark after. Normally, indents each nonblank line ARG spaces (default 3). However, if `mail-yank-prefix' is non-nil, insert that prefix on each line. Just \[universal-argument] as argument means don't indent, insert no prefix, and don't delete any header fields. (defalias 'mail-yank-original #[(arg) "…T`ÂÃ\"ˆÄ!ˆ :„A bˆ ƒ!Æ !‚#ƒ1ÉÈ!ˆ‚@\nƒ=ÉÊ!ˆ‚@Ë ˆ)ÌÃ!Í `p“ˆbˆl?…SÎc)‡" [mail-reply-buffer start delete-windows-on t insert-buffer arg prefix-numeric-value mail-indentation-spaces mail-citation-hook run-hooks mail-yank-hooks mail-indent-citation mark mark-marker 10] 4 (#$ . 18846) "P"]) (defalias 'mail-yank-clear-headers #[(start end) "…7Š bˆÂÃ\fÅ#…6Œ `}ˆ bˆÅÇÈÅ#)…5Éyˆ`ÇÊ!ˆËuˆ`|ˆ‚))‡" [mail-yank-ignored-headers start search-forward "\n\n" end t case-fold-search re-search-forward nil 0 "\n[^ ]" -1] 4]) #@1634 Edit a message to be sent. Prefix arg means resume editing (don't erase). When this function returns, the buffer `*mail*' is selected. The value is t if the message was newly initialized; otherwise, nil. Optionally, the signature file `mail-signature-file' can be inserted at the end; see the variable `mail-signature'. \ While editing message, type \[mail-send-and-exit] to send the message and exit. Various special commands starting with C-c are available in sendmail mode to move to message header fields: \{mail-mode-map} If `mail-self-blind' is non-nil, a BCC to yourself is inserted when the message is initialized. If `mail-default-reply-to' is non-nil, it should be an address (a string); a Reply-to: field with that address is inserted. If `mail-archive-file-name' is non-nil, an FCC field with that file name is inserted. The normal hook `mail-setup-hook' is run after the message is initialized. It can add more default fields to the message. When calling from a program, the first argument if non-nil says not to erase the existing contents of the `*mail*' buffer. The second through fifth arguments, TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil the initial contents of those header fields. These arguments should not have final newlines. The sixth argument REPLYBUFFER is a buffer whose contents should be yanked if the user types C-c C-y. The seventh argument ACTIONS is a list of actions to take if/when the message is sent. Each action looks like (FUNCTION . ARGS); when the message is sent, we apply FUNCTION to ARGS. This is how Rmail arranges to mark messages `answered'. (defalias 'mail #[(&optional noerase to subject in-reply-to cc replybuffer actions) "ÀÁ!ˆÂ !ˆÄ ˆÅ„4È ƒÉÊ!ƒ4Ë ˆÌ &ˆÓƒDÕ!ƒDÖ×!ˆ)‡" [pop-to-buffer "*mail*" auto-save-mode auto-save-default mail-mode nil initialized noerase buffer-modified-p y-or-n-p "Unsent message being composed; erase it? " erase-buffer mail-setup to subject in-reply-to cc replybuffer actions t buffer-auto-save-file-name file-exists-p message "Auto save file for draft message exists; consider M-x mail-recover"] 7 (#$ . 19777) "P"]) #@65 Reread contents of current buffer from its last auto-save file. (defalias 'mail-recover #[nil "À ‹ƒÃÅ ˆÆ Ã\")‚ÇÈ!)‡" [make-auto-save-file-name file-name ((byte-code "Á=„ÂÃ\f!ˆÅÇÈÉ\fÉÊ &)‘ˆÌÍÎ \"!‡" [system-type vax-vms "*Directory*" buffer-disable-undo standard-output "/" default-directory call-process "ls" nil "-l" file-name yes-or-no-p format "Recover auto save file %s? "] 8)) nil buffer-read-only erase-buffer insert-file-contents error "mail-recover cancelled"] 3 (#$ . 21949) nil]) #@65 Like `mail' command, but display mail buffer in another window. (defalias 'mail-other-window #[(&optional noerase to subject in-reply-to cc replybuffer sendactions) "ÀÁ‰‰‰ÇÈ!ˆ-É\n \f &‡" [t nil same-window-regexps same-window-buffer-names special-display-regexps special-display-buffer-names pop-up-windows pop-to-buffer "*mail*" mail noerase to subject in-reply-to cc replybuffer sendactions] 8 (#$ . 22461) "P"]) #@64 Like `mail' command, but display mail buffer in another frame. (defalias 'mail-other-frame #[(&optional noerase to subject in-reply-to cc replybuffer sendactions) "ÀÁ‰‰‰ÇÈ!ˆ-É\n \f &‡" [t nil same-window-regexps same-window-buffer-names special-display-regexps special-display-buffer-names pop-up-frames pop-to-buffer "*mail*" mail noerase to subject in-reply-to cc replybuffer sendactions] 8 (#$ . 22899) "P"]) (provide (quote sendmail)) emacs-19.30/lisp/server.elc100666 13437 1 21447 6051027642 14236 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 00:07:35 1995 ;;; from file /home/fsf/rms/e19/lisp/server.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`server.el' was compiled for Emacs 19.29 or later")) #@41 *The program to use as the edit server. (defvar server-program (expand-file-name "emacsserver" exec-directory) (#$ . -472)) #@67 *List of hooks to call when visiting a file for the Emacs server. (defvar server-visit-hook nil (#$ . -602)) #@73 *List of hooks to call when switching to a buffer for the Emacs server. (defvar server-switch-hook nil (#$ . -717)) #@73 *List of hooks to call when done editing a buffer for the Emacs server. (defvar server-done-hook nil (#$ . -839)) #@28 the current server process (defvar server-process nil (#$ . 959)) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp server-previous-string "" current-load-list] 2) #@225 List of current server clients. Each element is (CLIENTID BUFFERS...) where CLIENTID is a string that can be given to the server process to identify a client. When a buffer is marked as "done", it is removed from this list. (defvar server-clients nil (#$ . 1116)) #@69 List of clientids for clients requesting editing of current buffer. (defvar server-buffer-clients nil (#$ . 1386)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local server-buffer-clients put permanent-local t] 4) #@140 *The window to use for selecting Emacs server buffers. If nil, use the selected window. If it is a frame, use the frame's selected window. (defvar server-window nil (#$ . -1608)) #@148 *Regexp which should match filenames of temporary files which are deleted and reused after each edit by the programs that invoke the emacs server. (defvar server-temp-file-regexp "^/tmp/Re\\|/draft$" (#$ . -1794)) (byte-code "À ž„\n BÀ‡" [server-buffer-clients minor-mode-alist (server-buffer-clients " Server")] 2) (defalias 'server-log #[(string) "ÀÁ!…ŠÁqˆdbˆÂ Ã\f±ˆn†Å )‡" [get-buffer "*server*" current-time-string " " string newline] 3]) (defalias 'server-sentinel #[(proc msg) "À !Â=ƒÃÄÅ!!‡À !Æ=…ÃÄÇ!!‡" [process-status proc exit server-log message "Server subprocess exited" signal "Server subprocess killed"] 3]) #@371 Allow this Emacs process to be a server for client processes. This starts a server communications subprocess through which client "editors" can send your editing commands to this Emacs job. To use the server, set up the program `emacsclient' in the Emacs distribution as your standard "editor". Prefix arg means just kill any existing server communications subprocess. (defalias 'server-start #[(&optional leave-dead) "ƒÁÂ\"ˆÂÃĈÂÅÆˆÇ ÉÊ\" ÂÌ͈ ƒ-ÂÎψ*ƒC@A@Ò!ˆ)‚.?…kƒSÔÕÖ!!ˆÂØÙÂ#)ÁÛ\"ˆÜÝ\"ˆÞ!‡" [server-process set-process-sentinel nil (delete-process server-process) ((error)) (delete-file "~/.emacs_server") ((error)) system-name sysname string-match "\\." dot-index (byte-code "ÀÁÂà \f#!‡" [delete-file format "/tmp/esrv%d-%s" user-uid sysname] 5) ((error)) (byte-code "ÀÁÂà \fÅO#!‡" [delete-file format "/tmp/esrv%d-%s" user-uid sysname 0 dot-index] 7) ((error)) server-clients buffer server-buffer-done leave-dead server-log message "Restarting server" process-connection-type start-process "server" server-program server-sentinel set-process-filter server-process-filter process-kill-without-query] 4 (#$ . 2434) "P"]) (defalias 'server-process-filter #[(proc string) "À !ˆ\n PÃÄ \"ƒÀ ʼn”OƉÇ \n Å•ÆOÃÌ \"ƒ;ÍÎ Å•ÆOP!ˆ‚¼ÃÏ \"ƒ¼ Å•ÆO‰ ÅÃÐ \"OC\n Å•ÆO ÃÑ \"ƒ ŔŕSO Å•ÆO ÃÓ\"ƒŒÔÇÆO!‚™D B Ç)‚^Õ \n\"ˆ\nB×\nA@!ˆØÙ!ˆÍÚÛ!!ˆ,‚ ‰‡" [server-log string server-previous-string string-match "\n" 0 nil 1 lineno files client request "^Error: " message "Server error: " "^Client: " " " "[^ ]+ " arg "\\`\\+[0-9]+\\'" read server-visit-files server-clients server-switch-buffer run-hooks server-switch-hook substitute-command-keys "When done with a buffer, type \\[server-edit]"] 6]) #@127 Finds FILES and returns the list CLIENT with the buffers nconc'd. FILES is an alist whose elements are (FILENAME LINENUMBER). (defalias 'server-visit-files #[(files client) "ÀÁpÅŽƒv@@È!‰ƒN\nqƒNÉ!ƒ<Ê\n!ƒ4Ë\n!ƒXÌÁÀ\"ˆ‚XÍÎÏQ!ƒXÐ!ˆ‚XÑ!qˆÒÓ!ˆ*Ô@A@!ˆ@Bp\fBA‰„ )\f¤+‡" [nil t obuf last-nonmenu-event client-record ((set-buffer obuf)) files filen get-file-buffer file-exists-p verify-visited-file-modtime buffer-modified-p revert-buffer y-or-n-p "File no longer exists: " ", write buffer to file? " write-file find-file-noselect run-hooks server-visit-hook goto-line client server-buffer-clients] 5 (#$ . 4213)]) #@270 Mark BUFFER as "done" for its client(s). This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED). NEXT-BUFFER is another server buffer, as a suggestion for what to select next, or nil. KILLED is t if we killed BUFFER (because it was a temp file). (defalias 'server-buffer-done #[(buffer) "À !Â=Ã‰Ä  \nƒ–@  „+\f >A@ Í\f \"ˆ ‰ƒ[Ï@!ƒRÐ@!„RÍ@ \"ˆA‰„:) A„Œ\nƒ†„pÑÒ!ˆÃÓ ÔÕ @\"\"ˆÖÔÕ @\"!ˆÍ \")A‰„Ï\f!ƒÈÐ\f!ƒÈŠ\fqˆÃØÙ!ˆ)Ú\f!ƒÃÛ\f!ˆÄ‚ÈÜ\f!ˆ -D‡" [process-status server-process run nil t server-clients old-clients first killed next-buffer running client buffer delq tail bufferp buffer-name sit-for 1 send-string format "Close: %s Done\n" server-log server-buffer-clients run-hooks server-done-hook server-temp-file-p kill-buffer bury-buffer] 6 (#$ . 4870)]) #@258 Return non-nil if BUFFER contains a file considered temporary. These are files whose names suggest they are repeatedly reused to pass information to another program. The variable `server-temp-file-regexp' controls which filenames are considered temporary. (defalias 'server-temp-file-p #[(buffer) "À !…\f À !\"‡" [buffer-file-name buffer string-match server-temp-file-regexp] 4 (#$ . 5726)]) #@294 Offer to save current buffer, mark it as "done" for clients. This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED). NEXT-BUFFER is another server buffer, as a suggestion for what to select next, or nil. KILLED is t if we killed the BUFFER (because it was a temp file). (defalias 'server-done #[nil "p …-Â!ƒÉÆ ˆ*‚*Ç ƒ*ÈÉ\nËQ!ƒ*Æ!ˆÌ!)‡" [buffer server-buffer-clients server-temp-file-p nil buffer-backed-up version-control save-buffer buffer-modified-p y-or-n-p "Save file " buffer-file-name "? " server-buffer-done] 4 (#$ . 6128)]) (defalias 'server-kill-buffer-query-function #[nil "?† ÁÂÃÄp!\"!‡" [server-buffer-clients yes-or-no-p format "Buffer `%s' still has clients; kill it? " buffer-name] 5]) (add-hook (quote kill-buffer-query-functions) (quote server-kill-buffer-query-function)) (defalias 'server-kill-emacs-query-function #[nil "À \nƒÄÅÆÅÇ\n@A\"\">ƒÄ\nA‰„ ?†'ÈÉ!*‡" [nil server-clients tail live-client t mapcar stringp buffer-name yes-or-no-p "Server buffers still have clients; exit anyway? "] 7]) (add-hook (quote kill-emacs-query-functions) (quote server-kill-emacs-query-function)) #@695 Switch to next server editing buffer; say "Done" for current buffer. If a server buffer is current, it is marked "done" and optionally saved. When all of a client's buffers are marked as "done", the client is notified. 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. If invoked with a prefix argument, or if there is no server process running, starts server process and that is all. Invoked by \[server-edit]. (defalias 'server-edit #[(&optional arg) "„ ƒ !Ã>ƒÄÅ!‡ÆÇÈ \"‡" [arg server-process process-status (signal exit) server-start nil apply server-switch-buffer server-done] 3 (#$ . 7284) "P"]) #@126 Switch to another buffer, preferably one that has a client. Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it. (defalias 'server-switch-buffer #[(&optional next-buffer killed-one) "À !ƒ !ƒà !ˆ‚(Ä !ƒ(Å !„\"Æ ÃÇ !!ˆÈÉ !ƒ7ÃÊËÌÍ#!ˆÎËÌÍ#ÐÉ !ƒXÉ =„XÃÊËÌÍ#!ˆ‚>)ÑÉ Ë\"ˆƒÓ!ƒwÔ!ƒwÕ!‡Ö×Ø!\"‡ƒŽ×@A@\"‡?…˜ÕÛ !‡" [windowp server-window window-live-p select-window framep frame-live-p make-frame frame-selected-window window-minibuffer-p selected-window next-window nil nomini 0 previous-window last-window window-dedicated-p set-window-dedicated-p next-buffer bufferp buffer-name switch-to-buffer apply server-switch-buffer server-buffer-done server-clients killed-one other-buffer] 5 (#$ . 8182)]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [global-set-key "#" server-edit provide server] 3) emacs-19.30/lisp/sgml-mode.elc100666 13437 1 11371 5770131710 14606 0ustar jimbdaemon;ELC ;;; compiled by kwzh@nutrimat.gnu.ai.mit.edu on Thu Jun 15 18:27:16 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/sgml-mode.el ;;; emacs version 19.28.94.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`sgml-mode.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!‡" [provide sgml-mode require compile] 2) #@134 *The command to validate an SGML document. The file name of current buffer file name will be appended to this, separated by a space. (defconst sgml-validate-command "sgmls -s" (#$ . -547)) #@51 The command last used to validate in this buffer. (defvar sgml-saved-validate-command nil (#$ . 742)) #@22 Keymap for SGML mode (defvar sgml-mode-map nil (#$ . 850)) (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÁ‡" [sgml-mode-map make-sparse-keymap define-key ">" sgml-close-angle "/" sgml-slash "" sgml-validate] 4) #@159 Major mode for editing SGML. Makes > display the matching <. Makes / display matching /. Use \[sgml-validate] to validate your document with an SGML parser. (defalias 'sgml-mode #[nil "À ˆ Ã\f!ˆÅÇÉÊ!ˆË\nÉÌ!ˆÍ\fÉÎ!ˆÏ!ˆÉÑ!ˆÒÉÓ!ˆÔÉÕ!ˆÖÉ×!ˆØÙÚÛ\"‡" [kill-all-local-variables text-mode-abbrev-table local-abbrev-table use-local-map sgml-mode-map "SGML" mode-name sgml-mode major-mode make-local-variable paragraph-start "^[ \n]\\|\\($\\)" paragraph-separate "^[ \n]*$\\|^$" sgml-saved-validate-command set-syntax-table text-mode-syntax-table comment-start "" comment-indent-function sgml-comment-indent comment-start-skip "--[ ]*" run-hooks text-mode-hook sgml-mode-hook] 3 (#$ . 1061) nil]) (defalias 'sgml-comment-indent #[nil "ÀÁ!ƒ!`SfÂ=ƒ`ÃZfÄ=„!ÅÆxˆiT]‡È‡" [looking-at "--" 33 2 60 " " nil comment-column 0] 2]) #@95 Regular expression that matches a non-empty start tag. Any terminating > or / is not matched. (defconst sgml-start-tag-regex "<[A-Za-z]\\([-.A-Za-z0-9= \n ]\\|\"[^\"]*\"\\|'[^']*'\\)*" (#$ . 2064)) #@45 Syntax table used for scanning SGML markup. (defvar sgml-mode-markup-syntax-table nil (#$ . 2268)) (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÁ‡" [sgml-mode-markup-syntax-table make-syntax-table modify-syntax-entry 60 "(>" 62 ")<" 45 "_ 1234" 39 "\""] 4) #@64 *If non-nil, is the maximum distance to search for matching <. (defconst sgml-angle-distance 4000 (#$ . -2529)) #@34 Insert > and display matching <. (defalias 'sgml-close-angle #[(arg) "ÀÁ\n\"ˆ\nÃV…Ë`ÄŠŒƒ!e`Z]}ˆ`eZÈVƒZ`ÉZfÊ=ƒZ`ÈZfÊ=ƒZËÌeÍ#ƒZ`ÏÐÍ#ƒY`=ƒY) „‡bˆÄÑÒˆ ƒ‡ bƒ‡ÓÔ!ƒ…ÓÖP!„…Ó×!ƒ‡Ä „®bˆØÙeÍ#ƒ®`ÏÛÍ#ƒ­`=ƒ­)) …Ê bˆÜ ƒÁÝÞ!‚Êßà Ĉ`{\"+‡" [insert-char 62 arg 0 nil blinkpos oldpos sgml-angle-distance 3 2 93 re-search-backward "" (byte-code "À ÁÄŽÅ!ˆÇÉ\"\n+À‡" [syntax-table t parse-sexp-ignore-comments oldtable ((set-syntax-table oldtable)) set-syntax-table sgml-mode-markup-syntax-table scan-sexps oldpos -1 blinkpos] 3) ((error)) looking-at "<\\(\\?\\|/?[A-Za-z>]\\|!\\([[A-Za-z]\\|--\\)\\)" sgml-start-tag-regex "[/<]" "" pos-visible-in-window-p sit-for 1 message "Matches %s"] 4 (#$ . 2647) "p"]) #@64 *If non-nil, is the maximum distance to search for matching /. (defconst sgml-slash-distance 1000 (#$ . -3556)) #@176 Insert / and display any previous matching /. Two /s are treated as matching if the first / ends a net-enabling start tag, and the second / is the corresponding null end tag. (defalias 'sgml-slash #[(arg) "ÀÁ\n\"ˆ\nÃV…—`ÄÊŒƒ$e`Z]}ˆÉ\neË#ƒ6ÕS=„vSbˆ„vÌÍeË#ƒvŠÉ\neË#…TÕ)‰`=ƒo Ã=ƒi`‚r S‚r T)‚;)…–bˆÏ ƒ‹ÐÑ!‚–ÒÓÃyˆ`T{\",‡" [insert-char 47 arg 0 nil level blinkpos oldpos sgml-slash-distance re-search-backward sgml-start-tag-regex t search-backward "/" tagend pos-visible-in-window-p sit-for 1 message "Matches %s"] 5 (#$ . 3675) "p"]) #@275 Validate an SGML document. Runs COMMAND, a shell command, in a separate process asynchronously with output going to the buffer *compilation*. You can then use the command \[next-error] to find the next error message and move to the line in the SGML document that caused it. (defalias 'sgml-validate #[(command) "ÂÃ\"‡" [command sgml-saved-validate-command compile-internal "No more errors"] 3 (#$ . 4261) (list (read-string "Validate command: " (or sgml-saved-validate-command (concat sgml-validate-command " " (let ((name (buffer-file-name))) (and name (file-name-nondirectory name)))))))]) emacs-19.30/lisp/sh-script.elc100666 12120 1 101632 6051132342 14515 0ustar rmsdaemon;ELC ;;; compiled by erik@naggum.no on Sat Nov 11 09:35:53 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/sh-script.el ;;; emacs version 19.29.90.5. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`sh-script.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ\f\"„ÅBÇ\f¤À‡" [require executable assoc "sh" interpreter-mode-alist ("\\.c?sh\\'\\|\\.shar\\'\\|/\\.\\(z?profile\\|bash_profile\\|z?login\\|bash_login\\|z?logout\\|bash_logout\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\|rcrc\\|[kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) auto-mode-alist (("ash" . sh-mode) ("bash" . sh-mode) ("csh" . sh-mode) ("dtksh" . sh-mode) ("es" . sh-mode) ("itcsh" . sh-mode) ("jsh" . sh-mode) ("ksh" . sh-mode) ("oash" . sh-mode) ("pdksh" . sh-mode) ("rc" . sh-mode) ("sh" . sh-mode) ("sh5" . sh-mode) ("tcsh" . sh-mode) ("wksh" . sh-mode) ("wsh" . sh-mode) ("zsh" . sh-mode))] 3) #@656 *Alist showing the direct ancestor of various shells. This is the basis for `sh-feature'. See also `sh-alias-alist'. By default we have the following three hierarchies: csh C Shell jcsh C Shell with Job Control tcsh Toronto C Shell itcsh ? Toronto C Shell rc Plan 9 Shell es Extensible Shell sh Bourne Shell ash ? Shell jsh Bourne Shell with Job Control bash GNU Bourne Again Shell ksh88 Korn Shell '88 ksh Korn Shell '93 dtksh CDE Desktop Korn Shell pdksh Public Domain Korn Shell wksh Window Korn Shell zsh Z Shell oash SCO OA (curses) Shell posix IEEE 1003.2 Shell Standard wsh ? Shell (defvar sh-ancestor-alist (quote ((ash . sh) (bash . jsh) (dtksh . ksh) (es . rc) (itcsh . tcsh) (jcsh . csh) (jsh . sh) (ksh . ksh88) (ksh88 . jsh) (oash . sh) (pdksh . ksh88) (posix . sh) (tcsh . csh) (wksh . ksh88) (wsh . sh) (zsh . ksh88))) (#$ . -1112)) #@158 *Alist for transforming shell names to what they really are. Use this where the name of the executable doesn't correspond to the type of shell it really is. (defvar sh-alias-alist (byte-code "Á=…Âä‡" [system-type linux ((csh . tcsh) (ksh . pdksh) (sh . bash)) ((ksh . ksh88) (sh5 . sh))] 2) (#$ . -2033)) #@48 *The executable of the shell being programmed. (defvar sh-shell-path (byte-code "ÀÁ!†‡" [getenv "SHELL" "/bin/sh"] 2) (#$ . -2348)) #@66 *Single argument string for the magic number. See `sh-feature'. (defvar sh-shell-arg (quote ((bash . "-norc") (csh . "-f") (ksh88 eval progn nil (if (file-exists-p "/etc/suid_profile") nil "-p")) (pdksh) (rc . "-p") (wksh . "-motif") (zsh . "-f"))) (#$ . -2489)) #@62 The shell being programmed. This is set by \[sh-set-shell]. (defvar sh-shell (byte-code "ÀÁ\n!! žA†ÀÁ\n!!‡" [intern file-name-nondirectory sh-shell-path sh-alias-alist] 3) (#$ . 2759)) #@195 Abbrev-table used in Shell-Script mode. See `sh-feature'. Due to the internal workings of abbrev tables, the shell name symbol is actually defined as the table for the like of \[edit-abbrevs]. (defvar sh-abbrevs (quote ((csh eval sh-abbrevs shell "switch" (quote sh-case) "getopts" (quote sh-while-getopts)) (es eval sh-abbrevs shell "function" (quote sh-function)) (ksh88 eval sh-abbrevs sh "select" (quote sh-select)) (rc eval sh-abbrevs shell "case" (quote sh-case) "function" (quote sh-function)) (sh eval sh-abbrevs shell "case" (quote sh-case) "function" (quote sh-function) "until" (quote sh-until) "getopts" (quote sh-while-getopts)) (shell "for" sh-for "loop" sh-indexed-loop "if" sh-if "tmpfile" sh-tmp-file "while" sh-while) (zsh eval sh-abbrevs ksh88 "repeat" (quote sh-repeat)))) (#$ . 2954)) #@60 Syntax-table used in Shell-Script mode. See `sh-feature'. (defvar sh-mode-syntax-table (quote ((csh eval identity sh) (sh eval sh-mode-syntax-table nil 34 "\"\"" 39 "\"'" 96 ".`" 36 "_" 33 "_" 37 "_" 58 "_" 46 "_" 94 "_" 126 "_") (rc eval sh-mode-syntax-table sh 34 "_" 96 "."))) (#$ . 3767)) #@35 Keymap used in Shell-Script mode. (defvar sh-mode-map (byte-code "À  ÃÄ#ˆÂ ÅÆ#ˆÂ ÇÈ#ˆÂ ÉÊ#ˆÂ ËÌ#ˆÂ ÍÎ#ˆÂ ÏÐ#ˆÂ ÑÒ#ˆÂ ÓÔ#ˆÂ ÕÖ#ˆÂ ×Ø#ˆÂ ÙÚ#ˆÂ ÛÜ#ˆÂ ÝÞ#ˆÂ ßà#ˆÂ áâ#ˆÂ ãä#ˆÂ åä#ˆÂ æä#ˆÂ çä#ˆÂ èä#ˆÂ éä#ˆÂ êë#ˆìíî ï $ˆìðñ ï $ˆìòó ï $ˆÂ ôõ#ˆìö÷ ï $ˆìøù ï $ˆìúû ï $ˆÂ üýÀý!B#ˆÂ þÿ#ˆÂ @A#ˆÂ BC#ˆÂ DE#ˆÂ FG#ˆÂ HI#ˆÂ JK#ˆÂ LM#ˆÂ NO#ˆÂ PQ#ˆ )‡" [make-sparse-keymap map define-key "(" sh-function "" sh-while "" sh-until "" sh-tmp-file "" sh-select "" sh-repeat "" sh-while-getopts "\f" sh-indexed-loop " " sh-if "" sh-for "" sh-case "=" sh-assignment "+" sh-add "˜" sh-execute-region "" executable-interpret "<" sh-maybe-here-document "(" skeleton-pair-insert-maybe "{" "[" "'" "`" "\"" " " sh-indent-line substitute-key-definition complete-tag comint-dynamic-complete current-global-map newline-and-indent sh-newline-and-indent delete-backward-char backward-delete-char-untabify ":" sh-set-shell beginning-of-defun sh-beginning-of-compound-command backward-sentence sh-beginning-of-command forward-sentence sh-end-of-command [menu-bar insert] "Insert" [menu-bar insert sh-while] ("While loop" . sh-while) [menu-bar insert sh-until] ("Until loop" . sh-until) [menu-bar insert sh-tmp-file] ("Temporary file" . sh-tmp-file) [menu-bar insert sh-select] ("Select statement" . sh-select) [menu-bar insert sh-repeat] ("Repeat loop" . sh-repeat) [menu-bar insert sh-while-getopts] ("Options loop" . sh-while-getopts) [menu-bar insert sh-indexed-loop] ("Indexed loop" . sh-indexed-loop) [menu-bar insert sh-if] ("If statement" . sh-if) [menu-bar insert sh-for] ("For loop" . sh-for) [menu-bar insert sh-case] ("Case statement" . sh-case)] 6) (#$ . 4067)) #@46 *Functions for doing TAB dynamic completion. (defvar sh-dynamic-complete-functions (quote (shell-dynamic-complete-environment-variable shell-dynamic-complete-command comint-dynamic-complete-filename)) (#$ . -5770)) #@83 *Value of `require-final-newline' in Shell-Script mode buffers. See `sh-feature'. (defvar sh-require-final-newline (quote ((csh . t) (pdksh . t) (rc eval . require-final-newline) (sh eval . require-final-newline))) (#$ . -5991)) #@190 *Regexp matching what may come before a comment `#'. This must contain one \(grouping\) since it is the basis for fontifying comments as well as for `comment-start-skip'. See `sh-feature'. (defvar sh-comment-prefix (quote ((csh . "\\(^\\|[^$]\\|\\$[^{]\\)") (rc eval identity csh) (sh . "\\(^\\|[ |&;()]\\)"))) (#$ . -6227)) #@172 *Regexp for the variable name and what may follow in an assignment. First grouping matches the variable name. This is upto and including the `=' sign. See `sh-feature'. (defvar sh-assignment-regexp (quote ((csh . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ ]*[-+*/%^]?=") (ksh88 . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ ]*\\([-+*/%&|~^]\\|<<\\|>>\\)?=") (rc . "\\<\\([a-zA-Z0-9_*]+\\)[ ]*=") (sh . "\\<\\([a-zA-Z0-9_]+\\)="))) (#$ . -6560)) #@57 The width for further indentation in Shell-Script mode. (defvar sh-indentation 4 (#$ . 7009)) #@71 *Don't remember variables less than this length for completing reads. (defvar sh-remember-variable-min 3 (#$ . -7109)) #@130 When non-`nil' is the end of header for prepending by \[sh-execute-region]. That command is also used for setting this variable. (defvar sh-header-marker nil (#$ . 7235)) #@127 *Regexp to determine the beginning of a shell command. The actual command starts at the beginning of the second \(grouping\). (defvar sh-beginning-of-command "\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ ]*\\([/~a-zA-Z0-9:]\\)" (#$ . -7413)) #@112 *Regexp to determine the end of a shell command. The actual command ends at the end of the first \(grouping\). (defvar sh-end-of-command "\\([/~a-zA-Z0-9:]\\)[ ]*\\([;#)}`|&]\\|$\\)" (#$ . -7650)) #@33 Word to delimit here documents. (defvar sh-here-document-word "EOF" (#$ . 7854)) #@75 Initial input in Bourne if, while and until skeletons. See `sh-feature'. (defvar sh-test (quote ((sh "[ ]" . 3) (ksh88 "[[ ]]" . 4))) (#$ . 7941)) #@180 *List of all shell builtins for completing read and fontification. Note that on some systems not all builtins are available or some are implemented as aliases. See `sh-feature'. (defvar sh-builtins (quote ((bash eval sh-append posix "alias" "bg" "bind" "builtin" "declare" "dirs" "enable" "fc" "fg" "help" "history" "jobs" "kill" "let" "local" "popd" "pushd" "source" "suspend" "typeset" "unalias") (bourne eval sh-append shell "eval" "export" "getopts" "newgrp" "pwd" "read" "readonly" "times" "ulimit") (csh eval sh-append shell "alias" "chdir" "glob" "history" "limit" "nice" "nohup" "rehash" "setenv" "source" "time" "unalias" "unhash") (dtksh eval identity wksh) (es "access" "apids" "cd" "echo" "eval" "false" "let" "limit" "local" "newpgrp" "result" "time" "umask" "var" "vars" "wait" "whatis") (jsh eval sh-append sh "bg" "fg" "jobs" "kill" "stop" "suspend") (jcsh eval sh-append csh "bg" "fg" "jobs" "kill" "notify" "stop" "suspend") (ksh88 eval sh-append bourne "alias" "bg" "false" "fc" "fg" "jobs" "kill" "let" "print" "time" "typeset" "unalias" "whence") (oash eval sh-append sh "checkwin" "dateline" "error" "form" "menu" "newwin" "oadeinit" "oaed" "oahelp" "oainit" "pp" "ppfile" "scan" "scrollok" "wattr" "wclear" "werase" "win" "wmclose" "wmmessage" "wmopen" "wmove" "wmtitle" "wrefresh") (pdksh eval sh-append ksh88 "bind") (posix eval sh-append sh "command") (rc "builtin" "cd" "echo" "eval" "limit" "newpgrp" "shift" "umask" "wait" "whatis") (sh eval sh-append bourne "hash" "test" "type") (shell "cd" "echo" "eval" "set" "shift" "umask" "unset" "wait") (wksh eval sh-append ksh88 "Xt[A-Z][A-Za-z]*") (zsh eval sh-append ksh88 "autoload" "bindkey" "builtin" "chdir" "compctl" "declare" "dirs" "disable" "disown" "echotc" "enable" "functions" "getln" "hash" "history" "integer" "limit" "local" "log" "popd" "pushd" "r" "readonly" "rehash" "sched" "setopt" "source" "suspend" "true" "ttyctl" "type" "unfunction" "unhash" "unlimit" "unsetopt" "vared" "which"))) (#$ . -8098)) #@271 *List of keywords that may be immediately followed by a builtin or keyword. Given some confusion between keywords and builtins depending on shell and system, the distinction here has been based on whether they influence the flow of control or syntax. See `sh-feature'. (defvar sh-leading-keywords (quote ((csh "else") (es "true" "unwind-protect" "whatis") (rc "else") (sh "do" "elif" "else" "if" "then" "trap" "type" "until" "while"))) (#$ . -10099)) #@67 *List of keywords not in `sh-leading-keywords'. See `sh-feature'. (defvar sh-other-keywords (quote ((bash eval sh-append bourne "bye" "logout") (bourne eval sh-append shell "done" "esac" "fi" "for" "function" "in" "return") (csh eval sh-append shell "breaksw" "default" "end" "endif" "endsw" "foreach" "goto" "if" "logout" "onintr" "repeat" "switch" "then" "while") (es "break" "catch" "exec" "exit" "fn" "for" "forever" "fork" "if" "return" "throw" "while") (ksh88 eval sh-append bourne "select") (rc "break" "case" "exec" "exit" "fn" "for" "if" "in" "return" "switch" "while") (shell "break" "case" "continue" "exec" "exit") (zsh eval sh-append bash "select"))) (#$ . -10557)) #@78 List of all shell variables available for completing read. See `sh-feature'. (defvar sh-variables (quote ((bash eval sh-append sh "allow_null_glob_expansion" "auto_resume" "BASH" "BASH_VERSION" "cdable_vars" "ENV" "EUID" "FCEDIT" "FIGNORE" "glob_dot_filenames" "histchars" "HISTFILE" "HISTFILESIZE" "history_control" "HISTSIZE" "hostname_completion_file" "HOSTTYPE" "IGNOREEOF" "ignoreeof" "LINENO" "MAIL_WARNING" "noclobber" "nolinks" "notify" "no_exit_on_failed_exec" "NO_PROMPT_VARS" "OLDPWD" "OPTERR" "PPID" "PROMPT_COMMAND" "PS4" "pushd_silent" "PWD" "RANDOM" "REPLY" "SECONDS" "SHLVL" "TMOUT" "UID") (csh eval sh-append shell "argv" "cdpath" "child" "echo" "histchars" "history" "home" "ignoreeof" "mail" "noclobber" "noglob" "nonomatch" "path" "prompt" "shell" "status" "time" "verbose") (es eval sh-append shell "apid" "cdpath" "CDPATH" "history" "home" "ifs" "noexport" "path" "pid" "prompt" "signals") (jcsh eval sh-append csh "notify") (ksh88 eval sh-append sh "ENV" "ERRNO" "FCEDIT" "FPATH" "HISTFILE" "HISTSIZE" "LINENO" "OLDPWD" "PPID" "PS3" "PS4" "PWD" "RANDOM" "REPLY" "SECONDS" "TMOUT") (oash eval sh-append sh "FIELD" "FIELD_MAX" "LAST_KEY" "OALIB" "PP_ITEM" "PP_NUM") (rc eval sh-append shell "apid" "apids" "cdpath" "CDPATH" "history" "home" "ifs" "path" "pid" "prompt" "status") (sh eval sh-append shell "CDPATH" "IFS" "OPTARG" "OPTIND" "PS1" "PS2") (shell "COLUMNS" "EDITOR" "HOME" "HUSHLOGIN" "LANG" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES" "LC_MONETARY" "LC_NUMERIC" "LC_TIME" "LINES" "LOGNAME" "MAIL" "MAILCHECK" "MAILPATH" "PAGER" "PATH" "SHELL" "TERM" "TERMCAP" "TERMINFO" "VISUAL") (tcsh eval sh-append csh "addsuffix" "ampm" "autocorrect" "autoexpand" "autolist" "autologout" "chase_symlinks" "correct" "dextract" "edit" "el" "fignore" "gid" "histlit" "HOST" "HOSTTYPE" "HPATH" "ignore_symlinks" "listjobs" "listlinks" "listmax" "matchbeep" "nobeep" "NOREBIND" "oid" "printexitvalue" "prompt2" "prompt3" "pushdsilent" "pushdtohome" "recexact" "recognize_only_executables" "rmstar" "savehist" "SHLVL" "showdots" "sl" "SYSTYPE" "tcsh" "term" "tperiod" "tty" "uid" "version" "visiblebell" "watch" "who" "wordchars") (zsh eval sh-append ksh88 "BAUD" "bindcmds" "cdpath" "DIRSTACKSIZE" "fignore" "FIGNORE" "fpath" "HISTCHARS" "hostcmds" "hosts" "HOSTS" "LISTMAX" "LITHISTSIZE" "LOGCHECK" "mailpath" "manpath" "NULLCMD" "optcmds" "path" "POSTEDIT" "prompt" "PROMPT" "PROMPT2" "PROMPT3" "PROMPT4" "psvar" "PSVAR" "READNULLCMD" "REPORTTIME" "RPROMPT" "RPS1" "SAVEHIST" "SPROMPT" "STTY" "TIMEFMT" "TMOUT" "TMPPREFIX" "varcmds" "watch" "WATCH" "WATCHFMT" "WORDCHARS" "ZDOTDIR"))) (#$ . 11242)) #@59 *Rules for highlighting shell scripts. See `sh-feature'. (defvar sh-font-lock-keywords (quote ((csh eval sh-append shell (quote ("\\${?[#?]?\\([A-Za-z_][A-Za-z0-9_]*\\|0\\)" 1 font-lock-variable-name-face))) (es eval sh-append executable-font-lock-keywords (quote ("\\$#?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\)" 1 font-lock-variable-name-face))) (rc eval identity es) (sh eval sh-append shell (quote ("\\$\\({#?\\)?\\([A-Za-z_][A-Za-z0-9_]*\\|[-#?@!]\\)" 2 font-lock-variable-name-face))) (shell eval sh-append executable-font-lock-keywords (quote ("\\\\." 0 font-lock-string-face)) (quote ("\\${?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\|[$*_]\\)" 1 font-lock-variable-name-face))))) (#$ . -13858)) #@70 *Additional rules for highlighting shell scripts. See `sh-feature'. (defvar sh-font-lock-keywords-1 (quote ((sh "[ ]in[ ]"))) (#$ . -14558)) #@68 *Yet more rules for highlighting shell scripts. See `sh-feature'. (defvar sh-font-lock-keywords-2 nil (#$ . -14708)) #@2071 Major mode for editing shell scripts. This mode works for many shells, since they all have roughly the same syntax, as far as commands, arguments, variables, pipes, comments etc. are concerned. Unless the file's magic number indicates the shell, your usual shell is assumed. Since filenames rarely give a clue, they are not further analyzed. This mode adapts to the variations between shells (see `sh-set-shell') by means of an inheritance based feature lookup (see `sh-feature'). This mechanism applies to all variables (including skeletons) that pertain to shell-specific features. The default style of this mode is that of Rosenblatt's Korn shell book. The syntax of the statements varies with the shell being used. The following commands are available, based on the current shell's syntax: \[sh-case] case statement \[sh-for] for loop \[sh-function] function definition \[sh-if] if statement \[sh-indexed-loop] indexed loop from 1 to n \[sh-while-getopts] while getopts loop \[sh-repeat] repeat loop \[sh-select] select loop \[sh-until] until loop \[sh-while] while loop \[backward-delete-char-untabify] Delete backward one position, even if it was a tab. \[sh-newline-and-indent] Delete unquoted space and indent new line same as this one. \[sh-end-of-command] Go to end of successive commands. \[sh-beginning-of-command] Go to beginning of successive commands. \[sh-set-shell] Set this buffer's shell, and maybe its magic number. \[sh-execute-region] Have optional header and region be executed in a subshell. \[sh-maybe-here-document] Without prefix, following an unquoted < inserts here document. {, (, [, ', ", ` Unless quoted with \, insert the pairs {}, (), [], or '', "", ``. If you generally program a shell different from your login shell you can set `sh-shell-path' accordingly. If your shell's file name doesn't correctly indicate what shell it is use `sh-alias-alist' to translate. If your shell gives error messages with line numbers, you can use \[executable-interpret] with your script for an edit-interpret-debug cycle. (defalias 'sh-mode #[nil "À ˆÁ\n!ˆÃÄ!ˆÃÅ!ˆÃÆ!ˆÃÇ!ˆÃÈ!ˆÃÉ!ˆÃÊ!ˆÃË!ˆÃÌ!ˆÃÍ!ˆÃÎ!ˆÃÏ!ˆÃÐ!ˆÃÑ!ˆÃÒ!ˆÃÓ!ˆÃÔ!ˆÃÕ!ˆÃÖ!ˆÃ×!ˆØÚÜÝÞàP‰á \"ãäåæç(éêebˆëìí!ƒ™îï!‚› !ˆðñ!‡" [kill-all-local-variables use-local-map sh-mode-map make-local-variable indent-line-function indent-region-function skeleton-end-hook paragraph-start paragraph-separate comment-start comment-start-skip require-final-newline sh-header-marker sh-shell-path sh-shell skeleton-pair-alist skeleton-pair-filter comint-dynamic-complete-functions comint-prompt-regexp font-lock-keywords font-lock-defaults skeleton-filter skeleton-newline-indent-rigidly process-environment sh-mode major-mode "Shell-script" mode-name sh-indent-line #[(b e) "ŠbˆÁÂ!ˆ` bˆÁÂ!ˆÄ` #)‡" [b skip-syntax-backward "-" e indent-rigidly sh-indentation] 4] #[nil "l† À † Á ‡" [newline indent-relative] 1] page-delimiter "\\|$" "# " sh-dynamic-complete-functions "^[ ]*" ((sh-font-lock-keywords sh-font-lock-keywords-1 sh-font-lock-keywords-2) nil nil ((47 . "w") (126 . "w") (46 . "w") (45 . "w") (95 . "w"))) ((96 _ 96)) sh-quoted-p ((< (quote (- (min sh-indentation (current-column)))))) skeleton-further-elements sh-feature t sh-set-shell looking-at "#![ ]*\\([^ \n ]+\\)" match-string 1 run-hooks sh-mode-hook] 4 (#$ . 14834) nil]) (defalias (quote shell-script-mode) (quote sh-mode)) #@118 Function to get simple fontification based on `sh-font-lock-keywords'. This adds rules for comments and assignments. (defalias 'sh-font-lock-keywords #[(&optional keywords) "À Â\"‡" [sh-feature sh-font-lock-keywords #[(list) "À !ÂPÃBÀ\f!ÅBÆ\"BB‡" [sh-feature sh-comment-prefix "\\(#.*\\)" (2 font-lock-comment-face t) sh-assignment-regexp (1 font-lock-variable-name-face) append keywords list] 5]] 3 (#$ . 18262)]) #@58 Function to get better fontification including keywords. (defalias 'sh-font-lock-keywords-1 #[(&optional builtins) "ÀÁÂÃ\f!Å#ÆÁÂÇÃ\f!Ã!\"Å#É°\nËÇ\f…6\nÍÁÂÃ!Å#ÏRÐBÃ!B\nÏPÒBCÃ!#!)‡" ["\\([;(){}`|&]\\|^\\)[ ]*\\(\\(\\(" mapconcat identity sh-feature sh-leading-keywords "\\|" "\\)[ ]+\\)?\\(" append sh-other-keywords "\\)" keywords sh-font-lock-keywords builtins "[ ]+\\)?\\(" sh-builtins "\\)\\>" ((2 font-lock-keyword-face nil t) (6 font-lock-function-name-face)) sh-font-lock-keywords-2 (2 font-lock-keyword-face) sh-font-lock-keywords-1] 9 (#$ . 18687)]) #@71 Function to get better fontification including keywords and builtins. (defalias 'sh-font-lock-keywords-2 #[nil "ÀÁ!‡" [sh-font-lock-keywords-1 t] 2 (#$ . 19267)]) #@150 Set this buffer's shell to SHELL (a string). Makes this script executable via `executable-set-magic'. Calls the value of `sh-set-shell-hook' if set. (defalias 'sh-set-shell #[(shell) "Á=ƒÂÃÄ !!‰žA† È !\"\nÈ !\fÈ !ÏÈ!ÒPÔÕ\"×Ø!È!ÚÈ!!ˆÏŠÝÞÏß#ƒfàá!ˆ‚W) ƒwâ @!ˆ A‰„kãä!ƒˆ$ƒˆä‰á!!ˆåæ!‡" [this-command sh-set-shell executable-set-magic intern file-name-nondirectory shell sh-shell sh-alias-alist sh-feature sh-shell-arg sh-shell-path sh-abbrevs local-abbrev-table sh-require-final-newline require-final-newline nil font-lock-keywords sh-comment-prefix "#+[ ]*" comment-start-skip format "[%s]" mode-line-process default-value process-environment sh-variables set-syntax-table sh-mode-syntax-table font-lock-syntax-table search-forward "=" t sh-assignment 0 sh-remember-variable boundp font-lock-mode run-hooks sh-set-shell-hook] 5 (#$ . 19437) (list (completing-read "Name or path of shell: " interpreter-mode-alist (lambda (x) (eq (cdr x) (quote sh-mode)))))]) #@892 Index ALIST by the current shell. If ALIST isn't a list where every element is a cons, it is returned as is. Else indexing follows an inheritance logic which works in two ways: - Fall back on successive ancestors (see `sh-ancestor-alist') as long as the alist contains no value for the current shell. - If the value thus looked up is a list starting with `eval' its `cdr' is first evaluated. If that is also a list and the first argument is a symbol in ALIST it is not evaluated, but rather recursively looked up in ALIST to allow the function called to define the value for one shell to be derived from another shell. While calling the function, is the car of the alist element is the current shell. The value thus determined is physically replaced into the alist. Optional FUNCTION is applied to the determined value and the result is cached in ALIST. (defalias 'sh-feature #[(list &optional function) ":ƒ!‰ƒ @:ƒ A‰„ …)†¬\nƒ1Ã\f\nB‰\"A†¬\fʼn‰ƒP\fž‰„P\fžA‰„=A‰:ƒ”@É=ƒ”ÉA‰:ƒŒA@ʼnžƒ†AÊË!D ˆ*‚Ž!‰¡ˆ\nƒ©\n‰@\nA!‰BC¤ˆ+‡" [list l function assoc sh-shell nil val elt sh-ancestor-alist eval quote sh-feature] 7 (#$ . 20449)]) #@343 Iff it isn't, define the current shell as abbrev table and fill that. Abbrev table will inherit all abbrevs from ANCESTOR, which is either an abbrev table or a list of (NAME1 EXPANSION1 ...). In addition it will define abbrevs according to the remaining arguments NAMEi EXPANSIONi ... EXPANSION may be either a string or a skeleton command. (defalias 'sh-abbrevs #[(ancestor &rest list) "À !ƒ J†Q\n<ƒ \n¤ˆÄ Å\"ˆÆ\n!ƒ$ÇÈ\n\"ˆ ƒOÉ J @ A@;ƒ: A@‚;Ê A@9…E A@$ˆ AA‰„( J‡" [boundp sh-shell ancestor list define-abbrev-table nil vectorp mapatoms #[(atom) "Á=† JÄ!JK$‡" [atom 0 define-abbrev sh-shell symbol-name] 5] define-abbrev ""] 6 (#$ . 21685)]) #@71 Copy TABLE and set syntax for succesive CHARs according to strings S. (defalias 'sh-mode-syntax-table #[(table &rest list) "À !\nƒÃ\n@\nA@ #ˆ\nAA‰„ ‡" [copy-syntax-table table list modify-syntax-entry] 5 (#$ . 22354)]) #@78 Return list composed of first argument (a list) physically appended to rest. (defalias 'sh-append #[(ancestor &rest list) " ¤‡" [list ancestor] 2 (#$ . 22585)]) #@73 Modify a copy of SKELETON by replacing I1 with REPL1, I2 with REPL2 ... (defalias 'sh-modify #[(skeleton &rest list) "À !\nƒ!\n@ ›†ÃÄ\n@\"\nA@ ˆ\nAA‰„ ‡" [copy-sequence skeleton list error "Index %d out of bounds"] 4 (#$ . 22753)]) #@132 Indent as far as preceding non-empty line, then by steps of `sh-indentation'. Lines containing only comments are considered empty. (defalias 'sh-indent-line #[nil "ŠÀÁ!ˆÂ ˆl„gÃ=„i)ÄŠÈ=ƒ%‚^i ˆi‰Wƒ=lƒ9‚^É‚^`Éyˆ`|ˆlƒV \n¥T\n_]‚^ \n¥T\n_jˆ)iË W…kÌÄw*‡" [line-move -1 back-to-indentation 35 nil current previous this-command newline-and-indent 0 sh-indentation current-indentation " "] 3 (#$ . 22999) nil]) #@398 Pass optional header and region to a subshell for noninteractive execution. The working directory is that of the buffer, and only environment variables are already set which is why you can mark a header within the script. With a positive prefix ARG, instead of sending region, define header from beginning of buffer to point. With a negative prefix ARG, instead of sending region, clear header. (defalias 'sh-execute-region #[(start end &optional flag) "ƒÁ!ÂV…à ‰‡\fƒ:ŠÅ\fbˆÇp #ˆÊe\f Z\\‰  #ˆ\f |*‡Ê  ÌP#‡" [flag prefix-numeric-value 0 point-marker sh-header-marker nil buffer-undo-list append-to-buffer start end shell-command-on-region sh-shell-path " -"] 5 (#$ . 23439) "r\nP"]) #@69 Make VARIABLE available for future completing reads in this buffer. (defalias 'sh-remember-variable #[(var) "G W„Â!„ÃP\fB‡" [var sh-remember-variable-min getenv "=" process-environment] 2 (#$ . 24152)]) #@52 Is point preceded by an odd number of backslashes? (defalias 'sh-quoted-p #[nil "ŠÀÁx)¦Ã=‡" ["\\\\" nil 2 -1] 2 (#$ . 24370)]) #@52 Insert a case/switch statement. See `sh-feature'. (defvar sh-case (quote ((csh "expression: " "switch( " str " )" n > "case " (read-string "pattern: ") 58 n > _ n "breaksw" n ("other pattern, %s: " < "case " str 58 n > _ n "breaksw" n) < "default:" n > _ n resume: < < "endsw") (es) (rc "expression: " "switch( " str " ) {" n > "case " (read-string "pattern: ") n > _ n ("other pattern, %s: " < "case " str n > _ n) < "case *" n > _ n resume: < < 125) (sh "expression: " "case " str " in" n > (read-string "pattern: ") 41 n > _ n ";;" n ("other pattern, %s: " < str 41 n > _ n ";;" n) < "*)" n > _ n resume: < < "esac"))) (#$ . 24504)) (byte-code "ÀÁÂ\"ˆÃÁÄÅ#‡" [defalias sh-case skeleton-proxy put menu-enable (sh-feature sh-case)] 4) #@39 Insert a for loop. See `sh-feature'. (defvar sh-for (quote ((csh eval sh-modify sh 1 "foreach " 3 " ( " 5 " )" 15 "end") (es eval sh-modify rc 3 " = ") (rc eval sh-modify sh 1 "for( " 5 " ) {" 15 125) (sh "Index variable: " "for " str " in " _ "; do" n > _ | 36 & (sh-remember-variable str) n < "done"))) (#$ . 25247)) (defalias (quote sh-for) (quote skeleton-proxy)) #@56 Insert an indexed loop from 1 to n. See `sh-feature'. (defvar sh-indexed-loop (quote ((bash eval identity posix) (csh "Index variable: " "@ " str " = 1" n "while( $" str " <= " (read-string "upper limit: ") " )" n > _ 36 str n "@ " str "++" n < "end") (es eval sh-modify rc 3 " =") (ksh88 "Index variable: " "integer " str "=0" n "while (( ( " str " += 1 ) <= " (read-string "upper limit: ") " )); do" n > _ 36 (sh-remember-variable str) n < "done") (posix "Index variable: " str "=1" n "while [ $" str " -le " (read-string "upper limit: ") " ]; do" n > _ 36 str n str 61 (sh-add (sh-remember-variable str) 1) n < "done") (rc "Index variable: " "for( " str " in" " `{awk 'BEGIN { for( i=1; i<=" (read-string "upper limit: ") "; i++ ) print i }'}) {" n > _ 36 (sh-remember-variable str) n < 125) (sh "Index variable: " "for " str " in `awk 'BEGIN { for( i=1; i<=" (read-string "upper limit: ") "; i++ ) print i }'`; do" n > _ 36 (sh-remember-variable str) n < "done"))) (#$ . 25622)) (defalias (quote sh-indexed-loop) (quote skeleton-proxy)) #@69 Insert an addition of VAR and prefix DELTA for Bourne (type) shell. (defalias 'sh-add #[(var delta) "ÀÁ! !\fÅWƒÆ‚ÇÈÉ\f!!ÀÊ!±‡" [sh-feature ((bash . "$[ ") (ksh88 . "$(( ") (posix . "$(( ") (rc . "`{expr $") (sh . "`expr $") (zsh . "$[ ")) sh-remember-variable var delta 0 " - " " + " number-to-string abs ((bash . " ]") (ksh88 . " ))") (posix . " ))") (rc . "}") (sh . "`") (zsh . " ]"))] 6 (#$ . 26670) (list (completing-read "Variable: " (mapcar (lambda (var) (substring var 0 (string-match "=" var))) process-environment)) (prefix-numeric-value current-prefix-arg))]) #@50 Insert a function definition. See `sh-feature'. (defvar sh-function (quote ((bash eval sh-modify ksh88 3 "() {") (ksh88 "name: " "function " str " {" n > _ n < "}") (rc eval sh-modify ksh88 1 "fn ") (sh nil "() {" n > _ n < "}"))) (#$ . 27253)) (defalias (quote sh-function) (quote skeleton-proxy)) #@44 Insert an if statement. See `sh-feature'. (defvar sh-if (quote ((csh "condition: " "if( " str " ) then" n > _ n ("other condition, %s: " < "else if( " str " ) then" n > _ n) < "else" n > _ n resume: < "endif") (es "condition: " "if { " str " } {" n > _ n ("other condition, %s: " < "} { " str " } {" n > _ n) < "} {" n > _ n resume: < 125) (rc eval sh-modify csh 3 " ) {" 8 (quote ("other condition, %s: " < "} else if( " str " ) {" n > _ n)) 10 "} else {" 17 125) (sh "condition: " (quote (setq input (sh-feature sh-test))) "if " str "; then" n > _ n ("other condition, %s: " < "elif " str "; then" n > _ n) < "else" n > _ n resume: < "fi"))) (#$ . 27559)) (defalias (quote sh-if) (quote skeleton-proxy)) #@53 Insert a repeat loop definition. See `sh-feature'. (defvar sh-repeat (quote ((es nil "forever {" n > _ n < 125) (zsh "factor: " "repeat " str "; do" n > _ n < "done"))) (#$ . 28272)) (byte-code "ÀÁÂ\"ˆÃÁÄÅ#‡" [defalias sh-repeat skeleton-proxy put menu-enable (sh-feature sh-repeat)] 4) #@47 Insert a select statement. See `sh-feature'. (defvar sh-select (quote ((ksh88 "Index variable: " "select " str " in " _ "; do" n > 36 str n < "done"))) (#$ . 28566)) (byte-code "ÀÁÂ\"ˆÃÁÄÅ#‡" [defalias sh-select skeleton-proxy put menu-enable (sh-feature sh-select)] 4) #@66 Insert code to setup temporary file handling. See `sh-feature'. (defvar sh-tmp-file (quote ((bash eval identity ksh88) (csh (file-name-nondirectory (buffer-file-name)) "set tmp = /tmp/" str ".$$" n "onintr exit" n _ (and (goto-char (point-max)) (not (bolp)) 10) "exit:\n" "rm $tmp* >&/dev/null" >) (es (file-name-nondirectory (buffer-file-name)) "local( signals = $signals sighup sigint; tmp = /tmp/" str ".$pid ) {" n > "catch @ e {" n > "rm $tmp^* >[2]/dev/null" n "throw $e" n < "} {" n > _ n < 125 n < 125) (ksh88 eval sh-modify sh 6 "EXIT") (rc (file-name-nondirectory (buffer-file-name)) "tmp = /tmp/" str ".$pid" n "fn sigexit { rm $tmp^* >[2]/dev/null }") (sh (file-name-nondirectory (buffer-file-name)) "TMP=/tmp/" str ".$$" n "trap \"rm $TMP* 2>/dev/null\" " 48))) (#$ . 28843)) (defalias (quote sh-tmp-file) (quote skeleton-proxy)) #@42 Insert an until loop. See `sh-feature'. (defvar sh-until (quote ((sh "condition: " (quote (setq input (sh-feature sh-test))) "until " str "; do" n > _ n < "done"))) (#$ . 29693)) (byte-code "ÀÁÂ\"ˆÃÁÄÅ#‡" [defalias sh-until skeleton-proxy put menu-enable (sh-feature sh-until)] 4) #@41 Insert a while loop. See `sh-feature'. (defvar sh-while (quote ((csh eval sh-modify sh 2 "while( " 4 " )" 10 "end") (es eval sh-modify rc 2 "while { " 4 " } {") (rc eval sh-modify csh 4 " ) {" 10 125) (sh "condition: " (quote (setq input (sh-feature sh-test))) "while " str "; do" n > _ n < "done"))) (#$ . 29981)) (defalias (quote sh-while) (quote skeleton-proxy)) #@191 Insert a while getopts loop. See `sh-feature'. Prompts for an options string which consists of letters for each recognized option followed by a colon `:' if the option accepts an argument. (defvar sh-while-getopts (quote ((bash eval sh-modify sh 18 "${0##*/}") (csh nil "while( 1 )" n > "switch( \"$1\" )" n (quote (setq input (quote ("- x" . 2)))) > > ("option, %s: " < "case " (quote (eval str)) (quote (if (string-match " +" str) (setq v1 (substring str (match-end 0)) str (substring str 0 (match-beginning 0))) (setq v1 nil))) str 58 n > "set " v1 & " = $2" | -4 & _ n (if v1 "shift") & n "breaksw" n) < "case --:" n > "shift" n < "default:" n > "break" n resume: < < "endsw" n "shift" n < "end") (ksh88 eval sh-modify sh 16 "print" 18 "${0##*/}" 36 "OPTIND-1") (posix eval sh-modify sh 18 "$(basename $0)") (sh "optstring: " "while getopts :" str " OPT; do" n > "case $OPT in" n > > (quote (setq v1 (append (vconcat str) nil))) ((prog1 (if v1 (char-to-string (car v1))) (if (eq (nth 1 v1) 58) (setq v1 (nthcdr 2 v1) v2 "\"$OPTARG\"") (setq v1 (cdr v1) v2 nil))) < str "|+" str 41 n > _ v2 n ";;" n) < "*)" n > "echo" " \"usage: " "`basename $0`" "[ +-" (quote (setq v1 (point))) str (quote (save-excursion (while (search-backward ":" v1 t) (replace-match " arg][ +-" t t)))) (if (eq (preceding-char) 45) -5) "][ --] args\"" n "exit 2" n < < "esac" n < "done" n "shift " (sh-add "OPTIND" -1)))) (#$ . 30355)) (byte-code "ÀÁÂ\"ˆÃÁÄÅ#‡" [defalias sh-while-getopts skeleton-proxy put menu-enable (sh-feature sh-while-getopts)] 4) #@73 Remember preceding identifier for future completion and do self-insert. (defalias 'sh-assignment #[(arg) "À !ˆ ÂX…ÊÄÅ!`ÇyˆÈ#…ÉÂ!)!‡" [self-insert-command arg 1 sh-remember-variable re-search-forward sh-feature sh-assignment-regexp 0 t match-string] 5 (#$ . 31893) "p"]) #@130 Inserts self. Without prefix, following unquoted `<' inserts here document. The document is bounded by `sh-here-document-word'. (defalias 'sh-maybe-here-document #[(arg) "ÀÁ\n!!ˆ\n†H`ÃZf\f=?†HŠÅÃ!ˆÆ )†Hcˆl„0ÈÉ!„0ÊcˆËˆÆ ƒ>È‚3Ì ˆŠÍ±)‡" [self-insert-command prefix-numeric-value arg 2 last-command-char backward-char sh-quoted-p sh-here-document-word looking-at "[ ]" 32 1 newline 10] 3 (#$ . 32177) "*P"]) #@42 Dynamically perform completion at point. (autoload (quote comint-dynamic-complete) "comint" '(#$ . 32604) t) #@44 Dynamically complete the command at point. (autoload (quote shell-dynamic-complete-command) "shell" '(#$ . 32719) t) #@45 Dynamically complete the filename at point. (autoload (quote comint-dynamic-complete-filename) "comint" '(#$ . 32842) t) #@57 Dynamically complete the environment variable at point. (autoload (quote shell-dynamic-complete-environment-variable) "shell" '(#$ . 32969) t) #@74 Strip unquoted whitespace, insert newline, and indent like current line. (defalias 'sh-newline-and-indent #[nil "À `ÁÂÃx!„Ä ƒÃuˆ`|ˆÅ ˆj‡" [current-indentation zerop " " nil sh-quoted-p newline] 5 (#$ . 33118) "*"]) #@50 Move point to successive beginnings of commands. (defalias 'sh-beginning-of-command #[nil "À ÂÃ#… Ä”b‡" [re-search-backward sh-beginning-of-command nil t 2] 4 (#$ . 33344) nil]) #@44 Move point to successive ends of commands. (defalias 'sh-end-of-command #[nil "À ÂÃ#… Ä•b‡" [re-search-forward sh-end-of-command nil t 1] 4 (#$ . 33529) nil]) emacs-19.30/lisp/shadowfile.elc100666 12120 1 50324 6045214326 14715 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:25:51 1995 ;;; from file /home/fsf/rms/e19/lisp/shadowfile.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`shadowfile.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!ˆÄÀ‡" [provide shadowfile require ange-ftp t find-file-visit-truename] 2) #@166 *If t, always copy shadow files without asking. If nil (the default), always ask. If not nil and not t, ask only if there is no buffer currently visiting the file. (defvar shadow-noquery nil (#$ . -575)) #@65 *If nonnil, do not display a message when a file needs copying. (defvar shadow-inhibit-message nil (#$ . -786)) #@185 If nonnil, shadowfile won't redefine C-x C-c. Normally it overloads the function `save-buffers-kill-emacs' to check for files have been changed and need to be copied to other systems. (defvar shadow-inhibit-overload nil (#$ . 905)) #@144 File to keep shadow information in. The shadow-info-file should be shadowed to all your accounts to ensure consistency. Default: ~/.shadows (defvar shadow-info-file nil (#$ . 1144)) #@354 File to store the list of uncopied shadows in. This means that if a remote system is down, or for any reason you cannot or decide not to copy your shadow files at the end of one emacs session, it will remember and ask you again in your next emacs session. This file must NOT be shadowed to any other system, it is host-specific. Default: ~/.shadow_todo (defvar shadow-todo-file nil (#$ . 1336)) #@40 The complete hostname of this machine. (defvar shadow-system-name (system-name) (#$ . 1737)) #@38 Your home directory on this machine. (defvar shadow-homedir nil (#$ . 1836)) #@52 List of host clusters (see shadow-define-cluster). (defvar shadow-clusters nil (#$ . 1919)) #@139 List of files that are shared between hosts. This list contains shadow structures with literal filenames, created by shadow-define-group. (defvar shadow-literal-groups nil (#$ . 2018)) #@161 List of file types that are shared between hosts. This list contains shadow structures with regexps matching filenames, created by shadow-define-regexp-group. (defvar shadow-regexp-groups nil (#$ . 2210)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ B‡" [boundp shadow-files-to-copy nil current-load-list shadow-hashtable shadow-info-buffer shadow-todo-buffer] 2) #@71 (shadow-when CONDITION . BODY) => evaluate BODY if CONDITION is true. (defalias 'shadow-when '(macro . #[(condition &rest body) "ÀÁ\nDÃ\fBBB‡" [if not condition nil body] 4 (#$ . 2597)])) #@78 Add members of list A to list B if they are not equal to items already in B. (defalias 'shadow-union #[(a b) "„ ‡@ ƒÂA \"‡ÂA@ B\"‡" [a b shadow-union] 4 (#$ . 2791)]) #@84 If FUNC applied to some element of LIST is nonnil, return the first such element. (defalias 'shadow-find #[(func list) "ƒ @!„A‰„@‡" [list func] 3 (#$ . 2974)]) #@123 Remove elements satisfying FUNC from LIST. Nondestructive; actually returns a copy of the list with the elements removed. (defalias 'shadow-remove-if #[(func list) "… @!ƒ A\"‡@ A\"B‡" [list func shadow-remove-if] 4 (#$ . 3153)]) #@68 Concatenate elements of the list of STRINGS with SEP between each. (defalias 'shadow-join #[(strings sep) "„Á‡A„@‡@ÂÃA\f\"Q‡" [strings "" " " shadow-join sep] 5 (#$ . 3399)]) #@94 Like regexp-quote, but includes the ^ and $ to make sure regexp matches nothing but STRING. (defalias 'shadow-regexp-superquote #[(string) "ÀÁ\n!ÃQ‡" ["^" regexp-quote string "$"] 3 (#$ . 3589)]) #@127 If PREFIX begins STRING, return the rest. Return value is nonnil if PREFIX and STRING are string= up to the length of PREFIX. (defalias 'shadow-suffix #[(prefix string) "G G\n Y… Ä O˜… ÅO*‡" [prefix string ls lp 0 nil] 4 (#$ . 3793)]) #@301 Creates a shadow cluster called NAME, using the PRIMARY hostname, REGEXP matching all hosts in the cluster. The variable shadow-clusters associates the names of clusters to these structures. This function is for program use: to create clusters interactively, use shadow-define-cluster instead. (defalias 'shadow-make-cluster #[(name primary regexp) " \nE‡" [name primary regexp] 3 (#$ . 4044)]) #@33 Return the name of the CLUSTER. (defalias 'shadow-cluster-name '(macro . #[(cluster) "À ÂE‡" [elt cluster 0] 3 (#$ . 4452)])) #@43 Return the primary hostname of a CLUSTER. (defalias 'shadow-cluster-primary '(macro . #[(cluster) "À ÂE‡" [elt cluster 1] 3 (#$ . 4584)])) #@48 Return the regexp matching hosts in a CLUSTER. (defalias 'shadow-cluster-regexp '(macro . #[(cluster) "À ÂE‡" [elt cluster 2] 3 (#$ . 4729)])) #@196 Put cluster NAME on the list of clusters, replacing old definition if any. PRIMARY and REGEXP are the information defining the cluster. For interactive use, call shadow-define-cluster instead. (defalias 'shadow-set-cluster #[(name primary regexp) "ÀÁ\n\"Ä # B‰)‡" [shadow-remove-if #[(x) " @š‡" [name x] 2] shadow-clusters rest shadow-make-cluster name primary regexp] 4 (#$ . 4879)]) #@36 Return cluster named NAME, or nil. (defalias 'shadow-get-cluster '(macro . #[(name) "À ÂE‡" [assoc name shadow-clusters] 3 (#$ . 5279)])) #@67 If SITE is a cluster, return primary host, otherwise return SITE. (defalias 'shadow-site-primary #[(site) "À \n\"‰ƒ Äœ‚ )‡" [assoc site shadow-clusters c 1] 4 (#$ . 5423)]) #@84 Given a SITE (hostname or cluster name), return the cluster that it is in, or nil. (defalias 'shadow-site-cluster #[(site) "À \n\"† ÃÄ\n\"‡" [assoc site shadow-clusters shadow-find #[(x) "À Âœ \"‡" [string-match x 2 site] 3]] 3 (#$ . 5607)]) #@54 Read a cluster name or hostname from the minibuffer. (defalias 'shadow-read-site #[nil "ÀÁ\n\"‰Äš?… )‡" [completing-read "Host or cluster name [RET when done]: " shadow-clusters ans ""] 4 (#$ . 5856)]) #@162 Nonnil iff SITE1 is or includes SITE2. Each may be a host or cluster name; if they are clusters, regexp of site1 will be matched against the primary of site2. (defalias 'shadow-site-match #[(site1 site2) " ˜†# \"Å !\fƒÇ\fÈœ\"‚\"˜*‡" [site1 site2 assoc shadow-clusters cluster1 shadow-site-primary primary2 string-match 2] 3 (#$ . 6068)]) #@42 Returns the default username for a site. (defalias 'shadow-get-user #[(site) "ÀÁ\n!!‡" [ange-ftp-get-user shadow-site-primary site] 3 (#$ . 6429)]) #@142 Parse PATH into (site user path) list, or leave it alone if it already is one. Returns nil if the argument is not a full ange-ftp pathname. (defalias 'shadow-parse-fullpath #[(fullpath) "<ƒ‡Á!‡" [fullpath ange-ftp-ftp-name] 2 (#$ . 6584)]) #@118 Parse any PATH into (site user path) list. Argument can be a simple path, full ange-ftp path, or already a hup list. (defalias 'shadow-parse-path #[(path) "À !† \nà E‡" [shadow-parse-fullpath path shadow-system-name user-login-name] 3 (#$ . 6837)]) #@124 Make an ange-ftp style fullpath out of HOST, USER (optional), and PATH. This is probably not as general as it ought to be. (defalias 'shadow-make-fullpath #[(host user path) "À … ÂP Ä °‡" ["/" user "@" host ":" path] 5 (#$ . 7095)]) (put (quote shadow-make-fullpath) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@65 Return FULLPATH with the pathname component changed to NEWPATH. (defalias 'shadow-replace-path-component #[(fullpath newpath) "À !‰@\nA@ Ç … ÈPÉ\f°,‡" [shadow-parse-fullpath fullpath hup newpath path user host "/" "@" ":"] 6 (#$ . 7430)]) #@135 If FILENAME is at this site, remove /user@host part. If refers to a different system or a different user on this system, return nil. (defalias 'shadow-local-file #[(file) "À !‰„\f ‚$Ã\n@\f\"ƒ#\nA@Å ˜ƒ#Æ\n8‚$Ç)‡" [shadow-parse-fullpath file hup shadow-site-match shadow-system-name user-login-name 2 nil] 4 (#$ . 7686)]) #@141 If hostname part of FILE is a cluster, expand it into the cluster's primary hostname. Will return the pathname bare if it is a local file. (defalias 'shadow-expand-cluster-in-file-name #[(file) "À !‰„ ‚6Å\f!†6Æ\f@!\fA@Ç\f8 \nË …. ÌP\nÍ°+*‡" [shadow-parse-path file nil cluster hup shadow-local-file shadow-site-primary 2 path user host "/" "@" ":"] 6 (#$ . 8020)]) #@44 Expand file name and get file's true name. (defalias 'shadow-expand-file-name #[(file &optional default) "ÀÁ\n \"!‡" [file-truename expand-file-name file default] 4 (#$ . 8410)]) #@159 Simplify FILENAME by replacing (when possible) home directory with ~, and hostname with cluster name that includes it. Filename should be absolute and true. (defalias 'shadow-contract-file-name #[(file) "À !Ã\n!ƒ\f‚4ÅÆÇÈ\n@\nA@É\n \fÍ …( ÎP\fÏ\n°+!!8!ÑÆ\n8\"Ó\n@!‰ƒPÕœ‚R\n@\nA@ƒaÖP‚dÆ\n8\n \fÍ …t ÎP\fÏ\n°.‡" [shadow-parse-path file hup shadow-local-file shadow-homedir file-name-as-directory 2 shadow-parse-fullpath expand-file-name "~" path user host "/" "@" ":" homedir shadow-suffix suffix shadow-site-cluster cluster 0 "~/"] 10 (#$ . 8596)]) #@236 True if the site of PATTERN and of FILE are on the same site. If usernames are supplied, they must also match exactly. PATTERN and FILE may be lists of host, user, path, or ange-ftp pathnames. FILE may also be just a local filename. (defalias 'shadow-same-site #[(pattern file) "À ! !Æ @\f@\"… A@?† A@\fA@˜*‡" [shadow-parse-fullpath pattern shadow-parse-path file file-sup pattern-sup shadow-site-match] 3 (#$ . 9192)]) #@406 Returns t if PATTERN matches FILE. If REGEXP is supplied and nonnil, the pathname part of the pattern is a regular expression, otherwise it must match exactly. The sites and usernames must match---see shadow-same-site. The pattern must be in full ange-ftp format, but the file can be any valid filename. This function does not do any filename expansion or contraction, you must do that yourself first. (defalias 'shadow-file-match #[(pattern file &optional regexp) "À !Ã\f!Æ\n \"…&ƒÈÉ\n8É 8\"‚&É\n8É 8˜*‡" [shadow-parse-fullpath pattern pattern-sup shadow-parse-path file file-sup shadow-same-site regexp string-match 2] 4 (#$ . 9628)]) #@368 Edit (or create) the definition of a cluster. This is a group of hosts that share directories, so that copying to or from one of them is sufficient to update the file on all of them. Clusters are defined by a name, the network address of a primary host (the one we copy files to), and a regular expression that matches the hostnames of all the sites in the cluster. (defalias 'shadow-define-cluster #[(name) "À \n\"ÄÅ ƒ Æœ‚ \"È ÊÄË ƒ% Ìœ‚)Í!\"‰ \"„>ÎÏ!ˆÐÌ!ˆ‚ )Ò #+‡" [assoc name shadow-clusters old read-string "Primary host: " 1 primary nil try-regexp string-match "Regexp matching all host names: " 2 shadow-regexp-superquote message "Regexp doesn't include the primary host!" sit-for regexp shadow-set-cluster] 5 (#$ . 10283) (list (completing-read "Cluster name: " shadow-clusters nil nil))]) #@271 Declare a single file to be shared between sites. It may have different filenames on each site. When this file is edited, the new version will be copied to each of the other locations. Sites can be specific hostnames, or names of clusters (see shadow-define-cluster). (defalias 'shadow-define-literal-group #[nil "ÀÁ !!Ä 8ÆÆÆ Ê ‰ƒ]ËÌÍÎ!\"!ËÏ \"Иƒ<Î!‚> Ò…NÓPÔ °+ B ‚ B-Ö ‡" [shadow-parse-fullpath shadow-contract-file-name buffer-file-name hup 2 path nil user site group shadow-read-site read-string format "Username [default %s]: " shadow-get-user "Filename: " "" host "/" "@" ":" shadow-literal-groups shadow-write-info-file] 5 (#$ . 11113) nil]) #@375 Make each of a group of files be shared between hosts. Prompts for regular expression; files matching this are shared between a list of sites, which are also prompted for. The filenames must be identical on all hosts (if they aren't, use shadow-define-group instead of this function). Each site can be either a hostname or the name of a cluster (see shadow-define-cluster). (defalias 'shadow-define-regexp-group #[nil "ÀÁ …ÃÄÅÆ !!8!\"lj‰ \n Ì ‰\nƒ?\n B ÀÍÎ\n\"Ï\n!\"B‚Ð  #BÒ ,‡" [read-string "Filename regexp: " buffer-file-name shadow-regexp-superquote 2 shadow-parse-path shadow-contract-file-name nil usernames sites site regexp shadow-read-site format "Username for %s: " shadow-get-user shadow-make-group shadow-regexp-groups shadow-write-info-file] 7 (#$ . 11819) nil]) #@54 Interactive function to display shadows of a buffer. (defalias 'shadow-shadows #[nil "ÀÁÂÃÄ !\"Å\"ÇGÈUƒÉ‚!)‡" [shadow-join mapcar cdr shadow-shadows-of buffer-file-name " " msg message 0 "No shadows."] 5 (#$ . 12631) nil]) #@303 Copy all pending shadow files. With prefix argument, copy all pending files without query. Pending copies are stored in variable shadow-files-to-copy, and in shadow-todo-file if necessary. This function is invoked by shadow-save-buffers-kill-emacs, so it is not usually necessary to call it manually. (defalias 'shadow-copy-files #[(&optional arg) "„\ftƒ\fÁÂ!‡ŠÃÄÅÆ$ˆÇÈ!)‡" [shadow-files-to-copy message "No files need to be shadowed." map-y-or-n-p #[(pair) "† † ÂÃ\fA\"‡" [arg shadow-noquery format "Copy shadow file %s? " pair] 3] shadow-copy-file ("shadow" "shadows" "copy") shadow-write-todo-file t] 5 (#$ . 12871) "P"]) #@277 Cancel the instruction to copy some files. Prompts for which copy operations to cancel. You will not be asked to copy them again, unless you make more changes to the files. To cancel a shadow permanently, remove the group from shadow-literal-groups or shadow-regexp-groups. (defalias 'shadow-cancel #[nil "ÀÁ Ä$ˆÅÆÇ G\"!ˆÈ ‡" [map-y-or-n-p #[(pair) "ÀÁ\n@\nA#‡" [format "Cancel copying %s to %s? " pair] 4] #[(pair) "À !‡" [shadow-remove-from-todo pair] 2] shadow-files-to-copy ("shadow" "shadows" "cancel copy") message format "There are %d shadows to be updated." shadow-write-todo-file] 5 (#$ . 13512) nil]) #@197 Makes a description of a file group--- actually a list of regexp ange-ftp file names---from REGEXP (name of file to be shadowed), list of SITES, and corresponding list of USERNAMES for each site. (defalias 'shadow-make-group #[(regexp sites usernames) "…\"@ @\nÆ\f…\fÇP È °+É\nA A#B‡" [sites usernames regexp path user host "/" "@" ":" shadow-make-group] 5 (#$ . 14133)]) #@23 Copy one shadow file. (defalias 'shadow-copy-file #[(s) "ÀÁ @!!!†9Ä @!„$ÅÆÇ @\"!ƒ È !ˆÉ‚9\nË=„5ÅÆÌ @\"!…9Í @!Ï A!??…TqˆŒ~ˆÑÒÓ)*‡" [get-file-buffer abbreviate-file-name shadow-expand-file-name s file-readable-p y-or-n-p format "Cannot find file %s--cancel copy request?" shadow-remove-from-todo nil shadow-noquery t "No buffer for %s -- update shadow anyway?" find-file-noselect buffer shadow-expand-cluster-in-file-name to i (byte-code "Àed #ˆÂ !‡" [write-region to shadow-remove-from-todo s] 4) ((error (byte-code "ÀÁ A\"!‡" [message format "Shadow %s not updated!" s] 4)))] 4 (#$ . 14521)]) #@225 Returns copy operations needed to update FILE. Filename should have clusters expanded, but otherwise can have any format. Return value is a list of dotted pairs like (from . to), where from and to are absolute file names. (defalias 'shadow-shadows-of #[(file) "À \n\"J†7ÃÄ !† \"Ç!ÉÊËÌ Î#ÌÐ#\"\"Ò \n\"L+‡" [intern-soft file shadow-hashtable shadow-expand-file-name shadow-local-file shadow-homedir absolute-file shadow-contract-file-name canonical-file mapcar #[(shadow) " B‡" [absolute-file shadow] 2] append shadow-shadows-of-1 shadow-literal-groups nil shadow-regexp-groups t shadows intern] 8 (#$ . 15140)]) #@116 Return list of FILE's shadows in GROUPS, which are considered as regular expressions if third arg REGEXP is true. (defalias 'shadow-shadows-of-1 #[(file groups regexp) "…6ÁÂ@\"Ä @šƒÅ‚,ƒ+ÇÈ !8\nËÌ \")‚, Í A#\")‡" [groups shadow-remove-if #[(x) "À \n #‡" [shadow-file-match x file regexp] 4] nonmatching append nil regexp 2 shadow-parse-fullpath file realpath mapcar #[(x) "À \n\"‡" [shadow-replace-path-component x realpath] 3] shadow-shadows-of-1] 6 (#$ . 15782)]) #@84 If current buffer has shadows, add them to the list of files needing to be copied. (defalias 'shadow-add-to-todo #[nil "ÀÁÂp!!!‰ƒ#Ä \"„ ÇÈÉ!!ˆÊË!ˆÌ ˆ)͇" [shadow-shadows-of shadow-expand-file-name buffer-file-name shadows shadow-union shadow-files-to-copy shadow-inhibit-message message substitute-command-keys "Use \\[shadow-copy-files] to update shadows." sit-for 1 shadow-write-todo-file nil] 5 (#$ . 16272)]) #@95 Remove PAIR from shadow-files-to-copy. PAIR must be (eq to) one of the elements of that list. (defalias 'shadow-remove-from-todo #[(pair) "ÀÁ\n\"‰‡" [shadow-remove-if #[(s) " =‡" [s pair] 2] shadow-files-to-copy] 3 (#$ . 16698)]) #@175 Visits and loads shadow-info-file and shadow-todo-file, thus restoring shadowfile's state from your last emacs session. Returns t unless files were locked; then returns nil. (defalias 'shadow-read-files #[nil "ÀÁ!ƒ!Á\n!;„Á !;ƒ!ÄÅ!ˆÆ ˆÇÈ!ˆÉ‡Š\nƒNÊ\n!‰ qˆÌ „KÍÎ \n\"ƒKÏ ˆÄÐÑÎ !@\"ˆÇÒ!ˆÓ ˆ ƒ{Ê !‰qˆÌ „wÍÎ \"ƒwÏ ˆÄÐÑÎ !@\"ˆÇÒ!ˆÓÉ!ˆÕ ˆ)Ö‡" [fboundp file-locked-p shadow-info-file shadow-todo-file message "Shadowfile is running in another emacs; can't have two." beep sit-for 3 nil find-file-noselect shadow-info-buffer buffer-modified-p file-newer-than-file-p make-auto-save-file-name erase-buffer "Data recovered from %s." insert-file-contents 1 eval-current-buffer shadow-todo-buffer shadow-invalidate-hashtable t] 4 (#$ . 16937) nil]) #@151 Write out information to shadow-info-file. Also clears shadow-hashtable, since when there are new shadows defined, the old hashtable info is invalid. (defalias 'shadow-write-info-file #[nil "À ˆ …#Š\n„à !\nqˆed|ˆÄÅ!ˆÄÆ!ˆÄÇ!)‡" [shadow-invalidate-hashtable shadow-info-file shadow-info-buffer find-file-noselect shadow-insert-var shadow-clusters shadow-literal-groups shadow-regexp-groups] 2 (#$ . 17692)]) #@90 Write out information to shadow-todo-file. With nonnil argument also saves the buffer. (defalias 'shadow-write-todo-file #[(&optional save) "Š„ Á\n!qˆed|ˆÃÄ!ˆ …Æ )‡" [shadow-todo-buffer find-file-noselect shadow-todo-file shadow-insert-var shadow-files-to-copy save shadow-save-todo-file] 2 (#$ . 18108)]) (defalias 'shadow-save-todo-file #[nil "…Á!…ŠqˆÂÃÄ)‡" [shadow-todo-buffer buffer-modified-p nil (basic-save-buffer) ((error (byte-code "ÀÁ!ˆÂÃ!‡" [message "WARNING: Can't save shadow todo file; it is locked!" sit-for 1] 2)))] 3]) (defalias 'shadow-invalidate-hashtable #[nil "ÀÁÂ\"‰‡" [make-vector 37 0 shadow-hashtable] 3]) #@176 Prettily insert a setq command for VARIABLE. which, when later evaluated, will restore it to its current setting. SYMBOL must be the name of a variable whose value is a list. (defalias 'shadow-insert-var #[(variable) "pÁ \"cˆÄ !:ƒ;ÅcˆÆÄ !@!ˆÄ !A‰ƒ5ÈcˆÆ@!ˆA‰„#Éc)‚FÊcˆÆÄ !!ˆËc)‡" [standard-output format "(setq %s" variable eval "\n '(" prin1 rest "\n " "))\n\n" " " ")\n\n"] 4 (#$ . 18763)]) #@291 Offer to save each buffer and copy shadows, then kill this Emacs process. With prefix arg, silently save all file-visiting buffers, then kill. Extended by shadowfile to automatically save `shadow-todo-file' and look for files that have been changed and need to be copied to other systems. (defalias 'shadow-save-buffers-kill-emacs #[(&optional arg) "À ˆÁ\nÃ\"ˆÄ ˆÀ ˆÃÅÆÇ \">ƒÈÉ!…iÊË!ƒgË Ì ‰ƒZÏ@!Ð>ƒQÑ@!Ñ@\"ˆ)ƒQà A‰„/ ?†cÈÓ!*…iÔ ‡" [shadow-save-todo-file save-some-buffers arg t shadow-copy-files mapcar #[(buf) "À !…  !‡" [buffer-file-name buf buffer-modified-p] 2] buffer-list yes-or-no-p "Modified buffers exist; exit anyway? " fboundp process-list nil active processes process-status (run stop open) process-kill-without-query val "Active processes exist; kill them and exit anyway? " kill-emacs] 5 (#$ . 19180) "P"]) (defalias 'shadow-initialize #[nil "„\nÁÂÃ!!\f„ÂÅ!„ÂÇ!È „,ÉÊ!ˆË ˆÌÍ!‡„AÏÐ!„AÐÑKMˆÑÒKMˆÓÔÕ\"ˆÖØÙ#‡" [shadow-homedir file-name-as-directory shadow-expand-file-name "~" shadow-info-file "~/.shadows" shadow-todo-file "~/.shadow_todo" shadow-read-files message "Shadowfile information files not found - aborting" beep sit-for 3 shadow-inhibit-overload fboundp shadow-orig-save-buffers-kill-emacs save-buffers-kill-emacs shadow-save-buffers-kill-emacs add-hook write-file-hooks shadow-add-to-todo define-key ctl-x-4-map "s" shadow-copy-files] 4]) (byte-code "ƒ\fÁÂÃ\"ˆ‚à ˆÁ‡" [noninteractive add-hook after-init-hook shadow-initialize] 3) emacs-19.30/lisp/shell.elc100666 74777 1 51306 5771400125 13721 0ustar esrdaemon;ELC ;;; compiled by kwzh@hill.gnu.ai.mit.edu on Mon Jun 19 18:55:10 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/shell.el ;;; emacs version 19.28.95.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`shell.el' was compiled for Emacs 19.29 or later")) (require (quote comint)) #@426 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. (defvar shell-prompt-pattern "^[^#$%>\n]*[#$%>] *" (#$ . 499)) #@295 *List of suffixes to be disregarded during file/command completion. This variable is used to initialize `comint-completion-fignore' in the shell buffer. The default is nil, for compatibility with most shells. Some people like ("~" "#" "%"). This is a fine thing to set in your `.emacs' file. (defvar shell-completion-fignore nil (#$ . -994)) #@242 List of characters to recognise as separate arguments. This variable is used to initialize `comint-delimiter-argument-list' in the shell buffer. The default is (?\| ?& ?< ?> ?\( ?\) ?\;). This is a fine thing to set in your `.emacs' file. (defvar shell-delimiter-argument-list (quote (124 38 60 62 40 41 59)) (#$ . 1345)) #@277 List of characters to quote when in a file name. This variable is used to initialize `comint-file-name-quote-list' in the shell buffer. The default is (? ?* ?! ?" ?' ?`) plus characters in `shell-delimiter-argument-list'. This is a fine thing to set in your `.emacs' file. (defvar shell-file-name-quote-list (append shell-delimiter-argument-list (quote (32 42 33 34 39 96))) (#$ . 1676)) #@194 List of functions called to perform completion. This variable is used to initialise `comint-dynamic-complete-functions' in the shell buffer. This is a fine thing to set in your `.emacs' file. (defvar shell-dynamic-complete-functions (quote (comint-replace-by-expanded-history shell-dynamic-complete-environment-variable shell-dynamic-complete-command shell-replace-by-expanded-directory comint-dynamic-complete-filename)) (#$ . 2074)) #@121 *Regexp to match a single command within a pipeline. This is used for directory tracking and does not do a perfect job. (defvar shell-command-regexp "[^;&|\n]+" (#$ . -2517)) #@187 *If non-nil, use executable files only for completion candidates. This mirrors the optional behavior of tcsh. Detecting executability of files may slow command completion considerably. (defvar shell-completion-execonly t (#$ . -2699)) #@56 *Regexp to match subshell commands equivalent to popd. (defvar shell-popd-regexp "popd" (#$ . -2941)) #@57 *Regexp to match subshell commands equivalent to pushd. (defvar shell-pushd-regexp "pushd" (#$ . -3049)) #@112 *If non-nil, make pushd with no arg behave as "pushd ~" (like cd). This mirrors the optional behavior of tcsh. (defvar shell-pushd-tohome nil (#$ . -3161)) #@108 *If non-nil, make "pushd +n" pop the nth dir to the stack top. This mirrors the optional behavior of tcsh. (defvar shell-pushd-dextract nil (#$ . -3324)) #@111 *If non-nil, make pushd only add unique directories to the stack. This mirrors the optional behavior of tcsh. (defvar shell-pushd-dunique nil (#$ . -3485)) #@54 *Regexp to match subshell commands equivalent to cd. (defvar shell-cd-regexp "cd" (#$ . -3647)) #@75 *If non-nil, is file name to use for explicitly requested inferior shell. (defvar explicit-shell-file-name nil (#$ . -3749)) #@113 *Args passed to inferior shell by M-x shell, if the shell is csh. Value is a list of strings, which may be nil. (defvar explicit-csh-args (byte-code "Á=ƒ‡Ç" [system-type hpux ("-i" "-T") ("-i")] 2) (#$ . -3881)) #@452 *If non-nil, expand input command history references on completion. This mirrors the optional behavior of tcsh (its autoexpand and histlit). If the value is `input', then the expansion is seen on input. If the value is `history', then the expansion is only when inserting into the buffer's input ring. See also `comint-magic-space' and `comint-dynamic-complete'. This variable supplies a default for `comint-input-autoexpand', for Shell mode only. (defvar shell-input-autoexpand (quote history) (#$ . -4105)) #@119 List of directories saved by pushd in this buffer's shell. Thus, this does not include the shell's current directory. (defvar shell-dirstack nil (#$ . 4624)) #@64 Non-nil in a shell buffer means directory tracking is enabled. (defvar shell-dirtrackp t (#$ . 4788)) #@54 Keep track of last directory for ksh `cd -' command. (defvar shell-last-dir nil (#$ . 4896)) #@56 Command used by `shell-resync-dir' to query the shell. (defvar shell-dirstack-query nil (#$ . 4995)) (byte-code "ÀÁ!„ÂÁ B „LÄ ¤Æ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÌ#ˆÆ ÍÎ#ˆÆ ÏÐÑ Ò\"!#ˆÓÑ Ô\"ÕÖ×$ˆÓÑ Ø\"ÙÚÛ$ˆÂ‡" [boundp shell-mode-map nil current-load-list make-sparse-keymap comint-mode-map define-key "" shell-forward-command "" shell-backward-command " " comint-dynamic-complete "¿" comint-dynamic-list-filename-completions [menu-bar completion] copy-keymap lookup-key [menu-bar completion] define-key-after [menu-bar completion] [complete-env-variable] ("Complete Env. Variable Name" . shell-dynamic-complete-environment-variable) complete-file [menu-bar completion] [expand-directory] ("Expand Directory Reference" . shell-replace-by-expanded-directory) complete-expand] 7) #@35 *Hook for customising Shell mode. (defvar shell-mode-hook nil (#$ . -5768)) #@52 Additional expressions to highlight in Shell mode. (defvar shell-font-lock-keywords (byte-code "ÁBÂÃÄF‡" [shell-prompt-pattern font-lock-keyword-face ("[ ]\\([+-][^ \n]+\\)" 1 font-lock-comment-face) ("^[^ \n]+:.*" . font-lock-string-face) ("^\\[[1-9][0-9]*\\]" . font-lock-string-face)] 4) (#$ . 5850)) #@2711 Major mode for interacting with an inferior shell. \[comint-send-input] after the end of the process' output sends the text from the end of process to the end of the current line. \[comint-send-input] before end of process output copies the current line minus the prompt to the end of the buffer and sends it (\[comint-copy-old-input] just copies the current line). \[send-invisible] reads a line of text without echoing it, and sends it to the shell. This is useful for entering passwords. Or, add the function `comint-watch-for-password-prompt' to `comint-output-filter-functions'. If you want to make multiple shell buffers, rename the `*shell*' buffer using \[rename-buffer] or \[rename-uniquely] and start a new shell. If you want to make shell buffers limited in length, add the function `comint-truncate-buffer' to `comint-output-filter-functions'. If you accidentally suspend your process, use \[comint-continue-subjob] to continue it. `cd', `pushd' and `popd' commands given to the shell are watched by Emacs to keep this buffer's default directory the same as the shell's working directory. While directory tracking is enabled, the shell's working directory is displayed by \[list-buffers] or \[mouse-buffer-menu] in the `File' field. \[dirs] queries the shell and resyncs Emacs' idea of what the current directory stack is. \[dirtrack-toggle] turns directory tracking on and off. \{shell-mode-map} Customization: Entry to this mode runs the hooks on `comint-mode-hook' and `shell-mode-hook' (in that order). Before each input, the hooks on `comint-input-filter-functions' are run. After each shell output, the hooks on `comint-output-filter-functions' are run. Variables `shell-cd-regexp', `shell-pushd-regexp' and `shell-popd-regexp' are used to match their respective commands, while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the relevant command. Variables `comint-completion-autolist', `comint-completion-addsuffix', `comint-completion-recexact' and `comint-completion-fignore' control the behavior of file name, command name and variable name completion. Variable `shell-completion-execonly' controls the behavior of command name completion. Variable `shell-completion-fignore' is used to initialise the value of `comint-completion-fignore'. Variables `comint-input-ring-file-name' and `comint-input-autoexpand' control the initialisation of the input ring history, and history expansion. Variables `comint-output-filter-functions', a hook, and `comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output' control whether input and output cause the window to scroll to the end of the buffer. (defalias 'shell-mode #[nil "À ˆÁÃÅ!ˆ \n \f ÑÒ!ˆÑÓ!ˆÔÑÕ!ˆÖÖÑØ!ˆÙÚÛÜÖÙ$ˆÑß!ˆà!!âãäp!!@!%æç!†|%蘃pé‚|%ꘃ{ë‚|ì‰-îš„ï-!ðšƒÖ-ñò%\"ƒœó‚ô5)ö÷!ˆøÙ!‡" [comint-mode shell-mode major-mode "Shell" mode-name use-local-map shell-mode-map shell-prompt-pattern comint-prompt-regexp shell-completion-fignore comint-completion-fignore shell-delimiter-argument-list comint-delimiter-argument-list shell-file-name-quote-list comint-file-name-quote-list shell-dynamic-complete-functions comint-dynamic-complete-functions make-local-variable paragraph-start font-lock-defaults (shell-font-lock-keywords t) shell-dirstack nil shell-last-dir shell-dirtrackp t add-hook comint-input-filter-functions shell-directory-tracker shell-input-autoexpand comint-input-autoexpand list-buffers-directory expand-file-name default-directory file-name-nondirectory process-command get-buffer-process shell getenv "HISTFILE" "bash" "~/.bash_history" "ksh" "~/.sh_history" "~/.history" comint-input-ring-file-name "" file-truename "/dev/null" string-match "^k?sh$" "pwd" "dirs" shell-dirstack-query run-hooks shell-mode-hook comint-read-input-ring] 6 (#$ . 6166) nil]) #@1025 Run an inferior shell, with I/O through buffer *shell*. If buffer exists but shell process is not running, make new shell. If buffer exists and shell process is running, just switch to buffer `*shell*'. Program used comes from variable `explicit-shell-file-name', or (if that is nil) from the ESHELL environment variable, or else from SHELL if there is no ESHELL. If a file `~/.emacs_SHELLNAME' exists, it is given as initial input (Note that this may lose due to a timing error if the shell discards input when it starts up.) The buffer is put in Shell mode, giving commands for sending input and controlling the subjobs of the shell. See `shell-mode'. See also the variable `shell-prompt-pattern'. The shell file name (sans directories) is used to make a symbol name such as `explicit-csh-args'. If that symbol is a variable, its value is used as a list of arguments when invoking the shell. Otherwise, one argument `-i' is passed to the shell. (Type \[describe-mode] in the shell buffer for a list of commands.) (defalias 'shell #[nil "ÀÁ!„c\n†ÃÄ!†ÃÅ!†ÆÈ! Ê P ÌÍ ÎQ!ЊÒÓÔÕ !…@ ƒRÖ!ƒRJ‚S×%qˆpØ ˆ)Ù!-‡ÙÁ!‡" [comint-check-proc "*shell*" explicit-shell-file-name getenv "ESHELL" "SHELL" "/bin/sh" prog file-name-nondirectory name "~/.emacs_" startfile intern-soft "explicit-" "-args" xargs-name nil shell-buffer apply make-comint "shell" file-exists-p boundp ("-i") shell-mode pop-to-buffer] 7 (#$ . 10073) nil]) #@641 Tracks cd, pushd and popd commands issued to the shell. This function is called on each input passed to the shell. It watches for cd, pushd and popd commands and sets the buffer's default directory to track these commands. You may toggle this tracking on and off with M-x dirtrack-toggle. If emacs gets confused, you can resync with the shell with M-x dirs. See variables `shell-cd-regexp', `shell-pushd-regexp', and `shell-popd-regexp', while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the relevant command. Environment variables are expanded, see function `substitute-in-file-name'. (defalias 'shell-directory-tracker #[(str) "…ÁÂÇ" [shell-dirtrackp chdir-failure (byte-code "ÀÁ\n\"ˆÃ•Ä‰‰À \n#…€Ã•Ê\nOÉ#Ê\nOˉ#ÀÌ ÎQ\"ƒKÏÐ !!ˆ‚rÀÌÎQ\"ƒ`ÒÐ !!ˆ‚rÀÌÎQ\"ƒrÔÐ !!ˆÀÕ\n#ˆÃ•‚,‡" [string-match "^[; ]*" str 0 nil arg1 cmd end start shell-command-regexp comint-arguments 1 "\\`\\(" shell-popd-regexp "\\)\\($\\|[ ]\\)" shell-process-popd substitute-in-file-name shell-pushd-regexp shell-process-pushd shell-cd-regexp shell-process-cd "[; ]*"] 4) ((error "Couldn't cd"))] 3 (#$ . 11538)]) (defalias 'shell-process-popd #[(arg) "À !†‰ƒ# ÂUƒ#\fƒ#Å\f@!ˆ\fAÆ ‚S ƒP ÂVƒP \fGXƒPÇ\fB S›‰ ‰AA¡ˆAÆ *‚SÊË!)‡" [shell-extract-num arg 0 num shell-dirstack shell-cd shell-dirstack-message nil ds cell error "Couldn't popd"] 3]) (defalias 'shell-prefixed-directory-name #[(dir) "GÁUƒ \n‡Ã\n!ƒ\nP‡Ä\n!‡" [comint-file-name-prefix 0 dir file-name-absolute-p expand-file-name] 2]) (defalias 'shell-process-cd #[(arg) "GÁUƒ \nÃP‚Ęƒ ‚Æ!É!ˆÊ )‡" [arg 0 comint-file-name-prefix "~" "-" shell-last-dir shell-prefixed-directory-name new-dir default-directory shell-cd shell-dirstack-message] 2]) (defalias 'shell-process-pushd #[(arg) "À ! GÃUƒ;\fƒÅÇP!‚Ôƒ5 \nË@!ˆ\nABÌ )‚ÔÍÎ!‚Ô\n§ƒ³\nGVƒNÍÏ!‚Ô\nÃUƒ\\ÐÍÑ!!‚Ôƒ|\nS8Ô !ˆÅ !ˆË!ˆÌ )‚Ô B‰G\n›Ø\nZØ!›!Ú\"Ë@!ˆAÌ -‚Ô ËÝ !!ˆƒÊ„ÑBÌ ))‡" [shell-extract-num arg num 0 shell-pushd-tohome shell-process-pushd comint-file-name-prefix "~" shell-dirstack default-directory old shell-cd shell-dirstack-message message "Directory stack empty." "Directory stack not that deep." error "Couldn't cd." shell-pushd-dextract dir shell-process-popd ds dslen front reverse back append new-ds old-wd shell-prefixed-directory-name shell-pushd-dunique] 5]) (defalias 'shell-extract-num #[(str) "ÀÁ\n\"…\nÃ\n!‡" [string-match "^\\+[1-9][0-9]*$" str string-to-int] 3]) #@55 Turn directory tracking on and off in a shell buffer. (defalias 'shell-dirtrack-toggle #[nil "?‰ƒ\f ‚ÃÄŃƂÇ\"‡" [shell-dirtrackp default-directory list-buffers-directory nil message "Directory tracking %s" "ON" "OFF"] 3 (#$ . 14137) nil]) (defalias (quote dirtrack-toggle) (quote shell-dirtrack-toggle)) #@58 Do normal `cd' to DIR, and set `list-buffers-directory'. (defalias 'shell-cd #[(dir) "ƒ\nÁ !!Å !‡" [shell-dirtrackp file-name-as-directory expand-file-name dir list-buffers-directory cd] 3 (#$ . 14460)]) #@496 Resync the buffer's idea of the current directory stack. This command queries the shell with the command bound to `shell-dirstack-query' (default "dirs"), reads the next line output and parses it to form the new directory stack. DON'T issue this command unless the buffer is at a shell prompt. Also, note that if some other subprocess decides to do output immediately after the query, its output will be taken as the new directory stack -- you lose. If this happens, just do the command again. (defalias 'shell-resync-dirs #[nil "Àp! !‰bˆ\fcˆÅcˆÆÇ!ˆÈ \f\"ˆÈ Å\"ˆ `É“ˆ`\nÅcˆËÌ!ˆÍÎ!„?Ï !ˆ\nbˆ‚.) bˆÐÌ!ˆÇ”Ç•S{‰GÉÇÇWƒÕÖ#ˆ̔̕OPBÇ•‰‚ZŸÉØÙ.‡" [get-buffer-process proc process-mark pmark shell-dirstack-query "\n" sit-for 0 comint-send-string nil pt backward-char 1 looking-at ".+\n" accept-process-output delete-char dl dl-len ds i string-match "\\s *\\(\\S +\\)\\s *" comint-file-name-prefix (byte-code "À @!ˆ Aà ‡" [shell-cd ds shell-dirstack shell-dirstack-message] 2) ((error (message "Couldn't cd.")))] 5 (#$ . 14675) nil]) (defalias (quote dirs) (quote shell-resync-dirs)) (defalias 'shell-dirstack-message #[nil "À\n BÅÇP!‰G \fƒu\f@‰\nG Yƒ8\nË O˜ƒ8Ç\n ÌOP\nƒf\nGGYƒf\nËGO˜ƒf\nGÌO‰\nƒf\f\n ˆ Í\n!ÎQ\fA)‚Ï !,‡" ["" msg default-directory shell-dirstack ds expand-file-name comint-file-name-prefix "~/" home homelen dir 0 nil directory-file-name " " message] 5]) #@94 Move forward across ARG shell command(s). Does not cross lines. See `shell-command-regexp'. (defalias 'shell-forward-command #[(&optional arg) "ŠÀˆ`) ÄP Å$…ÇÈ!)‡" [nil limit re-search-forward shell-command-regexp "\\([;&|][ ]*\\)+" move arg skip-syntax-backward " "] 5 (#$ . 16126) "p"]) #@95 Move backward across ARG shell command(s). Does not cross lines. See `shell-command-regexp'. (defalias 'shell-backward-command #[(&optional arg) "ŠÀÁ!ˆ`)‰`VƒŠÃyˆ`)ÄÅ\n\"ˆÆÇÈ \"\nÊ $…/Ì”bˆÍÁw)‡" [comint-bol nil limit 0 skip-syntax-backward " " re-search-backward format "[;&|]+[ ]*\\(%s\\)" shell-command-regexp move arg 1 ";&|"] 6 (#$ . 16429) "p"]) #@458 Dynamically complete the command at point. This function is similar to `comint-dynamic-complete-filename', except that it searches `exec-path' (minus the trailing emacs library path) for completion candidates. Note that this may not be the same as the shell's idea of the path. Completion is dependent on the value of `shell-completion-execonly', plus those that effect file completion. See `shell-dynamic-complete-as-command'. Returns t if successful. (defalias 'shell-dynamic-complete-command #[nil "À ‰…( ÄŽÅÆ \"*?…(Ç”ŠÈÉ!ˆ`)=…(ÊË!ˆÌ )‡" [comint-match-partial-filename filename match-data match-data ((store-match-data match-data)) string-match "[~/]" 0 shell-backward-command 1 message "Completing command name..." shell-dynamic-complete-as-command] 4 (#$ . 16795) nil]) #@110 Dynamically complete at point as a command. See `shell-dynamic-complete-filename'. Returns t if successful. (defalias 'shell-dynamic-complete-as-command #[nil "À †ÁÃ\n!Å!AÈÉ\n!! \f…%ÍÎ\fÏ#ÁÒÁÁÒƒ°È×@†DØ!!Ù!…TÚ\f\"‰ƒ§@P„žƒ|Û\"„ž ˜„‹Ü!„žƒ—Þ!ƒžBA‰„ZA‰„;Òà\f\")‰!â>ƒÐƒÐÜÀ !„Ðãcˆ!. ‡" [comint-match-partial-filename "" filename file-name-nondirectory pathnondir reverse exec-path paths file-name-as-directory expand-file-name default-directory cwd comint-completion-fignore mapconcat #[(x) "À !ÂP‡" [regexp-quote x "$"] 2] "\\|" ignored-extensions path nil comps-in-path file filepath completions comint-directory "." file-accessible-directory-p file-name-all-completions string-match file-directory-p shell-completion-execonly file-executable-p comint-completion-addsuffix comint-dynamic-simple-complete success (sole shortest) " "] 5 (#$ . 17587)]) #@55 Return the variable at point, or nil if non is found. (defalias 'shell-match-partial-variable #[nil "Š`ÁÂÃÄ#ƒÅÆ!„Çuˆl†ÅÈ!?…)ÉÊ\"ˆË”Ë•{*‡" [limit re-search-backward "[^A-Za-z0-9_{}]" nil move looking-at "\\$" 1 "[^A-Za-z0-9_{}$]" re-search-forward "\\$?{?[A-Za-z0-9_]*}?" 0] 4 (#$ . 18544)]) #@738 Dynamically complete the environment variable at point. Completes if after a variable, i.e., if it starts with a "$". See `shell-dynamic-complete-as-environment-variable'. This function is similar to `comint-dynamic-complete-filename', except that it searches `process-environment' for completion candidates. Note that this may not be the same as the interpreter's idea of variable names. The main problem with this type of completion is that `process-environment' is the environment which Emacs started with. Emacs does not track changes to the environment made by the interpreter. Perhaps it would be more accurate if this function was called `shell-dynamic-complete-process-environment-variable'. Returns non-nil if successful. (defalias 'shell-dynamic-complete-environment-variable #[nil "À ‰…Âà \"…ÄÅ!ˆÆ )‡" [shell-match-partial-variable variable string-match "^\\$" message "Completing variable name..." shell-dynamic-complete-as-environment-variable] 4 (#$ . 18851) nil]) #@153 Dynamically complete at point as an environment variable. Used by `shell-dynamic-complete-environment-variable'. Uses `comint-dynamic-simple-complete'. (defalias 'shell-dynamic-complete-as-environment-variable #[nil "À †Á‰ÃÄ\n\"†ÅÆOÈÉ\n\" \f Æ\fÎ \"‰Ð>ƒxÀ ‰ÃÑ\n\"ÆOÃÒ\n\"ƒGÓ‚SÃÔ\n\"ƒRÕ‚SÁ „^Á‚n×ØÙ!!!ƒmÚ‚nÛ±ˆ,.‡" [shell-match-partial-variable "" var string-match "[^$({]\\|$" 0 nil variable mapcar #[(x) "ÁÂÃ\"O‡" [x 0 string-match "="] 5] process-environment variables comint-completion-addsuffix addsuffix comint-dynamic-simple-complete success (sole shortest) "[^$({]" "{" "}" "(" ")" protection file-directory-p comint-directory getenv "/" " " suffix] 5 (#$ . 19848)]) #@181 Expand directory stack reference before point. Directory stack references are of the form "=digit" or "=-". See `default-directory' and `shell-dirstack'. Returns t if successful. (defalias 'shell-replace-by-expanded-directory #[nil "À …UŠÁ”bˆ\n BÄÅ!ƒ G‚%ÄÆ!…%ÇȔȕ{! \n „2Ë‚T \nGYƒAÌÍ!‚TÎÏ \n8!Љ#ˆÑÒ \"ˆÐ+‡" [comint-match-partial-filename 0 default-directory shell-dirstack looking-at "=-/?" "=\\([0-9]+\\)" string-to-number 1 index stack nil error "Directory stack not that deep." replace-match file-name-as-directory t message "Directory item: %d"] 4 (#$ . 20574) nil]) (provide (quote shell)) emacs-19.30/lisp/simple.elc100666 12062 1 217116 6053423502 14050 0ustar bobdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 18 13:33:49 1995 ;;; from file /home/fsf/rms/e19/lisp/simple.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`simple.el' was compiled for Emacs 19.29 or later")) #@241 Insert a newline, and move to left margin of the new line if it's blank. The newline is marked with the text-property `hard'. With arg, insert that many newlines. In Auto Fill mode, if no numeric arg, break the preceding line if it's long. (defalias 'newline #[(&optional arg) "À ˆo?…n…Á`!†Â`ÃZWn…Ä !`‰ƒ-ÉÊ!ˆË\f†5?…;  ÏŽÐÑ\f!!ˆ+ƒRÉÊ!ˆƒ`\fƒdÑ\f!‚eÊZÔÕ\"×`ØÙ$ˆ<ƒØ>„×`ÕØB$ˆ*„²ŠbˆÚyˆÄÛ!ƒ±Ü ÚVƒ±`݈`|ˆ)ƒºÊuˆ„ÄÞÝÙ\"ˆ+݇" [barf-if-buffer-read-only previous-property-change -2 2 looking-at page-delimiter beforepos was-page-start flag backward-char 1 10 arg auto-fill-function last-command-char ((byte-code "ƒÁuˆÁ‡" [flag 1] 1)) self-insert-command prefix-numeric-value use-hard-newlines from get-text-property rear-nonsticky sticky put-text-property hard t 0 "[ ]$" current-left-margin nil move-to-left-margin] 7 (#$ . 471) "*P"]) #@187 Insert a newline and leave point before it. If there is a fill prefix and/or a left-margin, insert them on the new line if the line would have been blank. With arg N, insert N newlines. (defalias 'open-line #[(arg) "…nn… ÃV`Æ!ˆ bˆÃVƒ@nƒ4\fƒ, jˆ ƒ4È!ˆÉyˆS‰‚ bˆÊ+‡" [fill-prefix do-fill-prefix current-left-margin 0 do-left-margin loc newline arg insert-and-inherit 1 nil] 3 (#$ . 1376) "*p"]) #@66 Split current line, moving portion beyond point vertically down. (defalias 'split-line #[nil "ÀÁwˆi`ÄÅ!ˆÆ Ç\"ˆ\nb*‡" [" " nil pos col newline 1 indent-to 0] 3 (#$ . 1800) "*"]) #@590 Read next input character and insert it. This is useful for inserting control characters. You may also type up to 3 octal digits, to insert a character with that code. In overwrite mode, this function inserts the character anyway, and does not handle octal digits specially. This means that if you use overwrite as your normal editing mode, you can use this function to insert characters when necessary. In binary overwrite mode, this function does overwrite, and octal digits are interpreted as a character code. This is supposed to make this function useful in editing binary files. (defalias 'quoted-insert #[(arg) "ƒ\nÁ=ƒ ‚à  ÆVƒ\"Á=ƒ\"Ç !ˆ ÆV…3È\f!ˆ S‰‚#)‡" [overwrite-mode overwrite-mode-binary read-quoted-char read-char char arg 0 delete-char insert-and-inherit] 3 (#$ . 1987) "*p"]) #@178 Join this line to previous and fix up whitespace at join. If there is a fill prefix, delete it from the beginning of this line. With argument, join this line to following line. (defalias 'delete-indentation #[(&optional arg) "Àyˆ ƒ\nÂyˆhÃ=…6``S|ˆ\fƒ4`\fG\\dXƒ4\f``\fG\\{˜ƒ4``\fG\\|ˆÅ ‡" [0 arg 1 10 fill-prefix fixup-whitespace] 4 (#$ . 2805) "*P"]) #@100 Fixup white space between objects around point. Leave one space or none, according to the context. (defalias 'fixup-whitespace #[nil "ŠÀ ˆÁÂ!†ŠÃuˆÁÄ!)?…Åc)‡" [delete-horizontal-space looking-at "^\\|\\s)" -1 "$\\|\\s(\\|\\s'" 32] 2 (#$ . 3167) "*"]) #@42 Delete all spaces and tabs around point. (defalias 'delete-horizontal-space #[nil "ÀÁxˆ`ÀÁwˆ`|‡" [" " nil] 3 (#$ . 3427) "*"]) #@61 Delete all spaces and tabs around point, leaving one space. (defalias 'just-one-space #[nil "ÀÁxˆgÂUƒÃuˆ‚Âcˆ`ÀÁwˆ`|‡" [" " nil 32 1] 3 (#$ . 3561) "*"]) #@175 On blank line, delete all surrounding blank lines, leaving just one. On isolated blank line, delete that one. On nonblank line, delete any immediately following blank lines. (defalias 'delete-blank-lines #[nil "À‰ŠÃyˆÄÅ!‰…\"ÄÆ!?…\"o†\"ÇyˆÄÅ!?)\nƒEÃyˆ ƒ2Èyˆ`ÉÊÀË#ƒBÈyˆ`‚Ce|ˆ\nƒM „hŠÀˆÈyˆ`ÌÊÀË#ƒdÃyˆ`‚ed|ˆ)ÄÍ!…q`d|*‡" [nil singleblank thisblank 0 looking-at "[ ]*$" "[ ]*\n[ ]*$" -1 1 re-search-backward "[^ \n]" t re-search-forward "^[ ]*\n\\'"] 6 (#$ . 3726) "*"]) #@64 Move point to the first non-whitespace character on this line. (defalias 'back-to-indentation #[nil "ÀyˆÁÂw‡" [0 " " nil] 2 (#$ . 4219) nil]) #@304 Insert a newline, then indent according to major mode. Indentation is done using the value of `indent-line-function'. In programming language modes, this is the same as TAB. In some text modes, where TAB inserts a tab, this command indents to the column specified by the function `current-left-margin'. (defalias 'newline-and-indent #[nil "`ÀÁxˆ`|ˆÂ ˆÃ ‡" [" " nil newline indent-according-to-mode] 3 (#$ . 4369) "*"]) #@379 Reindent current line, insert newline, then indent the new line. Indentation of both lines is done according to the current major mode, which means calling the current value of `indent-line-function'. In programming language modes, this is the same as TAB. In some text modes, where TAB inserts a tab, this indents to the column specified by the function `current-left-margin'. (defalias 'reindent-then-newline-and-indent #[nil "Š`ÀÁxˆ`|ˆÂ ˆ)à ˆÂ ‡" [" " nil indent-according-to-mode newline] 3 (#$ . 4796) "*"]) (defalias 'kill-forward-chars #[(arg) "<ƒ@Á=ƒÂÃ``\\\"‡" [arg - -1 kill-region] 4]) (defalias 'kill-backward-chars #[(arg) "<ƒ@Á=ƒÂÃ``Z\"‡" [arg - -1 kill-region] 4]) #@219 Delete characters backward, changing tabs into spaces. Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil. Interactively, ARG is the prefix arg (default 1) and KILLP is t if a prefix arg was specified. (defalias 'backward-delete-char-untabify #[(arg &optional killp) "Š ÂVƒ0o„0hÃUƒ&iÅuˆ\fiZÆÇ\f\"ˆÈÉ!ˆ)Åuˆ S‰‚*Ê \"ˆ\f…Gl?…GŠÆÇ\")‡" [arg count 0 9 col -1 insert-char 32 delete-char 1 delete-backward-char killp overwrite-mode] 4 (#$ . 5503) "*p\nP"]) #@112 Kill up to and including ARG'th occurrence of CHAR. Goes backward if ARG is negative; error if CHAR not found. (defalias 'zap-to-char #[(arg char) "À`Á !ĉ $ˆ`\"‡" [kill-region search-forward char-to-string char nil arg] 7 (#$ . 5992) "p\ncZap to char: "]) #@350 Move point to the beginning of the buffer; leave mark at previous position. With arg N, put point N/10 of the way from the beginning. If the buffer is narrowed, this command uses the beginning and size of the accessible part of the buffer. Don't use this command in Lisp programs! (goto-char (point-min)) is faster and avoids clobbering the mark. (defalias 'beginning-of-buffer #[(&optional arg) "À ˆdeZ\nƒ)e ÃVƒÄ\n! Å¥_‚% Ä\n!_Å\\Å¥\\‚*ebˆ)\n…3Æy‡" [push-mark size arg 10000 prefix-numeric-value 10 1] 4 (#$ . 6257) "P"]) #@338 Move point to the end of the buffer; leave mark at previous position. With arg N, put point N/10 of the way from the end. If the buffer is narrowed, this command uses the beginning and size of the accessible part of the buffer. Don't use this command in Lisp programs! (goto-char (point-max)) is faster and avoids clobbering the mark. (defalias 'end-of-buffer #[(&optional arg) "À ˆdeZ\nƒ'd ÃVƒÄ\n! Å¥_‚# Ä\n!_Å¥Z‚(dbˆ)\nƒ2Æy‡`ŠÈ bˆÉÊ !ˆ`W*…NË`!ˆÌÍ!‡" [push-mark size arg 10000 prefix-numeric-value 10 1 old-point window-start vertical-motion window-height overlay-recenter recenter -3] 4 (#$ . 6796) "P"]) #@205 Put point at beginning and mark at end of buffer. You probably should not use this function in Lisp programs; it is usually a mistake for a Lisp function to use any subroutine that uses or sets the mark. (defalias 'mark-whole-buffer #[nil "À`!ˆÀdÁÂ#ˆeb‡" [push-mark nil t] 4 (#$ . 7424) nil]) #@53 Print number of lines and characters in the region. (defalias 'count-lines-region #[(start end) "ÀÁ \f\"\f Z#‡" [message "Region has %d lines, %d characters" count-lines start end] 5 (#$ . 7723) "r"]) #@73 Print the current buffer line number and narrowed line number of point. (defalias 'what-line #[nil "`ÀŠŒebˆ~ˆÃyˆ`\nbˆÃyˆ ÄU„,ÅÆÇÄ`\"TÇ `\"T#‚4ÅÈÇÄ`\"T\",‡" [nil start opoint 0 1 message "line %d (narrowed line %d)" count-lines "Line %d"] 6 (#$ . 7931) nil]) #@204 Return number of lines between START and END. This is usually the number of newlines between them, but can be one more if START is not equal to END and the greater of them is not at the start of a line. (defalias 'count-lines #[(start end) "ŠŒ }ˆebˆ\nÃ=ƒTÄ ÆŽÇÉÊËÃÌ$ƒ)Ì\\‚ÉÊËÃÍ$ƒ;Í\\‚)dbˆ U„Nn„NT‚P+‚ZÎ Î yZ*‡" [start end selective-display t match-data match-data ((store-match-data match-data)) 0 done re-search-forward "[\n ]" nil 40 1 buffer-size] 5 (#$ . 8201)]) #@62 Print info on cursor position (on screen and within buffer). (defalias 'what-cursor-position #[nil "ged`Ä ‰ÆVƒ Ç¥ S\\ È¥É]¥‚, Ê¥ SÈ_\\ É]¥ Ì ÍUƒ9΂>ÏÐÌ \"i \nUƒv ÉUƒV\n TU„gÓÔ  \n&‚¬ÓÕ  &‚¬ ÉUƒƒ\n TU„šÓÖ×!‰‰  \n&\f‚¬ÓØ×!‰‰  &\n.‡" [char beg end pos buffer-size total 50000 200 100 1 2 percent window-hscroll 0 "" format " Hscroll=%d" hscroll col message "point=%d of %d(%d%%) <%d - %d> column %d %s" "point=%d of %d(%d%%) column %d %s" "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) <%d - %d> column %d %s" single-key-description "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) column %d %s"] 14 (#$ . 8701) nil]) #@115 Major mode not specialized for anything in particular. Other major modes are defined by comparison with this one. (defalias 'fundamental-mode #[nil "À ‡" [kill-all-local-variables] 1 (#$ . 9383) nil]) #@54 Minibuffer keymap used for reading Lisp expressions. (defvar read-expression-map (cons (quote keymap) minibuffer-local-map) (#$ . 9590)) (byte-code "À ÂÃ#ˆÄÅÆÇ#ˆÈÉ!„Ê É B ʇ" [define-key read-expression-map "‰" lisp-complete-symbol put eval-expression disabled t boundp read-expression-history nil current-load-list] 4) #@111 Evaluate EXPRESSION and print value in minibuffer. Value is also consed on to front of the variable `values'. (defalias 'eval-expression #[(expression) "À !\nBÃ\n@Ä\"‡" [eval expression values prin1 t] 3 (#$ . 9922) (list (read-from-minibuffer "Eval: " nil read-expression-map t (quote read-expression-history)))]) #@178 Prompting with PROMPT, let user edit COMMAND and eval result. COMMAND is a Lisp expression. Let user edit that expression in the minibuffer, then read and evaluate the result. (defalias 'edit-and-eval-command #[(prompt command) "À  !\fÅÆ%@;ƒA @š„$ BÈ !)‡" [read-from-minibuffer prompt prin1-to-string command read-expression-map t (command-history . 1) command-history eval] 6 (#$ . 10245)]) #@537 Edit and re-evaluate last complex command, or ARGth from last. A complex command is one which used the minibuffer. The command is placed in the minibuffer as a Lisp form for editing. The result is executed, repeating the command as changed. If the command has been changed or is not the most recent previous command it is added to the front of the command history. You can use the minibuffer history commands \\[next-history-element] and \[previous-history-element] to get different commands to edit and resubmit. (defalias 'repeat-complex-command #[(arg) "S 8ÂɃ=ÃÉÊË!\fÂÁB%) @;ƒ, A\f @š„7\f BÍ\f!‚?Î ,‡" [arg command-history t nil newcmd minibuffer-history-sexp-flag minibuffer-history-position elt print-level read-from-minibuffer "Redo: " prin1-to-string read-expression-map eval ding] 8 (#$ . 10662) "p"]) #@124 Default minibuffer history list. This is used for all minibuffer input except when an alternate history list is specified. (defvar minibuffer-history nil (#$ . 11524)) #@166 Non-nil when doing history operations on `command-history'. More generally, indicates that the history list being acted on contains expressions rather than strings. (defvar minibuffer-history-sexp-flag nil (#$ . 11699)) (byte-code "ÀÂÄÅ!„\fÂÅBÇÈÉ\"‡" [minibuffer-history minibuffer-history-variable nil minibuffer-history-position boundp minibuffer-history-search-history current-load-list mapcar #[(key-and-command) "ÀÁÂ\"‡" [mapcar #[(keymap-and-completionp) "À @J\n@\nA‰:ƒ @‚ )#‡" [define-key keymap-and-completionp key-and-command command] 5] ((minibuffer-local-map) (minibuffer-local-ns-map) (minibuffer-local-completion-map . t) (minibuffer-local-must-match-map . t) (read-expression-map))] 3] (("n" next-history-element . next-complete-history-element) ([next] next-history-element . next-complete-history-element) ("p" previous-history-element . previous-complete-history-element) ([prior] previous-history-element . previous-complete-history-element) ("r" . previous-matching-history-element) ("s" . next-matching-history-element))] 3) #@216 Find the previous history element that matches REGEXP. (Previous history elements refer to earlier actions.) With prefix argument N, search for Nth previous match. If N is negative, find the next or Nth next match. (defalias 'previous-matching-history-element #[(regexp n) "JÁ\nÇU„i È ÇWƒÉ‚È\\] G^‰\fUƒ8Ê ÈUƒ5Ë‚6Ì!ˆÍƒMÁÑ S 8!)‚Q S 8\"ƒ‰ÇWƒaÈ‚bÉ\\‰‚ Ò ˆ S 8ƒ„ÁÑ!)‚†cˆ)ebˆ+@@Õ=„Ÿ@@Ö=…¥A‰‡" [minibuffer-history-variable nil minibuffer-history-position pos prevpos history n 0 1 -1 error "No later matching history item" "No earlier matching history item" string-match regexp minibuffer-history-sexp-flag print-level prin1-to-string erase-buffer elt command-history previous-matching-history-element next-matching-history-element] 6 (#$ . 12768) (let* ((enable-recursive-minibuffers t) (minibuffer-history-sexp-flag nil) (regexp (read-from-minibuffer "Previous element matching (regexp): " nil minibuffer-local-map nil (quote minibuffer-history-search-history)))) (list (if (string= regexp "") (if minibuffer-history-search-history (car minibuffer-history-search-history) (error "No previous history search regexp")) regexp) (prefix-numeric-value current-prefix-arg)))]) #@221 Find the next history element that matches REGEXP. (The next history element refers to a more recent action.) With prefix argument N, search for Nth next match. If N is negative, find the previous or Nth previous match. (defalias 'next-matching-history-element #[(regexp n) "À \n[\"‡" [previous-matching-history-element regexp n] 3 (#$ . 14001) (let* ((enable-recursive-minibuffers t) (minibuffer-history-sexp-flag nil) (regexp (read-from-minibuffer "Next element matching (regexp): " nil minibuffer-local-map nil (quote minibuffer-history-search-history)))) (list (if (string= regexp "") (setcar minibuffer-history-search-history (nth 1 minibuffer-history-search-history)) regexp) (prefix-numeric-value current-prefix-arg)))]) #@72 Insert the next element of the minibuffer history into the minibuffer. (defalias 'next-history-element #[(n) "ÁU†\\ Z]\fJG^‰ÁU„ Uƒ8Æ ÁUƒ)ÁV‚, ÂUƒ3Ç‚4È!‚[É ˆ ‰S\fJ8\n ƒTÌ Î\n!)‚V\ncˆ)eb)‡" [n 0 1 minibuffer-history-position minibuffer-history-variable narg error "End of history; no next item" "Beginning of history; no preceding item" erase-buffer elt minibuffer-history-sexp-flag nil print-level prin1-to-string] 4 (#$ . 14735) "p"]) #@77 Inserts the previous element of the minibuffer history into the minibuffer. (defalias 'previous-history-element #[(n) "À [!‡" [next-history-element n] 2 (#$ . 15199) "p"]) #@75 Get next element of history which is a completion of minibuffer contents. (defalias 'next-complete-history-element #[(n) "`ÁÂÃe`{!P\f\"ˆb)‡" [point-at-start next-matching-history-element "^" regexp-quote n] 5 (#$ . 15377) "p"]) #@79 Get previous element of history which is a completion of minibuffer contents. (defalias 'previous-complete-history-element #[(n) "À [!‡" [next-complete-history-element n] 2 (#$ . 15613) "p"]) #@61 Goto line ARG, counting from line 1 at beginning of buffer. (defalias 'goto-line #[(arg) "À !Œ~ˆÂbˆ Ä=ƒÅÆÇÈ S$‚ Sy)‡" [prefix-numeric-value arg 1 selective-display t re-search-forward "[\n ]" nil end] 5 (#$ . 15811) "NGoto line: "]) (define-function (quote advertised-undo) (quote undo)) #@116 Undo some previous changes. Repeat this command to undo more changes. A numeric argument serves as a repeat count. (defalias 'undo #[(&optional arg) "À à Æ Ç =„ÈÉ!ˆ\nË=„\"Ì ˆÍÎ!ˆÍ†)Î!ˆÑ‰ƒ]„]@ƒ]@¨ƒTÀÔ@\"A‰„6* ƒk „kÕ\f!ˆ*ˉ‡" [t this-command buffer-modified-p recent-auto-save-p recent-save modified selected-window minibuffer-window message "Undo!" last-command undo undo-start undo-more 1 arg buffer-undo-list nil done tail delq delete-auto-save-file-if-necessary] 4 (#$ . 16111) "*p"]) #@73 Within a run of consecutive undo commands, list remaining to be undone. (defvar pending-undo-list nil (#$ . 16648)) #@126 Set `pending-undo-list' to the front of the undo list. The next call to `undo-more' will undo the most recently made change. (defalias 'undo-start #[nil "Á=ƒ\nÂÃ!ˆ‰‡" [buffer-undo-list t error "No undo information in this buffer" pending-undo-list] 2 (#$ . 16771)]) #@179 Undo back N undo-boundaries beyond what was already undone recently. Call `undo-start' to get ready to undo recent changes, then call `undo-more' one or more times to undo them. (defalias 'undo-more #[(count) "„ÁÂ!ˆÃ\f\"‰‡" [pending-undo-list error "No further undo information" primitive-undo count] 3 (#$ . 17048)]) #@58 History list for some commands that read shell commands. (defvar shell-command-history nil (#$ . 17377)) #@66 Switch used to have the shell execute its command line argument. (defvar shell-command-switch "-c" (#$ . 17488)) #@991 Execute string COMMAND in inferior shell; display output, if any. If COMMAND ends in ampersand, execute it asynchronously. The output appears in the buffer `*Async Shell Command*'. That buffer is in shell mode. Otherwise, COMMAND is executed synchronously. The output appears in the buffer `*Shell Command Output*'. If the output is one line, it is displayed in the echo area *as well*, but it is nonetheless available in buffer `*Shell Command Output*', even though that buffer is not automatically displayed. If there is no output, or if output is inserted in the current buffer, then `*Shell Command Output*' is deleted. The optional second argument OUTPUT-BUFFER, if non-nil, says to put the output in some other buffer. If OUTPUT-BUFFER is a buffer or buffer name, put the output there. If OUTPUT-BUFFER is not a buffer and not nil, insert output in current buffer. (This cannot be done asynchronously.) In either case, the output is inserted after point (leaving mark after it). (defalias 'shell-command #[(command &optional output-buffer) "ƒ,Á!„,;„, ˆÃ ˆÄ ÆÇÆ &ˆÊÇ!Ë `p“ˆb‡Ì  ÎŽÏÐ \"ƒ¡Ñ†@Ò!Æ ׉”O Ø!‰ƒnÙÚ!ƒjÛ!ˆ‚nÜÝ!ˆŠqˆÆß ˆà!ˆáâ  %ã$åæ!ˆç ˆèé\",‚¨ê`` Æ$*‡" [output-buffer bufferp barf-if-buffer-read-only push-mark call-process shell-file-name nil t shell-command-switch command mark mark-marker match-data match-data ((store-match-data match-data)) string-match "[ ]*&[ ]*$" get-buffer-create "*Asynch Shell Command*" default-directory proc directory buffer 0 get-buffer-process yes-or-no-p "A command is running. Kill it? " kill-process error "Shell command in progress" buffer-read-only erase-buffer display-buffer start-process "Shell" (":%s") mode-line-process require shell shell-mode set-process-sentinel shell-command-sentinel shell-command-on-region] 8 (#$ . 17608) (list (read-from-minibuffer "Shell command: " nil nil nil (quote shell-command-history)) current-prefix-arg)]) (defalias 'shell-command-sentinel #[(process signal) "À !Â>…ÃÄÅ !AA@ÇÈO#‡" [process-status process (exit signal) message "%s: %s." process-command signal 0 -1] 6]) #@1017 Execute string COMMAND in inferior shell with region as input. Normally display output (if any) in temp buffer `*Shell Command Output*'; Prefix arg means replace the region with it. The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE. If REPLACE is non-nil, that means insert the output in place of text from START to END, putting point and mark around it. If the output is one line, it is displayed in the echo area, but it is nonetheless available in buffer `*Shell Command Output*' even though that buffer is not automatically displayed. If there is no output, or if output is inserted in the current buffer, then `*Shell Command Output*' is deleted. If the optional fourth argument OUTPUT-BUFFER is non-nil, that says to put the output in some other buffer. If OUTPUT-BUFFER is a buffer or buffer name, put the output there. If OUTPUT-BUFFER is not a buffer and not nil, insert output in the current buffer. In either case, the output is inserted after point (leaving mark after it). (defalias 'shell-command-on-region #[(start end command &optional output-buffer replace) "„ ƒV !„V ;„V… \fW bˆƒ%Æ ˆÇ \fɉÊ \f&ˆÍÎ!‰ƒIp=„IÐ!ˆ)…T …TÑ )‡Ò †\\Î!ÊÕŽp=ƒÊ \f]d|ˆe \f]|ˆÇedɉÊ \f&ˆÉ‰‚°ŠqˆÊ× ˆ)Ç \fÊÊ \f&ˆÉ‰+‡" [replace output-buffer bufferp start end swap push-mark call-process-region shell-file-name t nil shell-command-switch command get-buffer "*Shell Command Output*" shell-buffer kill-buffer exchange-point-and-mark get-buffer-create success buffer ((byte-code "ŠqˆÁ ÂUƒ‚Ãed\")‰ÂUƒ* ƒ#ÆÇ!ˆÈ!ˆ‚P ƒI\fÉUƒIÆÊŠqˆebˆ`ˈ`{)\"ˆ‚PÌÍ!É\"ˆ)ˇ" [buffer buffer-size 0 count-lines lines success message "(Shell command completed with no output)" kill-buffer 1 "%s" nil set-window-start display-buffer] 5)) buffer-read-only erase-buffer] 10 (#$ . 19742) (let ((string (read-from-minibuffer "Shell command on region: " nil nil nil (quote shell-command-history)))) (list (region-beginning) (region-end) string current-prefix-arg current-prefix-arg))]) #@53 Keymap used while processing \[universal-argument]. (defconst universal-argument-map (byte-code "À  ÃÄ#ˆÂ ÅÇ\"Ä#ˆÂ ÈÉ#ˆÂ ÊË#ˆÂ ÌÍ#ˆÂ ÎÏ#ˆÂ ÐÏ#ˆÂ ÑÏ#ˆÂ ÒÏ#ˆÂ ÓÏ#ˆÂ ÔÏ#ˆÂ ÕÏ#ˆÂ ÖÏ#ˆÂ ×Ï#ˆÂ ØÏ#ˆ )‡" [make-sparse-keymap map define-key [t] universal-argument-other-key vector meta-prefix-char t [switch-frame] nil [21] universal-argument-more [45] universal-argument-minus [48] digit-argument [49] [50] [51] [52] [53] [54] [55] [56] [57]] 5) (#$ . 21792)) #@194 Number of argument-specifying events read by `universal-argument'. `universal-argument-other-key' uses this to discard those events from (this-command-keys), and reread only the final command. (defvar universal-argument-num-events nil (#$ . 22254)) #@389 Begin a numeric argument for the following command. Digits or minus sign following \[universal-argument] make up the numeric argument. \[universal-argument] following the digits or minus sign ends the argument. \[universal-argument] without digits or minus sign provides 4 as argument. Repeating \[universal-argument] without digits or minus sign multiplies the argument by 4 each time. (defalias 'universal-argument #[nil "ÀC G\f‰‡" [4 prefix-arg this-command-keys universal-argument-num-events universal-argument-map overriding-terminal-local-map] 2 (#$ . 22510) nil]) (defalias 'universal-argument-more #[(arg) ":ƒ@Á_C‚ÃÅ G‰‡" [arg 4 prefix-arg nil overriding-terminal-local-map this-command-keys universal-argument-num-events] 2 nil "P"]) #@129 Begin a negative numeric argument for the next command. \[universal-argument] following digits or minus sign ends the argument. (defalias 'negative-argument #[(arg) "¨ƒ [‚Â=ƒÃ‚ÂÄ G‰‡" [arg prefix-arg - nil this-command-keys universal-argument-num-events universal-argument-map overriding-terminal-local-map] 2 (#$ . 23277) "P"]) #@124 Part of the numeric argument for the next command. \[universal-argument] following digits or minus sign ends the argument. (defalias 'digit-argument #[(arg) "À Â\"ÃZ ¨ƒ! Æ_ ÇWƒ\f[‚\f\\‚; É=ƒ8\fÇUƒ1É‚3\f[‚;\f)Ê G \f‰ ‡" [logand last-command-char 127 48 digit arg 10 0 prefix-arg - this-command-keys universal-argument-num-events universal-argument-map overriding-terminal-local-map] 3 (#$ . 23631) "P"]) (defalias 'universal-argument-minus #[(arg) "¨ƒ Á!‡Â!‡" [arg universal-argument-other-key negative-argument] 2 nil "P"]) (defalias 'universal-argument-other-key #[(arg) " Ä !Æ ›\"*É ˆÊ‰ ‡" [arg prefix-arg this-command-keys key listify-key-sequence keylist append universal-argument-num-events unread-command-events reset-this-command-lengths nil overriding-terminal-local-map] 3 nil "P"]) #@66 Move forward ARG lines and position at first nonblank character. (defalias 'forward-to-indentation #[(arg) "yˆÁÂw‡" [arg " " nil] 2 (#$ . 24465) "p"]) #@67 Move backward ARG lines and position at first nonblank character. (defalias 'backward-to-indentation #[(arg) "[yˆÁÂw‡" [arg " " nil] 2 (#$ . 24624) "p"]) #@75 *If non-nil, `kill-line' with no arg at beg of line kills the whole line. (defvar kill-whole-line nil (#$ . -24786)) #@366 Kill the rest of the current line; if no nonblanks there, kill thru newline. With prefix argument, kill that many lines from point. Negative arguments kill lines backward. When calling from a program, nil means "no arg", a number counts as a prefix arg. If `kill-whole-line' is non-nil, then kill the whole line when given no argument at the beginning of a line. (defalias 'kill-line #[(&optional arg) "À` ƒ !yˆ‚/mƒÃÄÅ\"ˆÆÇ!„&ƒ,nƒ,Éyˆ‚/ň`\"‡" [kill-region arg prefix-numeric-value signal end-of-buffer nil looking-at "[ ]*$" kill-whole-line 1] 5 (#$ . 24910) "P"]) #@558 Function to call to make a killed region available to other programs. Most window systems provide some sort of facility for cutting and pasting text between the windows of different programs. This variable holds a function that Emacs calls whenever text is put in the kill ring, to make the new kill available to other programs. The function takes one or two arguments. The first argument, TEXT, is a string containing the text which should be made available. The second, PUSH, if non-nil means this is a "new" kill; nil means appending to an "old" kill. (defvar interprogram-cut-function nil (#$ . 25499)) #@969 Function to call to get text cut from other programs. Most window systems provide some sort of facility for cutting and pasting text between the windows of different programs. This variable holds a function that Emacs calls to obtain text that other programs have provided for pasting. The function should be called with no arguments. If the function returns nil, then no other program has provided such text, and the top of the Emacs kill ring should be used. If the function returns a string, that string should be put in the kill ring as the latest kill. Note that the function should return a string only if a program other than Emacs has provided a string for pasting; if Emacs provided the most recent string, the function should return nil. If it is difficult to tell whether Emacs or some other program provided the current string, it is probably good enough to return nil if the string is equal (according to `string=') to the last text Emacs provided. (defvar interprogram-paste-function nil (#$ . 26115)) #@430 List of killed text sequences. Since the kill ring is supposed to interact nicely with cut-and-paste facilities offered by window systems, use of this variable should interact nicely with `interprogram-cut-function' and `interprogram-paste-function'. The functions `kill-new', `kill-append', and `current-kill' are supposed to implement this interaction; you may want to use them instead of manipulating the kill ring directly. (defvar kill-ring nil (#$ . 27144)) #@70 *Maximum length of kill ring before oldest elements are thrown away. (defconst kill-ring-max 30 (#$ . -27615)) #@63 The tail of the kill ring whose car is the last thing yanked. (defvar kill-ring-yank-pointer nil (#$ . 27732)) #@294 Make STRING the latest kill in the kill ring. Set the kill-ring-yank pointer to point to it. If `interprogram-cut-function' is non-nil, apply it to STRING. Optional second argument REPLACE non-nil means that STRING will replace the front of the kill ring, rather than being added to the list. (defalias 'kill-new #[(string &optional replace) "ÀÁ!ƒÁ\n …\f@\"ˆ ƒ\f\n ˆ‚-\n\fB‰G Vƒ- S\f›Æ¡ˆ\f…;\n ?\"‡" [fboundp menu-bar-update-yank-menu string replace kill-ring kill-ring-max nil kill-ring-yank-pointer interprogram-cut-function] 4 (#$ . 27850)]) #@185 Append STRING to the end of the latest kill in the kill ring. If BEFORE-P is non-nil, prepend STRING to the kill. If `interprogram-cut-function' is set, pass the resulting kill to it. (defalias 'kill-append #[(string before-p) "À ƒ\f\n @P‚ @\nPÄ\"‡" [kill-new before-p string kill-ring t] 3 (#$ . 28418)]) #@359 Rotate the yanking point by N places, and then return that kill. If N is zero, `interprogram-paste-function' is set, and calling it returns a string, then that string is added to the front of the kill ring and returned as the latest kill. If optional arg DO-NOT-MOVE is non-nil, then don't actually move the yanking point; just return the Nth kill forward. (defalias 'current-kill #[(n &optional do-not-move) "ÁU…\f\n…\f\n ‰ƒÄÆ !ˆ) ‚A„%ÈÉ!ˆÊ GZG\"›\f „=\f \f@))‡" [n 0 interprogram-paste-function interprogram-paste nil interprogram-cut-function kill-new kill-ring error "Kill ring is empty" mod kill-ring-yank-pointer ARGth-kill-element do-not-move] 4 (#$ . 28734)]) #@66 *Non-nil means don't signal an error for killing read-only text. (defvar kill-read-only-ok nil (#$ . -29432)) #@783 Kill between point and mark. The text is deleted but saved in the kill ring. The command \[yank] can retrieve it from there. (If you want to kill and then yank immediately, use \[copy-region-as-kill].) If the buffer is read-only, Emacs will beep and refrain from deleting the text, but put the text in the kill ring anyway. This means that you can use the killing commands to copy text from a read-only buffer. This is the primitive for programs to kill text (as opposed to deleting it). Supply two arguments, character numbers indicating the stretch of text to be killed. Any command that calls this function is a "kill command". If the previous command was also a kill command, the text killed this time appends to the text killed last time to make one entry in the kill ring. (defalias 'kill-region #[(beg end) "ƒ ƒ \fÅÆ$ƒ+Ç \f\"ˆƒ\"ÉÊ!ˆ‚}Ë\fÍ ˆ‚}Ï=„tË=„t \fU„t \f] \f^ZÑ\\Æ \f|ˆ‰@@;„iA‰‚ZÕ@@!ˆ+‚}Ç \f\"ˆ \f|ˆË‰\f‡" [buffer-read-only inhibit-read-only text-property-not-all beg end read-only nil copy-region-as-kill kill-read-only-ok message "Read only text copied to kill ring" kill-region this-command barf-if-buffer-read-only buffer-undo-list t last-command 100 tail old-list undo-strong-limit kill-new] 6 (#$ . 29549) "r"]) #@147 Save the region as if killed, but don't kill it. If `interprogram-cut-function' is non-nil, also save the text for a window system cut and paste. (defalias 'copy-region-as-kill #[(beg end) "Á=ƒ \f{\f W\"ˆ‚Å \f{!ˆÆ‡" [last-command kill-region kill-append beg end kill-new nil] 4 (#$ . 30832) "r"]) #@284 Save the region as if killed, but don't kill it. This command is similar to `copy-region-as-kill', except that it gives visual feedback indicating the extent of the region being copied. If `interprogram-cut-function' is non-nil, also save the text for a window system cut and paste. (defalias 'kill-ring-save #[(beg end) "À \n\"ˆt…|` Uƒ\n‚ `ÃÇÈ \"ƒSÉ `p“ˆbˆÊË!ˆÉ p“ˆ bˆ\f…{ …{…{Ï ÐÑ!‚{ÒÓ!‰GÕ^` Uƒq×Ø[ÏO\"‚z×ÙÓO\"*+‡" [copy-region-as-kill beg end t inhibit-quit opoint other-end pos-visible-in-window-p selected-window mark-marker sit-for 1 quit-flag mark-active transient-mark-mode nil run-hooks deactivate-mark-hook current-kill 0 killed-text 40 message-len message "Saved text until \"%s\"" "Saved text from \"%s\""] 6 (#$ . 31142) "r"]) #@67 Cause following command, if it kills, to append to previous kill. (defalias 'append-next-kill #[nil "tƒ\nÀÂÃ!‡À‰‡" [kill-region this-command message "If the next command is a kill, it will append" last-command] 2 (#$ . 31927) nil]) #@549 Replace just-yanked stretch of killed text with a different stretch. This command is allowed only immediately after a `yank' or a `yank-pop'. At such a time, the region contains a stretch of reinserted previously-killed text. `yank-pop' deletes that text and inserts in its place a different stretch of killed text. With no argument, the previous kill is inserted. With argument N, insert the Nth previous kill. If N is negative, this is a more recent kill. The sequence of kills wraps around, so that after the oldest one comes the newest one. (defalias 'yank-pop #[(arg) "Á=„\nÂÃ!ˆÁ`ÅÆ!W`ÅÆ!|ˆÈ `p“ˆÉ\n!cˆƒ5ÅÆ!È `p“ˆbˆ)ˇ" [last-command yank error "Previous command was not a yank" this-command mark t before mark-marker current-kill arg nil] 4 (#$ . 32169) "*p"]) #@364 Reinsert the last stretch of killed text. More precisely, reinsert the stretch of killed text most recently killed OR yanked. Put point at end, and set mark at beginning. With just C-u as argument, same but put point at beginning (and mark at end). With argument N, reinsert the Nth most recently killed stretch of killed text. See also the command \[yank-pop]. (defalias 'yank #[(&optional arg) "ÀÂ`!ˆÃ\f<ƒÅ‚\fÆ=ƒÇ‚\fS!cˆ\f:ƒ/ÈÀ!É `p“ˆbˆÊˇ" [t this-command push-mark current-kill arg 0 - -1 mark mark-marker yank nil] 4 (#$ . 32955) "*P"]) #@118 Rotate the yanking point in the kill ring. With argument, rotate that many kills forward (or backward, if negative). (defalias 'rotate-yank-pointer #[(arg) "À !‡" [current-kill arg] 2 (#$ . 33516) "p"]) #@120 Insert after point the contents of BUFFER. Puts mark after the inserted text. BUFFER may be a buffer or a buffer name. (defalias 'insert-buffer #[(buffer) "À !„\n !ɉŠŠ qˆed)Ç  #ˆ`)È\f!ˆ+Ç" [bufferp buffer get-buffer nil newmark end start insert-buffer-substring push-mark] 4 (#$ . 33726) (list (progn (barf-if-buffer-read-only) (read-buffer "Insert buffer: " (other-buffer (current-buffer) t) t)))]) #@264 Append to specified buffer the text of the region. It is inserted into that buffer before its point. When calling from a program, give three arguments: BUFFER (or buffer name), START and END. START and END specify the portion of the current buffer to be copied. (defalias 'append-to-buffer #[(buffer start end) "pŠÁ\n!qˆÃ\f #*‡" [oldbuf get-buffer-create buffer insert-buffer-substring start end] 4 (#$ . 34149) (list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t)) (region-beginning) (region-end))]) #@264 Prepend to specified buffer the text of the region. It is inserted into that buffer after its point. When calling from a program, give three arguments: BUFFER (or buffer name), START and END. START and END specify the portion of the current buffer to be copied. (defalias 'prepend-to-buffer #[(buffer start end) "pŠÁ\n!qˆŠÃ\f #+‡" [oldbuf get-buffer-create buffer insert-buffer-substring start end] 4 (#$ . 34681) "BPrepend to buffer: \nr"]) #@276 Copy to specified buffer the text of the region. It is inserted into that buffer, replacing existing text there. When calling from a program, give three arguments: BUFFER (or buffer name), START and END. START and END specify the portion of the current buffer to be copied. (defalias 'copy-to-buffer #[(buffer start end) "pŠÁ\n!qˆÃ ˆŠÄ #+‡" [oldbuf get-buffer-create buffer erase-buffer insert-buffer-substring start end] 4 (#$ . 35133) "BCopy to buffer: \nr"]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put mark-inactive error-conditions (mark-inactive error) error-message "The mark is not active now"] 4) #@336 Return this buffer's mark value as integer; error if mark inactive. If optional argument FORCE is non-nil, access the mark value even if the mark is not currently active, and return nil if there is no mark at all. If you are using this in an editing command, you are most likely making a mistake; see the documentation of `set-mark'. (defalias 'mark #[(&optional force) "„ ƒ\n„ ƒÄÅ !‡ÆÇÈ\"‡" [force transient-mark-mode mark-active mark-even-if-inactive marker-position mark-marker signal mark-inactive nil] 3 (#$ . 35738)]) #@152 Deactivate the mark by setting `mark-active' to nil. (That makes a difference only in Transient Mark mode.) Also runs the hook `deactivate-mark-hook'. (defalias 'deactivate-mark #[nil "… ÁÃÄ!‡" [transient-mark-mode nil mark-active run-hooks deactivate-mark-hook] 2 (#$ . 36279)]) (put (quote deactivate-mark) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@701 Set this buffer's mark to POS. Don't use this function! That is to say, don't use this function unless you want the user to see that the mark has moved, and you want the previous mark position to be lost. Normally, when a new mark is set, the old one should go on the stack. This is why most applications should use push-mark, not set-mark. Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. The mark saves a location for the user's convenience. Most editing commands should not alter the mark. To remember a location for internal use in the Lisp program, store it in a Lisp variable. Example: (let ((beg (point))) (forward-line 1) (delete-region beg (point))). (defalias 'set-mark #[(pos) "ƒÁÃÄ!ˆÅ p“‡ÆÃÇ!ˆÅ Ɖ“‡" [pos t mark-active run-hooks activate-mark-hook mark-marker nil deactivate-mark-hook] 3 (#$ . 36657)]) #@68 The list of former marks of the current buffer, most recent first. (defvar mark-ring nil (#$ . 37525)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local mark-ring put permanent-local t] 4) #@73 *Maximum size of mark ring. Start discarding off end if gets this big. (defconst mark-ring-max 16 (#$ . -37722)) #@52 The list of saved global marks, most recent first. (defvar global-mark-ring nil (#$ . 37842)) #@80 *Maximum size of global mark ring. Start discarding off end if gets this big. (defconst global-mark-ring-max 16 (#$ . -37942)) #@409 Set mark at where point is, or jump to mark. With no prefix argument, set mark, push old mark position on local mark ring, and push mark on global mark ring. With argument, jump to mark, and pop a new position for mark off the ring (does not affect global mark ring). Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. See the documentation of `set-mark' for more information. (defalias 'set-mark-command #[(arg) "„\nÁ‰Ã#‡ÄÃ!„ÅÆ!‡ÄÃ!bˆÇ ‡" [arg push-mark nil t mark error "No mark set in this buffer" pop-mark] 4 (#$ . 38077) "P"]) #@524 Set mark at LOCATION (point, by default) and push old mark on mark ring. If the last global mark pushed was not in the current buffer, also push LOCATION on the global mark ring. Display `Mark set' unless the optional second arg NOMSG is non-nil. In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil. Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. See the documentation of `set-mark' for more information. In Transient Mark mode, this does not activate the mark. (defalias 'push-mark #[(&optional location nomsg activate) "ÀÁ!ƒ#Âà !\fB‰G Vƒ# \f›@Ɖ“ˆ S\f›Æ¡ˆÃ †+`p“ˆƒ=É@!p=„aÂà !B‰G\nVƒa\n›@Ɖ“ˆ\nS›Æ¡ˆ „v\f„vÍ ÎV„vÏÐ!ˆ„€„†ÓÀÁ!!ˆÆ‡" [mark t copy-marker mark-marker mark-ring mark-ring-max nil location global-mark-ring marker-buffer global-mark-ring-max nomsg executing-macro minibuffer-depth 0 message "Mark set" activate transient-mark-mode set-mark] 4 (#$ . 38652)]) #@107 Pop off mark ring into the buffer's actual mark. Does not set point. Does nothing if mark ring is empty. (defalias 'pop-mark #[nil "…0Á !C¤ @p“ˆ ƒÄÆÇ!ˆ@ĉ“ˆÈÉ!„,Ê ˆA‰‡" [mark-ring copy-marker mark-marker transient-mark-mode nil mark-active run-hooks deactivate-mark-hook mark t ding] 3 (#$ . 39624)]) (define-function (quote exchange-dot-and-mark) (quote exchange-point-and-mark)) #@149 Put the mark where point is now, and point where the mark is now. This command works even when the mark is not active, and it reactivates the mark. (defalias 'exchange-point-and-mark #[nil "ÀÁ!‰„\fÃÄ!ˆÅ`!ˆ\nbˆ)Ƈ" [mark t omark error "No mark set in this buffer" set-mark nil] 3 (#$ . 40027) nil]) #@393 Toggle Transient Mark mode. With arg, turn Transient Mark mode on if arg is positive, off otherwise. In Transient Mark mode, when the mark is active, the region is highlighted. Changing the buffer "deactivates" the mark. So do certain other operations that set the mark but whose main purpose is something else--for example, incremental search, \[beginning-of-buffer], and \[end-of-buffer]. (defalias 'transient-mark-mode #[(arg) "„ ?‚Â!ÃV‰‡" [arg transient-mark-mode prefix-numeric-value 0] 2 (#$ . 40334) "P"]) #@56 Pop off global mark ring and jump to the top location. (defalias 'pop-global-mark #[nil "ƒÁ@!„A‰„„ÂÃ!ˆ@Á\f!Æ\f!A@C¤ qˆeYƒ>dX„@~ˆbˆÈ !+‡" [global-mark-ring marker-buffer error "No global mark set" marker buffer marker-position position switch-to-buffer] 3 (#$ . 40861) nil]) #@74 *If non-nil, `next-line' inserts newline to avoid `end of buffer' error. (defvar next-line-add-newlines t (#$ . -41170)) #@932 Move cursor vertically down ARG lines. If there is no character in the target line exactly under the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. If there is no line in the buffer after this one, behavior depends on the value of `next-line-add-newlines'. If non-nil, it inserts a newline character to create a line, and moves the cursor to that line. Otherwise it moves the cursor to the end of the buffer. The command \[set-goal-column] can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically. This goal column is stored in `goal-column', which is nil when there is none. If you are thinking of using this in a Lisp program, consider using `forward-line' instead. It is usually easier to use and more reliable (no dependence on goal column, etc.). (defalias 'next-line #[(arg) "ƒ% ÂUƒ%`ĈmƒÅÂ!ˆ‚! bˆÆ !ˆ)‚5tƒ1ÄÇȈ‚5Æ !ˆÄ‡" [next-line-add-newlines arg 1 opoint nil newline line-move (line-move arg) (((beginning-of-buffer end-of-buffer) (ding)))] 3 (#$ . 41298) "p"]) #@612 Move cursor vertically up ARG lines. If there is no character in the target line exactly over the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. The command \[set-goal-column] can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically. If you are thinking of using this in a Lisp program, consider using `forward-line' with a negative argument instead. It is usually easier to use and more reliable (no dependence on goal column, etc.). (defalias 'previous-line #[(arg) "tƒ\fÀÁˆ‚Ã\f[!ˆÀ‡" [nil (byte-code "À [!‡" [line-move arg] 2) (((beginning-of-buffer end-of-buffer) (ding))) line-move arg] 3 (#$ . 42467) "p"]) #@201 *Non-nil means vertical motion starting at end of line keeps to ends of lines. This means moving to the end of each line moved onto. The beginning of a blank line does not count as the end of a line. (defconst track-eol nil (#$ . -43268)) #@87 *Semipermanent goal column for vertical motion, as set by \[set-goal-column], or nil. (defvar goal-column nil (#$ . -43513)) (make-variable-buffer-local (quote goal-column)) #@198 Current goal column for vertical motion. It is the column where point was at the start of current run of vertical motion commands. When the `track-eol' feature is doing its job, the value is 9999. (defvar temporary-goal-column 0 (#$ . 43694)) #@98 *Non-nil means \[next-line] and \[previous-line] ignore invisible lines. Outline mode sets this. (defvar line-move-ignore-invisible nil (#$ . -43943)) (defalias 'line-move #[(arg) "À`ÁÅŽÇ=„1È=„1 ƒ.lƒ.nƒ*Ê=ƒ.Ë‚/i\f ¨„x„xÐVƒYÑVƒOSyˆÁˆÒÑy!‚bÒy!ƒen„8ÓÐWƒqÔ‚rÕÁ\"ˆ‚8ÐVƒ×ÁˆÖÑ!ÐUƒÓÕÁ\"ˆm„Î×`Ø\"À=ƒ¥‚²>†²ž)ƒÎÛ`Ø\"ƒÆÜ`Ø\"bˆ‚Ý`!bˆ‚S‰‚zÐWƒ8ÐyˆÖÞ!ÐUƒîÓÔÁ\"ˆo„/×`SØ\"À=ƒ‚>†ž)ƒ/Û`SØ\"ƒ'ß`Ø\"bˆ‚îà`!bˆ‚îT‰‚Ùá\"†@\f!ˆ,Á‡" [t nil new opoint inhibit-point-motion-hooks ((byte-code "` bˆÂb‡" [new opoint nil inhibit-point-motion-hooks] 1)) last-command next-line previous-line track-eol end-of-line 9999 temporary-goal-column selective-display line-move-ignore-invisible arg 0 1 zerop signal beginning-of-buffer end-of-buffer vertical-motion get-char-property invisible prop buffer-invisibility-spec get-text-property next-single-property-change next-overlay-change -1 previous-single-property-change previous-overlay-change move-to-column goal-column] 4]) (put (quote set-goal-column) (quote disabled) t) #@381 Set the current horizontal position as a goal for \[next-line] and \[previous-line]. Those commands will move to this position in the line moved to rather than trying to keep the same horizontal position. With a non-nil argument, clears out the goal column so that \[next-line] and \[previous-line] resume vertical motion. The goal column is stored in the variable `goal-column'. (defalias 'set-goal-column #[(arg) "ƒ ÁÃÄ!ˆ‚iÃÅÆ!\n\"ˆÁ‡" [arg nil goal-column message "No goal column" substitute-command-keys "Goal column %d (use \\[set-goal-column] with an arg to unset it)"] 3 (#$ . 45054) "P"]) #@214 *The number of columns to try scrolling a window by when point moves out. If that fails to bring point back on frame, point is centered instead. If this is zero, point is always centered after it moves off frame. (defvar hscroll-step 0 (#$ . -45664)) #@65 Scrolls the selected window horizontally to make point visible. (defalias 'hscroll-point-visible #[nil "ŠÀ qˆ „ ÃV„\f…¯Å Æ W…¯`Ç Wƒ=ŠÇ bˆÃyˆ`)`Yƒ<ÉÊ\"ˆ)Ë \f Í^Å S\fUƒZgÐU„_S\fZW„u\f\\Vƒ“ŠÊˆË )Ó\fÅ Ô¥ZÅ ZÕZ^!)‚®\fWƒ¢Ö!‚®\fV…®Ó!+)‡" [window-buffer truncate-lines window-hscroll 0 truncate-partial-width-windows window-width frame-width window-start ws-bol set-window-start nil hscroll-window-column here 1 left right 10 hscroll-step eol scroll-left 2 -5 scroll-right] 4 (#$ . 45921)]) (defalias 'hscroll-window-column #[nil "À ŠÂyˆ`ŠÃ bˆÂyˆ`)Uƒà bˆ`)Å Æ =ƒ7à ÇUƒ7\feUƒ7È ‚8ÂÂÇ Z^\\ Ê Ì\f ÂB`ÂÇBÍ ÂBÊ&A@,‡" [window-hscroll hscroll 0 window-start startpos selected-window minibuffer-window 1 minibuffer-prompt-width hpos nil val compute-motion 1000000] 8]) #@100 Scroll the "other window" down. For more details, see the documentation for `scroll-other-window'. (defalias 'scroll-other-window-down #[(lines) "À Â=?… „‚à ![!‡" [scroll-other-window lines - prefix-numeric-value] 3 (#$ . 46755) "P"]) (define-key esc-map [33554454] (quote scroll-other-window-down)) #@160 Move point to the beginning of the buffer in the other window. Leave mark at previous position. With arg N, put point N/10 of the way from the true beginning. (defalias 'beginning-of-buffer-other-window #[(arg) "À Á ÄŽÅ\n!ˆÆ!ˆÈÉ!+‡" [selected-window other-window-for-scrolling window orig-window ((select-window orig-window)) select-window beginning-of-buffer arg recenter (t)] 2 (#$ . 47069) "P"]) #@148 Move point to the end of the buffer in the other window. Leave mark at previous position. With arg N, put point N/10 of the way from the true end. (defalias 'end-of-buffer-other-window #[(arg) "À Á ÄŽÅ\n!ˆÆ!ˆÈÉ!+‡" [selected-window other-window-for-scrolling window orig-window ((select-window orig-window)) select-window end-of-buffer arg recenter (t)] 2 (#$ . 47479) "P"]) #@277 Interchange characters around point, moving forward one character. With prefix arg ARG, effect is to take character before point and drag it forward past ARG other characters (backward if ARG negative). If no argument and at end of line, the previous two chars are exchanged. (defalias 'transpose-chars #[(arg) "„ lƒ ÁuˆÂÃÄ!\"‡" [arg -1 transpose-subr forward-char prefix-numeric-value] 4 (#$ . 47865) "*P"]) #@290 Interchange words around point, leaving point at end of them. With prefix arg ARG, effect is to take word before or around point and drag it forward past ARG other words (backward if ARG negative). If ARG is zero, the words around or after point and around or after mark are interchanged. (defalias 'transpose-words #[(arg) "ÀÁ\n\"‡" [transpose-subr forward-word arg] 3 (#$ . 48285) "*p"]) #@129 Like \[transpose-words] but applies to sexps. Does not work on a sexp that point is in the middle of if it is a list or string. (defalias 'transpose-sexps #[(arg) "ÀÁ\n\"‡" [transpose-subr forward-sexp arg] 3 (#$ . 48682) "*p"]) #@205 Exchange current line and previous line, leaving point after both. With argument ARG, takes previous line and moves it past ARG lines. With argument 0, interchanges line point is in with line mark is in. (defalias 'transpose-lines #[(arg) "ÀÁ\n\"‡" [transpose-subr #[(arg) "ÁUƒÂˆmƒà ‡Áu‡y‡" [arg 1 nil newline] 2] arg] 3 (#$ . 48918) "*p"]) (defalias 'transpose-subr #[(mover arg) "À‰‰‰ ÆUƒ6ŠÈ!ˆ`É!ˆ`Ê bˆÈ!ˆ`É!ˆ`Ë ˆ)Ì ˆ ÆVƒeÉ!ˆ`È!ˆ`È!ˆ`É!ˆ`Ë ˆ bˆ S‰‚7 ÆW…‘É!ˆ`É!ˆ`È!ˆ`È!ˆ`Ë ˆ T‰‚f,‡" [nil end2 start2 end1 start1 arg 0 mover 1 -1 mark transpose-subr-1 exchange-point-and-mark] 5]) (defalias 'transpose-subr-1 #[nil " ^\n ]VƒÄÅ!ˆ\n{ { |ˆ bˆcˆ\n Wƒ-\n‚6\nGGZ\\bˆÈG!ˆc*‡" [end1 end2 start1 start2 error "Don't have two things to transpose" word2 word1 delete-char] 3]) #@254 *Column to indent right-margin comments to. Setting this variable automatically makes it local to the current buffer. Each mode establishes a different default value for this variable; you can set the value for a particular mode using that mode's hook. (defconst comment-column 32 (#$ . -49767)) (make-variable-buffer-local (quote comment-column)) #@72 *String to insert to start a new comment, or nil if no comment syntax. (defconst comment-start nil (#$ . -50121)) #@202 *Regexp to match the start of a comment plus everything up to its body. If there are any \(...\) pairs, the comment delimiter text is held to begin at the place matched by the close of the first pair. (defconst comment-start-skip nil (#$ . -50242)) #@110 *String to insert to end a new comment. Should be an empty string if comments are terminated by end-of-line. (defconst comment-end "" (#$ . -50498)) #@180 Obsolete variable for function to compute desired indentation for a comment. This function is called with no args with point at the beginning of the comment's starting delimiter. (defconst comment-indent-hook nil (#$ . 50654)) #@158 Function to compute desired indentation for a comment. This function is called with no args with point at the beginning of the comment's starting delimiter. (defconst comment-indent-function (quote (lambda nil comment-column)) (#$ . 50888)) #@217 *String to insert to start a new comment on a line by itself. If nil, use `comment-start' instead. Note that the regular expression `comment-start-skip' should skip this string as well as the `comment-start' string. (defconst block-comment-start nil (#$ . -51136)) #@165 *String to insert to end a new comment on a line by itself. Should be an empty string if comments are terminated by end-of-line. If nil, use `comment-end' instead. (defconst block-comment-end nil (#$ . -51408)) #@75 Indent this line's comment to comment column, or insert an empty comment. (defalias 'indent-for-comment #[nil "ŠÀyˆÁÂ!)‰ƒ\f†  ƒ† „,ÊË!‚®ŠÌˆ`) ÌÌÌÀyˆÑ Ó#ƒfÔ Õ•ƒZÕ•bˆ‚fÖ×À”\"ˆÖØÀ”\"ˆ`iƒu ‚x ‰Uƒ†bˆ‚“ÛÌxˆ`|ˆjˆƒ¤bˆ̉“‚­cˆŠ c),+‡" [0 looking-at "[ ]*$" empty block-comment-start comment-start starter block-comment-end comment-end ender error "No comment syntax defined" nil eolpos cpos indent begpos re-search-forward comment-start-skip move point-marker 1 skip-syntax-backward " " "^ " comment-indent-hook comment-indent-function " "] 5 (#$ . 51625) "*"]) #@297 Set the comment column based on point. With no arg, set the comment column to the current column. With just minus as arg, kill any comment on this line. With any other arg, set comment column to indentation of the previous comment and then align or create a comment on this line at that column. (defalias 'set-comment-column #[(arg) "Á=ƒ\nÂÃ!‡ƒ0ŠÄyˆÅ!ˆÄyˆÇ!ˆÄ”bˆiÉÊ\"ˆ)Ë ‡iÉÊ\"‡" [arg - kill-comment nil 0 re-search-backward comment-start-skip re-search-forward comment-column message "Comment column set to %d" indent-for-comment] 3 (#$ . 52253) "P"]) #@112 Kill the comment on this line, if any. With argument, kill comments on that many lines starting with this one. (defalias 'kill-comment #[(arg) "„ÁÂ!ˆÃ\f!ʼnÈV…fŠÅˆ`ÈyˆÉ\n™ƒ8ËÌ\n!Í#ˆÎÅwˆ`ÈyˆËÏ#ƒUÈ”bˆÎÅxˆÐ`\"ˆÑ ˆ)\fƒ]ÒyˆS‰‚*‡" [comment-start-skip error "No comment syntax defined" prefix-numeric-value arg nil endc count 0 "" comment-end re-search-forward regexp-quote move " " t kill-region indent-according-to-mode 1] 5 (#$ . 52830) "P"]) #@357 Comment or uncomment each line in the region. With just C-u prefix arg, uncomment each line in region. Numeric prefix arg ARG means use ARG comment characters. If ARG is negative, delete that many comment characters instead. Comments are terminated on each line, even for syntax in which newline does not end the comment. Blank lines do not get comments. (defalias 'comment-region #[(beg end &optional arg) "„ÁÂ!ˆ \fVƒÅ \f)ŠŒÅ \n :ƒ2Ì‚TÍ !‰ÎVƒT\nP\n P S‰‚9 \f}ˆ bˆm?…;Ì=„nÏWƒÌ=ƒ‡ÐÑ\n!!ƒ©Ò\nG!ˆ‚uÎT‰Vƒ¨ÐÑ\n!!ƒ¨Ò\nG!ˆ‚‹) Ô˜„Ì=ƒãňÕÅxˆ`eZ GYƒŠÖ G!ˆÐÑ !!)ƒÒ G[!ˆ‚ÎT‰VƒÅˆÕÅxˆŠÖ G!ˆÐÑ !!ƒÒ G!ˆ)‚ç)Îyˆ‚[Ð×!„2\ncˆ Ô˜„2ň cˆØÙÅÚ#ˆ‚[-‡" [comment-start error "No comment syntax is defined" beg end nil mid comment-end numarg ce cs arg t prefix-numeric-value 1 0 looking-at regexp-quote delete-char count "" " " backward-char "[ ]*$" search-forward "\n" move] 5 (#$ . 53307) "r\nP"]) #@161 Move backward until encountering the end of a word. With argument, do this that many times. In programs, it is faster to call `forward-word' with negative arg. (defalias 'backward-word #[(arg) "[v‡" [arg] 1 (#$ . 54300) "p"]) #@37 Set mark arg words away from point. (defalias 'mark-word #[(arg) "ÀŠ vˆ`)ÂÃ#‡" [push-mark arg nil t] 4 (#$ . 54533) "p"]) #@103 Kill characters forward until encountering the end of a word. With argument, do this that many times. (defalias 'kill-word #[(arg) "À` vˆ`\"‡" [kill-region arg] 3 (#$ . 54662) "p"]) #@104 Kill characters backward until encountering the end of a word. With argument, do this that many times. (defalias 'backward-kill-word #[(arg) "À [!‡" [kill-word arg] 2 (#$ . 54851) "p"]) #@153 Return the word point is on (or a nearby word) as a string. If optional arg STRICT is non-nil, return nil unless point is within or adjacent to a word. (defalias 'current-word #[(&optional strict) "Š```ÃÄ!ˆ`\nbˆÅÄ!ˆ` \n=ƒY\n=ƒY?…\\ÃÇŠÈyˆ`)\"ˆnƒKÅNJɈ`)\"ˆ`ÅÄ!ˆ`‚S`ÃÄ!ˆ` {‚\\ {,‡" [end start oldpoint skip-syntax-backward "w_" skip-syntax-forward strict "^w_" 0 nil] 3 (#$ . 55044)]) #@144 *String for filling to insert at front of new line, or nil for none. Setting this variable automatically makes it local to the current buffer. (defconst fill-prefix nil (#$ . -55455)) (make-variable-buffer-local (quote fill-prefix)) #@57 *Regexp to match lines which should not be auto-filled. (defconst auto-fill-inhibit-regexp nil (#$ . -55694)) (defalias 'do-auto-fill #[nil "À‰‰‰ Æ ‰?†6Ç ‰?†6\fÈ=ƒ&i X†6ŠÉyˆ`\n…5Ë\n!)?…(\fÌ>ƒEŠÍ ˆ)ƒv ƒT ϘƒvЊÑÒ!ˆ`)ŠÓÒ!ˆ`)Ô#‰ƒuÏš„u)\n„#i Vƒ#`ÀÖŠÚ T!ˆ„´o„ЄЃЊÜuˆËÝ!…°ËÞ!?)ƒÐÀßÀxˆnƒÉàáÖ#ˆÖâÀxˆ‚`,#Š#bˆn)„i$ŠâÀxˆ`#U)ƒõåÖ!ˆ‚ÿŠ#bˆåÖ!ˆ)\fÈ=„ŠÉˆæ\fÀÖ#ˆ)i$YƒÖ)‚Ö)‚væ\fÖ‰#-‡" [nil fill-prefix give-up bol justify fc current-justification current-fill-column left 0 auto-fill-inhibit-regexp looking-at (full center right) unjustify-current-line adaptive-fill-mode "" fill-context-prefix backward-paragraph 1 forward-paragraph "^[ ]*$" prefix t first bounce opoint move-to-column sentence-end-double-space -1 "\\. " "\\. " "^ \n" re-search-forward "[ ]" " " fill-point prev-column indent-new-comment-line justify-current-line] 6]) #@218 Toggle auto-fill mode. With arg, turn Auto-Fill mode on if and only if arg is positive. In Auto-Fill mode, inserting a space at a column beyond `current-fill-column' automatically breaks the line at a previous space. (defalias 'auto-fill-mode #[(&optional arg) "„ ?‚Â!ÃV…ĉÅ ˆ‡" [arg auto-fill-function prefix-numeric-value 0 do-auto-fill force-mode-line-update] 2 (#$ . 56608) "P"]) #@69 Automatically break line at a previous space, in insertion of text. (defalias 'auto-fill-function #[nil "À‡" [nil] 1 (#$ . 57007)]) #@41 Unconditionally turn on Auto Fill mode. (defalias 'turn-on-auto-fill #[nil "ÀÁ!‡" [auto-fill-mode 1] 2 (#$ . 57145)]) #@128 Set `fill-column' to current column, or to argument if given. The variable `fill-column' has a separate value for each buffer. (defalias 'set-fill-column #[(arg) "¨ƒ ‚\niÂà \"‡" [arg fill-column message "fill-column set to %d"] 3 (#$ . 57270) "P"]) #@190 *Non-nil means \[indent-new-comment-line] should continue same comment on new line, with no new terminator or starter. This is obsolete because you might as well use \[newline-and-indent]. (defconst comment-multi-line nil (#$ . -57531)) #@587 Break line at point and indent, continuing comment if within one. This indents the body of the continued comment under the previous comment line. This command is intended for styles where you write a comment per line, starting a new comment (and terminating it if necessary) on each line. If you want to continue one comment across several lines, use \[newline-and-indent]. If a fill column is specified, it overrides the use of the comment column or comment indentation. The inserted newline is marked hard if `use-hard-newlines' is true, unless optional argument SOFT is non-nil. (defalias 'indent-new-comment-line #[(&optional soft) "À‰ÃÀxˆ`ÃÀwˆ`|ˆ\fƒÅÆ!ˆ‚ÇÈ!ˆ ƒ.Ê ˆÅ !‚Í „‹Š\fƒŠ` ÎyˆÏ\f Ð#)ƒŠÈ•†QÑ”lƒ~o„~À Ñyˆ` ÎyˆÏ\f Ð#)ƒ~È•†yÑ”‚Sbˆi`Ñ•{))\nƒË\n ƒ¯Öš„¯ÎuˆcˆÈuˆl„¶ÖÅÆ!ˆÎuˆ× ˆŠÀˆØÈ!,‚ÍÙ *‡" [nil comstart comcol " " soft insert-and-inherit 10 newline 1 fill-prefix indent-to-left-margin comment-multi-line comment-start-skip opoint -1 re-search-forward t 0 win comment-end comment-start comment-column "" indent-for-comment delete-char indent-according-to-mode] 4 (#$ . 57775) nil]) #@239 Set `selective-display' to ARG; clear it if no arg. When the value of `selective-display' is a number > 0, lines whose indentation is >= that value are not displayed. The variable `selective-display' has a separate value for each buffer. (defalias 'set-selective-display #[(arg) "Á=ƒ\nÂÃ!ˆŒe`}ˆÄ bˆÅÆ !)…#É!Ê!ˆ)ËÌ ÄÌ !\"ˆÍÎÁ\"ˆÏÁ\"ˆÍÐÁ\"‡" [selective-display t error "selective-display already in use for marked lines" window-start vertical-motion window-height current-vpos arg prefix-numeric-value recenter set-window-start selected-window princ "selective-display set to " prin1 "."] 4 (#$ . 58931) "P"]) #@63 The string displayed in the mode line when in overwrite mode. (defconst overwrite-mode-textual " Ovwrt" (#$ . 59558)) #@70 The string displayed in the mode line when in binary overwrite mode. (defconst overwrite-mode-binary " Bin Ovwrt" (#$ . 59682)) #@464 Toggle overwrite mode. With arg, turn overwrite mode on iff arg is positive. In overwrite mode, printing characters typed in replace existing text on a one-for-one basis, rather than pushing it to the right. At the end of a line, such characters extend the line. Before a tab, such characters insert until the tab is filled in. \[quoted-insert] still inserts characters in overwrite mode; this is supposed to make it easier to insert characters when necessary. (defalias 'overwrite-mode #[(arg) "„ ?‚Â!ÃV…ÄÅ ‡" [arg overwrite-mode prefix-numeric-value 0 overwrite-mode-textual force-mode-line-update] 2 (#$ . 59817) "P"]) #@654 Toggle binary overwrite mode. With arg, turn binary overwrite mode on iff arg is positive. In binary overwrite mode, printing characters typed in replace existing text. Newlines are not treated specially, so typing at the end of a line joins the line to the next, with the typed character between them. Typing before a tab character simply replaces the tab with the character typed. \[quoted-insert] replaces the text at the cursor, just as ordinary typing characters do. Note that binary overwrite mode is not its own minor mode; it is a specialization of overwrite-mode, entered by setting the `overwrite-mode' variable to `overwrite-mode-binary'. (defalias 'binary-overwrite-mode #[(arg) "„ Â=?‚Ã!ÄV…ÂÅ ‡" [arg overwrite-mode overwrite-mode-binary prefix-numeric-value 0 force-mode-line-update] 2 (#$ . 60457) "P"]) #@50 *Non-nil means display line number in mode line. (defvar line-number-mode t (#$ . -61294)) #@158 Toggle Line Number mode. With arg, turn Line Number mode on iff arg is positive. When Line Number mode is enabled, the line number appears in the mode line. (defalias 'line-number-mode #[(arg) "„ ?‚Â!ÃVÄ ‡" [arg line-number-mode prefix-numeric-value 0 force-mode-line-update] 2 (#$ . 61392) "P"]) #@52 *Non-nil means display column number in mode line. (defvar column-number-mode nil (#$ . -61702)) #@166 Toggle Column Number mode. With arg, turn Column Number mode on iff arg is positive. When Column Number mode is enabled, the column number appears in the mode line. (defalias 'column-number-mode #[(arg) "„ ?‚Â!ÃVÄ ‡" [arg column-number-mode prefix-numeric-value 0 force-mode-line-update] 2 (#$ . 61806) "P"]) #@71 *Non-nil means show matching open-paren when close-paren is inserted. (defvar blink-matching-paren t (#$ . -62128)) #@69 *If non-nil, is maximum distance to search for matching open-paren. (defconst blink-matching-paren-distance 12000 (#$ . -62250)) #@74 *The number of seconds that `blink-matching-open' will delay at a match. (defconst blink-matching-delay 1 (#$ . -62385)) #@67 *Non-nil means `blink-matching-paren' should not ignore comments. (defconst blink-matching-paren-dont-ignore-comments nil (#$ . -62512)) #@68 Move cursor momentarily to the beginning of the sexp before point. (defalias 'blink-matching-open #[nil "`eTV…õ…õÁ`ŠÂuˆÃÄ!ˆ`)ZÅ\"ÅU…õ`ÇÇ ŠŒ\nƒ9e`\nZ]}ˆÇË̈)ƒcfzÍU„cÎf!?†aSfÎf!U?  ƒkǃàbˆÏ ƒ€Ð!‚ôbˆÒÓŠÔÇxˆn)„›Õyˆ`T{‚ÜŠÅuˆÔÇwˆl)„²Çˆ`{‚ÜŠÖÇxˆo)„×ÖÇxˆÕyˆ`LjÔÇxˆ`{׉T{Q‚܉T{\"‚ô ƒëÒØ!‚ô\n?…ôÒÙ!,‡" [blink-matching-paren logand -1 skip-syntax-backward "/\\" 1 oldpos nil blinkpos mismatch blink-matching-paren-distance (byte-code "… ? Ä\")‡" [parse-sexp-ignore-comments blink-matching-paren-dont-ignore-comments scan-sexps oldpos -1 blinkpos] 3) ((error)) 36 matching-paren pos-visible-in-window-p sit-for blink-matching-delay message "Matches %s" " " 0 "\n " "..." "Mismatched parentheses" "Unmatched parenthesis"] 6 (#$ . 62655) nil]) (byte-code "ÀÀ‡" [blink-matching-open blink-paren-function] 1) #@153 Signal a quit condition. During execution of Lisp code, this character causes a quit directly. At top-level, as an editor command, this simply beeps. (defalias 'keyboard-quit #[nil "ƒ\nÁÃÄ!ˆÅÆÁ\"‡" [transient-mark-mode nil mark-active run-hooks deactivate-mark-hook signal quit] 3 (#$ . 63531) nil]) (define-key global-map "" (quote keyboard-quit)) #@211 Function to call to "quit" the current buffer, or nil if none. \[keyboard-escape-quit] calls this function when its more local actions (such as cancelling a prefix argument, minibuffer or region) do not apply. (defvar buffer-quit-function nil (#$ . 63893)) #@374 Exit the current "mode" (in a generalized sense of the word). This command can exit an interactive command such as `query-replace', can clear out a prefix argument or a region, can get out of the minibuffer or other recursive edit, cancel the use of the current buffer (for special-purpose buffers), or go back to just one window (by deleting all but the selected window). (defalias 'keyboard-escape-quit #[nil "Á=ƒ‡à ÄVƒÅ ‡ƒ‡ƒ/ƒ/…AÂÉÊ!‡ ƒ8 ‡ÌÍ!?…AÎ ‡" [last-command mode-exited nil minibuffer-depth 0 abort-recursive-edit current-prefix-arg transient-mark-mode mark-active run-hooks deactivate-mark-hook buffer-quit-function one-window-p t delete-other-windows] 2 (#$ . 64157) nil]) (define-key global-map "" (quote keyboard-escape-quit)) #@339 Set VARIABLE to VALUE. VALUE is a Lisp object. When using this interactively, supply a Lisp expression for VALUE. If you want VALUE to be a string, you must surround it with doublequotes. If VARIABLE has a `variable-interactive' property, that is used as if it were the arg to `interactive' (which see) to interactively read the value. (defalias 'set-variable #[(var val) " L‡" [var val] 2 (#$ . 64934) (let* ((var (read-variable "Set variable: ")) (minibuffer-help-form (quote (funcall myhelp))) (myhelp (function (lambda nil (with-output-to-temp-buffer "*Help*" (prin1 var) (princ "\nDocumentation:\n") (princ (substring (documentation-property var (quote variable-documentation)) 1)) (if (boundp var) (let ((print-length 20)) (princ "\n\nCurrent value: ") (prin1 (symbol-value var)))) (save-excursion (set-buffer standard-output) (help-mode)) nil))))) (list var (let ((prop (get var (quote variable-interactive)))) (if prop (call-interactively (list (quote lambda) (quote (arg)) (list (quote interactive) prop) (quote arg))) (eval-minibuffer (format "Set %s to value: " var))))))]) #@40 Local map for completion list buffers. (defvar completion-list-mode-map nil (#$ . 66028)) (byte-code "„.Á Ã\nÄÅ#ˆÃ\nÆÇ#ˆÃ\nÈÉ#ˆÃ\nÊË#ˆÃ\nÌÍ#ˆÃ\nÎÏ#ˆ\n)ÐÑÒÓ#‡" [completion-list-mode-map make-sparse-keymap map define-key [mouse-2] mouse-choose-completion [down-mouse-2] nil " " choose-completion "" delete-completion-window [left] previous-completion [right] next-completion put completion-list-mode mode-class special] 4) #@186 Record the buffer that was current when the completion list was requested. This is a local variable in the completion list buffer. Initial value is nil to avoid some compiler warnings. (defvar completion-reference-buffer nil (#$ . 66463)) #@320 Number of chars at beginning of minibuffer not involved in completion. This is a local variable in the completion list buffer but it talks about the buffer in `completion-reference-buffer'. If this is nil, it means to compare text to determine which part of the tail end of the buffer's text is involved in completion. (defvar completion-base-size nil (#$ . 66709)) #@90 Delete the completion list window. Go to the window from which completion was requested. (defalias 'delete-completion-window #[nil "Âà !ˆÄ !…ÅÄ !!)‡" [completion-reference-buffer buf delete-window selected-window get-buffer-window select-window] 3 (#$ . 67081) nil]) #@51 Move to the previous item in the completion list. (defalias 'previous-completion #[(n) "À [!‡" [next-completion n] 2 (#$ . 67358) "p"]) #@118 Move to the next item in the completion list. WIth prefix argument N, move N items (negative N means move backward). (defalias 'next-completion #[(n) "ÁVƒ-m„-Â`Ã\"d‰ƒÆ`ÃÇ\f$bˆÆ`ÃÇ\f$bˆ*S‰‚ÁW…do?…dÂ`SÃ\"e‰ƒLÈ`ÃÇ\f$bˆÈ`ÃÇ\f$bˆÈ`ÃÇ\f$bˆ*T‰‚.‡" [n 0 get-text-property mouse-face end prop next-single-property-change nil previous-single-property-change] 6 (#$ . 67501) "p"]) #@52 Choose the completion that point is in or next to. (defalias 'choose-completion #[nil "À‰‰ \nm„È`É\"ƒ``To„1È`SÉ\"ƒ1`S`„:ÊË!ˆÌÉ\"ÍÉ\"†Jd{Î ÐÑÒ\"ƒlÓÎ !ƒlÔÒ !ˆ‚vÓÎ !„vÕ ˆÖ!ˆ)× \f #-‡" [nil completion-reference-buffer completion-base-size base-size buffer completion end beg get-text-property mouse-face error "No completion here" previous-single-property-change next-single-property-change selected-window owindow one-window-p t selected-frame window-dedicated-p iconify-frame bury-buffer select-window choose-completion-string] 5 (#$ . 67897) nil]) (defalias 'choose-completion-delete-max-match #[(string) "`G`eZ^`GZbˆ ƒ— ÄVƒ<`` \\{ ƒ) — Ä O˜)„< SÆuˆ‚Ç !*‡" [string len opoint completion-ignore-case 0 tail 1 delete-char] 4]) (defalias 'choose-completion-string #[(choice &optional buffer base-size) "† ÂÃÄ!\"ƒ#Å ƒÆÅ !š„#ÇÈ!‚eqˆ ƒ5 e\\`|ˆ‚:Ê !ˆ cˆÌ` GZ`Í#ˆÎÏ\"Ñ`\"ˆ)ÆÒ !š…e…eÔ )‡" [buffer completion-reference-buffer string-match "\\` \\*Minibuf-[0-9]+\\*\\'" buffer-name active-minibuffer-window window-buffer error "Minibuffer is not active for completion" base-size choose-completion-delete-max-match choice remove-text-properties (mouse-face nil) get-buffer-window t window set-window-point minibuffer-window minibuffer-completion-table exit-minibuffer] 4]) #@264 Major mode for buffers showing lists of possible completions. Type \\[choose-completion] in the completion list to select the completion near point. Use \\[mouse-choose-completion] to select one with the mouse. (defalias 'completion-list-mode #[nil "À ˆÁ\n!ˆÃÅÇÈ!ˆÉÊË!‡" [kill-all-local-variables use-local-map completion-list-mode-map "Completion List" mode-name completion-list-mode major-mode make-local-variable completion-base-size nil run-hooks completion-list-mode-hook] 2 (#$ . 69256) nil]) #@340 A function to customize how completions are identified in completion lists. `completion-setup-function' calls this function with no arguments each time it has found what it thinks is one completion. Point is at the end of the completion in the completion list buffer. If this function moves point, it can alter the end of that completion. (defvar completion-fixup-function nil (#$ . 69819)) (defalias 'completion-setup-function #[nil "Šp qˆÂ ˆÃÄ!ˆebˆ ƒÆÇ!cˆÆÈ!cˆÉyˆÊËÌÍ#…KΔ`ƒ; ˆÒ`ÓÔ$ˆbˆ*‚#*‡" [mainbuf standard-output completion-list-mode make-local-variable completion-reference-buffer window-system substitute-command-keys "Click \\[mouse-choose-completion] on a completion to select it.\n" "In this buffer, type \\[choose-completion] to select the completion near point.\n\n" 1 re-search-forward "[^ \n]+\\( [^ \n]+\\)*" nil t 0 end beg completion-fixup-function put-text-property mouse-face highlight] 5]) (byte-code "ÀÁÂ\"ˆÃ\fÅÆ#ˆÃÈÆ#ˆÃ\fÉÆ#ˆÃÉÆ#‡" [add-hook completion-setup-hook completion-setup-function define-key minibuffer-local-completion-map [prior] switch-to-completions minibuffer-local-must-match-map [prior] "ö"] 4) #@36 Select the completion list window. (defalias 'switch-to-completions #[nil "ÀÁ!„  ˆÃÀÁ!!ˆebˆÄÅ!ˆÆy‡" [get-buffer-window "*Completions*" minibuffer-completion-help select-window search-forward "\n\n" 1] 3 (#$ . 70985) nil]) (defalias 'event-apply-alt-modifier #[(ignore-prompt) "ÀÁ ÃÄÅ$!‡" [vector event-apply-modifier read-event alt 22 "A-"] 6]) (defalias 'event-apply-super-modifier #[(ignore-prompt) "ÀÁ ÃÄÅ$!‡" [vector event-apply-modifier read-event super 23 "s-"] 6]) (defalias 'event-apply-hyper-modifier #[(ignore-prompt) "ÀÁ ÃÄÅ$!‡" [vector event-apply-modifier read-event hyper 24 "H-"] 6]) (defalias 'event-apply-shift-modifier #[(ignore-prompt) "ÀÁ ÃÄÅ$!‡" [vector event-apply-modifier read-event shift 25 "S-"] 6]) (defalias 'event-apply-control-modifier #[(ignore-prompt) "ÀÁ ÃÄÅ$!‡" [vector event-apply-modifier read-event control 26 "C-"] 6]) (defalias 'event-apply-meta-modifier #[(ignore-prompt) "ÀÁ ÃÄÅ$!‡" [vector event-apply-modifier read-event meta 27 "M-"] 6]) #@233 Apply a modifier flag to event EVENT. SYMBOL is the name of this modifier, as a symbol. LSHIFTBY is the numeric value of this modifier, in keyboard events. PREFIX is the string that represents this modifier in an event type symbol. (defalias 'event-apply-modifier #[(event symbol lshiftby prefix) "§ƒc Â=ƒ:—ÃXƒ—ÄYƒ—ÅZ‡—ÆXƒ1—ÇYƒ1—ÈZ‡ÉÊË\f\"\"‡ Í=ƒZ—ÃXƒQ—ÄYƒQ–‡ÉÊË\f\"\"‡ÉÊË\f\"\"‡ Î!>ƒm‡9ƒv‚x@ÐÒ!P!9ƒ‚”AB)‡" [event symbol control 122 97 96 90 65 64 logior lsh 1 lshiftby shift event-modifiers event-type intern prefix symbol-name] 4 (#$ . 71982)]) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÎÏÐ\"‡" [define-key function-key-map [24 64 104] event-apply-hyper-modifier [24 64 115] event-apply-super-modifier [24 64 109] event-apply-meta-modifier [24 64 97] event-apply-alt-modifier [24 64 83] event-apply-shift-modifier [24 64 99] event-apply-control-modifier mapcar #[(keypad-normal) "@A@Ã\nÄ #ˆÅÇ\n!Ç !#*‡" [keypad-normal normal keypad put ascii-character define-key function-key-map vector] 5] ((kp-0 48) (kp-1 49) (kp-2 50) (kp-3 51) (kp-4 52) (kp-5 53) (kp-6 54) (kp-7 55) (kp-8 56) (kp-9 57) (kp-space 32) (kp-tab 9) (kp-enter 13) (kp-multiply 42) (kp-add 43) (kp-separator 44) (kp-subtract 45) (kp-decimal 46) (kp-divide 47) (kp-equal 61))] 4) emacs-19.30/lisp/simula.elc100666 13437 1 70640 5744577363 14243 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:51:07 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/simula.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/simula.el' was compiled for Emacs 19")) (provide (quote simula-mode)) #@176 *Non-nil means TAB in SIMULA mode should always reindent the current line. Otherwise TAB indents only when point is within the run of whitespace at the beginning of the line. (defconst simula-tab-always-indent nil (#$ . -512)) #@69 *Indentation of SIMULA statements with respect to containing block. (defconst simula-indent-level 3 (#$ . -745)) #@62 *Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE. (defconst simula-substatement-offset 3 (#$ . -864)) #@240 *Extra indentation for lines not starting a statement or substatement. If value is a list, each line in a multipleline continued statement will have the car of the list extra indentation with respect to the previous line of the statement. (defconst simula-continued-statement-offset 3 (#$ . -984)) #@62 *Offset of SIMULA label lines relative to usual indentation. (defconst simula-label-offset -4711 (#$ . -1288)) #@209 *Extra indentation of THEN and ELSE with respect to the starting IF. Value is a cons cell, the car is extra THEN indentation and the cdr extra ELSE indentation. IF after ELSE is indented as the starting IF. (defconst simula-if-indent (quote (0 . 0)) (#$ . -1406)) #@168 *Extra indentation of WHEN and OTHERWISE with respect to the INSPECT. Value is a cons cell, the car is extra WHEN indentation and the cdr extra OTHERWISE indentation. (defconst simula-inspect-indent (quote (0 . 0)) (#$ . -1678)) #@74 *Non-nil means `simula-indent-line' function may reindent previous line. (defconst simula-electric-indent nil (#$ . -1913)) #@176 *Specify how to convert case for SIMULA keywords. Value is one of the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table' or nil if they should not be changed. (defconst simula-abbrev-keyword (quote upcase) (#$ . -2044)) #@203 *Specify how to convert case for standard SIMULA procedure and class names. Value is one of the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table', or nil if they should not be changed. (defconst simula-abbrev-stdproc (quote abbrev-table) (#$ . -2287)) #@228 *File with extra abbrev definitions for use in SIMULA mode. These are used together with the standard abbrev definitions for SIMULA. Please note that the standard definitions are required for SIMULA mode to function correctly. (defvar simula-abbrev-file nil (#$ . -2563)) #@38 Syntax table in SIMULA mode buffers. (defvar simula-mode-syntax-table nil (#$ . 2841)) (byte-code "„]Á !ÃÄÅ#ˆÃÆÇ#ˆÃÈÇ#ˆÃÉÊ#ˆÃËÌ#ˆÃÍÎ#ˆÃÏÐ#ˆÃÑÇ#ˆÃÒÇ#ˆÃÓÇ#ˆÃÔÕ#ˆÃÖÇ#ˆÃ×Ç#ˆÃØÇ#ˆÁ‡" [simula-mode-syntax-table copy-syntax-table standard-syntax-table modify-syntax-entry 33 "<" 36 "." 37 39 "\"" 40 "()" 41 ")(" 59 ">" 91 92 93 95 "w" 124 123 125] 4) #@29 Keymap used in SIMULA mode. (defvar simula-mode-map nil (#$ . 3209)) (byte-code "„1Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÁ‡" [simula-mode-map make-sparse-keymap define-key "" simula-backward-up-level "" simula-previous-statement "" simula-forward-down-level "" simula-next-statement "" backward-delete-char-untabify ":" simula-electric-label " " simula-indent-command] 4) #@37 Abbrev table in SIMULA mode buffers (defvar simula-mode-abbrev-table nil (#$ . 3605)) #@2232 Major mode for editing SIMULA code. \{simula-mode-map} Variables controlling indentation style: simula-tab-always-indent Non-nil means TAB in SIMULA mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. simula-indent-level Indentation of SIMULA statements with respect to containing block. simula-substatement-offset Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE. simula-continued-statement-offset 3 Extra indentation for lines not starting a statement or substatement, e.g. a nested FOR-loop. If value is a list, each line in a multiple- line continued statement will have the car of the list extra indentation with respect to the previous line of the statement. simula-label-offset -4711 Offset of SIMULA label lines relative to usual indentation. simula-if-indent '(0 . 0) Extra indentation of THEN and ELSE with respect to the starting IF. Value is a cons cell, the car is extra THEN indentation and the cdr extra ELSE indentation. IF after ELSE is indented as the starting IF. simula-inspect-indent '(0 . 0) Extra indentation of WHEN and OTHERWISE with respect to the corresponding INSPECT. Value is a cons cell, the car is extra WHEN indentation and the cdr extra OTHERWISE indentation. simula-electric-indent nil If this variable is non-nil, `simula-indent-line' will check the previous line to see if it has to be reindented. simula-abbrev-keyword 'upcase Determine how SIMULA keywords will be expanded. Value is one of the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table', or nil if they should not be changed. simula-abbrev-stdproc 'abbrev-table Determine how standard SIMULA procedure and class names will be expanded. Value is one of the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table', or nil if they should not be changed. Turning on SIMULA mode calls the value of the variable simula-mode-hook with no arguments, if that value is non-nil Warning: simula-mode-hook should not read in an abbrev file without calling the function simula-install-standard-abbrevs afterwards, preferably not at all. (defalias 'simula-mode #[nil "À ˆÁ\n!ˆÃÅÇÈ!ˆÉÇÊ!ˆË\nÌ !ˆÇÎ!ˆÏÇÐ!ˆÇÑ!ˆÒÇÓ!ˆÔÇÕ!ˆÖÇ×!ˆØÇÙ!ˆÚÇÛ!ˆÜÇÝ!ˆÔ„}ƒqà!ˆ‚váÞÜ\"ˆÜ\"ã ˆ)$åæ!ˆçè!‡" [kill-all-local-variables use-local-map simula-mode-map simula-mode major-mode "SIMULA" mode-name make-local-variable comment-column 40 end-comment-column 75 set-syntax-table simula-mode-syntax-table paragraph-start "[ ]*$\\|\\f" paragraph-separate indent-line-function simula-indent-line require-final-newline t comment-start "! " comment-end " ;" comment-start-skip "!+ *" parse-sexp-ignore-comments nil comment-multi-line simula-mode-abbrev-table simula-abbrev-file read-abbrev-file define-abbrev-table abbrevs-changed simula-install-standard-abbrevs local-abbrev-table abbrev-mode 1 run-hooks simula-mode-hook] 3 (#$ . 3699) nil]) #@109 Indent this line as SIMULA code. If `simula-electric-indent' is non-nil, indent previous line if necessary. (defalias 'simula-indent-line #[nil "d`ZÀ ÁÅŽÆˆÇ ˆ…=ÆyˆÉÊwˆËÌ!…=Í ?…=À Ï =?…<Ð ˆj),‡" [simula-calculate-indent t case-fold-search indent origin ((byte-code "dZbˆÁ \n=ƒà ˆ‚Ä ˆ\njˆÁ‡" [origin current-indentation indent back-to-indentation delete-horizontal-space] 2)) 0 expand-abbrev simula-electric-indent " \f" nil looking-at "\\(end\\|if\\|then\\|else\\|when\\|otherwise\\)\\>" simula-context post-indent current-indentation delete-horizontal-space] 3 (#$ . 6746)]) #@451 Indent current line as SIMULA code, or insert TAB character. If `simula-tab-always-indent' is non-nil, always indent current line. Otherwise, indent only if point is before any non-whitespace character on the line. A numeric argument, regardless of its value, means indent rigidly all the lines of the SIMULA statement after point so that this line becomes properly indented. The relative indentation among the lines of the statement are preserved. (defalias 'simula-indent-command #[(&optional whole-exp) "À\n„ „ŠÄÅxˆn)ƒ•ŠÆyˆÇ )È d`ZŠÄÅxˆn)ʼn \n \f ÏŽ =ƒOŠÄÅxˆn)ƒYÐ ˆ‚YÆyˆÑ ˆjˆ)`\f\n…ŠÒyˆ`\n\fbˆÓÒ!ˆ`‰ \nV… =?…Ô\n  ZÕ$).‚—Ö )‡" [t case-fold-search whole-exp simula-tab-always-indent " \f" nil 0 simula-calculate-indent current-indentation end beg bol origin current indent ((byte-code "„ d ZbˆÂ‡" [bol origin nil] 2)) back-to-indentation delete-horizontal-space 1 simula-next-statement indent-code-rigidly "%" insert-tab] 7 (#$ . 7350) "P"]) #@274 Returns value according to syntactic SIMULA context of point. 0 point inside COMMENT comment 1 point on SIMULA-compiler directive line 2 point inside END comment 3 point inside string 4 point inside character constant nil otherwise. (defalias 'simula-context #[nil "ŠÀyˆg)Á=ƒ ‡ŠÃ`ÆexˆÃ\fo„šÀyˆgÁ=„‰`Wƒ„ÉÃwˆÂuˆhÊ=ƒC`‚)hË=ƒbÌÃwˆgÊ=ƒ\\`Í‚)Âuˆ‚)gÎ=ƒkÂuˆÏÃwˆgÊ=ƒ~`Í‚)Âuˆ‚)ƒšÐÂ!ˆÆÃxˆ`Â*`\fWƒNÑÒ\fÓ#ƒNhÔ>ƒÚÕhÖ>ƒÏ „ÏÑ×\fÓ#ƒ±hÁ=ƒ±Âyˆ‚»ØÙ!ƒ›Ã‚›hÚ>ƒÀÛ\fwˆ ƒ›`\fWƒ›gÊ=ƒüÉ‚çnƒÂyˆ‚ ÂuˆÛ\fwˆ‚æhË=ƒ#ÜÝ\fÓ#„›Þ‚›hÎ=ƒH`\f=„3mƒ8ß‚›ÂuˆÜà\fÓ#„›ß‚›Âyˆ‚› +‡" [0 37 1 nil origin return-value "^;" saved-point loopvalue "^;\"'" 59 34 "^\";" t 39 "^';" backward-char re-search-forward "\\\\|!\\|\"\\|'\\|^%\\|\\" move (100 68) 2 (100 68) ";\\|\\\\|\\\\|\\\\|\\\\|^%" looking-at "[ \n\f]*\\(;\\|\\\\|\\\\|\\\\|\\\\)" (33 116 84) "^%;" search-forward "\"" 3 4 "'"] 5 (#$ . 8346)]) #@61 If this is a label that starts the line, reindent the line. (defalias 'simula-electric-label #[nil "À ˆÁcˆd`ZÂà C‰  ÊŽË>?…hÌ>„<Í=ƒ5„<gÏ>?…hÐ ?…hÑÒ!ˆÓÔxˆÕÔxˆÖ×!?…hÓÔxˆn…hØ Ú ˆj)-‡" [expand-abbrev 58 t read-event unread-command-events last-command-char com-char next-char case-fold-search origin ((byte-code "dZb‡" [origin] 2)) (61 45) (10 13) 9 simula-tab-always-indent (61 45) simula-context backward-char 1 " \f" nil "a-zA-Z0-9_" looking-at "virtual\\>" simula-calculate-indent amount delete-horizontal-space] 4 (#$ . 9416) nil]) #@97 Move backward up COUNT block levels. If COUNT is negative, move forward up block level instead. (defalias 'simula-backward-up-level #[(count) "`ÀÃÄÅ*‡" [t case-fold-search origin nil (byte-code "ÁVƒ'ÁV…OÂÃ!ˆÄ „gÅ>ƒ S‚\"T‰‚ÁW…OÆÃ!ˆÇÈ!ˆÄ „HgÉ>ƒET‚GSÇÊ!ˆ‚'‡" [count 0 re-search-backward "\\\\|\\" simula-context (98 66) re-search-forward backward-word 1 (101 69) -1] 3) ((error (byte-code "bˆÁÂ!‡" [origin error "No higher block level"] 2)) (quit (byte-code "bˆÁÂÃ\"‡" [origin signal quit nil] 3)))] 3 (#$ . 9983) "p"]) #@101 Move forward down COUNT block levels. If COUNT is negative, move backward down block level instead. (defalias 'simula-forward-down-level #[(count) "`ÁÅÆÇ+‡" [count t case-fold-search origin start-count nil (byte-code "ÁWƒ2ÁW…fÂÃ!ˆÄ „#gÅ>ƒ T‚\"SWƒÇÈÉ\"ˆ‚ÁV…fÊÃ!ˆËÌ!ˆÄ „SgÍ>ƒPS‚RTËÎ!ˆVƒ2ÇÈÉ\"ˆ‚2‡" [count 0 re-search-backward "\\\\|\\" simula-context (101 69) start-count signal error nil re-search-forward backward-word 1 (98 66) -1] 3) ((error (byte-code "bˆÁÂ!‡" [origin error "No containing block level"] 2)) (quit (byte-code "bˆÁÂÃ\"‡" [origin signal quit nil] 3)))] 3 (#$ . 10550) "p"]) #@77 Move backward COUNT statements. If COUNT is negative, move forward instead. (defalias 'simula-previous-statement #[(count) "ÁWƒ Â[!‡ÃÄ`ÃÈÉ+‡" [count 0 simula-next-statement nil t origin case-fold-search status (byte-code "À ˆhÁ>ƒÂÃ!ˆÄÅ!„$ÂÆ!ˆ‚$hÇ=ƒ$ÈÃ!ˆÉ\nS‰\n!ƒ:ËÌÍÎ#‰„$ƒOgÇ=ƒKÃuˆ‚OÂÆ!ˆÐ ‡" [simula-skip-comment-backward (110 78) backward-word 1 looking-at "\\" -1 59 backward-char natnump count simula-search-backward ";\\|\\" nil move status simula-skip-comment-forward] 4) ((error (byte-code "bˆÁÂ!‡" [origin error "Incomplete statement (too many ENDs)"] 2)) (quit (byte-code "bˆÁÂÃ\"‡" [origin signal quit nil] 3)))] 3 (#$ . 11200) "p"]) #@77 Move forward COUNT statements. If COUNT is negative, move backward instead. (defalias 'simula-next-statement #[(count) "ÁWƒ Â[!‡ÃÄ`ÃÈÉ+‡" [count 0 simula-previous-statement nil t origin case-fold-search status (byte-code "À ˆÁÂ!ƒ\fÃvˆÄ S‰!ƒ ÆÇdÈ#‰ „\f …2hÊU?…2ËÃ!ˆÌ ‡" [simula-skip-comment-forward looking-at "\\" 1 natnump count simula-search-forward ";\\|\\" move status 59 backward-word simula-skip-comment-backward] 4) ((error (byte-code "bˆÁÂ!‡" [origin error "Incomplete statement (too few ENDs)"] 2)) (quit (byte-code "bˆÁÂÃ\"‡" [origin signal quit nil] 3)))] 3 (#$ . 11894) "p"]) #@66 Search towards bob to find first char that is outside a comment. (defalias 'simula-skip-comment-backward #[nil "ÀÁ‡" [simula-out (byte-code "ÀÂÀxˆhÃ=ƒŠÄÅ!ˆÆ )‚Æ  Ç>ƒHhÈ=ƒ@gÉ>„@ŠÊÀxˆËÌ!)„@ÊÀxˆ‚ÍÎÀ\"ˆ‚ Ï=ƒ^ÐÑ!ƒÆ Ò>„N‚ Å=ƒsψoƒÍÎÀ\"ˆ‚ Ó=ƒÐÔ!ˆÅvˆÍÎÀ\"ˆ‚" [nil context " \n\f" 59 backward-char 1 simula-context (nil 3 4) 58 (45 61) ": \fa-zA-Z0-9_" looking-at "virtual\\>" throw simula-out 0 re-search-backward "!\\|\\" (0 1) 2 "\\"] 3)] 2 (#$ . 12521) nil]) #@66 Search towards eob to find first char that is outside a comment. (defalias 'simula-skip-comment-forward #[nil "ÀÁ‡" [simula-out (byte-code "ÀÁwˆÂÃ!ƒÄÅÁÆ#ˆ‚nƒ#gÇ=ƒ#Èyˆ‚ÂÉ!ƒ6ÂÊ!„6ËÁwˆ‚ÌÍÎ\"ˆ‚" [" \n\f" nil looking-at "!\\|\\" search-forward ";" move 37 1 "[a-z0-9_]*[ \f]*:[^-=]" "virtual\\>" "a-zA-Z0-9_ \f:" throw simula-out t] 4)] 2 (#$ . 13033) nil]) (defalias 'simula-forward-up-level #[nil "À`ÀÁ‰‰ƒ8ÇÈeÉ#ƒ1Ê hË>…#\nÌ>‰?…+Í ‰‚\fÁ‰„ ƒ@À‚D bˆÁ-‡" [t nil temp return-value case-fold-search origin continue-loop re-search-backward "\\\\|\\" move simula-context (100 68) (nil 2) simula-forward-up-level] 6]) (defalias 'simula-calculate-indent #[nil "ŠÀ `Á‰‰‰‰ ‰\nÁ=ƒ?ËÂxˆn„3À Á=ƒ3ÌÍ!ˆ‚!ËÂwˆi bˆ‚u\nÎ=ƒLÏÐ!‚u\nÑ=ƒYÏÒ!‚uÓ ‰ƒd ‚uÔÂwˆÕÖ!ƒx[Ø‚ÕÕÙ!ƒ¦gÚ>ƒŒ@‚ gÜ>ƒšA‚ ÝvˆÁÞ ˆ‚ÕÕß!ƒÅgà>ƒº!@‚¿!Aâ ˆ‚ÕÕã!„ÕÕä!ƒÕ%æ ˆ\fƒhç=„hè>ƒõŠéÝ!ˆÕê!)?‚ö؃ëÝ!ˆæ ˆŠÁyˆ`)Šo?…$hzì=ƒ éÝ!ˆÕí!?‚$hî>?)n„sÌïð#ƒðÀ „'g‰ç=ƒHëÝ!ˆ‚ÊÕê!ƒX\\‚ÊÕÖ!ƒhÝvˆëÝ!ˆ‚ÊÕñ!ƒ{2\\ó ˆ‚ÊÕô!ƒª õ>ƒÝvˆ‚¤2 ö>ƒ@‚ A\\\\Þ ˆ‚ÊÕ÷!ƒÊ2 ø>ƒÀ@‚ÃA\\\\â ˆƒâ9<ƒÝ9@‚ß9\\ŠÁyˆ`)‚'À ?…ŠÔÂwˆÕú!†Õû!?) ƒü \\æ ˆo?…5hzì=ƒ1ŠéÝ!ˆÕí!)?‚5hý>? ƒ@ƒKƒ^9<ƒ^9<ƒY9@‚[9\\ „mŠÁyˆ`)‚'Áyˆ‚'. ‡" [simula-context 0 nil prev-cont found-end temp start-line continued indent origin where " \n\f" re-search-backward "^\\|!\\|\\" 3 error "Inside string" 4 "Inside character constant" simula-inside-parens " \f" looking-at "end\\>" simula-indent-level t "if\\>\\|then\\>\\|else\\>" (84 116) simula-if-indent (69 101) 1 simula-find-if "when\\>\\|otherwise\\>" (87 119) simula-inspect-indent simula-find-inspect "virtual\\>" "[a-z0-9_]*[ \f]*:[^-=]" simula-label-offset simula-skip-comment-backward 59 (78 110) backward-word "begin\\>" simula-previous-statement 119 "begin\\|then\\|else\\|when\\|otherwise\\|do" (58 59) ";\\|\\<\\(begin\\|end\\|if\\|else\\|then\\|when\\|otherwise\\|do\\)\\>" move "do\\>" simula-substatement-offset simula-find-do-match "\\(if\\|then\\|else\\)\\>" (73 105) (84 116) "\\\\|\\" (87 119) simula-continued-statement-offset "virtual" "!\\|comment\\>\\|[a-z0-9_]*[ \f]*:[^-=]" current-indentation (58 59)] 9]) #@62 Find starting IF of a IF-THEN[-ELSE[-IF-THEN...]] statement. (defalias 'simula-find-if #[nil "ÀÁ‡" [simula-out (byte-code "ÀÁÂÃ#ƒ,gÄ>ƒ,ŠÅ ˆhzÆ=ƒ#ÇÈ!ˆÉÊ!„(ËÌÃ\"ˆ)‚ÉÍ!„9ÎÏ!ˆ‚ËÌÃ\"ˆ‚" [simula-search-backward "\\\\|;\\|\\" nil t (73 105) simula-skip-comment-backward 119 backward-word 1 looking-at "else\\>" throw simula-out "\\" error "Missing IF or misplaced BEGIN or ';' (can't find IF)"] 4)] 2 (#$ . 15369)]) #@42 Find INSPECT matching WHEN or OTHERWISE. (defalias 'simula-find-inspect #[nil "ÀÁ‡" [simula-out (byte-code "ÀÂÃÄÅ#ƒ0gÆU„0gÇ>ƒ T‚ ÀUƒ*ÈÉÅ\"ˆ‚ S‚ÊË!ˆ‚" [0 level simula-search-backward "\\\\|\\\\|;" nil t 59 (79 111) throw simula-out error "Missing INSPECT or misplaced ';' (can't find INSPECT)"] 4)] 2 (#$ . 15817)]) #@55 Find keyword matching DO: FOR, WHILE, INSPECT or WHEN (defalias 'simula-find-do-match #[nil "ÀÁÂÃ#ƒ Ä „ÅÆ!…Ä ??…ÇÈ!‡" [re-search-backward "\\<\\(do\\|for\\|while\\|inspect\\|when\\|end\\|begin\\)\\>\\|;" nil move simula-context looking-at "\\<\\(for\\|while\\|inspect\\|when\\)\\>" error "No matching FOR, WHILE or INSPECT for DO, or misplaced ';'"] 4 (#$ . 16179)]) #@73 Return position after `(' on line if inside parentheses, nil otherwise. (defalias 'simula-inside-parens #[nil "ŠÀÂÃ*‡" [0 parlevel simula-out (byte-code "ÀÁÂÃ#ƒQÄ Â=ƒgÅ=ƒ+ÇUƒ$ÈÉÂ\"ˆ‚ÊË!ˆ‚gÌ=ƒIÇUƒAÈÉiT\"ˆ‚S‚T‚ÈÉÂ\"ˆ‚" [re-search-backward "(\\|)\\|;" nil t simula-context 59 parlevel 0 throw simula-out error "Parenthesis mismatch or misplaced ';'" 40] 4)] 2 (#$ . 16559)]) #@59 Goto point of definition of variable, procedure or class. (defalias 'simula-goto-definition #[nil "À‡" [nil] 1 (#$ . 16970) nil]) (defalias 'simula-expand-stdproc #[nil "ƒ Á ƒ\f ‡Ã=ƒÄÅ!‡Æ=ƒ ÇÅ!‡È=…)ÉÅ!‡" [simula-abbrev-stdproc simula-context unexpand-abbrev upcase upcase-word -1 downcase downcase-word capitalize capitalize-word] 2]) (defalias 'simula-expand-keyword #[nil "ƒ Á ƒ\f ‡Ã=ƒÄÅ!‡Æ=ƒ ÇÅ!‡È=…)ÉÅ!‡" [simula-abbrev-keyword simula-context unexpand-abbrev upcase upcase-word -1 downcase downcase-word capitalize capitalize-word] 2]) #@58 Expand SIMULA keyword. If it starts the line, reindent. (defalias 'simula-electric-keyword #[nil "Á=‰ƒÃ\fÅ\"ˆÆÇ!ˆÈÅ!ˆÉ Ê ‰\f…8\fÍ=…8hzÎ=…8ŠÏÅ!ˆÐÑ!)?*ƒAÒ ‚ƒ„LÒ ˆ‚sÔ=ƒZÕÖ!ˆ‚s×=ƒhØÖ!ˆ‚sÙ=ƒsÚÖ!ˆd`ZÊÛ ÜÞß+)‡" [this-command self-insert-command show-char insert-char last-command-char 1 sit-for 0 backward-char simula-context t case-fold-search where 2 119 backward-word looking-at "end\\>" unexpand-abbrev simula-abbrev-keyword upcase upcase-word -1 downcase downcase-word capitalize capitalize-word nil null pos (byte-code "hzÀ=ƒLÁÂ!ˆÃÄ!ƒ.ŠÅÂ!ˆÆ ƒ\"ÇÂ!ˆ‚-ÈÉ``Ê \\{P!ˆ)ËÌxˆnƒLÍ ‰Ï =„HÐ ˆjˆ)‚PËÌwˆdZbˆ…^ÓÂ!‡" [119 backward-word 1 looking-at "end\\>" simula-backward-up-level pos-visible-in-window-p sit-for message "Matches " window-width " \f" nil simula-calculate-indent indent current-indentation delete-horizontal-space pos show-char delete-char] 6) ((quit (byte-code "dZb‡" [pos] 2)))] 4 (#$ . 17538)]) (defalias 'simula-search-backward #[(string &optional limit move) "ÁPÂÄÅ)‡" [string "\\|\\" nil level simula-out (byte-code "À \n #…BÄ „ÅÆ!ƒ:ÇÉ!ƒÀÊ!ˆÄ „gË>ƒ2S‚5T‚ÌÍÎ\"ˆ‚‡" [re-search-backward string limit move simula-context looking-at "\\" 0 level natnump "\\\\|\\" (98 66) throw simula-out t] 4)] 2]) (defalias 'simula-search-forward #[(string &optional limit move) "ÁPÂÄÅ)‡" [string "\\|\\" nil level exit (byte-code "À \n #…`Ä”bˆÅ ƒÄ•Sbˆ‚ÆÇ!ƒSÄ•SbˆÄÉ!ƒÀÊ!ˆËÌ!ˆÅ „LgÍ>ƒGS‚JTËÎ!ˆ‚'Ä•SbˆÏÐÑ\"ˆ‚‡" [re-search-forward string limit move 0 simula-context looking-at "\\" level natnump "\\\\|\\" backward-word 1 (101 69) -1 throw exit t] 4)] 2]) #@71 Define Simula keywords, procedures and classes in local abbrev table. (defalias 'simula-install-standard-abbrevs #[nil "ÀÁÂ\"‡" [mapcar #[(args) "ÀÁ\n #‡" [apply define-abbrev simula-mode-abbrev-table args] 4] (("abs" "Abs" simula-expand-stdproc) ("accum" "Accum" simula-expand-stdproc) ("activate" "ACTIVATE" simula-expand-keyword) ("addepsilon" "AddEpsilon" simula-expand-stdproc) ("after" "AFTER" simula-expand-keyword) ("and" "AND" simula-expand-keyword) ("arccos" "ArcCos" simula-expand-stdproc) ("arcsin" "ArcSin" simula-expand-stdproc) ("arctan" "ArcTan" simula-expand-stdproc) ("arctan2" "ArcTan2" simula-expand-stdproc) ("array" "ARRAY" simula-expand-keyword) ("at" "AT" simula-expand-keyword) ("before" "BEFORE" simula-expand-keyword) ("begin" "BEGIN" simula-expand-keyword) ("blanks" "Blanks" simula-expand-stdproc) ("boolean" "BOOLEAN" simula-expand-keyword) ("breakoutimage" "BreakOutImage" simula-expand-stdproc) ("bytefile" "ByteFile" simula-expand-stdproc) ("call" "Call" simula-expand-stdproc) ("cancel" "Cancel" simula-expand-stdproc) ("cardinal" "Cardinal" simula-expand-stdproc) ("char" "Char" simula-expand-stdproc) ("character" "CHARACTER" simula-expand-keyword) ("checkpoint" "CheckPoint" simula-expand-stdproc) ("class" "CLASS" simula-expand-keyword) ("clear" "Clear" simula-expand-stdproc) ("clocktime" "ClockTime" simula-expand-stdproc) ("close" "Close" simula-expand-stdproc) ("comment" "COMMENT" simula-expand-keyword) ("constant" "Constant" simula-expand-stdproc) ("copy" "Copy" simula-expand-stdproc) ("cos" "Cos" simula-expand-stdproc) ("cosh" "CosH" simula-expand-stdproc) ("cotan" "CoTan" simula-expand-stdproc) ("cputime" "CpuTime" simula-expand-stdproc) ("current" "Current" simula-expand-stdproc) ("datetime" "DateTime" simula-expand-stdproc) ("decimalmark" "DecimalMark" simula-expand-stdproc) ("delay" "DELAY" simula-expand-keyword) ("deleteimage" "DeleteImage" simula-expand-stdproc) ("detach" "Detach" simula-expand-stdproc) ("digit" "Digit" simula-expand-stdproc) ("directbytefile" "DirectByteFile" simula-expand-stdproc) ("directfile" "DirectFile" simula-expand-stdproc) ("discrete" "Discrete" simula-expand-stdproc) ("do" "DO" simula-expand-keyword) ("downcase" "Downcase" simula-expand-stdproc) ("draw" "Draw" simula-expand-stdproc) ("eject" "Eject" simula-expand-stdproc) ("else" "ELSE" simula-electric-keyword) ("empty" "Empty" simula-expand-stdproc) ("end" "END" simula-electric-keyword) ("endfile" "Endfile" simula-expand-stdproc) ("entier" "Entier" simula-expand-stdproc) ("eq" "EQ" simula-expand-keyword) ("eqv" "EQV" simula-expand-keyword) ("erlang" "Erlang" simula-expand-stdproc) ("error" "Error" simula-expand-stdproc) ("evtime" "EvTime" simula-expand-stdproc) ("exp" "Exp" simula-expand-stdproc) ("external" "EXTERNAL" simula-expand-keyword) ("false" "FALSE" simula-expand-keyword) ("field" "Field" simula-expand-stdproc) ("file" "File" simula-expand-stdproc) ("first" "First" simula-expand-stdproc) ("follow" "Follow" simula-expand-stdproc) ("for" "FOR" simula-expand-keyword) ("ge" "GE" simula-expand-keyword) ("getchar" "GetChar" simula-expand-stdproc) ("getfrac" "GetFrac" simula-expand-stdproc) ("getint" "GetInt" simula-expand-stdproc) ("getreal" "GetReal" simula-expand-stdproc) ("go" "GO" simula-expand-keyword) ("goto" "GOTO" simula-expand-keyword) ("gt" "GT" simula-expand-keyword) ("head" "Head" simula-expand-stdproc) ("hidden" "HIDDEN" simula-expand-keyword) ("histd" "HistD" simula-expand-stdproc) ("histo" "Histo" simula-expand-stdproc) ("hold" "Hold" simula-expand-stdproc) ("idle" "Idle" simula-expand-stdproc) ("if" "IF" simula-expand-keyword) ("image" "Image" simula-expand-stdproc) ("imagefile" "ImageFile" simula-expand-stdproc) ("imp" "IMP" simula-expand-keyword) ("in" "IN" simula-expand-keyword) ("inbyte" "InByte" simula-expand-stdproc) ("inbytefile" "InByteFile" simula-expand-stdproc) ("inchar" "InChar" simula-expand-stdproc) ("infile" "InFile" simula-expand-stdproc) ("infrac" "InFrac" simula-expand-stdproc) ("inimage" "InImage" simula-expand-stdproc) ("inint" "InInt" simula-expand-stdproc) ("inner" "INNER" simula-expand-keyword) ("inreal" "InReal" simula-expand-stdproc) ("inrecord" "InRecord" simula-expand-stdproc) ("inspect" "INSPECT" simula-expand-keyword) ("integer" "INTEGER" simula-expand-keyword) ("intext" "InText" simula-expand-stdproc) ("into" "Into" simula-expand-stdproc) ("is" "IS" simula-expand-keyword) ("isochar" "ISOChar" simula-expand-stdproc) ("isopen" "IsOpen" simula-expand-stdproc) ("isorank" "ISORank" simula-expand-stdproc) ("label" "LABEL" simula-expand-keyword) ("last" "Last" simula-expand-stdproc) ("lastitem" "LastItem" simula-expand-stdproc) ("lastloc" "LastLoc" simula-expand-stdproc) ("le" "LE" simula-expand-keyword) ("length" "Length" simula-expand-stdproc) ("letter" "Letter" simula-expand-stdproc) ("line" "Line" simula-expand-stdproc) ("linear" "Linear" simula-expand-stdproc) ("linesperpage" "LinesPerPage" simula-expand-stdproc) ("link" "Link" simula-expand-stdproc) ("linkage" "Linkage" simula-expand-stdproc) ("ln" "Ln" simula-expand-stdproc) ("locate" "Locate" simula-expand-stdproc) ("location" "Location" simula-expand-stdproc) ("lock" "Lock" simula-expand-stdproc) ("locked" "Locked" simula-expand-stdproc) ("log10" "Log10" simula-expand-stdproc) ("long" "LONG" simula-expand-keyword) ("lowcase" "LowCase" simula-expand-stdproc) ("lowerbound" "LowerBound" simula-expand-stdproc) ("lowten" "LowTen" simula-expand-stdproc) ("lt" "LT" simula-expand-keyword) ("main" "Main" simula-expand-stdproc) ("max" "Max" simula-expand-stdproc) ("maxint" "MaxInt" simula-expand-stdproc) ("maxlongreal" "MaxLongReal" simula-expand-stdproc) ("maxloc" "MaxLoc" simula-expand-stdproc) ("maxrank" "MaxRank" simula-expand-stdproc) ("maxreal" "MaxReal" simula-expand-stdproc) ("min" "Min" simula-expand-stdproc) ("minint" "MinInt" simula-expand-stdproc) ("minlongreal" "MinLongReal" simula-expand-stdproc) ("minrank" "MinRank" simula-expand-stdproc) ("minreal" "MinReal" simula-expand-stdproc) ("mod" "Mod" simula-expand-stdproc) ("more" "More" simula-expand-stdproc) ("name" "NAME" simula-expand-keyword) ("ne" "NE" simula-expand-keyword) ("negexp" "NegExp" simula-expand-stdproc) ("new" "NEW" simula-expand-keyword) ("nextev" "NextEv" simula-expand-stdproc) ("none" "NONE" simula-expand-keyword) ("normal" "Normal" simula-expand-stdproc) ("not" "NOT" simula-expand-keyword) ("notext" "NOTEXT" simula-expand-keyword) ("open" "Open" simula-expand-stdproc) ("or" "OR" simula-expand-keyword) ("otherwise" "OTHERWISE" simula-electric-keyword) ("out" "Out" simula-expand-stdproc) ("outbyte" "OutByte" simula-expand-stdproc) ("outbytefile" "OutByteFile" simula-expand-stdproc) ("outchar" "OutChar" simula-expand-stdproc) ("outfile" "OutFile" simula-expand-stdproc) ("outfix" "OutFix" simula-expand-stdproc) ("outfrac" "OutFrac" simula-expand-stdproc) ("outimage" "OutImage" simula-expand-stdproc) ("outint" "OutInt" simula-expand-stdproc) ("outreal" "OutReal" simula-expand-stdproc) ("outrecord" "OutRecord" simula-expand-stdproc) ("outtext" "OutText" simula-expand-stdproc) ("page" "Page" simula-expand-stdproc) ("passivate" "Passivate" simula-expand-stdproc) ("poisson" "Poisson" simula-expand-stdproc) ("pos" "Pos" simula-expand-stdproc) ("precede" "Precede" simula-expand-stdproc) ("pred" "Pred" simula-expand-stdproc) ("prev" "Prev" simula-expand-stdproc) ("printfile" "PrintFile" simula-expand-stdproc) ("prior" "PRIOR" simula-expand-keyword) ("procedure" "PROCEDURE" simula-expand-keyword) ("process" "Process" simula-expand-stdproc) ("protected" "PROTECTED" simula-expand-keyword) ("putchar" "PutChar" simula-expand-stdproc) ("putfix" "PutFix" simula-expand-stdproc) ("putfrac" "PutFrac" simula-expand-stdproc) ("putint" "PutInt" simula-expand-stdproc) ("putreal" "PutReal" simula-expand-stdproc) ("qua" "QUA" simula-expand-keyword) ("randint" "RandInt" simula-expand-stdproc) ("rank" "Rank" simula-expand-stdproc) ("reactivate" "REACTIVATE" simula-expand-keyword) ("real" "REAL" simula-expand-keyword) ("ref" "REF" simula-expand-keyword) ("resume" "Resume" simula-expand-stdproc) ("setaccess" "SetAccess" simula-expand-stdproc) ("setpos" "SetPos" simula-expand-stdproc) ("short" "SHORT" simula-expand-keyword) ("sign" "Sign" simula-expand-stdproc) ("simset" "SimSet" simula-expand-stdproc) ("simulaid" "SimulaId" simula-expand-stdproc) ("simulation" "Simulation" simula-expand-stdproc) ("sin" "Sin" simula-expand-stdproc) ("sinh" "SinH" simula-expand-stdproc) ("sourceline" "SourceLine" simula-expand-stdproc) ("spacing" "Spacing" simula-expand-stdproc) ("sqrt" "Sqrt" simula-expand-stdproc) ("start" "Start" simula-expand-stdproc) ("step" "STEP" simula-expand-keyword) ("strip" "Strip" simula-expand-stdproc) ("sub" "Sub" simula-expand-stdproc) ("subepsilon" "SubEpsilon" simula-expand-stdproc) ("suc" "Suc" simula-expand-stdproc) ("switch" "SWITCH" simula-expand-keyword) ("sysin" "SysIn" simula-expand-stdproc) ("sysout" "SysOut" simula-expand-stdproc) ("tan" "Tan" simula-expand-stdproc) ("tanh" "TanH" simula-expand-stdproc) ("terminate_program" "Terminate_Program" simula-expand-stdproc) ("terminated" "Terminated" simula-expand-stdproc) ("text" "TEXT" simula-expand-keyword) ("then" "THEN" simula-electric-keyword) ("this" "THIS" simula-expand-keyword) ("time" "Time" simula-expand-stdproc) ("to" "TO" simula-expand-keyword) ("true" "TRUE" simula-expand-keyword) ("uniform" "Uniform" simula-expand-stdproc) ("unlock" "Unlock" simula-expand-stdproc) ("until" "UNTIL" simula-expand-keyword) ("upcase" "Upcase" simula-expand-stdproc) ("upperbound" "UpperBound" simula-expand-stdproc) ("value" "VALUE" simula-expand-keyword) ("virtual" "VIRTUAL" simula-expand-keyword) ("wait" "Wait" simula-expand-stdproc) ("when" "WHEN" simula-electric-keyword) ("while" "WHILE" simula-expand-keyword))] 3 (#$ . 19259) nil]) emacs-19.30/lisp/skeleton.elc100666 12120 1 31120 6046536004 14406 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 20:03:54 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/skeleton.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`skeleton.el' was compiled for Emacs 19.29 or later")) #@233 *If non-nil, function applied to literal strings before they are inserted. It should take strings and characters and return them transformed, or nil which means no transformation. Typical examples might be `upcase' or `capitalize'. (defvar skeleton-transformation nil (#$ . -482)) (put (quote skeleton-transformation) (quote variable-interactive) "aTransformation function: ") #@191 Hook called at end of skeleton but before going to point of interest. By default this moves out anything following to next line. The variables `v1' and `v2' are still set when calling this. (defvar skeleton-end-hook #[nil "l†À ‡" [newline-and-indent] 1] (#$ . 866)) #@71 Function for transforming a skeleton-proxy's aliases' variable value. (defvar skeleton-filter (quote identity) (#$ . 1140)) #@70 When non-`nil' untabifies when deleting backwards with element -ARG. (defvar skeleton-untabify t (#$ . 1270)) #@109 When non-`nil', indent rigidly under current line for element `\n'. Else use mode's `indent-line-function'. (defvar skeleton-newline-indent-rigidly nil (#$ . 1387)) #@240 A buffer-local varlist (see `let') of mode specific skeleton elements. These variables are bound while interpreting a skeleton. Their value may in turn be any valid skeleton element if they are themselves to be used as skeleton elements. (defvar skeleton-further-elements nil (#$ . 1559)) (make-variable-buffer-local (quote skeleton-further-elements)) #@59 *Replacement for %s in prompts of recursive subskeletons. (defvar skeleton-subprompt (substitute-command-keys "RET, \\\\[abort-recursive-edit] or \\[help-command]") (#$ . -1918)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp skeleton-abbrev-cleanup nil current-load-list] 2) #@66 *If non-nil `define-skeleton' will override previous definition. (defvar skeleton-debug nil (#$ . -2211)) (byte-code "À B Bà BÄ BÀ‡" [skeleton current-load-list skeleton-modified skeleton-point skeleton-regions] 2) #@277 Define a user-configurable COMMAND that enters a statement skeleton. DOCUMENTATION is that of the command, while the variable of the same name, which contains the skeleton, has a documentation to that effect. INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'. (defalias 'define-skeleton '(macro . #[(command documentation &rest skeleton) "ƒ \nLˆÃÄ Å\nDFÇÅ DÈBBE‡" [skeleton-debug command skeleton progn defvar quote documentation defalias ((quote skeleton-proxy))] 5 (#$ . 2438)])) #@425 Insert skeleton defined by variable of same name (see `skeleton-insert'). Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). This command can also be an abbrev expansion (3rd and 4th columns in \[edit-abbrevs] buffer: "" command-name). When called as a function, optional first argument STR may also be a string which will be the value of `str' whereas the skeleton's interactor is then ignored. (defalias 'skeleton-proxy #[(&optional str arg) "ÀÁ!A@‰Ã=ƒÀÄ!A@‚!\nÅ=ƒ!ÀÆ!A@\nJ!‰„=É>…}ÊÁ \"‰ ‚}Ì\nÍ=†JÎ=‰?…d„[…dÒ†c!;…l#ˆ…}ÔÏ`‰)‡" [backtrace-frame 1 function nth 5 byte-code 2 skeleton-filter this-command (self-insert-command skeleton-pair-insert-maybe expand-abbrev) primitive-undo buffer-undo-list skeleton-insert self-insert-command skeleton-pair-insert-maybe skeleton-abbrev-cleanup arg current-prefix-arg prefix-numeric-value str t deferred-action-list deferred-action-function] 5 (#$ . 2948) "*P\nP"]) #@68 Value for `post-command-hook' to remove char that expanded abbrev. (defalias 'skeleton-abbrev-cleanup #[(&rest list) "¨…`|ˆÁÁÁ‰‡" [skeleton-abbrev-cleanup nil deferred-action-list deferred-action-function] 2 (#$ . 3938)]) #@2778 Insert the complex statement skeleton SKELETON describes very concisely. With optional third REGIONS wrap first interesting point (`_') in skeleton around next REGIONS words, if REGIONS is positive. If REGIONS is negative, wrap REGIONS preceding interregions into first REGIONS interesting positions (successive `_'s) in skeleton. An interregion is the stretch of text between two contiguous marked points. If you marked A B C [] (where [] is the cursor) in alphabetical order, the 3 interregions are simply the last 3 regions. But if you marked B A [] C, the interregions are B-A, A-[], []-C. Optional fourth STR is the value for the variable `str' within the skeleton. When this is non-`nil' the interactor gets ignored, and this should be a valid skeleton element. SKELETON is made up as (INTERACTOR ELEMENT ...). INTERACTOR may be nil if not needed, a prompt-string or an expression for complex read functions. If ELEMENT is a string or a character it gets inserted (see also `skeleton-transformation'). Other possibilities are: \n go to next line and indent according to mode _ interesting point, interregion here, point after termination > indent line (or interregion if > _) according to major mode & do next ELEMENT if previous moved point | do next ELEMENT if previous didn't move point -num delete num preceding characters (see `skeleton-untabify') resume: skipped, continue here if quit is signaled nil skipped Further elements can be defined via `skeleton-further-elements'. ELEMENT may itself be a SKELETON with an INTERACTOR. The user is prompted repeatedly for different inputs. The SKELETON is processed as often as the user enters a non-empty string. \[keyboard-quit] terminates skeleton insertion, but continues after `resume:' and positions at `_' if any. If INTERACTOR in such a subskeleton is a prompt-string which contains a ".. %s .." it is formatted with `skeleton-subprompt'. Such an INTERACTOR may also a list of strings with the subskeleton being repeated once for each string. Quoted lisp-expressions are evaluated evaluated for their side-effect. Other lisp-expressions are evaluated and the value treated as above. Note that expressions may not return `t' since this impplies an endless loop. Modes can define other symbols by locally setting them to any valid skeleton element. The following local variables are available: str first time: read a string according to INTERACTOR then: insert previously read string once more help help-form during interaction with the user or `nil' input initial input (string or cons with index) while reading str v1, v2 local variables for memorising anything you want When done with skeleton, but before going back to `_'-point call `skeleton-end-hook' if that is non-`nil'. (defalias 'skeleton-insert #[(skeleton &optional skeleton-regions str) "ƒSÁVƒ ŠvˆÂ )D‚E[à \fB C‰ƒ@ÁVƒ@@ BSA‰„(Ç È\"*‰ƒS@bƒSA`ɉ‰‰‰‰‰\n \f ÒŽÓÔÖBB!. ‡" [skeleton-regions 0 point-marker mark-marker mark-ring l2 l1 sort < nil v2 v1 input help resume: skeleton-point skeleton-modified beg ((byte-code "ÀÁ!ˆÂÃ!ˆÄ !„ bˆÆÃ!ˆƒbˆÀ‡" [run-hooks skeleton-end-hook sit-for 0 pos-visible-in-window-p beg recenter skeleton-point] 2)) eval let skeleton-further-elements ((skeleton-internal-list skeleton str))] 9 (#$ . 4175)]) #@509 Function for reading a string from the minibuffer within skeletons. PROMPT may contain a `%s' which will be replaced by `skeleton-subprompt'. If non-`nil' second arg INITIAL-INPUT or variable `input' is a string or cons with index to insert before reading. If third arg RECURSIVE is non-`nil' i.e. we are handling the iterator of a subskeleton, returns empty string if user didn't modify input. While reading, the value of `minibuffer-help-form' is variable `help' if that is non-`nil' or a default string. (defalias 'skeleton-read #[(str &optional initial-input recursive) "ÀÁ!ƒ ÁJ†\nƒÂÄl „ ÇÈ!ˆÉŽ\n;ƒ=ËÌ\n \"†6ÏJ‰\"‚AÐ\n!\n+\nƒj\nƒe\nј„e\nš„e\n¢šƒjÒÓÔ\"‡\n‡" [boundp help recursive "As long as you provide input you will insert another subskeleton.\n\nIf you enter the empty string, the loop inserting subskeletons is\nleft, and the current one is removed as far as it has been entered.\n\nIf you quit, the current subskeleton is removed as far as it has been\nentered. No more of the skeleton will be inserted, except maybe for a\nsyntactically necessary termination." "You are inserting a skeleton. Standard text gets inserted into the buffer\nautomatically, and you are prompted to fill in the variable parts." eolp minibuffer-help-form open-line 1 ((byte-code "„ÁÂ!ˆÁ‡" [eolp delete-char 1] 2)) str read-string format skeleton-subprompt initial-input input eval "" signal quit t] 4 (#$ . 7526)]) (defalias 'skeleton-internal-list #[(skeleton &optional str recursive) "ŠÀyˆ`)i ŠÃˆ`){Ä(ÇÆÈÉ\n@Dà FE `=\f`\nA‰\nƒ@ÍÎψ‚(, Í=ƒMÐÍË\"‡ ‡" [0 start column nil line opoint str setq skeleton-read quote skeleton recursive skeleton-modified quit (byte-code "À @!‡" [skeleton-internal-1 skeleton] 2) ((quit (byte-code "AÁ=ƒÀ >‚1Ĉ `|ˆcˆÇ!ˆAƒ,ÄÄ‚1ÉÀÁ\"ˆÄ‡" [quit recursive resume: skeleton nil start line move-to-column column signal] 3))) signal] 6]) (defalias 'skeleton-internal-1 #[(element &optional literal) "À !ƒ4 ¨ƒ ÂWƒ ƒÄ [!‡Å [!‡Æƒ1„1 !‚2 !‡ É=ƒi\nƒW A@Ì=ƒWl„OÍ ˆÎ`\n@Ï#‡ƒcÑ Í ˆj‡Í ˆÒ ‡ Ó=ƒˆ\nƒ… A@Ì=ƒ…Î`\n@Ï#‡Ò ‡ Ì=ƒº\nƒ°\n@bˆ\nA\niÑ X…¹ A@É=…¹Â‡†¹`‰‡ Õ=ƒÌ…. A‰ ‡ ×=ƒÞ†. A‰ ‡ ¢Ø=ƒëÙ A@!‡ ¢;„÷ ¢:ƒ# @¢9ƒ Ú ÏÛ#…\"‚þ @‰…\"Ú @\"ˆA‰„χ ?†.ÜÙ !Û\"‡" [char-or-string-p element 0 skeleton-untabify backward-delete-char-untabify delete-backward-char insert-before-markers skeleton-transformation literal n skeleton-regions skeleton _ newline indent-region nil skeleton-newline-indent-rigidly current-indentation indent-according-to-mode > skeleton-point & skeleton-modified | quote eval skeleton-internal-list t skeleton-internal-1] 5]) #@71 Insert a local variables section. Use current comment syntax if any. (defvar local-variables-section (quote (nil (quote (save-excursion (if (re-search-forward page-delimiter nil t) (error "Not on last page.")))) comment-start "Local Variables:" comment-end n comment-start "mode: " (completing-read "Mode: " obarray (lambda (symbol) (if (commandp symbol) (string-match "-mode$" (symbol-name symbol)))) t) & -5 | (quote (kill-line 0)) & -1 | comment-end n ((completing-read (format "Variable, %s: " skeleton-subprompt) obarray (lambda (symbol) (or (eq symbol (quote eval)) (user-variable-p symbol))) t) comment-start str ": " (read-from-minibuffer "Expression: " nil read-expression-map nil (quote read-expression-history)) | _ comment-end n) resume: comment-start "End:" comment-end)) (#$ . 10225)) (defalias (quote local-variables-section) (quote skeleton-proxy)) #@184 *If this is nil pairing is turned off, no matter what else is set. Otherwise modes with `skeleton-pair-insert-maybe' on some keys will attempt to insert pairs of matching characters. (defvar skeleton-pair nil (#$ . -11098)) #@73 *If this is nil, paired insertion is inhibited before or inside a word. (defvar skeleton-pair-on-word nil (#$ . -11328)) #@149 Attempt paired insertion if this function returns nil, before inserting. This allows for context-sensitive checking whether pairing is appropriate. (defvar skeleton-pair-filter #[nil "À‡" [nil] 1] (#$ . 11456)) #@284 An override alist of pairing partners matched against `last-command-char'. Each alist element, which looks like (ELEMENT ...), is passed to `skeleton-insert' with no interactor. Variable `str' does nothing. Elements might be (?` ?` _ "''"), (?\( ? _ " )") or (?{ \n > _ \n ?} >). (defvar skeleton-pair-alist nil (#$ . 11674)) #@430 Insert the character you type ARG times. With no ARG, if `skeleton-pair' is non-nil, and if `skeleton-pair-on-word' is non-nil or we are not before or inside a word, and if `skeleton-pair-filter' returns nil, pairing is performed. If a match is found in `skeleton-pair-alist', that is inserted, else the defaults are used. These are (), [], {}, <> and `' for the symmetrical ones, and the same character twice for the others. (defalias 'skeleton-pair-insert-maybe #[(arg) "„ „\nƒ „ÄÅ!„ ƒ\"ÇÈ!!‡ÇÉ!ˆ\n?…Ih ž‰ƒ=Ì Î!)‡ŠhÏžA†Gc)‡" [arg overwrite-mode skeleton-pair skeleton-pair-on-word looking-at "\\w" skeleton-pair-filter self-insert-command prefix-numeric-value 1 skeleton-abbrev-cleanup skeleton-pair-alist nil skeleton-end-hook skeleton-insert ((40 . 41) (91 . 93) (123 . 125) (60 . 62) (96 . 39)) last-command-char] 3 (#$ . 12010) "*P"]) emacs-19.30/lisp/solar.elc100666 13437 1 45655 6032176617 14065 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Sep 27 03:29:48 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/solar.el ;;; emacs version 19.29.12. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`solar.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ƒ ÂÃ!ˆ‚ÄÅ!ˆÂÆ!‡" [fboundp atan require lisp-float-type error "Solar/lunar calculations impossible since floating point is unavailable." cal-dst] 2) #@422 *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-time-display-form (quote (12-hours ":" minutes am-pm (if time-zone " (") time-zone (if time-zone ")"))) (#$ . -643)) #@331 *Latitude of `calendar-location-name' in degrees. The value can be either a decimal fraction (one place of accuracy is sufficient), + north, - south, such as 40.7 for New York City, or the value can be a vector [degrees minutes north/south] such as [40 50 north] for New York City. This variable should be set in site-local.el. (defvar calendar-latitude nil (#$ . -1205)) #@328 *Longitude of `calendar-location-name' in degrees. The value can be either a decimal fraction (one place of accuracy is sufficient), + east, - west, such as -73.9 for New York City, or the value can be a vector [degrees minutes east/west] such as [73 55 west] for New York City. This variable should be set in site-local.el. (defvar calendar-longitude nil (#$ . -1586)) #@68 Convert calendar-latitude to a signed decimal fraction, if needed. (defalias 'calendar-latitude #[nil "§ƒ‡ÁHÂHÃ¥\\ÅHÆšƒ\f‚\f[)‡" [calendar-latitude 0 1 60.0 lat 2 north] 3 (#$ . 1964)]) (put (quote calendar-latitude) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@69 Convert calendar-longitude to a signed decimal fraction, if needed. (defalias 'calendar-longitude #[nil "§ƒ‡ÁHÂHÃ¥\\ÅHÆšƒ\f‚\f[)‡" [calendar-longitude 0 1 60.0 long 2 east] 3 (#$ . 2258)]) (put (quote calendar-longitude) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@207 *Expression evaluating to name of `calendar-longitude', calendar-latitude'. For example, "New York City". Default value is just the latitude, longitude pair. This variable should be set in site-local.el. (defvar calendar-location-name (quote (let ((float-output-format "%.1f")) (format "%s%s, %s%s" (if (numberp calendar-latitude) (abs calendar-latitude) (+ (aref calendar-latitude 0) (/ (aref calendar-latitude 1) 60.0))) (if (numberp calendar-latitude) (if (> calendar-latitude 0) "N" "S") (if (equal (aref calendar-latitude 2) (quote north)) "N" "S")) (if (numberp calendar-longitude) (abs calendar-longitude) (+ (aref calendar-longitude 0) (/ (aref calendar-longitude 1) 60.0))) (if (numberp calendar-longitude) (if (> calendar-longitude 0) "E" "W") (if (equal (aref calendar-longitude 2) (quote east)) "E" "W"))))) (#$ . -2557)) #@53 List of season changes for the northern hemisphere. (defvar solar-n-hemi-seasons (quote ("Vernal Equinox" "Summer Solstice" "Autumnal Equinox" "Winter Solstice")) (#$ . 3399)) #@53 List of season changes for the southern hemisphere. (defvar solar-s-hemi-seasons (quote ("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice")) (#$ . 3581)) #@53 Prompt user for latitude, longitude, and time zone. (defalias 'solar-setup #[nil "À ˆ „ ÂÃ!\f„ÂÅ!?…ÂÇ!‰‡" [beep calendar-longitude solar-get-number "Enter longitude (decimal fraction; + east, - west): " calendar-latitude "Enter latitude (decimal fraction; + north, - south): " calendar-time-zone "Enter difference from Coordinated Universal Time (in minutes): "] 2 (#$ . 3763)]) #@97 Return a number from the minibuffer, prompting with PROMPT. Returns nil if nothing was entered. (defalias 'solar-get-number #[(prompt) "À Â\"‰˜?…Ä !)‡" [read-string prompt "" x string-to-int] 4 (#$ . 4159)]) (defalias 'solar-sin-degrees #[(x) "ÀÁ\nÃ\"Ä_!‡" [sin mod x 360.0 .017453292519943295] 4]) (put (quote solar-sin-degrees) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'solar-cosine-degrees #[(x) "ÀÁ\nÃ\"Ä_!‡" [cos mod x 360.0 .017453292519943295] 4]) (put (quote solar-cosine-degrees) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'solar-tangent-degrees #[(x) "ÀÁ\nÃ\"Ä_!‡" [tan mod x 360.0 .017453292519943295] 4]) (put (quote solar-tangent-degrees) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@44 Determines the quadrant of the point X, Y. (defalias 'solar-xy-to-quadrant #[(x y) "ÁVƒ\nÁVƒÇć\nÁVƒŇƇ" [x 0 y 1 4 2 3] 2 (#$ . 4934)]) #@35 Determines the quadrant of ANGLE. (defalias 'solar-degrees-to-quadrant #[(angle) "ÀÁ\nÃ\"Ä\"T‡" [floor mod angle 360 90] 4 (#$ . 5086)]) #@35 Arctangent of X in quadrant QUAD. (defalias 'solar-arctan #[(x quad) "À !Â_\fÅšƒ Æ\\‚+\fÇšƒ Æ\\‚+\fÈšƒ* É\\‚+ )‡" [atan x 57.295779513082323 deg quad 2 180 3 4 360] 2 (#$ . 5229)]) (defalias 'solar-arccos #[(x) "ÀÁ\n‰_Z!Ä \n¥Å\n \"\")‡" [sqrt 1 x y solar-arctan solar-xy-to-quadrant] 5]) (defalias 'solar-arcsin #[(y) "ÀÁ\n‰_Z!Ä\n ¥Å \n\"\")‡" [sqrt 1 y x solar-arctan solar-xy-to-quadrant] 5]) #@63 Inclination of earth's equator to its solar orbit in degrees. (defconst solar-earth-inclination 23.441884000000002 (#$ . 5641)) #@32 Cosine of earth's inclination. (defconst solar-cos-inclination (byte-code "Âà Ä\"Å_!)‡" [solar-earth-inclination x cos mod 360.0 .017453292519943295] 4) (#$ . 5775)) #@30 Sine of earth's inclination. (defconst solar-sin-inclination (byte-code "Âà Ä\"Å_!)‡" [solar-earth-inclination x sin mod 360.0 .017453292519943295] 4) (#$ . 5949)) #@52 Eccentricity of orbit of the earth around the sun. (defconst solar-earth-orbit-eccentricity .016718 (#$ . 6121)) (defalias 'solar-degrees-to-hours #[(deg) "Á¥‡" [deg 15.0] 2]) (put (quote solar-degrees-to-hours) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'solar-hours-to-days #[(hour) "Á¥‡" [hour 24.0] 2]) (put (quote solar-hours-to-days) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@42 Longitude of the sun at DAY in the year. (defalias 'solar-longitude-of-sun #[(day) "Á_ÂZÄ ‰ÆÄ Ç\"È_!)É_ ‰\\ÆÄ Ç\"È_!)Ê_Ë\\\\\\Ì\")‡" [day .98559999999999999 3.2890000000000001 mean-anomaly mod x sin 360.0 .017453292519943295 1.916 .02 282.63400000000001 360] 7 (#$ . 6554)]) #@50 Right ascension of the sun, given its LONGITUDE. (defalias 'solar-right-ascension #[(longitude) "À \nÄÅ Æ\"Ç_!)_È\n!\"‰ Ê¥)‡" [solar-arctan solar-cos-inclination longitude x tan mod 360.0 .017453292519943295 solar-degrees-to-quadrant deg 15.0] 7 (#$ . 6839)]) #@46 Declination of the sun, given its LONGITUDE. (defalias 'solar-declination #[(longitude) "À \nÄÅ Æ\"Ç_!)_!‡" [solar-arcsin solar-sin-inclination longitude x sin mod 360.0 .017453292519943295] 6 (#$ . 7107)]) #@252 Calculates the *standard* time of sunrise for Gregorian DATE. Calculation is for location given by `calendar-latitude' and `calendar-longitude'. Returns a decimal fraction of hours. Returns nil if the sun does not rise at that location on that day. (defalias 'solar-sunrise #[(date) "‰‰@)‰A@)‰AA@)\n SÄ_\\ ÆVƒM Ç_È\\É¥Z ‰ǦÊU…F ˦ÊU?†F ̦ÊU)ƒM T -‰Í§ƒ]‚|ÊHÏHÐ¥\\ÆHÒšƒx‚{[)‰Ô¥)Z‰Ö¥)\\Ø!Ú!Ü!Þߥà\\!âã!ä\"å_!)!æã!ç\"è_!))§ƒÈ)‚ç)ÊH)ÏHê¥\\+)ÆH욃ã+‚æ+[)!æã!ç\"è_!)_Z!âã!ä\"å_!))§ƒ)‚-)ÊH)ÏHê¥\\+)ÆH욃)+‚,+[)!âã!ä\"å_!)_¥-î-!ÏX…ïð-!Z‰Ô¥)1ã1\\ò_ó\\Zô\"‰5§ƒq‚ÊHÏHÐ¥\\ÆHÒšƒŒ‚[)‰Ô¥)Z6÷¥\\*.‡" [date month day year 31 day-of-year 2 4 23 10 0 100 400 6 calendar-longitude 1 60.0 long east deg 15.0 hour 24.0 approx-sunrise solar-longitude-of-sun solar-longitude-of-sun-at-sunrise solar-right-ascension solar-right-ascension-at-sunrise solar-declination solar-declination-at-sunrise 50.0 60.0 90 x cos mod 360.0 .017453292519943295 sin 360.0 .017453292519943295 calendar-latitude 60.0 lat north cos-local-sunrise abs 360 solar-arccos local-sunrise .065709999999999997 6.6219999999999999 24 local-mean-sunrise calendar-time-zone 60.0] 7 (#$ . 7322)]) #@251 Calculates the *standard* time of sunset for Gregorian DATE. Calculation is for location given by `calendar-latitude' and `calendar-longitude'. Returns a decimal fractions of hours. Returns nil if the sun does not set at that location on that day. (defalias 'solar-sunset #[(date) "‰‰@)‰A@)‰AA@)\n SÄ_\\ ÆVƒM Ç_È\\É¥Z ‰ǦÊU…F ˦ÊU?†F ̦ÊU)ƒM T -‰Í§ƒ]‚|ÊHÏHÐ¥\\ÆHÒšƒx‚{[)‰Ô¥)Z‰Ö¥)\\Ø!Ú!Ü!Þߥà\\!âã!ä\"å_!)!æã!ç\"è_!))§ƒÈ)‚ç)ÊH)ÏHê¥\\+)ÆH욃ã+‚æ+[)!æã!ç\"è_!)_Z!âã!ä\"å_!))§ƒ)‚-)ÊH)ÏHê¥\\+)ÆH욃)+‚,+[)!âã!ä\"å_!)_¥-î-!ÏX…›ï-!‰Ô¥)0ã0\\ñ_ò\\Zó\"‰4§ƒo‚ŽÊHÏHÐ¥\\ÆHÒšƒŠ‚[)‰Ô¥)Z5ö¥\\*.‡" [date month day year 31 day-of-year 2 4 23 10 0 100 400 18 calendar-longitude 1 60.0 long east deg 15.0 hour 24.0 approx-sunset solar-longitude-of-sun solar-longitude-of-sun-at-sunset solar-right-ascension solar-right-ascension-at-sunset solar-declination solar-declination-at-sunset 50.0 60.0 90 x cos mod 360.0 .017453292519943295 sin 360.0 .017453292519943295 calendar-latitude 60.0 lat north cos-local-sunset abs solar-arccos local-sunset .065709999999999997 6.6219999999999999 24 local-mean-sunset calendar-time-zone 60.0] 7 (#$ . 8605)]) #@110 Printable form for decimal fraction TIME in TIME-ZONE. Format used is given by `calendar-time-display-form'. (defalias 'solar-time-string #[(time time-zone) "À Â_!‰Â¥ÄŠ¦\"ÄÇ È\\ɦT\"\n ÉYƒ'Ë‚(Ì ÄÅ \"ÎÏÑ#.‡" [round time 60 24-hours format "%02d" minutes "%d" 11 12 12-hours "pm" "am" am-pm mapconcat eval calendar-time-display-form ""] 5 (#$ . 9874)]) #@68 String giving local times of sunrise and sunset on Gregorian DATE. (defalias 'solar-sunrise-sunset #[(date) "À !‰…\fà \n\"Å !‰…à \"ÈÉ\nƒ5Ê \f@\"ƒ5ËÌÍ\fA\"P‚6΃OÊ @\"ƒOÏÌÍA\"P‚PÐÑ!$,‡" [solar-sunrise date rise dst-adjust-time adj-rise solar-sunset set adj-set format "%s, %s at %s" calendar-date-equal "Sunrise " apply solar-time-string "No sunrise" "sunset " "no sunset" eval calendar-location-name] 8 (#$ . 10245)]) #@545 First moment on or after Julian day number D when sun's longitude is a multiple of L degrees at calendar-location-name with that location's local time (including any daylight savings rules). L must be an integer divisor of 360. Result is in local time expressed astronomical (Julian) day numbers. The values of calendar-daylight-savings-starts, calendar-daylight-savings-starts-time, calendar-daylight-savings-ends, calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and calendar-time-zone are used to interpret local time. (defalias 'solar-date-next-longitude #[(d l) "À\nÄ\n!ÆÈ ¥!T_É\"\n\nË¥Ì_\\ Ä !Ï ZWƒg  \\Ð¥Ä\n!\nÑU„I \nW„W\nÑUƒ^ Wƒ^\n ‚'\n ‚'  \\Ò¥.‡" [nil long d start solar-longitude start-long mod l floor 360 next 360.0 400 end end-long 1e-005 2.0 0 2.0] 5 (#$ . 10694)]) #@376 Longitude of sun on astronomical (Julian) day number D. Accurary is about 0.01 degree (about 365.25*24*60*0.01/360 = 15 minutes). The values of calendar-daylight-savings-starts, calendar-daylight-savings-starts-time, calendar-daylight-savings-ends, calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and calendar-time-zone are used to interpret local time. (defalias 'solar-longitude #[(d) "À !ÃÄ\n!!\nÆ\n!ZÇ_ ‰‰AA@)S ‰‰@)\n ‰A@) ‰AA@)\f \nSÍ_\\\nÏVƒ|\nÐ_Ñ\\Ò¥Z\f‰\fЦÓU…s\fÔ¦ÓU?†s\fÕ¦ÓU)ƒ|T- Ö_ Ð¥ Ô¥[ Õ¥\\\\\\\\*×Ø_!Ù¥\\‰Û!ƒ¯Ý¥‚°ÓZ‰ߥZà\n!‰áÃÄÀ !!!‰AA@)!\\‰âZã¥$å$æ_$‰ç__è\\\\é\"*å$ë_$‰ì__$‰‰í___î\\\\\\ï\"0$ñ_$‰ò__ó\\\\4$õ_$‰ö__÷\\\\08ùå8ú\"û_!)_$ü_ý\\0‰\\8ùå8ú\"û_!)_0þ_8ùå8ú\"û_!)ÿ_\\\\@*@\\A$B_C\\DåAD8ùå8ú\"û_!)E_F\\\\G\".‡" [calendar-absolute-from-astro d a-d calendar-gregorian-from-absolute floor date truncate 24 time prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 round 60 1440.0 rounded-abs-date dst-in-effect calendar-daylight-time-offset 1440.0 calendar-time-zone 1440.0 calendar-astro-from-absolute solar-ephemeris-correction 2451545.0 36525.0 T mod 36000.769829999997 .0003032 280.46645000000001 360.0 Lo 35999.050300000003 -.00015589999999999997 -4.7999999999999998e-007 357.52910000000003 360.0 M -4.2036999999999995e-005 -1.2359999999999998e-007 .016708616999999997 e -.0048170000000000002 -1.3999999999999999e-005 1.9146000000000001 x sin 360.0 .017453292519943295 -.000101 .019992999999999999 3 .00029 C true-longitude -1934.136 125.04000000000001 omega -.0047800000000000002 -.0056899999999999995 360.0] 8 (#$ . 11543)]) #@206 Ephemeris time minus Universal Time at astronomical (Julian) day D. Result is in days For the years 1800-1987, the maximum error is 1.9 seconds. For the other years, the maximum error is about 30 seconds. (defalias 'solar-ephemeris-correction #[(year) "À Xƒ ÂWƒ Ã\\Ä¥‡Å Xƒy ÀWƒyÆÇÈ E‰ ‰ AA@)S\n ‰ ‰ @)  ‰ A@)\f ‰ AA@)\f SÍ_\\ ÏVƒ Ð_Ñ\\Ò¥Z ‰ЦÓU…† Ô¦ÓU?†† Õ¦ÓU)ƒT-\nÖ_\nÐ¥\nÔ¥[\nÕ¥\\\\\\\\*!Æ× ׉ AA@)S\n ‰ ‰ @)  ‰ A@)\f ‰ AA@)\f SÍ_\\ ÏVƒ Ð_Ñ\\Ò¥Z ‰ЦÓU… Ô¦ÓU?† Õ¦ÓU)ƒT-\nÖ_\nÐ¥\nÔ¥[\nÕ¥\\\\\\\\*!ZØ¥‰‰_‰_‰__Þ_ß_à_á_â_‰ã__ä__å\\\\\\\\\\\\\\-‡æ Xƒö ÅWƒöÆÇÈ E‰ ‰ AA@)S\n ‰ ‰ @)  ‰ A@)\f ‰ AA@)\f SÍ_\\ ÏVƒö Ð_Ñ\\Ò¥Z ‰ЦÓU…í Ô¦ÓU?†í Õ¦ÓU)ƒöT-\nÖ_\nÐ¥\nÔ¥[\nÕ¥\\\\\\\\*!Æç ç‰ AA@)S\n ‰ ‰ @)  ‰ A@)\f ‰ AA@)\f SÍ_\\ ÏVƒ~ Ð_Ñ\\Ò¥Z ‰ЦÓU…u Ô¦ÓU?†u Õ¦ÓU)ƒ~T-\nÖ_\nÐ¥\nÔ¥[\nÕ¥\\\\\\\\*!Z襉‰_‰_‰__é_ê_ë_ì_í_‰î__ï__‰ð__ñ__‰ò__ó\\\\\\\\\\\\\\\\\\\\-‡ô Xƒ æWƒ õZö¥‰7‰ø__7ù_ú\\\\û¥)‡Æȉ E‰ ‰ AA@)S\n ‰ ‰ @)  ‰ A@)\f ‰ AA@)\f SÍ_\\ ÏVƒŠ Ð_Ñ\\Ò¥Z ‰ЦÓU… Ô¦ÓU?† Õ¦ÓU)ƒŠT-\nÖ_\nÐ¥\nÔ¥[\nÕ¥\\\\\\\\*!üZ‰=‰_þ¥ÿZ‰@A¥*‡" [1988 year 2020 -1933.0 86400.0 1900 calendar-astro-from-absolute 7 1 date prior-years month day 31 day-of-year 2 4 23 10 0 100 400 365 (1 1 1900) 36525.0 theta theta2 theta3 theta4 theta5 .00029699999999999998 .025184000000000002 -.18113299999999999 .55304000000000002 -.86193799999999996 .67706599999999995 -.21259100000000002 -2e-005 1800 (1 1 1900) 36525.0 .0038440000000000003 .083562999999999992 .86573599999999988 4.8675750000000004 15.845535 31.332267000000002 38.291998999999997 28.316289000000001 11.636203999999999 2.0437940000000001 -9.0000000000000018e-006 1620 1600 10.0 x 2.1916699999999998 -40.674999999999997 196.58332999999999 86400.0 2382148 tmp 41048480.0 15 second 86400.0] 13 (#$ . 13236)]) #@328 Local time of sunrise and sunset for today. Accurate to +/- 2 minutes. If called with an optional prefix argument, prompt for date. If called with an optional double prefix argument, prompt for longitude, latitude, time zone, and date, and always use standard time. This function is suitable for execution in a .emacs file. (defalias 'sunrise-sunset #[(&optional arg) "„ÁÂWƒ ƒ\fƒ „Æ ˆÂWƒ%\f‚(ÇÈ!ÂWƒ3 ‚6ÇÉ!ÂWƒA ‚DÇÊ!ÂWƒP ‚¿Ì ÎÏ §ƒ`Ð !‚i ÑH ÁHÒ¥\\ §ƒ| ÑVƒxÓ‚‰Ô‚‰ ÕHÖšƒˆÓ‚‰Ô\f§ƒ”Ð\f!‚\fÑH\fÁH×¥\\\f§ƒ°\fÑVƒ¬Ø‚½Ù‚½\fÕHÚšƒ¼Ø‚½Ù%) ÂWƒÌ‚ç ÑUƒÖÜ‚ç ÑWƒãÎÝ \"‚çÎÞ \"ÂW…ñÂW…û  áWƒâ ‚\nã $å$æ\"'è$!)Îê')#+ìæ!-+Gî Xƒ7ï+!‚Zðñ'ò)Q!‘ˆïó-ƒW4ƒSõ‚Xö‚X÷!!.\f‡" [arg 1 16 calendar-latitude calendar-longitude calendar-time-zone solar-setup solar-get-number "Enter longitude (decimal fraction; + east, - west): " "Enter latitude (decimal fraction; + north, - south): " "Enter difference from Coordinated Universal Time (in minutes): " calendar-location-name "%.1f" float-output-format format "%s%s, %s%s" abs 0 60.0 "N" "S" 2 north 60.0 "E" "W" east calendar-standard-time-zone-name "UTC" "UTC%dmin" "UTC+%dmin" calendar-daylight-savings-starts calendar-daylight-savings-ends 4 calendar-current-date calendar-read-date date calendar-date-string t date-string solar-sunrise-sunset time-string "%s: %s" msg one-window-p one-window frame-width message "*temp*" princ "\n" substitute-command-keys pop-up-windows "Type \\[delete-other-windows] to remove temp window." "Type \\[switch-to-buffer] RET to remove temp window." "Type \\[switch-to-buffer-other-window] RET to restore old contents of temp window."] 7 (#$ . 15248) "p"]) #@84 Local time of sunrise and sunset for date under cursor. Accurate to +/- 2 minutes. (defalias 'calendar-sunrise-sunset #[nil "ƒ\f ƒ\f\n„à ˆÄÅ!ÇÈÉʼn#Ê!#)‡" [calendar-latitude calendar-longitude calendar-time-zone solar-setup calendar-cursor-to-date t date message "%s: %s" calendar-date-string solar-sunrise-sunset] 6 (#$ . 16955) nil]) #@79 Local time of sunrise and sunset as a diary entry. Accurate to +/- 2 minutes. (defalias 'diary-sunrise-sunset #[nil "ƒ\f ƒ\f\n„à ˆÄ !‡" [calendar-latitude calendar-longitude calendar-time-zone solar-setup solar-sunrise-sunset date] 2 (#$ . 17307)]) #@124 Local time of candle lighting diary entry--applies if date is a Friday. No diary entry if there is no sunset on that date. (defalias 'diary-sabbath-candles #[nil "ƒ\f ƒ\f\n„à ˆ\f‰‰AA@)S\f‰‰@)\f‰A@)\f‰AA@)SÉ_\\\nËVƒw\nÌ_Í\\Î¥Z\n‰̦ÏU…nЦÏU?†nѦÏU)ƒw\nT\n\n- Ò_ Ì¥ Ð¥[ Ñ¥\\\\\\\\*Ó¦ÔU…¾Õ\f!‰…¥×\fØÙ¥Z\"‰…½Û\f@\"…½ÜÝÞßA\"\"*‡" [calendar-latitude calendar-longitude calendar-time-zone solar-setup date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 7 5 solar-sunset sunset dst-adjust-time 18.0 60.0 light calendar-date-equal format "%s Sabbath candle lighting" apply solar-time-string] 8 (#$ . 17568)]) #@103 Date and time of equinoxes and solstices, if visible in the calendar window. Requires floating point. (defalias 'solar-equinoxes-solstices #[nil " \nÄ_ ‰Å¦ÆUƒÇ‚! ŦÈUƒ Æ‚!ÉÇ\\\\\\‰\nĦT\nÄ¥) ƒ<\f‚=Í\f …F …O ƒ[ ‚\\É Å¥SÑÒÅ_Å\\Ó\nE‰‰AA@)S‰‰@)‰A@)‰AA@)SÙ_\\ÈVƒàÛ_Ü\\Ý¥Z‰Û¦ÉU…×Þ¦ÉU?†×ߦÉU)ƒàT-à_Û¥Þ¥[ߥ\\\\\\\\*!á\"\"ã\"!$åæ$!!çè)ƒG)§ƒ)‚=)ÉH)ÆHê¥\\+)ÈH욃9+‚<+[)ÉWƒG-‚I.8ï$æ$!Zð_ñ$!ƒ`2‚b\f\"#. DC‡" [displayed-month displayed-year y m 12 3 1 -1 2 0 macro-y calendar-time-zone calendar-standard-time-zone-name "UTC" calendar-daylight-savings-starts calendar-daylight-savings-ends k solar-date-next-longitude calendar-astro-from-absolute 15 date prior-years month day year 31 day-of-year 4 23 10 100 400 365 90 d calendar-absolute-from-astro abs-day calendar-gregorian-from-absolute floor format "%s %s" calendar-latitude 60.0 lat north solar-s-hemi-seasons solar-n-hemi-seasons solar-time-string 24 dst-in-effect calendar-daylight-time-zone-name] 10 (#$ . 18251)]) (provide (quote solar)) emacs-19.30/lisp/solitaire.elc100666 12120 1 23663 6045214342 14567 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:26:32 1995 ;;; from file /home/fsf/rms/e19/lisp/solitaire.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`solitaire.el' was compiled for Emacs 19.29 or later")) #@31 Keymap for playing solitaire. (defvar solitaire-mode-map nil (#$ . 478)) (byte-code "„¶Á ÂÃ\"ˆÄÅÆ#ˆÄÇÈ#ˆÄÉÊ#ˆÄËÌ#ˆÄÍÎ#ˆÏÐÑ$ˆÄÓÔ#ˆÄÕÖ#ˆÄ×Æ#ˆÄØÈ#ˆÄÙÊ#ˆÄÚÌ#ˆÄÛÜ#ˆÄÝÞ#ˆÄßà#ˆÄáâ#ˆÄãÆ#ˆÄäÈ#ˆÄåÊ#ˆÄæÌ#ˆÄçè#ˆÄéÜ#ˆÄêÞ#ˆÄëà#ˆÄìâ#ˆÄíÎ#ˆÄîÑ#ˆÄïð#ˆñòóô#‡" [solitaire-mode-map make-sparse-keymap suppress-keymap t define-key "" solitaire-right "" solitaire-left "" solitaire-up "" solitaire-down [return] solitaire-move substitute-key-definition undo solitaire-undo global-map " " solitaire-do-check "q" solitaire-quit [right] [left] [up] [down] [S-right] solitaire-move-right [S-left] solitaire-move-left [S-up] solitaire-move-up [S-down] solitaire-move-down [kp-6] [kp-4] [kp-8] [kp-2] [kp-5] solitaire-center-point [S-kp-6] [S-kp-4] [S-kp-8] [S-kp-2] [kp-enter] [kp-0] [115] solitaire-solve put solitaire-mode mode-class special] 5) #@290 Major mode for playing solitaire. To learn how to play solitaire, see the documentation for function `solitaire'. \ The usual mnemonic keys move the cursor around the board; in addition, \[solitaire-move] is a prefix character for actually moving a stone on the board. (defalias 'solitaire-mode #[nil "À ˆÁ\n!ˆÃÅÇÉÊ!‡" [kill-all-local-variables use-local-map solitaire-mode-map t truncate-lines solitaire-mode major-mode "Solitaire" mode-name run-hooks solitaire-mode-hook] 2 (#$ . 1344) nil]) #@46 Counter for the stones that are still there. (defvar solitaire-stones 0 (#$ . 1869)) #@22 Center of the board. (defvar solitaire-center nil (#$ . 1960)) #@33 Upper left corner of the board. (defvar solitaire-start nil (#$ . 2029)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp solitaire-start-x nil current-load-list solitaire-start-y] 2) #@34 Lower right corner of the board. (defvar solitaire-end nil (#$ . 2218)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp solitaire-end-x nil current-load-list solitaire-end-y] 2) #@200 *Non-nil means check for possible moves after each major change. This takes a while, so switch this on if you like to be informed when the game is over, or off, if you are working on a slow machine. (defvar solitaire-auto-eval t (#$ . -2403)) (byte-code "ÀÁ\nBÁ‡" [(solitaire-left solitaire-right solitaire-up solitaire-down) solitaire-valid-directions current-load-list] 2) #@1695 Play Solitaire. To play Solitaire, type \[solitaire]. \ Move around the board using the cursor keys. Move stones using \[solitaire-move] followed by a direction key. Undo moves using \[solitaire-undo]. Check for possible moves using \[solitaire-do-check]. (The variable solitaire-auto-eval controls whether to automatically check after each move or undo) What is Solitaire? I don't know who invented this game, but it seems to be rather old and it's origin seems be northern Africa. Here's how to play: Initially, the board will look similar to this: Le Solitaire ============ o o o o o o o o o o o o o o o o . o o o o o o o o o o o o o o o o Let's call the o's stones and the .'s holes. One stone fits into one hole. As you can see, all holes but one are occupied by stones. The aim of the game is to get rid of all but one stone, leaving that last one in the middle of the board if you're cool. A stone can be moved if there is another stone next to it, and a hole after that one. Thus there must be three fields in a row, either horizontally or vertically, up, down, left or right, which look like this: o o . Then the first stone is moved to the hole, jumping over the second, which therefore is taken away. The above thus `evaluates' to: . . o That's all. Here's the board after two moves: o o o . o o o o . o o o o o . o o o o o o o o o o o o o o o o o o Pick your favourite shortcuts: \{solitaire-mode-map} (defalias 'solitaire #[(arg) "ÀÁ!ˆÂ ˆÃÅÇ ˆÈ ˆdbˆÉÊ! `C\fÍÎ!‡" [switch-to-buffer "*Solitaire*" solitaire-mode t buffer-read-only 32 solitaire-stones solitaire-insert-board solitaire-build-modeline search-backward "." solitaire-center buffer-undo-list set-buffer-modified-p nil] 2 (#$ . 2788) "P"]) (defalias 'solitaire-build-modeline #[nil "ÀÁÂÃ\fWƒÅÆ\f\"‚ÇÈÉÊËÌͯ\nÏ ‡" ["" "---" mode-line-buffer-identification 1 solitaire-stones format "--> There are %d stones left <--" "------" global-mode-string " %[(" mode-name minor-mode-alist "%n" ")%]-%-" mode-line-format force-mode-line-update] 10]) (defalias 'solitaire-insert-board #[nil "À Ä  ÆVƒÇ‚ ÈVƒÉ‚Ê ÌVƒ)Í‚*ÎÐ  GÑ_ZÒZÓ¥Ô\"Ö ˆÐ ‰×VƒKØ‚LÙZGSÑ_ZÒZÓ¥Ú\"cˆ͘„i ×VƒwÛÜ\"cˆÛÝ\"cˆcˆ`ià !Ûâ ‰‰‰&cˆÛã ‰‰‰&cˆÛä ‰‰‰‰‰& cˆÛå ‰‰%cˆ`&Ûç ‰‰%cˆÛä ‰‰‰‰‰& cˆÛã ‰‰‰&cˆÛè ‰‰‰‰‰&cˆ`)i*à ‰+.‡" [nil buffer-read-only window-width w window-height h 26 " " 20 " " "" hsep 17 "\n\n" "\n" vsep make-string 6 7 2 32 indent erase-buffer 12 3 0 10 format "%sLe Solitaire\n" "%s============\n\n" solitaire-start solitaire-start-x solitaire-current-line solitaire-start-y " %s %so%so%so%s" "%s %s %so%so%so%s" "%so%so%so%so%so%so%so%s" "%so%so%so%s" solitaire-center ".%so%so%so%s" "%s %s %so%so%so%s %s " solitaire-end solitaire-end-x solitaire-end-y] 10]) (defalias 'solitaire-right #[nil "`ÁuˆgÂUƒÁuˆ‚gÃU„#gÂU„#gÄU…%b)‡" [start nil 32 0 10] 2 nil nil]) (defalias 'solitaire-left #[nil "`Á ˆgÂUƒÁ ˆ‚hÃU„#gÂU„#gÄU…%b)‡" [start backward-char 32 0 10] 2 nil nil]) (defalias 'solitaire-up #[nil "`iÂyˆÃ!ˆgÄUƒ Âyƒ Ã!ƒ nƒ hÅU„8gÆU„8gÇU„8gÄU…: b*‡" [c start -1 move-to-column 10 0 32 61] 2 nil nil]) (defalias 'solitaire-down #[nil "`iÂyˆÃ!ˆgÄUƒ Âyƒ Ã!ƒ lƒ gÅU„2gÆU„2gÄU…4 b*‡" [c start 1 move-to-column 10 0 32] 2 nil nil]) (defalias 'solitaire-center-point #[nil "b‡" [solitaire-center] 1 nil nil]) (defalias 'solitaire-move-right #[nil "ÀÁ!‡" [solitaire-move [right]] 2 nil nil]) (defalias 'solitaire-move-left #[nil "ÀÁ!‡" [solitaire-move [left]] 2 nil nil]) (defalias 'solitaire-move-up #[nil "ÀÁ!‡" [solitaire-move [up]] 2 nil nil]) (defalias 'solitaire-move-down #[nil "ÀÁ!‡" [solitaire-move [down]] 2 nil nil]) #@293 Check if a move is possible from current point in the specified direction. MOVESYMBOL specifies the direction. Returns either a string, indicating cause of contraindication, or a list containing three numbers: starting field, skipped field (from which a stone will be taken away) and target. (defalias 'solitaire-possible-move #[(movesymbol) "ŠÀÁ\nMˆ\n >ƒG`Á ˆ`Á ˆ` \fUƒ$Ç‚CfÈUƒ: fÈUƒ:\ffÉU„>Ê‚C \fE+‚HË*‡" [nil move movesymbol solitaire-valid-directions target skip start "Off Board!" 111 46 "Wrong move!" "Not a valid direction"] 3 (#$ . 6762)]) #@53 Pseudo-prefix command to move a stone in Solitaire. (defalias 'solitaire-move #[(dir) "ÀÁ\n \"!Å\f;ƒÇ\f!‚X\f@\fA@\fAA@ ‰\nbˆËÌ!ˆÍcˆ bˆËÌ!ˆÍcˆbˆËÌ!ˆÎcˆbˆSÐ ˆ…WÒ +*‡" [solitaire-possible-move lookup-key solitaire-mode-map dir class nil buffer-read-only error target skip start delete-char 1 46 111 solitaire-stones solitaire-build-modeline solitaire-auto-eval solitaire-do-check] 5 (#$ . 7333) "kMove where? "]) #@27 Undo a move in Solitaire. (defalias 'solitaire-undo #[(arg) "À !ˆ)ŠÄbˆÇÈ Ê#ƒ;i Yƒi\fXƒÍ YƒÍ Xƒ T‚ ))Ñ ˆ…JÓ ‡" [nil buffer-read-only undo arg 0 count solitaire-end search-backward "o" solitaire-start done solitaire-start-x solitaire-end-x solitaire-current-line solitaire-start-y solitaire-end-y solitaire-stones solitaire-build-modeline solitaire-auto-eval solitaire-do-check] 4 (#$ . 7771) "P"]) (defalias 'solitaire-check #[nil "ŠÁUƒ ‚B bˆÂÅÆÈ#ƒ@i Yƒi\nXƒË \fYƒË  XƒÎÏ\"ˆ‚\f))‡" [solitaire-stones 1 0 solitaire-end count search-backward "o" solitaire-start done solitaire-start-x solitaire-end-x solitaire-current-line solitaire-start-y solitaire-end-y mapcar #[(movesymbol) "À !<… \nT‰‡" [solitaire-possible-move movesymbol count] 2] solitaire-valid-directions] 4]) #@44 Check for any possible moves in Solitaire. (defalias 'solitaire-do-check #[(&optional arg) "À \nÃUƒÄÅ!‚+ ÆUƒÄÇ!‚+ ÃUƒ'ÄÈ!‚+ÄÉ \")‡" [solitaire-check moves solitaire-stones 1 message "Yeah! You made it! Only the King is left!" 0 "Sorry, no more possible moves." "There is one possible move." "There are %d possible moves."] 3 (#$ . 8601) "P"]) #@68 Return the vertical position of point. Seen in info on text lines. (defalias 'solitaire-current-line #[nil "Àe`\"iÁUƒ‚ÁÃ\\\\‡" [count-lines 0 1 -1] 3 (#$ . 8959)]) #@25 Quit playing Solitaire. (defalias 'solitaire-quit #[nil "ÀÁ!‡" [kill-buffer "*Solitaire*"] 2 (#$ . 9134) nil]) #@93 Spoil solitaire by solving the game for you - nearly ... ... stops with five stones left ;) (defalias 'solitaire-solve #[nil "ÀÁÄ ˆÅÆ \"ˆ*Ç ‡" [[up up S-down up left left S-right up up left S-down up up right right S-left down down down S-up up S-down down down down S-up left left down S-right left left up up S-down right right right S-left left S-right right right right S-left right down down S-up down down left left S-right up up up S-down down S-up up up up S-down up right right S-left down right right down S-up left left left S-right right S-left down down left S-right S-up S-left S-left S-down S-right up S-right left left] nil solitaire-auto-eval allmoves solitaire-center-point mapcar #[(op) "Á>ƒ\nÂÃ!ˆÄÅ!!ˆÆ>…ÂÇ!‡" [op (S-left S-right S-up S-down) sit-for .2 execute-kbd-macro vector (S-left S-right S-up S-down) .4] 3] solitaire-do-check] 3 (#$ . 9251) nil]) (provide (quote solitaire)) emacs-19.30/lisp/sort.elc100666 13437 1 23252 6055512152 13712 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 24 22:58:24 1995 ;;; from file /home/fsf/rms/e19/lisp/sort.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`sort.el' was compiled for Emacs 19.29 or later")) #@59 *Non-nil if the buffer sort functions should ignore case. (defvar sort-fold-case nil (#$ . -466)) #@1580 General text sorting routine to divide buffer into records and sort them. Arguments are REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN. We divide the accessible portion of the buffer into disjoint pieces called sort records. A portion of each sort record (perhaps all of it) is designated as the sort key. The records are rearranged in the buffer in order by their sort keys. The records may or may not be contiguous. Usually the records are rearranged in order of ascending sort key. If REVERSE is non-nil, they are rearranged in order of descending sort key. The next four arguments are functions to be called to move point across a sort record. They will be called many times from within sort-subr. NEXTRECFUN is called with point at the end of the previous record. It moves point to the start of the next record. It should move point to the end of the buffer if there are no more records. The first record is assumed to start at the position of point when sort-subr is called. ENDRECFUN is called with point within the record. It should move point to the end of the record. STARTKEYFUN moves from the start of the record to the start of the key. It may return either a non-nil value to be used as the key, or else the key is the substring between the values of point after STARTKEYFUN and ENDKEYFUN are called. If STARTKEYFUN is nil, the key starts at the beginning of the record. ENDKEYFUN moves from the start of the sort key to the end of the sort key. ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the same as ENDRECFUN. (defalias 'sort-subr #[(reverse nextrecfun endrecfun &optional startkeyfun endkeyfun) "deZÀVŠ ƒÂÃ!ˆÄ $ Ê ! \f  ƒ—\n„3 Ÿ ƒ;ÂÎ!ˆÏÐ!ƒ`Ð ‰@@§ƒOÑ‚\\ @@:ƒ[Ò‚\\Ó\"‚|Ô ‰@@§ƒnÕ‚{ @@:ƒzÖ‚{×\" \nƒˆ Ÿ ƒÂØ!ˆÙ  \"ˆ+ ƒ ÂÚ!ˆ*Û‡" [50000 messages message "Finding sort keys..." sort-build-lists nextrecfun endrecfun startkeyfun endkeyfun sort-lists reverse old sort-fold-case case-fold-search "Sorting records..." fboundp sortcar < #[(a b) "ÀÁ @ AÂ\f@\fA&V‡" [0 compare-buffer-substrings nil a b] 8] string< sort car-less-than-car #[(a b) "ÀÁ @@ @AÂ\f@@\f@A&V‡" [0 compare-buffer-substrings nil a b] 8] #[(a b) "@ @™‡" [a b] 2] "Reordering buffer..." sort-reorder-buffer "Reordering buffer... Done" nil] 5 (#$ . 572)]) (defalias 'sort-build-lists #[(nextrecfun endrecfun startkeyfun endkeyfun) "À‰‰‰m„f`ÀÁÅ\nÀ„1ƒ& ˆ‚1ƒ1 ˆÈ ƒV :ƒN @ šƒN A`šƒN ‰B‚S `BB\fB\n„ƒ ˆ‚\f,‡" [nil key done start-rec sort-lists (byte-code "ƒ  †`\n† Ä ˆ `)B‡" [startkeyfun start endkeyfun endrecfun t done] 2) endrecfun nextrecfun t] 4]) (defalias 'sort-reorder-buffer #[(sort-lists old) "ÀeeddbˆÅÆ!ˆ\ndS}ˆƒJdbˆÈp  @A@#ˆdbˆÈp@A@@AA#ˆ @AAA A ‚dbˆÈp #ˆ\n |ˆdbˆ\n`T}ˆ``T|,‡" [t max min last inhibit-quit insert-before-markers " " sort-lists insert-buffer-substring old] 4]) #@190 Sort lines in region alphabetically; argument means descending order. Called from a program, there are three arguments: REVERSE (non-nil means reverse order), BEG and END (region to sort). (defalias 'sort-lines #[(reverse beg end) "ŠŒ }ˆebˆÂ ÄÅ#*‡" [beg end sort-subr reverse forward-line end-of-line] 4 (#$ . 3507) "P\nr"]) #@195 Sort paragraphs in region alphabetically; argument means descending order. Called from a program, there are three arguments: REVERSE (non-nil means reverse order), BEG and END (region to sort). (defalias 'sort-paragraphs #[(reverse beg end) "ŠŒ }ˆebˆÂ ÄÅ#*‡" [beg end sort-subr reverse #[nil "m?…À !…Âyˆ‚‡" [looking-at paragraph-separate 1] 2] forward-paragraph] 4 (#$ . 3840) "P\nr"]) #@190 Sort pages in region alphabetically; argument means descending order. Called from a program, there are three arguments: REVERSE (non-nil means reverse order), BEG and END (region to sort). (defalias 'sort-pages #[(reverse beg end) "ŠŒ }ˆebˆÂ ÄÅ#*‡" [beg end sort-subr reverse #[nil "ÀÁw‡" ["\n" nil] 2] forward-page] 4 (#$ . 4240) "P\nr"]) (byte-code "ÀÁ!„ÂÁ B „OÄ ÅÈWƒ/ÉÊ#ˆT‰‚ÉËÌ#ˆÉÍÌ#ˆÉÎÌ#ˆÉÏÐ#ˆ*‡" [boundp sort-fields-syntax-table nil current-load-list make-syntax-table 0 i table 256 modify-syntax-entry "w" 32 " " 9 10 46 "_"] 5) #@369 Sort lines in region numerically by the ARGth field of each line. Fields are separated by whitespace and numbered from 1 up. Specified field must contain a number in each line of the region. With a negative arg, sorts by the ARGth field counted from the right. Called from a program, there are three arguments: FIELD, BEG and END. BEG and END specify region to sort. (defalias 'sort-numeric-fields #[(field beg end) "À \n ÄÅ%‡" [sort-fields-1 field beg end #[nil "À !ˆÂ`ŠÃÄ!ˆ`){!‡" [sort-skip-fields field string-to-number forward-sexp 1] 4] nil] 6 (#$ . 4817) "p\nr"]) #@309 Sort lines in region lexicographically by the ARGth field of each line. Fields are separated by whitespace and numbered from 1 up. With a negative arg, sorts by the ARGth field counted from the right. Called from a program, there are three arguments: FIELD, BEG and END. BEG and END specify region to sort. (defalias 'sort-fields #[(field beg end) "À \n ÄÅ%‡" [sort-fields-1 field beg end #[nil "À !ˆÂ‡" [sort-skip-fields field nil] 2] #[nil "ÀÁw‡" ["^ \n" nil] 2]] 6 (#$ . 5395) "p\nr"]) (defalias 'sort-fields-1 #[(field beg end startkeyfun endkeyfun) "À \nÃUƒ ÄÅŽŠŒ}ˆebˆÈ !ˆÊËÌÍ%,‡" [syntax-table tbl field 0 1 ((set-syntax-table tbl)) beg end set-syntax-table sort-fields-syntax-table sort-subr nil forward-line end-of-line startkeyfun endkeyfun] 6]) (defalias 'sort-skip-fields #[(n) "ÁVƒ8S‰ÁVƒÃÄwˆÅÄwˆ\nS‰‚\nÃÄwˆl…6ÆÇŠÁyˆ`)ŠÄˆ`){\")‡Äˆ[S‰ÁVƒTÃÄxˆÅÄxˆ\nS‰‚@ÃÄxˆ)nƒnÆÇŠÁyˆ`)ŠÄˆ`){\"ˆÅÄx‡" [n 0 i " " nil "^ \n" error "Line has too few fields: %s"] 5]) (byte-code "À B BÀ‡" [sort-regexp-fields-regexp current-load-list sort-regexp-record-end] 2) (defalias 'sort-regexp-fields-next-record #[nil "`Á\nÃÄ#…1Å•‰…1Uƒ*ÇuˆÁ\nÃÄ#ˆÅ•‰‚+È…1Å”b)‡" [oldpos re-search-forward sort-regexp-fields-regexp nil move 0 sort-regexp-record-end 1 t] 4]) #@817 Sort the region lexicographically as specified by RECORD-REGEXP and KEY. RECORD-REGEXP specifies the textual units which should be sorted. For example, to sort lines RECORD-REGEXP would be "^.*$" KEY specifies the part of each record (ie each match for RECORD-REGEXP) is to be used for sorting. If it is "\\digit" then the digit'th "\\(...\\)" match field from RECORD-REGEXP is used. If it is "\\&" then the whole record is used. Otherwise, it is a regular-expression for which to search within the record. If a match for KEY is not found within a record then that record is ignored. With a negative prefix arg sorts in reverse order. For example: to sort lines in the region by the first word on each line starting with the letter "f", RECORD-REGEXP would be "^.*$" and KEY would be "\\=\" (defalias 'sort-regexp-fields #[(reverse record-regexp key-regexp beg end) "Áš„\fšƒÃ‚ÄÅ\"ƒÆHÇZŠŒ }ˆebˆÊ \f Î\f!ˆ` ÔbˆÏÑÒÓ$,‡" [key-regexp "" "\\&" 0 string-match "\\`\\\\[1-9]\\'" 1 48 beg end nil record-regexp sort-regexp-fields-regexp sort-regexp-record-end re-search-forward sort-subr reverse sort-regexp-fields-next-record #[nil "b‡" [sort-regexp-record-end] 1] #[nil "À\n§ƒ\f\n‚Ã\n\fÅ#ƒÀ‚ÆÇÈ\"ˆÈÉÊ)‡" [0 n key-regexp re-search-forward sort-regexp-record-end t throw key nil (byte-code "ÀÁ!ƒ\f\n”\n•B‡\n”\n•{‡" [fboundp buffer-substring-lessp n] 2) ((error (byte-code "ÀÁÂ\"‡" [throw key nil] 3)))] 4]] 5 (#$ . 6687) "P\nsRegexp specifying records to sort: \nsRegexp specifying key within record: \nr"]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp sort-columns-subprocess t current-load-list] 2) #@620 Sort lines in region alphabetically by a certain range of columns. For the purpose of this command, the region includes the entire line that point is in and the entire line the mark is in. The column positions of point and mark bound the range of columns to sort on. A prefix argument means sort into reverse order. Note that `sort-columns' rejects text that contains tabs, because tabs could be split across the specified columns and it doesn't know how to handle that. Also, when possible, it uses the `sort' utility program, which doesn't understand tabs. Use \[untabify] to convert tabs to spaces before sorting. (defalias 'sort-columns #[(reverse &optional beg end) "ŠÀ‰‰‰‰‰^bˆiÉyˆ`]bˆiÀyˆ`\f ^\f ]ÊËÌ#ƒ@ÍÎ!ˆÐ=„dÑ Ò̉ÀƒXÔ‚YÕÖ\nP× P& ‚xŠŒ }ˆbˆØÙÚÛÜ%*.‡" [nil col-end col-start col-end1 col-beg1 end1 beg1 beg end 0 search-backward " " t error "sort-columns does not work with tabs. Use M-x untabify." system-type vax-vms call-process-region "sort" reverse "-rt\n" "-t\n" "+0." "-0." sort-subr forward-line end-of-line #[nil "À !ˆÂ‡" [move-to-column col-start nil] 2] #[nil "À !ˆÂ‡" [move-to-column col-end nil] 2]] 11 (#$ . 8340) "P\nr"]) #@106 Reverse the order of lines in a region. From a program takes two point or marker arguments, BEG and END. (defalias 'reverse-region #[(beg end) " VƒÂ  )Šbˆn„Äyˆ` bˆlƒ'nƒ-ÅyˆÂˆÆ ÂÇ ƒ`bˆ`ˆ`{ B ` U?ƒZ`T‚[`|ˆ‚6 Aƒv @ʱˆ A‰ ‚b @c+‡" [beg end nil mid 1 -1 point-marker t do ll "\n"] 3 (#$ . 9535) "r"]) (provide (quote sort)) emacs-19.30/lisp/soundex.elc100666 12120 1 2237 5744577401 14250 0ustar rmsdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:51:29 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/soundex.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/soundex.el' was compiled for Emacs 19")) #@55 Alist of chars-to-key-code for building Soundex keys. (defvar soundex-alist (quote ((66 . "1") (70 . "1") (80 . "1") (86 . "1") (67 . "2") (71 . "2") (74 . "2") (75 . "2") (81 . "2") (83 . "2") (88 . "2") (90 . "2") (68 . "3") (84 . "3") (76 . "4") (77 . "5") (78 . "5") (82 . "6"))) (#$ . 483)) #@180 Return a Soundex key for WORD. Implemented as described in: Knuth, Donald E. "The Art of Computer Programming, Vol. 3: Sorting and Searching", Addison-Wesley (1973), pp. 391-392. (defalias 'soundex #[(word) "–‰GÂH žAÂÅOÅ\fÉGVƒN WƒNH žAT\f?†@\f˜?…E\fP\f‚ÉGVƒ`ÊPÂÉO‚b.‡" [word length 0 soundex-alist code 1 key index prev-code 4 "000"] 4 (#$ . 786)]) emacs-19.30/lisp/spell.elc100666 13437 1 5647 5744577402 14047 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:51:29 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/spell.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/spell.el' was compiled for Emacs 19")) #@36 *Command to run the spell program. (defvar spell-command "spell" (#$ . -479)) #@173 *Filter function to process text before passing it to spell program. This function might remove text-processor commands. nil means don't alter the text before checking it. (defvar spell-filter nil (#$ . -564)) (put (quote spell-filter) (quote risky-local-variable) t) #@298 Check spelling of every word in the buffer. For each incorrect word, you are asked for the correct spelling and then put into a query-replace to fix some or all occurrences. If you do not want to change a word, just give the same word as its "correct" spelling; then the query replace is skipped. (defalias 'spell-buffer #[nil "ÀedÁ#‡" [spell-region "buffer"] 4 (#$ . 839) nil]) #@156 Check spelling of word at or before point. If it is not correct, ask user for the correct spelling and `query-replace' the entire buffer to substitute it. (defalias 'spell-word #[nil "À‰‰ŠÄÅ!„Ævˆ`Çvˆ`)È \n \n{#+‡" [nil spell-filter end beg looking-at "\\<" -1 1 spell-region] 5 (#$ . 1225) nil]) #@181 Like `spell-buffer' but applies only to region. Used in a program, applies from START to END. DESCRIPTION is an optional string naming the unit being checked: for example, "word". (defalias 'spell-region #[(start end &optional description) "ÁÂ!Š qˆ~ˆÅ ˆ)ÆdžÉ\"ˆ\f„N\nSfËUƒN\f͘ƒ;Î\nÍÐ %ˆ‚Î\nÐ ÐÒ\f&ˆ‚pŠ qˆÔ\n#ˆn„eËcˆ\fƒl\f ˆ\f͘ƒ~ÎedÍÕ %ˆ‚ŒÎedÕ ÐÒ\f&ˆ*ÆÖ†•ÉŠ qˆ× ØV)ƒ¥Ù‚¦Ú#ˆÐ‰Õ‰Š qˆ× ØV)…Š qˆebˆ`Ј`{—ßuˆe`|ˆàáâQ\"ãäå!æQ!ˆ)š„´ebˆçèå!èQ\"ˆ‚´.‡" [spell-filter get-buffer-create " *temp*" buf filter erase-buffer message "Checking spelling of %s..." description "region" end 10 spell-command "spell" call-process-region start nil shell-file-name "-c" oldbuf insert-buffer-substring t "Checking spelling of %s...%s" buffer-size 0 "not correct" "correct" case-replace case-fold-search newword word 1 read-input "`" "' not recognized; edit a replacement: " flush-lines "^" regexp-quote "$" query-replace-regexp "\\b"] 9 (#$ . 1535) "r"]) #@48 Check spelling of string supplied as argument. (defalias 'spell-string #[(string) "ÀÁ!Š\nqˆ~ˆÃ ˆ\fűˆǘƒ$ÈedÇɉ%ˆ‚2Èed\nɉËÌ&ˆÍ ÎUƒ@ÏÐ\f\"‚XebˆÑÅËÉ#ƒRÒÓ!ˆ‚CÏÔÕd{\"*‡" [get-buffer-create " *temp*" buf erase-buffer string "\n" spell-command "spell" call-process-region t shell-file-name nil "-c" buffer-size 0 message "%s is correct" search-forward replace-match " " "%sincorrect" 1] 9 (#$ . 2552) "sSpell string: "]) emacs-19.30/lisp/spook.elc100666 13437 1 2223 5744577403 14047 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:51:30 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/spook.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/spook.el' was compiled for Emacs 19")) (require (quote cookie1)) #@34 Keep your favorite phrases here. (defvar spook-phrases-file (concat data-directory "spook.lines") (#$ . 505)) #@37 Default number of phrases to insert (defvar spook-phrase-default-count 15 (#$ . 621)) #@57 Adds that special touch of class to your outgoing mail. (defalias 'spook #[nil "À \nÃÄ$‡" [cookie-insert spook-phrases-file spook-phrase-default-count "Checking authorization..." "Checking authorization...Approved"] 5 (#$ . 713) nil]) #@65 Return a vector containing the lines from `spook-phrases-file'. (defalias 'snarf-spooks #[nil "À ÂÃ#‡" [cookie-snarf spook-phrases-file "Checking authorization..." "Checking authorization...Approved"] 4 (#$ . 954)]) emacs-19.30/lisp/startup.elc100666 12120 1 35640 6053157555 14307 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 17 14:15:28 1995 ;;; from file /home/fsf/rms/e19/lisp/startup.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`startup.el' was compiled for Emacs 19.29 or later")) (byte-code "À‡" [(normal-top-level) top-level nil] 1) #@40 t once command line has been processed (defvar command-line-processed nil (#$ . 528)) #@156 *Non-nil inhibits the initial startup message. This is for use in your personal init file, once you are familiar with the contents of the startup message. (defconst inhibit-startup-message nil (#$ . -621)) #@461 *Non-nil inhibits the initial startup echo area message. Inhibition takes effect only if your `.emacs' file contains a line of this form: (setq inhibit-startup-echo-area-message "YOUR-USER-NAME") If your `.emacs' file is byte-compiled, use the following form instead: (eval '(setq inhibit-startup-echo-area-message "YOUR-USER-NAME")) Thus, someone else using a copy of your `.emacs' file will see the startup message unless he personally acts to inhibit it. (defconst inhibit-startup-echo-area-message nil (#$ . -834)) #@50 *Non-nil inhibits loading the `default' library. (defconst inhibit-default-init nil (#$ . -1361)) #@213 Alist of command-line switches. Elements look like (SWITCH-STRING . HANDLER-FUNCTION). HANDLER-FUNCTION receives switch name as sole arg; remaining command-line args are in the variable `command-line-args-left'. (defconst command-switch-alist nil (#$ . 1466)) #@46 List of command-line args not yet processed. (defvar command-line-args-left nil (#$ . 1732)) #@398 List of functions to process unrecognized command-line arguments. Each function should access the dynamically bound variables `argi' (the current argument) and `command-line-args-left' (the remaining arguments). The function should return non-nil only if it recognizes and processes `argi'. If it does so, it may consume successive arguments by altering `command-line-args-left' to remove them. (defvar command-line-functions nil (#$ . 1832)) #@122 Default directory to use for command line arguments. This is normally copied from `default-directory' when Emacs starts. (defvar command-line-default-directory nil (#$ . 2284)) #@184 Functions to call after handling urgent options but before init files. The frame system uses this to open frames to display messages while Emacs loads the user's initialization file. (defvar before-init-hook nil (#$ . 2468)) #@203 Functions to call after loading the init file (`~/.emacs'). The call is not protected by a condition-case, so you can set `debug-on-error' in `.emacs', and put all the actual code on `after-init-hook'. (defvar after-init-hook nil (#$ . 2700)) #@233 Functions to be called after loading terminal-specific Lisp code. See `run-hooks'. This variable exists for users to set, so as to override the definitions made by the terminal-specific file. Emacs never sets this variable itself. (defvar term-setup-hook nil (#$ . 2950)) #@189 The brand of keyboard you are using. This variable is used to define the proper function and keypad keys for use under X. It is used in a fashion analogous to the environment value TERM. (defvar keyboard-type nil (#$ . 3230)) #@153 Normal hook run to initialize window system display. Emacs runs this hook after processing the command line arguments and loading the user's init file. (defvar window-setup-hook nil (#$ . 3464)) #@68 Major mode command symbol to use for the initial *scratch* buffer. (defconst initial-major-mode (quote lisp-interaction-mode) (#$ . 3665)) #@550 Identity of user whose `.emacs' file is or was read. The value is nil if no init file is being used; otherwise, it may be either the null string, meaning that the init file was taken from the user that originally logged in, or it may be a string containing a user's name. In either of the latter cases, `(concat "~" init-file-user "/")' evaluates to the name of the directory where the `.emacs' file was looked for. Setting `init-file-user' does not prevent Emacs from loading `site-start.el'. The only way to do that is to use `--no-site-file'. (defvar init-file-user nil (#$ . 3811)) #@745 File containing site-wide run-time initializations. This file is loaded at run-time before `~/.emacs'. It contains inits that need to be in place for the entire site, but which, due to their higher incidence of change, don't make sense to load into emacs' dumped image. Thus, the run-time load order is: 1. file described in this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'. Don't use the `site-start.el' file for things some users may not like. Put them in `default.el' instead, so that users can more easily override them. Users can prevent loading `default.el' with the `-q' option or by setting `inhibit-default-init' in their own init files, but inhibiting `site-start.el' requires `--no-site-file', which is less convenient. (defvar site-run-file "site-start" (#$ . 4407)) #@184 Regexp that specifies when to enable the ISO 8859-1 character set. We do that if this regexp matches the locale name specified by the LC_ALL, LC_CTYPE and LANG environment variables. (defconst iso-8859-1-locale-regexp "8859[-_]?1" (#$ . 5206)) #@54 *Name of this machine, for purposes of naming users. (defvar mail-host-address nil (#$ . -5456)) #@154 *Full mailing address of this user. This is initialized based on `mail-host-address', after your init file is read, in case it sets `mail-host-address'. (defvar user-mail-address nil (#$ . -5560)) #@143 Prefix for generating auto-save-list-file-name. Emacs's pid and the system name will be appended to this prefix to create a unique file name. (defvar auto-save-list-file-prefix "~/.saves-" (#$ . 5764)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp init-file-debug nil current-load-list init-file-had-error] 2) (defalias 'normal-top-level-add-to-load-path #[(dirs) " ‰ÃÄÅ\"\nA\"¡)‡" [default-directory load-path tail append mapcar expand-file-name dirs] 6]) (defalias 'normal-top-level #[nil "ƒÁÂ!‡Ã\fŠÆÇ!qˆ *É\n‰ ƒB @\nB\n @ÌÍÎ @\"ɉ$ˆ) A‰ „ *Ð=„rÑÒ!‰;ƒqÔÕ!ÖP!ÔÕ\f!ÖP!š„q×ØP\")Ú\f!ÉÜŽÝ *‡" [command-line-processed message "Back to top level." t default-directory dir get-buffer "*Messages*" load-path nil new tail load expand-file-name "subdirs.el" system-type vax-vms getenv "PWD" pwd file-attributes file-name-as-directory "." delete "PWD=" process-environment abbreviate-file-name menubar-bindings-done ((byte-code "À !ÂÃÄ Æ Ç $!ÉÊ!ˆ ƒÉË!ˆÌÍ!ƒ&Í ˆÌÎ!ƒ/Î ˆƒ8ÉÏ!ˆ„NÒ=„KÓ=ƒNÔ ˆÀ‡" [abbreviate-file-name default-directory expand-file-name format "%s%d-%s" auto-save-list-file-prefix emacs-pid system-name auto-save-list-file-name run-hooks emacs-startup-hook term-setup-hook fboundp frame-notice-user-settings font-menu-add-default window-setup-hook menubar-bindings-done window-system x win32 precompute-menubar-bindings] 6)) command-line] 6]) (defalias 'precompute-menubar-bindings #[nil "À Â\"‰ƒ> @:ƒ7 @@9ƒ7 @A¢;ƒ7Ä @AA!ƒ7ÅÆ @AA\"ˆƒ7È ˆ A‰„ )ɉ\n‡" [lookup-key global-map [menu-bar] submap keymapp x-popup-menu nil purify-flag garbage-collect t define-key-rebound-commands] 4]) (defalias 'command-line #[nil "ÂÃ!‰Å=„?\fƘ„\fǘƒÈ ‚?\fʘ„*\f˘ƒ0Å ‚?\f̘„<\f͘ƒ?Î )ÂÏ!‰Ñš?…N)†sÂÒ!‰Ñš?…`)†sÂÓ!‰Ñš?…r)‰…Õ\")ƒ×Ø!ˆÙÈ!ˆ×Ú!ˆÛÜ݈ÅA !?…¤â ‰#ƒµ#ä ˜ƒµÑ# „àƒàå@Å&'(Õé'\"ƒêÕê'\"ƒê'ë•ÅO&'뉔O'ì'(\"‰-È=ƒ'îÅO'‚)-;ƒ&ï-(\"‰0„Ûñ'\"ˆ0@îÅO')‚)Å&)'ò˜„8'ó˜ƒCÅ#A‚Ï'ô˜„Q'õ˜ƒn&„_A‰@&&#Å&A‚Ï'ö˜ƒ€Å7A‚Ï'ø˜ƒ’È9A‚Ï'ú˜ƒ§ûƒ)ÆÇ A@ÈÉ AAÊ##‚6ÆÇ @ËNÈÌ AÊ##Í\"ˆÎÐ ‡" [princ error apply concat file-error error-conditions format "%s: %s" mapconcat #[(obj) "À Â\"‡" [prin1-to-string obj t] 3] ", " error-message #[(obj) "À Â\"‡" [prin1-to-string obj t] 3] external-debugging-output nil window-system kill-emacs] 8))) command-line-args args done noninteractive user-login-name init-file-user user-real-login-name (("--no-init-file") ("--no-site-file") ("--user") ("--debug-init") ("--iconic") ("--icon-type")) argval argi longopts "\\`--" "=" 0 try-completion completion 1 assoc elt "Option `%s' is ambiguous" "-q" "-no-init-file" "-u" "-user" "-no-site-file" site-run-file "-debug-init" init-file-debug "-iconic" (visibility . icon) initial-frame-alist "-icon-type" "-i" "-itype" (icon-type . t) default-frame-alist "Option `%s' doesn't allow an argument" fboundp face-initialize frame-initialize window-system x win32 menu-bar-lines frame-parameters menu-bar-mode run-hooks before-init-hook load inhibit-startup-message startup debug-on-error-initial debug-on-error-should-be-set debug-on-error-from-init-file #[nil "…A Â=ƒÃÄQ‚) Å=ƒÆ‚) Ç=ƒ%È‚)ÃÉQ\nË\n̉‰$ˆ †AÎËÐ̉#)‡" [init-file-user system-type ms-dos "~" "/_emacs" windows-nt "~/_emacs" vax-vms "sys$login:.emacs" "/.emacs" user-init-file load t inhibit-default-init nil inhibit-startup-message "default"] 5] inner debug-on-error (byte-code " ˆÁÁ‡" [inner nil init-file-had-error] 1) ((error (byte-code "ÀÁ\n@ÃN\nAƒÄ‚ÅÆÇ\nAÈ#$ˆÉ\nÀ‡" [message "Error in init file: %s%s%s" error error-message ": " "" mapconcat prin1-to-string ", " t init-file-had-error] 8))) user-mail-address "@" mail-host-address system-name after-init-hook get-buffer "*scratch*" major-mode fundamental-mode initial-major-mode term-file-prefix "TERM" hyphend term "[-_][^-_]+$" command-line-1 kill-emacs] 5]) (defalias 'command-line-1 #[(command-line-args-left) "„5Á „5\n„5 ƒ#ÄÅ!ÇÈÉÊ!ˆ)„5ËÌÍ!Î=ƒ0Ï‚3ÐÑ!!ˆ„Z?…Y?…YÔ Õ˜…YÁ ?…Xƒ[×Ö!ˆÇØÙ!ƒgÙ ˆƒp×Ú!ˆÇÜ=„Ý=ƒ„Þ ˆß áŽâ 㱈Ìä!å=ƒ½Ìæ!ç=ƒ½Ìè!é=ƒ½Ìê!ë=ƒ½Ìì!í=ƒ½îcˆ‚ØÐïðñåÇß#‰2ƒÒó2!‚Óô)\"!cˆõö ž„òÌ÷!ø=ƒíùcˆ‚òÐú!cˆ;ü>„þƒýcˆþÿÇ@ß$ƒABC±ˆÌD!E=ƒDÌF!G=ƒDÌH!I=ƒDJcˆ‚KÐK!cˆLÇ!ˆMN!)‡\nƒfMO!ˆPQÇQRSTUƒ9@‰VWXYZ[\\\"\"]Ç^Ç_Ç`ÇabcAdeV\"ƒÌVQ•ÇO_VQ‰•SOVfV]\"‰`ß=ƒèVgÇOV‚`;ƒh`]\"‰i„jkV\"ˆi@gÇOV)‚Ç_WVhV\\\"‰^ƒJ_ƒ@_B^AV!ˆ)‚4^AV!ˆ‚4Vl˜„eVm˜„eVn˜ƒž_ƒuo_!^‚ƒo@!^Ap^K!ƒ—q^!ˆ‚4^ ˆ‚4Vr˜ƒË_ƒ³_^‚½@^Ast^!!ˆ‚4Vu˜„ÝVv˜ƒ\f_ƒé_^‚ó@^Aw^!aBaXaŸc\"b‚4Vx˜„Vy˜ƒZ_ƒ*_^‚4@^A^z{wz!!ƒMwz!z|zÇß#ˆ)‚4V}˜ƒ‘_ƒo_^‚y@^A^;„‡j~!ˆ^!ˆ‚4V€˜ƒ£ß!ˆ‚4d‚V\"ƒºƒV!R‚4„Ç…‰†ƒØ†@ ‰…„؆A‰†„Å…„3d‡V\"ƒójˆV\"ˆTT‰TgUƒ‰wVU\"!S‚ŠwVU\"!ˆ‹R!„.ŒR!ˆQR*.‚wTOV…WS!†WŽg!ˆ ,‡" [noninteractive input-pending-p init-file-had-error inhibit-startup-echo-area-message get-buffer-create " *temp*" buffer nil (byte-code "ŠqˆÁ\n!ˆÃÄÅÆÇɘƒÊ ‚!!ËRÌÍ#)‡" [buffer insert-file-contents user-init-file re-search-forward "([ \n]*setq[ \n]+" "inhibit-startup-echo-area-message[ \n]+" regexp-quote prin1-to-string init-file-user "" user-login-name "[ \n]*)" nil t] 7) ((error)) kill-buffer message key-binding "" describe-project "For information about the GNU Project and its goals, type C-h C-p." substitute-command-keys "For information about the GNU Project and its goals, type \\[describe-project]." command-line-args-left inhibit-startup-message buffer-name "*scratch*" term-setup-hook run-hooks fboundp frame-notice-user-settings window-setup-hook window-system x win32 precompute-menubar-bindings t menubar-bindings-done ((byte-code "ŠÀÁ!qˆÂ ˆÃÄ!ˆ)ć" [get-buffer "*scratch*" erase-buffer set-buffer-modified-p nil] 2)) emacs-version "\nCopyright (C) 1995 Free Software Foundation, Inc." "" help-command "u" advertised-undo "" save-buffers-kill-emacs "t" help-with-tutorial "i" info "\n\nType C-h for help; C-x u to undo changes. (`C-' means use CTRL key.)\nTo kill the Emacs job, type C-x C-c.\nType C-h t for a tutorial on using Emacs.\nType C-h i to enter Info, which you can use to read GNU documentation." format "\n\nType %s for help; \\[advertised-undo] to undo changes. (`C-' means use CTRL key.)\nTo kill the Emacs job, type \\[save-buffers-kill-emacs].\nType \\[help-with-tutorial] for a tutorial on using Emacs.\nType \\[info] to enter Info, which you can use to read GNU documentation." where-is-internal where key-description "M-x help" display frame-parameters "à" tmm-menubar "\n\nType F10, ESC ` or Meta-` to use the menu bar." "\n\nType \\[tmm-menubar] to use the menu bar." system-type (msdos windowsnt) "\n\nC-mouse-3 (third mouse button, with Control) gets a mode-specific menu." directory-files "~/" "\\`\\.saves-" "\n\nIf an Emacs session crashed recently,\n" "type M-x recover-session RET to recover" " the files you were editing." "" describe-copying "" describe-distribution "" describe-no-warranty "\n\nGNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.\nYou may give out copies of Emacs; type C-h C-c to see the conditions.\nType C-h C-d for information on getting the latest version." "\n\nGNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.\nYou may give out copies of Emacs; type \\[describe-copying] to see the conditions.\nType \\[describe-distribution] for information on getting the latest version." set-buffer-modified-p sit-for 120 2 command-line-default-directory 0 line first-file-buffer file-count dir argi orig-argi append (("--funcall") ("--load") ("--insert") ("--kill") ("--directory") ("--eval")) mapcar #[(elt) "À @PC‡" ["-" elt] 2] command-switch-alist longopts tem argval completion extra-load-path load-path initial-load-path string-match "^--[^=]*=" try-completion 1 assoc elt error "Option `%s' is ambiguous" "-f" "-funcall" "-e" intern arrayp command-execute "-eval" eval read "-L" "-directory" expand-file-name "-l" "-load" file file-exists-p load "-insert" "File name omitted from `-insert' option" insert-file-contents "-kill" kill-emacs "^\\+[0-9]+\\'" string-to-int command-line-functions did-hook hooks "\\`-" "Unknown option `%s'" find-file find-file-other-window zerop goto-line get-buffer-window other-window buffer-menu] 8]) emacs-19.30/lisp/studly.elc100666 13437 1 2226 5744577411 14242 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:51:36 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/studly.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/studly.el' was compiled for Emacs 19")) #@26 Studlify-case the region (defalias 'studlify-region #[(begin end) "Šbˆ`` X…–ÂÃ!?…–ÄvˆÅÄ!ˆ`]ÄvˆÆ` ^Ç \nbˆ` WƒB\ng\\\nÄuˆ‚/\ng\\\nbˆ` Wƒg‰\n\\˦ÌUƒŠg‰ ÎYƒp ÏX†{ ÐY…{ ÑX)ƒŠÒÄ!ˆÓÔ\"cˆÄuˆ‚K`+‚)‡" [begin end looking-at "\\W*\\'" 1 backward-word 0 nil c word-end offset 4 2 ch 97 122 65 90 delete-char logxor 32] 4 (#$ . 481) "*r"]) #@69 Studlify-case the current word, or COUNT words if given an argument (defalias 'studlify-word #[(count) "`À‰‰ vˆ`\f ^\f ]Æ\n \",‡" [nil re rb end begin count studlify-region] 4 (#$ . 853) "*p"]) #@34 Studlify-case the current buffer (defalias 'studlify-buffer #[nil "Àed\"‡" [studlify-region] 3 (#$ . 1060) "*"]) emacs-19.30/lisp/subr.elc100666 75424 12 54473 6035376220 13641 0ustar kwzhstaff;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Oct 7 00:05:15 1995 ;;; from file /home/fsf/rms/e19/lisp/subr.el ;;; emacs version 19.29.15. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`subr.el' was compiled for Emacs 19.29 or later")) #@702 Return a lambda expression. A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is self-quoting; the result of evaluating the lambda expression is the expression itself. The lambda expression may then be treated as a function, i.e., stored as the function value of a symbol, passed to funcall or mapcar, etc. ARGS should take the same form as an argument list for a `defun'. DOCSTRING is an optional documentation string. If present, it should describe how to call the function. But documentation strings are usually not useful in nameless functions. INTERACTIVE should be a call to the function `interactive', which see. It may also be omitted. BODY should be a list of lisp expressions. (defalias 'lambda '(macro . #[(&rest cdr) "ÀÁ\nBD‡" [function lambda cdr] 3 (#$ . 468)])) (defalias 'undefined #[nil "À ‡" [ding] 1 nil nil]) (put (quote undefined) (quote suppress-keymap) t) #@218 Make MAP override all normally self-inserting keys to be undefined. Normally, as an exception, digits and minus-sign are set to make prefix args, but optional second arg NODIGITS non-nil treats them like other chars. (defalias 'suppress-keymap #[(map &optional nodigits) "ÀÁ \f$ˆ †0ÆÈ ÉÊ#ˆËËÌX…/È Í!Î#ˆT‰‚)‡" [substitute-key-definition self-insert-command undefined map global-map nodigits nil loop define-key "-" negative-argument 48 57 char-to-string digit-argument] 6 (#$ . 1368)]) #@47 Used internally by substitute-key-definition. (defvar key-substitution-in-progress nil (#$ . 1874)) #@276 Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. In other words, OLDDEF is replaced with NEWDEF where ever it appears. If optional fourth argument OLDMAP is specified, we redefine in KEYMAP as NEWDEF those chars which are defined as OLDDEF in OLDMAP. (defalias 'substitute-key-definition #[(olddef newdef keymap &optional oldmap prefix) "„Á\n† ÅÆ!È\" \f\nB\n\f:…©\f@:ƒÕ\f@@\f@A \fÍ\fIˆ G\fIˆÆ‰ ¢;ƒ` @B A‰ ‚J :ƒr @:ƒr A  ‰9ƒ‹Ð!ƒ‹K‰‚w =ƒ¢Ò  Ÿ¤#ˆ‚ÑÔ !ƒÑÕ  \"‰?†¹Ô!)ƒÑ\n>„Ñ×  %ˆ,‚¢Ø\f@!ƒ¢\f@‰GÍÍWƒ¡H \fÍ\fIˆ G\fIˆÆ‰ ¢;ƒ& @B A‰ ‚ :ƒ8 @:ƒ8 A  ‰9ƒQÐ!ƒQK‰‚= =ƒhÒ  Ÿ¤#ˆ‚—Ô !ƒ—Õ  \"‰?†Ô!)ƒ—\n>„—×  %ˆ,T‰‚è+\fA‰‚,‡" [prefix "" oldmap keymap scan vector nil vec1 vconcat prefix1 key-substitution-in-progress defn char 0 skipped inner-def fboundp olddef define-key newdef keymapp lookup-key elt substitute-key-definition arrayp array len i] 7 (#$ . 1981)]) #@377 Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding. This is like `define-key' except that the binding for KEY is placed 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--that is to say, it must be a string or vector of length 1. (defalias 'define-key-after #[(keymap key definition after) "À !„ ÂÃÀ D\"ˆ\fGÅVƒÆÇ!ˆ ȉ\fÉH\n \f \f?…† …† A@¢\n=ƒC ‰AA¡ˆ @¢=„\\ A@Á=„\\ A„~ A@Á=ƒhÏ\f „{ \fÉHB AB¡ˆÏ  A ‚&,‡" [keymapp keymap signal wrong-type-argument key 1 error "multi-event key specified in `define-key-after'" nil 0 first inserted done tail after t definition] 5 (#$ . 3040)]) #@147 Translate character FROM to TO at a low level. This function creates a `keyboard-translate-table' if necessary and then modifies one entry in it. (defalias 'keyboard-translate #[(from to) "À !„ GV„\f GVƒ: G ÆÇ ZÈ\"P ÇWƒ6 ‰Iˆ T‰‚$ * \fI‡" [arrayp keyboard-translate-table "" from to i make-string 256 0 table] 5 (#$ . 3805)]) #@148 Default global keymap mapping Emacs keyboard input into commands. The value is a keymap which is usually (but not necessarily) Emacs's global map. (defvar global-map nil (#$ . 4156)) #@117 Default keymap for ESC (meta) commands. The normal global definition of the character ESC indirects to this keymap. (defvar esc-map nil (#$ . 4346)) #@110 Default keymap for C-x commands. The normal global definition of the character C-x indirects to this keymap. (defvar ctl-x-map nil (#$ . 4502)) #@33 Keymap for subcommands of C-x 4 (defvar ctl-x-4-map (make-sparse-keymap) (#$ . 4652)) (byte-code "ÀÁ\n\"ˆÃ\fÅÁ#‡" [defalias ctl-x-4-prefix ctl-x-4-map define-key ctl-x-map "4"] 4) #@28 Keymap for frame commands. (defvar ctl-x-5-map (make-sparse-keymap) (#$ . 4838)) (byte-code "ÀÁ\n\"ˆÃ\fÅÁ#ˆÆÇÈ!É\"\nÊ B À‡" [defalias ctl-x-5-prefix ctl-x-5-map define-key ctl-x-map "5" logior read "?\\M-\\^@" 128 listify-key-sequence-1 current-load-list] 4) #@45 Convert a key sequence to a list of events. (defalias 'listify-key-sequence #[(key) "À !ƒ  Ã\"‡ÄÅ Ã\"\"‡" [vectorp key append nil mapcar #[(c) "ÁVƒ  \"‡‡" [c 127 logxor listify-key-sequence-1] 3]] 5 (#$ . 5106)]) #@42 True if the argument is an event object. (defalias 'eventp #[(obj) "¨†9ƒÁN†:…@9…@ÁN‡" [obj event-symbol-elements] 2 (#$ . 5333)]) (put (quote eventp) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@213 Returns a list of symbols representing the modifier keys in event EVENT. The elements of the list may include `meta', `control', `shift', `hyper', `super', `alt', `click', `double', `triple', `drag', and `down'. (defalias 'event-modifiers #[(event) "‰<ƒ\n @ 9ƒ ÂNA‚~ÃÅÆ Ç\"!„%È\fBÅÆ É\"!ƒ7Æ Ê\"ËY„;Ì\fBÅÆ Í\"!ƒQÆ Î\"Æ Î\"—U„UÏ\fBÅÆ Ð\"!„bÑ\fBÅÆ Ò\"!„oÓ\fBÅÆ Ô\"!„|Õ\fB\f))‡" [event type event-symbol-elements nil list zerop logand -134217728 meta 67108864 127 32 control 33554432 255 shift 16777216 hyper 8388608 super 4194304 alt] 5 (#$ . 5565)]) #@139 Returns the basic type of the given event (all modifiers removed). The value is an ASCII printing character (not upper case) or a symbol. (defalias 'event-basic-type #[(event) ":ƒ@9ƒÁN@‡ÂÃÄÅ\"S\"‰ÇWƒ*ÈÉ\"‚,—)‡" [event event-symbol-elements logand lsh 1 18 base 32 logior 64] 6 (#$ . 6142)]) #@53 Return non-nil if OBJECT is a mouse movement event. (defalias 'mouse-movement-p #[(object) ":… @Á=‡" [object mouse-movement] 2 (#$ . 6457)]) (put (quote mouse-movement-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@318 Return the starting position of EVENT. If EVENT is a mouse press or a mouse click, this returns the location of the event. If EVENT is a drag, this returns the drag's starting position. The return value is of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) The `posn-' functions access elements of such lists. (defalias 'event-start #[(event) "A@‡" [event] 1 (#$ . 6697)]) (put (quote event-start) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@280 Return the ending location of EVENT. EVENT should be a click or drag event. If EVENT is a click event, this function is the same as `event-start'. The return value is of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) The `posn-' functions access elements of such lists. (defalias 'event-end #[(event) "À 8:ƒ À‚\f 8‡" [2 event 1] 2 (#$ . 7169)]) (put (quote event-end) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@103 Return the multi-click count of EVENT, a click or drag event. The return value is a positive integer. (defalias 'event-click-count #[(event) "À 8¨ƒ À 8‡Â‡" [2 event 1] 2 (#$ . 7615)]) (put (quote event-click-count) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@176 Return the window in POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) as returned by the `event-start' and `event-end' functions. (defalias 'posn-window #[(position) "@‡" [position] 1 (#$ . 7897)]) (put (quote posn-window) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@185 Return the buffer location in POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) as returned by the `event-start' and `event-end' functions. (defalias 'posn-point #[(position) "A@:ƒ\fA@@‡A@‡" [position] 1 (#$ . 8232)]) (put (quote posn-point) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@189 Return the x and y coordinates in POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) as returned by the `event-start' and `event-end' functions. (defalias 'posn-x-y #[(position) "À 8‡" [2 position] 2 (#$ . 8588)]) (put (quote posn-x-y) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@337 Return the column and row in POSITION, measured in characters. POSITION should be a list of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) as returned by the `event-start' and `event-end' functions. For a scroll-bar event, the result column is 0, and the row corresponds to the vertical position of the click in the scroll bar. (defalias 'posn-col-row #[(position) "À 8 ‰@) A@:ƒ A@@‚ A@Ä=ƒ,ÅÆ Ç\n!S\"B‚t A@:ƒ: A@@‚= A@È=ƒMÆ É\n!\"ÅB‚tÊ\n!ƒW\n‚ZË\n!\f @Í\f!¥ AÏ\f!¥+B*‡" [2 position window pair vertical-scroll-bar 0 scroll-bar-scale window-height horizontal-scroll-bar window-width framep window-frame frame frame-char-width x frame-char-height y] 6 (#$ . 8933)]) #@179 Return the timestamp of POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) as returned by the `event-start' and `event-end' functions. (defalias 'posn-timestamp #[(position) "À 8‡" [3 position] 2 (#$ . 9638)]) (byte-code "ÀÁÂÃ#ˆÄÅÆ\"ˆÄÇÈ\"ˆÄÉÊ\"ˆÄËÌ\"ˆÄÍÎ\"ˆÄÏÐ\"ˆÄÑÒ\"ˆÄÓÔ\"ˆÄÕÖ\"ˆÄ×Ø\"ˆÄÙÚ\"ˆÄÛÜ\"ˆÄÝÞ\"‡" [put posn-timestamp byte-optimizer byte-compile-inline-expand defalias dot point dot-marker point-marker dot-min point-min dot-max point-max window-dot window-point set-window-dot set-window-point read-input read-string send-string process-send-string send-region process-send-region show-buffer set-window-buffer buffer-flush-undo buffer-disable-undo eval-current-buffer eval-buffer compiled-function-p byte-code-function-p] 4) #@139 Obsolete function returning the value of the `baud-rate' variable. Please convert your programs to use the variable `baud-rate' directly. (defalias 'baud-rate #[nil "‡" [baud-rate] 1 (#$ . 10425)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖK\"ˆÀ×ØK\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"‡" [defalias string= string-equal string< string-lessp move-marker set-marker eql eq not null rplaca setcar rplacd setcdr beep ding indent-to-column indent-to backward-delete-char delete-backward-char search-forward-regexp re-search-forward search-backward-regexp re-search-backward int-to-string number-to-string set-match-data store-match-data string-to-int string-to-number] 3) #@137 Variable by which C primitives find the function `run-hooks'. Don't change it. Don't use it either; use the hook running C primitives. (defconst run-hooks (quote run-hooks) (#$ . 11115)) #@748 Make the hook HOOK local to the current buffer. When a hook is local, its local and global values work in concert: running the hook actually runs all the hook functions listed in *either* the local value *or* the global value of the hook variable. This function works by making `t' a member of the buffer-local value, which acts as a flag to run the hook functions in the default value as well. This works for all normal hooks, but does not work for most non-normal hooks yet. We will be changing the callers of non-normal hooks so that they can handle localness; this has to be done one by one. This function does nothing if HOOK is already local in the current buffer. Do not use `make-local-variable' to make a hook variable buffer-local. (defalias 'make-local-hook #[(hook) "À !?… !„ ÃLˆÄ !ˆ ÅCL‡" [local-variable-p hook boundp nil make-local-variable t] 2 (#$ . 11310)]) #@714 Add to the value of HOOK the function FUNCTION. FUNCTION is not added if already present. FUNCTION is added (if necessary) at the beginning of the hook list unless the optional argument APPEND is non-nil, in which case FUNCTION is added at the end. The optional fourth argument, LOCAL, if non-nil, says to modify the hook's buffer-local value rather than its default value. This makes no difference if the hook is not buffer-local. To make a hook variable buffer-local, always use `make-local-hook', not `make-local-variable'. HOOK should be a symbol, and FUNCTION may be any valid function. If HOOK is void, it is first set to nil. If HOOK's value is a single function, it is changed to a list of functions. (defalias 'add-hook #[(hook function &optional append local) "À !„\n ÂLˆÃ !„Ä Â\"ˆ J‰<ƒ$ @Æ=ƒ) CLˆ)„<È !ƒiÉ J>„i\n:ƒJ\n J‚O\n J>†š  ƒbË J\nC\"‚g\n JBL‡\n:ƒx\nÌ !‚~\nÌ !>†šÄ  ƒ“ËÌ !\nC\"‚™\nÌ !B\"‡" [boundp hook nil default-boundp set-default old lambda local local-variable-if-set-p t function append default-value] 6 (#$ . 12203)]) #@542 Remove from the value of HOOK the function FUNCTION. HOOK should be a symbol, and FUNCTION may be any valid function. If FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the list of hooks to run in HOOK, then nothing is done. See `add-hook'. The optional third argument, LOCAL, if non-nil, says to modify the hook's buffer-local value rather than its default value. This makes no difference if the hook is not buffer-local. To make a hook variable buffer-local, always use `make-local-hook', not `make-local-variable'. (defalias 'remove-hook #[(hook function &optional local) "À !?†ÂÁ!?† J?† ??…„\f„+Å !ƒWÆ J>„W J‰:ƒG ƒQÈ É!\"‚Q šƒQÊ L)‡Ë !‰:ƒt ƒ~È É!\"‚~ šƒ~ÊÌ \")‡" [boundp hook default-boundp function local local-variable-p t hook-value delete copy-sequence nil default-value set-default] 5 (#$ . 13292)]) #@403 Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. If you want to use `add-to-list' on a variable that is not defined until a certain package is loaded, you should put the call to `add-to-list' into a hook function that will be run only after loading the package. `eval-after-load' provides one way to do this. In some cases other hooks, such as major mode hooks, can do the job. (defalias 'add-to-list #[(list-var element) " J†  JBL‡" [element list-var] 3 (#$ . 14179)]) #@295 Arrange that, if FILE is ever loaded, FORM will be run at that time. This makes or adds to an entry on `after-load-alist'. If FILE is already loaded, evaluate FORM right now. It does nothing if FORM is already on the list for FILE. FILE should be the name of a library, with no directory name. (defalias 'eval-after-load #[(file form) "À \n\"„\f C\nBÀ \n\"\f A„( \fC¤ˆÀ \"ƒ(Æ\f!ˆ)\f‡" [assoc file after-load-alist elt form load-history eval] 3 (#$ . 14685)]) #@184 Read the following input sexp, and run it whenever FILE is loaded. This makes or adds to an entry on `after-load-alist'. FILE should be the name of a library, with no directory name. (defalias 'eval-next-after-load #[(file) "À  \"‡" [eval-after-load file read] 3 (#$ . 15158)]) #@270 Like `read-char', except that if the first character read is an octal digit, we read up to two more octal digits and return the character represented by the octal number consisting of those digits. Optional argument PROMPT specifies a string to use to prompt the user. (defalias 'read-quoted-char #[(&optional prompt) "ÀÁ‰À\fÆWƒw\fÁUÀÇ \n ƒ$ÌÍ \"ˆÎ \nƒ/À+\nƒÐ\nXƒ_\nÑXƒ_ Ò_\nÐZ\\\fT ƒÌÓÔ \n#‰ !ˆ‚\fÁVƒo\nCÖ‰‚ \nÖ‰‚ ×Ø Ù\"ÁU„…Ú‚†ÁØ Û\"\",‡" [nil 0 char code count message-log-max 3 "Type the special character you want to use,\nor three octal digits representing its character code." help-form help-char inhibit-quit prompt message "%s-" read-char quit-flag 48 55 8 format "%s %c" unread-command-events 259 logior logand -134217728 128 255] 6 (#$ . 15444)]) #@124 Force the mode-line of the current buffer to be redisplayed. With optional non-nil ALL, force redisplay of all mode-lines. (defalias 'force-mode-line-update #[(&optional all) "ƒ\nŠÁ qˆ)Âà !‡" [all other-buffer set-buffer-modified-p buffer-modified-p] 2 (#$ . 16248)]) #@375 Momentarily display STRING in the buffer at POS. Display remains until next character is typed. If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed; otherwise it is then available as input (as a command if nothing else). Display MESSAGE (optional fourth arg) in the echo area. If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there. (defalias 'momentary-string-display #[(string pos &optional exit-char message) "„ÁÂÃÄ Â \nËŽŠ\fbˆÂÍ!ˆ`Ï Vƒ6ÐÑ Ò¥!ˆÓÔ!ˆ`\fVƒI\fbˆÐÔ!ˆ)Õ†QÖ×!\"ˆØ ‰=†fC‰.‡" [exit-char 32 nil t buffer-modified-p buffer-file-name insert-end name modified buffer-undo-list buffer-read-only ((byte-code "ƒ\nŠ |ˆ)\nÄ !‡" [insert-end pos name buffer-file-name set-buffer-modified-p modified] 2)) pos insert-before-markers string window-end recenter window-height 2 move-to-window-line 0 message "Type %s to continue editing." single-key-description read-event char unread-command-events] 6 (#$ . 16525)]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp font-lock-defaults nil current-load-list] 2) #@218 Non-nil if the visited file is a binary file. This variable is meaningful on MS-DOG and Windows NT. On those systems, it is automatically local in every buffer. On other systems, this variable is normally always nil. (defvar buffer-file-type nil (#$ . 17609)) #@93 Do nothing and return nil. This function accepts any number of arguments, but ignores them. (defalias 'ignore #[(&rest ignore) "À‡" [nil] 1 (#$ . 17875) nil]) #@72 Signal an error, making error message by passing all args to `format'. (defalias 'error #[(&rest args) "ÀÁÂÃ\f\"C\"ˆ‚" [signal error apply format args] 5 (#$ . 18040)]) (defalias (quote user-original-login-name) (quote user-login-name)) #@641 Start a program in a subprocess. Return the process object for it. Args are NAME BUFFER COMMAND &rest COMMAND-ARGS. NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer or (buffer-name) to associate with the process. Process output goes at end of that buffer, unless you specify an output stream or filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated with any buffer Third arg is command name, the name of a shell command. Remaining arguments are the arguments for the command. Wildcards and redirection are handled as usual in the shell. (defalias 'start-process-shell-command #[(name buffer &rest args) "Á=ƒÂÃ\f $‡Ã\f ÉÊË#%‡" [system-type vax-vms apply start-process name buffer args shell-file-name shell-command-switch mapconcat identity " "] 9 (#$ . 18286)]) #@71 Execute the BODY forms, restoring the global value of the match data. (defalias 'save-match-data '(macro . #[(&rest body) "ÀÁ!Ã\nÄDCÅÆBÈ\nDEE)‡" [make-symbol "match-data" original let (match-data) unwind-protect progn body store-match-data] 6 (#$ . 19168)])) #@336 Return string of text matched by last search. NUM specifies which parenthesized expression in the last regexp. Value is nil if NUMth pair didn't match, or there were less than NUM pairs. Zero means the entire text matched by the whole regexp or whole string. STRING should be given if the last search was by `string-match' on STRING. (defalias 'match-string #[(num &optional string) "”… ƒ ”•O‡”•{‡" [num string] 3 (#$ . 19437)]) #@72 Return the text from BEG to END, without text properties, as a string. (defalias 'buffer-substring-no-properties #[(beg end) " {ÃÄ\nGÅ\n$ˆ\n)‡" [beg end string set-text-properties 0 nil] 5 (#$ . 19882)]) #@65 Quote an argument for passing as argument to an inferior shell. (defalias 'shell-quote-argument #[(argument) "Á=ƒ\n‡Ã=ƒÄ\nÄQ‡ÅÆÇ \nËÌ\n #ƒCÆ”\n\n OÍ\n‰TOR\nT ‚\n\n ÇOP+‡" [system-type ms-dos argument windows-nt "\"" "" 0 nil end start result string-match "[^-0-9a-zA-Z_./]" "\\"] 6 (#$ . 20094)]) #@167 Return a new syntax table. It inherits all letters and control characters from the standard syntax table; other characters are copied from the standard syntax table. (defalias 'make-syntax-table #[(&optional oldtable) "ƒÁ!‡Á ÂÅÅÆXƒ!\f ÂIˆ T‰‚ÇÇÈXƒ5\f ÂIˆ T‰‚$ÉÉÊXƒI\f ÂIˆ T‰‚8ËËÌXƒ]\f ÂIˆ T‰‚L\f*‡" [oldtable copy-syntax-table nil i table 0 31 65 90 97 122 128 255] 4 (#$ . 20426)]) #@398 Give KEY a global binding as COMMAND. COMMAND is a symbol naming an interactively-callable function. KEY is a key sequence (a string or vector of characters or event types). Non-ASCII characters with codes above 127 (such as ISO Latin-1) can be included if you use a vector. Note that if KEY has a local binding in the current buffer that local binding will continue to shadow any global binding. (defalias 'global-set-key #[(key command) "À !„ ;„ÂÃÄ D\"ˆÅÆ #ˆÈ‡" [vectorp key signal wrong-type-argument arrayp define-key current-global-map command nil] 4 (#$ . 20839) "KSet key globally: \nCSet key %s to command: "]) #@404 Give KEY a local binding as COMMAND. COMMAND is a symbol naming an interactively-callable function. KEY is a key sequence (a string or vector of characters or event types). Non-ASCII characters with codes above 127 (such as ISO Latin-1) can be included if you use a vector. The binding goes in the current buffer's local map, which in most cases is shared with all other buffers in the same major mode. (defalias 'local-set-key #[(key command) "À ‰„Âà ‰!ˆÄ !„ ;„ ÆÇÈ D\"ˆÉ \n#ˆ)ˇ" [current-local-map map use-local-map make-sparse-keymap vectorp key signal wrong-type-argument arrayp define-key command nil] 5 (#$ . 21472) "KSet key locally: \nCSet key %s locally to command: "]) #@86 Remove global binding of KEY. KEY is a string representing a sequence of keystrokes. (defalias 'global-unset-key #[(key) "À Â\"‡" [global-set-key key nil] 3 (#$ . 22167) "kUnset key globally: "]) #@85 Remove local binding of KEY. KEY is a string representing a sequence of keystrokes. (defalias 'local-unset-key #[(key) "À ƒ\nÁ\nÃ\"ˆÃ‡" [current-local-map local-set-key key nil] 3 (#$ . 22369) "kUnset key locally: "]) #@145 Return non-nil if OBJECT seems to be a frame configuration. Any list whose car is `frame-configuration' is assumed to be a frame configuration. (defalias 'frame-configuration-p #[(object) ":… @Á=‡" [object frame-configuration] 2 (#$ . 22595)]) emacs-19.30/lisp/supercite.elc100666 12120 1 150110 6014175410 14601 0ustar rmsdaemon;ELC ;;; compiled by kwzh@nutrimat.gnu.ai.mit.edu on Tue Aug 15 15:52:15 1995 ;;; from file /home/gd/gnu/emacs/19.0/lisp/supercite.el ;;; emacs version 19.29.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`supercite.el' was compiled for Emacs 19.29 or later")) (require (quote regi)) #@73 *If non-nil, automatically fill each paragraph after it has been cited. (defvar sc-auto-fill-region-p t (#$ . -510)) #@136 *Number of blank lines to leave after mail headers have been nuked. Set to nil, to use whatever blank lines happen to occur naturally. (defvar sc-blank-lines-after-headers 1 (#$ . -634)) #@46 *String comprising first part of a citation. (defvar sc-citation-leader " " (#$ . -827)) #@107 *String comprising third part of a citation. This string is used in both nested and non-nested citations. (defvar sc-citation-delimiter ">" (#$ . -926)) #@56 *String comprising fourth and last part of a citation. (defvar sc-citation-separator " " (#$ . -1085)) #@100 *Regexp describing citation leader for a cited line. This should NOT have a leading `^' character. (defvar sc-citation-leader-regexp "[ ]*" (#$ . -1195)) #@164 *Regexp describing variable root part of a citation for a cited line. This should NOT have a leading `^' character. See also `sc-citation-nonnested-root-regexp'. (defvar sc-citation-root-regexp "[-._a-zA-Z0-9]*" (#$ . -1357)) #@300 *Regexp describing the variable root part of a nested citation. This should NOT have a leading `^' character. This variable is related to `sc-citation-root-regexp' but where as that varariable describes both nested and non-nested citation roots, this variable describes only nested citation roots. (defvar sc-citation-nonnested-root-regexp "[-._a-zA-Z0-9]+" (#$ . -1591)) #@103 *Regexp describing citation delimiter for a cited line. This should NOT have a leading `^' character. (defvar sc-citation-delimiter-regexp "[>]+" (#$ . -1971)) #@103 *Regexp describing citation separator for a cited line. This should NOT have a leading `^' character. (defvar sc-citation-separator-regexp "[ ]*" (#$ . -2138)) #@45 *If non-nil, put a citation on blank lines. (defvar sc-cite-blank-lines-p nil (#$ . -2305)) #@360 *Alist for frame selection during citing. Each element of this list has the following form: (INFOKEY ((REGEXP . FRAME) (REGEXP . FRAME) (...))) Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular expression to match against the INFOKEY's value. FRAME is a citation frame, or a variable containing a citation frame. (defvar sc-cite-frame-alist nil (#$ . -2404)) #@97 *Alist for frame selection during unciting. See the variable `sc-cite-frame-alist' for details. (defvar sc-uncite-frame-alist nil (#$ . -2815)) #@97 *Alist for frame selection during reciting. See the variable `sc-cite-frame-alist' for details. (defvar sc-recite-frame-alist nil (#$ . -2965)) #@42 *Default REGI frame for citing a region. (defvar sc-default-cite-frame (quote ((begin (progn (sc-fill-if-different) (setq sc-tmp-nested-regexp (sc-cite-regexp "") sc-tmp-nonnested-regexp (sc-cite-regexp) sc-tmp-dumb-regexp (concat "\\(" (sc-cite-regexp "") "\\)" (sc-cite-regexp sc-citation-nonnested-root-regexp))))) ("^[ ]*$" (if sc-cite-blank-lines-p (sc-cite-line) (sc-fill-if-different ""))) (sc-reference-tag-string (if (string= sc-reference-tag-string "") (list (quote continue)) nil)) (sc-tmp-dumb-regexp (sc-cite-coerce-dumb-citer)) (sc-tmp-nested-regexp (sc-add-citation-level)) (sc-tmp-nonnested-regexp (sc-cite-coerce-cited-line)) (sc-nested-citation-p (sc-add-citation-level)) (t (sc-cite-line)) (end (sc-fill-if-different "")))) (#$ . -3115)) #@44 *Default REGI frame for unciting a region. (defvar sc-default-uncite-frame (quote (("^[ ]*$" nil) ((sc-cite-regexp) (sc-uncite-line)))) (#$ . -3879)) #@44 *Default REGI frame for reciting a region. (defvar sc-default-recite-frame (quote ((begin (sc-fill-if-different)) ("^[ ]*$" nil) ((sc-cite-regexp) (sc-recite-line (sc-cite-regexp))) (t (sc-cite-line)) (end (sc-fill-if-different "")))) (#$ . -4036)) #@712 *This variable controls automatic citation of yanked text. Legal values are: non-nil -- cite the entire region, regardless of its size nil -- do not cite the region at all -- a number indicating the threshold for citation. When the number of lines in the region is greater than this value, a warning message will be printed and the region will not be cited. Lines in region are counted with `count-lines'. The gathering of attribution information is not affected by the value of this variable. The number of lines in the region is calculated *after* all mail headers are removed. This variable is only consulted during the initial citing via `sc-cite-original'. (defvar sc-cite-region-limit t (#$ . -4293)) #@73 *If non-nil, always confirm attribution string before citing text body. (defvar sc-confirm-always-p t (#$ . -5055)) #@62 *String used when author's attribution cannot be determined. (defvar sc-default-attribution "Anon" (#$ . -5177)) #@55 *String used when author's name cannot be determined. (defvar sc-default-author-name "Anonymous" (#$ . -5296)) #@63 *Non-nil means downcase the attribution and citation strings. (defvar sc-downcase-p nil (#$ . -5413)) #@53 *If non-nil, treat electric references as circular. (defvar sc-electric-circular-p t (#$ . -5521)) #@56 *Hook for `sc-electric-mode' electric references mode. (defvar sc-electric-mode-hook nil (#$ . -5626)) #@38 *Use electric references if non-nil. (defvar sc-electric-references-p nil (#$ . -5735)) #@60 *If non-nil, delete all leading white space before citing. (defvar sc-fixup-whitespace-p nil (#$ . -5829)) #@50 *Hook which gets run once after Supercite loads. (defvar sc-load-hook nil (#$ . -5942)) #@68 *Hook which gets run before each invocation of `sc-cite-original'. (defvar sc-pre-hook nil (#$ . -6036)) #@67 *Hook which gets run after each invocation of `sc-cite-original'. (defvar sc-post-hook nil (#$ . -6147)) #@48 *Warn if mail headers don't conform to RFC822. (defvar sc-mail-warn-if-non-rfc822-p t (#$ . -6258)) #@68 *Value returned by `sc-mail-field' if field isn't in mail headers. (defvar sc-mumble "" (#$ . -6364)) #@474 *Name list components which are filtered out as noise. This variable contains an association list where each element is of the form: (REGEXP . POSITION). REGEXP is a regular expression which matches the name list component. Match is performed using `string-match'. POSITION is the position in the name list which can match the regular expression, starting at zero for the first element. Use `last' to match the last element in the list and `any' to match all elements. (defvar sc-name-filter-alist (quote (("^\\(Mr\\|Mrs\\|Ms\\|Dr\\)[.]?$" . 0) ("^\\(Jr\\|Sr\\)[.]?$" . last) ("^ASTS$" . 0) ("^[I]+$" . last))) (#$ . -6473)) #@125 *Controls whether to use nested or non-nested citation style. Non-nil uses nested citations, nil uses non-nested citations. (defvar sc-nested-citation-p nil (#$ . -7109)) #@320 *Controls mail header nuking. Used in conjunction with `sc-nuke-mail-header-list'. Legal values are: `all' -- nuke all mail headers `none' -- don't nuke any mail headers `specified' -- nuke headers specified in `sc-nuke-mail-header-list' `keep' -- keep headers specified in `sc-nuke-mail-header-list' (defvar sc-nuke-mail-headers (quote all) (#$ . -7287)) #@200 *List of mail header regexps to remove or keep in body of reply. This list contains regular expressions describing the mail headers to keep or nuke, depending on the value of `sc-nuke-mail-headers'. (defvar sc-nuke-mail-header-list nil (#$ . -7668)) #@1741 *Specifies what to use as the attribution string. Supercite creates a list of possible attributions when it scans the mail headers from the original message. Each attribution choice is associated with a key in an attribution alist. Supercite tries to pick a "preferred" attribution by matching the attribution alist keys against the elements in `sc-preferred-attribution-list' in order. The first non-empty string value found is used as the preferred attribution. Note that Supercite now honors the X-Attribution: mail field. If present in the original message, the value of this field should always be used to select the most preferred attribution since it reflects how the original author would like to be distinguished. It should be considered bad taste to put any attribution preference key before "x-attribution" in this list, except perhaps for "sc-lastchoice" (see below). Supercite remembers the last attribution used when reciting an already cited paragraph. This attribution will always be saved with the "sc-lastchoice" key, which can be used in this list. Note that the last choice is always reset after every call of `sc-cite-original'. Barring error conditions, the following preferences are always present in the attribution alist: "emailname" -- email terminus name "initials" -- initials of author "firstname" -- first name of author "lastname" -- last name of author "middlename-1" -- first middle name of author "middlename-2" -- second middle name of author ... Middle name indexes can be any positive integer greater than 0, although it is unlikely that many authors will supply more than one middle name, if that many. The string of all middle names is associated with the key "middlenames". (defvar sc-preferred-attribution-list (quote ("sc-lastchoice" "x-attribution" "firstname" "initials" "lastname")) (#$ . -7926)) #@742 *An alist for selecting preferred attribution based on mail headers. Each element of this list has the following form: (INFOKEY ((REGEXP . ATTRIBUTION) (REGEXP . ATTRIBUTION) (...))) Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular expression to match against the INFOKEY's value. ATTRIBUTION can be a string or a list. If its a string, then it is the attribution that is selected by `sc-select-attribution'. If it is a list, it is `eval'd and the return value must be a string, which is used as the selected attribution. Note that the variable `sc-preferred-attribution-list' must contain an element of the string "sc-consult" for this variable to be consulted during attribution selection. (defvar sc-attrib-selection-list nil (#$ . -9801)) #@47 *Hook to run before selecting an attribution. (defvar sc-attribs-preselect-hook nil (#$ . -10599)) #@71 *Hook to run after selecting an attribution, but before confirmation. (defvar sc-attribs-postselect-hook nil (#$ . -10704)) #@46 *Hook to run before citing a region of text. (defvar sc-pre-cite-hook nil (#$ . -10834)) #@48 *Hook to run before unciting a region of text. (defvar sc-pre-uncite-hook nil (#$ . -10929)) #@48 *Hook to run before reciting a region of text. (defvar sc-pre-recite-hook nil (#$ . -11028)) #@125 *Index into `sc-rewrite-header-list' specifying preferred header style. Index zero accesses the first function in the list. (defvar sc-preferred-header-style 4 (#$ . -11128)) #@62 *String used at the beginning of built-in reference headers. (defvar sc-reference-tag-string ">>>>> " (#$ . -11309)) #@244 *List of reference header rewrite functions. The variable `sc-preferred-header-style' controls which function in this list is chosen for automatic reference header insertions. Electric reference mode will cycle through this list of functions. (defvar sc-rewrite-header-list (quote ((sc-no-header) (sc-header-on-said) (sc-header-inarticle-writes) (sc-header-regarding-adds) (sc-header-attributed-writes) (sc-header-author-writes) (sc-header-verbose) (sc-no-blank-line-or-header))) (#$ . -11433)) #@116 *Regular expression describing the separator between names and titles. Set to nil to treat entire field as a name. (defvar sc-titlecue-regexp "\\s +-+\\s +" (#$ . -11935)) #@220 *Controls what happens when the preferred attribution cannot be found. If non-nil, then `sc-default-attribution' will be used. If nil, then some secondary scheme will be employed to find a suitable attribution string. (defvar sc-use-only-preference-p nil (#$ . -12114)) #@27 Supercite version number. (defconst sc-version "3.1" (#$ . 12391)) #@47 Address accepting submissions of bug reports. (defconst sc-help-address "supercite-help@anthem.nlm.nih.gov" (#$ . 12464)) #@61 Alist of mail header information gleaned from reply buffer. (defvar sc-mail-info nil (#$ . 12592)) #@44 Alist of attributions for use when citing. (defvar sc-attributions nil (#$ . 12697)) #@150 A list describing what version of Emacs we're running on. Known flavors are: All GNU18's: (v18 GNU) FSF19.x : (v19 GNU) Lucid19.x : (v19 Lucid) (defconst sc-emacs-features (byte-code "ÀÁ\fÅÆOǘƒÈÉÊ\f\"ƒË \n*D‡" [v18 GNU flavor version emacs-version 0 2 "19" v19 string-match "Lucid" Lucid] 3) (#$ . 12789)) #@47 Temporary regepx describing nested citations. (defvar sc-tmp-nested-regexp nil (#$ . 13115)) #@51 Temporary regexp describing non-nested citations. (defvar sc-tmp-nonnested-regexp nil (#$ . 13214)) #@72 Temp regexp describing non-nested citation cited with a nesting citer. (defvar sc-tmp-dumb-regexp nil (#$ . 13320)) #@31 Supercite minor mode on flag. (defvar sc-minor-mode nil (#$ . 13442)) #@30 Supercite minor mode string. (defvar sc-mode-string " SC" (#$ . 13518)) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!‡" [make-variable-buffer-local sc-mail-info sc-attributions sc-minor-mode] 2) #@94 *Key binding to install Supercite keymap. If this is nil, Supercite keymap is not installed. (defvar sc-mode-map-prefix "" (#$ . -13697)) #@58 Keymap for sub-keymap of setting and toggling functions. (defvar sc-T-keymap nil (#$ . 13843)) (byte-code "„gÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆÂáÐ#ˆÁ‡" [sc-T-keymap make-sparse-keymap define-key "a" sc-S-preferred-attribution-list "b" sc-T-mail-nuke-blank-lines "c" sc-T-confirm-always "d" sc-T-downcase "e" sc-T-electric-references "f" sc-T-auto-fill-region "h" sc-T-describe "l" sc-S-cite-region-limit "n" sc-S-mail-nuke-mail-headers "N" sc-S-mail-header-nuke-list "o" sc-T-electric-circular "p" sc-S-preferred-header-style "s" sc-T-nested-citation "u" sc-T-use-only-preferences "w" sc-T-fixup-whitespace "?"] 4) #@34 Keymap for Supercite quasi-mode. (defvar sc-mode-map nil (#$ . 14526)) (byte-code "„\\Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙ#ˆÂÛÜ#ˆÂÝÊ#ˆÁ‡" [sc-mode-map make-sparse-keymap define-key "c" sc-cite-region "f" sc-mail-field-query "g" sc-mail-process-headers "h" sc-describe "i" sc-insert-citation "o" sc-open-line "r" sc-recite-region "" sc-raw-mode-toggle "u" sc-uncite-region "v" sc-version "w" sc-insert-reference "" sc-T-keymap "" sc-submit-bug-report "?"] 4) #@57 Keymap for `sc-electric-mode' electric references mode. (defvar sc-electric-mode-map nil (#$ . 15035)) (byte-code "„UÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÌ#ˆÂÎÏ#ˆÂÐÏ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÔ#ˆÂÖÔ#ˆÂ×Ô#ˆÁ‡" [sc-electric-mode-map make-sparse-keymap define-key "p" sc-eref-prev "n" sc-eref-next "s" sc-eref-setn "j" sc-eref-jump "x" sc-eref-abort "q" " " sc-eref-exit "\n" "g" sc-eref-goto "?" describe-mode "" [f1] [help]] 4) #@60 Keymap for minibuffer confirmation of attribution strings. (defvar sc-minibuffer-local-completion-map nil (#$ . 15464)) (byte-code "„Á\n!ÃÄÅ#ˆÃÆÇ#ˆÁ‡" [sc-minibuffer-local-completion-map copy-keymap minibuffer-local-completion-map define-key "" sc-toggle-fn " " self-insert-command] 4) #@60 Keymap for minibuffer confirmation of attribution strings. (defvar sc-minibuffer-local-map nil (#$ . 15763)) (byte-code "„Á\n!ÃÄÅ#ˆÁ‡" [sc-minibuffer-local-map copy-keymap minibuffer-local-map define-key "" sc-toggle-fn] 4) #@106 Compatibility between Emacs 18 and 19 `completing-read'. In version 18, the HISTORY argument is ignored. (defalias 'sc-completing-read #[(prompt table &optional predicate require-match initial-contents history) "À >ƒ \f &‡Â \f ¢†!%‡" [v19 sc-emacs-features completing-read prompt table predicate require-match initial-contents history] 7 (#$ . 16000)]) #@102 Compatibility between Emacs 18 and 19 `read-string'. In version 18, the HISTORY argument is ignored. (defalias 'sc-read-string #[(prompt &optional initial-contents history) "À >ƒ  \f\"‡Â \f\"‡" [v19 sc-emacs-features read-string prompt initial-contents] 3 (#$ . 16377)]) (byte-code "ÀÁ!ƒÂÃÁ\"ˆ‚ÃÄMˆÀÅ!ƒ ÂÆÅ\"ˆ‚$ÆÇMˆÀÈ!ƒ2ÂÉÈ\"ˆ‚6ÉÊMˆÀ‡" [fboundp match-string defalias sc-submatch #[(matchnum &optional string) "ƒ  ” •O‡ ” •{‡" [string matchnum] 3 "Returns `match-beginning' and `match-end' sub-expression for MATCHNUM.\nIf optional STRING is provided, take sub-expression using `substring'\nof argument, otherwise use `buffer-substring' on current buffer. Note\nthat `match-data' must have already been generated and no error\nchecking is performed by this function."] member sc-member #[(elt list) "ÀÁ‡" [elt-is-member (byte-code "… @šƒÂÃ\"ˆA‰„ć" [list elt throw elt-is-member nil] 4)] 2 "Like `memq', but uses `equal' instead of `eq'.\nEmacs19 has a builtin function `member' which does exactly this."] string-text sc-string-text #[(string) "À !Âà GÄ $ˆ )‡" [copy-sequence string set-text-properties 0 nil] 5 "Return STRING with all text properties removed."]] 3) #@510 Ask a question in the minibuffer requiring a single character answer. This function is kind of an extension of `y-or-n-p' where a single letter is used to answer a question. Question is formed from ALIST which has members of the form: (WORD . LETTER). WORD is the long word form, while LETTER is the letter for selecting that answer. The selected letter is returned, or nil if the question was not answered. Note that WORD is a string and LETTER is a character. All LETTERs in the list should be unique. (defalias 'sc-ask #[(alist) "ÀÁ\nÃ#ÄÀÅ\nÆ#ÇR‰ Ê >…Ì   ;ƒΉÑÒ \"ˆÓ >ƒ=Ô  ‚PÊ >ƒLÕ !ˆ‚PÖ  Ø*ƒwÑÙ Ú !#ˆÊ >ƒoÛ !ˆØÜÝØ\"ˆÊ >ƒ—Þ !…‰ß !‰ …“á !)‚™ Ø\"‰#ƒ§#—#ä#\n\"‰\"ƒÃÑÙ \"@#ˆ\"A ‚þÊ >ƒÑå !„þÑÙ Ú !#ˆÊ >ƒêæØç\"ˆ‚íæ ˆè ˆ =ƒþéP *‚Ê >ƒÛ !ˆ +‡" [mapconcat #[(elt) "@‡" [elt] 1] alist ", " "? (" #[(elt) "À A!‡" [char-to-string elt] 2] "/" ") " prompt p Lucid sc-emacs-features allocate-event event t inhibit-quit cursor-in-echo-area message "%s" v18 read-char next-command-event read-event quit-flag nil "%s%s" single-key-description deallocate-event signal quit key-press-event-p event-key key event-to-character elt char rassq button-release-event-p ding y-or-n-p discard-input "Try again. "] 7 (#$ . 17577)]) #@64 Find a match in the info alist that matches a regexp in ALIST. (defalias 'sc-scan-info-alist #[(alist) "ÀÁ\fƒQ\f@‰@Ç! A@  ƒJ @‰\n@ \nA\fÍ \"ƒA\fÁ Á‚F A +‚\fA,‚\n*‡" ["" nil rtnvalue sc-mumble alist elem infokey sc-mail-field infoval mlist ml-elem regexp thing string-match] 4 (#$ . 18877)]) #@25 Start of header fields. (defvar sc-mail-headers-start nil (#$ . 19208)) #@23 End of header fields. (defvar sc-mail-headers-end nil (#$ . 19286)) #@50 For minibuffer completion on mail field queries. (defvar sc-mail-field-history nil (#$ . 19360)) #@56 For minibuffer completion on mail field modifications. (defvar sc-mail-field-modification-history nil (#$ . 19463)) #@50 Regi frame for glomming mail header information. (defvar sc-mail-glom-frame (quote ((begin (setq sc-mail-headers-start (point))) ("^x-attribution:[ ]+.*$" (sc-mail-fetch-field t) nil t) ("^\\S +:.*$" (sc-mail-fetch-field) nil t) ("^$" (list (quote abort) (quote (step . 0)))) ("^[ ]+" (sc-mail-append-field)) (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field)) (end (setq sc-mail-headers-end (point))))) (#$ . 19585)) #@140 Insert a key and value into `sc-mail-info' alist. If optional ATTRIBS-P is non-nil, the key/value pair is placed in `sc-attributions' too. (defalias 'sc-mail-fetch-field #[(&optional attribs-p) "ÀÁ\n\"ƒ2ÃÄÅ\n\"!—ÃÄÇ\n\"!B‰ \nB\n ƒ1 \fB\f+͇" [string-match "^\\(\\S *\\)\\s *:\\s +\\(.*\\)$" curline sc-string-text sc-submatch 1 key 2 val keyval sc-mail-info attribs-p sc-attributions nil] 5 (#$ . 20021)]) #@69 Append a continuation line onto the last fetched mail field's info. (defalias 'sc-mail-append-field #[nil "@‰ƒÂÃ\f\"ƒ ‰AÅÆÇÈ\f\"!Q¡ˆ)ɇ" [sc-mail-info keyval string-match "^\\s *\\(.*\\)$" curline " " sc-string-text sc-submatch 1 nil] 8 (#$ . 20450)]) #@59 Issue warning that mail headers don't conform to RFC 822. (defalias 'sc-mail-error-in-mail-field #[nil "GÁ^‰GWƒÂÄÆÈÉ\nO #ˆ+Ê ˆËÌ!ˆÍ‡" [curline 10 len "..." "" ellipsis "Mail header \"%s%s\" doesn't conform to RFC 822. skipping..." msg message 0 beep sit-for 2 nil] 6 (#$ . 20714)]) #@36 True if the last header was nuked. (defvar sc-mail-last-header-nuked-p nil (#$ . 21016)) #@36 Nuke the current mail header line. (defalias 'sc-mail-nuke-line #[nil "ÀÁ!ÀÂ!|ˆÃ‡" [regi-pos bol bonl ((step . -1))] 3 (#$ . 21111)]) #@59 Delete current-line and set up for possible continuation. (defalias 'sc-mail-nuke-header-line #[nil "À ‡" [t sc-mail-last-header-nuked-p sc-mail-nuke-line] 1 (#$ . 21251)]) #@65 Delete a continuation line if the last header line was deleted. (defalias 'sc-mail-nuke-continuation-line #[nil "…Á ‡" [sc-mail-last-header-nuked-p sc-mail-nuke-line] 1 (#$ . 21432)]) #@136 Leave some blank lines after original mail headers are nuked. The number of lines left is specified by `sc-blank-lines-after-headers'. (defalias 'sc-mail-cleanup-blank-lines #[nil "ƒ(Œ~ˆÁÂxˆÃyˆÄ ˆÅyˆÆÇ!ƒ\"ÈÉ!ÈÊ!|ˆËÌ\"ˆ)‡" [sc-blank-lines-after-headers " \n" nil 1 delete-blank-lines 0 looking-at "[ ]*$" regi-pos bol bonl insert-char 10] 3 (#$ . 21626)]) #@46 Build the regiframe for nuking mail headers. (defalias 'sc-mail-build-nuke-frame #[nil "À‰‰\fÅ=ƒÆ‚6\fÇ=ƒÈÉ‚6\fÊ=ƒ+ËÌ‚6\fÍ=„6ÎÏ\f\"ˆÐ\n…BÑ\nÀÓ$ …JÔ DC ?…PÕÖ× …ZØ DC&+‡" [nil nonentry-func entry-func every-func sc-nuke-mail-headers all (progn (forward-line -1) (sc-mail-nuke-line)) specified (sc-mail-nuke-header-line) (setq sc-mail-last-header-nuked-p nil) keep (setq sc-mail-last-header-nuked-p nil) (sc-mail-nuke-header-line) none error "Illegal value for sc-nuke-mail-headers: %s" append regi-mapcar sc-nuke-mail-header-list t "^\\S +:.*$" (("^[ ]+" (sc-mail-nuke-continuation-line))) ((begin (setq sc-mail-last-header-zapped-p nil))) ((end (sc-mail-cleanup-blank-lines))) every] 8 (#$ . 21994)]) #@197 Process original mail message's mail headers. After processing, mail headers may be nuked. Header information is stored in `sc-mail-info', and any old information is lost unless an error occurs. (defalias 'sc-mail-process-headers #[(start end) "À !À\n!ÅÅÆ #ˆ „%ÊË!ˆ\f ‰‚-ÆÌ  #*‡" [copy-alist sc-mail-info sc-attributions attribs info nil regi-interpret sc-mail-glom-frame start end message "No mail headers found! Restoring old information." sc-mail-build-nuke-frame sc-mail-headers-start sc-mail-headers-end] 4 (#$ . 22725) "r"]) #@171 Return the mail header field value associated with FIELD. If there was no mail header with FIELD as its key, return the value of `sc-mumble'. FIELD is case insensitive. (defalias 'sc-mail-field #[(field) "À —\n\"A†\n ‡" [assoc field sc-mail-info sc-mumble] 3 (#$ . 23280)]) #@149 View the value of a mail field. With `\[universal-argument]', prompts for action on mail field. Action can be one of: View, Modify, Add, or Delete. (defalias 'sc-mail-field-query #[(arg) "À\n„\nÂ Ä !Æ ??…¡ÈÉ \"@ÊP Æ Ì=?…*ÍÆÎ& Ã=ƒEÏÐÑ \"A#‚¡ Ò=ƒ[ÓÑ \" \"‰ ‚¡ Ô=ƒŒÑ \"ÖA\"„{ABØÙPA×#¡)‚¡ Ì=…¡ØÙP!B B‰ +‡" [(("view" . 118) ("modify" . 109) ("add" . 97) ("delete" . 100)) alist arg 118 sc-ask action nil key sc-completing-read rassq " information key: " sc-mail-info 97 noexit sc-mail-field-history message "%s: %s" assoc 100 delq 109 keyval sc-member sc-mail-field-modification-history sc-read-string ": "] 7 (#$ . 23563) "P"]) #@50 History for confirmation of attribution strings. (defvar sc-attribution-confirmation-history nil (#$ . 24252)) #@51 History for confirmation of attribution prefixes. (defvar sc-citation-confirmation-history nil (#$ . 24369)) #@293 Extract the author's email terminus from email address FROM. Match addresses of the style ``name%[stuff].'' when called with DELIM of "%" and addresses of the style ``[stuff]name@[stuff]'' when called with DELIM "@". If DELIM is nil or not provided, matches addresses of the style ``name''. (defalias 'sc-attribs-%@-addresses #[(from &optional delim) "ÀÁ\nP Ä#… Ĕĕ\n„Ä‚ÅZO‡" [string-match "[-a-zA-Z0-9_.]+" delim from 0 1] 4 (#$ . 24485)]) #@127 Extract the author's email terminus from email address FROM. Match addresses of the style ``[stuff]![stuff]...!name[stuff].'' (defalias 'sc-attribs-!-addresses #[(from) "GÁÂÃ#Õ …# T\f‰Uƒ Â!ÇZO+‡" [from string-match "![-a-zA-Z0-9_.]+\\([^-!a-zA-Z0-9_.]\\|$\\)" 0 mend mstart eos 1] 5 (#$ . 24941)]) #@110 Extract the author's email terminus from email address FROM. Match addresses of the style ``.'' (defalias 'sc-attribs-<>-addresses #[(from) "ÀÁ\n\"… ÃÄ\n\"‡" [string-match "<\\(.*\\)>" from sc-submatch 1] 3 (#$ . 25260)]) #@109 Get the full email address path from FROM. AUTHOR is the author's name (which is removed from the address). (defalias 'sc-get-address #[(from author) "GÂÃ\fÅQÆ#ƒ9Æ• O‰ÆHÈUƒ3‰GSHÉUƒ3ÊGSO‚5)‚IÂËÆ#ƒHÌÆ\"‚IÍ)‡" [from eos string-match "\\(^\\|^\"\\)" author "\\(\\s +\\|\"\\s +\\)" 0 address 60 62 1 "[-a-zA-Z0-9!@%._]+" sc-submatch ""] 5 (#$ . 25503)]) #@40 Get the email terminus name from FROM. (defalias 'sc-attribs-emailname #[(from) "À Â\"†$À Ã\"†$Ä !†$Å !†$À !†$ ÆÇO‡" [sc-attribs-%@-addresses from "%" "@" sc-attribs-!-addresses sc-attribs-<>-addresses 0 10] 3 (#$ . 25881)]) #@135 Extract the specified substring of STRING from START to END. EXTEND is the number of characters on each side to extend the substring. (defalias 'sc-name-substring #[(string start end extend) "… \\\n Z \fÆ \f#† O*‡" [start extend end eos sos string string-match sc-titlecue-regexp] 6 (#$ . 26118)]) #@99 Extract the name string from FROM. This should be the author's full name minus an optional title. (defalias 'sc-attribs-extract-namestring #[(from) "ÀÁ\nÃ#ƒÄ\nÉ”Ã$†?Ä\nÀÅ\nÃ#ÕÆ$†?Ä\nÀÇ\nÃ#ÕÆ$†?Ä\nÀÈ\nÃ#Æ•Ã$†?É\n!‰\n…ŒÃ\nGS ‰\f Xƒh\n\fHÍ>ƒh\fT‰\f‚O \fVƒƒ\n HÎ>ƒƒ S‰ ‚j\n\f TO*)‡" [string-match " *<.*>" from 0 sc-name-substring "(.*)" 1 "\".*\"" "\\([-.a-zA-Z0-9_]+\\s +\\)+<" sc-attribs-emailname namestring eos bos (32 9) (32 9)] 7 (#$ . 26432)]) #@127 Convert NAMESTRING to a list of names. example: (sc-namestring-to-list "John Xavier Doe") => ("John" "Xavier" "Doe") (defalias 'sc-attribs-chop-namestring #[(namestring) "ÀÁ\n\"…ÃÄ\n\"Å\nÆ•ÇO!B‡" [string-match "\\([ ]*\\)\\([^ ._]+\\)\\([ ]*\\)" namestring sc-submatch 2 sc-attribs-chop-namestring 3 nil] 5 (#$ . 26921)]) #@50 Extract the author's initials from the NAMELIST. (defalias 'sc-attribs-strip-initials #[(namelist) "ÀÁ\nÃ#‡" [mapconcat #[(name) "À GW… ÀÂO‡" [0 name 1] 3] namelist ""] 4 (#$ . 27263)]) #@187 Guess attribution string on current line. If attribution cannot be guessed, nil is returned. Optional STRING if supplied, is used instead of the line point is on in the current buffer. (defalias 'sc-guess-attribution #[(&optional string) "À †\fÂÃ!ÂÄ!{Å‰È #†ÊU…uÀ•‰…uÈ #†7ÌU…uÍÀ \"À•‰…uÈ #†VÊU…uÀ•‰…uÈ #†oÊU…u+‡" [0 string regi-pos bol eol nil attribution start string-match sc-citation-leader-regexp -1 sc-citation-root-regexp 1 sc-submatch sc-citation-delimiter-regexp sc-citation-separator-regexp] 6 (#$ . 27458)]) #@67 Filter out noise in NAMELIST according to `sc-name-filter-alist'. (defalias 'sc-attribs-filter-namelist #[(namelist) "GÁ‰ÇÈ\"ˆÇÉ\f\"ˆ ,‡" [namelist -1 nil filtered-list keepers position elements mapcar #[(name) "TÁÃÄ \"ˆ\n…B‰)‡" [position t keep-p mapcar #[(filter) "@AÃ\n\f\"…0 §ƒ U„, Æ=ƒ& SU„, È=…0ɉ\n*‡" [filter pos regexp string-match name position last elements any nil keep-p] 3] sc-name-filter-alist keepers] 3] #[(position) " 8\nB‰‡" [position namelist filtered-list] 2]] 4 (#$ . 28032)]) #@121 Extract attribution information from FROM. This populates the `sc-attributions' with the list of possible attributions. (defalias 'sc-attribs-chop-address #[(from) ";ƒ±ÁGWƒ±ÂÄ!ÆÇ !!ÉA!\n@ É\nA!\f\n@ Î!Ð!ÒÔÔ×Ø\fÙ# Ù\f…XÙ °ÚÛ BÜ BÝBÞBF\"Úà BáBâ BãBäBåBæçèé! \"Bêçèë! \"Bìçèí! \"B¯ .\"‰..\f‡å/B.B‰.‡" [from 0 "" sc-mumble sc-attribs-extract-namestring namestring sc-attribs-filter-namelist sc-attribs-chop-namestring namelist reverse revnames firstname midnames lastname sc-attribs-strip-initials initials sc-attribs-emailname emailname 1 n nil author middlenames mapconcat #[(midname) "ÀÁ\n\"ÀÃ\n\"‰BB\fBB\nT*‡" [format "middlename-%d" n "sc-middlename-%d" key-mail key-attribs midname sc-attributions sc-mail-info] 5] " " append "firstname" "lastname" "emailname" "initials" sc-attributions "sc-firstname" "sc-middlenames" "sc-lastname" "sc-emailname" "sc-initials" "sc-author" "sc-from-address" sc-get-address sc-mail-field "from" "sc-reply-address" "reply-to" "sc-sender-address" "sender" sc-mail-info sc-default-author-name] 13 (#$ . 28572)]) #@61 Used to toggle between attribution input or citation input. (defvar sc-attrib-or-cite nil (#$ . 29709)) #@93 Toggle between attribution selection and citation selection. Only used during confirmation. (defalias 'sc-toggle-fn #[nil "?ÁÂÃ\"‡" [sc-attrib-or-cite throw sc-reconfirm t] 3 (#$ . 29819) nil]) #@622 Select an attribution from `sc-attributions'. Variables involved in selection process include: `sc-preferred-attribution-list' `sc-use-only-preference-p' `sc-confirm-always-p' `sc-default-attribution' `sc-attrib-selection-list'. Runs the hook `sc-attribs-preselect-hook' before selecting an attribution and the hook `sc-attribs-postselect-hook' after making the selection but before querying is performed. During `sc-attribs-postselect-hook' the variable `citation' is bound to the auto-selected citation string and the variable `attribution' is bound to the auto-selected attribution string. (defalias 'sc-select-attribution #[nil "ÀÁ!ˆ\nÉ\f ƒo @‰ ʘƒVË\f!‰ „- A‚R ;ƒ< ÂR <ƒMÎ !ÂRÏÐÑ\"ˆ)‚kÒ \"A‰ƒhÂk A)‚„¬„¬ÒÕ\"A†ªÒÖ\"A†ªÒ×\"A†ªÒØ\"A†ªÒÙ\"A†ª@A„¸ÛÜ!ÀÝ!ˆƒ\fÞß\" !\"#$%Û&Ã'Ã(éê„ã(ƒ'ë!†û‚\nÜ'!'.,ƒ——í.ï0Ò.1\"2Ò01\"32ƒ?2¡ˆ‚Kô.BC1\"13ƒY3¡ˆ‚eô0BC1\"1,Õ5Ò5\"‰6ƒ}6¡‚ˆ5BB‰.‡" [run-hooks sc-attribs-preselect-hook sc-confirm-always-p nil sc-preferred-attribution-list attriblist citation attribution query-p preferred "sc-consult" sc-scan-info-alist sc-attrib-selection-list attrib eval error "%s did not evaluate to a string or list!" "sc-attrib-selection-list" assoc sc-attributions sc-use-only-preference-p "sc-lastchoice" "x-attribution" "firstname" "lastname" "initials" sc-default-attribution t sc-make-citation sc-attribs-postselect-hook mapcar #[(entry) "AC‡" [entry] 1] query-alist sc-minibuffer-local-completion-map minibuffer-local-completion-map sc-minibuffer-local-map minibuffer-local-map initial completer-disable choice sc-attrib-or-cite sc-reconfirm (byte-code "ƒ\fÁ Ä#‚ÅÆȉ ÊBË&‰\f͘‡" [sc-attrib-or-cite sc-read-string "Enter citation prefix: " citation sc-citation-confirmation-history sc-completing-read "Complete attribution name: " query-alist nil initial 0 sc-attribution-confirmation-history choice ""] 7) sc-guess-attribution sc-downcase-p "sc-citation" ckey "sc-attribution" akey sc-mail-info ckeyval akeyval append lkey lastchoice] 5 (#$ . 30022)]) #@289 Return a regexp describing a Supercited line. The regexp is the concatenation of `sc-citation-leader-regexp', `sc-citation-root-regexp', `sc-citation-delimiter-regexp', and `sc-citation-separator-regexp'. If optional ROOT-REGEXP is supplied, use it instead of `sc-citation-root-regexp'. (defalias 'sc-cite-regexp #[(&optional root-regexp) " †\n \fR‡" [sc-citation-leader-regexp root-regexp sc-citation-root-regexp sc-citation-delimiter-regexp sc-citation-separator-regexp] 4 (#$ . 32217)]) #@46 Make a non-nested citation from ATTRIBUTION. (defalias 'sc-make-citation #[(attribution) " \n R‡" [sc-citation-leader attribution sc-citation-delimiter sc-citation-separator] 4 (#$ . 32717)]) #@65 Setup `filladapt-prefix-table' to handle Supercited paragraphs. (defalias 'sc-setup-filladapt #[nil "À \"‰ƒ\fÅ  ‚ÆÇ!ˆÈ *‡" [filladapt-supercite-included-text fa-sc-elt rassq filladapt-prefix-table elt sc-cite-regexp message "Filladapt doesn't seem to know about Supercite." beep] 4 (#$ . 32916)]) #@35 Buffer position to begin filling. (defvar sc-fill-begin 1 (#$ . 33227)) #@30 Fill prefix of previous line (defvar sc-fill-line-prefix "" (#$ . 33305)) #@283 Fill the region bounded by `sc-fill-begin' and point. Only fill if optional PREFIX is different than `sc-fill-line-prefix'. If `sc-auto-fill-region-p' is nil, do not fill region. If PREFIX is not supplied, initialize fill variables. This is useful for a regi `begin' frame-entry. (defalias 'sc-fill-if-different #[(&optional prefix) "„ ÁÃÄ!‚/ƒ/\n˜„/\n‰Á˜„(È ÃÄ!\"ˆÃÄ!)ɇ" [prefix "" sc-fill-line-prefix regi-pos bol sc-fill-begin sc-auto-fill-region-p fill-prefix fill-region nil] 5 (#$ . 33386)]) #@50 Coerce a Supercited line to look like our style. (defalias 'sc-cite-coerce-cited-line #[nil "À  !Ä ! ƒ.Æ !ƒ.Ç”ŠÇ•bˆnƒ#Èuˆ`)|ˆ cˆÉ !ˆ+ʇ" [sc-guess-attribution attribution sc-cite-regexp regexp sc-make-citation prefix looking-at 0 -1 sc-fill-if-different nil] 2 (#$ . 33908)]) #@75 Coerce a non-nested citation that's been cited with a dumb nesting citer. (defalias 'sc-cite-coerce-dumb-citer #[nil "À”À•|ˆÁyˆÂ ‡" [1 0 sc-cite-coerce-cited-line] 2 (#$ . 34197)]) #@189 Guess the citation nesting on the current line. If nesting cannot be guessed, nil is returned. Optional STRING if supplied, is used instead of the line point is on in the current buffer. (defalias 'sc-guess-nesting #[(&optional string) "À †\fÂÃ!ÂÄ!{Å‰È #†ÊU…\\À•‰…\\È #†7ÊU…\\ÌÀ \"À•‰…\\È #†VÊU…\\+‡" [0 string regi-pos bol eol nil nesting start string-match sc-citation-leader-regexp -1 sc-citation-delimiter-regexp sc-submatch sc-citation-separator-regexp] 6 (#$ . 34385)]) #@61 Add a citation level for nested citation style w/ coersion. (defalias 'sc-add-citation-level #[nil "À  GTÃ\f!\" QÉÊË!!ƒ\"̔̕|ˆcˆÍ!+‡" [sc-guess-nesting nesting make-string string-to-char sc-citation-delimiter citation sc-citation-leader sc-citation-separator prefix looking-at sc-cite-regexp "" 0 sc-fill-if-different] 4 (#$ . 34907)]) #@102 Cite a single line of uncited text. Optional CITATION overrides any citation automatically selected. (defalias 'sc-cite-line #[(&optional citation) "ƒÁ ˆ\n†ÃÄ \"A†‰cˆÈ!ˆ)ɇ" [sc-fixup-whitespace-p fixup-whitespace citation assoc "sc-citation" sc-mail-info sc-default-attribution prefix sc-fill-if-different nil] 4 (#$ . 35265)]) #@36 Remove citation from current line. (defalias 'sc-uncite-line #[nil "ÀÁ !‰ƒÔÕ|ˆ)ć" [looking-at sc-cite-regexp cited 0 nil] 3 (#$ . 35613)]) #@68 Remove citation matching REGEXP from current line and recite line. (defalias 'sc-recite-line #[(regexp) "ÀÁ\nP!ÃÄ \"A‰ƒȔȕ|ˆ† cˆÊ!ˆ*ˇ" [looking-at "^" regexp assoc "sc-citation" sc-mail-info prefix cited 0 sc-default-attribution sc-fill-if-different nil] 5 (#$ . 35764)]) #@192 Cite a region delineated by START and END. If optional CONFIRM-P is non-nil, the attribution is confirmed before its use in the citation string. This function first runs `sc-pre-cite-hook'. (defalias 'sc-cite-region #[(start end &optional confirm-p) "À ˆÁ\n!†\n \fƒÅ‚ÈÉ!ˆtƒ#Ê ˆË\f #*‡" [undo-boundary sc-scan-info-alist sc-cite-frame-alist sc-default-cite-frame confirm-p t sc-confirm-always-p frame run-hooks sc-pre-cite-hook sc-select-attribution regi-interpret start end] 4 (#$ . 36058) "r\nP"]) #@79 Uncite a region delineated by START and END. First runs `sc-pre-uncite-hook'. (defalias 'sc-uncite-region #[(start end) "À ˆÁ\n!†\n ÅÆ!ˆÇ\f #)‡" [undo-boundary sc-scan-info-alist sc-uncite-frame-alist sc-default-uncite-frame frame run-hooks sc-pre-uncite-hook regi-interpret start end] 4 (#$ . 36580) "r"]) #@79 Recite a region delineated by START and END. First runs `sc-pre-recite-hook'. (defalias 'sc-recite-region #[(start end) "À ˆ)à ˆÄ !†ÈÉ!ˆÊ \f#)‡" [t sc-confirm-always-p sc-select-attribution undo-boundary sc-scan-info-alist sc-recite-frame-alist sc-default-recite-frame frame run-hooks sc-pre-recite-hook regi-interpret start end] 4 (#$ . 36898) "r"]) #@269 Returns a concatenation of PREFIX and FIELD. If FIELD is not a string or is the empty string, the empty string will be returned. Optional third argument SEP is concatenated on the end if it is a string. Returns empty string, unless optional RETURN-NIL-P is non-nil. (defalias 'sc-hdr #[(prefix field &optional sep return-nil-p) ";ƒÁ˜„\n †ÁQ‡\f?…Á‡" [field "" prefix sep return-nil-p] 3 (#$ . 37268)]) #@52 Return the value of (sc-mail-field "from") or nil. (defalias 'sc-whofrom #[nil "ÀÂÃ!)‡" [nil sc-mumble sc-mail-field "from"] 2 (#$ . 37688)]) #@63 Does nothing. Use this instead of nil to get a blank header. (defalias 'sc-no-header #[nil "À‡" [nil] 1 (#$ . 37837)]) #@72 Similar to `sc-no-header' except it removes the preceeding blank line. (defalias 'sc-no-blank-line-or-header #[nil "o?…,l…,ÀyˆÁÂÃ\f!ÅQ!„#Ç=…,È …,ÉyˆÊ Ì )‡" [-1 looking-at "^" regexp-quote mail-header-separator "$" major-mode mh-letter-mode mh-in-header-p nil t kill-lines-magic kill-line] 4 (#$ . 37963)]) #@183 "On , said:" unless: 1. the "from" field cannot be found, in which case nothing is inserted; 2. the "date" field is missing in which case only the from part is printed. (defalias 'sc-header-on-said #[nil "ÀÁ \n…\fÅÆÇÈ!É#\nʱ*‡" ["" sc-whofrom whofrom sc-mumble sc-reference-tag-string sc-hdr "On " sc-mail-field "date" ", " " said:\n"] 5 (#$ . 38284)]) #@113 "In article , writes:" Treats "message-id" and "from" fields similar to `sc-header-on-said'. (defalias 'sc-header-inarticle-writes #[nil "ÀÁÂ! … ÆÇÁÈ!É# ʱ*‡" ["" sc-mail-field "from" whofrom sc-mumble sc-reference-tag-string sc-hdr "In article " "message-id" ", " " writes:\n"] 5 (#$ . 38662)]) #@104 "Regarding ; adds:" Treats "subject" and "from" fields similar to `sc-header-on-said'. (defalias 'sc-header-regarding-adds #[nil "ÀÁ \n…\fÅÆÇÈ!É#\nʱ*‡" ["" sc-whofrom whofrom sc-mumble sc-reference-tag-string sc-hdr "Regarding " sc-mail-field "subject" "; " " adds:\n"] 5 (#$ . 38989)]) #@117 "" ==

writes: Treats these fields in a similar manner to `sc-header-on-said'. (defalias 'sc-header-attributed-writes #[nil "ÀÁ \n…2\fÅÆÇÈ!É#ÅÀÇÊ!Ë#ÅÌÇÍ!ÎÏ$†/ÅÌÇÐ!ÎÏ$†/Àѱ*‡" ["" sc-whofrom whofrom sc-mumble sc-reference-tag-string sc-hdr "\"" sc-mail-field "sc-attribution" "\" == " "sc-author" " " "<" "sc-from-address" ">" t "sc-reply-address" " writes:\n"] 8 (#$ . 39305)]) #@21 writes: (defalias 'sc-header-author-writes #[nil "ÀÁ \n…\fÅÀÆÇ!\"ȱ*‡" ["" sc-whofrom whofrom sc-mumble sc-reference-tag-string sc-hdr sc-mail-field "sc-author" " writes:\n"] 5 (#$ . 39732)]) #@31 Very verbose, some say gross. (defalias 'sc-header-verbose #[nil "ÀÁ \n\f…zÆ ÇPÈÉ!Ê#Æ ÈË!ÌÍ$†# \fÌQÆ ÎPÈÏ!Ì# ÐPÆÈÒ!ÌÍ$†JÆÈÓ!ÌÍ$†JÀ)Æ ÔPÈÕ!Ö#Æ ×PÈØ!Ì#Æ ÙPÈÚ!Ì#Æ ÛPÈÜ!Ì#Æ ÝPÈÞ!ß#± +‡" ["" sc-whofrom sc-reference-tag-string tag whofrom sc-mumble sc-hdr "On " sc-mail-field "date" ",\n" "sc-author" "\n" t "from the organization of " "organization" "who can be reached at: " rtag "sc-from-address" "sc-reply-address" "(whose comments are cited below with \"" "sc-citation" "\"),\n" "had this to say in article " "message-id" "in newsgroups " "newsgroups" "concerning the subject of " "subject" "(see " "references" " for more details)\n"] 12 (#$ . 39947)]) #@50 Supercite electric reference mode's buffer name. (defconst sc-electric-bufname " *sc-erefs* " (#$ . 40619)) #@35 Current electric reference style. (defvar sc-eref-style 0 (#$ . 40733)) #@92 Returns INDEX if it is a valid index into `sc-rewrite-header-list'. Otherwise returns nil. (defalias 'sc-valid-index-p #[(index) "À !… \nGW… ‡" [natnump index sc-rewrite-header-list] 2 (#$ . 40811)]) #@141 Insert the selected reference header in the current buffer. Optional NOMSG, if non-nil, inhibits printing messages, unless an error occurs. (defalias 'sc-eref-insert-selected #[(&optional nomsg) " 8ÃÄÅ)‡" [sc-eref-style sc-rewrite-header-list ref err (byte-code "À !ˆÂed\"\f†ÅÆ ‰ÈUƒÉ‚Ê %)‡" [eval ref count-lines lines nomsg message "Ref header %d [%d line%s]: %s" sc-eref-style 1 "" "s"] 6) ((void-function (byte-code "ÀÁ\nA@ #ˆÄ ‡" [message "Symbol's function definition is void: %s (Header %d)" err sc-eref-style beep] 4)))] 3 (#$ . 41022)]) #@395 Mode for viewing Supercite reference headers. Commands are: \{sc-electric-mode-map} `sc-electric-mode' is not intended to be run interactively, but rather accessed through Supercite's electric reference feature. See `sc-insert-reference' for more details. Optional ARG is the initial header style to use, unless not supplied or invalid, in which case `sc-preferred-header-style' is used. (defalias 'sc-electric-mode #[(&optional arg) " !†Â\f!†ÅÇ!ˆŠÉ‹ˆ)ƒ#Ê ˆË!)‡" [sc-mail-info info sc-valid-index-p arg sc-preferred-header-style 0 sc-eref-style get-buffer-create sc-electric-bufname ((byte-code "À !ˆÂ ˆ ÄÅÆ \nË\f!ˆÍ!ˆÏÐ!ˆÑ ˆ,À‡" [pop-to-buffer sc-electric-bufname kill-all-local-variables info t "SC Electric Refs" sc-electric-mode major-mode mode-name buffer-read-only sc-mail-info use-local-map sc-electric-mode-map sc-eref-show sc-eref-style run-hooks sc-electric-mode-hook recursive-edit] 4)) sc-eref-insert-selected kill-buffer] 2 (#$ . 41586)]) #@51 Show reference INDEX in `sc-rewrite-header-list'. (defalias 'sc-eref-show #[(index) "À GÄ !ƒ ‚> ÆWƒ(ƒ\nS‚>È É\"ˆÆ‚> \nY…>ƒ7Æ‚>È Ê\"ˆ\nS Š\fqˆÍÏ ˆebˆÐ ˆÑed\"Ò S‰U?…€VƒvÕZ!‚€Ö]Z!.‡" ["No %ing reference headers in list." sc-rewrite-header-list last msg sc-valid-index-p index 0 sc-electric-circular-p error "preced" "follow" sc-eref-style sc-electric-bufname nil buffer-read-only erase-buffer sc-eref-insert-selected count-lines window-height winlines hdrlines enlarge-window shrink-window window-min-height] 5 (#$ . 42575)]) #@41 Display next reference in other buffer. (defalias 'sc-eref-next #[nil "À T!‡" [sc-eref-show sc-eref-style] 2 (#$ . 43149) nil]) #@45 Display previous reference in other buffer. (defalias 'sc-eref-prev #[nil "À S!‡" [sc-eref-show sc-eref-style] 2 (#$ . 43283) nil]) #@45 Set reference header selected as preferred. (defalias 'sc-eref-setn #[nil "ÂÃ\"‡" [sc-eref-style sc-preferred-header-style message "Preferred reference style set to header %d."] 3 (#$ . 43421) nil]) #@115 Show reference style indexed by REFNUM. If REFNUM is an invalid index, don't go to that reference and return nil. (defalias 'sc-eref-goto #[(refnum) "À !ƒ\n !‡ÃÄ ÅGS$‡" [sc-valid-index-p refnum sc-eref-show error "Invalid reference: %d. (Range: [%d .. %d])" 0 sc-rewrite-header-list] 5 (#$ . 43630) "NGoto Reference: "]) #@43 Set reference header to preferred header. (defalias 'sc-eref-jump #[nil "À !‡" [sc-eref-show sc-preferred-header-style] 2 (#$ . 43961) nil]) #@64 Exit from electric reference mode without inserting reference. (defalias 'sc-eref-abort #[nil "À ‡" [nil sc-eref-style exit-recursive-edit] 1 (#$ . 44108) nil]) #@66 Exit from electric reference mode and insert selected reference. (defalias 'sc-eref-exit #[nil "À ‡" [exit-recursive-edit] 1 (#$ . 44277) nil]) #@412 Insert, at point, a reference header in the body of the reply. Numeric ARG indicates which header style from `sc-rewrite-header-list' to use when rewriting the header. No supplied ARG indicates use of `sc-preferred-header-style'. With just `\[universal-argument]', electric reference insert mode is entered, regardless of the value of `sc-electric-references-p'. See `sc-electric-mode' for more information. (defalias 'sc-insert-reference #[(arg) ":ƒÁ ‡Â!† !† †Äƒ%Á !‚(ÇÈ!)‡" [arg sc-electric-mode sc-valid-index-p sc-preferred-header-style 0 preference sc-electric-references-p sc-eref-insert-selected t] 2 (#$ . 44428) "P"]) #@108 Toggle, in one fell swoop, two important SC variables: `sc-fixup-whitespace-p' and `sc-auto-fill-region-p' (defalias 'sc-raw-mode-toggle #[nil "? ? ˆÃ ‡" [sc-fixup-whitespace-p sc-auto-fill-region-p sc-set-mode-string force-mode-line-update] 1 (#$ . 45081) nil]) #@127 Boolean toggle VARIABLE's value. VARIABLE must be a bound symbol. Nil values change to t, non-nil values are changed to nil. (defalias 'sc-toggle-var #[(variable) "ÀÁ\n‰JÃ\nÄ\n!?\"$ˆÅ ‡" [message "%s changed from %s to %s" variable set-variable eval-expression sc-set-mode-string] 8 (#$ . 45355)]) #@508 Set the Supercite VARIABLE. This function mimics `set-variable', except that the variable to set is determined non-interactively. The value is queried for in the minibuffer exactly the same way that `set-variable' does it. You can see the current value of the variable when the minibuffer is querying you by typing `C-h'. Note that the format is changed slightly from that used by `set-variable' -- the current value is printed just after the variable's name instead of at the bottom of the help window. (defalias 'sc-set-variable #[(var) "ÀÂ\fÅÆÇ\f\"!Lˆ*È ‡" [(funcall myhelp) minibuffer-help-form #[nil "ÀÁ\n!ˆÃ\n!ƒÄÆÇ!ˆÁ\nJ!ˆÆÈ!ˆ)ÆÉ!ˆÆÊ\nË\"ÌÍO!ˆŠqˆÏ ˆ)Í‘‡" ["*Help*" prin1 var boundp 20 print-length princ " (Current value: " ")" "\n\nDocumentation:\n" documentation-property variable-documentation 1 nil standard-output help-mode] 5] myhelp var eval-minibuffer format "Set %s to value: " sc-set-mode-string] 5 (#$ . 45661)]) (defalias 'sc-toggle-symbol '(macro . #[(rootname) "ÀÁ P!ÄÅCÆÇÁÈ ÉQ!DD¯‡" [defun intern "sc-T-" rootname nil interactive sc-toggle-var quote "sc-" "-p"] 10])) (defalias 'sc-setvar-symbol '(macro . #[(rootname) "ÀÁ P!ÄÅCÆÇÁÈ P!DD¯‡" [defun intern "sc-S-" rootname nil interactive sc-set-variable quote "sc-"] 9])) (defalias 'sc-T-confirm-always #[nil "ÀÁ!‡" [sc-toggle-var sc-confirm-always-p] 2 nil nil]) (defalias 'sc-T-downcase #[nil "ÀÁ!‡" [sc-toggle-var sc-downcase-p] 2 nil nil]) (defalias 'sc-T-electric-references #[nil "ÀÁ!‡" [sc-toggle-var sc-electric-references-p] 2 nil nil]) (defalias 'sc-T-auto-fill-region #[nil "ÀÁ!‡" [sc-toggle-var sc-auto-fill-region-p] 2 nil nil]) (defalias 'sc-T-mail-nuke-blank-lines #[nil "ÀÁ!‡" [sc-toggle-var sc-mail-nuke-blank-lines-p] 2 nil nil]) (defalias 'sc-T-nested-citation #[nil "ÀÁ!‡" [sc-toggle-var sc-nested-citation-p] 2 nil nil]) (defalias 'sc-T-electric-circular #[nil "ÀÁ!‡" [sc-toggle-var sc-electric-circular-p] 2 nil nil]) (defalias 'sc-T-use-only-preferences #[nil "ÀÁ!‡" [sc-toggle-var sc-use-only-preferences-p] 2 nil nil]) (defalias 'sc-T-fixup-whitespace #[nil "ÀÁ!‡" [sc-toggle-var sc-fixup-whitespace-p] 2 nil nil]) (defalias 'sc-S-preferred-attribution-list #[nil "ÀÁ!‡" [sc-set-variable sc-preferred-attribution-list] 2 nil nil]) (defalias 'sc-S-preferred-header-style #[nil "ÀÁ!‡" [sc-set-variable sc-preferred-header-style] 2 nil nil]) (defalias 'sc-S-mail-nuke-mail-headers #[nil "ÀÁ!‡" [sc-set-variable sc-mail-nuke-mail-headers] 2 nil nil]) (defalias 'sc-S-mail-header-nuke-list #[nil "ÀÁ!‡" [sc-set-variable sc-mail-header-nuke-list] 2 nil nil]) (defalias 'sc-S-cite-region-limit #[nil "ÀÁ!‡" [sc-set-variable sc-cite-region-limit] 2 nil nil]) #@418 Supercite provides a number of key bindings which simplify the process of setting or toggling certain variables controlling its operation. Note on function names in this list: all functions of the form `sc-S-' actually call `sc-set-variable' on the corresponding `sc-' variable. All functions of the form `sc-T-' call `sc-toggle-var' on the corresponding `sc--p' variable. \{sc-T-keymap} (defalias 'sc-T-describe #[nil "ÀÁ!‡" [describe-function sc-T-describe] 2 (#$ . 48330) nil]) #@58 Update the minor mode string to show state of Supercite. (defalias 'sc-set-mode-string #[nil "À „ \nƒ ÂÄ ƒÅ‚Ä\nƒÆ‚ ÄR‰‡" [" SC" sc-auto-fill-region-p sc-fixup-whitespace-p ":" "" "f" "w" sc-mode-string] 4 (#$ . 48846)]) #@941 Workhorse citing function which performs the initial citation. This is callable from the various mail and news readers' reply function according to the agreed upon standard. See `\[sc-describe]' for more details. `sc-cite-original' does not do any yanking of the original message but it does require a few things: 1) The reply buffer is the current buffer. 2) The original message has been yanked and inserted into the reply buffer. 3) Verbose mail headers from the original message have been inserted into the reply buffer directly before the text of the original message. 4) Point is at the beginning of the verbose headers. 5) Mark is at the end of the body of text to be cited. For Emacs 19's, the region need not be active (and typically isn't when this function is called. Also, the hook `sc-pre-hook' is run before, and `sc-post-hook' is run after the guts of this function. (defalias 'sc-cite-original #[nil "ÀÁ!ˆ\nƒ Ã\n\f\"ˆÅÆN„ÇÅƉ#ˆÈ BÉÊ ˆË ˆÌ ÉÏ ÑÒ !‰WƒJ)Õ\"ˆÖ×Ø!†g×Ù!†g×Ú!†g×Û!!ˆÜ ˆÝ\"ƒº§ƒ‡Xƒ¯à\"ˆbˆ!†˜â#$ƒ§å#!ˆ‚«æÉ!ˆ)‚ºç ˆèé#ˆ)̉“ˆ̉“ˆ,Àê!ˆÊ ‡" [run-hooks sc-pre-hook sc-mode-map-prefix local-set-key sc-mode-map minor-mode-alist sc-minor-mode put (sc-minor-mode sc-mode-string) t sc-set-mode-string undo-boundary nil zmacs-regions mark-active point-marker point copy-marker mark-marker mark tmp sc-mail-process-headers sc-attribs-chop-address sc-mail-field "from" "reply" "reply-to" "sender" sc-select-attribution count-lines linecnt sc-cite-region-limit sc-cite-region sc-preferred-header-style 0 sc-eref-style sc-electric-references-p sc-electric-mode sc-eref-insert-selected beep message "Region not cited. %d lines exceeds sc-cite-region-limit: %d" sc-post-hook] 5 (#$ . 49087)]) #@123 Like `open-line', but insert the citation prefix at the front of the line. With numeric ARG, inserts that many new lines. (defalias 'sc-open-line #[(arg) "Š`ÀyˆÁ !ƒÃÀ!†Ä‰bˆÇ!ˆÉyˆÀW…6 cˆÉyˆS‚!+‡" [0 looking-at sc-cite-regexp sc-submatch "" prefix start open-line arg 1] 4 (#$ . 50925) "p"]) #@151 Insert citation string at beginning of current line if not already cited. With `\[universal-argument]' insert citation even if line is already cited. (defalias 'sc-insert-citation #[(arg) "ŠÀyˆÁ !ƒÁÃ!„\f:ƒÅÆ!c‚ ÇÈ!)‡" [0 looking-at sc-cite-regexp "^[ ]*$" arg sc-mail-field "sc-citation" error "Line is already cited."] 2 (#$ . 51240) "P"]) #@194 Echo the current version of Supercite in the minibuffer. With \[universal-argument] (universal-argument), or if run non-interactively, inserts the version string in the current buffer instead. (defalias 'sc-version #[(arg) "ÀÁ\n\"\f:„t„Å ±‚Æ !)‡" [format "Using Supercite.el %s" sc-version verstr arg "`sc-version' says: " message] 3 (#$ . 51597) "P"]) #@158 Supercite is a package which provides a flexible mechanism for citing email and news replies. Please see the associated texinfo file for more information. (defalias 'sc-describe #[nil "ÀÁ!‡" [describe-function sc-describe] 2 (#$ . 51965) nil]) #@44 Submit a bug report on Supercite via mail. (defalias 'sc-submit-bug-report #[nil "ÀÁ!ˆÂÃ!…2Ä ÆPÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæ¯#‡" [require reporter y-or-n-p "Do you want to submit a report on Supercite? " reporter-submit-bug-report sc-help-address "Supercite version " sc-version sc-attrib-selection-list sc-auto-fill-region-p sc-blank-lines-after-headers sc-citation-leader sc-citation-delimiter sc-citation-separator sc-citation-leader-regexp sc-citation-root-regexp sc-citation-nonnested-root-regexp sc-citation-delimiter-regexp sc-citation-separator-regexp sc-cite-region-limit sc-confirm-always-p sc-default-attribution sc-default-author-name sc-downcase-p sc-electric-circular-p sc-electric-references-p sc-fixup-whitespace-p sc-mail-warn-if-non-rfc822-p sc-mumble sc-name-filter-alist sc-nested-citation-p sc-nuke-mail-headers sc-nuke-mail-header-list sc-preferred-attribution-list sc-preferred-header-style sc-reference-tag-string sc-rewrite-header-list sc-titlecue-regexp sc-use-only-preference-p] 34 (#$ . 52217) nil]) (byte-code "ÀÁ!ˆÂÃ!‡" [provide supercite run-hooks sc-load-hook] 2) emacs-19.30/lisp/swedish.elc100666 12241 1 4364 5744577437 14727 0ustar rolanddaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:51:59 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/swedish.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/swedish.el' was compiled for Emacs 19")) (require (quote iso-syntax)) #@46 Regular expression for common Swedish words. (defvar swedish-re "[ \n]\\(och\\|att\\|en\\|{r\\|\\[R\\|p}\\|P\\]\\|som\\|det\\|av\\|den\\|f|r\\|F\\\\R\\)[ \n.,?!:;'\")}]" (#$ . 512)) #@35 Trans table from SWASCII to 8859. (defvar swascii-to-8859-trans (byte-code "ÀÁÂ\"Ã\fÁWƒ \f‰Iˆ\fT‰‚ ÆÇIˆ ÈÉIˆ ÊËIˆ ÌÍIˆ ÎÏIˆ ÐÑIˆ ÒÓIˆ ÔÕIˆ Ö×Iˆ *‡" [make-string 256 32 0 i string 91 196 93 197 92 214 94 220 123 228 125 229 96 233 124 246 126 252] 4) (#$ . 702)) #@137 Convert characters in buffer from Swedish/Finnish-ascii to ISO 8859/1. Works even on read-only buffers. `$' and `@' are not converted. (defalias 'swascii-to-8859-buffer #[nil "ÀÂed #)‡" [nil buffer-read-only translate-region swascii-to-8859-trans] 4 (#$ . 978) nil]) #@122 Call swascii-to-8859-buffer if the buffer looks like Swedish-ascii. Leaves point just after the word that looks Swedish. (defalias 'swascii-to-8859-buffer-maybe #[nil "À ÄÀ#…\fÅ )‡" [t case-fold-search re-search-forward swedish-re nil swascii-to-8859-buffer] 4 (#$ . 1254) nil]) (byte-code "ÀÂÃ!„\nÄÅÆ \"ć" [swascii-to-8859-buffer-maybe rmail-show-message-hook boundp news-group-hook-alist nil append (("^swnet." . swascii-to-8859-buffer-maybe))] 3) #@30 8859 to SWASCII trans table. (defvar 8859-to-swascii-trans (byte-code "ÀÁÂ\"Ã\fÁWƒ \f‰Iˆ\fT‰‚ ÆÇIˆ ÈÉIˆ ÊËIˆ ÌÍIˆ ÎÏIˆ ÐÑIˆ ÒÓIˆ ÔÕIˆ Ö×Iˆ ØÙIˆ ÚÛIˆ *‡" [make-string 256 32 0 i string 164 36 196 91 197 93 201 64 214 92 220 94 228 123 229 125 233 96 246 124 252 126] 4) (#$ . 1718)) #@72 Convert characters in buffer from ISO 8859/1 to Swedish/Finnish-ascii. (defalias '8859-to-swascii-buffer #[nil "Àed #‡" [translate-region 8859-to-swascii-trans] 4 (#$ . 2013) "*"]) (byte-code "ÀÀÃÄ!‡" [8859-to-swascii-buffer mail-send-hook news-inews-hook provide swedish] 2) emacs-19.30/lisp/tabify.elc100666 13437 1 2673 5744577440 14204 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:52:00 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/tabify.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/tabify.el' was compiled for Emacs 19")) #@253 Convert all tabs in region to multiple spaces, preserving columns. Called non-interactively, the region is specified by arguments START and END, rather than by the position of point and mark. The variable `tab-width' controls the spacing of tab stops. (defalias 'untabify #[(start end) "ŠŒe}ˆ bˆÂÃÄÅ#…+`iÄà xˆ`|ˆjˆ+‚ *‡" [end start search-forward " " nil t indent-tabs-mode column tab-beg] 4 (#$ . 482) "r"]) #@354 Convert multiple spaces in region to tabs when possible. A group of spaces is partially replaced by tabs when this can be done without changing the column they end at. Called non-interactively, the region is specified by arguments START and END, rather than by the position of point and mark. The variable `tab-width' controls the spacing of tab stops. (defalias 'tabify #[(start end) "ŠŒbˆÁyˆ`\n}ˆbˆÃÄÅÆ#…*iÆÁ”`|ˆjˆ*‚*‡" [start 0 end re-search-forward "[ ][ ][ ]*" nil t indent-tabs-mode column] 4 (#$ . 911) "r"]) (provide (quote tabify)) emacs-19.30/lisp/talk.elc100666 75424 1 4260 5775441306 13714 0ustar kwzhdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Jul 2 02:55:00 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/talk.el ;;; emacs version 19.29.4. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`talk.el' was compiled for Emacs 19.29 or later")) #@105 Alist of displays on which Emacs talk is now running. Each element has the form (DISPLAY FRAME BUFFER). (defvar talk-display-alist nil (#$ . 468)) #@54 Connect to display DISPLAY for the Emacs talk group. (defalias 'talk-connect #[(display) "ÀÁ !žAÄ !ˆ)Ä!ˆÅ ‡" [display frame-parameters selected-frame mydisp talk-add-display talk-update-buffers] 3 (#$ . 621) "sTalk to display: "]) (defalias 'talk-add-display #[(display) "À \n\"Ä ÅQÇÇ ƒ Ê A@‰ !„*Ë ÆBC\" ƒ;ÌÍÎ 8‰!!„AÏ!  EÐ \n\"B‰,‡" [assoc display talk-display-alist elt "*talk-" "*" name nil buffer frame frame-live-p make-frame-on-display buffer-name get-buffer 2 get-buffer-create delq] 4]) #@52 Disconnect this display from the Emacs talk group. (defalias 'talk-disconnect #[nil "ÀÁ !žAÄ \"ÇA@!ˆÈÉ8!ˆÊ \"Ë *‡" [display frame-parameters selected-frame mydisp assoc talk-display-alist elt delete-frame kill-buffer 2 delq talk-update-buffers] 3 (#$ . 1150) nil]) #@69 Update all the talk frames so that each shows all the talk buffers. (defalias 'talk-update-buffers #[nil "‰…/ @A@ @8ÃÄ\"È \"BÉ \"ˆ+ A‰„Ê)‡" [talk-display-alist tail 2 mapcar #[(elt) "À 8‡" [2 elt] 2] buffers this-buffer frame delq talk-split-up-frame nil] 6 (#$ . 1433)]) #@145 Split FRAME into equal-sized windows displaying the buffers in BUFFERS. Select the first of these windows, displaying the first of the buffers. (defalias 'talk-split-up-frame #[(frame buffers) "À !\nG¥Ã ÆŽÇ !ˆÈÉ !!ˆÊ ˆË\n@!ˆ\nA‰ƒ0Ì !ˆÍÎ!ˆ‚ÈÉ !!+‡" [frame-height frame buffers selected-frame old-frame lines-per-buffer ((select-frame old-frame)) select-frame select-window frame-first-window delete-other-windows switch-to-buffer split-window-vertically other-window 1] 3 (#$ . 1732)]) emacs-19.30/lisp/tar-mode.elc100666 74777 1 61661 6006764221 14331 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Jul 30 16:14:16 1995 ;;; from file /home/fsf/rms/e19/lisp/tar-mode.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`tar-mode.el' was compiled for Emacs 19.29 or later")) #@521 *The blocksize of tar files written by Emacs, or nil, meaning don't care. The blocksize of a tar file is not really the size of the blocks; rather, it is the number of blocks written with one system call. When tarring to a tape, this is the size of the *tape* blocks, but when writing to a file, it doesn't matter much. The only noticeable difference is that if a tar file does not have a blocksize of 20, tar will tell you that; all this really controls is how many null padding bytes go on the end of the tar file. (defvar tar-anal-blocksize 20 (#$ . -475)) #@479 *Non-nil means tar-mode should play fast and loose with sub-file datestamps. If this is true, then editing and saving a tar file entry back into its tar file will update its datestamp. If false, the datestamp is unchanged. You may or may not want this - it is good in that you can tell when a file in a tar archive has been changed, but it is bad for the same reason that editing a file in the tar archive at all is bad - the changed version of the file never exists on disk. (defvar tar-update-datestamp nil (#$ . -1045)) #@144 *Non-nil means Tar mode should show the date/time of each subfile. This information is useful, but it takes screen space away from file names. (defvar tar-mode-show-date nil (#$ . -1577)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ BÈÁÉÊ#ˆÈÄÉÊ#ˆÈÅÉÊ#ˆÈÆÉÊ#‡" [boundp tar-parse-info nil current-load-list tar-header-offset tar-superior-buffer tar-superior-descriptor tar-subfile-mode put permanent-local t] 4) #@49 A mind-numbingly simple implementation of setf. (defalias 'tar-setf '(macro . #[(form val) "À ÂÃ!… \"‰9ƒÅ\fE‚^\f:„$ÇÈ \"‚^\f@É=ƒ8Ê\fA@Ë\f8F‚^\f@Ì=ƒIÍ\fA@E‚^\f@Î=ƒZÏ\fA@E‚^ÇÐ \")‡" [macroexpand form boundp byte-compile-macro-environment mform setq val error "can't setf %s" aref aset 2 car setcar cdr setcdr "don't know how to setf %s"] 5 (#$ . 2021)])) #@73 syntax: (dolist (var-name list-expr &optional return-value) &body body) (defalias 'tar-dolist '(macro . #[(control &rest body) "@A@AA@ÄÅ\nDCÆÅÄ ÇDCÈ ÊÅËÅDEC\"BBE F+‡" [control val init var let _dolist_iterator_ while (car _dolist_iterator_) append body setq cdr] 12 (#$ . 2402)])) #@74 syntax: (dolist (var-name count-expr &optional return-value) &body body) (defalias 'tar-dotimes '(macro . #[(control &rest body) "@A@AA@ÄÅ\nD ÆDDÇÈ ÅEÉ\nË Ì DEC\"BB F+‡" [control val n var let _dotimes_end_ 0 while < append body setq 1+] 10 (#$ . 2696)])) (defalias 'make-tar-header '(macro . #[(name mode uid git size date ck lt ln magic uname gname devmaj devmin) "À \n \f  \n \f ¯‡" [vector name mode uid git size date ck lt ln magic uname gname devmaj devmin] 15])) (defalias 'tar-header-name '(macro . #[(x) "À ÂE‡" [aref x 0] 3])) (defalias 'tar-header-mode '(macro . #[(x) "À ÂE‡" [aref x 1] 3])) (defalias 'tar-header-uid '(macro . #[(x) "À ÂE‡" [aref x 2] 3])) (defalias 'tar-header-gid '(macro . #[(x) "À ÂE‡" [aref x 3] 3])) (defalias 'tar-header-size '(macro . #[(x) "À ÂE‡" [aref x 4] 3])) (defalias 'tar-header-date '(macro . #[(x) "À ÂE‡" [aref x 5] 3])) (defalias 'tar-header-checksum '(macro . #[(x) "À ÂE‡" [aref x 6] 3])) (defalias 'tar-header-link-type '(macro . #[(x) "À ÂE‡" [aref x 7] 3])) (defalias 'tar-header-link-name '(macro . #[(x) "À ÂE‡" [aref x 8] 3])) (defalias 'tar-header-magic '(macro . #[(x) "À ÂE‡" [aref x 9] 3])) (defalias 'tar-header-uname '(macro . #[(x) "À ÂE‡" [aref x 10] 3])) (defalias 'tar-header-gname '(macro . #[(x) "À ÂE‡" [aref x 11] 3])) (defalias 'tar-header-dmaj '(macro . #[(x) "À ÂE‡" [aref x 12] 3])) (defalias 'tar-header-dmin '(macro . #[(x) "À ÂE‡" [aref x 13] 3])) (defalias 'make-tar-desc '(macro . #[(data-start tokens) "À \nE‡" [cons data-start tokens] 3])) (defalias 'tar-desc-data-start '(macro . #[(x) "À D‡" [car x] 2])) (defalias 'tar-desc-tokens '(macro . #[(x) "À D‡" [cdr x] 2])) (byte-code "ÀÁ\nB Ã\\Ä\nB\fÅ\\Æ\nBÅ\\Ç\nBÅ\\È\nBÉ\\\nÊ\nB\nÉ\\ Ë\nB Å\\\fÌ\nB\fÍ\\Î\nBÃ\\Ï\nBÅ\\Ð\nBÑ\\Ò\nBÑ\\Ó\nBÅ\\Ô\nBÅ\\Õ\nBÀ‡" [0 tar-name-offset current-load-list 100 tar-mode-offset 8 tar-uid-offset tar-gid-offset tar-size-offset 12 tar-time-offset tar-chk-offset tar-linkp-offset 1 tar-link-offset tar-magic-offset tar-uname-offset 32 tar-gname-offset tar-dmaj-offset tar-dmin-offset tar-end-offset] 2) #@129 Return a `tar-header' structure. This is a list of name, mode, uid, gid, size, write-date, checksum, link-type, and link-name. (defalias 'tar-header-block-tokenize #[(string) "GÁWƒ ‡ÃHÃUƒÄHÃU„' SS S\n S\f HSO‰ј†EÒ˜ÂÕ×#ƒ_ÕS^×#ƒqÕS^×#ƒƒ\nÕS^\n× #ƒ•\fÕS^\fOÃU†¨ÚU?…°ÚZ‰„Á×Û\"ƒÁÜÝÞ S#Þ S#Þ !S#Þ!\"S#ã\"$S#Þ$ S#O‰…\nO… \fOÞ %S#Þ%&S#&. ‡ç‡" [string 512 nil 0 101 tar-mode-offset name-end tar-magic-offset link-end tar-gname-offset uname-end tar-dmaj-offset gname-end tar-linkp-offset link-p tar-uname-offset magic-str "ustar " "GNUtar " uname-valid-p name "[^]*" nulsexp string-match tar-name-offset tar-link-offset 48 "/$" 5 vector tar-parse-octal-integer tar-uid-offset tar-gid-offset tar-size-offset tar-time-offset tar-parse-octal-long-integer tar-chk-offset tar-dmin-offset tar-end-offset empty-tar-block] 19 (#$ . 4849)]) (defalias 'tar-parse-octal-integer #[(string &optional start end) "„Á\n„ G HÁUƒÁ‡Á\nWƒ< HÅWƒ+\f‚4\fÆ_ HÅZ\\T‰‚\f)‡" [start 0 end string n 48 8] 4]) (defalias 'tar-parse-octal-long-integer #[(string &optional start end) "„Á\n„ G HÁUƒÁ‰D‡Á‰\nWƒJ HÆYƒC Ç_ HÆZ\\\fÇ_È É\"\\Ê Ë\"T‰‚\f *D‡" [start 0 end string hi lo 48 8 ash -16 logand 65535] 5]) (defalias 'tar-parse-octal-integer-safe #[(string) "G‰ÂUƒ ÃÄ!ˆ  Wƒ4 HÇW„) HÈVƒ-ÃÉ!ˆ T‰‚+Ê!‡" [string L 0 error "empty string" i _dotimes_end_ 48 55 "'%c' is not an octal digit" tar-parse-octal-integer] 3]) #@62 Compute and return a tar-acceptable checksum for this block. (defalias 'tar-header-block-checksum #[(string) "‰Â\\ÄÄÄ Wƒ\" H\\T‰‚\f ‰ÈWƒ< H\\T‰‚& É\\,‡" [tar-chk-offset chk-field-start 8 chk-field-end 0 sum i string 512 256] 4 (#$ . 6444)]) #@57 Beep and print a warning if the checksum doesn't match. (defalias 'tar-header-block-check-checksum #[(hblock desired-checksum file-name) "Á\n!U?…à ˆÄÅ\"‡" [desired-checksum tar-header-block-checksum hblock beep message "Invalid checksum for file %s!" file-name] 3 (#$ . 6721)]) #@59 Modifies the given string to have a valid checksum field. (defalias 'tar-header-block-recompute-checksum #[(hblock) "À !ÃÄ\n\"‰G ÇÈIˆ ÉÊIˆÈ \f \fWƒ? Í Z  ZÎZHIˆ T‰ ‚ - ‡" [tar-header-block-checksum hblock chk format "%6o" chk-string l 154 0 155 32 i _dotimes_end_ 153 1] 6 (#$ . 7010)]) (defalias 'tar-clip-time-string #[(time) "À !‰ÃÄO\nÅÆOP)‡" [current-time-string time str 4 16 19 24] 5]) #@123 Store `-rw--r--r--' indicating MODE into STRING beginning at START. MODE should be an integer which is a file mode value. (defalias 'tar-grind-file-mode #[(mode string start) "  Ä\"ÅUƒÆ‚ÇIˆ È\\ É\"ÅUƒ#Æ‚$ÊIˆ Ë\\ Ì\"ÅUƒ7Æ‚8ÍIˆ Î\\ Ï\"ÅUƒKÆ‚LÇIˆ Ð\\ Ñ\"ÅUƒ_Æ‚`ÊIˆ Ò\\ Ó\"ÅUƒsÆ‚tÍIˆ Ô\\ Ð\"ÅUƒ‡Æ‚ˆÇIˆ Õ\\ Ë\"ÅUƒ›Æ‚œÊIˆ Ó\\ È\"ÅUƒ¯Æ‚°ÍIˆÂ Ö\"ÅU„ Ë\\×IˆÂ Ø\"ÅU„Ò Ò\\×Iˆ‡" [string start logand mode 256 0 45 114 1 128 119 2 64 120 3 32 4 16 5 8 6 7 1024 115 2048] 5 (#$ . 7428)]) #@53 Returns a line similar to the output of `tar -vtf'. (defalias 'tar-header-block-summarize #[(tar-hblock &optional mod-p) "ÁHÂHÃHÄHÅHÆHÇHÈHÉHÊHËH\f ÆËË˃LÜ‚MÁ\\S‰\\\\‰Ã\\‰ \\!â!G ƒ~\fGÈ\\‚Á\\\\ã\"$ÊH%$Á&ƒ–ç‚—ãIˆ$Â%è=„ª%Á=ƒ®é‚%Â=ƒ¹ê‚%Ã=ƒÄë‚%Ä=ƒÏì‚%Ç=ƒÚí‚%È=ƒåî‚%É=ƒðï‚%ð=ƒûç‚%ñ=ƒò‚%ó=ƒô‚%õ=…öIˆ÷$Ã#ˆGÁUƒ2ø!‚4GÁUƒEø!‚Gø!ù!SG^Á:;:;Wƒ…$:Z‰G:ZÂZHIˆ:T‰:‚c*$TüIˆSG^Á:;:;Wƒ»$Ã\\:\\:HIˆ:T‰:‚œ*G^Á:;:;Wƒë$:Z‰G:ZÂZHIˆ:T‰:‚É*ƒGÁ:;:;Wƒ$ :\\:HIˆ:T‰:‚û*GÁ:;:;Wƒ@$!:\\:HIˆ:T‰:‚#* Â=„O Ã=ƒ³ÄÁ:;:;Wƒ„$!G:Â\\\\\\ ÂUƒuý‚vþ:HIˆ:T‰:‚W*\fGÁ:;:;Wƒ²$!G:È\\\\\\\f:HIˆ:T‰:‚*ÿ!$G@A$%ˆ$.‡" [tar-hblock 0 1 2 3 10 11 4 5 6 7 8 link-name link-p ck time size gname uname gid uid mode name left namew groupw sizew tar-mode-show-date 18 datew slash lastdigit datestart namestart make-string 32 string type mod-p 42 nil 45 108 115 99 98 100 112 20 29 77 35 83 38 86 tar-grind-file-mode int-to-string tar-clip-time-string i _dotimes_end_ 47 "==>" "-->" put-text-property mouse-face highlight] 13 (#$ . 7952)]) #@201 Parse the contents of the tar file in the current buffer. Place a dired-like listing on the front; then narrow to it, so that only that listing is visible (and the real data of the buffer is hidden). (defalias 'tar-summarize-buffer #[nil "ÀÁ!ˆÂÄÄÆ ÇZ]ÄÉ¥]\n Ì\\dXƒˆÍ ‰Ì\\{!‰ Î=„ˆ Ì\\ÀÏ \n¥\"ˆ ÐHÑ=ƒK Ì\\ ÒH‰ÔWƒaÕÖ ÔH#ˆ  B B ÐH„„ÔVƒ„ ׉SØ\"Ù\"Ì\\\\)‚ÚÛ!ˆ Ÿ Î=ƒžÀÜ!ˆ‚¢ÀÝ!ˆ-ŠebˆÂƒÍ@ áâ A!!ˆáã!ˆA)‚®)Úä!ˆ`$Ä$}ˆåÂ!*‡" [message "Parsing tar file..." nil result 1 pos buffer-size 1024 bs 100 bs100 tokens 512 tar-header-block-tokenize empty-tar-block "Parsing tar file...%d%%" 7 20 4 size 0 error "%s has size %s - corrupted" ash -9 9 make-local-variable tar-parse-info "Parsing tar file...done." "Warning: premature EOF parsing tar file" buffer-read-only _dolist_iterator_ tar-desc insert-string tar-header-block-summarize "\n" tar-header-offset set-buffer-modified-p] 6 (#$ . 9231)]) #@38 *Local keymap for Tar mode listings. (defvar tar-mode-map nil (#$ . -10178)) (byte-code "„›Á Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊÉ#ˆÃËÌ#ˆÃÍÌ#ˆÃÎÌ#ˆÃÏÐ#ˆÃÑÒ#ˆÃÓÔ#ˆÃÕÅ#ˆÃÖÅ#ˆÃ×Ø#ˆÃÙÚ#ˆÃÛÚ#ˆÃÜÝ#ˆÃÞß#ˆÃàá#ˆÃâã#ˆÃäå#ˆÃæØ#ˆÃçè#ˆÃéê#ˆÃëì#ˆÃíî#ˆÃïðñð!B#ˆÃòó#ˆÃôõ#ˆÃö÷#ˆÃøù#ˆÃúûñû!B#ˆÃüý#ˆÃþÿ#ˆÃ@A#ˆÃBCñC!B#ˆÃDE#ˆÃFG#ˆÃHI#ˆÃJK#ˆÃLM#ˆÃNO#ˆPQRS#ˆPTRS#‡" [tar-mode-map make-keymap suppress-keymap define-key " " tar-next-line "c" tar-copy "d" tar-flag-deleted "" "e" tar-extract "f" " " [mouse-2] tar-mouse-extract "g" revert-buffer "h" describe-mode "n" "" "o" tar-extract-other-window "p" tar-previous-line "" "r" tar-rename-entry "u" tar-unflag "v" tar-view "x" tar-expunge "" tar-unflag-backwards "E" "M" tar-chmod-entry "G" tar-chgrp-entry "O" tar-chown-entry [menu-bar edit] undefined [menu-bar immediate] "Immediate" make-sparse-keymap [menu-bar immediate view] ("View This File" . tar-view) [menu-bar immediate display] ("Display in Other Window" . tar-display-other-file) [menu-bar immediate find-file-other-window] ("Find in Other Window" . tar-extract-other-window) [menu-bar immediate find-file] ("Find This File" . tar-extract) [menu-bar mark] "Mark" [menu-bar mark unmark-all] ("Unmark All" . tar-clear-modification-flags) [menu-bar mark deletion] ("Flag" . tar-flag-deleted) [menu-bar mark unmark] ("Unflag" . tar-unflag) [menu-bar operate] "Operate" [menu-bar operate chown] ("Change Owner..." . tar-chown-entry) [menu-bar operate chgrp] ("Change Group..." . tar-chgrp-entry) [menu-bar operate chmod] ("Change Mode..." . tar-chmod-entry) [menu-bar operate rename] ("Rename to..." . tar-rename-entry) [menu-bar operate copy] ("Copy to..." . tar-copy) [menu-bar operate expunge] ("Expunge Marked Files" . tar-expunge) put tar-mode mode-class special tar-subfile-mode] 6) #@739 Major mode for viewing a tar file as a dired-like listing of its contents. You can move around using the usual cursor motion commands. Letters no longer insert themselves. Type `e' to pull a file out of the tar file and into its own buffer; or click mouse-2 on the file's line in the Tar mode buffer. Type `c' to copy an entry from the tar file into another file on disk. If you edit a sub-file of this archive (as with the `e' command) and save it with Control-x Control-s, the contents of that buffer will be saved back into the tar-file buffer; in this way you can edit a file inside of a tar archive without extracting it and re-archiving it. See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. \{tar-mode-map} (defalias 'tar-mode #[nil "À ˆÁÂ!ˆÁÃ!ˆÁÄ!ˆÅÁÆ!ˆÇÁÈ!ˆÅÁÉ!ˆÅ Ê Ì Î!ˆÐÑ!ˆÁÒ!ˆÓ~ˆÔÂ!ƒO\nƒOÕ\n}ˆ‚RÖ ˆ×Ø!‡" [kill-all-local-variables make-local-variable tar-header-offset tar-parse-info require-final-newline nil revert-buffer-function tar-mode-revert enable-local-variables next-line-add-newlines tar-mode major-mode "Tar" mode-name use-local-map tar-mode-map auto-save-mode 0 write-contents-hooks (tar-mode-write-file) boundp 1 tar-summarize-buffer run-hooks tar-mode-hook] 2 (#$ . 12041)]) #@229 Minor mode for editing an element of a tar-file. This mode redefines the save-buffer command to save the current buffer back into its associated tar-file buffer. You must save that buffer to actually save your changes to disk. (defalias 'tar-subfile-mode #[(p) "ÀÁ!ƒ\n „ÂÃ!ˆÄÅ!ˆ„ ?‚\"Ç!ÈV‰ƒ9ÄÉ!ˆÊ ËÌ!ˆÌ ÎÏ!‡ÐÉ!‡" [boundp tar-superior-buffer error "This buffer is not an element of a tar file" make-local-variable tar-subfile-mode p prefix-numeric-value 0 local-write-file-hooks (tar-subfile-save-buffer) auto-save-mode nil buffer-auto-save-file-name run-hooks tar-subfile-mode-hook kill-local-variable] 3 (#$ . 13288) "P"]) (defalias 'tar-mode-revert #[(&optional no-autosave no-confirm) "ÀÀÃÄ \"ˆ~ˆ)Æ ‡" [nil tar-header-offset revert-buffer-function revert-buffer t no-confirm tar-mode] 3]) (defalias 'tar-next-line #[(p) "yˆm?… ƒ‚Ãu‡" [p tar-mode-show-date 54 36] 1 nil "p"]) (defalias 'tar-previous-line #[(p) "À [!‡" [tar-next-line p] 2 nil "p"]) #@69 Return the tar-descriptor of the current line, or signals an error. (defalias 'tar-current-descriptor #[(&optional noerror) "ÀeŠÁyˆ`)\"\n8† ?…ÄÅ!‡" [count-lines 0 tar-parse-info noerror error "This line does not describe a tar-file entry"] 3 (#$ . 14270)]) (defalias 'tar-get-descriptor #[nil "À ‰A‰ÃH\nÅH‰ƒOÇÈÉ=ƒ Ê‚MË=ƒ+Ì‚MÍ=ƒ6΂MÏ=ƒAЂMÑ=ƒLÒ‚MÓ\"ˆ\fÔUƒYÇÕ!ˆ ,‡" [tar-current-descriptor descriptor tokens 4 size 7 link-p error "This is a %s, not a real file" 5 "directory" 20 "tar directory header" 29 "multivolume-continuation" 35 "sparse entry" 38 "volume header" "link" 0 "This is a zero-length file"] 5]) #@55 Extract a file whose tar directory line you click on. (defalias 'tar-mouse-extract #[(event) "ŠÀ  8:ƒ‚à 8)‰@)!qˆŠ  8:ƒ(‚)à 8)‰A@:ƒ;\fA@@‚>\fA@)bˆÅ ˆ*Æ  8:ƒS‚Tà 8)‰@)!ˆ  8:ƒj‚kà 8)‰A@:ƒ}\fA@@‚€\fA@)bˆÇ ‡" [window-buffer event 2 1 position tar-get-descriptor select-window tar-extract] 4 (#$ . 14917) "e"]) #@70 In Tar mode, extract this entry of the tar file into its own buffer. (defalias 'tar-extract #[(&optional other-window-p) "Á=à ‰A‰ÆH ÈH \f@\nË\\\\‰\f \\ pÏÐ !Ï!ÒÓR†=\n×!Ù„®Û!ÜÝŽ~ˆŠqˆÞ\f #ˆÆbˆßàQ!á!\"Šqˆ#)#ä ˆå!ˆæç!ˆæè!ˆ'\f(éê!ˆëÙ!ˆ)qˆ)\nƒÃì!ˆ…ßí‰.‚ßï=ƒÐð!‚߃Ûñ!‚ßò!. ‡" [other-window-p view view-p tar-get-descriptor descriptor tokens 0 name 4 size tar-header-offset -1 start end tar-buffer file-name-nondirectory buffer-file-name tarname " (" ")" bufname buffer-read-only read-only-p get-buffer buffer nil just-created get-buffer-create t ((narrow-to-region 1 tar-header-offset)) insert-buffer-substring expand-file-name ":" abbreviate-file-name buffer-file-truename default-directory normal-mode rename-buffer make-local-variable tar-superior-buffer tar-superior-descriptor tar-subfile-mode 1 set-buffer-modified-p view-buffer kill-buffer view-exit-action display display-buffer switch-to-buffer-other-window switch-to-buffer] 5 (#$ . 15258) nil]) #@66 *In Tar mode, find this entry of the tar file in another window. (defalias 'tar-extract-other-window #[nil "ÀÁ!‡" [tar-extract t] 2 (#$ . -16305) nil]) #@69 *In Tar mode, display this entry of the tar file in another window. (defalias 'tar-display-other-window #[nil "ÀÁ!‡" [tar-extract display] 2 (#$ . -16463) nil]) #@53 *In Tar mode, view the tar file entry on this line. (defalias 'tar-view #[nil "ÀÁ!‡" [tar-extract view] 2 (#$ . -16630) nil]) #@57 Read a file name with this line's entry as the default. (defalias 'tar-read-file-name #[(&optional prompt) "„ÁÂà AÄH!ÂÆÇ ! È$! Ê !˘„*Ì !ƒEÍÎ \"ƒ< ĉ•SO‚> ÏÊ !Q  *‡" [prompt "Copy to: " expand-file-name tar-current-descriptor 0 default-file read-file-name file-name-directory nil target file-name-nondirectory "" file-directory-p string-match "/$" "/"] 6 (#$ . 16762)]) #@168 *In Tar mode, extract this entry of the tar file into a file on disk. If TO-FILE is not supplied, it is prompted for, defaulting to the name of the current tar-entry. (defalias 'tar-copy #[(&optional to-file) "À ‰A‰ÃH\nÅH @È\\\\‰ \\\n  \f\fŒ~ˆÍ\fÎ\"Ï=ƒLÍÎ\"Ï=ƒLÏ\fÎ=…F B Î\fÎ \n#ˆ)ÑÒ\f#.‡" [tar-get-descriptor descriptor tokens 0 name 4 size tar-header-offset -1 start end inhibit-file-name-handlers inhibit-file-name-operation find-file-name-handler write-region jka-compr-handler to-file message "Copied tar entry %s to %s"] 5 (#$ . -17157) (list (tar-read-file-name))]) #@113 *In Tar mode, mark this sub-file to be deleted from the tar file. With a prefix argument, mark that many files. (defalias 'tar-flag-deleted #[(p &optional unflag) "Àyˆ ÀWƒ [‚ À\n WƒAÄ !ƒ-ÆÇ!ˆ ƒ*È‚+Écˆ ÀWƒ7Ê‚8Çyˆ\nT‰‚*m?…IËu‡" [0 p i _dotimes_end_ tar-current-descriptor unflag delete-char 1 " " "D" -1 36] 3 (#$ . -17768) "p"]) #@125 *In Tar mode, un-mark this sub-file if it is marked to be deleted. With a prefix argument, un-mark that many files forward. (defalias 'tar-unflag #[(p) "À Â\"‡" [tar-flag-deleted p t] 3 (#$ . -18119) "p"]) #@126 *In Tar mode, un-mark this sub-file if it is marked to be deleted. With a prefix argument, un-mark that many files backward. (defalias 'tar-unflag-backwards #[(p) "À [Â\"‡" [tar-flag-deleted p t] 3 (#$ . -18332) "p"]) #@54 Expunge the tar-entry specified by the current line. (defalias 'tar-expunge-internal #[nil "À ‰A @\nÄH\nÆH\nÈH @\n  >A\f ƒ*ÄÄyˆ` ΈÎuˆ` Z `|ˆZ*Ñ  \" ~ˆ\nÒ\\\\‰Ô‰Õ\\Ö\"×\"Ø\\\\|ˆZ\fƒ—@‰‰@Z ˆA)‚|.\fÝ}‡" [tar-current-descriptor descriptor tokens line 0 name 4 size 7 link-p start tar-parse-info following-descs line-start nil line-len tar-header-offset delq -513 data-start ash 511 -9 9 512 data-end data-length _dolist_iterator_ desc 1] 6 (#$ . 18556)]) #@164 *In Tar mode, delete all the archived files flagged for deletion. This does not modify the disk image; you must save the tar file itself for this to be permanent. (defalias 'tar-expunge #[(&optional noconfirm) "„\nÁÂ!…CÊÃbˆm„)ÅÆ!ƒ#Ç ˆ\fT‚Èyˆ‚É ˆÈ\n}ˆ)\fÃUƒ>ËÌ!‚BËÍ\f\")‡" [noconfirm y-or-n-p "Expunge files marked for deletion? " 0 n looking-at "D" tar-expunge-internal 1 tar-pad-to-blocksize tar-header-offset message "Nothing to expunge." "%s files expunged. Be sure to save this buffer."] 3 (#$ . -19082) nil]) #@49 Remove the stars at the beginning of each line. (defalias 'tar-clear-modification-flags #[nil "ŠÀbˆ` W…gÂ=„ÃÀ!ˆÄcˆÀyˆ‚)‡" [1 tar-header-offset 32 delete-char " "] 2 (#$ . 19618) nil]) #@368 *Change the user-id associated with this entry in the tar file. If this tar file was written by GNU tar, then you will be able to edit the user id as a string; otherwise, you must edit it as a number. You can force editing as a number by calling this with a prefix arg. This does not modify the disk image; you must save the tar file itself for this to be permanent. (defalias 'tar-chown-entry #[(new-uid) ";ƒÁ AÂIˆÃ\fÅP\"‡Á AÆIˆÃÈÉ\"ÊËOÌP\"‡" [new-uid tar-current-descriptor 10 tar-alter-one-field tar-uname-offset "" 2 tar-uid-offset format "%6o" 0 6 " "] 5 (#$ . -19815) (list (let ((tokens (tar-desc-tokens (tar-current-descriptor)))) (if (or current-prefix-arg (not (tar-header-magic tokens))) (let (n) (while (not (numberp (setq n (read-minibuffer "New UID number: " (format "%s" (tar-header-uid tokens))))))) n) (read-string "New UID string: " (tar-header-uname tokens)))))]) #@370 *Change the group-id associated with this entry in the tar file. If this tar file was written by GNU tar, then you will be able to edit the group id as a string; otherwise, you must edit it as a number. You can force editing as a number by calling this with a prefix arg. This does not modify the disk image; you must save the tar file itself for this to be permanent. (defalias 'tar-chgrp-entry #[(new-gid) ";ƒÁ AÂIˆÃ\fÅP\"‡Á AÆIˆÃÈÉ\"ÊËOÌP\"‡" [new-gid tar-current-descriptor 11 tar-alter-one-field tar-gname-offset "" 3 tar-gid-offset format "%6o" 0 6 " "] 5 (#$ . -20716) (list (let ((tokens (tar-desc-tokens (tar-current-descriptor)))) (if (or current-prefix-arg (not (tar-header-magic tokens))) (let (n) (while (not (numberp (setq n (read-minibuffer "New GID number: " (format "%s" (tar-header-gid tokens))))))) n) (read-string "New GID string: " (tar-header-gname tokens)))))]) #@159 *Change the name associated with this entry in the tar file. This does not modify the disk image; you must save the tar file itself for this to be permanent. (defalias 'tar-rename-entry #[(new-name) "Á˜ƒ\nÂÃ!ˆGÄVƒÂÅ!ˆÆ AÇIˆÈÇÉÊÇ\"PÇÊO\"‡" [new-name "" error "zero length name" 98 "name too long" tar-current-descriptor 0 tar-alter-one-field make-string 99] 6 (#$ . -21619) (list (read-string "New name: " (tar-header-name (tar-desc-tokens (tar-current-descriptor)))))]) #@170 *Change the protection bits associated with this entry in the tar file. This does not modify the disk image; you must save the tar file itself for this to be permanent. (defalias 'tar-chmod-entry #[(new-mode) "À AÁ\nIˆÃ\fÅÆ\n\"ÇÈOÉP\"‡" [tar-current-descriptor 1 new-mode tar-alter-one-field tar-mode-offset format "%6o" 0 6 " "] 5 (#$ . -22103) (list (tar-parse-octal-integer-safe (read-string "New protection (octal): ")))]) (defalias 'tar-alter-one-field #[(data-position new-data-string) "À ‰AÃŽŠÄyˆ`Æyˆ `|ˆÇ\n!ȱˆd )~ˆ @ Ê\\\\‰ \f\\bˆ`` G\\|ˆ cˆÎ ‰Ï\\{! \\bˆ``Ò\\|ˆÓÔ\"cˆÄcˆÕcˆ\nÖIˆ× ‰Ï\\{\nÄH#.‡" [tar-current-descriptor descriptor tokens ((narrow-to-region 1 tar-header-offset)) 0 p 1 tar-header-block-summarize "\n" tar-header-offset -513 start data-position new-data-string tar-header-block-checksum 512 chk tar-chk-offset 8 format "%6o" 32 6 tar-header-block-check-checksum] 6]) (defalias 'tar-octal-time #[(timeval) "@A@ÃÄÅ\nÆ\"ÇÅÈ\nÉ\"Ê\"È Ë\"ÌV\"È Í\"$c*‡" [timeval lobits hibits format "%05o%01o%05o" lsh -2 logior logand 3 1 32768 0 32767] 8]) #@182 In tar subfile mode, save this buffer into its parent tar-file buffer. This doesn't write anything to disk; you must save the parent tar-file buffer to make your changes permanent. (defalias 'tar-subfile-save-buffer #[nil "ÀÁ!ƒ\n „ÂÃ!ˆÀÄ!ƒ\f„ÂÅ!ˆŠpÆ \f qˆA\n@ \nÌH \nÎHЉÑ\\Ò\"Ó\">‰A„`ÂØ!ˆÙŽŠ~ˆ Û\\\\‰ЉÑ\\Ò\"Ó\"\\|ˆbˆÞ !ˆÐ‰Ñ\\Ò\"Ó\"\\bˆàZÌ\"cˆ\nÎIˆZ!\"\"ƒÕ\"@‰#‰@!\\ ˆ\"A\")‚º*äZ‰%&\\bˆ``ç\\|ˆèé\"cˆêcˆ+ƒ %,\\bˆ``ç\\|ˆíî !cˆêcˆï%{!0%1\\bˆ``ò\\|ˆèó0\"cˆÌcˆêcˆ\nô0Iˆ*GGZ5öbˆ÷5!ˆÌyˆ`øù ø“:;<öyˆ`;ýþ\nÿ\"@\"ˆ<;|ˆA:!.B ˆ. Cÿ!ˆ qˆCø!ˆDEF !\"ˆ,ÿ‡" [boundp tar-superior-buffer error "This buffer has no superior tar file buffer" tar-superior-descriptor "This buffer doesn't have an index into its superior tar file!" buffer-size descriptor subfile-size subfile tokens start 0 name 4 size ash 511 -9 9 size-pad tar-parse-info head following-descs "Can't find this tar file entry in its parent tar file!" ((narrow-to-region 1 tar-header-offset)) tar-header-offset -1 data-start data-end insert-buffer subfile-size-pad make-string difference _dolist_iterator_ desc 512 header-start tar-size-offset 12 format "%11o" 32 tar-update-datestamp tar-time-offset tar-octal-time current-time tar-header-block-checksum chk tar-chk-offset 8 "%6o" 6 position 1 next-line nil make-marker m after p insert-before-markers tar-header-block-summarize t "\n" marker-position tar-pad-to-blocksize set-buffer-modified-p message "Saved into tar-buffer `%s'. Be sure to save that buffer!" buffer-name] 6 (#$ . 23198) nil]) #@100 If we are being anal about tar file blocksizes, fix up the current buffer. Leaves the region wide. (defalias 'tar-pad-to-blocksize #[nil "…}~ˆ GS 8‰@\nA‰ÅH‰ƒÇ‚\"\fÈH  \\\nËÌ\"‰ ‰\nS ¥_\\φEÇ\n\\bˆÒ T†SÇ\\Vƒj†`Ç\\Ò T|‚{Ó†qÇ\\Ò TZÇ\"c. ‡" [tar-anal-blocksize tar-parse-info last-desc start tokens 7 link-p 0 4 size data-end ash 9 bbytes pad-to t inhibit-read-only tar-header-offset buffer-size make-string] 5 (#$ . 24838)]) (defalias 'tar-mode-write-file #[nil "ÀŽŠ~ˆÁ\nd ÄÅ%ˆÆ ˆ*Ň" [((narrow-to-region 1 tar-header-offset)) write-region tar-header-offset buffer-file-name nil t tar-clear-modification-flags] 6]) (provide (quote tar-mode)) emacs-19.30/lisp/tcl-mode.elc100666 12120 1 26066 6045214360 14300 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:26:44 1995 ;;; from file /home/fsf/rms/e19/lisp/tcl-mode.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`tcl-mode.el' was compiled for Emacs 19.29 or later")) (require (quote comint)) #@54 Default tcl/tk application to run in tcl subprocess. (defvar tcl-default-application "wish" (#$ . 501)) #@78 Command switches for `tcl-default-application'. Should be a list of strings. (defvar tcl-default-command-switches nil (#$ . 611)) #@60 The active tcl subprocess corresponding to current buffer. (defvar tcl-process nil (#$ . 747)) #@71 Buffer used for communication with tcl subprocess for current buffer. (defvar tcl-process-buffer nil (#$ . 848)) #@68 *Non-nil means display tcl-process-buffer after sending a command. (defvar tcl-always-show t (#$ . -967)) #@28 Keymap used with tcl mode. (defvar tcl-mode-map nil (#$ . 1079)) #@35 Prefix for all tcl-mode commands. (defvar tcl-prefix-key "" (#$ . 1150)) #@38 Hooks called when tcl mode fires up. (defvar tcl-mode-hook nil (#$ . 1230)) #@48 Start of special region for tcl communication. (defvar tcl-region-start (make-marker) (#$ . 1312)) #@46 End of special region for tcl communication. (defvar tcl-region-end (make-marker) (#$ . 1417)) #@50 Amount by which tcl subexpressions are indented. (defvar tcl-indent-level 4 (#$ . 1518)) #@44 Default command used when sending regions. (defvar tcl-default-eval "eval" (#$ . 1613)) #@29 Keymap for tcl-mode's menu. (defvar tcl-mode-menu (make-sparse-keymap "Tcl-Mode") (#$ . 1707)) #@48 Default expressions to highlight in TCL modes. (defvar tcl-font-lock-keywords (quote (("\\<\\(itcl_class\\|method\\|proc\\)\\>[ ]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) "\\<\\(break\\|c\\(ase\\|on\\(structor\\|tinue\\)\\)\\|de\\(fault\\|structor\\)\\|e\\(lse\\(\\|if\\)\\|rror\\|val\\|xit\\)\\|for\\(\\|_\\(array_keys\\|file\\|recursive_glob\\)\\|each\\)\\|i\\([fn]\\|tcl_class\\)\\|loop\\|proc\\|return\\|switch\\|then\\|uplevel\\|while\\)\\>" ("\\<\\(common\\|global\\|inherit\\|p\\(rotected\\|ublic\\)\\|upvar\\)\\>" . font-lock-type-face))) (#$ . 1808)) #@73 Imenu generic expression for tcl-mode. See `imenu-generic-expression'. (defvar tcl-imenu-generic-expression (quote ("^[ ]*proc[ ]+\\(\\(\\s_\\|\\sw\\)+\\)" 1)) (#$ . 2415)) #@84 Major mode for editing tcl scripts. The following keys are bound: \{tcl-mode-map}  (defalias 'tcl-mode #[nil "À‰à ˆÄÆÈÉ!ÀLˆÈÊ!ÀLˆÈË!ˆÈÌ!ÍLˆÈÎ!ÏLˆÈÐ!ÑLˆÈÒ!ÓLˆÈÔ!LˆÈÖ!ˆ„GØ ˆÙ!ˆÚÛ !ˆÜÝÞ\"ˆÜßà\"ˆŠebˆáâ!ƒÈã!ä”ä•{Lˆå”ƒ÷å”bˆÈË!ÀLˆ`å•Wƒ÷æp!`å•Xƒ~ç è !C\" ‚~gÝ=ƒ©äyˆ‚o„°éuˆhê=ƒ÷äuˆáë!ƒ÷Èã!ä”ä•{Lˆå”ƒ÷å”bˆÈË!ÀLˆ`å•Wƒ÷æp!`å•XƒØç è !C\" ‚Ø)ìí!*‡" [nil s switches kill-all-local-variables tcl-mode major-mode "TCL" mode-name make-local-variable tcl-process tcl-process-buffer tcl-default-command-switches indent-line-function tcl-indent-line comment-start "# " comment-start-skip "# *" font-lock-defaults (tcl-font-lock-keywords nil nil ((95 . "w"))) imenu-generic-expression tcl-imenu-generic-expression tcl-default-eval tcl-mode-map tcl-setup-keymap use-local-map set-syntax-table copy-syntax-table modify-syntax-entry 35 "<" 10 ">" looking-at "#![ ]*\\([^ ]*\\)[ ]\\(.*[ ]\\)-f" tcl-default-application 1 2 read append prin1-to-string -1 92 "exec[ ]+\\([^ ]*\\)[ ]\\(.*[ ]\\)*-f" run-hooks tcl-mode-hook] 4 (#$ . 2597) nil]) #@165 Set up keymap for tcl mode. If the variable `tcl-prefix-key' is nil, the bindings go directly to `tcl-mode-map', otherwise they are prefixed with `tcl-prefix-key'. (defalias 'tcl-setup-keymap #[nil "À  ÃÄ B#ˆƒÀ ‚  ÈÉ#ˆÂÊË#ˆÂÌÍ#ˆÂÎÏ#ˆÂÐÑ#ˆÂÒÓ#ˆÂÔÕ#ˆÂÖ×#ˆÂØÙ#ˆÂÚÛ#ˆÂÜÝ#ˆÂÞß#ˆÂàá#ˆÂâã#ˆÂäå#ˆ…ŒÂ #)‡" [make-sparse-keymap tcl-mode-map define-key [menu-bar tcl-mode] "Tcl-Mode" tcl-mode-menu tcl-prefix-key map [125] tcl-electric-brace "å" tcl-send-current-line "ò" tcl-send-region "÷" tcl-send-proc "á" tcl-send-buffer "ñ" tcl-kill-process "õ" tcl-restart-with-whole-file "ó" tcl-show-process-buffer "è" tcl-hide-process-buffer "é" tcl-get-error-info "Û" tcl-beginning-of-proc "Ý" tcl-end-of-proc "“" tcl-set-tcl-region-start "…" tcl-set-tcl-region-end "’" tcl-send-tcl-region] 5 (#$ . 3661)]) #@80 Indent current line as tcl code. Return the amount the indentation changed by. (defalias 'tcl-indent-line #[nil "ÀÁ!Á‰‰d`ZÇyˆ`ÈÁwˆŠgÉ=ƒA\nZÇ]ËuˆÌÍ!ƒ˔˕|ˆÎÏ\nS\"ˆ‚)iZ‰ÇUƒ]d\nZ`Vƒrd\nZbˆ‚r `|ˆjˆd\nZ`Vƒrd\nZbˆ\f-‡" [tcl-calculate-indentation nil pos case-fold-search shift-amt beg indent 0 " " 125 tcl-indent-level 1 looking-at "\\([ ]*\\)}" insert-char 32] 7 (#$ . 4502)]) #@121 Return appropriate indentation for current line as tcl code. In usual case returns an integer: the column to indent to. (defalias 'tcl-calculate-indentation #[(&optional parse-start) "`Š ƒ\n bÂyˆoƒà ‚ˆÄuˆhÅ=ƒDà Âyˆoƒ/‰\\‚@ÄuˆhÅ=„?‰\\‚@Â\\‚ˆÇuˆÈÉÊË#ƒ}à ŠÂyˆo?…`ÄuˆhÅ=)ƒk‰\\‚lÂZgÌ=ƒx‚yÂ\\‚ˆbˆÂyˆÄyˆÃ *‡" [pos parse-start 0 current-indentation -1 92 tcl-indent-level 1 re-search-backward "\\(^[^ \n #]\\)\\|\\({\\s *[#\n]\\)\\|\\(}\\s *\n\\)" nil t 123] 4 (#$ . 4910)]) #@37 Insert `}' and indent line for tcl. (defalias 'tcl-electric-brace #[(arg) "ÀÁ !\"ˆÄ ˆÅ ‡" [insert-char 125 prefix-numeric-value arg tcl-indent-line blink-matching-open] 4 (#$ . 5412) "P"]) #@235 Move backward to the beginning of a tcl proc (or similar). With argument, do it that many times. Negative arg -N means move forward to Nth following beginning of proc. Returns t unless search stops due to beginning or end of buffer. (defalias 'tcl-beginning-of-proc #[(&optional arg) "„ÁÂÃÆWƒÇÈ!ƒÁuˆÆWƒ7ÉÈÂÃ#ƒ/TÂÂƉ‚ ƒ>ÆyˆÆVƒ[ÊÈÂÃ#ƒSS‰‚?ÂƉ‚?\f*‡" [arg 1 nil t ret found 0 looking-at "^[^ \n#][^\n]*{[ ]*$" re-search-forward re-search-backward] 5 (#$ . 5609) "P"]) #@225 Move forward to next end of tcl proc (or similar). With argument, do it that many times. Negative argument -N means move back to Nth preceding end of proc. This function just searches for a `}' at the beginning of a line. (defalias 'tcl-end-of-proc #[(&optional arg) "„ÁÂÃÆWƒ\"n„\"ŠÆyˆg)Ç=ƒ\"ÈuˆÆVƒ@ÉÊÂÃ#ƒ8SÂ\"ÂƉ‚#ÆWƒ^ËÊÂÃ#ƒVTÂ@ÂƉ‚A ƒeˆ\f*‡" [arg 1 nil t ret found 0 125 -1 re-search-forward "^}" re-search-backward] 5 (#$ . 6118) "P"]) #@50 Start a tcl process named NAME, running PROGRAM. (defalias 'tcl-start-process #[(name program &optional startfile &rest switches) "„ ÂÃ\f %È! ŠqˆÊ‰ )‡" [switches tcl-default-command-switches apply make-comint name program startfile tcl-process-buffer get-buffer-process tcl-process "^[^% ]*%\\( %\\)* *" comint-prompt-regexp] 6 (#$ . 6600)]) #@37 Kill tcl subprocess and its buffer. (defalias 'tcl-kill-process #[nil "…Á!‡" [tcl-process-buffer kill-buffer] 2 (#$ . 6963) nil]) #@57 Set start of region for use with `tcl-send-tcl-region'. (defalias 'tcl-set-tcl-region-start #[(&optional arg) " †`“‡" [tcl-region-start arg nil] 3 (#$ . 7103) nil]) #@55 Set end of region for use with `tcl-send-tcl-region'. (defalias 'tcl-set-tcl-region-end #[(&optional arg) " †`“‡" [tcl-region-end arg nil] 3 (#$ . 7278) nil]) #@122 Send current line to tcl subprocess, found in `tcl-process'. If `tcl-process' is nil or dead, start a new process first. (defalias 'tcl-send-current-line #[nil "ŠÀyˆ`)ŠÁˆ`)\fƒÅ\f!Æ=„ lj\"ˆÉ\f \n{\"ˆÊyˆ …3Ì !*‡" [0 nil end start tcl-process process-status run tcl-start-process tcl-default-application comint-simple-send 1 tcl-always-show display-buffer tcl-process-buffer] 4 (#$ . 7448) nil]) #@59 Send region to tcl subprocess, wrapped in `eval { ... }'. (defalias 'tcl-send-region #[(start end) "ƒ\nÁ\n!„Ã\f‰\"ˆÅÇ {ÊR\"ˆ …%Ì\n!‡" [tcl-process comint-check-proc tcl-process-buffer tcl-start-process tcl-default-application comint-simple-send tcl-default-eval " {\n" start end "\n}" tcl-always-show display-buffer] 6 (#$ . 7858) "r"]) #@70 Send preset tcl region to tcl subprocess, wrapped in `eval { ... }'. (defalias 'tcl-send-tcl-region #[nil "ƒ „\fÂÃ!ˆ\fƒÅ!„lj\"ˆÉ\f\nË {ÌR\"ˆ …2Î!‡" [tcl-region-start tcl-region-end error "tcl-region not set" tcl-process comint-check-proc tcl-process-buffer tcl-start-process tcl-default-application comint-simple-send tcl-default-eval " {\n" "\n}" tcl-always-show display-buffer] 6 (#$ . 8213) nil]) #@70 Send proc around point to tcl subprocess, wrapped in `eval { ... }'. (defalias 'tcl-send-proc #[nil "À‰ŠÃ ˆ`Ä ˆ`) ƒÆ!„!È ‰\"ˆÊ  Ì\n {ÍR\"ˆ…6Ï!*‡" [nil end beg tcl-beginning-of-proc tcl-end-of-proc tcl-process comint-check-proc tcl-process-buffer tcl-start-process tcl-default-application comint-simple-send tcl-default-eval " {\n" "\n}" tcl-always-show display-buffer] 6 (#$ . 8637) nil]) #@65 Send whole buffer to tcl subprocess, wrapped in `eval { ... }'. (defalias 'tcl-send-buffer #[nil "ƒ\nÁ\n!„Ã\f‰\"ˆÅ ƒ#ÆÈed{ÉR\"ˆ‚,ÆÊË ÌQ\"ˆ …4Î\n!‡" [tcl-process comint-check-proc tcl-process-buffer tcl-start-process tcl-default-application buffer-modified-p comint-simple-send tcl-default-eval " {\n" "\n}" "source " buffer-file-name "\n" tcl-always-show display-buffer] 6 (#$ . 9048) nil]) #@75 Send string `set errorInfo' to tcl subprocess and display the tcl buffer. (defalias 'tcl-get-error-info #[nil "ƒ\nÁ\n!„Ã\f‰\"ˆÅÆ\"ˆÇ\n!‡" [tcl-process comint-check-proc tcl-process-buffer tcl-start-process tcl-default-application comint-simple-send "set errorInfo\n" display-buffer] 3 (#$ . 9457) nil]) #@54 Restart tcl subprocess and send whole file as input. (defalias 'tcl-restart-with-whole-file #[nil "À ˆÁ\n‰\"ˆÃ ‡" [tcl-kill-process tcl-start-process tcl-default-application tcl-send-buffer] 3 (#$ . 9771) nil]) #@52 Make sure `tcl-process-buffer' is being displayed. (defalias 'tcl-show-process-buffer #[nil "À !‡" [display-buffer tcl-process-buffer] 2 (#$ . 9988) nil]) #@55 Delete all windows that display `tcl-process-buffer'. (defalias 'tcl-hide-process-buffer #[nil "À !‡" [delete-windows-on tcl-process-buffer] 2 (#$ . 10149) nil]) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆÀ ØÙ#ˆÀ ÚÛ#ˆÀ ÜÝ#ˆÞß!‡" [define-key tcl-mode-menu [restart-with-whole-file] ("Restart With Whole File" . tcl-restart-with-whole-file) [kill-process] ("Kill Process" . tcl-kill-process) [hide-process-buffer] ("Hide Process Buffer" . tcl-hide-process-buffer) [get-error-info] ("Get Error Info" . tcl-get-error-info) [show-process-buffer] ("Show Process Buffer" . tcl-show-process-buffer) [end-of-proc] ("End Of Proc" . tcl-end-of-proc) [beginning-of-proc] ("Beginning Of Proc" . tcl-beginning-of-proc) [send-tcl-region] ("Send Tcl-Region" . tcl-send-tcl-region) [set-tcl-regio-end] ("Set Tcl-Region End" . tcl-set-tcl-region-end) [set-tcl-region-start] ("Set Tcl-Region Start" . tcl-set-tcl-region-start) [send-current-line] ("Send Current Line" . tcl-send-current-line) [send-region] ("Send Region" . tcl-send-region) [send-proc] ("Send Proc" . tcl-send-proc) [send-buffer] ("Send Buffer" . tcl-send-buffer) provide tcl-mode] 4) emacs-19.30/lisp/tcp.elc100666 13437 1 3003 5744577456 13507 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:52:14 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/tcp.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/tcp.el' was compiled for Emacs 19")) (provide (quote tcp)) #@66 *The name of the program emulating open-network-stream function. (defvar tcp-program-name "tcp" (#$ . -497)) #@713 Open a TCP connection for a service to a host. Returns a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. Args are NAME BUFFER HOST SERVICE. NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer (or buffer-name) to associate with the process. Process output goes at end of that buffer, unless you specify an output stream or filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated with any buffer Third arg is name of the host to connect to. Fourth arg SERVICE is name of the service desired, or an integer specifying a port number to connect to. (defalias 'open-network-stream #[(name buffer host service) "À \n \f ;ƒ ‚Æ !%È!ˆ)‡" [start-process name buffer tcp-program-name host service int-to-string proc process-kill-without-query] 7 (#$ . 613)]) emacs-19.30/lisp/telnet.elc100666 13437 13 12533 5744577460 13775 0ustar jimbuser;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:52:14 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/telnet.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/telnet.el' was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!„\fÄà BÂÆ!„ÇÆ BÂÈ!„&ÉÈ BÂÊ!„3Ç\nÊ BËÂÌ!„AÍ\fÌ BÎÌÏÐ#ˆÌ!ˆËÂÑ!„XÒÑ BÎÑÏÓ#ˆÑ!‡" [require comint boundp telnet-new-line " " current-load-list telnet-mode-map nil telnet-prompt-pattern "^[^#$%>\n]*[#$%>] *" telnet-replace-c-g make-variable-buffer-local telnet-remote-echoes t put variable-documentation "True if the telnet process will echo input." telnet-interrupt-string "" "String sent by C-c."] 5) #@74 Number of output strings from telnet process while looking for password. (defvar telnet-count 0 (#$ . 920)) (make-variable-buffer-local (quote telnet-count)) #@45 Program to run to open a telnet connection. (defvar telnet-program "telnet" (#$ . 1084)) #@147 Initial value of `telnet-count'. Should be set to the negative of the number of terminal writes telnet will make setting up the host connection. (defvar telnet-initial-count -50 (#$ . 1180)) #@237 Maximum value `telnet-count' can have. After this many passes, we stop looking for initial setup data. Should be set to the number of terminal writes telnet will make rejecting one login and prompting again for a username and password. (defvar telnet-maximum-count 4 (#$ . 1379)) (defalias 'telnet-interrupt-subjob #[nil "ÀÁ\n\"‡" [send-string nil telnet-interrupt-string] 3 nil nil]) (defalias 'telnet-c-z #[nil "ÀÁÂ\"‡" [send-string nil ""] 3 nil nil]) (defalias 'send-process-next-char #[nil "ÀÁÂÃÅ Á)!\"‡" [send-string nil char-to-string t inhibit-quit read-char quit-flag] 5 nil nil]) (byte-code "„!Á \n¤ÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÁ‡" [telnet-mode-map make-sparse-keymap comint-mode-map define-key " " telnet-send-input "" send-process-next-char "" telnet-interrupt-subjob "" telnet-c-z] 4) #@55 Tries to put correct initializations in. Needs work. (defalias 'telnet-check-software-type-initialize #[(string) "ÀÂÃ\f\"ƒ Ç‚6ÂÉ\f\"ƒÊ‚6ÂË\f\"ƒ,Ì‚6ÂÍ\f\"ƒ6Î)‰‡" [t case-fold-search string-match "unix" string comint-prompt-regexp telnet-prompt-pattern "\n" telnet-new-line "tops-20" "[@>]*" "its" "^[^*>\n]*[*>] *" "explorer" 10 telnet-replace-c-g] 3 (#$ . 2191)]) (defalias 'telnet-initial-filter #[(proc string) "ÀÁ\n\"ƒÃÄ !!ˆÆÇ!‡ÀÈ\n\"ƒ+É \n\"ˆÊ Ì ÍÎÏ\"P\"‡Ñ\n!ˆÉ \n\"ˆ VƒAÓ É\"‡ T‰ ‡" [string-match "No such host" string kill-buffer process-buffer proc error "No such host." "passw" telnet-filter 0 telnet-count send-string comint-read-noecho "Password: " t telnet-new-line telnet-check-software-type-initialize telnet-maximum-count set-process-filter] 5]) (defalias 'telnet-simple-send #[(proc string) "À \n\"ˆÀ \"‡" [comint-send-string proc string telnet-new-line] 3]) (defalias 'telnet-filter #[(proc string) "ŠÀ !qˆÂà !!`\fZ…Â!Èp!‰ …(Ê ! \fbˆÌ !ˆÃ !`Γˆ ƒFÏ  Ð#ˆƒRΓˆÑ\fxˆ`\fVƒd`S`|ˆ‚Rà !bˆƒwÓ\f`ÔÐ%ˆ ÕV…ƒÃ ! \\b.‡" [process-buffer proc marker-position process-mark last-insertion delta comint-last-input-end ie get-buffer-window w window-start ws insert-before-markers string nil set-window-start t "^ " telnet-replace-c-g subst-char-in-region 7 0] 7]) (defalias 'telnet-send-input #[nil "À ˆ …\n\n |‡" [comint-send-input telnet-remote-echoes comint-last-input-start comint-last-input-end] 2 nil nil]) #@190 Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer `*telnet-HOST*'. Normally input is edited in Emacs and sent a line at a time. (defalias 'telnet #[(host) "ÀÂÃ\fÅÆ#PÈÉÉQ!\nÆ \nƒ-Ì\n!ƒ-ÍÉÉQ!‚]ÍÎ\"!ˆÌp! Ð Ñ\"ˆÒ !ˆÓ ˆÔ Õ\fÖQ\"ˆ× ˆØ‰,‡" [(32 9) comint-delimiter-argument-list "telnet-" comint-arguments host 0 nil name get-buffer "*" buffer process get-buffer-process pop-to-buffer make-comint telnet-program set-process-filter telnet-initial-filter accept-process-output erase-buffer send-string "open " "\n" telnet-mode telnet-simple-send comint-input-sender telnet-initial-count telnet-count] 5 (#$ . 3681) "sOpen telnet connection to host: "]) #@322 This mode is for using telnet (or rsh) from a buffer to another host. It has most of the same commands as comint-mode. There is a variable ``telnet-interrupt-string'' which is the character sent to try to stop execution of a job on the remote host. Data is sent to the remote host when RET is typed. \{telnet-mode-map}  (defalias 'telnet-mode #[nil "À ˆÁà Ç!ˆÉÊ!‡" [comint-mode telnet-mode major-mode "Telnet" mode-name telnet-prompt-pattern comint-prompt-regexp use-local-map telnet-mode-map run-hooks telnet-mode-hook] 2 (#$ . 4421) nil]) #@187 Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer `*rsh-HOST*'. Normally input is edited in Emacs and sent a line at a time. (defalias 'rsh #[(host) "ÀÁ!ˆÂ PÅÆ\fÈ $!ˆÉÊ\f!Ë\"ˆÌ ˆÍ‰)‡" [require shell "rsh-" host name pop-to-buffer make-comint remote-shell-program nil set-process-filter get-process telnet-initial-filter telnet-mode -16 telnet-count] 6 (#$ . 4976) "sOpen rsh connection to host: "]) (provide (quote telnet)) emacs-19.30/lisp/tempo.elc100666 12120 1 41730 5771610463 13724 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jun 20 14:19:20 1995 ;;; from file /home/fsf/rms/e19/lisp/tempo.el ;;; emacs version 19.28.95.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`tempo.el' was compiled for Emacs 19.29 or later")) #@137 *Prompt user for strings in templates. If this variable is non-nil, `tempo-insert' prompts the user for text to insert in the templates (defvar tempo-interactive nil (#$ . -472)) #@328 *Automatically insert current region when there is a `r' in the template If this variable is NIL, `r' elements will be treated just like `p' elements, unless the template function is given a prefix (or a non-nil argument). If this variable is non-NIL, the behaviour is reversed. In Transient Mark mode, this option is unused. (defvar tempo-insert-region nil (#$ . -658)) #@99 *If non-NIL, show a buffer with possible completions, when only a partial completion can be found (defvar tempo-show-completion-buffer t (#$ . -1036)) #@129 *If NIL, a completion buffer generated by \[tempo-complete-tag] disappears at the next keypress; otherwise, it remains forever. (defvar tempo-leave-completion-buffer nil (#$ . -1194)) #@225 List of functions to run when inserting a string. Each function is called with a single arg, STRING and should return another string. This could be used for making all strings upcase by setting it to '(upcase), for example. (defvar tempo-insert-string-functions nil (#$ . 1385)) #@59 An association list with tags and corresponding templates (defvar tempo-tags nil (#$ . 1670)) #@379 A list of locally installed tag completion lists. It is a association list where the car of every element is a symbol whose varable value is a template list. The cdr part, if non-nil, is a function or a regexp that defines the string to match. See the documentation for the function `tempo-complete-tag' for more info. `tempo-tags' is always in the last position in this list. (defvar tempo-local-tags (quote ((tempo-tags))) (#$ . 1771)) #@62 A collection of all the tags defined for the current buffer. (defvar tempo-collection nil (#$ . 2216)) #@54 Indicates if the tag collection needs to be rebuilt. (defvar tempo-dirty-collection t (#$ . 2325)) #@87 A list of marks to jump to with `\[tempo-forward-mark]' and `\[tempo-backward-mark]'. (defvar tempo-marks nil (#$ . 2430)) #@860 The regexp or function used to find the string to match against tags. If `tempo-match-finder is a string, it should contain a regular expression with at least one \( \) pair. When searching for tags, `tempo-complete-tag' calls `re-search-backward' with this string, and the string between the first \( and \) is used for matching against each string in the tag list. If one is found, the whole text between the first \( and the point is replaced with the inserted template. You will probably want to include \ = at the end of the regexp to make sure that the string is matched only against text adjacent to the point. If `tempo-match-finder' is a symbol, it should be a function that returns a pair of the form (STRING . POS), where STRING is the string used for matching and POS is the buffer position after which text should be replaced with a template. (defvar tempo-match-finder "\\b\\([^\\b]+\\)\\=" (#$ . 2560)) #@231 Element handlers for user-defined elements. A list of symbols which are bound to functions that take one argument. This function should return somthing to be sent to `tempo-insert' if it recognizes the argument, and NIL otherwise (defvar tempo-user-elements nil (#$ . 3488)) #@40 Temporary storage for named insertions (defvar tempo-named-insertions nil (#$ . 3769)) #@47 Region start when inserting around the region (defvar tempo-region-start (make-marker) (#$ . 3862)) #@46 Region stop when inserting around the region (defvar tempo-region-stop (make-marker) (#$ . 3968)) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÀÅ!‡" [make-variable-buffer-local tempo-marks tempo-local-tags tempo-match-finder tempo-collection tempo-dirty-collection] 2) (defalias 'tempo-mapc #[(fun lst) "??… @!ˆÂ A\"‡" [lst fun tempo-mapc] 3]) (defalias 'tempo-dolist '(macro . #[(il &rest forms) "@A@ÃÄÅÆ\nCD\"D E*‡" [il l i tempo-mapc function append lambda forms] 5])) (put (quote tempo-dolist) (quote lisp-indent-function) 1) #@2918 Define a template. This function creates a template variable `tempo-template-NAME' and an interactive function `tempo-template-NAME' that inserts the template at the point. The created function is returned. NAME is a string that contains the name of the template, ELEMENTS is a list of elements in the template, TAG is the tag used for completion, DOCUMENTATION is the documentation string for the insertion command created, and TAGLIST (a symbol) is the tag list that TAG (if provided) should be added to). If TAGLIST is nil and TAG is non-nil, TAG is added to `tempo-tags' The elements in ELEMENTS can be of several types: - A string. It is sent to the hooks in `tempo-insert-string-functions', and the result is inserted. - The symbol 'p. This position is saved in `tempo-marks'. - The symbol 'r. If `tempo-insert' is called with ON-REGION non-nil the current region is placed here. Otherwise it works like 'p. - (p PROMPT ) If `tempo-interactive' is non-nil, the user is prompted in the minbuffer with PROMPT for a string to be inserted. If the optional parameter NAME is non-nil, the text is saved for later insertion with the `s' tag. If there already is something saved under NAME that value is used instead and no prompting is made. If NOINSERT is provided and non-nil, nothing is inserted, but text is still saved when a NAME is provided. For clarity, the symbol 'noinsert should be used as argument. - (P PROMPT ) Works just like the previous tag, but forces tempo-interactive to be true. - (r PROMPT ) like the previous, but if `tempo-interactive' is nil and `tempo-insert' is called with ON-REGION non-nil, the current region is placed here. This usually happens when you call the template function with a prefix argument. - (s NAME) Inserts text previously read with the (p ..) construct. Finds the insertion saved under NAME and inserts it. Acts like 'p if tempo-interactive is nil. - '& If there is only whitespace between the line start and point, nothing happens. Otherwise a newline is inserted. - '% If there is only whitespace between point and end-of-line nothing happens. Otherwise a newline is inserted. - 'n inserts a newline. - '> The line is indented using `indent-according-to-mode'. Note that you often should place this item after the text you want on the line. - 'r> Like r, but it also indents the region. - 'n> Inserts a newline and indents line. - 'o Like '% but leaves the point before the newline. - nil. It is ignored. - Anything else. It is evaluated and the result is treated as an element to be inserted. One additional tag is useful for these cases. If an expression returns a list '(l foo bar), the elements after 'l will be inserted according to the usual rules. This makes it possible to return several elements from one expression. (defalias 'tempo-define-template #[(name elements &optional tag documentation taglist) "ÀÁ\nP!‰ Lˆ\fÆÇÈD †Ê\nËQÌÍDÎÏ DÐÑÒÈDÈFE¯Mˆƒ:Ô #ˆ\f*‡" [intern "tempo-template-" name template-name command-name elements lambda &optional arg documentation "Insert a " "." interactive "*P" tempo-insert-template quote if tempo-insert-region not tag tempo-add-tag taglist] 12 (#$ . 4500)]) #@228 Insert a template. TEMPLATE is the template to be inserted. If ON-REGION is non-nil the `r' elements are replaced with the current region. In Transient Mark mode, ON-REGION is ignored and assumed true if the region is active. (defalias 'tempo-insert-template #[(template on-region) "ÀŽÁÂ!ƒ\nƒ „ÁÄ!ƒ\"\fƒ\"Å ƒ\"ƃ;Å `^É“ƒ;\nÅ `]É“ˆƒDbˆŠËÌ !ˆÍÎJ\"ˆËÌ !ˆ)Ð )‡" [((byte-code "À ˆÁÂ!ƒ\nƒ\nƒÃÅÆ!ˆÃ‡" [tempo-forget-insertions boundp transient-mark-mode nil mark-active run-hooks deactivate-mark-hook] 2)) boundp transient-mark-mode mark-active zmacs-regions mark t on-region tempo-region-start nil tempo-region-stop tempo-insert-mark point-marker mapcar #[(elt) "À \n\"‡" [tempo-insert elt on-region] 3] template tempo-forward-mark] 3 (#$ . 7813)]) #@225 Insert a template element. Insert one element from a template. If ON-REGION is non-nil the `r' elements are replaced with the current region. See documentation for `tempo-define-template' for the kind of elements possible. (defalias 'tempo-insert #[(element on-region) ";ƒ Á!‡:ƒ@Â=ƒÃA!‡:ƒ/@Ä=ƒ/ÅÃA!)‡:ƒI@Ç=ƒIƒD b‡ÃA!‡:ƒ[@Ê=ƒ[ËA@!‡:ƒm@Ì=ƒmÍÎA\"‡Â=ƒxÏÐ !‡Ç=ƒŒƒ‡ b‡ÏÐ !‡Ñ=ƒ§ƒ¢ bˆÒÓ `Ô#‡ÏÐ !‡Õ=ƒ°Ö ‡×=ƒÊiØU†ÃŠÙÚÔÅ#)?…'Ûc‡Ü=ƒâl†ÛŠÝÞÔÅ#)?…'Ûc‡ß=ƒëÛc‡à=ƒ÷ÛcˆÖ ‡á=ƒ† l† ŠÝÞÔÅ#)?…'âã!‡?†'äå!†$æ!\"‡" [element tempo-process-and-insert-string p tempo-insert-prompt-compat P t tempo-interactive r on-region tempo-region-stop s tempo-insert-named l mapcar #[(elt) "À \n\"‡" [tempo-insert elt on-region] 3] tempo-insert-mark point-marker r> indent-region mark nil > indent-according-to-mode & 0 re-search-backward "^\\s-*\\=" "\n" % re-search-forward "\\=\\s-*$" n n> o open-line 1 tempo-insert tempo-is-user-element eval] 4 (#$ . 8595)]) #@138 Compatibility hack for tempo-insert-prompt. PROMPT can be either a prompt string, or a list of arguments to tempo-insert-prompt, or nil. (defalias 'tempo-insert-prompt-compat #[(prompt) ":ƒ\nÁÂ\"‡Â!‡" [prompt apply tempo-insert-prompt] 3 (#$ . 9607)]) #@568 Prompt for a text string and insert it in the current buffer. If the variable `tempo-interactive' is non-nil the user is prompted for a string in the minibuffer, which is then inserted in the current buffer. If `tempo-interactive' is nil, the current point is placed on `tempo-mark'. PROMPT is the prompt string, SAVE-NAME is a name to save the inserted text under. If the optional argument NO-INSERT is non-nil, no text i inserted. This can be useful when there is a SAVE-NAME. If there already is a value for SAVE-NAME, it is used and the user is never prompted. (defalias 'tempo-insert-prompt #[(prompt &optional save-name no-insert) "À … ! ƒ „Æ !‚L ƒ À‚LƒH;„1ÉÊ\"ˆË! „=\fcˆ …LÌ \f\"‚LÍÎ !*‡" [nil save-name tempo-lookup-named previous insertion no-insert tempo-insert-named tempo-interactive prompt error "tempo: The prompt (%s) is not a string" read-string tempo-save-named tempo-insert-mark point-marker] 3 (#$ . 9870)]) #@70 Tries all the user-defined element handlers in `tempo-user-elements' (defalias 'tempo-is-user-element #[(element) "ÀÁ‡" [found (byte-code "ÀÁ\n\"ˆÃÄÅ\"‡" [mapcar #[(handler) " !‰…\fÃÄ\n\")‡" [handler element result throw found] 4] tempo-user-elements throw found nil] 3)] 2 (#$ . 10831)]) #@40 Forget all the saved named insertions. (defalias 'tempo-forget-insertions #[nil "À‰‡" [nil tempo-named-insertions] 2 (#$ . 11130)]) #@235 Save some data for later insertion The contents of DATA is saved under the name NAME. The data can later be retrieved with `tempo-lookup-named'. This function returns nil, so it can be used in a template without inserting anything. (defalias 'tempo-save-named #[(name data) " B\nBÇ" [name data tempo-named-insertions nil] 2 (#$ . 11270)]) #@100 Lookup some saved data under the name NAME. Returns the data if NAME was found, and nil otherwise. (defalias 'tempo-lookup-named #[(name) " žA‡" [name tempo-named-insertions] 2 (#$ . 11621)]) #@213 Insert the previous insertion saved under a named specified in NAME. If there is no such name saved, a tempo mark is inserted. Note that if the data is a string, it will not be run through the string processor. (defalias 'tempo-insert-named #[(name) "À !‰„ÃÄ !‚\n;ƒ\nc‚Å\nÆ\")‡" [tempo-lookup-named name insertion tempo-insert-mark point-marker tempo-insert nil] 4 (#$ . 11821)]) #@132 Insert a string from a template. Run a string through the preprocessors in `tempo-insert-string-functions' and insert the results. (defalias 'tempo-process-and-insert-string #[(string) "ƒ\"9ƒ !‚\"<ƒÂÃ\"ˆ‚\"ÄÅ\"ˆ c‡" [tempo-insert-string-functions string tempo-mapc #[(fn) " !‰‡" [fn string] 2] error "Bogus value in tempo-insert-string-functions: %s"] 3 (#$ . 12218)]) #@53 Insert a mark `tempo-marks' while keeping it sorted (defalias 'tempo-insert-mark #[(mark) "„ C‰‡ @Wƒ B‰‡‰Aƒ,\nA@ Xƒ,\nA‰‚ \n@U?…:\n \nAB¡)‡" [tempo-marks mark lp] 4 (#$ . 12609)]) #@53 Jump to the next mark in `tempo-forward-mark-list'. (defalias 'tempo-forward-mark #[nil "ÀÁ‰…\n\nb)‡" [found (byte-code "ÀÁ\n\"ˆÃ‡" [mapcar #[(mark) "`W…\nÁÂ\"‡" [mark throw found] 3] tempo-marks nil] 3) next-mark] 3 (#$ . 12812) nil]) #@54 Jump to the previous mark in `tempo-back-mark-list'. (defalias 'tempo-backward-mark #[nil "ÀÁ‰…\n\nb)‡" [found (byte-code "ÀÂÃ\f\"ˆ )‡" [nil last mapcar #[(mark) "`Xƒ Á \"ˆ‰‡" [mark throw found last] 3] tempo-marks] 3) prev-mark] 3 (#$ . 13060) nil]) #@131 Add a template tag. Add the TAG, that should complete to TEMPLATE to the list in TAG-LIST, or to `tempo-tags' if TAG-LIST is nil. (defalias 'tempo-add-tag #[(tag template &optional tag-list) "„Á J\"„ \fBJBLˆÅ ‡" [tag-list tempo-tags assoc tag template tempo-invalidate-collection] 3 (#$ . 13327) "sTag: \nCTemplate: "]) #@490 Install TAG-LIST to be used for template completion in the current buffer. TAG-LIST is a symbol whose variable value is a tag list created with `tempo-add-tag'. COMPLETION-FUNCTION is an obsolete option for specifyingis an optional function or string that is used by `\[tempo-complete-tag]' to find a string to match the tag against. It has the same definition as the variable `tempo-match-finder'. In this version, supplying a COMPLETION-FUNCTION just sets `tempo-match-finder' locally. (defalias 'tempo-use-tag-list #[(tag-list &optional completion-function) " ž‰ƒ\n ¡ˆ‚ B B) ƒ Å ‡" [tag-list tempo-local-tags old completion-function tempo-match-finder tempo-invalidate-collection] 3 (#$ . 13664)]) #@87 Marks the tag collection as obsolete. Whenever it is needed again it will be rebuilt. (defalias 'tempo-invalidate-collection #[nil "À‰‡" [t tempo-dirty-collection] 2 (#$ . 14383)]) #@117 Build a collection of all the tags and return it. If `tempo-dirty-collection' is NIL, the old collection is reused. (defalias 'tempo-build-collection #[nil "„ †ÂÃÄÅ\"\"‰Ç‡" [tempo-dirty-collection tempo-collection apply append mapcar #[(tag-list) "À @!‡" [eval tag-list] 2] tempo-local-tags nil] 5 (#$ . 14572)]) #@148 Find a string to be matched against a tag list. FINDER is a function or a string. Returns (STRING . POS), or nil if no reasonable string is found. (defalias 'tempo-find-match-string #[(finder) ";ƒÁŠÃÁÄ#)\n…Ŕŕ{Å”B)‡ ‡" [finder nil successful re-search-backward t 1] 4 (#$ . 14901)]) #@704 Look for a tag and expand it. All the tags in the tag lists in `tempo-local-tags' (this includes `tempo-tags') are searched for a match for the text before the point. The way the string to match for is determined can be altered with the variable `tempo-match-finder'. If `tempo-match-finder' returns nil, then the results are the same as no match at all. If a single match is found, the corresponding template is expanded in place of the matching string. If a partial completion or no match at all is found, and SILENT is non-NIL, the function will give a signal. If a partial completion is found and `tempo-show-completion-buffer' is non-NIL, a buffer containing possible completions is displayed. (defalias 'tempo-complete-tag #[(&optional silent) "À  !‰@\fAÇ \"‰@†!\f…!É \"‰\nƒ,`|ˆ\f„: †„Ì ‚„\n„I †„Ì ‚„\nÍ=ƒ[ÎÇ \"AÏ\"‚„Ç\n \"‰ƒoÎAÏ\"‚„\ncˆ „{Ì ˆ…„Ñ \".‡" [tempo-build-collection collection tempo-find-match-string tempo-match-finder match-info match-string match-start assoc exact try-completion compl silent ding t tempo-insert-template nil tempo-show-completion-buffer tempo-display-completions] 5 (#$ . 15201) "*"]) #@59 Show a buffer containing possible completions for STRING. (defalias 'tempo-display-completions #[(string tag-list) "ƒÁÂÃ\f \"!‘‡Æ‹‡" [tempo-leave-completion-buffer "*Completions*" display-completion-list all-completions string tag-list ((byte-code "ÀÁ \f\"!‘ˆÅÆ!‡" ["*Completions*" display-completion-list all-completions string tag-list sit-for 32767] 5))] 5 (#$ . 16378)]) #@315 Expand the tag before point if it is complete. Returns non-nil if an expansion was made and nil otherwise. This could as an example be used in a command that is bound to the space bar, and looks something like this: (defun tempo-space () (interactive "*") (or (tempo-expand-if-complete) (insert " "))) (defalias 'tempo-expand-if-complete #[nil "À  !‰@\fAÇ \"‰…%`|ˆÉAÊ\"ˆË-‡" [tempo-build-collection collection tempo-find-match-string tempo-match-finder match-info match-string match-start assoc exact tempo-insert-template nil t] 4 (#$ . 16766) "*"]) (provide (quote tempo)) emacs-19.30/lisp/term.elc100666 12120 1 206537 6045214506 13570 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:26:58 1995 ;;; from file /home/fsf/rms/e19/lisp/term.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`term.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ\nBÃÄ!ˆÃÅ!‡" ["0.95" term-protocol-version current-load-list require ring ehelp] 2) #@29 Size of input history ring. (defvar term-input-ring-size 32 (#$ . 568)) (byte-code "À B Bà BÄÅ!„ÆÅ BÄÇ!„!ÈÇ BÄÉ!„.È É BÄÊ!„;È\nÊ BÄË!„HÆ Ë BÌ BÄÍ!„YÈ Í BÄÎ!„fÆÎ BÏ BÐ BÄÑ!„{ÒÑ BÄÓ!„ˆÈÓ BÔ BÄÕ!„™ÆÕ BÄÖ!„¦ÆÖ B× BÄØ!„·ÆØ BÄÙ!„ÄÆÙ BÚ BÄÛ!„ÕÆÛ BÜ BÄÝ!„æÆÝ BÞ BƇ" [term-height current-load-list term-width term-home-marker boundp term-saved-home-marker nil term-start-line-column 0 term-current-column term-current-row term-insert-mode term-vertical-motion term-terminal-state term-kill-echo-list term-terminal-parameter term-terminal-previous-parameter term-current-face default term-scroll-start term-scroll-end term-pager-count term-saved-cursor term-command-hook term-log-buffer term-scroll-with-delete term-pending-delete-marker term-old-mode-map term-old-mode-line-format term-pager-old-local-map term-pager-old-filter] 2) #@75 *If non-nil, is file name to use for explicitly requested inferior shell. (defvar explicit-shell-file-name nil (#$ . -1466)) #@371 Regexp to recognise prompts in the inferior process. Defaults to "^", the null string at BOL. Good choices: Canonical Lisp: "^[^> \n]*>+:? *" (Lucid, franz, kcl, T, cscheme, oaklisp) Lucid Common Lisp: "^\\(>\\|\\(->\\)+\\) *" franz: "^\\(->\\|<[0-9]*>:\\) *" kcl: "^>+ *" shell: "^[^#$%>\n]*[#$%>] *" T: "^>+ *" This is a good thing to set in mode hooks. (defvar term-prompt-regexp "^" (#$ . 1598)) #@380 List of characters to recognise as separate arguments in input. Strings comprising a character in this list will separate the arguments surrounding them, and also be regarded as arguments in their own right (unlike whitespace). See `term-arguments'. Defaults to the empty list. For shells, a good value is (?\| ?& ?< ?> ?\( ?\) ?;). This is a good thing to set in mode hooks. (defvar term-delimiter-argument-list nil (#$ . 2019)) #@394 *If non-nil, expand input command history references on completion. This mirrors the optional behavior of tcsh (its autoexpand and histlit). If the value is `input', then the expansion is seen on input. If the value is `history', then the expansion is only when inserting into the buffer's input ring. See also `term-magic-space' and `term-dynamic-complete'. This variable is buffer-local. (defvar term-input-autoexpand nil (#$ . -2459)) #@143 *If non-nil, don't add input matching the last on the input ring. This mirrors the optional behavior of bash. This variable is buffer-local. (defvar term-input-ignoredups nil (#$ . -2907)) #@195 *If non-nil, name of the file to read/write input history. See also `term-read-input-ring' and `term-write-input-ring'. This variable is buffer-local, and is a good thing to set in mode hooks. (defvar term-input-ring-file-name nil (#$ . -3104)) #@352 *Controls whether interpreter output causes window to scroll. If nil, then do not scroll. If t or `all', scroll all windows showing buffer. If `this', scroll only the selected window. If `others', scroll only those that are not the selected window. The default is nil. See variable `term-scroll-show-maximum-output'. This variable is buffer-local. (defvar term-scroll-to-bottom-on-output nil (#$ . -3357)) #@209 *Controls how interpreter output causes window to scroll. If non-nil, then show the maximum output when the window is scrolled. See variable `term-scroll-to-bottom-on-output'. This variable is buffer-local. (defvar term-scroll-show-maximum-output nil (#$ . -3773)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp term-pending-frame nil current-load-list] 2) #@307 Function that submits old text in term mode. This function is called when return is typed while the point is in old text. It returns the text to be submitted as process input. The default is term-get-old-input-default, which grabs the current line, and strips off leading text matching term-prompt-regexp (defvar term-get-old-input (quote term-get-old-input-default) (#$ . 4127)) #@188 List of functions called to perform completion. Functions should return non-nil if completion was performed. See also `term-dynamic-complete'. This is a good thing to set in mode hooks. (defvar term-dynamic-complete-functions (quote (term-replace-by-expanded-history term-dynamic-complete-filename)) (#$ . 4515)) #@188 Predicate for filtering additions to input history. Only inputs answering true to this function are saved on the input history list. Default is to save anything that isn't all whitespace (defvar term-input-filter #[(str) "ÀÁ\n\"?‡" [string-match "\\`\\s *\\'" str] 3] (#$ . 4836)) #@160 Functions to call before input is sent to the process. These functions get one argument, a string containing the text to send. This variable is buffer-local. (defvar term-input-filter-functions nil (#$ . 5124)) #@289 Function to actually send to PROCESS the STRING submitted by user. Usually this is just 'term-simple-send, but if your mode needs to massage the input string, this is your hook. This is called from the user command term-send-input. term-simple-send just sends the string plus a newline. (defvar term-input-sender (quote term-simple-send) (#$ . 5343)) #@87 *Non-nil means go to the end of the line before sending input. See `term-send-input'. (defvar term-eol-on-send t (#$ . -5701)) #@80 Called upon entry into term-mode This is run before the process is cranked up. (defvar term-mode-hook nil (#$ . 5834)) #@317 Called each time a process is exec'd by term-exec. This is called after the process is cranked up. It is useful for things that must be done each time a process is executed in a term-mode buffer (e.g., (process-kill-without-query)). In contrast, the term-mode-hook is only executed once when the buffer is created. (defvar term-exec-hook nil (#$ . 5960)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp term-mode-map nil current-load-list] 2) #@71 Keyboard map for sending characters directly to the inferior process. (defvar term-raw-map nil (#$ . 6398)) #@112 Escape character for char-sub-mode of term mode. Do not change it directly; use term-set-escape-char instead. (defvar term-escape-char nil (#$ . 6513)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp term-raw-escape-map nil current-load-list term-pager-break-map] 2) #@124 True if communications via pty; false if by pipe. Buffer local. This is to work around a bug in emacs process signalling. (defvar term-ptyp t (#$ . 6788)) #@95 Last string searched for by term input history search, for defaulting. Buffer local variable. (defvar term-last-input-match "" (#$ . 6950)) (byte-code "ÀÁ!„ÂÁ BÄ BÅ B‡" [boundp term-input-ring nil current-load-list term-last-input-start term-last-input-end] 2) #@40 Index of last matched history element. (defvar term-input-ring-index nil (#$ . 7224)) #@47 Input previously used to match input history. (defvar term-matching-input-from-input-string "" (#$ . 7316)) (byte-code "ÀÁ!„ÂÁ BÄÅÆÇ#ˆÄÈÉÂ#ˆÄÊÉÂ#ˆÄÇÉÂ#ˆÄËÉÂ#ˆÄÌÉÂ#ˆÄÍÉÂ#ˆÄÎÉÂ#‡" [boundp term-pager-filter t current-load-list put term-replace-by-expanded-history menu-enable term-input-autoexpand term-input-ring permanent-local term-input-ring-index term-input-filter-functions term-scroll-to-bottom-on-output term-scroll-show-maximum-output term-ptyp] 4) (defalias 'term-if-emacs19 '(macro . #[(&rest forms) "ÀÁ\n\"…\nÃ\fB‡" [string-match "^19" emacs-version progn forms] 3])) (defalias 'term-is-xemacs '(macro . #[nil "À‡" [(string-match "Lucid" emacs-version)] 1])) (defalias 'term-if-xemacs '(macro . #[(&rest forms) "ÀÁ\n\"…\nÃ\fB‡" [string-match "Lucid" emacs-version progn forms] 3])) (defalias 'term-ifnot-xemacs '(macro . #[(&rest forms) "ÀÁ\n\"?… Ã\fB‡" [string-match "Lucid" emacs-version progn forms] 3])) (defalias 'term-in-char-mode '(macro . #[nil "À‡" [(eq (current-local-map) term-raw-map)] 1])) (defalias 'term-in-line-mode '(macro . #[nil "À‡" [(not (term-in-char-mode))] 1])) (defalias 'term-pager-enabled '(macro . #[nil "À‡" [term-pager-count] 1])) (defalias 'term-handling-pager '(macro . #[nil "À‡" [term-pager-old-local-map] 1])) (defalias 'term-using-alternate-sub-buffer '(macro . #[nil "À‡" [term-saved-home-marker] 1])) (byte-code "À B BÀ‡" [term-signals-menu current-load-list term-terminal-menu] 2) #@1435 Major mode for interacting with an inferior interpreter. Interpreter name is same as buffer name, sans the asterisks. In line sub-mode, return at end of buffer sends line as input, while return not at end copies rest of line to end and sends it. In char sub-mode, each character (except `term-escape-char`) is set immediately. This mode is typically customised to create inferior-lisp-mode, shell-mode, etc.. This can be done by setting the hooks term-input-filter-functions, term-input-filter, term-input-sender and term-get-old-input to appropriate functions, and the variable term-prompt-regexp to the appropriate regular expression. An input history is maintained of size `term-input-ring-size', and can be accessed with the commands \[term-next-input], \[term-previous-input], and \[term-dynamic-list-input-ring]. Input ring history expansion can be achieved with the commands \[term-replace-by-expanded-history] or \[term-magic-space]. Input ring expansion is controlled by the variable `term-input-autoexpand', and addition is controlled by the variable `term-input-ignoredups'. Input to, and output from, the subprocess can cause the window to scroll to the end of the buffer. See variables `term-scroll-to-bottom-on-input', and `term-scroll-to-bottom-on-output'. If you accidentally suspend your process, use \[term-continue-subjob] to continue it. \{term-mode-map} Entry to this mode runs the hooks on term-mode-hook (defalias 'term-mode #[nil "À ˆÁÃÅ!ˆÇÈ!ˆÉÊ!ÇË!ˆÇÌ!ˆÇÍ!ˆÎ S Ï S\fÇÐ!ˆÇÑ!ˆÇÒ!ˆÓ ÇÔ!ˆÓ ÇÕ!ˆÖÇ×!ˆÇØ!ˆÇÙ!ˆÇÚ!ˆÛÙ!ƒe„kÜ!ÇÝ!ˆÛÝ!ƒz„}ÞÇß!ˆßKÇà!ˆÇá!ˆÇâ!ˆÇã!ˆÇä!ˆÇå!ˆÇæ!ˆÇç!ˆ\f'Çè!ˆÇé!ˆÇê!ˆÇë!ˆÇì!ˆÇí!ˆÇî!ˆÇï!ˆÇð!ˆÇñ!ˆÇò!ˆÇó!ˆÇô!ˆÇõ!ˆÇö!ˆÇ÷!ˆÇø!ˆÇù!ˆÇú!ˆÇû!ˆÇü!ˆÇý!ˆÓ =Çþ!ˆÇÿ!ˆÞ?@A!ˆ„#Ü!B ‡" [kill-all-local-variables term-mode major-mode "Term" mode-name use-local-map term-mode-map make-local-variable term-home-marker copy-marker 0 term-saved-home-marker term-height term-width window-width window-height term-terminal-parameter term-saved-cursor term-last-input-start make-marker term-last-input-end term-last-input-match "" term-prompt-regexp term-input-ring-size term-input-ring term-input-ring-file-name boundp make-ring term-input-ring-index nil term-command-hook term-terminal-state term-kill-echo-list term-start-line-column term-current-column term-current-row term-log-buffer term-scroll-start term-scroll-end term-scroll-with-delete term-pager-count term-pager-old-local-map term-old-mode-map term-insert-mode term-dynamic-complete-functions term-completion-fignore term-get-old-input term-matching-input-from-input-string term-input-autoexpand term-input-ignoredups term-delimiter-argument-list term-input-filter-functions term-input-filter term-input-sender term-eol-on-send term-scroll-to-bottom-on-output term-scroll-show-maximum-output term-ptyp term-exec-hook term-vertical-motion term-pending-delete-marker term-current-face term-pending-frame run-hooks term-mode-hook term-update-mode-line] 2 (#$ . 8763) nil]) (byte-code "„­Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆÂáâ#ˆÂãä#ˆÂåÐ#ˆÂæç#ˆÂèé#ˆÂêë#ˆÂìí#ˆÂîï#ˆÂðñ#ˆÂòó#ˆÂôõ#ˆö÷ø\"ˆùøú\"ˆû<Áý!<Â<þÿ#ˆÂ<@A#ˆÂ)‡" [get-buffer-process buffer proc process-status (run stop)] 3 (#$ . 19511)]) #@326 Make a term process NAME in a buffer, running PROGRAM. The name of the buffer is made by surrounding NAME with `*'s. If there is already a running process in that buffer, it is not restarted. Optional third arg STARTFILE is the name of a file to send the contents of to the process. Any more args are arguments to PROGRAM. (defalias 'make-term #[(name program &optional startfile &rest switches) "ÀÁ\nÁQ!Ä !„ Š qˆÅ ˆ)Æ \n %ˆ )‡" [get-buffer-create "*" name buffer term-check-proc term-mode term-exec program startfile switches] 6 (#$ . 19793)]) #@44 Start a terminal-emulator in a new buffer. (defalias 'term #[(program) "ÀÁ\n\"qˆÃ ˆÄ ˆÅÆ!‡" [make-term "terminal" program term-mode term-char-mode switch-to-buffer "*terminal*"] 3 (#$ . 20353) (list (read-from-minibuffer "Run program: " (or explicit-shell-file-name (getenv "ESHELL") (getenv "SHELL") "/bin/sh")))]) #@248 Start up a process in buffer for term modes. Blasts any old process running in the buffer. Doesn't set the buffer mode. You can use this to cheaply run a series of processes in the same term buffer. The hook term-exec-hook is run after each exec. (defalias 'term-exec #[(buffer name command startfile switches) "ŠqˆÁ!‰ƒÃ\n!ˆ)Ä $ÈÉ!ˆ\n dbˆË\n!`Ì“ˆÍ\nÎ\"ˆƒQÐÑ!ˆdbˆÒ!ˆ`d{`d|ˆÓ\n\"ˆÔÕ!ˆ*‡" [buffer get-buffer-process proc delete-process term-exec-1 name command switches make-local-variable term-ptyp process-connection-type process-mark nil set-process-filter term-emulate-terminal startfile sleep-for 1 insert-file-contents term-send-string run-hooks term-exec-hook] 6 (#$ . 20676)]) (byte-code "ÀÁ!„ÂÁ BÀ‡" [boundp term-term-name "eterm" current-load-list] 2) #@31 termcap capabilties supported (defvar term-termcap-format "%s%s:li#%d:co#%d:cl=\\E[H\\E[J:cd=\\E[J:bs:am:xn:cm=\\E[%%i%%d;%%dH:nd=\\E[C:up=\\E[A:ce=\\E[K:ho=\\E[H:pt:al=\\E[L:dl=\\E[M:DL=\\E[%%dM:AL=\\E[%%dL:cs=\\E[%%i%%d;%%dr:sf=\\n:te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h:dc=\\E[P:DC=\\E[%%dP:IC=\\E[%%d@:im=\\E[4h:ei=\\E[4l:mi::so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m:UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC" (#$ . 21468)) (defalias 'term-exec-1 #[(name buffer command switches) "ÀÁ\n\"ÃÄ!ƒ\fƒÀÅ\"‚ ÀÈ\n \n%ÀË\f #ÀÎ \"ÀÏ\n\"¯¤ÑÒÕÖÀ× \n#Ø& )‡" [format "TERM=%s" term-term-name boundp system-uses-terminfo "TERMINFO=%s" data-directory term-termcap-format "TERMCAP=" term-height term-width "EMACS=%s (term:%s)" emacs-version term-protocol-version "LINES=%d" "COLUMNS=%d" process-environment apply start-process name buffer "/bin/sh" "-c" "stty -nl echo rows %d columns %d sane 2>/dev/null;if [ $1 = .. ]; then shift; fi; exec \"$@\"" ".." command switches] 10]) #@101 Test to see if ITEM is equal to an item in LIST. Option comparison function ELT= defaults to equal. (defalias 'term-mem #[(item list &optional elt=) "†ÁÂ\fƒ$ „$ \f@\"ƒ\f‚\fA‰„\f *‡" [elt= equal nil done list item] 4 (#$ . 22500)]) #@613 Sets the buffer's `term-input-ring' from a history file. The name of the file is given by the variable `term-input-ring-file-name'. The history ring is of size `term-input-ring-size', regardless of file size. If `term-input-ring-file-name' is nil this function does nothing. If the optional argument SILENT is non-nil, we say nothing about a failure to read the history file. This function is useful for major mode commands and mode hooks. The structure of the history file should be one input command per line, with the most recent command last. See also `term-input-ignoredups' and `term-write-input-ring'. (defalias 'term-read-input-ring #[(&optional silent) "ƒ\nÁšƒ\f‡Ã!„\f†‰ÅÆ\"‡ÇÈ!ÉÊ !\f ÐŽŠqˆ~ˆÑ ˆÒ!ˆdbˆ  WƒÓÔÂÕ#ƒÖ”Ö•{ƒnÙ\f!„nÚ\fÉ\"˜„uÛ\f\"ˆ) T‰ ‚B*\f‰,‡" [term-input-ring-file-name "" nil file-readable-p silent message "Cannot read history file %s" get-buffer-create " *temp*" 0 make-ring term-input-ring-size ring count file history-buf ((kill-buffer history-buf)) erase-buffer insert-file-contents re-search-backward "^[ ]*\\([^#\n].*\\)[ ]*$" t 1 history term-input-ignoredups ring-empty-p ring-ref ring-insert-at-beginning term-input-ring term-input-ring-index] 6 (#$ . 22753)]) #@345 Writes the buffer's `term-input-ring' to a history file. The name of the file is given by the variable `term-input-ring-file-name'. The original contents of the file are lost if `term-input-ring' is not empty. If `term-input-ring-file-name' is nil this function does nothing. Useful within process sentinels. See also `term-read-input-ring'. (defalias 'term-write-input-ring #[nil "ƒÁš„\nƒÃ\n!ƒćÅ!„!ÆÇ\"‡ÈÉ!\n\n \fÍ !Š\nqˆÏ ˆÐVƒSSÑ \"Ò±ˆ‚:ÓÔ Ä\fÄÕ%ˆÖÄ!-‡" [term-input-ring-file-name "" term-input-ring ring-empty-p nil file-writable-p message "Cannot write history file %s" get-buffer-create " *Temp Input History*" history-buf ring file ring-length index erase-buffer 0 ring-ref 10 write-region buffer-string no-message kill-buffer] 6 (#$ . 24008)]) #@49 List in help buffer the buffer's input history. (defalias 'term-dynamic-list-input-ring #[nil "À !ƒ\f !ƒÃÄ!‡ÅÆÇ !SÈ  \n \f\nÍYƒ:Î \n\"\fB\f\nS‰\n‚\" Ï\f!ˆ qˆÐyˆÑÒÅÓ#…XÔÕ!ˆ‚I‘ˆÖÍ!ˆÃ×!ˆØ ‰Ú=ƒsÛ !‚yC‰-‡" [ring-p term-input-ring ring-empty-p message "No history" nil " *Input History*" ring-length current-window-configuration conf index history-buffer history 0 ring-ref display-completion-list 3 search-backward "completion" move replace-match "history reference" sit-for "Hit space to flush" read-event ch 32 set-window-configuration unread-command-events] 6 (#$ . 24802) nil]) (defalias 'term-regexp-arg #[(prompt) "À\nÃ\fÀ‰‰Å%‰ǘƒ ‰A@ ‚È !+D‡" [nil minibuffer-history-sexp-flag last-command read-from-minibuffer prompt minibuffer-history-search-history regexp "" prefix-numeric-value current-prefix-arg] 7]) (defalias 'term-search-arg #[(arg) "À „ ÁÂ!‡ ƒÄ !ƒÁÅ!‡ÇUƒ#È ʇ‡" [term-after-pmark-p error "Not at command line" term-input-ring ring-empty-p "Empty input ring" arg 0 nil term-input-ring-index 1] 2]) (defalias 'term-search-start #[(arg) "ƒÁ\nÃVƒÄ‚Å\\Æ!\"‡\nÃYƒ ÇÆ!S‡" [term-input-ring-index mod arg 0 1 -1 ring-length term-input-ring] 4]) #@95 Return the string ARG places along the input ring. Moves relative to `term-input-ring-index'. (defalias 'term-previous-input-string #[(arg) "À \nƒÃ\f\n\\Å !\"‚\f\"‡" [ring-ref term-input-ring term-input-ring-index mod arg ring-length] 6 (#$ . 26023)]) #@40 Cycle backwards through input history. (defalias 'term-previous-input #[(arg) "ÀÁ\n\"‡" [term-previous-matching-input "." arg] 3 (#$ . 26285) "*p"]) #@39 Cycle forwards through input history. (defalias 'term-next-input #[(arg) "À [!‡" [term-previous-input arg] 2 (#$ . 26440) "*p"]) #@111 Return the string matching REGEXP ARG places along the input ring. Moves relative to `term-input-ring-index'. (defalias 'term-previous-matching-input-string #[(regexp arg) "À \n\"‰… Ä \")‡" [term-previous-matching-input-string-position regexp arg pos ring-ref term-input-ring] 4 (#$ . 26576)]) #@120 Return the index matching REGEXP ARG places along the input ring. Moves relative to START, or `term-input-ring-index'. (defalias 'term-previous-matching-input-string-position #[(regexp arg &optional start) "À !ƒ\f !ƒÃÄ!ˆÅ !ÈVƒ É‚!Ê Ì †-Î! Z\"ÐÐÈU„™„™Ì \\\"Wƒƒ„ƒÓÕ \"\"„ƒÌ \\\"‰U‚VÈVƒS‚“T‰‚=ÓÕ \"\"…§-‡" [ring-p term-input-ring ring-empty-p error "No history" ring-length len arg 0 1 -1 motion mod start term-search-start n nil tried-each-ring-item prev string-match regexp ring-ref] 6 (#$ . 26880)]) #@218 Search backwards through input history for match for REGEXP. (Previous history elements are earlier commands.) With prefix argument N, search for Nth previous match. If N is negative, find the next or Nth next match. (defalias 'term-previous-matching-input #[(regexp arg) "À ! \"‰„ÅÆ!‚*\fÈÉ\fT\"ˆÊËp!!`|ˆÌ \f\"c)‡" [term-search-arg arg term-previous-matching-input-string-position regexp pos error "Not found" term-input-ring-index message "History item: %d" process-mark get-buffer-process ring-ref term-input-ring] 4 (#$ . 27472) (term-regexp-arg "Previous input matching (regexp): ")]) #@227 Search forwards through input history for match for REGEXP. (Later history elements are more recent commands.) With prefix argument N, search for Nth following match. If N is negative, find the previous or Nth previous match. (defalias 'term-next-matching-input #[(regexp arg) "À \n[\"‡" [term-previous-matching-input regexp arg] 3 (#$ . 28078) (term-regexp-arg "Next input matching (regexp): ")]) #@238 Search backwards through input history for match for current input. (Previous history elements are earlier commands.) With prefix argument N, search for Nth previous match. If N is negative, search forwards for the -Nth following match. (defalias 'term-previous-matching-input-from-input #[(arg) "Á>„ÂÃp!!`{ÅÇÈÉ\f!P\n\"‡" [last-command (term-previous-matching-input-from-input term-next-matching-input-from-input) process-mark get-buffer-process term-matching-input-from-input-string nil term-input-ring-index term-previous-matching-input "^" regexp-quote arg] 4 (#$ . 28483) "p"]) #@243 Search forwards through input history for match for current input. (Following history elements are more recent commands.) With prefix argument N, search for Nth following match. If N is negative, search backwards for the -Nth previous match. (defalias 'term-next-matching-input-from-input #[(arg) "À [!‡" [term-previous-matching-input-from-input arg] 2 (#$ . 29079) "p"]) #@675 Expand input command history references before point. Expansion is dependent on the value of `term-input-autoexpand'. This function depends on the buffer's idea of the input history, which may not match the command interpreter's idea, assuming it has one. Assumes history syntax is like typical Un*x shells'. However, since emacs cannot know the interpreter's idea of input line numbers, assuming it has one, it cannot expand absolute input line number references. If the optional argument SILENT is non-nil, never complain even if history reference seems erroneous. See `term-magic-space' and `term-replace-by-expanded-history-before-point'. Returns t if successful. (defalias 'term-replace-by-expanded-history #[(&optional silent) "…,Á \"…,ŠÄyˆÅ!)…,Ç ÉÊ!ˆË\f!ˆÇ U)?‡" [term-input-autoexpand string-match "[!^]" term-get-old-input 0 looking-at term-prompt-regexp buffer-modified-tick previous-modified-tick message "Expanding history references..." term-replace-by-expanded-history-before-point silent] 3 (#$ . 29458) nil]) #@114 Expand directory stack reference before point. See `term-replace-by-expanded-history'. Returns t if successful. (defalias 'term-replace-by-expanded-history-before-point #[(silent) "ŠŠÀˆ`)`ZÁÀ!ˆ`ÄŠÀˆ` Z)wˆ`ŠÀˆ` Z)W…ˆÀhÆU„7Ç\n`\"ƒ>`Tbˆ‚ÈÉ!ƒOÊ•bˆËÌ!ˆ‚ÈÍ!ƒÎϔϕ{!S‰Ñ!Xƒ„ÓÔÕ!Ö”Ö•#׉#ˆËØT\"ˆ‚ŒÊ•bˆËÙ!ˆ)‚ÈÚ!„œÈÛ!ƒ±ÓÔÕÊ!ϔϕ#׉#ˆËÜ!ˆ‚ÈÝ!ƒ6ϔϕ֔ Ö•! †Î!†Õ{\"ã $åŽÈæ!*ƒéç‚êè)ã *ëŽì)í\"!PÏ\"*‰.„Ê•bˆ/„1Ëð!ˆñ ˆ‚1.ÓÔò.\"ó”ó•#׉#ˆËØ.T\"ˆ.‚Èô!ƒϔϕ{Ö”Ö•{À.56ÓÕÊ!׉#ˆ`.Ê”bˆ÷6.×#„r/„}øð!ˆ‚}Ó5׉#ˆËù!ˆ+‚Ê•bˆ‚+‡" [nil term-bol start toend "^!^" term-input-ring-index 92 term-within-quotes looking-at "![0-9]+\\($\\|[^-]\\)" 0 message "Absolute reference cannot be expanded" "!-\\([0-9]+\\)\\(:?[0-9^$*-]+\\)?" string-to-number 1 number ring-length term-input-ring replace-match term-args term-previous-input-string 2 t "History item: %d" "Relative reference exceeds input history size" "!!?:?\\([0-9^$*-]+\\)" "!!" "History item: previous" "!\\??\\({\\(.+\\)}\\|\\(\\sw+\\)\\)\\(:?[0-9^$*-]+\\)?" mb1 me1 mb2 me2 exp match-data match-data ((store-match-data match-data)) "!\\?" "" "^" pref match-data ((store-match-data match-data)) term-previous-matching-input-string-position regexp-quote pos silent "Not found" ding ring-ref 4 "\\^\\([^^]+\\)\\^?\\([^^]*\\)\\^?" new old search-forward error "History item: substituted"] 6 (#$ . 30509)]) #@143 Expand input history references before point and insert ARG spaces. A useful command to bind to SPC. See `term-replace-by-expanded-history'. (defalias 'term-magic-space #[(arg) "À ˆÁ\n!‡" [term-replace-by-expanded-history self-insert-command arg] 2 (#$ . 31930) "p"]) #@92 Return t if the number of quotes between BEG and END is odd. Quotes are single and double. (defalias 'term-within-quotes #[(beg end) "ÀÁ\n #ÀÄ\n #ÇÈ\"ÉU†Ç È\"ÉU*‡" [term-how-many-region "\\(^\\|[^\\\\]\\)'" beg end "\\(^\\|[^\\\\]\\)\"" countdq countsq mod 2 1] 5 (#$ . 32205)]) #@54 Return number of matches for REGEXP from BEG to END. (defalias 'term-how-many-region #[(regexp beg end) "ÀŠÂ ÄŽ bˆÆÉ#ƒ T‚ + )‡" [0 count match-data match-data ((store-match-data match-data)) beg re-search-forward regexp end t] 4 (#$ . 32497)]) (defalias 'term-args #[(string begin end) "À ÂŽ „Ä ÆÇ#‚w fÈ=ƒ T‚  {\nËÌ\n\"ƒ/Í‚JËÎ\n\"ƒ;Æ‚J\nϘƒFÇ‚JÐ\n!ËÒ\n\"ƒXÇ‚mËÓ\n\"ƒkÐ\nÆ•ÇO!‚mÄ #+*‡" [match-data match-data ((store-match-data match-data)) begin term-arguments string 0 nil 58 end range string-match "^[*^]" 1 "^-" "$" string-to-number nth "[-*$]$" "-" mth] 4]) (defalias 'term-delim-arg #[(arg) "„ C‡Âà G \fWƒ\\ H ‰>ƒ9 \fWƒN H=ƒN T‰‚$ \fWƒN H>„N T‰‚:  OB*‚+‡" [term-delimiter-argument-list arg nil 0 len pos args start char] 4]) #@358 Return from STRING the NTH to MTH arguments. NTH and/or MTH can be nil, which means the last argument. Returned arguments are separated by single spaces. We assume whitespace separates arguments, except within quotes. Also, a run of one or more of a single character in `term-delimiter-argument-list' is a separate argument. Argument 0 is the command name. (defalias 'term-arguments #[(string nth mth) "ÀÁ‰Á‰‰‰ \n ƒ\" Xƒ{Ì\n #ƒ{ƒH”UƒH• †DΔ‚ƒm O ƒ`  B‚fÏ ! ¤ TΔ”•‚ƒ  O ƒ“  B‚™Ï ! ¤ T†¨S ƒ¶ ZS‚·ÂÓÔ ›Ÿ›Õ#.\n‡" ["[^ \n \"'`]+\\|\\(\"[^\"]*\"\\|'[^']*'\\|`[^`]*`\\)" nil 0 quotes value str beg count pos args argpart mth string-match string 1 term-delim-arg nth m n mapconcat #[(a) "‡" [a] 1] " "] 8 (#$ . 33319)]) #@1937 Send input to process. After the process output mark, sends all text from the process mark to point as input to the process. Before the process output mark, calls value of variable term-get-old-input to retrieve old input, copies it to the process mark, and sends it. A terminal newline is also inserted into the buffer and sent to the process. The list of function names contained in the value of `term-input-filter-functions' is called on the input before sending it. The input is entered into the input history ring, if the value of variable term-input-filter returns non-nil when called on the input. Any history reference may be expanded depending on the value of the variable `term-input-autoexpand'. The list of function names contained in the value of `term-input-filter-functions' is called on the input before sending it. The input is entered into the input history ring, if the value of variable `term-input-filter' returns non-nil when called on the input. If variable `term-eol-on-send' is non-nil, then point is moved to the end of line before sending the input. The values of `term-get-old-input', `term-input-filter-functions', and `term-input-filter' are chosen according to the command interpreter running in the buffer. E.g., If the interpreter is the csh, term-get-old-input is the default: take the current line, discard any initial string matching regexp term-prompt-regexp. term-input-filter-functions monitors input for "cd", "pushd", and "popd" commands. When it sees one, it cd's the buffer. term-input-filter is the default: returns T if the input isn't all white space. If the term is Lucid Common Lisp, term-get-old-input snarfs the sexp ending at point. term-input-filter-functions does nothing. term-input-filter returns NIL if the input matches input-filter-regexp, which matches (1) all whitespace (2) :a, :c, etc. Similarly for Soar, Scheme, etc. (defalias 'term-send-input #[nil "Àp!‰„ÂÃ!‚üÄ !Æ !`Y‰ƒ/ ƒ)ʈ `{‚2 \f Î=„@\f‚GÏÐ!ˆ `{ Ñ=„U‚iÏÐ!ˆ `{ `|ˆcˆ)ƒ{ŠÄ !bˆÔ )!ƒ¨ƒ¡×!ƒ¡Ù!„¡ÚÛ\"˜„¨Ü\"ˆ‰ƒÂ@ßP!ˆA‰„°)Ê ! Ê“ˆ\"`Ê“ˆƒñã$!ƒã$ |ˆ$Ê“ˆÄ !`Ê“ˆ bˆ% \".)‡" [get-buffer-process proc error "Current buffer has no process" process-mark pmark marker-position pmark-val input-is-new term-eol-on-send nil term-get-old-input intxt term-input-autoexpand input term-replace-by-expanded-history t history copy term-pager-count term-current-row term-input-filter term-input-ignoredups ring-p term-input-ring ring-empty-p ring-ref 0 ring-insert term-input-filter-functions functions "\n" term-input-ring-index term-last-input-start term-last-input-end marker-buffer term-pending-delete-marker term-input-sender] 4 (#$ . 34143) nil]) #@114 Default for term-get-old-input. Take the current line, and discard any initial text matching term-prompt-regexp. (defalias 'term-get-old-input-default #[nil "ŠÀyˆÁ ˆ`È\n`{*‡" [0 term-skip-prompt beg nil] 2 (#$ . 36946)]) #@112 Insert after prompt old input at point as new input to be edited. Calls `term-get-old-input' to get old input. (defalias 'term-copy-old-input #[nil " Áp!\n„ÄÅ!‚Æ\n!bˆ c*‡" [term-get-old-input get-buffer-process process input error "Current buffer has no process" process-mark] 3 (#$ . 37177) nil]) #@127 Skip past the text matching regexp term-prompt-regexp. If this takes us past the end of the current line, don't skip at all. (defalias 'term-skip-prompt #[nil "ŠÀˆ`) !…Ä• X…Ä•b)‡" [nil eol looking-at term-prompt-regexp 0] 2 (#$ . 37489)]) #@43 Is point after the process output marker? (defalias 'term-after-pmark-p #[nil "ÀÁÂp!!!‰`X)‡" [marker-position process-mark get-buffer-process proc-pos] 5 (#$ . 37742)]) #@141 Default function for sending to PROC input STRING. This just sends STRING plus a newline. To override this, set the hook TERM-INPUT-SENDER. (defalias 'term-simple-send #[(proc string) "À \n\"ˆÀ Ã\"‡" [term-send-string proc string "\n"] 3 (#$ . 37919)]) #@291 Goes to the beginning of line, then skips past the prompt, if any. If a prefix argument is given (\[universal-argument]), then no prompt skip -- go straight to column 0. The prompt skip is done by skipping text matching the regular expression term-prompt-regexp, a buffer local variable. (defalias 'term-bol #[(arg) "Àyˆ ?…\n ‡" [0 arg term-skip-prompt] 1 (#$ . 38179) "P"]) #@598 Read a single line of text from user without echoing, and return it. Prompt with argument PROMPT, a string. Optional argument STARS causes input to be echoed with '*' characters on the prompt line. Input ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. C-g aborts (if `inhibit-quit' is set because e.g. this function was called from a process filter and C-g is pressed, this function returns nil rather than a string). Note that the keystrokes comprising the text can still be recovered (temporarily) with \[view-lossage]. This may be a security bug for some applications. (defalias 'term-read-noecho #[(prompt &optional stars) "ÀÁ‰ÂÃ\f„‘ ƒ%ÊË\fÍGÎ\"#ˆ‚*Ê\f!ˆÏ ‰ÐUƒ=‰‚ÒU„RÓU„RÔUƒX‰‚ÕUƒeÀ‚ ÖU„×U„Ø!P‚ GÁVƒ ÁÙO‚ ƒ¥Ã‰ÊÚ!ˆÛÂ!ˆ‚«ÊÀ!ˆ-‡" ["" 0 t nil done cursor-in-echo-area echo-keystrokes c ans stars message "%s%s" prompt make-string 42 read-char 7 quit-flag 13 10 27 21 8 127 char-to-string -1 "Quit" beep] 7 (#$ . 38565)]) #@255 Read a string without echoing. Then send it to the process running in the current buffer. A new-line is additionally sent. String is not saved on term input history list. Security bug: your string can still be temporarily recovered with \[view-lossage]. (defalias 'term-send-invisible #[(str &optional proc) ";„\nÁÂÃ\"\f„Åp!\f„ÆÇ!‡ÉB¤Ê\f\"ˆÊ\fË\"‡" [str term-read-noecho "Non-echoed text: " t proc get-buffer-process error "Current buffer has no process" term-kill-echo-list nil term-send-string "\n"] 3 (#$ . 39594) "P"]) #@143 *Long inputs send to term processes are broken up into chunks of this size. If your process is choking on big inputs, try lowering the value. (defvar term-input-chunk-size 512 (#$ . -40138)) #@323 Send PROCESS the contents of STRING as input. This is equivalent to process-send-string, except that long input strings are broken up into chunks of size term-input-chunk-size. Processes are given a chance to output between chunks. This can help prevent processes from hanging when you send them long inputs on some OS's. (defalias 'term-send-string #[(proc str) "G‰\n^Ä Æ O\"ˆ W…/ \n\\È ˆÄ  ^O\"ˆ)‚*‡" [str len term-input-chunk-size i process-send-string proc 0 next-i accept-process-output] 7 (#$ . 40336)]) #@183 Sends to PROC the region delimited by START and END. This is a replacement for process-send-region that tries to keep your process from hanging on long inputs. See term-send-string. (defalias 'term-send-region #[(proc start end) "À \n {\"‡" [term-send-string proc start end] 4 (#$ . 40870)]) #@52 Kill all output from interpreter since last input. (defalias 'term-kill-output #[nil "ÀÁp!!Ã\f\n\"ˆ\nbˆÅcˆ\n`Æ“)‡" [process-mark get-buffer-process pmark kill-region term-last-input-end "*** output flushed ***\n" nil] 3 (#$ . 41168) nil]) #@127 Display start of this batch of interpreter output at top of window. Sets mark to the value of point when this command is run. (defalias 'term-show-output #[nil "bˆÁ ˆÂyˆÃÄ `\"ˆÅ‡" [term-last-input-end backward-char 0 set-window-start selected-window nil] 3 (#$ . 41415) nil]) #@31 Interrupt the current subjob. (defalias 'term-interrupt-subjob #[nil "ÀÁ\n\"‡" [interrupt-process nil term-ptyp] 3 (#$ . 41699) nil]) #@41 Send kill signal to the current subjob. (defalias 'term-kill-subjob #[nil "ÀÁ\n\"‡" [kill-process nil term-ptyp] 3 (#$ . 41839) nil]) #@41 Send quit signal to the current subjob. (defalias 'term-quit-subjob #[nil "ÀÁ\n\"‡" [quit-process nil term-ptyp] 3 (#$ . 41979) nil]) #@290 Stop the current subjob. WARNING: if there is no current subjob, you can end up suspending the top-level process running in the buffer. If you accidentally do this, use \[term-continue-subjob] to resume the process. (This is not a problem with most shells, since they ignore this signal.) (defalias 'term-stop-subjob #[nil "ÀÁ\n\"‡" [stop-process nil term-ptyp] 3 (#$ . 42120) nil]) #@111 Send CONT signal to process buffer's process group. Useful if you accidentally suspend the top-level process. (defalias 'term-continue-subjob #[nil "ÀÁ\n\"‡" [continue-process nil term-ptyp] 3 (#$ . 42510) nil]) #@63 Kill all text from last stuff output by interpreter to point. (defalias 'term-kill-input #[nil "ÀÁp!!Ã\n!`\fV…Å\n`\"*‡" [process-mark get-buffer-process pmark marker-position p-pos kill-region] 3 (#$ . 42728) nil]) #@79 Delete ARG characters forward, or send an EOF to process if at end of buffer. (defalias 'term-delchar-or-maybe-eof #[(arg) "mƒÀ ‡Á\n!‡" [process-send-eof delete-char arg] 2 (#$ . 42953) "p"]) #@46 Send an EOF to the current buffer's process. (defalias 'term-send-eof #[nil "À ‡" [process-send-eof] 1 (#$ . 43153) nil]) #@227 Search backward through buffer for match for REGEXP. Matches are searched for on lines that match `term-prompt-regexp'. With prefix argument N, search for Nth previous match. If N is negative, find the next or Nth next match. (defalias 'term-backward-matching-input #[(regexp arg) "Á\nQŠ\fÅVƒÅ‚ÆˆÇ ÈÉ\f$…`)‰\n„-ËÌ!ˆÍ ‚4\nbˆÎÈ!*‡" [term-prompt-regexp ".*" regexp re arg 0 1 re-search-backward nil t pos message "Not found" ding term-bol] 6 (#$ . 43282) (term-regexp-arg "Backward input matching (regexp): ")]) #@235 Search forward through buffer for match for REGEXP. Matches are searched for on lines that match `term-prompt-regexp'. With prefix argument N, search for Nth following match. If N is negative, find the previous or Nth previous match. (defalias 'term-forward-matching-input #[(regexp arg) "À \n[\"‡" [term-backward-matching-input regexp arg] 3 (#$ . 43811) (term-regexp-arg "Forward input matching (regexp): ")]) #@73 Move to end of Nth next prompt in the buffer. See `term-prompt-regexp'. (defalias 'term-next-prompt #[(n) "\nÃVƒ\fÄ‚ ÈÅ\n!ˆÆ )‡" [term-prompt-regexp paragraph-start n 0 1 forward-paragraph term-skip-prompt] 2 (#$ . 44229) "p"]) #@77 Move to end of Nth previous prompt in the buffer. See `term-prompt-regexp'. (defalias 'term-previous-prompt #[(n) "À [!‡" [term-next-prompt n] 2 (#$ . 44469) "p"]) (defalias 'term-source-default #[(previous-dir/file source-modes) "ƒ \n>ƒÃ!Ä!B‡ †ÇB‡" [buffer-file-name major-mode source-modes file-name-directory file-name-nondirectory previous-dir/file default-directory nil] 3]) (defalias 'term-check-source #[(fname) "À !‰…&Ã\n!…&ÄÅÆÇ\n!\"!…&p\nqˆÉ ˆq))‡" [get-file-buffer fname buff buffer-modified-p y-or-n-p format "Save buffer %s first? " buffer-name old-buffer save-buffer] 6]) #@66 Returns string around POINT that starts the current line or nil. (defalias 'term-extract-string #[nil "Š`Áyˆ`È`bˆÅÆ\nÇ#…`TbˆÉÆ\fÇ#…)`S\n…:\n…:\n{.‡" [point 0 bol nil eol search-backward "\"" t start search-forward end] 4 (#$ . 45079)]) (defalias 'term-get-source #[(prompt prev-dir/file source-modes mustmatch-p) "À \n\"Ä ‰…ÆÇÈ…É !?‰\nƒ#Ë !‚% @\f\nƒ2Í !‚4 AσFÐÑ#‚H\f‰P$ÕÖ!!.C‡" [term-source-default prev-dir/file source-modes def term-extract-string stringfile nil (file-exists-p stringfile) ((error)) file-directory-p sfile-p file-name-directory defdir file-name-nondirectory deffile read-file-name format "%s(default %s) " prompt mustmatch-p ans expand-file-name substitute-in-file-name] 6]) (defalias 'term-proc-query #[(proc str) "À !à !Å\n!ˆ\nqˆÆ\n!Ç\f! Ê  \"ˆÌ !ˆÍ \"?…TÎ !Ð \f\"ˆÑÒ!ˆÍ \"„MÓ!‚SÐ \"),‡" [process-buffer proc proc-buf process-mark proc-mark display-buffer get-buffer-window marker-position proc-pt proc-win term-send-string str accept-process-output pos-visible-in-window-p window-point opoint set-window-point sit-for 0 push-mark] 3]) (defalias 'term-horizontal-column #[nil "À Á Z‡" [term-current-column term-start-line-column] 2]) (defalias 'term-vertical-motion '(macro . #[(count) "ÀÁ\nE‡" [funcall term-vertical-motion count] 3])) (defalias 'buffer-vertical-motion #[(count) "ÁUƒ i ¥_!ˆÁ‡ÁVƒfÄi ¥\\Ĉi Ç\\\\ ¥È]‰ XƒEm„E ZÄuˆÄˆ‚\" Yƒ] ÁVƒ] ZÇ\\\\‚d _!ˆ*‡Ä[i Ç\\\\ ¥È]‰ XƒÁyˆo„ ZÉ ˆ‚l Yƒ§ ÁVƒ§ ÈZ\\\\‚³Â ZÈZ _!ˆ*‡" [count 0 move-to-column term-width nil todo H -1 1 backward-char] 4]) (defalias 'term-start-line-column #[nil "†`\nÃ!ˆi bˆ)†ć" [term-start-line-column save-pos term-vertical-motion 0 nil] 2]) (defalias 'term-current-column #[nil "† i‰† Á‡" [term-current-column nil] 2]) (defalias 'term-move-columns #[(delta) "À \\ÂÃ\"‡" [term-current-column delta move-to-column t] 3]) (defalias 'term-insert-char #[(char count) "`Á\n \"ˆÄ`ÅÆ$)‡" [old-point insert-char char count put-text-property face default] 5]) (defalias 'term-current-row #[nil "†ŒŠ d}ˆ\nÃ![*‰†ć" [term-current-row term-home-marker term-vertical-motion -9999 nil] 2]) (defalias 'term-adjust-current-row-cache #[(delta) "…  \\‰‡" [term-current-row delta] 2]) (defalias 'term-terminal-pos #[nil "ŠÀ Á‰ Æ!ˆ\fiZ ! \n,B‡" [term-current-column nil y x save-col term-vertical-motion 0 term-height] 3]) (defalias 'term-emulate-terminal #[(proc str) "pÁÃÃÃÃÃà Ã\nÃ Ì  GÐŽÑ!qˆÓ!ƒ@Õ!|ˆÉ“ˆÖ p=ƒS×KÙ!ˆ‚WÚKÛÕ!!`Õ!U„rÜ Õ!bˆŒdÕ!Vƒ‹Ý =„‹eÕ!}ˆƒ—à\"ˆ!â=ƒ°#PÃ#GÁ!\nWƒ\nH!äWƒ¹åæ\n#‰„Ñ \nVƒŽ!ç=ƒåèç!ˆÁ! \nZé \\*Z‰\nÁX„C\nVƒ\nZ‰\n\\‚C+„,ƒ\"íç!ÁVƒ8îç!ˆ*^‰\n\\/0‚CÁ\nÃ/Ã0` `dU„c1ƒVò!ˆè!ˆ `|ˆ‚jï \\/\n Ocˆó `ô5$ˆ\nÁ=ƒˆèö!ˆç! S‚¡Á‰!ƒÂ\f÷=ƒÂï ‰øù\"[ù\\\\úÃ\"Wƒ»û\fç\"ˆ/‚¡\fü=ƒ\nT‰\nWƒ\nHý=ƒ`dUƒ+„>„,„ýcˆîç!ˆÁ0Á/\n‚¡Á!ˆÁ/‚¡\fý=ƒ,>ƒ ÿ „¡@çA\"ˆ‚¡\fù=ƒ9èö!ˆ‚¡\fB=ƒGä!‚¡\fÁ=„¡\fC=„¡\fD=„¡\fE=ƒpFA!ˆ‚¡\fG=ƒ©åH\n#‰Iƒ˜J\nTISO!ˆI‚¥\nÃO#â!)‚¡èç!ˆKç!ˆ\fcˆ‚¡!ä=ƒT\fL=ƒäMã!ˆMN!ˆÁ#ÁNO!‚¡\fP=ƒQ ˆ@çA\"ˆÁ!‚¡\fR=ƒSç!ˆÁ!‚¡\fT=ƒ0Q ˆU é BVÁ!‚¡\fW=ƒNVƒHXV@VA\"ˆÁ!‚¡Á!‚¡!O=ƒ¡\fYYƒ|\fZXƒ|#ý_\fYZ\\#‚¡\f[=ƒŽ#NÁ#‚¡\f\\=„¡]\f\"ˆÁ!^ƒüi*¦ÁVƒ¹\nÃO#‚Ý\nÁUƒÍ_\nÃOP#‚Ú\nSÃO‰#ÁüIˆdbˆâ!M`!ˆa!`bc\"ˆ\nT‰‚±)U dYƒQ ˆÕ!`Óˆƒ*bˆÉ“ˆeƒKÖ !p=ƒKfe@eA\"ˆÃeÙ!ˆ  g ÃA# Ö !Ñ!=ƒìhij !ˆ`U„²iA=„²ik=„²  =ƒ¡il=„²ƒ²im=ƒÒ  =„ÒnbˆoÁ!ˆÕ!bˆp` \"„Òoö!ˆqƒë`Õ!YƒëŠdbˆoö!ˆ))  =ƒOÉ“. ‡" [previous-buffer 0 i nil char funny count save-point save-marker old-point temp win selected-window selected str str-length ((byte-code "qˆÁ\n!‡" [previous-buffer select-window selected] 2)) process-buffer proc marker-buffer term-pending-delete-marker process-mark window-buffer vertical-motion term-vertical-motion term-check-size buffer-vertical-motion copy-marker point-marker current-local-map term-raw-map term-log-buffer princ term-terminal-state 4 term-terminal-parameter 2 string-match "[ \n ]" 1 term-move-columns term-horizontal-column term-width term-pager-count term-scroll-with-delete term-handle-scroll term-adjust-current-row-cache term-current-column term-start-line-column term-insert-mode term-insert-spaces put-text-property face term-current-face -1 9 mod 8 move-to-column term-insert-char 13 10 term-kill-echo-list term-check-kill-echo-list term-down t 27 14 15 7 beep 26 "\n" end term-command-hook backward-delete-char 91 make-local-variable term-terminal-previous-parameter 3 68 term-handle-deferred-scroll 77 term-insert-lines 55 term-current-row term-saved-cursor 56 term-goto 48 57 59 63 term-handle-ansi-escape term-pager-old-local-map " " term-pager-old-filter process-filter set-process-filter term-pager-filter term-height term-pending-frame term-display-line next-window term-scroll-to-bottom-on-output scroll select-window all this others term-home-marker recenter pos-visible-in-window-p term-scroll-show-maximum-output] 6]) (defalias 'term-handle-deferred-scroll #[nil "À Z‰ÃV…Š\fbˆ \n!ˆ\f`Æ“ˆ S‰))‡" [term-current-row term-height count 0 term-home-marker term-vertical-motion nil] 4]) (defalias 'term-handle-ansi-escape #[(proc char) "Á=ƒ1\nÃXƒÄ ÃXƒÄ Vƒ \nVƒ*È S\nS\"‡É=ƒBÊ ˆËÄ\n][Ì\"‡Í=ƒOËÄ\n]Ì\"‡Î=ƒ[ÏÄ\n]!‡Ð=ƒhÏÄ\n][!‡Ñ=ƒrÒ\n!‡Ó=ƒ|Ô\n!‡Õ=ƒˆÖÄ\n]!‡×=ƒ”ØÄ\n]!‡Ù=ƒ ÚÄ\n]!‡Û=ƒ¬ÜÄ\n]!‡Ý=ƒÇ\nÞ=ƒ½Ì‰‡\nà=…2áÌ!‡â=ƒâ\nÞ=ƒØ㉇\nà=…2áã!‡ä=ƒ\nå=ƒóæ‰'‡\nÞ=ƒþè‰'‡\nÄ=ƒ é‰'‡ê‰'‡ë=ƒ%Ê ˆì-îïð Tñ T#\"‡ò=ƒ1ó S\n\"‡Ì‡" [char 72 term-terminal-parameter 0 1 term-terminal-previous-parameter term-height term-width term-goto 65 term-handle-deferred-scroll term-down t 66 67 term-move-columns 68 74 term-erase-in-display 75 term-erase-in-line 76 term-insert-lines 77 term-delete-lines 80 term-delete-chars 64 term-insert-spaces 104 4 term-insert-mode 47 term-switch-to-alternate-sub-buffer 108 nil 109 7 highlight term-current-face term-underline-face bold default 110 process-send-string proc format "[%s;%sR" term-current-row term-horizontal-column 114 term-scroll-region] 6]) #@194 Set scrolling region. TOP is the top-most line (inclusive) of the new scrolling region, while BOTTOM is the line folling the new scrolling region (e.g. exclusive). The top-most line is line 0. (defalias 'term-scroll-region #[(top bottom) "ÁW„\f\nYƒÁ‚\f X„\f\nVƒ\"\n‚#\f†3 ÁU…2 \nU?‰‡" [top 0 term-height term-scroll-start bottom term-scroll-end term-saved-home-marker term-scroll-with-delete] 2 (#$ . 51522)]) (defalias 'term-switch-to-alternate-sub-buffer #[(set) "À ˆ \n?=…_Ã Ä  ƒ4dbˆhÇ=„#ÈÇÉ\"ˆÊ Ì ! `Γˆ‚TÐU…@U?  \nΓˆ\nΉ“ˆÎ bˆÎÐÔ \"*‡" [term-handle-deferred-scroll set term-saved-home-marker term-current-row term-horizontal-column col row 10 term-insert-char 1 t term-scroll-with-delete copy-marker term-home-marker nil term-scroll-start 0 term-scroll-end term-height term-current-column term-goto] 3]) (defalias 'term-command-hook #[(string) "ÁHÂUƒ4ÃÄÅ#ÃÄT#ÅOÉTO!\n\nB‰ ,‡ÁHÌUƒCÍÅÎO!‡Ï‡" [string 0 26 string-match ":" 1 first-colon second-colon filename string-to-int fileline term-pending-frame 47 cd nil t] 4]) (defalias 'term-display-line #[(true-file line) "ÀÁ\n! \"‡" [term-display-buffer-line find-file-noselect true-file line] 3]) (defalias 'term-display-buffer-line #[(buffer line) "À Â\"ÄŠ qˆŒ~ˆÆ!ˆ`È \n„!Ë \n\n`p“ˆ) eW„4 dVƒ9~ˆ bˆ)Ì \n\"*‡" [display-buffer buffer t window nil pos goto-line line "=>" overlay-arrow-string overlay-arrow-position make-marker set-window-point] 3]) (defalias 'term-goto-home #[nil "À ˆ bˆÂi‰‰‡" [term-handle-deferred-scroll term-home-marker 0 term-current-row term-current-column term-start-line-column] 3]) (defalias 'term-goto #[(row col) "À ˆ ƒ\n Yƒ Ä!ˆ \n Z‚Ç ˆÈ\n!ˆÉ\n!‡" [term-handle-deferred-scroll term-current-row row term-vertical-motion 0 term-start-line-column term-current-column term-goto-home term-down term-move-columns col] 2]) (defalias 'term-process-pager #[nil "„ÄÁ ÃÅÇ\nÈÉÊ È\"#ˆÇ\nËÉÊ Ë\"#ˆÇ\nÌÉÊ Ì\"#ˆÇ\nÍÎ#ˆÇ\nÏÐ#ˆÇ\nÑÒ#ˆÇ\nÓÒ#ˆÇ\nÔÕ#ˆÇ\nÖ×#ˆÇ\nØÙ#ˆÇ\nÚÛ#ˆÇ\nÜÝ#ˆÇ\nÞß#ˆÇ\nà!#ˆÇ\nâ##ˆäå!Çæç#ˆÇèé#ˆÇêë#ˆÇìí#ˆÇîï#ˆÇðñ#ˆÇòó#ˆÇôõ#ˆÇö÷#ˆÇ\nøåB#ˆ\n+ù :û!ˆüý!ˆ>=ÿ@ABF>C ‡" [term-pager-break-map make-keymap map 0 i nil tmp define-key "" lookup-key current-global-map "" "" " " term-pager-page " " term-pager-line "?" term-pager-help "h" "b" term-pager-back-page "" term-pager-back-line "q" term-pager-discard "D" term-pager-disable "<" term-pager-bob ">" term-pager-eob [menu-bar terminal] term-terminal-menu [menu-bar signals] term-signals-menu make-sparse-keymap "More pages?" [help] ("Help" . term-pager-help) [disable] ("Diable paging" . term-fake-pager-disable) [discard] ("Discard remaining output" . term-pager-discard) [eob] ("Goto to end" . term-pager-eob) [bob] ("Goto to beginning" . term-pager-bob) [line] ("1 line forwards" . term-pager-line) [bline] ("1 line backwards" . term-pager-back-line) [back] ("1 page backwards" . term-pager-back-page) [page] ("1 page forwards" . term-pager-page) [menu-bar page] current-local-map term-pager-old-local-map use-local-map make-local-variable term-old-mode-line-format mode-line-format "-- **MORE** " mode-line-buffer-identification " [Type ? for help] " "%-" force-mode-line-update] 6]) (defalias 'term-pager-line #[(lines) "À T! \nZ\n VƒÄ ˆ ÅXƒ ÆS!‚#È !*‡" [vertical-motion lines moved deficit backward-char 0 recenter term-height term-pager-continue] 2 nil "p"]) #@77 Proceed past the **MORE** break, allowing the next page of output to appear (defalias 'term-pager-page #[(arg) "À \n_!‡" [term-pager-line arg term-height] 3 (#$ . 54971) "p"]) (defalias 'term-pager-bob #[nil "ebˆÀ ! Uƒ ˆÃ S!‡" [vertical-motion term-height backward-char recenter] 2 nil nil]) (defalias 'term-pager-eob #[nil "bˆÁÂ!ˆÃÄp!!b‡" [term-home-marker recenter 0 process-mark get-buffer-process] 3 nil nil]) (defalias 'term-pager-back-line #[(lines) "ÀÁ\nZ!ˆo„à ˆ‚Ä ˆÀ !ˆÃ ˆÆ S!‡" [vertical-motion 1 lines backward-char beep term-height recenter] 3 nil "p"]) (defalias 'term-pager-back-page #[(arg) "À \n_!‡" [term-pager-back-line arg term-height] 3 nil "p"]) (defalias 'term-pager-discard #[nil "ÀÂÃÄ\"ˆÅ!‡" ["" term-terminal-parameter interrupt-process nil t term-pager-continue term-height] 3 nil nil]) (defalias 'term-pager-disable #[nil "ƒ ÁÂ!ˆ‚ ÂÄ ‡" [term-pager-old-local-map term-pager-continue nil term-pager-count term-update-mode-line] 2 nil nil]) (defalias 'term-pager-enable #[nil "„Á ‡" [term-pager-count 0 term-update-mode-line] 1 nil nil]) (defalias 'term-pager-toggle #[nil "ƒÁ ‡Â ‡" [term-pager-count term-pager-disable term-pager-enable] 1 nil nil]) (byte-code "ÀÁÂ\"ˆÀÃÂ\"ˆÄÅÆÇ#ˆÄÈÆÉ#ˆÄÁÆÊ#ˆÄÃÆË#‡" [defalias term-fake-pager-enable term-pager-toggle term-fake-pager-disable put term-char-mode menu-enable (term-in-line-mode) term-line-mode (term-in-char-mode) (not term-pager-count) term-pager-count] 4) #@74 Provide help on commands available in a terminal-emulator **MORE** break (defalias 'term-pager-help #[nil "ÀÁ!ˆÂÃ!ˆÄÅ!‡" [message "Terminal-emulator pager break help..." sit-for 0 with-electric-help #[nil "ÀÁÂ!!ˆÃ‡" [princ substitute-command-keys "\\Terminal-emulator MORE break.\nType one of the following keys:\n\n\\[term-pager-page] Move forward one page.\n\\[term-pager-line] Move forward one line.\n\\[universal-argument] N \\[term-pager-page] Move N pages forward.\n\\[universal-argument] N \\[term-pager-line] Move N lines forward.\n\\[universal-argument] N \\[term-pager-back-line] Move N lines back.\n\\[universal-argument] N \\[term-pager-back-page] Move N pages back.\n\\[term-pager-bob] Move to the beginning of the buffer.\n\\[term-pager-eob] Move to the end of the buffer.\n\\[term-pager-discard] Kill pending output and kill process.\n\\[term-pager-disable] Disable PAGER handling.\n\n\\{term-pager-break-map}\nAny other key is passed through to the program\nrunning under the terminal emulator and disables pager processing until\nall pending output has been dealt with." nil] 3]] 2 (#$ . 56430) nil]) (defalias 'term-pager-continue #[(new-count) "Àp! !ˆÄ Ç ˆ Ê  \"ˆ Ì\"ˆÍ !)‡" [get-buffer-process process use-local-map term-pager-old-local-map nil term-old-mode-line-format mode-line-format force-mode-line-update new-count term-pager-count set-process-filter term-pager-old-filter "" continue-process] 3]) (defalias 'term-handle-scroll #[(down) "À Â\\\\ Z‰ÅVƒÆ`!Ç \nbˆ ƒL\f !ˆ`\f\f!ˆ`|ˆ bˆ\f !ˆÎ\f[!ˆÇÐÑ\f\"ˆ‚v§ƒf Z‰ÅWƒfÅÓ ˆ‚vÎ\f[!ˆ\f\f!ˆ\n`Ç“ˆ bˆ lj“ˆ*) ‡" [term-current-row down 1 term-scroll-end scroll-needed 0 copy-marker nil save-top save-point term-home-marker term-scroll-with-delete term-vertical-motion term-scroll-start term-adjust-current-row-cache term-current-column term-insert-char 10 term-pager-count term-process-pager] 4]) #@41 Move down DOWN screen lines vertically. (defalias 'term-down #[(down &optional check-for-scroll) "À \nƒ „\fƒÅ!Ç!ˆ`dU„*!ZÉVƒ@ÊË\"ˆÉ\fÉ ‚FÎ\fi …MÏ !)‡" [term-horizontal-column start-column check-for-scroll term-scroll-with-delete term-pager-count term-handle-scroll down term-adjust-current-row-cache term-vertical-motion 0 term-insert-char 10 term-current-column term-start-line-column nil term-move-columns] 3 (#$ . 58372)]) (defalias 'term-unwrap-line #[nil "n?…ÀÁ!‡" [insert-before-markers 10] 2]) (defalias 'term-erase-in-line #[(kind) "ÁVƒ ` Æ!ˆ` |ˆÇÈ\f\"ˆ*Á=?…M` ÆU…-É ÆU?\n Á!ˆ `|ˆ\nƒ@ËcˆÈcˆÌ `ÍÎ$ˆ b*‡" [kind 1 term-horizontal-column saved-point cols term-vertical-motion 0 term-insert-char 10 term-current-column wrapped 32 put-text-property face default] 5]) #@240 Erases (that is blanks out) part of the window. If KIND is 0, erase from (point) to (point-max); if KIND is 1, erase from home to point; else erase from home to point-max. Should only be called when point is at the start of a screen line. (defalias 'term-erase-in-display #[(kind) "À ˆ Â=ƒ`d|ˆÃ ‡Ä Å È=ƒ!`‚\"d \n \f\n |ˆÃ ˆÈ=ƒ@ÍÎ\f\"ˆÏÏÑ\f \",‡" [term-handle-deferred-scroll term-terminal-parameter 0 term-unwrap-line term-current-row term-horizontal-column term-home-marker kind 1 end-region start-region col row term-insert-char 10 nil term-current-column term-goto] 5 (#$ . 59197)]) (defalias 'term-delete-chars #[(count) "` Â!ˆÃ ˆbˆÄÅ \\Ç\"ˆ`|)‡" [save-point term-vertical-motion 1 term-unwrap-line move-to-column term-current-column count t] 3]) (defalias 'term-insert-spaces #[(count) "`À Ä!ˆnƒÅ ˆ`ÆÇ  Z\\Ê\"ˆ `Vƒ'` |ˆ\nbˆËÌ \"ˆ\nb*‡" [nil save-eol save-point term-vertical-motion 1 backward-char move-to-column term-start-line-column term-width count t term-insert-char 32] 4]) (defalias 'term-delete-lines #[(lines) "`  Ç!ˆ`|ˆÇ ZZ!ˆÊË\"ˆ \f b,‡" [term-current-column term-start-line-column term-current-row save-current-row save-start-line-column save-current-column start term-down lines term-scroll-end term-insert-char 10] 4]) (defalias 'term-insert-lines #[(lines) "`À \nà É\n\fZ Z!ˆ`É !ˆ`|ˆbˆ \fÌÍ \"ˆb-‡" [nil term-current-column term-start-line-column term-current-row save-current-row save-start-line-column save-current-column start-deleted start term-down term-scroll-end lines term-insert-char 10] 5]) #@49 Record raw inferior process output in a buffer. (defalias 'term-set-output-log #[(name) "ƒ\nÁšƒÂÄÅ!‡Æ!„'ŠÇ!qˆÈ ˆÉp!ˆÊ ˆ)Æ!ÄËÌ !\"‡" [name "" nil term-log-buffer message "Output logging off." get-buffer get-buffer-create fundamental-mode buffer-disable-undo erase-buffer "Recording terminal emulator output into buffer \"%s\"" buffer-name] 4 (#$ . 60809) (list (if term-log-buffer nil (read-buffer "Record output in buffer: " (format "%s output-log" (buffer-name (current-buffer))) nil)))]) #@43 Discontinue raw inferior process logging. (defalias 'term-stop-photo #[nil "ÀÁ!‡" [term-set-output-log nil] 2 (#$ . 61316) nil]) #@56 Put the end of the buffer at the bottom of the window. (defalias 'term-show-maximum-output #[nil "dbˆÀÁ!‡" [recenter -1] 2 (#$ . 61451) nil]) #@83 This hook is run when term is loaded in. This is a good place to put keybindings. (defvar term-load-hook nil (#$ . 61599)) (run-hooks (quote term-load-hook)) #@113 *If non-nil, automatically list possiblities on partial completion. This mirrors the optional behavior of tcsh. (defvar term-completion-autolist nil (#$ . -61764)) #@113 *If non-nil, add a `/' to completed directories, ` ' to file names. This mirrors the optional behavior of tcsh. (defvar term-completion-addsuffix t (#$ . -61935)) #@186 *If non-nil, use shortest completion if characters cannot be added. This mirrors the optional behavior of tcsh. A non-nil value is useful if `term-completion-autolist' is non-nil too. (defvar term-completion-recexact nil (#$ . -62105)) #@180 *List of suffixes to be disregarded during file completion. This mirrors the optional behavior of bash and tcsh. Note that this applies to `term-dynamic-complete-filename' only. (defvar term-completion-fignore nil (#$ . -62349)) #@169 Prefix prepended to absolute file names taken from process input. This is used by term's and shell's completion functions, and by shell's directory tracking functions. (defvar term-file-name-prefix "" (#$ . 62586)) (defalias 'term-directory #[(directory) "ÀÁ\n!ƒ \nP‚\n!‡" [expand-file-name file-name-absolute-p directory term-file-name-prefix] 3]) #@191 Return the word of WORD-CHARS at point, or nil if non is found. Word constituents are considered to be those in WORD-CHARS, which is like the inside of a "[...]" (see `skip-chars-forward'). (defalias 'term-word #[(word-chars) "Š`À ÂQà ÂQÇ\fÈÉ#ƒÊuˆl† Ë\f!?…1Ì ÍP\"ˆÎ”Ε{,‡" ["[" word-chars "]" "[^" non-word word limit re-search-backward nil move 1 looking-at re-search-forward "+" 0] 5 (#$ . 62946)]) #@112 Return the filename at point, or nil if non is found. Environment variables are substituted. See `term-word'. (defalias 'term-match-partial-filename #[nil "ÀÁ!‰… Ã\n!)‡" [term-word "~/A-Za-z0-9+@:_.$#,={}-" filename substitute-in-file-name] 3 (#$ . 63364)]) #@210 Dynamically perform completion at point. Calls the functions in `term-dynamic-complete-functions' to perform completion until a function returns non-nil, at which point completion is assumed to have occurred. (defalias 'term-dynamic-complete #[nil "‰… @ ?… A‰„Â)‡" [term-dynamic-complete-functions functions nil] 2 (#$ . 63632) nil]) #@691 Dynamically complete the filename at point. Completes if after a filename. See `term-match-partial-filename' and `term-dynamic-complete-as-filename'. This function is similar to `term-replace-by-expanded-filename', except that it won't change parts of the filename already entered in the buffer; it just adds completion characters to the end of the filename. A completions listing may be shown in a help buffer if completion is ambiguous. Completion is dependent on the value of `term-completion-addsuffix', `term-completion-recexact' and `term-completion-fignore', and the timing of completions listing is dependent on the value of `term-completion-autolist'. Returns t if successful. (defalias 'term-dynamic-complete-filename #[nil "À …Á  =„ÃÄ!ˆÅ ‡" [term-match-partial-filename selected-window minibuffer-window message "Completing file name..." term-dynamic-complete-as-filename] 2 (#$ . 63982) nil]) #@110 Dynamically complete at point as a filename. See `term-dynamic-complete-filename'. Returns t if successful. (defalias 'term-dynamic-complete-as-filename #[nil "À\nÄÆ †\fÇÉ!\nË!\f\nƒ&Í\n!‚(Ð\f\"Ò Ó =„IÕÖ\"ˆÀ‚þÄ=ƒdƒXØcˆ„þÕÙ!ˆ‚þǘƒqÚ ˆ‚þÛ!PÝ!\fGÀOcˆÐ\"9ƒ®ƒ¢Þ!ƒŸß‚ Øcˆ„ýÕà!ˆ‚ý!ƒáƒá\f˜ƒáâ!ƒáÞ!ƒÒß‚ÓØcˆ„ýÕã!ˆ‚ý$„î\f˜ƒôÚ ˆ‚ý„ýÕå!ˆ) . ‡" [nil completion-ignore-case term-completion-fignore completion-ignored-extensions t success term-match-partial-filename "" filename file-name-directory pathdir file-name-nondirectory pathnondir term-directory default-directory directory file-name-completion completion selected-window minibuffer-window mini-flag message "No completions of %s" term-completion-addsuffix " " "Sole completion" term-dynamic-list-filename-completions file-name-as-directory file directory-file-name file-directory-p "/" "Completed" term-completion-recexact file-exists-p "Completed shortest" term-completion-autolist "Partially completed"] 3 (#$ . 64903)]) #@475 Dynamically expand and complete the filename at point. Replace the filename with an expanded, canonicalised and completed replacement. "Expanded" means environment variables (e.g., $HOME) and `~'s are replaced with the corresponding directories. "Canonicalised" means `..' and `.' are removed, and the filename is made absolute instead of relative. For expansion see `expand-file-name' and `substitute-in-file-name'. For completion see `term-dynamic-complete-filename'. (defalias 'term-replace-by-expanded-filename #[nil "ÀÁ !É#ˆÄ ‡" [replace-match expand-file-name term-match-partial-filename t term-dynamic-complete-filename] 4 (#$ . 65981) nil]) #@590 Dynamically complete STUB from CANDIDATES list. This function inserts completion characters at point by completing STUB from the strings in CANDIDATES. A completions listing may be shown in a help buffer if completion is ambiguous. Returns nil if no completion was inserted. Returns `sole' if completed with the only completion match. Returns `shortest' if completed with the shortest of the completion matches. Returns `partial' if completed as far as possible with the completion matches. Returns `listed' if a completion listing was shown. See also `term-dynamic-complete-filename'. (defalias 'term-dynamic-simple-complete #[(stub candidates) "ÀÂÃ\f\"Å\f\"‰„ÈÉ\"ˆÀ‚¡GÊUƒQ@‰ ˜ƒ7ÈÌ!ˆ‚D GÀOcˆÈÍ!ˆƒLÏcˆ)Ђ¡Ñ\f\"‰ GÀOcˆƒ…ƒ… ˜ƒ… ƒ…ÏcˆÈÓ!ˆÔ‚ „’ ˜ƒ›Ö!ˆ×‚ ÈØ!ˆÙ)+‡" [nil completion-ignore-case mapcar #[(x) "C‡" [x] 1] candidates all-completions stub completions message "No completions of %s" 1 completion "Sole completion" "Completed" term-completion-addsuffix " " sole try-completion term-completion-recexact "Completed shortest" shortest term-completion-autolist term-dynamic-list-completions listed "Partially completed" partial] 4 (#$ . 66643)]) #@68 List in help buffer possible completions of the filename at point. (defalias 'term-dynamic-list-filename-completions #[nil "À †ÃÅ\f!Ç\f!ƒÉ!‚!\n Ì \"‰ ƒ6Î !‚:ÏÐ\f\".‡" [nil completion-ignore-case term-match-partial-filename "" filename file-name-directory pathdir file-name-nondirectory pathnondir term-directory default-directory directory file-name-all-completions completions term-dynamic-list-completions message "No completions of %s"] 4 (#$ . 67858) nil]) #@77 List in help buffer sorted COMPLETIONS. Typing SPC flushes the help buffer. (defalias 'term-dynamic-list-completions #[(completions) "À ÂÃÄ Æ\"!‘ˆÇÈ!ˆÉ‰\n ŠÌÂ!qˆÍÉ!‰ ÎH‰\n:…HÏ\n‰A@)‰@)!ÌÂ!=…HÒ !Ó=)ƒWÓ\n!ˆÔ !‚k\nÕ=ƒdÔ !‚kÖ !‰+‡" [current-window-configuration conf "*Completions*" display-completion-list sort completions string-lessp message "Hit space to flush" nil first key get-buffer read-key-sequence 0 window-buffer event position key-binding mouse-choose-completion set-window-configuration 32 listify-key-sequence unread-command-events] 6 (#$ . 68351)]) (provide (quote term)) emacs-19.30/lisp/terminal.elc100666 13437 1 62614 6033656777 14565 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Oct 1 23:34:54 1995 ;;; from file /home/fsf/rms/e19/lisp/terminal.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`terminal.el' was compiled for Emacs 19.29 or later")) (require (quote ehelp)) #@336 *All characters except for this are passed verbatim through the terminal-emulator. This character acts as a prefix for commands to the emulator program itself. Type this character twice to send it through the emulator. Type ? after typing it for a list of possible commands. This variable is local to each terminal-emulator buffer. (defvar terminal-escape-char 30 (#$ . -499)) #@228 *If non-nil, the terminal-emulator will losingly `scroll' when output occurs past the bottom of the screen. If nil, output will win and `wrap' to the top of the screen. This variable is local to each terminal-emulator buffer. (defvar terminal-scrolling t (#$ . -886)) #@91 *If non-nil, do more-processing. This variable is local to each terminal-emulator buffer. (defvar terminal-more-processing t (#$ . -1161)) #@240 *Maximum number of characters which will be processed by the terminal-emulator before a screen redisplay is forced. Set this to a large value for greater throughput, set it smaller for more frequent updates but overall slower performance. (defvar terminal-redisplay-interval 5000 (#$ . -1307)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ B\f„+Æ ÈÉÊ#ˆ)ÀË!„4Å Ë B „[Æ ÈÌÊ#ˆÈÍÎ#ˆÈÏ\f#ˆ )ÀÐ!„dÅÐ B„èÆ ÈÑÒ#ˆÓÕHÖXƒ™È×#ˆÕÕHTIˆ‚{)ÈØÙ#ˆÈÚÛ#ˆÈÜÝ#ˆÈÞß#ˆÈàá#ˆÈâã#ˆÈäå#ˆÈæç#ˆÈèé#ˆÈê+!é#ˆ)Àì!„ñÅ,ì B,„ýí,Àî!„Å.î B.„EÆ Èïð#ˆÈê+!ñ#ˆÈòó#ˆÈÞß#ˆÈàô#ˆÈõö#ˆ.)À÷!„NÅ7÷ BÀø!„[Å8ø BÀù!„hÅ9ù BÀú!„uÅ:ú BÀû!„‚Å;û BÀü!„Å<ü BÀý!„œÅ=ý Bþ BÀÿ!„­Å?ÿ BÀ@!„¼Å@@ BÀA!„ÍÅAA BÀB!„ÞÅBB BÀC!„ïÅCC BDEE BÀF!„ ÅFF BŇ" [boundp terminal-more-break-insertion "*** More break -- Press space to continue ***" current-load-list terminal-meta-map nil make-sparse-keymap map define-key [t] te-pass-through terminal-map [t] [switch-frame] handle-switch-frame "" terminal-escape-map [t] undefined "0" s 0 57 digit-argument "b" switch-to-buffer "o" other-window "e" te-set-escape-char "\f" redraw-display "" te-flush-pending-output "m" te-toggle-more-processing "x" te-escape-extended-command "w" te-edit "?" te-escape-help char-to-string help-char te-escape-command-alist (("Set Escape Character" . te-set-escape-char) ("Edit" . te-edit) ("Refresh" . redraw-display) ("Record Output" . te-set-output-log) ("Photo" . te-set-output-log) ("Tofu" . te-tofu) ("Stuff Input" . te-stuff-string) ("Flush Pending Output" . te-flush-pending-output) ("Enable More Processing" . te-enable-more-processing) ("Disable More Processing" . te-disable-more-processing) ("Scroll at end of page" . te-do-scrolling) ("Wrap at end of page" . te-do-wrapping) ("Switch To Buffer" . switch-to-buffer) ("Other Window" . other-window) ("Kill Buffer" . kill-buffer) ("Help" . te-escape-help) ("Set Redisplay Interval" . te-set-redisplay-interval)) terminal-more-break-map [t] te-more-break-unread te-more-break-help " " te-more-break-resume te-more-break-flush-pending-output " " te-more-break-advance-one-line te-process te-log-buffer te-height te-width te-more-count te-redisplay-count te-pending-output te-saved-point te-more-old-point te-more-old-local-map te-more-old-filter te-more-old-mode-line-format te-pending-output-info "emacs-virtual" te-terminal-name-prefix te-terminal-name] 4) (defalias 'te-escape #[nil "ÀÁ  ÆŽÇ!ˆÉ!ˆÊ ƒ$ÌÍÎ !\"‚%Ï!)ÐÑ!ˆ ;ƒH ÒÓ\"˜ƒHÖ× )‚UØ \"‰…UÙ !+‡" [nil current-local-map current-global-map global local s ((byte-code "À !ˆÂ !‡" [use-global-map global use-local-map local] 2)) use-global-map terminal-escape-map use-local-map read-key-sequence current-prefix-arg format "Emacs Terminal escape> %d " prefix-numeric-value "Emacs Terminal escape> " message "" make-string 1 terminal-escape-char last-command-char -259 te-pass-through lookup-key call-interactively] 5 nil nil]) #@73 Provide help on commands available after terminal-escape-char is typed. (defalias 'te-escape-help #[nil "ÀÁ!ˆÂ !ÅÆ!)‡" [message "Terminal emulator escape help..." single-key-description terminal-escape-char char with-electric-help #[nil "ÀÁ ‰‰‰%!ˆÀÄÅ!!ˆÀÁÆÇÈ Ê#È#!ˆËÌ!ƒ-ÌÍ!Ï\"‚4ÐÍ!Ñ\"‰ƒxÓ@A!†DÔÖ×\"ƒV؉”OÀÙ!ˆÀ@@!ˆÀÚ!ˆÀ!ˆÛÜ!ˆ)A‰„:)݇" [princ format "Terminal-emulator escape, invoked by \"%s\"\nType \"%s\" twice to send a single \"%s\" through.\n\nOther chars following \"%s\" are interpreted as follows:\n" char substitute-command-keys "\\{terminal-escape-map}\n" "\nSubcommands of \"%s\" (%s)\n" where-is-internal te-escape-extended-command terminal-escape-map t fboundp sortcar copy-sequence te-escape-command-alist string< sort #[(a b) "@ @™‡" [a b] 2] l documentation "Not documented" doc string-match "\n" 0 " \"" "\":\n " write-char 10 nil] 8]] 2 (#$ . 4338) nil]) (defalias 'te-escape-extended-command #[nil "ÀÂÃ\fÅÀ$)‰…ÇÈ)‡" [t completion-ignore-case completing-read "terminal command: " te-escape-command-alist nil c foo (byte-code "— \n…&\n@@—˜ƒÃÄÅ\n@A!\"ˆ‚\nA‰„ Æ)‡" [c te-escape-command-alist l throw foo call-interactively nil] 5)] 6 nil nil]) (defalias 'te-escape-extended-command-unread #[nil "ÀÁ !à ‡" [listify-key-sequence this-command-keys unread-command-events te-escape-extended-command] 2 nil nil]) #@48 Change the terminal-emulator escape character. (defalias 'te-set-escape-char #[(c) " Uƒ Ä‚ÅÆ !Æ !#ˆ ‰)‡" [terminal-escape-char o message c "\"%s\" is the escape char" "\"%s\" is now the escape; \"%s\" passes through" single-key-description] 5 (#$ . 5722) "cSet escape character to: "]) #@151 Read a string to send to through the terminal emulator as though that string had been typed on the keyboard. Very poor man's file transfer protocol. (defalias 'te-stuff-string #[(string) "À \n\"‡" [process-send-string te-process string] 3 (#$ . 6023) "sStuff string: "]) #@55 Record output from the terminal emulator in a buffer. (defalias 'te-set-output-log #[(name) "ƒ\nÁšƒÂÄÅ!‡Æ!„'ŠÇ!qˆÈ ˆÉp!ˆÊ ˆ)Æ!ÄËÌ !\"‡" [name "" nil te-log-buffer message "Output logging off." get-buffer get-buffer-create fundamental-mode buffer-disable-undo erase-buffer "Recording terminal emulator output into buffer \"%s\"" buffer-name] 4 (#$ . 6301) (list (if te-log-buffer nil (read-buffer "Record output in buffer: " (format "%s output-log" (buffer-name (current-buffer))) nil)))]) #@25 Discontinue output log. (defalias 'te-tofu #[nil "ÀÁ!‡" [te-set-output-log nil] 2 (#$ . 6807) nil]) (defalias 'te-toggle #[(sym arg) " §„\n ‚! ÂUƒJ?‚! ÃWƒ Ä‚!ÅL‡" [sym arg 1 0 nil t] 3]) (defalias 'te-toggle-more-processing #[(arg) "ÀÁ \"ƒ\fÄ‚ Å!ˆ\n…Ɖ‡" [message te-toggle terminal-more-processing arg "More processing on" "More processing off" -1 te-more-count] 4 nil "p"]) (defalias 'te-toggle-scrolling #[(arg) "ÀÁ \"ƒ\fÄ‚ Å!‡" [message te-toggle terminal-scrolling arg "Scroll at end of page" "Wrap at end of page"] 4 nil "p"]) #@30 Enable ** MORE ** processing (defalias 'te-enable-more-processing #[nil "ÀÁ!‡" [te-toggle-more-processing t] 2 (#$ . 7365) nil]) #@31 Disable ** MORE ** processing (defalias 'te-disable-more-processing #[nil "ÀÁ!‡" [te-toggle-more-processing nil] 2 (#$ . 7500) nil]) #@30 Scroll at end of page (yuck) (defalias 'te-do-scrolling #[nil "ÀÁ!‡" [te-toggle-scrolling t] 2 (#$ . 7639) nil]) #@38 Wrap to top of window at end of page (defalias 'te-do-wrapping #[nil "ÀÁ!‡" [te-toggle-scrolling nil] 2 (#$ . 7758) nil]) #@202 Set the maximum interval (in output characters) between screen updates. Set this number to large value for greater throughput, set it smaller for more frequent updates (but overall slower performance. (defalias 'te-set-redisplay-interval #[(arg) "Á]‰É‡" [arg 1 terminal-redisplay-interval 0 te-redisplay-count] 3 (#$ . 7887) "NMax number of output chars between redisplay updates: "]) (put (quote te-more-break-unread) (quote suppress-keymap) t) (defalias 'te-more-break-unread #[nil " =ƒ\nÂÃ!‡ÄÅÆ!Ç #ˆÈ Ê ˆË\fÍ )‡" [last-input-char terminal-escape-char call-interactively te-escape message "Continuing from more break (\"%s\" typed, %d chars output pending...)" single-key-description te-pending-output-length 259259 te-more-count te-more-break-unwind nil terminal-more-processing te-pass-through] 4 nil nil]) #@77 Proceed past the **MORE** break, allowing the next page of output to appear (defalias 'te-more-break-resume #[nil "ÀÁ!ˆÂ ‡" [message "Continuing from more break" te-more-break-unwind] 2 (#$ . 8714) nil]) #@74 Provide help on commands available in a terminal-emulator **MORE** break (defalias 'te-more-break-help #[nil "ÀÁ!ˆÂÃ!ˆÄÅ!‡" [message "Terminal-emulator more break help..." sit-for 0 with-electric-help #[nil "ÀÁ!ˆÀÂÃÄÅÇ#ÈÅ!#!ˆÀÉÊ!!ˆÀË!ˆÌ‡" [princ "Terminal-emulator more break.\n\n" format "Type \"%s\" (te-more-break-resume)\n%s\n" where-is-internal te-more-break-resume terminal-more-break-map t documentation substitute-command-keys "\\{terminal-more-break-map}\n" "Any other key is passed through to the program\nrunning under the terminal emulator and disables more processing until\nall pending output has been dealt with." nil] 7]] 2 (#$ . 8924) nil]) #@75 Allow one more line of text to be output before doing another more break. (defalias 'te-more-break-advance-one-line #[nil "À ‡" [1 te-more-count te-more-break-unwind] 1 (#$ . 9590) nil]) #@129 Discard any output which has been received by the terminal emulator but not yet processed and then proceed from the more break. (defalias 'te-more-break-flush-pending-output #[nil "À ˆÁ ‡" [te-more-break-unwind te-flush-pending-output] 1 (#$ . 9786) nil]) #@89 Discard any as-yet-unprocessed output which has been received by the terminal emulator. (defalias 'te-flush-pending-output #[nil "A„ ÁÂ!‡Ã ÁÅ\f\"ˆÆÇÈ\f\"DÉ ˆÊË!ˆÌÆ!)‡" [te-pending-output message "(There is no output pending)" te-pending-output-length length "Flushing %d chars of pending output" 0 format "\n*** %d chars of pending output flushed ***\n" te-update-pending-output-display te-process-output nil sit-for] 4 (#$ . 10048) nil]) #@198 Character is passed to the program running under the terminal emulator. One characters is treated specially: the terminal escape character (normally C-^) lets you type a terminal emulator command. (defalias 'te-pass-through #[nil " =ƒ\nÂÃ!‡9ƒÄNƒÄN¨ƒ.ÅÆ\"ÇU„.ÅÈ\"É\\¨ƒO\nƒB A„BÌÍ!ˆÎÐÑ\"\"ˆÒÓ!‡ÔÕÖ!\"‡" [last-input-char terminal-escape-char call-interactively te-escape ascii-character logand -134217728 0 127 128 terminal-more-processing te-pending-output te-set-more-count nil send-string te-process make-string 1 te-process-output t message "Function key `%s' ignored" single-key-description] 5 (#$ . 10498) nil]) (defalias 'te-set-window-start #[nil "Àp!‰…  ! ?†= `eZ\fT¥Yƒ#Å e\"‚= d`Z\fT¥Yƒ<Å d \fT_ZÆZ\"‚=Ç*‡" [get-buffer-window w window-height h te-width set-window-start -1 nil] 6]) (defalias 'te-pending-output-length #[nil "@A ƒ\n @G\\ A‰„\n\n*‡" [te-pending-output tem length] 3]) (byte-code "ÀÁ!„ÂÁ B „Ä Å ÆÇ#ˆÈÉÊË#‡" [boundp terminal-edit-map nil current-load-list make-sparse-keymap define-key "" terminal-cease-edit put terminal-edit-mode mode-class special] 4) #@227 Major mode for editing the contents of a terminal-emulator buffer. The editing commands are the same as in Fundamental mode, together with a command \to return to terminal emulation: \[terminal-cease-edit]. (defalias 'terminal-edit-mode #[nil "À !ˆÂÄÆÇ!È ÊË!‡" [use-local-map terminal-edit-map terminal-edit-mode major-mode "Terminal Edit" mode-name default-value mode-line-modified nil mode-line-process run-hooks terminal-edit-mode-hook] 2 (#$ . 11633)]) #@74 Start editing the terminal emulator buffer with ordinary Emacs commands. (defalias 'te-edit #[nil "À ˆÁ ˆÂÃ!Ä=ƒÅÆ!‡ÅÇÈ!!‡" [terminal-edit-mode force-mode-line-update key-binding "" terminal-cease-edit message "Editing: Type C-c C-c to return to Terminal" substitute-command-keys "Editing: Type \\[terminal-cease-edit] to return to Terminal"] 3 (#$ . 12120) nil]) #@57 Finish editing message; switch back to Terminal proper. (defalias 'terminal-cease-edit #[nil "À~ˆÂ \fSebˆ ÈYƒ‘` ÊË \\Ì#ƒ:ÍuˆÎÏ` ZZ\"ˆÐuˆ‚qmƒLÎÏ` ZZ\"ˆ‚qgÑUƒXÐuˆ‚q` ÊËÀÒ#ƒl `S|ˆ‚q d|ˆ) ÈUƒƒm„Š`d|ˆ‚ŠmƒŠÑcˆ S‰‚bˆÀ‰“ˆ`ÈÍ,Ö×!Ø!ˆÚÜÞ‰‡" [nil buffer-read-only point-marker te-width te-height h width opoint 0 p search-forward "\n" move -1 insert-char 32 1 10 t te-saved-point te-redisplay-count te-more-count default-value mode-line-modified use-local-map terminal-map terminal-mode major-mode "terminal" mode-name (":%s") mode-line-process] 6 (#$ . 12493) nil]) (defalias 'te-more-break #[nil "ÀÁ!ˆÂÃ!ˆ`ÂÄ!ˆÅ Æ!ˆÂÈ!ˆÉ\n!ÂË!ˆ\f ÍÏE\fÐ\nÑ\"ˆÒ ˆÓÔ !p=ƒEÕÖ!ˆm„^ƒ^ŠØuˆ``\\|ˆcˆ)ÚÛ!ˆÜÝ!ˆÞßÁ\"‡" [te-set-more-count t make-local-variable te-more-old-point te-more-old-local-map current-local-map use-local-map terminal-more-break-map te-more-old-filter process-filter te-process te-more-old-mode-line-format mode-line-format "-- **MORE** " mode-line-buffer-identification "%-" set-process-filter #[(process string) "ŠÀ !qˆ\n C¤)Ä ‡" [process-buffer process te-pending-output string te-update-pending-output-display] 2] te-update-pending-output-display window-buffer selected-window message "More break " terminal-more-break-insertion 1 te-width run-hooks terminal-more-break-hook sit-for 0 throw te-process-output] 3]) (defalias 'te-more-break-unwind #[nil "À !ˆÂ \f\"ˆ bˆÈ ˆÉ\nm„3 ƒ3Ìuˆ`` G\\|ˆÍÎ\"ˆ bˆÉÐÒ ˆ*ÓÔ!‡" [use-local-map te-more-old-local-map set-process-filter te-process te-more-old-filter te-more-old-point te-more-old-mode-line-format mode-line-format force-mode-line-update nil buffer-read-only terminal-more-break-insertion 1 insert-char 32 te-width 259259 te-more-count te-newline te-process-output t] 3]) (defalias 'te-set-more-count #[(newline) "`eZT¥\nƒ T Uƒ ‰‚N SUƒ' ‰‚N Å¥W„7 ZÆVƒ? Z‰‚N ‰ÆVƒJÅ‚KÇZ‰)‡" [te-width line newline te-height te-more-count 2 10 1] 3]) #@120 Move down a line, optionally do more processing, perhaps wrap/scroll, move to start of new line, clear to end of line. (defalias 'te-newline #[nil "Àˆ ƒ \nS‰ÃWƒÄÅ!ˆ‚ \nÃ=ƒ Æ ˆmƒ@ee\\|ˆebˆƒJÉÊ!ˆdbˆËcˆ‚JÊuˆ``\\|ˆÌÍ\"ˆÃyˆÎ ‡" [nil terminal-more-processing te-more-count 0 te-set-more-count t te-more-break te-width terminal-scrolling delete-char 1 10 insert-char 32 te-set-window-start] 3 (#$ . 14486)]) (defalias 'te-move-to-position #[nil "À ÁZÀ ÁZ\n\fV„ V„ e\n \fT_\\\\bˆ*Ɖ‡" [te-get-char 32 x y te-width te-height -1 te-more-count] 4]) (defalias 'te-clear-rest-of-line #[nil "Š`Àˆ`Z`` \\|ˆÂà [\"*‡" [nil n insert-char 32] 3]) (defalias 'te-clear-rest-of-screen #[nil "ŠÀ ˆÁˆm?… ÂuˆÁˆ` Z`|ˆÄÅ \"ˆ‚)‡" [te-clear-rest-of-line nil 1 te-width insert-char 32] 3]) (defalias 'te-clear-screen #[nil "À ˆÁ\n Wƒ\nTÄÅ\"ˆÇcˆ‚)dSd|ˆebˆÈ‰ ‡" [erase-buffer 0 i te-height insert-char 32 te-width 10 -1 te-more-count] 3]) (defalias 'te-insert-lines #[nil "nƒNŠ`eZ T¥ZÂZÄ ÅZ ^Çd T_Zd|ˆ`d=ƒ.ÉcˆWƒMTÊÅ \"ˆ =„.Écˆ‚.,‰ ‡" [te-height te-width -1 line te-get-char 32 n 0 i 10 insert-char te-more-count] 3]) (defalias 'te-delete-lines #[nil "nƒJ`eZ T¥ZÂZÄ ÅZ ^Ç`` T_\\d^|ˆŠdbˆWƒITÉÅ \"ˆ =„*Êcˆ‚*,‰ ‡" [te-height te-width -1 line te-get-char 32 n 0 i insert-char 10 te-more-count] 4]) (defalias 'te-beginning-of-line #[nil "ÀyˆÁ‡" [0 nil] 1]) (defalias 'te-backward-char #[nil "n?…ÀÁ!‡" [backward-char 1] 2]) (defalias 'te-forward-char #[nil "l?…Àu‡" [1] 1]) (defalias 'te-delete #[nil "n?…`S`|ˆÀcˆÁu‡" [32 -1] 2]) (defalias 'te-beep #[nil "À ‡" [beep] 1]) (defalias 'te-insert-spaces #[nil "`Á ÂZÈ`Z^‰ÅX„!Æ\f[!ˆbˆÇÂ\f\"ˆb*‡" [p te-get-char 32 nil n 0 delete-char insert-char] 4]) (defalias 'te-delete-char #[nil "`Á ÂZÈ`Z^‰ÅX„ ÆÂ\f\"ˆbˆÇ\f!ˆb*‡" [p te-get-char 32 nil n 0 insert-char delete-char] 4]) (defalias 'te-losing-unix #[nil "À‡" [nil] 1]) (defalias 'te-output-tab #[nil "`‰Áyˆ`ZÃÄ\nÅ\"Zƈ`Z^\\b+‡" [p 0 x 8 logand 7 nil l] 5]) #@51 Move down a line vertically, or scroll at bottom. (defalias 'te-down-vertically-or-scroll #[nil "iÁˆmƒ'ee\n\\|ˆebˆÃÄ!ˆdbˆÅcˆÆÇ\n\"ˆÈyˆ‚*ÄyˆÉ!ˆ)Ê ‡" [column nil te-width delete-char 1 10 insert-char 32 0 move-to-column te-set-window-start] 3 (#$ . 16527)]) (defalias 'te-filter #[(process string) "pÁŽÂ !qˆ\fbˆÅ!ƒ1Ç!„ È‚1qˆdbˆÉ\n!ˆÂ !qˆ \nC¤ Ì ˆÍpÎÏ !=!ˆÂ !qˆ`‰*‡" [obuf ((set-buffer obuf)) process-buffer process te-saved-point bufferp te-log-buffer buffer-name nil insert-before-markers string te-pending-output te-update-pending-output-display te-process-output window-buffer selected-window] 4]) (defalias 'te-process-output #[(preemptable) "ÀÂÃˆÄ ‰ Ç!‰=?…+È!p=ƒ\fÉ`\"ˆ‚\f*‡" [t preemptable te-process-output (byte-code "À‰‰‰‰‰Aƒ< @A@‰ H T‰ G=ƒAÈAABÈA@É ˆ‚F  ˆ\nÊVƒ\n\nËWƒ\nlƒw È=ƒkÈÌÍ\n\"ABB‚q S ˆÎ ˆ‚* „‰ÏÍ!ˆ\ncˆÐÍ!ˆ‚*\f =ƒ“ †ŸÑÒ #‰†Ÿ GÏÍ!ˆ\ncˆ`Àˆ `\nZ\\^\nbˆ =ƒÃÀ`` Z\\|ˆ È=ƒÞ G=ƒÞ ‚ã Ocˆ G=ƒøÈAAB‚þ ˆÐ ZT!ˆ)‚*\nÔ=ƒÕ ÖžA†$ׂ$\nØžA†$× ˆÐÍ!ˆƒ Ú ƒ ÛÜÝ\"ˆ‚ .À‡" [nil matchpos char start ostring string buffer-read-only te-pending-output 0 te-update-pending-output-display 31 255 make-string 1 te-newline delete-char te-redisplay-if-necessary string-match "[--ÿ]" end 16 te-get-char ((61 . te-move-to-position) (99 . te-clear-rest-of-line) (67 . te-clear-rest-of-screen) (15 . te-insert-lines) (11 . te-delete-lines) (1 . te-beginning-of-line) (2 . te-backward-char) (100 . te-delete-char) (95 . te-insert-spaces) (6 . te-forward-char) (7 . te-beep) (10 . te-down-vertically-or-scroll) (12 . te-clear-screen)) te-losing-unix ((10 . te-newline) (127 . te-delete) (13 . te-beginning-of-line) (7 . te-beep) (8 . te-backward-char) (9 . te-output-tab)) preemptable input-pending-p throw te-process-output t] 7) selected-window s w next-window window-buffer set-window-point] 4]) (defalias 'te-get-char #[nil "Aƒ(@A@ \nH\nT‰ G=ƒ\"ÃAAB‚&\n ˆ*‡ÄŇ" [te-pending-output string start 0 char (byte-code "À !ÃŽÄ Å\"ˆÆ !*‡" [process-filter te-process filter ((set-process-filter te-process filter)) set-process-filter #[(p s) "GÁ=„ ÁDÃÄÅH\"‡" [s 1 te-pending-output throw char 0] 4] accept-process-output] 3)] 3]) (defalias 'te-redisplay-if-necessary #[(length) " Z‰ÂX…#pÃÄ !=…#Å …#Æ ˆÇÂ!ˆ‰‡" [te-redisplay-count length 0 window-buffer selected-window waiting-for-user-input-p te-update-pending-output-display sit-for terminal-redisplay-interval] 3]) (defalias 'te-update-pending-output-display #[nil "A„\nÁ‚\"à ‰ÅWƒÁ‚!ÆÇ\fÈ\\É¥\")Ê ‡" [te-pending-output "" te-pending-output-info te-pending-output-length length 1500 format "(%dK chars output pending) " 512 1024 force-mode-line-update] 5]) (defalias 'te-sentinel #[(process message) "À !Â=†DÃÄ !!?†DpŠÄ !qˆÆÈ ˆdbˆÉ ˆÊ ˆË\fͱˆ) Ä !=…CÎ …CdbˆÏÐ!)‡" [process-status process run buffer-name process-buffer b nil buffer-read-only fundamental-mode delete-blank-lines delete-horizontal-space "\n*******\n" message "*******\n" waiting-for-user-input-p recenter -1] 3]) #@60 Shell command to set terminal modes for terminal emulator. (defvar te-stty-string "stty -nl erase '^?' kill '^u' intr '^c' echo pass8" (#$ . 19618)) #@75 *If non-nil, is file name to use for explicitly requested inferior shell. (defvar explicit-shell-file-name nil (#$ . -19773)) #@1396 Under a display-terminal emulator in BUFFER, run PROGRAM on arguments ARGS. ARGS is a list of argument-strings. Remaining arguments are WIDTH and HEIGHT. BUFFER's contents are made an image of the display generated by that program, and any input typed when BUFFER is the current Emacs buffer is sent to that program an keyboard input. Interactively, BUFFER defaults to "*terminal*" and PROGRAM and ARGS are parsed from an input-string using your usual shell. WIDTH and HEIGHT are determined from the size of the current window -- WIDTH will be one less than the window's width, HEIGHT will be its height. To switch buffers and leave the emulator, or to give commands to the emulator itself (as opposed to the program running under it), type Control-^. The following character is an emulator command. Type Control-^ twice to send it to the subprogram. This escape character may be changed using the variable `terminal-escape-char'. `Meta' characters may not currently be sent through the terminal emulator. Here is a list of some of the variables which control the behaviour of the emulator -- see their documentation for more information: terminal-escape-char, terminal-scrolling, terminal-more-processing, terminal-redisplay-interval. This function calls the value of terminal-mode-hook if that exists and is non-nil after the terminal buffer has been set up and the subprocess started. (defalias 'terminal-emulator #[(buffer program args &optional width height) "À !ˆ\n„ÃÄ !ÅZ„ÇÄ !ÅZÈ ˆ\n \n Ì \nR ÎÏ \n#ÐDÒÔ ˆ)ÒÖp!‰ƒm×ÎØÙ!\"!ƒbÚ!ˆ‚EÛÜÙ!\"ˆ‚E)ÝÞ߈à!â#!ˆäå!ˆæçè)!êèëì-à#î##‡" [switch-to-buffer buffer width window-width selected-window 1 height window-height terminal-mode te-width te-height te-terminal-name-prefix "-" te-terminal-name format "Emacs terminal %dx%d: %%b " te-pending-output-info mode-line-buffer-identification nil buffer-read-only te-clear-screen process get-buffer-process y-or-n-p "Kill process %s? " process-name delete-process error "Process %s not killed" err (byte-code "À PÂà PÄÅ PBBBÇÈpÉÊËÌ ÎÏBÒ##%ÔÕ\"ˆÖ×\"ˆ)Ç" ["TERM=" te-terminal-name "TERMCAP=" te-create-termcap "TERMINFO=" te-create-terminfo process-environment start-process "terminal-emulator" "/bin/sh" "-c" format "%s; exec %s" te-stty-string mapconcat te-quote-arg-for-sh program args " " te-process set-process-filter te-filter set-process-sentinel te-sentinel] 12) ((error (byte-code "À ˆÁ\n@\nA\"‡" [fundamental-mode signal err] 3))) t inhibit-quit use-local-map terminal-map run-hooks terminal-mode-hook message "Entering emacs terminal-emulator... Type %s %s for help" single-key-description terminal-escape-char mapconcat where-is-internal te-escape-help terminal-escape-map " "] 9 (#$ . 19907) (byte-code "ŠÀÁ!qˆÂÃÄ!ƒ\fƒÅ\f!Æ=„p‚ ÇÁ!!)È †5ÊË!†5ÊÌ!†5ÍÏÐÑ\"!‰ÓšƒMÔD‚QÕ!*!B‡" [get-buffer-create "*terminal*" buffer-name boundp te-process process-status run generate-new-buffer append explicit-shell-file-name getenv "ESHELL" "SHELL" "/bin/sh" default-s read-string format "Run program in emulator: (default %s) " s "" nil te-parse-program-and-args] 7)]) (defalias 'te-parse-program-and-args #[(s) "ÀÁ\n\"ƒGÃÄ ƒ:ÀÇ\n #ƒ,\n È•OÄ•‰\nG=ƒ2Â2\n ÃOÃB‚\fŸ‰@A*D‡ÀÉ\n\"ƒ]Ê\n!„] ÌÍ\nPDD‡\nÃD‡" [string-match "\\`\\([-a-zA-Z0-9+=_.@/:]+[ ]*\\)+\\'" s nil 0 p l "\\([-a-zA-Z0-9+=_.@/:]+\\)\\([ ]+\\)*" 1 "[ ]" file-exists-p shell-file-name "-c" "exec "] 5]) (put (quote terminal-mode) (quote mode-class) (quote special)) #@134 Set up variables for use with the terminal-emulator. One should not call this -- it is an internal function of the terminal-emulator (defalias 'terminal-mode #[nil "À ˆÁp!ˆÂÄÆÈ È\nËÌ!ˆÍÌ!\fËÎ!ˆÍÎ!ËÏ!ˆÍÏ!ËÐ!ˆÍÐ!ËÑ!ˆËÒ!ˆËÓ!ˆËÔ!ˆÕCËÖ!ˆeË×!ˆØËÙ!ˆËÚ!ˆÛËÜ!ˆÝËÞ!ˆ‰‡" [kill-all-local-variables buffer-disable-undo terminal-mode major-mode "terminal" mode-name (":%s") mode-line-process t buffer-read-only truncate-lines make-local-variable terminal-escape-char default-value terminal-scrolling terminal-more-processing terminal-redisplay-interval te-width te-height te-process te-pending-output 0 te-saved-point te-pending-output-info "" inhibit-quit te-log-buffer nil te-more-count -1 te-redisplay-count] 2 (#$ . 23433)]) (defalias 'te-quote-arg-for-sh #[(string) "ÀÁ\n\"ƒ \n‡ÀÃ\n\"„Ä\n!‡ÅƉ \nGY„YÀÊ\n#‰„> \nËOP ‚Y \nOÌ\n‰TOR T‰‚Í ÍQ+‡" [string-match "\\`[-a-zA-Z0-9+=_.@/:]+\\'" string "[$]" prin1-to-string "" 0 end start harder "[\"\\$]" nil "\\" "\""] 7]) #@98 Create and compile a terminfo entry for the virtual terminal. This is kept in the /tmp directory (defalias 'te-create-terminfo #[nil "ƒUÁ ÄÅOÆR!„UÈÉ\n $ÌÍÎÏÐÑ°ÂÒQŠÕ!qˆcˆÖ!ˆ×Ø!ˆ)ÙÚPBÜÝÞØÞ$ß\"ˆ+Ú‡" [system-uses-terminfo file-exists-p "/tmp/" te-terminal-name-prefix 0 1 "/" te-terminal-name format "%s,mir, xon,cols#%d, lines#%d," te-width te-height "bel=^P^G, clear=^P\\f, cr=^P^A, cub1=^P^B, cud1=^P\\n," "cuf1=^P^F, cup=^P=%p1%'\\s'%+%c%p2%'\\s'%+%c," "dch=^Pd%p1%'\\s'%+%c, dch1=^Pd!, dl=^P^K%p1%'\\s'%+%c," "dl1=^P^K!, ed=^PC, el=^Pc, home=^P=\\s\\s," "ich=^P_%p1%'\\s'%+%c, ich1=^P_!, il=^P^O%p1%'\\s'%+%c," "il1=^P^O!, ind=^P\\n, nel=\\n," ".tif" file-name terminfo create-file-buffer write-file kill-buffer nil "TERMINFO=" "/tmp" process-environment set-process-sentinel start-process "tic" te-tic-sentinel] 7 (#$ . 24456)]) #@49 Create a termcap entry for the virtual terminal (defalias 'te-create-termcap #[nil "ÀÁ\n \f ƒ Æ‚Ç%ÈÉÊËÌÍ°‡" [format "%s:co#%d:li#%d:%s" te-terminal-name te-width te-height terminal-scrolling "" "ns:" "cm=^p=%+ %+ :cr=^p^a:le=^p^b:nd=^p^f:" "nw=^j:ce=^pc:cd=^pC:cl=^p^l:bl=^p^g:" "IC=^p_%+ :DC=^pd%+ :AL=^p^o%+ :DL=^p^k%+ :" "LP:NF:" "ic=^p_!:dc=^pd!:al=^p^o!:dl=^p^k!:ho=^p= :" "im=:ei=:dm=:ed=:mi:do=^p^j:nl=^p^j:bs:"] 7 (#$ . 25322)]) #@43 If tic has finished, delete the .tif file (defalias 'te-tic-sentinel #[(proc state-change) "Áš…\fÂÃ\fÅQ!‡" [state-change "finished\n" delete-file "/tmp/" te-terminal-name ".tif"] 4 (#$ . 25770)]) (provide (quote terminal)) emacs-19.30/lisp/tex-mode.elc100666 13437 1 77265 6046536067 14475 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 20:04:30 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/tex-mode.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`tex-mode.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!‡" [require shell compile] 2) #@74 *If non-nil, the shell file name to run in the subshell used to run TeX. (defvar tex-shell-file-name nil (#$ . -530)) #@242 *Directory in which temporary files are left. You can make this `/tmp' if your TEXINPUTS has no relative directories in it and you don't try to apply \[tex-region] or \[tex-buffer] when there are `\input' commands with relative directories. (defvar tex-directory "." (#$ . -655)) #@75 *If non-nil, ask about saving modified buffers before \[tex-file] is run. (defvar tex-offer-save t (#$ . -941)) #@178 *Command used to run TeX subjob. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end. (defvar tex-run-command "tex" (#$ . -1060)) #@180 *Command used to run LaTeX subjob. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end. (defvar latex-run-command "latex" (#$ . -1288)) #@29 Standard LaTeX block names. (defvar standard-latex-block-names (quote ("abstract" "array" "center" "description" "displaymath" "document" "enumerate" "eqnarray" "eqnarray*" "equation" "figure" "figure*" "flushleft" "flushright" "itemize" "letter" "list" "minipage" "picture" "quotation" "quote" "slide" "sloppypar" "tabbing" "table" "table*" "tabular" "tabular*" "thebibliography" "theindex*" "titlepage" "trivlist" "verbatim" "verbatim*" "verse")) (#$ . 1521)) #@104 *User defined LaTeX block names. Combined with `standard-latex-block-names' for minibuffer completion. (defvar latex-block-names nil (#$ . -1990)) #@181 *Command used to run SliTeX subjob. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end. (defvar slitex-run-command "slitex" (#$ . -2144)) #@210 *Command used by `tex-bibtex-file' to gather bibliographic data. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end. (defvar tex-bibtex-command "bibtex" (#$ . -2381)) #@197 *Command used by \[tex-print] to print a .dvi file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end. (defvar tex-dvi-print-command "lpr -d" (#$ . -2647)) #@547 *Command used by \[tex-print] with a prefix arg to print a .dvi file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end. If two printers are not enough of a choice, you can set the variable `tex-alt-dvi-print-command' to an expression that asks what you want; for example, (setq tex-alt-dvi-print-command '(format "lpr -P%s" (read-string "Use printer: "))) would tell \[tex-print] with a prefix argument to ask you which printer to use. (defvar tex-alt-dvi-print-command "lpr -d" (#$ . -2903)) #@498 *Command used by \[tex-view] to display a `.dvi' file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end. This can be set conditionally so that the previewer used is suitable for the window system being used. For example, (setq tex-dvi-view-command (if (eq window-system 'x) "xdvi" "dvi2tty * | cat -s")) would tell \[tex-view] to use xdvi under X windows and to use dvi2tty otherwise. (defvar tex-dvi-view-command nil (#$ . -3513)) #@124 *Command used by \[tex-show-print-queue] to show the print queue. Should show the queue(s) that \[tex-print] puts jobs on. (defvar tex-show-queue-command "lpq" (#$ . -4064)) #@259 *Mode to enter for a new file that might be either TeX or LaTeX. This variable is used when it can't be determined whether the file is plain TeX or LaTeX or what because the file contains no commands. Normally set to either `plain-tex-mode' or `latex-mode'. (defvar tex-default-mode (quote plain-tex-mode) (#$ . -4245)) #@69 *String inserted by typing \[tex-insert-quote] to open a quotation. (defvar tex-open-quote "``" (#$ . -4571)) #@70 *String inserted by typing \[tex-insert-quote] to close a quotation. (defvar tex-close-quote "''" (#$ . -4687)) #@164 Latest temporary file generated by \[tex-region] and \[tex-buffer]. Deleted when the \[tex-region] or \[tex-buffer] is next run, or when the tex shell terminates. (defvar tex-last-temp-file nil (#$ . 4806)) #@94 Command to run TeX. The name of the file, preceded by a blank, will be added to this string. (defvar tex-command nil (#$ . 5019)) #@73 String appended after the end of a region sent to TeX by \[tex-region]. (defvar tex-trailer nil (#$ . 5155)) #@74 Regular expression used by \[tex-region] to find start of file's header. (defvar tex-start-of-header nil (#$ . 5270)) #@72 Regular expression used by \[tex-region] to find end of file's header. (defvar tex-end-of-header nil (#$ . 5394)) #@131 Command to give to shell running TeX to change directory. The value of `tex-directory' is appended to this, separated by a space. (defvar tex-shell-cd-command "cd" (#$ . 5515)) #@138 Temporary file name used for text being sent as input to TeX. Should be a simple file name with no extension or directory specification. (defvar tex-zap-file nil (#$ . 5699)) #@30 Buffer which was last TeXed. (defvar tex-last-buffer-texed nil (#$ . 5880)) #@91 File name that \[tex-print] prints. Set by \[tex-region], \[tex-buffer], and \[tex-file]. (defvar tex-print-file nil (#$ . 5962)) #@38 Syntax table used while in TeX mode. (defvar tex-mode-syntax-table nil (#$ . 6098)) #@75 Imenu generic expression for LaTex mode. See `imenu-generic-expression'. (defvar latex-imenu-generic-expression (quote (("Part" "\\\\part{\\([^}]*\\)}" 1) ("Chapter" "\\\\chapter{\\([^}]*\\)}" 1) ("Section" "\\\\[a-zA-Z]*section{\\([^}]*\\)}" 1) ("Equations" "%[ ]*\\([0-9]+\\.[0-9]+\\)[,;]?[ ]?" 1))) (#$ . 6188)) #@77 Define the keys that we want defined both in TeX mode and in the TeX shell. (defalias 'tex-define-common-keys #[(keymap) "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍÎÍ!B#ˆÀ ÏÐ#ˆÀ ÑÒ#ˆÀ ÓÔ#ˆÀ ÕÖ#ˆÀ ×Ø#ˆÀ ÙÚ#‡" [define-key keymap " " tex-kill-job "\f" tex-recenter-output-buffer "" tex-show-print-queue "" tex-print "" tex-view [menu-bar tex] "TeX" make-sparse-keymap [menu-bar tex tex-kill-job] ("Tex Kill" . tex-kill-job) [menu-bar tex tex-recenter-output-buffer] ("Tex Recenter" . tex-recenter-output-buffer) [menu-bar tex tex-show-print-queue] ("Show Print Queue" . tex-show-print-queue) [menu-bar tex tex-alt-print] ("Tex Print (alt printer)" . tex-alt-print) [menu-bar tex tex-print] ("Tex Print" . tex-print) [menu-bar tex tex-view] ("Tex View" . tex-view)] 6 (#$ . 6512)]) #@22 Keymap for TeX mode. (defvar tex-mode-map nil (#$ . 7296)) (byte-code "„qÁ Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÃÐÑ#ˆÃÒÓ#ˆÃÔÕ#ˆÃÖ×#ˆÃØÙ#ˆÃÚÛ#ˆÃÜÝ#ˆÃÞß#ˆÃàá#ˆÃâã#ˆÃäå#ˆæÍçè#ˆæéçè#ˆæêçë#ˆæìçí#ˆæîçï#ˆæðçñ#ˆæòçó#‡" [tex-mode-map make-sparse-keymap tex-define-common-keys define-key "\"" tex-insert-quote "\n" tex-terminate-paragraph "}" up-list "{" tex-insert-braces "" tex-region "" tex-buffer "" tex-file " " tex-bibtex-file "" tex-latex-block "" tex-close-latex-block "" tex-goto-last-unclosed-latex-block [menu-bar tex tex-bibtex-file] ("BibTeX File" . tex-bibtex-file) [menu-bar tex tex-validate-region] ("Validate Region" . tex-validate-region) [menu-bar tex validate-tex-buffer] ("Validate Buffer" . validate-tex-buffer) [menu-bar tex tex-region] ("TeX Region" . tex-region) [menu-bar tex tex-buffer] ("TeX Buffer" . tex-buffer) [menu-bar tex tex-file] ("TeX File" . tex-file) put menu-enable mark-active tex-validate-region tex-print (stringp tex-print-file) tex-alt-print (stringp tex-print-file) tex-view (stringp tex-print-file) tex-recenter-output-buffer (get-buffer "*tex-shell*") tex-kill-job (tex-shell-running)] 4) #@75 Keymap for the TeX shell. Inherits `shell-mode-map' with a few additions. (defvar tex-shell-map nil (#$ . 8461)) (byte-code "À BÀ‡" [compare-windows-whitespace current-load-list] 2) #@385 Major mode for editing files of input for TeX, LaTeX, or SliTeX. Tries to determine (by looking at the beginning of the file) whether this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode', `latex-mode', or `slitex-mode', respectively. If it cannot be determined, such as if there are no commands in the file, the value of `tex-default-mode' says which mode to use. (defalias 'tex-mode #[nil "À‰‰ŠebˆÄÅÀÆ#‰ƒ'`ŠÈyˆÄÉÆ#*‰„\n\nƒE „EÊË!ƒCÊÌ!ƒ?Í‚D΂DÏ) ƒO ‚R +‡" [nil comment slash mode search-forward "\\" t search-end 0 "%" looking-at "documentstyle\\|documentclass\\|begin\\b\\|NeedsTeXFormat{LaTeX" "document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}" slitex-mode latex-mode plain-tex-mode tex-default-mode] 4 (#$ . 8651) nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias TeX-mode tex-mode LaTeX-mode latex-mode] 3) #@1652 Major mode for editing files of input for plain TeX. Makes $ and } display the characters they match. Makes " insert `` when it seems to be the beginning of a quotation, and '' when it appears to be the end; it inserts " only after a \. Use \[tex-region] to run TeX on the current region, plus a "header" copied from the top of the file (containing macro definitions, etc.), running TeX under a special subshell. \[tex-buffer] does the whole buffer. \[tex-file] saves the buffer and then processes the file. \[tex-print] prints the .dvi file made by any of these. \[tex-view] previews the .dvi file made by any of these. \[tex-bibtex-file] runs bibtex on the file of the current buffer. Use \[validate-tex-buffer] to check buffer for paragraphs containing mismatched $'s or braces. Special commands: \{tex-mode-map} Mode variables: tex-run-command Command string used by \[tex-region] or \[tex-buffer]. tex-directory Directory in which to create temporary files for TeX jobs run by \[tex-region] or \[tex-buffer]. tex-dvi-print-command Command string used by \[tex-print] to print a .dvi file. tex-alt-dvi-print-command Alternative command string used by \[tex-print] (when given a prefix argument) to print a .dvi file. tex-dvi-view-command Command string used by \[tex-view] to preview a .dvi file. tex-show-queue-command Command string used by \[tex-show-print-queue] to show the print queue that \[tex-print] put your job on. Entering Plain-tex mode runs the hook `text-mode-hook', then the hook `tex-mode-hook', and finally the hook `plain-tex-mode-hook'. When the special subshell is initiated, the hook `tex-shell-hook' is run. (defalias 'plain-tex-mode #[nil "À ˆÁà ÇÉ\nË\fÍÎÏÐ#‡" [tex-common-initialization "TeX" mode-name plain-tex-mode major-mode tex-run-command tex-command "%\\*\\*start of header" tex-start-of-header "%\\*\\*end of header" tex-end-of-header "\\bye\n" tex-trailer run-hooks text-mode-hook tex-mode-hook plain-tex-mode-hook] 4 (#$ . 9507) nil]) (defalias (quote plain-TeX-mode) (quote plain-tex-mode)) #@1621 Major mode for editing files of input for LaTeX. Makes $ and } display the characters they match. Makes " insert `` when it seems to be the beginning of a quotation, and '' when it appears to be the end; it inserts " only after a \. Use \[tex-region] to run LaTeX on the current region, plus the preamble copied from the top of the file (containing \documentstyle, etc.), running LaTeX under a special subshell. \[tex-buffer] does the whole buffer. \[tex-file] saves the buffer and then processes the file. \[tex-print] prints the .dvi file made by any of these. \[tex-view] previews the .dvi file made by any of these. \[tex-bibtex-file] runs bibtex on the file of the current buffer. Use \[validate-tex-buffer] to check buffer for paragraphs containing mismatched $'s or braces. Special commands: \{tex-mode-map} Mode variables: latex-run-command Command string used by \[tex-region] or \[tex-buffer]. tex-directory Directory in which to create temporary files for LaTeX jobs run by \[tex-region] or \[tex-buffer]. tex-dvi-print-command Command string used by \[tex-print] to print a .dvi file. tex-alt-dvi-print-command Alternative command string used by \[tex-print] (when given a prefix argument) to print a .dvi file. tex-dvi-view-command Command string used by \[tex-view] to preview a .dvi file. tex-show-queue-command Command string used by \[tex-show-print-queue] to show the print queue that \[tex-print] put your job on. Entering Latex mode runs the hook `text-mode-hook', then `tex-mode-hook', and finally `latex-mode-hook'. When the special subshell is initiated, `tex-shell-hook' is run. (defalias 'latex-mode #[nil "À ˆÁà ÇÉ\nË\fÍÏÑÒ!ˆÔÕÖ×#‡" [tex-common-initialization "LaTeX" mode-name latex-mode major-mode latex-run-command tex-command "\\\\documentstyle\\|\\\\documentclass" tex-start-of-header "\\\\begin{document}" tex-end-of-header "\\end{document}\n" tex-trailer "[ ]*$\\|[\f%]\\|[ ]*\\$\\$\\|\\\\begin\\>\\|\\\\label\\>\\|\\\\end\\>\\|\\\\\\[\\|\\\\\\]\\|\\\\chapter\\>\\|\\\\section\\>\\|\\\\subsection\\>\\|\\\\subsubsection\\>\\|\\\\paragraph\\>\\|\\\\subparagraph\\>\\|\\\\item\\>\\|\\\\bibitem\\>\\|\\\\newline\\>\\|\\\\noindent\\>\\|\\\\[a-z]*space\\>\\|\\\\[a-z]*skip\\>\\|\\\\newpage\\>\\|\\\\[a-z]*page\\|\\\\footnote\\>\\|\\\\marginpar\\>\\|\\\\parbox\\>\\|\\\\caption\\>" paragraph-start "[ ]*$\\|[\f%]\\|[ ]*\\$\\$[ ]*$\\|\\\\begin\\>\\|\\\\label\\>\\|\\\\end\\>\\|\\\\\\[\\|\\\\\\]\\|\\\\chapter\\>\\|\\\\section\\>\\|\\\\subsection\\>\\|\\\\subsubsection\\>\\|\\\\paragraph\\>\\|\\\\subparagraph\\>\\|\\(\\\\item\\|\\\\bibitem\\|\\\\newline\\|\\\\noindent\\|\\\\[a-z]*space\\|\\\\[a-z]*skip\\|\\\\newpage\\|\\\\[a-z]*page[a-z]*\\|\\\\footnote\\|\\\\marginpar\\|\\\\parbox\\|\\\\caption\\)[ ]*\\($\\|%\\)" paragraph-separate make-local-variable imenu-generic-expression latex-imenu-generic-expression run-hooks text-mode-hook tex-mode-hook latex-mode-hook] 4 (#$ . 11570) nil]) #@1687 Major mode for editing files of input for SliTeX. Makes $ and } display the characters they match. Makes " insert `` when it seems to be the beginning of a quotation, and '' when it appears to be the end; it inserts " only after a \. Use \[tex-region] to run SliTeX on the current region, plus the preamble copied from the top of the file (containing \documentstyle, etc.), running SliTeX under a special subshell. \[tex-buffer] does the whole buffer. \[tex-file] saves the buffer and then processes the file. \[tex-print] prints the .dvi file made by any of these. \[tex-view] previews the .dvi file made by any of these. \[tex-bibtex-file] runs bibtex on the file of the current buffer. Use \[validate-tex-buffer] to check buffer for paragraphs containing mismatched $'s or braces. Special commands: \{tex-mode-map} Mode variables: slitex-run-command Command string used by \[tex-region] or \[tex-buffer]. tex-directory Directory in which to create temporary files for SliTeX jobs run by \[tex-region] or \[tex-buffer]. tex-dvi-print-command Command string used by \[tex-print] to print a .dvi file. tex-alt-dvi-print-command Alternative command string used by \[tex-print] (when given a prefix argument) to print a .dvi file. tex-dvi-view-command Command string used by \[tex-view] to preview a .dvi file. tex-show-queue-command Command string used by \[tex-show-print-queue] to show the print queue that \[tex-print] put your job on. Entering SliTeX mode runs the hook `text-mode-hook', then the hook `tex-mode-hook', then the hook `latex-mode-hook', and finally the hook `slitex-mode-hook'. When the special subshell is initiated, the hook `tex-shell-hook' is run. (defalias 'slitex-mode #[nil "À ˆÁà ÇÉ\nË\fÍÏÑÒÓÔÕ$‡" [tex-common-initialization "SliTeX" mode-name slitex-mode major-mode slitex-run-command tex-command "\\\\documentstyle{slides}\\|\\\\docuentclass{slides}" tex-start-of-header "\\\\begin{document}" tex-end-of-header "\\end{document}\n" tex-trailer "[ ]*$\\|[\f%]\\|[ ]*\\$\\$\\|\\\\begin\\>\\|\\\\label\\>\\|\\\\end\\>\\|\\\\\\[\\|\\\\\\]\\|\\\\chapter\\>\\|\\\\section\\>\\|\\\\subsection\\>\\|\\\\subsubsection\\>\\|\\\\paragraph\\>\\|\\\\subparagraph\\>\\|\\\\item\\>\\|\\\\bibitem\\>\\|\\\\newline\\>\\|\\\\noindent\\>\\|\\\\[a-z]*space\\>\\|\\\\[a-z]*skip\\>\\|\\\\newpage\\>\\|\\\\[a-z]*page\\|\\\\footnote\\>\\|\\\\marginpar\\>\\|\\\\parbox\\>\\|\\\\caption\\>" paragraph-start "[ ]*$\\|[\f%]\\|[ ]*\\$\\$[ ]*$\\|\\\\begin\\>\\|\\\\label\\>\\|\\\\end\\>\\|\\\\\\[\\|\\\\\\]\\|\\\\chapter\\>\\|\\\\section\\>\\|\\\\subsection\\>\\|\\\\subsubsection\\>\\|\\\\paragraph\\>\\|\\\\subparagraph\\>\\|\\\\item[ ]*$\\|\\\\bibitem[ ]*$\\|\\\\newline[ ]*$\\|\\\\noindent[ ]*$\\|\\\\[a-z]*space[ ]*$\\|\\\\[a-z]*skip[ ]*$\\|\\\\newpage[ ]*$\\|\\\\[a-z]*page[a-z]*[ ]*$\\|\\\\footnote[ ]*$\\|\\\\marginpar[ ]*$\\|\\\\parbox[ ]*$\\|\\\\caption[ ]*$" paragraph-separate run-hooks text-mode-hook tex-mode-hook latex-mode-hook slitex-mode-hook] 5 (#$ . 14534) nil]) (defalias 'tex-common-initialization #[nil "À ˆÁ\n!ˆ  „rÆÈ É !ˆÊWƒ-ËÌ\"ˆT‰‚ËÆÍ\"ˆËÎÏ\"ˆËÐÑ\"ˆËÒÑ\"ˆËÓÔ\"ˆËÕÖ\"ˆË×Ø\"ˆËÙÌ\"ˆËÚÌ\"ˆËÛÌ\"ˆËÜÝ\"ˆËÞÏ\"ˆËßÍ\"ˆ)‚vÉ !ˆàá!ˆâ!àã!ˆä#àå!ˆæ%àç!ˆè'àé!ˆê)àë!ˆì+àí!ˆî-àï!ˆàð!ˆàñ!ˆàò!‡" [kill-all-local-variables use-local-map tex-mode-map text-mode-abbrev-table local-abbrev-table tex-mode-syntax-table 0 char make-syntax-table set-syntax-table 32 modify-syntax-entry "." "w" 9 " " 10 ">" 12 36 "$$" 37 "<" 92 "/" 34 38 95 64 "_" 126 39 make-local-variable paragraph-start "[ ]*$\\|[\f\\\\%]\\|[ ]*\\$\\$" paragraph-separate "[ ]*$\\|[\f\\\\%]\\|[ ]*\\$\\$[ ]*$" comment-start "%" comment-start-skip "\\(\\(^\\|[^\\]\\)\\(\\\\\\\\\\)*\\)\\(%+ *\\)" comment-indent-function tex-comment-indent parse-sexp-ignore-comments t compare-windows-whitespace tex-categorize-whitespace tex-command tex-start-of-header tex-end-of-header tex-trailer] 4]) (defalias 'tex-comment-indent #[nil "ÀÁ!ƒi‡ÂÃxˆnƒÄ‚iT ]‡" [looking-at "%%%" " " nil 0 comment-column] 2]) (defalias 'tex-categorize-whitespace #[(backward-limit) "ÀÁÄ xˆ\nƒRÆÇ!ƒ!È•bˆ À=ƒÉ‚ÆÊ!ƒ> Ë=ƒ5Ì͉‚ ËÈ•bˆ‚ÆÎ!ƒLÌ͉‚ ͉„\fÄÍwˆ Ë=ƒ`É‚a *‡" [null t not-finished category " \n\f" backward-limit looking-at "[ ]+" 0 space "\n" newline par nil "\f+"] 3]) #@210 Insert the appropriate quote marks for TeX. Inserts the value of `tex-open-quote' (normally ``) or `tex-close-quote' (normally '') depending on the context. With prefix argument, always inserts " characters. (defalias 'tex-insert-quote #[(arg) "ƒ\nÁÂ!!‡o„ŠÃuˆÄÅ!)ƒ‚*hÇUƒ(È‚* c‡" [arg self-insert-command prefix-numeric-value -1 looking-at "\\s(\\|\\s \\|\\s>" tex-open-quote 92 34 tex-close-quote] 3 (#$ . 18856) "*P"]) #@255 Check current buffer for paragraphs containing mismatched $s. Their positions are recorded in the buffer `*Occur*'. To find a particular invalidity from `*Occur*', switch to to that buffer and type C-c C-c on the line for the invalidity you want to see. (defalias 'validate-tex-buffer #[nil "peÀÄÅÆ!ˆŠqˆÈ ˆ  Ê À\f)ŠdbˆÍ „—o„—`ÏÐÀÑ#ˆÒ`\"„“ŠÓyˆ`)ÀÀÊyˆ` ƒ^ Ö\n`\"Z‚eÖÓ\"T`Š× qˆebˆÓyˆ\fB\fØ #ˆZuˆÙÚ \"cˆ,)‚\")Šqˆ\f„¥Ûcˆt…¯ÜÝ\fG\")‘+‡" [nil linenum prevpos buffer "*Occur*" princ "Mismatches:\n" standard-output occur-mode occur-buffer 0 occur-nlines occur-pos-list input-pending-p end search-backward "\n\n" move tex-validate-region 1 start tem count-lines point-marker insert-buffer-substring format "%3d: " "None!\n" message "%d mismatches found"] 5 (#$ . 19297) nil]) #@144 Check for mismatched braces or $'s in region. Returns t if no mismatches. Returns nil and moves point to suspect area if a mismatch is found. (defalias 'tex-validate-region #[(start end) "À \nZŠÀÅƈ)\fƒ\fbˆÀ‚Ç*‡" [nil end start max-possible-sexps failure-point (byte-code "Œ }ˆbˆÂ S‰WƒÄÅ!ˆ‚)‡" [start end 0 max-possible-sexps forward-sexp 1] 3) ((error (byte-code "`Á‡" [failure-point nil] 1))) t] 3 (#$ . 20125) "r"]) #@153 Insert two newlines, breaking a paragraph for TeX. Check for mismatched braces or $s in paragraph being terminated. A prefix arg inhibits the checking. (defalias 'tex-terminate-paragraph #[(inhibit-validation) "„ŠÁŠÂÃÄÅ#ˆ`)`\")„ÆÇ!ˆÃc‡" [inhibit-validation tex-validate-region search-backward "\n\n" nil move message "Paragraph being closed appears to contain a mismatch"] 5 (#$ . 20568) "*P"]) #@61 Make a pair of braces and be poised to type inside of them. (defalias 'tex-insert-braces #[nil "ÀcˆŠÁc)‡" [123 125] 1 (#$ . 20974) "*"]) #@117 Creates a matching pair of lines `\begin{NAME}' and `\end{NAME}' at point. Puts point on a blank line between them. (defalias 'tex-latex-block #[(name) "iÁ \"cˆjˆŠÄcˆjˆÅÁÆ \"!ˆm…Äc*‡" [col format "\\begin{%s}\n" name 10 insert-string "\\end{%s}"] 4 (#$ . 21118) (byte-code "À ˆÁÂÃÄÅ\"\"\"C‡" [barf-if-buffer-read-only completing-read "LaTeX block name: " mapcar list append standard-latex-block-names latex-block-names] 7)]) #@73 Leave point at the beginning of the last `\begin{...}' that is unended. (defalias 'tex-last-unended-begin #[nil "ÀÁ!…ÂÃ!…Ä ˆ‚‡" [re-search-backward "\\(\\\\begin\\s *{\\)\\|\\(\\\\end\\s *{\\)" looking-at "\\\\end{" tex-last-unended-begin] 2 (#$ . 21559)]) #@81 Move point to the last unclosed \begin{...}. Mark is left at original location. (defalias 'tex-goto-last-unclosed-latex-block #[nil "ÀŠÀÂÈ`)Ä ˆ b)‡" [nil spot (tex-last-unended-begin) ((error (error "Couldn't find unended \\begin"))) push-mark] 3 (#$ . 21828) nil]) #@62 Creates an \end{...} to match the last unclosed \begin{...}. (defalias 'tex-close-latex-block #[nil "nÀ‰ŠÀÄňiÆÇ!ˆÈ”È•{) jˆÉ\n±ˆ …'Êc+‡" [nil indentation text new-line-needed (tex-last-unended-begin) ((error (error "Couldn't find unended \\begin"))) re-search-forward "\\\\begin\\(\\s *{[^}\n]*}\\)" 1 "\\end" 10] 3 (#$ . 22104) "*"]) #@528 Parse the current buffer as error messages. This makes a list of error descriptors, compilation-error-list. For each source-file, line-number pair in the buffer, the source file is read in, and the text location is saved in compilation-error-list. The function `next-error', assigned to \[next-error], takes the next error off the list and visits its location. This function works on TeX compilations only. It is necessary for that purpose, since TeX does not put file names on the same line as line numbers for the errors. (defalias 'tex-compilation-parse-errors #[nil "ÀÂÃ!ˆÄÅÆ\"ˆÄÇÆ\"ˆÄÈÆ\"ˆÄÉÆ\"ˆÀ‰‰\n \f bˆoƒ.ÎyˆÏÐÀÑ#ƒÎÀ‰‰‰Öyˆ`Î\\bˆ×p!ØcˆÙ ˆÀuˆÚ ‰ šƒk\nU„ÇÛÀxˆÜ ˆÝ ˆÞß!ˆà  š„˜á‰ !…“â!\fÖ\n\fƒÇŠ\fqˆ\nÖUƒ¯ßbˆß\n\nZyˆ\nà D B)ßyˆ,‚.d +Âã!ˆ Ÿ‰‡" [nil compilation-error-list message "Parsing error messages..." modify-syntax-entry 123 "_" 125 91 93 last-linenum last-filename text-buffer compilation-parsing-end 2 re-search-forward "^l.[0-9]+ " t text-marker error-marker filename linenum 0 read 41 backward-sexp current-word "^(" backward-char forward-sexp backward-delete-char 1 point-marker file-exists-p find-file-noselect "Parsing error messages...done"] 5 (#$ . 22454)]) (defalias 'tex-start-shell #[nil "ŠÀÁ\n†ÃÄ!†ÃÅ!†ÆÇ#qˆÈÁ! Ê Ë\"ˆÌ !ˆ Ï ¤Ò!ˆÓ!ˆÔÕ!ˆÖ ×U…OØÙ!ˆ‚A*‡" [make-comint "tex-shell" tex-shell-file-name getenv "ESHELL" "SHELL" "/bin/sh" nil get-process proc set-process-sentinel tex-shell-sentinel process-kill-without-query shell-prompt-pattern comint-prompt-regexp make-sparse-keymap shell-mode-map tex-shell-map tex-define-common-keys use-local-map run-hooks tex-shell-hook buffer-size 0 sleep-for 1] 4]) #@48 Make the TeX shell buffer visible in a window. (defalias 'tex-display-shell #[nil "ÀÁÂÃ!!!ˆÄÅ!‡" [display-buffer process-buffer get-process "tex-shell" tex-recenter-output-buffer nil] 4 (#$ . 24170)]) (defalias 'tex-shell-sentinel #[(proc msg) "ÀÁ\n!!„Ã\nÄ\"ˆÅ ‡Æ\n!Ç>…Å ‡" [buffer-name process-buffer proc set-process-buffer nil tex-delete-last-temp-files process-status (signal exit)] 3]) #@49 Set BUFFER's default directory to be DIRECTORY. (defalias 'tex-set-buffer-directory #[(buffer directory) "ÀÁ\n!!Ã\n!„ÄÅ\n\"‡Šqˆ\n‰)‡" [file-name-as-directory expand-file-name directory file-directory-p error "%s is not a directory" buffer default-directory] 3 (#$ . 24571)]) (byte-code "ÀÁ!„ÂÁ BÄÁ!‡" [boundp tex-send-command-modified-tick 0 current-load-list make-variable-buffer-local] 2) #@324 Send COMMAND to TeX shell process, substituting optional FILE for *. Do this in background if optional BACKGROUND is t. If COMMAND has no *, FILE will be appended, preceded by a blank, to COMMAND. If FILE is nil, no substitution will be made in COMMAND. COMMAND can be any expression that evaluates to a command string. (defalias 'tex-send-command #[(command &optional file background) "ŠÀ !ÃÄ!†ÅÆ!È! ÊË\n\"\f ƒ?\fƒ7\nÎ\fO \n\fTÏOQ‚@\nÐ Q‚@\nƒIÒ‚JÓP qˆÕ !Uƒ`×!ˆØ!bˆcˆÙ ˆÕ !‰.‡" [eval command cmd get-process "tex-shell" error "No TeX subprocess" proc process-buffer buf string-match "\\*" star file 0 nil " " background "&" "" string buffer-modified-tick tex-send-command-modified-tick accept-process-output process-mark comint-send-input] 5 (#$ . 24980)]) #@89 Delete any junk files from last temp file. If NOT-ALL is non-nil, save the `.dvi' file. (defalias 'tex-delete-last-temp-files #[(&optional not-all) "…FÁ!Ã\n!…ÄÅ!\n\"‰…Eƒ3ÈÉ@\"„;Ê\n@P!ˆ‚;Ê\n@P!ˆA‰„Ë*‡" [tex-last-temp-file file-name-directory dir file-directory-p file-name-all-completions file-name-nondirectory list not-all string-match "\\.dvi$" delete-file nil] 4 (#$ . 25786)]) (add-hook (quote kill-emacs-hook) (quote tex-delete-last-temp-files)) #@568 Run TeX on the current region, via a temporary file. The file's name comes from the variable `tex-zap-file' and the variable `tex-directory' says where to put it. If the buffer has a header, the header is given to TeX before the region itself. The buffer's header is all lines between the strings defined by `tex-start-of-header' and `tex-end-of-header' inclusive. The header must start in the first 100 lines of the buffer. The value of `tex-trailer' is given to TeX as input after the region. The value of `tex-command' specifies the command to use to run TeX. (defalias 'tex-region #[(beg end) "À ƒ Á ˆ‚ ˆ „Ä ÅÆ!ÈÉ\n!!‰ P\fp =„2ÎÏ!ˆŠŒ~ˆebˆÐyˆ`ee ebˆÕÏ#ƒq×yˆ`ÕÙÏ#ƒnÚyˆ`‚qeÛ^\fÝPÙ‰%ˆÛ]\fÝPÏÙ%ˆ, qˆá ˆâã!ˆ ƒ«â !ˆä \"ˆÛed\fÝPÏÙ%ˆ+\f%æ' \"ˆæ(\f\"ˆé ˆ\f*p‰ +‡" [tex-shell-running tex-kill-job tex-start-shell tex-zap-file tex-generate-zap-file-name get-buffer-create " TeX-Output-Buffer" temp-buffer file-name-as-directory expand-file-name tex-directory zap-directory tex-out-file tex-last-buffer-texed tex-delete-last-temp-files t 100 default-directory hend hbeg search-end re-search-forward tex-start-of-header 0 tex-end-of-header nil 1 write-region beg ".tex" end tex-trailer local-tex-trailer erase-buffer insert-string "\n" tex-set-buffer-directory tex-last-temp-file tex-send-command tex-shell-cd-command tex-command tex-display-shell tex-print-file] 7 (#$ . 26271) "r"]) #@180 Run TeX on current buffer. See \[tex-region] for more information. Does not save the buffer, so it's useful for trying experimental versions. See \[tex-file] for an alternative. (defalias 'tex-buffer #[nil "Àed\"‡" [tex-region] 3 (#$ . 27731) nil]) #@190 Prompt to save all buffers and run TeX (or LaTeX) on current buffer's file. This function is more useful than \[tex-buffer] when you need the `.aux' file of LaTeX to have the correct name. (defalias 'tex-file #[nil "À ƒ\fÁÀ !‚ÂÃ!ÄÀ !ƒÈ ˆÉ ƒ)Ê ˆ‚,Ë ˆÌ \"ˆÌ\"ˆ*Ï ˆpÀ ‰‡" [buffer-file-name file-name-nondirectory error "Buffer does not seem to be associated with any file" file-name-directory file-dir tex-out-file tex-offer-save save-some-buffers tex-shell-running tex-kill-job tex-start-shell tex-send-command tex-shell-cd-command tex-command tex-display-shell tex-last-buffer-texed tex-print-file] 3 (#$ . 27988) nil]) #@57 Generate a unique name suitable for use as a file name. (defalias 'tex-generate-zap-file-name #[nil "ÀÁÂÃÄ!!ÅÆ !#‡" [format "#tz%d%s" process-id get-buffer-process "*tex-shell*" tex-strip-dots system-name] 5 (#$ . 28635)]) (defalias 'tex-strip-dots #[(s) "À !Âà \"ƒ Ä”ÅIˆ‚ ‡" [copy-sequence s string-match "\\." 0 45] 3]) (defalias 'tex-expand-files #[(s) "ÀÁÄÅ\n#ƒ\nÁ”O BÁ•‚\nÁU„*\nÀO BÇÈ ŸÅ#*‡" [nil 0 start elts string-match ":" s mapconcat expand-file-name] 4]) (defalias 'tex-shell-running #[nil "ÀÁ!… ÂÀÁ!!Ã=‡" [get-process "tex-shell" process-status run] 3]) #@37 Kill the currently running TeX job. (defalias 'tex-kill-job #[nil "ÀÁÂ!Ã\"‡" [quit-process get-process "tex-shell" t] 3 (#$ . 29229) nil]) #@173 Redisplay buffer of TeX job output so that most recent output can be seen. The last line of the buffer is displayed on line LINE of the window, or centered if LINE is nil. (defalias 'tex-recenter-output-buffer #[(linenum) "ÀÁ!p‰„ÄÅ!‚1Æ !ˆÇ !ˆdbˆÈ ƒ(Ê !‚,Ë Ì¥!ˆÆ\n!*‡" [get-buffer "*tex-shell*" old-buffer tex-shell message "No TeX output buffer" pop-to-buffer bury-buffer recenter linenum prefix-numeric-value window-height 2] 4 (#$ . 29375) "P"]) #@224 Print the .dvi file made by \[tex-region], \[tex-buffer] or \[tex-file]. Runs the shell command defined by `tex-dvi-print-command'. If prefix argument is provided, use the alternative command, `tex-alt-dvi-print-command'. (defalias 'tex-print #[(&optional alt) "À Â\"Ãpš„#Ç ƒ#ÈÀÇ Â\"‰Ç \"ƒ#\fÉ !„/ÊË!‚?Ì ƒ:‚< Ð#*‡" [tex-append tex-print-file ".dvi" nil test-name print-file-name-dvi tex-last-buffer-texed buffer-file-name file-newer-than-file-p file-exists-p error "No appropriate `.dvi' file could be found" tex-send-command alt tex-alt-dvi-print-command tex-dvi-print-command t] 4 (#$ . 29839) "P"]) #@137 Print the .dvi file made by \[tex-region], \[tex-buffer] or \[tex-file]. Runs the shell command defined by `tex-alt-dvi-print-command'. (defalias 'tex-alt-print #[nil "ÀÁ!‡" [tex-print t] 2 (#$ . 30467) nil]) #@333 Preview the last `.dvi' file made by running TeX under Emacs. This means, made using \[tex-region], \[tex-buffer] or \[tex-file]. The variable `tex-dvi-view-command' specifies the shell command for preview. You must set that variable yourself before using this command, because there is no standard value that would generally work. (defalias 'tex-view #[nil "„ÁÂ!ˆÄ )‡" [tex-dvi-view-command error "You must set `tex-dvi-view-command'" tex-dvi-print-command tex-print] 2 (#$ . 30683) nil]) #@221 Append to FILENAME the suffix SUFFIX, using same algorithm TeX uses. Pascal-based TeX scans for the first period, C TeX uses the last. No period is retained immediately before SUFFIX, so normally SUFFIX starts with one. (defalias 'tex-append #[(file-name suffix) ";ƒ:Á!ÂÅ!\fÆÇÈ\f\"O QÊ !„'Ê ËP!ƒ+ ‚8Å!\fÆÇÌ\f\"O Q*‡Í‡" [file-name file-name-nondirectory nil trial-name file file-name-directory 0 string-match "\\.[^.]*$" suffix file-exists-p ".aux" "\\." " "] 6 (#$ . 31185)]) #@117 Show the print queue that \[tex-print] put your job on. Runs the shell command defined by `tex-show-queue-command'. (defalias 'tex-show-print-queue #[nil "À ƒ Á ˆ‚ ˆÃ\f!ˆÅ ‡" [tex-shell-running tex-kill-job tex-start-shell tex-send-command tex-show-queue-command tex-display-shell] 2 (#$ . 31681) nil]) #@42 Run BibTeX on the current buffer's file. (defalias 'tex-bibtex-file #[nil "À ƒ Á ˆ‚ ˆÃÄÅ !Æ\"ÇÅ ! Ê \"ˆÊ\f \"ˆ*Í ‡" [tex-shell-running tex-kill-job tex-start-shell tex-append file-name-nondirectory buffer-file-name "" file-name-directory file-dir tex-out-file tex-send-command tex-shell-cd-command tex-bibtex-command tex-display-shell] 3 (#$ . 31994) nil]) (byte-code "ÀÁ!ˆÂÃ!‡" [run-hooks tex-mode-load-hook provide tex-mode] 2) emacs-19.30/lisp/texinfmt.elc100666 12120 1 145657 6045214620 14461 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:28:24 1995 ;;; from file /home/fsf/rms/e19/lisp/texinfmt.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`texinfmt.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!„ÂÁ BÄÅ!ˆÄÆ!ˆÀÇ!„ÈÇ BÉ BÊ BË BÌ BÍ BÎ BÏ BÐ BÑ BÒ BÓ BÔ BÕ BÖ B× BØ BÙ BÚ BÛ BÜ BÝ BÞ Bß Bà B„×á âãä#ˆâåä#ˆâæç#ˆâèç#ˆâéê#ˆâëê#ˆâìê#ˆâíê#ˆâîï#ˆâðñ#ˆâòê#ˆÈ‡" [boundp texinfmt-version "2.32 of 19 November 1993" current-load-list require texinfo texnfo-upd texinfo-format-syntax-table nil texinfo-vindex texinfo-findex texinfo-cindex texinfo-pindex texinfo-tindex texinfo-kindex texinfo-last-node texinfo-node-names texinfo-enclosure-list texinfo-alias-list texinfo-command-start texinfo-command-end texinfo-command-name texinfo-defun-type texinfo-last-node-pos texinfo-stack texinfo-short-index-cmds-alist texinfo-short-index-format-cmds-alist texinfo-format-filename texinfo-footnote-number texinfo-start-of-header texinfo-end-of-header texinfo-raisesections-alist texinfo-lowersections-alist make-syntax-table modify-syntax-entry 34 " " 92 64 "\\" 17 91 "." 93 40 41 123 "(}" 125 "){" 39] 4) #@345 Process the current buffer as texinfo code, into an Info file. The Info file output is generated in a buffer visiting the Info file names specified in the @setfilename command. Non-nil argument (prefix, if interactive) means don't make tag table and don't split the file if large. You can use Info-tagify and Info-split to do these manually. (defalias 'texinfo-format-buffer #[(&optional notagify) "À !ˆÃ ˆ\f„-Å ÆVƒÂlj!ˆÈ ˆÅ ÉVƒ-Âʉ!ˆË ˆÂ tƒ7Ì‚8ÍP!)‡" ["Formatting Info file..." lastmessage message texinfo-format-buffer-1 notagify buffer-size 30000 "Making tags table for Info file..." Info-tagify 100000 "Splitting Info file..." Info-split "done. Now save it." "done."] 3 (#$ . 1443) "P"]) #@65 *Name of the temporary buffer used by \[texinfo-format-region]. (defvar texinfo-region-buffer-name "*Info Region*" (#$ . -2154)) #@252 Convert the current region of the Texinfo file to Info format. This lets you see what that part of the file will look like in Info. The command is bound to \[texinfo-format-region]. The text that is converted to Info is stored in a temporary buffer. (defalias 'texinfo-format-region #[(region-beginning region-end) "ÀÁ!ˆÂ‰‰‰‰‰‰‰‰‰Ã‰‰‰Ä pÃlj \n \f ŠŒ~ˆebˆŠßyˆ`) á\" ã#Çyˆ` ƒxá$Âã#Äyˆ`„ebˆáå ã#Äyˆ` Çyˆ`ƒš &^{\n+çè)!!ˆê ˆ\ncˆë\f&],#ˆhíU„¾îcˆebˆï ˆÀÁ!ˆ ð1!ˆòóÂã#ƒ\"` ô P5öó!ˆ`ŠÇyˆ`)|ˆÀ÷5\"ˆŠŒ``ø5!A@\\}ˆebˆòùŠßyˆ`)ã#ƒÄyˆ`ŠÇyˆ`)|ˆ+‚Ðebˆú ˆebˆû ˆdbˆöüÂã#ƒ=`d|ˆhíU„FîcˆÂ=Â>ebˆÿ@!ƒ``ŠÇyˆ`)|ˆebˆáåŠßyˆ`)ã#ƒŸ`Äyˆ`A BC)D±ˆEFB!!cˆGcˆ)‚ªC)H±ˆIJK\f!ƒÑLMEK\f!!!NQ‚ÞOP\f!NQQRS±ˆebˆT ˆebˆÀU!.‡" [message "Converting region to Info format..." nil "" 0 fill-column default-directory 1 header-end header-beginning header-text input-directory input-buffer fill-column-for-info last-input-buffer texinfo-footnote-number texinfo-node-names texinfo-last-node texinfo-last-node-pos texinfo-example-start texinfo-format-filename texinfo-stack texinfo-kindex texinfo-tindex texinfo-pindex texinfo-cindex texinfo-findex texinfo-vindex texinfo-command-name texinfo-command-end texinfo-command-start 100 search-end search-forward tex-start-of-header t tex-end-of-header "@setfilename" region-beginning switch-to-buffer get-buffer-create texinfo-region-buffer-name erase-buffer insert-buffer-substring region-end 10 "\n" texinfo-mode set-syntax-table texinfo-format-syntax-table re-search-forward "^@include" texinfo-parse-line-arg filename re-search-backward "Reading included file: %s" insert-file-contents "^@setfilename" texinfo-raise-lower-sections texinfo-append-refill "^@bye" texinfo-enclosure-list texinfo-alias-list looking-at "\\\\input[ ]+texinfo" texinfo-parse-arg-discard arg " " " buffer for: `" file-name-nondirectory expand-file-name "', -*-Text-*-\n" " buffer -*-Text-*-\n" "produced by `texinfo-format-region'\n" "from a region in: " buffer-file-name "`" file-name-sans-versions "'" "buffer `" buffer-name "\nusing `texinfmt.el' version " texinfmt-version ".\n\n" texinfo-format-scan "Done."] 23 (#$ . 2290) "r"]) (defalias 'texinfo-format-buffer-1 #[nil "À‰‰‰‰‰‰‰‰‰‰‰‰‰‰ÁÀ‰\np  \n \f ÀÀŠebˆÛÜÀÝ#„SÞß!ˆ`à )á!ˆâ ˆã$!ˆå ˆæ !ˆçèé !\"ˆebˆêëÀÝ#ƒÍ`\fà P,íë!ˆ`Šîyˆ`)|ˆçï,\"ˆŠŒ``ð,!A@\\}ˆebˆêñŠòyˆ`)Ý#ƒÉÁyˆ`Šîyˆ`)|ˆ+‚|ebˆó ˆebˆô ˆebˆÛÜ!ˆÁyˆe`|ˆdbˆõöÀÝ#ƒö`d|ˆh÷U„ÿøcˆù ˆebˆ \f¯.‡" [nil 0 fill-column default-directory input-directory input-buffer fill-column-for-info outfile last-input-buffer texinfo-footnote-number texinfo-node-names texinfo-stack texinfo-kindex texinfo-tindex texinfo-pindex texinfo-cindex texinfo-findex texinfo-vindex texinfo-last-node-pos texinfo-last-node texinfo-command-name texinfo-command-end texinfo-command-start texinfo-example-start texinfo-format-filename texinfo-enclosure-list texinfo-alias-list search-forward "@setfilename" t error "Texinfo file needs an `@setfilename FILENAME' line." texinfo-parse-line-arg find-file texinfo-mode set-syntax-table texinfo-format-syntax-table erase-buffer insert-buffer-substring message "Converting %s to Info format..." buffer-name re-search-forward "^@include" filename re-search-backward 1 "Reading included file: %s" insert-file-contents "^@setfilename" 100 texinfo-raise-lower-sections texinfo-append-refill search-backward "@bye" 10 "\n" texinfo-format-scan] 21]) (defalias 'texinfo-format-convert #[(min max) "bˆÁ Ä#ƒÅÆ!ˆ‚bˆÁÇ Ä#ƒ$ÅÆ!ˆ‚bˆÈÉ Ä#…;Ê”TÊ”Ê\\|ˆ‚'‡" [min search-forward "``" max t replace-match "\"" "''" re-search-forward "\\( \\|\\w\\)\\(---\\)\\( \\|\\w\\)" 2] 4]) #@68 Regexp specifying environments in which paragraphs are not filled. (defvar texinfo-no-refill-regexp "^@\\(example\\|smallexample\\|lisp\\|smalllisp\\|display\\|format\\|flushleft\\|flushright\\|menu\\|titlepage\\|iftex\\|ifhtml\\|tex\\|html\\)" (#$ . 6112)) #@55 Regexp specifying @-commands found within paragraphs. (defvar texinfo-part-of-para-regexp "^@\\(b{\\|bullet{\\|cite{\\|code{\\|emph{\\|equiv{\\|error{\\|expansion{\\|file{\\|i{\\|inforef{\\|kbd{\\|key{\\|lisp{\\|minus{\\|point{\\|print{\\|pxref{\\|r{\\|ref{\\|result{\\|samp{\\|sc{\\|t{\\|TeX{\\|today{\\|var{\\|w{\\|xref{\\)" (#$ . 6376)) #@207 Append @refill at end of each paragraph that should be filled. Do not append @refill to paragraphs within @example and similar environments. Do not append @refill to paragraphs containing @w{TEXT} or @*. (defalias 'texinfo-append-refill #[nil "`dW…ÀÁÄyˆÅÆ P!ƒ/ÅÇÉ\nË°!„/`dWƒ/Ìyˆ‚ Å!ƒM̔̕{ ÎÏ PÁÐ#ˆÌyˆ)‚Œ`dY„`ÎÑŠÒ ˆ`)Ð#ƒfÒ ˆ‚ŒÒ ˆÓyˆÁˆ`ŠÔÁxˆ`)|ˆÕÖŠÄyˆ`)Ð#„‰×cˆÌyˆ*‚‡" ["^[ \n]*$" nil case-fold-search refill-blank-lines 0 looking-at "^@\\|^\\\\\\|" "\\(" texinfo-no-refill-regexp "\\|" texinfo-part-of-para-regexp "\\)" 1 environment re-search-forward "^@end " t "@w{\\|@\\*" forward-paragraph -1 " " re-search-backward "@refill\\|@bye" "@refill"] 6 (#$ . 6723)]) #@1279 Raise or lower the hierarchical level of chapters, sections, etc. This function acts according to `@raisesections' and `@lowersections' commands in the Texinfo file. For example, an `@lowersections' command is useful if you wish to include what is written as an outer or standalone Texinfo file in another Texinfo file as an inner, included file. The `@lowersections' command changes chapters to sections, sections to subsections and so on. @raisesections changes @subsection to @section, @section to @chapter, @heading to @chapheading, etc. @lowersections changes @chapter to @section, @subsection to @subsubsection, @heading to @subheading, etc. An `@raisesections' or `@lowersections' command changes only those structuring commands that follow the `@raisesections' or `@lowersections' command. An `@lowersections' command cancels an `@raisesections' command, and vice versa. Repeated use of the commands continue to raise or lower the hierarchical level a step at a time. An attempt to raise above `chapters' reproduces chapter commands; an attempt to lower below subsubsections reproduces subsubsection commands. (defalias 'texinfo-raise-lower-sections #[nil "ÀÁÄÅÇQÀÈ#…±ÁyˆŠÉp!) Ê=ƒ.\nT`ŠËyˆ`)|ˆ‚ Ì=ƒC\nS`ŠËyˆ`)|ˆ‚\nÁVƒt\n  ‰ÁVƒf žA S‰‚PÐË!ˆÑ !cˆ*‚\nÁUƒ€Ëyˆ‚\nÁWƒ\n  ‰ÁWƒ£ žA T‰‚ÐË!ˆÑ !cˆ*‚*‡" [nil 0 level type re-search-forward "\\(\\(^@\\(raise\\|lower\\)sections\\)\\|\\(" texinfo-section-types-regexp "\\)\\)" t read @raisesections 1 @lowersections new-level count texinfo-raisesections-alist kill-word symbol-name texinfo-lowersections-alist] 5 (#$ . 7423)]) #@241 *An alist of next higher levels for chapters, sections. etc. For example, section to chapter, subsection to section. Used by `texinfo-raise-lower-sections'. The keys specify types of section; the values correspond to the next higher types. (defvar texinfo-raisesections-alist (quote ((@chapter . @chapter) (@unnumbered . @unnumbered) (@majorheading . @majorheading) (@chapheading . @chapheading) (@appendix . @appendix) (@section . @chapter) (@unnumberedsec . @unnumbered) (@heading . @chapheading) (@appendixsec . @appendix) (@subsection . @section) (@unnumberedsubsec . @unnumberedsec) (@subheading . @heading) (@appendixsubsec . @appendixsec) (@subsubsection . @subsection) (@unnumberedsubsubsec . @unnumberedsubsec) (@subsubheading . @subheading) (@appendixsubsubsec . @appendixsubsec))) (#$ . -9214)) #@239 *An alist of next lower levels for chapters, sections. etc. For example, chapter to section, section to subsection. Used by `texinfo-raise-lower-sections'. The keys specify types of section; the values correspond to the next lower types. (defvar texinfo-lowersections-alist (quote ((@chapter . @section) (@unnumbered . @unnumberedsec) (@majorheading . @heading) (@chapheading . @heading) (@appendix . @appendixsec) (@section . @subsection) (@unnumberedsec . @unnumberedsubsec) (@heading . @subheading) (@appendixsec . @appendixsubsec) (@subsection . @subsubsection) (@unnumberedsubsec . @unnumberedsubsubsec) (@subheading . @subsubheading) (@appendixsubsec . @appendixsubsubsec) (@subsubsection . @subsubsection) (@unnumberedsubsubsec . @unnumberedsubsubsec) (@subsubheading . @subsubheading) (@appendixsubsubsec . @appendixsubsubsec))) (#$ . -10027)) (defalias 'texinfo-format-scan #[nil "Àed\"ˆebˆÁÂÃÄ#ƒ³ÅÆ!ƒ8gÇUƒ.`S`T|ˆgÈU„Ècˆ‚ÉÊ!ˆËuˆ‚`S\fgzÍUƒIËvˆ‚LËuˆ`Ã\fT{Ñ\"‰ƒnA‚ZÓ!*ÑÕ!\"‰ƒšA@@Ø A@A@±ˆ\fbˆ‚¯ÙN‰ƒ« ˆ‚®Û ˆ))‚…ÆÝ@8bˆÞß@@\"‡" [texinfo-format-convert search-forward "@" nil t looking-at "[@{}^'` *\"?!]" 42 10 delete-char -1 1 texinfo-command-start 119 texinfo-command-end cmdname trial assoc texinfo-alias-list intern texinfo-command-name symbol-name texinfo-enclosure-list enclosure-type texinfo-parse-arg-discard texinfo-format cmd texinfo-unsupported texinfo-stack 2 error "Unterminated @%s"] 5]) (put (quote begin) (quote texinfo-format) (quote texinfo-format-begin)) (defalias 'texinfo-format-begin #[nil "ÀÁ!‡" [texinfo-format-begin-end texinfo-format] 2]) (put (quote end) (quote texinfo-format) (quote texinfo-format-end)) (defalias 'texinfo-format-end #[nil "ÀÁ!‡" [texinfo-format-begin-end texinfo-end] 2]) (defalias 'texinfo-format-begin-end #[(prop) "ÀÁ !‰ N‰ƒ\f ‚Å )‡" [intern texinfo-parse-line-arg texinfo-command-name prop cmd texinfo-unsupported] 3]) (defalias 'texinfo-parse-line-arg #[nil "bˆ`ÂÃ!ƒ%ÃÄwˆ`ĈÃÄxˆ`Ĉ`|ˆ`T‚>ÂÅ!ƒ:`TÆÇ!ˆ`Èuˆ‚>ÉÊ!ˆ `{lƒHÇuˆ)‡" [texinfo-command-end start looking-at " " nil "{" forward-list 1 -1 error "Invalid texinfo command arg format"] 2]) (defalias 'texinfo-parse-expanded-arg #[nil "bˆ`ÁÄÅ!ƒÅÁwˆ`Áˆ`T‚5ÄÆ!ƒ1`TÇÈ!ˆ`Éuˆ‚5ÊË!ˆÌ Á“Í `\"ˆÎ\n!\nÁ‰“ˆ `{lƒSÈuˆ*‡" [texinfo-command-end nil marker start looking-at " " "{" forward-list 1 -1 error "Invalid texinfo command arg format" make-marker texinfo-format-expand-region marker-position] 3]) (defalias 'texinfo-format-expand-region #[(start end) "Œ }ˆÂ‰‰‰Ç ˆ,db)‡" [start end nil texinfo-stack texinfo-command-name texinfo-command-end texinfo-command-start texinfo-format-scan] 4]) (defalias 'texinfo-parse-arg-discard #[nil "À Á ˆ‡" [texinfo-parse-line-arg texinfo-discard-command] 2]) (defalias 'texinfo-discard-command #[nil " |‡" [texinfo-command-start texinfo-command-end] 2]) #@43 Discard braces following command, if any. (defalias 'texinfo-optional-braces-discard #[nil "bˆ`ÂÃ!„ÂÄ!ƒÅÆ!ˆ`‚ÇÈ!ˆ |)‡" [texinfo-command-end start looking-at "[ ]*\n" "{" forward-list 1 error "Invalid `texinfo-optional-braces-discard' format (need braces?)" texinfo-command-start] 2 (#$ . 12924)]) (defalias 'texinfo-format-parse-line-args #[nil "`SÀ‰‰‰ÆÀwˆl„A`ÇÈ!ˆ`nƒ\"\fSÉuˆÆÀxˆ`‰ V…4 \n{ B\fbˆÆÀwˆ‚lƒHÊuˆ` Ÿ-‡" [nil args end beg next start " " re-search-forward "[\n,]" -1 1 texinfo-command-end] 6]) (defalias 'texinfo-format-parse-args #[nil "`SÀ‰‰‰ÆÇ!ˆŠÈ`ŠÉÊ!ˆ`S)\"ˆ)hËU„bÌÀwˆ`ÍÎ!ˆ`ÏuˆÌÀxˆ` \nWƒP bˆÆÐ\nÑ#ƒPÒÓ!ˆ‚A\n V…Y \n{ B\fbˆ‚lƒiÊuˆ` Ÿ-‡" [nil args end beg next start search-forward "{" texinfo-format-expand-region up-list 1 125 " \n" re-search-forward "[},]" -1 "\n" t replace-match " " texinfo-command-end] 5]) (defalias 'texinfo-format-parse-defun-args #[nil "bˆ`ˆ`Tà “Å `\"ˆÆ\f!\f‰“ˆ) bˆÂ‰‰ ÊÂwˆl„gËÌ!ƒI`TÍÎ!ˆ`S‚V`ÏÐ!ˆÑuˆ`{ B ÊÂwˆ‚0Îuˆ Ÿ,‡" [texinfo-command-end start nil make-marker marker texinfo-format-expand-region marker-position end beg args " " looking-at "{" forward-list 1 re-search-forward "[\n ]" -1] 3]) (defalias 'texinfo-discard-line #[nil "bˆÁÂwˆl„ÃÄ!ˆ bˆn„ÃÆ!ˆ`Çyˆ`|‡" [texinfo-command-end " " nil error "Extraneous text at end of command line." texinfo-command-start "Extraneous text at beginning of command line." 1] 2]) (defalias 'texinfo-discard-line-with-args #[nil "bˆ`Áyˆ`|‡" [texinfo-command-start 1] 2]) (put (quote setfilename) (quote texinfo-format) (quote texinfo-format-setfilename)) (defalias 'texinfo-format-setfilename #[nil "À Âà \"ˆÄÅ !!ÇÈÉÊË\f!ƒ*ÍÎÄË\f!!!ÏQ‚1ÐÑ\f!ÏQÒÔ± )‡" [texinfo-parse-arg-discard arg message "Formatting Info file: %s" file-name-nondirectory expand-file-name texinfo-format-filename "Info file: " ", -*-Text-*-\n" "produced by `texinfo-format-buffer'\n" "from file" buffer-file-name input-buffer " `" file-name-sans-versions "'" "buffer `" buffer-name "\nusing `texinfmt.el' version " texinfmt-version ".\n\n"] 10]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put node texinfo-format texinfo-format-node nwnode] 4) (defalias 'texinfo-format-node #[nil "À ‰@ A@Ä 8Æ 8È ˆ\n \n—\nË\n\f\"ƒ.ÍÎ\n\"ˆ‚6\nC\fB\f)ÏÑÓ\n±ˆ ƒKÔ ±ˆ ƒTÕ ±ˆƒ_Ö±ˆ×cˆ`‰-‡" [texinfo-format-parse-line-args args name next 2 prev 3 up texinfo-discard-command texinfo-last-node tem assoc texinfo-node-names error "Duplicate node name: %s" 0 texinfo-footnote-number "\n\nFile: " texinfo-format-filename ", Node: " ", Next: " ", Prev: " ", Up: " 10 texinfo-last-node-pos] 5]) (put (quote menu) (quote texinfo-format) (quote texinfo-format-menu)) (defalias 'texinfo-format-menu #[nil "À ˆÁc‡" [texinfo-discard-line "* Menu:\n\n"] 1]) (byte-code "ÀÁÂÃ#ˆÀÄÅÆ#ˆÀÇÅÆ#‡" [put menu texinfo-end texinfo-discard-command ref texinfo-format texinfo-format-xref xref] 4) (defalias 'texinfo-format-xref #[nil "À  ˆÃcˆ A@†Ä 8‰„%Æ 8„% @DZ‚@ †+ @ȱˆÆ 8ƒ=ÉÆ 8ʱˆ @c*‡" [texinfo-format-parse-args args texinfo-discard-command "*Note " 2 fname 3 "::" ": " "(" ")"] 4]) (put (quote pxref) (quote texinfo-format) (quote texinfo-format-pxref)) (defalias 'texinfo-format-pxref #[nil "À ˆŠÁuˆÂÃ!)†Äc‡" [texinfo-format-xref -2 looking-at "::" "."] 2]) (put (quote inforef) (quote texinfo-format) (quote texinfo-format-inforef)) (defalias 'texinfo-format-inforef #[nil "À  ˆ A@ƒà A@ÄÅ 8Æ @±‚'ÃÇÅ 8Æ @ȱ)‡" [texinfo-format-parse-args args texinfo-discard-command "*Note " ": (" 2 ")" "(" "::"] 6]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#ˆÀÉÂÃ#ˆÀÊÂÃ#ˆÀËÂÃ#‡" [put majorheading texinfo-format texinfo-format-chapter chapheading ichapter chapter iappendix appendix iunnumbered top unnumbered] 4) (defalias 'texinfo-format-chapter #[nil "ÀÁ!‡" [texinfo-format-chapter-1 42] 2]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#ˆÀÉÂÃ#ˆÀÊÂÃ#ˆÀËÂÃ#‡" [put heading texinfo-format texinfo-format-section isection section iappendixsection appendixsection iappendixsec appendixsec iunnumberedsec unnumberedsec] 4) (defalias 'texinfo-format-section #[nil "ÀÁ!‡" [texinfo-format-chapter-1 61] 2]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#ˆÀÉÂÃ#‡" [put subheading texinfo-format texinfo-format-subsection isubsection subsection iappendixsubsec appendixsubsec iunnumberedsubsec unnumberedsubsec] 4) (defalias 'texinfo-format-subsection #[nil "ÀÁ!‡" [texinfo-format-chapter-1 45] 2]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#ˆÀÉÂÃ#‡" [put subsubheading texinfo-format texinfo-format-subsubsection isubsubsection subsubsection iappendixsubsubsec appendixsubsubsec iunnumberedsubsubsec unnumberedsubsubsec] 4) (defalias 'texinfo-format-subsubsection #[nil "ÀÁ!‡" [texinfo-format-chapter-1 46] 2]) (defalias 'texinfo-format-chapter-1 #[(belowchar) "À Âà \"ˆÄ ÄÅıˆÇy)‡" [texinfo-parse-arg-discard arg message "Formatting: %s ... " 10 "@SectionPAD " belowchar -2] 6]) (put (quote SectionPAD) (quote texinfo-format) (quote texinfo-format-sectionpad)) (defalias 'texinfo-format-sectionpad #[nil "À ÂuˆiÄuˆ ÅVƒ cˆ S‰‚\f)Æc)‡" [texinfo-parse-arg-discard str -1 column 1 0 10] 3]) (put (quote \.) (quote texinfo-format) (quote texinfo-format-\.)) (defalias 'texinfo-format-\. #[nil "À ˆÁc‡" [texinfo-discard-command "."] 1]) (put (quote :) (quote texinfo-format) (quote texinfo-format-:)) (defalias 'texinfo-format-: #[nil "À ‡" [texinfo-discard-command] 1]) (put (quote -) (quote texinfo-format) (quote texinfo-format-soft-hyphen)) (defalias 'texinfo-format-soft-hyphen #[nil "À ‡" [texinfo-discard-command] 1]) (put (quote center) (quote texinfo-format) (quote texinfo-format-center)) (defalias 'texinfo-format-center #[nil "À  ˆ cˆÃcˆŒ`SbˆÄÆ +‡" [texinfo-parse-expanded-arg arg texinfo-discard-command 10 nil indent-tabs-mode center-line] 1]) (put (quote sp) (quote texinfo-format) (quote texinfo-format-sp)) (defalias 'texinfo-format-sp #[nil "À  !ÄÅ \"*‡" [texinfo-parse-arg-discard arg read num insert-char 10] 3]) (put (quote br) (quote texinfo-format) (quote texinfo-format-paragraph-break)) #@75 Force a paragraph break. If used within a line, follow `@br' with braces. (defalias 'texinfo-format-paragraph-break #[nil "À ˆgÁUƒ\fÁc‡ÂÁÃ\"‡" [texinfo-optional-braces-discard 10 insert-char 2] 3 (#$ . 18986)]) #@41 Footnote style, either separate or end. (defvar texinfo-footnote-style "separate" (#$ . 19204)) (put (quote footnotestyle) (quote texinfo-format) (quote texinfo-footnotestyle)) #@104 Specify whether footnotes are at end of node or in separate nodes. Argument is either end or separate. (defalias 'texinfo-footnotestyle #[nil "À ‰‡" [texinfo-parse-arg-discard texinfo-footnote-style] 2 (#$ . 19388)]) (byte-code "À BÂÃÄÅ#‡" [texinfo-footnote-number current-load-list put footnote texinfo-format texinfo-format-footnote] 4) #@134 Format a footnote in either end of node or separate node style. The texinfo-footnote-style variable controls which style is used. (defalias 'texinfo-format-footnote #[nil "T ˜ƒ\fà ‡ Ę…Å ‡" [texinfo-footnote-number texinfo-footnote-style "end" texinfo-format-end-node "separate" texinfo-format-separate-node] 2 (#$ . 19736)]) #@104 Format footnote in Separate node style, with notes in own node. The node is constructed automatically. (defalias 'texinfo-format-separate-node #[nil "À ŠÄÅ!ˆÆ•)ŠbˆÈÀwˆ`ÉÊŠÀˆ`)Ë#ƒ+`S‚/Àˆ`{)\fÍ ˆŠÎÀxˆ`)`|ˆÏÐ\f#cˆÒÀ!ˆŠÓÔÀÕ#ƒYÖyˆŠÄ\f×PË#)ƒx`ÏØ #cˆÙ `\"‚“ÚÜ\f×\fݱˆ`ÏØ #cˆÙ `\"-‡" [nil start texinfo-parse-line-arg arg re-search-backward "^File: \\w+\\(\\w\\|\\s_\\|\\.\\|,\\)*[ ]+Node:" 0 node-name-beginning " " search-forward "," t node-name texinfo-discard-command " \n" format " (%d) (*Note %s-Footnotes::)" texinfo-footnote-number fill-paragraph re-search-forward "^@node" move -1 "-Footnotes, Up: " "\n(%d) %s\n" fill-region "\n\nFile: " texinfo-format-filename " Node: " "\n"] 7 (#$ . 20078)]) #@70 Format footnote in the End of node style, with notes at end of node. (defalias 'texinfo-format-end-node #[nil "ÀÁ Ä ˆŠÅÀxˆ`)`|ˆÆÇ\"cˆÉÀ!ˆŠÊËÀÌ#ƒBÍÎÀÏ#ƒ1Ðyˆ`ÆÑ\n#cˆÒ `\"‚YÍÎÀÏ#ƒMÐyˆËcˆ`ÆÑ\n#c+‡" [nil texinfo-parse-line-arg arg start texinfo-discard-command " \n" format " (%d) " texinfo-footnote-number fill-paragraph search-forward "\n--------- Footnotes ---------\n" t re-search-forward "^@node" move -1 "\n(%d) %s\n" fill-region] 4 (#$ . 20819)]) #@127 Count of number of unpopped texinfo-push-stack calls. Used by @refill indenting command to avoid indenting within lists, etc. (defvar texinfo-stack-depth 0 (#$ . 21291)) (defalias 'texinfo-push-stack #[(check arg) "T \n E\fB‰‡" [texinfo-stack-depth check arg texinfo-command-start texinfo-stack] 3]) (defalias 'texinfo-pop-stack #[(check) "S „\fÂÃ\f\"ˆ @@\f=„ÂÅ\f @@#ˆ @A A‡" [texinfo-stack-depth texinfo-stack error "Unmatched @end %s" check "@end %s matches @%s"] 4]) (put (quote itemize) (quote texinfo-format) (quote texinfo-itemize)) (defalias 'texinfo-itemize #[nil "ÀÁÂÃwˆlƒÄ‚Å \"ˆÆ ˆÈZ‰‡" [texinfo-push-stack itemize " " nil "@bullet" texinfo-parse-line-arg texinfo-discard-line-with-args fill-column 5] 4]) (put (quote itemize) (quote texinfo-end) (quote texinfo-end-itemize)) (defalias 'texinfo-end-itemize #[nil "Á\\ ˆÃÄ!Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack itemize stacktop texinfo-do-itemize] 2]) (put (quote enumerate) (quote texinfo-format) (quote texinfo-enumerate)) (defalias 'texinfo-enumerate #[nil "ÀÁÂÃwˆlƒÄ‚Åp!\"ˆ@A@9ƒ-ÄÇ@A@!GVƒ-ÈÉ!ˆÊ ˆ ÌZ‰ ‡" [texinfo-push-stack enumerate " " nil 1 read texinfo-stack symbol-name error "@enumerate: Use a number or letter, eg: 1, A, a, 3, B, or d." texinfo-discard-line-with-args fill-column 5] 4]) (put (quote enumerate) (quote texinfo-end) (quote texinfo-end-enumerate)) (defalias 'texinfo-end-enumerate #[nil "Á\\ ˆÃÄ!Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack enumerate stacktop texinfo-do-itemize] 2]) (put (quote alphaenumerate) (quote texinfo-format) (quote texinfo-alphaenumerate)) (defalias 'texinfo-alphaenumerate #[nil "ÀÁÂ\"ˆ ÄZÅ ‡" [texinfo-push-stack alphaenumerate 96 fill-column 5 texinfo-discard-line] 3]) (put (quote alphaenumerate) (quote texinfo-end) (quote texinfo-end-alphaenumerate)) (defalias 'texinfo-end-alphaenumerate #[nil "Á\\ ˆÃÄ!Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack alphaenumerate stacktop texinfo-do-itemize] 2]) (put (quote capsenumerate) (quote texinfo-format) (quote texinfo-capsenumerate)) (defalias 'texinfo-capsenumerate #[nil "ÀÁÂ\"ˆ ÄZÅ ‡" [texinfo-push-stack capsenumerate 64 fill-column 5 texinfo-discard-line] 3]) (put (quote capsenumerate) (quote texinfo-end) (quote texinfo-end-capsenumerate)) (defalias 'texinfo-end-capsenumerate #[nil "Á\\ ˆÃÄ!Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack capsenumerate stacktop texinfo-do-itemize] 2]) (defalias 'texinfo-do-itemize #[(from) "ŠÀyˆ` Y….gÂUƒ ŠÃÄ!ˆÅˆÃÆ!ˆ)‚ÇÈ!„ŠÉcˆ)‚)‡" [-1 from 8 delete-char 1 nil 6 looking-at "[ ]*$" " "] 2]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put item texinfo-format texinfo-item itemx] 4) (defalias 'texinfo-item #[nil "@@ÁN ‡" [texinfo-stack texinfo-item] 2]) (put (quote itemize) (quote texinfo-item) (quote texinfo-itemize-item)) (defalias 'texinfo-itemize-item #[nil "`TŠÀyˆ`)|ˆÁÂ!ƒÃ\f@A@űˆ‚%Ã\f@A@ƱˆÇy‡" [0 looking-at "[ ]*[^ \n]+" " " texinfo-stack " \n" " " -1] 3]) (put (quote enumerate) (quote texinfo-item) (quote texinfo-enumerate-item)) (defalias 'texinfo-enumerate-item #[nil "À ˆÁ @A@¨ƒ% @A@ÄÅÆ\n\"DZˆ @A\nT ˆ‚e @A@9ƒaÈ @A@!É\n!Êš„DÉ\n!ËšƒHÌÍ!ˆÄÅÎ\n\"DZˆ @AÏÐÉ\n!T!! ˆ‚eÌÑ!ˆÒy)‡" [texinfo-discard-line nil enumerating-symbol texinfo-stack 8 format "%3d. " 10 symbol-name string-to-char 91 123 error "Too many items in enumerated list; alphabet ends at Z." "%3s. " make-symbol char-to-string "@enumerate: Use a number or letter, eg: 1, A, a, 3, B or d." -1] 5]) (put (quote alphaenumerate) (quote texinfo-item) (quote texinfo-alphaenumerate-item)) (defalias 'texinfo-alphaenumerate-item #[nil "À ˆ @A@T‰ÃVƒÄÅ!ˆ @A\n ˆÆ\nDZˆ)Èy‡" [texinfo-discard-line texinfo-stack next 122 error "More than 26 items in @alphaenumerate; get a bigger alphabet." " " ". \n" -1] 4]) (put (quote capsenumerate) (quote texinfo-item) (quote texinfo-capsenumerate-item)) (defalias 'texinfo-capsenumerate-item #[nil "À ˆ @A@T‰ÃVƒÄÅ!ˆ @A\n ˆÆ\nDZˆ)Èy‡" [texinfo-discard-line texinfo-stack next 90 error "More than 26 items in @capsenumerate; get a bigger alphabet." " " ". \n" -1] 4]) (put (quote table) (quote texinfo-format) (quote texinfo-table)) (defalias 'texinfo-table #[nil "ÀÁÂÃwˆlƒÄ‚Å \"ˆÆ ˆÈZ‰‡" [texinfo-push-stack table " " nil "@asis" texinfo-parse-line-arg texinfo-discard-line-with-args fill-column 5] 4]) (put (quote table) (quote texinfo-item) (quote texinfo-table-item)) (defalias 'texinfo-table-item #[nil "À @A@Ä\nŠƱˆ*Çy‡" [texinfo-parse-arg-discard texinfo-stack itemfont arg 8 123 "}\n \n" -2] 5]) (put (quote table) (quote texinfo-end) (quote texinfo-end-table)) (defalias 'texinfo-end-table #[nil "Á\\ ˆÃÄ!Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack table stacktop texinfo-do-itemize] 2]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put description texinfo-end texinfo-end-table texinfo-format texinfo-description] 4) (defalias 'texinfo-description #[nil "ÀÁÂ\"ˆ ÄZÅ ‡" [texinfo-push-stack table "@asis" fill-column 5 texinfo-discard-line] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#‡" [put ftable texinfo-format texinfo-ftable vtable texinfo-vtable] 4) (defalias 'texinfo-ftable #[nil "ÀÁ!‡" [texinfo-indextable ftable] 2]) (defalias 'texinfo-vtable #[nil "ÀÁ!‡" [texinfo-indextable vtable] 2]) (defalias 'texinfo-indextable #[(table-type) "À  \"ˆ ÄZ‰‡" [texinfo-push-stack table-type texinfo-parse-arg-discard fill-column 5] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#‡" [put ftable texinfo-item texinfo-ftable-item vtable texinfo-vtable-item] 4) (defalias 'texinfo-ftable-item #[nil "ÀÁ!‡" [texinfo-indextable-item texinfo-findex] 2]) (defalias 'texinfo-vtable-item #[nil "ÀÁ!‡" [texinfo-indextable-item texinfo-vindex] 2]) (defalias 'texinfo-indextable-item #[(index-type) "À @A@\nÆ\fÇ È±ˆ  D JBLˆÊy+‡" [texinfo-parse-arg-discard texinfo-stack index-type indexvar itemfont item 8 123 "}\n \n" texinfo-last-node -2] 5]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#‡" [put ftable texinfo-end texinfo-end-ftable vtable texinfo-end-vtable] 4) (defalias 'texinfo-end-ftable #[nil "ÀÁ!‡" [texinfo-end-indextable ftable] 2]) (defalias 'texinfo-end-vtable #[nil "ÀÁ!‡" [texinfo-end-indextable vtable] 2]) (defalias 'texinfo-end-indextable #[(table-type) "Á\\ ˆÃ\f!Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack table-type stacktop texinfo-do-itemize] 2]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#ˆÀÆÂÇ#‡" [put ifinfo texinfo-format texinfo-discard-line texinfo-end texinfo-discard-command iftex texinfo-format-iftex] 4) (defalias 'texinfo-format-iftex #[nil "ÁÂ!ˆ`|‡" [texinfo-command-start re-search-forward "@end iftex[ ]*\n"] 3]) (put (quote ifhtml) (quote texinfo-format) (quote texinfo-format-ifhtml)) (defalias 'texinfo-format-ifhtml #[nil "ÁÂ!ˆ`|‡" [texinfo-command-start re-search-forward "@end ifhtml[ ]*\n"] 3]) (put (quote tex) (quote texinfo-format) (quote texinfo-format-tex)) (defalias 'texinfo-format-tex #[nil "ÁÂ!ˆ`|‡" [texinfo-command-start re-search-forward "@end tex[ ]*\n"] 3]) (put (quote html) (quote texinfo-format) (quote texinfo-format-html)) (defalias 'texinfo-format-html #[nil "ÁÂ!ˆ`|‡" [texinfo-command-start re-search-forward "@end html[ ]*\n"] 3]) (put (quote titlepage) (quote texinfo-format) (quote texinfo-format-titlepage)) (defalias 'texinfo-format-titlepage #[nil "ÁÂ!ˆ`|‡" [texinfo-command-start re-search-forward "@end titlepage[ ]*\n"] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#‡" [put endtitlepage texinfo-format texinfo-discard-line titlespec texinfo-format-titlespec] 4) (defalias 'texinfo-format-titlespec #[nil "ÁÂ!ˆ`|‡" [texinfo-command-start re-search-forward "@end titlespec[ ]*\n"] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#‡" [put endtitlespec texinfo-format texinfo-discard-line today texinfo-format-today] 4) (defalias 'texinfo-format-today #[nil "À ˆÁÂà ÄÅOà ÆÇOà ÈÉO$c‡" [texinfo-parse-arg-discard format "%s %s %s" current-time-string 8 10 4 7 -4 nil] 7]) (put (quote ignore) (quote texinfo-format) (quote texinfo-format-ignore)) (defalias 'texinfo-format-ignore #[nil "ÁÂ!ˆ`|‡" [texinfo-command-start re-search-forward "@end ignore[ ]*\n"] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#‡" [put endignore texinfo-format texinfo-discard-line definfoenclose texinfo-define-info-enclosure] 4) (defalias 'texinfo-define-info-enclosure #[nil "À ‰@ A@† ÃÅ 8†ÃÇ ˆ\n\fDDB‰,‡" [texinfo-format-parse-line-args args command-name "" beginning-delimiter 2 end-delimiter texinfo-discard-command texinfo-enclosure-list] 4]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put var texinfo-format texinfo-format-var sc] 4) (defalias 'texinfo-format-var #[nil "À –cˆ b‡" [texinfo-parse-arg-discard texinfo-command-start] 1]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#ˆÀÉÂÃ#ˆÀÊÂÃ#ˆÀËÂÃ#ˆÀÌÂÃ#‡" [put b texinfo-format texinfo-format-noop i r t w asis dmn key math titlefont] 4) (defalias 'texinfo-format-noop #[nil "À cˆ b‡" [texinfo-parse-arg-discard texinfo-command-start] 1]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#‡" [put cite texinfo-format texinfo-format-code code file kbd samp] 4) (defalias 'texinfo-format-code #[nil "ÀÁ ±ˆ b‡" ["`" texinfo-parse-arg-discard "'" texinfo-command-start] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put emph texinfo-format texinfo-format-emph strong] 4) (defalias 'texinfo-format-emph #[nil "ÀÁ À±ˆ\nb‡" ["*" texinfo-parse-arg-discard texinfo-command-start] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put dfn texinfo-format texinfo-format-defn defn] 4) (defalias 'texinfo-format-defn #[nil "ÀÁ À±ˆ\nb‡" ["\"" texinfo-parse-arg-discard texinfo-command-start] 3]) (put (quote bullet) (quote texinfo-format) (quote texinfo-format-bullet)) #@74 Insert an asterisk. If used within a line, follow `@bullet' with braces. (defalias 'texinfo-format-bullet #[nil "À ˆÁc‡" [texinfo-optional-braces-discard "*"] 1 (#$ . 30820)]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#‡" [put display texinfo-format texinfo-format-example example lisp quotation smallexample smalllisp] 4) (defalias 'texinfo-format-example #[nil "ÀÁÂ\"ˆ ÄZÅ ‡" [texinfo-push-stack example nil fill-column 5 texinfo-discard-line] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#‡" [put example texinfo-end texinfo-end-example display lisp quotation smallexample smalllisp] 4) (defalias 'texinfo-end-example #[nil "Á\\ ˆÃÄ!Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack example stacktop texinfo-do-itemize] 2]) (put (quote exdent) (quote texinfo-format) (quote texinfo-format-exdent)) (defalias 'texinfo-format-exdent #[nil "À ˆ`ÁÂwˆ`|ˆÃcˆŠÂˆÄc)‡" [texinfo-discard-command " " nil 8 "\n "] 3]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#ˆÀÆÂÇ#ˆÀÈÂÇ#‡" [put cartouche texinfo-format texinfo-discard-line texinfo-end texinfo-discard-command format texinfo-format-flushleft flushleft] 4) (defalias 'texinfo-format-flushleft #[nil "À ‡" [texinfo-discard-line] 1]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put format texinfo-end texinfo-end-flushleft flushleft] 4) (defalias 'texinfo-end-flushleft #[nil "À ‡" [texinfo-discard-command] 1]) (put (quote flushright) (quote texinfo-format) (quote texinfo-format-flushright)) (defalias 'texinfo-format-flushright #[nil "ÀÁÂ\"ˆÃ ‡" [texinfo-push-stack flushright nil texinfo-discard-line] 3]) (put (quote flushright) (quote texinfo-end) (quote texinfo-end-flushright)) (defalias 'texinfo-end-flushright #[nil "À ˆÁÂ!Ä A@!)‡" [texinfo-discard-command texinfo-pop-stack flushright stacktop texinfo-do-flushright] 2]) (defalias 'texinfo-do-flushright #[(from) "ŠÀyˆ` Y…(ÂyˆÃ\fŠÅˆÆÅxˆ`ň`|ˆi)ZÇ\"cˆ‚)‡" [-1 from 0 make-string fill-column nil " " 32] 4]) (put (quote ctrl) (quote texinfo-format) (quote texinfo-format-ctrl)) (defalias 'texinfo-format-ctrl #[nil "À  ÃHÄ\"c)‡" [texinfo-parse-arg-discard str logand 0 31] 3]) (put (quote TeX) (quote texinfo-format) (quote texinfo-format-TeX)) (defalias 'texinfo-format-TeX #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "TeX"] 1]) (put (quote copyright) (quote texinfo-format) (quote texinfo-format-copyright)) (defalias 'texinfo-format-copyright #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "(C)"] 1]) (put (quote minus) (quote texinfo-format) (quote texinfo-format-minus)) #@74 Insert a minus sign. If used within a line, follow `@minus' with braces. (defalias 'texinfo-format-minus #[nil "À ˆÁc‡" [texinfo-optional-braces-discard "-"] 1 (#$ . 33303)]) (put (quote dots) (quote texinfo-format) (quote texinfo-format-dots)) (defalias 'texinfo-format-dots #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "..."] 1]) (put (quote enddots) (quote texinfo-format) (quote texinfo-format-enddots)) (defalias 'texinfo-format-enddots #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "...."] 1]) #@74 Number of spaces for @refill to indent a paragraph; else to leave as is. (defvar texinfo-paragraph-indent "asis" (#$ . 33802)) (put (quote paragraphindent) (quote texinfo-format) (quote texinfo-paragraphindent)) #@113 Specify the number of spaces for @refill to indent a paragraph. Default is to leave the number of spaces as is. (defalias 'texinfo-paragraphindent #[nil "À ‰˜ƒ‰‚Ä !‰)‡" [texinfo-parse-arg-discard arg "asis" texinfo-paragraph-indent string-to-int] 3 (#$ . 34021)]) (put (quote refill) (quote texinfo-format) (quote texinfo-format-refill)) #@120 Refill paragraph. Also, indent first line as set by @paragraphindent. Default is to leave paragraph indentation as is. (defalias 'texinfo-format-refill #[nil "À ˆÁÂ!ˆÃÄ!ƒÅyˆŠÂyˆÃÆ!)ƒ(Âyˆ`Åyˆ`|ˆ‚EÈš„E ÊV„E`ËÌwˆ`|ˆÍÎ\"cˆÁÅ!ˆÂyˆÌˆÑPÑPÔŽÕÌ!-‡" [texinfo-discard-command forward-paragraph -1 looking-at "[ \n]*$" 1 "^@noindent" texinfo-paragraph-indent "asis" texinfo-stack-depth 0 " " nil make-string 32 paragraph-separate previous-paragraph-separate "\\|[-=*.]+" paragraph-start previous-paragraph-start ((byte-code "\nć" [previous-paragraph-separate paragraph-separate previous-paragraph-start paragraph-start nil] 1)) fill-paragraph] 3 (#$ . 34375)]) (put (quote noindent) (quote texinfo-format) (quote texinfo-noindent)) (defalias 'texinfo-noindent #[nil "ŠÀÁ!ˆÂÊÄyˆ`)Å#?…Æ )‡" [forward-paragraph 1 search-backward "@refill" -1 t texinfo-discard-line] 4]) (put (quote vindex) (quote texinfo-format) (quote texinfo-format-vindex)) (defalias 'texinfo-format-vindex #[nil "ÀÁ!‡" [texinfo-index texinfo-vindex] 2]) (put (quote cindex) (quote texinfo-format) (quote texinfo-format-cindex)) (defalias 'texinfo-format-cindex #[nil "ÀÁ!‡" [texinfo-index texinfo-cindex] 2]) (put (quote findex) (quote texinfo-format) (quote texinfo-format-findex)) (defalias 'texinfo-format-findex #[nil "ÀÁ!‡" [texinfo-index texinfo-findex] 2]) (put (quote pindex) (quote texinfo-format) (quote texinfo-format-pindex)) (defalias 'texinfo-format-pindex #[nil "ÀÁ!‡" [texinfo-index texinfo-pindex] 2]) (put (quote tindex) (quote texinfo-format) (quote texinfo-format-tindex)) (defalias 'texinfo-format-tindex #[nil "ÀÁ!‡" [texinfo-index texinfo-tindex] 2]) (put (quote kindex) (quote texinfo-format) (quote texinfo-format-kindex)) (defalias 'texinfo-format-kindex #[nil "ÀÁ!‡" [texinfo-index texinfo-kindex] 2]) (defalias 'texinfo-index #[(indexvar) "À  ˆ \f ƒÆ `\"T‚ÇE JBL)‡" [texinfo-parse-expanded-arg arg texinfo-discard-command indexvar texinfo-last-node texinfo-last-node-pos count-lines 1] 6]) (byte-code "ÀÁ\nBÃÄÅÆ#ˆÃÇÅÆ#‡" [(("cp" . texinfo-cindex) ("fn" . texinfo-findex) ("vr" . texinfo-vindex) ("tp" . texinfo-tindex) ("pg" . texinfo-pindex) ("ky" . texinfo-kindex)) texinfo-indexvar-alist current-load-list put defindex texinfo-format texinfo-format-defindex defcodeindex] 4) (defalias 'texinfo-format-defindex #[nil "À  ÃP!ÂÅ ÃQ!ÂÇ ÃQ!‰ÉLˆÊ\fË#ˆÌ  \"„5 B B ÎÉÏÐDDEM,‡" [texinfo-parse-arg-discard index-name intern "index" indexing-command "texinfo-format-" index-formatting-command "texinfo-" index-alist-name nil put texinfo-format assoc texinfo-indexvar-alist lambda texinfo-index quote] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put synindex texinfo-format texinfo-format-synindex syncodeindex] 4) (defalias 'texinfo-format-synindex #[nil "À  !AÄ !@!Ä \"@!Ç \"ƒ=ÉÇ \"AÊÇ \"A†9ÌÍÎQ!#‚VÉÌ ÎP!ÊÇ \"A†UÌÍÎQ!#,‡" [texinfo-parse-arg-discard args read-from-string second symbol-name joiner joined assoc texinfo-short-index-cmds-alist put texinfo-format texinfo-short-index-format-cmds-alist intern "texinfo-format-" "index"] 7]) (byte-code "ÀÁ\nBÃÄ\nBÁ‡" [(("cp" . cindex) ("fn" . findex) ("vr" . vindex) ("tp" . tindex) ("pg" . pindex) ("ky" . kindex)) texinfo-short-index-cmds-alist current-load-list (("cp" . texinfo-format-cindex) ("fn" . texinfo-format-findex) ("vr" . texinfo-format-vindex) ("tp" . texinfo-format-tindex) ("pg" . texinfo-format-pindex) ("ky" . texinfo-format-kindex)) texinfo-short-index-format-cmds-alist] 2) (defalias 'texinfo-sort-region #[(start end) "ÀÁ!ˆŒ\n }ˆÄÅÆÇÈ$)‡" [require sort start end sort-subr nil forward-line end-of-line texinfo-sort-startkeyfun] 5]) (defalias 'texinfo-sort-startkeyfun #[nil "`ŠÀˆ`){Âà \"ƒ! ĉ”OÅ Ä• GOQ‚ )‡" [nil line string-match "[ ][ ]+\\|[^a-z0-9 ]+" 0 " "] 5]) (put (quote printindex) (quote texinfo-format) (quote texinfo-format-printindex)) (defalias 'texinfo-format-printindex #[nil "ÀÁ \n\"AJÃÆcˆ`Çà \"ˆÉ=ƒ\"Ê\f`\"‚(Ë\f`ÌÍ$*‡" [assoc texinfo-parse-arg-discard texinfo-indexvar-alist nil opoint indexelts "\n* Menu:\n\n" texinfo-print-index system-type vax-vms texinfo-sort-region shell-command-on-region "sort -fd" 1] 5]) (defalias 'texinfo-print-index #[(file indexelts) "…Y@@;ƒFÁ@@±ˆÃjˆ\fƒ!Å\fÆQ‚\"Ç@A@ȱˆÉjˆÊ@8ƒ>ËÌÊ@8\"‚?Çͱˆ‚QÎ@A@Ê@8\"ˆA‰„χ" [indexelts "* " ": " 32 file "(" ")" "" "." 54 2 format " %d." "\n" texinfo-print-index nil] 5]) (put (quote equiv) (quote texinfo-format) (quote texinfo-format-equiv)) (defalias 'texinfo-format-equiv #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "=="] 1]) (put (quote error) (quote texinfo-format) (quote texinfo-format-error)) (defalias 'texinfo-format-error #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "error-->"] 1]) (put (quote expansion) (quote texinfo-format) (quote texinfo-format-expansion)) (defalias 'texinfo-format-expansion #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "==>"] 1]) (put (quote point) (quote texinfo-format) (quote texinfo-format-point)) (defalias 'texinfo-format-point #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "-!-"] 1]) (put (quote print) (quote texinfo-format) (quote texinfo-format-print)) (defalias 'texinfo-format-print #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "-|"] 1]) (put (quote result) (quote texinfo-format) (quote texinfo-format-result)) (defalias 'texinfo-format-result #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "=>"] 1]) (defalias 'texinfo-format-defun #[nil "ÀÁÂ\"ˆ ÄZÅÆ!‡" [texinfo-push-stack defun nil fill-column 5 texinfo-format-defun-1 t] 3]) (defalias 'texinfo-end-defun #[nil "Á\\ ˆÃÄ!A@Æ !ˆŠ bˆÇÈ!*‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack defun start texinfo-do-itemize delete-char -1] 2]) (defalias 'texinfo-format-defunx #[nil "ÀÁ!‡" [texinfo-format-defun-1 nil] 2]) (defalias 'texinfo-format-defun-1 #[(first-p) "À ÂNÄ ˆ „ÆÇ!ˆ ÈN !ˆÉcˆ\n@AA` ˆ ËN !*‡" [texinfo-format-parse-defun-args texinfo-command-name texinfo-defun-type parse-args texinfo-discard-command first-p delete-char -1 texinfo-deffn-formatting-property "\n\n" texinfo-stack texinfo-defun-indexing-property] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#‡" [put deffn texinfo-deffn-formatting-property texinfo-format-deffn deffnx defvr defvrx deftp deftpx] 4) (defalias 'texinfo-format-deffn #[(parsed-args) "@A@AAÄ Å\n±ˆ …=Æ @ÇHÈU„*É\n@!Ë=ƒ/ @‚2 @–±ˆ A‰„Ì+‡" [parsed-args args name category " -- " ": " " " 0 38 eval texinfo-defun-type deftp-type nil] 5]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#ˆÀÉÂÃ#ˆÀÊÂÃ#ˆÀËÂÃ#ˆÀÌÂÃ#‡" [put defun texinfo-deffn-formatting-property texinfo-format-specialized-defun defunx defmac defmacx defspec defspecx defvar defvarx defopt defoptx] 4) (defalias 'texinfo-format-specialized-defun #[(parsed-args) "A@ @ AÅ\fÆ ±ˆ\n…2Ç\n@ÈHÉUƒ$\n@‚'\n@–±ˆ\nA‰„Ê+‡" [texinfo-defun-type parsed-args args name category " -- " ": " " " 0 38 nil] 5]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#‡" [put deftypefn texinfo-deffn-formatting-property texinfo-format-deftypefn deftypefnx deftypevr deftypevrx] 4) (defalias 'texinfo-format-deftypefn #[(parsed-args) "@A@AA@AAAÅ\fÆ Ç\n±ˆ …,Ç @±ˆ A‰„È,‡" [parsed-args args name data-type category " -- " ": " " " nil] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#‡" [put deftypefun texinfo-deffn-formatting-property texinfo-format-deftypefun deftypefunx deftypevar deftypevarx] 4) (defalias 'texinfo-format-deftypefun #[(parsed-args) "A@ @ A@ AAÆ Ç\fÈ ±ˆ\n…*È\n@±ˆ\nA‰„É,‡" [texinfo-defun-type parsed-args args name data-type category " -- " ": " " " nil] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put defop texinfo-deffn-formatting-property texinfo-format-defop defopx] 4) (defalias 'texinfo-format-defop #[(parsed-args) "@A@AA@AAAÅ\fÆ Ç\n±ˆ …-È @–±ˆ A‰„É,‡" [parsed-args args name class category " -- " " on " ": " " " nil] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put defcv texinfo-deffn-formatting-property texinfo-format-defcv defcvx] 4) (defalias 'texinfo-format-defcv #[(parsed-args) "@A@AA@AAAÅ\fÆ Ç\n±ˆ …-È @–±ˆ A‰„É,‡" [parsed-args args name class category " -- " " of " ": " " " nil] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put defmethod texinfo-deffn-formatting-property texinfo-format-defmethod defmethodx] 4) (defalias 'texinfo-format-defmethod #[(parsed-args) "A@ @ A@ AAÆ Ç\fÈ ±ˆ\n…+É\n@–±ˆ\nA‰„Ê,‡" [texinfo-defun-type parsed-args args name class category " -- " " on " ": " " " nil] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put defivar texinfo-deffn-formatting-property texinfo-format-defivar defivarx] 4) (defalias 'texinfo-format-defivar #[(parsed-args) "A@ @ A@ AAÆ Ç\fÈ ±ˆ\n…+É\n@–±ˆ\nA‰„Ê,‡" [texinfo-defun-type parsed-args args name class category " -- " " of " ": " " " nil] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#ˆÀÉÂÃ#ˆÀÊÂÃ#ˆÀËÂÃ#ˆÀÌÂÃ#‡" [put defun texinfo-defun-indexing-property texinfo-index-defun defunx defmac defmacx defspec defspecx defvar defvarx defopt defoptx] 4) (defalias 'texinfo-index-defun #[(parsed-args) "ÁN‰ @\f ƒÆ `\"T‚ÇE\nJBL)‡" [texinfo-command-name texinfo-defun-index index-list parsed-args texinfo-last-node texinfo-last-node-pos count-lines 1] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#ˆÀÉÂÃ#ˆÀÊÂÃ#ˆÀËÂÃ#ˆÀÌÂÃ#‡" [put deffn texinfo-defun-indexing-property texinfo-index-deffn deffnx defvr defvrx deftp deftpx deftypefun deftypefunx deftypevar deftypevarx] 4) (defalias 'texinfo-index-deffn #[(parsed-args) "ÁN‰ A@\f ƒÆ `\"T‚ÇE\nJBL)‡" [texinfo-command-name texinfo-defun-index index-list parsed-args texinfo-last-node texinfo-last-node-pos count-lines 1] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#‡" [put deftypefn texinfo-defun-indexing-property texinfo-index-deftypefn deftypefnx deftypevr deftypevrx] 4) (defalias 'texinfo-index-deftypefn #[(parsed-args) "ÁN‰ AA@\f ƒÆ `\"T‚ÇE\nJBL)‡" [texinfo-command-name texinfo-defun-index index-list parsed-args texinfo-last-node texinfo-last-node-pos count-lines 1] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put defmethod texinfo-defun-indexing-property texinfo-index-defmethod defmethodx] 4) (defalias 'texinfo-index-defmethod #[(parsed-args) "ÁN‰ÃÄ A@ @#ƒÈ`\"T‚ÉE\nJBL)‡" [texinfo-command-name texinfo-defun-index index-list format "%s on %s" parsed-args texinfo-last-node texinfo-last-node-pos count-lines 1] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put defop texinfo-defun-indexing-property texinfo-index-defop defopx] 4) (defalias 'texinfo-index-defop #[(parsed-args) "ÁN‰ÃÄ AA@ A@#ƒÈ`\"T‚ ÉE\nJBL)‡" [texinfo-command-name texinfo-defun-index index-list format "%s on %s" parsed-args texinfo-last-node texinfo-last-node-pos count-lines 1] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put defivar texinfo-defun-indexing-property texinfo-index-defivar defivarx] 4) (defalias 'texinfo-index-defivar #[(parsed-args) "ÁN‰ÃÄ A@ @#ƒÈ`\"T‚ÉE\nJBL)‡" [texinfo-command-name texinfo-defun-index index-list format "%s of %s" parsed-args texinfo-last-node texinfo-last-node-pos count-lines 1] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#‡" [put defcv texinfo-defun-indexing-property texinfo-index-defcv defcvx] 4) (defalias 'texinfo-index-defcv #[(parsed-args) "ÁN‰ÃÄ AA@ A@#ƒÈ`\"T‚ ÉE\nJBL)‡" [texinfo-command-name texinfo-defun-index index-list format "%s of %s" parsed-args texinfo-last-node texinfo-last-node-pos count-lines 1] 7]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÁÆÇ#ˆÀÁÈÉ#ˆÀÄÈÊ#ˆÀÁËÌ#ˆÀÄËÌ#ˆÀÍÂÃ#ˆÀÎÂÅ#ˆÀÍÆÇ#ˆÀÍÈÏ#ˆÀÎÈÐ#ˆÀÍËÌ#ˆÀÎËÌ#ˆÀÑÂÃ#ˆÀÒÂÅ#ˆÀÑÆÇ#ˆÀÑÈÓ#ˆÀÒÈÔ#ˆÀÑËÌ#ˆÀÒËÌ#ˆÀÕÂÃ#ˆÀÖÂÅ#ˆÀÕÆÇ#ˆÀÕÈ×#ˆÀÖÈØ#ˆÀÕËÌ#ˆÀÖËÌ#ˆÀÙÂÃ#ˆÀÚÂÅ#ˆÀÙÆÇ#ˆÀÙÈÛ#ˆÀÚÈÜ#ˆÀÙËÝ#ˆÀÚËÝ#ˆÀÞÂÃ#ˆÀßÂÅ#ˆÀÞÆÇ#ˆÀÞÈà#ˆÀßÈá#ˆÀÞËÝ#ˆÀßËÝ#ˆÀâÂÃ#ˆÀãÂÅ#ˆÀâÆÇ#ˆÀâÈä#ˆÀãÈå#ˆÀâËÝ#ˆÀãËÝ#ˆÀæÂÃ#ˆÀçÂÅ#ˆÀæÆÇ#ˆÀæÈè#ˆÀçÈé#ˆÀæËÌ#ˆÀçËÌ#ˆÀêÂÃ#ˆÀëÂÅ#ˆÀêÆÇ#ˆÀêÈì#ˆÀëÈí#ˆÀêËÝ#ˆÀëËÝ#ˆÀîÂÃ#ˆÀïÂÅ#ˆÀîÆÇ#ˆÀîÈð#ˆÀïÈñ#ˆÀîËò#ˆÀïËò#ˆÀóÂÃ#ˆÀôÂÅ#ˆÀóÆÇ#ˆÀóÈõ#ˆÀôÈö#ˆÀóËÌ#ˆÀôËÌ#ˆÀ÷ÂÃ#ˆÀøÂÅ#ˆÀ÷ÆÇ#ˆÀ÷Èù#ˆÀøÈú#ˆÀ÷ËÌ#ˆÀøËÌ#ˆÀûÂÃ#ˆÀüÂÅ#ˆÀûÆÇ#ˆÀûÈý#ˆÀüÈþ#ˆÀûËÝ#ˆÀüËÝ#ˆÀÿÂÃ#ˆÀ@ÂÅ#ˆÀÿÆÇ#ˆÀÿÈA#ˆÀ@ÈB#ˆÀÿËÝ#ˆÀ@ËÝ#ˆÀCÂÃ#ˆÀDÂÅ#ˆÀCÆÇ#ˆÀCÈE#ˆÀDÈF#ˆÀCËÌ#ˆÀDËÌ#ˆÀGÂÃ#ˆÀHÂÅ#ˆÀGÆÇ#ˆÀGÈI#ˆÀHÈJ#ˆÀGËÌ#ˆÀHËÌ#ˆÀKÂÃ#ˆÀLÂÅ#ˆÀKÆÇ#ˆÀKÈM#ˆÀLÈN#ˆÀKËÝ#ˆÀLËÝ#ˆÀOÂÃ#ˆÀPÂÅ#ˆÀOÆÇ#ˆÀOÈQ#ˆÀPÈR#ˆÀOËÝ#ˆÀPËÝ#ˆÀSÂT#‡" [put deffn texinfo-format texinfo-format-defun deffnx texinfo-format-defunx texinfo-end texinfo-end-defun texinfo-defun-type ((quote deffn-type) nil) ((quote deffn-type) nil) texinfo-defun-index texinfo-findex defun defunx ((quote defun-type) "Function") ((quote defun-type) "Function") defmac defmacx ((quote defun-type) "Macro") ((quote defun-type) "Macro") defspec defspecx ((quote defun-type) "Special form") ((quote defun-type) "Special form") defvr defvrx ((quote deffn-type) nil) ((quote deffn-type) nil) texinfo-vindex defvar defvarx ((quote defun-type) "Variable") ((quote defun-type) "Variable") defconst defconstx ((quote defun-type) "Constant") ((quote defun-type) "Constant") defcmd defcmdx ((quote defun-type) "Command") ((quote defun-type) "Command") defopt defoptx ((quote defun-type) "User Option") ((quote defun-type) "User Option") deftp deftpx ((quote deftp-type) nil) ((quote deftp-type) nil) texinfo-tindex defop defopx ((quote defop-type) nil) ((quote defop-type) nil) defmethod defmethodx ((quote defmethod-type) "Method") ((quote defmethod-type) "Method") defcv defcvx ((quote defop-type) nil) ((quote defop-type) nil) defivar defivarx ((quote defmethod-type) "Instance variable") ((quote defmethod-type) "Instance variable") deftypefn deftypefnx ((quote deftypefn-type) nil) ((quote deftypefn-type) nil) deftypefun deftypefunx ((quote deftypefun-type) "Function") ((quote deftypefun-type) "Function") deftypevr deftypevrx ((quote deftypefn-type) nil) ((quote deftypefn-type) nil) deftypevar deftypevarx ((quote deftypevar-type) "Variable") ((quote deftypevar-type) "Variable") clear texinfo-clear] 4) #@30 Clear the value of the flag. (defalias 'texinfo-clear #[nil "À  !@  !AÄOÆ ÇÈ#ˆÆ ÉÊ#+‡" [texinfo-parse-arg-discard arg read-from-string flag nil value put texinfo-whether-setp flag-cleared texinfo-set-value ""] 4 (#$ . 48102)]) (put (quote set) (quote texinfo-format) (quote texinfo-set)) #@192 Set the value of the flag, optionally to a string. The command `@set foo This is a string.' sets flag foo to the value: `This is a string.' The command `@value{foo}' expands to the value. (defalias 'texinfo-set #[nil "À  !@  !AÄOÆ ÇÈ#ˆÆ É #+‡" [texinfo-parse-arg-discard arg read-from-string flag nil value put texinfo-whether-setp flag-set texinfo-set-value] 4 (#$ . 48402)]) (put (quote value) (quote texinfo-format) (quote texinfo-value)) #@185 Insert the string to which the flag is set. The command `@set foo This is a string.' sets flag foo to the value: `This is a string.' The command `@value{foo}' expands to the value. (defalias 'texinfo-value #[nil "À  !@ÃNÄ=ƒ! !@ÅNƒ! !@ÅNc‚D !@ÃNÆ=ƒ4ÇÈ \"c‚D !@ÃNÉ=…DÇÈ \"c)‡" [texinfo-parse-arg-discard arg read-from-string texinfo-whether-setp flag-set texinfo-set-value flag-cleared format "{No value for \"%s\"}" nil] 3 (#$ . 48859)]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put ifset texinfo-end texinfo-discard-command texinfo-format texinfo-if-set] 4) #@73 If set, continue formatting; else do not format region up to @end ifset (defalias 'texinfo-if-set #[nil "À  !@ÃNÄ=ƒÅ‚4 !@ÃNÆ=ƒ(ÈÉ!ˆ`|‚4 !@ÃNÅ=…4Å)‡" [texinfo-parse-arg-discard arg read-from-string texinfo-whether-setp flag-set nil flag-cleared texinfo-command-start re-search-forward "@end ifset[ ]*\n"] 3 (#$ . 49424)]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put ifclear texinfo-end texinfo-discard-command texinfo-format texinfo-if-clear] 4) #@71 If clear, continue formatting; if set, do not format up to @end ifset (defalias 'texinfo-if-clear #[nil "À  !@ÃNÄ=ƒ ÆÇ!ˆ`|‚3 !@ÃNÈ=ƒ'É‚3 !@ÃNÉ=…3É)‡" [texinfo-parse-arg-discard arg read-from-string texinfo-whether-setp flag-set texinfo-command-start re-search-forward "@end ifclear[ ]*\n" flag-cleared nil] 3 (#$ . 49875)]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÆÂÇ#ˆÀÈÂÇ#ˆÀÉÂÇ#ˆÀÊÂÅ#ˆÀËÌÇ#ˆÀËÂÇ#ˆÀÍÂÇ#ˆÀÎÂÇ#ˆÀÏÂÇ#ˆÀÐÂÇ#ˆÀÑÂÇ#ˆÀÒÂÇ#ˆÀÓÂÇ#ˆÀÔÂÇ#ˆÀÕÂÇ#ˆÀÖÂÇ#ˆÀ×ÂÇ#ˆÀØÂÇ#ˆÀÙÂÇ#ˆÀÚÂÅ#ˆÀÛÂÇ#‡" [put include texinfo-format texinfo-format-noop bye texinfo-discard-line c texinfo-discard-line-with-args comment contents finalout group texinfo-end headings hsize itemindent lispnarrowing need nopara page parindent setchapternewpage setq settitle setx shortcontents smallbook summarycontents] 4) (defalias 'texinfo-unsupported #[nil "ÀÁ\n {\"‡" [error "%s is not handled by texinfo" texinfo-command-start texinfo-command-end] 4]) #@289 Runs texinfo-format-buffer on the files remaining on the command line. Must be used only with -batch, and kills emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke "emacs -batch -funcall batch-texinfo-format $docs/ ~/*.texinfo". (defalias 'batch-texinfo-format #[nil "„ÁÂ!ˆÃĉʼn \nËĉ\f ƒhÏ@! Ð !„CÑÒ \"ˆÓA‰‚!Ô !ƒXÕ !A¤‰‚! \fB\fA‰„$\fƒ\f@ \fA\fÖ×؈‚hÙ !.‡" [noninteractive error "batch-texinfo-format may only be used -batch." t nil 259259 kept-new-versions kept-old-versions find-file-run-dired auto-save-default version-control 0 files file command-line-args-left expand-file-name file-exists-p message ">> %s does not exist!" 1 file-directory-p directory-files err (byte-code "ƒÁp!ˆÂ !ˆÄp!ˆÅÆ!ˆÇ ˆÈÉ \"ˆÊÆ!ˆË ƒ.ÈÌÀ \"ˆÍ ˆÆ‡" [buffer-file-name kill-buffer find-file file buffer-disable-undo set-buffer-modified-p nil texinfo-mode message "texinfo formatting %s..." texinfo-format-buffer buffer-modified-p "Saving modified %s" save-buffer] 3) ((error (byte-code "ÀÁ !\"ˆÀÄ!ˆ``Å\\d^{ÆÉÊ#‰ƒ<Ɖ”OËÆ•ÌOQT‚ÀÍ\"ˆ*Î̇" [message ">> Error: %s" prin1-to-string err ">> point at" 100 0 tem s string-match "\n+" "\n>> " nil ">> %s" 1 error] 5))) kill-emacs] 6 (#$ . 50801)]) (provide (quote texinfmt)) emacs-19.30/lisp/texinfo.elc100666 13437 1 52664 6045214633 14412 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:29:37 1995 ;;; from file /home/fsf/rms/e19/lisp/texinfo.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`texinfo.el' was compiled for Emacs 19.29 or later")) #@248 Make Info file from region of current Texinfo file, and switch to it. This command does not offer the `next-error' feature since it would apply to a temporary file, not the original; use the `makeinfo-buffer' command to gain use of `next-error'. (autoload (quote makeinfo-region) "makeinfo" '(#$ . 475) t nil) #@118 Make Info file from current buffer. Use the \[next-error] command to move to the next error (if there are errors). (autoload (quote makeinfo-buffer) "makeinfo" '(#$ . 793) t nil) #@50 Kill the process made by the \[compile] command. (autoload (quote kill-compilation) "compile" '(#$ . 980) t nil) #@166 Redisplay `*compilation*' buffer so most recent output can be seen. The last line of the buffer is displayed on line LINE of the window, or centered if LINE is nil. (autoload (quote makeinfo-recenter-compilation-buffer) "makeinfo" '(#$ . 1100) t nil) #@471 Without any prefix argument, make or update a menu. Make the menu for the section enclosing the node found following point. Non-nil argument (prefix, if interactive) means make or update menus for nodes within or part of the marked region. Whenever a menu exists, and is being updated, the descriptions that are associated with node names in the pre-existing menu are incorporated into the new menu. Otherwise, the nodes' section titles are inserted as descriptions. (autoload (quote texinfo-make-menu) "texnfo-upd" '(#$ . 1358) t nil) #@215 Update every regular menu in a Texinfo file. Remove 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. (autoload (quote texinfo-all-menus-update) "texnfo-upd" '(#$ . 1904) t nil) #@1450 Make a master menu for a whole Texinfo file. Non-nil argument (prefix, if interactive) means first update all existing nodes and menus. Remove pre-existing master menu, if there is one. This function creates a master menu that follows the top node. The master menu includes every entry from all the other menus. It replaces any existing ordinary menu that follows the top node. If called with a non-nil argument, this function first updates all the menus in the buffer (incorporating descriptions from pre-existing menus) before it constructs the master menu. 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'. The master menu has the following format, which is adapted from the recommendation in the Texinfo Manual: * The first part contains the major nodes in the Texinfo file: the nodes for the chapters, chapter-like sections, and the major appendices. This includes the indices, so long as they are in chapter-like sections, such as unnumbered sections. * The second and subsequent parts contain a listing of the other, lower level menus, in order. This way, an inquirer can go directly to a particular node if he or she is searching for specific information. Each of the menus in the detailed node listing is introduced by the title of the section containing the menu. (autoload (quote texinfo-master-menu) "texnfo-upd" '(#$ . 2202) t nil) #@239 Indent every description in menu following point to COLUMN. Non-nil argument (prefix, if interactive) means indent every description in every menu in the region. Does not indent second and subsequent lines of a multi-line description. (autoload (quote texinfo-indent-menu-description) "texnfo-upd" '(#$ . 3729) t nil) #@251 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. (autoload (quote texinfo-insert-node-lines) "texnfo-upd" '(#$ . 4057) t nil) #@336 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. (autoload (quote texinfo-start-menu-description) "texnfo-upd" '(#$ . 4391) t nil) #@1306 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: * this command does NOT save any files--you must save the outer file and any modified, included files. * except for the `Top' node, this command does NOT handle any pre-existing nodes in the outer file; hence, indices must be enclosed in an included file. Requirements: * each of the included files must contain exactly one highest hierarchical level node, * this highest node must be the first node in the included file, * each highest hierarchical level node must be of the same type. Thus, normally, each included file contains one, and only one, chapter. (autoload (quote texinfo-multiple-files-update) "texnfo-upd" '(#$ . 4816) t nil) (byte-code "ÀÁ!„ÂÁ B „IÄ ÅÆÇ #ˆÅÈÇ #ˆÅÉÊ #ˆÅËÊ #ˆÅÌÍ #ˆÅÎÏ #ˆÅÐÑ #ˆÅÒÓ #ˆÅÔÕ #ˆÂ‡" [boundp texinfo-mode-syntax-table nil current-load-list make-syntax-table modify-syntax-entry 34 " " 92 64 "\\" 17 91 "(]" 93 ")[" 123 "(}" 125 "){" 39 "w"] 4) #@77 Imenu generic expression for TexInfo mode. See `imenu-generic-expression'. (defvar texinfo-imenu-generic-expression (quote ((nil "^@node[ ]+\\([^,\n]*\\)" 1) ("Chapters" "^@chapter[ ]+\\(.*\\)$" 1))) (#$ . 6457)) #@54 Additional expressions to highlight in TeXinfo mode. (defvar texinfo-font-lock-keywords (list (quote ("^\\(@c\\|@comment\\)\\>.*" . font-lock-comment-face)) "@\\(@\\|[^} \n{]+\\)" (quote ("^\\(*.*\\)[ ]*$" 1 font-lock-function-name-face t)) (quote ("@\\(emph\\|strong\\|b\\|i\\){\\([^}]+\\)" 2 font-lock-comment-face)) (quote ("@\\(file\\|kbd\\|key\\){\\([^}]+\\)" 2 font-lock-string-face)) (quote ("@\\(samp\\|code\\|var\\|math\\){\\([^}]+\\)" 2 font-lock-variable-name-face)) (quote ("@\\(cite\\|xref\\|pxref\\){\\([^}]+\\)" 2 font-lock-reference-face)) (quote ("@\\(end\\|item\\) *\\(.+\\)" 2 font-lock-function-name-face keep))) (#$ . 6679)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp texinfo-mode-map nil current-load-list] 2) #@68 Define the keys both in Texinfo mode and in the texinfo-tex-shell. (defalias 'texinfo-define-common-keys #[(keymap) "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#‡" [define-key keymap " " tex-kill-job "" texinfo-quit-job "\f" tex-recenter-output-buffer "" texinfo-delete-from-print-queue "" tex-show-print-queue "" texinfo-tex-print " " texinfo-texindex "" texinfo-tex-region "" texinfo-tex-buffer] 4 (#$ . 7412)]) (byte-code "„­Á Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÃÐÑ#ˆÃÒÓ#ˆÃÔÕ#ˆÃÖ×#ˆÃØÙ#ˆÃÚÛ#ˆÃÜÝ#ˆÃÞß#ˆÃàá#ˆÃâã#ˆÃäå#ˆÃæç#ˆÃèé#ˆÃêë#ˆÃìí#ˆÃîï#ˆÃðñ#ˆÃòó#ˆÃôõ#ˆÃö÷#ˆÃøù#ˆÁ‡" [texinfo-mode-map make-sparse-keymap texinfo-define-common-keys define-key " " kill-compilation " \f" makeinfo-recenter-compilation-buffer " " makeinfo-region " " makeinfo-buffer "" texinfo-format-region "" texinfo-format-buffer "m" texinfo-master-menu " " texinfo-make-menu "" texinfo-update-node "" texinfo-every-node-update "" texinfo-all-menus-update "" texinfo-show-structure "}" up-list "{" texinfo-insert-braces "" texinfo-start-menu-description "v" texinfo-insert-@var "t" texinfo-insert-@table "s" texinfo-insert-@samp "o" texinfo-insert-@noindent "n" texinfo-insert-@node "k" texinfo-insert-@kbd "i" texinfo-insert-@item "f" texinfo-insert-@file "x" texinfo-insert-@example "e" texinfo-insert-@end "d" texinfo-insert-@dfn "c" texinfo-insert-@code] 4) #@128 Regular expression matching Texinfo chapter-level headings. This does not match `@node' and does not match the `@top' command. (defvar texinfo-chapter-level-regexp "chapter\\|unnumbered \\|appendix \\|majorheading\\|chapheading" (#$ . 8873)) #@2760 Major mode for editing Texinfo files. It has these extra commands: \{texinfo-mode-map} 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. Editing commands are like text-mode except that the syntax table is 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]. This command shows the structure of a Texinfo file by listing the lines with the @-sign commands for @chapter, @section, and the like. These lines are displayed in another window called the *Occur* window. In that window, you can position the cursor over one of the lines and use \[occur-mode-goto-occurrence], to jump to the corresponding spot in the Texinfo file. In addition, Texinfo mode provides commands that insert various frequently used @-sign commands into the buffer. You can use these commands to save keystrokes. And you can insert balanced braces with \[texinfo-insert-braces] and later use the command \[up-list] to move forward past the closing brace. Also, Texinfo mode provides functions for automatically creating or updating menus and node pointers. These functions * insert the `Next', `Previous' and `Up' pointers of a node, * insert or update the menu for a section, and * create a master menu for a Texinfo source file. Here are the functions: texinfo-update-node \[texinfo-update-node] texinfo-every-node-update \[texinfo-every-node-update] texinfo-sequential-node-update texinfo-make-menu \[texinfo-make-menu] texinfo-all-menus-update \[texinfo-all-menus-update] texinfo-master-menu texinfo-indent-menu-description (column &optional region-p) The `texinfo-column-for-description' variable specifies the column to which menu descriptions are indented. Passed an argument (a prefix argument, if interactive), the `texinfo-update-node' and `texinfo-make-menu' functions do their jobs in the region. To use the updating commands, you must structure your Texinfo file hierarchically, such that each `@node' line, with the exception of the Top node, is accompanied by some kind of section line, such as an `@chapter' or `@section' line. If the file has a `top' node, it must be called `top' or `Top' and be the first node in the file. Entering Texinfo mode calls the value of text-mode-hook, and then the value of texinfo-mode-hook. (defalias 'texinfo-mode #[nil "À ˆÁÃÅ!ˆÇ!ˆÉÊ!ˆË\fÍQ\nÉÎ!ˆÏÉÐ!ˆÑÉÒ!ˆÓPÉÔ!ˆÓPÉÕ!ˆÖÉ×!ˆØÉÙ!ˆÚÉÛ!ˆÏÉÜ!ˆÉÞ!ˆßÉà!ˆá Éâ!ˆã\"äåæ\"‡" [text-mode "Texinfo" mode-name texinfo-mode major-mode use-local-map texinfo-mode-map set-syntax-table texinfo-mode-syntax-table make-local-variable page-delimiter "^@node [ ]*[Tt]op\\|^@\\(" texinfo-chapter-level-regexp "\\)" require-final-newline t indent-tabs-mode nil paragraph-separate "\\|@[a-zA-Z]*[ \n]\\|" paragraph-start fill-column 72 comment-start "@c " comment-start-skip "@c +" words-include-escapes imenu-generic-expression texinfo-imenu-generic-expression font-lock-defaults (texinfo-font-lock-keywords t) tex-start-of-header "%**start" tex-end-of-header "%**end" run-hooks text-mode-hook texinfo-mode-hook] 3 (#$ . 9123) nil]) #@122 Regexp for environment-like Texinfo list commands. Subexpression 1 is what goes into the corresponding `@end' statement. (defconst texinfo-environment-regexp "^[ ]*@\\(f?table\\|enumerate\\|itemize\\|ifhtml\\|ifinfo\\|iftex\\|ifset\\|ifclear\\|example\\|quotation\\|lisp\\|smallexample\\|smalllisp\\|display\\|format\\|flushleft\\|flushright\\|ignore\\|group\\|tex\\|html\\|cartouche\\|menu\\|titlepage\\|end\\|def[a-z]*[a-wyz]\\>\\)" (#$ . 12696)) #@73 Insert the matching `@end' for the last Texinfo command that needs one. (defalias 'texinfo-insert-@end #[nil "ÀÁŠ ÄVƒ(ÅÁÇ#ƒ(ÈÉ!ƒ! T‰‚% S‰„È!ˆ ÄUƒ9À”À•{)Êcˆ\n…E\n˱*‡" [1 nil string depth 0 re-search-backward texinfo-environment-regexp t looking-at "@end" "@end " "\n"] 4 (#$ . 13152) nil]) (defalias 'texinfo-insert-@-with-arg #[(string &optional arg) "ƒ4Á!‰ÂWƒ\"ÃÄxˆŠÅ!ˆÆȱˆ)Éc‡ÃÄwˆÆȱˆÅ!ˆÉc‡ÆʱˆË ‡" [arg prefix-numeric-value 0 " \n \f" nil forward-sexp "@" string "{" "}" "{}" backward-char] 4]) #@111 Make a pair of braces and be poised to type inside of them. Use \[up-list] to move forward out of the braces. (defalias 'texinfo-insert-braces #[nil "ÀcˆÁ ‡" ["{}" backward-char] 1 (#$ . 13693) nil]) #@186 Insert a `@code{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces. (defalias 'texinfo-insert-@code #[(&optional arg) "ÀÁ\n\"‡" [texinfo-insert-@-with-arg "code" arg] 3 (#$ . 13900) "P"]) #@185 Insert a `@dfn{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces. (defalias 'texinfo-insert-@dfn #[(&optional arg) "ÀÁ\n\"‡" [texinfo-insert-@-with-arg "dfn" arg] 3 (#$ . 14212) "P"]) #@51 Insert the string `@example' in a Texinfo buffer. (defalias 'texinfo-insert-@example #[nil "Àc‡" ["@example\n"] 1 (#$ . 14520) nil]) #@186 Insert a `@file{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces. (defalias 'texinfo-insert-@file #[(&optional arg) "ÀÁ\n\"‡" [texinfo-insert-@-with-arg "file" arg] 3 (#$ . 14660) "P"]) #@48 Insert the string `@item' in a Texinfo buffer. (defalias 'texinfo-insert-@item #[nil "ÀcˆÁ ‡" ["@item" newline] 1 (#$ . 14971) nil]) #@185 Insert a `@kbd{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces. (defalias 'texinfo-insert-@kbd #[(&optional arg) "ÀÁ\n\"‡" [texinfo-insert-@-with-arg "kbd" arg] 3 (#$ . 15111) "P"]) #@142 Insert the string `@node' in a Texinfo buffer. This also inserts on the following line a comment indicating the order of arguments to @node. (defalias 'texinfo-insert-@node #[nil "ÀcˆÁyˆÂu‡" ["@node \n@comment node-name, next, previous, up" -1 6] 1 (#$ . 15420) nil]) #@52 Insert the string `@noindent' in a Texinfo buffer. (defalias 'texinfo-insert-@noindent #[nil "Àc‡" ["@noindent\n"] 1 (#$ . 15698) nil]) #@186 Insert a `@samp{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces. (defalias 'texinfo-insert-@samp #[(&optional arg) "ÀÁ\n\"‡" [texinfo-insert-@-with-arg "samp" arg] 3 (#$ . 15841) "P"]) #@49 Insert the string `@table' in a Texinfo buffer. (defalias 'texinfo-insert-@table #[(&optional arg) "Àc‡" ["@table "] 1 (#$ . 16152) "P"]) #@182 Insert a `@var{}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces. (defalias 'texinfo-insert-@var #[(&optional arg) "ÀÁ\n\"‡" [texinfo-insert-@-with-arg "var" arg] 3 (#$ . 16297) "P"]) #@572 Show the structure of a Texinfo file. List the lines in the file that begin with the @-sign commands for @chapter, @section, and the like. With optional argument (prefix if interactive), list both the lines with @-sign commands for @chapter, @section, and the like, and list @node lines. Lines with structuring commands beginning in them are displayed in another buffer named `*Occur*'. In that buffer, you can move point to one of those lines and then use \\[occur-mode-goto-occurrence], to jump to the corresponding spot in the Texinfo source file. (defalias 'texinfo-show-structure #[(&optional nodes-too) "ÀÁ!ˆŠebˆ\nƒÃÄ P!ˆ‚à !ˆ)ÆÇ!ˆebˆÈÉ!ˆdbˆÊ ÌÍÎÏ#…|ÐÑ!ˆÒÓÕQ!ƒEÊ‚qÒÓÕQ!ƒSׂqÒÓÕQ!ƒaÙ‚qÒÓÕQ!ƒoÛ‚q ‰ jˆÏyˆ‚+)‡" [require texnfo-upd nodes-too occur "\\(^@node\\)\\|" texinfo-section-types-regexp pop-to-buffer "*Occur*" flush-lines "-----" 5 margin re-search-backward "^ *[0-9]*:" nil 0 re-search-forward ":" looking-at "@\\(" texinfo-chapter-level-regexp "\\)" texinfo-section-level-regexp 9 texinfo-subsection-level-regexp 13 texinfo-subsubsection-level-regexp 17] 5 (#$ . 16603) "P"]) #@76 *Command used by `texinfo-tex-buffer' to run TeX and texindex on a buffer. (defvar texinfo-texi2dvi-command "texi2dvi" (#$ . -17743)) #@63 *Command used by `texinfo-tex-region' to run TeX on a region. (defvar texinfo-tex-command "tex" (#$ . -17883)) #@67 *Command used by `texinfo-texindex' to sort unsorted index files. (defvar texinfo-texindex-command "texindex" (#$ . -18000)) #@193 *Command string used to delete a job from the line printer queue. Command is used by \[texinfo-delete-from-print-queue] based on number provided by a previous \[tex-show-print-queue] command. (defvar texinfo-delete-from-print-queue-command "lprm" (#$ . -18132)) #@69 String appended after a region sent to TeX by `texinfo-tex-region'. (defvar texinfo-tex-trailer "@bye" (#$ . 18400)) #@588 Run TeX on the current region. This works by writing a temporary file (`tex-zap-file') in the directory that is the value of `tex-directory', then running TeX on that file. The first line of the buffer is copied to the temporary file; and if the buffer has a header, it is written to the temporary file before the region itself. The buffer's header is all lines between the strings defined by `tex-start-of-header' and `tex-end-of-header' inclusive. The header must start in the first 100 lines. The value of `texinfo-tex-trailer' is appended to the temporary file after the region. (defalias 'texinfo-tex-region #[(beg end) "ÀÁ!ˆÂÃ!ƒÄ ˆ‚Å ˆ„ÇÈ!ÉPÊË!ÌÍ!!ŠŒ~ˆebˆÒyˆ`eeebˆ×`ŠØˆ`)؉%ˆÙyˆ`Wƒe`ÛÝ#ƒŠÞyˆ`ÛØÝ#ƒ‡Þyˆ`‚Še×^ÝØ%ˆ×] ÝØ%ˆ,!\"qˆã ˆäå!ˆ\"ƒÀä\"!ˆæ\"ˆ×edÝØ%ˆ+æÃ\"ˆç(\"ˆç)\"ˆ+êÞ!‡" [require tex-mode get-buffer "*tex-shell*" tex-kill-job tex-start-shell tex-zap-file make-temp-name "#tz" ".tex" get-buffer-create " tex-Output-Buffer" file-name-as-directory expand-file-name tex-directory zap-directory temp-buffer tex-out-file 100 default-directory hend hbeg search-end write-region nil 1 beg search-forward tex-start-of-header t 0 tex-end-of-header end texinfo-tex-trailer local-tex-trailer erase-buffer insert-string "\n" tex-set-buffer-directory tex-send-command tex-shell-cd-command texinfo-tex-command tex-recenter-output-buffer] 6 (#$ . 18524) "r"]) #@72 Run TeX on visited file, once or twice, to make a correct `.dvi' file. (defalias 'texinfo-tex-buffer #[nil "ÀÁ!ˆÂÃ!ƒÄÅÆ!Ç\"ˆ‚È ˆ „#ÊË!ˆ‚,Ì ƒ,ÊÍ!ˆ ÏÑ!\"ˆÏ\"ˆÓÔ!‡" [require tex-mode get-buffer "*tex-shell*" quit-process get-process "tex-shell" t tex-start-shell buffer-file-name error "Buffer not visiting any file!" buffer-modified-p "Buffer has been modified since last saved!" tex-zap-file tex-send-command tex-shell-cd-command file-name-directory texinfo-texi2dvi-command tex-recenter-output-buffer 0] 4 (#$ . 19977) nil]) #@184 Run `texindex' on unsorted index files. The index files are made by \[texinfo-tex-region] or \[texinfo-tex-buffer]. This runs the shell command defined by `texinfo-texindex-command'. (defalias 'texinfo-texindex #[nil "ÀÁ!ˆÂ \fÅP\"ˆÆÇ!‡" [require tex-mode tex-send-command texinfo-texindex-command tex-zap-file ".??" tex-recenter-output-buffer nil] 4 (#$ . 20528) nil]) #@139 Print `.dvi' file made by \[texinfo-tex-region] or \[texinfo-tex-buffer]. This runs the shell command defined by `tex-dvi-print-command'. (defalias 'texinfo-tex-print #[nil "ÀÁ!ˆÂ \fÅP\"ˆÆÇ!‡" [require tex-mode tex-send-command tex-dvi-print-command tex-zap-file ".dvi" tex-recenter-output-buffer nil] 4 (#$ . 20904) nil]) #@58 Quit currently running TeX job, by sending an `x' to it. (defalias 'texinfo-quit-job #[nil "ÀÁ!„\nÂÃ!ˆÄÅ!‡" [get-process "tex-shell" error "No TeX shell running" tex-send-command "x"] 2 (#$ . 21233) nil]) #@158 Delete job from the line printer spooling queue. You are prompted for the job number (use a number shown by a previous \[texinfo-show-print-queue] command). (defalias 'texinfo-delete-from-print-queue #[(job-number) "ÀÁ!ˆÂ ƒà ˆ‚Ä ˆÅ\"ˆÈÉ!‡" [require tex-mode tex-shell-running tex-kill-job tex-start-shell tex-send-command texinfo-delete-from-print-queue-command job-number tex-recenter-output-buffer nil] 3 (#$ . 21446) "nPrinter job number for deletion: "]) (provide (quote texinfo)) emacs-19.30/lisp/texnfo-upd.elc100666 13437 1 120552 6045247073 15043 0ustar jimbdaemon;ELC ;;; compiled by erik@naggum.no on Mon Oct 30 17:13:37 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/texnfo-upd.el ;;; emacs version 19.29.1.5. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`texnfo-upd.el' was compiled for Emacs 19.29 or later")) #@471 Without any prefix argument, make or update a menu. Make the menu for the section enclosing the node found following point. Non-nil argument (prefix, if interactive) means make or update menus for nodes within or part of the marked region. Whenever a menu exists, and is being updated, the descriptions that are associated with node names in the pre-existing menu are incorporated into the new menu. Otherwise, the nodes' section titles are inserted as descriptions. (defalias 'texinfo-make-menu #[(&optional region-p) "„Á Ã\n!ˆÄÅ!)‡ÄÆÇ \"ˆÈ É È bˆÁ  \n \nUƒ1ËÌ!ˆŠŒ~ˆÍ\n \"ƒGÁ Ã\n!ˆ‚5` WƒkÎ\n \"ƒkÁ Í\n \"ƒGÁ Ã\n!ˆ‚Y-ÄÏ!‡" [region-p texinfo-hierarchic-level level texinfo-make-one-menu message "Done...updated the menu. You may save the buffer." "Making or updating menus in %s... " buffer-name region-beginning region-end beginning error "Please mark a region!" texinfo-find-lower-level-node texinfo-find-higher-level-node "Done...updated menus. You may save the buffer."] 3 (#$ . 470) "P"]) #@192 Make a menu of all the appropriate nodes in this section. `Appropriate nodes' are those associated with sections that are at the level specified by LEVEL. Point is left at the end of menu. (defalias 'texinfo-make-one-menu #[(level) "ÀŠÂ !bˆÄˆ`)Æ !È \" bˆÊyˆË \fÍ  #Ï  \"ƒDÐ!ˆÑ!ˆÒ  \"ˆÓ\f\".‡" [t case-fold-search texinfo-update-menu-region-beginning level nil beginning texinfo-update-menu-region-end end texinfo-menu-first-node first 0 texinfo-copy-node-name node-name texinfo-make-menu-list new-menu-list texinfo-old-menu-p texinfo-incorporate-descriptions texinfo-incorporate-menu-entry-names texinfo-delete-old-menu texinfo-insert-menu] 4 (#$ . 1498)]) #@215 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. (defalias 'texinfo-all-menus-update #[(&optional update-all-nodes-p) "ÀÁŠÄdÀ\"ˆebˆÅÆÇ \"ˆŠÈ ÁÀ#ƒ8ÀÊ”bˆŠË bˆÊyˆÌuˆ`) ` |ˆ))ƒXÅÏÇ \"ˆÐÑ!ˆÄdÀ\"ˆebˆÀÓÀ!ˆ)ÅÔÇ \"ˆÐÑ!ˆÄdÀ\"ˆebˆÀÕÀ!ˆ)\nƒ„ÅÖÇ \"ˆÐÑ!ˆ×Á!ˆ)ÅØ!*‡" [t nil master-menu-p case-fold-search push-mark message "Checking for a master menu in %s ... " buffer-name re-search-forward texinfo-master-menu-header 0 texinfo-menu-end -1 end-of-detailed-menu-descriptions update-all-nodes-p "Updating all nodes in %s ... " sleep-for 2 mark-active texinfo-update-node "Updating all menus in %s ... " texinfo-make-menu "Updating the master menu in %s... " texinfo-master-menu "Done...updated all the menus. You may save the buffer."] 4 (#$ . 2189) "P"]) #@305 Search forward from point for node at any level lower than LEVEL. Search is limited to the end of the marked region, REGION-END, and to the end of the menu region for the level. 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. (defalias 'texinfo-find-lower-level-node #[(level region-end) "À`\nW…$ÃÄÅÆÇÈÉ\n \"A!°Ì\n!À#…$Í”b)‡" [t case-fold-search region-end re-search-forward "\\(^@node\\).*\n" "\\(\\(\\(^@c\\).*\n\\)" "\\|" "\\(^@ifinfo[ ]*\n\\)\\)?" eval assoc level texinfo-update-menu-lower-regexps texinfo-update-menu-region-end 1] 9 (#$ . 3118)]) #@265 Search forward from point for node at any higher level than argument LEVEL. Search is limited to the end of the marked region, REGION-END. 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. (defalias 'texinfo-find-higher-level-node #[(level region-end) "À\nØ„\nĘƒÅÆÀ#…8ÈyˆÀ‚8ÅÉÊËÌÍÎ\n\"A!°À#…8ÈyˆÀ)‡" [t case-fold-search level "top" "chapter" re-search-forward "^@node [ ]*top[ ]*\\(,\\|$\\)" region-end 0 "\\(^@node\\).*\n" "\\(\\(\\(^@c\\).*\n\\)" "\\|" "\\(^@ifinfo[ ]*\n\\)\\)?" eval assoc texinfo-update-menu-higher-regexps] 9 (#$ . 3763)]) #@500 Make a list of node names and their descriptions. Point is left at the end of the menu region, but the menu is not inserted. First argument is position from which to start making menu list; second argument is end of region in which to try to locate entries; third argument is the level of the nodes that are the entries. Node names and descriptions are dotted pairs of strings. Each pair is an element of the list. If the description does not exist, the element consists only of the node name. (defalias 'texinfo-make-menu-list #[(beginning end level) "bˆÁÃ\f \"ƒÆ ÇÈyˆB\nB‚É\n!)‡" [beginning nil new-menu-list texinfo-menu-locate-entry-p level end texinfo-copy-node-name "" 1 reverse] 3 (#$ . 4409)]) #@477 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. The function returns t if the node is found, else nil. It searches forward from point, and leaves point at the beginning of the node. The function finds entries of the same type. Thus `subsections' and `unnumberedsubsecs' will appear in the same menu. (defalias 'texinfo-menu-locate-entry-p #[(level search-end) "ÀÂÃÄÅÆÇÈ \n\"A!° À#…Ì”b)‡" [t case-fold-search re-search-forward "\\(^@node\\).*\n" "\\(\\(\\(^@c\\).*\n\\)" "\\|" "\\(^@ifinfo[ ]*\n\\)\\)?" eval assoc level texinfo-update-menu-same-level-regexps search-end 1] 9 (#$ . 5130)]) #@297 Return the node name as a string. Start with point at the beginning of the node line; copy the text after the node command up to the first comma on the line, if any, and return the text as a string. Leaves point at the beginning of the line. If there is no node name, returns an empty string. (defalias 'texinfo-copy-node-name #[nil "ŠÀvˆÁÂwˆ`ÃĊˆ`)Å#ƒ`S‚ˆ`{)‡" [1 " " nil search-forward "," t] 5 (#$ . 5909)]) #@323 Return the title of the section as a string. The title is used as a description line in the menu when one does not already exist. Move point to the beginning of the appropriate section line by going to the start of the text matched by last regexp searched for, which must have been done by `texinfo-menu-locate-entry-p'. (defalias 'texinfo-copy-section-title #[nil "À”bˆÁvˆÂÃwˆ`È`{‡" [7 1 " " nil] 2 (#$ . 6339)]) #@488 Move point to the beginning of the menu for this section, if any. Otherwise move point to the end of the first node of this section. Return t if a menu is found, nil otherwise. First argument is the position of the beginning of the section in which the menu will be located; second argument is the position of the first node within the section. If no menu is found, the function inserts two newlines just before the end of the section, and leaves point there where a menu ought to be. (defalias 'texinfo-old-menu-p #[(beginning first) "bˆÁ Ä#„ÅcˆÆyˆÇ‡È‡" [beginning re-search-forward "^@menu" first goto-end "\n\n" -2 nil t] 4 (#$ . 6764)]) #@485 Copy the old menu line descriptions that exist to the new menu. 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. (defalias 'texinfo-incorporate-descriptions #[(new-menu-list) "Á ƒ.ŠÄÅ@@ÆÇÈ@@ÉÊ°\nË#ƒ&@Ì\n!¡ˆ)A‰„ ‰*‡" [new-menu-list texinfo-menu-end end-of-menu new-menu-list-pointer re-search-forward "\\* \\(" "::" "\\|" ".*: " "[., \n]" "\\)" t texinfo-menu-copy-old-description] 10 (#$ . 7418)]) #@637 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. (defalias 'texinfo-incorporate-menu-entry-names #[(new-menu-list) "Á ƒ,ŠÄÅÆ@@ÇR\nÈ#ƒ%@ɔɕ{@@B ˆA)‚ ‰*‡" [new-menu-list texinfo-menu-end end-of-menu new-menu-list-pointer re-search-forward "\\* " "\\(.*\\): " "[., \n]" t 1] 5 (#$ . 8209)]) #@193 Return description field of old menu line as string. Point must be located just after the node name. Point left before description. Single argument, END-OF-MENU, is position limiting search. (defalias 'texinfo-menu-copy-old-description #[(end-of-menu) "ÀÁwˆÂÃ!ƒ#ÂÄ!„#`ŠÅÄÇ#ˆÈyˆÁˆ`){‡É‡" ["[:., \n ]+" nil looking-at "\\(\\w+\\|@\\)" "\\(^\\* \\|^@end menu\\)" re-search-forward end-of-menu t -1 ""] 5 (#$ . 9106)]) #@104 Return position of end of menu. Does not change location of point. Signal an error if not end of menu. (defalias 'texinfo-menu-end #[nil "ŠÀÁÂÃ#ƒ `‚ÄÅ!)‡" [re-search-forward "^@end menu" nil t error "Menu does not have an end."] 4 (#$ . 9534)]) #@219 Delete the old menu. Point must be in or after menu. First argument is position of the beginning of the section in which the menu will be located; second argument is the position of the first node within the section. (defalias 'texinfo-delete-old-menu #[(beginning first) "ÀÁ\n\"ˆ`ŠÃÄ \"ˆ`)|‡" [re-search-backward "^@menu" beginning re-search-forward "^@end menu" first] 4 (#$ . 9789)]) #@56 *Column at which descriptions start in a Texinfo menu. (defvar texinfo-column-for-description 32 (#$ . -10183)) #@471 Insert formatted menu at point. Indents the first line of the description, if any, to the value of texinfo-column-for-description. MENU-LIST has form: (("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. (defalias 'texinfo-insert-menu #[(menu-list node-name) "Àcˆ ƒDÂcˆ @@‰;ƒÄÅ \"cˆ‚%ÄÆ @ A#cˆ) @Aƒ:ÇÉ\"ˆÄÊ @A\"cˆËcˆ A‰„ÌcˆÍÎ#‡" ["@menu\n" menu-list "* " node-part format "%s::" "%s: %s." indent-to texinfo-column-for-description 2 "%s" "\n" "@end menu" message "Updated \"%s\" level menu following node: %s ... " level node-name] 5 (#$ . 10302)]) #@336 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. (defalias 'texinfo-start-menu-description #[nil "À‰‰‰ŠÅyˆÆÇŠÀˆ`)È#ƒ\"ÉÀwˆ`‚&ÊË!ˆÆÌŠÀˆ`)È#ƒHÍÎ!ƒ=ÊÏ!ˆÐÀxˆ\f`{‚¨ÆÑŠÀˆ`)È#ƒ¤ÉÀwˆ`ÒÓŠÔyˆ`)È#ƒ}ÍÎ!ƒrÊÏ!ˆÕÀxˆ\f`{‚¨ÒÖŠÔyˆ`)È#ˆ×Àxˆ\f`{‰GÅUƒžÊØ!ˆ‚¨Ùcˆ‚¨ÊØ!ˆÒÚ\nÖÛÜÝÞß°ÀÈ#ƒÎÔvˆÉÀwˆ`ÀˆÉÀxˆ`{‚ÒÊà!ˆ)Àˆ`ŠÉÀxˆ`)|ˆá\"ã\"ˆŠ c-‡" [nil title node-name end beginning 0 search-forward "* " t " " error "This is not a line in a menu!" "::" looking-at "[ ]*[^ \n]+" "Descriptive text already exists." ": " ":" re-search-forward "[., ]" 1 "., " ".*\n" " \n" "No node name on this line." "." "^@node[ ]+" "\\(" "\\(\\(^@c \\|^@comment\\).*\n\\)" "\\|" "\\(^@ifinfo[ ]*\n\\)" "\\)?" "Cannot find node to match node name in menu entry." indent-to texinfo-column-for-description 2] 10 (#$ . 11138) nil]) #@239 Indent every description in menu following point to COLUMN. Non-nil argument (prefix, if interactive) means indent every description in every menu in the region. Does not indent second and subsequent lines of a multi-line description. (defalias 'texinfo-indent-menu-description #[(column &optional region-p) "ŠŒ~ˆ„ÁÂ!ˆÃ\f!ˆÅÆ!‚7ÅÇ!ˆÈ bˆ`É Wƒ4Ê ƒ4ËyˆÃ\f!ˆ‚ÅÌ!*‡" [region-p re-search-forward "^@menu" texinfo-menu-indent-description column message "Indented descriptions in menu. You may save the buffer." "Indenting every menu description in region... " region-beginning region-end texinfo-locate-menu-p 1 "Indenting done. You may save the buffer."] 2 (#$ . 12244) "nIndent menu descriptions to (column number): \nP"]) #@258 Indent the Texinfo file menu description to TO-COLUMN-NUMBER. Start with point just after the word `menu' in the `@menu' line and leave point on the line before the `@end menu' line. Does not indent second and subsequent lines of a multi-line description. (defalias 'texinfo-menu-indent-description #[(to-column-number) "`‰ŠÁ bˆÂyˆ`)W…:ÃÄÁ Å#ƒ1`ÇÈwˆÉÊ!ƒ0`|ˆ jˆ)Ìyˆ`‰‚)‡" [beginning-of-next-line texinfo-menu-end 0 re-search-forward "\\* \\(.*::\\|.*: [^., \n]+[., ]\\)" t beginning-white-space " " nil looking-at "\\(@\\|\\w\\)+" to-column-number 1] 5 (#$ . 12982)]) #@1450 Make a master menu for a whole Texinfo file. Non-nil argument (prefix, if interactive) means first update all existing nodes and menus. Remove pre-existing master menu, if there is one. This function creates a master menu that follows the top node. The master menu includes every entry from all the other menus. It replaces any existing ordinary menu that follows the top node. If called with a non-nil argument, this function first updates all the menus in the buffer (incorporating descriptions from pre-existing menus) before it constructs the master menu. 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'. The master menu has the following format, which is adapted from the recommendation in the Texinfo Manual: * The first part contains the major nodes in the Texinfo file: the nodes for the chapters, chapter-like sections, and the major appendices. This includes the indices, so long as they are in chapter-like sections, such as unnumbered sections. * The second and subsequent parts contain a listing of the other, lower level menus, in order. This way, an inquirer can go directly to a particular node if he or she is searching for specific information. Each of the menus in the detailed node listing is introduced by the title of the section containing the menu. (defalias 'texinfo-master-menu #[(update-all-nodes-menus-p) "À~ˆebˆÂÃÄÀ#„ÅÆ!ˆŠÂÇÄÀ#„ ÅÈ!ˆ`) Â\n À#ƒGË”bˆŠÌ bˆËyˆÍuˆ`)`|ˆ))ƒyÐÑÒ \"ˆÓÔ!ˆÕdÀ\"ˆebˆÖÀ!ˆÐ×Ò \"ˆÓÔ!ˆÕdÀ\"ˆebˆØÀ!ˆÐÙÒ \"ˆÓÔ!ˆebˆÚÛ !ˆŠebˆÂ\nÄÀ#ƒ¥Ë”bˆÜcˆÝ ˆebˆÂÞ!ˆÍyˆÝ ˆÂß!ˆàyˆÝ ˆ)Ðá!)‡" [t case-fold-search re-search-forward "^@node [ ]*top[ ]*\\(,\\|$\\)" nil error "This buffer needs a Top node!" "^@node" "Too few nodes for a master menu!" first-chapter texinfo-master-menu-header 0 texinfo-menu-end -1 end-of-detailed-menu-descriptions update-all-nodes-menus-p message "Making a master menu in %s ...first updating all nodes... " buffer-name sleep-for 2 push-mark texinfo-update-node "Updating all menus in %s ... " texinfo-make-menu "Now making the master menu in %s... " texinfo-insert-master-menu-list texinfo-master-menu-list "\n" delete-blank-lines "^@menu" "^@end menu" 1 "Done...completed making master menu. You may save the buffer."] 4 (#$ . 13571) "P"]) #@391 Return a list of menu entries and header lines for the master menu. Start with the menu for chapters and indices and then find each following menu and the title of the node preceding that menu. The master menu list has this form: (((... "entry-1-2" "entry-1") "title-1") ((... "entry-2-2" "entry-2-1") "title-2") ...) However, there does not need to be a title field. (defalias 'texinfo-master-menu-list #[nil "À ƒÃ Ä D B‚Å !)‡" [nil master-menu-list texinfo-locate-menu-p texinfo-copy-menu texinfo-copy-menu-title reverse] 2 (#$ . 15972)]) #@58 Format and insert the master menu in the current buffer. (defalias 'texinfo-insert-master-menu-list #[(master-menu-list) "ebˆÀÁÂÃ#„ÄÅ!ˆŠÀÆ!ˆ`)ÀÈÃ#„%ÄÉ!ˆ)Êyˆ`ŠÀË!ˆ`)|ˆŠÌcˆÍ@@!ÐÑ\"ˆƒ[Ò@Ó±ˆA‰„JA‰@@ƒjcˆƒ¨ÐÕ@A@\"ˆÓ@A@Ö±ˆÍ@@!‰ƒŸÒ@Ó±ˆA‰„ŽA‰„o×c)‡" [re-search-forward "^@node [ ]*top[ ]*\\(,\\|$\\)" nil t error "This buffer needs a Top node!" "^@node\\|^@include" first-chapter "^@menu" "Buffer lacks ordinary `Top' menu in which to insert master." 0 "^@end menu" "\n@menu\n" reverse master-menu-list this-very-menu-list message "Inserting chapter menu entry: %s ... " "* " "\n" texinfo-master-menu-header "Inserting menu for %s .... " "\n\n" "@end menu\n\n"] 5 (#$ . 16548)]) #@115 String inserted before lower level entries in Texinfo master menu. It comes after the chapter-level menu entries. (defvar texinfo-master-menu-header "\n --- The Detailed Node Listing ---\n" (#$ . 17284)) #@174 Find the next menu in the texinfo file. If found, leave point after word `menu' on the `@menu' line, and return t. If a menu is not found, do not move point and return nil. (defalias 'texinfo-locate-menu-p #[nil "ÀÁÂÃ#‡" [re-search-forward "\\(^@menu\\)" nil t] 4 (#$ . 17495)]) #@142 Return the title of the section preceding the menu as a string. If such a title cannot be found, return an empty string. Do not move point. (defalias 'texinfo-copy-menu-title #[nil "ÀŠÂÃÄ ÆRÇÀ#ƒ\"ÈyˆÉvˆÊÇwˆ`Lj`{‚#Ë*‡" [t case-fold-search re-search-backward "\\(^@top" "\\|" texinfo-section-types-regexp "\\)" nil 0 1 " " ""] 5 (#$ . 17781)]) #@172 Return the entries of an existing menu as a list. Start with point just after the word `menu' in the `@menu' line and leave point on the line before the `@end menu' line. (defalias 'texinfo-copy-menu #[nil "À Š bˆÄÅÀÆ#„ÇÈ!ˆ`) ` Wƒ;ÊÅ Æ#ƒ`ŠÊËÀÆ#ˆ`ÌZ){ B‚ +‡" [nil this-menu-list texinfo-menu-end end-of-menu re-search-backward "^* " t error "No entries in menu." last-entry re-search-forward "\\(^* \\|^@e\\)" 3] 5 (#$ . 18136)]) #@316 Return the specific type of next section, as a string. For example, "unnumberedsubsec". Return "top" for top node. Searches forward for a section. Hence, point must be before the 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. (defalias 'texinfo-specific-section-type #[nil "ÀŠÂÃÄÀ#ƒÅ‚)ÂÄÀ#ƒ&ÇÈyˆ`TÉvˆ`\"‚)ÊË!*‡" [t case-fold-search re-search-forward "^@node [ ]*top[ ]*\\(,\\|$\\)" nil "top" texinfo-section-types-regexp buffer-substring-no-properties 0 1 error "texinfo-specific-section-type: Chapter or section not found."] 4 (#$ . 18585)]) #@133 Return the general hierarchal level of the next node in a texinfo file. Thus, a subheading or appendixsubsec is of type subsection. (defalias 'texinfo-hierarchic-level #[nil "ÀÂà \f\"A)‡" [t case-fold-search assoc texinfo-specific-section-type texinfo-section-to-generic-alist] 3 (#$ . 19234)]) #@266 Locate beginning of higher level section this section is within. Return position of the beginning of the node line; do not move point. Thus, if this level is subsection, searches backwards for section node. Only argument is a string of the general type of section. (defalias 'texinfo-update-menu-region-beginning #[(level) "À\nØ„\nĘƒ ŠebˆÅÆÇÀ#ˆÈyˆ`)‚6ŠÉÊËÌÍÎÏ\n\"A!°ÇÑ#ˆ`))‡" [t case-fold-search level "top" "chapter" re-search-forward "^@node [ ]*top[ ]*\\(,\\|$\\)" nil 0 re-search-backward "\\(^@node\\).*\n" "\\(\\(\\(^@c\\).*\n\\)" "\\|" "\\(^@ifinfo[ ]*\n\\)\\)?" eval assoc texinfo-update-menu-higher-regexps goto-beginning] 9 (#$ . 19537)]) #@299 Locate end of higher level section this section is within. Return position; do not move point. Thus, if this level is a subsection, find the node for the section this subsection is within. If level is top or chapter, returns end of file. Only argument is a string of the general type of section. (defalias 'texinfo-update-menu-region-end #[(level) "ÀŠÂÃÄÅÆÇÈ \n\"A!°ËÌ#ƒÍ”‚d*‡" [t case-fold-search re-search-forward "\\(^@node\\).*\n" "\\(\\(\\(^@c\\).*\n\\)" "\\|" "\\(^@ifinfo[ ]*\n\\)\\)?" eval assoc level texinfo-update-menu-higher-regexps nil goto-end 1] 9 (#$ . 20205)]) #@334 Locate first node of the section the menu will be placed in. Return position; do not move point. The menu will be located just before this position. First argument is the position of the beginning of the section in which the menu will be located; second argument is the position of the end of that region; it limits the search. (defalias 'texinfo-menu-first-node #[(beginning end) "ŠbˆÁyˆÂÃ\fÅ#ˆÆyˆ`)‡" [beginning 1 re-search-forward "^@node" end t 0] 4 (#$ . 20800)]) #@192 *An alist of specific and corresponding generic Texinfo section types. The keys are strings specifying specific types of section; the values are strings of their corresponding general types. (defvar texinfo-section-to-generic-alist (quote (("top" . "top") ("chapter" . "chapter") ("unnumbered" . "chapter") ("majorheading" . "chapter") ("chapheading" . "chapter") ("appendix" . "chapter") ("section" . "section") ("unnumberedsec" . "section") ("heading" . "section") ("appendixsec" . "section") ("subsection" . "subsection") ("unnumberedsubsec" . "subsection") ("subheading" . "subsection") ("appendixsubsec" . "subsection") ("subsubsection" . "subsubsection") ("unnumberedsubsubsec" . "subsubsection") ("subsubheading" . "subsubsection") ("appendixsubsubsec" . "subsubsection"))) (#$ . -21282)) #@74 Regexp matching chapter, section, other headings (but not the top node). (defvar texinfo-section-types-regexp "^@\\(chapter \\|sect\\|subs\\|subh\\|unnum\\|major\\|chapheading \\|heading \\|appendix\\)" (#$ . 22084)) #@70 Regular expression matching just the Texinfo chapter level headings. (defvar texinfo-chapter-level-regexp "chapter\\|unnumbered \\|appendix \\|majorheading\\|chapheading" (#$ . 22307)) #@70 Regular expression matching just the Texinfo section level headings. (defvar texinfo-section-level-regexp "section\\|unnumberedsec\\|heading \\|appendixsec" (#$ . 22498)) #@73 Regular expression matching just the Texinfo subsection level headings. (defvar texinfo-subsection-level-regexp "subsection\\|unnumberedsubsec\\|subheading\\|appendixsubsec" (#$ . 22675)) #@76 Regular expression matching just the Texinfo subsubsection level headings. (defvar texinfo-subsubsection-level-regexp "subsubsection\\|unnumberedsubsubsec\\|subsubheading\\|appendixsubsubsec" (#$ . 22869)) #@183 *Regexps for searching for same level sections in a Texinfo file. The keys are strings specifying the general hierarchical level in the document; the values are regular expressions. (defvar texinfo-update-menu-same-level-regexps (quote (("top" . "top[ ]+") ("chapter" concat "\\(^@\\)\\(" texinfo-chapter-level-regexp "\\)[ ]*") ("section" concat "\\(^@\\)\\(" texinfo-section-level-regexp "\\)[ ]*") ("subsection" concat "\\(^@\\)\\(" texinfo-subsection-level-regexp "\\)[ ]+") ("subsubsection" concat "\\(^@\\)\\(" texinfo-subsubsection-level-regexp "\\)[ ]+"))) (#$ . -23082)) #@185 *Regexps for searching for higher level sections in a Texinfo file. The keys are strings specifying the general hierarchical level in the document; the values are regular expressions. (defvar texinfo-update-menu-higher-regexps (quote (("top" . "^@node [ ]*DIR") ("chapter" . "^@node [ ]*top[ ]*\\(,\\|$\\)") ("section" concat "\\(^@\\(" texinfo-chapter-level-regexp "\\)[ ]*\\)") ("subsection" concat "\\(^@\\(" texinfo-section-level-regexp "\\|" texinfo-chapter-level-regexp "\\)[ ]*\\)") ("subsubsection" concat "\\(^@\\(" texinfo-subsection-level-regexp "\\|" texinfo-section-level-regexp "\\|" texinfo-chapter-level-regexp "\\)[ ]*\\)"))) (#$ . -23674)) #@184 *Regexps for searching for lower level sections in a Texinfo file. The keys are strings specifying the general hierarchical level in the document; the values are regular expressions. (defvar texinfo-update-menu-lower-regexps (quote (("top" concat "\\(^@\\(" texinfo-chapter-level-regexp "\\|" texinfo-section-level-regexp "\\|" texinfo-subsection-level-regexp "\\|" texinfo-subsubsection-level-regexp "\\)[ ]*\\)") ("chapter" concat "\\(^@\\(" texinfo-section-level-regexp "\\|" texinfo-subsection-level-regexp "\\|" texinfo-subsubsection-level-regexp "\\)[ ]*\\)") ("section" concat "\\(^@\\(" texinfo-subsection-level-regexp "\\|" texinfo-subsubsection-level-regexp "\\)[ ]+\\)") ("subsection" concat "\\(^@\\(" texinfo-subsubsection-level-regexp "\\)[ ]+\\)") ("subsubsection" . "nothing lower"))) (#$ . -24345)) #@822 Without any prefix argument, update the node in which point is located. Non-nil argument (prefix, if interactive) means update the nodes in the marked region. The functions for creating or updating nodes and menus, and their keybindings, are: texinfo-update-node (&optional region-p) \[texinfo-update-node] texinfo-every-node-update () \[texinfo-every-node-update] texinfo-sequential-node-update (&optional region-p) texinfo-make-menu (&optional region-p) \[texinfo-make-menu] texinfo-all-menus-update () \[texinfo-all-menus-update] texinfo-master-menu () texinfo-indent-menu-description (column &optional region-p) The `texinfo-column-for-description' variable specifies the column to which menu descriptions are indented. Its default value is 32. (defalias 'texinfo-update-node #[(&optional region-p) "„Á‰ÄÅeÆ#„ÇÈ!ˆÉ ˆÊË!*‡Á‰Ì Í Uƒ4ÇÐ!ˆŒ}ˆbˆÑ`Æ\"ˆÒÅdÆ#ƒUÓyˆÉ ˆ‚DÊÔ!-‡" [region-p nil auto-fill-hook auto-fill-function re-search-backward "^@node" t error "Node line not found before this position." texinfo-update-the-node message "Done...updated the node. You may save the buffer." region-beginning region-end end beginning "Please mark a region!" push-mark re-search-forward 0 "Done...updated nodes in region. You may save the buffer."] 4 (#$ . 25172) "P"]) #@38 Update every node in a Texinfo file. (defalias 'texinfo-every-node-update #[nil "ŠÀdÁ\"ˆebˆÁÃÁ!ˆ)ÄÅ!)‡" [push-mark t mark-active texinfo-update-node message "Done...updated every node. You may save the buffer."] 3 (#$ . 26538) nil]) #@107 Update one node. Point must be at the beginning of node line. Leave point at the end of the node line. (defalias 'texinfo-update-the-node #[nil "À ˆÁ ˆÂÃÄ \"ˆŒ~ˆÅÇ É!\nË!\f͘ƒ.Î ‚NÏ\n\fÐ$ˆÏ\n\fÑ$ˆÏ\n\fÒ$ˆÓ -‡" [texinfo-check-for-node-name texinfo-delete-existing-pointers message "Updating node: %s ... " texinfo-copy-node-name t case-fold-search texinfo-hierarchic-level level texinfo-update-menu-region-beginning beginning texinfo-update-menu-region-end end "top" texinfo-top-pointer-case texinfo-insert-pointer next previous up texinfo-clean-up-node-line] 5 (#$ . 26785)]) #@300 Insert pointers in the Top node. This is a special case. The `Next' pointer is a pointer to a chapter or section at a lower hierarchical level in the file. The `Previous' and `Up' pointers are to `(dir)'. Point must be at the beginning of the node line, and is left at the end of the node line. (defalias 'texinfo-top-pointer-case #[nil "À ˆÁŠÂÃÄÅ#ƒÆyˆÇ ‚È)ɱ‡" [texinfo-clean-up-node-line ", " re-search-forward "^@node" nil t 0 texinfo-copy-node-name " " ", (dir), (dir)"] 5 (#$ . 27397)]) #@132 Determine whether the node has a node name. Prompt for one if not. Point must be at beginning of node line. Does not move point. (defalias 'texinfo-check-for-node-name #[nil "ŠÀ ÂvˆÃÄwˆÅÆ!?…ÇÈ \" Ê ±)*‡" [texinfo-copy-next-section-title initial 1 " " nil looking-at "[^, \n ]+" read-from-minibuffer "Node name (use no @, commas, colons, or apostrophes): " node-name " "] 3 (#$ . 27905)]) #@250 Delete `Next', `Previous', and `Up' pointers. Starts from the current position of the cursor, and searches forward on the line for a comma and if one is found, deletes the rest of the line, including the comma. Leaves point at beginning of line. (defalias 'texinfo-delete-existing-pointers #[nil "ŠÀˆ`)Âà Ä#ƒ`S |ˆ)ÅyˆÀ‡" [nil eol-point search-forward "," t 0] 4 (#$ . 28309)]) #@840 Move point to section associated with next, previous, or up pointer. Return type of pointer (either 'normal or 'no-pointer). The first and second arguments bound the search for a pointer to the beginning and end, respectively, of the enclosing higher level section. The third argument is a string specifying the general kind of section such as "chapter or "section". When looking for the `Next' pointer, the section found will be at the same hierarchical level in the Texinfo file; when looking for the `Previous' pointer, the section found will be at the same or higher hierarchical level in the Texinfo file; when looking for the `Up' pointer, the section found will be at some level higher in the Texinfo file. The fourth argument (one of 'next, 'previous, or 'up) specifies whether to find the `Next', `Previous', or `Up' pointer. (defalias 'texinfo-find-pointer #[(beginning end level direction) "À\nÃ=ƒ'ÄyˆÅÆÇÈÉ\n \"A!Q\fÀ#ƒ#Í‚ŒÎ‚Œ\nÏ=ƒZÐÑÆÇÈÉ\n \"A!ÒÆÇÈÉ\n\"A!ÒÔÕ° À#ƒVÍ‚ŒÎ‚Œ\n×=ƒ‰ÐÑÆÇÈÉ\n\"A!ÒÔÕ°ŠbˆØyˆ`)À#ƒ…Í‚ŒÎ‚ŒÙÚ!)‡" [t case-fold-search direction next 3 re-search-forward "\\(^@node\\).*\n" "\\(\\(\\(^@c\\).*\n\\)\\|\\(^@ifinfo[ ]*\n\\)\\)?" eval assoc level texinfo-update-menu-same-level-regexps end normal no-pointer previous re-search-backward "\\(" "\\|" texinfo-update-menu-higher-regexps "^@node [ ]*top[ ]*\\(,\\|$\\)" "\\)" beginning up 0 error "texinfo-find-pointer: lack proper arguments"] 12 (#$ . 28700)]) #@119 Return the node name preceding the section command. The argument is the kind of section, either normal or no-pointer. (defalias 'texinfo-pointer-name #[(kind) "À\nÃ=ƒÀˆÄÅŠÆy)Ç#ˆÈ ‚\"\nÉ=ƒ\"Ê )‡" [nil name kind normal re-search-backward "^@node" -3 t texinfo-copy-node-name no-pointer " "] 4 (#$ . 30174)]) #@424 Insert the `Next', `Previous' or `Up' node name at point. Move point forward. The first and second arguments bound the search for a pointer to the beginning and end, respectively, of the enclosing higher level section. The third argument is the hierarchical level of the Texinfo file, a string such as "section". The fourth argument is direction towards which the pointer is directed, one of `next, `previous, or 'up. (defalias 'texinfo-insert-pointer #[(beginning end level direction) "ÀˆÁŠÂÃ\f $!)±‡" [nil ", " texinfo-pointer-name texinfo-find-pointer beginning end level direction] 7 (#$ . 30495)]) #@51 Remove extra commas, if any, at end of node line. (defalias 'texinfo-clean-up-node-line #[nil "ÀˆÁÀxˆ`ŠÀˆ`)|‡" [nil ", "] 2 (#$ . 31115)]) #@717 Update one node (or many) in a Texinfo file with sequential pointers. This function causes the `Next' or `Previous' pointer to point to the immediately preceding or following node, even if it is at a higher or lower hierarchical level in the document. Continually pressing `n' or `p' takes you straight through the file. Without any prefix argument, update the node in which point is located. Non-nil argument (prefix, if interactive) means update the nodes in the marked region. This command makes it awkward to navigate among sections and subsections; it should be used only for those documents that are meant to be read like a novel rather than a reference, and for which the Info `g*' command is inadequate. (defalias 'texinfo-sequential-node-update #[(&optional region-p) "„Á‰ÄÅeÆ#„ÇÈ!ˆÉ ˆÊË!*‡Á‰Ì Í Uƒ4ÇÐ!ˆŒ}ˆbˆÑ`Æ\"ˆÒÅdÆ#ƒUÓyˆÉ ˆ‚DÊÔ!-‡" [region-p nil auto-fill-hook auto-fill-function re-search-backward "^@node" t error "Node line not found before this position." texinfo-sequentially-update-the-node message "Done...sequentially updated the node . You may save the buffer." region-beginning region-end end beginning "Please mark a region!" push-mark re-search-forward 0 "Done...updated the nodes in sequence. You may save the buffer."] 4 (#$ . 31263) "P"]) #@169 Update one node such that the pointers are sequential. A `Next' or `Previous' pointer points to any preceding or following node, regardless of its hierarchical level. (defalias 'texinfo-sequentially-update-the-node #[nil "À ˆÁ ˆÂÃÄ \"ˆŒ~ˆÅÇ ‰ɘƒ!Ê ‚5ËÌ\"ˆËÍ\"ˆËÎ\"ˆÏ +‡" [texinfo-check-for-node-name texinfo-delete-existing-pointers message "Sequentially updating node: %s ... " texinfo-copy-node-name t case-fold-search texinfo-hierarchic-level level "top" texinfo-top-pointer-case texinfo-sequentially-insert-pointer next previous up texinfo-clean-up-node-line] 4 (#$ . 32569)]) #@591 Find next or previous pointer sequentially in Texinfo file, or up pointer. Move point to section associated with the pointer. Find point even if it is in a different section. Return type of pointer (either 'normal or 'no-pointer). The first argument is a string specifying the general kind of section such as "chapter or "section". The section found will be at the same hierarchical level in the Texinfo file, or, in the case of the up pointer, some level higher. The second argument (one of 'next, 'previous, or 'up) specifies whether to find the `Next', `Previous', or `Up' pointer. (defalias 'texinfo-sequentially-find-pointer #[(level direction) "À\nÃ=ƒÄyˆÅdÀ#ƒÇ‚UÈ‚U\nÉ=ƒ3ÊeÀ#ƒ/Ç‚UÈ‚U\nË=ƒRÊÌÍ\"A!À#ƒNÇ‚UÈ‚UÑÒ!)‡" [t case-fold-search direction next 3 re-search-forward texinfo-section-types-regexp normal no-pointer previous re-search-backward up eval assoc level texinfo-update-menu-higher-regexps beginning error "texinfo-sequential-find-pointer: lack proper arguments"] 5 (#$ . 33170)]) #@244 Insert the `Next', `Previous' or `Up' node name at point. Move point forward. The first argument is the hierarchical level of the Texinfo file, a string such as "section". The second argument is direction, one of `next, `previous, or 'up. (defalias 'texinfo-sequentially-insert-pointer #[(level direction) "ÀˆÁŠÂÃ\f \"!)±‡" [nil ", " texinfo-pointer-name texinfo-sequentially-find-pointer level direction] 5 (#$ . 34202)]) #@251 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. (defalias 'texinfo-insert-node-lines #[(beginning end &optional title-p) "À‰‰‰ÅÇ\"ˆÈ  bˆÊ Æ#ƒŠ\fƒ6ÍyˆÎvˆÏÀwˆ`ŠÀˆ`){ÐÑ †BŠÒyˆ`)Ç#ƒMÎvˆ‚WÍyˆÓcˆÔÎ!ˆ\fƒvÏÀwˆÕÖ!„vÍyˆÎvˆ×\n±ˆØÙ\n\"ˆÊ ŠÚyˆ`)Ç#ˆ`Îyˆ‚Û !ˆ\fƒšØÜ!‚ØÝ!,‡" [nil last-section-position title end-marker beginning-marker push-mark end t mark-marker beginning re-search-forward texinfo-section-types-regexp title-p 0 1 " " re-search-backward "^@node" -2 "@node\n" backward-char looking-at "[^, \n ]+" " " message "Inserted title %s ... " 3 set-mark "Done inserting node lines and titles. You may save the buffer." "Done inserting node lines. You may save the buffer."] 4 (#$ . 34638) "r\nP"]) #@52 Return a list of the included files in OUTER-FILE. (defalias 'texinfo-multi-file-included-list #[(outer-file) "CÁŠÄÅ!!ˆ~ˆebˆÆÇÁÈ#ƒ/ÉÁwˆ`ÁˆÉÁxˆ\n`{ B‚ Ÿ+‡" [outer-file nil start included-file-list switch-to-buffer find-file-noselect re-search-forward "^@include" t " "] 4 (#$ . 35571)]) #@200 Return the name of the immediately following section as a string. Start with point at the beginning of the node line. Leave point at the same place. If there is no title, returns an empty string. (defalias 'texinfo-copy-next-section-title #[nil "ŠÀˆŠÁÂÀÃ#…Ä”)†dÁ Ã#ƒ1ÄyˆÇvˆÈÀwˆ`Àˆ`{‚2É*‡" [nil re-search-forward "\\(^@node\\)" t 0 node-end texinfo-section-types-regexp 1 " " ""] 5 (#$ . 35875)]) #@744 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 files included in the outer file with `@include' commands. If optional arg UPDATE-EVERYTHING non-nil, update every menu and pointer in each of the included files. Also update the `Top' level node pointers of the outer file. Requirements: * the first file in the FILES list must be the outer file, * each of the included files must contain exactly one highest hierarchical level node, * this node must be the first node in the included file, * each highest hierarchical level node must be of the same type. Thus, normally, each included file contains one, and only one, chapter. (defalias 'texinfo-multi-file-update #[(files &optional update-everything) "ÀÁÄÅA@!!ˆ~ˆebˆÇÈÁÀ#„ ÉÊË \"ˆÌyˆÍ ˆÎ ‰ÐÑyˆB\nBÄÅ@!!ˆebˆÇÒÁÀ#„JÉÓ!ˆÌyˆÔ ˆÁˆÕÖ±ˆÌyˆ×A‰ƒîA„uЂ¤ÄÅA@!!ˆ~ˆebˆÇÈÁÀ#„‘ÉÊË \"ˆÌyˆÍ ˆÎ ‰ÐÑyˆB\nBÄÅ@!!ˆebˆÇÈÁÀ#„½ÉÊË \"ˆÌyˆƒÉÚÀ!ˆÌyˆÔ ˆÁˆÕÕÕ±ˆÌyˆÎ A‰„i\nŸ*‡" [t nil menu-list case-fold-search switch-to-buffer find-file-noselect files re-search-forward "^@node" error "No `@node' line found in %s !" buffer-name 0 texinfo-check-for-node-name texinfo-copy-node-name next-node-name "" 1 "^@node [ ]*top[ ]*\\(,\\|$\\)" "This buffer needs a Top node!" texinfo-delete-existing-pointers ", " ", (dir), (dir)" "Top" previous-node-name update-everything texinfo-all-menus-update up-node-name] 7 (#$ . 36293)]) #@137 Insert formatted main menu at point. Indents the first line of the description, if any, to the value of texinfo-column-for-description. (defalias 'texinfo-multi-files-insert-main-menu #[(menu-list) "Àcˆ ƒDÂcˆ @@‰;ƒÄÅ \"cˆ‚%ÄÆ @ A#cˆ) @Aƒ:ÇÉ\"ˆÄÊ @A\"cˆËcˆ A‰„Ìc‡" ["@menu\n" menu-list "* " node-part format "%s::" "%s: %s." indent-to texinfo-column-for-description 2 "%s" "\n" "@end menu"] 5 (#$ . 37815)]) #@257 Return master menu list from files in FILES-LIST. Menu entries in each file collected using `texinfo-master-menu-list'. The first file in FILES-LIST must be the outer file; the others must be the files included within it. A main menu must already exist. (defalias 'texinfo-multi-file-master-menu-list #[(files-list) "ŠÀ\nƒ#ÃÄ\n@!!ˆÅÆp\"ˆebˆÇ È \"\nA‰„ *‡" [nil master-menu-list files-list switch-to-buffer find-file-noselect message "Working on: %s " append texinfo-master-menu-list] 4 (#$ . 38240)]) #@1503 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: * this command does NOT save any files--you must save the outer file and any modified, included files. * except for the `Top' node, this command does NOT handle any pre-existing nodes in the outer file; hence, indices must be enclosed in an included file. Requirements: * each of the included files must contain exactly one highest hierarchical level node, * this highest node must be the first node in the included file, * each highest hierarchical level node must be of the same type. Thus, normally, each included file contains one, and only one, chapter. (defalias 'texinfo-multiple-files-update #[(outer-file &optional update-everything make-master-menu) "À !‰ÄÄÄÈ Ê  \"ÌÍ\n@!!ˆÎeŠÏÐ!ˆÑyˆ`)\"ƒFÒ !ˆÑyˆ`ŠÏÓ!ˆ`)|ˆÔ !ˆ‚JÔ !ˆƒzebˆÏÄ×#ƒtÑ”bˆŠØ bˆÑyˆÙuˆ`)`|ˆ)ÛÜ\n!!ˆ.ŠebˆÏÝ!ˆÙyˆÞcˆß ˆÏÓ!ˆàyˆÞcˆß ˆ)áâ!‡" [texinfo-multi-file-included-list outer-file included-file-list files nil main-menu-list next-node-name previous-node-name "Top" up-node-name texinfo-multi-file-update update-everything switch-to-buffer find-file-noselect texinfo-old-menu-p re-search-forward "^@include" 0 texinfo-incorporate-descriptions "^@end menu" texinfo-multi-files-insert-main-menu make-master-menu texinfo-master-menu-header t texinfo-menu-end -1 end-of-detailed-menu-descriptions texinfo-insert-master-menu-list texinfo-multi-file-master-menu-list "^@menu" "\n" delete-blank-lines 1 message "Multiple files updated."] 5 (#$ . 38757) (byte-code "ÀÁ \" „ Ä‚ <ƒÅ‚ §…ÆB‡" [read-string "Name of outer `include' file: " buffer-file-name current-prefix-arg (nil nil) (t nil) (t t)] 3)]) (provide (quote texnfo-upd)) emacs-19.30/lisp/text-mode.elc100666 13437 1 7464 6024240272 14615 0ustar jimbdaemon;ELC ;;; compiled by roland@whiz-bang.gnu.ai.mit.edu on Sat Sep 9 03:22:33 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/text-mode.el ;;; emacs version 19.29.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`text-mode.el' was compiled for Emacs 19.29 or later")) #@39 Syntax table used while in text mode. (defvar text-mode-syntax-table nil (#$ . 482)) #@39 Abbrev table used while in text mode. (defvar text-mode-abbrev-table nil (#$ . 573)) (byte-code "ÀÁÂ\"ˆ „Ä ÅÆÇ #ˆÅÈÇ #ˆÅÉÊ #ˆÂ‡" [define-abbrev-table text-mode-abbrev-table nil text-mode-syntax-table make-syntax-table modify-syntax-entry 34 ". " 92 39 "w "] 4) #@143 Keymap for Text mode. Many other modes, such as Mail mode, Outline mode and Indented Text mode, inherit all the commands defined in this map. (defvar text-mode-map nil (#$ . 848)) (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÁ‡" [text-mode-map make-sparse-keymap define-key " " ispell-complete-word " " tab-to-tab-stop "s" center-line "S" center-paragraph] 4) #@190 Major mode for editing text intended for humans to read. Special commands: \{text-mode-map} Turning on Text mode calls the value of the variable `text-mode-hook', if that value is non-nil. (defalias 'text-mode #[nil "À ˆÁ\n!ˆÃÅÉ\n!ˆËÌ!‡" [kill-all-local-variables use-local-map text-mode-map "Text" mode-name text-mode major-mode text-mode-abbrev-table local-abbrev-table set-syntax-table text-mode-syntax-table run-hooks text-mode-hook] 2 (#$ . 1216) nil]) #@103 Keymap for Indented Text mode. All the commands defined in Text mode are inherited unless overridden. (defvar indented-text-mode-map nil (#$ . 1689)) (byte-code "„Á Ã\nÄÅ#ˆ\n¤)Á‡" [indented-text-mode-map make-sparse-keymap newmap define-key " " indent-relative text-mode-map] 4) #@340 Major mode for editing text with indented paragraphs. In this mode, paragraphs are delimited only by blank lines. You can thus get the benefit of adaptive filling (see the variable `adaptive-fill-mode'). \{indented-text-mode-map} Turning on `indented-text-mode' calls the value of the variable `text-mode-hook', if that value is non-nil. (defalias 'indented-text-mode #[nil "À ˆÁ\n!ˆÃÄÅ\"ˆ\fÇ!ˆÉÊ!ˆË\nÉÌ!ˆÍP\fÉÏ!ˆ\fÁ!ˆÑÓÕÖ×\"‡" [kill-all-local-variables use-local-map text-mode-map define-abbrev-table text-mode-abbrev-table nil local-abbrev-table set-syntax-table text-mode-syntax-table make-local-variable indent-line-function indent-relative-maybe paragraph-start "$\\|" page-delimiter paragraph-separate indented-text-mode-map "Indented Text" mode-name indented-text-mode major-mode run-hooks text-mode-hook indented-text-mode-hook] 3 (#$ . 1982) nil]) #@96 Center each nonblank line in the paragraph at or after point. See `center-line' for more info. (defalias 'center-paragraph #[nil "ŠÀ ˆn„\fÁÂ!ˆ`Ä ˆÅ` \"*‡" [forward-paragraph newline 1 end backward-paragraph center-region] 3 (#$ . 2863) nil]) #@84 Center each nonblank line starting in the region. See `center-line' for more info. (defalias 'center-region #[(from to) " Vƒ \n)ŠŒ }ˆbˆm?….ŠÃÄwˆl)„(Å ˆÆyˆ‚*‡" [from to tem " " nil center-line 1] 2 (#$ . 3113) "r"]) #@241 Center the line point is on, within the width specified by `fill-column'. This means adjusting the indentation so that it equals the distance between the end of the text and `fill-column'. The argument NLINES says how many lines to center. (defalias 'center-line #[(&optional nlines) "ƒÁ!Â=?…hŠÃ ÄÂyˆÇ ˆÄˆÇ ˆiZ ZÂVƒ?ÉZ ZÊ¥\\!ˆ+„J‰‚ ÂVƒYSËyˆ‚ÂWƒTÌyˆ‚‡" [nlines prefix-numeric-value 0 current-left-margin nil line-length lm delete-horizontal-space fill-column indent-line-to 2 1 -1] 5 (#$ . 3349) "P"]) emacs-19.30/lisp/thingatpt.elc100666 12120 1 7752 6003663764 14571 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Jul 21 04:40:16 1995 ;;; from file /home/fsf/rms/e19/lisp/thingatpt.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`thingatpt.el' was compiled for Emacs 19.29 or later")) (provide (quote thingatpt)) #@44 Move forward to the end of the next THING. (defalias 'forward-thing #[(THING &optional N) "ÁN†\fÂÃÄ\"!Å !ƒ †Ç!‚\"ÈÉ\")‡" [THING forward-op intern-soft format "forward-%s" fboundp N 1 error "Can't determine how to move over %ss"] 4 (#$ . 504)]) #@331 Determine the start and end buffer locations for the THING at point, where THING is an entity for which there is a either a corresponding forward-THING operation, or corresponding beginning-of-THING and end-of-THING operations, eg. 'word, 'sentence, 'defun. Return a cons cell '(start . end) giving the start and end positions. (defalias 'bounds-of-thing-at-point #[(THING) "`ÁÂÃ)‡" [orig nil (byte-code "ŠÁN† ˆ`ÃN†Ä ˆ` …4…4 X…4W…4 B+‡" [THING end-op #[nil "À Â\"‡" [forward-thing THING 1] 3] beginning-op #[nil "À Â\"‡" [forward-thing THING -1] 3] beg end orig] 3) ((error))] 3 (#$ . 767)]) #@90 Return the THING at point, where THING is an entity defined by bounds-of-thing-at-point. (defalias 'thing-at-point #[(THING) "À !‰… \n@\nA{)‡" [bounds-of-thing-at-point THING bounds] 3 (#$ . 1393)]) (defalias 'beginning-of-thing #[(THING) "À !‰„ ÃÄ \"ˆ\n@b)‡" [bounds-of-thing-at-point THING bounds error "No %s here"] 4]) (defalias 'end-of-thing #[(THING) "À !‰„ ÃÄ \"ˆ\nAb)‡" [bounds-of-thing-at-point THING bounds error "No %s here"] 4]) (put (quote line) (quote beginning-op) #[nil "nƒÀy‡ÁyˆÂ‡" [-1 0 nil] 1]) (defalias 'in-string-p #[nil "`ŠÁ ˆÂÃ`\"8*‡" [orig beginning-of-defun 3 parse-partial-sexp] 4]) (defalias 'end-of-sexp #[nil "`fz‰Á=„Â=ƒà ƒÄu‚ÅÄ!)‡" [char-syntax 41 34 in-string-p 1 forward-sexp] 3]) (byte-code "ÀÁÂÃ#ˆÀÄÂÅ#ˆÀÄÆÇ#‡" [put sexp end-op end-of-sexp list #[nil "ÀÁ!‡" [up-list 1] 2] beginning-op backward-sexp] 4) #@36 Characters allowable in filenames. (defvar file-name-chars "~/A-Za-z0-9---_.${}#%," (#$ . 2258)) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put filename end-op #[nil "Áw‡" [file-name-chars nil] 2] beginning-op #[nil "ex‡" [file-name-chars] 2]] 4) (defalias 'forward-whitespace #[(ARG) "À !ƒ ÂÃĉ $‡ ÅW….ÆÃĉ#ƒ'Å”fÇ=„'ÈÄxˆ T‰‚‡" [natnump ARG re-search-forward "[ ]+\\|\n" nil 0 re-search-backward 10 " "] 6 nil "p"]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put buffer end-op end-of-buffer beginning-op beginning-of-buffer] 4) (defalias 'forward-symbol #[(ARG) "À !ƒ ÂÃĉ $‡ ÅW…&ÆÃĉ#ƒÇÈ!ˆ T‰‚‡" [natnump ARG re-search-forward "\\(\\sw\\|\\s_\\)+" nil 0 re-search-backward skip-syntax-backward "w_"] 6 nil "p"]) (defalias 'forward-same-syntax #[(&optional arg) "ÁWƒÂÃ`Sfz!!ˆT‰‚ÁV…+ÄÃ`fz!!ˆS‰‚‡" [arg 0 skip-syntax-backward char-to-string skip-syntax-forward] 4 nil "p"]) (defalias 'word-at-point #[nil "ÀÁ!‡" [thing-at-point word] 2]) (defalias 'sentence-at-point #[nil "ÀÁ!‡" [thing-at-point sentence] 2]) #@89 Read a lisp expression from STR, signalling an error if the entire string was not used. (defalias 'read-from-whole-string #[(STR) "À !ÃÄʼnƒÇÈ!‚\n@*‡" [read-from-string STR read-data nil (byte-code "À \nAÃO!ˆÄ‡" [read-from-string STR read-data nil t] 4) ((end-of-file)) more-left error "Can't read whole string"] 4 (#$ . 3271)]) (defalias 'form-at-point #[(&optional THING PRED) "ÀÁÂ\fƒ\f !… )‡" [nil (byte-code "ÀÁ\n†Ã!!‡" [read-from-whole-string thing-at-point THING sexp] 3) ((error)) sexp PRED] 3]) (defalias 'sexp-at-point #[nil "ÀÁ!‡" [form-at-point sexp] 2]) (defalias 'symbol-at-point #[nil "ÀÁÂ\"‡" [form-at-point sexp symbolp] 3]) (defalias 'number-at-point #[nil "ÀÁÂ\"‡" [form-at-point sexp numberp] 3]) (defalias 'list-at-point #[nil "ÀÁÂ\"‡" [form-at-point list listp] 3]) emacs-19.30/lisp/time-stamp.elc100666 13437 1 26216 6046536104 15011 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 20:04:56 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/time-stamp.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`time-stamp.el' was compiled for Emacs 19.29 or later")) #@158 *Non-nil to enable time-stamping of buffers by \[time-stamp]. Can be toggled by \[time-stamp-toggle-active]. See also the variable time-stamp-warn-inactive. (defvar time-stamp-active t (#$ . -486)) #@210 *Non-nil to have \[time-stamp] warn if a buffer did not get time-stamped. A warning is printed if time-stamp-active is nil and the buffer contains a time stamp template that would otherwise have been updated. (defvar time-stamp-warn-inactive t (#$ . -691)) #@1053 *Template for the string inserted by \[time-stamp]. Value may be a string or a list. (Lists are supported only for backward compatibility.) A string is used verbatim except for character sequences beginning with %: %a weekday name: `Monday'. %A gives uppercase: `MONDAY' %b month name: `January'. %B gives uppercase: `JANUARY' %d day of month %H 24-hour clock hour %I 12-hour clock hour %m month number %M minute %p `am' or `pm'. %P gives uppercase: `AM' or `PM' %S seconds %w day number of week, Sunday is 0 %y year: `1995' %z time zone name: `est'. %Z gives uppercase: `EST' Non-date items: %% a literal percent character: `%' %f file name without directory %F gives absolute pathname %s system name %u user's login name %h mail host name Decimal digits between the % and the type character specify the field width. Strings are truncated on the right; numbers on the left. A leading zero causes numbers to be zero-filled. For example, to get the format used by the `date' command, use "%3a %3b %2d %02H:%02M:%02S %Z %y" (defvar time-stamp-format "%02y/%02m/%02d %02H:%02M:%02S %u" (#$ . -956)) #@507 Number of lines at the beginning of a file that are searched. The patterns `time-stamp-start' and `time-stamp-end' must be found on one of the first `time-stamp-line-limit' lines of the file for the file to be time-stamped by \[time-stamp]. Do not change `time-stamp-line-limit', `time-stamp-start', or `time-stamp-end' for yourself or you will be incompatible with other people's files! If you must change them for some application, do so in the local variables section of the time-stamped file itself. (defvar time-stamp-line-limit 8 (#$ . 2089)) #@398 Regexp after which the time stamp is written by \[time-stamp]. See also the variables `time-stamp-end' and `time-stamp-line-limit'. Do not change `time-stamp-line-limit', `time-stamp-start', or `time-stamp-end' for yourself or you will be incompatible with other people's files! If you must change them for some application, do so in the local variables section of the time-stamped file itself. (defvar time-stamp-start "Time-stamp:[ ]+\\\\?[\"<]+" (#$ . 2647)) #@525 Regexp marking the text after the time stamp. \[time-stamp] deletes the text between the first match of `time-stamp-start' and the following match of `time-stamp-end' on the same line, then writes the time stamp specified by `time-stamp-format' between them. Do not change `time-stamp-line-limit', `time-stamp-start', or `time-stamp-end' for yourself or you will be incompatible with other people's files! If you must change them for some application, do so in the local variables section of the time-stamped file itself. (defvar time-stamp-end "\\\\?[\">]" (#$ . 3119)) #@730 Update the time stamp string in the buffer. If you put a time stamp template anywhere in the first 8 lines of a file, it can be updated every time you save the file. See the top of `time-stamp.el' for a sample. The template looks like one of the following: Time-stamp: <> Time-stamp: " " The time stamp is written between the brackets or quotes, resulting in Time-stamp: <95/01/18 10:20:51 gildea> Only does its thing if the variable time-stamp-active is non-nil. Typically used on write-file-hooks for automatic time-stamping. The format of the time stamp is determined by the variable time-stamp-format. The variables time-stamp-line-limit, time-stamp-start, and time-stamp-end control finding the template. (defalias 'time-stamp #[nil "À‰ ;ƒ‹\f;ƒ‹ŠŒ~ˆebˆ yˆe`‰bˆ`Wƒ‡È É#ƒ‡`Àˆ`\nbˆÈ\f\nÉ#ƒƒ ƒyÌ”  |ˆbˆÎ cˆ` bˆÏÐ Ñ#ƒuÒ \"ˆ)‚€ƒ€Ñ`)‚!,‚“ÔÕ!ˆÖ×!ˆ ƒŸÔØ!ˆÖ×!ˆ*À‡" [nil need-to-warn case-fold-search time-stamp-start time-stamp-end time-stamp-line-limit search-end start re-search-forward move line-end time-stamp-active 0 end time-stamp-string search-forward " " t untabify time-stamp-warn-inactive message "time-stamp-start or time-stamp-end is not a string" sit-for 1 "Warning: time-stamp-active is off; did not time-stamp buffer."] 5 (#$ . 3699) nil]) #@139 Toggle time-stamp-active, setting whether \[time-stamp] updates a buffer. With arg, turn time stamping on if and only if arg is positive. (defalias 'time-stamp-toggle-active #[(&optional arg) "„ ?‚Â!ÃVÄÅ ƒÆ‚Ç\"‡" [arg time-stamp-active prefix-numeric-value 0 message "time-stamp is now %s." "active" "off"] 3 (#$ . 5024) "P"]) #@58 Generate the new string to be inserted by \[time-stamp]. (defalias 'time-stamp-string #[nil ";ƒ Á!‡ÂÃ\"‡" [time-stamp-format time-stamp-strftime time-stamp-fconcat " "] 3 (#$ . 5368)]) #@35 Alist of months and their number. (defconst time-stamp-month-numbers (quote (("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6) ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))) (#$ . 5563)) (byte-code "ÀÁ\nBÁ‡" [["(zero)" "January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December"] time-stamp-month-full-names current-load-list] 2) #@37 Alist of weekdays and their number. (defconst time-stamp-weekday-numbers (quote (("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3) ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))) (#$ . 6003)) (byte-code "ÀÁ\nBÁ‡" [["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"] time-stamp-weekday-full-names current-load-list] 2) #@233 Uses a FORMAT to format date, time, file, and user information. Optional second argument TIME will be used instead of the current time. See the description of the variable `time-stamp-format' for a description of the format string. (defalias 'time-stamp-strftime #[(format &optional time) ";ƒ ‚ƒÁ!‚Á \nGÃĉÅĉ‰Ã \n \f  Wƒˆ\n H\f\n\fÐ=ƒv T  T‰ Wƒb\n H‚cÃ\fÑ\fXƒsÒ\fY„O\n  OÑ\fXƒ‰Ò\fY„\fÓ=„\fÔ=„\fÕ=„\fÖ=„\f×=„\fØ=„\fÙ=„\fÚ=„\fÛ=ƒØ Ü=„ØT‰„\fÝ=ƒö Ü=„öÃVƒöS‰‚ÃVƒ# Wƒ# T \f  Wƒ\n H‚Ã\f‚{\fÐ=ƒ.Þ‚\fß=„<\fà=ƒ^!âÃãO$\"AH%\fß=ƒW%‚Z%–)‚\fæ=„l\fç=ƒŽ(âéêO+\"AH%\fæ=ƒ‡%‚Š%–)‚\fì=ƒŸíîïO!‚\fð=ƒ°íñòO!‚\fó=ƒáíñòO!‰4õWƒÍ4ö\\‚Ý4öVƒÛ4öZ‚Ý4)‚\f÷=ƒõâéêO+\"A‚\fø=ƒíùúO!‚\fû=„\fü=ƒ:öíñòO!Vƒ$ý‚%þ%\fû=ƒ3%‚6%–)‚\fÿ=ƒOí@AO!‚\fB=ƒeâÃãO$\"A‚\fC=ƒzíDÄO!‚\fE=„Œ\fF=ƒ¼GH!…H!A@‰%„¦Å%\fE=ƒµ%—‚¸%–)‚\fI=ƒÙJƒÓKJ!‚L‚\fM=ƒíJ†L‚\fN=ƒýO ‚\fP=ƒ Q ‚\fR=…S Řƒ(‚|‰T§ƒ9ì‚<N#†CÅ\"‰UGí!V‰WVVƒp;ƒfUÃVO‚rUV[ÄO‚rU+‚|X\f!P\n T‰ ‚5\n.\n‡" [time current-time-string format 0 nil "" paren-level field-result field-width field-index result prev-char cur-char ind fmt-len time-string 37 48 57 46 44 58 64 45 43 32 35 40 92 41 "%" 97 65 time-stamp-weekday-full-names assoc 3 time-stamp-weekday-numbers name 98 66 time-stamp-month-full-names 4 7 time-stamp-month-numbers 100 string-to-int 8 10 72 11 13 73 hour 1 12 109 77 14 16 112 80 "am" "pm" 83 17 19 119 121 -4 122 90 fboundp current-time-zone 102 buffer-file-name file-name-nondirectory "(no file)" 70 115 system-name 117 user-login-name 104 time-stamp-mail-host-name "%%%s%c" padded-result desired-length initial-length char-to-string] 11 (#$ . 6339)]) #@320 Return the name of the host where the user receives mail. This is the value of `mail-host-address' if bound and a string, otherwise the value of `time-stamp-mail-host' (for versions of Emacs before 19.29) otherwise the value of the function system-name. This function may be usefully referenced by `time-stamp-format'. (defalias 'time-stamp-mail-host-name #[nil "ÀÁ!ƒ ;ƒ † ÀÂ!ƒ\n;ƒ\n† à ‡" [boundp mail-host-address time-stamp-mail-host system-name] 2 (#$ . 8275)]) #@305 Similar to (mapconcat 'funcall LIST SEP) but LIST allows literals. If an element of LIST is a symbol, it is funcalled to get the string to use; the separator SEP is used between two strings obtained by funcalling a symbol. Otherwise the element itself is inserted; no separator is used around literals. (defalias 'time-stamp-fconcat #[(list sep) "ÀÁ\fƒ/\f@9ƒ!\nƒ P \f@ PÆ‚( \f@PÁ\fA‰„ *‡" ["" nil insert-sep-p return-string list sep t] 3 (#$ . 8758)]) #@63 Return the current date as a string in "Month DD, YYYY" form. (defalias 'time-stamp-month-dd-yyyy #[nil "À ÂÃ\fÅ ÆÇO\"AHÉ ÊËO! ÌÍO$)‡" [current-time-string date format "%s %d, %s" time-stamp-month-full-names assoc 4 7 time-stamp-month-numbers string-to-int 8 10 -4 nil] 7 (#$ . 9233)]) #@125 Return the current date as a string in "Mon DD YYYY" form. The first character of DD is space if the value is less than 10. (defalias 'time-stamp-mon-dd-yyyy #[nil "À Âà ÄÅOÆ ÇÈO! ÉÊO$)‡" [current-time-string date format "%s %2d %s" 4 7 string-to-int 8 10 -4 nil] 7 (#$ . 9529)]) #@58 Return the current date as a string in "DD Mon YY" form. (defalias 'time-stamp-dd-mon-yy #[nil "À ÂÃÄ ÅÆO! ÇÈO ÉÊO$)‡" [current-time-string date format "%02d %s %s" string-to-int 8 10 4 7 -2 nil] 7 (#$ . 9816)]) #@57 Return the current date as a string in "YY/MM/DD" form. (defalias 'time-stamp-yy/mm/dd #[nil "À Âà ÄÅOÆ ÇÈO \"AÊ ËÌO!$)‡" [current-time-string date format "%s/%02d/%02d" -2 nil assoc 4 7 time-stamp-month-numbers string-to-int 8 10] 8 (#$ . 10035)]) #@59 Return the current date as a string in "YYYY/MM/DD" form. (defalias 'time-stamp-yyyy/mm/dd #[nil "À Âà ÄÅOÆ ÇÈO \"AÊ ËÌO!$)‡" [current-time-string date format "%s/%02d/%02d" -4 nil assoc 4 7 time-stamp-month-numbers string-to-int 8 10] 8 (#$ . 10292)]) #@59 Return the current date as a string in "YYYY-MM-DD" form. (defalias 'time-stamp-yyyy-mm-dd #[nil "À Âà ÄÅOÆ ÇÈO \"AÊ ËÌO!$)‡" [current-time-string date format "%s-%02d-%02d" -4 nil assoc 4 7 time-stamp-month-numbers string-to-int 8 10] 8 (#$ . 10553)]) #@55 Return the current date as a string in "YYMMDD" form. (defalias 'time-stamp-yymmdd #[nil "À Âà ÄÅOÆ ÇÈO \"AÊ ËÌO!$)‡" [current-time-string date format "%s%02d%02d" -2 nil assoc 4 7 time-stamp-month-numbers string-to-int 8 10] 8 (#$ . 10814)]) #@57 Return the current time as a string in "HH:MM:SS" form. (defalias 'time-stamp-hh:mm:ss #[nil "À ÁÂO‡" [current-time-string 11 19] 3 (#$ . 11065)]) #@53 Return the current time as a string in "HHMM" form. (defalias 'time-stamp-hhmm #[nil "À ‰ÂÃO ÄÅOP)‡" [current-time-string date 11 13 14 16] 5 (#$ . 11218)]) (provide (quote time-stamp)) emacs-19.30/lisp/time.elc100666 13437 1 11060 6044554662 13665 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Sat Oct 28 21:32:31 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/time.el ;;; emacs version 19.29.1.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`time.el' was compiled for Emacs 19.29 or later")) #@208 *File name of mail inbox file, for indicating existence of new mail. Non-nil and not a string means don't check for mail. nil means use default, which is system-dependent, and is the same as used by Rmail. (defvar display-time-mail-file nil (#$ . -476)) #@77 *Non-nil means \[display-time] should display day and date as well as time. (defvar display-time-day-and-date nil (#$ . -737)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp display-time-process nil current-load-list] 2) #@52 *Seconds between updates of time in the mode line. (defvar display-time-interval 60 (#$ . -953)) #@124 *Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23. Nil means 1 <= hh <= 12, and an AM/PM suffix is used. (defvar display-time-24hr-format nil (#$ . -1057)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp display-time-string nil current-load-list] 2) #@77 * List of functions to be called when the time is updated on the mode line. (defvar display-time-hook nil (#$ . -1319)) #@114 Time when mail file's file system was recorded to be down. If that file system seems to be up, the value is nil. (defvar display-time-server-down-time nil (#$ . 1446)) #@269 Display current time, load level, and mail flag in mode line of each buffer. Updates automatically every minute. If `display-time-day-and-date' is non-nil, the current day and date are displayed as well. After each update, `display-time-hook' is run with `run-hooks'. (defalias 'display-time #[nil "… Á!Â=‰?…JƒÄ!ˆ „ÆÇ >„(È É\"ÊË\fÍÎËÏÐ\"Ò!$)Ô!ˆÕÖ\"ˆ×Ø\")‡" [display-time-process process-status run live delete-process global-mode-string ("") display-time-string append (display-time-string) "" nil process-connection-type start-process "display-time" expand-file-name "wakeup" exec-directory int-to-string display-time-interval process-kill-without-query set-process-sentinel display-time-sentinel set-process-filter display-time-filter] 7 (#$ . 1621) nil]) (defalias 'display-time-sentinel #[(proc reason) "À !Â=„\nÃÅÆ!ˆÇÈ!‡" [process-status proc run "" display-time-string force-mode-line-update t sit-for 0] 2]) #@605 *A list of expressions governing display of the time in the mode line. This expression is a list of expressions that can involve the keywords `load', `day', `month', and `year', `12-hours', `24-hours', `minutes', `seconds', all numbers in string form, and `monthname', `dayname', `am-pm', and `time-zone' all alphabetic strings, and `mail' a true/nil value. For example, the form '((substring year -2) "/" month "/" day " " 24-hours ":" minutes ":" seconds (if time-zone " (") time-zone (if time-zone ")") (if mail " Mail" "")) would give mode line times like `94/12/30 21:07:48 (UTC)'. (defvar display-time-string-forms (quote ((if display-time-day-and-date (format "%s %s %s " dayname monthname day) "") (format "%s:%s%s" (if display-time-24hr-format 24-hours 12-hours) minutes (if display-time-24hr-format "" am-pm)) load (if mail " Mail" ""))) (#$ . -2570)) (defalias 'display-time-filter #[(proc string) "À  !ÄÅƆÉÊ!† Ì P‰ ;…Xƒ5À A@ZÏV…XÀ Ñ !À A@A@ZÒVƒTÀ A@‚WÄ) ÔÕO×!ÙÔ\\Ú¦T!ÚYƒ|Ü‚}Ý ßàO! âãO$å !A@& çèO) ÒêO+ ìíO.ï.ð\"A1 òóO4õö7ø#9úû!ˆ.ü ˆýò!‡" [current-time now current-time-string time nil (byte-code "À @ÁUƒ\n‡ÃÄÀ @\"‰ÁÆOÇ ÆÈOQ)‡" [load-average 0 "" format " %03d" str -2 "." nil] 6) ((error "")) load display-time-mail-file getenv "MAIL" rmail-spool-directory user-login-name mail-spool-file display-time-server-down-time 1200 start-time display-time-file-nonempty-p 20 mail 11 13 24-hours string-to-int hour int-to-string 12 12-hours "pm" "am" am-pm 14 16 minutes 17 19 seconds current-time-zone time-zone 8 10 day 24 year 4 7 monthname assoc (("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4") ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8") ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12")) month 0 3 dayname mapconcat eval display-time-string-forms "" display-time-string run-hooks display-time-hook force-mode-line-update sit-for] 5]) (defalias 'display-time-file-nonempty-p #[(file) "À !…ÂÃÄÅ !!8W‡" [file-exists-p file 0 7 file-attributes file-chase-links] 5]) emacs-19.30/lisp/timer.elc100666 13437 1 10444 5744577606 14065 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:53:41 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/timer.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/timer.el' was compiled for Emacs 19")) #@102 The name of the program to run as the timer subprocess. It should normally be in the exec-directory. (defvar timer-program (expand-file-name "timer" exec-directory) (#$ . 480)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÆÅ B‡" [boundp timer-process nil current-load-list timer-alist timer-out ""] 2) #@75 If non-nil, don't exit the timer process when no more events are pending. (defvar timer-dont-exit nil (#$ . 788)) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#ˆÀÆÂÇ#ˆÀÆÄÈ#ˆÀÉÂÊ#ˆÀÉÄË#‡" [put timer-error error-conditions (error timer-error) error-message "Timer error" timer-abnormal-termination (error timer-error timer-abnormal-termination) "Timer exited abnormally--all events cancelled" timer-filter-error (error timer-error timer-filter-error) "Error in timer process filter"] 4) (defalias 'timer-kill-emacs-hook #[nil "…ÁÂ\"ˆÃÂ\"ˆÄ!‡" [timer-process set-process-sentinel nil set-process-filter delete-process] 3]) (add-hook (quote kill-emacs-hook) (quote timer-kill-emacs-hook)) #@886 Run a function at a time, and optionally on a regular interval. Arguments are TIME, REPEAT, FUNCTION &rest ARGS. TIME, a string, can be specified absolutely or relative to now. TIME can also be an integer, a number of seconds. REPEAT, an integer number of seconds, is the interval on which to repeat the call to the function. If REPEAT is nil or 0, call it just once. Absolute times may be specified in a wide variety of formats; Something of the form `HOUR:MIN:SEC TIMEZONE MONTH/DAY/YEAR', where all fields are numbers, works; the format used by the Unix `date' command works too. Relative times may be specified as a series of numbers followed by units: 1 min denotes one minute from now. min does too. 1 min 5 sec denotes 65 seconds from now. 1 min 2 sec 3 hour 4 day 5 week 6 fortnight 7 month 8 year denotes the sum of all the given durations from now. (defalias 'run-at-time #[(time repeat function &rest args) "ÁšƒÂ ¨ƒÄÅ \"ƒ Ç!È>ƒMƒ*É!ˆÂ\nËÌ #)ÂÏÐ\"ˆÑÒ\"ˆÓ!ˆ‚[Ç!Ô=ƒ[Õ!ˆÖ ×GQ‰FÜ ÝÞR\"ˆB*‡" [repeat 0 nil time format "%d sec" timer-process process-status (exit signal nil) delete-process process-connection-type start-process "timer" timer-program timer-alist set-process-filter timer-process-filter set-process-sentinel timer-process-sentinel process-kill-without-query stop continue-process current-time-string "-" token function args elt process-send-string "@" "\n"] 7 (#$ . 1463) "sRun at time: \nNRepeat interval: \naFunction: "]) #@205 Cancel a timer previously made with `run-at-time'. The argument should be a value previously returned by `run-at-time'. Cancelling the timer means that nothing special will happen at the specified time. (defalias 'cancel-timer #[(elt) "AÁ ˆAA ‡" [elt nil ignore] 2 (#$ . 2999)]) (defalias 'timer-process-filter #[(proc str) " P‰‰ÆÇ\"ƒŸȉ”OÉ\f\n\"È•ÂO ƒRËÌ 8Í 8\"ˆÎ A@!ƒHÏ A@Ñ @ÇR\"ˆ‚\nÒ \n\"\n‚\nÆÓ\f\"ƒ\n\fÔ”Ô•O\f̔̕OÉ\f͔͕O\n\"Ò\f\n\"‰\n„‡„‡Ö!ˆ×ØÙÚÛ Ì\f8 $#ˆÜØ D\"ˆ‚\n\n†­†­Ö!+‡" [timer-out str nil error token do string-match "\n" 0 assoc timer-alist apply 2 3 natnump send-string proc " sec@" delq "timer: \\([^:]+\\): \\([^@]*\\)@\\(.*\\)$" 1 timer-dont-exit process-send-eof put timer-filter-error error-message format "%s for %s; couldn't set at \"%s\"" signal] 9]) (defalias 'timer-process-sentinel #[(proc str) "À !‰Ã=ƒÄ !‚4 ƒ.\nÆ=„. È ÈÊË \n\fF\"ˆ)È ȉ)‡" [process-status proc stat stop continue-process timer-alist exit alist nil timer-process signal timer-abnormal-termination str] 7]) #@72 Cancel all events scheduled by `run-at-time' which would run FUNCTION. (defalias 'cancel-function-timers #[(function) "‰ƒ @8 =ƒÄ @\" A‰„)†) †)Æ!‡" [timer-alist alist 2 function delq timer-dont-exit process-send-eof timer-process] 4 (#$ . 4069) "aCancel timers of function: "]) (provide (quote timer)) emacs-19.30/lisp/timezone.elc100666 13437 1 22051 6045214710 14547 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:30:23 1995 ;;; from file /home/fsf/rms/e19/lisp/timezone.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`timezone.el' was compiled for Emacs 19.29 or later")) (provide (quote timezone)) #@217 *Time differentials of timezone from GMT in +-HHMM form. This list is obsolescent, and is present only for backwards compatibility, because time zone names are ambiguous in practice. Use `current-time-zone' instead. (defvar timezone-world-timezones (quote (("PST" . -800) ("PDT" . -700) ("MST" . -700) ("MDT" . -600) ("CST" . -600) ("CDT" . -500) ("EST" . -500) ("EDT" . -400) ("AST" . -400) ("NST" . -330) ("UT" . 0) ("GMT" . 0) ("BST" . 100) ("MET" . 100) ("EET" . 200) ("JST" . 900) ("GMT+1" . 100) ("GMT+2" . 200) ("GMT+3" . 300) ("GMT+4" . 400) ("GMT+5" . 500) ("GMT+6" . 600) ("GMT+7" . 700) ("GMT+8" . 800) ("GMT+9" . 900) ("GMT+10" . 1000) ("GMT+11" . 1100) ("GMT+12" . 1200) ("GMT+13" . 1300) ("GMT-1" . -100) ("GMT-2" . -200) ("GMT-3" . -300) ("GMT-4" . -400) ("GMT-5" . -500) ("GMT-6" . -600) ("GMT-7" . -700) ("GMT-8" . -800) ("GMT-9" . -900) ("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200))) (#$ . -504)) #@75 Alist of first three letters of a month and its numerical representation. (defvar timezone-months-assoc (quote (("JAN" . 1) ("FEB" . 2) ("MAR" . 3) ("APR" . 4) ("MAY" . 5) ("JUN" . 6) ("JUL" . 7) ("AUG" . 8) ("SEP" . 9) ("OCT" . 10) ("NOV" . 11) ("DEC" . 12))) (#$ . 1437)) #@260 Convert DATE to an arpanet standard date. Optional 1st argument LOCAL specifies the default local timezone of the DATE; if nil, GMT is assumed. Optional 2nd argument TIMEZONE specifies a time zone to be represented in; if nil, the local time zone is assumed. (defalias 'timezone-make-date-arpa-standard #[(date &optional local timezone) "À \n #Å\fÆH\fÇH\fÈHÉ\fÊH\fËH\fÌH#\fÍH%)‡" [timezone-fix-time date local timezone new timezone-make-arpa-date 0 1 2 timezone-make-time-string 3 4 5 6] 9 (#$ . 1718)]) #@257 Convert DATE to a sortable date string. Optional 1st argument LOCAL specifies the default local timezone of the DATE; if nil, GMT is assumed. Optional 2nd argument TIMEZONE specifies a timezone to be represented in; if nil, the local time zone is assumed. (defalias 'timezone-make-date-sortable #[(date &optional local timezone) "À \n #Å\fÆH\fÇH\fÈHÉ\fÊH\fËH\fÌH#$)‡" [timezone-fix-time date local timezone new timezone-make-sortable-date 0 1 2 timezone-make-time-string 3 4 5] 9 (#$ . 2230)]) #@118 Make arpanet standard date string from YEAR, MONTH, DAY, and TIME. Optional argument TIMEZONE specifies a time zone. (defalias 'timezone-make-arpa-date #[(year month day time &optional timezone) "<ƒ.Á!‰ÃWƒ\n[‚\nÅÆ\nÃWƒ\"Ç‚#È\fÉ¥\fɦ$*‚/\nÅË\fÍÎ\"@!\n&)‡" [timezone timezone-zone-to-minute m 0 absm format "%c%02d%02d" 45 43 60 zone "%02d %s %04d %s %s" day capitalize rassq month timezone-months-assoc year time] 8 (#$ . 2732)]) #@60 Make sortable date string from YEAR, MONTH, DAY, and TIME. (defalias 'timezone-make-sortable-date #[(year month day time) "ÀÁ\n \f %‡" [format "%4d%02d%02d%s" year month day time] 6 (#$ . 3192)]) #@49 Make time string from HOUR, MINUTE, and SECOND. (defalias 'timezone-make-time-string #[(hour minute second) "ÀÁ\n \f$‡" [format "%02d:%02d:%02d" hour minute second] 5 (#$ . 3394)]) #@415 Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE]. 19 is prepended to year if necessary. Timezone may be nil if nothing. Understands the following styles: (1) 14 Apr 89 03:20[:12] [GMT] (2) Fri, 17 Mar 89 4:01[:33] [GMT] (3) Mon Jan 16 16:12[:37] [GMT] 1989 (4) 6 May 1992 1641-JST (Wednesday) (5) 22-AUG-1993 10:59:12.82 (6) Thu, 11 Apr 16:17:12 91 [MET] (7) Mon, 6 Jul 16:47:20 T 1992 [MET] (defalias 'timezone-parse-date #[(date) ";ƒ#ÁÂ\"„ÃÂ\"ƒ#Ä!‰ƒ#ÅÂGÆ$ˆ†(ÇƉ‰‰‰ \n \fÍÎ\"ƒQÏ\fÐ Ñ\nÒ Æ‚ýÍÓ\"ƒjÏ\fÐ Ñ\nÒ Ô‚ýÍÕ\"ƒƒÐ\fÑ Ö\nÒ Æ‚ýÍ×\"ƒœÐ\fÑ Ö\nÒ Ø‚ýÍÙ\"ƒµÒ\fÖ Ñ\nÐ Æ‚ýÍÚ\"ƒÎØ\fÖ Ñ\nÐ Ò‚ýÍÛ\"ƒçÐ\fÑ Ö\nÒ Ø‚ýÍÜ\"ƒýÐ\fÑ Ö\nÒ Æ\fƒI\f”\f•O‰\fGÒWƒÝ\fÞÆOP\f ” ”Ð\\Oàá–\"\"A! )\n”\n•O\n ” •O ƒX”•O\fƒlã\f \n %‚sã䉉‰Æ%.‡" [date text-properties-at 0 next-property-change copy-sequence set-text-properties nil "" zone time day month year string-match "\\([^ ,]+\\),[ ]+\\([0-9]+\\)[ ]+\\([^ ,]+\\)[ ]+\\([0-9]+:[0-9:]+\\)[ ]+\\(T[ ]+\\|\\)\\([0-9]+\\)[ ]*\\'" 6 3 2 4 "\\([^ ,]+\\),[ ]+\\([0-9]+\\)[ ]+\\([^ ,]+\\)[ ]+\\([0-9]+:[0-9:]+\\)[ ]+\\(T[ ]+\\|\\)\\([0-9]+\\)[ ]*\\([-+a-zA-Z0-9]+\\)" 7 "\\([0-9]+\\)[ ]+\\([^ ,]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+:[0-9:]+\\)[ ]*\\'" 1 "\\([0-9]+\\)[ ]+\\([^ ,]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+:[0-9:]+\\)[ ]*\\([-+a-zA-Z0-9]+\\)" 5 "\\([^ ,]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+:[0-9:]+\\)[ ]+\\([0-9]+\\)" "\\([^ ,]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+:[0-9:]+\\)[ ]+\\([-+a-zA-Z0-9]+\\)[ ]+\\([0-9]+\\)" "\\([0-9]+\\)[ ]+\\([^ ,]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+\\)[ ]*\\([-+a-zA-Z0-9]+\\)" "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ ]+\\([0-9]+:[0-9]+:[0-9]+\\)\\.[0-9]+" "19" -2 string int-to-string assoc timezone-months-assoc vector "0"] 7 (#$ . 3582)]) #@106 Parse TIME (HH:MM:SS) and return a vector [hour minute second]. Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM. (defalias 'timezone-parse-time #[(time) "†Á‰‰ÆÇ\"ƒÈÉÊ‚IÆË\"ƒ,ÈÉ‚IÆÌ\"ƒ<ÈÉÊ‚IÆÍ\"ƒIÈÉÂÎ ƒW ” •O‚XÏ\fƒe\f”\f•O‚fÏ ƒs ” •O‚tÏ#,‡" [time "" nil second minute hour string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" 1 2 3 "\\`\\([0-9]+\\):\\([0-9]+\\)\\'" "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" vector "0"] 6 (#$ . 5474)]) #@185 Translate TIMEZONE to an integer minute offset from GMT. TIMEZONE can be a cons cell containing the output of current-time-zone, or an integer of the form +-HHMM, or a time zone name. (defalias 'timezone-zone-to-minute #[(timezone) ":ƒ\n@Á¥‡ƒC– \"A†‰;ƒ\"Ä!Å!‰Ç¥Á_Ǧ\\ÉWƒ?[‚A*‡É‡" [timezone 60 assoc timezone-world-timezones string-to-int abs abszone 100 minutes 0] 4 (#$ . 6013)]) #@279 Compute the UTC time equivalent to DATE at time SECONDS after midnight. Return a list suitable as an argument to current-time-zone, or nil if the date cannot be thus represented. DATE is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC. (defalias 'timezone-time-from-absolute #[(date seconds) "À\n ZÄÅ! _\\ÄÈ! Ê ¥!‰  _\fÊ\fZ! Î\f \\Z!ÏW…E  B.‡" [719162 current-time-origin date days float 86400 seconds-per-day seconds 65536 current-time-arithmetic-base floor hi hibase lo abs 2] 5 (#$ . 6429)]) #@286 Compute the local time zone for DATE at time SECONDS after midnight. Return a list in the same format as current-time-zone's result, or nil if the local time zone could not be computed. DATE is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC. (defalias 'timezone-time-zone-from-absolute #[(date seconds) "ÀÁ!… \f\"‰…Á !‰@…))‡" [fboundp current-time-zone timezone-time-from-absolute date seconds utc-time zone] 4 (#$ . 7002)]) #@162 Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector. If LOCAL is nil, it is assumed to be GMT. If TIMEZONE is nil, use the local time zone. (defalias 'timezone-fix-time #[(date local timezone) "À ! ÃH!‰ÅWƒ\fÆ\\‚#\fÇWƒ\"\fÈ\\‚#\f ÉH!\n ËH!\fÍ ÎH!ÂÃH!ÂÉH!ÂËH! ÓH†Y†uÖ×\n\f\f#Ø_\\Ø_\\\"Ù!Ù!Z\\ÛØ\"\\Ø_ZÝXƒÕÝZ\fT\fÞ\n\f\"\fWƒ\nT\nÉ\fß\nWƒÉ\n\fT‚ÃVƒÝ\\\fS\fÉ\fVƒ\nS\nÉ\nVƒß\n\fSÞ\n\f\"\fà\f\n\f&.‡" [timezone-parse-date date string-to-int 0 year 50 2000 100 1900 1 month 2 day timezone-parse-time 3 time hour minute second 4 local timezone timezone-time-zone-from-absolute timezone-absolute-from-gregorian 60 timezone-zone-to-minute diff floor hour-fix 24 timezone-last-day-of-month 12 vector] 9 (#$ . 7489)]) #@36 The last day in MONTH during YEAR. (defalias 'timezone-last-day-of-month #[(month year) "ÁUƒ !ƒćÅSH‡" [month 2 timezone-leap-year-p year 29 [31 28 31 30 31 30 31 31 30 31 30 31]] 2 (#$ . 8351)]) #@45 Returns t if YEAR is a Gregorian leap year. (defalias 'timezone-leap-year-p #[(year) "Á¦ÂUƒæÂU?†ĦÂU‡" [year 4 0 100 400] 2 (#$ . 8560)]) #@67 Return the day number within the year of the date month/day/year. (defalias 'timezone-day-number #[(month day year) " SÂ_\\ ÄVƒ! Å_Æ\\Ç¥ZÈ !ƒ! T )‡" [day month 31 day-of-year 2 4 23 10 timezone-leap-year-p year] 3 (#$ . 8712)]) #@137 The number of days between the Gregorian date 12/31/1 BC and month/day/year. The Gregorian date Sunday, December 31, 1 BC is imaginary. (defalias 'timezone-absolute-from-gregorian #[(month day year) "À \n # SÄ_ SÅ¥ SÆ¥[ SÇ¥\\\\\\\\‡" [timezone-day-number month day year 365 4 100 400] 6 (#$ . 8955)]) emacs-19.30/lisp/tmm.elc100666 12120 1 15617 6052473634 13402 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 15 18:28:22 1995 ;;; from file /home/fsf/rms/e19/lisp/tmm.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`tmm.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂ BÄÅ!„ÆÅ BÇ BÈ BÉ BÊ BƇ" [require electric tmm-short-cuts current-load-list boundp tmm-old-mb-map nil tmm-old-comp-map tmm-c-prompt tmm-km-list tmm-table-undef] 2) #@101 Text-mode emulation of looking and choosing from a menubar. See the documentation for `tmm-prompt'. (defalias 'tmm-menubar #[nil "ÀÁ!ˆÂÃ! ‰ƒ.@‰\fžÉÊ\f\"C\"*A‰„)Ë\f!)‡" [run-hooks menu-bar-update-hook tmm-get-keybind [menu-bar] menu-bar menu-bar-final-items list item this-one append delq tmm-prompt] 5 (#$ . 656) nil]) #@57 String to insert between shortcut and menu item or nil. (defvar tmm-mid-prompt "==>" (#$ . 1002)) #@34 A place to store minibuffer map. (defvar tmm-mb-map nil (#$ . 1106)) #@42 What insert on top of completion buffer. (defvar tmm-completion-prompt "Press PageUp Key to reach this buffer from the minibuffer.\nAlternatively, you can use Up/Down keys (or your History keys) to change\nthe item in the minibuffer, and press RET when you are done, or press the \nmarked letters to pick up your choice. Type C-g or ESC ESC ESC to cancel.\n" (#$ . 1181)) #@479 Text-mode emulation of calling the bindings in keymap. Creates a text-mode menu of possible choices. You can access the elements in the menu: *) Either via history mechanism from minibuffer; *) Or via completion-buffer that is automatically shown. The last alternative is currently a hack, you cannot use mouse reliably. If the optional argument IN-POPUP is set, is argument-compatible with `x-popup-menu', otherwise the argument BIND should be a cdr of sparse keymap. (defalias 'tmm-prompt #[(bind &optional in-popup) "ƒ ƒ ‚ÂÃ\"ˆÃ‰‰‰‰‰‰‰‰‰ \n \f ÎÏ!ˆÐÑ \"ˆ\fƒƒGÓ\f!\fÔÐÕ\f\"!‰\nG Ö\n‰‰‰$\n S\n8×ØÙ\"ˆÚŽÛ ÜP\fÃÝÃÊ ‰\\B& )Þ \f\"A‰„µ GGVƒµ ßGO˜ƒµ GÃO Þ \f\"A „Éà \f\" Þ \f\"A @! A‰ƒƒßâÝ \"‚ã !ƒ <ƒúÃäåˆÃæçˆâ !‚â J!‚!ƒ\fè !‚ ‚ .\n‡" [in-popup bind x-popup-menu nil tmm-short-cuts tmm-old-comp-map tmm-old-mb-map tmm-c-prompt tmm-table-undef history-len history out tmm-km-list gl-str run-hooks activate-menubar-hook mapcar #[(elt) ";ƒ ‰‡<… \"‡" [elt gl-str tmm-get-keymap in-popup] 3] tmm-mid-prompt tmm-add-shortcuts reverse car append add-hook minibuffer-setup-hook tmm-add-prompt ((byte-code "ŠÀÁÂ\"ˆÃÄ!ƒÄqˆÅ!ˆÇp!ˆ)À‡" [remove-hook minibuffer-setup-hook tmm-add-prompt get-buffer "*Completions*" use-local-map tmm-old-comp-map bury-buffer] 3)) completing-read " (up/down to change, PgUp to menu): " t assoc 0 try-completion last-command-event tmm-prompt keymapp (byte-code "ÀÁ!‡" [require mouse] 2) ((error)) (x-popup-menu nil bind) ((error)) call-interactively] 11 (#$ . 1561)]) #@216 Adds shortcuts to cars of elements of the list. Takes a list of lists with a string as car, returns list with shortcuts added to these cars. Stores a list of all the shortcuts in the free variable `tmm-short-cuts'. (defalias 'tmm-add-shortcuts #[(list) "ÀÂÃÄ !\")‡" [0 next-shortcut-number mapcar #[(elt) "@Á‰‰ÅÆO–‰ƒ%ÈÉ\f\"ƒ%\fÆ”‰‰TO– ƒC\nËWƒAÌÍ\n\"\nT\n‚CÁ „K‚Y B \fQAB+‡" [elt nil b f str 0 1 tmm-short-cuts string-match " \\([^ ]\\)" next-shortcut-number 10 format "%d" tmm-mid-prompt] 4] reverse list] 4 (#$ . 3166)]) (defalias 'tmm-define-keys #[nil "ÀÁ\n\"ˆÃÄ ÅÆ#ˆÃÄ ÇÆ#ˆÃÄ ÈÆ#ˆÃÄ ÉÊ#ˆÃÄ ËÌ#‡" [mapcar #[(str) "ÀÁ \nÃ#ˆÀÁ \n—Ã#‡" [define-key current-local-map str tmm-shortcut] 4] tmm-short-cuts define-key current-local-map [pageup] tmm-goto-completions [prior] "v" "" next-history-element "" previous-history-element] 4]) (defalias 'tmm-add-prompt #[nil "ÀÁÂ\"ˆÃÄ!ˆÅÄÆÇÈ$ˆÉ \nË \fÍÎÏ \f\"!ˆÐ ˆÑ‹ˆŠÒÓ!ˆÔÕÖ!!qˆË ÍÎÏ \"!ˆÐ ˆØ\n!ˆ)c)‡" [remove-hook minibuffer-setup-hook tmm-add-prompt make-local-hook minibuffer-exit-hook add-hook tmm-delete-map nil t selected-window win current-local-map tmm-old-mb-map use-local-map append make-sparse-keymap tmm-define-keys ((byte-code "ÀÁ\n\"ÄÅ !‘ˆ)ÄqˆÆbˆc‡" [mapcar car minibuffer-completion-table completions "*Completions*" display-completion-list 1 tmm-completion-prompt] 3)) other-window 1 window-buffer Electric-pop-up-window "*Completions*" tmm-old-comp-map select-window tmm-c-prompt] 5]) (defalias 'tmm-delete-map #[nil "ÀÁÂÃ#ˆ\f… Å\f!‡" [remove-hook minibuffer-exit-hook tmm-delete-map t tmm-old-mb-map use-local-map] 4]) #@42 Choose the shortcut that the user typed. (defalias 'tmm-shortcut #[nil "À !–‰ …2Æ Çšƒ$È ˆÉÊ\f Q!ˆÌ ‚2Í ˆÎÏ\"ˆ cˆÑ *‡" [char-to-string last-command-char nil s c tmm-short-cuts buffer-name "*Completions*" beginning-of-buffer re-search-forward "\\(^\\|[ ]\\)" tmm-mid-prompt choose-completion erase-buffer mapcar #[(elt) "@Á\nGT@G^O \nP˜…@‰‡" [elt 0 tmm-mid-prompt c s] 4] tmm-km-list exit-minibuffer] 5 (#$ . 4800) nil]) (defalias 'tmm-goto-completions #[nil "À  ˆÃÄ!ˆÅ !ˆÆ !‡" [buffer-string tmm-c-prompt erase-buffer switch-to-buffer-other-window "*Completions*" search-forward search-backward] 2 nil nil]) #@352 Prepends (DOCSTRING EVENT BINDING) to free variable `tmm-km-list'. The values are deduced from the argument ELT, that should be an element of keymap, an `x-popup-menu' argument, or an element of `x-popup-menu' argument (when IN-X-MENU is not-nil). Does it only if it is not already there. Uses free variable `tmm-table-undef' to keep undefined keys. (defalias 'tmm-get-keymap #[(elt &optional in-x-menu) "À‰‰ @ A‰Æ=ƒ\nÀBB‰‚TÈ\n\"„. <ƒ1É !‚4Ê !ƒ= ‰„. £<ƒJÉ £!‚NÊ £!ƒe A‰ƒe @;ƒe @‰„. ££<ƒtÉ ££!‚yÊ ££!ƒ¶ AA‰ƒ¶ @;ƒ¶ @‰ƒ¶\fƒ² A@A;ƒ² A@A‰ƒ² ƒ²\f P‰„.\f„. £££<ƒÇÉ £££!‚ÍÊ £££!ƒ  AAA‰ƒ  @;ƒ  @‰ƒ \fƒ  AA@A;ƒ  AA@A‰ƒ  ƒ \f P‰„.\f„.\n;ƒ. „ ¢;ƒ&\nÀ ‚.\nÀÌ B ƒ9 ;ƒ9  …T\f…TÈ\f \"†T\f\n BB B‰ ,‡" [nil elt event cache str km undefined tmm-table-undef assoc keymapp fboundp in-x-menu keymap tmm-km-list] 5 (#$ . 5433)]) #@300 Return the current binding of KEYSEQ, merging prefix definitions. If KEYSEQ is a prefix key that has local and gloibal bindings, we merge them into a single keymap which shows the proper order of the menu. However, for the menu bar itself, the value does not take account of `menu-bar-final-items'. (defalias 'tmm-get-keybind #[(keyseq) "À‰Ã\f!Å !ƒÀ †-ÆÇÈ\f!\"É\f!\nBÊ\f!\nBÆË\n\"ˆ *‡" [nil bind allbind key-binding keyseq keymapp mapcar cdr minor-mode-key-binding local-key-binding global-key-binding #[(in) "9ƒÁ!ƒK…,Á!…,Á\n!ƒ'\nÃA!¤‰‡Ã!‰‡" [in keymapp bind copy-sequence] 3]] 4 (#$ . 6329)]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [add-hook calendar-load-hook #[nil "ÀÁ!‡" [require cal-menu] 2] provide tmm] 3) emacs-19.30/lisp/tpu-edt.elc100666 12120 1 150002 6046536202 14165 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 20:05:09 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/tpu-edt.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`tpu-edt.el' was compiled for Emacs 19.29 or later")) #@25 TPU-edt version number. (defconst tpu-version "4.2" (#$ . 479)) #@64 *If non-nil (default), TPU-edt uses ispell for spell checking. (defconst tpu-have-ispell t (#$ . -549)) #@61 *If non-nil, TPU-edt kills modified buffers without asking. (defconst tpu-kill-buffers-silently nil (#$ . -659)) #@72 *Percentage of the screen to scroll for next/previous screen commands. (defvar tpu-percent-scroll 75 (#$ . -778)) #@64 *Number of columns the tpu-pan functions scroll left or right. (defvar tpu-pan-columns 16 (#$ . -898)) #@54 Non-nil if we are running Lucid Emacs or version 19. (defconst tpu-emacs19-p (byte-code "Á™?‡" [emacs-version "19"] 2) (#$ . 1007)) #@51 Non-nil if we are running Lucid Emacs version 19. (defconst tpu-lucid-emacs19-p (byte-code "…Á \"‡" [tpu-emacs19-p string-match "Lucid" emacs-version] 3) (#$ . 1146)) #@94 Maps the CSI function keys on the VT100 keyboard. CSI is DEC's name for the sequence [. (defvar CSI-map (make-sparse-keymap) (#$ . 1323)) #@94 Maps the SS3 function keys on the VT100 keyboard. SS3 is DEC's name for the sequence O. (defvar SS3-map (make-sparse-keymap) (#$ . 1472)) #@113 Maps the function keys on the VT100 keyboard preceeded by PF1. GOLD is the ASCII 7-bit escape sequence OP. (defvar GOLD-map (make-keymap) (#$ . 1622)) #@69 Maps the function keys on the VT100 keyboard preceeded by GOLD-CSI. (defvar GOLD-CSI-map (make-sparse-keymap) (#$ . 1784)) #@69 Maps the function keys on the VT100 keyboard preceeded by GOLD-SS3. (defvar GOLD-SS3-map (make-sparse-keymap) (#$ . 1913)) #@24 TPU-edt global keymap. (defvar tpu-global-map nil (#$ . 2042)) #@25 Original global keymap. (defvar tpu-original-global-map (copy-keymap global-map) (#$ . 2111)) (byte-code "ƒÁÂ!„ à Â\fBÅÂÆÇ#ˆÁ‡" [tpu-lucid-emacs19-p boundp minibuffer-local-ns-map make-sparse-keymap current-load-list put variable-documentation "Hack to give Lucid Emacs the same maps as ordinary Emacs."] 4) #@37 If non-nil, TPU-edt mode is active. (defvar tpu-edt-mode nil (#$ . 2431)) #@49 Last text deleted by a TPU-edt replace command. (defvar tpu-last-replaced-text "" (#$ . 2511)) #@48 Last text deleted by a TPU-edt remove command. (defvar tpu-last-deleted-region "" (#$ . 2612)) #@53 Last text deleted by a TPU-edt line-delete command. (defvar tpu-last-deleted-lines "" (#$ . 2713)) #@53 Last text deleted by a TPU-edt word-delete command. (defvar tpu-last-deleted-words "" (#$ . 2818)) #@63 Last character deleted by a TPU-edt character-delete command. (defvar tpu-last-deleted-char "" (#$ . 2923)) #@60 If non-nil, TPU-edt is searching in the forward direction. (defvar tpu-searching-forward t (#$ . 3037)) #@56 Last text searched for by the TPU-edt search commands. (defvar tpu-search-last-string "" (#$ . 3147)) #@62 If non-nil, TPU-edt uses regexp search and replace routines. (defvar tpu-regexp-p nil (#$ . 3255)) #@53 If non-nil, TPU-edt removes and inserts rectangles. (defvar tpu-rectangular-p nil (#$ . 3360)) #@58 True when TPU-edt is operating in the forward direction. (defvar tpu-advance t (#$ . 3461)) #@59 True when TPU-edt is operating in the backward direction. (defvar tpu-reverse nil (#$ . 3559)) #@60 If non-nil, control keys are set to perform TPU functions. (defvar tpu-control-keys nil (#$ . 3660)) #@36 File containing TPU-edt X key map. (defvar tpu-xkeys-file nil (#$ . 3767)) #@48 Mode line string to identify rectangular mode. (defvar tpu-rectangle-string nil (#$ . 3848)) #@49 Mode line string to identify current direction. (defvar tpu-direction-string nil (#$ . 3947)) #@51 History variable for tpu-edt-add-at-bol function. (defvar tpu-add-at-bol-hist nil (#$ . 4047)) #@51 History variable for tpu-edt-add-at-eol function. (defvar tpu-add-at-eol-hist nil (#$ . 4148)) #@52 History variable for search and replace functions. (defvar tpu-regexp-prompt-hist nil (#$ . 4249)) #@52 If non-nil, Return produces a newline and indents. (defvar tpu-newline-and-indent-p nil (#$ . 4354)) (make-variable-buffer-local (quote tpu-newline-and-indent-p)) #@47 Mode line string to identify AutoIndent mode. (defvar tpu-newline-and-indent-string nil (#$ . 4523)) (make-variable-buffer-local (quote tpu-newline-and-indent-string)) #@32 Saved value of the delete key. (defvar tpu-saved-delete-func nil (#$ . 4697)) (make-variable-buffer-local (quote tpu-saved-delete-func)) #@31 TPU-edt buffer local key map. (defvar tpu-buffer-local-map nil (#$ . 4840)) (byte-code "ÀÁ!ˆÂÃ!„\f\fà BÂÆ!„Æ BÂÈ!„'ÉÈ BÀÈ!‡" [make-variable-buffer-local tpu-buffer-local-map boundp tpu-original-mode-line mode-line-format current-load-list tpu-original-mm-alist minor-mode-alist tpu-mark-flag " "] 2) #@57 Set the mode for TPU-edt, or reset it to default Emacs. (defalias 'tpu-set-mode-line #[(for-tpu) "„\n  ‰‡ÅÂÆÇ!ÈÉÆÊ!ËÆÊ!ÌÆÍ!ÎÏÄÆÐ!ÆÑ!ÆÒ!ÆÓ!ÆÔ!ÆÕ!¯\"ˆÖ\fž„?×\fBØ\fž„IÙ\fBÚ\fž†TÛ\fB‰‡" [for-tpu tpu-original-mode-line mode-line-format tpu-original-mm-alist minor-mode-alist set-default purecopy "" mode-line-modified mode-line-buffer-identification " " global-mode-string tpu-mark-flag " %[(" mode-name mode-line-process "%n" ")%]--" (line-number-mode "L%l--") (column-number-mode "C%c--") (-3 . "%p") "-%-" tpu-newline-and-indent-p (tpu-newline-and-indent-p tpu-newline-and-indent-string) tpu-rectangular-p (tpu-rectangular-p tpu-rectangle-string) tpu-direction-string (tpu-direction-string tpu-direction-string)] 20 (#$ . 5160)]) #@65 Make sure mode-line in the current buffer reflects all changes. (defalias 'tpu-update-mode-line #[nil "À ƒ Á‚\nÂ\fƒÅ ‡ÆÇ !ˆÈÉ!‡" [tpu-mark "M" " " tpu-mark-flag tpu-emacs19-p force-mode-line-update set-buffer-modified-p buffer-modified-p sit-for 0] 2 (#$ . 5906)]) (byte-code "ƒÁÂÃ\"ˆÁÄÃ\"ˆ‚ ƒÁÆÃ\"ˆÁÇÃ\"ˆÈÉ!„)Ê  É B ÈÌ!„9Ê \fÌ B Á‡" [tpu-lucid-emacs19-p add-hook zmacs-deactivate-region-hook tpu-update-mode-line zmacs-activate-region-hook tpu-emacs19-p activate-mark-hook deactivate-mark-hook boundp tpu-match-beginning-mark make-marker current-load-list tpu-match-end-mark] 3) #@41 Set markers at match beginning and end. (defalias 'tpu-set-match #[nil "ÀÁ”T!ÀÁ•!‰‡" [copy-marker 0 tpu-match-beginning-mark tpu-match-end-mark] 2 (#$ . 6512)]) #@40 Unset match beginning and end markers. (defalias 'tpu-unset-match #[nil "Á‰“ˆ\nÁ‰“‡" [tpu-match-beginning-mark nil tpu-match-end-mark] 3 (#$ . 6681)]) #@51 Returns the location of the last match beginning. (defalias 'tpu-match-beginning #[nil "À !S‡" [marker-position tpu-match-beginning-mark] 2 (#$ . 6839)]) #@45 Returns the location of the last match end. (defalias 'tpu-match-end #[nil "À !‡" [marker-position tpu-match-end-mark] 2 (#$ . 6999)]) #@111 Returns t if point is between tpu-match markers. Otherwise sets the tpu-match markers to nil and returns nil. (defalias 'tpu-check-match #[nil "À !pšƒ.` !SYƒ.` !W„, !S !Uƒ. !`Uƒ.ćŠˆÆ‡" [marker-buffer tpu-match-beginning-mark marker-position tpu-match-end-mark t tpu-unset-match nil] 3 (#$ . 7141)]) #@39 Show the values of the match markers. (defalias 'tpu-show-match-markers #[nil "À !… !ÄÅ … SÂ!Ç!`p&)‡" [markerp tpu-match-beginning-mark marker-position beg message "(%s, %s) in %s -- current %s in %s" tpu-match-end-mark marker-buffer] 7 (#$ . 7458) nil]) (defalias 'tpu-caar #[(thingy) "@@‡" [thingy] 1]) (defalias 'tpu-cadr #[(thingy) "A@‡" [thingy] 1]) #@114 TPU-edt version of the mark function. Return the appropriate value of the mark for the current version of Emacs. (defalias 'tpu-mark #[nil "ƒ Á\n?!‡ ƒ\f…Á ?!‡Á ‡" [tpu-lucid-emacs19-p mark zmacs-regions tpu-emacs19-p mark-active transient-mark-mode] 2 (#$ . 7833)]) #@132 TPU-edt verion of the `set-mark' function. Sets the mark at POS and activates the region acording to the current version of Emacs. (defalias 'tpu-set-mark #[(pos) "À !ˆ\n… …à ‡" [set-mark pos tpu-lucid-emacs19-p zmacs-activate-region] 2 (#$ . 8112)]) #@28 Read a string with PROMPT. (defalias 'tpu-string-prompt #[(prompt history-symbol) "ƒ\fÁ\nɉ\f%‡Å\n!‡" [tpu-emacs19-p read-from-minibuffer prompt nil history-symbol read-string] 6 (#$ . 8373)]) #@39 Most recent response to tpu-y-or-n-p. (defvar tpu-last-answer nil (#$ . 8575)) #@178 Prompt for a y or n answer with positive default. Optional second argument NOT-YES changes default to negative. Like Emacs `y-or-n-p', but also accepts space as y and DEL as n. (defalias 'tpu-y-or-n-p #[(prompt &optional not-yes) "ÀÁ \fƒ\fÅ‚ Æ#!ˆÇƒ|ÉÊ ‰ ÌU„3 ÍU„3 ÎUƒ9Ç‚x ÐU„N ÑU„N ÒUƒTÉ‚x ÓUƒb\f?‚xÇÔ ˆÀÁÕ \fƒtÅ‚uÆ#!ˆ)‚)‡" [message format "%s[%s]" prompt not-yes "n" "y" t doit nil read-char ans 121 89 32 tpu-last-answer 110 78 127 13 beep "Please answer y or n. %s[%s]"] 6 (#$ . 8661)]) #@78 Replace a key in the TPU-edt local key map. Create the key map if necessary. (defalias 'tpu-local-set-key #[(key func) "À !„ ƒà!‚Ä Å !ˆÆ\"‡" [keymapp tpu-buffer-local-map current-local-map copy-keymap make-sparse-keymap use-local-map local-set-key key func] 3 (#$ . 9199)]) #@130 Return the vertical position of point in the selected window. Top line is 0. Counts each text line only once, even if it wraps. (defalias 'tpu-current-line #[nil "ÀÁ `\"iÂUƒÂÂÄ\\\\‡" [count-lines window-start 0 1 -1] 3 (#$ . 9494)]) #@60 The set of user-defined markers (breadcrumbs), as a plist. (defvar tpu-breadcrumb-plist nil (#$ . 9739)) #@72 Drops a breadcrumb that can be returned to later with goto-breadcrumb. (defalias 'tpu-drop-breadcrumb #[(num) "À \np`D#ˆÃÄ\n\"‡" [put tpu-breadcrumb-plist num message "Mark %d set."] 5 (#$ . 9850) "p"]) #@51 Returns to a breadcrumb set with drop-breadcrumb. (defalias 'tpu-goto-breadcrumb #[(num) " NƒÂ N@!ˆÃ N!bˆÄÅ \"‡ÄÆ \"‡" [tpu-breadcrumb-plist num switch-to-buffer tpu-cadr message "mark %d found." "mark %d not found."] 3 (#$ . 10059) "p"]) #@127 Change the case of the character under the cursor or region. Accepts a prefix argument of the number of characters to invert. (defalias 'tpu-change-case #[(num) "À ƒ/Á   \fVƒ*\ff—\ffUƒÅ‚Æ\f‰T\"ˆ\fT‚ ÇÈ!*‡É ƒ]Ê Ë  \fVƒY\ff—\ffUƒMÅ‚NÆ\f‰T\"ˆ\fT‚:Ì *‡ ÎV…Šg—gUƒoÅ‚pÆ``T\"ˆƒ~ЂÑuˆ S‰ ‚_‡" [tpu-mark region-beginning region-end end beg upcase-region downcase-region tpu-unselect t tpu-check-match tpu-match-beginning tpu-match-end tpu-unset-match num 0 tpu-reverse -1 1] 4 (#$ . 10310) "p"]) #@67 Fill paragraph or marked region. With argument, fill and justify. (defalias 'tpu-fill #[(num) "À ƒÁ`À \n#ˆÃÄ!‡Å\n!‡" [tpu-mark fill-region num tpu-unselect t fill-paragraph] 4 (#$ . 10834) "P"]) #@35 Print the TPU-edt version number. (defalias 'tpu-version #[nil "ÀÁ\n\"‡" [message "TPU-edt version %s by Rob Riepel (riepel@networking.stanford.edu)" tpu-version] 3 (#$ . 11037) nil]) #@23 Sets the screen size. (defalias 'tpu-reset-screen-size #[(height width) "À !ˆÂ !‡" [set-screen-height height set-screen-width width] 2 (#$ . 11227) "nnew screen height: \nnnew screen width: "]) #@59 Toggle between 'newline and indent' and 'simple newline'. (defalias 'tpu-toggle-newline-and-indent #[nil "ƒÁÃÄÅÆ\"ˆ‚ÇÈÄÅÉ\"ˆÊ ˆt…,Ë̃*Í‚+Î\"‡" [tpu-newline-and-indent-p "" tpu-newline-and-indent-string nil tpu-local-set-key " " newline " AutoIndent" t newline-and-indent tpu-update-mode-line message "Carriage return inserts a newline%s" " and indents." "."] 3 (#$ . 11427) nil]) #@87 Checks the spelling of the region, or of the entire buffer if no region is selected. (defalias 'tpu-spell-check #[nil "ƒÁ ƒÂÁ `\"ˆ‚)à ˆ‚)Á ƒ&ÄÁ `\"ˆ‚)Å ˆÁ …1ÆÇ!‡" [tpu-have-ispell tpu-mark ispell-region ispell-buffer spell-region spell-buffer tpu-unselect t] 3 (#$ . 11826) nil]) #@39 Switches in and out of overwrite mode (defalias 'tpu-toggle-overwrite-mode #[nil "ƒ Á \"ˆÀÄ!‡ÅÂ!ÁÂÆ\"ˆÀÇ!‡" [overwrite-mode tpu-local-set-key "" tpu-saved-delete-func 0 local-key-binding picture-backward-clear-column 1] 3 (#$ . 12123) nil]) #@74 Insert a character or control code according to its ASCII decimal value. (defalias 'tpu-special-insert #[(num) "ƒÁÂ!ˆ ƒ ‚Äc‡" [overwrite-mode delete-char 1 num 0] 2 (#$ . 12375) "P"]) #@91 Read next input character and insert it. This is useful for inserting control characters. (defalias 'tpu-quoted-insert #[(num) "À \nƒ Ã\f!ˆÅ \f\")‡" [read-char char overwrite-mode delete-char num insert-char] 3 (#$ . 12572) "*p"]) #@23 TPU-like include file (defalias 'tpu-include #[(file) "ŠÀ !ˆÂÃ!)‡" [insert-file file message ""] 2 (#$ . 12811) "fInclude file: "]) #@19 TPU-like get file (defalias 'tpu-get #[(file) "À !‡" [find-file file] 2 (#$ . 12949) "FFile to get: "]) #@80 Tells what line the point is on, and the total number of lines in the buffer. (defalias 'tpu-what-line #[nil "mƒ\fÀÁÂÃd\"\"‡ÀÄÂÃ`T\"ÂÃd\"#‡" [message "You are at the End of Buffer. The last line is %d." count-lines 1 "Line %d of %d"] 6 (#$ . 13059) nil]) #@66 Exit the way TPU does, save current buffer and ask about others. (defalias 'tpu-exit #[nil "À Á=„\n ‡Ã ˆÄ ‡" [recursion-depth 0 exit-recursive-edit save-buffer save-buffers-kill-emacs] 2 (#$ . 13323) nil]) #@70 Quit the way TPU does, ask to make sure changes should be abandoned. (defalias 'tpu-quit #[nil "À Á ƒ2\nƒ2 @Å\f!ƒ+Æ\f!ƒ+ÇÈ!ƒ)ÉÁ!ˆ‚+Ê A)‚\n…9ÉÁ!*‡" [buffer-list t working list buffer buffer-file-name buffer-modified-p tpu-y-or-n-p "Modifications will not be saved, continue quitting? " kill-emacs nil] 2 (#$ . 13537) nil]) (byte-code "ÀÁMˆÂÁMˆÃÁMˆÄÁMˆÅÆMˆÇÆMˆÈÉMˆÊÉMˆËÌMˆÍÌMˆÎÏMˆÐÏMˆÑÒMˆÓÒMˆÔÕMˆÖÕMˆ×ØMˆÙØMˆÚÛMˆÜÛMˆÝÞMˆßÞMˆàáMˆâáMˆãäMˆåäMˆæç!„rçèMˆé*ê+B+ì-í+B+îï!„ðñò\"/ï+B+îó!„¢ðñô\"3ó+B+îõ!„±ö5õ+B+î÷!„Àø7÷+B+îù!„Ïú9ù+B+îû!„Þü;û+B+À‡" [tpu-edt-mode tpu-edt-on TPU-EDT-MODE tpu-edt TPU-EDT exit tpu-exit EXIT Get tpu-get GET include tpu-include INCLUDE quit tpu-quit QUIT spell tpu-spell-check SPELL what\ line tpu-what-line WHAT\ LINE replace tpu-lm-replace REPLACE help tpu-help HELP set\ cursor\ free tpu-set-cursor-free SET\ CURSOR\ FREE set\ cursor\ bound tpu-set-cursor-bound SET\ CURSOR\ BOUND set\ scroll\ margins tpu-set-scroll-margins SET\ SCROLL\ MARGINS fboundp next-line-internal line-move "\f\n _______________________ _______________________________\n | HELP | Do | | | | | |\n |KeyDefs| | | | | | |\n |_______|_______________| |_______|_______|_______|_______|\n _______________________ _______________________________\n | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L |\n | | |Sto Tex| | key |E-Help | Find |Undel L|\n |_______|_______|_______| |_______|_______|_______|_______|\n |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W |\n | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W|\n |_______|_______|_______| |_______|_______|_______|_______|\n |Move up| |Forward|Reverse|Remove | Del C |\n | Top | |Bottom | Top |Insert |Undel C|\n _______|_______|_______ |_______|_______|_______|_______|\n |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | |\n |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter |\n |_______|_______|_______| |_______|_______|_______| |\n | Line |Select | Subs |\n | Open Line | Reset | |\n |_______________|_______|_______|\n" tpu-help-keypad-map current-load-list "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f\n\n Control Characters\n\n ^A toggle insert and overwrite\n ^B recall\n ^E end of line\n\n ^G Cancel current operation\n ^H beginning of line\n ^J delete previous word\n\n ^K learn\n ^L insert page break\n ^R remember (during learn), re-center\n\n ^U delete to beginning of line\n ^V quote\n ^W refresh\n\n ^Z exit\n ^X^X exchange point and mark - useful for checking region boundaries\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f\n Gold- Functions\n\n B Next Buffer - display the next buffer (all buffers)\n C Recall - edit and possibly repeat previous commands\n E Exit - save current buffer and ask about others\n G Get - load a file into a new edit buffer\n\n I Include - include a file in this buffer\n K Kill Buffer - abandon edits and delete buffer\n M Buffer Menu - display a list of all buffers\n N Next File Buffer - display next buffer containing a file\n\n O Occur - show following lines containing REGEXP\n Q Quit - exit without saving anything\n R Toggle rectangular mode for remove and insert\n S Search and substitute - line mode REPLACE command\n\n ^T Toggle control key bindings between TPU and emacs\n U Undo - undo the last edit\n W Write - save current buffer\n X Exit - save all modified buffers and exit\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f\n\n More extensive documentation on TPU-edt can be found in the `Commentary'\n section of tpu-edt.el. This section can be accessed through the standard\n Emacs help facility using the `p' option. Once you exit TPU-edt Help, one\n of the following key sequences is sure to get you there.\n\n ^h p if you're not yet using TPU-edt\n Gold-PF2 p if you're using TPU-edt\n\n Alternatively, fire up Emacs help from the command prompt, with\n\n M-x help-for-help p \n\n Where `M-x' might be any of `Gold-KP7', 'Do', or 'ESC-x'.\n\n When you successfully invoke this part of the Emacs help facility, you\n will see a buffer named `*Finder*' listing a number of topics. Look for\n tpu-edt under `emulations'.\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f\n\n *** No more help, use P to view previous screen" tpu-help-text boundp tpu-help-enter format "%s" "OM" tpu-help-return " " tpu-help-N "N" tpu-help-n "n" tpu-help-P "P" tpu-help-p "p"] 3) #@23 Display TPU-edt help. (defalias 'tpu-help #[nil "À‹‡" [((byte-code "ÀÁ!„ÂÁ!ˆÃÁ!ˆ\fcˆ cˆÆÃÁ!ˆÈ ˆÉ ˆÊyˆË ˆÌ‰‰ š?…Ó ƒFÑÒ!‚KÑÓ!ÔÕ\"šƒcÌ È ˆ‚0š„sšƒŒ ƒ€ÌÙÚˆ‚0Û ˆÊyˆË ˆ‚0š„œšƒµ ƒ©ÌÞ߈‚0à ˆÊyˆË ˆ‚0š„0Æ á!ˆâ!„0ãä!ˆ‚0+‡" [get-buffer "*TPU-edt Help*" generate-new-buffer switch-to-buffer tpu-help-keypad-map tpu-help-text t buffer-read-only delete-other-windows tpu-move-to-beginning 1 tpu-line-to-top-of-window nil split fkey key tpu-help-return read-key-sequence "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, P=prev): " "Press the key you want help on (RET to exit, N next screen, P prev screen): " format "%s" tpu-help-enter tpu-help-N tpu-help-n (scroll-other-window 8) ((error)) forward-page tpu-help-P tpu-help-p (scroll-other-window -8) ((error)) backward-page describe-key key-binding sit-for 3] 3))] 1 (#$ . 18752) nil]) #@67 Inserts an escape character, and so becomes the escape-key alias. (defalias 'tpu-insert-escape #[nil "Àc‡" [""] 1 (#$ . 19673) nil]) #@31 Inserts a formfeed character. (defalias 'tpu-insert-formfeed #[nil "Àc‡" ["\f"] 1 (#$ . 19813) nil]) #@27 Saved value of Control-r. (defvar tpu-saved-control-r nil (#$ . 19920)) #@35 Ends the current macro definition (defalias 'tpu-end-define-macro-key #[(key) "ÀÁ!ˆÂ \f\"ˆÂÅ\"‡" [end-kbd-macro nil global-set-key key last-kbd-macro "" tpu-saved-control-r] 3 (#$ . 19998) "kPress the key you want to use to do what was just learned: "]) #@63 Bind a set of keystrokes to a single key, or key combination. (defalias 'tpu-define-macro-key #[nil "ÀÁ!ÃÁÄ\"ˆÅÆ!‡" [global-key-binding "" tpu-saved-control-r global-set-key tpu-end-define-macro-key start-kbd-macro nil] 3 (#$ . 20261) nil]) #@108 Kills the current buffer. If tpu-kill-buffers-silently is non-nil, kills modified buffers without asking. (defalias 'tpu-kill-buffer #[nil "ƒÁÂ!ˆÃp!‡" [tpu-kill-buffers-silently set-buffer-modified-p nil kill-buffer] 2 (#$ . 20511) nil]) #@34 Save all buffers and exit emacs. (defalias 'tpu-save-all-buffers-kill-emacs #[nil "ÀÂÀ!)‡" [t delete-old-versions save-buffers-kill-emacs] 2 (#$ . 20759) nil]) #@44 Save all modified buffers without exiting. (defalias 'tpu-write-current-buffers #[nil "ÀÁ!‡" [save-some-buffers t] 2 (#$ . 20926) nil]) #@28 Go to next buffer in ring. (defalias 'tpu-next-buffer #[nil "ÀÁ !@!‡" [switch-to-buffer reverse buffer-list] 3 (#$ . 21068) nil]) #@65 Go to next buffer in ring that is visiting a file or directory. (defalias 'tpu-next-file-buffer #[nil "ÀÁ !Ãp\n\"‰„ÄÅ!ˆÆÇ\n!@!)‡" [tpu-make-file-buffer-list buffer-list list delq error "No other buffers." switch-to-buffer reverse] 4 (#$ . 21205) nil]) #@80 Returns names from BUFFER-LIST excluding those beginning with a space or star. (defalias 'tpu-make-file-buffer-list #[(buffer-list) "ÀÁÂÃ\f\"\"‡" [delq nil mapcar #[(b) "À !ÂHÃU†À !ÂHÄU?… ‡" [buffer-name b 0 32 42] 2] buffer-list] 5 (#$ . 21467)]) #@26 Move to the next window. (defalias 'tpu-next-window #[nil "À ƒ ÁÂ!‡ÃÄ!‡" [one-window-p message "There is only one window on screen." other-window 1] 2 (#$ . 21725) nil]) #@30 Move to the previous window. (defalias 'tpu-previous-window #[nil "À ƒ ÁÂ!‡ÃÄ !‡" [one-window-p message "There is only one window on screen." select-window previous-window] 2 (#$ . 21902) nil]) #@68 Switches in and out of regular expression search and replace mode. (defalias 'tpu-toggle-regexp #[nil "?Á ˆt…ÂÃĂÅ\"‡" [tpu-regexp-p tpu-set-search message "Regular expression search and substitute %sabled." "en" "dis"] 3 (#$ . 22103) nil]) #@66 Read a string, adding 'RE' to the prompt if tpu-regexp-p is set. (defalias 'tpu-regexp-prompt #[(prompt) "…Á\nP\fƒŠƉ‰Ç%‚È !)‡" [tpu-regexp-p "RE " prompt re-prompt tpu-emacs19-p read-from-minibuffer nil tpu-regexp-prompt-hist read-string] 6 (#$ . 22360)]) #@94 Search for a string or regular expression. The search is performed in the current direction. (defalias 'tpu-search #[nil "À ˆÁÂ!‡" [tpu-set-search tpu-search-internal ""] 2 (#$ . 22632) nil]) #@91 Search for a string or regular expression. The search is begins in the forward direction. (defalias 'tpu-search-forward #[nil "ÀÂÀ!ˆÃÄ!‡" [t tpu-searching-forward tpu-set-search tpu-search-internal ""] 2 (#$ . 22830) nil]) #@91 Search for a string or regular expression. The search is begins in the reverse direction. (defalias 'tpu-search-reverse #[nil "ÀÂÃ!ˆÄÅ!‡" [nil tpu-searching-forward tpu-set-search t tpu-search-internal ""] 2 (#$ . 23060) nil]) #@114 Search for the same string or regular expression as last time. The search is performed in the current direction. (defalias 'tpu-search-again #[nil "À !‡" [tpu-search-internal tpu-search-last-string] 2 (#$ . 23295) nil]) #@143 Set the search functions and set the search direction to the current direction. If an argument is specified, don't set the search direction. (defalias 'tpu-set-search #[(&optional arg) "„\n …  ƒ\"\fƒÅÆMˆÇÈM‡ÅÉMˆÇÊM‡\fƒ.ÅÈMˆÇÆM‡ÅÊMˆÇÉM‡" [arg tpu-advance t tpu-searching-forward tpu-regexp-p tpu-emacs-search re-search-forward tpu-emacs-rev-search re-search-backward search-forward search-backward] 2 (#$ . 23522)]) #@44 Search for a string or regular expression. (defalias 'tpu-search-internal #[(pat &optional quiet) "Á˜„\n‚ ÂÃ!Å ˆÆ ˆ…È\f!É\fÊË#ƒ/Ì ˆÍ b‚†ÆË!ˆÊ‰Š?Æ ˆÑ\fÊË#Ò”*ƒqÓÔÕƒ_Ö‚`×\"!……bˆÌ ˆØ ‚…?……ÚÛƒ‚Ý‚ƒÁ\f#*)‡" [pat "" tpu-regexp-prompt "Search: " tpu-search-last-string tpu-unset-match tpu-adjust-search case-fold-search tpu-check-search-case tpu-emacs-search nil t tpu-set-match tpu-match-beginning pos found tpu-searching-forward tpu-emacs-rev-search 0 tpu-y-or-n-p format "Found in %s direction. Go there? " "reverse" "forward" tpu-toggle-search-direction quiet message "%sSearch failed: \"%s\"" tpu-regexp-p "RE "] 4 (#$ . 23953)]) (byte-code "ÀÁKM‡" [tpu-search-internal-core tpu-search-internal] 2) #@42 Returns t if string contains upper case. (defalias 'tpu-check-search-case #[(string) "ƒqÁ\n!ÃÄÈÉ\"‰ƒ# Ê\\ËIˆ‚ÈÌ\"‰ƒ8 Ê\\ËIˆ‚#ÈÍ\"‰ƒM Ê\\ËIˆ‚8ÈÎ\"‰ƒj Ê\\ËIˆ Ï\\ËIˆ‚M‰—˜+‡\n‰—˜‡" [tpu-regexp-p copy-sequence string nil 0 pos case-fold-search pat string-match "\\\\\\\\" 1 46 "\\\\B" "\\\\W" "\\\\S." 2] 3 (#$ . 24698)]) #@140 For forward searches, move forward a character before searching, and backward a character after a failed search. Arg means end of search. (defalias 'tpu-adjust-search #[(&optional arg) "… ƒo?…Âu‡m?…Ãu‡" [tpu-searching-forward arg -1 1] 1 (#$ . 25062)]) #@79 Toggle the TPU-edt search direction. Used for reversing a search in progress. (defalias 'tpu-toggle-search-direction #[nil "?ÁÂ!ˆt…ÃăłÆ\"‡" [tpu-searching-forward tpu-set-search t message "Searching %sward." "for" "back"] 3 (#$ . 25331) nil]) #@51 Set search direction forward and exit minibuffer. (defalias 'tpu-search-forward-exit #[nil "ÀÂÀ!ˆÃ ‡" [t tpu-searching-forward tpu-set-search exit-minibuffer] 2 (#$ . 25591) nil]) #@52 Set search direction backward and exit minibuffer. (defalias 'tpu-search-backward-exit #[nil "ÀÂÃ!ˆÄ ‡" [nil tpu-searching-forward tpu-set-search t exit-minibuffer] 2 (#$ . 25778) nil]) #@46 Sets the mark to define one end of a region. (defalias 'tpu-select #[(&optional quiet) "À ƒ Á\n!‡Ã`!ˆÄ ˆ\n?…ÅÆ!‡" [tpu-mark tpu-unselect quiet tpu-set-mark tpu-update-mode-line message "Move the text cursor to select text."] 2 (#$ . 25971) "P"]) #@50 Removes the mark to unselect the current region. (defalias 'tpu-unselect #[(&optional quiet) "ÀÂÀ!ˆÃ ˆ\f?…ÅÆ!‡" [nil mark-ring tpu-set-mark tpu-update-mode-line quiet message "Selection canceled."] 2 (#$ . 26226) "P"]) #@48 Toggle rectangular mode for remove and insert. (defalias 'tpu-toggle-rectangle #[nil "?‰ƒ Á‚\fÂÄ ˆt… ÅƃǂÈ\"‡" [tpu-rectangular-p " Rect" "" tpu-rectangle-string tpu-update-mode-line message "Rectangular cut and paste %sabled." "en" "dis"] 4 (#$ . 26454) nil]) #@82 Adjust point and mark to mark upper left and lower right corners of a rectangle. (defalias 'tpu-arrange-rectangle #[nil "iÀ ˆi`à Vƒ& \nVƒÀ ‚9Ä\n!ˆÀ ˆÄ !‚9 \nV…9Ä\n!ˆÀ ˆÄ !ˆÀ *‡" [exchange-point-and-mark pc mc tpu-mark move-to-column-force] 2 (#$ . 26733)]) #@74 Delete the selected region. The text is saved for the tpu-paste command. (defalias 'tpu-cut-text #[nil "À ƒ' ƒ ˆÃ`À \f?#ˆÅÆ!‡À `{À `|ˆÅÆ!‡È ƒDÉ Ê  ‰\f {\f |ˆÍ *‡ÎÏ!‡" [tpu-mark tpu-rectangular-p tpu-arrange-rectangle picture-clear-rectangle overwrite-mode tpu-unselect t tpu-last-deleted-region tpu-check-match tpu-match-beginning tpu-match-end end beg tpu-unset-match error "No selection active."] 5 (#$ . 27004) nil]) #@110 Copy the selected region to the cut buffer without deleting it. The text is saved for the tpu-paste command. (defalias 'tpu-store-text #[nil "À ƒ\" ƒŠÂ ˆÃ`À \")ÅÆ!‡À `{ÅÆ!‡È ƒ1É Ê {Ë ‡ÌÍ!‡" [tpu-mark tpu-rectangular-p tpu-arrange-rectangle extract-rectangle picture-killed-rectangle tpu-unselect t tpu-last-deleted-region tpu-check-match tpu-match-beginning tpu-match-end tpu-unset-match error "No selection active."] 3 (#$ . 27445) nil]) #@105 Copy selected region to the cut buffer. In the absence of an argument, delete the selected region too. (defalias 'tpu-cut #[(arg) "ƒÁ ‡Â ‡" [arg tpu-store-text tpu-cut-text] 1 (#$ . 27900) "P"]) #@111 Append selected region to the tpu-cut buffer. In the absence of an argument, delete the selected region too. (defalias 'tpu-append-region #[(arg) "À ƒÁ   \f {P„\f |ˆÇÈ!*‡É ƒ=Ê Ë  \f {P„9\f |ˆÌ *‡ÍÎ!‡" [tpu-mark region-beginning region-end end beg tpu-last-deleted-region arg tpu-unselect t tpu-check-match tpu-match-beginning tpu-match-end tpu-unset-match error "No selection active."] 3 (#$ . 28106) "P"]) #@170 Delete one or specified number of lines after point. This includes the newline character at the end of each line. They are saved for the TPU-edt undelete-lines command. (defalias 'tpu-delete-current-line #[(num) "` yˆhÂ=„Ãcˆ`{`|)‡" [beg num 10 "\n" tpu-last-deleted-lines] 2 (#$ . 28538) "p"]) #@143 Delete text up to end of line. With argument, delete up to to Nth line-end past point. They are saved for the TPU-edt undelete-lines command. (defalias 'tpu-delete-to-eol #[(num) "`Áuˆ\nˆ`{`|)‡" [beg 1 num tpu-last-deleted-lines] 2 (#$ . 28845) "p"]) #@151 Delete text back to beginning of line. With argument, delete up to to Nth line-end past point. They are saved for the TPU-edt undelete-lines command. (defalias 'tpu-delete-to-bol #[(num) "`Á\n!ˆ`{`|)‡" [beg tpu-next-beginning-of-line num tpu-last-deleted-lines] 2 (#$ . 29108) "p"]) #@109 Delete one or specified number of words after point. They are saved for the TPU-edt undelete-words command. (defalias 'tpu-delete-current-word #[(num) "`Á\n!ˆ`{`|)‡" [beg tpu-forward-to-word num tpu-last-deleted-words] 2 (#$ . 29402) "p"]) #@110 Delete one or specified number of words before point. They are saved for the TPU-edt undelete-words command. (defalias 'tpu-delete-previous-word #[(num) "`Á\n!ˆ`{`|)‡" [beg tpu-backward-to-word num tpu-last-deleted-words] 2 (#$ . 29653) "p"]) #@135 Delete one or specified number of characters after point. The last character deleted is saved for the TPU-edt undelete-char command. (defalias 'tpu-delete-current-char #[(num) "ÁV…'m?…'`f ƒÄÅ!ˆÅuˆ‚ ÆÅ!ˆS‰‚‡" [num 0 tpu-last-deleted-char overwrite-mode picture-clear-column 1 delete-char] 3 (#$ . 29907) "p"]) #@103 Insert the last region or rectangle of killed text. With argument reinserts the text that many times. (defalias 'tpu-paste #[(num) "ÁV…)\nƒ`ŠÄ ?!ˆÆÇ!ˆ) bˆ)‚\"cˆS‰‚‡" [num 0 tpu-rectangular-p beg picture-yank-rectangle overwrite-mode message "" tpu-last-deleted-region] 3 (#$ . 30235) "p"]) #@108 Insert lines deleted by last TPU-edt line-deletion command. With argument reinserts lines that many times. (defalias 'tpu-undelete-lines #[(num) "` ÂVƒ cˆ S‰‚b)‡" [beg num 0 tpu-last-deleted-lines] 3 (#$ . 30544) "p"]) #@108 Insert words deleted by last TPU-edt word-deletion command. With argument reinserts words that many times. (defalias 'tpu-undelete-words #[(num) "` ÂVƒ cˆ S‰‚b)‡" [beg num 0 tpu-last-deleted-words] 3 (#$ . 30777) "p"]) #@125 Insert character deleted by last TPU-edt character-deletion command. With argument reinserts the character that many times. (defalias 'tpu-undelete-char #[(num) "ÁV…\nƒÃuˆÄÅ!ˆcˆÃuˆS‰‚‡" [num 0 overwrite-mode -1 delete-char 1 tpu-last-deleted-char] 3 (#$ . 31010) "p"]) #@66 Replace the selected region with the contents of the cut buffer. (defalias 'tpu-replace #[nil "À ƒÁ  ‰ {\f |ˆcˆÇÈ!*‡É ƒ:Ê Ë ‰ {Ì ??#ˆÏ *‡ÐÑ!‡" [tpu-mark region-beginning region-end end beg tpu-last-replaced-text tpu-last-deleted-region tpu-unselect t tpu-check-match tpu-match-beginning tpu-match-end replace-match case-replace tpu-regexp-p tpu-unset-match error "No selection active."] 5 (#$ . 31296) nil]) #@215 Replace the selected region with the contents of the cut buffer, and repeat most recent search. A numeric argument serves as a repeat count. A negative argument means replace all occurrences of the search string. (defalias 'tpu-substitute #[(num) "À „\nÁ ƒJ\nÃU?…IÀ „Á …M`Å ˆƒ+Çuˆ‚.\fbˆ\nÈUƒ<É\n!ˆ‚AË\n!ˆ)\nS‰‚ ‡ÌÍ!‡" [tpu-mark tpu-check-match num 0 beg tpu-replace tpu-searching-forward -1 1 tpu-search-internal tpu-search-last-string tpu-search-internal-core error "No selection active."] 3 (#$ . 31728) "p"]) #@64 Interactively search for OLD-string and substitute NEW-string. (defalias 'tpu-lm-replace #[(from to) "ÀÁ\fŘƒÆÇ!ˆÈ ˆÉ\fÀ\"ˆ ƒ?Ê „%ˉ‚ÌÍ!ˆÎ ‰ÐU„HÑU„HÒU„HÓUƒq`Õ??#ˆ\nTƒdÚuˆ‚hbˆ)É\fÀ\"ˆ‚;ÛU„†ÜU„†ÝUƒŽÉ\fÀ\"ˆ‚;ÞU„œßUƒ÷Š`Õ??#ˆ\nTƒ¹Úuˆ‚½bˆ)à\fÀ\"ˆÊ ƒñ`Õ??#ˆ\nTƒäÚuˆ‚èbˆ)à\fÀ\"ˆ‚Ã)Ë‚;áU„âUƒ+`Õ??#ˆ\nTƒ!Úuˆ‚%bˆ)Ë‚;ãU„9äUƒ;Ë)‚Ìå\n‰æU„Lç‚MÅ#*‡" [t 0 strings doit from "" error "No string to replace." tpu-set-search tpu-search-internal tpu-check-match nil message "Replace? Type Yes, No, All, Last, or Quit: " read-char ans 121 89 13 32 beg replace-match to case-replace tpu-regexp-p tpu-searching-forward -1 110 78 127 97 65 tpu-search-internal-core 108 76 113 81 "Replaced %s occurrence%s." 1 "s"] 6 (#$ . 32264) (list (tpu-regexp-prompt "Old String: ") (tpu-regexp-prompt "New String: "))]) #@269 A TPU-edt interface to the emacs replace functions. If TPU-edt is currently in regular expression mode, the emacs regular expression replace functions are used. If an argument is supplied, replacements are performed without asking. Only works in forward direction. (defalias 'tpu-emacs-replace #[(&optional dont-ask) "ƒÁÃ\fƒÅ‚Æ!‡Ã\fƒÇ‚È!‡" [dont-ask nil current-prefix-arg call-interactively tpu-regexp-p replace-regexp replace-string query-replace-regexp query-replace] 2 (#$ . 33176) "P"]) #@113 Add text to the beginning of each line in a region, or each line in the entire buffer if no region is selected. (defalias 'tpu-add-at-bol #[(text) "Á˜ƒ\nÂÃ!ˆÄ ƒ=Š`Ä VƒÅ ˆ`Ä Wƒ8ÆÇÄ È#ƒ8`Ä WƒÉ!ˆ‚)ÊÈ!‡ŠebˆÆÇËÈ#…Um?…UÉ!ˆ‚A)‡" [text "" error "No string specified." tpu-mark exchange-point-and-mark re-search-forward "^" t replace-match tpu-unselect nil] 4 (#$ . 33690) (list (tpu-string-prompt "String to add: " (quote tpu-add-at-bol-hist)))]) #@107 Add text to the end of each line in a region, or each line of the entire buffer if no region is selected. (defalias 'tpu-add-at-eol #[(text) "Á˜ƒ\nÂÃ!ˆÄ ƒ9Š`Ä VƒÅ ˆ`Ä Wƒ4ƈ`Ä Xƒ.cˆÆyˆ‚)ÇÈ!‡Šebˆm?…NƈcˆÆyˆ‚=)‡" [text "" error "No string specified." tpu-mark exchange-point-and-mark nil tpu-unselect t] 2 (#$ . 34152) (list (tpu-string-prompt "String to add: " (quote tpu-add-at-eol-hist)))]) #@60 Removes trailing whitespace from every line in the buffer. (defalias 'tpu-trim-line-ends #[nil "À ‡" [picture-clean] 1 (#$ . 34564) nil]) #@102 Move to the next character in the current direction. A repeat count means move that many characters. (defalias 'tpu-char #[(num) "ƒÁ\n!‡Ã\n!‡" [tpu-advance tpu-forward-char num tpu-backward-char] 2 (#$ . 34709) "p"]) #@54 Move right ARG characters (left if ARG is negative). (defalias 'tpu-forward-char #[(num) "u‡" [num] 1 (#$ . 34935) "p"]) #@54 Move left ARG characters (right if ARG is negative). (defalias 'tpu-backward-char #[(num) "À !‡" [backward-char num] 2 (#$ . 35063) "p"]) #@37 List of additional word separators. (defconst tpu-word-separator-list nil (#$ . 35207)) #@94 Characters to skip when moving by word. Additional word separators are added to this string. (defconst tpu-skip-chars "^ " (#$ . 35301)) #@109 Move to the beginning of the next word in the current direction. A repeat count means move that many words. (defalias 'tpu-word #[(num) "ƒÁ\n!‡Ã\n!‡" [tpu-advance tpu-forward-to-word num tpu-backward-to-word] 2 (#$ . 35446) "p"]) #@98 Move forward until encountering the beginning of a word. With argument, do this that many times. (defalias 'tpu-forward-to-word #[(num) "ÁV…Bm?…B`È`\nbˆlƒÅuˆ‚:`f>ƒ1ÅuˆÇ\fwˆ‚:\fwˆÇ\fwˆ*S‰‚‡" [num 0 beg nil end 1 tpu-word-separator-list " " tpu-skip-chars] 3 (#$ . 35685) "p"]) #@99 Move backward until encountering the beginning of a word. With argument, do this that many times. (defalias 'tpu-backward-to-word #[(num) "ÁV…Mo?…M`Áyˆ`\nbˆnƒÄuˆ‚E`Sf >ƒ-Äuˆ‚EÆ xˆ xˆn„E`fzÈUƒEÄuˆ*S‰‚‡" [num 0 beg end -1 tpu-word-separator-list " " tpu-skip-chars 32] 3 (#$ . 35988) "p"]) #@52 Add new word separators for TPU-edt word commands. (defalias 'tpu-add-word-separators #[(separators) "À\nG W…]\n H\n ‰TO‰>„VÇ\f\" ÈUƒ2 ÊP ‚V ËUƒA ÌP ‚V ÍUƒP ÎP ‚V \fP T*‚*‡" [0 n separators length ss char tpu-word-separator-list append 45 tpu-skip-chars "\\-" 92 "\\\\" 94 "\\^"] 5 (#$ . 36301) "sSeparators: "]) #@41 Reset word separators to default value. (defalias 'tpu-reset-word-separators #[nil "À‰‡" [nil tpu-word-separator-list "^ " tpu-skip-chars] 2 (#$ . 36651) nil]) #@52 Set new word separators for TPU-edt word commands. (defalias 'tpu-set-word-separators #[(separators) "À ˆÁ\n!‡" [tpu-reset-word-separators tpu-add-word-separators separators] 2 (#$ . 36821) "sSeparators: "]) #@62 Move to next line. Prefix argument serves as a repeat count. (defalias 'tpu-next-line #[(num) "À !ˆÂ‰‡" [next-line-internal num next-line this-command] 2 (#$ . 37035) "p"]) #@66 Move to previous line. Prefix argument serves as a repeat count. (defalias 'tpu-previous-line #[(num) "À [!ˆÂ‰‡" [next-line-internal num previous-line this-command] 2 (#$ . 37215) "p"]) #@136 Move to beginning of line; if at beginning, move to beginning of next line. Accepts a prefix argument for the number of lines to move. (defalias 'tpu-next-beginning-of-line #[(num) "ÀÁ!ˆÁ\nZy‡" [backward-char 1 num] 2 (#$ . 37409) "p"]) #@99 Move to the next end of line in the current direction. A repeat count means move that many lines. (defalias 'tpu-end-of-line #[(num) "ƒÁ\n!‡Ã\n!‡" [tpu-advance tpu-next-end-of-line num tpu-previous-end-of-line] 2 (#$ . 37652) "p"]) #@118 Move to end of line; if at end, move to end of next line. Accepts a prefix argument for the number of lines to move. (defalias 'tpu-next-end-of-line #[(num) "Àuˆ ‡" [1 num] 1 (#$ . 37894) "p"]) #@77 Move EOL upward. Accepts a prefix argument for the number of lines to move. (defalias 'tpu-previous-end-of-line #[(num) "À Z‡" [1 num] 2 (#$ . 38095) "p"]) #@36 Move point to end of current line. (defalias 'tpu-current-end-of-line #[nil "`Áˆ`U…ÂÃ!)‡" [beg nil message "You are already at the end of a line."] 2 (#$ . 38258) nil]) #@109 Move to the beginning of the next line in the current direction. A repeat count means move that many lines. (defalias 'tpu-line #[(num) "ƒÁ\n!‡Ã\n!‡" [tpu-advance tpu-forward-line num tpu-backward-line] 2 (#$ . 38439) "p"]) #@75 Move to beginning of next line. Prefix argument serves as a repeat count. (defalias 'tpu-forward-line #[(num) "y‡" [num] 1 (#$ . 38672) "p"]) #@77 Move to beginning of previous line. Prefix argument serves as repeat count. (defalias 'tpu-backward-line #[(num) "n„À Y„ ÂZ [y‡" [0 num 1] 2 (#$ . 38821) "p"]) #@102 Move to the next paragraph in the current direction. A repeat count means move that many paragraphs. (defalias 'tpu-paragraph #[(num) "ƒÁ\n!‡Ã\n!‡" [tpu-advance tpu-next-paragraph num tpu-previous-paragraph] 2 (#$ . 38993) "p"]) #@98 Move to beginning of the next paragraph. Accepts a prefix argument for the number of paragraphs. (defalias 'tpu-next-paragraph #[(num) "Àyˆm„- ÀVƒ-ÂÃÄÅ#ƒ'ÂÆÄÅ#ƒ$À”bˆ‚'dbˆ S‚ÀyˆÄ‡" [0 num re-search-forward "^[ ]*$" nil t "[^ \n]"] 4 (#$ . 39231) "p"]) #@98 Move to beginning of previous paragraph. Accepts a prefix argument for the number of paragraphs. (defalias 'tpu-previous-paragraph #[(num) "Àˆo„: ÂVƒ:ÃÄÀÅ#ƒ1ÃÆÀÅ#ƒ1ÃÄÀÅ#ƒ1ÇÆÀÅ#ˆÂ”b„4ebˆ S‚ÂyˆÀ‡" [nil num 0 re-search-backward "^[ ]*$" t "[^ \n]" re-search-forward] 4 (#$ . 39498) "p"]) #@92 Move to the next page in the current direction. A repeat count means move that many pages. (defalias 'tpu-page #[(num) "ƒ Á\n!ˆ‚Ã\n!ˆm…ÄÅ!‡" [tpu-advance forward-page num backward-page recenter -1] 2 (#$ . 39801) "p"]) #@114 Scroll the display to the next section in the current direction. A repeat count means scroll that many sections. (defalias 'tpu-scroll-window #[(num) "ƒÁ\n!‡Ã\n!‡" [tpu-advance tpu-scroll-window-up num tpu-scroll-window-down] 2 (#$ . 40033) "p"]) #@94 Scroll the display down to the next section. A repeat count means scroll that many sections. (defalias 'tpu-scroll-window-down #[(num) "À  S\f _Æ¥_È[!ˆ V… ÉÊ!+‡" [tpu-current-line beg window-height height num tpu-percent-scroll 100 lines next-line-internal recenter 0] 3 (#$ . 40289) "p"]) #@92 Scroll the display up to the next section. A repeat count means scroll that many sections. (defalias 'tpu-scroll-window-up #[(num) "À  S\f _Æ¥_È!ˆ \\ Y…!ÉÊ!+‡" [tpu-current-line beg window-height height num tpu-percent-scroll 100 lines next-line-internal recenter -1] 3 (#$ . 40596) "p"]) #@115 Pan right tpu-pan-columns (16 by default). Accepts a prefix argument for the number of tpu-pan-columns to scroll. (defalias 'tpu-pan-right #[(num) "À \n_!‡" [scroll-left tpu-pan-columns num] 3 (#$ . 40903) "p"]) #@114 Pan left tpu-pan-columns (16 by default). Accepts a prefix argument for the number of tpu-pan-columns to scroll. (defalias 'tpu-pan-left #[(num) "À \n_!‡" [scroll-right tpu-pan-columns num] 3 (#$ . 41122) "p"]) #@65 Move cursor to the beginning of buffer, but don't set the mark. (defalias 'tpu-move-to-beginning #[nil "eb‡" [] 1 (#$ . 41339) nil]) #@59 Move cursor to the end of buffer, but don't set the mark. (defalias 'tpu-move-to-end #[nil "dbˆÀÁ!‡" [recenter -1] 2 (#$ . 41478) nil]) #@45 Move point to ARG percentage of the buffer. (defalias 'tpu-goto-percent #[(perc) "ÁV„\fÂWƒÃÄ\"‡d_Á¥b‡" [perc 100 0 error "Percentage %d out of range 0 < percent < 100"] 3 (#$ . 41620) "NGoto-percentage: "]) #@31 Move cursor to top of window. (defalias 'tpu-beginning-of-window #[nil "ÀÁ!‡" [move-to-window-line 0] 2 (#$ . 41840) nil]) #@34 Move cursor to bottom of window. (defalias 'tpu-end-of-window #[nil "ÀÁ!‡" [move-to-window-line -1] 2 (#$ . 41969) nil]) #@52 Move the current line to the bottom of the window. (defalias 'tpu-line-to-bottom-of-window #[nil "ÀÁ!‡" [recenter -1] 2 (#$ . 42096) nil]) #@49 Move the current line to the top of the window. (defalias 'tpu-line-to-top-of-window #[nil "ÀÁ!‡" [recenter 0] 2 (#$ . 42241) nil]) #@55 Set TPU Advance mode so keypad commands move forward. (defalias 'tpu-advance-direction #[nil "ÀÂÄÆ ˆÇ ‡" [" Advance" tpu-direction-string t tpu-advance nil tpu-reverse tpu-set-search tpu-update-mode-line] 1 (#$ . 42379) nil]) #@55 Set TPU Backup mode so keypad commands move backward. (defalias 'tpu-backup-direction #[nil "ÀÂÄÆ ˆÇ ‡" [" Reverse" tpu-direction-string nil tpu-advance t tpu-reverse tpu-set-search tpu-update-mode-line] 1 (#$ . 42614) nil]) (byte-code "À  #ˆÀ Ä #ˆÀ Æ#ˆÀÂ#ˆÀÄ #ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆÀ ØÙ#ˆÀ ÚÛ#ˆÀ ÜÝ#ˆÀ Þß#ˆÀ àß#ˆÀ áß#ˆÀ âß#ˆÀ ãß#ˆÀ äß#ˆÀ åß#ˆÀ æß#ˆÀ çß#ˆÀ èé#ˆÀ êë#ˆÀ ìí#ˆÀ îï#ˆÀ ðñ#ˆÀ òó#ˆÀ ôõ#ˆÀ ö÷#ˆÀ øß#ˆÀ ùß#ˆÀ úß#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÐÑ#ˆÀ ÎÏ#ˆÀ ûó#ˆÀ üý#ˆÀ þÿ#ˆÀ @A#ˆÀ BC#ˆÀ DE#ˆÀ FG#ˆÀ HI#ˆÀ JK#ˆÀ L×#ˆÀ MN#ˆÀ OP#ˆÀ QR#ˆÀ ST#ˆÀ UV#ˆÀ WÙ#ˆÀ XY#ˆÀZñ#ˆÀ[ß#ˆÀ\\ß#ˆÀ]ß#ˆÀ^ß#ˆÀ_`#ˆÀab#ˆÀcd#ˆÀef#ˆÀgß#ˆÀhi#ˆÀjk#ˆÀlß#ˆÀmß#ˆÀnß#ˆÀoß#ˆÀpß#ˆÀqß#ˆÀrß#ˆÀst#ˆÀuv#ˆÀwß#ˆÀxy#ˆÀzß#ˆÀ{ß#ˆÀ|ß#ˆÀ}~#ˆÀß#ˆÀ€ß#ˆÀ‚#ˆÀƒ„#ˆÀ…ß#ˆÀ†ß#ˆÀ‡ß#ˆÀˆ‰#ˆÀŠß#ˆÀ‹÷#ˆÀŒ#ˆÀŽ#ˆÀ‘#ˆÀ’“#ˆÀ”“#ˆÀ•“#ˆÀ–“#ˆÀ—“#ˆÀ˜“#ˆÀ™“#ˆÀš“#ˆÀ›“#ˆÀœ“#ˆÀß#ˆÀžŸ#ˆÀ ß#ˆÀ¡ß#ˆÀ¢ß#ˆÀ£¤#ˆÀÊ¥#ˆÀ̦#ˆÀЧ#ˆÀΨ#ˆÀ©é#ˆÀª«#ˆÀ¬­#ˆÀ®ß#ˆÀ¯°#ˆÀ±²#ˆÀ³´#ˆÀXµ#ˆÀ¶·#ˆÀ¸¹#ˆÀƺ#ˆÀû»#ˆÀü¼#ˆÀþ½#ˆÀ¾¿#ˆÀÀ~#ˆÀÁÂ#ˆÀÃÄ#ˆÀÅÆ#ˆÀÇÈ#ˆÀÉÊ#ˆÀËÌ#ˆÀÍß#ˆÀÎÌ#ˆÀÏÐ#ˆÀÑÒ#ˆÀÓÔ#ˆÀÕ¥#ˆÀÖ¦#ˆÀק#ˆÀب#ˆÀÙé#ˆÀÚ«#ˆÀÛ­#ˆÀÜß#ˆÀÝ°#ˆÀÞ²#ˆÀUß#ˆÀSµ#ˆÀW·#ˆÀà¹#ˆÀ@á#ˆÀB»#ˆÀD¼#ˆÀF½#ˆÀH¿#ˆÀJ~#ˆÀLÂ#ˆÀMÄ#ˆÀOÆ#ˆÀQÈ#ˆÀâÊ#ˆÀãß#ˆÀäå#ˆÀæß#ˆÀçè#ˆÀéê#ˆÀÊë#ˆÀÌì#ˆÀÐí#ˆÀÎî#ˆÀÒß#ˆÀÔß#ˆÀÖï#ˆÀØð#ˆÀÚñ#ˆÀÜò#ˆÀÞß#ˆÀàß#ˆÀáß#ˆÀâß#ˆÀóß#ˆÀäß#ˆÀåß#ˆÀæß#ˆÀçß#ˆÀèß#ˆÀêß#ˆÀìß#ˆÀîß#ˆÀðß#ˆÀòô#ˆÀôß#ˆÀö#ˆÀøß#ˆÀùß#ˆÀúß#ˆÀ Êë#ˆÀ Ìì#ˆÀ Ðí#ˆÀ Îî#ˆÀ Æb#ˆÀ ûõ#ˆÀ üÓ#ˆÀ þö#ˆÀ @÷#ˆÀ Bø#ˆÀ Dù#ˆÀ Fú#ˆÀ Hì#ˆÀ Jë#ˆÀ LÕ#ˆÀ Mõ#ˆÀ Oû#ˆÀ Qü#ˆÀ Sý#ˆÀ Uþ#ˆÀ Wð#ˆÀ Xÿ#ˆ!ƒ8À#ˆÀ#ˆÀ#ˆÀ#ˆÀ \n#ˆÀ  \n#ˆÀ\f \n#ˆÀ  #ˆ!ƒ~À \n#ˆÀ#ˆÀ#‡" [define-key global-map "[" CSI-map "O" SS3-map "P" GOLD-map GOLD-CSI-map GOLD-SS3-map "A" tpu-previous-line "B" tpu-next-line "D" tpu-backward-char "C" tpu-forward-char "1~" tpu-search "2~" tpu-paste "3~" tpu-cut "4~" tpu-select "5~" tpu-scroll-window-down "6~" tpu-scroll-window-up "11~" nil "12~" "13~" "14~" "15~" "17~" "18~" "19~" "20~" "21~" tpu-exit "23~" tpu-insert-escape "24~" tpu-next-beginning-of-line "25~" tpu-delete-previous-word "26~" tpu-toggle-overwrite-mode "28~" tpu-help "29~" execute-extended-command "31~" tpu-goto-breadcrumb "32~" "33~" "34~" "Q" "R" tpu-search-again "S" tpu-delete-current-line "p" tpu-line "q" tpu-word "r" tpu-end-of-line "s" tpu-char "t" tpu-advance-direction "u" tpu-backup-direction "v" "w" tpu-page "x" tpu-scroll-window "y" tpu-append-region "m" tpu-delete-current-word "l" tpu-delete-current-char "n" "M" newline "" "" "" "" "" "" set-visited-file-name "" keyboard-quit "" delete-other-windows " " other-window "\n" " " tpu-define-macro-key "\f" downcase-region " " "" "" "" "" "" "" "" tpu-toggle-control-keys "" upcase-region "" "" tpu-write-current-buffers "" "" "" " " undo "!" "#" "$" tpu-add-at-eol "%" tpu-goto-percent "&" "(" ")" "*" tpu-toggle-regexp "+" "," "-" negative-argument "." tpu-drop-breadcrumb "/" tpu-emacs-replace "0" digit-argument "1" "2" "3" "4" "5" "6" "7" "8" "9" ":" ";" tpu-trim-line-ends "<" "=" ">" "?" tpu-spell-check tpu-toggle-newline-and-indent tpu-next-buffer repeat-complex-command shell-command "E" "F" tpu-set-cursor-free "G" tpu-get "H" "I" tpu-include "K" tpu-kill-buffer "L" tpu-what-line buffer-menu "N" tpu-next-file-buffer "O" occur lpr-buffer tpu-quit tpu-toggle-rectangle replace "T" tpu-line-to-top-of-window "U" "V" tpu-version "W" save-buffer "X" tpu-save-all-buffers-kill-emacs "Y" copy-region-as-kill "Z" suspend-emacs "[" blink-matching-open "\\" "]" "^" tpu-add-at-bol "_" split-window-vertically "`" what-line "a" "b" "c" "d" "e" "f" "g" "h" "i" "k" goto-line "o" lpr-region "z" "{" "|" split-window-horizontally "}" "~" exchange-point-and-mark "" delete-window tpu-move-to-beginning tpu-move-to-end end-of-line beginning-of-line tpu-store-text tpu-unselect tpu-previous-window tpu-next-window "16~" describe-bindings help-for-help tpu-undelete-lines open-line tpu-change-case tpu-delete-to-eol tpu-special-insert tpu-fill tpu-replace tpu-undelete-words tpu-undelete-char tpu-substitute boundp repeat-complex-command-map "" previous-complex-command "" next-complex-command "OA" "OB" minibuffer-local-map "OM" exit-minibuffer minibuffer-local-ns-map minibuffer-local-completion-map minibuffer-local-must-match-map minibuffer-complete-and-exit "Ot" tpu-search-forward-exit "Ou" tpu-search-backward-exit] 4) #@42 Set control keys to TPU style functions. (defalias 'tpu-set-control-keys #[nil "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆÀ ØÙ#ˆÀ ÚÛ#ˆÜ‰‡" [define-key global-map "" quoted-insert "" tpu-toggle-overwrite-mode "" repeat-complex-command "" tpu-current-end-of-line "" tpu-next-beginning-of-line "\n" tpu-delete-previous-word " " tpu-define-macro-key "\f" tpu-insert-formfeed "" recenter "" tpu-delete-to-bol "" tpu-quoted-insert "" redraw-display "" tpu-exit t tpu-control-keys] 4 (#$ . 47810)]) #@51 Set control keys to TPU or emacs style functions. (defalias 'tpu-reset-control-keys #[(tpu-style) "… ??… \n† ‰…Æ ƒ\"Å!\nƒ-Å!‚1Å! ÊËÌ Ë\"#ˆÊÍÌ Í\"#ˆÊÎÌ Î\"#ˆÊÏÌ Ï\"#ˆÊÐÌ Ð\"#ˆÊÑÌ Ñ\"#ˆÊÒÌ Ò\"#ˆÊÓÌ Ó\"#ˆÊÔÌ Ô\"#ˆÊÕÌ Õ\"#ˆÊÖÌ Ö\"#ˆÊ×Ì ×\"#ˆÊØÌ Ø\"#ˆ‰)+‡" [tpu-style tpu-control-keys tpu emacs doit copy-keymap global-map tpu-global-map tpu-original-global-map map define-key "" lookup-key "" "" "" "" "\n" " " "\f" "" "" "" "" ""] 7 (#$ . 48344)]) #@57 Toggles control key bindings between TPU-edt and Emacs. (defalias 'tpu-toggle-control-keys #[nil "À ?!ˆt…Âà ƒÄ‚Å\"‡" [tpu-reset-control-keys tpu-control-keys message "Control keys function with %s bindings." "TPU-edt" "Emacs"] 3 (#$ . 48870) nil]) #@72 Insert the next element of the minibuffer history into the minibuffer. (defalias 'tpu-next-history-element #[(n) "À !ˆdb‡" [next-history-element n] 2 (#$ . 49130) "p"]) #@76 Insert the previous element of the minibuffer history into the minibuffer. (defalias 'tpu-previous-history-element #[(n) "À !ˆdb‡" [previous-history-element n] 2 (#$ . 49305) "p"]) #@58 Modify minibuffer maps to use arrows for history recall. (defalias 'tpu-arrow-history #[nil "ÀÁ!‰@‰ƒ7Å Ç#ˆÅ Ç#ˆÅ Ç#ˆÅ\n Ç#ˆÅ Ç#ˆ\fA‰‚ÀÌ!‰@‰…lÅ Í#ˆÅ Í#ˆÅ Í#ˆÅ\n Í#ˆÅ Í#ˆ\fA‰‚<*‡" [where-is-internal tpu-previous-line nil cur loc define-key read-expression-map tpu-previous-history-element minibuffer-local-map minibuffer-local-ns-map minibuffer-local-completion-map minibuffer-local-must-match-map tpu-next-line tpu-next-history-element] 5 (#$ . 49492) nil]) #@188 Load the TPU-edt X-windows key definitions FILE. If FILE is nil, try to load a default file. The default file names are `~/.tpu-lucid-keys' for Lucid emacs, and `~/.tpu-keys' for Emacs. (defalias 'tpu-load-xkeys #[(file) "ƒ Á!‚>\nƒÁ\n!‚> ƒ!ÁÄ!‚> ƒ>ÁÆ!Ç!„>ÇÁÈ!!ƒ>ÉÁÈ!\"ˆÊ!ƒHË!‡ÌÍ!ˆÎ ˆÏcˆÐщÒÁÓ!C\"„œƒœ@ØÙ@\"ƒ~Ú‚ÛQÇ!ƒ”Ü!„”ÝA‚dƒµÞß\"cˆàá!…»Ë!‚»âcˆãä!,‡" [file expand-file-name tpu-xkeys-file tpu-lucid-emacs19-p "~/.tpu-lucid-keys" tpu-emacs19-p "~/.tpu-keys" file-exists-p "~/.tpu-gnu-keys" tpu-copy-keyfile file-readable-p load-file switch-to-buffer "*scratch*" erase-buffer "\n\n Ack!! You're running TPU-edt under X-windows without loading an\n X key definition file. To create a TPU-edt X key definition\n file, run the tpu-mapper.el program. It came with TPU-edt. It\n even includes directions on how to use it! Perhaps it's laying\n around here someplace. " "tpu-mapper.el" nil append "." load-path search-list path found string-match "/$" "" "/" file-directory-p t format "Ah yes, there it is, in \n\n %s \n\n" tpu-y-or-n-p "Do you want to run it now? " "Nope, I can't seem to find it. :-(\n\n" sit-for 120] 6 (#$ . 49987) "fX key definition file: "]) #@66 Copy the TPU-edt X key definitions file to the new default name. (defalias 'tpu-copy-keyfile #[(oldname newname) "ÀÁ!„\nÂÁ!ˆÁqˆÃ ˆÄcˆÅ‹‡" [get-buffer "*TPU-Notice*" generate-new-buffer erase-buffer "\n NOTICE --\n\n The default name of the TPU-edt key definition file has changed\n from `~/.tpu-gnu-keys' to `~/.tpu-keys'. With your permission,\n your key definitions will be copied to the new file. If you'll\n never use older versions of Emacs, you can remove the old file.\n If the copy fails, you'll be asked if you want to create a new\n key definitions file. Do you want to copy your key definition\n file now?\n " ((byte-code "ÀÁ!ˆÂ ˆebˆÃ ˆÄÅ!ƒÆÇȈÉÁ!‡" [switch-to-buffer-other-window "*TPU-Notice*" shrink-window-if-larger-than-buffer beep tpu-y-or-n-p "Copy key definitions to the new file now? " conditions (copy-file oldname newname) ((error (byte-code "ÀÁ\nA\"‡" [message "Sorry, couldn't copy - %s" conditions] 3))) kill-buffer] 3))] 2 (#$ . 51258) "fOld name: \nFNew name: "]) #@28 Turn on TPU/edt emulation. (defalias 'tpu-edt-on #[nil "?…QÁÂ!ˆÃ ˆ\fƒ ƒÆÇ!ˆÈ ˆ‚:ÉÊËÌÍ$ˆÉÎËÏÍ$ˆÉÐËÑÍ$ˆÉÒËÓÍ$ˆÔÍ!ˆÕ ˆÖ×Ø\"ˆÖÙÍ\"ˆÚ͉‡" [tpu-edt-mode require picture tpu-set-control-keys tpu-emacs19-p window-system tpu-load-xkeys nil tpu-arrow-history autoload ispell-word "ispell" "Check spelling of word at or before point" t ispell-complete-word "Complete word at or before point" ispell-buffer "Check spelling of entire buffer" ispell-region "Check spelling of region" tpu-set-mode-line tpu-advance-direction set-default page-delimiter "\f" truncate-lines 1 scroll-step] 5 (#$ . 52271) nil]) #@63 Turn off TPU/edt emulation. Note that the keypad is left on. (defalias 'tpu-edt-off #[nil "…'ÁÂ!ˆÃÂ!ˆÄÅÆ\"ˆÄÇÂ\"ˆÈ Ê !\fÍ\f!ˆÂ‰‡" [tpu-edt-mode tpu-reset-control-keys nil tpu-set-mode-line set-default page-delimiter "^\f" truncate-lines 0 scroll-step copy-keymap tpu-original-global-map global-map use-global-map] 3 (#$ . 52880) nil]) (provide (quote tpu-edt)) emacs-19.30/lisp/tpu-extras.elc100666 12120 1 21771 6006771420 14710 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Jul 30 17:00:20 1995 ;;; from file /home/fsf/rms/e19/lisp/tpu-extras.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`tpu-extras.el' was compiled for Emacs 19.29 or later")) (require (quote tpu-edt)) #@95 *Scroll margin at the top of the screen. Interpreted as a percent of the current window size. (defconst tpu-top-scroll-margin 0 (#$ . -504)) #@98 *Scroll margin at the bottom of the screen. Interpreted as a percent of the current window size. (defconst tpu-bottom-scroll-margin 0 (#$ . -651)) #@191 *If non-nil, in free cursor mode backward-char (left-arrow) works just like TPU/edt. Otherwise, backward-char will move to the end of the previous line when starting from a line beginning. (defvar tpu-backward-char-like-tpu t (#$ . -805)) #@39 If non-nil, let the cursor roam free. (defvar tpu-cursor-free nil (#$ . 1051)) (add-hook (quote picture-mode-hook) (quote tpu-set-cursor-free)) #@63 Eliminate whitespace at ends of lines, if the cursor is free. (defalias 'tpu-write-file-hook #[nil "À … …  ‡" [buffer-modified-p tpu-cursor-free picture-clean] 1 (#$ . 1201)]) (byte-code "À >„\nÀ BÀ‡" [tpu-write-file-hook write-file-hooks] 2) #@45 Enforce scroll margin at the top of screen. (defalias 'tpu-top-check #[(beg lines) "À _Â¥\f WƒÅ\f!‚\fZ W…Å !)‡" [window-height tpu-top-scroll-margin 100 margin beg recenter lines] 2 (#$ . 1456)]) #@48 Enforce scroll margin at the bottom of screen. (defalias 'tpu-bottom-check #[(beg lines) "À ‰\n_Ã¥Ä\\ ZÄZVƒ!È!‚0 \\V…0È [!+‡" [window-height height tpu-bottom-scroll-margin 100 1 margin difference beg recenter lines] 3 (#$ . 1668)]) #@54 Move right ARG characters (left if ARG is negative). (defalias 'tpu-forward-char #[(num) "ƒÁ\n!‡\nu‡" [tpu-cursor-free picture-forward-column num] 2 (#$ . 1926) "p"]) #@54 Move left ARG characters (right if ARG is negative). (defalias 'tpu-backward-char #[(num) "„Á\n!‡ ƒÄ\n!‡nƒ ÁÅ!ˆÆ ˆÄ\nS!‡Ä\n!‡" [tpu-cursor-free backward-char num tpu-backward-char-like-tpu picture-backward-column 1 picture-end-of-line] 2 (#$ . 2102) "p"]) #@62 Move to next line. Prefix argument serves as a repeat count. (defalias 'tpu-next-line #[(num) "À \nƒm„Ã\f!ˆ‚Å\f!ˆÆ \f\"ˆÇ‰)‡" [tpu-current-line beg tpu-cursor-free picture-move-down num next-line-internal tpu-bottom-check next-line this-command] 3 (#$ . 2370) "p"]) #@66 Move to previous line. Prefix argument serves as a repeat count. (defalias 'tpu-previous-line #[(num) "À \nƒÃ\f!ˆ‚Å\f[!ˆÆ \f\"ˆÇ‰)‡" [tpu-current-line beg tpu-cursor-free picture-move-up num next-line-internal tpu-top-check previous-line this-command] 3 (#$ . 2651) "p"]) #@136 Move to beginning of line; if at beginning, move to beginning of next line. Accepts a prefix argument for the number of lines to move. (defalias 'tpu-next-beginning-of-line #[(num) "À ÂÃ!ˆÃ\fZyˆÅ \f\")‡" [tpu-current-line beg backward-char 1 num tpu-top-check] 3 (#$ . 2937) "p"]) #@118 Move to end of line; if at end, move to end of next line. Accepts a prefix argument for the number of lines to move. (defalias 'tpu-next-end-of-line #[(num) "À \nƒ%`Ã\fWƒ\fyˆÅ ˆ` Xƒ!ÆyˆÅ ˆ)‚+Æuˆ\fˆÇ \f\")‡" [tpu-current-line beg tpu-cursor-free 1 num picture-end-of-line nil tpu-bottom-check] 3 (#$ . 3226) "p"]) #@77 Move EOL upward. Accepts a prefix argument for the number of lines to move. (defalias 'tpu-previous-end-of-line #[(num) "À \nƒÃÄ Z!ˆ‚Ä ZˆÆ \")‡" [tpu-current-line beg tpu-cursor-free picture-end-of-line 1 num tpu-top-check] 3 (#$ . 3553) "p"]) #@36 Move point to end of current line. (defalias 'tpu-current-end-of-line #[nil "` ƒ\f ˆ‚È`U…ÄÅ!)‡" [beg tpu-cursor-free picture-end-of-line nil message "You are already at the end of a line."] 2 (#$ . 3810) nil]) #@75 Move to beginning of next line. Prefix argument serves as a repeat count. (defalias 'tpu-forward-line #[(num) "À  !ˆÄ \"ˆÅyˆ)Ƈ" [tpu-current-line beg next-line-internal num tpu-bottom-check 0 nil] 3 (#$ . 4036) "p"]) #@77 Move to beginning of previous line. Prefix argument serves as repeat count. (defalias 'tpu-backward-line #[(num) "À n„ Y„ ÄZÅ [!ˆÆ \"ˆÂyˆ)LJ" [tpu-current-line beg 0 num 1 next-line-internal tpu-top-check nil] 3 (#$ . 4263) "p"]) #@102 Move to the next paragraph in the current direction. A repeat count means move that many paragraphs. (defalias 'tpu-paragraph #[(num) "À Ä ÇUƒÈ‚ \nÇUƒ\"Ë‚$\n\f  _Í¥ \f_Í¥Ï\\ ZÏZ]ŠÒ!ˆ`)ŠÒ!ˆ`)Šbˆ ÕZyˆ`)ƒžØ!ˆ`VƒŠ y)‰ÇUƒ‡Ú!‚°Ú Z!‚°`V…°Ú!‚°Û!ˆ`W…°Ú ^!. ‡" [nil left tpu-current-line beg window-height height tpu-top-scroll-margin 0 10 top-percent tpu-bottom-scroll-margin 15 bottom-percent 100 top-margin 1 bottom-up-margin bottom-margin move-to-window-line top bottom 2 far tpu-advance tpu-next-paragraph num recenter tpu-previous-paragraph] 4 (#$ . 4508) "p"]) #@92 Move to the next page in the current direction. A repeat count means move that many pages. (defalias 'tpu-page #[(num) "À Ä ÇUƒÈ‚ \nÇUƒ\"Ë‚$\n\f  _Í¥ \f_Í¥Ï\\ ZÏZ]ŠÒ!ˆ`)ŠÒ!ˆ`)Šbˆ ÕZyˆ`)ƒžØ!ˆ`VƒŠ y)‰ÇUƒ‡Ú!‚°Ú Z!‚°`V…°Ú!‚°Û!ˆ`W…°Ú ^!. ‡" [nil left tpu-current-line beg window-height height tpu-top-scroll-margin 0 10 top-percent tpu-bottom-scroll-margin 15 bottom-percent 100 top-margin 1 bottom-up-margin bottom-margin move-to-window-line top bottom 2 far tpu-advance forward-page num recenter backward-page] 4 (#$ . 5143) "p"]) #@94 Scroll the display down to the next section. A repeat count means scroll that many sections. (defalias 'tpu-scroll-window-down #[(num) "À  S\f _Æ¥_È[!ˆÉ \"+‡" [tpu-current-line beg window-height height num tpu-percent-scroll 100 lines next-line-internal tpu-top-check] 3 (#$ . 5748) "p"]) #@92 Scroll the display up to the next section. A repeat count means scroll that many sections. (defalias 'tpu-scroll-window-up #[(num) "À  S\f _Æ¥_È!ˆÉ \"+‡" [tpu-current-line beg window-height height num tpu-percent-scroll 100 lines next-line-internal tpu-bottom-check] 3 (#$ . 6053) "p"]) #@44 Search for a string or regular expression. (defalias 'tpu-search-internal #[(pat &optional quiet) "À Ä ÇUƒÈ‚ \nÇUƒ\"Ë‚$\n\f  _Í¥ \f_Í¥Ï\\ ZÏZ]ŠÒ!ˆ`)ŠÒ!ˆ`)Šbˆ ÕZyˆ`)×\"ˆƒ `Vƒ’Š y)‰ÇUƒ‰Û!‚­Û Z!‚­`V…­Û!‚­`W…­Û ^!. ‡" [nil left tpu-current-line beg window-height height tpu-top-scroll-margin 0 10 top-percent tpu-bottom-scroll-margin 15 bottom-percent 100 top-margin 1 bottom-up-margin bottom-margin move-to-window-line top bottom 2 far tpu-search-internal-core pat quiet tpu-searching-forward recenter] 4 (#$ . 6356)]) (byte-code "ÀÁ!„ ÁÂKMˆÀÃ!„ÃÄKMˆÀÅ!„!ÅÆKMˆÀ‡" [fboundp tpu-old-newline newline tpu-old-do-auto-fill do-auto-fill tpu-old-newline-and-indent newline-and-indent] 2) #@192 Insert a newline. With arg, insert that many newlines. In Auto Fill mode, can break the preceding line if no numeric arg. This is the TPU-edt version that respects the bottom scroll margin. (defalias 'newline #[(&optional num) "À \n„ ÃÄ\n!ˆÅ \n\")‡" [tpu-current-line beg num 1 tpu-old-newline tpu-bottom-check] 3 (#$ . 7115) "p"]) #@336 Insert a newline, then indent according to major mode. Indentation is done using the current indent-line-function. In programming language modes, this is the same as TAB. In some text modes, where TAB inserts a tab, this indents to the specified left-margin column. This is the TPU-edt version that respects the bottom scroll margin. (defalias 'newline-and-indent #[nil "À  ˆÃ Ä\")‡" [tpu-current-line beg tpu-old-newline-and-indent tpu-bottom-check 1] 3 (#$ . 7458) nil]) #@57 TPU-edt version that respects the bottom scroll margin. (defalias 'do-auto-fill #[nil "À  ˆÃ Ä\")‡" [tpu-current-line beg tpu-old-do-auto-fill tpu-bottom-check 1] 3 (#$ . 7940)]) #@21 Set scroll margins. (defalias 'tpu-set-scroll-margins #[(top bottom) "Á˜„%ÂÃOĘƒÅ!‚%Å!Ç_È \\SÈ ¥ Á˜„N ÂÃOĘƒ?Å !\n‚NÅ !Ç_È \\SÈ ¥\nt…YËÌ\n#‡" [top "" -1 nil "%" string-to-int tpu-top-scroll-margin 100 window-height bottom tpu-bottom-scroll-margin message "Scroll margins set. Top = %s%%, Bottom = %s%%"] 4 (#$ . 8127) "sEnter top scroll margin (N lines or N%% or RETURN for current value): \nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): "]) #@51 Allow the cursor to move freely about the screen. (defalias 'tpu-set-cursor-free #[nil "ÀÂÃÄ #ˆÆÇ!‡" [t tpu-cursor-free substitute-key-definition tpu-set-cursor-free tpu-set-cursor-bound GOLD-map message "The cursor will now move freely about the screen."] 4 (#$ . 8629) nil]) #@47 Constrain the cursor to the flow of the text. (defalias 'tpu-set-cursor-bound #[nil "À ˆÁÃÄÅ#ˆÇÈ!‡" [picture-clean nil tpu-cursor-free substitute-key-definition tpu-set-cursor-bound tpu-set-cursor-free GOLD-map message "The cursor is now bound to the flow of your text."] 4 (#$ . 8913) nil]) emacs-19.30/lisp/tpu-mapper.elc100666 12120 1 21734 6006771472 14674 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Jul 30 17:01:05 1995 ;;; from file /home/fsf/rms/e19/lisp/tpu-mapper.el ;;; emacs version 19.29.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`tpu-mapper.el' was compiled for Emacs 19.29 or later")) (byte-code "ƒ\n ™ƒÃÄ!ˆÃ‡" [window-system emacs-version "19" error "tpu-mapper requires running in Emacs 19, with an X display"] 2) #@51 Non-NIL if we are running Lucid Emacs version 19. (defconst tpu-lucid-emacs19-p (string-match "Lucid" emacs-version) (#$ . 614)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ BÀÈ!„GÂÈ BÀÉ!„TÂ É BÀÊ!„aÂ\nÊ B ƒtÌÍ ÎÏ#ˆ‚{ÐÑ ÎÏ#ˆÒÓ!„…ÔÓ!ˆÒÕ!„ÔÕ!ˆÒÖ!„™ÔÖ!ˆÕqˆ×cˆØÓ!ˆÙcˆÚ ˆebˆ ƒÇÛÜ!\nÝÞßà\náH!\"âQ‚ÙãÜ!ˆä \nÝÞß\n\"âQ‡" [boundp tpu-kp4 nil current-load-list tpu-kp5 tpu-key tpu-enter tpu-return tpu-key-seq tpu-enter-seq tpu-return-seq tpu-lucid-emacs19-p set-screen-size selected-screen 80 36 set-frame-size selected-frame get-buffer "Directions" generate-new-buffer "Keys" "Gold-Keys" ";; Key definitions for TPU-edt\n;;\n" switch-to-buffer "\n This program prompts you to press keys to create a custom keymap file\n for use with the x-windows version of Emacs and TPU-edt.\n\n Start by pressing the RETURN key, and continue by pressing the keys\n specified in the mini-buffer. You can re-arrange the TPU-edt keypad\n by pressing any key you want at any prompt. If you want to entirely\n omit a key, just press RETURN at the prompt.\n\n Here's a picture of the standard TPU/edt keypad for reference:\n\n _______________________ _______________________________\n | HELP | Do | | | | | |\n |KeyDefs| | | | | | |\n |_______|_______________| |_______|_______|_______|_______|\n _______________________ _______________________________\n | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L |\n | | |Sto Tex| | key |E-Help | Find |Undel L|\n |_______|_______|_______| |_______|_______|_______|_______|\n |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W |\n | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W|\n |_______|_______|_______| |_______|_______|_______|_______|\n |Move up| |Forward|Reverse|Remove | Del C |\n | Top | |Bottom | Top |Insert |Undel C|\n _______|_______|_______ |_______|_______|_______|_______|\n |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | |\n |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter |\n |_______|_______|_______| |_______|_______|_______| |\n | Line |Select | Subs |\n | Open Line | Reset | |\n |_______________|_______|_______|\n\n\n" delete-other-windows read-key-sequence "Hit carriage-return to continue " "[" format "%s" event-key 0 "]" message read-event] 6) (defalias 'tpu-lucid-map-key #[(ident descrip func gold-func) "ÀÁ \f#!ÆÁÇÈ ÉH!\"ÊQ‰ \fš„7ÍqˆÁÎ #cˆÐqˆÁÑ #cˆÓqˆ ‡" [read-key-sequence format "Press %s%s: " ident descrip tpu-key-seq "[" "%s" event-key 0 "]" tpu-key tpu-return "Keys" "(global-set-key %s %s)\n" func "Gold-Keys" "(define-key GOLD-map %s %s)\n" gold-func "Directions"] 7 nil nil]) (defalias 'tpu-emacs-map-key #[(ident descrip func gold-func) "ÀÁ\n #ˆÄ ÆÇÈ \"ÉQ‰\n š„4ÌqˆÇÍ\n#cˆÏqˆÇÐ\n#cˆÒqˆ\n‡" [message "Press %s%s: " ident descrip read-event tpu-key-seq "[" format "%s" "]" tpu-key tpu-return "Keys" "(global-set-key %s %s)\n" func "Gold-Keys" "(define-key GOLD-map %s %s)\n" gold-func "Directions"] 5 nil nil]) (byte-code "À ƒ ‚\nÃMˆÄqˆÅcˆÆqˆÇcˆÈqˆÀÉÊËÌ$ˆÀÍÊÎÏ$ˆÀÐÊÑÒ$ˆÀÓÊÔÕ$ˆÄqˆÖcˆÆqˆ×cˆÈqˆÀØÙÚÛ$ˆÀÜÝÞß$ˆÀàáâã$ˆÀäåæç$ˆÄqˆècˆÆqˆécˆÈqˆÀêëìí$ˆÀîïðñ$ˆÀòóôõ$ˆÀö÷øù$ˆÀúûüÏ$=Àþÿ@Ì$AÀBCDE$ˆÀFGHI$ˆÀJKLM$ˆÀNOPQ$ˆÀRSTU$ˆÀVWXY$ˆÀZ[\\]$ˆÀ^_`a$ˆbcdeÄqˆfcˆÆqˆgcˆÈqˆÀhiãj$ˆÀklEj$ˆÀmnDo$ˆÀpq\\]$ˆÀrstu$ˆÀvwxy$ˆÄqˆzcˆÆqˆ{cˆÈqˆÀ|}~j$ˆÀ€j$ˆÀ‚ƒ„j$ˆÀ…†‡j$ˆÀˆ‰Šj$ˆÀ‹ŒÞ$ˆÀŽIj$ˆÀÊ‘’$ˆÆqˆc“š„M”cˆ•–c\"cˆ•—c\"cˆ•˜c\"cˆ•™c\"cˆ=“š„xA“š„xšcˆ•›=\"cˆ•œA\"cˆcˆ ƒ®•že\"cˆ•Ÿ \"cˆ¡cˆ¢cˆ£cˆ¤cˆ‚¹•žc\"cˆ¥Ä¦`#ˆÄqˆ ƒÐ§‚Ó¨©ª«•¬©\"Ê©#!ˆ)­ ˆ® ˆ¯p!ˆ¯°!ˆ¯Æ!ˆ±È!ˆ² ˆ³cˆeb‡" [tpu-map-key tpu-lucid-emacs19-p tpu-lucid-map-key tpu-emacs-map-key "Keys" "\n;; Arrows\n;;\n" "Gold-Keys" "\n;; GOLD Arrows\n;;\n" "Directions" "Up-Arrow" "" "'tpu-previous-line" "'tpu-move-to-beginning" "Down-arrow" "'tpu-next-line" "'tpu-move-to-end" "Right-arrow" "'tpu-forward-char" "'end-of-line" "Left-arrow" "'tpu-backward-char" "'beginning-of-line" "\n;; PF keys\n;;\n" "\n;; GOLD PF keys\n;;\n" "PF1" " - The GOLD key" "GOLD-map" "'keyboard-quit" "PF2" " - The Keypad Help key" "'tpu-help" "'help-for-help" "PF3" " - The Find/Find-Next key" "'tpu-search-again" "'tpu-search" "PF4" " - The Del/Undelete Line key" "'tpu-delete-current-line" "'tpu-undelete-lines" "\n;; KP0-9 KP- KP, KP. and KPenter\n;;\n" "\n;; GOLD KP0-9 KP- KP, and KPenter\n;;\n" "KP-0" " - The Line/Open-Line key" "'tpu-line" "'open-line" "KP-1" " - The Word/Change-Case key" "'tpu-word" "'tpu-change-case" "KP-2" " - The EOL/Delete-EOL key" "'tpu-end-of-line" "'tpu-delete-to-eol" "KP-3" " - The Character/Special-Insert key" "'tpu-char" "'tpu-special-insert" "KP-4" " - The Forward/Bottom key" "'tpu-advance-direction" tpu-kp4 "KP-5" " - The Reverse/Top key" "'tpu-backup-direction" tpu-kp5 "KP-6" " - The Remove/Insert key" "'tpu-cut" "'tpu-paste" "KP-7" " - The Page/Do key" "'tpu-page" "'execute-extended-command" "KP-8" " - The Section/Fill key" "'tpu-scroll-window" "'tpu-fill" "KP-9" " - The Append/Replace key" "'tpu-append-region" "'tpu-replace" "KP--" " - The Delete/Undelete Word key" "'tpu-delete-current-word" "'tpu-undelete-words" "KP-," " - The Delete/Undelete Character key" "'tpu-delete-current-char" "'tpu-undelete-char" "KP-." " - The Select/Reset key" "'tpu-select" "'tpu-unselect" "KP-Enter" " - The Enter key on the numeric keypad" "'newline" "'tpu-substitute" tpu-key tpu-enter tpu-key-seq tpu-enter-seq "\n;; Editing keypad (find, insert, remove)\n;; (select, prev, next)\n;;\n" "\n;; GOLD Editing keypad (find, insert, remove)\n;; (select, prev, next)\n;;\n" "Find" " - The Find key on the editing keypad" "'nil" "Insert" " - The Insert key on the editing keypad" "Remove" " - The Remove key on the editing keypad" "'tpu-store-text" "Select" " - The Select key on the editing keypad" "Prev Scr" " - The Prev Scr key on the editing keypad" "'tpu-scroll-window-down" "'tpu-previous-window" "Next Scr" " - The Next Scr key on the editing keypad" "'tpu-scroll-window-up" "'tpu-next-window" "\n;; F10-14 Help Do F17\n;;\n" "\n;; GOLD F10-14 Help Do F17\n;;\n" "F10" " - Invokes the Exit function on VT200+ terminals" "'tpu-exit" "F11" " - Inserts an Escape character into the text" "'tpu-insert-escape" "Backspace" " - Not Delete nor ^H! Sometimes on the F12 key" "'tpu-next-beginning-of-line" "F13" " - Invokes the delete previous word function" "'tpu-delete-previous-word" "F14" " - Toggles insert/overstrike modes" "'tpu-toggle-overwrite-mode" "Help" " - Brings up the help screen, same as PF2" "'describe-bindings" "Do" " - Invokes the COMMAND function" "F17" "'tpu-goto-breadcrumb" "'tpu-drop-breadcrumb" tpu-return "\n;; Minibuffer map additions to make KP_enter = RET\n;;\n" format "(define-key minibuffer-local-map %s 'exit-minibuffer)\n" "(define-key minibuffer-local-ns-map %s 'exit-minibuffer)\n" "(define-key minibuffer-local-completion-map %s 'exit-minibuffer)\n" "(define-key minibuffer-local-must-match-map %s 'minibuffer-complete-and-exit)\n" "\n;; Minibuffer map additions to allow KP-4/5 termination of search strings.\n;;\n" "(define-key minibuffer-local-map %s 'tpu-search-forward-exit)\n" "(define-key minibuffer-local-map %s 'tpu-search-backward-exit)\n" "\n;; Define the tpu-help-enter/return symbols\n;;\n" "(setq tpu-help-enter \"%s\")\n" "(setq tpu-help-return \"%s\")\n" tpu-return-seq "(setq tpu-help-N \"[#]\")\n" "(setq tpu-help-n \"[#]\")\n" "(setq tpu-help-P \"[#]\")\n" "(setq tpu-help-p \"[#]\")\n" append-to-buffer 1 "~/.tpu-lucid-keys" "~/.tpu-keys" file set-visited-file-name read-file-name "Save key mapping to file (default %s): " save-buffer eval-current-buffer kill-buffer "*scratch*" switch-to-buffer erase-buffer "\n A custom TPU-edt keymap file has been created.\n\n Press GOLD-k to remove this buffer and continue editing.\n"] 5) emacs-19.30/lisp/tq.elc100666 13437 1 5523 5756317006 13340 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Wed May 17 02:56:06 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/tq.el ;;; emacs version 19.28.91.22. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/tq.el' was compiled for Emacs 19")) #@236 Create and return a transaction queue communicating with PROCESS. PROCESS should be a subprocess capable of sending and receiving streams of bytes. It may be a local process, or it may be connected to a tcp server on another machine. (defalias 'tq-create #[(process) "À ÂÃÄ !P!BBÆ ÇÈÉÊ DËBBE\"ˆ )‡" [nil process generate-new-buffer " tq-temp-" process-name tq set-process-filter lambda (proc string) tq-filter quote (string)] 7 (#$ . 474)]) (defalias 'tq-queue #[(tq) "@‡" [tq] 1]) (defalias 'tq-process #[(tq) "A@‡" [tq] 1]) (defalias 'tq-buffer #[(tq) "AA‡" [tq] 1]) (defalias 'tq-queue-add #[(tq re closure fn) "Á!\n \fBBÅB¤ ˆÆ‡" [tq tq-queue re closure fn nil ok] 5]) (defalias 'tq-queue-head-regexp #[(tq) "À !@@‡" [tq-queue tq] 2]) (defalias 'tq-queue-head-fn #[(tq) "À !@AA‡" [tq-queue tq] 2]) (defalias 'tq-queue-head-closure #[(tq) "À !@A@‡" [tq-queue tq] 2]) (defalias 'tq-queue-empty #[(tq) "À !?‡" [tq-queue tq] 2]) (defalias 'tq-queue-pop #[(tq) "‰@A ˆ@?‡" [tq] 2]) #@332 Add a transaction to transaction queue TQ. This sends the string QUESTION to the process that TQ communicates with. When the corresponding answer comes back, we call FN with two arguments: CLOSURE, and the answer to the question. REGEXP is a regular expression to match the entire answer; that's how we tell where the answer ends. (defalias 'tq-enqueue #[(tq question regexp closure fn) "À \n \f$ˆÅÆ !\"‡" [tq-queue-add tq regexp closure fn process-send-string tq-process question] 5 (#$ . 1469)]) #@58 Shut down transaction queue TQ, terminating the process. (defalias 'tq-close #[(tq) "ÀÁ\n!!ˆÃÄ\n!!‡" [delete-process tq-process tq kill-buffer tq-buffer] 3 (#$ . 1975)]) #@62 Append STRING to the TQ's buffer; then process the new data. (defalias 'tq-filter #[(tq string) "À !qˆdbˆ\ncˆÃ !‡" [tq-buffer tq string tq-process-buffer] 2 (#$ . 2151)]) #@60 Check TQ's buffer for the regexp at the head of the queue. (defalias 'tq-process-buffer #[(tq) "À !qˆÂ ÃU?…cÄ !ƒ;ÅÆ!Èed#ˆe`|ˆÉÊ\"ˆËÌÍÎ !!ÏÐ!Ñ°!)‡ebˆÒÓ !ÊÔ#…ce`{e`|ˆÖ !× !\"ˆØ !ˆÙ !)‡" [tq-buffer tq buffer-size 0 tq-queue-empty generate-new-buffer "*spurious*" buf copy-to-buffer pop-to-buffer nil error "Spurious communication from process " process-name tq-process ", see buffer " buffer-name "." re-search-forward tq-queue-head-regexp t answer tq-queue-head-fn tq-queue-head-closure tq-queue-pop tq-process-buffer] 6 (#$ . 2328)]) (provide (quote tq)) emacs-19.30/lisp/trace.elc100666 12120 1 11043 5754706405 13673 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri May 12 12:29:49 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/trace.el ;;; emacs version 19.28.91.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/trace.el' was compiled for Emacs 19")) (require (quote advice)) #@50 *Trace output will by default go to that buffer. (defvar trace-buffer "*trace-output*" (#$ . -509)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„'ÇÈÉÊË\"\"Æ BÀ‡" [boundp trace-level 0 current-load-list trace-advice-name trace-function\ trace-separator format "%s\n" make-string 70 61] 5) (defalias 'trace-entry-message #[(function level argument-bindings) "ÀÁÂÃÄ SÆ\"Ç# ÈVƒÇ‚É \nÂË\fÇ#&‡" [format "%s%s%d -> %s: %s\n" mapconcat char-to-string make-string level 124 " " 1 "" function #[(binding) "ÀÁ\nÃ\"!ÄÅÁ\nÆ\"!Q‡" [symbol-name ad-arg-binding-field binding name "=" prin1-to-string value] 6] argument-bindings] 10]) (defalias 'trace-exit-message #[(function level value) "ÀÁÂÃÄ SÆ\"Ç# ÈVƒÇ‚É \nË\f!&‡" [format "%s%s%d <- %s: %s\n" mapconcat char-to-string make-string level 124 " " 1 "" function prin1-to-string value] 8]) (defalias 'trace-make-advice #[(function buffer background) "À ÂÃ\fƒ9ÅÆÂÇÈÉÊ DDDÌÍÎÏÐÑÒDÔBBD¯ÕÌÖ×ÐØÒDÙBBDF¯F‚bÅÆÂÇÚÉÊ DDDÛÜÝÐÑÒDÞBBDÕßàÐØÒDáBBD¯\nF$‡" [ad-make-advice trace-advice-name nil t background advice lambda let (trace-level (1+ trace-level)) trace-buffer get-buffer-create buffer save-excursion (set-buffer trace-buffer) (goto-char (point-max)) (if (= trace-level 1) (insert trace-separator)) insert trace-entry-message quote function (trace-level ad-arg-bindings) ad-do-it (set-buffer trace-buffer) (goto-char (point-max)) trace-exit-message (trace-level ad-return-value) (trace-level (1+ trace-level)) (pop-to-buffer trace-buffer) (goto-char (point-max)) (if (= trace-level 1) (insert trace-separator)) (trace-level ad-arg-bindings) (pop-to-buffer trace-buffer) (goto-char (point-max)) (trace-level ad-return-value)] 20]) (defalias 'trace-function-internal #[(function buffer background) "À  † \f #ÆÇ$ˆÈ É\"‡" [ad-add-advice function trace-make-advice buffer trace-buffer background around last ad-activate nil] 6]) (defalias 'trace-is-traced #[(function) "Á\nÃNžAž‡" [trace-advice-name around function ad-advice-info] 4]) #@487 Traces FUNCTION with trace output going to BUFFER. For every call of FUNCTION Lisp-style trace messages that display argument and return values will be inserted into BUFFER. This function generates the trace advice for FUNCTION and activates it together with any other advice there might be!! The trace BUFFER will popup whenever FUNCTION is called. Do not use this to trace functions that switch buffers or do any other display oriented stuff, use `trace-function-background' instead. (defalias 'trace-function #[(function &optional buffer) "À \nÃ#‡" [trace-function-internal function buffer nil] 4 (#$ . 2507) (list (intern (completing-read "Trace function: " obarray (quote fboundp) t)) (read-buffer "Output to buffer: " trace-buffer))]) #@401 Traces FUNCTION with trace output going quietly to BUFFER. For every call of FUNCTION Lisp-style trace messages that display argument and return values will be inserted into BUFFER. This function generates the trace advice for FUNCTION and activates it together with any other advice there might be!! Trace output will quietly go to BUFFER without changing the window or buffer configuration at all. (defalias 'trace-function-background #[(function &optional buffer) "À \nÃ#‡" [trace-function-internal function buffer t] 4 (#$ . 3255) (list (intern (completing-read "Trace function in background: " obarray (quote fboundp) t)) (read-buffer "Output to buffer: " trace-buffer))]) #@243 Untraces FUNCTION and possibly activates all remaining advice. Activation is performed with `ad-update', hence remaining advice will get activated only if the advice of FUNCTION is currently active. If FUNCTION was not traced this is a noop. (defalias 'untrace-function #[(function) "À !… Ã\f#ˆÅ !‡" [trace-is-traced function ad-remove-advice around trace-advice-name ad-update] 4 (#$ . 3940) (list (ad-read-advised-function "Untrace function: " (quote trace-is-traced)))]) #@42 Untraces all currently traced functions. (defalias 'untrace-all #[nil "Á‰ƒ @Ä\n@!Å\n!ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern untrace-function] 3 (#$ . 4423) nil]) (provide (quote trace)) emacs-19.30/lisp/two-column.elc100666 13437 1 25240 6046536214 15033 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 3 20:06:11 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/two-column.el ;;; emacs version 19.29.90.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`two-column.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!„\nÁÂMˆÀ‡" [fboundp frame-width screen-width] 2) #@53 Keymap for commands for setting up two-column mode. (defvar 2C-mode-map (byte-code "À  ÃÄ#ˆÂ ÅÄ#ˆÂ ÆÇ#ˆÂ ÈÉ#ˆ )‡" [make-sparse-keymap map define-key "2" 2C-two-columns [f2] "b" 2C-associate-buffer "s" 2C-split] 4) (#$ . 550)) (byte-code "À MˆÂÃÀ\"ˆÂÄÀ\"‡" [2C-command 2C-mode-map global-set-key "6" [f2]] 3) #@49 Keymap for commands for use in two-column mode. (defvar 2C-minor-mode-map (byte-code "À  ÃÄ#ˆÂ ÅÆ#ˆÂ ÇÈ#ˆÂ ÉÊ#ˆÂ ËÌ#ˆÂ ÍÎ#ˆÂ ÏÐ#ˆ )‡" [make-sparse-keymap map define-key "1" 2C-merge "d" 2C-dissociate "o" 2C-associated-buffer " " 2C-newline "|" 2C-toggle-autoscroll "{" 2C-shrink-window-horizontally "}" 2C-enlarge-window-horizontally] 4) (#$ . 867)) (byte-code "ÀÁ ÃÄ \nÆ $ˆÃÇÈ\nÆ $ˆÃÉÊ\nÆ $ˆ\n)B B À‡" [2C-mode make-sparse-keymap map substitute-key-definition 2C-command 2C-minor-mode-map current-global-map enlarge-window-horizontally 2C-enlarge-window-horizontally shrink-window-horizontally 2C-shrink-window-horizontally minor-mode-map-alist] 6) #@46 Marker to the associated buffer, if non-nil. (defvar 2C-mode nil (#$ . 1528)) (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅBÀ‡" [make-variable-buffer-local 2C-mode put permanent-local t (2C-mode " 2C") minor-mode-alist] 4) #@67 *Value of mode-line-format for a buffer in two-column minor mode. (defvar 2C-mode-line-format (quote ("-%*- %15b --" (-3 . "%p") "--%[(" mode-name minor-mode-alist "%n" mode-line-process ")%]%-")) (#$ . -1739)) #@65 *Hook run in new buffer when it is associated with current one. (defvar 2C-other-buffer-hook (quote text-mode) (#$ . -1956)) #@96 *A string inserted between the two columns when merging. This gets set locally by \[2C-split]. (defvar 2C-separator "" (#$ . -2087)) (put (quote 2C-separator) (quote permanent-local) t) #@123 *The width of the first column. (Must be at least `window-min-width') This value is local for every buffer that sets it. (defvar 2C-window-width 40 (#$ . -2280)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local 2C-window-width put permanent-local t] 4) #@163 *Base for calculating `fill-column' for a buffer in two-column minor mode. The value of `fill-column' becomes `2C-window-width' for this buffer minus this value. (defvar 2C-beyond-fill-column 4 (#$ . -2544)) #@70 If non-nil, Emacs attempts to keep the two column's buffers aligned. (defvar 2C-autoscroll t (#$ . 2758)) (byte-code "ÀÁ!„ÂÁ BÄÁ!‡" [boundp 2C-autoscroll-start nil current-load-list make-variable-buffer-local] 2) (defalias '2C-other #[(&optional req) "ƒÁ!\n†ÄÀ!ˆÄÃ!ˆ …ÆÇ!‡" [2C-mode marker-buffer 2C-mode-line-format mode-line-format kill-local-variable req error "You must first set two-column minor mode."] 2]) #@1577 Minor mode for independently editing two columns. This is set up for two associated buffers by the three commands bound to \[2C-two-columns] , \[2C-associate-buffer] and \[2C-split]. Turning on two-column mode calls the value of the variable `2C-mode-hook', if that value is non-nil. These buffers can be edited separately, for example with `fill-paragraph'. If you want to disable parallel scrolling temporarily, use \[2C-toggle-autoscroll] . If you include long lines, i.e which will span both columns (eg. source code), they should be in what will be the first column, with the associated buffer having empty lines next to them. Potential uses are writing bilingual texts, or editing the comments of a source code. See the file lisp/two-column.el for detailed examples. You have the following commands at your disposal: \[2C-two-columns] Rearrange screen with current buffer first \[2C-associate-buffer] Reassociate buffer after changing major mode \[shrink-window-horizontally], \[enlarge-window-horizontally] Shrink, enlarge current column \[2C-associated-buffer] Switch to associated buffer at same point \[2C-newline] Insert newline(s) in both buffers at same point \[2C-merge] Merge both buffers \[2C-dissociate] Dissociate the two buffers These keybindings can be customized in your ~/.emacs by `2C-mode-map', `2C-minor-mode-map' and by binding `2C-command' to some prefix. The appearance of the screen can be customized by the variables `2C-window-width', `2C-beyond-fill-column', `2C-mode-line-format' and `truncate-partial-width-windows'. (defalias '2C-mode #[(other) "ÀÁ!ˆÂÁÃÄÅ$ˆZ \n \fÍÎ!‡" [make-local-hook post-command-hook add-hook 2C-autoscroll nil t 2C-window-width 2C-beyond-fill-column fill-column 2C-mode-line-format mode-line-format other 2C-mode run-hooks 2C-mode-hook] 5 (#$ . 3192)]) #@344 Split current window vertically for two-column editing. When called the first time, associates a buffer with the current buffer in two-column minor mode (see \[describe-mode] ). Runs `2C-other-buffer-hook' in the new buffer. When called again, restores the screen layout with the current buffer first and the associated buffer to it's right. (defalias '2C-two-columns #[(&optional buffer) "À Á Wƒ ÂÃÄ\"ˆÅÁ Z^]!ˆÈ ƒ6ÉÊ!ˆËÈ !ˆÉÌ!ˆ …^ÎÄ!‡ÏÐ ÉÊ!ˆË†IÒÓÔ P!!ˆ„TÕÖ!ˆ!ˆÏÐ ÉÌ!ˆ!‡" [window-width frame-width enlarge-window 99999 t split-window-horizontally window-min-width 2C-window-width 2C-other other-window 1 switch-to-buffer -1 2C-autoscroll 2C-toggle-autoscroll 2C-mode point-marker buffer generate-new-buffer "2C/" buffer-name run-hooks 2C-other-buffer-hook] 6 (#$ . 5044) "P"]) #@197 Associate another buffer with this one in two-column minor mode. Can also be used to associate a just previously visited file, by accepting the proposed default buffer. (See \[describe-mode] .) (defalias '2C-associate-buffer #[nil "pÀ † ÁÂà \"ŠÆ\fqˆÀ ƒ( À =„(ÈÉÊÀ !\"ˆËÌ ž…1 ) ƒ=Í Z Î\f!*‡" [2C-other read-buffer "Associate buffer: " other-buffer b2 b1 nil 2C-mode error "Buffer already associated with buffer `%s'." buffer-name 2C-window-width buffer-local-variables frame-width 2C-two-columns] 4 (#$ . 5845) nil]) #@727 Split a two-column text at point, into two buffers in two-column minor mode. Point becomes the local value of `2C-window-width'. Only lines that have the ARG same preceding characters at that column get split. The ARG preceding characters without any leading whitespace become the local value for `2C-separator'. This way lines that continue across both columns remain untouched in the first buffer. This function can be used with a prototype line, to set up things. You write the first line of each column and then split that line. E.g.: First column's text sSs Second column's text \___/\ / \ 5 character Separator You type M-5 \[2C-split] with the point here. (See \[describe-mode] .) (defalias '2C-split #[(arg) "À ƒ\"ÁÂÃÀ !ÄQ!ƒŠÀ qˆÅ ˆ)‚\"ÆÇÈ\"ˆ`iÉe`\"Sȉ\n \f ŠÏ!ˆ`{ ÑwˆÒÓ!ˆ`{i)Õ ˆÀ \nŠm?…½i Uƒx `ŠÏ!ˆ`){˜„€\fT\f‚¶`Ï!ˆÑÈxˆ`|ˆ`Ö×\f\"ˆØ\nȈmƒª`‚¬`T#ˆ`|ˆÙ\fÚÛ!ˆ‚\\.‡" [2C-other y-or-n-p "Overwrite associated buffer `" buffer-name "'? " erase-buffer signal quit nil count-lines other chars n goal-column point backward-char arg " " make-local-variable 2C-separator 2C-window-width 2C-two-columns insert-char 10 append-to-buffer 0 next-line 1] 5 (#$ . 6383) "*p"]) #@130 Turn off two-column minor mode in current and associated buffer. If the associated buffer is unmodified and empty, it is killed. (defalias '2C-dissociate #[nil "pŠÁ ƒBÁ qƒBÁ ƒÁ =ƒB „.mƒ.oƒ.ÃÄ!ˆ‚BÅÆ!ˆÅÇ!ˆÅÈ!ˆÅÉ!ˆÅÊ!ˆ)ÅÆ!ˆÅÇ!ˆÅÈ!ˆÅÉ!ˆÅÊ!)‡" [buffer 2C-other buffer-modified-p kill-buffer nil kill-local-variable 2C-mode 2C-window-width 2C-separator mode-line-format fill-column] 2 (#$ . 7650) nil]) #@691 Merges the associated buffer with the current buffer. They get merged at the column, which is the value of `2C-window-width', i.e. usually at the vertical window separator. This separator gets replaced with white space. Beyond that the value of `2C-separator' gets inserted on merged lines. The two columns are thus pasted side by side, in a single text. If the other buffer is not displayed to the left of this one, then this one becomes the left column. If you want `2C-separator' on empty lines in the second column, you should put just one space in them. In the final result, you can strip off trailing spaces with \[beginning-of-buffer] \[replace-regexp] [ SPC TAB ] + $ RET RET (defalias '2C-merge #[nil "À @ÁVƒÂà !ÄÅ!=ƒÆÇ!ˆŠpÄÅ!È \n ebˆ\nqˆebˆm„d`Ȉ`{ m„@Èuˆ qˆ ̘„YȈ jˆ ±ˆÏÐ!ˆ\nqˆ‚-,Ñ Ò W…qÓÔÅ\"‡" [window-edges 0 window-buffer previous-window 2C-other t other-window -1 nil string b2 b1 "" 2C-window-width 2C-separator next-line 1 window-width frame-width enlarge-window 99999] 3 (#$ . 8066) nil]) #@30 Switch to associated buffer. (defalias '2C-associated-buffer #[nil "Àe`\"nƒ\fÁ‚ Â\\lƒn…‚iÅÆÇ!!ƒ/ÈÅÆ !!ˆ‚4ÉÆ !ˆÊË\f!!ˆ ƒDÌ !‚FÁ*‡" [count-lines 1 0 col line get-buffer-window 2C-other t select-window switch-to-buffer newline goto-line move-to-column] 3 (#$ . 9110) nil]) #@38 Insert ARG newlines in both buffers. (defalias '2C-newline #[(arg) "À‹ˆÁ\n!‡" [((byte-code "À ˆÁ\n!‡" [2C-associated-buffer newline arg] 2)) newline arg] 2 (#$ . 9402) "P"]) #@142 Toggle autoscrolling, or set it iff prefix ARG is non-nil and positive. When autoscrolling is turned on, this also realigns the two buffers. (defalias '2C-toggle-autoscroll #[(arg) "À \nƒÃ\n!ÄY‚ ?‰ƒPÆÇ ÈÉ!ˆÊeÀ \"ËÌÍ!!ƒNÆËÌ !!ˆ\nÊeÀ \"ZŠÎÏ\nÊÀ db\"ZÐZ\"ˆ)Ñ\n!ˆ!‡ÈÒ!‡" [window-start 2C-autoscroll-start arg prefix-numeric-value 0 2C-autoscroll select-window selected-window message "Autoscrolling is on." count-lines get-buffer-window 2C-other t insert-char 10 -1 scroll-up "Autoscrolling is off."] 8 (#$ . 9583) "P"]) (defalias '2C-autoscroll #[nil "…#Á :ƒ A@@=„Á A@@!ˆÄÅƈ!‡" [2C-autoscroll select-window selected-window last-command-char nil (byte-code "„\nÁÂ!ƒTà U„TÄ ƒTÅÄ !ƒTÆà \"à Wƒ0[à ÈÅÄ !!ˆŠÉÊÆà db\"ZËZ\"ˆ)Ì!ˆÃ )͇" [2C-autoscroll-start 2C-toggle-autoscroll t window-start 2C-other get-buffer-window count-lines lines select-window insert-char 10 -1 scroll-up nil] 6) ((error))] 5]) #@40 Make current window ARG columns wider. (defalias '2C-enlarge-window-horizontally #[(arg) "À Â\"ˆÃ …\f \\‰…à q…\f Z‰‡" [enlarge-window arg t 2C-other 2C-window-width] 3 (#$ . 10524) "p"]) #@43 Make current window ARG columns narrower. (defalias '2C-shrink-window-horizontally #[(arg) "À [!‡" [2C-enlarge-window-horizontally arg] 2 (#$ . 10725) "p"]) (provide (quote two-column)) emacs-19.30/lisp/type-break.elc100666 12120 1 54125 5752206367 14650 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu May 4 13:20:42 1995 ;;; from file /home/fsf/rms/e19/lisp/type-break.el ;;; emacs version 19.28.90.6. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/home/fsf/rms/e19/lisp/type-break.el' was compiled for Emacs 19")) (require (quote timer)) #@122 *Non-`nil' means typing break mode is enabled. See the docstring for the `type-break-mode' command for more information. (defvar type-break-mode nil (#$ . -511)) #@156 *Non-`nil' means warn about imminent typing breaks in echo area. See the docstring for the `type-break-warning-message-mode' command for more information. (defvar type-break-warning-message-mode t (#$ . -680)) #@53 *Number of seconds between scheduled typing breaks. (defvar type-break-interval 3600 (#$ . -896)) #@421 *Number of seconds of idle time considered to be an adequate typing rest. When this variable is non-`nil', emacs checks the idle time between keystrokes. If this idle time is long enough to be considered a "good" rest from typing, then the next typing break is simply rescheduled for later. If a break is interrupted before this much time elapses, the user will be asked whether or not really to interrupt the break. (defvar type-break-good-rest-interval (/ type-break-interval 6) (#$ . -1001)) #@1068 *Upper and lower bound on number of keystrokes for considering typing break. This structure is a pair of numbers. The first number is the minimum number of keystrokes that must have been entered since the last typing break before considering another one, even if the scheduled time has elapsed; the break is simply rescheduled until later if the minimum threshold hasn't been reached. If this first value is nil, then there is no minimum threshold; as soon as the scheduled time has elapsed, the user will always be queried. The second number is the maximum number of keystrokes that can be entered before a typing break is requested immediately, pre-empting the originally scheduled break. If this second value is nil, then no pre-emptive breaks will occur; only scheduled ones will. Keys with bucky bits (shift, control, meta, etc) are counted as only one keystroke even though they really require multiple keys to generate them. The command `type-break-guestimate-keystroke-threshold' can be used to guess a reasonably good pair of values for this variable. (defvar type-break-keystroke-threshold (byte-code "À \fÅ¥__‰Â¥‰,B‡" [35 wpm 5 avg-word-length type-break-interval 60 upper lower] 5) (#$ . -1507)) #@707 Function to use for making query for a typing break. It should take a string as an argument, the prompt. Usually this should be set to `yes-or-no-p' or `y-or-n-p'. Some people prefer a less intrusive way of being reminded to take a typing break. One possibility is simply to beep a couple of times. To accomplish this, one could do: (defun my-type-break-query (&optional ignored-args) (beep t) (message "You should take a typing break now. Do `M-x type-break'.") (sit-for 1) (beep t) ;; return nil so query caller knows to reset reminder, as if user ;; said "no" in response to yes-or-no-p. nil) (setq type-break-query-function 'my-type-break-query) (defvar type-break-query-function (quote yes-or-no-p) (#$ . 2738)) #@178 *Number of seconds between queries to take a break, if put off. The user will continue to be prompted at this interval until he or she finally submits to taking a typing break. (defvar type-break-query-interval 60 (#$ . -3518)) #@185 *List of time intervals for warnings about upcoming typing break. At each of the intervals (specified in seconds) away from a scheduled typing break, print a warning in the echo area. (defvar type-break-time-warning-intervals (quote (300 120 60 30)) (#$ . -3753)) #@285 *List of keystroke measurements for warnings about upcoming typing break. At each of the intervals (specified in keystrokes) away from the upper keystroke threshold, print a warning in the echo area. If either this variable or the upper threshold is set, then no warnings Will occur. (defvar type-break-keystroke-warning-intervals (quote (300 200 100 50)) (#$ . -4024)) #@179 *Number of keystrokes for which warnings should be repeated. That is, for each of this many keystrokes the warning is redisplayed in the echo area to make sure it's really seen. (defvar type-break-warning-repeat 40 (#$ . -4401)) #@916 If non-nil, this is a countdown for the next typing break. This variable, in conjunction with `type-break-warning-countdown-string-type' (which indicates whether this value is a number of keystrokes or seconds) can be installed by the user somewhere in mode-line-format to notify of imminent typing breaks there. For example, you could do (defvar type-break-mode-line-string '(type-break-warning-countdown-string (" ***Break in " type-break-warning-countdown-string " " type-break-warning-countdown-string-type "***"))) (setq global-mode-string (append global-mode-string '(type-break-mode-line-string))) If you do this, you may also wish to disable the warning messages in the minibuffer. To do this, either set the variable `type-break-warning-message-mode' to `nil' or call the function of the same name with a negative argument. (defvar type-break-warning-countdown-string nil (#$ . 4637)) #@112 Indicates the unit type of `type-break-warning-countdown-string'. It will be either "seconds" or "keystrokes". (defvar type-break-warning-countdown-string-type nil (#$ . 5620)) #@272 *List of functions to consider running as demos during typing breaks. When a typing break begins, one of these functions is selected randomly to have emacs do something interesting. Any function in this list should start a demo which ceases as soon as a key is pressed. (defvar type-break-demo-functions (quote (type-break-demo-boring type-break-demo-life type-break-demo-hanoi)) (#$ . -5804)) #@464 Hook run indirectly by post-command-hook for typing break functions. This is not really intended to be set by the user, but it's probably harmless to do so. Mainly it is used by various parts of the typing break program to delay actions until after the user has completed some command. It exists because `post-command-hook' itself is inaccessible while its functions are being run, and some type-break--related functions want to remove themselves after running. (defvar type-break-post-command-hook nil (#$ . 6206)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÂÆ BÀÇ!„.ÂÇ BÀÈ!„<É È BÀÊ!„IÂ\nÊ BÀË!„VÂ Ë BÀÌ!„cÅ\fÌ BÀÍ!„pÅ Í B‡" [boundp type-break-alarm-p nil current-load-list type-break-keystroke-count 0 type-break-time-last-break type-break-time-next-break type-break-time-last-command current-time type-break-current-time-warning-interval type-break-current-keystroke-warning-interval type-break-time-warning-count type-break-keystroke-warning-count] 2) #@2671 Enable or disable typing-break mode. This is a minor mode, but it is global to all buffers by default. When this mode is enabled, the user is encouraged to take typing breaks at appropriate intervals; either after a specified amount of time or when the user has exceeded a keystroke threshold. When the time arrives, the user is asked to take a break. If the user refuses at that time, emacs will ask again in a short period of time. The idea is to give the user enough time to find a good breaking point in his or her work, but be sufficiently annoying to discourage putting typing breaks off indefinitely. A negative prefix argument disables this mode. No argument or any non-negative argument enables it. The user may enable or disable this mode by setting the variable of the same name, though setting it in that way doesn't reschedule a break or reset the keystroke counter. If the mode was previously disabled and is enabled as a consequence of calling this function, it schedules a break with `type-break-schedule' to make sure one occurs (the user can call that command to reschedule the break at any time). It also initializes the keystroke counter. The variable `type-break-interval' specifies the number of seconds to schedule between regular typing breaks. This variable doesn't directly affect the time schedule; it simply provides a default for the `type-break-schedule' command. If set, the variable `type-break-good-rest-interval' specifies the minimum amount of time which is considered a reasonable typing break. Whenever that time has elapsed, typing breaks are automatically rescheduled for later even if emacs didn't prompt you to take one first. Also, if a break is ended before this much time has elapsed, the user will be asked whether or not to continue. The variable `type-break-keystroke-threshold' is used to determine the thresholds at which typing breaks should be considered. You can use the command `type-break-guestimate-keystroke-threshold' to try to approximate good values for this. There are several variables that affect how or when warning messages about imminent typing breaks are displayed. They include: type-break-warning-message-mode type-break-time-warning-intervals type-break-keystroke-warning-intervals type-break-warning-repeat type-break-warning-countdown-string type-break-warning-countdown-string-type There are several variables that affect how and when queries to begin a typing break occur. They include: type-break-query-function type-break-query-interval Finally, the command `type-break-statistics' prints interesting things. (defalias 'type-break-mode #[(&optional prefix) "ÀÁÂÃ#ˆÀÄÅ\"ˆÈ !ÊYƒ,ƒ,tƒJËÌ!ˆ‚JƒBÍ ˆÎ ˆtƒJËÏ!ˆ‚JtƒJËÐ!ˆ)‡" [add-hook post-command-hook type-break-run-tb-post-command-hook append type-break-post-command-hook type-break-check type-break-mode already-enabled prefix-numeric-value prefix 0 message "type-break-mode is enabled" type-break-keystroke-reset type-break-schedule "type-break-mode is enabled and reset" "type-break-mode is disabled"] 4 (#$ . 7195) "P"]) #@272 Enable or disable warnings in the echo area about imminent typing breaks. A negative prefix argument disables this mode. No argument or any non-negative argument enables it. The user may also enable or disable this mode simply by setting the variable of the same name. (defalias 'type-break-warning-message-mode #[(&optional prefix) "À !ÂYtƒ ƒÄÅ!ˆ‚ÄÆ!ˆ ‡" [prefix-numeric-value prefix 0 type-break-warning-message-mode message "type-break-warning-message-mode is enabled" "type-break-warning-message-mode is disabled"] 2 (#$ . 10355) "P"]) #@230 Take a typing break. During the break, a demo selected from the functions listed in `type-break-demo-functions' is run. After the typing break is finished, the next break is scheduled as per the function `type-break-schedule'. (defalias 'type-break #[nil "À ˆÁ  \fƒEÆ‹ˆƒ?È Â \"‰ Yƒ)Ê‚; ÌÍÎ Z!\"!„;Ê)‚\nʉ„*Ï ˆÐ ‡" [type-break-cancel-schedule t current-time start-time continue type-break-time-last-break ((byte-code "À Á =ƒ\fÂÃ!ˆÄ ˆÅÆ !ˆÇÈ!ˆÉÊ!ˆ G\fÉ\f!‰  8ÏÐш+χ" [selected-window minibuffer-window other-window 1 delete-other-windows scroll-right window-width message "Press any key to resume from typing break." random t type-break-demo-functions len idx fn nil (funcall fn) ((error))] 4)) type-break-good-rest-interval type-break-time-difference break-secs nil type-break-query-function format "You really ought to rest %s more. Continue break? " type-break-format-time type-break-keystroke-reset type-break-schedule] 7 (#$ . 10911) nil]) #@112 Schedule a typing break for TIME seconds from now. If time is not specified, default to `type-break-interval'. (defalias 'type-break-schedule #[(&optional time) "„ ÂÃÄ!ˆ)Å ˆÆÇ\"ˆÈÄ]ÉÊ#ˆËÌ \"‰ ‡" [time type-break-interval t type-break-mode 1 type-break-cancel-schedule type-break-time-warning-schedule reset run-at-time nil type-break-alarm type-break-time-sum current-time type-break-time-next-break] 4 (#$ . 11898) (list (and current-prefix-arg (prefix-numeric-value current-prefix-arg)))]) (defalias 'type-break-cancel-schedule #[nil "À ˆÁÃÄ!ˆ)Åʼn‡" [type-break-cancel-time-warning-schedule t timer-dont-exit cancel-function-timers type-break-alarm nil type-break-alarm-p type-break-time-next-break] 2]) (defalias 'type-break-time-warning-schedule #[(&optional time resetp) "À ˆ) …S\fƒ  „ÆÇ \" ƒ- @ Vƒ- A‰„ …S @Z AÉÊ ]ÀË#ˆ\fƒJÀ‰\f‡Í !\fΉ‡" [nil type-break-current-time-warning-interval type-break-cancel-time-warning-schedule type-break-time-warning-intervals resetp time type-break-time-difference current-time type-break-time-next-break run-at-time 1 type-break-time-warning-alarm type-break-warning-countdown-string number-to-string "seconds" type-break-warning-countdown-string-type] 5]) (defalias 'type-break-cancel-time-warning-schedule #[nil "ÀÂÃ!ˆ)ÄÅÆ\"ˆɉ\n‡" [t timer-dont-exit cancel-function-timers type-break-time-warning-alarm remove-hook type-break-post-command-hook type-break-time-warning type-break-time-warning-intervals type-break-current-time-warning-interval nil type-break-warning-countdown-string] 3]) (defalias 'type-break-alarm #[nil "ÀÁÂ!ˆ)À‰‡" [t type-break-mode 1 type-break-alarm-p] 2]) (defalias 'type-break-time-warning-alarm #[nil "ÀÁÂ!ˆ)à ˆ\fÆÇÈÉ#‡" [t type-break-mode 1 type-break-time-warning-schedule type-break-warning-repeat type-break-time-warning-count add-hook type-break-post-command-hook type-break-time-warning append] 4]) (defalias 'type-break-run-tb-post-command-hook #[nil "…ÁÂ!‡" [type-break-mode run-hooks type-break-post-command-hook] 2]) #@225 Ask to take a typing break if appropriate. This may be the case either because the scheduled time has come (and the minimum keystroke threshold has been reached) or because the maximum keystroke threshold has been exceeded. (defalias 'type-break-check #[nil "@A ƒ!Ä Æ \" VƒÇ ˆÆ É ˆÆ ƒKÊ  Ì !ƒB ÍH:ƒB ÍH@Î>„J G\\)ƒ‰Ñ †ÄÒ Ó =†Ä ƒm WƒmÉ ‚Ä\nƒ„ ƒ„\nZ Wƒ„Ç ˆ Ô ‚ăž\nƒžÍUƒž× †Ä\n…Ä\nV…ÄÑ ?…ÄÒ Ó =?…ÄÇ ˆ †ÀÍÔ *‡" [type-break-keystroke-threshold min-threshold max-threshold type-break-good-rest-interval type-break-time-difference type-break-time-last-command current-time type-break-keystroke-reset type-break-time-last-break type-break-schedule this-command-keys keys vectorp 0 (mouse-movement) type-break-keystroke-count type-break-alarm-p input-pending-p selected-window minibuffer-window type-break-query type-break-keystroke-warning-intervals type-break-keystroke-warning-count type-break-check-keystroke-warning] 3 (#$ . 13950)]) (defalias 'type-break-check-keystroke-warning #[nil "A Z @„Ä‚=\n @VƒÄ‚= @ƒ,\n @Wƒ, A‰‚ ÇÈÉ\"ˆÊ\n! Ì Î)‡" [type-break-keystroke-threshold type-break-keystroke-count left type-break-current-keystroke-warning-interval nil type-break-warning-repeat type-break-keystroke-warning-count add-hook type-break-post-command-hook type-break-keystroke-warning number-to-string type-break-warning-countdown-string "keystrokes" type-break-warning-countdown-string-type t] 4]) (put (quote type-break-check-keystroke-warning) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'type-break-query #[nil "ÀÁÂ\"‡" [add-hook type-break-post-command-hook type-break-do-query] 3]) (defalias 'type-break-do-query #[nil "ÀÁ!…ÂÃĈÅÆÇ\"‡" [sit-for 1 nil (byte-code "À  Ä!*ƒÅ ˆ‚Æ!ˆÀ‡" [nil this-command type-break-mode type-break-query-function "Take a break from typing now? " type-break type-break-schedule type-break-query-interval] 2) ((quit (type-break-schedule type-break-query-interval))) remove-hook type-break-post-command-hook type-break-do-query] 3]) (defalias 'type-break-time-warning #[nil "@ƒ\f @W†O\nÃVƒFÄÅ \"È! Ê Ë =†D\fÍ>†D…DÏÐ!ˆÑÒÓ!\"ˆ\nS‰)‡ÔÕÖ\"ˆ×‰ ‡" [type-break-keystroke-threshold type-break-keystroke-count type-break-time-warning-count 0 type-break-time-difference current-time type-break-time-next-break timeleft number-to-string type-break-warning-countdown-string selected-window minibuffer-window this-command (digit-argument universal-argument) type-break-warning-message-mode sit-for 2 message "Warning: typing break due in %s." type-break-format-time remove-hook type-break-post-command-hook type-break-time-warning nil] 4]) (defalias 'type-break-keystroke-warning #[nil "ÁVƒ+ A\fZ!Æ Ç =†3…*ÉÊ!ˆËÌ A\fZ\"ˆS‰‡ÍÎÏ\"ˆÐ‰‡" [type-break-keystroke-warning-count 0 number-to-string type-break-keystroke-threshold type-break-keystroke-count type-break-warning-countdown-string selected-window minibuffer-window type-break-warning-message-mode sit-for 2 message "Warning: typing break due in %s keystrokes." remove-hook type-break-post-command-hook type-break-keystroke-warning nil] 4]) #@210 Print statistics about typing breaks in a temporary buffer. This includes the last time a typing break was taken, when the next one is scheduled, the keystroke thresholds and the current keystroke count, etc. (defalias 'type-break-statistics #[nil "ÀÁÂÃ\fƒ łƃłƃ$É!‚%Ê\fƒ@ ƒ@ÂÌÉ !ÍÎÏ  \"!#‚AÐ@†HÒA†OÒ&!‘‡" ["*Typing Break Statistics*" princ format "Typing break statistics\n-----------------------\n\nTyping break mode is currently %s.\nWarnings of imminent typing breaks in echo area is %s.\n\nLast typing break ended : %s\nNext scheduled typing break : %s\n\nMinimum keystroke threshold : %s\nMaximum keystroke threshold : %s\nCurrent keystroke count : %s" type-break-mode "enabled" "disabled" type-break-warning-message-mode type-break-time-last-break current-time-string "never" type-break-time-next-break "%s (%s from now)" type-break-format-time type-break-time-difference current-time "none scheduled" type-break-keystroke-threshold "none" type-break-keystroke-count] 14 (#$ . 17104) nil]) #@1179 Guess values for the minimum/maximum keystroke threshold for typing breaks. If called interactively, the user is prompted for their guess as to how many words per minute they usually type. This value should not be your maximum WPM, but your average. Of course, this is harder to gauge since it can vary considerably depending on what you are doing. For example, one tends actually to type less when debugging a program, as opposed to writing documentation. (Perhaps a separate program should be written to estimate average typing speed.) From that, this command sets the values in `type-break-keystroke-threshold' based on a fairly simple algorithm involving assumptions about the average length of words (5). For the minimum threshold, it uses about a fifth of the computed maximum threshold. When called from lisp programs, the optional args WORDLEN and FRAC can be used to override the default assumption about average word length and the fraction of the maximum threshold to which to set the minimum threshold. FRAC should be the inverse of the fractional value; for example, a value of 2 would mean to use one half, a value of 4 would mean to use one quarter, etc. (defalias 'type-break-guestimate-keystroke-threshold #[(wpm &optional wordlen frac) " † ĥ__‰†Â¥„ ɉB ˆ ¡ˆtƒ8ÊË #‚:*‡" [wpm wordlen 5 type-break-interval 60 upper frac lower type-break-keystroke-threshold nil message "min threshold: %d max threshold: %d"] 5 (#$ . 18151) "NOn average, how many words per minute do you type? "]) (defalias 'type-break-time-difference #[(a b) "À @\n@ZÃ\" A@\nA@Z\\‡" [lsh b a 16] 3]) (put (quote type-break-time-difference) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'type-break-time-sum #[(&rest tmlist) "À‰‰ÁƒC@A\n§ƒ\"\f\n\\‚ \n@†)À\\\f\nA@†3À\\ \nAA@†>À\\‚ ÇYƒW Ç¥\f\n\\ \nÇ_ZÈ\fÉ\"‰ÀVƒkÊ\fË\" \n\\ \f E,‡" [0 nil tem micro low high tmlist 1000000 lsh -16 logand 65535] 5]) (defalias 'type-break-format-time #[(secs) "Á¥‰ÃUƒÄÅ\n\"‚/\nÆVƒÄÇ\n\"‚/ÃUƒ+ÄÈ\"‚/ÄÉ\")‡" [secs 60 mins 1 format "%d minute" 0 "%d minutes" "%d second" "%d seconds"] 4]) (put (quote type-break-format-time) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'type-break-keystroke-reset #[nil "ÀÀ ÅÆÇ\"‡" [0 type-break-keystroke-count type-break-keystroke-warning-count type-break-keystroke-warning-intervals type-break-current-keystroke-warning-interval remove-hook type-break-post-command-hook type-break-keystroke-warning] 3]) #@31 Take a hanoiing typing break. (defalias 'type-break-demo-hanoi #[nil "ÀÁ!ƒ\nÂÁ!ˆÃÄŇ" [get-buffer "*Hanoi*" kill-buffer nil (byte-code "ÀÁ Â¥!ˆÃ ˆÄÅ!‡" [hanoi window-width 8 read-char kill-buffer "*Hanoi*"] 3) ((quit (byte-code "À ˆÁÂ!…\fÃÂ!‡" [read-char get-buffer "*Hanoi*" kill-buffer] 2)))] 3 (#$ . 20692)]) #@37 Take a typing break and get a life. (defalias 'type-break-demo-life #[nil "À …ÂÃÄ!ƒÅÄ!ˆÂÆLj‚)‡" [t continue nil get-buffer "*Life*" kill-buffer (byte-code "ÀÁ!ˆÂ ˆÃÄ!‡" [life 3 read-char kill-buffer "*Life*"] 2) ((life-extinct (byte-code "ÀÁÂN!ˆÃÄ!ˆÅÀ‡" [message life-extinct error-message sit-for 3 t continue] 3)) (quit (byte-code "ÀÁ!ƒ\nÂÁ!ˆÀ‡" [get-buffer "*Life*" kill-buffer] 2)))] 3 (#$ . 21013)]) #@27 Boring typing break demo. (defalias 'type-break-demo-boring #[nil "ÀÁ‰‰‰‰‰ \nÂËÌ.‡" ["Press any key to resume from typing break" "*Typing Break Buffer*" nil tmsg timeleft elapsed pos col line buffer-name rmsg (byte-code "ÀÁ\n!!ˆÃp!ˆÄ ˆÅ Æ¥TÈ  GZÆ¥\nËÌ\"Ë\nÍ\" ±ˆÎyˆÏyˆ`Ñ „[‰bˆÒˆ`|ˆÔ ×@@ZØ\"A@A@Z\\*ƒýZ‰ÏVƒºÜ݉ߥ‰ áUƒÜâ \"‚³ ÏVƒŸÜã \"‚³áUƒ®Üä\"‚³Üå\"*\"&‚=Üç‰ߥ‰ áUƒÓÜâ \"‚ö ÏVƒâÜã \"‚öáUƒñÜä\"‚öÜå\"*\"&‚=Üç‰ߥ‰ áUƒÜâ \"‚9 ÏVƒ%Üã \"‚9áUƒ4Üä\"‚9Üå\"*\"&È &GZÆ¥\nË\nÍ\"&±ˆebˆèß!ˆ‚6é ˆê\n!‡" [switch-to-buffer get-buffer-create buffer-name buffer-disable-undo erase-buffer window-height 2 line window-width rmsg col make-string 10 32 -1 0 pos input-pending-p nil type-break-time-last-break current-time b a lsh 16 elapsed type-break-good-rest-interval timeleft format "You should rest for %s more" secs 60 mins 1 "%d minute" "%d minutes" "%d second" "%d seconds" tmsg "Typing break has lasted %s" sit-for read-char kill-buffer] 7) ((quit (byte-code "À !…  !‡" [get-buffer buffer-name kill-buffer] 2)))] 8 (#$ . 21436)]) (provide (quote type-break)) emacs-19.30/lisp/uncompress.elc100666 13437 1 3517 5744577655 15132 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:54:20 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/uncompress.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/uncompress.el' was compiled for Emacs 19")) #@35 Program to use for uncompression. (defvar uncompress-program "gunzip" (#$ . 489)) (defalias 'uncompress-backup-file #[nil "ƒ ƒ\n„Ã!„Ä Æ‰‰%ˆÆ‡" [buffer-file-name make-backup-files buffer-backed-up file-exists-p call-process uncompress-program nil] 6]) (byte-code "ÀÁ\n\"„ Ã\nBÀÄ\n\"„Å\nBÀ‡" [assoc "\\.Z$" auto-mode-alist ("\\.Z$" . uncompress-while-visiting) "\\.gz$" ("\\.gz$" . uncompress-while-visiting)] 3) #@146 Temporary "major mode" used for .Z and .gz files, to uncompress them. It then selects a major mode from the uncompressed file name and contents. (defalias 'uncompress-while-visiting #[nil "ƒÁÂ\"ƒÃĉ”O!ˆ‚)ƒ)ÁÅ\"ƒ)Ãĉ”O!ˆÆÇ!ˆÈ Êed Ì$ˆ)ÆÍ!ˆÎÈ!ˆÏÐ!ˆÑ>„RÑBÒ ‡" [buffer-file-name string-match "\\.Z$" set-visited-file-name 0 "\\.gz$" message "Uncompressing..." nil buffer-read-only shell-command-on-region uncompress-program t "Uncompressing...done" set-buffer-modified-p make-local-variable write-file-hooks uncompress-backup-file normal-mode] 5 (#$ . 923)]) (byte-code "À >„\nÀ BÀ‡" [find-compressed-version find-file-not-found-hooks] 2) #@63 Hook to read and uncompress the compressed version of a file. (defalias 'find-compressed-version #[nil "À ÄP‰!ƒ ‚ ÅP‰!ƒ  =…/Æ Ç\"ˆebˆÀÇ)‡" [nil name file-exists-p buffer-file-name ".Z" ".gz" insert-file-contents t error] 3 (#$ . 1587)]) (provide (quote uncompress)) emacs-19.30/lisp/underline.elc100666 13437 1 2227 5744577656 14717 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:54:21 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/underline.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/underline.el' was compiled for Emacs 19")) #@179 Underline all nonblank characters in the region. Works by overstriking underscores. Called from program, takes two arguments START and END which specify the range to operate on. (defalias 'underline-region #[(start end) "ŠÀ ‰\n ]Ä“ˆ\n ^bˆ` W…%ÅÆ!„ÇcˆÈuˆ‚*‡" [make-marker end1 start end nil looking-at "[_- ]" "_" 1] 4 (#$ . 488) "r"]) #@158 Remove all underlining (overstruck underscores) in the region. Called from program, takes two arguments START and END which specify the range to operate on. (defalias 'ununderline-region #[(start end) "ŠÀ ‰\n ]Ä“ˆ\n ^bˆÅÆ Ç#…ÈÉ!ˆ‚*‡" [make-marker end1 start end nil re-search-forward "_\\|_" t delete-char -2] 5 (#$ . 838) "r"]) emacs-19.30/lisp/undigest.elc100666 13437 1 4172 6033657022 14527 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Oct 1 23:35:31 1995 ;;; from file /home/fsf/rms/e19/lisp/undigest.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`undigest.el' was compiled for Emacs 19.29 or later")) (require (quote rmail)) #@127 Break up a digest message into its constituent messages. Leaves original message, deleted, before the undigestified messages. (defalias 'undigestify-rmail-message #[nil "~ˆÀÁ\n!Ã\n!{Ã\n!bˆ``}ˆ\fcˆedS}ˆ*ÆÀÈŽŒebˆeÉÊ!ˆ`|ˆËcˆ`d}ˆÌ ÆÀÐŒÉÑ!ˆ`e`}ˆdbˆÒÓ!†fÒÔ!†fÒÕ!†fÒÖ!)†mÇ×!!ŠdbˆÙÀxˆÀ`Vƒœ„œÛyˆÜÝÞß!àáR!ƒ{Æ‚{„¥Çâ!ˆ*ãäåæç\"èQ!ˆéË!ˆŒ`ÉÑ!ˆ`}ˆÒÔ!„Íebˆê뱈)ãÑåìç\"èQÀÆ#ƒ4éí!ˆŒÜî!ƒñêѱˆ‚û`ÉÑÀï#ˆ`}ˆÒÔ!„ ebˆê뱈)ŠebˆãðÀÆ#ƒ0ñ 2ebˆãó2Æ#ƒ/ôõ!ˆ‚))‚Î-Àö÷!ˆ\n8ù ˆú8!ˆû ˆü …‹=>ÿ ƒw@ AŠBŽCD!ˆ>=E ˆ,‚†ŠDqˆ>=E ˆ*F ),‡" [nil rmail-msgbeg rmail-current-message rmail-msgend msg-string buffer-read-only t error ((byte-code "ƒedT}ˆed|ˆÁ\n!ˆÁ‡" [error rmail-show-message rmail-current-message] 2)) search-forward "\n*** EOOH ***\n" "\f\n0, unseen,,\n*** EOOH ***\n" "" fill-prefix case-fold-search start mail-strip-quoted-names "\n\n" mail-fetch-field "Reply-To" "To" "Apparently-To" "From" "Message is not a digest--bad header" digest-name " \n" found -1 looking-at "End of.*Digest.*\n" regexp-quote "*********" "*" "\\(\n------*\\)*" "Message is not a digest--no end line" re-search-forward "^" make-string 55 45 "-*\n*" replace-match "To: " "\n" 27 "\n\n\f\n0, unseen,,\n*** EOOH ***\n" "End " move "\n\n----------------------------*\n*" point-marker end "^- " delete-char -2 message "Message successfully undigestified" n rmail-forget-messages rmail-show-message rmail-delete-forward rmail-summary-exists rmail-total-messages total rmail-summary-displayed selected-window window ((select-window window)) pop-to-buffer rmail-summary-buffer rmail-update-summary rmail-maybe-display-summary] 5 (#$ . 499) nil]) emacs-19.30/lisp/uniquify.elc100666 12120 1 16756 6045235564 14463 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 15:54:06 1995 ;;; from file /home/fsf/rms/e19/lisp/uniquify.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`uniquify.el' was compiled for Emacs 19.29 or later")) (provide (quote uniquify)) #@564 *If non-nil, buffer names are uniquified with parts of directory name. The value determines the buffer name style and is one of 'forward, 'reverse, 'post-forward (the default), or 'post-forward-angle-brackets. For example, files /foo/bar/mumble/name and /baz/quux/mumble/name would be in the following buffers: forward bar/mumble/name quux/mumble/name reverse name\mumble\bar name\mumble\quux post-forward name|bar/mumble name|quux/mumble post-forward-angle-brackets name name nil name name<2> (defvar uniquify-buffer-name-style (quote post-forward) (#$ . -504)) #@215 *If non-nil, rerationalize buffer names after a buffer has been killed. This can be dangerous if Emacs Lisp code is keeping track of buffers by their names (rather than keeping pointers to the buffers themselves). (defvar uniquify-after-kill-buffer-p nil (#$ . -1143)) #@180 *If non-nil, permit user to choose names for buffers with same base file. If the user chooses to name a buffer, uniquification is preempted and no other buffer names are changed. (defconst uniquify-ask-about-buffer-names-p nil (#$ . -1419)) #@63 *Minimum parts of directory pathname included in buffer name. (defvar uniquify-min-dir-content 0 (#$ . -1666)) #@271 *String separator for buffer name components. When `uniquify-buffer-name-style' is 'post-forward, separates base file name from directory part in buffer names (default "|"). When `uniquify-buffer-name-style' is 'reverse, separates all pathname components (default "\"). (defvar uniquify-separator nil (#$ . -1784)) #@231 *If non-nil, add a pathname separator to dired buffer names. If `uniquify-buffer-name-style' is 'forward, add the separator at the end; if it's is 'reverse, add the separator at the beginning; otherwise, this variable is ignored. (defvar uniquify-trailing-separator-p nil (#$ . -2106)) (defalias 'uniquify-push '(macro . #[(item list) "À  EE‡" [setq list cons item] 5])) (defalias 'uniquify-fix-list-base '(macro . #[(a) "À D‡" [car a] 2])) (defalias 'uniquify-fix-list-filename '(macro . #[(a) "ÀÁ\nDD‡" [car cdr a] 3])) (defalias 'uniquify-fix-list-buffer '(macro . #[(a) "ÀÁ‰\nDDD‡" [car cdr a] 4])) (defalias 'uniquify-cadddr '(macro . #[(a) "ÀÁ‰‰\nDDDD‡" [car cdr a] 5])) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp uniquify-non-file-buffer-names nil current-load-list uniquify-possibly-resolvable] 2) #@200 Makes file buffer names unique by adding segments from pathname. If `uniquify-min-dir-content' > 0, always pulls that many pathname elements. Arguments cause only a subset of buffers to be renamed. (defalias 'uniquify-rationalize-file-buffer-names #[(&optional newbuffile newbuf) "À‰ Å ‰ƒh@‰=ƒ!É\n!‚%Ë!‰\f…/Í\f!‰…B\n?†BÍ\n!š‰ƒV\fÀF\fB‚^Ð!C B,A‰„)Ñ\fÒ\"Ó\f\n\"ˆÔÕ\f\"+‡" [nil uniquify-min-dir-content depth uniquify-non-file-buffer-names fix-list buffer-list buffers buffer newbuf expand-file-name newbuffile uniquify-buffer-file-name bfn file-name-nondirectory rawname deserving buffer-name sort uniquify-filename-sort uniquify-rationalize-a-list mapcar uniquify-unrationalized-buffer] 5 (#$ . 2926) nil]) #@123 Return name of file BUFFER is visiting, or nil if none. Works on dired buffers as well as ordinary file-visiting buffers. (defalias 'uniquify-buffer-file-name #[(buffer) "À !†\fŠ qˆ\n)‡" [buffer-file-name buffer list-buffers-directory] 2 (#$ . 3688)]) (defalias 'uniquify-filename-sort #[(s1 s2) "À A@\nA@\"‡" [uniquify-filename-lessp s1 s2] 3]) (defalias 'uniquify-filename-lessp #[(s1 s2) "À !À\n! Åš?…C\f ™†C\f š…CÆ !Æ\n!GÉX?…BGÉX†BÊËÌOËÌO\"**‡" [file-name-nondirectory s1 s2 s2f s1f "" file-name-directory s2d s1d 1 uniquify-filename-lessp 0 -1] 5]) (defalias 'uniquify-unrationalized-buffer #[(item) "AAA@‡" [item] 1]) (defalias 'uniquify-rationalize-a-list #[(fix-list depth) "ÀÁÀ‰ƒ9@È \"‰\fš„(Ê \f #ˆÀ B )A‰„ Ê \f #,‡" [nil "" uniquify-possibly-resolvable proposed-name old-name conflicting-sublist fix-list item uniquify-get-proposed-name depth uniquify-rationalize-conflicting-sublist] 5]) (defalias 'uniquify-get-proposed-name #[(item depth) "ÀÁ\n @ A@ÉVƒJÊËÌ!Ì !ÍR\f\"‰ƒJ\fÉUƒ6É‚9T\fG GZOS‰‚ÉUƒT΃ƒÑ\f!ƒƒ Á˜„ƒÓ=ƒs ÔP‚ƒÕ=ƒƒ†€× PÁ˜„£Ø=„˜Ù=ƒ£ÉGÚZOÁ˜ƒ® ‚ Á˜ƒ¹‚Ó=ƒÇ P‚Õ=ƒ× Û!P‚Ø=ƒë †åÜQ‚Ù=ƒû ÝÞR‚ßà\"-‡" [nil "" depth item fn base n extra-string index 0 string-match "\\(^\\|/[^/]*\\)/" regexp-quote "\\'" t uniquify-possibly-resolvable uniquify-trailing-separator-p file-directory-p uniquify-buffer-name-style forward "/" reverse uniquify-separator "\\" post-forward post-forward-angle-brackets 1 uniquify-reverse-components "|" "<" ">" error "Bad value for uniquify-buffer-name-style: %s"] 6]) (defalias 'uniquify-rationalize-conflicting-sublist #[(conflicting-sublist old-name depth) "?†,A„!Á\n \"„!\nĘ„Å@\n\"†,Ƈ…,È T\"‡" [conflicting-sublist assoc old-name uniquify-non-file-buffer-names "" uniquify-rename-buffer t uniquify-possibly-resolvable uniquify-rationalize-a-list depth] 3]) (defalias 'uniquify-rename-buffer #[(item newname) "AA@\nà !š„pÄ qˆÇ\n!ˆqˆ*)țɠ‡" [item buffer newname buffer-name nil uniquify-buffer-name-style unset rename-buffer 3 t] 3]) (defalias 'uniquify-reverse-components #[(instring) "ÀÁ\nG † ÄWƒP\nHÉUƒ0 BT‰‚ÊË\n#†;\f\n\fOB\f)‚ÍÎ\",‡" [nil 0 instring uniquify-separator "\\" sep len cursor sofar 47 string-match "/" first-slash apply concat] 5]) (byte-code "ÀÁÂÃÄ$ˆÅÁÄ\"ˆÀÆÇÃÄ$ˆÅÆÄ\"‡" [ad-add-advice rename-buffer (rename-buffer-uniquify nil t (advice lambda nil "Uniquify buffer names with parts of directory name." (if (and uniquify-buffer-name-style (ad-get-arg 1)) (progn (if uniquify-after-kill-buffer-p (uniquify-rationalize-file-buffer-names) (uniquify-rationalize-file-buffer-names (uniquify-buffer-file-name (current-buffer)) (current-buffer))) (setq ad-return-value (buffer-name (current-buffer))))))) after nil ad-activate-on create-file-buffer (create-file-buffer-uniquify nil t (advice lambda nil "Uniquify buffer names with parts of directory name." (if uniquify-buffer-name-style (uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value))))] 5) #@154 Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'. For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion. (defalias 'delay-uniquify-rationalize-file-buffer-names #[nil "…\f …\fÂÃÄ\"‡" [uniquify-buffer-name-style uniquify-after-kill-buffer-p add-hook post-command-hook delayed-uniquify-rationalize-file-buffer-names] 3 (#$ . 6840)]) #@134 Rerationalize buffer names and remove self from `post-command-hook'. See also `delay-rationalize-file-buffer-names' for hook setter. (defalias 'delayed-uniquify-rationalize-file-buffer-names #[nil "À ˆÁÂÃ\"‡" [uniquify-rationalize-file-buffer-names remove-hook post-command-hook delayed-uniquify-rationalize-file-buffer-names] 3 (#$ . 7229)]) (add-hook (quote kill-buffer-hook) (quote delay-uniquify-rationalize-file-buffer-names)) emacs-19.30/lisp/unrmail.elc100666 13437 1 2776 6034775233 14372 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Thu Oct 5 11:32:41 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/unrmail.el ;;; emacs version 19.29.11. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`unrmail.el' was compiled for Emacs 19.29 or later")) (byte-code "À BÀ‡" [command-line-args-left current-load-list] 2) #@260 Convert Rmail files to system inbox format. Specify the input Rmail file names as command line arguments. For each Rmail file, the corresponding output file name is made by adding `.mail' at the end. For example, invoke `emacs -batch -f batch-unrmail RMAIL'. (defalias 'batch-unrmail #[nil "„ÁÂ!ˆÃ\fƒ\"Å\f@\f@ÆP\"„Ç\fA‰„ÈÉ!ˆÊ ƒ/Ë‚0Ì!)‡" [noninteractive error "`batch-unrmail' is to be used only with -batch" nil command-line-args-left unrmail ".mail" t message "Done" kill-emacs 1 0] 5 (#$ . 547)]) #@62 Convert Rmail file FILE to system inbox format file TO-FILE. (defalias 'unrmail #[(file to-file) "ÀÁ‰Å!ˆÇÈ \"ˆ\f\nWƒ,Ë\fT‰!ˆÌ ˆÍ ÎÏ#ˆ‚ÇÐ \"+‡" [0 nil rmail-delete-after-output rmail-display-summary message-count rmail file message "Writing messages to %s..." to-file rmail-total-messages rmail-show-message rmail-toggle-header rmail-output 1 t "Writing messages to %s...done"] 4 (#$ . 1065) "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): "]) emacs-19.30/lisp/unused.elc100666 13437 1 2422 5744577660 14225 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:54:24 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/unused.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/unused.el' was compiled for Emacs 19")) #@42 Set mark at the beginning of the buffer. (defalias 'mark-beginning-of-buffer #[nil "Àe!‡" [push-mark] 2 (#$ . 481) nil]) #@36 Set mark at the end of the buffer. (defalias 'mark-end-of-buffer #[nil "Àd!‡" [push-mark] 2 (#$ . 608) nil]) #@64 Uppercasify ARG chars starting from point. Point doesn't move (defalias 'upcase-char #[(arg) "ŠÀ` uˆ`\")‡" [upcase-region arg] 3 (#$ . 723) "p"]) #@98 Move forward until encountering the beginning of a word. With argument, do this that many times. (defalias 'forward-to-word #[(arg) "À ÂVƒ Â\fÄÅÆ $† ÂVƒd‚eb‡" [re-search-forward arg 0 "\\W\\b" "\\b\\W" nil t] 5 (#$ . 876) "p"]) #@93 Move backward until encountering the end of a word. With argument, do this that many times. (defalias 'backward-to-word #[(arg) "À [!‡" [forward-to-word arg] 2 (#$ . 1119) "p"]) emacs-19.30/lisp/userlock.elc100666 13437 1 7161 5744577662 14560 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:54:26 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/userlock.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/userlock.el' was compiled for Emacs 19")) (put (quote file-locked) (quote error-conditions) (quote (file-locked file-error error))) #@382 Ask user what to do when he wants to edit FILE but it is locked by USER. This function has a choice of three things to do: do (signal 'buffer-file-locked (list FILE USER)) to refrain from editing the file return t (grab the lock on the file) return nil (edit the file even though it is locked). You can rewrite it to use any criterion you like to choose which one to do. (defalias 'ask-user-about-lock #[(fn opponent) "À ˆÁ‹‡" [discard-input ((byte-code "À „bÂÃ\f #ˆÆ‰É —À\n*‰ \fUƒ(Í ˆ‚^Î Ï\"‰„@Ð ˆÂÑ!ˆÒÓ!ˆ‚^ AÔ=ƒOÍ ˆÀ‚^ AÕ=ƒ^Ö×Ø \fE\"ˆ)‚ A)‡" [nil answer message "%s is locking %s: action (s, q, p, ?)? " opponent fn t cursor-in-echo-area inhibit-quit read-char quit-flag tem help-char ask-user-about-lock-help assoc ((115 . t) (113 . yield) (7 . yield) (112) (63 . help)) beep "Please type q, s, or p; or ? for help" sit-for 3 help yield signal file-locked "File is locked"] 6))] 1 (#$ . 576)]) (defalias 'ask-user-about-lock-help #[nil "ÀÁÂ!ˆŠ qˆÄ )‘‡" ["*Help*" princ "It has been detected that you want to modify a file that someone else has\nalready started modifying in EMACS.\n\nYou can teal the file; The other user becomes the\n intruder if (s)he ever unmodifies the file and then changes it again.\nYou can

roceed; you edit at your own (and the other user's) risk.\nYou can uit; don't modify this file." standard-output help-mode] 3]) (put (quote file-supersession) (quote error-conditions) (quote (file-supersession file-error error))) #@425 Ask a user who is about to modify an obsolete buffer what to do. This function has two choices: it can return, in which case the modification of the buffer will proceed, or it can (signal 'file-supersession (file)), in which case the proposed buffer modification will not be made. You can rewrite this to use any criterion you like to choose which one to do. The buffer in question is current when this function is called. (defalias 'ask-user-about-supersession-threat #[(fn) "À ˆÁ‹‡" [discard-input ((byte-code "À „YÂÃÄ !\"ˆÆÈ )—‰ \nUƒ!Ë‚'Ì Í\"A‰„:Î ˆÂÏ!ˆÐÑ!ˆ‚U Ë=ƒHÒ ˆÀ‚U Ó=ƒUÔÕÖ D\"ˆ)‚Â×!ˆÀ‰)‡" [nil answer message "%s changed on disk; really edit the buffer? (y, n or C-h) " file-name-nondirectory fn t cursor-in-echo-area read-char tem help-char help assoc ((110 . yield) (7 . yield) (121 . proceed) (63 . help)) beep "Please type y or n; or ? for help" sit-for 3 ask-user-about-supersession-help yield signal file-supersession "File changed on disk" "File on disk now will become a backup file if you save these changes." buffer-backed-up] 5))] 1 (#$ . 2073)]) (defalias 'ask-user-about-supersession-help #[nil "ÀÁÂ!ˆŠ qˆÄ )‘‡" ["*Help*" princ "You want to modify a buffer whose disk file has changed\nsince you last read it in or saved it with this buffer.\n\nIf you say `y' to go ahead and modify this buffer,\nyou risk ruining the work of whoever rewrote the file.\nIf you say `n', the change you started to make will be aborted.\n\nUsually, you should type `n' and then `M-x revert-buffer',\nto get the latest version of the file, then make the change again." standard-output help-mode] 3]) emacs-19.30/lisp/vc-hooks.elc100666 12241 1 41633 6052010674 15004 0ustar rolanddaemon;ELC ;;; compiled by roland@snoopy.gnu.ai.mit.edu on Mon Nov 13 23:51:06 1995 ;;; from file /usr/src/emacs-build/lisp/vc-hooks.el ;;; emacs version 19.29.91.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`vc-hooks.el' was compiled for Emacs 19.29 or later")) #@133 *Back-end actually used by this interface; may be SCCS or RCS. The value is only computed when needed to avoid an expensive search. (defvar vc-default-back-end nil (#$ . -483)) #@93 *If non-nil, use VC for files managed with CVS. If it is nil, don't use VC for those files. (defvar vc-handle-cvs t (#$ . -666)) #@194 *Indicates whether rcsdiff understands the --brief option. The value is either `yes', `no', or nil. If it is nil, VC tries to use --brief and sets this variable to remember whether it worked. (defvar vc-rcsdiff-knows-brief nil (#$ . -802)) #@68 *List of extra directories to search for version control commands. (defvar vc-path (byte-code "ÀÁ!…‡" [file-directory-p "/usr/sccs" ("/usr/sccs")] 2) (#$ . -1049)) #@148 *Where to look for version-control master files. The first pair corresponding to a given back end is used as a template when creating new masters. (defvar vc-master-templates (quote (("%sRCS/%s,v" . RCS) ("%s%s,v" . RCS) ("%sRCS/%s" . RCS) ("%sSCCS/s.%s" . SCCS) ("%ss.%s" . SCCS) vc-find-cvs-master)) (#$ . -1223)) #@146 *If non-nil, backups of registered files are made as with other files. If nil (the default), files covered by version control don't get backups. (defvar vc-make-backup-files nil (#$ . -1546)) #@93 *If non-nil, display revision number and lock status in modeline. Otherwise, not displayed. (defvar vc-display-status t (#$ . -1744)) #@56 *Identify work files by searching for version headers. (defvar vc-consult-headers t (#$ . -1884)) #@157 *If non-nil, don't delete working files after registering changes. If the back-end is CVS, workfiles are always kept, regardless of the value of this flag. (defvar vc-keep-workfiles t (#$ . -1989)) #@76 *Don't assume that permissions and ownership track version-control status. (defvar vc-mistrust-permissions nil (#$ . -2193)) (defalias 'vc-mistrust-permissions #[(file) "Á=†… !!‡" [vc-mistrust-permissions t vc-backend-subdirectory-name file] 3]) (byte-code "ÀÁ\n\"„ Ã\nBÄÁ!ˆÅÁÆÇ#‡" [assoc vc-mode minor-mode-alist (vc-mode vc-mode) make-variable-buffer-local put permanent-local t] 4) (defalias 'vc-error-occurred '(macro . #[(&rest body) "ÀÁÂÃ\fÅ\"BÆF‡" [condition-case nil progn append body (nil) (error t)] 6])) #@34 Obarray for per-file properties. (defvar vc-file-prop-obarray [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] (#$ . 2724)) (byte-code "ÀÁ!„ÂÁ BÄÁ!‡" [boundp vc-buffer-backend t current-load-list make-variable-buffer-local] 2) (defalias 'vc-file-setprop #[(file property value) "ÀÁ\n \"\f #‡" [put intern file vc-file-prop-obarray property value] 4]) (defalias 'vc-file-getprop #[(file property) "À \n\" N‡" [intern file vc-file-prop-obarray property] 3]) (defalias 'vc-file-clearprops #[(file) "ÀÁ\n \"Ä\"‡" [setplist intern file vc-file-prop-obarray nil] 4]) (defalias 'vc-match-substring #[(bn) "”•{‡" [bn] 2]) (defalias 'vc-lock-file #[(file) "À !‰…ÃÄ\n\"…\nŔŕOÆ\nǔǕOQ)‡" [vc-name file master string-match "\\(.*/\\)s\\.\\(.*\\)" 1 "p." 2] 6]) (defalias 'vc-parse-buffer #[(patterns &optional file properties) "ÀÁ\n\"‡" [mapcar #[(p) "ebˆGÁ=ƒ1ÂÄ@ÂÅ#ƒÆÇœ!ƒ.É\n@ #ˆ\nA\n )‡GË=…|Ì Ä@ÂÅ#ƒeÆÁœ!™ƒaÆÇœ! )‚>ƒyÉ\n@ #ˆ\nA\n *‡" [p 2 nil value re-search-forward t vc-match-substring 1 file vc-file-setprop properties 3 "" latest-val latest-date date] 4] patterns] 3]) (defalias 'vc-insert-file #[(file &optional limit blocksize) "À ˆÁ\n!ƒU ƒG\f„ÅƉ‰„CÉ ‰TbˆÊ\nƉ\f\\$A@ËU†=ËyˆÌ ÆÍ#‰ƒ*‚KÊ\n!ˆÎÆ!ˆÏÆ!ˆÍ‡Æ‡" [erase-buffer file-exists-p file limit blocksize 8192 nil s found buffer-size insert-file-contents 0 re-search-forward t set-buffer-modified-p auto-save-mode] 7]) (defalias 'vc-parse-locks #[(file locks) "„\nÁ\nÃÄ#‡ÅÆlj‰ \n \fÍ\n!Î=ƒMÏÐ #ƒ™єѕO Ò”Ò•OÓ\n BC\"\nÆ• ‚!Í\n!Ô=ƒ™ÏÕ #ƒÒ”Ò•O єѕOÓ\n BC\"\nÆ• ‚UÏÖ #ƒ“Á\n×Ø#ˆ‚™Á\n×Ù#ˆÁ\nÃ\n†¢Ä#-‡" [locks vc-file-setprop file vc-master-locks none t 0 nil user version master-locks index found vc-backend SCCS string-match "^\\([0-9.]+\\) [0-9.]+ \\([^ ]+\\) .*\n?" 1 2 append RCS "[ \n]*\\([^:]+\\):\\([0-9.]+\\)" ";[ \n]+strict;" vc-checkout-model manual implicit] 5]) (defalias 'vc-simple-command #[(okstatus command file &rest args) "ŠÀÁ!qˆÂ ˆ)Ã\f \"ÆÇÈÉ!\nËÌ\f\n#R B ÏÐÆÁÆÃC\"&‰VƒNÕÖ!!ˆ×ØÁ!!ˆÙÚ!ˆ+‡" [get-buffer-create "*vc-info*" erase-buffer append vc-path exec-path nil "PATH=" getenv "PATH" path-separator mapconcat identity process-environment exec-status apply call-process command args file okstatus switch-to-buffer get-file-buffer shrink-window-if-larger-than-buffer display-buffer error "Couldn't find version control information"] 10]) (defalias 'vc-fetch-master-properties #[(file) "ŠÀ !Â=ƒ?ÃÄ!qˆÅÆ !!ƒÇ È \"ˆ‚%É ÊË#ˆÅÌ !Í\"ˆÎÏÐÑÒ !ÓQÔDD Õ#ˆ‚AÀ !Ö=ƒ®ÃÄ!qˆÅÌ !×\"ˆÎØÙÚE Û#ˆÜ Ý\"‰ƒmߘƒyÉ àÜ á\"#ˆ‚¢âã\"ƒ‹É à#ˆ‚¢ÅÌ !ä\"ˆÎåÑ!æQÔçEC è#ˆ)Ç Ü Ê\"\"ˆ‚AÀ !é=ƒAŠê !+ìíîï !ð$ˆ)ñÄ!qˆÎò ó#ˆÜ ô\"5âö5\"ƒòÉ ô÷#ˆÉ øùú !8#ˆ‚@É ôâû5\"ƒü‚>âý5\"ƒ þ‚>âÿ5\"ƒ@‚>âA5\"ƒ+B‚>âC5\"ƒ;D‚>E#ˆ*ñÄ!…NFñÄ!!)‡" [vc-backend file SCCS get-buffer-create "*vc-info*" vc-insert-file vc-lock-file vc-parse-locks buffer-string vc-file-setprop vc-master-locks none vc-name "^e" vc-parse-buffer ("^d D \\([^ ]+\\)" 1) "^d D \\([^ ]+\\) .* " regexp-quote user-login-name " " 1 (vc-latest-version vc-your-latest-version) RCS "^[0-9]" ("^head[ \n]+\\([^;]+\\);" 1) ("^branch[ \n]+\\([^;]+\\);" 1) ("^locks[ \n]*\\([^;]*;\\([ \n]*strict;\\)?\\)" 1) (vc-head-version vc-default-branch vc-master-locks) vc-file-getprop vc-default-branch default-branch "" vc-master-workfile-version vc-head-version string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$" "^desc" "^\\(" "\\.[0-9]+\\)\ndate[ ]+\\([0-9.]+\\);" 2 (vc-master-workfile-version) CVS file-name-directory default-directory vc-simple-command 0 "cvs" file-name-nondirectory "status" get-buffer (("\\(RCS Version\\|RCS Revision\\|Repository revision\\):[ ]+\\([0-9.]+\\)" 2) ("^File: [^ ]+[ ]+Status: \\(.*\\)" 1)) (vc-latest-version vc-cvs-status) vc-cvs-status status "Up-to-date" up-to-date vc-checkout-time 5 file-attributes "Locally Modified" locally-modified "Needs Merge" needs-merge "Needs \\(Checkout\\|Patch\\)" needs-checkout "Unresolved Conflict" unresolved-conflict "Locally Added" locally-added unknown kill-buffer] 7]) (defalias 'vc-consult-rcs-headers #[(file) "ƒ\nÁ\n!„\fÇɉŠÁ\n!qˆebˆÇÈÃÉ#ƒ*ÊË!„;ebˆÇÌÃÉ#ƒrÊË!ƒrÍ•bˆÎ”Ε{ÊÏÐÑQ!ƒºÍ•bˆÊÒ!ƒ`ÓÔ‚ºÊÕ!ƒºÎ”Ε{Ô‚ºÖÒ×PÃÉ#ƒºÎ”Ε{ebˆÖÒØPÃÉ#ƒ·ÊÙ!ƒ¡Î”Ε{Ô‚ºÊÚ!ƒ¯ÓÔ‚ºÓÔ‚ºÛ)ƒÆÜ\nÝ #ˆÔ=ƒÞ\n!ß=ƒÜ\nà\f#ƒá\n!„à\n!„âãäå\n!8\"ƒýÜ\næç#ˆ‚Ü\næè#ˆ+‡" [vc-consult-headers get-file-buffer file nil locking-user version status search-forward "$Id: " t looking-at "[^ ]+ \\([0-9.]+\\) " "$Header: " 0 1 "[0-9]+[/-][01][0-9][/-][0-3][0-9] " "[0-2][0-9]:[0-5][0-9]+:[0-6][0-9]+\\([+-][0-9:]+\\)? " "[^ ]+ [^ ]+ " "\\$" none rev-and-lock "\\([^ ]+\\) \\$" re-search-forward "Revision: \\([0-9.]+\\) \\$" "Locker:" " \\([^ ]+\\) \\$" " *\\$" rev vc-file-setprop vc-workfile-version vc-backend RCS vc-locking-user vc-mistrust-permissions string-match ".r-..-..-." 8 file-attributes vc-checkout-model manual implicit] 5]) (defalias 'vc-backend-subdirectory-name #[(&optional file) "À ƒ  !† †ÄÅ!ƒÆ‚lj!‡" [symbol-name file vc-backend vc-default-back-end vc-find-binary "rcs" RCS SCCS] 3]) #@115 Return the master name of a file, nil if it is not registered. For CVS, the full name of CVS/Entries is returned. (defalias 'vc-name #[(file) "À Â\"†à !‰…Å Æ\fA#ˆÅ Â\f@#)‡" [vc-file-getprop file vc-name vc-registered name-and-type vc-file-setprop vc-backend] 5 (#$ . 7905)]) #@73 Return the version-control type of a file, nil if it is not registered. (defalias 'vc-backend #[(file) "…!ÁÂ\"†!Ã!‰… ÅÆ\f@#ˆÅÂ\fA#)‡" [file vc-file-getprop vc-backend vc-registered name-and-type vc-file-setprop vc-name] 5 (#$ . 8191)]) (defalias 'vc-checkout-model #[(file) "À Â\"†Hà !Ä=ƒÅ ÂÆ#‡Ã !Ç=ƒ1È !ˆÀ Â\"†HÉ !ˆÀ Â\"‡Ã !Ê=…HÅ ÂËÌ!ƒFÆ‚GÍ#‡" [vc-file-getprop file vc-checkout-model vc-backend SCCS vc-file-setprop manual RCS vc-consult-rcs-headers vc-fetch-master-properties CVS getenv "CVSREAD" implicit] 5]) (defalias 'vc-cvs-status #[(file) "À Â\"†à !ˆÀ Â\"‡" [vc-file-getprop file vc-cvs-status vc-fetch-master-properties] 3]) (defalias 'vc-master-locks #[(file) "À Â\"†à !ˆÀ Â\"‡" [vc-file-getprop file vc-master-locks vc-fetch-master-properties] 3]) (defalias 'vc-master-locking-user #[(file) "À !‰Å=ƒÅ‚!ÆÇ !\f\"‰ƒ A‚!Å*‡" [vc-master-locks file nil lock master-locks none assoc vc-workfile-version] 4]) (defalias 'vc-lock-from-permissions #[(file) "À !à !?…4ÄÅÆ\n8\"ƒÇ ÈÉ#‚4Ê\n8Ë U…4ÄÌÆ\n8\"…4Ç ÈÍ #)‡" [file-attributes file attributes vc-mistrust-permissions string-match ".r-..-..-." 8 vc-file-setprop vc-locking-user none 2 user-uid ".rw..-..-." user-login-name] 4]) (defalias 'vc-file-owner #[(file) "ÀÁ\n!8‰Ä UƒÅ ‚ )‡" [2 file-attributes file uid user-uid user-login-name] 4]) (defalias 'vc-rcs-lock-from-diff #[(file) "ÀÁ\n!P\fÅ=ƒÆÇÈ\n $‚ÆÉÈ\nÊ %‰ É=ƒ<\f„5ÅÆÇÈ\n $ ‚BÌÍ!ˆ‚B\f„BÎ ÏUƒQÐ\nÑÒ#‚XÐ\nÑÓ\n!#*‡" ["-r" vc-workfile-version file version vc-rcsdiff-knows-brief no vc-simple-command 1 "rcsdiff" 2 "--brief" status error "rcsdiff failed." yes 0 vc-file-setprop vc-locking-user none vc-file-owner] 7]) (defalias 'vc-locking-user #[(file) "À Â\"‰ƒ Ä=?…Ô ‚ÔÅ !Æ=ƒ]Ç !È=ƒ*É !„ÇÀ Ê\"ËÌ !8šƒ?Í ÂÄ#„ÇÎ !Í Â;ƒR‚WÐÑ\"#ˆ)‚ÇÅ !Ò=ƒ±ÓÕ !Ö=„˜É !‰ƒÄ=ƒˆÍ ÇÈ#‚Ç !È=„˜Í Â× !#ˆÀ Â\"Ä=ƒ­Ç !Ø=ƒ­Ù !ˆ)‚ÇÅ !Ú=ƒÇÉ !„ÇÍ Â× !#ˆÀ Â\"‰Ä=?…Ô )‡" [vc-file-getprop file vc-locking-user locking-user none vc-backend CVS vc-checkout-model manual vc-lock-from-permissions vc-checkout-time 5 file-attributes vc-file-setprop vc-file-owner locker format "%d" RCS nil p-lock vc-consult-rcs-headers rev-and-lock vc-master-locking-user implicit vc-rcs-lock-from-diff SCCS] 7]) (defalias 'vc-latest-version #[(file) "À Â\"†à !ˆÀ Â\"‡" [vc-file-getprop file vc-latest-version vc-fetch-properties] 3]) (defalias 'vc-your-latest-version #[(file) "À Â\"†à !ˆÀ Â\"‡" [vc-file-getprop file vc-your-latest-version vc-fetch-properties] 3]) (defalias 'vc-master-workfile-version #[(file) "À Â\"†à !ˆÀ Â\"‡" [vc-file-getprop file vc-master-workfile-version vc-fetch-master-properties] 3]) (defalias 'vc-fetch-properties #[(file) "À !Â=ƒ6ŠÃÄ!qˆÅÆ !Ç\"ˆÈÉÊËÌÍÎ !Ï°ÐÑED Ò#ˆÓÄ!…4ÔÓÄ!!)‡Õ !‡" [vc-backend file RCS get-buffer-create "*vc-info*" vc-insert-file vc-name "^desc" vc-parse-buffer ("^\\([0-9]+\\.[0-9.]+\\)\ndate[ ]+\\([0-9.]+\\);" 1 2) "^\\([0-9]+\\.[0-9.]+\\)\n" "date[ ]+\\([0-9.]+\\);[ ]+" "author[ ]+" regexp-quote user-login-name ";" 1 2 (vc-latest-version vc-your-latest-version) get-buffer kill-buffer vc-fetch-master-properties] 7]) (defalias 'vc-workfile-version #[(file) "À Â\"†[à !Ä=ƒÅ !‡Ã !Æ=ƒ@Ç !ƒ&À Â\"‡È !†3Å !†3É\nË Â\n#ˆ\n)‡Ã !Ì=…[Ç !ƒSÀ Â\"‡ÍΈÀ Â\"‡" [vc-file-getprop file vc-workfile-version vc-backend SCCS vc-latest-version RCS vc-consult-rcs-headers vc-master-workfile-version nil rev vc-file-setprop CVS found (byte-code "ÀÁ\n!Ã\n!\"‡" [vc-find-cvs-master file-name-directory file file-name-nondirectory] 4)] 4]) (defalias 'vc-registered #[(file) "À‰ÃÄ!ƒÅÇ\"\nƒ\nÇ\"‚0È!†$ÉÊ! \fÍÎ**‡" [nil handlers handler boundp file-name-handler-alist find-file-name-handler file vc-registered file-name-directory "" file-name-nondirectory basename dirname found (byte-code "ÀÁ\n\"ˆÃ‡" [mapcar #[(s) ":„\n \n\"‡Ã@ \n#Å\f!…2 Æ\f!˜ƒ+Ç!Ç\f!š?…2ÉÊ\fAB\")‡" [s dirname basename format trial file-exists-p file-name-directory file-attributes file throw found] 4] vc-master-templates nil] 3)] 3]) (defalias 'vc-utc-string #[(timeval) "À @ A@ !@\f Z‰ÇVƒ\" T\fÈZD‚4\fÉWƒ1 S\fÈ\\D‚4 \fDÊ!,‡" [nil timeval current-time-zone offset low high utc 65535 65536 0 current-time-string] 6]) (defalias 'vc-find-cvs-master #[(dirname basename) "…ŒÁ\nÃP!…ŒÄ\nÅP!…ŒÆ‰\nP \n \fÍŽŠÎÏ!q\fÐ\nÅP!ˆebˆÆÑÒÓ!ÔQÆÕ#ƒ…\nÖ ×ØÙ!#ˆÚÛ !8ØÝ!Þ!˜ƒrÖ ß#ˆ‚yÖ ßà#ˆ)áâ\nÅPãB\"‚Š\nÆ.‡" [vc-handle-cvs file-directory-p dirname "CVS/" file-readable-p "CVS/Entries" nil case-fold-search basename file fold time buffer ((kill-buffer buffer)) get-buffer-create "*vc-info*" vc-insert-file re-search-forward "^/" regexp-quote "/\\([^/]*\\)/\\([^/]*\\)/" t vc-file-setprop vc-workfile-version match-string 1 5 file-attributes mtime 2 vc-utc-string vc-checkout-time 0 throw found CVS] 5]) #@70 Return the version-control type of the visited file, or nil if none. (defalias 'vc-buffer-backend #[nil "Á=ƒ Âà !‰‡‡" [vc-buffer-backend t vc-backend buffer-file-name] 2 (#$ . 13026)]) #@275 Change read-only status of current buffer, perhaps via version control. If the buffer is visiting a file registered with version control, then check the file in or out. Otherwise, just change the read-only flag of the buffer. With prefix argument, ask for version number. (defalias 'vc-toggle-read-only #[(&optional verbose) "ÀÁ !ƒ  !‡Ä ‡" [vc-backend buffer-file-name vc-next-action verbose toggle-read-only] 2 (#$ . 13222) "P"]) (define-key global-map "" (quote vc-toggle-read-only)) (defalias 'vc-after-save #[nil "À  Ã\"…F Ä\"ÅÆ !8šƒÇ ÄÈ#ˆÉ !?…FÊ !Ë=…FÇ ÉÌ #…Fà !Í=ƒCÇ ÎÈ#ˆÏ !)‡" [buffer-file-name file vc-file-getprop vc-backend vc-checkout-time 5 file-attributes vc-file-setprop nil vc-locking-user vc-checkout-model implicit user-login-name CVS vc-cvs-status vc-mode-line] 4]) #@217 Set `vc-mode' to display type of version control for FILE. The value is set in the current buffer, which should be the buffer visiting FILE. Second optional arg LABEL is put in place of version control system name. (defalias 'vc-mode-line #[(file &optional label) "À !‰…Ã\f†Å\n!…Ç !Q\nƒ8 É šƒ8Ê !ƒ8Ë Ê !˜„8Ì Î ˆ\n)‡" [vc-backend file vc-type " " label symbol-name vc-display-status vc-status vc-mode buffer-file-name vc-locking-user user-login-name t buffer-read-only force-mode-line-update] 5 (#$ . 14029) (list buffer-file-name nil)]) (defalias 'vc-status #[(file) "À ! ! ŘƒÆ‚:\f„Ç P‚:\f;ƒ(\fÈ ˜‚,\fÉ Uƒ5Ê P‚:Ê\fÊ R*‡" [vc-locking-user file vc-workfile-version rev locker "0" " @@" "-" user-login-name user-uid ":"] 4]) (defalias 'vc-find-file-hook #[nil "…9Á!ˆÂ!ƒ Ã!ˆ\f?…9ÅÆ!ˆÇ‰‡È!‰ …- !‰\n…8ËÌ\n\"*‡" [buffer-file-name vc-file-clearprops vc-backend vc-mode-line vc-make-backup-files make-local-variable backup-inhibited t file-symlink-p link link-type message "Warning: symbolic link to %s-controlled source file"] 4]) (add-hook (quote find-file-hooks) (quote vc-find-file-hook)) #@116 When file is not found, try to check it out from RCS or SCCS. Returns t if checkout was successful, nil otherwise. (defalias 'vc-file-not-found-hook #[nil "À !…ŠÂÃ!ˆÄÁ !ÆÇÈ)?‡" [vc-backend buffer-file-name require vc file-name-directory default-directory nil (byte-code "À !ˆÂ‡" [vc-checkout buffer-file-name nil] 2) ((error t))] 3 (#$ . 15168)]) (add-hook (quote find-file-not-found-hooks) (quote vc-file-not-found-hook)) (defalias 'vc-kill-buffer-hook #[nil "À ;…ÁÀ !ˆÂÃ!‡" [buffer-file-name vc-file-clearprops kill-local-variable vc-buffer-backend] 2]) (byte-code "À Â\"Ä !„\\Å Æ Â #ˆÆ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÌ#ˆÆ ÍÎ#ˆÆ ÏÐ#ˆÆ ÑÒ#ˆÆ ÓÔ#ˆÆ ÕÖ#ˆÆ ×Ø#ˆÆ ÙÚ#ˆÆ ÛÜ#ˆÆ ÝÞ#ˆßà!ƒÆ áâ#ˆÆ ãä#ˆÆ åæ#ˆÆ çè#ˆÆ éê#ˆÆ ëì#ˆÆ íî#ˆÆ ïð#ˆÆ ñò#ˆÆ óô#ˆÆ õö#ˆÆ ÷ø#ˆÆ ùú#ˆÆ ûü#ˆýþÿ@#ˆýÞÿ@#ˆýÜÿ@#ˆýÈÿA#ˆýÒÿ@#ˆýÊÿ@#ˆýØÿ@#ˆýÎÿ@#ˆýÚÿB#ˆýCÿD#ˆýÐÿE#ˆFG!‡" [lookup-key global-map "v" vc-prefix-map keymapp make-sparse-keymap define-key "a" vc-update-change-log "c" vc-cancel-version "d" vc-directory "h" vc-insert-headers "i" vc-register "l" vc-print-log "r" vc-retrieve-snapshot "s" vc-create-snapshot "u" vc-revert-buffer "v" vc-next-action "=" vc-diff "~" vc-version-other-window boundp vc-menu-map [vc-directory] ("Show Locked Files" . vc-directory) [separator1] ("----") [vc-rename-file] ("Rename File" . vc-rename-file) [vc-version-other-window] ("Show Other Version" . vc-version-other-window) [vc-diff] ("Compare with Last Version" . vc-diff) [vc-update-change-log] ("Update ChangeLog" . vc-update-change-log) [vc-print-log] ("Show History" . vc-print-log) [separator2] ("----") [undo] ("Undo Last Check-In" . vc-cancel-version) [vc-revert-buffer] ("Revert to Last Version" . vc-revert-buffer) [vc-insert-header] ("Insert Header" . vc-insert-headers) [vc-menu-check-in] ("Check In" . vc-next-action) [vc-check-out] ("Check Out" . vc-toggle-read-only) [vc-register] ("Register" . vc-register) put vc-rename-file menu-enable vc-mode (eq (vc-buffer-backend) (quote RCS)) (and vc-mode (not buffer-read-only)) vc-toggle-read-only (and vc-mode buffer-read-only) (and buffer-file-name (not vc-mode)) provide vc-hooks] 4) emacs-19.30/lisp/vc.elc100666 74777 1 141140 6051724722 13242 0ustar esrdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 13 15:25:03 1995 ;;; from file /home/fsf/rms/e19/lisp/vc.el ;;; emacs version 19.29.90.5. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`vc.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÀÂ!ˆÃÄ \"„Æ BÀ‡" [require vc-hooks ring assoc vc-parent-buffer minor-mode-alist (vc-parent-buffer vc-parent-buffer-name)] 3) #@152 Execute FORM1, FORM2 or FORM3 for SCCS, RCS or CVS respectively. If FORM3 is `RCS', use FORM2 for CVS as well as RCS. (CVS shares some code with RCS). (defalias 'vc-backend-dispatch '(macro . #[(f s r c) "ÀÁ DDCÄÅÁÆEDÅÁÈE DÅÁÊE Ì=ƒ& ‚( DFE‡" [let type vc-backend f cond eq (quote SCCS) s (quote RCS) r (quote CVS) c RCS] 8 (#$ . 607)])) #@76 *If non-nil, treat user as expert; suppress yes-no prompts on some things. (defvar vc-suppress-confirm nil (#$ . -959)) #@56 *Prompt for initial comment when a file is registered. (defvar vc-initial-comment nil (#$ . -1085)) #@47 *Display run messages from back-end commands. (defvar vc-command-messages nil (#$ . -1191)) #@65 *Extra switches passed to the checkin program by \[vc-checkin]. (defvar vc-checkin-switches nil (#$ . -1289)) #@67 *Extra switches passed to the checkout program by \[vc-checkout]. (defvar vc-checkout-switches nil (#$ . -1405)) #@73 *Directory names ignored by functions that recursively walk file trees. (defvar vc-directory-exclusion-list (quote ("SCCS" "RCS" "CVS")) (#$ . -1524)) #@55 Maximum number of saved comments in the comment ring. (defconst vc-maximum-comment-ring-size 32 (#$ . 1681)) #@75 *A string or list of strings specifying switches to be be passed to diff. (defvar diff-switches "-c" (#$ . -1796)) #@70 *List of functions called after a checkin is done. See `run-hooks'. (defvar vc-checkin-hook nil (#$ . -1917)) #@235 *List of functions called when a buffer is made writable. See `run-hooks.' This hook is only used when the version control system is CVS. It might be useful for sites who uses locking with CVS, or who uses link farms to gold trees. (defvar vc-make-buffer-writable-hook nil (#$ . -2035)) #@71 *Header keywords to be inserted when `vc-insert-headers' is executed. (defvar vc-header-alist (quote ((SCCS "%W%") (RCS "$Id$") (CVS "$Id$"))) (#$ . -2330)) #@186 *Associate static header string templates with file types. A %s in the template is replaced with the first string associated with the file's version-control type in `vc-header-alist'. (defvar vc-static-header-alist (quote (("\\.c$" . "\n#ifndef lint\nstatic char vcid[] = \"%s\";\n#endif /* lint */\n"))) (#$ . -2494)) #@252 *Special comment delimiters to be used in generating vc headers only. Add an entry in this list if you need to override the normal comment-start and comment-end variables. This will only be necessary if the mode language is sensitive to blank lines. (defvar vc-comment-alist (quote ((nroff-mode ".\\\"" ""))) (#$ . -2821)) #@143 *Non-nil means be extra-careful in checkout. Verify that the file really is not locked and that its contents match what the master file says. (defvar vc-checkout-carefully (byte-code "À ÁU‡" [user-uid 0] 2) (#$ . -3152)) #@123 *The release number of your RCS installation, as a string. If nil, VC itself computes this value when it is first needed. (defvar vc-rcs-release nil (#$ . -3380)) #@124 *The release number of your SCCS installation, as a string. If nil, VC itself computes this value when it is first needed. (defvar vc-sccs-release nil (#$ . -3550)) #@124 *The release number of your SCCS installation, as a string. If nil, VC itself computes this value when it is first needed. (defvar vc-cvs-release nil (#$ . -3722)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÇÆ BÀÈ!„:ÂÈ BÀÉ!„GÂ É BÊ BË BÌ Í BÀÎ!„cÂÎ BÏÎ!ˆÀÐ!„tÂÐ BÀÑ!„ÂÑ BÀÒ!„ŽÂÒ B‡" [boundp vc-log-entry-mode nil current-load-list vc-log-operation vc-log-after-operation-hook vc-checkout-writable-buffer-hook vc-checkout-writable-buffer vc-parent-buffer vc-parent-buffer-name vc-log-file vc-log-version "VC-names" vc-name-assoc-file vc-dired-mode make-variable-buffer-local vc-comment-ring vc-comment-ring-index vc-last-comment-match] 2) (defalias 'file-executable-p-18 #[(f) "À !‰… Ã)‡" [file-modes f modes t] 3]) (defalias 'file-regular-p-18 #[(f) "À !‰… \n@?)‡" [file-attributes f attributes] 3]) (byte-code "ÀÁ!„ÂÄÅMˆÆÇMˆÈÉ!„ÉÊMˆÂ‡" [boundp minor-mode-map-alist nil compilation-old-error-list file-executable-p file-executable-p-18 shrink-window-if-larger-than-buffer beginning-of-buffer fboundp file-regular-p file-regular-p-18] 2) (defalias 'vc-backend-release #[(backend) "Á=ƒ,\n†cÃÄÅÆĉÇ&ÈUƒ(ŠÉÊ!qˆËÌ!@‰)†c͉‡Î=ƒ[†cÃÄÐÑĉÒ&ÈUƒVŠÉÊ!qˆËÓ!@‰)†c͉‡Ô=…c‡" [backend RCS vc-rcs-release vc-do-command nil 2 "rcs" "-V" 0 get-buffer "*vc*" vc-parse-buffer (("^RCS version \\([0-9.]+ *.*\\)" 1)) unknown CVS vc-cvs-release 1 "cvs" "-v" (("^Concurrent Versions System (CVS) \\([0-9.]+\\)" 1)) SCCS vc-sccs-release] 7]) (defalias 'vc-release-greater-or-equal #[(r1 r2) "À‰‰‰ÅÆ,‡" [nil i2 i1 v2 v1 done (byte-code "ÀÁ\n\"ƒlÕ‰ƒlÅÆÇ\n\"!‰ƒlÀÁ \"ƒlÕ‰\nƒlÅÆÇ \"!‰ ƒl VƒFÌÍÎ\"‚d WƒUÌÍÏ\"‚dÌÍÐ\n\fÏO \nÏO\"\"ƒlÌÍÎ\"ˆÀÁ \"ƒ{ÌÍÏ\"†ÌÍÎ\"‡" [string-match "^\\.?\\([0-9]+\\)" r1 0 i1 string-to-number match-string 1 v1 r2 i2 v2 throw done t nil vc-release-greater-or-equal] 7)] 4]) (defalias 'vc-backend-release-p #[(backend release) "À‰Á‰À‰Â ! \n\fË=?…- Ì=„( Í=…-Î\f\".‡" [nil 0 vc-backend-release backend installation rs is ii ri r i unknown RCS CVS vc-release-greater-or-equal release] 8]) (defalias 'vc-trunk-p #[(rev) "ÀÁ\n\"Ã=?‡" [string-match "\\`[0-9]+\\.[0-9]+\\'" rev nil] 3]) (defalias 'vc-branch-part #[(rev) "ÁÂÃ\"O‡" [rev 0 string-match "\\.[0-9]+\\'"] 5]) #@56 Clear all cached file properties and the comment ring. (defalias 'vc-clear-context #[nil "À Â\"ˆÂ‰‡" [fillarray vc-file-prop-obarray nil vc-comment-ring] 3 (#$ . 6013) nil]) (defalias 'vc-file-clear-masterprops #[(file) "À ÂÃ#ˆÀ ÄÃ#ˆÅ !‰Ç=ƒÀ ÈÃ#‚LÉ=ƒ@À ÊÃ#ˆÀ ËÃ#ˆÀ ÌÃ#ˆÀ ÈÃ#‚LÍ=…LÀ ÎÃ#)‡" [vc-file-setprop file vc-latest-version nil vc-your-latest-version vc-backend type SCCS vc-master-locks RCS vc-default-branch vc-head-version vc-master-workfile-version CVS vc-cvs-status] 5]) (defalias 'vc-head-version #[(file) "À Â\"†à !ˆÀ Â\"‡" [vc-file-getprop file vc-head-version vc-fetch-master-properties] 3]) (defalias 'vc-latest-on-branch-p #[(file) "À !‰Ã=ƒÄ !Å !˜‚s\nÆ=ƒlÄ !Ç Ê !ƒ7Ë !ˆÌ Í\" ˜‚hŠÎÏ!qˆÐÑ !Ò\"ˆÓÔÕÖ !!×QØÙEC!@ÚÏ!ƒbÛÚÏ!!ˆ ˜)*‚s\nÜ=…sÝ)‡" [vc-backend file type SCCS vc-workfile-version vc-latest-version RCS nil tip-version workfile-version vc-trunk-p vc-fetch-master-properties vc-file-getprop vc-head-version get-buffer-create "*vc-info*" vc-insert-file vc-name "^desc" vc-parse-buffer "^\\(" regexp-quote vc-branch-part "\\.[0-9]+\\)\ndate[ ]+\\([0-9.]+\\);" 1 2 get-buffer kill-buffer CVS t] 6]) (defalias 'vc-registration-error #[(file) "ƒ ÁÂ\"‡ÁÃÄ \"‡" [file error "File %s is not under version control" "Buffer %s is not associated with a file" buffer-name] 3]) (byte-code "ÀÁ!„ÂÁ B‡" [boundp vc-binary-assoc nil current-load-list] 2) #@68 Look for a command anywhere on the subprocess-command search path. (defalias 'vc-find-binary #[(name) "À \n\"A† Ãć" [assoc name vc-binary-assoc found (byte-code "ÀÁ\n\"ˆÃ‡" [mapcar #[(s) "…Á\nQÄ !…\n B BÆÇ \")‡" [s "/" name full file-executable-p vc-binary-assoc throw found] 3] exec-path nil] 3)] 3 (#$ . 7418)]) #@388 Execute a version-control command, notifying user and checking for errors. Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil. The command is successful if its exit status does not exceed OKSTATUS. The last argument of the command is the master name of FILE if LAST is `MASTER', or the workfile of FILE if LAST is `WORKFILE'; this is appended to an optional list of FLAGS. (defalias 'vc-do-command #[(buffer okstatus command file last &rest flags) "ƒÁ!\n„Ã\fƒÅÆ#ˆppÈ…#É!\nÈ \f Ñ\n!qˆÒÓ!LˆÒÔ!ÕÖ!PLˆ\f\n× ˆØÙ\"ˆ ƒkÜ=ƒkÝ C\"Þ=ƒ–Á\n!‰G á O˜ƒ ÈO*ÝC\"Ý\"#\"äåæ!'èé\"'#R*B*#ëìÈíÈ& *dbˆîÈ!ˆïyˆ ¨ƒ×0 Wƒúñ\n!ˆebˆò ˆóô ¨ƒóõö \"‚õ #ˆ‚\fƒÅ÷\"ˆqˆ .‡" [file expand-file-name buffer "*vc*" vc-command-messages message "Running %s on %s..." command nil vc-name default-directory status olddir vc-file squeezed camefrom obuf get-buffer-create make-local-variable vc-parent-buffer vc-parent-buffer-name " from " buffer-name erase-buffer mapcar #[(s) "… Á\nC\"‰‡" [s append squeezed] 3] flags last MASTER append WORKFILE pwd preflen 0 vc-path exec-path "PATH=" getenv "PATH" path-separator mapconcat identity process-environment apply call-process t set-buffer-modified-p -1 okstatus pop-to-buffer shrink-window-if-larger-than-buffer error "Running %s...FAILED (%s)" format "status %d" "Running %s...OK"] 9 (#$ . 7750)]) (defalias 'vc-position-context #[(posn) "Á dÂ\\^{E‡" [posn buffer-size 100] 6]) (defalias 'vc-find-position-by-context #[(context) "À 8‰Úƒd‚@Š A@Ä Z‰ÆWƒ [ @bˆÇ\nÈÉ#„;` Z\nGZbˆÇ\nÈÉ#…?`\nGZ*)‡" [2 context context-string "" buffer-size diff 0 search-forward nil t] 5]) (defalias 'vc-buffer-context #[nil "À`!Á !p=…À !ÃÄÅ!…!pŠÇÈÉ \"*\n \f‰ \f\nE,‡" [vc-position-context marker-buffer mark-marker nil boundp compilation-error-list curbuf mapcar #[(buffer) "qˆ †\nÉ:ƒ/\f„/Æ @A!ƒ(Ç @A!=ƒ(È A‰‚\f\f…4*‡" [buffer compilation-old-error-list compilation-error-list nil buffer-error-marked-p errors markerp marker-buffer t] 4] buffer-list reparse mark-active mark-context point-context] 7]) (defalias 'vc-restore-buffer-context #[(context) "@A@Á8\nƒJ\n@ƒCŠ\n@qˆpÅ¢@!ÉÊ \"ˆƒB@@U„BA‰„/+\nA‰„Ì\f!‰ ƒW bˆ) …jÌ !‰…iÏ!)+‡" [context 2 reparse mark-context point-context marker-position compilation-error-list error-pos compilation-last-buffer compile-reinitialize-errors (4) compilation-parsing-end vc-find-position-by-context new-point new-mark set-mark] 5]) (defalias 'vc-revert-buffer1 #[(&optional arg no-confirm) "~ˆÀ  \f\"ˆÅ !)‡" [vc-buffer-context context revert-buffer arg no-confirm vc-restore-buffer-context] 3 nil "P"]) (defalias 'vc-buffer-sync #[(&optional not-urgent) "À … „ÂÃÄÅ \"!ƒÆ ‡?…ÈÉ!‡" [buffer-modified-p vc-suppress-confirm y-or-n-p format "Buffer %s modified; save it? " buffer-name save-buffer not-urgent error "Aborted"] 4]) (defalias 'vc-workfile-unchanged-p #[(file &optional want-differences-if-changed) "À Â\"ÃÄ !8‰ š†:ƒ…:È É‰?$ÊU Ì Â ƒ4 ‚5Ê#ˆ )*‡" [vc-file-getprop file vc-checkout-time 5 file-attributes lastmod checkout-time want-differences-if-changed vc-backend-diff nil 0 unchanged vc-file-setprop] 6]) (defalias 'vc-next-action-on-file #[(file verbose &optional comment) "À ! !ɉ‰„.É\n \"ˆ\fƒ(͉‚ÚÏ !‚ÚÐ=ƒ¶Ñ !Ò=„EÑ !Ó=ƒ¶„TÕÖ×Ø \"!ƒ®ƒtÙ !‰ƒzÚ\f!ƒzÛ\f!ƒzÜÝ!ˆ‚zpÜÝ!ˆ\fƒ“Ú\f!ƒ“ÕÖÞØ\f!\"!„“ßà!ˆá !âU„Ÿãä!ˆ\f…Úå ÝÚ\f!?#‚ÚßæØ \"‚Úç !‰„B(ƒñé Ý\"„ñꋃÚë !ˆì !‚ÚÕí!„æßî!‚Úï݉\"ˆÏ !‚Ú\nƒ ð=„ñ Ãòó!#‚Úßô!‚Úõ !ƒÏ !‚ÚÕö!ƒ%Ï !‚ÚÕ÷!…ÚÏ øù !!ƒ9ú‚>ûù !!\"‚ÚÐ=„ü ˜„ ƒ[ßý \"ˆþ=ƒsÿþ@\"„sßA\"ˆB \nƒ„òC!‚‡ù !#‚Úƒ›D !ˆ‚¡E !ˆÜ ˆé !ƒÇÚ „ÇÕF!…ÚG !ˆH ݉#‚Ú\nƒÒòI!J  #-‡" [vc-name file vc-backend nil buffer version owner vc-type vc-file vc-register verbose comment vc-initial-comment vc-checkout-writable-buffer-hook vc-log-after-operation-hook vc-checkout-writable-buffer CVS vc-cvs-status needs-checkout needs-merge vc-dired-mode yes-or-no-p format "%s is not up-to-date. Merge in changes now? " buffer-name get-file-buffer buffer-modified-p switch-to-buffer-other-window vc-buffer-sync t "Buffer %s modified; merge file on disc anyhow? " error "Merge aborted" vc-backend-merge-news 0 message "Conflicts detected!" vc-resynch-buffer "%s needs update" vc-locking-user vc-checkout-carefully vc-workfile-unchanged-p ((byte-code "ÀÁ!ˆebˆÂÃÄ \"!ˆÆ ˆÇÈÉP!‡" [pop-to-buffer "*vc-diff*" insert-string format "Changes to %s since last lock:\n\n" file beep yes-or-no-p "File has unlocked changes, " "claim lock retaining changes? "] 4)) vc-backend-steal vc-mode-line "Revert to checked-in version, instead? " "Checkout aborted." vc-revert-buffer1 SCCS vc-checkout read-string "Branch or version to move to: " "Sorry, this is not implemented for SCCS." vc-latest-on-branch-p "This is not the latest version. Really lock it? " "Lock the latest version instead? " vc-trunk-p vc-workfile-version "" vc-branch-part user-login-name "Sorry, you can't steal the lock on %s this way" RCS vc-backend-release-p "5.6.2" "File is locked by %s." vc-steal-lock "Version to steal: " find-file-other-window find-file "Revert to master version? " vc-backend-revert vc-resynch-window "New version level: " vc-checkin] 6]) (defalias 'vc-next-action-dired #[(file rev comment) "À p ʼn‰‰ Ê Å \fŠebˆÍ\fÅÎ#…)Ï ‰ ?? ƒŽ bˆÐÑ!ˆÒ ÅÕÖ\"ˆ×!ØÅ#ˆ qˆ\nÚ!ˆÛ\f!ˆÕÜ\"*B bˆÝyˆ ʼn“ˆÍ\fÅÎ#…ˆÏ ‰ „5)ƒ™‚ÈÒ ÅÕÖ\"ˆ×!ØÅ#ˆ qˆ\nÚ!ˆÛ\f!ˆÕÜ\"*C.Þ ˆ+‡" [current-window-configuration default-directory dired-dir dired-buffer configuration nil results found case-fold-search buffer-read-only dired-marker-regexp next-position regexp re-search-forward t point-marker sit-for 0 dired-get-filename p file message "Processing %s..." file-name-directory vc-next-action-on-file comment vc-dired-update-line set-window-configuration "Processing %s...done" 1 dired-move-to-filename] 5]) #@2026 Do the next logical checkin or checkout operation on the current file. If you call this from within a VC dired buffer with no files marked, it will operate on the file in the current line. If you call this from within a VC dired buffer, and one or more files are marked, it will accept a log message and then operate on each one. The log message will be used as a comment for any register or checkin operations, but ignored when doing checkouts. Attempted lock steals will raise an error. A prefix argument lets you specify the version number to use. For RCS and SCCS files: If the file is not already registered, this registers it for version control and then retrieves a writable, locked copy for editing. If the file is registered and not locked by anyone, this checks out a writable and locked file ready for editing. If the file is checked out and locked by the calling user, this first checks to see if the file has changed since checkout. If not, it performs a revert. If the file has been changed, this pops up a buffer for entry of a log message; when the message has been entered, it checks in the resulting changes along with the log message as change commentary. If the variable `vc-keep-workfiles' is non-nil (which is its default), a read-only copy of the changed file is left in place afterwards. If the file is registered and locked by someone else, you are given the option to steal the lock. For CVS files: If the file is not already registered, this registers it for version control. This does a "cvs add", but no "cvs commit". If the file is added but not committed, it is committed. If your working file is changed, but the repository file is unchanged, this pops up a buffer for entry of a log message; when the message has been entered, it checks in the resulting changes along with the logmessage as change commentary. A writable file is retained. If the repository file is changed, you are asked if you want to merge in the changes into your working copy. (defalias 'vc-next-action #[(verbose) "ÀÁ‡" [nogo (byte-code "ƒ(Á ÃÄ\nÅ#ŘƒÆljÈ#ˆ‚\"Élj‰ÊÆ%ˆËÌÇ\"ˆ) ƒ5Î !ˆ‚(ƒAÐ\"‡ÒÇ!‡" [vc-dired-mode dired-get-marked-files files mapconcat #[(f) "À !Â=ƒà !Ä=„à !Å=ƒÆ‡Ç‡È !ƒ$ƇLJ" [vc-backend f CVS vc-cvs-status locally-modified locally-added "@" "" vc-locking-user] 2] "" vc-next-action-dired nil "dummy" vc-start-entry "Enter a change comment for the marked files." throw nogo vc-parent-buffer pop-to-buffer buffer-file-name vc-next-action-on-file verbose vc-registration-error] 6)] 2 (#$ . 13807) "P"]) #@78 Retrieve a writable copy of the latest version of the current buffer's file. (defalias 'vc-checkout-writable-buffer #[(&optional file rev) "À † Ã\f#‡" [vc-checkout file buffer-file-name t rev] 4 (#$ . 16403)]) #@61 Register the current file into your version-control system. (defalias 'vc-register #[(&optional override comment) "„ÁÂ!ˆÃ!‰ƒÅ\f!ƒÁÆ!ˆ\fƒ(ÇÈ!„(ÁÆ!ˆ)É „?Ê ËUƒ?Å!„?ÌÍ!ˆÎ ˆ„NÐÑ!ˆÍÒ…[ÔÕÖ\"!\"‡" [buffer-file-name error "No visited file" vc-name master file-exists-p "This file is already registered" y-or-n-p "Previous master file has vanished. Make a new one? " buffer-modified-p buffer-size 0 set-buffer-modified-p t vc-buffer-sync vc-make-backup-files make-local-variable backup-inhibited vc-admin override read-string format "Initial version level for %s: "] 7 (#$ . 16622) "P"]) (defalias 'vc-resynch-window #[(file &optional keep noquery) " ˜…!\nƒÃÄÅ\"ˆÆÇ\"ˆÉÄÅ\"ˆÊ!‡Ëp!‡" [buffer-file-name file keep remove-hook find-file-hooks vc-find-file-hook vc-revert-buffer1 t noquery add-hook vc-mode-line kill-buffer] 3]) (defalias 'vc-resynch-buffer #[(file &optional keep noquery) "À !‰…Š\nqˆÃ \f #))‡" [get-file-buffer file buffer vc-resynch-window keep noquery] 5]) (defalias 'vc-start-entry #[(file rev comment msg action &optional after-hook) "ƒ\nÁ!‚ p ƒÄÅ!qˆ‚ÆÄÅ!!ˆÇÈ!\nLˆÇÉ!ÊË!PLˆƒ7Ì!ˆÍ ˆÇÎ!ˆƒG ƒnÕ ˆ Ö=ƒe×Ö!‚s cˆ×Ø!‚sÙÚ\")‡" [file find-file-noselect parent comment get-buffer-create "*VC-log*" pop-to-buffer make-local-variable vc-parent-buffer vc-parent-buffer-name " from " buffer-name vc-mode-line vc-log-mode vc-log-after-operation-hook after-hook action vc-log-operation vc-log-file rev vc-log-version erase-buffer t vc-finish-logentry nil message "%s Type C-c C-c when done." msg] 4]) #@197 Check a file into your version-control system. FILE is the unmodified name of the file. REV should be the base version level to check it in under. COMMENT, if specified, is the checkin comment. (defalias 'vc-admin #[(file rev &optional comment) "À \n † \f?ÅÆÇ&‡" [vc-start-entry file rev comment vc-initial-comment "Enter initial comment." vc-backend-admin nil] 7 (#$ . 18196)]) #@58 Retrieve a copy of the latest version of the given file. (defalias 'vc-checkout #[(file &optional writable rev) "ÀÁ\n\"ƒÃÄ!ƒÅÆ!ˆÇ\n #ˆÊ\nˉ#‡" [string-match "^/[^/:]+:" file vc-find-binary "ftp" error "Sorry, you can't check out files over FTP" vc-backend-checkout writable rev vc-resynch-buffer t] 4 (#$ . 18585)]) #@41 Steal the lock on the current workfile. (defalias 'vc-steal-lock #[(file rev &optional owner) "À\n„\nÃ\f! ƒÆÇ\f #‚\fÈÆÉ \n#!„'ÊË!ˆÌÍÎ!!ˆÏÐ!Ò!ˆÔ ˆÕ ˆÖ\nÆ× \"À‰‰Ø\f EC&ˆdbˆÆÙ \"Ú Û±ˆÜÝ!)‡" [nil file-description owner vc-locking-user file rev format "%s:%s" y-or-n-p "Take the lock on %s from %s? " error "Steal cancelled" pop-to-buffer get-buffer-create "*VC-mail*" expand-file-name "~/" default-directory auto-save-mode auto-save-default mail-mode erase-buffer mail-setup "Stolen lock on %s" vc-finish-steal "I stole the lock on %s, " current-time-string ".\n" message "Please explain why you stole the lock. Type C-c C-c when done."] 9 (#$ . 18914)]) (defalias 'vc-finish-steal #[(file version) "À \n\"ˆÃ !…ŠÃ !qˆÄ ʼn#)‡" [vc-backend-steal file version get-file-buffer vc-resynch-window t] 4]) #@415 Check in the file specified by FILE. The optional argument REV may be a string specifying the new version level (if nil increment the current level). The file is either retained with write permissions zeroed, or deleted (according to the value of `vc-keep-workfiles'). If the back-end is CVS, a writable workfile is always kept. COMMENT is a comment string; if omitted, a buffer is popped up to accept a comment. (defalias 'vc-checkin #[(file &optional rev comment) "À \n ÄÅÆ&‡" [vc-start-entry file rev comment "Enter a change comment." vc-backend-checkin vc-checkin-hook] 7 (#$ . 19734)]) #@230 Enter last VC comment into change log file for current buffer's file. Optional arg (interactive prefix) non-nil means prompt for user name and site. Second arg is file name of change log. If nil, uses `change-log-default-name'. (defalias 'vc-comment-to-change-log #[(&optional whoami file-name) "ÀÁ!ˆÂ Ä\"ÅÆ Ê \f͉$ˆŠ cˆÎ )ÏÐ!ƒ-ÑÒ!ˆÓ ˆÔ Š`WƒFÖyˆjˆ‚5`*ØPØPÄyˆÚ`\"ˆ*ÛÜ\"ˆÑÝÜ![!ˆm†yÏÞ!†yßc+‡" [require add-log ring-ref vc-comment-ring 0 ignore nil end add-log-current-defun-function comment add-change-log-entry whoami file-name t point-marker looking-at "\\s *\\s(" delete-char -2 just-one-space current-indentation indentation 1 paragraph-separate "\\|\\s *\\s(" paragraph-start fill-region skip-syntax-forward " " skip-syntax-backward "\n\n" "\n"] 5 (#$ . 20334) (byte-code "…Á D‡" [current-prefix-arg prompt-for-change-log-name] 2)]) #@58 Complete the operation implied by the current log entry. (defalias 'vc-finish-logentry #[(&optional nocomment) "„!dbˆn„Á ˆÂ !ˆ\f„Å!Ç\fÈ \"ˆŠ qˆ\n„.Ë ˆ)\f„8ÍÎ!ˆ\f È Ö !ˆ×Ø!Ú!ˆÛ!ˆ)Š#ˆ)ƒyÝß#ˆà!-‡" [nocomment newline vc-backend-logentry-check vc-log-file vc-comment-ring make-ring vc-maximum-comment-ring-size ring-insert buffer-string vc-parent-buffer vc-dired-mode vc-buffer-sync vc-log-operation error "No log operation is pending" vc-log-version vc-log-after-operation-hook after-hook log-entry log-version log-file log-operation pop-to-buffer get-buffer "*VC-log*" logbuf delete-windows-on kill-buffer buffer-file-name vc-resynch-window vc-keep-workfiles t run-hooks] 5 (#$ . 21215) nil]) #@42 Cycle backwards through comment history. (defalias 'vc-previous-comment #[(arg) "À !‰ÃXƒÄÅ!ˆÆ ‚KÇ ˆ„4 ÃVƒ&Ê‚2 ÃWƒ1Ë‚2ÃÌ \\\n\"ÄÍT\"ˆÎ \"c)‡" [ring-length vc-comment-ring len 0 message "Empty comment ring" ding erase-buffer vc-comment-ring-index arg -1 1 mod "%d" ring-ref] 4 (#$ . 21964) "*p"]) #@41 Cycle forwards through comment history. (defalias 'vc-next-comment #[(arg) "À [!‡" [vc-previous-comment arg] 2 (#$ . 22289) "*p"]) #@65 Searches backwards through comment history for substring match. (defalias 'vc-comment-search-reverse #[(str) "Á˜ƒ \n‚  „ÄÅ!Æ! T  Wƒ?ÊË\"\"„?Ì\\‰‚# WƒPÍ Z!‚SÎÏ!+‡" [str "" vc-last-comment-match vc-comment-ring-index -1 regexp-quote ring-length vc-comment-ring n len string-match ring-ref 1 vc-previous-comment error "Not found"] 6 (#$ . 22426) "sComment substring: "]) #@64 Searches forwards through comment history for substring match. (defalias 'vc-comment-search-forward #[(str) "Á˜ƒ \n‚  „ÄÅ!Æ!  ÄYƒ=ÊË\"\"„=ÌZ‰‚\"ÄYƒMÍ Z!‚PÎÏ!+‡" [str "" vc-last-comment-match vc-comment-ring-index 0 regexp-quote ring-length vc-comment-ring n len string-match ring-ref 1 vc-next-comment error "Not found"] 6 (#$ . 22838) "sComment substring: "]) #@289 Display diffs between file versions. Normally this compares the current file and buffer with the most recent checked in version of that file. This uses no arguments. With a prefix argument, it reads the file name to use and two version designators specifying which versions to compare. (defalias 'vc-diff #[(historic &optional not-urgent) "ƒ\nÁ !qˆ ƒÄ !ˆ‚\n ƒÆÇ!‡ƒ)É!„-ÊË!ˆÌ ‰ƒ?É!„DÏ!ˆÐ!ˆÒ!‰ ƒ\\ÓÔ\"ˆ‚„Õ!ˆÄÖ!ˆ×!Ù ÚUƒ~Û ÓÔ\"ˆ‚„ebˆÜ ˆ *?‡" [vc-dired-mode find-file-noselect dired-get-filename vc-parent-buffer pop-to-buffer historic call-interactively vc-version-diff buffer-file-name vc-name error "There is no version-control master associated with this buffer" nil unchanged file vc-registration-error vc-buffer-sync not-urgent vc-workfile-unchanged-p message "No changes to %s since latest version." vc-backend-diff "*vc-diff*" file-name-directory default-directory buffer-size 0 t shrink-window-if-larger-than-buffer] 4 (#$ . 23242) "P"]) #@170 For FILE, report diffs between two stored versions REL1 and REL2 of it. If FILE is a directory, generate diffs between versions for all registered files in or below it. (defalias 'vc-version-diff #[(file rel1 rel2) "Á˜ƒÂ Á˜ƒÂÄ !ƒapÇÈ!qˆÉÊ!LˆÉË!ÌÍ!PLˆÎ ˆÏ†9ÐÑ †?ÒÓ±ˆÇÔ!qˆÕ !ˆÖØ\"ˆÙÈ!ˆÚcˆebˆÛÂ!)‡Ü  #ÝUƒrÞß  $‡ÙÔ!‡" [rel1 "" nil rel2 file-directory-p file camefrom get-buffer-create "*vc-status*" make-local-variable vc-parent-buffer vc-parent-buffer-name " from " buffer-name erase-buffer "Diffs between " "last version checked in" " and " "current workfile(s)" ":\n\n" "*vc-diff*" cd vc-file-tree-walk default-directory #[(f) "ÀÁ\n\"ˆÃ\n!?…!Ä\n!…!Å\n#…!ÈÉed#‡" [message "Looking at %s" f file-directory-p vc-registered vc-backend-diff rel1 rel2 append-to-buffer "*vc-status*"] 4] pop-to-buffer "\nEnd of diffs.\n" set-buffer-modified-p vc-backend-diff 0 message "No changes to %s between %s and %s."] 5 (#$ . 24239) "FFile or directory to diff: \nsOlder version: \nsNewer version: "]) #@197 Visit version REV of the current buffer in another window. If the current buffer is named `F', the version is named `F.~REV~'. If `F.~REV~' already exists, it is used instead of being re-created. (defalias 'vc-version-other-window #[(rev) "ƒ\nÁ !qˆ ƒÄ !ˆ‚\n ƒNÆ !ƒNȘƒ,É !‚.\n Ë\nÌR Î !„HÏ Ð\n $ˆÑ !*‡Ò !‡" [vc-dired-mode find-file-noselect dired-get-filename vc-parent-buffer pop-to-buffer buffer-file-name vc-name rev "" vc-latest-version version ".~" "~" filename file-exists-p vc-backend-checkout nil find-file-other-window vc-registration-error] 5 (#$ . 25261) "sVersion to visit (default is latest version): "]) #@177 Insert headers in a file for use with your version-control system. Headers desired are inserted at the start of the buffer, and are pulled from the variable `vc-header-alist'. (defalias 'vc-insert-headers #[nil "ƒ Á !ˆ ƒÄ !ˆ‚ ŠŒ~ˆÅ ƒ#ÆÇ!…c žA‰\n@†6 †6Ì \nA@†E†EÏÑÒÓ !\"AÖ×\"ˆ…bÖÙ\",*‡" [vc-dired-mode find-file-other-window dired-get-filename vc-parent-buffer pop-to-buffer vc-check-headers y-or-n-p "Version headers already exist. Insert another set? " major-mode vc-comment-alist delims comment-start "#" comment-start-vc comment-end "" comment-end-vc assoc vc-backend buffer-file-name vc-header-alist hdstrings mapcar #[(s) "Á\nÁ ı‡" [comment-start-vc " " s comment-end-vc "\n"] 6] vc-static-header-alist #[(f) "À @\n\"…à A\f@\"c‡" [string-match f buffer-file-name format hdstrings] 3]] 4 (#$ . 25908) nil]) (defalias 'vc-clear-headers #[nil "À ebˆÂÃÄÅ#ƒÆÇ!ˆ‚È !)‡" [vc-buffer-context context re-search-forward "\\$\\([A-Za-z]+\\): [^\\$]+\\$" nil t replace-match "$\\1$" vc-restore-buffer-context] 4]) (derived-mode-init-mode-variables (quote vc-dired-mode)) #@348 The major mode used in VC directory buffers. It is derived from Dired. All Dired commands operate normally. Users currently locking listed files are listed in place of the file's owner and group. Keystrokes bound to VC commands will execute as though they had been called on a buffer attached to the file named in the current Dired buffer line. (defalias 'vc-dired-mode #[nil "À ˆÀÁNƒÂÃÁÄ#ˆÃÆÈÃ!ˆÉÃ!ˆÊÃ!ˆÄËÃ!‡" [dired-mode special put vc-dired-mode t major-mode "Dired under VC" mode-name derived-mode-set-keymap derived-mode-set-syntax-table derived-mode-set-abbrev-table derived-mode-run-hooks] 4 (#$ . 27023) nil]) (byte-code "À  #ˆÀ ÄÅ#ˆÀ ÆÇ#‡" [define-key vc-dired-mode-map "v" vc-prefix-map "g" vc-dired-update "=" vc-diff] 4) (defalias 'vc-dired-state-info #[(file) "À !Â=… à !‰ƒL\fÅ=ƒÆ‚O\fÇ=ƒ$È‚O\fÉ=ƒ.Ê‚O\fË=ƒ8Ì‚O\fÍ=ƒB΂O\fÏ=…OЂOÑ !)‡" [vc-backend file CVS vc-cvs-status cvs-state up-to-date nil needs-checkout "patch" locally-modified "modified" needs-merge "merge" unresolved-conflict "conflict" locally-added "added" vc-locking-user] 3]) (defalias 'vc-dired-reformat-line #[(x) "`À‰‰‰Àˆ` bˆÆÇ\fÈ#„\"ÆÉ\fÈ#ƒ1ÊË!ÊÌ!ÊÍ!‚AÆÎ\fÈ#ƒAÊË!ÊÌ!§ƒQ\n†OÐ!ƒ]ÑÒQÓPÔÕO×  Q!.‡" [nil date-and-file owner perm limit pos re-search-forward "\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[^ ]+ +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" t "\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" match-string 1 2 3 "\\([drwxlts-]+ \\) *[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" x number-to-string "(" ")" " " 0 10 rep replace-match] 5]) (defalias 'vc-dired-update-line #[(file) "ÀyˆÁuˆ`ÃyˆÀyˆ\n`|ˆÄ \"ˆÇyˆÈˆÉ G[!ˆ Ê !GÈOcˆ\nbˆ)ÌÍ !!‡" [0 2 start 1 insert-directory file dired-listing-switches -1 nil delete-char expand-file-name default-directory vc-dired-reformat-line vc-dired-state-info] 3]) (defalias 'vc-dired-update #[(verbose) "À \n\"‡" [vc-directory default-directory verbose] 3 nil "P"]) #@213 Show version-control status of the current directory and subdirectories. Normally it creates a Dired buffer that lists only the locked files in all these directories. With a prefix argument, it lists all files. (defalias 'vc-directory #[(dirname verbose) "ÀÁ!ˆÂ !‰‰GSœÄ=„ ÅPÆ GƉƉ \n \f Ï Ð\"ˆÑ‹ˆÒ !ˆÆebˆÔyˆ`ƈ`|ˆ)Öyˆƒj×Ø Ÿ\"ˆÙebˆÚÛ!‚‚ÚÔ!ˆÜcˆÙÝÞƒà‚€á #.‡" [require dired expand-file-name dirname 47 "/" nil default-directory dired-buf-mod-count dired-buf old-dir statelist filelist dl nonempty vc-file-tree-walk #[(f) "À !…' !\f„ …& ÆOB‰…& B‰)‡" [vc-registered f vc-dired-state-info state verbose dl nil filelist statelist] 3] ((byte-code "ŠÀ \nŸB Ä#\nGÆ=?)À‡" [dired-internal-noselect dirname filelist dired-listing-switches vc-dired-mode dired-buf 0 nonempty] 4)) switch-to-buffer buffer-read-only 1 start 0 mapcar #[(x) "ÀuˆÁ\n!ˆÃy‡" [2 vc-dired-reformat-line x 1] 2] t dired-next-line 2 " " message "No files are currently %s under %s" verbose "registered" "locked"] 8 (#$ . 29011) "DDired under VC (directory): \nP"]) #@71 Show version-control status of all files under the current directory. (defalias 'vc-directory-18 #[(verbose) "À ŠÄÅ!qˆÆ ˆÇ\n!ˆÈ É\"ˆÊ ËU?) ƒ,ÌÅÍ\"ˆebˆÎ ˆÏЃ7Ò‚8Ó #*‡" [nil default-directory dir nonempty get-buffer-create "*vc-status*" erase-buffer cd vc-file-tree-walk #[(f) "À !… !‰„\f…ÅÆ ° #c)‡" [vc-registered f vc-locking-user user verbose format "%s %s\n"] 5] buffer-size 0 pop-to-buffer t shrink-window-if-larger-than-buffer message "No files are currently %s under %s" verbose "registered" "locked"] 4 (#$ . 30100) "P"]) (byte-code "ÀÁ!„\nÂÃMˆÀ‡" [boundp minor-mode-map-alist vc-directory vc-directory-18] 2) (defalias 'vc-add-triple #[(name file rev) "ŠÀÁ\nÃÁÄ !Æ !\"!\"!ˆdbˆÈ É\n˱ˆÌ ˆÍp!)‡" [find-file expand-file-name vc-name-assoc-file file-name-as-directory vc-backend-subdirectory-name file file-name-directory name " : " " " rev "\n" basic-save-buffer kill-buffer] 8]) (defalias 'vc-record-rename #[(file newname) "ŠÀÁ\nÃÁÄ !Æ !\"!\"!ˆebˆÇÈÉ !ÊQËÌ#ƒ-ÍÈPˉ#ˆ‚Ï ˆÐp!)‡" [find-file expand-file-name vc-name-assoc-file file-name-as-directory vc-backend-subdirectory-name file file-name-directory re-search-forward ":" regexp-quote "$" nil t replace-match newname basic-save-buffer kill-buffer] 8]) (defalias 'vc-lookup-triple #[(file name) "„‡ÁH‰ÃY…\nÄX)ƒ‡ŠÅÆ!qˆÇÈ ÊÈË\f!Í\f!\"!\"!ˆÎÏ\fÐRÑDC!@ÒÆ!ˆ)‡" [name 0 firstchar 48 57 get-buffer-create "*vc-info*" vc-insert-file expand-file-name vc-name-assoc-file file-name-as-directory vc-backend-subdirectory-name file file-name-directory vc-parse-buffer " : " " \\(.+\\)" 1 kill-buffer] 9]) (defalias 'vc-snapshot-precondition #[nil "ÀÂÃ)‡" [nil status vc-locked-example (byte-code "À Â\"ˆ ‡" [vc-file-tree-walk default-directory #[(f) "À !… !ƒÃÄ \"‡Å !…Ɖ‡" [vc-registered f vc-locking-user throw vc-locked-example get-file-buffer visited status] 3] status] 3)] 2]) #@209 Make a snapshot called NAME. The snapshot is made from all registered files at or below the current directory. For each file, the version level of its latest version becomes part of the named configuration. (defalias 'vc-create-snapshot #[(name) "À ‰;ƒÂà \"‚Ä Æ\")‡" [vc-snapshot-precondition result error "File %s is locked" vc-file-tree-walk default-directory #[(f) "À !…\n \"‡" [vc-name f vc-backend-assign-name name] 3]] 4 (#$ . 31984) "sNew snapshot name: "]) #@214 Retrieve the snapshot called NAME. This function fails if any files are locked at or below the current directory Otherwise, all registered files are checked out (unlocked) at their version levels in the snapshot. (defalias 'vc-retrieve-snapshot #[(name) "À Á‰;ƒÄÅ \"‚ Æ=ƒÇÈ!É\nË\"*‡" [vc-snapshot-precondition nil update result error "File %s is locked" visited yes-or-no-p "Update the affected buffers? " vc-file-tree-walk default-directory #[(f) "À !…\nÂÃć" [vc-name f nil (byte-code "À  #ˆ\fƒŠƉ#ˆÂ‡" [vc-backend-checkout f nil name update vc-resynch-buffer t] 4) ((error t))] 3]] 4 (#$ . 32465) "sSnapshot name to retrieve: "]) #@56 List the change log of the current buffer in a window. (defalias 'vc-print-log #[nil "ƒ\nÁ !qˆ ƒÄ !ˆ‚\n ƒ\\Æ !ƒ\\ È!ˆÄÉÊ!!ˆË!\fÍÎ!ƒGÏЕДZ!ˆÑyˆ‚3ebˆÍÒ!ƒXÏЕДZ!ˆÓ )‡Ô !‡" [vc-dired-mode find-file-noselect dired-get-filename vc-parent-buffer pop-to-buffer buffer-file-name vc-name file vc-backend-print-log get-buffer-create "*vc*" file-name-directory default-directory looking-at "=*\n" delete-char 0 -1 "[ \n \f ]+" shrink-window-if-larger-than-buffer vc-registration-error] 3 (#$ . 33120) nil]) #@269 Revert the current buffer's file back to the latest checked-in version. This asks for confirmation if the buffer contents are not identical to that version. If the back-end is CVS, this will give you the most recent revision of the file on the branch you are editing. (defalias 'vc-revert-buffer #[nil "ƒ Á !ˆ ƒÄ !ˆ‚ ÆpÇÆÈ\" \n \f ƒNÍÎ!„NÏÐ !ƒDÑÈÒ\"ƒDÓÒ !ˆ‚GÔ ˆÕÖ!ˆ‚R\nqˆ ƒpÏÐ !ƒmÑÈÒ\"ƒmÓÒ !ˆ‚pÔ ˆ×\f!ˆØ\fȉ#,‡" [vc-dired-mode find-file-other-window dired-get-filename vc-parent-buffer pop-to-buffer buffer-file-name nil vc-diff t changed obuf vc-suppress-confirm file yes-or-no-p "Discard changes? " window-dedicated-p selected-window one-window-p selected-frame make-frame-invisible delete-window error "Revert cancelled" vc-backend-revert vc-resynch-window] 6 (#$ . 33644) nil]) #@120 Get rid of most recently checked in version of this file. A prefix argument means do not revert the buffer afterwards. (defalias 'vc-cancel-version #[(norevert) "ƒ Á !ˆ ƒÄ !ˆ‚ ÅÆ !Ç=ƒ$ÈÉ!ˆ‚=ÊÆ !ƒ2ÈË!ˆ‚=ÌÆ !„=ÈÍ!ˆÎÆ !ÐÑ!…‘†RÐÓ!?ÔÆ \"ˆ„iÕÆ Ö\"ˆ‚ŒÅÆ !×=ƒxÖÙ ˆÚÆ ÛÜ!#ˆÝÆ !ˆÞÆ !ˆßà\")‡" [vc-dired-mode find-file-other-window dired-get-filename vc-parent-buffer pop-to-buffer vc-backend buffer-file-name CVS error "Unchecking files under CVS is dangerous and not supported in VC" vc-locking-user "This version is locked. Use vc-revert-buffer to discard changes." vc-latest-on-branch-p "This is not the latest version. VC cannot cancel it." vc-workfile-version target yes-or-no-p "Remove this version from master? " norevert "Revert buffer to most recent remaining version? " vc-backend-uncheck vc-checkout nil RCS buffer-read-only vc-clear-headers vc-backend-checkout t vc-branch-part set-visited-file-name vc-mode-line message "Version %s has been removed from the master."] 5 (#$ . 34459) "P"]) #@62 Rename file OLD to NEW, and rename its master file likewise. (defalias 'vc-rename-file #[(old new) "À !Â=ƒ\fÃÄ!ˆÅ !‰ƒ Ç!ƒ ÃÈ!ˆÅ !ƒ+ÃÊ!ˆË !ƒ6ÃÌ!ˆÍ !‰ƒzÏ !ƒIÃÐ!ˆÑ!„XÑÒ !!ƒ\\ÃÓ!ˆÔÀ !Õ !†jÖ× !ÛÜ+\"ˆƒ…Ë !ƒ‹Ô  \"ˆ)ƒ ŠqˆÝ !ˆÞß!ˆ))À !‰ á=ƒ´â  \"‚Ç ã=ƒ¿ß‚Ç Â=…Çß)‡" [vc-backend old CVS error "Renaming files under CVS is dangerous and not supported in VC." get-file-buffer oldbuf buffer-modified-p "Please save files before moving them" new "Already editing new file name" file-exists-p "New file already exists" vc-name oldmaster vc-locking-user "Please check in files before moving them" file-symlink-p vc-backend-subdirectory-name "This is not a safe thing to do in the presence of symbolic links" rename-file file-name-directory "" file-name-nondirectory newbase newdir backend found (byte-code "ÀÁ\n\"ˆÃÄ!‡" [mapcar #[(s) " A=…# @ \f#Æ !‰ƒÈ!…\"ÉÊ \"*‡" [backend s format newdir newbase newmaster file-name-directory newmasterdir file-directory-p throw found] 5] vc-master-templates error "New file lacks a version control directory"] 3) set-visited-file-name set-buffer-modified-p nil type SCCS vc-record-rename RCS] 7 (#$ . 35490) "fVC rename file: \nFRename to: "]) #@430 Find change log file and add entries from recent RCS logs. The mark is left at the end of the text prepended to the change log. 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. (defalias 'vc-update-change-log #[(&rest args) "Âà !ˆÄ ˆÅ ˆÆ ˆebˆÇ ˆÈÉ!ˆÈÊ ƒ>ÌÍÎÏÐÏÑÒ ÓÔ Ó°Ö× \"&Ø=ƒBÙ‚CÚ\")‡" [default-directory odefault find-file-other-window find-change-log barf-if-buffer-read-only vc-buffer-sync undo-boundary push-mark message "Computing change log entries..." "Computing change log entries... %s" args apply call-process "rcs2log" nil t "-u" user-login-name " " user-full-name user-mail-address mapcar #[(f) "ÀÁ\n!ƒ \n‚ \nP!‡" [file-relative-name file-name-absolute-p f odefault] 3] 0 "done" "failed"] 14 (#$ . 36723) (byte-code ":ƒ C‡ƒ8Âà  ƒ4Á @!‰ƒ-Ç\f!ƒ-\fB A‰„+‡ÉP\nË\n!…NÌÍÎ\nÂÏ#\")‡" [current-prefix-arg buffer-file-name nil buffer-list file buffers files vc-backend default-directory "RCS" RCS file-directory-p mapcar #[(f) "ÀÁ\n\"ƒ \nÃÄ•O‡\n‡" [string-match "\\(.*\\),v$" f 0 1] 3] directory-files "...\\|^[^.]\\|^.[^.]"] 7)]) (defalias 'vc-backend-admin #[(file &optional rev comment) "À !ˆ\n„ÃÄ!ƒÅ‚ÆÇÈ \"ˆÉÊ !ƒ$\n‚CÉË!ƒ.Å‚CÉÌ!ƒ8Æ‚CÉÍ!ƒB΂C\n‰Æ=ƒÐÑÒÓ Ô…ZÖP×Ø P…gÚPÛÜÆ\"@Þ !†ußà !#&\nˆá !ˆ\"ƒäÐÑÒã Ô%ˆ‚äÅ=ƒÂÐÑÒä ÔåÅæ\"…¥Ø\"ƒ®ç‚¯ÖP…»èP & ˆ‚äÎ=ƒäÐÑÒé êë…áìí\"…áîP&ˆ)Çï \"‡" [vc-file-clearprops file vc-default-back-end vc-find-binary "rcs" RCS SCCS message "Registering %s..." file-exists-p vc-backend-subdirectory-name "RCS" "SCCS" "CVS" CVS backend vc-do-command nil 0 "admin" MASTER rev "-r" "-fb" "-i" comment "-y" format rassq vc-master-templates file-name-directory "" file-name-nondirectory delete-file vc-keep-workfiles "get" "ci" vc-backend-release-p "5.6.4" "-u" "-t-" "cvs" WORKFILE "add" string-match "[^ \n ]" "-m" "Registering %s...done"] 16]) (defalias 'vc-backend-checkout #[(file &optional writable rev workfile) "†  ! ÇÈ\"ˆŠ ƒ qˆÉ!Ê !‰ Ì=ƒ©ƒ‚ÍÎÏ !!ƒ>Ñ‚?Ò\"ÓÖŽ×ØÙÒÚ ÛÜÝÞßà!á\"ßàâ !á\"#ã…iäå&…vçè &\"P)&ˆÙ+‚`×ØÙÒê Û…ä&…›çè &\"P)& ˆë ìÙ#ˆ‚` í=ƒœƒþÍÎÏ !!ƒÃÑ‚ÄÒ\"ÓîŽ×ØÙÒÚ ÛÜÝïßà!á\"ßàâ !á\"#ã…îðå&P)& ˆÙ+‚`Ù1&ƒ&㘃ØÙÒò Ûó&ˆ×ØÙÒô Ûõ !ö=…'÷…-ð&ƒ9ç&P‚Gì !‰8…Fç8P))&\nˆŠùqˆebˆúûÙÓ#…`ü”ü•{1)ë ì1#ˆ&ƒ˜&㘄˜ØÙÒò Ûóý !ƒ’þ1!?…”ÿ1!‚”1P&ˆ)‚` @=ƒ`ƒÐÓAŽ×ØÙÒÚ BÜCãç&På)& ˆÙ*‚`&ƒï&㘃ïØÙÒD BEF&ˆ&ƒ-×ØÙÒD B…õ !G=…HE&…%&ã˜?…%ç&P)&\nˆ‚UƒUõ !G=„IIßÑÎ !\"!ƒUJ ÍÎ !Ñ\"\"ˆ&ƒ`ë ìÙ#ˆ)\f„K !ˆƒ}ë LM #ˆë NOP !8#ˆÇQ\",‡" [workfile file get-file-buffer default-directory old-default-dir file-buffer filename message "Checking out %s..." file-name-directory vc-backend type SCCS logior file-modes vc-name writable 128 0 t failed vc-modes ((byte-code "ƒÁ\n!ƒÃ\n!ˆÁ‡" [failed file-exists-p filename delete-file] 2)) apply vc-do-command nil "/bin/sh" MASTER "-c" format "if [ x\"$1\" = x ]; then shift; fi; umask %o; exec >\"$1\" || exit; shift; umask %o; exec get \"$@\"" logand lognot 511 default-file-modes "" "-e" "-p" rev "-r" vc-lookup-triple vc-checkout-switches "get" vc-file-setprop vc-workfile-version RCS ((byte-code "ƒÁ\n!ƒÃ\n!ˆÁ‡" [failed file-exists-p filename delete-file] 2)) "if [ x\"$1\" = x ]; then shift; fi; umask %o; exec >\"$1\" || exit; shift; umask %o; exec co \"$@\"" "-l" new-version "rcs" "-b" "co" vc-checkout-model implicit "-f" workrev "*vc*" re-search-forward "^revision \\([0-9.]+\\).*\n" 1 vc-latest-on-branch-p vc-trunk-p vc-branch-part CVS ((byte-code "ƒÁ\n!ƒÃ\n!ˆÁ‡" [failed file-exists-p filename delete-file] 2)) WORKFILE "exec >\"$1\" || exit; shift; exec cvs update \"$@\"" "cvs" "update" "-A" manual "-w" zerop set-file-modes vc-file-clear-masterprops vc-locking-user user-login-name vc-checkout-time 5 file-attributes "Checking out %s...done"] 18]) (defalias 'vc-backend-logentry-check #[(file) "À !‰Ã=ƒÄ ÅY…+ÅbˆÆÇ!‚+\nÈ=ƒ$É‚+\nÊ=…+É)‡" [vc-backend file type SCCS buffer-size 512 error "Log must be less than 512 characters; point is now at pos 512" RCS nil CVS] 3]) (defalias 'vc-backend-checkin #[(file rev comment) "ÀÁ\n\"ˆ ƒÄÅ \"„ÆŠÇ\n!†pqˆÈ\n!ˆÉ\n!‰\nË=ƒ_ÌÍÎÏÐ\nÑ…;ÓPÔ P& ˆÖ\n×Ø#ˆÖ\nÙÎ#ˆƒWÍÎÏÛ\nÑ%ˆ‚W\nÜ=ƒ\nÙ\n!ÎÌÍÎÏß\nÑàÜá\"…}⃆ょÓPä P&\nˆÖ\n×Ø#ˆÖ\nÙÎ#ˆåqˆebˆæçÎè#„´æéÎè#ƒÂê”ê•{Ö\nÙ#ˆƒƒë!ë!˜„ÍÎÏì\nÑí!ƒéî‚ïîë!P&ˆàÜï\"„ÍÎêì\nÑãP&ˆ*‚W\nð=ƒWÎñòˆåqˆebˆæóÎè#ƒ1Ö\nÙô”ô•{#ˆ‚7Ö\nÙÎ#ˆƒGÍÎÏõ\nö÷ø&ˆÖ\n×Ø#ˆÖ\nùúû\n!8#ˆ*Àü\n\"‡" [message "Checking in %s..." file comment string-match "[^ \n ]" "*** empty log message ***" get-file-buffer vc-file-clear-masterprops vc-backend type SCCS apply vc-do-command nil 0 "delta" MASTER rev "-r" "-y" vc-checkin-switches vc-file-setprop vc-locking-user none vc-workfile-version vc-keep-workfiles "get" RCS new-version old-version "ci" vc-backend-release-p "5.6.4" "-j" "-u" "-m" "*vc*" re-search-forward "new revision: \\([0-9.]+\\);" t "reverting to previous revision \\([0-9.]+\\)" 1 vc-branch-part "rcs" vc-trunk-p "-b" "5.6.2" CVS (byte-code "ƒÁ!ƒÂÃÄÅÆÈÉÊË\f&\nˆÂÃÄÅÆÈÉ…*ÍPÊP\f&\n‡" [rev vc-trunk-p apply vc-do-command nil 0 "cvs" file WORKFILE "ci" "-m" "intermediate" vc-checkin-switches "-r" comment] 11) ((error (byte-code "À !Â=ƒÃÄ!ˆ‚ÃÅ!ˆÀ‡" [vc-cvs-status file needs-merge error "Type C-x 0 C-x C-q to merge in changes." "Check in FAILED."] 2))) "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2 "cvs" WORKFILE "update" "-A" vc-checkout-time 5 file-attributes "Checking in %s...done"] 12]) (defalias 'vc-backend-revert #[(file) "ÀÁ\n\"ˆÃ\n!ˆÄ\n!‰Æ=ƒ*ÇÈÉÊ\nËÈ&ˆÇÈÉÌ\nËÈ&ˆ‚V Í=ƒBÇÈÉÎ\nËÏÐÑ\n!P&ˆ‚V Ò=ƒVÓ\n!ˆÇÈÉÔ\nÕÖ&ˆ)×\nØÙ#ˆ×\nÚÛÜ\n!8#ˆÀÝ\n\"‡" [message "Reverting %s..." file vc-file-clear-masterprops vc-backend type SCCS vc-do-command nil 0 "unget" MASTER "get" RCS "co" "-f" "-u" vc-workfile-version CVS delete-file "cvs" WORKFILE "update" vc-file-setprop vc-locking-user none vc-checkout-time 5 file-attributes "Reverting %s...done"] 11]) (defalias 'vc-backend-steal #[(file &optional rev) "ÀÁ\n\"ˆÃ\n!‰Å=ƒ8ÆÇÈÉ\nÊË\f…Í\fP&ˆÆÇÈÎ\nÊÏ\f…2Í\fP&ˆ‚]\fÐ=ƒSÆÇÈÑ\nÊÒÓ\fPÔ\fP&ˆ‚]\fÕ=ƒ]Ö×!ˆ)Ø\nÙÚ #ˆÀÛ\n\"‡" [message "Stealing lock on %s..." file vc-backend type SCCS vc-do-command nil 0 "unget" MASTER "-n" rev "-r" "get" "-g" RCS "rcs" "-M" "-u" "-l" CVS error "You cannot steal a CVS lock; there are no CVS locks to steal." vc-file-setprop vc-locking-user user-login-name "Stealing lock on %s...done"] 11]) (defalias 'vc-backend-uncheck #[(file target) "ÀÁ\n\"ˆÃ\n!‰Å=ƒÆÇÈÉ\nÊË\fP&ˆ‚2\fÍ=ƒ2ÆÇÈÎ\nÊÏ\fP&ˆ)ÀÐ\n\"‡" [message "Removing last change from %s..." file vc-backend type SCCS vc-do-command nil 0 "rmdel" MASTER "-r" target RCS "rcs" "-o" "Removing last change from %s...done"] 9]) (defalias 'vc-backend-print-log #[(file) "À !‰Ã=ƒÄÅÆÇ È%‚3\nÉ=ƒ$ÄÅÆÊ È%‚3\nË=…3ÄÅÆÌ ÍÊ&)‡" [vc-backend file type SCCS vc-do-command nil 0 "prs" MASTER RCS "rlog" CVS "cvs" WORKFILE] 8]) (defalias 'vc-backend-assign-name #[(file name) "À !‰Ã=ƒÄ Æ !#‚9\nÇ=ƒ)ÈÉÊË ÌÍ ÎQ&‚9\nÏ=…9ÈÉÊÐ ÑÒ &)‡" [vc-backend file type SCCS vc-add-triple name vc-latest-version RCS vc-do-command nil 0 "rcs" MASTER "-n" ":" CVS "cvs" WORKFILE "tag"] 10]) (defalias 'vc-backend-diff #[(file &optional oldvers newvers cmp) "À !‰Ã=ƒÄ \"Ä \"‚3\nÇ=ƒ3 „'È ! …1\nË=? \nÃ=„?\nÇ=ƒÓ\nÃ=ƒIÌ‚JÍ\nÇ=ƒVÏ‚WÐÒ …`ÓÔ …hÕ P…qÕPF ?…†<ƒƒ‚†C\"ØÙÚÛ &‰Û=ƒÀØÙÚÝ Ï ƒ±A‚³& ƒÏË\n‚Ï ƒÍ\n„ÍÞ\n,‚E\nß=ƒBÈ !à˜ƒ „êƒñáâ \"‚E ƒúÝ‚EØÙÚÝã ÏÒ<ƒ ‚Cä\"&‚EØÙÚÝå Ïã …&Õ P…/ÕP<ƒ:‚=C&\n‚Eæ !)‡" [vc-backend file backend SCCS vc-lookup-triple oldvers newvers RCS vc-workfile-version cmp vc-rcsdiff-knows-brief no "vcdiff" "rcsdiff" command WORKFILE MASTER mode append "--brief" "-q" "-r" diff-switches options apply vc-do-command "*vc-diff*" 2 status 1 yes CVS "0" error "No revisions of %s exist" "diff" ("/dev/null") "cvs" vc-registration-error] 12]) (defalias 'vc-backend-merge-news #[(file) "ÀÁ\n\"ˆÃ\n!‰Å=ƒÆÇ!‚X\fÈ=ƒ!ÆÉ!‚X\fÊ=…XŠË\n!ˆÌ\nÍÎ#ˆÌ\nÏÎ#ˆÐÎÑÒ\nÓÔ&ˆÕÖ!qˆebˆ×ØÎÙ#ƒVÚ‚WÑ))ÀÛ\n\"ˆ‡" [message "Merging changes into %s..." file vc-backend type SCCS error "vc-backend-merge-news not meaningful for SCCS files" RCS "vc-backend-merge-news not meaningful for RCS files" CVS vc-file-clear-masterprops vc-file-setprop vc-workfile-version nil vc-locking-user vc-do-command 0 "cvs" WORKFILE "update" get-buffer "*vc*" re-search-forward "^cvs update: conflicts found in .*" t 1 "Merging changes into %s...done"] 8]) #@50 Check if the current file has any headers in it. (defalias 'vc-check-headers #[nil "ŠebˆÀ !‰Ã=ƒÄÅÆÇ#‚+\nÈ=ƒ$ÄÉÆÇ#‚+\nÊ=…+È*‡" [vc-backend buffer-file-name type SCCS re-search-forward "%[MIRLBSDHTEGUYFPQCZWA]%" nil t RCS "\\$[A-Za-zÀ-ÖØ-öø-ÿ]+\\(: [ -#%-~ -ÿ]*\\)?\\$" CVS] 5 (#$ . 45636) nil]) #@2449 Minor mode for driving version-control tools. These bindings are added to the global keymap when you enter this mode: \[vc-next-action] perform next logical version-control operation on current file \[vc-register] register current file \[vc-toggle-read-only] like next-action, but won't register files \[vc-insert-headers] insert version-control headers in current file \[vc-print-log] display change history of current file \[vc-revert-buffer] revert buffer to latest version \[vc-cancel-version] undo latest checkin \[vc-diff] show diffs between file versions \[vc-version-other-window] visit old version in another window \[vc-directory] show all files locked by any user in or below . \[vc-update-change-log] add change log entry from recent checkins While you are entering a change log message for a version, the following additional bindings will be in effect. \[vc-finish-logentry] proceed with check in, ending log message entry Whenever you do a checkin, your log comment is added to a ring of saved comments. These can be recalled as follows: \[vc-next-comment] replace region with next message in comment ring \[vc-previous-comment] replace region with previous message in comment ring \[vc-comment-search-reverse] search backward for regexp in the comment ring \[vc-comment-search-forward] search backward for regexp in the comment ring Entry to the change-log submode calls the value of text-mode-hook, then the value of vc-log-mode-hook. Global user options: vc-initial-comment If non-nil, require user to enter a change comment upon first checkin of the file. vc-keep-workfiles Non-nil value prevents workfiles from being deleted when changes are checked in vc-suppress-confirm Suppresses some confirmation prompts, notably for reversions. vc-header-alist Which keywords to insert when adding headers with \[vc-insert-headers]. Defaults to '("%W%") under SCCS, '("$Id$") under RCS and CVS. vc-static-header-alist By default, version headers inserted in C files get stuffed in a static string area so that ident(RCS/CVS) or what(SCCS) can see them in the compiled object code. You can override this by setting this variable to nil, or change the header template by changing it. vc-command-messages if non-nil, display run messages from the actual version-control utilities (this is intended primarily for people hacking vc itself).  (defalias 'vc-log-mode #[nil "À !ˆÂ !ˆ\fÆÈ ÊË!ˆÊÌ!ˆÊÍ!ˆÎÏ!ˆÏÑÒÓ\"‡" [set-syntax-table text-mode-syntax-table use-local-map vc-log-entry-mode text-mode-abbrev-table local-abbrev-table vc-log-mode major-mode "VC-Log" mode-name make-local-variable vc-log-file vc-log-version vc-comment-ring-index set-buffer-modified-p nil buffer-file-name run-hooks text-mode-hook vc-log-mode-hook] 3 (#$ . 45946) nil]) (byte-code "„%Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÁ‡" [vc-log-entry-mode make-sparse-keymap define-key "î" vc-next-comment "ð" vc-previous-comment "ò" vc-comment-search-reverse "ó" vc-comment-search-forward "" vc-finish-logentry] 4) #@98 Walk recursively through DIRNAME. Invoke FUNC f ARGS on each non-directory file f underneath it. (defalias 'vc-file-tree-walk #[(dirname func &rest args) "ÀÁ\n! \f#ˆÅÆ\n\"‡" [vc-file-tree-walk-internal expand-file-name dirname func args message "Traversing directory %s...done"] 4 (#$ . 49041)]) (defalias 'vc-file-tree-walk-internal #[(file func args) "À !„\f \f#‡ÅÆÇ !\"ˆÈ ! ÊËÌ !\")‡" [file-directory-p file apply func args message "Traversing directory %s..." abbreviate-file-name file-name-as-directory dir mapcar #[(f) "Á˜†$˜†$ †$\fPÆ !†#Ç  #)‡" [f "." ".." vc-directory-exclusion-list dir dirf file-symlink-p vc-file-tree-walk-internal func args] 4] directory-files] 4]) (provide (quote vc)) emacs-19.30/lisp/vi.elc100666 13437 1 117530 6011353125 13357 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Aug 7 05:00:23 1995 ;;; from file /home/fsf/rms/e19/lisp/vi.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`vi.el' was compiled for Emacs 19.29 or later")) #@92 Switch the major mode of current buffer as specified by the following char \{vi-tilde-map} (defalias 'vi-switch-mode #[(arg mode-char) "À  !\"‰„ÅÆÇÈ!!ˆŠ qˆÊ )‘‚* \fÍ\fÎ\"ˆÏ )‡" [lookup-key vi-tilde-map char-to-string mode-char mode-cmd "*Help*" princ substitute-command-keys "Possible major modes to switch to: \\{vi-tilde-map}" standard-output help-mode arg prefix-arg command-execute nil force-mode-line-update] 5 (#$ . 462) "P\nc"]) (byte-code "ÀÁ \"„Ã\fÅÁ#ˆÀ‡" [where-is-internal vi-switch-mode current-local-map define-key ctl-x-map "~"] 4) #@77 Keymap used for \[vi-switch-mode] prefix key. Link to various major modes. (defvar vi-tilde-map nil (#$ . 1026)) (byte-code "„sÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆÂáâ#ˆÂãä#ˆÂåæ#ˆÁ‡" [vi-tilde-map make-keymap define-key "a" abbrev-mode "c" c-mode "d" vi-debugging "e" emacs-lisp-mode "f" auto-fill-mode "g" prolog-mode "h" hanoi "i" info-mode "l" lisp-mode "n" nroff-mode "o" overwrite-mode "O" outline-mode "P" picture-mode "r" vi-readonly-mode "t" text-mode "v" vi-mode "x" tex-mode "~" vi-back-to-old-mode] 4) #@61 Toggle debug-on-error flag. If prefix arg is given, set t. (defalias 'vi-debugging #[(arg) "ƒ Á‚\f\n?\nƒÃÄ!‡ÃÅ!‡" [arg t debug-on-error message "Debug-on-error ..." "NO more debug-on-error"] 2 (#$ . 1607) "P"]) #@64 Go back to the previous mode without setting up for insertion. (defalias 'vi-back-to-old-mode #[nil "… Ã\f!ˆÈ ‡" [vi-mode-old-major-mode vi-mode-old-mode-name mode-name use-local-map vi-mode-old-local-map major-mode vi-mode-old-case-fold case-fold-search force-mode-line-update] 2 (#$ . 1832) nil]) #@40 Toggle current buffer's readonly flag. (defalias 'vi-readonly-mode #[nil "?‰‡" [buffer-read-only] 2 (#$ . 2147) nil]) #@128 Keymap used in Evi's command state Command state includes most of the vi editing commands, with some Emacs command extensions. (defvar vi-com-map nil (#$ . 2274)) (byte-code "ÀÁÂÃ#ˆ\f„‚Å Æ\fÇÈ#ˆÆ\fÉÊ#ˆÆ\fËÌ#ˆÆ\fÍÎ#ˆÆ\fÏÐ#ˆÆ\fÑÒ#ˆÆ\fÓÔ#ˆÆ\fÕÖ#ˆÆ\f×Ø#ˆÆ\fÙÚ#ˆÆ\fÛÜ#ˆÆ\fÝÞ#ˆÆ\fßà#ˆÆ\fáÚ#ˆÆ\fâã#ˆÆ\fäå#ˆÆ\fæç#ˆÆ\fèé#ˆÆ\fêë#ˆÆ\fìí#ˆÆ\fîï#ˆÆ\fðñ#ˆÆ\fòó#ˆÆ\fôõ#ˆÆ\fö÷#ˆÆ\føù#ˆÆ\fúû#ˆÆ\füý#ˆÆ\fþÿ#ˆÆ\f@A#ˆÆ\fBÁ#ˆÆ\fCD#ˆÆ\fEF#ˆÆ\fGH#ˆÆ\fIJ#ˆÆ\fKL#ˆÆ\fMN#ˆÆ\fOý#ˆÆ\fPQ#ˆÆ\fRS#ˆÆ\fTU#ˆÆ\fVW#ˆÆ\fXà#ˆÆ\fYZ#ˆÆ\f[\\#ˆÆ\f]^#ˆÆ\f_`#ˆÆ\fab#ˆÆ\fcd#ˆÆ\fed#ˆÆ\ffd#ˆÆ\fgd#ˆÆ\fhd#ˆÆ\fid#ˆÆ\fjd#ˆÆ\fkd#ˆÆ\fld#ˆÆ\fmn#ˆÆ\fop#ˆÆ\fqF#ˆÆ\frF#ˆÆ\fsF#ˆÆ\ftu#ˆÆ\fvw#ˆÆ\fxy#ˆÆ\fz{#ˆÆ\f|}#ˆÆ\f~Ü#ˆÆ\f€#ˆÆ\f‚#ˆÆ\fƒ„#ˆÆ\f…†#ˆÆ\f‡ˆ#ˆÆ\f‰Š#ˆÆ\f‹Á#ˆÆ\fŒ#ˆÆ\fŽ#ˆÆ\f‘#ˆÆ\f’“#ˆÆ\f”•#ˆÆ\f–—#ˆÆ\f˜™#ˆÆ\fš›#ˆÆ\fœ#ˆÆ\fžý#ˆÆ\fŸÁ#ˆÆ\f ¡#ˆÆ\f¢£#ˆÆ\f¤¥#ˆÆ\f¦§ #ˆÆ\f¨©#ˆÆ\fªý#ˆÆ\f«F#ˆÆ\f¬ý#ˆÆ\f­®#ˆÆ\f¯Á#ˆÆ\f°±#ˆÆ\f²³#ˆÆ\f´µ#ˆÆ\f¶F#ˆÆ\f·F#ˆÆ\f¸¹#ˆÆ\fº»#ˆÆ\f¼½#ˆÆ\f¾¿#ˆÆ\fÀÁ#ˆÆ\fÂÚ#ˆÆ\fÃå#ˆÆ\fÄD#ˆÆ\fÅÆ#ˆÆ\fÇÈ#ˆÆ\fÉÊ#ˆÆ\fËÌ#ˆÆ\fÍÎ#ˆÆ\fÏÐ#ˆÆ\fÑÒ#ˆÆ\fÓÔ#ˆÆ\fÕÖ#ˆÆ\f×Ø#ˆÆ\fÙÚ#ˆÆ\fÛÜ#ˆÆ\fÝF#ˆÆ\fÞß#ˆÆ\fàá#ˆÆ\fâã#ˆÆ\fäå#ˆÆ\fæç#ˆÆ\fèé#ˆÀ¿êë#ˆÀÚêì#ˆÀíêì#ˆÀîêì#ˆÀåêì#ˆÀéêï#ˆÀuêï#ˆÀëêï#ˆÀ`êï#ˆÀDêë#ˆÀLêë#ˆÀNêð#ˆÀQêì#ˆÀSêñ#ˆÀUêñ#ˆÀàêì#ˆÀ\\êì#ˆÀZêò#ˆÀóêï#ˆÀbêë#ˆÀ½êë#ˆÀpêô#ˆÀõêï#ˆÀ{êö#ˆÀ€êð#ˆÀ‚êô#ˆÀ„êì#ˆÀ†êì#ˆÀêì#ˆÀêì#ˆÀ‘ê÷#ˆÀêô#ˆÀ¡êö#ˆÀ®êë#ˆÀ±êë#ˆÀµêø#ˆÀ¹êð#ˆÀ»êô#ˆÀ¿êë#ˆÀùêë#ˆÀÈêï#ˆÀÔêô#ˆÀÚêø#ˆÀãêð#ˆÀåêú#ˆÀáêú#ˆÀûêü#ˆÀýêü#ˆÀþêü#ˆÀÿêü#ˆÀêü#ˆÀêü#ˆÀêü#ˆÀêü#‡" [put vi-undefined suppress-keymap t vi-com-map make-keymap define-key "" vi-mark-region "" vi-ask-for-info "" vi-backward-windowfull "" vi-do-old-mode-C-c-command "" vi-scroll-down-window "" vi-expose-line-below "" vi-forward-windowfull "" keyboard-quit " " indent-relative-maybe "\n" vi-next-line " " vi-kill-line "\f" recenter " " vi-next-line-first-nonwhite "" "" vi-split-open-line "" previous-line "" vi-query-replace "" vi-isearch-backward "" vi-isearch-forward "" vi-transpose-objects "" vi-scroll-up-window "" scroll-up "" vi-kill-region "" Control-X-prefix "" vi-expose-line-above "" suspend-emacs "" ESC-prefix "" vi-unimplemented "" find-tag "" vi-locate-def "" " " forward-char "!" vi-operator "\"" vi-char-argument "#" universal-argument "$" end-of-line "%" vi-find-matching-paren "&" "'" vi-goto-line-mark "(" backward-sexp ")" forward-sexp "*" vi-name-last-change-or-macro "+" "," vi-reverse-last-find-char "-" vi-previous-line-first-nonwhite "." vi-redo-last-change-command "/" vi-search-forward "0" beginning-of-line "1" vi-digit-argument "2" "3" "4" "5" "6" "7" "8" "9" ":" vi-ex-cmd ";" vi-repeat-last-find-char "<" "=" ">" "?" vi-search-backward "@" vi-call-named-change-or-macro "A" vi-append-at-end-of-line "B" vi-backward-blank-delimited-word "C" vi-change-rest-of-line "D" "E" vi-end-of-blank-delimited-word "F" vi-backward-find-char "G" vi-goto-line "H" vi-home-window-line "I" vi-insert-before-first-nonwhite "J" vi-join-lines "K" "L" vi-last-window-line "M" vi-middle-window-line "N" vi-reverse-last-search "O" vi-open-above "P" vi-put-before "Q" vi-quote-words "R" vi-replace-chars "S" vi-substitute-lines "T" vi-backward-upto-char "U" "V" "W" vi-forward-blank-delimited-word "X" call-last-kbd-macro "Y" vi-yank-line "Z" make-sparse-keymap "ZZ" vi-save-all-and-exit "[" "\\" "]" "^" back-to-indentation "_" "`" vi-goto-char-mark "a" vi-insert-after "b" backward-word "c" "d" "e" vi-end-of-word "f" vi-forward-find-char "g" vi-beginning-of-buffer "h" backward-char "i" vi-insert-before "j" "k" "l" "m" vi-set-mark "n" vi-repeat-last-search "o" vi-open-below "p" vi-put-after "q" vi-replace "r" vi-replace-1-char "s" vi-substitute-chars "t" vi-forward-upto-char "u" undo "v" vi-verify-spelling "w" vi-forward-word "x" vi-kill-char "y" "z" vi-adjust-window "{" backward-paragraph "|" vi-goto-column "}" forward-paragraph "~" vi-change-case "" delete-backward-char point-moving-unit char line next-line forward-line search match sexp rev-find vi-re-search-forward find vi-re-search-backward WORD rev-search word vi-forward-char paragraph mark-page region mark-paragraph mark-word mark-sexp mark-defun mark-whole-buffer mark-end-of-sentence mark-c-function] 4) #@57 Alist of (NAME . MARK), marks are local to each buffer. (defvar vi-mark-alist nil (#$ . 7091)) #@60 Default amount of lines for scrolling (used by "^D"/"^U"). (defvar vi-scroll-amount (byte-code "À Á¥‡" [window-height 2] 2) (#$ . 7192)) #@37 Shift amount for "<"/">" operators. (defvar vi-shift-width 4 (#$ . 7335)) #@51 Last insertion point. Should use `mark' instead. (defvar vi-ins-point nil (#$ . 7415)) #@27 Length of last insertion. (defvar vi-ins-length nil (#$ . 7509)) #@45 The repetition required for last insertion. (defvar vi-ins-repetition nil (#$ . 7580)) #@45 T if last insertion was a replace actually. (defvar vi-ins-overwrt-p nil (#$ . 7673)) #@52 Code to be eval'ed before (redo-)insertion begins. (defvar vi-ins-prefix-code nil (#$ . 7765)) #@64 Save last direction, char and upto-flag used for char finding. (defvar vi-last-find-char nil (#$ . 7866)) #@111 Save commands for redoing last changes. Each command is in (FUNC . ARGS) form that is ready to be `apply'ed. (defvar vi-last-change-command nil (#$ . 7979)) #@49 Save last shell command given for "!" operator. (defvar vi-last-shell-command nil (#$ . 8143)) #@35 Non-nil if it is in insert state. (defvar vi-insert-state nil (#$ . 8244)) #@45 Save last search command for possible redo. (defvar vi-search-last-command nil (#$ . 8325)) #@50 Save the local-map used before entering vi-mode. (defvar vi-mode-old-local-map nil (#$ . 8423)) #@45 Save the mode-name before entering vi-mode. (defvar vi-mode-old-mode-name nil (#$ . 8525)) #@46 Save the major-mode before entering vi-mode. (defvar vi-mode-old-major-mode nil (#$ . 8622)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp vi-mode-old-case-fold nil current-load-list] 2) #@74 Setup a buffer for vi-mode by creating necessary buffer-local variables. (defalias 'vi-mode-setup #[nil "ÀÁ!ˆÂ Ã¥ÀÄ!ˆÅÀÆ!ˆÀÇ!ˆÀÈ!ˆÀÉ!ˆÀÊ!ˆÀË!ˆÀÌ!ˆÀÍ!ˆÀÎ!ˆÀÏ!ˆÀÐ!ˆÀÑ!ˆÀÒ!ˆÀÓ!ˆÔÕ!‡" [make-local-variable vi-scroll-amount window-height 2 vi-shift-width 4 vi-ins-point vi-ins-length vi-ins-repetition vi-ins-overwrt-p vi-ins-prefix-code vi-last-change-command vi-last-shell-command vi-last-find-char vi-mark-alist vi-insert-state vi-mode-old-local-map vi-mode-old-mode-name vi-mode-old-major-mode vi-mode-old-case-fold run-hooks vi-mode-hook] 2 (#$ . 8805)]) #@2275 Major mode that acts like the `vi' editor. The purpose of this mode is to provide you the combined power of vi (namely, the "cross product" effect of commands and repeat last changes) and Emacs. This command redefines nearly all keys to look like vi commands. It records the previous major mode, and any vi command for input (`i', `a', `s', etc.) switches back to that mode. Thus, ordinary Emacs (in whatever major mode you had been using) is "input" mode as far as vi is concerned. To get back into vi from "input" mode, you must issue this command again. Therefore, it is recommended that you assign it to a key. Major differences between this mode and real vi : * Limitations and unsupported features - Search patterns with line offset (e.g. /pat/+3 or /pat/z.) are not supported. - Ex commands are not implemented; try ':' to get some hints. - No line undo (i.e. the 'U' command), but multi-undo is a standard feature. * Modifications - The stopping positions for some point motion commands (word boundary, pattern search) are slightly different from standard 'vi'. Also, no automatic wrap around at end of buffer for pattern searching. - Since changes are done in two steps (deletion then insertion), you need to undo twice to completely undo a change command. But this is not needed for undoing a repeated change command. - No need to set/unset 'magic', to search for a string with regular expr in it just put a prefix arg for the search commands. Replace cmds too. - ^R is bound to incremental backward search, so use ^L to redraw screen. * Extensions - Some standard (or modified) Emacs commands were integrated, such as incremental search, query replace, transpose objects, and keyboard macros. - In command state, ^X links to the 'ctl-x-map', and ESC can be linked to esc-map or set undefined. These can give you the full power of Emacs. - See vi-com-map for those keys that are extensions to standard vi, e.g. `vi-name-last-change-or-macro', `vi-verify-spelling', `vi-locate-def', `vi-mark-region', and 'vi-quote-words'. Some of them are quite handy. - Use \[vi-switch-mode] to switch among different modes quickly. Syntax table and abbrevs while in vi mode remain as they were in Emacs. (defalias 'vi-mode #[nil "„Á ˆ\nÃ=ƒÄÅÆ \"‡Ç  \n\n \fÍ Î!ˆÃÐ Ñ ˆ…8Ó ‡" [vi-mode-old-major-mode vi-mode-setup major-mode vi-mode message "Already in vi-mode." ding current-local-map vi-mode-old-local-map mode-name vi-mode-old-mode-name case-fold-search vi-mode-old-case-fold nil use-local-map vi-com-map "VI" force-mode-line-update vi-insert-state vi-end-of-insert-state] 3 (#$ . 9369) nil]) #@8 Ding ! (defalias 'vi-ding #[nil "À ‡" [ding] 1 (#$ . 12058) nil]) #@61 Save all modified buffers without asking, then exits emacs. (defalias 'vi-save-all-and-exit #[nil "ÀÁ!ˆÂ ‡" [save-some-buffers t kill-emacs] 2 (#$ . 12130) nil]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp vi-replaced-string nil current-load-list vi-replacing-string] 2) #@495 Ex commands are not implemented in Evi mode. For some commonly used ex commands, you can use the following alternatives for similar effect : w C-x C-s (save-buffer) wq C-x C-c (save-buffers-kill-emacs) w fname C-x C-w (write-file) e fname C-x C-f (find-file) r fname C-x i (insert-file) s/old/new use q (vi-replace) to do unconditional replace use C-q (vi-query-replace) to do query replace set sw=n M-x set-variable vi-shift-width n  (defalias 'vi-ex-cmd #[nil "ÀÁÂÃ!!ˆŠ\fqˆÅ )‘‡" ["*Help*" princ documentation vi-ex-cmd standard-output help-mode] 4 (#$ . 12412) nil]) (defalias 'vi-undefined #[nil "ÀÁ !\"ˆÄ ‡" [message "Command key \"%s\" is undefined in Evi." single-key-description last-command-char ding] 4 nil nil]) (defalias 'vi-unimplemented #[nil "ÀÁ !\"ˆÄ ‡" [message "Command key \"%s\" is not implemented in Evi." single-key-description last-command-char ding] 4 nil nil]) #@291 Go into insert state, the text entered will be repeated if REPETITION > 1. If PREFIX-CODE is given, do it before insertion begins if DO-IT-NOW-P is T. In any case, the prefix-code will be done before each 'redo-insert'. This function expects 'overwrite-mode' being set properly beforehand. (defalias 'vi-goto-insert-state #[(repetition &optional prefix-code do-it-now-p) "ƒ Á\n@\nA\"ˆ`\f\n \nË\f!ˆ Ï ˆÐ‰‡" [do-it-now-p apply prefix-code vi-ins-point repetition vi-ins-repetition vi-ins-prefix-code vi-mode-old-mode-name mode-name vi-mode-old-case-fold case-fold-search use-local-map vi-mode-old-local-map vi-mode-old-major-mode major-mode force-mode-line-update t vi-insert-state] 3 (#$ . 13367)]) #@53 Terminate insertion and set up last change command. (defalias 'vi-end-of-insert-state #[nil "`W„`Uƒ ƒ\nÃXƒÄÅ!‡\nÆVƒ7`{\nÆVƒ6cˆ\nS‰‚&)ÈÉ`\n %ˆÄÅ!‡" [vi-ins-point vi-ins-prefix-code vi-ins-repetition 0 vi-goto-command-state t 1 str vi-set-last-change-command vi-first-redo-insertion overwrite-mode] 7 (#$ . 14089)]) #@148 Redo last insertion the first time. Extract the string and save it for future redoes. Do prefix-code if it's given, use overwrite mode if asked. (defalias 'vi-first-redo-insertion #[(begin end &optional overwrite-p prefix-code) " { ƒÄ @ A\"ˆ ƒ``\nG\\|ˆ\ncˆÆÇ\n $)‡" [begin end str prefix-code apply overwrite-p vi-set-last-change-command vi-more-redo-insertion] 5 (#$ . 14431)]) #@135 Redo more insertion : copy string from STR to point, use overwrite mode if overwrite-p is T; apply prefix-code first if it's non-nil. (defalias 'vi-more-redo-insertion #[(str &optional overwrite-p prefix-code) "ƒ Á@A\"ˆ\nƒ`` G\\|ˆ c‡" [prefix-code apply overwrite-p str] 3 (#$ . 14826)]) #@87 Go to vi-mode command state. If optional arg exists, means return from insert state. (defalias 'vi-goto-command-state #[(&optional from-insert-state-p) "À !ˆÂ\f… …ÅÆ!‡" [use-local-map vi-com-map nil vi-insert-state from-insert-state-p overwrite-mode 0] 2 (#$ . 15126)]) #@68 kill specified number of lines (=d$), text saved in the kill ring. (defalias 'vi-kill-line #[(arg) "À !ˆÂÀ \"‡" [kill-line arg vi-set-last-change-command] 3 (#$ . 15408) "*P"]) (defalias 'vi-kill-region #[(start end) "À \n\"ˆÃÀ!‡" [kill-region start end vi-set-last-change-command] 3 nil "*r"]) #@53 go to end of line and then go into vi insert state. (defalias 'vi-append-at-end-of-line #[(arg) "À ÂÃ#‡" [vi-goto-insert-state arg (end-of-line) t] 4 (#$ . 15709) "*p"]) #@46 Change the rest of (ARG) lines (= c$ in vi). (defalias 'vi-change-rest-of-line #[(arg) "ÀÁ DÄ#‡" [vi-goto-insert-state 1 kill-line arg t] 4 (#$ . 15885) "*P"]) #@14 (= ^i in vi) (defalias 'vi-insert-before-first-nonwhite #[(arg) "À ÂÃ#‡" [vi-goto-insert-state arg (back-to-indentation) t] 4 (#$ . 16052) "*p"]) #@61 open new line(s) above current line and enter insert state. (defalias 'vi-open-above #[(arg) "ÀÁ DÄ#‡" [vi-goto-insert-state 1 #[(x) "ÀyˆÁ\n!‡" [0 open-line x] 2] arg t] 4 (#$ . 16204) "*p"]) #@60 open new line(s) and go into insert mode on the last line. (defalias 'vi-open-below #[(arg) "ÀÁ DÄ#‡" [vi-goto-insert-state 1 #[(x) "À† Á\n!† \ny‡" [nil open-line x] 2] arg t] 4 (#$ . 16403) "*p"]) #@37 start vi insert state after cursor. (defalias 'vi-insert-after #[(arg) "À ÂCÃ#‡" [vi-goto-insert-state arg #[nil "l?…Àu‡" [nil] 1] t] 4 (#$ . 16611) "*p"]) #@39 enter insert state before the cursor. (defalias 'vi-insert-before #[(arg) "À !‡" [vi-goto-insert-state arg] 2 (#$ . 16775) "*p"]) #@19 Go to ARGth line. (defalias 'vi-goto-line #[(arg) "À !„  ‡ÃÄ !!‡" [vi-raw-numeric-prefix arg end-of-buffer goto-line vi-prefix-numeric-value] 3 (#$ . 16911) "P"]) #@48 Move point to the beginning of current buffer. (defalias 'vi-beginning-of-buffer #[nil "eb‡" [] 1 (#$ . 17082) nil]) #@68 Incremental search forward. Use regexp version if ARG is non-nil. (defalias 'vi-isearch-forward #[(arg) "ƒÁ‚ Â`Å\f!ˆ `U?…#ƒÆ‚ lj*‡" [arg isearch-forward-regexp isearch-forward opoint scmd call-interactively re-search-forward search-forward vi-search-last-command] 2 (#$ . 17205) "P"]) #@69 Incremental search backward. Use regexp version if ARG is non-nil. (defalias 'vi-isearch-backward #[(arg) "ƒÁ‚ Â`Å\f!ˆ `U?…#ƒÆ‚ lj*‡" [arg isearch-backward-regexp isearch-backward opoint scmd call-interactively re-search-backward search-backward vi-search-last-command] 2 (#$ . 17510) "P"]) #@70 Nonincremental search forward. Use regexp version if ARG is non-nil. (defalias 'vi-search-forward #[(arg string) "ƒÁ‚ Â\fGÅVƒ\f ljÈ$‡" [arg re-search-forward search-forward vi-search-last-command string 0 search-last-string nil 1] 5 (#$ . 17821) (byte-code "ƒ ÁÂÃÄ\"D‡ÄÂÅÄ\"D‡" [current-prefix-arg t read-string "regexp/" nil "/"] 4)]) #@72 Nonincremental search backward. Use regexp version if ARG is non-nil. (defalias 'vi-search-backward #[(arg string) "ƒÁ‚ Â\fGÅVƒ\f ljÈ$‡" [arg re-search-backward search-backward vi-search-last-command string 0 search-last-string nil 1] 5 (#$ . 18176) (byte-code "ƒ ÁÂÃÄ\"D‡ÄÂÅÄ\"D‡" [current-prefix-arg t read-string "regexp?" nil "?"] 4)]) #@112 Repeat last search command. If optional search-command/string are given, use those instead of the ones saved. (defalias 'vi-repeat-last-search #[(arg &optional search-command search-string) "„ \n„\f „ÄÅÆ \"‡\nlj$‡" [search-command vi-search-last-command search-string search-last-string message "No last search command to repeat." ding nil arg] 5 (#$ . 18537) "p"]) #@124 Redo last search command in reverse direction. If the optional search args are given, use those instead of the ones saved. (defalias 'vi-reverse-last-search #[(arg &optional search-command search-string) "„ \n„\f „ÄÅÆ \"‡Ç=ƒ È‚;È=ƒ*Ç‚;É=ƒ4Ê‚;Ê=…;É\nˉ\f$‡" [search-command vi-search-last-command search-string search-last-string message "No last search command to repeat." ding re-search-forward re-search-backward search-forward search-backward nil arg] 5 (#$ . 18923) "p"]) #@72 join ARG lines from current line (default 2), cleaning up white space. (defalias 'vi-join-lines #[(arg) "À !„ ÂÃ!ˆ‚\"Ä !‰ÆYƒ\"ÂÃ!ˆ S‰‚ÇÈ \"‡" [vi-raw-numeric-prefix arg delete-indentation t vi-prefix-numeric-value count 2 vi-set-last-change-command vi-join-lines] 4 (#$ . 19426) "P"]) #@53 kill the current line. Only works in insert state. (defalias 'vi-backward-kill-line #[nil "…\nÁyˆÂÃ!‡" [vi-insert-state 0 kill-line nil] 2 (#$ . 19724) nil]) #@70 abort insert state, kill inserted text and go back to command state. (defalias 'vi-abort-ins #[nil "…` Vƒ `\"ˆÃÄ!‡" [vi-insert-state vi-ins-point kill-region vi-goto-command-state t] 3 (#$ . 19891) nil]) #@45 Backward COUNT windowfulls. Default is one. (defalias 'vi-backward-windowfull #[(count) "ÁV…ÂÃ!ˆS‰‚‡" [count 0 scroll-down nil] 3 (#$ . 20107) "p"]) #@152 Scrolls down window COUNT lines. If COUNT is nil (actually, non-integer), scrolls default amount. The given COUNT is remembered for future scrollings. (defalias 'vi-scroll-down-window #[(count) "¨ƒ !‡" [count vi-scroll-amount scroll-up] 2 (#$ . 20270) "P"]) #@72 Expose COUNT more lines below the current window. Default COUNT is 1. (defalias 'vi-expose-line-below #[(count) "À !‡" [scroll-up count] 2 (#$ . 20540) "p"]) #@44 Forward COUNT windowfulls. Default is one. (defalias 'vi-forward-windowfull #[(count) "ÁV…ÂÃ!ˆS‰‚‡" [count 0 scroll-up nil] 3 (#$ . 20705) "p"]) #@54 Go down count lines, try to keep at the same column. (defalias 'vi-next-line #[(count) "À` !†\n`UƒÄ ‡À‰‡" [next-line this-command line-move count ding last-command] 3 (#$ . 20863) "p"]) #@48 Go down COUNT lines. Stop at first non-white. (defalias 'vi-next-line-first-nonwhite #[(count) "`yˆÁ ˆ`U… ‡" [count back-to-indentation ding] 2 (#$ . 21061) "p"]) #@46 Go up COUNT lines. Stop at first non-white. (defalias 'vi-previous-line-first-nonwhite #[(count) "À !ˆÂ ‡" [previous-line count back-to-indentation] 2 (#$ . 21235) "p"]) #@150 Scrolls up window COUNT lines. If COUNT is nil (actually, non-integer), scrolls default amount. The given COUNT is remembered for future scrollings. (defalias 'vi-scroll-up-window #[(count) "¨ƒ !‡" [count vi-scroll-amount scroll-down] 2 (#$ . 21413) "P"]) #@72 Expose COUNT more lines above the current window. Default COUNT is 1. (defalias 'vi-expose-line-above #[(count) "À !‡" [scroll-down count] 2 (#$ . 21681) "p"]) #@155 Get following character (could be any CHAR) as part of the prefix argument. Possible prefix-arg cases are NIL, INTEGER, (NIL . CHAR) or (INTEGER . CHAR). (defalias 'vi-char-argument #[(arg) "À \n„à B‰‚\"\n¨ƒ\n B‰‚\"\n@ B‰)‡" [read-char char arg nil prefix-arg] 2 (#$ . 21849) "P"]) #@125 Go to marked position or line (if line-flag is given). Goto mark '@' means jump into and pop the top mark on the mark ring. (defalias 'vi-goto-mark #[(mark-char &optional line-flag) "À \n\"ƒà ˆ\f…CÅ ‡À Æ\"ƒ#ÇÈ!ˆ\f…CÅ ‡É !‰\n„4ËÌÍ \"‚BÇÎ!ˆ\nbˆ\f…BÅ )‡" [char-equal mark-char last-command-char exchange-point-and-mark line-flag back-to-indentation 64 set-mark-command t vi-get-mark mark message "Mark register undefined." vi-ding nil] 4 (#$ . 22148)]) #@58 Go to the line (at first non-white) marked by next char. (defalias 'vi-goto-line-mark #[(char) "À Â\"‡" [vi-goto-mark char t] 3 (#$ . 22614) "c"]) #@51 Go to the char position marked by next mark-char. (defalias 'vi-goto-char-mark #[(char) "À !‡" [vi-goto-mark char] 2 (#$ . 22767) "c"]) #@30 Set numeric prefix argument. (defalias 'vi-digit-argument #[(arg) "„Á!‡¨ƒÁÂ!ˆ _‰‡ÁÂ!ˆ @„%Ä‚'@_AB‰‡" [arg digit-argument nil prefix-arg 1] 2 (#$ . 22909) "P"]) #@55 Return the raw value of numeric part prefix argument. (defalias 'vi-raw-numeric-prefix #[(arg) ":ƒ@‡‡" [arg] 1 (#$ . 23089)]) #@148 Return numeric meaning of the raw prefix argument. This is a modification to the standard one provided in `callint.c' to handle (_ . CHAR) cases. (defalias 'vi-prefix-numeric-value #[(arg) "„Á‡¨ƒ ‡:…@ƒ@‡Á‡" [arg 1] 1 (#$ . 23227)]) #@118 Reverse last f F t T operation COUNT times. If the optional FIND-ARG is given, it is used instead of the saved one. (defalias 'vi-reverse-last-find-char #[(count &optional find-arg) "„ „ÂÃÄ \"‡Å@[AB\"‡" [find-arg vi-last-find-char message "No last find char to repeat." ding vi-find-char count] 3 (#$ . 23480) "p"]) #@144 Find in DIRECTION (1/-1) for CHAR of COUNT'th times on current line. If UPTO-FLAG is T, stop before the char. ARG = (DIRECTION.CHAR.UPTO-FLAG. (defalias 'vi-find-char #[(arg count) "@A@AA` \\Åƃ\fb‚Ç ,‡" [arg direction char upto-flag pos exit-find-char (byte-code "f„ ÁÂÃ\"ˆ‚DÄfÅ\"ƒÁÂÃ\"ˆ‚DÄf\"ƒDS‰ÈUƒDÁ ƒA\nZ‰‚B\"ˆ\n\\‰‚" [pos throw exit-find-char nil char-equal 10 char count 0 upto-flag direction] 5) ding] 2 (#$ . 23815)]) #@113 Repeat last f F t T operation COUNT times. If optional FIND-ARG is given, it is used instead of the saved one. (defalias 'vi-repeat-last-find-char #[(count &optional find-arg) "„ „ÂÃÄ \"‡Å\"‡" [find-arg vi-last-find-char message "No last find char to repeat." ding vi-find-char count] 3 (#$ . 24290) "p"]) #@50 Find the COUNT'th CHAR backward on current line. (defalias 'vi-backward-find-char #[(count char) "À ÂBBÄ !‡" [-1 char nil vi-last-find-char vi-repeat-last-find-char count] 3 (#$ . 24613) "p\nc"]) #@49 Find the COUNT'th CHAR forward on current line. (defalias 'vi-forward-find-char #[(count char) "À ÂBBÄ !‡" [1 char nil vi-last-find-char vi-repeat-last-find-char count] 3 (#$ . 24816) "p\nc"]) #@55 Find upto the COUNT'th CHAR backward on current line. (defalias 'vi-backward-upto-char #[(count char) "À ÂBBÄ !‡" [-1 char t vi-last-find-char vi-repeat-last-find-char count] 3 (#$ . 25016) "p\nc"]) #@54 Find upto the COUNT'th CHAR forward on current line. (defalias 'vi-forward-upto-char #[(count char) "À ÂBBÄ !‡" [1 char t vi-last-find-char vi-repeat-last-find-char count] 3 (#$ . 25222) "p\nc"]) #@92 Move forward until encountering the end of a word. With argument, do this that many times. (defalias 'vi-end-of-word #[(count) "m„ÀuˆÁÂÀÃ\f$…Å ‡" [nil re-search-forward "\\W*\\w+\\>" t count backward-char] 5 (#$ . 25425) "p"]) #@56 Replace char after point by CHAR. Repeat COUNT times. (defalias 'vi-replace-1-char #[(count char) "À Â\"ˆ Å !ˆÆÇ #‡" [delete-char count nil char last-command-char self-insert-command vi-set-last-change-command vi-replace-1-char] 4 (#$ . 25662) "p\nc"]) #@30 Replace chars over old ones. (defalias 'vi-replace-chars #[(arg) "ÀÁ!ˆÂ !‡" [overwrite-mode 1 vi-goto-insert-state arg] 2 (#$ . 25924) "*p"]) #@64 Substitute COUNT chars by the input chars, enter insert state. (defalias 'vi-substitute-chars #[(count) "ÀÁ DÄ#‡" [vi-goto-insert-state 1 #[(c) "``\\|‡" [c] 3] count t] 4 (#$ . 26072) "*p"]) #@56 Substitute COUNT lines by the input chars. (=cc in vi) (defalias 'vi-substitute-lines #[(count) "ÀÁÂÃ\fSEÅ#‡" [vi-goto-insert-state 1 vi-delete-op next-line count t] 5 (#$ . 26271) "*p"]) #@51 Get the char part of the current prefix argument. (defalias 'vi-prefix-char-value #[(arg) "„Á‡¨ƒ Á‡:ƒA‡Á‡" [arg nil] 1 (#$ . 26465)]) #@120 Handling vi operators (d/c//!/=/y). Current implementation requires the key bindings of the operators being fixed. (defalias 'vi-operator #[(arg) "ÀÁ‡" [vi-exit-op (byte-code " Ã\fÅ!\"‰Ç=„ ‚*Ç!ˆÂ Ã\fÅ!\"Ê \"ƒBË ÌÍ !SÎ !B#‚IË  #)‡" [last-command-char this-op-char read-char lookup-key vi-com-map char-to-string this-command vi-digit-argument arg prefix-arg char-equal vi-execute-op next-line vi-prefix-numeric-value vi-prefix-char-value] 7)] 2 (#$ . 26615) "P"]) #@120 Execute vi edit operator as specified by OP-CHAR, the operand is the region determined by the MOTION-COMMAND with ARG. (defalias 'vi-execute-op #[(op-char motion-command arg) "ÁUƒ \f\"…¬ÅÂÆ !\f#‡ÇUƒ- \f\"…¬ÈÉÂÆ !\fEÊ#‡ËUƒBÌ \f\"…¬ÅÌÆ !\f#‡ÍUƒYÎ \f\"…¬ÅÎÆ !\f$‡ÐUƒtÑ \f[#…¬ÅÑÆ !\f[$‡ÓUƒÑ \f#…¬ÅÑÆ !\f$‡ÔUƒ¢Õ \f\"…¬ÅÕÆ !\f#‡ÖU…¬× \f\"‡" [op-char 100 vi-delete-op motion-command arg vi-set-last-change-command vi-repeat-command-of 99 vi-goto-insert-state 1 nil 121 vi-yank-op 33 vi-shell-op vi-last-shell-command 60 vi-shift-op vi-shift-width 62 61 vi-indent-op 92 vi-narrow-op] 5 (#$ . 27116)]) #@48 Return the command for redo the given command. (defalias 'vi-repeat-command-of #[(command) "ÁN‰Ã=ƒÄ‚\nÅ=ƒÆ‚)‡" [command point-moving-unit cmd-type search vi-repeat-last-search find vi-repeat-last-find-char] 3 (#$ . 27752)]) #@158 Return (begin . end) of the range spanned by executing the given MOTION-COMMAND with ARG. MOTION-COMMAND in ready-to-eval list form is not yet supported. (defalias 'vi-effective-range #[(motion-command arg) "Š`À‰ ÂN`É À\"ˆ`\fUƒ) Ê=„)\f‰B‚ƒ Ë=ƒ7Ì †5``XƒC`‚I` Í=„U Î=ƒ[ T‚w Ê=ƒwbˆÏyˆ` bˆÐÑ!ˆÏyˆ` dVƒd B-‡" [nil motion-command point-moving-unit moving-unit opoint end begin arg prefix-arg command-execute line region mark match find 0 next-line 1] 5 (#$ . 27994)]) #@52 Delete range specified by MOTION-COMMAND with ARG. (defalias 'vi-delete-op #[(motion-command arg) "À \n\"‰@ AÆ\f U?…IÈ\n!‰„&É\f \"ˆ‚HÊYƒ@ËXƒ@Ì—\f Í$ˆ‚HÎ\f Í$ˆÍ,‡" [vi-effective-range motion-command arg range begin end nil reg vi-prefix-char-value kill-region 65 90 append-to-register t copy-to-register] 6 (#$ . 28507)]) #@64 Yank (in vi sense) range specified by MOTION-COMMAND with ARG. (defalias 'vi-yank-op #[(motion-command arg) "À \n\"‰@ AÆ\f U?…IÈ\n!‰„&É\f \"ˆ‚HÊYƒ@ËXƒ@Ì—\f Æ$ˆ‚HÍ\f Æ$ˆÎ,‡" [vi-effective-range motion-command arg range begin end nil reg vi-prefix-char-value copy-region-as-kill 65 90 append-to-register copy-to-register t] 6 (#$ . 28855)]) #@44 Yank (in vi sense) lines (= `yy' command). (defalias 'vi-yank-line #[(arg) "À !S !BÃÄ \"…ÅÃÄ #‡" [vi-prefix-numeric-value arg vi-prefix-char-value vi-yank-op next-line vi-set-last-change-command] 4 (#$ . 29221) "*P"]) #@118 See if STRING ends with a newline char. Used in checking whether the yanked text should be put back as lines or not. (defalias 'vi-string-end-with-nl-p #[(string) "‰GSHÁU‡" [string 10] 2 (#$ . 29450)]) #@210 Put yanked (in vi sense) text back before/above cursor. If a numeric prefix value (currently it should be >1) is given, put back text as lines. If the optional after-p is given, put after/below the cursor. (defalias 'vi-put-before #[(arg &optional after-p) "À !‰ƒ#\fÅW„\fÆVƒ#Ç\f!„#ÈÉ\f\"‚†\f„)Å\fÅYƒA\fÆXƒAÊ Ì\fÅZÍ\"‚RÇ\f!;ƒNÇ\f!‚RÈÎ\f\"Ï !ƒnƒhÑÒ!ˆÓyˆ‚vÓyˆ‚vƒvÒuˆÔ`!ˆ cˆÕ ˆÖ× #*‡" [vi-prefix-char-value arg nil put-text reg 49 57 get-register error "Nothing in register %c" yank this-command current-kill do-not-rotate "Register %c is not containing text string" vi-string-end-with-nl-p after-p next-line 1 0 push-mark exchange-point-and-mark vi-set-last-change-command vi-put-before] 5 (#$ . 29660) "P"]) #@56 Put yanked (in vi sense) text back after/below cursor. (defalias 'vi-put-after #[(arg) "À Â\"‡" [vi-put-before arg t] 3 (#$ . 30404) "P"]) #@229 Perform shell command (as filter). Performs command on range specified by MOTION-COMMAND with ARG. If SHELL-COMMAND is not given, ask for one from minibuffer. If char argument is given, it directs the output to a *temp* buffer. (defalias 'vi-shell-op #[(motion-command arg &optional shell-command) "À \n\"‰@ A\f U?…,„ ÇÈÉ\"‰\nË\f Ì\n!?$ˆÍ+‡" [vi-effective-range motion-command arg range begin end shell-command read-string "!" nil vi-last-shell-command shell-command-on-region vi-prefix-char-value t] 7 (#$ . 30550)]) #@202 Perform shift command on range specified by MOTION-COMMAND with ARG for AMOUNT on each line. Negative amount means shift left. SPECIAL FEATURE: char argument can be used to specify shift amount(1-9). (defalias 'vi-shift-op #[(motion-command arg amount) "À \n\"‰@ A\f U?…6Æ\n!ƒ.ÈVƒ'Æ\n!ÉZ‚,ÉÆ\n!ZÊ\f #ˆË+‡" [vi-effective-range motion-command arg range begin end vi-prefix-char-value amount 0 48 indent-rigidly t] 5 (#$ . 31087)]) #@71 Perform indent command on range specified by MOTION-COMMAND with ARG. (defalias 'vi-indent-op #[(motion-command arg) "À \n\"‰@ A\f U?…Æ\f Ç#ˆÈ+‡" [vi-effective-range motion-command arg range begin end indent-region nil t] 5 (#$ . 31536)]) #@56 Narrow to region specified by MOTION-COMMAND with ARG. (defalias 'vi-narrow-op #[(motion-command arg) "À \n\"‰@ AÆ\f U?…\f },‡" [vi-effective-range motion-command arg range begin end nil reg] 4 (#$ . 31786)]) #@70 Return contents of vi mark register named CHAR, or nil if undefined. (defalias 'vi-get-mark #[(char) " žA‡" [char vi-mark-alist] 2 (#$ . 32008)]) #@107 Set contents of vi mark register named CHAR to current point. '@' is the special anonymous mark register. (defalias 'vi-set-mark #[(char) "À Â\"ƒ ÃÄ!‡ ž‰ƒA`Ä“‚) Ç`!B‰ B‰)‡" [char-equal char 64 set-mark-command nil vi-mark-alist aelt copy-marker] 4 (#$ . 32162) "c"]) #@52 Locate the matching paren. It's a hack right now. (defalias 'vi-find-matching-paren #[nil "ÀÁ!ƒÂÃ!ˆÄÃ!‡ÀÅ!ƒÃuˆÆÃ!‡Ç ‡" [looking-at "[[({]" forward-sexp 1 backward-char "[])}]" backward-sexp ding] 2 (#$ . 32447) nil]) #@39 Backward COUNT blank-delimited words. (defalias 'vi-backward-blank-delimited-word #[(count) "ÀÁÂÃ\f$…o?…Åu‡" [re-search-backward "[ \n`][^ \n`]+" nil t count 1] 5 (#$ . 32675) "p"]) #@38 Forward COUNT blank-delimited words. (defalias 'vi-forward-blank-delimited-word #[(count) "ÀÁÂÃ\f$…m?…ÅÆ!‡" [re-search-forward "[^ \n]*[ \n]+[^ \n]" nil t count backward-char 1] 5 (#$ . 32869) "p"]) #@58 Forward to the end of the COUNT'th blank-delimited word. (defalias 'vi-end-of-blank-delimited-word #[(count) "ÀÁÂÃ\f$…m?…ÅÆ!‡" [re-search-forward "[^ \n']+[ \n']" nil t count backward-char 2] 5 (#$ . 33081) "p"]) #@59 To window home or arg'th line from the top of the window. (defalias 'vi-home-window-line #[(arg) "À S!ˆÂ ‡" [move-to-window-line arg back-to-indentation] 2 (#$ . 33306) "p"]) #@67 To window last line or arg'th line from the bottom of the window. (defalias 'vi-last-window-line #[(arg) "À [!ˆÂ ‡" [move-to-window-line arg back-to-indentation] 2 (#$ . 33487) "p"]) #@35 To the middle line of the window. (defalias 'vi-middle-window-line #[nil "ÀÁ!ˆÂ ‡" [move-to-window-line nil back-to-indentation] 2 (#$ . 33676) nil]) #@57 Stop at the beginning of the COUNT'th words from point. (defalias 'vi-forward-word #[(count) "ÀÁÂÃ\f$ƒ ÇŠ‡" [re-search-forward "\\w*\\W+\\<" nil t count vi-ding] 5 (#$ . 33832) "p"]) #@48 Set (FUN . ARGS) as the `last-change-command'. (defalias 'vi-set-last-change-command #[(fun &rest args) " B‰‡" [fun args vi-last-change-command] 2 (#$ . 34024)]) #@131 Redo last change command COUNT times. If the optional COMMAND is given, it is used instead of the current `last-change-command'. (defalias 'vi-redo-last-change-command #[(count &optional command) "„ „ÂÃ!‡\fÅV…\"Æ@A\"ˆ\fS‰‚‡" [command vi-last-change-command message "No last change command available." count 0 apply] 4 (#$ . 34195) "p"]) #@38 Kill COUNT chars from current point. (defalias 'vi-kill-char #[(count) "À Â\"ˆÃÀ Â#‡" [delete-char count t vi-set-last-change-command] 4 (#$ . 34552) "*p"]) #@233 Transpose objects. The following char specifies unit of objects to be transposed -- "c" for chars, "l" for lines, "w" for words, "s" for sexp, "p" for paragraph. For the use of the prefix-arg, refer to individual functions called. (defalias 'vi-transpose-objects #[(arg unit) "À Â\"ƒÃÄ!ˆÅ ÆÇ #ˆÀ É\"ƒ!Ê!‡À Ë\"ƒ/ÌÍ!!‡À Î\"ƒ=ÏÍ!!‡À Ð\"ƒKÑÍ!!‡À Ò\"ƒYÓÍ!!‡ÇÂ\"‡" [char-equal unit 63 message "Transpose: c(har), l(ine), p(aragraph), s(-exp), w(ord)," read-char vi-set-last-change-command vi-transpose-objects arg 99 transpose-chars 108 transpose-lines vi-prefix-numeric-value 112 transpose-paragraphs 115 transpose-sexps 119 transpose-words] 4 (#$ . 34716) "*P\nc"]) #@54 Query replace, use regexp version if ARG is non-nil. (defalias 'vi-query-replace #[(arg) "ƒÁ‚ ÂÄ Å\")‡" [arg query-replace-regexp query-replace rcmd call-interactively nil] 3 (#$ . 35407) "*P"]) #@56 Replace strings, use regexp version if ARG is non-nil. (defalias 'vi-replace #[(arg) "ƒÁ‚ ÂÄ Å\")‡" [arg replace-regexp replace-string rcmd call-interactively nil] 3 (#$ . 35613) "*P"]) #@59 Move current line to the top/center/bottom of the window. (defalias 'vi-adjust-window #[(arg position) "À Â\"ƒ ÃÄ!‡À Å\"ƒÃÆ!‡À Ç\"ƒ$ÃÈ É¥!‡ÊË!ˆÌ Í \"‡" [char-equal position 13 recenter 0 45 -1 46 window-height 2 message "Move current line to: \\r(top) -(bottom) .(middle)" read-char vi-adjust-window arg] 3 (#$ . 35810) "p\nc"]) #@41 Go to given column of the current line. (defalias 'vi-goto-column #[(col) "`Áyˆ\nÃVƒlƒÁ‰‚Ãuˆ\nS‰‚\nÃUƒ)Ä‚.bˆÅ )‡" [opoint 0 col 1 t ding] 3 (#$ . 36152) "p"]) #@206 Give name to the last change command or just defined kbd macro. If prefix ARG is given, name last macro, otherwise name last change command. The following CHAR will be the name for the command or macro. (defalias 'vi-name-last-change-or-macro #[(arg char) "ƒ\fÁÂÃ\f!!!‡ @Æ=ƒ7 A‰@A@{É8\nË8\fÍÎ\n\f$ˆ,ÂÃ\f!! M‡" [arg name-last-kbd-macro intern char-to-string char vi-last-change-command vi-first-redo-insertion args str 2 overwrite-p 3 prefix-code vi-set-last-change-command vi-more-redo-insertion] 6 (#$ . 36332) "P\nc"]) #@80 Execute COUNT times the keyboard macro definition named by the following CHAR. (defalias 'vi-call-named-change-or-macro #[(count char) "ÀÁ\n!!K;ƒÃÀÁ\n!!\f\"‡Å\fÀÁ\n!!K\"‡" [intern char-to-string char execute-kbd-macro count vi-redo-last-change-command] 5 (#$ . 36880) "p\nc"]) #@42 Change the case of the char after point. (defalias 'vi-change-case #[(arg) "ÀÁ‡" [exit (byte-code "ÀÁ!ƒÂ`` \\\"ˆ‚(ÀÄ!ƒ Å`` \\\"ˆ‚(Æ ˆÇÈÉ\"ˆÊË \"ˆ u‡" [looking-at "[a-z]" upcase-region arg "[A-Z]" downcase-region ding throw exit nil vi-set-last-change-command vi-change-case] 4)] 2 (#$ . 37165) "*p"]) #@80 Inquire status info. The next CHAR will specify the particular info requested. (defalias 'vi-ask-for-info #[(char) "À Â\"ƒ\nà ‡À Ä\"ƒÅ ‡À Æ\"ƒÇ ‡ÈÉ!ˆÊ Ë !‡" [char-equal char 108 what-line 99 what-cursor-position 112 what-page message "Ask for: l(ine number), c(ursor position), p(age number)" read-char vi-ask-for-info] 3 (#$ . 37478) "c"]) #@165 Mark region appropriately. The next char REGION is d(efun),s(-exp),b(uffer), p(aragraph), P(age), f(unction in C/Pascal etc.), w(ord), e(nd of sentence), l(ines). (defalias 'vi-mark-region #[(arg region) "À Â\"ƒ\nà ‡À Ä\"ƒÅ!‡À Ç\"ƒ È ‡À É\"ƒ*Ê ‡À Ë\"ƒ6Ì!‡À Í\"ƒ@Î ‡À Ï\"ƒLÐ!‡À Ñ\"ƒXÒ!‡À Ó\"ƒdÔ!‡ÕÖ!ˆ× Ø \"‡" [char-equal region 100 mark-defun 115 mark-sexp arg 98 mark-whole-buffer 112 mark-paragraph 80 mark-page 102 mark-c-function 119 mark-word 101 mark-end-of-sentence 108 vi-mark-lines message "Mark: d(efun),s(-exp),b(uf),p(arag),P(age),f(unct),w(ord),e(os),l(ines)" read-char vi-mark-region] 3 (#$ . 37832) "p\nc"]) #@56 Mark NUM of lines from current line as current region. (defalias 'vi-mark-lines #[(num) "ÀyˆÁ ˆ\n‡" [0 push-mark num] 1 (#$ . 38484)]) #@99 Verify spelling for the objects specified by char UNIT : [b(uffer), r(egion), s(tring), w(ord) ]. (defalias 'vi-verify-spelling #[(arg unit) " Ä\"ƒ ÅÆ!‡Â Ç\"ƒÅÈ!‡Â É\"ƒ#ÅÊ!‡Â Ë\"ƒ.ÅÌ!‡ÍÎ!ˆÏ Ð \"‡" [arg prefix-arg char-equal unit 98 call-interactively spell-buffer 114 spell-region 115 spell-string 119 spell-word message "Spell check: b(uffer), r(egion), s(tring), w(ord)" read-char vi-verify-spelling] 3 (#$ . 38626) "P\nc"]) #@69 This is a hack for accessing mode specific C-c commands in vi-mode. (defalias 'vi-do-old-mode-C-c-command #[(arg) "À ÂÃÄ !P\"ÆÇ…È ˆ \nË Ì\")‡" [lookup-key vi-mode-old-local-map "" char-to-string read-char cmd exit-vi-mode (byte-code "„ Á ˆÂ‡  ÇÂ\"ˆ)‡" [cmd ding nil vi-mode-old-case-fold case-fold-search arg prefix-arg command-execute] 3) vi-back-to-old-mode arg prefix-arg command-execute nil] 5 (#$ . 39069) "P"]) #@122 Quote ARG words from the word point is on with pattern specified by CHAR. Currently, CHAR could be [,{,(,",',`,<,*, etc. (defalias 'vi-quote-words #[(arg char) "ÀÁ !\"„ÄÅ!ˆÆ ‚ÇÈ #ˆÊË!„#Ìvˆ cˆÍ Î\"ƒ2Ï‚_Í Ð\"ƒ>Ñ‚_Í Ò\"ƒJÓ‚_Í Ô\"ƒVÕ‚_Í Ö\"ƒ_×Ø !ˆÙuˆ c‡" [string-match "[[({<\"'`*]" char-to-string char message "Enter any of [,{,(,<,\",',`,* as quoting character." read-char vi-set-last-change-command vi-quote-words arg looking-at "\\<" -1 char-equal 91 93 123 125 60 62 40 41 96 39 vi-end-of-word 1] 4 (#$ . 39507) "*p\nc"]) #@130 Locate definition in current file for the name before the point. It assumes a `(def..' always starts at the beginning of a line. (defalias 'vi-locate-def #[nil "ÀŠÂÃ!ˆÄÀwˆ`ÅÃ!ˆÀuˆÄÀxˆ`{)ÆÀ!ˆebˆÇÈ PÀÉ#?…7ÊË Ì #ˆÆÉ!)‡" [nil name vi-backward-blank-delimited-word 1 "^a-zA-Z" vi-end-of-blank-delimited-word set-mark-command re-search-forward "^(def[unvarconst ]*" t message "No definition for \"%s\" in current file." ding] 4 (#$ . 40061) nil]) #@83 Insert a newline and leave point before it. With ARG, inserts that many newlines. (defalias 'vi-split-open-line #[(arg) "ÀÁ DÄ#‡" [vi-goto-insert-state 1 #[(arg) "n…o?‰ƒÁuˆ\nÃVƒ'ŠÄcˆ ƒ cˆ)\nS‰‚…-Æu)‡" [flag -1 arg 0 10 fill-prefix 1] 3] arg t] 4 (#$ . 40511) "*p"]) emacs-19.30/lisp/view.elc100666 13437 1 31547 6055451313 13704 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 24 18:18:29 1995 ;;; from file /home/fsf/rms/e19/lisp/view.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`view.el' was compiled for Emacs 19.29 or later")) #@78 *The overlay face used for highlighting the match found by View mode search. (defvar view-highlight-face (quote highlight) (#$ . -466)) #@34 Non-nil if View mode is enabled. (defvar view-mode nil (#$ . 608)) (make-variable-buffer-local (quote view-mode)) #@65 Non-nil means scrolling past the end of buffer exits View mode. (defvar view-mode-auto-exit nil (#$ . 728)) (byte-code "ÀÁ!ˆÂÃ!„\fÄà BÀÃ!ˆÆ BÀÆ!ˆÂÇ!„%ÄÇ BÀÇ!ˆÂÈ!„6ÄÈ BÀÈ!ˆÂÉ!„GÄ É BÀÉ!ˆÂÊ!„XÄ\nÊ BÀÊ!ˆÂË!„iÄ Ë BÀË!‡" [make-variable-buffer-local view-mode-auto-exit boundp view-old-buffer-read-only nil current-load-list view-old-Helper-return-blurb view-scroll-size view-last-regexp view-exit-action view-return-here view-exit-position] 2) #@114 Overlay used to display where a search operation found its match. This is local in each buffer, once it is used. (defvar view-overlay nil (#$ . 1195)) (byte-code "ÀÁ!ˆÂ ž„Ä BÅÆ!„ÇÆB„áÉ Ê!ˆËÌÍ#ˆËÎÏ#ˆËÐÑ#ˆËÒÓ#ˆËÔÕ#ˆËÖÕ#ˆË×Ó#ˆËØÙ#ˆËÚÙ#ˆËÛÜ#ˆËÝÞ#ˆËßà#ˆËáâ#ˆËãä#ˆËåä#ˆËæç#ˆËèé#ˆËêé#ˆËëì#ˆËíî#ˆËïð#ˆËñò#ˆËóð#ˆËôò#ˆËõö#ˆË÷ø#ˆÂ9ž„ñÂB9B9LJ" [make-variable-buffer-local view-overlay view-mode minor-mode-alist (view-mode " View") boundp view-mode-map nil current-load-list make-keymap suppress-keymap define-key "q" view-exit "<" beginning-of-buffer ">" end-of-buffer "v" View-scroll-lines-backward "" View-scroll-lines-forward " " "" "\n" View-scroll-one-more-line " " "z" View-scroll-lines-forward-set-scroll-size "g" View-goto-line "=" what-line "." set-mark-command "'" View-back-to-mark "@" "x" exchange-point-and-mark "h" describe-mode "?" "s" isearch-forward "r" isearch-backward "/" View-search-regexp-forward "\\" View-search-regexp-backward "" "" "n" View-search-last-regexp-forward "p" View-search-last-regexp-backward minor-mode-map-alist] 4) #@381 View FILE in View mode, returning to previous buffer when done. 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. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-mode-hook'. (defalias 'view-file #[(file-name) "pÀ ! !Æ \f\"ˆÇ \f?…È !?…É\"+‡" [get-file-buffer file-name find-file-noselect buf-to-view had-a-buf old-buf switch-to-buffer view-mode-enter buffer-modified-p kill-buffer] 4 (#$ . 2330) "fView file: "]) #@394 View FILE in View mode in other window. Return to previous buffer when done. 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. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-mode-hook'. (defalias 'view-file-other-window #[(file-name) "À Á\n!Ã\n!Ç\f!ˆÈ ?… É\f!?… Ê\"+‡" [current-window-configuration get-file-buffer file-name find-file-noselect buf-to-view had-a-buf old-arrangement switch-to-buffer-other-window view-mode-enter buffer-modified-p kill-buffer] 4 (#$ . 2963) "fView file: "]) #@383 View BUFFER in View mode, returning to previous buffer when done. 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. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-mode-hook'. (defalias 'view-buffer #[(buffer-name) "pÁ\nÃ\"ˆÄÅ\")‡" [old-buf switch-to-buffer buffer-name t view-mode-enter nil] 3 (#$ . 3675) "bView buffer: "]) #@442 View BUFFER in View mode in another window. Return to previous buffer when done, unless NOT-RETURN is non-nil. 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. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-mode-hook'. (defalias 'view-buffer-other-window #[(buffer-name not-return) "…Á Ã\f!ˆÅ\n!)‡" [not-return current-window-configuration return-to switch-to-buffer-other-window buffer-name view-mode-enter] 2 (#$ . 4216) "bView buffer:\nP"]) #@1690 Toggle View mode. If you use this function to turn on View mode, "exiting" View mode does nothing except turn View mode off. The other way to turn View mode on is by calling `view-mode-enter'. Letters do not insert themselves. Instead these commands are provided. Most commands take prefix arguments. Commands dealing with lines default to "scroll size" lines (initially size of window). Search commands default to a repeat count of one. M-< or < move to beginning of buffer. M-> or > move to end of buffer. C-v or Space scroll forward lines. M-v or DEL scroll backward lines. CR or LF scroll forward one line (backward with prefix argument). z like Space except set number of lines for further scrolling commands to scroll by. C-u and Digits provide prefix arguments. `-' denotes negative argument. = prints the current line number. g goes to line given by prefix argument. / or M-C-s searches forward for regular expression \ or M-C-r searches backward for regular expression. n searches forward for last regular expression. p searches backward for last regular expression. C-@ or . set the mark. x exchanges point and mark. C-s or s do forward incremental search. C-r or r do reverse incremental search. @ or ' return to mark and pops mark ring. Mark ring is pushed at start of every successful search and when jump to line to occurs. The mark is set on jump to buffer start or end. ? or h provide help message (list of commands). \[help-command] provides help (list of commands or description of a command). C-n moves down lines vertically. C-p moves upward lines vertically. C-l recenters the screen. q exit view-mode and return to previous buffer. (defalias 'view-mode #[(&optional arg) "„ ?‚Â!ÃVÄ ‡" [arg view-mode prefix-numeric-value 0 force-mode-line-update] 2 (#$ . 4894) "P"]) #@187 Enter View mode, a Minor mode for viewing text but not editing it. See the function `view-mode' for more details. This function runs the normal hook `view-mode-hook'. \{view-mode-map} (defalias 'view-mode-enter #[(&optional prev-buffer action) "ÂÃ!… ÅÅÅÈÉÊ ƒ ËÊ !‚\"Ì \" Ñ ÓyˆÔÖ×!ˆØÙÚ!!‡" [buffer-read-only view-old-buffer-read-only boundp Helper-return-blurb view-old-Helper-return-blurb t view-mode-auto-exit view-mode format "continue viewing %s" buffer-file-name file-name-nondirectory buffer-name action view-exit-action prev-buffer view-return-here point-marker view-exit-position 0 nil goal-column run-hooks view-mode-hook message substitute-command-keys "Type \\[help-command] for help, \\[describe-mode] for commands, \\[view-exit] to quit."] 4 (#$ . 6732)]) #@172 Exit from view-mode. If you viewed an existing buffer, that buffer returns to its previous mode. If you viewed a file that was not present in Emacs, its buffer is killed. (defalias 'view-exit #[nil "À\nƒ\nÃ\n!ˆÄ ˆ …NÀbˆÀ‰“ˆp \n Ì !ƒ7Î !ˆ‚CÏ !ƒCÐ !ˆ\n…M\n !*‡" [nil view-mode view-overlay delete-overlay force-mode-line-update view-mode-auto-exit view-old-buffer-read-only buffer-read-only view-exit-position view-exit-action action viewed-buffer bufferp view-return-here switch-to-buffer window-configuration-p set-window-configuration] 3 (#$ . 7533) nil]) (defalias 'view-window-size #[nil "À S‡" [window-height] 1]) (defalias 'view-scroll-size #[nil "À †À ^‡" [view-window-size view-scroll-size] 2]) #@57 Normal hook run when starting to view a buffer or file. (defvar view-mode-hook nil (#$ . 8270)) #@116 Move to line LINE in View mode. Display is centered at LINE. Sets mark at starting position and pushes mark ring. (defalias 'View-goto-line #[(line) "À ˆÁ\n!ˆÃÄ Å¥!‡" [push-mark goto-line line recenter view-window-size 2] 3 (#$ . 8373) "p"]) #@203 Scroll forward in View mode, or exit if end of text is visible. No arg means whole window full, or number of lines set by \[View-scroll-lines-forward-set-scroll-size]. Arg is number of lines to scroll. (defalias 'View-scroll-lines-forward #[(&optional lines) "ƒ\nÁ!‚\f Ãd!ƒ ÄVƒ ƒ Æ ‡Ç Yƒ.ÈÉ!ˆ‚A[Ç Yƒ=ÊÉ!ˆ‚AÈ!ˆÃd!ƒPdbˆËÌÍ!!ˆÎÏ!ˆÄyˆÉ‡" [lines prefix-numeric-value view-scroll-size pos-visible-in-window-p 0 view-mode-auto-exit view-exit view-window-size scroll-up nil scroll-down message substitute-command-keys "End. Type \\[view-exit] to quit viewing." move-to-window-line -1] 3 (#$ . 8623) "P"]) #@487 Scroll forward LINES lines in View mode, setting the "scroll size". This is the number of lines which \[View-scroll-lines-forward] and \[View-scroll-lines-backward] scroll by default. The absolute value of LINES is used, so this command can be used to scroll backwards (but "scroll size" is always positive). If LINES is greater than window height or omitted, then window height is assumed. If LINES is less than window height then scrolling context is provided from previous screen. (defalias 'View-scroll-lines-forward-set-scroll-size #[(&optional lines) "„\nÁ ‚Ã!‰ÄVƒ‚[Á ^Å!‡" [lines view-window-size view-scroll-size prefix-numeric-value 0 View-scroll-lines-forward] 3 (#$ . 9247) "P"]) #@70 Scroll one more line up in View mode. With ARG scroll one line down. (defalias 'View-scroll-one-more-line #[(&optional arg) "À „ ‚\nÃ!‡" [View-scroll-lines-forward arg 1 -1] 2 (#$ . 9961) "P"]) #@169 Scroll backward in View mode. No arg means whole window full, or number of lines set by \[View-scroll-lines-forward-set-scroll-size]. Arg is number of lines to scroll. (defalias 'View-scroll-lines-backward #[(&optional lines) "À ƒ\f ![‚à [!‡" [View-scroll-lines-forward lines prefix-numeric-value view-scroll-size] 3 (#$ . 10165) "P"]) #@367 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. The variable `view-highlight-face' controls the face that is used for highlighting the match that is found. (defalias 'View-search-regexp-forward #[(n regexp) "À \nÚƒ\f\f‚ \n\"‡" [view-search n regexp "" view-last-regexp] 4 (#$ . 10512) "p\nsSearch forward (regexp): "]) #@384 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. The variable `view-highlight-face' controls the face that is used for highlighting the match that is found. (defalias 'View-search-regexp-backward #[(n regexp) "À [\nÚƒ \f‚\n\"‡" [View-search-regexp-forward n regexp "" view-last-regexp] 4 (#$ . 11051) "p\nsSearch backward (regexp): "]) #@269 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. The variable `view-highlight-face' controls the face that is used for highlighting the match that is found. (defalias 'View-search-last-regexp-forward #[(n) "À \n\"‡" [View-search-regexp-forward n view-last-regexp] 3 (#$ . 11624) "p"]) #@272 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. The variable `view-highlight-face' controls the face that is used for highlighting the match that is found. (defalias 'View-search-last-regexp-backward #[(n) "À \n\"‡" [View-search-regexp-backward n view-last-regexp] 3 (#$ . 12027) "p"]) #@165 Return to last mark set in View mode, else beginning of file. Displays line at center of window. Pops mark ring so successive invocations return to earlier marks. (defalias 'View-back-to-mark #[(&optional ignore) "ÀÁ!†ebˆÂ ˆÃÄ Å¥!‡" [mark t pop-mark recenter view-window-size 2] 3 (#$ . 12435) nil]) (defalias 'view-search #[(times regexp) "ÂŠÄ ÆWƒÆ‚Ç!ˆÈÂÉ $ƒ`) ƒVÊ ˆ bˆ ƒ:Ì Ɣƕ#ˆ‚BÍƔƕ\" Î Ï#ˆÆyˆÑÒ Ó¥!‚_ÔÕ #ˆÖ×!)‡" [regexp view-last-regexp nil where move-to-window-line times 0 -1 re-search-forward t push-mark view-overlay move-overlay make-overlay overlay-put face view-highlight-face recenter view-window-size 2 message "Can't find occurrence %d of %s" sit-for 4] 5]) (provide (quote view)) emacs-19.30/lisp/vip.elc100666 13437 13 171130 5773627545 13321 0ustar jimbuser;ELC ;;; compiled by kwzh@nutrimat.gnu.ai.mit.edu on Mon Jun 26 18:05:44 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/vip.el ;;; emacs version 19.29.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`vip.el' was compiled for Emacs 19.29 or later")) #@49 Local map used in emacs mode. (buffer specific) (defvar vip-emacs-local-map nil (#$ . 470)) #@58 Local map used in insert command mode. (buffer specific) (defvar vip-insert-local-map nil (#$ . 568)) (byte-code "ÀÁ!ˆÀÂ!‡" [make-variable-buffer-local vip-emacs-local-map vip-insert-local-map] 2) #@54 Remember insert point as a marker. (buffer specific) (defvar vip-insert-point nil (#$ . 771)) (byte-code "ÀÁ \"ˆÃÁ!‡" [set-default vip-insert-point make-marker make-variable-buffer-local] 3) #@51 Remember com point as a marker. (buffer specific) (defvar vip-com-point nil (#$ . 969)) (byte-code "ÀÁ \"ˆÃÁ!‡" [set-default vip-com-point make-marker make-variable-buffer-local] 3) #@57 Current mode. One of emacs-mode, vi-mode, insert-mode. (defvar vip-current-mode nil (#$ . 1158)) (byte-code "ÀÁ!ˆÂÁÃ\"‡" [make-variable-buffer-local vip-current-mode set-default emacs-mode] 3) #@57 value of mode-line-buffer-identification in emacs-mode. (defvar vip-emacs-mode-line-buffer-identification nil (#$ . 1358)) (byte-code "ÀÁ!ˆÂÁÃ\"‡" [make-variable-buffer-local vip-emacs-mode-line-buffer-identification set-default ("Emacs: %17b")] 3) #@84 vip-current-major-mode is the major-mode vi considers it is now. (buffer specific) (defvar vip-current-major-mode nil (#$ . 1613)) (make-variable-buffer-local (quote vip-current-major-mode)) #@42 last shell command executed by ! command (defvar vip-last-shell-com nil (#$ . 1810)) #@54 name of register to store deleted or yanked strings. (defvar vip-use-register nil (#$ . 1901)) #@102 If non-nil, it's value is a list (M-COM VAL COM), and is used to re-execute last destructive command (defvar vip-d-com nil (#$ . 2003)) #@51 *The number of colums shifted by > and < command. (defconst vip-shift-width 8 (#$ . -2145)) #@62 *If t then do regexp replace, if nil then do string replace. (defconst vip-re-replace nil (#$ . -2243)) #@48 The character remembered by the vi "r" command (defvar vip-d-char nil (#$ . 2353)) #@24 for use by ";" command (defvar vip-f-char nil (#$ . 2442)) #@24 for use by "." command (defvar vip-F-char nil (#$ . 2507)) #@24 for use by ";" command (defvar vip-f-forward nil (#$ . 2572)) #@24 for use by ";" command (defvar vip-f-offset nil (#$ . 2640)) #@28 *if t, search wraps around (defconst vip-search-wrap-around t (#$ . -2707)) #@60 *if t, search is reg-exp search, otherwise vanilla search. (defconst vip-re-search nil (#$ . -2789)) #@20 last search string (defvar vip-s-string nil (#$ . 2896)) #@26 if t, search is forward. (defvar vip-s-forward nil (#$ . 2959)) #@30 *if t, search ignores cases. (defconst vip-case-fold-search nil (#$ . -3029)) #@62 *If t then do regexp replace, if nil then do string replace. (defconst vip-re-query-replace nil (#$ . -3113)) #@37 *if t, indent when open a new line. (defconst vip-open-with-indent nil (#$ . -3229)) #@106 *if t then C-h is bound to help-command in insert mode, if nil then it is bound to delete-backward-char. (defconst vip-help-in-insert-mode nil (#$ . -3321)) #@44 string inserted at the beginning of region (defvar vip-quote-string "> " (#$ . 3484)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÆÇÈ\"‡" [boundp vip-tags-file-name "TAGS" current-load-list vip-inhibit-startup-message nil global-set-key "" vip-change-mode-to-vi] 3) #@40 (COUNT BODY) Execute BODY COUNT times. (defalias 'vip-loop '(macro . #[(count body) "ÀÁ DCÂÃÁÄE ÆÁÇÁDEFE‡" [let count while > 0 body setq 1-] 9 (#$ . 3749)])) #@86 Set mark at LOCATION (point, by default) and push old mark on mark ring. No message. (defalias 'vip-push-mark-silent #[(&optional location) "ÀÁ!ƒ#Âà !\fB‰G Vƒ# \f›@Ɖ“ˆ S\f›Æ¡ˆÇ†*`!‡" [mark t copy-marker mark-marker mark-ring mark-ring-max nil set-mark location] 4 (#$ . 3914)]) #@21 Go to ARG's column. (defalias 'vip-goto-col #[(arg) "À ! !ŠÅˆ\fiTVƒÆÇ!ˆ) ƒ\"`Å“ˆÉyˆ\fSuˆ …2ÊË\f #*‡" [vip-p-val arg vip-getcom com val nil error "" vip-com-point 0 vip-execute-com vip-goto-col] 4 (#$ . 4205) "P"]) (defalias 'vip-copy-keymap #[(map) "„Á ‡Â!‡" [map make-sparse-keymap copy-keymap] 2]) #@71 Change mode to NEW-MODE---either emacs-mode, vi-mode, or insert-mode. (defalias 'vip-change-mode #[(new-mode) " =†£Â=ƒ7 Ã=ƒÄ` \"ˆÆ ˆ‚+Ç  \nËÇ !\fÍÎ!ˆÏ!ˆ‚ŸÃ=ƒ `Ñ“ˆ Ò=ƒYÇ  \nËÇ !\f‚_Ë!\fÍÓ!ˆÏ\f!ˆÔ\fÕÖ#ˆÔ\f×Ø#ˆÔ\fÙƒƒÛ‚„Ü#ˆÔ\fÝÞ#ˆ‚ŸÒ=ƒŸÍß!ˆÏ!ˆà ‡" [new-mode vip-current-mode vi-mode insert-mode vip-copy-region-as-kill vip-insert-point vip-repeat-insert-command current-local-map vip-emacs-local-map mode-line-buffer-identification vip-emacs-mode-line-buffer-identification vip-copy-keymap vip-insert-local-map vip-change-mode-line "Vi: " use-local-map vip-mode-map nil emacs-mode "Insert" define-key "" vip-change-mode-to-vi "" vip-ESC "" vip-help-in-insert-mode help-command delete-backward-char "" vip-delete-backward-word "Emacs:" force-mode-line-update] 4 (#$ . 4525)]) #@74 If BEG and END do not belong to the same buffer, it copies empty region. (defalias 'vip-copy-region-as-kill #[(beg end) "ÀÁ‡" [nil (copy-region-as-kill beg end) ((error (byte-code "À ‰\"‡" [copy-region-as-kill beg] 3)))] 3 (#$ . 5352)]) #@117 Assuming that the mode line format contains the string "Emacs:", this function replaces the string by "Vi: " etc. (defalias 'vip-change-mode-line #[(string) "Á˜ƒ\n\n‚ÃPC‰‡" [string "Emacs:" vip-emacs-mode-line-buffer-identification " %17b" mode-line-buffer-identification] 2 (#$ . 5598)]) #@30 Turn on VIP emulation of VI. (defalias 'vip-mode #[nil "„?ÁÂ!ˆÃ ˆÄcˆebˆÅÆ!ƒ5ŠÇÈÉ!!qˆdbˆÊcˆË ˆÌp!ˆ)ÍÎ!ˆÏÐ!ˆÌp!ˆÍÑ!ˆÒÓ ‡" [vip-inhibit-startup-message switch-to-buffer "VIP Startup Message" erase-buffer "VIP is a Vi emulation package for GNU Emacs. VIP provides most Vi commands\nincluding Ex commands. VIP is however different from Vi in several points.\nYou can get more information on VIP by:\n 1. Typing `M-x info' and selecting menu item \"vip\".\n 2. Typing `C-h k' followed by a key whose description you want.\n 3. Printing VIP manual which can be found as GNU/man/vip.texinfo\n 4. Printing VIP Reference Card which can be found as GNU/etc/vipcard.tex\n\nThis startup message appears whenever you load VIP unless you type `y' now.\nType `n' to quit this window for now.\n" y-or-n-p "Inhibit VIP startup message? " find-file-noselect substitute-in-file-name "~/.vip" "\n(setq vip-inhibit-startup-message t)\n" save-buffer kill-buffer message "VIP startup message inhibited." sit-for 2 "" t vip-change-mode-to-vi] 3 (#$ . 5901) nil]) #@25 Change mode to vi mode. (defalias 'vip-change-mode-to-vi #[nil "ÀÁ!‡" [vip-change-mode vi-mode] 2 (#$ . 6967) nil]) #@29 Change mode to insert mode. (defalias 'vip-change-mode-to-insert #[nil "ÀÁ!‡" [vip-change-mode insert-mode] 2 (#$ . 7089) nil]) #@28 Change mode to emacs mode. (defalias 'vip-change-mode-to-emacs #[nil "ÀÁ!‡" [vip-change-mode emacs-mode] 2 (#$ . 7223) nil]) #@178 Escape to Emacs mode for one Emacs command. ARG is used as the prefix value for the executed command. If EVENTS is a list of events, which become the beginning of the command. (defalias 'vip-escape-to-emacs #[(arg &optional events) "À‰Á  ƒ É\n!ˆËŽÌÍÀ!‰!)Î\f\"ˆÀ‰+‡" [nil current-local-map old-map key com events unread-command-events arg prefix-arg use-local-map vip-emacs-local-map ((use-local-map old-map)) key-binding read-key-sequence command-execute] 3 (#$ . 7355) "P"]) #@32 Print CONDITIONS as a message. (defalias 'vip-message-conditions #[(conditions) "@A „ÃÄ\n\"ˆ‚ÃÅ\nÆ !#ˆÇ *‡" [conditions msg case message "%s" "%s %s" prin1-to-string ding] 5 (#$ . 7856)]) #@32 Emulate ESC key in Emacs mode. (defalias 'vip-ESC #[(arg) "À Â\"‡" [vip-escape-to-emacs arg (27)] 3 (#$ . 8058) "P"]) #@32 Emulate C-c key in Emacs mode. (defalias 'vip-ctl-c #[(arg) "À Â\"‡" [vip-escape-to-emacs arg (3)] 3 (#$ . 8182) "P"]) #@32 Emulate C-x key in Emacs mode. (defalias 'vip-ctl-x #[(arg) "À Â\"‡" [vip-escape-to-emacs arg (24)] 3 (#$ . 8307) "P"]) #@32 Emulate C-h key in Emacs mode. (defalias 'vip-ctl-h #[(arg) "À Â\"‡" [vip-escape-to-emacs arg (8)] 3 (#$ . 8433) "P"]) #@135 Compute numeric prefix arg value. Invoked by CHAR. VALUE is the value obtained so far, and COM is the command part obtained so far. (defalias 'vip-prefix-arg-value #[(char value com) "ÁYƒ$ÂXƒ$ §ƒ ‚ÄÅ_ÁZ\\Æ ‰‚ ƒ3BÉUƒEÊ!ˆÆ ‰‚4C‰ ‡" [char 48 57 value 0 10 read-char prefix-arg com 85 vip-describe-arg unread-command-events] 4 (#$ . 8559)]) #@33 Vi operator as prefix argument. (defalias 'vip-prefix-arg-com #[(char value com) "À ƒü\nÃU„H\nÄU„H\nÅU„H\nÆU„H\nÇU„H\nÈU„H\nÉU„H\nÊU„H\nËU„H\nÌU„H\nÍUƒüƒi\nÊU„Y\nÍUƒ]ÏÐ!ˆ\nBщ‚\nÆU„u\nÉUƒ\nÒ щ‚\nÊUƒ–Ò Ó\\Ò щ‚\nÇU„¢\nÈUƒ»\nÒ \nUƒµ\nBщ‚\nÍUƒóÒ ÕXƒÓÖX„á×XƒèØXƒè‚ìÏÐ!ˆÒ )‚\nÒ ‚):„\"B\nÜUƒÝ!ˆÒ ‰‚ \nC‰‡@ËU„2@ÌUƒ[@AB\nËUƒPß!ˆ‚Uà!ˆÑ‰*‡„dá‚fÑ⚃yãäB!‡嚃‡ãæB!‡皃‘è ‡隃ŸãêB!‡뚃­ãÇB!‡욃»ãÈB!‡횃ÉãÆB!‡×ãÉB!‡ÏÐ!‡" [t cont char 99 100 121 33 60 62 61 35 114 82 34 com error "" nil read-char 128 reg 65 122 49 57 vip-use-register value prefix-arg 85 vip-describe-arg unread-command-events vip-region vip-Region 1 (99 . 99) vip-line 67 (100 . 100) 68 (100 . 121) vip-yank-defun (121 . 121) 89 (60 . 60) (62 . 62) (33 . 33) (61 . 61)] 4 (#$ . 8936)]) (defalias 'vip-describe-arg #[(arg) "À‰Ã\f!Å\f!\n„! „ÆÇ!‚1ÆÈ \"‚1 „,ÆÉ\n\"‚1ÆÊ\n #*‡" [nil com val vip-P-val arg vip-getcom message "Value is nil, and command is nil." "Value is nil, and command is %c." "Value is %d, and command is nil." "Value is %d, and command is %c."] 4]) #@46 Begin numeric argument for the next command. (defalias 'vip-digit-argument #[(arg) "À  :…\n A#‡" [vip-prefix-arg-value last-command-char nil arg] 4 (#$ . 10152) "P"]) #@41 Accept a motion command as an argument. (defalias 'vip-command-argument #[(arg) "ÀÁ‡" [conditions (byte-code "À \n„\n \n:ƒ\n@‚ \n§ƒ\n‚ ÄÅ!\n„(Â>\n:ƒ2\nA‚>\n§ƒ;Â>ÄÅ!#‡" [vip-prefix-arg-com last-command-char arg nil error "strange arg"] 5) ((quit (byte-code "ÀÂÃÀ\"‡" [nil vip-use-register signal quit] 3)))] 3 (#$ . 10327) "P"]) #@40 Get value part of prefix-argument ARG. (defalias 'vip-p-val #[(arg) "„Á‡:ƒ@„Á‡@‡‡" [arg 1] 1 (#$ . 10682)]) #@40 Get value part of prefix-argument ARG. (defalias 'vip-P-val #[(arg) ":ƒ@‡‡" [arg] 1 (#$ . 10807)]) #@38 Get com part of prefix-argument ARG. (defalias 'vip-getcom #[(arg) "„Á‡:ƒA‡Á‡" [arg nil] 1 (#$ . 10917)]) #@52 Get com part of prefix-argument ARG and modify it. (defalias 'vip-getCom #[(arg) "À !‰ÚƒÄ‚#\nÅšƒÆ‚#\nÇšƒ\"È‚#\n)‡" [vip-getcom arg com 99 67 100 68 121 89] 3 (#$ . 11036)]) #@102 Append region to text in register REG. START and END are buffer positions indicating what to append. (defalias 'vip-append-to-register #[(reg start end) "À  !† Ã\f {P\"‡" [set-register reg get-register "" start end] 5 (#$ . 11226)]) #@112 (M-COM VAL COM) Execute command COM. The list (M-COM VAL COM) is set to vip-d-com for later use by vip-repeat (defalias 'vip-execute-com #[(m-com val com) "\nƒ \nÃUƒÄ `\"ˆ‚ \nÆUƒ\"Ç `\"ˆ‚ \nÈU„.\nÉUƒŠÊ !ˆËÌ `\"ˆƒtÍXƒTÎXƒTÏÌ `Ð$ˆ‚rÑXƒlÒXƒlÓÔ\\Ì `#ˆ‚rÐÕÖ!ˆÐÌ `|ˆ)×Ø!ˆ\nÈUƒŠÙ ˆ‚ Ú ˆ‚ \nÛUƒäƒÏÍXƒ°ÎXƒ°Ï `Ð$ˆ‚ÍÑXƒÇÒXƒÇÓÔ\\ `#ˆ‚ÍÐÕÖ!ˆÐÝ=…×ÞÞ `\"ˆÝ‚ \nàUƒQŠÊ !ˆËÌ `\"ˆƒ0ÍXƒÎXƒÏÌ `Ð$ˆ‚.ÑXƒ(ÒXƒ(ÓÔ\\Ì `#ˆ‚.ÐÕÖ!ˆÐá=…8ÞÞÌ `\"ˆ\"ã=ƒJá)ä ˆ‚ \nåUƒžƒÍXƒqÎXƒqÏ `Ð$ˆ‚ŽÑXƒˆÒXƒˆÓÔ\\ `#ˆ‚ŽÐÕÖ!ˆÐÐæ `\"ˆ bˆ‚ \nçUƒúŠÊ !ˆËÌ `\"ˆƒêÍXƒÊÎXƒÊÏÌ `Ð$ˆ‚èÑXƒâÒXƒâÓÔ\\Ì `#ˆ‚èÐÕÖ!ˆÐÐæÌ `\"ˆ) bˆ‚ \nèU„\néUƒ-ŠÊ !ˆËÌ `\"ˆêÌ `\nèUƒ$ëì!‰-‚&-î$ˆ)‚ \nïUƒSŠÊ !ˆËÌ `\"ˆÌ `VƒHð ˆñÌ `Ð#ˆ)‚ \nòUƒtŠÊ !ˆËÌ `\"ˆóÌ `4[#ˆ) bˆ‚ \nõUƒ”ŠÊ !ˆËÌ `\"ˆóÌ `4#ˆ) bˆ‚ \nöYƒ ÷\nöZ!ˆ\"8\nÃU„¶\nÈU„¶\nèUƒ»\n[‚¼\n F‰9)‡" [vip-use-register reg com 99 vip-change vip-com-point -99 vip-change-subr 67 -67 set-mark vip-enlarge-region mark 97 122 copy-to-register nil 65 90 vip-append-to-register 32 error "" open-line 1 vip-change-mode-to-insert yank 100 last-command d-command kill-region this-command 68 D-command m-com vip-line back-to-indentation 121 copy-region-as-kill 89 33 -33 shell-command-on-region vip-read-string "!" vip-last-shell-com t 61 exchange-point-and-mark indent-region 60 indent-rigidly vip-shift-width 62 128 vip-special-prefix-com val vip-d-com] 5 (#$ . 11468)]) #@256 (ARG) Re-execute last destructive command. vip-d-com has the form (COM ARG CH REG), where COM is the command to be re-executed, ARG is the argument for COM, CH is a flag for repeat, and REG is optional and if exists is the name of the register for COM. (defalias 'vip-repeat #[(arg) "Á=ƒ  ‡ @Ä ! AA@Æ 8 \n „' A@ \n„0ËÌ!ˆ \n B!,‡" [last-command vip-undo vip-undo-more vip-d-com vip-P-val arg 3 reg com val m-com error "No previous command to repeat." vip-use-register] 5 (#$ . 12947) "P"]) #@67 This command is invoked interactively by the key sequence # (defalias 'vip-special-prefix-com #[(char) "ÁUƒ `^ `]\"‡ÄUƒÅ `^ `]\"‡ÆUƒ+Ç !ˆÈ ‡ÉUƒ8Ç !ˆÊ ‡ËU…BÌ `\"‡" [char 99 downcase-region vip-com-point 67 upcase-region 103 set-mark vip-global-execute 113 vip-quote-region 115 spell-region] 4 (#$ . 13465)]) #@23 Undo previous change. (defalias 'vip-undo #[nil "ÀÁ!ˆÂ ˆÃÄ!ˆÅ‰‡" [message "undo!" undo-start undo-more 2 vip-undo this-command] 2 (#$ . 13797) nil]) #@36 Continue undoing previous changes. (defalias 'vip-undo-more #[nil "ÀÁ!ˆÂÃ!ˆÄ‰‡" [message "undo more!" undo-more 1 vip-undo this-command] 2 (#$ . 13954)]) (defalias 'vip-string-tail #[(str) "?†Á˜?…ÂÃO‡" [str "" 1 nil] 3]) (defalias 'vip-yank-defun #[nil "À ˆÁ` \"‡" [mark-defun copy-region-as-kill mark] 3]) #@37 Enlarge region between BEG and END. (defalias 'vip-enlarge-region #[(beg end) " WƒbˆÂ !ˆ‚ bˆÂ!ˆÃyˆÄ ˆmƒ%n„)ÅÆ!ˆÃyˆ V…4Ä ‡" [beg end set-mark 0 exchange-point-and-mark next-line 1] 2 (#$ . 14276)]) #@54 Call last keyboad macro for each line in the region. (defalias 'vip-global-execute #[nil "`À Vƒ\nÁ ˆÂyˆÃ ˆ`À W…#ÄyˆÂyˆÃ ˆ‚‡" [mark exchange-point-and-mark 0 call-last-kbd-macro 1] 2 (#$ . 14490)]) #@97 Quote region by inserting the user supplied string at the beginning of each line in the region. (defalias 'vip-quote-region #[nil "ÀÁ \"!‰Řƒ ‚\f)Æ`Ç \"ˆ`Ç Vƒ$È ˆ cˆÉyˆÊyˆ`Ç W…Dn…D cˆÉyˆÊyˆ‚-‡" [vip-read-string format "quote string (default \"%s\"): " vip-quote-string str "" vip-enlarge-region mark exchange-point-and-mark 0 1] 5 (#$ . 14697)]) #@42 Check if the string ends with a newline. (defalias 'vip-end-with-a-newline-p #[(string) "Á˜† \n‰GSHÃU‡" [text "" string 10] 2 (#$ . 15060)]) (defalias 'vip-read-string #[(prompt &optional init) "À !à ÄÅ#ˆÃ ÆÇ#ˆÃ ÈÉ#ˆÊ ÌÍΈ\n )‡" [copy-keymap minibuffer-local-map save-minibuffer-local-map define-key "" backward-char "" backward-word "" exit-minibuffer nil str conditions (byte-code "À \n\"À‡" [read-string prompt init str] 3) ((quit (byte-code "ÂÃÄ\"‡" [save-minibuffer-local-map minibuffer-local-map signal quit nil] 3)))] 4]) #@182 This function is called when mode changes from insertion mode to vi command mode. It will repeat the insertion command if original insertion command was invoked with argument > 1. (defalias 'vip-repeat-insert-command #[nil "@A@ …! ÃV…!\n SÄEÅÆ!ˆ\n ÄE‰*‡" [vip-d-com val i-com 1 114 vip-repeat nil] 3 (#$ . 15609)]) #@2  (defalias 'vip-insert #[(arg) "À ! !Å\fÆE ƒ+\f‰ÉV…'Ê ˆS‰‚)‚-Ë *‡" [vip-p-val arg vip-getcom com val vip-insert 114 vip-d-com count 0 yank vip-change-mode-to-insert] 4 (#$ . 15938) "P"]) #@21 Append after point. (defalias 'vip-append #[(arg) "À ! !Å\fÆEl„Èuˆ Æšƒ4\f‰ ÊV…0Ë ˆ S‰ ‚)‚6Ì *‡" [vip-p-val arg vip-getcom com val vip-append 114 vip-d-com nil count 0 yank vip-change-mode-to-insert] 4 (#$ . 16147) "P"]) #@24 Append at end of line. (defalias 'vip-Append #[(arg) "À ! !Å\fÆEȈ Æšƒ0\f‰ ÊV…,Ë ˆ S‰ ‚)‚2Ì *‡" [vip-p-val arg vip-getcom com val vip-Append 114 vip-d-com nil count 0 yank vip-change-mode-to-insert] 4 (#$ . 16388) "P"]) #@32 Insert before first non-white. (defalias 'vip-Insert #[(arg) "À ! !Å\fÆEÈ ˆ Æšƒ0\f‰ ÊV…,Ë ˆ S‰ ‚)‚2Ì *‡" [vip-p-val arg vip-getcom com val vip-Insert 114 vip-d-com back-to-indentation count 0 yank vip-change-mode-to-insert] 4 (#$ . 16628) "P"]) #@18 Open line below. (defalias 'vip-open-line #[(arg) "À ! !Å\fÆEÈ  ÆšƒA\f‰\nËV…=̈ÍÎ!ˆƒ1 jˆÐ ˆ\nS‰\n‚)‚S̈ÍÎ!ˆƒQ jˆÑ +‡" [vip-p-val arg vip-getcom com val vip-open-line 114 vip-d-com current-indentation col count 0 nil newline 1 vip-open-with-indent yank vip-change-mode-to-insert] 4 (#$ . 16892) "P"]) #@18 Open line above. (defalias 'vip-Open-line #[(arg) "À ! !Å\fÆEÈ  ÆšƒA\f‰\nËV…=ËyˆÌÍ!ˆƒ1 jˆÏ ˆ\nS‰\n‚)‚SËyˆÌÍ!ˆƒQ jˆÐ +‡" [vip-p-val arg vip-getcom com val vip-Open-line 114 vip-d-com current-indentation col count 0 open-line 1 vip-open-with-indent yank vip-change-mode-to-insert] 4 (#$ . 17223) "P"]) #@21 Open line at point. (defalias 'vip-open-line-at-point #[(arg) "À ! !Å\fÆE Æšƒ1\f‰ÉV…-ÊË!ˆÌ ˆS‰‚)‚7ÊË!ˆÍ *‡" [vip-p-val arg vip-getcom com val vip-open-line-at-point 114 vip-d-com count 0 open-line 1 yank vip-change-mode-to-insert] 4 (#$ . 17552) "P"]) #@24 Substitute characters. (defalias 'vip-substitute #[(arg) "À ! !ŠÅ`!ˆ\fuˆ ÆšƒÇÈ `\"ˆ‚%ÉÈ `\"ˆ)Ê\fÆE‰ *‡" [vip-p-val arg vip-getcom com val set-mark 114 vip-change-subr mark vip-change vip-substitute vip-d-com] 3 (#$ . 17826) "P"]) #@19 Substitute lines. (defalias 'vip-substitute-line #[(arg) "À ÂB!‡" [vip-line arg 67] 3 (#$ . 18069) "p"]) (defalias 'vip-line #[(arg) "@A `Ä“ˆÅ\nS!ˆÆÇ\n #*‡" [arg com val vip-com-point nil next-line vip-execute-com vip-line] 4]) #@32 Yank ARG lines (in vi's sense) (defalias 'vip-yank-line #[(arg) "À !Ã\nÄB!)‡" [vip-p-val arg val vip-line 89] 3 (#$ . 18307) "P"]) (defalias 'vip-region #[(arg) "À ! ! `Æ“ˆÇ ˆÈÉ\f #*‡" [vip-P-val arg vip-getcom com val vip-com-point nil exchange-point-and-mark vip-execute-com vip-region] 4 nil "P"]) (defalias 'vip-Region #[(arg) "À ! ! `Æ“ˆÇ ˆÈÉ\f #*‡" [vip-P-val arg vip-getCom com val vip-com-point nil exchange-point-and-mark vip-execute-com vip-Region] 4 nil "P"]) #@56 Replace the following ARG chars by the character read. (defalias 'vip-replace-char #[(arg) "À ! !Å\fÆEÈ Æšƒ ‚Ê \f\"*‡" [vip-p-val arg vip-getcom com val vip-replace-char 114 vip-d-com vip-replace-char-subr vip-d-char read-char] 3 (#$ . 18791) "P"]) (defalias 'vip-replace-char-subr #[(char arg) "À Â\"ˆ  ÅVƒ ‚ [‰ÅVƒ' cˆS‰‚)Ç !‡" [delete-char arg t char vip-d-char 0 count backward-char] 4]) #@152 Replace string. If you supply null string as the string to be replaced, the query replace mode will toggle between string replace and regexp replace. (defalias 'vip-replace-string #[nil "À ƒ Ä‚\fÅ!‰Ƙƒ( ?ÇÈÉ ƒ\"Ê‚#Ë\"!‚K ƒBÌ ÀÍ#…KÎÂÈÏ \"!À‰#ˆ‚,Ð ÂÈÑ \"!\")‡" [nil str vip-read-string vip-re-replace "Replace regexp: " "Replace string: " "" message format "Replace mode changed to %s." "regexp replace" "string replace" re-search-forward t replace-match "Replace regexp \"%s\" with: " replace-string "Replace \"%s\" with: "] 7 (#$ . 19213) nil]) #@106 Move point right ARG characters (left if ARG negative).On reaching end of buffer, stop and signal error. (defalias 'vip-forward-char #[(arg) "À ! ! ƒ `Æ“ˆ\fuˆ …ÇÈ\f #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil vip-execute-com vip-forward-char] 4 (#$ . 19779) "P"]) #@114 Move point left ARG characters (right if ARG negative). On reaching beginning of buffer, stop and signal error. (defalias 'vip-backward-char #[(arg) "À ! ! ƒ `Æ“ˆÇ\f!ˆ …ÈÉ\f #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil backward-char vip-execute-com vip-backward-char] 4 (#$ . 20070) "P"]) #@15 Forward word. (defalias 'vip-forward-word #[(arg) "À ! ! ƒ `Æ“ˆ\fvˆÇÆwˆ …K ÈU„( ÉUƒ/ÊË!ˆËvˆ ÌU„; ÍUƒFÊË!ˆËvˆÎÆwˆÏÐ\f #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil " \n" 99 -99 backward-word 1 100 121 " " vip-execute-com vip-forward-word] 4 (#$ . 20385) "P"]) #@36 Move point to end of current word. (defalias 'vip-end-of-word #[(arg) "À ! ! ƒ `Æ“ˆÆuˆ\fvˆÇ ˆ …&ÆuˆÈÉ\f #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil backward-char vip-execute-com vip-end-of-word] 4 (#$ . 20673) "P"]) #@16 Backward word. (defalias 'vip-backward-word #[(arg) "À ! ! ƒ `Æ“ˆÇ\f!ˆ …ÈÉ\f #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil backward-word vip-execute-com vip-backward-word] 4 (#$ . 20914) "P"]) #@44 Forward word delimited by white character. (defalias 'vip-forward-Word #[(arg) "À ! ! ƒ `Æ“ˆÇÈÆÉ\f$ˆ …K ÊU„( ËUƒ/ÌÍ!ˆÍvˆ ÎU„; ÏUƒFÌÍ!ˆÍvˆÐÆwˆÑÒ\f #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil re-search-forward "[^ \n]*[ \n]+" t 99 -99 backward-word 1 100 121 " " vip-execute-com vip-forward-Word] 5 (#$ . 21131) "P"]) #@59 Move forward to end of word delimited by white character. (defalias 'vip-end-of-Word #[(arg) "À ! ! ƒ `Æ“ˆÆuˆÇÈÆÉ\f$ƒ Ê ˆ …,ÆuˆËÌ\f #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil re-search-forward "[^ \n]+" t backward-char vip-execute-com vip-end-of-Word] 5 (#$ . 21479) "P"]) #@45 Backward word delimited by white character. (defalias 'vip-backward-Word #[(arg) "À ! ! ƒ `Æ“ˆÇÈÆÉ\f$ƒ Æuˆ‚#ebˆ …,ÊË\f #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil re-search-backward "[ \n]+[^ \n]+" t vip-execute-com vip-backward-Word] 5 (#$ . 21780) "P"]) #@26 Go to beginning of line. (defalias 'vip-beginning-of-line #[(arg) "À ! ! ƒ `Æ“ˆÇ\f!ˆ …ÈÉ\f #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil beginning-of-line vip-execute-com vip-beginning-of-line] 4 (#$ . 22065) "P"]) #@49 Beginning of line at first non-white character. (defalias 'vip-bol-and-skip-white #[(arg) "À ! ! ƒ `Æ“ˆÇ ˆ …ÈÉ\f #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil back-to-indentation vip-execute-com vip-bol-and-skip-white] 4 (#$ . 22304) "P"]) #@20 Go to end of line. (defalias 'vip-goto-eol #[(arg) "À ! ! ƒ `Æ“ˆ\fˆ …ÇÈ\f #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil vip-execute-com vip-goto-eol] 4 (#$ . 22568) "P"]) #@18 Go to next line. (defalias 'vip-next-line #[(arg) "À ! ! ƒ `Æ“ˆÇ\f!ˆÈ …!ÊË\f #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil line-move next-line this-command vip-execute-com vip-next-line] 4 (#$ . 22764) "P"]) #@33 Next line at beginning of line. (defalias 'vip-next-line-at-bol #[(arg) "À ! ! ƒ `Æ“ˆÇ\f!ˆÈ ˆ …!ÉÊ\f #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil next-line back-to-indentation vip-execute-com vip-next-line-at-bol] 4 (#$ . 22997) "P"]) #@22 Go to previous line. (defalias 'vip-previous-line #[(arg) "À ! ! ƒ `Æ“ˆÇ\f[!ˆÈ …\"ÊË\f #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil next-line previous-line this-command vip-execute-com vip-previous-line] 4 (#$ . 23256) "P"]) #@37 Previous line at beginning of line. (defalias 'vip-previous-line-at-bol #[(arg) "À ! ! ƒ `Æ“ˆÇ\f[!ˆÈ ˆ …\"ÉÊ\f #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil next-line back-to-indentation vip-execute-com vip-previous-line] 4 (#$ . 23507) "P"]) #@24 Change to end of line. (defalias 'vip-change-to-eol #[(arg) "À ÂB!‡" [vip-goto-eol arg 99] 3 (#$ . 23773) "P"]) #@14 Delete line. (defalias 'vip-kill-line #[(arg) "À ÂB!‡" [vip-goto-eol arg 100] 3 (#$ . 23891) "P"]) #@53 Go to ARG's line. Without ARG go to end of buffer. (defalias 'vip-goto-line #[(arg) "À ! ! `Æ“ˆÇ`!ˆ\f„dbˆ‚\"ebˆ\fSyˆÈ ˆ ….ÉÊ\f #*‡" [vip-P-val arg vip-getCom com val vip-com-point nil set-mark back-to-indentation vip-execute-com vip-goto-line] 4 (#$ . 23996) "P"]) #@154 Find ARG's occurrence of CHAR on the current line. If FORWARD then search is forward, otherwise backward. OFFSET is used to adjust point after search. (defalias 'vip-find-char #[(arg char forward offset) "ƒ ‚\n [ŠŒ ÄVƒ-lƒÅÆ!‚ `ÇÈ!ˆÄyˆ`}ˆ‚>nƒ7ÅÆ!‚8`Äyˆ`}ˆ ÄVƒKeTbˆ‚NdbˆÂ ÊË\f!ÂÄ $ˆ)` ÄVƒj dU„v ÄWƒz eUƒzÅÆ!ˆ* ÄVƒ ƒ‹Î‚™Ï‚™ ƒ˜È‚™Ä\\b*‡" [forward arg nil point 0 error "" next-line 1 case-fold-search search-forward char-to-string char offset -2 -1] 5 (#$ . 24276)]) #@216 Find char on the line. If called interactively read the char to find from the terminal, and if called from vip-repeat, the char last used is used. This behaviour is controlled by the sign of prefix numeric value. (defalias 'vip-find-char-forward #[(arg) "À ! !‰ÅVƒÆ È Ê ‚\f[ ƒ(\f`Ê“ˆÍ\fÀ !ÅVƒ7‚9ÈÊ$ˆ\f[ …PÊuˆÏÐ\f #*‡" [vip-p-val arg vip-getcom com val 0 read-char vip-f-char t vip-f-forward nil vip-f-offset vip-com-point vip-find-char vip-F-char vip-execute-com vip-find-char-forward] 6 (#$ . 24781) "P"]) #@36 Go up to char ARG forward on line. (defalias 'vip-goto-char-forward #[(arg) "À ! !‰ÅVƒÆ È È\n‚\f[ ƒ( `Ì“ˆÍ\fÀ !ÅVƒ7‚9ȉ$ˆ\f[ …PÌuˆÏÐ\f #*‡" [vip-p-val arg vip-getcom com val 0 read-char vip-f-char t vip-f-forward vip-f-offset vip-com-point nil vip-find-char vip-F-char vip-execute-com vip-goto-char-forward] 6 (#$ . 25322) "P"]) #@33 Find char ARG on line backward. (defalias 'vip-find-char-backward #[(arg) "À ! !‰ÅVƒÆ È È\n‚\f[ ƒ( `È“ˆÌ\fÀ !ÅVƒ7‚9 ȉ$ˆ\f[ …M ÎÏ\f #*‡" [vip-p-val arg vip-getcom com val 0 read-char vip-f-char nil vip-f-forward vip-f-offset vip-com-point vip-find-char vip-F-char vip-execute-com vip-find-char-backward] 6 (#$ . 25683) "P"]) #@37 Go up to char ARG backward on line. (defalias 'vip-goto-char-backward #[(arg) "À ! !‰ÅVƒÆ È Ê ‚\f[ ƒ(\f`È“ˆÍ\fÀ !ÅVƒ7‚9ÈÊ$ˆ\f[ …MÏÐ\f #*‡" [vip-p-val arg vip-getcom com val 0 read-char vip-f-char nil vip-f-forward t vip-f-offset vip-com-point vip-find-char vip-F-char vip-execute-com vip-goto-char-backward] 6 (#$ . 26038) "P"]) #@31 Repeat previous find command. (defalias 'vip-repeat-find #[(arg) "À ! ! ƒ `Æ“ˆÇ\f \n$ˆ …, ƒ'ÆuˆËÌ\f #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil vip-find-char vip-f-char vip-f-forward vip-f-offset vip-execute-com vip-repeat-find] 5 (#$ . 26399) "P"]) #@57 Repeat previous find command in the opposite direction. (defalias 'vip-repeat-find-opposite #[(arg) "À ! ! ƒ `Æ“ˆÇ\f ?\n$ˆ …- ƒ(ÆuˆËÌ\f #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil vip-find-char vip-f-char vip-f-forward vip-f-offset vip-execute-com vip-repeat-find-opposite] 5 (#$ . 26680) "P"]) #@25 Switch to other window. (defalias 'vip-other-window #[(arg) "À !ˆ\nÃ=?†Äp!؆Æ ‡" [other-window arg vip-current-mode emacs-mode buffer-name " *Minibuf-1*" vip-change-mode-to-vi] 2 (#$ . 27006) "p"]) #@25 Go to home window line. (defalias 'vip-window-top #[(arg) "À ! ! ƒ `Æ“ˆÇ\fS!ˆ …ÈÉ\f #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil move-to-window-line vip-execute-com vip-window-top] 4 (#$ . 27215) "P"]) #@27 Go to middle window line. (defalias 'vip-window-middle #[(arg) "À ! ! ƒ `Æ“ˆÇÈ SÉ¥\fS\\!ˆ …%ÊË\f #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil move-to-window-line window-height 2 vip-execute-com vip-window-middle] 4 (#$ . 27442) "P"]) #@25 Go to last window line. (defalias 'vip-window-bottom #[(arg) "À ! ! ƒ `Æ“ˆÇ\f[!ˆ …ÈÉ\f #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil move-to-window-line vip-execute-com vip-window-bottom] 4 (#$ . 27700) "P"]) #@36 Put current line on the home line. (defalias 'vip-line-to-top #[(arg) "À S!‡" [recenter arg] 2 (#$ . 27933) "p"]) #@38 Put current line on the middle line. (defalias 'vip-line-to-middle #[(arg) "À S SÃ¥\\!‡" [recenter arg window-height 2] 4 (#$ . 28053) "p"]) #@36 Put current line on the last line. (defalias 'vip-line-to-bottom #[(arg) "ÀÁ \nTZ!‡" [recenter window-height arg] 3 (#$ . 28201) "p"]) #@33 Go to the matching parenthesis. (defalias 'vip-paren-match #[(arg) "À ! §ƒ5 ÃV„ ÄWƒÅÆ!‚€dÇVƒ)dÈ¥ _‚.d _È¥bˆÉ ‚€ÊË!ƒZ\nƒE\f`Í“ˆÎÄ!ˆ\nƒUÏÐÍ\n#‚€Ñ ‚€ÊÒ!ƒ}Íuˆ\nƒm\f`Í“ˆÓÄ!ˆ\n…€ÏÐÍ\n#‚€ÅÔ!)‡" [vip-getcom arg com 99 1 error "Prefix must be between 1 and 99." 80000 100 back-to-indentation looking-at "[([{]" vip-com-point nil forward-sexp vip-execute-com vip-paren-match backward-char "[])}]" backward-sexp ""] 4 (#$ . 28342) "P"]) #@19 Forward sentence. (defalias 'vip-forward-sentence #[(arg) "À ! ! ƒ `Æ“ˆÇ\f!ˆ …ÈÉÆ #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil forward-sentence vip-execute-com vip-forward-sentence] 4 (#$ . 28795) "P"]) #@20 Backward sentence. (defalias 'vip-backward-sentence #[(arg) "À ! ! ƒ `Æ“ˆÇ\f!ˆ …ÈÉÆ #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil backward-sentence vip-execute-com vip-backward-sentence] 4 (#$ . 29023) "P"]) #@20 Forward paragraph. (defalias 'vip-forward-paragraph #[(arg) "À ! ! ƒ `Æ“ˆÇ\f!ˆ …ÈÉÆ #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil forward-paragraph vip-execute-com vip-forward-paragraph] 4 (#$ . 29255) "P"]) #@21 Backward paragraph. (defalias 'vip-backward-paragraph #[(arg) "À ! ! ƒ `Æ“ˆÇ\f!ˆ …ÈÉÆ #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil backward-paragraph vip-execute-com vip-backward-paragraph] 4 (#$ . 29487) "P"]) #@24 Scroll to next screen. (defalias 'vip-scroll #[(arg) "ÁVƒÁV…% ˆS‰‚ÁV…%à ˆT‚‡" [arg 0 scroll-up scroll-down] 3 (#$ . 29723) "p"]) #@28 Scroll to previous screen. (defalias 'vip-scroll-back #[(arg) "À [!‡" [vip-scroll arg] 2 (#$ . 29874) "p"]) #@24 Scroll up half screen. (defalias 'vip-scroll-down #[(arg) "„ Á å!‡Á!‡" [arg scroll-down window-height 2] 3 (#$ . 29988) "P"]) #@21 Scroll up one line. (defalias 'vip-scroll-down-one #[(arg) "À !‡" [scroll-down arg] 2 (#$ . 30125) "p"]) #@26 Scroll down half screen. (defalias 'vip-scroll-up #[(arg) "„ Á å!‡Á!‡" [arg scroll-up window-height 2] 3 (#$ . 30236) "P"]) #@23 Scroll down one line. (defalias 'vip-scroll-up-one #[(arg) "À !‡" [scroll-up arg] 2 (#$ . 30371) "p"]) #@37 Show current buffer in two windows. (defalias 'vip-buffer-in-two-windows #[nil "À ˆÁÂ!‡" [delete-other-windows split-window-vertically nil] 2 (#$ . 30480) nil]) #@169 Search a string forward. ARG is used to find the ARG's occurrence of the string. Default is vanilla search. Search mode can be toggled by giving null search string. (defalias 'vip-search-forward #[(arg) "À ! !ÅǃɂÊ!‰ ̘ƒ6?ÍÎσ0Ђ1Ñ\"!‚MÒ Å\f#ˆ …MÔ Õ“ˆÖ×\f #*‡" [vip-P-val arg vip-getcom com val t vip-s-forward vip-read-string vip-re-search "RE-/" "/" vip-s-string "" message format "Search mode changed to %s search." "regular expression" "vanilla" vip-search vip-com-point mark nil vip-execute-com vip-search-next] 5 (#$ . 30648) "P"]) #@170 Search a string backward. ARG is used to find the ARG's occurrence of the string. Default is vanilla search. Search mode can be toggled by giving null search string. (defalias 'vip-search-backward #[(arg) "À ! !ÅǃɂÊ!‰ ̘ƒ6?ÍÎσ0Ђ1Ñ\"!‚MÒ Å\f#ˆ …MÔ Å“ˆÕÖ\f #*‡" [vip-P-val arg vip-getcom com val nil vip-s-forward vip-read-string vip-re-search "RE-?" "?" vip-s-string "" message format "Search mode changed to %s search." "regular expression" "vanilla" vip-search vip-com-point mark vip-execute-com vip-search-next] 5 (#$ . 31223) "P"]) #@137 (STRING FORWARD COUNT &optional NO-OFFSET) Search COUNT's occurrence of STRING. Search will be forward if FORWARD, otherwise backward. (defalias 'vip-search #[(string forward arg &optional no-offset init-point) "À ! !à !?\f? †` \n \f ƒ+ÎÏЂ/ÎÑÒ.‡" [vip-p-val arg vip-getcom vip-P-val no-offset vip-case-fold-search init-point start-point case-fold-search offset null-arg com val forward conditions (byte-code "ƒ m„ Áuˆ\nƒÃ\fÁ‰ $ˆÆ\f!ˆ‚(Ç\fÁ‰ $ˆÈ\f!ˆÉ\n!‡" [offset nil vip-re-search re-search-forward string val re-search-backward search-forward search-backward push-mark start-point] 5) ((search-failed (byte-code "ƒ ƒebˆÂ \fÅBÇ%‡bˆÉÊ A\"‡" [null-arg vip-search-wrap-around vip-search string forward 1 com t start-point signal search-failed conditions] 6))) (byte-code "ƒÁ\nÉ\f$ˆ‚Å\nÉ\f$ˆÆ!‡" [vip-re-search re-search-backward string nil val search-backward push-mark start-point] 5) ((search-failed (byte-code "ƒ ƒdbˆÂ \fÅBÇ%‡bˆÉÊ A\"‡" [null-arg vip-search-wrap-around vip-search string forward 1 com t start-point signal search-failed conditions] 6)))] 6 (#$ . 31798)]) #@25 Repeat previous search. (defalias 'vip-search-next #[(arg) "À ! ! „ÆÇ!ˆÈ  #ˆ … ÊË\f #*‡" [vip-p-val arg vip-getcom com val vip-s-string error "No previous search string." vip-search vip-s-forward vip-execute-com vip-search-next] 4 (#$ . 32937) "P"]) #@50 Repeat previous search in the reverse direction. (defalias 'vip-search-Next #[(arg) "À ! ! „ÆÇ!ˆÈ  ? #ˆ …!ÊË\f #*‡" [vip-p-val arg vip-getcom com val vip-s-string error "No previous search string." vip-search vip-s-forward vip-execute-com vip-search-Next] 4 (#$ . 33201) "P"]) #@41 Switch to buffer in the current window. (defalias 'vip-switch-to-buffer #[nil "ÀÂÃÄÅÆp!!\"!Ç !ˆÈ )‡" [nil buffer read-buffer format "switch to buffer (%s): " buffer-name other-buffer switch-to-buffer vip-change-mode-to-vi] 6 (#$ . 33491) nil]) #@37 Switch to buffer in another window. (defalias 'vip-switch-to-buffer-other-window #[nil "ÀÂÃÄÅÆp!!\"!Ç !ˆÈ )‡" [nil buffer read-buffer format "Switch to buffer (%s): " buffer-name other-buffer switch-to-buffer-other-window vip-change-mode-to-vi] 6 (#$ . 33743) nil]) #@16 Kill a buffer. (defalias 'vip-kill-buffer #[nil "À‰ÃÄÅÁp!\"!‰„p‚Æ !‰„\"ÇÈ \"ˆÉ\n!ƒ.ÊË!ƒ4Ì\n!‚7ÇÍ!*‡" [nil buffer-name buffer read-buffer format "Kill buffer (%s): " get-buffer error "Buffer %s nonexistent." buffer-modified-p y-or-n-p "Buffer is modified, are you sure? " kill-buffer "Buffer not killed."] 6 (#$ . 34017) nil]) #@35 Visit file in the current window. (defalias 'vip-find-file #[nil "ÀÂÃ!ÄÅ !!ˆÆ )‡" [nil file read-file-name "visit file: " switch-to-buffer find-file-noselect vip-change-mode-to-vi] 3 (#$ . 34361) nil]) #@31 Visit file in another window. (defalias 'vip-find-file-other-window #[nil "ÀÂÃ!ÄÅ !!ˆÆ )‡" [nil file read-file-name "Visit file: " switch-to-buffer-other-window find-file-noselect vip-change-mode-to-vi] 3 (#$ . 34571) nil]) #@64 Give information of the file associated to the current buffer. (defalias 'vip-info-on-file #[nil "ÀÁ ƒ\f ‚ ÃÄe`\"TÄed\"T$‡" [message "\"%s\" line %d of %d" buffer-file-name "" count-lines] 7 (#$ . 34803) nil]) #@21 yank TEXT silently. (defalias 'vip-yank #[(text) "ŠÀ`!ˆ cˆÂ ˆ)ÃÄw‡" [vip-push-mark-silent text exchange-point-and-mark " " nil] 2 (#$ . 35023)]) #@34 Put back after point/below line. (defalias 'vip-put-back #[(arg) "À !\nƒ\"Ã\nXƒ\nÄXƒÅ\nÃZÆ\"‚%Ç\n!‚%ÅÈ! \n „E\nƒA\n ÌÍÎ \"ˆ)‚EÍÏ!ˆÌÐ !ƒXÑÒ!ˆÈyˆ‚cl„cm„cÌuˆÓ\nÌ\nF\n‰ÈV…ƒÖ !ˆS‰‚p+‡" [vip-p-val arg vip-use-register 49 57 current-kill do-not-rotate get-register 0 text val reg nil error "Nothing in register %c" "" vip-end-with-a-newline-p next-line 1 vip-put-back vip-d-com count vip-yank] 5 (#$ . 35175) "P"]) #@31 Put back at point/above line. (defalias 'vip-Put-back #[(arg) "À !\nƒ\"Ã\nXƒ\nÄXƒÅ\nÃZÆ\"‚%Ç\n!‚%ÅÈ! \n „E\nƒA\n ÌÍÎ \"ˆ)‚EÍÏ!ˆÌÐ !ƒQÈyˆÑ\nÌ\nF\n‰ÈV…qÔ !ˆS‰‚^+‡" [vip-p-val arg vip-use-register 49 57 current-kill do-not-rotate get-register 0 text val reg nil error "Nothing in register %c" "" vip-end-with-a-newline-p vip-Put-back vip-d-com count vip-yank] 5 (#$ . 35624) "P"]) #@19 Delete character. (defalias 'vip-delete-char #[(arg) "À !Ã\nÄEƒ7ÇXƒ*ÈXƒ*ÉÊ\\``\nZ#ˆ‚4Ë``\nZÄ$ˆÄÌ\nÍ\")‡" [vip-p-val arg val vip-delete-char nil vip-d-com vip-use-register 65 90 vip-append-to-register 32 copy-to-register delete-char t] 5 (#$ . 36040) "P"]) #@28 Delete previous character. (defalias 'vip-delete-backward-char #[(arg) "À !Ã\nÄEƒ7ÇXƒ*ÈXƒ*ÉÊ\\``\n\\#ˆ‚4Ë``\n\\Ä$ˆÄÌ\nÍ\")‡" [vip-p-val arg val vip-delete-backward-char nil vip-d-com vip-use-register 65 90 vip-append-to-register 32 copy-to-register delete-backward-char t] 5 (#$ . 36320) "P"]) #@67 Join this line to next, if ARG is nil. Otherwise, join ARG lines (defalias 'vip-join-lines #[(arg) "À !Ã\nÄE\n„Æ‚\nS‰ÈV…6Ĉm„-Æyˆ``S|ˆÉ ˆS‰‚*‡" [vip-P-val arg val vip-join-lines nil vip-d-com 1 count 0 fixup-whitespace] 4 (#$ . 36638) "*P"]) (defalias 'vip-change #[(beg end) "ÀÁ \f{\"!Æ \f\"‡" [vip-read-string format "%s => " beg end c-string vip-change-subr] 5]) (defalias 'vip-change-subr #[(beg end) "ƒ Á\n Ä$ˆÄÅ\n \"ˆÆc‡" [vip-use-register copy-to-register beg end nil kill-region vip-change this-command c-string] 5]) #@151 Query replace. If you supply null string as the string to be replaced, the query replace mode will toggle between string replace and regexp replace. (defalias 'vip-query-replace #[nil "À ƒ Ä‚\fÅ!‰Ƙƒ& ?ÇÈ ƒ!É‚\"Ê\"‚? ƒ6Ë ÂÌÍ \"!\"‚?Î ÂÌÏ \"!\")‡" [nil str vip-read-string vip-re-query-replace "Query replace regexp: " "Query replace: " "" message "Query replace mode changed to %s." "regexp replace" "string replace" query-replace-regexp format "Query replace regexp \"%s\" with: " query-replace "Query replace \"%s\" with: "] 7 (#$ . 37198) nil]) (defalias 'vip-mark-beginning-of-buffer #[nil "À`!ˆebˆÁ ˆÂÃ!‡" [set-mark exchange-point-and-mark message "mark set at the beginning of buffer"] 2 nil nil]) (defalias 'vip-mark-end-of-buffer #[nil "À`!ˆdbˆÁ ˆÂÃ!‡" [set-mark exchange-point-and-mark message "mark set at the end of buffer"] 2 nil nil]) (defalias 'vip-mark-point #[(char) "À Xƒ ÂXƒà ÄZÅ\"‡ ÆUƒÇ ‡ ÈUƒ%É ‡ ÊUƒ.Ë ‡ ÌUƒ8ÍÎ!‡ ÏUƒAÐ ‡ÑÒ!‡" [97 char 122 point-to-register 96 nil 60 vip-mark-beginning-of-buffer 62 vip-mark-end-of-buffer 46 push-mark 44 set-mark-command 1 68 mark-defun error ""] 3 nil "c"]) #@13 Go to mark. (defalias 'vip-goto-mark #[(arg) "À Á\n!Å\f Æ#*‡" [read-char vip-getcom arg com char vip-goto-mark-subr nil] 4 (#$ . 38340) "P"]) #@49 Go to mark and skip to first non-white on line. (defalias 'vip-goto-mark-and-skip-white #[(arg) "À Á\n!Å\f Æ#*‡" [read-char vip-getCom arg com char vip-goto-mark-subr t] 4 (#$ . 38490) "P"]) (defalias 'vip-goto-mark-subr #[(char com skip-white) "À XƒS ÂXƒSp\fƒ `Æ“ˆÇ ÈZ!bˆ ƒ&Ê ˆË ˆ\f…Q pšƒDÌ ƒ=Í‚>ÎÆ\f#‚QÏ !ˆ bˆË ˆÐÑ!)‡ „t ÈUƒt\fƒg `Æ“ˆÒ ˆ\f…›ÌÎÆ\f#‡ ƒ˜ ÓUƒ˜\fƒˆ `Æ“ˆÒ ˆÊ ˆ\f…›ÌÍÆ\f#‡ÐÑ!‡" [97 char 122 buff com vip-com-point nil register-to-point 96 skip-white back-to-indentation vip-change-mode-to-vi vip-execute-com vip-goto-mark-and-skip-white vip-goto-mark switch-to-buffer error "" exchange-point-and-mark 39] 4]) (defalias 'vip-exchange-point-and-mark #[nil "À ˆÁ ‡" [exchange-point-and-mark back-to-indentation] 1 nil nil]) #@44 Abort partially formed or running command. (defalias 'vip-keyboard-quit #[nil "À ‡" [nil vip-use-register keyboard-quit] 1 (#$ . 39254) nil]) #@28 Emulate C-c in Emacs mode. (defalias 'vip-ctl-c-equivalent #[(arg) "ÀÁ\n\"‡" [vip-ctl-key-equivalent "" arg] 3 (#$ . 39404) "P"]) #@28 Emulate C-x in Emacs mode. (defalias 'vip-ctl-x-equivalent #[(arg) "ÀÁ\n\"‡" [vip-ctl-key-equivalent "" arg] 3 (#$ . 39541) "P"]) (defalias 'vip-ctl-key-equivalent #[(key arg) "À  Xƒ ÃXƒ ÄZÅÈH D\")‡" [read-char char 65 90 64 vip-escape-to-emacs arg key 0] 4]) #@23 Delete previous word. (defalias 'vip-delete-backward-word #[(arg) "ŠÀ`!ˆÁ\n!ˆ`à |)‡" [set-mark backward-word arg mark] 2 (#$ . 39819) "p"]) (byte-code "ÀÁ LˆÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÆ#ˆÂÔÕ#ˆÂÖ×#ˆÂØÙ#ˆÂÚÛ#ˆÂÜÝ#ˆÂÞß#ˆÂàá#ˆÂâÎ#ˆÂãä#ˆÂåä#ˆÂæä#ˆÂçè#ˆÂéê#ˆÂëì#ˆÂíî#ˆÂïð#ˆÂñò#ˆÂóô#ˆÂõö#ˆÂ÷ø#ˆÂùú#ˆÂûü#ˆÂýþ#ˆÂÿ@#ˆÂAB#ˆÂCB#ˆÂDB#ˆÂEB#ˆÂFB#ˆÂGB#ˆÂHB#ˆÂIB#ˆÂJB#ˆÂKL#ˆÂMN#ˆÂOä#ˆÂPä#ˆÂQä#ˆÂRS#ˆÂTì#ˆÂUV#ˆÂWX#ˆÂYZ#ˆÂ[\\#ˆÂ]^#ˆÂ_`#ˆÂab#ˆÂcd#ˆÂef#ˆÂgh#ˆÂij#ˆÂkl#ˆÂmn#ˆÂop#ˆÂqr#ˆÂst#ˆÂuv#ˆÂwx#ˆÂyz#ˆÂ{|#ˆÂ}ì#ˆÂ~#ˆÂ€#ˆÂ‚ƒ#ˆÂ„…#ˆÂ†‡#ˆÂˆì#ˆÂ‰Š#ˆÂ‹ì#ˆÂŒ#ˆÂŽì#ˆÂ#ˆÂ‘’#ˆÂ“”#ˆÂ•ä#ˆÂ–ä#ˆÂ—˜#ˆÂ™š#ˆÂ›œ#ˆÂž#ˆÂŸ #ˆÂ¡¢#ˆÂ£¤#ˆÂ¥¦#ˆÂ§¨#ˆÂ©ª#ˆÂ«¬#ˆÂ­®#ˆÂ¯ì#ˆÂ°±#ˆÂ²³#ˆÂ´µ#ˆÂ¶·#ˆÂ¸¹#ˆÂº»#ˆÂ¼½#ˆÂ¾ä#ˆÂ¿À#ˆÂÁÂ#ˆÂÃÄ#ˆÂÅÀ#ˆÂÆÂ#ˆÂÇÄ#ˆÂÈÉ#ˆÂÊË#ˆÂÌÍ#ˆÂÎì#ˆÂÏÐ#ˆÂÑDÒ#ˆÂÑÓÔ#‡" [vip-mode-map make-keymap define-key "" beginning-of-line "" vip-scroll-back "" vip-ctl-c "" vip-scroll-up "" vip-scroll-up-one "" vip-scroll "" vip-keyboard-quit "" help-command " " "" vip-other-window "" vip-open-line-at-point "" vip-scroll-down "" vip-ctl-x "" vip-scroll-down-one "" vip-change-mode-to-emacs "" vip-ESC " " "!" vip-command-argument "\"" "#" "$" vip-goto-eol "%" vip-paren-match "&" vip-nil "'" vip-goto-mark-and-skip-white "(" vip-backward-sentence ")" vip-forward-sentence "*" call-last-kbd-macro "+" vip-next-line-at-bol "," vip-repeat-find-opposite "-" vip-previous-line-at-bol "." vip-repeat "/" vip-search-forward "0" vip-beginning-of-line "1" vip-digit-argument "2" "3" "4" "5" "6" "7" "8" "9" ":" vip-ex ";" vip-repeat-find "<" "=" ">" "?" vip-search-backward "@" "A" vip-Append "B" vip-backward-Word "C" vip-ctl-c-equivalent "D" vip-kill-line "E" vip-end-of-Word "F" vip-find-char-backward "G" vip-goto-line "H" vip-window-top "I" vip-Insert "J" vip-join-lines "K" vip-kill-buffer "L" vip-window-bottom "M" vip-window-middle "N" vip-search-Next "O" vip-Open-line "P" vip-Put-back "Q" vip-query-replace "R" vip-replace-string "S" vip-switch-to-buffer-other-window "T" vip-goto-char-backward "U" "V" vip-find-file-other-window "W" vip-forward-Word "X" vip-ctl-x-equivalent "Y" vip-yank-line "ZZ" save-buffers-kill-emacs "[" "\\" vip-escape-to-emacs "]" "^" vip-bol-and-skip-white "_" "`" vip-goto-mark "a" vip-append "b" vip-backward-word "c" "d" "e" vip-end-of-word "f" vip-find-char-forward "g" vip-info-on-file "h" vip-backward-char "i" vip-insert "j" vip-next-line "k" vip-previous-line "l" vip-forward-char "m" vip-mark-point "n" vip-search-next "o" vip-open-line "p" vip-put-back "q" "r" vip-replace-char "s" vip-switch-to-buffer "t" vip-goto-char-forward "u" vip-undo "v" vip-find-file "w" vip-forward-word "x" vip-delete-char "y" "zH" vip-line-to-top "zM" vip-line-to-middle "zL" vip-line-to-bottom "z " "z." "z-" "{" vip-backward-paragraph "|" vip-goto-col "}" vip-forward-paragraph "~" "" vip-delete-backward-char ctl-x-map vip-buffer-in-two-windows " " insert-file] 4) (defalias 'vip-version #[nil "ÀÁ!‡" [message "VIP version 3.5 of September 15, 1987"] 2 nil nil]) #@78 type of token. if non-nil, gives type of address. if nil, it is a command. (defvar ex-token-type nil (#$ . 43241)) #@17 value of token. (defvar ex-token nil (#$ . 43364)) #@22 list of ex addresses (defvar ex-addresses nil (#$ . 43421)) #@18 flag for ex flag (defvar ex-flag nil (#$ . 43487)) #@19 name of ex buffer (defvar ex-buffer nil (#$ . 43544)) #@19 value of ex count (defvar ex-count nil (#$ . 43604)) #@25 flag for global command (defvar ex-g-flag nil (#$ . 43663)) #@64 if t global command is executed on lines not matching ex-g-pat (defvar ex-g-variant nil (#$ . 43729)) #@33 save reg-exp used in substitute (defvar ex-reg-exp nil (#$ . 43837)) #@32 replace pattern for substitute (defvar ex-repl nil (#$ . 43912)) #@28 pattern for global command (defvar ex-g-pat nil (#$ . 43983)) #@31 save commands for mapped keys (defvar ex-map (make-sparse-keymap) (#$ . 44051)) #@13 save ex tag (defvar ex-tag nil (#$ . 44137)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ B‡" [boundp ex-file nil current-load-list ex-variant ex-offset ex-append] 2) (defalias 'vip-nil #[nil "ÀÁ!‡" [error ""] 2 nil nil]) #@53 returns t if looking back reg-exp STR before point. (defalias 'vip-looking-back #[(str) "ŠÀ ÂÃ#)…`Ä•U‡" [re-search-backward str nil t 0] 4 (#$ . 44381)]) #@48 check if ex-token is an initial segment of STR (defalias 'vip-check-sub #[(str) "G‰\nGXƒ\nà O˜ƒ\n‰‚ĉ)‡" [ex-token length str 0 "non-command" ex-token-type] 5 (#$ . 44543)]) #@27 get a complete ex command (defalias 'vip-get-ex-com-subr #[nil "À`!ˆÁÂ!ˆÃ`Å {Ç ˆÈÉ!ƒ:ÈÊ!ƒ&ËÌ!ˆ‚›ÈÍ!ƒ3ËÎ!ˆ‚›ËÏ!ˆ‚›ÈÐ!ƒEÑ‚›ÈÒ!ƒ_ÈÓ!ƒXËÔ!ˆ‚›ËÕ!ˆ‚›ÈÖ!ƒlË×!ˆ‚›ÈØ!ƒ†ÈÙ!ƒËÙ!ˆ‚›ËÚ!ˆ‚›ÈÛ!ƒ“ËÜ!ˆ‚›ÈÝ!ƒ ËÞ!ˆ‚›Èß!ƒ­Ëà!ˆ‚›Èá!ƒºËâ!ˆ‚›Èã!ƒÇËä!ˆ‚›Èå!ƒîÈæ!ƒÚËæ!ˆ‚›Èç!ƒçËè!ˆ‚›Ëé!ˆ‚›Èê!ƒÈë!ƒËì!ˆ‚›Ëí!ˆ‚›Èî!ƒËï!ˆ‚›Èð!ƒ<Èñ!ƒ(Ëò!ˆ‚›Èó!ƒ5Ëô!ˆ‚›Ëõ!ˆ‚›Èö!ƒIË÷!ˆ‚›Èø!ƒpÈù!ƒ\\Ëú!ˆ‚›Èû!ƒiËü!ˆ‚›Ëý!ˆ‚›Èþ!ƒÁÈÿ!ƒ…Ë@!ˆ‚›ÈA!ƒ–ËB!ˆ‚›ÈC!ƒ§ËD!ˆ‚›ÈE!ƒ¸ËF!ˆ‚›ËG!ˆ‚›ÈH!ƒãÈI!ƒÚËJ!ˆ‚›ËH!ˆ‚›ÈK!ƒÈL!ƒüËM!ˆ‚›ÈN!ƒ ËO!ˆ‚›ËP!ˆ‚›ÈQ!ƒIÈR!ƒ/ËS!ˆ‚›ÈT!ƒ@ËU!ˆ‚›ËQ!ˆ‚›ÈV!ƒkÈW!ƒbËW!ˆ‚›ËX!ˆ‚›ÈY!ƒ|ËZ!ˆ‚›È[!ƒË\\!ˆ‚›È]!ƒ›Ë]!ˆÇ ‡" [set-mark re-search-forward "[a-z][a-z]*" "command" ex-token-type mark ex-token exchange-point-and-mark looking-at "a" "ab" vip-check-sub "abbreviate" "ar" "args" "append" "[bh]" "non-command" "c" "co" "copy" "change" "d" "delete" "e" "ex" "edit" "f" "file" "g" "global" "i" "insert" "j" "join" "l" "list" "m" "map" "mar" "mark" "move" "n" "nu" "number" "next" "o" "open" "p" "pre" "preserve" "pu" "put" "print" "q" "quit" "r" "rec" "recover" "rew" "rewind" "read" "s" "se" "set" "sh" "shell" "so" "source" "st" "stop" "substitute" "t" "ta" "tag" "u" "una" "unabbreviate" "unm" "unmap" "undo" "v" "ve" "version" "vi" "visual" "w" "wq" "write" "x" "xit" "y" "yank" "z"] 2 (#$ . 44734)]) #@115 get an ex-token which is either an address or a command. a token has type (command, address, end-mark) and value. (defalias 'vip-get-ex-token #[nil "À‹‡" [((byte-code "ÀqˆÁÂwˆÃÄ!ƒÅÇg!Éu‡ÃÊ!ƒ!Ë ‡ÃÌ!ƒ/ÉuˆÍ‰‡ÃÎ!ƒ`Ï`!ˆÐÑ!ˆÒ˜ƒHÓ‚TÔ˜ƒSÕ‚TÖ×`Ø {!‰‡ÃÙ!ƒnÉuˆÚ‰‡ÃÛ!ƒ|ÉuˆÜ‰‡ÃÝ!ƒ¯ÃÞ!„ŽÃß!ƒÉuˆàcˆáÉ!ˆÒ‰‡Ãâ!ƒ«ÉuˆÒ‰‡ãä!‡Ãå!ƒâÃæ!„ÁÃç!ƒÐÉuˆàcˆáÉ!ˆÔ‰‡Ãè!ƒÞÉuˆÔ‰‡ãä!‡Ãé!ƒ$ÉuˆÏ`!ˆê+l„ +ƒ Ðì!ˆíî!„òÂ+‚ò)áÉ!ˆ`Ø {Ãé!ƒÉuˆï‰‡Ãð!ƒgÉuˆÏ`!ˆê+l„Z+ƒZÐñ!ˆíò!„JÂ+áÉ!ˆÃó!„4Éuˆ‚4)ô`SØ {‰‡Ãõ!ƒuÉuˆö‰‡Ã÷!ƒƒÉuˆø‰‡Ãù!ƒ”ÅÇg!Éu‡Ãú!ƒ¿ûÉuˆÃú!ƒ¬Â‚¼ÃÊ!ƒ¸g‚¼ãü!ˆÉu‡Ãó!ƒÍýþ‰‡ãÿ!‡" [" *ex-working-space*" " " nil looking-at "[k#]" "command" ex-token-type char-to-string ex-token 1 "[a-z]" vip-get-ex-com-subr "\\." "dot" "[0-9]" set-mark re-search-forward "[0-9]*" "plus" "add-number" "minus" "sub-number" "abs-number" string-to-int mark "\\$" "end" "%" "whole" "+" "+[-+]" "+[\n|]" "1" backward-char "+[0-9]" error "Badly formed address" "-" "-[-+]" "-[\n|]" "-[0-9]" "/" t cont "[^/]*\\(/\\|\n\\)" vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/" "search-forward" "\\?" "[^\\?]*\\(\\?\\|\n\\)" "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?" "\n" "search-backward" "," "comma" ";" "semi-colon" "[!=><&~]" "'" "goto-mark" "Marks are ' and a-z" "end-mark" "goto" "illegal token"] 3))] 1 (#$ . 46165)]) #@25 ex commands within VIP. (defalias 'vip-ex #[(&optional string) "„ÁÁ†ÄÅ!ÁÆ` \nË‹ˆÌ Á…çÏ ˆ И„9 јƒr ƒE BÓ˜ƒWÔÁ!ˆÁ‰‚%Õ˜ƒiÔÆ!ˆÁ‰‚%Ö ˆ×‹ˆ‚# ؘƒ„ÙÚÛ\"!ˆ‚# ܘƒ–deBB‚# ݘƒ° „¦`‚¨ B‚# Þ˜ƒÓ ƒÀ  „É`‚Ë B‚#ß \"‰ ƒã  )‚#,‡" [string nil ex-g-flag ex-g-variant vip-read-string ":" t dot cont address com-str ((byte-code "ÀÁ!qˆed|ˆ\nñˆeb‡" [get-buffer-create " *ex-working-space*" com-str "\n"] 2)) "" ex-token-type ex-addresses vip-get-ex-token "command" "end-mark" ex-token "global" ex-global "v" vip-execute-ex-command ((byte-code "ÀqˆÁÂwˆÃÄ!ƒÅuˆ‚#ÃÆ!ƒÂ‚#ÈÉ!ˆÂ‡" [" *ex-working-space*" " " nil looking-at "|" 1 "\n" cont error "Extra character at end of a command"] 2)) "non-command" error format "%s: Not an editor command" "whole" "comma" "semi-colon" vip-get-ex-address-subr ans] 5 (#$ . 47509) nil]) #@54 get a regular expression and set ex-variant if found (defalias 'vip-get-ex-pat #[nil "À‹‡" [((byte-code "ÀqˆÁÂwˆÃÄ!ƒ ??ÇuˆÁÂwˆÃÈ!ƒ\\ÇuˆÉ`!ˆÊ l„E ƒEÌÍ!ˆÎÏ!„, ‚,)Ð `UƒQÑ‚V`SÐ {ÓÇ!‡Â‰‡" [" *ex-working-space*" " " nil looking-at "!" ex-g-variant ex-g-flag 1 "/" set-mark t cont re-search-forward "[^/]*\\(/\\|\n\\)" vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/" mark "" ex-token backward-char] 2))] 1 (#$ . 48408)]) #@19 get an ex command (defalias 'vip-get-ex-command #[nil "À‹‡" [((byte-code "ÀqˆÁÂ!ƒ\fÃuˆÄÅwˆÁÆ!ƒ&Ç ˆɘ…7ÊË\f\"‡ÁÍ!ƒ4Îg!\fÃu‡ÊÏ!‡" [" *ex-working-space*" looking-at "/" 1 " " nil "[a-z]" vip-get-ex-com-subr ex-token-type "non-command" error "%s: not an editor command" ex-token "[!=><&~]" char-to-string "Could not find an ex command"] 3))] 1 (#$ . 48850)]) #@25 get an ex option g or c (defalias 'vip-get-ex-opt-gc #[nil "À‹‡" [((byte-code "ÀqˆÁÂ!ƒ\fÃuˆÄÅwˆÁÆ!ƒÆÃuˆÈ‡ÁÉ!ƒ,ÉÃuˆÈ‡Å‡" [" *ex-working-space*" looking-at "/" 1 " " nil "g" ex-token t "c"] 2))] 1 (#$ . 49220)]) #@60 compute default addresses. whole-flag means whole buffer. (defalias 'vip-default-ex-addresses #[(&optional whole-flag) "„ ƒdeÂBB‚``ÂBB‰‡A?…$@B‰‡" [ex-addresses whole-flag nil] 3 (#$ . 49445)]) #@66 get an ex-address as a marker and set ex-flag if a flag is found (defalias 'vip-get-ex-address #[nil "À ÁÄÆ\nƒuÈ ˆ ʘƒ: ˘„* ̘„* ͘ƒ3ÁƉ‚ ÎÏ!ˆ‚\n ИƒGƉ‚  јƒUÎÒ!ˆ‚\n Ó˜ƒcÎÔ!ˆ‚\nÕ À \"‰ƒq)‚\n *‡" [point-marker t cont address "" ex-token nil ex-flag vip-get-ex-token ex-token-type "command" "print" "list" "#" error "address expected" "end-mark" "whole" "a trailing address is expected" "comma" "Extra characters after an address" vip-get-ex-address-subr ans] 4 (#$ . 49658)]) #@31 returns an address as a point (defalias 'vip-get-ex-address-subr #[(old-address dot) "À\n„ \fŘƒ ‚Æ\fƘƒ4Š\nbˆ\nÇUƒ)S‚+yˆÉ )‚Æ\fʘƒJŠ\nbˆ[yˆÉ )‚Æ\f˘ƒlŠebˆÇUƒ`Ç‚hSyˆÉ )‚Æ\f̘ƒxÍ ‚Æ\fΘ„Æ\fϘ„Æ\fИƒ–ŠÑÒ!ˆÉ )‚Æ\fÓ˜ƒ¨ŠÑÀ!ˆÉ )‚Æ\fÔ˜ƒÆŠ„ºÕ ˆ‚ÂÖ×Z!bˆÉ ) )‡" [nil address old-address dot ex-token-type "dot" "add-number" 0 ex-token point-marker "sub-number" "abs-number" "end" point-max-marker "plus" "minus" "search-forward" ex-search-address t "search-backward" "goto-mark" exchange-point-and-mark register-to-point 96] 3 (#$ . 50174)]) #@32 search pattern and set address (defalias 'ex-search-address #[(forward) "Á˜ƒ\n„ÃÄ!ˆ‚\n‚ ƒ#ÆyˆÇ!‡ÈyˆÉ!‡" [ex-token "" vip-s-string error "No previous search string" forward 1 re-search-forward -1 re-search-backward] 2 (#$ . 50763)]) #@57 get a buffer name and set ex-count and ex-flag if found (defalias 'vip-get-ex-buffer #[nil "ÀÀÀÄ‹‡" [nil ex-buffer ex-count ex-flag ((byte-code "ÀqˆÁÂwˆÃÄ!ƒgÆuˆÁÂwˆÃÇ!ƒ0È`!ˆÉÊ!ˆË`Ì {! ÁÂwˆÃÎ!ƒ<ÏÆuˆÃÑ!?…FÒÓ!‡" [" *ex-working-space*" " " nil looking-at "[a-zA-Z]" ex-buffer 1 "[0-9]" set-mark re-search-forward "[0-9][0-9]*" string-to-int mark ex-count "[pl#]" t ex-flag "[\n|]" error "Illegal extra characters"] 3))] 1 (#$ . 51016)]) (defalias 'vip-get-ex-count #[nil "ÀÀÀÄ‹‡" [nil ex-variant ex-count ex-flag ((byte-code "ÀqˆÁÂwˆÃÄ!ƒÅÇuˆÁÂwˆÃÈ!ƒ1É`!ˆÊË!ˆÌ`Í {!ÁÂwˆÃÏ!ƒ=ÅÇuˆÃÑ!?…GÒÓ!‡" [" *ex-working-space*" " " nil looking-at "!" t ex-variant 1 "[0-9]" set-mark re-search-forward "[0-9][0-9]*" string-to-int mark ex-count "[pl#]" ex-flag "[\n|]" error "Illegal extra characters"] 3))] 1]) #@70 get a file name and set ex-variant, ex-append and ex-offset if found (defalias 'vip-get-ex-file #[nil "ÀÀÀÀÅ‹‡" [nil ex-file ex-variant ex-append ex-offset ((byte-code "ÀqˆÁÂwˆÃÄ!ƒÅÇuˆÁÂwˆÃÈ!ƒ*Å ÅÊuˆÁÂwˆÃË!ƒLÇuˆÌ`!ˆÍÎ!ˆÏÇ!ˆ`Ð {ÇuˆÁÂwˆÌ`!ˆÍÎ!ˆÏÇ!ˆ`Ð {‰‡" [" *ex-working-space*" " " nil looking-at "!" t ex-variant 1 ">>" ex-append 2 "+" set-mark re-search-forward "[ \n]" backward-char mark ex-offset ex-file] 2))] 1 (#$ . 51840)]) #@50 execute ex command using the value of addresses. (defalias 'vip-execute-ex-command #[nil "Á˜ƒ  ‡؃ÄÅ!‡ƘƒÇ ‡Șƒ%É ‡ʘƒ.Ë ‡̘ƒ8ÍÌ!‡ΘƒAÏ ‡ИƒJÏ ‡јƒSÒ ‡Ó˜ƒ]ÄÔ!‡Õ˜ƒfÖ ‡טƒoØ ‡Ù˜ƒxÚ ‡Û˜ƒÜ ‡ݘƒŠÞ ‡ߘƒ“à ‡ᘃœâ ‡㘃¦ÄÅ!‡䘃¯å ‡昃¸ç ‡蘃Áé ‡ꘃÊë ‡옃ÓÉ ‡혃ÝîÅ!‡çîÔ!‡ð˜ƒðñ ‡ò˜ƒùó ‡ô˜ƒõ ‡ö˜ƒ\fÍ÷!‡ø˜ƒÍù!‡ú˜ƒ àÔ!‡û˜ƒ+àÔ‰\"‡ü˜„Ký˜„Kþ˜„Kÿ˜„K@˜ƒXABC\"!‡D˜„°E˜„°F˜„°G˜„°H˜„°I˜„°J˜„°K˜„°L˜„°M˜„°N˜ƒ½ABO\"!‡ABP\"!‡" [ex-token "goto" ex-goto "copy" ex-copy nil "delete" ex-delete "edit" ex-edit "file" vip-info-on-file "join" ex-line "k" ex-mark "mark" "map" ex-map "move" t "put" ex-put "quit" ex-quit "read" ex-read "set" ex-set "shell" ex-shell "substitute" ex-substitute "stop" suspend-emacs "t" "tag" ex-tag "undo" vip-undo "unmap" ex-unmap "version" vip-version "visual" "write" ex-write "wq" "yank" ex-yank "!" ex-command "=" ex-line-no ">" "right" "<" "left" "&" "~" "append" "args" "change" "insert" "open" error format "%s: no such command from VIP" "abbreviate" "list" "next" "print" "preserve" "recover" "rewind" "source" "unabbreviate" "xit" "z" "%s: not implemented in VIP" "%s: Not an editor command"] 4 (#$ . 52296)]) #@17 ex goto command (defalias 'ex-goto #[nil "„`ÁBÂ`!ˆ@bˆÃyˆÁ‡" [ex-addresses nil push-mark 0] 2 (#$ . 53574)]) #@51 ex copy and move command. DEL-FLAG means delete. (defalias 'ex-copy #[(del-flag) "À ˆÁ \n@\nA@\fbˆŠÆ !ˆÇÈ `\"ˆ ƒ)Ê`È \"ˆ‚/Ë`È \"ˆ\fƒXÍÎ „F„FƒLÑÒ!‚P`È {!‘ˆÓÔÕˆ) ÒUƒeebˆ‚k bˆÖyˆÑÒ!c+‡" [vip-default-ex-addresses vip-get-ex-address ex-addresses beg end address set-mark vip-enlarge-region mark del-flag kill-region copy-region-as-kill ex-flag "*copy text*" princ ex-g-flag ex-g-variant current-kill 0 nil (byte-code "ÀÁ!ˆŠÂÃ!ˆ)À‡" [vip-read-string "[Hit return to continue] " kill-buffer "*copy text*"] 2) ((quit (byte-code "ŠÀÁ!ˆ)ÂÃÄ\"‡" [kill-buffer "*copy text*" signal quit nil] 3))) 1] 4 (#$ . 53693)]) #@11 ex delete (defalias 'ex-delete #[nil "À ˆÁ ˆ\n@\nA@ \fVƒÅÆ!ˆŠÇ \f\"ˆÈ ˆ ƒ1Ê`!ˆ Syˆ‚5Ê\f!ˆÇ`Ë \"ˆ\fƒWÍÎ`Ë {!‘ˆÏÐшŠÒÍ!)‚„ƒ€ÔXƒwÕXƒwÖ×\\`Ë #ˆ‚€Ø`Ë Ù$ˆ`Ë |+‡" [vip-default-ex-addresses vip-get-ex-buffer ex-addresses beg end error "First address exceeds second" vip-enlarge-region exchange-point-and-mark ex-count set-mark mark ex-flag " *delete text*" princ conditions (vip-read-string "[Hit return to continue] ") ((quit (byte-code "ŠÀÁ!ˆ)ÂÃ!‡" [kill-buffer " *delete text*" error ""] 2))) kill-buffer ex-buffer 65 90 vip-append-to-register 32 copy-to-register nil] 5 (#$ . 54325)]) #@9 ex-edit (defalias 'ex-edit #[nil "À ˆ „ ƒ ƒÄÅ!ˆÆ ˆÇ P!qˆÊ ˆebˆ …6Ì‹ˆÍ bˆÎyˆÏ‡" [vip-get-ex-file ex-variant buffer-modified-p buffer-file-name error "No write since last change (:e! overrides)" vip-change-mode-to-emacs find-file-noselect default-directory ex-file vip-change-mode-to-vi ex-offset ((byte-code "Àqˆed|ˆ ±ˆeb‡" [" *ex-working-space*" ex-offset "\n"] 2)) vip-get-ex-address 0 nil] 3 (#$ . 54938)]) #@19 ex global command (defalias 'ex-global #[(variant) "„ ƒÂÃ!ˆ‚\fƒÅÆ‚ÆÅÇ ˆ„*ÂÉ!ˆʘƒD „=ÂÌ!ˆ‚L  ‚L  „VdeDÅÏÅ@A@VƒvÂÕ!ˆŠÖ\"ˆ× ˆÆØ × ˆÏyˆmƒšo„šÛÜ!ˆƒöo„ö`YƒöÏyˆÝ`!ˆÅˆÞ ß Æ# ƒÆ „Ï ƒÞ „ÞňTØ B)Ïyˆoƒíʼn‚œáyˆÅˆ‚š+⋈…@bˆã!ˆSA‰„ÿÅ-‡" [ex-g-flag ex-g-variant error "Global within global not allowed" variant nil t vip-get-ex-pat ex-token "Missing regular expression for global command" "" vip-s-string "No previous search string" ex-g-pat ex-addresses 0 beg end com-str mark-count marks "First address exceeds second" vip-enlarge-region exchange-point-and-mark point-marker limit cont backward-char 1 set-mark re-search-backward mark found -1 ((byte-code "Àqˆ`TdS{‡" [" *ex-working-space*" com-str nil] 2)) vip-ex] 6 (#$ . 55367)]) #@60 ex line commands. COM is join, shift-right or shift-left. (defalias 'ex-line #[(com) "À ˆÁ ˆ\n@\nA@à VƒÇÈ!ˆŠÉ \"ˆÊ ˆ ƒ2Ì`!ˆ yˆ ƒOÎÏ`Ð {!‘ˆÑÒÓˆŠÔÎ!ˆ)‚WÕ`Ð #ˆ`)\fSbˆ×yˆ+Ç" [vip-default-ex-addresses vip-get-ex-count ex-addresses nil point beg end error "First address exceeds second" vip-enlarge-region exchange-point-and-mark ex-count set-mark ex-flag " *text*" princ mark conditions (byte-code "ÀÁ!ˆÂ `Ä #‡" [vip-read-string "[Hit return to continue] " ex-line-subr com mark] 4) ((quit (ding))) kill-buffer ex-line-subr com 0] 4 (#$ . 56210)]) (defalias 'ex-line-subr #[(com beg end) "Á˜ƒ;\n ^bˆm?…:`\n ]W…hĈ`\n ]Xƒ m„ Åyˆ``S|ˆ„ Ç ˆ‚ ‡Ș„Gɘ…hÊ\n ^\n ]ȘƒY ‚\\ [#ˆ\n ]bˆÄˆÅu‡" [com "join" beg end nil 1 ex-variant fixup-whitespace "right" "left" indent-rigidly vip-shift-width] 5]) #@9 ex mark (defalias 'ex-mark #[nil "À\n„\n`ÀBˈŠ\n@bˆÄ ÅZÀ\"*‡" [nil char ex-addresses ((byte-code "ÀqˆÁÂwˆÃÄ!ƒ#gÆuˆÁÂwˆÃÇ!„4ÈÉ!ˆ‚4ÃÇ!ƒ0ÈÊ!ˆ‚4ÈË!ˆÂ‡" [" *ex-working-space*" " " nil looking-at "[a-z]" char 1 "[\n|]" error "Extra characters at end of \"k\" command" "\"k\" requires a following letter" "Mark must specify a letter"] 2)) point-to-register 96] 3 (#$ . 57041)]) #@8 ex map (defalias 'ex-map #[nil "À‰ËˆÄ \n\"„Æ \nÄ\n\"†È#ˆÆ\nÉÊËÌÍÎ ÏEEBD!#*‡" [nil string char ((byte-code "ÀqˆÁÂwˆÃg!ÅuˆÁÂwˆÆÇ!ƒÈÉ!ˆÊ`!ˆË ˆÌÅ!ˆÍ `{‡" [" *ex-working-space*" " " nil char-to-string char 1 looking-at "[\n|]" error "Missing rhs" set-mark end-of-buffer backward-char mark string] 2)) lookup-key ex-map define-key vip-mode-map vip-nil eval quote lambda (count) (interactive "p") execute-kbd-macro count] 11 (#$ . 57428)]) #@10 ex unmap (defalias 'ex-unmap #[nil "À‹ˆÃ\f \"„ÅÆ!ˆÇ Ã\f \"#ˆÇ\f À#)‡" [nil char ((byte-code "ÀqˆÁÂwˆÃg!ÅuˆÁÂwˆÆÇ!„ÈÉ!ˆÂ‡" [" *ex-working-space*" " " nil char-to-string char 1 looking-at "[\n|]" error "Macro must be a character"] 2)) lookup-key ex-map error "That macro wasn't mapped" define-key vip-mode-map] 6 (#$ . 57885)]) #@8 ex put (defalias 'ex-put #[nil "„`‚\n@ ˆ  bˆ ÅUƒÆÇ!‚\"ÈÇ!)‡" [ex-addresses point vip-get-ex-buffer ex-buffer vip-use-register 0 vip-Put-back 1 vip-put-back] 2 (#$ . 58226)]) #@9 ex quit (defalias 'ex-quit #[nil "À‹ˆ ÃUƒÄÅ!‚Æ )‡" [nil char ((byte-code "ÀqˆÁÂwˆg‡" [" *ex-working-space*" " " nil char] 2)) 33 kill-emacs t save-buffers-kill-emacs] 2 (#$ . 58416)]) #@9 ex read (defalias 'ex-read #[nil "„`‚\n@Á‰‰‰bˆ ÆU„ÇÈ!ˆÆyˆÉ‹ˆ\fƒ/Ê Ë\"‚2Ì\n!,‡" [ex-addresses nil file command variant point 0 next-line 1 ((byte-code "ÀqˆÁÂwˆÃÄ!ƒ'ÅÇuˆÁÂwˆÈ`!ˆÂˆÉ `{\n‚9È`!ˆËÌ!ˆÍÇ!ˆ`É {‡" [" *ex-working-space*" " " nil looking-at "!" t variant 1 set-mark mark command re-search-forward "[ \n]" backward-char file] 2)) shell-command t insert-file] 5 (#$ . 58614)]) (defalias 'ex-set #[nil "ÀÁÂÃ!ÀÄÅ!!E!‡" [eval setq read-variable "Variable: " read-minibuffer "Value: "] 6]) #@10 ex shell (defalias 'ex-shell #[nil "À ˆÁ ‡" [vip-change-mode-to-emacs shell] 1 (#$ . 59133)]) #@83 ex substitute. If REPEAT use previous reg-exp which is ex-reg-exp or vip-s-string (defalias 'ex-substitute #[(&optional repeat r-flag) "À‰‰‰‰ƒÀ‚È ˆ„0 ƒ'\n‚) \f‚]͘ƒ<\n‚>‰\n  È ˆ„VÍÍ\f‚]\fÎ ƒsϘƒnЂ]Ђ]Ñ ˆƒ›Šƒ†@bˆÔ`!ˆSyˆ`Õ ÀBB)‚¸„ª``ÀBB‚¸A„¸@B@A@ÐÀŠÚ\"ˆŠ`Õ ]bˆÛ )`Õ ^bˆ`WƒCÀˆÛ Ýyˆ ƒ!l„Þ Ð#ƒ\nƒßà!ƒø`á\f!ˆ‚øÀˆÀuˆ‚ãÞ Ð#ƒ:\nƒ4ßà!ƒ:`á\f!ˆÀˆÀuˆ‚ã. ƒL bˆÝyˆ\n…Vâã!-‡" [nil matched-pos opt-c opt-g repl pat repeat ex-token vip-get-ex-pat r-flag vip-s-string ex-reg-exp ex-repl "" vip-get-ex-opt-gc "g" t vip-get-ex-count ex-count ex-addresses set-mark mark eol-mark cont end beg vip-enlarge-region point-marker limit 0 re-search-forward y-or-n-p "Replace? " replace-match message "done"] 6 (#$ . 59233)]) #@8 ex tag (defalias 'ex-tag #[nil "À‹ˆ Ø„ Å ˆÆÇÈ)‡" [nil tag ((byte-code "ÀqˆÁÂwˆÃ`!ˆÄÂwˆÅ `{‡" [" *ex-working-space*" " " nil set-mark "^ | \n" mark tag] 2)) "" ex-tag vip-change-mode-to-emacs conditions (byte-code "Á˜ƒ Ä\"ˆ‚Å !ˆÆ ‡" [tag "" find-tag ex-tag t find-tag-other-window vip-change-mode-to-vi] 3) ((error (byte-code "À ˆÁ\n!‡" [vip-change-mode-to-vi vip-message-conditions conditions] 2)))] 3 (#$ . 60068)]) #@10 ex write (defalias 'ex-write #[(q-flag) "ÀÁ!ˆÂ ˆ Ęƒ „ÆÇ!ˆ ‚È ! Å ˜„7É !ƒ7\n„7ÆËÌ \"!ˆ @ A@VƒNÆÐ!ˆŠÑ\"ˆÒ`Ó Á%ˆ+ „g …nÖ ‡" [vip-default-ex-addresses t vip-get-ex-file ex-file "" buffer-file-name error "No file associated with this buffer" expand-file-name file-exists-p ex-variant format "\"%s\" File exists - use w! to override" ex-addresses beg end "First address exceeds second" vip-enlarge-region write-region mark ex-append q-flag save-buffers-kill-emacs] 6 (#$ . 60508)]) #@9 ex yank (defalias 'ex-yank #[nil "À ˆÁ ˆ\n@\nA@ \fVƒÅÆ!ˆŠÇ \f\"ˆÈ ˆ „*\nƒ.ÅË!ˆ\fƒ?Í`!ˆ\fSyˆ‚CÍ\f!ˆÇ`Î \"ˆƒRÅÐ!ˆƒ`Ò`Î Ó$ˆÔ`Î \"+‡" [vip-default-ex-addresses vip-get-ex-buffer ex-addresses beg end error "First address exceeds second" vip-enlarge-region exchange-point-and-mark ex-g-flag ex-g-variant "Can't yank within global" ex-count set-mark mark ex-flag "Extra characters at end of command" ex-buffer copy-to-register nil copy-region-as-kill] 5 (#$ . 61025)]) #@23 execute shell command (defalias 'ex-command #[nil "À‹ˆ „Ä !‚9 @ A@ „Š bˆÇ!ˆÈ`É \"ˆÊ`É Ë$ˆ) b*)‡" [nil command ((byte-code "ÀqˆÁÂwˆÃ`!ˆÂˆÄ `{‡" [" *ex-working-space*" " " nil set-mark mark command] 2)) ex-addresses shell-command beg end set-mark vip-enlarge-region mark shell-command-on-region t] 5 (#$ . 61513)]) #@19 print line number (defalias 'ex-line-no #[nil "ÀÁÂe „\fd‚ @\"T\"‡" [message "%d" count-lines ex-addresses] 5 (#$ . 61852)]) (byte-code "ÀÁ!ƒ\nÂÁ!ˆÀ‡" [file-exists-p "~/.vip" load] 2) emacs-19.30/lisp/viper-ex.elc100666 75424 12 77222 6045215160 14416 0ustar kwzhstaff;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:32:01 1995 ;;; from file /home/fsf/rms/e19/lisp/viper-ex.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`viper-ex.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ\fBÅ !Æ\fBÇÈ\fBÉ\nÊ\fBË\fÌ\fBÍÎ!„1ÏÎ\fBÍÐ!„>ÏÐ\fBÍÑ!„KÏÑ\fBÍÒ!„XÏÒ\fBÍÓ!„eÏÓ\fBÍÔ!„rÏÔ\fBÍÕ!„ÏÕ\fBÍÖ!„ŒÏÖ\fBÍ×!„™Ï×\fBÍØ!„¦ÏØ\fBÍÙ!„³ÏÙ\fBχ" [require viper-util " *ex-working-space*" vip-ex-work-buf-name current-load-list get-buffer-create vip-ex-work-buf " *ex-tmp*" vip-ex-tmp-buf-name (("!") ("=") (">") ("&") ("~") ("yank") ("xit") ("WWrite") ("Write") ("write") ("wq") ("visual") ("version") ("vglobal") ("unmap") ("undo") ("tag") ("transfer") ("suspend") ("substitute") ("submitReport") ("stop") ("sr") ("source") ("shell") ("set") ("rewind") ("recover") ("read") ("quit") ("pwd") ("put") ("preserve") ("PreviousRelatedFile") ("RelatedFile") ("next") ("Next") ("move") ("mark") ("map") ("kmark") ("join") ("help") ("goto") ("global") ("file") ("edit") ("delete") ("copy") ("chdir") ("cd") ("Buffer") ("buffer") ("args")) ex-token-alist (("wrapscan") ("ws") ("wrapmargin") ("wm") ("tab-stop-local") ("tsl") ("tabstop") ("ts") ("showmatch") ("sm") ("shiftwidth") ("sw") ("shell") ("sh") ("readonly") ("ro") ("nowrapscan") ("nows") ("noshowmatch") ("nosm") ("noreadonly") ("noro") ("nomagic") ("noma") ("noignorecase") ("noic") ("noautoindent") ("noai") ("magic") ("ma") ("ignorecase") ("ic") ("autoindent") ("ai")) ex-variable-alist boundp ex-token nil ex-token-type ex-addresses ex-flag ex-buffer ex-count ex-g-flag ex-g-variant ex-reg-exp ex-repl ex-g-pat] 2) #@111 Shell in which to interpret wildcards. Must be csh, tcsh, or similar. Bourne shell doesn't seem to work here. (defconst ex-find-file-shell "csh" (#$ . 1919)) #@43 *Options to pass to `ex-find-file-shell'. (defvar ex-find-file-shell-options "-f" (#$ . -2083)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÂÆ BÀÇ!„:ÂÇ BÀÈ!„GÂÈ BÀÉ!„TÂ É B‡" [boundp ex-tag nil current-load-list ex-file ex-variant ex-offset ex-append ex-cmdfile vip-keep-reading-filename] 2) #@148 *If t, :n and :b cycles through files and buffers in other window. Then :N and :B cycles in the current window. If nil, this behavior is reversed. (defconst ex-cycle-other-window t (#$ . -2407)) #@71 *Cycle through *scratch* and other buffers that don't visit any file. (defconst ex-cycle-through-non-files nil (#$ . -2608)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÆÅ B‡" [boundp vip-ex-last-shell-com nil current-load-list vip-incomplete-ex-cmd vip-last-ex-prompt ""] 2) (defalias 'vip-check-sub #[(str) "G‰\nGXƒ\nà O˜ƒ\n‰‚ĉ)‡" [ex-token length str 0 non-command ex-token-type] 5]) (defalias 'vip-get-ex-com-subr #[nil "ÀÂ`!ˆÃÄ!ˆÅ`ÇÈ!{ Ê ˆËÌ!ƒ>ËÍ!ƒ*ÎÏ!ˆ‚©ËÐ!ƒ7ÎÑ!ˆ‚©ÎÒ!ˆ‚©ËÓ!ƒKÎÔ!ˆ‚©ËÕ!ƒËÖ!ƒ^ÎÖ!ˆ‚©Ë×!ƒkÎØ!ˆ‚©ËÙ!ƒxÎÚ!ˆ‚©ÎÛ!ˆ‚©ËÜ!ƒŒÎÝ!ˆ‚©ËÞ!ƒ™Îß!ˆ‚©Ëà!ƒ¦Îá!ˆ‚©Ëâ!ƒÀËã!ƒ¹Îã!ˆ‚©Îä!ˆ‚©Ëå!ƒÍÎæ!ˆ‚©Ëç!ƒÚÎè!ˆ‚©Ëé!ƒçÎê!ˆ‚©Ëë!ƒôÎì!ˆ‚©Ëí!ƒÎî!ˆ‚©Ëï!ƒ(Ëð!ƒÎð!ˆ‚©Ëñ!ƒ!Îò!ˆ‚©Îó!ˆ‚©Ëô!ƒ:õ öuˆÊ ˆ‚©Ë÷!ƒGÎõ!ˆ‚©Ëø!ƒaËù!ƒZÎú!ˆ‚©Îû!ˆ‚©Ëü!ƒnÎý!ˆ‚©Ëþ!ƒ{Îÿ!ˆ‚©Ë@!ƒ¿ËA!ƒ”ÎB!ˆ‚©ËC!ƒ¥ÎD!ˆ‚©ËE!ƒ¶ÎF!ˆ‚©ÎG!ˆ‚©ËH!ƒÐÎI!ˆ‚©ËJ!ƒáÎK!ˆ‚©ËL!ƒòÎM!ˆ‚©ËN!ƒ%ËO!ƒ ÎP!ˆ‚©ËQ!ƒÎR!ˆ‚©ÎS!ˆ‚©ËT!ƒ­ËU!ƒ>ÎV!ˆ‚©ËW!ƒOÎX!ˆ‚©ËY!ƒ`ÎZ!ˆ‚©Ë[!ƒqÎ[!ˆ‚©Ë\\!ƒ‚Î]!ˆ‚©Ë^!ƒ“Î_!ˆ‚©Ë`!ƒ¤Îa!ˆ‚©Îb!ˆ‚©Ëc!ƒÏËd!ƒÆÎe!ˆ‚©Îf!ˆ‚©Ëg!ƒËh!ƒèÎi!ˆ‚©Ëj!ƒùÎk!ˆ‚©Îl!ˆ‚©Ëm!ƒ5Ën!ƒÎo!ˆ‚©Ëp!ƒ,Îq!ˆ‚©Îr!ˆ‚©Ës!ƒWËt!ƒNÎt!ˆ‚©Îu!ˆ‚©Ëv!ƒyËw!ƒpÎx!ˆ‚©Îy!ˆ‚©Ëz!ƒŠÎ{!ˆ‚©Ë|!ƒ›Î}!ˆ‚©Ë~!ƒ©Î~!ˆÊ )‡" [nil case-fold-search set-mark re-search-forward "[a-zA-Z][a-zA-Z]*" command ex-token-type mark t ex-token exchange-point-and-mark looking-at "a" "ab" vip-check-sub "abbreviate" "ar" "args" "append" "h" "help" "c" "cd" "ch" "chdir" "co" "copy" "change" "d" "delete" "b" "buffer" "B" "Buffer" "e" "ex" "edit" "f" "file" "g" "global" "i" "insert" "j" "join" "l" "list" "m" "map" "mar" "mark" "move" "k[a-z][^a-z]" "kmark" 1 "k" "n" "nu" "number" "next" "N" "Next" "o" "open" "p" "pre" "preserve" "pu" "put" "pw" "pwd" "print" "P" "PreviousRelatedFile" "R" "RelatedFile" "q" "quit" "r" "rec" "recover" "rew" "rewind" "read" "s" "se" "set" "sh" "shell" "so" "source" "sr" "st" "stop" "sus" "suspend" "subm" "submitReport" "substitute" "t" "ta" "tag" "transfer" "u" "una" "unabbreviate" "unm" "unmap" "undo" "v" "ve" "version" "vi" "visual" "vglobal" "w" "wq" "write" "W" "WW" "WWrite" "Write" "x" "xit" "y" "yank" "z"] 3]) (defalias 'vip-get-ex-token #[nil "À‹‡" [((byte-code "qˆÁÂwˆÃÄ!ƒÅÇg!Éu‡ÃÊ!ƒ!Ë ‡ÃÌ!ƒ/ÉuˆÍ‰‡ÃÎ!ƒaÏ`!ˆÐÑ!ˆÒ=ƒHÓ‚TÔ=ƒSÕ‚TÖ×`ØÙ!{!‰‡ÃÚ!ƒoÉuˆÛ‰‡ÃÜ!ƒ}ÉuˆÝ‰‡ÃÞ!ƒ±Ãß!„Ãà!ƒžÉuˆácˆâÉ!ˆÒ‰‡Ãã!ƒ¬ÉuˆÒ‰‡ä%!‡Ãæ!ƒåÃç!„ÃÃè!ƒÒÉuˆácˆâÉ!ˆÔ‰‡Ãé!ƒàÉuˆÔ‰‡ä%!‡Ãê!ƒ(ÉuˆÏ`!ˆÙ+l„+ƒÐì!ˆíî!„õÂ+‚õ)âÉ!ˆ`ØÙ!{Ãê!ƒ#Éuˆï‰‡Ãð!ƒlÉuˆÏ`!ˆÙ+l„^+ƒ^Ðñ!ˆíò!„NÂ+âÉ!ˆÃó!„8Éuˆ‚8)ô`SØÙ!{‰‡Ãõ!ƒzÉuˆö‰‡Ã÷!ƒˆÉuˆø‰‡Ãù!ƒ™ÅÇg!Éu‡Ãú!ƒÄûÉuˆÃú!ƒ±Â‚ÁÃÊ!ƒ½g‚Áäü!ˆÉu‡Ãó!ƒÒýþ‰‡ä?!‡" [vip-ex-work-buf " |" nil looking-at "#" command ex-token-type char-to-string ex-token 1 "[a-z]" vip-get-ex-com-subr "\\." dot "[0-9]" set-mark re-search-forward "[0-9]*" plus add-number minus sub-number abs-number string-to-int mark t "\\$" end "%" whole "+" "+[-+]" "+[\n|]" "1" backward-char "+[0-9]" error vip-BadAddress "-" "-[-+]" "-[\n|]" "-[0-9]" "/" cont "[^/]*\\(/\\|\n\\)" vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/" search-forward "\\?" "[^\\?]*\\(\\?\\|\n\\)" "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?" "\n" search-backward "," comma ";" semi-colon "[!=><&~]" "'" goto-mark "Marks are ' and a-z" end-mark "goto" vip-BadExCommand] 4))] 1]) (defalias 'ex-cmd-read-exit #[nil "ÀÂÃÄÅÄÆÄÇÄÈÉ° ÊÂËÄÌÄÍÉΰ ÂÏÄÐÄÑÄÒÄÓÄÔÄÕÄÖÄ×ÄØÄÙÄÚÄÛÄÜÝÄÞÉß°! !\"㋈ä\"!ƒRå ‚lä !ƒ^æc‚lä!!ƒjå ‚læc+‡" [t vip-incomplete-ex-cmd "\\(" "set[ ]*" "\\|" "edit[ ]*" "[nN]ext[ ]*" "unm[ ]*" "^[ ]*rep" "\\)" "[a-zA-Z][ ]*" "!" ">>" "\\+[0-9]+" "*[ ]*$" "^[ ]*$" "[ktgjmsz][ ]*$" "^[ ]*ab.*" "tr[ansfer ]*" "sr[ ]*" "mo.*" "^[ ]*k?ma[^p]*" "^[ ]*fi.*" "v?gl.*" "[vg][ ]*$" "jo.*" "^[ ]*ta.*" "^[ ]*una.*" "^[ ]*su.*" "\\|['`][a-z][ ]*" "![ ]*[a-zA-Z].*" "!*" stay-regex quit-regex2 quit-regex1 ((byte-code "qˆdb‡" [vip-ex-work-buf] 1)) vip-looking-back exit-minibuffer " "] 35 nil nil]) (defalias 'ex-cmd-complete #[nil "À‰‰‰‰ŠÆÀx`)\fÇU„$ÈÉ!„$ÈÊ!ƒCÈË!†3ÈÉ!†3ÌÍ!?…ŒÎÏÐ!!‘‚Œ `{Ò\n\"‰Ó=ƒYÔÕ!‚Œ À=ƒeÔÖ!‚Œ bˆ`d|ˆ cˆÀØÙ P\") GÚV…ŒÎÏÐÛ !!!‘-‡" [nil completion-result string-to-complete compl-list dist save-pos "[a-zA-Z!=>&~]" 0 vip-looking-back "\\([ ]*['`][ ]*[a-z]*\\)" "^[ ]*[a-zA-Z!=>&~][ ]*[/?]*+[ ]+[a-zA-Z!=>&~]+" "[a-zA-Z!=>&~][ ]*[/?]*[ ]*" looking-at "[^ \n ]" "*Completions*" display-completion-list vip-alist-to-list ex-token-alist try-completion t vip-tmp-insert-at-eob " (Sole completion)" " (No match)" case-fold-search vip-filter-alist "^" 1 reverse] 6 nil nil]) (defalias 'vip-ex #[(&optional string) "„ÁÁÄ !ÁÈ `\nÁ Á\fÍ\"ˆ†1ÏÐÁÑ@%\fÒ‹ˆÁÁ … Õ ˆÖ>ƒ‚ƒWBؘƒhÙÁ!ˆÁ ‚Ú˜ƒyÙÈ!ˆÁ ‚Û ˆÜ‹ˆ‚Ý=ƒ–Þßà!#!ˆ‚â=ƒ·Áƒ¬dB‚²deBB‚ã=ƒÛ â=ƒÈe„Ñ`‚ÓB‚ä=ƒ â=ƒìeƒõ\n„þ`‚B‚å\n\"‰&ƒ&) ‚<.‡" [string nil ex-g-flag ex-g-variant copy-keymap minibuffer-local-map map address t cont dot prev-token-type com-str vip-add-keymap vip-ex-cmd-map vip-read-string-with-history ":" vip-ex-history ((byte-code "ƒÁ!ƒÂÁ!!„Ã\f!qˆed|ˆ Ʊˆeb‡" [vip-ex-work-buf get-buffer buffer-name get-buffer-create vip-ex-work-buf-name com-str "\n"] 3)) ex-token-type ex-addresses vip-get-ex-token (command end-mark) ex-token "global" ex-global "vglobal" vip-execute-ex-command ((byte-code "qˆÁÂwˆÃÄ!ƒÅuˆ‚'ÃÆ!ƒÂ‚'ÈÉ\n #ˆÂ‡" [vip-ex-work-buf " " nil looking-at "|" 1 "\n" cont error "`%s': %s" ex-token vip-SpuriousText] 4)) non-command error format "`%s': %s" vip-BadExCommand whole comma semi-colon vip-get-ex-address-subr ans] 7 nil nil]) (defalias 'vip-get-ex-pat #[nil "À‹‡" [((byte-code "qˆÁÂwˆÃÄ!ƒ ??ÇuˆÁÂwˆgÉÊËÌ\"\"ƒ.ÍÎ!ˆÃÏ!ƒ‘ÇuˆÐ`!ˆÑl„uƒuÓËÔ‰#ÂÑ#„eÖƒbÍ×!ˆ‚edbˆØËÙ\"!„>‚>)ÚÑ!`Uƒ‚Û‚ˆ`SÚÑ!{ÜÇ!ˆ‚”Â)‡" [vip-ex-work-buf " " nil looking-at "!" ex-g-variant ex-g-flag 1 c string-match "[0-9A-Za-z]" format "%c" error "Global regexp must be inside matching non-alphanumeric chars" "[^\\\\\n]" set-mark t cont re-search-forward "[^%c]*%c" ex-token ("global" "vglobal") "Missing closing delimiter for global regexp" vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" mark "" backward-char] 5))] 1]) (defalias 'vip-get-ex-command #[nil "À‹‡" [((byte-code "qˆÁÂ!ƒ\fÃuˆÄÅwˆÁÆ!ƒ(Ç ˆÉ=…:ÊË\f #‡ÁÎ!ƒ6Ïg!\fÃu‡Ê !‡" [vip-ex-work-buf looking-at "/" 1 " " nil "[a-z]" vip-get-ex-com-subr ex-token-type non-command error "`%s': %s" ex-token vip-BadExCommand "[!=><&~]" char-to-string] 4))] 1]) (defalias 'vip-get-ex-opt-gc #[(c) "À‹‡" [((byte-code "qˆÁÂÃ\f\"!ƒÅuˆÆÇwˆÁÈ!ƒ!È ÅuˆÊ‡ÁË!ƒ/Ë ÅuˆÊ‡Ç‡" [vip-ex-work-buf looking-at format "%c" c 1 " " nil "g" ex-token t "c"] 4))] 1]) (defalias 'vip-default-ex-addresses #[(&optional whole-flag) "„ ƒdeÂBB‚``ÂBB‰‡A?…$@B‰‡" [ex-addresses whole-flag nil] 3]) (defalias 'vip-get-ex-address #[nil "À ÁÄÆ\nƒlÈ ˆ Ê=ƒ. ˃'ÁƉ‚ ÌÍ!ˆ‚\n Î=ƒ;Ɖ‚  Ï=ƒIÌÐ!ˆ‚\n Ñ=ƒZÌÒ #ˆ‚\nÔ À \"‰ƒh)‚\n *‡" [point-marker t cont address "" ex-token nil ex-flag vip-get-ex-token ex-token-type command ("print" "list" "#") error "Address expected in this Ex command" end-mark whole "Trailing address expected" comma "`%s': %s" vip-SpuriousText vip-get-ex-address-subr ans] 5]) (defalias 'vip-get-ex-address-subr #[(old-address dot) "À\n„ \fÃ=ƒ ‚È\fÅ=ƒ4Š\nbˆ\nÆUƒ)S‚+yˆÈ )‚È\fÉ=ƒJŠ\nbˆ[yˆÈ )‚È\fÊ=ƒlŠebˆÆUƒ`Æ‚hSyˆÈ )‚È\fË=ƒxÌ ‚È\fÍ=„È\fÎ=„È\fÏ=ƒ–ŠÐÑ!ˆÈ )‚È\fÒ=ƒ¨ŠÐÀ!ˆÈ )‚È\fÓ=ƒÈŠ„ºÔ ˆ‚ÄÕÖZT×\"bˆÈ ) )‡" [nil address old-address dot ex-token-type add-number 0 ex-token point-marker sub-number abs-number end point-max-marker plus minus search-forward ex-search-address t search-backward goto-mark exchange-point-and-mark vip-register-to-point 97 enforce-buffer] 3]) (defalias 'ex-search-address #[(forward) "Á˜ƒ\n„Ã\f!ˆ‚\n‚ ƒ#ÆyˆÇ!‡ÈyˆÉ!‡" [ex-token "" vip-s-string error vip-NoPrevSearch forward 1 re-search-forward -1 re-search-backward] 2]) (defalias 'vip-get-ex-buffer #[nil "ÀÀÀÄ‹‡" [nil ex-buffer ex-count ex-flag ((byte-code "qˆÁÂwˆÃÄ!ƒgÆuˆÁÂwˆÃÇ!ƒ1È`!ˆÉÊ!ˆË`ÌÍ!{!ÁÂwˆÃÏ!ƒ=ÍÆuˆÃÑ!?…KÒÓ#‡" [vip-ex-work-buf " " nil looking-at "[a-zA-Z]" ex-buffer 1 "[0-9]" set-mark re-search-forward "[0-9][0-9]*" string-to-int mark t ex-count "[pl#]" ex-flag "[\n|]" error "`%s': %s" ex-token vip-SpuriousText] 4))] 1]) (defalias 'vip-get-ex-count #[nil "ÀÀÀÄ‹‡" [nil ex-variant ex-count ex-flag ((byte-code "qˆÁÂwˆÃÄ!ƒÅÇuˆÁÂwˆÃÈ!ƒ2É`!ˆÊË!ˆÌ`ÍÅ!{!ÁÂwˆÃÏ!ƒ>ÅÇuˆÃÑ!?…NÒÓedS{#‡" [vip-ex-work-buf " " nil looking-at "!" t ex-variant 1 "[0-9]" set-mark re-search-forward "[0-9][0-9]*" string-to-int mark ex-count "[pl#]" ex-flag "[\n|]" error "`%s': %s" vip-BadExCommand] 4))] 1]) (defalias 'ex-expand-filsyms #[(cmd buf) "À‰‰Š\fqˆ ÆÀÇ\") „\"ÈÉ\n\"ƒ\"ËÌ!ˆ\n„2ÈÍ\n\"ƒ2ËÎ!ˆŠÏ!qˆÑ ˆ\ncˆebˆÒÓÀÇ#ƒ‚Ô Õ”Õ•{ØÙP!ƒgÚ!ˆ‚~Û!ˆܘƒzÚ !ˆ‚~Ú\n!ˆ*‚CÀˆe`{ÝÞ \"ˆ) +‡" [nil ret pf cf buf buffer-file-name ex-next t string-match "[^\\]%\\|\\`%" cmd error "No current file to substitute for `%'" "[^\\]#\\|\\`#" "No alternate file to substitute for `#'" get-buffer-create vip-ex-tmp-buf-name erase-buffer re-search-forward "%\\|#" match-data 0 char data vip-looking-back "\\\\" replace-match store-match-data "%" message "%s"] 4]) (defalias 'vip-get-ex-file #[nil "ÀÀÀÀÀÀŠÇ‹ˆ)  ƒ%ÊËÌ \"!‰‚,\n†*͉)‡" [nil prompt ex-file ex-variant ex-append ex-offset ex-cmdfile ((byte-code "qˆÁÂwˆÃÄ!ƒ1ÅÆ!„'Ș„'É\nËuˆÁÂwˆ‚1É\fËuˆÁÂwˆÃÍ!ƒDÉÉ\nÏuˆÁÂwˆÃÐ!ƒgËuˆÑ`!ˆÒÓ!ˆÔË!ˆ`ÕÉ!{ËuˆÁÂwˆ׃œ`dS{ÙÚ˜ƒ€Û‚Ü\"ƒ”ÂÞ”Þ•O‚•ß`dS|ˆdbˆàÂxˆe`{!‡" [vip-ex-work-buf " " nil looking-at "!" vip-looking-back "[ ]" ex-token "read" t ex-variant 1 ex-cmdfile ">>" ex-append 2 "+" set-mark re-search-forward "[ \n]" backward-char mark ex-offset ("read" "write" "edit" "visual" "next") ex-file string-match "edit" "[^ \n]+\\([ ]+[^ \n]+\\)*" "[^ \n]+" vip-incomplete-ex-cmd 0 "" " \n" prompt] 3)) vip-last-ex-prompt vip-incomplete-ex-cmd vip-ex-read-file-name format ":%s " ""] 4]) (defalias 'vip-complete-filename-or-exit #[nil "À !ƒ Ä ‡Å ‡" [t vip-keep-reading-filename ex-cmd-accepts-multiple-files-p ex-token exit-minibuffer minibuffer-complete-word] 2 nil nil]) (defalias 'ex-cmd-accepts-multiple-files-p #[(token) "Á‡" [token ("edit" "next" "Next")] 2]) (defalias 'vip-ex-read-file-name #[(prompt) "À !ÄÄÄÄÉ\n \"ˆË‰\f‰ƒZÄ\fÍ PÄ# Àšƒ;À‚<ЉÀšƒHÀ‚IÐR\f…TÑ!‰„!ÓÔ \"ÓÕ \"ÖƒÓ× \"ƒË TÚP †…ÛO.‡" ["" str copy-keymap minibuffer-local-completion-map nil beg end cont val vip-add-keymap ex-read-filename-map t vip-keep-reading-filename read-file-name prompt default-directory " " ex-cmd-accepts-multiple-files-p ex-token string-match "[^ ]" "[ ]*$" ("read" "write") "[ ]*!" ex-cmdfile vip-last-ex-prompt " !" 0] 6]) (defalias 'vip-execute-ex-command #[nil "À ˆ ˜ƒ\fà ‡ ĘƒÅÆ!‡ ǘƒÈ ‡ ɘƒ(È ‡ ʘƒ1Ë ‡ ̘ƒ:Í ‡ ΘƒCÏ ‡ ИƒLÑ ‡ Ò˜ƒUÓ ‡ Ô˜ƒ_ÕÔ!‡ Ö˜ƒh× ‡ ؘƒq× ‡ Ù˜ƒzÚ ‡ Û˜ƒ„ÅÜ!‡ ݘƒÞ!‡ à˜ƒ›Þ?!‡ ᘃ¥âã!‡ 䘃®å ‡ 昃·ç ‡ 蘃Àé ‡ ꘃÊâë!‡ 옃Óí ‡ Üï ‡ ð˜ƒåñ ‡ ò˜ƒîó ‡ ô˜ƒ÷õ ‡ ö˜ƒ÷ ‡ ø˜ƒ ù ‡ ú˜ƒû ‡ ü˜ƒý܉\"‡ þ˜ƒ&ý ‡ ÿ˜ƒ1@ ‡ A˜ƒ>@ ‡ B˜ƒJÅÆ!‡ C˜ƒaƒ\\D ‡E ‡ F˜ƒxƒsE ‡D ‡ G˜ƒ…H ‡ I˜ƒ’J ‡ K˜ƒŸL ‡ M˜ƒ¬N ‡ O˜ƒ·Í ‡ P˜ƒÅQÆ!‡ R˜ƒÒS ‡ T˜ƒàQÜ!‡ U˜ƒîSÜ!‡ V˜ƒüQÜ!‡ W˜ƒ X ‡ Y˜ƒZ ‡ [˜ƒ#\\ ‡ ]˜ƒ1Õ^!‡ _˜ƒ?Õ`!‡ a˜ƒKýÜ!‡ b˜ƒXý܉\"‡ c˜„x d˜„x e˜„x f˜ƒ…ghi \"!‡ j˜„• k˜ƒ¢ghl \"!‡ m˜„ n˜„ o˜„ p˜ƒÏghq \"!‡ghr s#!‡" [vip-deactivate-mark ex-token "args" ex-args "copy" ex-copy nil "cd" ex-cd "chdir" "delete" ex-delete "edit" ex-edit "file" vip-info-on-file "goto" ex-goto "help" ex-help "join" ex-line "kmark" ex-mark "mark" "map" ex-map "move" t "next" ex-next ex-cycle-other-window "Next" "RelatedFile" ex-next-related-buffer 1 "put" ex-put "pwd" ex-pwd "preserve" ex-preserve "PreviousRelatedFile" -1 "quit" ex-quit "read" ex-read "recover" ex-recover "rewind" ex-rewind "submitReport" vip-submit-report "set" ex-set "shell" ex-shell "source" ex-source "sr" ex-substitute "substitute" "suspend" suspend-emacs "stop" "transfer" "buffer" vip-switch-to-buffer-other-window vip-switch-to-buffer "Buffer" "tag" ex-tag "undo" vip-undo "unmap" ex-unmap "version" vip-version "visual" "write" ex-write "Write" save-some-buffers "wq" "WWrite" "xit" "yank" ex-yank "!" ex-command "=" ex-line-no ">" "right" "<" "left" "&" "~" "append" "change" "insert" "open" error format "`%s': Obsolete command, not supported by Viper" "abbreviate" "unabbreviate" "`%s': Vi-style abbrevs are obsolete. Use the more powerful Emacs abbrevs" "list" "print" "z" "#" "`%s': Command not implemented in Viper" "`%s': %s" vip-BadExCommand] 5]) (defalias 'vip-undisplayed-files #[nil "ÀÁ \"‡" [mapcar #[(b) "À !?…* !‰ƒ ‚)\f…)Å !‰ÇÈOɘ?…())‡" [get-buffer-window b buffer-file-name f ex-cycle-through-non-files buffer-name s 0 1 " "] 4] buffer-list] 3]) (defalias 'ex-args #[nil "À Á‰ƒ\" @ƒÆÇ\f @$ T A‰„ \fÁ˜ƒ.ÈÉ!‚2ŠÊ‹)+‡" [vip-undisplayed-files "" 1 file-count args l format "%s %d) %s\n" message "All files are already displayed" ((byte-code "ÀÁÂ!ˆÁÃ!ˆÁ\f!ˆÁÃ!ˆÁÅ!ˆÁÆ!‘ˆÇ ‡" [" *vip-info*" princ "\n\nThese files are not displayed in any window.\n" "\n=============\n" args "\nThe numbers can be given as counts to :next. " "\n\nPress any key to continue...\n\n" vip-read-event] 3))] 6]) (defalias 'ex-cd #[nil "À ˆ ˜ƒ ÃÄÅ !!‰‡" [vip-get-ex-file ex-file "" "~" file-name-as-directory expand-file-name default-directory] 3]) (defalias 'ex-copy #[(del-flag) "À ˆÁ \n@\nA@\fbˆŠÆ Ç\"ˆÈÉÇ!`\"ˆ\nƒ,Ë`ÉÇ!\"ˆ‚3Ì`ÉÇ!\"ˆ ƒ]ÎÏ\n„J„JƒPÒÓ!‚U`ÉÇ!{!‘ˆÔÕÖˆ) ÓUƒjebˆ‚p bˆ×yˆÒÓ!c+‡" [vip-default-ex-addresses vip-get-ex-address ex-addresses beg end address push-mark t vip-enlarge-region mark del-flag kill-region copy-region-as-kill ex-flag "*copy text*" princ ex-g-flag ex-g-variant current-kill 0 nil (byte-code "ÀÁ!ˆŠÂÃ!ˆ)À‡" [read-string "[Hit return to continue] " kill-buffer "*copy text*"] 2) ((quit (byte-code "ŠÀÁ!ˆ)ÂÃÄ\"‡" [kill-buffer "*copy text*" signal quit nil] 3))) 1] 5]) (defalias 'ex-delete #[nil "À ˆÁ ˆ\n@\nA@ \fVƒÅ!ˆŠÇ \f\"ˆÈ ˆ ƒ2Ê`!ˆ Syˆ‚6Ê\f!ˆÇ`ËÌ!\"ˆ ƒZÎÏ`ËÌ!{!‘ˆÐÑÒˆŠÓÎ!)‚•ƒÕÖ\"ƒt×—`ËÌ!#ˆ‚Õ!ƒˆØ`ËÌ!Ð$ˆ‚Å\"ˆÚ`ËÌ!\"+‡" [vip-default-ex-addresses vip-get-ex-buffer ex-addresses beg end error vip-FirstAddrExceedsSecond vip-enlarge-region exchange-point-and-mark ex-count set-mark mark t ex-flag " *delete text*" princ nil (read-string "[Hit return to continue] ") ((quit (byte-code "ŠÀÁ!ˆ)ÂÃ!‡" [kill-buffer " *delete text*" error ""] 2))) kill-buffer ex-buffer vip-valid-register (Letter) vip-append-to-register copy-to-register vip-InvalidRegister kill-region] 5]) (defalias 'ex-edit #[(&optional file) "„Á ˆ\n؃\fƒÅÄ !‚$\n؃$Æ!ˆÈ‰ \n\fƒUË ƒ@ÌÍÎ \"\nÏ ‚UÐp!„RÌÑ\f\"\nÏ ‚UÈ  ƒrÒ\n!ƒlÓÈ!ˆÔp!ˆ‚rÕÖÎ \"ˆ*×\n!‰„ˆØ\n!ˆÙ ˆebˆ‚ŒÚ!ˆƒ›Ü‹ˆÝ bˆÞyˆß \n\"‡" [file vip-get-ex-file ex-file "" buffer-file-name abbreviate-file-name error vip-NoFileSpecified nil do-edit msg buffer-modified-p format "Buffer %s is modified. Discard changes? " buffer-name t verify-visited-file-modtime "File %s changed on disk. Reread from disk? " yes-or-no-p set-buffer-modified-p kill-buffer message "Buffer %s was left intact" get-file-buffer ex-find-file vip-change-state-to-vi switch-to-buffer ex-offset ((byte-code "qˆed|ˆ ±ˆeb‡" [vip-ex-work-buf ex-offset "\n"] 2)) vip-get-ex-address 0 ex-fixup-history vip-last-ex-prompt] 3]) (defalias 'ex-find-file #[(filespec) "À‰‰‰ÅÆ\"ƒuŠÈ !‰qˆÊ ˆË\fÀÍÀÏÐÑ\"&ebˆ ÒVƒQŠÓÀwˆÔÕ!ƒEÖ×!ˆØÙ`ÚÛ!{#ˆ)Üed\"ˆebˆm„q`ÚÛ!{Ý\f!\nqˆÞ×!ˆ‚Y)‚|߉!à !,‡" [nil status tmp-buf filebuf f string-match "[^a-zA-Z0-9_.-/]" filespec get-buffer-create vip-ex-tmp-buf-name erase-buffer call-process ex-find-file-shell t ex-find-file-shell-options "-c" format "echo %s | tr ' ' '\\012'" 0 " \nj" looking-at "echo:" vip-forward-word 1 error "%S%s" vip-line-pos end reverse-region find-file forward-to-indentation find-file-noselect switch-to-buffer] 10]) (defalias 'ex-global #[(variant) "\n„\n ƒÄÅ \"ˆ‚\"ƒÇÈ‚\"ÈÇÉ ˆ„.ÄÊ \"ˆ)˘ƒI\f„BÄ !ˆ‚O\f‚O\f„\\deD‚_Ð ˆÇÑÇ@A@Vƒ€Ä!ˆŠØ\"ˆÙ ˆÈÚ Ù ˆÑyˆmƒŸÝ ˆƒüo„ü`YƒüÑyˆÞ`!ˆÇˆßàÈ!È#!\nƒÌ!„Õ ƒä!„äLjTÚ B)Ñyˆoƒólj‚¡âyˆÇˆ‚Ÿ+㋈…@bˆä!ˆSA‰„Ç-‡" [ex-token gcommand ex-g-flag ex-g-variant error "`%s' within `global' is not allowed" variant nil t vip-get-ex-pat "`%s': Missing regular expression" "" vip-s-string vip-NoPrevSearch ex-g-pat ex-addresses vip-default-ex-addresses 0 beg end com-str mark-count marks vip-FirstAddrExceedsSecond vip-enlarge-region exchange-point-and-mark point-marker limit cont vip-backward-char-carefully set-mark re-search-backward mark found -1 ((byte-code "qˆ`TdS{‡" [vip-ex-work-buf com-str nil] 2)) vip-ex] 6]) (defalias 'ex-goto #[nil "„`ÁBÂ`Ã\"ˆ@bˆÄyˆÁ‡" [ex-addresses nil push-mark t 0] 3]) (defalias 'ex-line #[(com) "À ˆÁ ˆ\n@\nA@à VƒÇ!ˆŠÉ \"ˆÊ ˆ ƒ3Ì`!ˆ yˆ ƒQÎÏ`ÐÑ!{!‘ˆÃÒÓˆŠÔÎ!ˆ)‚ZÕ`ÐÑ!#ˆ`)\fSbˆ×yˆ+Ç" [vip-default-ex-addresses vip-get-ex-count ex-addresses nil point beg end error vip-FirstAddrExceedsSecond vip-enlarge-region exchange-point-and-mark ex-count set-mark ex-flag " *text*" princ mark t (byte-code "ÀÁ!ˆÂ `ÄÅ!#‡" [read-string "[Hit return to continue] " ex-line-subr com mark t] 5) ((quit (ding))) kill-buffer ex-line-subr com 0] 5]) (defalias 'ex-line-subr #[(com beg end) "Á˜ƒ;\n ^bˆm?…:`\n ]W…hĈ`\n ]Xƒ m„ Åyˆ``S|ˆ„ Ç ˆ‚ ‡Ș„Gɘ…hÊ\n ^\n ]ȘƒY ‚\\ [#ˆ\n ]bˆÄˆÌ ‡" [com "join" beg end nil 1 ex-variant fixup-whitespace "right" "left" indent-rigidly vip-shift-width vip-forward-char-carefully] 5]) (defalias 'ex-mark #[nil "À\n„\n`ÀBˈŠ\n@bˆÄ ÅZT!*‡" [nil char ex-addresses ((byte-code "qˆÁÂwˆÃÄ!ƒ'gÆuˆÁÂwˆÃÇ!„-ÈÉ\n #ˆ‚-ÈÌ\n\"ˆÂ‡" [vip-ex-work-buf " " nil looking-at "[a-z]" char 1 "[\n|]" error "`%s': %s" ex-token vip-SpuriousText "`%s' requires a following letter"] 4)) point-to-register 97] 3]) (defalias 'ex-next #[(cycle-other-window &optional find-alt-file) "ÀÁ‡" [ex-edit (byte-code "À‰ „GÄ ˆÅ!„!Ș„-ÉÊ\"„-ËÌ!ˆÍËÀ\"ˆ‚IÎ!‰ÏUƒ:Ð\nÏWƒIÑÒ!ˆ‚IÐÓ \nÏVƒq ƒb @„b A‰„V\nS‰ÏVƒL A‚L ƒz @‚® @ƒ«ƒ‰Õ ‚‹Ö Ø!ÚÛ @!\"ˆÜ!ˆÝ\"*‚®Ñß!*‡" [nil l count find-alt-file vip-get-ex-file char-or-string-p ex-offset ex-file "" string-match "^[0-9]+$" ex-edit t throw string-to-int 0 1 error "Usage: `next ' (count >= 0)" vip-undisplayed-files cycle-other-window get-lru-window selected-window w window-buffer b set-window-buffer get-file-buffer bury-buffer ex-fixup-history vip-last-ex-prompt "Not that many undisplayed files"] 5)] 2]) (defalias 'ex-next-related-buffer #[(direction &optional no-recursion) "À \n\"ˆÃ ! Ä Å‰‰ \n Ì !ƒ(Í !ÎV„,ÏÐ!ˆ ;„8ÏÑ \"ˆÒ !†JÓ !…JÔ !‰ƒ`Ò!ƒ`ÕÒ!!„lÏÖ ×Ø !!#ˆpšƒ„„„Ú‰„„Û\nÜ\"ˆ?…üÝ!‰„¦Þ?…œà!á\"ˆ\"ƒ°#‚´äå !ƒë\"ƒÁ#‚Åäå !æ>„ëçè!!ˆè!è !šƒã鋈‚îê!ˆ‚î니Šqˆ\n)ì ‰-.‡" [vip-ring-rotate1 vip-related-files-and-buffers-ring direction vip-current-ring-item selected-window nil wind buf skip-rest old-win old-ring file-or-buffer-name ring-p ring-length 0 error "This buffer has no related files or buffers" "File and buffer names must be strings, %S" get-buffer file-exists-p find-file-noselect buffer-name "Didn't find buffer %S or file %S" abbreviate-file-name expand-file-name no-recursion t ex-next-related-buffer norecursion vip-get-visible-buffer-window get-lru-window vip-xemacs-p visible set-window-buffer vip-emacs-p window-system device-type selected-device (tty stream) raise-frame window-frame ((byte-code "À !ˆÂÃ!‡" [select-window wind sit-for 1] 2)) select-window ((byte-code "À !ˆÂÃ!‡" [select-window wind sit-for 1] 2)) point-marker vip-local-search-start-marker] 7]) (defalias 'ex-preserve #[nil "ÀÁ!ˆÂÃ!‡" [message "Autosaving all buffers that need to be saved..." do-auto-save t] 2]) (defalias 'ex-put #[nil "„`‚\n@ ˆ  bˆoƒÅÆ!‚ ÇÆ!)‡" [ex-addresses point vip-get-ex-buffer ex-buffer vip-use-register vip-Put-back 1 vip-put-back] 2]) (defalias 'ex-pwd #[nil "À !‡" [message default-directory] 2]) (defalias 'ex-quit #[nil "ŠqˆÁÂ!ƒ Ãuˆ)\fÅWƒÆ ‡Çp!‡" [vip-ex-work-buf looking-at "!" 1 vip-expert-level 3 save-buffers-kill-emacs kill-buffer] 2]) (defalias 'ex-read #[nil "À ˆ „ `‚ @‰bˆÃ ˆo„m„Äyˆ „8ǘƒ8„4É\n!ˆ ƒFÌÍ\"ˆ‚KÎ!ˆ)Ï\"‡" [vip-get-ex-file ex-addresses point vip-add-newline-at-eob-if-necessary 1 ex-variant ex-file "" buffer-file-name error vip-NoFileSpecified ex-cmdfile shell-command t insert-file-contents ex-fixup-history vip-last-ex-prompt] 4]) (defalias 'ex-fixup-history #[(&rest args) "ÀÁ\nÃ#\fAB‰‡" [mapconcat identity args " " vip-ex-history] 4]) (defalias 'ex-recover #[nil "À ˆ „ \nƒÃÄ \"ˆǘƒ'„ ÃÉ!ˆ‚-Ê!È ˜„CË ƒC\f„CÃÍ!ˆÎ!‡" [vip-get-ex-file ex-append ex-offset error "`recover': %s" vip-SpuriousText ex-file "" buffer-file-name "This buffer isn't visiting any file" expand-file-name buffer-modified-p ex-variant "No write since last change (:rec! overrides)" recover-file] 3]) (defalias 'ex-rewind #[nil "ÀÁ!‡" [message "Use `:n ' instead. Counts are obtained from the `:args' command"] 2]) (defalias 'ex-set-read-variable #[nil "À !ÂÉÇ ÈÉ#ˆÇ ÊË#ˆÌÍÎÃÏ#!ƒ'ÂÌÐ!ˆÑÒ!ˆ\f„3ÓÔ!ˆÕÖ×Ø\"‰\"ƒQÑÚ!ˆÌÛ!„3ÓÔ!ˆ‚3 ,‡" [copy-keymap minibuffer-local-completion-map t nil batch str cursor-in-echo-area define-key " " minibuffer-complete-and-exit "=" exit-minibuffer vip-set-unread-command-events ex-get-inline-cmd-args "[ ]*[a-zA-Z]*[ ]*" " " 13 message ":set [= ]" sit-for 2 string-match "^[ \\t\\n]*$" completing-read ":set " ex-variable-alist ":set " ""] 5]) (defalias 'ex-set #[nil "À ÁÂÃÄÅƉ‰‰ \n \f ‰у2ÒÓ‚ßÔƒBÒÕ‚ßÖƒR×Ó‚ß؃b×Õ‚ßÙƒrÚÓ‚ßÛƒ‚ÚÕ‚ß܃’ÝÓ‚ßÞƒ¢ÝÕ‚ß߃²àÓ‚ßáƒÂàÕ‚ßâƒÒãÓ‚ßäƒßãÕÁ=ƒ‚Ã%æçè\"!ˆéê!„ûëì!ˆíçî\"!ïð#ˆñƒÆòóˆôƒ%õ‚~öƒ9÷ø!ˆùú‚~ûƒLùÂÆ ‚~üƒg÷ý!ˆþçÿ\"ú‚~@ƒ~AçB\")‚ˆïð\"ˆçC\f%\nçD\f$  ƒöEçFG\"!ƒöH\nG #ˆþ˜ƒöÁVƒâHI\fPG #ˆ‚öHÆG #ˆHÆG #ˆæçJKL\"ƒçM\"‚$!ˆNO\n!@!ˆþ˜…EÁVƒ>PQ!‚EPR!.\n‡" [ex-set-read-variable 0 "setq" t "; don't touch or else..." "([ ]*add-hook[ ]+'vip-insert-state-hooks[ ]+'turn-on-auto-fill.*)" nil orig-var val2 lisp-cmd-del-pattern actual-lisp-cmd delete-turn-on-auto-fill-pattern auto-cmd-label ask-if-save set-cmd val var ("ai" "autoindent") "vip-auto-indent" "t" ("noai" "noautoindent") "nil" ("ic" "ignorecase") "vip-case-fold-search" ("noic" "noignorecase") ("ma" "magic") "vip-re-search" ("noma" "nomagic") ("ro" "readonly") "buffer-read-only" ("noro" "noreadonly") ("sm" "showmatch") "blink-matching-paren" ("nosm" "noshowmatch") ("ws" "wrapscan") "vip-search-wrap-around-t" ("nows" "nowrapscan") cursor-in-echo-area message format ":set %s = " vip-set-unread-command-events "" sit-for 2 read-string ":set %s = " ex-fixup-history "set" ("sw" "shiftwidth" "ts" "tabstop" "wm" "wrapmargin") (byte-code "À !@‰§„ÃÄ #ˆÀ‡" [read-from-string val val2 error "%s: Invalid value, numberp, %S" var] 4) ((error (error "%s: Invalid value, numberp, %S" var val))) ("sw" "shiftwidth") "vip-shift-width" ("ts" "tabstop") kill-local-variable tab-width "tab-width" "setq-default" ("tsl" "tab-stop-local") ("wm" "wrapmargin") fill-column "fill-column" "(- (window-width) %s)" ("sh" "shell") "explicit-shell-file-name" "\"%s\"" "\n(%s %s %s) %s" "^\n?[ ]*([ ]*%s[ ]+%s[ ].*)[ ]*%s" y-or-n-p "Do you want to save this setting in %s " vip-custom-file-name vip-save-string-in-file "(add-hook 'vip-insert-state-hooks 'turn-on-auto-fill) " "%s %s %s" string-match "^[ ]*$" "%S" eval read-from-string auto-fill-mode 1 -1] 11]) (defalias 'ex-get-inline-cmd-args #[(regex-forw &optional chars-back replace-str) "ŠqˆebˆÁ\nÃÄ#ˆ`Ãdbˆƒ\"Ãxˆ‚&ÈÃxˆ`bˆ ƒFÁÊÃÄ#ƒFË ÃÄ#ˆÌ ˆ‚1 bˆ {+‡" [vip-ex-work-buf re-search-forward regex-forw nil t end beg chars-back " \n " replace-str " +" replace-match vip-forward-char-carefully] 4]) (defalias 'ex-shell #[nil "À ‡" [shell] 1]) (defalias 'ex-help #[nil "ÀÁ‡" [nil (byte-code "ÀÁÂ!!ˆÃÄ!ˆÅÆ!‡" [pop-to-buffer get-buffer-create "*info*" info "viper.info" message "Type `i' to search for a specific topic"] 3) ((error (byte-code "ÀÁ!ˆÂÃÄŃǂÈ\"!‘‡" [beep 1 " *vip-info*" princ format "\nThe Info file for Viper does not seem to be installed.\n\nThis file is part of the standard distribution of %sEmacs.\nPlease contact your system administrator. " vip-xemacs-p "X" ""] 5)))] 3]) (defalias 'ex-source #[nil "À ˆ ˜ƒ Ã\f!‡Ã !‡" [vip-get-ex-file ex-file "" load vip-custom-file-name] 2]) (defalias 'ex-substitute #[(&optional repeat r-flag) "À‰‰ À‰‰ ƒÀ\n‚Ë \n„D\fƒ. ‚0‰;„:ÏÐ!ˆÒ !‚q\nÓ˜ƒP ‚R\n‰ Ë \n„jÓ\nÓ‚q\n\nÔ\f!ƒŠ\nÕ˜ƒ„Ö‚qÖ‚q× ˆƒ³Šƒ@bˆÚ`!ˆSyˆ`ÛÖ!ÀBB)‚ЄÂ``ÀBB‚ÐA„Ð@B@A@ÀŠß\"ˆŠ`ÛÖ!]bˆà )!`ÛÖ!^bˆ`!Wƒ}Àˆà âyˆƒFl„=ã Ö#ƒ=ƒ(äå!ƒ`\n;„4Ïæ!ˆç\nÖ‰#ˆ‚Àˆè ˆ‚ú „NÏé!ˆã Ö#ƒtƒbäå!ƒt`\n;„nÏæ!ˆç\nÖ‰#ˆÀˆè ˆ‚ú-ƒ‡bˆâyˆ…’êë!.‡" [nil vip-case-fold-search repl pat delim case-fold-search matched-pos opt-c opt-g repeat ex-token vip-get-ex-pat r-flag vip-s-string ex-reg-exp error "No previous pattern to use in substitution" ex-repl string-to-char "" vip-get-ex-opt-gc "g" t vip-get-ex-count ex-count ex-addresses set-mark mark eol-mark end beg vip-enlarge-region point-marker limit 0 re-search-forward y-or-n-p "Replace? " "Can't perform Ex substitution: No previous replacement pattern" replace-match vip-forward-char-carefully "Can't repeat Ex substitution: No previous regular expression" message "done"] 8]) (defalias 'ex-tag #[nil "À‹ˆ Ø„ Å ˆÆÇÈ)‡" [nil tag ((byte-code "qˆÁÂwˆÃ`!ˆÄÂwˆÅÆ!`{‡" [vip-ex-work-buf " " nil set-mark "^ | \n" mark t tag] 2)) "" ex-tag vip-change-state-to-emacs conds (byte-code "Á˜ƒ Ä\"ˆ‚Å !ˆÆ ‡" [tag "" find-tag ex-tag t find-tag-other-window vip-change-state-to-vi] 3) ((error (byte-code "À ˆÁ\n!‡" [vip-change-state-to-vi vip-message-conditions conds] 2)))] 3]) (defalias 'ex-write #[(q-flag) "ÀÁ!ˆÂ ˆ @ A@ĉ‰‰‰ \n \n Vƒ+Ì !ˆƒBÏ\n \"ˆÐ`ÑÁ!#‚dÓ˜ƒWÔ „WÕÖ×Ø \"!e\nU…bd UÓ˜ƒoÔ ‚sÙ!Ú!ƒ‘ƒ‘Ú!„‘Û!PÜ!Ô ˜ ƒÄƒÄÝ „³Þß!ˆ‚6à ˆá\n $ˆ‚6âã!‰ !ˆÄŽŠƒì„ìäÖå\"!„ìÌæ!ˆ‚(Ï\n \"ˆ`ÑÁ!{ qˆç!ˆè ˆƒ)ƒê!ˆdbˆcˆà ˆáed$ˆ qˆëÄ!ˆì !ˆ*Ô ƒCƒCí ˆ „PƒPëÁ!ˆ.…d/ðWƒañ ‚dìp!.‡" [vip-default-ex-addresses t vip-get-ex-file ex-addresses nil writing-whole-file file-exists region writing-same-file temp-buf beg end error vip-FirstAddrExceedsSecond ex-cmdfile vip-enlarge-region shell-command-on-region mark ex-file "" buffer-file-name read-file-name format "Buffer %s isn't visiting any file. File to save in: " buffer-name expand-file-name file-directory-p file-name-nondirectory file-exists-p buffer-modified-p message "(No changes need to be saved)" save-buffer ex-write-info buffer-disable-undo create-file-buffer yes-or-no-p "File %s exists. Overwrite? " "Quit" set-visited-file-name erase-buffer ex-append insert-file-contents set-buffer-modified-p kill-buffer set-visited-file-modtime q-flag vip-expert-level 2 save-buffers-kill-emacs] 7]) (defalias 'ex-write-info #[(exists file-name beg end) "ÀÁ !\fƒ Å‚ÆÇ Td^\" Z%‡" [message "`%s'%s %d lines, %d characters" abbreviate-file-name file-name exists "" " [New file]" count-lines beg end] 8]) (defalias 'ex-yank #[nil "À ˆÁ ˆ\n@\nA@ \fVƒÅ!ˆŠÇ \f\"ˆÈ ˆ „+\nƒ/ÅË!ˆ\fƒ@Í`!ˆ\fSyˆ‚DÍ\f!ˆÇ`ÎÏ!\"ˆƒVÅÑ\"ˆƒ‹ÔÕ\"ƒpÖ—`ÎÏ!#ˆ‚‹Ô!ƒ„×`ÎÏ!Ø$ˆ‚‹Å\"ˆÚ`ÎÏ!\"+‡" [vip-default-ex-addresses vip-get-ex-buffer ex-addresses beg end error vip-FirstAddrExceedsSecond vip-enlarge-region exchange-point-and-mark ex-g-flag ex-g-variant "Can't execute `yank' within `global'" ex-count set-mark mark t ex-flag "`yank': %s" vip-SpuriousText ex-buffer vip-valid-register (Letter) vip-append-to-register copy-to-register nil vip-InvalidRegister copy-region-as-kill] 5]) (defalias 'ex-command #[nil "À‹ˆÃ p\"‰GÄVƒ. ÄÅOƘƒ.ƒ* ÅÀOP‚.ÈÉ!ˆ \n„<Ë !‚o\n@\nA@\f \f„P \fŠ\fbˆÎ !ˆÏ`ÐÑ!\"ˆÒ`ÐÑ! Ñ$ˆ)\fb*)‡" [nil command ((byte-code "qˆÁÂwˆ`d{‡" [vip-ex-work-buf " " nil command] 2)) ex-expand-filsyms 0 1 "!" vip-ex-last-shell-com error "No previous shell command" ex-addresses shell-command beg end set-mark vip-enlarge-region mark t shell-command-on-region] 6]) (defalias 'ex-line-no #[nil "ÀÁÂe „\fd‚ @\"T\"‡" [message "%d" count-lines ex-addresses] 5]) (defalias 'vip-info-on-file #[nil "À‰à ƒÄà !ÅP‚Æ ÇPÈÉÊeËÌ!\"Êed\"`dSiTÍ ƒ1΂2Ï&‰G\nGÐ\\\\ÑÒ !WƒMÓ\nÔ Q!‚OÕ‹*‡" [nil info file buffer-file-name abbreviate-file-name ":" buffer-name " [Not visiting any file]:" format "line=%d/%d pos=%d/%d col=%d %s" count-lines vip-line-pos end buffer-modified-p "[Modified]" "[Unchanged]" 1 window-width minibuffer-window message " " ((byte-code "ÀÁÂ Ä Æ°!‘ˆÇ ‡" [" *vip-info*" princ "\n" file "\n\n " info "\n\n\nPress any key to continue...\n\n" vip-read-event] 7))] 9 nil nil]) (provide (quote viper-ex)) emacs-19.30/lisp/viper-keym.elc100666 75424 12 33713 6045215217 14747 0ustar kwzhstaff;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:33:22 1995 ;;; from file /home/fsf/rms/e19/lisp/viper-keym.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`viper-keym.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!„ Ä à BÂÆ!„Ä Æ BÂÇ!„)Ä Ç BÂÈ!„7Ä È BÀ‡" [require viper-util boundp vip-vi-intercept-map make-sparse-keymap current-load-list vip-insert-intercept-map vip-emacs-intercept-map vip-overriding-map] 2) #@304 Keymap for user-defined local bindings. Useful for changing bindings such as ZZ in certain major modes. For instance, in letter-mode, one may want to bind ZZ to mh-send-letter. In a newsreader such as gnus, tin, or rn, ZZ could be bound to save-buffers-kill-emacs then post article, etc. (buffer local) (defvar vip-vi-local-user-map (make-sparse-keymap) (#$ . 713)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local vip-vi-local-user-map put permanent-local t] 4) #@88 Keymap for user-defined global bindings. These bindings are seen in all Viper buffers. (defvar vip-vi-global-user-map (make-sparse-keymap) (#$ . 1185)) #@99 This is the main keymap in effect in Viper's Vi state. This map is global, shared by all buffers. (defvar vip-vi-basic-map (make-keymap) (#$ . 1343)) #@65 This keymap keeps keyboard macros defined via the :map command. (defvar vip-vi-kbd-map (make-sparse-keymap) (#$ . 1499)) #@149 This keymap is in use when the user asks Viper to simulate Vi very closely. This happens when vip-expert-level is 1 or 2. See vip-set-expert-level. (defvar vip-vi-diehard-map (make-sparse-keymap) (#$ . 1627)) #@87 Auxiliary map for per-buffer user-defined keybindings in Insert state. (buffer local) (defvar vip-insert-local-user-map (make-sparse-keymap) (#$ . 1842)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local vip-insert-local-user-map put permanent-local t] 4) #@65 Auxiliary map for global user-defined bindings in Insert state. (defvar vip-insert-global-user-map (make-sparse-keymap) (#$ . 2106)) #@31 The basic insert-mode keymap. (defvar vip-insert-basic-map (make-sparse-keymap) (#$ . 2245)) #@180 Map used when user wants vi-style keys in insert mode. Most of the Emacs keys are suppressed. This map overshadows vip-insert-basic-map. Not recommended, except for novice users. (defvar vip-insert-diehard-map (make-keymap) (#$ . 2345)) #@56 This keymap keeps VI-style kbd macros for insert mode. (defvar vip-insert-kbd-map (make-sparse-keymap) (#$ . 2588)) #@36 Map used in Viper's replace state. (defvar vip-replace-map (make-sparse-keymap) (#$ . 2710)) #@64 Auxiliary map for global user-defined bindings in Emacs state. (defvar vip-emacs-global-user-map (make-sparse-keymap) (#$ . 2809)) #@55 This keymap keeps Vi-style kbd macros for emacs mode. (defvar vip-emacs-kbd-map (make-sparse-keymap) (#$ . 2946)) #@78 Auxiliary map for local user-defined bindings in Emacs state. (buffer local) (defvar vip-emacs-local-user-map (make-sparse-keymap) (#$ . 3066)) (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅÆ!„Ç ÆBÅÉ!„$Ç  ÉBÅÊ!„3Ë\nÊBÅÌ!„BË\fÌBÅÍ!„QË ÍBˇ" [make-variable-buffer-local vip-emacs-local-user-map put permanent-local t boundp vip-empty-keymap make-sparse-keymap current-load-list vip-mode-map vip-vi-state-modifier-alist nil vip-insert-state-modifier-alist vip-emacs-state-modifier-alist] 4) #@17 (buffer local) (defvar vip-need-new-vi-local-map t (#$ . 3569)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local vip-need-new-vi-local-map put permanent-local t] 4) #@17 (buffer local) (defvar vip-need-new-insert-local-map t (#$ . 3744)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local vip-need-new-insert-local-map put permanent-local t] 4) #@17 (buffer local) (defvar vip-need-new-emacs-local-map t (#$ . 3927)) (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅÇÈ#ˆÅÉÊ#ˆÅËÊ#ˆÅÌÍ#ˆÅÎÊ#ˆÅÏÊ#ˆÅÐÊ#ˆÅÇÊ#ˆÅÑÊ#ˆÅÒÊ#ˆÅÓÊ#ˆÅÔÊ#ˆÅÕÊ#ˆÅÖÊ#ˆÅ×Ê#ˆÅØÊ#ˆÅÙÚ#ˆÅÛÊ#ˆÅÜÊ#ˆÅÝÊ#ˆÅÞÊ#ˆÅßÊ#ˆà!àâXƒÁÅãä!\"Ê#ˆ!T‰!‚¨)Å%æç#ˆÅ%èé#ˆÅ%êë#ˆÅ%,ƒãí‚äîÈ#ˆÅ%ïð#ˆÅ%ñò#ˆÅ%óô#ˆÅ%õö#ˆÅ7êë#ˆÅ7øù#ˆÅ7úù#ˆÅ7ñû#ˆÅ<ýþ#ˆÅ<Ëÿ#ˆÅ<æ@#ˆÅ<ÎA#ˆÅ<ÏB#ˆÅ<úC#ˆÅ<ÙD#ˆÅ<ÜE#ˆÅ<ØF#ˆÅ<×G#ˆÅ" "?" vip-search-backward "@" vip-register-macro "A" vip-Append "B" vip-backward-Word "C" vip-change-to-eol "D" vip-kill-line "E" vip-end-of-Word "F" vip-find-char-backward "G" vip-goto-line "H" vip-window-top "I" vip-Insert "J" vip-join-lines "K" vip-nil "L" vip-window-bottom "M" vip-window-middle "N" vip-search-Next "O" vip-Open-line "P" vip-Put-back "Q" vip-query-replace "R" vip-overwrite "S" vip-substitute-line "T" vip-goto-char-backward "U" vip-undo "V" find-file-other-window "W" vip-forward-Word "X" vip-delete-backward-char "Y" vip-yank-line "ZZ" vip-save-kill-buffer "\\" vip-escape-to-emacs "[" vip-brac-function "]" vip-ket-function "_" vip-alternate-ESC "^" vip-bol-and-skip-white "`" vip-goto-mark "a" vip-append "b" vip-backward-word "c" "d" "e" vip-end-of-word "f" vip-find-char-forward "g" "h" vip-backward-char "i" vip-insert "j" vip-next-line "k" vip-previous-line "l" "m" vip-mark-point "n" vip-search-next "o" vip-open-line "p" vip-put-back "q" "r" vip-replace-char "s" vip-substitute "t" vip-goto-char-forward "u" "v" find-file find-file-other-frame "w" vip-forward-word "x" vip-delete-char "y" "zH" vip-line-to-top "zM" vip-line-to-middle "zL" vip-line-to-bottom "z " "z." "z-" "{" vip-backward-paragraph "|" vip-goto-col "}" vip-forward-paragraph "~" vip-toggle-case global-set-key "š" vip-escape-to-vi vip-vi-diehard-map redraw-display] 6) #@64 Keymap used to modify keys when Minibuffer is in Insert state. (defvar vip-minibuffer-map (make-sparse-keymap) (#$ . 8569)) (byte-code "À ÂÃ#ˆÀ ÄÃ#ˆÅÆ!„Ç ÆBÀÉÊ#ˆÀËÌ#ˆÅÍ!„4Ç  ÍBÀ ÉÎ#‡" [define-key vip-minibuffer-map " " vip-exit-minibuffer "\n" boundp vip-ex-cmd-map make-sparse-keymap current-load-list " " ex-cmd-read-exit " " ex-cmd-complete ex-read-filename-map vip-complete-filename-or-exit] 4) #@442 Override some vi-state or insert-state bindings in the current buffer. The effect is seen in the current buffer only. Useful for customizing mailer buffers, gnus, etc. STATE is 'vi-state, 'insert-state, or 'emacs-state ALIST is of the form ((key . func) (key . func) ...) Normally, this would be called from a hook to a major mode or on a per buffer basis. Usage: (vip-add-local-keys state '((key-str . func) (key-str . func)...))  (defalias 'vip-add-local-keys #[(state alist) "À\nÃ=ƒ\fƒÅ À‚M\nÇ=ƒ0ƒ'Å  À ‚M\nÊ=ƒH ƒ?Å \fÀ \f‚MÍÎ\n\"ˆÏ \"ˆÑ ˆÒ!)‡" [nil map state vi-state vip-need-new-vi-local-map make-sparse-keymap vip-vi-local-user-map insert-state vip-need-new-insert-local-map vip-insert-local-user-map emacs-state vip-need-new-emacs-local-map vip-emacs-local-user-map error "Invalid state in vip-add-local-keys: %S. Valid states: vi-state, insert-state or emacs-state" vip-modify-keymap alist vip-normalize-minor-mode-map-alist vip-set-mode-vars-for vip-current-state] 3 (#$ . 8994)]) #@572 Modify key bindings in a major-mode in a Viper state using a keymap. If the default for a major mode is emacs-state, then modifications to this major mode may not take effect until the buffer switches state to Vi, Insert or Emacs. If this happens, add vip-change-state-to-emacs to this major mode's hook. If no such hook exists, you may have to put an advice on the function that invokes the major mode. See vip-set-hooks for hints. The above needs not to be done for major modes that come up in Vi or Insert state by default. Arguments: (major-mode vip-state keymap) (defalias 'vip-modify-major-mode #[(mode state keymap) "Á=ƒ\n‚Ã=ƒÄ‚Å=…ÆÇ Ê Ì !\"‰ƒ: ÍÌ !\"Lˆ  BÌ !BLˆÏ ˆÐ!*‡" [state vi-state vip-vi-state-modifier-alist insert-state vip-insert-state-modifier-alist emacs-state vip-emacs-state-modifier-alist nil elt alist assoc mode eval delq keymap vip-normalize-minor-mode-map-alist vip-set-mode-vars-for vip-current-state] 5 (#$ . 10035)]) (defalias 'vip-debug-keymaps #[nil "ÀÁÂÃÄ \"!ˆÁÅ!ˆÁÂÆ\"!ˆÁÂÈ \"!ˆÁÂÊ \"!ˆÁÂÌ \"!ˆÁÂÎ\"!ˆÁÂÐ\"!ˆÁÂÒ\"!ˆÁÂÔ\"!ˆÁÂÖ\"!ˆÁÂØ\"!ˆÁÂÚ\"!ˆÁÂÜ\"!ˆÁÂÞ\"!ˆÁÂà!\"!ˆÁÂâ#\"!ˆÁÂä%\"!ˆÁÂæ'\"!ˆÁÂè)\"!ˆÁÂê+\"!ˆÁÂì-\"!ˆÁÂî/\"!ˆÁÂð1\"!ˆÁÂò3\"!ˆÁÂô5\"!ˆÁÂö7\"!ˆÁÂø9\"!ˆÁÂú;\"!ˆÁÂü=\"!ˆÁÂþ?\"!ˆÁÂ@A\"!ˆÁÂBC\"!ˆÁÂDE\"!ˆÁÂFG\"!ˆÁH!ˆÁÂIJK!\"!ˆÁÂLK\"!‘‡" [" *vip-debug*" princ format "Buffer name: %s\n\n" buffer-name "Variables: \n" "major-mode: %S\n" major-mode "vip-current-state: %S\n" vip-current-state "vip-mode-string: %S\n\n" vip-mode-string "vip-vi-intercept-minor-mode: %S\n" vip-vi-intercept-minor-mode "vip-insert-intercept-minor-mode: %S\n" vip-insert-intercept-minor-mode "vip-emacs-intercept-minor-mode: %S\n" vip-emacs-intercept-minor-mode "vip-vi-minibuffer-minor-mode: %S\n" vip-vi-minibuffer-minor-mode "vip-insert-minibuffer-minor-mode: %S\n\n" vip-insert-minibuffer-minor-mode "vip-vi-local-user-minor-mode: %S\n" vip-vi-local-user-minor-mode "vip-vi-global-user-minor-mode: %S\n" vip-vi-global-user-minor-mode "vip-vi-kbd-minor-mode: %S\n" vip-vi-kbd-minor-mode "vip-vi-state-modifier-minor-mode: %S\n" vip-vi-state-modifier-minor-mode "vip-vi-diehard-minor-mode: %S\n" vip-vi-diehard-minor-mode "vip-vi-basic-minor-mode: %S\n" vip-vi-basic-minor-mode "vip-replace-minor-mode: %S\n" vip-replace-minor-mode "vip-insert-local-user-minor-mode: %S\n" vip-insert-local-user-minor-mode "vip-insert-global-user-minor-mode: %S\n" vip-insert-global-user-minor-mode "vip-insert-kbd-minor-mode: %S\n" vip-insert-kbd-minor-mode "vip-insert-state-modifier-minor-mode: %S\n" vip-insert-state-modifier-minor-mode "vip-insert-diehard-minor-mode: %S\n" vip-insert-diehard-minor-mode "vip-insert-basic-minor-mode: %S\n" vip-insert-basic-minor-mode "vip-emacs-local-user-minor-mode: %S\n" vip-emacs-local-user-minor-mode "vip-emacs-kbd-minor-mode: %S\n" vip-emacs-kbd-minor-mode "vip-emacs-global-user-minor-mode: %S\n" vip-emacs-global-user-minor-mode "vip-emacs-state-modifier-minor-mode: %S\n" vip-emacs-state-modifier-minor-mode "\nvip-expert-level %S\n" vip-expert-level "vip-no-multiple-ESC %S\n" vip-no-multiple-ESC "vip-always %S\n" vip-always "vip-ex-style-motion %S\n" vip-ex-style-motion "vip-ex-style-editing-in-insert %S\n" vip-ex-style-editing-in-insert "vip-want-emacs-keys-in-vi %S\n" vip-want-emacs-keys-in-vi "vip-want-emacs-keys-in-insert %S\n" vip-want-emacs-keys-in-insert "vip-want-ctl-h-help %S\n" vip-want-ctl-h-help "\n\n\n" "Default value for minor-mode-map-alist: \n%S\n\n" default-value minor-mode-map-alist "Actual value for minor-mode-map-alist: \n%S\n"] 6 nil nil]) #@72 Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse. (defalias 'vip-add-keymap #[(mapsrc mapdst) "ƒ Á \"‡ÄÅ A\"‡" [vip-xemacs-p map-keymap #[(key binding) "À \n #‡" [define-key mapdst key binding] 4] mapsrc mapcar #[(p) "À  @! A#‡" [define-key mapdst vector p] 4]] 3 (#$ . 13695)]) #@117 Modifies MAP with bindings specified in the ALIST. The alist has the form ((key . function) (key . function) ... ). (defalias 'vip-modify-keymap #[(map alist) "ÀÁ\n\"‡" [mapcar #[(p) "À  @! A#‡" [define-key map eval p] 4] alist] 3 (#$ . 14006)]) (provide (quote viper-keym)) emacs-19.30/lisp/viper-macs.elc100666 75424 12 37626 6045215256 14737 0ustar kwzhstaff;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:33:52 1995 ;;; from file /home/fsf/rms/e19/lisp/viper-macs.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`viper-macs.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!„\fÄà BÂÆ!„ÄÆ BÂÇ!„&ÄÇ BÂÈ!„3ÄÈ BÂÉ!„@Ä É Bć" [require viper-util boundp vip-last-macro-reg nil current-load-list vip-vi-kbd-macro-alist vip-insert-kbd-macro-alist vip-emacs-kbd-macro-alist vip-kbd-macro-parameters] 2) #@76 Vector of keys representing the name of currently running Viper kbd macro. (defvar vip-this-kbd-macro nil (#$ . 738)) #@68 Vector of keys representing the name of last Viper keyboard macro. (defvar vip-last-kbd-macro nil (#$ . 862)) #@187 *Key sequence separated by no more than this many milliseconds is viewed as a macro, if such a macro is defined. This also controls ESC-keysequences generated by keyboard function keys. (defconst vip-fast-keyseq-timeout 200 (#$ . -979)) #@360 Prefix key for invocation of vip-repeat-from-history function, which repeats previous destructive commands from the history of such commands. This function can then be invoked as 1 or 2. The notation for these keys is borrowed from XEmacs. Basically, a key is a symbol, e.g., `a', `\1', `f2', etc., or a list, e.g., `(meta control f1)'. (defvar vip-repeat-from-history-key (quote f12) (#$ . 1223)) (defalias 'ex-map #[nil "ÀÁ‰‰‰Ç‹ˆÈ!‰@ A\n \fF \fƒ+ÊË!‚eÌÍÎÏ !#!ˆ\nƒ=Ð ˆÑÁ!ˆÒÔÊ#ˆÒÔÊ#ˆÒÔÊ#ˆ×ØÏ !\nƒcÙ‚dÚ#-‡" ["" nil ins map-args macro-body macro-name mod-char ((byte-code "qˆÁÂ!ƒÃÂÆuˆÁ‡" [vip-ex-work-buf looking-at "!" t ins mod-char 1] 2)) ex-map-read-args vip-kbd-macro-parameters vip-end-mapping-kbd-macro ignore ex-fixup-history format "map%s %S" vip-display-macro vip-change-state-to-insert start-kbd-macro define-key vip-vi-intercept-map ")" vip-insert-intercept-map vip-emacs-intercept-map message "Mapping %S in %s state. Hit `C-x )' to complete the mapping" "Insert" "Vi"] 7]) (defalias 'ex-unmap #[nil "ÀÁ‰‰Æ‹ˆÇ !ÈÉ !!ÊËÌ Í\f!#!ˆÎ \nƒ)Ï‚*Ð\",‡" ["" nil ins macro-name temp mod-char ((byte-code "qˆÁÂ!ƒÃÂÆuˆÁ‡" [vip-ex-work-buf looking-at "!" t ins mod-char 1] 2)) ex-unmap-read-args vip-fixup-macro vconcat ex-fixup-history format "unmap%s %S" vip-display-macro vip-unrecord-kbd-macro insert-state vi-state] 6]) (defalias 'ex-map-read-args #[(variant) "ÀÁ‰‰‰‰‰‰ \n ÂÌ͈ ƒ<Î !„· ;ƒ3Ï !‚·ÏÐ !!‚·ÆÑ\"ˆÓÔ!ˆÕ„´Ï\nƒ\\Ö!‚]×\"\n؃sÙ\nÚ\nGÔZ#\nÛÜ\nGÚVƒˆÐÝ\n!!‚‰Þ#Æ!ˆß à!ƒªÆá\"ˆÓÔ!ˆÂ‚®â!‰‚H\n GÚUƒÂãä!ˆå !æ !ƒÐç !\fƒëæ\f!ƒáç\f!‚ëÎ\f!„ëãè!ˆÂ ÓÚ!ˆ \f. B‡" [t [] nil args macro-body macro-name message event key temp key-seq cursor-in-echo-area (byte-code "ÀÁÂ\"ÃPÅ\f!‰@Å\fA\"@À‡" [ex-get-inline-cmd-args ".*map[!]*[ ]?" "\n " " nil nil " args read-from-string temp macro-name macro-body] 4) ((error (byte-code "ÀÁÂ\"‡" [signal error ("map: Macro name and body must be a quoted string or a vector")] 3))) vectorp vconcat prin1-to-string ":map%s " variant sit-for 2 (13 10 (control m) (control j) return linefeed) vector [] (8 127 (quote ^) 32 (quote ^H) (control h) (control \?) backspace delete) subseq 0 format ":map%s %s" vip-display-macro "" vip-read-key vip-mouse-event-p "%s (No mouse---only keyboard keys, please)" vip-event-key error "Can't map an empty macro name" vip-fixup-macro vip-char-array-p vip-char-array-to-macro "map: Invalid syntax in macro definition"] 10]) (defalias 'ex-unmap-read-args #[(variant) "À ˜ƒ ‚\f\fʼn‰‰‰‰‰‰‰‰‰ \n \f ÓÔ!‰GÕV„îÉÖ \"ˆ×Ø!ˆÙ„êÚƒ\\Û!‚]Ü\"݃vÞÕGØZ#‚ª߃ªÞÕGS#àá GÕVƒœâã!!‚ä# å #àá GÕVƒ¾âã!!‚¿ä# É !ˆæ \nç\n!ƒàÉè \"ˆ×Ø!ˆÅ‚äé\n!‰‚HGÕUƒúêë!ˆÕœì>ƒ í!@‚Ú!. ‡" [t variant "!" vip-insert-kbd-macro-alist vip-vi-kbd-macro-alist nil macro-name key-seq key message event vip-emacs-intercept-minor-mode vip-insert-intercept-minor-mode vip-vi-intercept-minor-mode vip-emacs-kbd-minor-mode vip-insert-kbd-minor-mode vip-vi-kbd-minor-mode macro-alist cursor-in-echo-area ex-get-inline-cmd-args ".*unma?p?[!]*[ ]*" 0 ":unmap%s " sit-for 2 (13 10 (control m) (control j) return linefeed) vconcat vector [] (8 127 (quote ^) 32 (quote ^H) (control h) (control \?) backspace delete) subseq (tab (control i) 9) format ":unmap%s %s" prin1-to-string vip-display-macro "" vip-do-sequence-completion vip-read-key vip-mouse-event-p "%s (No mouse---only keyboard keys, please)" vip-event-key error "Can't unmap an empty macro name" (91 34) read-from-string] 14]) #@22 Terminate kbd macro. (defalias 'vip-end-mapping-kbd-macro #[(&optional ignore) "À ÂÃ#ˆÀ\fÂÃ#ˆÀ ÂÃ#ˆ„%ƒ!„%ÉÊ!ˆA@@Ë8Ì8 ÄQÑÃ!ˆÒ! Ô ˆÕƒ]Ö‚^×Ø !#ˆÙÚÛØ!Ø !$!,‡" [define-key vip-vi-intercept-map ")" nil vip-insert-intercept-map vip-emacs-intercept-map ignore vip-kbd-macro-parameters defining-kbd-macro error "Not mapping a kbd-macro" 2 3 macro-body macro-name ins mod-char end-kbd-macro vip-events-to-macro last-kbd-macro vip-change-state-to-vi vip-record-kbd-macro insert-state vi-state vip-display-macro ex-fixup-history format "map%s %S %S"] 7 (#$ . 4884) nil]) (byte-code "ÀÁÂÃÄ$ˆÅÁÄ\"‡" [ad-add-advice start-kbd-macro (vip-kbd-advice nil t (advice lambda nil "Remove Viper's intercepting bindings for C-x ).\nThis may be needed if the previous `:map' command terminated abnormally." (define-key vip-vi-intercept-map ")" nil) (define-key vip-insert-intercept-map ")" nil) (define-key vip-emacs-intercept-map ")" nil))) after nil ad-activate-on] 5) #@495 Record a Vi macro. Can be used in `.vip' file to define permanent macros. MACRO-NAME is a string of characters or a vector of keys. STATE is either `vi-state' or `insert-state'. It specifies the Viper state in which to define the macro. MACRO-BODY is a string that represents the keyboard macro. Optional SCOPE says whether the macro should be global (t), mode-specific (a major-mode symbol), or buffer-specific (buffer name, a string). If SCOPE is nil, the user is asked to specify the scope. (defalias 'vip-record-kbd-macro #[(macro-name state macro-body &optional scope) "ÀÀ Ä=ƒÅÇ‚( È>ƒ\"É\nË‚(Ì ÎÀÀÀÀÀÀÀGØUƒKÙÚ!ˆÛ!Ü!ƒ^Ý!Û!Ü!ƒqÝ!à=„K;„Kƒ‰9„Káâãä \"!ƒ¾âåæ!çâèæ!‰\"éê‰;ƒ±ë‚²ì% ä %ä ‚áâí.\"!ƒóâïæ!çâèæ!‰\"éê‰;ƒæë‚çì% .%.‚âðæ!çâèæ!‰\"éê‰;ƒë‚ì% $àáâñò3!\"!ƒFôâõæ! ö!ƒ=âè\"‚?%3\"ˆ÷!ˆà=ƒ]À‰àÀBE‚€9ƒpÀÀBCàÀBE‚€;…€ÀBCÀàÀBEBøù!\"‰„àú\nûüØH!!ý#ˆù!‰ƒÇþ@@!þ!™ƒÇ@BA‰„¨ÿ!@B\"Lˆà=ƒðA8‚9ƒøB8\"‚;…øA@\"‰ƒ¡‚M9ƒ9AABB8B ‚M;…MABA@B .\n‡" [nil state-name keymap state vi-state "Vi state" vip-vi-kbd-map vip-vi-kbd-macro-alist (insert-state replace-state) "Insert state" vip-insert-kbd-map vip-insert-kbd-macro-alist "Emacs state" vip-emacs-kbd-map vip-emacs-kbd-macro-alist macro-alist-var new-elt old-elt old-sub-elt msg temp lis lis2 macro-name 0 error "Can't map an empty macro name" vip-fixup-macro vip-char-array-p vip-char-array-to-macro macro-body scope t y-or-n-p format "Map this macro for buffer `%s' only? " buffer-name "%S is mapped to %s for %s in `%s'" vip-display-macro vip-abbreviate-string "%S" 14 "" " ....\"" " ....]" "Map this macro for the major mode `%S' only? " major-mode "%S is mapped to %s for %s in `%S'" "%S is globally mapped to %s in %s" "Save this macro in %s? " abbreviate-file-name vip-custom-file-name vip-save-string-in-file "\n(vip-record-kbd-macro %S '%S %s '%S)" vectorp message assoc eval define-key vector vip-key-to-emacs-key vip-exec-mapped-kbd-macro vip-array-to-string reverse append 3 2] 10 (#$ . 5886)]) #@361 Delete macro MACRO-NAME from Viper STATE. MACRO-NAME must be a vector of vip-style keys. This command is used by Viper internally, but the user can also use it in ~/.vip to delete pre-defined macros supplied with Viper. The best way to avoid mistakes in macro names to be passed to this function is to use vip-describe-kbd-macros and copy the name from there. (defalias 'vip-unrecord-kbd-macro #[(macro-name state) "ÀÀ Ä=ƒÅÇ‚( È>ƒ\"É\nË‚(Ì ÎÀÀÀÀÀÕ!×!ƒLØ!ÙÚ!\"GÛUƒbÜÝ!ˆ„rÜÞß! à $ˆÙà A@\"Ù!â8\"ã8Aƒ¾A„žAƒ¬äåæß!à #!ƒ¾çèß! à $ˆ‚\fAƒêAƒØäåéß!!#!ƒêçêß! !$ˆ‚\fã8‰Aƒçëß! #ˆ‚\fÜÞß! à $ˆÀ¡ˆA†HA†HA†HìÚ!\"LˆíÛHÚ!\"…Hî\nïðÛH!!À#.‡" [nil state-name keymap state vi-state "Vi state" vip-vi-kbd-map vip-vi-kbd-macro-alist (insert-state replace-state) "Insert state" vip-insert-kbd-map vip-insert-kbd-macro-alist "Emacs state" vip-emacs-kbd-map vip-emacs-kbd-macro-alist macro-alist-var buf-mapping mode-mapping global-mapping macro-pair macro-entry vip-fixup-macro macro-name vip-char-array-p vip-char-array-to-macro assoc eval 0 error "Can't unmap an empty macro name" "%S is not mapped to a macro for %s in `%s'" vip-display-macro buffer-name major-mode 2 3 y-or-n-p format "Unmap %S for `%s' only? " message "%S is unmapped for %s in `%s'" "Unmap %S for the major mode `%S' only? " "%S is unmapped for %s in %S" "Global mapping of %S for %s is removed" delq vip-can-release-key define-key vector vip-key-to-emacs-key] 6 (#$ . 8091)]) (defalias 'vip-can-release-key #[(char macro-alist) "Á‰ƒ$\fƒ$ @@ ÇH=ƒÂ A‰„\n\f+‡" [macro-alist t nil macro-name can-release lis char 0] 4]) #@21 Dispatch kbd macro. (defalias 'vip-exec-mapped-kbd-macro #[(count) "Á=ƒ\n\n‚Ã>ƒ\f‚ ÇÉ\nÉ É\fÉ ÉÉÉÉÉÉÕ\"Ö!×\"Ø\" „m @Ù A\"ƒ—×Ú A@\"A‰„—×Ü8\"A‰„—Ý8AƒÃ„Ã@ áâ!#\"ˆÉ @$å!)‚éå!ˆ&„Ñ#&çèÉ!!é!ƒæê!‚éëì!.\f‡" [vip-current-state vi-state vip-vi-kbd-macro-alist (insert-state replace-state) vip-insert-kbd-macro-alist vip-emacs-kbd-macro-alist macro-alist "" unmatched-suffix nil vip-vi-kbd-minor-mode vip-insert-kbd-minor-mode vip-emacs-kbd-minor-mode next-best-match keyseq event-seq macro-first-char macro-alist-elt macro-body command last-command-event vip-read-fast-keysequence vip-events-to-macro assoc vip-find-best-matching-macro subseq buffer-name major-mode 2 3 defining-kbd-macro command-history vip-this-kbd-macro execute-kbd-macro vip-macro-to-events count vip-last-kbd-macro vip-set-unread-command-events prefix-arg key-binding read-key-sequence commandp command-execute beep 1] 4 (#$ . 9814) "P"]) #@41 Show currently defined keyboard macros. (defalias 'vip-describe-kbd-macros #[nil "ÀÁÂ!ˆÃÄ \"ˆÁÆ!ˆÃÄ\"ˆÁÈ!ˆÃÄ \"‘‡" [" *vip-info*" princ "Macros in Vi state:\n===================\n" mapcar vip-describe-one-macro vip-vi-kbd-macro-alist "\n\nMacros in Insert and Replace states:\n====================================\n" vip-insert-kbd-macro-alist "\n\nMacros in Emacs state:\n======================\n" vip-emacs-kbd-macro-alist] 4 (#$ . 10841) nil]) (defalias 'vip-describe-one-macro #[(macro) "ÀÁÂÃ\f@!\"!ˆÀÅ!ˆ\fA@ƒÆÇ\fA@\"ˆ‚\"ÀÈ!ˆÀÉ!ˆÊ\f8ƒ6ÆÇÊ\f8\"ˆ‚:ÀÈ!ˆÀË!ˆÌ\f8AƒRÀÁÍÌ\f8A\"!ˆ‚VÀÎ!ˆÀÏ!‡" [princ format "\n *** Mappings for %S:\n ------------\n" vip-display-macro macro " ** Buffer-specific:" mapcar vip-describe-one-macro-elt " none\n" "\n ** Mode-specific:" 2 "\n ** Global:" 3 "\n %S" " none" "\n"] 5]) (defalias 'vip-describe-one-macro-elt #[(elt) "@AÃÄÅ\n #!*‡" [elt defn name princ format "\n * %S:\n %S\n"] 5]) (defalias 'vip-keyseq-is-a-possible-macro #[(seq alist) "À !ÃÄÅÆÇ!\"B!)‡" [vip-events-to-macro seq converted-seq eval or mapcar #[(elt) "À \n\"‡" [vip-prefix-subseq-p converted-seq elt] 3] vip-this-buffer-macros alist] 6]) (defalias 'vip-prefix-subseq-p #[(seq1 seq2) "G G‰\nX…Ä Å #š*‡" [seq1 seq2 len2 len1 subseq 0] 6]) (defalias 'vip-common-seq-prefix #[(&rest seqs) "@AÃÅÇGÅUƒÅ‚$ÉÊËÌ\"\"WƒJÍÎËÏ\n\"B!ƒAÐ\fÑ œ!\"T‰‚&\f-‡" [seqs first rest [] pref 0 idx nil len apply min mapcar length eval and #[(s) " œ\n œš‡" [first idx s] 3] vconcat vector] 6]) (defalias 'vip-extract-matching-alist-members #[(pref alist) "ÀÁÂÃÄ !\"\"‡" [delq nil mapcar #[(elt) "À \n\"…\n‡" [vip-prefix-subseq-p pref elt] 3] vip-this-buffer-macros alist] 6]) (defalias 'vip-do-sequence-completion #[(seq alist compl-message) "À \n\"ÄÅ \" šƒ& GÇUƒ&ÈÉ\n\"ˆËÌ!ˆ‚\\ „:ÈÍ\n\"ˆËÌ!ˆ ‚\\ ƒQÈÎ\n\"ˆËÌ!ˆÏ !ˆ‚\\ šƒ\\Ï !ˆ*‡" [vip-extract-matching-alist-members seq alist matches apply vip-common-seq-prefix new-seq 1 message "%s (Sole completion)" compl-message sit-for 2 "%s (No match)" "%s (Complete, but not unique)" vip-display-vector-completions] 3]) (defalias 'vip-display-vector-completions #[(list) "ÀÁÂÃÂÄ \"\"!‘‡" ["*Completions*" display-completion-list mapcar prin1-to-string vip-display-macro list] 7]) (defalias 'vip-find-best-matching-macro #[(alist str) "Á\nGɉ‰ \n „a\nƒa\n@‰@G  YƒY\f@Ë\nÁ #šƒYÌÍ \fA@\"A„WÌÏ\f8\"A„WÐ\f8AƒYÑ\nA\n‚ ƒo\f ‚uÃÁ.B‡" [alist 0 str nil macro-def found unmatched-start-idx match str-len def-len lis subseq assoc buffer-name major-mode 2 3 t] 8]) (defalias 'vip-this-buffer-macros #[(macro-alist) "ÀÂÃ\f\"ÅÀ \"‰)‡" [nil candidates mapcar #[(elt) "ÀÁ \nA@\"A„À Ä\n8\"A„Å\n8A…\n@‡" [assoc buffer-name elt major-mode 2 3] 4] macro-alist delq] 3]) (defalias 'vip-display-macro #[(macro-name) "À !ƒ\fÂà Ä#‡Å !ƒÂÆ Ä#‡ ‡" [vip-char-symbol-sequence-p macro-name mapconcat symbol-name "" vip-char-array-p char-to-string] 4]) (defalias 'vip-events-to-macro #[(event-seq) "ÀÁ \"!‡" [vconcat mapcar vip-event-key event-seq] 4]) (defalias 'vip-char-array-to-macro #[(array) "À ! ƒÆÇ\f\"‚\fÀÆÈ \"!*‡" [vconcat array nil macro vec vip-xemacs-p mapcar character-to-event vip-event-key] 4]) (defalias 'vip-fixup-macro #[(macro) "GÁ‰Ç!„<ƒw Wƒw „w œ‰§ƒ]Á\fXƒp\fÈXƒpÉ!ƒI ÊË\fÌ\\!!Iˆ‚p<ƒp ›ÊË\fÌ\\!! ˆ‚p\f<ƒiÍ\f!ˆ‚p\f9„pÎ T‰‚ ƒ‚ÏÐ\f\"‚ƒ,‡" [macro 0 nil break elt idx len vectorp 9 arrayp intern char-to-string 48 vip-fixup-macro t error "Wrong type macro component, symbol-or-listp, %S"] 7]) (defalias 'vip-char-array-p #[(array) "ÀÁÂÃ\f\"B!‡" [eval and mapcar numberp array] 5]) (defalias 'vip-macro-to-events #[(macro-body) "ÀÁ \"!‡" [vconcat mapcar vip-key-to-emacs-key macro-body] 4]) (defalias 'vip-char-symbol-sequence-p #[(vec) "À !…ÂÃÄÅ \"B!‡" [sequencep vec eval and mapcar #[(elt) "9… Á!GÂU‡" [elt symbol-name 1] 2]] 5]) (defalias 'vip-event-vector-p #[(vec) "À !…ÂÃÄÅ \"B!‡" [vectorp vec eval and mapcar #[(elt) "‰¨†! 9ƒ ÂN†! :…! @9…! @ÂN)…&Ç" [elt obj event-symbol-elements t] 3]] 5]) (defalias 'vip-read-fast-keysequence #[(event macro-alist) "À !Â Æ ƒÊË¥\"‚#ÊÌ#*„BÍ\f\"ƒBÏ Ð !„Ñ\fÀ !\"‚\f*‡" [vector event nil next-event lis vip-fast-keyseq-timeout t nodisp val vip-xemacs-p sit-for 1000.0 0 vip-keyseq-is-a-possible-macro macro-alist vip-read-key vip-mouse-event-p vconcat] 4]) (defalias 'vip-set-register-macro #[(reg) "À !ƒÂÃ!„ÄÅ!ˆÆ \"‡" [get-register reg y-or-n-p "Register contains data. Overwrite? " error "Macro not saved in register. Can still be invoked via `C-x e'" set-register last-kbd-macro] 3]) #@54 Keyboard macros in registers - a modified @ command. (defalias 'vip-register-macro #[(count) "À — Xƒ) ÃXƒ)  ƒÆ ˆÇ !‚~ÈÉ !\n\"‚~ ËU„; ÌU„; ÍUƒM\f„CÎÏ!ˆÈÉ\f!\n\"‚~ ÐUƒZÑ\n!‚~ ÒUƒxÀ — X…~ ÃX…~ Ç !‚~ÎÓÔ \"!)‡" [read-char reg 97 122 vip-last-macro-reg defining-kbd-macro end-kbd-macro vip-set-register-macro execute-kbd-macro get-register count 64 10 13 error "No previous kbd macro" 35 start-kbd-macro 33 format "`%c': Unknown register"] 4 (#$ . 15557) "P"]) #@54 Call last keyboad macro for each line in the region. (defalias 'vip-global-execute #[nil "`ÀÁ!Vƒ  ˆÃyˆÄ ˆ`ÀÁ!W…%ÅyˆÃyˆÄ ˆ‚‡" [mark t exchange-point-and-mark 0 call-last-kbd-macro 1] 3 (#$ . 16044)]) (provide (quote viper-macs)) emacs-19.30/lisp/viper-mous.elc100666 75424 12 24046 6045215302 14757 0ustar kwzhstaff;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 30 13:34:24 1995 ;;; from file /home/fsf/rms/e19/lisp/viper-mous.el ;;; emacs version 19.29.1.2. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`viper-mous.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ!„\fÄà BÆ Ç Bć" [require viper-util boundp vip-frame-of-focus nil current-load-list selected-frame vip-current-frame-saved] 2) #@235 *Function that determines what constitutes a word for clicking events. Takes two parameters: a COUNT, indicating how many words to return, and CLICK-COUNT, telling whether this is the first click, a double-click, or a tripple-click. (defvar vip-surrounding-word-function (quote vip-surrounding-word) (#$ . -633)) #@86 *Time interval in millisecond within which successive clicks are considered related. (defconst vip-multiclick-timeout (byte-code "ƒ ‡\n‡" [vip-xemacs-p mouse-track-multi-click-time double-click-time] 1) (#$ . -953)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀ‡" [boundp vip-current-click-count 0 current-load-list vip-last-click-event-timestamp] 2) #@20 nil (buffer local) (defvar vip-mouse-click-search-noerror t (#$ . 1305)) (make-variable-buffer-local (quote vip-mouse-click-search-noerror)) #@20 nil (buffer local) (defvar vip-mouse-click-search-limit nil (#$ . 1452)) (byte-code "ÀÁ!ˆÂÃ!„\fÄà Bć" [make-variable-buffer-local vip-mouse-click-search-limit boundp vip-global-prefix-argument nil current-load-list] 2) (defalias 'vip-multiclick-p #[nil "Á\fƒŠƥ\n\"‚ÅÇ \n#*?‡" [vip-multiclick-timeout t nodisp val vip-xemacs-p sit-for 1000.0 0] 4]) (put (quote vip-multiclick-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@752 Returns word surrounding point according to a heuristic. COUNT indicates how many regions to return. If CLICK-COUNT is 1, `word' is a word in Vi sense. If CLICK-COUNT is 2,then `word' is a Word in Vi sense. If the character clicked on is a non-separator and is non-alphanumeric but is adjacent to an alphanumeric symbol, then it is considered alphanumeric for the purpose of this command. If this character has a matching character, such as `(' is a match for `)', then the matching character is also considered alphanumeric. For convenience, in Lisp modes, `-' is considered alphanumeric. If CLICK-COUNT is 3 or more, returns the line clicked on with leading and trailing space and tabs removed. In that case, the first argument, COUNT, is ignored. (defalias 'vip-surrounding-word #[(count click-count) "ÀÁ‰‰‰ÈVƒ'ŠÉyˆÊË!ˆ`Áˆ `{)‚(Ì „žŠÍ ˆÎ )„@ŠÏ ˆÎ )ƒžÐÑ!ƒJÑ‚œÐÒ!ƒTÓ‚œÐÔ!ƒ^Õ‚œÐÖ!ƒhׂœÐØ!ƒrÙ‚œÐÚ!ƒ|Û‚œÐÜ!ƒ†Ý‚œÐÞ!ƒÞ‚œß ƒ™À‚œàg!ÐÒ!„´áâã$!\"ƒ´ÓPŠåVƒÃæç!ˆ‚òÎ!ƒÒè!ˆ‚òÌ!„ßé ˆ‚òåVƒíæç!ˆ‚òè!ˆ`Á*ÉVƒ#\fƒÏå!ˆëåVƒæì!ˆ‚í!ˆ*S‰*‚ø\n`{).ƒ5ïÉ GÁ $ˆ -‡" ["" nil word-beg result skip-flag beg modifiers click-count 2 0 vip-skip-all-separators-forward within-line vip-looking-at-alphasep vip-backward-char-carefully vip-looking-at-alpha vip-forward-char-carefully looking-at "\\\\" "-" "C-C-" "[][]" "][" "[()]" ")(" "[{}]" "{}" "[<>]" "<>" "[`']" "`'" "\\^" vip-looking-at-separator char-to-string string-match "lisp" symbol-name major-mode 1 vip-skip-nonseparators backward vip-skip-alpha-backward vip-skip-nonalphasep-backward count t forward vip-skip-alpha-forward vip-emacs-p set-text-properties] 6 (#$ . 1909)]) #@224 Returns word surrounding the position of a mouse click. Click may be in another window. Current window and buffer isn't changed. On single or double click, returns the word as determined by `vip-surrounding-word-function'. (defalias 'vip-mouse-click-get-word #[(click count click-count) "ÀÁ\n!Ã\n!§„È §„È ŠÊ‹,‡" ["" vip-mouse-click-posn click vip-mouse-click-window-buffer click-buf click-pos click-word count 1 click-count ((byte-code "ƒ qˆbˆ\n \f\"‚ÆÇ!ˆ ‡" [click-pos click-buf vip-surrounding-word-function count click-count click-word error "Click must be over a window."] 3))] 4 (#$ . 3601)]) (defalias 'vip-mouse-click-frame #[(click) "ÀÁ\n!!‡" [window-frame vip-mouse-click-window click] 3]) (put (quote vip-mouse-click-frame) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-mouse-click-window #[(click) "ƒÁ\n!‡\n‰A@)‰@)‡" [vip-xemacs-p event-window click event position] 3]) (put (quote vip-mouse-click-window) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-mouse-click-window-buffer #[(click) "À \nƒ à !‚ ‰A@)‰@))!‡" [window-buffer click vip-xemacs-p event-window event position] 4]) (put (quote vip-mouse-click-window-buffer) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-mouse-click-window-buffer-name #[(click) "À   ƒÄ !‚ ‰A@)‰@))!)!‡" [buffer-name click window-buffer vip-xemacs-p event-window event position] 5]) (put (quote vip-mouse-click-window-buffer-name) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-mouse-click-posn #[(click) "ƒÁ\n!‡\n‰A@)‰A@:ƒ\fA@@‚ \fA@)‡" [vip-xemacs-p event-point click event position] 3]) (put (quote vip-mouse-click-posn) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@318 Insert word clicked or double-clicked on. With prefix argument, N, insert that many words. This command must be bound to a mouse click. The double-click action of the same mouse button must not be bound (or it must be bound to the same function). See `vip-surrounding-word' for the definition of a word in this case. (defalias 'vip-mouse-click-insert-word #[(click arg) "ƒÁ!ˆ\n§„ \n<ƒ\n@§ƒ\n@‚ ÃĉÈ \n ƒ<Ì\nÍ¥ \"‚CÌÎ\n #*„[Ï Ð!ƒ[\nÓ!‚¯Ó!‰ÃVƒmÄÕ\n#cˆ …¯ ‰¨†¡9ƒ×N†¡:…¡@9…¡@×N)…¯Ð !?…¯Ø !*‡" [vip-frame-of-focus select-frame arg 1 nil interrupting-event click-count vip-multiclick-timeout t nodisp val vip-xemacs-p sit-for 1000.0 0 vip-read-event vip-mouse-event-p last-input-event vip-global-prefix-argument vip-event-click-count click vip-mouse-click-get-word obj event-symbol-elements vip-set-unread-command-events] 5 (#$ . 5393) "e\nP"]) (defalias 'vip-mouse-event-p #[(event) "‰¨†! 9ƒ ÂN†! :…! @9…! @ÂN)…-ÃÄÅÆ!!\"‡" [event obj event-symbol-elements string-match "\\(mouse-\\|frame\\|screen\\|track\\)" prin1-to-string vip-event-key] 6]) (defalias 'vip-event-click-count #[(click) "ƒÁ\n! Z\fVƒÅÁ\n!T‰‡\nÈ8¨ƒ.È8‚/É)‡" [vip-xemacs-p event-timestamp click vip-last-click-event-timestamp vip-multiclick-timeout 0 vip-current-click-count event 2 1] 2]) #@367 Find the word clicked or double-clicked on. Word may be in another window. With prefix argument, N, search for N-th occurrence. This command must be bound to a mouse click. The double-click action of the same button must not be bound (or it must be bound to the same function). See `vip-surrounding-word' for the details on what constitutes a word for this command. (defalias 'vip-mouse-click-search-word #[(click arg) "ƒÁ!ˆÂ‰ È \n ƒ&Ì\nÍ¥ \"‚-ÌÎ\n #*„OÏ ˆÐ!ƒO†BÖ!‚ÚÖ!Ø # ÙVƒi†oÙÚ ˆ ˜ƒ’Û!ƒ’Ý!pšƒ’Þ=„¼ß ‰ È!Â\"#ƒ«ä!‚­‰%@˜„¼ %B%æÂÈ\"ˆÎV…ÚçÙ!ˆÂèéˆS‰‚Ã+‡" [vip-frame-of-focus select-frame nil vip-s-string previous-search-string click-count click-word vip-multiclick-timeout t nodisp val vip-xemacs-p sit-for 1000.0 0 vip-read-event vip-mouse-event-p last-input-event vip-global-prefix-argument arg last-command this-command vip-event-click-count click vip-mouse-click-get-word 1 vip-deactivate-mark markerp vip-search-start-marker marker-buffer vip-mouse-click-search-word point-marker vip-local-search-start-marker vip-mouse-click-search-noerror vip-mouse-click-search-limit vip-re-search regexp-quote vip-search-history push-mark vip-forward-word (byte-code "À \n #„+ÄŠÅ!ƒÇ!ƒbˆÈÉ!)ebˆÀ \nÄ#ˆÊ”bˆËÌ \"ˆÏXƒ?Ð ˆÄ‡" [search-forward click-word vip-mouse-click-search-limit vip-mouse-click-search-noerror nil markerp vip-local-search-start-marker marker-buffer vip-line-pos end 0 message "Searching for: %s" vip-s-string arg 1 vip-flash-search-pattern] 4) ((error (byte-code "ÀÁ!ˆ\n ˜ƒ\fÅ=„ÆÇÉp!#ˆ‚+ÆÊ\nÉp!#ˆÁ ÌÍ!ˆÎÐÒ!ƒCÔ!ƒCbˆÐ‡" [beep 1 click-word previous-search-string last-command vip-mouse-click-search-word message "`%s': String not found in %s" vip-s-string buffer-name "`%s': Last occurrence in %s. Back to beginning of search" arg sit-for 2 t vip-mouse-click-search-noerror nil vip-mouse-click-search-limit markerp vip-local-search-start-marker marker-buffer] 5)))] 5 (#$ . 6750) "e\nP"]) #@153 Catch the event of switching frame. Usually is bound to a 'down-mouse' event to work properly. See sample bindings in viper.el and in the Viper manual. (defalias 'vip-mouse-catch-frame-switch #[(event arg) "À\n\fÅ=ƒ \f‰‡" [nil vip-frame-of-focus arg prefix-arg last-command handle-switch-frame vip-current-frame-saved this-command] 2 (#$ . 8781) "e\nP"]) (defalias 'vip-remember-current-frame #[(frame) "À ‰‡" [handle-switch-frame last-command selected-frame vip-current-frame-saved] 2]) (byte-code "ÀÁÂÃ#ˆ\fƒ ‚ÆÇ !ƒ»\fƒ ‚!ÆÇ !È>„» ƒ/Ê‚0Ë\f ƒ;Í‚<Î ƒGЂHÑ ƒSÓ‚TÔÖ\f!?…cÖ!?Ö!?…rÖ!?ƒÙ\fÚ\"ˆƒŠÙÛ\"ˆƒ•ÙÜ\"ˆƒ ÙÜ\"ˆ ƒ­ÝÞÁ\"ˆ‚¹ßàáâã$ˆäàã\"ˆ.åæ!‡" [put vip-remember-current-frame byte-optimizer byte-compile-inline-expand vip-emacs-p window-system device-type selected-device (tty stream) vip-xemacs-p [(meta shift button1up)] [S-mouse-1] search-key [(meta shift button1)] [S-down-mouse-1] search-key-catch [(meta shift button2up)] [S-mouse-2] insert-key [(meta shift button2)] [S-down-mouse-2] insert-key-catch key-binding search-key-unbound insert-key-unbound global-set-key vip-mouse-click-search-word vip-mouse-click-insert-word vip-mouse-catch-frame-switch add-hook mouse-leave-frame-hook ad-add-advice handle-switch-frame (vip-frame-advice nil t (advice lambda nil "Remember the selected frame before the switch-frame event." (vip-remember-current-frame (selected-frame)))) before nil ad-activate-on provide viper-mous] 5) emacs-19.30/lisp/viper-util.elc100666 75424 12 56116 6043467054 14767 0ustar kwzhstaff;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Oct 25 13:04:01 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/viper-util.el ;;; emacs version 19.29.1.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`viper-util.el' was compiled for Emacs 19.29 or later")) (byte-code "ÀÁ!ˆÂÃ\f\"ÅB ?ÇBÀ‡" [require ring string-match "\\(Lucid\\|XEmacs\\)" emacs-version vip-xemacs-p current-load-list vip-emacs-p] 3) (defalias 'vip-device-type #[nil "ƒ ‡Âà !‡" [vip-emacs-p window-system device-type selected-device] 2]) (put (quote vip-device-type) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-window-display-p #[nil "ƒ ‚\fÂà !…ƒ ‚Âà !Ä>?‡" [vip-emacs-p window-system device-type selected-device (tty stream)] 2]) (put (quote vip-window-display-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-deflocalvar '(macro . #[(var default-value &optional documentation) "ÀÁ\n ÄÅ\"FÇÈ\nDDE‡" [progn defvar var default-value format "%s\n(buffer local)" documentation make-variable-buffer-local quote] 7])) #@49 (vip-loop COUNT BODY) Execute BODY COUNT times. (defalias 'vip-loop '(macro . #[(count body) "ÀÁ DCÂÃ\fÅFE‡" [let count while (> count 0) body (setq count (1- count))] 6 (#$ . 1294)])) (defalias 'vip-buffer-live-p '(macro . #[(buf) "À  DàDDF‡" [and buf get-buffer buffer-name] 6])) (defalias 'vip-kbd-buf-alist '(macro . #[(macro-elt) "ÀÁ\nE‡" [nth 1 macro-elt] 3])) (defalias 'vip-kbd-buf-pair '(macro . #[(macro-elt) "ÀÁ DE‡" [assoc (buffer-name) vip-kbd-buf-alist macro-elt] 4])) (defalias 'vip-kbd-buf-definition '(macro . #[(macro-elt) "ÀÁ\nDD‡" [cdr vip-kbd-buf-pair macro-elt] 3])) (defalias 'vip-kbd-mode-alist '(macro . #[(macro-elt) "ÀÁ\nE‡" [nth 2 macro-elt] 3])) (defalias 'vip-kbd-mode-pair '(macro . #[(macro-elt) "ÀÁ DE‡" [assoc major-mode vip-kbd-mode-alist macro-elt] 4])) (defalias 'vip-kbd-mode-definition '(macro . #[(macro-elt) "ÀÁ\nDD‡" [cdr vip-kbd-mode-pair macro-elt] 3])) (defalias 'vip-kbd-global-pair '(macro . #[(macro-elt) "ÀÁ\nE‡" [nth 3 macro-elt] 3])) (defalias 'vip-kbd-global-definition '(macro . #[(macro-elt) "ÀÁ\nDD‡" [cdr vip-kbd-global-pair macro-elt] 3])) (defalias 'vip-seq-last-elt #[(seq) "‰GSœ‡" [seq] 2]) (put (quote vip-seq-last-elt) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-valid-register #[(reg &optional type) "„ÁÂ>ƒÃ\fXƒ\fÅX†9Æ>ƒ*Ç\fXƒ*\fÈX†9É>…9Ê\fX…9\fËX‡" [type (letter Letter digit) letter 97 reg 122 digit 49 57 Letter 65 90] 2]) (defalias 'vip-valid-marker #[(marker) "À !…\" !…\" !à !Š qˆ\fdX…!e\fX+‡" [markerp marker marker-buffer marker-position pos buf] 3]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÅÄ BÀÆ!„!ÇÆ Bƒ¬ÉÊKMˆËÌKMˆÍÎKMˆÏÐKMˆÑÒKMˆÓÔKMˆÕÖKMˆ×ØKMˆƒ\\‚`ÛÜ !ƒ{ƒm‚qÛÜ !Ý>„{ÞßKMˆƒ…‚‰ÛÜ !ƒ+ƒ–‚šÛÜ !Ý>„+àáKMˆâãKMˆ‚+ÉäKMˆËåKMˆÍæKMˆÏçKMˆÑèKMˆÓéKMˆÕêKMˆ×ëKMˆƒÞ‚âÛÜ !ƒýƒï‚óÛÜ !Ý>„ýÞìKMˆƒ‚ ÛÜ !ƒ+ƒ‚ÛÜ !Ý>„+àíKMˆâîKMˆÀ‡" [boundp vip-minibuffer-overlay-priority 300 current-load-list vip-replace-overlay-priority 400 vip-search-overlay-priority 500 vip-xemacs-p vip-read-event next-command-event vip-make-overlay make-extent vip-overlay-start extent-start-position vip-overlay-end extent-end-position vip-overlay-put set-extent-property vip-overlay-p extentp vip-overlay-get extent-property vip-move-overlay set-extent-endpoints vip-emacs-p window-system device-type selected-device (tty stream) vip-iconify iconify-frame vip-get-face get-face vip-color-defined-p valid-color-name-p read-event make-overlay overlay-start overlay-end overlay-put overlayp overlay-get move-overlay iconify-or-deiconify-frame internal-get-face x-color-defined-p] 2) (defalias 'vip-color-display-p #[nil "ƒÁ ‡Âà !Ä=‡" [vip-emacs-p x-display-color-p device-class selected-device color] 2]) (byte-code "ÀÁÂÃ#ˆ\fƒ ‚ÆÇ !È=ƒÉÊMˆÀ‡" [put vip-color-display-p byte-optimizer byte-compile-inline-expand vip-emacs-p window-system device-type selected-device pm vip-color-defined-p #[(color) "À \n\"‡" [assoc color pm-color-alist] 3]] 4) (defalias 'vip-italicize-face #[(face) "ƒÁ\n!‡Á\nÃÄ#‡" [vip-xemacs-p make-face-italic face nil noerror] 4]) (put (quote vip-italicize-face) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-can-use-colors #[(&rest colors) "ƒ Á ‚Âà !Ä=…ÅÆÇ\">?‡" [vip-emacs-p x-display-color-p device-class selected-device color nil mapcar vip-color-defined-p colors] 4]) (put (quote vip-can-use-colors) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-change-cursor-color #[(new-color) "ƒ ‚\fÂà !…Vƒ ‚Âà !Ä>?…Vƒ*Å ‚0Æà !Ç=…V;…VÉ!…VÊËÌ \"A˜?…VÍÎ ËBC\"‡" [vip-emacs-p window-system device-type selected-device (tty stream) x-display-color-p device-class color new-color vip-color-defined-p assoc cursor-color frame-parameters modify-frame-parameters selected-frame] 4]) (defalias 'vip-save-cursor-color #[nil "ƒ ‚\fÂà !…Xƒ ‚Âà !Ä>?…Xƒ*Å ‚0Æà !Ç=…XÈÉÊ \"A‰;…WË!…W\f˜?…WÍÏ#)‡" [vip-emacs-p window-system device-type selected-device (tty stream) x-display-color-p device-class color assoc cursor-color frame-parameters vip-color-defined-p vip-replace-overlay-cursor-color vip-overlay-put vip-replace-overlay vip-cursor-color] 5]) (put (quote vip-save-cursor-color) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-restore-cursor-color #[nil "ÀÁ\nÃ\"!‡" [vip-change-cursor-color vip-overlay-get vip-replace-overlay vip-cursor-color] 4]) (put (quote vip-restore-cursor-color) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-get-cursor-color #[nil "ÀÁ \"A‡" [assoc cursor-color frame-parameters] 3]) (put (quote vip-get-cursor-color) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-check-version #[(op major minor &optional type-of-emacs) "ÀÁ!ƒeÀÂ!ƒe Ä=ƒ ‚\" Æ=ƒ!‚\"È…v Ê=ƒ8\n U…d \fU‡ Í>ƒ_ \f\"„O \fU…d \fUƒ] \n \"‡È‡ÎÏ \"‡ Ð>ƒnч Ò>…vȇ" [boundp emacs-major-version emacs-minor-version type-of-emacs xemacs vip-xemacs-p emacs vip-emacs-p t op = minor major (> >= < <=) error "%S: Invalid op in vip-check-version" (= > >=) nil (< <=)] 3]) (defalias 'vip-get-visible-buffer-window #[(wind) "ƒ Á\nÃ\"‡Á\nÄ\"‡" [vip-xemacs-p get-buffer-window wind t visible] 3]) (defalias 'vip-line-pos #[(pos) "`À ÄšƒÅyˆ‚9 ÆšƒÀˆ‚9 Çšƒ0ÈÄ!ÈÆ!É\\\\bˆ‚9 Êšƒ9Ë ˆ`\nbˆ *‡" [nil result cur-pos pos start 0 end mid vip-line-pos 2 indent back-to-indentation] 3]) (defalias 'vip-move-marker-locally #[(var pos &optional buffer) "ÀÁ\n!!„ \nà LˆÁ\n!\f “‡" [markerp eval var make-marker pos buffer] 3]) (defalias 'vip-message-conditions #[(conditions) "@A „ÃÄ\n\"ˆ‚ÃÅ\nÆÇ È##ˆÉÊ!*‡" [conditions msg case message "%s" "%s: %s" mapconcat prin1-to-string " " beep 1] 7]) (defalias 'vip-list-to-alist #[(lst) "À\nƒ\n@C B\nA‰„ )‡" [nil alist lst] 3]) (defalias 'vip-alist-to-list #[(alst) "À\nƒ\n@@ B\nA‰„ )‡" [nil lst alst] 3]) (defalias 'vip-filter-alist #[(regexp alst) "À \n@ƒÄ \n@@\"ƒ\n@ B\nA‰‚ *‡" [nil alst inalst outalst string-match regexp] 4 nil "s x"]) (defalias 'vip-filter-list #[(regexp lst) "À \n@ƒÄ \n@\"ƒ\n@ B\nA‰‚ *‡" [nil lst inlst outlst string-match regexp] 4 nil "s x"]) (defalias 'vip-append-filter-alist #[(lis1 lis2) "Á‰ƒ\"Ä @@ \"‰ƒÆ\n \"‚ A‰„ ¤*‡" [lis1 nil elt temp assoc lis2 delq] 4]) (defalias 'vip-ring-rotate1 #[(ring dir) "À !…6 !ÃV…6 \fÃVƒÅ @ !\"‚1\fÃWƒ/Æ @ !\"‚1 @ ˆÇ !‡" [ring-p ring ring-length 0 dir ring-plus1 ring-minus1 vip-current-ring-item] 5]) (defalias 'vip-special-ring-rotate1 #[(ring dir) "Á>ƒ  \f\"‡Â Å\"‡" [vip-intermediate-command (repeating-display-destructive-command repeating-insertion-from-ring) vip-ring-rotate1 ring dir 0] 3]) (defalias 'vip-current-ring-item #[(ring &optional n) "†Á !…#Ä !ÁV…# AAÅ @ZÆZÄ !\"H‡" [n 0 ring-p ring ring-length mod 1] 5]) (defalias 'vip-push-onto-ring #[(item ring-var) "ÀÁ\n!!„\nÃÁÄÅÆ\n\"!!!Lˆ?†J;ƒ(Ș†JÉÁ\n!!š†J\nÊ=ƒCËÌÍÎ !\"†JÏÁ\n!\"‡" [ring-p eval ring-var make-ring intern format "%S-size" item "" vip-current-ring-item vip-command-ring string-match "\\([0-9]*\\|^[ ]*$\\|escape\\)" vip-array-to-string this-command-keys vip-ring-insert] 7]) (defalias 'vip-cleanup-ring #[(ring) "À !ÂW†à !?†à !à Ä\"š…Å !‡" [ring-length ring 2 vip-current-ring-item 1 vip-ring-pop] 4]) (defalias 'vip-ring-pop #[(ring) "À ! AA‰G @ÆÇ \n\"] H T\fWƒ7  THIˆT‰‚ ÊIˆÆÇ \n\"]‰\nSUƒMÆ  ˆ AÆ\nS] ˆ .‡" [ring-length ring ln vec veclen hd 0 ring-minus1 idx top-elt nil] 5]) (defalias 'vip-ring-insert #[(ring item) "À ! AA‰G @‰ÆUƒ\n‚ \n\n\fUƒ4  Iˆ Ê \n\" ˆ‚k A\nT ˆ Ê\nT\" ˆYƒd\nÆVƒd  SHIˆS‰‚E  Iˆ .‡" [ring-length ring ln vec veclen hd 0 vecpos-after-hd idx item ring-plus1] 5]) (defalias 'vip-abbreviate-string #[(string max-len pre-string post-string abbrev-sign) "À\n;…\nÃ\f\nG^O‰„Å‚3\nG\fVƒ+ÆÇ  \n%‚3ÆË \n$)‡" [nil truncated-str string 0 max-len "" format "%s%s%s%s" pre-string abbrev-sign post-string "%s%s%s"] 7]) (defalias 'vip-over-whitespace-line #[nil "ŠÀyˆÁÂ!)‡" [0 looking-at "^[ ]*$"] 2]) (put (quote vip-over-whitespace-line) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-save-setting #[(var message custom-file &optional erase-msg) "À !à !… Ä !ÆÇ\n\"ÉÊ !!\fÍ !ˆŠ\fqˆebˆÎÏÐ#ƒPÑ•SÓ\n!ˆÑ”|ˆÑ”bˆÆÔ\n #cˆ)‚adbˆn„ZÕcˆÆÖ\n #cˆ× ˆ)Ø\f!ˆ…vÚÛ!ˆÍÜ!,‡" [symbol-name var var-name boundp eval var-val format "^[^;]*%s[ \n]*[a-zA-Z---_']*[ \n)]" regexp find-file-noselect substitute-in-file-name custom-file buf message re-search-forward nil t 0 reg-end search-backward "%s '%S" "\n" "(setq %s '%S)\n" save-buffer kill-buffer erase-msg sit-for 2 ""] 4]) (defalias 'vip-save-string-in-file #[(string custom-file &optional pattern) "ÀÁ\n!!Š qˆebˆ\fƒÅ\f!ˆdbˆƒ!cˆÇ ˆ)È !)‡" [find-file-noselect substitute-in-file-name custom-file buf pattern delete-matching-lines string save-buffer kill-buffer] 3]) (defalias 'vip-flash-search-pattern #[nil "À !ƒ ÔÕ#ˆ‚ÄÔÕp#Å Æ#ˆƒ* ‚.ÊË !…Uƒ; ‚?ÊË !Ì>?…UÅ Í#ˆÏÐ!ˆÅ ÍÑ#‡" [vip-overlay-p vip-search-overlay vip-move-overlay 0 vip-make-overlay vip-overlay-put priority vip-search-overlay-priority vip-emacs-p window-system device-type selected-device (tty stream) face vip-search-face sit-for 2 nil] 4]) (defalias 'vip-set-replace-overlay #[(beg end) "À !ƒ(\n Ä \n #ˆÅ Æ\"Ç !È“ˆÅ É\"Ê !È“ˆ*‚MË\n p#Ì ÆÍ Ç !È“#ˆÌ ÉÍ Ê !È“#ˆÌ Î#ˆƒW‚[ÒÓ !ƒxƒh‚lÒÓ !Ô>„xÌ Õ#ˆƒ‚‚†ÒÓ !ƒÔƒ“‚—ÒÓ !Ô>„Ôƒ¦× ‚¬ØÓ !Ù=ƒÔÚÛÜ \"A‰;…ÒÝ!…Ò˜?…ÒÌ ß#)ˆà!‡" [vip-overlay-p vip-replace-overlay beg end vip-move-overlay vip-overlay-get vip-start vip-overlay-start nil vip-end vip-overlay-end vip-make-overlay vip-overlay-put make-marker priority vip-replace-overlay-priority vip-emacs-p window-system device-type selected-device (tty stream) face vip-replace-overlay-face x-display-color-p device-class color assoc cursor-color frame-parameters vip-color-defined-p vip-replace-overlay-cursor-color vip-cursor-color vip-change-cursor-color] 6]) (defalias 'vip-hide-replace-overlay #[nil "À‰ ƒ\f\f‚ÅÆ !ƒ) ƒ\f‚ÅÆ !Ç>„)ƒR ƒ2Ê‚3Ë ƒ<Ì‚=ÍÐ\n#ˆÐ #*ˆ*ÒÓÔ\"!ˆ ƒc\f‚gÅÆ !…‚ ƒr\f‚vÅÆ !Õ>?…‚ÐÖÀ#‡" [nil after-glyph before-glyph vip-emacs-p window-system device-type selected-device (tty stream) vip-use-replace-region-delimiters vip-xemacs-p begin-glyph before-string end-glyph after-string after-name before-name vip-overlay-put vip-replace-overlay vip-change-cursor-color vip-overlay-get vip-cursor-color (tty stream) face] 4]) (put (quote vip-hide-replace-overlay) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-set-replace-overlay-glyphs #[(before-glyph after-glyph) "ƒ ‚\fÂà !ƒ$ƒ ‚Âà !Ä>„$ …Nƒ-Ç‚.ȃ7É‚8Ê \fÍ\f#ˆÍ #*‡" [vip-emacs-p window-system device-type selected-device (tty stream) vip-use-replace-region-delimiters vip-xemacs-p begin-glyph before-string end-glyph after-string after-name before-name vip-overlay-put vip-replace-overlay before-glyph after-glyph] 4]) (put (quote vip-set-replace-overlay-glyphs) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-replace-start #[nil "À Â\"‡" [vip-overlay-get vip-replace-overlay vip-start] 3]) (put (quote vip-replace-start) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-replace-end #[nil "À Â\"‡" [vip-overlay-get vip-replace-overlay vip-end] 3]) (put (quote vip-replace-end) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-move-replace-overlay #[(beg end) "À \n #ˆÄ Å\"Æ !Ç“ˆÄ È\"É !Ç“‡" [vip-move-overlay vip-replace-overlay beg end vip-overlay-get vip-start vip-overlay-start nil vip-end vip-overlay-end] 4]) (put (quote vip-move-replace-overlay) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-set-minibuffer-overlay #[nil "À ˆÁ ˆ\nƒ ‚ÄÅ !…6\nƒ ‚!ÄÅ !Æ>?…6ÇÉ\n#ˆÇË\f#‡" [vip-check-minibuffer-overlay vip-move-minibuffer-overlay vip-emacs-p window-system device-type selected-device (tty stream) vip-overlay-put vip-minibuffer-overlay face vip-minibuffer-current-face priority vip-minibuffer-overlay-priority] 4]) (defalias 'vip-check-minibuffer-overlay #[nil "À !?…ÂÃÄ Tp#‰‡" [vip-overlay-p vip-minibuffer-overlay vip-make-overlay 1 buffer-size] 4]) (defalias 'vip-move-minibuffer-overlay #[(&optional overl beg end) "ÀÁ \"…à ˆÄ ÆÇ T#‡" [string-match "*Minibuf-" buffer-name vip-check-minibuffer-overlay vip-move-overlay vip-minibuffer-overlay 1 buffer-size] 4]) (defalias 'vip-is-in-minibuffer #[nil "ÀÁ \"‡" [string-match "*Minibuf-" buffer-name] 3]) (put (quote vip-is-in-minibuffer) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-sit-for-short #[(val &optional nodisp) "ƒ Á\nÃ¥\f\"‡ÁÅ\n\f#‡" [vip-xemacs-p sit-for val 1000.0 nodisp 0] 4]) (put (quote vip-sit-for-short) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-ESC-event-p #[(event) "ÀÁ\n! \f*‡" [(27 (control \[) escape) vip-event-key event key ESC-keys] 3]) (put (quote vip-ESC-event-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-set-mark-if-necessary #[nil "À ƒ ÂÃ!‚  \f\"ÅÆ!‡" [delete vip-xemacs-p mark-marker t mark-ring set-mark-command nil] 3]) (put (quote vip-set-mark-if-necessary) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-mark-marker #[nil "ƒÁÂ!‡Á ‡" [vip-xemacs-p mark-marker t] 2]) (put (quote vip-mark-marker) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-deactivate-mark #[nil "ƒÁ ‡\n…ÃÅÆ!‡" [vip-xemacs-p zmacs-deactivate-region transient-mark-mode nil mark-active run-hooks deactivate-mark-hook] 2]) (defalias 'vip-leave-region-active #[nil "…Á‰‡" [vip-xemacs-p t zmacs-region-stays] 2]) (put (quote vip-leave-region-active) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-events-to-keys #[(events) "ƒÁ\n!‡\n‡" [vip-xemacs-p events-to-keys events] 2]) (put (quote vip-events-to-keys) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-eval-after-load #[(file form) "ƒ Á\n \"‡Ä\n \"„\nC BÄ\n \" A„* C¤) ‡" [vip-emacs-p eval-after-load file form assoc after-load-alist elt] 3]) (defalias 'vip-add-hook #[(hook function &optional append) "À !„\n ÂLˆ J‰<ƒ @Ä=ƒ C ?…5 ƒ1Æ C\"‚4 BL)‡" [boundp hook nil old lambda function append] 5]) (defalias 'vip-remove-hook #[(hook function) "À !?† J?†\n??…1 J‰:ƒ%Ä\nÅ !\"‚- \nšƒ-Æ L)‡" [boundp hook function hook-value delete copy-sequence nil] 5]) (defalias 'vip-read-event-convert-to-char #[nil "À\nƒ à ‚Ä Å !† )‡" [nil event vip-emacs-p read-event next-command-event event-to-character] 2]) (defalias 'vip-read-key #[nil "ÁÄ!ˆÅÁ!ÆœÄ!ˆ\n*‡" [vip-overriding-map nil key overriding-local-map use-global-map read-key-sequence 0 global-map] 2]) (defalias 'vip-event-key #[(event) "ƒ\nÁ!„ÂÃ\"ˆÄ!Ń?É!ƒ(Ê!‚xË!ƒ8ÌÍÎ!!P‚xÂÏ\"‚x§ƒYÐXƒYÑXƒYʼn‚x§ƒuÒWƒuÓXƒuÔÕZ‰‚xÖ!‰§ƒ”ÒUƒŒ×ØD‚’ÙÚ!!ƒ£ÛC\"‚¥*‡" [event eventp error "vip-event-key: Wrong type argument, eventp, %S" event-modifiers nil basis mod vip-xemacs-p key-press-event-p event-key button-event-p "mouse-" prin1-to-string event-button "vip-event-key: Unknown event, %S" 65 90 127 255 (meta) 128 event-basic-type control \? intern char-to-string append] 5]) (defalias 'vip-key-to-emacs-key #[(key) "À‰‰‰‰‰ƒ‚‚9ƒ6É!‰GÊUƒ1Ë!‚‚‚‚<…‚ÌÍGS#‰‰GSœ)É\n!‰GÊUÏÐ\f\" ƒuÑÒÓÔ Õ#Ö R!@‰‚‚×ÓÔ Ö#Ö Q!‰.‡" [nil base-key-name base-key mod-char-list modifiers char-p key-name vip-xemacs-p key symbol-name 1 string-to-char subseq 0 seq mapcar #[(elt) "À !ÂÃO–‡" [symbol-name elt 0 1] 3] read-from-string "?\\" mapconcat identity "-\\" "-" intern] 7]) (defalias 'vip-array-to-string #[(event-seq &optional representation) "À\n;ƒ \n‚=Ã\n!ƒ,ÄÅ\n\"Æ !ƒ$ÇÈ É#‚=ÊË !!‚=Æ\n!ƒ:ÇÈ\nÉ#‚=Ê\n!)‡" [nil temp event-seq vip-event-vector-p mapcar vip-event-key vip-char-symbol-sequence-p mapconcat symbol-name "" prin1-to-string vconcat] 4]) (defalias 'vip-key-press-events-to-chars #[(events) "À ƒ ‚\nÃ\fÅ#‡" [mapconcat vip-emacs-p char-to-string #[(elt) "ÀÁ\n!!‡" [char-to-string event-to-character elt] 3] events ""] 4]) (defalias 'vip-fast-keysequence-p #[nil "Á\fƒŠƥ\n\"‚ÅÇ \n#*?‡" [vip-fast-keyseq-timeout t nodisp val vip-xemacs-p sit-for 1000.0 0] 4]) (put (quote vip-fast-keysequence-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-read-char-exclusive #[nil "ÀÁ „ÀÄň‚ *‡" [nil 1 echo-keystrokes char (byte-code "À À‡" [read-char char] 1) ((error (vip-read-event)))] 3]) #@163 Set up the current buffer as a master buffer. Arguments become related buffers. This function should normally be used in the `Local variables' section of a file. (defalias 'vip-setup-master-buffer #[(&rest other-files-or-buffers) "À GT!ÃÄ \"ˆÅ\nÆ \"‡" [make-ring other-files-or-buffers vip-related-files-and-buffers-ring mapcar #[(elt) "À \n\"‡" [vip-ring-insert vip-related-files-and-buffers-ring elt] 3] vip-ring-insert buffer-name] 3 (#$ . 18082)]) #@523 *Syntax type characterizing Viper's alphanumeric symbols. `emacs' means only word constituents are considered to be alphanumeric. Word constituents are symbols specified as word constituents by the current syntax table. `extended' means word and symbol constituents. `reformed-vi' means Vi-ish behavior: word constituents and the symbol `_'. However, word constituents are determined according to Emacs syntax tables, which may be different from Vi in some major modes. `strict-vi' means Viper words are exactly as in Vi. (defvar vip-syntax-preference (quote strict-vi) (#$ . -18542)) #@189 String of syntax classes characterizing Viper's alphanumeric symbols. In addition, the symbol `_' may be considered alphanumeric if `vip-syntax-preference'is `reformed-vi'. (buffer local) (defvar vip-ALPHA-char-class "w" (#$ . 19134)) (make-variable-buffer-local (quote vip-ALPHA-char-class)) #@92 Regexp matching the set of alphanumeric characters acceptable to strict Vi. (buffer local) (defvar vip-strict-ALPHA-chars "a-zA-Z0-9_" (#$ . 19433)) (make-variable-buffer-local (quote vip-strict-ALPHA-chars)) #@92 Regexp matching the set of alphanumeric characters acceptable to strict Vi. (buffer local) (defvar vip-strict-SEP-chars " \n" (#$ . 19648)) (make-variable-buffer-local (quote vip-strict-SEP-chars)) #@109 String of syntax classes for Vi separators. Usually contains ` ', linefeed, TAB or formfeed. (buffer local) (defvar vip-SEP-char-class " -" (#$ . 19854)) (make-variable-buffer-local (quote vip-SEP-char-class)) #@185 Set the syntactic class of Viper alphanumeric symbols according to the variable `vip-ALPHA-char-class'. Should be called in order for changes to `vip-ALPHA-char-class' to take effect. (defalias 'vip-update-alphanumeric-class #[nil "ÀÁ\nÃ=ƒ\fÄ‚\nÅ=ƒÆ‚Ä\"‡" [set-default vip-ALPHA-char-class vip-syntax-preference emacs "w" extended "w_"] 4 (#$ . 20071) nil]) (defalias 'vip-looking-at-alpha #[(&optional addl-chars) ";„Á\nÃ=ƒÄP`f‰…>\nÆ=ƒ)ÇÈ ÊR!‚> ËÌ!Í\">†> zËÌ!Í\">)‡" [addl-chars "" vip-syntax-preference reformed-vi "_" char strict-vi looking-at "[" vip-strict-ALPHA-chars "]" append vconcat nil vip-ALPHA-char-class] 6]) (defalias 'vip-looking-at-separator #[nil "`f‰…Á=†zÂÃ\f!Å\">)‡" [char 10 append vconcat vip-SEP-char-class nil] 5]) (put (quote vip-looking-at-separator) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-looking-at-alphasep #[(&optional addl-chars) "`f‰…Á=†zÂÃ\f!Å\">)†Æ!‡" [char 10 append vconcat vip-SEP-char-class nil vip-looking-at-alpha addl-chars] 5]) (put (quote vip-looking-at-alphasep) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-skip-alpha-forward #[(&optional addl-chars) ";„ÁÂÃ\fÅ=ƒÁ‚\fÅ=ƒ\"P‚##‡" [addl-chars "" vip-skip-syntax forward vip-syntax-preference strict-vi vip-ALPHA-char-class vip-strict-ALPHA-chars] 5]) (put (quote vip-skip-alpha-forward) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-skip-alpha-backward #[(&optional addl-chars) ";„ÁÂÃ\fÅ=ƒÁ‚\fÅ=ƒ\"P‚##‡" [addl-chars "" vip-skip-syntax backward vip-syntax-preference strict-vi vip-ALPHA-char-class vip-strict-ALPHA-chars] 5]) (put (quote vip-skip-alpha-backward) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-skip-all-separators-forward #[(&optional within-line) "ÀÁ\n †Ä …ÅÆ!$‡" [vip-skip-syntax forward vip-SEP-char-class within-line "\n" vip-line-pos end] 6]) (put (quote vip-skip-all-separators-forward) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-skip-all-separators-backward #[(&optional within-line) "ÀÁ\n †Ä …ÅÆ!$‡" [vip-skip-syntax backward vip-SEP-char-class within-line "\n" vip-line-pos start] 6]) (put (quote vip-skip-all-separators-backward) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-skip-nonseparators #[(direction) "ÀÁ \"!‰ÅPÇ È=ƒÉ‚Ê!\")‡" [intern format "skip-syntax-%S" direction func "^" vip-SEP-char-class vip-line-pos forward end start] 6]) (defalias 'vip-skip-nonalphasep-forward #[nil "Á=ƒ  \fQÅw‡ÆÂQÉÊ!\"‡" [vip-syntax-preference strict-vi "^" vip-strict-SEP-chars vip-strict-ALPHA-chars nil skip-syntax-forward vip-ALPHA-char-class vip-SEP-char-class vip-line-pos end] 4]) (put (quote vip-skip-nonalphasep-forward) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-skip-nonalphasep-backward #[nil "Á=ƒ  \fQÅx‡ÆÂQÉÊ!\"‡" [vip-syntax-preference strict-vi "^" vip-strict-SEP-chars vip-strict-ALPHA-chars nil skip-syntax-backward vip-ALPHA-char-class vip-SEP-char-class vip-line-pos start] 4]) (put (quote vip-skip-nonalphasep-backward) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-skip-syntax #[(direction syntax addl-chars &optional limit) "ÀÁÂÃÄ \"!ÂÃÆ \"! \n ;„Ì  ;„(Ì  ÀU„Nm„N \" \"\\ \n \\\n‚(\n,‡" [0 1 intern format "skip-chars-%S" direction "skip-syntax-%S" skip-syntax-func skip-chars-func local total addl-chars "" syntax limit] 7]) (provide (quote viper-util)) emacs-19.30/lisp/viper.elc100666 75424 12 353435 6051576716 14045 0ustar kwzhstaff;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 13 03:09:03 1995 ;;; from file /home/fsf/rms/e19/lisp/viper.el ;;; emacs version 19.29.90.5. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`viper.el' was compiled for Emacs 19.29 or later")) #@30 The current version of Viper (defconst viper-version "2.82 of October 12, 1995" (#$ . 468)) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÅÆ!„ÇÆBÀ‡" [require advice cl ring viper-util boundp vip-first-time t current-load-list] 2) #@327 User's expert level. The minor mode vip-vi-diehard-minor-mode is in effect when vip-expert-level is 1 or 2 or when vip-want-emacs-keys-in-vi is t. The minor mode vip-insert-diehard-minor-mode is in effect when vip-expert-level is 1 or 2 or if vip-want-emacs-keys-in-insert is t. Use `M-x vip-set-expert-level' to change this. (defvar vip-expert-level 0 (#$ . 695)) (byte-code "ÀÁ\nBÃÄ!„ÅÄ\nBÆÇ!‡" [5 vip-max-expert-level current-load-list boundp vip-saved-user-settings nil make-variable-buffer-local minor-mode-map-alist] 2) #@20 nil (buffer local) (defvar vip-vi-intercept-minor-mode nil (#$ . 1233)) (make-variable-buffer-local (quote vip-vi-intercept-minor-mode)) #@52 Viper's minor mode for Vi bindings. (buffer local) (defvar vip-vi-basic-minor-mode nil (#$ . 1376)) (make-variable-buffer-local (quote vip-vi-basic-minor-mode)) #@82 Auxiliary minor mode for user-defined local bindings in Vi state. (buffer local) (defvar vip-vi-local-user-minor-mode nil (#$ . 1543)) (make-variable-buffer-local (quote vip-vi-local-user-minor-mode)) #@83 Auxiliary minor mode for user-defined global bindings in Vi state. (buffer local) (defvar vip-vi-global-user-minor-mode nil (#$ . 1750)) (make-variable-buffer-local (quote vip-vi-global-user-minor-mode)) #@86 Minor mode used to make major-mode-specific modification to Vi state. (buffer local) (defvar vip-vi-state-modifier-minor-mode nil (#$ . 1960)) (make-variable-buffer-local (quote vip-vi-state-modifier-minor-mode)) #@81 This minor mode is in effect when the user wants Viper to be Vi. (buffer local) (defvar vip-vi-diehard-minor-mode nil (#$ . 2179)) (make-variable-buffer-local (quote vip-vi-diehard-minor-mode)) #@154 Minor mode for Ex command macros in Vi state. The corresponding keymap stores key bindings of Vi macros defined with the Ex command :map. (buffer local) (defvar vip-vi-kbd-minor-mode nil (#$ . 2380)) (make-variable-buffer-local (quote vip-vi-kbd-minor-mode)) #@20 nil (buffer local) (defvar vip-insert-intercept-minor-mode nil (#$ . 2645)) (make-variable-buffer-local (quote vip-insert-intercept-minor-mode)) #@64 Viper's minor mode for bindings in Insert mode. (buffer local) (defvar vip-insert-basic-minor-mode nil (#$ . 2796)) (make-variable-buffer-local (quote vip-insert-basic-minor-mode)) #@188 Auxiliary minor mode for buffer-local user-defined bindings in Insert state. This is a way to overshadow normal Insert mode bindings locally to certain designated buffers. (buffer local) (defvar vip-insert-local-user-minor-mode nil (#$ . 2984)) (make-variable-buffer-local (quote vip-insert-local-user-minor-mode)) #@87 Auxiliary minor mode for global user-defined bindings in Insert state. (buffer local) (defvar vip-insert-global-user-minor-mode nil (#$ . 3305)) (make-variable-buffer-local (quote vip-insert-global-user-minor-mode)) #@90 Minor mode used to make major-mode-specific modification to Insert state. (buffer local) (defvar vip-insert-state-modifier-minor-mode nil (#$ . 3527)) (make-variable-buffer-local (quote vip-insert-state-modifier-minor-mode)) #@103 Minor mode that simulates Vi very closely. Not recommened, except for the novice user. (buffer local) (defvar vip-insert-diehard-minor-mode nil (#$ . 3759)) (make-variable-buffer-local (quote vip-insert-diehard-minor-mode)) #@156 Minor mode for Ex command macros Insert state. The corresponding keymap stores key bindings of Vi macros defined with the Ex command :map!. (buffer local) (defvar vip-insert-kbd-minor-mode nil (#$ . 3990)) (make-variable-buffer-local (quote vip-insert-kbd-minor-mode)) #@86 Minor mode in effect in replace state (cw, C, and the like commands). (buffer local) (defvar vip-replace-minor-mode nil (#$ . 4265)) (make-variable-buffer-local (quote vip-replace-minor-mode)) #@20 nil (buffer local) (defvar vip-emacs-intercept-minor-mode t (#$ . 4464)) (make-variable-buffer-local (quote vip-emacs-intercept-minor-mode)) #@155 Minor mode for local user bindings effective in Emacs state. Users can use it to override Emacs bindings when Viper is in its Emacs state. (buffer local) (defvar vip-emacs-local-user-minor-mode t (#$ . 4612)) (make-variable-buffer-local (quote vip-emacs-local-user-minor-mode)) #@156 Minor mode for global user bindings in effect in Emacs state. Users can use it to override Emacs bindings when Viper is in its Emacs state. (buffer local) (defvar vip-emacs-global-user-minor-mode t (#$ . 4897)) (make-variable-buffer-local (quote vip-emacs-global-user-minor-mode)) #@221 Minor mode for Vi style macros in Emacs state. The corresponding keymap stores key bindings of Vi macros defined with `vip-record-kbd-macro' command. There is no Ex-level command to do this interactively. (buffer local) (defvar vip-emacs-kbd-minor-mode t (#$ . 5185)) (make-variable-buffer-local (quote vip-emacs-kbd-minor-mode)) #@186 Minor mode used to make major-mode-specific modification to Emacs state. For instance, a Vi purist may want to bind `dd' in Dired mode to a function that deletes a file. (buffer local) (defvar vip-emacs-state-modifier-minor-mode t (#$ . 5522)) (make-variable-buffer-local (quote vip-emacs-state-modifier-minor-mode)) #@218 *If non-nil, ISO accents will be turned on in insert/replace emacs states and turned off in vi-state. For some users, this behavior may be too primitive. In this case, use insert/emacs/vi state hooks. (buffer local) (defvar vip-automatic-iso-accents nil (#$ . -5846)) (make-variable-buffer-local (quote vip-automatic-iso-accents)) #@141 *Set to nil if you want complete Vi compatibility in insert mode. Complete compatibility with Vi is not recommended for power use of Viper. (defvar vip-want-emacs-keys-in-insert t (#$ . -6185)) #@128 *Set to nil if you want complete Vi compatibility in Vi mode. Full Vi compatibility is not recommended for power use of Viper. (defvar vip-want-emacs-keys-in-vi t (#$ . -6386)) #@20 nil (buffer local) (defvar vip-undo-needs-adjustment nil (#$ . 6569)) (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅÆBÀ‡" [make-variable-buffer-local vip-undo-needs-adjustment put permanent-local t viper vip-buffer-undo-list-mark current-load-list] 4) #@153 *Non-nil means not to move point while undoing commands. This style is different from Emacs and Vi. Try it to see if it better fits your working style. (defvar vip-keep-point-on-undo nil (#$ . -6811)) #@17 (buffer local) (defvar vip-after-change-functions nil (#$ . 7018)) (make-variable-buffer-local (quote vip-after-change-functions)) #@17 (buffer local) (defvar vip-before-change-functions nil (#$ . 7156)) (make-variable-buffer-local (quote vip-before-change-functions)) #@17 (buffer local) (defvar vip-post-command-hooks nil (#$ . 7296)) (make-variable-buffer-local (quote vip-post-command-hooks)) #@17 (buffer local) (defvar vip-pre-command-hooks nil (#$ . 7426)) (make-variable-buffer-local (quote vip-pre-command-hooks)) #@17 (buffer local) (defvar vip-intermediate-command nil (#$ . 7554)) (make-variable-buffer-local (quote vip-intermediate-command)) #@17 (buffer local) (defvar vip-began-as-replace nil (#$ . 7688)) (make-variable-buffer-local (quote vip-began-as-replace)) #@39 *Cursor color to use in Replace state (defvar vip-replace-overlay-cursor-color "Red" (#$ . -7814)) #@17 (buffer local) (defvar vip-replace-overlay nil (#$ . 7919)) (byte-code "ÀÁ!ˆÂÁÃÄ#ˆ ƒ‚ÇÈ !ƒm ƒ#‚'ÇÈ !É>„mÊËÌ\"ˆÍÌ!ˆÎÌ!„mÏÐD ƒIÒ ‚OÓÈ !Ô=…ZÕÖ×\">?)ƒhØÌÏ\"ˆÙÌÐ\"ˆÚÌÄ\"ˆÕ‡" [make-variable-buffer-local vip-replace-overlay put permanent-local t vip-emacs-p window-system device-type selected-device (tty stream) add-to-list facemenu-unlisted-faces vip-replace-overlay-face make-face face-differs-from-default-p "darkseagreen2" "Black" colors x-display-color-p device-class color nil mapcar vip-color-defined-p set-face-background set-face-foreground set-face-underline-p] 4) #@61 *Face for highlighting replace regions on a window display. (defvar vip-replace-overlay-face (quote vip-replace-overlay-face) (#$ . -8516)) #@130 A string marking the end of replacement regions. It is used only with TTYs or if `vip-use-replace-region-delimiters' is non-nil. (defvar vip-replace-region-end-delimiter "$" (#$ . 8663)) #@136 A string marking the beginning of replacement regions. It is used only with TTYs or if `vip-use-replace-region-delimiters' is non-nil. (defvar vip-replace-region-start-delimiter "" (#$ . 8857)) #@241 *If non-nil, Viper will always use `vip-replace-region-end-delimiter' and `vip-replace-region-start-delimiter' to delimit replacement regions, even on color displays. By default, the delimiters are used only on TTYs or monochrome displays. (defvar vip-use-replace-region-delimiters (byte-code "ƒ ‚\fÂà !…ƒ ‚Âà !Ä>??†2ƒ+Å ‚1Æà !Ç=?‡" [vip-emacs-p window-system device-type selected-device (tty stream) x-display-color-p device-class color] 2) (#$ . -9058)) (byte-code "ƒÁ\n!„Ã\n!Á\f!„Ã\f!Á‡" [vip-xemacs-p glyphp vip-replace-region-end-delimiter make-glyph vip-replace-region-start-delimiter] 2) #@20 nil (buffer local) (defvar vip-last-posn-in-replace-region nil (#$ . 9683)) (make-variable-buffer-local (quote vip-last-posn-in-replace-region)) #@20 nil (buffer local) (defvar vip-last-posn-while-in-insert-state nil (#$ . 9834)) (byte-code "ÀÁ!ˆÂÃÄÅ#ˆÂÁÄÅ#‡" [make-variable-buffer-local vip-last-posn-while-in-insert-state put vip-last-posn-in-replace-region permanent-local t] 4) #@17 (buffer local) (defvar vip-sitting-in-replace nil (#$ . 10072)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local vip-sitting-in-replace put permanent-local t] 4) #@17 (buffer local) (defvar vip-replace-chars-to-delete 0 (#$ . 10244)) (make-variable-buffer-local (quote vip-replace-chars-to-delete)) #@17 (buffer local) (defvar vip-replace-chars-deleted 0 (#$ . 10383)) (make-variable-buffer-local (quote vip-replace-chars-deleted)) #@33 The size of the insertion ring. (defvar vip-insertion-ring-size 14 (#$ . 10518)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÆÅ B‡" [boundp vip-insertion-ring nil current-load-list vip-temp-insertion-ring vip-last-inserted-string-from-insertion-ring ""] 2) #@31 The size of the command ring. (defvar vip-command-ring-size 14 (#$ . 10782)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B‡" [boundp vip-command-ring nil current-load-list vip-temp-command-ring] 2) #@20 nil (buffer local) (defvar vip-current-state (quote emacs-state) (#$ . 10978)) (make-variable-buffer-local (quote vip-current-state)) #@206 The key used to change states from emacs to Vi and back. In insert mode, this key also functions as Meta. Must be set in .vip file or prior to loading Viper. This setting cannot be changed interactively. (defvar vip-toggle-key "" (#$ . 11119)) #@117 Key used to ESC. Must be set in .vip file or prior to loading Viper. This setting cannot be changed interactively. (defvar vip-ESC-key "" (#$ . 11372)) #@444 *If true, multiple ESC in Vi mode will cause bell to ring. _ is then mapped to Meta. This is set to t on a windowing terminal and to 'twice on a dumb terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this enables cursor keys and is generally more convenient, as terminals usually don't have a convenient Meta key. Setting vip-no-multiple-ESC to nil will allow as many multiple ESC, as is allowed by the major mode in effect. (defvar vip-no-multiple-ESC t (#$ . -11533)) #@106 *If t then C-h is bound to help-command in insert mode, if nil then it is bound to delete-backward-char. (defvar vip-want-ctl-h-help nil (#$ . -12028)) #@17 (buffer local) (defvar vip-cted nil (#$ . 12186)) (make-variable-buffer-local (quote vip-cted)) #@20 nil (buffer local) (defvar vip-current-indent 0 (#$ . 12289)) (make-variable-buffer-local (quote vip-current-indent)) #@20 nil (buffer local) (defvar vip-preserve-indent nil (#$ . 12413)) (make-variable-buffer-local (quote vip-preserve-indent)) #@19 *Autoindent if t. (defconst vip-auto-indent nil (#$ . -12541)) #@27 *The shiftwidth variable. (defconst vip-shift-width 8 (#$ . -12610)) #@238 *If t, don't move point when repeating previous command. This is useful for doing repeated changes with the '.' key. The user can change this to nil, if she likes when the cursor moves to a new place after repeating previous Vi command. (defconst vip-keep-point-on-repeat t (#$ . -12686)) #@20 nil (buffer local) (defvar vip-insert-point nil (#$ . 12981)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local vip-insert-point put permanent-local t] 4) #@20 nil (buffer local) (defvar vip-pre-command-point nil (#$ . 13144)) (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅÆ!„ÇÆBÅÉ!„\"Ê ÉBLJ" [make-variable-buffer-local vip-pre-command-point put permanent-local t boundp vip-last-insertion nil current-load-list vip-last-replace-region ""] 4) #@20 nil (buffer local) (defvar vip-com-point nil (#$ . 13425)) (byte-code "ÀÁ!ˆÂÃ!„\fÄà BÂÆ!„ÄÆ BÂÇ!„&ÄÇ BÂÈ!„3ÄÈ BÂÉ!„@Ä É BÂÊ!„MÄ\nÊ BÂË!„ZÄ Ë BÂÌ!„gÍ\fÌ Bć" [make-variable-buffer-local vip-com-point boundp vip-d-com nil current-load-list vip-d-char vip-use-register vip-f-char vip-F-char vip-f-forward vip-f-offset vip-s-string ""] 2) #@52 String inserted at the beginning of quoted region. (defvar vip-quote-string "> " (#$ . 13794)) (byte-code "ÀÁ!„ÂÁ B‡" [boundp vip-s-forward nil current-load-list] 2) #@30 *If t, search ignores cases. (defconst vip-case-fold-search nil (#$ . -13971)) #@60 *If t, search is reg-exp search, otherwise vanilla search. (defconst vip-re-search t (#$ . -14056)) #@62 *If t then do regexp replace, if nil then do string replace. (defconst vip-re-query-replace t (#$ . -14162)) #@56 *If t, do regexp replace. nil means do string replace. (defconst vip-re-replace t (#$ . -14277)) #@69 *Ex-style: the commands l,h do not cross lines, etc. (buffer local) (defvar vip-ex-style-motion t (#$ . -14380)) (make-variable-buffer-local (quote vip-ex-style-motion)) #@219 *The keys ^H, ^? don't jump lines in insert, ESC moves cursor back, etc. Note: this doesn't preclude ^H and ^? from deleting characters by moving past the insertion point. This is a feature, not a bug. (buffer local) (defvar vip-ex-style-editing-in-insert t (#$ . -14557)) (make-variable-buffer-local (quote vip-ex-style-editing-in-insert)) #@155 *If t, DEL key will delete characters while moving the cursor backwards. If nil, the cursor will move backwards without deleting anything. (buffer local) (defvar vip-delete-backwards-in-replace nil (#$ . -14906)) (make-variable-buffer-local (quote vip-delete-backwards-in-replace)) #@34 *Key bound for buffer-searching. (defconst vip-buffer-search-char nil (#$ . -15194)) #@29 *If t, search wraps around. (defconst vip-search-wrap-around-t t (#$ . -15285)) #@164 *Ring of file and buffer names that are considered to be related to the current buffer. These buffers can be cycled through via :R and :P commands. (buffer local) (defvar vip-related-files-and-buffers-ring nil (#$ . -15372)) (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local vip-related-files-and-buffers-ring put permanent-local t] 4) #@20 nil (buffer local) (defvar vip-local-search-start-marker nil (#$ . 15716)) (byte-code "ÀÁ!ˆÂÃ!„ Ä à BÀ‡" [make-variable-buffer-local vip-local-search-start-marker boundp vip-search-start-marker make-marker current-load-list] 2) #@20 nil (buffer local) (defvar vip-search-overlay nil (#$ . 15953)) (make-variable-buffer-local (quote vip-search-overlay)) #@43 *Regexps for Headings. Used by [[ and ]]. (defvar vip-heading-start (concat "^\\s-*(\\s-*defun\\s-\\|" "^{\\s-*$\\|^[_a-zA-Z][^()]*[()].*{\\s-*$\\|" "^\\s-*class.*{\\|^\\s-*struct.*{\\|^\\s-*enum.*{\\|" "^\\\\[sb][a-z]*{.*}\\s-*$\\|" "^@node\\|@table\\|^@m?enu\\|^@itemize\\|^@if\\|" "^.+:-") (#$ . -16079)) #@48 *Regexps to end Headings/Sections. Used by []. (defvar vip-heading-end (concat "^}\\|" "^\\\\end{\\|" "^@end \\|" ")\n\n[ \n]*\\|" "\\.\\s-*$") (#$ . -16393)) #@20 nil (buffer local) (defvar vip-last-jump nil (#$ . 16559)) (make-variable-buffer-local (quote vip-last-jump)) #@20 nil (buffer local) (defvar vip-last-jump-ignore 0 (#$ . 16675)) (make-variable-buffer-local (quote vip-last-jump-ignore)) #@2  (defconst vip-SpuriousText "Spurious text after command" (#$ . 16802)) #@2  (defconst vip-BadExCommand "Not an editor command" (#$ . 16879)) #@2  (defconst vip-InvalidCommandArgument "Invalid command argument" (#$ . 16950)) #@2  (defconst vip-NoPrevSearch "No previous search string" (#$ . 17034)) #@2  (defconst vip-EmptyRegister "`%c': Nothing in this register" (#$ . 17109)) #@2  (defconst vip-InvalidRegister "`%c': Invalid register" (#$ . 17190)) #@2  (defconst vip-EmptyTextmarker "`%c': Text marker doesn't point anywhere" (#$ . 17265)) #@2  (defconst vip-InvalidTextmarker "`%c': Invalid text marker" (#$ . 17358)) #@2  (defconst vip-InvalidViCommand "Invalid command" (#$ . 17438)) #@2  (defconst vip-BadAddress "Ill-formed address" (#$ . 17507)) #@2  (defconst vip-FirstAddrExceedsSecond "First address exceeds second" (#$ . 17573)) #@2  (defconst vip-NoFileSpecified "No file specified" (#$ . 17661)) (byte-code "ÀÁ!„ ÂCÁ BÀÄ!„ÅÄ BÀÆ!„\"ÅÆ BÀÇ!„1CÇ BÀÉ!„>Å É BÀÊ!„KÅ\nÊ BÀË!„XÅ Ë BÌ Ň" [boundp vip-search-history "" current-load-list vip-replace1-history nil vip-replace2-history vip-quote-region-history vip-quote-string vip-ex-history vip-shell-history vip-last-shell-com t mark-even-if-inactive] 2) #@52 Whether Viper startup message should be inhibited. (defvar vip-inhibit-startup-message nil (#$ . 18061)) #@51 t means, arrange that vi-state will be a default. (defvar vip-always t (#$ . 18172)) #@77 Viper customisation file. This variable must be set _before_ loading Viper. (defvar vip-custom-file-name "~/.vip" (#$ . 18263)) #@51 Spell function used by #s command to spell. (defvar vip-spell-function (quote ispell-region) (#$ . 18397)) #@30 The tags file used by Viper. (defvar vip-tags-file-name "TAGS" (#$ . 18516)) #@75 If t, use vi-style editing in minibuffer. Should be set in `~/.vip' file. (defvar vip-vi-style-in-minibuffer t (#$ . 18599)) #@20 nil (buffer local) (defvar vip-minibuffer-overlay nil (#$ . 18730)) (byte-code "ÀÁ!ˆÂÃ!„\fÄà Bć" [make-variable-buffer-local vip-minibuffer-overlay boundp vip-minibuffer-exit-hook nil current-load-list] 2) #@84 Minor mode that forces Vi-style when the Minibuffer is in Vi state. (buffer local) (defvar vip-vi-minibuffer-minor-mode nil (#$ . 18946)) (make-variable-buffer-local (quote vip-vi-minibuffer-minor-mode)) #@88 Minor mode that forces Vi-style when the Minibuffer is in Insert state. (buffer local) (defvar vip-insert-minibuffer-minor-mode nil (#$ . 19156)) (byte-code "ÀÁ!ˆÂÄÀÅ!‡" [make-variable-buffer-local vip-insert-minibuffer-minor-mode nil next-line-add-newlines t require-final-newline] 2) #@49 Mode line tag identifying the Vi mode of Viper. (defconst vip-vi-state-id " " (#$ . 19450)) #@52 Mode line tag identifying the Emacs mode of Viper. (defconst vip-emacs-state-id " " (#$ . 19551)) #@53 Mode line tag identifying the Insert mode of Viper. (defconst vip-insert-state-id " " (#$ . 19658)) #@54 Mode line tag identifying the Replace mode of Viper. (defconst vip-replace-state-id " " (#$ . 19767)) (set-default (quote mode-line-buffer-identification) (quote (" %b"))) #@20 nil (buffer local) (defvar vip-mode-string vip-emacs-state-id (#$ . 19948)) (byte-code "ÀÁ!ˆÁ\n>„ÃÄ\nA\"À‡" [make-variable-buffer-local vip-mode-string global-mode-string append ("" vip-mode-string)] 3) #@60 *Hooks run just before the switch to Vi mode is completed. (defvar vip-vi-state-hook nil (#$ . -20160)) #@64 *Hooks run just before the switch to Insert mode is completed. (defvar vip-insert-state-hook nil (#$ . -20270)) #@65 *Hooks run just before the switch to Replace mode is completed. (defvar vip-replace-state-hook nil (#$ . -20388)) #@63 *Hooks run just before the switch to Emacs mode is completed. (defvar vip-emacs-state-hook nil (#$ . -20508)) #@37 Hooks run just after loading Viper. (defvar vip-load-hook nil (#$ . 20624)) (defalias 'vip-test-com-defun '(macro . #[(name) "À !Ã\nÄP!Ã\nÆP!È ÉÊËÌEDF+‡" [symbol-name name snm intern "-p" nm-p "s" nms defun (com) consp memq (if (< com 0) (- com) com)] 7])) (byte-code "ÀÁ\nBÁ‡" [(99 100 121 33 61 35 60 62 34) vip-prefix-commands current-load-list] 2) (defalias 'vip-prefix-command-p #[(com) "ÁWƒ [‚\f\n>:‡" [com 0 vip-prefix-commands] 2]) (byte-code "ÀÁ\nBÁ‡" [(99 100 121 33 61 60 62 114 82) vip-charpair-commands current-load-list] 2) (defalias 'vip-charpair-command-p #[(com) "ÁWƒ [‚\f\n>:‡" [com 0 vip-charpair-commands] 2]) #@19 Movement commands (defconst vip-movement-commands (quote (98 66 101 69 102 70 71 104 72 106 107 108 72 77 110 116 84 119 87 36 37 94 40 41 45 43 124 123 125 91 93 39 96 59 44 48 63 47)) (#$ . 21280)) (defalias 'vip-movement-command-p #[(com) "ÁWƒ [‚\f\n>:‡" [com 0 vip-movement-commands] 2]) (byte-code "ÀÁ\nBÁ‡" [(99 100 67 68 62 60) vip-dotable-commands current-load-list] 2) (defalias 'vip-dotable-command-p #[(com) "ÁWƒ [‚\f\n>:‡" [com 0 vip-dotable-commands] 2]) (byte-code "ÀÁ\nBÁ‡" [(99 67 103 113 83) vip-hash-cmds current-load-list] 2) (defalias 'vip-hash-cmd-p #[(com) "ÁWƒ [‚\f\n>:‡" [com 0 vip-hash-cmds] 2]) (byte-code "ÀÁ\nBÁ‡" [(100 121 89 68 112 80 120 88) vip-regsuffix-commands current-load-list] 2) (defalias 'vip-regsuffix-command-p #[(com) "ÁWƒ [‚\f\n>:‡" [com 0 vip-regsuffix-commands] 2]) (require (quote viper-keym)) (defalias 'vip-change-state #[(new-state) "ÀÁÂ\"ˆÃÁÂ\"ˆÀÄÅ\"ˆÃÄÅÆ#ˆÇÈÉ\"ˆÇÊË\"ˆ\fÍ=ƒSσwÉ ˆÐÑÒˆGÔVƒCÕÖ\"ˆƒwn„wØÙ!ˆ‚w\fÚ>ƒwÛ>ƒfÜÝ`\"ˆÜÞ`\"ˆßÈÉÆ#ˆßÊËÆ#ˆ\fà ˆá\f!ˆâ\f!ˆã ‡" [remove-hook post-command-hook vip-post-command-sentinel add-hook pre-command-hook vip-pre-command-sentinel t vip-remove-hook vip-post-command-hooks vip-insert-state-post-command-sentinel vip-pre-command-hooks vip-insert-state-pre-command-sentinel new-state vi-state vip-current-state (insert-state replace-state) conds (byte-code "À \n\"ˆ ƒÄ‚ŠÅ ˆ)ć" [vip-save-last-insertion vip-insert-point vip-last-posn-while-in-insert-state vip-began-as-replace nil vip-repeat-insert-command] 3) ((error (vip-message-conditions conds))) vip-last-insertion 0 vip-push-onto-ring vip-insertion-ring vip-ex-style-editing-in-insert backward-char 1 (insert-state replace-state) (emacs-state vi-state) vip-move-marker-locally vip-insert-point vip-last-posn-while-in-insert-state vip-add-hook vip-normalize-minor-mode-map-alist vip-adjust-keys-for vip-set-mode-vars-for vip-refresh-mode-line] 4]) #@62 Make necessary adjustments to keymaps before entering STATE. (defalias 'vip-adjust-keys-for #[(state) "Á>ƒH\nƒ$Ã\fÅÆ#ˆƒÃ\fÈÉ#ˆ‚$Ã\fÈÆ#ˆ?\n ƒ;Ã\fÌÍ#ˆÃÌÍ#‡Ã\fÌÏ#ˆÃÌÐ#‡? ƒYÃÌÍ#‡ÃÌÔ#‡" [state (insert-state replace-state) vip-auto-indent define-key vip-insert-basic-map " " vip-autoindent vip-want-emacs-keys-in-insert "\n" nil vip-insert-diehard-minor-mode vip-want-ctl-h-help "" help-command vip-replace-map vip-del-backward-char-in-insert vip-del-backward-char-in-replace vip-want-emacs-keys-in-vi vip-vi-diehard-minor-mode vip-vi-basic-map vip-backward-char] 4 (#$ . 23233)]) (defalias 'vip-normalize-minor-mode-map-alist #[nil "ÀÁ\nBÃ\fBÅBÇBÉ\nBËÌÍ\"A!ƒ*Í\"A‚,BÑBÓBÕB×BÙ\fBÚBÜBÞBàÌÍ!\"A!ƒcÍ!\"A‚eBâ#Bä%Bæ'Bè)Bê+Bì-BîÌÍ/\"A!ƒ•Í/\"A‚—B¯0\"‰0‡" [vip-append-filter-alist vip-vi-intercept-minor-mode vip-vi-intercept-map vip-vi-minibuffer-minor-mode vip-minibuffer-map vip-vi-local-user-minor-mode vip-vi-local-user-map vip-vi-kbd-minor-mode vip-vi-kbd-map vip-vi-global-user-minor-mode vip-vi-global-user-map vip-vi-state-modifier-minor-mode keymapp assoc major-mode vip-vi-state-modifier-alist vip-empty-keymap vip-vi-diehard-minor-mode vip-vi-diehard-map vip-vi-basic-minor-mode vip-vi-basic-map vip-insert-intercept-minor-mode vip-insert-intercept-map vip-replace-minor-mode vip-replace-map vip-insert-minibuffer-minor-mode vip-insert-local-user-minor-mode vip-insert-local-user-map vip-insert-kbd-minor-mode vip-insert-kbd-map vip-insert-global-user-minor-mode vip-insert-global-user-map vip-insert-state-modifier-minor-mode vip-insert-state-modifier-alist vip-insert-diehard-minor-mode vip-insert-diehard-map vip-insert-basic-minor-mode vip-insert-basic-map vip-emacs-intercept-minor-mode vip-emacs-intercept-map vip-emacs-local-user-minor-mode vip-emacs-local-user-map vip-emacs-kbd-minor-mode vip-emacs-kbd-map vip-emacs-global-user-minor-mode vip-emacs-global-user-map vip-emacs-state-modifier-minor-mode vip-emacs-state-modifier-alist minor-mode-map-alist] 27]) (defalias 'vip-refresh-mode-line #[nil "Á=ƒ\n\n‚'Ã=ƒ\f‚'Å=ƒ‚'Ç=…' Ê ‡" [vip-current-state emacs-state vip-emacs-state-id vi-state vip-vi-state-id replace-state vip-replace-state-id insert-state vip-insert-state-id vip-mode-string force-mode-line-update] 2]) #@32 Turn on Viper emulation of Vi. (defalias 'viper-mode #[nil "?… ƒÂ „Ä‹ˆÅÆ!ˆÇÈ!ˆÉ ‡" [noninteractive vip-first-time nil vip-inhibit-startup-message ((byte-code "À ˆÃÄ!ˆÅ ˆÆÇ!cˆebˆÈÉ!ƒ\"ÊÁË\fÀ$ˆÍp!‡" [t vip-inhibit-startup-message delete-other-windows switch-to-buffer "Viper Startup Message" erase-buffer substitute-command-keys "Viper Is a Package for Emacs Rebels.\nIt is also a VI Plan for Emacs Rescue and a venomous VI PERil.\n\nTechnically speaking, Viper is a Vi emulation package for GNU Emacs 19 and\nXEmacs 19. It supports virtually all of Vi and Ex functionality, extending\nand improving upon much of it.\n\n 1. Viper supports Vi at several levels. Level 1 is the closest to\n Vi, level 5 provides the most flexibility to depart from many Vi\n conventions.\n \n You will be asked to specify your user level in a following screen.\n \n If you select user level 1 then the keys ^X, ^C, ^Z, and ^G will\n behave as in VI, to smooth transition to Viper for the beginners. \n However, to use Emacs productively, you are advised to reach user\n level 3 or higher. \n \n If your user level is 2 or higher, ^X and ^C will invoke Emacs\n functions,as usual in Emacs; ^Z will toggle vi/emacs modes, and\n ^G will be the usual Emacs's keyboard-quit (something like ^C in VI).\n \n 2. Vi exit functions (e.g., :wq, ZZ) work on INDIVIDUAL files -- they\n do not cause Emacs to quit, except at user level 1 (a novice).\n 3. ^X^C EXITS EMACS.\n 4. Viper supports multiple undo: `u' will undo. Typing `.' will repeat\n undo. Another `u' changes direction.\n \n 6. Emacs Meta functions are invoked by typing `_' or `\\ ESC'.\n On a window system, the best way is to use the Meta-key.\n 7. Try \\[keyboard-quit] and \\[abort-recursive-edit] repeatedly,\n if something funny happens. This would abort the current editing\n command. \n \nYou can get more information on Viper by:\n\n a. Typing `:help' in Vi state\n b. Printing Viper manual, found in ./etc/viper.dvi\n c. Printing ViperCard, the Quick Reference, found in ./etc/viperCard.dvi\n \nThis startup message appears whenever you load Viper, unless you type `y' now." y-or-n-p "Inhibit Viper startup message? " vip-save-setting "Viper startup message inhibited" vip-custom-file-name kill-buffer] 5)) message " " vip-set-expert-level dont-change-unless vip-change-state-to-vi] 2 (#$ . 25570) nil]) (defalias (quote vip-mode) (quote viper-mode)) (defalias 'vip-exit-insert-state #[nil "À ‡" [vip-change-state-to-vi] 1 nil nil]) #@71 Sets Viper minor mode variables to put Viper's state STATE in effect. (defalias 'vip-set-mode-vars-for #[(state) "ÀÀÀÀÀÀÀÀÀ À\nÀ À\fÀ ÀÀÀÀÒÒÕÖ× \"?ÒÒÜ=ƒ€ÒÕÖ× \"ÒÕÖ× \"?ÒÒ†kÕÖ× \"? Ò\nÀÀÀÀÀÞƒÅÒß= ÕÖ× \"Ò\fÕÖ× \"? ÒÒ †°ÕÖ× \"?ÒÀÀÀÀÀ!ƒÏ\"‚Óãä !ƒ\f!ƒà\"‚äãä !å>„\fæ=ƒõ'‚\nÜ=ƒ(‚\né>…\n*+ÕÖ× \"…ì ‡" [nil vip-vi-minibuffer-minor-mode vip-insert-minibuffer-minor-mode vip-vi-intercept-minor-mode vip-insert-intercept-minor-mode vip-vi-local-user-minor-mode vip-vi-kbd-minor-mode vip-vi-global-user-minor-mode vip-vi-state-modifier-minor-mode vip-vi-diehard-minor-mode vip-vi-basic-minor-mode vip-replace-minor-mode vip-insert-local-user-minor-mode vip-insert-kbd-minor-mode vip-insert-global-user-minor-mode vip-insert-state-modifier-minor-mode vip-insert-diehard-minor-mode vip-insert-basic-minor-mode t vip-emacs-intercept-minor-mode vip-emacs-local-user-minor-mode string-match "*Minibuf-" buffer-name vip-emacs-kbd-minor-mode vip-emacs-global-user-minor-mode vip-emacs-state-modifier-minor-mode state vi-state vip-want-emacs-keys-in-vi (insert-state replace-state) replace-state vip-want-emacs-keys-in-insert vip-emacs-p window-system device-type selected-device (tty stream) emacs-state vip-minibuffer-emacs-face vip-minibuffer-vi-face (insert-state replace-state) vip-minibuffer-insert-face vip-minibuffer-current-face vip-set-minibuffer-overlay] 3 (#$ . 28180)]) #@27 Change Viper state to Vi. (defalias 'vip-change-state-to-vi #[nil "ƒÁÂà \"„Ä ‡ ƒÅÆ!ˆƒÈ ˆ ƒ/i\nVƒ/ ˆ Ì>ƒDŠÍyˆÎÏ!)ƒDÐ ˆÑ ˆƒOÓ ˆÔÕ!ˆÖ×!ƒbƒb×Ø!ˆÙÚÛ‡" [vip-first-time string-match "*Minibuf-" buffer-name viper-mode overwrite-mode nil abbrev-mode expand-abbrev auto-fill-function fill-column last-command (vip-autoindent vip-open-line vip-Open-line vip-replace-state-exit-cmd) 0 looking-at "^[ ]*$" indent-to-left-margin vip-add-newline-at-eob-if-necessary vip-undo-needs-adjustment vip-adjust-undo vip-change-state vi-state boundp iso-accents-mode -1 conds (byte-code "ÀÁ!‡" [run-hooks vip-vi-state-hook] 2) ((error (vip-message-conditions conds)))] 3 (#$ . 29669) nil]) #@31 Change Viper state to Insert. (defalias 'vip-change-state-to-insert #[nil "ÀÁ!ˆ\nƒÃÄ!ƒÄÅ!ˆÆÇȇ" [vip-change-state insert-state vip-automatic-iso-accents fboundp iso-accents-mode 1 conds (byte-code "ÀÁ!‡" [run-hooks vip-insert-state-hook] 2) ((error (vip-message-conditions conds)))] 3 (#$ . 30370) nil]) (defalias 'vip-downgrade-to-insert #[nil "À‰‡" [insert-state vip-current-state nil vip-replace-minor-mode] 2]) (put (quote vip-downgrade-to-insert) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-change-state-to-replace #[(&optional non-R-cmd) "ÀÁ!ˆ\nƒÃÄ!ƒÄÅ!ˆÆÇȈ ƒÊ ‡Ë ‡" [vip-change-state replace-state vip-automatic-iso-accents fboundp iso-accents-mode 1 conds (byte-code "ÀÁÂ\"‡" [run-hooks vip-insert-state-hook vip-replace-state-hook] 3) ((error (vip-message-conditions conds))) non-R-cmd vip-start-replace vip-start-R-mode] 3]) #@30 Change Viper state to Emacs. (defalias 'vip-change-state-to-emacs #[nil "ÀÁ!ˆ\nƒÃÄ!ƒÄÅ!ˆÆÇȇ" [vip-change-state emacs-state vip-automatic-iso-accents fboundp iso-accents-mode 1 conds (byte-code "ÀÁ!‡" [run-hooks vip-emacs-state-hook] 2) ((error (vip-message-conditions conds)))] 3 (#$ . 31258) nil]) #@193 Escape to Emacs state from Vi state for one Emacs command. ARG is used as the prefix value for the executed command. If EVENTS is a list of events, which become the beginning of the command. (defalias 'vip-escape-to-emacs #[(arg &optional events) "À \nÃ#‡" [vip-escape-to-state arg events emacs-state] 4 (#$ . 31570) "P"]) #@217 Escape from Emacs state to Vi state for one Vi 1-character command. This doesn't work with prefix arguments or most complex commands like cw, dw, etc. But it does work with some 2-character commands, like dd or dr. (defalias 'vip-escape-to-vi #[nil "ÀÁ‰Â#‡" [vip-escape-to-state nil vi-state] 4 (#$ . 31901) nil]) (defalias 'vip-escape-to-state #[(arg events state) "À‰‰Ä !ˆÆ ˆƒÈ!ˆÀÉʈ+Ä !‡" [nil prefix-arg key com vip-set-mode-vars-for state vip-normalize-minor-mode-map-alist events vip-set-unread-command-events (byte-code "ÀŽÁ\nƒ ÃÀ!‚ÃÀÄ\"‰!Ç!ƒ&Á!‚)È !ˆ\n\nƒH ‰ ‰GSœ)\fÍ\f!‚V ‰ ‰GSœ)‰\fÏ!ƒfÒ!ˆÀ‡" [nil key-binding vip-xemacs-p read-key-sequence t key com vectorp vip-set-mode-vars-for vip-current-state this-command seq last-command-event event-to-character last-command-char commandp arg prefix-arg command-execute] 5) ((quit (ding)) (error (beep 1))) vip-current-state] 3]) #@141 Execute FORM in Emacs, temporarily disabling Viper's minor modes. Similar to vip-escape-to-emacs, but accepts forms rather than keystrokes. (defalias 'vip-exec-form-in-emacs #[(form) "pÀÃÄ!ˆÅ!\npš„Š\nqˆÃ!ˆ)Ã!ˆ *‡" [nil result buff vip-set-mode-vars-for emacs-state eval form vip-current-state] 2 (#$ . 32840)]) #@391 Familiarize Viper with a minor mode defined in LOAD_FILE. Minor modes that have their own keymaps may overshadow Viper keymaps. This function is designed to make Viper aware of the packages that define such minor modes. Usage: (vip-harness-minor-mode load-file) LOAD-FILE is a name of the file where the specific minor mode is defined. Suffixes such as .el or .elc should be stripped. (defalias 'vip-harness-minor-mode #[(load-file) "À Â\"ˆÀ Ã\"‡" [vip-eval-after-load load-file (vip-normalize-minor-mode-map-alist) (setq-default minor-mode-map-alist minor-mode-map-alist)] 3 (#$ . 33169) "sEnter name of the load file: "]) #@528 Emulate ESC key in Emacs. Prevents multiple escape keystrokes if vip-no-multiple-ESC is true. In that case @ will be bound to ESC. If vip-no-multiple-ESC is 'twice double ESC would dings in vi-state. Other ESC sequences are emulated via the current Emacs's major mode keymap. This is more convenient on dumb terminals and in Emacs -nw, since this won't block functional keys such as up,down, etc. Meta key also will work. When vip-no-multiple-ESC is nil, ESC key behaves as in Emacs, any number of multiple escapes is allowed. (defalias 'vip-ESC #[(arg) "À\n„ Ä=ƒÅ ÆÈ D\"‚B\nÉ=ƒ@ Ä=ƒ@Å ‰Ê !Uƒ6Ì ‚BÆÈ D\"‚BÌ )‡" [nil char vip-no-multiple-ESC vip-current-state vi-state vip-read-char-exclusive vip-escape-to-emacs arg 27 twice string-to-char vip-ESC-key ding] 5 (#$ . 33805) "P"]) #@51 ESC key without checking for multiple keystrokes. (defalias 'vip-alternate-ESC #[(arg) "À Â\"‡" [vip-escape-to-emacs arg (27)] 3 (#$ . 34608) "P"]) (defalias 'vip-envelop-ESC-key #[nil "Á‰ÆÇ !  +ƒ\nË\f ƒ0Ï Ð¥\f\"‚7ÏÑ \f#*„öÂÓ !ˆÔÕÖNžA×!…TK)Â!)\fÑœÙ!ÆÇ !  +ƒ“ÓÛ\fÜ\"!ˆ ƒŠÞ‚ßàá!!‚òƒÂâ!ƒÂ㚃ÂÓäßàå!!!Û\fÜ\"\"!ˆ ßàá!!‚ò‰&¨†ê&9ƒØ&çN†ê&:…ê&@9…ê&@çN)ƒò(*‚Ó !ˆÔÕÖNžA×!…\fK)Â!‚ß !\f+‡" [last-input-event [nil] nil inhibit-quit keyseq event (27 (control \[) escape) vip-event-key key ESC-keys vip-fast-keyseq-timeout t nodisp val vip-xemacs-p sit-for 1000.0 0 minor-mode-map-alist vip-set-unread-command-events origname read-key-sequence ad-advice-info fboundp first-key event-modifiers key-mod subseq 1 vip-emacs-p "" vector character-to-event 27 key-press-event-p (meta) vconcat event-key obj event-symbol-elements last-command-event] 7]) (byte-code "ÀÁÂÃÄ$ˆÅÁÄ\"ˆÀÆÇÈÄ$ˆÅÆÄ\"ˆÀÉÊÈÄ$ˆÅÉÄ\"‡" [ad-add-advice read-key-sequence (vip-read-keyseq-ad nil t (advice lambda nil "Harness to work for Viper. This advice is harmless---don't worry!" (let (inhibit-quit event keyseq) (setq keyseq ad-do-it) (setq event (if vip-xemacs-p (elt keyseq 0) (elt (listify-key-sequence keyseq) 0))) (if (vip-ESC-event-p event) (let (unread-command-events) (vip-set-unread-command-events keyseq) (if (vip-fast-keysequence-p) (let ((vip-vi-global-user-minor-mode nil) (vip-vi-local-user-minor-mode nil) (vip-replace-minor-mode nil) (vip-insert-global-user-minor-mode nil) (vip-insert-local-user-minor-mode nil)) (setq keyseq ad-do-it)) (setq keyseq ad-do-it)))) keyseq))) around nil ad-activate-on describe-key (vip-read-keyseq-ad (protect activate) t (advice lambda nil "Force to read key via `read-key-sequence'." (interactive (list (vip-events-to-keys (read-key-sequence "Describe key: ")))))) before describe-key-briefly (vip-read-keyseq-ad (protect activate) t (advice lambda nil "Force to read key via `read-key-sequence'." (interactive (list (vip-events-to-keys (read-key-sequence "Describe key briefly: "))))))] 5) #@60 Function that implements ESC key in Viper emulation of Vi. (defalias 'vip-intercept-ESC-key #[nil "ÀÁ !†‰Ä=ƒ/ Æ=ƒÇ‚. È=ƒ#É‚. Ê=ƒ-Ë‚.ÌÍ !)‡" [key-binding vip-envelop-ESC-key (lambda nil (interactive) (error "")) cmd vip-intercept-ESC-key vip-current-state vi-state vip-ESC insert-state vip-exit-insert-state replace-state vip-replace-state-exit-cmd vip-change-state-to-vi call-interactively] 3 (#$ . 36713) nil]) (defalias 'vip-prefix-arg-value #[(event com) "À\n§ƒ+\nÃYƒ+\nÄXƒ+ §ƒ ‚ÅÆ_\nÃZ\\Ç ‰‚  ƒ: B\nÊ=ƒLË!ˆÇ ‰‚;Ì\n!)‡" [nil value event 48 57 0 10 vip-read-event-convert-to-char prefix-arg com 85 vip-describe-arg vip-set-unread-command-events] 4]) (defalias 'vip-prefix-arg-com #[(char value com) "À ƒ…\nÃÄÅÆÇÈÉÊËÌͯ\f>ƒ…ƒ5\nÐ>ƒ)ÑÒ!ˆ\nBÓ‰‚\nÔ>ƒG\nÕ Ó‰‚\nÊUƒYÕ Ö\\Õ ‚\nÍUƒ|Õ Ø!ƒq‚uÑÒ!ˆÕ )‚\nÚ ‚):„©B\nÝUƒ¥Þ!ˆÕ ‰‚”ß\n!‡@à>ƒÚ@AB\nËUƒÏá!ˆ‚Ôâ!ˆÓ‰*‡„ãã‚åÓ䚃øåæB!‡皃åèB!‡隃ê ‡뚃åìB!‡횃,åÇB!‡:åÈB!‡HåÆB!‡ðšƒVåÉB!‡ÑÒ!‡" [t cont char 99 100 121 33 60 62 61 35 114 82 34 vip-buffer-search-char com (35 34) error "" nil (33 61) read-char 128 reg vip-valid-register vip-use-register vip-read-char-exclusive value prefix-arg 85 vip-describe-arg vip-set-unread-command-events (114 82) vip-region vip-Region 1 (99 . 99) vip-line 67 (100 . 100) 68 (100 . 121) vip-yank-defun (121 . 121) 89 (60 . 60) (62 . 62) (33 . 33) (61 . 61)] 14]) (defalias 'vip-describe-arg #[(arg) "À‰Ã\f!Å\f!\n„! „ÆÇ!‚1ÆÈ \"‚1 „,ÆÉ\n\"‚1ÆÊ\n #*‡" [nil com val vip-P-val arg vip-getcom message "Value is nil, and command is nil" "Value is nil, and command is `%c'" "Value is `%d', and command is nil" "Value is `%d', and command is `%c'"] 4]) #@46 Begin numeric argument for the next command. (defalias 'vip-digit-argument #[(arg) "ƒÁÃ\f :… A\"‡" [vip-xemacs-p t zmacs-region-stays vip-prefix-arg-value last-command-char arg] 3 (#$ . 38521) "P"]) #@41 Accept a motion command as an argument. (defalias 'vip-command-argument #[(arg) "ÀÁˆà ‡" [nil (byte-code "À \n„\n \n:ƒ\n@‚ \n§ƒ\n‚ Ä !\n„(Â>\n:ƒ2\nA‚>\n§ƒ;Â>Ä !#‡" [vip-prefix-arg-com last-command-char arg nil error vip-InvalidCommandArgument] 5) ((quit (byte-code "ÀÂÃÀ\"‡" [nil vip-use-register signal quit] 3))) vip-deactivate-mark] 3 (#$ . 38732) "P"]) (defalias 'vip-p-val #[(arg) "„Á‡:ƒ@ƒ@šƒÁ‡@‡‡" [arg 1 (nil)] 2]) (put (quote vip-p-val) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-P-val #[(arg) ":ƒ@‡‡" [arg] 1]) (put (quote vip-P-val) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-getcom #[(arg) "„Á‡:ƒA‡Á‡" [arg nil] 1]) (put (quote vip-getcom) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-getCom #[(arg) "‰„\nÁ‚:ƒA‚Á)‰Úƒ!Ä‚6\nÅšƒ+Æ‚6\nÇšƒ5È‚6\n)‡" [arg nil com 99 67 100 68 121 89] 3]) (defalias 'vip-append-to-register #[(reg start end) "À  !;ƒ !‚Ã\f {P\"‡" [set-register reg get-register "" start end] 5]) (put (quote vip-append-to-register) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-exec-change #[(m-com com) "lƒ\n`U„dUƒÁcˆÂÃ!ˆ`Uƒ Ä ˆ ÆUƒ+Ç`\"‡È`\"‡" [vip-com-point " " backward-char 1 vip-forward-char-carefully com 99 vip-change vip-change-subr] 3]) (defalias 'vip-exec-Change #[(m-com com) "ŠÀ !ˆÂÃÄ!`\"ˆ ƒ_Æ Ç\"ƒ#È ÃÄ!`É$ˆ‚]Æ Ê\"ƒU —ÃÄ!` \f Î Ï !;ƒHÏ !‚IÐ\f {P\"ˆ+‚]ÉÑ \"ˆÉÃÄ!`|ˆ)ÓÔ!ˆÖUƒt× ‡Ø ‡" [set-mark vip-com-point vip-enlarge-region mark t vip-use-register vip-valid-register (letter digit) copy-to-register nil (Letter) end start reg set-register get-register "" error vip-InvalidRegister open-line 1 com 67 vip-change-mode-to-insert vip-yank-last-insertion] 5]) (defalias 'vip-exec-delete #[(m-com com) "ƒOÁÂ\"ƒÃ\f`Å$ˆ‚MÁÆ\"ƒE—\f` Ê Ë !;ƒ8Ë !‚9Ì{P\"ˆ+‚MÅÍ\"ˆÅÐ=…WÑÑ\f`\"ˆÐ…rl…rn?…rÔÕ!‡" [vip-use-register vip-valid-register (letter digit) copy-to-register vip-com-point nil (Letter) end start reg set-register get-register "" error vip-InvalidRegister last-command d-command kill-region this-command vip-ex-style-motion backward-char 1] 5]) (defalias 'vip-exec-Delete #[(m-com com) "ŠÀ !ˆÂÃÄ!`\"ˆ ƒ_Æ Ç\"ƒ#È ÃÄ!`É$ˆ‚]Æ Ê\"ƒU —ÃÄ!` \f Î Ï !;ƒHÏ !‚IÐ\f {P\"ˆ+‚]ÉÑ \"ˆÉÔ=…gÕÕÃÄ!`\"ˆ×=ƒzÔ)Ù ‡" [set-mark vip-com-point vip-enlarge-region mark t vip-use-register vip-valid-register (letter digit) copy-to-register nil (Letter) end start reg set-register get-register "" error vip-InvalidRegister last-command D-command kill-region m-com vip-line this-command back-to-indentation] 5]) (defalias 'vip-exec-yank #[(m-com com) "ƒOÁÂ\"ƒÃ\f`Å$ˆ‚MÁÆ\"ƒE—\f` Ê Ë !;ƒ8Ë !‚9Ì{P\"ˆ+‚MÅÍ\"ˆÅÅÐ\f`\"ˆ\fb‡" [vip-use-register vip-valid-register (letter digit) copy-to-register vip-com-point nil (Letter) end start reg set-register get-register "" error vip-InvalidRegister last-command copy-region-as-kill] 5]) (defalias 'vip-exec-Yank #[(m-com com) "ŠÀ !ˆÂÃÄ!`\"ˆ ƒ_Æ Ç\"ƒ#È ÃÄ!`É$ˆ‚]Æ Ê\"ƒU —ÃÄ!` \f Î Ï !;ƒHÏ !‚IÐ\f {P\"ˆ+‚]ÉÑ \"ˆÉÉÔÃÄ!`\"ˆ)Õ ˆ b‡" [set-mark vip-com-point vip-enlarge-region mark t vip-use-register vip-valid-register (letter digit) copy-to-register nil (Letter) end start reg set-register get-register "" error vip-InvalidRegister last-command copy-region-as-kill vip-deactivate-mark] 5]) (defalias 'vip-exec-bang #[(m-com com) "ŠÀ !ˆÂÃÄ!`\"ˆÅÃÄ!`ÇUƒ&ÈÉÊË @$‰\f‚(\fÄ$)‡" [set-mark vip-com-point vip-enlarge-region mark t shell-command-on-region com 33 vip-read-string-with-history "!" nil vip-shell-history vip-last-shell-com] 8]) (defalias 'vip-exec-equals #[(m-com com) "ŠÀ !ˆÂÃÄ!`\"ˆÃÄ!`VƒÅ ˆÆÃÄ!`Ç#)‡" [set-mark vip-com-point vip-enlarge-region mark t exchange-point-and-mark indent-region nil] 4]) (defalias 'vip-exec-shift #[(m-com com) "ŠÀ !ˆÂÃÄ!`\"ˆÃÄ!`VƒÅ ˆÆÃÄ!`ÈUƒ( ‚+ [#ˆ) b‡" [set-mark vip-com-point vip-enlarge-region mark t exchange-point-and-mark indent-rigidly com 62 vip-shift-width] 5]) (defalias 'vip-exec-dummy #[(m-com com) "À‡" [nil] 1]) (put (quote vip-exec-dummy) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-exec-buffer-search #[(m-com com) "`{ \fBÅ Æ#‡" [vip-com-point vip-s-string t vip-s-forward vip-search-history vip-search 1] 4]) (byte-code "ÀÁ!„ ÂÃÄ\"Á B ÆÇIˆ ÈÉIˆ ÊËIˆ ÌÍIˆ ÎÏIˆ ÐÑIˆ ÒÓIˆ ÔÕIˆ Ö×Iˆ Ø×Iˆ ÙÚI‡" [boundp vip-exec-array make-vector 128 nil current-load-list 99 vip-exec-change 67 vip-exec-Change 100 vip-exec-delete 68 vip-exec-Delete 121 vip-exec-yank 89 vip-exec-Yank 114 vip-exec-dummy 33 vip-exec-bang 60 vip-exec-shift 62 61 vip-exec-equals] 3) (defalias 'vip-execute-com #[(m-com val com) "\nÃVƒÄ\nÃZ!ˆ‚7 \nÆWƒ\n[‚\nH‰„/ÈÉ\n\n#ˆ‚6 \n\"ˆ)Ì\n!…WÍ \nÏÐÑE>ƒP\n[‚Q\n Ò‰¯!)‡" [vip-use-register reg com 128 vip-special-prefix-com vip-exec-array 0 fn error "%c: %s" vip-InvalidViCommand m-com vip-dotable-command-p vip-set-destructive-command val 99 67 33 nil] 8]) #@383 Re-execute last destructive command. Use the info in vip-d-com, which has the form (com val ch reg inserted-text command-keys), where `com' is the command to be re-executed, `val' is the argument to `com', `ch' is a flag for repeat, and `reg' is optional; if it exists, it is the name of the register for `com'. If the prefix argument, ARG, is non-nil, it is used instead of `val'. (defalias 'vip-repeat #[(arg) "`À Ä=ƒÅ ˆ‚„@‰:ƒ\"@‚$)È8É8\n \f \f„@A@\f „IÎÏ!ˆ\nÑ8ƒ`Ñ8Ñ8 \f B!ˆƒw\n`Wƒw\nbˆlƒƒn„ƒÕÖ!ˆ,ƒŒØ ˆ Ù=ƒ˜ÚÛ\"ˆÜ *‡" [vip-repeat vip-intermediate-command save-point last-command vip-undo vip-undo-more vip-d-com arg 2 3 reg com val m-com error "No previous command to repeat." vip-use-register 4 vip-last-insertion vip-d-char vip-keep-point-on-repeat backward-char 1 vip-undo-needs-adjustment vip-adjust-undo vip-display-current-destructive-command vip-push-onto-ring vip-command-ring vip-deactivate-mark] 6 (#$ . 43803) "P"]) #@384 Repeat a destructive command from history. Doesn't change vip-command-ring in any way, so `.' will work as before executing this command. This command is supposed to be bound to a two-character Vi macro where the second character is a digit 0 to 9. The digit indicates which history command to execute. `0' is equivalent to `.', `1' invokes the command before that, etc. (defalias 'vip-repeat-from-history #[nil "À\nƒÃÄ\nÅœ!!‚Ɖ  §ƒ.ÆXƒ.ÊX„<ÆƉ„<ËÌ!ˆÆWƒRÍÏ\" S‚<ÐÑ!ˆV…lÍÅ\"ˆT‚V,‡" [repeating-display-destructive-command vip-intermediate-command vip-this-kbd-macro string-to-number symbol-name 1 0 idx num vip-d-com 9 message "`vip-repeat-from-history' must be invoked as a Vi macro bound to `'" vip-special-ring-rotate1 vip-command-ring -1 vip-repeat nil] 5 (#$ . 44800) nil]) (defalias 'vip-special-prefix-com #[(char) "ÁUƒ `^ `]\"‡ÄUƒÅ `^ `]\"‡ÆUƒ,Ç È\"ˆÉ ‡ÊUƒ:Ç È\"ˆË ‡ÌUƒF `\"‡ÎÏ#‡" [char 99 downcase-region vip-com-point 67 upcase-region 103 push-mark t vip-global-execute 113 vip-quote-region 115 vip-spell-function error "#%c: %s" vip-InvalidViCommand] 4]) #@23 Undo previous change. (defalias 'vip-undo #[nil "ÀÁ!ˆÂ à \fʼn ÊÄË\"ˆÌ ˆÍÎ!ˆ†'†0bˆÏÐ!ˆƒ´Ò!ƒ´Óà Ô\"ˆÕŃbÏÙ¥\"‚iÏÐ#ˆ*bˆÕŃ…ÏÙ¥\"‚ŒÏÐ#ˆ*ÚZ!ÛVƒ­ÚZ!ÛVƒ­bˆ‚ºbˆ‚ºÓÔ\"ˆlƒÆn„ÆÜÛ!ˆ „ÏÝÔ!ˆ-Þ‰‡" [message "undo!" buffer-modified-p point-marker after-change-functions nil undo-end-posn undo-beg-posn before-undo-pt modified add-hook (lambda (beg end len) (setq undo-beg-posn beg undo-end-posn (or end beg))) undo-start undo-more 2 sit-for 0 vip-keep-point-on-undo pos-visible-in-window-p push-mark t 300 nodisp val vip-xemacs-p 1000.0 abs 1 backward-char set-buffer-modified-p vip-undo this-command] 5 (#$ . 45960) nil]) (defalias 'vip-undo-more #[nil "ÀÁ!ˆÂÃĈlƒn„ÅÆ!ˆÇ‰‡" [message "undo more!" nil (undo-more 1) ((error (byte-code "À ˆÁÂ!‡" [beep message "No further undo information in this buffer"] 2))) backward-char 1 vip-undo this-command] 3]) (defalias 'vip-adjust-undo #[nil "ÀÁ‰Á<…?>‰ƒ7 A Á¡ˆÈÁ\"È\"‰\n¤‰‚?ÈÁ\"‰+‡" [t nil tmp2 tmp inhibit-quit vip-undo-needs-adjustment buffer-undo-list vip-buffer-undo-list-mark delq] 4]) (defalias 'vip-set-complex-command-for-undo #[nil "<… ?…Â\fB‰)‡" [buffer-undo-list vip-undo-needs-adjustment t inhibit-quit vip-buffer-undo-list-mark] 2]) (defalias 'vip-display-current-destructive-command #[nil "À 8 8ÃÇÉÊËÌ !ÍQÎ\fÏÍÐ%#+‡" [4 vip-d-com 5 30 max-text-len keys text vip-display-current-destructive-command this-command message " `.' runs %s%s" "`" vip-array-to-string "'" vip-abbreviate-string " inserting `" " ......."] 9]) (defalias 'vip-set-destructive-command #[(list) "Á=†\nÄ ›ÅÆ ! ˆÇ È\"‡" [vip-intermediate-command vip-repeat list vip-d-com 5 vip-array-to-string this-command-keys vip-push-onto-ring vip-command-ring] 3]) #@128 Find previous destructive command in the history of destructive commands. With prefix argument, find next destructive command. (defalias 'vip-prev-destructive-command #[(next) "À‰ Ä=ƒÅ‚Æ! ƒ\"ÊË\"‚'ÊÌ\"‰ƒ/\n Ä *‡" [nil vip-intermediate-command cmd last-command vip-display-current-destructive-command repeating-display-destructive-command copy-list vip-command-ring vip-temp-command-ring next vip-special-ring-rotate1 1 -1 vip-d-com] 4 (#$ . 47784) "P"]) #@71 Find next destructive command in the history of destructive commands. (defalias 'vip-next-destructive-command #[nil "ÀÁ!‡" [vip-prev-destructive-command next] 2 (#$ . 48265) nil]) #@319 Cycle through insertion ring in the direction of older insertions. Undoes previous insertion and inserts new. With prefix argument, cycles in the direction of newer elements. In minibuffer, this command executes whatever the invocation key is bound to in the global map, instead of cycling through the insertion ring. (defalias 'vip-insert-prev-from-insertion-ring #[(arg) "À\nÃ=ƒ%Ä Æ=ƒÇÈ!ˆ‚+ ƒ+Ê G!ˆ‚+Ë\f! ÃÀBÐ ƒ@È‚AÒ\" À …N c)‡" [nil vip-intermediate-command last-command vip-insert-from-insertion-ring repeating-insertion-from-ring vip-current-state replace-state undo 1 vip-last-inserted-string-from-insertion-ring backward-delete-char copy-list vip-insertion-ring vip-temp-insertion-ring this-command buffer-undo-list vip-special-ring-rotate1 arg -1] 3 (#$ . 48452) "P"]) #@109 Cycle through insertion ring in the direction of older insertions. Undo previous insertion and inserts new. (defalias 'vip-insert-next-from-insertion-ring #[nil "ÀÁ!‡" [vip-insert-prev-from-insertion-ring next] 2 (#$ . 49264) nil]) (defalias 'vip-add-newline-at-eob-if-necessary #[nil "ŠÀˆm…n?… …ÂÃÄ \"?…Åc)‡" [nil require-final-newline string-match "*Minibuf-" buffer-name "\n"] 3]) (defalias 'vip-yank-defun #[nil "À ˆÁ`ÂÃ!\"‡" [mark-defun copy-region-as-kill mark t] 4]) (defalias 'vip-enlarge-region #[(beg end) "„  „\f WƒbˆÂ !ˆ‚# bˆÂ!ˆÃyˆÄ ˆmƒ1n„4Åyˆm„;Ãyˆ V…CÄ ‡" [beg end set-mark 0 exchange-point-and-mark 1] 2]) (defalias 'vip-quote-region #[nil "ÀÁÂÃ\f$Å`ÆÇ!\"ˆ`ÆÇ!VƒÈ ˆ\fcˆÉyˆÊyˆ`ÆÇ!W…:n…:\fcˆÉyˆÊyˆ‚\"‡" [vip-read-string-with-history "Quote string: " nil vip-quote-region-history vip-quote-string vip-enlarge-region mark t exchange-point-and-mark 0 1] 5]) (defalias 'vip-same-line #[(beg end) "À\nƒF ƒF\ndV† dV?…G \nVƒ*ÄÅ! Uƒ* Td^\n Vƒ=ÄÅ!\nUƒ=\nTd^Æ\n \"ÇX‚GÀ)‡" [nil selective-display beg end vip-line-pos start count-lines 1] 3]) (defalias 'vip-end-with-a-newline-p #[(string) "Á˜†‰‰GSœ)ÃU‡" [string "" seq 10] 3]) (defalias 'vip-tmp-insert-at-eob #[(msg) "d‰bˆ cˆÂÃ!ˆbˆ`d|)‡" [savemax msg sit-for 2] 3]) (defalias 'vip-set-minibuffer-style #[nil "ÀÁÂ\"‡" [add-hook minibuffer-setup-hook vip-minibuffer-setup-sentinel] 3]) (put (quote vip-set-minibuffer-style) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-minibuffer-setup-sentinel #[nil "ƒÁ‚ ‰ ˆÄÅÆ\")‡" [vip-vi-style-in-minibuffer vip-change-state-to-insert vip-change-state-to-emacs hook vip-add-hook vip-post-command-hooks vip-move-minibuffer-overlay] 4]) (defalias 'vip-exit-minibuffer #[nil "ÀÂÃ\f!!‰ƒÅ !‚Æ )‡" [nil command local-key-binding char-to-string last-command-char command-execute exit-minibuffer] 4 nil nil]) (defalias 'vip-set-search-face #[nil "ƒ ‚\fÂà !…€ƒ ‚Âà !Ä>?…€ÅÆ!„sÇÈÆ\"ˆÉÆ!ˆÊÆ!„pËÌD ƒDÎ ‚JÏà !Ð=…UÑÒÓ \">?)ƒfÔÆÌ\"ˆÕÆË\"ˆ‚pÖ×Æ\"ˆØÆÙ\"ˆÆÆBÛÆÜÝ#ˆÆ‡" [vip-emacs-p window-system device-type selected-device (tty stream) boundp vip-search-face add-to-list facemenu-unlisted-faces make-face face-differs-from-default-p "Black" "khaki" colors x-display-color-p device-class color nil mapcar vip-color-defined-p set-face-background set-face-foreground copy-face italic set-face-underline-p t current-load-list put variable-documentation "*Face used to flash out the search pattern."] 4]) (defalias 'vip-set-minibuffer-faces #[nil "ƒ ‚\fÂà !…çƒ ‚Âà !Ä>?…çÅÆ!„«ÇÈÆ\"ˆÉÆ!ˆÊÆ!„¨ ƒsÌÍDƒIÏ ‚OÐà !Ñ=…ZÒÓÔ\">?)ƒkÕÆÌ\"ˆÖÆÍ\"ˆ‚¨×ØÆ\"ˆ‚¨ÍÙDƒÏ ‚‡Ðà !Ñ=…’ÒÓÔ\">?)ƒ£ÕÆÙ\"ˆÖÆÍ\"ˆ‚¨×ÚÆ\"ˆÆÆBÜÆÝÞ#ˆÅß!„XÇÈß\"ˆÉß!ˆÊß!„U ƒ ÍÙDƒßÏ ‚åÐà !Ñ=…ðÒÓÔ\">?)ƒÕßÙ\"ˆÖßÍ\"ˆ‚U×Úß\"ˆ‚UÌÍDƒÏ ‚Ðà !Ñ=…(ÒÓÔ\">?)ƒ9ÕßÌ\"ˆÖßÍ\"ˆ‚>×Øß\"ˆß !ƒMâ !‚Sâ Òã#ˆ)ßßBÜßÝä#ˆÅå!„ÂÇÈå\"ˆÉå!ˆÊå!„¿ ƒ¶ÍæDƒŒÏ ‚’Ðà !Ñ=…ÒÓÔ\">?)ƒ®Õåæ\"ˆÖåÍ\"ˆ‚¿×çå\"ˆ‚¿×çå\"ˆèå!ˆå%åBÜåÝé#ˆÅê!„Ø*êBÜêÝë#ˆìê!‡" [vip-emacs-p window-system device-type selected-device (tty stream) boundp vip-minibuffer-emacs-face add-to-list facemenu-unlisted-faces make-face face-differs-from-default-p vip-vi-style-in-minibuffer "darkseagreen2" "Black" colors x-display-color-p device-class color nil mapcar vip-color-defined-p set-face-background set-face-foreground copy-face highlight "pink" italic current-load-list put variable-documentation "Face used in the Minibuffer when it is in Emacs state." vip-minibuffer-insert-face face vip-xemacs-p make-face-italic noerror "Face used in the Minibuffer when it is in Insert state." vip-minibuffer-vi-face "grey" bold invert-face "Face used in the Minibuffer when it is in Vi state." vip-minibuffer-current-face "\n(buffer local)" make-variable-buffer-local] 4]) (defalias 'vip-read-string-with-history #[(prompt &optional initial history-var default keymap) "ÀÁ‰Â† †Á \nƒ'ËÌ\n\"‚(Á Π \fRÂ%ÂÑÒ !Á Ó!@˜„Z Ó!BLˆÓ!@Ó!A@˜„sÓ!@Á˜ƒ|Ó!ALˆ Á˜ƒÕÖ×E>„Á‚  Á˜ƒŸ\n† Á‚  ,‡" [(lambda nil (if (stringp initial) (progn (or unread-command-events executing-kbd-macro (sit-for 840)) (erase-buffer) (insert initial))) (vip-minibuffer-setup-sentinel)) "" nil temp-msg padding val minibuffer-setup-hook keymap minibuffer-local-map initial default format "(default: %s) " vip-incomplete-ex-cmd read-from-minibuffer prompt history-var vip-array-to-string this-command-keys eval last-command vip-ex vip-command-argument t] 6]) (defalias 'vip-repeat-insert-command #[nil "@A@Á8 …- ÅV…-\f SÆlj‰¯ÈÇ!ˆ\f \nlj‰¯‰+‡" [vip-d-com 2 char val i-com 1 114 nil vip-repeat] 6]) #@22 Insert before point. (defalias 'vip-insert #[(arg) "À ˆ ‰„ ‚( :ƒ' @ƒ @Úƒ\"‚( @‚( ) ‰„3Ä‚> :ƒ= A‚>Ä)ÇÈÉĉ‰¯!ˆ ƒl‰\nËV…hÌ ˆ\nS‰\n‚W)‚nÍ *‡" [vip-set-complex-command-for-undo arg 1 (nil) nil com val vip-set-destructive-command vip-insert 114 count 0 vip-yank-last-insertion vip-change-state-to-insert] 8 (#$ . 53963) "P"]) #@21 Append after point. (defalias 'vip-append #[(arg) "À ˆ ‰„ ‚( :ƒ' @ƒ @Úƒ\"‚( @‚( ) ‰„3Ä‚> :ƒ= A‚>Ä)ÇÈÉĉ‰¯!ˆl„UÄuˆ Éšƒu‰\nËV…qÌ ˆ\nS‰\n‚`)‚wÍ *‡" [vip-set-complex-command-for-undo arg 1 (nil) nil com val vip-set-destructive-command vip-append 114 count 0 vip-yank-last-insertion vip-change-state-to-insert] 8 (#$ . 54321) "P"]) #@24 Append at end of line. (defalias 'vip-Append #[(arg) "À ˆ ‰„ ‚( :ƒ' @ƒ @Úƒ\"‚( @‚( ) ‰„3Ä‚> :ƒ= A‚>Ä)ÇÈÉĉ‰¯!ˆÄˆ Éšƒq‰\nËV…mÌ ˆ\nS‰\n‚\\)‚sÍ *‡" [vip-set-complex-command-for-undo arg 1 (nil) nil com val vip-set-destructive-command vip-Append 114 count 0 vip-yank-last-insertion vip-change-state-to-insert] 8 (#$ . 54687) "P"]) #@32 Insert before first non-white. (defalias 'vip-Insert #[(arg) "À ˆ ‰„ ‚( :ƒ' @ƒ @Úƒ\"‚( @‚( ) ‰„3Ä‚> :ƒ= A‚>Ä)ÇÈÉĉ‰¯!ˆÊ ˆ Éšƒq‰ ÌV…mÍ ˆ S‰ ‚\\)‚sÎ *‡" [vip-set-complex-command-for-undo arg 1 (nil) nil com val vip-set-destructive-command vip-Insert 114 back-to-indentation count 0 vip-yank-last-insertion vip-change-state-to-insert] 8 (#$ . 55053) "P"]) #@18 Open line below. (defalias 'vip-open-line #[(arg) "À ˆ ‰„ ‚( :ƒ' @ƒ @Úƒ\"‚( @‚( ) ‰„3Ä‚> :ƒ= A‚>Ä)ÇÈÉĉ‰¯!ˆÊ  Éšƒ…‰\fÍV…ĈÎÂ!ˆƒuÐ jˆÒ ˆ\fS‰\f‚])‚šÄˆÎÂ!ˆƒ˜Ð jˆÓ +‡" [vip-set-complex-command-for-undo arg 1 (nil) nil com val vip-set-destructive-command vip-open-line 114 current-indentation col count 0 newline vip-auto-indent t vip-cted vip-yank-last-insertion vip-change-state-to-insert] 8 (#$ . 55444) "P"]) #@18 Open line above. (defalias 'vip-Open-line #[(arg) "À ˆ ‰„ ‚( :ƒ' @ƒ @Úƒ\"‚( @‚( ) ‰„3Ä‚> :ƒ= A‚>Ä)ÇÈÉĉ‰¯!ˆÊ  Éšƒ…‰\fÍV…ÍyˆÎÂ!ˆƒuÐ jˆÒ ˆ\fS‰\f‚])‚šÍyˆÎÂ!ˆƒ˜Ð jˆÓ +‡" [vip-set-complex-command-for-undo arg 1 (nil) nil com val vip-set-destructive-command vip-Open-line 114 current-indentation col count 0 open-line vip-auto-indent t vip-cted vip-yank-last-insertion vip-change-state-to-insert] 8 (#$ . 55907) "P"]) #@21 Open line at point. (defalias 'vip-open-line-at-point #[(arg) "À ˆ ‰„ ‚( :ƒ' @ƒ @Úƒ\"‚( @‚( ) ‰„3Ä‚> :ƒ= A‚>Ä)ÇÈÉĉ‰¯!ˆ Éšƒr‰\nËV…nÌÂ!ˆÍ ˆ\nS‰\n‚Y)‚xÌÂ!ˆÎ *‡" [vip-set-complex-command-for-undo arg 1 (nil) nil com val vip-set-destructive-command vip-open-line-at-point 114 count 0 open-line vip-yank-last-insertion vip-change-state-to-insert] 8 (#$ . 56372) "P"]) #@24 Substitute characters. (defalias 'vip-substitute #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)‰„0Â;:ƒ:A‚;Ã)ÆÃÇ\"ˆ uˆ\fÈšƒVÉÊÇ!`\"ˆ‚]ËÊÇ!`\"ˆÌÍ Èɉ¯!*‡" [arg 1 (nil) nil com val push-mark t 114 vip-change-subr mark vip-change vip-set-destructive-command vip-substitute] 8 (#$ . 56773) "P"]) #@19 Substitute lines. (defalias 'vip-substitute-line #[(arg) "À ˆÁ\nÃB!‡" [vip-set-complex-command-for-undo vip-line arg 67] 3 (#$ . 57087) "p"]) (defalias 'vip-start-replace #[nil "ÀÀÃÃÆÇÈÀ#ˆÆÉÊÀ#ˆËÌÍÀ#ˆËÎÏÀ#ˆÐÑÒÔ\"\"ˆÆÕÖÀ#ˆÆ×ØÀ#‡" [t vip-began-as-replace vip-sitting-in-replace 0 vip-replace-chars-to-delete vip-replace-chars-deleted vip-add-hook vip-after-change-functions vip-replace-mode-spy-after vip-before-change-functions vip-replace-mode-spy-before add-hook after-change-functions vip-after-change-sentinel before-change-functions vip-before-change-sentinel vip-move-marker-locally vip-last-posn-in-replace-region vip-overlay-get vip-replace-overlay vip-start vip-post-command-hooks vip-replace-state-post-command-sentinel vip-pre-command-hooks vip-replace-state-pre-command-sentinel] 5]) (defalias 'vip-after-change-sentinel #[(beg end len) "‰… @\n \f#ˆ A‰„Å)‡" [vip-after-change-functions list beg end len nil] 5]) (defalias 'vip-before-change-sentinel #[(beg end) "‰… @\n \"ˆ A‰„Ä)‡" [vip-before-change-functions list beg end nil] 4]) (defalias 'vip-post-command-sentinel #[nil "ÀÁ!‡" [run-hooks vip-post-command-hooks] 2]) (put (quote vip-post-command-sentinel) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-pre-command-sentinel #[nil "ÀÁ!‡" [run-hooks vip-pre-command-hooks] 2]) (put (quote vip-pre-command-sentinel) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-insert-state-post-command-sentinel #[nil "Á>ƒ\nƒ`\nYƒà  Æ=…+¨…+\nV…+\nÈ“‡" [vip-current-state (insert-state replace-state) vip-insert-point point-marker vip-last-posn-while-in-insert-state this-command dabbrev-expand vip-pre-command-point nil] 3]) (put (quote vip-insert-state-post-command-sentinel) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-insert-state-pre-command-sentinel #[nil "Á=… !…Ä !…Ä !‰‡" [this-command dabbrev-expand markerp vip-insert-point marker-position vip-pre-command-point] 2]) (put (quote vip-insert-state-pre-command-sentinel) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-R-state-post-command-sentinel #[nil "À Â\"`Xƒ`À Ã\"XƒÄ !‡ÄÀ Æ\"!‡" [vip-overlay-get vip-replace-overlay vip-start vip-end vip-change-cursor-color vip-replace-overlay-cursor-color vip-cursor-color] 4]) (put (quote vip-R-state-post-command-sentinel) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-replace-state-pre-command-sentinel #[nil "Á>† !Ä>†ÅÆÈ\"!‡" [this-command (self-insert-command) vip-event-key last-command-event (up down left right (meta f) (meta b) (control n) (control p) (control f) (control b)) vip-change-cursor-color vip-overlay-get vip-replace-overlay vip-cursor-color] 4]) (put (quote vip-replace-state-pre-command-sentinel) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'vip-replace-state-post-command-sentinel #[nil "Á>„ ÂÃ\fÅ\"!ˆÇ=ƒ]Ã\fÈ\" Š\nbˆË\f!ˆÍ\fÍ\nÃ\fÈ\"Uƒ9Ï\n!ˆ)Ã\fÐ\"`X…[` X…[Ç=ƒVÂ!ˆÒ ‰\n)‡Ï\n!‡" [this-command (self-insert-command) vip-change-cursor-color vip-overlay-get vip-replace-overlay vip-cursor-color vip-current-state replace-state vip-end replace-boundary vip-last-posn-in-replace-region delete-char vip-replace-chars-to-delete 0 vip-replace-chars-deleted vip-finish-change vip-start vip-replace-overlay-cursor-color point-marker] 4]) (defalias 'vip-replace-mode-spy-before #[(beg end) " ZÂÃ\fÅ\"Z]ZÂÃ\fÆ\" Z]Z‰‡" [end beg 0 vip-overlay-get vip-replace-overlay vip-end vip-start vip-replace-chars-deleted] 6]) (defalias 'vip-replace-mode-spy-after #[(beg end length) "Á>ƒ ÂÄÅ`\"‡Æ‰‰‰ \n Ì Î\"^Šbˆi\nbˆi )Ì Ð\"XƒIÌ Î\"X„WÂUƒiÓ=ƒi \nZZ]Â]‚lÂÔ !Uƒ€ \\Z‚ƒÄÅ Ì Î\"Vƒ˜Ì Ð\"‚š Ô !†¥Ì Ð\"]\"ˆÂ Ì Î\" Z^]‰,‡" [vip-intermediate-command (repeating-insertion-from-ring) 0 vip-replace-chars-to-delete vip-move-marker-locally vip-last-posn-in-replace-region nil chars-to-delete real-end end-col beg-col end vip-overlay-get vip-replace-overlay vip-end beg vip-start length this-command dabbrev-expand marker-position vip-replace-chars-deleted] 6]) (defalias 'vip-finish-change #[(posn) "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÉÊ Ì\"!ˆÍŠ ƒDÊ Ð\"YƒDÊ Ñ\"WƒDÊ Ñ\"|ˆ)Ó=ƒRÔÍÖ×Í\"ˆÍ‰ƒg‚kÜÝ !ƒ†ƒx‚|ÜÝ !Þ>„†ƒ± ƒá‚â ƒ™ã‚šä%&ç &#ˆç %#*ˆ*ÉÊ Ì\"!ˆƒÄ‚ÈÜÝ !ƒåƒÕ‚ÙÜÝ !è>„åç éÍ#ˆê ˆë,!‡" [vip-remove-hook vip-after-change-functions vip-replace-mode-spy-after vip-before-change-functions vip-replace-mode-spy-before vip-post-command-hooks vip-replace-state-post-command-sentinel vip-pre-command-hooks vip-replace-state-pre-command-sentinel vip-change-cursor-color vip-overlay-get vip-replace-overlay vip-cursor-color nil vip-sitting-in-replace posn vip-start vip-end vip-current-state replace-state insert-state vip-replace-minor-mode vip-move-marker-locally vip-last-posn-in-replace-region after-glyph before-glyph vip-emacs-p window-system device-type selected-device (tty stream) vip-use-replace-region-delimiters vip-xemacs-p begin-glyph before-string end-glyph after-string after-name before-name vip-overlay-put (tty stream) face vip-refresh-mode-line vip-put-string-on-kill-ring vip-last-replace-region] 4]) (defalias 'vip-put-string-on-kill-ring #[(string) " B‰G\nVƒ\nS ›Ã¡ˆ ‰‡" [string kill-ring kill-ring-max nil kill-ring-yank-pointer] 3]) (defalias 'vip-finish-R-mode #[nil "ÀÁÂ\"ˆÀÃÄ\"ˆÅlj‡" [vip-remove-hook vip-post-command-hooks vip-R-state-post-command-sentinel vip-pre-command-hooks vip-replace-state-pre-command-sentinel insert-state vip-current-state nil vip-replace-minor-mode] 3]) (defalias 'vip-start-R-mode #[nil "ÀÁ!ˆÂÃÄÅ#ˆÂÆÇÅ#‡" [overwrite-mode 1 vip-add-hook vip-post-command-hooks vip-R-state-post-command-sentinel t vip-pre-command-hooks vip-replace-state-pre-command-sentinel] 4]) #@111 Binding for keys that cause Replace state to switch to Vi or to Insert. These keys are ESC, RET, and LineFeed (defalias 'vip-replace-state-exit-cmd #[nil "ƒ\nÁ ˆ‚ !ˆÄÇ=ƒÈ‚'É\n!ˆËÌÄ!!ÍÎψ)ĉƒ=‚AÔÕ !ƒ\\ƒN‚RÔÕ !Ö>„\\ƒ‡ƒeÙ‚fÚƒoÛ‚pÜß #ˆß #*ˆ*áâ ã\"!ˆƒš‚žÔÕ !…»ƒ«‚¯ÔÕ !ä>?…»ß åÄ#‡" [overwrite-mode vip-finish-R-mode vip-finish-change vip-last-posn-in-replace-region nil com this-command vip-intercept-ESC-key vip-exit-insert-state vip-set-unread-command-events last-input-char key-binding read-key-sequence conds (command-execute com) ((error (vip-message-conditions conds))) after-glyph before-glyph vip-emacs-p window-system device-type selected-device (tty stream) vip-use-replace-region-delimiters vip-xemacs-p begin-glyph before-string end-glyph after-string after-name before-name vip-overlay-put vip-replace-overlay vip-change-cursor-color vip-overlay-get vip-cursor-color (tty stream) face] 4 (#$ . 62976) nil]) #@23 Begin overwrite mode. (defalias 'vip-overwrite #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)‰„0Â;:ƒ:A‚;Ã)ÃÇÈÉɉ¯!ˆ ƒs\nGË\f!ˆ‰\fÍV…oÎ ˆ\fS‰\f‚^)‚‚ÈÐ ˆÑ`ÒÓ!\"ˆÔ +‡" [arg 1 (nil) nil len com val vip-set-destructive-command vip-overwrite 114 vip-last-insertion delete-char count 0 vip-yank-last-insertion last-command vip-set-complex-command-for-undo vip-set-replace-overlay vip-line-pos end vip-change-state-to-replace] 8 (#$ . 63970) "P"]) (defalias 'vip-line #[(arg) "@AÃÄ`\"ˆm„Å\nS!ˆÆ ˆÇÈ\n #ˆ*m…)o?…)Éy‡" [arg com val vip-move-marker-locally vip-com-point vip-next-line-carefully vip-add-newline-at-eob-if-necessary vip-execute-com vip-line -1] 4]) #@33 Yank ARG lines (in Vi's sense). (defalias 'vip-yank-line #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)Ä ÅB!)‡" [arg 1 (nil) val vip-line 89] 4 (#$ . 64668) "P"]) #@30 Execute command on a region. (defalias 'vip-region #[(arg) "‰:ƒ\f@‚ )‰„Á‚#:ƒ\"A‚#Á)ÄÅ`\"ˆÆ ˆÇÈ \n#*‡" [arg nil com val vip-move-marker-locally vip-com-point exchange-point-and-mark vip-execute-com vip-region] 5 (#$ . 64840) "P"]) #@30 Execute command on a Region. (defalias 'vip-Region #[(arg) "‰:ƒ\f@‚ )Á!ÄÅ`\"ˆÆ ˆÇÈ \n#*‡" [arg vip-getCom com val vip-move-marker-locally vip-com-point exchange-point-and-mark vip-execute-com vip-Region] 5 (#$ . 65093) "P"]) #@56 Replace the following ARG chars by the character read. (defalias 'vip-replace-char #[(arg) "lƒ\fnƒ\fÀÁ!ˆ\n‰„Â1\n:ƒ0\n@ƒ'\n@Äšƒ+Â1\n@‚1\n)\n‰„<Å‚G\n:ƒF\nA‚GÅ)È\"ˆlƒ^n„^ÃuˆÉÊËÅ\fů!*‡" [error "No character to replace here" arg 1 (nil) nil com val vip-replace-char-subr vip-set-destructive-command vip-replace-char 114 vip-d-char] 8 (#$ . 65333) "P"]) (defalias 'vip-replace-char-subr #[(com arg) "ÀÁ!…\nÃÇšƒ‚É  ƒ5\fÊ>ƒ5ÁË!ˆÌ\f!ˆÍÃ!ÎHÁÏ!ˆÐÒ\"ˆ\fÎVƒJ‚M[‰ÎVƒm\fÔ=ƒaÕcˆ‚d\fcˆS‰‚P)Ö!*‡" [boundp iso-accents-mode vip-automatic-iso-accents nil char take-care-of-iso-accents com 114 vip-d-char read-char (39 34 94 126) 1 vip-set-unread-command-events read-key-sequence 0 -1 delete-char arg t count 13 "\n" backward-char] 4]) #@105 Move point right ARG characters (left if ARG negative). On reaching end of line, stop and signal error. (defalias 'vip-forward-char #[(arg) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ ) ‰„6Æ‚A :ƒ@ A‚AÆ)ƒPÉÊ`\"ˆ ƒƒlƒdnƒdÌÍ!ˆ‚huˆƒuÎÏ#ˆl…“ÐÄ!ˆÌÍ!‚“uˆ…“ÎÏ#*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) nil com val vip-move-marker-locally vip-com-point vip-ex-style-motion error "" vip-execute-com vip-forward-char backward-char] 5 (#$ . 66127) "P"]) #@112 Move point left ARG characters (right if ARG negative). On reaching beginning of line, stop and signal error. (defalias 'vip-backward-char #[(arg) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ ) ‰„6Æ‚A :ƒ@ A‚AÆ)ƒPÉÊ`\"ˆ ƒtnƒ`ÌÍ!ˆ‚eÎ!ˆ……ÏÐ#‚…Î!ˆ……ÏÐ#*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) nil com val vip-move-marker-locally vip-com-point vip-ex-style-motion error "" backward-char vip-execute-com vip-backward-char] 5 (#$ . 66622) "P"]) (defalias 'vip-forward-char-carefully #[(&optional arg) "†Ád`\\Yƒu‡db‡" [arg 1] 3]) (defalias 'vip-backward-char-carefully #[(&optional arg) "†Áe`ZXƒÂ!‡eb‡" [arg 1 backward-char] 3]) (defalias 'vip-next-line-carefully #[(arg) "ÀÁ‡" [nil (next-line arg) ((error))] 3]) (defalias 'vip-skip-separators #[(forward) "ƒ5ÁÂÀ †Ä …ÅÆ!$ˆ)ÇÄ!…hÈuˆÁÂÀ †+Ä …2ÅÆ!$)‡ÁÂÉ †?Ä …FÅÊ!$ˆ)Ë ˆÇÄ!ƒfÁÂÉ †\\Ä …cÅÊ!$)‡Èu‡" [forward within-line vip-skip-syntax vip-SEP-char-class "\n" vip-line-pos end looking-at nil backward start backward-char] 6]) (defalias 'vip-forward-word-kernel #[(val) "ÁV…±Â ƒ<ÃÃ;„ÅÆÇÉ=ƒ!Å‚#\nÉ=ƒ1 \fP‚2\f#ˆ)ÌÍ!ˆ‚ª`f‰…VÏ=†VzÐÑ!Ó\">)ƒaÌÍ!ˆ‚ªÓ`f‰…}Ï=†}zÐÑ!Ó\">)†„Â\f!)„ªÉ=ƒšÔ QÓw‚¥ÖÔ\nQ×Ø!\"ˆÌÍ!ˆS‰‚‡" [val 0 vip-looking-at-alpha "_" addl-chars "" vip-skip-syntax forward vip-syntax-preference strict-vi vip-ALPHA-char-class vip-strict-ALPHA-chars vip-skip-separators t char 10 append vconcat vip-SEP-char-class nil "^" vip-strict-SEP-chars skip-syntax-forward vip-line-pos end] 6]) (defalias 'vip-fwd-skip #[(pat aux-pat lim) "ŠÀ \nÃ#)ƒ`Ä•UƒÄ”bˆ \nxˆ`\nU…!Æ ‡" [re-search-backward pat lim t 0 aux-pat vip-forward-char-carefully] 4]) #@15 Forward word. (defalias 'vip-forward-word #[(arg) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ ) ‰„6Æ‚A :ƒ@ A‚AÆ)ƒPÉÊ`\"ˆË!ˆ…•ÌÍD>ƒmÎÏÐ\n#ˆ‚ŽÑÒD>ƒ€ÎÏÓ\n#ˆ‚ŽÔ!ƒŽÎÏÓ\n#ˆÕÖ#*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) nil com val vip-move-marker-locally vip-com-point vip-forward-word-kernel 99 -99 vip-fwd-skip "\n[ ]*" " " 121 -121 "" vip-dotable-command-p vip-execute-com vip-forward-word] 5 (#$ . 68345) "P"]) #@45 Forward word delimited by white characters. (defalias 'vip-forward-Word #[(arg) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ ) ‰„6Æ‚A :ƒ@ A‚AÆ)ƒPÉÊ`\"ˆ‰ ÌVƒkÍÎ!ˆÏÁ!ˆ S‰ ‚U)…¬ÐÑD>ƒ„ÒÓÔ\n#ˆ‚¥ÕÖD>ƒ—ÒÓ×\n#ˆ‚¥Ø!ƒ¥ÒÓ×\n#ˆÙÚ#*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) nil com val vip-move-marker-locally vip-com-point count 0 vip-skip-nonseparators forward vip-skip-separators 99 -99 vip-fwd-skip "\n[ ]*" " " 121 -121 "" vip-dotable-command-p vip-execute-com vip-forward-Word] 5 (#$ . 68804) "P"]) (defalias 'vip-end-of-word-kernel #[nil "À ƒÁuˆ`f‰…\nÃ=†\nzÄÅ!Á\">)ƒ;ÁÈɆ0Ê…8ËÌ!$ˆ)Í ƒqÎÎ;„KÐÈÉÒ=ƒXЂZÒ=ƒiP‚k#ˆ)‚µÁ`f‰…‹\nÃ=†‹\nzÄÅ!Á\">)†“Í!)„µÒ=ƒ©ÕQÁw‚´×ÕQËÌ!\"ˆØ ‡" [vip-end-of-word-p nil char 10 append vconcat vip-SEP-char-class within-line vip-skip-syntax forward "\n" vip-line-pos end vip-looking-at-alpha "_" addl-chars "" vip-syntax-preference strict-vi vip-ALPHA-char-class vip-strict-ALPHA-chars "^" vip-strict-SEP-chars skip-syntax-forward vip-backward-char-carefully] 6]) (defalias 'vip-end-of-word-p #[nil "m†]ŠÀ ƒÁuˆÀ ?‚\\Á`f‰…, Ä=†, zÅÆ!Á\">)†3À\n!)?…\\ÁuˆÁ`f‰…T Ä=†T zÅÆ!Á\">)†[À\n!))‡" [vip-looking-at-alpha nil addl-chars char 10 append vconcat vip-SEP-char-class] 5]) #@36 Move point to end of current word. (defalias 'vip-end-of-word #[(arg &optional careful) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ ) ‰„6Æ‚A :ƒ@ A‚AÆ)ƒPÉÊ`\"ˆ‰ ÌVƒfÍ ˆ S‰ ‚U)…vÆuˆÎÏ#*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) nil com val vip-move-marker-locally vip-com-point count 0 vip-end-of-word-kernel vip-execute-com vip-end-of-word] 5 (#$ . 70123) "P"]) #@54 Forward to end of word delimited by white character. (defalias 'vip-end-of-Word #[(arg) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ ) ‰„6Æ‚A :ƒ@ A‚AÆ)ƒPÉÊ`\"ˆ‰ ÌVƒmÍ ˆÎÏ!ˆÐ ˆ S‰ ‚U)…}ÆuˆÑÒ#*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) nil com val vip-move-marker-locally vip-com-point count 0 vip-end-of-word-kernel vip-skip-nonseparators forward backward-char vip-execute-com vip-end-of-Word] 5 (#$ . 70523) "P"]) (defalias 'vip-backward-word-kernel #[(val) "ÁV…/ ˆÃ ƒ;ÄÄ;„ÆÇÈ Ê=ƒ$Æ‚&  Ê=ƒ4\f P‚5 #ˆ)‚(`f‰ …U Î=†U zÏÐ!Ò\">)ƒãÒuˆÓÒ!ˆÂ ˆÃ ƒ•ÄÄ;„qÆÇÈ Ê=ƒ~Æ‚€  Ê=ƒŽ\f P‚ #ˆ)‚(Ò`f‰ …± Î=†± zÏÐ!Ò\">)†¸Ã !)„Ý Ê=ƒÎÔ\fQÒx‚ÙÖÔ Q×Ø!\"ˆ‚(Òuˆ‚(Ò`f‰ …ÿ Î=†ÿ zÏÐ!Ò\">)†à !)„( Ê=ƒÔ\fQÒx‚'ÖÔ Q×Ø!\"ˆS‰‚‡" [val 0 backward-char vip-looking-at-alpha "_" addl-chars "" vip-skip-syntax backward vip-syntax-preference strict-vi vip-ALPHA-char-class vip-strict-ALPHA-chars char 10 append vconcat vip-SEP-char-class nil vip-skip-separators "^" vip-strict-SEP-chars skip-syntax-backward vip-line-pos start] 6]) #@16 Backward word. (defalias 'vip-backward-word #[(arg) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ ) ‰„6Æ‚A :ƒ@ A‚AÆ)ƒmÆ ŠÊ ˆËÌ!)‰ ƒ_Ê ˆÍÎ`\"ˆ ƒlÆuˆ)Ï!ˆ…~ÐÑ#*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) nil com val i backward-char looking-at "\n" vip-move-marker-locally vip-com-point vip-backward-word-kernel vip-execute-com vip-backward-word] 5 (#$ . 71632) "P"]) #@45 Backward word delimited by white character. (defalias 'vip-backward-Word #[(arg) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ ) ‰„6Æ‚A :ƒ@ A‚AÆ)ƒmÆ ŠÊ ˆËÌ!)‰ ƒ_Ê ˆÍÎ`\"ˆ ƒlÆuˆ)‰ÐVƒˆÑÆ!ˆÒÓ!ˆS‰‚r)…•ÔÕ#*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) nil com val i backward-char looking-at "\n" vip-move-marker-locally vip-com-point count 0 vip-skip-separators vip-skip-nonseparators backward vip-execute-com vip-backward-Word] 5 (#$ . 72032) "P"]) #@26 Go to beginning of line. (defalias 'vip-beginning-of-line #[(arg) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ ) ‰„6Æ‚A :ƒ@ A‚AÆ)ƒPÉÊ`\"ˆË!ˆ…aÌÍ#*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) nil com val vip-move-marker-locally vip-com-point beginning-of-line vip-execute-com vip-beginning-of-line] 5 (#$ . 72519) "P"]) #@49 Beginning of line at first non-white character. (defalias 'vip-bol-and-skip-white #[(arg) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ ) ‰„6Æ‚A :ƒ@ A‚AÆ)ƒPÉÊ`\"ˆËS!ˆ…bÌÍ#*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) nil com val vip-move-marker-locally vip-com-point forward-to-indentation vip-execute-com vip-bol-and-skip-white] 5 (#$ . 72869) "P"]) #@20 Go to end of line. (defalias 'vip-goto-eol #[(arg) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ ) ‰„6Æ‚A :ƒ@ A‚AÆ)ƒPÉÊ`\"ˆˆƒaËÌ#ˆ …zl…zn?…zÏš?…zÐÄ!*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) nil com val vip-move-marker-locally vip-com-point vip-execute-com vip-goto-eol vip-ex-style-motion vip-current-state insert-state backward-char] 5 (#$ . 73250) "P"]) #@21 Go to ARG's column. (defalias 'vip-goto-col #[(arg) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ ) ‰„6Æ‚A :ƒ@ A‚AÆ)ŠÆˆiTVƒVÉÊ!ˆ)ƒaËÌ`\"ˆÍyˆSuˆ…uÎÏ#*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) nil com val error "" vip-move-marker-locally vip-com-point 0 vip-execute-com vip-goto-col] 5 (#$ . 73648) "P"]) #@18 Go to next line. (defalias 'vip-next-line #[(arg) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ )Æ !ƒ=ÉÊ`\"ˆË!ˆ\fƒSlƒSn„SÍÄ!ˆË…bÏÐ#*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) vip-getCom com val vip-move-marker-locally vip-com-point next-line vip-ex-style-motion backward-char this-command vip-execute-com vip-next-line] 5 (#$ . 73988) "P"]) #@33 Next line at beginning of line. (defalias 'vip-next-line-at-bol #[(arg) "ƒÁŠÃˆmƒÄÅ!ˆ)‰„Ç‚?:ƒ=@ƒ3@Èšƒ7Ç‚?@‚?)É!\n \nƒRÌÍ`\"ˆ yˆÎ ˆ\n…eÏÐ \n#*‡" [vip-xemacs-p t zmacs-region-stays nil error "Last line in buffer" arg 1 (nil) vip-getCom com val vip-move-marker-locally vip-com-point back-to-indentation vip-execute-com vip-next-line-at-bol] 5 (#$ . 74362) "P"]) #@22 Go to previous line. (defalias 'vip-previous-line #[(arg) "ƒÁ ‰„Ä‚+ :ƒ* @ƒ! @Åšƒ%Ä‚+ @‚+ )Æ !ƒ=ÉÊ`\"ˆË!ˆ\fƒSlƒSn„SÍÄ!ˆË…bÏÐ#*‡" [vip-xemacs-p t zmacs-region-stays arg 1 (nil) vip-getCom com val vip-move-marker-locally vip-com-point previous-line vip-ex-style-motion backward-char this-command vip-execute-com vip-previous-line] 5 (#$ . 74766) "P"]) #@37 Previous line at beginning of line. (defalias 'vip-previous-line-at-bol #[(arg) "ƒÁŠÃyˆoƒÄÅ!ˆ)‰„Ç‚?:ƒ=@ƒ3@Èšƒ7Ç‚?@‚?)É!\n \nƒRÌÍ`\"ˆ [yˆÎ ˆ\n…fÏÐ \n#*‡" [vip-xemacs-p t zmacs-region-stays 0 error "First line in buffer" arg 1 (nil) vip-getCom com val vip-move-marker-locally vip-com-point back-to-indentation vip-execute-com vip-previous-line] 5 (#$ . 75156) "P"]) #@24 Change to end of line. (defalias 'vip-change-to-eol #[(arg) "À ÂB!‡" [vip-goto-eol arg 99] 3 (#$ . 75565) "P"]) #@14 Delete line. (defalias 'vip-kill-line #[(arg) "À ÂB!‡" [vip-goto-eol arg 100] 3 (#$ . 75683) "P"]) #@13 Erase line. (defalias 'vip-erase-line #[(arg) "À ÂB!‡" [vip-beginning-of-line arg 100] 3 (#$ . 75788) "P"]) #@53 Go to ARG's line. Without ARG go to end of buffer. (defalias 'vip-goto-line #[(arg) "‰:ƒ\f@‚ )Á!ÄÅ`\"ˆÆ ˆÇÈÉ\"ˆ „*dbˆ‚1ebˆ Syˆmƒ@nƒ@o„@ÊyˆË ˆ\nƒMÌÍ \n#ˆmƒ\\nƒ\\o„\\ÊyˆË *‡" [arg vip-getCom com val vip-move-marker-locally vip-com-point vip-deactivate-mark push-mark nil t -1 back-to-indentation vip-execute-com vip-goto-line] 5 (#$ . 75902) "P"]) (defalias 'vip-find-char #[(arg char forward offset) "À !„\nÂÃ!ˆ\fƒ ‚ [Ç=ƒ\"È 8‚&ÊË !Ì ŠŒ ÏVƒJlƒ@ÂÐ\"‚A`̈`}ˆ‚]nƒVÂÑ\"‚W`Ïyˆ`}ˆ ÏVƒjeTbˆ‚mdbˆÌÓÔ !ÌÏ $)ƒ‚` ‚‰ÂÕ #ˆ* ÏVƒŸƒ›×‚©Ø‚©ƒ¨Ù‚©Ï\\b+‡" [char-or-string-p char error "" forward arg vip-intermediate-command vip-repeat 5 vip-d-com vip-array-to-string this-command-keys nil point cmd 0 "Command `%s': At end of line" "Command `%s': At beginning of line" case-fold-search search-forward char-to-string "Command `%s': `%c' not found" offset -2 -1 1] 5]) #@216 Find char on the line. If called interactively read the char to find from the terminal, and if called from vip-repeat, the char last used is used. This behaviour is controlled by the sign of prefix numeric value. (defalias 'vip-find-char-forward #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)‰„0Â;:ƒ:A‚;Ã)‰ÆVƒQÇ É\nà ‚rÌ 8;ƒhÌ 8‰‰GSœ)‚j‰ [\fƒ{ÐÑ`\"ˆÒ ‰„‡Á‚¢:ƒ¡@ƒ˜@šƒœÁ‚¢@‚¢)ÆVƒ­‚¯ÉÃ$ˆ [\f…ÆÃuˆÓÔ \f#*‡" [arg 1 (nil) nil com val 0 read-char vip-f-char t vip-f-forward vip-f-offset 5 vip-d-com seq vip-F-char vip-move-marker-locally vip-com-point vip-find-char vip-execute-com vip-find-char-forward] 6 (#$ . 76824) "P"]) #@36 Go up to char ARG forward on line. (defalias 'vip-goto-char-forward #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)‰„0Â;:ƒ:A‚;Ã)‰ÆVƒQÇ É\nÉ ‚rÌ 8;ƒhÌ 8‰‰GSœ)‚j‰ [\fƒ{ÐÑ`\"ˆÒ ‰„‡Á‚¢:ƒ¡@ƒ˜@šƒœÁ‚¢@‚¢)ÆVƒ­‚¯ɉ$ˆ [\f…ÆÃuˆÓÔ \f#*‡" [arg 1 (nil) nil com val 0 read-char vip-f-char t vip-f-forward vip-f-offset 5 vip-d-com seq vip-F-char vip-move-marker-locally vip-com-point vip-find-char vip-execute-com vip-goto-char-forward] 6 (#$ . 77511) "P"]) #@33 Find char ARG on line backward. (defalias 'vip-find-char-backward #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)‰„0Â;:ƒ:A‚;Ã)‰ÆVƒQÇ Ã Ã\n‚rË\f8;ƒhË\f8‰ ‰GSœ)‚j‰ [\fƒ{ÏÐ`\"ˆÑ ‰„‡Á‚¢:ƒ¡@ƒ˜@šƒœÁ‚¢@‚¢)ÆVƒ­‚¯É$ˆ [\f…ÃÒÓ \f#*‡" [arg 1 (nil) nil com val 0 read-char vip-f-char vip-f-forward vip-f-offset 5 vip-d-com seq vip-F-char vip-move-marker-locally vip-com-point vip-find-char vip-execute-com vip-find-char-backward] 6 (#$ . 78018) "P"]) #@37 Go up to char ARG backward on line. (defalias 'vip-goto-char-backward #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)‰„0Â;:ƒ:A‚;Ã)‰ÆVƒQÇ Ã Ê ‚rÌ 8;ƒhÌ 8‰‰GSœ)‚j‰ [\fƒ{ÐÑ`\"ˆÒ ‰„‡Á‚¢:ƒ¡@ƒ˜@šƒœÁ‚¢@‚¢)ÆVƒ­‚¯ÃÊ$ˆ [\f…ÃÓÔ \f#*‡" [arg 1 (nil) nil com val 0 read-char vip-f-char vip-f-forward t vip-f-offset 5 vip-d-com seq vip-F-char vip-move-marker-locally vip-com-point vip-find-char vip-execute-com vip-goto-char-backward] 6 (#$ . 78521) "P"]) #@31 Repeat previous find command. (defalias 'vip-repeat-find #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)‰„0Â;:ƒ:A‚;Ã)Æ ˆ\fƒJÇÈ`\"ˆÉ \n \f$ˆ\f…e ƒ`ÃuˆÍÎ \f#*‡" [arg 1 (nil) nil com val vip-deactivate-mark vip-move-marker-locally vip-com-point vip-find-char vip-f-char vip-f-forward vip-f-offset vip-execute-com vip-repeat-find] 6 (#$ . 79027) "P"]) #@57 Repeat previous find command in the opposite direction. (defalias 'vip-repeat-find-opposite #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)‰„0Â;:ƒ:A‚;Ã)Æ ˆ\fƒJÇÈ`\"ˆÉ \n ?\f$ˆ\f…f ƒaÃuˆÍÎ \f#*‡" [arg 1 (nil) nil com val vip-deactivate-mark vip-move-marker-locally vip-com-point vip-find-char vip-f-char vip-f-forward vip-f-offset vip-execute-com vip-repeat-find-opposite] 6 (#$ . 79400) "P"]) #@25 Switch to other window. (defalias 'vip-other-window #[(arg) "À !ˆ\nÃ=?†Äp!؆Æ ‡" [other-window arg vip-current-state emacs-state buffer-name " *Minibuf-1*" vip-change-state-to-vi] 2 (#$ . 79818) "p"]) #@25 Go to home window line. (defalias 'vip-window-top #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)Ã!\fƒ4ÆÇ`\"ˆÈÉÊ\"ˆË S!ˆmƒMnƒMo„MÌyˆÍ ˆ\fƒZÎÏ \f#ˆmƒinƒio„iÌyˆÍ *‡" [arg 1 (nil) vip-getCom com val vip-move-marker-locally vip-com-point push-mark nil t move-to-window-line -1 back-to-indentation vip-execute-com vip-window-top] 5 (#$ . 80030) "P"]) #@27 Go to middle window line. (defalias 'vip-window-middle #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)Ã!ă9ÈÉ`\"ˆÊÄË\"ˆÌd!„SÍÎ SÏ¥S\\!ˆ‚cÐÑ d\"Í Ï¥S\\!ˆmƒrnƒro„rÒyˆÓ ˆƒ‚ÔÕ#ˆmƒ‘nƒ‘o„‘ÒyˆÓ +‡" [arg 1 (nil) vip-getCom nil lines com val vip-move-marker-locally vip-com-point push-mark t pos-visible-in-window-p move-to-window-line window-height 2 count-lines window-start -1 back-to-indentation vip-execute-com vip-window-middle] 5 (#$ . 80394) "P"]) #@25 Go to last window line. (defalias 'vip-window-bottom #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)Ã!\fƒ4ÆÇ`\"ˆÈÉÊ\"ˆË [!ˆmƒMnƒMo„MÌyˆÍ ˆ\fƒZÎÏ \f#ˆmƒinƒio„iÌyˆÍ *‡" [arg 1 (nil) vip-getCom com val vip-move-marker-locally vip-com-point push-mark nil t move-to-window-line -1 back-to-indentation vip-execute-com vip-window-bottom] 5 (#$ . 80877) "P"]) #@36 Put current line on the home line. (defalias 'vip-line-to-top #[(arg) "À S!‡" [recenter arg] 2 (#$ . 81247) "p"]) #@38 Put current line on the middle line. (defalias 'vip-line-to-middle #[(arg) "À S SÃ¥\\!‡" [recenter arg window-height 2] 4 (#$ . 81367) "p"]) #@36 Put current line on the last line. (defalias 'vip-line-to-bottom #[(arg) "ÀÁ \nTZ!‡" [recenter window-height arg] 3 (#$ . 81515) "p"]) #@33 Go to the matching parenthesis. (defalias 'vip-paren-match #[(arg) "‰„\nÁ‚:ƒA‚Á)§ƒHÃV„(ÄWƒ.ÅÆ!‚»dÇVƒ<dÈ¥_‚Ad_È¥bˆÉ ‚»Á\nlƒVn„VËuˆŠÁˆ`\n)ÌÍ\nÎ#ƒmÏ ˆ‚qÅÐ!ˆ)ÑÒ!ƒ–\nƒÓÔ`\"ˆÕÄ!ˆ\nƒ‘Ö×Á\n#‚»Ï ‚»ÑØ!ƒ¸Áuˆ\nƒ¨ÓÔ`\"ˆÙÄ!ˆ\n…»Ö×Á\n#‚»ÅÚ!)‡" [arg nil com 99 1 error "Prefix must be between 1 and 99" 80000 100 back-to-indentation lim -1 re-search-forward "[][(){}]" t backward-char "No matching character on line" looking-at "[([{]" vip-move-marker-locally vip-com-point forward-sexp vip-execute-com vip-paren-match "[])}]" backward-sexp ""] 5 (#$ . 81656) "P"]) #@19 Forward sentence. (defalias 'vip-forward-sentence #[(arg) "ÀÁÂ\"ˆ ‰„Ä‚* :ƒ) @ƒ @Åšƒ$Ä‚* @‚* ) ‰„5Á‚@ :ƒ? A‚@Á)ƒOÈÉ`\"ˆÊ!ˆ…_ËÌÁ#*‡" [push-mark nil t arg 1 (nil) com val vip-move-marker-locally vip-com-point forward-sentence vip-execute-com vip-forward-sentence] 5 (#$ . 82254) "P"]) #@20 Backward sentence. (defalias 'vip-backward-sentence #[(arg) "ÀÁÂ\"ˆ ‰„Ä‚* :ƒ) @ƒ @Åšƒ$Ä‚* @‚* ) ‰„5Á‚@ :ƒ? A‚@Á)ƒOÈÉ`\"ˆÊ!ˆ…_ËÌÁ#*‡" [push-mark nil t arg 1 (nil) com val vip-move-marker-locally vip-com-point backward-sentence vip-execute-com vip-backward-sentence] 5 (#$ . 82571) "P"]) #@20 Forward paragraph. (defalias 'vip-forward-paragraph #[(arg) "ÀÁÂ\"ˆ ‰„Ä‚* :ƒ) @ƒ @Åšƒ$Ä‚* @‚* )Æ !ƒ<ÉÊ`\"ˆË!ˆ…LÌÍÁ#*‡" [push-mark nil t arg 1 (nil) vip-getCom com val vip-move-marker-locally vip-com-point forward-paragraph vip-execute-com vip-forward-paragraph] 5 (#$ . 82892) "P"]) #@21 Backward paragraph. (defalias 'vip-backward-paragraph #[(arg) "ÀÁÂ\"ˆ ‰„Ä‚* :ƒ) @ƒ @Åšƒ$Ä‚* @‚* )Æ !ƒ<ÉÊ`\"ˆË!ˆ…LÌÍÁ#*‡" [push-mark nil t arg 1 (nil) vip-getCom com val vip-move-marker-locally vip-com-point backward-paragraph vip-execute-com vip-backward-paragraph] 5 (#$ . 83205) "P"]) (defalias 'vip-prev-heading #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)Ã!\fƒ4ÆÇ`\"ˆÈ ÊË $ˆÌ”bˆ\f…IÍÎÊ\f#*‡" [arg 1 (nil) vip-getCom com val vip-move-marker-locally vip-com-point re-search-backward vip-heading-start nil t 0 vip-execute-com vip-prev-heading] 6 nil "P"]) (defalias 'vip-heading-end #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)Ã!\fƒ4ÆÇ`\"ˆÈ ÊË $ˆÌ”bˆ\f…IÍÉÊ\f#*‡" [arg 1 (nil) vip-getCom com val vip-move-marker-locally vip-com-point re-search-forward vip-heading-end nil t 0 vip-execute-com] 6 nil "P"]) (defalias 'vip-next-heading #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)Ã!\fƒ4ÆÇ`\"ˆÈˆÉ\nÈË $ˆÌ”bˆ\f…LÍÎÈ\f#*‡" [arg 1 (nil) vip-getCom com val vip-move-marker-locally vip-com-point nil re-search-forward vip-heading-start t 0 vip-execute-com vip-next-heading] 6 nil "P"]) (byte-code "ÀÀ‡" [1 scroll-step] 1) #@24 Scroll to next screen. (defalias 'vip-scroll #[(arg) "ÁVƒÁV…% ˆS‰‚ÁV…%à ˆT‚‡" [arg 0 scroll-up scroll-down] 3 (#$ . 84381) "p"]) #@28 Scroll to previous screen. (defalias 'vip-scroll-back #[(arg) "À [!‡" [vip-scroll arg] 2 (#$ . 84532) "p"]) #@24 Pull down half screen. (defalias 'vip-scroll-down #[(arg) "ÀÁ‡" [nil (byte-code "„ Á å!‡Á!‡" [arg scroll-down window-height 2] 3) ((error (byte-code "ÀÁ!ˆÂÃ!ˆeb‡" [beep 1 message "Beginning of buffer"] 2)))] 3 (#$ . 84646) "P"]) #@21 Scroll up one line. (defalias 'vip-scroll-down-one #[(arg) "À !‡" [scroll-down arg] 2 (#$ . 84888) "p"]) #@22 Pull up half screen. (defalias 'vip-scroll-up #[(arg) "ÀÁ‡" [nil (byte-code "„ Á å!‡Á!‡" [arg scroll-up window-height 2] 3) ((error (byte-code "ÀÁ!ˆÂÃ!ˆdb‡" [beep 1 message "End of buffer"] 2)))] 3 (#$ . 84999) "P"]) #@23 Scroll down one line. (defalias 'vip-scroll-up-one #[(arg) "À !‡" [scroll-up arg] 2 (#$ . 85229) "p"]) (defalias 'vip-if-string #[(prompt) "À Âà @$‰Ř?…\f‰)‡" [vip-read-string-with-history prompt nil vip-search-history s "" vip-s-string] 6]) #@619 Toggle the value of vip-case-fold-search/vip-re-search. Without prefix argument, will ask which search style to toggle. With prefix arg 1,toggles vip-case-fold-search; with arg 2 toggles vip-re-search. Although this function is bound to \[vip-toggle-search-style], the most convenient way to use it is to bind `//' to the macro `1 M-x vip-toggle-search-style' and `///' to `2 M-x vip-toggle-search-style'. In this way, hitting `//' quickly will toggle case-fold-search and hitting `/' three times witth toggle regexp search. Macros are more convenient in this case because they don't affect the Emacs binding of `/'. (defalias 'vip-toggle-search-style #[(arg) "À\nÃ=„(\n„;ÄÅƃȂɃ\"É‚#È#!ƒ;?‰ƒ6Ê‚vË‚v\nÌ=„a\n„tÄÅÆ ƒQ΂RÏ ƒ[Ï‚\\Î#!ƒt ?‰ ƒoЂvÑ‚vÒÓ Ô\")‡" [nil msg arg 1 y-or-n-p format "Search style: '%s'. Want '%s'? " vip-case-fold-search "case-insensitive" "case-sensitive" "Search becomes case-insensitive" "Search becomes case-sensitive" 2 vip-re-search "regexp-search" "vanilla-search" "Search becomes regexp-style" "Search becomes vanilla-style" "Search style remains unchanged" prin1 t] 6 (#$ . 85483) "P"]) #@124 Search a string forward. ARG is used to find the ARG's occurrence of the string. Null string will repeat previous search. (defalias 'vip-search-forward #[(arg) "‰:ƒ\f@‚ )‰„Á‚#:ƒ\"A‚#Á)\nÆÈÉ!ˆ \nšƒCÊ !ƒCÌ !„GÍ  Î\nÆ #ˆ\f…]ÏÐÑÆ!\"ˆÒÓ \f#+‡" [arg nil vip-s-string old-str com val t vip-s-forward vip-if-string "/" markerp vip-local-search-start-marker marker-buffer point-marker vip-search vip-move-marker-locally vip-com-point mark vip-execute-com vip-search-next] 5 (#$ . 86646) "P"]) #@125 Search a string backward. ARG is used to find the ARG's occurrence of the string. Null string will repeat previous search. (defalias 'vip-search-backward #[(arg) "‰:ƒ\f@‚ )‰„Á‚#:ƒ\"A‚#Á)\nÁÇÈ!ˆ \nšƒCÉ\n!ƒCË\n!„GÌ \nÍ\nÁ #ˆ\f…]ÎÏÐÑ!\"ˆÒÓ \f#+‡" [arg nil vip-s-string old-str com val vip-s-forward vip-if-string "?" markerp vip-local-search-start-marker marker-buffer point-marker vip-search vip-move-marker-locally vip-com-point mark t vip-execute-com vip-search-next] 5 (#$ . 87165) "P"]) (defalias 'vip-search #[(string forward arg &optional no-offset init-point fail-if-not-found) "Áš?…l\n‰„Â,\n:ƒ+\n@ƒ\"\n@Äšƒ&Â,\n@‚,\n)\n‰„7Å‚B\n:ƒA\nA‚BÅ)?†N` \n \f Î ˆƒgÅÐÑ‚kÅÒÓ-‡" [string "" arg 1 (nil) nil no-offset vip-case-fold-search init-point start-point case-fold-search offset com val vip-deactivate-mark forward (byte-code "ƒÁ ˆ\nƒÃ\fʼn$ˆÇ\f!ˆ‚&È\fʼn$ˆÉ\f!ˆ\n„.Ë ˆ\f`š?…;Í\fÎ\"‡" [offset vip-forward-char-carefully vip-re-search re-search-forward string nil val re-search-backward search-forward search-backward executing-kbd-macro vip-flash-search-pattern start-point push-mark t] 5) ((search-failed (byte-code "„+ ƒ+ÂÃ!ˆebˆÄ ÇBÉ\nË&ˆ\f„'ÍÎ!ˆÂÏ!‡\nbˆÐÑ ƒ;Ó‚<Ô#‡" [fail-if-not-found vip-search-wrap-around-t message "Search wrapped around end of buffer" vip-search string forward 1 com t start-point fail executing-kbd-macro sit-for 2 "" error "`%s': %s not found" vip-re-search "Pattern" "String"] 7))) (byte-code "ƒÁ\nÉ\f$ˆ‚Å\nÉ\f$ˆ„Ç ˆ`š?…*ÉÊ\"‡" [vip-re-search re-search-backward string nil val search-backward executing-kbd-macro vip-flash-search-pattern start-point push-mark t] 5) ((search-failed (byte-code "„+ ƒ+ÂÃ!ˆdbˆÄ ÇBÉ\nË&ˆ\f„'ÍÎ!ˆÂÏ!‡\nbˆÐÑ ƒ;Ó‚<Ô#‡" [fail-if-not-found vip-search-wrap-around-t message "Search wrapped around beginning of buffer" vip-search string forward 1 com t start-point fail executing-kbd-macro sit-for 2 "" error "`%s': %s not found" vip-re-search "Pattern" "String"] 7)))] 6]) #@25 Repeat previous search. (defalias 'vip-search-next #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)‰„0Â;:ƒ:A‚;Ã)„HÇ!ˆÉ\n#ˆ\f…`ËÌÍÎ!\"ˆÏÐ \f#*‡" [arg 1 (nil) nil com val vip-s-string error vip-NoPrevSearch vip-search vip-s-forward vip-move-marker-locally vip-com-point mark t vip-execute-com vip-search-next] 5 (#$ . 89216) "P"]) #@50 Repeat previous search in the reverse direction. (defalias 'vip-search-Next #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)‰„0Â;:ƒ:A‚;Ã)„HÇ!ˆÉ\n?#ˆ\f…aËÌÍÎ!\"ˆÏÐ \f#*‡" [arg 1 (nil) nil com val vip-s-string error vip-NoPrevSearch vip-search vip-s-forward vip-move-marker-locally vip-com-point mark t vip-execute-com vip-search-Next] 5 (#$ . 89572) "P"]) (defalias 'vip-buffer-search-enable #[(&optional c) "ƒ ‚ „ÂÃ\fÅ !Æ#ˆ ÈIˆ  B‰ ‡" [c vip-buffer-search-char 103 define-key vip-vi-basic-map char-to-string vip-command-argument vip-exec-array vip-exec-buffer-search vip-prefix-commands] 4]) #@32 Do incremental search forward. (defalias 'vip-isearch-forward #[(arg) "<ƒ@ÁÂD!‡" [arg vip-exec-form-in-emacs isearch-forward] 3 (#$ . 90204) "P"]) #@33 Do incremental search backward. (defalias 'vip-isearch-backward #[(arg) "<ƒ@ÁÂD!‡" [arg vip-exec-form-in-emacs isearch-backward] 3 (#$ . 90363) "P"]) #@41 Switch to buffer in the current window. (defalias 'vip-switch-to-buffer #[nil "ÀÂÃÄÅÆp!!\"!Ç !)‡" [nil buffer read-buffer format "Switch to buffer in this window (%s): " buffer-name other-buffer switch-to-buffer] 6 (#$ . 90525) nil]) #@37 Switch to buffer in another window. (defalias 'vip-switch-to-buffer-other-window #[nil "ÀÂÃÄÅÆp!!\"!Ç !)‡" [nil buffer read-buffer format "Switch to buffer in another window (%s): " buffer-name other-buffer switch-to-buffer-other-window] 6 (#$ . 90767) nil]) #@16 Kill a buffer. (defalias 'vip-kill-buffer #[nil "À‰ÃÄÅÁp!\"!‰„p‚Æ !‰„\"ÇÈ \"ˆÉ\n!ƒ1ÊÄË \"!ƒ7Ì\n!‚:ÇÍ!*‡" [nil buffer-name buffer read-buffer format "Kill buffer (%s): " get-buffer error "`%s': No such buffer" buffer-modified-p y-or-n-p "Buffer `%s' is modified, are you sure you want to kill it? " kill-buffer "Buffer not killed"] 6 (#$ . 91034) nil]) #@653 *List of suffixes that Viper automatically tries to append to filenames ending with a `.'. This is useful when you the current directory contains files with the same prefix and many different suffixes. Usually, only one of the suffixes represents an editable file. However, file completion will stop at the `.' The smart suffix feature lets you hit RET in such a case, and Viper will select the appropriate suffix. Suffixes are tried in the order given and the first suffix for which a corresponding file exists is selected. If no file exists for any of the suffixes, the user is asked to confirm. To turn this feature off, set this variable to nil. (defvar vip-smart-suffix-list (quote ("" "tex" "c" "cc" "el" "p")) (#$ . -91405)) (defalias 'vip-file-add-suffix #[nil "À G É‰‰ \ndbˆ …”ËÌ\"…”„O\n WƒO\n 8\nT\nÍÎÏ\f#!ƒ$Ð\fcˆ‚$?…”ÑÒ!ˆÃŽ Ó>?…“ÔÕÃ!‰!‰Ö=ƒ†ƒØ!cˆ‚[cˆ‚[ Ù>„[Ú !ˆ‚[).‡" [0 vip-smart-suffix-list buffer-string nil suff cmd key found file len count string-match "\\.$" file-exists-p format "%s%s" t vip-tmp-insert-at-eob " [Please complete file name]" (exit-minibuffer vip-exit-minibuffer) key-binding read-key-sequence self-insert-command vip-xemacs-p events-to-keys (exit-minibuffer vip-exit-minibuffer) command-execute] 8]) (byte-code "ÀÁÂÃÄ$ˆÅÁÄ\"ˆÀÆÇÃÄ$ˆÅÆÄ\"ˆÀÈÉÃÄ$ˆÅÈÄ\"ˆÀÊËÃÄ$ˆÅÊÄ\"ˆÀÌÍÎÄ$ˆÅÌÄ\"‡" [ad-add-advice exit-minibuffer (vip-exit-minibuffer-advice nil t (advice lambda nil "Run `vip-minibuffer-exit-hook' just before exiting the minibuffer." (run-hooks (quote vip-minibuffer-exit-hook)))) before nil ad-activate-on find-file (vip-add-suffix-advice nil t (advice lambda nil "Use `read-file-name' for reading arguments." (interactive (list (read-file-name "Find file: " nil default-directory))))) find-file-other-window (vip-add-suffix-advice nil t (advice lambda nil "Use `read-file-name' for reading arguments." (interactive (list (read-file-name "Find file in other window: " nil default-directory))))) find-file-other-frame (vip-add-suffix-advice nil t (advice lambda nil "Use `read-file-name' for reading arguments." (interactive (list (read-file-name "Find file in other frame: " nil default-directory))))) read-file-name (vip-suffix-advice nil t (advice lambda nil "Tell `exit-minibuffer' to run `vip-file-add-suffix' as a hook." (let ((vip-minibuffer-exit-hook (quote vip-file-add-suffix))) ad-do-it))) around] 5) #@73 Yank TEXT silently. This works correctly with Emacs's yank-pop command. (defalias 'vip-yank #[(text) "cˆÁ‰‡" [text yank this-command] 2 (#$ . 93809)]) (put (quote vip-yank) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@34 Put back after point/below line. (defalias 'vip-put-back #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%) ƒOÄ Å\"ƒ:Æ ÇZÈ\"‚RÄ !ƒGÉ —!‚RÊ \"‚RÆÌ!  „s ƒo ÐÊ\"ˆ)‚sÊÒ!ˆÐÓ !ƒmƒ†Ôcˆ‚‰ÁyˆÌyˆ‚–l„–Õ ˆƒ¡×Ø!‚£× `p“ˆÙÚРЉ¯!ˆ‰ÌVƒÑ ‰ cˆÜ)S‰‚¸+Þ`ß \"ƒç`ß U„ñà ˆ‚ñá ˆnƒñ⠈㠇" [arg 1 (nil) vip-use-register vip-valid-register (digit) current-kill 49 do-not-rotate get-register error vip-InvalidRegister 0 text val reg nil vip-EmptyRegister "" vip-end-with-a-newline-p "\n" vip-forward-char-carefully vip-xemacs-p mark-marker t vip-set-destructive-command vip-put-back count yank this-command vip-same-line mark vip-backward-char-carefully exchange-point-and-mark back-to-indentation vip-deactivate-mark] 8 (#$ . 94049) "P"]) #@31 Put back at point/above line. (defalias 'vip-Put-back #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%) ƒOÄ Å\"ƒ:Æ ÇZÈ\"‚RÄ !ƒGÉ —!‚RÊ \"‚RÆÌ!  „s ƒo ÐÊ\"ˆ)‚sÊÒ!ˆÐÓ !ƒÌyˆÔÕРЉ¯!ˆƒ–×Ø!‚˜× `p“ˆ‰ÌVƒº ‰ cˆÚ)S‰‚¡+Ü`Ý \"ƒÐ`Ý U„ÚÞ ˆ‚Úß ˆnƒÚà ˆá ‡" [arg 1 (nil) vip-use-register vip-valid-register (digit) current-kill 49 do-not-rotate get-register error vip-InvalidRegister 0 text val reg nil vip-EmptyRegister "" vip-end-with-a-newline-p vip-set-destructive-command vip-Put-back vip-xemacs-p mark-marker t count yank this-command vip-same-line mark vip-backward-char-carefully exchange-point-and-mark back-to-indentation vip-deactivate-mark] 8 (#$ . 94821) "P"]) (defalias 'vip-copy-region-as-kill #[(beg end) "ÀÁ‡" [nil (copy-region-as-kill beg end) ((error (byte-code "À ‰\"‡" [copy-region-as-kill beg] 3)))] 3]) (defalias 'vip-save-last-insertion #[(beg end) " { GÄW„Å ›\n ˆ?†+Ç!†+ÅÈ!›\n ˆÉ!‡" [beg end vip-last-insertion vip-d-com 5 4 vip-command-ring ring-empty-p vip-current-ring-item vip-cleanup-ring] 3]) #@73 Inserts the text saved by the previous vip-save-last-insertion command. (defalias 'vip-yank-last-insertion #[nil "ÀÁ‡" [nil (insert vip-last-insertion) ((error))] 3 (#$ . 95901)]) (put (quote vip-yank-last-insertion) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@19 Delete character. (defalias 'vip-delete-char #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)ÄŠƉ‰‰¯!ˆ ÁVƒNŠ`ƈ `ZVƒM`Z* È=ƒ[ „[Á ƒqlƒqnƒoÊË!ˆ‚qÈ\fƒÈÍ\fÎ\"ƒª\f—`` ZÒÓ!;ƒÓ!‚žË{P\"ˆ+‚ÅÍ\f!ƒ¾Ô\f`` ZÆ$ˆ‚ÅÊ\f\"ˆÆ\f ƒáÖ ×\"ˆl…ðn?…ðØÁ!‚ðlƒìÙ ×\"‚ðÖ ×\")‡" [arg 1 (nil) val vip-set-destructive-command vip-delete-char nil here 0 vip-ex-style-motion error "" vip-use-register vip-valid-register ((Letter)) end start reg set-register get-register copy-to-register vip-InvalidRegister delete-char t backward-char delete-backward-char] 8 (#$ . 96185) "P"]) #@74 Delete previous character. On reaching beginning of line, stop and beep. (defalias 'vip-delete-backward-char #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)ÄŠƉ‰‰¯!ˆ ÁVƒNŠ`Èyˆ `ZVƒM`Z* ƒ¥Ê Ë\"ƒ‡ —`` \\\f ÏÐ!;ƒzÐ!‚{Ñ \f{P\"ˆ+‚¢Ê !ƒ›Ò `` \\Æ$ˆ‚¢Ó \"ˆÆ nƒ®Õ ‚²Ö ×\")‡" [arg 1 (nil) val vip-set-destructive-command vip-delete-backward-char nil here 0 vip-use-register vip-valid-register (Letter) end start reg set-register get-register "" copy-to-register error vip-InvalidRegister ding delete-backward-char t] 8 (#$ . 96799) "P"]) #@47 Delete 1 char backwards while in insert mode. (defalias 'vip-del-backward-char-in-insert #[nil "ƒ\fnƒ\fÁÂ!‡ÃÂÄ\"‡" [vip-ex-style-editing-in-insert beep 1 delete-backward-char t] 3 (#$ . 97376) nil]) #@302 Delete one character in replace mode. If `vip-delete-backwards-in-replace' is t, then DEL key actually deletes charecters. If it is nil, then the cursor just moves backwards, similarly to Vi. The variable `vip-ex-style-editing-in-insert', if t, doesn't let the cursor move past the beginning of line. (defalias 'vip-del-backward-char-in-replace #[nil "ƒ\"n„ ÁÂÃ\"‡\fƒÅÂ!‡oƒÅÂ!‡ÁÂÃ\"‡\fƒ2nƒ.ÅÂ!‡ÆÂ!‡ÆÂ!‡" [vip-delete-backwards-in-replace delete-backward-char 1 t vip-ex-style-editing-in-insert beep backward-char] 3 (#$ . 97585) nil]) #@68 Join this line to next, if ARG is nil. Otherwise, join ARG lines. (defalias 'vip-join-lines #[(arg) "‰:ƒ\f@‚ )Âà ĉ‰‰¯!ˆ „\"Å‚$ S‰ÇV…GĈm„>Åyˆ``S|ˆÈ ˆS‰‚'*‡" [arg val vip-set-destructive-command vip-join-lines nil 1 count 0 fixup-whitespace] 8 (#$ . 98134) "*P"]) (defalias 'vip-change #[(beg end) "À !ƒ\n !À !ƒ ! „ Ä ˆ ƒ*Æ Ç$ˆÇÈ \"ˆÇ Ê Ì\"dUƒ@ÍÎ!ˆÊ Ì\"Ê Ï\"{ÑÒÓ‡" [markerp beg marker-position end vip-set-complex-command-for-undo vip-use-register copy-to-register nil vip-set-replace-overlay last-command vip-overlay-get vip-replace-overlay vip-start error "End of buffer" vip-end vip-last-replace-region conds (byte-code "ÀÁ\nÃ\"Á\nÄ\"\"ƒ®Á\nÄ\"bˆÅÆ!ˆÇÁ\nÃ\"`\"ˆÈÉ!ˆ\n \f ƒ5‚9ÐÑ !ƒTƒF‚JÐÑ !Ò>„Tƒ}ƒ]Õ‚^ÖƒgׂhØÛ\n #ˆÛ\n\f#*ˆ*Á\nÃ\"`Þ\n#ˆÁ\nÃ\"ß\n!à“ˆÁ\nÄ\"á\n!à“ˆ*Á\nÃ\"bˆâã!‡äÁ\nÃ\"Á\nÄ\"\"ˆåÁ\næ\"!ˆç ‡" [vip-same-line vip-overlay-get vip-replace-overlay vip-start vip-end insert-before-markers "@" untabify delete-backward-char 1 vip-replace-region-start-delimiter vip-replace-region-end-delimiter after-glyph before-glyph vip-emacs-p window-system device-type selected-device (tty stream) vip-use-replace-region-delimiters vip-xemacs-p begin-glyph before-string end-glyph after-string after-name before-name vip-overlay-put end beg vip-move-overlay vip-overlay-start nil vip-overlay-end vip-change-state-to-replace t kill-region vip-change-cursor-color vip-cursor-color vip-change-state-to-insert] 5) ((error (byte-code "À Â\"bˆÃ‰ƒ‚ÈÉ !ƒ3ƒ%‚)ÈÉ !Ê>„3 ƒZ\fƒ<Í‚=Î\fƒFÏ‚GÐÓ  #ˆÓ \f#*ˆ*ÔÀ Õ\"!ˆƒl‚pÈÉ !ƒŒƒ}‚ÈÉ !Ö>„ŒÓ ×Ã#ˆØ!‡" [vip-overlay-get vip-replace-overlay vip-start nil after-glyph before-glyph vip-emacs-p window-system device-type selected-device (tty stream) vip-use-replace-region-delimiters vip-xemacs-p begin-glyph before-string end-glyph after-string after-name before-name vip-overlay-put vip-change-cursor-color vip-cursor-color (tty stream) face vip-message-conditions conds] 4)))] 5]) (defalias 'vip-change-subr #[(beg end) "„ \nƒÃ\n Ä$ˆÄÅ \"ˆÆÄÈɇ" [beg end vip-use-register copy-to-register nil kill-region vip-change this-command (insert vip-last-insertion) ((error))] 5]) #@24 Toggle character case. (defalias 'vip-toggle-case #[(arg) "‰„\nÁ‚%:ƒ$@ƒ@šƒÁ‚%@‚%)ÃÆÇ Ã‰‰‰¯!ˆ ÈV…fgÉÁÃ\"ˆ\f‰–=ƒQÊ\f—Á\"ˆ‚WÊ\f–Á\"ˆlƒ_ËÁ!ˆ S‰‚5*‡" [arg 1 (nil) nil c val vip-set-destructive-command vip-toggle-case 0 delete-char insert-char backward-char] 8 (#$ . 100389) "P"]) #@153 Query replace. If a null string is suplied as the string to be replaced, the query replace mode will toggle between string replace and regexp replace. (defalias 'vip-query-replace #[nil "À ƒ Ä‚\fÅÀÆ@$‰ǘƒ+ ?ÈÉ ƒ&Ê‚'Ë\"‚N ƒ@Ì ÂÍÎ \"ÀÆ@$\"‚NÏ ÂÍÐ \"ÀÆ@$\")‡" [nil str vip-read-string-with-history vip-re-query-replace "Query replace regexp: " "Query replace: " vip-replace1-history "" message "Query replace mode changed to %s" "regexp replace" "string replace" query-replace-regexp format "Query replace regexp `%s' with: " query-replace "Query replace `%s' with: "] 8 (#$ . 100698) nil]) #@27 Mark beginning of buffer. (defalias 'vip-mark-beginning-of-buffer #[nil "À`!ˆebˆÁ ˆÂÃ!‡" [push-mark exchange-point-and-mark message "Mark set at the beginning of buffer"] 2 (#$ . 101311) nil]) #@21 Mark end of buffer. (defalias 'vip-mark-end-of-buffer #[nil "À`!ˆdbˆÁ ˆÂÃ!‡" [push-mark exchange-point-and-mark message "Mark set at the end of buffer"] 2 (#$ . 101510) nil]) #@30 Set mark at point of buffer. (defalias 'vip-mark-point #[nil "À  Xƒ ÃXƒÄ ÂZT!‚f ÅUƒ#Æ ‚f ÇUƒ.È ‚f ÉUƒMÊ ƒ@ÌÍ!‚BÌ \"ÏÐ!‚f ÑUƒXÒ ‚f ÓUƒcÔ ‚fÕÖ!)‡" [vip-read-char-exclusive char 97 122 point-to-register 60 vip-mark-beginning-of-buffer 62 vip-mark-end-of-buffer 46 delete vip-xemacs-p mark-marker t mark-ring set-mark-command nil 44 vip-cycle-through-mark-ring 68 mark-defun error ""] 3 (#$ . 101691) nil]) #@99 Visit previous locations on the mark ring. One can use `` and '' to temporarily jump 1 step back. (defalias 'vip-cycle-through-mark-ring #[nil "` Â=„'Ã\fƒÅÆ!‚Å \"ÈÆ!ƒ'ÉÈÆ!Æ\"ˆÊ ˆËÌ!ˆÃ\fƒ9ÅÆ!‚;Å \"ÉÆ\"ˆÍ ˆÂ‰)‡" [sv-pt last-command vip-cycle-through-mark-ring delete vip-xemacs-p mark-marker t mark-ring mark push-mark pop-mark set-mark-command 1 vip-deactivate-mark this-command] 3 (#$ . 102124)]) #@13 Go to mark. (defalias 'vip-goto-mark #[(arg) "À ‰„\f‚ :ƒ A‚Â)Å\f Â#*‡" [read-char arg nil com char vip-goto-mark-subr] 5 (#$ . 102547) "P"]) #@59 Go to mark and skip to first non-white character on line. (defalias 'vip-goto-mark-and-skip-white #[(arg) "À Á\n!Å\f Æ#*‡" [read-char vip-getCom arg com char vip-goto-mark-subr t] 4 (#$ . 102706) "P"]) (defalias 'vip-goto-mark-subr #[(char com skip-white) "mƒoƒÀÁ!ˆ‚ÂÃ!ˆÄ Æ\"ƒ¢p ÈZT Ê ! \fƒ3ÍÎ`\"ˆÏ !„BÀÐ \"!ˆÒ`\"ƒZ`UƒZÕÖ\"ˆ‚_Õ×Ö\"ˆØ !ˆÙ ƒsÛ ˆ`\f… pšƒ‘܃‰Ý‚ŠÞ×\f#‚ ß!ˆbˆà ˆÀá!+‡„ë âUƒë\fƒ·ÍÎ`\"ˆÒ`\"ƒÊ`UƒÊbˆ`ãÖ!UƒÕä ˆå ˆÙ æ\f…;ÜÞ×\f#‡ƒ6 çUƒ6\fƒÍÎ`\"ˆÒ`\"ƒ`Uƒbˆ`ãÖ!Uƒä ˆå ˆ`Û ˆ`\f…;ÜÝ×\f#‡À( \"‡" [error "Empty buffer" backward-char 1 vip-valid-register char (letter) buff 97 reg get-register text-marker com vip-move-marker-locally vip-com-point vip-valid-marker format vip-EmptyTextmarker vip-same-line vip-last-jump vip-last-jump-ignore push-mark t nil vip-register-to-point point-marker skip-white back-to-indentation vip-execute-com vip-goto-mark-and-skip-white vip-goto-mark switch-to-buffer vip-change-state-to-vi "" 96 mark pop-mark exchange-point-and-mark 0 39 vip-InvalidTextmarker] 4]) (defalias 'vip-insert-tab #[nil "À ‡" [insert-tab] 1 nil nil]) (defalias 'vip-exchange-point-and-mark #[nil "À ˆÁ ‡" [exchange-point-and-mark back-to-indentation] 1 nil nil]) #@32 Indent forward -- `C-t' in Vi. (defalias 'vip-forward-indent #[nil "Ài\n\\j‡" [t vip-cted vip-shift-width] 2 (#$ . 103984) nil]) #@20 Backtab, C-d in VI (defalias 'vip-backward-indent #[nil "…T`iÁÂÇÈ!ƒ%hÉUƒÂ\nËÌ!ˆ`ÁŠÍyˆ`)ÎÏ\fÌ#ƒ7Áuˆ`|ˆ ƒF Zjˆn„PÇÏ!…SÁ‰,‡" [vip-cted nil t indent bol c p vip-looking-back "[0^]" 94 vip-preserve-indent delete-backward-char 1 0 re-search-backward "[^ ]" vip-shift-width] 4 (#$ . 104120) nil]) #@29 Auto Indentation, Vi-style. (defalias 'vip-autoindent #[nil "À \n„\f ‚Ä Æ>ƒÇ ˆÈÉ!ˆ\n…%Ë\f j)‡" [current-indentation col vip-preserve-indent vip-current-indent nil last-command (vip-autoindent vip-open-line vip-Open-line vip-replace-state-exit-cmd) indent-to-left-margin newline 1 vip-auto-indent t vip-cted] 2 (#$ . 104441) nil]) #@60 Function called by ], the ket. View registers and call ]]. (defalias 'vip-ket-function #[(arg) "À  Ã\"ƒÄ —!‚Q Å\"ƒ?Æ ÇZÈ\" ŠÊË!qˆed|ˆÌÍ \"cˆ cˆebˆ)ÎË!)‚Q ÏUƒLÐ!‚QÒ \")‡" [read-char reg vip-valid-register (letter Letter) view-register (digit) current-kill 49 do-not-rotate text get-buffer-create "*Output*" format "Register %c contains the string:\n" display-buffer 93 vip-next-heading arg error vip-InvalidRegister] 3 (#$ . 104788) "P"]) #@62 Function called by [, the brac. View textmarkers and call [[ (defalias 'vip-brac-function #[(arg) "À ‰ÂUƒÃ\f!‚ì ÅUƒÆ\f!‚ìÇ È\"ƒçÉ ÊZT!‰ „8ÌÍ \"!‚<Ï !Ñ !ÓÓŠØÙ!qˆed|ˆƒÔƒÔŠqˆÚe \"TbˆÛyˆÜÝÓÞ#ƒˆÛyˆ`bˆßyˆàÝÓÞ#ƒÓˆ`{ÍáÛZO ZÓO$)Íâ ã!$cˆÍä #cˆ‚ÛÍ \"cˆebˆ)åÙ!.‚ìÌ& \")‡" [read-char reg 91 vip-prev-heading arg 93 vip-heading-end vip-valid-register (letter) get-register 97 val error format vip-EmptyTextmarker marker-buffer buf marker-position pos nil line-no text s e get-buffer-create "*Output*" count-lines 0 re-search-backward "[^ ]" t 1 re-search-forward "%s<%c>%s" "Textmarker `%c' is in buffer `%s' at line %d.\n" buffer-name "Here is some text around %c:\n\n %s" display-buffer vip-InvalidTextmarker] 8 (#$ . 105248) "P"]) #@23 Delete previous word. (defalias 'vip-delete-backward-word #[(arg) "ŠÀÁÂ\"ˆÃ\f!ˆ`ÅÂ!|ˆÆ )‡" [push-mark nil t backward-word arg mark pop-mark] 3 (#$ . 106061) "p"]) #@407 Sets the expert level for a Viper user. Can be called interactively to change (temporarily or permanently) the current expert level. The optional argument DONT-CHANGE-UNLESS if not nil, says that the level should not be changed, unless its current value is meaningless (i.e., not one of 1,2,3,4,5). User level determines the setting of Viper variables that are most sensitive for VI-style look-and-feel. (defalias 'vip-set-expert-level #[(&optional dont-change-unless) "§„Á‹ˆÃÃÃÇÉ=ƒ]Ê \fƒ' ‚+ÎÏ !ƒE\fƒ8 ‚<ÎÏ !Ð>„EÑ‚FÒ\"ˆÃÃÃÃÇÇ‚*ÉVƒØÙWƒØ\fƒs ‚wÎÏ !ƒ‘\fƒ„ ‚ˆÎÏ !Ð>„‘Â’ÚÃÛVÜ=ƒ*ÝÆÞÆ\"A\"ˆÝÅÞÅ\"A\"ˆÞÅ\"AÞÆ\"AÞÔ\"AÞÓ\"A‚*ÝÆÞÆ\"A\"ˆÝÅÞÅ\"A\"ˆÞÈ\"AÞÄ\"AÞÓ\"AÞÅ\"AÞÆ\"AÞÔ\"AÞ×\"AÞØ\"Aà!!ˆ\f„?ÁV…AÙV…Aâ ‡" [vip-expert-level 0 ((byte-code "À ˆÁ\n!‡" [delete-other-windows vip-ask-level dont-change-unless] 2)) t vip-always vip-ex-style-motion vip-ex-style-editing-in-insert nil vip-want-ctl-h-help 1 global-set-key vip-toggle-key vip-emacs-p window-system device-type selected-device (tty stream) vip-iconify suspend-emacs vip-no-multiple-ESC vip-re-search vip-vi-style-in-minibuffer vip-search-wrap-around-t vip-want-emacs-keys-in-vi vip-want-emacs-keys-in-insert 5 twice 2 4 set-default assoc vip-saved-user-settings vip-set-mode-vars-for vip-current-state vip-set-hooks] 5 (#$ . 106231) nil]) (defalias 'vip-ask-level #[(dont-change-unless) "ÀÁ‰Å‹+‡" [" *vip-ask-level*" nil repeated level-changed ask-buffer ((byte-code "À !ˆ\nÃ=„\f Xƒ\fÆY„ÇcˆÈ ˆÉ ˆ\f V„0\fÆW„0\n„XÉ ˆ ƒCÌÍ!ˆÎÆ!ˆ‚FÏ Ï\nÏÑcˆÒ ÓZ‰‚ ƒsÔÕ\f\"cˆÖ×!ƒsØÄÔÙ\f\"#ˆÛ ˆÌÜ!‡" [switch-to-buffer ask-buffer this-command vip-set-expert-level vip-expert-level vip-max-expert-level 1 "\n \n *** Important Notice for VIP users***\n \n This is VIPER\n \n@joke\nViper Is a Package for Emacs Rebels,\na VI Plan for Emacs Rescue,\nand a venomous VI PERil.\n@end joke\n\nTechnically speaking, Viper is a new Vi emulator that replaces\nthe old VIP package.\n\nViper emulates Vi much better than VIP. It also significantly\nextends and improves upon Vi in many useful ways.\n\nAlthough many VIP settings in your ~/.vip are compatible with Viper,\nyou may have to change some of them. Please refer to the documentation,\nwhich can be obtained by executing\n\n:help\n\nwhen Viper is in Vi state.\n\nIf you will be so lucky as to find a bug, report it via the command\n\n:submitReport\n\nType any key to continue... " read-char erase-buffer dont-change-unless repeated message "Invalid user level" beep t level-changed "\nPlease specify your level of familiarity with the venomous VI PERil\n(and the VI Plan for Emacs Rescue).\nYou can change it at any time by typing `M-x vip-set-expert-level RET'\n \n 1 -- BEGINNER: Almost all Emacs features are suppressed.\n Feels almost like straight Vi. File name completion and\n command history in the minibuffer are thrown in as a bonus. \n To use Emacs productively, you must reach level 3 or higher.\n 2 -- MASTER: C-c now has its standard Emacs meaning in Vi command state,\n so most Emacs commands can be used when Viper is in Vi state.\n Good progress---you are well on the way to level 3!\n 3 -- GRAND MASTER: Like 3, but most Emacs commands are available also\n in Viper's insert state.\n 4 -- GURU: Like 3, but user settings are respected for vip-no-multiple-ESC,\n vip-re-search, vip-ex-style-motion, & vip-ex-style-editing-in-insert\n variables. Adjust these settings to your taste.\n 5 -- WIZARD: Like 4, but user settings are also respected for vip-always,\n vip-want-ctl-h-help, vip-want-emacs-keys-in-vi, and \n vip-want-emacs-keys-in-insert. Adjust these to your taste.\n \nPlease, specify your level now: " vip-read-char-exclusive 48 format "\n\n\n\n\n You have selected user level %d" y-or-n-p "Do you wish to make this change permanent? " vip-save-setting "Saving user level %d ..." vip-custom-file-name bury-buffer ""] 6))] 3]) (defalias 'viper-version #[nil "ÀÁ\n\"‡" [message "Viper version is %s" viper-version] 3 nil nil]) (defalias (quote vip-version) (quote viper-version)) (defalias 'vip-nil #[nil "ÀÁ!‡" [beep 1] 2 nil nil]) (defalias 'vip-looking-back #[(str) "ŠÀ ÂÃ#)…`Ä•U‡" [re-search-backward str nil t 0] 4]) (put (quote vip-looking-back) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@74 Like jump-to-register, but switches to another buffer in another window. (defalias 'vip-register-to-point #[(char &optional enforce-buffer) "À !ÃÄ!ƒÄ\n!ƒÅ\n!‚fÆ\n!ƒ\"Ç\n!‚fÈ\n!ƒK ƒ@pÊ\n!š„@Ë\fÍP Î\\S\"ˆÏÊ\n!!ˆ\nb‚f\n:ƒ^\n@Ð=ƒ^Ñ\nA!‚fË\f Î\\S\")‡" [get-register char val fboundp frame-configuration-p set-frame-configuration window-configuration-p set-window-configuration vip-valid-marker enforce-buffer marker-buffer error vip-EmptyTextmarker " in this buffer" 97 pop-to-buffer file find-file] 4 (#$ . 110681) "cViper register to point: "]) #@33 Save then kill current buffer.  (defalias 'vip-save-kill-buffer #[nil "ÁWƒ  ‡Ã ˆÄp!‡" [vip-expert-level 2 save-buffers-kill-emacs save-buffer kill-buffer] 2 (#$ . 111247) nil]) #@29 Submit bug report on Viper. (defalias 'vip-submit-report #[nil "À ƒ \n‚ ÃÄ !ʼn‰‰‰‰‰‰ \n \f  ƒ1\n‚5ÃÄ !ƒ[ ƒ@\n‚DÃÄ !Ð>„[ ƒRÑ ‚\\ÒÄ !Ó=‚\\Ô ƒf\n‚jÃÄ !ƒ… ƒu\n‚yÃÄ !Ð>„…Õ!‚†Ô\n ƒ\n‚”ÃÄ !ƒ¯ ƒŸ\n‚£ÃÄ !Ð>„¯Õ!‚°Ô ƒº\n‚¾ÃÄ !ƒÙ ƒÉ\n‚ÍÃÄ !Ð>„ÙÕ!‚ÚÔ ÙÌ!…æÌÚ !\fÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ@ABÎÍÌÊÉ˯.CD EFE!ˆG ˆHI!ˆJK!?…]L!ˆMN!‘ˆOP!ˆL!ˆQRS ÅG&.\n‡" [t vip-emacs-p window-system device-type selected-device nil window-config salutation varlist minibuffer-insert-face minibuffer-vi-face minibuffer-emacs-face frame-parameters color-display-p vip-device-type reporter-prompt-for-summary-p (tty stream) x-display-color-p device-class color non-x vip-get-face vip-minibuffer-vi-face vip-minibuffer-insert-face vip-minibuffer-emacs-face fboundp selected-frame vip-vi-minibuffer-minor-mode vip-insert-minibuffer-minor-mode vip-vi-intercept-minor-mode vip-vi-local-user-minor-mode vip-vi-kbd-minor-mode vip-vi-global-user-minor-mode vip-vi-state-modifier-minor-mode vip-vi-diehard-minor-mode vip-vi-basic-minor-mode vip-replace-minor-mode vip-insert-intercept-minor-mode vip-insert-local-user-minor-mode vip-insert-kbd-minor-mode vip-insert-global-user-minor-mode vip-insert-state-modifier-minor-mode vip-insert-diehard-minor-mode vip-insert-basic-minor-mode vip-emacs-intercept-minor-mode vip-emacs-local-user-minor-mode vip-emacs-kbd-minor-mode vip-emacs-global-user-minor-mode vip-emacs-state-modifier-minor-mode vip-automatic-iso-accents vip-want-emacs-keys-in-insert vip-want-emacs-keys-in-vi vip-keep-point-on-undo vip-no-multiple-ESC vip-ESC-key vip-want-ctl-h-help vip-ex-style-editing-in-insert vip-delete-backwards-in-replace vip-vi-style-in-minibuffer vip-vi-state-hook vip-insert-state-hook vip-replace-state-hook vip-emacs-state-hook ex-cycle-other-window ex-cycle-through-non-files vip-expert-level major-mode "\nCongratulations! You may have unearthed a bug in Viper!\nPlease mail a concise, accurate summary of the problem to the address above.\n\n-------------------------------------------------------------------" current-window-configuration " *vip-info*" switch-to-buffer delete-other-windows princ "\nPLEASE FOLLOW THESE PROCEDURES\n------------------------------\n\nBefore reporting a bug, please verify that it is related to Viper, and is\nnot cause by other packages you are using.\n\nDon't report compilation warnings, unless you are certain that there is a\nproblem. These warnings are normal and unavoidable.\n\nPlease note that users should not modify variables and keymaps other than\nthose advertised in the manual. Such `customization' is likely to crash\nViper, as it would any other improperly customized Emacs package.\n\nIf you are reporting an error message received while executing one of the\nViper commands, type:\n\n M-x set-variable debug-on-error t \n \nThen reproduce the error. The above command will cause Emacs to produce a\nback trace of the execution that leads to the error. Please include this\ntrace in your bug report.\n\nIf you believe that one of Viper's commands goes into an infinite loop\n(e.g., Emacs freezes), type:\n\n M-x set-variable debug-on-quit t \n \nThen reproduce the problem. Wait for a few seconds, then type C-g to abort\nthe current command. Include the resulting back trace in the bug report.\n\nMail anyway (y or n)? " y-or-n-p "Mail anyway? " set-window-configuration error "Bug report aborted" require reporter reporter-submit-bug-report "kifer@cs.sunysb.edu" vip-version] 46 (#$ . 111433) nil]) (defalias 'vip-set-unread-command-events #[(arg) "ƒ€ ‰¨†%\n9ƒ\nÃN†%\n:…%\n@9…%\n@ÃN)ƒ. C‚G <ƒ7 ‚GÄ !ƒCÅ !‚GÆÇ \"Éɨ†j\n9ƒ[\nÃN†j\n:…j\n@9…j\n@ÃN)„uÊÉ\"Ë\f\")‰\f‡Ë §ƒÍ !C‚ß ‰¨†®\n9ƒŸ\nÃN†®\n:…®\n@9…®\n@ÃN)ƒ· C‚ß ;ƒÃÎÍ \"‚ßÏ !ƒÐË É\"‚ß <ƒÛÐ !‚ßÆÇ \"\f\"‰\f‡" [vip-emacs-p arg obj event-symbol-elements sequencep listify-key-sequence error "vip-set-unread-command-events: Invalid argument, %S" new-events nil delq append unread-command-events character-to-event mapcar vectorp vip-eventify-list-xemacs] 5]) (defalias 'vip-eventify-list-xemacs #[(lis) "ÀÁ\n\"‡" [mapcar #[(elt) "§ƒ Á!‡‰¨†*\n9ƒ\nÃN†*\n:…*\n@9…*\n@ÃN)ƒ0‡ÄÅ\"‡" [elt character-to-event obj event-symbol-elements error "vip-eventify-list-xemacs: can't convert to event, %S"] 4] lis] 3]) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÄÅÆ\"ˆÄÇÈ\"ˆÄÉÊ\"‡" [require viper-mous viper-macs viper-ex defalias vip-change-mode-to-vi vip-change-state-to-vi vip-change-mode-to-insert vip-change-state-to-insert vip-change-mode-to-emacs vip-change-state-to-emacs] 3) (defalias 'vip-comint-mode-hook #[nil "ÀÀÀÄÅÆ\"ˆÄÇÈ\"‡" [nil require-final-newline vip-ex-style-editing-in-insert vip-ex-style-motion vip-add-local-keys vi-state ((" " . comint-send-input) ("" . comint-delchar-or-maybe-eof)) insert-state ((" " . comint-send-input) ("" . comint-delchar-or-maybe-eof))] 3]) (defalias 'vip-set-hooks #[nil "ÀÂÃÄÅÆ$ˆÇÃÆ\"ˆÈÉ!„Æ É\nB\nËÉÀ\"ˆÈÌ!„+Æ\fÌ\nB\nËÌÀ\"ˆÈÍ!„?Æ Í\nB\nËÍÀ\"ˆÈÎ!„SÆÎ\nB\nËÎÀ\"ˆÈÏ!„gÆÏ\nB\nËÏÀ\"ˆÈÐ!„{ÆÐ\nB\nËÐÀ\"ˆÈÑ!„ÆÑ\nB\nËÑÀ\"ˆÈÒ!„£ÆÒ\nB\nËÒÀ\"ˆÈÓ!„·ÆÓ\nB\nËÓÀ\"ˆÈÔ!„ËÆÔ\nB\nËÔÀ\"ˆËÕÀ\"ˆËÖÀ\"ˆÈ×!„éÆ×\nB\nË×Ø\"ˆÙÚÛ\"ˆÂÜÝÅÆ$ˆÇÜÆ\"ˆÙÞß\"ˆÙàá\"ˆÈâ!„Æ\"â\nB\nËâã\"ˆËâä\"ˆÈå!„1Æ%å\nB\nËåÀ\"ˆËæØ\"ˆ'ƒcÈè!„OÆ(è\nB\néèêë#ˆËèØ\"ˆ‚‰ÂìíÅÆ$ˆÇìÆ\"ˆÈî!„xÆ.î\nB\néîêë#ˆËîØ\"ˆÈï!„’Æ/ï\nB\néïêð#ˆÈñ!„§Æ1ñ\nB\néñêò#ˆËïØ\"ˆËñØ\"ˆÙóô\"ˆÂõöÅÆ$ˆÇõÆ\"ˆõ‡" [viper-mode default-major-mode ad-add-advice fundamental-mode (vip-fundamental-mode-ad nil t (advice lambda nil "Run `vip-change-state-to-vi' on entry." (vip-change-state-to-vi))) after nil ad-activate-on boundp help-mode-hook current-load-list add-hook emacs-lisp-mode-hook html-mode-hook lisp-mode-hook bibtex-mode-hook cc-mode-hook c-mode-hook c++-mode-hook lisp-interaction-mode-hook text-mode-hook completion-list-mode-hook compilation-mode-hook emerge-startup-hook vip-change-state-to-emacs vip-eval-after-load "emerge" (defadvice emerge-quit (after vip-emerge-advice activate) "Run `vip-change-state-to-vi' after quitting emerge." (vip-change-state-to-vi)) emerge-quit (vip-emerge-advice nil t (advice lambda nil "Run `vip-change-state-to-vi' after quitting emerge." (vip-change-state-to-vi))) "asm-mode" (defadvice asm-mode (after vip-asm-mode-ad activate) "Run `vip-change-state-to-vi' on entry." (vip-change-state-to-vi)) "passwd" (defadvice read-passwd-1 (before vip-passwd-ad activate) "Switch to emacs state while reading password." (vip-change-state-to-emacs)) comint-mode-hook vip-change-state-to-insert vip-comint-mode-hook sh-mode-hook dired-mode-hook vip-emacs-p view-mode-hook put variable-documentation "View hook. Run after view mode." view-minor-mode (vip-view-ad nil t (advice lambda nil "Switch to Emacs state in View mode." (vip-change-state-to-emacs))) view-hook vm-mode-hooks "This hook is run after vm is started." vm-summary-mode-hooks "This hook is run after vm switches to summary mode." "rmailedit" (defadvice rmail-cease-edit (after vip-rmail-advice activate) "Switch to emacs state when done editing message." (vip-change-state-to-emacs)) rmail-cease-edit (vip-rmail-advice nil t (advice lambda nil "Switch to emacs state when done editing message." (vip-change-state-to-emacs)))] 5]) (byte-code "ÀÁ\nÃ\"ÄÅÆ$ˆÀÁ\nÇ\"ÄÈÆ$ˆÀÉÄÊÆ$ˆÀËÄÌÆ$ˆÍ!ƒ3„3Ð!ˆÑ\"ˆÔBÕBÖB×BØBÙBÚBÛB¯ÝÞß\"ˆà ˆá ˆ\"ƒqã ˆä ˆåæ!ˆåç!ˆåè!ˆåé!ˆåê!ˆåë!ˆåì!ˆåí!ˆåî!ˆåï!ˆåð!ˆñ23ô#ˆñ53ô#ˆñ56÷#ˆñ26ø#ˆñ96ú#ˆ„Û;üWƒÞ;ýVƒÞþ ˆ?@=ƒöA ˆBCC\"ˆDE!ˆFG!ˆFH!ˆFI!‡" [vip-record-kbd-macro vector vip-repeat-from-history-key \1 vi-state [(meta x) v i p - r e p e a t - f r o m - h i s t o r y return] t \2 [(meta x) v i p - r e p e a t - f r o m - h i s t o r y return] "//" [1 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] "///" [2 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] file-exists-p vip-custom-file-name noninteractive load vip-add-keymap vip-mode-map vip-vi-global-user-map vip-want-ctl-h-help vip-always vip-no-multiple-ESC vip-ex-style-motion vip-ex-style-editing-in-insert vip-want-emacs-keys-in-vi vip-want-emacs-keys-in-insert vip-re-search vip-saved-user-settings add-hook minibuffer-setup-hook vip-minibuffer-setup-sentinel vip-set-minibuffer-faces vip-set-search-face vip-buffer-search-char vip-buffer-search-enable vip-update-alphanumeric-class vip-harness-minor-mode "compile" "outline" "allout" "xref" "lmenu" "vc" "ltx-math" "latex" "cyrillic" "russian" "view-less" define-key vip-vi-intercept-map vip-ESC-key vip-intercept-ESC-key vip-insert-intercept-map vip-toggle-key vip-alternate-ESC (lambda nil (interactive) (if (and (< vip-expert-level 2) (equal vip-toggle-key "")) (if (vip-window-display-p) (vip-iconify) (suspend-emacs)) (vip-change-state-to-emacs))) vip-emacs-intercept-map vip-change-state-to-vi vip-expert-level 5 0 vip-set-hooks vip-current-state emacs-state vip-change-state-to-emacs set-default minor-mode-map-alist run-hooks vip-load-hook provide viper vip19 vip] 9) emacs-19.30/lisp/vms-patch.elc100666 13437 1 10373 5744600142 14626 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:57:21 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/vms-patch.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/vms-patch.el' was compiled for Emacs 19")) #@208 Create a suitably named buffer for visiting FILENAME, and return it. FILENAME (sans directory) is used unchanged if that name is free; otherwise a string <2> or <3> or ... is appended to get an unused name. (defalias 'create-file-buffer #[(filename) "ÀÁ\n!—!‡" [generate-new-buffer file-name-nondirectory filename] 3 (#$ . 488)]) (defalias 'make-legal-file-name #[(fn) "À !Âà G Wƒ H‰È=ƒ5ƒ/ ÉIˆ‚xÊ‚x\fËYƒA\fÌX„x\fÍYƒM\fÎX„x\fÏYƒY\fÐX„x\fÑ=„x\fÉ=„x\fÒ=ƒrÃV„x ÉIˆT‰‚, ‡" [copy-sequence fn nil 0 chr len indx dot 46 95 t 97 122 65 90 48 57 36 45] 5]) #@316 Return file name to use for auto-saves of current buffer. This function does not consider `auto-save-visited-file-name'; the caller should check that before calling this function. This is a separate function so that your `.emacs' file or the site's `site-init.el' can redefine it. See also `auto-save-file-name-p'. (defalias 'make-auto-save-file-name #[nil "ƒÁ!ÂÃ!ÄR‡ÅÆÇÈ !ÄQ!‡" [buffer-file-name file-name-directory "_$" file-name-nondirectory "$" expand-file-name "_$_" make-legal-file-name buffer-name] 4 (#$ . 1087)]) #@199 Return t if FILENAME can be yielded by `make-auto-save-file-name'. FILENAME should lack slashes. This is a separate function so that your `.emacs' file or the site's `site-init.el' can redefine it. (defalias 'auto-save-file-name-p #[(filename) "ÀÁ\n\"‡" [string-match "^_\\$.*\\$" filename] 3 (#$ . 1621)]) #@133 When resuming suspended Emacs, check for file to be found. If the logical name `EMACS_FILE_NAME' is defined, `find-file' that file. (defalias 'vms-suspend-resume-hook #[nil "ÀÁÂ\"ÀÁÃ\"ÀÁÄ\"„,…5È!ˆ …5ÉÊ !!‚5ËÌ!!ˆÍ +‡" [vms-system-info "LOGICAL" "EMACS_FILE_NAME" "EMACS_COMMAND_ARGS" "EMACS_FILE_LINE" line args file find-file goto-line string-to-int cd file-name-directory vms-command-line-again] 5 (#$ . 1935)]) (byte-code "ÀÀ‡" [vms-suspend-resume-hook suspend-resume-hook] 1) #@73 Don't allow suspending if logical name `DONT_SUSPEND_EMACS' is defined. (defalias 'vms-suspend-hook #[nil "ÀÁÂ\"ƒ ÃÄ!ˆÅ‡" [vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS" error "Can't suspend this emacs" nil] 3 (#$ . 2438)]) (byte-code "ÀÀ‡" [vms-suspend-hook suspend-hook] 1) #@261 Reprocess command line arguments. VMS specific. Command line arguments are initialized from the logical EMACS_COMMAND_ARGS which is defined by kepteditor.com. On VMS this allows attaching to a spawned Emacs and doing things like "emacs -l myfile.el -f doit" (defalias 'vms-command-line-again #[nil "ÀÁÂ\"—ÄCÆÆ G Ê …Í GWƒDÌ H‰ V„5Í Wƒ; ÎIˆT‰‚ GS HÎUƒZS‚I ÆTOÆÆ GWƒË GWƒÌ H‰ V„†Í WƒT‰„kT‰ GWƒ·Î H‰ Wƒ·Í Vƒ·T‰‚•Ï OC\"T‰‚eÐ .‡" [vms-system-info "LOGICAL" "EMACS_COMMAND_ARGS" args "emacs" command-line-args 0 beg end len nil this-char 33 127 32 append command-line] 6 (#$ . 2723)]) (defalias 'vms-read-directory #[(dirname switches buffer) "ŠqˆÁÂ Ä R\"ˆebˆÆÇ!ƒÈuˆÉ ˆ‚eb)‡" [buffer subprocess-command-to-buffer "DIRECTORY " switches " " dirname search-forward " \n" -1 delete-horizontal-space] 5]) (byte-code "ÀÂć" ["/SIZE/DATE/OWNER/WIDTH=(FILENAME=32,SIZE=5)" dired-listing-switches (lambda (start end command ign1 ign2 ign3 &rest switches) (write-region start end "sys$login:delete-me.txt") (send-command-to-subprocess 1 (concat command " sys$login:delete-me.txt/name=\"GNUprintbuffer\" " (mapconcat (quote identity) switches " ")) nil nil nil)) print-region-function nil] 1) #@283 Set up file assuming use by VMS Mail utility. The buffer is put into text-mode, auto-save is turned off and the following bindings are established. \[vms-pmail-save-and-exit] vms-pmail-save-and-exit \[vms-pmail-abort] vms-pmail-abort All other Emacs commands are still available. (autoload (quote vms-pmail-setup) "vms-pmail" '(#$ . 4002) t) emacs-19.30/lisp/vms-pmail.elc100666 13437 1 5346 5744600143 14616 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:57:22 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/vms-pmail.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/vms-pmail.el' was compiled for Emacs 19")) #@293 Save current buffer and exit emacs. If this emacs cannot be suspended, you will be prompted about modified buffers other than the mail buffer. BEWARE --- suspending emacs without saving your mail buffer causes mail to abort the send (potentially useful since the mail buffer is still here). (defalias 'vms-pmail-save-and-exit #[nil "À ˆÁÂÃ\"ƒÄ ˆÅÆ!‡Çp!ˆÈ ‡" [basic-save-buffer vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS" save-some-buffers kill-emacs 1 kill-buffer suspend-emacs] 3 (#$ . 488) nil]) #@213 Mark buffer as unmodified and exit emacs. When the editor is exited without saving its buffer, VMS mail does not send a message. If you have other modified buffers you will be prompted for what to do with them. (defalias 'vms-pmail-abort #[nil "ÀÁ!„  ‡Ã ˆÄÅÆ\"ƒÇ ˆÈÉ!‡Êp!ˆË ‡" [yes-or-no-p "Really abort mail? " ding not-modified vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS" save-some-buffers kill-emacs 1 kill-buffer suspend-emacs] 3 (#$ . 999) nil]) #@283 Set up file assuming use by VMS MAIL utility. The buffer is put into text-mode, auto-save is turned off and the following bindings are established. \[vms-pmail-save-and-exit] vms-pmail-save-and-exit \[vms-pmail-abort] vms-pmail-abort All other emacs commands are still available. (defalias 'vms-pmail-setup #[nil "ÀÁ!ˆÂ ˆÃÄÅ\"ÆÇ !ÈÇ ! \n \n̘ƒ,Í !ˆ  PÎÏÐ !!ˆÑÒÓ\"ˆÑÔÕ\"+‡" [auto-save-mode -1 text-mode vms-system-info "LOGICAL" "SYS$SCRATCH" file-name-directory buffer-file-name file-name-nondirectory filename directory default "SYS$SCRATCH:" cd use-local-map copy-keymap current-local-map local-set-key "" vms-pmail-save-and-exit "" vms-pmail-abort] 4 (#$ . 1465) nil]) #@68 Prepares received mail for re-sending by placing >'s on each line. (defalias 'indicate-mail-reply-text #[nil "ebˆm„ÀcˆÁyˆÂyˆ‚ÃÄ!ˆeb‡" [">" 0 1 set-buffer-modified-p nil] 2 (#$ . 2159) nil]) #@214 Moves to the end of the buffer and inserts a "signature" file. First try the file indicated by environment variable MAIL$TRAILER. If that fails, try the file "~/.signature". If neither file exists, fails quietly. (defalias 'insert-signature #[nil "À ˆÁ ˆÂÃÄ\"…&ÅÂÃÄ\"!ƒÆÂÃÄ\"!‡ÅÇ!…&ÆÇ!‡" [end-of-buffer newline vms-system-info "LOGICAL" "MAIL$TRAILER" file-attributes insert-file-contents "~/.signature"] 4 (#$ . 2360) nil]) emacs-19.30/lisp/vmsproc.elc100666 13437 1 5517 5744600143 14402 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:57:23 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/vmsproc.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/vmsproc.el' was compiled for Emacs 19")) #@75 If non-nil, the suprocess window is displayed whenever input is received. (defvar display-subprocess-window nil (#$ . 483)) #@59 String to insert to distinguish commands entered by user. (defvar command-prefix-string "$ " (#$ . 613)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ B\f„+Å Æ\fÇÈ#ˆÆ\fÉÊ#ˆÂ‡" [boundp subprocess-running nil current-load-list command-mode-map make-sparse-keymap define-key " " command-send-input "" command-kill-line] 4) #@52 Handles input from a subprocess. Called by Emacs. (defalias 'subprocess-input #[(name str) "ƒÁ\n!ˆp\nqˆdbˆ\fcˆÅcˆ q)‡" [display-subprocess-window display-buffer subprocess-buf old-buffer str 10] 2 (#$ . 931)]) #@39 Called by Emacs upon subprocess exit. (defalias 'subprocess-exit #[(name) "À‰‡" [nil subprocess-running] 2 (#$ . 1152)]) #@189 Spawns an asynchronous subprocess with output redirected to the buffer *COMMAND*. Within this buffer, use C-m to send the last line to the subprocess or to bring another line to the end. (defalias 'start-subprocess #[nil "ƒ ÁÂÃ\"ˆÄÅ!ŠqˆÇ!ˆ)ÉÊËÌ#‰…'ÍÊÎ\"‡" [subprocess-running throw --cl-block-nil-- t get-buffer-create "*COMMAND*" subprocess-buf use-local-map command-mode-map spawn-subprocess 1 subprocess-input subprocess-exit send-command-to-subprocess "ON SEVERE_ERROR THEN CONTINUE"] 5 (#$ . 1281)]) #@50 Execute COMMAND and redirect output into BUFFER. (defalias 'subprocess-command-to-buffer #[(command buffer) "À‰ ÄÅÆ \"O ÅÆ \"ÀOÇ\nÀÀÉ &*‡" [nil args cmd command 0 string-match " " call-process buffer "*dcl*"] 7 (#$ . 1803)]) #@75 Starts asynchronous subprocess if not running and switches to its window. (defalias 'subprocess-command #[nil "„Á ˆ… !ˆdb‡" [subprocess-running start-subprocess pop-to-buffer subprocess-buf] 2 (#$ . 2041) nil]) #@149 If at last line of buffer, sends the current line to the spawned subprocess. Otherwise brings back current line to the last line for resubmission. (defalias 'command-send-input #[nil "Àyˆ`Áˆ`{mƒ3 „Ä ˆ …UÀyˆÅÆ\n\"ˆƒ-ÀyˆcˆÈÆ!‚UÉ ˆÊ ˆÈÆ!ˆ\nÀGO˜ƒS\nGÁOc‚U\nc)‡" [0 nil current-line subprocess-running start-subprocess send-command-to-subprocess 1 command-prefix-string next-line end-of-buffer backward-char] 4 (#$ . 2266) nil]) #@48 Kills the current line. Used in command mode. (defalias 'command-kill-line #[nil "ÀyˆÁ ‡" [0 kill-line] 1 (#$ . 2717) nil]) (define-key esc-map "$" (quote subprocess-command)) emacs-19.30/lisp/vt100-led.elc100666 13437 1 2471 5744600145 14323 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:57:24 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/vt100-led.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/vt100-led.el' was compiled for Emacs 19")) #@85 The internal state of the LEDs. Choices are nil, t, `flash. Element 0 is not used. (defvar led-state (make-vector 5 nil) (#$ . 487)) #@14 Flash LED l. (defalias 'led-flash #[(l) " ÂIˆÃ ‡" [led-state l flash led-update] 3 (#$ . 627)]) #@68 Turn off vt100 led number L. With no argument, turn them all off. (defalias 'led-off #[(&optional l) "ƒ Â!ÃIˆ‚Ä Ã\"ˆÅ ‡" [l led-state prefix-numeric-value nil fillarray led-update] 3 (#$ . 730) "P"]) #@16 Turn on LED l. (defalias 'led-on #[(l) " ÂIˆÃ ‡" [led-state l t led-update] 3 (#$ . 943)]) #@59 Update the terminal's LEDs to reflect the internal state. (defalias 'led-update #[nil "ÀÁ ÆU„6 H‰É=ƒ\" ÊË !Q‚.ƒ.\fÊË !Q) T‰‚\fÌ ÍRÎ\f!+‡" ["[?0" "[0" 1 l o f 5 led-state s flash ";" int-to-string "q" "t" send-string-to-terminal] 5 (#$ . 1041)]) (provide (quote vt100-led)) emacs-19.30/lisp/window.elc100666 13437 1 16674 6051030074 14236 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 11 00:10:11 1995 ;;; from file /home/fsf/rms/e19/lisp/window.el ;;; emacs version 19.29.1.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`window.el' was compiled for Emacs 19.29 or later")) #@473 Returns non-nil if the selected window is the only window (in its frame). Optional arg NOMINI non-nil means don't count the minibuffer even if it is active. The optional arg ALL-FRAMES t means count windows on all frames. If it is `visible', count windows on all visible frames. ALL-FRAMES nil or omitted means count only the selected frame, plus the minibuffer it uses (which may be on another frame). If ALL-FRAMES is neither nil nor t, count only the selected frame. (defalias 'one-window-p #[(&optional nomini all-frames) "À \nƒ à =ƒÄ ! Ä \n…Å#)=‡" [selected-window base-window nomini minibuffer-window next-window arg all-frames] 5 (#$ . 473)]) #@1125 Cycle through all visible windows, calling PROC for each one. PROC is called with a window as argument. Optional second arg MINIBUF t means count the minibuffer window even if not active. MINIBUF nil or omitted means count the minibuffer iff it is active. MINIBUF neither t nor nil means not to count the minibuffer even if it is active. Several frames may share a single minibuffer; if the minibuffer counts, all windows on all frames that share that minibuffer count too. Therefore, when a separate minibuffer frame is active, `walk-windows' includes the windows in the frame from which you entered the minibuffer, as well as the minibuffer window. But if the minibuffer does not count, only windows from WINDOW's frame count. ALL-FRAMES is the optional third argument. ALL-FRAMES nil or omitted means cycle within the frames as specified above. ALL-FRAMES = `visible' means include windows on all visible frames. ALL-FRAMES = 0 means include windows on all visible and iconified frames. ALL-FRAMES = t means include windows on all frames including invisible frames. Anything else means restrict to WINDOW's frame. (defalias 'walk-windows #[(proc &optional minibuf all-frames) "ÀÁ !ƒ ÂÁ ‰Æ # !ˆ \f=?…$‚*‡" [window-minibuffer-p selected-window t minibuf walk-windows-start walk-windows-current next-window all-frames proc] 5 (#$ . 1143)]) #@57 Return t if WINDOW (a minibuffer window) is now active. (defalias 'minibuffer-window-active-p #[(window) "Á =‡" [window active-minibuffer-window] 2 (#$ . 2509)]) #@69 Execute BODY, then select the window that was selected before BODY. (defalias 'save-selected-window '(macro . #[(&rest body) "ÀÁÂÃ\fBÅÆDEE‡" [let ((save-selected-window-window (selected-window))) unwind-protect progn body select-window save-selected-window-window] 6 (#$ . 2678)])) #@124 Returns the number of visible windows. Optional arg NO-MINI non-nil means don't count the minibuffer even if it is active. (defalias 'count-windows #[(&optional minibuf) "ÀÂÃ\f\"ˆ )‡" [0 count walk-windows #[(w) "Á\\‰‡" [count 1] 2] minibuf] 3 (#$ . 2967)]) #@60 Makes all visible windows the same height (approximately). (defalias 'balance-windows #[nil "ÀÁ‰‰ÂÃÄ !!A@ Ê‹ˆË Z ¥ÌÍÎ\"ˆÌÏÎ\"-‡" [-1 nil window-edges frame-first-window selected-frame mbl size newsizes levels count ((byte-code "ÀÁÄÅÆ\"ˆÇ È\"‰ƒ3 @\nTVƒ\" @ T @ B\nB\n A‰„ T *À‡" [nil -2 prev-top tops walk-windows #[(w) "À !A@\nB‰‡" [window-edges w tops] 2] nomini sort < count levels] 4)) frame-height walk-windows #[(w) "À !ˆÂ A@ žAÄ Â A@\\ žA†  Z_B B‰ *‡" [select-window w window-edges levels window-height count newbot newtop size newsizes] 4] nomini #[(w) "À !ˆ \nžAÄ Å Z!)‡" [select-window w newsizes newsize enlarge-window window-height] 3]] 7 (#$ . 3234) nil]) #@253 *If non-nil, split windows keeps the original point in both children. This is often more convenient for editing. If nil, adjust point in each of the two windows to minimize redisplay. This is convenient on slow terminals, but point can move strangely. (defvar split-window-keep-point t (#$ . -3954)) #@746 Split current window into two windows, one above the other. The uppermost window gets ARG lines and the other gets the rest. Negative arg means select the size of the lowermost window instead. With no argument, split equally or close to it. Both windows display the same buffer now current. If the variable split-window-keep-point is non-nil, both new windows will get the same value of point as the current window. This is often more convenient for editing. Otherwise, we chose window starts so as to minimize the amount of redisplay; this is convenient on slow terminals. The new selected window is the one that the current value of point appears in. The value of point can change if the text around point is hidden by the new mode line. (defalias 'split-window-vertically #[(&optional arg) "À ` …\n !ɉ ƒ*ÊWƒ*Ë \\ÌÃ\" „ƒŠÎ qˆÏ bˆÐË !ˆÑ`\"ˆ`Ò!VƒYÓ`\"ˆÐÔ!ˆ`) `XƒmÓ S\"ˆÏ!WƒƒÓ\"ˆÕ!ˆ.‡" [selected-window arg prefix-numeric-value nil switch bottom new-w size old-point old-w 0 window-height split-window split-window-keep-point window-buffer window-start vertical-motion set-window-start window-point set-window-point -1 select-window] 6 (#$ . 4261) "P"]) #@216 Split current window into two windows side by side. This window becomes the leftmost of the two, and gets ARG columns. Negative arg means select the size of the rightmost window instead. No arg means split equally. (defalias 'split-window-horizontally #[(&optional arg) "…Á!‰ƒ\nÃWƒÄ \n\\ÅÆ\nÇ#)‡" [arg prefix-numeric-value size 0 window-width split-window nil t] 5 (#$ . 5480) "P"]) #@40 Make current window ARG columns wider. (defalias 'enlarge-window-horizontally #[(arg) "À Â\"‡" [enlarge-window arg t] 3 (#$ . 5879) "p"]) #@43 Make current window ARG columns narrower. (defalias 'shrink-window-horizontally #[(arg) "À Â\"‡" [shrink-window arg t] 3 (#$ . 6023) "p"]) #@367 Shrink the WINDOW to be as small as possible to display its contents. Do not shrink to less than `window-min-height' lines. Do nothing if the buffer contains more lines than the present window height, or if some of the window's contents are scrolled out of view, or if the window is not the full width of the frame, or if the window is the only window of its frame. (defalias 'shrink-window-if-larger-than-buffer #[(&optional window) "„Á ŠÂ!qˆÁ \f`Æm?…!dSfÈ= Ê Ì  pÏÐ!!ÒžAÔÁ !Ö× ÙÐ!!ˆÚŽÛ *W…ÎÜ!ÝÐ!!U…ÎÞe\"…Îß=?…΃à8Ô!A@W„A@ážAV…ÎâŽã†˜ !ˆebˆÞd ƒ¨Ö‚©ÆZ!ƒ»ÊÈcˆT‚ÆV…ÍäSå &Z^!).\f‡" [window selected-window window-buffer w buffer-file-name p 0 n 10 ignore-final-newline nil buffer-read-only buffer-modified-p modified buffer frame-parameters window-frame params minibuffer mini window-edges edges 1 selected-frame frame select-frame ((select-frame frame)) count-windows window-width frame-width pos-visible-in-window-p only 3 menu-bar-lines ((byte-code "e`|ˆÀ !ˆ\nbˆÃ\f!ˆ q‡" [set-buffer-modified-p modified p select-window w buffer] 2)) select-window shrink-window window-height window-min-height] 4 (#$ . 6169) nil]) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#‡" [define-key ctl-x-map "2" split-window-vertically "3" split-window-horizontally "}" enlarge-window-horizontally "{" shrink-window-horizontally "-" shrink-window-if-larger-than-buffer "+" balance-windows] 4) emacs-19.30/lisp/winnt.elc100666 12120 1 6170 5770163733 13720 0ustar rmsdaemon;ELC ;;; compiled by kwzh@hill.gnu.ai.mit.edu on Thu Jun 15 22:09:28 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/winnt.el ;;; emacs version 19.28.94.4. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`winnt.el' was compiled for Emacs 19.29 or later")) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÊËÌÍ!ÎÏÌÐ!ÑÌÒ!ÌÓ!ÔÕÖÌ×!ÌØ!ÌÙ!ÌÚ!ÌÛ!¯\"ˆÜÞà!â#ä%À‡" [define-key function-key-map [backspace] "" [delete] "" [M-backspace] [-134217601] [C-M-backspace] [C-M-delete] set-default mode-line-format purecopy "" mode-line-modified mode-line-buffer-identification " " global-mode-string " %[(" "%t:" mode-name mode-line-process minor-mode-alist "%n" ")%]--" (line-number-mode "L%l--") (-3 . "%p") "-%-" t completion-ignore-case "/c" shell-command-switch ";" path-separator "NUL" grep-null-device (("^\\(\\([a-zA-Z]:\\)?[^:( \n]+\\)[:( ]+\\([0-9]+\\)[:) ]" 1 3)) grep-regexp-alist] 18) #@187 *Alist for distinguishing text files from binary files. Each element has the form (REGEXP . TYPE), where REGEXP is matched against the file name, and TYPE is nil for text, t for binary. (defvar file-name-buffer-file-type-alist (quote (("[:/].*config.sys$") ("\\.elc$" . t) ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t) ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t) ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t) ("\\.tp[ulpw]$" . t) ("[:/]tags$" . t))) (#$ . -1103)) (defalias 'find-buffer-file-type #[(filename) "Á‰ÅÇ! „-\fƒ-É\f@@\"ƒ'\f@AÅ\fA‚) ƒN\nÊ>ƒ<\n‚P\n9…PË\n!…P\n!‚P\f+‡" [file-name-buffer-file-type-alist nil code found alist t case-fold-search file-name-sans-versions filename string-match (nil t) fboundp default-buffer-file-type] 3]) #@45 Visit file FILENAME and treat it as binary. (defalias 'find-file-binary #[(filename) "À !)‡" [(("" . t)) file-name-buffer-file-type-alist find-file filename] 2 (#$ . 1912) "FFind file binary: "]) #@50 Visit file FILENAME and treat it as a text file. (defalias 'find-file-text #[(filename) "À !)‡" [(("")) file-name-buffer-file-type-alist find-file filename] 2 (#$ . 2116) "FFind file text: "]) (defalias 'find-file-not-found-set-buffer-file-type #[nil "ŠpqˆÀÁ !)Ç" [find-buffer-file-type buffer-file-name buffer-file-type nil] 2]) (add-hook (quote find-file-not-found-hooks) (quote find-file-not-found-set-buffer-file-type)) (defalias 'save-to-unix-hook #[nil "ŠÀ)‡" [t buffer-file-type nil] 1]) (defalias 'revert-from-unix-hook #[nil "ŠÀÁ !)Ç" [find-buffer-file-type buffer-file-name buffer-file-type nil] 2]) (defalias 'using-unix-filesystems #[(flag) "ƒÁÂÃ\"ˆÁÄÃ\"ˆÁÅÆ\"‡ÇÂÃ\"ˆÇÄÃ\"ˆÇÅÆ\"‡" [flag add-hook write-file-hooks save-to-unix-hook write-contents-hooks after-save-hook revert-from-unix-hook remove-hook] 3]) (byte-code "ÀÁÂ\"ˆÃÄMˆÅÆ!ˆÇÈ!ˆÇÉ!ˆÇÊ!ˆËÌ!‡" [defalias x-set-selection ignore x-get-selection (lambda (&rest rest) "") fmakunbound font-menu-add-default global-unset-key [C-down-mouse-1] [C-down-mouse-2] [C-down-mouse-3] set-message-beep nil] 3) emacs-19.30/lisp/ws-mode.elc100666 13437 1 42474 6021172367 14310 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Aug 30 19:31:51 1995 ;;; from file /home/fsf/rms/e19/lisp/ws-mode.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`ws-mode.el' was compiled for Emacs 19.29 or later")) #@2  (defvar wordstar-mode-map nil (#$ . 468)) #@2  (defvar wordstar-C-j-map nil (#$ . 516)) #@2  (defvar wordstar-C-k-map nil (#$ . 563)) #@2  (defvar wordstar-C-o-map nil (#$ . 610)) #@2  (defvar wordstar-C-q-map nil (#$ . 657)) (byte-code "„(Á Á Á Á ÅÆÇ#ˆÅÈÉ#ˆÅÊË#ˆÅÌÍ#ˆÅÎÏ#ˆÅÐÑ#ˆÅÒÓ#ˆÅÔÕ#ˆÅÖ×#ˆÅØÙ#ˆÅÚ\n#ˆÅÛÜ#ˆÅÝÞ#ˆÅß #ˆÅàá#ˆÅâ\f#ˆÅãä#ˆÅåÕ#ˆÅæç#ˆÅèé#ˆÅêë#ˆÅìí#ˆÅîï#ˆÅðñ#ˆÅòó#ˆÅ\nôõ#ˆÅ\nö÷#ˆÅ\nøù#ˆÅ\núû#ˆÅ\nüý#ˆÅ\nþÿ#ˆÅ\n@A#ˆÅ\nBC#ˆÅ\nDE#ˆÅ\nFG#ˆÅ\nHI#ˆÅ\nJK#ˆÅ\nÈK#ˆÅ\nLM#ˆÅ\nÊM#ˆÅ\nNO#ˆÅ\nÌO#ˆÅ\nPQ#ˆÅ\nÐQ#ˆÅ\nRS#ˆÅ\nÔS#ˆÅ\nTU#ˆÅ\nÖU#ˆÅ\nVW#ˆÅ\nÚW#ˆÅ\nXY#ˆÅ\nàY#ˆÅ\nZ[#ˆÅ\nâ[#ˆÅ\n\\]#ˆÅ\nã]#ˆÅ\n^_#ˆÅ\nå_#ˆÅ\n`a#ˆÅ\næa#ˆÅ\nbc#ˆÅ\nèé#ˆÅ\nde#ˆÅ\nêe#ˆÅ\nfg#ˆÅ\nìg#ˆÅ\nhO#ˆÅ\nîO#ˆÅ\nij#ˆÅ\nðj#ˆÅ ôõ#ˆÅ Lk#ˆÅ Êk#ˆÅ Jl#ˆÅ Èl#ˆÅ mn#ˆÅ Øn#ˆÅ Vo#ˆÅ Úo#ˆÅ pq#ˆÅ Ûq#ˆÅ rs#ˆÅ ts#ˆÅ \\u#ˆÅ ãu#ˆÅ èé#ˆÅ vw#ˆÅ xy#ˆÅ z{#ˆÅ |}#ˆÅ\fôõ#ˆÅ\fö~#ˆÅ\fø#ˆÅ\fú€#ˆÅ\fü#ˆÅ\fþ‚#ˆÅ\f@ƒ#ˆÅ\fB„#ˆÅ\fD…#ˆÅ\fF†#ˆÅ\fH‡#ˆÅ\fˆ‰#ˆÅ\fƉ#ˆÅ\fJŠ#ˆÅ\fÈŠ#ˆÅ\fL‹#ˆÅ\fÊ‹#ˆÅ\fNŒ#ˆÅ\fÌŒ#ˆÅ\fP#ˆÅ\fÐ#ˆÅ\fVŽ#ˆÅ\fÚŽ#ˆÅ\fp#ˆÅ\fÛ#ˆÅ\fX#ˆÅ\fà#ˆÅ\f\\‘#ˆÅ\fã‘#ˆÅ\f^’#ˆÅ\få’#ˆÅ\fèé#ˆÅ\ff“#ˆÅ\fì“#ˆÅ\fi”#ˆÅ\fð”#ˆÅ\f•–#ˆõ‡" [wordstar-mode-map make-keymap wordstar-C-k-map wordstar-C-o-map wordstar-C-q-map define-key "" backward-word "" fill-paragraph "" scroll-up "" forward-char "" previous-line "" forward-word "" delete-char "" backward-char " " indent-for-tab-command "\n" help-for-help " " "\f" ws-repeat-search "" open-line "" "" quoted-insert "" "" scroll-down "" "" kill-word "" keyboard-quit "" overwrite-mode "" scroll-down-line "" next-line "" kill-complete-line "" scroll-up-line " " nil "0" ws-set-marker-0 "1" ws-set-marker-1 "2" ws-set-marker-2 "3" ws-set-marker-3 "4" ws-set-marker-4 "5" ws-set-marker-5 "6" ws-set-marker-6 "7" ws-set-marker-7 "8" ws-set-marker-8 "9" ws-set-marker-9 "b" ws-begin-block "c" ws-copy-block "d" save-buffers-kill-emacs "f" find-file "h" ws-show-markers "i" ws-indent-block "k" ws-end-block "p" ws-print-block "q" kill-emacs "r" insert-file "s" save-some-buffers "t" ws-mark-word "u" ws-exdent-block "v" ws-move-block "w" ws-write-block "x" "y" ws-delete-block wordstar-center-line switch-to-buffer "j" justify-current-line kill-buffer "l" list-buffers "m" auto-fill-mode " " set-fill-column "wd" delete-other-windows "wh" split-window-horizontally "wo" other-window "wv" split-window-vertically ws-find-marker-0 ws-find-marker-1 ws-find-marker-2 ws-find-marker-3 ws-find-marker-4 ws-find-marker-5 ws-find-marker-6 ws-find-marker-7 ws-find-marker-8 ws-find-marker-9 "a" ws-query-replace ws-goto-block-begin end-of-buffer end-of-line ws-search ws-goto-block-end ws-undo ws-last-cursorp beginning-of-buffer beginning-of-line ws-last-error ws-kill-eol "" ws-kill-bol] 4) #@2442 Major mode with WordStar-like key bindings. BUGS: - Help menus with WordStar commands (C-j just calls help-for-help) are not implemented - Options for search and replace - Show markers (C-k h) is somewhat strange - Search and replace (C-q a) is only available in forward direction No key bindings beginning with ESC are installed, they will work Emacs-like. The key bindings are: C-a backward-word C-b fill-paragraph C-c scroll-up-line C-d forward-char C-e previous-line C-f forward-word C-g delete-char C-h backward-char C-i indent-for-tab-command C-j help-for-help C-k ordstar-C-k-map C-l ws-repeat-search C-n open-line C-p quoted-insert C-r scroll-down-line C-s backward-char C-t kill-word C-u keyboard-quit C-v overwrite-mode C-w scroll-down C-x next-line C-y kill-complete-line C-z scroll-up C-k 0 ws-set-marker-0 C-k 1 ws-set-marker-1 C-k 2 ws-set-marker-2 C-k 3 ws-set-marker-3 C-k 4 ws-set-marker-4 C-k 5 ws-set-marker-5 C-k 6 ws-set-marker-6 C-k 7 ws-set-marker-7 C-k 8 ws-set-marker-8 C-k 9 ws-set-marker-9 C-k b ws-begin-block C-k c ws-copy-block C-k d save-buffers-kill-emacs C-k f find-file C-k h ws-show-markers C-k i ws-indent-block C-k k ws-end-block C-k p ws-print-block C-k q kill-emacs C-k r insert-file C-k s save-some-buffers C-k t ws-mark-word C-k u ws-exdent-block C-k C-u keyboard-quit C-k v ws-move-block C-k w ws-write-block C-k x kill-emacs C-k y ws-delete-block C-o c wordstar-center-line C-o b switch-to-buffer C-o j justify-current-line C-o k kill-buffer C-o l list-buffers C-o m auto-fill-mode C-o r set-fill-column C-o C-u keyboard-quit C-o wd delete-other-windows C-o wh split-window-horizontally C-o wo other-window C-o wv split-window-vertically C-q 0 ws-find-marker-0 C-q 1 ws-find-marker-1 C-q 2 ws-find-marker-2 C-q 3 ws-find-marker-3 C-q 4 ws-find-marker-4 C-q 5 ws-find-marker-5 C-q 6 ws-find-marker-6 C-q 7 ws-find-marker-7 C-q 8 ws-find-marker-8 C-q 9 ws-find-marker-9 C-q a ws-query-replace C-q b ws-to-block-begin C-q c end-of-buffer C-q d end-of-line C-q f ws-search C-q k ws-to-block-end C-q l ws-undo C-q p ws-last-cursorp C-q r beginning-of-buffer C-q C-u keyboard-quit C-q w ws-last-error C-q y ws-kill-eol C-q DEL ws-kill-bol  (defalias 'wordstar-mode #[nil "À ˆÁ\n!ˆÃʼn‡" [kill-all-local-variables use-local-map wordstar-mode-map "WordStar" mode-name wordstar-mode major-mode] 2 (#$ . 3486) nil]) #@96 Center each line in the paragraph at or after point. See `wordstar-center-line' for more info. (defalias 'wordstar-center-paragraph #[nil "ŠÀ ˆn„\fÁÂ!ˆ`Ä ˆÅ` \"*‡" [forward-paragraph newline 1 end backward-paragraph wordstar-center-region] 3 (#$ . 6107) nil]) #@84 Center each line starting in the region. See `wordstar-center-line' for more info. (defalias 'wordstar-center-region #[(from to) " Vƒ \n)ŠŒ }ˆbˆm?…$à ˆÄyˆ‚*‡" [from to tem wordstar-center-line 1] 2 (#$ . 6375) "r"]) #@181 Center the line point is on, within the width specified by `fill-column'. This means adjusting the indentation to match the distance between the end of the text and `fill-column'. (defalias 'wordstar-center-line #[nil "ŠÀÂyˆÃ ˆÀˆÃ ˆiÂyˆ\f \fZ ZÆ¥\\j*‡" [nil line-length 0 delete-horizontal-space left-margin fill-column 2] 3 (#$ . 6610) nil]) #@23 Scroll one line down. (defalias 'scroll-down-line #[nil "ÀÁ!‡" [scroll-down 1] 2 (#$ . 6962) nil]) #@21 Scroll one line up. (defalias 'scroll-up-line #[nil "ÀÁ!‡" [scroll-up 1] 2 (#$ . 7067) nil]) #@37 Position marker 0 in WordStar mode. (defvar ws-marker-0 nil (#$ . 7166)) #@37 Position marker 1 in WordStar mode. (defvar ws-marker-1 nil (#$ . 7245)) #@37 Position marker 2 in WordStar mode. (defvar ws-marker-2 nil (#$ . 7324)) #@37 Position marker 3 in WordStar mode. (defvar ws-marker-3 nil (#$ . 7403)) #@37 Position marker 4 in WordStar mode. (defvar ws-marker-4 nil (#$ . 7482)) #@37 Position marker 5 in WordStar mode. (defvar ws-marker-5 nil (#$ . 7561)) #@37 Position marker 6 in WordStar mode. (defvar ws-marker-6 nil (#$ . 7640)) #@37 Position marker 7 in WordStar mode. (defvar ws-marker-7 nil (#$ . 7719)) #@37 Position marker 8 in WordStar mode. (defvar ws-marker-8 nil (#$ . 7798)) #@37 Position marker 9 in WordStar mode. (defvar ws-marker-9 nil (#$ . 7877)) #@40 Beginning of "Block" in WordStar mode. (defvar ws-block-begin-marker nil (#$ . 7956)) #@34 End of "Block" in WordStar mode. (defvar ws-block-end-marker nil (#$ . 8048)) #@41 String of last search in WordStar mode. (defvar ws-search-string nil (#$ . 8132)) #@75 Direction of last search in WordStar mode. T if forward, NIL if backward. (defvar ws-search-direction t (#$ . 8220)) #@52 Position before last search etc. in WordStar mode. (defvar ws-last-cursorposition nil (#$ . 8343)) #@56 Last error message issued by a WordStar mode function. (defvar ws-last-errormessage nil (#$ . 8448)) #@118 Report error of a WordStar special function. Error message is saved in ws-last-errormessage for recovery with C-q w. (defalias 'ws-error #[(string) "Â!‡" [string ws-last-errormessage error] 2 (#$ . 8556)]) #@60 In WordStar mode: Set marker 0 to current cursor position. (defalias 'ws-set-marker-0 #[nil "À ÂÃ!‡" [point-marker ws-marker-0 message "Marker 0 set"] 2 (#$ . 8771) nil]) #@60 In WordStar mode: Set marker 1 to current cursor position. (defalias 'ws-set-marker-1 #[nil "À ÂÃ!‡" [point-marker ws-marker-1 message "Marker 1 set"] 2 (#$ . 8949) nil]) #@60 In WordStar mode: Set marker 2 to current cursor position. (defalias 'ws-set-marker-2 #[nil "À ÂÃ!‡" [point-marker ws-marker-2 message "Marker 2 set"] 2 (#$ . 9127) nil]) #@60 In WordStar mode: Set marker 3 to current cursor position. (defalias 'ws-set-marker-3 #[nil "À ÂÃ!‡" [point-marker ws-marker-3 message "Marker 3 set"] 2 (#$ . 9305) nil]) #@60 In WordStar mode: Set marker 4 to current cursor position. (defalias 'ws-set-marker-4 #[nil "À ÂÃ!‡" [point-marker ws-marker-4 message "Marker 4 set"] 2 (#$ . 9483) nil]) #@60 In WordStar mode: Set marker 5 to current cursor position. (defalias 'ws-set-marker-5 #[nil "À ÂÃ!‡" [point-marker ws-marker-5 message "Marker 5 set"] 2 (#$ . 9661) nil]) #@60 In WordStar mode: Set marker 6 to current cursor position. (defalias 'ws-set-marker-6 #[nil "À ÂÃ!‡" [point-marker ws-marker-6 message "Marker 6 set"] 2 (#$ . 9839) nil]) #@60 In WordStar mode: Set marker 7 to current cursor position. (defalias 'ws-set-marker-7 #[nil "À ÂÃ!‡" [point-marker ws-marker-7 message "Marker 7 set"] 2 (#$ . 10017) nil]) #@60 In WordStar mode: Set marker 8 to current cursor position. (defalias 'ws-set-marker-8 #[nil "À ÂÃ!‡" [point-marker ws-marker-8 message "Marker 8 set"] 2 (#$ . 10196) nil]) #@60 In WordStar mode: Set marker 9 to current cursor position. (defalias 'ws-set-marker-9 #[nil "À ÂÃ!‡" [point-marker ws-marker-9 message "Marker 9 set"] 2 (#$ . 10375) nil]) #@70 In WordStar mode: Set block begin marker to current cursor position. (defalias 'ws-begin-block #[nil "À ÂÃ!‡" [point-marker ws-block-begin-marker message "Block begin marker set"] 2 (#$ . 10554) nil]) #@39 In WordStar mode: Show block markers. (defalias 'ws-show-markers #[nil "„ ƒ>ŠƒbˆÂÃ!ˆÄÅ!ˆ‚#ÂÆ!ˆÄÅ!ˆ ƒ5 bˆÂÇ!ˆÄÅ!ˆ‚9ÂÈ!ˆÂÉ!)‡ÂÊ!‡" [ws-block-begin-marker ws-block-end-marker message "Block begin marker" sit-for 2 "Block begin marker not set" "Block end marker" "Block end marker not set" "" "Block markers not set"] 2 (#$ . 10762) nil]) #@55 In WordStar mode: Indent block (not yet implemented). (defalias 'ws-indent-block #[nil "ÀÁ!‡" [ws-error "Indent block not yet implemented"] 2 (#$ . 11114) nil]) #@68 In WordStar mode: Set block end marker to current cursor position. (defalias 'ws-end-block #[nil "À ÂÃ!‡" [point-marker ws-block-end-marker message "Block end marker set"] 2 (#$ . 11281) nil]) #@32 In WordStar mode: Print block. (defalias 'ws-print-block #[nil "ÀÁ!‡" [message "Don't do this. Write block to a file (C-k w) and print this file."] 2 (#$ . 11481) nil]) #@47 In WordStar mode: Mark current word as block. (defalias 'ws-mark-word #[nil "ŠÀvˆÁÀ!ˆÂ ˆÃvˆÁÀ!ˆÄ )‡" [1 sit-for ws-end-block -1 ws-begin-block] 2 (#$ . 11656) nil]) #@43 I don't know what this (C-k u) should do. (defalias 'ws-exdent-block #[nil "ÀÁ!‡" [ws-error "This won't be done -- not yet implemented."] 2 (#$ . 11827) nil]) #@58 In WordStar mode: Move block to current cursor position. (defalias 'ws-move-block #[nil "ƒ\" ƒ\" \"ˆÃ ˆŠÄ bˆÅ Æ bˆÅ ‰)‡Çƒ+È‚4 ƒ3É‚4Ê!‡" [ws-block-begin-marker ws-block-end-marker kill-region yank region-beginning point-marker region-end ws-error "Block end marker not set" "Block begin marker not set" "Block markers not set"] 3 (#$ . 11992) nil]) #@40 In WordStar mode: Write block to file. (defalias 'ws-write-block #[nil "ƒ ƒÂÃ!Å \f#)‡ÆƒÇ‚% ƒ$È‚%É!‡" [ws-block-begin-marker ws-block-end-marker read-file-name "Write block to file: " filename write-region ws-error "Block end marker not set" "Block begin marker not set" "Block markers not set"] 4 (#$ . 12358) nil]) #@33 In WordStar mode: Delete block. (defalias 'ws-delete-block #[nil "ƒ ƒÂ \"ˆÃɇăł% ƒ$Æ‚%Ç!‡" [ws-block-begin-marker ws-block-end-marker kill-region nil ws-error "Block end marker not set" "Block begin marker not set" "Block markers not set"] 3 (#$ . 12693) nil]) #@35 In WordStar mode: Go to marker 0. (defalias 'ws-find-marker-0 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-0 point-marker ws-last-cursorposition ws-error "Marker 0 not set"] 2 (#$ . 12977) nil]) #@35 In WordStar mode: Go to marker 1. (defalias 'ws-find-marker-1 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-1 point-marker ws-last-cursorposition ws-error "Marker 1 not set"] 2 (#$ . 13168) nil]) #@35 In WordStar mode: Go to marker 2. (defalias 'ws-find-marker-2 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-2 point-marker ws-last-cursorposition ws-error "Marker 2 not set"] 2 (#$ . 13359) nil]) #@35 In WordStar mode: Go to marker 3. (defalias 'ws-find-marker-3 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-3 point-marker ws-last-cursorposition ws-error "Marker 3 not set"] 2 (#$ . 13550) nil]) #@35 In WordStar mode: Go to marker 4. (defalias 'ws-find-marker-4 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-4 point-marker ws-last-cursorposition ws-error "Marker 4 not set"] 2 (#$ . 13741) nil]) #@35 In WordStar mode: Go to marker 5. (defalias 'ws-find-marker-5 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-5 point-marker ws-last-cursorposition ws-error "Marker 5 not set"] 2 (#$ . 13932) nil]) #@35 In WordStar mode: Go to marker 6. (defalias 'ws-find-marker-6 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-6 point-marker ws-last-cursorposition ws-error "Marker 6 not set"] 2 (#$ . 14123) nil]) #@35 In WordStar mode: Go to marker 7. (defalias 'ws-find-marker-7 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-7 point-marker ws-last-cursorposition ws-error "Marker 7 not set"] 2 (#$ . 14314) nil]) #@35 In WordStar mode: Go to marker 8. (defalias 'ws-find-marker-8 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-8 point-marker ws-last-cursorposition ws-error "Marker 8 not set"] 2 (#$ . 14505) nil]) #@35 In WordStar mode: Go to marker 9. (defalias 'ws-find-marker-9 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-9 point-marker ws-last-cursorposition ws-error "Marker 9 not set"] 2 (#$ . 14696) nil]) #@45 In WordStar mode: Go to block begin marker. (defalias 'ws-goto-block-begin #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-block-begin-marker point-marker ws-last-cursorposition ws-error "Block begin marker not set"] 2 (#$ . 14887) nil]) #@66 In WordStar mode: Search string, remember string for repetition. (defalias 'ws-search #[(string) "ÀÁ!ˆÂ ‰–Äšƒ ÇÉ \nË !‚7 –Ìšƒ5 ÍÉ \nÎ !‚7Ï )‡" [message "Forward (f) or backward (b)" read-char direction 70 string ws-search-string t ws-search-direction point-marker ws-last-cursorposition search-forward 66 nil search-backward keyboard-quit] 3 (#$ . 15111) "sSearch for: "]) #@43 In WordStar mode: Go to block end marker. (defalias 'ws-goto-block-end #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-block-end-marker point-marker ws-last-cursorposition ws-error "Block end marker not set"] 2 (#$ . 15506) nil]) #@69 In WordStar mode: Undo and give message about undoing more changes. (defalias 'ws-undo #[nil "À ˆÁÂ!‡" [undo message "Repeat C-q l to undo more changes."] 2 (#$ . 15722) nil]) #@20 In WordStar mode:  (defalias 'ws-goto-last-cursorposition #[nil "ƒ\nÁ ‰b‡ÂÃ!‡" [ws-last-cursorposition point-marker ws-error "No last cursor position available."] 3 (#$ . 15904) nil]) #@112 In WordStar mode: repeat last error message. This will only work for errors raised by WordStar mode functions. (defalias 'ws-last-error #[nil "ƒÁ!‡ÁÂ!‡" [ws-last-errormessage message "No WordStar error yet."] 2 (#$ . 16098) nil]) #@72 In WordStar mode: Kill to end of line (like WordStar, not like Emacs). (defalias 'ws-kill-eol #[nil "`ÁˆÂ`\")‡" [p nil kill-region] 3 (#$ . 16338) nil]) #@79 In WordStar mode: Kill to beginning of line (like WordStar, not like Emacs). (defalias 'ws-kill-bol #[nil "`ÁyˆÂ`\")‡" [p 0 kill-region] 3 (#$ . 16500) nil]) #@25 Kill the complete line. (defalias 'kill-complete-line #[nil "Àyˆmƒ ÁÂ!ˆ`ÄyˆÅ `\")‡" [0 error "End of buffer" beg 1 kill-region] 3 (#$ . 16667) nil]) #@39 In WordStar mode: Repeat last search. (defalias 'ws-repeat-search #[nil "À \nƒ ƒÄ\n!‡Å\n!‡ÆÇ!‡" [point-marker ws-last-cursorposition ws-search-string ws-search-direction search-forward search-backward ws-error "No search to repeat"] 2 (#$ . 16824) nil]) #@66 In WordStar mode: Search string, remember string for repetition. (defalias 'ws-query-replace #[(from to) "ÂÄ Æ\"‡" [from ws-search-string t ws-search-direction point-marker ws-last-cursorposition query-replace to] 3 (#$ . 17089) "sReplace: \nsWith: "]) #@58 In WordStar mode: Copy block to current cursor position. (defalias 'ws-copy-block #[nil "ƒ\" ƒ\" \"ˆÃ ˆŠÄ bˆÅ Æ bˆÅ ‰)‡Çƒ+È‚4 ƒ3É‚4Ê!‡" [ws-block-begin-marker ws-block-end-marker copy-region-as-kill yank region-beginning point-marker region-end ws-error "Block end marker not set" "Block begin marker not set" "Block markers not set"] 3 (#$ . 17355) nil]) emacs-19.30/lisp/x-apollo.elc100666 75424 1 4450 5766670071 14520 0ustar kwzhdaemon;ELC ;;; compiled by kwzh@churchy.gnu.ai.mit.edu on Sun Jun 11 18:37:41 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/x-apollo.el ;;; emacs version 19.28.93.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`x-apollo.el' was compiled for Emacs 19.29 or later")) #@40 Kill the entire line containing point. (defalias 'apollo-kill-entire-line #[nil "ÀyˆÁÂ!‡" [0 kill-line 1] 2 (#$ . 482) nil]) #@37 Scroll window to right ten columns. (defalias 'apollo-scroll-window-right #[nil "ÀÁ!‡" [scroll-left 10] 2 (#$ . 613) nil]) #@36 Scroll window to left ten columns. (defalias 'apollo-scroll-window-left #[nil "ÀÁ!‡" [scroll-right 10] 2 (#$ . 742) nil]) #@68 Move window forward one line leaving cursor at position in window. (defalias 'apollo-scroll-window-forward-line #[nil "ÀÁ!‡" [scroll-up 1] 2 (#$ . 870) nil]) #@69 Move window backward one line leaving cursor at position in window. (defalias 'apollo-scroll-window-backward-line #[nil "ÀÁ!‡" [scroll-down 1] 2 (#$ . 1034) nil]) (byte-code "ÀÁÂ\"ˆÀÃÂ\"ˆÀÄÅ\"ˆÀÆÅ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÊ\"ˆÀÞß\"ˆÀàá\"ˆÀâÜ\"ˆÀãä\"ˆÀåæ\"ˆÀçè\"ˆÀéê\"ˆÀëì\"ˆÀíî\"ˆÀïð\"ˆÀñò\"ˆÀóô\"ˆÀõö\"ˆÀ÷ô\"ˆÀøì\"ˆÀùú\"ˆÀûð\"ˆÀüý\"ˆÀþÿ\"ˆÀ@A\"ˆÀBC\"ˆÀDE\"ˆÀFG\"‡" [global-set-key [S-tab] " " [C-tab] [S-return] " " [C-return] [linedel] apollo-kill-entire-line [chardel] delete-char [leftbar] beginning-of-line [rightbar] end-of-line [leftbox] apollo-scroll-window-left [rightbox] apollo-scroll-window-right [S-up] apollo-scroll-window-backward-line [S-down] apollo-scroll-window-forward-line [select] set-mark-command [S-insert] overwrite-mode [S-linedel] yank [S-chardel] [copy] copy-region-as-kill [S-cut] kill-region [paste] [S-undo] undo [S-left] backward-word [S-right] forward-word [upbox] scroll-down [S-upbox] beginning-of-buffer [downbox] scroll-up [S-downbox] end-of-buffer [S-redo] toggle-read-only [exit] save-buffer [S-cancel] kill-buffer [S-save] [S-leftbar] [cmd] execute-extended-command [S-rightbar] [next] other-window [S-next] delete-window [read] find-file-read-only [edit] find-file [S-shell] shell [S-help] manual-entry] 3) emacs-19.30/lisp/x-menu.elc100666 13437 1 6712 6021172401 14106 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Aug 30 19:32:08 1995 ;;; from file /home/fsf/rms/e19/lisp/x-menu.el ;;; emacs version 19.29.9. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`x-menu.el' was compiled for Emacs 19.29 or later")) #@187 Major mode for creating permanent menus for use with X. These menus are implemented entirely in Lisp; popup menus, implemented with x-popup-menu, are implemented using XMenu primitives. (defalias 'x-menu-mode #[nil "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÀÅ!ˆÆÆÉʉ ‡" [make-local-variable x-menu-items-per-line x-menu-item-width x-menu-items-alist x-process-mouse-hook x-menu-assoc-buffer t buffer-read-only truncate-lines x-menu-pick-entry ("MENU: %32b") mode-line-buffer-identification] 2 (#$ . 468)]) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ BÀÆ!„-ÇÆ BÀÈ!„:ÇÈ BLJ" [boundp x-menu-max-width 0 current-load-list x-menu-items-per-line x-menu-item-width x-menu-items-alist nil x-menu-assoc-buffer] 2) #@68 *Minimum horizontal spacing between objects in a permanent X menu. (defvar x-menu-item-spacing 1 (#$ . -1171)) #@114 Create a permanent X menu. Returns an item which should be used as a menu object whenever referring to the menu. (defalias 'x-menu-create-menu #[(name) "pÀ !\nqˆÄ ˆ  qˆ\n*‡" [get-buffer-create name buf old x-menu-mode x-menu-assoc-buffer] 3 (#$ . 1289)]) #@79 Change associated buffer of MENU to BUFFER. BUFFER should be a buffer object. (defalias 'x-menu-change-associated-buffer #[(menu buffer) "p qˆ\nq)‡" [old menu buffer x-menu-assoc-buffer] 1 (#$ . 1553)]) #@320 Add to MENU an item with name ITEM, associated with BINDING. Following a sequence of calls to x-menu-add-item, a call to x-menu-compute should be performed before the menu will be made available to the user. BINDING should be a function of one argument, which is the numerical button/key code as defined in x-menu.el. (defalias 'x-menu-add-item #[(menu item binding) "pÀ qˆÄ \"‰ƒ ¡ˆ‚$È BC\"\nqˆ *‡" [nil elt old menu assoc item x-menu-items-alist binding append] 4 (#$ . 1766)]) #@107 Delete from MENU the item named ITEM. Call `x-menu-compute' before making the menu available to the user. (defalias 'x-menu-delete-item #[(menu item) "pÀ qˆÄ \"‰ƒ À ˆ\nqˆ *‡" [nil elt old menu assoc item x-menu-items-alist] 3 (#$ . 2269)]) #@169 Compute all necessary parameters for MENU. This must be called whenever a menu is modified before it is made available to the user. This also creates the menu itself. (defalias 'x-menu-activate #[(menu) "pÁ\n!ˆÃÅ SÇà \n \nƒ>\n@@ƒ5\n@ B \n@@G]\nA‰\n„Ì ! * \\Î¥]Ð ˆ   ƒ”Ç ƒT‰XƒÒÓÔ!ÕQ @@\"cˆ A‰ „i)Öcˆ‚\\)×ÇØ Ùed\"TZ]!ˆebˆ)Á!)‡" [buf pop-to-buffer menu nil buffer-read-only frame-width x-menu-max-width 0 x-menu-item-width x-menu-items-alist items-tail items-head reverse x-menu-item-spacing 1 x-menu-items-per-line erase-buffer items format "%" int-to-string "s" 10 shrink-window window-height count-lines] 7 (#$ . 2523)]) #@56 Internal function for dispatching on mouse/menu events (defalias 'x-menu-pick-entry #[(position event) "Si ¥^Ãe`\"iÄUƒÄ‚ÅZ\n_\\‰8A‰ ƒ2 \n!ˆ,Ë\f!‡" [x-menu-items-per-line x-menu-item-width x count-lines 0 1 y item x-menu-items-alist litem event pop-to-buffer x-menu-assoc-buffer] 4 (#$ . 3214)]) emacs-19.30/lisp/xscheme.elc100666 13437 1 62176 6014666546 14403 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Thu Aug 17 12:24:45 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/xscheme.el ;;; emacs version 19.29.11. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`xscheme.el' was compiled for Emacs 19.29 or later")) (require (quote scheme)) #@47 *Program invoked by the `run-scheme' command. (defvar scheme-program-name "scheme" (#$ . -502)) #@43 *Band loaded by the `run-scheme' command. (defvar scheme-band-name nil (#$ . -604)) #@70 *Arguments passed to the Scheme program by the `run-scheme' command. (defvar scheme-program-arguments nil (#$ . -694)) #@200 If non-nil, an expression may be transmitted while another is evaluating. Otherwise, attempting to evaluate an expression before the previous expression has finished evaluating will signal an error. (defvar xscheme-allow-pipelined-evaluation t (#$ . 820)) #@122 String to insert into Scheme process buffer first time it is started. Is processed with `substitute-command-keys' first. (defvar xscheme-startup-message "This is the Scheme process buffer.\nType \\[advertised-xscheme-send-previous-expression] to evaluate the expression before point.\nType \\[xscheme-send-control-g-interrupt] to abort evaluation.\nType \\[describe-mode] for more information.\n\n" (#$ . 1083)) #@76 If non-nil, causes a message to be generated when the Scheme process dies. (defvar xscheme-signal-death-message nil (#$ . 1501)) (defalias 'xscheme-evaluation-commands #[(keymap) "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÃ#ˆÀ ÉÊ#ˆÀ ËÌ#‡" [define-key keymap "" xscheme-send-definition "" advertised-xscheme-send-previous-expression "o" xscheme-send-buffer "z" " " xscheme-send-previous-expression "" xscheme-send-region] 4]) (defalias 'xscheme-interrupt-commands #[(keymap) "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#‡" [define-key keymap "" xscheme-select-process-buffer "" xscheme-send-breakpoint-interrupt "" xscheme-send-control-g-interrupt "" xscheme-send-control-u-interrupt "" xscheme-send-control-x-interrupt] 4]) (byte-code "À !ˆÂ !‡" [xscheme-evaluation-commands scheme-mode-map xscheme-interrupt-commands] 2) #@118 Run MIT Scheme in an inferior process. Output goes to the buffer `*scheme*'. With argument, asks for a command line. (defalias 'run-scheme #[(command-line) "ÂÃ!!‡" [command-line xscheme-process-command-line pop-to-buffer xscheme-start-process] 3 (#$ . 2313) (list (let ((default (or xscheme-process-command-line (xscheme-default-command-line)))) (if current-prefix-arg (read-string "Run Scheme: " default) default)))]) #@27 Reset the Scheme process. (defalias 'reset-scheme #[nil "ÀÁ!‰ƒÃ\n!Ä=ƒÅÆ!…+ÇÈ!ˆ\nƒ#É\nÊ\"ˆË\f!ˆÇÍ!)‡" [get-process "scheme" process process-status run yes-or-no-p "The Scheme process is running, are you SURE you want to reset it? " message "Resetting Scheme process..." kill-process t xscheme-start-process xscheme-process-command-line "Resetting Scheme process...done"] 4 (#$ . 2741) nil]) (defalias 'xscheme-default-command-line #[nil "Á\nƒ\fÃ\nP‚ Ä ƒÆ P‚ÄR‡" [scheme-program-name " -emacs" scheme-program-arguments " " "" scheme-band-name " -band "] 5]) #@3241 Major mode for interacting with the inferior Scheme process. Like scheme-mode except that: \[advertised-xscheme-send-previous-expression] sends the expression before point to the Scheme process as input \[xscheme-yank-previous-send] yanks the expression most recently sent to Scheme All output from the Scheme process is written in the Scheme process buffer, which is initially named "*scheme*". The result of evaluating a Scheme expression is also printed in the process buffer, preceded by the string ";Value: " to highlight it. If the process buffer is not visible at that time, the value will also be displayed in the minibuffer. If an error occurs, the process buffer will automatically pop up to show you the error message. While the Scheme process is running, the modelines of all buffers in scheme-mode are modified to show the state of the process. The possible states and their meanings are: input waiting for input run evaluating gc garbage collecting The process buffer's modeline contains additional information where the buffer's name is normally displayed: the command interpreter level and type. Scheme maintains a stack of command interpreters. Every time an error or breakpoint occurs, the current command interpreter is pushed on the command interpreter stack, and a new command interpreter is started. One example of why this is done is so that an error that occurs while you are debugging another error will not destroy the state of the initial error, allowing you to return to it after the second error has been fixed. The command interpreter level indicates how many interpreters are in the command interpreter stack. It is initially set to one, and it is incremented every time that stack is pushed, and decremented every time it is popped. The following commands are useful for manipulating the command interpreter stack: \[xscheme-send-breakpoint-interrupt] pushes the stack once \[xscheme-send-control-u-interrupt] pops the stack once \[xscheme-send-control-g-interrupt] pops everything off \[xscheme-send-control-x-interrupt] aborts evaluation, doesn't affect stack Some possible command interpreter types and their meanings are: [Evaluator] read-eval-print loop for evaluating expressions [Debugger] single character commands for debugging errors [Where] single character commands for examining environments Starting with release 6.2 of Scheme, the latter two types of command interpreters will change the major mode of the Scheme process buffer to scheme-debugger-mode , in which the evaluation commands are disabled, and the keys which normally self insert instead send themselves to the Scheme process. The command character ? will list the available commands. For older releases of Scheme, the major mode will be be scheme-interaction-mode , and the command characters must be sent as if they were expressions. Commands: Delete converts tabs to spaces as it moves back. Blank lines separate paragraphs. Semicolons start comments. \{scheme-interaction-mode-map} Entry to this mode calls the value of scheme-interaction-mode-hook with no args, if that value is non-nil. Likewise with the value of scheme-mode-hook. scheme-interaction-mode-hook is called after scheme-mode-hook. (defalias 'scheme-interaction-mode #[nil "À ˆÁ ˆÂ ˆÃÄ!ˆÅÆÇ\"‡" [kill-all-local-variables scheme-interaction-mode-initialize scheme-mode-variables make-local-variable xscheme-previous-send run-hooks scheme-mode-hook scheme-interaction-mode-hook] 3 (#$ . 3320) nil]) (defalias 'scheme-interaction-mode-initialize #[nil "À !ˆÂĉ‡" [use-local-map scheme-interaction-mode-map scheme-interaction-mode major-mode "Scheme Interaction" mode-name] 2]) (defalias 'scheme-interaction-mode-commands #[(keymap) "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#‡" [define-key keymap " " xscheme-send-current-line "" xscheme-send-proceed "" xscheme-yank-previous-send] 4]) (byte-code "ÀÁ!„ÂÁ B „#Ä Å !ˆÆ !ˆÇ !ˆÈ !ˆÂ‡" [boundp scheme-interaction-mode-map nil current-load-list make-keymap scheme-mode-commands xscheme-interrupt-commands xscheme-evaluation-commands scheme-interaction-mode-commands] 2) (defalias 'xscheme-enter-interaction-mode #[nil "ŠÀ qˆ Â=?… Ã=ƒÄ ‚ )‡" [xscheme-process-buffer major-mode scheme-interaction-mode scheme-debugger-mode scheme-interaction-mode-initialize] 2]) (fset (quote advertised-xscheme-send-previous-expression) (quote xscheme-send-previous-expression)) #@316 Major mode for executing the Scheme debugger. Like scheme-mode except that the evaluation commands are disabled, and characters that would normally be self inserting are sent to the Scheme process instead. Typing ? will show you which characters perform useful functions. Commands: \{scheme-debugger-mode-map} (defalias 'scheme-debugger-mode #[nil "ÀÁ!‡" [error "Illegal entry to scheme-debugger-mode"] 2 (#$ . 7732)]) (defalias 'scheme-debugger-mode-initialize #[nil "À !ˆÂĉ‡" [use-local-map scheme-debugger-mode-map scheme-debugger-mode major-mode "Scheme Debugger" mode-name] 2]) (defalias 'scheme-debugger-mode-commands #[(keymap) "ÀÀÂW…Ã\fÅ !Æ#ˆ T‰‚)‡" [32 char 127 define-key keymap char-to-string scheme-debugger-self-insert] 5]) (byte-code "ÀÁ!„ÂÁ B „Ä Å !ˆÆ !ˆÇ !ˆÂ‡" [boundp scheme-debugger-mode-map nil current-load-list make-keymap scheme-mode-commands xscheme-interrupt-commands scheme-debugger-mode-commands] 2) #@48 Transmit this character to the Scheme process. (defalias 'scheme-debugger-self-insert #[nil "À !‡" [xscheme-send-char last-command-char] 2 (#$ . 8685) nil]) (defalias 'xscheme-enter-debugger-mode #[(prompt-string) "ŠÀ qˆ Â=?… Ã=„à ˆÄ )‡" [xscheme-process-buffer major-mode scheme-debugger-mode scheme-interaction-mode scheme-debugger-mode-initialize] 2]) (defalias 'xscheme-debugger-mode-p #[nil "À ‰…Š qˆ\n)Ã=)‡" [xscheme-process-buffer buffer major-mode scheme-debugger-mode] 3]) #@108 Send the string arguments to the Scheme process. The strings are concatenated and terminated by a newline. (defalias 'xscheme-send-string #[(&rest strings) "À „ÁÂ!…:à ˆÄ ˆdbˆÅÆ\"ˆÈ!‡É ƒ(ÊË!‡\f„6 ƒ6ÊÎ!‡È!‡" [xscheme-process-running-p yes-or-no-p "The Scheme process has died. Reset it? " reset-scheme xscheme-wait-for-process apply insert-before-markers strings xscheme-send-string-1 xscheme-debugger-mode-p error "No sends allowed in debugger mode" xscheme-allow-pipelined-evaluation xscheme-running-p "No sends allowed while Scheme running"] 3 (#$ . 9181)]) (defalias 'xscheme-send-string-1 #[(strings) "ÀÁ\n\"Ä !ˆ Æ=… ‰)‡" [apply concat strings string xscheme-send-string-2 major-mode scheme-interaction-mode xscheme-previous-send] 3]) (defalias 'xscheme-send-string-2 #[(string) "ÀÁ!Ã\n\fÅP\"ˆÆ …Ç\n!`È“)‡" [get-process "scheme" process send-string string "\n" xscheme-process-buffer-current-p process-mark nil] 4]) #@45 Insert the most recent expression at point. (defalias 'xscheme-yank-previous-send #[nil "À ˆ c‡" [push-mark xscheme-previous-send] 1 (#$ . 10129) nil]) #@64 Select the Scheme process buffer and move to its output point. (defalias 'xscheme-select-process-buffer #[nil "ÀÁ!† ÂÃ!Å\f!†ÂÆ!È!‰ ƒ'Ê !ˆ‚,Ë!ˆÌ\f!b+‡" [get-process "scheme" error "No scheme process" process process-buffer "No process buffer" buffer get-buffer-window window select-window switch-to-buffer process-mark] 3 (#$ . 10287) nil]) #@92 Send the current region to the Scheme process. The region is sent terminated by a newline. (defalias 'xscheme-send-region #[(start end) "À ƒ bˆÂÃÄ!! Å“ˆÆ {!‡" [xscheme-process-buffer-current-p end process-mark get-process "scheme" nil xscheme-send-string start] 3 (#$ . 10647) "r"]) #@186 Send the current definition to the Scheme process. If the current line begins with a non-whitespace character, parse an expression from the beginning of the line and send that instead. (defalias 'xscheme-send-definition #[nil "À‰ŠÃ ˆ`ÄÅÀÆ#ƒ`‚ÇÈ!ˆ)É\n \"*‡" [nil end start end-of-defun re-search-backward "^\\s(" t error "Can't find definition" xscheme-send-region] 4 (#$ . 10941) nil]) #@68 Send the expression to the right of `point' to the Scheme process. (defalias 'xscheme-send-next-expression #[nil "`ÁŠÂ ˆ`)\")‡" [start xscheme-send-region forward-sexp] 3 (#$ . 11341) nil]) #@67 Send the expression to the left of `point' to the Scheme process. (defalias 'xscheme-send-previous-expression #[nil "`ÁŠÂ ˆ`)\")‡" [end xscheme-send-region backward-sexp] 3 (#$ . 11539) nil]) #@98 Send the current line to the Scheme process. Useful for working with debugging Scheme under adb. (defalias 'xscheme-send-current-line #[nil "ŠÀyˆ`ˆ `{*ˆÄcˆÅ !)‡" [0 start nil line 10 xscheme-send-string-2] 2 (#$ . 11739) nil]) #@48 Send the current buffer to the Scheme process. (defalias 'xscheme-send-buffer #[nil "À ƒ ÁÂ!ˆÃed\"‡" [xscheme-process-buffer-current-p error "Not allowed to send this buffer's contents to Scheme" xscheme-send-region] 3 (#$ . 11978) nil]) #@59 Prompt for a character and send it to the Scheme process. (defalias 'xscheme-send-char #[(char) "ÀÁ !\"‡" [send-string "scheme" char-to-string char] 4 (#$ . 12223) "cCharacter to send: "]) #@49 Cause the Scheme process to enter a breakpoint. (defalias 'xscheme-send-breakpoint-interrupt #[nil "ÀÁÂ\"‡" [xscheme-send-interrupt 98 nil] 3 (#$ . 12419) nil]) #@56 Cause the Scheme process to proceed from a breakpoint. (defalias 'xscheme-send-proceed #[nil "ÀÁÂ\"‡" [send-string "scheme" "(proceed)\n"] 3 (#$ . 12586) nil]) #@96 Cause the Scheme processor to halt and flush input. Control returns to the top level rep loop. (defalias 'xscheme-send-control-g-interrupt #[nil "À\n„\fÃÄ!‚& ƒÆÇ!‚&ÀÆÈ!ˆÃÄ!ˆÉÄÊË!\")‡" [t inhibit-quit xscheme-control-g-synchronization-p interrupt-process "scheme" xscheme-control-g-disabled-p message "Relax..." "Sending C-G interrupt to Scheme..." send-string char-to-string 0] 4 (#$ . 12752) nil]) #@67 Cause the Scheme process to halt, returning to previous rep loop. (defalias 'xscheme-send-control-u-interrupt #[nil "ÀÁÂ\"‡" [xscheme-send-interrupt 117 t] 3 (#$ . 13164) nil]) #@66 Cause the Scheme process to halt, returning to current rep loop. (defalias 'xscheme-send-control-x-interrupt #[nil "ÀÁÂ\"‡" [xscheme-send-interrupt 120 t] 3 (#$ . 13347) nil]) #@49 Send a ^A type interrupt to the Scheme process. (defalias 'xscheme-send-interrupt #[(char mark-p) "ÀÁ!ˆÂÁÃ\f!\"ˆ ……ÂÁÃÇ!\"‡" [quit-process "scheme" send-string char-to-string char mark-p xscheme-control-g-synchronization-p 0] 4 (#$ . 13529) "cInterrupt character to send: "]) #@55 Command used to start the most recent Scheme process. (defvar xscheme-process-command-line nil (#$ . 13817)) #@59 Most recent expression transmitted to the Scheme process. (defvar xscheme-previous-send "" (#$ . 13932)) #@213 State of scheme process escape reader state machine: idle waiting for an escape sequence reading-type received an altmode but nothing else reading-string reading prompt string (defvar xscheme-process-filter-state (quote idle) (#$ . 14044)) #@125 This variable, if nil, indicates that the scheme process is waiting for input. Otherwise, it is busy evaluating something. (defvar xscheme-running-p nil (#$ . 14327)) #@203 If non-nil, insert markers in the scheme input stream to indicate when control-g interrupts were signalled. Do not allow more control-g's to be signalled until the scheme process acknowledges receipt. (defconst xscheme-control-g-synchronization-p t (#$ . 14502)) #@142 This variable, if non-nil, indicates that a control-g is being processed by the scheme process, so additional control-g's are to be ignored. (defvar xscheme-control-g-disabled-p nil (#$ . 14773)) #@109 This variable, if nil, prevents output from the scheme process from being inserted into the process-buffer. (defvar xscheme-allow-output-p t (#$ . 14976)) #@35 The current scheme prompt string. (defvar xscheme-prompt "" (#$ . 15137)) #@68 Accumulator for the string being received from the scheme process. (defvar xscheme-string-accumulator "" (#$ . 15217)) #@64 Procedure to send the string argument from the scheme process. (defvar xscheme-string-receiver nil (#$ . 15342)) #@136 If non-nil, a procedure to call when the Scheme process is started. When called, the current buffer will be the Scheme process-buffer. (defvar xscheme-start-hook nil (#$ . 15462)) (byte-code "ÀÁ!„ÂÁ BÀÄ!„ÂÄ BÀÅ!„ ÂÅ B‡" [boundp xscheme-runlight-string nil current-load-list xscheme-mode-string xscheme-filter-input] 2) (defalias 'xscheme-start-process #[(command-line) "ÀÁ!Ã\n!Š\nqˆ\fƒ\"Å\f!Æ>ƒ\"Ç\f!dÈ“ˆ‚g\fƒ*É\f!ˆdbˆÊ ˆoƒ;ËÌ !!ˆÈÏÐÑ\nÒ!BB\")Ç\f!dÈ“ˆÔÕ!ˆÖ ˆ×\fØ\"ˆÙ\fÚ\"ˆÛÜ!ˆ*\n)‡" [get-buffer-create "*scheme*" buffer get-buffer-process process process-status (run stop) process-mark nil delete-process scheme-interaction-mode insert-before-markers substitute-command-keys xscheme-startup-message process-connection-type apply start-process "scheme" xscheme-parse-command-line command-line xscheme-process-filter-initialize t xscheme-modeline-initialize set-process-sentinel xscheme-process-sentinel set-process-filter xscheme-process-filter run-hooks xscheme-start-hook] 6]) (defalias 'xscheme-parse-command-line #[(string) "À !Âà ƒAÆÇ #‰„\" ÃO\fBÂ< Uƒ1ÆÉ #‚< O\fBT)‚\fŸ*‡" [substitute-in-file-name string 0 nil result start string-match "[ ]" index "[^ ]"] 5]) (defalias 'xscheme-wait-for-process #[nil "ÀÁ!ˆ\n…ÀÃ!ˆ‚‡" [sleep-for 2 xscheme-running-p 1] 2]) #@59 True iff there is a Scheme process whose status is `run'. (defalias 'xscheme-process-running-p #[nil "ÀÁ!‰… Ã\n!Ä=)‡" [get-process "scheme" process process-status run] 3 (#$ . 16786)]) (defalias 'xscheme-process-buffer #[nil "ÀÁ!‰… Ã\n!)‡" [get-process "scheme" process process-buffer] 3]) (defalias 'xscheme-process-buffer-window #[nil "À ‰…\n !)‡" [xscheme-process-buffer buffer get-buffer-window] 3]) #@59 True iff the current buffer is the Scheme process buffer. (defalias 'xscheme-process-buffer-current-p #[nil "À p=‡" [xscheme-process-buffer] 2 (#$ . 17203)]) (defalias 'xscheme-process-sentinel #[(proc reason) "À Â=!ˆ Â=ƒà ˆ‚ÄÆ È>?…) …)Ê ˆËÌ!‡" [xscheme-process-filter-initialize reason run xscheme-modeline-initialize "" scheme-mode-line-process "no process" xscheme-mode-string (run stop) xscheme-signal-death-message beep message "The Scheme process has died! Do M-x reset-scheme to restart it"] 3]) (defalias 'xscheme-process-filter-initialize #[(running-p) "À\nÄÆÈ ʉ ‡" [idle xscheme-process-filter-state running-p xscheme-running-p nil xscheme-control-g-disabled-p t xscheme-allow-output-p "" xscheme-prompt (": " xscheme-runlight-string) scheme-mode-line-process] 2]) (defalias 'xscheme-process-filter #[(proc string) " …·\nÃ=ƒ7ÄÅ \"‰ƒ*Ç ÈO!ˆ TÉOÊ‚3 ÉÇ!ˆ))‚\nÊ=ƒy GÈUƒJɉ‚ ÈH ÌÉOÍ \"‰ƒmÐ8A@!ˆ‚uÇÑ \"ˆÃ*‚\nÒ=ƒ°ÄÅ \"‰ƒ¤ ÈOP TÉOÃ!ˆ)‚¬ PÉ)‚ÕÖ!ˆ‚)‡" [string xscheme-filter-input xscheme-process-filter-state idle string-match "" start xscheme-process-filter-output 0 nil reading-type char 1 assoc xscheme-process-filter-alist entry 2 27 reading-string xscheme-string-accumulator xscheme-string-receiver error "Scheme process filter -- bad state"] 5]) (defalias 'xscheme-process-filter-output #[(&rest args) "…NÁ \"ŠÅ ˆÆÇ\f\"ƒJȔȕ \nË\fÈ\nO!ˆ\f\nHÌUƒ<n„5ËÍ!ˆËÌ!ˆ‚?Î ˆ\f\nTÏO*‚ Ë\f!*‡" [xscheme-allow-output-p apply concat args string xscheme-goto-output-point string-match "\\(\\|\f\\)" 0 end start insert-before-markers 12 10 beep nil] 4]) (defalias 'xscheme-guarantee-newlines #[(n) "…;ŠÁ ˆÂ „%nƒ%\fSoƒʼn‚ Æ ˆ‚\n)Á ˆ\fÇV…:ÈÉ!ˆ\fS‰‚*)‡" [xscheme-allow-output-p xscheme-goto-output-point nil stop n t backward-char 0 insert-before-markers 10] 3]) (defalias 'xscheme-goto-output-point #[nil "ÀÁ!Ã\n!qˆÄ\n!b)‡" [get-process "scheme" process process-buffer process-mark] 2]) (defalias 'xscheme-modeline-initialize #[nil "ÀÀɇ" ["" xscheme-runlight-string xscheme-mode-string ("Scheme: " xscheme-mode-string) mode-line-buffer-identification] 2]) (defalias 'xscheme-set-runlight #[(runlight) "ÂÃ!‡" [runlight xscheme-runlight-string force-mode-line-update t] 2]) #@673 Table used to decide how to handle process filter commands. Value is a list of entries, each entry is a list of three items. The first item is the character that the process filter dispatches on. The second item is the action to be taken, a function. The third item is the handler for the entry, a function. When the process filter sees a command whose character matches a particular entry, it calls the handler with two arguments: the action and the string containing the rest of the process filter's input stream. It is the responsibility of the handler to invoke the action with the appropriate arguments, and to reenter the process filter with the remaining input. (defvar xscheme-process-filter-alist (quote ((68 xscheme-enter-debugger-mode xscheme-process-filter:string-action) (69 xscheme-eval xscheme-process-filter:string-action) (80 xscheme-set-prompt-variable xscheme-process-filter:string-action) (82 xscheme-enter-interaction-mode xscheme-process-filter:simple-action) (98 xscheme-start-gc xscheme-process-filter:simple-action) (101 xscheme-finish-gc xscheme-process-filter:simple-action) (102 xscheme-exit-input-wait xscheme-process-filter:simple-action) (103 xscheme-enable-control-g xscheme-process-filter:simple-action) (105 xscheme-prompt-for-expression xscheme-process-filter:string-action) (109 xscheme-message xscheme-process-filter:string-action) (110 xscheme-prompt-for-confirmation xscheme-process-filter:string-action) (111 xscheme-output-goto xscheme-process-filter:simple-action) (112 xscheme-set-prompt xscheme-process-filter:string-action) (115 xscheme-enter-input-wait xscheme-process-filter:simple-action) (118 xscheme-write-value xscheme-process-filter:string-action) (119 xscheme-cd xscheme-process-filter:string-action) (122 xscheme-display-process-buffer xscheme-process-filter:simple-action) (99 xscheme-unsolicited-read-char xscheme-process-filter:simple-action))) (#$ . 19495)) (defalias 'xscheme-process-filter:simple-action #[(action) "À\n ‡" [idle xscheme-process-filter-state action] 1]) (defalias 'xscheme-process-filter:string-action #[(action) "Âĉ‡" [action xscheme-string-receiver "" xscheme-string-accumulator reading-string xscheme-process-filter-state] 2]) #@61 The character displayed when the Scheme process is running. (defconst xscheme-runlight:running "run" (#$ . 21716)) #@71 The character displayed when the Scheme process is waiting for input. (defconst xscheme-runlight:input "input" (#$ . 21837)) #@72 The character displayed when the Scheme process is garbage collecting. (defconst xscheme-runlight:gc "gc" (#$ . 21968)) (defalias 'xscheme-start-gc #[nil "À !‡" [xscheme-set-runlight xscheme-runlight:gc] 2]) (defalias 'xscheme-finish-gc #[nil "À ƒ \n‚\n !‡" [xscheme-set-runlight xscheme-running-p xscheme-runlight:running xscheme-runlight:input] 2]) (defalias 'xscheme-enter-input-wait #[nil "À !ˆÂ‰‡" [xscheme-set-runlight xscheme-runlight:input nil xscheme-running-p] 2]) (defalias 'xscheme-exit-input-wait #[nil "À !ˆÂ‰‡" [xscheme-set-runlight xscheme-runlight:running t xscheme-running-p] 2]) (defalias 'xscheme-enable-control-g #[nil "À‰‡" [nil xscheme-control-g-disabled-p] 2]) (defalias 'xscheme-display-process-buffer #[nil "À † Á !Ä‹)‡" [xscheme-process-buffer-window display-buffer xscheme-process-buffer window ((byte-code "À !ˆÂ ˆÃ …Ä ‡" [select-window window xscheme-goto-output-point xscheme-debugger-mode-p xscheme-enter-interaction-mode] 2))] 2]) (defalias 'xscheme-unsolicited-read-char #[nil "À‡" [nil] 1]) (defalias 'xscheme-eval #[(string) "ÀÁ\n!@!‡" [eval read-from-string string] 3]) (defalias 'xscheme-message #[(string) "GÁU?…ÂÃÄ\"\"‡" [string 0 xscheme-write-message-1 format ";%s"] 5]) (defalias 'xscheme-write-value #[(string) "GÁUƒ\fÂÃÄ\"‡ÂÅÆ\"\"‡" [string 0 xscheme-write-message-1 "(no value)" ";No value" format ";Value: %s"] 5]) (defalias 'xscheme-write-message-1 #[(message-string output-string) "ÀÁ!ÃÄ\n!!‰ƒÆÇ\n! \"„ÈÉ\n\"ˆ*ËÌ!ˆÍ!‡" [get-process "scheme" process get-buffer-window process-buffer window pos-visible-in-window-p process-mark message "%s" message-string xscheme-guarantee-newlines 1 xscheme-process-filter-output output-string] 4]) (defalias 'xscheme-set-prompt-variable #[(string) "‰‡" [string xscheme-prompt] 2]) (defalias 'xscheme-set-prompt #[(string) "ÂÃ!ˆÄ!ÆÇ!‡" [string xscheme-prompt xscheme-guarantee-newlines 2 xscheme-coerce-prompt xscheme-mode-string force-mode-line-update t] 2]) (defalias 'xscheme-output-goto #[nil "À ˆÁÂ!‡" [xscheme-goto-output-point xscheme-guarantee-newlines 2] 2]) (defalias 'xscheme-coerce-prompt #[(string) "ÀÁ\n\"ƒ,Õ\nÃ\fO\n\fÅOÇ\"‰ ƒ& A‚(*P)‡\n‡" [string-match "^[0-9]+ " string 0 end nil prompt assoc xscheme-prompt-alist entry] 5]) #@76 An alist which maps the Scheme command interpreter type to a print string. (defvar xscheme-prompt-alist (quote (("[Normal REPL]" . "[Evaluator]") ("[Error REPL]" . "[Evaluator]") ("[Breakpoint REPL]" . "[Evaluator]") ("[Debugger REPL]" . "[Evaluator]") ("[Visiting environment]" . "[Evaluator]") ("[Environment Inspector]" . "[Where]"))) (#$ . 24246)) (defalias 'xscheme-cd #[(directory-string) "ŠÀ qˆÁ\n!)‡" [xscheme-process-buffer cd directory-string] 2]) (defalias 'xscheme-prompt-for-confirmation #[(prompt-string) "ÀÁ\n!ƒ Â\fÄ!‡" [xscheme-send-char y-or-n-p prompt-string 121 110] 3]) (defalias 'xscheme-prompt-for-expression #[(prompt-string) "ÀÁ\nÃ\f#!‡" [xscheme-send-string-2 read-from-minibuffer prompt-string nil xscheme-prompt-for-expression-map] 5]) (byte-code "ÀÁ!„ÂÁ B „Ä !ÆÇÈ #ˆÂ‡" [boundp xscheme-prompt-for-expression-map nil current-load-list copy-keymap minibuffer-local-map substitute-key-definition exit-minibuffer xscheme-prompt-for-expression-exit] 4) (defalias 'xscheme-prompt-for-expression-exit #[nil "Àed\"Á=ƒ\f ‡ÃÄ!‡" [xscheme-region-expression-p one exit-minibuffer error "input must be a single, complete expression"] 3 nil nil]) (defalias 'xscheme-region-expression-p #[(start end) "ŠÀ ÂŽÃ\f!ˆÅ\"‰@ÉU…7Ê8…7ÅÊ8\"Ê8ƒ5Ë‚6Ì),‡" [syntax-table old-syntax-table ((set-syntax-table old-syntax-table)) set-syntax-table scheme-mode-syntax-table parse-partial-sexp start end state 0 2 many one] 5]) (provide (quote xscheme)) emacs-19.30/lisp/yow.elc100666 13437 1 3576 5744600165 13536 0ustar jimbdaemon;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Mon Apr 17 19:57:40 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/yow.el ;;; emacs version 19.28.90.26. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/yow.el' was compiled for Emacs 19")) (require (quote cookie1)) #@44 File containing pertinent pinhead phrases. (defvar yow-file (concat data-directory "yow.lines") (#$ . 501)) #@74 Return or display a random Zippy quotation. With prefix arg, insert it. (defalias 'yow #[(&optional insert) "À ÂÃ# ƒ\fc‚>t„\f‚>ÆÇ\f\"„+ÈÉÊ!!ˆËÌ\f\"‚>ËÍ!ˆÊÎ\f!ˆŠqˆÐ )‘)‡" [cookie yow-file "Am I CONSING yet?..." "I have SEEN the CONSING!!" yow insert string-match "\n" delete-windows-on get-buffer-create "*Help*" message "%s" "Yow!" princ standard-output help-mode] 4 (#$ . 615) "P"]) #@149 Read a Zippyism from the minibuffer with completion, prompting with PROMPT. If optional second arg is non-nil, require input to match a completion. (defalias 'read-zippyism #[(prompt &optional require-match) "À \nÃÄ %‡" [read-cookie prompt yow-file "Am I CONSING yet?..." "I have SEEN the CONSING!!" require-match] 6 (#$ . 1019)]) (put (quote read-zippyism) (quote byte-optimizer) (quote byte-compile-inline-expand)) #@77 Prompt with completion for a known Zippy quotation, and insert it at point. (defalias 'insert-zippyism #[(&optional zippyism) "c‡" [zippyism] 1 (#$ . 1442) (list (read-zippyism "Pinhead wisdom: " t))]) #@28 Zippy goes to the analyst. (defalias 'psychoanalyze-pinhead #[nil "À ˆÁÂ!ˆÃÄ!ˆÅÆ!ˆÇ ?…)ÈÉ !ˆÅÆ!ˆÊË!ˆÊË!ˆ‚‡" [doctor message "" switch-to-buffer "*doctor*" sit-for 0 input-pending-p insert-string yow doctor-ret-or-read 1] 2 (#$ . 1651) nil]) (provide (quote yow)) emacs-19.30/lisp/xt-mouse.elc100666 12120 1 6076 6055526327 14346 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 25 00:42:39 1995 ;;; from file /home/fsf/rms/e19/lisp/xt-mouse.el ;;; emacs version 19.29.91.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`xt-mouse.el' was compiled for Emacs 19.29 or later")) (define-key function-key-map "" (quote xterm-mouse-translate)) (defalias 'xterm-mouse-translate #[(event) "ŠÀ‹)‡" [((byte-code "ƒ\nÁÃÄ!ˆÁÆ ‰@A@‰ A@\nË\n9ƒ/Ì\n\"‚3Ì!! Î Ï=ƒKÎ Ð=ƒKÎ Ñ=„OÒÓ!ˆÆ ‰@A@‰A@ Ø>ƒ‰9ƒ‚Ù=„‚ÌD\"‚ÑÌ!‚Ñ\n=ƒ—C‚²ÚD\n9ƒ¥Û‚±ÜÝ Þ\\P! ED\n9ƒÍ\nÙ=„ÍÌ\n D\"‚ÑÌ!.\n‡" [transient-mark-mode nil mark-active run-hooks deactivate-mark-hook last xterm-mouse-event down down-command down-data down-where key-binding vector down-binding read-char 27 91 77 error "Unexpected escape sequence from XTerm" click click-command click-data click-where (nil ignore) menu-bar mouse-movement 0 intern "drag-mouse-" 1 unread-command-events] 6))] 1]) #@59 Position of last xterm mouse event relative to the frame. (defvar xterm-mouse-x 0 (#$ . 1197)) #@59 Position of last xterm mouse event relative to the frame. (defvar xterm-mouse-y 0 (#$ . 1298)) (byte-code "ÀÁÂÃÄ$ˆÅÁÄ\"‡" [ad-add-advice mouse-position (xterm-mouse nil t (advice lambda nil "Use last key from xterm-mouse-mode if available." (let ((answer ad-do-it)) (setq ad-return-value (if xterm-mouse-mode (cons (car answer) (cons xterm-mouse-x xterm-mouse-y)) answer))))) around nil ad-activate-on] 5) (defalias 'xterm-mouse-event #[nil "À ÁZÀ ÃZÀ ÃZ\f BÇ\f \"‰ƒ'É\"‚(ʉ :ƒRÌ!ˆÍ!bˆÎ A!ˆÏ @i\\ÐÑ S]\\!ˆ`‚T Ó\nÔ=ƒfÕ×\\P‚n\nØ\n×\\P!\f ÜÝ 8Þ¥F.D‡" [read-char 32 type 33 x y point window-at window coordinates-in-window-p menu-bar where select-window window-start move-to-window-line move-to-column 0 window-hscroll pos intern 3 "mouse-" last 1 "down-mouse-" mouse xterm-mouse-x xterm-mouse-y 2 current-time 1000] 7]) (byte-code "ÀÁ!„ÂÁ BÁ\fž„Å\fB‡" [boundp xterm-mouse-mode nil current-load-list minor-mode-alist (xterm-mouse-mode (" Mouse"))] 2) #@167 Toggle XTerm mouse mode. With prefix arg, turn XTerm mouse mode on iff arg is positive. Turn it on to use emacs mouse commands, and off to use xterm mouse commands. (defalias 'xterm-mouse-mode #[(arg) "„ „Â!ÃXƒ …,Ä ˆÅÆÇ !‡ ?…,ÈÉ ˆÆÇ !‡" [arg xterm-mouse-mode prefix-numeric-value 0 turn-off-xterm-mouse-tracking nil set-buffer-modified-p buffer-modified-p t turn-on-xterm-mouse-tracking] 2 (#$ . 2306) "P"]) (defalias 'turn-on-xterm-mouse-tracking #[nil "…ÁÂ!‡" [xterm-mouse-mode send-string-to-terminal "[?1000h"] 2]) (defalias 'turn-off-xterm-mouse-tracking #[nil "…ÁÂ!‡" [xterm-mouse-mode send-string-to-terminal "[?1000l"] 2]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÂ\"ˆÆÇ!‡" [add-hook suspend-hook turn-off-xterm-mouse-tracking suspend-resume-hook turn-on-xterm-mouse-tracking kill-emacs-hook provide xt-mouse] 3) emacs-19.30/lisp/forms-d2.dat100666 22441 1 1065 5626417630 14026 0ustar fpdaemoncomp.sources.unix v11i008 269 getty-enable 1 tron@sc.nsc.com (Ronald S. Karr) Getty on/off programs for 4.[23] BSD 890505 This program can be used to dynamically enable / disable terminal lines on a BSD system. comp.sources.unix 11 v11i022 283 syslog 1 emory!arnold (Arnold D. Robbins {EUCC}) Development version of syslog(3), for ATT, too 28/08/1987 comp.sources.unix 11 v11i033 290 less3 3 sun!intsc!convgt!mark The 'less' pager 02/09/1987 comp.sources.unix 11 v11i036 293 test.el 3 "Mark A. Ardis" Test system for GNU Emacs 10/09/1987 emacs-19.30/lisp/ChangeLog100666 12120 1 1647617 6055525431 13742 0ustar rmsdaemonFri Nov 24 17:58:03 1995 Richard Stallman * Version 19.30 released. * diary-lib.el: Renamed from diary.el. * calendar.el, cal-tex.el: Use new name diary-lib. * cc-mode.el (c++-mode, objc-mode, c-mode): Doc fix. * font-lock.el (font-lock-make-faces): Add special code for ms-dos. * view.el (view-mode, view-mode-enter): Doc changes. (view-mode-map): Change h and ? to use describe-mode. Delete binding of help char. (view-mode-enter): Use describe-mode in message. Thu Nov 23 12:40:47 1995 Andreas Schwab * ediff-mult.el (ediff-intersect-directories): Quote symbols starting with `:'. * view.el (view-mode-enter): Replace Help-helper by help-command in doc string and message. * sort.el (sort-regexp-fields): Doc fix. * inf-lisp.el (inferior-lisp-load-command): Doc fix. * imenu.el (imenu-generic-expression, imenu--generic-function): Doc fix. * add-log.el (add-change-log-entry): Initialize add-log-full-name and add-log-mailing-address before prompting. Thu Nov 23 00:56:16 1995 Richard Stallman * completion.el (cmpl-make-standard-completion-syntax-table) (cmpl-make-c-def-completion-syntax-table): Use make-syntax-table. (completion-c-mode-hook): Encapsulate C-mode changes in new function. Either call it now or put it on c-mode-hook. Wed Nov 22 14:55:12 1995 Barry Warsaw * cc-mode.el (c-beginning-of-statement-1): CASE 3, can't just return t at end of let clause since this will break arglist-cont-nonempty lines. Wed Nov 22 14:03:08 1995 Geoff Voelker * makefile.nt (install, clean): Don't use switches to del not supported by Win95. Tue Nov 21 00:12:36 1995 Richard Stallman * man.el (Man-fontify-manpage, Man-cleanup-manpage): Convert \255 to a dash. * apropos.el (apropos-print): Put the item property on the whole printed symbol. (apropos-follow): Look for the item property only adjacent to point. Signal an error if there is none. Mon Nov 20 00:39:01 1995 Richard Stallman * apropos.el (apropos-print): Use apropos-local-map as buffer's map, not as a text property. * ediff-hook.el (menu-bar-epatch-menu, menu-bar-ediff-merge-menu) (menu-bar-ediff-menu): Give names to the menus. * ediff-mult.el: Renamed from ediff-meta.el. Changed provide. * ediff.el, ediff-util.el: Require ediff-mult. * ediff-hook.el (ediff-show-registry): Use renamed file ediff-mult.el. * array.el (array-mode): Set overwrite-mode to overwrite-mode-textual. * term/pc-win.el (msdos-color-aliases): Add more aliases. (msdos-face-setup): Change colors for bold, bold-italic, underline. (x-frob-font-slant): Define as no-op. * saveplace.el (save-place-to-alist): Handle hexl-mode specially. Sun Nov 19 18:24:58 1995 Erik Naggum * calendar.el (cal-tex-cursor-week-iso): Doc fix. Sun Nov 19 15:39:49 1995 Richard Stallman * calendar.el: (cal-tex-cursor-filofax-week): Renamed from cal-tex-cursor-week6. (cal-tex-cursor-filofax-2week): Renamed from cal-tex-cursor-week5. (cal-tex-cursor-week-monday): Renamed from cal-tex-cursor-week4. (cal-tex-cursor-week-iso): Renamed from cal-tex-cursor-week3. * cal-tex.el (cal-tex-version): Deleted. (cal-tex-cursor-year-landscape): Doc fix. (cal-tex-cursor-filofax-week): Renamed from cal-tex-cursor-week6. (cal-tex-cursor-filofax-2week): Renamed from cal-tex-cursor-week5. (cal-tex-cursor-week-monday): Renamed from cal-tex-cursor-week4. (cal-tex-cursor-week-iso): Renamed from cal-tex-cursor-week3. * info.el (Info-directory-list): Use source-directory. Sat Nov 18 10:49:47 1995 Richard Stallman * calendar.el (calendar-goto-info-node): Don't let same-window-buffer-names do its usual job--force *info* buffer into another window. * simple.el (do-auto-fill): Look at 2nd line for fill prefix even when on the first line. Don't accept non-whitespace prefix from the first line. * fill.el (fill-context-prefix): New arg first-line-regexp. * finder.el (finder-known-keywords): Delete `debugging'. Sat Nov 18 03:09:37 1995 Lars Magne Ingebrigtsen * nntp.el (nntp-open-server): Accept a second optional parameter for just changing virtual server. Doc fix. (nntp-possibly-change-server): Use it. (nntp-close-server): Ditto. Fri Nov 17 21:39:30 1995 Richard Stallman * cc-mode.el (c-guess-basic-syntax, c-beginning-of-statement-1): Do not check for c-conditional-key when skipping backwards over statements that look sort of like conditionals. This makes statements following nested functions indent correctly. CASE 9B.3 (unknown catchall) now gets triggered by the brace that opens a nested function. Also, this changes the relpos for top-level defun-open braces, but that will be very hard to fix, and it may break backward compatibility. * cc-mode.el (c-guess-basic-syntax): CASE 5H, inclass relpos should be relative to boi of the open brace, not the beginning of the class keyword. * cc-mode.el (c-fill-paragraph): Doc fix. Fri Nov 17 20:51:54 1995 Lars Magne Ingebrigtsen * gnus.el (gnus-group-quit-config): Return the quit-config instead of a list containing the quit-config. Fri Nov 17 17:34:13 1995 Andreas Schwab * mail-utils.el (rmail-dont-reply-to): Preserve whitespace after comma. Fri Nov 17 13:36:39 1995 Richard Stallman * etags.el (next-file): Make interactive arg t if had any prefix arg. * faces.el (face-color-supported-p): Return nil if no window system. Fri Nov 17 12:39:59 1995 Ed Reingold * cal-coptic.el: Fix epoch of Ethiopiac calendar. * cal-chinese.el: Minor fixes. Fri Nov 17 11:03:20 1995 Boris Goldowsky * indent.el (move-to-left-margin): Removed left-over code that made it fail on right-justified and centered text. * fill.el (fill-region-as-paragraph): Remove redundant "setq from". Don't add extra newline at end if there is no text in paragraph -- doing so can make fill-region loop. When testing for indentation exceeding fill-column, skip back over tabs too. Fri Nov 17 03:19:45 1995 Karl Heuer * rmail.el (rmail-retry-failure): Add missing colons in regexp. Use " +", not " *", to check for indented text. Don't make a temp buffer; just record the indent amount. Simplify. Fri Nov 17 00:26:48 1995 Richard Stallman * simple.el (do-auto-fill): Ignore the result of fill-context-prefix if it is empty. * cc-mode.el (c-common-init): Set adaptive-fill-regexp to nil. * fill.el (fill-context-prefix): Use adaptive-fill-regexp only if non-nil. Thu Nov 16 16:49:56 1995 Andreas Schwab * calendar.el (calendar-julian-date-string): Autoload this. Thu Nov 16 17:23:03 1995 Richard Stallman * ange-ftp.el (ange-ftp-process-handle-hash): If ange-ftp-hash-mark-unit is nil, don't display a message. (ange-ftp-process-filter): Call ange-ftp-process-handle-hash even if ange-ftp-hash-mark-unit is nil. Thu Nov 16 15:06:51 1995 Johan Vromans * forms.el: Use `buffer-substring-no-properties' instead of `buffer-substring' to avoid the properties being copied. Thu Nov 16 12:22:11 1995 Richard Stallman * cc-mode.el (c-beginning-of-statement, c-end-of-statement): New arg sentence-flag. Use that instead of interactive-p. (c-mode-help-address): Send bug reports to bug-gnu-emacs too. * fill.el (fill-context-prefix): Check adaptive-fill-function non-nil. Thu Nov 16 15:38:58 1995 Per Abrahamsen * menu-bar.el (minibuffer maps): Delete extra quote. Thu Nov 16 11:31:46 1995 Richard Stallman * info.el (Info-complete-menu-item): Don't treat `* Menu:' as a menu item. Wed Nov 15 12:24:00 1995 Richard Stallman * nntp.el (nntp-close-server-internal): Don't call nntp-possibly-change-server. * cplus-md.el (c++-mode): Remove autoload cookie. * mouse-sel.el (mouse-sel-lost-selection-hook): Undo prev change. * tmm.el (tmm-prompt): Delete tmm-add-prompt if we fail. Don't switch to *Completions* if it wasn't created. * startup.el (command-line-1): Mention F10. Tue Nov 14 12:34:00 1995 Richard Stallman * fill.el (fill-individual-paragraphs): Advance 1 line in inner loop. (fill-region-as-paragraph): Handle left margin extending to or past fill-column. * mouse-sel.el (mouse-sel-lost-selection-hook): Use (car selection). * indent.el (indent-line-to): Delete spaces before inserting a tab. * calendar.el (calendar-julian-from-absolute): Autoload it. * goto-addr.el (goto-address): Use S-mouse-2, not S-mouse-1. Add autoload cookie. * startup.el (command-line-1): Reorganize the initial help output. * hexl.el (hexl-mode): Set require-final-newline to nil. If point was at end of buffer, move it back one byte. Tue Nov 14 20:25:01 1995 Eric Ding * goto-addr.el (goto-address-highlight-p): New variable. (goto-address-fontify): Removed check for invisible text, set inhibit-point-motion-hooks instead Mon Nov 13 15:20:42 1995 Richard Stallman * vc-hooks.el (vc-locking-user): In CVS case, convert user number to a string. * vc.el (vc-directory): Require dired. (vc-revert-buffer): Ignore vc-suppress-confirm. Mon Nov 13 13:10:12 1995 Morten Welinder * arc-mode.el (archive-remote-regexp): Doc fix. Sun Nov 12 16:54:33 1995 Andreas Schwab * compile.el (compilation-sentinel): Use the local value of compilation-exit-message-function in the process buffer. Sun Nov 12 14:33:59 1995 Richard Stallman * tmm.el (tmm-define-keys): Don't define ESC ESC. * ffap.el: New file. * info.el (info-insert-file-contents-1): Various rewrites. Compute EXT-LEFT after removing the dot from SUFFIX. Sat Nov 11 00:24:12 1995 Richard Stallman * window.el (balance-windows): Don't count the menu bar's lines in the frame height. * menu-bar.el (delete-frame): Don't use delete-frame as event name. * startup.el (command-line): Don't reject unknown args here. (command-line-1): Detect it here. * dabbrev.el (dabbrev-case-replace): Doc fix. Fri Nov 10 19:30:48 1995 Richard Stallman * tmm.el: Define menu-bar mouse-1 as tmm-menubar. * simple.el (universal-argument-other-key): Add to existing unread-command-events value. Fri Nov 10 19:34:15 1995 Per Abrahamsen * xt-mouse.el (global-map): Removed bindings of down events to ignore. (xterm-mouse-translate): Only generate down event when bound. Cleanup. Support for mode line and vertical bar dragging, and menu-bar events. (xterm-mouse-x): New variable. (xterm-mouse-y): New variable. (mouse-position): Advice to use above variables. (xterm-mouse-event): Support menu-bar. Set xterm-mouse-x and xterm-mouse-y. Fri Nov 10 10:29:12 1995 Boris Goldowsky * add-log.el (change-log-mode): Remove incorrect "^" anchors from paragraph-start and -separate. (change-log-fill-paragraph): Use regular value of paragraph-start to bound paragraph to be filled, modified values only to do the filling. Make lines beginning with parentheses paragraph-starters, but not paragraph-separators. * cc-mode.el (c-common-init): Remove "^" from paragraph-start and paragraph-separate. Moved page-delimiter first in case it has a "^" also. * lisp-mode.el (lisp-mode-variables, lisp-fill-paragraph): Remove "^" from paragraph-start and paragraph-separate. Moved page-delimiter first in case it has a "^" also. * sh-script.el (sh-mode): as above. Use page-delimiter rather than literal "^L". * fill.el (fill-region-as-paragraph): Since adaptive-fill-regexp is supposed to match text STARTING at the left margin, use `looking-at' rather than `re-search-forward'. (fill-individual-paragraphs): Match fill-prefixes starting at left-margin. Fri Nov 10 04:55:12 1995 Erik Naggum * view.el (View-scroll-lines-forward): Don't recenter at end. Fri Nov 10 14:11:43 1995 Kevin Rodgers * files.el (find-file-noselect): Respect the value of find-file-visit-truename when FILENAME is a directory and find-file-run-dired is non-nil. Fri Nov 10 13:55:55 1995 Boris Goldowsky * facemenu.el (facemenu-unlisted-faces): Remove font-lock faces from the default list. The list of face names was out of sync; to prevent this from happenning again I made font-lock.el, and other packages that create "private" faces, put them on the list themselves. This should give them a better chance of being updated when the packages are changed. * calendar.el (holiday-face, calendar-today-face, diary-face): Add faces to facemenu-unlisted-faces before creating so that facemenu won't list them as faces to be added interactively. * viper.el: Don't list any faces in menu. * paren.el (show-paren-command-hook): Don't list `paren-mismatch' face in menu. * make-mode.el (makefile-space-face): Don't list in facemenu. * ediff-init.el: All faces added to facemenu-unlisted-faces list. * facemenu.el (facemenu-active-faces): Replaces function `facemenu-discard-redundant-faces'. This version, written by Simon Marshall, is faster and does not require optional argument for recursive re-entry. New argument FRAME allows check to be done relative to face definitions in any frame. Fri Nov 10 12:58:36 1995 Richard Stallman * enriched.el (enriched-next-annotation): Doc fix. * dos-fns.el: Fix previous change. Thu Nov 9 23:27:08 1995 Richard Stallman * make-mode.el (makefile-mode): Call makefile-define-space-face only if it is defined. (makefile-define-space-face): Create the face unconditionally; alter it only if have X. * cal-x.el: Require calendar. Thu Nov 9 12:40:50 1995 Richard Stallman * simple.el (do-auto-fill): Use fill-context-prefix. * fill.el (fill-region-as-paragraph): Use fill-context-prefix. (fill-context-prefix): New function. Thu Nov 9 03:20:51 1995 Simon Marshall * font-lock.el (font-lock-mode): Use make-local-hook. (font-lock-fontify-buffer): Don't preserve buffer modification here, it is done elsewhere, but do preserve match-data. (font-lock-fontify-syntactically-region, font-lock-fontify-keywords-region): Don't preserve buffer modification and temporarily install font-lock-syntax-table here. (font-lock-fontify-region): Do it here instead. (font-lock-fontify-anchored-keywords): Ensure LIMIT is end of line. (font-lock-match-c++-style-declaration-item-and-skip-to-next): No need to do end-of-line here now. (font-lock-keywords): Doc fix. (font-lock-make-face): Add the face to facemenu-unlisted-faces, from Boris Goldowsky . * compile.el (compilation-mode-font-lock-keywords): No leading spaces. Wed Nov 8 05:59:35 1995 Richard Stallman * apropos.el (apropos-print): Use buffer *Apropos*, not *Help*. (apropos-follow): Don't print a "how to get back" message. * awk-mode.el (awk-mode): Require cc-mode. * term/pc-win.el (x-display-color-p): Accept optional arg. * dos-fns.el (mode-line-format): Modify it, don't override it entirely. * startup.el (command-line): Complain about unknown options. Tue Nov 7 14:47:02 1995 Richard Stallman * simple.el (shell-command-on-region): Use region-beginning and region-end, to put them in the command history. Tue Nov 7 02:46:06 1995 Kevin Gallo * term/win32-win.el: New file. * startup.el [win32] (normal-top-level, command-line, command-line-1): * mouse.el [win32] (mouse-set-region): * faces.el [win32] (make-face, make-face-x-resource-internal): * facemenu.el [win32] (face-menu-read-color, list-colors-display, facemenu-color-equal, face-menu-get-face): Test for 'win32 window system as well as 'x. * makefile.nt (install): Change same-dir test to create test file in installation tree and thereby support read-only shares. Mon Nov 6 15:37:54 1995 Richard Stallman * apropos.el (apropos-follow): Fix error message. * startup.el (command-line): Handle = in option only if starts with --. * tmm.el (tmm-define-keys): New subroutine. (tmm-add-prompt): Use that to define keys in both maps separately. * term/internal.el: Rewrite for new case tables. Mon Nov 6 11:03:34 1995 Boris Goldowsky * fill.el (fill-region-as-paragraph): Don't insert extra space at end of filled region. Mon Nov 6 08:27:45 1995 Simon Marshall * bytecomp.el (byte-force-recompile): Make suitably interactive. Sat Nov 4 13:57:09 1995 Richard Stallman * tmm.el: Use f10 as well as M-`. * menu-bar.el (menu-bar-tools-menu): Always define GNUS entry. * bytecomp.el (byte-compile-associative): Do operations left to right. Sat Nov 4 23:36:01 1995 Karl Heuer * make-mode.el (makefile-define-space-face): Don't make face if non-X. Sat Nov 4 01:22:21 1995 Lars Magne Ingebrigtsen * nnvirtual.el, nntp.el, nnspool.el, nnml.el, nnmh.el, nnmbox.el, * nnmail.el, nnkiboze.el, nnheader.el, nnfolder.el, nneething.el, * nndoc.el, nndir.el, nnbabyl.el, gnus.el, gnus-vm.el, * gnus-vis.el, gnus-uu.el, gnus-score.el, gnus-msg.el, gnus-mh.el, * gnus-kill.el, gnus-ems.el, gnus-edit.el, gnus-cite.el, * gnus-cache.el, custom.el: New files. Fri Nov 3 21:18:13 1995 Erik Naggum * gnus.el, gnusmail.el, gnuspost.el, gnusmisc.el, gnus-uu.el, * mhspool.el, nnspool.el, nntp.el: GNUS release 4 files deleted. * hilit19.el: Removed old gnus hooks. (gnus-group-mode): Adapt to new Gnus. (gnus-summary-mode): Removed. Fri Nov 3 18:11:32 1995 Karl Heuer * sendmail.el (mail): Don't change directory for *mail* buffer. (sendmail-send-it, mail-recover): Instead, temporarily change to a safe directory for just the subprocess. * tex-mode.el (tex-send-command): Give meaningful error message. Fri Nov 3 12:26:02 1995 Richard Stallman * sendmail.el (mail-yank-clear-headers): Do nothing if mail-yank-ignored-headers is nil. * pc-select.el (pc-selection-mode): Don't mess with c-mode-map. * startup.el (user-mail-address): Doc fix. * view.el (view-mode-map): Use ordinary Help command. Thu Nov 2 21:58:56 1995 Daniel Pfeiffer * sh-script.el (sh-shells): Eliminated variable redundant with `interpreter-mode-alist'. (sh-beginning-of-command): Take into account \quoted newline. (sh-builtins, sh-leading-keywords, sh-other-keywords): Now three distinct sets for font-locking. (sh-font-lock-keywords-1, sh-font-lock-keywords-2): New variables and functions to give the user finer control over how much to fontify, including new distinction between keywords and builtins. (sh-mode): Use new features of `font-lock-defaults' and adaptation to skeleton changes. (sh-while): Fix csh, es & rc skeletons. * skeleton.el (skeleton-end-hook): Now defvared and responsible for pushing out anything following skeleton to next line. Thus this behaviour can now be controlled by modes. (skeleton-insert): Parameter `no-newline' removed. (skeleton-read): Take this into account. (skeleton-internal-1): Less spurious empty lines when wrapping. * sh-script.el (sh-remember-variable): Set variable to empty string, so as not to mess up subprocesses' environment. Not so nice for completion. * two-column.el (minor-mode-map-alist): Use substitute-key-definition to find the appropriate bindings for window enlarge/shrink. (2C-shrink-window-horizontally, 2C-enlarge-window-horizontally): Renamed from shrink-window-horizontally, enlarge-window-horizontally to avoid redefining the standard functions. Thu Nov 2 21:27:35 1995 Stephen Gildea * mh-e.el (mh-make-folder-mode-line): support mh-msg-count. (mh-delete-scan-msgs): use fast new mh-goto-msg. * mh-utils.el (mh-goto-msg): binary search (much faster!). (mh-prompt-for-folder): error if regular file. * mh-comp.el: reporter.el support. Thu Nov 2 15:53:02 1995 Richard Stallman * rmail.el (rmail-delete-message-hook): New hook. (rmail-delete-message, rmail-delete-forward): Run the hook. * rmail.el (rmail-mode-hook, rmail-get-new-mail-hook): Add defvars. (rmail-show-message-hook): Likewise. * simple.el (do-auto-fill): When choosing fill-prefix, don't include the left-margin indentation. * fill.el (fill-individual-paragraphs): Insist on nonempty header name, in the special mailp case. Thu Nov 2 15:29:22 1995 Erik Naggum * ehelp.el (with-electric-help): Add missing argument MINHEIGHT. Thu Nov 2 04:31:32 1995 Andre Spiegel * vc-hooks.el (vc-utc-string): Use timezone of TIMEVAL for the correction, not the current one. (vc-rcsdiff-knows-brief): New variable. (vc-rcs-lock-from-diff): Use it. * vc.el (vc-backend-diff): Use new variable vc-rcsdiff-knows-brief. Wed Nov 1 23:30:20 1995 Karl Heuer * make-mode.el: Renamed from makefile.el. * term/x-win.el: Don't require initial whitespace in vendor name. * tpu-edt.el (tpu-set-mode-line): Add element for column number. Tue Oct 31 19:44:58 1995 Richard Stallman * cc-mode.el (c-recognize-knr-p): Default now t. * server.el (server-log): Record the current time. End with newline whenever STRING doesn't end with one. * sh-script.el (sh-mode-map): Put sh-execute-region on C-M-x. Put executable-interpret on C-c C-x. Tue Oct 31 00:24:32 1995 Richard Stallman * loadup.el: Always load menu-bar. * msb.el (msb--toggle-menu-type): Pass t as arg. * startup.el (command-line-1): Say how to invoke menu bar, if not X. * jka-compr.el (auto-compression-mode): Make arg optional. * loadup.el: Fix previous change. Mon Oct 30 19:25:42 1995 Richard Stallman * mailabbrev.el (mail-abbrev-syntax-table): Fix initialization. * startup.el (command-line): If not X, do enable menu bar. Mon Oct 30 19:00:50 1995 Stephen Gildea * time-stamp.el: Update some doc strings. (time-stamp-strftime): Ignore some additional chars we might want to use in the future for additional controls or parameters. (time-stamp): Minor optimizations. Mon Oct 30 12:38:27 1995 Richard Stallman * help.el (describe-function): Call documentation just once. (describe-key): Likewise. * files.el (set-auto-mode): If mode cmds move point, obey them. * help.el (describe-variable): Don't call substitute-command-keys. * rmailsum.el (rmail-summary-overlay): Make it a permanent local. * vmsx.el: File deleted. Mon Oct 30 03:31:21 1995 Simon Marshall * makefile.el (makefile-define-space-face): Use frame-parameters for frame and display attributes. Sun Oct 29 17:22:51 1995 Andreas Schwab * loadup.el (finding existing executable versions): Add a period to the end of BASE. * arc-mode.el (archive-zoo-summarize): Handle archives with long file names. * disass.el (disassemble-internal): Handle lazy-loaded doc strings. (disassemble-1): Handle lazy-loaded bytecode objects. * etags.el (select-tags-table): Don't modify the value of tags-table-list. Sun Oct 29 15:21:43 1995 Richard Stallman * tmm.el (tmm-old-mb-map): Initialize to nil. (tmm-delete-map): Don't use tmm-old-mb-map if nil. (tmm-add-prompt): Bind C-n and C-p. Put only the shortcuts into the completion buffer's map. Produce the completion list by hand so as not to sort it. (tmm-prompt): Start at the first item in the menu. Don't reverse tmm-km-list; reverse compl-list instead. Use try-completion in last-ditch attempt to find a match. Rename compl-list to history. (tmm-get-keybind): Put more local bindings last in a menu. Major rewrite. (tmm-menubar): Handle menu-bar-final-items. (tmm-remove-shortcuts): Function deleted. (tmm-add-shortcuts): If we can't find a letter shortcut, use a numeric shortcut. * simple.el (column-number-mode): Make default value nil. * cc-mode.el (c-guess-basic-syntax): Verify c-access-key is non-nil before looking for it. * bytecomp.el (byte-recompile-directory): New arg FORCE. (byte-force-recompile): New function. * case-table.el (describe-buffer-case-table): Use set-char-table-range. Sat Oct 28 02:19:32 1995 Erik Naggum * iso02-syn.el: Adapt to new char-table implementation. Fix name of file in the first line, part number syntax of ISO standards, and `provide' clause. Register file with RCS. * ange-ftp.el (ange-ftp-ftp-name,ange-ftp-replace-name-component): Use posix-string-match for complex regexp in `ange-ftp-name-format'. (ange-ftp-process-sentinel): Quote final * in buffer name match. Fri Oct 27 17:40:51 1995 Noah Friedman * rlogin.el (rlogin): If `buffer' arg is a buffer object, initialize `buffer-name' to the buffer name. Set `buffer' to buffer actually created or returned by get-buffer-create. Set `proc' to the process actually in the new buffer, not the process with the name buffer-name; they may not be the same if buffers have been renamed. Thu Oct 26 18:38:26 1995 Ed Reingold * cal-chinese.el (calendar-chinese-sexagisimal-name): New function. (holiday-chinese-new-year,calendar-chinese-date-string): Use it. Thu Oct 26 14:21:26 1995 Richard Stallman * files.el (set-visited-file-name, basic-save-buffer): Set buffer-file-number consistently with find-file-noselect. Thu Oct 26 09:52:51 1995 Simon Marshall * font-lock.el: General reorganisation. (font-lock-fontify-syntactically-region): Renamed from font-lock-fontify-region. Assume that region end-points are at bol. Don't bother wrapping with save-excursion; caller does this. (font-lock-fontify-keywords-region): Renamed from font-lock-hack-keywords. Call font-lock-fontify-anchored-keywords if car of HIGHLIGHT is not a number (i.e., is another MATCHER, not a MATCH), for new MATCH-ANCHORED font-lock-keywords structure. (font-lock-fontify-region): Use them. (font-lock-after-change-function): Use it. Don't bother invalidating font-lock-cache-position; called function does this. (font-lock-keywords-only): Renamed from font-lock-no-comments. (font-lock-maximum-decoration, font-lock-maximum-size): Doc fix for new functionality. (font-lock-set-defaults, font-lock-mode): Cope if they are lists. (font-lock-keywords): Doc fix for new MATCH-ANCHORED structure and new OVERRIDE values. (font-lock-fontify-anchored-keywords): New function for processing the new MATCH-ANCHORED structure. (font-lock-fillin-text-property, font-lock-prepend-text-property, font-lock-append-text-property): New text property functions. (font-lock-apply-highlight): Use them for new OVERRIDE values. (scheme-font-lock-keywords): New variable. (c-font-lock-keywords-3, c++-font-lock-keywords-3): New variables. (font-lock-defaults-alist): Use them for Scheme, C and C++ modes. * fast-lock.el (fast-lock-read-cache): Set fast-lock-cache-filename. (fast-lock-cache-data): Don't set it here via caller's local variable. * fortran.el (fortran-mode): Addition for font-lock-defaults. (fortran-font-lock-keywords-3): Rewrite using MATCH-ANCHORED structure. * rmail.el (rmail-font-lock-keywords): Better citation regexp. * sendmail.el (mail-font-lock-keywords): Likewise. Thu Oct 26 02:39:28 1995 Richard Stallman * morse.el: New file. Wed Oct 25 15:23:31 1995 Richard Stallman * cc-mode.el (c-mode): Add autoload. * loadup.el: Don't load c-mode. * loaddefs.el: Get rid of cplus-md.el; add cc-mode.el. * cmacexp.el: Require cc-mode. * hideif.el: Provide hideif; require cc-mode. * help.el (describe-key, describe-key-briefly): For a mouse click, go to its buffer and position before looking up the key. Wed Oct 25 13:01:36 1995 Gregor Schmid * tcl-mode.el: Add support for imenu. Add support for font-lock-mode (thanks to ). Tue Oct 24 12:38:43 1995 Richard Stallman * files.el (set-visited-file-name): Abbreviate buffer-file-name. * mouse.el (mouse-drag-region): Set end-of-range after calling mouse-scroll-subr. (mouse-set-region): Don't do the sit-for on a pc frame. Tue Oct 24 10:29:59 1995 Brian D. Carlstrom * gud.el (gud-dbx-directories): New variable. (gud-dbx-massage-args): Use gud-dbx-directories. (gud-dbx-file-name): New function. (gud-irixdbx-marker-filter): Use gud-dbx-file-name. (gud-dbx-file-file): Use gud-dbx-file-name. * gud.el (gud-filter): Fix previous change. Tue Oct 24 11:44:45 1995 Ed Reingold * cal-menu.el (calendar-mouse-print-dates): Fix entry for Chinese calendar. * cal-chinese.el: Completely rewritten! Tue Oct 24 00:06:14 1995 Richard Stallman * add-log.el (get-method-definition, get-method-definition-1): Rename var md to get-method-definition-md and defvar it. Mon Oct 23 12:50:38 1995 Richard Stallman * ange-ftp.el (internal-ange-ftp-mode): Set comint-password-prompt-regexp locally to not match anything. * informat.el (Info-validate, Info-validate-node-name): Use buffer-substring-no-properties. (Info-tagify, batch-info-validate, Info-validate-tags-table): Likewise. * informat.el (Info-validate-tags-table): Change handling of newline in the loop reading node names. * info.el (Info-following-node-name, Info-extract-menu-node-name) (Info-select-node): Use buffer-substring-no-properties. Sun Oct 22 12:30:46 1995 Richard Stallman * case-table.el (copy-case-table): New function. (set-case-syntax-delims, set-case-syntax-pair, set-case-syntax): Clear out the three extra slots. Sun Oct 22 02:28:11 1995 Erik Naggum * derived.el (derived-mode-init-mode-variables): Make proper syntax-table. * iso-syntax.el: Handle new case-table implementation. Sat Oct 21 13:31:39 1995 Richard Stallman * msb.el: Require cl only when compiling. Sat Oct 21 13:31:39 1995 Axel Boldt * electric.el (Electric-command-loop): Don't display a prompt if 2nd arg equals or returns 'noprompt. * ehelp.el: Fix key bindings. (electric-help-mode): Use mouse-leave-buffer-hook. (electric-help-retain): Remove mouse-leave-buffer-hook. (with-electric-help): New argument minheight. (electric-help-execute-extended): New function. (electric-help-ctrl-x-prefix): New function. (electric-help-command-loop): Make messages more consistent. Include strategic sit-for 0, so that pos-visible-in-window-p will return the right thing. Make 2nd arg of Electric-command-loop return 'noprompt if we are in isearch-mode. Eval to-be-executed at the very end. (ehelp-map): Electrify apropos too. Fri Oct 20 15:34:39 1995 Richard Stallman * noutline.el (outline-view-change-hook): New hook variable. (outline-flag-region): Run the hook. * informat.el (Info-validate-tags-table): Fix the scan of the tags table checking that the positions are right. (Info-validate): Use buffer-substring-no-properties. * dabbrev.el (dabbrev-expand): When no more expansions, Put back the original abbrev with its original case pattern. (dabbrev--find-expansion): Move buffers that are visible on the screen to the front of the list to be searched. * startup.el (normal-top-level): Set auto-save-list-file-name later, after calling command-line. Fri Oct 20 15:08:22 1995 Erik Naggum * comint.el (comint-exec-1): Fix previous change. Fri Oct 20 11:22:25 1995 Richard Stallman * add-log.el (add-log-current-defun): Handle `private', `public' in C++ class definitions. Thu Oct 19 01:14:59 1995 Richard Stallman * isearch.el (isearch-message-prefix): Change "wrapped" to "overwrapped" when past original start point. * comint.el (comint-exec-1): Don't alter EMACS envvar if it's already defined. * cplus-md.el (calculate-c++-indent): Skip over paren-group when looking back to determine context of a top-level line. Don't treat a line starting with } as a continuation. Wed Oct 18 21:06:59 1995 Richard Stallman * emacsbug.el (report-emacs-bug): Don't mention system-configuration-options if it is empty. Make it clearer what that text is. Tue Oct 17 14:10:19 1995 Richard Stallman * tex-mode.el (tex-start-of-header): Now a regexp. (tex-end-of-header): Likewise. (plain-tex-mode, latex-mode, slitex-mode, tex-region): Changed accordingly. * pc-select.el (pc-selection-mode): Add autoload cookie. * pc-select.el: New file. Mon Oct 16 22:21:38 1995 Rolf Ebert * ada-mode.el: All doc strings changed to comply with standard Emacs conventions. (ada-mode): Support new font-lock-mode. (ada-format-paramlist): Changed all `accept' to `access'. (ada-insert-paramlist): Changed all `accept' to `access'. (ada-in-comment-p): Use standard Emacs way `parse-partial-sexp'. (ada-font-lock-keywords-1): Change order of some alternatives. Mon Oct 16 17:45:22 1995 Richard Stallman * cc-mode.el (c-emacs-features): Don't expect integer in syntax table. * flow-ctrl.el (enable-flow-control): Use a char-table. Sun Oct 15 04:53:55 1995 Richard Stallman * mailabbrev.el (mail-abbrev-syntax-table): Rewrite using map-char-table. * derived.el (derived-mode-merge-syntax-tables): Rewrite using map-char-table. * hippie-exp.el (he-transfer-case): Fix typo in prev change. Fri Oct 13 23:14:10 1995 Michael Kifer > * ediff.el (ediff-version): is now autoloaded. * ediff-init.el: Moved defsubsts up. * ediff-hook.el: Now defines [window] in menu-bar-ediff-menu. Fri Oct 13 20:14:10 1995 Michael Kifer > * viper.el (vip-set-hooks): Use view-mode-hook in emacs and view hook in xemacs. (vip-read-string-with-history): minibuffer-setup-hook no longer waits for the user to type, if there are unread events. Added (vip-leave-region-active) to all simple movement commands. Viper now understands syntactic tables. Harnessed view-minor-mode. (vip-read-string-with-history,vip-search): won't pause inside macros any more. * viper-mous.el (vip-surrounding-word): modified to understand tripple clicks. * viper-util.el (vip-leave-region-active): new function. * viper-ex.el (ex-write): uses better defaults. * viper-macs.el (vip-record-kbd-macro): correctly escapes `.' and `[' now. Fri Oct 13 15:17:28 1995 Richard Stallman * help.el (variable-at-point, function-called-at-point): Switch temporarily to emacs-lisp-mode-syntax-table. * goto-addr.el: New file. * browse-url.el: New file. Fri Oct 13 1995 Anders Holst (aho@nada.kth.se) * hippie-exp.el: (hippie-expand): Removed bug - don't undo from another buffer. (he-reset-string): Removed bug - don't move markers. (he-capitalize-first): New function, defining new "case". (he-transfer-case): New function. (he-transfer-case-ok): Function removed. (he-substitute-string,he-ordinary-case-p,he-string-member): Use the new functions above, for the new case handling. (he-file-name-chars): New variable. (he-file-name-beg): Use `he-file-name-chars'. (he-file-name-nondirectory,he-file-name-directory, he-file-directory-p,he-concat-directory-file-name): New functions to handle VMS and PC filename formats more accurately. (try-complete-file-name,try-complete-file-name-partially): Use the new functions above. (try-expand-line-all-buffers,try-expand-list-all-buffers, try-expand-dabbrev-all-buffers): Use `case-fold-search' from the original buffer. (he-line-beg): Removed bug that made point move. (try-expand-all-abbrevs): Check that abbrev tables exist before use. (try-expand-dabbrev-visible): New try function. (he-search-window): New variable used by `try-expand-dabbrev-visible'. (he-dab-search-regexp): Function removed. (he-dab-search): Renamed to `he-dabbrev-search'. (he-dabbrev-search): Find only whole matching symbols. (he-dabbrev-skip-space): New variable. (he-dabbrev-beg): Use `he-dabbrev-skip-space'. (try-expand-dabbrev-from-kill,he-dabbrev-kill-search): New try function, with requisites. (try-expand-whole-kill,he-whole-kill-search,he-kill-beg): New try function, with requisites. (he-search-loc2): New variable, used by `try-expand-whole-kill' and `try-expand-dabbrev-from-kill'. (hippie-expand-try-functions-list): Added the try functions `try-complete-file-name-partially', `try-expand-dabbrev-from-kill' and `try-complete-lisp-symbol-partially'. (Several functions): Adjusted and corrected use of `he-tried-table'. Fri Oct 13 09:06:37 1995 Ed Reingold * cal-tex.el: Minor fixes to doc strings and other small changes. Thu Oct 12 13:55:26 1995 Richard Stallman * help.el (variable-at-point, function-called-at-point): Fix revious changes. * iso-transl.el: Handle aliases dead-acute,... Thu Oct 12 11:28:50 1995 Ed Reingold * cal-tex.el: New file. * calendar.el: Add autoloads and key definitions for cal-tex.el. * cal-menu.el: Add menu items for cal-tex.el. Wed Oct 11 14:26:34 1995 Robert J. Chassell * texinfmt.el (texinfo-unsupported): Handle commands in all capitals. Wed Oct 11 11:38:55 1995 Richard Stallman * files.el (find-alternate-file-other-window): New function. Wed Oct 11 01:23:31 1995 Michael Kifer * menu-bar.el: Moved (define-key menu-bar-ediff-menu ...) to ediff-hook.el, as menu-bar-ediff-menu is not defined yet. Wed Oct 11 00:59:00 1995 Richard Stallman * fill.el (adaptive-fill-function): Change defun to defvar. Tue Oct 10 12:52:39 1995 Richard Stallman * simple.el (next-completion): Specify the LIMIT arg when searching for text properties. * help.el (function-called-at-point, variable-at-point): Don't back up if we start at the beginning of a symbol. * disp-table.el (display-table-slot, set-display-table-slot): Get slot number from a property of its name. Eliminate the type-checking. (make-display-table): Call make-char-table the new way. (describe-display-table): Use slot names to access slots. (display-table): Give it the char-table-extra-slots property. (display-table-char-p, display-table-vector-p): Functions deleted. (display-table-slot-name-alist): Variable deleted. Mon Oct 9 22:30:42 1995 Andreas Schwab * mail-utils.el (mail-strip-quoted-names): Preserve white space after comma when stripping text outside of <> delims. Mon Oct 9 15:41:18 1995 Richard Stallman * view.el: Doc fixes. (view-highlight-face): New variable. (view-search): Use that variable. Mon Oct 9 14:01:04 1995 Roland McGrath * etags.el (tags-table-check-computed-list): Map tags-expand-table-name over lists of included tables. Mon Oct 9 13:44:43 1995 Erik Naggum * disp-table.el: New implementation with char-tables. Mon Oct 9 13:08:04 1995 Richard Stallman * xt-mouse.el: New file. Mon Oct 9 00:49:37 1995 Noah Friedman * mailabbrev.el (mail-abbrev-syntax-table): Use `equal' instead of `=', in case elts of syntax table are lists, not integers. Sun Oct 8 15:58:21 1995 Erik Naggum * ada-mode.el (ada-gen-treat-proc): Bind `procname' and `functype'. * view.el (view-exit): Delete view-overlay only if it exists. Sun Oct 8 14:56:12 1995 Richard Stallman * server.el (server-start): Try both full hostname and shortened hostname when deleting the socket file. * gud.el (gud-filter): Move the gud-display-frame call outside of the save-excursion. New var process-window controls which window to do it in. Sat Oct 7 00:08:29 1995 Richard Stallman * subr.el (make-syntax-table): Use nil for "inherit". Fri Oct 6 11:11:31 1995 Richard Stallman * bytecomp.el (byte-compile-from-buffer): Bind print-level. * simple.el (newline): Call barf-if-buffer-read-only. * iso-acc.el: Fix typo calling iso-accents-customize. (iso-accents-compose): If this-command is non-nil, do prompt. Thu Oct 5 20:54:29 1995 Michael Kifer * ediff-meta.el: new file. * ediff-hook.el: new file. * ediff.el: Moved menubar definitions to a new file, ediff-hook.el (ediff-files,ediff-merge-files): better file-name defaults. (ediff-split-string): new function. (ediff-exec-process): now handles diff args separated by space. (ediff-backup-extension): new variable. Replaced -hooks with -hook. (ediff-revision-key): variable deleted. * ediff-util.el (ediff-toggle-read-only,ediff-read-file-name): replaced abbreviate-file-name with ediff-abbreviate-file-name. (ediff-documentation): bug fix. (ediff-setup,ediff-really-quit): modified to work with Ediff session groups. (ediff-quit,ediff-really-quit): now ask if the user wants to delete buffers. * ediff-init.el (ediff-abbreviate-file-name): function modified. (ediff-truncate-string-left): new function. (ediff-strip-last-dir,ediff-key-press-event-p,ediff-event-point, ediff-event-buffer): new functions. (ediff-frame-has-menubar,ediff-protect-meta-chars): functions deleted. * ediff-wind.el (ediff-make-frame-position): fixed bugs. (ediff-control-frame-parameters): fixed defaults. * ediff-diff.el (ediff-setup-diff-regions,ediff-setup-diff-regions3, ediff-setup-fine-diff-regions): functions modified. (ediff-shell-command,ediff-shell-command-sentinel, ediff-shell-command-filter): deleted. (ediff-exec-process,ediff-process-sentinel,ediff-process-filter): new. Thu Oct 5 18:24:01 1995 Richard Stallman * appt.el (appt-disp-window): Call raise-frame. * view.el (View-search-regexp-forward, View-search-regexp-backward): If arg is empty, use view-last-regexp. (view-overlay): New variable, local in all buffers. (view-search): Highlight the match using view-overlay. (view-exit): Delete view-overlay. Wed Oct 4 11:59:54 1995 Richard Stallman * desktop.el (desktop-outvar): Support truncation. (desktop-globals-to-save): Doc fix. * startup.el (command-line): Init user-mail-address here, after reading init file. (normal-top-level): Not here. * gnuspost.el (gnus-inews-do-fcc): Use mail-file-babyl-p. * gnus.el (gnus-summary-save-in-mail): Use mail-file-babyl-p. * startup.el (auto-save-list-file-prefix): New variable. (normal-top-level): Use it. * files.el (recover-session): Use auto-save-list-file-prefix. * sendmail.el (mail-signature-file): New variable. Fix various doc strings to mention it. (mail-signature): Use mail-signature-file. * unrmail.el (unrmail): Call rmail-toggle-header. * isearch.el (isearch-forward): Doc fix. Wed Oct 4 11:15:40 1995 Andre Spiegel * vc.el (vc-next-action-on-file): When locking the latest trunk version, use empty version number. Sun Oct 1 16:33:43 1995 Noah Friedman * terminal.el (te-escape): Remove spurious partial duplicate definition. Sun Oct 1 13:59:29 1995 Richard Stallman * files.el (recover-session-finish): Ask only about files that have auto-save files now. Don't put "temp" into temp file names. Sat Sep 30 12:35:24 1995 Roland McGrath * files.el (cd): Fix interactive spec to require match if there is no CDPATH. Thu Sep 28 23:48:41 1995 Richard Stallman * comint.el (comint-password-prompt-regexp): Recognize Old Password and New password. Thu Sep 28 16:36:14 1995 Michael Ernst * ispell.el (ispell-message-text-end): Match reporter.el bug reports. Thu Sep 28 15:18:50 1995 Richard Stallman * help.el (print-help-return-message): Handle lists in special-display-regexps and same-window-regexps. Also in special-display-buffer-names and same-window-buffer-names * files.el (interpreter-mode-alist): Handle nawk. Wed Sep 27 11:25:56 1995 Richard Stallman * sendmail.el (sendmail-send-it): Handle FCC after all text changes. (mail-do-fcc): Don't add From field here. * undigest.el (undigestify-rmail-message): Better error messages. Tue Sep 26 15:33:27 1995 Richard Stallman * ange-ftp.el (ange-ftp-dumb-unix-host): Avoid error if HOST is nil. Mon Sep 25 18:14:51 1995 Richard Stallman * add-log.el (add-log-current-defun): Ignore quotes before fcn name. Mon Sep 25 14:53:24 1995 Karl Heuer * info.el (Info-title-face-alist): New var. (Info-fontify-node): Check for headings that are `underlined' with characters on the following line. Mon Sep 25 10:53:57 1995 Richard Stallman * help.el (help-mode): Call view-mode. * diary.el (mark-sexp-diary-entries): Add \ for C-M-f's sake. * view.el (view-mode-enter): Renamed from view-mode. Callers changed. Don't create local vars here. Set view-mode-auto-exit. Don't change local map--just set view-mode. (view-mode): New function toggles minor mode in the usual way. (view-mode-map): Put this on minor-mode-map-alist. (view-mode-exit): Do the exit actions only if view-mode-auto-exit. (View-scroll-lines-forward): Exit only if view-scroll-lines-forward. (view-mode-auto-exit, view-old-buffer-read-only) (view-old-Helper-return-blurb, view-scroll-size, view-last-regexp) (view-exit-action, view-return-here, view-exit-position): Defvar them and make them always-local. Mon Sep 25 06:53:32 1995 Erik Naggum * startup.el (command-line-1): --eval: Don't print the value. (command-line-1): --insert: Don't complain on --insert=file. Sun Sep 24 19:24:35 1995 Richard Stallman * replace.el (occur): Indent better for matches that contain newlines. Sat Sep 23 23:49:25 1995 Richard Stallman * jka-compr.el (auto-compression-mode): Add autoload cookie. Renamed from toggle-auto-compression. (toggle-auto-compression): Define as alias. Fri Sep 22 17:51:48 1995 Erik Naggum * cl-macs.el (get-setf-method): Protect caller's match-data from string-match. Fri Sep 22 17:33:18 1995 Karl Heuer * edt.el (edt-setup-default-bindings): Revert function is revert-buffer, not revert-file. Fri Sep 22 17:31:07 1995 Torbjorn Einarsson * f90.el: Major revision. Much improved and quicker highlighting using font-lock. Support for hilit19 removed. Support for imenu added. Changed indentation for continue statements. Added treatment of preprocessor directives. (f90-directive-comment-re) is now a regular expression. Many bug fixes. Fri Sep 22 15:36:23 1995 Ed Reingold * cal-menu.el (calendar-mouse-chinese-date): New function. (calendar-mouse-print-dates): Use it. Thu Sep 21 21:38:19 1995 Richard Stallman * sendmail.el (mail-do-fcc): Erase the ` mail-temp' buffer. (mail-do-fcc): Clear read-only flag in ` mail-temp' buffer. * undigest.el (undigestify-rmail-message): Scan back as far as start of message, to find end of digest. * rmailout.el (rmail-file-p): Function moved to mail-utils.el ad renamed to mail-file-babyl-p. (rmail-output, rmail-output-to-rmail-file): Use new name. * mail-utils.el (mail-file-babyl-p): Function moved from rmail.el and renamed. * sendmail.el (mail-file-babyl-p): Function deleted. (sendmail-send-it): Load mail-utils first thing. Thu Sep 21 18:01:48 1995 Erik Naggum * byte-opt.el (byte-boolean-vars): Update list to reflect actual DEFVAR_BOOL symbols in the C code. Thu Sep 21 16:53:08 1995 Karl Heuer * edt.el (edt-set-screen-width-80, edt-set-screen-width-132): If a terminal-specific function exists, call it. * edt-vt100.el (edt-set-term-width-80, edt-set-term-width-132): Terminal-specific functions. Don't redefine edt-set-screen-width-80 and edt-set-screen-width-132. * terminal.el (te-escape, te-escape-help): Handle non-ASCII events. Tue Sep 19 16:02:37 1995 Edward M. Reingold * cal-chinese.el: New file. * cal-coptic.el: New file. * cal-julian.el: New file. All Julian calendar related code moved here from calendar.el, holidays.el, and diary-lib.el. * cal-iso.el: New file. All ISO calendar related code moved here from calendar.el and diary-lib.el. * cal-islamic.el: New file. All Islamic calendar related code moved here from calendar.el, holiday.el, diary-lib.el, and diary-ins.el. * cal-hebrew.el: New file. All Hebrew calendar related code moved here from calendar.el, holiday.el, diary-lib.el, and diary-ins.el. * cal-move.el: New file. All functions related to movement in the calendar moved here from calendar.el. * diary.el: New file. Functions related to the diary moved from diary-lib.el and diary-ins.el. * holidays.el (holiday-hebrew): Moved to cal-hebrew. (holiday-islamic): Moved to cal-islamic. (holiday-julian): Moved to cal-julian. * cal-x.el (calendar-setup): Moved to calendar.el. * diary-lib.el: Deleted. (diary-date, diary-remind): New functions. (list-sexp-diary-entries): Mention them in doc string. (diary-remind-message, marking-diary-entries, marking-diary-entry): New variables. (diary-mark-sexp-diary-entries, mark-diary-entries): Rewritten to accomodate marking-diary-entries. (diary-sexp-entry): Fix indentation. (diary-chinese-date, diary-coptic-date, diary-ethiopic-date): Do autoloads. (diary-islamic-date, list-islamic-diary-entries, mark-islamic-diary-entries, mark-islamic-calendar-date-pattern): Moved to cal-islamic.el. (diary-hebrew-date, list-hebrew-diary-entries, mark-hebrew-diary-entries, mark-hebrew-calendar-date-pattern): Moved to cal-hebrew.el. Everything else moved to diary.el. * diary-ins.el: Deleted. (insert-islamic-diary-entry, insert-monthly-islamic-diary-entry, insert-yearly-islamic-diary-entry): Moved to cal-islamic.el. (insert-hebrew-diary-entry, insert-monthly-hebrew-diary-entry, insert-yearly-hebrew-diary-entry): Moved to cal-hebrew.el. Everything else moved to diary.el. * cal-menu.el (calendar-mouse-print-dates): Add Chinese and Coptic dates; fix astro date message. (calendar-mouse-2-date-menu): Add dayname to menu. * cal-french.el (french-calendar-special-days-array, calendar-french-date-string): Fix accents. (calendar-goto-french-date): Use reverse instead of nreverse; fix accents. (french-calendar-epoch): New variable. (calendar-french-from-absolute, calendar-absolute-from-french): Use it. * cal-dst.el: Fix commentary. (dst-adjust-time): Moved and renamed from solar.el. (dst-in-effect): New function. * solar.el (solar-equinoxes-solstices, solar-ephemeris-correction, solar-equinoxes/solstices): Rewritten. (solar-apparent-longitude-of-sun): Deleted. (solar-longitude, solar-date-next-longitude): New functions. (solar-adj-time-for-dst): Renamed dst-adjust-time and moved to cal-dst.el. (solar-sin-degrees, solar-cosine-degrees, solar-tangent-degrees): Take angle mod 360.0. (solar-tangent-degrees): Change to macro. * calendar.el (calendar-mod, calendar-absolute-from-astro, calendar-astro-from-absolute): New functions. (calendar-astro-date-string, calendar-goto-astro-day-number): Use them. Autoload holiday-chinese-new-year, calendar-goto-chinese-date, calendar-print-chinese-date, calendar-chinese-date-string, calendar-goto-coptic-date, calendar-print-coptic-date, calendar-coptic-date-string, calendar-goto-ethiopic-date, calendar-print-ethiopic-date, calendar-ethiopic-date-string, calendar-one-frame-setup, and calendar-two-frame-setup. (oriental-holidays): New variable for Chinese New Year. (calendar-mode-map): Put Chinese and Coptic calendar functions on keys. (calendar-setup): Moved here from cal-x.el. (diary-file): Mention Chinese, Coptic, and Ethiopic dates. (calendar-goto-today, calendar-forward-month, calendar-forward-year, calendar-backward-month, calendar-backward-year, scroll-calendar-left, scroll-calendar-right, scroll-calendar-left-three-months, scroll-calendar-right-three-months, calendar-cursor-to-nearest-date, calendar-forward-day, calendar-backward-day, calendar-forward-week, calendar-backward-week, calendar-beginning-of-week, calendar-end-of-week, calendar-beginning-of-month, calendar-end-of-month, calendar-beginning-of-year, calendar-end-of-year, calendar-cursor-to-visible-date, calendar-goto-date, calendar-goto-iso-date): Moved to cal-move.el. (calendar-goto-julian-date): Moved to cal-julian. (calendar-cursor-to-date, generate-calendar-month): Consider the space next to a one-digit date as being on that date. * cal-mayan.el (calendar-mayan-tzolkin-from-absolute): Use them. (mayan-adjusted-mod): Moved to calendar.el and renamed calendar-mod. * lunar.el (lunar-new-moon-time, lunar-new-moon-on-or-after) New functions. Mon Sep 18 10:45:24 1995 Richard Stallman * subr.el (substitute-key-definition): Do recursively scan where KEYMAP has nothing at all. * mouse.el (C-down-mouse-1): Use buffer menu, not font menu. (S-down-mouse-1): Put font menu here. * mouse.el (mouse-drag-vertical-line): New function. (mouse-scroll-min-lines): New variable. (mouse-scroll-subr): Use it. Sun Sep 17 10:11:08 1995 Richard Stallman * files.el (find-alternate-file): Kill any preexisting ` **lose**' buf. Thu Sep 14 10:44:41 1995 Richard Stallman * dunnet.el (dun-climb): Handle unknown object name. (dun-objnames): Add "palm" as alias for "tree". * indent.el (indent-for-tab-command): Get the prefix arg and pass it along to indent-line-function if it isn't nil. Thu Sep 14 03:25:26 1995 Andre Spiegel * vc-hooks.el (vc-fetch-master-properties): Call "cvs status" in the right directory, passing only the nondirectory part of the file name. (vc-find-cvs-master): Bind `mtime' locally instead of using it as a free variable. Tue Sep 12 00:31:50 1995 Erik Naggum * dired-x.el: Remove `dired-up-directory'. (dired-find-buffer-nocreate): Add optional argument `mode' like the function it redefines from dired.el. * dired.el (dired-up-directory): Add optional argument `other-window' to obviate the need to redefine it in dired-x.el. Tue Sep 12 16:57:07 1995 Richard Stallman * files.el (auto-mode-alist): .pl is now Perl. * delsel.el (clipboard-yank): Add delete-selection property. Mon Sep 11 19:33:17 1995 Richard Stallman * server.el (server-process-filter): Ignore lines that don't start with `Error:' or `Client:'. Fri Sep 8 16:43:10 1995 Andre Spiegel * dired.el (dired-internal-noselect): Set dired-directory when refreshing a buffer that displays a list of files. (dired-find-buffer-nocreate): Handle the case when dired-directory is a list. (dired-sort-other): Don't set mode-name if we are not in dired-mode. * vc.el (vc-dired-mode): Now a major mode derived from dired-mode. (vc-directory): Take DIRNAME as an argument. Ask for it in the minibuffer. Don't kill pre-existing vc-dired buffers (dired now re-uses the right one). (vc-file-tree-walk): New argument DIRNAME. Updated all callers. (vc-dired-update): New function. `g' in vc-dired-mode calls it. (vc-dired-reformat-line): Handle different ls -l formats. * vc-hooks.el (vc-locking-user): Fixed wrong parentheses. Fri Sep 8 13:19:17 1995 Richard Stallman * register.el: Rename all register-name args to `register'. Thu Sep 7 06:12:50 1995 Paul Eggert * env.el (setenv): Call set-time-zone-rule when setting TZ. Thu Sep 7 00:14:51 1995 Richard Stallman * text-mode.el (center-line): New arg NLINES. Do nothing for lines that are too wide. * hexl.el (hexl-current-address): New arg VALIDATE. Handle point values in the ASCII text section and in the addresses. (hexl-insert-char): Handle point located in the ASCII text. Wed Sep 6 12:42:02 1995 Richard Stallman * info.el (Info-suffix-list): Add .inf to MSDOS list. * ange-ftp.el (ange-ftp-gwp-filter): Go to process buffer before getting text from it. * mouse.el (mouse-drag-region): Record where the mouse drag has reached and use that to adjust the drag event before replaying it. * gud.el (gud-filter): Save up text that arrives while processing previous text. Wed Sep 6 14:28:03 1995 Fred Pierresteguy * rmailsum.el (rmail-summary-construct-io-menu): Use all of FILES. Also disable the menu instead of not displaying it, if FILES is empty. Tue Sep 5 17:28:56 1995 Richard Stallman * browse-url.el: New file. Mon Sep 4 16:25:53 1995 Richard Stallman * mailabbrev.el (mail-interactive-insert-alias): Call mail-abbrev-expand-hook. Sat Sep 2 12:27:45 1995 Richard Stallman * info.el (info-insert-file-contents): Use info-insert-file-contents-1 to set FULLNAME. Use call-process-region to run the decode program. (Info-find-node): Use info-insert-file-contents-1. (info-insert-file-contents-1) [MSDOS]: Don't use the dot in SUFFIX if FILENAME already has one. * dired.el (dired-internal-noselect): New arg MODE. If it's non-nil, switch to that nil. (dired-find-buffer-nocreate): New arg MODE. * mouse.el (mouse-drag-region): Store the right end position in the drag-event before replaying it at the end. * files.el (auto-mode-alist): Handle .f90 files. * dired.el (dired-internal-noselect): Use dirname when finding existing buffer. Thu Aug 31 19:48:44 1995 Richard Stallman * cc-compat.el: New file. * sendmail.el (sendmail-send-it): Use user-mail-address. Thu Aug 31 23:41:21 1995 Barry Warsaw * cc-mode.el (c-backslashify-current-line): Obsolete. (c-append-backslash, c-delete-backslash): Taken from c-mode.el. (c-backslash-region): Likewise. * cc-mode.el (c-indent-defun): Watch out for point being on the first top-level open brace in the buffer. * cc-mode.el (c-copy-tree, c-mapcar-defun): Define functions only available in XEmacs 19.12, or Emacs 19 + lucid.el. * cc-mode.el (c-lineup-ObjC-method-call): New implementation better handles 1. indentation of arguments to keyword parameters, 2. multiline method calls. * cc-mode.el (c-electric-brace): Fixed preservation of no-whitespace before brace. * cc-mode.el (c-guess-basic-syntax): CASE 5A.1: Watch out for c-state-cache; it may or may not be in place, but it should be ignored. * cc-mode.el (c-electric-colon): In call to c-lookup-lists, fixed incorrect quoting of symbols in the quoted list. * cc-mode.el (c-search-uplist-for-classkey): Watch out for embedded c-class-key keywords. * cc-mode.el (c-common-init): Make a deep copy of c-offsets-alist so that changing the buffer-local value in one buffer doesn't affect the global value, or other buffers. * cc-mode.el (c-snug-do-while): forward-sexp call could fail; wrap it in a c-safe. * cc-mode.el (c++-mode, objc-mode): comment-multi-line must be nil if // is the default comment style. Thu Aug 31 11:04:43 1995 Richard Stallman * ange-ftp.el (ange-ftp-vms-sans-version): Accept extra args. Wed Aug 30 12:01:14 1995 Richard Stallman * simple.el (kill-new): Compute 2nd arg to interprogram-cut-function based on REPLACE. * files.el (list-directory): Set default-directory. Wed Aug 30 14:37:25 1995 Per Abrahamsen * mouse.el (mouse-skip-word): Skip complete symbol when over a character with symbol syntax. Tue Aug 29 11:30:37 1995 Richard Stallman * dired-aux.el (dired-byte-compile): Report failure if output file is not created. * term/x-win.el (function-key-map): Consistently map CLEAR to C-l. Tue Aug 29 06:57:29 1995 Andre Spiegel * vc-hooks.el (vc-utc-string): New function. (vc-find-cvs-master): Use it to compare mtime and checkout time. (vc-locking-user): CVS case: *only* use checkout time. (vc-find-cvs-master): Don't attempt to find the RCS master file. Throw the full name of CVS/Entries. (vc-name): Doc change (special CVS case). (vc-after-save): Handle the case when a file is saved in the very second in which it was checked out. * vc.el (vc-dired-update-line): Don't use dired-do-redisplay. (vc-next-action-dired): Adjust default-directory before calling vc-next-action-on-file. (vc-next-action-on-file): Handle CVS merge in vc-dired-mode correctly. (vc-next-action): Ask for a check-in comment if there are "added" CVS files. Don't special-case single files in vc-dired-mode. (vc-file-clear-masterprops): Typo fix. (vc-latest-on-branch-p): Always true for CVS. (vc-directory): Header change. Do display the buffer, even if no locked/registered files were found. Mon Aug 28 11:09:11 1995 Richard Stallman * files.el (recover-session-finish): Catch erorr in recover-file. * makefile.el (makefile-font-lock-keywords): Highlight lines with tab followed by #, and initial spaces preceding tabs--not all initial spaces. Sun Aug 27 03:19:50 1995 Richard Stallman * tmm.el: Fix typo in global-map define. * cl-seq.el (rassoc): Definition deleted. * mailabbrev.el (mail-mode-syntax-table): defvar deleted. * edebug.el: Delete redundant defvars of built-in variables. * edmacro.el: Load cl only during compilation. (edmacro-mismatch, edmacro-subseq): New functions. Use them instead of mismatch and subseq. * hideif.el (hide-ifdef-hiding): Delete duplicate defvar. * modula2.el (m2-execute-monitor-command): Renamed from execute-monitor-command. Sat Aug 26 16:24:44 1995 Richard Stallman * refer.el (refer-every): Renamed from every. (refer-convert-string-to-list-of-strings): Renamed from convert-string-to-list-of-strings. * levents.el (eventp): Duplicate definition deleted. * ws-mode.el (wordstar-center-line): Renamed from center-line. (wordstar-center-region): Renamed from center-region. (wordstar-center-paragraph): Renamed from center-paragraph. * x-menu.el: Doc fixes. (caar, cdar): Deleted--use (car (car ...)). * find-file.el (ada-spec-suffix): Definition deleted. (ada-make-filename-from-adaname): Delete autoload. (ff-special-constructs): Load ada-mode before referring to ada-spec-suffix and ada-make-filename-from-adaname. * life.el (abs): Function definition deleted. (goto-beginning-of-buffer): Macro deleted. Use goto-char. (goto-end-of-buffer): Macro deleted. Use goto-char. (maxint): Macro deleted. (life-increment): Renamed from increment. (life-initialized): New variable. (life): Do (random t) only once and only when `life' is called. * info.el (Info-default-directory-list): Duplicate defvar deleted. Fri Aug 25 17:18:04 1995 Richard Stallman * uniquify.el: New file. * mailabbrev.el (rebuild-mail-abbrevs): FILE defaults to visited file. * executable.el (executable-set-magic): Use make-local-hook for after-save-hook. * files.el (basic-save-buffer): Doc fix. (after-save-hook): Add defvar. Fri Aug 25 14:39:29 1995 Andre Spiegel * vc.el: Enhanced vc-dired-mode. (vc-directory): Kill existing vc-dired buffers for this directory. Provide a better header. Corrected the check whether any files were found at all (don't display a listing in this case). Under CVS, display cvs-status rather than vc-locking-user. (vc-next-action-on-file): When doing a check-in in vc-dired-mode, find the file in another window. (vc-next-action-dired): Update dired listing while processing the files. (vc-next-action): Check whether a check-in comment is really needed for this mass operation. (vc-checkout): Resynch the buffer, even if it's not current. (vc-dired-state-info, vc-dired-update-line): New functions. (vc-dired-prefix-map): Added local definition for `g' and `='. (vc-dired-reformat-line): Simplified. Erase the hardlink count from the listing, because it doesn't relate to version control. * vc.el: Added functions to dispatch on backend release numbers. Under RCS, use this to find out whether new features can be used. (vc-rcs-release, vc-cvs-release, vc-sccs-release): New variables, may be set by the user. (vc-backend-release, vc-release-greater-or-equal, vc-backend-release-p): New Functions. (vc-do-command): Allow FILE to be nil. (vc-backend-checkin): When creating a branch, don't bother to unlock the old version if this is RCS 5.6.2 or higher. (vc-next-action-on-file): Allow lock-stealing only if RCS 5.6.2 or higher. (vc-backend-admin, vc-backend-checkin): If available, use ci -i and -j. Updated Developer's Notes. * vc.el (vc-backend-diff): Handle the case of a locally added CVS file correctly. * vc-hooks.el (vc-fetch-master-properties): Count cvs status "Needs Patch" as `needs-checkout'. (vc-after-save): Clear the cvs status. Fri Aug 25 12:39:51 1995 Roland McGrath * etags.el (next-file): Advance next-file-list before finding the file named in its car, in case finding signals an error. Fri Aug 25 10:15:53 1995 Richard Stallman * help.el (describe-function): Show file name for autoloaded fns. * simple.el (what-line): Print narrowed linenum with full buffer num. Thu Aug 24 01:24:48 1995 Tom Tromey * makefile.el (makefile-mode-syntax-table): "]" is a close-paren. (makefile-add-log-defun): Avoid error at eob. Wed Aug 23 19:40:22 1995 Richard Stallman * makefile.el: Doc fixes. (makefile-font-lock-keywords): Highlight lines of just whitespace. Tue Aug 22 16:24:49 1995 Richard Stallman * edebug.el (edebug-outside-post-command-idle-hook) (post-command-idle-hook): New variables. (edebug-enter, edebug-outside-excursion): Use them. * avoid.el (mouse-avoidance-mode): Use post-command-idle-hook. Use remove-hook. * two-column.el (2C-mode): Use make-local-hook and add-hook. * icomplete.el (icomplete-minibuffer-setup): Use make-local-hook and add and remove hooks locally. * ediff-util.el (ediff-profile): Use make-local-hook and add and remove hooks locally. Tue Aug 22 13:57:30 1995 Andre Spiegel * files.el (basic-save-buffer): Call vc-after-save, to support implicit locking in VC. * vc-hooks.el (vc-simple-command): New function. (vc-fetch-master-properties): CVS case: Use it. (vc-lock-from-permissions, vc-file-owner, vc-rcs-lock-from-diff): New functions. (vc-locking-user): Largely rewritten. Uses the above, handles RCS non-strict locking. Under CVS in CVSREAD-mode, learn the locking state from the permissions. (vc-find-cvs-master): Use vc-insert-file, rather than find-file-noselect. Greatly speeds up things. (vc-consult-rcs-headers): Bug fix, return status in all cases. * vc.el: Removed the comment that said we assume strict locking. (vc-next-action-dired): Don't switch to vc-parent-buffer, because that was already done. Tue Aug 22 12:43:26 1995 Richard Stallman * sc.el: Provide sc. Mon Aug 21 18:16:07 1995 Roland McGrath * compile.el (compilation-exit-message-function): New variable. (compilation-sentinel): If compilation-exit-message-function is non-nil, call it to produce messages for buffer and mode line. (grep): Use that variable to produce snazzier messages. Mon Aug 21 17:59:43 1995 Richard Stallman * paren.el: Use post-command-idle-hook. (show-paren-command-hook): No need to test for idleness. Mon Aug 21 15:28:47 1995 Andre Spiegel * vc-hooks.el (vc-fetch-master-properties): RCS case: get locking mode. CVS case: new state `locally-added'. (vc-locking-user): Under RCS with non-strict locking, don't trust the file permissions. CVS case: change which states count as "locked". (vc-consult-rcs-headers): Streamlined. Don't set vc-locking-user if this is called under CVS. Under RCS, use a heuristic to find the value of vc-checkout-model without examining the master file. (vc-parse-locks): Set vc-checkout-model. (vc-status): Comment change. (vc-after-save-hook, vc-after-save): The former renamed to the latter. Now unconditionally called by `basic-save-buffer', determines whether the buffer should be "locked" or not. (vc-checkout-model): Values are now `manual' and `implicit'. Derive the property on a per-file basis, supporting all possible modes. (vc-mode-line): No longer use dynamic after-save-hook. Changed references to `automatic' into `implicit'. * vc.el (vc-latest-on-branch-p): Under CVS, handle the case when the file is added, but not yet committed. (vc-backend-checkout): RCS case: In non-strict locking mode, force to overwrite the writable workfile. CVS case: Do the right thing in CVSREAD-mode. Mon Aug 21 10:47:30 1995 Richard Stallman * files.el (auto-mode-alist): Turn on use of makefile-mode. * rmailsum.el: Require rmail. (rmail-new-summary): Specify size in split-window. Call rmail-select-summary to force size to specified amount. Mon Aug 21 08:15:47 1995 Simon Marshall * fast-lock.el: New version 3.07 from author. (fast-lock-mode): Use buffer-file-truename, not buffer-file-name. (fast-lock-cache-directories, fast-lock-cache-name): Doc fixes. Mon Aug 21 01:18:55 1995 Richard Stallman * solar.el: Doc fixes. Sun Aug 20 15:12:09 1995 Andreas Schwab * icon.el: Define user options with defvar, not defconst. Sun Aug 20 01:05:26 1995 Richard Stallman * dired.el (dired-string-replace-match): Simplify using replace-match. * dired-aux.el (dired-expand-newtext): Function deleted. * bytecomp.el (byte-compiler-base-file-name): New function. (byte-compile-dest-file): Call byte-compiler-base-file-name. * jka-compr.el (jka-compr-byte-compiler-base-file-name): New function. Use it to handle byte-compiler-base-file-name operation. Sun Aug 20 00:34:10 1995 Michael Kifer > * viper.el (vip-set-hooks): Use view-mode-hook in emacs and view hook in xemacs. (vip-read-string-with-history): minibuffer-setup-hook no longer waits for the user to type, if there are unread events. Harnessed view-minor-mode. Added (vip-leave-region-active) to all simple movement commands. * viper-mous.el (vip-surrounding-word): modified to understand tripple clicks. * viper-util.el (vip-leave-region-active): new function. Sat Aug 19 12:38:16 1995 Richard Stallman * vc.el (file-regular-p-18): Fix test for whether to use this. * info.el (Info-find-emacs-command-nodes): Fix previous change. (Info-suffix-list): For MS-DOS, use gunzip as the only uncompressor, and don't include .info as suffix. (info-insert-file-contents-1): New function. (info-insert-file-contents): Use info-insert-file-contents-1. * macros.el (insert-kbd-macro): Express vector char modifiers with escape prefixes. Express big basic char codes in octal. Sat Aug 19 02:33:10 1995 Karl Heuer * hilit19.el (hilit-submit-feedback): New ftp site. Sat Aug 19 00:37:47 1995 Richard Stallman * info.el (Info-file-list-for-emacs): New variable. (Info-find-emacs-command-nodes): Look in those files, if appropriate. * files.el (basic-save-buffer): Confirm for overwriting old file when a file name is specified. Fri Aug 18 20:28:58 1995 Daniel Pfeiffer * skeleton.el (skeleton-newline-indent-rigidly): New variable. (skeleton-internal-1): Use it for indenting after \n because previous behaviour was only useful for `sh-script.el' and old `ada.el'. Other modes now get their own indentation. (skeleton, skeleton-modified, skeleton-point, skeleton-regions): `New' variables for passing between the mutually recursive functions of the skeleton engine. Introduced to remove compiler warnings. (skeleton-proxy): New argument `str' to make this settable when calling a skeleton as a function. (skeleton-insert): New argument `str' to pass down. Element `\n' now usually indents according to mode. Subskeletons may also have a list of strings as iterator. Earlier modification also removed meaning of `quit' -- I did not put it back in since it's useless. When quitting out of a subskeleton while still wrapping around text don't duplicate first line of that text. (skeleton-end-hook): New hook useful say for modes that leave a `;' on an empty line to indent right and then want to clean it up when doing a skeleton there. * sh-script.el (sh-newline-and-indent): Don't interpret prefix arg since `newline-and-indent' doesn't either. Don't turn a trailing quoted tab into a space. (sh-mode): Use new `skeleton-newline-indent-rigidly'. (sh-set-shell): Make maximum font-locking also hightlight keywords after ``' and `!'. (The latter is for ksh '93 but should't hurt other shells.) Fri Aug 18 16:36:52 1995 Andre Spiegel * vc.el (vc-next-action-on-file): Changed doc string, CVS case. (vc-backend-checkin): Clear master properties before doing the check-in. In the CVS case, catch error and display an appropriate message in the echo area. (vc-backend-revert): Clear master properties, because some might get outdated by the operation. (vc-backend-merge-news): Scan the output of "cvs update" and find out whether conflicts have occurred. * vc-hooks.el (vc-fetch-master-properties): Recognize cvs status "Unresolved Conflict". (vc-locking-user): Count cvs status `unresolved-conflict' as "locked". * vc.el (vc-finish-logentry): Delete the *VC-log* buffer *before* doing the actual check-in. That leads to a better display in case the check-in fails. * vc.el (vc-latest-on-branch-p): Defined it for CVS in the obvious way. (vc-next-action-on-file): Removed special CVS cases. At this level, CVS is now mostly handled like the other backends. (vc-backend-checkout): CVS case: Clear sticky tag as default when doing a verbose checkout. (This used to be done in vc-next-action-on-file.) * vc-hooks.el (vc-checkout-model): New property and access function (still simplistic). (vc-after-save-hook): New function. (vc-mode-line): When the file is locked by somebody else, make the buffer read-only. (Formerly this was only done for root.) Don't write-protect the buffer if the file is unlocked. Instead, install vc-after-save-hook, which "locks" the file when modifications are saved. Fri Aug 18 12:42:13 1995 Richard Stallman * makefile.el (makefile-space-face): New variable. (makefile-define-space-face): New function. (makefile-tab-face): Variable deleted. (makefile-define-tab-face): Function deleted. (makefile-font-lock-keywords): Highlight leading spaces, not tabs. Thu Aug 17 15:40:32 1995 Karl Heuer * hilit19.el (hilit-submit-feedback): New bug-reporting address. Thu Aug 17 08:46:53 1995 Andre Spiegel * vc.el (vc-next-action-on-file): Moved the setting of the default branch to vc-backend-checkout, where it belongs. (vc-backend-checkout): If an explicit version was specified, adjust the default branch accordingly. * vc-hooks.el (vc-top-version): Renamed to vc-master-workfile-version. Updated all references. vc.el: Changed references to vc-top-version into vc-master-workfile-version. * vc.el (vc-next-action-on-file): Query when trying to lock non-latest version. * vc.el: Let vc-cancel-version handle branches correctly, and behave more comfortably in the `norevert' case. (vc-revert-buffer1): Split part of the function into vc-buffer-context and vc-restore-buffer-context, so we can use it also in other circumstances. (vc-buffer-context, vc-restore-buffer-context): New functions. (vc-clear-headers): New function, uses the above. (vc-cancel-version): When `norevert', locks the most recent remaining version. Also, refuse to work on anything but the latest version of a branch. Removed the check whether the version is the user's, because that is difficult to decide, now that multiple branches are possible. (vc-latest-on-branch-p): New function. (vc-head-version): New access function to the already existing property. (vc-trunk-p, vc-branch-part): Functions moved before first use. Thu Aug 16 22:21:38 1995 Fred Pierresteguy * rmailsum.el (rmail-new-summary): Enable the Input/output menu. Wed Aug 16 16:13:43 1995 Richard Stallman * pascal.el (pascal-mode): Set comment-start. (pascal-toggle-completions): Doc fix. Wed Aug 16 10:36:06 1995 Richard Stallman * simple.el (blink-matching-paren-dont-ignore-comments): New var. (blink-matching-open): Use it. Also, if the matching char hasn't paren syntax, call that mismatch. * inf-lisp.el (inferior-lisp): Use pop-to-buffer. Add *inferior-lisp* to same-window-buffer-names. * cmuscheme.el (run-scheme): Use pop-to-buffer. Add *scheme* to same-window-buffer-names. * xscheme.el (run-scheme): Use pop-to-buffer. Tue Aug 15 16:02:34 1995 Karl Heuer * sh-script.el (sh-mode-map): Use new name skeleton-pair-insert-maybe. (sh-mode): Use new names skeleton-pair-alist, skeleton-pair-filter. Tue Aug 15 15:48:33 1995 Daniel Pfeiffer * skeleton.el (skeleton-pair-insert-maybe): Plain insert in Ovwrt mode (skeleton-insert): If skeleton doesn't fit in window, put beginning at top before going to _ point. (skeleton-internal-list): Rewritten so that resume: sections pertain only to inferior skeletons and make str available there (skeleton-read): Don't quit and remove partial skeleton when empty string entered for outer iterator. Added implicit argument `input'. (define-skeleton, skeleton-insert, skeleton-internal-list): Use `x rather than backquote's (` x) or own (list 'x) * sh-script.el (sh-test): New variable. (sh-if, sh-until, sh-while): Use it. (sh-while-getopts): Handle csh passably well. (sh-font-lock-keywords): Use `font-lock-variable-name-face'. (sh-set-shell): Respect `font-lock-maximum-decoration'. Tue Aug 15 08:30:32 1995 Richard Stallman * supercite.el (sc-attribs-extract-namestring): If name has <...>, treat everything before that as the full name. Mon Aug 14 17:56:23 1995 Karl Heuer * view.el: Rewrite as a minor mode. * viper.el (vip-set-hooks): Use view-mode-hook, not view-hook. Mon Aug 14 13:21:39 1995 Richard Stallman * files.el (basic-save-buffer-1): Pass new arg to write-region. Mon Aug 14 12:01:33 1995 Erik Naggum * files.el (insert-file-contents-literally): New function. (find-file-noselect): Use it if new optional argument `rawfile' is non-nil. * startup.el (command-line-1): Add option --eval to evalute an expression on the command line and print the result. Mon Aug 14 02:17:09 1995 Richard Stallman * paren.el (show-paren-command-hook): Do nothing if have unread events. Sun Aug 13 11:45:09 1995 Richard Stallman * mouse.el (mouse-drag-region): Unread the up-event rather than execute it here. Sat Aug 12 05:20:56 1995 Richard Stallman * rmail.el (rmail-convert-file): Look back for ^_ only at bol. * simple.el (shell-command-on-region): Don't examine order of point and mark; use order of START and END instead. Interactively pass point and mark, not region-beg and region-end. Thu Aug 10 16:01:19 1995 Richard Stallman * isearch.el (isearch-other-meta-char): Avoid bug checking whether a key is defined in the function key map. Call cancel-kbd-macro-events. * bytecomp.el (byte-compile-insert-header): Use 19.29, not 19.28.90 as limit for where dynamic docstrings are allowed. * server.el (server-buffer-done): Pause between client commands, but not after the last one. * files.el (recover-file): It's ok if the visited file doesn't exist. (recover-session-finish): Compute "file name" from autosave file if no visited file. Thu Aug 10 10:50:21 1995 Andre Spiegel * vc.el (vc-dired-reformat-line): Display eight character user names correctly. Thu Aug 10 09:57:30 1995 Simon Marshall * font-lock.el (font-lock-beginning-of-syntax-function): New variable. (font-lock-defaults-alist): New element to specify it. (font-lock-set-defaults): Set it. (font-lock-fontify-region): Use it when calculating the cache state. (font-lock-maximum-size): Add autoload cookie. (font-lock-fontify-region, font-lock-unfontify-region): Also wrap value of buffer-file-truename to avoid clash detection. (font-lock-hack-keywords): Likewise. Also use a while loop, not mapcar, when applying keywords. (tex-font-lock-keywords): Rewritten again. (scheme-font-lock-keywords): New keywords. (font-lock-defaults-alist): Specify defaults for them. * fortran.el (fortran-font-lock-keywords-1): Fix column 72 comments. * texinfo.el (texinfo-font-lock-keywords): Rewritten. (texinfo-mode): Set up font-lock-defaults for keywords only. * help.el (help-font-lock-keywords): New keywords. (help-mode): Set up font-lock-defaults. Wed Aug 9 18:09:15 1995 Francesco Potorti` (pot@cnuce.cnr.it) * man.el (Man-translate-references): Anchor the regexps. Tue Aug 8 13:03:51 1995 Boris Goldowsky * forms.el (forms-check-number-of-fields): New vbl. (forms-mode): Don't issue warning if vbl says not to. Tue Aug 8 01:14:27 1995 Richard Stallman * vc.el (vc-revert-buffer): In a dedicated solitary window, make the frame invisible instead of trying to delete window. * paragraphs.el (forward-paragraph): Don't overlook a paragraph-start line just because it ends at eob. * edebug.el (edebug-functionp): Return t for a bytecode function. * dired.el (dired-mode-map): Set up the map completely before storing it into dired-mode-map. Mon Aug 7 04:44:30 1995 Richard Stallman * bytecomp.el (byte-compile-insert-header): New args inbuffer and outbuffer. Test byte-compile-dynamic-docstrings in the initially current buffer. (byte-compile-from-buffer): Add new args to byte-compile-insert-header. * startup.el (command-line-1): Fix previous change. * bytecomp.el (byte-compile-output-docform): Check byte-compile-dynamic-docstrings in input buffer, not output buffer. Sun Aug 6 02:26:39 1995 Richard Stallman * delsel.el (delete-selection-pre-hook): New type value `yank'. (yank): Use `yank' as delete-selection property. * simple.el (column-number-mode, line-number-mode): Default now t. Sat Aug 5 02:32:33 1995 Richard Stallman * faces.el (set-face-background): When using face-color-supported-p, specify foreground, not background. Fri Aug 4 15:55:57 1995 Richard Stallman * bibtex.el (bibtex-maintain-sorted-entries): Make nil the default. * ps-print.el: Renamed `fsf' to `emacs' in all names. (ps-print-emacs-type): Renamed from emacs-type. Fri Aug 4 15:39:50 1995 Stephen A. Wood * fortran.el (fortran-auto-fill-mode, fortran-do-auto-fill, fortran-fill): Invoke auto filling only when past fill-column. Fri Aug 4 14:02:11 1995 Roland McGrath * compile.el (compilation-error-regexp-alist): Add regexp for Sun ada. Thu Aug 3 22:27:24 1995 Richard Stallman * solitaire.el: New file. Thu Aug 3 13:53:55 1995 Morten Welinder * arc-mode.el: Standardize layout of doc strings. Thu Aug 3 03:26:29 1995 Richard Stallman * rsz-mini.el (resize-minibuffer-setup): Use make-local-hook. * tmm.el: Don't alter bindings in minibuffer-local-must-match-map or completion-list-mode-map. (tmm-add-prompt): Use make-local-hook; add hook locally. (tmm-delete-map): Delete hook locally. * indent.el (tab-to-tab-stop): Expand abbrevs only after a word-char. Wed Aug 2 17:59:22 1995 Rob Riepel * tpu-edt.el (tpu-control-keys): New initial value, nil. (tpu-help): Back up one page at a time. (tpu-set-control-keys): New function. (tpu-edt-on): Call tpu-set-control-keys. Wed Aug 2 00:41:09 1995 Richard Stallman * jka-compr.el (jka-compr-load): Bind load-force-doc-strings. * dired-aux.el (dired-do-copy): Doc fix. * arc-mode.el (archive-remote-regexp): Don't accept hostnames ending in period. (See previous ange-ftp.el change.) * gud.el (gud-xdb-marker-filter): Change pattern to accept spc at end. Tue Aug 1 19:38:13 1995 Richard Stallman * ange-ftp.el (file-name-handler-alist): Don't match host name ending in period. Tue Aug 1 18:40:22 1995 Daniel Pfeiffer * two-column.el (2C-toggle-autoscroll, 2C-autoscroll): Only (sit-for 0) once for smoother scrolling. (2C-associated-buffer): go to same line and column. (2C-newline): new function. (2C-other): optional arg to signal missing other buffer. Tue Aug 1 02:36:29 1995 Richard Stallman * byte-opt.el (byte-optimize-nthcdr): Fix previous change. Mon Jul 31 16:19:04 1995 Richard Stallman * startup.el (command-line-1): Mention recover-session if there's a .saves file. * files.el (recover-session): Mention deletion is possible. (recover-session-finish): Call dired-do-flagged-delete. * dired.el (dired-do-flagged-delete): New arg nomessage. * vi.el (vi-scroll-amount, vi-shift-width): Fix syntax of doc strings. Mon Jul 31 05:55:56 1995 Simon Marshall * subr.el (run-hooks): Variable doc fix. (run-hooks, run-hook-with-args-until-success, run-hook-with-args-until-failure): Functions moved to C. Sun Jul 30 18:28:45 1995 Andreas Schwab * dired-aux.el (dired-read-shell-command): Use `shell-command-history' in read-string. Sun Jul 30 02:43:41 1995 Richard Stallman * iso-acc.el: Major additions by Gustavo Chaves. (iso-languages): New variable. (iso-accents-list): Now set by iso-customize-accents. (iso-customize-accents): New function. (iso-accentuate, iso-deaccentuate, iso-unaccentuate): (iso-accent-rassoc-unit): New functions. * rmail.el (rmail-unix-mail-delimiter): Allow two-letter timezone name. * faces.el (set-face-background): Don't treat nil as a color. * loadhist.el (unload-feature): Delete the file's load-history element. (file-set-intersect): Renamed from set-intersect. (file-dependents): Use new name. * ehelp.el (with-electric-help): Doc fix. * files.el (cd): When reading arg, use just directory as the default. * bytecomp.el (byte-compile-insert-header): If compiling for vers 18, arrange to set current-load-list when loading the file. Sat Jul 29 19:32:12 1995 Richard Stallman * fill.el (fill-region-as-paragraph): Don't find adaptive-fill-regexp on first line of paragraph if it's a paragraph-separate line. Don't look past the intended line. (adaptive-fill-function): New variable. (fill-region-as-paragraph): Use it. (colon-double-space): New variable. (canonically-space-region): Put two spaces after colon if necessary. * simple.el (do-auto-fill): Use adaptive-fill-function. * paragraphs.el (forward-paragraph): Don't move back over a line before the paragraph which doesn't start with fill-prefix unless that is the only line we've moved over. Fri Jul 28 15:51:15 1995 Michael Ernst * simple.el (scroll-other-window-down): Bind to S-C-M-v. Enhance documentation. Fri Jul 28 21:49:53 1995 Richard Stallman * info.el (Info-read-node-name-1): New function. (Info-read-node-name): Use Info-read-node-name-1 to avoid getting confused by spaces when text starts with (FILENAME). Fri Jul 28 16:26:10 1995 Andre Spiegel * vc.el (vc-resynch-buffer): New function. (vc-locked-example): Renamed to vc-snapshot-precondition. It now also checks whether any of the files are visited. (vc-retrieve-snapshot): If any files are visited, ask whether to revert their buffers. Use vc-backend-checkout and vc-resynch-buffer to do that, instead of vc-checkout. * vc.el (vc-backend-checkout): Adjust default-directory so that the checked-out file goes to the right place. Fri Jul 28 13:10:38 1995 Richard Stallman * dired.el (dired-insert-set-properties): Catch errors. * simple.el (next-line): Doc fix. * dabbrev.el (dabbrev-expand): Save previous point for undo. Thu Jul 27 18:04:03 1995 Richard Stallman * simple.el (do-auto-fill): Handle adaptive-fill-regexp. * texnfo-upd.el (texinfo-specific-section-type): Use buffer-substring-no-properties. Thu Jul 27 15:08:32 1995 Karl Heuer * imenu.el: (imenu-generic-lisp-expression) (imenu-generic-c++-expression, imenu-generic-c-expression) (imenu-generic-ada-expression, imenu-generic-texinfo-expression) (imenu-generic-latex-expression): Vars deleted; now handled by the major modes themselves. (imenu--scanning-method-alist): Var deleted. (imenu-default-create-index-function): Don't use that alist. * cplus-md.el (c++-imenu-generic-expression): Var defined. (c++-mode): Set imenu-generic-expression. * c-mode.el (c-imenu-generic-expression): Var defined. (c-mode): Set imenu-generic-expression. * tex-mode.el (latex-imenu-generic-expression): Var defined. (latex-mode): Set imenu-generic-expression. * texinfo.el (texinfo-imenu-generic-expression): Var defined. (texinfo-mode): Set imenu-generic-expression. * ada-mode.el (ada-imenu-generic-expression): Var defined. (ada-mode): Set imenu-generic-expression. * lisp-mode.el (lisp-imenu-generic-expression): Var defined. (lisp-mode-variables): Set imenu-generic-expression. * faces.el (x-font-regexp): Add \\(\\) for substring extraction. Thu Jul 27 11:04:08 1995 Ulrich Mueller * fortran.el (fortran-break-line): Fixed a bug that sometimes deleted first character in statement field of continuation line. Thu Jul 27 10:11:59 1995 Espen Skoglund * pascal.el (pascal-mode): Added imenu support. (pascal-imenu-generic-expression): New variable. Thu Jul 27 03:04:18 1995 Richard Stallman * texinfo.el (texinfo-environment-regexp): Allow whitespace at BOL. * isearch.el (isearch-mode-map): Don't bind tab, return, kp-N, etc. (isearch-other-meta-char): Special handling for keys like tab, etc. Wed Jul 26 16:01:29 1995 Stefan Schoef * bibtex.el: Add keywords and comments as per conventions. * bibtex.el: Changed almost all occurences of buffer-substring to buffer-substring-no-properties.. * bibtex.el (bibtex-find-entry-location, bibtex-clean-entry): Added support to handle invalidate buffers in a more friendly manner. * bibtex.el (bibtex-make-field): Changed to be called either interactively with a string (field name) or from Lisp with a list of two strings (FIELDNAME COMMENT). Wed Jul 26 13:47:14 1995 Rob Riepel * tpu-edt.el (tpu-version): New version. (tpu-help-keypad-map): New help text. (tpu-backward-line): Only move to BOL if not already there. * tpu-extras.el (tpu-backward-line): Only move to BOL if not already there. Wed Jul 26 18:19:12 1995 Richard Stallman * indent.el (indent-region-function): Doc fix. * lisp-mode.el (shared-lisp-mode-map): Don't bind TAB, just set indent-line-function. Wed Jul 26 15:40:00 Michael Kifer (kifer@cs.sunysb.edu) * viper-ex.el (vip-submit-report): fnc modified. * viper-keym.el (vip-overriding-map): new variable. * viper-macs.el (vip-repeat-from-history-key): new default. (vip-read-fast-keysequence, ex-unmap-read-args, ex-map-read-args): changed to use vip-read-key. * viper-mous.el (vip-multiclick-timeout): new default. (vip-surrounding-word, vip-mouse-click-get-word): fnc modified. * viper-util.el (vip-add-hook, vip-remove-hook): new fncs. * viper.el (vip-info-file-name): variable removed. (vip-envelop-ESC-key, vip-start-replace, vip-finish-R-mode, vip-start-R-mode, vip-insert-state-pre-command-sentinel, vip-R-state-post-command-sentinel, vip-replace-char) fncs modified. Tue Jul 25 18:04:33 1995 Karl Heuer * faces.el (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum) (x-font-regexp-swidth-subnum, x-font-regexp-adstyle-subnum): Defconst. Tue Jul 25 17:01:48 1995 Richard Stallman * imenu.el (imenu--history-list): Don't make this buffer-local. (imenu): Call imenu-choose-buffer-index from interactive spec. Tue Jul 25 15:35:07 1995 Karl Heuer * subr.el (run-hook-with-args): Deleted; now in C code. Mon Jul 24 21:52:52 1995 Richard Stallman * imenu.el: Many doc fixes. Tue Jul 25 07:17:02 1995 Ake Stenhoff * perl-mode.el (perl-imenu-generic-expression) New variable. (perl-mode): Set imenu-generic-expression. * imenu.el (imenu-generic-expression): Call make-variable-buffer-local. (imenu-create-index-pattern): Variable deleted. Sat Jul 22 17:24:07 1995 Richard Stallman * tar-mode.el (tar-copy): Inhibit use of jka-compr handler when both to- and from- files would use it. Sat Jul 22 11:13:54 1995 Daniel Pfeiffer * apropos.el: Add latest changes of old library and some more. (apropos): Only show unbound symbols when do-all (apropos-documentation-check-elc-file): new copied function. (apropos-command): also use `apropos-do-all' when called as function. (apropos-print-doc): renamed from `apropos-print-documentation', i is numeric index, replaces parameter tem. (apropos-macrop): new function. (apropos-print): use it to differentiate macros. (apropos-symbol-face, apropos-keybinding-face, apropos-label-face) (apropos-property-face, apropos-match-face): new variables replace and extend the effect of `apropos-use-faces'. (apropos-safe-documentation): renames `safe-documentation', also returns a cons. (apropos-regexp, apropos-files-scanned, apropos-accumulator) (apropos-item): new variables to prevent compiler warnings. (apropos-value-internal, apropos-documentation-internal): new fns. Fri Jul 21 01:04:25 1995 Richard Stallman * byte-opt.el (byte-optimize-lapcode): Fix format calls. * imenu.el (imenu-choose-buffer-index): Avoid trying to select WINDOW if it is nil. * menu-bar.el (menu-bar-buffer-menu): Function deleted. (global-map): Define [menu-bar buffer] as a keymap with no fcn name. (menu-bar-update-buffers): After defining it, call it. * faces.el (make-face-bold, make-face-italic, make-face-bold-italic) (make-face-unbold, make-face-unitalic): No error if font is already bold, italic, or whatever. * font-lock.el (font-lock-make-faces): Redo logic for whether to call font-lock-make-face for a given face. Thu Jul 20 16:16:37 1995 Richard Stallman * rmail.el (rmail-insert-inbox-text): Always use movemail when renaming a file. * simple.el (indent-new-comment-line): fill-prefix overrides comment indentation. * skeleton.el (local-variables-section): Delete autoload cookie. (skeleton-pair-insert-maybe): Renamed from pair-insert-maybe. (skeleton-pair, skeleton-pair-filter, skeleton-pair-alist) (skeleton-pair-on-word): Renamed from pair-... (mirror-mode): Commented out. * info.el (Info-current-file): Doc fix. (Info-find-node): Set Info-current-file to file name as specified. Thu Jul 20 15:34:52 1995 Dave Love * mail-utils.el (mail-fetch-field): Use buffer-substring-no-properties. Thu Jul 20 02:13:52 1995 Richard Stallman * derived.el (derived-mode-set-keymap): Cope if old-map is nil. * menu-bar.el (menu-bar-update-yank-menu): Treat all-dashes specially. Wed Jul 19 11:43:14 1995 Richard Stallman * sendmail.el (mail-default-reply-to): Doc fix. Tue Jul 18 09:06:10 1995 Richard Stallman * backquote.el (backquote): Doc fix. * noutline.el (outline-next-visible-heading): Rewritten to handle backwards motion and handle beg/end of buffer properly. * menu-bar.el (menu-bar-tools-menu): Don't define gnus entry if no network support. * faces.el (x-create-frame-with-faces): Specify frame arg to x-color-values and frame-parameters. (set-face-background): Pass background-p arg to face-color-supported-p. Tue Jul 18 21:45:17 1995 Michael Ernst * ehelp.el (electric-helpify): Autoload with-electric-help, electric-helpify. Tue Jul 18 21:05:34 1995 Rolf Ebert * ada-mode.el (ada-ident-re): Doc fix. (ada-end-stmt-re): Corrected serious pb of wrong parentheses. (ada-subprog-start-re): Removed 'body' from the list. (ada-format-paramlist): Simplified a regexp. (ada-indent-current): On first line of the buffer, indent to column 0. Don't reindent if new position is the same as the old one. Thus, a correcly indended line is not modified. (ada-get-indent-subprog): Simplified a regexp. (ada-goto-matching-decl-start): Distinguish between normal type declaration and protected types, which are more like procedures. (ada-remove-trailing-spaces): Use save-match-data, save-restriction and widen when removing whitespace. (ada-font-lock-keywords-1): Add 'pragma' as keyword. (ada-font-lock-keywords-2): Allow *qualified* idents after 'end'. * files.el (auto-mode-alist): Recognize *.ads and *.adb as Ada specs and bodies. Tue Jul 18 15:26:23 1995 Dave Love * nroff-mode.el (font-lock-defaults): New variable. (nroff-mode-syntax-table): New variable to provide comment syntax for font-lock; I'm not sure if this is (or should be) necessary in 19.29 with font-lock-defaults. (nroff-font-lock-keywords): New variable. (nroff-mode): Install nroff syntax table and font lock keywords. Comment about comments in filling and line-counting. Tue Jul 18 14:47:21 1995 Andre Spiegel * vc.el (vc-do-command): Added parameter BUFFER (the default, if nil, is *vc*). Updated all callers. (vc-next-action-on-file, vc-diff, vc-version-diff, vc-backend-diff): Use buffer *vc-diff* for diff output instead of *vc*. * vc-hooks.el (vc-mode-line, vc-find-file-hook): Moved the test for version-controlled symbolic link from the former to the latter. * files.el (file-name-sans-versions): Recognize version control version numbers. Tue Jul 18 12:37:47 1995 Mike Williams * mouse-sel.el: Don't (require 'backquote). * mouse-sel.el (mouse-extend-internal): Select space in between "things" when extending selection, ie. we are extending to "thing" boundaries. * mouse-sel.el: Use x-lost-selection-hooks to handle loss of selection. (mouse-sel-lost-selection-hook): New function. (mouse-sel-selection-owner-p-function): Variable removed. (mouse-sel-selection-owner-p): Function removed. (mouse-sel-validate-selection): Function removed. * thingatpt.el (forward-same-syntax): New function. Sun Jul 16 14:31:08 1995 Richard Stallman * appt.el: Add provide. Sat Jul 15 11:41:42 1995 Richard Stallman * byte-opt.el (byte-optimize-if): Optimize (if (not foo) nil ...). * add-log.el (add-log-current-defun): Handle C struct definitions. (add-change-log-entry): Use case-sensitive search for file name. Find first blank line correctly. Fri Jul 14 15:12:07 1995 Karl Fogel * bookmark.el (bookmark-make): Strip text properties off name. (bookmark-make-cell): Use `buffer-substring-no-properties'. Fri Jul 14 03:38:32 1995 Richard Stallman * bytecomp.el (byte-compile-output-file-form): Bind print-length and print-level to nil. Thu Jul 13 21:02:01 1995 Richard Stallman * mouse.el (mouse-major-mode-menu): Catch quit in read-key-sequence. Wed Jul 12 20:25:29 1995 Richard Stallman * bookmark.el (bookmark-yank-word): Use buffer-substring-no-properties. Thu Jul 13 11:25:21 1995 Richard Stallman * files.el (auto-mode-alist): Move .scm.[0-9] before nroff-mode. Escape the second period. Wed Jul 12 19:22:59 1995 Richard Stallman * dabbrev.el (dabbrev--search): Don't let spurious match in middle of word obscure real match at start of same word. * term/x-win.el (vendor-specific-keysyms): In Sun keys, f36 was misnamed f35 and f37 misnamed f36. * fill.el (canonically-space-region): Doc fix. * menu-bar.el (menu-bar-help-menu): Add finder-by-keyword. * ediff-wind.el (ediff-skip-unsuitable-frames): Use make-frame, not ediff-make-frame. Wed Jul 12 23:10:46 1995 Richard Stallman * paths.el (remote-shell-program): Try rcmd also. Tue Jul 11 10:39:52 1995 Andre Spiegel * vc-hooks.el (vc-mode-line): Don't write-protect a VC-Log buffer. Better mode line text for initial comments. Streamlined the function. Mon Jul 10 02:59:13 1995 Richard Stallman * faces.el (x-create-frame-with-faces): Set background-mode and display-type frame parameters. * mouse.el (mouse-major-mode-menu): Don't call command-execute if lookup-key gives nil. * byte-opt.el (byte-optimize-nth, byte-optimize-nthcdr): Do nothing if form wrong length. (byte-optimize-multiply): Fix bug in 0 case. (byte-optimize-divide): Optimize (/ CONST CONST) if safe. Sun Jul 9 03:14:03 1995 Richard Stallman * fill.el (fill-region-as-paragraph): In adaptive-fill-mode, if paragraph has one line, take the fill prefix from it. (adaptive-fill-regexp): Doc fix. * startup.el (normal-top-level): Don't use mail-host-address for auto-save-list-file-name. * sendmail.el (mail-setup-hook): New defvar. (mail): Doc fix. Thu Jul 6 14:21:50 1995 Francesco Potorti` * simple.el (shell-command): Use save-match-data. Put the buffer in shell mode, don't use shell-command-filter. (shell-command-filter): Deleted. (shell-command-sentinel): Don't reset the mode line. Don't test the buffer name--what was that for, anyway?. Thu Jul 6 10:04:10 1995 Andre Spiegel * vc.el (vc-backend-merge-news): Force to refetch the properties after the merge. * vc-hooks.el (vc-locking-user): Consider a cvs file "locked" if its status is either 'locally-modified or 'needs-merge. (vc-workfile-version): Catch 'found when calling vc-find-cvs-master. (vc-fetch-master-properties): Handle cvs status "Needs Checkout". This is intended for future use. Thu Jul 6 04:14:54 1995 Richard Stallman * byte-opt.el (byte-optimize-logmumble): Fix (logior -1 ...) case. * cc-mode.el (c-set-style-1): Copy c-offsets-alist if nec. Wed Jul 5 08:00:09 1995 Richard Stallman * faces.el (x-frob-font-slant, x-frob-font-weight): Replace the adstyle field with *, if we can find it. * find-file.el (ff-set-point-accordingly): Doc fix. * vc-hooks.el (vc-fetch-master-properties): Shrink the window that displays the error message. * faces.el (set-face-background): Use face-color-supported-p. Tue Jul 4 15:38:12 1995 Ralf Fassel * fill.el (fill-individual-paragraphs): Use `adaptive-fill-regexp' to determine `fill-prefix' if `adaptive-fill-mode' is non-nil. Tue Jul 4 01:22:44 1995 Richard Stallman * cc-mode.el (c-common-init): Copy c-offsets-alist. Sun Jul 2 12:32:38 1995 Richard Stallman * ebuff-menu.el (electric-buffer-list): Save point before finding the first buffer line, and use that saved point to determine the buffer to use, if it is a reasonable value. * faces.el (face-color-gray-p): New function. (face-default-stipple): New variable. (set-face-background): Use face-default-stipple for all grays. (set-face-stipple): Change arg name. (face-color-supported-p): Use face-color-gray-p. * simple.el (column-number-mode): New variable and new command. * loaddefs.el (mode-line-format): Use column-number-mode. Mon Jul 17 16:14:39 1995 Richard Stallman * sh-script.el (interpreter-mode-alist): Delete autoload cookie. * executable.el (interpreter-mode-alist): Delete autoload cookie. Wed Jul 12 15:14:12 1995 Karl Heuer * comint.el (comint-kill-output): Preserve entire partial line at end, even if it doesn't match comint-prompt-regexp. Wed Jul 12 13:22:20 1995 Roland McGrath * copyright.el: Fixed Author: comment. This code bears no relation to what I wrote. Sun Jul 9 07:41:19 1995 Simon Marshall * font-lock.el: Moved font-lock-doc-string-face to bytecomp.el. (font-lock-fontify-region): Do all cleanups inside unwind-protect. (font-lock-hack-keywords): Likewise. (font-lock-choose-keywords): Don't eval here. (font-lock-set-defaults): Do it here and compile too. * bytecomp.el: Make executing-macro, before-change-function, after-change-function and font-lock-doc-string-face obsolete. * version.el: Do a purecopy of emacs-version for UN*X's what command. Sat Jul 8 09:17:23 1995 Johan Vromans * forms.el (forms-mode): Treat local-write-file-hooks as a list. Fri Jul 7 18:09:41 1995 Francesco Potorti` * mailalias.el (build-mail-aliases): Fixed the regexp for "^group". Fri Jul 7 14:43:05 1995 Daniel Pfeiffer * apropos.el: Restructured, largely rewritten and extended. (apropos-use-faces, apropos-local-map): New variables. (apropos-command): New name for `command-apropos' no longer in help.el. (apropos-value): New command. (apropos-documentation): New name for `super-apropos' (apropos-follow, apropos-mouse-follow): New commands for hypertext. (apropos-describe-plist): New function. * help.el: (command-apropos): Deleted function. This is replaced by apropos-command in apropos.el. * autoload.el: (make-autoload): Generate `(autoload ...)' form for `(define-skeleton ...)' * skeleton.el: partly rewritten and extended. (skeleton-filter, skeleton-untabify, skeleton-further-elements) (skeleton-abbrev-cleanup): New variables (skeleton-proxy, skeleton-abbrev-cleanup): New functions (skeleton-insert): Sublanguage element < must now be handled via `skeleton-further-elements' (used only in sh-script and ada). Lisp expressions can be quoted to ignore the return value. (skeleton-read): New name for `skeleton-internal-read' because this may be useful in skeletons. (local-variables-section): New skeleton command, might go to simple.el. * autoinsert.el: extended to use skeletons or call functions (auto-insert, auto-insert-query, auto-insert-prompt): New variables (auto-insert-alist): New features (auto-insert): New name for `insert-auto-insert-files' (define-auto-insert): New function * copyright.el: New name for generalized upd-copyr.el (copyright-limit, copyright-regexp): New variables (copyright-query): New name for `inhibit-update-copyright' (copyright-current-year): New name for `current-year' (copyright-current-gpl-version): New name for `current-gpl-version' (copyright-update): New name for `update-copyright' and `ask-to-update-copyright' (copyright): New skeleton command * executable.el: New file extracted and optimized from sh-script.el * sh-script.el: restructured, largely rewritten without the bugs and extended to cover over 15 shells. Most variables can now work as a lookup table, and, unless set by user, do. (sh-mode-syntax-table): Possibly multiple tables. (sh-shell): Set initially so shell or other libraries may use features. (sh-assignment-regexp): Replaces `sh-assignment-space'. (sh-here-document-word): Set to more common "EOF". (sh-variables): Changed semantics. (sh-font-lock-keywords): Much nicer. (sh-ancestor-alist, sh-alias-alist, sh-shells, sh-abbrevs) (sh-dynamic-complete-functions, sh-require-final-newline) (sh-comment-prefix, sh-indentation, sh-header-marker, sh-builtins) (sh-leading-keywords): New variables. (sh-use-prefix, sh-find-file-modifies, sh-query-for-magic) (sh-magicless-file-regexp, magic-number-alist, sh-executable) (sh-chmod-argument, sh-shell-is-csh, sh-tab-width) (sh-sh-font-lock-keywords, sh-ksh-font-lock-keywords) (sh-bash-font-lock-keywords, sh-csh-font-lock-keywords) (sh-tcsh-font-lock-keywords): Variables deleted, see also executable.el. (sh-mode): Shell dependent code moved to `sh-set-shell'. (sh-feature, sh-abbrevs, sh-syntax-table, sh-append, sh-modify): New functions. (sh-execute-region): New command. (sh-indexed-loop): Far more efficient code generated for sh. (sh-repeat, sh-tmp-file, sh-while-getopts): New skeletons. (sh-or-other-mode, define-sh-skeleton, sh-executable, sh-chmod) (sh-query-for-variable): Command deleted. * two-column.el: Symbols renamed to be like mode-line indicator. Supposed to now also work for Lucid. (2C-mode-map): New name for `tc-mode-map'. Additionally bound to [f2]. (2C-minor-mode-map) New variable. (2C-mode): New name for `tc-other'. (2C-mode-line-format): New name for `tc-mode-line-format'. (2C-other-buffer-hook): New variable. (2C-separator): New name for `tc-separator'. (2C-window-width): New name for `tc-window-width'. (2C-beyond-fill-column): New name for `tc-beyond-fill-column'. (2C-autoscroll, 2C-autoscroll-start): New variables. (2C-other): New name for `tc-other'. (2C-mode): New name for `tc-mode', `tc-two-columns'. (2C-two-columns): New function. (2C-associate-buffer): New name for `tc-associate-buffer'. (2C-split): New name for `tc-split'. (2C-dissociate): New name for `tc-dissociate'. (2C-merge): New name for `tc-merge'. (2C-associated-buffer): New name for `tc-associated-buffer'. (2C-toggle-autoscroll, 2C-autoscroll): New functions. (tc-scroll-line, tc-scroll-up, tc-scroll-down, tc-recenter): Deleted functions. Thu Jul 6 14:16:18 1995 Karl Heuer * timezone.el (timezone-parse-date): Ignore text properties. * find-dired.el (find-dired): Undefine the g command. Sun Jul 2 04:13:00 1995 Richard Stallman * bytecomp.el (byte-compile-obsolete): Do the funcall to compile the form whether or not we warn. * c-mode.el (calculate-c-indent-after-brace): New function. (calculate-c-indent, indent-c-exp): Use it. * faces.el (x-font-regexp): Include the avgwidth. * iso-transl.el (iso-transl-char-map): Treat m, *m like u and *u. Sat Jul 1 01:39:19 1995 Richard Stallman * subr.el (shell-quote-argument): Don't do anything, on MS-DOS. * sendmail.el (mail-default-reply-to): Initialize to nil. (mail-setup): Override it from env var if nil. * talk.el (talk-disconnect): Make it interactive. (talk-add-display): Ignore dead buffers and deleted frames. * font-lock.el (font-lock-make-faces): On grayscale screen, use grays for background, not foreground. * faces.el (describe-face): new function. Fri Jun 30 09:10:07 1995 Andre Spiegel * vc-hooks.el (vc-fetch-master-properties): Better error message in case the "cvs status" command fails. Fri Jun 30 16:27:02 1995 Richard Stallman * man.el (Man-underline-face): Doc fix. * mailalias.el (define-mail-alias): Doc fix. Fri Jun 30 19:07:05 1995 Paul Eggert * sendmail.el (sendmail-send-it): If mail-from-style is parens, don't escape all parentheses; escape only the nonmatching ones. * sendmail.el (sendmail-send-it): If user-full-name contains special characters, quote or escape them for the From: line. Fri Jun 30 01:12:40 1995 Richard Stallman * rmail.el (rmail-find-all-files): Bind case-fold-search. * term/x-win.el (x-colors): Doc fix. Fri Jun 30 00:13:38 1995 Kevin Rodgers * mailabbrev.el (mail-resolve-all-aliases-1): Downcase address before recursive call. Thu Jun 29 18:07:10 1995 Richard Stallman * time.el (display-time-filter): Move run-hooks inside let. * simple.el (switch-to-completions): Make a completions window if none. * mouse.el (mouse-selection-click-count-buffer): New variable. (mouse-drag-region): Set it. (mouse-save-then-kill): Test it. Thu Jun 29 17:28:26 1995 David M Smith * ielm.el (ielm-font-lock-keywords): New variable (inferior-emacs-lisp-mode): Use it for font-lock support Thu Jun 29 13:42:46 1995 Bryan O'Sullivan * ange-ftp.el (ange-ftp-normal-login): if ange-ftp-smart-gateway is set but ange-ftp-gateway-host is nil, use user@host proxy protocol. Thu Jun 29 10:51:47 1995 Morten Welinder * arc-mode.el (archive-mode): Add autoload cookie. * files.el (auto-mode-alist): Make archive-mode the default for .arc, .lzh, .zip, and .zoo files. Thu Jun 29 14:48:25 1995 Karl Fogel (kfogel@wombat.gnu.ai.mit.edu) * bookmark.el: use "Save" and "Save As" instead of the nonstandard "Save" and "Write", in menu item titles. Thu Jun 29 00:35:53 1995 Richard Stallman * menu-bar.el (find-tag): Delete the menu-enable property. * info.el (Info-goto-node, Info-search): In Transient Mark mode, deactivate the mark. * faces.el (make-face-x-resource-internal): Give special meanings to font "names" `italic', `bold', and `bold-italic'. * rmail.el (rmail-summary-by-sender): Autoload this. (rmail-mode-map): Add rmail-summary-by-senders. Wed Jun 28 06:01:36 1995 Richard Stallman * fill.el (current-fill-column): If fill-column is nil, return nil. * simple.el (do-auto-fill): No-op if (current-fill-column) is nil. * loadup.el: Put isearch before menu-bar. * loaddefs.el: Don't set up key-translation-map. * help-macro.el (make-help-screen): Handle help-event-list. Handle backspace like delete. * help.el: Bind f1 and help like C-h. * supercite.el (sc-electric-mode-map): Bind f1 and help like C-h. * ediff-util.el (ediff-setup-keymap): Bind f1 and help like C-h. * edt.el (edt-setup-default-bindings): Bind f1 and help like C-h. * cplus-md.el (electric-c++-terminator): Fix logic for handling colon. * menu-bar.el: Make more menu-enables check (not buffer-read-only). Add minibuffer local menu bar menus. * startup.el: Update copyright year in message. * server.el (server-process-filter): Detect error messages from server. Tue Jun 27 18:58:43 1995 Richard Stallman * edt.el (edt-emulation-on): Check window-system for x, specifically. Tue Jun 27 12:23:58 1995 Andre Spiegel * vc-hooks.el (vc-consult-rcs-headers): Use an even more pedantic regexp to match RCS time strings. Improved efficiency by using looking-at instead of re-search "\\=... Tue Jun 27 02:51:17 1995 Richard Stallman * ediff-wind.el (ediff-control-frame-parameters): Specify user-position. * imenu.el (imenu-choose-buffer-index): Understand that (menu-bar) doesn't specify a window. * startup.el (command-line): Extract arg value properly for -u. * subr.el (lambda): Doc fix. Mon Jun 26 15:40:39 1995 Ake Stenhoff * imenu.el (imenu-use-keymap-menu): New variable. (imenu-auto-rescan): New variable. (imenu-auto-rescan-maxout): New variable. (imenu-generic-expression): Doc changes. (imenu-generic-lisp-expression): New variable. (imenu-generic-c-expression): New variable. (imenu-example--generic-c++-expression): Changed the name to imenu-generic-c++-expression. (imenu-example--generic-texinfo-expression): Changed the name to imenu-generic-texinfo-expression. (imenu-example--generic-latex-expression): Changed the name to imenu-generic-latex-expression. (imenu--scanning-method-alist): New variable. (imenu--split-menu): Changed it to make the title "Index menu" instead of "Function menus". (imenu--make-index-alist): Changed to handle auto rescan. (imenu--create-keymap-2): New function to create a keymap. (imenu--create-keymap-1): New function. (imenu--in-alist): New function. (imenu-default-create-index-function): Changed to handle imenu--scanning-method-alist). (imenu--generic-extract-name): Removed. (imenu--generic-function): Rewritten to handle submenus. (imenu--mouse-menu): Changed to handle keymaps. Mon Jun 26 19:19:52 1995 Richard Stallman * paths.el (remote-shell-program): Fix typo checking /usr/bin/remsh. Mon Jun 26 17:04:23 1995 Eric S. Raymond * vc.el (vc-start-entry): Prevent lossage when doing a mass checkin from a VC-dired buffer. Mon Jun 26 21:05:21 1995 Andre Spiegel * vc-hooks.el (vc-consult-rcs-headers): Handle the new time string formats of RCS 5.7. Mon Jun 26 13:56:46 1995 Mike Long * view.el (view-file-other-window): Re-add missing argument to switch-buffer-other-window. (view-mode-map): Leave C-c alone! (view-mode): Doc fix. Mon Jun 26 07:55:44 1995 Simon Marshall * font-lock.el (font-lock-defaults-alist): List all keywords for C and Emacs Lisp modes. Doc fix. (font-lock-maximum-decoration): Doc fix. (font-lock-choose-keywords): New function. Use them. (font-lock-set-defaults): Use it. Doc fix. (lisp-font-lock-keywords): Default to lisp-font-lock-keywords-1. (c-font-lock-keywords): Default to c-font-lock-keywords-1. (c++-font-lock-keywords): Default to c++-font-lock-keywords-1. * fortran.el (fortran-mode): List all keywords for font-lock-defaults. (fortran-font-lock-keywords): Default to fortran-font-lock-keywords-1. Sat Jun 24 17:58:51 1995 Richard Stallman * rmail.el (rmail-revert): Use the default revert-buffer-function * simple.el (newline): Put point at right place if insert gets error. Sat Jun 24 00:43:32 1995 Karl Fogel * mail-hist.el (mail-hist-text-size-limit): New var. (mail-hist-text-too-long-p): New func. (mail-hist-add-header-contents-to-ring): call above; if the text is too long, then store the empty string in the history. Sat Jun 24 00:17:08 1995 Richard Stallman * pc-mode.el (pc-bindings-mode): Add autoload. * enriched.el (excerpt): Ignore error making `excerpt' italic. Fri Jun 23 23:39:14 1995 Tom Tromey * makefile.el (makefile-define-tab-face): New function. (makefile-tab-face): Don't create face here. (makefile-mode): Call makefile-define-tab-face. Fri Jun 23 18:11:26 1995 Richard Stallman * cc-mode.el (c-mode): Delete autoload cookie. * mail-hist.el: Don't autoload anything to turn on mail-hist. (mail-hist-enable): New function, autoloaded. Fri Jun 23 11:21:18 1995 Andre Spiegel * vc-hooks.el: Fix bug concerning vc-latest-version. Accessing that property left erroneous contents in the *vc-info* buffer, which could later be misinterpreted by other functions. (vc-insert-file): Erase the current buffer before inserting the file. (vc-fetch-master-properties, vc-fetch-properties): Don't erase the buffer because that is now done in vc-insert-file. (vc-fetch-properties): Kill the *vc-info* buffer when done. Fri Jun 23 01:52:12 1995 Paul Eggert * vc.el (vc-backend-admin, vc-backend-checkin): Assume that comments are empty if they contain only white space. Thu Jun 22 13:50:29 1995 Andre Spiegel * vc-hooks.el (vc-fetch-master-properties): Pass an absolute pathname to the cvs status command. This is required to make recursive vc-directory listings work. Thu Jun 22 11:59:49 1995 Ethan Bradford * vt-control.el (vt-keypad-on, vt-keypad-off): Updated codes sent to terminal to eliminate some garbage that made NCSA telnet crash. Thu Jun 22 00:36:05 1995 Richard Stallman * vip.el (vip-push-mark-silent): Use (mark t). * mouse.el (mouse-yank-at-click): Clear mouse-selection-click-count. Wed Jun 21 19:03:13 1995 Richard Stallman * files.el (buffer-file-truename): Duplicate definition deleted. * simple.el (mark-even-if-inactive): Duplicate definition deleted. * lisp-mode.el (eval-defun): Don't change defvar to defconst if it has just one argument. Wed Jun 21 14:26:10 1995 Richard Stallman * Version 19.29 released. * startup.el (precompute-menubar-bindings): While dumping, garbage-collect after each menu. Tue Jun 20 09:54:02 1995 Richard Stallman * gud.el (gud-make-debug-menu): Cope if no local map yet. * loaddefs.el (help-event-list): Initialize it. * dired-aux.el (dired-do-redisplay): Call dired-uncache. * simple.el (universal-argument-num-events): New variable. (universal-argument, universal-argument-more, negative-argument) (digit-argument): Set that variable. (universal-argument-other-key): Use that variable when unreading. * vc-hooks.el (vc-handle-cvs): New variable. (vc-find-cvs-master): Check that variable. Mon Jun 19 21:07:03 1995 Richard Stallman * vc-hooks.el (vc-fetch-properties): Add save-excursion. * cc-mode.el: Version 4.222 installed. Changes too much to list. Kept these changes previously installed here: (c-version): Mention that this may be modified version. (c-common-init, c-fill-paragraph): Remove "^" used as anchor from paragraph-start and paragraph-separate values, so that they will work with non-0 left-margin settings. * vc-hooks.el (vc-fetch-master-properties): Be more careful about killing the *vc-info* buffer. Mon Jun 19 18:51:08 1995 Karl Heuer * shell.el (shell-directory-tracker): Check for terminator after cd, pushd, or popd, so that we don't try to do directory tracking on things like "cdump". Don't use \\s patterns inside brackets. Mon Jun 19 16:27:34 1995 David K}gedal * tempo.el: Documented the `l' tag. (tempo-insert-template): Check for zmacs-regions. Wrapped it in unwind-protect. (tempo-save-named): New function. (tempo-insert-prompt): Added NO-INSERT parameter. Handles previous values better. Cleaned up interface. Check for already saved value. (tempo-remember-insertion): Function deleted. (tempo-insert-named): Use tempo-insert if data is not a string. Use tempo-lookup-named. (tempo-insert-prompt-compat): New function. (tempo-lookup-named): New function. Mon Jun 19 16:06:24 1995 Richard Stallman * simple.el (universal-argument-other-key): Call reset-this-command-lengths. Mon Jun 19 11:34:38 1995 Ed Reingold * solar.el (calendar-location-name, sunrise-sunset): Fix bug in determination of output string. Sun Jun 18 12:44:24 1995 Richard Stallman * simple.el (negative-argument, digit-argument): Set overriding-terminal-local-map like C-u. (universal-argument-map): Add binding for \e t. * texinfo.el (texinfo-environment-regexp): Add @ifhtml, @html. Sun Jun 18 12:08:17 1995 Morten Welinder * arc-mode.el (archive-zip-summarize): Handle per-file comments in central directory. Sun Jun 18 10:45:30 1995 Johan Vromans * forms.el: Remove references to mouse-major-mode-menu. Sun Jun 18 10:13:17 1995 Andre Spiegel * vc-hooks.el (vc-fetch-master-properties): Use path-separator for path to "cvs status" command. Sat Jun 17 21:24:28 1995 Karl Fogel * bookmark.el: Make doc strings and argument names consistent where necessary. Moved user variables to own section. (bookmark-alist): Better doc string. (bookmark-insert-current-bookmark): Doc string. (bookmark-insert-buffer-name): Doc string. (bookmark-set): Take optional NAME argument. (bookmark-bmenu-select): Use member to test for string's presence. Use a more efficent test at end, as suggested by Mikio Nakajima. Sat Jun 17 11:20:25 1995 Richard Stallman * startup.el (normal-top-level, command-line-1): Call precompute-menubar-bindings only if using x. (precompute-menubar-bindings): Don't check for x here. Set define-key-rebound-commands to t. * loadup.el: Call precompute-menubar-bindings. Then set define-key-rebound-commands to nil. * subr.el (add-hook): Use local local-variable-if-set-p. * info.el (Info-directory-list): If path-separator isn't available, bind it here. * vc.el (vc-do-command): Use path-separator. Sat Jun 17 16:18:18 1995 Andre Spiegel * vc.el (vc-directory): Use expand-file-name on default-directory. (vc-directory-exclusion-list): Add "CVS" to this list. Sat Jun 17 02:33:21 1995 Roland McGrath * ediff.el: Fixed bogus references to menu-bar-file-menu in define-key forms. Fri Jun 16 18:24:06 1995 Karl Heuer * isearch.el (isearch-mode-map): Bind frame events to nil. Fri Jun 16 19:38:19 1995 Andre Spiegel * vc-hooks.el (vc-fetch-properties): Don't use vc-backend-dispatch, as that is in vc.el. * vc.el (vc-register): Inhibit backups for the file's buffer * vc.el (vc-add-triple, vc-lookup-triple, vc-record-rename): Use absolute file names to access the SCCS named configuration files ("VC-names"). * vc-hooks.el (vc-consult-rcs-headers): Fix typo in prev change. * vc-hooks.el (vc-find-cvs-master): Exit gracefully when not finding CVS/Repository. * vc.el (vc-lookup-triple): Call vc-parse-buffer instead of vc-master-info. * vc.el (vc-retrieve-snapshot): Use vc-checkout instead of vc-backend-checkout, as the former also updates the current buffer. (vc-file-tree-walk, vc-file-tree-walk-internal): Use expand-file-name, so that FUNC gets called with an unabbreviated name. Fri Jun 16 09:09:09 1995 Richard Stallman * ispell.el: Reinstalled autoloads from ispell-dictionary-alist, ispell-menu-map, ispell-menu-lucid, and ispell-menu-map-needed. * vc.el (vc-backend-dispatch): Move definition before first use. Fri Jun 16 03:38:49 1995 Simon Marshall * c-mode.el (c-mode-map): Put mark-active for menu-enable property on comment-region, c-macro-expand and c-backslash-region symbols. * facemenu.el (facemenu-menu): Change name to Special Properties. * font-lock.el (font-lock-make-faces): Optional arg OVERRIDE. Make faces, and their face variables, only if they don't exist already. (font-lock-make-faces-done): Removed. (font-lock-set-defaults): Don't set it. Fri Jun 16 02:08:48 1995 Karl Heuer * simple.el (universal-argument-map): New var. (universal-argument, negative-argument, digit-argument): Use overriding-terminal-local-map. (prefix-arg-internal, describe-arg): Functions deleted. (universal-argument-more, universal-argument-minus): New functions. (universal-argument-other-key): New function. * isearch.el (isearch-mode): Use overriding-terminal-local-map. (isearch-done): Likewise. Thu Jun 15 08:24:03 1995 Richard Stallman * ispell.el: Removed autoload from ispell-dictionary-alist, ispell-menu-map, ispell-menu-lucid, and ispell-menu-map-needed so users can more easily modify and upgrade entries. (ispell-dictionary-alist): Once more a single variable. (ispell-required-version): Documentation changes (ispell-skip-sgml): Documentation changes (ispell-command-loop): mode-line-format now shows misspelled word. (ispell-message-text-end): Can now process postscript version 1. (ispell-message-start-skip): New variable for block skips, set up for pgp and forward blocks. (ispell-message-end-skip): New variable for block skips, set up for pgp and forward blocks. (ispell-message): Added block message skipping. (ispell-buffer-local-parsing): Added html-mode. * mouse.el (mouse-set-region): Bind last-command with this-command. * winnt.el (grep-null-device): Set this instead of null-device. * dos-fns.el (path-separator, grep-null-device, grep-regexp-alist): Set them, as in winnt.el. * compile.el (grep-null-device): Renamed from null-device. * vc-hooks.el (vc-fetch-master-properties): For RCS file, don't look for vc-latest-version and vc-your-latest-version here. Read only through ^locks unless we need to find the tip of a branch. (vc-consult-rcs-headers): Use non-regexp search to find the headers. (vc-latest-version, vc-your-latest-version): Use vc-fetch-properties. (vc-fetch-properties): New function. * buff-menu.el (list-buffers-noselect): Don't let space after buf name inherit the text props from it. * subr.el (make-local-hook): Doc fix. Thu Jun 15 08:24:03 1995 Andre Spiegel * vc-hooks.el: The RCS status is now found by reading the master file directly, instead of using rlog. The properties retrieved from the master file are kept separately. The two main properties, `vc-workfile-version' and `vc-locking-user', are inferred from those master file properties if the information cannot be found elsehow. All properties are consistently cached now. Reordered some defuns so they are grouped in a logical way. (vc-master-info, vc-log-info, vc-fetch-properties): Functions removed. Their job is now done by `vc-fetch-master-properties' and `vc-insert-file'. (vc-fetch-master-properties): New function. (vc-insert-file): New function. (vc-parse-locks): New function. (vc-locked-version): Property no longer set. (vc-head-version, vc-default-branch, vc-master-locks): New properties. (vc-top-version): New name for the old property `vc-branch-version'. (vc-master-locking-user): Replaces `vc-true-locking-user'. (vc-locking-user): Slightly changed to use the new properties. Changed the actual property value for an unlocked file to 'none. This is to distinguish it from an unknown locking state, which is represented by nil. The function vc-locking-user returns nil if the property is 'none, to make it compatible with the rest of VC. (vc-consult-rcs-headers, vc-master-locking-user): Adapted to the new 'none-value of vc-locking-user. (vc-consult-rcs-headers): Fixed bug that prevented (not vc-consult-headers) from working (vc-file-not-found-hook): Set the default-directory of the new buffer before check-out. * vc.el: Adapt to the changes in vc-hooks.el, namely, the new 'none-value of vc-locking-user, and the consistent caching of all properties. Especially, make the properties survive check-ins and check-outs. Various minor bug fixes. (vc-file-clear-masterprops): New function. (vc-backend-checkin, vc-backend-revert): Set vc-locking-user to 'none if the file is unlocked. (vc-backend-checkin, vc-backend-revert, vc-backend-checkout): Use vc-file-clear-masterprops, and adjust those properties that are not cleared. (vc-resynch-window): Temporarily remove vc-find-file-hook, so that we don't lose the file properties during check-in/out. (vc-resynch-window): Do not try to delete the current window if `vc-keep-workfiles' is nil (doesn't make sense; killing the buffer is enough.) (vc-backend-checkin): Rewrote the code that adjusts the default branch and removes any locks that might remain after check-in. (vc-cancel-version): Abort with error message in the CVS case. (The error used to be signalled in vc-backend-uncheck, which is a little too late.) (vc-minor-revision): Function removed. Wed Jun 14 22:16:14 1995 Geoff Voelker * subr.el (shell-quote-argument) [WINDOWSNT]: Wrap in quotes only. * compile.el (null-device): Defined. (grep): Use null-device. * winnt.el (null-device): Set to "NUL". (grep-regexp-alist): Match entries with drive letters. (save-to-unix-hook,revert-from-unix-hook): Defined. (using-unix-filesystems): Defined. (window-frame): Unaliased. Wed Jun 14 18:27:58 1995 Karl Heuer * simple.el (universal-argument, describe-arg): Restore Lisp code, undoing Feb 28 change. (prefix-arg-internal, digit-argument, negative-argument): Likewise. Wed Jun 14 12:00:35 1995 Richard Stallman * frame.el (frame-notice-user-settings): When making a minibufferless frame, don't copy `name' parm explicitly unless it was explicit before. Wed Jun 14 11:47:33 1995 Roland McGrath * compile.el (compilation-find-file): If FILENAME is absolute, apply abbreviate-file-name to it and then use its directory part as the first search path element, searching for its nondirectory part. Fix prompting code not to use a free variable. (compilation-parse-errors, compile-abbreviate-directory): Use abbreviate-file-name on directories. Wed Jun 14 21:55:27 1995 Johan Vromans * forms.el (forms--mode-menu-edit,forms--mode-menu-ro): Set `mouse-major-mode-menu'. Wed Jun 14 10:50:27 1995 Simon Marshall * lisp-mode.el (emacs-lisp-mode-map): Put mark-active for menu-enable property on eval-region, comment-region and indent-region symbols. (save-selected-window): Define indentation. Wed Jun 14 07:06:47 1995 Richard Stallman * viper-util.el: Delete the Emacs version error check. * ediff-init.el: Delete the Emacs version error check. * dired.el (dired-change-marks): If OLD is a space, don't act on non-file lines. * vc.el (vc-backend-checkin): Provide an explicit string saying the log message is empty instead of providing it as empty. Always use -m option for ci. * shell.el (shell-mode): Make shell-directory-tracker a hook function locally only. Tue Jun 13 16:38:40 1995 Per Bothner * term.el: Various optimizations. The main one is to optimize for simple output at the end of the buffer, with no paging, and in that case to defer scrolling while we can. (term-emulate-terminal): Don't call term-handle-scroll in simple cases unless we are either paging or term-scroll-with-delete. (term-down): Likewise. (term-handle-scroll): Modify accordingly. (term-emulate-terminal): Avoid deleting old text in common case. Optimize the simple case of CRLF when we're at buffer end. Handle deferred scroll when done processing output. (term-handle-deferred-scroll): New function. (term-down): Simplify - no longer take RIGHT argument. Tune. (term-goto): Use term-move-columns to compensate for the above. * term.el (term-escape-char, term-set-escape-char): Add doc-string. (term-mouse-paste): Add xemacs support. * term.el: Various speed enhencements: (term-handle-scroll): Don't clear term-current-row; maybe adjust it. (term-down): Don't call term-adjust-current-row-cache if we've done term-handle-scroll. (term-emulate-terminal): Don't call term-adjust-current-row-cache. (term-emulate-terminal): For TAB, don't nil term-start-line-column. (term-goto): Possible optimization. Tue Jun 13 19:28:59 1995 Karl Heuer * comint.el (comint-mode): Use make-local-hook. (comint-send-input, comint-output-filter): Use run-hook-with-args. (comint-dynamic-complete): Use run-hook-with-args-until-success. Tue Jun 13 17:19:52 1995 Michael Kifer * viper.el (vip-change-state-to-vi): bug fix. * viper-util.el (vip-over-whitespace-line): new function. Tue Jun 13 04:16:28 1995 Simon Marshall * files.el (file-truename): Use expand-file-name if filename is "". * shell.el (shell-mode): Set comint-input-ring-file-name to nil if "". Mon Jun 12 22:16:46 1995 Karl Heuer * menu-bar.el (help-menu): Symbol renamed from `help'. * rmail.el (rmail-search-backwards): Default count is 1, not -1. Sat Jun 10 00:38:31 1995 Richard Stallman * window.el (save-selected-window): New macro. Fri Jun 9 11:38:01 1995 Karl Heuer * faces.el (x-create-frame-with-faces): Don't use initial-frame-alist when looking for the X resource name. Copy parameters from default-frame-alist, before the geometry specs from the X resource database. Fri Jun 9 11:24:26 1995 Richard Stallman * faces.el (x-create-frame-with-faces): Don't look for geometry resource if name is nil. Fri Jun 9 08:37:08 1995 Erik Naggum * gnuspost.el (gnus-cancel-news): Use `buffer-disable-undo'. (gnus-inews-article): Ditto. (gnus-inews-insert-signature): Use the recommended hyphen-hyphen-space as the signature delimiter. Thu Jun 8 16:23:13 1995 Richard Stallman * info.el (Info-mode): Doc fix. (Info-next-preorder): Renamed from Info-next-preorder-1. Old definition deleted. After moving up, go to end of node. (Info-last-preorder): If no menu, try the previous node. After going down thru menu or to previous, position at end of node and recenter. After moving up, position at start of menu. (Info-follow-nearest-node, Info-mouse-follow-nearest-node): Use Info-next-preorder. (Info-scroll-up, Info-scroll-down): Doc fix. * emacsbug.el (report-emacs-bug-info): New command. (report-emacs-bug): Put it in local map. Display a message in another window. * format.el (format-find-file, format-insert-file): New functions. Thu Jun 8 10:34:10 1995 Morten Welinder * add-log.el (prompt-for-change-log-name): Handle the case where a directory name is specified gracefully. Thu Jun 8 21:20:39 1995 Andre Spiegel * vc.el (vc-backend-checkin): Handle RCS `ci'-output in the event that a check-in only results in reverting to the previous version. Also be more robust if the new version number cannot be told from what `ci' says. Thu Jun 8 20:59:55 1995 Karl Heuer * vc.el (vc-register): Check for a visited file first thing. * files.el (file-precious-flag): Doc clarification. Thu Jun 8 20:06:03 1995 Michael Kifer * viper.el (vip-envelop-ESC-key): if an ESC-sequence translates into a function key, pretend that this key was the last command event. * viper.el (vip-put-back,vip-Put-back): now emulate Vi's behavior more closely. * viper.el (vip-line): no longer not bombs out. (vip-exec-shift) now preserves the point. * viper.el: Fixed the behavior of the Vi commands M, L, G, yw, dg, etc. * viper-util.el (vip-event-key): now handles keys 128--255 as meta-chars. * viper-ex.el: Fixed problems with yanking/deleting buffers. * viper.el, viper-mous.el, viper-util.el, viper-ex.el: Changed vip-*-frame-* to *-frame-*, incorporated overlay strings, unread-command-events, removed support for emacs versions 19.28 and xemacs 19.11 and earlier. * viper-macs.el, viper-keym.el: Likewise. Thu Jun 8 12:48:54 1995 Roland McGrath * map-ynp.el (map-y-or-n-p): Don't eval return value of prompter function. Thu Jun 8 10:29:43 1995 Simon Marshall * texinfo.el (texinfo-font-lock-keywords): Do comments first. Thu Jun 8 09:03:28 1995 Roland McGrath * rlogin.el (rlogin): If optional second arg is buffer or string, use that as name. Wed Jun 7 18:08:10 1995 Roland McGrath * gud.el (gud-common-init): Call the MASSAGE-ARGS function even if FILE is nil. Wed Jun 7 14:57:24 1995 Morten Welinder * s-region.el: Delete version number. (s-region-bind): Doc fix. (s-region-move): Split into s-region-move and s-region-move-p1. (s-region-move-p2): New function. (s-region-move): Bind this-command. Bind keys to s-region-move-p1 or s-region-move-p2 as appropriate. Wed Jun 7 11:05:56 1995 Richard Stallman * replace.el (query-replace-map): Bind f1 and help. * subr.el (read-quoted-char): Turn on help-form and turn off help-char. * isearch.el (isearch-other-meta-char): Try downshifting shifted control characters. * files.el (file-precious-flag): Doc fix. * vc.el (vc-register): Clean error message if no visited file. * vc-hooks.el (vc-menu-map): Disable Register when no visited file. Wed Jun 7 15:11:27 1995 Paul Eggert * time.el (display-time-filter): Use same instant for both time and time-zone. Mon Jun 5 19:36:35 1995 Michael Kifer * ediff-merg.el (ediff-set-state-of-diff-in-all-buffers): bug fix. (ediff-set-merge-mode): new function. (ediff-do-merge): now sets correct major mode in the merge buffer. (ediff-combine-diffs): handles correctly non-interactive calls. * ediff.el: Added ediff-cleanup-hooks and ediff-janitor. * ediff-wind.el (ediff-setup-control-frame, ediff-keep-window-config): bug fix. * ediff-init.el (ediff-frame-has-menubar): function deleted. (ediff-device-type, ediff-color-display-p): new functions. * ediff-wind.el (ediff-make-control-frame): optimized for display. Commented out (redraw-display), to improve speed. * ediff.el: don't make the patch buffer RO. * ediff.el (ediff-load-version-control): now checks if ediff-revision-key is non-nil. * ediff.el (ediff-revision-key): Now defaults to nil. * ediff.el (ediff-revision): now takes prefix argument; can compare two versions of the same file. * ediff.el: the merge buffer now assumes the major mode of the default variant. * ediff.el (ediff-documentation: new function. * ediff-wind.el: Got rid of toolbars in control frame in xemacs * ediff-wind.el: Changed window-min-height from 1 to 2 * ediff-wind.el (ediff-diff-at-point, ediff-toggle-multiframe): bug fixes. (ediff-destroy-control-frame, ediff-window-display-p): new functions. * ediff.el, ediff-wind.el, ediff-util.el, ediff-init.el: Converted xemacs *screen* nomenclature to *frame*. Incorporated overlay strings. Ediff no longer runs under emacs 19.28 and earlier and XEmacs 19.11 and earlier. * ediff.el (ediff-patch-buffer): now handles buffers that don't visit any file. (ediff-windows): renamed to ediff-windows-wordwise, added (ediff-windows-linewise): new function. Changed ediff-small/large-regions to ediff-regions-wordwise/linewise * ediff.el, ediff-wind.el: Changed window-system to ediff-window-display. * ediff-wind.el (ediff-toggle-multiframe): fixed. (ediff-destroy-control-frame): new function. Mon Jun 5 16:43:29 1995 Boris Goldowsky * avoid.el, enriched.el, facemenu.el, format.el, shadowfile.el: Change email address for Boris. Sat Jun 3 14:10:48 1995 Richard Stallman * mouse.el (mouse-set-region): Don't bounce the cursor on X. mouse-drag-region takes care of showing it, sufficiently. Fri Jun 2 12:07:40 1995 Richard Stallman * version.el (emacs-version): If using Motif, mention it. * files.el (hack-local-variables-prop-line): Don't downcase var name. Fri Jun 2 10:34:53 1995 Ed Reingold * calendar.el (calendar-string-spread): Fix to allow 0 or 1 string. (calendar-set-mode-line): Use this ability. (generate-calendar-month): Ditto. * cal-x.el (calendar-two-frame-setup): Create fancy buffer if needed. (calendar-one-frame-setup): Ditto. * diary-lib.el (make-fancy-diary-buffer): New function. (fancy-diary-display): Use it. Fri Jun 2 03:42:37 1995 Simon Marshall * comint.el (comint-word): Set match-data to match the word. Thu Jun 1 20:13:28 1995 Karl Heuer * term/x-win.el (vendor-specific-keysyms): Recognize "X Consortium". Thu Jun 1 19:19:03 1995 Roland McGrath * files.el (multiple-recover-finish): Renamed to recover-session-finish. (recover-session): Changed binding. (recover-session-finish): Doc fix; rewritten using map-y-or-n-p. Thu Jun 1 16:53:39 1995 Ed Reingold * cal-x.el (calendar-setup): Autoload it. Thu Jun 1 05:09:12 1995 Simon Marshall * fast-lock.el: New version 3.06 from author. (fast-lock-save-cache): Use verify-visited-file-modtime to check timestamp of file against buffer, and visited-file-modtime to check timestamp of file against cache. Check buffer with buffer-modified-p. Do set-buffer before all of these. (fast-lock-save-events): Events for which a cache may be saved. (fast-lock-after-save-hook, fast-lock-kill-buffer-hook, fast-lock-kill-emacs-hook): Functions for those events; added to hooks. (fast-lock-save-faces): List of faces to save. (fast-lock-get-face-properties): Use it. (fast-lock-cache-filename): Variable to store buffer's cache file name. (fast-lock-cache-data): Set it. Use buffer-modified-p to check buffer. Compile keywords before comparison. Revert timestamp from verify-visited-file-modtime format if necessary. * font-lock.el (font-lock-compile-keywords): Optional KEYWORDS to use. Don't compile them if it looks like they already have been. Wed May 31 15:40:29 1995 Karl Heuer * time-stamp.el: Move defconsts to avoid byte-compiler warnings. * menu-bar.el (menu-bar-help-menu): Add "..." Wed May 31 16:25:03 1995 Richard Stallman * dired.el (dired-find-buffer-nocreate): Ignore dead buffers. * scroll-bar.el (scroll-bar-drag): Call scroll-bar-drag-1 inside the let. Tue May 30 17:44:51 1995 Morten Welinder * lisp-mode.el (emacs-lisp-mode-map): Add a menu. (emacs-lisp-byte-compile): New function. * arc-mode.el (archive-lemacs): New variable. (archive-mode-map, archive-summarize-files): Make it sort-of work with Lucid Emacs. (archive-mouse-extract): Use Lucid compatible code. (archive-summarize-files, archive-lzh-chmod-entry): Guard lambda with function. Tue May 30 17:19:56 1995 Stephen Gildea * time-stamp.el (time-stamp): only warn about time-stamping being disabled if found a time-stamp that won't get updated. Tue May 30 15:36:18 1995 Roland McGrath * compile.el (compilation-error-regexp-alist): In "Cray C" regexp, don't allow newlines. Tue May 30 15:20:19 1995 Michael Kifer * ediff-wind.el (ediff-setup-control-frame): Make Ediff delete the old control frame before creating a new one. Tue May 30 14:38:48 1995 Karl Heuer * bookmark.el: Fix capitalization in menu bar. * rmailsum.el: Likewise. * makefile.el: Likewise. * hideshow.el: Likewise. * cal-menu.el: Likewise. * sh-script.el (sh-mode-map): Likewise. * compile.el (compilation-mode-map): Likewise. * bibtex.el (bibtex-mode-map): Likewise. * tar-mode.el (tar-mode-map): Likewise. * forms.el (forms--mode-menu-ro, forms--mode-menu-edit): Likewise. * gud.el: Likewise. (gud-xdb-find-file): Delete duplicate menu-bar entry. * f90.el: Fix capitalization and punctuation in menu bar. * frame.el (frame-configuration-p): Moved to subr.el. * subr.el (frame-configuration-p): Moved here from frame.el. Tue May 30 14:27:18 1995 Richard Stallman * facemenu.el (facemenu-special-menu): Use characters, not symbols. Add Remove Special menu item. (facemenu-remove-special): New function. (facemenu-set-face-from-menu): If prefix arg, treat region as inactive. (facemenu-set-face): Likewise. (facemenu-keymap, facemenu-foreground-menu, facemenu-background-menu): Add ... after Other. (facemenu-menu): Change name to Text Properties. * facemenu.el (facemenu-remove-really-all): New function. (facemenu-special-menu): Add Remove All menu item. (facemenu-indentation-menu): Make item names clearer. Pick new key names too. * facemenu.el (facemenu-menu): Split up definition. Move `Remove All' item here. (facemenu-special-menu): Delete `Remove All' item. (facemenu-remove-all): Renamed from facemenu-remove-really-all. (facemenu-remove-props): Renamed from facemenu-remove-all. Mon May 29 16:15:53 1995 Karl Heuer * frame.el (make-initial-minibuffer-frame): New function. (frame-notice-user-settings): Call it. * man.el (Man-default-man-entry): Return result. * gud.el (gud-perldb-find-file): Use gud-make-debug-menu. Mon May 29 17:59:27 1995 Richard Stallman * gud.el (gud-make-debug-menu): New function. (gud-mode, gud-gdb-find-file, gud-dbx-find-file, gud-sdb-find-file) (gud-xdb-find-file): Use gud-make-debug-menu. * find-dired.el (find-dired): If dired-simple-subdir-alist is not defined, set dired-subdir-alist a different way. (find-dired-version): Variable deleted. * files.el (after-revert-hook, before-revert-hook): Add defvars. Mon May 29 16:07:36 1995 Andreas Schwab * gud.el (gud-perldb-massage-args): Pass `-emacs' after the file name. * dired.el (dired-mode-map): Rename menubar bindings and use the new function names `dired-do-query-replace' and `dired-do-search'. Mon May 29 15:15:01 1995 Francesco Potorti` (pot@cnuce.cnr.it) * man.el (Man-init-defvars): Don't remove lines containing "No such file or directory". Mon May 29 02:48:05 1995 Karl Heuer * cc-mode.el (c-mode-help-address): New hostname. Sun May 28 23:59:00 1995 Erik Naggum * mail-extr.el (mail-extr-all-letters-but-separators): reinstate \377, the bug in search.c is apparently gone. (mail-extr-first-letters): add 8-bit characters (mail-extr-last-letters): ditto * simple.el (indent-for-comment): move to beginning of line only if there is a comment syntax. Sun May 28 23:58:00 1995 Michael Ernst * dired.el (dired-find-buffer-nocreate): Check only buffers in dired-buffers instead of all buffers in (buffer-list). Sun May 28 18:17:22 1995 Richard Stallman * vc.el (vc-revert-buffer1): Delete the special code for font-lock. * font-lock.el (font-lock-revert-cleanup): Always turn font lock on. (font-lock-mode): When turning mode off, always take out the revert hooks. * files.el (revert-buffer): Save after-revert-hook (both local and global values) before reverting, and run the saved values at the end. * files.el (find-file-noselect): In "file changed" messages, mention buffer name if different from file name. * ediff-wind.el (ediff-setup-control-frame): Use designated-minibuffer-frame while making the new frame. And delete the old frame if its minibuffer is not in that frame. (ediff-setup-windows-multiframe-compare) (ediff-setup-windows-multiframe-merge): Don't mess with default-minibuffer-frame here and don't kill the old control frame. * ediff-util.el (ediff-setup): Don't make default-minibuffer-frame a buffer-local variable. * dabbrev.el (dabbrev--abbrev-at-point): If point is after a separator, move back to previous abbreviation. (dabbrev-expand): New feature--if you insert a space and call this command again, it always fetches consecutive words after the expansion that was found for the actual abbrev. * isearch.el (isearch-edit-string): Don't bind isearch-other-end. Fri May 26 20:40:18 1995 Richard Stallman * sendmail.el (send-mail-function, mail): Doc fixes. * simple.el (previous-matching-history-element): No longer remove empty string from history. Better error message if history is empty. Fri May 26 20:33:52 1995 Karl Heuer * vc-hooks.el (vc-log-info): Use path-separator. * info.el (Info-directory-list): Use path-separator. * gud.el (gud-gdb-marker-regexp): New var. Use path-separator. Fri May 26 20:22:39 1995 Michael Ernst * ispell.el (ispell-message-text-end): Match start of forwarded msg. Fri May 26 16:11:07 1995 Geoff Voelker * startup.el (command-line): Handle nil command-line-args. Fri May 26 12:25:13 1995 Roland McGrath * compile.el (compilation-error-regexp-alist): In "IBM C/C++ Tools" regexp, disallow leading spaces and disallow whitespace chars within the file name. Fri May 26 00:00:10 1995 Michael Ernst * dired-x.el (dired-find-buffer-nocreate): Don't try to find a wildcard as a subdirectory. * gud.el (gud-common-init): Don't die if filename not supplied. Omit trailing hyphen when no filename follows. * texnfo-upd.el (texinfo-sequentially-find-pointer): Don't modify the kill ring. Thu May 25 23:53:58 1995 Richard Stallman * bytecomp.el (byte-compile-insert-header): When using dynamic docstrings, refuse to load in 19.28 and older. In that error message, don't mention the directory names. * faces.el (x-create-frame-with-faces): Read geometry resource and use that while creating the frame. Wed May 24 17:02:23 1995 Rolf Ebert * ada-mode.el (initial comments): Copyright 1995; don't speak about setup; correct history for a file that actually IS in Emacs 19.29; update list of known bugs. (all functions): inititialize all local variables explicitely to 'nil'. (ada-font-lock-keywords): initialized according to new user option `font-lock-maximum-decoration'. * ada-mode.el (ada-ident-re): new regexp for Ada identifiers. (ada-block-start-re): "record" may be preceded by one or more occurencies of "limited", "abstract", or "tagged". (ada-end-stmt-re): added "separate" body parts, "else", and "package is". (ada-subprogram-start-re): added "entry", "protected" and "package body" (ada-indent-function): handle "elsif" the same way as "if", added "separate" for no indent. (ada-get-indent-type): if "type ... is .." is followed by code on the same line, it is a broken statement. Test it. (ada-check-defun-name): check for "protected" records. (ada-goto-matching-decl-start): use of ada-ident-re. (ada-goto-matching-start): extend regexp for "protected" record. (ada-in-limit-line): renamed from in-limit-line. Don't use count-lines, but test if beginning-of-line/end-of-line puts us to bob/eob. (ada-goto-previous-nonblank-line): save a beginning-of-line statement, as we already are there. (ada-complete-type): removed. (ada-tabsize): removed. (keymap): use C-M-a and C-M-e for proc/func movement. No keybinding anymore for next/prev-package. (ada-font-lock-keywords-[1|2]): add protected records. "when" removed from 'reference'-face. (initial comments): updated CREDITS list. (ada-add-ada-menu): capitalized menu entries. Added menu statement needed for XEmacs. * ada-mode.el: changed all Ada94 to Ada95. * ada-mode.el: (ada-xemacs): new function, detect if we are running on XEmacs. Ada keymap definition and menus use it. (ada-create-syntax-table): corrected comments explaining use of 2nd syntax table. Added creation of ada-mode-symbol-syntax-table with '_' as word constituent. (ada-adjust-case): add test, if symbol is preceeded by a "'". If true, change case according to ada-case-attribute. (ada-which-function-are-we-in): new routine. Save name of the current function in the old buffer; we can place cursor now at the same function in the new buffer using find-file. (ada-make-body): new function. Generates body stubs if the body did not exist yet and you switch to it by find-file. (ada-gen-treat-proc): complete rewrite for ada-make-body. (ada-mode): two doc lines about the above extension. (keymap definition): remove 4th parameter in call to `substitute-key-definition' to make XEmacs happy. (ada-adjust-case-region, ada-move-to-start, ada-move-to-end, ada-indent-newline-indent, ada-format-paramlist): switch syntax tables, protect switching of syntax tables with unwind-protect. (ada-in-open-paren-p): replace user option `ada-search-paren-line-count-limit' by `ada-search-paren-char-count-limit'. (ada-case-attribute): new user option, but not yet the functionality. (ada-krunch-args): initialized to 0 exploiting the new capability of 'gnatk8' as of gnat-2.0. (ada-make-filename-from-adaname): remove downcasing and replacement of dots. This is done in external program gnatk8 (gnat-2.0). (ada-in-open-paren-p): complete rewrite for speed-up. (ada-search-ignore-string-comment): ignore # as a string terminator in all searches. (ada-add-ada-menu): use real variables instead of t for invoking 'easymenu' (require 'easymenu). (imenu-create-ada-index): we accept forward definitions again. (ada-indent-region): catch errors, simplified code. Tue May 23 20:18:57 1995 Karl Heuer * term/x-win.el (vendor-specific-keysyms): Add second spelling for HP. * arc-mode.el: Remove version number. Tue May 23 15:08:51 1995 Richard Stallman * menu-bar.el (delete-frame-enabled-p): New subroutine. Use frame-visible-p to reduce consing. * help.el (describe-prefix-bindings): If key is a string, make a substring; for a vector, make a vector. Mon May 22 18:24:16 1995 Erik Naggum * gnus.el (gnus-gnus-to-quick-newsrc-format): don't save gnus-newsgroup-alist in .newsrc.el. Mon May 22 17:41:23 1995 Richard Stallman * edmacro.el (edit-kbd-macro): Better error messages for undefined keys or keys that are not keyboard macros. * ada-mode.el (ada-add-ada-menu): Fix args to easy-menu-define. Mon May 22 15:40:21 1995 Karl Heuer * files.el (file-ownership-preserved-p): Fix typo in previous change. * sendmail.el (mail-text): Expand abbrev before moving point. Sat May 20 00:29:11 1995 Karl Heuer * mouse.el (mouse-save-then-kill): Fix previous change. * easymenu.el (easy-menu-do-define): Add autoload cookie. Fri May 19 14:56:10 1995 Kevin Rodgers * mailalias.el (expand-mail-aliases): Expand aliases in From and Reply-to headers as well, plus the Resent- variants. * sendmail.el (mail-mode): Clarify doc string. (mail-text): Ditto. Thu May 18 18:20:57 1995 Karl Heuer * faces.el: Put property on set-face-stipple, not set-stipple. (face-fill-in): Handle stipple. Thu May 18 12:50:58 1995 Richard Stallman * bytecomp.el (byte-compile-dynamic-docstrings): Doc fix. * tar-mode.el (tar-mode): Set write-contents-hooks instead of local-write-file-hooks. * loadhist.el (unload-feature): When we come to (provide . FEATURE), remove FEATURE from the features list. Wed May 17 16:34:48 1995 Richard Stallman * c-mode.el (c-fill-paragraph): Don't alter point when deciding to narrow at the end for the sake of a comment ender. * gnus.el (gnus-expunge): Use defalias. Wed May 17 15:33:47 1995 Karl Heuer * buff-menu.el (Buffer-menu-buffer): Give more informative error message if user attempts a selection at end of buffer. * easymenu.el (easy-menu-create-keymaps): Set menu-enable prop. Tue May 16 17:57:50 1995 Karl Heuer * lpr.el: Add provide call. Mon May 15 17:52:55 1995 Karl Heuer * facemenu.el (facemenu-set-face-from-menu): Doc fix. (facemenu-set-background, facemenu-set-foreground): Doc fix. (facemenu-set-face): Doc fix. * files.el (file-ownership-preserved-p): Don't bomb if file doesn't exist. * add-log.el (get-method-definition): Fix regexps. * tq.el (tq-process-buffer): Don't hard-code the buffer name. Fri May 12 20:26:29 1995 Karl Heuer * x-apollo.el: New file. * term/x-win.el (vendor-specific-keysyms): New function. Fri May 12 12:39:44 1995 Roland McGrath * rlogin.el (rlogin-history): New defvar. (rlogin): Use rlogin-history as history var in read-from-minibuffer. * compile.el (compilation-next-error-locus): Ignore zero column number. (compilation-parse-errors): Don't store the beginning of the line containing the end of the error-regexp match. Instead, store the beginning of the line containing the start of the match, unless the match starts with a newline, in which case the beginning of the next line. * vc-hooks.el (vc-status): If vc-locking-user returns a number, compare it to (user-uid). Thu May 11 22:16:55 1995 James Thompson * ps-print.el: Miscellaneous fixes for better compatibility with XEmacs 19.12. * ps-print.el (ps-plot-with-face): Added code to handle Emacs 19.29's new ability for the face attribute to hold a list of faces. * ps-print.el: Rolled in Chuck Thompson's changes to make color printing work in XEmacs 19.12. * ps-print.el: Fix error in comments. * ps-print.el (ps-generate-postscript-with-faces): Add fix to handle extents without faces. * ps-print.el (ps-faces-list): deleted. Added alias for list-faces if face-list isn't fbound. * ps-print.el: (ps-print-ensure-fontified) added to make sure ps-print works correctly in conjunction with lazy-lock. * ps-print.el: RMS's changes for Emacs. Wed May 10 20:45:12 1995 Roland McGrath * etags.el (tags-loop-continue): Doc fix. Reset NEW after visiting for real, so we don't clobber the buffer again. * compile.el (compilation-error-regexp-alist): Add regexps for IBM and Cray compilers. (compilation-next-error-locus): Ignore a column number that is zero. Tue May 9 01:31:23 1995 Richard Stallman * bytecomp.el (byte-compile-insert-header): Cope if user-mail-address is unbound. Tue May 9 14:30:19 1995 Andreas Schwab * loaddefs.el: Remove duplicate autoloads. Tue May 9 00:05:37 1995 Richard Stallman * info.el (Info-directory-list): Use installation-directory, not invocation-directory. Cope if it is nil. * sendmail.el (mail-font-lock-keywords): Make mail-header-separator into a regexp. * rnewspost.el (news-reply-mode): Add ^ to paragraph delimiters. * supercite.el (sc-no-blank-line-or-header): Make mail-header-separator into a regexp. Mon May 8 11:22:05 1995 Richard Stallman * lmenu.el (popup-dialog-box): x-popup-dialog returns the value, not the cons cell. * rnewspost.el (news-setup): Bind mail-signature to nil. * ediff.el (ediff-revision-key): Default value nil. (ediff-load-version-control): Don't remind any key if ediff-revision-key is nil. * info.el (info-insert-file-contents): Don't use (file-name-directory fullname) if it is nil. * helper.el (Helper-help): Use read-key-sequence. * mouse.el (mouse-save-then-kill): When making a new region and not adjusting an old one, always make new kill-ring entry and don't call mouse-show-mark. * add-log.el (add-log-current-defun): Handle objc-mode like c-mode; detect method definitions by their syntax. * menu-bar.el (menu-bar-tools-menu): Rename key to `compare'. Sun May 7 13:31:58 1995 Richard Stallman * add-log.el (get-method-definition, get-method-definition-1): New functions. (add-log-current-defun): Use them to handle objc-mode. * pc-mode.el (pc-bindings-mode): Add bindings for C-backspace and M-backspace. Make C-delete and M-delete operate on words. Add C-escape binding. * loaddefs.el (global-map): Add bindings for C-insert and S-insert. Also S-delete. Also C-up, C-down, C-prior and C-next. * files.el (recover-session): Renamed from multiple-recover. * noutline.el: Provide noutline as well as outline. Sat May 6 23:09:50 1995 Geoff Voelker * winnt.el (path-separator): Set to ";". * files.el (path-separator): Defined. (parse-colon-path): Use path-separator. Sat May 6 00:23:02 1995 Richard Stallman * pp.el (pp-eval-expression): Update use of temp-buffer-show-function. * term/x-win.el (x-colors): Delete "medium goldenrod" in both forms. Delete "medium forest green" in both forms. * gnus.el (gnus-use-generic-from): Doc fix. Fri May 5 18:30:45 1995 Richard Stallman * loaddefs.el: Delete autoloads for ispell4, noutline, noutline1. * noutline.el: All autoload cookies disabled. * ispell4.el: All autoload cookies disabled. * gnus.el (gnus-group-mode): Set truncate-lines. * edebug.el (\`): Add backslash. (edebug-\`): Add backslash. * info.el (info-insert-file-contents): Fix Apr 19 change. * sendmail.el (sendmail-send-it): Check continuation lines when checking for empty subject lines. Fri May 5 12:18:28 1995 Michael Ernst * ispell.el (ispell-region): If position not visible, (sit-for 0). Thu May 4 16:09:02 1995 Richard Stallman * trace.el: Don't try to define backquote. (trace-version): Deleted. * backquote.el ('\`): Use backslash for reading the backquote. (backquote-backquote-symbol): Likewise. (backquote): Doc fix. Wed May 3 02:10:43 1995 Richard Stallman * cc-mode.el: Doc fixes. (c-version): Mention that this may be modified version. Tue May 2 19:25:28 1995 Karl Heuer * scribe.el: (scribe-chapter): Change to C-c C-c. (scribe-section): Change to C-c C-t. (scribe-subsection): Change to C-c C-s. (scribe-insert-environment): Change to C-c C-v. (scribe-bracket-region-be): Change to C-c C-e. (scribe-italicize-word): Change to C-c C-i. (scribe-bold-word): Change to C-c C-b. (scribe-underline-word): Change to C-c C-u. * gomoku.el (gomoku-human-plays): Change to C-c C-p. (gomoku-human-takes-back): Change to C-c C-b. (gomoku-human-resigns): Change to C-c C-r. (gomoku-emacs-plays): Change to C-c C-e. * gnus-uu.el (gnus-uu-interactive-scan-directory): Change to C-c C-d. (gnus-uu-interactive-save-current-file): Change to C-c C-z. * allout.el (outline-rebullet-current-heading): Change to C-c *. Mon May 1 20:51:42 1995 Richard Stallman * s-region.el (S-delete): Fix typo (was C-delete). * hideif.el (hide-ifdef-mode-prefix-key): Change to C-c @. (hide-ifdef-mode-submap): Get rid of \e from all bindings. * outline.el, noutline.el (outline-minor-mode-prefix): Change to C-c @. * texinfo.el (texinfo-mode-map): Delete C-c ] binding. * forms.el (forms--mode-commands): Delete C-c ? binding. * rnewspost.el (news-reply-mode-map): Delete C-c ? binding. * isearch.el (isearch-mode): Doc fix. * iso-acc.el (iso-accents-mode): Doc fix. Mon May 1 15:04:21 1995 Karl Heuer * cc-mode.el (c-set-style): Ignore case in completion. Mon May 1 11:48:34 1995 Richard Stallman * mailalias.el (expand-mail-aliases): Use buffer-substring-no-properties. * subr.el (buffer-substring-no-properties): New function. * makefile.el (makefile-mode): Set dabbrev-abbrev-skip-leading-regexp. * dabbrev.el (dabbrev-completion): Use mapcar, not mapc. Call dabbrev--reset-global-variables as the first thing. * files.el (set-auto-mode): If buffer has no file, use buffer name. Sun Apr 30 21:52:09 1995 Jay Adams * jka-compr.el (jka-compr-write-region): Handle the append argument correctly when the can-append flag is false. (jka-compr-write-region): Make temp-buffer name unique to this fn. (jka-compr-file-local-copy): Ditto. Sun Apr 30 14:47:33 1995 Richard Stallman * files.el (multiple-recover, multiple-recover-finish): New commands. * startup.el (normal-top-level): Set auto-save-list-file-name. Sat Apr 29 01:28:11 1995 Richard Stallman * startup.el (command-line-1): Implement -L/--directory option. * jka-compr.el (jka-compr-insert-file-contents): When visiting, bind buffer-file-name to nil temporarily. * tex-mode.el (tex-view): Nice error if tex-dvi-view-command is nil. Wed Apr 26 14:24:44 1995 Rob Riepel * tpu-edt.el (tpu-copy-keyfile): New function. (tpu-load-xkeys): Copy key definition file to new default name. Wed Apr 26 17:42:37 1995 Karl Heuer * vc.el (vc-next-action-on-file): Add missing let-binding. Wed Apr 26 17:41:11 1995 Andre Spiegel * vc.el (vc-default-backend, vc-keep-workfiles, vc-consult-headers): (vc-mistrust-permissions, vc-path): Vars moved to vc-hooks.el. (vc-match-substring, vc-lock-file, vc-parse-buffer, vc-master-info): (vc-log-info, vc-consult-rcs-headers, vc-fetch-properties): (vc-backend-subdirectory-name, vc-locking-user, vc-true-locking-user): (vc-latest-version, vc-your-latest-version, vc-branch-version): (vc-workfile-version): Functions moved to vc-hooks.el. (vc-trunk-p, vc-minor-revision, vc-branch-part): Functions moved here from vc-hooks.el. * vc-hooks.el (vc-default-backend, vc-path, vc-consult-headers): (vc-mistrust-permissions, vc-keep-workfiles): Customization variables, moved here from vc.el. (vc-trunk-p, vc-minor-revision, vc-branch-part): Moved to vc.el. (vc-backend): Renamed from vc-backend-deduce. Callers changed. (vc-match-substring, vc-lock-file, vc-parse-buffer, vc-master-info): (vc-log-info, vc-consult-rcs-headers, vc-fetch-properties): (vc-backend-subdirectory-name, vc-locking-user, vc-true-locking-user): (vc-latest-version, vc-your-latest-version, vc-branch-version): (vc-workfile-version): Functions moved here from vc.el. (vc-log-info): Log program is no longer called through vc-do-command, to avoid including the lengthy vc-do-command here. It is done directly through call-process now. Removed obsolete parameter LAST. (vc-status): Replaced by the much simpler version that gets the information from the file properties. Removed the obsolete parameter vc-type. (vc-parse-buffer): changed format of PATTERNS. Each pattern is now a list of 2 to 3 elements, the first being the pattern, the remaining ones the numbers of subexpressions to refer to. (vc-cvs-status): New per-file property, only used in the CVS case. (vc-cvs-status): New function. (vc-log-info): Adapted to new version of vc-parse-buffer (vc-fetch-properties): Adapted to new version of vc-parse-buffer. Better search regexp for CVS latest version. (vc-log-info): Search for branch version only in the RCS case, since this doesn't make sense for SCCS or CVS. (vc-fetch-properties): CVS case: set vc-cvs-status. (vc-locking-user): CVS case: use vc-cvs-status to determine if the file is up-to-date, thus avoiding an expensive call to vc-workfile-unchanged-p. (vc-mode-line): Re-activated the code that makes the buffer read-only if the work file is unchanged. But the status of the work file is now determined by looking at the already-computed mode string. Wed Apr 26 05:18:11 1995 Richard Stallman * startup.el (command-line): Handle -iconic and -icon-type here. Tue Apr 25 17:49:45 1995 Karl Heuer * abbrev.el (abbrev-mode): Use force-mode-line-update. * appt.el (appt-check): Likewise. * array.el (array-mode): Likewise. * bytecomp.el (byte-recompile-directory): Likewise. * delsel.el (delete-selection-mode): Likewise. * dired-x.el (dired-omit-expunge): Likewise. * dired.el (dired-sort-set-modeline): Likewise. * double.el (double-mode): Likewise. * edt.el (edt-advance, edt-backup): Likewise. * emerge.el (emerge-fast-mode, emerge-edit-mode): Likewise. (emerge-auto-advance, emerge-skip-prefers): Likewise. (emerge-refresh-mode-line): Likewise. * f90.el (f90-auto-fill-mode): Likewise. * files.el (toggle-read-only, rename-uniquely): Likewise. * find-dired.el (find-dired-sentinel): Likewise. * fortran.el (fortran-auto-fill-mode): Likewise. * gomoku.el (gomoku-display-statistics): Likewise. * gud.el (gud-sentinel): Likewise. * hanoi.el (hanoi): Likewise. * hideif.el (hide-ifdef-toggle-read-only): Likewise. (hide-ifdef-toggle-outside-read-only): Likewise. * info.el (Info-edit-mode, Info-cease-edit): Likewise. * isearch.el (isearch-mode, isearch-done): Likewise. * ispell.el (ispell-minor-mode): Likewise. * mh-comp.el (mh-insert-signature): Likewise. * mh-e.el (mh-set-scan-mode): Likewise. * mh-utils.el (mh-set-mode-name): Likewise. o * noutline.el (outline-minor-mode): Likewise. * outline.el (outline-minor-mode): Likewise. * picture.el (picture-set-motion, picture-mode-exit): Likewise. * rmailedit.el (rmail-edit-current-message): Likewise. (rmail-cease-edit): Likewise. * simple.el (auto-fill-mode): Likewise. * supercite.el (sc-raw-mode-toggle): Likewise. * term.el (term-update-mode-line, term-process-pager): Likewise. (term-pager-continue): Likewise. * terminal.el (te-edit, te-more-break-unwind): Likewise. (te-update-pending-output-display): Likewise. * time.el (display-time-sentinel, display-time-filter): Likewise. * vi.el (vi-switch-mode, vi-back-to-old-mode): Likewise. (vi-mode, vi-goto-insert-state): Likewise. * vip.el (vip-change-mode): Likewise. * xscheme.el (xscheme-set-runlight, xscheme-set-prompt): Likewise. Tue Apr 25 15:00:23 1995 Richard Stallman * compile.el (compile-internal): Disable undo before erasing the buffer, then enable again afterward. (compilation-sentinel): Use force-mode-line-update. * tpu-extras.el: Removed reference to tpu-gnu-emacs18-p. * tpu-mapper.el: Eval key definitions and clean up upon completion. Persistent completion status message. * loaddefs.el (esc-map): Define ESC ESC : like ESC :. Tue Apr 25 09:34:58 1995 Johan Vromans * forms.el: (forms--make-format-elt-using-text-properties) forms--make-format): Add `intangible' text property to read-only areas. (forms-next-field, forms-previous-field): Use `inhibit-point-motion-hooks' to allow move between two intangible areas. Tue Apr 25 03:52:28 1995 Simon Marshall * supercite.el (sc-string-text): New function to return raw text. (sc-mail-fetch-field, sc-mail-append-field): Use it. (sc-submatch): Make it a defalias for match-string. (sc-member): Make it a defalias for member. Tue Apr 25 00:09:05 1995 Richard Stallman * files.el (rename-uniquely): Don't discard from end if that is part of the visited file name. * rmail.el (rmail-insert-inbox-text): Get the truename of the standard inbox name, not just of its directory. Mon Apr 24 10:58:51 1995 Richard Stallman * sendmail.el (mail-position-on-field): Use $, not \n, in regexp. * tpu-edt.el (tpu-search-internal): Case-sensitive search if search string contains upper-case. tpu-check-search-case): New function. * tpu-edt.el: Don't turn on tpu-edt mode. (tpu-gnu-emacs19-p): Function deleted. Callers changed. (tpu-load-xkeys): Use file name .tpu-keys by default. (tpu-gnu-emacs18-p): Function deleted. * tpu-mapper.el: At end, use default file name .tpu-keys. Do not kill Emacs. (tpu-emacs-map-key): Renamed from tpu-gnu-map-key. * vc.el (vc-backend-checkout): Pass vc-checkout-switches arg properly to vc-do-command. * isearch.el (isearch-update-ring): Use STRING arg, not isearch-ring. * files.el (rename-uniquely): Strip suffix before rename. Mon Apr 24 06:51:48 1995 Simon Marshall * font-lock.el (font-lock-keywords): Doc fix for MATCHER. (font-lock-maximum-size): Set based on font-lock-maximum-decoration. (font-lock-after-fontify-buffer-hook): Removed. (font-lock-after-fontify-buffer): New function. (font-lock-fontify-buffer): Use instead. Don't bother if buffer empty. (font-lock-fontify-region): Use font-lock-syntax-table if set. (font-lock-unfontify-region): Only set-buffer-modified-p if necessary. (font-lock-after-change-function): Use it to unfontify. (font-lock-compile-keywords): New function to compile keywords. (font-lock-apply-highlight): New inline function to apply highlights. (font-lock-hack-keywords): Use them, if font-lock-keywords are not compiled, and to highlight. Use funcall if MATCHER is not a regexp. (font-lock-mode): Doc fix for font-lock-maximum-decoration. Use font-lock-set-defaults to call font-lock-make-faces. (tex-font-lock-keywords): Revamped. * fortran.el (fortran-match-!-comment): New function. (fortran-font-lock-keywords-1, fortran-font-lock-keywords-2): Use it. (fortran-font-lock-keywords-3): New variable. (fortran-find-comment-start-skip): Clean code. * add-log.el (change-log-font-lock-keywords): dired.el (dired-font-lock-keywords): sendmail.el (mail-font-lock-keywords): rmailsum.el (rmail-summary-font-lock-keywords): shell.el (shell-font-lock-keywords): Efficiency change. Mon Apr 24 00:20:29 1995 Richard Stallman * easymenu.el (easy-menu-define): Doc fix. * iso-acc.el (iso-accents-list): Add ~! and ~? combinations. * byte-opt.el (byte-optimize-letX): Use car-safe and cdr-safe. Thu Apr 20 17:19:49 1995 Karl Heuer * rmail.el (rmail-resend): Fix abbrev expansion. * rmailkwd.el (rmail-attributes): Recognize "resent" attribute. * mailabbrev.el (sendmail-pre-abbrev-expand-hook): When setting the dummy value for abbrev-start-location, use (point-max) rather than (point), so we won't delete a "-" that happens to be at point. Thu Apr 20 19:22:23 1995 Stephen Gildea * mh-mime.el, mh-comp.el: Update some MIME doc strings. * mh-comp.el (mh-auto-fill-for-letter): Use fill-prefix to do message headers. Thu Apr 20 13:22:00 1995 Torbj|rn Einarsson * f90.el (f90-keywords): "only" added to keyword list. (f90-font-lock-keywords-1): Type may now have attributes private and public. (f90-font-lock-keywords-2): Fixed difference between type and type(). (hilit-set-mode-patterns): Type may now have attributes private. and public, fixed difference between type and type(). (f90-p-type-re): New regular-expression constant for type commands. (f90-mode): indent-tabs-mode put to nil by default. (f90-looking-at-type-like): Now uses f90-p-type-re. (f90-no-block-limit): Now uses f90-p-type-re. (f90-change-keywords): Don't change preprocessor lines. Thu Apr 20 11:39:25 1995 Kevin Rodgers * dired-x.el: Change the instructions in the INSTALLATION comment block to set buffer-local variables like dired-omit-files-p in dired-mode-hook. (dired-omit-files-p): Make local to all buffers. (dired-omit-files): Fix doc string (not buffer-local). (dired-omit-startup): Don't need to make dired-omit-files-p local to buffer here. Thu Apr 20 04:38:36 1995 Richard Stallman * rmail.el (rmail-get-new-mail): Simply the reversion check; don't call rmail-forget-messages. Wed Apr 19 22:22:06 1995 Richard Stallman * rmail.el (rmail-revert): Call rmail-mode after reverting to make sure rmail-message-vector is buffer-local. * undigest.el (undigestify-rmail-message): Strip "^- " which is added by some digest makers to the beginning of lines. Wed Apr 19 02:06:24 1995 Richard Stallman * info.el (info-insert-file-contents): Set default-directory around call to shell-command-on-region. Wed Apr 19 10:39:00 1995 Mike Williams * mouse-sel.el: Downcase function parameters. Doc fixes. * mouse-sel.el Rewrite to support secondary selection. (mouse-sel-maintainer-address): New constant. (mouse-sel-submit-bug-report): New function. Rename mouse-sel-selection-type to mouse-sel-primary-thing. (mouse-sel-secondary-thing): New variable. (mouse-sel-selection-alist): New constant. (mouse-sel-set-selection-function): Semantics changed. Value should now be a function taking two arguments. (mouse-sel-get-selection-function): Semantics changed. Value should now be a function taking one argument. (mouse-sel-selection-owner-p-function): New variable. Removed variable mouse-sel-check-selection-function. Rename mouse-sel-determine-selection-type to mouse-sel-determine-selection-thing. (mouse-sel-set-selection): New function. (mouse-sel-get-selection): New function. (mouse-sel-selection-owner-p): New function. (mouse-sel-selection-overlay): New function. (mouse-sel-selection-thing): New function. (mouse-sel-region-to-primary): New function. (mouse-sel-primary-to-region): New function. (mouse-sel-eval-at-event-end): New macro. (mouse-sel-determine-selection-thing): Quad-click selects paragraphs. Removed variable mouse-sel-retain-highlight; use inverse of transient-mark-mode instead. (mouse-select-internal): New function. (mouse-select): Re-written using mouse-select-internal and mouse-sel-primary-to-region. (mouse-select-secondary): New function. (mouse-extend-internal): New function. (mouse-extend): Re-written using mouse-extend-internal, mouse-sel-region-to-primary and mouse-sel-primary-to-region. (mouse-extend-secondary): New function. (mouse-insert-selection-internal): New function. (mouse-insert-selection): Re-written using mouse-insert-selection-internal. (mouse-insert-secondary): New function. (mouse-sel-validate-selection): Check all selections in mouse-sel-selection-alist. Tue Apr 18 13:39:55 1995 Andreas Schwab * info.el (Info-find-node, Info-restore-point, Info-search, Info-forward-node, Info-backward-node): Use string-equal, not equal, to compare node names. * cpp.el (cpp-edit-reset): Fix typo. (cpp-signal-read-only, cpp-grow-overlay): Update to new calling conventions. (cpp-make-overlay-hidden): Don't allow insertion before a read-only overlay. Tue Apr 18 20:05:20 1995 Richard Stallman * cl-specs.el (pushnew): Use edebug-keywordp. * edebug.el (edebug-match-keywordp): Function deleted. * finder.el (finder-known-keywords): Add `debugging'. * vc-hooks.el (vc-buffer-backend): New function. Also new variable, local in all buffers. (vc-kill-buffer-hook): Kill local vc-buffer-backend. * vc.el (vc-update-change-log): Use vc-buffer-backend in menu-enable. Tue Apr 18 18:53:56 1995 Roland McGrath * complete.el: Add Keywords: comment header for finder.el. Tue Apr 18 15:23:05 1995 Richard Stallman * menu-bar.el: Disable many Files menu items in minibuffer. (menu-bar-search-menu): Add ... to many items. Add a query-replace-regexp item. (nonincremental-repeat-search-forward): Renamed from noninteractive... (nonincremental-repeat-search-backward): Likewise. (nonincremental-repeat-re-search-forward): Likewise. (nonincremental-repeat-re-search-backward): Likewise. * frame.el (frame-notice-user-settings): Don't respecify an old value which was nil and remains nil. Tue Apr 18 14:29:14 1995 Roland McGrath * etags.el (tags-search, tags-query-replace): Put (quote ...) around args inserted into forms to be evalled. Tue Apr 18 03:00:44 1995 Richard Stallman * cpp.el (cpp-edit-list): Move definition toward start of file. (cpp-face-type-list, cpp-writable-list, cpp-button-event) (cpp-edit-buffer, cpp-branch-list, cpp-face-default-list) (cpp-face-light-name-list, cpp-face-dark-name-list) (cpp-face-light-list, cpp-face-dark-list, cpp-face-mono-list) (cpp-face-none-list, cpp-face-all-list, cpp-overlay-list): Likewise. * cpp.el (cpp-highlight-buffer): Rename stack to cpp-state-stack. (cpp-parse-open, cpp-parse-close): Likewise. (cpp-push-button, cpp-choose-symbol): Rename data to cpp-callback-data. (cpp-state-stack, cpp-callback-data): Add defvars. * simple.el (line-move): Fix previous change: if we get an error, move to where the error happened, don't go back to starting point. Mon Apr 17 23:37:58 1995 Richard Stallman * forms.el: Major rewrite to use `intangible' property. Mon Apr 17 14:51:54 1995 Karl Heuer * map-ynp.el (map-y-or-n-p): Don't log prompt messages. Mon Apr 17 14:42:13 1995 Richard Stallman * finder.el (finder-known-keywords): Generalize `c' keyword. Sun Apr 16 23:01:43 1995 Ethan Bradford * ispell.el (ispell-init-ispell): Don't barf if there is a warning message before the version line when Ispell starts up. Sun Apr 16 00:01:10 1995 Richard Stallman * font-lock.el (font-lock-make-faces): Determine font-lock-background-mode from color values of background color. * facemenu.el (list-colors-display): Minor clarification. (facemenu-special-menu): Add "Intangible" item. (facemenu-color-equal): Doc fix. * faces.el (set-face-background): Handle FRAME = nil directly so stipple colors work in that case. * term/x-win.el (x-defined-colors): Take frame as optional arg. Check whether colors are really supported on the display in use. Sat Apr 15 01:40:12 1995 Richard Stallman * files.el (set-auto-mode): If -*- spec doesn't set `mode:', look for other ways of specifying major mode. * talk.el: New file. * dired.el (dired-mode-map): Rename commands for A and Q. * dired-aux.el (dired-do-search): Renamed from dired-do-tags-search. (dired-do-query-replace): Renamed from dired-do-tags-query-replace. Fri Apr 14 19:15:47 1995 Richard Stallman * cpp.el (cpp-parse-open): Delete comments that go past end of line. (cpp-edit-reset): Clean up the four standard buttons. (cpp-parse-buffer): Name was undefined--use cpp-highlight-buffer. * finder.el (finder-known-keywords): Add frames, hypermedia, outlines, oop. Fri Apr 14 21:03:27 1995 Erik Naggum * rmail.el (rmail-reformat-message): Call `rmail-clear-headers' also if `rmail-displayed-headers' is set. (rmail-clear-headers): Handle `rmail-displayed-headers' correctly. Fri Apr 14 18:01:38 1995 Erik Naggum * rmail.el (rmail-insert-inbox-text): When reading old .newmail- file, report it specifically. Fri Apr 14 13:15:37 1995 Karl Heuer * mouse.el: Create mouse-drag-overlay as a dead overlay, instead of having it live in the *scratch* buffer until first used. * edt-vt100.el (edt-vt100-revision): Deleted. * edt-pc.el (edt-pc-revision): Deleted. * edt-mapper.el (edt-mapper-revision): Deleted. * edt-lk201.el (edt-lk201-revision): Deleted. * edt.el: Many doc fixes. (edt-version): Deleted. Fri Apr 14 12:05:38 1995 Morten Welinder * tar-mode.el (tar-mode): Locally bind next-line-add-newlines to nil. (tar-subfile-mode): Doc fix. (tar-expunge): Make questions and messages start with uppercase letter. (tar-summarize-buffer): Ditto. (tar-subfile-save-buffer): Make message like others. (tar-mode): Locally bind local-write-file-hooks. (tar-mode-write-file): Renamed from tar-mode-maybe-write-tar-file. (tar-mode-write-file): Simplify to only work for tar file buffers. (write-file-hooks): Don't modify this. Fri Apr 14 01:53:54 1995 Richard Stallman * derived.el (derived-mode-merge-keymaps): Recursively merge prefix key submaps also. Thu Apr 13 18:14:58 1995 Richard Stallman * edebug.el (edebug-gensym): Renamed from gensym. Don't use concat on an integer. Define unconditionally. (edebug-gensym-index): Renamed from *gensym-index*. (edebug-lambda-list-keywordp): Renamed from lambda-list-keywordp. (edebug-keywordp): Renamed from keywordp. Define unconditionally. * vc-hooks.el (vc-kill-buffer-hook): Don't put it on kill-buffer-hook. (vc-file-clearprops): Function moved here. (vc-workfile-version): Function moved here. (vc-mode-line): Don't call vc-locking-user. * vc.el (vc-file-clearprops, vc-workfile-version): Functions moved to vc-hooks.el. * edebug.el (edebug-emacs-19-specific): Use name edebug-menu for the easy-menu-define call. * font-lock.el (font-lock-make-faces-done): New variable. (font-lock-make-faces): Set font-lock-make-faces-done to t. Don't call it when loading the file. (font-lock-mode): Call font-lock-make-faces if not yet done. * bytecomp.el (byte-compile-log-file): Always insert at eob. (byte-compile-insert-header): Cope if user-mail-address is nil. Thu Apr 13 18:00:00 1995 Andre Spiegel * vc-hooks.el: Add branch support for RCS; treat CVS more like RCS and SCCS. (vc-occurences, vc-trunk-p, vc-branch-p, vc-minor-revision) (vc-branch-part): new functions that operate on RCS revision numbers. (vc-status): Use the new property vc-workfile-version and vc-locking-user (see vc.el). Display "locking state" for CVS. (vc-find-cvs-master): Search for file name case-sensitively, store version number into the new property vc-workfile-version. (vc-find-file-hook): kill any remaining properties. Like this, when re-finding a file (for example because it has changed on disk), the version control state gets re-computed. (vc-mode-line): CVS case: make the buffer read-only if the file is unmodified. (vc-kill-buffer-hook): Clear file's vc props when buffer is killed. * vc.el: Add branch support for RCS; treat CVS more like RCS and SCCS. (vc-next-action-on-file): changed CVS handling, such that C-x C-q works as with RCS and SCCS. (vc-consult-rcs-headers): New function. (vc-branch-version): New per-file property, refers to the RCS version selected by `rcs -b'. (vc-workfile-version): New function. Also new per-file property (vc-consult-headers): New parameter variable. (vc-mistrust-permissions): Default set to `nil'. (vc-locking-user): Property is now cached. The other functions update it as necessary. Attempts to use RCS headers if enabled. (vc-log-info, vc-parse-buffer): Various bug fixes. Added support for property `vc-branch-version'. (vc-backend-checkout): RCS case: if no explicit version is specified, check out `vc-workfile-version'. After check-out, set `vc-workfile-version' according to the version number reported by "co". (vc-backend-checkin): RCS case: remove any remaining locks if a new branch was created. After every check-in, adjust the current branch using `rcs -b' (this cannot be avoided). CVS case: allow for explicit checkin, but only on the trunk. (vc-next-action-on-file, vc-backend-checkout, vc-backend-checkin, vc-backend-revert, vc-backend-diff): Explicitly use vc-workfile-version as the default version to operate on. Thu Apr 13 01:43:13 1995 Richard Stallman * help.el (print-help-return-message): Check same-window-buffer-names and same-window-regexps. * help-macro.el (make-help-screen): Explicitly translate key thru function-key-map. * tabify.el (tabify): Include entire first line in narrowing. * sendmail.el (mail-do-fcc): Use just find-buffer-visiting to find buffer to append to. Wed Apr 12 03:05:23 1995 Richard Stallman * select.el (x-set-selection): Fix up interactive defaults. * fill.el (fill-paragraph, fill-region, fill-nonuniform-paragraphs) (fill-individual-paragraphs): Pass `full' for JUSTIFY arg, in the interactive spec, if have prefix arg. Tue Apr 11 10:20:51 1995 Stephen Gildea * time-stamp.el (time-stamp-format): Replace list of Lisp functions with string containing %-escapes, as in `date' program. (time-stamp): Widen buffer while time-stamping. (time-stamp-toggle-active): New function. (time-stamp-warn-inactive): New variable. Tue Apr 11 23:15:40 1995 Geoff Voelker * loadup.el [WINDOWSNT]: Find doc strings. * files.el (set-auto-mode) [WINDOWSNT]: Match insensitive to case. * dired-aux.el (dired-do-chmod): Use dired-chmod-program. (dired-do-chgrp, dired-do-chown) [DOS_NT]: Disabled. * dired.el (dired-chmod-program): Defined. * makefile.nt (all): Use DEL_TREE instead of delnode. * winnt.el: Key [C-M-backspace] defined. (mode-line-format): Defined. Tue Apr 11 19:00:36 1995 Richard Stallman * mail-hist.el (mail-hist-put-headers-into-history): Add save-excursion around entire function. Tue Apr 11 11:46:38 1995 Boris Goldowsky * facemenu.el (facemenu-read-color): Don't ignore PROMPT arg. Make arg optional. (facemenu-unlisted-faces): Add font-lock faces to default value. Tue Apr 11 09:17:49 1995 enami tsugutomo * perl-mode.el (perl-comment-indent): Make extra space only when not at beginning of line. Mon Apr 10 08:30:04 1995 Stefan Schoef * bibtex.el (bibtex-find-text, bibtex-remove-double-quotes-or-braces): Support both kind of delimiters (braces or quotes) regardless of the value of bibtex-field-left-delimiter and bibtex-field-right-delimiter. (bibtex-field-left-delimiter, bibtex-field-right-delimiter): Made buffer-local. * bibtex.el (bibtex-beginning-of-entry): At the beginning of an entry, leave point at the beginning of that entry instead of moving to the beginning of the previous one. (bibtex-end-of-entry): Outside an entry, now move to the end of the *previous* entry (i.e. bibtex-beginning-of-entry and bibtex-end-of-entry are now idempotent). (bibtex-sort-entries, bibtex-clean-entry): Removed now obsolete calls of bibtex-beginning-of-entry just before calls to bibtex-end-of-entry. (bibtex-clean-entry): Minor change to adapt to new behavior of bibtex-beginning-of-entry. Mon Apr 10 19:21:41 1995 Richard Stallman * reporter.el (reporter-mailer): Replace mail with reporter-mail. (reporter-mail): New function. (reporter-submit-bug-report): Don't check return value of the reporter-mailer function. Mon Apr 10 15:50:39 1995 Boris Goldowsky * simple.el (newline): Don't auto-fill if flag is on; it was filling wrong line. Mon Apr 10 12:45:56 1995 Roland McGrath * compile.el (compilation-error-regexp-alist): Remove superfluous SGI cc regexp. Mon Apr 10 09:26:08 1995 Simon Marshall * version.el (emacs-major-version, emacs-minor-version): Use match-string rather than substring. Mon Apr 10 03:09:18 1995 Richard Stallman * pc-mode.el (pc-bindings-mode): New file. * loaddefs.el (global-map): Bind C-M-backspace like C-M-delete. Sun Apr 9 20:02:47 1995 Richard Stallman * files.el (write-file): Default is ask for confirmation only interactively. Sun Apr 9 18:28:45 1995 Karl Heuer * mh-e.el, mh-seq.el, mh-pick.el, mh-mime.el: New version from author. * mh-comp.el, mh-utils.el, mh-funcs.el: New version from author. Sun Apr 9 14:57:14 1995 Roland McGrath * server.el (server-switch-buffer): Make first arg optional too; server-edit might pass no args, since server-done might return nil. Sun Apr 9 01:31:30 1995 Richard Stallman * simple.el (line-move): Turn off intangibility for intermediate stops. * menu-bar.el (menu-bar-update-buffers): Reuse the entry for list-buffers rather than making a new one each time. * simple.el (newline): Don't indent afterward if at page sep line. Delete whitespace on blank line before the inserted newlines. (open-line): Add all the left margins and fill prefixes after inserting all the newlines. * bytecomp.el (byte-compile-log-file): New function. (displaying-byte-compile-warnings): Log the file name at start; display the log buffer only if something more gets output by BODY. (byte-compile-warnings-point-max): Initialize to nil. Sun Apr 9 07:29:26 1995 G Dinesh Dutt (brat@htilbom.ernet.in) * etags.el (list-tags): Delete call to select-tags-matched-file. Sat Apr 8 23:51:05 1995 Richard Stallman * term/x-win.el (mode-line-buffer-identification): Fix prev change; use setq-default. Sat Apr 8 23:18:33 1995 Roland McGrath * etags.el (next-file): Handle empty list returned by (tags-table-files). Sat Apr 8 18:37:04 1995 Richard Stallman * replace.el (occur): Provide 5 cols for line number. * ange-ftp.el (ange-ftp-parse-netrc): Bind `default-directory' to "/" to avoid infinite loop while expanding filename. (ange-ftp-message): Don't truncate message in batch mode. * simple.el (completion-setup-function): Undo March 11 change. Add some doc strings to completion-related variables. Sat Apr 8 16:15:37 1995 Roland McGrath * compile.el (compilation-error-regexp-alist): Extend Ultrix 3.0 f77 regexp to also match SGI cc. Sat Apr 8 15:59:11 1995 Morten Welinder * comint.el (make-comint): Error, if start-process is not fboundp. * menu-bar.el (menu-bar-edit-menu): Don't define ispell item unless start-process is fboundp. Sat Apr 8 15:41:37 1995 Richard Stallman * rnewspost.el (news-reply-mode): Make mail-header-separator into regexp. * sendmail.el (mail-mode): Convert mail-header-separator to regexp for use in paragraph-start, etc. * ispell.el (ispell-message): Make mail-header-separator into regexp and add $ at end. * window.el (walk-windows): Doc fix. Sat Apr 8 03:31:49 1995 Noah Friedman * rsz-mini.el (resize-minibuffer-window): Make sure minibuffer window is selected. (resize-minibuffer-window-restore): Likewise. Sat Apr 8 01:00:37 1995 Richard Stallman * fill.el (fill-region-as-paragraph): Undo previous change. Instead, set JUSTIFY to `full' in the interactive spec. * startup.el (normal-top-level): Copy default-directory from *scratch* to *Messages*. * menu-bar.el (menu-bar-file-menu): Add back as alias for menu-bar-files-menu. Fri Apr 7 22:49:34 1995 Richard Stallman * loaddefs.el (mode-line-buffer-identification): Use %F by default. ([C-delete]): Bind C-delete normally, not in function-key-map. * term/x-win.el (mode-line-buffer-identification): Eliminate %F. Fri Apr 7 17:22:41 1995 Noah Friedman * rlogin.el (rlogin): Use format, not concat, to generate numeric buffer names. Do not create a new buffer if process in existing buffer has exited. (rlogin-directory-tracking-mode): Set shell-dirtrackp, not shell-dirtrack-p. Fri Apr 7 17:27:59 1995 Richard Stallman * ebuff-menu.el (electric-buffer-menu-mode-map): Undefine ESC ESC before binding ESC ESC ESC. * edt.el (edt-keep-current-page-delimiter): Doc fix. * find-file.el: Many doc fixes. (ff-upcase-p): Renamed from upcase-p. Callers changed. (ff-emacs-19): Renamed from ff-gnu-emacs-19. (ff-string-match): Simplify. * docref.el (docref-last-active-buffer): Add defvar. Fri Apr 7 14:32:56 1995 Boris Goldowsky * indent.el (set-right-margin): Fix prompt. * fill.el (fill-region): Avoid error on reaching end of buffer. * avoid.el: Add autoload cookies; doc fixes. (mouse-avoidance-set-pointer-shape): New function. (mouse-avoidance-nudge-mouse): Use it. (mouse-avoidance-fancy-hook): streamline args to set-mouse-pos. Fri Apr 7 02:02:10 1995 Richard Stallman * msb.el (msb--toggle-menu-type): menu-bar-update-buffers wants 0 args. * bytecomp.el (byte-compile-output-docform): Output doc string position as negative number, if doc string starts with *. * mail-hist.el: Use $ at end when searching for mail-header-separator. * fill.el (fill-region-as-paragraph): If JUSTIFY is non-nil, pass t to justify-current-line. Thu Apr 6 13:57:13 1995 Morten Welinder * desktop.el (desktop-save): Use dired-directory as name of top-level in order to capture wildcards used. (desktop-buffer-dired): Skip possible wildcard when checking for directory existance. Use dired-insert-subdir, not dired-maybe-insert-subdir. Thu Apr 6 15:24:30 1995 Karl Heuer * files.el (write-file): Fix arg count in call to y-or-n-p. Thu Apr 6 01:20:46 1995 Richard Stallman * ispell.el (ispell-menu-map-needed): Delete test for menu-bar feature. * bookmark.el (menu-bar-bookmark-map): Autoload each form used to set up this variable's value, so that the whole job is done in loaddefs.el. (bookmark-menu-locate, bookmark-menu-jump, bookmark-menu-insert) (bookmark-menu-delete, bookmark-menu-rename): Add autoloads. * buff-menu.el (list-buffers-noselect): Put buffer name in a text property on the buffer's name. Put in mouse-face prop here too. Set Buffer-menu-buffer-column here. (Buffer-menu-mode): Don't do those things here. (Buffer-menu-buffer): Use text properties. (Buffer-menu-buffer-name-position): Function deleted. * tar-mode.el (tar-clear-modification-flags): Fix several bugs. Wed Apr 5 22:11:13 1995 Richard Stallman * tar-mode.el (tar-mode-map): Fix typo for tar-display-other-file. Wed Apr 5 15:30:52 1995 Karl Heuer * tempo.el (tempo-build-collection): Clear flag after computing return value. Tue Apr 4 18:47:58 1995 Karl Heuer * ispell.el (ispell-personal-dictionary): Add autoload. * simple.el: Change bindings of event-apply-control-modifier, event-apply-meta-modifier, event-apply-hyper-modifier, event-apply-shift-modifier, event-apply-alt-modifier, and event-apply-super-modifier, in function-key-map, to use C-x @ instead of C-x ESC. Using escape causes problems since that's in function-key-map itself. * byte-opt.el (byte-compile-inline-expand): Fetch actual bytecode before inlining a lazy function. * tempo.el (tempo-dolist): Don't use `cadr'. * simple.el (event-apply-modifier): Fix off-by-one errors. Mon Apr 3 18:00:06 1995 Richard Stallman * jka-compr.el (jka-compr-install): Doc fix. (jka-compr-uninstall): Delete entries that jka-compr-install added to inhibit-first-line-modes-suffixes. Mon Apr 3 18:15:11 1995 David K}gedal * tempo.el (tempo-insert): Added the P tag and modified the s tag accordingly (tempo-insert-named): Checks for valid name, insert mark otherwise. * tempo.el (tempo-dolist): Changed (cadr ...) to (car (cdr ...)) * tempo.el (tempo-expand-if-complete): New function Mon Apr 3 17:36:50 1995 Karl Heuer * files.el (set-auto-mode): Fix previous change. Mon Apr 3 08:11:19 1995 Simon Marshall * comint.el (comint-file-name-quote-list): New variable of special characters that are quoted when in file names (default nil). (comint-mode): Make it buffer local. (comint-quote-filename): Quote them if they are in the file name. (comint-dynamic-complete-as-filename, comint-dynamic-list-filename-completions): Call it before insertion. (comint-unquote-filename): Unquote any character in the file name. (comint-match-partial-filename): Call it before substitution. (comint-word): Include any quoted character as part of the word. (comint-completion-addsuffix): Value can be a cons pair of strings. (comint-dynamic-complete-as-filename, comint-dynamic-simple-complete): Use it when inserting suffixes. * shell.el (shell-file-name-quote-list): New variable of special characters that are quoted when present in file names. (shell-mode): Set comint-file-name-quote-list with it. Sun Apr 2 00:40:15 1995 Richard Stallman * netunam.el: File deleted. * menu-bar.el (menu-bar-edit-menu): Capitalize an item name. (menu-bar-tools-menu): Add verb to Calendar item. (menu-bar-help-menu): Rename Info to Browse Manuals. * sendmail.el (mail-mode-map): Longer title for headers submenu. Sat Apr 1 00:14:46 1995 Richard Stallman * fill.el (fill-region-as-paragraph): Remove fill-prefix first, then remove indentation. * files.el (inhibit-first-line-modes-suffixes): New variable. (set-auto-mode): Use it. (inhibit-first-line-modes-regexps): Use \\', not $. * jka-compr.el (jka-compr-install): Add items to inhibit-first-line-modes-suffixes. * reporter.el (reporter-submit-bug-report): Give up if mailer command returns nil. Fix error message syntax. (reporter-bug-hook): Fix error message syntax. Fri Mar 31 17:05:15 1995 Richard Stallman * unrmail.el (unrmail): Don't make or switch to a summary buffer. * rmail.el (rmail-displayed-headers): New variable. (rmail-clear-headers): Handle rmail-displayed-headers Fri Mar 31 10:11:15 1995 Michael Ernst * scheme.el (scheme-indent-sexp): Don't fail when calculate-scheme-indent returns a one-element list. * rmailsum.el (rmail-summary-toggle-header): Make header visible in message buffer. Fri Mar 31 13:52:21 1995 Karl Heuer * macros.el (insert-kbd-macro): Do something reasonable for vectors. Thu Mar 30 20:46:55 1995 Richard Stallman * simple.el (choose-completion-string): Use active-minibuffer-window. * dired-aux.el (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that. Thu Mar 30 18:37:43 1995 Karl Heuer * comint.el (comint-read-noecho): Don't log prompt messages. Thu Mar 30 02:14:32 1995 Richard Stallman * apropos.el (apropos): Use apropos-worthy-symbol-p as default predicate. (apropos-worthy-symbol-p): New function. * faces.el (modify-face): Handle stipple. Handle defaulting properly. Speed up making completion alists. (modify-face-read-string): New subroutine. Thu Mar 30 01:59:12 1995 Simon Marshall * dired.el (dired-insert-directory): Wrap filename character quoting code with save-excursion. Wed Mar 29 02:14:12 1995 Richard Stallman * window.el (minibuffer-window-active-p): Use active-minibuffer-window. Tue Mar 28 17:24:35 1995 Karl Heuer * comint.el (comint-read-noecho): Use a format string, in case PROMPT contains a percent sign. Tue Mar 28 11:54:57 1995 Richard Stallman * nntp.el (nntp-request-article): If ID is integer, convert to string. Mon Mar 27 17:14:03 1995 Richard Stallman * simple.el (event-apply-modifier): New function. (event-apply-control-modifier, event-apply-meta-modifier) (event-apply-hyper-modifier, event-apply-shift-modifier) (event-apply-alt-modifier, event-apply-super-modifier): New functions, with bindings in function-key-map. * files.el (insert-directory): Use \ before insert-directory-program to ignore shell aliasing. Mon Mar 27 10:26:49 1995 Boris Goldowsky * enriched.el (enriched-mode): Use new plist-put and plist-get functions, and change name of default-text-properties var. Mon Mar 27 02:49:02 1995 Richard Stallman * cplus-md.el (calculate-c++-indent): Copy colon-line-end code from calculate-c-indent. Sat Mar 25 14:09:29 1995 Richard Stallman * scroll-bar.el (scroll-bar-drag): Bind echo-keystrokes to 0. Fri Mar 24 22:04:30 1995 Richard Stallman * rmail.el (rmail-display-labels): Use `format' to convert message numbers to strings. Fri Mar 24 18:41:20 1995 Karl Heuer * bytecomp.el (byte-compile-out-toplevel): Compile lambda forms even if trivial. Fri Mar 24 04:01:31 1995 Simon Marshall * subr.el (match-string): Change to defun, but still return nil if no match. Thu Mar 23 16:41:30 1995 Karl Heuer * c-mode.el (c-style-alist): Set c-continued-brace-offset and c-brace-offset in all styles, so that they don't inherit a trash value from a previously set style. * compile.el (compilation-sentinel): Use `format'; `concat' doesn't stringize integers anymore. * loadup.el: Don't load mouse and face files in system-specific branches; an earlier test has already loaded them based on a symbol equivalent to HAVE_MOUSE or HAVE_FACES. Thu Mar 23 15:41:00 1995 Richard Stallman * asm-mode.el (asm-mode): Make a per-buffer child keymap here. Use asm-comment-char to specify which character to define. (asm-mode-map): Don't bind `;' at load time. * pascal.el (pascal-mode-version): Variable deleted. Thu Mar 23 17:16:44 1995 Espen Skoglund * pascal.el (pascal-mode-syntax-table): Give \ punctuation syntax. Thu Mar 23 03:36:15 1995 Simon Marshall * subr.el (match-string): New macro. Unlike the function version, returns nil if no match. Wed Mar 22 16:30:58 1995 Richard Stallman * asm-mode.el: Doc fixes. Wed Mar 22 15:38:18 1995 Karl Heuer * mlsupport.el (ml-concat): New function. * mlconvert.el: Translate concat to ml-concat. Wed Mar 22 11:57:15 1995 Richard Stallman * window.el (one-window-p, walk-windows, minibuffer-window-active-p): Functions moved here. * subr.el (one-window-p, walk-windows, minibuffer-window-active-p): Functions moved to window.el. Tue Mar 21 16:39:39 1995 Boris Goldowsky * facemenu.el: Added autoload cookies, small doc fixes. (list-text-properties-at): New fn. (facemenu-menu): Add it to menu. * menu-bar.el (menu-bar-edit-menu): Add Text Properties item. Tue Mar 21 00:14:14 1995 Richard Stallman * startup.el (init-file-user, site-run-file): Doc fixes. * vc.el (vc-update-change-log): Use new -u option for rcs2log. * replace.el (occur): Copy default-directory to *Occur* buffer. * simple.el (shell-command): Use *Async Shell Command* for asynchronous commands. Doc fix. Mon Mar 20 21:18:56 1995 Karl Heuer * tar-mode.el (tar-parse-octal-long-integer): Return list, not vector. Mon Mar 20 14:42:09 1995 Karl Fogel * bookmark.el (bookmark-automatically-show-annotations): new var. (bookmark-jump): only show annotation if above var is non-nil. Mon Mar 20 00:09:06 1995 Richard Stallman * debug.el (debug): Now interactive. Sun Mar 19 15:09:34 1995 Richard Stallman * c-mode.el (c-mode-map): Use "C-mode", not "C mode". * menu-bar.el (menu-bar-files-menu): Renamed from ...-file-menu. (menu-bar-tools-menu, menu-bar-search-menu): New menu bar menus. Items moved from Edit and Files menus. Add Split Window, One Window, Find Tag and Postscript print menu items. (nonincremental-search-forward, nonincremental-search-backward) (nonincremental-re-search-forward, nonincremental-re-search-backward) (noninteractive-repeat-search-forward) (noninteractive-repeat-search-backward) (noninteractive-repeat-re-search-forward) (noninteractive-repeat-re-search-backward): New commands. * isearch.el (isearch-update-ring): New subroutine. (isearch-done): Use that. Sat Mar 18 02:01:07 1995 Richard Stallman * info.el (Info-next-preorder, Info-next-preorder-1): When moving up, advance to next menu item. * sendmail.el (mail): Use pop-to-buffer. (same-window-buffer-names): Add *mail*. (mail-other-window, mail-other-frame): Bind to nil same-window-buffer-names, special-display-buffer-names, and ...regexps. * files.el (write-file): Query if file exists already. * isearch.el (isearch-abort): Treat "incomplete regexp" as failure when deciding how much to discard for C-g. * rmail.el (rmail-resend): If mailabbrev loaded, use that to expand abbrevs. * mailabbrev.el: Various doc fixes. (mail-abbrevs-setup): Use add-hook and make-local-hook. Fri Mar 17 20:36:44 1995 Richard Stallman * debug.el (debugger-outer-load-read-function): New variable. (debug): Bind load-read-function to nil; save old value in debugger-outer-load-read-function and restore at end. (debugger-eval-expression): Handle load-read-function like other magic variables. Fri Mar 17 18:00:14 1995 Karl Heuer * ediff.el: Delete some autoloads that are now in menu-bar.el. Don't put ediff-windows in the menu. (ediff-patch-buffer): Use buffer name in error message. Fri Mar 17 13:16:53 1995 Boris Goldowsky * format.el: New file. * loadup.el: Load format.el. * enriched.el: Some keybindings adjusted for new function names. (enriched-auto-save-interval, enriched-downcase-annotations, enriched-code-face, enriched-indenatation-face, enriched-ignored-ok, enriched-encode-interesting-regexp, enriched-decode-special-alist, enriched-decode-interesting-regexp, enriched-encode-special-alist, enriched-translated, enriched-ignored-list, enriched-open-ans, enriched-encode-hard-newline, enriched-decode-hard-newline, enriched-push, enriched-pop, enriched-which-assoc, enriched-get-face-attribute, enriched-overlays-overlapping, enriched-show-codes, enriched-show-margin-codes, enriched-show-region-as-code, enriched-nogrow-hook, enriched-warn, enriched-looking-at-with-props, enriched-search-forward-with-props, enriched-search-backward-with-props, enriched-text-properties-include, enriched-tag-indentation, enriched-open-annotation, enriched-close-annotation, enriched-annotate-function, enriched-delete-indentation, enriched-move-to-next-property-change): Deleted. (enriched-delq-1, enriched-make-list-uniq, enriched-make-relatively-unique, enriched-common-tail, enriched-reorder, enriched-insert-annotations, enriched-loc-annotations, enriched-annotate-change, enriched-encode-unknown): Moved to format.el. Names changed. (enriched-display-table): Copy standard table if there is one, otherwise create new table. (enriched-par-props): Don't include front-sticky. (enriched-initial-annotation): Made it closer to MIME standard. (enriched-file-width): Use new header format. (enriched-remove-header): New fn. (enriched-par-props, enriched-initial-annotation, enriched-annotation-format, enriched-annotation-regexp): Declare as const. (enriched-translations): Name changed from enriched-annotation-alist. `hard' removed from list. Description of its semantics moved to format.el. (enriched-list-valued-properties): Deleted, now `format-list-valued' property holds this information. (enriched-annotation-name, enriched-annotation-positive-p): Merged into enriched-next-annotation. (enriched-mode): Do not translate buffer. This should be done already when mode is called. Do not set write-region-annotate-functions or after-change-functions hooks. Put text/enriched on buffer-file-format if necessary. Don't set auto-save-interval. Do set default-properties. (enriched-insert-indentation): Do nothing to blank lines. (enriched-encode, enriched-decode): New fns are rewritten versions of enriched-encode-region and enriched-decode-region. Much of the complexity moved to format.el. (enriched-next-annotation): Name changed from enriched-move-to-next-annotation. Efficiency & clarity improvements. Return value changed to agree with format-deannotate-region. Fri Mar 17 12:37:30 1995 Richard Stallman * rmail.el (rmail-unix-mail-delimiter): Accept <...> around address in Unix `From ' line. Thu Mar 16 18:28:06 1995 Richard Stallman * isearch.el (isearch-abort): Set isearch-success to nil. * vms-patch.el (make-auto-save-file-name, auto-save-file-name-p): Doc fixes. Thu Mar 16 17:23:57 1995 Boris Goldowsky * indent.el (indent-line-to): move to end of indentation, even if it didn't change. Thu Mar 16 15:22:01 1995 Karl Heuer * ediff.el: Installed new version from author. * ediff-diff.el, ediff-init.el, ediff-merg.el: New files. * ediff-util.el, ediff-wind.el: New files. * menu-bar.el (menu-bar-file-menu): Changed "Emerge" to "Merge" to agree with the new ediff package. * frame.el (other-frame): Don't try to unfocus in a termcap frame. (frame-notice-user-settings): Skip menu-bar code in a termcap frame. (frame-initialize): Set frame-creation-function to `make-terminal-frame' if appropriate. * loadup.el: Use appropriate `fboundp' tests to decide what to load. Thu Mar 16 13:47:19 1995 Richard Stallman * simple.el (line-move): Handle conses in buffer-invisibility-spec. Handle skipping invisible overlays. Wed Mar 15 23:32:49 1995 Richard Stallman * allout.el (outline-layout): Doc fix. * edebug.el: Minor doc fixes. Wed Mar 15 17:20:26 1995 Per Bothner * term.el (term-mouse-paste): Make work for xemacs-19.11. For GNU emacs, don't mouse-set-point, but do run-hooks on mouse-leave-buffer-hook, * term.el (term-char-mode): Fix paren error that caused the arrow keys to not be recognized under xemacs. Also, simplify/fix [(button2)] to [button2] for paste under xemacs. Wed Mar 15 18:15:07 1995 Richard Stallman * debug.el (debugger-outer-overriding-local-map): New variable. (debug): Bind overriding-local-map to nil; save old value in debugger-outer-overriding-local-map and restore at end. (debugger-eval-expression): Handle overriding-local-map like other magic variables. Wed Mar 15 09:10:01 1995 enami tsugutomo * window.el (balance-windows): Ignore minibuffer window when browsing the `levels'. Wed Mar 15 18:02:55 1995 Richard Stallman * c-mode.el (c-style-alist): For BSD, set c-continued-brace-offset instead of c-brace-offset. Wed Mar 15 16:29:02 1995 Karl Heuer * mouse.el (mouse-major-mode-menu): Avoid confusing error message when there's no current local map. Wed Mar 15 00:30:41 1995 Torbjvrn Axelsson * options.el (edit-options): Make the buffer read-only. (Edit-options-modify): Cope with that. Wed Mar 15 09:47:22 1995 Karl Fogel * bookmark.el: (bookmark-bmenu-2-window): go to correct position as well as correct buffer. (bookmark-bmenu-other-window): same. (bookmark-bmenu-switch-other-window): same. Mon Mar 13 22:45:15 1995 Karl Fogel * bookmark.el: Removed C-v bindings; they were inconsistent. Defvarred some variables to nil, solely to avoid compilation warnings. Use "Author's Update Number:" instead of "Version:". (bookmark-history): new var. (bookmark-completing-read): use `bookmark-history'. (bookmark-maybe-historicize-string): new macro. Use this everywhere `bookmark-completing-read' is used, because `completing-read' won't get a chance to add to `bookmark-history' if we were invoked via a menu. (bookmark-rename): use `bookmark-history' when reading the new name. No need for the strange C-o binding anymore. Mon Mar 13 00:24:40 1995 Richard Stallman * fill.el (adaptive-fill-regexp): Skip # or ;. Allow more than one of them (or *'s or >'s). * telnet.el (rsh): Name the buffer *rsh-HOST*. * c-mode.el (c-mode): Make comment-multi-line t locally. Sun Mar 12 02:38:04 1995 Richard Stallman * simple.el (block-comment-start, block-comment-end): New vars. (indent-for-comment): Handle them. * ielm.el (ielm): Use pop-to-buffer. (same-window-buffer-names): Add *ielm*. * telnet.el (rsh, telnet): Use pop-to-buffer. (same-window-regexps): Add elt to match *telnet-...* and *rsh...* with or without at end. * info.el (same-window-buffer-names): Set this only in loaddefs.el, not when info.el is loaded. * rlogin.el (rlogin): Use pop-to-buffer. (same-window-regexps): Add elt to match *rlogin-...* with or without at end. * hexl.el (hexl-mode-old-local-map, hexl-mode-old-mode-name) (hexl-mode-old-major-mode): Add defvars. * shell.el (shell): Use pop-to-buffer. (same-window-buffer-names): Add *shell* to the list. * auto-show.el: New file. Unconditionally add to comint-output-filter-functions. (auto-show-mode): Command renamed from auto-show-toggle. Handle an arg in the standard way. (auto-show-mode): Variable renamed from auto-show-enable. * rnewspost.el (news-reply-mode-map): Add menu bar menus. * rmail.el (rmail-duplicate-message): New function. (rmail-list-to-menu): Bind `command' with let. Sat Mar 11 14:11:58 1995 Richard Stallman * server.el (server-buffer-done): Return a list (NEXT-BUFFER KILLED). KILLED is t if we killed the buffer. (server-edit): Values from server-done is now list of args for server-switch-buffer. (server-switch-buffer): Likewise. * simple.el (completion-setup-function): Set completion-base-size. Sat Mar 11 11:30:13 1995 Karl Fogel * bookmark.el (bookmark-buffer-name): Be smarter about deducing a name. (bookmark-insert-buffer-name): Use bookmark-buffer-name. Replaces bookmark-insert-current-file-name. (bookmark-make-cell): Fix previous change. Fri Mar 10 21:08:29 1995 Richard Stallman * info.el (Info-menu): Bind beg with let. * tmm.el: New file. * lmenu.el (add-menu-item-1): Better error message if a menu not the last in the path does not exist. * rmail.el (rmail-retry-failure): Don't get errors when searching for `End of returned message'. * vc.el (vc-path): Use /usr/sccs only if it is a dir. * bookmark.el (bookmark-make-cell): Use set-text-properties, not format, to clear text properties. Fri Mar 10 19:53:15 1995 Karl Fogel * bookmark.el: Insure that all entry points call `bookmark-maybe-load-default-file'. Changed format of bookmark-alist and therefore of bookmark files. Have version stamps in bookmark files. Automatically upgrade old bookmark files to new format. Changed name of default bookmark file to ".emacs.bmk". Replaced "Bookmark-menu" with "bookmark-bmenu". The capitalization signified nothing; "bmenu" means "buffer-menu" -- that is, bmenu code is for the dired-like of bookmarks that appears when `list-bookmarks' is run, and the "bookmark-menu" prefix is for the menu-bar. Internally, use an alist instead of hardcoded list-positions for storing bookmark information. Applied 's patches for annotation support: (bookmark-send-annotation, bookmark-read-annotation-mode) (bookmark-edit-annotation-mode, bookmark-default-annotation-text) (bookmark-read-annotation-text-func, bookmark-read-annotation) (bookmark-send-edited-annotation, bookmark-edit-annotation): New functions. (bookmark-get-bookmark, bookmark-get-bookmark-record) (bookmark-name-from-full-record, bookmark-set-name) (bookmark-get-annotation, bookmark-set-annotation) (bookmark-get-info-node, bookmark-set-info-node) (bookmark-get-filename, bookmark-set-filename) (bookmark-get-position, bookmark-set-position) (bookmark-get-front-context-string, bookmark-set-front-context-string) (bookmark-get-rear-context-string, bookmark-set-rear-context-string): New subroutines. (bookmark-file-format-version, bookmark-end-of-version-stamp-marker): New variables. (bookmark-grok-file-format-version, bookmark-maybe-upgrade-file-format) (bookmark-upgrade-version-0-alist, bookmark-upgrade-file-format-from-0) (bookmark-insert-file-format-version-stamp): New functions. (bookmark-maybe-load-default-file): Renamed from bookmark-try-default-file'. (bookmark-old-default-file): New variable. (bookmark-default-file): Renamed from `bookmark-file'. New initial value, ".emacs.bmk". (bookmark-make-cell): Use backquote. Produce with the new format (Format Version 1). Use `format' to strip text-properties. (bookmark-write-file): Use `pp' instead of `princ'. Call `bookmark-insert-file-format-version-stamp'. (bookmark-all-names, bookmark-menu-popup-paned-bookmark-menu) (bookmark-menu-build-paned-menu, bookmark-menu-popup-paned-menu) (bookmark-insert-location): New functions. (bookmark-completing-read): New function. Everyone who called `completing-read' in the interactive spec now calls this. (bookmark-load-hook): New hook. (bookmark-make-menu-alist): Function deleted. (bookmark-popup-menu-and-apply-function): replaces `bookmark-make-menu-with-function'. (bookmark-load): Use `bookmark-alist-from-buffer'. Call `bookmark-maybe-upgrade-file-format'. (bookmark-set): If Info mode, record Info-current-node. Use `bookmark-bmenu-surreptitiously-rebuild-list'. (bookmark-buffer-file-name): Handle Info files. (bookmark-buffer-name): If Info mode, return Info-current-node. (bookmark-jump-noselect): For info node, use Info-goto-node. Use the helper functions, don't mess with the raw alist (except in completion, which we'll take care of later). Don't count on `bookmark-search-size' being correct; use the length of `forward-str' and `behind-str' instead. (bookmark-relocate): Use the helper functions; don't mess with the raw alist except in completion. (bookmark-rename): C-o in minibuffer now inserts old name. (bookmark-delete): New arg BATCH. (bookmark-bmenu-execute-deletions): Was `bookmark-bmenu-execute'. Just call bookmark-delete with the BATCH arg. Set the modification count and maybe save when done. Save point intuitively. (bookmark-insert-current-file-name): Just use `file-name-nondirectory'. (bookmark-location): Made non-interactive. (bookmark-bmenu-list): Replaces `list-bookmarks'. Delete arg ANNOTATION. Use mapcar to simplify. If not interactive-p, then use `set-buffer' instead of `switch-to-buffer'. (bookmark-kill-line): New function, used instead of kill-line. (bookmark-search-size): Init to 16 instead of 500. Fri Mar 10 00:54:08 1995 Richard Stallman * dired-aux.el (dired-do-print): Allow lpr-switches to be a string. Clean up. Thu Mar 9 22:19:34 1995 Richard Stallman * simple.el (line-move-ignore-invisible): New variable. (line-move): If that var is set, use vertical-motion. Skip any extra invis chars beyond where vertical-motion stops. Tue Mar 7 21:19:36 1995 Richard Stallman * files.el (revert-buffer): Doc fix. * hexl.el (hexl-mode): Make after-revert-hook rehexlify. (hexl-after-revert-hook): New function. * perl-mode.el (calculate-perl-indent): When backing up over continuations, don't go to line beg; perl-backward-to-start-of-continued-exp gives the right place. Tue Mar 7 13:07:23 1995 Enami Tsugutomo * simple.el (indent-new-comment-line): Clean up handling of \(...\) in comment-start-skip. Tue Mar 7 16:43:51 1995 Per Bothner * term.el (term-eol-on-send): New variable. (term-send-input): Move point to eol before sending only if term-eol-on-send is true. * term.el (term-send-input): Don't move process-mark until after possible 'history processing. Tue Mar 7 16:06:10 1995 Francesco Potorti` (pot@cnuce.cnr.it) * cmacexp.el (c-macro-expansion): put the unique string before the first #line directive (instead of after), preceded by a newline. Mon Mar 6 10:51:32 1995 Roland McGrath * find-dired.el (find-ls-option): Doc fix: now a cons. (find-dired): Initialize the process-mark for the filter to use. Find listing switches in cdr of find-ls-option. (find-dired-filter): Use dired-insert-set-properties on new text. * compile.el (compilation-buffer-p): Fix braino in last change: switch to the buffer first. (compilation-error-regexp-alist): Doc fix: optional cdrs give string containing %s to produce the file name from the matched text. (compilation-find-file): Reorder args: MARKER first, then FILENAME, DIR, and new arg &rest FORMATS (as they appear in parsed the fileinfo lists). Try each of the FORMATS in each directory tried. (compilation-next-error-locus): Apply compilation-find-file to the FILEINFO list. (compilation-parse-errors): Instead of a cons (DIR . FILE), make a list (FILE DIR [FORMATS...]) using the 4th cdr of the matching elt of regexp-alist. Mon Mar 6 00:17:48 1995 Richard Stallman * menu-bar.el (menu-bar-help-menu): Binding for view-emacs-FAQ. Sun Mar 5 23:30:29 1995 Richard Stallman * help.el (view-emacs-FAQ): New function. Bind to C-h F. (help-for-help): Doc fix. * info.el (info): Use pop-to-buffer. (same-window-buffer-names): Add "*info*". Fri Mar 3 14:02:58 1995 Robert J. Chassell * texinfmt.el (texinfo-format-refill): Don't confuse a title underline with 2 or more `*' with an xref line starting with one `*'. Fri Mar 3 01:46:52 1995 Richard Stallman * simple.el (shell-command-on-region): Obey REPLACE even if OUTPUT-BUFFER is nil. Interactively, make REPLACE non-nil only if there is a prefix arg. Thu Mar 2 14:36:28 1995 Richard Stallman * files.el (kill-emacs-query-functions): Doc fix. Thu Mar 2 10:22:30 1995 Boris Goldowsky * ada.el (ada-mode): Remove "^" used as anchor from paragraph-start and paragraph-separate values, so that they will work with non-0 left-margin settings. * allout.el (outline-mode): Likewise. * awk-mode.el (awk-mode): Likewise. * bibtex.el (bibtex-mode): Likewise. * c-mode.el (c-mode, c-fill-paragraph): Likewise. * cc-mode.el (c-common-init, c-fill-paragraph): Likewise. * cplus-md.el (c++-mode): Likewise. * edt.el (edt-indent-or-fill-region): Likewise. * gnus-uu.el (gnus-uu-post-reply-mode): Likewise. * icon.el (icon-mode): Likewise. * mh-comp.el (mh-letter-mode): Likewise. * mim-mode.el (mim-mode): Likewise. * modula2.el (modula-2-mode): Likewise. * nroff-mode.el (nroff-mode): Likewise. * options.el (Edit-options-mode): Likewise. * outline.el (outline-mode): Likewise. * perl-mode.el (perl-mode): Likewise. * prolog.el (prolog-mode-variables): Likewise. * rnewspost.el (news-reply-mode): Likewise. * scheme.el (scheme-mode-variables): Likewise. * scribe.el (scribe-mode): Likewise. * sendmail.el (mail-mode): Likewise. * simula.el (simula-mode): Likewise. * texinfmt.el (texinfo-format-refill): Likewise. * texinfo.el (texinfo-mode): Likewise. * tex-mode.el (tex-common-initialization,latex-mode,slitex-mode): Likewise. * text-mode.el (indented-text-mode): Likewise. * vc.el (vc-comment-to-change-log): Likewise. Thu Mar 2 05:58:37 1995 Simon Marshall * font-lock.el (font-lock-maximum-decoration) New variable. (font-lock-after-fontify-buffer-hook): New variable. (font-lock-fontify-buffer): Run it after fontifying. (font-lock-thing-lock-cleanup): New function to turn things off. (font-lock-mode): Call it when turning Font Lock mode off. (font-lock-fontify-region): Fix to use forward-comment from comment-start, rather than searching for comment-end from point. * ada.el, ada-mode.el (ada-font-lock-keywords): Use font-lock-maximum-decoration. * fortran.el, f90.el (fortran-font-lock-keywords): Use font-lock-maximum-decoration. Thu Mar 2 03:33:39 1995 Richard Stallman * gud.el (gud-massage-args): Variable and function deleted. (gud-common-init): Don't set the variable. Thu Mar 2 15:11:02 1995 Boris Goldowsky * simple.el (newline): Moved from cmds.c. Indents last inserted line to left-margin. * paragraphs.el (paragraph-start, paragraph-separate): Default values no longer start with ^. Doc fix. (use-hard-newlines): Moved here from cmds.c. Made buffer-local. Doc fix. (looking-at-hard): Deleted, not needed. (forward-paragraph): Removes ^ from beginning of regexps, if required. Look for paragraph-start and paragraph-separate at left-margin, not BOL. Lines with just left-margin indentation are treated like blank lines. Paragraph-separate no longer requires a preceding hard newline, but paragraph-start does: paragraph-separates usually won't occur by accident, so it doesn't hurt to respect them whenever they do occur. Wed Mar 1 03:27:15 1995 Richard Stallman * vc.el (vc-do-command): Search vc-path first, not last. * tar-mode.el (tar-grind-file-mode): Doc fix. Tue Feb 28 22:06:57 1995 Karl Heuer * simple.el (shell-command-on-region): Fix typos in doc string. (universal-argument, describe-arg): Deleted; this is now in C code. (prefix-arg-internal, digit-argument, negative-argument): Likewise. Tue Feb 28 12:54:01 1995 Richard Stallman * gud.el (gud-common-init): Put substed file name back in original sequence in the args. Pass ARGS to massage-file even if no file name. (gud-gdb-massage-args, gud-sdb-massage-args, gud-dbx-massage-args) (gud-mipsdbx-massage-args, gud-xdb-massage-args) (gud-perldb-massage-args): Don't add FILE onto the args. * simple.el (shell-command-on-region): Rename arg; doc fix. * server.el (server-switch-buffer): New optional arg KILLED-ONE. Avoid the other-buffer at the end in that case. Tue Feb 28 04:07:48 1995 Noah Friedman * rlogin.el (rlogin-carriage-filter): Don't assume buffer is narrowed to region with most recent output. Tue Feb 28 01:18:20 1995 Karl Heuer * files.el (revert-buffer): Use current-prefix-arg, not prefix-arg. * terminal.el (te-escape): Likewise. Mon Feb 27 03:05:44 1995 Simon Marshall * dired.el (dired-internal-noselect): Use substitute-command-keys to get binding of revert-buffer. Sun Feb 26 16:37:37 1995 Roland McGrath * compile.el (compilation-buffer-p): Check for compilation-minor-mode or compilation-mode major mode, rather than internal state variables. Don't want to match a buffer that was once in compilation-minor-mode but is not now. Sun Feb 26 15:00:54 1995 Richard Stallman * info.el (Info-extract-menu-node-name): Collapse multiple spaces. * tar-mode.el (tar-mode-show-date): New variable. (tar-header-block-summarize, tar-next-line): Obey it. Sun Feb 26 23:07:09 1995 Greg McGary * tar-mode.el (tar-header-block-tokenize): Parse 32-bit modtime current-time compatible a list of 16-bit ints (HIGH LOW). (tar-parse-octal-integer): Write char-const '0' as ?0 instead of more obscure 48. (tar-parse-octal-long-integer): New function. (tar-clip-time-string): New function. (tar-header-block-summarize, tar-header-block-summarize): Insert mod-time into listing. (tar-next-line): Move goal column to new location of filenames. Sat Feb 25 18:26:30 1995 Richard Stallman * mouse.el (mouse-kill-secondary): Avoid changing this-command. Don't clear the secondary selection. Sat Feb 25 10:23:45 1995 Simon Marshall * comint.el (comint-truncate-buffer): New function. (comint-buffer-maximum-size): New variable. * shell.el (shell-truncate-buffer): Doc them. * comint.el (comint-dynamic-complete-as-filename): Let file-name-handler-alist to nil; comint-file-name-prefix does this. (comint-dynamic-list-filename-completions): Likewise. (comint-dynamic-complete-filename, comint-dynamic-complete-as-filename): Use window-minibuffer-p. Sat Feb 25 02:29:45 1995 Richard Stallman * cplus-md.el (c++-backward-to-noncomment): Don't loop forever if first line of buffer starts with ` #'. * subr.el (walk-windows): Doc fix. Fri Feb 24 23:55:54 1995 Karl Heuer * subr.el (local-unset-key): Fix args in previous change. Fri Feb 24 13:54:41 1995 Richard Stallman * subr.el (global_set_key, local_set_key, global_unset_key) (local_unset_key): Functions moved here from keyboard.c. Fri Feb 24 07:35:36 1995 Lars Lindberg * msb.el (msb): Select the window that the mouse is in before showing the menu. This makes the "Most recently used" menu more accurate. (menu-bar-update-buffers): The frame list is now an integrated part of the buffer menu. (msb--few-menus, msb--very-many-menus): Added rmail-edit-mode. * msb.el (mouse-select-buffer): Do sit-for before x-popup-menu. Thu Feb 23 19:01:46 1995 Richard Stallman * lisp-mode.el (eval-defun): Convert defvar to defconst. * loaddefs.el (function-key-map): Use vector in definition of C-delete. * rmail.el (rmail-retry-failure): Support a new style of failure msg. Tue Feb 21 14:49:58 EST 1995 Boris Goldowsky * fill.el (set-fill-prefix): Sets it to the text between left-margin and point, not the whole line before point. (fill-region-as-paragraph): Set `from' to the beginning and `to' to the end immediately, for clarity. This used to be done after the save-restriction. Newlines at end of region used to be changed to spaces, then deleted. Now delete them (all but one) explicitly, so that we can test whether they are hard and not delete hard newlines. Ignore all whitespace at beginning of region: a line containing spaces before first line of text used to be joined onto first line of text, making spurious paragraph indentation. If there is only whitespace in the region, exit quickly (fixed possible infinite-loop condition). Moved the loop that just indents when justification=none inside the save-restriction. It's a little simpler that way. When deleting indentation and fill-prefixes from lines, delete any whitespace after the fill-prefix too. Always exit with point at end of region, after a single paragraph-final newline. (fill-region): Don't use paragraph-movement commands in use-hard-newlines mode; just fill between each pair of hard newlines. Old strategy of setting paragraph-start to "^" doesn't work, since paragraph-start no longer no longer need occur at BOL. (current-justification): Don't look for text-props at EOB: there are none. (set-justification): New arg WHOLE-PAR controls whether to trust begin and end args in noninteractive use, or extend to limits of paragraphs. Don't use "^" in paragraph-start regexp. Ignore fill-prefix when searching for enclosing paragraph with use-hard-newlines true. Squeeze spaces from regions that used to be full-justified. Remove leftover debugging code. (set-justification-{none,left,right,full,center}): Use WHOLE-PAR arg of set-justification. Interactive spec changed to avoid errors when there is no region. (justify-current-line): Error if JUSTIFY value is not one of the meaningful symbols (used to do full justification in this case); change interactive spec to explicitly request full justification. Don't need to save-restriction & narrow (except for full-justify). Explicitly remember beginning position, so that we can move it to after indentation if that is appropriate. Save a few more useful quantities; add documentation of variables used. Do nothing if there is no text on the line. Notice adaptive-fill fill-prefixes too. Center or flushright indentation is put between fill-prefix and text; can't use standard line-indent function for this. If centering, do so between left and right margins. Warning messages ("line too long") removed; they were annoying in auto-fill-mode. (unjustify-current-line, unjustify-region): New functions. * indent.el (indent-line-to): Don't need `let'. (current-left-margin): Don't look for text-props at EOB. (move-to-left-margin): Always move to left-margin, even in centered or right-justified regions. New arg FORCE to add indentation or convert tabs to spaces if necessary. FORCE is the interactive default; it used to be available only interactively. (indent-to-left-margin): Doc fix. (delete-to-left-margin): Use move-to-left-margin. Doc fix. Make arguments optional. (set-left-margin): Make region include following spaces and tabs, so that later insertions there will inherit new setting. Always reindent text to show new setting, not only when auto-fill is active; auto-fill controls only whether to re-fill text. (set-left-margin, increase-left-margin): Use indent-rigidly to change indentation level. (set-left-margin, set-right-margin, increase-left-margin): Save point when calling fill-region. (increase-left-margin): left-margin property can be negative, for outdenting, up to the value of the left-margin variable. (increase-right-margin): right-margin property can be arbitrarily negative. Negative values can't be stored in text/enriched format, but that doesn't mean we shouldn't allow it in general. (beginning-of-line-text): New function. * simple.el (open-line): Indent to left-margin any lines that you would consider inserting a fill-prefix on. (do-auto-fill): Use unjustify-current-line. (indent-new-comment-line): Indent to left-margin before inserting fill-prefix. * facemenu.el (facemenu-justification-menu): "Unfilled" now bound to set-justification-none; fn changed name. Thu Feb 23 00:00:49 1995 Richard Stallman * perl-mode.el (perl-tab-to-comment): Default is nil. * loadup.el: Load version.el early on. * simple.el (shell-command-on-region): When computing interactive args, read the minibuffer arg first, then get the region bounds. Tue Feb 21 17:50:41 1995 Michael Kifer * viper-ex.el (ex-find-file): now gives an error when a wild card gives no match. (ex-next): now recognizes counts and puts proper commands in ex-command-history. (vip-info-on-file, ex-substitute): bug fixed. Tue Feb 21 07:47:38 1995 Simon Marshall * shell.el (shell-cd): New function. (shell-process-cd, shell-process-pushd, shell-process-popd, shell-resync-dirs): Use it instead of cd. (shell-mode): Make list-buffers-directory local with value default-directory. * mouse.el (mouse-buffer-menu): Use list-buffers-directory if non-nil if buffer-file-name is nil. Mon Feb 20 19:00:56 1995 Karl Heuer * viper.el, viper-ex.el, viper-util.el: New files. * viper-keym.el, viper-macs.el, viper-mous.el: New files. Mon Feb 20 05:50:44 1995 Simon Marshall * fortran.el (fortran-mode): Made fortran-font-lock-keywords turn off syntactic fontification by default. Mon Feb 20 04:39:48 1995 Roland McGrath * vc.el (vc-log-info): Don't switch to the *vc* buffer before running vc-do-command, because that would change its default-directory. Sun Feb 19 15:04:06 1995 Richard Stallman * rnewspost.el: Various doc fixes. (news-post-news): Add autoload cookie. Sat Feb 18 14:40:49 1995 Richard Stallman * mouse.el (mouse-buffer-menu): Don't clear selection when we kill it. * subr.el (eval-after-load): Run FORM now if FILE's already loaded. * imenu.el (imenu--cleanup): Set alist to its default just once, at the beginning. Don't recurse on a cdr which is nil. Fri Feb 17 18:21:54 1995 Richard Stallman * simple.el (quoted-insert): Use insert-and-inherit. Don't change buffer if arg is negative. * tex-mode.el (tex-append): Try splitting on last period, then try splitting on first period. * desktop.el (desktop-internal-v2s): Don't use format to eliminate text properties. Fri Feb 17 13:31:23 1995 Karl Heuer * mailabbrev.el (mail-abbrev-mode-regexp): Doc fix. Fri Feb 17 03:59:35 1995 Richard Stallman * rmailsum.el (rmail-summary-mail, rmail-summary-continue) (rmail-summary-reply, rmail-summary-retry-failure) (rmail-summary-forward, rmail-summary-resend): Switch to rmail buffer's window first, so mail buffer replaces summary. Thu Feb 16 00:56:51 1995 Richard Stallman * buff-menu.el (Buffer-menu-save): Fix the test for header line. Wed Feb 15 03:34:54 1995 Richard Stallman * info.el (Info-index): Bind Info-history, not Info-keep-history. Tue Feb 14 09:47:41 1995 Boris Goldowsky * facemenu.el (facemenu-self-insert-face): If previous self-insert-face is still valid, add to rather than replace it. (facemenu-loc): Variable deleted. Tue Feb 14 01:20:35 1995 Richard Stallman * ehelp.el (electric-help-help, electric-help-command-loop): Mention q and r, not Q and R. * sort.el (sort-regexp-fields-next-record): New subroutine. If the first search does not advance point and finds an empty match, skip one char and search again. (sort-regexp-fields): Use that subroutine. Bind sort-regexp-fields-regexp, for sort-regexp-fields-next-record. (sort-regexp-fields-regexp): Declared. (sort-regexp-record-end): Declared. Mon Feb 13 11:38:23 1995 Jeff Dwork * ehelp.el (electric-help-map): Use supress-keymap instead of filling keymap with undefined commands. Bind R like r. Substitute electric-command-apropos for command-apropos. (electric-apropos): New function. (electric-help-help, electric-help-command-loop): Mention Q and R in messages. Mon Feb 13 22:11:48 1995 Jim Thompson * ps-print.el (ps-print-version): Add caveat about version number. (ps-begin-file): Fix format code for /LineHeight. Mon Feb 13 03:42:17 1995 Richard Stallman * files.el (auto-mode-alist): Fix problem in previous change. * pp.el (pp-to-string): Fix previous change. * debug.el (debugger-step-after-exit): Variable declared. (debugger-old-buffer, debugger-value): Variables declared. * facemenu.el (facemenu-next): Variable deleted. (facemenu-self-insert-face): New function. (facemenu-set-face): Use facemenu-self-insert-face. (facemenu-set-face-from-menu): Likewise. (facemenu-after-change): Function deleted. Don't use it as hook. * debug.el (debug): Fix arg to backtrace-debug for debug-on-entry. Sun Feb 12 03:25:02 1995 Richard Stallman * pp.el (pp-to-string): Don't use emacs-lisp-mode. Just do the parts of it we actually want. * simple.el (next-history-element): Do nothing if n is 0. Handle errors properly when history list is empty. Sat Feb 11 19:15:37 1995 Richard Stallman * menu-bar.el (menu-bar-kill-ring-save): New function--use as `copy'. (delete-region): Don't enable if (mouse-region-match) is true. * mouse.el (mouse-drag-region): Delete the overlay before calling the terminating event's command binding or making a region. (mouse-set-region-1): New function. (mouse-drag-region, mouse-set-region, mouse-save-then-kill): Call it. (mouse-region-match): New function. * ange-ftp.el (ange-ftp-write-region, ange-ftp-insert-file-contents) (ange-ftp-copy-file-internal): If remote host is unix, use binary mode. (ange-ftp-file-local-copy): Delete local var bin1. (ange-ftp-rename-remote-to-remote): Delete arg `binary'. (ange-ftp-rename-file): Don't pass or compute that arg. Fri Feb 10 01:28:06 1995 Richard Stallman * files.el (auto-mode-alist): Add .cpp, .cxx, .hxx, .c++, .h++. * sendmail.el (mail-reply-to): New command, on C-c C-f C-r and in menu. * c-mode.el (c-switch-label-regexp): Insist on colon after `default'. * sendmail.el (mail-do-fcc): Find buffer to add to using truename, if can't find it by real name. * files.el (recover-file): Use ordinary `f' to read file name. Thu Feb 9 01:34:25 1995 Richard Stallman * rmail.el (rmail): Don't set rmail-default-file here. (rmail-default-file): Init it to ~/xmail. (rmail-default-rmail-file): Don't call expand-file-name. * dired.el (dired-mark): If on dir header line, always mark the files in that dir. * lpr.el (print-region-1): Include print options in echo area msgs. Wed Feb 8 18:46:26 1995 Richard Stallman * ada.el (ada-mode): Delete autoload. * ada-mode.el: New file. Add autoload cookie. (ada-mode-map): Don't define C-m, M-a, M-e, M-q. Don't define M-q. (ada-mode): Set fill-paragraph-function locally. (ada-fill-comment-paragraph): Return t. (ada-gen-make-bodyfile): Add missing backslash. Wed Feb 8 08:00:33 1995 Simon Marshall * comint.el (comint-match-partial-filename): Include `%' char. Wed Feb 8 01:03:55 1995 Ken Stevens * ispell.el: Personal dictionary save forced when called from menu, Epoch compile support. (ispell-skip-sgml): Added variable for skipping SGML tags & references. (ispell-buffer-local-parsing): Hard wire set of ispell-skip-sgml-tags to sgml-mode. (ispell-pdict-save): Message improvement. (ispell-command-loop): Properly adjust screen with different settings of ispell-choices-win-default-height. (check-ispell-version): Use fundamental-mode as default-major-mode. (ispell-change-dictionary): Remove unnecessary process kills (ispell-region): Fold sgml support in with tib checking. (ispell-message): Skips checking of forwarded messages. Tue Feb 7 19:38:25 1995 Karl Heuer * novice.el (disabled-command-hook): Recognize ESC x as well as M-x. * edmacro.el (edmacro-format-keys): Don't presume internal bit layout of non-ASCII keys. (edmacro-parse-keys): Likewise. * terminal.el (te-pass-through): Likewise. * subr.el (listify-key-sequence-1, event-modifiers): Likewise. * edt.el: New enhanced version. * edt-lk201.el, edt-mapper.el, edt-pc.el, edt-vt100.el: New files. * bytecomp.el (byte-compile-file-form-defmumble, display-call-tree): Print ellipsis earlier, so message logging will fold similar strings. (byte-compile-file): Add "done" message. Tue Feb 7 17:46:00 1995 Richard Stallman * ps-print.el (ps-print-thompson-version): Renamed from ps-print-version. Tue Feb 7 16:52:44 1995 Karl Heuer * subr.el (read-quoted-char): Don't log prompt messages. Use M- notation instead of assuming internal layout. Tue Feb 7 02:59:59 1995 Richard Stallman * term.el (term-protocol-version): Renamed from term-version. Mon Feb 6 17:34:55 1995 G Dinesh Dutt (brat@htilbom.ernet.in) * etags.el (etags-file-of-tag): Handle file name used as tag. Sat Feb 4 16:23:18 1995 Per Bothner * term.el (term-version): Increased to 0.95. (term-pager-enabled): New macro. Use it a bunch of places. (term-terminal-menu): Clean up initialization so we don't get complaints when re-loading term.el. (term-send-raw-meta): Redo to handle meta-symbols (e.g. meta-delete). More robust checking of parameter to make-string. (term-update-mode-line): New function. Call it whenever we change char/line/paging mode. Now includes "page" in mode-line-process if paging is abled. * term.el: Remove causes for byte-compilation to complain: (term-terminal-pos): Declare x and y in let-binding. (term-send-invisible): Remove bogus second "iteractive" call. (term-*): Provide defvars for lots of buffer-local variables. (term-mode): Make comments and initial value setting from here to the corresponding defvar. (term-line-start-column): Remove unused variable. (term-erase-in-line): Fix syntax (incorrect parenthesis) error. (term-erase-in-display): Fix typo "\?n" -> "?\n". * term.el: Make Unix "resize" command work: (term-handle-ansi-escape): On "\e[row;colH", limit row and col to size of window. (Resize sends "999;999".) (term-handle-ansi-escape): Implement "\e[6n" "Report cursor position". This requires that we pass proc as an extra parameter. (term-scroll-region): An empty region means extend to window bottom. Sun Feb 5 22:28:19 1995 Richard Stallman * lpr.el (lpr-add-switches): Renamed from lpr-add-options. (print-region-new-buffer): Return new start and end. (print-region-1): Use new calling convention. Sun Feb 5 19:09:36 1995 Jim Blandy * texinfo.el (texinfo-environment-regexp): Match @menu and @titlepage --- they require @ends. Don't match @defunx commands; they don't. (texinfo-insert-@end): Don't put a command name after the @end if we ran off the top of the buffer looking for its mate. Sat Feb 4 21:16:57 1995 Richard Stallman * rmail.el (rmail-next-same-subject): New command. (rmail-previous-same-subject): Likewise. (rmail-mode-map): Add bindings for C-c C-n and C-c C-p. * rmailsum.el (rmail-summary-next-same-subject): New command. (rmail-summary-previous-same-subject): Likewise. (rmail-summary-mode-map): Add bindings for C-c C-n and C-c C-p. Sat Feb 4 15:34:55 1995 G Dinesh Dutt (brat@htilbom.ernet.in) * etags.el : Changes to support filenames as tags too and provided a drop-in replacement for list-tags. (find-tag-noselect): Recognize filenames as valid tags too. (find-tag-file-order): New variable holds function to check for match for a file name used as a tag. (last-tag-file): New variable; stores the filename looked for via find-tag family of functions. (find-tag-in-order): If the tag is a file name, position at file beg. (etags-recognize-tags-table): Added new var find-tag-file-order to tags-table-format variables. Added tag-filename-match-p to the list for find-tag-tag-order. (tag-filename-match-p): New function. (list-tags): Rewritten for speed. (tags-list-functions-in-file): New subroutine for list-tags. (tags-locate-file-in-tags-table): New function locates a file in `tags-table-list'. Fri Feb 3 14:27:50 1995 Richard Stallman * lpr.el (print-region-1): If we run pr, give it the -h option instead of giving lpr the -T option. * dired.el (dired-mode-map): Define up and down arrows like C-p, C-n. * f90.el (f90-mode-version): Variable deleted. (f90-mode): Don't use f90-mode-version. * ps-print.el: Add autoload cookies. (ps-paper-type): Doc fix. * lpr.el (print-region-1): Use lpr-page-header-switches, not ...-options. Fri Feb 3 12:59:14 1995 Francesco Potorti` (pot@cnuce.cnr.it) * man.el (Man-default-man-entry): Remove text properties from result. Thu Feb 2 23:20:29 1995 Karl Heuer * rmail.el (rmail-reply-regexp): New var. (rmail-reply): Delete text matching rmail-reply-regexp. Thu Feb 2 14:27:55 1995 Richard Stallman * completion.el: Don't use cl. Eliminate use of when, unless, dotimes, plusp, minusp, pusnhew, second. (completion-dolist): New macro. Use instead of dolist. (completion-gensym-counter, completion-gensym): New variable and fn. (locate-completion-entry-retry): Bind cmpl-entry, then use it. (locate-completion-entry): Use completion-string, not string. (add-completion-to-head, delete-completion): Rename arg to completion-string. (completions-list-return-value): Defvar'd and renamed from return-completions. (cmpl-preceding-syntax, cdabbrev-stop-point): Add defvars. (delete-completion, check-completion-length): Fix message format. (complete, add-completions-from-buffer, add-completions-from-c-buffer) (save-completions-to-file): Likewise. (completion-string): Add defvar. * lpr.el (lpr-headers-switches): Default is nil. * fill.el (fill-paragraph): Bind fill-paragraph-function to nil before calling it. * dabbrev.el (dabbrev-abbrev-char-regexp): Default value is nil again. Thu Feb 2 04:37:25 1995 Richard Stallman * c-mode.el (c-mode-map): No binding for c-fill-paragraph (c-fill-paragraph): Return t. (c-mode): Put c-fill-paragraph in fill-paragraph-function. * lisp-mode.el (shared-lisp-mode-map): Don't bind M-q. (lisp-fill-paragraph): Return t. (lisp-mode-variables): Put that in fill-paragraph-function locally. * fill.el (fill-paragraph-function): New variable. (fill-paragraph): Use it. Wed Feb 1 15:23:17 1995 Noah Friedman * sendmail.el (mail-mailer-swallows-blank-line): Handle full range of RFC822-legal header names. Wed Feb 1 00:46:57 1995 Richard Stallman * help.el (describe-variable): If var is local, mention default. * rmail.el (rmail-retry-failure): Handle "Mime-encapsulated messages". Discard return-path and from headers as well as sender. Tue Jan 31 01:24:18 1995 Richard Stallman * f90.el: New file. Mon Jan 30 17:36:37 1995 Karl Heuer * iso-acc.el (iso-accents-list): Add Icelandic thorn. * iso-transl.el (iso-transl-language-alist): Add French & Portuguese. (iso-transl-char-map): Use /a /e ~d "s ~t digraphs as in iso-acc.el. * frame.el (frame-notice-user-settings): Avoid having the window manager re-prompt for the initial frame's clone. * faces.el (x-create-frame-with-faces): Assume cursor-color, mouse-color, and border-color are okay as specified unless they are the same as the new background color. Mon Jan 30 01:14:18 1995 Richard Stallman * simple.el (indent-new-comment-line): Obey the convention about \(...\) pairs in comment-start-skip. * lucid.el (make-extent, delete-extent, set-extent-property) (set-extent-face): New functions. * desktop.el: Many doc fixes. Sun Jan 29 04:29:51 1995 Richard Stallman * buff-menu.el (list-buffers-noselect): Handle read-only properly. Select each buffer just once to get all necessary info about it. * buff-menu.el (list-buffers-noselect): New subroutine. (list-buffers): Use that. (buffer-menu): Switch to the buffer in the same window. (buffer-menu-other-window): New command. (Buffer-menu-select): Just change the current window. * rnewspost.el (news-reply-mode): Change mode-name to News Reply. * lisp-mode.el (lisp-indent-region): Set endmark before indenting first line. (indent-sexp): Fixes for ENDPOS != nil case--use nil as starting-point, and don't insist on a complete sexp. Sat Jan 28 03:26:43 1995 Richard Stallman * subr.el (match-string): Fix braino. * faces.el (facep): New function. (internal-check-face): Don't make a loop, since signal can't return. Fri Jan 27 16:57:15 1995 Richard Stallman * frame.el (make-frame): Doc fix. * help.el (describe-variable): Use local-variable-p. * debug.el (debug-convert-byte-code): Convert the doc info to a string. * shell.el (shell): If we create a new shell buffer, select that buffer even if it has been renamed. * faces.el (x-resolve-font-name): Better error messages. Fri Jan 27 13:58:24 1995 Karl Heuer * subr.el (match-string): Delete extra arg to buffer-substring. * replace.el (perform-replace): Don't log the repetitive prompts. Fri Jan 27 02:05:53 1995 Richard Stallman * lucid.el (read-number): New function. * tex-mode.el (tex-display-shell): Pass nil as arg to tex-recenter-output-buffer. (tex-region, tex-file, tex-show-print-queue, tex-bibtex-file): Put the call to tex-display-shell essentially last. * menu-bar.el (menu-bar-update-yank-menu): If string is too long, show start and end, with ... between them. (yank-menu-length): Default value 20. * subr.el (match-string): New function. Thu Jan 26 01:52:53 1995 Richard Stallman * mouse.el (mouse-save-then-kill): When we don't use existing region, put where click and put mark at the other end. Use point-before-scroll if non-nil. Recognize mouse-set-region as a previous command that makes a region we should use. (mouse-drag-region): When we run the final click's binding, set this-command. * scroll-bar.el (scroll-bar-drag-1): Set point-before-scroll properly. (scroll-bar-scroll-down, scroll-bar-scroll-up): Likewise. Wed Jan 25 00:36:14 1995 Richard Stallman * mouse.el (mouse-save-then-kill): Ignore mouse-selection-click-count if no active mark. (mouse-drag-region): Modify previous change--don't run the ordinary binding in the case of a multiple click. * tex-mode.el (tex-display-shell): New function. (tex-file, tex-region, tex-show-print-queue, tex-bibtex-file): Use that instead of tex-display-shell. Tue Jan 24 17:42:47 1995 Richard Stallman * fill.el (justify-current-line): Avoid error comparing fill-prefix near end of buffer. Do nothing fast if justification not wanted. * bytecpat.el: Renamed from bytecomp1.el. Tue Jan 24 10:21:19 1994 G Dinesh Dutt (brat@htilbom.ernet.in) * etags.el : Changes to support filenames as tags too and provided a drop-in replacement for list-tags. (find-tag-noselect): recognize filenames as valid tags too. (find-tag-file-order): new variable added. This contains the name of the function used to qualify a matched filename. (last-tag-file): new variable; stores the filename looked for via find-tag fmaily of functions. (find-tag-in-order): In case tag searched for is a file, don't do anything fancy to locate position of tag in file. Just seek to beginning of file. (etags-recognize-tags-table): Added new var find-tag-file-order to tags-table-format variables and also set the priority of searching for tag type to make it look for a filetype tag first. (tag-filename-match-p): New function added to qualify naive match for a filename tag. (list-tags): Replaced with contents with one performing better for this function. (tags-list-functions-in-file): New function which is a backend for list-tags function. (tags-locate-file-in-tags-table): New function which locates a file in `tags-table-list'. Its used by list-tags. Tue Jan 24 09:29:13 1995 Frederic Lepied * gnus.el: Added support for descriptions in the group buffer: (gnus-group-prepare, gnus-group-prepare-line, gnus-setup-news) (gnus-gnus-to-quick-newsrc-format, gnus-group-list-groups): Record if we show all groups, to redisplay correctly after toggling descriptions display. (gnus-newsgroups-display-toggle, gnus-newsgroups-update-description) (gnus-newsgroups-retrieve-description): New functions. (gnus-group-mode-map): Bind t to gnus-newsgroups-display-toggle. Add a newsgroups-update-description menu. (gnus-newsgroups-regex, gnus-newsgroups-display, gnus-newsgroups-alist) (gnus-newsgroups-hashtb, gnus-newsgroups-showall): New variables. (gnus-group-group-name): Changed the regexp to avoid conflict with descriptions which have a ':' inside. (gnus-group-mode): Doc fix. Mon Jan 23 23:44:06 1995 Richard Stallman * c-mode.el (c-forward-conditional): If an apparent conditional is not really a conditional, skip past it. Mon Jan 23 17:36:42 1995 Karl Heuer * iso-transl.el (iso-transl-dead-key-alist): New var. (iso-transl-char-map): Give each singleton a doubleton synonym. (iso-transl-language-alist, iso-transl-ctl-x-8-map): New vars. (iso-transl-define-keys): New function; sets up keymap. (iso-transl-set-language): New function; sets language-specific part. * simple.el (mark): If transient-mark-mode is nil, mark is active. Mon Jan 23 14:42:25 1995 Espen Skoglund * pascal.el: (pascal-*-completion, pascal-comp-defun) (pascal-complete-word, pascal-completion-response, pascal-completion) (pascal-get-completion-decl): Rename some internal variables to start with 'pascal-'. (pascal-str, pascal-all, pascal-pred, pascal-flag) (pascal-buffer-to use): New dummy variables. Sun Jan 22 04:50:39 1995 Richard Stallman * vc.el (vc-do-command): Arrange for the default-directory variable in *vc* to be re-set each time this function uses it. Discard current dir from front of FILE later on, and only if last = `WORKFILE'. * vc.el: Undo Dec 10 change: (vc-directory, vc-dired-reformat-line): Changed back. (vc-directory-18): Old function restored. (vc-dir-all-files): Function deleted. * vc.el (vc-next-action-on-file): If file is not registered, check file out after registering it. (vc-next-action-dired): Restore the window configuration after doing vc-next-action on each file in a VC-dired buffer. (file-regular-p-18): New function. (file-regular-p): Define, if not already defined. * iso-transl.el (iso-transl-char-map): Add elements for mute-acute, etc. * gud.el (gud-mode): Use gud-new-keymap, so inherit keymaps.. * font-lock.el (font-lock-fontify-region): Bind inhibit-read-only. Also buffer-file-name. (font-lock-hack-keywords, font-lock-unfontify-region): Likewise. Sat Jan 21 19:51:21 1995 Richard Stallman * c-mode.el (c-fill-paragraph): If comment terminator is on a separate line, don't include that line in the filling. * bytecomp.el (byte-compile-defvar): Add the var to current-load-list. Sat Jan 21 18:04:00 1994 David K}gedal * tempo.el (tempo-insert-template): Quoted transient-mark-mode Expansion around region now puts point at the first mark. * tempo.el (tempo-region-start, tempo-region-stop): New variables (tempo-insert-template, tempo-insert): Don't affect the mark. Check for Transient Mark mode * tempo.el (tempo-find-match-string): Removed the stupid 1+ again * tempo.el (tempo-use-tag-list): Set tempo-match-finder to completion-function * tempo.el (tempo-match-finder): Renamed variable from tempo-default-match-finder. Change the value too. (tempo-collection, tempo-dirty-collection): New variables. (tempo-user-elements): New variable. (tempo-insert): New argument ON-REGION. New elements 'l and 'r. Use tempo-is-user-element. (tempo-is-user-element): New function. (tempo-invalidate-collection, tempo-build-collection): New functions. (tempo-find-match-string): Reinserted bugfix for re-search-backward. (tempo-complete-tag): Complete rewrite. * tempo.el (tempo-insert): Added the 'o tag. Sat Jan 21 14:07:31 1995 Per Bothner * term.el (term-version): Increased to 0.94. (term-if-emacs19, term-if-xemacs, term-ifnot-xemacs): New macros to conditionalize at compile-time for different emacs versions. (various places): Use them (instead of term-is-XXXX). (term-is-emacs19): Removed, no longer needed. * term.el: Change keybindings to not use C-c LETTER, for term-char-mode, term-line-mode. Keybindings for term-pager-enable and term-pager-disable replaced by one for term-pager-toggle. (term-pager-toggle): New function. * term.el (term-fake-pager-enable, term-fake-pager-disable): Define as aliases, so that menubar code will find proper keybindings. (term-char-mode): Make no-op if already in char mode. (term-line-mode): Make no-op if already in line mode. (term-mode-map): Add keybinding for no-op term-line-mode, so code to display menubar keybindings doesn't lose it. (Needed as long as char-mode and line-mode share term-terminal-menu.) (term-raw-escape-map): Likewise for term-char-mode. (term-char-mode, term-line-mode): Better documentation strings. * term.el: Added menubar for pager sub-mode. * term.el (term-command-hook): Disabled the feature that allowed inferior to send a lisp command to emacs - too big a security hole. Sat Jan 21 08:59:15 1995 Roland McGrath * upd-copyr.el (update-copyright): Remove gratuitous error at end. Fri Jan 20 18:04:28 1995 Richard Stallman * loadhist.el (unload-feature): Don't care if FILE is a dependency of itself. * fill.el (fill-region-as-paragraph): At end, advance over any newlines that were in the region but excluded from filling. Fri Jan 20 14:11:25 1995 Karl Heuer * text-mode.el (center-line): fill-column is a var, not a function. Fri Jan 20 00:28:15 1995 Morten Welinder * compile.el (compile-internal): Force redisplay on compilation buffer before executing compile process. Fri Jan 20 01:18:42 1995 Richard Stallman * ps-print.el: New file. Thu Jan 19 22:19:59 1995 Karl Heuer * c-mode.el (set-c-style): Ignore case in completion. Thu Jan 19 21:28:03 1995 Richard Stallman * rmailsum.el (rmail-summary-update-highlight): New function. (rmail-summary-goto-msg): Use it. (rmail-summary-rmail-update): Move the summary highlight. (rmail-summary-mark-deleted): Do nothing if rmail-summary-overlay has a nil face-property. (rmail-new-summary): Make the summary-on-top kludge more restricted in when it is used. Thu Jan 19 17:23:53 1995 Karl Heuer * paths.el (remote-shell-program): Reorder search path. Wed Jan 18 17:11:11 1995 Richard Stallman * fill.el (current-justification): Renamed from current-justification. Callers changed. (fill-region-as-paragraph): left-margin renamed to current-left-margin. * indent.el (move-to-left-margin): justification renamed to current-justification. * simple.el (do-auto-fill): justification renamed to current-justification. * ispell.el (check-ispell-version): Use Fundamental mode in the temporary buffer. * calendar.el: Use byte-compile-dynamic. Wed Jan 18 16:57:14 1995 Roland McGrath * etags.el (etags-file-of-tag): Use a regexp search to find the file name, allowing it to contain any char but a newline. Wed Jan 18 15:56:39 1995 Boris Goldowsky * indent.el (standard-indent): New variable. (alter-text-property, current-left-margin, move-to-left-margin) (delete-to-left-margin, set-left-margin, set-right-margin) (increase-left-margin, decrease-left-margin, increase-right-margin) (decrease-right-margin, indent-line-to): New functions. (indent-to-left-margin): Use indent-line-to. Don't delete or insert anything unless necessary. * fill.el (set-justification): New function. (set-justification-{none,left,right,full,center}): New functions. (fill-region-as-paragraph, fill-region, justify-current-line): New arg NOSQUEEZE defeats normal removal of extra whitespace. (fill-region-as-paragraph, fill-region) (fill-nonuniform-paragraphs, fill-individual-paragraphs): Arg JUSTIFY-FLAG (JUSTIFYP) renamed to JUSTIFY. (fill-region-as-paragraph): Obey left-margin; fill-prefix starts after left-margin. Disable filling if JUSTIFY == none, but indent to margin anyway. Adaptive-fill removes text-props from fill-prefixes it finds. Adaptive-fill no longer has to notice left-margin: std fill does that. Use fill-column and canonically-space-region functions. (canonically-space-region): New fn split from fill-region-as-paragraph. (fill-region): New args NOSQUEEZE (as above) and TO-EOP. (default-justification): New variable. (current-left-margin, fill-column, justification): New functions. (fill-paragraph): Use fill-region-as-paragraph when possible. (justify-current-line): New arguments; different kinds of justification handled. Uses left-margin and fill-column functions. * paragraphs.el (forward-paragraph): Fix end-of-buffer bug. * completion.el (completion-separator-self-insert-autofilling): Don't check fill-column; do-auto-fill will do that. * simple.el (do-auto-fill): Fill, don't fill, or fill-and-justify depending on setting of justification text-property. Respect left-margin and right-margin text properties. (open-line, indent-new-comment-line): Inherit when inserting. (newline-and-indent, reindent-then-newline-and-indent): Doc fix. * text-mode.el (center-line): Use current-left-margin function. * enriched.el (enriched-annotation-list): Property `hard-newline' renamed to `hard'. Justification value `both' renamed `full'. (enriched-mode): Don't set auto-fill-function, fill-column, sentence-end-double-space. Do set use-hard-newlines. (enriched-delete-indentation): Use delete-to-left-margin and canonically-space-region. (enriched-indent-increment): Deleted, use `standard-indent' instead. (enriched-insert-hard-newline): Deleted, use `newline'. (enriched-beginning-of-line): Deleted, use `move-to-left-margin'. (enriched-squeeze-spaces): Deleted, use canonically-space-region. (enriched-forward-paragraph, enriched-backward-paragraph) (enriched-open-line, enriched-fill-paragraph, enriched-fill-region) (enriched-fill-region-as-paragraph, enriched-auto-fill-function) (enriched-justify-line): Deleted, use standard versions. (enriched-region-pars, enriched-end-of-paragraph, enriched-unindent) (enriched-beginning-of-paragraph, enriched-move-to-fill-column) (enriched-line-length, enriched-indent-line, enriched-indent) (enriched-aggressive-auto-fill-function, enriched-hard-newline) (enriched-indent-right, enriched-unindent-right): Deleted. (enriched-show-codes, enriched-show-margin-codes) (enriched-show-region-as-code, enriched-nogrow-hook): Commented out. (enriched-left-margin, enriched-change-left-margin) (enriched-change-right-margin, enriched-set-left-margin) (enriched-set-right-margin): Moved to indent.el as current-left-margin, increase-left/right-margin, set-left-/right-margin. (enriched-default-justification, enriched-justification) (enriched-set-justification-*, enriched-fill-column): Moved to fill.el as default-justification, current-justification, set-justification-*, current-fill-column. (enriched-indentation-menu-map, enriched-justification-menu-map): Moved to facemenu.el as facemenu-indentation-menu, facemenu-justification-menu. * facemenu.el (facemenu-keybindings, facemenu-face-menu): Keybinding for bold-italic changed from M-g o to M-g l; M-g o is now "other". (facemenu-justification-menu, facemenu-indentation-menu): New submenus, moved from enriched.el (list-colors-display, facemenu-color-equal): New functions. (facemenu-menu): Added "Display Faces" item. (facemenu-new-faces-at-end): New variable. (facemenu-add-new-face): Obey facemenu-new-faces-at-end. (facemenu-menu, facemenu-keymap, facemenu-face-menu) (facemenu-foreground-menu, facemenu-background-menu) (facemenu-special-menu): Now have function definitions as prefix keys. (facemenu-menu, facemenu-update): Refer to submenus by their names rather than including their values. (facemenu-set-face): Error if read-only; add item to menu if necessary. (facemenu-get-face): Always return FACE. (facemenu-add-new-face): Don't add if facemenu-unlisted-faces is t. (facemenu-unlisted-faces): Doc fix. * facemenu.el: Revise keybindings; doc fix. (facemenu-new-faces-at-end): New vbl. (facemenu-add-new-face): Use it. (facemenu-set-face, facemenu-set-face-from-menu): Check read-only. (facemenu-set-face): Doc fix. * facemenu.el (facemenu-face-menu, facemenu-foreground-menu, facemenu-background-menu, facemenu-special-menu): New or renamed variables for submenus. (facemenu-color-alist): Renamed from facemenu-colors. (facemenu-add-new-face): New function. (facemenu-update): Don't redo top-level menu; nothing should change. Move menu setup to defvars. Use facemenu-add-new-face. Changed global binding to C-down-mouse-3. (facemenu-menu): "Update" item removed; should no longer be needed interactively. (facemenu-complete-face-list): Just return faces, not keybindings. Wed Jan 18 14:41:12 1995 Karl Heuer * ispell.el (check-ispell-version): Force standard syntax table. * paths.el (remote-shell-program): New var. * telnet.el (rsh): Use it. * rcompile.el (remote-compile): Likewise. * ange-ftp.el (ange-ftp-gateway-program): Likewise. (ange-ftp-shell-command): Likewise. Wed Jan 18 02:56:21 1995 Richard Stallman * gud.el (gdb): In gud-remove, specify the source file. Tue Jan 17 23:54:59 1995 Richard Stallman * gud.el (gud-new-keymap): New function. (gud-xdb-find-file, gud-dbx-find-file, gud-sdb-find-file, gud-gdb-find-file): Use it for keymap inheritance. Tue Jan 17 20:50:39 1995 Dave Love * gud.el (gud-gdb-find-file): Propagate debug menu to found buffers. (gud-dbx-find-file, gud-xdb-find-file, gud-sdb-find-file, gud-perldb-find-file): Likewise. (gud-menu-map): New variable. (gud-mode): Use gud-menu-map and move the menu-setting outside. * gud.el (dbx): Fix missing cast of $curline for Irix. (gud-irixdbx-marker-filter): Make $curline cast consistent with the others. Tue Jan 17 05:34:53 1995 Simon Marshall * comint.el (comint-dynamic-list-completions): Test event-start to make sure it is not a complex event (e.g., switch-frame). Tue Jan 17 00:35:28 1995 Richard Stallman * help.el (help-for-help): Doc fix. * help-macro.el (make-help-screen): Use *only* local-map to look up keys. Mon Jan 16 17:54:53 1995 Karl Heuer * edebug.el (edebug-enter): Fix reversed setq's. * calendar.el (calendar): Doc fix. * disp-table.el (standard-display-ascii): Doc fix. Allow use with X. * iso-cvt.el (iso-aggressive-german-trans-tab): Doc fix. (iso-cvt-ffh, iso-cvt-wfh, iso-cvt-ash): Doc fix. Mon Jan 16 18:27:50 1994 Espen Skoglund * pascal.el (pascal-mode-map, pascal-outline-map): C-c C-b now inserts block. C-c C-d does goto-defun. `#' calls on electric-pascal-hash. (pascal-calculate-indent, pascal-indent-alist) (electric-pascal-tab, pascal-indent-case): Better handling of indent within case. Support for CPP. The `;' in the last statement of a subblock may be omitted. (electric-pascal-hash): New function. Mon Jan 16 00:45:52 1995 Richard Stallman * vc.el: Revert Jan 15 and Jan 5 changes. * scribe.el (scribe-mode): Treat @: as a sentence end. Sun Jan 15 20:12:53 1995 Richard Stallman * dabbrev.el (dabbrev--find-all-expansions): Don't use push. (dabbrev--search): Likewise. Sun Jan 15 04:43:40 1995 Roland McGrath * vc.el (vc-do-command): Use set-buffer-modified-p instead of not-modified. * files.el (not-modified): Doc fix. * etags.el (etags-tags-completion-table): Don't let match string contain a \177. Fri Jan 13 22:10:18 1995 Karl Heuer * vc.el (vc-directory): Prompt for a directory, not a file. Thu Jan 12 19:35:03 1995 Karl Heuer * edebug.el: Undo Nov 30 change. (edebug-emacs-19-specific): Don't use quote; easy-menu-define doesn't evaluate its first arg. * easymenu.el (easy-menu-define): Doc fix. Thu Jan 12 15:53:22 1994 Boris Goldowsky * paragraphs.el (forward-paragraph): Notice use-hard-newlines value. (looking-at-hard): New function. (paragraph-start, paragraph-separate): Doc fix. * simple.el (open-line, split-line, next-line): Use `newline' function to insert newline so it will be marked hard if appropriate. (indent-new-comment-line): Use `newline' function, unless called with (new) argument. (do-auto-fill): Call indent-new-comment-line with argument to make newline soft. * fill.el (fill-region-as-paragraph): Don't modify newline at end of paragraph, to make sure text-properties are preserved. (fill-paragraph): Call fill-region, not fill-region-as-paragraph, to avoid clobbering paragraph-internal hard-newlines. (fill-region): If use-hard-newlines is on, divide into "paragraphs" by breaking at every hard newline, temporarily ignoring paragraph-start. Thu Jan 12 10:36:13 1994 Tom Tromey * buff-menu.el (list-buffers): New function. (ctl-x-map): Define C-x C-b to list-buffers. Thu Jan 12 00:42:39 1995 Richard Stallman * files.el (revert-buffer): Recompute buffer-file-truename. * c-mode.el (indent-c-exp): Handle `{ if (x)\n foo;\n bar;' case. * cplus-md.el (indent-c++-exp): Handle `{ if (x)\n foo;\n bar;' case. * etags.el (etags-goto-tag-location): Add 1 to char positions in TAGS. * startup.el (command-line-1): Handle -f with kbd macro. * msb.el (mouse-select-buffer) Handle an aborted selection. Wed Jan 11 12:27:27 1995 Richard Stallman * derived.el (define-derived-mode): Doc fix. Tue Jan 10 23:43:34 1995 Richard Stallman * term/x-win.el: Put height and width from geometry parm into default-frame-alist. Tue Jan 10 21:22:32 1995 Karl Heuer * isearch.el (isearch-edit-string): Disable message logging. (isearch-toggle-case-fold, isearch-message): Likewise. Tue Jan 10 20:28:01 1995 Richard Stallman * dired.el (dired-insert-directory): Don't call expand-file-name when dir-or-list is a list. Tue Jan 10 17:31:01 1995 Noah Friedman * rlogin.el (rlogin-tab-or-complete): Insert tab in buffer, don't send directly to process. (rlogin, rlogin-directory-tracking-mode): Use rlogin-remote-user, not rlogin-user. Tue Jan 10 12:37:54 1995 Richard Stallman * faces.el (face-nontrivial-p): New function. * paren.el (show-paren-command-hook): Don't alter paren-mismatch face if make-face gives it some contents. Tue Jan 10 12:25:50 1995 Simon Marshall * shell.el (shell-mode): Doc fix. Tue Jan 10 01:23:54 1995 Richard Stallman * dabbrev.el (dabbrev-check-other-buffers): Renamed from dabbrev-always-check-other-buffers. (dabbrev-check-all-buffers): Renamed frm dabbrev-check-rest-of-buffers. * ange-ftp.el (ange-ftp-set-buffer-mode): Don't set make-backup-files. (ange-ftp-real-find-backup-file-name): New function. (ange-ftp-find-backup-file-name): New function. Use it to handle find-backup-file-name. * files.el (find-backup-file-name): Run a file name handler. (backup-buffer): Do nothing if backup-info is nil. Mon Jan 9 23:58:03 1995 Noah Friedman * rlogin.el: Removed several more gratuitous autoload cookies. (rlogin-initially-track-cwd): Variable deleted. (rlogin-directory-tracking-mode): New variable and function. Default to 'local. (rlogin-host, rlogin-remote-user): New variables. (rlogin): Set them appropriately. (rlogin-tab-or-complete): New function. Bind C-i to it. (rlogin-carriage-filter): New function. (rlogin): Add it to comint-output-filter-functions. (rlogin-parse-words): New function. (rlogin): Make buffer name "*rlogin-USER@HOST* if remote user differs from local. Simplify initialization of local variables, using rlogin-parse-words. Do not call comint-mode directly. Doc fixes. Mon Jan 9 18:09:46 1995 Karl Heuer * bytecomp.el: Fix text punctuation. Mon Jan 9 04:46:59 1995 Richard Stallman * faces.el (face-try-color-list): Treat `underline' as valid. * subr.el (listify-key-sequence-1): Update for change in CHAR_META. * dabbrev.el (dabbrev-expand): Now checks for marker. (dabbrev--try-find): Now does a protected call to `widen'. (dabbrev-always-check-other-buffers): Default now t. (dabbrev--capitalize): Function deleted. (dabbrev-completion): Use `capitalize'. * msb.el Better format of files-by-directory menus. Now splits big menus into sub-menus. (msb-max-menu-items): Changed default value. This variable now depicts the maximum number of items in a sub-menu. (msb-display-most-recently-used): Changed default value. (mouse-select-buffer): Now handles several levels of sub-menus. New format on return value. Sun Jan 8 14:36:11 1995 Richard Stallman * find-file.el: New file. Fri Jan 6 15:48:24 1995 Richard Stallman * mouse.el (mouse-drag-region): As once in the past, call the binding of the terminating event. * terminal.el (te-terminfo-systems-regexp): Variable deleted. (te-create-terminfo): Use system-uses-terminfo. * simple.el (what-cursor-position): Show char in decimal, hex, octal. Thu Jan 5 15:27:30 1995 Stefan Schoef * bibtex.el (bibtex-clean-entry): Killing text while editing the autogenerated label in the minibuffer caused the killed text to appear in front of the bibtex entry. Thu Jan 5 17:10:48 1995 Eric Raymond * vc.el (vc-do-command): Change RCS handling so rcsdiff won't strip away relative-pathname information. This function no longer sets the default directory. Also, mark the *vc* output buffer unmodified. (vc-revert-buffer1): Handle font-lock mode correctly. (vc-diff, vc-print-log): vc-do-command no longer sets the default directory, but doing so is advantageous for these cases. (file-executable-p-18): Better portability to Emacs 18. (vc-directory-exclusion-list, vc-file-tree-walk-internal): Implement the new variable vc-directory-exclusion-list to prune tree walks. Initial value tells it to ignore SCCS and RCS subdirectories. Thu Jan 5 15:32:51 1995 Ken Laprade * simple.el (pop-global-mark): Make pop-global-mark treat global-mark-ring as a ring. Thu Jan 5 07:01:33 1995 Johan Vromans * forms.el: Change forms-search to forms-search-forward, and add forms-search-backward. (forms--mode-menu-ro, forms--mode-menu-edit): New functions to create a pulldown menu in the menubar. (forms--mode-commands): Call them for the edit and view mode. * (forms-print): New function. Wed Jan 4 17:32:32 1995 Stephen Gildea * tex-mode.el (tex-print): Better check for when to print current buffer's file over last processed file. Tue Jan 3 17:12:48 1995 Noah Friedman * sendmail.el (mail-personal-alias-file): New variable. Use globally in place of hardwired "~/.mailrc". * mailalias.el: Here too. * mailabbrev.el (mail-abbrev-mailrc-file): Variable and macro deleted. All callers now use `mail-personal-alias-file'. * pp.el: Add autoload cookies. Tue Jan 3 01:39:54 1995 Richard Stallman * tex-mode.el (tex-mode): Recognize \NeedsTeXFormat{LaTeX2e}. * startup.el (command-line-1): Pause between init file error and command line option processing. * spell.el (spell-filter): Make it a risky-local-variable. Mon Jan 2 18:01:07 1995 Richard Stallman * gud.el (gud-sdb-marker-filter): Use gud-marker-acc. * time.el (display-time-string-forms): Fix doc string syntax error. Mon Jan 2 13:03:23 1994 Kevin J. Greiner * gud.el (gud-dbx-marker-filter): Use gud-marker-acc like gud-gdb-marker-filter. Sat Dec 31 00:11:30 1994 Richard Stallman * files.el (auto-mode-alist): Add entries for .cls files, and for /drafts/. Put tex-mode and latex-mode in lower case. * files.el (set-visited-file-name): Error if buffer is indirect. (basic-save-buffer): For indirect buffer, save the base buffer. (save-some-buffers): Ignore indirect buffers. Fri Dec 30 15:47:30 1994 Richard Stallman * tex-mode.el (tex-mode): \begin at start of file implies Latex. * terminal.el (terminal-emulator): Test system-configuration to decide on terminfo vs termcap. (te-terminfo-systems-regexp): Renamed from te-terminfo-systems. Fri Dec 30 14:55:27 1994 Kishore Kumar (kishorek@tulblr.unisys.com) * terminal.el: Added terminfo support. (te-terminal-name-prefix, te-terminal-name, te-terminfo-systems): New variables. (terminal-emulator): Handle termcap or terminfo. (te-create-terminfo, te-create-termcap): New subroutines. (te-tic-sentinel): New subroutine. Thu Dec 29 13:52:13 1994 Richard Stallman * simple.el (completion-list-mode-map): Don't bind return, just C-m. Wed Dec 28 20:47:21 1994 Richard Stallman * apropos.el (super-apropos-check-elc-file): New function. specifies which file to search. (apropos-files-scanned): New variable. (super-apropos): Bind apropos-files-scanned. Update apropos-accumulate from apropos-print-matches. Call super-apropos-accumulate before checking for no matches. (super-apropos-check-doc-file): Don't visit the file, just insert it. (super-apropos-accumulate): When doc string is in a file, scan that file. (apropos-print-matches): Return the sorted list. (safe-documentation): Handle compiled files. Wed Dec 28 03:12:30 1994 Roland McGrath * etags.el (find-tag-in-order): Don't set buffer-local value of tags-file-name. Tue Dec 27 15:13:57 1994 Richard Stallman * tex-mode.el (tex-mode-map): Add BibTeX File menu item. * subr.el (run-hook-with-args-until-failure): Return non-nil if no hook functions. Mon Dec 26 00:06:09 1994 Richard Stallman * startup.el (command-line-1): Split startup msg into two parts. Add something about C-mouse-3 when on a window system. * tar-mode.el (tar-mode-map): Bind C-m to tar-extract. * replace.el (occur-mode-map): Bind C-m to occur-mode-goto-occurrence. (occur-mode): Doc fix. * compile.el (compilation-minor-mode-map): Bind C-m to compilation-goto-error. * buff-menu.el (Buffer-menu-mode-map): Bind C-m to Buffer-menu-this-window. * dired.el (dired-mode-map): Bind C-m to dired-advertised-find-file. Change f to dired-find-file. * simple.el (switch-to-completions): New command, with bindings in the minibuffer completion maps. * simple.el (next-completion, previous-completion): New commands. (completion-list-mode-map): Put them on left, right arrows. * isearch.el (isearch-mode): Set mouse-leave-buffer-hook. (isearch-done): Clear it. Sun Dec 25 09:27:20 1994 Richard Stallman * mouse.el (mouse-minibuffer-check, mouse-drag-mode-line) (mouse-yank-at-click, mouse-yank-secondary, mouse-choose-completion): Run mouse-leave-buffer-hook. * bytecomp.el (byte-compile-warning-types): Add obsolete. (byte-compile-warnings): Doc fix. (byte-compile-obsolete): Check for obsolete in byte-compile-warnings. (byte-compile-variable-ref): Likewise. * timezone.el (timezone-fix-time): For year values < 50, add 2000. * server.el (server-process-filter): Process each line separately. (server-buffer-done): Delete dead buffers from CLIENT list. Wait a while after sending a command to emacsclient. Verify that BUFFER is a buffer. * subr.el (font-lock-defaults): Add defvar. (buffer-file-type): Add defvar. * simple.el (completion-reference-buffer): Initialize to nil. * dabbrev.el (esc-map): Delete excess closeparen. * apropos.el (super-apropos, super-apropos-check-doc-file) (super-apropos-accumulate): Vars item, fn-doc and var-doc renamed to apropos-item, apropos-fn-doc and apropos-var-doc. (apropos-item, apropos-var-doc, apropos-fn-doc) (apropos-accumulate, apropos-regexp): New defvars. (super-apropos): Bind apropos-regexp to regexp. (super-apropos-accumulate): Use apropos-regexp. * ange-ftp.el (ange-ftp-save-match-data): Macro deleted. Most callers use save-match-data. (ange-ftp-process-filter, ange-ftp-process-sentinel) (ange-ftp-gwp-filter): Don't save the match data explicitly. * ange-ftp.el (ange-ftp-process-filter, ange-ftp-gwp-filter): After comint output processing, update STR. Sat Dec 24 10:24:42 1994 Richard Stallman * fast-lock.el: New file. * dabbrev.el (dabbrev-abbrev-char-regexp): Accept symbol chars as well as word constituent chars. * startup.el (command-line-1): If help-command has no key binding, say `M-x help', not `M-x help-command'. * emacs-lock.el: New file. Fri Dec 23 13:04:39 1994 Richard Stallman * msb.el: Fix quoting conventions and spaces at end of sentence. * msb.el: New file. * dabbrev.el (dabbrev-completion): Now searches all buffers when given prefix arg 16. (dabbrev--version): Variable deleted. * dabbrev.el: Don't require cl, picture, or reporter. Don't provide new-dabbrev. (dabbrev--try-find): Don't use `loop'. Don't create or kill local bindings. (dabbrev-completion): Use key-description to say what to type. Fix style of "done" message. (dabbrev-submit-feedback): Function deleted. (dabbrev--same-major-mode-p): Simplify. (dabbrev-completion, dabbrev--abbrev-at-point): Fix error msg style. * dabbrev.el (dabbrev-filter-elements): New macro. (dabbrev--select-buffers, dabbrev--find-expansion): Use that. (dabbrev--search): Use that. * dabbrev.el: Complete rewrite by Lars.Lindberg@sypro.cap.se. Fri Dec 23 18:12:54 1994 Barry Warsaw (bwarsaw@cnri) * elp.el (elp-pack-number): New function. (elp-output-results): Use elp-pack-number to truncate time strings, watching out for very small or very large numbers. * elp.el (elp-unset-master): Make it an interactive command. * reporter.el (reporter-submit-bug-report): Set up for status messages. Use mail-text to position point to the body of the message. * reporter.el (reporter-beautify-list): Complete rewrite. Optional nocompact-p argument. * reporter.el (reporter-dump-variable): Invert the test and passing of compact-p argument to reporter-beautify-list. List values are not printed as defuns or function calls. * reporter.el: Updated package list. * reporter.el (reporter-lisp-indent): New defun. * reporter.el (reporter-dont-compact-list) (reporter-status-message, reporter-status-count): New variables. * reporter.el (reporter-update-status, reporter-beautify-list) reporter-dump-variable): Now smarter about formating variables with list values. Checks the value of reporter-dont-compact-list. Fri Dec 23 12:23:40 1994 Richard Stallman * simple.el (next-line, previous-line): If interactive and not in kbd macro, catch the error and beep instead. Thu Dec 22 22:30:08 1994 Richard Stallman * bibtex.el (bibtex-string, bibtex-preamble): Use forward-line. (sort-subr): Don't call autload for this--that's done in loaddefs.el. (bibtex-mode): Add autoload cookie. * server.el (server-switch-buffer): Cope with dead frames and windows. Thu Dec 22 19:19:25 1994 Dave Love * gud.el (gdb): Correct tbreak doc string. (gud-mode): Define a Gud menu. (gdb): Set debugger-specific menu entries. (sdb) (dbx) (xdb): Likewise. Thu Dec 22 17:52:03 1994 Richard Stallman * novice.el (enable-command): Always insert code to enable. (disable-command): Insert newline before as well as after. Wed Dec 21 12:56:21 1994 David M. Smith * imenu.el (imenu-always-use-completion-buffer-p): A value of `never' now means never display a completion buffer. (imenu--completion-buffer): implement 'never behaviour. Wed Dec 21 15:45:00 1994 Stefan Schoef * bibtex.el: Changed keybinding for bibtex-print-help-message (from \C-ch to \C-c?). Therefore, describe-mode is not longer on \C-c?. Also, changed prefix \C-cn for bibtex-narrow functions to \C-c\C-r. (bibtex-string-files): Changed documentation. (bibtex-mode-map): Inscriptions of menu bar changed from "Entry Types" to "Entry-Types" and "Bibtex Edit" to "BibTeX-Edit". (bibtex-string-files): Changed documentation. (bibtex-mode): If environment variable BIBINPUTS isn't defined, string files are searched in the current directory. (bibtex-completion-candidates): Now buffer-local to allow evaluation of different bibtex-string-files in different buffers. (bibtex-autokey-edit-before-use, bibtex-clean-entry): New variable that determines, if the user is allowed to edit auto-generated reference keys before they are used. (bibtex-generate-autokey, bibtex-clean-entry): New function to generate an autokey if necessary. (bibtex-autokey-names, bibtex-autokey-name-change-strings, bibtex-autokey-name-length, bibtex-autokey-name-separator, bibtex-autokey-year-length, bibtex-autokey-titlewords, bibtex-autokey-title-terminators, bibtex-autokey-titlewords-stretch, bibtex-autokey-titleword-first-ignore, bibtex-autokey-titleword-abbrevs, bibtex-autokey-titleword-change-strings, bibtex-autokey-titleword-length, bibtex-autokey-titleword-separator, bibtex-autokey-name-year-separator, bibtex-autokey-year-title-separator): New variables related to bibtex-generate-autokey. (bibtex-find-entry-location): Optional second parameter maybedup to tell it that entering a duplicate entry isn't to report by an error but by the return value of the function (necessary for bibtex-clean-entry to find the correct position of an entry with an autogenerated key without disturbing the user with unwanted messages). (bibtex-help-message): New variable to avoid printing of help messages in the echo area. (assoc-of-regexp): New function to match an alist of regexps. (bibtex-string-files, bibtex-completion-candidates, bibtex-mode): New variables to allow bibtex-complete-string to work on strings initialized from a variable and from @String definitions in a list of files, too. (bibtex-predefined-strings, bibtex-entry-field-alist): Changed to user options. (bibtex-mode): Changed doc string. (many functions and variables): Changed documentation strings of variables and functions to hold a complete sentence in the first line. (bibtex-print-help-message): Now line dependent and reports if it is called outside a BibTeX field. (validate-bibtex-buffer): Completely rewritten to validate, if buffer is syntactically correct. (find-bibtex-duplicates): Moved into validate-bibtex-buffer. (ispell-abstract, bibtex-ispell-abstract, ispell-bibtex-entry, bibtex-ispell-entry, beginning-of-bibtex-entry, bibtex-beginning-of-entry, end-of-bibtex-entry, bibtex-end-of-entry, hide-bibtex-entry-bodies, bibtex-hide-entry-bodies, narrow-to-bibtex-entry, bibtex-narrow-to-entry, sort-bibtex-entries, bibtex-sort-entries, validate-bibtex-buffer, bibtex-validate-buffer, find-bibtex-entry-location, bibtex-find-entry-location): All interactive functions are renamed, so that any interface function begins with "bibtex-". Mapping: ispell-abstract --> bibtex-ispell-abstract ispell-bibtex-entry --> bibtex-ispell-entry beginning-of-bibtex-entry --> bibtex-beginning-of-entry end-of-bibtex-entry --> bibtex-end-of-entry hide-bibtex-entry-bodies --> bibtex-hide-entry-bodies narrow-to-bibtex-entry --> bibtex-narrow-to-entry sort-bibtex-entries --> bibtex-sort-entries validate-bibtex-buffer --> bibtex-validate-buffer find-bibtex-entry-location --> bibtex-find-entry-location (bibtex-maintain-sorted-entries, bibtex-sort-ignore-string-entries): Default is now t. (bibtex-complete-string): String list is built from additional string list bibtex-predefined-string and current strings in file. (string-equalp): Deleted and substituted by string-equal. (assoc-string-equalp): Renamed to assoc-ignore-case. (bibtex-entry): Reference key can be entered with completion. All reference keys that are defined in buffer and all labels that appear in crossreference entries are object to completion. (Entry types): Changed order of entries in menu "entry types". (bibtex-entry-field-alist): Changed order of entries slightly to be more conform with standard BibTeX style layouts. (bibtex-mode-map): Uniform keybindings for \C-c\C-e prefix (often used types on control keys, sometimes used types on normal keys, rarely used types on shift keys, almost never used types on meta keys). (bibtex-mode-map): Function narrow-to-bibtex-entry and counterpart widen and function hide-bibtex-entry-bodies and counterpart show-all bounded to appropriate local keys. (bibtex-abbrev-table): Deleted (bibtex-current-entry-label, put-string-on-kill-ring): Deleted (AUCTeX provides all the functionality needed for citation completion). (bibtex-enclosing-reference, bibtex-pop-previous, bibtex-pop-next, bibtex-clean-entry): Hacked for speed (bibtex-pop-previous and bibtex-pop-next were to slow for larger BibTeX files). (bibtex-pop-previous, bibtex-pop-next): Delimiters from previous or next entry are changed to actual delimters if necessary. (bibtex-entry): Fixed bug (False entry wasn't reported in error message if bibtex-entry was called with undefined reference name). (bibtex-entry-field-alist, bibtex-entry, bibtex-make-field, bibtex-next-field, bibtex-clean-entry): Every reference entry now contains a comment in addition to the name of the reference. This comment appears in the echo area if you start editing that field (after calling bibtex-next-field). (bibtex-include-OPTcrossref, bibtex-entry): Changed bibtex-include-OPTcrossref from single boolean variable to hold a list of reference names which should have a crossref field. (bibtex-complete-word): New function, which completes word fragment before point to the longest prefix of predefined strings in the buffer in the same way that ispell-complete-word operates for words found in the dictionary. (bibtex-reference-head): Start of bibtex-reference-head changed from "^[ \t]*\\(" to "^\\( \\|\t\\)*\\(" (bibtex-pop-previous and bibtex-pop-next didn't work, probably due to a bug in re-search-forward). (several functions): Added support for {} as field delimiters (better than '"' for accented characters. (bibtex-clean-entry): If optional field crossref is empty or missing, former optional fields (if bibtex-include-OPTcrossref was t) are necessary again. bibtex-clean-entry complains if they are empty but not if they are missing, so you can intenionally omit them, e. g. for a pseudo @Journal entry (needed for crossreferences) made out of an @article with missing non-optional fields. Menu bar entries aren't centered anymore. Wed Dec 21 15:07:58 1994 Richard Stallman * facemenu.el (facemenu-key): Change to M-g. * files.el (save-buffers-kill-emacs): Fix backward test of value of run-hook-with-args-until-failure's value. * tex-mode.el (tex-start-shell): Use inheritance. Wed Dec 21 15:20:15 1994 Dave Love * gud.el (gud-irixdbx-marker-filter): Changes for Irix dbx. (dbx): gud-up, gud-down are now special cases for Irix. Wed Dec 21 11:33:45 1994 Richard Stallman * dired.el (dired-string-replace-match): Function moved here. * dired-aux.el (dired-string-replace-match): Moved to dired.el. Wed Dec 21 10:54:38 1994 Ed Reingold * tex-mode.el (tex-shell-map,tex-start-shell): Start with shell-mode-map. Wed Dec 21 09:35:24 1994 Richard Stallman * help.el (describe-function): Don't add `.el' when printing file name. Tue Dec 20 10:41:02 1994 Richard Stallman * bytecomp.el (byte-compile-dest-file): New variable. (byte-compile-file): Bind that var, early on. (byte-compile-dynamic): New variable. (byte-compile-dynamic-docstrings): New variable. (byte-compile-close-variables): Bind byte-compile-dynamic, byte-compile-dynamic-docstrings, and byte-compiler-compatibility. (byte-compile-file): Call normal-mode, not set-auto-mode. (byte-compile-output-docform): New arguments PREFACE, NAME, SPECINDEX, QUOTED. Callers changed. Output doc strings as references to the .elc file itself, using #@ and #$ constructs. (byte-compile-output-as-comment): New function. * bytecomp.el (byte-compile-insert-header): Don't save-excursion. Insert at point, and move point. Insert extra newline at end. (byte-compile-from-buffer): Insert the header before compilation. * buff-menu.el (Buffer-menu-buffer): Clear text properties in STRING. * faces.el (frame-update-face-colors): New function. * frame.el (set-background-color, set-foreground-color): Call frame-update-face-colors. * rmail.el (rmail-first-unseen-message): Fix 1-off error. Mon Dec 19 14:09:46 1994 Ed Reingold * tex-mode.el (tex-start-shell): Use comint prompt and mode-map. Sun Dec 18 12:39:58 1994 Richard Stallman * rmail.el (rmail-search-backward): Function deleted. (rmail-mode-map): Use rmail-search-backwards instead. Sun Dec 18 14:16:39 1994 Lawrence R. Dodd (dodd@roebling.poly.edu) * fortran.el (fortran-end-if, fortran-end-do, fortran-beginning-if, fortran-beginning-do): New subroutines. (fortran-blink-matching-if, fortran-blink-matching-do): Use them. (fortran-mark-do, fortran-mark-if): New user functions. (fortran-blink-matching-if, fortran-mode): Doc mod. Sun Dec 18 14:59:55 1994 Morten Welinder * tar-mode.el (tar-extract): Don't use set-visited-file-name. to avoid interaction problems with ange-ftp. Fri Dec 16 19:50:24 1994 Richard Stallman * rnewspost.el (news-mail-reply): Restore the saved narrowing before calling `mail'. Thu Dec 15 07:15:27 1994 Richard Stallman * emerge.el (emerge-read-file-name): New arg must-match. (emerge-files, emerge-files-with-ancestor): Pass new arg. * isearch.el (isearch-done): Don't print msg about mark if we don't set it. Fix paren error. * subr.el (lambda): Doc fix. * vc-hooks.el (vc-toggle-read-only): Accept prefix arg and pass it along to vc-next-action. * font-lock.el (font-lock-hack-keywords): Turn off undo generation. (font-lock-unfontify-region. font-lock-fontify-region): Likewise. * c-mode.el (indent-c-exp): Don't be fooled by else_ or while_. (c-indent-line): Likewise. (c-backward-to-start-of-if): Don't be fooled by if_ or else_. * sendmail.el (sendmail-send-it): Don't convert S: to Subject:. * faces.el (face-initialize): Test for framep not t or nil. * files.el (hack-local-variables): Run hack-local-variables-hook. (hack-local-variables-hook): New variable. * find-dired.el (find-grep-options): Use -q on non-BSD systems. Wed Dec 14 14:58:59 1994 Richard Stallman * find-dired.el (find-ls-option): Don't ask for inode numbers. * apropos.el (apropos-match-keys): Handle menu bindings with cached equivalent keys. * rmail.el (rmail-ignored-headers): Delete junk from definition. Tue Dec 13 17:20:12 1994 Don Woods (don@genmagic.com) * replace.el (perform-replace): Report number of replacements when done. (query-replace, query-replace-regexp, replace-string) (map-query-replace-regexp. replace-regexp): No message here. Tue Dec 13 13:40:41 1994 Richard Stallman * informat.el (Info-split): Fix 1-off error in subfile position. * replace.el (occur): Escape newlines when printing regexp. * informat.el (Info-tagify): Avoid 1-off error in position of a tag. * macros.el (insert-kbd-macro): Specially handle C-\, M-\ and C-M-\. Only convert the character syntax if definition is a string. Sun Dec 11 16:22:26 1994 Richard Stallman * rmailsum.el (rmail-summary-goto-msg): When highlighting, don't skip 1st char on line if it isn't a space. * gnusmail.el (gnus-mail-reply-using-mail): Don't save point; yank the original at point. * apropos.el (apropos-match-keys): Handle minor mode maps and overriding-local-map. Sat Dec 10 18:03:42 1994 Richard Stallman * vc.el (vc-dir-all-files): New function. (vc-directory): Show just one directory by default. Read dir name in minibuffer. (vc-directory-18): Deleted. Fri Dec 9 20:59:52 1994 Ken Stevens * ispell.el: Added ispell-offset for version consistency. (ispell-dictionary-alist): updated dictionaries & better match defaults (ispell-alternate-dictionary): added /usr/shar path (ispell-menu-map-needed): redo changes that made this incompatible with earlier versions of emacs19. (ispell-required-version): changed to assure version 3.1.12 accessed. (ispell-word): Correctly accept buffer-local information. Does not try to modify read-only buffer on 'm' command. (ispell-command-loop): fixed bug that corrupted buffers. removed scrolling when *Choices* buffer shrinks. (check-ispell-version): Correctly identifies new version requirements. (ispell-region): Interaction updated for version 3.1.12+ Buffer read-only modification improvement. Dictionary messages added. (ispell-message-text-end): skips additional shell files. (ispell-buffer-local-parsing): extended-char mode now matches text mode Fri Dec 9 01:14:03 1994 Karl Heuer * hilit19.el: Add patterns for asm-mode. * files.el (set-auto-mode): Don't get confused by anything ending in "mode:" which isn't a mode spec. Fri Dec 9 00:03:18 1994 Richard Stallman * rlogin.el (rlogin-initially-track-cwd): Now a 3-way flag. (rlogin): Handle that. Thu Dec 8 15:31:50 1994 Richard Stallman * files.el (ignored-local-variables): Mark it risky. Thu Dec 8 13:51:43 1994 Ed Reingold * cal-mayan.el (calendar-mayan-days-before-absolute-zero): Mention Hochleitner's correlation. Wed Dec 7 21:47:48 1994 Richard Stallman * telnet.el (telnet): Don't make assumptions about process name. (telnet-send-process-next-char): Renamed from send-... * nntp.el (nntp-buggy-select): Delete usg-unix-v from list. Wed Dec 7 19:25:27 1994 Richard Stallman * dired.el (dired-insert-directory): Quote certain chars with \. (dired-get-filename): Always unquote \ quoting. * comint.el (comint-mode-map): Treat C-up, C-down like M-p, M-n. Tue Dec 6 17:39:14 1994 Richard Stallman * simple.el (buffer-quit-function): New variable. (keyboard-escape-quit): Use it. * loaddefs.el: Delete ESC ESC binding for eval-expression. (function-key-map): Map C-delete into M-DEL. Mon Dec 5 19:17:54 1994 Karl Heuer * ange-ftp.el (ange-ftp-set-binary-mode): Ignore hash size if nil. (ange-ftp-set-ascii-mode): Likewise. Mon Dec 5 19:17:20 1994 Richard Stallman * ebuff-menu.el (electric-buffer-menu-mode-map): Bind ESC ESC ESC to Electric-buffer-menu-quit. * loaddefs.el (minibuffer-local-map): Bind up and down to history cmds. (minibuffer-local-ns-map, minibuffer-local-completion-map): Likewise. (minibuffer-local-must-match-map): Likewise. * isearch.el (isearch-cancel): New function. (isearch-mode-map): Bind that to ESC ESC ESC. Move the code to set up the meta submap earlier in the expression. * loaddefs.el (function-key-map): Map f1 to C-h. * simple.el (delete-completion-window): New function. (completion-list-mode-map): Bind that to ESC ESC ESC. * simple.el (keyboard-escape-quit): Bind this globally to ESC ESC ESC. Mon Dec 5 08:40:29 1994 Simon Marshall * font-lock.el (font-lock-after-change-function): Undo Oct 18 change. Sun Dec 4 12:52:32 1994 Richard Stallman * fill.el (fill-region-as-paragraph): If region starts in mid-line, don't fill the text before that, but count it for indentation. (fill-region): If region starts in mid-line, keep whole line in the region, but pass the region start to fill-region-as-paragraph. * faces.el (set-face-font): Pass `default' as face to x-resolve-font-name. (x-resolve-font-name): Better error message when FACE doesn't specify the font. * faces.el: At compile time, discard any defsubr definitions in the Emacs doing the compilation. * bibtex.el (bibtex-mode-map): Delete binding for ". Don't load in tex-insert-quote. * faces.el (face-name, face-id, face-foreground, face-background) (face-font, face-stipple, face-underline-p): Change defsubst to defun. (set-face-font, set-face-foreground, set-face-background) (set-face-stipple, set-face-underline-p): Change defsubst to defun. * replace.el (replace-string, query-replace): Doc fixes. Sat Dec 3 18:13:44 1994 Richard Stallman * rmail.el (rmail-get-new-mail): Position on first unseen message. Return t if actually got new mail. (rmail): Show rmail-first-unseen-message if got no new mail. Thu Dec 1 21:07:06 1994 Karl Heuer * rmailout.el (rmail-output): Don't quote "From " lines unless the capitalization is exact. Thu Dec 1 09:00:40 1994 Simon Marshall * font-lock.el (font-lock-make-faces): Added font-lock-reference-face defaults for grayscale. Wed Nov 30 15:54:14 1994 Karl Heuer * sendmail.el (sendmail-send-it): Add `From:' header. (mail-from-style): New variable. * gud.el (gud-basic-call): Detect error earlier. * term/x-win.el (system-key-alist): Extra keys are F36 and F37. * edebug.el (edebug-enter): Add save-excursion so that buffer-local variables will reset properly. Wed Nov 30 15:47:08 1994 Ake Stenhoff * imenu.el (imenu-generic-expression): New variable. (imenu-example--generic-c++-expression): New variable. (imenu-example--generic-texinfo-expression): New variable. (imenu-example--generic-latex-expression): New variable. (imenu-example--create-c++-index): Deleted. (imenu-example--function-name-regexp-c++): Deleted. (imenu--generic-function): New function. (imenu--generic-extract-name): New function. (imenu-default-create-index-function): Added the generic function calls for the provided examples. Wed Nov 30 14:37:55 1994 Roland McGrath * compile.el (compilation-next-error-locus): Parsed column numbers are 1-origin. Tue Nov 29 15:22:33 1994 Richard Stallman * complete.el (PC-do-completion): If complete but not unique, the second time in a row, give a list of completions. (PC-do-complete-and-exit, PC-do-completion): Use [...] in messages. Tue Nov 29 10:59:07 1994 Ed Reingold * cal-x.el: New file. * calendar.el: Mention cal-x.el in comments. Mon Nov 28 13:15:01 1994 Richard Stallman * simple.el (keyboard-escape-quit): Don't make keybinding yet. * iso-cvt.el: Handle pilcrow, paragraph and pound signs. Use \aa, \AA for a-with-ring. * c-mode.el (calculate-c-indent): Handle a top-level decl with multiple paren groups. * paths.el (gnus-default-nntp-server): Doc fix. * gnus.el: Many doc fixes. Fix progress message formats. (gnus-article-prev-digest): Rename arg to n. (gnus-summary-next-digest, gnus-summary-prev-digest): Likewise. (file-newer-than-file-p): Definition deleted. Thu Nov 24 11:16:51 1994 Ake Stenhoff * imenu.el (imenu): Widen temporary before scan the file. Widen if the user asks to move to an object that is outside the current accessible region. Thu Nov 24 03:37:55 1994 Richard Stallman * simple.el (beginning-of-buffer, end-of-buffer): With argument, calculate fraction wrt accessible portion of buffer. * replace.el (occur): Put number of matches in the header line. Wed Nov 23 03:10:00 1994 Richard Stallman * double.el (double-mode-name): Variable deleted. (minor-mode-alist): Use a constant string to indicate Double mode. * info.el (Info-follow-reference): Use regexp-quote. * simple.el (keyboard-escape-quit): New command. On ESC ESC ESC. * replace.el (query-replace-map): Define \e and escape as exit-prefix. (perform-replace): When exiting and rereading, set this-command to mode-exit. * map-ynp.el (map-y-or-n-p): Handle exit-prefix as definition of char. * loaddefs.el (global-map): Add bindings for C-left and C-right. Tue Nov 22 14:19:25 1994 Richard Stallman * term/x-win.el (Calling menu-bar-enable-clipboard): Be less selective matching Suns. * lpr.el (lpr-page-header-switches): Use -f by default. (lpr-headers-switches): Make it a list. * simple.el (append-to-buffer): Don't use current buffer as default. Tue Nov 22 06:44:09 1994 Roland McGrath * vc.el (vc-checkout-switches): New variable. (vc-backend-checkout): Use it. Mon Nov 21 23:37:26 1994 Richard Stallman * gud.el (gud-gdb-marker-filter, gud-irixdbx-marker-filter) (gud-perldb-marker-filter, gud-mipsdbx-marker-filter): No need for save-match-data. * timer.el (timer-process-filter): No need for save-match-data. * man.el (Man-bgproc-sentinel): No need for save-match-data. Mon Nov 21 12:38:05 1994 Per Bothner * term.el (term-termcap-format): Add cd capability. Fix ei. (term-exec-1): Pass $TERMINFO instead of $TERMCAP if appropriate. Pass emacs-version and term-version in $TERM. Rewrite to set process-environment. Sun Nov 20 15:08:10 1994 Richard Stallman * compare-w.el (compare-windows): Push mark in both buffers at start. * loaddefs.el (global-map): Change home and end bindings to beginning/end-of-line. Put beginning/end-of-buffer on C-home/end. Sat Nov 19 02:51:24 1994 Richard Stallman * term/x-win.el (x-option-alist): New variable now holds list of short options. Don't set command-switch-alist. (x-long-option-alist): New variable. (x-handle-args): Detect long options and convert to short. * startup.el (command-line-1): Handle long options --funcall, --load, --insert, --kill. (command-line): Don't leave argval set if option not really a long one. * gomoku.el (gomoku-click): New function. (gomoku-mode-map): Put it on Mouse-2. * subr.el (start-process-shell-command): Don't use `exec'-- run the command in a child process. * find-dired.el (start-process-shell-command): Function deleted. * simple.el (kill-region): Use = to compare positions. Fri Nov 18 11:40:36 1994 Richard Stallman * picture.el (picture-self-insert): Use last-command-event, not last-input-char. (picture-mode-map): Make the keymap vector 256 chars long. Fix typo `newline-andindent'. * bytecomp1.el: New file. (batch-byte-compile-emacs): New function. * sendmail.el (mail-setup): Make fill-column wide for the in-reply-to. Fri Nov 18 02:45:24 1994 Karl Heuer * simple.el (kill-region): Set this-command unconditionally. Thu Nov 17 11:12:36 1994 Richard Stallman * faces.el (face-color-supported-p): New function. (face-try-color-list): Use that. * timer.el (timer-process-filter): Use save-match-data. * files.el (backup-buffer): Use file-ownership-preserved-p. Wed Nov 16 10:18:32 1994 Michael Ernst * rmailsum.el (rmail-summary-scroll-msg-up): If at end of message, advance to the next message. (rmail-summary-scroll-msg-down): If at beginning of message, advance to the previous message. Wed Nov 16 09:26:05 1994 Richard Stallman * timezone.el (timezone-parse-date): Handle two new formats (6 and 7). * subr.el (substitute-key-definition): Don't recursively scan where OLDMAP has a submap but KEYMAP does not. * dired-aux.el (dired-collect-file-versions): Discard version #s from arg; then do nothing if already in dired-file-version-alist. Tue Nov 15 16:03:38 1994 Roland McGrath * etags.el (tags-query-replace): Use query-replace-read-args in interactive spec. Tue Nov 15 11:50:31 1994 Richard Stallman * isearch.el (isearch-unread): Always use unread-command-events. (isearch-other-meta-char): In the case of a mouse event with a dummy prefix, recombine the two into a single event before unreading. (isearch-gnu-emacs-events): Variable deleted. (isearch-update): Always test unread-command-events. (isearch-event-data-type): Variable deleted. (isearch-pre-command-hook-exists): Variable deleted. (isearch-last-command-char): Only use last-command-char. (isearch-other-meta-char): Delete debugging code. (isearch-mode): Use baud-rate as variable. (isearch-char-to-string): Simplify--assume character is an integer. Tue Nov 15 11:16:57 1994 Ed Reingold * calendar.el (calendar-mode-map): Undefine kill-region and copy-region-as-kill. * cal-menu.el (calendar-mode-map): Get rid of edit menu. Tue Nov 15 09:07:58 1994 Richard Stallman * mouse.el (mouse-save-then-kill): Call mouse-show-mark when we adjust an existing region. * lucid.el (set-keymap-parent): Fix bug in case of empty keymap. (switch-to-other-buffer): Fix one-off error. Mon Nov 14 23:16:44 1994 Richard Stallman * thingatpt.el (line): Add a beginning-op function. Mon Nov 14 21:38:14 1994 Roland McGrath * etags.el (tags-table-including): Don't gratuitously cons (what was I thinking?). Properly skip t elements of tags-table-computed-list. Mon Nov 14 13:53:16 1994 Jim Blandy * scheme.el (scheme-mode-variables): Set parse-sexp-ignore-comments to t. Mon Nov 14 03:03:55 1994 Simon Marshall * font-lock.el (font-lock-defaults-alist): Defaults for scheme-mode. Sun Nov 13 07:15:02 1994 Richard Stallman * rmailout.el (rmail-fields-not-to-output): New variable. (rmail-delete-unwanted-fields): New function. (rmail-output, rmail-output-to-rmail-file): Call it. * replace.el (query-replace-map): Bind Y and N like y and n. * loadup.el: For windows-nt, load mouse. * lpr.el (lpr-headers-switches): Base default on lpr-command value. Fri Nov 11 08:33:25 1994 Richard Stallman * comint.el (comint-exec-1): Terminate TERMCAP with colon. * texinfmt.el (texinfo-format-node): Insert the node delimiter that info is looking for unconditionally. Thu Nov 10 18:01:30 1994 Roland McGrath * compile.el (compile): With prefix arg, prompt even if (not compilation-read-command). (compilation-error-regexp-alist): Make first regexp match column numbers too. Remove regexp for "prog:file:line: error". Replace GNAT 1.82 regexp with "prog: file:line\(:col\)?: error". (compilation-parse-errors): If spec has a column subexpr, but it was optional and didn't match, ignore it. Thu Nov 10 17:01:15 1994 Richard Stallman * add-log.el (find-change-log): If change-log-default-name has no dir component, search through parent dirs for it. Wed Nov 9 15:17:41 1994 Richard Stallman * ange-ftp.el (ange-ftp-version): Var deleted. * rect.el (string-rectangle): Don't set point. * simple.el (copy-region-as-kill): Don't set this-command. Wed Nov 9 07:57:35 1994 Roland McGrath * vc-hooks.el: Only define items in vc-menu-map if it is boundp. Wed Nov 9 07:46:23 1994 Richard Stallman * compile.el (compilation-error-regexp-alist): Add an element for Irix 5.2 warnings. Wed Nov 9 12:56:23 1994 Francesco Potorti` (pot@cnuce.cnr.it) * man.el (Man-berkeley-sed-script, Man-sysv-sed-script, Man-cleanup-manpage, Man-fontify-manpage): Handle the "+\bo" form (used by aix) in addition to the "o\b+" one (used by sun). Wed Nov 9 00:32:23 1994 Karl Heuer * vi.el (vi-kill-region): Pass args to kill-region. (vi-mark-region): Don't pass unexpected args. * apropos.el (apropos-print-matches): Set help-mode in *Help* buffer. * calendar.el (describe-calendar-mode): Likewise. * case-table.el (describe-buffer-case-table): Likewise. * debug.el (debugger-list-functions): Likewise. * disp-table.el (describe-display-table): Likewise. * emerge.el (emerge-file-names): Likewise. [commented out] (describe-mode): Likewise. * help-macro.el (make-help-screen): Likewise. * help.el (describe-key, describe-mode, view-lossage): Likewise. (describe-function, describe-variable): Likewise. * helper.el (Helper-describe-mode): Likewise. * info.el (Info-summary): Likewise. * macros.el (kbd-macro-query): Likewise. * map-ynp.el (map-y-or-n-p): Likewise. * novice.el (disabled-command-hook): Likewise. * refbib.el (r2b-help): Likewise. * replace.el (perform-replace): Likewise. * simple.el (set-variable): Likewise. * supercite.el (sc-set-variable): Likewise. * upd-copyr.el (update-copyright): Likewise. * userlock.el (ask-user-about-lock-help): Likewise. (ask-user-about-supersession-help): Likewise. * vi.el (vi-switch-mode, vi-ex-cmd): Likewise. * yow.el (yow): Likewise. Tue Nov 8 11:23:46 1994 Ed Reingold * calendar.el (diary-entry-marker, calendar-today-marker, calendar-holiday-marker): Don't supersede attributes for faces `diary-face', `calendar-display-face', or `holiday-face' if they are already defined. Tue Nov 8 00:00:10 1994 Karl Heuer * help.el (help-mode): New function. (help-mode-map): Local keymap for help-mode. Empty for now. (print-help-return-message): Fix misspelled var. Mon Nov 7 11:39:27 1994 Ed Reingold * solar.el (solar-sunrise-sunset): Check for nil time before trying to adjust it for dst. Mon Nov 7 12:28:15 1994 Francesco Potorti` (pot@cnuce.cnr.it) * man.el (Man-reuse-okay-flag): Deleted. (man, Man-getpage-in-background): Second arg deleted. References to Man-reuse-okay-flag deleted. (Man-follow-manual-reference): First arg deleted. Call Man-getpage-in-background with one argument only. Fri Nov 4 21:13:09 1994 Ethan Bradford * gnus.el (gnus-configure-windows): Make split-window-keep-point locally t so that focus doesn't occasionally move to the wrong window on split-window-vertically. Thu Nov 3 16:22:47 1994 Geoff Voelker * subr.el (start-process-shell-command): Don't use exec on windows-nt. Thu Nov 3 15:34:33 1994 Ralf Fassel * tar-mode.el (tar-extract): Set default-directory to that of the superior buffer, not the pseudo-dir formed from the archive name. Thu Nov 3 15:29:12 1994 Rick Sladkey * gud.el (gud-gdb-complete-command): Add a trailing single quote to partially quoted unique completions. Thu Nov 3 10:31:08 1994 Simon Marshall * font-lock.el (font-lock-fontify-region): Wrap string-match with save-match-data. Tue Nov 1 04:53:54 1994 Richard Stallman * comint.el (comint-exec-1): Make sure default-directory is a real dir. * bytecomp.el (byte-compile-insert-header): Escape backslashes in FILENAME when putting it inside a string constant. Mon Oct 31 13:47:05 1994 voelker * makefile.nt: New file. * winnt.el: New file. * bytecomp.el (byte-compile-file): Treat windows-nt like ms-dos. * hexl.el (hexl-find-file): Treat windows-nt like ms-dos. * simple.el (shell-command-switch): New variable. (shell-command, shell-command-on-region): Use new variable. * info.el (Info-directory-list): Treat windows-nt like ms-dos. * startup.el (command-line): Use ~/_emacs as init file in windows-nt. * loadup.el: On windows-nt, load ls-lisp and winnt. Treat windows-nt like ms-dos for DOC file name. * loaddefs.el (completion-ignored-extensions): Treat windows-nt like ms-dos. * files.el (abbreviate-file-name): Handle drive letters on windows-nt as on ms-dos. * desktop.el (desktop-basefilename): Use emacs.dsk on windows-nt. * bookmark.el (bookmark-file): Use ~/emacs.bmk on windows-nt. * add-log.el (change-log-name): Use changlo on windows-nt. Mon Oct 31 23:38:21 1994 Richard Stallman * bytecomp.el (byte-compile-file): Check for windows-nt like ms-dos. Mon Oct 31 21:19:19 1994 Ed Reingold * diary-lib.el (view-diary-entries): Fix error message. (view-other-diary-entries): New function. * calendar.el (calendar-mode-map): Bind it to key. * cal-menu.el (calendar-mouse-view-other-diary-entries): New function. (calendar-mode-map): Put them on mouse. Mon Oct 31 20:28:49 1994 Richard Stallman * comint.el (comint-read-noecho): Use `read-char-exclusive' instead of `read-char'. Sun Oct 30 04:11:05 1994 Erik Naggum * simple.el (blink-matching-delay): New variable. * isearch.el (isearch-edit-string, isearch-toggle-case-fold): Pass isearch-nonincremental to isearch-message-prefix. * cl.el (cl-macroexpand): Copy documentation from `macroexpand'. * timezone.el (timezone-world-timezones): Add "UT" -> +000. Sun Oct 30 16:06:47 1994 Ed Reingold * calendar.el (calendar-mode): Delete to window configuration var. Sun Oct 30 01:38:26 1994 Richard Stallman * texinfmt.el (texinfo-format-scan): Make @- vanish; don't insert -. (texinfo-format-soft-hyphen): New function. (texinfo-alias-list): New variable. (texinfo-format-region, texinfo-format-buffer-1): Clear texinfo-alias-list. (texinfo-format-scan): Implement @alias expansion. * loadup.el: Load facemenu if have X. After dumping, print number of pure bytes used. * mouse.el: Put mouse-set-font on C-down-mouse-1. Don't bind C-down-mouse-2. * facemenu.el: Doc fixes. (facemenu-update): Use C-down-mouse-2 for the menu. * simple.el (line-move): Use sign of arg to choose error condition. Sat Oct 29 20:26:50 1994 Ed Reingold * calendar.el (calendar, calendar-other-month): Fix use of calendar-read-date. (calendar-read-date): Fix noday option. * lunar.el (phases-of-moon): Fix use of calendar-read-date. Sat Oct 29 18:58:41 1994 Richard Stallman * simple.el (blink-matching-open): Do blink if an even number of quoting characters precede the close. Sat Oct 29 07:13:35 1994 Richard Stallman * gud.el (gud-common-init): If file arg has no directory, let the debugger search PATH, and don't set default-directory. Fri Oct 28 19:54:06 1994 Tom Tromey * makefile.el: Changed almost every doc string. (makefile-macroassign-regex): Don't include space and tab in macro names. * makefile.el (makefile-backslash-column): New variable. (makefile-backslash-region): New function. (makefile-backslashify-current-line): New function. (makefile-mode-map): Bind C-c C-\ to makefile-backslash-region. * makefile.el (makefile-tab-face): New variable. (makefile-font-lock-keywords): Use makefile-tab-face. (makefile-font-lock-keywords): Use defvar, not defconst. Fri Oct 28 10:55:19 1994 Ulrich Mueller * iso-acc.el (iso-accents-mode): Variable renamed from iso-accents-minor-mode. Fri Oct 28 01:21:18 1994 Richard Stallman * cal-menu.el (calendar-mode-map): Define c-down-mouse-3 like down-mouse-3. Fri Oct 28 22:49:51 1994 Per Abrahamsen * easymenu.el (easy-menu-define): Call `easy-menu-do-define' to do the real work. Document XEmacs keyword arguments. (easy-menu-do-define): New function. (easy-menu-create-keymaps): Support XEmacs keyword arguments in menu definition. Thu Oct 27 18:33:52 1994 Karl Heuer * files.el (find-file-noselect): Call set-buffer-major-mode here. Thu Oct 27 18:42:23 1994 Francesco Potorti` (pot@cnuce.cnr.it) * man.el (Man-fontify-manpage-flag): defvar put at outer level. (manual-program, Man-untabify-command, Man-untabify-command-args, Man-sed-command, Man-awk-command, Man-mode-line-format, Man-mode-map, Man-mode-hook, Man-cooked-hook, Man-name-regexp, Man-section-regexp, Man-page-header-regexp, Man-heading-regexp, Man-see-also-regexp, Man-first-heading-regexp, Man-reference-regexp, Man-switches, Man-specified-section-option): Make them normal defvars, no more user options. (Man-overstrike-face, Man-undeline-face): New user options. (Man-init-defvars): Man-fontify-manpage-flag removed from here. (man-fontify-manpage): Use the new user options above. Thu Oct 27 14:27:12 1994 Karl Heuer * tar-mode.el (tar-summarize-buffer): Improperly terminated archive now produces only a warning. Wed Oct 26 16:07:09 1994 Richard Stallman * flow-ctrl.el (enable-flow-control): Make message depend on customization variables. Wed Oct 26 13:57:13 1994 Michael Ernst * ispell.el (ispell-message-text-end): Match Postcript 3 like 2. Wed Oct 26 11:27:01 1994 Ed Reingold * cal-menu.el (calendar-mouse-insert-diary-entry): New function. (calendar-mouse-2-date-menu): Put it on menu. * diary-lib.el (diary-entry-time): Fix regexps to include TAB. (diary-ordinal-suffix): Fix indentation of code. * calendar.el (calendar-offset, lunar-phases-buffer): New vars. Change defmacros to defsubst for readability, where possible. (calendar-read-date): Rewritten with optional parameter. (calendar): Delete mention of window configuration; use new form of calendar-read-date and calendar-offset. (describe-calendar-mode): Rewritten to link to info. (calendar-mode-line-format): Refer to info, not help. (calendar-mode): Just give keymap. (calendar-goto-info-node, calendar-window-list, calendar-buffer-list, calendar-hide-window): New functions. (calendar-mode-map): Put calendar-goto-info-node on key. (exit-calendar, calendar-current-date): Rewritten. (calendar-cursor-to-date): Fix doc string. (calendar-other-month): Use new form of calendar-read-date. * holidays.el (check-calendar-holidays): Use new form of calendar-read-date. * lunar.el (calendar-phases-of-moon): Use new var lunar-phases-buffer. (phases-of-moon): Use new form of calendar-read-date. * solar.el: Fix doc at start of file and error message when floating point is not available. (calendar-latitude, calendar-longitude, calendar-location): Include vector form; suggest setting values in site-local.el. (solar-sin-degrees, solar-cosine-degrees): Change to macros. (solar-degrees-to-hours, solar-hours-to-days): Change to defsubst. (solar-sunrise, solar-sunset): Allow use of vector forms of latitude/longitude. (calendar-latitude, calendar-longitude): New macros to allow use of vector forms. Wed Oct 26 05:32:50 1994 Richard Stallman * dired-x.el (dired-find-subdir): Doc fix. Tue Oct 25 21:38:59 1994 Karl Heuer * tar-mode.el (tar-summarize-buffer): Check for end of buffer before extracting substring. Tue Oct 25 16:28:42 1994 Richard Stallman * diff.el (diff-command): New variable. (diff): Use it. * frame.el (frame-initialize): Set special-display-function here, not at top level. * gud.el (gud-irixdbx-marker-filter): Cast $curline to int. Tue Oct 25 09:51:53 1994 Boris Goldowsky * enriched.el (enriched-mode): Add autoload cookie. (enriched-decode-foreground, enriched-decode-background): Create faces even if no window system, to prevent multiple warnings. Tue Oct 25 00:46:40 1994 Richard Stallman * ispell.el (ispell-grep-command, ispell-look-command): Don't specify directory. * files.el (buffer-file-truename): Doc fix. Mon Oct 24 19:29:11 1994 Karl Heuer * term/x-win.el: Make previous change conditional. Mon Oct 24 16:32:23 1994 Francesco Potorti` (pot@cnuce.cnr.it) * man.el (Man-init-defvars): Do not delete empty lines. Mon Oct 24 09:55:43 1994 Boris Goldowsky * enriched.el: New file. Mon Oct 24 13:31:57 1994 Francesco Potorti` (pot@cnuce.cnr.it) * man.el (Man-cleanup-manpage): do all the work if called interactively. Sun Oct 23 18:56:40 1994 Roland McGrath * dired.el (dired-mode-map): Add query-replace and search items to operate menu. Sun Oct 23 01:01:41 1994 Richard Stallman * tex-mode.el (latex-mode): Recognize \item etc. that have no arg because only a comment follows. * fill.el (fill-individual-paragraphs): Avoid infinite loop if mailp is set and no message was yanked. * term/x-win.el: Say error in x-open-connection should be fatal. * menu-bar.el (menu-bar-file-menu): Add item `Make Frame On Display'. * menu-bar.el (menu-bar-update-buffers-maxbuf): Declare variable. (menu-bar-update-buffers-1, menu-bar-update-buffers): Rename local var maxbuf to menu-bar-update-buffers-maxbuf. * frame.el (make-frame-on-display): New function. * faces.el (set-face-background): Set either stipple or color, never both. Do this only for a specific frame, not for t. * sendmail.el (mail-setup): Fill in-reply-to field properly. Sat Oct 22 20:52:19 1994 Richard Stallman * faces.el (set-face-background): If color is gray, and frame can't display that directly, use corresponding stipple. (face-try-color-list): Assume gray colors are valid on any display. Sat Oct 22 11:59:08 1994 Roland McGrath * dired-aux.el (dired-do-tags-search, dired-do-tags-query-replace): New functions. * dired.el (dired-mode-map): Bind A to dired-do-tags-search, Q to dired-do-tags-query-replace. Sat Oct 22 11:35:54 1994 Ethan Bradford * ange-ftp.el (ange-ftp-process-handle-line): Check for a multi-line message before an error message. Fixes problem of thinking there is an error in narrative text. Fri Oct 21 03:15:37 1994 Richard Stallman * sendmail.el (sendmail-synch-aliases): Check MAILRC envvar. (mail-aliases, mail-archive-file-name): Doc fixes. * mailalias.el (define-mail-alias): Check MAILRC envvar. * view.el (view-file): Do record the buffer switch. * help.el (describe-function): Mention the file it was loaded from. (describe-function-find-file): New function. (describe-function): Use that. * gud.el (dbx): Delete call to gud-switch-to-buffer. (gud-sdb-marker-filter): Handle SVR4 clumped lines. * emerge.el (emerge-auto-advance): Fix criterion for which message. Thu Oct 20 14:48:22 1994 Noah Friedman * timer.el (timer-error, timer-abnormal-termination, timer-filter-error): New error conditions. (timer-process-filter, timer-process-sentinel): Signal an error, don't just print a message. Thu Oct 20 20:03:33 1994 Richard Stallman * rmail.el (rmail-get-new-mail): If display-time is in use, call display-time-filter to update the Mail indicator. * startup.el (command-line): Set x-cut-buffer-max here. * term/x-win.el: Not here. Thu Oct 20 17:17:53 1994 Roland McGrath * etags.el (next-file): Initialize next-file-list all at once from all tables. Never call visit-tags-table-buffer when INITIALIZE is not t. Thu Oct 20 16:02:12 1994 Richard Stallman * ange-ftp.el (ange-ftp-get-passwd): Use user-mail-address. (ange-ftp-generate-anonymous-password): Doc fix. Thu Oct 20 15:47:05 1994 Karl Heuer * simple.el (edit-and-eval-command): Elements of command-history are forms, not strings. * chistory.el (repeat-matching-complex-command): Fix check for empty pattern. Simplify. (default-command-history-filter-garbage): Fix doc string. (list-command-history-filter, list-command-history-max): Likewise. Wed Oct 19 18:03:40 1994 Noah Friedman * timer.el (timer-program): Make defvar, not defconst. Expand name of timer program in exec-directory here. (run-at-time): Not here. Wed Oct 19 08:46:03 1994 Boris Goldowsky * facemenu.el (facemenu-face-menu, facemenu-foreground-menu, facemenu-background-menu, facemenu-special-menu): New or renamed variables for submenus. * facemenu.el (facemenu-color-alist): Renamed from facemenu-colors. * facemenu.el (facemenu-add-new-face): New function. * facemenu.el (facemenu-update): Don't redo top-level menu; nothing should change. Move menu setup to defvars. Use facemenu-add-new-face. Changed global binding to C-down-mouse-3. * facemenu.el (facemenu-menu): "Update" item removed; should no longer be needed interactively. * facemenu.el (facemenu-complete-face-list): Just return faces, not keybindings. Mon Oct 17 09:46:09 1994 Boris Goldowsky * faces.el (make-face): Add new face to Face menu on creation. * facemenu.el (facemenu-get-face): Don't add to menu here. Fri Oct 14 18:46:28 1994 Francesco Potorti` (pot@cnuce.cnr.it) * man.el (Man-init-defvars): Corrections to Man-filter-list. (Man-fontify-manpage): Added cleaning of ksh manpage daggers. (Man-fontify-manpage): Added cleaning of ksh manpage daggers. (Man-bgproc-sentinel): Unconditionally call Man-cleanup-manpage. Tue Oct 18 00:59:33 1994 Richard Stallman * term.el (term-exec-1): Put `sane' last in stty cmd. Redirect stderr to /dev/null. * files.el (auto-mode-alist): Doc fix. * font-lock.el (font-lock-after-change-function): If inside a comment, don't scan for keywords. * cmuscheme.el (run-scheme): Add autoload cookie. (scheme): Function deleted. * xscheme.el (run-scheme): Delete autoload cookie. * easymenu.el (easy-menu-create-keymaps): Add autoload cookie. Mon Oct 17 22:38:13 1994 Richard Stallman * nntp.el (nntp-open-server): Send MODE READER command to server. * time.el (display-time-filter): Ignore mail-spool-file if not string. Mon Oct 17 15:36:03 1994 Andreas Schwab * info.el (info-insert-file-contents): Always check for conflict with jka-compr. (Info-find-node): Don't search on Info-directory-list if the file name is absolute. * etags.el (etags-tags-table-files, etags-tags-included-tables): Search backwards for the comma in case the file name contains one. Mon Oct 17 08:15:45 1994 Fred Pierresteguy * paths.el (rmail-spool-directory): Add a condition to test the Bull DPX/2. Mon Oct 17 04:05:11 1994 Morten Welinder * dos-fns.el (window-frame, raise-frame, select-frame): Clean stubs. * faces.el (face-initialize): Fill in the faces for non-X frames also. * info.el (Info-mode): Also use fonts for `pc' window system. * loadup.el ((eq system-type 'ms-dos)): Rearrange what to load. ((eq system-type 'ms-dos)): Under X, let the documentation be stored in DOC-X. * mouse.el (mouse-set-region) [MSDOS]: Give pc-frames the same treatment as X-frames. * term/pc-win.el: New file. Sun Oct 16 07:15:34 1994 Morten Welinder * emerge.el (emerge-temp-file-prefix): Try TEMP and TMP as alternatives for TMPDIR. Sun Oct 16 02:16:38 1994 Richard Stallman * faces.el (set-face-stipple): New function. (set-face-background-pixmap): An alias for that. (face-stipple): New function. (face-background-pixmap): An alias for that. (copy-face, face-equal, face-differs-from-default-p) (make-face-x-resource-internal): Handle stipple bitmaps. * simple.el (count-lines): Do save-match-data only when necessary. * loadup.el: Delete code to write subdirs.el. Sat Oct 15 04:32:58 1994 Richard Stallman * rmailsum.el (rmail-summary-delete-forward): Don't move fwd to eob. * gnus.el (gnus-group-group-name): Get rid of text properties. * cmuscheme.el (run-scheme): Set scheme-program-name. Fri Oct 14 00:49:12 1994 Richard Stallman * sendmail.el (mail-setup): Fill the in-reply-to field. * subr.el (add-to-list): Doc fix. * rnewspost.el (news-reply-mode-map): Add C-c C-t binding. * delsel.el (self-insert-iso): Add delete-selection property. * font-lock.el (font-lock-fontify-region): Discard leading spaces from comment-end. * sendmail.el (mail-do-fcc): If file does not exist, assume it is not a Babyl file. Thu Oct 13 23:26:39 1994 Roland McGrath * etags.el (tags-reset-tags-tables): New function. Thu Oct 13 19:29:35 1994 Karl Heuer * lmenu.el (make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items. (popup-menu): Update documentation string to describe the new syntax. Thu Oct 13 14:33:51 1994 Morten Welinder * desktop.el (desktop-internal-v2s): Remove all text properties from strings. Thu Oct 13 14:56:05 1994 Fred Pierresteguy * hilit19.el (hilit-set-mode-patterns - lisp-mode): Fix regexp for 'defconstant' that leads to an infinite loop. Hilight the 'list' keyword. Thu Oct 13 04:35:24 1994 Richard Stallman * sendmail.el (mail-file-babyl-p): New function. (mail-do-fcc): If file is a Babyl file, write output in Babyl format. * loadup.el (Evaluating top-level): Don't load loadup.el again. Thu Oct 13 03:55:51 1994 Simon Marshall * font-lock.el: Use purify-flag rather than noninteractive. Thu Oct 13 02:15:40 1994 Richard Stallman * loadup.el: Move the subdirs.el up to near first thing. * compile.el (compilation-filter): Do nothing if buffer is dead. * gud.el (gud-filter): Don't bind inhibit-quit. Do nothing if buffer is dead. * texinfmt.el (texinfo-no-refill-regexp): Recognize @ifhtml, @html. (texinfo-format-ifhtml, texinfo-format-html): New functions. (texinfo-format-enddots): New function. Wed Oct 12 19:16:15 1994 Richard Stallman * simple.el (shell-command, shell-command-on-region): Rename arg FLAG to OUTPUT-BUFFER and allow it to be a buffer. * ada.el (ada-mode): Rename end-comment-column to ada-comment-end-column. (ada-inline-comment): Likewise. (ada-comment-end-column): Declare variable. * appt.el (appt-select-lowest-window): Locally bind lowest-window. (appt-delete): Don't set tmp-appt-msg-list. * add-log.el (change-log-mode-map): Move the definition up. * menu-bar.el (menu-bar-update-buffers-1): New subroutine broken out of menu-bar-update-buffers. Truncate the file name and discard the nondirectory part. (menu-bar-update-buffers): Discard middle of long buffer names. * subr.el (add-to-list): New function. Wed Oct 12 16:49:34 1994 Boris Goldowsky * facemenu.el (facemenu-read-color, facemenu-colors): New fn, var. (facemenu-set-face, facemenu-set-face-from-menu, facemenu-after-change): Face property can take a list value; add to it rather than completely replacing the property. (facemenu-add-face, facemenu-discard-redundant-faces): New functions. * facemenu.el (facemenu-set-foreground, facemenu-set-background) (facemenu-get-face, facemenu-foreground, facemenu-background): New functions and variables. Faces with names of the form fg:color and bg:color are now treated specially. (facemenu-update): Updated for above. Wed Oct 12 16:03:14 1994 Jonathan I. Kamens (jik@gza-client1.cam.ov.com) * jka-compr.el (jka-compr-mode-compression-info-list): Add .tgz extension. (jka-compr-mode-alist-additions): New variable. (jka-compr-install): Append jka...additions to auto-mode-alist. (jka-compr-uninstall): Remove jka-...-additions from auto-mode-alist. Wed Oct 12 14:36:13 1994 Richard Stallman * rmailsum.el (rmail-summary-previous-all) (rmail-summary-next-all): Don't move forward to the end of the buffer. Wed Oct 12 05:24:00 1994 Simon Marshall * ada.el (ada-mode-syntax-table): Made `-' and `\n' be comments. (ada-font-lock-keywords-1, ada-font-lock-keywords-2, ada-font-lock-keywords): New variables. (ada-mode): Set font-lock-defaults. * add-log.el (change-log-mode): Set font-lock-defaults. * asm-mode.el (asm-mode): Set font-lock-defaults. * compile.el (compilation-mode): Set font-lock-defaults. * dired.el (dired-mode): Set font-lock-defaults. * fortran.el (fortran-mode-syntax-table): Made `!' be a comment. (fortran-font-lock-keywords-1, fortran-font-lock-keywords-2, fortran-font-lock-keywords): New variables. (fortran-mode): Set font-lock-defaults. * makefile.el (makefile-mode-syntax-table): Made `'' and ``' be strings, and `#' be a comment. (makefile-font-lock-keywords): Add variable reference regexp. (makefile-mode): Set font-lock-defaults. * outline.el (outline-mode): Set font-lock-defaults. * pascal.el (pascal-mode): Set font-lock-defaults. * perl-mode.el (perl-mode): Set font-lock-defaults. * rmail.el (rmail-variables): Set font-lock-defaults. * rmailsum.el (rmail-summary-mode): Set font-lock-defaults. * sendmail.el (mail-mode): Set font-lock-defaults. * sh-script.el (sh-set-shell): Set font-lock-defaults. * shell.el (shell-font-lock-keywords): Add `\n' to [^] regexps. (shell-mode): Set font-lock-defaults. * texinfo.el (texinfo-mode): Set font-lock-defaults. * font-lock.el: To make font-lock.el dumpable. (font-lock-display-type, font-lock-background-mode) (font-lock-face-attributes): Default to nil. (font-lock-make-faces): New function. Set them. (font-lock.el): Add to after-init-hook if noninteractive or use it. (font-lock-maximum-size): New variable. (font-lock-mode): Use it to fontify only if buffer is within it. (font-lock-defaults, font-lock-defaults-alist): Item for syntax table. (font-lock-set-defaults): Set font-lock-syntax-table too. (lisp-font-lock-keywords-2): Fix CLisp end-of-keyword in regexp. (c-font-lock-keywords-*): Specific to ANSI C. (c++-font-lock-keywords-*): Specific to ANSI C++. Wed Oct 12 03:22:43 1994 Richard Stallman * mouse.el (mouse-major-mode-menu): Use minor-mode-map-alist instead of overriding-local-map. Display equiv keys using mouse-major-mode-menu-compute-equiv-keys. (mouse-major-mode-menu-compute-equiv-keys): New function. * sendmail.el (mail-alias-modtime): Doc fix. * appt.el (appt-delete-window): Avoid error if WINDOW is nil. * c-mode.el (c-mode-map): Capitalize Mode in C Mode menu bar item. Tue Oct 11 13:22:05 1994 Richard Stallman * hilit19.el (calendar-mode): Delete the regexps for diary, hollidays. * tex-mode.el (compare-windows-whitespace): Eliminate initial value. * rmail.el (rmail-find-all-files): Fix several errors and make faster. Always return a single-level list of file names. (rmail-construct-io-menu): If FILES is null, turn off the menus. (rmail-disable-menu): A phony "command", always disabled in menus. (rmail-list-to-menu): Reverse the list L. Tue Oct 11 19:04:50 1994 Tom Tromey * makefile.el (makefile-mode-name): Removed. (makefile-mode): Skip any number of "#"s at beginning of comments. (makefile-electric-keys): New variable. (makefile-electric-dot): Self insert if not at bol. (makefile-electric-equal): Really self-insert if not at bol. (makefile-pickup-everything): Prefix arg means force pickups to be redone. (makefile-insert-macro-ref): Don't use format. (makefile-runtime-macros-list): Added "$" to list. (makefile-insert-special-target): Don't use format. (makefile-insert-macro): Don't use format. (makefile-insert-target): Don't use format. (makefile-insert-target-ref): Don't use format. (makefile-electric-colon): Really self-insert if not at bol. (makefile-complete): New function. Bound to M-TAB. (makefile-do-macro-insertion): New function. (makefile-mode-map): Add menu bar bindings. (makefile-font-lock-keywords): New constant. (makefile-mode): Deal with font-lock, add-log, imenu. (makefile-macroassign-regex): Changed for use with font-lock. (makefile-dependency-regex): Changed for use with font-lock. (makefile-add-log-defun): New function. (makefile-menu-index-function): New function. Tue Oct 11 08:56:04 1994 Fred Pierresteguy * rmailsum.el (rmail-summary-resend): New function. (rmail-summary-mode-map - resend): Call rmail-summary-resend instead of rmail-resend. Tue Oct 11 00:42:02 1994 Richard Stallman * startup.el (normal-top-level-add-to-load-path): New function. (normal-top-level): Load subdirs.el in each dir in load-path. * loadup.el: Write the subdirs.el file. * simple.el (blink-matching-open): Check there is a previous nonblank line before trying to display it. No need for backward-char before the skip-chars-backward. * rmail.el (rmail-show-message): New argument no-summary. * rmailsum.el (rmail-summary-rmail-update): Pass new arg to rmail-show-message. Mon Oct 10 00:47:36 1994 Richard Stallman * iso-transl.el (initializing keymaps): Define translations for mute-acute and the other mute- keys. * term/x-win.el (system-key-alist): Add sun versions of mute-grave, mute-diaeresis, mute-asciicircum. * c-mode.el (c-mode-map): Use "C mode" for the menu bar item name. * mouse-sel.el (mouse-select): Pass an arg to mouse-extend. * mail-hist.el (mail-hist-put-headers-into-history) (mail-hist-current-header-contents, mail-hist-forward-header) (mail-hist-current-header-name): Use regexp-quote on mail-header-separator. * lisp-mode.el (calculate-lisp-indent): Local var last-sexp renamed to calculate-lisp-indent-last-sexp. (lisp-indent-function): Use new name of var. (calculate-lisp-indent-last-sexp): Var defined. * menu-bar.el (menu-bar-file-menu): Don't include the frame commands in a non-frame version of Emacs. * font-lock.el (font-lock-set-defaults): Do nothing if font-lock-keywords already non-nil. Use font-lock-defaults. (font-lock-defaults): New variable. Sun Oct 9 13:22:22 1994 Richard Stallman * appt.el (appt-delete-window): Do nothing if the window is the only one in its frame. * calendar.el (calendar-holiday-marker): Copy holiday-face from highlight face. * ispell.el (ispell-highlight-spelling-error): Have just one definition, which decides what to do. (ispell-command-loop): New args START and END. Do highlighting and unhighlighting here. (ispell-word, ispell-region, ispell-complete-word): Not here. (ispell-highlight-spelling-error-generic): Bind buffer-undo-list to t. * lisp-mode.el (emacs-lisp-mode-syntax-table): Don't set syntax of formfeed. * bytecomp.el (byte-compile-insert-header): Use user-mail-address. Sat Oct 8 00:11:57 1994 Richard Stallman * add-log.el (add-log-current-defun): In texinfo-mode, handle the case of no commas after @node. * tex-mode.el (tex-region): Don't delete temp files if we do one buffer twice in a row. * rmail.el (rmail-delete-forward): Use rmail-select-summary. Fri Oct 7 05:52:06 1994 Richard Stallman * mouse.el (mouse-major-mode-menu): New function, on C-mouse-3. (mouse-major-mode-menu-1): New function (mouse-set-font): Move it to C-mouse-2. * font-lock.el (font-lock-defaults-alist): Delete most modes--all those that now set font-lock-keywords themselves. Re-delete code deleted in rms's Oct 5 change. * pascal.el (pascal-mode): Set font-lock-keywords locally. * perl-mode.el (perl-mode): Set font-lock-keywords locally. * asm-mode.el (asm-mode): Set font-lock-keywords locally. * texinfo.el (texinfo-mode): Set font-lock-keywords locally. * shell.el (shell-mode): Set font-lock-keywords locally. * dired.el (dired-mode): Set font-lock-keywords locally. * sendmail.el (mail-mode): Set font-lock-keywords locally. * rmail.el (rmail-variables): Set font-lock-keywords locally. * rmailsum.el (rmail-summary-mode): Set font-lock-keywords locally. * outline.el (outline-mode): Set font-lock-keywords locally. * add-log.el (change-log-mode): Set font-lock-keywords locally. * compile.el (compilation-mode): Use kill-all-local-variables. Set font-lock-keywords locally. Thu Oct 6 16:55:54 1994 Richard Stallman * menu-bar.el (query-replace): Add missing quote. Thu Oct 6 14:13:50 1994 Noah Friedman * type-break.el: Do not call type-break-mode upon loading. (type-break-time-sum): New function. (type-break-schedule): Use it. Make function interactive. (type-break-guestimate-keystroke-threshold): Use `N' interactive spec, not `n'. (type-break-demo-boring): Show elapsed time of break, or number of minutes left for good break. Thu Oct 6 04:23:17 1994 Richard Stallman * appt.el (appt-delete-window): Look on all frames for the window. (appt-disp-window): If frame is unsplittable, use display-buffer. Wed Oct 5 20:12:25 1994 Simon Marshall * comint.el (comint-check-proc): Recognise `open'. (comint-exec): Use open-network-stream if command is a cons pair. * font-lock.el (compilation-mode-font-lock-keywords, rmail-summary-font-lock-keywords, dired-font-lock-keywords, shell-font-lock-keywords, texi-font-lock-keywords, perl-font-lock-keywords): Deleted. * sh-script.el (sh-font-lock-keywords): Default to nil. * compile.el (compilation-mode-font-lock-keywords): New variable. * add-log.el (change-log-font-lock-keywords): New variable. * outline.el (outline-font-lock-keywords): New variable. * rmailsum.el (rmail-summary-font-lock-keywords): New variable. * rmail.el (rmail-font-lock-keywords): New variable. * sendmail.el (mail-font-lock-keywords): New variable. * dired.el (dired-font-lock-keywords): New variable. * shell.el (shell-font-lock-keywords): New variable. * texinfo.el (texinfo-font-lock-keywords): New variable. * asm-mode.el (asm-font-lock-keywords): New variable. * perl-mode.el (perl-font-lock-keywords): New variable. * pascal.el (pascal-font-lock-keywords): New variable. (pascal-mode): Set comment-start-skip and comment-end. * font-lock.el: (font-lock-mode): Doc fix; use add/remove-hook, not setq; removed make-local-variable of font-lock-no-comments. (font-lock-set-defaults): Do it there, and use: (font-lock-defaults-alist): Use it to set font-lock-keywords, font-lock-keywords-case-fold-search and font-lock-no-comments. (turn-on-font-lock): New function. (font-lock-fontify-buffer): Made interruptible; deleted messages. * font-lock.el: (font-lock-fontify-region): Made syntax state reliable by widening within new restriction; let cstart and cend for speed; outputs message. (font-lock-after-change-function): Remove spurious goto-char and use forward-line, not 1+ end-of-line, for end of fontification region. (font-lock-any-properties-p): Removed, use text-property-not-all. * font-lock.el (font-lock-*-face): facename values are themselves. (font-lock-variable-name-face, font-lock-reference-face): New vars. (font-lock-doc-string-face): Removed. (font-lock-keywords): Extended value syntax. (font-lock-hack-keywords): Cope with it; outputs initial message. * font-lock.el: Merged in face-lock.el: (font-lock-display-type, font-lock-background-mode) (font-lock-face-attributes): New variables, use it. (font-lock-make-face): New function, use them. Wed Oct 5 11:30:10 1994 Francesco Potorti` (pot@cnuce.cnr.it) * man.el (Man-notify, Man-current-page, Man-page-list, Man-filter-list, Man-original-frame, Man-arguments, Man-fontify-manpage-flag, Man-sections-alist, Man-refpages-alist, Man-uses-untabify-flag, Man-page-mode-string, Man-sed-script): Added defvar's to keep the compiler quiet. (Man-getpage-in-background): Start buffer name with "*Man ". instead of "*man " to avoid conflict with "*mail*". (Man-match-substring): Defsubst moved before first call. (Man-build-page-list, Man-strip-page-headers, Man-unindent): Use defun instead of defsubst, for code clarity purpose. Wed Oct 5 02:29:01 1994 Richard Stallman * font-lock.el: Delete the error when no window system. * gnuspost.el (sendnews, postnews): Use defalias. * startup.el (command-line): Load disp-table explicitly. * add-log.el (add-log-current-defun): Handle Perl specially. * env.el (read-envvar-name): Special meaning for MUSTMATCH neither t nor nil. (setenv): Use that new case, when clearing a var. Tue Oct 4 18:57:17 1994 Richard Stallman * texinfmt.el (texinfo-format-scan): Accept @^, @", @?, @!, @-. * rmailsum.el (rmail-summary-goto-msg): Get rmail-total-messages from the rmail buffer. * simple.el (goto-line): Call prefix-numeric-value. Mon Oct 3 18:57:36 1994 Richard Stallman * files.el (set-auto-mode): Discard versions from file name before testing inhibit-first-line-modes-regexps. * rlogin.el (rlogin): Doc fix. Sun Oct 2 22:45:57 1994 Per Cederqvist * vc-hooks.el (vc-status): Handle CVS. * vc-hooks.el (vc-find-cvs-master): New function. (vc-master-templates): Add vc-find-cvs-master. (vc-registered): Allow vc-master-templates to contain atoms, and call them with dirname and basename as arguments. * vc-hooks.el (vc-mode-line): Use equal, not string-equal, to compare the result of vc-locking-user. * vc.el (vc-backend-checkin): When CVS checks in a file, it is immediately checked out again, so set vc-checkout-time. * vc.el (vc-fetch-properties): CVS 1.4A1 says "Repository revision". * vc.el (vc-locking-user): Do something sensible when the backend is CVS. May return a numerical UID or a string when CVS is used. (vc-dired-reformat-line): Handle numerical arguments. * vc.el (vc-backend-checkout): Don't extract CVS files twice. * vc.el (vc-next-action-on-file): Handle return value from vc-backend-merge-news correctly. * vc.el (vc-rename-file): Fixed call to vc-backend-dispatch. (vc-make-buffer-writable-hook): New hook, for CVS only. (vc-header-alist): Added header for CVS. (vc-next-action-on-file): Added support for CVS. (vc-next-action, vc-checkin, vc-revert-buffer): Doc fixes. (vc-rename-file): Disable if the backend is CVS. (vc-log-info): New arguments: LAST and FLAGS, passed on to vc-do-command. All callers updated. (vc-fetch-properties): Implement support for CVS files. * vc.el (vc-backend-checkin): Args REV and COMMENT no longer optional. Implement support for CVS. (vc-backend-revert): Implement support for CVS. (vc-backend-diff): Treat files which are added, but not yet committed, specially (diff them against /dev/null). (vc-backend-merge-news): New function. (vc-log-mode): Talk a little about CVS in the comment. * vc.el (vc-log-info): Simplify code. * vc.el (vc-do-command): New argument LAST. All callers updated. Legal values for LAST are 'MASTER and 'BASE. (vc-backend-dispatch): New argument C, used by CVS. All callers updated, but many just passes an (error "NYI") form. (vc-backend-admin): Issue a "cvs add" (but not a "cvs commit"). (vc-backend-checkout, vc-backend-logentry-check, vc-backend-print-log, vc-backend-assign-name, vc-backend-diff, vc-check-headers): Handle CVS. (vc-backend-steal, vc-backend-uncheck): Give error if using CVS. * vc.el (vc-backend-diff): Fixed typo in SCCS code. Sun Oct 2 00:01:49 1994 Richard Stallman * comint.el (comint-strip-ctrl-m): Renamed from shell-strip-crtl-m and moved here. (shell-strip-ctrl-m): Add defalias. * shell.el (shell-strip-ctrl-m): Function deleted. * rect.el (kill-rectangle): In read-only buffer, do record the rectangle for later yanking. * shell.el (shell-mode): Compare the truename with /dev/null. * files.el (file-truename): If name has no dir, use default-directory. * env.el (setenv-history): New history list. (setenv): Use setenv-history. Place the variable's current value at front of setenv-history while reading the new value. Sat Oct 1 17:06:58 1994 Richard Stallman * cplus-md.el (indent-c++-exp): For public/private/protected, don't do the case/label adjustment. * fill.el (fill-region, fill-region-as-paragraph): Fix previous change. * vc.el (vc-register): Verify an old master file really still exists before giving error. If it has disappeared, ask for confirmation. * files.el (save-buffers-kill-emacs): Fix previous change. Sat Oct 1 00:23:41 1994 Richard Stallman * mouse.el (mouse-secondary-click-count): New variable. (mouse-secondary-save-then-kill, mouse-drag-secondary): Use mouse-secondary-click-count, not mouse-selection-click-count. * server.el (server-switch-buffer): Don't go to an invisible frame. Move to a non-dedicated window if possible. Otherwise, make the window non-dedicated. * subr.el (add-hook, remove-hook): If the hook was made local in the old way, always modify the local value. * ispell.el (ispell-init-process): Add missing arg in error msg. * finder.el (finder-mode-map): Change key bindings: RET or f to select, d to go back to directory. (finder-summary): Fix the help summary. Fri Sep 30 14:19:54 1994 Jan-Hein Buhrman * env.el (setenv): Provide history, completion for envvar. (read-envvar-name-history): New variable. (read-envvar-name): New function. Fri Sep 30 18:14:05 1994 Francesco Potorti` (pot@cnuce.cnr.it) * man.el (Man-init-defvars, Man-cleanup-manpage, Man-fontify-manpage): fix previous fix. Fri Sep 30 16:29:27 1994 Michael Ernst * fill.el (fill-region, fill-region-as-paragraph): If specified region ends before a newline, include that newline. Fri Sep 30 00:44:57 1994 Richard Stallman * edmacro.el (edmacro-format-keys): Cope if local keymap is nil. * faces.el (modify-face): New function. * files.el (save-buffers-kill-emacs): Use run-hook-with-args-until-failure. (find-file-noselect): Use run-hook-with-args-until-success. (after-find-file): Use run-hooks for find-file-hooks. (basic-save-buffer): Use run-hook-with-args-until-success. * subr.el (add-hook): Initialize default value and local value. (run-hook-with-args-until-success): New function. (run-hook-with-args-until-failure): New function. * dired-aux.el (dired-do-print): Put spaces between lpr switches. Thu Sep 29 14:51:09 1994 Richard Stallman * lpr.el (print-region-1): Use them instead of just pr. (lpr-page-header-program, lpr-page-header-switches): New variables. * abbrev.el (add-abbrev, inverse-add-abbrev): Clear text properties from NAME. * scheme.el (scheme-mode-variables): Make parse-sexp-ignore-comments t. * texinfmt.el (texinfo-format-region, texinfo-format-buffer-1): Search back for the @include. Thu Sep 29 13:39:02 1994 Francesco Potorti` (pot@cnuce.cnr.it) * man.el (Man-init-defvars, Man-cleanup-manpage, Man-fontify-manpage): added support for the big cross present in the ksh manpage. Thu Sep 29 00:48:21 1994 Richard Stallman * frame.el (handle-delete-frame): New function. Wed Sep 28 15:49:33 1994 Ake Stenhoff * imenu.el (imenu--cleanup): Changed 'mapc' to 'mapcar'. Wed Sep 28 19:00:42 1994 Richard Stallman * subr.el (run-hooks): t as hook list element means run the global value of the variable as well as the local value. (run-hook-with-args): Likewise. (make-local-hook): New function. (add-hook, remove-hook): New arg LOCAL means modify local value. Test default-boundp as well as boundp. Wed Sep 28 18:10:55 1994 Karl Heuer * startup.el (command-line): Recognize --longopt synonyms for all options handled here. Tue Sep 27 16:29:27 1994 Michael Ernst * paragraphs.el (backward-kill-sentence): Work in read-only buffers. (kill-sentence): Work in read-only buffers. Tue Sep 27 16:14:42 1994 Richard Stallman * help.el (command-apropos): Pass t for no-header to apropos. * apropos.el (apropos-print-matches): Add newline after Function: or Variable: if line doesn't fit with it. New arg no-header inhibits them entirely. (apropos): New arg no-header. Pass it to apropos-print-matches. * sendmail.el (mail): Doc fix. Tue Sep 27 12:03:04 1994 Christopher J. Madsen * files.el (hack-one-local-variable): Support safe-local-variable property. (compile-command): Add safe-local-variable property. Tue Sep 27 01:41:30 1994 Roland McGrath * etags.el (etags-tags-completion-table): Allow ? and : in guessed tag names. Mon Sep 26 16:47:50 1994 Joe Ramey * rmailsum.el (rmail-summary-delete-forward): Regexp for recognizing deleted message should not require a space at the beginning of the line. Mon Sep 26 19:04:19 1994 Richard Stallman * gud.el (gud-overload-functions): Function deleted. (gud-massage-args, gud-marker-filter, gud-find-file): New vars. Mark them as permanent locals. (gud-massage-args, gud-marker-filter, gud-find-file): In these functions, use those variables. (gud-common-init): 3 new args give values for those variables. (gdb, sdb, dbx, xdb, perldb): Pass new args to gud-common-init. (gud-gdb-complete-command): Bind gud-marker-filter. (gud-find-file): Condense multiple slashes to single slashes. Mon Sep 26 06:49:42 1994 Lennart Staflin * dired.el (dired-re-perms): Accept various file type letters. Sun Sep 25 14:27:30 1994 Richard Stallman * flow-ctrl.el (enable-flow-control): Never make keyboard-translate-table shorter. Sun Sep 27 13:27:11 1994 Barry A. Warsaw (warsaw@anthem.nlm.nih.gov) * Installed version 4.85. * cc-mode.el (c-mode-fsf-menu, c-mode-map, c++-mode-map, objc-mode-map): Use a better feature test to figure out how to set the menu title string. * cc-mode.el (c-search-uplist-for-classkey): In `class' keyword verification section, only skip forward for ?> template char if a matching ?< char was found previous to search-start. * cc-mode.el (c-submit-bug-report): Updated var list. * cc-mode.el (c-search-uplist-for-classkey): Lele patch for objc-mode. * cc-mode.el (c-search-uplist-for-classkey): Avoid "invalid search bound" error. * cc-mode.el (c-beginning-of-statement-1): Skip special modifier chars in all cases. * cc-mode.el (c-guess-basic-syntax): CASE 9: generalize and collect common code for finding position after conditional statements, and check for `while' statement of a `do' loop. In that case, skip over the trailing semi. * cc-mode.el (c-progress-info, c-progress-init) (c-progress-update, c-progress-fini): New vars/defuns for better long indentation progress reporting (c-indent-exp, c-indent-region): Use them. * cc-mode.el (c-guess-basic-syntax): CASE 6F, go forward 1 char from b-o-s of containing-sexp bufpos to find proper relpos of an arglist-cont. * cc-mode.el (c-offset-alist-default): statement-case-open default offset is zero (c-skip-case-statement-forward): New function. (c-guess-basic-syntax): CASE 15: use c-skip-case-statement-forward in proper places to find the real relpos of statement's inside switch case/default bodies. CASE 15D: remove special handling when looking at c-conditional-key. * cc-mode.el (c-offsets-alist, c-cleanup-list, c-mode-menu) (c-mode-map, c-symbol-key, c-indent-line, c-popup-menu): Doc fixes. * cc-mode.el (c-least-enclosing-brace): New function. (c-most-enclosing-brace): Renamed from c-enclosing-brace. (c-indent-defun): Handle opening braces not in column 1. * cc-mode.el (c-beginning-of-statement-1): Skip over statement mod characters that don't precede an open paren. * cc-mode.el (c-guess-basic-syntax): Check for c-access-key non-nil before using it. * cc-mode.el (c-beginning-of-statement-1): Swapped CASE 3 and 4, so that conditional statements are picked up properly. * cc-mode.el (c-guess-basic-syntax): CASE 15D, calculate relpos from boi of beginning of statement prior to indent-point, unless we're looking at a conditional key. * cc-mode.el (c-mode-map, c++-mode-map, objc-mode-map): Change test of 'FSF in c-emacs-features to specific features based tests. * cc-mode.el (c-just-after-func-arglist-p) (c-guess-basic-syntax, c-lineup-objc-method-args-2): More objc patches from Lele * cc-mode.el (c-indent-command): With optional arg, shift-amt had wrong sign. * cc-mode.el (c-lineup-arglist): Better handling of comments preceding arg lists. * cc-mode.el (c-guess-basic-syntax): Swapped CASE 6A and 6B to recognize empty arglists with close paren on separate line. * cc-mode.el (c-mode-menu, c-emacs-features, c-mode-map) (c-common-init): Remove dependency on string "Lucid" in emacs-version. Use features to distinguish. * cc-mode.el (c-fill-paragraph): Merge with 19.25's c-mode.el--uses fill-region-as-paragraph. * cc-mode.el (c-offsets-alist-default, c-offsets-alist) (c-hanging-braces-alist, c-electric-brace, c-guess-basic-syntax): Added syntactic symbol statement-case-open for statement-case-intro's that contain an open brace. * cc-mode.el (c-lineup-math): Watch for equal signs in literals. * cc-mode.el (c-beginning-of-statement-1): CASE5 and CASE 6, better pick up of label's with potential embedded colons (scope operators). * cc-mode.el (c-hanging-comment-ender-p): New variable. (c-fill-paragraph): Use c-hanging-comment-ender-p. * cc-mode.el (c-recognize-knr-p): New variable. (c-common-init): Make it buffer-local. (c-mode, c++-mode, objc-mode): Use c-recognize-knr-p. (c-guess-basic-syntax): Use c-recognize-knr-p; swap CASE 5B.2 and 5B.3. * cc-mode.el (c-offsets-alist-default, c-offsets-alist) (c-guess-basic-syntax): Changed syntactic symbol c++-funcdecl-cont to ansi-funcdecl-cont * cc-mode.el (c-offsets-alist, c-read-offset, c-set-offset): Accept variable symbols as offsets. (c-get-offset): Accept ++ and -- symbols. * cc-mode.el (c-guess-basic-syntax): CASE 9C: added small performance improvment to c-in-literal call. * cc-mode.el (c-beginning-of-statement-1): Use c-in-literal-cache, and limit backscanning in CASE 5 to known, non-literal position. * cc-mode.el (c-in-literal, c-guess-basic-syntax): Caching of last literal result. * cc-mode.el (c-guess-basic-syntax): CASE 15D, calculate 'statement relpos as the beginning-of-statement relative to indent-point. * cc-mode.el (c-beginning-of-statement-1): CASE 4, check for conditional keywords which could be followed by a balanced paren expr. I.e. while(foo). * cc-mode.el (c++-mode-syntax-table, objc-mode-syntax-table): Give CR same syntax as newline, for selective-display. * cc-mode.el (c-electric-star): Fixed indentation problem when a star is not preceded by a slash. * cc-mode.el (c-indent-defun): Removed condition-case inside unwind-protect. * cc-mode.el (c-class-key, c-search-uplist-for-classkey): Greatly simplified, this constant now contains a regexp that only matches valid `class' keywords, in the C++ sense. Sun Sep 25 02:04:32 1994 Richard Stallman * info.el (Info-scroll-down, Info-scroll-up): Doc fixes. * rmail.el (rmail-forward): Simplify insertion of forwarded msg. Don't use exchange-point-and-mark. * rmail.el (rmail-msg-number-after-expunge): New function. (rmail-reply, rmail-forward): Use separate local variables rmail-send-actions-rmail-msg-number, rmail-send-actions-rmail-buffer to record which message to mark as answered or forwarded. (rmail-only-expunge): Update msg numbers stored in those variables. Sat Sep 24 21:21:26 1994 Richard Stallman * rmail.el (rmail-construct-io-menu): Don't print a message about no matching files. Sat Sep 24 06:49:42 1994 Lennart Staflin * dired.el (dired-re-perms): Accept directories and symbolic links also, not only plain files. Sat Sep 24 00:01:02 1994 Richard Stallman * buff-menu.el (Buffer-menu-delete): Handle prefix arg. (Buffer-menu-delete-backwards): Handle prefix; use Buffer-menu-delete. * dired-x.el (dired-virtual-mode): Doc fix. * sh-script.el (auto-mode-alist): Use \' in auto-mode-alist regexps. * mlsupport.el (auto-execute): Use \' in auto-mode-alist regexps. * icon.el (icon-mode): Add autoload cookie. * ada.el (ada-mode): Add autoload cookie. (auto-mode-alist): Don't alter it here. * files.el (auto-mode-alist): Handle ada-mode and icon-mode. Fri Sep 24 13:03:09 1994 Jan-Hein Buhrman (J.H.Buhrman@ns-nl.att.com) * ange-ftp.el (ange-ftp-start-process): Add use-smart-ftp code. (ange-ftp-get-process): Use ange-ftp-normal-login if ange-ftp-gateway-host is nil. Fri Sep 24 12:02:26 1994 Michael D. Ernst * simple.el (shell-command, shell-command-on-region): Make "*Shell Command Output*" non-read-only. Fri Sep 24 04:39:22 1994 Erik Naggum * comint.el (comint-input-chunk-size): Variable deleted. (comint-send-string): Make it an alias for process-send-string. (comint-send-region): Make it an alias for process-send-region. * nntp.el (nntp-send-region-to-server): Call process-send-region just once, for the whole string. * rmail.el (rmail-reformat-message): Run mail-message-filter before calling rmail-clear-headers. Fri Sep 23 20:57:05 1994 Richard Stallman * isearch.el (isearch-mode): Don't set deactivate-mark here. (isearch-done): In Transient Mark mode, don't set mark if is active. * vc.el (vc-finish-steal): Do vc-resynch-window in the right buffer. (vc-steal-lock): Delete spurious reference to `configuration'. * vc.el (vc-backend-checkout): Add if-statements to the shell cmds to discard the extra arg some shells make. Fri Sep 23 20:03:47 1994 Jonathan I. Kamens (jik@gza-client1) * files.el (find-alternate-file): Confirm killing buffer only if it is visiting a file. Fri Sep 23 13:30:10 1994 Roland McGrath * etags.el (tag-symbol-match-p): New function. (etags-recognize-tags-table): Add that second in find-tag-tag-order, after tag-exact-match-p. * etags.el (tags-table-check-computed-list): Call tags-verify-table on existing buffers. Fri Sep 23 10:08:09 1994 Boris Goldowsky * fill.el (justify-current-line): Inherit props when inserting spaces. Fri Sep 23 01:14:28 1994 Richard Stallman * vc.el (vc-rename-file): Add autoload cookie. * mail-extr.el (mail-extr-all-top-level-domains): Fix formal name of Hungary. Thu Sep 22 21:26:21 1994 Tom Tromey * add-log.el (add-change-log-entry): Set add-log-full-name and add-log-mailing-address here. (add-log-mailing-address, add-log-full-name): Initialize to nil. Thu Sep 22 15:35:40 1994 Stephen Gildea (gildea@x.org) * time-stamp.el (time-stamp-mail-host-name): Use mail-host-address. (time-stamp-mail-host): Variable deleted. Thu Sep 22 12:59:27 1994 Karl Heuer * sendmail.el (sendmail-synch-aliases): Renamed from synch-mail-aliases. All callers changed. Thu Sep 22 14:31:41 1994 Francesco Potorti` * man.el (Man-notify-method): New name for old Man-notify-flag user options. All functions using it updated. * ispell.el (check-ispell-version): Suggest to try ispell4.el if version does not match. Thu Sep 22 00:15:12 1994 Richard Stallman * faces.el (x-create-frame-with-faces): Delete the frame if get error. * rmailsum.el (rmail-summary-goto-msg): Simply the regexp for finding the message number. Check that a non-digit follows it. * help.el (print-help-return-message): Handle cons cells in special-display-regexps and special-display-buffer-names. * startup.el (mail-host-address): New variable. (normal-top-level): Use mail-host-address to init user-mail-address. * files.el (file-ownership-preserved-p): New function. Wed Sep 21 19:52:39 1994 Jonathan I. Kamens (jik@gza-client1) * rmail.el (rmail-retry-ignored-headers): New variable, specifying the headers that should be removed by rmail-retry-failure. (rmail-retry-setup-hook): Obsolete variable (see below), deleted. (rmail-clear-headers): New optional arg is list of headers to clear. (rmail-retry-failure): Copy the whole block of headers from the message and then discard those in rmail-retry-ignored-headers. Delete usage of rmail-retry-setup-hook. Bind mail-signature and mail-setup-hook to nil when composing retry buffer. Handle mail-self-blind. * vc.el (vc-steal-lock): (1) Function should be non-interactive, because it doesn't work when called directly by the user. (2) Don't display revision "nil" when stealing lock if revision is unknown. (3) Put "Stolen lock on " instead of just the file name in the Subject of the notification message. * rmail.el (rmail-ignored-headers): Add resent-message-id. * simple.el (insert-buffer): Default to first other buffer, not first non-visible buffer. Wed Sep 21 19:21:43 1994 Erik Naggum * lisp.el (insert-parentheses): Don't insert spaces at beginning and end of buffer. Wed Sep 21 10:23:57 1994 Per Abrahamsen * frame.el (special-display-popup-frame): Rename new arg to ARGS. Allow (FUNCTION OTHER-ARGS...) as the value of ARGS. * frame.el (special-display-popup-frame): New argument PARAMS. Use it as well as `special-display-frame-alist'. Wed Sep 21 14:18:37 1994 Richard Stallman * mail-extr.el (mail-extr-all-top-level-domains): Update domain list. * emerge.el (emerge-recenter, emerge-operate-on-windows): Use `visible' when calling get-buffer-window. * etags.el (find-tag-noselect): Simplify. Always run find-tag-hook at the tag's location. * sendmail.el (mail-default-reply-to): Initialize to t. (mail-setup): If it's t, set it from envvar REPLYTO. Mon Sep 19 14:08:01 1994 Francesco Potorti` * man.el (Man-notify-flag): replaces the old Man-notify variable, use the old one if it is bound as initial value. (Man-reuse-okay-flag): replaces Man-reuse-okay. (Man-downcase-section-letters-flag): replaces Man-downcase-section-letters. (Man-circular-pages-flag): replaces Man-circular-pages. (Man-auto-section-alist): variable deleted. (Man-section-translations-alist): removed the "3x" translation. (Man-untabify-command, Man-untabify-command-args): new vars. (Man-sed-command, Man-awk-command): new variables. (Man-sysv-sed-script, Man-berkeley-sed-script): new constants. (Man-name-regexp, Man-page-header-regexp): new variable. (Man-heading-regexp): changed default value. (Man-reference-regexp): now refers to previous regexps. (Man-arguments): new buffer-local variable. (Man-page-mode-string): changed default value. (Man-mode-map): changed the meanings of ",", ".", "q". Added new keys ">", "<", "k". (Man-page-mode-string): function deleted. (Man-init-defvars): New function used for initialising the system and environment dependent variables Man-fontify-manpage-flag, Man-uses-untabify, Man-sed-script, Man-filter-list. (Man-delete-trailing-newlines): function deleted. (Man-make-page-mode-string): new subst. (Man-build-man-command): now subst instead of function. Modified to comply with the new format of Man-filter-list. (Man-downcase): function deleted. (Man-translate-references): complete rewrite. (Man-linepos): function deleted. (Man-match-substring): new function. (Man-default-man-args): function deleted. (Man-default-man-entry): complete rewrite. (man, manual-entry): function-alias relationship reversed. (man): prompt changed, prompt using interactive, call Man-init-defvars, set Man-arguments. (Man-notify-when-ready): manage the 'pushy value. (Man-fontify-manpage): substitute Man-set-fonts. (Man-cleanup-manpage): new function. (Man-bgproc-sentinel): cleanup, call Man-fontify-manpage and Man-cleanup-page when necessary. (Man-mode): call Man-strip-page-headers and Man-unindent. (Man-build-section-alist, Man-build-references-alist, Man-build-page-list): substs instead of functions. (Man-build-references-alist): cleanup. (Man-build-page-list): new algorithm. (Man-strip-page-headers, Man-unindent): new substs. (Man-find-section): assume section names start in column 1. (Man-quit): bury the buffer instead of killing it, delete the frame when necessary. (Man-kill): new function. (Man-goto-page): do the right thing when the manpage is not found, do not assume that Man-build-references-alist is broken. Wed Sep 21 01:19:09 1994 Richard Stallman * menu-bar.el (vc-menu-map): New menu. (menu-bar-file-menu): Put the VC map under the File map. * vc-hooks.el (vc-menu-map): Set up menu items. * rmail.el (rmail-mode-kill-summary): New function. (rmail-variables): Put that on kill-buffer-hook locally. * subr.el (remove-hook, add-hook): Copy existing list before modifying. Tue Sep 20 19:52:20 1994 Richard Stallman * sendmail.el (mail-bury-selects-summary): New variable. (mail-bury): Test it. Tue Sep 20 16:38:28 1994 Francesco Potorti` * vc-hooks.el (vc-status): Use vc-path when calling prs. Tue Sep 20 02:34:26 1994 Richard Stallman * vc-hooks.el (vc-status): New arg vc-type. * window.el (shrink-window-if-larger-than-buffer): Use WINDOW's frame for all actions that operate on a frame. Set WINDOW to selected window if it was nil. Mon Sep 19 11:25:11 1994 Boris Goldowsky * add-log.el (add-log-current-defun): Deal with lisp-interaction-mode like lisp-mode. * facemenu.el (facemenu-update): Make menu separators all dashes. Mon Sep 19 20:59:08 1994 Richard Stallman * subr.el (add-hook): Doc fix. Mon Sep 19 13:31:16 1994 Karl Heuer * emacsbug.el (report-emacs-bug): system-configuration-options was misspelled as system-configure-options. Mon Sep 19 13:29:03 1994 Jim Blandy * disp-table.el: Add support for new window border display table element. (describe-display-table): Describe the window border glyph. (display-table-len): New constant. (make-display-table, standard-display-8bit, standard-display-default, standard-display-ascii, standard-display-g1, standard-display-graphic, standard-display-underline): Use display-table-len, instead of hard-coding the display table length. Mon Sep 19 13:19:50 1994 Francesco Potorti` * rlogin.el (rlogin): recognise the `-l user' option to rlogin and let comint and ange-ftp know about the correct home directory. Mon Sep 19 00:17:22 1994 Richard Stallman * picture.el (picture-yank-at-click): New function. * hideif.el: Handle ==, !=, + and -. (hif-tokenize): Handle ==, !=, + and -. (hif-token-regexp): Handle ==, !=, + and -. (hif-notequal, hif-plus, hif-minus, hif-mathify): New functions. (hif-math, hif-eq-expr): New functions. (hif-term): Call hif-eq-expr. (hide-ifdef-define): Pass 1 to hif-set-var. * files.el (file-name-sans-extension): New function. * files.el (basic-save-buffer-1): If writing temp file fails or a precious file, restore the old visited file modtime. * replace.el (query-replace-interactive): New user option. (query-replace-read-args): Obey that option--fetch from search-ring or regexp-search-ring. New arg regexp-flag. (query-replace, query-replace-regexp, replace-string) (replace-regexp): Pass new arg to query-replace-read-args. (map-query-replace-regexp): Obey query-replace-interactive. Sun Sep 18 15:45:40 1994 Vincent Del Vecchio (vdelvecc@dsd.camb.inmet.com) * info.el (Info-insert-dir): Insert newlines before rather than after nodes copied from other files, for consistency. Sun Sep 18 17:15:30 1994 Frederic Pierresteguy * rmail.el: Build proper keymap for the "Input (menu)" and "Output (menu)" submenus. (rmail-find-all-files, rmail-list-to-menu): New functions. (rmail-construct-io-menu): New functions. (rmail-input-menu): Function deleted. (rmail). Call rmail-construct-io-menu. (rmail-mode-map): 'Input Rmail file (menu)' renamed to 'Input Rmail file'. 'Output (Rmail menu)' renamed to 'Output Rmail file'. * rmailout.el (rmail-output-menu): Function deleted. * rmailsum.el (rmail-summary-construct-io-menu): New function. (rmail-new-summary): Call rmail-summary-construct-io-menu. (rmail-summary-mode-map): New menu items 'Input Rmail File' and 'Output Rmail File'. (rmail-summary-output-to-rmail-file): New arg 'file-name'. If it non-nil, call rmail-output-to-rmail-file. Sun Sep 18 15:07:21 1994 Richard Stallman * tex-mode.el (tex-start-shell): Inherit comint-mode-map, don't copy. * shell.el (shell-mode-map): Inherit comint-mode-map, and copy only the completion menu. * telnet.el (telnet-mode-map): Inherit comint-mode-map, don't copy. * vc-hooks.el (vc-file-not-found-hook): Use save-excursion. Sun Sep 18 22:21:53 1994 Kenneth Manheimer (klm@coil.nist.gov) * icomplete.el: Major rewrite to behave more like a minor mode. Doc fixes. (icomplete-mode): New function and var. (icomplete-minibuffer-setup-hook): New hook. (icomplete-inhibit): Defunct. Using icomplete-pre-command-hook, icomplete-post-command-hook as real hook functions. (icomplete-simple-completing-p): Subsumes icomplete-window-minibuffer-p plus other stuff, determines whether simple completion is active. (icomplete-window-minibuffer-p): Defunct, see above. (icomplete-minibuffer-setup): Use icomplete-simple-completing-p, copy-sequence hooks before adding to them, run hooks properly. (icomplete-tidy): Changed from misnamed icomplete-pre-command-hook; use icomplete-simple-completing-p. (icomplete-exhibit): Changed from misnamed icomplete-post-command-hook; use icomplete-simple-completing-p. (icomplete-completions): Changed from old, misnamed icomplete-exhibit; combined with old misnamed icomplete-prompt. Sun Sep 18 16:39:30 1994 Michael Kifer * ediff.el (ediff-submit-report, ediff-revision) (ediff-find-file-name-handler, vc-ediff-internal, rcs-ediff-internal): New functions. (ediff-version-control-package): New variable. (vc-ediff, rcs-ediff): Functions deleted. * ediff.el (ediff-submit-report): New function. * ediff.el (ediff-toggle-read-only, ediff-patch-file): Check out version controlled files before their buffers are modified. (ediff-local-checkout-flag, ediff-toggle-read-only-function): New variables. * ediff.el (ediff-find-file, ediff-patch-file): Were getting confused by symbolic links. Fixed. Sun Sep 18 13:47:14 1994 Lawrence R. Dodd * rmail.el (rmail-forward): Insert separator before and after message. Sun Sep 18 11:48:01 1994 Francesco Potorti` * vc-hooks.el (vc-status): Renamed from vc-rcs-status. Handle SCCS. (vc-display-status): Renamed from vc-rcs-status. (vc-mode-line): Call vc-status for SCCS files too. Sun Sep 18 01:05:36 1994 Richard Stallman * telnet.el (telnet): Use name *telnet-HOST*, not *HOST-telnet*. * lmenu.el (make-lucid-menu-keymap-disable): New variable. (make-lucid-menu-keymap): Use that when disabling item unconditionally. Sat Sep 17 01:14:42 1994 Richard Stallman * help.el (describe-variable): Report whether var is local in this buf. * terminal.el (terminal-map): Define switch-frame. Fri Sep 16 19:10:14 1994 Richard Stallman * facemenu.el (facemenu-update): Reverse the menu order again. * compile.el (compile-internal): Set EMACS=t in process-environment. * ispell.el (ispell-highlight-spelling-error): Test window-system. Fri Sep 16 17:40:22 1994 Karl Heuer * emacsbug.el: (report-emacs-bug): Insert configuration options. * ispell.el (ispell-menu-map): Order menu items by size: buffer > region > word. * ispell4.el (ispell-menu-map): Likewise. * register.el (insert-register): Add `*' interactive spec. * menu-bar.el (complex-buffers-menu-p): Delete; obsolete variable. * info.el (Info-edit): Move the customary mode-initialization calls out of here. (Info-edit-mode): Put them here. Also enable undo, and call Info-edit-mode-hook. * time.el: (display-time-24hr-format): Doc fix. (display-time-filter): Reenable code that got deleted during a mispatch. * sendmail.el (mail-alias-modtime): New variable. (synch-mail-aliases): New function. (mail-setup, sendmail-send-it): Synchronize cached list with file. * mailalias.el: Require sendmail. Delete redundant defvar. (expand-mail-aliases, define-mail-alias): Synchronize cached list with file. * compile.el (compilation-sentinel): Include exit status in modeline. Fri Sep 16 17:30:01 1994 Richard Stallman * dired.el (dired-buffers-for-dir): Delete debugging code. (dired-in-this-tree): Likewise. Fri Sep 16 13:16:21 1994 Michael Ernst * dired.el, dired-aux.el, dired-x.el: Make directories in dired-buffers and dired-subdir-alist be expanded; adjust calls accordingly. * dired-aux.el (dired-fun-in-all-buffers): Expand dir at start. (dired-rename-subdir, dired-rename-subdir-1, dired-kill-tree): Likewise. * dired-x.el (dired-clean-up-after-deletion): Expand fn. (dired-find-buffer-nocreate): Expand dir at beginning. * dired.el (dired-buffers-for-dir): Assume dirs are preexpanded. (dired-in-this-tree): Likewise. (dired-advertise, dired-unadvertise): Expand default-directory. Fri Sep 16 00:36:33 1994 Richard Stallman * window.el (shrink-window-if-larger-than-buffer): Do nothing in minibuffer-only frame. * menu-bar.el (menu-bar-file-menu): Rename "Kill Buffer" menu item. Thu Sep 15 17:32:37 1994 Richard Stallman * term/x-win.el (system-key-alist): Add Sun definition for mute-acute. * autoinsert.el (auto-insert-alist): Add entries for C++. (insert-auto-insert-files): Do case-sensitive match except on vms. Thu Sep 15 17:23:50 1994 Karl Heuer * simple.el (kill-new): Call menu-bar-update-yank-menu if that function is defined. New optional argument means replace most recent kill. (kill-append): Use that new interface. * mouse.el (mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new interface; don't manipulate kill-ring directly. * menu-bar.el (yank-menu): New variable; kill-ring in menu format. (menu-bar-update-yank-menu, menu-bar-select-yank): New function. Thu Sep 15 09:11:56 1994 Jay K. Adams (jka@ece.cmu.edu) * jka-compr.el (jka-compr-compression-info-list): Expand regular expressions to include backup files with version numbers. * jka-compr.el (jka-compr-insert-file-contents): Run the functions in after-insert-file-functions after the buffer-file-name has been set, not before. * jka-compr.el (jka-compr-insert-file-contents): Properly handle the 'replace' argument for compressed files. Thu Sep 15 00:17:40 1994 Richard Stallman * term/x-win.el: Don't call menu-bar-mode. * startup.el (command-line): If initial X frame has a menu bar, mark menu-bar-mode as on. * telnet.el (telnet-program): New variable. (telnet): Use telnet-program. (rsh-program): Renamed from telnet-rsh-program. (rsh): Use new name. Wed Sep 14 14:51:15 1994 Richard Stallman * page.el (forward-page): If we find a match that ends where we started searching, look for another one. * window.el (shrink-window-if-larger-than-buffer): Use frame-width, not screen-width. * startup.el (command-line): If we can't load x-win.el, terminate. * facemenu.el (facemenu-update): Don't use quoted constant lists in define-key. Reverse order of menu definitions. * autoload.el (generate-file-autoloads): Warn if we put a line in loaddefs.el that is long enough to cause trouble. * elp.el: Add autoloads. * c-mode.el (c-mode-map): Add "Highlight Conditionals" menu item. * cpp.el (cpp-highlight-buffer): Renamed from cpp-parse-buffer. Wed Sep 14 10:53:15 1994 Per Abrahamsen * cpp.el (cpp-edit-load): Only call `cpp-edit-reset' in cpp-edit-mode. Wed Sep 14 04:18:15 1994 Richard Stallman * type-break.el: New file. * cpp.el: New file. * info.el (Info-mode-map): Bind M-s like s. * ispell.el (ispell-check-only): New variable. (ispell-word): Handle ispell-check-only. (ispell-minor-mode): New variable. (ispell-minor-keymap): New map. (ispell-minor-mode): New function. * facemenu.el: New file. * elp.el: New file. Wed Sep 14 21:09:48 1994 Andreas Schwab (schwab@ls5.informatik.uni-dortmund.de) * server.el (server-start): Always use pipes for communication. Wed Sep 14 14:16:58 1994 Boris Goldowsky * simple.el (repeat-complex-command, next-history-element, previous-matching-history-element): Override print-level when offering command lines to edit. Tue Sep 13 23:18:34 1994 Karl Heuer * faces.el (make-face-unbold, make-face-unitalic, make-face-bold, make-face-italic, make-face-bold-italic): Don't try to frob font if it's nil. Sun Sep 11 14:56:01 1994 Richard Stallman * Version 19.27 released. Sun Sep 11 01:41:49 1994 Richard Stallman * ispell.el: Further split the Ispell menu autoloads. Sat Sep 10 16:37:11 1994 Richard Stallman * rmailsum.el (rmail-summary-goto-msg): Preserve the current buffer. Fri Sep 9 17:35:23 1994 Richard Stallman * window.el (shrink-window-if-larger-than-buffer): Doc fix. Thu Sep 8 19:28:02 1994 Richard Stallman * vc.el (vc-do-command): Temporarily add vc-path to the end of PATH. Thu Sep 8 13:41:12 1994 Karl Heuer * bibtex.el (put-string-on-kill-ring): Delete this function. (bibtex-current-entry-label): Call kill-new instead. Wed Sep 7 03:54:08 1994 Richard Stallman * Version 19.26 released. Tue Sep 6 16:33:01 1994 Richard Stallman * rmailmsc.el (set-rmail-inbox-list): Doc fix. Mon Sep 5 19:59:29 1994 Karl Heuer * help-macro.el (make-help-screen): Doc fix. Mon Sep 5 15:32:47 1994 Lawrence R. Dodd * dired-x.el: (dired-omit-expunge): Avoid setting buffer modified unless it was modified before and some mark is set so `%*' won't appear in mode-line of omitted buffers. Mon Sep 5 00:32:07 1994 Richard Stallman * saveplace.el (save-place-find-file-hook): Check after-find-file-from-revert-buffer. * cmacexp.el (c-macro-prompt-flag): Set default back to nil. Sun Sep 4 20:10:40 1994 Richard Stallman * rmail.el (rmail-get-new-mail): Run rmail-get-new-mail-hook. Sun Sep 4 22:03:44 1994 Tom Tromey (tromey@drip.colorado.edu) * man.el (Man-notify-when-ready): Get Man-original-frame from the proper buffer. Sat Sep 3 04:41:11 1994 Richard Stallman * simple.el (mark-ring): Add permanent-local prop. Doc fix. * shell.el (shell-command-regexp): Use a simpler faster regexp. * info.el (Info-mode): Text for using x, not for make-face defined. * mh-e.el (mh-get-new-mail): Always use mh-inc-prog, never `inc'. Fri Sep 2 20:07:38 1994 Richard Stallman * outline.el (outline-minor-mode-prefix): Doc fix. Fri Sep 2 19:11:03 1994 Espen Skoglund (espensk@tklab1.cs.uit.no) * pascal.el (pascal-auto-lineup): New variable. (pascal-end-of-statement): New function. (pascal-indent-command): Now does optional lineups of : and =. (pascal-indent-case): Uses pascal-end-of-statement to skip the case statements. Thu Sep 1 12:38:15 1994 Espen Skoglund (espensk@tklab1.cs.uit.no) * pascal.el (pascal-indent-declaration): Indent correctly when record blocks are used within parameterlists. (pascal-declaration-beg): Strange -0 argument removed. (pascal-type-completion): Fix typo in regexp. (pascal-get-lineup-indent): Use match-end instead of end-of-line. Thu Sep 1 16:43:04 1994 Richard Stallman * compile.el (grep-command): Doc fix. * tcl-mode.el: Call provide. Thu Sep 1 12:38:02 1994 Francesco Potorti` (pot@cnuce.cnr.it) * cmacexp.el (c-macro-prompt-flag): set default to t. (c-macro-expand): buffer-flush-undo is outdated. (c-macro-expansion): make exit-status a local variable. Thu Sep 1 02:12:12 1994 Richard Stallman * completion.el (completion-before-command): Don't call get on a non-symbol. Tue Aug 30 02:58:32 1994 Richard Stallman * window.el (shrink-window-if-larger-than-buffer): Don't make the window shorter than window-min-height. * calendar.el (exit-calendar): Don't restore window config. (calendar): Don't save one. * isearch.el (isearch-edit-string): Use isearch-text-char-description. * ispell.el (ispell-dictionary-alist-1): For English, remove hyphen from the OTHERCHARS. * isearch.el (isearch-edit-string): In the isearch-recursive-edit case, don't end the recursive edit and don't start another one. (isearch-done): New arg EDIT. (isearch-mode): Return t if search succeeded. Mon Aug 29 22:20:43 1994 Tom Tromey (tromey@creche.colorado.edu) * replace.el (perform-replace): Restore match data before highlighting. Mon Aug 29 20:46:14 1994 Richard Stallman * help-macro.el (make-help-screen): Don't call window-frame in a non-multi-frame Emacs. Mon Aug 29 08:43:49 1994 Lennart Staflin * diary-ins.el: Require diary-lib, not diary. * diary-lib.el: Provide diary-lib not diary. Sun Aug 28 00:14:20 1994 Richard Stallman * files.el (after-find-file-from-revert-buffer): Add defvar. * gud.el (dbx): Use newline, not semicolon, between file and stop cmds. Sat Aug 27 15:02:55 1994 Richard Stallman * outline.el (outline-mode-prefix-map): New variable. Define all the C-c commands here. (outline-mode-menu-bar-map): New variable, holds local menu-bar keymap. (outline-mode-map): Bind C-c and menu-bar to those maps. (outline-minor-mode-map): Likewise use those submaps for the prefixes. * indent.el (indent-rigidly): Insert new indent, then delete old. * comint.el (comint-arguments): Treat \n and \t like space. Fri Aug 26 02:54:44 1994 Richard Stallman * simple.el (set-mark): When POS is nil, always clear mark-active. * rmailsum.el (rmail-summary-output-menu): New command. (rmail-summary-mode-map): Add Output and Input with menu of files. Thu Aug 25 01:34:59 1994 Richard Stallman * vc.el (vc-backend-checkout): Don't use -G for SCCS. * rot13.el (toggle-rot13-mode): New function. * rmailsum.el (rmail-summary-rmail-update): Check whether rmail-buffer is dead. Wed Aug 24 21:51:39 1994 Roland McGrath * etags.el (tags-table-extend-computed-list): In loop processing list of included tables to incorporate it, advance TABLES to its cdr at end of loop. Wed Aug 24 00:48:02 1994 Richard Stallman * files.el (find-file-noselect): Improve "file changed" message. * comint.el (comint-arguments): Rewrite for speed. Don't keep parsing once we have enough args. * ispell.el (ispell-buffer-local-words): Don't treat doublequote specially when splitting the line into words. * mouse-sel.el (mouse-extend): In Transient Mark mode, use the region whenever it is active. Tue Aug 23 20:55:18 1994 Karl Heuer * simple.el (shell-command-on-region): Don't delete current buffer. Tue Aug 23 12:31:47 1994 Richard Stallman * simple.el (backward-delete-char-untabify): Doc fix. * lpr.el (lpr-headers-switches): Don't use -p on dgux, irix. * edebug.el (edebug-read-and-maybe-wrap-form): Increment max-specpdl-size by 2000. * jka-compr.el (jka-compr-insert-file-contents): Run the after-insert-file-functions. * rmail.el (rmail-ignored-headers): Split string constant into lines. Sun Aug 21 13:24:32 1994 Richard Stallman * term/news.el (news-fkey-prefix): Use kp-decimal, not kp-period. * rnews.el (news-select-message): Do most of the work even for nonexistent article. (Code copied from 18.59). Fri Aug 19 00:37:37 1994 Richard Stallman * rmail.el (rmail-retry-failure, mail-unsent-separator): Doc fix. * rnews.el (news-mode): Don't set mode-name to a list. Use mode-line-process instead. * rot13.el (rot13-other-window): Doc fix. * lpr.el (lpr-command, lpr-headers-switches): Undo previous change. Thu Aug 18 17:02:47 1994 Karl Heuer * window.el (split-window-horizontally): If size is negative, measure from the right. Wed Aug 17 16:29:27 1994 Richard Stallman * info.el (Info-mode): Doc fix. * lpr.el (lpr-command, lpr-headers-switches): Treat Solaris like BSD. * paren.el (show-paren-command-hook): Set the face of an overlay each time we move it somewhere. * files.el (after-find-file): New arg after-find-file-from-revert-buffer. (revert-buffer): Pass t for that. * simple.el (choose-completion-string): Use plain exit-minibuffer, not minibuffer-complete-and-exit. And do so only if the minibuffer was doing completion. * tex-mode.el (tex-mode): Allow for documentclass options when checking for SliTeX. Wed Aug 17 19:51:28 1994 Lawrence R. Dodd * vc.el (vc-admin): Pass nil instead of vc-checkout-writable-buffer-hook to vc-start-entry. Tue Aug 16 21:45:27 1994 Richard Stallman * perl-mode.el (perl-indent-command): Fix backwards conditional. Sun Aug 14 00:09:16 1994 Richard Stallman * rmailsum.el (rmail-summary-scroll-msg-up): Put rmail buffer on the screen if necessary--but don't scroll in that case. * rmail.el (rmail-resend): Preserve point around expand-mail-aliases. * easymenu.el (easy-menu-define): Doc fix. Sat Aug 13 13:34:59 1994 Richard Stallman * cmacexp.el (c-macro-expansion): If the CPP output is empty, just show error messages. * mouse.el (mouse-set-mark): Select the window before saving point. * iso-cvt.el (iso-tex2iso-trans-tab): Put the sequences with braces before corresponding ones without. Escape ? in patterns. (iso-translate-conventions): Don't widen. (iso-german-tex-p): Preserve narrowing. * rmail.el (rmail-maybe-display-summary): If summary is in some frame, just use that. Fri Aug 12 00:49:35 1994 Richard Stallman * rmail.el (rmail-retry-failure): Narrow to just the old header for calling mail-fetch-field. Thu Aug 11 03:10:33 1994 Richard Stallman * compile.el (compilation-set-window-height): Add save-excursion. * rmail.el (rmail-maybe-display-summary): Don't set summary window height if its frame isn't split. * subr.el (one-window-p): Doc fix. * frame.el (frame-notice-user-settings): If we change the frame's font, call frame-update-faces. Wed Aug 10 22:41:58 1994 Richard Stallman * paren.el (show-paren-command-hook): Cope if matching-paren gives nil. Wed Aug 10 19:34:45 1994 Roland McGrath * etags.el (tags-table-including): Inside loop: if CORE-ONLY skip all consecutive tables not in core; else extend computed list. Wed Aug 10 16:21:31 1994 Richard Stallman * gnus.el (gnus-summary-mode-map): Delete unusable `Sort Summary' item. Wed Aug 10 04:39:22 1994 Erik Naggum * rmail.el (rmail-forward): Anchor `mail-header-separator' on both sides to match whole line, not just initial substring. Wed Aug 10 00:07:36 1994 Richard Stallman * help.el (view-lossage): Handle buffers and frames in recent-keys. Wed Aug 10 00:48:50 1994 Michael Kifer (Michael Kifer ) * ediff.el (ediff-find-file, ediff-patch-file): Handle symlinks. * ediff.el (ediff-save-buffer): Added option for saving diff output. * ediff.el (ediff-fine-diff-buffer, ediff-ignore-similar-regions): New variables. (ediff-no-fine-diffs): Macro added. (ediff-next-difference, ediff-previous-difference) (ediff-make-fine-diffs): Enabled a new feature that allows one to skip over the difference regions where the only differences are the white space and newlines. (ediff-toggle-autorefine): Fixed a bug that caused error when the current difference is <= 0 or > ediff-number-of-differences. Tue Aug 9 19:16:26 1994 Richard Stallman * menu-bar.el (menu-bar-file-menu): Compare Files renamed to Compare. (menu-bar-ediff-menu): Add one element for compare-windows. * appt.el: Require calendar. Tue Aug 9 14:49:17 1994 Michael D. Ernst * rmailedit.el (rmail-abort-edit): Call `rmail-highlight-headers'. Tue Aug 9 01:41:58 1994 Richard Stallman * mailalias.el (define-mail-alias): Avoid error if DEFINITION is "". * appt.el (appt-check): Update on first wakeup after midnight even if that's not precisely 12:01. Mon Aug 8 00:38:11 1994 Richard Stallman * mouse.el (mouse-drag-mode-line): New function (from mldrag.el, but changed a little). Put it on mode-line down-mouse-1. (mouse-select-window): Bind to mode-line drag-mouse-1. * info.el (Info-last-menu-item): Fix gross logic errors. (Info-last-preorder): After going thru menu item, go to end. (Info-scroll-up): Set window-start if it's out of range. Once menu start is on or above screen, start using menu items. (Info-scroll-down): Set window-start if it's out of range. If there's a menu item, always use menu. * sendmail.el (mail-alias-file): Add autoload cookie. * mouse.el (x-fixed-font-alist): Add clean 5x8 and clean 6x8. * compile.el (compilation-set-window-height): New function, broken out from compile-internal. Don't change window height if it is the frame root window. (compile-internal): Call it. (compilation-goto-locus): Call it. Use any visible frame already showing the compilation buffer. * gnus.el (gnus-start-news-server): Fix the call to `error'. Sun Aug 7 02:47:33 1994 Richard Stallman * info.el (Info-additional-directory-list): New variable. (Info-find-node): Use it. * faces.el (copy-face): Ignore errors in set-face-font. * mouse.el (mouse-choose-completion): Pass completion-base-size value to choose-completion-string. * simple.el (completion-base-size): New variable. (completion-list-mode): Make it local. (choose-completion): Pass its value to choose-completion-string. (choose-completion-string): New arg base-size. Use that when deciding how much to delete. * complete.el (PC-do-completion): Set completion-base-size. * cmacexp.el: Doc fixes. (c-macro-expansion): Capture and display CPP error messages. * tex-mode.el (tex-mode): Accept documentclass when checking Slitex. Sat Aug 6 00:45:19 1994 Richard Stallman * gnus.el: Require timezone when loading this file. Move the provide call to the end. * c-mode.el (indent-c-exp): Preserve point when handling comments. * byte-opt.el (byte-after-unbind-ops): Fix paren error wrt doc string. * font-lock.el (font-lock-hack-keywords): Delete debugging code. Fri Aug 5 12:46:53 1994 Erik Naggum * simple.el (choose-completion): Bury or iconify the completion list using code copied from mouse-choose-completion. Fri Aug 5 22:58:12 1994 Richard Stallman * tex-mode.el (tex-mode): Check for documentclass like documentstyle. * info.el (Info-directory-list): Doc fix. Fri Aug 5 03:53:56 1994 Erik Naggum * files.el (save-buffer): Unconditionally make a backup with 2 or 3 C-u's even if make-backup-files is nil. Fri Aug 5 14:56:12 1994 Richard Stallman * mouse.el (x-fixed-font-alist): Regularize how fonts are specified. * time.el (display-time-filter): pm starts at 12, not 13. Fri Aug 5 03:42:04 1994 Hans Chalupsky (hans@hydra.cs.Buffalo.EDU) * advice.el (ad-subr-arglist): Adapted to new DOC file format. Fri Aug 5 00:27:57 1994 Richard Stallman * etags.el (select-tags-table): Doc fix. * font-lock.el (font-lock-syntax-table): New syntax table. (font-lock-hack-keywords): Use it temporarily here. (font-lock-set-defaults): Set up special syntax table for C and C++. Thu Aug 4 01:43:39 1994 Richard Stallman * isearch.el (isearch-mode-map): Delete mouse-2, down-mouse-2 bindings. * rmail.el (rmail-select-summary): Preserve rmail buffer's value of rmail-total-messages even while summary buffer is current. * gnus.el: Doc fixes. * frame.el (frame-delete-all): Copy the whole alist first. * hilit19.el (hilit-find-file-hook): Preserve buffer modified state. * simple.el (end-of-buffer-other-window): Go to the end, not to the beginning. * appt.el (appt-make-list): Do nothing unless range being processed for diary entries includes today's date. Wed Aug 3 23:27:05 1994 Hans Chalupsky (hans@hydra.cs.Buffalo.EDU) * bytecomp.el (byte-compile-protect-from-advice): Macro deleted. (byte-compile-from-buffer, byte-compile-top-level): Don't use it. * advice.el: New handling of automatic advice activation that exploits modified built-in versions of `fset' and `defalias' which take care of this functionality directly: (ad-start-advice-on-load, ad-activate-on-definition) (ad-definition-hooks, ad-enable-definition-hooks, ad-defined-function) (ad-advised-definers, ad-advised-byte-compilers, byte-constant) (byte-constant-limit, byte-constant2, byte-fset) (ad-byte-code-fset-regexp): Variables deleted. (ad-activate-defined-function, ad-find-fset-in-byte-code) (ad-scan-byte-code-for-fsets, ad-advised-byte-code) (ad-recover-byte-code, ad-enable-definition-hooks) (ad-disable-definition-hooks): Functions deleted. (defun, defmacro, fset, defalias, define-function) (byte-compile-from-buffer, byte-compile-top-level): Removed `defadvice' for these functions. (ad-save-real-definitions): Removed saving of `byte-code'. (ad-activate-off): New dummy function. (ad-activate-on): New name for `ad-activate'. All calls changed. (ad-with-auto-activation-disabled): New macro prevents automatic advice activation. (ad-safe-fset): New function, used instead of `ad-real-fset'. (ad-compile-function): Disable automatic advice activation while compiling, because `byte-compile' uses `fset'. (ad-activate-on): Renamed from `ad-activate'. Avoid recursive calls. (ad-activate-on-top-level): New variable. (ad-start-advice, ad-stop-advice, ad-recover-normality): Modified to achieve de/activation of automatic advice activation by setting the definition of `ad-activate' to `ad-activate-on' or `ad-activate-off'. (ad-start-advice): Is now called unconditionally when Advice is loaded. Made compilation behavior of advised definitions customizable, since loading the byte-compiler takes some time and is not always worth the cost, e.g., if one only wants to make a few simple modifications: (ad-default-compilation-action): New variable which specifies whether to compile an advised definition in case the COMPILE argument to `ad-activate-on' or one of its friends was supplied as nil. (ad-preactivate-advice): Supply negative COMPILE argument to prevent compilation. (ad-should-compile): New function. (ad-activate-advised-definition): Use `ad-should-compile' to determine whether an advised definition should get compiled. (ad-activate-on, ad-update, ad-activate-regexp, ad-update-regexp) (ad-activate-all): Doc fixes. (ad-update): Leave handling of COMPILE up to `ad-activate-on'. Extracted construction of freeze-advices from `defadvice': (ad-make-freeze-definition): New function. (defadvice): Use `ad-make-freeze-definition' to construct frozen defs. Wed Aug 3 16:41:06 1994 Richard Stallman * gnus.el (gnus-kill-files-directory): New variable. (gnus-Newsgroup-kill-file, gnus-newsgroup-kill-file): Use it. * dired.el (dired-mode): Put expanded name in list-buffers-directory. * icomplete.el (icomplete-prime-minibuffer): Copy the hook lists after making them local. * gnus.el (gnus): Require timezone. Delete timezone autoloads. * iso-cvt.el (iso-fix-iso2tex, iso-fix-tex2iso): Check plain-text-mode. Tue Aug 2 22:17:21 1994 Karl Heuer * sh-script.el (auto-mode-alist): Fix typos in comments. Tue Aug 2 17:58:24 1994 Richard Stallman * mouse.el: Capitalize some error messages. (mouse-set-point): Nice error if button release is in scrollbar. Tue Aug 2 11:43:33 1994 Frederic Pierresteguy (F.Pierresteguy@frcl.bull.fr) * compile.el: Set up a "Compile" menubar item. (recompile): New function. (previous-error): New function. (first-error): New function. Tue Aug 2 00:57:41 1994 Richard Stallman * frame.el (frame-delete-all): New function. (frame-notice-user-settings): Call it--with or without separate minibuffer frame. Mon Aug 1 00:40:54 1994 Richard Stallman * rmailsum.el (rmail-summary-mode-map): Fix the Get New Mail entry. Fix typo. Add `...' where appropriate. * rmail.el (rmail-mode-map): Fix the Get New Mail entry. Add `...' where appropriate. * ediff.el (ediff-version): Function, variable deleted. (ediff-date): Var deleted. (ediff-status-info): Don't call ediff-version. * dired.el (dired-insert-directory): Call expand-file-name here because the dir name may have been abbreviated before. Sun Jul 31 21:25:27 1994 Morten Welinder (terra@diku.dk) * ls-lisp.el (insert-directory): Gracefully handle the case where a file disappears between it is listed in the directory and the attributes are requested. Sun Jul 31 01:30:57 1994 Richard Stallman * compile.el (compilation-error-regexp-alist): Fix previous change. Add alternatives for GNU error messages with program name in them. * time.el (display-time-string-forms): New variable. (display-time-filter): Simplify to use it. * dired.el (dired-noselect): Call abbreviate-file-name here. (dired-internal-noselect): Not here. * comint.el (comint-password-prompt-regexp): Handle PGP prompt. * gnus.el (gnus-sortable-date): Use timezone-make-time-string. * rmail.el (rmail-retry-failure): Handle a weird case with a couple of lines before the old message header. * compile.el (compilation-error-regexp-alist): Make separate regexp for Borland C++; the combined one matched too much. * ange-ftp.el (ange-ftp-parse-netrc-group): Don't move back to line beginning. Skip the machine name whatever it may be. (ange-ftp-parse-netrc): Skip initial whitespace. * sendmail.el (sendmail-send-it): Handle resent-to specially. * mouse-sel.el (mouse-extend): Pass WINDOW arg to mouse-scroll-subr. * rmailsum.el (rmail-summary-mode-map): Add Get New Mail item. Move new Re-send menu item to right place. * rmail.el (rmail-mode-map): Move new Re-send menu item to right place. Sat Jul 30 17:19:59 1994 Richard Stallman * hilit19.el: Specify patterns for objc-mode. Sat Jul 30 08:55:26 1994 Martin Boyer * menu-bar.el (menu-bar-enable-clipboard): Moved here the clipboard function key bindings. Sat Jul 30 13:47:16 1994 Michael D. Ernst * ispell.el (ispell-message-text-end): Improve context diff regexp. Sat Jul 30 03:43:09 1994 Richard Stallman * rmailsum.el (rmail-new-summary): If just one window, put the summary in the upper window and Rmail buffer below. Sat Jul 30 11:34:43 1994 Ake Stenhoff (etxaksf@aom.ericsson.se) * imenu.el (imenu, imenu--flatten-index-alist): Add marker support. (imenu--cleanup): New function. (imenu-example--name-and-position): Now uses markers. * imenu.el (imenu-add-to-menubar): New function to add an entry to the menubar for the buffer's current local keymap. Fri Jul 29 15:59:47 1994 Richard Stallman * rmail.el (rmail-highlight-face): New variable. (rmail-highlight-headers): Use it if non-nil. * gnus.el (gnus-group-suspend): Be sure to bury the right buffer. * hideif.el (hide-ifdefs): Doc fix. Fri Jul 29 14:52:10 1994 Frederic Pierresteguy (F.Pierresteguy@frcl.bull.fr) * rmail.el (rmail-display-summary): New variable. (rmail): Call rmail-summary at the end if rmail-display-summary is set. * rmail.el (rmail-mode-map): Add Re-send menu item. * rmailsum.el (rmail-summary-mode-map): Add Re-send menu item. Thu Jul 28 20:44:04 1994 Andreas Schwab * simple.el (choose-completion): Check for next-single-property-change returning nil. * mouse.el (mouse-choose-completion): Dito. Thu Jul 28 02:22:24 1994 Richard Stallman * files.el (file-truename): Temporarily get rid of the ange-ftp completion handler. * info.el (Info-find-node): Use a loop instead of mapcar and catch. * buff-menu.el (buffer-menu): Undo previous change. Instead, save the point value that list-buffers set up and go back there after switching windows. Wed Jul 27 13:49:32 1994 Richard Stallman * faces.el (face-initialize): Use underlining for region face if there's no gray. (face-try-color-list): Support `underline' in color list. * fill.el (justify-current-line): Delete space at end of line. * files.el (set-auto-mode): Shorten scope of case-fold-search binding. * files.el (cd-absolute): Call file-name-as-directory first thing. * compile.el (compilation-error-regexp-alist): Fix bug in Borland C++ change. Make first regexp reject cases that give column numbers. Add new regexp for GNU format with column numbers. Tue Jul 26 11:51:32 1994 Richard Stallman * mail-extr.el (what-domain): Doc fix. * files.el (basic-save-buffer-1): Ignore file-precious-flag if the file's dir is not writable. * forms.el (forms--update): Undo change made mistakenly. * vc.el (vc-next-action): Even in 1-file case, get its name from FILES. (vc-finish-logentry): Don't do vc-buffer-sync on the parent buffer when hat parent buffer is a dired buffer. * menu-bar.el (menu-bar-update-buffers): Use (current-global-map), not global-map. * compile.el (compilation-next-error-locus): New arg SILENT. * dissociate.el (dissociated-press): Error at start if buffer is empty. * ediff.el: Made menu bar's autoloaded stuff conditional on purify-flag, to avoid error message when loading ediff in a frame that has no menu bar. Tue Jul 26 16:24:25 1994 Michael Kifer (kifer@sbkifer) * ediff.el (ediff-setup): Improved mode-line-buffer-identification. Now accommodates buffer identifications generated by mode-line.el and uniquify.el. * ediff.el (ediff-current-diff-face-A/B, ediff-fine-diff-face-A/B,ediff-odd/even-diff-face-A/B): Variables changed to contain face names instead of face internal representation. Mon Jul 25 20:55:46 1994 Johan Vromans (jv@squirrel.NL.net) * forms.el (forms-read-file-filter): new hook function to preprocess file contents before being passed to forms mode. (forms-write-file-filter): new hook function to preprocess file contents before it is being saved to disk. Can be used to undo the effects of `forms-read-file-filter'. (forms-mode): Supply a default format if no `forms-format-list' was specified. Preprocess file contents using `forms-read-file-filter' and attach `forms-write-file-filter' to the `local-write-file-hooks' of the file buffer. Present a friendly message if the visited file is empty or new. (forms--intuit-from-file): New subroutine to get the number of fields from the data file; constructs a default format list. (forms-save-buffer): Forms mode wrapper for `save-buffer'. (forms--change-commands, forms--exit): Use it. (forms--update): Check for the presence of the field separator in any of the fields. Refuse update if found. (forms-delete-record): Allow the last record of the file to be deleted, even if not terminated by a newline. (forms--local-write-file-function): Remove. Didn't do any good. Replaced by `forms-save-buffer'. * forms-d2.el: Use `forms-new-record-filter' variable instead of defining the function. Mon Jul 25 17:45:22 1994 Richard Stallman * startup.el (command-line-args-left): Add defvar. Sun Jul 24 22:16:58 1994 Andreas Schwab * comint.el (comint-dynamic-list-completions): Listify the key sequence to be put back. Sun Jul 24 15:57:12 1994 Richard Stallman * lisp-mode.el (emacs-lisp-mode-syntax-table): Give RET the same syntax as newline. * cplus-md.el (c++-mode-syntax-table): Likewise. * vc.el (vc-finish-logentry): Use vc-parent-buffer to find the buffer to offer to save. * gud.el (dbx): Use system-configuration, not system-type. Sun Jul 24 01:53:22 1994 Erik Naggum * dired.el (dired-internal-noselect): a zero modtime means directory is unchanged. Sat Jul 23 17:11:48 1994 David Robinson (drtr@mail.ast.cam.ac.uk) * term/x-win.el (system-key-alist): Add Sun-specific X11R6 keysyms. * menu-bar.el: Add to global key map for cut, paste & copy keys. Sun Jul 24 01:30:54 1994 Richard Stallman * mail-extr.el (mail-extr-all-top-level-domains): Update a few long names. * menu-bar.el (menu-bar-update-buffers): If Buffers item is gone, don't bring it back. Sat Jul 23 21:07:03 1994 Richard Stallman * ispell4.el (ispell-tex-buffer-p): Write names in lower case. Add slitex-mode. * simple.el (line-move, next-line): Check last line moved over has a newline, in a way that intangible text does not confuse. Sat Jul 23 14:18:38 1994 enami tsugutomo * lisp/add-log.el (add-log-current-defun): Skip doc string correctly even if it ends with line that starts space. Fri Jul 22 16:43:48 1994 Ed Reingold * cal-menu.el (calendar-mode-map): Change reference from renamed calendar-current-month to calendar-goto-today. Wed Jul 20 15:24:52 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired.el (dired-between-files): Ignore dired-subdir-regexp if we can move to the file name on the line. * dired.el (dired-internal-noselect): Don't revert, just suggest `g'. Wed Jul 20 22:23:29 1994 Ethan Bradford (ethanb@ptolemy.astro.washington.edu) * ispell.el (ispell-command-loop, ispell-region, ispell-word): Only pop up the choices window if an error is found in the region. Don't change the size of the choices window except as needed. Don't (sit-for 0) at the start of ispell-region (i.e. don't force redisplay at the start of the region). (ispell-overlay-window): Small documentation fix. Wed Jul 20 10:02:57 1994 Roland McGrath * etags.el (visit-tags-table-buffer): Bind a variable local-tags-file-name with the value of tags-file-name before calling tags-verify-table, which switches buffers; change all references to use local-tags-file-name. Save current buffer before that call and on error, switch back before killing local value of tags-file-name. Wed Jul 20 00:08:39 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * imenu.el (imenu-choose-buffer-index): Use last-nonmenu-event to decide on mouse vs non-mouse. (imenu-progress-message): New arg prevpos. All callers changed. Don't print messages too frequently. * byte-opt.el (byte-decompile-bytecode-1): Don't add pc values if make-spliceable is non-nil. (Arg renamed from make-splicable.) * disass.el (disassemble-1): Display the pc values. (disassemble-column-1-indent): Increase to 8. * byte-opt.el (byte-decompile-bytecode-1): Put a pc value before each insn in the list we return. Tue Jul 19 16:00:10 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ediff.el (Emacs 19 menu setup): Move back to top level and do it only if purify-flag. * vc.el: At compile time, require dired. (vc-finish-logentry): Use the proper files buffer for vc-buffer-sync. * compile.el (compilation-error-regexp-alist): Allow `(' after linenum in "FILE", line LINENUM. Add backslash so C-M-a works. Tue Jul 19 02:38:56 1994 Michael Kifer (kifer@cs.sunysb.edu) * ediff.el (ediff-find-file, ediff-files-internal, ediff-patch-file): Modified to work with remote and compressed files. * ediff.el (ediff-read-file-name, ediff-buffers): Better defaults. (ediff-read-file-name) Handle OS/2. * ediff.el (ediff-forward-word-function) New function. (ediff-wordify-function): Variable deleted. (ediff-toggle-regexp-match, ediff-hide-regexp-matches): New functions. (ediff-focus-on-regexp-matches): New function. (ediff-status-info): New function. (ediff-file-names, ediff-line-numbers): Functions deleted. Mon Jul 18 14:03:30 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mh-e.el (mh-folder-mode): Use local-write-file-hooks. Mon Jul 18 09:39:49 1994 Barry A. Warsaw (warsaw@anthem.nlm.nih.gov) * reporter.el (reporter-dump-state, reporter-submit-bug-report): Don't print package name if pkgname is nil. Don't dump state if varlist is nil. * reporter.el (reporter-bug-hook, reporter-submit-bug-report) (reporter-calculate-separator, reporter-initial-text): New or modified functions and variables attempting to prohibit submission of empty bug reporters. * reporter.el: (reporter-prompt-for-summary-p): Default value now nil. * reporter.el (reporter-dump-state): Make sure there's a final newline after the setq sexp. Pass mail buffer as second arg to print fcn. Use symbol-value to get varsym's value. * reporter.el (reporter-dump-variable): Handle long sexp's even after entering newline. Done by filling current line. Much better pretty printing of long lists!! Handle void variables. * reporter.el (reporter-version): New variable. * reporter.el (reporter-submit-bug-report-internal): Leave point after the salutation. * reporter.el (reporter-submit-bug-report): Prompt for a subject. Mon Jul 18 03:26:04 1994 Karl Fogel (kfogel@phylo.life.uiuc.edu) * mail-hist.el: Make sure that headers are case-insensitive. Upped version to 1.3. Sun Jul 17 19:55:40 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * forms.el (forms-delete-record): Handle deletion of last line when it has no terminating newline. Sat Jul 16 15:29:29 1994 Richard Stallman * mouse.el ([vertical-line C-mouse-2]): Bind it as in a scroll bar. * comint.el (comint-mode-map): Move comint-bol to C-c C-a. * calendar.el (calendar-goto-today): Renamed from calendar-current-month. * add-log.el (add-change-log-entry): Use <...> around mail address. * help.el (print-help-return-message): If help buffer is a special display buffer, say nothing about how to switch back. * help-macro.el (make-help-screen): Handle case where *Help* comes up in a separate frame. Fri Jul 15 00:30:53 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sh-script.el: "Comment out" autoload cookies. * mouse.el (mouse-drag-region): Delete redundant switch-frame clause. (mouse-drag-secondary): Likewise. * sendmail.el (mail-mailer-swallows-blank-line): Verify sendmail.cf exists before reading it. Thu Jul 14 18:48:16 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (rmail-output-file-alist): Mark it risky. Wed Jul 13 18:56:52 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * help-macro.el (make-help-screen): Bind overriding-local-map just for short sections of code. Wed Jul 13 13:19:39 1994 Noah Friedman (friedman@prep.ai.mit.edu) * rsz-mini.el: (resize-minibuffer-setup): Copy post-command-hook when handling minibuffer windows in other frames, not just minibuffer-exclusive frames. Resize the minibuffer window/frame now, in case it has already been initialized with text. Wed Jul 13 11:14:15 1994 Ed Reingold (reingold@albert.gnu.ai.mit.edu) * diary-lib.el: Correct file name on last line of file. Wed Jul 13 00:02:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-movemail-program): New variable. (rmail-insert-inbox-text): Use it. * files.el (insert-directory): Fix previous change. Tue Jul 12 08:14:43 1994 enami tsugutomo (enami@sys.ptg.sony.co.jp) * vc.el (vc-finish-logentry): Use the value of vc-log-after-operation-hook of *VC-log* buffer instead of vc-parent-buffer. Tue Jul 12 00:08:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-mode-map): Fix previous change. * menu-bar.el (menu-bar-file-menu): Add insert-file menu item. * gnus.el: Clean up menu item string format. Add a few menu items and separators. (gnus-mouse-pick-group): New function, on mouse-2 in Group mode. (gnus-mouse-pick-article): New function, on mouse-2 in Summary mode. * rsz-mini.el (resize-minibuffer-setup): Copy the value of post-command-hook. * mouse-sel.el: Many doc fixes. (mouse-extend): Don't use existing region if EVENT is nil. * mouse.el (mouse-drag-secondary): Don't start making an overlay when the range is empty. (mouse-secondary-save-then-kill): The first time, make a new kill ring entry. * ispell4.el (ispell-word): Call ispell-dehighlight. * files.el (insert-directory): Fix prev change. * rmail.el (rmail-mode-map): Add "Get New Mail" menu item under Mail. * compile.el (compilation-next-error-locus): Don't call compilation-forget-errors if compilation is still runing. Mon Jul 11 08:28:42 1994 Erik Naggum (erik@naggum.no) * buff-menu.el (buffer-menu): Call pop-to-buffer before list-buffers. Don't move point afterwards. Mon Jul 11 20:40:45 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * prolog.el (prolog-mode-syntax-table): Make newline end comments. * sendmail.el (mail-setup): Insert -- line before .signature file. * dired-aux.el (dired-byte-compile): Use byte-compile-dest-file to get the output file name. * subr.el (ignore): Put doc string in right place. * indent.el (move-to-tab-stop): Delete spurious multiple definition. Mon Jul 11 09:19:55 1994 Kevin Rodgers * mailabbrev.el (define-mail-abbrev): Don't try to parse empty aliases. Mon Jul 11 20:41:50 1994 Andreas Schwab (schwab@ls5.informatik.uni-dortmund.de) * backquote.el (backquote-splice-symbol): Doc typo fix. * edebug.el (edebug-install-read-eval-functions): Fix test for edebug-read already installed. * hexl.el (hexl-maybe-dehexlify-buffer): New function. (hexl-mode): Add it to change-major-mode-hook. (hexl-mode-exit): Remove kludge for mode-line update. (hexlify-buffer): Doc fix. Mon Jul 11 00:30:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (insert-directory): Allow list for SWITCHES. Also split up a string containing separate options. * lisp.el (lisp-complete-symbol): Bind completion-fixup-function. * mouse.el (mouse-choose-completion): Use mouse-face properties to find string to use. * simple.el (completion-setup-function): Put on mouse-face prop even if no window-system. Call completion-fixup-function if not nil. (completion-fixup-function): New variable. (choose-completion): Use mouse-face properties to find string to use. * server.el (server-start): Try both possible socket file names for the file to delete. * mouse.el (x-fixed-font-alist): Add 8x13. Don't specify 75-75 for 7x13, 7x14. * diff.el (diff-latest-backup-file): Cope with backups stored in a different directory. Sun Jul 10 17:32:27 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * etags.el (find-tag-regexp): Bind to C-M-.. Sun Jul 10 13:01:06 1994 Erik Naggum (erik@naggum.no) * buff-menu.el (Buffer-menu-not-modified): Make `Buffer-menu-not-modified' handle an argument like `not-modified'. * info.el (Info-fontify-maximum-menu-size): New variable. (Info-fontify-node): Use that variable. Sat Jul 9 00:15:40 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * faces.el (x-create-frame-with-faces): Don't downcase nil. * loadup.el (current-load-list): Set it to nil. * compile.el (compilation-window-height): Use defvar. (compilation-leave-directory-regexp): Likewise. (compilation-enter-directory-regexp): Likewise. * loadup.el: If have frames, load `faces'. * man.el (Man-bgproc-sentinel): Bind case-fold-search for just the necessary parts of the function, not the call to Man-notify-when-ready. Fri Jul 8 17:26:21 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (hack-one-local-variable): Check for root using user-uid. Thu Jul 7 00:42:03 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (outline-level): Mark it risky. * version.el (emacs-version): Avoid unnecessary recursive call. * mouse.el ([vertical-scroll-bar C-mouse-2]): Split the window. * version.el (emacs-version): Check x-toolkit with featurep. * gud.el (gud-mips-p): Check for OSF system on Alpha also. * files.el (process-environment, exec-path, load-path,exec-directory): Mark these as risky. (hack-one-local-variable): Treat vars ending in -program and -command as risky. * version.el (emacs-version): Indicate x toolkit usage in value. * files.el (switch-to-buffer-other-frame): Raise the frame. Wed Jul 6 21:32:45 1994 Michael I Bushnell (mib@churchy.gnu.ai.mit.edu) * gnus.el (gnus-summary-show-all-threads): Undo previous change. (gnus-summary-show-thread, gnus-summary-hide-all-threads) (gnus-summary-hide-thread): Likewise. Wed Jul 6 17:27:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buff-menu.el (Buffer-menu-revert-function): New function. (Buffer-menu-mode): Use it, for revert-buffer-function. (Buffer-menu-mode-map): Bind revert-buffer. * files.el (revert-buffer-function): Doc fix. * vc.el (vc-start-entry): New arg after-hook. Set vc-log-operation-hook locally. (vc-next-action-on-file): Not here. (vc-admin): Pass new arg. (vc-checkin): Pass new arg instead of setting vc-log-operation-hook. * files.el (auto-save-mode): If autosave is off because buffer has shrunk, then toggling should turn it on. * tpu-edt.el (tpu-save-all-buffers-kill-emacs): Use delete-old-versions, and bind it locally. * completion.el (save-completions-to-file): Use delete-old-versions. * files.el (delete-old-versions): Var renamed from trim-versions-without-asking. Wed Jul 6 16:25:29 1994 Ed Reingold (reingold@albert.gnu.ai.mit.edu) * diary-lib.el (fancy-diary-display): Consistently turn off selective display in diary buffer before doing anything. Wed Jul 6 16:10:27 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * outline.el (outline-next-preface): Undo previous change: Do stop before final newline. Wed Jul 6 13:56:23 1994 Morten Welinder (terra@tyr.diku.dk) * desktop.el (desktop-buffer-rmail): Handle the situation where the RMAIL file is locked, mail is waiting, and the user selects `quit' gracefully. Tue Jul 5 18:36:27 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (set-visited-file-name): Avoid crash if TRUENAME is nil. Tue Jul 5 17:52:48 1994 Michael I Bushnell (mib@churchy.gnu.ai.mit.edu) * sendmail.el (mail): Commented out buggy call to set-visited-file-name. (It pukes on a nil argument.) Tue Jul 5 14:31:57 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gnusmail.el (gnus-mail-reply-using-mhe): Handle case of no subject. * faces.el (x-create-frame-with-faces): Ignore case in X resource. (make-face-x-resource-internal): Test underline attribute as boolean. * files.el (file-truename): Use iteration when possible. Avoid recalculating the same truename twice in one invocation. Error check for infinite link loop. * files.el (debugger): Mark it a risky-local-variable. * startup.el (command-line): Check LC_ALL and LANG as well as LC_CTYPE. (iso-8859-1-locale-regexp): Don't check for `iso'. * paths.el (rmail-spool-directory): Use /var/mail if it exists. Tue Jul 5 11:44:59 1994 Ed Reingold (reingold@albert.gnu.ai.mit.edu) * calendar.el (generate-calendar-month): Make highlighted text for mouse-2 a one character wide for single-digit dates (this undoes the incorrect fix of May 30, 1994). Mon Jul 4 19:23:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * paths.el (rmail-spool-directory): Use /var/mail for bsd386. * startup.el (iso-8859-1-locale-regexp): New variable. (command-line): Use it. Mon Jul 4 16:58:45 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * add-log.el (add-change-log-entry): Apply expand-file-name to FILE-NAME. Sun Jul 3 20:47:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-drag-region): Bind this-command like last-command. (mouse-kill-ring-save): Bind this-command and last-command. Sun Jul 3 15:05:04 1994 Richard Stallman (rms@gnu.ai.mit.edu) * startup.el (command-line): Accept iso-8859-1 like iso_8859_1. * sendmail.el (sendmail-send-it): Allow specifying Sender. * emacsbug.el (report-emacs-bug-hook): Error if user has added no text. (report-emacs-bug): Set local report-emacs-bug-orig-text. Add to mail-send-hook. Use mail-send-and-exit for the echo area msg. * frame.el (initial-frame-alist): Doc fix. * startup.el (command-line): Automatically use iso-syntax and standard-display-european if LC_CTYPE asks for it. Sun Jul 3 09:30:57 1994 Ethan Bradford (ethanb@ptolemy.astro.washington.edu) * gnuspost.el (gnus-inews-news): Allow newsgroups to be separated by spaces or commas and spaces. Set Jul 2 23:00:53 1994 Morten Welinder (terra@diku.dk) * meese.el: Use add-hook, (provide 'meese). (protect-innocence-hook): compare expanded file names for the sake of non-unix file systems. Use expand-file-name instead of concat to create "celibacy.1" file name. Check that the "sex.6" exists. Sat Jul 2 00:48:54 1994 Richard Stallman (rms@gnu.ai.mit.edu) * ebuff-menu.el (electric-buffer-list): Change prompt message. (electric-buffer-menu-mode-map): Define C-m like space. * sh-script.el (sh-chmod-argument): Change default. * vc.el (vc-update-change-log): Pass a -n option to rcs2log. Fri Jul 1 12:27:28 1994 Richard Stallman (rms@gnu.ai.mit.edu) * mouse.el (mouse-scroll-subr): Delete some debugging code. * etags.el (visit-tags-table-buffer): Move error call into scope of `file'. * bytecomp.el (byte-compile-defalias): Fix typo in prev change. * bytecomp.el (byte-compile-callargs-warn): Handle function defnition that is not a lambda expression or byte code function. (byte-compile-arglist-warn): Likewise. (byte-compile-defalias): New function, used to compile defalias. (byte-compile-defalias-warn): New function. * lpr.el (print-region-1): Essentially undo previous change. * files.el (set-visited-file-name): Handle find-file-visit-truename early on, before we deal with lock files. * gnuspost.el (gnus-inews-domain-name): Once again test gnus-your-domain. * shell.el (shell-mode): Don't read history from /dev/null. * faces.el (make-face-italic, make-face-bold): Don't bind f2 here. (make-face-bold-internal, make-face-italic-internal): Bind f2 here. (make-face-bold-italic-internal, make-face-italic-internal) (make-face-bold-internal): New arg `font'. Callers changed. * loadhist.el (unload-feature): The autoload property does not start with `autoload'. * faces.el (list-faces-display): Line up multiple lines in sample. * sh-script.el (sh-set-shell): Obey sh-query-for-magic in all cases. Thu Jun 30 23:49:08 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tcl-mode.el (tcl-mode): Fix regexp to avoid nested loop. Thu Jun 30 14:56:58 1994 Richard Stallman (rms@gnu.ai.mit.edu) * hideif.el (minor-mode-map-alist): Add missing quote. * rmail.el (rmail-highlight-headers): Do nothing if rmail-highlighted-headers is nil. Thu Jun 30 02:37:55 1994 Noah Friedman (friedman@prep.ai.mit.edu) * rsz-mini.el (resize-minibuffer-window-restore): Don't do anything if the window height is already 1. Thu Jun 30 00:40:42 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-drag-secondary): Don't treat end of buffer specially when within the window. Wed Jun 29 14:21:50 1994 Noah Friedman (friedman@prep.ai.mit.edu) * comint.el (comint-password-prompt-regexp): New variable. (comint-watch-for-password-prompt): Use it. Wed Jun 29 12:27:55 1994 Richard Stallman (rms@gnu.ai.mit.edu) * easymenu.el (easy-menu-change): New function. Tue Jun 28 16:21:58 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (tag-exact-match-p): Test for point sitting after the explicit tag name itself. Tue Jun 28 08:25:30 1994 enami tsugutomo (enami@sys.ptg.sony.co.jp) * simple.el (line-move): Don't use message or ding; just signal errors. Tue Jun 28 10:12:51 1994 Lawrence R. Dodd (dodd@roebling.poly.edu) * dired-x.el (dired-x-hands-off-my-keys): New user-defined variable. (dired-x-bind-find-file): Use it. (dired-x-find-file): New function to substitute find-file. (dired-x-find-file-other-window): New function to substitute find-file-other-window. Tue Jun 28 00:14:23 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.el (auto-lower-mode, auto-raise-mode): Doc fixes. * info.el (Info-index): Fix typo: t => \t. Mon Jun 27 16:52:57 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sh-script.el (sh-mode): Don't move point permanently. * info.el (Info-insert-dir): Capitalize `node' when inserting it. (Info-search): Don't move point to beginning, after Info-read-subfile. Sat Jun 25 00:30:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-scroll-subr): Don't do anything special at eob. (mouse-drag-region): Don't treat scrolling differently at eob. (mouse-drag-secondary): Likewise. * comint.el (comint-send-input): Update markers before actually sending the input. * dired.el (dired-readin): Record the directory's modtime. (dired-internal-noselect): Offer to revert if dir has changed. * menu-bar.el (menu-bar-mode): Make this a global variable. (menu-bar-mode): Make variable menu-bar-mode and default-frame-alist consistent. * frame.el (frame-notice-user-settings): Make menu-bar-mode and default-frame-alist consistent with each other. * simple.el (beginning-of-buffer-other-window) (end-of-buffer-other-window): New functions. * loaddefs.el: Key bindings for M-home and M-end. * ispell.el (ispell-message): Avoid an infinite loop. Fri Jun 24 21:42:19 1994 Karl Heuer (kwzh@nutrimat.gnu.ai.mit.edu) * lmenu.el (popup-menu): Allow user to select nothing. Fri Jun 24 11:45:18 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * paren.el (show-paren-command-hook): Use matching-paren. Call overlay-put once for each overlay. Wait .1 sec to see if any input comes in. * gnuspost.el (gnus-inews-user-name, gnus-inews-domain-name): Use user-mail-address unless there's a reason to do otherwise. (gnus-inews-domain-name): Delete compatibility use of gnus-your-domain. * add-log.el (add-log-mailing-address): Use user-mail-address. * startup.el (user-mail-address): New variable. (normal-top-level): Initialize it. * gnus.el (gnus-summary-show-all-threads): Enable thread use. (gnus-summary-show-thread): Enable thread use. (gnus-summary-hide-all-threads): Enable thread use. (gnus-summary-hide-thread): Enable thread use. (gnus-summary-catchup-to-here): New function. (gnus-summary-mode-map): Add menu bar menus. (gnus-group-mode-map): Add menu bar menus. * timer.el (run-at-time): If REPEAT is 0, don't repeat. * tar-mode.el (tar-alter-one-field): Finish previous renaming change. * add-log.el (find-change-log): If file name specified, just use it. Fri Jun 24 04:08:11 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (visit-tags-table-buffer): Don't take car of return from tags-table-including. Thu Jun 23 19:54:24 1994 Karl Heuer (kwzh@nutrimat.gnu.ai.mit.edu) * lmenu.el (popup-menu): Convert list to same-size vector, not singleton vector. Thu Jun 23 10:22:48 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el (comint-read-input-ring): Use ring-insert-at-beginning. Insert most recent string first and only as many as we need. Don't visit the file, just read it. * ring.el (ring-insert-at-beginning): New function. * jka-compr.el (jka-compr-partial-uncompress): Handle the case where LEN reaches to or past the end of the data. * soundex.el (soundex-alist): Delete the elements that mapped into nil. * tar-mode.el (tar-extract): Set file name by hand before calling set-visited-file-name. * tar-mode.el: Various renamings; all callers changed. (tar-header-block-tokenize): Renamed from tokenize-tar-header-block. (tar-header-block-checksum): Renamed from checksum-tar-header-block. (tar-header-block-check-checksum): Renamed from check-tar-header-block-checksum. (tar-header-block-recompute-checksum): Renamed from recompute-tar-header-block-checksum. (tar-header-block-summarize): Renamed from summarize-tar-header-block. * paren.el (show-paren-command-hook): Set paren foreground to white. (show-paren-command-hook): Handle close paren rather than open paren if point is between the two. * info.el (Info-next-preorder-1): New function. (Info-mouse-follow-nearest-node): Use that. (Info-follow-nearest-node): Use that. Wed Jun 22 23:32:22 1994 Ethan Bradford (ethanb@ptolemy.astro.washington.edu) * lpr.el (print-region-1): Don't include a space in the job name. Wed Jun 22 21:11:56 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (tags-table-including): Don't call tags-table-check-computed-list. After skipping a table not in core, make sure TABLES is non-nil before using it. At end, find the table in the user's list which includes FOUND. Wed Jun 22 18:14:36 1994 Noah Friedman (friedman@prep.ai.mit.edu) * rsz-mini.el (resize-minibuffer-window-exactly, resize-minibuffer-frame, resize-minibuffer-frame-exactly): Doc fixes. (resize-minibuffer-frame-exactly): make default t. (resize-minibuffer-frame-original-height): New variable. (resize-minibuffer-setup): Set it locally in the minibuffer. (resize-minibuffer-frame): Use it instead of minibuffer-frame-alist's height. (resize-minibuffer-setup): Append resize-minibuffer-window and resize-minibuffer-frame to the end of post-command-hook, don't insert on the front. (resize-minibuffer-window-restore): New function. (resize-minibuffer-setup): Put it on minibuffer-exit-hook. Wed Jun 22 00:04:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * faces.el (make-face): Return the face name, not the vector. * menu-bar.el: Rearrange the edit and file menus, and add separators. * indent.el (move-to-tab-stop): Delete unnecessary spaces before the old point if a tab followed or follows the old point. * backquote.el (backquote-process): Fix criterion for using FIRSTLIST. * loaddefs.el (global-map): Bind M-prior. * simple.el (scroll-other-window-down): New command. * env.el (setenv): Rewrite. Provide a way to unset interactively. Tue Jun 21 16:17:42 1994 Per Abrahamsen (abraham@eupectic.research.att.com) * double.el (double-prefix-only): New variable. (double-translate-key): Use it. Tue Jun 21 13:46:04 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * faces.el (face-equal): Do check the underline attribute. * files.el (delete-auto-save-files): Doc fix. Mon Jun 20 17:55:33 1994 Morten Welinder (terra@diku.dk) * info.el (Info-directory-list): For msdos, don't check for exec-directory != ../lib-src (since we use wrapped binaries). * s-region.el: Don't bind keys C-insert, C-delete, and S-insert if they are already bound. Mon Jun 20 12:45:13 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * indent.el (move-to-tab-stop): Get rid of spaces before tabs that were made by an immediately previous use of this command. * gnus.el (gnus-summary-next-article): Fix previous change. * help.el (finder-by-keyword): Add doc string and t for interactive. * cc-mode.el: Large changes--version 3.349. * jka-compr.el: Use plists to record handlers. (jka-compr-insert-file-contents): Don't leave buffer locked. Call the standard function, and file-local-copy, using jka-compr-run-real-handler. (jka-compr-file-local-copy): Call file-local-copy using jka-compr-run-real-handler. (jka-compr-write-region): Likewise. (jka-compr-load): Don't alter file-name-handler-alist. Do bind inhibit-file-name-handlers and inhibit-file-name-operation. (jka-compr-handler): Don't alter file-name-handler-alist. * shell.el (shell-prefixed-directory-name): Do nothing if comint-file-name-prefix is empty. Do not inline. Tue May 31 17:52:11 1994 Lars Magne Ingebrigtsen (larsi@bera.ifi.uio.no) * gnus-uu.el (gnus-uu-view-directory): Fixed viewing with the `gnus-uu-asynchronous' variable set. (gnus-uu-ctl-map): Removed the keystrokes `C-c C-v C-h' and `C-c C-v h' from the keymap. (gnus-uu-decode-and-view-all-articles, (gnus-uu-decode-and-view-all-unread-articles, (gnus-uu-decode-and-save-all-unread-articles, (gnus-uu-decode-and-save-all-articles): Accept prefix arg for # files. (gnus-uu-uustrip-article-as): Waits for uudecode to finish before further treatment of the resulting files. (gnus-uu-summary-next-subject): After decoding, if there are no more unread articles, jump to the last article decoded. (gnus-uu-post-encoded): Make last posting in a series always have more than 4 lines. * gnus-uu.el (gnus-uu-interactive-save-original-file): Fixed original file save when there's more that one original file. * gnus-uu.el (gnus-uu-view-file): Rewrote function and fixed ask before view/save after view. (gnus-uu-ask-to-save-file): New function. * gnus-uu.el (gnus-uu-interactive-set-up-windows): New function. (gnus-uu-interactive-scan-directory) New function. (gnus-uu-interactive-rescan-directory): New function. (gnus-uu-ignore-files-by-name, gnus-uu-ignore-files-by-type): New vars. (gnus-uu-interactive-execute): Change directory to work dir before executing. (gnus-uu-view-directory, gnus-uu-check-for-generated-files): Fixed bug deleting generated directories. (gnus-uu-unpack-archives): Added error message for corrupted archives. Sun Jun 19 13:13:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * indent.el (tab-to-tab-stop): Combine new indentation with previous. * mailalias.el (define-mail-alias): Copy parsing code from mailabbrev.el. New arg from-mailrc-file. (build-mail-aliases): Pass t as new arg. * mouse.el (mouse-scroll-subr): Preserve point if WINDOW's not the selected window. (mouse-drag-region, mouse-drag-secondary): Accept any list event as normal termination of the dragging. Sun Jun 19 03:56:30 1994 Erik Naggum (erik@naggum.no) * simple.el (blink-matching-open): Use matching-paren. Sun Jun 19 15:19:56 1994 Rob Riepel (riepel@Snowflake.Stanford.edu) * tpu-doc.el (tpu-doc-revision): Variable deleted. * tpu-edt.el (tpu-edt-off): Restore original global key map. (tpu-next-file-buffer): Move to dired buffer too. (tpu-make-file-buffer-list): New function. (tpu-version): New version. (tpu-set-mode-line): Added line-number-mode to mode-line. (tpu-search-forward-exit, tpu-search-backward-exit): New functions, key mappings. * tpu-extras.el: Require tpu-edt. (tpu-extras-revision): Variable deleted. * tpu-mapper.el: Change size of selected screen. Reposition after printing help. Null default directory for save. Produce minibuffer key bindings for kp4 and kp5. (tpu-kp4, tpu-kp5): New variables. (tpu-mapper-revision): Variable deleted. * vt-control.el (vt-revision): Variable deleted. Sat Jun 18 09:23:23 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-bury): Test that rmail-summary-buffer is boundp. * files.el (insert-directory): Don't quote braces for shell. * calendar.el: Fix references to diary.el. * diary-lib.el: Renamed from diary.el. * rmailmsc.el (set-rmail-inbox-list): Use insert-before-markers. Fri Jun 17 23:39:42 1994 Michael D. Ernst (mernst@research.microsoft.com) * rmail.el (rmail-highlight-headers): Don't skip newlines, just tab and space. Fri Jun 17 18:28:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gnus.el (gnus-summary-next-article): Handle non-character events. Fri Jun 17 18:15:03 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * dired.el (dired-build-subdir-alist): Don't let looking-at destroy the match data. Fri Jun 17 09:38:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (make-auto-save-file-name): Double the backslashes and convert slashes to \!. * finder.el (finder-commentary): Fix error message syntax. * autoload.el, bookmark.el, cl-*.el, cl.el, complete.el: * mouse-sel.el, rot13.el, thingatpt.el: Fix Commentary section comments and other section comments. * lisp-mnt.el (lm-section-mark): Accept extra semicolons; accept spaces at end of line. * faces.el (x-create-frame-with-faces): Set the cursor color last. Fri Jun 17 17:41:10 1994 Kevin Rodgers (kevinr@ihs.com) * mailabbrev.el (build-mail-abbrevs): Pass a recursivep argument in recursive call. Fri Jun 17 00:06:16 1994 Roland McGrath (roland@geech.gnu.ai.mit.edu) * etags.el (tags-table-computed-list, tags-table-computed-list-for): New variables. (tags-table-list-pointer, tags-table-list-started-at): Doc fixes. (tags-table-parent-pointer-list): Variable removed. (tags-table-check-computed-list, tags-table-extend-computed-list): New functions. (tags-find-table-in-list): Function removed. (tags-table-list-member): New function replaces it. (tags-verify-table): New function, broken out of visit-tags-table-buffer. (tags-table-including, tags-next-table): Rewritten. (visit-tags-table-buffer-cont): Variable removed. (visit-tags-table-buffer): Overhauled. (tag-exact-match-p): Disallow newline in tag string before \177. Thu Jun 16 10:14:47 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-scroll-subr): New arg WINDOW. (mouse-drag-region, mouse-drag-secondary): Pass new arg. * bibtex.el (bibtex-mode): Set up comment-start locally. * ange-ftp.el (ange-ftp-canonize-filename): Fix wrong var name. Thu Jun 16 04:09:48 1994 Noah Friedman (friedman@prep.ai.mit.edu) * rlogin.el (rlogin-password-paranoia): Variable deleted. (rlogin-password): Function deleted. This functionality is handled by comint-watch-for-password-prompt. * rlogin.el (rlogin-filter): Function deleted. (rlogin): Do not set the process filter to rlogin-filter. Wed Jun 15 22:22:33 1994 Morten Welinder (terra@diku.dk) * info.el (Info-directory-list): For msdos, use ";" instead of ":" as delimiter in INFOPATH. Wed Jun 15 00:37:07 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * outline.el (outline-mode): Make change-major-mode-hook buffer-local. * dired.el (dired-build-subdir-alist): Avoid mistaking a file name ending in a colon for a subdir header line. * sendmail.el (mail-send-hook): Add defvar. (mail-send): Run mail-send-hook before the `Sending...' message. * etags.el (find-tag-history): New variable. (find-tag-noselect): Set that variable. Tue Jun 14 22:42:00 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * mouse.el (mouse-drag-region): Bind last-command, not this-command. * files.el (make-auto-save-file-name): Don't use slashes in autosave name for a non-file buffer. Tue Jun 14 16:18:12 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ispell.el (ispell-command-loop): C-g should be like X, not q. * fortran.el (fortran-blink-matching-do): When looking for do, insist on nondigit after it. Tue Jun 14 20:06:55 1994 Ed Reingold (reingold@albert.gnu.ai.mit.edu) * cal-menu.el (calendar-mode-map): Change moon menu bar to pop up a menu instead doing it directly. (calendar-mouse-2-date-menu): Remove moon phase. Tue Jun 14 19:50:14 1994 Richard Stallman (rms@albert.gnu.ai.mit.edu) * cal-menu.el (calendar-mouse-2-date-menu): Put moon phase here. (calendar-mode-map): Delete from here. Tue Jun 14 00:34:43 1994 Richard Stallman (rms@albert.gnu.ai.mit.edu) * simple.el (pop-global-mark): Discard entries for nonexistent buffers. * startup.el (inhibit-startup-echo-area-message): Doc fix. * avoid.el (mouse-avoidance-threshold): Renamed from ...threshhold. Mon Jun 13 23:40:33 1994 Richard Stallman (rms@albert.gnu.ai.mit.edu) * simple.el (end-of-buffer): Recenter overlay lists. Mon Jun 13 19:40:12 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (pop-global-mark): Discard entries for nonexistent buffers. * startup.el (inhibit-startup-echo-area-message): Doc fix. * avoid.el (mouse-avoidance-threshold): Renamed from ...threshhold. * simple.el (end-of-buffer): Recenter overlay lists. Mon Jun 13 19:27:54 1994 Roland McGrath (roland@geech.gnu.ai.mit.edu) * compile.el (compilation-error-regexp-alist): Extend first regexp to handle Borland C++ msgs: "Warning" or "Error" before file name. Mon Jun 13 18:06:09 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ispell.el (ispell-dictionary-alist): Add autoload. Split into two subvariables. (ispell-menu-map): Defvar and set up at top level. Split into parts. (ispell-menu-map-needed): New variable. * font-lock.el (font-lock-hack-keywords, font-lock-fontify-region): Don't call set-buffer-modified-p if no change in its value. Mon Jun 13 21:31:53 1994 Lawrence R. Dodd (dodd@roebling) * dired-x.el (dired-man): Use internal function from man.el. (dired-omit-files): Omit `.' and `..' by default, not all files ending in `.'. Mon Jun 13 09:56:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * font-lock.el: Don't alter the underline face. * font-lock.el (c-font-lock-keywords-2): Insist on whitespace before a label. * mouse.el (mouse-save-then-kill-delete-region): Turn off change hooks for the edit operations that are not real. Sun Jun 12 21:09:22 1994 Johan Vromans (jv@NL.net) * forms.el (forms-mode): Plug security hole by disabling `eval-buffer' unless `enable-local-eval' is set to t. Correct setting of `forms--mode-setup'. (forms--local-write-file-function): New function to be used as `local-write-file-hooks'. (forms-mode): Use it. (forms-find-file,forms-find-file-other-window): Locally set `enable-local-eval' and `enable-local-variables' to t. (forms-find-file-other-window): Remove extraneous call to `eval-current-buffer'. Sun Jun 12 22:31:50 1994 Kohtala Marko (Marko.Kohtala@ntc.nokia.com) * info.el (Info-insert-dir): Ignore access times when comparing file attributes. Print message while merging. Use separate buffers for merging. Try lower case `dir' first. Sun Jun 12 08:53:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * iso-cvt.el (iso-iso2tex-trans-tab): Add a few characters. (iso-iso2gtex-trans-tab): Likewise. (iso-tex2iso-trans-tab): Recognize TeX accent sequences without braces. (iso-gtex2iso-trans-tab): Likewise. * info.el (Info-fontify-node): Require some whitespace after *Note. * sendmail.el (mail): If homedir is nonexistent, don't use as default. Sat Jun 11 14:13:07 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * server.el (server-start): Doc fix. * font-lock.el (font-lock-hack-keywords): Avoid changing the narrowing. * tex-mode.el (latex-mode, slitex-mode): In paragraph-separate, delete spurious \\\\ from char set. * isearch.el (isearch-mode-map): Bind the ASCII-equivalent fcn keys explicitly to nil. * iso-cvt.el (iso-translate-conventions): Get rid of interactive spec. Fri Jun 10 20:56:03 1994 Morten Welinder (terra@diku.dk) * font-lock.el (tex-font-lock-keywords): Make the pattern for macros respect TeX's idea of identifiers. (font-lock-set-defaults): Don't check for 'tex-mode, but instead for 'plain-tex-mode, 'latex-mode, and 'slitex-mode which is what tex-mode.el uses. Fri Jun 10 10:13:10 1994 Boris Goldowsky (boris@mink.cs.rochester.edu) * avoid.el (mouse-avoidance-point-position): Fix compute-motion call to use (X . Y) relative to window, not frame. Avoid errors if window-start < point-min. Fri Jun 10 16:28:12 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el (comint-dynamic-list-completions): No space in *Completions*. * ispell4.el (ispell-complete-word): Likewise. * ielm.el (ielm-complete-symbol): Likewise. * etags.el (complete-tag): Likewise. * complete.el (PC-do-completion): Likewise. * lisp.el (lisp-complete-symbol): Likewise. * ispell.el (ispell-dictionary-alist): Fix regexp in francais. * dired-x.el: Require dired and dired-aux in the standard way. * dired-aux.el: Add provide call. * info.el (Info-complete-menu-item): New function. (Info-menu): Use it to speed completion. * tex-mode.el (tex-start-shell): Add autoload. Tue Jun 7 13:47:11 1994 Richard Stallman (rms@geech.gnu.ai.mit.edu) * iso-cvt.el (iso-translate-conventions): Use case-dependent search and don't alter case. * disp-table.el (standard-display-european): Treat 0 arg like negative. * ange-ftp.el (ange-ftp-canonize-filename): Preserve // after colon. (ange-ftp-expand-file-name): Likewise. (ange-ftp-canonize-filename): Preserve // at very beginning. Tue Jun 7 12:35:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tex-mode.el (tex-show-print-queue): Display the tex shell buffer. (tex-file, tex-bibtex-file): Likewise. (latex-mode, slitex-mode): Treat \] as paragraph starter. Tue Jun 7 21:33:02 1994 Morten Welinder (terra@diku.dk) * dos-fns.el (Info-default-directory-list): Setting this no longer needed. Tue Jun 7 03:47:05 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cal-menu.el (calendar-mouse-2-date-menu): Put moon phase here. (calendar-mode-map): Delete from here. * simple.el (delete-blank-lines): Doc fix. Mon Jun 6 04:01:24 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * indent.el (tab-stop-list): Doc fix. * sendmail.el (mail-bury): If showing rmail buffer that has summary, show the summary too. Mon Jun 6 01:04:39 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * menu-bar.el (menu-bar-update-buffers): Avoid excessive consing. Sun Jun 5 06:59:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tex-mode.el (tex-file, tex-region): Display the tex shell buffer. * gomoku.el (gomoku-display-statistics): Use human's point of view for wins and losses. (gomoku-number-of-emacs-wins): Renamed from gomoku-number-of-wins. (gomoku-number-of-human-wins): Renamed from gomoku-number-losses. * derived.el (derived-mode-merge-abbrev-tables): Do nothing if OLD is nil. * edebug.el (edebug-emacs-19-specific): Call x-popup-menu only if using a window system. * info.el (Info-directory-list): Don't use the invocation directory unless it was used for exec-directory too. * gud.el (gud-massage-args): Fix error message syntax. (gud-marker-filter, gud-find-file): Likewise. (gud-display-line): Don't use dialog box for questions. Fri Jun 3 20:16:43 1994 Morten Welinder (terra@diku.dk) * dos-fns.el (frame-parameters): Setting this is no longer needed. Fri Jun 3 20:27:02 1994 Ed Reingold (reingold@albert.gnu.ai.mit.edu) * solar.el (solar-sunrise, solar-sunset): Fix doc string. (solar-time-string): Rewritten. (solar-adj-time-for-dst): New function. (solar-sunrise-sunset, diary-sabbath-candles, solar-equinoxes-solstices): Revised to use the rewritten and new fcns. * calendar.el (solar-holidays): Revised to use the rewritten and new fcns. * lunar.el (lunar-phase): Revised to use the rewritten and new fcns. Thu Jun 2 18:15:13 1994 Richard Stallman (rms@albert.gnu.ai.mit.edu) * compile.el (compilation-error-regexp-alist): Stricter Lucid regexp. * complete.el (PC-do-completion): Clear text props from inserted text. * comint.el (comint-dynamic-complete-as-filename) (comint-dynamic-complete-filename): Suppress most messages when completing in the minibuffer. Wed Jun 1 14:18:06 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gnus-uu.el (gnus-uu-ctl-map): Move C-h binding to C-d. * mouse.el (mouse-choose-completion): If *Completion* is a special buffer or just has a dedicated window, do something reasonable. * gnus.el (gnus-newsrc-to-gnus-format): In main loop, don't try to match the ranges with the regexp. Match just the group name and the subscribed-flag. Mon May 30 17:44:30 1994 Paul Eggert (eggert@twinsun.com) * calendar.el (calendar-mod): Remove; it was equivalent to `mod'. All callers changed. Mon May 30 14:51:16 1994 Ed Reingold (reingold@albert.gnu.ai.mit.edu) * calendar.el (generate-calendar-month): Make highlighted text for mouse-2 a full column (2 chars) wide, even for single-digit dates. Mon May 30 12:23:10 1994 Richard Stallman (rms@albert.gnu.ai.mit.edu) * comint.el (comint-read-input-ring): Make regexp stricter. * paths.el (Info-default-directory-list): Don't attach ../info. So now configure-info-directory comes last. Put /usr/local/info second. * info.el (Info-directory-list): Doc fix. * font-lock.el (shell-font-lock-keywords): Removed regexp for commands. (rmail-summary-font-lock-keywords): New variable. (font-lock-set-defaults): Use it. * bibtex.el (bibtex-clean-entry): Back over close delimiter carefully. * cal-dst.el (calendar-current-time-zone): Fix typo that transposed DST-STARTS-TIME and DST-ENDS-TIME. * ange-ftp.el (ange-ftp-insert-directory): Expand file name to check whether it is really an ftp file name. * cal-dst.el (calendar-daylight-savings-ends): Fix typo in put. * menu-bar.el (menu-bar-mode): Fix previous change. See ChangeLog.4 for earlier changes. emacs-19.30/lisp/Makefile100666 12120 1 454 5556242244 13510 0ustar rmsdaemon# # Maintainence productions for the Lisp directory # SOURCES = *.el COPYING Makefile lisptagsfiles = [a-zA-Z]*.el term/[a-zA-Z]*.el unlock: chmod u+w $(SOURCES) relock: chmod -w $(SOURCES) chmod +w version.el finder-inf.el loaddefs.el TAGS: $(lisptagsfiles) ../lib-src/etags $(lisptagsfiles) emacs-19.30/lisp/makefile.nt100444 23073 1 2432 6054670567 15066 0ustar voelkerdaemon# Hacked up Nmake makefile for GNU Emacs # Geoff Voelker (voelker@cs.washington.edu) # Copyright (c) 1994 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. */ # !include ..\nt\makefile.def all: # # Assuming INSTALL_DIR is defined, copy the elisp files to it # install:; - mkdir $(INSTALL_DIR)\lisp - del .\same-dir.tst - del $(INSTALL_DIR)\lisp\same-dir.tst echo SameDirTest > $(INSTALL_DIR)\lisp\same-dir.tst if not exist .\same-dir.tst $(CP_DIR) . $(INSTALL_DIR)\lisp - del $(INSTALL_DIR)\lisp\same-dir.tst # # Maintenance # clean:; - del *~ - $(DEL_TREE) deleted emacs-19.30/lisp/ChangeLog.1100666 12120 1 310473 5431107655 14044 0ustar rmsdaemonMon May 5 13:47:55 1986 Richard M. Stallman (rms at prep) * isearch.el (isearch): Fix bug extending a search string in place in reverse regexp search. Fri May 2 19:36:43 1986 Richard M. Stallman (rms at prep) * mh-e.el (mh-get-field): Make regexp accept values starting with non-letters. Wed Apr 30 10:33:04 1986 Richard M. Stallman (rms at prep) * rnews.el (news-get-new-news): Avoid lossage if a news group is subscribed to twice. Tue Apr 29 01:14:09 1986 Richard M. Stallman (rms at prep) * page.el (count-lines-page): Fine end of page properly when it's at end of buffer with no newline. Fri Apr 25 11:09:45 1986 Richard M. Stallman (rms at prep) * man.el (manual-entry): Pass more selective arg to file-name-all-completions. Tue Apr 22 17:47:48 1986 Richard M. Stallman (rms at prep) * fill.el (fill-region-as-paragraph): Avoid infinite loop if have a too-wide word with a fill prefix containing a space. Wed Apr 16 19:03:56 1986 Richard M. Stallman (rms at prep) * term/xterm.el (x-get-default-args): Handle `reversevideo' last. Test switches with "on", not "On", since that is what X uses. Mon Apr 14 16:47:07 1986 Richard M. Stallman (rms at prep) * compile.el (compile1): Try interrupt-process first when getting rid of old compilation process. * text-mode.el: Set up text-mode-abbrev-table at load time since all text-related modes use it. * loadup.el: Don't change the major mode. Leave as fundamental. * startup.el: After init file, use initial-major-mode as major mode to select in *scratch*. This avoids problems when .emacs wants to set variables globally that are local in lisp-interaction-mode. Sat Apr 12 19:29:26 1986 Richard M. Stallman (rms at prep) * replace.el (perform-replace): Save and restore the match-data around call to read-char. Mysterious bug of replacing the wrong characters was due to display-time-filter running inside read-char. Also make the C-w option set `replaced' to t, not `done'. Fri Apr 11 13:56:16 1986 Richard M. Stallman (rms at prep) * rmail.el (rmail-nuke-pinhead-header): Deleted code to delete old Date: line, since new one is made only if had no old one. Thu Apr 10 05:58:53 1986 Richard M. Stallman (rms at prep) * rnews.el (news-set-current-certifiable): Follow symlinks before looking up the attributes. * time.el (display-time): Specify nil for process's buffer ab initio; avoid C-g timing error. Mon Apr 7 13:00:45 1986 Richard M. Stallman (rms at prep) * compile.el (kill-{compilation,grep}): Use interrupt-process, not kill-process, so make can delete the output file being produced. Sun Apr 6 18:52:09 1986 Richard M. Stallman (rms at prep) * paths.el (sendmail-program): Always use sendmail if bsd, even if it does not appear to exist. Sat Apr 5 21:01:48 1986 Richard M. Stallman (rms at prep) * bytecomp.el (batch-byte-compile): Use batch-byte-compile-file, not byte-compile-file. Fri Apr 4 16:12:18 1986 Richard M. Stallman (rms at prep) * files.el (set-auto-mode): Bind case-fold-search only over small pieces of code, not including the major mode function. * rmail.el (rmail-nuke-pinhead-header): Don't kill the line after Date: along with Date:. Mon Mar 31 12:39:55 1986 Richard M. Stallman (rms at prep) * man.el: fix stupid error in arg to file-name-all-completions. Fri Mar 28 23:28:16 1986 Richard M. Stallman (rms at prep) * info.el (Info-tagify): When restoring old restriction, bring it inside final buffer size. Thu Mar 27 16:28:59 1986 Richard M. Stallman (rms at prep) * rnews.el (news-mode): Run news-mode-hook. * rnews.el (news-get-pruned-list-of-files): Don't discard first two files; . and .. are not first on Apollo. Wed Mar 26 16:09:59 1986 Richard Mlynarik (mly at prep) * indent.el (edit-tab-stops): Go to character 0 so editing happens in right place Mon Mar 24 12:11:53 1986 Richard M. Stallman (rms at prep) * mail-utils.el (mail-strip-quoted-names): Don't strip "foo"@host. Sat Mar 22 15:20:09 1986 Richard M. Stallman (rms at prep) * mail-utils.el (rmail-dont-reply-to): Default names to flush include all starting with "info-". For user's own name, match only if ends at end of word. Fri Mar 21 10:06:22 1986 Richard M. Stallman (rms at prep) * paths.el (mh-progs, mh-lib): Try two alternatives for these. * paths.el (rmail-spool-directory): Say $LOGNAME for usg. Thu Mar 20 21:57:04 1986 Richard M. Stallman (rms at prep) * rmail.el (rmail): Move a forward-char so it isn't done if convert is t. Tue Mar 18 01:41:29 1986 Richard M. Stallman (rms at prep) * paths.el (news-inews-program): Add new possibility /usr/lib/news/inews. * rmail.el (rmail): Detect Unix format messages added after last Babyl message and if so call rmail-convert-to-babyl-format. * mail-utils.el (rmail-dont-reply-to): Use LOGNAME if no USER env variable. * paths.el (news-inews-program): Try various pathnames and use the one that exists. Mon Mar 17 16:52:32 1986 Richard M. Stallman (rms at prep) * sendmail.el (mail-do-fc): Put a newline at front of the message written in the file. Sat Mar 15 15:51:40 1986 Richard M. Stallman (rms at prep) * rnews.el: Installed king@kestrel's changes: Correct reentrance bug, don't bother with groups that received no new traffic since last read completely, find out what traffic a group has available much more quickly when possible, do some completing reads for group names. Also adds the 'c' command to copy a message. Sat Mar 15 15:49:28 1986 Bill Rozas (jinx at prep) * scheme.el: (scheme-zap-name) Uses expand-file-name to obtain an absolute pathname. Sat Mar 15 14:28:06 1986 Richard M. Stallman (rms at prep) * replace.el (perform-replace): Hack for preventing loops matching null strings at same place was also preventing them at successive characters. Fixed. Thu Mar 13 11:47:39 1986 Bill Rozas (jinx at prep) * scheme.el: (scheme-zap-name) change it back to fromedit.zap since that is where scheme expects it and it is too much work to change scheme right now. This interface is obsolete anyway, but some people (athena) still use it. Thu Mar 13 00:53:00 1986 Richard M. Stallman (rms at prep) * mail-utils.el (mail-strip-quoted-names): Don't delete <...> and surroundings if there's a comma inside. Wed Mar 12 15:20:29 1986 Richard Mlynarik (mly at prep) * shell.el (shell) If no environment variable SHELL, default to /bin/sh Wed Mar 12 11:16:08 1986 Leonard H. Tower Jr. (tower at prep) * rnews.el (news-mail-reply): didn't work if point was not at (point-min). added (goto-line (point-min)). Tue Mar 11 00:37:52 1986 Richard M. Stallman (rms at prep) * loadup.el: If CANNOT_DUMP, don't copy DOC to name with version number. Mon Mar 10 19:07:19 1986 Richard M. Stallman (rms at prep) * rmail.el (rmail-reply): Delete "re: " only if at front of subject. * files.el (basic-save-buffer): Call expand-file-name; avoid setting default-directory to nil. * paths.el: Look for name `hpux', not `hp-ux'. Sat Mar 8 02:28:13 1986 Richard M. Stallman (rms at prep) * scheme.el (scheme-zap-name): Change this to be a temp name in /tmp. Fri Mar 7 22:32:44 1986 Sundar Narasimhan (sundar at prep) * rnews.el: fix bug in news-get-new-news. (news-current-news-group should be nil on startup). Fri Mar 7 14:14:14 1986 Bill Rozas (jinx at prep) * scheme.el: autoloads from xscheme.el * xscheme.el: New file. Implements inferior-scheme-mode and related commands. Similar (almost a query replace of) inferior-lisp-mode in shell.el Fri Mar 7 01:52:25 1986 Richard M. Stallman (rms at prep) * options.el: Replace real ctl chars with suitable escapes. * telnet.el: Replace real ctl chars with suitable escapes. Fill long line in a doc string. Wed Mar 5 01:21:11 1986 Richard M. Stallman (rms at prep) * scheme.el: Considerable rewrite by jinx, already tested. * rmail.el (rmail-quit): Don't use the summary buffer as the buffer to select. * rmail.el (rmail-convert-to-babyl-format): 1. Position point correctly at end of Unix-fmt message. 2. Handle failure to find expected end of Babyl-format message. Mon Mar 3 15:59:19 1986 Richard M. Stallman (rms at prep) * files.el (revert-buffer): Don't lock the file being reverted. * term/xterm.el: Install complete rewrite from Athena. Change it so that if Emacs is not compiled for X nothing is done except define a few functions. Mon Mar 3 15:52:19 1986 Leonard H. Tower Jr. (tower at prep) * rnews.el (news-add-news-group) Fixed bug that was putting "/"'s in newsgroups names in .newsrc instead of "."'s. Mon Mar 3 00:45:34 1986 Richard M. Stallman (rms at prep) * simple.el (kill-region): Add to doc string a cross-reference to M-w. * loaddefs.el (query-replace{,-regexp}): Improve documentation of use of Help. * emacsbug.el: Include machine name and system type in initial text. Sun Mar 2 19:09:21 1986 Richard M. Stallman (rms at prep) * shell.el (shell-send-input): Ignore errors happening while trying to hack default-directory. * time.el (display-time-filter): Find start of an output message as NN:, not end as ], since the ] appears at the end only on 4.2. * paths.el: Make criterion for using sendmail be: if the file sendmail exists. Sat Mar 1 00:12:38 1986 Richard M. Stallman (rms at prep) * loadup.el: Change DOCSTR to DOC. Tue Feb 25 10:20:43 1986 Richard M. Stallman (rms at prep) * mail-utils.el (mail-strip-quoted-names): Supply missing brackets around some sets in regexps. Sat Feb 22 15:44:39 1986 Richard M. Stallman (rms at prep) * abbrev.el (write-abbrev-file): Get value of abbrev-file-name from the correct buffer. * startup.el (command-line-1): Use unwind-protect to delete the startup-message from the buffer. Fri Feb 21 12:37:52 1986 Richard M. Stallman (rms at prep) * rmail.el (rmail-parse-inbox-file, rmail-nuke-pinhead-header): Allow spaces within quotes in sender in unix-style From line. Thu Feb 20 17:42:16 1986 Richard Mlynarik (mly at prep) * info.el (Info-validate): Node-names are case-insensitive, but assoc is case-sensitive Separate out function Info-validate-tags-table Wed Feb 19 02:18:41 1986 Richard M. Stallman (rms at prep) * c-mode.el (indent-c-exp): Fix indentation of comments, both after text and on separate lines. Fix indentation of first statement in a block when comment precedes it. * rmail.el (rmail-nuke-pinhead-header): Keep either the sender or the date or both, whichever is not otherwise mentioned in the header. Tue Feb 18 21:16:00 1986 Richard M. Stallman (rms at prep) * loaddefs.el (auto-mode-alist): ".sty" -> TeX-mode. Mon Feb 10 22:16:57 1986 Richard M. Stallman (rms at prep) * rmail.el (rmail-quit): It was burying the wrong buffer. Sun Feb 9 02:39:15 1986 Richard M. Stallman (rms at prep) * lpr.el: Put "Emacs buffer" at end of job title, not beginning. Fri Feb 7 00:44:54 1986 Richard M. Stallman (rms at prep) * paths.el: Add slashes at end of mh-lib and mh-progs. * mail-utils.el (rmail-dont-reply-to): If "foo" is in rmail-dont-reply-to-names, flush names like bar!foo. * simple.el (eval-expression): Remove the hack to remove `eval-expression from the command history. It was not working before because of the bug in interactive-p. Now that it works, it loses because without the explicit use of eval-expression, the value will not be printed when the command is redone. * info.el: (Info-goto-node): Use regexps to do all the blank stripping. (Info-edit-mode): Don't use \\[...] in the doc string. (Info-menu): Revert most changes in making completion list. Also, restore original point before calling completing-read. (Info-find-node): Use new strategy, like the original one except that if an error happens go back to the previous node. Faster in the usual case (where no error), and simpler. Do not allow abbreviations for node names. If tag table, get immediate error on node not in it. Thu Feb 6 23:25:39 1986 Richard M. Stallman (rms at prep) * text-mode.el (text-mode-syntax-table): Make " and \ punctuation, not whitespace. Thu Feb 6 22:03:01 1986 Richard Mlynarik (mly at prep) * info.el (Info-find-node): Fix braino. Also, allow abbreviations for node names. Info-tagify: insert tags in forward order so that an abbrev finds the textually first possibility rather than the last. Thu Feb 6 12:54:49 1986 Richard M. Stallman (rms at prep) * paths.el: Conditionalize some filenames for hpux. * simple.el (backward-delete-char-untabify): Don't screw up value of point if hit beg of buffer. Wed Feb 5 22:58:58 1986 Richard M. Stallman (rms at prep) * mh-e.el (mh-insert-prefix-string): Fix typo in arg to replace-regexp. Wed Feb 5 15:31:36 1986 Richard Mlynarik (mly at prep) * info.el: Completely rewrite Info-find-node so that it doesn't blow out on nonexistent nodes/files Rewrite Info-goto-node through the Magic of Regular Expressions. Make interactive part of Info-menu be byte-compiled and speed up in various other ways. Wed Feb 5 11:45:09 1986 Richard M. Stallman (rms at prep) * tags.el (find-tag): Push the buffer's old point as a mark. Tue Feb 4 01:20:33 1986 Richard M. Stallman (rms at prep) * rmailout.el (rmail-output): Make sure message output is terminated with a newline. * rmailmsc.el (set-rmail-inbox-list): Update rmail-inbox-list with the new list of inbox files. Mon Feb 3 20:38:25 1986 Richard Mlynarik (mly at prep) * info.el (Info-validate) Insert a missing space. Mon Feb 3 02:56:37 1986 Richard M. Stallman (rms at prep) * texinfo.el: Define @smallexample as synonym for @example. * shell.el (make-shell): New &rest arg contains switch args to give the shell. (shell): Pass -i as a switch arg to make-shell. * shell.el: Don't use csh on HP-UX (it has sanity checking). Sun Feb 2 15:56:53 1986 Richard M. Stallman (rms at prep) * rmailout.el (rmail-output-to-rmail-file): If target file is being visited, write msg into its buffer. * files.el (append-to-file): Don't require file to exist. * rmail.el (rmail-reformat-message): Insert new copy of header before the original, not after. Avoids trouble with marker at the end, if message is all header. * rmail.el (rmail-search): Simplify prompting and make it mention the default if any. Print message when starting and another when done. Sat Feb 1 17:36:11 1986 Richard M. Stallman (rms at prep) * rmail.el (rmail-convert-to-babyl-format, rmail-nuke-pinhead-header): Accept and preserve a timezone in the Unix style From line. Fri Jan 31 14:45:10 1986 Sundar Narasimhan (sundar at prep) * rnews.el (news-quit & news-get-new-news): remember to update .newsrc file. Fri Jan 31 12:40:59 1986 Richard M. Stallman (rms at prep) * tex-mode.el (TeX-region): Use new variable TeX-command instead of "tex". Thu Jan 30 15:47:25 1986 Richard M. Stallman (rms at prep) * mail-utils.el (mail-fetch-field): New 3rd arg ALL: t means find and concatenate all fields of the specified type. * rmail.el (rmail-reply): Pass 3rd arg t to mail-fetch-field for To and CC fields. Tue Jan 28 19:27:02 1986 Richard M. Stallman (rms at prep) * yow.el (yow): Use remainder to get random in desired range. Needed on sysV where you only get 16 bits from random. Also randomize the seed when yow is loaded. * doctor.el (random-range): Use remainder; the same fix. Mon Jan 27 23:59:41 1986 Richard M. Stallman (rms at prep) * rmail.el: Remove defvar for rmail-primary-inbox-list. Sat Jan 25 15:48:46 1986 Richard M. Stallman (rms at prep) * mlsupport.el (line-to-top-of-window): Fix name of function `recenter'. * isearch.el (isearch-message): Don't display the ... when in slow-speed mode. Thu Jan 23 15:45:57 1986 Richard M. Stallman (rms at prep) * compile.el (compilation-parse-errors): Fix several bugs in parsing lint line numbers. * mail-utils.el (mail-strip-quoted-names): Don't delete the comma before a <...> arg that is being taken out of the <...>. Wed Jan 22 17:18:47 1986 Richard M. Stallman (rms at prep) * nroff-mode.el (forward-text-line): Negative args had several bugs; thorough rewrite fixed them and made function half as big and faster. Wed Jan 22 15:19:50 1986 Richard Mlynarik (mly at prep) * files.el (set-auto-mode): Set mode correctly for .~i~ backup files. * shell.el (inferior-lisp-mode): Use \\{...} in doc. Fix up initialization of inferior-lisp-mode-map Tue Jan 21 18:32:19 1986 Richard Mlynarik (mly at prep) * startup.el (command-line): Set some `foo' variables to default-`foo' after loading user init file. Tue Jan 21 00:01:17 1986 Richard M. Stallman (rms at prep) * lisp-mode.el (lisp-comment-indent): If at bol, don't insist on at least 1 col of indent. * texinfo.el (texinfo-format-setfilename): Don't mention directory name in the Info file introductory message. * c-mode.el (calculate-c-indent): Use new variable c-brace-imaginary-offset for statements inside a brace that isn't firstthing in its line. * startup.el (command-line): Catch errors in init file and continue. If term-file-prefix is nil, don't load a term file. * dired.el (dired-repeat-over-line, dired-get-filename): Barf right away on a "total" line. Mon Jan 20 15:27:38 1986 Richard M. Stallman (rms at prep) * rmailedit.el (rmail-cease-edit): Set point-min correctly (after the original header). Sun Jan 19 20:15:24 1986 Richard M. Stallman (rms at prep) * tags.el (visit-tag-table): If directory is specified, use file TAGS in that directory. * buff-menu.el (Buffer-menu-select): Divide the entire screen hight to compute window sizes, since we are going to divide up the entire screen. * bytecomp.el (various): Fix severe errors in handling byte-compile-depth. Clarified when to use byte-compile-push-constant vs byte-compile-constant. Sat Jan 18 10:16:12 1986 Richard M. Stallman (rms at prep) * doctor.el: Fix typo "symtoms". Fri Jan 10 16:23:39 1986 Richard Mlynarik (mly at prep) * mail-utils.el (mail-fetch-field) regexp-quote the argument. Fri Jan 10 07:12:53 1986 Richard M. Stallman (rms at prep) * files.el: delete-auto-save-files = t. Thu Jan 9 18:25:22 1986 Richard Mlynarik (mly at prep) * mail-utils (mail-strip-quoted-names): Handle multi-line address lists Wed Jan 8 11:25:22 1986 Richard Mlynarik (mly at prep) * subr.el (copy-keymap): New function. * loaddefs.el: Autoload view-mode. * nroff.el (electric-nroff-newline): Clean up and avoid lossage on a line with < 3 chars. Wed Jan 8 10:01:29 1986 Richard M. Stallman (rms at prep) * simple.el (transpose-lines): Create a newline (if nec) to terminate the line being transposed. * mailalias.el (expand-mail-aliases): Notice return within a continued header line as separating addresses. Tue Jan 7 14:14:50 1986 Richard Mlynarik (mly at prep) * tags.el (visit-tags-table): Barf if given a directory Mon Jan 6 16:06:29 1986 Richard Mlynarik (mly at prep) * nroff-mode.el (electric-nroff-mode): set-minor-mode correctly Thu Jan 2 00:11:54 1986 Richard Mlynarik (mly at prep) * info.el (Info-validate): Catch only real footnote references by using stricter regexp Allow multiple nodes to have the same `next' pointer as long as the next's previous points back to one of them. * info.el (Info-tagify, Info-validate): (let ((case-fold-search t)) ...) for when these functions are used outside info mode Mon Dec 30 15:06:33 1985 Richard M. Stallman (rms at prep) * rmailsum.el (rmail-new-summary): Avoid errors when there are zero messages to summarize. * startup.el: Make first line of greeting one character shorter. * chistory.el: command-history-map may not be sparse. * info.el (Info-extract-pointer, Info-previous): New optional 2nd arg to Info-extract-pointer is used instead of the 1st arg in any error message. Mon Dec 30 03:51:48 1985 Richard Mlynarik (mly at prep) * files.el (backup-buffer): Don't backup `weird' (non-character or link) files Sat Dec 28 06:56:56 1985 Richard M. Stallman (rms at prep) * mailalias.el (expand-mail-aliases): Go back to line beginning after finding a nonblank line-start that ends a header field. * info.el (Info-follow-reference): Match [ \n]* after *note when finding all refs. Fri Dec 27 19:30:39 1985 Richard Mlynarik (mly at prep) * view.el: Various: Fix cases of "view" => "View" which were missed. Damn. Fri Dec 27 12:23:18 1985 Richard M. Stallman (rms at prep) * simple.el (exchange-dot-and-mark): Define as an alias. Thu Dec 26 14:15:59 1985 Richard M. Stallman (rms at prep) * rmailsum.el (rmail-summary-mode): Run rmail-summary-mode-hook. Fri Dec 20 00:19:47 1985 Richard M. Stallman (rms at prep) * files.el (after-find-file): If noninteractive, don't print message and don't turn on auto-saving. * simple.el (describe-no-warranty): Use describe-copying as subroutine so start search from beginning of buffer each time. * term/xterm.el: Select interrupt-driven input when talking to X. Thu Dec 19 19:11:31 1985 Richard M. Stallman (rms at prep) * files.el: Provide dummy definitions of {un,}lock-buffer if they don't have definitions. Define a function ignore. Thu Dec 19 18:58:49 1985 Richard Mlynarik (mly at prep) * rnews.el (news-set-mode-line): Fix fencepost. Thu Dec 19 05:22:22 1985 Richard M. Stallman (rms at prep) * sendmail.el (mail-do-fcc): Insert a blank line after each message in the CC file. * fill.el (fill-region): It was not loking at the prefix arg! * loaddefs.el, nroff-mode.el: Add autoload for nroff-mode. Change its doc string a little. Wed Dec 18 00:03:14 1985 Richard M. Stallman (rms at prep) * texinfo.el (texinfo-format-buffer): Remove directory from Info file name as it appears in node headers. * userlock.el (ask-user-about-lock): Handle `p' response properly. Was looping and asking again. * x-mouse.el (x-mouse-set-mark): Don't use save-excursion; save only point, not the mark. * bg-mouse.el: Some bug fixes from jr; some documentation cleanups. * doctor.el (doctor-desire): Was using nonexistent function list*. Make it use append instead. * rmail.el (rmail-expunge): Discard summary lines for messages that change numbers. * rmailsum.el (rmail-make-basic-summary-line): save-excursion around finding the From: line. * doctor.el (doctor-read-token): Don't use forward-to-word. * simple.el (describe-copying): Move point to beginning of the file. Tue Dec 17 23:48:43 1985 Richard M. Stallman (rms at prep) * startup.el (command-line-1): Make startup message more concise; mention C-h t. Tue Dec 17 16:52:55 1985 Richard Mlynarik (mly at prep) * simple.el (goto-line): Accept either prefix arg or prompt in minibuffer Tue Dec 17 02:25:00 1985 Richard M. Stallman (rms at prep) * simple.el (help-for-help): Make help-for-help message be documentation of help-for-help so it goes into DOCSTR; gets rid of 1k of impure. Mention C-w and C-n in these messages. * mim-mode.el (mim-mode): Make mim-mode-map a sparse keymap. * shell.el: Make shell-mode-map a sparse keymap. Mon Dec 16 00:31:41 1985 Richard M. Stallman (rms at prep) * info.el (Info-summary): Add scroll capability if user types Space. * files.el (set-visited-file-name): Work properly in case of arg = nil or = "". * debug.el (debugger-frame{,-clear}) Bind off read-only flag to change buffer. Sat Dec 14 17:15:46 1985 Richard M. Stallman (rms at prep) * various: Change uses of copy-sequence on keymaps to copy-alist. Use run-hooks for all hooks. * simple.el (variable-at-point): Strip leading singlequotes before variable name. * rmailsum.el (rmail-summary-undelete): Rename rmail-summary-undelete-backward to this and make it undelete current message if that's deleted. Also win if no message to undelete. Flush the M-u command. * outline.el (outline-mode): Make lines starting with * separate paragraphs. Fri Dec 13 00:52:16 1985 Richard M. Stallman (rms at prep) * shell.el (run-lisp): Switch to the Lisp buffer that make-shell returns. * rmailedit.el (rmail-cease-edit): Make sure edited message text ends in a newline. Adjust the rmail-msgend pointer of the message to the new end. Make sure bfr isn't read-only while deleting old cached summary line. * rmail.el: Replace every real ^_ with a \ escape sequence. Make rmail-save always expunge. Skipping it if buffer isn't modified was a good try, but I think it makes things unpredictable; whether buffer is modified in Rmail doesn't always correlate with what the user is thinking about. * abbrev.el (prepare-abbrev-list-buffer, list-abbrevs, edit-abbrevs): Some cleanups. prepare-... now does all the work and returns the buffer for the caller to select or display. * subr.el: Rename feep to beep, a more traditional name. Thu Dec 12 17:54:02 1985 Richard M. Stallman (rms at prep) * abbrev.el (edit-abbrevs-mode): New function, used to make C-h m work right in that mode. * text-mode.el, c-mode.el, lisp-mode.el: Make major mode functions use run-hooks. * subr.el (run-hooks): New function; takes list of hook symbols and run each one. * simple.el (shell-command-on-region): Don't print message or display output if quit or error. * loadup.el: At end, on machines that cannot dump, eval top-level to run the normal command-line arg processing. * term/xterm.el: Set term-setup-hook. Was using wrong name. Convert arg to x-set-border-width to an int before calling. * rmail.el (rmail-display-label, rmail-set-message-counters): save-excursion must go outside save-restriction. * rmail.el (rmail-reply): Do save-excursion. Wed Dec 11 19:18:06 1985 Richard Mlynarik (mly at prep) * isearch.el (isearch-search): Don't feep after every single character added to a failing regexp isearch. * subr.el: (fset 'feep 'ding) to preserve purity of language. Wed Dec 11 00:50:36 1985 Richard M. Stallman (rms at prep) * simple.el (set-variable): Must bind minibuffer-help-form, not help-form. Also arrange for most of code to be compiled. Tue Dec 10 01:31:55 1985 Richard M. Stallman (rms at prep) * rmail.el (rmail): If file already visited, don't disturb it, just select it. * simple.el, subr.el, unused.el: Move general purpose subroutines from simple.el to new file subr.el. Some editing commands that are not on any keys and not otherwise used are moved to unused.el. * loadup.el: Load subr.elc first thing. * subr.el (copy-alist): New function, copies alist links and pairs. Many uses of copy-sequence should call this instead. * rmailsum.el (rmail-summary-exit): Bury the summary buffer. * rmailsum.el (rmail-summary-goto-msg): Erase the - in the summary line meaning message is unseen. * rmailout.el (rmail-output-to-rmail-file): Don't delete message if output was not done. * files.el (switch-to-buffer-other-window): Pass t as new second arg to pop-to-buffer. * indent.el (insert-tab): If indent-tabs-mode = nil, insert spaces instead. * debug.el (debug): Combine two unwind-protect's into one. Set debug-on-next-call at outermost level after the unwind-protect. The variable to request doing that is now called debug-step-after-exit. Mon Dec 9 19:26:42 1985 Richard Mlynarik (mly at prep) * rmail.el (rmail-save): Don't do possibly lengthy expunge if buffer not modified * loaddefs.el: (fset 'TeX-mode 'tex-mode) Sun Dec 8 01:56:06 1985 Richard M. Stallman (rms at prep) * files.el (normal-mode): New command to choose major mode automatically. * inc-vers.el: Renamed from inc-version.el for file name length reasons. * term/*.el: terminal-specific files found here now. term-*.el have been renamed to term/*.el. Changed makedist to handle this subdirectory. * paths.el: New variable term-file-prefix which now is "term/". * startup.el (command_line): Use term-file-prefix to compute file name to load. * bytecomp.el (byte-compile-file): Put output-buffer into Emacs-Lisp mode. Fixes lossage observed for autoloads by people who have set default-major-mode. Sun Dec 8 00:13:14 1985 Richard Mlynarik (mly at prep) * debug.el (debug): Bind debug-on-quit to nil within the debugger. * info.el (Info-find-node): Must search for "Node: Foo" not " Foo" or else would lose when there was a "Node: Bar Foo" * dired.el (dired-copy-file): interactive "F" not "s" * man.el (manual-entry): Allow user to specify "chdir(3)" to get entry from section 3 of the manual. Sat Dec 7 02:05:01 1985 Richard M. Stallman (rms at prep) * loaddefs.el: Remove duplicate autoload for convert-mocklisp-buffer. Add autoload for doctor. * simple.el (shell-command-on-region): Don't muck with the mark if called noninteractively. * tags.el (visit-tag-table): Really provide TAGS as default file name. * info.el: (Info-validate-node-name): Don't complain about nodes in other files. (Info-menu-sequence): fix typo in function name. * rmail.el: (rmail-save): new function; `s' and `q' commands now expunge. (rmail-set-attribute): Don't lose if buffer wasn't narrowed. (rmail-undelete-previous-message): Try current message first, then back up till deleted msg is found. M-u command removed as u now does its job. * bytecomp.el (byte-compile-file): Use get-buffer-create for making the temp buffers. Really! Fri Dec 6 01:22:18 1985 Richard M. Stallman (rms at prep) * simple.el (set-comment-column): Don't use this line's comment to set the comment column. * bytecomp.el (byte-compile-lambda): Don't treat (interactive) as having an expression be compiled. Recompile all 40 files affected; reduces Emacs pure code about 4k. * info.el: (Info-select-node): was searching unboundedly for "execute:". (Info-follow-reference): Was called Info-footnote. Also, handle presence of spaces and newlines in ref names. (Info-extract-menu-node-name): Handle presence of spaces and newlines in the node name. (Info-menu): Handle presence of spaces and newlines in item names. * texinfo.el: @ifinfo and @end ifinfo must use texinfo-discard-command. Handle @page (by ignoring it). * rmailkwd.el (rmail-next-labeled-message): Be consistent about `label' vs `labels'. Thu Dec 5 23:25:50 1985 Richard M. Stallman (rms at prep) * mh-e.el: Eliminate region-around-match and region-string. Thu Dec 5 18:44:46 1985 Richard Mlynarik (mly at prep) * rmail.el (rmail-search): Say if search failed. * compile.el (compile1): Rename compilation-error-format to compilation-error-message Add third arg (for mode-name) to compile1 and callers (grep) Use value of compilation-error-regexp from current buffer in the *compilation* buffer, thus allowing buffers to have local compilation-error-regexp variables. (provide 'compile) Thu Dec 5 03:02:59 1985 Richard M. Stallman (rms at prep) * files.el (recover-file): New command. * isearch.el (isearch, isearch-search): Call isearch-message from isearch-search; do not call before the usual call to isearch-search. Thu Dec 5 02:39:28 1985 Richard Mlynarik (mly at prep) * abbrev.el, chistory.el, debug.el, doctor.el, indent.el, info.el, sendmail.el: Fix initialization of mode-maps * sendmail.el (mail-position-on-field): Make this work Thu Dec 5 01:01:30 1985 Richard M. Stallman (rms at prep) * dired.el: Change "mark" to "flag" in function names and documentation. * buff-menu.el (Buffer-menu-buffer): End of buffer name marked by tab or two spaces. Wed Dec 4 02:55:28 1985 Richard M. Stallman (rms at prep) * startup.el (normal-top-level): Run new hook term-setup-hook after doing command switches. * startup.el (command-line-1): Run the term-setup-hook now, if no switches, so it is done before the initial message. * term-xterm.el: Set term-setup-hook. x-extract-number: Subtract 1 from any negative arg. * x-mouse.el (x-mouse-mode): Change name from just mouse-mode. Fix paren error. Change key for this to C-c C-m. * x-mouse.el (x-select-window): Was neglecting to actually select the window. * x-mouse.el: Define constant names for button keys: names like x-button-c-m-left. * rnews.el (news-mode): Don't make news-group-article-assoc buffer-local. Making it so causes rnews not to work; I don't know why. * outline.el (flag-lines-in-region): Pass fifth arg t to subst-char-in-region, for no undo. Tue Dec 3 22:56:05 1985 Richard M. Stallman (rms at prep) * simple.el (prefix-arg-internal and callers): Regularize reading of negative prefix arguments. Do the right thing for each possible input digit or - with each kind of existing value of prefix-arg. * simple.el (repeat-complex-command): If command to be repeated does not match first elt of command history, add it to the command history. Tue Dec 3 17:17:48 1985 Richard Mlynarik (mly at prep) * bytecomp.el (byte-compile-file-form): Reduce noninteractive message verbosity * ebuff-menu.el: Standardize initialization of Electric-buffer-menu-mode-map make digits, meta-digits and "-" be numeric args (put 'Electric-buffer-menu-undefined 'suppress-keymap t) * electric.el (Electric-command-loop): Set up this-command and last-command-char in command loop * simple.el (prefix-arg-internal, negative-argument): Fix problem with negative-arguments and unreading Tue Dec 3 04:30:56 1985 Richard M. Stallman (rms at prep) * texinfo.el (texinfo-format-buffer): Define @' and @` to convert to ' and ` but suppressing conversion into ". Thu Nov 28 19:22:58 1985 Richard M. Stallman (rms at prep) * rnews.el: Remove stray "<" character introduced by mly. (news-move-to-group): give error message if no new group to move to. (news-next-message): with arg of 1 or -1, keep doing news-next-group or news-previous-group till reach nonempty group. * x-mouse.el: Change define-key args from chars to strings. * view.el: Fix bug in defvar of view-mode-map. Wed Nov 27 21:32:14 1985 Richard M. Stallman (rms at prep) * files.el (find-file-no-select): Call find-file-not-found-hook if non nil when detect a file-error. * buff-menu.el (Buffer-menu-buffer): Simplify finding end of buffer name; don't get confused if buffer name ends with digits. Wed Nov 27 15:40:32 1985 Richard Mlynarik (mly at prep) * rnews.el: (news-mode, news-set-mode-line): Get rid of news-mode-group-string. * rnews.el (news-unsubscribe-internal): Fix confirmation message. Tue Nov 26 19:07:49 1985 Richard Mlynarik (mly at prep) * view.el: Define c-x o Rename interactive functions from view-* to View-* to improve m-x completion. defvar, rather than defconst, view-mode-map Take old-emacs-version-compatibility out of view-file * helper.el (Helper-describe-mode, Helper-describe-bindings) Fix bit-rot Hack C-l in Helper-help-scroller. Mon Nov 25 01:03:46 1985 Richard M. Stallman (rms at prep) * isearch.el (isearch-search): Remove call to isearch-message. * rnews.el: Flush old news-next-message. Rename old news-forward-message to that name. Sun Nov 24 17:45:12 1985 Richard M. Stallman (rms at prep) * rnews.el: Turn off use of numeric backup versions in news mode. Fri Nov 22 17:55:26 1985 Richard M. Stallman (rms at prep) * rnews.el: Fix incorrect syntax for meta chars in define-key args. Fri Nov 22 15:21:57 1985 Richard Mlynarik (mly at prep) * term-supdup.el: New file. Defines supdup-contol-map, supdup-control-meta-map for characters which don't exist in ascii. Uses 0237 (m-c-_) as control escape -- this is what the supdup server uses. Fri Nov 22 03:18:54 1985 Richard M. Stallman (rms at prep) * outline.el: Change text to body in function names and documentation. Rename M-H, M-S and M-s to C-c C-h, C-c C-s and C-c C-i. Goes with new manual chapter. Thu Nov 21 17:29:36 1985 Richard M. Stallman (rms at prep) * sendmail.el: Don't die in old Emacses that don't have delete-auto-save-file-if-necessary. Thu Nov 21 15:36:28 1985 Richard Mlynarik (mly at prep) * abbrev.el (quietry-read-abbrev-file): Fix typo. Fix documentation of edit-abbrevs. * options.el: Initialize Edit-options-map when loaded. Make edit-options-1 inline. * term-xterm.el: Fix documentation for x-switches Wed Nov 20 03:53:23 1985 Richard Mlynarik (mly at prep) * files.el, sendmail.el: New function delete-auto-save-file-if-necessary Make basic-save-file, mail-send call it * startup.el (command-line-1): Reformat to make all extraneous bs fit in 80 columns * lisp-mode.el (calculate-lisp-indent): Check for boundp lisp-indent-hook, not fboundp. * lisp.el, lisp-mode.el Move eval-last-sexp, eval-defun from lisp.el to lisp-mode.el since all their usages occur in the latter file. * rnews.el Use `mail-header-separator' * term-xterm.el: Define x-handle-switch-1 to modularize discarding of args from command-line-args. * startup.el (command-line-1): Check for command-switch-alist before checking for builtin switches. * bytecomp.el, term-xterm.el, tex-start.el Switches look for `command-line-args' rather than `args' Wed Nov 20 01:30:46 1985 Richard M. Stallman (rms at prep) * x-mouse.el: Thorough rewrite and cleanup. * rnews.el: Install new version from sundar. Rename news-go-to-* to news-select-*. Rename news-move-to-message to news-forward-message. Make news-{next,previous}-message take argument. Rename news-unsubscribe-group to news-unsubscribe-current-group. Rename news-unsubscribe-any-group to news-unsubscribe-group. Rename N and P and J commands to M-n, M-p, M-j. Flush + and - commands. Rename s command to o. Tue Nov 19 01:26:58 1985 Richard M. Stallman (rms at prep) * texinfo.el: Fix all texinfo-end property functions to call texinfo-discard-command instead of texinfo-discard-line. Give @ the syntax of escape character. * rmail.el (rmail-mode): Turn off auto-saving for rmail files. * simple.el (describe-no-warranty): New function; C-h C-w. * startup.el: Mention existence of C-h C-w. * shell.el (make-shell): Don't select the buffer being created; return it as value. Mon Nov 18 11:07:32 1985 Richard Mlynarik (mly at prep) * bytecomp.el (batch-byte-compile): Print a message for the log before terminating self. * simple.el (set-variable): Fix thinko in help-form, and include current value. * info.el (Info-find-node): If can't find node, say which node in error message * rmailedit.el (rmail-edit-mode): Improve documentation greatly, fix typo. Fri Nov 15 03:08:00 1985 Richard M. Stallman (rms at prep) * c-mode.el (indent-c-exp): Handle case of several lines inside a set of parentheses. Handle case of continuation line following parentheses that span lines. * replace.el (perform-replace): Reject match that is null string at end of previous replacement. * startup.el: Define command-switch-alist to provide hooks for X window system (or other things) to define new switches. Thu Nov 14 22:31:43 1985 Richard Mlynarik (mly at prep) * info.el Make "." be beginning-of-buffer Wed Nov 13 19:46:07 1985 Richard M. Stallman (rms at prep) * rmail.el (rmail-get-new-mail): Treat movemail case more like renaming case, so if rmail dies leaving a .newmail file the next use of rmail will read in and delete that .newmail. * rmail.el (rmail-mode, rmail, rmail-quit): Eliminate rmail-buffer-save. Make q go to the other-buffer. Tue Nov 12 14:17:53 1985 Richard Mlynarik (mly at prep) * bytecomp.el (batch-byte-compile): Fix paren error. * files.el (after-find-file): Accurately report the case in which a file exists but is not readable. * rmail.el (rmail-search): Rewrote this function. Now only searches within messages -- will not match across message boundaries. Fri Nov 8 17:03:53 1985 Richard Mlynarik (mly at prep) * startup.el (command-line): If noninteractive, don't load "term-*" noninteractive => -q [Change this if you think it is a bad idea rms -- every use of -batch I make is followed by -q...] Thu Nov 7 19:56:25 1985 Richard Mlynarik (mly at prep) * files.el (after-find-file): If get error hacking mode or local-vars, say what sort of error Wed Nov 6 13:21:55 1985 Richard Mlynarik (mly at prep) * bytecomp.el (byte-compile-lambda): Compile non-string `interactive' frobs Tue Nov 5 17:35:29 1985 Richard M. Stallman (rms at prep) * sendmail.el (sendmail-send-it): Remove "n" that was randomly inserted. Use new variable sendmail-program as name of file to run (defined in paths.el). Tue Nov 5 14:19:53 1985 Richard Mlynarik (mly at prep) * rmailsum.el (rmail-new-summary): Don't use create-file-buffer for summary buffer! * rmailsum.el (rmail-make-summary-line-1): Fix bug computing new summary line * debug.el (debug): Make recursive calls to the debugger work. Make debugger buffer read-only * sendmail.el (mail-send, sendmail-send-it): Move some stuff from sendmail-send-it to mail-send Delete auto-save #%*mail* file if `delete-auto-save-files' * electric.el (Electric-command-loop): condition-case for `beginning-of-buffer' Tue Nov 5 01:03:53 1985 Richard M. Stallman (rms at prep) * rmail.el, rmailsum.el, rmailkwd.el: Move definition of rmail-last-multi-labels from rmailkwd to rmail. Make rmail-summary-by-labels use it as default and set it. Mon Nov 4 05:45:40 1985 Richard Mlynarik (mly at prep) * yow.el, loaddefs.el: Function yow. Depends on file emacs/etc/yow.lines Mon Nov 4 03:48:33 1985 Richard M. Stallman (rms at prep) * texinfo.el: Remove definition of `@points' Make texinfo-parse-arg-discard on a command with a whole-line arg discard the whole line including the final newline. As a result, texinfo-discard-line no longer works after texinfo-parse-line-arg; make all such callers use texinfo-parse-arg-discard. * rmail.el: Rename rmail-find to rmail-search and put on M-s. Move `h' to C-M-h as well. Move `l' to C-M-l as well. Move old C-M-l to C-M-r. * rmailkwd.el: Make rmail-next-labeled-message keep its own default rmail-last-multi-labels, instead of using rmail-last-label. Fri Nov 1 16:09:23 1985 Richard M. Stallman (rms at prep) * rmail.el (rmail-parse-file-inboxes): Must do save-excursion outside the save-restriction. Thu Oct 31 23:09:01 1985 Richard M. Stallman (rms at prep) * rmail.el: (rmail-mode) don't default rmail-inbox-list here. (rmail): Default rmail-inbox-list to rmail-primary-inbox-list only if primary Rmail file. rmail-primary-inbox-list now in loaddefs.el. Thu Oct 31 15:58:34 1985 Richard Mlynarik (mly at prep) * rmailsum.el (rmail-make-summary-line-1): Fix case in which old summary line was being deleted. Some more bugs seem to remain in this code... * dired.el: Both "e" and "f" are `dired-find-file' Wed Oct 30 12:23:11 1985 Richard Mlynarik (mly at prep) * bytecomp.el (batch-byte-compile): If an argument is a directory, then do a byte-recompile-directory on it. * abbrev.el (abbrev-mode): flag that abbrev-mode is on by set-minor-mode (automagic indication in src/xdisp.c flushed) Use interactive "f" and "F" to replace "s" in a couple places. Tue Oct 29 18:50:27 1985 Richard M. Stallman (rms at prep) * debug.el (debug): Don't die in kill-buffer of *Backtrace* while exiting if it's already killed. * simple.el ({append,prepend,copy}-to-buffer): Use interactive type B, not s, for buffer name. Tue Oct 29 16:13:40 1985 Richard Mlynarik (mly at prep) * startup.el (command-line-1): "-l" switch loads wrt load-path, rather than wrt default-directory Tue Oct 29 02:37:59 1985 Richard M. Stallman (rms at prep) * isearch.el (isearch): Redisplay echo area with ... before searching, or without ... when about to wait for input. * simple.el (blink-matching-open): Don't ever complain that a math char is mismatched. Mon Oct 28 01:13:52 1985 Richard M. Stallman (rms at prep) * rmail.el, rmailsum.el, rmailkwd.el, rmailmsc.el, rmailout.el, rmailedit.el: Install thoroughly rewritten rmail with many new features. * debug.el (debug, debugger-mode): Avoid lossage with random default major mode: debugger-mode: use lisp-mode syntax table. debug: turn on debugger-mode before doing forward-sexp. Sat Oct 26 18:34:32 1985 Richard M. Stallman (rms at prep) * simple.el: Define C-c globally as a prefix character. * files.el (backup-buffer): Catch errors in deleting old backup versions; one deletion failure does not stop other deletions. * files.el (hack-local-variables): Comparing against "end" was supposed to ignore case but it failed to do so. Fri Oct 25 15:48:03 1985 Richard M. Stallman (rms at prep) * userlock.el: Change responses to "p" for "proceed" and "q" for "quit". Wed Oct 23 10:39:25 1985 Richard Mlynarik (mly at prep) * mouseinit.el Delete this file. Put its contents in files term-bg.el, term-bgnv.el, term-bgrv.el, term-bbn.el (Perhaps there should be a subdirectory emacs/lisp/term/ ??) Wed Oct 23 01:23:19 1985 Richard M. Stallman (rms at prep) * time.el (display-time): Set up process with no associated buffer. Tue Oct 22 14:36:39 1985 Richard Mlynarik (mly at prep) * debugger.el (debug): Bind variable `debugger-value' instead of `value' * userlock.el: Give `file-locked' error-conditions and error-message props Mon Oct 21 17:28:49 1985 Richard M. Stallman (rms at mit-prep) * c-mode.el (c-comment-indent): Since this is for indent-for-comment, it should use comment-column rather than indenting like code. * shell.el (shell-send-input): Detect when arg of cd or pushd is ended with a semicolon. Mon Oct 21 05:50:23 1985 Richard Mlynarik (mly at mit-prep) * sendmail.el (mail-do-fcc): Do cretinous unix ">" `quoting' of "\nFrom " strings (this isn't transparent, but it's what other stupid programs expect) * mailalias.el (expand-mail-aliases): Hack case-fold-search as appropriate Mon Oct 21 00:36:22 1985 Richard M. Stallman (rms at mit-prep) * sendmail.el (mail-do-fcc): New function that finds Fcc: fields and writes to spec'd files in Unix mail format. Var mail-archive-file-name holds nil or name to initialize every message with an Fcc to. Defined here and in loaddefs. * sendmail.el (sendmail-send-it): Use a temp buffer to avoid hair in un-changing user's buffer. Kill temp and error buffers on exit, always. If any Fcc is present, call mail-do-fcc. Sun Oct 20 01:42:00 1985 Richard M. Stallman (rms at mit-prep) * mailalias.el: New file containing build-mail-aliases (called if nec from mail-setup) and expand-mail-aliases (called if nec from sendmail-send-it) that read ~/.mailrc, make an alist of mail aliases in mail-aliases, and expand them inside the buffer in a message being sent. * sendmail.el (mail-setup): Call build-mail-aliases if ~/.mailrc exists. * sendmail.el (sendmail-send-it): Call expand-mail-aliases if any aliases are defined. * loaddefs.el: Define mail-aliases: initially t, meaning ~/.mailrc has not been looked at yet. Define mail-header-separator. Make define-mail-alias autoload from mailaliases. Move rmail-delete-after-output from rmail.el. Flush rmail-mmdf-inbox-list and rmail-make-summary-line-function. * mail-utils (mail-strip-quoted-names): Delete leading and trailing whitespace. Sat Oct 19 04:13:49 1985 Richard M. Stallman (rms at mit-prep) * sendmail.el: Use new var mail-header-separator in place of constant --text... (mail-setup): fill the To and Cc text inserted. Assume <...> constructs were handled by mail-strip-quoted-names. (mail-fill-yanked-message): Add this and put on C-c q. (mail-mode): Set up mail-mode-map when file is loaded. Run text-mode-hook before mail-mode-hook. (mail-send-and-exit): Assume bury-buffer exists. (sendmail-send-it): Put in a Sender: if From: is specified. If empty Subject: is removed, put it back in afterward. * debug.el (debug): Save match-data on entry, and do store-match-data on exit. * mail-utils: mail-string-delete: Make arg END exclusive. mail-strip-quoted-names: flush spaces before stuff being flushed. Compensate for change to mail-string-delete. Use fact that string-match sets match-end. rmail-dont-reply-to: flush extra spaces, comms after deleted name. Compensate for change to mail-string-delete. Use fact that string-match sets match-end. Fri Oct 18 16:21:17 1985 Richard Mlynarik (mly at mit-prep) * startup.el (command-line): load "term-$TERM" after loading user's init file, so that changes made to load-path will affect load . Fri Oct 18 00:29:25 1985 Richard M. Stallman (rms at mit-prep) * mlsupport.el (move-dot-to-x-y): Add a definition of this. Takes args in origin 1. * shell.el (shell-send-eof): Rename delete-char-or-send-eof to this, and make it always only send eof. Thu Oct 17 21:03:15 1985 Richard M. Stallman (rms at mit-prep) * replace.el (how-many): Start count at 0, not 1. Ignore matches of null string that don't move point. Thu Oct 17 15:02:34 1985 Richard Mlynarik (mly at mit-prep) * rnews.el: (news-save-item-in-file) Append to file, rather than overwriting. * isearch.el Eliminate confused attempts at indicating that long isearch was `in progress' Tue Oct 15 18:29:01 1985 Richard M. Stallman (rms at mit-prep) * info.el: Use C-c C-c to exit Info-edit. * shell.el: Move the mode-specific commands onto C-c prefix. * picture.el: Move all C-c commands to other C-c subcommands. * echistory.el, ebuff-menu.el: Change C-c command to C-c C-c. * rmailedit.el: Move C-] command to C-c C-], C-c command to C-c C-c. * files.el (find-backup-file-name): Change termination of numeric backup file names back to `~'. * dired.el (dired-clean-directory & subroutines): Adapt for change from .NN to .~NN~ in numeric backup file names. * simple.el (suppress-keymap): Put negative-argument on '-'. Put non-nil suppress-keymap properties on the commands that are used in suppressing a keymap. Tue Oct 15 05:43:14 1985 Richard Mlynarik (mly at mit-prep) * bytecomp.el (byte-compile-find-vars-1) Fix paren error. Tue Oct 15 00:51:54 1985 Richard M. Stallman (rms at mit-prep) * paths.el: New file containing defs of vars containing names of files or directories that Emacs wants to refer to. Collected for convenience of customization. * rnews.el, mh-e.el, loaddefs.el: Comment out or remove stuff now in paths.el. * spell.el: Remove explicit directory names from programs run in subforks. * lpr.el (print-region-1): Remove explicit directory names from programs run in subforks. Mon Oct 14 19:03:18 1985 Richard M. Stallman (rms at mit-prep) * bytecomp.el (byte-compile-find-vars): Change many nested ifs to one cond. * mlsupport.el: Replace all uses of "e with macros. Sun Oct 13 02:00:28 1985 Richard M. Stallman (rms at mit-prep) * texinfo.el: Define @dots{} and @copyright{}. Define indexing commands to generate each index as a menu sorted alphabetically. Sat Oct 12 18:13:14 1985 Richard M. Stallman (rms at mit-prep) * mh-e.el: Don't mess with track-eol. Define mh-insert-message-buffer, as C-c y while editing message. New reply option `i'. Fri Oct 11 02:21:44 1985 Richard M. Stallman (rms at mit-prep) * info.el (Info-edit-map): Use C-c to exit from editing, not C-z. * files.el (hack-local-variables): Ignore case in checking for End:. Allow backslashes to quote in local variable names. Thu Oct 10 03:08:43 1985 Richard M. Stallman (rms at mit-prep) * c-mode.el: Make require-final-newline be t in C mode. * tex-mode.el (TeX-mode): Make comment-start-skip check that % is not quoted with \. * simple.el (indent-for-comment): Save result of first search for a comment starter, rather than searching again after reindenting. Wed Oct 9 00:21:31 1985 Richard M. Stallman (rms at mit-prep) * tags.el (find-tag): Make M-, find the next such tag, if used after M-. * files.el (find-backup-file-name): Make numeric backup names end in # rather than ~ so they arenot automatically deleted when two days old. * nroff-mode.el (nroff-mode): Make all .-commands separate paragraphs. * dired.el (dired-rename-file): Use code F to read the file name. * shell.el (shell-send-input): Use three new variables shell-{cd,pushd,popd}-regexp to match the command names "cd", "pushd" and "popd". * tex-mode.el (TeX-flash-$): Don't look for "match" for a $ quoted with a \. * c-mode.el (indent-c-exp): Call c-backward-to-start-of-if only for statements and only when they start with "else". Tue Oct 8 19:09:55 1985 Richard M. Stallman (rms at mit-prep) * mlsupport.el: Define region-to-string and region-around-match. * simple.el ({beginning,end}-of-buffer): Warn people not to use in Lisp code. Mon Oct 7 23:25:21 1985 Richard M. Stallman (rms at mit-prep) * userlock.el: New file containing function ask-user-about-lock (autoloading), called when trying to modify a function another has locked. * files.el (find-alternate-file): Unlock the old file before finding new file. Relock the old one if old buffer is not killed. * files.el (set-visited-file-name): Unlock old name and relock new one (if should be locked). * replace.el (perform-replace): Do substitute-command-keys on the help message. Mon Oct 7 17:16:10 1985 Richard Mlynarik (mly at mit-prep) * simple.el (eval-expression): Put "(foo bar)" rather than "(eval-expression (quote (foo bar)))" on the command history if called interactively. * simple.el (repeat-complex-command): Define commands next-complex-command and previous-complex-command for use in repeat-complex-command editing. Sat Oct 5 01:51:12 1985 Richard M. Stallman (rms at mit-prep) * debug.el (debug): Bind debug-on-error to nil over entire invocation of debugger. * everywhere: Change dot to point. * Many major mode commands: Use \{..} in documentation string. Initialize the local map when the file is loaded, not when mode is invoked. Fri Oct 4 00:43:48 1985 Richard M. Stallman (rms at mit-prep) * indent.el (indent-relative-maybe): New function to do indent-relative but not if prev line has no indentation. Used as the indent-line-function in indented-text-mode (text-mode.el). * bytecomp.el (byte-compile-cond): Correct handling of final cond-clause with only one element. * simple.el (read-quoted-char): Avoid clearing quit-flag if not 1st input char. No longer any reason to quit explicitly. * simple.el (quit): Flush this function. Keep keyboard-quit. * view.el (view-scroll-lines-forward): Count screen lines. Preserve overlap if scroll by full length of the window. Thu Oct 3 16:58:57 1985 Richard Mlynarik (mly at mit-prep) * simple.el Functions quit, keyboard-quit * isearch.el: "I-searching: foo..." in the middle of possibly lengthy search * files.el (set-auto-mode): Don't hack auto-mode-alist at all if -*- mode -*- is specified. Wed Oct 2 00:30:49 1985 Richard M. Stallman (rms at mit-prep) * mh-e.el: Put *'s in doc of user option vars. New variable mh-use-mhl; in mh-show, causes mhl to be invoked. Fix some mode lines: add %-, remove %p, move %[ and %]. Remove spurious setting of mark when saving a position will do (in mh-get-new-mail, mh-make-mode-line, mh-pick-body, mh-exec-cmd) Flush erroneous & from some refs to command names. Define mh-exec-lib-cmd-output. * tex-mode.el: Rename TeX-make-barr into barrier-for-TeX, and remove it from M-$. Rename quotestartp to TeX-quotestartp. Rename count-$s to TeX-count-$-occurrences, and make it take two args (FROM and TO). * compile.el (compilation-find-errors): Search for compilation-error-regexp, which matches the ENTIRE filename/linenumber, not just the stuff between the two. The rest of the code had to change to fit. New subroutine compilation-grab-filename. * files.el (find-backup-file-name): Put ~ before and after version numbers of backup files. * files.el (backup-buffer): Ask only once, to delete all the excess backup versions. Sun Sep 29 15:05:27 1985 Richard M. Stallman (rms at mit-prep) * backquote.el: New file, containing a list constructor macro. * tex-mode.el: New file, containing TeX-mode. Sat Sep 28 06:27:18 1985 Richard M. Stallman (rms at mit-prep) * abbrev.el (add-abbrev, inverse-add-abbrev): Convert the abbrev to lower case before defining. * files.el (set-auto-modes): Strip backup suffix from file name before scanning auto-mode-list. Remove tilde-terminated entries from auto-mode-list. * dired.el: Add command `.', dired-clean-directory, plus subroutines. * files.el (backup-buffer, save-file): Replace backup-buffer with new version backup definition. Rename save-file as basic-save-file, and add a new save-file that calls the old one but also takes args to control backup. Several new variables to control making of backups. Fri Sep 27 19:52:35 1985 Richard M. Stallman (rms at mit-prep) * dired.el (dired-mode): Define n and p like C-n and C-p. Tue Sep 24 22:45:32 1985 Richard M. Stallman (rms at mit-prep) * loaddefs.el, text-mode.el: Use non-saved-text-mode for files on /tmp. * rmailsum.el (rmail-summary-goto-msg): Do check for msg # on line at beginning of line, not at point. Sat Sep 21 18:59:11 1985 Richard M. Stallman (rms at mit-prep) * files.el (find-file-noselect): Do erase-buffer in case reusing existing buffer. Wed Sep 18 00:22:25 1985 Richard M. Stallman (rms at mit-prep) * nroff-mode.el: New file, extensively rewritten from submission by N. Ziring. Not tested yet (I don't know how to use nroff). Fri Sep 13 14:42:29 1985 Richard M. Stallman (rms at mit-prep) * simple.el (what-cursor-position): Use single-key-description to show the character after point. Thu Sep 12 15:49:41 1985 Richard M. Stallman (rms at mit-prep) * text-mode.el, c-mode.el: No need to define syntax of [, ], {, } since fundamental mode now makes them paren-syntax. Define C operators as punctuation rather than whitespace. * texinfo.el: Change syntax for @xref and @pxref to use braces. Change syntax for @node to read entire line (new function texinfo-format-parse-line-args for that). Change paragraph-separate, etc., so only directives without braces separate paragraphs. When formatting, discard all of the file up to the @setfilename. * rmailedit.el (rmail-edit-mode): Remove spurious quote before text-mode-hook. Wed Sep 11 14:47:54 1985 Richard M. Stallman (rms at mit-prep) * dired.el (dired-do-deletions): Print a message reporting any deletion failures. * dired.el (dired-add-entry): Pass "-d" switch to "ls". Tue Sep 10 16:11:00 1985 Richard M. Stallman (rms at mit-prep) * text-mode-el, lisp-mode.el, c-mode.el, buff-menu.el: Initialize all keymaps at load time. Use new \{...} construct for documenting them. * simple.el (shell-command-on-region): Don't request redisplay during reading of output. That feature stimulates kernel bugs. Sun Sep 8 18:43:51 1985 Richard M. Stallman (rms at mit-prep) * simple.el (edit-and-eval-command): Assume arg is expression already, since now elements of command-history are expressions. * simple.el (error): Just keep signalling if user tries to continue. Sat Sep 7 12:14:35 1985 Richard M. Stallman (rms at mit-prep) * dired.el: Normally put cursor at beginning of filename. New functions dired-next-line and dired-previous-line to do vertical motion followed by positioning. dired-repeat-over-lines hacked likewise. Most action functions changed to work independent of and without effect on cursor position within line. * dired.el (dired-view-file): If file is directory, dired it. * dired.el (dired-other-window): Use switch-to-buffer-other-window if that exists. * files.el (switch-to-buffer-other-window): Define this function in Lisp. All other "...-other-window" functions should use it to do selection. * fill.el (fill-region-as-paragraph): Convert newline to space before flushing excess spaces. * mlsupport.el: Deleted ml-forward-word and ml-backward-word since mlconvert no longer generates them. Fri Sep 6 16:32:05 1985 Richard M. Stallman (rms at mit-prep) * files.el (revert-buffer): Don't query for reverting read-only buffers. * time.el (display-time-filter): If we have lots of tims received at once, quickly discard all but last few. * files.el (after-find-file): Check for write permission there, and print messages there. after-find-file now expects an arg which is t if file does not actually exist; it prints (New file) messages too. * lisp-mode.el (indent-sexp): If skip a newline, clear quoted flag in the state. Thu Sep 5 11:52:28 1985 Richard M. Stallman (rms at mit-prep) * tags.el (visit-tag-table[-...]): Rename to visit-tags-table[-...]. Thu Sep 5 09:40:43 1985 Richard M. Stallman (rms at mit-prep) * mh-e.el (mh-letter-mode): Have separate map mh-letter-mode-map so Don't clobber text-mode-map. Use C-c rather than C-x for local prefix commands. * simple.el (shell-command-on-region): If current buffer is *Shell Command Output*, avoid being confused by an old pair of region ends, since often region is empty and doesn't matter anyway. Tue Sep 3 22:42:05 1985 Richard M. Stallman (rms at mit-prep) * spell.el (spell-word): Check word before point, if point is not in or next to a word. * tags.el (find-tag): Don't read tag name if given prefix arg. Tue Sep 3 14:36:23 1985 Richard Mlynarik (mly at mit-prep) * macros.el (kbd-macro-query) Barf if not defining or executing keyboard macro. Mon Sep 2 16:42:55 1985 Richard M. Stallman (rms at mit-prep) * rmail.el (rmail-expunge): If all mesages thru current one get expunged, show message 1. * debug.el (debug): Bind debug-on-error and print-length to avoid various kinds of infinite loops or recursions. Sun Sep 1 19:17:53 1985 Richard M. Stallman (rms at mit-prep) * term-vt100.el: Always define ESC O so arrows work. Eliminate ESC [ hacks entirely. * term-vt200.el: Always define ESC O so keypad works. Rename the function to use for defining ESC [, and give it appropriate documentation. * lisp.el (move-past-close-and-reindent): Handle correctly case where ) passed is not at beg of line except indentation, or where there are white lines preceding it too. Sat Aug 31 13:24:28 1985 Richard M. Stallman (rms at mit-prep) * chistory.el (repeat-matching-complex-command): Arg to edit-and-eval-command is now a list, as it should be. Sat Aug 31 04:32:08 1985 Richard Mlynarik (mly at mit-prep) * simple.el (delete-indentation) Don't err if on first line of buffer. Fri Aug 30 22:39:12 1985 Richard M. Stallman (rms at mit-prep) * ledit.el (ledit-setup): Don't refer to lisp-mode-map in setting up ledit-mode-map. Mon Aug 26 12:42:24 1985 Richard Mlynarik (mly at mit-prep) * shell.el Sending empty line of input at the end of a buffer that is an interaction with a promptless shell program copied previous input rather than sending an empty line. (by silogic!eggert@ucla-cs) Tue Aug 20 17:43:51 1985 Richard Mlynarik (mly at mit-prep) * dired.el, files.el, sendmail.el, compile.el Make *-other-window really do other window even if pop-up-windows is set to nil. Sat Aug 17 19:07:24 1985 Richard Mlynarik (mly at mit-prep) * c-mode.el (c-indent-line) Make "^[ \t]*#" indent to 0 (if not in string or comment) * startup.el (command-line) (or (getenv "USER") (getenv "LOGNAME")) for USG compatibility (consider it a standard) * lpr.el Typo (``format1'' for ``format'') Mon Aug 12 14:39:11 1985 Richard Mlynarik (mly at mit-prep) * buff-menu.el (Buffer-menu-buffer) Win more often on `too-long' buffer names. Sun Aug 11 10:44:22 1985 Richard Mlynarik (mly at mit-prep) * make narrow-to-page be disabled by default. * rmail.el (rmail-insert-inbox-text) Hack case that /usr/spool/mail/user is a directory Sat Aug 10 23:42:57 1985 Richard Mlynarik (mly at mit-prep) * isearch.el (isearch) Make isearch work in regexp case Fri Aug 9 13:17:46 1985 Richard Mlynarik (mly at mit-prep) * c-mode.el (c-comment-indent) Return a valid value when used within a comment. (such as when inenting when comment-multi-line is non-nil) Associated changes to c-indent-line, c-calculate-indent-within-comment * debug.el (debug): Use buffer "*Backtrace*", not " *Backtrace*" so that users can reselect it trivially. Kill the buffer on exit so that users aren't tempted to lose weirdly. Rename "args" "debugger-args" so that common var isn't lambda-bound. Make "-" be negative-argument in debugger-mode-map * rnews.el (news-convert-format): Don't lose on empty messages. * term-vt100.el, term-vt200.el Make "application mode" arrow keys ("\eOA"... "\eOD") do the right thing. Tue Aug 6 01:48:59 1985 Richard Mlynarik (mly at mit-prep) * c-mode.el calculate-c-indent was ignoring parse-start arg Inserted jdf@prep.mit.edu's `else' indentation code Make C-j be reindent-then-newline-and-indent to take advantage of this. * simple.el Added function reindent-then-newline-and-indent * rnews.el Fix typo and supply function news-show-all-headers * startup.el Make the value of args be the remaining command-line arguments after the "-e" function name when the "-e" function is called. Make "-f" be the same as "-e" --- it's in the manual. * bytecomp.el Added batch-byte-compile written by crl@newton.purdue.edu * isearch.el Typing C-s/C-r at start of isearch wasn't displaying search string until it had completed the search. * indent.el (indent-relative) Losing when indentation point was beneath non-whitespace * c-mode.el (indent-c-exp): Replace "2" with "c-continued-statement-offset" Add (message "...") * mlsupport.el Fix typo in ml-current-indent Make kill-to-end-of-line work * mlconvert.el Hack "(forward-word)" => "(forward-word 1)" Mon Aug 5 12:34:00 1985 Richard Mlynarik (mly at mit-prep) * c-mode.el Variable "c-continued-statement-indent" should have been "c-continued-statement-offset" as in the documentation and manual * rmail.el (rmail-find): Hack default of last search string, hack reverse search (-ve prefix arg) Make "-" be negative-argument Tue Jul 23 20:47:38 1985 Richard Mlynarik (mly at mit-prep) * shell.el (shell-send-input): cd/pushd hackery wasn't substitute-in/expand-file-name'ing (ie "cd $es" was losing) Tue Jul 16 21:24:50 1985 Richard Mlynarik (mly at mit-prep) * view.el: Add "c-x ]" and "c-x [" page-movement commands "c-x /" "c-x j" register save/jump Speed up more losingly slow calls to substitute-command-keys by conditional substitution of constant string. (view-helpful-message, view-undefined, view-mode-command-loop) * mail-utils.el rmail-dont-reply-to was losing on multi-line fields. * simple.el delete-blank-lines was deleting too much if on an isolated blank line. Fri Jul 12 14:29:31 1985 Richard M. Stallman (rms at mit-prep) * mh-e.el: Replace C-h command with DEL so Help is still available. get-string was erroneously used for read-string. Wed Jul 10 20:24:14 1985 Richard M. Stallman (rms at mit-prep) * simple.el (function-called-at-dot): Don't scan more than 1000 characters back for containing open-paren. * simple.el (goto-line): Read arg using minibuffer. * simple.el (zap-to-char): Don't leave dot on the far side of the terminating character. Wed Jul 10 11:51:10 1985 Richard Mlynarik (mly at mit-prep) * ebuff-menu.el (Electric-buffer-menu-undefined) Don't call substritute-command-keys if keybindings are default, with resultant couple-of-orders-of-magnitude speedup. RMS: this is what my changes to Fsubstitute_command_keys in doc.c were supposed to do. Tue Jul 9 01:36:56 1985 Richard M. Stallman (rms at mit-prep) * isearch.el (isearch): Do not preserve window-start if had switched to the small window. * dissociate.el: Pause after each screen. Avoid forward-char past end of buffer. Make positive arg mean go by chars, negative mean by words. * lpr.el: Define lpr-region and print-region. Autoload in loaddefs. Mon Jul 8 04:55:18 1985 Richard M. Stallman (rms at mit-prep) * compile.el (compile1): Put buffer in Fundamental mode, in case default-major-mode is something else. * mh-e.el: backup-before-writing -> make-backup-files. mh-clean-message-header: kill only one line, not 2. * ledit.el (ledit-from-lisp-mode): Call ledit-mode-hook. * rmail.el (rmail-mode-1): Include %M in the mode-line-format. * abbrev.el: Document meaning of negative arg to add-...-abbrev. * loaddefs.el: C-x - and C-x C-h had the wrong definitions. * debug.el: Document the `r' command. Sun Jul 7 18:30:57 1985 Richard M. Stallman (rms at mit-prep) * view.el, buff-menu.el, ebuff-menu.el, echistory.el: Do not redefine C-z. Allow it to exit from Emacs. Sat Jul 6 00:12:26 1985 Richard M. Stallman (rms at mit-prep) * page.el (forward-page): Avoid setting the mark. * c-mode.el (calculate-c-indent, indent-c-exp): Don't subtract c-brace-offset when c-indent-level is used. Fri Jul 5 05:39:12 1985 Richard M. Stallman (rms at mit-prep) * indent.el: Put tab-to-tab-stop on Meta-i. Thu Jul 4 03:15:10 1985 Richard M. Stallman (rms at mit-prep) * files.el (hack-local-variables): Local variable list must start within last page of file and within last 3000 characters; there need not be a page boundary in the last 3000 characters, or anywhere near the end, however. * mlconvert.el: Convert backup-before-writing and unlink-checkpoint-files. * files.el: Rename backup-before-writing to make-backup-files. Rename auto-save-visited-filename to auto-save-visited-file-name. Wed Jul 3 16:28:09 1985 Richard M. Stallman (rms at mit-prep) * dired.el (dired-revert): Avoid error if point is at a non-file line. * abbrev.el (expand-region-abbrevs): Record end of region as distance from dot-max, so it remains correct as abbrevs are expanded. * startup.el (command-line-1): Quote the backslash in the regexp for line-number specs. Tue Jul 2 00:09:45 1985 Richard M. Stallman (rms at mit-prep) * c-mode.el (c-indent-line): * lisp-mode.el (indent-code-rigidly): C-u Tab in C mode: do indent lines starting in middle of a comment, but don't indent preprocessor lines. Involves new arg NOCHANGE-REGEXP to indent-code-rigidly. * rmail.el (rmail-show-message): Don't print a blank message, in case where no message to print. * c-mode.el (calculate-c-indent): Use new variable c-continued-statement-indent to determine extra indentation in lines not starting new statements. Mon Jul 1 23:59:51 1985 Richard M. Stallman (rms at mit-prep) * man.el: Catch the error if one of the directories searched does not exist. Mon Jun 24 03:45:06 1985 Richard M. Stallman (rms at mit-prep) * simple.el (help-map): Define C-h b as describe-bindings and C-h s as describe-syntax. Update documentation of help and help-for-help prompts for this. Sat Jun 22 18:22:26 1985 Richard M. Stallman (rms at mit-prep) * compile.el (compilation-sentinel): Advance dot if dot is at end of buffer. Sat Jun 22 17:31:56 1985 K. Shane Hartman (shane at mit-prep) * rmailedit.el: New file. The guts of rmail edit mode. * rmailsum.el: New file. The guts of rmail summary mode. * rmail.el: Massage it a bit to reduce the size. Put edit, summary stuff in separate files and autoload from rmail. (provide 'rmail). * helper.el (Helper-help-scroller): If there is already a *Help* window. Don't make another. Sat Jun 22 16:36:30 1985 Richard M. Stallman (rms at mit-prep) * simple.el (set-variable): New function. Tue Jun 18 01:36:16 1985 K. Shane Hartman (shane at mit-prep) * rmail.el: Massively rehacked. Better label support. Message selection, deletion and expunging by dispatch. Toggle rmail and original headers. etc... Tue Jun 18 00:27:55 1985 Richard M. Stallman (rms at mit-prep) * shell.el: Create variable explicit-shell-file-name that overrides ESHELL and SHELL environment vars. * isearch.el (isearch, nonincremental-search): Use explicit "%s" when calling message so %'s in message are not special. * bytecomp.el (byte-compile-file-form): Display name of function being compiled in echo area. * bytecomp.el (byte-compile-find-vars-1): Expand macros in order to find all the vars. Mon Jun 17 17:22:57 1985 Richard M. Stallman (rms at mit-prep) * compile.el (compile1.el): If *compilation* is current buffer, put point at end. * simple.el (indent-for-comment, kill-comment, set-comment-column, indent-new-comment-line): use comment-start-skip to find comments. Don't use find-comment-line any more. * lisp-mode.el, c-mode.el, scheme.el, mim-mode.el: Define comment-start-skip so it does not match the null string. * c-mode.el (electric-c-terminator): Don't use find-line-comment--use parse-partial-sexp to check for line ending in a comment. * startup.el (command-line-1): Define +nnn line-number specs. Use precomputed help string for speed instead of substitute-command-keys when the precomputed string is correct. * bytecomp.el (byte-compile-concat): concat with one arg is not a no-op. Sun Jun 16 02:26:00 1985 K. Shane Hartman (shane at mit-prep) * sendmail (mail-mode): Mention that C-c y will yank current message in rmail whether replying or not. * mail-utils (rmail-dont-reply-to): If rmail-dont-reply-to-names is nil, make it be (getenv "USER"). Sat Jun 15 01:41:35 1985 Richard M. Stallman (rms at mit-prep) * simple.el, lisp-mode.el, c-mode.el, scheme.el: comment-indent-hook now called with no args, with point at beginning of existing comment or at end of line. mim-mode's comment-indent-hook seems to need no change. Fri Jun 14 20:12:32 1985 K. Shane Hartman (shane at mit-prep) * loaddefs.el (rmail-dont-reply-to-names): Misleading documentation said `list' of names. Its really a regular expression. Make it nil by default. Also, add defconst for `rmail-spool-directory'. * mail-utils.el (rmail-dont-reply-to): Check for nilness of rmail-dont-reply-to-names and skip strip loop if so. * loaddefs.el: Elisp -> Emacs-Lisp. * echistory.el, chistory.el: Elisp -> Emacs-Lisp. * rmail.el: Various functions - If message counters aren't set, set them. Expunge unsets them. Make expunge give running count in minibuffer messages. Fri Jun 14 19:19:30 1985 Richard M. Stallman (rms at mit-prep) * lisp-mode.el, startup.el, loadup.el: Avoid problem with term "elisp". Rename elisp-interaction-FOO to lisp-interaction-FOO, rename all other elisp-FOO to emacs-lisp-FOO. Fri Jun 14 05:40:11 1985 K. Shane Hartman (shane at mit-prep) * rmail.el (rmail-mode-1): Use %b instead of %17b in mode-line-format to leave more room for attributes (some of us like time in the modeline). * rmail.el: Make rmail-summary-goto-msg barf if the summary is invalid (e.g. after `e' or `g') and tell user to make a new one, leaving them in the rmail window which is right place to do it. * rmail.el: Add commands for user to set attributes. rlk called these keywords and duplicated code (the only `attributes' were "deleted" and "answered"). I don't think the distinction is worth it. Add command for summarizing by attribute. Make `rmail-new-summary' support it. * rmail.el (rmail-show-message): search instead of re-search. * rmail.el (rmail-output-to-mail-file): Yechh. Cleaned it up. * rmail.el (rmail-summary-mode): Add functions for scrolling current message from summary. After rlk, only make them bullet proof. Add quit from rmail. * rmail.el (rmail-new-summary): Reuse old summary buffers when possible. After rlk, only his way of doing it was brain damaged. * rmail.el: rmail-last-message was off by 1. Fix it and put it on key `>'. (bug noted by rlk). Make rmail-edit run text-mode-hook. rlk also had it run `rmail-edit-mode-hook' but this is silly because function claims to be like text-mode except for two keys. * rmail.el (rmail-insert-inbox-text): Chomper wasn't deleting ~/.newmail after moving mail from /usr/spool/mail/. Make it do the right thing. Use new variable rmail-spool-directory (default "/usr/spool/mail/") to determine if movemail should be called (some people use "/spool/mail/"). Probably should move defvar to loaddefs when released. * simple.el: Flush `blink-matching-paren-ding' and code. * add-log.el: Flush `add-log-entry-to-log-in-buffer'. * loaddefs.el: Changes to reflect partitioning of command history stuff. Flush autoload of report-emacs-bug, leave the file emacsbug.el for arpanet sites to use if they want. * echistory.el: (require 'chistory) * chistory.el: Move list-command-history and command-history-mode here. Purpose of this file is just to look at the history. Also contains unrelated (to listing) but useful `repeat-matching-complex-command'. * simple.el (repeat-complex-command): Replaced its definition with `repeat-edit-nth-complex-command' from chistory.el, edit form in minibuffer instead of asking for confirmation. Add new function `edit-and-eval-command' which it uses. Thu Jun 13 01:30:08 1985 K. Shane Hartman (shane at mit-prep) * rmail.el (rmail-insert-inbox-text): Expand file name "movemail" in exec-directory for call-process. The only reason it worked here before is because exec-directory is in most people's shell paths. No, this directory is added automatically to the path used by call-process. It should have worked before. - RMS * loaddefs.el: C-z -> C-c in documentation for mail. autoload report-emacs-bug from emacsbug.el. * emacsbug.el: New file. Reports bugs with version info. * helper.el (Helper-describe-bindings): Make it describe local bindings faster by binding global map to nil so describe-bindings is faked out. * lisp-mode.el: First form of prog1 is distinguished. * loaddefs.el: autoload functions from chistory.el and echistory.el. * chistory.el: New file containing two alternatives to `repeat-complex-command' which put the form in the minibuffer instead of asking for confirmation. * echistory.el: Finished it. Split off two useful but unrelated commands into chistory.el. Made command-history-mode unable to redo expressions because there is no sensible way to pick buffer to do it in: now its just for looking at the history produced by list-command-history or after electric-command-history throws. * electric.el: Allow specification of prompt to Electric-command-loop. Interpret nil max-height argument to Electric-pop-up-window as license to grab as much of the screen as necessary if buffer wont fit; also fix fencepost neglect to account for modeline in height computations. Wed Jun 12 21:22:32 1985 Richard Mlynarik (mly at mit-prep) * rmail (rmail-insert-inbox-text) file-name-directory includes a trailing "/" Wed Jun 12 01:23:28 1985 K. Shane Hartman (shane at mit-prep) * shell.el (inferior-lisp-mode): Call lisp-mode-hook AFTER shell-mode-hook. * rmail.el (rmail-get-attribute-string): Did not account for empty attribute string. Neglected to include leading `,' for rmail-display-message-attributes. Unbound variable dot-max-save - I guessed that it was really supposed to be dot-min before the widen (the start of the user visible header) so I bound it and renamed it dot-min-save. * ebuff-menu.el: New variable after-electric-buffer-menu called after select if non-nil. Bind goal-column to nil while running. * add-log.el: New function add-log-entry-to-log-in-buffer. Use when adding multiple entries to the ChangeLog. Bound to ESC-*. Made it share code with add-change-log-entry (former calls latter). Wed Jun 12 00:24:07 1985 Richard M. Stallman (rms at mit-prep) * rmail.el (rmail-get-attribute-string): Rewritten by rlk to be smaller and more general. Tue Jun 11 18:29:07 1985 K. Shane Hartman (shane at mit-prep) * ebuff-menu.el: Make M-C-v scroll-other-window instead of scroll-down. Make M-v scroll-down. * ebuff-menu.el, echistory.el: Made them use electric. * electric.el: New module for packages that retain control until some event occurs. Command loop and window maker. Mon Jun 10 21:07:50 1985 K. Shane Hartman (shane at mit-prep) * echistory.el: Made it use helper.el. Remove kill-ring-save stuff pending use of new winning prin1-to-string for minibuffer hacking. * view.el: Made it use helper.el. * helper.el: New module for packages which want to do help without giving up control. Mon Jun 10 16:46:02 1985 Richard M. Stallman (rms at mit-prep) * sendmail.el: Switch to C-c as prefix instead of C-z. Sun Jun 9 20:20:30 1985 Richard M. Stallman (rms at mit-prep) * simple.el: Rename kill-ring-save to copy-region-as-kill. Old name still works. * tags.el (visit-tag-table-buffer): Give error unless tag table starts with a formfeed as it should. * sendmail.el: Install C-z w as mail-signature. Fix bug of reinserting --text...-- in wrong place when a null subject was deleted. * macros.el (kbd-macro-query): Don't ask for input when macro is being defined. When macro is executing, make prompt really appear. In loaddefs, put this on C-x q. Sun Jun 9 03:33:18 1985 K. Shane Hartman (shane at mit-prep) * dired.el: Fix bugs in dired introduced by use of auto-save-file-name-p. Dont call it if it isn't fbound (just look for `#'). Add second arg to dired-get-filename which says just return nil (no error) if there is no filename on line. Rename dired-mark-backup-and-temp-files to be dired-mark-backup-and-auto-save-files. Sat Jun 8 00:41:17 1985 K. Shane Hartman (shane at mit-prep) * ebuff-menu.el (electric-buffer-list): Lost if # lines < window-min-height and there was only one window. Make it win! * echistory.el: New file - implements command history interface (electric and plain jane listing). Waiting for opinions before I put it in loaddefs. * ebuff-menu.el (electric-buffer-list): Went to char select after Buffer-menu-execute, which can kill lines. So set mark at select before execute and go to mark before select. Winnage. * buff-menu.el: Stomp all kinds of roaches. Buffer-menu-do-kills was doing re-search when it wanted to do search (no harm, but faster). Fix fencepost error, when it killed a buffer line, it neglected to move back, thereby sitting on potential `K' which was missed. Wrap save-excursion around kill-buffer, it seems that kill-buffer changes something when it asks about mod file (dont ask me ...). Buffer-menu-do-saves was searching for "\n.S", it meant re-search. Teach Buffer-menu-unmark how to handle `%' and `*' at same time. * files.el (find-file-no-select): Don't run dired if value of new variable find-file-run-dired is nil. t by default. Fri Jun 7 05:21:08 1985 K. Shane Hartman (shane at mit-prep) * options.el (list-options): Use substitute-command-keys. * loaddefs.el (view-file, view-buffer, electric-buffer-list): Mention view-hook. Mention electric-buffer-menu-mode-hook. * ebuff-menu.el: Restrict dot to actual buffer description line. Document some functions. Make electric-buffer-menu-describe-mode interactive. Make C-g shutup when it exits, advertise it as exit char. Restrict help so that window configuration lossage is impossible (could lose if went into full blown help). Add function for describing help options. Add `v' command for viewing buffer and returning to the Electric Buffer List. * loaddefs.el: autoload edit-picture. * picture.el: New "Major" mode for editing pictures and tables. * view.el: Fix bug with non-file-buffer names. Use buffer name instead in these cases. New variable view-hook. Thu Jun 6 15:04:15 1985 Richard Mlynarik (mly at mit-prep) * view.el: (provide 'view) defined unadvertized c-m-a, c-m-e, c-m-b, c-m-f at end of buffer says how to exit. Thu Jun 6 07:39:17 1985 K. Shane Hartman (shane at mit-prep) * view.el: Restrict quit to q, C-c, C-z. Fill keymaps with new function view-undefined which dings and tells you how to quit or get help. Add eval-expression but don't advertise it. * indent.el (edit-tab-stops-note-changes): Make *Tab Stops* buffer go away when changes are installed by switching to edit-tab-stops-buffer and burying *Tab Stops*. Thu Jun 6 00:12:03 1985 Richard M. Stallman (rms at mit-prep) * fill.el: New function fill-individual-paragraphs. * dired.el: Rename dired-mark-temp-files to dired-mark-auto-save-files, and make it use auto-save-file-name-p. * bytecode.el (byte-recompile-directory): Use auto-save-file-name-p. Provide default definition of same. * files.el: Define auto-save-file-name-p. Tue Jun 4 16:59:03 1985 Richard Mlynarik (mly at mit-prep) * sendmail.el (sendmail-send-it): Somewhat gratuitously deleting empty subject lines. /usr/lib/sendmail seems smart enough (!) to hack this itself Tue Jun 4 00:42:12 1985 K. Shane Hartman (shane at mit-prep) * info.el (Info-find-node, Info-exit): Use expansion of filename in error message on file not found in Info-find-node. Bury the current buffer in Info-exit because you can say C-h i if you want to look at it again. * simple.el (goal-column): Use \\[...] to refer to set-goal-column in variable documentation. * simple.el (function-called-at-dot, variable-at-dot): Eliminate redundant testing of nil'ness of obj in and clauses. * simple.el (describe-variable): Bind enable-recursive-minibuffers so can use C-h v. It would be nice if instead could enable JUST C-h v (or C-h f for describe-function). * aton.el (occur-menu): Bogus message in minibuffer claimed C-z expanded menu entry. Use substitute-command-keys to get the right key. Move to the first line if rebuild-summary, else the next line. Make the occur menu buffer read-only. Mon Jun 3 22:12:27 1985 K. Shane Hartman (shane at mit-prep) * mim-mode.el: Fix bugs related to moving across atoms in other packages (i.e. with trailers). Mon Jun 3 18:01:33 1985 Richard M. Stallman (rms at mit-prep) * c-mode.el (indent-c-exp, calculate-c-indent): Fix indentation of line following a #-directive in C-M-Q, by doing essentially what calculate-c-indent does. New subroutine c-backward-to-start-of-if. * isearch.el: Don't allow reverse search to match a string straddling the initial value of dot. * simple.el (read-quoted-char): Handle quitting correctly (really quit unless first input char). Echo with spaces between chars and dash after even if have prompt string. Mon Jun 3 02:24:47 1985 K. Shane Hartman (shane at mit-prep) * mim-mode.el, medit.el: Clean up the documentation, use \\[...] where appropriate. Change a few names. Flush binding of uppercase letters in keymaps. * shell.el (run-lisp): Make it put the *lisp* buffer in inferior-lisp-mode as claimed in NEWS. Sun Jun 2 01:52:48 1985 Richard M. Stallman (rms at mit-prep) * rnews.el (news-get-pruned-list-of-files): Sort final list of files numerically. * simple.el, time.el, loadst.el (Info-directory): Process exec-directory using expand-file-name so as not to depend on whether it ends in /. * simple.el: define turn-on-auto-fill. Sat Jun 1 08:46:40 1985 K. Shane Hartman (shane at mit-prep) * loaddefs.el: Update documentation for rmail. * lisp-mode.el (calculate-lisp-indent): Asked (fboundp 'lisp-indent-hook). Right question is boundp. * scheme-mode.el (calculate-scheme-indent): Ditto. * compile.el (next-error): Missed a \\[...]. * buff-menu.el: Use \\[...]. Disambiguate documentation of q command (read as if you marked buffers with > instead of m, now mention mark `>' and what command you use to make one). * loaddefs.el: Put \ in front of \[ where needed. ' next-error in autoload definition. Fix typo in electric-buffer-list documentation (also fix in ebuff-menu). Sat Jun 1 04:51:31 1985 Richard M. Stallman (rms at mit-prep) * Many files: put in \\[...] where appropriate. Sat Jun 1 03:41:17 1985 K. Shane Hartman (shane at mit-prep) * shell.el (run-lisp): Make it interactive since loaddefs claims it is. Sat Jun 1 01:03:09 1985 Richard M. Stallman (rms at mit-prep) * isearch.el: Fix quit logic since condition signaled is `quit' now. Don't reprint echo area if have buffered ^G to handle. Fri May 31 21:40:16 1985 K. Shane Hartman (shane at mit-prep) * c-mode.el (c-backward-to-noncomment): Still failed to terminate in some cases (after many #include's and #defines, comments at beginning of file). Now stop if looking at # and dot <= lim. It guarantees termination but does it leave dot at right place for indenter? Fri May 31 20:01:18 1985 Richard M. Stallman (rms at mit-prep) * simple.el (help-for-help): Lookup in help-map explicitly; calling help-command no longer works. * mlconvert.el (fixup-mlisp-syntax): Skip strings and comments properly. Handle \ in char constants. * mlconvert.el (fixup-mlisp-symbols): Skip strings, comments, char constants. Find symbols even if they have no letters in them. * mlsupport.el: Insert symbol-value call in use-local-map. Handle key codes > 127 in local-bind-to-key. Write ml-modify-syntax-entry. Thu May 30 12:49:48 1985 Richard Mlynarik (mly at mit-prep) * sendmail.el Typo made sendmail-send-it lose when mail-interactive * simple.el Aborting out of octal read in read-quoted-char restarts "from the top." * startup.el Catch another place where \\[..] was needed Don't insert copyright info if noninteractive Thu May 30 06:04:56 1985 K. Shane Hartman (shane at mit-prep) * lisp-mode.el (lisp-send-defun): Make it interactive since it's on a key. Also, indent lambda like defun. * view.el: Improve documentation. Add isearch, previous and next line (useful in conjunction with recenter and argument). Flush repeat last command because it really does not repeat all commands. Make space quit in help scrolling if no more to scroll. Thu May 30 03:25:55 1985 Richard M. Stallman (rms at mit-prep) * simple.el: Use \\[...] in doc strings when appropriate. * simple.el (blink-matching-paren): Avoid error when (dot) - (dot-min) < 2. * simple.el (help-command): Function help-command flushed. C-h now defined as prefix character. * startup.el: Use substitute-command-keys in printing startup message. * simple.el: Define advertised-undo == undo, to force startup msg to say C-x u rather than C-_. Wed May 29 01:57:33 1985 Richard M. Stallman (rms at mit-prep) * rmail.el: Add C-r command (rmail-edit-current-message) and its commands. Separated out part of rmail-mode as rmail-mode-1. * Rename some files so all .el & .elc file names are <= 14 chars. syntax-check-mim.el => mim-syntax.el (change in mim-mode.el too). new-version-level.el => grow-vers.el. scheme-mode.el => scheme.el compare-windows.el => compare-w.el electric-buffer-list.el => ebuff-menu.el Tue May 28 10:55:20 1985 Richard Mlynarik (mly at mit-prep) * simple.el (describe-function) bind enable-recursive-minibuffers to read fn name (useful when typing c-h f after m-esc) * files.el made create-file-buffer a lisp function (was in src/buffer.c) * electric-buffer-menu-mode.el If the first character typed is a space then quit, ie return to previous window/buffer configuration Mon May 27 00:05:21 1985 Richard M. Stallman (rms at mit-prep) * fill.el (fill-region-as-paragraph): It was filling to width (1- fill-column) except on the last line of a paragraph. Also make it not delete excess spaces in paragraph indentation, delete fill prefixes before checking for excess spaces. Sat May 25 06:29:29 1985 K. Shane Hartman (shane at mit-prep) * c-mode.el: c-backward-to-noncomment failed to terminate on LF after #include at beginning of buffer. Make it stop if it sees bobp in such cases. * isearch.el: isearch was doing (push-mark odot) inside save-window-excursion, which loses. Move to outside of save-window-excursion. Fri May 24 05:15:54 1985 K. Shane Hartman (shane at mit-prep) * loaddefs.el: Update documentation strings for dired, byte-recompile-directory. Correct some typos and spelling errors. Fri May 24 00:42:59 1985 Richard M. Stallman (rms at mit-prep) * add-log.el: Don't make double blank line when adding to existing entry. Thu May 23 22:42:31 1985 Richard M. Stallman (rms at mit-prep) * sendmail.el (mail-yank-original): Arg other than C-u is # columns to indent. * lisp-mode.el: Provide default definition of lisp-send-defun, to just get an error. * shell.el: rename lisp to run-lisp. * loaddefs.el: make run-lisp autoloading. Thu May 23 14:59:54 1985 Richard Mlynarik (mly at mit-prep) * files.el FOO! Local-variables weren't working since hack-local-variables was searching for "\n^L" not "\n\^L" * lisp-mode.el, loadup.el, startup.el renamed lisp-interaction-mode to elisp-interaction-mode Made elisp-mode call elisp-mode-hook, elisp-interaction-mode call elisp-interaction-mode-hook. This will break people's init files! * loaddefs.el made ".lisp" suffixes get lisp mode. Toto, I don't think we're using fourteen-character filenames anymore. Autoload scheme-mode * scheme-mode.el installed scheme-mode, courtesy MIT scheme people. * lisp-mode.el made mode doc strings use \[...] substitute-command-keys technology Thu May 23 02:17:56 1985 Richard M. Stallman (rms at mit-prep) * lisp-mode.el: Renamed lisp-mode to elisp-mode and external-lisp-mode to lisp-mode. Renamed ...-map variables likewise. * loaddefs.el: Made ".el" files use elisp-mode; ".scm" files use scheme-mode. Wed May 22 22:21:59 1985 Richard M. Stallman (rms at mit-prep) * tags.el (visit-tag-table): If tags file has changed since last read in, offer to read it again. Wed May 22 05:56:46 1985 Richard Mlynarik (mly at mit-prep) * nrnews.el Foo. A distinct lack of communication here. Fairly radical surgery --- many bug fixes and clarifications, quite different from rnews.el Sigh Wed May 22 05:01:47 1985 K. Shane Hartman (shane at mit-prep) * view.el Add new flavor of help. ?, h still give list of commands. C-h understands m, c, k options. Make help commands use pop up window with scroll on space. * loaddefs.el Minor change for documentation of view-file and view-buffer because C-h does not describe mode now. Wed May 22 01:21:24 1985 Richard M. Stallman (rms at mit-prep) * rnews.el: news-go-to-news-group: don't get confusing error if arg is nil. Print messages describing change of groups here, not in callers. Accept interactive string arg. news-next-group: combine with news-move-to-group. Change so arg N means go forward N groups. Don't print any messages. news-previous-group: call news-next-group. Don't print any messages. news-move-to-message: simplify by using news-previous-group. Also, most messages were spurious. news-goto-news-group: it had duplicate definitions. Flushed both of them; use news-go-to-news-group instead. various: standardized elipses in messages. Use error rather than message where appropriate. Tue May 21 06:42:12 1985 Richard Mlynarik (mly at mit-prep) * mlsupport: Fixs assorted typos where variable "bufname" was changed to "name" * view.el Make M-<, M-> work. Fix documentation strings to work with the combination of lisp quoting and substitute-command-keys quoting. * electric-buffer-list.el Call Buffer-menu-execute before selecting. (Why doesn't standard buffer-menu-mode do this?) Flush "x", "1" and "2" commands * buff-menu.el: Call bury-buffer after selecting new buffer. Make things work when pop-up-windows is nil. Tue May 21 05:40:18 1985 K. Shane Hartman (shane at mit-prep) * view.el: Flush skip commands since they dont make much sense. Make searches, goto-line's center display at point found with dot at beginning of line. Use mark ring and provide mark manipulation commands. C-l is recenter. Improve documentation. Tue May 21 01:07:52 1985 Richard M. Stallman (rms at mit-prep) * loadup.el: Copy DOCSTR rather than renaming it. * sendmail.el (mail-yank-original): If have numeric arg, don't delete header fields and don't indent. Mon May 20 02:35:00 1985 Richard M. Stallman (rms at mit-prep) * rmail.el (rmail-get-new-mail): Pass the proper arg to delete-file. Don't always say "no new mail has arrived". * sendmail.el (mail-send-and-exit): Bury the *mail* buffer. Sun May 19 16:05:08 1985 Richard Mlynarik (mly at mit-prep) * view.el, dired.el typos in viewing stuff * simple.el, isearch.el Added prompt argument to read-quoted-char; improved isearch input echoing when reading quoted char. * sendmail.el, loaddefs.el added send-mail-function; initially sendmail-send-it (also, mail-yank-ignored-headers had a typo) * rmail.el (rmail-get-new-mail, convert-to-babyl-format, ...) loaddefs.el Remodularize inbox parsing. Add support(?) for mmdf inboxes. Note that I can't seem to define definitive documentation of what this format is; however the code installed seems to work for all cases encountered Sun May 19 15:36:12 1985 Richard M. Stallman (rms at mit-prep) * rmail.el (rmail-get-new-mail): Pass the proper arg to delete-file. * view.el: Change to use recursive-edit for its command loop. Define < and > commands. * files.el (backup-buffer): Get error if about to rename a directory. Sat May 18 11:30:36 1985 K. Shane Hartman (shane at mit-prep) * view.el, more-mode.el: Latter flushed in favor of former. view-mode preserves concept of more-mode but uses non-standard command loop so that viewed buffer is unchanged on exit from mode. * dired.el, loaddefs.el: Changed to use view.el. Change documentation of dired-listing-switches to note importance of excluding 'F' option. Fri May 17 01:25:31 1985 Richard M. Stallman (rms at mit-prep) * isearch.el: Preserve window-start on exit from save-window-excursion Thu May 16 18:34:37 1985 Richard M. Stallman (rms at mit-prep) * rmail.el: correct read-only suppression in rmail-new-summary. Thu May 16 15:38:32 1985 K. Shane Hartman (shane at mit-prep) * loaddefs.el: Autoload more-mode, more-file, more-buffer. * more-mode.el: New tourist mode for files. * dired.el: Put more-file on v-iew in dired. Returns to dired when user quits more. Thu May 16 12:23:29 1985 Richard Mlynarik (mly at mit-prep) * simple.el: make i run info * sundry changes to go with changes in src/fileio.c making copy-file, rename-file, add-name take an optional third argument. The only autoloaded system code this breaks is rmail --- a condition-case for wrong-number-of-arguments kludge was installed there in two places to make things work until everybody is running an emacs which takes the extra arg (marked "** KLUDGE **".) Remember to remove the kludge at that time! Mods to files.el, loadup.el, rmail.el * added autoloading function electic-buffer-list * buff-menu.el: make splitting screen between > 2 buffers work Thu May 16 03:23:38 1985 K. Shane Hartman (shane at mit-prep) * dired.el: Put dired-rename-file, dired-copy file-on keys. Make them change buffer if appropriate. Put dired-mark-backup-files, dired-mark-temp-files on keys. Eliminate possibility of looping at last line in dired-repeat-over-filenames. Wed May 15 00:47:03 1985 K. Shane Hartman (shane at mit-grape-nehi) * dired.el: Fix bug in dired-noselect which caused dired of / to get buffer name of /default/directory// with contents of /. Mon May 13 18:58:03 1985 Richard M. Stallman (rms at mit-prep) * isearch.el: Add crl's slow isearch code, plus changes: use variable isearch-slow-speed to control whether to use it. Also fix ^W inside reverse isearch with nonempty search string. * loadup.el: Flush the "inc" switch. * inc-version.el: Kill Emacs at the end. * simple.el: fixed overflow problem in what-cursor-position. * startup.el: Don't print a help message if noninteractive. Mon May 13 01:04:38 1985 K. Shane Hartman (shane at mit-ajax) * replace.el: Add ?^ to list of special characters in query replace loop so that replacing continues after moving back to previous. * add-log.el: add prefix arg to add-change-log-entry so will prompt for information if desired. If there is an entry for today, make sure login-name is same before using it, else make new entry. Use auto-fill-mode. Sun May 12 17:00:00 1985 Richard M. Stallman (rms at mit-prep) * lisp-mode.el: defined lisp-mode-commands, lisp-mode-variables. Added external-lisp-mode. Made doc strings mention mode hook variables. * shell.el: defined functions `lisp' and `inferior-lisp-mode'. Renamed shell-send-defun... to lisp-send-defun... and made them use process "lisp", buffer *lisp*. * text-mode.el: made indented-text-mode not call text-mode. Made doc strings mention mode hook variables. * c-mode.el: Made doc strings mention mode hook variables. * add-log.el Change format used for change log entries. Select indented-text-mode for the change log file. Sun May 12 04:01:21 1985 Shane (shane at mit-ajax) simple.el: suppress matching close paren if preceded by char syntax \. mim-mode.el: flush private paren blinker in favor of default. add-log.el: change mode-string to mode-name so reflected in mode-line. change \\W to \\sW when looking for place to add. Sun May 12 04:01:21 1985 Richard M. Stallman (rms at mit-prep) simple.el: modified open-line to insert newlines before an existing one before dot. This makes better redisplay. dired.el: Installed Shane's changes that allow user to choose switches to use. Sat May 11 16:23:19 1985 Richard M. Stallman (rms at mit-prep) rmail.el: if given file name as argument, correctly displays one message of that file but does not try to get new mail. simple.el: Fix what-line bug: line # too high by 1 if not at bol. Put in blink-matching-paren-distance, and check for wrong kinds of parens matching. time.el: Put in display-time-day-and-date flag, to display day and date in addition to the time. startup.el: Call lisp-interaction-mode-hook if defined. Set current buffer variables from defaults in case user's init file has changed them. emacs-19.30/lisp/ChangeLog.2100666 12241 1 400662 5523315235 14524 0ustar rolanddaemonThu Sep 1 14:22:30 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * Version 18.52 released. * fortran.el (fortran-split-line): Add space before continuation-char. Mon Aug 29 15:57:20 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * mh-e.el: New version from Larus. Sun Aug 21 21:05:08 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * view.el (view-mode): Initially view-scroll-size is nil. (view-scroll-size): If it's nil, return (view-window-size). Thu Aug 18 14:21:41 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fill.el (justify-current-line): Skip fill-prefix before whitespace. * spell.el (spell-region): Change minibuffer prompt. Mon Aug 15 19:37:27 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * add-log.el (add-change-log-entry): Log filename is now an arg; prompt for it with `interactive'. (add-change-log-entry-other-window): Always use default log filename and never prompt for anything. Sat Aug 13 14:59:02 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * simula.el: New version from obh. * add-log.el (add-change-log-entry): New arg OTHER-WINDOW. (add-change-log-entry-other-window): New fn. * loaddefs.el: Autoload that fn and put on C-x 4 a. Thu Aug 11 22:43:01 1988 Chris Hanson (cph at kleph) * xscheme.el (xscheme-cd): New function to guarantee that `cd' happens in Scheme process buffer. Mon Aug 8 08:09:17 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * life.el, saveconf.el, doctex.el: New files. * files.el (create-file-buffer): Avoid empty buffer name for root dir. * dired.el (dired-find-buffer): Let create-file-buffer do more work. (dired-noselect): Use directory-file-name, file-name-as-directory. Thu Aug 4 15:26:44 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * server.el (server-process-filter): Handle +NNN to specify linenum. (server-visit-files): Arg is now alist of (FILENAME . LINENUM). * server.el (server-visit-files): criterion for revert is if either buffer or file has changed. * abbrev.el: Doc fix. * files.el: Wed Aug 3 12:28:05 1988 Robert J. Chassell (bob at frosted-flakes.ai.mit.edu) * texinfo.el: Changed fill-colum from 75 to 72. The larger fill-column causes numerous overfull hboxes in TeX when you are writing Emacs Lisp code that will be formatted as a Texinfo example. Sun Jul 31 06:46:43 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * rmailsum.el (rmail-new-summary): Always go to line for current msg. (rmail-summary-exit): Delete just current window, and that only if Rmail was already in another window. Fri Jul 29 13:45:27 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * tags.el: provide 'tags. Tue Jul 26 16:30:30 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * info.el (Info-follow-reference): Handle extra newlines, tabs or spaces inside of cross-references. * outline.el: doc fix. Sat Jul 23 17:05:13 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * loaddefs.el: autoload texinfo-format-region. Fri Jul 22 05:11:50 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * simple.el (transpose-subr-1): Error if regions overlap. * dired.el (dired-flag-file-deleted): Directories no longer special. * dired.el (dired-do-deletions): If deleting a dir, run `rmdir'. Tue Jul 19 00:43:31 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * ftp.el (ftp-find-file-or-directory): Typo in arg name. Mon Jul 18 00:24:40 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * c-fill.el: New file. * compile.el (compilation-error-regexp): Exclude colon from filename. Sun Jul 17 13:43:49 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * view.el: `h' ran undefined command; make it like `?'. Sat Jul 16 22:25:36 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * spell.el (spell-region): Run spell-filter to alter the text before actual checking. Fri Jul 15 04:10:30 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * rmailsum.el (rmail-make-basic-summary-line): If sender is self, show recipient instead, with `to:'. Wed Jul 13 13:36:36 1988 Richard Stallman (rms at wheat-chex.ai.mit.edu) * files.el (auto-save-file-name-p): doc fix. Tue Jul 12 21:58:17 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * paths.el (rmail-spool-directory): Handle RTU like sysV. Sun Jul 10 14:43:44 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * compile.el (compile1): use set-buffer, not switch-to-buffer. * startup.el (command-line): strip hyphens one by one from TERM type. Tue Jul 5 15:11:42 1988 Chris Hanson (cph at kleph) * texinfmt.el: Add support for @defun and related commands. Tue Jul 5 14:00:46 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * loadup.el: Avoid setting the global variable `name'. Mon Jul 4 12:21:03 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * rmail.el (rmail-make-in-reply-to-field): Use doublequotes, not parens, around sender name in rfc822 mode. * info.el (Info-read-subfile): Don't lose if subfile header isn't same length as main file header. Sun Jul 3 10:37:05 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * shell.el (shell-send-input): Put bound on search for prompt. Fri Jul 1 10:07:14 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * autoinsert.el: New file. * text-mode.el (center-region): Don't let end-of-region become wrong when insertion/deletion is done. * info.el (Info-find-node): Typo in regexp. (Info-following-node-name): At open paren, continue to close. * tags.el (list-tags): Terminate scan on end-of-buffer. Thu Jun 30 10:09:19 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * loaddefs.el (auto-mode-alist): C mode for `.cc'. Mon Jun 27 12:22:11 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * paths.el (rmail-spool-directory): Treat unisoft like usg. * texinfo.el (texinfo-show-structure): New function. (texinfo-insert-*): Several new functions. (texinfo-mode-map): New keymap. * dired.el: provide 'dired. Thu Jun 23 11:02:37 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * files.el (hack-local-variables): Ignore `eval' if running as root. Wed Jun 22 10:33:39 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * nroff-mode.el (nroff-brace-table): Add G1 vs G2. Tue Jun 21 04:43:41 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * spell.el (spell-region, spell-string): Fix typo `spell-cmd'. Sun Jun 19 15:35:21 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * lpr.el (lpr-command): New variable holds the shell command to print a file (normally "lpr"). Wed Jun 15 06:13:32 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * rnewspost.el (news-inews): run news-inews-hook. * rmail.el (rmail-show-message): run rmail-show-message-hook. Sun Jun 12 10:55:47 1988 Richard Stallman (rms at gluteus.ai.mit.edu) * keypad.el: Additional conventional chars added in the comments. * text-mode.el: erroneously installed text-mode-syntax-table in current buffer. Thu Jun 9 05:28:48 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fill.el (fill-region-as-paragraph): Err if fill-prefix is too long for the fill-column. * texinfmt.el (texinfo-format-{region,buffer-1}): Make sure buffer ends in a newline. Tue Jun 7 12:47:31 1988 Chris Hanson (cph at kleph) * xscheme.el (xscheme-process-filter-alist): add escape sequence which instructs Emacs to change the working directory of the Scheme process buffer. This change is required for Scheme runtime library version 14. Thu Jun 2 06:36:43 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * sendmail.el (mail-do-fcc): avoid insert-buffer (too high level). Tue May 31 18:12:10 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * outline.el: Must put `\(...\)' around outline-regexp when prepending `^'. Mon May 30 17:30:18 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fortran.el, hanoi.el, helper.el, info.el, mlconvert.el, modula2.el, rmail.el, sendmail.el, sort.el, underline.el: doc fixes. * loaddefs.el: autoload doc fixes. Sat May 28 05:19:41 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * help.el (print-help-return-message): Handle pop-up-windows = nil. * nroff-mode.el (nroff-brace-table): Add more pairs, for some mm macros (nroff-comment-indent): Recognize ' like period. (nroff-mode): .SK and .OP separate pages. * shell.el (lisp-send-defun): Install new, corrected no-process check. Fri May 27 21:28:20 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * c-mode.el (electric-c-terminator): Tests to distinguish labels from other uses of colon failed if inserting at end of buffer. Tue May 24 15:09:32 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * texinfmt.el (texinfo-parse-expanded-arg): like texinfo-parse-line-arg but expand commands inside the arg. (texinfo-index): Use that. (@end ifinfo): Discard terminating newline. Mon May 23 12:45:52 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * files.el (file-name-sans-versions): VMS version can be sep. by `.'. Also delete mysterious line that removes `$__$'. Sun May 22 14:28:56 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * gdb.el (gdb-filter-accumulate-marker): Empty gdb-filter-accumulate since its contents are now in STRING. * rnews.el (news-get-pruned-list-of-files): catch errors for read-protected directories. Fri May 20 00:54:22 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * meese.el: Bind off buffer-read-only while changing buffer. Don't add protect-innocence-hook twice. * sendmail.el (mail-do-fcc): If fcc file is in a buffer, append there. Mon May 16 21:17:39 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * bibtex.el (bibtex-mode): Delete some keys that were vt100 keypad. (bibtex-DEAthesis): Delete this and its key definition. (bibtex-sun-*): Insert functions. Sun May 15 19:35:59 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * loaddefs.el: Doc fix. Thu May 12 17:47:35 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * tex-mode.el (TeX-region): Pass nil to make-shell as startfile arg. Wed May 11 14:20:41 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * shell.el (make-shell): If PROGRAM is nil, default like M-x shell. * tex-mode.el (TeX-region): Used eliminated fn. expand-directory-name. Tue May 10 21:45:09 1988 Richard Stallman (rms at corn-chex.ai.mit.edu) * shell.el (lisp-send-defun): Undo last change. * loaddefs.el (rmail-primary-inbox-list): Doc fix. Sun May 8 15:15:45 1988 Richard Stallman (rms at lucky-charms.ai.mit.edu) * man.el (manual-entry): Handle section names > 1 letter. * paths.el (manual-formatted-*): Add alternative for Xenix. Fri May 6 10:49:12 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * Version 18.51 released. * vms-patch.el (vms-suspend-resume-hook): New fn to find a file after Emacs is resumed on VMS. (vms-suspend-hook): Don't suspend if logical name DONT_SUSPEND_EMACS * server.el (server-start): Don't say "restarting" the first time. * files.el (revert-buffer): Avoid wta error if autosave turned off. Tue May 3 08:30:12 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * icon.el: New file. Mon May 2 17:44:49 1988 Brian Fox (bfox at rice-krispies.ai.mit.edu) * replace.el (perform-replace): Make `y' do what SPC does, `n' do what DEL does, and `q' do what ESC does. The original set of keys still work. Sun May 1 17:09:04 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * gdb.el (gdb-filter-insert): Save and restore prev. current buffer. (gdb-filter-accumulate-marker): set-buffer should not be done here. Thu Apr 28 17:46:02 1988 Chris Hanson (cph at kleph) * xscheme.el: Force use of pipes for communication with inferior Scheme. This avoids bugs in PTY implementations on various systems. Mon Apr 25 08:56:41 1988 Chris Hanson (cph at kleph) * scheme.el: Add indentation for `with-values'. Fri Apr 22 07:12:46 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * shell.el (shell-send-input, lisp-send-defun): Err right away if shell no process. * text-mode.el (center-line): doc fix. Thu Apr 21 01:00:45 1988 Richard Stallman (rms at corn-chex.ai.mit.edu) * texinfmt.el (texinfo-format-region): Select the output buffer at the beginning. Copy the @setfilename command as well as the specified region. At end, put point at top. Accept @bye only at beg of line. Wed Apr 20 19:20:33 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * informat.el (Info-validate): Change message for Next's Previous. Now the word "invalid" must be included in the message string if it is wanted. Tue Apr 19 00:01:22 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * cl-indent.el (common-lisp-indent-hook): Handle ` like '. * gdb.el: Completely rewritten filtering mechanism (by cph). Should look the same to the user. Mon Apr 18 16:17:42 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * startup.el (command-line): Treat `_' in term-type name like `-'. * term/apollo.el: New file, loads vt100.el. * dired.el (dired-mode): Allow no arg--to put any old dir into dired mode. Make it interactive. * simple.el (indent-for-comment): If comment-start-skip has \(...\), the delimiter starts where the end of the first pair matches. * tex-mode.el (TeX-common-initialization): Add a \(...\) to comment-start-skip so its end is always at start of delimiter. Thu Apr 14 05:54:37 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * paragraph.el (forward-paragraph): Bug in pragraph-ignore-fill-prefix. * terminal.el (te-sentinel): Delete whitespace at end of buffer before inserting the message. * debug.el (debug): Bind executing-macro to nil; avoid lossage if enter debugger while kbd macro is running. * rmailout.el (rmail-output-to-rmail-file): Error if output file is same as current file. * rmailout.el (rmail-output): Don't die if rmail-last-file is nil. Wed Apr 13 10:48:13 1988 Leonard H. Tower Jr. (tower at rice-krispies.ai.mit.edu) * rnews.el: fixed mis-documentation. Wed Apr 13 00:55:00 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * dired.el (dired-readin): Print msg on startup and when done. * spell.el (spell-command): New var; command to use to invoke the spell program. * terminal.el (terminal-emulator): Choose default shell like shell.el. Use /bin/sh for changing env. (te-parse-program-and-args): Use shell-file-name for globbing. * dired.el (dired-rename-file): Include old file name in prompt. * cal.el (calendar): Convert any nonnull arg to a number. Tue Apr 12 13:05:18 1988 Chris Hanson (cph at kleph) * xscheme.el: Change to print ";No value" when the value of an expression is undefined. Sun Apr 10 02:33:43 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * kermit.el: New file. * tex-mode.el (TeX-common-initialization): Make TeX-command, etc., local here rather than in both callers. Provide 'tex-mode. (TeX-start-shell): Make keymap only once, and reuse it. Pass 'nostartfile, not "/dev/null", to `make-shell'. (set-buffer-directory): Use file-name-as-directory. Don't use... (expand-directory-name): function deleted. * simple.el (indent-for-comment): If comment-start-skip matches a string with nonfinal whitespace, the comment delimiter starts after that whitespace (for indentation purposes). Don't modify the buffer if existing indent is correct. * cmacexp.el (c-macro-expand): Use cpp to expand macros in the region. * c-mode.el: Autoload that. * texinfmt.el (texinfo-format-scan): Guts of texinfo-format-buffer-1 split into a new function. Delete handling of C-q, which is not used in Texinfo nowadays. (texinfo-format-region): New function to format a region. Sat Apr 9 11:48:24 1988 Leonard H. Tower Jr. (tower at frosted-flakes.ai.mit.edu) * rnewspost.el (news-post-news, news-reply) No longer re-inits *post-news* buffer, if buffer-modified-p. Sat Apr 9 03:09:36 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * spook.el (shuffle-vector): Rewrite by phr. * undigest.el (undigestify-rmail-message): Put space before `unseen'. * ada.el, c-mode.el, lisp-mode.el, mim-mode.el, modula2.el, prolog.el, scheme.el: Make paragraph-ignore-fill-prefix locally t in these modes. * paragraph.el (forward-paragraph): Ignore fill-prefix if Make paragraph-ignore-fill-prefix is non-nil. Fri Apr 8 05:39:13 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * man.el, loaddefs.el: Doc fix. Wed Apr 6 21:06:52 1988 Robert J. Chassell (bob at frosted-flakes.ai.mit.edu) * loaddefs.el: added `.texinfo' to the less common extensions section of the auto-mode-alist so that emacs chooses the correct mode for files with this extension. Fri Apr 1 17:53:57 1988 Richard M. Stallman (rms at wilson) * gdb.el (gdb): Specify -cd option to GDB so GDB will use the same path for the dir as the user is using in Emacs. Thu Mar 24 01:15:15 1988 Richard M. Stallman (rms at wilson) * spook.el: New file. * nroff-mode.el (forward-text-line): either . or ' starts a request. (nroff-mode): In paragraph-{start,separate}, ditto. (electric-nroff-newline): Don't insert extra newlines. Wed Mar 23 16:21:02 1988 Richard M. Stallman (rms at wilson) * x-mouse.el: Change unshifted clicks for x11. Bind all up-clicks to no-op. * term/x-win.el (command-switch-alist): Ignore all X's switches in x11. Don't test fboundness of `x-change-display'. On x11, don't set-input-mode or set term-setup-hook. x-switches feature now broken. * term/x11-win.el: Delete this file since X11 is now a subcase of X. Sun Mar 20 14:23:07 1988 Richard M. Stallman (rms at wilson) * rmailkwd.el (rmail-next-labeled-message): Allow space before the label name (since now they are supposed to be there). * paths.el (rmail-primary-inbox-list): Don't define it here. * loaddefs.el: Define it here but set it to nil. * rmail.el (rmail): If it's nil, compute the default here. Now we decide $LOGNAME vs $USER at run time, not build time. * lisp-mode.el (lisp-indent-line): Single-semicolon comment lines should be indented at comment col. * cl-indent.el (lisp-indent-do): Smarter version from Kevin Layer. * cl.el (setf): Simplify code produced; don't use `apply' and, if handler isn't a macro, don't bind any temp vars. * cl.el: Make and doc strings and error messages use GNU style. Sat Mar 19 17:18:01 1988 Richard M. Stallman (rms at wilson) * hideif.el: New version from liberte@b.cs.uiuc.edu. * VMS-oriented bug fixes from David Gentzel. * texinfmt.el (texinfo-format-setfilename): expand the filename. (texinfo-do-itemize): Don't indent an empty line. (texinfo-format-printindex): On VMS, use texinfo-sort-region to sort. (texinfo-sort-{region,startkeyfun}): New functions. * sort.el: provide 'sort. * sendmail.el (mail): Doc fix. * help.el (help-with-tutorial): Use expanded file name for making bfr. * info.el (Info-find-node): Remove versions from file name. * informat.el (Info-split): Remove versions from file name. * bytecomp.el (byte-compile-file, byte-recompile-directory): Remove versions from name of file to write. Good on VMS. (batch-byte-compile): Likewise. Fri Mar 18 13:11:35 1988 Chris Hanson (cph at kleph) * term/x11-win.el (command-switch-alist): Option "-rn" mistakenly omitted from this list. Fri Mar 18 15:42:19 1988 Richard M. Stallman (rms at wilson) * modula2.el: Changes from Michael Schmidt: Better prompting in m2-for. Variables for program name for compilation and for linking. Don't assume executable name comes from module name. m2-toggle knows about .md and .mi files. * rmail.el (rmail): Default for C-o is now `xmail'; rmail-last-rmail-file now defaults independently to `XMAIL'. * lisp-mode.el (lisp-mode): Define C-c C-l as M-x run-lisp. * paths.el (rmail-primary-inbox-list): Use rmail-spool-directory as a basis for value of this; avoid redundant decisions. * rnews.el (news-update-message-read): typo, cdadr => news-cdadr. * gdb.el (gdb): expand `path'; start-process loses if default-directory is not absolute. * tags.el (find-tag-tag): Create this function again to hold shared arg-reading code for find-tag and find-tag-other-window. (find-tag, find-tag-other-window): Use find-tag-tag. * shell.el (inferior-lisp-mode): lisp-mode-variables needs an arg. Also improve the doc string. * chistory.el (Command-history-setup): Likewise. Thu Feb 11 01:37:48 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * Version 18.50 released. * tex-mode.el (tex-mode): Use the default if file has no tex commands. * term/vt200.el: Delete vt200-enable-arrows; leave the standard name enable-arrow-keys. * version.el (emacs-build-system): Store system name on which Emacs was built. * version.el (emacs-version): Print that system name. * vip.el: Install version 3.5 sent by author. * man.el (nuke-nroff-bs): New regexp for footers on hpux. Wed Feb 10 12:34:14 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * simple.el (fundamental-mode): Delete fundamental-mode-map. Mon Feb 8 22:50:08 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * paths.el (rmail-primary-inbox-list): Check separately for which directory and which envvar. Sat Feb 6 18:31:55 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * loaddefs.el: Autoload `gdb'. * gdb.el: New file, interface to GDB. From Schelter, but rewritten to use the new GDB -fullname feature and the new Emacs overlay-arrow-position feature. * dbx.el: New file (Masanobu's version, changed to use overlay-arrow-string). Thu Feb 4 21:00:23 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * mh-e.el: Version 3.4o from Larus. Sun Jan 31 18:16:14 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * term/vt125.el, term/vt240.el: New files: Just load vt100.el or vt200.el. Thu Jan 28 07:21:54 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * tags.el (find-tag-tag): Deleted. * tags.el (find-tag-default): New function returns default tag based on buffer text, or nil. Fix several bugs such as handling of quote-characters, and case of before or after a list or near unbalanced paren. * tags.el (find-tag): Use find-tag-default and show default in the prompt while reading the tag. Sun Jan 24 02:38:17 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * undigest.el (undigestify-rmail-message): Accept "Apparently-To". Fri Jan 22 22:46:19 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * edt.el (edt-bind-gold-keypad): New fn so that calls to define-keypad-key are deferred till edt-mode is turned on. Thu Jan 21 23:11:14 1988 Richard Stallman (rms at frosted-flakes) * simple.el (kill-line): doc fix. Wed Jan 20 03:22:12 1988 Richard Stallman (rms at frosted-flakes) * rmail.el (rmail-get-new-mail): If save fails, recount messages. * rmail.el (rmail-revert): Handle revert-buffer; recount messages. * rmail.el (rmail-variables): Set up to use this. * rmail.el (rmail-convert-file): Babyl-mode conversion code moved here from `rmail'. * files.el (revert-buffer): Return t if did revert. Tue Jan 19 21:54:04 1988 Richard Stallman (rms at frosted-flakes) * sendmail.el (mail-send-and-exit): Don't delete the window unless an rmail-mode buffer is in the next window. Tue Jan 19 14:03:23 1988 Chris Hanson (cph at sugar-smacks) * xscheme.el: Extensive changes including better documentation, a new major mode `scheme-debugger-mode', and a new format for the modeline when using the Scheme interface. The major mode `scheme-debugger-mode' is used when Scheme is running one of the character-driven debugger interfaces. It is like Scheme mode except that evaluation is disabled, and characters that are normally self-inserting instead are transmitted to the Scheme process. The modeline is changed so that information about the state of the Scheme process is shown only in buffers whose major mode is `scheme-mode' or one of the related Scheme major modes. Information about the state of the read-eval-print loop is shown only in the Scheme process buffer. All of these changes are upwards compatible with versions of Scheme which ran using the previous interface. However, some of the features will not be enabled in older Scheme systems. Newer versions of Scheme (specifically, those newer than release 6.1.1) require the new interface for correct operation. They will not work correctly with older version of this interface. * scheme.el: Minor changes to support "xscheme.el" changes. Mostly this involved adding hooks to existing facilities. Tue Jan 19 05:07:25 1988 Richard Stallman (rms at frosted-flakes) * c-mode.el (indent-c-exp): Use new state-element from parse-partial-sexp to handle case of (...newline...) {... Sun Jan 17 21:53:57 1988 Richard Stallman (rms at frosted-flakes) * rmail.el (rmail-display-labels): Preserve buffer bounds correctly. Remove extra spaces from the string before displaying it. * rmail.el (rmail-insert-inbox-text): message only if file exists. * rmail.el (rmail-get-new-mail): Don't save if was no new mail. Fri Jan 15 16:46:17 1988 Richard Stallman (rms at frosted-flakes) * info.el (Info-search): Two bugs in indirect files: Failed to search the indirect table right, and failed to recover if nothing found. Thu Jan 14 00:23:29 1988 Richard Stallman (rms at frosted-flakes) * loaddefs.el: Make search-... into user variables. Mon Jan 11 20:46:54 1988 Richard Stallman (rms at frosted-flakes) * rmail.el (rmail-display-label): Put a space before each label name if there wasn't one already. Turns out valid BABYL format requires a space there. * rmailkwd.el (rmail-set-label): Expect and write spaces before labels. Eliminate the loop to delete such spaces. * rmail.el (rmail-set-attribute): Expect and write spaces before labels. * rmailsum.el (rmail-summary-by-labels): Expect spaces. * info.el (Info-find-node): If filename starts with ./, interpret relative to current directory. Sun Jan 10 15:51:08 1988 Richard Stallman (rms at frosted-flakes) * undigest.el: If it fails, delete ALL of the temporary copy. Wed Jan 6 17:20:59 1988 Richard Stallman (rms at frosted-flakes) * paths.el (mh-dir, mh-lib): Add two new alternatives to test for. (For HPUX). * paths.el (manual-formatted-dirlist) [HPUX]: Add a completely new alternative value. Tue Jan 5 16:56:12 1988 Richard Stallman (rms at frosted-flakes) * simple.el (indent-new-comment-line): In a comment, look back for a line with a nonempty comment and indent the comment text like it. * lpr.el (print-buffer-1): Use `untabify' to expand tabs, not the `expand' program. Fix other bugs with tab-width != 8. Sat Dec 26 13:27:00 1987 Richard Stallman (rms at frosted-flakes) * c-mode.el (electric-c-terminator, c-indent-line): Don't recognize `case' unless space or tab follows. Wed Dec 23 17:24:16 1987 Richard Mlynarik (mly at peduncle) * loaddefs.el: Update terminal-emualator documentation. (This wasn't done after the last edit.) * terminal.el: Split out te-stty-string from function terminal-emulator. Run "sh" if no env var SHELL. Add nonstandard (though useful) NF and LP termcap flags. Fix terminal-emulator documentation. Some comments. Tue Dec 22 19:34:37 1987 Richard Stallman (rms at frosted-flakes) * rnews.el (news-get-pruned-list-of-files): Don't die on unreadable directory. Mon Dec 21 19:52:15 1987 Richard Stallman (rms at frosted-flakes) * window.el (split-widow-{vertically,horizontally}): Make the arg optional. Wed Dec 9 18:32:21 1987 Richard Stallman (rms at frosted-flakes) * picture.el (picture-clear-rectangle): Delete spurious arg. Tue Dec 8 16:09:28 1987 Richard Stallman (rms at frosted-flakes) * rmailout.el (rmail-output): Don't crash if msg has no From. * dabbrev.el (dabbrev-expand): Don't print messages. * isearch.el (nonincremental-search): Put onto command-history. * simple.el (kill-region): Doc fix. Sun Dec 6 01:22:27 1987 Richard Stallman (rms at frosted-flakes) * compile.el (compilation-error-regexp): Last alternative could match spuriously; change `.*' to ` *'. Change may be wrong; nobody knows which program makes error messages this should match. * terminal.el: Many fixes: some new termcap entries and fix bugs in others. Terminal width and height may be specified. Scrolling is now the default. Enabling or disabling scrolling during use does not really work because it is necessary to change the termcap entry. Do `stty new dec' at startup. Without this, you get printing terminal echoing which looks very strange with DEL as the erase char. This may lose on sysV, but the need can't be ignored. One known bug remains a mystery: when running `ex', the empty-line command fails to overprint the colon with the text that is printed. The output Emacs receives contains a crlf in place of a cr. * startup.el (command-line-1): Don't insert the startup-message in a buffer other than *scratch*. Fixes bug with (rmail) in .emacs. * files.el (save-buffer): Don't make a backup if arg is 0. Clean up documentation. * tags.el (tags-query-replace): Handle prefix arg like query-replace. * replace.el ({keep,flush}-lines): Handle matches split across lines. Sat Dec 5 03:46:16 1987 Richard Stallman (rms at frosted-flakes) * xscheme.el (xscheme-start-process): Put xscheme-mode-string into mode-line-process. * xscheme.el (add-to-global-mode-string): Function eliminated. * startup.el: New var window-setup-hook; works like term-setup-hook. * term/x-win.el: Set window-setup-hook instead of term-setup-hook. term-setup-hook now for users only. Fri Dec 4 19:34:36 1987 Richard Stallman (rms at frosted-flakes) * tags.el (find-tag): Better error message when no tag found for substring. * lisp-mode.el (emacs-lisp-mode-syntax-table): New variable. Initialize this instead of lisp-mode-syntax-table. * lisp-mode.el (lisp-mode-variables): New arg; if non-nil, initialize lisp-mode-syntax-table unless already done, and install it. * lisp-mode.el (*-mode): Pass an arg to lisp-mode-variables. * lisp-mode.el (eval-last-sexp): Use emacs-lisp-mode-syntax-table. * lisp-mode.el (eval-print-last-sexp): * debug.el (debugger-mode): * chistory.el (Command-history-setup): * options.el (Edit-options-mode): Tue Dec 1 00:48:06 1987 Richard Stallman (rms at frosted-flakes) * lisp-mode.el (calculate-lisp-indent): Typo for case within a string. Indent first arg of ordinary function directly under the function name. Remove a call to parse-partial-sexp that always did nothing. Wed Nov 25 19:14:29 1987 Richard Stallman (rms at frosted-flakes) * rmail.el (rmail): Widen and goto beginning before checking format. Sun Nov 22 00:59:46 1987 Richard Stallman (rms at frosted-flakes) * page.el (mark-page): Be more careful about where exactly to put the buffer boundaries. Widen before searching for a page. Thu Nov 19 18:31:11 1987 Richard Stallman (rms at frosted-flakes) * startup.el (command-line-1): Don't (goto-line 0). * replace.el (occur-mode): Doc fix. Wed Nov 11 11:22:13 1987 Richard Stallman (rms at frosted-flakes) * dired.el (dired-find-file{,-other-window}): No need to check for a line saying it is a directory, because find-file does that in a better way. * dired.el (dired-view-file): Use file-directory-p to decide whether to call dired. * rmail.el (rmail): If buffer already existed and find-file reverts it, recompute the message tables. Tue Nov 3 07:22:29 1987 Richard Stallman (rms at frosted-flakes) * files.el (hack-local-variables): If selective-display is set, next local-variables line starts with either \n or ^M. Sat Oct 31 22:09:52 1987 Richard Stallman (rms at sugar-smacks) * mh-e.el (push): Renamed to mh-push. * mailalias.el (define-mail-alias): Fix bug when there was multiple whitespace. Thu Oct 29 20:39:55 1987 Richard Stallman (rms at frosted-flakes) * simple.el (repeat-complex-command, next-complex-command): Rename `arg' to `repeat-complex-command-arg'. Thu Oct 15 12:46:36 1987 Leonard H. Tower Jr. (tower at frosted-flakes) * rnewspost.el (news-inews): commented out -n and -t args in news-inews. Wed Oct 7 10:54:14 1987 Richard Stallman (rms at frosted-flakes) * tex-mode.el (TeX-start-shell): Copy the local map before changing it: don't clobber shell-mode's map. * rmail.el (rmail-insert-inbox-text): Print the "getting..." message for all files. Fri Oct 2 00:30:30 1987 Richard Stallman (rms at frosted-flakes) * rnews.el: Rename // to news-/. Rename cadr, etc. to news-cadr, etc. Rename push to news-push and supply a definition for it. Wed Sep 30 11:50:10 1987 Richard Stallman (rms at frosted-flakes) * compile.el (compile1): Save the compilation process across the sit-for. Wed Sep 16 17:19:40 1987 Richard M. Stallman (rms at prep) * Version 18.49 released. * debug.el (debugger-mode): mode-class special. * buff-menu.el: Typo putting mode-class on `Buffer-menu-mode'. * c-mode.el (electric-c-brace): set insertpos after calling newline, since newline might do an auto-fill. Sat Sep 12 22:47:11 1987 Richard Mlynarik (mly at prep) * loaddefs.el, mail-utils.el (rmail-dont-reply-to): Add new variable `rmail-default-dont-reply-to-names' which is used (together with the user's name) as the default value of rmail-dont-reply-to-names. This variable replaces the wired-in constant "info-" in `rmail-dont-reply-to' and is intended to be used in the site-init.el file -- eg "all-ai\\>\\|[0-9]ai\\>\\|info-" Thu Sep 10 18:46:16 1987 Richard M. Stallman (rms at prep) * debug.el (debug): bind default-major-mode normally when creating the backtrace buffer. * rmailsum.el (rmail-summary-goto-msg): Avoid error on empty buf. Mon Sep 7 19:49:56 1987 Richard Mlynarik (mly at prep) * rmailsum (rmail-new-summary): Fix scope of `new-summary-line-count' * lisp-mode.el (calculate-lisp-indent): Don't fail on first line of defun. Sun Aug 30 02:20:48 1987 Richard M. Stallman (rms at prep) * Version 18.48 released. * backquote.el: Rename push to bq-push, and likewise for caar, cadr and cdar. Delete cddr. Definitions for the common-lisp functions were different from those in cl.el and could interfere. Wed Aug 19 18:07:39 1987 Richard Mlynarik (mly at prep) * lisp-mode.el (lisp-indent-hook): Fix braino. Fri Aug 14 17:55:42 1987 Richard M. Stallman (rms at prep) * loaddefs.el (auto-mode-alist): Recognize .emacs file with either Unix or VMS syntax. * sun-mouse-fns.el: Renamed to sun-fns.el. * sun-mouse.el, term/sun.el: Rename references too. * shell.el (lisp-send-defun-and-go): Call to lisp-send-defun requires an arg. Fri Jul 31 11:15:46 1987 Leonard H. Tower Jr. (tower at prep) * rnewspost.el (news-setup) commented out Posting-Front-End to save USENET bytes Wed Jul 29 22:12:12 1987 Richard Mlynarik (mly at prep) * simple.el (negative-argument): Pass explicit ?- to prefix-arg-internal rather than relying on value of last-command-char (broke when this command wasn't assigned to the "-" key) * loaddefs.el: Autoload common-lisp-indent-hook. * cl-indent.el: New file which understands common lisp special forms and has hairy indentation-specification templates. (setq lisp-indent-hook 'common-lisp-indent-hook) to enable it. * lisp-mode.el (lisp-indent-hook): No need to do save-excursion. Deal with case of car of form being a list (which used to be handled by calculate-lisp-indent) * lisp-mode.el (calculate-lisp-indent): Call indent-hook even if looking-at a list. Needed for correct indentation of pleblisp FLET, etc. Sun Jul 26 20:07:49 1987 Richard M. Stallman (rms at prep) * rmailsum.el (rmail-new-summary): Avoid error on empty summary. * sendmail.el (mail): Doc fix. * c-mode.el (c-backward-to-noncomment): Last change broke it totally. Sat Jul 25 15:33:26 1987 Richard M. Stallman (rms at prep) * paths.el (term-file-prefix): Make it "[.term]" on VMS * mlconvert.el: Add a few simple translations. * tags.el (visit-tags-table): Reset tag-table-files. Sat Jul 18 19:37:10 1987 Richard M. Stallman (rms at prep) * lpr.el (print-region-1): Make program name conditional on system-type; use "lp" on sysV. * keypad.el: Use help-for-help on the `?' key. Provide a default for the `D' key. Change syntax for the control-letters from ^ to `C-'. * simple.el (delete-indentation): Do nothing if have arg and on last line of buffer. * mailalias.el (define-mail-alias): Call build-mail-aliases if that has not yet been done. * mailalias.el (build-mail-aliases): If no newline at eof, invent one. * helper.el (Helper-help): Downcase the char before looking in map. * informat.el (Info-tagify): The check for a split file searched for the wrong string. Tue Jun 30 12:37:39 1987 Richard Mlynarik (mly at prep) * info.el (Info-menu): If interactive and point is within a menu item, make that item the default for completing-read. * man.el (nuke-nroff-bs): Split this function out from manual-entry for users who need to remove stupid control-h characters from text. * mh-e.el: Version 3.4m from Larus. Bug fixes plus draft folders. Mon Jun 29 01:04:03 1987 Richard M. Stallman (rms at prep) * vms-patch.el (make-legal-file-name): New function converts any string to a similar string that's a legal VMS filename. * picture.el: provide 'picture. * blackbox.el (bb-init-board): Use (logand (random) 7) instead of remainder by 8. Thu Jun 25 21:38:21 1987 Richard M. Stallman (rms at prep) * replace.el (perform-replace): Don't exit on no-op comma. Tue Jun 23 02:09:31 1987 Richard M. Stallman (rms at prep) * c-mode.el (electric-c-terminator): Bug if auto-fill while doing an auto-newline. (insertpos off by 1). * files.el (set-visited-file-name): Downcase buffer name uniformly on VMS. Mon Jun 22 22:24:12 1987 Richard M. Stallman (rms at prep) * c-mode.el (c-backward-to-noncomment): Don't loop on lines starting in ` #'. Thu Jun 18 00:38:46 1987 Richard M. Stallman (rms at prep) * files.el (set-visited-file-name): Downcase the new buffer name on VMS. Wed Jun 17 00:39:56 1987 Richard M. Stallman (rms at prep) * view.el (View-scroll-lines-forward): If end of buffer is visible, exit view mode. Mon Jun 15 20:25:55 1987 Richard M. Stallman (rms at prep) * rmail.el (rmail-get-new-mail): If file has changed on disk and is read in again, count its messages again. Wed Jun 10 21:10:01 1987 Richard M. Stallman (rms at prep) * Version 18.47 released. * startup.el (command-line): Old test for su failed. Now assume su if (user-login-name) != (getenv "USER"). Mon Jun 8 19:31:03 1987 Richard M. Stallman (rms at prep) * version 18.46 released. * isearch.el (isearch): Typo (3 should be 2) in getting old start-point in reverse regexp search made more liberal. Mon Jun 8 18:41:28 1987 Chris Hanson (cph at prep) * scheme.el (scheme-mode-syntax-table): Typo. Thu Jun 4 17:14:54 1987 Richard M. Stallman (rms at prep) * telnet.el: Doc fix. Sun May 31 01:20:32 1987 Richard M. Stallman (rms at prep) * version 18.45. * informat.el (Info-split): Bind case-fold-search to t. Fri May 29 00:41:16 1987 Richard M. Stallman (rms at prep) * lisp-mode.el: Add some comments. * replace.el (list-matching-lines): If run on *Occur* buffer, find nothing, rather than getting infinite loop. Thu May 28 16:41:41 1987 Richard M. Stallman (rms at prep) * simple.el (backward-delete-char-untabify): Use insert-char to insert the spaces. Wins for large tab-width. Thu May 28 15:40:36 1987 Chris Hanson (cph at prep) * xscheme.el (xscheme-send-current-line): Send the line to Scheme AFTER writing the newline which acknowledges the command. Otherwise the process-mark can end up in the wrong place. Thu May 28 12:24:54 1987 Richard M. Stallman (rms at prep) * texinfmt.el (texinfo-format-printindex): Pass -d to `sort'. This makes entry `Foo' precede `Foo Bar'. * vms-patch.el (create-file-buffer): New VMS-override definition downcases the file name. Wed May 27 12:44:22 1987 Richard M. Stallman (rms at prep) * informat.el (Info-split): Put newlines at end of split files. * dabbrev.el (dabbrev-expand): Preserve case in the replacement if that's enabled and the replacement is either all lower case or capitalized. (dabbrevs-search): Don't distinguish possible replacements that match except for case, if new 3rd arg NOCASE is set. * ftp.el (various): Ignore errors in accept-process-output. Mon May 25 23:01:09 1987 Richard M. Stallman (rms at prep) * sun-mouse-fns.el (mouse-scroll-proportional): Scroll proportional to current restrictions. * sun-mouse-fns.el (enable-mouse-in-buffer-list): Make mouse do something on *Buffer List*. Sat May 23 18:30:02 1987 Richard M. Stallman (rms at prep) * shell.el (kill-output-from-shell): Save final unfinished line. Thu May 21 17:37:45 1987 Richard M. Stallman (rms at prep) * c-mode.el (calculate-c-indent, indent-c-exp): When using c-continued-statement-offset, if line starts with an open-brace, add c-continued-brace-offset. Wed May 20 11:38:25 1987 Richard M. Stallman (rms at prep) * isearch.el (isearch): When splitting window, any hscroll stays with the text it applied to. Tue May 19 10:38:25 1987 Chris Hanson (cph at prep) * scheme.el (scheme-indent-specform): Do not handle first two distinguished forms specially. All distinguished forms are indented at double scheme-body-indent. * scheme.el: Conditionalize MIT-Scheme specific indentation with a flag `scheme-mit-dialect'. Users of other dialects can set this to false to disable that indentation. Sat May 16 02:16:31 1987 Richard M. Stallman (rms at prep) * rmailsum.el (rmail-summary-scroll-msg-{up,down}): Simplify, and make ...-down use scroll-other-window so it avoids changing the selected window. * tex-mode.el (TeX-common-initialization): Don't give \ any special syntax. * dired.el (dired-compress): Fix typo in call to `message'. * rmailsum.el (rmail-make-basic-summary-line): When searching for header field names, insist they appear at beginning of line. * subr.el (one-window-p): If ARG was nil it was really less-than-three-windows-p. * sendmail.el, electric.el, ehelp.el, rmail.el: Delete temporary duplicate definitions of one-window-p. Wed May 13 10:28:39 1987 Richard M. Stallman (rms at prep) * sendmail.el (mail-setup): New parameter mail-default-reply-to: if non-nil, insert it as a Reply-to field. * dired.el (dired-unflag): Doc fix. * simple.el (blink-matching-open): Don't use last-input-char; look in the buffer to determine which closeparen is present. Tue May 12 11:50:22 1987 Richard M. Stallman (rms at prep) * loadefs.el (sentence-end): Treat `}' like `)'. * buff-menu.el (buffer-menu-mode): Run buffer-menu-mode-hook. * modula2.el (m2-newline): Define this missing function. * server.el (server-done): Write MH backup with write-region. loaddefs.el: Autoload server-start, not server-edit. (server-start): Change documentation: this is the main entry. * startup.el (command-line): If running under `su', use user's original login name to get init file. Otherwise use $HOME. Mon May 11 17:25:04 1987 Richard M. Stallman (rms at prep) * isearch.el (isearch): When splitting window for slow search with temp window at the top, prevent scrolling in main window. * term/vt200.el: Correct mapping of Insert key. * loaddefs.el (run-scheme): Add an autoload. Wed Apr 29 14:46:12 1987 Richard Mlynarik (mly at prep) * abbrevlist.el (list-one-abbrev-list): Use value returned by sort. (Michael Prange <8704291816.AA13767@prep.ai.mit.edu>) Wed Apr 29 10:02:00 1987 Leonard H. Tower Jr. (tower at prep) * loaddefs.el Updated rnews documentation and added autoload of news-post-news. Tue Apr 28 15:24:49 1987 Leonard H. Tower Jr. (tower at prep) * rnewspost.el (news-post-news, news-reply) Fixed news-show-all-headers bug when *news* buffer was on an article that no longer has a file in the news spool directory tree. Also made both work from almost any buffer in any mode. (Dave Steiner <8704230309.AA03452@topaz.rutgers.edu>) Tue Apr 28 10:51:16 1987 Richard Mlynarik (mly at prep) * files.el (save-buffer): When saving a large file, print a message. * terminal.el (te-newline, te-set-window-start): Don't set-window-start unless (eq (selected-window) (get-buffer-window (current-buffer))) * startup.el (command-line): -batch => -no-init-file Thu Apr 23 17:10:41 1987 Leonard H. Tower Jr. (tower at prep) * rnewspost.el; rnews.el: added (require 'rnews) and (provide 'rnews), respectively. Thu Apr 23 12:38:37 1987 Chris Hanson (cph at prep) * scheme.el: * xscheme.el: Install new versions of these files to correspond to CScheme release 5. The old `xscheme.el' will not work correctly with the new CScheme release. The new `scheme.el' implements the Scheme standard syntax more correctly. Thu Apr 23 10:42:53 1987 Richard Mlynarik (mly at prep) * loaddefs.el: Autoload `run-prolog'. ".pl" files are in prolog-mode. * prolog.el: Fix to prolog-indent-level. (Masanobu UMEDA <8704201111.AA10940@flab.flab.fujitsu.junet>) * vip.el: Fixes from Masahiko Sato; Version 2.8 (ms@sail.stanford.edu <8704231017.AA11075@nttlab.ntt.junet>) Wed Apr 15 01:29:41 1987 Paul Rubin (phr at prep) * version 18.44 released. Tue Apr 14 09:55:34 1987 Richard Mlynarik (mly at prep) * mailalias.el (build-mail-aliases): Don't treat "alt" as "alias" (delimit "[ \t]+" not "[ \t]*") (sjk <8704140433.AA00840@cancun.ads.arpa>) Mon Apr 13 08:53:18 1987 Richard Mlynarik (mly at prep) * loaddefs.el ((query-)replace-regexp documentation): Use \=\ in doc strings now that \< is special in substitute-command-keys. Sat Apr 11 15:30:17 1987 Richard Mlynarik (mly at prep) * server.el: (various): Changes suggested by rlk@athena.mit.edu (<8704032045.AA00797@CHOWPEENTULK.MIT.EDU>) * loaddefs.el: Autoload server-edit rather than server-start. [This was later taken out.] * dired.el (dired-compress, dired-uncompress): Add "(Un)compressing ... done" messages. * view.el (view-mode-command-loop): Restore local map of correct buffer, even if user has switched buffers. (jason <19933.545094826@violet.berkeley.edu>) * lisp.el (lisp-complete-symbol): Skip over `quote' syntax chars to find real start of symbol. (douglis <8704102143.AA16318@sloth.Berkeley.EDU>) Fri Apr 10 10:16:51 1987 Richard Mlynarik (mly at prep) * mailalias.el: build-mail-aliases: Hack "\\\n" continuation lines. define-mail-alias: Addresses sent to the mailer should be separated by ", ", not " "!! Wed Apr 8 13:05:41 1987 Richard Mlynarik (mly at prep) * rfc822.el (rfc822-addresses): Don't loop trying to report that ";" is an invalid address. Mon Apr 6 09:21:18 1987 Richard Mlynarik (mly at prep) * sun-mouse.el: (sm::window-xy): Agree with `new' args to next-window. (peck@sun.com <8704032106.AA12845@denali.sun.com>) Fri Apr 3 08:49:27 1987 Richard Mlynarik (mly at prep) * term/vt200.el: Fix typo. Thu Apr 2 12:42:08 1987 Richard Mlynarik (mly at prep) * startup.el (command-line): Default init file is "$HOME/.emacs", not "~$USER/.emacs" Tue Mar 31 10:03:06 1987 Richard Mlynarik (mly at prep) * edt.el: Fix typo. * mh-e.el (mh-send-letter): "-unique" => "-nopush. (larus <8703311804.AA05788@paris.Berkeley.EDU>) * shell.el: Minor doc fixes. * rmail.el (rmail-get-new-mail): Handle errors competently. (Don't attempt to handle them, rather than botching the job) * rmail.el (rmail-insert-inbox-text): Put ".newmail" file in same directory as rmail-file-name rather than in $HOME. This allows one to read things in even when out of space on one filesystem. Use expand-file-name rather than (concat file "/...") for system-independence. Collect and report errors from `movemail' (rather than saying "(There is no new mail)"!) * rmail.el: rms' changes of the 5th of March never made it in. rmail-undelete-previous-message, rmail-next-undeleted-message: Don't call rmail-show-msg if message is already current. Avoids scrolling. Sun Mar 22 09:26:51 1987 Richard M. Stallman (rms at prep) * Version 18.41 released. * vip.el (vip-mode): Add this function, which loaddefs.el expected. * vip.el (change-mode): Eliminate emacs-mode-line-format; use change-mode-line when reentering emacs-mode. * prolog.el (prolog-mode-variables): comment-column=48. * prolog.el (prolog-consult-region): New arg COMPILE (prefix). Before the region, send one of prolog-{consult,compile}-string. After, send prolog-eof-string or else real eof. Get region bounds using interactive r. * prolog.el (prolog-consult-region-and-go): Similar. * info.el (Info-find-node): Don't call Info-mode if already in that mode. Avoids wiping out local variables such as Info-current-file. Sat Mar 21 13:36:04 1987 Richard M. Stallman (rms at prep) * term/sun.el: Define sun-esc-bracket as nil: don't redefine M-[ by default. * informat.el (Info-validate): Don't get error while checking for an indirect info file. Fri Mar 20 10:20:16 1987 Richard M. Stallman (rms at prep) * dired.el (dired-{un,}compress): Don't specify path for programs compress and uncompress. Thu Mar 19 14:56:55 1987 Richard Mlynarik (mly at prep) * disassemble.el (disassemble-1): Let print-escape-newlines t around constant printing. * terminal.el (terminal-emulator): Quote shell arg as "TERMCAP=foo" not TERMCAP="foo" Thu Mar 19 14:21:09 1987 Richard M. Stallman (rms at prep) * vip.el (string-tail, change-mode-line): Use string manipulation; flush the temp buffer " *working-space*". Wed Mar 18 11:36:49 1987 Richard M. Stallman (rms at prep) * Version 18.40 released. * files.el (after-find-file): Use directory-file-name where needed. Wed Mar 18 10:11:51 1987 Richard Mlynarik (mly at prep) * ftp.el (ftp-find-file-or-directory): Paren error. Tue Mar 17 09:46:29 1987 Richard M. Stallman (rms at prep) * server.el (server-visit-buffers): Don't revert a buffer automatically if the file does not currently exist. * mh-e.el (mh-list-to-string, mh-page-digest{,-backwards}): Fixes from Larus. * server.el (server-start): Kill old server before clearing out its records. Delete any old server socket unconditionally. Mark server process as kill-without-query. * files.el (recover-file): Don't try to list directory on vms. Sat Mar 14 09:39:24 1987 Richard M. Stallman (rms at prep) * Version 18.39 released. Fri Mar 13 19:34:24 1987 Richard M. Stallman (rms at prep) * dired.el: New commands dired-{un,}compress, dired-byte-compile, dired-ch{mod,own,grp} and subroutine dired-redisplay. From Jim Cottrell, rbj@icst-cmr.arpa. They are all put on keys. * sun-{mouse,mouse-fns,cursors}.el, term/sun.el: New and replacement files from peck@sun.com. Thu Mar 12 16:17:22 1987 Richard M. Stallman (rms at prep) * server.el (server-visit-files): Before trying find-file-noselect, check for existing buffer, and if it isn't modified, revert it unconditionally. * mh-e.el (mh-send-letter): Considerable rewrite by Larus; don't know why. Wed Mar 11 18:11:12 1987 Chris Hanson (cph at prep) * sort.el (sort-subr): fix typo in sorting of lists: in case where `sortcar' is not available, and arguments are numbers, was using `cdr' to extract second argument to `sort' (rather than `car'). Wed Mar 11 10:05:35 1987 Richard M. Stallman (rms at prep) * tex-mode.el (TeX-comment-indent): In column 0, don't require indenting at least to column 1. * vip.el: New version from Sato; handles the EX commands. * server.el: New version frm peck@sun, supporting multiple clients. Tue Mar 10 16:20:48 1987 Richard M. Stallman (rms at prep) * outline.el (hide-region-body): Exit loop cleanly no matter which stage reaches eob. Mon Mar 9 10:21:40 1987 Richard M. Stallman (rms at prep) * files.el (hack-local-variables): New optional arg FORCE. If it's nil, and `inhibit-local-variables' is non-nil, then query before installing the file's local variables. * files.el (normal-mode): Pass non-nil FORCE to hack-local-variables if we were called from find-file. * shell.el (shell-send-input): Fix typo in condition-case syntax. * shell.el (make-shell): Make a TERMCAP env var for term type "emacs" to give the screen width. Sun Mar 8 08:30:26 1987 Richard M. Stallman (rms at prep) * info.el (Info-mode): Make variables Info-current-*, Info-tag-table-marker and Info-history local in Info-mode. Fri Mar 6 14:55:31 1987 Richard Mlynarik (mly at prep) * ftp.el: Paren error. Thu Mar 5 16:27:47 1987 Richard M. Stallman (rms at prep) * sort.el (sort-reorder-buffer): Fix typo `end'->`last' in insertion of the spacing after the last sort record. * rmail.el (rmail-undelete-previous-message): Don't call rmail-show-msg if message is already current. Avoids scrolling. * rmail.el (rmail-next-undeleted-message): Likewise. Wed Mar 4 01:21:22 1987 Richard M. Stallman (rms at prep) * loaddefs.el (auto-mode-alist): Add .article and .letter as text-mode, for rn. * ftp.el (ftp-list-directory): New command. * ftp.el (ftp-find-file-or-directory): Guts of ftp-find-file are now here. 3rd arg is t for a file, nil for listing a directory. * mailalias.el (expand-mail-aliases): Correct handling of aliases whose expansions use other aliases, and aliases that are self-referent. * c-mode.el (calculate-c-indent): Line at beg of buffer needs no indentation. Tue Mar 3 21:43:01 1987 Richard M. Stallman (rms at prep) * shell.el (shell): New series of variables `explicit-FOO-args' specify args to use when running program FOO as a shell. Supply system-dependent default for explicit-csh-args. * mailalias.el (expand-mail-aliases): Fix typo: use build-mail-aliases to gobble redefined mail aliases. * loaddefs.el (dired-listing-switches): Doc fix. Mon Mar 2 15:54:47 1987 Richard Mlynarik (mly at prep) * Version 18.38 released. * shell.el (make-shell): Use the "env" program. This both simplifies and shortens the code, and makes it environment-implementation-independent. Mon Mar 2 08:36:03 1987 Chris Hanson (cph at prep) * page.el (what-page): Reported wrong page number if invoked exactly to the right of a page-delimiter. Sat Feb 28 14:28:28 1987 Richard M. Stallman (rms at prep) * loaddefs.el (mode-line-modified): New variable for string that indicates modifiedness in mode line. * rmail.el (rmail-mode-1): If mode-line-modified is bound, change it rather than mode-line-format. * rmailedit.el (rmail-edit-mode): same thing. Fri Feb 27 14:06:52 1987 Richard M. Stallman (rms at prep) * info.el (Info-follow-reference): Combine multiple spaces in node name before searching. Also helps with newline and spaces. * texinfmt.el (texinfo-format-buffer-1): Discard everything after the @bye. Thu Feb 26 22:02:09 1987 Paul Rubin (phr at prep) * texinfmt.el (texinfo-format-emph): Function was accidentally misnamed `texinfo-format'. Thu Feb 26 02:10:58 1987 Richard M. Stallman (rms at prep) * x-mouse.el (x-help, x-buffer-menu): Install definitions of these commands, possible now that xmenu.c is installed. Tue Feb 24 13:00:44 1987 Richard M. Stallman (rms at prep) * edt.el (update-mode-line): New function forces mode line update. * edt.el (backup-mode, advance-mode): Call update-mode-line. Also include a space at front of the word that's displayed. function-map => function-keymap. * edt.el: fix calls to define-keypad-key. * edt.el: fix typo `delete-previous-character'. Sun Feb 22 23:08:54 1987 Richard M. Stallman (rms at prep) * texinfmt.el: Define @cite, @emph and @strong. Thu Feb 19 16:00:13 1987 Richard Mlynarik (mly at prep) * subr.el: (fset 'set-window-buffer 'show-buffer) => (fset 'show-buffer 'set-window-buffer) Thu Feb 19 14:25:04 1987 Richard M. Stallman (rms at prep) * view.el (view-mode): No longer interactive. Much easier than fixing the problems that happen if it is used wrong. * files.el (find-alternate-file): Don't offer save if read-only. Wed Feb 18 19:32:06 1987 Chris Hanson (cph at prep) * simple.el (do-auto-fill): Do not `save-excursion' if do-auto-fill should have exactly the same effect as doing indent-new-comment-line. Otherwise if a fill-prefix or comment-start is inserted, point will be left at the beginning rather than the end of the inserted prefix. Wed Feb 18 10:20:23 1987 Richard M. Stallman (rms at prep) * abbrev.el (abbrev-mode): Update the mode line. * simple.el (overwrite-mode): Update the mode line. * term/vt100.el: If there are already keymaps on \e[ amd \eO, use them for the CSI-map and SS3-map. * texinfmt.el (texinfo-format-center): @center was missing. * isearch.el (isearch): If DEL is not special, it terminates the search as a random control character. Mon Feb 16 14:56:18 1987 Richard M. Stallman (rms at prep) * dabbrev.el: Missing quote in arg to make-variable-buffer-local. * man.el (manual-entry): Use insert-man-file instead of insert-file-contents. * tex-mode.el (TeX-show-print-queue): Start tex shell if not already done. * tex-mode.el (TeX-mode): bound search for % at eol. Sun Feb 15 18:03:14 1987 Richard M. Stallman (rms at prep) * loaddefs.el (completion-ignored-extensions): Add .bin again; scheme is said to use it. Fri Feb 13 14:40:51 1987 Richard M. Stallman (rms at prep) * rmail.el (rmail-insert-inbox-text): Do expand-file-name on names of inbox files. * loaddefs.el: Add autoload for server-start. Mon Feb 9 09:53:27 1987 Richard Mlynarik (mly at prep) * Version 18.37 released. * rmail.el (rmail-mode-1): Don't rely on mode-line-format being consp. Sun Feb 8 08:53:07 1987 Richard M. Stallman (rms at prep) * shell.el (inferior-lisp-program): New variable is used as program name when starting inferior Lisp. * shell.el (lisp-send-defun): Write the text to a temp file, then send a string saying to load the file. inferior-lisp-load-command controls generation of that string. Prefix arg means bring *lisp* buffer onto the screen and scroll it to the end. inferior-lisp-prompt controls recognition of when prompt arrives, indicating no more output coming so scrolling may be done. * server.el (server-start): Make "Server" appear in mode line while actual server operation is going on. Do process-kill-without-query also. * server.el (various): Call the buffer " *server*", not "*server*". * server.el (server-sentinel): Considerable cleanup. Don't ever switch-to-buffer on *server*. Do all parsing in it and finding of files without changing displayed buffers; only then display one buffer that merits it. Eliminate variable old-server-edit-buffer. * files.el (save-abbrevs): Default value is nil. * abbrev.el (read-abbrev-file): Set save-abbrevs to t. * shell.el (make-shell): Change process-environment to specify EMACS=t, TERM=switch and no TERMCAP. * debug.el (debug): Bind print-escape-newlines to t while printing the backtrace. * subr.el (run-hooks): Each hook value may be a list of functions as well as a single function. * files.el (after-find-file): Wait only after serious messages, not "(New file)" or "File is read-only". And don't redisplay when waiting. * mlconvert.el (convert-mocklisp-buffer): Generate mocklisp-style defuns, not Lisp-style, for dummy function ml-foo. Indent the body. Sun Feb 8 08:42:44 1987 Daniel LaLiberte (liberte at b.cs.uiuc.edu) * mlconvert.el (convert-mocklisp-buffer): Insert the starting comment and the `require' after encapsulating non-defuns into defuns. * mlconvert.el (fix-mlisp-syntax): Detect and fix the ^LETTER syntax. Sat Feb 7 22:27:16 1987 Richard M. Stallman (rms at prep) * mlconvert.el (convert-mocklisp-buffer): Treat | as alphabetic char. Convert syntax before converting non-defuns to defuns. Thu Feb 5 07:10:39 1987 Richard Mlynarik (mly at prep) * ftp.el (ftp-find-file): Ignore `125's from server. Tue Feb 3 05:21:10 1987 Richard Mlynarik (mly at prep) * simple.el (auto-fill-mode): Update mode-line after changing minor mode. Tue Feb 3 00:10:47 1987 Richard M. Stallman (rms at prep) * mh-e.el (mh-insert-prefix-string): Use explicit loop by lines. Sun Feb 1 04:39:34 1987 Richard M. Stallman (rms at prep) * loaddefs.el: purecopy many strings found in initial var values. Garbage collect in middle of file to reduce storage required for loading. Remove ".bin" from completion-ignored-extensions on Unix since only Symbolics customers would benefit from its presence. Symbolics killed the MIT AI lab; don't do business with them. * view.el (view-file): Kill the buffer at the end if it was created just for this and was not modified. * userlock.el (ask-user-about-supercession-help): Suggest use of revert-buffer. * help.el (print-help-return-message): Don't count minibuffer window when deciding whether there is only one window. Calls one-window-p. * subr.el (one-window-p): New function. * subr.el: Rename some args to reduce number of symbols. * electric.el (Electric-pop-up-window): * ehelp.el (with-electric-help): * rmail.el (rmail-forward): * sendmail.el (mail-send-and-exit): Don't count minibuffer window when deciding whether there is only one window. These are done by definining subroutine one-window-p in a way that works in old versions of Emacs. Fri Jan 30 16:35:48 1987 Richard Mlynarik (mly at prep) * loaddefs.el (completion-ignored-extensions): Add ".lbin" * mail-utils.el, loaddefs.el (mail-use-rfc822): Doc typo. Thu Jan 29 03:44:29 1987 Richard M. Stallman (rms at prep) * rmail.el (rmail-set-message-counters): * rmail.el (rmail-count-new-messages): Don't bind cursor-in-echo-area. * debug.el (debug-on-entry): Doc fix. * files.el (rename-auto-save-file): Don't rename if new and old names are the same. Wed Jan 28 17:55:02 1987 Richard M. Stallman (rms at prep) * rmail.el (rmail-mode-1): Don't set mode-line-buffer-identification. Mon Jan 26 17:15:27 1987 Richard M. Stallman (rms at prep) * simple.el (set-variable): Use documentation-property instead of get, for getting variable documentation. Sun Jan 25 15:46:01 1987 Richard Mlynarik (mly at prep) * debug.el (debug): Bind cursor-in-echo-area. Fri Jan 23 13:19:28 1987 Richard M. Stallman (rms at prep) * isearch.el (isearch): In reverse search, wrapping is to end of buffer, not beginning. * man.el (manual-entry): Take 1st char of `section' as a substring, not as a char, to pass to `concat'. * loaddefs.el (completion-ignored-extensions): Add ".glo", ".idx" and ".lot". Thu Jan 22 16:09:51 1987 Chris Hanson (cph at prep) * shell.el (shell): Do not pass -T flag to `/bin/sh', only to `/bin/csh'. Thu Jan 22 15:08:24 1987 Richard M. Stallman (rms at prep) * scribe.el (scribe-mode): Doc fix. * loaddefs.el (scribe-mode): Doc fix. * tex-mode.el (tex-mode): Change tex vs latex discrimination to avoid a slow regexp. Thu Jan 22 13:06:33 1987 Richard Mlynarik (mly at prep) * files.el (find-file-noselect): Call expand-file-name earlier so it is correct in case of errors, file-not-found, etc. Wed Jan 21 17:00:19 1987 Richard Mlynarik (mly at prep) * yow.el, flame.el, doctor.el: Change calls to (random) (lisp reader doesn't read octal "07777") Wed Jan 21 02:13:17 1987 Richard M. Stallman (rms at prep) * Version 18.36 released. Wed Jan 21 02:13:17 1987 Richard M. Stallman (rms at prep) * bytecomp.el (byte-compile-setq-default): New function for special handling needed because setq-default has an unevalled arg. * c-mode.el (calculate-c-indent): When finding first statement inside brace-group, `case' is not special unless a colon appears. * macros.el (kbd-macro-query): Make C-l call `recenter'. * bytecomp.el (byte-compile-setq): Make setq with no args generate a value. * bytecomp.el (byte-compile-cond): Notice unconditional clauses and optimize the code generated. Tue Jan 20 11:48:17 1987 Richard M. Stallman (rms at prep) * bytecomp.el (byte-compile-if): Correct test for else-less if's. * sun-mouse.el: Delete code to handle resize-blips since they are unnecessary and no longer generated. * sort.el (sort-columns): Pass -t\n instead of -b to `sort'. Mon Jan 19 12:44:42 1987 Richard M. Stallman (rms at prep) * loaddefs.el (auto-mode-alist): Recognize .lsp as Lisp mode. Fri Jan 16 18:09:59 1987 Richard Mlynarik (mly at prep) * rmail.el (rmail-count-new-messages), rmailout.el (rmail-output-to-rmail-file): Add optional arg `nomsg' to former, which latter supplies, so that rmail doesn't report counting one appended message. Thu Jan 15 22:19:17 1987 Richard M. Stallman (rms at prep) * shell.el (shell): Flush hpux kludge to use "sh" instead of SHELL, and install another kludge to pass -T if on hpux. Thu Jan 15 17:08:01 1987 Richard Mlynarik (mly at prep) * time.el (display-time-filter): Never eat anything larger than your own head. Thu Jan 15 16:10:33 1987 Richard M. Stallman (rms at prep) * files.el (after-find-file): Sit for 2 sec after warning msg. Thu Jan 15 09:07:04 1987 Richard Mlynarik (mly at prep) * rmail.el (rmail-get-new-mail): (or (verify-visited-file-modtime (current-buffer)) (find-file (buffer-file-name))) * simple.el (append-next-kill): Make this work when not (interactive-p) Wed Jan 14 16:40:38 1987 Richard Mlynarik (mly at prep) * terminal.el: Can't send ^d chars (004) through the cretinous so-called ptys written by the mindless so-called hackers responsible for un*x (the Operating System of the Future.) Mon Jan 12 01:08:19 1987 Richard Mlynarik (mly at prep) * files.el (basic-save-buffer): Typo. Sun Jan 11 16:16:15 1987 Richard Mlynarik (mly at prep) * ebuff-menu (electric-buffer-list): Typo. * buff-menu.el (Buffer-menu-select): If the buffer to select is also marked with ">" only make one window for it. * terminal.el (te-filter): Save/restore point from te-saved-point to minimise the lossage vandals can inflict. Fri Jan 9 15:54:00 1987 Richard M. Stallman (rms at prep) * tex-mode.el: New version from Gildea. Many changes. Fri Jan 9 15:04:45 1987 Richard Mlynarik (mly at prep) * novice.el (disabled-command-hook): cursor-in-echo-area. Fri Jan 9 10:23:13 1987 Richard M. Stallman (rms at prep) * mh-e.el (mh-send-letter, mh-fully-kill-draft): Two minor fixes from Larus. * files.el (basic-save-buffer): After prompting for filename for non-file buffer, turn on auto-save. Thu Jan 8 12:05:49 1987 Richard Mlynarik (mly at prep) * files.el (set-visited-filename): (kill-local-variable 'revert-buffer-function) * hanoi.el (hanoi0), yow.el, flame.el (psychoanalyze-{pinhead,flamer}): Quit if luser types a char rather than inhibiting redisplay for 20 minutes! Thu Jan 8 00:59:16 1987 Richard M. Stallman (rms at prep) * sort.el (sort-columns): Fix typo in variable name. Also check for presence of tabs and get error. Wed Jan 7 13:25:01 1987 Richard M. Stallman (rms at prep) * vi.el: New version from wu@crys.wisc.edu. All function and variable names start with `vi'. Some missing vi capabilities now emulated. * sun-mouse.el (set-screen-size-and-rdis): was using x as screen height and y as width; exchange. Tue Jan 6 23:52:52 1987 Richard Mlynarik (mly at prep) * term/x-win.el: Set suspend-hook to get an error. Tue Jan 6 17:35:37 1987 Richard M. Stallman (rms at prep) * mh-e.el (mh-write-msg-to-file): Generate buffer " *mh-temp*" if it is missing. Tue Jan 6 11:53:42 1987 Richard Mlynarik (mly at prep) * rmailmsc.el (set-rmail-inbox-list): More informative prompt. Mon Jan 5 01:15:17 1987 Richard M. Stallman (rms at prep) * paths.el: Prefer Berkeley-style formatted manual directories (/usr/mat/cat1...) to ATT-style ones. Pyramid has trouble if it uses ATT dirs in BSD universe. * vi.el: New version from wu@crys.wisc.edu. * Version 18.35 released. Sun Jan 4 22:11:20 1987 Richard M. Stallman (rms at prep) * picture.el: Fix typo in define-key for C-c<. Sun Jan 4 21:15:59 1987 Richard Mlynarik (mly at prep) * prolog.el: Don't modify current buffer's syntax-table when loading this file. Sat Jan 3 19:59:41 1987 Richard M. Stallman (rms at prep) * x-mouse.el: Define names for the button-up events. Wed Dec 31 04:19:31 1986 Richard M. Stallman (rms at prep) * bytecomp.el (byte-compile-function-form): Was miscompiling (function SYMBOL) by failing to quote SYMBOL. Sun Dec 28 14:32:22 1986 Richard Mlynarik (mly at prep) * userlock.el: Bind cursor-in-echo-area for read-char. Wed Dec 24 18:31:50 1986 Richard Mlynarik (mly at prep) * terminal.el: Lots of things changed. Have to start a shell just to call stty since emacs won't set things up correctly!!! (We end up sometimes execing 5 programs to start up...) Emulator terminal-type capabilities extended somewhat and `command-set' made somewhat emacs-oid in order to make termscript files easier to understand. Tue Dec 23 02:11:49 1986 Richard M. Stallman (rms at prep) * macros.el (insert-kbd-macro): Only look for global key bindings since we don't know how to record local ones properly (and in general there is no way to do it). * bytecomp.el (byte-compile-find-vars-1): Cons up and return a macroexpanded version of the form being scanned. Don't look inside a call to `function' or `condition-case'. For catch, look only at first argument. * bytecomp.el (byte-compile-find-vars): Return (MACROEXPANDEDFORM . VARSUSED). * bytecomp.el (byte-compile-top-level): Use the macroexpanded form returned by byte-compile-find-vars for subsequent compilation. Thus, each macro call is expanded only once. Mon Dec 22 15:50:58 1986 Richard M. Stallman (rms at prep) * subr.el: Delete nth and copy-keymap (now in fns.c and keymap.c). Mon Dec 22 14:04:15 1986 Richard Mlynarik (mly at prep) * texinfmt.el (batch-texinfo-format): Was printing message about source file rather than output file. Mon Dec 22 13:08:39 1986 Richard M. Stallman (rms at prep) * subr.el: Remove `delete-backward-char-untabify', insert `backward-'delete-char'. Mon Dec 22 11:06:47 1986 Richard Mlynarik (mly at prep) * simple.el (undo): Was missing local var `modified' * subr.el: Make `set-window-buffer' synonym for obfuscatory `show-buffer' Make 'delete-backward-char-untabify' a synonym for `backward-delete-char-untabify' -- the non-conventional naming of the latter confuses people Sat Dec 20 23:38:00 1986 Richard Mlynarik (mly at prep) * loaddefs.el: Add autoload for sort-regexp-fields. * sort.el: Rename skip-fields -> sort-skip-fields to avoid name-conflict Sat Dec 20 21:51:22 1986 Richard M. Stallman (rms at prep) * isearch.el (isearch): Print message "" only if don't set mark. * isearch.el (isearch-message): Put cursor in echo area instead of ellipsis. * isearch.el (isearch-search): use one string-match to check for all errors that mean "incomplete input". * files.el (rename-auto-save-file): Alter auto save file name of current buffer, and rename any existing auto save file. * files.el (set-visited-file-name): Use rename-auto-save-file if auto save mode is already on. * simple.el (undo): If undo-mode clears modified, delete any auto-save file. Sat Dec 20 17:04:26 1986 Richard Mlynarik (mly at prep) * fortran.el: Allow fortran-comment-indent-char to be a string of length 1, since that is what is documented in the printed v18 manuals. * terminal.el: Print a help message when emulator starts. Fix a bug in te-escape-help. * subr.el (read-quoted-char): Document PROMPT arg. Fri Dec 19 16:26:05 1986 Richard M. Stallman (rms at prep) * lisp.el (lisp-complete-symbol): Don't put pre-completion text on kill ring. Fri Dec 19 11:31:22 1986 Richard Mlynarik (mly at prep) * ftp.el (read-ftp-user-password): Change prompting for user-name Thu Dec 18 01:40:37 1986 Richard M. Stallman (rms at prep) * files.el (recover-file): Supply missing arg in call to error. * isearch.el: If search-slow-window-lines is negative, put the search window at the top. Always bind window-min-height to 1. * isearch.el: When extending a reverse non-regexp search must not extend past barrier (same idea as below for regexps). Wed Dec 17 11:44:21 1986 Richard M. Stallman (rms at prep) * isearch.el: Combine code for search-repeat-char and search-reverse-char into one cond clause. If search direction is changing, don't greb prev search-string. Otherwise, do grab it if search-string is currently empty. * isearch.el: When extending a reverse regexp search string, criterion for extending current match was one off, and also now won't go into the area beyond where last C-r was typed. * replace.el (perform-replace): If user types C-l, clear screen, redisplay, and ask again. * isearch.el: In regexp isearch, when a ?, * or | is input, back up start of search. New local variable `barrier' is position of original command or of last C-s or C-r; it is saved by isearch-push-state. Mon Dec 15 09:30:22 1986 Richard Mlynarik (mly at prep) * fortran.el: Initialise fortran-mode-abbrev-table correctly. * fortran.el: fortran-comment-indent-char should be a character (a fixnum), not a string of length one. * rmail.el: Add support for delta-from-UT timezone specs ("EST" = "-0500") Add support for four-character timezone specifications such as NZST [This is actually a bit suspect, since four-character timezone specs violate the rfc822 date format -- one should be using a spec like "+1000" instead] Fri Dec 12 09:21:03 1986 Richard M. Stallman (rms at prep) * loaddefs.el: Delete incorrect entry for .mss in auto-mode-alist, so correct entry is visible. * rmail.el (rmail): Initialize rmail-last-{rmail-,}file here rather than when rmail.el is loaded. * Version 18.33 released. * rnewspost.el: require sendmail. * loaddefs.el: Autoload scribe-mode and use for ".mss" files. Autoload modula-2-mode and prolog-mode as well. * sendmail.el (mail-mode): Set buffer-offer-save. * files.el (save-some-buffers): If user says `n' to "Save abbrevs?", clear abbrevs-changed so won't ask again. * files.el (buffer-offer-save): New variable, local in all buffers. * files.el (save-some-buffers): New 2nd arg EXITING. If non-nil, offer to save any nonempty modified buffer in which `buffer-offer-save' is non-nil. * sup-mouse.el: New file to handle mouse commands on supdup terminals. Thu Dec 11 17:59:43 1986 Chris Hanson (cph at prep) * man.el: Fix bug in regexp used to nuke footers in hp-ux. Thu Dec 11 17:52:44 1986 Richard M. Stallman (rms at prep) * keypad.el: Fix typo "kill-linee". Thu Dec 11 14:19:20 1986 Richard Mlynarik (mly at prep) * isearch.el (isearch): Never set search-last-string to "" Wed Dec 10 17:28:20 1986 Richard M. Stallman (rms at prep) * help.el (help-for-help): Once long help text is on screen, bind cursor-in-echo-area to t for reading subsequent chars. * sort.el (sort-columns): Fix typo (col-beg1 was col-beg and likewise for col-end1). Tue Dec 9 16:06:45 1986 Richard Mlynarik (mly at prep) * terminal.el, ehelp.el: New files. "terminal" still needs a small amount of documentation. Sat Dec 6 14:28:39 1986 Richard M. Stallman (rms at prep) * Version 18.32 released. * scribe.el: New file containing scribe-mode. * server.el: New file containing server-start (makes existing Emacs process serve as "the editor" for other programs that want to invoke an editor subprocess.) Fri Dec 5 01:14:16 1986 Richard M. Stallman (rms at prep) * subr.el (substitute-key-definition): [MLY] The definitions are in the cdr's of alist elts, not the cars. * mh-e.el: 3.4h from Larus. * rmail.el (rmail-get-new-mail): Never bind make-backup-files to t if it was nil before. * keypad.el (function-key-sequence): * macros.el (insert-kbd-macro): * vi.el: Pass local map argument to where-is-internal. * c-mode.el (c-backward-to-noncomment): Skip ^L like newline. * c-mode.el (calculate-c-indent): When checking for continued previous lines, after skipping one, use c-backward-to-noncomment to find next real text. When classifying top-level lines, ignore page breaks; lines ending in } are not continued lines. * rmailkwd.el (rmail-set-label): Delete whitespace only next to commas. * rmailkwd.el (rmail-nuke-whitespace): Delete this function. * sendmail.el (mail-do-fcc): Delete the entire line of an fcc including the newline after it. Was failing to do so if the line had a space or tab at the end. * c-mode.el (c-indent-line): Don't think that "else_..." is the keyword "else". * rmail.el (rmail-search): For reverse search, use re-search-forward to filter messages; then, once a message is found, use re-search-backward to position point within it. * rmail.el (rmail-expunge): Don't bomb if rmail file is empty. * rmail.el (rmail-show-message): If showing message number zero, don't beep, and set point at beginning of it. * rmail.el (rmail-set-message-counters): If no messages, set rmail-current-message to 0. Thu Dec 4 18:53:38 1986 Richard Mlynarik (mly at prep) * ftp.el (ftp-sentinel): Catch time taken/transfer-rate information. Tue Dec 2 22:35:00 1986 Richard M. Stallman (rms at prep) * float.el (float-to-string): Don't infinite-loop if arg is zero. * float.el (float-regexp): Accept numbers lacking digits before the point. Accept numbers with a point and no digits after it. Don't get confused by matching just part of the input. * float.el (string-to-float): Detect if loading-0s gets to equal the length of digit-string. Tue Dec 2 15:46:37 1986 Richard Mlynarik (mly at prep) * float.el (extract-match): Convert to new re-register regime Mon Dec 1 18:08:39 1986 Richard Mlynarik (mly at prep) * mailalias.el (expand-mail-aliases): Check for case of (eq mail-aliases t) -- can happen if mail-mode is entered without calling mail-setup (eg when trying to recover an autosaved mail file) Wed Nov 26 17:30:21 1986 Richard Mlynarik (mly at prep) * loaddefs.el: mode-line-format should contain (-3 . "%p") rather than "%3p" * terminal.el: Use the "env" program Wed Nov 26 00:07:19 1986 Richard M. Stallman (rms at prep) * compile.el (compile1, compilation_sentinel): Don't make *compilation* read-only. * simple.el (next-complex-command): fix one-off about largest allowed value of ARG. If attempting to move past beginning or end of history, move to the first or last element and then signal an error. * terminal.el: New file, like shell-mode modified to simulate a display terminal for the inferior. Tue Nov 25 00:04:36 1986 Richard M. Stallman (rms at prep) * outline.el (outline-mode): outline-regexp must match at start of line to be a paragraph start. * simple.el ({beginning,end}-of-buffer): When buffer-size is large, divide before multiplying to avoid overflow. * mailalias.el (expand-mail-aliases): Re-expand the expansions for compatibility with Berkeley mail. * ftp.el: New file for visiting remote files using FTP. Mon Nov 24 14:07:40 1986 Richard M. Stallman (rms at prep) * files.el (find-file-noselect): Due to change in insert-file-contents, need not set buffer-file-name if error. * paths.el: Correct manual-formatted-dirlist for USG systems. * man.el: Use new subroutine insert-man-file to insert files uncompressing if nec. Also uncompact compacted files. Detect sysV footers. Detect headers when section contains a letter (as in 3n). Delete the vars already moved to paths.el. * disass.el: new name for disassemble.el to avoid USG truncation. loaddefs.el changed for this. Mon Nov 24 02:43:08 1986 Chris Hanson (cph at prep) * term/supdup.el: Add code for hp-ux which has no binding for the TERMCAP environment variable. Sun Nov 23 00:03:35 1986 Richard M. Stallman (rms at prep) * version 18.31 released. * x-mouse.el: New mouse-command keys are C-x C-@. Sat Nov 22 14:15:11 1986 Richard Mlynarik (mly at prep) * bytecomp.el (byte-recompile-directory): Use third arg to `directory-files' Sat Nov 22 02:26:22 1986 Richard M. Stallman (rms at prep) * subr.el: Defvars for global-map, ctl-x-map, esc-map and mouse-map, just so they get doc strings. Fri Nov 21 15:43:49 1986 Richard M. Stallman (rms at prep) * bytecomp.el (byte-compile-file): Bind vms-stmlf-recfm to t around writing the output file. Fri Nov 21 14:46:37 1986 Leonard H. Tower Jr. (tower at prep) * rnews.el, rnewspost.el (caesar-region, news-caesar-buffer-body) Added former from phr, rename latter and modified it to work with former. Changed key-bindings for rename. This gets rid of the interface (which also is ugly) to the UNIX "tr" command. Fri Nov 21 00:29:13 1986 Richard M. Stallman (rms at prep) * mh-e.el (mh-display-msg): Pass non-nil 2nd arg to insert-file-contents Thu Nov 20 23:57:52 1986 Richard M. Stallman (rms at prep) * vip.el (vip-find-char): Use search-forward instead of * yow.el (snarf-yows): scan-buffer. A few other local * man.el (manual-entry): simplifications. * bytecomp.el: Don't open-code scan-buffer. Thu Nov 20 12:33:31 1986 Richard Mlynarik (mly at prep) * helper.el: Flush Helper-major-mode, Helper-mode-name: there is a much simpler way of doing this (see new Helper-describe-mode) Make it work for Helper-return-blurb to be buffer-local (this is better than binding it dynamically) * ebuffer-menu.el, echistory.el, view.el: Flush references to Helper-{major-mode,mode-name} Wed Nov 19 22:39:57 1986 Richard M. Stallman (rms at prep) * indent.el: Make tab-stop-list a user variable. * rmail.el: Undo previous change to rmail-show-message. Tue Nov 18 08:39:59 1986 Richard Mlynarik (mly at prep) * prolog.el (end-of-prolog-clause): Typo * ebuff-menu.el: Make "n" and "p" synonymous with "\C-n" and "\C-p" * rmail.el (rmail-show-message): With no interactive argument, just move to beginning of current message (like ".") rather than to message 1. Sun Nov 16 23:32:19 1986 Richard M. Stallman (rms at prep) * startup.el: expect window-system to be a symbol, not a string, and concatenate "-win" instead of "-windows" to keep file names short. * term/x-win.el: New name for term/X-windows.el needed due to change in dispnew.c re window-systems. Sun Nov 16 11:04:33 1986 Leonard H. Tower Jr. (tower at prep) * rnews.el (news-ignored-headers) removed Organization:, so it's visible to readers. Fri Nov 14 13:16:48 1986 Richard M. Stallman (rms at prep) * Emacs version 18.30 * * rmail.el (rmail-forward): Use mail-other-window unless there is only one window visible. Use of `mail' instead in the case of multiple windows on the screen makes it a nuisance to get back to Rmail. * outline.el (outline-regexp): ^L starts a header line. Thu Nov 13 23:38:57 1986 Richard M. Stallman (rms at prep) * fill.el (fill-region-as-paragraph): If 1st line starts with fill prefix, exclude that fill prefix from the preprocessing before actual filling. Fixes failure to preserve initial whitespace after a fill prefix. Tue Nov 11 14:57:25 1986 Leonard H. Tower Jr. (tower at prep) * rnews.el (news-show-all-headers) Added code to replace previously deleted (news-get-back). * emacsbug.el (report-emacs-bug): Got rid of redundant "on system-name (system-type)" now that (emacs-version) outputs it. Mon Nov 10 08:54:05 1986 Richard Mlynarik (mly at prep) * dired.el (dired-mode): (run-hooks 'dired-mode-hook) Sun Nov 9 21:59:30 1986 Richard Mlynarik (mly at prep) * files.el (set-visited-file-name): (kill-local-variable 'write-file-hooks) Sun Nov 9 14:28:43 1986 Richard M. Stallman (rms at prep) * simple.el (push-mark): Print nothing if minibuffer active. Sat Nov 8 09:38:18 1986 Richard M. Stallman (rms at prep) * rnews.el (news-set-mode-line): Don't change mode-line-format; instead change mode-line-process and mode-line-buffer-identification. Delete unused function `strcpyn'. * echistory.el (electric-command-history): Delete no-op `let'. * compile.el (compile1): Flush v17 compatibility code to sett mode-line-format. * info.el (Info-set-mode-line, Info-edit): Ditto. * shell.el (shell-mode, inferior-lisp-mode): Ditto. * telnet.el (telnet-mode): Ditto. * c-mode.el (calculate-c-indent): When deciding whether a line is a continuation, ignore label-lines. Also ignore preceding lines that end in commas. Consequence: if the preceding line is a continuation, our line is indented just like it (as a continuation of the same thing). * loadup.el: look for new file "site-load.el" to preload libraries before the DOC file is read. Fri Nov 7 19:15:57 1986 Richard M. Stallman (rms at prep) * novice.el (disabled-command-hook): Catch errors in `documentation' in case doc file is missing. * keypad.el (function-key-sequence): Use cons, not list, to make the definition to search for. Fri Nov 7 12:30:48 1986 Richard Mlynarik (mly at prep) * sort.el (sort-build-lists): Delete CPH's change. This had already been fixed in a different way. Fri Nov 7 10:40:40 1986 Richard M. Stallman (rms at prep) * c-mode.el (calculate-c-indent): A line ending in singlequote-colon now does not make the following line be considered a continuation. Fri Nov 7 09:14:29 1986 Chris Hanson (cph at prep) * sort.el (sort-build-lists): Was not initializing point to the beginning of the region. As a result, if one tried to sort a region where point was at the end and mark at the beginning, nothing would happen. Thu Nov 6 19:47:21 1986 Richard M. Stallman (rms at prep) * subr.el (indent-to-column): New alias for indent-to. Thu Nov 6 18:09:10 1986 Leonard H. Tower Jr. (tower at prep) * rnewspost.el Finish bringing posting and followups (mostly) up to the News 2.11 revision of RFC 850 (exceptions noted in rnewspost.el's header). Added function news-reply-yank-original, to be used in lieu of mail-yank-original. Thu Nov 6 12:46:57 1986 Richard M. Stallman (rms at prep) * version.el (emacs-version): Include host name and system type. * rmail.el: rmail-edit-current-message moved from C-r to w. Doc string of rmail-mode changed. * loaddefs.el (auto-mode-alist, completion-ignored-extensions): Ignore ".blg" and ".bbl". Know modes for ".bbl" and ".bib". Rearrange auto-mode-alist with frequently used elts first. * files.el (find-file-noselect): Eliminate incorrect nested or-for-effect within or-for-effect. Bug was it didn't offer to reread a changed file. Wed Nov 5 16:32:31 1986 Leonard H. Tower Jr. (tower at prep) * rnewspost.el (news-reply) Fixed bug when point was outside of header on invocation. Added References: header line per RFC850. Wed Nov 5 12:48:44 1986 Richard M. Stallman (rms at prep) * files.el (file-name-sans-versions): Fix one more typo in name of argument variable. Wed Nov 5 11:01:57 1986 Richard Mlynarik (mly at prep) * mh-e.el: Version 3.4d from Larus Wed Nov 5 10:10:53 1986 Richard M. Stallman (rms at prep) * novice.el (disabled-command-hook): Clean up the message in the case of coming from M-x ... Tue Nov 4 17:55:33 1986 Richard M. Stallman (rms at prep) * various files (dired-mode, Edit-options-mode, rmail-mode, rmail-summary-mode, rmail-edit-mode, Buffer-menu-mode): Give these symbols `special' as a `mode-class' property. * dired.el (dired-mode): Take out local value for default-major-mode. The mode-class property now makes sure new buffers are not made in dired-mode. Tue Nov 4 16:58:49 1986 Leonard H. Tower Jr. (tower at prep) * rnews.el Add several C-C C-F C-letter fields in RFC 850. Tue Nov 4 11:56:46 1986 Richard Mlynarik (mly at prep) * paragraphs.el (various): (interactive "*") needed in some places. Mon Nov 3 23:31:42 1986 Richard M. Stallman (rms at prep) * help.el (variable-at-point): Catch all errors anywhere within. Fixes bug when `C-h v' was done with point after an `('. Sun Nov 2 17:30:54 1986 Richard Mlynarik (mly at prep) * files.el (backup-buffer): "neq" isn't defined -- use /= Sat Nov 1 00:28:14 1986 Richard Mlynarik (mly at prep) * simple.el (open-line): interactive "*" * rmail.el (rmail-variables): rmail-keywords should be buffer-local * undigest.el: Another broken-un*x-mailer-compensation fix from rlk. * file.el (file-name-sans-version): Fix typo in VMS case. Thu Oct 30 20:12:01 1986 Richard Mlynarik (mly at prep) * xscheme.el: defvar scheme-program-name, not defconst * keypad.el (setup-terminal-keypad): Use correct format for indirect keymap entries. Wed Oct 29 19:07:03 1986 Leonard H. Tower Jr. (tower at prep) * rnews.el, rnewspost.el: Created later from parts of former to speed up initial rnews load (also debugging time). Added autoloads as appropriate. The mail and posting commands are most often not used in an rnews session. Wed Oct 29 18:53:37 1986 Richard Mlynarik (mly at prep) * startup.el (command-line): VMS sys$login:.emacs Wed Oct 29 14:13:10 1986 Leonard H. Tower Jr. (tower at prep) * rnews.el (news-inews): Added save-excursion call. Got bury-buffer at right nesting level. Got rid of unneeded code. * rnews.el (news-rotate-buffer-body): Added and modified this function written by paul@media-lab.mit.edu. Bound it to C-c C-r in both news and post-news modes. * rnews.el: Message text cleanup. Wed Oct 29 13:27:26 1986 Richard Mlynarik (mly at prep) * help.el (view-lossage): Use (goto-char (point-min)), not (beginning-of-buffer)) * electric.el (shrink-window-if-larger-than-buffer): New function. Perhaps this should be in subr.el? * tags.el (find-tag): If arg is "" and interactive, put computed tag into command-history so that repeat-complex-command works. * subr.el (momentary-string-display): Avoid losing due to file-locking. * files.el (auto-save-mode): Print a confirming message if interactive. Tue Oct 28 01:12:35 1986 Richard Mlynarik (mly at prep) * undigestify.el: Compensate for broken MH digests * tex-mode.el (TeX-region): Call csh with -f flag * rmail.el (rmail-forward): Use mail, not mail-other-window. Mon Oct 27 14:46:48 1986 Richard Mlynarik (mly at prep) * nroff-mode (electric-nroff-mode): Fix bugs. * electric.el, ebuff-menu.el, echistory.el: Do the `space to flush' before calling Electric-command-loop Delete the space to flush in electric-command-history. * tex-mode.el: defconst -> defvar Sun Oct 26 01:32:14 1986 Richard Mlynarik (mly at prep) * sendmail.el: (provide 'sendmail) * files.el (basic-save-buffer): Set file modes appropriately in file-precious-flag case. Wed Oct 22 18:00:18 1986 Richard Mlynarik (mly at prep) * Rename term/xterm.el => term/X-windows.el * startup.el (command-line): If the variable window-system is non-nil, load (concat term-file-prefix window-system "-windows") rather than (concat term-file-prefix (getenv "TERM")) * files.el (basic-save-buffer): Fix write-file-hooks. * tex-mode.el (TeX-region): Ensure newline before trailer (from gildea) Tue Oct 21 11:39:56 1986 Richard Mlynarik (mly at prep) * rmailedit.el (rmail-cease-edit): Don't add edited attribute unless changes were actually made. * term/xterm.el (x-handle-switch): command-line-args => command-line-args-left (yet again) Mon Oct 20 18:40:23 1986 Richard Mlynarik (mly at prep) * sort.el: Work if (point) > (mark) * vip.el (vi-change-mode-line): Sat Oct 18 17:02:13 1986 Richard Mlynarik (mly at prep) * add-log.el (add-change-log-entry): If file specified is a directory, then use `ChangeLog' in that directory. * sendmail.el (mail-send-and-exit): Don't kill selected-window, if given a prefix arg. * files.el (normal-mode): Don't clobber value of major-mode set by way of default-major-mode. Fri Oct 17 01:06:06 1986 Richard Mlynarik (mly at prep) * help.el, picture.el, simple.el, tags.el, vi.el: Doc/spelling fixes from sjk * rmailsum.el: use new mode-line technology * rmail.el (rmail-reply): Handle resent-reply-to better. Wed Oct 15 16:20:03 1986 Richard Mlynarik (mly at prep) * edt.el: (require 'keypad) * dired.el (dired-mode): Don't lose finding files from dired when default-major-mode is nil. Tue Oct 14 18:08:53 1986 Richard Mlynarik (mly at prep) * texinfmt.el: Support for @include from schaefer%andy.bgsu.edu@CSNET-RELAY.ARPA * dabbrev.el (dabbrev-expand): Give useful error message. Use save-excursion. Allow both symbol-constituent and word-constituent chars in the expansion. * files.el (save-buffers-kill-emacs): Make arg optional. Sun Oct 12 02:26:26 1986 Richard Mlynarik (mly at prep) * macros.el (name-last-kbd-macro): Insert omitted argument in error message. * userlock.el (ask-user-about-lock-help): Improve help message. Sat Oct 11 16:33:51 1986 Richard Mlynarik (mly at prep) * files.el (find-backup-file-name): Call make-backup-file-name rather than appending "~" * lisp-mode.el: Make `|' have `"' syntax for |WeIrD SymbolS| Fri Oct 10 14:21:15 1986 Richard Mlynarik (mly at prep) * edt.el, vi.el: typo. Wed Oct 8 09:56:38 1986 Richard Mlynarik (mly at prep) * bytecomp.el (byte-compile-function-form): Handle "(function symbol)" * sendmail.el (mail-position-on-field): Return nil if field wasn't there and we did add (the non-`soft' case) Tue Oct 7 01:57:31 1986 Richard Mlynarik (mly at prep) * shell.el: Split off shell-set-directory from shell-send-input. * dabbrev.el (dabbrev-expand): Fix bugs. Check whether last-command was a dabbrev-expand. Undo-boundary. Sat Oct 4 14:50:01 1986 Richard Mlynarik (mly at prep) * info.el (Info-find-node): Bug in case of nodename "*" * info.el (Info-search): Hair plus: make search work with split subfiles. Also, push position on node history if searching puts us in a different node. * debug.el (debug): New match-data format. * info.el (Info-goto-node): Adjust to new regexp-register scheme. * info.el (Info-read-subfile): Node delimiter is \n\^_, not just \^_ * texinfmt.el (batch-texinfo-format): Wasn't updated when Info-validate was given a required arg. * informat.el (Info-validate, Info-tagify): Warn that don't know how to hack indirect files. * texinfmt.el, informat.el (batch-{texinfo-format,info-validate}): First elt of command-line-args-left shouldn't be skipped. Thu Oct 2 21:40:50 1986 Richard Mlynarik (mly at prep) * info.el (Info-find-node): Tag-table position match-data was being clobbered by intervening search for "(indirect)" Thu Oct 2 01:59:17 1986 Richard M. Stallman (rms at prep) * texinfmt.el: define @smallbook and @tex ... @end tex. Wed Oct 1 02:02:14 1986 Richard M. Stallman (rms at prep) * lisp.el (lisp-complete-symbol): fix stupid bugs affecting printing completion lists. * loaddefs.el: Improve doc of isearch functions. * texinfmt.el: Define commands chapheading, (sub)*heading to format in the Info file like chapter and (sub)*section. * macros.el (name-last-kbd-macro): Supply (interactive). * macros.el (insert-kbd-macro): Fix a few bugs. Mon Sep 29 00:55:06 1986 Richard M. Stallman (rms at prep) * subr.el (momentary-string-display): Use insert-before-markers to insert the string so that the right cursor position is displayed. Sat Sep 27 04:56:36 1986 Richard M. Stallman (rms at prep) * vip.el: renamed from vi1.el. Many cleanup changes. Entry point is now vip-mode, autoloaded from loaddefs.el. Fri Sep 26 17:47:32 1986 Richard Mlynarik (mly at prep) * files.el (recover-file, find-file-noselect): Add nowarn arg to find-file-noselect, so that recover-file doesn't warn one that one should consider doing m-x recover file. * subr.el (mod): Synonym for "%" * files.el (recover-file): Call expand-file-name. Also, get an error if user specifies an auto-save filename. (Would be able to do something useful if there were a way to get back the original filename from the auto-save filename) Thu Sep 25 18:35:16 1986 Richard M. Stallman (rms at prep) * man.el (manual-entry): If formatted man file name ends in .Z, uncompress it. * macros.el (name-last-kbd-macro): Now in Lisp code and autoloaded. Get an error if name has a definition that's not a kbd macro. Thu Sep 25 01:17:07 1986 Richard Mlynarik (mly at prep) * replace.el (perform-replace): Make ? (as well as C-h) give help for query-replace(-regexp) Wed Sep 24 15:22:37 1986 Richard Mlynarik (mly at prep) * simple.el (set-mark): set-mark is in lisp code now (from editfns.c) * bytecomp.el: Don't compile (mark) specially -- lisp code shouldn't call this function very freqently. * startup.el (command-line-1): (let ((load-path (cons default-directory load-path))) (load ...)) so that the "-load" switch can specify a file relative to $cwd now that $cwd isn't a component of emacs' default load-path. * man.el (manual-entry) HPUX dain bramage. Tue Sep 23 20:02:01 1986 Richard M. Stallman (rms at prep) * help.el: New file containing help commands formerly in simple.el. Installed in loadup.el and ../src/ymakefile. * help.el: Move calls to print-help-return-message inside the with-output-to-temp-buffer constructs. Outside, they saw the window state after displaying the buffer and printed the wrong stuff. * help.el (print-help-return-message): If the help buffer is already visible, do nothing since it is impossible to bring back the old contents of that buffer in this case. If given an argument, apply that argument to the message (and return the result) instead of calling `message' with it. Tue Sep 23 16:17:48 1986 Richard Mlynarik (mly at prep) * files.el (revert-buffer) Pass noconfirm arg to revert-buffer-function dired.el (dired-revert) Ignore extra arg. * tags.el (visit-tags-table-buffer) noconfirm revert-buffer Tue Sep 23 14:33:20 1986 Richard M. Stallman (rms at prep) * rmail.el: Define "x" like "e" for consistency with Dired. * buff-menu.el (Buffer-menu-other-window): New function on "o" command, acts like "o" in Dired. * buff-menu.el (Buffer-menu-this-window): New function on "f" command, acts like "f" in Dired. * buff-menu.el (Buffer-menu-mode): Update doc for these changes and C-d change. * mh-e.el: Version 3.4a from Larus. Tue Sep 23 11:06:41 1986 Richard Mlynarik (mly at prep) * doctor.el: Heroine isn't a drug. * ebuff-menu.el (electric-buffer-list) If no buffers are marked with ">" just select the selected buffer and don't change the window configuration or any other buffers. If more than one buffer is selected, split the screen up between those buffers. Remove after-electric-buffer-menu. "kill" -> "delete" * buff-menu.el Use "D" rather than "K" for buffers to be deleted for consistency with rmail and dired and others. Rename "kill" -> "delete" for both function-names and documentation. Define C-d as Buffer-menu-delete-backwards. (also in ebuff-menu) Save space: Merge buffer-menu-{execute,do-saves,do-kills} Mon Sep 22 15:54:49 1986 Richard M. Stallman (rms at prep) * macros.el (insert-kbd-macro): New function to insert Lisp code to define a kbd macro as it is now defined. * macros.el ({write,append}-kbd-macro): Commands deleted. * loaddef.el: change autoloads for above changes. * simple.el (callers of print-help-return-message): Calling this function is now the last thing done in each caller. Mon Sep 22 13:18:44 1986 Richard Mlynarik (mly at prep) * loaddefs.el Fix some defvars/defconsts whose doc-string didn't start on the same line (yuck). Split some of these into a defvar nil followed by a setq. Sun Sep 21 22:15:02 1986 Richard M. Stallman (rms at prep) * loaddefs.el (auto-mode-alist): Don't use non-saved-text-mode now that it is deleted. Sun Sep 21 15:56:25 1986 Richard Mlynarik (mly at prep) * disassemble.el, fortran.el Use insert-char. * fortran.el (fortran-electric-line-number)): "self-insert-command", not "self-insert" * fortran.el (fortran-window-create): Just bind window-min-width, don't set it. * fortran.el (fortran-abbrev-start): Don't mark buffer as modified after ";?" fortran-abbrev-help -- do "message...done" * files.el (revert-buffer) Check to see if (file-exists-p buffer-auto-save-file-name) even if (recent-auto-save-p) before offering to revert from it. * text-mode.el: Remove non-saved-text-mode * *-mode.el Fix some initializations of syntax-tables so that user can override them. Sun Sep 21 14:54:30 1986 Richard M. Stallman (rms at prep) * files.el (recover-file, list-directory): Don't say /bin/ls; let search path be searched for ls. Sat Sep 20 21:25:01 1986 Richard M. Stallman (rms at prep) * lisp.el (lisp-complete-symbol): New command does completion on a symbol name in the buffer. * fortran.el: New file defining fortran-mode, which is autoloaded from loaddefs. * abbrevlist.el: New file defining list-one-abbrev-table, a function now used by fortran-mode but not Fortran-specific. Fri Sep 19 00:52:07 1986 Richard M. Stallman (rms at prep) * subr.el (momentary-string-display): New function to display a string momentarily in the buffer. * loadup.el: Load loaddefs before simple and files because loaddefs makes more garbage. * loaddefs.el: Include defvar of ctl-x-4-map needed now that this is loaded before files.el. Wed Sep 17 20:55:00 1986 Richard Mlynarik (mly at prep) * hanoi.el Vital improvements Wed Sep 17 12:13:58 1986 Richard M. Stallman (rms at prep) * loaddefs.el: disable C-x p. * loaddefs.el: autoload set-gosmacs-bindings. * gosmacs.el: renamed from gosling.el with many changes (saves old bindings and can restore them as they were). Wed Sep 17 11:02:39 1986 Richard Mlynarik (mly at prep) * replace.el (occur) Use variable list-matching-lines-default-context-lines if no prefix arg specified. If nlines arg is -ve, include that many lines of preceding context, no lines of following context. Use markers instead of line-numbers. In occur-mode-goto-occurrence, warn about deleted buffer. Tue Sep 16 02:07:53 1986 Richard M. Stallman (rms at prep) * simple.el (indent-for-comment): Delete only the spaces before the beginning of the comment starter in case the comment starter contains a leading space. * abbrev.el (edit-abbrevs-map): Define C-c C-c like C-x C-s. * texinfmt.el: define @r as noop. * simple.el (print-help-return-message): New function. Use before doing with-output-to-temp-buffer, and it prints an echo area message about how to restore current screen configuration from the configuration that will obtain after the with-output-to-temp-buffer. * simple.el (describe-{key,mode,function,variable}): * simple.el (view-lossage, command-apropos): Ca;; print-help-return-message. Mon Sep 15 17:49:07 1986 Richard M. Stallman (rms at prep) * sendmail.el (sendmail-send-it): Don't require newline before header-separator; search for regexp and use `^'. * mh-e.el: Version 3.4 from Larus. Uses `interactive' properly to read the arguments. Sun Sep 14 19:44:31 1986 Richard Mlynarik (mly at prep) * files.el (normal-mode) Use shorter error message, so more fits on screen. Sun Sep 14 14:14:35 1986 Richard M. Stallman (rms at prep) * loadup.el: On VMS, dump under name temacs.dump only. * vms-patch.el (make-auto-save-file-name): Append "$" at end as well as "_$" at front. * files.el (cd): Don't do file-name-as-directory on VMS. Sat Sep 13 19:36:01 1986 Richard M. Stallman (rms at prep) * bytecomp.el (byte-compile-file): Don't bomb on defvar with no initial value argument. * texinfmt.el (texinfo-format-buffer): Tagify and maybe even split automatically if buffer is big enough. Non-nil arg inhibits this. * informat.el (Info-tagify): Don't leave buffer narrowed if it wasn't narrowed to start with. * simple.el (comment-column, fill-prefix): Make them buffer-local and fix documentation. * loaddefs.el: make indent-tabs-mode buffer-local. Fri Sep 12 18:37:08 1986 Richard M. Stallman (rms at prep) * dired.el (dired-add-entry): Go to beginning of line before adding the entry. Fri Sep 12 02:36:53 1986 Richard Mlynarik (mly at prep) * mlsupport.el: Define ml-substr (used to be in mocklisp.c) Fri Sep 12 02:07:23 1986 Richard M. Stallman (rms at prep) * time.el: Don't just clobber global-mode-string. Instead, add 'display-time-string as an element and update the time by changing value of that variable. * rmail.el (rmail-mode-1): Change only part of mode-line-format Instead set mode-line-buffer-identification. * rmail.el (rmail-show-message): Use mode-line-process to display the message numbers and labels. Thu Sep 11 18:24:28 1986 Richard Mlynarik (mly at prep) * compile.el (compilation-sentinel) Ignore buffer-read-only. Wed Sep 10 17:40:01 1986 Richard M. Stallman (rms at prep) * picture.el: Convert `Picture' to `picture' in all symbols. * subr.el: Define old names send-string and send-region as aliases for new names process-send-... Tue Sep 9 13:08:12 1986 Richard M. Stallman (rms at prep) * time.el (display-time): variable display-time-interval specifies seconds between updates. * loaddefs.el: Put \-newline in doc strings that lacked it. Mon Sep 8 09:45:01 1986 Richard M. Stallman (rms at prep) * simple.el: Give C-c's keymap a name, mode-specific-map. * options.el (list-options): Use user-variable-p to filter the variables and documentation-property to get the strings. Sat Sep 6 08:52:01 1986 Richard M. Stallman (rms at prep) * tex-mode.el (tex-region): Handle case where specified region extends before header. Thu Sep 4 17:00:05 1986 Leonard H. Tower Jr. (tower at prep) * rnews.el (news-inews) added -h to call of inews to insert all header fields. Thu Sep 4 08:37:49 1986 Richard M. Stallman (rms at prep) * files.el (save-buffers-kill-emacs): Prefix arg means save with no query. * files.el (backup-buffer): Fix uses of % in message about %backup%. Wed Sep 3 12:22:06 1986 Leonard H. Tower Jr. (tower at prep) * rnews.el (news-reply-mode-map) Change mail-x field bindings from C-c x to C-c C-f C-x to agree with sendmail.el . * sendmail.el (mail-mode-map) Change mail-x field bindings from C-c C-f x to C-c C-f C-x to agree with ../etc/NEWS . Mon Sep 1 06:17:17 1986 Richard M. Stallman (rms at prep) * info.el (Info-find-node, Info-read-subfile): Now knows how to deal with indirect info files. * info.el: Info-current-file is now the primary place that records which info file is in the *info* buffer, and it is updated as soon as a new file is correctly read. * info.el: New var Info-current-subfile records which subfile is in the *info* buffer, or is nil for an Info file that doesn't have subfiles or if no subfile read in yet. * informat.el (Info-split): New function to split an Info file into a bunch of subfiles. It edits the original file into an indirect file. * info.el, loaddefs.el: Autoloads for informat.el moved from info.el to loaddefs.el. Sun Aug 31 04:21:17 1986 Richard M. Stallman (rms at prep) * page.el (mark-page): * paragraphs.el (mark-paragraph): * x-mouse.el (x-mouse-set-mark): Use push-mark and inhibit the message, instead of set-mark. * mh-e.el (mh-position-on-field, mh-exec-lib-cmd-output, mh-exec-cmd-output): use push-mark instead of set-mark. * simple.el (push-mark): optional 2nd arg NOMSG inhibits message. * ebuff-menu.el (electric-buffer-list): Was using the mark for internal purposes. Use an anonymous marker instead. * bytecomp.el: Stop using the byte-set-mark opcode. * replace.el (occur): Put the *Occur* buffer in Occur mode. Remember line number of each occurrence in occur-pos-list Occur mode defines C-c C-c as occur-mode-goto-occurrence, which uses that list to move the cursor in the original buffer (which is saved in occur-buffer). * aton.el (occur-menu: File deleted; occur-menu is subsumed by occur. * isearch.el (isearch): repeating the search in either direction must set success to t to produce correct echo area text. * edt.el: New file. Autoloadable entry is edt-emulation-on. * keypad.el (function-key-sequence): New function finds which key sequence leads to a slot in function-keymap. Sat Aug 30 00:31:48 1986 Richard M. Stallman (rms at prep) * files.el (backup-buffer): Use "%backup%~", not "%backup%", if cannot write the backup in the usual place. * sort.el (sort-columns): Sort into reverse order if have prefix arg. Args are now the same as for sort-lines, etc. Thu Aug 28 13:56:56 1986 Richard Mlynarik (mly at prep) * c-mode.el (electric-c-{brace,terminator}) c-indent-line takes no args. Thu Aug 28 01:57:58 1986 Richard M. Stallman (rms at prep) * files.el (backup-buffer): file-precious-flag forces copying. * loaddefs.el: Autoload plain-TeX-mode and LaTeX-mode. Define aliases for them. Fix doc for TeX-mode. Tue Aug 26 14:25:59 1986 Leonard H. Tower Jr. (tower at prep) * rnews.el: Added autoload of rmail-output and bound it to C-o in news-mode-map. Also needed defvar of rmail-last-file. * rmailout.el (rmail-output): Made rmail-mode specific code dependent on rmail-mode being major-mode. Mon Aug 25 03:47:24 1986 Richard M. Stallman (rms at prep) * view.el (view-mode): Bind mode-line-buffer-identification; in new versions don't change mode-line-format. * dired.el (dired-mode): * info.el (Info-set-mode-line): * x-menu.el (x-menu-mode): Don't change mode-line-format. Use mode-line-buffer-identification instead. * ebuff-menu.el (electric-buffer-menu-mode): Likewise, and also copy the mode-line-format and replace `mode-name in it with "Buffers". * info.el (Info-edit): Restore normal mode line by killing the local variables used by Info to change it. * echistory.el (electric-command-history): In newer Emacs versions, don't alter mode-line-format. * compile.el (compile1, compilation-sentinel): * shell.el (shell-mode, inferior-lisp-mode): * xscheme.el (inferior-scheme-mode): * telnet.el (telnet-mode): If minor-mode-alist is bound, put the %s or process status into mode-line-process instead of changing mode-line-format. * sort.el: New file contains buffer-sorting commands. Autoload them in loaddefs.el. * files.el (backup-buffer): Obey new variable backup-by-copying-when-mismatch. * loaddefs.el: Set default-mode-line-format to use the new list and symbol constructs. Define minor-mode-alist. * rnews.el (news-set-minor-modes): Store the string in news-minor-modes, and set minor-modes only if minor-mode-alist is unbound (Emacs versions < 18.16). * rnews.el (news-mode): In newer Emacses, set mode-name so it displays news-minor-mode. * nroff-mode.el (nroff-mode): If minor-mode-alist bound, add an entry for nroff-electric-mode to it, and don't call set-minor-mode. * simple.el (overwrite-mode, auto-fill-mode): * abbrev.el (abbrev-mode): Don't call set-minor-mode. * simple.el (set-minor-mode): Delete this function. * bytecomp.el (byte-compile-file): Put backslash-newline at front of doc string when that is safe. * bytecomp.el (old-file-newer-than-file-p): Deleted this; built-in file-newer-than-file-p is well established. Sun Aug 24 03:11:41 1986 Richard M. Stallman (rms at prep) * term/xterm.el: Install some changes from rlk. -ib switch and InternalBorder default are handled. Set variable x-processed-defaults when defaults are processed. Use require to load x-mouse. Use message to say why suspend-emacs is disabled. * x-mouse.el: Install some changes from rlk. * x-menu.el: New file that handles menus on X window system. * buff-menu.el (buffer-menu): Put point on third line initially (this line describes the buffer that had been selected). * files.el (create-file-buffer): Delete the variable ask-about-buffer-names and simplify this function. Sat Aug 23 14:57:55 1986 Richard M. Stallman (rms at prep) * files.el (basic-save-buffer): When changing visited name, don't try to rename old auto-save file if it does not exist. * c-mode.el (c-indent-command): New definition of TAB, uses c-indent-line as a subroutine. Handling of prefix arg and indenting an entire expression rigidly is now in this fn. * c-mode.el (c-tab-always-indent): If nil, TAB inserts a tab if not in the initial whitespace of the line. * c-mode.el (calculate-c-indent): For statements: if prev line ends in `:', this line is still a continuation if the `:' follows a non-symbol-constituent char. For top level: look at previous line that starts in column 0 to determine whether this line is at top level or in arg decls. Also notice if line is a continuation. * novice.el (disabled-command-hook): If the 'disabled property is a string, include it in the message. Thu Aug 21 14:50:03 1986 Richard M. Stallman (rms at prep) * bytecomp.el (byte-compile-interactive-p): Remove superfluous compilation of 'nil causing stack overflow. * compile.el (compilation-parse-errors): Count lines from the previous error message, not from line 1. Thu Aug 21 10:45:44 1986 Richard Mlynarik (mly at prep) * debug.el (debug, debugger-eval-expression): Evaluate the expression in the context of the buffer current when the debugger was entered. Thu Aug 21 02:15:36 1986 Richard M. Stallman (rms at prep) * files.el (after-find-file): Print no message rather than printing a null message. Wed Aug 20 23:34:04 1986 Richard M. Stallman (rms at prep) * files.el (set-auto-mode): On VMS, turn on case-fold-search while matching auto-mode-alist elements. Wed Aug 20 12:30:45 1986 Richard M. Stallman (rms at prep) * debug.el (debug): Don't try to restore the match data if it refers to a dead buffer. * startup.el (command-line-1): -i FILE or -insert FILE means insert contents of file into buffer. Tue Aug 19 00:05:15 1986 Richard M. Stallman (rms at prep) * simple.el (describe-variable): Use `documentation-property' instead of `get' to get the `variable-documentation' property. * userlock.el: correct spelling "supercession" -> "supersession". * files.el (basic-save-file): If file-precious-flag is non-nil, rename the old file before saving, and if saving fails, rename the old file back. * rmail.el (rmail-get-new-mail): Do not make a backup file if the rmail file was just visited and hasn't been changed aside from reading the new mail. This preserves the old backup file. * rmail.el (rmail-expunge-and-save): New name for rmail-save. * rmail.el (rmail-mode): Turn on file-precious-flag. * dired.el: Define `g' as revert-buffer in dired-mode. * c-mode.el (c-mode): Give `&' and `|' "punctuation" syntax. Mon Aug 18 14:24:55 1986 Richard Mlynarik (mly at prep) * files.el (find-backup-file-name): Don't blow up if (eq version-control 'never) * files.el (set-visited-file-name): Use `buffer-auto-save-file-name' not `auto-save-file-name' which is unbound and unused. Sun Aug 17 18:34:09 1986 Richard M. Stallman (rms at prep) * compile.el (compilation-sentinel): Don't get error if *compilation* has been killed. Include current date/time in message inserted in buffer. Sun Aug 17 15:07:28 1986 Richard Mlynarik (mly at prep) * files.el (basic-save-buffer) Fix paren error Sat Aug 16 19:25:09 1986 Richard M. Stallman (rms at prep) * files.el (find-file-noselect): Change find-file-not-found-hook to find-file-not-found-hooks and make it a list of functions to call until one of them returns non-nil. * files.el (normal-mode, after-find-file): Change find-file-hook to find-file-hooks, a list of functions to call. Call it from after-find-file, not from normal-mode. * files.el (revert-buffer): Restore old point before calling after-find-file. * files.el (basic-save-buffer): Change write-file-hook to write-file-hooks, a list of functions to run until one returns t. In that case, skip writing the file the usual way. * tags.el (visit-tag-table-buffer): Get proper error for empty tag table file; realize that char-after returns nil in that case. Also move error check after auto-revert. Sat Aug 16 19:21:20 1986 Richard Mlynarik (mly at prep) * subr.el Move copy-alist to c code, moved nth from c code. Sat Aug 16 19:11:11 1986 Richard M. Stallman (rms at prep) * files.el (normal-mode): initially call fundamental-mode to reinitialize everything. * files.el (hack-local-variables): Don't consider suffix as including any leading spaces. Sat Aug 16 17:05:41 1986 Richard Mlynarik (mly at prep) * informat.el, texinfmt.el Detect and complain about duplicate node-names Sat Aug 16 16:56:05 1986 Richard M. Stallman (rms at prep) * mh-e.el: 3.3j from Larus. Changes C-c C-g prefix to C-c C-f. Fri Aug 15 16:11:37 1986 Richard M. Stallman (rms at prep) * isearch.el: Default for regexp searches is now search-last-regexp. Rename isearch-slow... vars to search-slow... C-s or C-r in failing search wraps around buffer and tries again. New local var `wrapped' records this has happened. Display `Wrapped' in echo area at such times. Record value of `wrapped' on the search state stack. Display shorter string for incomplete regexps. Incomplete regexp no longer implies "failure" of search. Clean up isearch-search considerably. isearch-message computes message in lower case, then case-converts the first char. * loaddefs.el: New variable search-last-regexp; default string for isearch-regexp. Rename isearch-... vars to search-... * simple.el (next-line, kill-line): * lisp.el (end-of-defun): * picture.el (Picture-clear-line): * replace.el (keep-lines): * indent.el (indent-relative): Use forward-line, not scan-buffer. * fill.el (justify-current-line): Use search-backward not scan-buffer to check whether the line has a space in it. * files.el (set-visited-file-name): Rename the auto-save file if appropriate. (make-auto-save-file-name, auto-save-file-name-p): Auto save file for foo is now #foo#. (make-backup-file-name, backup-file-name-p): New functions, used in appropriate places. * dired.el (dired-flag-backup-files): Use backup-file-name-p. * sendmail.el (mail-mode): Fix documentation of key bindings. Fri Aug 15 14:45:40 1986 Richard Mlynarik (mly at prep) * man.el (manual-entry) Compensate for Sun wankerism. If would be nice if there were something a little more fine-grained than `system-type' for testing for these cases... Fri Aug 15 04:11:01 1986 Richard M. Stallman (rms at prep) * startup.el (command-line): No longer necessary to set ctl-arrow from default-ctl-arrow, etc., after init file is run due to changed behavior of those variables. * info.el (Info-edit): * rmailedit.el (rmail-edit-mode): Change default-mode-line-format to (default-value 'mode-line-format). Thu Aug 14 16:17:20 1986 Richard Mlynarik (mly at prep) * man.el (manual-entry): Speed up `\b'-hacking. Thu Aug 14 01:08:32 1986 Richard M. Stallman (rms at prep) * sendmail.el: Change key bindings. C-c becomes C-c C- or C-c C-f . * mh-e.el (mh-position-on-field): mh-header-end -> mh-goto-header-end. * novice.el (disabled-command-hook): Print only the first paragraph of the command's documentation. [Test this, once new narrow-to-region doc is installed.] * rmailsum.el (rmail-make-basic-summary-line): Don't accept a time zone as a month. Wed Aug 13 02:01:59 1986 Richard M. Stallman (rms at prep) * mh-e.el: New version 3.3i, moving mode-specific commands to C-c prefix. * tex-mode.el: many new features incl. LaTeX mode and some C-c commands. * indent.el (indent-relative): Fix lossage if point to indent under was inside a tab. * bytecomp.el (byte-compile-substring): Fix dumb error. * info.el: Autoload Info-validate. Fix bug in autoload Info-tagify. Tue Aug 12 11:30:53 1986 Richard Mlynarik (mly at prep) * rmailedit.el (rmail-cease-edit, rmail-attributes) Add label (well, `attribute,' really) "edited" to message. * mlsupport.el (auto-execute) Fix from bap@g.cs.cmu.edu Mon Aug 11 10:36:51 1986 Richard Mlynarik (mly at prep) * bytecomp.el (byte-compile-form) Compile references to t and nil as constants rather then variable references. * bytecomp.el (byte-compile-no-args, ..., byte-compile-three-args) If called with wrong-number-of-args, do a normal function call and get an error at runtime. * bytecomp.el (byte-compile-file-form) Process (require ...) at compile-time * informat.el, info.el, loaddefs.el Move Info-validate and friends into new file informat.el Add batch-info-validate * texinfmt.el, loaddefs.el Add batch-texinfo-format * startup.el Add synonym switches "-funcall" "-load" "-user" "-no-init-file" for cryptic "-f" "-l" "-u" "-q" * mlsupport.el Make various turds know that inhibit-command-line has gone. * bytecomp.el (batch-byte-compile), tex-start.el Because of RMS's change "Mon Jul 7 14:01:51 1986" must use variable command-line-args-left rather than command-line-args. Actually, I see no circumstances under which a switch -could- be interested in any command-line-args before the mention of itself, and so think that rebinding command-line-args as appropriate was correct (if perhaps a little confusing to the person who requested that RMS' change be made) Sun Aug 10 08:02:19 1986 Richard Mlynarik (mly at prep) * info.el (Info-validate) re-search for \\*, not * Thu Aug 7 10:24:21 1986 Richard Mlynarik (mly at prep) * rfc822.el, loaddefs.el, mail-utils.el Hairy address parser, used only if mail-use-rfc822 is non-nil (It is nil by default, so if one doesn't like or need the hair of this file, then one is never troubled by it) * disassemble.el, loaddefs.el Code from doug@csli.stanford.edu modified by mly. RMS -- if this is too random to be in the GNU Emacs distribution, please tell me so. * bytecomp.el Compile eql same as eq. Wed Jul 30 22:03:02 1986 Richard M. Stallman (rms at prep) * outline.el (many functions): New variable outline-regexp controls what is a heading line. It must match at the beginning of a line. Length of matched text gives the depth of heading within the tree. * term/xterm.el (x-get-default-args): Process reversevideo option just once. (Twice is noop.) Mon Jul 28 20:24:18 1986 Richard M. Stallman (rms at prep) * term/vt100.el, term/vt200.el: Move (require 'keypad) to top to avoid error. Fri Jul 18 14:26:00 1986 Leonard H. Tower Jr. (tower at prep) * rnews.el: (news-add-news-group) handle unsubscribed groups better * rnews.el: (news-{next,previous}-group) now skip groups with no new messages Thu Jul 17 19:06:59 1986 Richard M. Stallman (rms at prep) * mh-e.el: Install version 3.3h from Larus. Tue Jul 15 17:35:34 1986 Richard M. Stallman (rms at prep) * shell.el (shell-send-input): If get error trying to change directory, call shell-set-directory-error-hook with no args. Sat Jul 12 00:12:37 1986 Richard M. Stallman (rms at prep) * tags.el (list-tags, tags-apropos): Call output buffer *Tags List*. * c-mode.el (calculate-c-indent): Better handling of case where first statement at current level starts on same line as a case..: or label. New local var colon-line-end. Mon Jul 7 14:01:51 1986 Richard M. Stallman (rms at prep) * startup.el (command-line-1): rename argument variable command-line-args to command-line-args-left. Don't rebind command-line-args. Sat Jun 21 01:11:23 1986 Richard M. Stallman (rms at prep) * mh-e.el: Version 3.3g from Larus. Thu Jun 19 12:35:17 1986 Richard M. Stallman (rms at prep) * isearch.el (isearch): Use slow terminal mode only if current window is > 4 times the slow-terminal lines high. Tue Jun 17 05:37:59 1986 Richard M. Stallman (rms at prep) * nroff-mode.el: Add elements to nrofff-brace-table. Mon Jun 16 06:30:54 1986 Richard M. Stallman (rms at prep) * mlconvert.el (convert-mocklisp-buffer): Proper handling of `!' function, via new function ml-not. Proper handling of non-defuns, by putting them inside a dummy defun and calling that function. Sat Jun 14 22:05:58 1986 Richard M. Stallman (rms at prep) * mh-e.el : Install 3.3f from Larus. Thu Jun 12 02:47:11 1986 Richard M. Stallman (rms at prep) * startup.el (command-line): Rename default init file to default.el. Don't look for suffixes on .emacs file. * keypad.el: New file that defines a standard keypad mode. * term/vt*.el: Rewrite completely to use keypad.el. Wed Jun 11 16:43:27 1986 Richard M. Stallman (rms at prep) * abbrev.el (abbrev-prefix-mark): Insert a - at the beginning of the abbrev. expand-abbrev will now delete such -'s. * userlock.el (ask-user-about-supercession): Ask user what to do if he is modifying a buffer whose file is changed on disk. Tue Jun 10 04:54:33 1986 Richard M. Stallman (rms at prep) * rmail.el (rmail-reply): For the in-reply-to, try to get the sender's full name from within parentheses. * outline.el: pervasive changes; new features, changed keys. * files.el (backup-bufer): If cannot write backup under normal name, write it in ~/%backup%. Preserve the last-modified time when backing up by copying. Mon Jun 9 00:00:24 1986 Richard M. Stallman (rms at prep) * rmail.el (rmail-expunge): Preserve point unless expunging the current message. * bytecomp.el (file-newer-than-file-p): Since this is a primitive in version 18, define it only if not defined. Sun Jun 8 09:43:02 1986 Richard M. Stallman (rms at prep) * files.el (load-file, load-library): two new commands. * startup.el (command-line): Eliminate inhibit-command-line since one can just set command-line-args to nil. * term/xterm.el: No need to handle -d switch since main() handles it now. * tags.el: Display name of file being processed. * mh-e.el: Install version 3.3 from Larus. * replace.el, loaddefs.el (perform-replace): perform-replace does not print "done"; its callers do. * startup.el (command-line): Rename file default-profile to .emacs-df; load it always, unless inhibit-default-init is set to t. * telnet.el: Switch to C-c prefix for mode-specific commands. * startup.el (command-line): Use just first word of terminal name to make per-terminal library file name. * loadup.el: Change name of installed docstr file to DOC-mm.nn.oo from DOC.mm.nn.oo. * files.el (file-name-sans-versions): New system-dependent function to remove backup or version suffixes from filename. Sat Jun 7 16:04:07 1986 Richard M. Stallman (rms at prep) * c-mode.el (electric-c-terminator): Check for point being inside a multi-line string or comment and do nothing. For colon, check for more than one word before it on the line (with first one not "case") and do nothing. * c-mode.el: Don't rebind Linefeed. * c-mode.el (calculate-c-indent): If previous line ends in ") {", skip back to matching "(" and use that line's indentation as the brace's column. Fri Jun 6 00:12:48 1986 Richard M. Stallman (rms at prep) * nroff-mode.el (nroff-comment-indent, nroff-mode): Define a comment syntax. Install comment-indenter as supplied by gildea, but change it not to use insert-before-markers, to avoid display anomalies. * files.el (find-file-noselect): Tell revert-buffer not to query. * files.el (revert-buffer): Second arg non-nil means no query. * files.el (after-find-file): Warn if auto-save file exists and is newer than the file visited. * files.el (find-alternate-file): Allow replacing a non-file buffer, as long as not modified. * files.el (recover-file): Initially show a directory listing of real and auto-save files. Only find the file if user says yes. Print better messages. * simple.el (goto-line): Use new interactive code N. * subr.el (substitute-key-definition): New function. Replaces all bindings to one function in one map with another function. * xterm.el: Use substitute-key-definition to get rid of keys that do suspend-emacs. Thu Jun 5 00:25:52 1986 Richard M. Stallman (rms at prep) * simple.el (fundamental-mode): Provide a fundamental-mode-map in case user does local-set-key. * picture.el (picture-mode): New key bindings for setting insert motion direction: C-c <, C-c >, C-c ^ and C-c . instead of M- chars. * rmail.el (rmail-reply): When putting From into In-reply-to, stop at any newline. * mail-utils.el (mail-strip-quoted-names): Consider newlines like other whitespace for <...> hacks. * bytecomp.el (byte-compile-cond{,-1}): Handling of singleton clauses that are not last. Handling of cond with no clauses. * startup.el (command-line): Switch to *scratch* before running initial-major-mode, and do this only if *scratch* exists. * compare-w.el: Simplify the handling of `size': always reduce size not to exceed the amount of space left in either buffer. Wed Jun 4 21:44:40 1986 Richard M. Stallman (rms at prep) * man.el (manual-entry): Use new variables manual-program, manual-formatted-dir-prefix and manual-formatted-dirlist, defined in paths.el. * time.el (display-time): Don't expand-file-name of "loadst". Let start-process search the exec-path for it. * texinfmt.el (texinfo-discard-line): Allow and discard spaces at end of line. * texinfo.el: Split most of this into new file texinfmt.el. * replace.el (perform-replace): Bind help-form only while the read-char is done; don't interfere with recursive edits. Thu May 29 19:05:19 1986 Richard M. Stallman (rms at prep) * info.el (Info-validate): If file is valid, erase the buffer of problems found previously. Non-re search was used by mistake to search for regexps; fix. * nroff-mode.el (electric-nroff-newline): Leave point between the open-directive and the close-directive, as it was supposed to do. Add some directive-pairs to nroff-brace-table. Wed May 28 03:56:04 1986 Richard M. Stallman (rms at prep) * telnet.el (telnet-initial-filter): If host nonexistent, kill the telnet buffer and get error. Sun May 25 20:00:21 1986 Richard M. Stallman (rms at prep) * rmail.el (rmail-search): Don't find a match in the current message. Mon May 19 22:11:52 1986 Richard M. Stallman (rms at prep) * mh-e.el (mh-get-new-mail): Handle error messages reeived from `inc'. Thu May 15 18:35:25 1986 Richard M. Stallman (rms at prep) * files.el (save-buffer): Switch meanings of one-C-u and two-C-u in the code, so they match the documentation. See ChangeLog.1 for earlier changes. emacs-19.30/lisp/ChangeLog.3100666 12120 1 1641212 5523315252 14061 0ustar rmsdaemonSun May 30 00:15:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.10 released. Sat May 29 00:40:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/bobcat.el: Just load term/keyswap.el. * term/vt200.el: Just load term/vt100.el. * term/apollo.el: Just load term/vt100.el. * term/vt102.el, term/vt125.el, term/vt201.el, term/vt220.el, term/vt240.el, term/vt300.el, term/vt320.el, term/vt400.el, term/vt420.el: New files. Just load vt100.el. * term/lk201.el: New file. * term/vt100.el: Use term/lk201.el. * term/vt100.el (vt100-wide-mode): Add missing arg in set-frame-width. Sat May 29 00:33:39 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * startup.el (command-line-1): Pass arg to other-window. * files.el (find-file-run-dired): Doc fix. (find-file-read-only): Return the buffer. (find-file-read-only-other-window): Likewise. (find-file-read-only-other-frame): Likewise. * timer.el (cancel-function-timers): Renamed from spurious duplicate definition of cancel-timer. * add-log.el (find-change-log): Use file-chase-links. * files.el (file-chase-links): New function. (backup-buffer): Use file-chase-links. (file-chase-links): Handle leading .. in symlink target. * c-mode.el (c-up-conditional): Handle commented-out #-cmds properly. * window.el (split-window-vertically): Return the new window. * paths.el (gnus-local-organization): Initially nil. * isearch.el (isearch-search): Take note of isearch-case-fold-search initial value. * lisp-mode.el (indent-sexp): Even if outer-loop-done is t, still move down one line. * files.el (auto-mode-alist): Fix syntax for sgml mode. * man.el (Man-mode-map): Bind m to manual-entry. (Man-notify-when-ready): Make arg name consistent. Use delete-other-window. (Man-mode): Use buffer-disable-undo, not old name. * faces.el (x-resolve-font-name): Allow symbol as FACE arg. Allow t as FRAME arg. * sendmail.el (send-mail-function): Use defvar. not defconst. * mouse.el (x-fixed-font-alist): Specify field 7, not field 6. Fri May 28 00:43:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * iso8859-1.el: File deleted. * superyank.el: File deleted. * vc.el (vc-steal-lock, vc-insert-headers): Fix question whitespace. (vc-finish-logentry): Use delete-windows-on. * add-log.el (find-log-file): Use source file's truename dir. * mh-e.el: Version 3.8.1 from Gildea. * loaddefs.el (-key): repeat-complex-command moved to C-x ESC ESC. * hexl.el: Doc fixes. (hexl-char-after-point): Get rid of mistakenly free variables. * info.el (Info-insert-dir): Ignore duplicate directories. * paths.el (Info-default-directory-list): Take out ../../info. Avoid duplication. (manual-formatted-dirlist, manual-formatted-dir-prefix): Deleted. * subr.el (baud-rate): Doc fix. * add-log.el (find-change-log): Chase symlinks multiple levels. * rmailsum.el (rmail-new-summary): Set rmail-summary-buffer to nil at beginning; set it for real after summary is set up. Thu May 27 20:58:51 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (find-alternate-file): Hide truename and inode number temporarily, like the visited file name. * iso8859-1.el: Pass just the downcase table to set-case-... Thu May 28 20:58:08 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * find-dired.el (find-dired-sentinel): Write a line describing death. Set mode-line-process to record exit status. Delete the process. Thu May 27 08:43:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.el (frame-initialize): Handle reverseVideo resource. * faces.el (x-create-frame-with-faces): Handle reverseVideo resource. * iso-insert.el, iso-ascii.el, iso-swed.el: Provide same name as file. * ange-ftp.el (ange-ftp-dired-compress-file): Use dired-compress-file, not dired-compress-filename. * completion.el: Pervasive changes to use Emacs 19 features and conform to Emacs conventions. Thu May 27 02:35:32 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.9 released. Thu May 27 01:37:30 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * term/x-win.el: Check for a geometry resource, and apply it to the initial frame. Wed May 26 23:32:25 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * isearch.el (isearch-forward): Remove the claim that isearch-whitespace-chars matches any string of whitespace. Wed May 26 16:26:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * completion.el: Comment out handling of shell-send-input. Delete the "local thinking machines" definitions at the end since they caused compilation failure. * cl.el (cl-member): Renamed from member. * time.el (display-time-day-and-date): Use defvar, not defconst. * subr.el (listify-key-sequence): Avoid the constant ?\M-\200. * files.el (find-file-noselect): Expand buffer-file-truename before copying it to anything else. * dired.el (dired-other-frame): New function, with binding. * compile.el: Make C-x ` binding just once. * help.el (finder-by-keyword): Autoload from `finder', not `finder.el'. * nroff-mode.el (nroff-mode): Don't leave nroff-electric-mode void. * byte-opt.el (byte-optimize-divide): Don't optimize to less than two arguments. * hexl.el (hexlify-command, dehexlify-command): Use exec-directory. * rmailsort.el: New version from Umeda. (timezone-make-date-sortable): Make autoload for this. (rmail-sort-by-recipient): Downcase the strings for sorting. (rmail-sort-by-recipient): Likewise. (rmail-sort-by-lines): Renamed from rmail-sort-by-size-lines. Use numbers to sort by. (rmail-summary-...): New functions. Bind in rmail-summary-mode-map. (rmail-sort-from-summary): New function. (rmail-sort-messages): Don't bother checking major mode. Put message bounds in sort list, not its text. Choose string< or < as predicate. Reorder messages by exchanging them, with inhibit-quit bound. (rmail-fetch-field): Start by widening. (rmail-sortable-date-strng): Deleted. (rmail-make-date-sortable): New function, used instead. * paths.el (gnus-local-organization): Renamed from ...-your-... (gnus-local-domain): Likewise. Wed May 26 02:49:13 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * faces.el (x-resolve-font-name): If PATTERN is nil, return the frame's face. (set-face-font): Only use x-resolve-font-name if FONT is a string. Copying a faces shouldn't resolve the font. * paths.el (Info-default-directory-list): Add configure-info-directory to this list. Wed May 26 00:18:13 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * scroll-bar.el (scroll-bar-mode): Make default value t. * help-macro.el (make-help-screen): Handle mouse events. Be smart about window configurations--when and whether to restore. * info.el (Info-follow-nearest-node): Omit 4th arg to Info-get-token. * sgml-mode.el (sgml-validate): compile1 renamed to compile-internal. (sgml-mode): Add autoload cookie. * files.el (auto-mode-alist): Recognize .sgm, .sgml, .dtd. * files.el (auto-mode-alist): Treat .H and .hh as C++ files. * mouse.el (mouse-set-mark): Activate the mark. Don't bounce the cursor if Transient Mark mode. (mouse-save-then-kill): Pass explicit args to kill-ring-save. (mouse-kill-ring-save): Likewise. * mail-utils.el (mail-strip-quoted-names): Catch errors from forward-sexp. * comint.el (comint-filter): Restore buffer-read-only in proper buffer. * ispell.el: Provide `ispell'. * ange-ftp.el (ange-ftp-set-buffer-mode): Do nothing unless visited name is an ange ftp magic name. * advice.el: New version from Chalupsky. Tue May 25 11:47:35 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired.el (dired-unmark-all-files): Read arg as a string. * rmailsum.el (rmail-summary-mark-deleted): Check for end of buffer. Pass t as NOWARN when calling rmail-summary-goto-msg. * dired-aux.el (dired-compress-file): Test the return value of dired-check-process properly. Fix use of nonexistent var `name'. * info.el (Info-edit, Info-last-search, Info-enable-edit): Correct case in `Info-mode-map'. * rmail.el (rmail-bury): Fix call to set-window-buffer. * loaddefs.el: copy-to-register now on C-x r s. Tue May 25 11:06:28 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el: Pass x-command-line-resources to x-open-connection. (x-command-line-resources): New variable. (x-handle-rn-switch): New function. (command-switch-alist): Add -rn. Tue May 25 06:26:51 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * term/x-win.el (command-switch-alist, x-switch-definitions): Treat `-i' like `-itype', as in Emacs 18. Tue May 25 05:15:14 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.8 released. * startup.el (command-line-1): Don't handle `-i'. We're abandoning the `insert file' meaning in favor of the `use a bitmapped icon' meaning. * faces.el (set-face-font): Call x-resolve-font-name on the font before including it in the face. (x-resolve-font-name): New function. * iso-syntax.el: Make downcase into a proper case table before passing it to set-standard-case-table. * disp-table.el (standard-display-european): Doc fix. Make it autoload. Make it respond to prefix arg like a minor mode. Mon May 24 17:17:02 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el (x-select-text): New arg PUSH. (x-switch-definitions): Represent -r as `reverse' option. Mon May 24 17:16:41 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (find-file-read-only-other-window): Use find-file-other-window. * paths.el (Info-default-directory-list): Add ../../info. * info.el (Info-suffix-list): Fix duplicate .z to .info.z. * faces.el (x-create-frame-with-faces): Handle `reverse' as parameter. * frame.el (frame-initialize): Likewise. * dired.el (dired-flag-backup-files): Speedup: check explicitly for ~ at end of line. (dired-flag-auto-save-files): Similar change. * register.el (jump-to-register): Don't fail if frame-configuration-p is unbound. * files.el (cd): Set cd-path to a list. * simple.el (kill-new): Pass t as 2nd arg to interprogram-cut-function. * select.el (x-set-cut-buffer): New arg PUSH. Mon May 24 12:14:41 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * disp-table.el (standard-display-default): New function. (standard-display-european): New command. * loaddefs.el: Bind [?\M-\C-\ ] to mark-sexp. Mon May 24 14:44:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (shell-command): Don't activate mark even momentarily. Mon May 24 03:54:44 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * case-table.el, disp-table.el, finder.el, iso-ascii.el, iso-insert.el, iso-swed.el, iso-syntax.el, iso8859-1.el, swedish.el: Change "i14n" keyword to "i18n". * finder.el (finder-compile-keywords): Replacement unnecessary. Mon May 24 01:06:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * menu-bar.el (menu-bar-mode): Doc fix. Sun May 23 21:58:38 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * lucid.el (switch-to-other-buffer): Build the list of acceptable buffers properly. * faces.el (make-face): Change interactive spec to 'S'. Sun May 23 18:44:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ange-ftp.el (ange-ftp-raw-send-cmd): Allow quitting during accept-process-output. * finder.el (finder-known-keywords): Use i18n, not i14n. (finder-compile-keywords): Substitute i18n for i14n. Turn off undo in *finder-scratch*. Ignore file names starting with =. (finder-mode, finder-current-item): Rename headmark to finder-headmark. (finder-list-matches, finder-list-keywords): Likewise. * iso8859-1.el: Call set-case-..., not standard-case-... Sun May 23 18:56:04 1993 Paul Eggert (eggert@twinsun.com) * calendar.el (calendar-daylight-savings-starts, calendar-daylight-savings-ends): Default to nil if the locale never has DST. Sat May 22 19:37:01 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.7 released. Sat May 22 18:33:19 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * vc.el (vc-comment-to-change-log): Don't take FILE argument, since vc-update-change-log doesn't support it anyway. Don't bind default-directory. Instead pass second arg to file-relative-name. (vc-update-change-log): Use find-change-log instead of hardcoding. Sat May 22 18:08:08 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * cl.el (cl-floor, cl-ceiling, cl-truncate, cl-round): Renamed from floor, ceiling, truncate, and round; the old names conflict with built-in functions. Sat May 22 14:00:33 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gud.el (gud-def): Fix inclusion of the define-key. (gdb, sdb, dbx): Change bindings from letters to control chars. (gud-common-init): Add save-excursion. (gud-display-line): Don't mess with buffer-read-only. (gud-filter): Set output-after-point *after* deleting old prompt. Likewise for `moving'. * subr.el (event-modifiers): Doc fix. * help.el (describe-key, describe-key-briefly): Discard the click or drag that follows a down event. * levents.el (event-modifiers): Function deleted. (read-command-event): For switch-frame event, call select-frame. Sat May 22 01:53:26 1993 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * rlogin.el (rlogin-filter): Yet another rewrite which handles unusual values of scroll-step in a winning way by window-start frobnication. Sat May 22 00:18:56 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (pending-undo-list): Var declared. * apropos.el (apropos-print-matches): Bind tem. Fri May 21 18:54:24 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * holidays.el: Update reference to the papers in S-P&E. (filter-visible-calendar-holidays): Test for nil date. * cal-mayan.el: Update reference to the papers in S-P&E. * cal-french.el: Update reference to the papers in S-P&E. Fri May 21 12:37:20 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * apropos.el (apropos-match-keys): Handle modern keymap structure. * simple.el (transient-mark-mode): Doc fix. * outline.el (outline-minor-mode): Make permanent local in all buffers. Give the command a doc string, and make it autoload. * lisp-mode.el (lisp-body-indent): Add doc. Thu May 20 09:57:37 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * texinfo.el (texinfo-section-types-regexp): Define here. * delsel.el: Provide delsel. (keyboard-quit): Definition deleted. (minibuffer-keyboard-quit): If Delete Selection mode is off, do abort even if mark is active. Wed May 19 15:48:21 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) Some time-handling patches from Paul Eggert: * calendar.el (calendar-current-time-zone): New function. (calendar-time-zone, calendar-standard-time-zone-name, calendar-daylight-time-zone-name): Use it instead of current-time-zone. * sendmail.el (mail-do-fcc): Use the same absolute time for both current-time-string and current-time-zone. Adjust to new format returned by current-time-zone. * xfaces.el (face-equal): Doc fix. Wed May 19 12:01:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * delsel.el: Renamed from pending-del.el. Functions and variables renamed to ...delete-selection... from ...pending-delete... Bind all minibuffer keymaps alike. * outline.el (outline-heading-end-regexp): Fix typo. (outline-minor-mode-map): New variable. (minor-mode-map-alist): Add new entry. (outline-minor-mode): Work with above change. Do not set outline-regexp or outline-header-end-regexp. Wed May 19 08:24:52 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (hebrew-calendar-yahrzeit): Correct error from S-P&E paper in test for Adar I 30 date of death for yahrzeit in a non-leap year when Shevat 29 must be used. Wed May 19 02:02:10 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * files.el (set-auto-mode): If the buffer's file name is nil, don't try to compare it against the entries in auto-mode-alist. Wed May 19 00:06:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ispell.el (ispell-command-loop): Make an undo boundary. * isearch.el (isearch-mode-map): Use vector, not string, to bind printing characters. Tue May 18 19:21:59 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * select.el (xselect-convert-to-class): Just return "Emacs" here. That's what the class will always be. Tue May 18 18:28:06 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * loaddefs.el: Add bindings for C-SPC and C-/, like C-@ and C-_. Tue May 18 17:14:27 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * startup.el (normal-top-level, command-line, command-line-1): Don't call the frame and face initialization functions unless they're bound. * frame.el (frame-notice-user-settings): Don't make frame-initial-frame unbound; just set it to nil. * startup.el (command-line-1): Call frame-notice-user-settings before displaying the startup message. * server.el (server-switch-hook): New hook. (server-process-filter): Call it. * bibtex.el (bibtex-string): Use \" instead of "" to get a double quote inside a string. * vms-patch.el (print-region-function): Same. Tue May 18 11:45:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-yank-original): In Transient Mark mode, don't get error and don't activate the mark. * isearch.el (isearch-mode-map): Extend the dense keymap to 256 chars. Mon May 17 00:42:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * trace.el, advice.el: New files. * bytecomp.el (byte-compile-file): Don't write output if error. * sendmail.el (mail-setup): Leave point before signature, not after. * rmailsort.el (rmail-sortable-date-string): Handle date in format produced by current-time-string. * simple.el (keyboard-quit): Run deactivate-mark-hook. (kill-ring-save): If quit happens while cursor is bounced, make it appear like a command-level quit. * loaddefs.el: Add bindings for C-digits, C-M-digits, C-- and C-M--. * isearch.el (isearch-mode): Set deactivate-mark. * menu-bar.el (fill-region, kill-region, delete-region) (kill-ring-save): Use mark-active as enable condition. (undo): Add an enable condition. Sun May 16 23:37:21 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * texinfo.el (texinfo-chapter-level-regexp): Copied here. Mon May 17 02:42:16 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * gnus.el (gnus-info-directory): Variable removed. (gnus-info-find-node): Don't use it. Sun May 16 22:40:14 1993 Richard Stallman (rms@geech.gnu.ai.mit.edu) * gnus.el, gnuspost.el, gnusmail.el, gnusmisc.el * nntp.el, nnspool.el, mhspool.el: Version 3.15 from Umeda. * frame.el (toggle-scroll-bar): Renamed from toggle-vertical-scroll... Sun May 16 09:19:32 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * texinfo.el: Don't require tex-mode or texnfo-upd. (texinfo-mode-map): Binding for " deleted. (texinfo-tex-print): Require tex-mode here. (texinfo-tex-region): Likewise. (texinfo-tex-region): Update name of tex-set-buffer-directory. * tex-mode.el (tex-insert-quote): Doc fix. * vc.el: Don't require sendmail, compile, or dired. * simple.el (push-mark): Always activate the mark if not in Transient Mark mode. * c-mode.el (mark-c-function): Activate the mark. * ispell.el (ispell): Deactivate mark before the Ispell run. (ispell-point): Delete the sit-for; it was confusing. (ispell): Don't use save-excursion; just restore current buffer. (ispell-next): Don't save-excursion or save-window-excursion. (ispell-point): Don't save-excursion. (ispell-window-configuration): New variable. (ispell-show-choices): Set it if not nil. (ispell-next): Initialize to nil. Restore at end. * simple.el (yank, yank-pop): Don't activate the mark. * lisp.el (mark-sexp, mark-defun): Activate the mark. * page.el (mark-page): Activate the mark. * paragraphs.el (mark-paragraph, mark-end-of-sentence): Likewise. * simple.el (mark-whole-buffer, mark-word): Activate the mark. (push-mark): Optional arg ACTIVATE. (set-mark-command): Use that. * faces.el (face-initialize): Do make the modeline face. (x-initialize-frame-faces): Explicitly invert `modeline' face. (x-create-frame-with-faces): Simplify; do nothing special with `default' or `modeline' face. Sat May 15 22:09:19 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * version.el (emacs-version): Alpha release 19.6. Sat May 15 12:52:36 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * faces.el: Rename `primary-selection' to `region'. * mouse.el (mouse-set-region): Call set-mark to activate mark. * isearch.el (isearch-done): Don't activate mark. * simple.el (push-mark): Don't activate the mark. (set-mark-command): Explicitly do so here. When popping, don't mind if mark is inactive. (pop-mark): Deactivate mark. Don't mind if it's inactive. (yank-pop): Don't mind if mark is inactive. (keyboard-quit): Deactivate the mark. (kill-ring-save): When bouncing cursor, bounce the mark too, so highlighted area does not change. * bytecomp.el (byte-compile-track-mouse): New function. This is a kludge; track-mouse must be compiled better. * simple.el (transient-mark-mode): New command. * mouse.el (mouse-drag-region): New command, on down-mouse-1. * map-ynp.el (map-y-or-n-p): Show the answers in the echo area. * faces.el (face-initialize): Turn off `modeline' face. Set region-face. (invert-face): Really do use the default colors. (x-initialize-frame-faces): Always try "gray" color for primary-selection; always invert if that fails. Similar changes for highlight, secondary-selection. * menu-bar.el: Fix up the edit commands. Add fill-region. Fri May 14 11:46:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * menu-bar.el (menu-bar-mode): New command. Use for initialization. * faces.el (make-face): Add interactive spec. (set-default-font): Deleted. * isearch.el (isearch-mode-map): Handle any length vector in keymap. (isearch-char-to-string): Handle non-character events properly. Fri May 14 11:21:22 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * subr.el (overlay-start, overlay-end, overlay-buffer): Removed. * vc.el (vc-version-diff): Match parens. Fri May 14 03:29:31 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-revert-buffer1): Don't assume that compilation-error-list is a list; it might be t. Thu May 13 12:53:28 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emerge.el: Installed version 5 from drw. Merged in previous FSF changes, plus new changes: (emerge-count-matches-string): Renamed from count-matches-string. (emerge-command-prefix): Now C-c C-c. (emerge-shadow-key-definition): Deleted. Callers use substitute-key-definition. (emerge-recursively-substitute-key-definition): Deleted. Callers use substitute-key-definition. (emerge-unselect-hook): Renamed from emerge-unselect-hooks. (emerge-files-internal): Use file-local-copy to handle remote files. (emerge-files-with-ancestor-internal): Likewise. (emerge-remote-file-p): Deleted. (emerge-abort): New command. (describe-mode): Deleted. (emerge-hash-string-into-string): Renamed from hash-string-into-string. (emerge-unslashify-name): Renamed from unslashify-name. (emerge-write-and-delete): Don't write-file if file-out is nil. (emerge-setup-fixed-keymaps): Put emerge-abort on C-]. (emerge-find-difference-diff): Renamed from emerge-find-difference. (emerge-find-difference): New command. Now on `.'. (emerge-diff-ok-lines-regexp): Renamed from emerge-diff-ok-lines. (emerge-diff3-ok-lines-regexp): Renamed from emerge-diff3-ok-lines. Thu May 13 05:48:19 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-version-diff): Don't move point in current buffer. Thu May 13 05:28:14 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * etags.el (tags-table-including): Take new third arg CORE-ONLY. If non-nil, ignore files without extant buffers. (visit-tags-table-buffer): Call tags-table-including first with CORE-ONLY set, and then afterwards with it clear. Wed May 12 12:13:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el: Require menu-bar.el. * menu-bar.el: Provide 'menu-bar. * compile.el (Setting minor-mode-map-alist): Put the map directly in the alist, not a variable name. * vc.el: Likewise. * macros.el (kbd-macro-query): Fix prompt string. * loadup.el: Preload mouse, scroll-bar and select if have multi-frames. * vc.el: Improve doc strings and prompt strings. (vc-cancel-version): Ask whether to revert buffer. * lmenu.el (default-menubar): Make initial value nil. (kill-this-buffer, x-new-frame) (sensitize-file-and-edit-menus-hook, format-buffers-menu-line) (buffers-menu-max-size, complex-buffers-menu-p) (buffers-menu-switch-to-buffer-function, buffer-menu-save-buffer) (buffer-menu-write-file, build-buffers-menu-internal) (build-buffers-menu-hook): Functions and variables deleted. * faces.el (face-initialize): New function. All initialization code moved into it. Call at end of file, if using X frames already. (x-create-frame-with-faces): Don't use faces if not initialized. * startup.el (command-line): Call frame-initialize explicitly. Call face-initialize. (normal-top-level): Call frame-notice-user-settings explicitly. * frame.el: Do not put those functions on hooks. * terminal.el (te-pass-through): Handle meta chars and non-char events. (terminal-map, etc.): Use default bindings, not fillarray. Make the maps sparse. (terminal-meta-map): New map; lets us make ESC a prefix key. (terminal-map): Bind ESC to terminal-meta-map. (te-more-break-unread): Handle non-char as last-input-char. (te-filter): Delete code that worked with meta-flag. (terminal-emulator): Don't look at meta-flag. (terminal-mode): Don't make meta-flag local. (te-stty-string): Quote the args that have ^. Add pass8. Sat May 8 00:55:11 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-diff): Report an error if the buffer isn't registered. (vc-registration-error): New function. (vc-next-action, vc-diff, vc-print-log, vc-backend-diff): Use it to make VC's error messages more uniform. * vc.el (vc-directory, vc-revert-buffer1): Quote lambdas with (function ...) for Emacs 18. (compilation-old-error-list): Set if undefined, for Emacs 18. Tue May 11 15:15:05 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * faces.el: Re-arranged to put accessors at the top. Mon May 10 12:16:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buff-menu.el (Buffer-menu-quit): New function, now on q. (buffer-menu): Update list of options. Don't save a window config. (Buffer-menu-select): Don't call Buffer-menu-execute. Don't restore a window config. (Buffer-menu-mode-map): Buffer-menu-select now on v. Mon May 10 00:49:06 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * bytecomp.el (byte-recompile-directory): If ARG is non-nil, set it to its prefix numeric value. Test for ARG being zero with eq, not zerop. Sun May 9 19:38:38 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmailout.el (rmail-output): Undo June 11 1992 change: Don't try to use Date field in the From. * faces.el: Rename all references to try-face-font to internal-try-face-font, so we don't need lucid.el. * faces.el (read-face-name): Call face-list, not list-faces. Fail more gracefully if we can't build bold, italic, etc, versions of the default font. * faces.el (make-face-bold, make-face-italic, make-face-bold-italic, make-face-unbold, make-face-unitalic): Implement NOERROR argument. (x-initialize-frame-faces): Use the NOERROR argument to the font manipulation functions to avoid errors while starting up. Remove initialization of isearch font. * xfaces.c (internal-x-complain-about-font): Add new frame argument, so we can check the frame parameters to find the default font. Callers changed. * faces.el (x-create-frame-with-faces): Fix typo. Dyke out code to fully qualify the modeline font; we may not be able to do that correctly. Sun May 9 19:17:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dabbrev.el (dabbrev-expand): Delete a search-forward call after the second replace-match. Sun May 9 23:16:19 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * add-log.el (find-change-log): If there is a buffer-local value of change-log-default-name, just return it with no searching. Previously if it was set to a nonexistent file name, we would loop forever. Sun May 9 01:30:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * replace.el (query-replace-map): Bind [escape] like "\e". * macros.el (kbd-macro-query): Use query-replace-map to define answers. * vc.el (diff-switches): Define var here as well as in diff.el. (vc-backend-diff): Handle either string or list. * comint.el (comint-filter): Increment opoint only if after insertion point. Sat May 8 23:15:07 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * faces.el: Call internal-set-face-1, not internat-set-face-1. * faces.el: Don't set frame-creation-function here; term/x-win.el is the appropriate place to set it. * faces.el: Only apply x-initialize-frame-faces to X frames; pass over terminal frames. * faces.el: Provide 'faces. Sat May 8 22:42:26 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * term/x-win.el: Since we require faces.el, there's no point in setting frame-creation-function to x-create-frame - just set it directly to x-create-frame-with-faces. Sat May 8 12:45:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-do-fcc): Don't output a newline before From... * rmail.el (rmail-convert-to-babyl-format): Delete 1 char if we see a newline instead of what we expect. * register.el (jump-to-register): Allow file name "in" a register. * scroll-bar.el (scroll-bar-drag, scroll-bar-drag-1): New functions. Put scroll-bar-drag on down-mouse-2 in scroll bar. Leave up-events on mouse-2 unbound. * help-macro.el: Provide help-macro, not help-screen. * help.el: Require help-macro, not help-screen. * menu-bar.el: Don't add menu bar to minibuffer-only frames. Fri May 7 22:47:43 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-directory-18): New function. If Emacs 18, make vc-directory alias to this. Fri May 7 12:50:35 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * loaddefs.el: Bind M-right and M-left to forward-word, backward-word. Unbind M-up and M-down. * calendar.el (calendar-mode-map): Add arrow key bindings. * rmail.el (rmail-resend): Add `resent' attribute. (rmail-forward): With prefix arg, run rmail-resend. Fri May 7 03:02:55 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * term/x-win.el: (require 'faces), too. Move (require 'select) to top, with the other requires. Thu May 6 13:13:10 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * finder.el: Bind finder-exit to 'q', not 'x'; the former is the conventional way to get out of such a package. (finder-summary): Use substitute-command-keys. (finder-mode): Use \\<...> to make sure we get the right keymap. Thu May 6 10:28:04 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * replace.el (flush-lines, keep-lines, how-many): Delete spurious `s' from prompt arg to read-from-minibuffer. * comint.el (comint-filter): New function. (comint-exec): Install the filter. * simple.el (previous-matching-history-element): If minibuf is empty, use the last regexp specified a the default. (next-matching-history-element): Likewise. * comint.el (comint-previous-matching-input): New command, on M-r. (comint-next-matching-input): New command, on M-s. (comint-previous-similar-input): Commented out. (comint-next-similar-input): Likewise. (comint-previous-input-matching): Deleted. (comint-last-input-match): Var commented out. (comint-mode): Don't make comint-last-input-match local. Wed May 5 14:11:45 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (auto-mode-alist): Delete the entries for makefile-mode. * asm-mode.el: Doc fix. * man.el: Rename functions and variables `man-*' to `Man-*'. (manual-entry): Make prompt string clearer. * simple.el (blink-matching-paren-distance): Change default to 12,000. Tue May 4 12:42:19 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc.el (minor-mode-map-alist): Don't use it if it's void. (vc-cancel-version): Doc fix. (vc-backend-diff): Use diff-switches, not vc-diff-options. (vc-diff-options): Variable deleted. Mon May 3 12:52:03 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el: Update reference to the papers in S-P&E. (calendar-print-astro-day-number): Correct spelling error in message string. Mon May 3 11:00:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * help.el (help-for-help): Use lower case letters for help options. * rect.el (string-rectangle): Renamed from fill-rectangle. (string-rectangle-line): Renamed from fill-rectangle-line. Sat May 1 10:53:35 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc.el (vc-dired-prefix-map): New keymap. Use it in minor-mode-map-alist for vc-dired-mode. * vc-hooks.el (vc-mode-line): Don't alter key bindings. (vc-toggle-read-only): Put on C-x C-q unconditionally. (vc-mode): Add permanent-local property. Fri Apr 30 07:51:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (find-file-noselect): On VMS, always set buffer-file-name to the truename. * vc.el (vc-revert-buffer1): Fix format of compilation-error-list. * files.el (find-file-noselect): Do set buffer-file-name to the truename, when find-file-visit-truename. Thu Apr 29 13:19:09 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * yow.el (yow): Fix interactive spec. * files.el (insert-directory): Undo change of March 23; dereferencing links is inappropriate for dired. * edebug.el (edebug-display): Call the `mark' function with the FORCE argument non-nil, so that we don't get an error if the mark isn't set yet. * edebug.el (global-edebug-prefix, global-edebug-map): Add autoload cookies for these, so they are present when Emacs starts up. * edebug.el (global-edebug-map): Bind `C-x X d' to edebug-defun in this map; we can't bind it to `C-x x', as the installation instructions suggest, because that conflicts with copy-to-register. Thu Apr 29 09:34:02 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * complete.el: New file. * vc.el (vc-match-substring): Renamed from match-substring. (vc-parse-buffer): Use new name. * shell.el (shell-prompt-pattern): Undo last change. * files.el (file-truename): Redo esr's change. * loaddefs.el: Put arrow key bindings back to the ordinary Emacs cmds. * simple.el (up-arrow, down-arrow, left-arrow, right-arrow): Deleted. * simple.el (kill-line, next-line-add-newlines): Doc fix. (kill-whole-line): Doc fix. (kill-forward-chars, kill-forward-chars): Reinsert as before. * simple.el: Change defalias to define-function. Wed Apr 28 18:48:52 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * vc.el (vc-revert-buffer1): Ignore non-marker elts of compilation-error-list. * compile.el: Add compilation-minor-mode to minor-mode-alist and minor-mode-map-alist. (compilation-minor-mode): New defvar. (compilation-minor-mode-map): New defvar; keymap with the bindings from compilation-mode-map except SPC and DEL. (compilation-mode-map): Construct this keymap to inherit from compilation-minor-mode-map. (compilation-setup): New function, code broken out of compilation-mode. (compilation-mode): Call it. (compilation-minor-mode): New function to toggle compilation-minor-mode; if setting it, call compilation-setup. Wed Apr 28 17:19:21 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * bibtex.el: Installed Aaron Larson's new bibtex.el. See the header comment for details. Wed Apr 28 16:31:02 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * gnuspost.el (gnus-inews-organization): If ORGANIZATION is "", set it to nil. Wed Apr 28 13:34:40 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * files.el (file-truename): Undo last change. Tue Apr 27 22:01:32 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * files.el (file-truename): Do the right thing when $HOME = "". * simple.el (hscroll-step): New variable. (hscroll-point-visible): New function. (left-arrow, right-arrow): These use hscroll-point-visible for better auto- scrolling behavior. * picture.el: Completed the package entry point's name change from edit-picture to picture-mode. (move-to-column-force, picture-end-of-line): When movement is completed, scroll horizontally if necessary to make point visible. (picture-beginning-of-line): New function. (picture-mode-map): Use substitute-key-definition. * gud.el (gud-format-command): Fix %f expansion to send ondly the basename of files to gdb. Tue Apr 27 11:25:32 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * disp-table.el (describe-display-table): Don't use the term "rope"; we're using vectors of characters now. (standard-display-8bit, standard-display-ascii): Set the element of the display table to a vector, not an integer; the latter doesn't mean anything. * mouse.el (mouse-buffer-menu): Don't right-justify the buffer name; this doesn't look nice if we use a proportional font. * sendmail.el (mail-setup): Don't insert "--\n" before the signature. If they want it, they can put it in their .signature file. * lucid.el: Comment out fset of set-screen-width properly. * lucid.el: (provide 'lucid). * lucid.el: (switch-to-other-buffer): Avoid buffers whose names start with a space. Mon Apr 26 15:21:01 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * etags.el (find-tag-interactive): New function to read args. (find-tag-noselect, find-tag, find-tag-other-window) (find-tag-other-frame, find-tag-regexp): Use it. (find-tag, find-tag-other-window): Take new arg REGEXP-P, pass to find-tag-noselect. (find-tag-regexp): Call either find-tag-other-window or find-tag, rather than find-tag-noselect and switch-to-buffer[-other-window]. (tags-location-stack): New defvar. (find-tag-noselect): If NEXT-P is '-, pop location off tags-location-stack. Mon Apr 26 05:15:08 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * cmacexp.el: Installed Francesco Potorti's enhanced and cleaned-up version, see its commentary for details. * tex-mode.el: Doc fixes. Also a few teaks to pacify the byte-compiler. * terminal.el: Some defvars moved. Defvars added for many variables. (te-stty-string): Specify the characters explicitly--not `stty dec'. Mon Apr 26 05:01:41 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * files.el (cd): Handle leading "~" like an absolute filename. * dired.el: Changed fsets to defaliases. Sun Apr 25 22:26:51 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * comint.el (comint-mod): Nuked. A call to ring-mod replaces it. (comint-mem): Nuked. A call to member replaces it. * ring.el: Rewritten. A poor choice of representation made the old code excessively complex. The new version is smaller and faster. The interface is unchanged, except that ring-remove now accepts an optional numeric argument specifying the element to remove. * gud.el: Set no-byte-compile local variable t to work around a byte-compiler bug. (gud-def, global-map): Move C-x C-a commands to global map. Restore original C-x SPC global binding. * vc.el (vc-diff): Get proper error message when you run this with no prefix arg on an empty buffer. (vc-directory): Better directory format --- replace the user and group IDs with locking-user (if any). (vc-finish-logentry, vc-next-comment, vc-previous-comment): Replace *VC-comment-buffer* with a ring vector. Sun Apr 25 06:14:19 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * simple.el (down-arrow): New function. Uses next-line-add-newlines to suppress addition of new lines at end of buffer. (up-arrow): Alias of previous-line, added for consistency. These changes complete terminal-type-independent support for arrow keys. * tex-mode.el (tex-compilation-parse-errors): Added. At the moment, this would have to be applied manually. It's not worth trying to integrate this with the rest of the mode more tightly until we decide whether and how compile's interface is going to change away from a closed subsystem. * files.el (cd): Changed to use to resolve relative cd calls. (cd-absolute): Added. This is actually the old cd code with a changed doc string. (parse-colon-path): Added. Path-to-string exploder --- may be useful elsewhere. * ring.el: Added and fixed documentation. (ring-rotate): Nuked. It was (a) unused, and (b) totally broken (as in, any attempt to use it died with a type error, and when I patched it to fix that I found its algorithm was broken). (ring-ref): Added doc string. Sun Apr 25 00:48:29 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * bytecomp.el (meta-flag): Declare this an obsolete variable. * subr.el (listify-key-sequence): Use a character constant to decide which bits to flip, not an integer constant. Sat Apr 24 06:08:52 1993 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * shell.el (shell-prompt-pattern): Add `;' as potential prompt delimiter (for `es' and `rc' shells most particularly). Fri Apr 23 07:31:14 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * isearch.el: Replaced all fsets with defaliases. Fri Apr 23 06:51:44 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * bytecomp.el (define-function): Changed name back to defaliases to get things in a known-good state. The unload patch had been half-applied, leading to lossage. * register.el, gnuspost.el, find-dired.el, cust-print.el, two-column.el, tar-mode.el, shell.el, lselect.el, select.el, ispell.el, life.el, picture.el, rmail.el, mim-mode.el, replace.el, tex-mode.el, frame.el, lucid.el, subr.el: All fsets changed to defaliases. * edt.el: Some fsets changed to defaliases. * telnet.el: Commentary added. (telnet): Doc fix. (rsh): Added entry point for rsh to remote host, per suggestion by Michael McNamara . No change to any other code. * info.el (Info-find-node, Info-insert-subfile): Do the right thing if info files have been compressed or gzipped. This is saving me lots of disk space. * simple.el: All fsets changed to defaliases. (kill-forward-chars, kill-backward-chars): Deleted. These were internal subroutines used by delete-char and delete-backward-char before those functions were moved into the C kernel. Now nothing uses them. (kill-line): Added kill-whole-line variable. Defaults to nil; a non-nil value causes a kill-line at the beginning of a line to kill the newline as well as the line. I find it very convenient. Emulates Unipress' &kill-lines-magic variable. (next-line): Added next-line-add-newlines variable. If nil, next-line will not insert newlines when invoked at the end of a buffer. This obviates three LCD packages. (left-arrow, right-arrow): New functions. These do backward-char and forward-char first. If line truncation is on, they then scroll left or right as necessary to make sure point is visible. * loaddefs.el: All fsets changes to defaliases. (global-map): Changed bindings of [left] and [right] to left-arrow and right-arrow respectively. Thu Apr 22 22:56:54 1993 Roland McGrath (roland@mole.gnu.ai.mit.edu) * ange-ftp.el (ange-ftp-binary-file-name-regexp): Match .z and .z-part-?? files. Wed Apr 21 03:47:05 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * makefile.el: Rewritten and simplified, commentary added. It now will usually detect when the makefile target or macro lists need to be rebuilt and do it automatically; in particular, this means you no longer have to deal with an annoying wait at find-time. Mon Apr 19 21:29:48 1993 Roland McGrath (roland@mole.gnu.ai.mit.edu) * vc.el (vc-revert-buffer1): Typo fix in last change. * shell.el (shell-mode): isation/ization (doc fix). * shell.el (shell-mode): Capitalize mode name. * vc.el (vc-comment-to-change-log): Restored interactive spec. Why was it removed? Why does the only log entry mentioning this function contain no actual information? * vc.el (vc-revert-buffer1): Completely rewrote compilation reparsing code. * files.el (find-file-noselect): Never set SAME-TRUENAME to a buffer whose buffer-file-name is nil. * files.el (set-auto-mode): If the buffer begins with "#!", look for -*- in the first two lines, not just the first one. Sat Apr 17 17:44:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-do-fcc): Make a numeric time zone indicator with current-time-zone--don't run `date'. Fri Apr 16 19:36:29 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * bytecomp.el (byte-compile, byte-compile-keep-pending) (byte-compile-file-form-defmumble): Generate define-function rather than fset, to install definitions for defun, defmacro, etc. * loadhist.el: New file. * tar-mode.el: Add defvars to pacify the byte compiler, at RMS's request. * diff.el (diff-parse-differences): Small robustification --- don't lose if we call this with compilation-parsing-end nil Fri Apr 16 19:23:21 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * electric.el (shrink-window-if-larger-than-buffer): Moved to window.el. Fri Apr 16 18:55:13 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * comint.el (comint-match-partial-pathname): Move "---" range in character class in regular expressions to the end of the character class; this way, it meets the POSIX regexp specs. * files.el (abbreviate-file-name): If abbreviated-home-dir ends with a slash, don't remove the corresponding slash from filename when we collapse the home directory to ~. Fri Apr 16 09:06:07 1993 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * rlogin.el: Add autoload cookies for all defvars. (rlogin-process-connection-type): New variable. (rlogin): Use it to determine process-connection-type. (rlogin): Set process mark to point-max, not point-min. (rlogin-with-args): Put `+' inside \(\) pair in string-match. (rlogin-password): Take optional arg `proc' for use by rlogin-filter. Write docstring. Call new winning version of comint-read-noecho instead of doing reading by hand. (rlogin-mode): Wrote docstring. (rlogin-filter): Completely rewritten to be more efficient. Wed Apr 14 16:35:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * resume.el (resume-suspend-hook): Renamed from empty-args-file. Add autoload cookie. (resume-emacs-args-buffer): Renamed. (resume-write-buffer-to-file): Renamed. * two-column.el (tc-dissociate): Renamed from tc-kill-association. Move binding to C-x 6 d. Wed Apr 14 15:56:19 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * autoload.el (update-file-autoloads, update-directory-autoloads): If called interactively, save generated-autoload-file when done. Wed Apr 14 15:34:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * makefile.el (makefile-mode): Fix typo in autoload cookie. * isearch.el: Doc fixes. Wed Apr 14 16:41:51 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * gud.el (gud-mode): Created C-c synonym bindings in the GUD buffer's local map. (gud-key-prefix): Changed to C-x C-a. Wed Apr 14 16:38:49 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * help-macro.el: Name changed from help-screen.el to fit in a 14-character limit. * sun-curs.el: Name changed from sun-cursors.el to protect the innocents. Wed Apr 14 03:34:44 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * finder.el: Rewritten. The Finder is now a major mode with the ability to browse package commentary sections and a completely point-and-shoot interface similar to Dired's. * window.el (shrink-window-if-larger-than-buffer): Moved from electric.el to windows.el, minor bug fix. This is to avoid code duplication between vc.el, electric.el, and finder.el. (ctl-x-map): Added C-x - and C-x + as experimental bindings for shrink-window-if-larger-than-buffer and balance-windows respectively. Since shrink-window-if-larger-than-buffer has to live here anyhow, let users use it to manage screen space. * lisp-mnt.el (lm-commentary-region): Gone. (lm-commentary): New function, replacing lm-commentary-region. Mon Apr 12 21:36:52 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * bytecomp.el: The `suspend-hooks' variable is obsolete now, and `suspend-hook' is the right name. Mon Apr 12 21:36:20 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * term/sun-mouse.el (suspend-emacstool): Run suspend-hook, not suspend-hooks. Mon Apr 12 07:54:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rot13.el (rot13-display-table): Use `vector', not `make-rope'. * disp-table.el: Use `vector', not `make-rope'. * rot13.el (rot13-other-window): Add autoload. Mon Apr 12 04:30:46 1993 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * comint.el (comint-process-echoes): New variable. (comint-mode): Make it buffer-local. (comint-send-input): Delete text from process mark to point if variable `comint-process-echoes' is non-`nil', since it is assumed process will re-echo the text. Mon Apr 12 03:49:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * disp-table.el: Use `vector', not `make-rope'. * rot13.el (rot13-other-window): Add autoload. (rot13-display-table): Use `vector', not `make-rope'. Sat Apr 10 14:28:05 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * gud.el (gdb, sdb, dbx): Improved prompting a la grep. * comint.el: Clean up cmu* uses in header comments. Sat Apr 10 06:21:55 1993 Jim Blandy (jimb@mole.gnu.ai.mit.edu) * subr.el (overlay-start, overlay-end, overlay-buffer): New defsubsts. Sat Apr 10 00:39:29 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * paragraphs.el (sentence-end, forward-sentence): Doc fixes. * finder.el (finder-by-keyword): Build an alist to pass to completing-read, instead of building an invalid obarray. * finder.el (finder-by-keyword): If the user quits or enters the empty string in response to the keyword prompt, restore the old window configuration properly. Sat Apr 10 00:39:29 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * paragraphs.el (sentence-end, forward-sentence): Doc fixes. Fri Apr 9 23:17:05 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * emerge.el (emerge-with-ancestor): Applied Donald Erway's fix patch, which included the following explanatory comment: "D.Erway - This used to just do emerge-get-diff3-group on 2, then on 3. This was incorrect, since the file 3 info for a diff can preceed the file 2 info for that same diff. So we save and restore point to overcome this." Fri Apr 9 03:34:22 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * subr.el (overlay-start, overlay-end, overlay-buffer): New defsubsts. * finder.el (finder-by-keyword): Build an alist to pass to completing-read, instead of building an invalid obarray. * finder.el (finder-by-keyword): If the user quits or enters the empty string in response to the keyword prompt, restore the old window configuration properly. Thu Apr 8 17:47:39 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * autoload.el (generate-file-autoloads): Doc fix. Thu Apr 8 16:35:59 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * gud.el: Massive changes, amounting nearly to a rewrite. The new features include auto-configuring support for SVr4, more commands, and a full minor-mode implementation that binds all GUD commands not just in the GUD interaction mode, but in C buffers visited by GUD. The common prefix of GUD commands is now C-x X, like electric-debug mode. * vc-hooks.el (vc-mode): name change. This looks better in keymap listings and conforms to the naming conventions used by other packages. * vc.el (vc-directory. vc-start-entry, vc-next-action, vc-next-action-on-file): The vc-directory listing is now in an augmented Dired mode that supports vc-next-action on all marked files. * dired.el (dired-noselect, dired-internal-noselect, dired-insert-directory): Enhancements to support passing dired a DIRNAME argument consisting of a directory-name car and a list-of-files cdr. This is needed to support VC's augmented dired, which wants a filtered file display that recurses (showing all version-controlled files in subdirectories as well as the top-level ones). * menu-bar.el: Added and corrected library headers. Thu Apr 8 07:10:13 1993 Richard Stallman (rms@geech.gnu.ai.mit.edu) * menu-bar.el: entered into RCS * lucid.el: Add copyright notice. Wed Apr 7 20:58:20 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * compile.el (compile-internal): Initialize the process-mark. * compile.el (compilation-error-regexp-alist): Tighten first regexp so that it requires a colon or open-paren before the line number, not just whitespace. * compile.el (compilation-parse-errors): Remove debugging setq. * compile.el (compilation-filter): New function. (compile-internal): Make it the process's filter. * compile.el (compilation-error-regexp-alist): Fixed MIPS CC regexp to match file names longer than one char. (compilation-parse-errors): Error if compilation-error-regexp-alist is nil. Wed Apr 7 17:42:52 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * menu-bar.el: New file. * fill.el (fill-nonuniform-paragraphs): New command. Wed Apr 7 16:58:20 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * compile.el (compile-internal): Initialize the process-mark. Wed Apr 7 16:14:29 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * compile.el (compilation-error-regexp-alist): Tighten first regexp so that it requires a colon or open-paren before the line number, not just whitespace. Wed Apr 7 15:24:19 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (find-file-noselect): Verify other buffers' file numbers are still valid. Wed Apr 7 14:34:17 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * compile.el (compilation-filter): New function. (compile-internal): Make it the process's filter. * compile.el (compilation-error-regexp-alist): Fixed MIPS CC regexp to match file names longer than one char. (compilation-parse-errors): Error if compilation-error-regexp-alist is nil. Wed Apr 7 00:27:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tabify.el (untabify): Don't really change where restriction starts. Tue Apr 6 13:11:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired.el (dired-pop-to-buffer): Adjust count-lines val for last line. Mon Apr 5 19:52:16 1993 Roland McGrath (roland@wookumz.gnu.ai.mit.edu) * add-log.el (find-change-log): New function. (add-change-log-entry): FILE-NAME frobnicating code moved there; call it. * vc.el (vc-comment-to-change-log): Renamed from vc-comment-to-changelog. Take optional arg and pass it to find-change-log. Added docstring and interactive spec. Mon Apr 5 17:13:43 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-error-regexp-alist): Merged HP-UX 7.0 fc regexp with the GNU format regexp: just allowing blanks to terminate the line number makes that one handle the HP case. Merged MIPS RISC CC regexp with Apollo cc regexp: make "s optional, and don't anchor to bol. * compile.el (compilation-error-regexp-alist): Changed MIPS RISC CC regexp (last one) to be anchored at bol, and to never match multiple lines. Sat Apr 3 23:28:03 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * man.el, assoc.el: Installed Barry Warsaw's new and much more featureful man page browser. * finder.el, help-screen.el, faces.el: Added or corrected documentation headers Sat Apr 3 11:00:56 1993 Noah Friedman (friedman@geech.gnu.ai.mit.edu) * comint.el: New comint-read-noecho. Fri Apr 2 16:41:54 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * chistory.el (repeat-history-command): Bug fix. Someone forgot a car. Fri Apr 2 01:18:58 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * mpuz.el (mpuz-try-letter): Use read-char to read digit. Use message directly also. Use downcase. (mpuz-read-map): Deleted. * dired.el (dired-unmark-all-files): Read the arg as just a char. Thu Apr 1 17:19:36 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * lisp-mode.el (eval-defun): Rename argument to avoid collision. (eval-last-sexp): Likewise. Wed Mar 31 21:11:36 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (etags-tags-completion-table): Rewritten with a mondo regexp. Wed Mar 31 20:05:51 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * timer.el (timer-program): New defconst. (run-at-time): Use timer-program as the name of the program the subprocess should run, and search for it in exec-directory, rather than checking the entire exec path. Wed Mar 31 16:12:06 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * simple.el (indent-for-comment): Use skip-syntax-backward in place of skip-chars-backward. Correctly set INDENT to the return value of comment-indent-function. * etags.el (etags-tags-completion-table): Use skip-syntax-backward instead of skip-chars-backward. * view.el (view-exit): Use local map view-old-local-map, not (current-local-map). (view-buffer-other-window): Remove spurious backslashes from interactive spec. * map-ynp.el (map-y-or-n-p): Make bindings of user-defined keys be each a vector containing the user's binding, rather than 'user. Check (vectorp DEF) and call the vector's elt, rather than checking (eq 'user DEF) and calling something completely random. * novice.el (enable-command): Remove spurious assignment of free variable `foo'. * help.el (describe-function): For Lisp functions, write a prototype call before the docstring, instead of an argument description after it. Tue Mar 30 17:15:24 1993 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * files.el (find-backup-file-name): Delete nothing if overflow in number of versions to keep. Tue Mar 30 16:12:13 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * subr.el (int-to-string): Make this an alias for the subr number-to-string. Tue Mar 30 14:37:56 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch.el (isearch-mode-map): Delete the binding for C-h. (isearch-done): Customize the message about mark. Tue Mar 30 14:37:42 1993 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * comint.el (comint-read-noecho): Rewritten to provide some simple editing ability and be able to abort when called from a process filter. Re-arranged and updated docstring. Tue Mar 30 16:22:39 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * ring.el: Changed summary line. Tue Mar 30 02:27:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * faces.el: New file. Mon Mar 29 14:08:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail): Don't use mbox as inbox by default. * simple.el (count-lines): Use save-match-data. * buff-menu.el: Put back removed years in copyright notice. Mon Mar 29 15:38:31 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * vc.el (vc-next-action, vc-print-log, vc-diff, vc-revert-buffer): Improved logic for parent buffer finding. (vc-cancel-version): bug fix. Mon Mar 29 03:09:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mailabbrev.el: Provide mailabbrev, not mail-abbrevs. Sun Mar 28 15:10:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fill.el (fill-individual-paragraphs): When skipping mail headers, skip to a blank line. * env.el (setenv): Renamed back from putenv. * replace.el (regexp-history): New history list. (occur, flush-lines, keep-lines, how-many): Use it. (occur): Don't insert previous string in minibuffer gratuitously. Just use it if input is empty. Use save-match-data around count-lines. Sun Mar 28 01:53:54 1993 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * setenv.el: Renamed to env.el. Provide `env', not `setenv'. (setenv): Renamed to `putenv', which is the more proper complement of `getenv'. `setenv' retained as an alias. Make VALUE parameter optional; if not set, remove VARIABLE from process-environment. * rlogin.el (rlogin): If given a prefix argument and an rlogin session for HOST is already running, start a new rlogin process rather than switching to the existing one. Added docstring. Bound `proc' in let*. (rlogin-explicit-args, rlogin-password-paranoia): New variables. (rlogin-filter): Prompt for passwords in minibuffer if rlogin-password-paranoia is set. (rlogin-with-args, rlogin-password): New functions. Sun Mar 28 06:40:46 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * vc.el (vc-comment-to-changelog): A useful vc-checkin hook, added. (vc-checkout): Now rejects attempts to check out files via FTP. * vc.el: The `derived buffers' in the mode (the VC log buffer, status buffers, and most buffer output commands) now know which file buffer was their parent, and most commands will try to find such a parent buffer when executed from within a special buffer. * makefile.el: Added autoload cookie for entry point. * files.el (auto-mode-alist): added pairs for .ms, .man, .mk, [Mm]akefile, .lex. * electric.el: (shrink-window-if-larger-than-buffer) Added doc string. Made argument optional, because window-buffer does the right thing with nil. * ebuff-menu.el (electric-buffer-menu-mode-map): fillarray isn't a valid operation on maps any more. Sat Mar 27 16:26:22 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * refer.el: Installed. Sat Mar 27 13:00:59 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * lucid.el (try-face-font, find-face, get-face): New aliases. Sat Mar 27 08:20:12 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * abbrevlist.el, old-inf-lisp.el, old-screen.el old-shell.el, oshell.el: Removed. Sat Mar 27 02:44:26 1993 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * rlogin.el: Updated copyright year and added autoload cookies. (rlogin): Set process marker to beginning of buffer. (rlogin-filter): Use unwind-protect to restore match-data. Use insert-before-markers instead of insert to keep input and output from getting garbled. Delete spurious ?\C-m chars in output instead of replacing them with ?\ . Sat Mar 27 01:18:21 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * case-table.el: Add autoloads. (set-case-syntax-delims, set-case-syntax-pair, set-case-syntax): Rename arg STRING to TABLE. Do not set the standard case table. Fri Mar 26 21:45:40 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * loaddefs.el: Commented out function-key-error definition and uses in the global keymaps. RMS and jimb objected to the amount of space these took up in the keybinding listings. Sat Mar 27 01:58:44 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * lpr.el (printify-buffer): Added, debugged from Roland McGrath's printify-buffer code in LCD. * cookie.el (cookie): Enhanced it to handle both LINS files and UNIX fortune files. * rect.el (fill-rectangle): Added. Inspired by Lynn Slater's insert-box package in LCD, but the interface and implementation are different. * loaddefs.el (ctl-x-map): Added binding for fill-rectangle. * buff-menu.el (Buffer-menu-toggle-read-only): Added, per Rob Austein's suggestion in the LCD package bm-toggle.el. * subr.el (add-hook): Added optional arg to cause hook to be appended rather than prepended to the hook list. This obviates the 23 different hook-bashing packages in LCD. * subr.el (current-word): Added. Lots of help and default-generator functions in LCD use it, and it's remarkably difficult to get right, especially given the new syntax primitives. Fri Mar 26 07:28:20 1993 Richard Stallman (rms@geech.gnu.ai.mit.edu) * files.el (local-write-file-hooks): New variable. (set-visited-file-name): Kill local-write-file-hooks as local var. (basic-save-buffer): Use local-write-file-hooks. Fri Mar 26 02:27:15 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * files.el (local-write-file-hooks): New variable. (set-visited-file-name): Kill local-write-file-hooks as local var. (basic-save-buffer): Use local-write-file-hooks. Fri Mar 26 04:17:45 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * yow.el (psychoanalyze-pinhead): Needed a prefrontal lobotomy. I gave it one. * two-column.el: Added Commentary. Thu Mar 25 03:40:35 1993 Richard Stallman (rms@geech.gnu.ai.mit.edu) * help.el (describe-function): Add blank line above doc string. * uncompress.el: Add provide call. Thu Mar 25 01:57:43 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * lisp-mnt.el (lm-last-modified-date): Fixed return bug. (lm-author, lm-maintainer): These now return cons pairs, not strings. * shell.el: Brent Benson's patch to support `cd -'. * mh-e.el (mh-unshar): Added. * emacsbug.el: Added a (provide 'emacsbug); lisp-mnt.el needs this. Wed Mar 24 23:38:53 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * term/x-win.el (x-defined-colors): Use x-color-defined-p instead of x-defined-color. (x-handle-geometry): Use x-parse-geometry instead of x-geometry. Wed Mar 24 20:27:07 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * calendar.el (calendar-standard-time-zone-name, calendar-daylight-time-zone-name): Initialize these at load-time, as well as calendar-time-zone. * calendar.el (calendar-time-zone): Fix code which initializes this. Wed Mar 24 02:59:21 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * term/x-win.el: Bind M-next to an alias scroll-other-window-1 to get better doc string output. Tue Mar 23 18:27:03 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * compile.el: Fix library headers. Tue Mar 23 07:41:49 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * files.el (insert-directory): Do chase symlinks before passing the directory name to ls. Tue Mar 23 07:26:34 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * buff-menu.el: Incorporated changes from Bob Weiner's enhanced buff-menu from the LCD archive. Tue Mar 23 02:26:42 1993 Richard Stallman (rms@geech.gnu.ai.mit.edu) * replace.el (query-replace-map): Define backspace like delete. Mon Mar 22 22:44:49 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * cookie.el: Created. This file contains what was formerly the guts of spook.el, lightly hacked to support more than one simultaneous cookie database. * spook.el, yow.el: Modified to use cookie.el. Total code in the three files cookie.el, yow.el and spook.el is less than the old spook.el + yow.el. * time.el, timer.el, uncompress.el, underline.el, view.el, vip.el, xscheme.el: Added or corrected Commentary section. This finishes my pass over the lisp libraries; I'll teach the finder about these commentary sections soon. Mon Mar 22 17:35:29 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * term/x-win.el (x-win-suspend-error): suspend-hook renamed from suspend-hooks. Mon Mar 22 16:53:22 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * help.el, register.el, replace.el, reposition.el, rfc822.el, rlogin.el, rot13.el, scribe.el, scroll-bar.el, sendmail.el, setenv.el, sgml-mode.el, simple.el, simula.el, sort.el, spell.el, spook.el, studly.el, tabify.el, text-mode.el: Added or corrected Commentary headers. Mon Mar 22 14:15:30 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * diary-insert.el: Change the name to diary-ins.el. * calendar.el: Change all autoload references to diary-ins. Mon Mar 22 06:59:54 1993 Richard Stallman (rms@geech.gnu.ai.mit.edu) * help.el: Don't load help-screen at run time if compiled. Mon Mar 22 05:42:35 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * man.el, mlconvert.el, mlsupport.el, modula2.el, mouse.el, mpuz.el, netunam.el, novice.el, nroff-mode.el, options.el, outline.el, page.el, paragraphs.el, picture.el, prolog.el, rect.el: Added or corrected Commentary sections. Mon Mar 22 03:27:18 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * abbrev.el, ada.el, add-log.el, array.el, autoinsert.el, autoload.el, awk-mode.el, bib-mode.el, bibtex.el, buff-menu.el, bytecomp.el, c++-mode.el, c-mode.el, cl-indent.el, cmacexp.el, cmulisp.el, cmuscheme.el, comint.el, compare-w.el, compile.el, debug.el, diff.el, dired-aux.el, dired.el, disass.el, dissociate.el, doctor.el, ebuff-menu.el, edebug.el, ehelp.el, emacsbug.el, emerge.el, files.el, fill.el, fortran.el, gosmacs.el, hanoi.el, hexl.el, hideif.el, icon.el, indent.el, iso-insert.el, iso-swed.el, iso-syntax.el, iso8859-1.el, ispell.el, kermit.el, ledit.el, life.el, lisp-mode.el, lisp.el, lpr.el, macros.el, mail-utils.el, mailalias.el, makefile.el, makesum.el, mim-mode.el, modula2.el, nroff-mode.el, perl-mode.el, prolog.el, scheme.el, sgml-mode.el, tex-mode.el: Added or corrected Commentary sections. There's more of this coming; soon, the package finder will be able to browse Commentary sections, and I want almost all packages to have useful ones. Sun Mar 21 03:03:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * help.el: Don't load help-screen at run time if compiled. * simple.el (line-number-mode): New function and variable. * loaddefs.el (default-mode-line-format-default): Use %l. Sun Mar 21 00:30:21 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * time.el (display-time): Doc fix. * isearch.el (isearch-switch-frame-handler): Call handle-switch-frame instead of select-frame; it has been renamed. * simple.el (comment-indent-function): New variable, intended to replace comment-indent-hook. (comment-indent-hook): Make this default to nil now. (indent-for-comment): If comment-indent-hook is non-nil, call it for backward compatibility; otherwise, call comment-indent-function. * bytecomp.el: Declare comment-indent-hook an obsolete variable. Sat Mar 20 15:16:51 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * time.el (display-time): Doc fix. * lucid.el: Alias lower-screen and raise-screen to lower-frame and raise-frame, the new names for those functions. Fri Mar 19 21:48:09 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * bush.el: Deleted. * finder.el: Make sure that when new keywords are compiled, we see them immediately. Fri Mar 19 17:38:48 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * tex-mode.el (tex-send-command): Fix the command sent so that no blank is inserted when replacing the asterisk with the file name. Fri Mar 19 14:21:44 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * vt100-led.el, bg-mouse.el, sup-mouse.el, sun-mouse.el: moved to term directory. Thu Mar 18 21:44:24 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * Makefile: created. This exists mainly so developers elsewhere can unlock the lisp files to accept an update tar, then relock them without locking the few that should stay writeable. * solar.el, ange-ftp.el: Corrected Keywords header * ftp.el: Nuked (actually, moved to =ftp.el). ange-ftp.el replaces this. Thu Mar 18 21:39:28 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * solar.el (solar-time-string): Round the time properly. Thu Mar 18 21:29:42 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * abbrev.el, abbrevlist.el, add-log.el, apropos.el, array.el, autoload.el, awk-mode.el, cal-french.el, cal-mayan.el, calendar.el, cmulisp.el, cmuscheme.el, comint.el, compile.el, completion.el, cust-print.el, dabbrev.el, debug.el, diary.el, diff.el, disass.el, edebug.el, edmacro.el, emacsbug.el, finder.el, inf-lisp.el, ispell.el, life.el, lisp.el, lunar.el, macros.el, netunam.el, old-shell.el, scribe.el, spell.el, sun-cursors.el, terminal.el, unrmail.el, vms-pmail.el: Add or correct Keywords headers for finder. Thu Mar 18 19:22:48 1993 Richard Stallman (rms@geech.gnu.ai.mit.edu) * frame.el (make-frame): Renamed from new-frame. (new-frame): Alias for make-frame. Thu Mar 18 14:18:32 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * frame.el (make-frame): Renamed from new-frame. (new-frame): Alias for make-frame. Thu Mar 18 11:34:34 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * tex-mode.el (tex-send-command): Fix the command sent so that no blank is inserted when replacing the asterisk with the file name. Thu Mar 18 03:38:31 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * term/wyse50.el: (function-key-map) Nuke code no longer bound to keys. * term/tvi970.el: (function-key-map) As many key cookies as possible renamed to fit the new conventions documented in lisp/term/README. * term/vt100.el, term/news.el: (function-key-map) Fix things so that bindings are added to the keymap already created by terminal initialization. Wed Mar 17 16:57:17 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * help-screen.el: Installed, following release. Now package writers can easily implement help screens resembling Emacs's own on-line help system. * help.el: help-for-help now uses make-help-screen from help-screen.el. Wed Mar 17 13:24:32 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * finder-inf.el: Deleted the RCS file. Wed Mar 17 17:19:16 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * isearch.el, lselect.el, select.el, scroll-bar.el, texinfo.el, pending-del.el, profile.el, texinfmt.el, ls-lisp.el, meese.el, isearch.el, tmenu.el, lmenu.el, rmailsum.el, unrmail.el, hippie.el, lmenu.el, rmailmsc.el, rlogin.el, mhspool.el, lisp-mode.el, novice.el, mouse.el, vms-pmail.el, vc-hooks.el, levents.el, iso8859-1.el, isearch.el, hippie.el, find-gc.el, cust-print.el, find-dired.el, etags.el, electric.el, dired.el, dired-aux.el, cust-print.el, cmuscheme.el, cmulisp.el, cl.el, case-table.el, byte-run.el, ange-ftp.el, backquote.el: Added or corrected library header comments. Wed Mar 17 14:26:35 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * finder.el (finder-compile-keywords): Treat nil in a path argument as $PWD. (finder-by-keyword): Handle LFD as input gracefully. Wed Mar 17 14:01:56 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * vc-hooks.el: Increment version number to match vc.el's. * vc.el (vc-header-strings): Name changed to vc-header-alist, to match the docs. (vc-finish-logentry, vc-next-comment, vc-previous-comment, vc-comment-search-forward, vc-comment-search-backward) The VC comment ring is now a separate buffer from *VC-log*; editing of old comments is no longer destructive. Tue Mar 16 21:09:56 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-version-diff): Use (message ...), not (message (format ...)). (vc-backend-checkout, vc-backend-assign-name): Correct bogus messages. * vc-hooks.el: Merge today's change by eric with everybody else's change (from 1992/08/04 through 1993/02/24). Tue Mar 16 13:03:35 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * bytecomp.el (byte-compile-from-buffer): Put buffer containing compiled code in binary overwrite mode. * simple.el (quoted-insert): In overwrite mode, don't read digits as an octal character code. In binary overwrite mode, overwrite the characters instead of inserting them. (overwrite-mode-textual, overwrite-mode-binary): New symbols, for use in the mode line. (overwrite-mode): Doc fix. Use force-mode-line-update. (binary-overwrite-mode): New function. * loaddefs.el (minor-mode-alist): Make the mode line element for overwrite-mode be the symbol `overwrite-mode'. Tue Mar 16 10:52:06 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * vc.el, vc-hooks.el: the macro vc-error-occurred has to move from vc.el to vc-hooks.el for C-x C-f of a nonexistent file to work. Tue Mar 16 03:40:21 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * calendar.el (calendar-time-zone): Initialize this when calendar.el loads, not in the defvar. Mon Mar 15 01:01:29 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * register.el (view-register): Neglect not to avoid failing to properly display all the possible sorts of things one might find in a buffer. Make frame configurations start with a distinctive symbol. * frame.el (current-frame-configuration): Return a list as before, but starting with `frame-configuration'. (set-frame-configuration): Check that CONFIGURATION is a list starting with `frame-configuration', strip it off, and do as before. (frame-configuration-p): New function. * register.el (jump-to-register): Use frame-configuration-p, instead of catching an error in set-frame-configuration. Really now. * indent.el (indent-region, indent-region-function): Doc fix. * indent.el (indent-line-function): Doc fix. Sun Mar 14 23:43:04 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * sort.el (sort-float-fields, sort-numeric-fields): Use string-to-number, not string-to-float or string-to-int. * sort.el (sort-float-fields): Make this autoloaded. * sort.el (sort-numeric-fields): Doc fix. Sun Mar 14 00:51:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lselect.el, select.el: New files. * term/x-win.el: Require select.el. (x-select-text): Update call to x-set-cut-buffer. Put `PRIMARY' and `CLIPBOARD' in upper case. (x-cut-buffer-or-selection-value): Put `PRIMARY' in upper case. * lucid.el, lmenu.el, levents.el: New files. Much of lmenu.el comes from Lucid. Sat Mar 13 16:45:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmailsum.el (rmail-summary-next-msg): Call display-buffer. (rmail-summary-previous-all, rmail-summary-next-all): Likewise. (rmail-summary-rmail-update): Do nothing if rmail buffer not visible. (rmail-summary-mode-map): Don't bind C-n, C-p. Use ordinary move cmds. Fri Mar 12 19:53:22 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * term/x-win.el: Added library headers. Fri Mar 12 14:53:51 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * loaddefs.el (global-map): Fixed a typo in the binding of [kp-backtab]. * term/x-win.el: Added library headers back in. Didn't touch any key bindings or code, and won't without making sure there won't be any repeat of the bad-patch brouhaha. Thu Mar 11 18:50:04 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el: Cancel previous change, since it discarded earlier necessary changes. Thu Mar 11 13:45:58 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el: Cancel previous change, since it discarded earlier necessary changes. Thu Mar 11 09:00:25 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * term/vt100.el: Added headers, commented out code the duplicates startup effects. * term/x-win.el: Added headers, removed function bindings. * term/wyse50.el: Added headers, changed some keycap names. * term/tvi970.el: Added headers, changes some keycap names. * term/sun.el: Added headers, removed function-key bindings. * term/news.el: Added headers, changed a few cookie names. * term/keyswap.el: Initial revision Thu Mar 11 07:01:17 1993 Jim Blandy (jimb@mole.gnu.ai.mit.edu) * term/x-win.el: Disable suspending under X windows by setting suspend-hooks, not suspend-hook. The latter is an obsolete name. Use add-hook instead of setting suspend-hooks directly. Thu Mar 11 03:00:19 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) A boatload of changes to terminal support and terminal capability initialization that make it a lot smarter, with a more uniform and featureful interface across many different keyboard types. * term.c (fkey_table): has been expanded to handle the entire intersection of the capability sets defined by X keysyms and terminfo. That is, every keysym for which there is a natural equivalent in terminfo is now bound to that by the startup code. * loaddefs.el (global-map): Natural default keybindings set up for almost all supported keysyms other than function keys. All other keysyms are now default-bound to a function which explains that the key is not bound to anything, then raises an error. * term/READ.ME: terminal package conventions and standard keysym cookies are now documented here. * term/AT386.el: new package installed. Handles IBM-AT style console keyboards with style and flair. * term/new-at386.el: removed, it was obsolescent. * term/apollo.el: nuked and linked to vt100.el. All it formerly did was load vt100.el. * term/bobcat.el: copied and linked to `keyswap.el'. * term/keyswap.el: the old bobcat.el with headers and docs. This is available for other terminal packages to call. * term/news.el: cleaned up, headers added. * term/sun.el: headers added, [again] changed to [redo]. This package is a hairball and should probably be scrapped if we can find or built abetter one. * term/tvi970.el: headers added, [enter] changed to [kp-enter]. * term/vt100.el: headers added, cleanup, explicit function-key enable is no longer necessary. * term/vt200.el: nuked. It's now a link to vt100.el. This is possible because all the things handled differently on the vt200 are mined out of termcap by 19's initialization before either package is loaded. * term/wyse50.el: cleaned up, headers added, various cookie names changed, function bindings removed. * term/x-win.el: cleaned up, headers added. Some bindings of keycap cookies to functions were removed; all that stuff is handled terminal-independently in loaddefs now. Other changes: * help.el: added binding and menu line for new `P' package-finder command. Won't actually take effect till the next Emacs build. * vc.el (vc-backend-checkin): Fixed bizarre POM-dependent bug introduced into VC by a bad patch. This was one for the books....badly corrupted vc-checkin code somehow mostly functioned for three days. The Code That Would Not Die... Thu Mar 11 02:01:52 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * startup.el (command-line-1): Fix copyright year. Wed Mar 10 12:59:06 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * diary-insert.el (insert-anniversary-diary-entry, insert-block-diary-entry): Fix calendar-date-display-form used. Wed Mar 10 12:06:52 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * files.el (basic-save-buffer): If file-precious-flag is set, and we write the buffer to a temp file and then rename it, don't neglect to set the new file's modes properly. Wed Mar 10 06:31:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el (function-key-map): Map key symbols backspace, return... into ASCII chars. Likewise their Meta versions. Also add `ascii-character' properties. Tue Mar 9 17:58:31 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * term/at386.el: Removed. The new terminal initialization stuff makes it superfluous. I wrote it, so I should know. :-) * vc.el: Installed version 5, the new baseline. This version merges my changes with Paul Eggert's. Tue Mar 9 00:36:33 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * timer.el (run-at-time): Allow an integer as TIME. (cancel-timer): New function. * c-mode.el (c-beginning-of-statement): If next to a comment, use sentence motion. * map-ynp.el (map-y-or-n-p): Use query-replace-map. * replace.el (query-replace-map): New keymap. (perform-replace): Use query-replace-map. (query-replace, query-replace-regexp, map-query-replace-regexp): (replace-string, replace-regexp): Don't print `done' if unread chars. * help.el (command-apropos): Print echo area message iff found symbols. * rmailsum.el (rmail-update-summary): New function. (rmail-new-summary): New arg redo-form. Considerable rewrite of how and when buffers are selected. (rmail-summary-mode): New local vars rmail-summary-redo, revert-buffer-function, post-command-hook, rmail-current-message. (rmail-summary-expunge): Use rmail-update-summary. (rmail-summary-get-new-mail): Likewise. (rmail-summary-expunge-and-save): Likewise. (rmail-summary-input): Don't update summary at all. (rmail-summary-reply): Do the work inside save-window-excursion, then switch to the mail buffer. (rmail-summary-retry-failure): Likewise. (rmail-summary-edit-current-message): Delete spurious autoload. (rmail-summary-summary): Function deleted. Use plain rmail-summary on h and C-M-h. (rmail-summary-rmail-update): New function. * rmail.el (rmail-delete-forward): Go to summary buf to change D mark. Always do the motion in the rmail buffer; let that handle summary. (rmail-undelete-previous-message): Likewise. (rmail-select-summary): New macro. (rmail-show-message): Use rmail-select-summary. (rmail-get-new-mail): Likewise. (rmail-expunge): Likewise. * pending-del.el: New file. Mon Mar 8 01:39:42 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (posn-timestamp, posn-col-row, posn-point, posn-window): (event-end, event-start, mouse-movement-p): Moved from mouse.el. * mouse.el: Functions moved to subr.el. Sun Mar 7 15:12:13 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (event-basic-type): New function. * isearch.el: Renamed from isearch-mode.el. * isearch-mode.el (isearch-other-meta-char): Call listify-key-sequence. (isearch-unread): Don't call it here. (isearch-mode-map): Bind the ASCII-equivalent function keys. Sun Mar 7 18:20:54 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-update-change-log): Check that ChangeLog is writable before starting the expensive rcs2log process. Use call-process instead of shell-command to invoke rcs2log; this avoids undesired shell escapes and is more robust about errors. Put mark at point-min, so that the new insertion is in the region. (vc-checkin-hook): Fix `runs-hooks' typo. (vc-checkout-writeable-buffer-hook): New var. (vc-next-action): Fix bug: initial checkin was botched when C-x v v was applied to a new file while vc-initial-comment was non-nil. (vc-register): Don't barf when registering a new, empty buffer. (vc-directory): The `No files are currently registered' message was wrongly worded, because sometimes the message talks about locked files, not registered files. (vc-file-tree-walk): Change (apply 'funcall ...) to (apply ...), since the 'funcall is redundant. When traversing a directory tree, message "Traversing directory XXX" so that the user can see what progress is being made. Traversal can take a long time. Omit first argument, since it is always the current directory. All callers changed. (vc-file-tree-walk-internal): New function. (vc-do-command, vc-diff, vc-version-diff, vc-backend-diff): Remove redundant calls to `format'. (vc-diff): Remove unused variable `old'. (vc-version-diff): When recursively generating a difference listing, don't append the latest output unless diff was actually run; otherwise, you'll get the output from the previous file by mistake. Sun Mar 7 04:22:37 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el (function-key-map): Map key symbols backspace, return... into ASCII chars. Sun Mar 7 02:34:45 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch-mode.el (isearch-mode): Don't make a pre-command-hook. * vc.el (vc-revert-buffer1): Use mark-marker; don't alter mark-active. * subr.el (event-modifiers): New function. (eventp): New function. Sat Mar 6 00:12:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch-mode.el (isearch-unread): Find last list element by hand. * info.el (Info-forward-node): Properly go to first menu item. (Info-insert-dir): Bind temp wider, around use. * term/x-win.el (function-key-map): Map key symbols backspace, return... into ASCII chars. Likewise their Meta versions. Also add `ascii-character' properties. * simple.el (set-mark): Activate the mark. (mark): Handle region-active. New optional arg FORCE. (exchange-point-and-mark, push_mark): Pass FORCE. (set-mark-command): Likewise. * terminal.el (te-escape-extended-command-unread): Handle any key seq. * emerge.el (emerge-show-file-name): Handle any kind of event. * fortran.el (fortran-abbrev-start): Handle any kind of event. (fortran-window-create-momentarily): Likewise. * ehelp.el (electric-help-command-loop): Handle any kind of event. * ebuff-menu.el (electric-buffer-list): Handle any kind of event. (Electric-buffer-menu-exit): Handle any key sequence. * info.el (Info-summary): Handle any event when flushing the display. * simula.el (simula-electric-label): Handle any event when flushing the display. * subr.el (momentary-string-display): Handle any event when flushing the display. * comint.el (comint-dynamic-list-completions): Handle any event when flushing the display. * subr.el (listify-key-sequence): New function. * simple.el (prefix-arg-internal): Use listify-key-sequence. * isearch-mode.el (isearch-unread): Handle multiple args. For Emacs 19, use listify-key-sequence. If not Emacs 19, assume they are a meta sequence. (isearch-other-meta-char): Pass the whole key sequence. (isearch-other-control-char): Make this alias for ...-meta-char. * rmail.el (rmail-bury): Record Rmail buffer to bury it later. Fri Mar 5 15:34:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * disp-table.el: Add autoload comments. (rope-to-vector): Deleted. (describe-display-table): Don't use rope-to-vector. * compare-w.el (compare-windows): Use compare-buffer-substrings. Fri Mar 5 11:33:59 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * term/x-win.el: Disable suspending under X windows by setting suspend-hooks, not suspend-hook. The latter is an obsolete name. Use add-hook instead of setting suspend-hooks directly. * bytecomp.el: Declare suspend-hook to be an obsolete variable. Fri Mar 5 09:37:35 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (hebrew-calendar-yahrzeit): Change reference to nonexistent function last-month-of-hebrew-year to the correct function hebrew-calendar-last-month-of-year. * cal-mayan.el (calendar-mayan-haab-on-or-before, calendar-mayan-tzolkin-on-or-before): Change `mod' to `%'. * cal-mayan.el (calendar-next-tzolkin-date): Delete bogus second defun. Thu Mar 4 12:31:22 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * simple.el (kill-ring-save): Doc fix. * sun-mouse.el (suspend-emacstool): Run suspend-hooks, not suspend-hook. * resume.el: Doc fix. * simple.el (yank, yank-pop): Always return nil; don't rely on exchange-point-and-mark to return nil. * fill.el (justify-current-line): Return nil, to be sure to conform with documentation. Wed Mar 3 00:11:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (write-file): Handle directory name as arg. * rmail.el: Major changes from Bob Weiner Handle some Emacs 18 function names to run in 18. This is to facilitate working with Weiner. (rmail-reply-prefix): New variable. (rmail-reply): Use that variable to add to subject. (rmail-retry-failure): Change binding to M-m. (rmail-forward): Look for >From as well as for From. Handle case where neither is found. (rmail-last-regexp): New variable. (rmail-mode): Make rmail-last-regexp local. (rmail): Don't update rmail-mode data for old buffer if it's not in rmail mode. Error if in Rmail Edit mode. (rmail-bury): New command, plus key binding. (rmail-summary-by-topic): New key binding. (rmail-insert-inbox-text): Check for pop case earlier. (rmail-convert-to-babyl-format): Handle Content-Length field. (rmail-maybe-display-summary): New function. (rmail-redisplay-summary): New user option. (rmail-undelete-previous-message, rmail-delete-forward): (rmail-get-new-mail, rmail-show-message): Update summary buffer if any. Call rmail-maybe-display-summary to put it back on screen. (rmail-only-expunge): Renamed from rmail-expunge. (rmail-expunge): New function. (rmail-message-recipients-p, rmail-message-regexp-p): New functions. (rmail-summary-exists, rmail-summary-displayed): New functions. Tue Mar 2 13:38:56 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cl.el (defsetf): Use eval-and-compile for self-update-fn. * add-log.el (add-change-log-entry): Never move past second hdr line. Tue Mar 2 07:35:52 1993 Jim Blandy (jimb@mole.gnu.ai.mit.edu) * term/x-win.el (x-switch-definitions): Use the proper names for the scroll bar parameters. Use the term `scroll bar', instead of `scrollbar'. * term/x-win.el, frame.el, mouse.el: Terminology changed. * scrollbar.el: Renamed to scroll-bar.el. * term/x-win.el: Require `scroll-bar', not `scrollbar'. Tue Mar 2 00:25:09 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * frame.el (new-frame): Doc fix. * info.el (Info-directory-list): Doc fix; it is set according to INFOPATH, not INFODIR. * info.el (Info-find-node): Don't try to set the info buffer's directory according to Info-directory; that variable doesn't exist any more. Instead, let Info-insert-dir set the current directory. (Info-insert-dir): Properly check for upper- and lower-case forms of "dir", with and without ".info" extension. Set the buffer's default-directory to the directory containing the first dir file we find, and cache it in Info-dir-contents-directory. (Info-dir-contents-directory): New variable, to cache the directory we decided to use as the merged directory's default-directory. * term/x-win.el (x-switch-definitions): Use the proper names for the scroll bar parameters. Mon Mar 1 04:04:09 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.el: Doc fixes. (set-pointer-color): Renamed to set-mouse-color. (set-border-color): New function. * info.el (Info-insert-dir): Make menu items in Top node pointing each of the other nodes. * rmail.el (rmail-get-new-mail): Reset read-only after find-file. Mon Mar 1 00:18:31 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * simple.el (kill-region): If the buffer is read-only, call `barf-if-buffer-read-only' instead of just `ding', to get the appropriate error condition and message. * hexl.el (hexl-mode-map): When initializing, remember that the argument to key-binding is a key sequence, not a single key. * mouse.el (mouse-split-window-vertically): If the user clicks too close to the top or bottom of a window, split at the closest reasonable line. Give a helpful error message if the window is too small to be split anywhere. (mouse-split-window-horizontally): Similar changes. Sun Feb 28 01:27:39 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * simple.el (insert-buffer): Make sure this returns nil. * simple.el (quoted-insert): Use insert-char, instead of writing out the loop. * etags.el (find-tag-other-window): If another window is already displaying the tag's buffer, explicitly set that window's point to the tag's position. Use the term `scroll bar', instead of `scrollbar'. * term/x-win.el, frame.el, mouse.el: Terminology changed. * scrollbar.el: Renamed to scroll-bar.el. Fri Feb 26 15:48:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.el (auto-raise-mode): Renamed from toggle-auto-raise. (auto-lower-mode): Renamed from toggle-auto-lower. Fri Feb 26 02:22:26 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * timer.el (run-at-time): Doc fix. * autoload.el (generate-file-autoloads): Add another save-excursion so that point is before the generated autoloads after we scan the file. Thu Feb 25 01:38:33 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * add-log.el (add-change-log-entry): Find end of first paragraph from after the header line. * subr.el (walk-windows): Doc fix. * register.el (point-to-register): Make arg ARG optional. (window-configuration-to-register): Likewise. (frame-configuration-to-register): Likewise. Wed Feb 24 19:36:06 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these functions to scrolbar.el. * scrollbar.el (scroll-bar-mode, scroll-bar-mode): Here they are. Make scroll-bar-mode set the {vertical,horizontal}-scrollbars parameters in default-frame-alist, and modify all extant screens using the correct parameter names. Wed Feb 24 13:03:57 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc-hooks.el (vc-find-file-hook): Discard vc status of file if we will actually have to create the buffer. Mon Feb 22 03:18:59 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * gud.el (gud-break): With a prefix argument, set a temporary breakpoint. (gud-apply-from-source): New argument ARGS, to pass to FUNC. Now it's really like `apply'. (gud-set-break): Add another argument to this method. Document it in the section describing how the methods are supposed to be used. (gud-gdb-set-break): New argument TEMP; if non-nil, set a temporary breakpoint. (gud-sdb-set-break, gud-dbx-set-break): New argument TEMP. Ignore it, since I don't know how to set a temporary breakpoint in these debuggers. * subr.el (string-to-int): Make this an alias for string-to-number. Sun Feb 21 17:16:50 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * two-column.el: Add autoloads for the functions defined in tc-mode-map. Sun Feb 21 01:28:49 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * info.el (Info-insert-dir): New function. (Info-find-node): Use Info-insert-dir to visit dir file. * mlsupport.el (esc-map, ctl-x-map): Define as functions. Sat Feb 20 01:22:56 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * apropos.el (super-apropos-check-doc-file): Look for DOC file in proper directory. * files.el (insert-directory): Doc fix. Fri Feb 19 00:05:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * help.el (describe-function): Print the arglist if the function is bytecode or a list. Wed Feb 17 21:23:39 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * files.el (revert-buffer): Reverse the sense of the first argument, but leave interactive usage the same. * vc.el (vc-resynch-window): Call vc-revert-buffer1 with the newly appropriate arguments. This seems to be the only file which was adjusted for the new meaning of the revert-buffer arguments. Wed Feb 17 16:30:21 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * autoload.el (generate-file-autoloads): If no buffer was visiting FILE when we started, kill the buffer we create. Wed Feb 17 15:31:57 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch-mode.el (isearch-backward-regexp): New arg no-recursive-edit, always non-nil for interactive call. Rename first arg, and set it right in interactive call. (isearch-forward-regexp): Likewise. (isearch-forward, isearch-backward): Likewise no-recursive-edit. Tue Feb 16 01:33:55 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.el (frame-initialize): Fix error syntax. (toggle-horizontal-scroll-bar): Likewise. (toggle-horizontal-scroll-bar): Renamed from set-horizontal-bar (toggle-vertical-scroll-bar): Likewise. (toggle-auto-lower, toggle-auto-raise): Likewise. (set-foreground-color, set-background-color): Renamed from set-frame-{fore,back}ground. Mon Feb 15 19:22:00 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * informat.el (Info-tagify): Change the regular expression which recognizes node names to work properly with Emacs 19's regexp semantics. Mon Feb 15 02:42:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (find-file-hooks): Delete permanent-local property. (find-file-not-found-hooks): Likewise. * bytecomp.el (byte-compile-lambda): Test of byte-compile-compatibility was backwards. Fri Feb 12 17:16:14 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * gosmacs.el: Bind M-h to delete-previous-word, not backward-kill-word; the latter has different prefix semantics. * frame.el: Clean up initialization code. (initial-frame-alist): Doc fix. (minibuffer-frame-alist): New default value, with a reasonable height. (filtered-frame-list, minibuffer-frame-list): New functions. (frame-initialize): Use minibuffer-frame-list, instead of writing it out. (frame-notice-user-settings): Thoroughly rearranged. Notice changes to default-frame-alist as well as initial-frame-alist. Properly handle requests to make the initial frame into a minibufferless or minibuffer-only frame. Create a minibuffer-only frame if the initial frame should lack a minibuffer and there are no other minibuffer frames created by the user's initialization file. Fix any frames using the initial frame as a surrogate minibuffer frame. Restore the current buffer after creating and deleting all these frames. * frame.el (set-default-font, set-frame-background, set-frame-foreground, set-cursor-color, set-pointer-color, set-auto-raise, set-auto-lower, set-vertical-bar, set-horizontal-bar): Give these docstrings. (set-auto-raise, set-auto-lower, set-vertical-bar, set-horizontal-bar): Make these toggle or look at the prefix argument, like minor modes. * frame.el (set-vertical-bar): Use the proper parameter symbol. (set-horizontal-bar): Signal an error indicating that horizontal scrollbars are not implemented. * lisp-mode.el (lisp-fill-paragraph): New function. (shared-lisp-mode-map): Bind M-q to lisp-fill-paragraph. Thu Feb 11 18:31:38 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * flow-ctrl.el (enable-flow-control...): Renamed from evade... (enable-flow-control): Add autoload. Wed Feb 10 01:45:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gosmacs.el (set-gosmacs-bindings): Fix binding of \eh. Wed Feb 10 01:16:56 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * gosmacs.el: Require 'mlsupport, to get definition of backward-kill-word. Wed Feb 10 00:11:57 1993 Stephen A. Wood (saw@cebaf.gov) * fortran.el (fortran-prepare-abbrev-list-buffer): Put quote in front of first argument to `insert-abbrev-table-description'. * fortran.el (fortran-is-in-string-p): Fixed incorrect behaviour when in first statement of a buffer. Mon Feb 8 17:25:34 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * add-log.el (add-change-log-entry): Undo Jan 25 change. It worked for buffers in indented-text-mode, but lost for change-log-mode, which is what matters. Mon Feb 8 15:32:57 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-forget-errors): Just set compilation-directory-stack to nil; no need to loop through it. (next-error): For a non-numeric prefix arg, pass nil for compile-reinitialize-errors's FIND-AT-LEAST arg. (next-error): When getting marker for error source location, be sure to examine buffer local value of compilation-old-error-list before switching to source file buffer. Mon Feb 8 12:03:00 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * rmailout.el (rmail-output, rmail-output-to-mail-file): Reverse the order of the arguments and make COUNT optional, for backward compatibility's sake. * cl.el (cl-version): Mark as no longer in beta test. Sun Feb 7 21:36:06 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * subr.el (mod): Add back this alias for %. Sun Feb 7 00:50:20 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sort.el (sort-build-lists): Record the key as pair of positions; don't copy string from buffer. (sort-subr): Use compare-buffer-substrings. Sat Feb 6 20:11:21 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-setup): Use fill-region-as-paragraph for To field; handle the CC just like the To. * rmailsum.el: Big rewrite from weiner@pts.mot.com. Fri Feb 5 13:28:05 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * comint.el (make-comint): Added docstring. Fri Feb 5 12:41:42 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * simple.el: Restore nuked information in minibuffer history bindings. Use intelligent method of disabling completion-oriented bindings. Thu Feb 4 21:05:09 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el: Once again, go back to ordinary next-history-element for M-n in minibuf, even for completion. Tue Feb 2 15:22:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sort.el (sort-subr): Doc fixes. * sendmail.el (mail-do-fcc): Allow dash in timezone name. Mon Feb 1 17:18:22 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * texinfo.el (texinfo-mode): Make page-delimiter buffer-local, and set it according to texinfo-chapter-level-regexp. * simple.el (kill-region): If the buffer is read-only, do beep, but also put the region in the kill ring. Doc fix. Sun Jan 31 15:48:19 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * mailabbrev.el (mail-abbrev-end-of-buffer): Changed interactive spec from "P" to "p". Fri Jan 29 22:42:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cmacexp.el (c-macro-expand): Use expanded name to write or delete. Send two eofs. Thu Jan 28 15:22:10 1993 Roland McGrath (roland@wookumz.gnu.ai.mit.edu) * simple.el (next-complete-history-element): Restore point after replacing the buffer text with the appropriate history element. Thu Jan 28 01:14:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el: Don't use the completion-oriented history commands. * paths.el (sendmail-program): Try /usr/ucblib/sendmail. Tue Jan 26 01:26:58 1993 Jim Blandy (jimb@mole.gnu.ai.mit.edu) * term/x-win.el: x-selection-value has been renamed to x-selection. x-own-selection has been renamed to x-set-selection, and the order of its arguments has been reversed, for consistency with other lisp functions like put and aset. * term/x-win.el (x-select-text): Adjusted. (x-cut-buffer-or-selection-value): Check the primary selection, using x-selection, instead of checking the cut buffer again. * term/x-win.el: Doc fix. Mon Jan 25 12:08:05 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * frame.el (frame-notice-user-settings): Use new name frame-live-p, instead of live-frame-p. x-selection-value has been renamed to x-selection. x-own-selection has been renamed to x-set-selection, and the order of its arguments has been reversed, for consistency with other lisp functions like put and aset. * term/x-win.el (x-select-text): Adjusted. (x-cut-buffer-or-selection-value): Check the primary selection, using x-selection, instead of checking the cut buffer again. * disass.el (disassemble): Add autoload cookie for this. * bytecomp.el (byte-decompile-bytecode): Add an autoload for this. compiled-function-p has been renamed to byte-code-function-p. * subr.el: Define compiled-function-p as an alias for it. * bytecomp.el: Register compiled-function-p as obsolete. * bytecomp.el, byte-opt.el, disass.el, help.el, map-ynp.el: Change uses. * subr.el (numberp): Remove fset which made this an alias for integerp; now numberp also recognizes floats. Mon Jan 25 12:04:33 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (tags-query-replace): C-t. * add-log.el (add-change-log-entry): Restrict PARAGRAPH-END to being on the first page. * simple.el (next-complete-history-element): Use only buffer contents before point to match history elements. Sun Jan 25 19:45:01 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * simple.el ({next,previous}-complete-history-element): New functions. Bind them to M-n/M-p and next/prior in minibuffer completion maps. Sun Jan 24 16:14:04 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) unread-command-event has been replaced by unread-command-events. * simple.el (prefix-arg-internal): Use this to push back all key sequences for processing by the main command loop, instead of trying to simulate its behavior ourselves. * bytecomp.el: Document unread-command-event as an obsolete variable, although nothing but the GNU Emacs 19 sources use it. Adjust obsolescence message for unread-command-char. * comint.el (comint-dynamic-list-completions): Change uses of unread-command-event to work with unread-command-events. * ebuff-menu.el (electric-buffer-list, Electric-buffer-menu-exit): Same. * edebug.el (edebug-outside-excursion): Same. * ehelp.el (electric-help-command-loop): Same. * electric.el (Electric-command-loop): Same. * emerge.el (emerge-show-file-name): Same. * fortran.el (fortran-abbrev-start, fortran-window-create-momentarily): Same. * gnus.el (gnus-Subject-next-article): Same. * info.el (Info-summary): Same. * isearch-mode.el (isearch-update, isearch-unread): Same. * map-ynp.el (map-y-or-n-p): Same. * mlsupport.el (push-back-character): Same. * replace.el (perform-replace): Same. * simula.el (simula-electric-label): Same. * subr.el (read-quoted-char, momentary-string-display): Same. * sun-mouse.el (mouse-second-hit): Same. * terminal.el (te-escape-extended-command-unread): Same. * vip.el (vip-escape-to-emacs, vip-prefix-arg-value, vip-prefix-arg-com): Same. * simple.el (quoted-insert): Doc fix. Sat Jan 23 03:11:03 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * mouse.el (mouse-save-then-kill): Instead of deleting the text whenever the text of the region happens to be the same as the front of the kill-ring, delete it only when the front of the kill ring is identical to the last text we put there, and point and the mouse click are at the same position. * mouse.el (mouse-save-then-kill): If the undo list is disabled, don't build an undo record. * mouse.el (mouse-save-then-kill): If we're deleting the text, kill from point to the mouse click, not from point to mark; mark and the mouse click may not be the same. If they're not, this screws up the undo record we create, corrupting the undo list pretty nastily. Fri Jan 22 01:00:05 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * term/x-win.el: Doc fix. * mouse.el (mouse-set-font): Account for the fact that x-popup-menu returns nil if no selection is made. * mouse.el (mouse-buffer-menu, mouse-set-font): Bind these to the down-going events. (mouse-split-window-vertically): Move the binding for this down out of the commented-out scrollbar section, so it is on S-mouse-2 on the mode line. Thu Jan 21 22:37:11 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * c-mode.el (c-fill-paragraph): Fix the regular expressions used for finding paragraph beginnings and endings so that they think lines containing only whitespace and asterisks are paragraph separators/starters. * add-log.el (add-change-log-entry): If we've just started a new date, limit the searches to within the current date, not the first paragraph; the latter extends into the previous date. Thu Jan 21 17:37:04 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * etags.el (tags-loop-scan): Set default value to an error form. * etags.el (visit-tags-table-buffer): When propagating a change of name after file-find-noselect, refer to tags-file-name, not the undefined var FILE. Wed Jan 20 15:01:27 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * c-mode.el (c-fill-paragraph): When modifying the paragraph-separate regexp, don't let it match paragraph starts. Tue Jan 19 16:05:15 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * etags.el (visit-tags-table-buffer): Error if called with 'same and no current table. Tue Jan 19 15:15:15 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * mouse.el (event-end): Work on click events, too. (mouse-split-window-vertically): Use event-end and posn-col-row, instead of mouse-coords, which is obsolete. * mouse.el: Comment out the scrollbar commands until we make them work. * mouse.el: Comment out jla's experimental things. What are these doing in the distribution source anyway? * mouse.el: Bind the help menu to C-down-mouse-2, instead of C-mouse-2; this way, you can use the mouse-up event to make the menu selection. (help-apropos-map, help-keys-map, help-manual-map, help-misc-map, help-modes-map, help-admin-map): Give the menu names for these keymaps using make-sparse-keymap's optional argument, rather than constructing them by hand. * scrollbar.el: (require 'mouse) (scrollbar-set-window-start, scrollbar-scroll-down, scrollbar-scroll-up): Use event-end, from mouse.el. Tue Jan 19 15:10:39 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * x-mouse.el: Deleted; it was the interface to the Emacs 18-style mouse interface, which doesn't exist anymore. Fri Jan 15 07:48:49 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * c-mode.el (c-switch-label-regexp): New constant. (electric-c-terminator, c-indent-line, indent-c-exp): Use it to correctly recognize default labels in switch statements. Fri Jan 15 02:00:19 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * shell.el (shell): Doc fix. Thu Jan 14 16:26:21 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * files.el (switch-to-buffer-other-frame): Pass t to pop-to-buffer. Thu Jan 14 03:35:40 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * scrollbar.el: New file. * term/x-win.el: Require 'scrollbar. Wed Jan 13 10:36:59 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * solar.el (solar-time-string): Round the time properly. Tue Jan 12 20:30:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-save-then-kill): When deleting, avoid delay and don't set the mark. Replace obsolete fn event-point. (mouse-kill): Replace obsolete fn event-point. Mon Jan 11 22:15:22 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * page-ext.el (next-page): Correctly handle negative page count. Mon Jan 11 00:10:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (kill-append): Doc fix. Sat Jan 9 23:11:03 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * frame.el (frame-notice-user-settings): Don't try to delete the initial frame if the user took care of that. Sat Jan 9 08:52:19 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (mail-unsent-separator): Add `-- begin message --'. * dired.el (dired-regexp-history): New history list. (dired-read-regexp): Use that history list. Take just one arg. * dired-aux.el (dired-mark-read-regexp): Give dired-read-regexp 1 arg. Sat Jan 8 19:01:00 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * upd-copyr.el (update-copyright): Doc fix. Fri Jan 8 16:12:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * add-log.el (add-change-log-entry): Search for existing ChangeLog in parent dir and its parents. Fri Jan 8 15:28:41 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * timer.el (run-at-time): Use a pipe to talk to the timer process. Thu Jan 7 16:27:43 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * simple.el (set-goal-column): Make this disabled by default. Thu Jan 7 05:18:23 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-send): Don't clear modified or delete autosave if visiting a file. Tue Jan 5 23:40:18 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * hippie.el: New file. Mon Jan 4 06:35:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * apropos.el (apropos-match-keys): Handle non-chars as keys. Sat Jan 2 16:20:41 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * compile.el (compilation-sentinel): Change buffer-read-only with let. Tue Dec 29 16:06:31 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-buffer-menu): Select the window clicked on. Tue Dec 28 20:07:26 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * add-log.el (add-change-log-entry): Notice when ENTRY is equal to FILE-NAME, not the hard-wired string "ChangeLog". Added missing regexp-quote's in same-day entry search. Search only in the first paragraph for a similar entry to add to. Sat Dec 26 03:46:03 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (abbreviated-home-dir): New variable. (abbreviate-file-name): Properly convert abbreviated homedir to ~. Thu Dec 24 17:42:05 1992 Roland McGrath (roland@albert.gnu.ai.mit.edu) * etags.el (visit-tags-table-buffer): When picking a table and using tags-table-list, skip over nonexistent files in the list. * etags.el (etags-verify-tags-table): Use eq instead of = in case char-after returns nil. Mon Dec 21 14:13:11 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * etags.el (visit-tags-table-buffer): Don't look in list for tags-file-name if nil. * etags.el: Many comments added and docstrings fixed. (tags-table-list): Elt of nil is not special. (tags-expand-table-name): Value of nil is not special. (tags-next-table): Removed arg RESET; no caller used it. (visit-tags-table-buffer): Don't need to do tags-expand-table-name in or form. When table is invalid, only set tags-file-name to nil globally if its global value contained the losing table file name. (find-tag-tag): Return a string, not a list. (find-tag-noselect, find-tag, find-tag-other-window, find-tag-other-frame): Changed callers. (etags-recognize-tags-table): Call etags-verify-tags-table, rather than duplicating its functionality. (visit-tags-table-buffer): When CONT is 'same, set it to nil after the cond. We want the normal list frobbing to take place in this case. (find-tag-other-window): Save and restore window-point around call to find-tag-noselect. Mon Dec 21 13:34:22 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * subr.el (ignore): Use defun instead of fset to define; the byte compiler is smart enough now not to compile this trivial function into slow byte code. Mon Dec 21 02:59:00 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * c-mode.el (c-fill-paragraph): Calculating the proper fill-prefix shouldn't change the buffer text. Make it not. If we're in the blank space before another comment, fill that one as a comment, not as normal text. Sun Dec 20 14:30:41 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * simple.el (kill-region): Change interactive spec to signal an error if the buffer is read-only, and remove the code to do a copy-region-as-kill if the buffer is read-only. Sat Dec 19 15:53:30 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * loadup.el: Display load-path at start. Sat Dec 19 09:30:24 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * sendmail.el (mail-position-on-field): `end' is guaranteed to be at the beginning of the header separator; don't skip back to the end of the previous line. * loadup.el: Dump under the name `emacs', not `xemacs'. * compile.el (compilation-error-regexp-alist): Tightened up BSD/GNU regexp to insist that line number end with a colon or close-paren. Thu Dec 17 04:12:08 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * rmail.el (rmail-unix-mail-delimiter): Not all time zone names end with "T". Accept any sequence of three or four alphabetic characters. * simple.el (set-mark-command): Clarify doc string. * simple.el (prefix-arg-internal): Don't apply string-to-char to get the first element of the key sequence - it might be a vector. Tue Dec 15 18:56:21 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * c-mode.el (c-fill-paragraph): When guessing the fill prefix, don't ever grab any actual text. Mon Dec 14 11:15:11 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * compile.el (compilation-error-regexp-alist): Add regexp for the MIPS CC distributed with Ultrix. Sat Dec 12 03:22:57 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * paths.el (Info-default-directory-list): The info files are supposed to be in /usr/local/info these days. Add it to the list of directories to search. Fri Dec 11 01:19:11 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * vc.el (vc-do-command): Set the default directory of the *vc* buffer to the directory containing FILE. Wed Dec 9 17:30:20 1992 Roland McGrath (roland@wookumz.gnu.ai.mit.edu) * info.el (Info-{first,second,third,fourth,fifth}-menu-item): Removed. (Info-nth-menu-item): New function; bound to 1..9. Tue Dec 8 21:29:34 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) The find-file-name-handler function in ../src/fileio.c is now callable from lisp; use it instead of writing out its code. * dired-aux.el (dired-compress-file): Just that. * dired.el (dired-uncache): Just that. * files.el (file-local-copy, file-truename, file-name-sans-versions, make-directory, save-buffers-kill-emacs): Just that. * ls-lisp.el (insert-directory): Just that. * ange-ftp.el (ange-ftp-unhandled-file-name-directory): New function. Set ange-ftp's `unhandled-file-name-property' to its name. Mon Dec 7 20:10:32 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * lpr.el (lpr-switches, lpr-command): Make these defvars, not defconsts. Fri Dec 4 00:31:30 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * c-mode.el (c-fill-paragraph): When trying to make sure that the comment ender isn't on its own line, don't signal an error if there is no comment ender. Thu Dec 3 23:45:21 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * sendmail.el (mail-self-blind, mail-interactive, mail-yank-ignored-headers): Make these defvars, not defconsts. Otherwise, they wipe out the user's customizations when we autoload sendmail.el. Tue Dec 1 22:34:42 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * hanoi.el (hanoi): If pole-spacing is odd, round down, not up. To see if the window is wide enough, just check if one half of a ring will fit inside pole-spacing. Fri Nov 27 17:54:20 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * add-log.el (add-change-log-entry): Expand file-name again after chasing links. Fri Nov 20 14:33:20 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc.el (vc-next-action): Undo previous change. Thu Nov 19 16:44:24 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * vc.el (vc-next-action): Pass t as NOQUERY argument to vc-resynch-window here too. This means that all uses of vc-resynch-window pass t; I'm going to wait until I understand the situation better before I rip out the NOQUERY argument altogether. * vc.el (vc-revert-buffer1): Try to preserve the position of mark as well as point. (vc-position-context, vc-find-position-by-context): New functions to help with that, made out of the old innards of vc-revert-buffer1. Wed Nov 18 12:34:10 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * fortran.el: New version of version 1.30 (!) from Stephen A. Wood Tue Nov 17 00:22:09 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * fortran.el: New version (1.30) from "Stephen A. Wood" * subr.el (lambda): Doc fix. Sun Nov 15 02:17:04 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * simple.el (comment-column): Doc fix. Fri Nov 13 13:45:55 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * paths.el (rmail-spool-directory): Add dgux-unix to the list of systems which put their mail in "/usr/mail". * lpr.el (lpr-command, lpr-switches): Removed strings starting with \newline; this file is loaded in loaddefs.el, and doesn't need to follow that convention. * lpr.el (lpr-command): Add dgux-unix to the list of systems which want "lp". Thu Nov 12 02:53:21 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * bytecomp.el: Declare unread-command-char an obsolete variable. * vip.el (vip-escape-to-emacs, vip-prefix-arg-value, vip-prefix-arg-com): Use unread-command-event instead of unread-command-char; respect its new semantics. * simula.el (simula-electric-label): Same. * comint.el (comint-dynamic-list-completions): Same. * ebuff-menu.el (electric-buffer-list, Electric-buffer-menu-exit): Same. * ehelp.el (electric-help-command-loop): Same. * electric.el (Electric-command-loop): Same. * emerge.el (emerge-show-file-name): Same. * fortran.el (fortran-abbrev-start, fortran-window-create-momentarily): Same. * gnus.el (gnus-Subject-next-article): Same. * info.el (Info-summary): Same. * isearch-mode.el (isearch-update, isearch-unread): Same. * map-ynp.el (map-y-or-n-p): Same. * mlsupport.el (push-back-character): Same. * replace.el (perform-replace): Same. * simple.el (prefix-arg-internal): Same. * subr.el (read-quoted-char, momentary-string-display): Same. * sun-mouse.el (mouse-second-hit): Same. * terminal.el (te-escape-extended-command-unread): Same. * emerge.el (emerge-file-names): Use `temp-buffer-show-function', not `temp-buffer-show-hook'. (emerge-combine-versions-edit): Fix misarranged cond expression; the t is an `else' clause, not a function call in the preceeding clause. * simula.el (simula-calculate-indent): Call backward-word with the appropriate argument. * vip.el (vip-delete-char, vip-delete-backward-char, ex-delete): Don't pass nil as a fourth argument to vip-append-to-register; it takes only three. (vip-mark-point, ex-mark): Pass required second argument to point-to-register. * bytecomp.el: (require 'backquote). * subr.el (lambda): Don't use backquotes in lambda's definition. * disass.el (byte-compile): Specify that the 'byte-compile feature is provided in the file "bytecomp". Wed Nov 11 23:24:15 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * ange-ftp.el (ange-ftp-repaint-buffer): Give this a non-hacky definition using (message nil). (ange-ftp-read-passwd, ange-ftp-process-filter): Uncomment out the calls to ange-ftp-repaint-buffer. Wed Nov 11 15:18:12 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * c-mode.el (c-style-alist): Add quotes around C++ style name. Tue Nov 10 21:00:27 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * rect.el (operate-on-rectangle): Use move-to-column's FORCE argument instead of implementing it ourselves. (rectangle-coerce-tab): No longer used; deleted. * rect.el (open-rectangle): Leave point at the upper corner of the rectangle just opened, in imitation of open-line. Fix doc typo. (open-rectangle-line): Use skip-chars-backward's LIM argument to leave spaces before the line segment's beginning undisturbed. * rect.el: Provide 'rect. Sun Nov 8 13:58:00 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc.el (vc-cancel-version): Use yes-or-no-p. Fri Nov 6 23:05:17 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * startup.el (after-init-hook): Doc fix. Thu Nov 5 22:07:19 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * isearch.el (isearch-frames-exist): This isn't what we want - replaced by... (isearch-gnu-emacs-events): non-nil if should expect events in the style generated by GNU Emacs 19. Set if set-frame-height is fboundp; this is true on any GNU Emacs 19, whether or not it was compiled with multiple frame support. (isearch-mode-map): Test isearch-gnu-emacs-events instead of isearch-frames-exist to see if we should bind switch-frame events. (isearch-update): Test isearch-gnu-emacs-events instead of isearch-frames-exist to see if unread-command-char's quiescent value is nil or -1. * simple.el (previous-line): Doc fix. Thu Nov 5 09:58:13 1992 Stephen A. Wood (saw@cebaf.gov) * fortran.el version 1.28.8 (fortran-indent-to-column): Make turning of lines that begin with `fortran-continuation-string' into properly formated continuation lines work for fortran TAB mode. * fortran.el version 1.28.7a Cleaned up some doc strings. (fortran-abbrev-help, fortran-prepare-abbrev-list-buffer): Use `insert-abbrev-table-description' and make buffer in abbrevs-mode. * fortran.el version 1.28.7 Many changes since version 1.28.3. Added auto-fill-mode, support for some Fortran 90 statements. Adjust comments to conform to new gnu conventions. (fortran-mode): Fix `comment-line-start-skip' by changing \\1 to \\2 and include cpp statements in matching. Changes for auto fill. (fortran-auto-fill-mode, fortran-do-auto-fill, fortran-break-line): New functions to implement auto fill. (fortran-indent-line, fortran-reindent-then-newline-and-indent): Added auto fill support. (find-comment-start-skip, is-in-fortran-string-p): New functions. (fortran-electric-line-number): Works better in overwrite mode. (fortran-indent-comment, fortran-indent-line, fortran-indent-to-column): Use find-comment-start-skip instead of searching for `comment-start-skip'. (fortran-mode, calculate-fortran-indent): Added indentation for fortran 90 statements. (fortran-next-statement, fortran-previous-statement): Bug fixes. (fortran-mode, calculate-fortran-indent, fortran-setup-tab-format-style, fortran-setup-fixed-format-style): `fortran-comment-line-column' meaning changed. Now defaults to 0. Thu Nov 5 05:00:28 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el: (command-switch-alist, x-switch-definitions): -ib was used for two things. Use -itype for icon type. Wed Nov 4 23:58:42 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el (command-switch-alist, x-switch-definitions): -ib was used for two things. Use -itype for icon type. Wed Nov 4 01:44:17 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * term/x-win.el: Moved functions to support selections and cut buffers out from amidst the X initialization code. * simple.el (kill-line): Don't shift point before doing the delete. * startup.el (normal-top-level): Don't worry about setting default-directory to PWD if PWD is shorter. And, if PWD isn't accurate, delete it. Tue Nov 3 19:52:43 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * compile.el (compile-internal): Use NAME-OF-MODE in the prompt when offering to kill an existing process. * autoload.el (make-autoload): When creating an autoload invocation for a macro, pass (list 'quote 'macro) as the sixth argument, not just t. autoload's sixth argument is now a type instead of just a boolean value, so we should use a value which reflects that. * cl.el: New version - 3.0 - from Cesar Quiroz. * etags.el (find-tag-noselect): Doc fix. Tue Nov 3 03:46:41 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rect.el (insert-rectangle): Put mark at upper left corner. * dired-aux.el (dired-mark-confirm): For `compress', say `Compress or uncompress'. (dired-map-over-marks-check): Likewise. Sun Nov 1 17:07:52 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch-mode.el (isearch-search): Handle all sorts of errors from regexp search. Sat Oct 31 04:27:09 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (make-directory): Renamed from make-directory-path. Optional argument says whether to create parent dirs. Invoke file-name handler here. (after-find-file): Delete code that offers to create dir. Instead, just print a message. * bytecomp.el (byte-compile-lambda): Don't compile the interactive spec if it is a call to `list'. Fri Oct 30 22:34:45 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * ange-ftp.el: Tighten the regular expression used in file-name-handler-alist to recognized ange-ftp filenames; the slash, username and hostname must be at the start of the filename, not just anywhere in the filename. Fri Oct 30 00:37:54 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tabify.el: Doc fix. Wed Oct 28 01:03:50 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc.el (vc-admin): Pass t as noquery arg to vc-resynch-window. * paths.el (manual-program): Always use /usr/ucb/man if that exists. Tue Oct 27 03:47:32 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fortran.el (fortran-tab-mode): Add defvar. (fortran-analyze-file-format): Bind i. (fortran-tab-mode-string): Add defvar. (fortran-tab-mode): Use `arg' as variable, not as function. (fortran-prepare-abbrev-list-buffer): New function. (fortran-abbrev-help): Call that. (fortran-window-create): Use screen-width, not frame-width. * info.el: Rename buffer-flush-undo to buffer-disable-undo. (Info-goto-emacs-key-command-node): Fix typo. (Info-menu-item-sequence): Commented out. (Info-follow-nearest-node): Use new event format. Select the window clicked on. * vc.el (vc-log-file, vc-log-version): Declared. * simple.el (shell-command-on-region): Use region-beginning and region-end, in interactive spec. Mon Oct 26 23:11:12 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch-mode.el (isearch-edit-string): Bind cursor-in-echo-area only around read-char/allocate-event. Sat Oct 24 15:57:11 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc-hooks.el (vc-prefix-map): Put vc-diff on = and vc-directory on d. * vc.el (vc-resynch-window): New arg NOQUERY. Pass it to vc-revert-buffer1. (vc-checkout, vc-finish-logentry, vc-revert-buffer, vc-finish-steal): Supply t as NOQUERY arg for vc-resynch-window. (vc-next-action): Don't revert workfile from master if buffer is modified. Fri Oct 23 04:53:38 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (set-visited-file-name): Change the auto save file name. * macros.el (insert-kbd-macro): Replace nonprinting chars with escapes. If arg is empty, use last macro as default. * sendmail.el (mail-aliases): Doc fix. * help.el (describe-function): Print `an autoloaded', not `a ...'. * simple.el (goal-column): Don't put the defvar inside the make-variable-buffer-local. Wed Oct 21 00:50:11 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired.el (dired-chown-program): Treat silicon-graphics-unix like usg-unix-v. * rmail.el (rmail-mode-map): Delete binding of M-r (use global one). * lpr.el (lpr-command): Treat hpux and silicon-graphics-unix like usg-unix-v. * rmailout.el (rmail-output-to-rmail-file): Call abbreviate-file-name. * files.el: Doc fixes. Tue Oct 20 00:35:01 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (comment-region): Do move to next line, in neg arg case. * isearch-mode.el (isearch-mode-map): Make the top-level keymap dense. Explicitly bind control characters at that level. * files.el (file-truename): Check for root by seeing if directory-file-name returns same as DIR. Look for a file-truename handler for the file name. * vc-hooks (vc-registered): Look for a vc-registered handler. But only if file-name-handler-alist is bound. * ange-ftp.el: Add dummy handlers for file-truename and vc-registered. (ange-ftp-add-vms-host, ange-ftp-add-dl-dir, ange-ftp-add-mts-host): (ange-ftp-add-dumb-unix-host): Use default-directory, not dired-directory. (ange-ftp-allow-child-lookup): Eliminate dired-local-variables-file. * mailalias.el (mail-aliases): Add definition here. Mon Oct 19 18:37:46 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * add-log.el (add-log-current-defun): Add condition-case around the body, so at worst we return nil. Sun Oct 18 15:09:51 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * paragraphs.el (kill-sentence, backward-kill-sentence): (kill-paragraph, backward-kill-paragraph): Don't change point before calling kill-region. * sendmail.el (mail-setup): Call build-mail-aliases, not mail-abbrev-setup. (sendmail-send-it): Call expand-mail-aliases. * mailalias.el: Doc fixes. * mailabbrev.el: Delete version 18 compatibility stuff. (mail-abbrevs, build-mail-abbrevs, rebuild-mail-abbrevs): (merge-mail-abbrevs): Renamed `mail-aliases' to `mail-abbrevs'. (mail-abbrev-end-of-buffer): Renamed from abbrev-hacking-end-of-buffer. (mail-abbrev-next-line): Renamed from abbrev-hacking-next-line. * isearch-mode.el (isearch-mode-map): Use sparse keymaps. Start printing-char loop at SPC. * rmailsort.el (rmail-sort-messages): Give up right away if not Rmail mode. Sat Oct 17 21:06:20 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * replace.el (occur): Always search entire buffer. Sat Oct 17 17:34:47 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * mouse.el (mouse-tear-off-window): New function. Sat Oct 17 03:07:14 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-set-region): New command. Bind drag-mouse-1 to it. Thu Oct 15 03:17:47 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * telnet.el (telnet): Wait for telnet output before sending `open'. Wed Oct 14 12:29:09 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * files.el (file-truename): The variable ~ should be considered an absolute pathname; handle it correctly. Concatenate the directory onto the filename in the correct order. Tue Oct 13 15:48:28 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch-mode.el (isearch-mode-map): Bind t in top-level map and in the submap for meta keys. Don't bind the individual chars. Mon Oct 12 17:18:22 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * etags.el (visit-tags-table-buffer): When trying to pick table, call tags-expand-table-name on alternatives that might be nil. (tags-table-files): Don't call visit-tags-table-buffer; assume we are there. Mon Oct 12 00:52:04 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * picture.el (edit-picture): Run picture-mode-hook. Sat Oct 10 12:12:30 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * dired-aux.el (dired-compress-file): Change references to `from-file' to use `file'; the former only works because dired-compress-file is only called by dired-compress, which binds from-file. * rmail.el (rmail-mode): Make this autoload; we might find a file whose first line local variables want to put it in RMAIL mode; that ought to work. Sat Oct 10 02:13:18 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el (comint-last-input-match): defvar moved up. * files.el (buffer-file-number): New variable. (find-file-noselect): Record the file's filenum and devnum. Notify if any buffer has the same values. (basic-save-buffer): Save new filenum and devnum. For file-precious-flag, pass real name as VISIT arg of write-region. (set-visited-file-name): Likewise. Clear buffer-file-{number,truename} if now visiting no file. Fri Oct 9 01:29:03 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (mail-unsent-separator): Handle "Message text follows". * files.el (hack-one-local-variables): New subroutine. (hack-local-variables-prop-line): New function. (hack-local-variables): Use them both. (ignored-local-variables): New variable. * files.el (file-truename): New function. (find-file-noselect): Look for buffer with same truename. Warn about it; optionally find it. Set buffer-file-truename. (set-visited-file-name): Set buffer-file-truename. (buffer-file-truename): New var, permanent local in all buffers. (find-file-visit-truename, find-file-compare-truenames): New options. Thu Oct 8 02:14:14 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (mail-unsent-separator): Allow "original message" as alternative. Allow extra dashes and spaces. (rmail-retry-failure): Ignore case while searching for unsent sep. * add-log.el (add-log-current-defun): In normal C case, start with beginning-of-line. In last (fallback) case, start with end-of-line. (add-log-current-defun-header-regexp): In first alternative within the parens, don't allow space as last character. * cust-print.el (custom-prin1-chars): Var defined, and renamed from prin1-chars. (circle-tree, circle-table): Define vars. (cust-print-vector, cust-print-list): Rename level to circle-level. (cust-print-top-level): Likewise. (circle-level): Var defined. * cmuscheme.el (inferior-scheme-filter-regexp): Move definition of this var up before first use. (scheme-buffer): Define variable. * cmulisp.el (cmulisp-mode): Eliminate compatibility code calling lisp-mode-variables with no arg. (cmulisp-mode-map): Use shared-lisp-mode-map as tail. (cmulisp-args-to-list): Fix typo in recursive call. (cmulisp-buffer): Define variable. * files.el (hack-local-variables): Ignore attempts to bind enable-local-eval. Wed Oct 7 04:59:09 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cust-print.el: CP:: changed to cust-print- in all names. Lots of doc fixes. Tue Oct 6 01:12:33 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * add-log.el (add-log-current-defun): Catch errors checking for DEFUN. Mon Oct 5 16:53:41 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc.el (vc-steal-lock): Use mail-setup, and do like `mail'. Supply vc-finish-steal as an action on sending. (vc-finish-steal): Delete the code to send the message. (vc-backend-steal): Put filename after options in rcs commands. Delete the workfile after the rcs -M -u. Mon Oct 5 16:33:46 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * rmail.el (rmail-first-unseen-message): Don't show the message, just return its number, if there was an unseen message. (rmail): Check for unseen messages before calling rmail-get-new-mail. After getting the new mail, call rmail-show-message to show the pre-existing unseen message, or if that is nil, the current message, which rmail-get-new-mail sets to the first new message. Mon Oct 5 06:15:05 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch-mode.el (isearch-ring-advance-edit): Delete spurious `)'. * info.el (Info-restore-point): Delete duplicate definition. Mon Oct 5 05:49:27 1992 Roland McGrath (roland@albert.gnu.ai.mit.edu) * vc.el (vc-backend-checkin): Change buffers to get local value of vc-checkin-switches. * vc.el (vc-backend-checkin): Use apply on vc-do-command: vc-checkin-switches is a list. Mon Oct 5 05:17:21 1992 Roland McGrath (roland@albert.gnu.ai.mit.edu) * vc.el (vc-checkin-switches): New defvar. (vc-backend-checkin): Pass vc-checkin-switches to prog. Mon Oct 5 00:12:51 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ls-lisp.el (insert-directory): Renamed from dired-ls. All other functions renamed to start with ls-lisp. * ls-lisp.el: New file from Kremer. Sun Oct 4 00:08:59 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fill.el (fill-paragraph): Don't actually change point before calling fill-region-as-paragraph. (fill-region-as-paragraph): Save point on undo list at start. Sat Oct 3 23:44:31 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (insert-buffer): Before reading arg, barf if read-only. Sat Oct 3 03:01:25 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * mouse.el: Begin adapting this to the new event format. (event-window, event-point, mouse-coords, mouse-timestamp): Removed. (event-start, event-end, posn-window, posn-point, posn-col-row, posn-timestamp): New accessors; these are defsubsts. (mouse-delete-window, mouse-delete-other-windows, mouse-split-window-vertically, mouse-set-point): Rewritten to use the new accessors. * mouse.el: Remove hack of binding down-mouse-1. * mouse.el (mouse-movement-p): Add docstring for this. Fri Oct 2 22:21:12 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (open-line): Shield undo from the hack to insert at pt-1. Thu Oct 1 20:31:53 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * man.el (nuke-nroff-bs): 4 lines after header was 1 too many. Likewise for 10 before the header. Thu Oct 1 02:00:41 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * compile.el (compilation-parse-errors): Save (match-beginning 0) in a variable, so the looking-at call doesn't clobber its value when we want to use it to back up before the error we discard. Make sure compilation-error-list is at least two elts long before checking its first two elts for being in the same file. Wed Sep 30 06:30:31 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (kill-word): Don't change point before calling kill-region. (delete-indentation): Don't go beyond eob, comparing with fill-prefix. Wed Sep 30 04:36:39 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * gud.el (gud-last-frame): Added defvar for this. Tue Sep 29 22:12:49 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * info.el (Info-follow-nearest-node): Handle line breaks after *note. Fix interactive spec. Doc fix. Put on mouse-3. Wed Sep 30 01:45:47 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * compile.el (compilation-parse-errors): After we get enough errors to stop early, toss the last one (which is for a different file), so we don't lose the same way on the next run. Tue Sep 29 23:59:26 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * compile.el (compilation-parse-errors): When we reach FIND-AT-LEAST errors, keep going until we have seen all the consecutive errors in the same file. Tue Sep 29 14:14:01 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-send-and-exit): Do other-buffer before bury-buffer. * rmail.el (mail-unsent-separator): Add another alternative. Tue Sep 29 02:09:01 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * term/x-win.el (x-select-text, x-cut-buffer-or-selection-value): Use x-get-cut-buffer and x-set-cut-buffer, instead of expecting x-selection-value to manipulate the cut buffers. * term/x-win.el (x-cut-buffer-or-selection-value): Treat selections whose value is the empty string like unset selections. This allows us to truncate cut buffers to the empty string (if the text is too large, say) without causing interprogram-paste-function to wipe out the latest kill. * gud.el: When we send a command to the debugger via gud-call, it's annoying to see the command and the new prompt in the debugger interaction buffer; nuke the command and the old prompt. (gud-delete-prompt-marker): New variable, with extensive documentation. (gud-mode): Make gud-delete-prompt-marker buffer-local, and initialize it. (gud-filter-insert): If gud-delete-prompt-marker is set, delete the prompt, and clear gud-delete-prompt-marker. (gud-call): Arrange for the last prompt printed to get deleted, by setting gud-delete-prompt-char. * gud.el (gud-def): Doc fix. (gud-gdb-marker-filter, gud-sdb-marker-filter, gud-dbx-marker-filter): Rename the argument `s' or `str' to `string', and change all uses; these definitions were referring to `string', which is unbound in the lexical context, but which happens to end up being bound to the right thing by the caller, gud-filter. (sdb): Set comint-prompt-regexp, not comint-prompt-pattern; the latter doesn't exist. (gud-dbx-debugger-setup): Use the argument `f', not the variable `file', which happens to be bound in the caller. (gud-filter-insert): The variable `start' is never used. The variable `moving' is unnecessary. The variable `old-buffer' and the unwind-protect form are unneeded, since save-excursion can do their work. The binding of output-after-point should be done after switching to the process's buffer, not in whatever random buffer happens to be current when the process filter is called. There's no need to set the process mark if we've just inserted at its location using insert-before-markers. (gud-read-address): Don't bother setting the variable `result'; it is never used. Mon Sep 28 08:34:47 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ange-ftp.el (ange-ftp-kill-ftp-process): Delete spurious ". * files.el (file-relative-name-1): New function split out. (file-relative-name): Use it. * timer.el (timer-process-sentinel): Don't set timer-scratch. * ws-mode.el (ws-mark-word): Use forward-word, with an arg, instead of backward-word. (wordstar-mode): Move after definition of keymap. (ws-move-block): Just two args for kill-region. * vc.el (vc-rename-file): Use OLD, not FILE which is unbound. * two-column.el: Use frame-width instead of screen-width. Mon Sep 28 01:27:56 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * map-ynp.el: Use (function ...) around lambdas, so it works in v18. Sun Sep 27 02:42:08 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * vc.el (vc-update-change-log): Use file-relative-name. Sun Sep 27 02:40:49 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * files.el (file-relative-name): Rewritten so unrelativizable file names win. Sun Sep 27 02:27:00 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * files.el (file-relative-name): Don't lose when DIRECTORY is nil. * files.el (file-relative-name): New function. Sun Sep 27 01:51:04 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * vc.el (vc-checkin-hook): New user hook variable. (vc-log-after-operation-hook): New internal defvar. (vc-checkin): Set vc-log-after-operation-hook to 'vc-checkin-hook. (vc-finish-logentry): (run-hooks vc-log-after-operation-hook) at end. (vc-update-change-log): When doing all visited files, remove directory names from file names that are in default-directory. * vc.el (vc-update-change-log): Use shell-command, not shell-command-on-region. Take optional args to pass to script. Add fancy interactive spec: C-u for current file only; M-0 for all visited. Sun Sep 27 01:24:00 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * find-dired.el: New version from sk. Changed copyright owner to FSF, and updated year. (find-grep-dired): Use ! -type d, not -type f. Sun Sep 27 00:45:57 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * vc-hooks.el (vc-toggle-read-only): Doc fix. (vc-mode-line): Add interactive spec. Sat Sep 26 03:51:54 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * two-column.el (tc-window-width, tc-separator, tc-other): Add permanent-local property. (tc-two-columns): Renamed from tc-split. (tc-split): Renamed from tc-unmerge. Put it on C-x 6 s. Use make-local-variable on tc-separator. * spook.el (spook): Make it autoload. * gomoku.el (gomoku): Make it autoload. * mpuz.el: Fix setup of mpuz-read-map not to depend on keymap format. (mpuz): Renamed from mult-puzzle. Make it autoload. * setenv.el (setenv): Doc fix. Make it autoload. * diff.el (diff): Don't print echo area message. (diff-parse-differences): Always add `done' to message, at end. New local num-loci-found counts the loci. * mouse.el (mouse-split-window-vertically): Use @. (mouse-split-window-horizontally): New command. Use S-mouse-2 for them. (mouse-delete-window): Put on mode-line mouse-3. (mouse-save-then-kill): New command, on mouse-3. (mouse-delete-other-windows): Use @. Now on mode-line mouse-1. (mouse-scroll-down, mouse-scroll-up): Use e, get line from event. (mouse-scroll-move-cursor): Likewise. (mouse-scroll-left, mouse-scroll-right): Likewise for column. (mouse-scroll-move-cursor-horizontally): Likewise. Thu Sep 24 03:22:29 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (after-find-file): New arg NOAUTO. (revert-buffer, recover-file): Pass t for that arg. Wed Sep 23 15:34:53 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * cal-mayan.el (calendar-print-mayan-date): Fix conversion in output message. Wed Sep 23 00:18:25 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * c-mode.el (calculate-c-indent): When testing for function-start line, always match the first paren if have more than one. Mon Sep 21 03:46:20 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vms-pmail.el: New file. * texinfo.el (texinfo-mode): Capitalize the mode name string. * mail-extr.el (mail-undo-backslash-quoting): Renamed from undo-... (mail-safe-move-sexp): Renamed from safe-... (mail-variant-method): Renamed from variant-method. * tq.el: Doc fixes. Make tq-create autoload. * keypad.el: File deleted (obsolete). * setenv.el (setenv): Add interactive spec. Use \\` for string beg. Improve error message. * isearch-mode.el (isearch-other-meta-char): Use isearch-unread. Support `edit' as search-exit-option. * recompile-startup.el: File deleted. * at386.el: Deleted from here; latest version moved into term. * c-mode.el (calculate-c-indent): When checking for DEFUN macro, stop moving down if reach eob. Sun Sep 20 15:06:52 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * prompt.el: File deleted. * find-dired.el (start-process-shell-command): Deleted. * diff.el (diff-switches): Default is now -c. (diff-parse-differences): Use line beg as location of message. * c-mode.el (calculate-c-indent): When checking for DEFUN macro, stop moving down at line with # or /. (c-fill-paragraph): Set first-line whenever we find a comment start on the current line. Protect text before the comment start by excluding it from the region and adding spaces to bring back proper indentation of that point. Sat Sep 19 01:58:01 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ange-ftp.el (ange-ftp-generate-anonymous-password): Default now t. ??? This file is waiting for papers from several people. * vms-patch.el (vms-command-line-again): New function. (vms-pmail-setup): Autoload added here. (vms-suspend-resume-hook): Handle envvars EMACS_COMMAND_ARGS and EMACS_FILE_LINE. * dired.el (dired-view-file, dired-up-directory): Test that dired-subdir-alist has more than one element, to use dired-goto-subdir. (dired-goto-file, dired-clean-up-after-deletion): Likewise. (dired-mark): Likewise, before dired-get-subdir. (dired-subdir-max): Likewise, before dired-next-subdir. * isearch-mode.el (isearch-done): Do push on ring if ring is empty. (isearch-edit-string): Get default from search ring. Don't set the default here. (search-last-string, search-last-regexp): Vars deleted. (search-highlight): No longer a user option. * subr.el (baud-rate): Defined. (substitute-key-definition): Understand today's keymap format. New arg OLDMAP. Operate recursively on prefix keys. * rmail.el (rmail-insert-inbox-text): Make the inbox file empty here if we rename it with rename-file here. (rmail-get-new-mail): Always try deleting the files in delete-files. Fri Sep 18 02:58:14 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lisp-mode.el (eval-last-sexp): Narrow before reading so don't read past point. * isearch-mode.el (isearch-mode): Change back to (baud-rate). * rmail.el (rmail-get-new-mail): Truncate inbox file if we fail to delete it, or if it's not in the ordinary mail spool dir. Thu Sep 17 15:50:30 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * c-mode.el (calculate-c-indent): When checking for DEFUN macro, stop moving down at line with open-brace or close-brace. * ange-ftp.el (ange-ftp-file-name-as-directory): Fix typo. Thu Sep 17 14:31:04 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * gud.el (gud-mode-map): Bind gud-refresh to C-c C-l, not C-c l; the latter is reserved for the user's purposes. Wed Sep 16 21:27:17 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * isearch-mode.el (isearch-ring-advance-edit): added missing closing paren to end of this function. Wed Sep 16 20:45:04 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * rmail.el (rmail-insert-inbox-text): Avoid "Getting mail from" message for zero-length files. Tue Sep 15 17:04:49 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * term/x-win.el: Bind M-next to scroll-other-window. * etags.el (visit-tags-table-buffer): Only return nil if (null tags-table-list-pointer) when CONT is t, not anything non-nil. * etags.el (tags-apropos): Pass arg to tags-apropos-function. * mailabbrev.el: Delete comment about needing papers. We have them. * etags.el (tags-apropos): Start FIRST-TIME as t, not nil. Set it to nil inside the loop. Tue Sep 15 03:21:44 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (previous-history-element): Doc fix. * isearch-mode.el (isearch-event-data-type): Renamed from isearch-events-exist. (isearch-frames-exist): Set properly in Emacs 18. (isearch-mode): Use baud-rate as variable, not function. (isearch-abort): Use nil as 2nd arg to `signal'. (isearch-ring-advance-edit, isearch-ring-retreat-edit): Fns deleted. (isearch-ring-adjust-edit): Fns deleted. (isearch-done): Add new string to ring unless matches newest elt. Don't update the yank pointers. (isearch-repeat): Always use newest elt of ring. (isearch-mode): Set *search-ring-yank-pointer to nil. (isearch-edit-string): Set cursor-in-echo-area to nil after read-char. Use read-from-minibuffer and specify a ring as history. (*search-ring-yank-pointer): Value now integer or nil. (isearch-ring-adjust1): Modify yank pointer usage accordingly. Mon Sep 14 20:10:28 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * dabbrev.el: Change provide to 'dabbrev from 'dabbrevs. * etags.el (find-tag-noselect, next-file, list-tags, tags-apropos): Call visit-tags-table-buffer with nil, not 'reset. (tags-expand-table-name): New function. (tags-table-list-member): New function. (tags-next-table): New function. (visit-tags-file): Folded into visit-tags-table-buffer. (tags-table-list-started-at): New defvar. (visit-tags-table-buffer): Rewritten. No longer groks 'reset arg. For 'same, just expand tags-file-name. For t, use tags-next-table, and skip over nonexistent files. Use tags-table-list-member to search lists. Set tags-table-list-started-at. (visit-tags-table): Use (visit-tags-table-buffer 'same) in place of visit-tags-file. (tags-table-parent-pointer-list): Doc fix. (tags-table-including): New function, subr of visit-tags-table-buffer. Mon Sep 14 19:02:22 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * gud.el (gdb, sdb, dbx): Use C-c C-r ("resume") for continuing, instead of C-c C-c. C-c C-c should be comint-interrupt-subjob; it's important to have that available, and the C-c C-c binding is consistent with all the other comint-derived modes. Mon Sep 14 18:31:53 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch-mode.el: Add global key bindings. (isearch-mode-map): Use only define-key, not aset. Don't try using length of keymap. (isearch-update): Handle unread-command-char properly for Emacs 19. (isearch-switch-frame-handler): Use select-frame to switch frames. (isearch-pre-command-hook): Commented out. (search-upper-case): Renamed from search-caps-disable-folding. Mon Sep 14 14:41:54 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * etags.el (visit-tags-file): Return t iff tags file exists. (visit-tags-table): Error if file doesn't exist. (tags-next-table): New function, code broken out from visit-tags-table-buffer. (visit-tags-table-buffer): Use it. Skip over nonexistent files in the tags-table-list. (find-tag-in-order): When (not FIRST-SEARCH), call visit-tags-table-buffer with 'same, not nil. * etags.el (visit-tags-file): Check for file being a directory here. (visit-tags-table-buffer): Not here. (visit-tags-table): Or here. Mon Sep 14 01:54:25 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-retry-failure): Bind off mail-signature and mail-setup-hook. (rmail-forward): Likewise. * loaddefs.el: Added autoloads for dabbrev. (That section got lost.) * simple.el (repeat-complex-command): Get rid of strings added to command-history by read-from-minibuffer. Don't bind minibuffer-history-variable here. (previous-matching-history-element): Read argument manually, with a special history list. Delete this command from command-history. Fix arithmetic for counting N. (next-matching-history-element): Likewise. (minibuffer-history-search-history): New variable. * simple.el (read-expression-map): New keymap, w/ lisp-complete-symbol. (eval-expression, edit-and-eval-command): Use read-expression-map. (repeat-complex-command): Likewise. Sun Sep 13 14:13:23 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * compile.el: Fix first lines of doc strings. (compilation-sentinel): Use local value of compilation-finish-function. (compilation-num-errors-found): New variable. (compilation-parse-errors): Use that, not `nfound'. * diff.el (diff-parse-differences): Likewise. * lisp-mode.el (save-match-data): Define indentation. * files.el (file-local-copy): New function, replaces diff-prepare. * subr.el (save-match-data): New macro. * files.el (insert-directory): Use that macro. (file-name-sans-versions): Likewise. * dired-aux.el (dired-compress-file): Likewise. * diff.el (diff-old-file, diff-new-file): Vars declared. (diff-old-temp-file, diff-new-temp-file): Vars declared. (dired-add-entry): Pass t as wildcard arg to insert-directory. (diff): Use compilation-finish-function to delete temp files. * comint.el (comint-mode): Reinsert kill-all-local-variables. Delete kludges to preserve comint-ptyp and comint-input-ring. (comint-ptyp): Move declaration before uses. Make permanent. (comint-input-ring): Make permanent. (comint-input-ring-index): Declare it. * bytecomp.el (byte-compile-report-error): Set byte-compiler-have-errors. (byte-compile-file): Don't kill ` *Compiler Input*' buffer if error. Put input and output buffers in local vars when made. Make two separate save-excursion forms, excluding the call to byte-compile-from-buffer. * dired.el (dired-uncache): New function. (dired-revert, dired-insert-old-subdirs): Use it. (dired-view-file): Undo previous change. Sun Sep 13 03:33:49 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * mouse.el: Change uses of 'K' interactive spec to 'e'. Sun Sep 13 00:13:00 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * diff.el (diff): Call diff-prepare. If we do have temporary files, tell diff to override their names in the listing; delete them at end. (diff-prepare): New function. * files.el (file-name-sans-versions): Support file-name-handler-alist. New arg KEEP-BACKUP-VERSION means don't delete backup versions. * dired.el (dired-display-file, dired-find-file-other-window): (dired-view-file, dired-find-file): Call file-name-sans-versions to remove non-backup version numbers. * dired-aux.el (dired-compress-file): New function. (dired-compress): Call that, to compress and determine new name. * files.el (insert-directory): New function; based on dired-ls. Supports file-name-handler-alist. (insert-directory-program): New variable. * dired-aux.el (dired-add-entry, dired-insert-subdir-doinsert): Use insert-directory. * dired.el (dired-readin-insert): Use insert-directory. (dired-ls, dired-ls-program): Deleted. Sat Sep 12 04:41:34 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * autoload.el (update-file-autoloads): Use beginning of specified line. * loaddefs.el: Sort alphabetically by file name. * files.el (backup-buffer): If backup file to copy into exists and is not writable, try deleting it. * ange-ftp.el: New version from Andrew Norman. Modified to use file-name-handler-alist. Get rid of the dummy shell mode. Rename many variables used free to start with ange-ftp. Don't do anything special for revert-buffer. Fri Sep 11 03:06:55 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (x-fixed-font-alist): New variable. (mouse-set-font): New function, now on C-mouse-3. * term/x-win.el (scroll-bar-mode): New function (and variable too). * dired.el (dired-next-subdir, dired-subdir-index): Moved here * dired-aux.el: From here. * dired.el (dired-build-subdir-alist): Don't print msg after each dir. Clarify final message. * files.el (auto-mode-alist): Recognize ChangeLog.N as change-log-mode. Move *.N pattern for nroff mode after ChangeLog.N. Thu Sep 10 18:58:19 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * add-log.el (add-log-current-defun): Use eq instead of = when one side might be nil. Wed Sep 9 19:53:33 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * frame.el (frame-notice-user-settings): In situations where we have to delete the existing frame and create a new one, redirect the dying frame's focus to the new frame, so that characters typed ahead won't get lost. * frame.el (frame-notice-user-settings): Explicitly include default-frame-alist in the frame parameter lists; it was nil before the .emacs file was loaded, and now we have to make sure it takes effect. * subr.el (keyboard-translate): keyboard-translate-table is a C variable; it's never unbound. Assume it's bound, and create a new string if its current value is a non-array, or if the current array is too short to handle FROM or TO. Tue Sep 8 15:25:58 1992 Joseph Arceneaux (jla@geech.gnu.ai.mit.edu) * mailabbrev.el (sendmail-pre-abbrev-expand-hook): Changed the structure of this function: Don't check to call mail-resolve-all-aliases unless we are actually in a header field where an abbrev should be expanded. Sat Sep 5 19:19:26 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * c-mode.el (c-fill-paragraph): Fix the cases where point is before or after the comment. This uses new var comment-start-place. Fri Sep 4 04:59:33 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * rmail.el (rmail-unix-mail-delimiter): Expand this to recognize time zones after the date too. Re-arranged some of the whitespace matching, to facilitate factoring out the time zone regexp. (rmail-nuke-pinhead-header): Deal with the timezone matched in either position. Fri Sep 4 17:49:24 1992 Roland McGrath (roland@albert.gnu.ai.mit.edu) * server.el: Add provide. Fri Sep 4 01:20:40 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * c-mode.el (calculate-c-indent): Delete stray setq of tem. (c-fill-paragraph): If line contains any comment, treat as comment. * add-log.el (change-log-mode): Match start of word at start of line. * page.el (forward-page): Handle page delim that matches null string. * rmail.el (rmail-mode): Doc fix. * shell.el (shell): Doc fix. * sendmail.el (mail-do-fcc): Copy code from Emacs 18 to add time zone. Thu Sep 3 20:04:28 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * rmail.el (rmail-unix-mail-delimiter): Split this up and comment its various components so it looks a bit less like three lines of garbage. Wed Sep 2 19:15:42 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * compile.el (compile-goto-error): Move to bol before looking for the error. Wed Sep 2 18:09:41 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * c-mode.el (c-auto-newline): Added backslashed before quotes in docstring. Tue Sep 1 15:05:33 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lpr.el (lpr-command): Make this autoload. * fill.el (justify-current-line): Fix escape syntax of regexp constant. Mon Aug 31 20:24:43 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (enable-local-eval): Default value is `maybe'. (hack-local-variables): Ask just once about `eval:', not each time. Mon Aug 31 19:22:20 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * loadup.el: Don't delete old DOC-M.N.O file if it doesn't exist. Mon Aug 31 02:26:43 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * loadup.el: Delete old DOC-M.N.O file before copying to it. * c-mode.el (calculate-c-indent): Recognize the Emacs DEFUN macro. Do condition-case around sexp functions when checking for function arg decls. (c-fill-paragraph): Detect comment starting after code on current line. Exclude everything before line where comment starts. * add-log.el (add-log-current-defun): Fix test for LOCATION in range, for instace of DEFUN macro. * simple.el (open-line): Fix fill-prefix case. * loaddefs.el: Swap bindings of C-x a i l and C-x a i g. The former is now for mode abbrevs and the latter for global. Sun Aug 30 21:57:08 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el: Add bindings for down-mouse-1, drag-mouse-1, S-mouse-3, C-mouse-1. Add real keybindings for scroll bar commands. (help-menu-map): New tree of menu-maps, on C-mouse-2. (mouse-buffer-menu): New function. Sat Aug 29 04:25:31 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * c-mode.el (calculate-c-indent): If taking indent from prev stmt and it starts with an {, subtract c-brace-offset. Thu Aug 27 00:22:35 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * add-log.el (add-log-current-defun): Recognize Emacs DEFUN properly. Mon Aug 24 18:47:15 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * rnewspost.el (news-setup): Don't use kill-line; that puts trash in the kill ring; instead, use delete-region. * mouse.el (mouse-kill, mouse-set-point): Remember that event-point does not always return a number; it may return `mode-line' or `vertical-line'. * simple.el (prefix-arg-internal): Make sure that the key sequence is a string before comparing it against "0" and "9". Mon Aug 24 18:07:55 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * etags.el (etags-recognize-tags-table): Don't print message. Fri Aug 21 03:18:34 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el: Doc fixes. Wed Aug 19 04:13:25 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * sendmail.el (mail-signature-file): Undo the previous change - replace this with mail-signature. The manual has already gone to the printer. (mail-setup): Use mail-signature, rather than mail-signature-file. (mail-signature): Use "~/.signature", rather than mail-signature-file. (mail): Doc fix. Wed Aug 19 03:03:49 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail): Bind enable-local-variables, not inhibit... * sendmail.el (mail-setup): Don't use mail-signature-file if nonexistent. Insert just one newline if no signature. Tue Aug 18 17:18:25 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-next-undeleted-message): No error at eob, just message. (This reverses the previous change.) Mon Aug 17 14:28:46 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * sendmail.el (mail-signature): Variable replaced with... (mail-signature-file): This, since this is the way all the other lisp packages do it, and it's how people always say they want it on the mailing lists. (mail-setup, mail-signature): Adjusted accordingly. (mail): Doc fix. Mon Aug 17 23:13:23 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sort.el (sort-subr): No progress messages if sorting less than 50k. Mon Aug 17 13:56:14 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * solar.el (sunrise-sunset): Get various values set properly when there is (or isn't) a double prefix arg. Fri Aug 14 13:24:20 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * timer.el (run-at-time, timer-process-filter): The character used to separate the time from the token in input to the timer subprocess used to be ?\001, which is not human-readable. Make it ?@, which is. Fri Aug 14 03:50:30 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * info.el (Info-find-node): Be more flexible about format of tags table. Thu Aug 13 20:14:21 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * unrmail.el: New file. Thu Aug 13 15:01:28 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * hideif.el (hide-ifdef-mode): Made this function autoload. (hide-ifdef-initially, hide-ifdef-read-only, hide-ifdef-lines): Make these variables autoload. Wed Aug 12 14:37:41 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (grep-regexp-alist): New defvar. (grep): Pass grep-regexp-alist to compile-internal. * etags.el (find-tag-noselect): If NEXT-P, (visit-tags-table-buffer 'same) first. * add-log.el: Add (provide 'add-log). Wed Aug 12 02:48:34 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * add-log.el (change-log-mode): Make it autoload. Wed Aug 12 01:49:56 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * frame.el (initial-frame-alist): Change the initial frame alist from ((minibuffer . nil)), which asks for no minibuffer, to ((minibuffer . t)), which asks for a minibuffer. * term/x-win.el: Don't call set-input-mode from here; it's already taken care of in x_term_init, which is called from Fx_open_connection. Rah. Tue Aug 11 21:35:43 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * calendar.el, diary.el, diary-insert.el, holidays.el, cal-french.el cal-mayan.el, solar.el, lunar.el: Installed the latest update of this calendar stuff from that calendar guy, Ed Reingold. Entries for his changes have been inserted in this file, ordered by date amongst the rest of the changes. * diary-add.el: This has become diary-insert.el. * calendar.el (generate-calendar-window, update-calendar-mode-line, calendar-set-mode-line): Replace uses of screen-width with frame-width. * diary.el (simple-diary-entry, fancy-diary-entry): Same. Tue Aug 11 03:25:08 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (eval-expression): Doc fix. Mon Aug 10 17:24:27 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * add-log.el (add-log-current-defun): Protect against "Unbalanced parens" error from down-list. Mon Aug 10 10:19:28 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * frame.el (set-screen-width, set-screen-height): Make the docstring say that these are obsolete. (screen-width, screen-height, set-screen-width, set-screen-height): Apply make-obsolete to these. Mon Aug 10 09:03:24 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-mode): Update mode line. * calendar.el (calendar-read-date): New function. (calendar-goto-date): Use it. * holidays.el (holidays): Optional prefix arg causes prompting for month and year. * calendar.el (calendar-interval): Fix doc string. * calendar.el (calendar): Changed use of prefix arg--now it causes prompting for the month and year. (regenerate-calendar-window): Renamed generate-calendar-window. Changed optional argument from an offset from the current month to a month, year pair. (redraw-calendar, calendar-current-month, scroll-calendar-left, calendar-other-month): Change calls from regenerate-calendar-window to generate-calendar-window. Sat Aug 8 18:08:46 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc.el (vc-revert-buffer): Use yes-or-no-p. Doc fix. * Reinstalled a loaddefs.el backup dated Aug 4. The installed copy seems to be a very old version. Sat Aug 8 13:37:31 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * frame.el (set-screen-width, set-screen-height): Changed these from fset aliases to actual functions, since they aren't supposed to take a frame argument, while set-frame-{width,height} do. Fri Aug 7 17:13:23 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * add-log.el (add-log-current-defun): Handle ansidecl DEFUN macros. (change-log-mode): Doc fix. * add-log.el (add-log-current-defun): Use an intelligent regexps instead of many looking-at calls. Use memq instead of (or (eq x a) (eq x b)). Stupidity reigns. Fri Aug 7 04:51:50 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * frame.el (set-frame-width, set-frame-height): Functions deleted *again*. Where did these come from? * bytecomp.el: Merged changes up to version 2.08 of the Zawinski-Furuseth compiler. Added a comment above the declaration of byte-compile-version indicating this, to assist future patchers. (byte-compile-warnings): Doc fix. (byte-recompile-directory): Ignore CVS subdirectories, as well as RCS dirs. * byte-opt.el: Correctly extract the components of a compiled function object. * bytecomp.el (byte-compile-warnings): Have this default to t, since Zawinski says everyone likes the warnings about unbound variables. * appt.el (appt-issue-message, appt-message-warning-time, appt-audible, appt-visible, appt-display-mode-line, appt-msg-window, appt-display-duration, appt-display-diary): Added ;;;###autoload cookies for these variables, since they are options for the user to set. * tex-mode.el (tex-shell-file-name, tex-directory, tex-offer-save, tex-run-command, latex-run-command, latex-block-names, slitex-run-command, tex-bibtex-command, tex-dvi-print-command, tex-alt-dvi-print-command, tex-dvi-view-command, tex-show-queue-command, tex-default-mode, tex-open-quote, tex-close-quote): Same. Thu Aug 6 19:44:31 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * add-log.el (add-log-current-defun): Use eq instead of = when one side might be nil. * compile.el (compilation-mode-map): Change compilation-previous/next-file bindings to M-{ and M-}. Wed Aug 5 00:41:53 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * cl.el (*cl-valid-named-list-accessors*, *cl-valid-nth-offsets*, byte-compile-named-accessors): Deleted. (first, second, ... tenth, rest): Define these with defsubst, to get the same effect. (byte-compile-ca*d*r): Deleted. (caar, cadr, ..., cddddr): Define these using defsubst. * Installed changes from Zawinski-Furuseth 2.04 to 2.07: * byte-run.el (dont-compile): Doc fix. (make-obsolete-variable): New function. * bytecomp.el (byte-compile-log-1): Added new optional argument, FILL; if it is non-nil, reformat the error message. (byte-compile-warn): Use that flag. (byte-recompile-directory): Offer to recompile subdirectories. If prefix argument is zero, create .elc files for those .el files which lack them, without asking. (byte-compile-output-form, byte-compile-output-docform): Disable print-gensym while writing the form. (byte-compile-form): Warn if t or nil are called as functions. (byte-compile-variable-ref): Check for, and warn about, obsolete variable uses. (byte-set-marker, byte-string=, byte-string<, byte-setcar, byte-setcdr, byte-rem): Define these with byte-defop-compiler19, not plain byte-defop-compiler. (auto-fill-hook, blink-paren-hook, lisp-indent-hook, temp-buffer-show-hook, inhibit-local-variables): Declare these variables to be obsolete. * byte-opt.el (byte-optimize-apply): If the last argument to apply is a constant list, and we therefore decide to turn this into a funcall, then don't forget to quote all the elements of the constant list. * inf-lisp.el (inferior-lisp-filter-regexp, inferior-lisp-program, inferior-lisp-load-command, inferior-lisp-prompt, inferior-lisp-mode-hook, inferior-lisp): Added ;;;###autoload cookies for these. * bytecomp.el (byte-compile-warnings): When choosing the default value for this variable, don't forget to apply delq to a COPY of byte-compile-warning-types, so we don't nuke the `free-vars' flag altogether. Tue Aug 4 21:08:02 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-search): Fix typo (premature ref to reversep). Choice of amount to increment n by was backwards. (rmail-search-backwards): Setting of reversep was backwards. Tue Aug 4 18:30:51 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-next-file): Use FILE instead of "This" in error for moving too far. Tue Aug 4 17:39:24 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el (comint-mode-map): Set to nil at load time. * lint.el: File deleted. Tue Aug 4 17:28:01 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-parse-errors): Write progress messages on all regexp matches, not just errors. Tue Aug 4 13:08:26 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * view.el (view-mode): teach this how to use help-char. * info.el (Info-mode): scroll-up, scroll-down now do the right thing for preorder browsing when the beginning/end of the node is visible. RET now goes to the next preorder node. These changes make sequential reading of info subtrees easier. Tue Aug 4 01:01:00 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * appt.el (appt-make-list): Add ;;;###autoload cookie for this function. * vc-hooks.el: Removed autoloads; this task is better performed by the autoload cookies. * vc.el (vc-next-action, vc-register, vc-diff, vc-insert-headers, vc-directory, vc-create-snapshot, vc-retrieve-snapshot, vc-print-log, vc-revert-buffer, vc-cancel-version, vc-update-change-log): Added the ;;;###autoload cookies to these functions, since they get bound to keys in the global keymap. * loadup.el: Load vc-hooks.el. Mon Aug 3 20:52:21 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compile-error-at-point): New function. (compilation-next-error): Use it. (compile-file-of-error): New function. (compilation-next-file, compilation-previous-file): New functions. (compilation-mode-map): Bind C-x [ and C-x ] to them. Mon Aug 3 18:33:31 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (next-error): Call compile-reinitialize-errors with 3rd arg of ARGP-1, not ARGP. (compile-reinitialize-errors): Don't need to parse if compilation-parsing-end is past LIMIT-SEARCH. (compilation-next-error): Rewritten to use compile-reinitialize-errors limiting args. (compile-reinitialize-errors): Don't parse at all if compilation-parsing-end is at (point-max). * loaddefs.el (complete-tag): Define here to always error; loading etags will redefine it. * etags.el (complete-tag): Error if no tags table loaded. Mon Aug 3 17:11:41 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * ebuff-menu.el, echistory.el, help.el, hexl.el: teach these packages to use help-char, and add the appropriate magic to doc strings. Mon Aug 3 15:20:17 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gud.el (gud-def): If KEY is nil, don't make a binding. Mon Aug 3 14:50:40 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * diary.el (print-diary-entries): Rewrote to work for either simple or fancy diary display. (add-diary-heading): Deleted--incorporated into print-diary-entries. * calendar.el (print-diary-entries-hook): Change default value. Mon Aug 3 12:41:32 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * add-log.el (change-log-mode): Doc fix. * map-ynp.el (map-y-or-n-p): Use key-description for USER-KEYS. Mon Aug 3 05:19:24 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * simple.el (current-kill): Reinstate interprogram-paste feature. It doesn't seem to be wedged for me, and I can't find out how it is wedged unless it's enabled. * terminal.el (terminal-map, terminal-escape-map, terminal-more-break-map): Apply fillarray to the cadr of the map, not to the map itself; dense keymaps are no longer vectors. * ehelp.el (electric-help-map): Same here. * bytecomp.el (byte-compile-file): Don't catch errors here. (displaying-byte-compile-warnings): Catch them here. This way, errors get caught no matter which compilation entry point we use; anyplace that can report warnings, also catches errors. * sun-cursors.el: Require 'cl, for the sake of the push macro. (sc::pic-ins-at-mouse): Call move-to-column with the FORCE argument true, instead of calling an unknown function named `move-to-column-force'. * medit.el (medit-zap-define-to-mdl): Fix interactive spec. (medit-zap-define-to-mdl): Change `medit-save-defun' to `medit-save-define'. (medit-save-region, medit-save-buffer, medit-zap-define-to-mdl): Changed `medit-go-to-mdl' to `medit-goto-mdl'. Did anyone ever try this code? Sun Aug 2 00:39:59 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el: Fix message syntax. (comint-previous-similar-input): Use error, not message. * files.el (save-some-buffers): Use C-r, not v, to look at a buffer. Use view-buffer and a recursive edit to do it. * view.el: Delete key bindings for C-x v and C-x 4 v. (View-scroll-lines-forward, view-helpful-message): Use view-exit, not exit-recursive-edit. * map-ynp.el: Fix prompt. * dired.el (dired-why): Don't use save-excursion. (dired-change-marks): New command. (dired-mode-map): Put dired-change-marks on c. Put dired-do-kill-lines on k. * dired-aux.el: Require dired.el for compilation. (dired-bunch-files): Was duplicating PENDING in apply calls. Fixed. (dired-do-shell-command, dired-run-shell-command): Delete arg IN-BACKGROUND; rely on including & at end of command. (dired-run-shell-command): Return nil. (dired-do-shell-command): Accept COMMAND as arg; use minibuf within `interactive'. (dired-create-files, dired-handle-overwrite): Rename overwrite-confirmed to dired-overwrite-confirmed. (dired-do-kill-lines): Handle prefix arg as number of lines to kill. (dired-kill-line-or-subdir): Deleted. Sat Aug 1 22:35:09 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * mailabbrev.el [from jwz] (mail-interactive-insert-alias): Do mail-aliases-setup if necessary before completing for interactive. (build-mail-aliases): Changed parsing regexp. * compile.el (compilation-parse-errors): Take 2nd arg FIND-AT-LEAST. If non-nil, stop after parsing that many new errors. (compilation-parse-errors-function): Document 2nd arg. (compile-reinitialize-errors): Take optional 3rd arg; pass to parser. (next-error): Pass repeat count to compile-reinitialize-errors. * diff.el (diff-parse-differences): Take same new arg. * reposition.el (C-l): Fix typo. Sat Aug 1 15:00:51 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el: ring-* functions deleted--get them from ring.el. * ring.el (ring-mod): Renamed from comint-mod. Provide `ring', not history'. (make-ring, ring-p): Add autoloads. * history.el: Link deleted. * c-mode.el (c-up-conditional): New function. * add-log.el (add-log-current-defun): In C and Lisp, verify the defun really starts at or before the original point. Sat Aug 1 10:41:29 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * mailalias.el: Provide 'mailalias. * mailpost.el: Require 'mailalias and 'sendmail, since we use expand-mail-aliases and mail-do-fcc. * mail-extr.el (mail-extract-address-components, variant-method): Use buffer-disable-undo instead of buffer-flush-undo; the latter is obsolete. * lpr.el (print-region-new-buffer): Added arguments START and END; this used to use dynamic scope, but it makes things less readable. (print-region-1): Always call this with two arguments, not sometimes two and sometimes none. * lint.el: Require 'compile. (compilation-convert-lint): Call set-buffer with only one argument. * life.el: Move the definitions of the macros out of the require clause; the new compiler seems to handle the macros correctly. (life): Add an autoload cookie for this. (life-display-generation): If the sit-for returns before the timeout has elapsed, exit the life loop. * ledit.el (ledit-setup): Use shared-lisp-mode-map, instead of lisp-mode-commands. * kermit.el (kermit-send-input-cr): comint-send-input doesn't accept any arguments. Instead of applying comint-send-input to "\r", call comint-send-input on no arguments, and then use comint-send-string to send the carriage return. (kermit-clean-filter): Call re-search-backward, not re-search-backware. (kermit-clean-on): Remove extra quote from doc string. * informat.el (batch-info-validate): Don't pass any arguments to Info-tagify; it doesn't want any. * hideif.el (hif-endif-to-ifdef): Fix munged comment which was interfering with parsing. * hexl.el (hexl-next-line): Fixed up malformed let binding. * bytecomp.el (byte-compile-file): Catch errors that occur during compilation, and record them in the compilation log. This allows us to find the name of the guilty file when we get a "invalid read syntax" error or some such. * gud.el: Require `etags', not `tags'. (sdb): Move interactive spec to top of function, just under doc string. (gud-read-address, send-gud-command): Use the point and point-max function instead of dot and dot-max; the latter two are obsolete. * gnus.el (gnus-Group-mode, gnus-Subject-mode, gnus-Subject-rmail-digest, gnus-Article-mode, gnus-output-to-rmail, gnus-output-to-file): Use buffer-disable-undo, instead of buffer-flush-undo; the latter is an obsolete name. * simple.el: Bind the `next' and `prior' function keys to next-history-element and previous-history-element in the minibuffer maps. Clean up binding code. * two-column.el: Doc fixes. * loaddefs.el (function-keymap): Definition deleted; this has been superceded by function-key-map. * gomoku.el (gomoku-mode-map): Use function key symbols, instead of the keypad.el facilities. * edt.el: Converted to use the new function key events instead of keypad.el. Don't require keypad. Change global key bindings. (advance-direction, backup-direction): Bind the function key symbols directly in the global map, not in function-keymap. (edt-emulation-on): Doc fix. This function will now work when called simply from .emacs; it doesn't need to be run after the terminal-dependent file has been loaded. * cl.el (byte-compile-named-list-accessors, byte-compile-ca*d*r): Changed these to work correctly with the Zawinski-Furuseth byte compiler. Fri Jul 31 13:01:45 1992 Robert J. Chassell (bob@churchy.gnu.ai.mit.edu) * loaddefs.el: New keybinding, `C-x r y', for `yank-rectangle'. Fri Jul 31 10:17:35 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-string-spread): New function. (calendar-mode-line-format): Redefine it. (calendar-set-mode-line): Rewrite using new function. (update-calendar-mode-line): Rewrite using new function. Fri Jul 31 00:04:58 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * startup.el (command-line-1): Mention info in startup message. Thu Jul 30 22:27:50 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * byte-opt.el (byte-optimize-plus): Don't entirely eliminate the call. (byte-optimize-minus): Likewise. (byte-optimize-multiply,(byte-optimize-divide): Likewise. Thu Jul 30 17:08:34 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * compile.el (compile-goto-error): Set compilation-error-list to the one we want, not the one before it. (next-error): Use the ARGP-1th, not ARGPth cdr of compilation-error-list. Thu Jul 30 15:23:02 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * bytecomp.el (byte-compile-warnings): By default, do not display warnings about references free variables. Thu Jul 30 00:30:21 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail): Get rid of the multiple mail buffer feature. Wed Jul 29 16:04:40 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (general-holidays, hebrew-holidays, local-holidays, christian-holidays, islamic-holidays, solar-holidays, other-holidays): New variables. (calendar-holidays): Use them to define the default value. Wed Jul 29 00:56:29 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el (comint-mode-map): comint-previous-similar-input now M-r. (comint-previous-similar-input): Initialize comint-input-ring-index if nil. (comint-previous-input-matching): Report ordinary error if fail. Initialize comint-input-ring-index if nil. (comint-next-similar-input): New command, on M-s. (comint-previous-input): Always delete what was already given for the next input. Initialize comint-input-ring-index if nil. (comint-send-input): Set comint-input-ring-index to nil. * field.el, cmushell.el: Files deleted. * co-isearch.el: File deleted; comint should have M-r and M-s like the minibuffer, instead. Wed Jul 29 00:18:09 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * diff.el: Everything but diff and diff-backup removed. (diff-regexp-alist): New defvar. (diff-parse-differences): New defun. (diff): Use compile-internal. Take optional arg SWITCHES; interactively, prompt if prefix arg. (diff-backup): Take same new arg. Make this autoload. * compile.el (compilation-parse-errors): No message when we stop at LIMIT-SEARCH. (compile-reinitialize-errors): Don't short-circuit if passed a non-nil LIMIT-SEARCH. (compilation-next-error): New; bound to M-n. (compilation-previous-error): New; bound to M-p. Tue Jul 28 22:54:02 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-mode-map): Bind SPC, DEL, M-n, M-p. Tue Jul 28 22:15:36 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * texinfo.el (texinfo-mode-map): Move M-} and M-{ to C-c prefix. * simple.el (delete-indentation): Delete fill prefix from after join. Tue Jul 28 18:12:28 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * map-ynp.el (map-y-or-n-p-help): Remove. (map-y-or-n-p): Take new arg ACTION-ALIST. Compute help string fully instead of using map-y-or-n-p-help. * files.el (save-some-buffers): Pass new arg to map-y-or-n-p, so `v' displays the buffer. Change save-excursion to save-window-excursion; it was only there to restore the current buffer, and now display-buffer might change windows. * compile.el (compilation-parse-errors): Fix M-t-o on `found-desired'. (compilation-error-list): Doc fix. (compile-internal): Document to return the buffer. (next-error): Simplify code to set NEXT-ERRORS from compilation-error-list and ARGP. (compile-goto-error): Rewrote searching so it finds the error that point is in or after; the error need not start at bol. Restore current buffer after calling other-window. Tue Jul 28 11:48:12 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * holidays.el (calendar-holiday-function-sexp): New function. *calendar.el (calendar-holidays): Describe it and use it for daylight savings. * calendar.el, cal-mayan.el, cal-french.el: Change names of all calendar-goto-next- or calendar-goto-previous- commands to eliminate the word "goto". Change names of all cursor-to-***-calendar-date commands to calendar-print-***-date. * diary.el (sort-diary-entries): New function. Tue Jul 28 01:24:36 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (backup-extract-version): Copied from Emacs 18. (find-backup-file-name): Use that. * dired-aux.el (dired-clean-directory): Moved here. (dired-map-dired-file-lines, dired-collect-file-versions): (dired-trample-file-versions): Likewise. * dired.el: Moved from here. (dired-clean-directory): Auto load added. * add-log.el (add-change-log-entry): Chase symlinks. Mon Jul 27 16:24:31 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gud.el (gdb, dbx, sdb): Change C-c LETTER commands to C-c C-LETTER. * add-log.el (add-log-current-defun): Handle C macros. Handle the DEFUN macro used in Emacs C sources. Mon Jul 27 13:27:44 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-parse-errors): Take arg LIMIT-SEARCH; if non-nil stop parsing when we pass that location. (compilation-parse-errors-function): Document arg. (compile-reinitialize-errors): Take optional 2nd arg; pass to parser. (compile-goto-error): Pass (point) to compile-reinitialize-errors. * compile.el (compile-goto-error): Doc fix. * etags.el (find-tag): Fixed prompt. (tag-exact-match-p): Rewritten (again). * startup.el (command-line): Load site-start here. (normal-top-level): Not here. * etags.el: Remove M-? binding; move M-TAB binding to after defun. Mon Jul 27 03:59:00 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * completion.el: Moved to external-lisp. * diff.el (diff-rcs, diff-sccs): Deleted. Mon Jul 27 02:53:31 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * tar-mode.el (tar-subfile-save-buffer): whoever changed current-time forgot to check for breakage. Added code to print the seconds parts of a (current-time) value as 11 octal digits (yes, this is nontrivial). Sun Jul 26 22:37:50 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (next-history-element): Fix error messages. (previous-matching-history-element): Likewise. * help.el (describe-function): Don't give the file name in the case of an autoloaded function. * lisp-mode.el (emacs-lisp-mode-map, lisp-interaction-mode-map): Add M-TAB as lisp-complete-symbol. * loaddefs.el: Delete binding of M-TAB. * etags.el: Add binding of M-TAB. Sun Jul 26 22:14:02 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (tags-exact-match-p): Rewritten. (tags-with-syntax): New macro. Sun Jul 26 19:20:33 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-cursor-to-date): Change `current-day' to `starred-day'. (calendar-star-date): Create and set buffer local var `starred-day'. (calendar-mode): Don't create buffer local vars current-month, current-day, current-year. (regenerate-calendar-window, calendar-current-date): Don't set buffer local vars current-month, current-day, current-year. (calendar, redraw-calendar, scroll-calendar-left, calendar-other-month, calendar-goto-date, calendar-goto-hebrew-date, calendar-goto-julian-date, calendar-goto-islamic-date, calendar-goto-iso-date): Use `calendar-current-date' instead of buffer local vars current-month, current-day, current-year. Sun Jul 26 15:26:20 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * diff.el (diff-backup): New function. (diff-last-backup-file): Renamed from dired-last-backup-file. * dired-aux.el (dired-backup-diff): Use diff-backup. (dired-last-backup-file): Moved and renamed. * dired.el, dired-aux.el (dired-diff, dired-backup-diff): Doc fixes. * help.el (command-apropos): Fix call to apropos for new arg. * finder.el (finder-by-keyword): Rewrite to read args in `interactive' and use with-output-to-temp-buffer. * startup.el (normal-top-level): Load site-start if it exists. * add-log.el (add-log-current-defun): In C, when moving back over arg decls, stop at beg of buffer. (add-change-log-entry): Likewise for blank lines at end of buffer. * picture.el (picture-mode-old-major-mode): Declared. (picture-mode-old-mode-name, picture-mode-old-local-map): Likewise. (picture-mode-map): Don't use aset directly; use define-key. * saveconf.el: File deleted. * rmail.el (rmail-search): Accept repeat count. (rmail-search-backwards): New command, on M-r. * simple.el (previous-matching-history-element): New command. On M-r. (next-matching-history-element): New command. On M-s. Fri Jul 24 00:16:32 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * c-mode.el (c-beginning-of-statement): If in string or comment, move by sentences. * compile.el (compile-history): New variable. (compile): Specify history list copile-history, with compile-command as initial contents. (grep): Specify constant "grep -n" as initial input, and history list grep-history. (grep-command): Variable deleted. * replace.el (query-replace-read-args): New function. It reads two args using query-replace-history. (query-replace, query-replace-regexp, replace-string): (replace-regexp): Use query-replace-read-args. (map-query-replace-regexp): Read args using query-replace-history. (perform-replace): Add local binding for `char'. * dired.el: Don't check for version 18. (dired-file-version-alist): New defvar. Use this instead of file-version-assoc-list. (dired-shrink-to-fit): Default is always t. (dired-internal-do-deletions): remove-directory => delete-directory. * abbrev.el (define-abbrevs): Bind name, hook, exp, count. * replace.el (perform-replace): Fix typo: match-after => match-again. (map-query-replace-regexp): Delete duplicate definition. * subr.el (defun-inline): Commented out. * comint.el (comint-input-ring*): Renamed from input-ring*. (ring-remove, ring-rotate): use setcar, not set-car. * co-isearch.el: input-ring* renamed to comint-input-ring*. * tex-mode.el: Don't require comint. * comint.el (make-comint): Make this autoload. * case-table.el (describe-buffer-case-table): Move the describe-vector inside the let. * c++-mode.el (indent-c++-exp): Fix typo "innerloop-done". Make last-depth local. Thu Jul 23 22:53:46 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * flow-ctrl.el: fixed set-input-mode call broken by new third arg for meta control. Thu Jul 23 15:31:04 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (cursor-to-islamic-calendar-date, cursor-to-hebrew-calendar-date): Add phrase "until sunset" to message. * calendar.el (calendar-goto-astro-day-number, calendar-print-astro-day-number): New functions. (calendar-mode): Put them on keys and describe them. * diary.el (diary-astro-day-number): New function. * diary.el (diary-julian-date): New function. Thu Jul 23 13:17:24 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (current-kill): Ignore the interprogram paste feature; it is wedged. * paths.el (mh-lib, mh-prog): Add more alternatives. Wed Jul 22 18:53:04 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emerge.el (emerge-startup-hook, emerge-quit-hook): Renamed from ...-hooks. * dired.el (dired-display-file): New command, on C-o. * files.el (ctl-x-4-map): display-buffer is now C-x 4 C-o. Wed Jul 22 17:16:56 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (visit-tags-table-buffer): Look for a tags table containing buffer-file-name's tags. Wed Jul 22 17:04:14 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (last-tag): New defvar. (find-tag-noselect): Set and use it. Wed Jul 22 16:54:20 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * edebug.el, gnus.el, gnusmail.el, gnusmisc.el, gnuspost.el, hideif.el, isearch-mode.el, mh-e.el, mhspool.el, netunam.el, nnspool.el, nntp.el, scheme.el, xscheme.el: Removed RCS "$Header" and "$Log" files; K. Richard Pixley says they cause trouble with patches. Wed Jul 22 16:44:30 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (find-tag-noselect): Properly return find-tag-in-order's value. Wed Jul 22 12:55:43 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * bytecomp.el: Removed relative jump instructions. (byte-rel-goto-ops): Variable deleted. (byte-compile-lapcode): Code to recognize potential relative jumps and patch the PC into relative jumps removed. * byte-opt.el (disassemble-offset, byte-decompile-bytecode-1): Support for relative jumps removed. Wed Jul 22 00:23:27 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * Removed all Last-Modified headers. Tue Jul 21 23:14:54 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * files.el (trim-versions-without-asking): Non-nil, non-t value suppresses all trimming of excess backups. This is so we can make the @!%$@ question at save time go away.... Tue Jul 21 21:15:37 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (kill-ring-save): Display only if interactive-p. * c-mode.el (c-backslash-region): New command. (c-append-backslash, c-delete-backslash): New functions. * c++-mode.el (c++-macroize-region, backslashify-current-line): Deleted. (c++-comment-region, c++-uncomment-region): Deleted. comment-region works just fine. (c++-beginning-of-defun, c++-end-defun, c++-indent-defun): Deleted. (c++-point-bol): Renamed from point-bol. (c++-within-string-p): Renamed from within-string-p. (c++-count-char-in-string): Renamed from count-char-in-string. (fill-c++-comment): Renamed from fill-C-comment. (c++-insert-header): Deleted. Tue Jul 21 19:29:21 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * inf-lisp.el: When creating inferior-lisp-mode-map, use shared-lisp-mode-map, instead of calling the function lisp-mode-commands; that doesn't exist any more. (inferior-lisp-args-to-list): Recurse, rather than calling tea-args-to-list, which doesn't exist. (inferior-lisp-mode): Always call lisp-mode-variables with one argument; there's no longer any need to adapt to different versions of Emacs. Tue Jul 21 14:22:35 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-set-mode-line): New function. (list-yahrzeit-dates): Use it for mode line. * diary.el (simple-diary-display, fancy-diary-display): Use it for mode line. * diary.el (show-all-diary-entries): Use default mode line. * lunar.el (calendar-phases-of-moon): Use it for mode line. * holiday.el (list-calendar-holidays, calendar-cursor-holidays): Use it for mode line. Tue Jul 21 13:57:56 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired.el (dired-remember-hidden): Fix typo in `following-char'. * add-log.el (add-change-log-entry): Avoid spurious whitespace when making new entry. Delete excess blank lines. Really don't use "ChangeLog" as the file name in the entry. Always put a space after the colon. (add-log-current-defun): Verify the defun actually contains point. Handle the lines of a C function before the open brace. * rmail.el (rmail-undelete-previous-message): Don't catch errors. * simple.el (end-of-buffer): If buffer end is on screen, don't scroll. * c-mode.el (set-c-style): Deleted the first version of this function. It was badly written. Modified the remaining version by adding new argument GLOBAL and setting the parameters locally if GLOBAL is nil. Tue Jul 21 03:38:22 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * Turfed r2bibtex.el. Refbib.el turns out to be a newer version of the same package. * Installed co-isearch.el, new gud.el (1.19) Tue Jul 21 00:02:03 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * frame.el (get-frame): Renamed to get-other-frame; get-frame sounds like a parallel to get-buffer or get-process. * c-mode.el (set-c-style): Remove the extraneous copy of this function. * c++-mode.el (within-string-p): Use `%', not `mod', as the name of the modulus function. * frame.el (frame-height, frame-width): Fixed several confusions here. * blackbox.el: When building blackbox-mode-map, locally rebind all keys to which the movement commands are bound to blackbox's movement functions. Define the insert and kp-enter keys. Mon Jul 20 23:02:48 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * blackbox.el (blackbox): Doc fix. (bb-outside-box): For some reason, this function was replaced by the comment ";; blackbox.el ends here" * dired.el (dired): Doc fix. Mon Jul 20 22:48:55 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-send-and-exit): Just switch windows if the next window is in Rmail mode. Mon Jul 20 18:30:25 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * simple.el (set-variable): If VAR has a `variable-interactive' property, use it as an interactive spec to prompt for VAL. * etags.el (tags-file-name): Give it a variable-interactive property. * etags.el (tags-table-format-hooks): Remove ctags-recognize-tags-table * ctags.el: Removed. (visit-tags-table): Don't call abbreviate-file-name. (visit-tags-file): If find-file-noselect changed the file name, propagate the change to tags-file-name and tags-table-list. * startup.el (command-line): Fixed typo in comment. Mon Jul 20 14:57:27 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * bytecomp.el (byte-compile-warnings): Include the full documentation given in the comments at the top of the file in this variable's docstring. Sun Jul 19 01:05:22 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired.el (dired-mark): Use prefix-numeric-value. * simple.el (kill-ring-save): Say "saved", not "killed", in messages. Let message do the formatting. * fill.el (fill-individual-paragraphs): If MAILP, skip indented headers and blank lines. * register.el (window-configuration-to-register): New function. (frame-configuration-to-register): New function. * loaddefs.el: Put them on C-x r w, C-x r f. * window.el (window-config-to-register, register-to-window-config): Deleted, along with keybindings C-x 6 and C-x 7. Sun Jul 19 00:24:35 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * cal-mayan.el: New file. The only functions visible to the outside world are calendar-goto-mayan-date, calendar-next-haab-date, calendar-previous-haab-date, calendar-next-tzolkin-date, calendar-previous-tzolkin-date, calendar-next-calendar-round-date, calendar-previous-calendar-round-date, diary-mayan-date, and cursor-to-mayan-calendar-date. * diary.el: Autoload diary-mayan-date. * calendar.el: Autoload the 7 "goto" functions. (calendar-mode-map): Put them on keys. (calendar-mode): Describe them. * cal-french.el (french-calendar-month-name-array): Add accents to month names. (cursor-to-french-calendar-date): Add accents. * cal-french.el (calendar-goto-french-date): New function. * calendar.el: Autoload it. (calendar-mode-map): Put it on a key. (calendar-mode): Describe it. * cal-french.el (diary-french-date): Moved from diary.el and fixed accent. * diary.el: Move dairy-french-date to cal-french.el and autoload it. * diary-insert.el: Move all diary inserting commands from diary.el * diary.el: Move all diary inserting commands to diary-insert.el * calendar.el: Change autoloads for all diary inserting commands from diary.el to diary-insert.el. * calendar.el: Put ";;;###autoload" before calendar function and before list-yahrzeit-dates function. * holiday.el: Put ";;;###autoload" before holiday function. * diary.el: Put ";;;###autoload" before diary function. * cal-french.el: New file. All French Revolutionary calendar code from calendar.el has been moved here. * calendar.el: All French Revolutionary calendar code moved to a new file, cal-french.el. Autoload cursor-to-french-calendar-date. * diary.el (list-sexp-diary-entries): Add mention of diary-sunrise-sunset, diary-lunar-phase, and diary-sabbath-candles to doc string. * calendar.el (list-yahrzeit-dates): Prompt for date of death if not called from the calendar window. This function should now be known to the outside world. * calendar.el (diary-file): Add mention of diary-sunrise-sunset, diary-lunar-phase, and diary-sabbath-candles to doc string. Sat Jul 18 20:13:20 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * bytecomp.el (compile-defun): Use displaying-byte-compile-warnings. (byte-compile-warn): Don't display the warning now, just log it. * files.el (auto-mode-alist): Recognize .texi. * rmail.el (rmail-delete-forward): Removed the feature of moving back if there's nowhere to go forward. Fri Jul 17 17:32:29 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * etags.el (visit-tags-table-buffer): Call abbreviate-file-name on the argument before setting tags-file-name. * files.el (automount-dir-prefix): New variable. (abbreviate-file-name): Remove the automount prefix here, rather than in find-file-noselect. Use automount-dir-prefix. (find-file-noselect): Don't remove the automount prefix here; let abbreviate-file-name take care of it. Fri Jul 17 16:24:26 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * Keywords added for [n-z]*.el. Finder now under construction. Fri Jul 17 16:09:55 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * rmail.el (rmail-insert-inbox-text): Generate an alternate name to use for tofile by appending a `+' to file, not a `~'; files ending with the latter may be deleted accidentally when space is low. Fri Jul 17 03:11:10 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * Keywords added for [a-m]*.el. The keyword categories will probably need some tuning, but at least this will suffice for testing the finder code. * makefile.el, two-column.el, sgml-mode.el, resume.el, mail-extr.el: Installed. Thu Jul 16 17:49:20 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * Changed all copying notices to GPL version 2. Thu Jul 16 17:34:28 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * Finished decorating the library files with new standard headers. Thu Jul 16 16:13:25 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * disass.el: Require `byte-compile', not 'bytecomp'. * bytecomp.el (byte-compile-file): Correct parens in interactive form so that it returns a list containing the filename and the prefix argument, not just the prefix argument by itself. * bytecomp.el (byte-compile-file): Changed reference to byte-compile-report-call-tree to use display-call-tree. * bytecomp.el (byte-recompile-directory, byte-compile-file, batch-byte-compile, byte-compile, compile-defun, display-call-tree): Added autoload cookies for these functions. Thu Jul 16 16:03:55 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el: Major rewrite with many new features. * ctags.el: New file; goes with new etags.el. Thu Jul 16 15:50:49 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * byte-run.el (defsubst): Removed extra closing paren at the end of this function. Thu Jul 16 00:26:55 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * At RMS's request, all occurrences of `elisp' changed to `Emacs Lisp'. * New library headers for [fghijklmn]*.el. First steps towards keyword-based code finder via Keywords header. Wed Jul 15 19:31:16 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * New library headers for [opqrst]*.el. Ghod, this is boring. Wed Jul 15 13:07:37 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * lunar.el: New file. The only functions known to outside world are calendar-phases-of-moon, diary-phases-of-moon, and phases-of-moon. * calendar.el (calendar-mode): Put calendar-phases-of-moon on a key and describe it. * diary.el: Autoload diary-lunar-phase. Wed Jul 15 00:28:58 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * loaddefs.el: Added C-x a, C-x r and C-x n as prefixes. Removed old C-x a, C-x g, C-x j, C-x n, C-x p, C-x r, C-x x, C-x w. Also C-x /, C-x C-a, C-x C-h, C-x +, C-x -. Added bindings for function keys insert-line, delete-line, delete-char. * bytecomp.el: Deleted support for running compiler in Emacs 18. Spell "Emacs 18" properly. (byte-compile-version): FSF 2.1. (byte-compiler-valid-options): Deleted. (byte-compile-single-version): Always return nil. (byte-compiler-version-cond): Always return the argument. * loaddefs.el: Key bindings moved here. * simple.el: From here. Tue Jul 14 19:43:05 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * byte-opt.el (byte-boolean-vars): Rebuilt for Emacs 19. * screen.el: Renamed to frame.el. The term is no longer `screen', but `frame'. All variables and functions renamed. * x-menu.el, window.el, sup-mouse.el, sun-mouse.el, subr.el, startup.el, sendmail.el, register.el, prompt.el, mlconvert.el, loadup.el, ispell.el, isearch.el, holidays.el, fortran.el, files.el, etags.el, emerge.el, electric.el, edebug.el, dired.el, diary.el, csharp.el, compile.el, comint.el, calendar.el, buff-mune.el, bg-mouse.el, appt.el, abbrevlist.el, term/x-win.el, term/wyse50.el, term/vt200.el, term/vt100.el: All uses changed. * screen.el (screen-height, screen-width, set-screen-height, set-screen-width): Defined as aliases for frame-height, frame-width, set-frame-height, and set-frame-width. (set-frame-height, set-frame-width): Functions deleted; they are defined in frame.c. Tue Jul 14 15:51:38 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * [uvwxy]*.el: Added headers for new Emacs Lisp documentation conventions. Tue Jul 14 11:21:34 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-mode): Change key bindings for all functions to make them consistent with Version 19 requirements. Mon Jul 13 22:49:25 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * comint.el: minor changes to comments to reflect the fact that comint has won its war and replaced shell mode. Mon Jul 13 16:46:51 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmailsort.el: Change copyright to FSF; update permission notice. * byte-run.el: Delete compatibility definition of make-byte-code. (byte-compiler-options): Commented out. (proclaim-inline, proclaim-notinline): Commented out. * byte-opt.el: Change several doc strings to comments. They had the wrong format anyway. Delete the `require' and the test for wrong compiler version. * disass.el: Require just bytecomp, not byte-opt. * bytecomp.el (emacs-lisp-file-regexp): Renamed from elisp-source-file-re. All uses changed. (byte-compile-dest-file): Don't use that var. (compile-defun): Renamed from elisp-compile-defun. (byte-compile-report-ops): Define unconditionally. It's a bad idea to make function definitions of moderate size conditional on anything. (byte-compile-and-load-file): Commented out. (byte-compiler-valid-options): Renamed from byte-compiler-legal-options. (byte-compile-overwrite-file): Variable deleted. (byte-compile-file): Don't use that var. (byte-compile-compatibility): Renamed from byte-compile-emacs18-compatibility. (byte-compile-generate-emacs19-bytecodes): Variable deleted. Use byte-compile-compatibility instead. (byte-compiler-options-handler): Deleted. (byte-compile-body-do-effect, byte-compile-form-do-effect): Use defsubst, not proclaim-inline. * byte-opt.el: Renamed from byte-optimize.el. * byte-run.el: Renamed from bytecomp-runtime.el. * bytecomp.el, loadup.el: References to those files fixed. * bytecomp.el: Style corrected in calls to error. Many doc strings corrected in style. * Repeated the following changes: * bytecomp.el (byte-compile-file): Don't put file name in minibuffer. (byte-compile-buffer): Function commented out. Mon Jul 13 16:26:07 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * loaddefs.el (completion-ignored-extensions): nconc together list of common extensions and list of unix or vms-specific ones. Mon Jul 13 14:39:10 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * simple.el (kill-region): The variable `undo-high-threshold' has been renamed to `undo-strong-limit'. Change its use here. Mon Jul 13 10:49:26 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (exit-calendar): Bury buffers instead of killing them. (european-calendar-display-form, american-calendar-display-form): Make comma after day name conditional so it's available for more general use. (calendar-date-string): Make dayname nil instead of the empty string. (cursor-to-julian-calendar-date, cursor-to-islamic-calendar-date, cursor-to-hebrew-calendar-date, list-yahrzeit-dates): Use nodayname form of display. * diary.el (diary-islamic-date, diary-hebrew-date, insert-diary-entry, insert-anniversary-diary-entry, insert-block-diary-entry, insert-cyclic-diary-entry, insert-hebrew-diary-entry, insert-islamic-diary-entry): Use nodayname form of display. Sat Jul 11 14:59:21 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * c-mode.el (calculate-c-indent): Don't indent as argdecl after apparent function decl inside a comment. Fri Jul 10 17:45:33 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * bytecomp.el: Replaced with Jamie Zawinksi's byte compiler. * byte-optimize.el, bytecomp-runtime.el: New files, supporting bytecomp.el. * loadup.el: Load bytecomp-runtime into the dumped Emacs. * disass.el: New version of the disassembler, to fit with the new compiler. * mouse.el (mouse-select-buffer-line): Removed extraneous setting of the variable `the-buffer'; it's never used elsewhere. * mouse.el (mouse-kill): Don't set the mark; pass point and the click's position to kill-region directly. Thu Jul 9 20:28:46 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * abbrev.el (write-abbrev-file): Removed extraneous interactive spec. * screen.el (current-screen-configuration, set-screen-configuration): New functions. * buff-menu.el (buffer-menu): Make ARG an optional argument. * screen.el (iconify): Call the function `make-screen-visible' instead of `deiconify-screen'; the latter no longer exists. * files.el (find-backup-file-name): Replace the reference to `backup-extract-version' with a literal `function' form. This eliminates the use of dynamic binding, and allows us to remove backup-extract-version, which doesn't really want to be its own function. (backup-extract-version): Function removed. * help.el (help-with-tutorial): Zap the value of `buffer-auto-save-file-name', not `auto-save-file-name'. * loadup.el: Don't forget to garbage-collect after loading each file. Yes, some of the files are small enough that it won't make much of a difference, but there's no reason not to garbage collect here (other parts of the build process are much slower), and these files might grow. * startup.el (command-line): Comment out the code which chooses a default value for split-window-keep-point; let's see if we can live without this option. Wed Jul 8 14:14:25 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * terminal.el (te-set-escape-char): Improve messages. Tue Jul 7 13:57:28 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * etags.el (find-tag): Don't set tags-loop-form. Mon Jul 6 20:45:20 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-do-fcc): Call rmail-set-message-counters. Mon Jul 6 18:27:40 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * etags.el (visit-tags-table): Remove automounter prefixes before setting tags-file-name. Mon Jul 6 16:33:50 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * Moved gdb.el to =gdb.el. The autoload generation for loaddefs.el was getting screwed up by the conflicting autoloads generated from gdb.el and gud.el. In any case gdb.el is obsolete; we're using the gdb entry point of gud.el now. * Installed tq.el. Mon Jul 6 14:47:05 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * tex-mode.el (tex-file): Fix reference to tex-offer-save. Sun Jul 5 15:00:05 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * tex-mode.el: Require comint instead of oshell. (tex-start-shell): Use comint, not oshell. (tex-filter): Deleted function; no filter is now longer needed. * tex-mode.el (tex-run-command, latex-run-command, slitex-run-command, tex-bibtex-run-command, tex-dvi-print-command, tex-alt-dvi-print-command, tex-dvi-view-command): Change doc strings to reflect the fact that `*' will be replaced by the file name. (tex-send-command): New function to interact with comint subshell and replace `*' by the file name. (tex-file, tex-region, tex-print, tex-view, tex-bibtex-file, tex-show-print-queue): Use tex-send-command to send commands. * tex-mode.el (tex-offer-save): New variable. (tex-file): Offer to save buffers if tex-offer-save is t (default). * tex-mode.el (latex-block-names, standard-latex-block-names): New variables. (tex-latex-block): Use them to do completing-read for block name. * tex-mode.el (tex-last-temp-file): New variable to remember file name for clean up. (tex-shell-sentinel): New function--clean up when tex process dies. (tex-delete-last-temp-files): New function to do the cleanup. Add this function to kill-emacs-hook. (tex-region): Do clean up of files from last invocation. * tex-mode.el (tex-insert-quote): Make it barf on read-only buffers. * tex-mode.el (tex-terminate-paragraph): Make it barf on read-only buffers. * tex-mode.el (tex-insert-braces): Make it barf on read-only buffers. * tex-mode.el (tex-close-latex-block): Change void var `ERR' to `nil'. * tex-mode.el (tex-print): Use alternative printer when given prefix arg. * tex-mode.el (tex-mode-load-hook): New variable. Run-hooks on it. Sat Jul 4 21:20:55 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-in-progress): New variable. Add it to minor-mode-alist. (compile-internal): Cons the new process onto it. (compilation-sentinel): Remove the dead process from it. Sat Jul 4 12:21:50 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tex-mode.el: New version from reingold. * files.el (save-buffers-kill-emacs): Consider open net connections as possibly requiring a query. Thu Jul 2 17:43:00 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (recover-file): Pass -L option to ls, if file is link. Wed Jul 1 22:25:11 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * files.el (ctl-x-4-map): Bind `C-x 4 o' to display-buffer. * buff-menu.el (Buffer-menu-switch-other-window): New function, bound to C-o in Buffer-menu-mode-map. Wed Jul 1 17:47:28 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cmutex.el: Deleted, following recommendation of reingold. Tue Jun 30 07:37:25 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * startup.el (command-line-1): Signal an error if the argument to the `-insert' option isn't a string. Sun Jun 28 22:23:00 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * completion.el (completion-separator-self-insert-autofilling): Changed references to `auto-fill-hook' to `auto-fill-function'. * mh-e.el (mh-letter-mode): Same thing. * texinfo-upd.el (texinfo-update-node, texinfo-sequential-node-update): Same thing. Sun Jun 28 16:31:53 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * solar.el: New file. The only functions known to outside world are calendar-sunrise-sunset, diary-sunrise-sunset, diary-sabbath-candles, sunrise-sunset, and calendar-holiday-function-solar-equinoxes-solstices. * calendar.el (calendar-holidays): Add equinoxes and solstices. (calendar-mode-map): Add key for sunrise/sunset. Add a new variables calendar-time-display-form, calendar-latitude, calendar-longitude, calendar-location-name, calendar-time-zone, calendar-standard-time-zone-name, calendar-daylight-time-zone-name, calendar-daylight-savings-starts, calendar-daylight-savings-ends. Add autoload of calendar-sunrise-sunset. (calendar-mode): Add description of sunrise/sunset capability. (calendar-version): Changed to 5. * diary.el: Autoload diary-sunrise-sunset and diary-sabbath-candles. * holidays.el: Autoload calendar-holiday-function-solar-equinoxes-solstices. Sat Jun 27 09:10:36 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * info.el: Bindings for Info-goto-emacs-command-node and Info-goto-emacs-key-command-node in help-map moved from here... * help.el: to here. * compile.el (compile-internal): Make the buffer read-only, to remind people that they probably don't want to mess with it. (compilation-sentinel): Make the buffer temporarily writable, so we can insert the termination message. * help.el, indent.el, paragraphs.el, isearch.el, replace.el: Deleted autoload cookies from these files; they are all loaded into Emacs by loadup.el. * loaddefs.el: Removed autoload sections for the above files. * loaddefs.el: Put autoload sections in alphabetical order by file name. * replace.el (perform-replace): Remember the match data from the real occurrence found, and restore it before executing the command. This preserves the match data across various other matching we do, and protects it from mungement while we're waiting for input. * loaddefs.el: Bind [M-right], [M-left], [M-up], and [M-down] to backward-sexp, forward-sexp, backward-list, and forward-list. Fri Jun 26 16:35:22 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * holidays.el (calendar-holiday-list): Protect holiday evaluation from bogus holidays on list. Fri Jun 26 00:13:43 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * outline.el (outline-flag-region): Bind buffer-read-only to nil. Thu Jun 25 23:26:35 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * calendar.el, diary.el, holidays.el: Merged new versions from Ed Reingold. * calendar.el (mark-holidays-in-calendar, all-hebrew-calendar-holidays, all-christian-calendar-holidays, all-islamic-calendar-holidays, list-diary-entries-hook, diary-display-hook, nongregorian-diary-listing-hook, nongregorian-diary-marking-hook, diary-list-include-blanks): Added autoload cookie for these; Reingold's distribution suggests that these variables are ones that you are especially likely to want to customize. * holiday.el (holidays): Added autoload cookie for this. Thu Jun 25 11:15:54 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * diary.el (diary-rosh-hodesh): Change mod to % in two places. Wed Jun 24 15:00:20 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * holidays.el (calendar-holiday-function-fixed, calendar-holiday-function-float. calendar-holiday-function-julian, calendar-holiday-function-islamic, calendar-holiday-function-hebrew): Correct documentation strings. * holidays.el (calendar-holiday-function-greek-orthodox-easter): New function. * calendar.el (calendar-holidays): Add Greek Orthodox Easter to all Christian holidays list. * calendar.el: calendar-load-hook: New variable; use it with run-hooks. calendar: Describe use of calendar-load-hook. Tue Jun 23 17:34:54 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * autoload.el: The docstring is the third element of a `defun' form, not the second. Tue Jun 23 17:06:24 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fill.el (fill-region-as-paragraph): Don't assume any indentation for a one-line paragraph. * dired.el: Complete rewrite, mostly by sk@thp.uni-koeln.de. * dired-aux.el: Other parts of dired. * files.el (enable-local-eval): Renamed from `ignore-local-eval'; now has values like `enable-local-variables'. (hack-local-variables): Test `enable-local-eval' properly. Mon Jun 22 00:58:59 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * autoload.el (generate-file-autoloads): Do attach a `doc-string-elt' property to `defun', `defvar', `defconst', and `defmacro'; since the files with ";;;autoload" cookies in them are never loaded into the dumped Emacs - otherwise, why would you be autoloading them?. Sun Jun 21 23:08:09 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fill.el (fill-region-as-paragraph): Handle fill-prefix wider than fill-column. Ensure we keep at least one word on each line. Also don't break after a period followed by just one space. Sun Jun 21 19:20:44 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * screen.el (ctl-x-5-map): Removed declaration and initialization of this here; it's done in subr.el, alongside ctl-x-4-map. * autoload.el (generate-file-autoloads): If FILE is in the same directory as the current buffer's file, or a subdirectory thereof, change FILE to be a path relative to the current buffer's file. This will allow `update-autoloads-here' to find a section's file even if the Emacs tree has been moved, as it would be when installed on a different system. Fri Jun 19 16:17:26 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * upd-copyr.el (update-copyright): Grok abbreviated years. Fri Jun 19 03:42:43 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * lisp-mode.el (indent-sexp): The local variable `last-point' was being asked to do double-duty - `calculate-lisp-indent' needs to be given a location guaranteed to be outside of the current s-expression, but the outer loop (according to the change made Dec 21 1989) needs to know where point was at the top of the loop. Added variable `starting-point' for `calculate-lisp-indent' to use. * lisp-mode.el (indent-sexp): Change the `while' loop to an `if', using `make-list' and `-' instead of `(list nil)' and `1+'. Thu Jun 18 16:28:26 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * edebug.el (edebug-debug): Added autoload cookie for this. * etags.el (find-tag-other-frame): New function. Bind it to `C-x 5 .'. Wed Jun 17 02:21:28 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * compile.el (compilation-error-regexp-alist): Tightened up the regular expressions designed to match lint pass 2 and lint pass 3 error messages. These were too loose; they were matching the "grep exited 00:06:20" messages at the end of the buffer. Tue Jun 16 23:24:42 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * upd-copyr.el (update-copyright): Do nothing if inhibit-update-copyright is non-nil. If the user answers "no", set that to t locally. (inhibit-update-copyright): New defvar. Mon Jun 15 17:07:08 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * mailabbrev.el: New version from jwz. Mon Jun 15 01:53:07 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * compile.el (compilation-enter-directory-regexp, compilation-leave-directory-regexp): In strings, replace uses of "\\\(" or "\\\)" with "\\(" or "\\)". (compilation-error-regexp-alist): Remember to include newlines in all the complemented character sets; none of these should match across a newline. Sun Jun 14 16:00:07 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * isearch-mode.el (isearch-forward): Remove sentence from doc string claiming that the key bindings are controlled by variables named `search-FOO-char'. That was true of the old isearch.el, but now the keymap `isearch-mode-map' controls special characters in isearch-mode. * blackbox.el (blackbox): Added ;;;###autoload cookie. * add-log.el (change-log-mode): Integrated some code from the `change-log-mode' function in `text-mode.el'. Docstring now mentions that it prevents numeric backups, and sets `left-margin' and `fill-column'. Code now actually sets `left-margin' and `fill-column', as advertised. * text-mode.el (change-log-mode): Function deleted, since it's been superceded by the one in add-log.el. Sun Jun 14 15:58:20 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gnus.el (gnus-start-news-server): Criterion for using the local news spool is now that gnus-nntp-server is "::". Sat Jun 13 19:34:19 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gnus.el (gnus-nntp-server): Eval gnus-default-nntp-server only if bound. Fri Jun 12 06:09:19 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * isearch-mode.el: New package, which will probably supercede isearch.el. (isearch-mode-map, isearch-mode-meta-map): When initializing these, remember that vectors are no longer keymaps. (isearch-update): unread-command-char is no longer -1 when there is no unread character - it's nil. * simple.el (interprogram-paste-function): Add the stipulation that the function this points to should return nil if Emacs sent the most recent string for interprogram pasting; the function should never return the same string Emacs posted with `interprogram-cut-function'. * term/x-win.el (x-last-selected-text): New variable. (x-select-text): Set it, so we can check later against returning it. (x-cut-buffer-or-selection-value): Check it, to make sure we don't return our own text. Fri Jun 12 18:24:26 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * simple.el (current-kill): Fixed misnamed parameter and reorganized code slightly. Thu Jun 11 16:39:10 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmailout.el (rmail-output): Get date using mail-fetch-field. Wed Jun 10 22:31:14 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * compile.el (compile-internal): Do buffer-disable-undo here. (compilation-mode): Not here. Wed Jun 10 02:57:23 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * simple.el (rotate-yank-pointer): Move the guts of this to current-kill, and get rid of the optional DO-NOT-MOVE argument. (current-kill): Rotate the yank pointer here. Tue Jun 9 21:55:13 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * subr.el (one-window-p): Rename argument ARG to NOMINI, so that the docstring will agree with the argument list generated by make-docfile.c. * simple.el (kill-region): Undo May 20th change - add back Roland McGrath's hack of June 17, 1991, which allows kill-region to work on read-only buffers - in read-only buffers, it acts just like copy-region-as-kill. Tue Jun 9 14:16:10 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * electric.el (Electric-command-loop): Set last-command after each cmd. * server.el (server-buffer-clients): Add permanent-local property. Mon Jun 8 21:31:52 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * csharp.el (c-find-nesting): Renamed from csharp-find-nesting. Add autoload. All other functions in this file renamed to start with c-find-nesting. Sun Jun 7 23:56:02 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.el (split-window-keep-point): Make it t by default. Sat Jun 6 18:00:57 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (delete-blank-lines): Handle special case near eob. Fri Jun 5 01:47:07 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (universal-argument): Don't call describe-arg. Pass t as 2nd arg to read-key-sequence. (prefix-arg-internal): Likewise. Thu Jun 4 15:56:49 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * startup.el (command-line): Run after-init-hook. Renamed pre-init-hook to before-init-hook for consistency with e.g., before-change-function. (after-init-hook): New defvar. * screen.el: Use before-init-hook instead of pre-init-hook. Thu Jun 4 07:55:48 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el: Doc fix. Wed Jun 3 16:43:53 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * info.el (Info-enable-edit): Now a user option. Wed Jun 3 13:47:20 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * sendmail.el (mail-signature): Suppress move to end of buffer if we gave a prefix argument (requested by Bob Chassell). Wed Jun 3 02:42:41 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * add-log.el (add-change-log-entry): Match the file name followed by a colon in an existing entry. To find a blank line, search for one containing only whitespace, not two consecutive newlines. When adding to an existing entry, open a line and indent. Wed Jun 3 01:32:30 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * add-log.el (change-log-mode): Set version-control to 'never locally. Set adaptive-fill-regexp. Make paragraph-separate match date lines. * bytecomp.el (byte-compile-file): Don't put file name in minibuffer. (byte-compile-buffer): Function commented out. * lisp-mode.el (lisp-indent-line): Keep point unchanged in ;;; line. Tue Jun 2 23:42:15 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * add-log.el (add-change-log-entry): If the visited file is in the directory tree under the directory containing the change log file, insert the path to it from there, rather than just the file name. Also removed setq of random variable `formatted-revision'. Tue Jun 2 23:25:04 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * yow.el: Somehow, the semicolons introducing the comment on the first line disappeared. Put them back. Tue Jun 2 22:52:32 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (eval-current-buffer): Add as alias for eval-buffer. * calendar.el (calendar): Add an autoload. * cal.el: File deleted. Tue Jun 2 20:19:12 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * add-log.el: Fixed copyright years to not use a range. (change-log-mode): Added docstring. (add-change-log-entry): Put a space between the file name and "(function name):". Put a colon after the file name if we have found no function name. Tue Jun 2 00:01:24 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * edebug.el (edebug-eval-buffer): New function. Install it in place of eval-buffer if eval-buffer is defined. (edebug-eval-current-buffer): Define this, not eval-current-buffer. Use fset to install it in place of eval-current-buffer. ??? mlconvert.el needs fixing too. * ispell.el: Add some autoloads. (ispell-word): Accept prefix arg, meaning do ispell-next. Mon Jun 1 16:27:45 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * simple.el (current-kill): Name the variable which holds the value from other programs to be pasted interprogram-paste, not interprogram-cut. * files.el: Bind find-file-other-screen to C-x 5 C-f as well as C-x 5 f, for symmetry with C-x C-f. Mon Jun 1 04:08:15 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * asm-mode.el (asm-mode-map): Don't override RET. * teco.el: Rename `teco:' to `teco-' in all symbols. (teco-command): Make it autoload. * edebug.el (edebug-defun): Make it autoload. * hexl.el (hexl-save-buffer): Return t. (hexl-mode): Put hexl-save-buffer in write-contents-hooks. (hexl-mode-map): Put the 1k page commands on C-x [ and C-x ]. * diff.el: Doc fix. * fill.el (fill-region-as-paragraph): Treat } like closeparen. If a fill prefix is specified globally, always use that one. * flow-ctrl.el (evade-flow-control-memstr=): Renamed from memstr=. Sun May 31 22:52:14 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * bibtex.el: merged in alarson's changes * simula.el: replaced Bj|rn Hessen's version with Hans Henrik Eriksen's improved version (both of them wanted it this way). Sun May 31 17:09:37 1992 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * subr.el (lambda): Added docstring. Sun May 31 16:12:58 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * gdb.el nuked --- subsumed by gdb entry point of gud.el * dbx.el nuked --- subsumed by dbx entry point of gud.el * session.el nuked --- saveconf.el is better * add-log.el now contains the add-log-new.el changes which merge consecutive entries by the same user on the same day and try to auto-generate both the file key and function changed fields --- the old version still exists in the ~n~ files if this loses, but the code looks good. Sat May 30 14:48:44 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * profile.el: installed * cus-print.el: installed Sat May 30 01:56:10 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * startup.el (normal-top-level): Call abbreviate-file-name instead of writing out its code. * comint.el: Merged with Olin Shivers' comint version 2.03. (comint-version): Changed accordingly. (comint-previous-input-matching): Bind this to c-m-r, rather than c-c c-r. (comint-exec-hook): Make this variable buffer-local. (comint-exec): Put the code which feeds the startfile to the inferior inside the let which binds ``proc'', as suggested by the indentation. (comint-read-noecho): New optional argument STARS, which causes input to be echoed with '*' characters on the prompt line. (send-invisible): Change prompt from "Enter non-echoed text: " to "Non-echoed text: ". This conforms with the convention used by existing prompts, and gives more room to type stuff. * comint.el (comint-last-input-start): New varible. In particular, this helps support subprocesses that insist on echoing their input. Added comments to porting guide indicating that this should probably not be used for implementing history stuff. (comint-mode): Create and initialize comint-last-input-start as a buffer-local var. (comint-send-input): Set comint-last-input-start when we send the input. Porting documentation at end of file adjusted to describe the differences between the old shell mode's last-input-start variable and comint-last-input-start. * telnet.el (telnet-send-input): If telnet-remote-echos is non-nil, use comint-last-input-start and comint-last-input-end to delete the input we just sent. Fri May 29 18:34:06 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * simple.el (append-to-buffer): When called interactively, default to (other-buffer nil t). This way, it will offer to insert into the buffer in the other window. Wed May 27 17:48:47 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * term/x-win.el (x-cut-buffer-or-selection-value): New function. Set interprogram-paste-function to use it. (x-select-text): For backwards compatibility, set cut buffer 0 as well as claiming ownership of the other selections. Wed May 27 02:41:36 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (indent-new-comment-line): Change handling of comment-multi-line (which is effectively obsolete now). Sun May 24 21:48:34 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (set-selective-display): Keep vpos of point constant. Sun May 24 12:20:28 1992 Edward M. Reingold (reingold at emr.cs.uiuc.edu) * calendar.el (list-yahrzeit-dates): New function. (hebrew-calendar-yahrzeit): Moved from diary.el. * diary.el (hebrew-calendar-yahrzeit): Moved to calendar.el. diary-ordinal-suffix: Give correct suffix for 111, 112, 113, 211, 212, 213, etc. Thu May 21 00:39:33 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * mouse.el: Emulate the Emacs 18 mouse button bindings for now. (mouse-yank-at-click): New function. * term/x-win.el (x-select-text): Don't bother to check if the window system is X; if it isn't, then this function would never have been defined, let alone called. Is this right, Joe? * simple.el (interprogram-paste-function): New hook, for getting the current pasting text from the window system. (kill-ring): Doc fix, encouraging people to use the functions below instead of manipulating the kill ring directly, since the functions correctly deal with interprogram cutting and pasting. (kill-new): New function. (kill-append): Added doc string. Be sure to call the interprogram-cut-function on the new string. (current-kill): New function. (rotate-yank-pointer): New optional argument do-not-move, to support vi.el and vip.el's style of ring access. (kill-region, copy-region-as-kill): Call kill-new, instead of writing out all the logic. (yank-pop): Use current-kill, rather than assuming that kill-ring-yank-pointer points to the text you should use. (yank): Use current-kill, instead of calling rotate-yank-pointer and then fetching through the kill-ring-yank-pointer. * vi.el (vi-put-before): Instead of figuring out the index into the kill-ring and fetching directly, call current-kill. * vip.el (vip-put-back, vip-Put-back, ex-copy): Use current-kill, don't access the kill ring directly. * term/x-win.el: Set interprogram-paste-function to 'x-selection-value. * sun-fns.el (mouse-yank-at-point): Instead of rotating the yank pointer one spot and then accessing the kill ring directly, just call the function current-kill with an argument of one. * simple.el (kill-ring-save): Blink to the other end of the saved region, if it's on the screen, or print out the text if it's not, instead of printing the number of characters saved. Nobody cares how many characters were saved, and it's hard to interpret intuitively. * screen.el (ctl-x-3-map): Renamed to ctl-x-5-map, and now bound to C-x 5, not C-x 3. This makes a nicer analogy with C-x 4. Moving split-window-horizontally to C-x 3 also makes a nicer analogy with C-x 2. * files.el, sendmail.el, subr.el: Uses of ctl-x-3-map here renamed. * window.el: Binding of split-window-horizontally moved from C-x 5 to C-x 3. Wed May 20 23:21:03 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * simple.el (kill-region): This used to forgo actually deleting the region if the buffer was read-only, meaning that the command would silently copy the region to the kill ring, but leave the buffer unmodified. Now it tries to delete the region, even if the buffer is read-only; go ahead and get the error. Tue May 19 23:23:53 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (one-window-p): If arg is t, completely avoid minibuffer. Tue May 19 19:29:06 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * version.el (version): New alias for emacs-version. Tue May 19 01:19:11 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * startup.el (normal-top-level): Typo: s/getev/getenv/. Wed May 13 01:50:16 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * subr.el (lambda): Define this as a macro which wraps the lambda expression in a (function ...) quoter. This means that you don't need to write out the cursed ``function'' any more. It might be cleaner to simply change the way the interpreter and compiler treat lambda. * loadup.el: Disable undo recording in scratch while we load all the files; re-enable them before we dump. Tue May 12 14:51:51 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * startup.el (normal-top-level): If (getenv "PWD") or (getenv "HOME") refer to the same directory as default-directory, change default-directory to the shortest of the three. * disass.el (disassemble-internal): Use indirect-function instead of just looping. Tue May 12 01:33:25 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * simple.el (kill-region): Call the interprogram-cut-function if it's non-nil. * term/x-win.el (x-select-text): New function for selecting text, asserts both PRIMARY and CLIPBOARD selections. Tue May 5 23:15:57 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ftp.el (ftp-command): Correctly ignore lines without status codes. * fill.el (fill-individual-paragraphs): Choice of two modes, controlled by fill-individual-varying-indent. Tue May 5 18:12:23 1992 Roland McGrath (roland@albert.gnu.ai.mit.edu) * files.el (save-some-buffers): Use save-excursion around whole fn, rather than several inside. Tue May 5 00:11:31 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * terminal.el (terminal-emulator): Use process-enironment, not env. Get rid of code that used start-subprocess. Sun May 3 14:11:14 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * mailabbrev.el (mail-abbrevs-v18-munge-map): Use define-key instead of making up an extra alist and nconcing it onto the keymap. Sat May 2 22:08:04 1992 Edward M. Reingold (reingold at emr.cs.uiuc.edu) * calendar.el (generate-calendar-month): Center heading over each month. Thu Apr 30 20:48:18 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * loaddefs.el: Moved (put 'narrow-to-page 'disabled t)... * page.el: To here. Tue Apr 28 16:18:43 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * mh-e.el (mh-signature-file-name): New variable. (mh-insert-signature): Use it. Mon Apr 27 14:53:12 1992 Roland McGrath (roland@albert.gnu.ai.mit.edu) * mailabbrev.el: New version from jwz. Sun Apr 26 12:49:06 1992 Roland McGrath (roland@albert.gnu.ai.mit.edu) * loaddefs.el: Removed (put 'narrow-to-region 'disabled t). It is done in simple.el. Sat Apr 25 18:10:26 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * dired.el (dired-mode): Make the modeline display the entire path of the directory, not just the buffer name. Fri Apr 24 15:41:06 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * flame.el: Add "flame-" prefix to internal functions, to conform with the naming conventions of the rest of Emacs. Tue Apr 21 16:13:33 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * doctor.el (doctor-svo): Deleted second expression from top let binding; it used to read "(let ((foo sent)) ...)"; let bindings can only have one expression. * flame.el: We might as well (provide 'flame). Sat Apr 18 16:40:29 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * startup.el (normal-top-level): Don't change default-directory to (getenv "PWD") unless they actually refer to the same directory. * rmail.el (rmail-unix-mail-delimiter): Doc fix. Fri Apr 17 15:56:25 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * rmail.el (rmail-unix-mail-delimiter): Don't bother giving this a docstring; move it to a comment. Fri Apr 17 08:21:14 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cmacexp.el: Doc fix. Wed Apr 15 02:08:03 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * simple.el (reindent-then-newline-and-indent, newline-and-indent): Call the newline function instead of saying (insert ?\n), so that auto fill mode will break lines correctly. * upd-copyr.el (update-copyright): Used to not change the copyright version when user elected to update the copyright year, but would change it when user decided not to update. Now doesn't do anything unless user gives permission, and when the user does give permission, does everything. * rmail.el (rmail-unix-mail-delimiter): New variable. (rmail-convert-to-babyl-format): Use it to recognize the start of an mbox message. (rmail-nuke-pinhead-header): Same. Wed Apr 15 01:38:13 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-find-buffer): Optional non-nil arg says to try to find some buffer other than the current one. Fri Apr 10 10:20:16 1992 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * holidays.el (calendar-cursor-holidays): Signal error when cursor is not on a date. Wed Apr 8 01:53:31 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * doctex.el, gdb.el, mh-e.el, vip.el: Use point{,-min,-max,-marker} functions instead of dot{,-min,-max,-marker}. Tue Apr 7 17:48:09 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * mailabbrev.el (mail-abbrev-expand-hook): Rewritten so it won't loop if a single address doesn't fit within fill-column. Sun Apr 5 19:25:54 1992 Roland McGrath (roland@albert.gnu.ai.mit.edu) * mailabbrev.el (sendmail-v18-self-insert-command): Just pass arg to sendmail-pre-abbrev-expand-hook. (sendmail-pre-abbrev-expand-hook): Take optional arg; if non-nil, call self-insert-command with it, and don't do expand-abbrev; just Mon Apr 6 16:29:50 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * lpr.el (lpr-command): Make this variable settable. Fri Apr 3 21:59:35 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * files.el (revert-buffer): Reverse the sense of the prefix argument; by default, do not offer to revert from the auto-save file. Thu Apr 2 02:55:58 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (write-contents-hooks): New variable. (basic-save-buffer): Use write-contents-hooks like write-file-hooks. Tue Mar 31 10:40:09 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * bytecomp.el (byte-compile-let, byte-compile-let*): Signal an error message if a binding has more than one value form. * sendmail.el (mail-position-on-field): Search for the mail header separator only occurring at the beginning of a line. Insert new headers correctly even if there are no other headers. * loadup.el: When finding pointers to doc strings, place the doc file in ../etc, not ../share-lib. It's been renamed. Tue Mar 24 00:08:33 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * mailabbrev.el: New version from jwz. * mailabbrev.el (mail-abbrev-expand-hook): If an address in the expansion begins with a /, turn it into an FCC header. * mailabbrev.el: Major rehacking. Should work in 18 and 19. Mon Mar 23 21:06:30 1992 Roland McGrath (roland@albert.gnu.ai.mit.edu) * simple.el (copy-region-as-kill): Doc fix. Mon Mar 16 10:23:29 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Moved provide clauses to bottom of every elisp file that contains one. * simple.el (undo): Don't print the "Undo!" message if we're in the minibuffer. Mon Mar 16 02:13:19 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * upd-copyr.el (update-copyright): Don't update the GPL version or replace the notice if the user said not to update the copyright. Wed Mar 11 22:46:33 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * sendmail.el (mail-fcc): New function. (mail-mode-map): Bind C-c C-f C-f to mail-fcc. * sendmail.el (mail-position-on-field): Recognize the mail-header-separator string, even when it's at the beginning of the buffer. Wed Mar 11 13:04:54 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * map-ynp.el (map-y-or-n-p): Doc fix. Sat Mar 7 22:04:35 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * upd-copyr.el (update-copyright): Take two new optional args, to ask the user whether to update, and whether to replace the year. When asking the user, narrow it down to things that look like GPL notices. (ask-to-update-copyright): New function, meant to be put on write-file-hooks. Thu Mar 5 20:28:19 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * compile.el (compilation-mode-hook): New variable. (compilation-mode): Run it. (compilation-search-path): Made user variable, added autoload cookie. (compilaton-window-height): Added autoload cookie. Thu Feb 27 17:06:03 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * hack-local-variables: Don't take a FORCE argument; it's as easy to bind enable-local-variables to t for a while as it is to pass an extra argument, and it's cleaner. * normal-mode: Instead of passing the FORCE argument, bind enable-local-variables. * set-auto-mode: Don't check for the -*- mode tag if enable-local-variables is nil. * loaddefs.el (auto-mode-alist): There's no reason for this definition and initialization to be here; moved it to... * files.el: Here. Fri Feb 21 12:27:50 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * telnet.el (read-password): Let the quit character terminate password entry. Fri Feb 7 16:43:03 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * info.el: Doc fix. Mon Jan 27 19:19:16 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * simple.el (universal-argument): Read key sequences, not single keys. Renamed `c-u' to `factor'. Describe the argument in the minibuffer as it is read. (prefix-arg-internal): Same changes here. Renamed CHAR argument KEY, to reflect the fact that it can now be an event sequence. (describe-arg): New function (actually, uncommented). (digit-argument, negative): Call prefix-arg-internal with a string for KEY argument, not a character. * simple.el (digit-argument): Strip off high bit of last-command-char. Fri Jan 17 18:15:08 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * term/tvi970.el: New file. Thu Jan 16 17:37:26 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * screen.el: Don't automatically bind C-z to iconify; this is inappropriate on terminals. * term/x-win.el: Bind C-z to iconify here. Wed Jan 15 18:22:42 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * term/wyse50.el: Rewritten to use function-key-map. * simple.el: Include bindings for [up], [down], [left], and [right]. Mon Jan 13 02:01:42 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * setenv.el: New file. * simple.el (x-select-kill): Variable removed. (interprogram-cut-function): New variable. (copy-region-as-kill): Use it. * term/new-at386.el: Rewritten to use function-key-map. Fri Jan 10 19:46:58 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * flow-ctrl.el: installed. Wed Jan 8 16:27:17 1992 Jim Blandy (jimb at occs.cs.oberlin.edu) * simple.el (temporary-goal-column): Added missing closing paren. Wed Dec 25 22:24:50 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * mail-utils.el (mail-strip-quoted-names): Return nil if given nil. Mon Dec 23 21:01:57 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * debug.el (cancel-debug-on-entry): Complete over debugged functions. Sat Dec 21 03:03:04 1991 Jim Blandy (jimb at occs.cs.oberlin.edu) * at386.el: Moved to term/at386.el, changed to use function-key-map. Fri Dec 20 02:18:27 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * term/news.el, term/vt100.el: Converted to use function-key-map instead of old keypad.el. * term/sun.el: Console key sequences converted to use function-key-map; emacstool bindings left alone. Mon Dec 16 22:29:36 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * mailabbrev.el: New file. * sendmail.el (mail-setup): Delete code for mail-aliases. Call mail-aliases-setup instead. (sendmail-send-it): Delete code for mail-aliases. (build-mail-aliases, expand-mail-aliases): Autoloads deleted. Sat Dec 14 10:04:49 1991 Eric S. Raymond (eric at mole.gnu.ai.mit.edu) * etags.el (find-tag-noselect): fixed subtle bug due to save-excursion. (tags-tag-match): new function, made smarter about exact matches. Fri Dec 13 04:48:43 1991 Eric S. Raymond (eric at mole.gnu.ai.mit.edu) * perl-mode.el: installed. Fri Dec 13 02:33:26 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * sendmail.el (mail-default-headers): New user variable. (mail-setup): Insert value of that variable. Wed Dec 11 11:04:04 1991 Eric S. Raymond (eric at mole.gnu.ai.mit.edu) * c-mode.el: added C++ style to c-style-alist. * at386.el: installed. Mon Dec 9 21:58:03 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * man.el (nuke-nroff-bs): Simplify o^H+. Delete "reformatting" msg. Sun Dec 8 04:36:37 1991 Eric S. Raymond (eric at mole.gnu.ai.mit.edu) * blackbox.el: Applied doc patch. No functions affected. * etags.el: support new (find-tag-noselect) entry point. * info: patched to restore point on `up' to previously visited buffer. * sccs.el: installed 3.5 Sun Dec 8 02:07:23 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * simple.el (universal-argument): If there is already an argument specified, don't toss it and read a new one; instead, end argument processing and read the next key literally. (digit-argument, negative-argument): Doc fix. * tar-mode.el (tar-subfile-save-buffer): Use the new current-time subr to generate real timestamps. (tar-update-datestamp): Remove docstring paragraph that claims the feature is not implemented. Remove similar paragraph from TO DO list at top of file. Sun Dec 8 00:43:23 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * diff.el (diff-internal-diff): New subroutine. (diff): Removed from here. (diff-sccs, diff-rcs): New commands using diff-internal-diff. (diff-rcs-extension): New variable. Thu Dec 5 13:49:30 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * apropos.el, doctex.el, help.el, paths.el, spook.el, yow.el: These files expected to find their data in exec-directory, but their data is now located under data-directory. Changed to use data-directory as appropriate. * loadup.el: Changed to use the appropriate path names. Mon Dec 2 22:22:34 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * mailalias.el (define-mail-alias): Handle quoted aliases. Sat Nov 30 22:49:11 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * simple.el (prefix-arg-internal): Make C-u end the arg. Doc fixes on the argument commands. Thu Nov 28 20:23:03 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * emacsbug.el (report-emacs-bug): Now autoloaded. Sun Nov 24 14:38:24 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * simple.el: Doc fix. Fri Nov 15 19:07:30 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * startup.el (command-line): Don't bother catching errors that occur while the window system file is loading; cmd_error can now properly handle errors that occur before screens are set up properly. * startup.el (command-line): baud-rate is a variable, not a function. Thu Nov 14 16:44:01 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * info.el (Info-mode): Mention Info-directory in the list of commands in the docstring. (Info-follow-nearest-node): Rebalance parens. Mon Nov 11 18:15:43 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * find-dired.el: New version munged by sk for tree dired. Wed Nov 6 11:05:24 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * screen.el (screen-initialize, screen-notice-user-settings): Renamed global-minibuffer-screen to default-minibuffer-screen. Tue Nov 5 15:43:54 1991 Edward M. Reingold (reingold at emr.cs.uiuc.edu) * diary.el (diary-rosh-hodesh): Add Erev Rosh Hodesh to the diary, as needed. Thu Oct 31 22:24:04 1991 Richard Mlynarik (mly at peduncle) * ebuff-menu.el (eletric-buffer-menu-mode-map): Define < and > to scroll-left and scroll-right per user suggestion. Thu Oct 31 01:34:14 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * files.el (cd): Don't bother calling pwd after changing the directory. * shell.el (shell-mode): Doc fix. * screen.el (screen-notice-user-settings): When replacing the initial screen with a minibuffer-only screen, append the original screen's parameters to initial-screen-parameters, so that moves and resizes may take place if appropriate. * cmushell.el: This is now the real shell.el. Removed the "cmu" prefix from names. (shell): Marked this to be autoloaded. Tue Oct 29 11:58:48 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * files.el (find-file-noselect): Extract filename abbreviation code into separate function. (abbreviate-file-name): This is that. * files.el (after-find-file): If the directory containing the file doesn't exist, offer to create it. (make-directory-path): New function to support this offer. Mon Oct 28 21:42:48 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * macros.el (apply-macro-to-region-lines): Use a marker to keep track of the next line to operate on, so the macro can delete or add lines. Sat Oct 26 00:27:40 1991 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * disass.el (disassemble): Correctly distinguish functions with no interactive spec and functions that are (interactive). Correctly extract components of explicit calls to byte-code (old-style compiled functions). Correctly pass byte code of function to disassemble-1. (disassemble-1): Use nth to extract components of explicit call to byte-code, not car and cdr. Fri Oct 25 18:17:26 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * lisp-mode.el (eval-print-last-sexp): Saying (terpri (current-buffer)) after evaluating the expression does bad things if the expression changes the current buffer, so bind standard-input to the buffer that is current before evaluation. Mon Oct 21 19:56:11 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-buffer-name-function, compilation-finish-function): Add autoload cookie for these. Tue Oct 15 03:03:27 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * info.el (Info-follow-nearest-node): Adjusted for new return value format from coordinates-in-window-p. Tue Oct 8 15:44:51 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * add-log.el (change-log-name): New fn. (add-change-log-entry, add-change-log-entry-other-window): All args optional. FILE-NAME defaults to new var `change-log-default-name'. Give this var a local value in the buffer we were run from, pointing to the file we found. Mon Oct 7 17:36:30 1991 Roland McGrath (roland@geech.gnu.ai.mit.edu) * compile.el (compilation-buffer-p): New fn. (compilation-find-buffer, compile-goto-error): Use it. Sat Oct 5 18:07:29 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * compile.el (compile-internal): Don't make state vars local. (compilation-mode): Do it here. (compilation-parse-errors-function, compilation-error-message): Give initial values. (compile-goto-error): Look for compilation-error-list rather than compilation-parse-errors-function in the buffer-local variables to see if this is a compilation buffer, because the latter might not be local. Fri Oct 4 19:30:07 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * files.el (revert-buffer): Call verify-visited-file-modtime with one arg (the current buffer), instead of none. Fri Oct 4 16:17:14 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * rmail.el: Changed two regexps not to look specifically for 19yy for years; look for yyyy instead. Planning for the millenium. Thu Oct 3 18:36:31 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * version.el (emacs-version): (From Bob:) Take optional arg (prefix arg) to insert version text at point. Thu Sep 26 05:28:34 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * info.el (Info-default-directory-list): defvar this instead of defconsting it, so paths.el can set it. Thu Sep 26 01:40:12 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * map-ynp.el (map-y-or-n-p): Fixed for lists containing nil. Mon Sep 10 19:43:20 1991 Roland McGrath (roland@wookumz.gnu.ai.mit.edu) * autoload.el (batch-update-autoloads): Use catch and throw to give up on a file altogether if it gets an error. * autoload.el (update-file-autoloads): Always check the old section. If the file has no cookies, it will be deleted and not replaced. Sun Sep 8 17:44:17 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * simple.el (line-move): After C-e, do consider eol of blank line. Don't treat start of blank line as eol. Sat Sep 7 13:55:38 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * fill.el (fill-individual-paragraphs): Find a fill-prefix that works for the whole paragraph. * simple.el (line-move): Don't treat start of blank line as eol. Tue Sep 3 21:55:08 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * debug.el (debugger-step-through): Fix message typo. Mon Sep 2 20:28:24 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * server.el (server-start): Delete old socket in /tmp as well as in ~. Mon Aug 26 23:30:14 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * abbrev.el, chistory.el: Remove periods from error messages. Sun Aug 25 16:02:03 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * help.el (describe-function, describe-variable): Return the same text as was displayed. * files.el: Doc fix. * files.el: Don't require map-ynp. * map-ynp.el: No need for provide. * loadup.el: Load map-ynp. Fri Aug 23 10:35:45 1991 Edward M. Reingold (reingold at emr.cs.uiuc.edu) * calendar.el (calendar-last-day-of-month, calendar-leap-year-p, calendar-day-number, calendar-absolute-from-gregorian): Change from functions to macros for speed. Thu Aug 22 19:57:12 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * files.el (find-backup-file-name): (apply fun (cons first rest)) => (apply fun first rest). Come on, guys. Tue Aug 20 16:20:42 1991 Michael I Bushnell (mib@geech.gnu.ai.mit.edu) * rmail.el (rmail-convert-to-babyl-format): Roland added the missing paren in the wrong place; fixed. * screen.el (screen-initialize): Added missing `function' around lambda expression. Tue Aug 20 16:15:13 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * files.el (switch-to-buffer-other-screen, find-file-read-only-other-screen): Remove extra parens. * rmail.el (rmail-convert-to-babyl-format): Add missing paren. Mon Aug 19 12:16:47 1991 Edward M. Reingold (reingold at emr.cs.uiuc.edu) * calendar.el (redraw-calendar): Preserve cursor location in redrawing. (extract-calendar-month, extract-calendar-day, extract-calendar-year): Change from functions to macros to speed up computation. * holiday.el: calendar-holiday-function-rosh-hashanah-etc: Correct date of Selichot. Sun Aug 18 19:46:20 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * rmail.el (rmail-convert-to-babyl-format): If can't find end of babyl header or babyl message, try to resync with next ordinary message. Sat Aug 17 20:54:46 1991 Roland McGrath (roland@geech.gnu.ai.mit.edu) * doctor.el (doctor-strangelove): New fn. (doctor-member): Removed. (doctor-doc): Use member instead of doctor-member. (doctor-rms): Restored. Fri Aug 16 00:07:35 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * term/x-win.el: Removed obsolete definitions for function keys. Thu Aug 15 02:32:24 1991 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * screen.el (screen-create-initial-screen): Renamed to screen-initialize. Arrange to cause errors if people try to create screens when no window system is running. * loadup.el: load screen.el into the dumped emacs. * subr.el (add-hook): Cons FUNCTION onto the value of the symbol HOOK, not the symbol itself. * loaddefs.el (ctl-x-4-map): Move definition from here... * subr.el (ctl-x-4-map): To here. (ctl-x-3-map): New prefix. (mouse-map): Deleted. * screen.el (new-screen-x-delta, new-screen-y-delta, new-screen-position): Removed. (new-screen): Simplified. (split-to-other-screen): Removed. (switch-to-buffer-other-screen, find-file-other-screen, find-file-read-only-other-screen, mail-other-screen): Moved, along with their keybindings, to... * files.el (switch-to-buffer-other-screen, find-file-other-screen, find-file-read-only-other-screen): Here... * sendmail.el (mail-other-screen): And here. Wed Aug 14 18:48:25 1991 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * files.el (generate-new-buffer): Function moved here from src/buffer.c. (set-visited-file-name): Use the new argument to rename-buffer. * macros.el (apply-macro-to-region-lines): Don't complain if there is no defined keyboard macro if one was passed as an argument. Don't test if macro is null inside the loop; set it to last-kbd-macro outside the loop. Wed Aug 14 18:30:38 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * info.el: Removed bindings and help reference to nonexistent mouse commands. (Info-default-directory-list): New defconst, list to initialize Info-directory-list with by default. (info): Initialize Info-directory-list to Info-default-directory-list if there is no INFODIR envariable. * paths.el (Info-default-directory-list): Define instead of Info-directory-list. Tue Aug 13 07:57:29 1991 Ken Raeburn (raeburn@watch.com) * time.el (display-time-24hr-format): New variable. (display-time-filter): If display-time-24hr-format is non-nil, display time in 24-hour format, rather than using AM/PM suffix. Also, don't blow up in substring if load average is unavailable. Tue Aug 13 04:31:30 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * screen.el: Incorporated other-screen functions and key bindings. * screen.el: iconification code reworked; this code will require a mapping hook of some sort to work correctly. * screen.el, term/x-win.el: Renamed screen-default-alist to default-screen-alist. (default-screen-alist): Moved declaration to screen.c; the screen creation subrs should consult this transparently. * term/x-win.el (x-get-resources, x-pop-initial-window): Functions deleted. Don't call them at the bottom of the file anymore. Mon Aug 12 02:16:22 1991 Roland McGrath (roland@geech.gnu.ai.mit.edu) * simple.el (undo-start): Doc fix: undo-pointer -> pending-undo-list. * files.el (save-some-buffers): Add missing `(and' and matching `)' so that buffer-offer-save is actually tested. Mon Aug 12 01:14:37 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * window.el (split-window-keep-point): New user option. (split-window-vertically): Modified to support it. * startup.el (command-line): Choose a default value for split-window-keep-point according to the baud rate. * term/x-win.el: Set split-window-keep-point. Sat Aug 10 21:02:00 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * term/x-win.el (x-daemon-mode, x-establish-daemon-mode): Removed these functions; we do this differently now. Wed Aug 7 22:49:14 1991 Roland McGrath (roland@geech.gnu.ai.mit.edu) * autoload.el (batch-update-autoloads): Do (save-some-buffers t) before killing emacs, so loaddefs.el will be saved. Mon Aug 5 18:41:25 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * screen.el (screen-creation-func): Renamed to screen-creation-function, as per the convention. * screen.el (screen-creation-func): Do not initialize this according to the window system name; let the window system-specific file initialize it however it wants. * term/x-win.el: Set screen-creation-function to x-create-screen. * screen.el: All of the screen startup code reworked. Thu Aug 1 14:48:40 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * startup.el (pre-init-hook): New variable. (window-setup-hook): Doc fix. (command-line): Call pre-init-hook. (command-line-1): Updated copyright date. Wed Jul 31 13:39:04 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * rmailedit.el: When initializing rmail-edit-map, take the cdr of text-mode-map before nconcing it, to omit the keymap header. Wed Jul 31 02:03:38 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * screen.el (auto-new-screen-function): Renamed to pop-up-screen-function. (buffer-in-other-screen): Use pop-up-screens, not auto-new-screen. Tue Jul 30 22:49:17 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * apropos.el (apropos, super-apropos): Don't make window for no syms. Mon Jul 29 23:34:04 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * loaddefs.el: Don't make backup versions of this file. Sun Jul 28 14:39:44 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * autoload.el (generate-autoload-cookie): Doc fix. Sun Jul 28 08:42:20 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * etags.el: Renamed new-etags.el, copied Emacs 18's tags package into its place - the new version seemed to have half-completed major changes. Added autoload marks and changed it to (provide 'etags) instead of tags. * help.el: Autoload the (defvar help-map ...) so that info.el can define keys in it. * loaddefs.el: Updated. Sat Jul 27 20:20:57 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * info.el (Info-find-emacs-command-node): New fn. (Info-goto-emacs-command-node, Info-goto-emacs-key-command-node): New fns, bound to C-h C-f and C-h C-k, to pop to the info node for an Emacs command or keystroke. Fri Jul 26 23:25:42 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * terminal.el (te-stty-string): Delete `new' since loses on SYSV. Thu Jul 25 19:22:02 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * edebug.el: Version 2.5 from LaLiberte. Thu Jul 25 12:40:39 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * view.el: (define-key "C-xv" 'view-file). (view-file-other-window, view-buffer-other-window): New functions. (view-prev-buffer): Renamed to view-return-here. (view-exit): If view-return-here is a buffer, switch to it; if it is a window configuration, apply it. * subr.el (search-forward-regexp, search-backward-regexp): Added alternate names. Wed Jul 24 00:34:15 1991 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * diff.el (diff): Turn off read-only flag to insert "no differences" message. Tue Jul 23 18:54:26 1991 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * isearch.el (isearch): If the user switches to a different screen, exit the isearch. * isearch.el (isearch): Changed reference to `cmds' to use variable's new name `history'. Tue Jul 23 15:00:06 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * rmail.el (rmail-first-unseen-message): Make loop looking for unseen msgs not skip the first one. * rmail.el (rmail-widen-to-current-msgbeg): Added missing close paren. Sun Jul 21 07:54:33 1991 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * isearch.el (isearch): Don't assume that we're repeating a search that found an empty string; check history to make sure we're repeating a search and not starting one up with a pattern from the ring. * view.el: When initializing view-mode-map, use the new-style key maps. * screen.el (auto-new-screen-function): Set this to a lambda which calls the screen-creation-func. Fri Jul 19 16:14:33 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * backquote.el (bq-make-maker): Don't replace quoted shared structure by copies. Fri Jul 19 10:42:57 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * files.el (save-some-buffers): Added save-excursions around code that does set-buffer. Mon Jul 15 19:33:30 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (visit-tags-table): Don't make tags-completion-alist. (tags-completion-alist): If tags-completion-alist is non-nil, return it; else build it and then return it. (find-tag-tag): Pass 'tags-completion-alist as TABLE to completing-read, so the table is built on demand. * sendmail.el (mail-do-fcc): Added missing close paren. Mon Jul 15 17:54:22 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * term/x-win.el: Enable interrupt-driven input after opening the X connection, so that the fcntls on file descriptor 0 apply to the socket, not the terminal. * screen.el: Don't bind `C-x o' to next-multiscreen-window or displace other-window to `M-o'. Mon Jul 15 09:15:26 1991 Stephen A. Wood (saw at hallc1) * fortran.el version 1.28.3 Now works in either mode when `tab-width' is not 8. (fortran-electric-line-number, fortran-indent-to-column): Use `fortran-minimum-statement-indent' instead of 8. (fortran-current-line-indentation): Now skips over line number and whitespace correctly when tab-width is not 8. (fortran-setup-tab-format-style): Set `fortran-comment-line-column' and `fortran-minimum-statement-indent' to (max tab-width 6) instead of 8. The minimum 6 insures legal indenting for lines with line numbers. Sat Jul 13 02:19:05 1991 Jim Blandy (jimb at churchy.gnu.ai.mit.edu) * info.el (Info-find-node): Call buffer-flush-undo with one arg, instead of none. Change call to get-buffer-c>reate to get-buffer-create. * startup.el (command-line): Remove the arguments from command-line-args as we process them. (command-line-1): Removed code to ignore the arguments processed in command-line, because they're all deleted now. * replace.el (occur): Set tem to the location of the match before adding it to occur-pos-list, so we don't end up with an occur-pos-list of nulls. And allocate the final-context-start marker once, so we don't allocate jillions of markers in the Thu Jul 11 17:58:13 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * term/x-win.el (x-handle-args): Re-written to take the command line switch as an argument, instead of just assuming it's in ARGS, and return the modified list. Changed caller to pass and set command-line-args. * startup.el (command-line): Re-balance parens. Pass command-line-args to command-line-1, not args. Tue Jul 9 12:28:14 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * map-ynp.el (map-y-or-n-p): Fixed lossage on ? or random char. Mon Jul 8 21:26:28 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * ftp.el (ftp-command): Skip multiline messages. Mon Jul 8 12:01:34 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * ispell.el (ispell-buffer): fset to 'ispell. * map-ynp.el (map-y-or-n-p): Don't quote a form inside quasiquote. Thu Jul 4 16:56:45 1991 Stephen A. Wood (saw at hallc1.cebaf.gov) * fortran.el: Added ;;;###autoload definition for fortran-tab-mode-default variable. * fortran.el (fortran-numerical-continuation-char): Replace (backward-line 1) with (forward-line -1) since backward-line is defined only in edt. (fortran-previous-statement): Fix error in parens. (fortran-indent-to-column): Likewise. Thu Jul 4 13:01:57 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * files.el (save-some-buffers): Use map-y-or-n-p return value. * map-ynp.el (map-y-or-n-p): Fixed bug that caused first elt on ! hit not get acted on. Thu Jul 4 13:03:51 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * cmacexp.el (c-macro-expand): Use new variables c-macro-preprocessor and c-macro-options. * teco.el: New file. Mon Jul 1 16:59:51 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * map-ynp.el (map-y-or-n-p): Fixed misplaced paren. Fixed list-eating bug. Mon Jul 1 14:17:51 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * ws-mode.el: New file. * forms.el: New version from Vromans. Sat Jun 29 16:04:08 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * map-ynp.el (map-y-or-n-p): LISTS may also be an iterator fn. PROMPTER may also be a format string. Sat Jun 29 15:49:13 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * simple.el (shell-command-on-region): Handle case where input is from *Shell Command Output*. Fri Jun 28 17:19:23 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * startup.el (command-line): Let init file change command-line-args. Don't fail to advance args past -debug-init. (command-line-1): Ignore here options processed at earlier stages. Wed Jun 26 12:27:39 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * term/x-win.el (x-read-resources): When a resource is not available, use (nth 2 key-resname-default) to get the default, not (nth 3 key-resname-default), which is nil. Open the connection to the server *before* trying to read the resources, silly. Thu Jun 20 06:28:50 1991 Jim Blandy (jimb at wookumz.gnu.ai.mit.edu) * subr.el (ignore): Added docstring for this; it appears as a key binding, so it ought to be described. Wed Jun 19 12:26:17 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * find-dired.el (find-dired-sentinel): Don't twiddle a killed buffer. Mon Jun 17 17:50:46 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * simple.el (kill-region): Allow read-only buffers. * find-dired.el (find-dired-filter): If the buffer has been killed, delete the process. * find-dired.el (find-ls-option): Made a defvar rather than defconst. Wed Jun 12 14:01:07 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * upd-copyr.el (update-copyright): Fixed typo in help text. Sun May 26 12:34:50 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * disass.el (disassemble-internal): Fixed typo string? -> stringp. Sun May 26 11:36:43 1991 Edward M. Reingold (reingold at emr.cs.uiuc.edu) * holiday.el (calendar-holiday-function-passover-etc): Correct date and spelling of Yom HaAtzma'ut. Thu May 23 18:14:55 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * mail-utils.el: Require lisp-mode, because we use lisp-mode-syntax-table. Lisp-mode is usually in the dumped emacs, but dumping should always be a convenience, not an unstated expectation. * lisp-mode.el: Do a (provide 'lisp-mode). Initialize lisp-mode-syntax-table outside of all functions, so that we don't have to hope that lisp-mode-variables has been called before using mail-strip-quoted-name. Odd dependencies. * sendmail.el (mail-archive-file-name): Make this a defvar, not a defconst. There seems to be no entry saying why this was made a defconst. * text-mode.el (indented-text-mode-map): When redefining TAB, don't clobber the definition in text-mode-map, but DO share the rest of text-mode-map. Thu May 23 14:34:03 1991 Michael I Bushnell (mib@geech.gnu.ai.mit.edu) * startup.el (command-line): don't do anything if $VERSION_CONTROL is not set; move code to import environment var ahead of .emacs load. Wed May 22 20:11:53 1991 Brian Preble (rassilon at mole.gnu.ai.mit.edu) * forms.el (scroll-up, scroll-down): Made argument &optional. Wed May 22 18:04:28 1991 Michael I Bushnell (mib@churchy.gnu.ai.mit.edu) * rmail.el (rmail-variables): Rmail should not be a save-buffer-skip buffer. If the user wants this confusing behavior, it can be personally customized. Wed May 22 15:05:03 1991 Jim Blandy (jimb at wookumz.gnu.ai.mit.edu) * term/x-win.el (x-switches-specified): Variable deleted; the options given on the command line are placed in screen-default alist, so that all the screens created get them. (x-handle-switch, x-handle-numeric-switch): Put the values in screen-default alist instead of in x-switches-specified. (x-handle-geometry): Put the geometry in initial-screen-alist. (x-pop-initial-window): Build the arguments to pop-initial-screen from initial-screen-alist and screen-default-alist alone; don't use x-switches-specified. (x-read-resources): New function to read the X defaults and put them in screen-default-alist. Call this function at the bottom. * screen.el (death-function): Removed, because this is now handled better in startup.el. (pop-initial-screen): Don't do a condition-case to call death-function. Sat May 18 14:11:06 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * macros.el (apply-macro-to-region-lines): Added a save-excursion around the macro invocation, so that the macro doesn't need to stay on the same line. * gdb.el (gdb-call): Don't set gdb-delete-prompt-marker to an empty region when the process-mark was at the beginning of the line, because this will cause an infinite loop in gdb-maybe-delete-prompt. * startup.el (command-line): If an error occurs while initializing the window system, catch it and write the error message to external-debugging-output. Fri May 17 14:20:11 1991 Edward M. Reingold (reingold at emr.cs.uiuc.edu) * holiday.el: Add Erev Shavuot to the full list of Jewish holidays. Thu May 16 15:05:52 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * macros.el (apply-macro-to-region-lines): New function. * term/x-win.el (x-handle-switch): The newline at the end of the comment line at the top of this function was missing. Thu May 16 14:22:10 1991 Roland McGrath (roland@geech.gnu.ai.mit.edu) * autoload.el (batch-update-autoloads): New function to update autoloads with emacs -batch. * autoload.el (generate-file-autoloads): Don't put non-autoload forms in the (autoloads ...) list in the header. Tue May 14 18:05:51 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * map-ynp.el (map-y-or-n-p): Put the cursor in the echo area while prompting. Mon May 13 21:55:14 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * bytecomp.el (byte-compile-setq): Clean error if var not a symbol. Mon May 13 18:09:52 1991 Roland McGrath (roland@geech.gnu.ai.mit.edu) * autoload.el (update-file-autoloads): If the file is in a buffer and that buffer is modified, update the autoloads regardless of the file times. If the file was not in a buffer before, kill the buffer we create. update-directory-autoloads on /gd/gnu/emacs/lisp had a tendency to eat all available memory. Mon May 13 17:35:33 1991 Brian Preble (rassilon at mole.gnu.ai.mit.edu) * abbrev.el, add-log.el, apropos.el, asm-mode.el, autoload.el: awk-mode.el, backquote.el, bibtex.el, bytecomp.el, c++-mode.el: cal.el, calc-ext.el, calc.el, chistory.el, cl-indent.el, etags.el: compare-w.el, compile.el, dabbrev.el, debug.el, diary.el, diff.el: dired.el, disass.el, dissociate.el, doctor.el, ebuff-menu.el, edt.el: echistory.el, edebug.el, edmacro.el, emerge.el, find-dired.el: fortran.el, ftp.el, gdb.el, gnus.el, gnuspost.el, gosmacs.el: hanoi.el, helper.el, holidays.el, indent.el, info.el, informat.el: isearch.el, ispell.el, ledit.el, loaddefs.el, rect.el, macros.el: mail-utils.el, mailalias.el, makesum.el, man.el, map-ynp.el, mh-e.el: mlconvert.el, modula2.el, novice.el, nroff-mode.el, options.el: outline.el, paragraphs.el, picture.el, prolog.el, lpr.el, replace.el: reposition.el, rmail.el, spell.el, scribe.el, sendmail.el, server.el: shell.el, sort.el, scheme.el, tabify.el, telnet.el, terminal.el: tex-mode.el, texinfmt.el, texinfo.el, time.el, timer.el: underline.el, userlock.el, vi.el, view.el, vip.el, xscheme.el, yow.e: Fixed ;;;###autoload definitions. Mon May 13 16:52:53 1991 Roland McGrath (roland@geech.gnu.ai.mit.edu) * autoload.el (generate-file-autoloads): Don't do special doc-string hacking for defvar and defconst. We in fact don't want loaddefs.el to have docstrings make-docfile can grok; it should be able to grok the originals, but not the copies, so there will be only one copy of each docstring in the DOC file. Mon May 13 16:16:50 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * isearch.el (search-exit-char): As per the opinion poll results, change this to RET. (isearch): Change miscellanous internals so that newline is automatically quoted, and change the docstring and comments to say that RET exits the search. Mon May 13 14:38:26 1991 Roland McGrath (roland@geech.gnu.ai.mit.edu) * find-dired.el (find-ls-option): New defconst, string for "-ls". (find-dired): Use it. Mon May 13 11:37:01 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * loaddefs.el (auto-mode-alist): Recognize .emacs only at end. Mon May 13 10:27:56 1991 Jim Blandy (jimb at wookumz.gnu.ai.mit.edu) * simple.el (blink-matching-open): Make this function interactive. Sun May 12 20:30:31 1991 Roland McGrath (roland@geech.gnu.ai.mit.edu) * find-dired.el (find-name-dired): Simple-minded find-dired interface to do "find -name PATTERN". * find-dired.el (find-dired-filter): Don't search; use forward-line instead. (find-dired-filter, find-dired-sentinel): Changed docstrings to comments. Sat May 11 13:21:09 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * loaddefs.el: Moved some defvars and defconsts to other files (with ;;;###autoload). * reposition.el: Bind reposition-window to M-C-l. Thu May 9 16:31:24 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * autoload.el: New file, a package to maintain autoloads in loaddefs.el. * *.el: Make everything use it. Comments in loaddefs.el explain what to do. * etags.el: (provide 'etags) inside of (provide 'tags). Why was the file renamed?? * lisp-mode.el (eval-print-last-sexp): Use terpri instead of newline. Thu May 9 07:15:16 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * disass.el (disassemble-internal): Rearranged to conveniently handle compiled-function objects. (disassemble-1): Extract bytes and constants correctly from both compiled-function objects and calls to the byte-code function. * simple.el (kill-region): Remove the second item from the interactive spec; this is a vestige from when this function took a "verbose" argument. * lisp-mode.el (eval-print-last-sexp): Insert newlines before and after evaluating the expression. Wed May 8 15:21:27 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * map-ynp.el: New file defines new fn map-y-or-n-p. * files.el (save-some-buffers): Rewritten to use it. Wed May 8 13:25:59 1991 Brian Preble (rassilon at mole.gnu.ai.mit.edu) * rmail.el: Doc fix. (rmail-first-message): New function; bound to "<". Wed May 8 06:23:25 1991 Jim Blandy (jimb at churchy.gnu.ai.mit.edu) * screen.el: Removed temporary hack to set up auto-new-screen and auto-new-screen-function. Tue May 7 20:31:28 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * find-dired.el: New fn M-x find-dired lets you run a `find' command and do dired on the result. * loaddefs.el (find-dired): Autoload it. Mon May 6 15:00:00 1991 Stephen A. Wood (saw at hallc1.cebaf.gov) * fortran.el version 1.28 Major upgrade of previous version 1.21. Cleaned up doc-strings, made all lines 80 or less characters and made the following changes. Added modify-syntax-entry's for ?\r and ?=. Bound LFD to fortran-reindent-then-newline-and-indent. Rebound \C-c\C-w to fortran-window-create-momentarily. Added numerous default abbreviations for keywords. (fortran-mode): Definition of `comment-line-start-skip' changed. `abbrev-mode' is set to t by default. New local variables `fortran-tab-mode', `fortran-comment-line-column', `fortran-minimum-statement-indent', `fortran-column-ruler', and `fortran-tab-mode-string'. Call fortran-analyze-file-format. (fortran-window-create, fortran-window-create-momentarily): Cleaned up first function, created second to create a window 72 characters wide until a key is struck. (fortran-electric-line-number): Distinguish digit as continuation character from digit as line number. (fortran-previous-statement, fortran-next-statement): Recognize tab-digit continuation lines as well as fixed format. (fortran-blink-matching-if): New command. (fortran-indent-line): Change indentation of comments. (fortran-reindent-then-newline-and-indent): New command. (calculate-fortran-indent): Now handles tab format style. If a previous END statement is found, the indentation is reset to the minimum. (fortran-current-line-indentation, fortran-indent-to-column): (fortran-split-line, fortran-numerical-continuation-char): (fortran-line-number-indented-correctly-p): Handle tab format style. (fortran-analyze-file-format): (fortran-tab-mode, fortran-setup-tab-mode-style): (fortran-setup-fixed-format-style): New commands. Sun May 5 21:24:04 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * calc.el: When setting up calc-digit-map, don't try to apply aref to the keymaps; extract the vectors from the keymaps before working on them. * calc-ext.el: When setting up calc-mode-map, use define-key and lookup-key instead of aset and aref. Fri May 3 15:05:48 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * help.el (function-called-at-point): Try a symbol around point. (describe-function): Describe datatype also. Wed May 1 01:28:43 1991 Roland McGrath (roland at albert.gnu.ai.mit.edu) * lisp-mode.el (eval-last-sexp, eval-defun): Bind standard-output to where the value of the form will be printed while evalling it. Tue Apr 30 20:24:45 1991 Roland McGrath (roland at albert.gnu.ai.mit.edu) * lisp-mode.el (eval-last-sexp): Rewritten to read a form and then eval it, rather than using eval-region. The old version could lose if the form being eval'd moved point or twiddled the restriction. (eval-defun): Similarly rewritten. (eval-print-last-sexp): Rewritten to just call eval-last-sexp; removed some duplicated code. Tue Apr 30 18:14:58 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * isearch.el (isearch): * and ? are not special after incomplete input. When they are special, use old other-end for cs in both reverse and forward. Tue Apr 30 22:53:05 1991 Stephen A. Wood (saw at hallc1.cebaf.gov) * fortran.el version 1.28. Major upgrade of previous version 1.21. Now supports tab or fixed format style of continuation control and indentation. In tab style, lines start with a tab, or a line number followed by a tab. If the first character after the tab is a digit from 1 to 9, the line is a continuation line. When entering fortran mode for a file, the first line that begins with 6 spaces or a tab is found. The buffer is then set respectively to either fixed format or tab format style. The mode may be toggled with the command fortran-tab-mode. Fixed a bug in which indenting a comment line that contained a `!' caused a max-lisp-eval-depth exceeded error. Bound LFD to fortran-reindent-then-newline-and-indent. Added command fortran-blink-matching-if which is called when an endif statement is indented. Enabled/disabled by setting variable of same name to t/nil. Added some abbreviations for modern fortrans. C-c C-w bound to new function fortran-window-create-momentarily which creates a 72 character wide window until the next key is struck. Variable fortran-continuation-char changed to fortran-continuation-string. Modified fortran-electric-line-number to just insert the struck digit when the point is located after 5 spaces, or when the point is located after a tab character and the last command was not fortran-indent-line or fortran-reindent-then-newline-and-indent. This allows digits to be manually used as continuation line indicators. Also fixed a bug in fortran-electric-line-number which caused the digit keys not to work at all if electric line numbering was disabled. Mon Apr 29 15:01:52 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * info.el (Info-read-subfile): Skip blank lines. Mon Apr 22 19:53:58 1991 Brian Preble (rassilon@gnu.ai.mit.edu) * resume.el, rfc822.el, rmail-kill.el: Doc fix. Thu Apr 18 21:43:10 1991 Roland McGrath (roland@gnu.ai.mit.edu) * add-log.el (prompt-for-change-log-name): Made a defun rather than a defmacro (braino fix). Thu Apr 18 20:36:22 1991 Jim Blandy (jimb@gnu.ai.mit.edu) * simple.el (count-lines-region): Display the number of characters in the region as well. Sun Apr 14 23:35:21 1991 Edward M. Reingold (reingold at emr.cs.uiuc.edu) * diary.el (diary-omer, diary-parasha): Fix punctuation in diary entries. Fri Apr 12 15:24:43 1991 Brian Preble (rassilon@gnu.ai.mit.edu) * prolog.el, r2bibtex.el, rect.el, refbib.el, register.el: Doc fix. * remote.el, replace.el: Doc fix. Thu Apr 11 15:25:04 1991 Jim Blandy (jimb@gnu.ai.mit.edu) * simple.el (kill-region): Don't print out a message saying how many characters are being killed. Wed Apr 10 09:58:35 1991 Brian Preble (rassilon@gnu.ai.mit.edu) * modula2.el, mouse.el, mpuz.el, nntp.el, options.el: Doc fix. * oshell.el, page-ext.el, page.el, paragraphs.el, picture.el: Doc fix. Fri Apr 5 16:11:59 1991 Raul Acevedo (kitaro@gnu.ai.mit.edu) * options.el: Edit-options-mode runs `Edit-options-mode-hook'. Also fixed the regexp used by Edit-options-modify so you can modify a variable if at the beginning of the buffer. Fri Apr 5 14:45:24 1991 Brian Preble (rassilon@gnu.ai.mit.edu) * man.el, medit.el, mh-e.el, mhspool.el, mim-mode.el: Doc fix. Thu Apr 4 13:06:16 1991 Raul Acevedo (kitaro@gnu.ai.mit.edu) * info.el (Info-mode): now runs `Info-mode-hook' Tue Apr 2 17:12:54 1991 Brian Preble (rassilon@gnu.ai.mit.edu) * mailpost.el, mail-utils.el, mailalias.el: Doc fix. Sun Mar 24 21:35:34 1991 Richard Stallman (rms@gnu.ai.mit.edu) * rmail.el (rmail-resend): New function. * sendmail.el (mail-alias-file): New global variable. (sendmail-send-it): Use that variable. * mailalias.el (expand-mail-aliases): Handle resent-to. * files.el (hack-local-variables): ignore-local-eval ignores `eval'. Tue Mar 19 23:17:45 1991 Richard Stallman (rms@gnu.ai.mit.edu) * fill.el (justify-current-line): Adjust for 18.57 behavior of current-column. Sun Mar 17 16:13:00 1991 Richard Stallman (rms@mole.ai.mit.edu) * add-log.el (add-change-log-entry): Recognize `@', not ` at '. * fill.el (justify-current-line): Handle extra indent after prefix. Thu Mar 14 19:23:31 1991 Robert J. Chassell (bob@gnu.ai.mit.edu) * info.el (Info-forward-node): Go up several levels, if necessary. Add two new arguments. (Info-final-node): Go forward from last node in menu. (Info-find-node): Turn off undo in Info's buffers. Thu Mar 14 17:59:48 1991 Richard Stallman (rms@mole.ai.mit.edu) * add-log.el (add-change-log-entry): Use `@', not ` at '. Thu Mar 14 14:54:47 1991 Brian Preble (rassilon@mole.ai.mit.edu) * loaddefs.el, lpr.el: Doc fix. Tue Mar 12 21:17:02 1991 Richard Stallman (rms@mole.ai.mit.edu) * compare-w.el (compare-windows-whitespace): Now a set of chars, not a regexp. (compare-windows): Use it properly. Tue Mar 12 13:09:44 1991 Brian Preble (rassilon@gnu.ai.mit.edu) * info.el, informat.el, ispell.el, kermit.el, keypad.el: Doc fix. * ledit.el, lisp-mode.el, lisp.el: Doc fix. Mon Mar 11 18:14:53 1991 Richard Stallman (rms@mole.ai.mit.edu) * simple.el (kill-region): Make undo buffer and kill ring share. Sun Mar 10 20:46:35 1991 Richard Stallman (rms@mole.ai.mit.edu) * tar-mode.el: New file. Fri Mar 8 15:05:14 1991 Brian Preble (rassilon@mole.ai.mit.edu) * indent.el, inf-lisp.el: Doc fix. Fri Mar 8 14:46:59 1991 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (byte-compile-file-form): Print warning for " unescaped in doc string. Wed Mar 6 13:26:28 1991 Brian Preble (rassilon@mole.ai.mit.edu) * gosmacs.el, help.el, helper.el, hexl.el, hideif.el: Doc fix. * holidays.el, icon.el: Doc fix. Tue Mar 5 13:41:02 1991 Brian Preble (rassilon@mole.ai.mit.edu) * gnusmail.el, gnusmisc.el, gnuspost.el, gomoku.el: Doc fix. Mon Mar 4 22:35:31 1991 Richard Stallman (rms@mole.ai.mit.edu) * info.el (Info-extract-menu-item): Use regexp search. (Info-extract-menu-node-name): Fix typo in arglist. * info.el (Info-top-node, Info-final-node): New functions. (Info-forward-node, Info-backward-node): New functions. Mon Mar 4 12:48:36 1991 Brian Preble (rassilon@mole.ai.mit.edu) * gnus.el: Doc fix. Fri Mar 1 17:07:23 1991 Richard Stallman (rms@mole.ai.mit.edu) * rmailout.el (rmail-output-to-rmail-file, rmail-output): Expand file name in dir used for completion. Fri Mar 1 15:02:42 1991 Brian Preble (rassilon@mole.ai.mit.edu) * emerge.el, etags.el, field.el, files.el, fill.el, float.el: Doc fix. * fortran.el, ftp.el, gdb.el: Doc fix. Thu Feb 28 18:05:37 1991 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (byte-compile-cond-1): Fix handling of unconditional clauses. Thu Feb 28 14:16:35 1991 Brian Preble (rassilon@mole.ai.mit.edu) * edmacro.el, edt.el, edt-doc.el, ehelp.el, emacsbug.el: Doc fix. Wed Feb 27 14:22:04 1991 Brian Preble (rassilon@mole.ai.mit.edu) * ebuff-menu.el, echistory.el, edebug.el: Doc fix. Tue Feb 26 16:00:30 1991 Richard Stallman (rms@mole.ai.mit.edu) * isearch.el (isearch): Copy point from small window before deciding whether to set the mark. Tue Feb 26 13:37:39 1991 Brian Preble (rassilon@mole.ai.mit.edu) * dired.el: Doc fix. (dired-flag-backup-and-auto-save-files): New arg UNFLAG-P. * disp-table.el, doctex.el, doctor.el: Doc fix. * doctex.el (LaTeXify-DOC): Use new permission wording. Mon Feb 25 13:07:37 1991 Paul Hilfinger (hilfingr@hilfinger.cs.nyu.edu) * fill.el (fill-individual-paragraphs): Changed response to mailp to effect only leading lines in a region (was getting confused about colons embedded in ordinary text). Changed method of moving to next paragraph in the main loop to use forward-paragraph rather than goto-char, since the final character position is rendered obsolete by the intervening fill-region-as-paragraph. Sun Feb 24 18:24:31 1991 Edward M. Reingold (reingold at emr.cs.uiuc.edu) * diary.el (include-other-diary-files): Fix documentation string. Sat Feb 23 15:25:23 1991 Roland McGrath (mcgrath@cygint.cygnus.com) * compile.el (next-error): Fixed bug in rms's optimization. Sat Feb 23 13:22:19 1991 Richard Stallman (rms@mole.ai.mit.edu) * reposition.el: New file. * loaddefs.el (reposition-window): Autoload it. * rmailkwd.el: Doc fix. * rmail.el (rmail-first-unseen-message): New function. (rmail): Call that. * buff-menu.el (Buffer-menu-mode-map): Make `n' and `p' move by lines. Thu Feb 21 20:46:27 1991 Roland McGrath (mcgrath@cygint.cygnus.com) * compile.el (next-error): Do rms's optimization (Feb 8 change) when moving backward, too. Wed Feb 20 04:35:50 1991 Jim Blandy (jimb@geech.ai.mit.edu) * startup.el (command-line): Re-arranged nested ifs that handle the different command-line arguments into a cond, to make it easier for me to read. Fri Feb 15 05:56:30 1991 Jim Blandy (jimb@pogo.ai.mit.edu) * loaddefs.el: Bind \M-C-r to isearch-backward-regexp, since it really ought to be there. I want it often. Fri Feb 8 17:08:17 1991 Richard Stallman (rms@mole.ai.mit.edu) * compile.el (next-error): Count lines from prev error, not file beg. Thu Feb 7 12:15:46 1991 Brian Preble (rassilon@mole.ai.mit.edu) * c++-mode.el, c-comment.el, c-fill.el, c-mode.el: Doc fix. * cal.el, calc-alg2.el, calc.el, calendar.el, case-table.el: Doc fix. * chistory.el, cl-indent.el, cl.el, compare-w.el: Doc fix. * compile.el, completion.el, dabbrev.el, dbx.el, debug.el: Doc fix. * diary-add.el, diary.el, diff.el: Doc fix. Wed Feb 6 23:50:12 1991 Richard Stallman (rms@mole.ai.mit.edu) * c-mode.el (indent-c-exp, electric-c-terminator, c-indent-line): Treat `default:' like `case...:'. Tue Feb 6 17:26:59 1991 Brian Preble (rassilon@mole.ai.mit.edu) * blackbox.el, buff-menu.el, bug-screen.el, bytecomp.el: Doc fix. Mon Feb 4 21:49:39 1991 Richard Stallman (rms@mole.ai.mit.edu) * info.el (Info-extract-menu-node-name): New arg MULTI-LINE. (Info-follow-reference): Pass t for that. Mon Feb 4 17:06:58 1991 Brian Preble (rassilon@mole.ai.mit.edu) * bg-mouse.el, bib-mode.el: Doc fix. Mon Feb 4 02:18:23 1991 Jim Blandy (jimb@gnu.ai.mit.edu) * simple.el (eval-current-buffer): Removed, since it has been reintroduced to the C code. Sat Feb 2 09:07:38 1991 Jim Blandy (jimb@gnu.ai.mit.edu) * comint.el (comint-mode): Move the creation of input-ring down with the other variables, and (golly!) initialize it to a ring. (make-comint): Pass a parameter to comint-check-proc - buffer. * shell.el (shell): rebalance parens. Thu Jan 31 21:35:16 1991 Richard Stallman (rms@mole.ai.mit.edu) * replace.el (perform-replace): Prevent spurious match of ^foo in second part of foofoo after first part is deleted. Thu Jan 31 21:30:44 1991 Jim Blandy (jimb@pogo.ai.mit.edu) * files.el (find-file-noselect): Strip auto-mount prefix only if safe. Thu Jan 31 14:34:33 1991 Richard Stallman (rms@mole.ai.mit.edu) * time.el (display-time-filter): Use display-time-file-nonempty-p. (display-time-file-nonempty-p): New function; trace symlinks. Wed Jan 30 17:51:19 1991 Brian Preble (rassilon@mole.ai.mit.edu) * ada.el (ada-tabsize): Use prefix arg, not minibuffer. Doc fix. * abbrev.el: Doc fix. * abbrevlist.el: Doc fix. * apropos.el: Doc fix. * appt.el: Doc fix. * array.el: Doc fix. * asm-mode.el: Doc fix. * awk-mode.el: Doc fix. Wed Jan 30 14:18:24 1991 Roland McGrath (roland@cygint.cygnus.com) * compile.el (compilation-parse-errors): Don't remove duplicate errors. (next-error): Skip over duplicates here instead. Wed Jan 30 16:37:41 1991 Richard Stallman (rms@mole.ai.mit.edu) * appt.el: Doc fix. Wed Jan 30 05:37:48 1991 Jim Blandy (jimb@pogo.ai.mit.edu) * paths.el (Info-directory-list): Look for info files in /usr/local/lib/info first, since this is the standard place for info files. Tue Jan 29 13:15:29 1991 Richard Stallman (rms@mole.ai.mit.edu) * info.el (info): With prefix arg, read file name and visit it. Sat Jan 26 00:19:00 1991 Jim Blandy (jimb@gnu.ai.mit.edu) * term/x-win.el: Do not define the f1 function key to run rmail. Fri Jan 25 16:24:35 1991 Richard Stallman (rms@mole.ai.mit.edu) * help.el (help-for-help): Call delete-other-windows. Mon Jan 21 00:11:32 1991 Mike Newton (newton@fig) * bibtex.el -- updated to conform better with bibtex 0.99c by: bibtex-mode : updated comments to indicate new use of address, add minor explanations and fix small omissions. bibtex-entry : fixed spelling of variable * bibtex.el - Expanded the various bibtex-field-* patterns to allow fields like 'title = poft # "Fifth Triquaterly" # random-conf,'. Needs to have more work done to accept all cases. Added code for the bibtex 'crossref' command, which subsumes other options. Made field ordering different when this option on. Also allow user to have a list of field to be added to all entries (bibtex-mode-user-optional-fields). Merged in Bengt Martensson's changes. Fri Jan 18 07:14:57 1991 Roland McGrath (roland@cygint.cygnus.com) * compile.el (compilation-find-buffer): New function to find a compilation buffer to use (or barf if there aren't any). (kill-compilation, compile-goto-error, next-error): Use it. Thu Jan 17 03:08:07 1991 Richard Stallman (rms@mole.ai.mit.edu) * info.el (Info): Init Info-directory-list from INFOPATH. Sat Jan 12 16:22:33 1991 Jim Blandy (jimb@gnu.ai.mit.edu) * etags.el (visit-tags-file-buffer): use progn instead of save-excursion, so the buffer actually gets visited. Fri Jan 11 14:45:07 1991 Richard Mlynarik (mly@august-east.ai.mit.edu) * terminal.el (terminal-cease-edit): If this dubious code is really necessary it might as well be more bug-free. * ehelp.el (with-electric-help): Use window-configs. Thu Jan 10 23:34:44 1991 Richard Stallman (rms@mole.ai.mit.edu) * loaddefs.el (minor-mode-alist): Doc fix. Wed Jan 8 23:15:59 1991 Roland McGrath (roland@albert.ai.mit.edu) * compile.el (compilation-parse-errors): Fixed maintenance of last-linenum, so dups are really found. Tue Jan 8 11:26:07 1991 Jim Blandy (jimb@pogo.ai.mit.edu) * bytecomp.el (byte-compile-byte-code-maker): Since byte-compile-lambda is free to return the original lambda expression, we'd better be prepared to handle things that aren't bytecode objects. Mon Jan 7 17:29:50 1991 Jim Blandy (jimb@gnu.ai.mit.edu) * loaddefs.el: Don't forget to specify the filenames when autoload-ing byte-compile-buffer and byte-compile-defun. Fri Jan 4 00:41:56 1991 Richard Stallman (rms@mole.ai.mit.edu) * files.el (find-file-noselect): Get rid of automounter prefixes. Wed Jan 2 18:39:57 1991 Richard Stallman (rms@mole.ai.mit.edu) * lpr.el (print-region-function): New hook variable. (print-region-1): Use it if non-nil. * vms-patch.el (print-region-function): Specify a function. Mon Dec 31 23:49:38 1990 Richard Stallman (rms@mole.ai.mit.edu) * files.el (revert-buffer): Clear buffer-backed-up if file has changed. Sun Dec 30 23:11:27 1990 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (byte-compile-buffer, byte-compile-defun): New functions. * loaddefs.el: Autoload them, and byte-compile also. * isearch.el (isearch-message): Always mention if case-sensitive. (isearch): Don't turn off uppercase-flag when char is not upper case. Sat Dec 29 14:40:27 1990 Richard Stallman (rms@mole.ai.mit.edu) * terminal.el (te-edit): New command. (terminal-edit-mode, te-terminal-cease-edit): New functions. * isearch.el (isearch): An upper-case letter sets uppercase-flag which turns off case-folding. Save flag in search rings. (isearch-push-state, isearch-pop): Push and pop uppercase-flag. (isearch-search, isearch-message): Handle uppercase-flag. (search-ring, regexp-search-ring): Record uppercase-flag. (isearch-get-string-from-ring): New function. Thu Dec 27 15:51:49 1990 Richard Stallman (rms@mole.ai.mit.edu) * rmailsort.el (rmail-sort-messages): Print more progress messages. (rmail-sort-by-size-lines): New command. (rmail-sortable-date-string): Handle non-abbreviated month names. (rmail-sort-messages): Always show message 1. Wed Dec 26 16:54:56 1990 Richard Stallman (rms@mole.ai.mit.edu) * startup.el (command-line): Handle -debug-init: use debugger. * isearch.el (isearch): Use only barrier, not opoint, in starting point for reverse search. Mon Dec 24 17:12:04 1990 Richard Stallman (rms@mole.ai.mit.edu) * mouse.el (mouse-set-mark): Use sit-for, not sleep-for. (mouse-fill-paragraph): New command. (mouse-fill-paragraph-with-prefix): New command. * rmailout.el (rmail-output-to-rmail-file): Suggest file based on rmail-output-file-alist. Sun Dec 23 17:07:13 1990 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-convert-to-babyl-format, rmail-nuke-pinhead-header): Accept `remote from ...'@end of UNIX From line. Sat Dec 22 13:15:09 1990 Richard Stallman (rms@mole.ai.mit.edu) * subr.el (defun-inline): New function. * bytecomp.el (byte-compile-form): Delete unreachable cond-clause. * time.el (display-time): Specify precise directory for wakeup. (display-time-filter): Don't display 0 as load. Catch error in load-average. Fri Dec 21 11:37:32 1990 Chris Hanson (cph@kleph) * info.el (Info-extract-menu-node-name): Permit \n between colon and start of node name. Thu Dec 20 15:43:40 1990 Chris Hanson (cph@kleph) * texnfo-upd.el (texinfo-update-menu-region-beginning): Change code that searches for "top" node so it returns the position of the beginning of the node line. Always search from the buffer's start when looking for that node. (texinfo-make-one-menu): Bump forward over the outer node line. Thu Dec 20 15:31:53 1990 Richard Stallman (rms@mole.ai.mit.edu) * fortran.el: New version from gildea. Thu Dec 20 15:21:11 1990 Chris Hanson (cph@kleph) * texinfmt.el (texinfo-format-footnote): Number each footnote in a node so that multiple footnotes can be distinguished. * texnfo-upd.el: Change regular expression used to identify the "Top" node so that names that begin with "Top" do not confuse it. Wed Dec 19 16:29:19 1990 Stephen Gildea (gildea@expo) * fortran.el: Changes for version 1.21.1: Provide the 'fortran feature. Change syntax of '=' to punctuation. Add some more abbrevs. Change fortran-mode-map keymap to non-sparse. (fortran-electric-line-number): Fix bug occurring when fortran-electric-line-number is nil. (fortran-mode, fortran-next-statement): (fortran-line-number-indented-correctly-p): Fix up doc strings. (fortran-indent-to-column): Protect against nil comment-start-skip. Wed Dec 19 13:17:21 1990 Richard Stallman (rms@mole.ai.mit.edu) * mpuz.el: New file. Tue Dec 18 20:25:28 1990 Richard Stallman (rms@mole.ai.mit.edu) * files.el (hack-local-variables): Match suffix only@eol. Sun Dec 16 17:54:07 1990 Richard Stallman (rms@mole.ai.mit.edu) * startup.el (normal-top-level): Execute emacs-startup-hook. * rmail.el (rmail-parse-file-inboxes): Look for BABYL OPTIONS in u.c. (rmail-convert-to-babyl-format): Likewise. And don't skip white space after ^_ that ends a babyl format message. * saveconf.el: No need to rename kill-emacs. (save-context-predicate): Now uses save-buffer-context-predicate. (save-buffer-context-predicate): New function. (kill-emacs-hook): Supply a hook. (just-kill-emacs): New function. (emacs-startup-hook): Set this instead of top-level. (save-context-buffer-name): Test dired-directory for non-nil. (save-context-buffer-file-name): New function. (save-context): Record read-only status of buffers. (recover-context): Handle that. * register.el (point-to-register): If arg, save screen config. (jump-to-register): Restore screen config. Sat Dec 15 15:34:04 1990 Roland McGrath (roland@albert.ai.mit.edu) * compile.el (compilation-last-error): Remove this variable. (next-error): Don't set it. Wed Dec 12 11:34:25 1990 Ed Reingold (reingold at emr.cs.uiuc.edu) * calendar.el (calendar-end-of-year): Delete extraneous statement in let. (calendar-mode): Update old description of use of hooks to get the fancy diary display. Wed Dec 12 00:27:36 1990 Roland McGrath (roland@albert.ai.mit.edu) * compile.el (compilation-error-buffer): Removed. (compilation-last-buffer): Now last buffer in which any of: started compilation; C-x `; C-c C-c; was done. (compile-internal): Don't set compilation-error-buffer. Start the process after setting up the mode, etc. in the compilation buffer. Name the process (downcase mode-name) instead of "compilation" (so it will be "grep" for M-x grep). Make compilation-error-list, compilation-parsing-end local vars. (next-error): Slightly reorganized (changed (let* (while (save-ex))) to (let (save-ex (while)))). Be sure to be in the compilation buffer before doing anything, so we will get local values for vars. Before doing anything, if current buffer is a compilation buffer, set compilation-last-buffer to that. Always do things in compilation-last-buffer. * compile.el (compilation-error-regexp-alist, compilation-{enter,leave}-directory-regexp): Get rid of .*@the beginning of regexps. * compile.el (compilation-mode): Don't make local vars for parser, error-message, and regexp-alist. (compile-internal): Do it here, after calling compilation-mode. * compile.el (compilation-error-list): Changed elt format. (compilation-parse-errors): Don't find files when parsing. Instead record ((DIR . FILE) . LINENO) structures to describe each error. (next-error): Take the error descriptors, and find the file given in the descriptor, using compilation-find-file. Then goto the line number given in the descriptor and replace the error descriptor cons with a marker into the source file buffer. Then search through the compilation-error-list for errors in the same file, and turn their descriptors into markers as well. (compilation-find-file): Take new arg DIR, the directory to use as default in expanding the filename, and MARKER. If we can't find the file@all, pop up MARKER's buffer and scroll to MARKER (to display the error message for which we want this file), and ask the user where to find the file. Wed Dec 12 00:11:37 1990 Richard Stallman (rms@mole.ai.mit.edu) * files.el (hack-local-variables): Display local vars@screen top. * server.el (server-process-filter): Don't be confused if input from process is split into multiple chunks. Mon Dec 10 13:43:59 1990 Richard Stallman (rms@mole.ai.mit.edu) * c-mode.el (indent-c-find-real-comment): New function. * sort.el (sort-subr): Eliminate special case for floats. * sort.el (sort-reorder-buffer, sort-build-lists): Use (key start . end) to record a record. Sun Dec 9 22:04:55 1990 Richard Stallman (rms@mole.ai.mit.edu) * lisp.el (insert-parentheses): Small cleanups. Wed Dec 5 18:46:27 1990 Richard Stallman (rms@mole.ai.mit.edu) * replace.el (occur): Show all lines that contain part of a match. Tue Dec 4 21:01:26 1990 Richard Stallman (rms@mole.ai.mit.edu) * time.el (display-time-filter): Let user specify mail file name. Tue Dec 4 14:06:23 1990 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-mode-map): Make < same as j. Mon Dec 3 14:55:54 1990 Richard Stallman (rms@mole.ai.mit.edu) * rmailsort.el (rmail-select-correspondent): New function. (rmail-sort-by-correspondent): New function. (rmail-sortable-date-string): Handle two-digit and four-digit years. (rmail-date-full-year): New subroutine. [Done by Szolovitz.] * fill.el (fill-region-as-paragraph): New feature: Adaptive Fill mode. (adaptive-fill-mode, adaptive-fill-regexp): New user options. Fri Nov 30 01:58:26 1990 Mike Newton (newton@gumby.cs.caltech.edu) * bibtex.el (start comments) : added earlier comments of Bengt Martensson. Some of the changes listed below are originally his (including clean-entry, OPTkey and OPTannote, the function renaming and the preamble code). * bibtex.el (bibtex-field-* patterns) : expanded to allow fields like 'title = poft # "Fifth Triquaterly" # random-conf,'. Needs to have more work done to accept all cases. * bibtex.el (bibtex-clean-entry-zap-empty-opts) : added. * bibtex.el (bibtex-include-OPTcrossref) : added. If set, changes order of the the lists presented to luser. * bibtex.el (bibtex-include-OPTkey & bibtex-include-OPTannote) : added * bibtex.el (bibtex-mode-user-optional-fields) : can be set to a list of field the user wants to add to entries. * bibtex.el (bibtex-mode documentation string) updated for new changes, DEAthesis added back in, bibtex-preamble call added. * bibtex.el (bibtex-entry) : add OPTkey/annote. If OPTcrossref set then put it in. * bibtex.el (bibtex-make-entry) : renamed bibtex-make-field * bibtex.el (bibtex-make-optional-entry) : renamed bibtex-make-optional-field. * bibtex.el (bibtex-Article) : change order of presentation if OPTcrossref is set. * bibtex.el (bibtex-InBook) : change order of presentation if OPTcrossref is set. * bibtex.el (bibtex-InCollection) : change order of presentation if OPTcrossref is set. * bibtex.el (bibtex-InProceedings) : change order of presentation if OPTcrossref is set. * bibtex.el (bibtex-MastersThesis) : added "note". * bibtex.el (bibtex-preamble) : added. * bibtex.el (bibtex-inside-field) : only go backwards if quote is there. * bibtex.el (bibtex-clean-entry) : added call to bibtex-clean-entry-zap-empty-opts, OPT field testing for errors. * bibtex.el (bibtex-x-help) : added options Conference and preamble, restored DEAthesis. Fri Nov 30 17:30:47 1990 Richard Stallman (rms@mole.ai.mit.edu) * rmailsum.el (rmail-summary-mode-map): Don't rebind C-n and C-p. Put rmail-summary-next-all, etc., on M-n and M-p. Thu Nov 29 20:43:40 1990 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-insert-inbox-text): Don't give up if movemail fails. Wed Nov 28 17:09:42 1990 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (byte-compile-form): Don't let handlers change depth. (byte-compile-normal-call): Don't alter byte-compile-depth. (byte-compile-funcall): New function. Tue Nov 27 14:42:55 1990 Ed Reingold (reingold at emr.cs.uiuc.edu) * diary.el (diary-float): Allow month to be a list of months, a single month, or t (for all months). Mon Nov 26 18:11:53 1990 Jim Blandy (jimb@geech.ai.mit.edu) * simple.el (copy-region-as-kill): No longer prints "Region copied" error message. Mon Nov 26 17:02:13 1990 Richard Stallman (rms@mole.ai.mit.edu) * bg-mouse.el (bg-insert-moused-sexp): If before ')', just skip that. Mon Nov 26 10:30:59 1990 Neil Mager (neilm@juliet.ll.mit.edu) * appt.el: Fixed if construct for midnight update. Sun Nov 25 11:58:17 1990 Ed Reingold (reingold at emr.cs.uiuc.edu) * diary.el (insert-block-diary-entry): Change reference to mark-ring to calendar-mark-ring. Wed Nov 21 17:09:21 1990 Neil Mager (neilm@juliet.ll.mit.edu) * appt.el: Updated header of file to reflect changes. * appt.el: Added variable appt-display-diary to display the diary automatically when the appointments list is updated at midnight. * appt.el: Fixed bug to allow update of daily appointments list at midnight if today's diary had no entry. Required moving 'if' statement down several lines. * appt.el: Changed list-diary-entries-hook to diary-display-hook to be compatible with new version of the calendar/diary packgage. Mon Nov 20 22:21:27 1990 Ed Reingold (reingold at emr.cs.uiuc.edu) * calendar.el (calendar-version): New constant, with date (calendar-count-days-region, calendar-not-available): New functions. (calendar-mode-map): Put them on keys. (calendar-mode): Describe them. Sun Nov 11 13:59:44 1990 Ed Reingold (reingold at emr.cs.uiuc.edu) * diary.el (make-diary-entry): New function. (insert-diary-entry, insert-weekly-diary-entry, insert-monthly-diary-entry, insert-yearly-diary-entry, insert-hebrew-diary-entry, insert-monthly-hebrew-diary-entry, insert-yearly-hebrew-diary-entry, insert-islamic-diary-entry, insert-monthly-islamic-diary-entry, insert-yearly-islamic-diary-entry): Modified so that if a prefix arg is supplied these make nonmarking diary entries; otherwise the entries made are marking. (insert-block-diary-entry, insert-anniversary-diary-entry, insert-cyclic-diary-entry): New functions. * calendar.el: Autoload them. (calendar-mode-map): Put them on keys. (calendar-mode): Describe them. Thu Nov 8 17:12:22 1990 Ed Reingold (reingold at emr.cs.uiuc.edu) * calendar.el (calendar-set-mark, calendar-exchange-point-and-mark): New functions. (calendar-mode-map): Put them on keys. (calendar-mode): Describe them. Tue Nov 6 11:57:01 1990 Ed Reingold (reingold at emr.cs.uiuc.edu) * calendar.el (sexp-diary-entry-symbol): New variable. (cursor-to-iso-calendar-date): Simplified, slightly. (cursor-to-calendar-day-of-year): Fixed punctuation. (cursor-to-french-calendar-date): Moved French names to arrays. * diary.el (list-sexp-diary-entries, diary-sexp-entry, diary-cyclic, diary-hebrew-date, diary-iso-date, diary-day-of-year, diary-float, diary-islamic-date, diary-anniversary, diary-block, diary-french-date, diary-omer, diary-yahrzeit, diary-parasha, diary-rosh-hodesh, hebrew-calendar-parasha-name): New functions. (list-diary-entries): Added call to (list-sexp-diary-entries) and fixed an obscure error that caused a diary entry to be missed if it was preceded by an empty entry of the same style. (list-hebrew-diary-entries, list-islamic-diary-entries): Fixed an obscure error that caused a diary entry to be missed if it was preceded by an empty entry of the same style. (mark-islamic-calendar-date-pattern): Renamed some local variables more appropriately. Tue Oct 23 17:31:36 1990 Ed Reingold (reingold at emr.cs.uiuc.edu) * diary.el (list-diary-entries): Added a separate hook to do the display, so that the diary entries can be obtained without displaying them. (simple-diary-display): New function (renaming of ordinary-list-diary-hook). (fancy-diary-display): New function (renaming of prepare-fancy-diary-buffer). calendar.el: Add default definition of diary-display-hook. Sat Oct 20 22:15:51 1990 Ed Reingold (reingold at emr.cs.uiuc.edu) * calendar.el (describe-calendar-mode): Rewrote to give just a brief description of the mode instead of calling describe-mode. Mon Oct 19 10:23:43 1990 Neil Mager (neilm@juliet.ll.mit.edu) * appt.el: Changed issue-appointments-message to appt.issue.message in header. * appt.el: Using copy modified by rms. Mon Oct 8 19:29:59 1990 Ed Reingold (reingold at emr.cs.uiuc.edu) * holiday.el (calendar-holiday-function-hebrew): Fixed minor problem with the code to short-circuit the calculations to save time. *diary.el (mark-hebrew-calendar-date-pattern): Fixed minor problem with the code to short-circuit the calculations to save time. Thu Nov 22 17:14:52 1990 Richard Stallman (rms@mole.ai.mit.edu) * files.el (basic-save-buffer): Run after-save-hooks. Wed Nov 21 15:02:35 1990 Robert J. Chassell (bob@gnu.ai.mit.edu) * texinfmt.el (texinfo-parse-line-arg): Ignore spaces@end of line. (texinfo-format-make-node): Handle Info file names with periods in them. * history.el: Specify `(provide 'history)'. Mon Nov 20 22:21:27 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el: Added constant calendar-version with date (calendar-count-days-region), (calendar-not-available): New functions. (calendar-mode-map): Put them on keys. (calendar-mode): Describe them. Sun Nov 11 13:59:44 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * diary.el: (make-diary-entry): New function. (insert-diary-entry), (insert-weekly-diary-entry), (insert-monthly-diary-entry), (insert-yearly-diary-entry), (insert-hebrew-diary-entry), (insert-monthly-hebrew-diary-entry), (insert-yearly-hebrew-diary-entry), (insert-islamic-diary-entry), (insert-monthly-islamic-diary-entry), (insert-yearly-islamic-diary-entry): Modified so that if a prefix arg is supplied these make nonmarking diary entries; otherwise the entries made are marking. (insert-block-diary-entry), (insert-anniversary-diary-entry), (insert-cyclic-diary-entry): New functions. * calendar.el: Autoload them. (calendar-mode-map): Put them on keys. (calendar-mode): Describe them. Thu Nov 8 17:12:22 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el: (calendar-set-mark), (calendar-exchange-point-and-mark): New functions. (calendar-mode-map): Put them on keys. (calendar-mode): Describe them. Tue Nov 6 11:57:01 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el: Added new variable sexp-diary-entry-symbol. (cursor-to-iso-calendar-date): Simplified, slightly. (cursor-to-calendar-day-of-year): Fixed punctuation. (cursor-to-french-calendar-date): Moved French names to arrays. * diary.el: (list-sexp-diary-entries), (diary-sexp-entry), (diary-cyclic), (diary-hebrew-date), (diary-iso-date), (diary-day-of-year), (diary-float), (diary-islamic-date), (diary-anniversary),(diary-block), (diary-french-date), (diary-omer), (diary-yahrzeit), (diary-parasha), (diary-rosh-hodesh), (hebrew-calendar-parasha-name): New functions. (list-diary-entries): Added call to (list-sexp-diary-entries) and fixed an obscure error that caused a diary entry to be missed if it was preceded by an empty entry of the same style. (list-hebrew-diary-entries), (list-islamic-diary-entries): Fixed an obscure error that caused a diary entry to be missed if it was preceded by an empty entry of the same style. (mark-islamic-calendar-date-pattern): Renamed some local variables more appropriately. Tue Oct 23 17:31:36 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * diary.el (list-diary-entries): Added a separate hook to do the display, so that the diary entries can be obtained without displaying them. (simple-diary-display): New function (renaming of ordinary-list-diary-hook). (fancy-diary-display): New function (renaming of prepare-fancy-diary-buffer). calendar.el: Add default definition of diary-display-hook. Sat Oct 20 22:15:51 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (describe-calendar-mode): Rewrote to give just a brief description of the mode instead of calling describe-mode. Mon Oct 8 19:29:59 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * holiday.el: (calendar-holiday-function-hebrew): Fixed minor problem with the code to short-circuit the calculations to save time. *diary.el: (mark-hebrew-calendar-date-pattern): Fixed minor problem with the code to short-circuit the calculations to save time. Mon Sep 10 10:32:13 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * diary.el: (list-diary-entries), (list-hebrew-diary-entries), (list-islamic-diary-entries): Fixed to use add-to-diary-list. Fri Sep 7 08:50:13 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * holiday.el (filter-visible-calendar-holidays): New function. (calendar-holiday-function-rosh-hashanah-etc): Rewrote. (calendar-holiday-function-tisha-b-av-etc): New function. (calendar-holiday-function-passover-etc): New function. (calendar-holiday-function-hanukkah): New function. (calendar-holiday-function-easter-etc): Rewrote. * calendar.el: (calendar-other-month): Rewrote. (calendar-read), (calendar-make-alist): New functions. Eliminated constants calendar-day-abbrev-list and calendar-month-abbrev-list. (calendar-current-date): Eliminated use of calendar-month-abbrev-list. Modified the default value of `calendar-holidays'. Added variable `all-christian-calendar-holidays'. Added variable `all-islamic-calendar-holidays'. Added variable `all-hebrew-calendar-holidays'. (redraw-calendar), (calendar-goto-date), (calendar-goto-julian-date), (calendar-goto-hebrew-date), (calendar-goto-islamic-date), (calendar-goto-iso-date): New functions. (calendar-mode-map): Put them on keys. (calendar-mode): Describe them. (calendar-mode-map): Put scroll-other-window on a key. list-diary-entries-hook: Changed the default value to ordinary-list-diary-hook. * diary.el: (mark-diary-entries), (mark-islamic-diary-entries), (mark-hebrew-diary-entries): Eliminated use of constant alists for month and day names. (prepare-fancy-diary-buffer): Fixed the way holidays are displayed when there are no diary entries but lots of holidays. (ordinary-list-diary-hook), (add-to-diary-list): New functions. Thu Sep 6 19:23:12 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el: Changed reference at beginning of file from the report to the published version of the paper. Changed all calls to `mod' to call `%' to avoid problem with cl. (calendar-date-string): Added optional parameter `nodayname'. (cursor-to-islamic-calendar-date): Fixed so that calendar-date-string doesn't try find the day name. (cursor-to-hebrew-calendar-date): Fixed so that calendar-date-string doesn't try find the day name. nongregorian-diary-marking-hook: Fixed typo in doc string. (calendar-mode): Fixed a typo in doc string. (cursor-to-iso-calendar-date): Made message consistent with similar functions for Julian, Islamic, Hebrew, and French calendars. (calendar-absolute-from-gregorian): Simplified calculation. (calendar-mark-today): Changed today mark to `=' to avoid confusion with the default holiday mark. (calendar-julian-from-absolute): Rewrote parallel to other functions. (calendar-islamic-from-absolute): Rewrote parallel to other functions. (calendar-forward-day): Fixed movement when cursor is not on a date and arg is negative. Added description of new `if' form to doc string for calendar-holidays. * diary.el: Changed all calls to `mod' to call `%' to avoid problem with cl. (diary-entry-time): New function. (diary-entry-compare): Rewritten to take time of day into account. * holiday.el: Changed all calls to `mod' to call `%' to avoid problem with cl. (calendar-holiday-function-rosh-hashanah-etc): Fixed grammatical error in a comment. (calendar-holiday-function-hebrew): Fixed typo in doc string. (calendar-holiday-function-islamic): Fixed typo in doc string. (calendar-holiday-function-if): New function. Mon Nov 19 16:24:35 1990 Richard Mlynarik (mly@august-east) * rfc822.el (rfc822-addresses): Blow out, don't loop, on ") (rfc822-addresses-1) Error if address "phrase" not followed by route-spec * ebuff-menu.el (Electric-buffer-menu-mode): Remove questionable code which attempted to fake out mode-name in mode-line-list. Also, use slow \\<...> technology. Tue Nov 13 22:32:01 1990 David J. MacKenzie (djm@apple-gunkies) * fortran.el: Use domain format instead of uucp format for bug list address. Mon Nov 12 17:03:44 1990 Richard Stallman (rms@mole.ai.mit.edu) * lisp.el (lisp-complete-symbol): Use emacs-lisp-mode-syntax-table. Mon Nov 5 22:52:35 1990 Roland McGrath (roland@geech.ai.mit.edu) * compile.el (compilation-window-height): Added defconst for this, since it somehow disappeared. * compile.el: Unoverhauled. Restored from old 19 compile.el, plus these changes: (compilation-{enter,leave}-directory-regexp): New variables, specifying regexps that match lines saying the compilation process is entering/leaving a directory. The default values match the messages produced by the `-w' option to GNU make. (compilation-error-regexp-alist): [Idea from tale.] Replaces compilation-error-regexp. Alist (REGEXP FILE-IDX LINE-IDX) of regular expressions to match errors in compilation. If REGEXP matches, the FILE-IDX'th subexpression gives the file name, and the LINE-IDX'th subexpression gives the line number. (compilation-parse-errors): Rewritten. Combine the error and enter/leave directory regexps into a single regexp to search for, and dispatch on which subexpressions match. When the enter-directory regexp matches, set default-directory to that directory, and push it on compilation-directory-stack. When the leave-directory regexp matches, pop the stack to find the matching directory, and set default-directory to that. This change requries RE_NREGS to be (at least 26) (it's been upped from 10 to 30 in v19 ../src/regex.h). (compilation-finish-hook): New variable, a hook to run when a compilation finishes. Called with two args: the compilation buffer that finished, and the string passed to the process-sentinel describing how it finished ("exited", "signaled", etc.). (compilation-sentinel): Call it. (compilation-buffer-name-hook): Hook called to generate a name for a compilation buffer. Passed one arg, the name of the major mode of the buffer. (compile-internal): Use it. [From tale's changes:] (compile): Moved window enlarging to compile-internal. (compile-internal): Don't use with-output-to-temp-buffer. Use display-buffer instead. Mon Nov 5 05:03:32 1990 David Lawrence (tale@pogo.ai.mit.edu) * c++-mode.el (c++-mode): Made several global variables related to comment handling buffer-local. * emerge.el: Moved the kill-buffers out of emerge-extract-* and into the emerge-make-*-list functions which are responsible for creating and using them. unwind-protect it to make sure the buffer is always killed. * subr.el: fset buffer-flush-undo to buffer-disable-undo, not buffer-enable-undo. * comint.el, inf-lisp.el, shell.el: Updated to meet Olin's version 2.0 comint offerings. * ring.el: The underlying history mechanism for comint. Generalised handling of a ring data type based on vectors. * history.el: For now, a symlink to ring.el. * loaddefs.el: Updated shell-prompt-pattern doc string. Fri Nov 2 17:06:04 1990 Richard Stallman (rms@mole.ai.mit.edu) * files.el (set-visited-file-name): Reject empty string as name. * saveconf.el (save-context): Record dired buffers. (save-context-buffer-name): Compute the "name" of a buffer. (restore-context): Handle expressions as buffer names. Thu Nov 1 20:46:15 1990 Richard Stallman (rms@mole.ai.mit.edu) * info.el (Info-find-node): Simplify file search. Try appending `.info' to specified name. Wed Oct 31 11:09:33 1990 Jim Blandy (jimb@gnu.ai.mit.edu) * bytecomp.el: Put properties on * so that the byte-compiler knows how to inline multiplication. Tue Oct 30 15:20:05 1990 Richard Stallman (rms@mole.ai.mit.edu) * files.el (delete-auto-save-file-if-necessary): Don't delete if auto-saveing in visited file. Mon Oct 29 20:14:09 1990 Jim Blandy (jimb@pogo.ai.mit.edu) * subr.el: `buffer-flush-undo' is now officially named `buffer-enable-undo'; added an alias for backward compatibility. Sun Oct 28 15:56:12 1990 Richard Stallman (rms@mole.ai.mit.edu) * dabbrev.el (dabbrev-expand): Use original abbrev for case pattern. Do preserve case if expansion has a single uppercase initial. Fri Oct 26 00:13:25 1990 Richard Stallman (rms@mole.ai.mit.edu) * subr.el (keyboard-translate): New function. Thu Oct 25 16:24:16 1990 Robert J. Chassell (bob@gnu.ai.mit.edu) * texinfmt.el (texinfo-format-defun-1): Replace with new version that handles @deftypefn and related typed definition commands. (texinfo-format-deftypefn-type, texinfo-format-deftypefn-index): Formatting commands for @deftypefn and related typed definition commands. Inserted related `put' expressions. Tue Oct 23 02:00:32 1990 David Lawrence (tale@pogo.ai.mit.edu) * emerge.el (emerge-setup, emerge-setup-with-ancestor): Moved insert-buffer calls back before call to emerge-extract-diffs where the merge-buffer really needs to have something in it. (emerge-extract-diffs,emerge-extract-diffs3): Moved errant kill-buffer which interfered with return value of functions. Mon Oct 22 03:22:54 1990 David Lawrence (tale@pogo.ai.mit.edu) * loaddefs.el, bibtex.el: Changed bogus "" sequences attempting to generate a single quote to \" pairs. * calc-aent.el, calc-alg-2.el, calc-alg.el, calc-arith.el, calc-bin.el, calc-comb.el, calc-comp.el, calc-cplx.el, calc-ext.el, calc-forms.el, calc-frac.el, calc-funcs.el, calc-graph.el, calc-incom.el, calc-lang.el, calc-macs.el, calc-map.el, calc-mat.el, calc-math.el, calc-misc.el, calc-mode.el, calc-prog.el, calc-rewr.el, calc-rules.el, calc-sel-2.el, calc-sel.el, calc-store.el, calc-stuff.el, calc-trail.el, calc-undo.el, calc-units.el, calc-vec.el, calc-yank.el, calc.el: New files for a very complete RPN calculator which supports integer, rational, floating-point, comples, matrix and symbolic arithmetic to arbitrary precision. edmacro.el: New file, a keyboard macro editor. On its own probably not very useful, but in the context of calc programmability it fits the model well. emerge.el: New file, for merging files or buffers based on their differences. loaddefs.el: Autoloads for calc, quick-calc, full-calc, calc-eval, defmath, calc-grab-region and calc-extensions for the calculator. Bind calc to M-#. Autoloads for edit-kbd-macro, edit-last-kbd-macro and read-kbd-macro for edmacro. Autoloads for emerge-files, emerge-files-with-ancestor, emerge-buffers and emerge-buffers-with-ancestor for emerge. Sun Oct 21 22:06:45 1990 Richard Stallman (rms@mole.ai.mit.edu) * window.el (split-window-vertically): Select the bottom window if that lets point stay on screen. * etags.el (visit-tags-table-buffer): Handle local bindings of tags-file-name. Fri Oct 19 15:59:50 1990 Robert J. Chassell (bob@gnu.ai.mit.edu) * texinfmt.el (texinfo-format-include, texinfo-format-setfilename): Redefined to handle new include files. (texinfo-format-buffer-1, texinfo-format-region): Add `last-input-buffer' so handles new include files. (texinfo-format-bullet, texinfo-format-minus, texinfo-format-paragraph-break): Require braces if used within line; do no require braces if used@end of line. (texinfo-optional-braces-discard): Discard optional braces. * texnfo-upd.el (texinfo-incorporate-descriptions): Require exact match for item names. (texinfo-update-menu-region-beginning): Do not accidentally copy an info-only title for the top node into the main menu. (texinfo-section-types-regexp): Add `@chapheading'. (texinfo-find-lower-level-node, texinfo-find-higher-level-node, texinfo-menu-locate-entry-p, texinfo-copy-menu-title, texinfo-update-menu-region-beginning, texinfo-update-menu-region-end): Handle `@ifinfo' as well as comment line following node line. (texinfo-multiple-files-update and aux. files): Added to handle multi-file Texinfo sources. Thu Oct 18 17:40:11 1990 Richard Stallman (rms@mole.ai.mit.edu) * info.el (Info-help): Go to one window. Wed Oct 17 02:11:26 1990 David Lawrence (tale@pogo.ai.mit.edu) * lisp-mode.el: Indent autoload like defun. * cl.el, mh-e.el, gnus.el: Change uses of lisp-indent-hook to lisp-indent-function. Tue Oct 16 13:32:21 1990 Richard Stallman (rms@mole.ai.mit.edu) * files.el (revert-buffer): Discard all undo records. * rmail.el (rmail-expunge, rmail-get-new-mail): Likewise. Sun Oct 14 18:14:12 1990 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (symbol-function, fset, read-char): Don't open code them. Thu Oct 11 16:14:51 1990 Richard Stallman (rms@mole.ai.mit.edu) * Kill commands on read-only buffers, just copy to kill-ring. * simple.el (kill-region): If read-only, just copy to kill-ring. (zap-to-char, kill-line, kill-comment, kill-word): (backward-kill-word, kill-paragraph, backward-kill-paragraph): Allow read-only buffers. * csharp.el: New file. Wed Oct 10 18:00:11 1990 Richard Stallman (rms@mole.ai.mit.edu) * rmailsum.el (rmail-summary-scroll-msg-up): Make msg visible. (rmail-summary-scroll-msg-down): Likewise. * bytecomp.el (byte-compile-associative): New function. (+, max, min, -): Use that. (byte-compile-make-binary, byte-compile-butlast): New functions. Tue Oct 9 14:32:00 1990 Richard Stallman (rms@mole.ai.mit.edu) * dired.el (dired-compress, dired-uncompress): Put output from subprocess in a buffer to display it. * appt.el (fix-time): Deleted. (appt-select-lowest-window): Renamed from select-lowest-window. (appt-visible): Renamed from appt-visable. * time.el (display-time-filter): Run display-time-hook. * lisp.el (lisp-complete-symbol): Last change clobbered beg. * lisp-mode.el (indent-sexp): Make sure outer loop ends@eob. Mon Oct 8 16:59:45 1990 Richard Stallman (rms@mole.ai.mit.edu) * man.el (nuke-nroff-bs): Handle o\b+. * files.el (save-buffers-kill-emacs): Do querying here. Don't die if process-list is not defined. * simple.el (next-complex-command): Fix typo. Sun Oct 7 23:39:26 1990 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (byte-compile-file): Run set-auto-mode. Mon Oct 1 22:03:50 1990 David Lawrence (tale@pogo.ai.mit.edu) * compile.el: Major overhauls. Remove references to mode, since it never really was a mode. (compile-regexp-list): Don't use a single regexp, but try multiple ones from a list. (next-error): Don't read in every single file when doing next-error, just go to the line of the next file, reading it in if need be. The old method was slow and could end up creating a lot of buffers you never wanted around. Use buffer named in compilation-buffer. Get buffer to use interactively via compilation-use-buffer if called with arg. (compile-internal): Move window resizing here, since a grep window is still a compile window as far as this package is concerned. Don't use with-output-to-temp-buffer since it is very anti-social with show-temp-buffer-hooks which resize based on the how much data is output by its forms; it never worked with compile-window-height that way anyway. (compilation-parse-line): Figures out file and line for next-error from compile-regexp-list. (compilation-use-buffer): Function which sets buffer for next-error to use. Mon Oct 1 00:03:17 1990 Richard Stallman (rms@mole.ai.mit.edu) * c-mode.el (c-indent-line): Special clause for `} else'. Sun Sep 30 15:12:58 1990 Richard Stallman (rms@mole.ai.mit.edu) * compile.el (compilation-mode): Don't set compilation-error-regexp. (compile-internal): Set it here. (compilation-error-regexp): Put on permanent-local property. * startup.el (command-line-functions): New variable. (command-line-1): Do something with it. * diff.el (diff): Fix bug in searching for first change run. * bytecomp.el (byte-compile-lambda): Handle string constant as value. Fri Sep 28 17:52:57 1990 Richard Stallman (rms@mole.ai.mit.edu) * mh-e.el: New version from Larus. * c-mode.el (calculate-c-indent): When looking@previous column-0 line, allow whitespace between the close-paren and the semicolon. Wed Sep 26 18:48:35 1990 Richard Stallman (rms@mole.ai.mit.edu) * startup.el (command-line): Make init-file-user permanent. Tue Sep 25 09:19:27 1990 David Lawrence (tale@pogo.ai.mit.edu) * edebug.el: New file for elisp source debugging. * loaddefs.el: Autoload edebug with edebug-defun. * lisp-mode.el (eval-defun): If arg, edebug-defun. * simple.el (comment-region): New function. * c-mode.el (c-beginning-of-statement, c-end-of-statement): New functions bound to M-a and M-e respectively. (c-beginning-of-statement-1, c-end-of-statement-1): Engines for above. (set-c-style): New function to easily select a preferred indentation style. (c-style-alist): Styles and variables values for set-c-style. * asm-mode.el: New file. Mode for editing assembler code. * loaddefs.el (auto-mode-alist): Use asm-mode for .s files. Autoload it. Mon Sep 24 15:54:51 1990 Richard Stallman (rms@mole.ai.mit.edu) * loaddefs.el (auto-mode-alist): Use \\' for end of string. Sat Sep 22 04:11:46 1990 David Lawrence (tale@pogo.ai.mit.edu) * simple.el (shell-command): Document in code comment why -f is not used for C shells. Perhaps this will get people to stop asking about it. Fri Sep 21 16:04:59 1990 Richard Stallman (rms@mole.ai.mit.edu) * isearch.el (nonincremental-search): Bind cursor-in-echo-area only as long as necessary. Fri Sep 21 09:12:29 1990 David Lawrence (tale@pogo.ai.mit.edu) * loaddefs.el (auto-mode-alist): Use bibtex-mode for .bib files and autoload it. Tue Sep 18 08:55:14 1990 Richard Stallman (rms@mole.ai.mit.edu) * doctor.el (doctor-caddr, doctor-cadr, doctor-cddr): Renamed. Thu Sep 13 22:25:31 1990 Richard Stallman (rms@mole.ai.mit.edu) * c-mode.el (calculate-c-indent): Skip back across preprocessor lines before testing for a continuation statement. * mouse.el (mouse-set-point): Compensate properly for hscroll. Thu Sep 13 18:49:04 1990 Robert J. Chassell (bob@gnu.ai.mit.edu) * texinfmt.el (texinfo-format-inforef): Item name now optional. Thu Sep 13 15:30:59 1990 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-nuke-pinhead-header): Save From line in Mail-from:. * help.el (print-help-return-message): Mention C-M-v. Mon Sep 10 21:52:11 1990 Chris Hanson (cph@kleph) * xscheme.el (xscheme-eval): Add hook that allows Scheme to evaluate arbitrary expression in Emacs. (scheme-interaction-mode): Run scheme-mode-hook before scheme-interaction-mode-hook. Guarantee that the process-filter's state is correctly updated before calling any code that can possibly allow more input to be read from the process. Mon Sep 10 12:34:16 1990 Richard Stallman (rms@mole.ai.mit.edu) * rmailsort.el (rmail-sortable-date-string): Handle excess space. Discard century from year. * files.el (after-find-file): Improve a message. Sun Sep 9 17:46:03 1990 Richard Stallman (rms@mole.ai.mit.edu) * sendmail.el (mail-signature): t means use signature file. (mail-setup): Implement that. (mail-mode-map): Put mail-signature command back on C-c C-w. (mail-signature-inserted): Variable deleted. Sat Sep 8 15:33:48 1990 Richard Stallman (rms@mole.ai.mit.edu) * ftp.el (ftp-command): Ignore output lines without status codes. Thu Sep 6 22:39:48 1990 Richard Stallman (rms@mole.ai.mit.edu) * sendmail.el (mail-signature): New variable holds signature. (mail-setup): Default mail-signature from .signature file. Insert the value. Tue Sep 4 18:14:14 1990 Richard Stallman (rms@mole.ai.mit.edu) * ftp.el (ftp-write-file): Accept status 125 as normal. Mon Sep 3 03:37:22 1990 David Lawrence (tale@pogo.ai.mit.edu) * rnews.el: Reinstated. Sat Sep 1 16:48:38 1990 Richard Stallman (rms@mole.ai.mit.edu) * files.el (backup-buffer): Test backup-inhibited. (find-file-noselect, set-visited-file-name): Set that var based on backup-enable-predicate. Fri Aug 31 07:21:12 1990 David Lawrence (tale@pogo.ai.mit.edu) * sendmail.el (mail-send-and-exit): Remove dependency on other window being in rmail-mode in order to delete selected window. Thu Aug 30 05:39:11 1990 David Lawrence (tale@pogo.ai.mit.edu) * paths.el: Add gnus-default-nntp-server, gnus-nntp-service, gnus-your-domain, gnus-your-organization, and gnus-newsrc-file to be visible for admins during installation configuration. * loaddefs.el: (gnus, gnus-post-news): Autoload gnus. (sendnews, postnews): fset to gnus-post-news instead of news-post-news. (rnews, news-post-news): Removed autoloads. * gnus.el: New file. (gnus-make-newsrc-file): Removed. (gnus-read-newsrc-file): Work without above. (gnus-Info-directory): Removed. (gnus-Info-find-node): Work without above. (lots of variables): Made non-interactive. Some doc fixes. * gnuspost.el, gnusmail.el, gnusmisc.el, nntp.el, nnspool.el, * mhspool.el: New files. * rnews.el: Removed. (Renamed to rnews.el.~backout~.) Wed Aug 29 18:19:46 1990 Richard Stallman (rms@mole.ai.mit.edu) * loaddefs.el: Put paragraph commands on M-{ and M-}. * files.el (basic-save-buffer): Make error messages more natural. * rmail.el (rmail-search): Call rmail-maybe-set-message-counters. Wed Aug 29 06:14:30 1990 David Lawrence (tale@pogo.ai.mit.edu) * files.el (basic-save-buffer): Signal an error when the directory doesn't exist or is write-protected. (set-visited-file-name): When renaming buffer, don't switch from current name if that is the name causing the conflict for the new name. Eg, C-x b foo C-x C-w /tmp/foo would name the buffer foo<2> and leave no foo around. Now it stays foo. * fortran.el (fortran-mode): Define comment-line-start-skip based partially on value of fortran-comment-region; statements starting with c (eg: call, common) were being indented as comments. (fortran-current-line-indentation): Only skip over continuation char or line number for statements. It was giving back wrong values for statements which started in columns 1-6. (fortran-mode-version): Removed. Tue Aug 28 04:07:38 1990 David Lawrence (tale@pogo.ai.mit.edu) * loaddefs.el: Autoload reverse-region from sort.el. * cl.el: (defstruct): The copier function invoked the non-existent copy-vector. Calling copy-sequence does the job. (defsetf for point): Point's inverse is goto-char. Of course, what do we do with the other basic types of Emacs Lisp? (member): Another, perhaps counterproductive, speed hack. When test or testnot are symbols (hopefully, non-null), they are replaced by their symbol-function slots. This presumably reduces one indirection per each funcall in the inner loop. (byte-compile-named-list-accessors): Another byte-compile handler, this one eliminates the extra call incurred when using first, ..., tenth, or rest. This makes those list accessors essentially as primitive as car, cdr, or nth. (with-keyword-args): Macro that simplifies most of the handling of klists. The only neglected functionality is that no supplied-p forms exist (although that is true also of lambda lists in Emacs Lisp). (cl-eval-print-last-sexp): Added half-hearted support for -, +, ++, +++, *, **, ***, /, //, ///; and cleared the mvalues mechanism at every call. (declare, proclaim, the): Make some more CL codes easy to load. These are dummies, and have no effect whatsoever. (Perhaps `the' could be made to check in interpreter, and to ignore in the compiler. Then again, writing `typecase' would be also useful and I haven't done it yet.) (byte-compile-ca*d*r): New function, used as a handler from byte-compile-form to eliminate the extra call to the c*r functions in compiled code. (adjoin, map): Changed to use `memq' instead of `member', too. (case, ecase): Via a change in case-clausify, these macros now generate tests using the primitive `memq', instead of the heavier `member'. (member): Rewrote it to exploit the keyword argument machinery. It also tries to call memq whenever possible. (many funcs): Two-branch conds changed into simple ifs here and there, minor layout changes all over. (defsetf): `Puts' occur in the generated code, not in the macro expander. (Didn't we fix this long ago?) (setf): Comment disagreed with the code. Code was right. (defkeyword): Was dropping the DOCSTRING. (reduce): New function. Presented as an example of how to use KLISTs to parse calls in functions that take keyword arguments. (concatenate, map): New functions. (extract-from-klist): Swapped arguments for convenience. (keyword-argument-supplied-p, cl$subseq-as-list): New auxiliary functions. (build-klist): Better error messages. (psetf): Rewrote, patterned after the new psetq. (psetq): Added early check for even number of arguments. This causes a better error message than previously. (defstruct, parse$defstruct$options): asp@CS.CMU.EDU (James Aspnes) reported that defstruct wasn't handling properly the use of accessors of an :included definition applied to instances of the :including structure. Indeed, the old version was implementing a (rather useless) sense of multiple-inheritance that was inimical to the Common Lisp sense. Fixed here by adding properties :structure-includes and :structure-included-in to the struct name. They keep track of the graph of inclusions. (mapc, maplist, mapl, mapcan, mapcon, copy-list, copy-tree, revappend, nreconc, nbutlast, subst, subst-if, subst-if-not, sublis, member-if, member-if-not, tailp): New functions, developed apart and now merged with the main file. They still don't take :keyword arguments. * sort.el (sort-subr): Support floating point numbers. (sort-float-fields, reverse-region): New functions. (sort-numeric-fields, sort-fields, sort-float-fields): Use -ARG to mean count fields from right, not reverse. (Doc fixes.) (sort-fields-1): Let negative arg pass unmolested. Always do ascending sort. (sort-skip-fields): Handle negative field. * tex-mode.el (tex-mode-map): Move bindings of M-{ and M-} to C-c { and C-c }. Tue Aug 28 01:25:47 1990 Roland McGrath (roland@gnu.ai.mit.edu) * bytecomp.el (byte-compile-file): If interactive, ask user if he wants to save a buffer visiting file to be compiled. Mon Aug 27 00:21:22 1990 David Lawrence (tale@pogo.ai.mit.edu) * compile.el (compilation-error-regexp): Padded up a little to work with new function: (compilation-get-file-and-line): Grabs file and line using matched sub-expressions in compilation-error-regexp. (compilation-parse-errors): Use new function. (compilation-sentinel): Make buffer writable before trying to insert things. * info.el (Info-extract-menu-item): Search for an exact match for menu item before looking for a partial match. Regexp-quote the search string. * lisp.el (lisp-complete-symbol): Display possibilities in *Completions* not *Help*. * help.el (describe-mode): Use Dale Worley's version to also show minor mode documentation if argument is given. Fset defining-keyboard-macro to start-keyboard-macro so its documentation can be found. Currently does not work with auto-fill-mode because of the hook nature of its minor mode indicator variable. Sun Aug 26 21:54:33 1990 Richard Stallman (rms@mole.ai.mit.edu) * terminal.el: Move possibly offensive comments to term-nasty.el. (te-quote-arg-for-sh): Give some variables more useful names. Sat Aug 25 16:36:06 1990 Richard Stallman (rms@mole.ai.mit.edu) * resume.el: New version from Joe Wells. Wed Aug 22 11:31:37 1990 Joseph Arceneaux (jla@geech) * lisp.el (lisp-complete-symbol): Use lisp-mode-syntax table rather than current buffer's. Thu Aug 16 13:31:56 1990 Richard Stallman (rms@mole.ai.mit.edu) * isearch.el (isearch): For C-y and C-w in regexp search, use regexp-quote. * time.el (display-time-filter): Check that file is non-empty. Thu Aug 16 13:31:19 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * term/x-win.el: Don't define C-z here; it's now in screen.el. Tue Aug 14 23:44:30 1990 David J. MacKenzie (djm@apple-gunkies) * time.el: New version that uses wakeup instead of loadst. Tue Aug 14 15:50:34 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * simple.el (eval-current-buffer): New function. * screen.el: Moved screen convenience functions here, formerly in term/x-win.el. other-window now bound to esc-o, ctl-x-o now next-multiscreen-window. Mon Aug 13 17:04:20 1990 Richard Stallman (rms@mole.ai.mit.edu) * files.el: Doc fix. Sat Aug 11 10:20:49 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * screen.el (get-screen): Don't loop on screen-visible-p. Set auto-new-screen-function to new-screen. * gdb.el (gdb-break): Also handle temporary breaks. Wed Aug 1 12:02:48 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * bytecomp.el (byte-compile-file): Fix format string in call to float-output-format. Tue Jul 31 17:09:52 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * files.el (find-alternate-file): Don't depend on buffer being read-only for modifications to invoke yes-or-no-p. Sat Jul 28 22:17:57 1990 Richard Stallman (rms@mole.ai.mit.edu) * paths.el (rmail-spool-directory): Change silicon-graphics-unix to irix. Fri Jul 27 19:16:17 1990 Richard Stallman (rms@mole.ai.mit.edu) * tex-mode.el (tex-region): Set tex-last-temp-file in shell buffer. Give it tex-filter as a filter. (tex-filter): New function. Deletes the temp file and junk files. (tex-directory): Now set to `.'. Fri Jul 27 00:22:07 1990 David Lawrence (tale@pogo.ai.mit.edu) * fill.el (fill-region-as-paragraph): Remove tabs that aren't in fill-prefix or part of paragraph indentation. Thu Jul 26 20:44:37 1990 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (byte-compile-file-forms): New function. (byte-compile-file): Use that for the runs of ordinary forms. Don't crash when make-byte-code has only 3 elements. * help.el (view-lossage): Use insert, not `newline'. * info.el (Info-find-node): Set case-fold-search for tag tbl buffer. Thu Jul 26 18:24:21 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * bytecomp.el (byte-compile-verbose): Baud rate is a variable, not a function in 19. Thu Jul 26 17:58:54 1990 Richard Stallman (rms@mole.ai.mit.edu) * chistory.el (command-history-repeat): New function. (command-history-map): Put command-history-repeat on x. (command-history-mode): Document that. Thu Jul 26 00:07:49 1990 David Lawrence (tale@pogo.ai.mit.edu) * c-mode.el (c-auto-newline): Doc addition. (electric-c-terminator): Removed bogus set-marker. (electric-c-sharp-sign): Make sure c-auto-newline is nil for call to electric-c-terminator. * texinfo.el: Bind tex-insert-quote to " in texinfo-mode-map. * simple.el (goal-column): Make buffer-local. * man.el (manual-entry): Enter view-mode. Wed Jul 25 22:30:54 1990 David Lawrence (tale@pogo.ai.mit.edu) * replace.el (occur-last-string): New variable to hold last interactive regexp to occur. (occur): Use occur-last-string. * lisp.el (down-list): Doc fix. Tue Jul 24 13:27:59 1990 Richard Stallman (rms@mole.ai.mit.edu) * files.el (find-file-noselect): Nice msg if can write but not read. * lisp.el: Doc fix. Thu Jul 19 16:41:05 1990 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (byte-compile-lambda): Fix test for nontrivial function. Tue Jul 17 13:33:04 1990 Richard Stallman (rms@mole.ai.mit.edu) * files.el (find-file-read-only-other-window): New function. Put on C-x 4 r. Sun Jul 15 22:33:39 1990 Richard Stallman (rms@mole.ai.mit.edu) * register.el (view-register): Don't ignore first line of rect. Sat Jul 14 21:36:56 1990 Richard Stallman (rms@mole.ai.mit.edu) * outline.el (show-children): Make default arg smarter. Thu Jul 12 23:17:04 1990 Richard Stallman (rms@mole.ai.mit.edu) * compile.el (compile-internal): Make *compilation* read-only except during this function. Wed Jul 11 15:13:21 1990 Richard Stallman (rms@mole.ai.mit.edu) * c-mode.el (c-comment-indent): Special case comment after }. Thu Jul 5 22:28:50 1990 Robert J. Chassell (bob@gnu.ai.mit.edu) * texinfmt.el: Renamed Lisp definitions section to `Description formatting' and revised `texinfo-format-defun-1' and format defuns to handle object oriented descriptions properly. Sat Jun 30 13:07:32 1990 Richard Stallman (rms@mole.ai.mit.edu) * dbx.el: Use C-x SPC for setting break point. Fri Jun 29 13:38:44 1990 Richard Stallman (rms@mole.ai.mit.edu) * sort.el: Doc fix. Thu Jun 28 17:25:14 1990 Robert J. Chassell (bob@gnu.ai.mit.edu) * texinfmt.el (texinfo-format-paragraph-break): @br{} no longer a noop. * texinfmt.el (texinfo-format-scan): @* now breaks lines; no longer does nothing. * texinfmt.el: `Bottom node' changed to `End node' and `BN' changed to `EN'; also, `footnote-style' changed to `texinfo-footnote-style'. * texnfo-upd.el (texinfo-all-menus-update): With a non-nil argument, now updates all the nodes in the buffer before updating the menus. * texnfo-upd.el (texinfo-master-menu): With non-nil argument (prefix, if interactive) means first update all existing nodes and menus, not just menus. * texinfo.el (texinfo-show-structure): With optional arg, list lines with @-sign commands for @chapter, @section and the like, but not @node lines. Wed Jun 27 14:33:55 1990 Richard Stallman (rms@mole.ai.mit.edu) * paragraphs.el (start-of-paragraph-text): Avoid infinite loop. Tue Jun 26 21:21:56 1990 Richard Stallman (rms@mole.ai.mit.edu) * disass.el (disassemble-1): Check ptr in range for aref. * bytecomp.el (byte-compile-defvar, byte-compile-defconst): New. (byte-compile-find-vars-1): Do nothing for defun or defmacro. Do nothing for defvar or defconst with only one argument. (byte-compile-lambda): New function for error checking. (byte-compile-verbose): New variable. (byte-compile-file, byte-compile-file-form): Check that for messages. Tue Jun 26 10:04:26 1990 David Lawrence (tale@geech) * compile.el (grep): Use `grep-command' to also hold args for grep, like compile-command. * simple.el (kill-ring-save): Fixed to not reference free variable `verbose' but to just unconditionally echo message. (shell-command): Use new `last-shell-command' interactively. (shell-command-on-region): Use new `last-shell-command-on-region' interactively. Delete *Shell Command Output* if no output. (kill-comment): Error if no comment syntax defined. Mon Jun 25 21:47:26 1990 Richard Stallman (rms@mole.ai.mit.edu) * simple.el (kill-region): New arg VERBOSE says print a message. (kill-ring-save): Print a message, instead of moving point. Sat Jun 23 19:01:06 1990 Randall Smith (randy@substantia-nigra) * dired.el (dired-flag-regexp-files): Added function to flag all files matching a REGEXP for deletion. (): Bound this function to key "F" in dired-mode ("D" was already taken). Fri Jun 22 17:04:03 1990 Richard Stallman (rms@albert.ai.mit.edu) * fill.el (fill-region-as-paragraph): Don't consider colon as sentence end. Use syntax table to decide what is whitespace. (justify-current-line): Don't consider colon as sentence end. * c-mode.el (calculate-c-indent): Back up over comma before calling c-backward-to-start-of-continued-exp. (c-backward-to-start-of-continued-exp): Back up over strings. Thu Jun 21 18:11:45 1990 Robert J. Chassell (bob@pogo.ai.mit.edu) * texinfmt.el (texinfo-format-include): Include files ending with ".texi" as well as ".texinfo" and ".tex". * texinfmt.el: Define @shortcontents, like @summaryconents, as 'texinfo-discard-line-with-args. Wed Jun 20 11:43:53 1990 Richard Stallman (rms@mole.ai.mit.edu) * isearch.el (isearch): Do exit on meta keys. Also exit on function keys and mouse clicks. * loaddefs.el (search-exit-char): Change back to escape. (search-ring-advance-char): Moved from isearch.el. (search-ring-retreat-char): Renamed from ...-recline-char and moved. * float.el: Provide 'float. Tue Jun 19 16:32:11 1990 Richard Stallman (rms@mole.ai.mit.edu) * mouse.el (mouse-set-point): Compensate for horizontal scrolling. Tue Jun 19 11:56:04 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * isearch.el (isearch): Don't quit on meta-chars. Fri Jun 15 20:51:05 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * loaddefs.el: search-exit-char is now Return. * simple.el: Search-ring advance and recline characters are now M-n and M-p. Fri Jun 15 09:19:27 1990 Robert J. Chassell (bob@pogo.ai.mit.edu) * tex-mode.el (tex-start-shell): Don't put `require' in defun, put it@top level. * texnfo-upd.el (texinfo-incorporate-descriptions): Don't accidently find a string in the description that is confused for a menu item. Fri Jun 1 17:41:08 1990 Robert J. Chassell (bob@wheat-chex) * texinfo.el: Added `texinfo-tex-region' (C-c C-r) to run TeX on the current region, `texinfo-tex-buffer' (C-c C-t) to run TeX on the current buffer, and `texinfo-tex-print' (C-c C-p) to print the .dvi file made by TeX. Also, bound functions from TeX mode in Texinfo mode: `tex-kill-job' (C-c C-k), `tex-recenter-output-buffer' (C-c C-l), and `tex-show-print-queue' (C-c C-q). Thu May 31 17:28:34 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * startup.el (command-line): Check environment variable VERSION_CONTROL and set version-control appropriately. Thu May 31 16:34:56 1990 Robert J. Chassell (bob@wheat-chex) * texnfo-upd.el (texinfo-top-pointer-case): rewrote to handle @chapter (or other sectioning) command following Top node. (texinfo-master-menu): rewrote to remove pre-existing master menu, if there is one. Non-nil argument (prefix, if interactive) now means first update all existing menus---previously it always updated all existing menus (very time consuming). (texinfo-all-menus-update, texinfo-every-node-update): added a save-excursion to each so that point does not move when you update the menus or nodes. * texinfmt.el (texinfo-format-parse-args): expand arguments so they can include commands such as @code, etc. Thu May 31 10:29:32 1990 David Lawrence (tale@geech) * backquote.el (bq-splicequote): Correctly splice in elements when followed by constant elements; don't list the constant elements. * add-log.el (add-change-log-entry): Fixed match test for full name. * lpr.el (print-buffer): Removed an extra trailing parenthesis. Wed May 30 23:15:46 1990 David Lawrence (tale@geech) * comint.el (comint-load-hook): Superseded by eval-after-load. * inf-lisp.el (lisp-eval-region, lisp-compile-region): Use temporary files instead of send-string to avoid problems with pty buffering. * tex-mode.el (tex-close-latex-block): Allow whitespace after \begin and \end before their opening brace. (tex-last-unended-begin): Ditto. Wed May 30 22:15:18 1990 Richard Stallman (rms@mole.ai.mit.edu) * subr.el (add-hook): New function. Wed May 30 21:43:18 1990 David Lawrence (tale@geech) * dired.el (dired-revert): Preserve deletions across reversion and report files flagged for deletion which were already removed. When reading the root directory, name the buffer "/". Tue May 29 12:51:32 1990 Richard Stallman (rms@mole.ai.mit.edu) * scheme.el (run-scheme): Autoload deleted. Already done in loaddefs. Thu May 24 17:58:44 1990 Robert J. Chassell (bob@rice-chex) * page-ext.el (pages-directory-goto): Go to end of file if called from the last line (which is empty) of the pages-directory Thu May 24 13:57:06 1990 David Lawrence (tale@pogo.ai.mit.edu) * shell.el (shell-load-hook): Superseded by eval-after-load. * files.el (cd): Make sure that directory can be changed to. * shell.el (shell-process-cd-or-pushd): ditto. * c++-mode.el: Installed latest version from David Detlefs with all additions made since Sep 1989. Thu May 24 13:07:38 1990 Robert J. Chassell (bob@apple-gunkies) * texinfmt.el: Added texinfo-format-defindex which provides @defindex and @defcodeindex. Rewrote texinfo-format-synindex to be more modular; removed references to it in texinfo-format-scan and texinfo-format-printindex. Tue May 22 19:50:46 1990 David Lawrence (tale@geech) * informat.el: (Info-tagify): Give status messages before and after tagifying. (batch-info-validate): Removed status messages around Info-tagify. * rmailout.el (rmail-output): Check for From:, Really-From: and Sender: fields, in that order, and run mail-strip-quoted-names on a non-nil value for the initial Unix mail "From user date" line. Mon May 21 17:26:20 1990 Richard Stallman (rms@mole.ai.mit.edu) * buff-menu.el (Buffer-menu-buffer): Simplified. Set Buffer-menu-buffer-column initially. Fri May 18 14:33:00 1990 Robert J. Chassell (bob@apple-gunkies) * page-ext.el: (pages-addresses-file-name): Renamed from addresses-file-name. Thu May 17 22:25:38 1990 Robert J. Chassell (bob@apple-gunkies) * texinfo.el (texinfo-mode-map): Replace `C-c LETTER ...' key bindings for functions updating nodes and menus with `C-c C-...' keybindings, so as to leave `C-c LETTER' bindings free. * texnfo-upd.el (texinfo-menu-copy-old-description): Copy descriptions that begin with an `@' as well as with word syntax char. (texinfo-insert-master-menu-list): Print message telling which menu entry it is inserting. Sat May 12 23:35:49 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * isearch.el (isearch): Check non-nil of unread command char before checking >= 0. Sat May 12 16:53:35 1990 Richard Stallman (rms@mole.ai.mit.edu) * info.el (Info-read-subfile): Ignore blank lines in split file list. Fri May 11 16:01:41 1990 Richard Stallman (rms@albert.ai.mit.edu) * isearch.el (isearch): Advance@least one character if empty string was found the previous time. * replace.el (keep-lines): Likewise. Thu May 10 21:47:33 1990 Robert J. Chassell (bob@wheat-chex) * texinfmt.el: updated to correspond, more or less, to version 2.8 of texinfo.tex. Does not do refilling. texinfo-format-chapter-1 now displays message telling which section is being formatted, so formatting is no longer silent. Added notations: @quiv, @error, @expansion, @point, @print, @result Added @synindex and @syncodeindex, including texinfo-format-synindex, texinfo-format-syncodeindex, and defined syncode-arg as local variable in texinfo-format-scan. Modified texinfo-format-printindex to handle these. Added @ref, which the same as @xref in Info. Added @titlespec, which is ignored in Info. Added @br @need as noops. Added @today texinfo-format-today in `1 Jan 1900' style. Added @defconst, @defcmd to the texinfo-format-defun series Added @flushright @end flushright, including texinfo-format-flushright, texinfo-end-flushright, texinfo-do-flushright. Added @ftable, which is like the `@table' command but also inserts each item in the first column into the function index. Includes texinfo-ftable, texinfo-ftable-item, texinfo-end-ftable. Added @footnote, including texinfo-format-footnote, footnote-style, texinfo-format-make-node, texinfo-format-bottom-node. Thu May 10 15:23:04 1990 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (byte-compile-cond-1): Handle (t). Fri May 4 17:28:35 1990 Richard Stallman (rms@mole.ai.mit.edu) * simple.el (indent-new-comment-line): Delete the temporary newline even if point is not there after indent-for-comment. Fri May 4 17:05:42 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * simple.el (open-line): Insert fill-prefix if defined. Tue May 1 14:49:46 1990 Richard Stallman (rms@mole.ai.mit.edu) * c-mode.el (c-comment-indent): If@beginning of line and comment-column is 0, insert no space. * replace.el (occur): Avoid infinite loop@end of buffer. Mon Apr 30 20:54:47 1990 Richard Stallman (rms@mole.ai.mit.edu) * float.el (float-to-string): Adjust POWER when rounding makes new digit. Thu Apr 26 16:20:32 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * man.el (manual-entry): Don't allow null topics. * dired.el (dired-create-directory): Use new primitive make-directory. (dired-do-deletions): Use new primitive remove-directory. Tue Apr 24 14:15:33 1990 Richard Stallman (rms@mole.ai.mit.edu) * dired.el (dired-readin): Mark buffer unmodified@end. Wed Apr 18 23:10:15 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * loaddefs.el: Removed Meta-g def of fill-region. Fri Apr 13 18:33:08 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * c-mode.el (c-comment-indent): Don't need \n in #endif/#else regexps. Thu Apr 12 21:48:01 1990 Richard Stallman (rms@mole.ai.mit.edu) * isearch.el (isearch): In reverse search, don't move point for C-w, C-y. * startup.el (normal-top-level): Don't check envvar PWD on vms. Tue Apr 10 19:37:35 1990 Richard Stallman (rms@mole.ai.mit.edu) * add-log.el (add-change-log-entry): Require match in full-name as well as login-name. Don't switch windows if desired buffer already current. (add-change-log-entry-other-window): Take two args and pass on. Change interactive spec so default behavior doesn't change. Mon Apr 9 12:42:17 1990 Richard Stallman (rms@mole.ai.mit.edu) * dired.el (dired-mode): Set list-buffers-directory like dired-directory. So name appears in list-buffers. * sendmail.el (mail-do-fcc): Append properly to rmail buffers. * bytecomp.el (byte-compile-find-vars-1): Treat interactive and save-window-excursion like condition-case. Sun Apr 8 17:06:53 1990 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (byte-compile-file-form): Most forms pushed on `pending'. Those that are special print their output and first compile and print the contents of `pending'. (byte-compile-file):@end of file, compile and print `pending'. (byte-compile-pending): New function. * bytecomp.el (byte-compile-find-vars-1): Special case unwind-protect and save-window-excursion. Fri Apr 6 21:04:05 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * mouse.el: Check consp of coordinates-in-window-p result. Fri Apr 6 15:48:11 1990 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (byte-compile-file): Accumulate consecutive ordinary forms, put them together into lambdas, and call them. (byte-compile-file-form): With nil, do nothing fast. (byte-compile-lambda): Do nothing with trivial lambdas Thu Apr 5 16:41:44 1990 Richard Stallman (rms@mole.ai.mit.edu) * rmailout.el (rmail-output-to-rmail-file): Set message counters before inserting in a file being visited. Thu Apr 5 14:26:27 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * screen.el: Don't redefine ctl-x {p,n}, just ctl-x o. Thu Apr 5 13:37:31 1990 Richard Stallman (rms@mole.ai.mit.edu) * startup.el (command-line-1): Always erase *scratch*, not current buf. Wed Apr 4 16:27:19 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * screen.el: Define keys ctl-x {o, n, p}. Make C-Z iconify emacs. (next-multiscreen-window): (previous-multiscreen-window): Include the minibuffer screen if the minbuffer is active. Tue Apr 3 21:33:07 1990 Richard Stallman (rms@mole.ai.mit.edu) * fill.el (fill-individual-paragraphs): Check for mail header name only@beginning of line. Thu Mar 29 18:02:16 1990 Richard Stallman (rms@mole.ai.mit.edu) * keypad.el: Define the `do' key. * dired.el (dired-diff): New command. (dired-mode-map): Put on `='. Wed Mar 28 21:23:00 1990 Jim Kingdon (kingdon@mole.ai.mit.edu) * rmail.el (rmail-insert-rmail-file-header, rmail-convert-file): Put in "-*- rmail -*-". Rename rmail-mode to rmail-mode-2. (rmail-mode): New function. Move docstring and (interactive) from rmail-mode to rmail-mode-2. (rmail): Call rmail-mode-2 not rmail-mode. Tue Mar 27 17:30:27 1990 Richard Stallman (rms@mole.ai.mit.edu) * etags.el (tags-loop-continue): Print message when find a match, if tags-loop-operate is nil. * c-mode.el (calculate-c-indent): Don't consider a line as a function definition line if it contains `='. * compile.el (compile-find-file): New function, to search a path. (compilation-parse-errors): Use it. (compilation-search-path): New user variable. Sun Mar 25 23:02:44 1990 Richard Stallman (rms@mole.ai.mit.edu) * loaddefs.el: Add autoloads for ispell.el. * ispell.el: Doc fixes. Problem: key for ispell-next was already used by set-selective-display. Should we move that? Sun Mar 25 17:06:15 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * x-mouse.el (x-select): Only pass one arg to x-own-selection. Fri Mar 23 15:39:01 1990 Richard Stallman (rms@mole.ai.mit.edu) * fortran.el (fortran-electric-line-number): Make sure arg to self-insert-command is a number. Wed Mar 21 13:54:20 1990 Richard Stallman (rms@mole.ai.mit.edu) * fortran.el (fortran-electric-line-number): Use self-insert-command for all insertion. Wed Mar 21 11:18:06 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * startup.el (command-line): Load the window-system file if DISPLAY is set or -d was specified on the command line. Tue Mar 20 14:44:21 1990 Richard Stallman (rms@mole.ai.mit.edu) * lpr.el (print-region-1): New arg PAGE-HEADERS. On system V, handle it by running pr. Use print-region-new-buffer to copy text to temp buffer. (all commands): Pass new arg; pass lpr-switches unchanged. (print-region-new-buffer): New function. Tue Mar 20 13:12:54 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * term/x-win.el (x-pop-initial-window): Set mouse-motion-handler. Mon Mar 19 11:22:38 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * sendmail.el (mail-send): Force deletion of auto-save files. (mail-do-fcc): Add closing paren. Sat Mar 17 12:45:54 1990 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (byte-compile-file): Turn off print-length. Fri Mar 16 12:49:01 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * simple.el (auto-fill-mode): Doc fix. Wed Mar 14 19:56:51 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * term/x-win.el: Set suspend hook here, as well as put 'iconify-emacs on C-Z. * screen.el: Check screenp of last-selected-screen in iconification functions. Wed Mar 14 13:07:41 1990 David Lawrence (tale@pogo.ai.mit.edu) * c++-mode.el (c++-comment-region): New function. (c++-uncomment-region): New function. Sun Mar 11 15:49:46 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * mouse.el (track-mouse): x-mouse-grabbed now mouse-grabbed. * x-mouse.el (dynamic-rect-selection): Ditto. Sat Mar 10 18:29:21 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * x-mouse.el: Conditionalization of certain functions dependent on X version. Added mouse-key descriptions for X11. Fri Mar 9 18:53:52 1990 Richard Stallman (rms@mole.ai.mit.edu) * man.el (nuke-nroff-bs): Allow period in middle of topic name. * simple.el (do-auto-fill): Handle auto-fill-inhibit-regexp. * outline.el (outline-mode): Set that from outline-regexp. Thu Mar 8 13:19:18 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * screen.el (deiconify-function, multi-minibuffer-startup, attached-minibuffer-startup, detached-minibuffer-startup): Pass second parameter t to select-screen. Wed Mar 7 17:59:00 1990 Richard Stallman (rms@mole.ai.mit.edu) * sendmail.el (mail-do-fcc): Temporarily unwiden Tue Mar 6 11:46:18 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * screen.el (deiconify-function): Setq last-selected-screen nil. * array.el, blackbox.el, compile.el, diff.el, files.el, ftp.el: * gomoku.el, hanoi.el, informat.el, ispell.el, life.el, mailalias.el: * man.el, rmail.el, sendmail.el, terminal.el: * texinfmt.el: Renamed buffer-flush-undo to buffer-disable-undo. Sun Mar 4 17:53:05 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * screen.el (get-screen): If the screen is not visible, make it so. Fri Mar 2 15:56:31 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * term/x-win.el: Don't set suspend-hook any more. * screen.el: No more x-specific things, this is now entirely window system independent. (new-screen): Use new function: (new-screen-position): Determine position of new screen based on that of selected-screen. (pop-initial-screen): Set first-screen-user-positioned if user did so. Also decide on which screen style depending on either new variable `separate-minibuffer-screen' or minibuffer elt in window-system-switches. (detached-minibuffer-startup): Add screen colors to minibuffer alist if possible. Also make sure screen-default-alist has minibuffer element none, and correct name. Thu Mar 1 13:42:23 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * term/x-win.el: Require 'screen as well in initial setup code. Don't set suspend hook; this will be something else. Removed redundant cursor-shape delcarations. The all begin with x-pointer- now. Added some more definitions to the function keys. Generally cleaned up this file. Thu Mar 1 01:24:49 1990 David Lawrence (tale@pogo.ai.mit.edu) * subr.el (force-mode-line-update): New function. time.el (display-time-filter): Update modeline with above. * rmail.el (rmail-get-new-mail): Remove " Mail" from display-time-string if necessary. Wed Feb 28 14:55:08 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * screen.el (iconify-function, iconify-emacs, deiconify-function): New functions. * files.el (save-some-buffers): Removed last parameter skip-list. Now this checks for buffer-local variable save-buffers-skip to determine whether or not to avoid asking to save the buffer. * rmail.el (rmail-mode): Removed skip-list stuff. (rmail-variables): make-local-variable save-buffers-skip. * compile.el (compile): Removed additional parameter to save-buffers. Mon Feb 26 01:02:22 1990 David Lawrence (tale@pogo.ai.mit.edu) * time.el (display-time-hook): New hook run by display-time-filter. (display-time-filter): Run display-time-hook after setting display-time-string. (rmail-pop-up): Default display-time-hook to automatically retrieve new mail if the variable rmail-pop-up is non-nil. (add-clock-handler): Removed; superceded by timer.el. * loaddefs.el: Removed add-clock-handler. Sun Feb 25 16:57:36 1990 David Lawrence (tale@pogo.ai.mit.edu) * c++-mode.el: New file. (point-bol): Removed this function. * loaddefs.el: Autoload C++-mode. (auto-mode-alist): c++-mode for .C and .cc files. Sun Feb 25 13:29:16 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * lisp-mode.el (indent-sexp): Changed opoint to last-point. Very strange, I thought I'd already fixed this. * screen.el: New file. Sat Feb 24 08:57:50 1990 David Lawrence (tale@pogo.ai.mit.edu) * loaddefs.el: Autoload for diff. * files.el (diff): Superceded by diff.el. (diff-switches-function): Still needs to be merged into diff.el. * diff.el: New file. Changes from the original include recognition of context diffs, rewrites of motion functions for more efficiency, and general tidying of code. Thu Feb 22 15:47:21 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * isearch.el (isearch): After doing read-event, check numberp of char first. * replace.el (perform-replace): Use read-event rather than read-char. Check that returned object is char before comparisons. Thu Feb 22 05:43:25 1990 David Lawrence (tale@pogo.ai.mit.edu) * files.el (file-newest-backup): Return either the name of an existing backup file or nil if none exists. * server.el (server-program): Renamed from "server" to "emacsserver". Tue Feb 20 10:46:14 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * fill.el (fill-region-as-paragraph): Fixed regexp typo in call to re-search-forward. Mon Feb 19 22:09:14 1990 David Lawrence (tale@pogo.ai.mit.edu) * simple.el (kill-comment): Take better advantage of comment-end. Sun Feb 18 14:02:31 1990 Richard Stallman (rms@mole.ai.mit.edu) * ispell.el: new file. Wed Feb 14 13:19:45 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * calendar.el: Require cl. Tue Feb 13 21:15:15 1990 David Lawrence (tale@wheat-chex) * files.el: Set default-directory of *Directory* to one displayed by list-directory. * compile.el: Added to compilation-error-regexp pattern for errors from IBM High C. Tue Feb 13 15:37:56 1990 Joseph Arceneaux (jla@gnu.ai.mit.edu) * files.el (save-some-buffers): New parameter skip-list of buffers to not save. New variable save-buffers-skip-list. * rmail.el (rmail-mode): Add the RMAIL buffer to the skip list. * compile.el (compile): Pass save-buffers-skip-list to save-some-buffers. Mon Feb 12 22:26:58 1990 Richard Stallman (rms@mole.ai.mit.edu) * rmailsum.el (rmail-summary-by-regexp, rmail-message-regexp-p): New functions. Mon Feb 12 02:19:40 1990 David Lawrence (tale@galapas) * tex-mode.el: require oshell until converted to comint. * loaddefs.el: point run-lisp autoload to new file inf-lisp. * shell.el: converted to comint. Relegated original to oshell.el. * inf-lisp.el: converted to comint. * comint.el: removed last vestiges of original history stuff. Wed Feb 7 16:27:31 1990 David Lawrence (tale@galapas) * inf-lisp.el: inferior-lisp-program can be a list of the programme name and its arguments. Tue Feb 6 14:42:09 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el: (french-calendar-leap-year-p): Rewritten with corrected rule. (calendar-absolute-from-french): Fixed comments. (calendar-french-from-absolute): Rewrote using calendar-sum. (cursor-to-french-calendar-date): Simplified and corrected spelling. Tue Feb 6 15:59:23 1990 Richard Stallman (rms@mole.ai.mit.edu) * register.el (insert-register): Return nil. (jump-to-register): Likewise. * sort.el (sort-subr): Return nil. * simple.el (copy-region-as-kill): Return nil. * register.el (set-register): Return VALUE. Tue Feb 6 15:03:55 1990 Joseph Arceneaux (jla@albert.ai.mit.edu) * term/x-win.el (x-pop-up-window): Die and leave disgusted message when we can't get our X-window up. Mon Feb 5 17:59:22 1990 Richard Stallman (rms@mole.ai.mit.edu) * c-mode.el (calculate-c-indent): When distinguishing top level, check for doublequotes when checking for parens. Sun Feb 4 00:37:28 1990 Richard Stallman (rms@mole.ai.mit.edu) * tex-mode.el (tex-show-print-queue): Restart shell like tex-file. Fri Feb 2 14:53:44 1990 Richard Stallman (rms@mole.ai.mit.edu) * tex-mode.el (tex-bibtex-file, tex-file, tex-region): Restart the tex shell if process is gone or stopped. (tex-shell-running): New function. Thu Feb 1 02:21:56 1990 Richard Stallman (rms@mole.ai.mit.edu) * texinfmt.el (batch-texinfo-format): Paren error on (setq error 1). Sat Jan 27 21:54:58 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el: (scroll-calendar-left): Fixed so it works when the cursor is not positioned on a day. (cursor-to-calendar-day-of-year): Fixed so that "day" is properly pluralized, depending how many days remain in the year. (french-calendar-leap-year-p): New function. (french-calendar-last-day-of-month): New function. (calendar-absolute-from-french): New function. (calendar-french-from-absolute): New function. (cursor-to-french-calendar-date): New function. (calendar-mode-map): Put cursor-to-french-calendar-date on a key. (calendar-mode): Describe cursor-to-french-calendar-date. Wed Jan 31 12:25:01 1990 Richard Stallman (rms@mole.ai.mit.edu) * yow.el: Provide 'yow. Thu Jan 25 21:57:25 1990 Richard Stallman (rms@mole.ai.mit.edu) * lisp-mode.el: Indent prog2 specially. Wed Jan 24 19:56:49 1990 Richard Stallman (rms@albert.ai.mit.edu) * compare-w.el (compare-windows): Handle compare-ignore-case. Fri Jan 19 22:27:36 1990 David Lawrence (tale@cocoa-puffs) * dired.el: Removed restriction for -s, -i and -F switches to ls. * loaddefs.el: Removed above from dired-listing-switches doc string. * mh-e.el (c/o James Larus ): Accepts message range specifications. Defaults sequence name to previous sequence name when reading. Made mode-line id user-setable. Changes from Gildea: documentation and a few typos. Added command to pipe message through shell command. Fixed refile twice failed after second one moved. Added changes from Gildea to speed-up mh-e. Won't reverse sequence lists. Allows arbitrary fields for pick. Packing folder now properly updates sequence list. Added previously missing %s in mh-redistribute. * timer.el: (new file) Adds run-at-time function with absolute or relative time spec to run a function with args. * loaddefs.el: autoload for run-at-time. Tue Jan 16 19:49:00 1990 Richard Stallman (rms@mole.ai.mit.edu) * rfc822.el (rfc822-addresses): Barf, don't loop, on > in host name. Tue Jan 16 19:31:46 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * diary.el: (insert-diary-entry): New function. (insert-weekly-diary-entry): New function. (insert-monthly-diary-entry): New function. (insert-yearly-diary-entry): New function. (insert-hebrew-diary-entry): New function. (insert-monthly-hebrew-diary-entry): New function. (insert-yearly-hebrew-diary-entry): New function. (insert-islamic-diary-entry): New function. (insert-monthly-islamic-diary-entry): New function. (insert-yearly-islamic-diary-entry): New function. * calendar.el: Autoload these functions. (calendar-mode-map): Put them on keys. (calendar-mode): Describe them. Thu Jan 11 20:45:04 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * diary.el (list-diary-entries): Deleted several lines of extraneous code and added `nongregorian-diary-listing-hook' to the list of hooks called@the end; this is for use in including Hebrew, Islamic, Julian, or ISO diary entries. A similar `nongregorian-diary-marking-hook' was added to the list of hooks called at the end of mark-diary-entries for the same reason. (diary-name-pattern): Fixed the documentation and added an optional parameter FULLNAME which insists on the full spelling of the name; this is also for use in marking Hebrew or Islamic diary entries (those month names are not unique in the first three characters). (mark-hebrew-diary-entries): New function. (list-hebrew-diary-entries): New function. (mark-hebrew-calendar-date-pattern): New function. (mark-islamic-diary-entries): New function. (list-islamic-diary-entries): New function. (mark-islamic-calendar-date-pattern): New function. (list-diary-entries): Added nongregorian-diary-listing-hook. (mark-diary-entries): Added nongregorian-diary-marking-hook. * calendar.el: Added documentation for the hooks described above. Wed Jan 10 13:21:32 1990 Richard Stallman (rms@mole.ai.mit.edu) * isearch.el (isearch): Check adding * or | to regexp even if failing. * yow.el (yow): Don't be confused by percent in message. Use raw prefix arg as first argument; process it later. Mon Jan 8 14:06:03 1990 Robert J. Chassell (bob@apple-gunkies.ai.mit.edu) * texnfo-upd.el (texinfo-update-node, texinfo-sequential-node-update): fixed auto-fill-hook bug. Mon Jan 8 13:07:38 1990 Joseph Arceneaux (jla@spiff) * term/x-win.el (x-pop-up-window): Set global-minibuffer-screen. Mon Jan 8 12:21:09 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-date-is-visible-p): Fixed so it does not switch to the calendar buffer. * diary.el (prepare-fancy-diary-buffer): Compute the list of holidays only once for each three-month period, not once for each date displayed in the calendar. This saves an enormous amount of time in the fancy diary display for multiple days. Sun Jan 7 16:03:28 1990 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el: Fixed the value of list-diary-entries-hook. (regenerate-calendar-window): Changed (update-display) to (sit-for 0). Corrected several instances of "dairy" to "diary". (describe-calendar-mode): Added this function to issue the message "Preparing..." to `?' key in calendar-mode because it's so incredibly slow for describe-mode to prepare the help buffer. (calendar-holidays): Fixed the examples in the doc-string. * diary.el: Corrected several instances of "dairy" to "diary". Fri Jan 5 17:10:47 1990 Joseph Arceneaux (jla@spiff) * term/x-win.el: Function key stuff redone. Thu Jan 4 21:10:29 1990 Richard Stallman (rms@mole.ai.mit.edu) * tex-mode.el (tex-kill-job): Avoid error if no process. * bibtex.el (sun menus): Avoid error if defmenu not defined. * doctor.el: Delete spurious symbol@top level. Wed Jan 3 19:54:36 1990 Richard Stallman (rms@mole.ai.mit.edu) * view.el (View-scroll-lines-forward): Exit@end only if view-scroll-forward-exits is non-nil. Fri Dec 29 14:32:18 1989 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (mark-diary-entries): Made "sticky" so effect continues whenever the calendar is redisplayed. (mark-calendar-holidays, calendar-unmark): Likewise. Tue Dec 26 15:33:45 1989 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el: Fixed many minor bugs throughout the code. The major changes are as follows. Completely rewrote the Hebrew calendar functions to make them much faster and hence make holiday determination much faster Split the code into three files: the calendar stuff is in the main file, calendar.el; the diary stuff is in diary.el; the holiday stuff is in holiday.el. Added a diary hook example that shows how to get sorted diary entries in the fancy diary buffer. (calendar-iso-from-absolute): New function. (calendar-absolute-from-iso): New function. (cursor-to-iso-calendar-date): Added `D' calendar command to give the day number in the Gregorian year and number of days remaining. (mark-diary-entries): Made two-digit abbreviated years acceptable in diary entries. Changed possible diary entry styles: DAY entries are no longer available; European style is now an option. Diary entry styles are now controlled by a list of pseudo-patterns. (list-diary-entries): Made two-digit abbreviated years acceptable in diary entries. Changed possible diary entry styles: DAY entries are no longer available; European style is now an option. Diary entry styles are now controlled by a list of pseudo-patterns. (calendar-date-string): Display style of dates is now controlled by a pseudo-pattern so the European style is available. (all functions conatining the word `hebrew'). (list-diary-entries, mark-diary-entries): (include-other-diary-files, mark-included-diary-files): Added the possibity of `shared diary files' with a recursive include mechanism like the C preprocessor (list-calendar-holidays): Eliminated the 'special class of holidays, rewriting the entire mechanism to make it more general. (calendar-holiday-function-float): Changed the 'float class of holidays so that negative values count backward from end of month: 5 is no longer used for the last occurrence of a day in a month; -1 is used instead Wed Dec 27 16:41:54 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail): Handle MAIL environment var. Mon Dec 25 00:18:25 1989 Richard Stallman (rms@mole.ai.mit.edu) * loaddefs.el (sentence-end): Allow single space@EOL. * etags.el: New name for tags.el. * loaddefs.el: Autoloads changed. * paths.el (manual-formatted-dirlist): New alternative for UMAX. * simple.el (next-complex-command): Fix err msg. Thu Dec 21 19:02:14 1989 Richard Stallman (rms@mole.ai.mit.edu) * lisp-mode.el (indent-sexp): Exit outer loop if make no progress. Wed Dec 20 07:06:12 1989 Richard Stallman (rms@mole.ai.mit.edu) * telnet.el (telnet-initial-filter): Make `password' local. Mon Dec 18 17:05:40 1989 Richard Stallman (rms@mole.ai.mit.edu) * simple.el (edit-and-eval-command): Add new command to history. * chistory.el (repeat-matching-complex-command): Delete the useless history entry for this command. Sun Dec 17 01:38:08 1989 David Lawrence (tale@cocoa-puffs) * (comint-)shell.el: Use comint. NOT ready yet. * (comint-)inf-lisp.el: Broke the inferior lisp code out to its own file and converted for comint use. NOT ready yet. Sat Dec 16 14:17:02 1989 Richard Stallman (rms@mole.ai.mit.edu) * c-mode.el (indent-c-exp): Verify that comment start isn't in string. Reindent comment on starting line like other comments. * tex-mode.el (validate-tex-buffer): Use tex-validate-region, not obsolete name. Fri Dec 15 13:20:01 1989 Joseph Arceneaux (jla@spiff) * isearch.el: Replaced all occurences of read-char with read-event; and check return type. Fri Dec 15 09:21:32 1989 Richard Stallman (rms@mole.ai.mit.edu) * appt.el: New file. * files.el (backup-buffer): Ask question (if nec) before writing file. Tue Dec 12 03:24:48 1989 David Lawrence (tale@cocoa-puffs) * medit.el and simple.el: initial definition of keymaps uses copy-keymap, not copy-alist. Mon Dec 11 00:11:02 1989 David Lawrence (tale@cocoa-puffs) * telnet.el: Converted to use comint. Removed delete-char-or-send-eof and telnet-copy-last-input. Added telnet-mode-hook. Modified telnet-filter to insert-before-markers at the process-mark. Sun Dec 10 19:07:33 1989 David Lawrence (tale@cocoa-puffs) * prolog.el: Converted to use comint. Replaced copy-keymap for copy-alist of comint-mode-map. * kermit.el: Converted to use comint. Replaced kermit-clean-filter with a more efficient version. * comint.el: Added optional arguments ``terminator'' and ``delete'' to comint-send-input, for processes that want to see a CR or CR-LFD pair instead of LFD and for processes that do echoing. Fri Dec 8 22:14:42 1989 David Lawrence (tale@cocoa-puffs) * history.el (new file): general history mechanism, primarily intended for interactive processes. * comint.el: converted to use history.el. Took out all the ring code. comint-send-input will replace entire input region rather than append to it (user option?). comint-kill-output will only nuke through the last newline, to retain prompt. comint-show-output will start window@line before output start, to show command. * dbx.el: Converted to use comint-mode. Wed Dec 6 05:22:20 1989 David Lawrence (tale@wheat-chex) * comint.el: make-variable-buffer-local declarations moved from comint-mode to defvars. * gdb.el: Converted to use comint-mode. Tue Dec 5 00:56:37 1989 David Lawrence (tale@wheat-chex) * comint.el (new file): Added FSF copyright. Moved bindings off of C-c LETTER. Cleaned up references to cmu* files. Made comint-send-input do unconditional end-of-line before processing. cominit-exec will signal an error if no programme name. Removed full-copy-sparse-keymap and comint-log-user. Mon Dec 4 08:56:54 1989 Joseph Arceneaux (jla@spiff) * isearch.el: fset synonyms for re-search-*. Thu Nov 30 09:51:12 1989 Joseph Arceneaux (jla@spiff) * c-mode.el (c-comment-indent): Place comments 2 spaces after #endif and #else. Mon Nov 27 08:51:07 1989 Joseph Arceneaux (jla@spiff) * shell.el (shell-complete-file-name): Don't count tildes as filename separators if they are in the filename to be expanded. Wed Nov 22 17:36:59 1989 Joseph Arceneaux (jla@spiff) * mouse.el, x-mouse.el: Moved button definitions from mouse.el to x-mouse.el. They are defined differently depending upon the X version. Fri Nov 17 13:37:32 1989 Joseph Arceneaux (jla@spiff) * paths.el: Changed rmail-file-name from const to a var. Thu Nov 16 23:43:26 1989 Ed Reingold (reingold@cs.uiuc.edu) * tex-mode.el (slitex-mode): New alternative to plain-tex-mode and latex-mode. (tex-mode): Know when to choose slitex mode. (tex-run-command, latex-run-command, slitex-run-command): New vars. (tex-mode, latex-mode, slitex-mode): Init tex-command from them. (tex-latex-block): Insert matching begin-end pair for latex. (tex-close-block): Be smart about nested begin-end pairs. (tex-last-unended-begin): New subroutine. (tex-region): Handle buffers with no files. (tex-file): Cleaner error for buffer with no file. (tex-generate-zap-file-name): New name for tex-generate-junk-file-name. Thu Nov 16 10:24:52 1989 Joseph Arceneaux (jla@spiff) * simple.el: New variable x-select-kill. (copy-region-as-kill): If non-nil, make the killed text an X selection. * fill.el (justify-current-line, fill-region-as-paragraph): Consider : as sentence terminator. Tue Nov 14 19:32:22 1989 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (byte-compile-file): Copy .el permissions to .elc. Delete .elc if possible before writing. Thu Nov 9 18:05:43 1989 Joseph Arceneaux (jla@spiff) * x-mouse.el (x-select-wipe): New function. Bind the selection functions to the default keys. Wed Nov 8 15:54:55 1989 Richard Stallman (rms@mole.ai.mit.edu) * tex-mode.el (tex-bibtex-file): New command. (tex-mode-map): Put on a key. * debug.el (debug): No need to check match-data for invalid markers. Wed Nov 8 14:14:20 1989 Joseph Arceneaux (jla@spiff) * paths.el (mh-progs, mh-lib): Use file-directory-p, and check /usr/local/bin as well. Mon Nov 6 01:35:05 1989 Richard Stallman (rms@mole.ai.mit.edu) * tex-mode.el (tex-print, tex-view): Run the command asynchronously. Eliminate tex-after-print-hook. Sun Nov 5 01:29:26 1989 Richard Stallman (rms@mole.ai.mit.edu) * tex-mode.el (tex-region): Delete tex output files directly, not with rm. Use tex-generate-junk-file-name to make tex-out-file. (tex-generate-junk-file-name): New function. (tex-strip-dots): New name for TeX-strip-dots. (tex-append): New name for tex-append-dvi. Suffix is now argument. (tex-view): New function. (tex-dvi-view-command): New variable. * files.el (make-auto-save-file-name): For non-file buffer, use Emacs pid and buffer name. Tue Oct 31 01:28:22 1989 Richard Stallman (rms@mole.ai.mit.edu) * files.el (hack-local-variables): save-excursion around the eval. Mon Oct 30 13:01:50 1989 Richard Stallman (rms@mole.ai.mit.edu) * tex-mode.el (tex-region): Replace `.' in host name with `-'. Eliminate extra / in arg when running TeX. (TeX-strip-dots): New subroutine. Sun Oct 29 14:07:04 1989 Richard Stallman (rms@mole.ai.mit.edu) * tex-mode.el (tex-region): Run TeX in dir the source file is in. Fri Oct 27 13:52:49 1989 Richard Stallman (rms@mole.ai.mit.edu) * tex-mode.el (tex-region): Use shell pid and host name in zap file. (TeX-expand-files): New fn, not yet used. * startup.el (command-line): Error if foo-win library not found. Thu Oct 26 10:04:49 1989 Joseph Arceneaux (jla@spiff) * dired.el (dired-first-filename): New function, move to first file found. (dired-noselect): Use it to position point@first file when entering dired. Wed Oct 25 16:07:25 1989 Richard Stallman (rms@mole.ai.mit.edu) * simple.el (count-lines, goto-lines): ^M is line sep for outline md. Tue Oct 24 18:52:56 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-make-in-reply-to-field): Avoid bare singlequote. Sat Oct 21 03:02:43 1989 Richard Stallman (rms@mole.ai.mit.edu) * replace.el (perform-replace): Always find null string@eob. Sat Oct 14 01:33:11 1989 Richard Stallman (rms@mole.ai.mit.edu) * startup.el (command-line-1): If > 2 files visited, do buffer-menu. * texinfo.el (texinfo-mode): Set words-include-escapes to t. * tex-mode.el (tex-start-shell): Run tex-shell-hook. Thu Oct 12 16:54:30 1989 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) * x-mouse.el (x-paste-text): push-mark before inserting text. (x-insert-selection): (x-select): Moved these functions over from the file: * mouse.el Thu Oct 12 02:37:18 1989 Richard Stallman (rms@mole.ai.mit.edu) * simple.el (kill-ring-save): New command for M-w. Shows other end of region momentarily. * register.el (jump-to-register): New name for register-to-point. Old name remains as alias. * simple.el (end-of-buffer): Scroll to put point near screen bottom. Wed Oct 11 17:22:29 1989 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) * compile.el (grep): Don't save buffers for grep. Tue Oct 10 15:06:45 1989 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) * files.el (recover-file): Prompt with current buffer's filename. Mon Oct 9 18:24:21 1989 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) * term/x-win.el (x-pop-up-window): If color screen, start out with some default colors. Sun Oct 8 19:00:06 1989 Richard Stallman (rms@mole.ai.mit.edu) * rnewspost.el (news-mail-reply, news-reply, news-post-news): Include newline before the blank line, when narrowing. Wed Oct 4 16:41:16 1989 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) * mouse.el (mouse-double-down, mouse-double-up): New functions for double-clicking. Tue Oct 3 12:38:45 1989 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) * x-mouse.el (x-insert-selecton, x-select): New functions: * mouse.el: New [experimental] functions: (mouse-motion, track-mouse, mouse-select-buffer-line) (mouse-boxing, mouse-erase-box, incr-scroll-down) (incr-scroll-up, incremental-scroll, incr-scroll-stop) (mouse-kill-rectangle, mouse-open-rectangle, mouse-multiple-insert) (mouse-move-text) Sun Oct 1 21:01:44 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmailout.el (rmail-output): Check for an RMAIL file, and get error. Sat Sep 30 18:11:41 1989 Robert J. Chassell (bob@rice-chex) * texnfo-upd.el (texinfo-copy-menu): Don't enter infinite loop when copying a multi-line description@the end of a menu. Thu Sep 28 13:55:19 1989 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) * mouse.el: New function mouse-line-length. New constants for mouse-motion keys. Wed Sep 27 09:49:06 1989 Richard Stallman (rms@mole.ai.mit.edu) * c-mode.el (calculate-c-indent): Don't treat function-name line as continuation, because its previous line's indent is zero. * sendmail.el (mail-do-fcc): No blank line before iff file is new. Mon Sep 25 16:21:51 1989 Robert J. Chassell (bob@apple-gunkies.ai.mit.edu) * renamed texinfo-update.el to texnfo-upd.el and updated `provide' * texinfo.el: updated `require' to reflect new name for texnfo-upd Sat Sep 23 14:38:26 1989 Robert J. Chassell (bob@rice-chex) * texinfo.el: Moved functions to update nodes and menus to texinfo-update.el. * texinfo.el, texinfo-update.el: Added `require' and `provide'. * texinfo.el: Added keybindings to insert frquently used @-commands. Added keybindings for `texinfo-format-buffer', `texinfo-update-node', `texinfo-every-node-update', `texinfo-make-menu', and `texinfo-all-menus-update'. * texinfo-update.el (texinfo-sequential-node-update): now updates node in which point is located so pointer are to next and previous node regardless of hierarchy. Non-nil argument (prefix, if interactive) means update nodes in region. (texinfo-every-node-update): updates every node in a Texinfo file. (texinfo-all-menus-update): updates all the regular menus in a Texinfo file. (texinfo-indent-menu-description, texinfo-menu-indent-description): Indent every description in menu following point to specified column. Non-nil argument (prefix, if interactive) means indent every description in every menu in the region. Does not indent second and subsequent lines of a multi-line description. (texinfo-insert-menu, texinfo-column-for-description): starts a menu description@column specified by variable `texinfo-column-for-description'. (texinfo-find-pointer, texinfo-insert-pointer): find and inserts higher level pointer as `Previous' pointer if there is no previous node@the same level. (texinfo-menu-copy-old-description): now copies `@' commands in old descriptions. Fri Sep 22 00:59:54 1989 Richard Stallman (rms@mole.ai.mit.edu) * simple.el (previous-complex-command): If not already inside repeat-complex-command, enter it. (repeat-complex-command): Bind repeat-complex-command-flat to t. * prolog.el (prolog-comment-indent): Don't insist on 1 space if@left margin. Thu Sep 21 23:32:15 1989 Richard Stallman (rms@mole.ai.mit.edu) * gdb.el (gdb-break): Go to line beg before counting lines. Thu Sep 21 11:08:30 1989 Joseph Arceneaux (jla@susie) * term/x-win.el: Added cursor-shape list, removed x-defined-colors stuff. Thu Sep 21 03:59:28 1989 Richard Stallman (rms@mole.ai.mit.edu) * simple.el (shell-command-on-region): If output is 1 line, display it in echo area. Tue Sep 19 16:33:38 1989 Richard Stallman (rms@mole.ai.mit.edu) * files.el (not-modified): With arg, mark buffer as modified. * c-mode.el (indent-c-exp): Support do-while. Mon Sep 18 02:32:36 1989 Richard Stallman (rms@mole.ai.mit.edu) * info.el (Info-mode, Info-edit-mode): Put on 'mode-class 'special. * c-mode.el (c-indent-line): Special for line starting in `while' to detect a do-while statement. (c-backward-to-start-of-do): New subroutine. Sun Sep 17 15:18:11 1989 Richard Stallman (rms@mole.ai.mit.edu) * cl.el (safe-idiv): Avoid overflow calculating sign of quotient. Sat Sep 16 01:52:08 1989 Richard Stallman (rms@mole.ai.mit.edu) * c-mode.el (calculate-c-indent): A line starting in `}' is not considered a continuation. * sendmail.el (sendmail-send-it): Don't let user specify `Sender'. Insert a `Sender' if From is specified and doesn't match login name. Fri Sep 15 11:53:47 1989 Joseph Arceneaux (jla@spiff) * term/x-win.el: Removed function x-color-screen-p (now in xfns.c). New variables x-colors, x-display-defined colors. Initialize them. Thu Sep 14 04:37:15 1989 Richard Stallman (rms@mole.ai.mit.edu) * startup.el (command-line): Rename local var for name of user to `init-file-user'. Advertise that for use in the init file. Mon Sep 11 20:22:43 1989 Robert J. Chassell (bob@apple-gunkies.ai.mit.edu) * texinfo.el (texinfo-update-node, texinfo-make-menu, texinfo-master-menu, texinfo-sequential-node-update): Added functions to insert or update the next, previous, and up node pointers in a Texinfo file, or alternatively to insert node pointers as a depth-first traversal---sequentially through the file, each pointing to the next node regardless of its hierarchical level, and to create or update a menu or menus (preserving pre-existing descriptions, if any), to create a master menu for a Texinfo file accordng to the Manual recommendation. Mon Sep 11 19:07:45 1989 Richard Stallman (rms@mole.ai.mit.edu) * sun-fns.c, term/sun.el: Rename prev-complex-command to select-previous... Sun Sep 10 15:56:09 1989 Joseph Arceneaux (jla@spiff) * files.el (find-file-noselect): Indicate if file is a soft link to some file already present. Thu Sep 7 00:47:37 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmailmsc.el (set-rmail-inbox-list): Doc fix. Fri Sep 1 18:39:30 1989 Richard Stallman (rms@mole.ai.mit.edu) * files.el (basic-save-buffer): On VMS, remove version number from visited file name before saving, and rename buffer. Thu Aug 31 16:19:47 1989 Joseph Arceneaux (jla@spiff) * term/Old/wyse.el: New terminal configuration file. Wed Aug 30 13:16:02 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el: `e' is now edit; only `x' for expunge. * term/x-win.el: Fix error message. * dired.el (dired-repeat-over-lines): FUNCTION returns t if it deleted the line. All callers changed to make it return nil. (dired-move-file, dired-create-directory): New functions. Tue Aug 29 16:41:34 1989 Joseph Arceneaux (jla@spiff) * files.el: * bytecomp.el: Call read-file-name instead of new-read-file-name, since the latter subr has been renamed the former. Wed Aug 23 23:32:25 1989 Richard Stallman (rms@apple-gunkies.ai.mit.edu) * startup.el (command-line-1): Update year in startup message. Wed Aug 23 17:47:47 1989 Joseph Arceneaux (jla@spiff) * term/x-win.el: Open the X connection when this file is loaded; don't wait for pop-up-window. Tue Aug 22 16:08:31 1989 Joseph Arceneaux (jla@spiff) * term/x-win.el: Changed the documentation of `x-switches'. Mon Aug 21 17:21:16 1989 Joseph Arceneaux (jla@spiff) * term/x-win.el: Rewrote the code for handling command line args, including x-handle-switch. Sat Aug 19 16:44:57 1989 Joseph Arceneaux (jla@spiff) * term/x-win.el: Changed iconic type option string from "-i" to "-ib". Also normalized the options to the X toolkit standard. Tue Aug 15 13:32:23 1989 Richard Stallman (rms@hobbes.ai.mit.edu) * files.el (basic-save-buffer): For precious file, don't delete renamed old version if rename failed. * files.el (backup-buffer): Don't delete old backup, since rename-file should do it. * c-mode.el (electric-c-terminator): Recognize labels with _ or $. Tue Aug 15 10:52:19 1989 Joseph Arceneaux (jla@spiff) * replace.el (occur): Optionally search whole buffer, controlled by new variable occur-whole-buffer. Tue Aug 15 09:21:56 1989 Roland McGrath (roland@apple-gunkies.ai.mit.edu) * add-log.el (prompt-for-change-log-name): New macro to prompt for a change log file name. (add-change-log-entry): Use it. (add-change-log-entry-other-window): Take an arg, the file name of the change log. If interactive: if given a prefix arg, prompt for the file name; if use default-directory. Mon Aug 14 22:04:04 1989 Richard Stallman (rms@hobbes.ai.mit.edu) * man.el (nuke-nroff-bs): Assume footers are what precede headers. Delete fixed number of lines around each header, so that significant blank lines next to these are preserved. Sun Aug 13 17:39:40 1989 Richard Stallman (rms@hobbes.ai.mit.edu) * c-mode.el (indent-c-exp): Remove indentation from blank lines. When trying to move up to init contain-stack, don't go past start of function. If no containing open is found thus, set opoint to prev. function-start, so calculate-c-indent wins. Sat Aug 12 13:24:13 1989 Richard Stallman (rms@hobbes.ai.mit.edu) * rmailsum.el (rmail-new-summary): Use other-window-scroll-buffer to make scroll commands do the right thing. Make it local. Fri Aug 11 14:27:43 1989 Richard Stallman (rms@hobbes.ai.mit.edu) * telnet.el (telnet-filter): Don't move point if was not@end. Eliminate ^M entirely. * tex-mode.el (tex-mode-syntax-table): Give \ the syntax code /. Sun Aug 6 17:14:17 1989 Richard Stallman (rms@mole.ai.mit.edu) * sendmail.el (mail-text): New command, on C-c C-t. Sat Aug 5 16:19:51 1989 Richard Stallman (rms@mole.ai.mit.edu) * rnewspost.el (news-setup): ACTIONS arg to mail-setup was missing. Fri Aug 4 23:56:44 1989 Richard Stallman (rms@mole.ai.mit.edu) * hideif.el (hif-factor): Typo in error message. Thu Aug 3 23:43:01 1989 Richard Stallman (rms@mole.ai.mit.edu) * sort.el, loaddefs.el: Doc fixed. Wed Aug 2 19:22:06 1989 Richard Stallman (rms@mole) * cl.el (floor): Fix bug in last cond clause, (floor -10 2). * backquote.el (`): Upgrade doc string. Mon Jul 31 01:55:11 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail): If existing buffer is empty, treat it as new. * abbrev.el (expand-region-abbrevs): Mention abbrev when querying. Test for abbrev definition without modifying buffer. No need to compare start with end, since (interactive "r") does it. Arrange for prefix arg as NOQUERY arg. (add-abbrev): Prompt differently if undefining an abbrev. (write-abbrev-file): Better default file name. (read-abbrev-file, quietly-read-abbrev-file): Make FILE arg optional. Tue Jul 25 19:47:39 1989 Joseph Arceneaux (jla@spiff) * files.el (write-file): If no file is associated with the current buffer, prompt with the buffer name. Thu Jul 20 02:26:35 1989 Richard Stallman (rms@mole.ai.mit.edu) * info.el (Info-follow-reference): Handle newline and indentation immediately after *note. Wed Jul 19 11:35:55 1989 Joseph Arceneaux (jla@spiff) * keypad.el: Removed unused symbols, changed commentary. * term/x-win.el: Added mapping from emacs key symbols to strings used by X. (x-keypad-setup): Provide use of the function and keypad keys, using the standard keyboard files of /term/* * term/news.el: New file for the Sony keyboard. This now works with both keypad.el and x-win.el. The other terminal files are obsolete. Fri Jul 14 11:23:15 1989 Joseph Arceneaux (jla@spiff) * gdb.el (gdb): Use "interactive f" instead of "F". Thu Jul 13 10:20:27 1989 Joseph Arceneaux (jla@spiff) * outline.el (outline-flag-region): Don't pass optional last arg `t' to subst-char-in-region. Wed Jul 12 12:08:07 1989 Joseph Arceneaux (jla@spiff) * lisp.el (insert-parentheses) Changed conditions for pre- and post- insertion of blanks. * bytecomp.el (byte-compile-file): If current buffer is in emacs-lisp mode, prompt with buffer's file name as default. Fri Jul 7 08:16:03 1989 Joseph Arceneaux (jla@spiff) * files.el (basic-save-buffer) When querying for a final newline, use y-or-n-p instead of yes-or-no-p. Thu Jul 6 10:59:21 1989 Joseph Arceneaux (jla@galapas.ai.mit.edu) * files.el: (find-alternate-file): Use new function new-read-file-name. This name is temporary. Also don't substitute `~' for homedir; new-read-file-name does this. Tue Jul 4 20:23:32 1989 Richard Stallman (rms@mole.ai.mit.edu) * mailalias.el (build-mail-aliases): Accept `group' as synonym. * nroff-mode.el (electric-nroff-mode): Arg now optional. * man.el (insert-man-file): Handle HP's directories with .Z in their names. Tue Jun 27 16:10:03 1989 Joseph Arceneaux (jla@mole.ai.mit.edu) * term/x-win.el (x-new-window) New function. Sun Jun 25 12:45:05 1989 Richard Stallman (rms@mole.ai.mit.edu) * ledit.el (ledit-zap-file, etc.): Use user-login-name. * medit.el (medit-zap-file): Likewise. * subr.el (user-original-login-name): New function. * rmail.el (rmail, rmail-insert-inbox-text): Use that. * mail-utils.el (rmail-dont-reply-to): Use that. Sat Jun 24 23:24:41 1989 Richard Stallman (rms@mole.ai.mit.edu) * compile.el: Doc fix. Fri Jun 23 17:00:12 1989 Joseph Arceneaux (jla@all-bran.ai.mit.edu) * term/x-win.el (x-pop-up-window) Run hook x-pop-up-window-hook. (x-color-screen-p) New macro; used to be C function. Thu Jun 22 12:57:54 1989 Richard Stallman (rms@mole.ai.mit.edu) * time.el (add-clock-handler): Call specified function each minute. * loaddefs.el: Autoload it. * subr.el: Doc fix. Thu Jun 22 11:11:06 1989 Joseph Arceneaux (jla@gracilis.ai.mit.edu) * rmail.el: Fixed missing declares of rmail-inbox-list and rmail-keywords. * sendmail.el: Fixed missing declares of mail-reply-buffer and mail-send-actions. Wed Jun 21 12:17:27 1989 Richard Stallman (rms@mole.ai.mit.edu) * sendmail.el (mail-recover): New command. Tue Jun 20 13:58:03 1989 Richard Stallman (rms@mole.ai.mit.edu) * sendmail.el (mail-signature): Delete excess blank lines; put one blank line and one line of `--' before signature. * sort.el (sort-subr): Make sure markers@end of text stay at the end. (calls to sort-subr): Put save-excursion around save-restriction. Now all these commands preserve region around sorted text. Mon Jun 19 19:59:23 1989 Richard Stallman (rms@mole.ai.mit.edu) * rnewspost.el (news-reply-yank-original): Break out insertion of header line into a hook, news-reply-header-hook. Recommended by Barry Warsaw. Mon Jun 19 18:31:40 1989 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) * files.el (find-alternate-file): Check that file is non nil. Sun Jun 18 12:19:14 1989 Richard Stallman (rms@mole.ai.mit.edu) * sendmail.el (mail-mode): Make mail-signature-inserted local. (mail-setup): Set it to nil. (mail-signature): Set it to t. (mail-mode-map): Don't put that on a key. (mail-send): Call mail-signature if .signature exists and not already done. * texinfmt.el (texinfo-format-node): Add properly to texinfo-node-names. Fri Jun 16 15:57:44 1989 Richard Stallman (rms@mole.ai.mit.edu) * texinfmt.el: Doc fix. Thu Jun 15 17:12:32 1989 Richard Stallman (rms@mole.ai.mit.edu) * c-mode.el (electric-c-terminator, c-indent-line): (calculate-c-indent, indent-c-exp): Recognize `case' more generally. * c-mode.el (c-indent-command): With arg, find a sexp split over lines. * c-mode.el (indent-c-exp): Typo in local name innerloop-done. Declare last-depth. Use OPOINT by default as arg to calculate-c-indent. * lisp-mode.el (indent-sexp): Likewise. * dired.el (dired-readin): Detect non-existent directories. Thu Jun 8 16:31:41 1989 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) * term/x-win.el (new-screen): Added this function, which is the default auto-screen function. It uses new variables new-screen-x-delta and new-screen-y-delta. (next-multiscreen-window, previous-multiscreen-window): These new functions step through all windows, jumping screens when they need to.x Thu Jun 8 12:08:28 1989 Richard Stallman (rms@mole.ai.mit.edu) * spell.el (spell-region): Downcase misspelled word. Tue Jun 6 19:58:01 1989 Richard Stallman (rms@mole.ai.mit.edu) * chistory.el (list-command-history): Go to history buffer before examining its text. * subr.el (suppress-keymap): Store using define-key so that sparse keymaps work. Sun Jun 4 14:17:27 1989 Richard Stallman (rms@mole.ai.mit.edu) * time.el (display-time-filter): Preserve the match data. Fri Jun 2 16:04:14 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-convert-to-babyl-format): Generalize time zone fmt. (rmail-nuke-pinhead-header): Likewise. * cmacexp.el (c-macro-expand): Terminate string or comment after last macro in the file. * bib-mode.el: New file. * sendmail.el (mail-mode-syntax-table): Seperate syntax table for mail mode. Makes % a separator. Wed May 31 18:05:20 1989 Richard Stallman (rms@mole.ai.mit.edu) * cmacexp.el (c-macro-expand): Handle \-continuation of macros. * fill.el (fill-region-as-paragraph): Don't leave space@end of line. Tue May 30 14:33:09 1989 Richard Stallman (rms@mole.ai.mit.edu) * replace.el (perform-replace): Fix typo. * shell.el (make-shell): Don't call shell-mode if already in that mode. * compile.el (next-error): Widen if necessary. Sat May 27 00:24:01 1989 Richard Stallman (rms@mole.ai.mit.edu) * hexl.el: New file. Thu May 25 15:22:30 1989 Richard Stallman (rms@mole.ai.mit.edu) * c-mode.el (c-indent-region): Make marker before indenting first line. (indent-c-exp): Find preceding open paren or open brace to initialize contain-stack, if have endpos. Don't treat next-depth = 0 as special if have endpos. Don't use next-depth as exit criterion if have endpos. Wed May 24 00:27:45 1989 Richard Stallman (rms@mole.ai.mit.edu) * simple.el (do-auto-fill): Keep splitting until short line or give up. Tue May 23 16:13:10 1989 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) * rmailsum.el: Added C-d (rmail-summarey-delete-backward) to rmail-summary-mode-map. Mon May 22 13:44:00 1989 Richard Stallman (rms@mole.ai.mit.edu) * dired.el (dired-chown): Put file name in a variable. Sun May 21 00:55:50 1989 Richard Stallman (rms@mole.ai.mit.edu) * compile.el (compile-command): Add SPC@end of value. * simple.el (shell-command): If COMMAND ends in &, do it asynch. * apropos.el (apropos-match-keys): Ignore atoms in an alist. Ignore menu prompts in key bindings. * cl.el (defsetf): Put quotes into expansion where needed. * apropos.el (apropos): Call apropos-internal to get list of syms. * cl.el (isqrt): More accurate termination condition. Fewer special cases needed. * sendmail.el (mail-send): Ignore errors in mail-send-actions. Sat May 20 15:43:28 1989 Richard Stallman (rms@mole.ai.mit.edu) * simple.el (insert-buffer): Default to (other-buffer). Thu May 18 16:33:08 1989 Richard Stallman (rms@mole.ai.mit.edu) * isearch.el (isearch): Bug in previous change: was assuming regexp. Wed May 17 17:19:43 1989 Kyle Jones (kjones@talos.uucp) * saveconf.el: Changed copying permissions and warranty disclaimer to those of the GNU General Public License * saveconf.el: Added usage instructions at the top of file. * saveconf.el (recover-context): Returns t if recover succeeds. Wed May 17 13:21:49 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-nuke-pinhead-header): Accept space before numeric time zone in From line. * sendmail.el (mail): Use multiple mail buffers. Reuse an unmodified one or make a new one. With arg, find a modified one. If have auto-save file, suggest M-x recover. * rmailout.el (rmail-output-to-rmail-file): Adjust narrowing@call to rmail-count-new-messages, for changes therein. Tue May 16 11:56:19 1989 Chris Hanson (cph@kleph) * scheme.el: change syntax table entries to use new "p" bit. Mon May 15 10:32:29 1989 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) * tags.el (next-file): fixed typo: " *next-file*" --> "*next-file*" Sun May 14 20:12:50 1989 Richard Stallman (rms@mole.ai.mit.edu) * files.el (set-visited-file-name): Don't rename autosave file. This avoids losing it when you do C-x C-w. Sat May 13 14:12:23 1989 Richard Stallman (rms@mole.ai.mit.edu) * chistory.el (command-history-map): Share with shared-lisp-mode-map. Fri May 12 18:12:03 1989 Richard Stallman (rms@mole.ai.mit.edu) * debug.el (debug): Use search to find extraneous part of backtrace. Works even interpreted. (debug-convert-byte-code): New function: convert byte-code object to a lambda-exp. (debug-on-entry, debugger-reenable): Call that function. * rmail.el (rmail-set-message-counters-counter): Change in search caused pointers to wrong place in message. * c-mode.el (c-indent-region): Pass marker to indent-c-exp. * lisp-mode.el (lisp-indent-region): Likewise. Fri May 12 10:40:04 1989 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) * term/x-win.el (x-set-display-name): Now works; correctly gets display name and removes those options from `command-line-args-left'. Renamed some of the options to be consistent with standard X applications. Added "-iconic" option for iconic startup; created variable `x-iconic-startup' and function `x-set-iconic-startup' (x-pop-up-window): initialize x-display-name first, then call x-open-connection. Thu May 11 00:27:43 1989 Richard Stallman (rms@mole.ai.mit.edu) * loaddefs.el (completion-ignored-extensions): Add .sbin. * c-mode.el (c-fill-paragraph): Recognize first line of comment. Move to second line to get fill prefix. On one-line comment, pick reasonable prefix. Don't strand comment ender on separate line. Wed May 10 19:02:26 1989 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) * term/x-win.el (x-handle-numeric-switch) Just like x-handle-switch, but converts argument to int (e.g., "-b 4"). Wed May 10 16:33:08 1989 Richard Stallman (rms@mole.ai.mit.edu) * man.el (manual-entry): Make buffer read only. Mon May 8 18:28:59 1989 Richard Stallman (rms@mole.ai.mit.edu) * startup.el (command-line-1): Split paragraph in startup message. * simple.el (append-next-kill): Print a message. * startup.el (command-line-1): Except for first file, find in other window. * isearch.el (isearch): Don't move cursor for c-w, c-y in reverse. Allow longer match@point in non-regexp reverse search as in regexp. * startup.el (command-line): Give details on error in init file. * fill.el (fill-region-as-paragraph): Insert NL before delete space. Mon May 8 18:26:01 1989 Joseph Arceneaux (jla@rice-chex.ai.mit.edu) * x-mouse.el (x-cut-text): sit-for 1 when warping mouse to mark. Also removed code dupicated by mouse.el (x-trace-mouse): debugging function which prints out mouse events as they arrive. (x-paste-text): Don't set point before inserting cut text; too confusing and incompatible with xterm. * mouse.el (mouse-scroll, mouse-del-char, mouse-kill-line, narrow-window-to-region, mouse-window-to-region): Added these new functions. Mon May 8 18:10:13 1989 Richard Stallman (rms@mole.ai.mit.edu) * info.el (Info-find-node): Fix confusion testing file existence. * files.el (basic-save-buffer): Mention file name in "save anyway". Mon May 8 16:18:13 1989 Richard Stallman (rms@mole.ai.mit.edu) * lisp-mode.el (lisp-indent-line, lisp-comment-indent): Use \\s< to recognize comment-start characters. (indent-sexp): likewise. * lisp.el (end-of-defun): likewise. Sun May 7 15:12:01 1989 Richard Stallman (rms@mole.ai.mit.edu) * underline.el (ununderline-region): Handle pre- or -post underline. * rmail.el (rmail-search): Fix failure message. * paths.el (Info-directory-list): Replaces Info-directory. * info.el (Info-find-node): Search that directory list. * c-mode.el (electric-c-sharp-sign): Auto-align #@column 0. * rmail.el (rmail-parse-file-inboxes, rmail-get-new-mail): Require newline before ^_ when searching. More reliable. (rmail-count-new-messages, rmail-set-message-counters): Likewise. (rmail-set-message-counters-counter): Likewise. * rmailout.el (rmail-output-to-rmail-file): Likewise. * info.el (info-follow-reference): Provide default: ref point is in. * page.el (what-page): Reckon from beginning of line. * blackbox.el: Doc fix. (bb-done): Improve messages. * replace.el (perform-replace): Keep stack of previous pos for ^. * info.el: Doc fix. * simple.el: Doc fix. Fri May 5 14:55:55 1989 Richard Stallman (rms@mole.ai.mit.edu) * view.el (view-mode): Save and set major-mode like mode-name. (view-exit): Restore it. (view-helpful-message): Update for new exit command. * tags.el (tags-loop-continue): Just set-buffer if not permanent. * tags.el (visit-tags-table-buffer): Clean up if file invalid. * apropos.el: New file. Apropos now defined here. * loaddefs.el: Autoload it. * help.el: Doc fix. * sort.el: Doc fix. * bytecomp.el (byte-compile-lambda): Return a byte-code object. (byte-compile-file-form): Return an fset form which constructs such a byte-code object and installs it. (byte-compile-defun, byte-compile-macro): Likewise. (byte-compile-function-form): Translate to a make-byte-code form. (byte-compile-file): Find and fix doc strings in fset forms. * loaddefs.el (completion-ignored-extensions): Add .fmt. Thu May 4 02:02:08 1989 Richard Stallman (rms@mole.ai.mit.edu) * blackbox.el (bb-init-board): Use (random 8) to get # in [0,7]. * dissociate.el: Likewise. * fill.el (justify-current-line): Likewise. * flame.el (define-element, psychoanalize-flamer): Likewise. * yow.el (yow): Likewise. * doctor.el: Use (random N), not (random-range N). (random-range): Function deleted. * simple.el (auto-fill-mode): Arg now optional. Mon May 1 14:25:30 1989 Richard Stallman (rms@mole.ai.mit.edu) * cl.el (cl-member): New name for Common Lisp `member'. Sun Apr 30 17:07:16 1989 Richard Stallman (rms@mole.ai.mit.edu) * cmacexp.el (c-macro-expand): Use a second temp file for the region. * tags.el (tags-loop-continue): Widen the buffers. Sat Apr 29 14:31:22 1989 Richard Stallman (rms@mole.ai.mit.edu) * cl.el (defsetf): Take effect@run time, not expansion time. * bytecomp.el (byte-compile-file-form): Expand top level macros. Look inside of progn. Thu Apr 27 15:36:12 1989 Richard Stallman (rms@mole.ai.mit.edu) * replace.el (map-query-replace-regexp): New function. * replace.el (perform-replace): Allow list of strings to replace with; they are used in rotation. Optional arg repeat-count is number of times to use each string before rotating. Wed Apr 26 22:35:31 1989 Richard Stallman (rms@mole.ai.mit.edu) * sendmail.el (mail-yank-original): Handle new var mail-yank-prefix. Tue Apr 25 20:30:23 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-output-to-rmail-file): If output buffer is not in rmail mode, insert@end of it. * rmail.el (rmail-set-attribute): search-forward's value is no longer t or nil; now may be a number. Mon Apr 24 14:31:37 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail): Put existing buffer into rmail-mode if necessary. Thu Apr 20 00:30:42 1989 Richard Stallman (rms@mole.ai.mit.edu) * x-mouse.el: Delete mouse-event-hook; now in keyboard.c. * term/x-win.el (x-switch-definitions, command-switch-alist): Add -bd. (x-set-*): New commands. * startup.el (command-line-1, normal-top-level): Call hooks with run-hooks. * sun-mouse.el: likewise. * mim-mode.el: rename indent-mim-hook to indent-mim-function. * scheme.el: likewise scheme-indent-hook. * lisp-mode.el, cl.el, cl-indent.el, loaddefs.el, sun-mouse.el: *lisp-indent-hook renamed to *lisp-indent-function. * kermit.el (shell-send-input-cr): use run-hooks. * shell.el (shell-send-input): run-hooks wants quoted arg. * simple.el, mlsupport.el, loaddefs.el, c-fill.el, doctor.el: blink-paren-hook and auto-fill-hook renamed to -function. * files.el (diff-switches-function): diff-switches-hook renamed. * compile.el (compile-reinitialize-errors): use run-hooks. * rmail.el (rmail-convert-to-babyl-format): error if unrecognized text. Wed Apr 19 23:41:39 1989 Richard Stallman (rms@mole.ai.mit.edu) * replace.el (occur-mode-goto-occurrence): Insure arg to count-lines is@start of line. * replace.el (occur): Removed an extraneous save-excursion. * replace.el (perform-replace): make ! undo as a unit. Mon Apr 17 23:38:31 1989 Chris Smith (csmith@mozart) * icon-mode.el (icon-comment-indent): When auto-fill breaks a line in a bol comment, start the continued line in column 1 not column 2. * icon-mode.el (icon-backward-to-noncomment): use parse-partial-sexp so as not to be fooled by # in strings. * icon-mode.el (icon-is-continuation-line): distinguish between tokens that end a statement but cause the following statement to be indented and tokens that cause the following line to be a continuation of the same statement. Wed Apr 12 10:45:30 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-message-labels-p): put save-excursion outside. * picture.el (picture-tab): Dumb errors in prefix-arg case. * tags.el (tags-loop-continue): No message if slow terminal. * c-mode.el (c-fill-paragraph): Don't fill a comment together with anything following it. Tue Apr 11 01:04:53 1989 Richard Stallman (rms@mole.ai.mit.edu) * lpr.el (print-region-1): For tab-conversion case, insert specd range. Fri Apr 7 00:01:53 1989 Richard Stallman (rms@mole.ai.mit.edu) * compile.el (compilation-mode): Doc fix. * loaddefs.el: Autoload ftp-list-directory. Thu Apr 6 22:00:26 1989 Edward M. Reingold (reingold@cs.uiuc.edu) * Hook added to list-diary-entries, along with a possible value for that hook which prepares a fancy diary buffer for display. * Holidays integrated into the diary: in the ordinary diary buffer the holidays are given in the mode line. In the fancy diary buffer the holidays are given in the heading for each date. * Added a new command to tell the holidays on a specific date, parallel to the way diary entries are given for a specific date. This new command became `h' and the old `h' became `a' to show all the holidays in a three-month period. Thu Apr 6 12:27:21 1989 Richard Stallman (rms@mole.ai.mit.edu) * dired.el (dired-flag-backup-files, dired-flag-auto-save-files): With prefix arg, unflag the appropriate class of files. * info.el (Info-tag-table-marker): `read' now stops@end of line, so advance to next line. * info.el (Info-follow-nearest-node):@last line of text, move to next node. * rmail.el (rmail-message-labels-p): Widen. * term/iris-ansi.el: New file. * r2bibtex.el: New file. * files.el (rename-uniquely): New command. * bytecomp.el (byte-recompile-directory): Update mode lines after save-some-buffers. * buff-menu.el (Buffer-menu-visit-tags-table): New fn. (Buffer-menu-mode-map): `t' runs that. * rmail.el (rmail-delete-forward): If no nondeleted msg fwd, go bkwd. * rmail.el (rmail-convert-to-babyl-format, rmail-nuke-pinhead-header): Accept spaces@end of Unix-style From line. * view.el (view-mode): Don't use a recursive edit; instead, save old mode info in local variables. Now two args: buffer to go back to, and fn to apply to viewed buffer when exiting. (view-exit): Restore old mode from those local variables. Apply specified fn to buffer that was viewed. This is on C-c and q. (view-command-loop): Deleted. (view-window-size): Now applies to selected window. * startup.el (normal-top-level): Use PWD envvar to set default dir. * rmail.el (rmail-convert-to-babyl-format): Bind case-fold-search to t for mmdf case. Mon Apr 3 23:33:04 1989 Richard Stallman (rms@mole.ai.mit.edu) * modula2.el: Turn m2-newline back on. (various templates): Put relevant variable name in final comment. Sun Apr 2 00:24:51 1989 Richard Stallman (rms@mole.ai.mit.edu) * paths.el (rmail-spool-directory): Treat silicon-graphics-unix like usg. Thu Mar 30 16:00:29 1989 Richard Stallman (rms@mole.ai.mit.edu) * files.el: doc fix. * autoinsert.el (insert-auto-insert-files): Mark bfr unmodified if has just the autoinsert file. * sendmail.el: doc fix. Wed Mar 29 09:58:39 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-insert-inbox-text): Don't insert newline if inserted an empty file. * startup.el: doc fix. Wed Mar 29 09:54:28 1989 Edward M. Reingold (reingold@cs.uiuc.edu) * calendar.el: Change shift-three-month functions so the name includes the word ``calendar''. * calendar.el (list-diary-entries): Delete extraneous command to indicate buffer is not modified. Wed Mar 15 23:20:25 1989 Jeff Peck (rms@mole.ai.mit.edu) * term/sun.el (sunview-terminal): New default keybindings Check for (getenv "IN_EMACSTOOL") to automatically do emacstool-init. Fri Feb 24 15:39:17 1989 Richard Mlynarik (mly@rice-chex.ai.mit.edu) * terminal.el (terminal-emulator): Move help message after call-hooks so that correct escape character is mentioned. Thu Feb 23 17:35:44 1989 Richard Stallman (rms@mole.ai.mit.edu) * Version 18.53 released(?) * telnet.el: New vars telnet-initial-count and telnet-maximum-count. These replace constants in the code. (telnet, telnet-initial-filter): Use those vars. (telnet-filter): Use subst-char-in-region to change CR to Space. Advance point if insert@end of bfr. Tue Feb 21 08:06:07 1989 Richard Stallman (rms@mole.ai.mit.edu) * flame.el: Fix spelling errors. * compile.el (compile-reinitialize-errors): New subroutine broken out from next-error. (compile-goto-error): New command, uses that and next-error. (compilation-mode): New command; sets major mode. (compile-internal): Use that function. (compilation-mode-map): New variable; define C-c C-c. Mon Feb 20 09:18:37 1989 Richard Stallman (rms@mole.ai.mit.edu) * lisp-mode.el (indent-sexp): Optional arg says where to stop indenting; if spec', don't stop@end of first sexp. (lisp-indent-region): New fn: use that to do Lisp-style indent-region. (lisp-mode-variables): Set up indent-region-function as that. * c-mode.el (indent-c-exp, c-indent-region, c-mode): Similar changes. Sun Feb 19 06:46:52 1989 Richard Stallman (rms@apple-gunkies.ai.mit.edu) * files.el (set-visited-file-name): Always rename the buffer; make name unique with as find-file does. * compile.el (next-error): Prefix arg now says how many errors to move. When parsing more errors incrementally, append to previous list. (compile): Handle new option `compile-window-height'. Sat Feb 18 06:16:21 1989 Richard Stallman (rms@mole.ai.mit.edu) * dbx.el (dbx-mode-map): Change C-c w to C-c C-w. * misc.el: New file. Fri Feb 17 02:17:19 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmailout.el (rmail-output*): Handle prefix arg and output consecutive nondeleted messages. * rmail.el (rmail-next-undeleted-message): Error if hit eob. * dbx.el (run-dbx): Do expand-file-name. * paths.el (manual-formatted-dirlist): More alternatives in sysV case. Wed Feb 15 03:55:23 1989 Richard Stallman (rms@mole.ai.mit.edu) * dbx.el (run-dbx): Set dbx-process. (dbx-stop-at): Use that to decide where to send the string. Mon Feb 13 09:33:58 1989 Marc Shapiro (shapiro@sor.inria.fr) * bibtex.el (bibtex-clean-entry, bibtex-empty-field, bibtex-find-text, bibtex-kill-optional-field, bibtex-next-field, bibtex-pop-next, bibtex-pop-previous, bibtex-cfield, bibtex-enclosing-field, bibtex-enclosing-reference, bibtex-enclosing-regexp, bibtex-flash-entry bibtex-flash-head, bibtex-inside-field, bibtex-make-optional-entry, bibtex-remove-OPT): New functions. (bibtex-find-it, bibtex-make-OPT-entry, bibtex-next-position): Deleted (kill-current-line): Deleted. (bibtex-mode-map): C-c keys to make entries moved to C-c C-e. (general): Use regexps instead of simple-minded cursor motion. New keys include C-c C-p, C-c C-n, C-c C-k, C-c C-d, C-c C-c, TAB, LF. Mon Feb 13 02:53:08 1989 Richard Stallman (rms@mole.ai.mit.edu) * subr.el (suppress-keymap): Undefine chars iff self-inserting, not based on numeric range. * rmail.el (rmail-reply): Don't call rmail-retry-failure. (rmail-mode-map): Put that cmd on C-M-m. Sat Feb 11 04:14:24 1989 Richard Stallman (rms@mole.ai.mit.edu) * debug.el (debug-on-entry): Special err msg for functions we can't handle. Fri Feb 10 05:11:30 1989 Richard Stallman (rms@mole.ai.mit.edu) * files.el (list-directory-brief-switches): Value was garbled when VMS changes were installed. Thu Feb 9 02:38:10 1989 Richard Stallman (rms@mole.ai.mit.edu) * loaddefs.el (calendar, diary, holidays): Autoload from calendar.el. Wed Feb 8 01:41:01 1989 Richard Stallman (rms@mole.ai.mit.edu) * loaddefs.el (ctl-x-4-map): Fully define it here, as sparse keymap. * files.el: not here. * lisp-mode.el (lisp-interaction-mode): Use emacs-lisp-mode-syntax-table Tue Feb 7 16:05:51 1989 Richard Stallman (rms@mole.ai.mit.edu) * c-style.el (set-c-style): Delete extra closeparen@end. * tex-mode.el: Doc fixes. Sun Feb 5 00:16:45 1989 Richard Stallman (rms@mole.ai.mit.edu) * uncompress.el (uncompress-backup-file): Uncompress original file when it's time to make it unto a backup. Sat Feb 4 00:42:58 1989 Richard Stallman (rms@mole.ai.mit.edu) * files.el: Make certain variables permenant if they are local. * ftp.el: Likewise. * dired.el (dired-rename-file): If file is visited, offer to change visited file name. * tags.el (find-tag, find-tag-other-window, find-tag-regexp): Bugs in interactive arg reading. * dired.el (dired-do-deletion): If list is small enough, display in half the screen. * files.el (basic-save-buffer): Check writability and make backup file only after trying the hooks. * ftp.el (ftp-write-file): do save-excursion. (ftp-write-file-hook): Clear modified-flag here. (ftp-setup-write-file-hooks): Clear read-only flag here. (ftp-sentinal): If input, clear modified flag. Don't bind buffer-read-only across (kill-buffer (current-buffer)). * texinfmt.el (texinfo-format-sp): New fn; handle @sp. (texinfo-format-noop): Handle @titlefont with this. Fri Feb 3 18:51:42 1989 Richard Stallman (rms@mole.ai.mit.edu) * files.el (revert-buffer): New hook that replaces just the erase-buffer and the insert-file-contents. Mon Jan 30 16:47:50 1989 Richard Stallman (rms@mole.ai.mit.edu) * term/x-win.el (initialization): Go through x-switches list. Don't set window-system-version; C code now does this. Sun Jan 29 01:20:57 1989 Richard Stallman (rms@mole.ai.mit.edu) * undigest.el (undigestify-message): Allow submessage to have no `to', just a `from'. Sat Jan 28 03:41:45 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-reply): Search from msg-beg for rejection indicator Thu Jan 26 13:31:28 1989 Richard Stallman (rms@mole.ai.mit.edu) * replace.el (occur-mode-goto-occurrence): error msg fix. * tex-mode.el (tex-mode-syntax-table): Initialize all elts afresh. (tex-common-initialization): Make local var compare-windows-whitespace. Make %-lines separate paragraphs. (latex-mode): No more need to override paragraphs. (tex-categorize-whitespace): New fn helps compare-windows. (tex-insert-quote): Use \\s when categorizing prev. char. * compare-w.el: provide 'compare-w. (compare-windows): Don't set success for just whitespace. Remember start-point in both buffers, and pass as arg to the whitespace-function. If whitespace regexp, back over all whitespace; but don't back up if@end of buffer. Set point for real after each bunch of matches, in case C-g. Wed Jan 25 02:47:35 1989 Richard Stallman (rms@mole.ai.mit.edu) * paragraph.el (forward-paragraph): Check for end-of-buffer in forward-loop within backward-loop. * window.el (split-window-vertically): Set window-start and maybe window-point, to avoid scrolling. Tue Jan 24 01:58:08 1989 Richard Stallman (rms@mole.ai.mit.edu) * window.el (balance-windows): New command. * subr.el (walk-windows): New function. Fri Jan 20 13:08:05 1989 Richard Stallman (rms@mole.ai.mit.edu) * sort.el: doc fix. * server.el (server-buffer-clients): Now a permanent local. * dabbrev.el (dabbrev-expand): case-adapt only if expansion is l.c. (dabbrev-search): downcase the result if found@beg of sentence and only initial is upper case. Thu Jan 19 19:33:31 1989 Richard Stallman (rms@mole.ai.mit.edu) * files.el (after-find-file): change calling sequence to sit-for. * bytecomp.el (byte-compile-defun,-defmacro): Compile `defun' and `defmacro' within functions. Wed Jan 18 14:32:36 1989 Richard Stallman (rms@mole.ai.mit.edu) * tex-mode.el: Many changes. TeX changed to tex in all symbols. (tex-open-quote, tex-close-quote): New vars for tex-insert-quote. (tex-insert-quote): Those vars say what to insert. Inserting `"' is done by simply calling self-insert-command. (tex-last-buffer-texed, tex-print-file): New vars. (tex-region): Don't output line before start of header. Set those two variables. (tex-mode-map): C-c C-e and C-c C-f changed. (tex-common-initialization): comment-start-skip changed. (tex-validate-region): Fn renamed, and now leaves point@the error. (tex-terminate-paragraph): must save-excursion. (tex-start-shell):@end, sleep a little if I/O buffer is empty. (tex-file): New fn; save buffers and run TeX on visit file. (tex-print): Print buffer's most recent output, whether from tex-file or tex-region. Use shell-command to do the printing. (tex-append-dvi): New subroutine. * compare-w.el (compare-windows): Prefix arg means ignore whitespace changes. * bytecomp.el (byte-compile-form, byte-compile-find-vars-1): Handle forms containing explicit lambda-functions. Tue Jan 17 16:53:03 1989 Richard Stallman (rms@mole.ai.mit.edu) * texinfmt.el: Define @s (small caps) like @var. Sun Jan 15 14:13:17 1989 Richard Stallman (rms@mole.ai.mit.edu) * shell.el (inferior-lisp-mode-map): Copy shared-lisp-mode-map, inherit from shell-mode-map. * files.el (find-alternate-file): Don't drop a necessary `/'. Sat Jan 14 23:03:24 1989 Richard Stallman (rms@mole.ai.mit.edu) * startup.el (normal-top-level): Abbrev default directory as in find-file-noselect. * lisp-mode.el (lisp-mode-variables): set parse-sexp-ignore-comments. Fri Jan 13 02:21:02 1989 Richard Stallman (rms@mole.ai.mit.edu) * files.el (find-alternate-file): Don't change prefix to `~' unless a slash follows. * lisp.el (insert-parentheses): skip leading spaces if arg, maybe insert one if no arg. * lisp-mode.el (shared-lisp-mode-map): New map contains shared keys. (*-mode-map): All inherit from that map. * text-mode.el (indented-text-mode-map): Inherit text-mode-map. * rmailedit.el (rmail-edit-map): Likewise. * outline.el (outline-mode-map): Likewise. * c-mode.el (c-fill-paragraph): New cmd, on M-q in C mode. If in a comment, fill with comment delimiters/decoration. (calculate-c-indent-within-comment): New arg after-star * field.el: New file. Wed Jan 11 12:58:54 1989 Richard Stallman (rms@mole.ai.mit.edu) * shell.el (shell-send-input): Use run-hooks on shell-set-directory-error-hook. * subr.el (eval-after-load, eval-next-after-load): New fns to put entries on after-load-alist. * c-mode.el (c-backward-to-start-of-if): Stop looping@buffer beg. Mon Jan 9 12:37:06 1989 Richard Stallman (rms@mole.ai.mit.edu) * simple.el (zap-to-char): Error if char not found. Killed region now includes the matching char. Sat Jan 7 01:01:43 1989 Richard Stallman (rms@mole.ai.mit.edu) * options.el: doc fix. * mouse.el (mouse-delete-window): Delete window pointed at. * simple.el (backward-delete-char-untabify): In overwrite mode, back over columns clearing them out. * dired.el (dired-get-filename): filename ends before ` ->', not after. Fri Jan 6 01:38:43 1989 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-retry-failure): Lv cursor on To: line. * compile.el (compile-internal): Delete typo `<'. * tags.el (file-of-tag): Just search backwards. (tag-table-files): Don't worry about char counts. Just search. * tags.el (next-file): Change NOWARN to NOVISIT: t =>get the file in a reusable temp buffer. (tags-loop-continue): Use NOVISIT while scanning. Use separate form tags-loop-scan to scan for interesting files. If we find one, visit the file for real if nec. then use tags-loop-operate to make changes. (tags-search, tags-query-replace): Use new interface. * files.el (find-file-noselect): Do directory abbrevs first thing so both dir name and file name show the abbreviations. * tags.el (find-tag): Fix bug in last changes. * debug.el (cancel-debug-on-entry): Use empty string for "cancel all". (debug-on-entry-1): Clean err msg for built-in function. * session.el: New file. Load ~/.emacs-session. Related code moved here from startup.el. * session.el (save-session): New fn. has meat of kill-emacs-hook. Call expand-file-name to expand `~'. Save the value of point, as well. * subr.el: Set run-hooks variable. * tex-mode.el (LaTeX-mode): %@line start separates paragraphs. * files.el (basic-save-buffer): Don't write over directories if file-precious-flag is set. Wed Jan 4 23:45:30 1989 Richard Stallman (rms@mole.ai.mit.edu) * sendmail.el (sendmail-send-it): Always pass -f option to sendmail. * tags.el (find-tag): In regexp case, consider only matches that don't go past the DEL char. Tue Jan 3 13:31:13 1989 Richard Stallman (rms@mole.ai.mit.edu) * loaddefs.el (auto-mode-alist): Add `.oak'. Mon Jan 2 02:49:22 1989 Richard Stallman (rms@mole.ai.mit.edu) * files.el (diff): New command to compare file with its backup. (file-newest-backup): Return newest backup for given filename. * debug.el (debug-on-entry-1): Handle macros here. ({cancel-,}debug-on-entry): instead of here. But here maintain a list debug-function-list of functions set for debug on entry. nil or empty arg to cancel-... means cancel all. (debugger-list-functions): New command, on `l'. (debugger-jump): Continue to exit of this frame after turning off all debug-on-entries. (debugger-reenable): Turn back on all debug-on-entries that are supposed to be on. Called from `debug' and other debugging fns. * startup.el (kill-emacs-hook): If save-session-flag is set, write a file ~/.emacs-session recording file and line number. Put (load "~/.emacs-session" t t) (setq save-session-flag t) in your .emacs to enable session saving. * window.el (window-config-to-register, register-to-window-config): New fns, on C-x 6 and C-x 7. * vmsproc.el (subprocess-command-to-buffer): New function. * dired.el (dired-readin): Handle VMS. (dired-get-filename): handle VMS. Also move handling of LOCALP and NOERROR arguments to the end. * vms-patch.el (vms-read-directory): New function. * loaddefs.el (auto-mode-alist): Add `.for' and `.ltx'. * files.el (list-directory): Support for VMS. * c-style.el: New file. * vt200.el (keyboard-translate-table): Make a table, and use it to interchange ESC and backquote. Sun Jan 1 14:21:26 1989 Richard Stallman (rms@mole.ai.mit.edu) * gdb.el (gdb-mode-map): continue now C-c C-p. * tags.el (find-tag-default): If not inside a tag, use previous or next tag found on current line. Never go outside current line. * sendmail.el (mail-mode-map): Make map inherit from text-mode-map. Sat Dec 31 01:07:56 1988 Richard Stallman (rms@mole.ai.mit.edu) * files.el (find-alternate-file): Abbreviate homedir as `~'. * files.el (find-file-noselect): perform abbreviations on the directory name when setting the default--from directory-abbrev-alist. Fri Dec 30 18:40:19 1988 Richard Stallman (rms@mole.ai.mit.edu) * tags.el (next-file): New arg means don't warn of readonly file, etc. (tags-loop-continue): Don't warn and don't do local vars when scanning. If scanning makes a new buffer, kill it and re-find the file "for real" after exiting the scanning loop. * files.el (hack-local-variables): Change `inhibit-local-variables' to `enable-local-variables'. Now three alternative values: nil (ignore them), t (use them) or otherwise (query). * startup.el (command-line-1): Rearrange startup message. Thu Dec 29 14:23:10 1988 Richard Stallman (rms@mole.ai.mit.edu) * compile.el (compilation-sentinel): Set OPOINT, OMAX in proper buffer. Wed Dec 28 15:02:43 1988 Richard Stallman (rms@mole.ai.mit.edu) * lpr.el (print-region-1): Anything except `berkeley-unix', treat like USG. * picture.el (picture-tab): Use move-to-tab-stop. * indent.el (move-to-tab-stop): Like tab-to-tab-stop but just move point; don't change buffer unless nec. to get a spot to move to. * indent.el (indent-region): If have fill-prefix, make each line start with the prefix. * awk-mode.el: New file. * loaddefs.el: Add autoload and auto-mode-alist entry. Sat Dec 24 15:13:59 1988 Richard Stallman (rms@mole.ai.mit.edu) * mail-utils.el (mail-strip-quoted-names): Handle nested comments. * gdb.el (gdb-refresh): Call `recenter'. Take prefix arg and pass it. Fri Dec 23 17:26:55 1988 Richard Stallman (rms@mole.ai.mit.edu) * dired.el (dired-get-filename): Handle spaces in filenames. Thu Dec 22 02:46:25 1988 Richard Stallman (rms@mole.ai.mit.edu) * term/at386.el: Eric Raymond's changes to work with keypad.el. * loaddefs.el (completion-ignored-extensions): add .a and .ln. * shell.el (shell-set-directory): Convert // to one /, so Emacs emulates Unix conventions. (shell-unduplicate-slashes): New fn to convert a string that way. * info.el (Info-edit-map): Make this inherit text-mode-map, instead of copying that. TEST THIS LATER. * dired.el (dired-readin): Add the `d' option, if wildcard pattern. * gdb.el: Commands changed: M-c, M-u, M-d now use C-c prefix. (gdb-maybe-delete-prompt, gdb-call): Handle the fact that insertion is done with insert-before-markers. Also delete multiple prompts if they arrive in succession. Also work properly if buffer contains an unsent partial input line. Value of gdb-delete-prompt-marker is now a list: (BEG-OF-LINE-MARKER PROMPT-LENGTH PROMPT-STRING). Wed Dec 21 11:16:48 1988 Chris Hanson (cph@kleph) * telnet.el (telnet-filter): Don't insert ^M's into the buffer. Don't force point to move to end of buffer; `insert-before-markers' will move it if that is appropriate. * netunam.el: New file supports hp-ux `RFA' feature. Tue Dec 20 01:53:03 1988 Richard Stallman (rms@mole.ai.mit.edu) * backquote.el, loaddefs.el: doc fix. Sun Dec 18 00:39:24 1988 Richard Stallman (rms@mole.ai.mit.edu) * keypad.el: Change from character numbers to named characters in the function keymap. Fri Dec 16 12:53:20 1988 Richard Stallman (rms@mole.ai.mit.edu) * files.el (find-file-noselect): Mention file name when asking whether to read new version from disk. Wed Dec 14 12:04:01 1988 Richard Stallman (rms@mole.ai.mit.edu) * mouse.el: New file; window-system-independent parts of mouse support. * x-mouse.el: Parts moved to mouse.el. Require 'mouse. * rmail.el (rmail-make-in-reply-to-field): Regexp had nested loops. * term/x-win.el: Add missing arg to set-input-mode. Mon Dec 12 15:21:39 1988 Richard Stallman (rms@mole.ai.mit.edu) * telnet.el (telnet-send-input): Save input in telnet-previous-input (telnet-mode): Make that var buffer-local. (telnet-copy-last-input): New fn to yank that var; now on C-c C-y. * loaddefs.el (replace-string): Fix doc typo causing bug. Sat Dec 10 14:51:24 1988 Richard Stallman (rms@mole.ai.mit.edu) * compile.el (compile-internal): Get old compile process just once. * hideif.el, keypad.el, terminal.el: Add new arg to calls to where-is-internal. * x-mouse.el (mouse-binding-names): Set up this table. * sort.el (sort-columns): On VMS, use sort-subr to do the work. * rmail.el (rmail-insert-inbox-text): Vary name of .newmail file based on name of inbox file. Wed Dec 7 15:15:56 1988 Richard Stallman (rms@mole.ai.mit.edu) * shell.el (shell): Do M-x shell-mode only if new buffer. Don't bother setting NAME; it's not used again. Tue Dec 6 18:56:21 1988 Richard Mlynarik (mly@peduncle.ai.mit.edu) * files.el (toggle-read-only): +ve prefix arg means to set read-only Sun Dec 4 12:05:34 1988 Richard Stallman (rms@mole.ai.mit.edu) * debug.el (cancel-debug-on-entry): Fix typo in handling macros. * spell.el (spell-region): Win if spell-filter is buffer-local. * c-mode.el (electric-c-terminator): Don't use a marker to handle auto-fill from newline. Do it as in electric-c-brace. * keypad.el (function-key-sequence): Pass t as new arg. * rmailout.el (rmail-output-to-rmail-file): Temporarily undelete the message while it is being copied. * texinfmt.el (texinfo-format-emph): Was failing to rescan result. Sat Dec 3 09:06:27 1988 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-reply): On a bounce notice, do rmail-retry-failure. (rmail-retry-failure): Set up to re-edit and re-send original msg. Thu Dec 1 23:54:29 1988 Richard Stallman (rms@mole.ai.mit.edu) * dbx.el (dbx-filter): Use insert-before-markers. * gdb.el (gdb-filter): Likewise... * kermit.el (kermit-clean-filter): * mh-e.el (mh-process-demon): * telnet.el (telnet-filter): * terminal.el (te-filter): Wed Nov 30 06:51:22 1988 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail-convert-to-babyl-format): Turn case-fold-search off since `from' in l.c. can appear@beg of line within a Unix-format message. * files.el (set-auto-mode): Call the mode function outside of the save-excursion, so mode hooks can move point. * replace.el (occur-mode-goto-occurrence): Don't lose if not@col 0. Fri Nov 25 13:36:27 1988 Richard Stallman (rms@mole.ai.mit.edu) * bytecomp.el (byte-compile-function-form): For symbol as arg, return the symbol, not its function definition. Sat Nov 19 13:16:10 1988 Richard Stallman (rms@mole.ai.mit.edu) * tags.el (tags-completion-alist): New local var of each tag table, holding alist of all tags in it. Also a function to compute the alist. (visit-tags-table-buffer): Make that var local. (visit-tags-table): Compute the alist unless already done. (find-tag-tag): Do completing read using the alist. Thu Nov 17 17:27:30 1988 Richard Stallman (rms@mole.ai.mit.edu) * sendmail.el (mail-sent-via): New command, entered in mail-mode-map. * files.el (find-alternate-file): Include old filename in initial contents of minibuf. * files.el (file-name-sans-versions): Fuller knowledge of VMS version numbers. Tue Nov 15 16:16:53 1988 Richard Mlynarik (mly@peduncle.ai.mit.edu) * rmail.el (rmail-make-in-reply-to-field): I'm sick of seeing illegal headers generated by rmail. Note that this change undoes rms' change of 4-Jul-88" -- I'll check to see why that change was made in the first place. * rmail.el (rmail-forward): Set `forwarded' attribute only if mail is sent. Tue Nov 15 15:28:43 1988 Richard Stallman (rms@mole.ai.mit.edu) * startup.el (command-line): Don't set mode of *scratch* if .emacs did. (command-line-1): Avoid binding load-path for -l switch. Sun Nov 13 21:09:47 1988 Richard Stallman (rms@mole.ai.mit.edu) * time.el (display-time): Use pipes--don't waste a pty. * ispell.el (start-ispell): Likewise. Fri Oct 21 11:30:51 1988 Chris Hanson (cph@kleph) * xscheme.el (xscheme-send-control-g-interrupt, xscheme-send-interrupt): Don't use second argument to `interrupt-process' or `quit-process'. These aren't needed and they actually cause the wrong effect on Ultrix. Wed Oct 12 13:15:56 1988 Richard Stallman (rms@mole.ai.mit.edu) * rmail.el (rmail): Don't process local-variables specs in RMAIL files. Mon Oct 10 13:14:50 1988 Richard Stallman (rms@mole.ai.mit.edu) * files.el (list-directory): Handle non-ex dirs properly. Use file-name-as-directory when appro. Simplify testing for dir-name vs. file-pattern. * rmail.el (rmail-set-attribute): Optional 3rd arg is message #. * sendmail.el (mail, mail-other-window, mail-setup): 7th arg is list of (FCN . ARGS) to perform when msg is sent. * rmail.el (rmail-reply): Don't set `answered' now; use new arg to mail-other-window to get that done later. Sat Oct 8 02:51:33 1988 Richard Stallman (rms@mole.ai.mit.edu) * gomoku.el, resume.el: New files. * server.el (server-visit-files): Run server-visit-hook. * electric.el (shrink-window-if-larger-than-buffer): Make proper buffer current when buffer-local let-vars are unwound. Fri Oct 7 06:32:52 1988 Chris Hanson (cph@kleph) * texinfmt.el (texinfo-format-defun-1): Don't upcase &-keywords in @defun argument lists. Fri Oct 7 00:20:58 1988 Richard Stallman (rms@mole.ai.mit.edu) * term/vt100.el (vt100-wide-mode): New function to toggle 132-col mode. * replace.el (perform-replace): typos in doc string. Thu Oct 6 01:08:28 1988 Richard Stallman (rms@mole.ai.mit.edu) * files.el (recover-file): Don't turn-off auto-save. * time.el (display-time-filter): rmail-pop-up non-nil says, if have new mail, pop up rmail window and read it in. Wed Oct 5 18:08:53 1988 Richard Stallman (rms@mole.ai.mit.edu) * compile.el (compile-internal): Must do fundamental-mode *before* make-local-variable. Tue Oct 4 16:36:43 1988 Richard Stallman (rms@mole.ai.mit.edu) * files.el (backup-buffer): Chase symlinks and backup their target. Mon Oct 3 00:41:46 1988 Richard Stallman (rms@corn-chex.ai.mit.edu) * compile.el (compile-internal): New name for compile1. Doc changes in many functions. Fri Sep 30 15:52:30 1988 Richard Stallman (rms@mole.ai.mit.edu) * loaddefs.el: autoload mail-mode. Thu Sep 29 15:04:23 1988 Richard Stallman (rms@mole.ai.mit.edu) * man.el (nuke-nroff-bs): Delete ESC 7, ESC 8, ESC 9. (manual-entry): Put the arg into the buffer name. Wed Sep 28 15:03:11 1988 Richard Stallman (rms@mole.ai.mit.edu) * term/s4.el: Fix typo in `select' key, undefine ESC 0 and ESC 9. * mailalias.el (expand-mail-alias): New arg EXCLUDE is regex to delete. * loaddefs.el (auto-mode-alist): nroff-mode for .me, .mm, .[1-9]. * compile.el (next-error): Support multiple compilation buffers. (compile1): Likewise. New variable compilation-error-buffer. Variable compilation-process eliminated. compilation-error-buffer records which buffer next-error should use. (compilation-sentinel): Use positive indices in current-time-string. Tue Sep 27 22:23:38 1988 Chris Hanson (cph@kleph) * dired.el (dired-chown): hp-ux puts the chown program in /bin, not /etc. Tue Sep 27 00:46:34 1988 Richard Stallman (rms@corn-chex.ai.mit.edu) * files.el (delete-auto-save-file-if-necessary): New arg FORCE. Delete only if file is recent or if FORCE. (basic-save-buffer): Pass t for FORCE if auto save file was recent. (rename-auto-save-file): Don't rename file if not recent. * sendmail.el (mail-send): Query if buffer unmodified (already sent). Mon Sep 26 15:14:15 1988 Richard Stallman (rms@mole.ai.mit.edu) * prolog.el (run-prolog): Use new var prolog-program-name. * compile.el (compile1): Don't call save-some-buffers. (compile, grep): Call it here. * compile.el (compile1): Two new args PARSER and REGEXP control local bindings for compilation-parse-errors-hook and compilation-error-regexp. (next-error): Call compilation-parse-errors-hook to parse errors. Save the entire list in compilation-old-error-list. Don't clear markers when used; put them in compilation-last-error. (compilation-forget-errors): Clear all the markers that were made. Sun Sep 25 12:59:18 1988 Richard Stallman (rms@mole.ai.mit.edu) * text-mode.el (change-log-mode): New function. * loaddefs.el: Use that for ChangeLog files. * add-log.el (add-change-log-entry): Don't set major or minor modes. * tags.el (select-tags-table): New; offers menu for of tags tables. (visit-tags-table): Add each tags table to tags-table-file-list. * tags.el (find-tag): New arg REGEXP means 1st arg is a regexp. (last-tag): Now can be a list, whose car is a regexp. Means find-tag to repeat same tag should do regexp search. (find-tag-regexp): New command. * tags.el (tags-loop-continue): If we don't stop in a buffer and it isn't modified, kill it when get the next one. * bibtex.el: Greatly revised by Marc Shapiro. Fri Sep 23 00:35:33 1988 Richard Stallman (rms@hobbes.ai.mit.edu) * sendmail.el (sendmail-send-it): Change "s:" to "subject:". Wed Sep 21 01:02:53 1988 Richard Stallman (rms@hobbes.ai.mit.edu) * float.el (abs): Define it as in cl.el and mim-mode.el. * doctor.el (doctor-member): New name for `member'. * subr.el (mod): Name deleted. * mlsupport.el (setq-default): Defn deleted; data.c does it. * edt.el (edt-beginning-of-window): Function renamed. (edt-delete-previous-word): Function renamed. (edt-line-to-{top,bottom}-of-window): Function renamed. * cl.el: require cl, so that byte-compiler will load it. * lpr.el (print-region-1): Don't pass -T, -J switches on sysv. * bibtex.el (bibtex-entry): Insert comma only if both required and optional are non-nil. * autoinsert.el: Change defconst to defvar. Mon Sep 19 18:49:10 1988 Richard Stallman (rms@mole.ai.mit.edu) * * shell.el: New commands TAB, M-n, M-p. (shell-complete-file-name): New function. (shell-completion-cleanup): New function, called from kill-shell-input and shell-send-input. (kill-output-from-shell): Kill back to last recognized prompt. (shell-{next,prev}-command): New motion commands. * * text-mode.el (center-region): Don't change blank lines. Sat Sep 17 17:27:47 1988 Richard Stallman (rms@mole.ai.mit.edu) * * lisp.el (beginning-of-defun): Obey new var defun-prompt-regexp. Fri Sep 16 00:34:47 1988 Richard Stallman (rms@corn-chex.ai.mit.edu) * files.el (find-alternate-file): Don't kill OBUF if still current. * subr.el (start-process-shell-command): Start subprocess, exec'ing via the shell. * compile.el (compile1): Call that. * * server.el (server-temp-file-p): New function for recognizing which files are temp files. (server-edit): Call it. (server-temp-file-regexp): Variable that controls the function. * * outline.el (outline-minor-mode): New command; adds outline-mode-ness to current major mode. (outline-heading-end-regexp): New variable; how to find end of heading. (outline-end-of-heading): Move fwd to end of heading. So that a heading can be more than one line. Various functions call this. (outline-level): Now it's the indentation of the end of what matches. Thu Sep 15 17:30:08 1988 Richard Stallman (rms@mole.ai.mit.edu) * compile.el (grep): Use grep-command for program. * * loaddefs.el (grep-command): New variable. (compile-command): Moved to compile.el. * c-mode.el (electric-c-terminator): Make insertpos a marker. * c-mode.el (c-indent-command): `interactive' should follow doc string. Tue Sep 13 22:49:02 1988 Richard Stallman (rms@corn-chex.ai.mit.edu) * hideif.el (hif-tokenize): Typo in token string. Mon Sep 12 14:56:40 1988 Richard Stallman (rms@mole.ai.mit.edu) * help.el (locate-library): New command. * cl-indent.el (common-lisp-indent-hook): New clause for `,'. * c-mode.el (c-backward-to-noncomment): Stop better@beg of bfr. * info.el (Info-find-file): Clear buffer-file-name before calling erase-buffer. Tue Sep 6 21:03:07 1988 Richard Stallman (rms@mole.ai.mit.edu) * loaddefs.el (shell-prompt-pattern): Allow prompt enclosed in parens. * lisp-mode.el (calculate-lisp-indent): bug in lisp-indent-offset case. See ChangeLog.2 for earlier changes. emacs-19.30/lisp/ChangeLog.4100666 12120 1 1210151 5643210550 14052 0ustar rmsdaemonMon May 30 04:33:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.25 released. * comint.el (comint-read-input-ring): Make regexp stricter. * info.el (Info-directory-list): Doc fix. * paths.el (Info-default-directory-list): Don't attach ../info. So now configure-info-directory comes last. Put /usr/local/info second. * bibtex.el (bibtex-clean-entry): Back over close delimiter carefully. * ange-ftp.el (ange-ftp-insert-directory): Expand file name to check whether it is really an ftp file name. * compile.el (compilation-error-regexp-alist): Stricter Lucid regexp. * simple.el (completion-list-mode-map): Unbind down-mouse-2. Mon May 30 03:32:01 1994 Simon Marshall (Simon.Marshall@mail.esrin.esa.it) * font-lock.el (shell-font-lock-keywords): Removed regexp for commands. (rmail-summary-font-lock-keywords): New variable. (font-lock-set-defaults): Use it. Sun May 29 16:05:39 1994 Paul Eggert (eggert@twinsun.com) * cal-dst.el (calendar-current-time-zone): Fix typo that transposed DST-STARTS-TIME and DST-ENDS-TIME. * cal-dst.el (calendar-daylight-savings-ends): Fix typo in put. Sat May 28 00:11:04 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gud.el: Use ctl-x-map to bind C-x SPC. * lmenu.el (make-lucid-menu-keymap): Allow any form as the enabler. * info.el (Info-directory-list): Doc fix. * server.el (server-visit-files): Bind last-nonmenu-event. * mailalias.el (build-mail-aliases): Handle source directives. Handle MAILRC envvar. * flow-ctrl.el (enable-flow-control): Fix bugs turning off flow ctrl. * files.el (insert-directory): Use expanded file name to find handler. * dired.el (dired-get-filename): Get rid of text props from name. * simple.el (deactivate-mark): Do nothing unless transient-mark-mode. * ispell.el (ispell-command-loop): Fix `q' question. * derived.el (derived-mode-init-mode-variables): Add autoload cookie. * calendar.el (calendar-cursor-to-date): Rename starred-day to calendar-starred-day. * cal-menu.el (calendar-mode-map): Define mouse-2 as ignore. * frame.el (make-frame): Doc fix. * hexl.el (hexl-mode-map): Call define-key properly for help-char. Fri May 27 21:55:28 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ediff.el (ediff-patch-buffer): Fix autoload cookie. * tcl-mode.el (tcl-mode): Copy syntax table before changing it. Thu May 26 19:17:44 1994 Michael D. Ernst (mernst@research.microsoft.com) * dired-x.el (dired-jump): Autoload. * compare-w.el (compare-windows): Make leading whitespace equivalent to no leading whitespace, according to IGNORE-WHITESPACE argument. Thu May 26 18:25:17 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gnus.el (gnus-summary-catchup): Check gnus-interactive-catchup. (gnus-summary-catchup-and-exit): Likewise. * simple.el (completion-setup-function): Fix up the regexp. * menu-bar.el (menu-bar-mode): Fix previous change. * rmail.el (rmail-show-message): If transient-mark-mode, deactivate the mark. * edebug.el (edebug-emacs-19-specific): Call x-popup-menu to fill in cache of key equivalents. Thu May 26 17:51:38 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * subr.el (posn-col-row): Test for consp, not symbolp. Doc fix. Thu May 26 00:20:11 1994 Stephen A. Wood (saw@cebaf.gov) * fortran.el: (fortran-link-matching-do): Ignore DO statements with line numbers. Thu May 26 13:37:28 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * ws-mode.el (ws-search): Fix malformed character constants. Wed May 25 04:02:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (kill-emacs-query-functions): Doc fix. * simple.el (choose-completion-string): Clear mouse-face property. * files.el: Add more risky-local-variable properties. * fill.el (fill-region-as-paragraph): if left-margin is nonzero, do adaptive-fill processing even for one-line paragraphs. * c-mode.el (c-fill-paragraph): Don't include part of comment terminator in the fill-prefix. * server.el (server-kill-emacs-query-function): Ignore killed buffers. Tue May 24 16:39:01 1994 Kenneth Manheimer (ken.manheimer@nist.gov) * allout.el (outline-chart-subtree): include outline-next- heading in loop conditions to detect end-of-buffer (and avoid infinite loop). Mon May 23 03:32:01 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.24 released. * ange-ftp.el (ange-ftp-gwp-start): Call internal-ange-ftp-mode. Mon May 23 00:50:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (interpreter-mode-alist): Add wishx, tclsh. Delete form, scope, shell. (set-auto-mode): Don't get confused by args after #! shell name. * frame.el (frame-initialize): Record in frame-initial-frame-alist the actual settings of vertical-scroll-bars. * buff-menu.el (Buffer-menu-mouse-select): Handle dedicated window. * lmenu.el (popup-menu): Bind cmd with let. (popup-dialog-box): Bind meaning with let. (current-menubar): Add defvar. * etags.el (select-tags-table-mode): New function, a major mode. (select-tags-table): Call that. (select-tags-table-mode-map): New variable. * mouse-sel.el (mouse-insert-selection): Test mouse-yank-at-point. (mouse-sel-insert-at-point): Variable deleted. * files.el (hack-one-local-variable): Check properly for `defun. * sendmail.el (mail-mailer-swallows-blank-line): Don't die if /etc/sendmail.cf does not exist. * lmenu.el (popup-menu): Use mouse-pixel-position. Sun May 22 02:47:47 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (posn-col-row): Use let*. * allout.el, cal-french.el, complete.el, diary.el: Doc fix. * edebug.el, ediff.el, forms.el, gnus.el, hippie-exp.el: Doc fix. * holidays.el, imenu.el, inf-lisp.el, ispell.el, mail-hist.el: Doc fix. * makefile.el, nntp.el, refbib.el, refer.el, simula.el: Doc fix. * supercite.el, vip.el, ws-mode.el, term/x-win.el: Doc fix. * mouse.el (mouse-split-window-vertically): Treat scroll bar events just like others. * subr.el (posn-col-row): Do something useful for scroll bar event. * paths.el (rmail-spool-directory): Maybe use /var/mail. * jka-compr.el (jka-compr-compression-info-list): Doc fix. (jka-compr-op-table, jka-compr-file-name-handler-entry): Move defvars. * subr.el (substitute-key-definition): Skip cached menu key-equivs. * easymenu.el (easy-menu-create-keymaps): Renamed from easy-menu-keymap. Callers changed. Sat May 21 20:50:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * shell.el (shell-strip-ctrl-m): Strip multiple ^Ms. Sat May 21 11:38:20 1994 Michael D. Ernst (mernst@research.microsoft.com) * dired.el (dired-mark-pop-up): Clear mouse-face property. Sat May 21 09:26:47 1994 Kevin Broadey (KevinB@mended_drum) * foldout.el (foldout-exit-fold): Make numeric argument work; before, it always exited one fold. Replace the Common Lisp `loop' construct with `while'. Sat May 21 01:28:13 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * startup.el (command-line-1): Precompute menu bar before startup msg. * ispell.el: Doc fixes. * ispell.el: Lucid menu added. (ispell): New function. (ispell-region): Assure choices and checked buffer selections correct. reindented. (ispell-highlight-spelling-errors): Prefix ispell- to highlght fns. (ispell-complete-word): Heuristic to respect case of completed words. (ispell-command-loop): Non-character events ignored. Reindented. (ispell-message): Various improvements. (ispell-init-process): `ispell-extra-args' added to allow personal customizations. Fri May 20 17:21:57 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * paren.el (show-paren-command-hook): Always set show-paren-mismatch-face to symbol, not face vector. * dired.el (dired-readin): Clear modified flag at the very end. * server.el (server-done-hook): New hook. (server-buffer-done): Run it. * mouse.el (mouse-choose-completion): Include words separated by single spaces in the completion. * simple.el (choose-completion): Include words separated by single spaces in the completion. * ispell.el: Lots of doc fixes and message syntax fixes. (ispell-command-loop): For X, put point before the word being considered, and mention C-u M-$ in message. * bookmark.el (bookmark-file): Alternate default on ms-dos. Fri May 20 13:43:51 1994 Noah Friedman (friedman@kropotkin.gnu.ai.mit.edu) * rsz-mini.el: Enable resize-minibuffer-mode when this file is loaded. Fri May 20 03:40:12 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-drag-secondary): Handle mouse motion out of window as in mouse-drag-region. * ispell.el (ispell-word): Implement C-u $ as in ispell4.el. (ispell-command-loop): Make quit-char work like X. For C-z, run whatever it's bound to. Thu May 19 16:39:23 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cal-menu.el (calendar-mode-map): Use calendar-goto-astro-day-number. * simple.el (completion-setup-function): Make highlight span single spaces. (choose-completion-delete-max-match): Handle completion-ignore-case. * gnus.el (gnus-group-unsubscribe-current-group): Fail nicely if no current group name. * avoid.el (mouse-avoidance-nudge-dist): Doc fix. * menu-bar.el (menu-bar-mode): Preserve window height. * vc-hooks.el (vc-mode-line): Do nothing if FILE is nil. * compile.el (compilation-goto-locus): Handle case where *compilation* is in a dedicated window. * ispell4.el (ispell-highlight): Do nothing unless window-system. * rmail.el (rmail-variables): Don't add any permanent-local props. Don't make rmail-last-file local. * rmailedit.el (rmail-edit-current-message): Undo previous change. * rmailout.el (rmail-output): Doc fix. * gnus.el: rmail-default-file renamed from rmail-last-file, rmail-default-rmail-file renamed from rmail-last-... Thu May 19 01:58:43 1994 Daniel Quinlan (quinlan@bucknell.edu) * info.el (info-insert-file-contents): Avoid conflict with jka-compr. Thu May 19 11:33:35 1994 Boris Goldowsky (boris@mink.cs.rochester.edu) * avoid.el: Doc fixes. (mouse-avoidance-nudge-mouse): Removed redundant bounds check on destination coordinates. Thu May 19 00:29:41 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * server.el (server-done): Never kill buffer here. (server-buffer-done): Do it here, if temp file. * menu-bar.el (menu-bar-update-buffers): Record buffers' mod and read-only flags, and recompute if they change. * subr.el (posn-col-row): Doc fix. Wed May 18 19:29:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * font-lock.el (font-lock-after-change-function): Fix typo in prev chg. (font-lock-mode): Use after-change-functions not after-change-function. Tue May 17 21:11:29 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * tex-mode.el (tex-delete-last-temp-files): Don't fail on non-existent directory. Tue May 17 18:54:29 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * soundex.el (soundex-alist): Put variable before fn that uses it. Tue May 17 05:05:03 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.23 released. * gnus.el (gnus-group-mode-map): Fix typo in prev change. Mon May 16 03:23:48 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * man.el (Man-heading-regexp): Accept multiple whitespace chars. * gnuspost.el (gnus-post-news): Handle followup-to field. * bookmark.el: Doc fixes. (bookmark-relocate): Rename arg. Sun May 15 17:41:12 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * startup.el (precompute-menubar-bindings): Don't precompute menus if not using x. Thu May 12 13:04:53 1994 Kenneth Manheimer (klm@coil.nist.gov) * allout.el (outline-mode): Use outline-this-or-next-heading. * allout.el (outline-this-or-next-heading): New function. * allout.el (outline-mode): Fixed topic body reindentation scheme so programming code is not indented unless `outline-reindent-bodies' has value `force'. * allout.el (outline-infer-reindent-bodies): Implement above. * allout.el (outline-reindent-bodies): Doc fix. * allout.el (outline-init): New user interface for control of outline-mode session setup. Sets up `outline-find-file-hook', `outline-layout', and `outline-auto-activation'. Sat May 14 04:29:48 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * man.el: Remove periods from messages. (Man-heading-regexp): Accept only one leading space. * tar-mode.el (tar-extract): Put tar name into subfile visited name. (tar-subfile-save-buffer): When updating the desc line, insert new text after, then delete. * ediff.el: Move menu bar defines to top level and split them among three top-level sexps. Make menu bar defines unconditional. Don't alter menu-bar-files-menu here; menu-bar.el does that. Fri May 13 05:13:32 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * font-lock.el (font-lock-mode): Make font-lock-no-comments local. (font-lock-after-change-function): If we don't call font-lock-fontify-region, clear out face props instead. Thu May 12 13:55:15 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cal-menu.el: Rewrite mouse-3 menu as a keymap. Move calendar-mouse-2-date-menu to down-mouse-2. * autoload.el (autoload-trim-file-name): Make it relative to the directory that loaddefs.el is in. * allout.el (outline-init): Delete junk at end. * texinfo.el (texinfo-show-structure): Fix subsubsection indent amount. * autoload.el (update-autoloads-here): Make just one shorter message. (batch-update-autoloads): Doc fix. Thu May 12 10:43:15 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * menu-bar.el (menu-bar-update-buffers): Don't use string-match. * autoload.el (update-autoloads-here): Split up long message. Thu May 12 00:59:07 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * font-lock.el (font-lock-fontify-buffer): Don't give "syntactically" message if we aren't doing that part. * gnus.el (gnus-group-mode-map, gnus-summary-mode-map): Add bindings for up and down keys. * dired.el (dired-mode-map): Get rid of dired-regexp-prefix; put the submap directly in the main map. * tar-mode.el (tar-extract): Don't clear out the buffer-file-name. Don't set list-buffers-directory. Wed May 11 19:10:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (shell-command): Use buffer name *Shell-Command*. * gud.el (sdb): Handle tags-file-name as nil. * isearch.el (isearch-done): Don't call deactivate-mark. Tue May 10 21:54:53 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * ediff.el (ediff-no-help-in-control-buffer): Renamed from ediff-nix-help-in-control-buffer, to match doc and usage. * autoload.el (update-file-autoloads): Delete leftover variable. * man.el (Man-reuse-okay-p): Doc fix. (Man-filter-list, Man-heading-regexp): Fix patterns. (Man-first-heading-regexp, Man-find-section): Likewise. (Man-getpage-in-background): Don't print ellipsis. (Man-bgproc-sentinel): Preserve match data. (Man-build-references-alist): Preserve restriction. (Man-bgproc-sentinel, Man-build-section-alist): Bind case-fold-search. (Man-next-section, Man-previous-section, Man-find-section): Likewise. (Man-goto-page): Fix interactive declaration. (Man-build-section-alist): Use match data, not bol/eol. (Man-build-man-command): Use manual-program, not hardcoded name. (Man-getpage-in-background): Likewise. Tue May 10 16:59:37 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc-hooks.el (vc-registered): Use find-file-name-handler. * font-lock.el (font-lock-no-comments): New variable. (font-lock-after-change-function): Test it. (font-lock-fontify-buffer): Test it. (font-lock-set-defaults): Set it. * files.el (abbreviate-file-name): Add special case for ms-dos. Delete code that checked for abbreviated-home-dir ending in /; it never did anything. * ispell4.el (ispell-message): Add `ispell-message-text-end' and `ispell-message-limit'. Spell-check subject as well as body. Tue May 10 16:54:49 1994 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * cal-menu.el (calendar-mode-map): Change binding of Mouse-2. Bind Mouse-3. (calendar-event-to-date): Add optional error parameter. (calendar-mouse-print-dates): Fix first line to show day of year. (calendar-mouse-date-menu): Deleted; split into two parts. (calendar-mouse-2-date-menu, calendar-mouse-3-date-menu): The two new functions. * calendar.el (calendar-cursor-to-date): Fix error return. (calendar-iso-date-string): Repair punctuation. Tue May 10 03:53:51 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * frame.el (frame-remove-geometry-params): Reverse the computed list, to preserve the original order of the elements. Tue May 10 02:32:58 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * texnfo-upd.el (texinfo-every-node-update) (texinfo-all-menus-update): Bind mark-active to t. * texinfo.el (texinfo-environment-regexp): Split lines. Add def..., ifset, ifclear. (texinfo-show-structure): Fix typo. Tue May 10 01:57:08 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * files.el (file-chase-links): Delete redundant slashes. Match `..' only at start of string. * gud.el (gud-gdb-marker-filter, gud-mipsdbx-marker-filter, gud-perldb-marker-filter): Allow marker string to arrive in mid-line. Tue May 10 01:12:42 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (shell-command-on-region): Don't kill output buffer when in the one line case. Mon May 9 14:06:55 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * iso-cvt.el (iso-gtex2iso-trans-tab): Reorder this list. * rmailsum.el (rmail-make-basic-summary-line): Get all the lines of the From field. * menu-bar.el (menu-bar-file-menu): Add Apply Patch and Compare Files * ediff.el: Doc fixes. Mon May 9 14:48:58 1994 Michael D. Ernst (mernst@monozygote.research.microsoft.com) * files.el (find-file-noselect): Suppress same-file warning if both filenames would print identically. Sun May 8 20:08:14 1994 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * cal-menu.el (calendar-mouse-set-mark): New function. (calendar-mouse-date-menu): Bind it to key. Sun May 8 11:58:33 1994 Kenneth Manheimer (klm@coil.nist.gov) * allout.el (outline-init) New user interface for control of outline-mode session setup, sets up `outline-find-file-hook', `outline-layout', and `outline-auto-activation'. * allout.el (outline-mode-post-command-business, outline-mode) (outlineify-sticky): Major new mode activation scheme. See outline-layout docstring for details. (outline-layout, outline-use-mode-specific-leader) (outline-mode-leaders): Variables for new mode-activation scheme. (outline-expose-topic): New specification format and optimizations, including thorough accomodation of multiple top- level topics. (outline-forward-current-level, outline-next-sibling) (outline-backward-current-level, outline-goto-prefix) (outline-show-children, outline-up-current-level) (outline-expose-topic): Behavior refinements and repairs, and speed optimizations. Better accomodation for multiple top-level topics. (outline-recent-end-of-subtree): New state var, basis for many topic-oriented optimizations. * allout.el: Revisions of many docstrings, for conformance to gnu standards and/or clarity. Sun May 8 02:05:32 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * calendar.el: Doc fixes. * cal-menu.el (calendar-mouse-print-dates): Add missing level of list for Islamic, Revolutionary and Mayan calendars. Delete duplicate entry for ISO calendar. (calendar-event-to-date): Set buffer in case calendar isn't current. Sun May 8 02:44:06 1994 David K}gedal (davidk@lysator.liu.se) * tempo.el (tempo-insert-region, tempo-show-completion-buffer, tempo-leave-completion-buffer): New variables. (tempo-complete-tag): Added a completion buffer mechanism. (tempo-display-completions): New function. (tempo-insert-template): An extension to the (p ...) tag enables named insertion for later insertion using a (s ...) tag. Sat May 7 17:59:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (ignore): Allow interactive call. * loaddefs.el (global-map): Bind mouse-movement to ignore. * rmail.el (rmail-toggle-header): Call rmail-highlight-headers. * sendmail.el (mail-mailer-swallows-blank-line): Put space and tab into brackets. Sat May 7 02:35:21 1994 Morten Welinder (terra@diku.dk) * hexl.el (dehexlify-buffer): Reflect that binary-process was renamed to binary-process-output. (dehexlify-buffer): Bind also binary-process-input (for ms-dos). (hexlify-buffer): Bind both binary-process-input and binary-process-output (for ms-dos). (hexl-save-buffer): Force binary save (for ms-dos). Sat May 7 01:28:41 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * skeleton.el (mirror-mode): Commented out. Fri May 6 22:35:47 1994 Andreas Schwab (schwab@issan.informatik.uni-dortmund.de) * asm-mode.el (asm-comment): Don't match newline. * dired-aux.el (dired-mark-subdir-files): Don't pass any arguments interactively. * echistory.el (Electric-history-undefined): Substitute `Helper-help', not `Help-for-help'. * forms.el (forms-mode): Set visited file name to nil to prevent overwrite and autosave. The previous method didn't go far enough. * hexl.el (hexl-insert-char): Increment `address' for every character inserted. (hexl-mode-map): Add bindings for cursor keys. * hideif.el (hide-ifdef-syntax-table): New variable. (hif-tokenize): Use it. (hide-ifdef-mode): Don't clobber `c-mode-syntax-table'. * isearch.el (isearch-edit-string): Doc fix. (isearch-message-prefix): Initialize `isearch-within-brackets'. * resume.el: Provide 'resume. (resume-process-args): Bind `command-line-default-directory' for command-line-1. * shell.el (shell-backward-command): Fix regexp. * simple.el (minibuffer-history-sexp-flag): Doc fix. * terminal.el (terminal-edit-mode): Doc fix. (terminal-cease-edit): Reset the local keymap. Fri May 6 19:59:09 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * paths.el (rmail-spool-directory): On SCO 3.2v4, use /usr/spool/mail. * blessmail.el: If rmail-spool-directory is not a directory, just output an `echo' command to tell about it. * supercite.el (sc-cite-original): Add autoload. * backquote.el (backquote-backquote-symbol): Don't autoload defvar. (`): Write its name directly in the definition. Use defalias. (backquote-list*): Define with defalias. * rmailsum.el (rmail-make-basic-summary-line): Show 14 chars before @ and 11 after. Fri May 6 16:26:53 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * loadup.el: Don't precompute keybinding cache for menubar. * startup.el (normal-top-level): Do it here, after loading user files. * startup.el (command-line-1): Or here, if displaying startup message. * startup.el (precompute-menubar-bindings): New function. * menu-bar.el (menu-bar-file-menu): Change new-frame to make-frame, to agree with the keyboard binding. * mouse.el, man.el, lucid.el: Change new-frame to make-frame. Fri May 6 02:01:18 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ange-ftp.el (ange-ftp-start-process): Bind file-name-handler-alist to nil. * frame.el (frame-notice-user-settings): Wait till frame becomes visible before using its parameters. * imenu.el (imenu-default-create-index-function): Temporarily build in handling of a few major modes. (imenu--completion-buffer): Set completion-reference-buffer properly. Thu May 5 23:05:49 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * loaddefs.el (completion-ignored-extensions): Change if to cond. * hilit19.el (hilit-lookup-face-create): Don't put string values into the global face-font data. Thu May 5 01:07:58 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.el (frame-notice-user-settings): Use geometry parms from frame when the initial specifications did not have them. * frame.el (frame-notice-user-settings): When replacing the first X frame, use the same geometry parms that were used to make it. (frame-remove-geometry-params): Treat user-size and user-position as geometry parms. Store all those parms into frame-initial-geometry-arguments. * simple.el (choose-completion-string): Barf if completing into a minibuffer but it's not now active. * rmailout.el (rmail-output-menu): Set rmail-default-rmail-file. (rmail-output-to-rmail-file): Doc fix. Wed May 4 00:22:17 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.el (frame-notice-user-settings): Discard `reverse' when making the replacement for the initial frame. Put it on as nil. (new-frame): Use make-frame instead. * rmail.el (rmail-input-menu): Do nothing if rmail-secondary-file-menu return nil. Don't call expand-file-name. (rmail-secondary-file-menu): If no files match, warn and return nil. * rmailout.el (rmail-output-menu): Don't call expand-file-name. Do nothing if rmail-secondary-file-menu return nil. * imenu.el (imenu): Renamed from goto-index-pos. Add autoload. (imenu-prev-index-position-function): Renamed from prev-... (imenu-extract-index-name-function): Renamed from extract-... * gud.el (gud-marker-acc): Use make-variable-buffer-local. * outline.el (hide-sublevels): No need for condition-case. Don't call show-children if levels is 0. No need to check eob in while condition. Delete spurious setq of `first'. * frame.el (frame-initialize): Delete the code for reverse-video. x-create-frame-with-faces takes care of that. Tue May 3 20:37:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-secondary-save-then-kill): Doc fix. Tue May 3 19:11:38 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * backquote.el (backquote): Add autoloads. Tue May 3 17:32:16 1994 Per Abrahamsen (abraham@eupectic.research.att.com) * lisp-mode.el: Removed duplicate ";;; Code: " section separator. (lisp-mode-variables): Added missing backslash to outline-regexp. Tue May 3 17:04:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * autoload.el (update-directory-autoloads): Ignore files whose names start with =. Bind enable-local-eval to nil. Mon May 2 22:42:13 1994 Morten Welinder (terra@diku.dk) * isearch.el (isearch-case-fold-search): new possible value `yes' is like t except that mixed case in search string is ignored. (isearch-toggle-case-fold): New function. (isearch-search): Don't undo the work of isearch-toggle-case-fold. Mon May 2 03:49:05 1994 Lars Magne Ingebrigtsen (larsi@dyggve.ifi.uio.no) * gnus-uu.el: Removed some keystrokes for obscure toggle commands: C-c C-v C-a, C-c C-v C-p, C-c C-v C-q and C-c C-v C-k. (gnus-uu-decode-and-save-all-unread-articles-and-mark): Fn deleted. (gnus-uu-decode-and-save-all-articles-and-mark): Fn deleted. (gnus-uu-do-sloppy-uudecode): Variable deleted. (gnus-uu-decode-and-save-articles): Rewritten. (gnus-uu-grab-articles, gnus-uu-uustrip-article-as): Rewritten to properly handle multiple encoded files in one gulp. (gnus-uu-uustrip-article-as): Replace spaces in file names with underscores before giving the file to uudecode. * gnus-uu.el (gnus-uu-save-in-digest): Doc fix. (gnus-uu-save-articles, gnus-uu-save-article, gnus-uu-digest-and-forward, gnus-uu-marked-digest-and-forward): Changed old functions and added new functions to digest and forward articles. (gnus-uu-mark-thread): New function to mark a thread for later treatment. (gnus-uu-mark-by-regexp): Changed to add articles instead of clearing before adding. (gnus-uu-check-for-generated-files): First delete files, then directories. (gnus-uu-edit-begin-line, gnus-uu-decode-and-show-in-buffer): Select the current article before starting work. (gnus-uu-decode-and-view-all-unread-articles) (gnus-uu-decode-and-view-all-articles): Two new functions for decoding and viewing all (unread) articles in a newsgroup. * gnus-uu.el (gnus-uu-view-directory, gnus-uu-unpack-archives, gnus-uu-treat-archive): gnus-uu will now treat archives in archives (etc) properly when viewing. * gnus-uu.el (gnus-uu-threaded-multi-decode-and-save, gnus-uu-threaded-multi-decode-and-view): New interactive functions for decoding/saving threads. Bound to `C-c C-v C-j'. (gnus-uu-save-article): Added RFC1153-compliant digest saving. * gnus-uu.el (gnus-uu-initialize): Does some checks and expands relative temp dir names. * gnus-uu.el (gnus-uu-decode-and-show-in-buffer) (gnus-uu-decode-and-strip, gnus-uu-grab-articles) (gnus-uu-decode-and-view-or-save): Allow multiple encoded files to be decoded (and viewed) in one fell swoop. (gnus-uu-work-dir): New variable. * gnus-uu.el (gnus-uu-view-file): Changed to work with metamail. (gnus-uu-get-action, gnus-uu-toggle-view-with-metamail): New functions. (gnus-uu-ext-to-mime, gnus-uu-view-with-metamail): New variables. (gnus-uu-ctl-map): Add C-a binding. (gnus-uu-summary-next-subject): Ensures that the next unread article is moved to. (gnus-uu-default-interactive-view-rules-end): New variable to provide a "catch-all" when using interactive mode. (gnus-uu-get-action): Changed viewing rules in interactive mode. * gnus-uu.el (gnus-uu-uustrip-article-as): Disabled case-fold-search and changed gnus-uu-body-line to be more restrictive. (gnus-uu-multi-decode-and-view-or-save, gnus-uu-uustrip-article-as): Changed hard returns to \r. (gnus-uu-post-reply-mode): New mode for sending encoded files. (gnus-uu-post-news, gnus-uu-post-insert-binary-in-article) (gnus-uu-post-encode-uuencode, gnus-uu-post-encode-mime-uuencode) (gnus-uu-post-encode-mime, gnus-uu-post-make-mime) (gnus-uu-post-encode-file, gnus-uu-post-news-inews) (gnus-uu-post-insert-binary, gnus-uu-post-encoded): New functions. (gnus-uu-post-encode-method, gnus-uu-post-include-before-composing) (gnus-uu-post-threaded, gnus-uu-post-binary-separator): New variables. Mon May 2 17:41:55 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (visit-tags-table-buffer): If CONT is stringp, use it for tags-file-name. Don't bother calling tags-table-including when buffer-file-name is nil. (visit-tags-table): Signal error FILE is not stringp. Call visit-tags-table-buffer with FILE instead of 'same. (tags-next-table): When restoring state vars, set tags-file-name too. * etags.el (tags-find-table-in-list): Only recurse if (tags-included-tables) returns non-nil (avoid infinite recursion). Mon May 2 15:38:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * man.el (Man-notify-when-ready): Don't call select-frame if no window system. Mon May 2 20:55:42 1994 Daniel Quinlan (quinlan@bucknell.edu) * dired.el: Unspecified location of chown for Linux (Linux doesn't put chown in /etc). Mon May 2 12:24:20 1994 Per Abrahamsen (abraham@eupectic) * double.el (double-translate-key): Changed 'delete to 127 to make the non-X11 version work. Mon May 2 09:58:06 1994 David M. Smith (maa036@lancaster.ac.uk) * ielm.el (ielm-dynamic-multiline-inputs): New variable. (ielm-return): Support it. * ielm.el (ielm-print-working-buffer): New command (ielm-change-working-buffer): New command (ielm-display-working-buffer): New command (ielm-map): Bindings for new commands; bindings from shared-lisp-mode-map; Lemacs support. * ielm.el (ielm-eval-input): Give bindings in scope during the eval non-clashing names (ielm- prefix) * ielm.el (ielm-get-old-input): New function (inferior-emacs-lisp-mode): Bind it to comint-get-old-input Mon May 2 00:44:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * outline.el: Doc fixes. (hide-sublevels): Rewritten faster and simpler. * tex-mode.el: Doc fixes. * man.el (Man-notify-when-ready): In newframe case, use save-excursion. * tempo.el: New file. * mail-hist.el: New fike. * mldrag.el: New file. * ielm.el: New file. * rsz-mini.el: New file. Sun May 1 01:53:34 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * iso-cvt.el: New file. * replace.el (perform-replace): Call substitute-command-keys just once and only if querying. * term/x-win.el (x-handle-geometry): Specify user-position and user-size properties when appropriate. * solar.el (solar-degrees-to-hours, solar-hours-to-days): Force floating result. * blessmail.el: Don't load site-init.el. Print the mail directory we tested, on standard output. Don't load paths.el either--we now run in emacs, not temacs. Sun May 1 17:37:38 1994 Morten Welinder (terra@diku.dk) * dos-fns.el (set-register-value): Setting the high byte of a register trashed the low byte. (set-register-value): Fixed test so the value 0 can be set. (set-register-value): Rewrote to use bit operations instead of multiplication and division. (register-name-by-word-alist, register-name-by-byte-alist): Combined into one list, register-name-alist. (register-value, set-register-value): Use combined list. (mode-line-format): Make the %n pure. * loaddefs.el (mode-line-format): Make the %n pure. Sat Apr 30 22:05:40 1994 Morten Welinder (terra@diku.dk) * desktop.el (desktop-files-not-to-save): New variable to exclude certain files -- magic ftp names by default -- from being put into desktop files. (desktop-save-buffer-p): Check file name also. (desktop-save-buffer-p): For directories loaded by dired consider the directory to be the file name. (desktop-locals-to-save): Add line-number-mode to be saved when local. (desktop-remove): In case the desktop file cannot be deleted make sure that the desktop system is still inactivated. (desktop-kill): In case an error occurs when saving the desktop, offer to quit regardless. (desktop-save-buffer-p): Disregard case when testing file and buffer names against regexps. (desktop-buffer-dired): Display a warning if a directory no longer exists. (desktop-save-hook): New variable. (desktop-save): Run desktop-save-hook. (desktop-clear): Clear search history. (desktop-internal-v2s): Be more explicit when encountering an unprintable value. Sat Apr 30 21:55:10 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * menu-bar.el (menu-bar-update-buffers): Fix misspelled variable. Sat Apr 30 17:16:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * menu-bar.el: Don't call menu-bar-mode here. Sat Apr 30 12:14:34 1994 Morten Welinder (terra@tyr.diku.dk) * internal.el: Don't bind [mouse-1]; that's done elsewhere. Define lower-upper case correspondence for the three mostly used code pages. Sat Apr 30 00:15:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * scroll-bar.el (scroll-bar-event-ratio): New function. * files.el (hack-one-local-variable): Silently execute eval if the form is a put of a harmless property with harmless args. * gnus.el (gnus-summary-mode-map): Bind # to gnus-uu-mark-article. (gnus-uu-mark-article): Autoload it from gnus-uu. * gnus.el (gnus-summary-mode-map): Bind C-c C-v to gnus-uu-ctl-map. (gnus-uu-ctl-map): Autoload it from gnus-uu. Fri Apr 29 22:40:09 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * files.el (revert-buffer): Widen before replacing text. Fri Apr 29 16:54:55 1994 Kenneth Manheimer (ken.manheimer@nist.gov) * allout.el: major code speedups, bug fixes, behavior refinements, doc-string clarification and elaboration, etc. Prominent new features include: - Exposure changes and navigation are greatly accelerated. - More elaborate and clear doc-string for outline-mode, giving better guidance on use of the mode. - A new exposure-layout syntax, which accomodates outlines with multiple top-level topics. (See `outline-expose' and `outline-new-exposure'.) - Automatic exposure and verfication-prompting on attempts to change text within concealed regions, before they are applied. (Undo affecting concealed regions is only exposed, not verified, to facilitate smooth undo sequences.) - 'hot-spot' navigation implemented. When the cursor is on a topic's bullet, regular-character keystrokes will be interepreted as if they were preceded by ^C, when appropriate, so users can navigate and adjust exposure, etc, with single-stroke commands. - Lucid emacs accomodated. Fri Apr 29 20:52:03 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (tags-table-parent-pointer-list): Doc fix; elts are now 3-elt lists. (tags-next-table): Save tags-table-list in tags-table-parent-pointer-list and then set it to tags-included-tables. Restore tags-table-list from tags-table-parent-pointer-list. (tags-find-table-in-list): Renamed from tags-table-list-member. Search included tables. Take new arg MOVE-TO; if t, frob list pointers. (tags-table-including): Save tags-table-list in tags-table-parent-pointer-list. Set tags-table-list to the passed TABLES value. (visit-tags-table-buffer): When CONT is nil, pop all tags-table-parent-pointer-list state before doing anything else. Don't do list frobnication when CONT is 'same. Call tags-find-table-in-list instead of tags-table-list-member; let it do list frobnication when it succeeds. Fri Apr 29 19:42:40 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * menu-bar.el (menu-bar-update-buffers): Check whether frames ad buffers have actually changed; if not, do nothing. Fri Apr 29 14:13:14 1994 Morten Welinder (terra@tyr.diku.dk) * desktop.el (desktop-internal-v2s): Default case fixed to return correct quote flag. Fix cons cell handling to avoid recursion in the cdr part. Fri Apr 29 02:24:15 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc-hooks.el (vc-mode-line): Fix previous change. Thu Apr 28 11:11:32 1994 Michael D. Ernst (mernst@monozygote.research.microsoft.com) * novice.el (disabled-command-hook): Try to enable command in user init file only if there is a user init file. Thu Apr 28 03:31:53 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * lisp-mode.el (lisp-mode-variables): Undo previous change. * blessmail.el: Drop the trailing slash. Thu Apr 28 03:28:08 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * menu-bar.el (menu-bar-help-menu): Add item for emacs-version. Add item for report-emacs-bug. * gud.el (gud-mips-p, gud-irix-p): Test system-configuration. Wed Apr 27 18:16:00 1994 Dave Love (d.love@dl.ac.uk) * gud.el (gud-mipsdbx-marker-filter): Reimplemented based on gud-gdb-marker-filter, with regexps appropriately altered. (gud-marker-acc): New variable, replacing the debugger-specific accumulation variables. (dbx): On Irix, emit a marker so that the source is displayed initially with the marker at the first executable statement. * gud.el (dbx): Fix gud-break under SunOS, at least. (I suspect this is a general problem, because of the \n for some reason.) * gud.el (gud-dbx-mips-p, gud-dbx-irix-p): Use system-type to choose system-dependent dbx incantations. * gud.el (gud-dbx-mips-p): Use "-emacs" for OSF/1 dbx as for MIPS. * gud.el (gud-irix-dbx-p): Determines whether to use (new) gud-irixdbx-marker-filter. (gud-irixdbx-marker-filter): New function. (dbx): Insert case for Irix. Wed Apr 27 11:56:28 1994 Ulrich Mueller (ulm@vsnhd1.cern.ch) * case-table.el (describe-buffer-case-table): Don't use text-char-description. Wed Apr 27 23:41:50 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * menu-bar.el: Make a sub-keymap for the Buffers menu bar item. (menu-bar-select-buffer, menu-bar-select-frame): New commands for that subkeymap. (menu-bar-update-buffers): New function, on menu-bar-update-hook, made partly out of mouse-menu-bar-buffers. Wed Apr 27 23:33:13 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * blessmail.el: Chase symlinks manually. Wed Apr 27 23:01:23 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * blessmail.el: Get the file's truename in case it is a link. Wed Apr 27 22:40:17 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * blessmail.el: Don't make an empty script. Use signal, not error. Wed Apr 27 19:26:54 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (ange-ftp-completion-hook-function): Use new inhibit vars. * ange-ftp.el (ange-ftp-hook-function): Use ange-ftp-run-real-handler. (ange-ftp-run-real-handler): Inhibit ange-ftp-completion-hook-function as well as ange-ftp-hook-function. Wed Apr 27 17:56:55 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * compile.el (compilation-error-regexp-alist): Add fortran pattern. Wed Apr 27 02:20:03 1994 Noah Friedman (friedman@kropotkin.gnu.ai.mit.edu) * yow.el: Added comment indicating author. Tue Apr 26 20:30:10 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * faces.el (frame-update-faces): Unset old font. Tue Apr 26 05:39:04 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * case-table.el: Don't modify text-mode-syntax-table. * ange-ftp.el (internal-ange-ftp-mode): Set comint-prompt-regexp and paragraph-start. * etags.el (tags-add-tables): Doc fix. Mon Apr 25 19:09:38 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * rmailsum.el (rmail-summary-scroll-msg-up, rmail-summary-scroll-msg-down): Scroll rmail-buffer explicitly. Mon Apr 25 18:31:55 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-next-error-locus): Use compilation-error-message instead of "Moved past last error" when MOVE is 1 (default value). Mon Apr 25 14:25:13 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * desktop.el (desktop-internal-v2s): Make structure match docstring. * tar-mode.el (tar-copy): Don't bother with a temp buffer. Sun Apr 24 17:04:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dos-fns.el (mode-line-format): Put `mode-line-process' earlier. (file-name-buffer-file-type-alist): Use nil or t, not 0 or 1. (find-buffer-file-type): Handle that change. * calendar.el (calendar-starred-day): Var renamed from starred-day. Sun Apr 24 14:26:57 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * rmail.el (rmail-highlight-headers): Extracted as a new function. Fix overlay position. Do nothing if face support is unavailable. Sun Apr 24 04:21:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc-hooks.el (vc-mode-line): Warn if file is not vc-registered but is a symlink to a vc-maintained file. * tar-mode.el (tar-extract): Don't put whole file name in buffer name. Do put it in list-buffers-directory. Save mode line space when mentioning the tar file name. (tar-subfile-mode): Don't add anything to minor-mode-alist. Sun Apr 24 22:41:50 1994 Simon Marshall (Simon.Marshall@mail.esrin.esa.it) * shell.el (shell-dirstack-query): defaults to nil. (shell-mode): Guesses shell-dirstack-query based on shell name. Sun Apr 24 00:19:32 1994 Lawrence R. Dodd (dodd@roebling.poly.edu) * loaddefs.el (mode-line-format): * man.el (Man-mode-line-format): * tpu-edt.el (tpu-set-mode-line): * two-column.el (tc-mode-line-format): Put mode-line-process immediately after mode-name when setting mode-line-format. * cmuscheme.el (inferior-scheme-mode): * comint.el (comint-mode): * compile.el (compilation-setup, compilation-sentinel): * find-dired.el (find-dired, find-dired-sentinel): * gud.el (gud-mode, gud-sentinel): * inf-lisp.el (inferior-lisp-mode): * simple.el (shell-command): * terminal.el (terminal-cease-edit, terminal-mode): Remove space after `:' in mode-line-process. Sun Apr 24 00:51:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * jka-compr.el: Doc fixes. (jka-compr-run-real-handler): New function. (jka-compr-handler): Call it, to reinvoke the Emacs primitive using the new inhibit protocol. * rmail.el (rmail-show-message): Always re-set overlay face property. * simple.el (kill-line, kill-word): Don't use save-excursion. (kill-read-only-ok): New variable. (kill-region): Handle that variable. Handle read-only text property. * paragraphs.el (kill-paragraph): Don't use save-excursion. (backward-kill-paragraph): Likewise. (kill-sentence, backward-kill-sentence): Likewise. * rmail.el (rmail-show-message): Use overlays, not text properties. (rmail-overlay-list): New variable. (rmail-mode): Make it local. * subr.el (run-hooks): Don't use mapcar--save consing. Sat Apr 23 01:14:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mail-extr.el (mail-extr-all-top-level-domains): Renamed from all-top-level-domains. * lisp-mode.el (lisp-mode-variables): In comment-start-skip, reject semicolon after a backslash. * frame.el (special-display-frame-alist): New variable. (special-display-popup-frame): New function. (special-display-function): Set it. * rmail.el (rmail-show-message): Highlight the specified fields. (rmail-highlighted-headers): New user variable. * ange-ftp.el (ange-ftp-add-file-entry-alist): Fix typo in prev change. Fri Apr 22 22:31:22 1994 Jamie Zawinski (jwz@lucid.com) * mail-extr.el: Major changes by jwz and drw. * subr.el (run-hook-with-args): New function. Fri Apr 22 22:31:22 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * undigest.el (undigestify-rmail-message): Update summary buffer. Fri Apr 22 20:47:47 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ange-ftp.el: Many doc fixes. * ange-ftp.el (ange-ftp-run-real-handler): New function. (ange-ftp-real-...): Use that. * ange-ftp.el (ange-ftp-gwp-start, ange-ftp-nslookup-host) (ange-ftp-start-process): Bind process-connection-type explicitly. Fri Apr 22 17:51:12 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * hilit19.el: Don't treat $ as special if escaped. Fri Apr 22 00:31:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse-sel.el (mouse-extend): Handle case where posn-window is a frame. * comint.el (comint-mode-map): comint-dynamic-list-input-ring now on C-c C-l. * faces.el (frame-update-faces): New function. * frame.el (set-default-font): Call frame-update-faces. * mouse.el (mouse-set-font): Simply call set-default-font. * font-lock.el (rmail-font-lock-keywords): New variable. (compilation-mode-font-lock-keywords): New variable. (font-lock-set-defaults): Use those vars in those modes. * startup.el (command-line-default-directory): New variable. (command-line, command-line-1): Use and set it. * time.el (display-time): Force use of pipe, not pty. * vc.el (vc-backend-diff): Test of cmp was backwards. Fri Apr 22 12:27:07 1994 Per Abrahamsen (abraham@eupectic) * makefile.el (makefile-mode): Removed extra quote before makefile-warn-suspicious-lines. Thu Apr 21 17:24:14 1994 Boris Goldowsky (boris@moose.cs.rochester.edu) * avoid.el: (mouse-avoidance-point-position): New function, using new `compute-motion' functionality. Use of this fixes bugs involving wrapped lines & horizontally-scrolled windows. * avoid.el: New avoidance mode, "exile", like "banish" but temporary. * avoid.el: Jump/animate modes now keep track of net offset that they have moved the mouse, and try to keep this near 0. No longer wraps to other side of screen. * avoid.el (mouse-avoidance-mode): Update mode line. * avoid.el (mouse-avoidance-*-hook): Do nothing if inside kbd macro. Thu Apr 21 14:44:40 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ispell.el (ispell-use-ptys-p): Doc fix. * gud.el (gud-filter): Call comint-output-filter at the end. Thu Apr 21 15:22:18 1994 Francesco Potorti` (pot@fly.cnuce.cnr.it) * cmacexp.el (c-macro-expansion): changed the algorithm to allow __FILE__ and __LINE__ directives to be expanded correctly. (c-macro-expansion): use a forth optional argument DISPLAY meaning it should print messages at the start and end of preprocessing. All callers changed. (c-macro-expand): Don't display message here. Thu Apr 21 10:38:21 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * info.el (Info-next-preorder): Don't follow footnotes here. (Info-mouse-follow-nearest-node, Info-follow-nearest-node): Split into mouse and keyboard versions. (Info-mode-map): Bind them to mouse-2 and RET. (Info-try-follow-nearest-node): Common subroutine. * ebuff-menu.el (Electric-buffer-menu-mouse-select): New function. (electric-buffer-menu-mode-map): Bind it to mouse-2. Thu Apr 21 09:50:13 1994 Per Abrahamsen (abraham@research.att.com) * ispell.el (ispell-dictionary-alist): Renamed the entry for danish from "dansk" to "danish" in order to conform with reality. Thu Apr 21 02:22:38 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gud.el (gdb, sdb, dbx, xdb, perldb): Set paragraph-start. (gud-mode): Make paragraph-start buffer-local. Thu Apr 21 21:14:01 1994 Simon Marshall (Simon.Marshall@mail.esrin.esa.it) * comint.el (comint-mode): Set comint-last-input-start and comint-last-input-end to valid markers. * comint.el (comint-send-input): Use comint-output-filter to run functions on comint-output-filter-functions. * comint.el (comint-kill-output): Use delete-region to remove, and comint-output-filter to insert. Wed Apr 20 15:55:57 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * server.el (server-kill-emacs-query-function) (server-kill-buffer-query-function): Give names to these hook fns. * sort.el (sort-subr): Use car-less-than-car when appropriate. Wed Apr 20 15:52:48 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-parse-errors): Fix references for column number, 3rd elt not 2nd. Wed Apr 20 02:03:33 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile (TAGS): New target. (lisptagsfiles): New variable. * cmacexp.el: Doc fixes. (c-macro-expansion): Handle a and b comment styles. (c-macro-shrink-window-flag): Renamed from c-macro-shrink-window-p. (c-macro-prompt-flag): Renamed from c-macro-prompt-p. * cmacexp.el: Potorti's changes: Provide cmacexp. (c-macro-prompt-p): Var renamed from c-macro-always-prompt-p. (c-macro-cppflags): Var renamed from c-macro-default-cppflags. (c-macro-expand): Don't handle C-u C-u specially. Compute message here in var mymsg. Clear buffer-auto-save-file-name. (c-macro-display-buffer): Now takes no argument. Use point-max to get large number. (c-macro-default-message, c-macro-eval): Functions deleted. (c-macro-expansion): Use startinstring as the char to insert. Tue Apr 19 20:13:41 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * startup.el (init-file-user): Doc fix. * blessmail.el: New file. * lisp.el (defun-prompt-regexp): Make this variable buffer-local. * emacsbug.el (report-emacs-bug): Insert at separator, not at end. Mon Apr 18 20:48:26 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * rmailsum.el (rmail-summary-rmail-update): Update rmail buffer even if it isn't displayed. * comint.el (comint-replace-by-expanded-history): Expand only at prompt. Pass SILENT flag to comint-replace-by-expanded-history-before-point. Mon Apr 18 20:31:26 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * server.el (kill-buffer-query-functions): Fix the question text. (kill-emacs-query-functions): Fix typo in question text. Mon Apr 18 19:52:58 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * outline.el (outline-end-of-subtree): Stop before final newline. Mon Apr 18 00:02:09 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (shell-command-sentinel): Do nothing if buffer is dead. (shell-command-filter): If point was at end, leave it at end. * menu-bar.el (menu-bar-enable-clipboard): Construct new cons cells. * loaddefs.el: Move pop-global-mark bindings to this file. * simple.el: Move pop-global-mark bindings to loaddefs.el. Sun Apr 17 21:56:49 1994 Per Cederqvist (ceder@signum.se) * hexl.el (hexl-mode): Make local binding for hexl-max-address. Sun Apr 17 21:06:07 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * pascal.el (pascal-outline-map): Move pascal-outline-goto-defun to C-c C-d. Sat Apr 16 02:42:41 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * debug.el (debug, debugger-eval-expression): Preserve match-data. * mouse.el (mouse-drag-region): Handle scroll off top/bottom. Fri Apr 15 19:33:41 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * imenu.el: Require cl only at compile time. (imenu--mouse-menu): Copy list by hand, not with copy-list. * simple.el (auto-fill-function): New function (doc placeholder). * calendar.el (calendar-mode-map): Use substitute-key-definition. Don't mess with kill-region and copy-region-as-kill. * window.el (shrink-window-if-larger-than-buffer): Do nothing for side-by-side windows. * help.el (describe-mode): Always show minor modes, at front. Fri Apr 15 15:24:54 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * mouse.el (mouse-set-font): Don't error if no selection. * startup.el (command-line): If no error data, print "", not nil. * emerge.el (emerge-goto-line): Fix return value. (emerge-convert-diffs-to-markers): Fix line number calculations. * files.el (basic-save-buffer): If selective-display is t, file may end in CR instead of LF. * comint.el: Doc fix. Thu Apr 14 21:12:22 1994 Lars Magne Ingebrigtsen (larsi@bera.ifi.uio.no) * gnus-uu.el (gnus-uu-enter-interactive-file): Escape any special characters in file names. (gnus-uu-call-asynchronous, gnus-uu-treat-archive): Likewise. * gnus-uu.el (gnus-uu-uustrip-article-as): Added more corrections of corrupt uucode. (gnus-uu-uustrip-article-as): Changed the algorithm for finding begin/body lines of encoded articles. (gnus-uu-check-correct-stripped-uucode): Handle extraneous empty lines in uuencoded postings. * gnus-uu.el (gnus-uu-uustrip-article-as, gnus-uu-clean-up): Check before calling process-status. (gnus-uu-uuencode-and-post): Added possibly non-standard posting of uuencoded files. Thu Apr 14 19:29:10 1994 Simon Marshall (Simon.Marshall@mail.esrin.esa.it) * shell.el (shell-replace-by-expanded-directory): Don't display initial message. * shell.el: Properly use define-key-after to change menu-bar. Thu Apr 14 14:39:38 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * comint.el (comint-replace-by-expanded-history-before-point): Advance point unconditionally. * shell.el (shell-dynamic-complete-as-command): Don't match ignored-extensions if it's nil. * rmailout.el (rmail-default-file, rmail-default-rmail-file): Cancel new defvars. Thu Apr 14 03:37:49 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * faces.el (make-face-x-resource-internal): Don't mess with terminal frames. * startup.el (command-line): Call face-initialize before frame-initialize. * faces.el (x-create-frame-with-faces): Create frame invisible, set up the faces, then make it visible. * saveplace.el (save-place-kill-emacs-hook): Fix typo. Wed Apr 13 14:59:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (x-fixed-font-alist): Give multiple names for try for certain fonts. (mouse-set-font): Handle these. * files.el (find-buffer-visiting): Don't check buffer-file-number unless buffer-file-name is non-nil. * dired.el (dired-subdir-regexp): Allow a space in dir name. * rmailout.el (rmail-default-file, rmail-default-rmail-file): New defvars. * apropos.el (super-apropos-check-doc-file): Force Fundamental mode. Wed Apr 13 14:59:51 1994 Stephen Gildea (gildea@x.org) * mh-e.el, mh-utils.el: (mh-progs, mh-lib): Move from mh-e.el to mh-utils.el for Emacs 19.23, which doesn't define them in paths.el. * mh-utils.el (mh-find-progs): Add paths for BSDI. Put local paths first so they override the system's paths. * mh-utils.el (with-mh-folder-updating): Optimize to keep buffer-file-name nil even while restoring modified-p status at end. * mh-e.el (mh-store-buffer): Autoload. Better doc strings. Wed Apr 13 12:17:32 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * comint.el (comint-dynamic-complete-as-filename): Simplify. Wed Apr 13 00:27:28 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * menu-bar.el (mouse-menu-bar-buffers): Put Frames pane behind Buffers. Tue Apr 12 17:47:46 1994 Ethan Bradford (ethanb@ptolemy.astro.washington.edu) * ispell.el (ispell-message): Turn LIMIT into an integer, around ispell-region. Tue Apr 12 01:07:10 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * edt.el (case-flip-character): Make case test more general. * ispell.el: Bind M-$. * subr.el (read-quoted-char): Convert meta chars into 128+ chars. * simple.el (quoted-insert): Do nothing special for meta chars. * backquote.el (backquote-process): Don't crash if ultimate expression is just a variable. * dired-aux.el (dired-add-entry): Set opoint at beginning of line. No need to explicitly discard direcory from file name. Mon Apr 11 17:03:04 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired.el (dired-move-to-filename-regexp): Match the year or time. (dired-move-to-filename): Simplify the code for that. * imenu.el (imenu): Renamed from goto-index-pos. * gnus-uu.el: Doc fixes. (gnus-uu): New function is placeholder for docs. (gnus-uu-summary-next-subject): Do sit-for before gnus-summary-recenter. * emerge.el (menu-bar-emerge-menu): Improve menu title. * edebug.el (eval-reg): Fix the require call. * eval-reg.el: Renamed from eval-region.el. Fix the `provide' call. Doc fixes. * dired.el (dired-move-to-filename): Use skip-chars-forward instead of looking-at, for speed. Mon Apr 11 16:39:35 1994 Per Abrahamsen (abraham@research.att.com) * makefile.el (makefile-mode): make-local-variable misspelled as make-local-file. Mon Apr 11 15:59:29 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * ange-ftp.el (ange-ftp-process-filter): Call comint-output-filter. (ange-ftp-gwp-filter): Likewise. * gud.el (gud-filter): Let comint-output-filter do the hard work. * jka-compr.el (jka-compr-handler): Save match data. * comint.el (comint-dynamic-complete-as-filename): Save end of match before calling other functions. Handle non-match too. * dired.el (dired-move-to-filename): Handle leading blanks. * subr.el (force-mode-line-update): Doc fix. Mon Apr 11 14:22:01 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * easymenu.el (easy-menu-keymap): Don't append `...' to name. Sat Apr 9 20:58:22 1994 Richard Stallman (rms@geech.gnu.ai.mit.edu) * makeinfo.el (makeinfo-region): Fix name of tex-start/end-of-header. Sat Apr 9 17:52:48 1994 Daniel LaLiberte (liberte@churchy.gnu.ai.mit.edu) * cust-print.el: Simplify top-level definition of defalias for Emacs 18. * edebug.el: (keywordp): Remove definition. (edebug-form): Check whether keywordp is defined. Sat Apr 9 15:52:42 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/lk201.el (function-key-map): Use f11, not \e. * term/vt300.el, term/vt320.el, term/vt400.el, term/vt420.el: Replace it with \e here. * files.el (inhibit-first-line-modes-regexps): Renamed from inhibit-local-variables-regexps. Fri Apr 8 22:44:59 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * rmailsum.el (rmail-new-summary): Avoid unsafe save-restriction. Fri Apr 8 01:03:48 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/lk201.el: Support kp-tab, kp-multiply, kp-add, kp-divide. * menu-bar.el (global-map): Bind function keys f16, f18 and f20, which Sun knows as copy, paste and cut. * lmenu.el (popup-dialog-box): New function. Thu Apr 7 20:17:01 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * comint.el (comint-exec-1): Handle both termcap and terminfo. * simple.el (hscroll-window-column): New function. (hscroll-point-visible): Do the right thing in the hard cases. * telnet.el (telnet-initial-filter, read-password): Don't unnecessarily duplicate comint functionality. Thu Apr 7 13:11:29 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * calendar.el: Many doc fixes. (general-holidays, *-holidays): Add risky-local-variable property. * cal-dst.el (calendar-daylight-savings-ends) (calendar-daylight-savings-ends): Add risky-local-variable property. * files.el (hack-one-local-variable): Treat varnames ending in -form or -forms like eval. (hack-one-local-variable): Test for risky-local-variable property. Put such properties on some variables, including minor-mode-map-alist. * edebug.el (edebug-version): Delete third arg of string-match. * term/x-win.el: If server is a Sun, call menu-bar-enable-clipboard. Thu Apr 7 10:18:46 1994 Frederic Pierresteguy (fp@hal.gnu.ai.mit.edu) * rmail.el (rmail-secondary-file-menu): Fix typo. Thu Apr 7 03:18:02 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (define-key-after): Doc fix. Wed Apr 6 23:10:23 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * rmailsum.el (rmail-summary-disable): New function. (rmail-summary-enable): New function. (rmail-summary-mode): Call rmail-summary-enable. * rmailedit.el (rmail-edit-mode): Disable summary during edit. (rmail-cease-edit): Re-enable summary. * replace.el (replace-regexp): Fix misbalanced quotes. * rmailsort.el (rmail-sort-by-keywords): New function. * rmailsum.el (rmail-summary-sort-by-keywords): New function. * rmail.el (rmail-mode-map): Key binding for rmail-sort-by-keywords. * info.el (Info-find-node): Don't try to backstep if no history. (Info-insert-dir): Print sensible error message if no dir node. Wed Apr 6 00:13:13 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * replace.el: Doc fixes. * term/wyse50.el (kill-emacs-hook): Use add-hook. * saveplace.el (save-place-find-file-hook) (save-place-kill-emacs-hook): New functions. (hooks for find-file-hooks,kill-emacs-hook): Use those new functions. * menu-bar.el (clipboard-yank, clipboard-kill-ring-save) (clipboard-kill-region): New functions. Give them menu-enable properties and bind the PASTE, COPY and CUT keys. (menu-bar-enable-clipboard): New function. * term/x-win.el (x-select-enable-clipboard): New variable. (x-select-text, x-cut-buffer-or-selection-value): Obey it. * term/x-win.el (x-handle-args): Doc fix. Tue Apr 5 23:46:41 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (quoted-insert): Handle meta-chars usefully. Tue Apr 5 20:50:59 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * dired-x.el: New version from maintainer. Tue Apr 5 19:52:04 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * timer.el (timer-kill-emacs-hook): New function. (kill-emacs-hook): Add the new hook. * cc-mode.el: Large changes. Tue Apr 5 17:53:59 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * rmailsum.el (rmail-summary-goto-msg): Fix bug in earlier change. Tue Apr 5 16:55:08 1994 Daniel LaLiberte (liberte@churchy.gnu.ai.mit.edu) * cust-print.el: Change install-* and uninstall-* to *-install and *-uninstall. * eval-region.el: Change install-* and uninstall-* to *-install and *-uninstall. Mon Apr 4 23:38:27 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * man.el (manual-program): New (actually reintroduced) variable. (Man-getpage-in-background): Don't hardcode the program name. Mon Apr 4 21:53:40 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (auto-save-mode): Don't let buffer-saved-size stay negative. Mon Apr 4 21:34:23 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * calendar.el (calendar-cursor-to-date): Fix to signal error when appropriate. Mon Apr 4 20:28:21 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * edebug.el (edebug-emacs-19-specific): Renamed from edebug-fsf19-specific. (edebug-emacs-version-specific): Test for not-version-18. * view.el (view-mode-map): Don't bind C-z. Mon Apr 4 18:59:33 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * calendar.el (generate-calendar-month): Add mouse-face properties. * simple.el (completion-setup-function): Add mouse-face properties. * window.el (split-window-vertically): If size is negative, measure from bottom. Mon Apr 4 17:48:16 1994 Daniel LaLiberte (liberte@spiff.gnu.ai.mit.edu) * edebug.el Change "-emacs-" to "-original-" throughout. (edebug-last-sexp): Fix missing ";;" (edebug-read): Fix docstring, &optional arg, and the check that stream is current-buffer. (edebug-install-read-eval-functions): Use (elisp-eval-region-install). (edebug-uninstall-read-eval-functions): Restore to function values. (edebug-eval-defun): Repair check for edebug-all-defs. (edebug-top-level-form): Set edebug-all-defs to t. (edebug-read-and-maybe-wrap-form1): Call edebug-original-read instead of read. (edebug-enter): Bind pre-command-hook and post-command-hook to nil. Reset these variables and executing-macro to outside values. (edebug-display): Reset global variables to outside values. (edebug-recursive-edit): Reset global variables to outside values. (edebug-outside-excursion): Set outside values of global variables in case they were changed by side effect. (edebug-instrument-callee): Use edebug-original-read instaed of read. (edebug-eval-result-list): While evaluating evaluation list, bind edebug-execution-mode and edebug-trace to nil. Mon Apr 4 16:20:06 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * uncompress.el (uncompress-program): New variable. (uncompress-backup-file): Use it. (uncompress-while-visiting): Use that var. Handle .gz suffix. (auto-mode-alist): Handle .gz suffix. (find-compressed-version): Handle .gz suffix. Sun Apr 3 11:50:22 1994 Lawrence R. Dodd (dodd@roebling.poly.edu) * fortran.el (fortran-blink-matching-do): New function, basically copied from fortran-blink-matching-if. (fortran-indent-line): Call it. (fortran-mode): Doc mod. Mon Apr 4 01:45:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (version-control): Doc fix. * rmailsum.el (rmail-summary-goto-msg): Highlight the whole line except first char. Sat Apr 2 10:00:00 1994 Karl Fogel (kfogel@phylo.life.uiuc.edu) * saveplace.el (save-place-version-control): New var, for determining how to back up the master saved-places file. (save-place-alist-to-file): Bind version-control depending on `save-place-version-control'. (hook for find-file-hooks): Specify the APPEND arg to add-hook. Fri Apr 1 15:03:52 1994 Ethan Bradford (ethanb@ptolemy.astro.washington.edu) * ispell.el (ispell-message): Fixed infinite loop on shortened msg. Fri Apr 1 23:09:23 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * buff-menu.el (Buffer-menu-mode): Add mouse-face properties. (Buffer-menu-buffer-name-position): New function. * tar-mode.el (summarize-tar-header-block): Add mouse-face properties. * compile.el (compile-mouse-goto-error): Simplify. (compilation-parse-errors-function): Doc fix. Fri Apr 1 05:09:42 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * replace.el (occur): Add mouse-face property to each line. * dired.el (dired-insert-directory): Add mouse-face properties. (dired-insert-set-properties): New subroutine. * dired-aux.el (dired-add-entry, dired-insert-subdir-doinsert): Call dired-insert-set-properties. (dired-add-entry): Don't make name absolute; bind default-directory. * info.el (Info-fontify-node): Add mouse-face properties. Increase size limit for fontifying to 30000. Thu Mar 31 21:28:53 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * rmailkwd.el (rmail-message-label-p, rmail-parse-message-labels): Update obsolete (commented-out) functions. Thu Mar 31 18:39:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * unrmail.el, rmailout.el: Doc fixes. Thu Mar 31 17:00:25 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * man.el (Man-filter-list): New footer format to delete. Thu Mar 31 11:05:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tar-mode.el: Fix error message syntax. (tar-mode): Doc fix. (tar-mouse-extract): New command. (tar-mode-map): Bind mouse-2. (tar-get-descriptor): New function. (tar-extract, tar-copy): Use that. (tar-mode-maybe-write-tar-file): Renamed from maybe-write-tar-file. * buff-menu.el (Buffer-menu-mouse-select): New command. (Buffer-menu-mode-map): Bind mouse-2. (Buffer-menu-mode): Doc fix. * replace.el (occur-mode): Doc fix. (occur-mode-goto-occurrence): Delete excess close paren. * dired.el (dired-mouse-find-file): Use same window. Renamed from ...-other-window. Wed Mar 30 12:21:35 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * replace.el (occur-mode-find-occurrence): New subroutine. (occur-mode-goto-occurrence): Use that. (occur-mode-mouse-goto): New command. (occur-mode-map): Bind mouse-2. (occur-mode-find-occurrence): Error if point is on first line. * compile.el (compile-mouse-goto-error): New command. (compilation-minor-mode-map): Bind mouse-2. * dired.el (dired-mouse-find-file-other-window): New command. (dired-mode-map): Bind mouse-2. Tue Mar 29 21:19:45 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * rmailsort.el (rmail-sort-messages): Update summary buffer. (rmail-sort-messages): Use buffer-disable-undo, not buffer-flush-undo. * rmailsum.el (rmail-sort-from-summary): Preserve window selection. Tue Mar 29 20:42:38 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc.el (vc-checkin): Undo previous change. * help.el (help): New alias. (help-for-help): Mention help character. (help-quit): New command. (help-map): Bind `q'. Tue Mar 29 02:06:29 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * c-mode.el (calculate-c-indent): Don't loop forever at bobp. (calculate-c-indent, indent-c-exp): Test char against 0, not nil. * font-lock.el: Check for existence of windowing system. * files.el (hack-local-variables-prop-line): Search two lines if "#!". Ignore keyword `mode', since it's already been handled. Mon Mar 28 20:35:16 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * debug.el (debug): Behave sensibly if pop-up-frames is set. * info.el (Info-suffix-list): Put empty string last. (info-insert-file-contents): Allow filename to already be suffixed. Mon Mar 28 18:58:07 1994 Roland McGrath (roland@mole.gnu.ai.mit.edu) * vc.el (vc-checkin): Insert name of current defun in comment buffer. * add-log.el (add-log-current-defun): Autoload this. Mon Mar 28 18:11:23 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * forms.el (forms-mode): Set major mode before finding forms-file. Mon Mar 28 00:08:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (basic-save-buffer-1): New subroutine, broken out of basic-save-buffer. (basic-save-buffer): Use basic-save-buffer-1. * bytecomp.el (byte-compile-file): Use whole file name for errors. * subr.el (momentary-string-display): Avoid modifying the undo list. * startup.el: Doc fixes. Sun Mar 27 14:43:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (set-match-data): New alias. * mouse.el (mouse-choose-completion): Use choose-completion-string. (mouse-completion-delete-max-match): Moved to simple.el. * simple.el (choose-completion-delete-max-match): Renamed from mouse-completion-delete-max-match and moved here. (choose-completion-string): New function. (choose-completion): New command. (completion-list-mode-map): Add binding for choose-completion. (completion-setup-function): Mention RET. * vc-hooks.el (vc-find-file-hook): Set backup-inhibited. * files.el (set-visited-file-name): Kill local var vc-mode. Make buffer writable if was read-only due to vc. Sat Mar 26 00:22:31 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * loadup.el: Don't test for presence of dump-emacs. Use `dump' argument as criterion for copying DOC, for running top-level, and for extending the version number. Delete the sleep-for. * emerge.el (emerge-goto-line): New function. (emerge-convert-diffs-to-markers): Use it. * simple.el (blink-matching-open): Now three strategies for choosing the text to display when the matching open is off screen. * info.el (Info-insert-dir): Add a save-excursion. Require menu items for subnodes to end in ::. Fri Mar 25 17:59:01 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gud.el (gud-comint-buffer): Move defvar up. Fri Mar 25 08:45:35 1994 Rick Sladkey (jrs@world.std.com) * gud.el (gud-gdb-complete-command): New defun to support true GDB completion in the GUD buffer. Requires assistance from GDB in the form of the `complete' command. (gud-gdb-complete-in-progress, gud-gdb-complete-string, gud-gdb-complete-break, gud-gdb-complete-list, gud-gdb-complete-filter): New. (gdb): Bind TAB to gud-gdb-complete-command. Fri Mar 25 02:48:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * easymenu.el: New file. Thu Mar 24 15:45:15 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * apropos.el (apropos-match-keys): Skip duplicate keybindings. * menu-bar.el (mouse-menu-bar-buffers): Fix position structure. Thu Mar 24 15:27:20 1994 Daniel LaLiberte (liberte@spiff.gnu.ai.mit.edu) * edebug.el: New version from author. * cust-print.el Change "internal" to "original" throughout. (add-custom-printer, delete-custom-printer) replace old customizers. (with-custom-print) new (custom-prin1-to-string) Made it more robust. Wed Mar 23 21:51:12 1994 Simon Marshall (simonm@penelope) * comint.el (comint-run): New command. (comint-watch-for-password-prompt): New function. (comint-mode, comint-show-output): Doc fix. * comint.el (comint-replace-by-expanded-history): Add menu-enable property. * shell.el (shell-strip-ctrl-m): New command. (shell-mode): Doc fix. (shell-dynamic-complete-as-command): Use comint-dynamic-simple-complete. Wed Mar 23 15:46:48 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * rmailsort.el (rmail-sort-by-subject): Fix `Re:' regexp. * nroff-mode.el (nroff-mode-abbrev-table): Call define-abbrev-table. Wed Mar 23 13:22:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-secondary-file-menu): Display relative file names. (rmail-output-menu): Autoload it. (rmail-mode-map): Add rmail-output-menu and rmail-input-menu. (rmail-quit): Remove summary buffer from display. Thoroughly remove Rmail buffer from display. Tue Mar 22 00:43:34 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * help.el (where-is): New function. * sort.el (sort-subr): Add autoload. * asm-mode.el (asm-mode): Doc fix. * debug.el (debugger-eval-expression): Use a history list. * skeleton.el, sh-script.el: New files. Mon Mar 21 20:40:29 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * register.el (jump-to-register): Handle dead marker. Mon Mar 21 19:27:19 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * map-ynp.el (map-y-or-n-p): Don't add any text to the ACTION-ALIST descriptions to make dialog box buttons. Mon Mar 21 01:11:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (insert-directory): Quote special shell chars, aside from wildcards and quoting characters. * loaddefs.el (mode-line-buffer-identification): Doc fix. Sun Mar 20 19:36:26 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * lmenu.el (make-lucid-menu-keymap): Any row of dashes means blank. Sun Mar 20 18:22:43 1994 Lawrence R. Dodd (dodd@roebling.poly.edu) * sendmail.el (mail-mode): Doc mod. Sun Mar 20 02:04:50 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * select.el (x-valid-simple-selection-p): Accept an overlay. (xselect-convert-to-string, xselect-convert-to-length): (xselect-convert-to-filename xselect-convert-to-charpos): (xselect-convert-to-lineno, xselect-convert-to-colno): Likewise. * subr.el (one-window-p): New argument all-frames. * map-ynp.el (map-y-or-n-p): Call x-popup-dialog the new way. Sat Mar 19 21:37:29 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * paths.el (mh-progs, mh-lib): Deleted. * tex-mode.el (tex-delete-last-temp-files): New arg NOT-ALL. (tex-region): Pass new arg. * help.el (help-with-tutorial): Change previous change; reduce threshold to 12 lines. Fri Mar 18 23:31:28 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * iso-acc.el (iso-accents-list): Add entries for unadorned accents. Fri Mar 18 22:14:05 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lmenu.el: Provide lmenu, not menubar. * rmailsum.el (rmail-summary-goto-msg): Highlight message number of current message. Fri Mar 18 23:06:26 1994 Michael D. Ernst (mernst@research.microsoft.com) * lisp.el (beginning-of-defun-raw): Don't err when called at end of buffer. Fri Mar 18 21:55:14 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * help.el (help-with-tutorial): Avoid unexplained large blank area. * disp-table.el (create-glyph): Don't use slots that look like ASCII. (standard-display-ascii): Error if using a windowing system. (standard-display-g1, standard-display-graphic): Ditto. (standard-display-underline): If window system, use underline font. Fri Mar 18 06:54:31 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-error-regexp-alist): Generalize ultrix 3 f77 regexp to match Absoft FORTRAN 77 errors. * replace.el (perform-replace): Set match-data markers to nil before discarding them. * map-ynp.el (map-y-or-n-p): Use a dialog box when triggered by a mouse event. Fri Mar 18 01:27:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmailout.el (rmail-output-menu): New command. * rmail.el (rmail-summary-window-size): New variable. (rmail-maybe-display-summary): Use it. (rmail-secondary-file-directory): New var. (rmail-secondary-file-regexp): New var. (rmail-secondary-file-menu): New function. (rmail-input-menu): New command. Fri Mar 18 00:54:37 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * telnet.el (telnet-maximum-count): Doc fix. Thu Mar 17 18:28:38 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * term/x-win.el (x-cut-buffer-or-selection-value): Check for error from x-get-selection. * lisp.el (end-of-defun): Fix check for trailing comment. * lisp.el (beginning-of-defun-raw): New function. (end-of-defun): Handle defun-prompt-regexp correctly. * rmail.el (rmail-convert-to-babyl-format): Check Content-Length field for consistency. Wed Mar 16 11:32:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (undo): Don't let the undo entries for the undo contain a specific buffer position. Delete it if there is one. * foldout.el: New file. * version.el (emacs-version): Use system-configuration. Tue Mar 15 00:06:50 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * man.el (manual-entry): Document what the arg does. * lisp.el (defun-prompt-regexp): Doc fix. * man.el (Man-original-frame): New variable. (Man-getpage-in-background): Save the frame that man was invoked in. (Man-notify-when-ready): Restore it, if appropriate. Mon Mar 14 21:50:20 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * gud.el (gud-filter): Update comint-last-input-end. * man.el (Man-filter-list): Extend footer pattern for hpux. (Man-cooked-hook): New variable. (Man-bgproc-sentinel): Run Man-cooked-hook after cleaning backspaces. Mon Mar 14 17:35:08 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * hilit19.el (LaTeX patterns): Don't match \( and \[ following a \. * man.el (Man-build-man-command): Redirect desc 2 to /dev/null. (Man-getpage-in-background): Require env before printing message. * mh-comp.el, mh-funcs.el, mh-mime.el, mh-pick.el, mh-seq.el, mh-utils.el: New files. * mh-e.el: Version 4.0 from Gildea. Mon Mar 14 16:18:40 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * info.el (Info-insert-dir): Use printable escapes instead of embedding literal control chars in the source. * underline.el (underline-region, ununderline-region): Ditto. * edt.el (indent-or-fill-region): Ditto. * page-ext.el (original-page-delimiter, set-page-delimiter): Ditto. * register.el (view-register, insert-register): Handle dead marker. Mon Mar 14 11:00:27 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * view.el (view-mode): Run view-mode-hook as well as view-hook. (view-mode-hook): New defvar. Sun Mar 13 16:52:32 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * text-mode.el (text-mode): Doc fix. Sat Mar 12 19:38:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * diff.el (diff-latest-backup-file): Call file name handler properly. * outline.el (hide-other, hide-sublevels): Renamed from outline-... Fri Mar 11 19:17:04 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * rmailsort.el (rmail-sort-by-lines): msgnum variable should be msg. * appt.el: Doc fix. * add-log.el, ange-ftp.el, cplus-md.el, dired-aux.el, dired.el, files.el, gnus.el, ispell.el, subr.el, texinfmt.el: Don't use triple-hyphen in a character class. * scheme.el (scheme-let-indent): Put hyphen in a safer place in the character class. * terminal.el (te-parse-program-and-args, te-quote-arg-for-sh): Ditto. Fri Mar 11 13:08:25 1994 Espen Skoglund (espensk@lglab17.cs.uit.no) * pascal.el (pascal-indent-case): Handle comma separated list. (pascal-set-auto-comments): No comment after record block. (pascal-seperator-keywords): Renamed to pascal-separator-keywords. (pascal-get-lineup-indent): Handle multiple declarations on same line. Thu Mar 10 18:44:54 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * mouse.el (mouse-kill): Select the clicked window first. * outline.el: (outline-mode, outline-level): Doc fix. (outline-on-heading-p): Use bolp, not bobp. (outline-hide-other): Rename from hide-other. (outline-hide-sublevels): Rename from hide-sublevels. (outline-back-to-heading): Error if no previous heading. (outline-next-visible-heading): Check for search failure. (outline-hide-sublevels): Ignore text before first outline heading. (outline-level): Count characters, not columns, so ^L is level 1. Thu Mar 10 02:26:16 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * shell.el (shell-dynamic-complete-as-command): Make ignored-extensions nil if comint-completion-fignore is nil. * files.el (find-buffer-visiting): Don't compare NUMBER if it is nil. * man.el (Man-filter-list): Don't insist on `...done' after `wait'. Match `Reformatting entry. Wait'. * rmail.el (rmail-ignored-headers): Add several x400 header types. * ispell.el (ispell-pdict-save, ispell-kill-ispell, ispell-continue): (ispell-help): Add autoloads. * bookmark.el (kill-emacs-hook): Don't autoload this hook. (bookmark-menu-bar-delete, bookmark-menu-bar-rename) (bookmark-menu-bar-locate, bookmark-menu-bar-jump) (bookmark-menu-bar-insert): Add autoloads. * emerge.el (emerge-revisions, emerge-revisions-with-ancestor) (emerge-merge-directories): Add autoloads. Wed Mar 9 23:00:50 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * loadup.el: Preload menu-bar. Prescan the menu bar keymaps for keyboard equivalents. * term/x-win.el: Turn on menu-bar-mode. * autoload.el (generate-file-autoloads): Don't ignore the line after the form marked by a ;;;###autoload\n. * menu-bar.el: Delete the `>' from various menu item strings. * emerge.el (menu-bar-emerge-menu): Autoload the whole setup. * bookmark.el (menu-bar-bookmark-map): Autoload the whole setup. * ispell.el (ispell-menu-map): Autoload the whole setup. (ispell-dictionary-alist): Add autoload. (ispell-menu-map): Don't redefine if already defined. Don't test for menu-bar since this is now done before menu-bar. Wed Mar 9 01:41:10 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * outline.el (outline-regexp): Initialize outside the defvar. * nroff-mode.el (nroff-mode): Deleted garbage character. Tue Mar 8 13:56:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * text-mode.el (indented-text-mode): Run indented-text-mode-hook. * derived.el: Renamed from mode-clone.el. All functions renamed. (define-derived-mode): Renamed from define-mode-clone. Tue Mar 8 07:38:42 1994 Simon Marshall (simonm@penelope) * comint.el (comint-completion-fignore): New variable. (comint-dynamic-complete-as-filename): Use it. * shell.el (shell-completion-fignore): New variable. (shell-mode): Use it to set comint-completion-fignore. (shell-dynamic-complete-as-command): Use it. Tue Mar 8 18:31:05 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * mouse.el (mouse-minibuffer-check): New function to disallow mouse events in an inactive minibuffer. All relevant mouse functions changed to use it. * files.el (find-buffer-visiting): New function to look for another buffer visiting the same inode. (find-file-noselect): Use it instead of inline code. * apropos.el (super-apropos-check-doc-file): Use doc-directory instead of data-directory. (apropos, super-apropos): Doc fix. Tue Mar 8 13:56:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * derived.el: Renamed from mode-clone.el. All functions renamed. (define-derived-mode): Renamed from define-mode-clone. Tue Mar 8 07:38:42 1994 Simon Marshall (simonm@penelope) * comint.el (comint-completion-fignore): New variable. (comint-dynamic-complete-as-filename): Use it. * shell.el (shell-completion-fignore): New variable. (shell-mode): Use it to set comint-completion-fignore. (shell-dynamic-complete-as-command): Use it. Tue Mar 8 00:49:35 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (etags-list-tags): Check for explicit tag names. * etags.el (etags-tags-completion-table): Let the line number or char pos be empty. (etags-snarf-tag): Look for line number as well as char pos. Let either be empty; return both. (etags-goto-tag-location): Arg also contains line number. If char pos is nil, use line number. Mon Mar 7 17:56:16 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * bytecomp.el (byte-compile-track-mouse): Undo previous change, but use byte-compile-top-level-body. Mon Mar 7 17:31:56 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compile-reinitialize-errors): Rename first arg from ARGP to REPARSE. Test only its nilness. (compile-goto-error): Pass (consp ARGP) to compile-reinitialize-errors instead of ARGP itself. (next-error): Code broken out into two new functions; call them. (compilation-next-error-locus): New function; bulk of code from next-error. Silently skip errors whose source loci are markers in killed buffers. (compilation-goto-locus): New function, final code from next-error. Mon Mar 7 14:44:27 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * gud.el (gdb): Use a minibuffer map with TAB to complete a filename. * simple.el (comment-column): Doc fix. Sun Mar 6 21:28:53 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-choose-completion): Bury the completion buffer. * mouse-sel.el: Doc fixes. Mon Mar 7 11:57:42 1994 Mike Williams (mikew@pooh.dosli.govt.nz) * mouse-sel.el (mouse-sel-insert-at-point): New variable. (mouse-insert-selection): Don't move point if mouse-sel-insert-at-point is non-nil. Sun Mar 6 14:37:40 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * backquote.el (backquote-listify): Renamed from bq-listify. (backquote-process): Renamed from bq-process. (backquote-list*-function): Renamed from list*-function. (backquote-list*-macro): Renamed from list*-macro. (backquote-list*): Renamed from list*. * backquote.el: Complete rewrite by Sladkey. Sun Mar 6 12:11:38 1994 Michael D. Ernst (mernst@monozygote) * edebug.el (edebug-skip-whitespace): Only \n, not \r, ends a comment. Sat Mar 5 18:28:21 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s-region.el: New file. * jka-compr.el (jka-compr-insert-file-contents): Handle 5th arg. Fri Mar 4 18:07:53 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * rmail.el (rmail-message-filter): Doc fix. Fri Mar 4 15:48:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * bytecomp.el (byte-compile-track-mouse): Handle >1 body form. Generate code that binds track-mouse. * font-lock.el (c++-font-lock-keywords-1, c++-font-lock-keywords-2): New variables. (c++-font-lock-keywords): Use c++-font-lock-keywords-1. Fri Mar 4 01:12:04 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compile-goto-error): Push the mark before calling next-error. Thu Mar 3 20:29:06 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el (system-key-alist): Fix the code value for `remove'. * ange-ftp.el (ange-ftp-nslookup-host, ange-ftp-start-process): Bind default-directory to some accessible directory, if necessary. Thu Mar 3 10:15:31 1994 Michael D. Ernst (mernst@research.microsoft.com) * bytecomp.el (byte-compile-insert-header): Take a filename argument. (byte-compile-from-buffer): Change second argument to filename. Always return outbuffer; never eval from it or kill it. (byte-compile-file): Pass filename to byte-compile-from-buffer. Thu Mar 3 19:04:39 1994 Karl Heuer (kwzh@churchy.gnu.ai.mit.edu) * c-mode.el (c-fill-paragraph): Preserve final sentence boundary. Thu Mar 3 18:33:35 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el (comint-input-filter-functions) (comint-output-filter-functions): Renamed from ...-sentinel-functions. * shell.el: Rename comint-input-filter-functions and comint-output-filter-functions. (shell-mode): Put dir tracker on comint-input-filter-functions, not ...output... (shell-directory-tracker, shell-process-popd): Call just error, not message and error. Thu Mar 3 23:39:40 1994 Simon Marshall (Simon.Marshall@mail.esrin.esa.it) * cmuscheme.el (inferior-scheme-mode): Removed unnecessary initialisation of comint-input-sentinel. * shell.el (shell-dynamic-complete-functions): New variable. (shell-mode): Use it to set comint-dynamic-complete-functions. * shell.el (shell-mode-map): Define menu-bars for command, variable and directory completion/expansion. * shell.el (shell-get-current-command, shell-after-partial-filename): Functions deleted. * shell.el (shell-dynamic-complete-environment-variable, shell-replace-by-expanded-directory): New commands. (shell-match-partial-variable, shell-dynamic-complete-as-environment-variable): New functions. * comint.el (comint-after-partial-filename-command, comint-dynamic-complete-filename-command, comint-dynamic-complete-command-command, comint-get-current-command): Deleted. * comint.el (comint-input-sentinel-functions): Replaces comint-input-sentinel. (comint-input-sentinel): Deleted. (comint-send-input): Run hooks on comint-input-sentinel-functions. (comint-output-sentinel-functions): Renamed from comint-output-filter-functions. * comint.el (comint-dynamic-complete-functions): New variable. * comint.el (comint-mode-map): Removed menu-bar for command and variable completion. * comint.el (comint-exec-1): Add to environment by hand; avoids using setenv. * comint.el (comint-replace-by-expanded-history-before-point): Renamed from comint-replace-by-expanded-history. (comint-replace-by-expanded-history): New wrapper definition. * comint.el (comint-word): New function. (comint-match-partial-filename): Use it. (comint-after-partial-filename, comint-match-partial-variable, comint-dynamic-complete-variable): Deleted. * comint.el (comint-dynamic-complete): Run hooks on comint-dynamic-complete-functions. * comint.el (comint-dynamic-complete-as-filename): Renamed from function comint-dynamic-complete-filename. (comint-dynamic-complete-filename): New wrapper definition. * comint.el (comint-dynamic-simple-complete): Return a symbol representing completion. Thu Mar 3 17:13:52 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * autoload.el (generate-file-autoloads): Move misplaced paren in match clause of cond so copying the rest of the line to the output is the else clause of if (eolp), not after the if. Thu Mar 3 16:12:09 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * server.el (server-switch-buffer): Don't select a minibuffer. Thu Mar 3 13:26:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * outline.el (outline-on-heading-p): Use bolp. (show-children): Use outline-back-to-heading. (outline-next-preface): Don't retreat over \n or ^M if no more headers. * simple.el (current-word): Check properly for bolp. New optional arg STRICT. Doc fix. Thu Mar 3 12:37:53 1994 Christian Lynbech (lynbech@daimi.aau.dk) * appt.el: Better use add-hook than setq when setting display-time-hook Thu Mar 3 11:25:57 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * files.el (buffer-file-truename): Doc fix. * subr.el (substitute-key-definition): Avoid infinite recursion. Wed Mar 2 20:13:50 1994 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * lunar.el (lunar-phase): Use calendar-mod instead of % so that it works for negative phase numbers. Wed Mar 2 11:40:34 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (completion-list-mode): Set completion-reference-buffer to the buffer for which the completions were requested. (completion-reference-buffer): New variable. * mouse.el (mouse-choose-completion): Use that as the buffer to edit. * comint.el (full-copy-sparse-keymap): Function deleted. (comint-arguments): Use just one regexp to find end of arg and detect whether it has any quotes. (comint-delim-arg): Don't check for quotes. Use loop, not regexps. (comint-delimiter-argument-list): List now has chars, not strings. * shell.el (shell-delimiter-argument-list): Now has chars, not strings. * telnet.el (telnet): Use chars in comint-delimiter-argument-list. * shell.el (shell-mode-map): Use copy-keymap. (shell-dirtrackp): Variable definition added. * inf-lisp.el (inferior-lisp-mode-map): Use copy-keymap. * cmuscheme.el (inferior-scheme-mode-map): Use copy-keymap. * comint.el (comint-mode-map): Rename `input' to `inout' as menu key. Don't put `output' in menu-bar-final-items. Wed Mar 2 19:46:19 1994 Espen Skoglund (espensk@stud.cs.uit.no) * pascal.el (pascal-calculate-indent): Fixed indentation bug in for-loops, with-structures and else-structures. (pascal-noindent-re): Add `else'. Wed Mar 2 05:27:55 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * diff.el (diff-latest-backup-file): Check for a file-name-handler and run it. Wed Mar 2 02:53:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * makefile.el (makefile-mode): Set local-write-file-hooks, not write-file-hooks. Wed Mar 2 00:28:02 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * faces.el (copy-face): Don't change old-face and new-face before the frame loop. * term/x-win.el (iconify-or-deiconify-frame): Don't make invisible before making visible. Wed Mar 2 00:24:53 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (tags-add-tables): Change default value to 'ask-user; update doc. (visit-tags-table-buffer): If tags-add-tables is nil, never add to current list; if t, always; if non-nil, non-t, ask user. Wed Mar 2 07:24:55 1994 Thomas Neumann (tom@smart.bo.open.de) * makefile.el: Version 1.16. (makefile-mode): Correct `make-variable-buffer-local' to `make-local-variable'. Set indent-tabs-mode to t. * makefile.el (makefile-insert-macro-ref): Do not append a space to the inserted macro reference. (makefile-insert-macro-ref): Likewise if the reference is to one of makefile-runtime-macros-list. (makefile-format-macro-ref): If the name of the macro ref starts with a '(' or '{' then the enclosing parentheses are not added. * makefile.el (makefile-warn-suspicious-lines): New function. * makefile.el: Changed mode name to "Makefile" instead of "makefile". Tue Mar 1 23:40:46 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * term/x-win.el (iconify-or-deiconify-frame): Force temporary invisibility even if this is the only frame. Tue Mar 1 22:42:53 1994 Ed Reingold (reingold@goldman.gnu.ai.mit.edu) * calendar.el: (calendar-current-date): Use fixed assoc list for month names so that changing the array of names doesn't screw up the determination of the current date. Tue Mar 1 14:57:59 1994 Ethan Bradford (ethanb@ptolemy.astro.washington.edu) * ispell.el (ispell-message-text-end): New variable. (ispell-message): Use ispell-message-text-end. Spell check all of a multi-line subject. Correct bug whereby internally generated messages were not recognized. Tue Mar 1 17:28:34 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-do-fcc): Don't write a newline before the text. * pascal.el (pascal-sub-block-re): Recognize for and with. Tue Mar 1 01:18:27 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * info.el (Info-restore-point): Don't wipe out hl before using it. * picture.el (picture-forward-column, picture-backward-column): Allow backward motion across multi-column characters. Mon Feb 28 23:37:50 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * startup.el (inhibit-startup-echo-area-message): Doc fix. * two-column.el (tc-mode-map): Fix binding of tc-dissociate. Sat Feb 26 22:25:28 1994 David J. MacKenzie (djm@geech.gnu.ai.mit.edu) * avoid.el: Fix comment typos. Fri Feb 25 23:32:07 1994 Michael D. Ernst (mernst@monozygote) * menu-bar.el (menu-bar-mode): Make menu-bar-mode without an argument toggle display of a menu bar. Fri Feb 25 22:42:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el (system-key-alist): Renamed from vendor-key-syms. Fri Feb 25 19:07:34 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * comint.el (comint-exec-1): Force a local copy of the environment. * font-lock.el: Clean up c-font-lock-keywords; now slightly more consistent about highlighting declarations. Fri Feb 25 01:24:09 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cmacexp.el (c-macro-display-buffer): Delete special view-mode hack. (c-macro-expansion): Parse from 1 to START just once. Avoid counting lines. Use ???!!!???!!! to mark start of the region we want to look at. Thu Feb 24 18:16:01 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * files.el (set-visited-file-name): Unlock the file if setting the visited file name to nil. * buff-menu.el (Buffer-menu-toggle-read-only): Change toggle-read-only to vc-toggle-read-only. * help-macro.el (make-help-screen): Initialize help-screen before changing the keymap. * help.el (help-for-help): Use help-map in the docstring. Thu Feb 24 18:02:49 1994 Hans Chalupsky (hans@hydra.cs.buffalo.edu) * bytecomp.el (byte-compile-protect-from-advice): New macro that temporarily deactivates advice of `defun/defmacro' while BODY is run. (byte-compile-from-buffer, byte-compile-top-level): Use `byte-compile-protect-from-advice' to protect compilation. Thu Feb 24 03:30:19 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * c-mode.el (c-mode): Set outline-regexp and outline-level. (c-outline-level): New function. * nroff-mode.el (nroff-mode): Set outline-regexp and outline-level. (nroff-outline-level): New function. * lisp-mode.el (lisp-mode-variables): Set outline-regexp. * outline.el (outline-minor-mode-prefix): Change to C-c C-o. (hide-sublevels, hide-other): New functions. (outline-mode-map): New key bindings. New menu bindings. * macros.el (insert-kbd-macro): Handle C-@, C-[, etc. properly and their meta variants too. Wed Feb 23 18:15:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * server.el (kill-emacs-query-functions, kill-buffer-query-functions): Add functions to these lists. * files.el (kill-emacs-query-functions): New variable. (save-buffers-kill-emacs): Use it. * info.el (Info-build-node-completions): Add a call to widen. (Info-goto-emacs-command-node): Fix paren error. Fix typo in message. (Info-restore-point): Use iteration instead of recursion. * debug.el (debug, debug-on-entry): Doc strings. Wed Feb 23 14:16:33 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * bytecomp.el (byte-compile-file): Return nil on failure. Wed Feb 23 09:57:11 1994 Gregor Schmid (schmid@fb3-s7.math.tu-berlin.de) * tcl-mode.el (tcl-mode-menu): Move defvar. New order for menu entries. Wed Feb 23 00:00:38 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tcl-mode.el (tcl-mode): Handle files that don't start with #. (tcl-mode-menu): New keymap. (tcl-setup-keymap): Use tcl-mode-menu. * mouse.el (help-menu-map): Variable deleted, and its binding. (mouse-select-window): New command, now on mode-line mouse-1. (mouse-delete-other-windows): Now on mode-line mouse-2. (mouse-split-window-horizontally): Now on mode-line C-mouse-2. * subr.el (posn-x-y): New function. (posn-col-row): Convert coords from pixels to glyph units. Tue Feb 22 15:56:56 1994 Jay K. Adams (jka@mustang.ece.cmu.edu) * jka-compr.el: (jka-compr-partial-uncompress): Make dd give you one more block than you think you need. * jka-compr.el (jka-compr-dd-blocksize): Change default value to 256. Tue Feb 22 10:34:03 1994 Hans Chalupsky (hans@hydra.cs.Buffalo.EDU) * advice.el: Removed all support for Emacs-18: Removed autoload for `backquote'. Removed arglist specifications for `documentation' and `fset'. (ad-emacs19-p, ad-use-jwz-compiler): Removed these variables. (ad-lemacs-p, ad-v19-compiled-p, ad-subr-arglist, ad-make-advised-docstring): Removed reference to `ad-emacs19-p'. (ad-compiled-p): Renamed from `ad-v19-compiled-p'. Removed old definition of `ad-compiled-p'. (ad-compiled-code): Renamed from `ad-v19-compiled-code'. (ad-arglists, ad-docstring, ad-interactive-form): Use new names. (ad-body-forms): Always return nil for compiled definitions. (ad-compile-function): Simplified, because the v19 incarnation of `byte-compile' can compile macros. (ad-real-byte-codify): Removed. (ad-execute-defadvices): Removed. The `defadvice's it contained are now at the top level. (ad-advised-byte-code-definition): Renamed to `ad-advised-byte-code' and removed the definition of `ad-advised-byte-code' via `fset'. (ad-advised-byte-code-definition, ad-recover-byte-code, ad-stop-advice, ad-recover-normality): Removed `ad-real-byte-codify'-cation of their definitions. (ad-adjust-stack-sizes): Removed. (ad-enable-definition-hooks, ad-disable-definition-hooks): Removed v19 conditionalization. * advice.el: Fixed the problematic interaction between the byte-compiler and Advice when `ad-activate-on-definition' was t which resulted in erroneous compilation of nested `defun/defmacro's: (byte-compile-from-buffer, byte-compile-top-level): Advised to temporarily deactivate the advice of `defun/defmacro'. (ad-advised-definers, ad-advised-byte-compilers): New variables. (ad-enable-definition-hooks, ad-disable-definition-hooks): En/disable the advised byte-compiler entry points. * advice.el (defadvice): Implement a `freeze' option which expands the `defadvice' into a redefining and dumpable `defun/defmacro' whose documentation can be written to the `DOC' file. Frozen advices cannot be undone, hence, they do not need any Advice runtime support. (ad-defadvice-flags): Add `freeze' flag. (ad-make-advised-docstring, ad-make-single-advice-docstring): New STYLE option for `plain' and `freeze' styles. Slightly changed the default formatting of advised docstrings. (ad-make-plain-docstring, ad-make-freeze-docstring): New functions. * advice.el: (ad-recover-all, ad-scan-byte-code-for-fsets): Removed unused condition variable `ignore-errors'. * advice.el (ad-save-real-definition): New macro to save real definitions of functions used by Advice. Use `ad-save-real-definition' to save definitions of `fset', `byte-code' and now also `documentation'. (ad-subr-arglist, ad-docstring, ad-make-advised-docstring): Use `ad-real-documentation' to avoid interference with the advised version of `documentation'. * advice.el (ad-execute-defadvices): Copy advice infos. * advice.el (ad-start-advice-on-load): Default changed to t. Tue Feb 22 21:38:47 1994 Ed Reingold (reingold@mole.gnu.ai.mit.edu) * calendar.el (calendar-cursor-to-date): Fix to handle starred days correctly. Tue Feb 22 19:30:00 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * rmail.el (rmail-insert-inbox-text): Recognize the spool directory even if symlinks are present. Mon Feb 21 16:35:47 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * window.el (shrink-window-if-larger-than-buffer): Don't shrink if the window that would expand is the minibuffer. Sun Feb 20 21:49:23 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * picture.el (picture-mode-map): Replace delete-backward-char like backward-delete-char-untabify. Fri Feb 18 14:42:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cal-mayan.el (calendar-string-to-mayan-long-count): Don't assume that periods must end numbers. Look for digit runs explicitly. * subr.el (substitute-key-definition): Don't discard menu strings. * lisp.el (lisp-complete-symbol): Doc fix. * mouse.el (mouse-delete-max-match): Set len properly. * jka-compr.el: New file. * double.el: New file. * gud.el (gud-mode): Define C-c C-l in gud buffer. * soundex.el: New file. Fri Feb 18 02:51:33 1994 Paul Eggert (eggert@twinsun.com) * (vc-lookup-triple): Yield nil, not "", if version name is nil. Thu Feb 17 00:55:30 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ange-ftp.el (ange-ftp-insert-file-contents): New arg REPLACE. * lmenu.el: Delete the code to enable menu bars. * lisp.el (defun-prompt-regexp): Now a user variable. * files.el (revert-buffer): Use new insert-file-contents replace arg. Thu Feb 17 00:54:54 1994 Noah Friedman (friedman@prep.ai.mit.edu) * files.el (interpreter-mode-alist): Add entries for awk, gawk, and scm scripts. Wed Feb 16 19:11:36 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-error-regexp-alist): Tighten up Ultrix 3.0 f77 regexp to exclude : from file names; avoids lossage when : appears in error text. Wed Feb 16 13:19:40 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (recover-file): Call auto-save-file-name-p correctly. * cplus-md.el (c++-mode): Set parse-sexp-ignore-comments to t. Wed Feb 16 15:02:07 1994 Stephen Gildea (gildea@x.org) * time-stamp.el (time-stamp-start): Allow more white space between keyword and time stamp. Tue Feb 15 17:28:12 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * faces.el (face-try-color-list): Don't rely on errors from using a color that the server can't really support. Mon Feb 14 18:46:26 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (interpreter-mode-alist): New variable. (set-auto-mode): Use that for chosing a mode. Mon Feb 14 14:50:38 1994 Karl Heuer (kwzh@geech.gnu.ai.mit.edu) * simple.el (current-word): Remove (interactive). Mon Feb 14 14:18:23 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-mailer-swallows-blank-line): Fix regexp typo. Check for apparent header line as well as for leading whitespace. Sat Feb 12 00:06:50 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (undo, yank): Set this-command to t at start, and set it correctly at the end. * startup.el (inhibit-startup-echo-area-message): New variable. (command-line-1): Undo prev change. New test for whether to suppress echo area message. Update copyright year in displayed message. * faces.el (face-initialize): Specify default characteristics for the standard faces. Use face-fill-in to set up existing frames. (face-fill-in, face-try-color-list): New subroutines. Handle underline, foreground and background in the frame-independent info of a face. (x-create-frame-with-faces): Use face-fill-in. (x-initialize-frame-faces): Function deleted. Fri Feb 11 23:18:33 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * apropos.el (super-apropos-check-doc-file): Don't attempt to retrieve function documentation from a symbol with no function binding. Fri Feb 11 17:55:38 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * perl-mode.el (perl-mode): Set parse-sexp-ignore-comments. Fri Feb 11 17:07:56 1994 Paul Eggert (eggert@twinsun.com) * editfns.c (init_editfns): Look at LOGNAME before USER. * fileio.c (Fsubstitute_in_file_name): Remove long-dead code that looked at USER before LOGNAME. * time.el (display-time-filter): Remove unnecessary (getenv "LOGNAME") and (getenv "USER"), since (user-login-name) already does this. * gnuspost.el (gnus-inews-login-name): Likewise. * gnus.el (gnus-user-login-name): Fix doc string accordingly. * subr.el (user-original-login-name): Reduce to a defalias, since it's redundant with user-login-name. All callers changed to use user-login-name. Fri Feb 11 00:56:37 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * replace.el (perform-replace): Check for empty stack. * completion.el: Fix spelling of pre-command-hook. * simple.el: Fix syntax used for C-SPC. Fri Feb 11 00:54:46 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (etags-goto-tag-location): First go directly to STARTPOS and see if PAT is right there. Thu Feb 10 03:35:26 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * shell.el (shell-get-current-command): Make regexp more selective. Thu Feb 10 06:26:23 1994 David Megginson (dmeggins@aix1) * mode-clone.el (clone-init-mode-variables): Don't defvar variables if already bound. Put on clone-unmerged props if they were not bound. (clone-make-docstring): Install the map unconditionally; set clone-unmerged property to nil. No clone-merged property. (clone-set-syntax-table): Set clone-unmerged prop, not clone-merged. (clone-set-abbrev-table): Call clone-merge-abbrev-tables. Don't touch properties here. (clone-merge-keymaps): Splice out the `keymap' of the OLD map. (clone-merge-abbrev-tables): New function. Thu Feb 10 02:38:02 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-start-end): For double click with START on openparen, start forward scan from START. Wed Feb 9 23:43:29 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * font-lock.el (lisp-font-lock-keywords-2): Quote the * in let*. Wed Feb 9 17:21:54 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * outline.el (outline-mode): Fix spelling of add-hook. * vc.el (vc-comment-to-change-log): Load add-log before binding add-log-current-defun-function. * mouse.el (mouse-start-end): Check START rather than point for being at eob. Wed Feb 9 00:36:04 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * server.el (server-program): Use expand-file-name. * time.el (display-time): Use expand-file-name to make file name of wakeup. * novice.el (disabled-command-hook): Use eq to compare elts of this-command-keys. Choose the appropriate kind of Meta. Tue Feb 8 23:08:22 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * rmail.el (rmail-expunge-and-save): Mark summary buffer as unmodified. * rmailsum.el (rmail-summary-expunge-and-save): Likewise. * rmailout.el: Add (require 'rmail) so the macro will be byte-compiled properly. Tue Feb 8 18:49:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * outline.el (show-children): Don't narrow to (1+ (point-max)) when exposing the last level-n header in the buffer. Tue Feb 8 18:03:14 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * autoload.el (generate-file-autoloads): Don't frob literal formfeeds into \f; just bind print-escape-newlines to t around printing (now has same effect). Tue Feb 8 17:25:45 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * rmail.el (rmail-variables): Make local variables permanent, so the user can safely change major modes during an edit. * rmailedit.el (rmail-edit-current-message): Likewise. Tue Feb 8 12:49:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * version.el (emacs-minor-version, emacs-major-version): New variables. * faces.el (copy-face): Doc fix. * finder.el (finder-mode): Doc fix. * sendmail.el (mail-signature): Insert a `-- ' line. Tue Feb 8 00:06:13 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * subr.el (make-syntax-table): Behave like copy-syntax-table if an argument is given, for backward compatibility. Mon Feb 7 18:38:44 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * autoload.el (batch-update-autoloads): Add missing close paren. * ange-ftp.el (ange-ftp-load): Honor the NOERROR and NOSUFFIX flags. Mon Feb 7 18:06:00 1994 Lawrence R. Dodd (dodd@roebling.poly.edu) * sendmail.el (mail-signature): Doc mod. * lisp.el (insert-parentheses): Doc mod. Mon Feb 7 17:19:12 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * autoload.el (autoload-trim-file-name): New function. (generate-file-autoloads): Bind print-readably to t for Lucid. Use autoload-trim-file-name on FILE when inserting the name. Scan written text and fix up ^L to \f and ( at bol in doc string to \(. (update-file-autoloads): When we find a later file's section, set FOUND to 'new. If FOUND is 'new after loop, check file for autoload cookies and don't call generate-file-autoloads if none. (update-directory-autoloads): Get absolute file names from directory-files. (batch-update-autoloads): Rewrite from jwz to process later files in a directory after one file errs. Mon Feb 7 16:03:29 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * desktop.el (desktop-bug-report): Command deleted. Mon Feb 7 14:08:38 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * rcompile.el (remote-compile): Set comint-file-name-prefix in the compilation buffer. Mon Feb 7 13:40:24 1994 Michael I Bushnell (mib@geech.gnu.ai.mit.edu) * simple.el (push-mark): Fix Roland's misplaced paren around call to marker-buffer. Mon Feb 7 08:52:32 1994 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-mode-line-format): Change "current" to "today". (calendar-cursor-to-date): Add optional parameter to cause error signal when cursor is not on a date---this allows lots of simplifications throughout the code. (calendar-forward-month,calendar-set-mark, calendar-exchange-point-and-mark,calendar-count-days-region, calendar-print-day-of-year,calendar-print-iso-date, calendar-print-julian-date,calendar-print-islamic-date, calendar-print-hebrew-date,calendar-print-astro-day-number): Use simplification. * holidays.el (calendar-cursor-holidays): Use new error arg to calendar-cursor-to-date. * diary.el (view-diary-entries,diary-islamic-date): Use new error arg to calendar-cursor-to-date. * diary-ins.el (insert-diary-entry,insert-weekly-diary-entry, insert-monthly-diary-entry,insert-yearly-diary-entry, insert-anniversary-diary-entry,insert-block-diary-entry, insert-cyclic-diary-entry,insert-hebrew-diary-entry, insert-monthly-hebrew-diary-entry,insert-yearly-hebrew-diary-entry, insert-islamic-diary-entry,insert-monthly-islamic-diary-entry, insert-yearly-islamic-diary-entry): Use new error arg to calendar-cursor-to-date. * solar.el (calendar-sunrise-sunset): Use new error arg to calendar-cursor-to-date. * cal-french.el (calendar-print-french-date,diary-french-date): Use new error arg to calendar-cursor-to-date. * cal-mayan.el (calendar-print-mayan-date): Use new error arg to calendar-cursor-to-date. * solar.el (sunrise-sunset): Allow it to be called without an argument (as advertized). Mon Feb 7 00:40:20 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * iso-transl.el: Set up Alt keys as well as C-x 8 prefix. No need to create the prefix submaps explicitly. (iso-transl-char-map): New variable. Change the sequences aa and ae to just a and e. * iso-insert.el: Change the sequences aa and ae to just a and e. * gomoku.el (gomoku-init-display, gomoku-put-char): Bind inhibit-read-only; don't set buffer-read-only. * tar-mode.el (tar-pad-to-blocksize): Bind inhibit-read-only, not buffer-read-only. * makefile.el (makefile-browser-fill, makefile-browser-toggle): Bind inhibit-read-only; don't set buffer-read-only. * hideif.el (show-ifdefs, hide-ifdefs): Bind inhibit-read-only. Set buffer-read-only directly. (hide-ifdef-block): Likewise. (show-ifdef-block): Bind inhibit-read-only; don't set buffer-read-only. * hexl.el (hexl-mode): Bind inhibit-read-only; don't alter buffer-read-only. (hexl-mode-exit): Likewise. * cmacexp.el (c-macro-expand): Check inhibit-read-only. Mon Feb 7 00:08:43 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * autoload.el (update-file-autoloads): Never ask the user where to put a new section. While searching the file, look for an alphabetically later file's section, and insert the new section before it. Sun Feb 6 21:24:10 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * simple.el (push-mark): Don't push on global-mark-ring if its car is a marker in the current buffer. * simple.el (global-mark-ring, global-mark-ring-max): New variables. (push-mark): Also push a marker on the global-mark-ring. (pop-global-mark): New function; on C-x C-@, C-x C-SPC. Sun Feb 6 14:21:21 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rcompile.el: New file. * c-mode.el (indent-c-exp): If line starts with }, ignore what the previous line ends with. * cc-mode.el: Renamed from cplus-md1.el. * simple.el (kill-region): Test inhibit-read-only. * files.el (auto-mode-alist): Add elt for .tcl files. Move texinfo elts up. * tcl-mode.el: Doc fixes. (tcl-mode): Add autoload. (tcl-prefix-key): Changed to C-c. * tcl-mode.el: New file. Sun Feb 6 17:37:06 1994 Lawrence R. Dodd (dodd@roebling.poly.edu) * dired.el (dired-listing-switches): Doc fix. Sat Feb 5 20:45:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-yank-secondary): Do move point. (mouse-yank-at-point): New var. (mouse-yank-at-click, mouse-yank-secondary) Obey that. * menu-bar.el: Use > as convention for another menu follows. (menu-bar-edit-menu): Add entry for Emerge. * emerge.el (menu-bar-emerge-menu): New map. * emerge.el: Add defvars for many vars already being used. (emerge-options-menu, emerge-merge-menu, emerge-move-menu): New vars. (emerge-setup-fixed-keymaps): Set up emerge-move-menu, emerge-merge-menu and emerge-options-menu. Put them into emerge-fast-keymap. (emerge-set-keys): Put them into the emerge-edit-keymap. (emerge-minor-modes-list): Add defvar. (emerge-before-flag, emerge-after-flag): Move defvars up. (emerge-files-remote, emerge-files-with-ancestor-remote): (emerge-remote-exit): Var exit-func renamed to emerge-exit-func. Sat Feb 5 15:58:53 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * rlogin.el (rlogin-delchar-or-send-Ctrl-D): Call rlogin-send-Ctrl-D. Doc fix. * rlogin.el: Removed many extra autoload cookies. (rlogin-send-Ctrl-D): New function, on C-c C-d. Sat Feb 5 00:05:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * profile.el: Comment changes and doc fixes. The C program in the comments was moved into ../lib-src/profile.c. Fri Feb 4 01:26:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rect.el (string-rectangle): Make operate-on-rectangle convert tabs. (string-rectangle-line): After inserting string, insert the same width of whitespace that we deleted earlier. (operate-on-rectangle): Operate even if width is 0. (open-rectangle-line): Clean up. * outline.el (outline-end-of-subtree): If loop leaves us at eob, don't move back from there. * vc-hooks.el (vc-make-backup-files): Doc fix. * rmail.el (rmail-reply): If no resent-date, use ordinary date. If no resent-to, use empty string for to. * hideif.el: Delete bindings for C-c C-f, C-c C-b, C-c C-u, C-c C-d, C-c C-p and C-c C-n. Move C-c C-h to C-c C-d. (define-hide-ifdef-mode-map): Remove this code from a function and execute it at load time. (hide-ifdef-mode-submap): New variable holds the list of commands. (hide-ifdef-mode-map): Set this up with a prefix key and put it in minor-mode-map-alist. (hide-ifdef-mode-map-before): Variable deleted. (hide-ifdef-mode): Use force-mode-line-update. Delete the code to manipulate keymaps. * outline.el (outline-mode-map): Move C-c C-h to C-c C-d. * terminal.el (te-escape-help, te-more-break-help, terminal-emulator): Pass just one KEYMAP arg to where-is-internal. * calendar.el (calendar-mode-map): Pass (keymap) as KEYMAP arg to where-is-internal. * edmacro.el (edit-kbd-macro, edmacro-finish-edit, insert-kbd-macro): Pass (keymap) as KEYMAP arg to where-is-internal. * hideif.el (define-hide-ifdef-mode-map): Pass (keymap) as KEYMAP arg to where-is-internal. * macros.el (insert-kbd-macro): Pass (keymap) as KEYMAP arg to where-is-internal. Fri Feb 4 16:25:28 1994 Morten Welinder (terra@tyr.diku.dk) * desktop.el (desktop-internal-v2s): Allow saving of markers and subrs. (desktop-delay-hook): New variable. (desktop-read): Run desktop-delay-hook. (desktop-globals-to-save): Save register-alist. Always make desktop-locals-to-save local. (desktop-value-to-string): Make sure floating point numbers are output with maximum accuracy. (desktop-bug-report): New function. * desktop.el (desktop-internal-v2s): New function. (desktop-value-to-string): Use above function. * desktop.el (desktop-buffers-not-to-save): Add regexp for "nn" temporary files. (desktop-save, ): Remove support for Emacs 18, because it's not worth the effort and didn't work anymore, anyway. (desktop-save): Needn't bind `print-escape-newlines' anymore. Thu Feb 3 19:28:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (do-auto-fill): Don't break line at period-single-space. * fill.el (sentence-end-double-space): New variable. (fill-region-as-paragraph): Handle it. * rmailout.el (rmail-output): Handle rmail-output-file-alist. * simple.el (comment-region): Fix previous change. * mode-clone.el: New file. (define-mode-clone): Renamed from mode-clone. Swap args PARENT and CHILD. Don't use clone-run-setup-function. (clone-run-setup-function): Function deleted. Thu Feb 3 18:49:15 1994 Michael I Bushnell (mib@geech.gnu.ai.mit.edu) * simple.el (backward-word): Rms changed `interactive' to be `INTERACTIVE' on Feb 1. I changed it back. Thu Feb 3 15:25:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cplus-md1.el: Fix terminology used to name various Emacs versions. * server.el (server-done): If we kill the old buffer, and server-buffer-done gives us nil, return the new current buffer. Thu Feb 3 12:46:48 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * c-mode.el (c-fill-paragraph): Delete extraneous close paren. Wed Feb 2 00:00:40 1994 Barry A. Warsaw, ITB (warsaw@anthem) * cplus-md1.el (c-lineup-arglist): Add kludge for arglist-cont-nonempty to get correct indentation. (c-guess-basic-semantics): CASE 5D: arglist-cont-nonempty's relpos needs to be boi of containing-sexp paren. This is good for + offset, but bad for c-lineup-arglist, so add the kludge described above. Wed Feb 2 17:51:19 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * server.el (server-buffer-done): If buffer is dead, don't bury it. * font-lock.el (dired-font-lock-keywords): New variable. (font-lock-set-defaults): Handle dired.el. * server.el (server-program): Add exec-directory to value. Wed Feb 2 16:35:22 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * sort.el (sort-paragraphs): Use proper paragraph definition instead of just checking for whitespace. * advice.el (ad-execute-defadvices): Don't allocate advice-infos in pure space, in case we want to preload this file. Wed Feb 2 16:39:27 1994 Mike Williams (mikew@pooh.dosli.govt.nz) * mouse-sel.el (mouse-sel-version): Don't base version number on RCS revision. Updated to version 2.0. (mouse-sel-set-selection-function, mouse-sel-get-selection-function, mouse-sel-check-selection-function): Check whether X11 functions are bound when setting defaults. (mouse-extend): Check whether modify-frame-parameters is bound before calling it. Add support to kill region with double-mouse-3. * thingatpt.el (thing@pt-version): Removed variable. Wed Feb 2 14:57:20 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * avoid.el: Doc fix. * font-lock.el (shell-font-lock-keywords): Doc fix. Wed Feb 2 18:56:02 1994 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * vc-hooks.el (vc-mode-line): Use force-mode-line-update instead of the Emacs 18 kluge. Wed Feb 2 13:46:13 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * novice.el (disable-command): Reject invalid commands. Wed Feb 2 02:44:48 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * help-macro.el (make-help-screen): Remove debugging code. Tue Feb 1 23:39:31 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * files.el (file-relative-name): Allow for ancestors as well as descendants. Wed Feb 2 03:27:26 1994 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * vc.el (vc-parse-buffer): arrange for old properties to get cleared when their match string is not found in the master file. Tue Feb 1 12:13:34 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * font-lock.el (font-lock-set-defaults): Handle shell mode. (shell-font-lock-keywords): New variable. * simple.el (comment-region): Handle comment-end deletion for C-u. Don't let short lines confuse the comment-end deletion. * pascal.el: Many doc fixes. (pascal-get-beg-of-line, pascal-get-end-of-line): Use defsubst. Renamed from get-... (pascal-within-string): Use defsubst. (delete-whitespaces): Function deleted; callers use delete-horizontal-space instead. (pascal-string-diff): Renamed from string-diff. * files.el (auto-mode-alist): Add .p and .pas for pascal-mode. * simple.el (comment-region): Just C-u prefix means uncomment lines. * files.el (revert-buffer): Doc fix. Tue Feb 1 15:21:25 1994 Espen Skoglund (espensk@stud.cs.uit.no) * pascal.el: Complete rewrite. Added an outline- minor-mode and completion. Tue Feb 1 01:32:48 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * files.el (revert-buffer): Reposition after-revert-hook, and add before-revert-hook. * font-lock.el (font-lock-mode): Use the new hooks to get proper behavior on a revert. Tue Feb 1 00:16:31 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tabify.el (tabify): Don't delete back before initial START. * appt.el: (appt-display-interval, appt-display-duration) (appt-message-warning-time): Use larger defaults. Mon Jan 31 22:59:09 1994 (saw@cebaf.gov) * fortran.el (calculate-fortran-indent): Handle Fortran 90 INTERFACE and SELECT/CASE blocks. Mon Jan 31 17:53:57 1994 Boris Goldowsky (boris@moose.cs.rochester.edu) * avoid.el: (mouse-avoidance-nudge-mouse): Use (frame-width) and (frame-height) instead of erroneous (window-width) and (window-height). (mouse-avoidance-simple-hook): Raise frame first. (mouse-avoidance-fancy-hook): If moving mouse would enter another frame, stay put. * avoid.el: Doc fixes. Mon Jan 31 18:05:38 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (visit-tags-table-buffer): Don't change VISIT-TAGS-TABLE-BUFFER-CONT when it is 'same. Do list verification frobbing for it being either 'same or nil; but only set tags-table-list-started-at and tags-table-list-pointer when it's nil. Mon Jan 31 11:40:53 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * outline.el (show-children): Don't call outline-level at eob. * tabify.el (tabify): Don't delete back before initial START. * appt.el (appt-display-interval, appt-display-duration) (appt-message-warning-time): Use larger defaults. Mon Jan 31 07:05:45 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * rmailsum.el (rmail-summary-mail, rmail-summary-continue, rmail-summary-reply, rmail-summary-retry-failure): Fix rmail summary commands to work with rmail-mail-new-frame. Sun Jan 30 09:55:44 1994 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-print-hebrew-date): Change to use calendar-hebrew-date-string. Sat Jan 29 18:56:09 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * outline.el (minor-mode-alist): Don't add "Outl" if already added. * rmail.el (rmail-make-in-reply-to-field): Discard text properties from the address before printing it. Fri Jan 28 11:41:47 1994 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * cal-mayan.el (calendar-mayan-date-string): New function. (calendar-print-mayan-date, diary-mayan-date): Use it. * cal-french.el (calendar-french-date-string): New function. (calendar-print-french-date, diary-french-date): Use it. * cal-menu.el: New file with all menu support functions. * calendar.el (calendar-version): New function. Adjustments to commentary at top of file. (diary-entry-marker, calendar-today-marker, calendar-holiday-marker): Don't autoload them; change definitions to support monochrome and color workstations. (calendar-french-date-string,calendar-mayan-date-string): Autoload them. (calendar-day-of-year-string, calendar-iso-date-string, calendar-julian-date-string,calendar-islamic-date-string, calendar-hebrew-date-string,calendar-astro-date-string): New functions (calendar-print-day-of-year, calendar-print-iso-date, calendar-print-iso-date,calendar-print-julian-date, calendar-print-islamic-date,calendar-print-hebrew-date, calendar-print-astro-day-number): Use them. (calendar-mode-map): Add mouse support. (calendar-unmark,mark-visible-calendar-date,calendar-mark-today): Rewritten. * diary.el (diary-day-of-year, diary-iso-date, diary-islamic-date, diary-hebrew-date, diary-julian-date, diary-astro-day-number): Use new functions from calendar.el. * holidays.el (list-calendar-holidays): Fix mode line. * lunar.el (calendar-phases-of-moon): Fix mode line. * solar.el (calendar-sunrise-sunset): Add date to message. Wed Jan 26 13:57:02 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * help.el (help-for-help): Doc fix. * help-macro.el (three-step-help): New option. (make-help-screen): Implement that option. Handle delete function key like DEL. Don't include the option list in the prompt when displaying a full window of options. * rmailsum.el (rmail-summary-undelete): If we don't undelete anything, don't move point. Wed Jan 26 01:09:48 1994 Rick Sladkey (jrs@world.std.com) * simple.el (next-line): Move error signaling and special end of line behavior into line-move so that next-line is symmetric with previous-line when next-line-add-newlines is nil. (line-move): Move as far as possible and ding with a message if the requested motion cannot be accomplished. When selective-display is numeric, ensure point actually moves and does so to a visible line. Tue Jan 25 00:27:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * c-mode.el (c-fill-paragraph): Handle C++ mode. Mon Jan 24 18:51:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * appt.el (appt-check): Doc fix. * sendmail.el (mail-mailer-swallows-blank-line): New variable. (sendmail-send-it): Add extra newline if appropriate. Fri Jan 21 11:29:57 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * paragraphs.el (forward-paragraph): Doc fix. Fri Jan 21 23:29:12 1994 Michael Kifer (kifer@cs.sunysb.edu) * appt.el (appt-check): Use the new variables appt-disp-window-function and appt-delete-window-function. (appt-disp-window-function): New variable. (appt-delete-window-function): New variable. (appt-delete-window): New function. (appt-disp-window): Don't delete the appt window here; instead, call appt-delete-window-function. Fixed bug that messed up the screen when appt-check ran when mouse is in the minibuffer. Call select-frame only if window-system. Thu Jan 20 09:25:23 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch.el (isearch-highlight): Do nothing if not window-system. * flow-ctrl.el (enable-flow-control-on): Do nothing if no TERM. * help-macro.el (make-help-screen): Use overriding-local-map. Recognize C-v and M-v properly. Compute help-screen after changing the map. Wed Jan 19 09:21:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch.el (isearch-push-state): Save isearch-case-fold-search. (isearch-top-state): Restore it. * simple.el (shell-command-on-region): If we quit the command, display the output buffer anyway. * compile.el (compilation-error-regexp-alist): Handle DEC AXP OSF/1. Wed Jan 19 14:50:59 1993 Stephen Gildea (gildea@x.org) * time-stamp.el: Better, more user-oriented doc strings. (time-stamp-mail-host): Now a user option. (time-stamp-current-year, time-stamp-hh:mm): Removed. (time-stamp-mm/dd/yy, time-stamp-dd/mm/yy): Removed. (time-stamp-yyyy-mm-dd): New function, ISO 8601 format. Tue Jan 18 14:11:57 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * font-lock.el (font-lock-mode): Set after-revert-hook to refontify after revert. * files.el (revert-buffer): Run after-revert-hook. Mon Jan 17 17:43:06 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * paren.el (show-paren-command-hook): Do nothing when in kbd macro. Mon Jan 17 16:44:41 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) The most important new feature added to GNU Emacs in recent history. * yow.el (yow-file): Doc fix. (yow): With non-nil arg (prefix arg), insert the chosen pinhead wisdom at point. Use (interactive-p) instead of arg to decide if interactive. (insert-zippyism): Yow! Am I INSERTED yet? Sun Jan 16 14:03:12 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch.el (isearch-mode): Set overriding-local-map locally. Don't set isearch-old-local-map and don't call use-local-map. (isearch-done): Set overriding-local-map to nil. Don't call use-local-map. (isearch-old-local-map): Variable deleted. * menu-bar.el (menu-bar-file-menu): Add rmail, gnus, calendar items. * rmail.el (rmail-get-new-mail): Avoid error if file is empty. * paragraphs.el (forward-paragraph): If moving back we find nothing but separator lines till buffer beg, just stay there. Exit outer loop if at beg or end of buffer. Sun Jan 16 04:11:04 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-error-regexp-alist): Add regexp for Lucid lcc. Element lists can now contain a 4th elt giving subexpr for the column. (next-error): Handle error records with column numbers. (compilation-parse-errors): Parse column numbers when the alist elt specifies it. Use string-to-int instead of read for numbers from buffer text. Sat Jan 15 23:35:50 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * upd-copyr.el (update-copyright): Wrap final copyright-matching regexp in parens, so \1 gets all the year tokens, not just the last. (The old regexp won with the pre-POSIX defn of subexpressions with +.) Sat Jan 15 09:36:13 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch.el: SPC is not special in regexp within brackets. (isearch-within-brackets): New variable. (isearch-mode): Set that. (isearch-edit-string): Bind that. (isearch-search-and-update): Set that. (isearch-top-state): Set that. (isearch-push-state): Use that. (isearch-search): Set that. * files.el (set-auto-mode): Handle (REGEXP FUNCTION t) elements. * dired-x.el: New file. Fri Jan 14 09:08:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-default-file): Renamed from rmail-last-file. (rmail-default-rmail-file): Renamed from rmail-last-... * rmailout.el: Use new names. * perl-mode.el: Change defconsts to defvars. Doc fixes. * rmail.el (rmail-bury): Rename local rmail-buffer to buffer-to-bury. (rmail-set-message-counters): Avoid errors moving backwd if new file. * debug.el (debug): Bind unread-command-char to -1, not nil. * files.el (abbreviate-file-name): Don't convert / to ~/ when the home dir is /. * term/lk201.el (function-key-map): Rename kp-period to kp-decimal. Add f1 thru f5. Change insertchar and deletechar to insert and delete. Wed Jan 12 23:36:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el (comint-show-output): Leave point at start of output, but push the mark. Tue Jan 11 00:46:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * man.el (Man-default-man-args): Use Man-specified-section-option. (Man-default-man-entry): Likewise. * loaddefs.el (global-map): Add binding for C-M-delete. * simple.el (open-line): Treat all cases of enabled undo alike. * bytecomp.el (byte-compile-condition-case): Disable warning about symbol not naming a condition. Allow a list of condition names. * hideif.el (hif-tokenize): Handle // comments after #if. Mon Jan 10 13:14:06 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch.el (isearch-mode): If not slow, clear isearch-window-configuration. * telnet.el (telnet): Fix previous change--tentative idea wasn't fully removed. Mon Jan 10 15:33:43 1994 Lawrence R. Dodd (dodd@roebling.poly.edu) * info.el (Info-follow-reference): If point is not in middle of a cross-reference but located somewhere on current line, make cross-reference the `default'. If only one cross-reference located in node, make it `default'. Mon Jan 10 07:03:12 1994 Michael D. Ernst (mernst@monozygote) * mailabbrev.el (mail-abbrev-mode-regexp): Add Reply-to. Sun Jan 9 18:22:35 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * term/x-win.el (vendor-key-syms): Fixed typo (extra parens). * debug.el (debug): Fixed typo (extra paren). Sun Jan 9 11:37:52 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * debug.el (debug): Bind a bunch of vars, like last-command, to neutral values. Save the outer values in debugger-last-command, etc. Put those saved values back into effect when returning. (debugger-eval-expression): Put the saved values into effect while evaluating, and store modified values back into debugger-outer-... after evaluating. * diff.el (diff-latest-backup-file): Call file-chase-links. (diff): Select the differences buffer. * c-mode.el (c-indent-region): Keep looping till reach endmark. Treat #-lines specially. * shell.el (shell-input-autoexpand): New variable. (shell-mode): Set comint-input-autoexpand. (shell-mode): Don't call shell-dirstack-message. * comint.el (comint-input-autoexpand): Make default nil. * term/x-win.el (vendor-key-syms): Add more HP keysyms and some Sun. Sat Jan 8 04:44:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el (vendor-key-syms): Set this variable. * rmailsum.el (rmail-summary-delete-forward): Fix regexp used for recognizing deleted message. (rmail-summary-output, rmail-summary-output-to-rmail-file): Use rmail-summary-delete-forward. * loadup.el: If there are no subversions yet, use 1. * gud.el (gud-common-init): Don't crash if no file specified. * rmailsum.el (rmail-summary-by-senders): Add missing arg to rmail-new-summary. (rmail-summary-output, rmail-summary-output-to-rmail-file): Handle rmail-delete-after-output explicitly here. * flow-ctrl.el (enable-flow-control): Use prefix argument like minor modes. (enable-flow-control-memstr=): Function deleted. (enable-flow-control-on): Use member instead. (flow-control-c-q-replacement, flow-control-c-s-replacement): New vars. * loadup.el: Load version.el before site-load.el. Sat Jan 8 12:20:03 1994 Lawrence R. Dodd (dodd@roebling.poly.edu) * gnus.el (gnus-group-list-all-groups): Display a message in the echo area. Fri Jan 7 00:36:49 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * loadup.el: Extend emacs-version based on which executable files exist. * version.el (emacs-version): Discard the third version component. * inc-vers.el, grow-vers.el: Files deleted. * dired.el (dired-move-to-filename-regexp): New variable. (dired-move-to-filename): Use that. * info.el (Info-directory-list): Change last elt to ../info (expanded). * startup.el (command-line-1): Improve echo area message wording. Don't print it if C-h C-p has been redefined. * ange-ftp.el (ange-ftp-hash-mark-msgs): Undo previous change. * lmenu.el (make-lucid-menu-keymap): Allow multiple identical inactive strings. Thu Jan 6 10:25:28 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * comint.el (comint-show-output): Use (point-max) rather than erring when the comint-last-input-end marker points nowhere. * compile.el (compilation-parse-errors): Prepend comint-file-name-prefix (if boundp) to absolute file names culled from error msgs. (compile-abbreviate-directory): Prepend comint-file-name-prefix (if boundp) to DIR before other processing. * shell.el (shell-cd): Function removed. (shell-prefixed-directory-name): New defsubst. (shell-process-popd, shell-process-pushd, shell-process-cd, shell-resync-dirs): Apply it to ARG when it's a directory name. Use (concat comint-file-name-prefix "~") in place of (getenv "HOME") or "~". Call cd instead of shell-cd. * menu-bar.el (mouse-menu-choose-yank): Don't use rotate-yank-pointer; set kill-ring-yank-pointer explicitly instead. * compile.el (compilation-buffer-p): Move defsubst before all callers. (compilation-forget-errors): Reset compilation-parsing-end to 1 here. (compile-reinitialize-errors): Don't reset compilation-parsing-end after calling compilation-forget-errors. Comment out gratuitous switch-to-buffer call; what was the rationale for it? Don't check compilation-parsing-end (removed local AT-START); instead always append to compilation-old-error-list, it will be nil if at start. If compilation-error-list is non-nil before calling the parser, restore its previous value afterwards; it still indicates the current error position. Subtract the length of the existing compilation-error-list from FIND-AT-LEAST when calling the parser. (compilation-parse-errors): Don't check LIMIT-SEARCH at end of loop. Inside check it inside each case of the cond; in error case we must discard the last new error before stopping (just as for FIND-AT-LEAST). Use floating-point in buffer percentage calculation, to avoid integer overflow. Thu Jan 6 04:58:30 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-resend): Use send-mail-function. * files.el (auto-mode-alist): Treat changelo like ChangeLog. * add-log.el (change-log-name): On MSDOS, use changelo. * rmail.el (rmail-convert-to-babyl-format): Fix one-off error in handling content-length field. * makefile.el (makefile-mode): Make comment-start, comment-end, and comment-start-skip buffer-local. Wed Jan 5 15:31:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lmenu.el (make-lucid-menu-keymap): For "----", make blank line. * add-log.el (change-log-name) [MSDOS]: Use change.log, not changelo. * subr.el (eval-after-load): Do nothing if FORM is already on the list. Wed Jan 5 03:15:31 1993 Morten Welinder (terra@diku.dk) * hexl.el (dehexlify-buffer): If msdos, bind binary-process. (hexl-find-file): Load as binary. * ls-lisp.el (ls-lisp-format): Bad format for uid and gid fixed. * compile.el (compile-internal): Extended to work without asynchronous subprocesses available. * subr.el (start-process-shell-command): Doc fix. * find-dired.el (start-process-shell-command): Doc fix. * add-log.el (change-log-name): Let default name for ms-dos be "change.log". * files.el (auto-mode-alist): Default mode for "changelo" set to change-log-mode to support ms-dos 8+3 file names. AAAARRGGG! Also use emacs-lisp-mode for "_emacs" file which is the equivalent of ".emacs" * bytecomp.el (byte-compile-file) [ms-dos]: Save as binary. * dos-fns.el, term/internal.el: New files for MSDOS. * files.el (make-backup-file-name, backup-file-name-p) [ms-dos]: Use "*.bak" as backup file name. (user-init-file): new variable. * inc-vers.el [ms-dos]: Save version.el as *binary*. * loadup.el [ms-dos]: Preload mouse.el, dos-fns.el, disp-table.el, and ls-lisp. Dump only one version. Use simpler name for doc file. * loaddefs.el (completion-ignored-extensions) [ms-dos]: More suitable set for MSDOS. * startup.el (command-line): Set user-init-file. * novice.el (enable-command, disable-command): Use user-init-file. * desktop.el: (desktop-buffer-mh): New function for mh mail system. (desktop-buffer-handlers): Add desktop-buffer-mh. (desktop-buffer): Correct setting of auto-fill-mode. Make the compilation silent using (eval-when-compile ...) (old-kill-emacs): New explicit variable (for Emacs 18 comp.) (desktop-globals-to-save): Add the history rings for interactive searches. (postv18): Remove. (desktop-create-buffer-form): New variable. (desktop-save): Use desktop-create-buffer-form. (desktop-value-to-string): New function. (desktop-outvar): Clean-up using desktop-value-to-string. (desktop-save): clean-up Using desktop-value-to-string. (desktop-save): Decide Emacs version at compile time. (desktop-locals-to-save): New variable. (desktop-truncate): New function. Tue Jan 4 18:29:48 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lmenu.el (popup-menu): Add loop to handle submenus. Mon Jan 3 20:39:20 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * debug.el (debug): Bind this-command and last-command. Mon Jan 3 20:53:26 1994 Paul Eggert (eggert@twinsun.com) * vc.el (vc-finish-logentry): Sync the buffer in case the user modified it while editing the comment. Mon Jan 3 00:13:06 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * time.el (display-time-file-nonempty-p): Check existence here. (display-time-server-down-time): New variable. (display-time-filter): If accessing mail-spool-time takes too long, don't try again for twenty minutes. * tex-mode.el (slitex-mode, latex-mode): Set paragraph-start and paragraph-separate to a specific list of control sequences. (tex-common-initialization): Make parse-sexp-ignore-comments t. * lpr.el (lpr-headers-switches): Set proper value on hpux and usg. * comint.el (comint-last-output-start): Add defvar. * subr.el (make-syntax-table): New function; no longer an alias for copy-syntax-table. * rmail.el (rmail-get-new-mail): Cope if display-time-string is nil. Sun Jan 2 12:29:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sort.el (sort-float-fields): Commented out. * c-mode.el (c-mode-map): Add menu bar menu. * isearch.el (isearch-repeat): If we matched a null string and there's no place to advance to, fail instead. Sun Jan 2 11:52:33 1994 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * cal-french.el (calendar-goto-french-date): Fix special day choice in non-leap years by re-reversing the list. Fix out of place parenthesis in prompt. Sat Jan 1 00:26:10 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * compile.el (compilation-read-command, compilation-ask-about-save): New variables. (compile): Obey them. * paths.el (Info-default-directory-list): Doc fix. jrs. * ispell.el (ispell-highlight, ispell-dehighlight): New functions. (ispell-command-loop, ispell-next): Call them. (ispell-highlight, ispell-overlay): New variables. * simple.el (next-line): Don't signal error here. (line-move): Do it here instead. * comint.el (comint-dynamic-list-completions): Use read-key-sequence. Special handling for mouse-choose-completion. * files.el (save-some-buffers): Fix previous change. * gnuspost.el (gnus-news-reply): Handle reply-to field. * paths.el (manual-program): Deleted. Sat Jan 1 16:39:41 1993 Martin Boyer * bibtex.el (bibtex-field-name, bibtex-field-const, bibtex-field-text): Adapted to Emacs 19 regex rules. (bibtex-reference): Removed one set of parentheses (a workaround). Sat Jan 1 09:56:27 1993 Michael D. Ernst (mernst@research.microsoft.com) * rmailout.el (rmail-output-to-rmail-file): If just a dir is specified, use default name in specified dir. Fri Dec 31 01:45:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) jrs. * replace.el (query-replace-highlight): New variable. (replace-overlay): New variable. (replace-highlight, replace-dehighlight): New functions. (perform-replace): Use them. * lpr.el (print-region-1): If lpr-headers-switches is string, turn it into a list before appending. * files.el (save-some-buffers): Reinsert lost code to save abbrevs. jrs. * edebug.el (eval-current-buffer): Old definition deleted. (eval-buffer): Use current buffer by default. * diff.el (diff): Call shell-quote-argument. * subr.el (shell-quote-argument): New function. * ispell.el (ispell-next): Remove periods from messages. (ispell-complete-word): Improve error messages. * simple.el (open-line): Properly put fill-prefix on each line. Thu Dec 30 02:37:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * help.el (help-for-help): Mention the scroll commands. * help-macro.el (make-help-screen): Use read-key-sequence. Temporarily switch keymaps. * startup.el (command-line): In most cases, if init file sets debug-on-error, leave it set that way. * files.el (hack-one-local-variable): Treat file-name-handler-alist and after-load-alist like eval. * simple.el (transient-mark-mode): Doc fix. * rmailsum.el (rmail-summary-delete-forward): Move to next or prev msg among those included in the summary. Wed Dec 29 10:47:52 EST 1993 Ken Manheimer (klm@nist.gov) * icomplete.el (icomplete-pre-command-hook): Reconciled with keyboard macro operation. (icomplete-post-command-hook): Likewise. (window-minibuffer-p): Cleaned up according to suggestion from Richard Mlynarik. General rectification of doc strings and comments. Wed Dec 29 01:54:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * apropos.el (super-apropos-check-doc-file): Verify that the doc string can actually be found from the symbol. Sun Dec 26 02:56:02 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * font-lock.el (font-lock-set-defaults): Add missing paren. * lisp-mnt.el (lm-report-bug): Don't crash if version is nil. (lm-report-bug): lm-maintainer returns a cons; convert it to a string. Fri Dec 24 00:40:23 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ange-ftp.el (ange-ftp-write-region): Call set-visited-file-modtime. (ange-ftp-insert-file-contents): Likewise. * isearch.el (isearch-mode-map): Bind kp-... keys. * simple.el (setting up kp-... keys): Make ascii-character props. * bytecomp.el: Provide bytecomp as well as byte-compile. * vc.el (vc-buffer-sync, vc-diff): New arg NOT-URGENT. (vc-diff): Pass new arg. * replace.el (query-replace-map): Don't bind ESC. (query-replace-help): Changed accordingly. * loadhist.el (unload-feature): Ignore conses in the feature-symbols. * shell.el (shell-backward-command): If comint-bol moves forward, use real beginning of line instead. Use skip-syntax-backward properly. If backward search finds a separator, move forward over it. (shell-forward-command): Call skip-syntax-backward properly. Thu Dec 23 21:40:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * telnet.el (telnet): Use comint-arguments. * rmailout.el (rmail-output-to-rmail-file): When copying to a buffer, maybe enable auto save in that buffer. * awk-mode.el (awk-mode-syntax-table): Was mistakenly changing emacs-lisp-mode-syntax-table. * isearch.el (isearch-update): If isearch-other-end is nil, call isearch-dehighlight. * rmail.el (rmail-insert-inbox-text): If copy-file fails, call rename-file with t as third arg. * simple.el (next-complete-history-element): Doc fix. (previous-complete-history-element): Doc fix. * comint.el (comint-next-matching-input-from-input): Doc fix. Wed Dec 22 13:54:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tex-mode.el (tex-common-initialization): Make paragraph-start and paragraph-separate match a line of $$. Wed Dec 22 07:01:53 1993 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * lisp-mnt.el (Bogus-Bureaucratic-Cruft): Changed to `X-Bogus-Bureaucratic-Cruft'. Change comments to indicate that any header starting with `X-' is not supposed to be implemented. This gives us the same "out" that RFC822 does. Thu Dec 16 18:00:49 1993 Richard Stallman (rms@srarc2) * ange-ftp.el (ange-ftp-hash-mark-msgs): Make match more general. Thu Dec 16 16:44:02 1993 Karl Berry (karl@cs.umb.edu) * compile.el (grep-command): New variable. (grep): Use it. Thu Dec 16 11:18:28 1993 Richard Stallman (rms@srarc2) * awk-mode.el (awk-mode): Use c-indent-line. * gud.el (gud-format-command): Rewrite. * lpr.el (lpr-headers-switches): Treat hpux like usg-unix-v. Wed Dec 15 11:45:27 1993 Richard Stallman (rms@srarc2) * asm-mode.el (asm-mode): Don't mess with auto-fill mode. * man.el (Man-specified-section-option): Test system-configuration. * lpr.el (print-region-1): Adjust start, end after running pr. * info.el (Info-insert-dir): Compute truename just once for each dir. * calendar.el (calendar-mode-map): Put back C-v and M-v bindings. * telnet.el (telnet-filter): Rewrite, taken mostly from Lucid. * rmailsum.el (rmail-summary-goto-msg): Use unwind-protect to go back to summary, and go back to the window that was selected before. * rmail.el (rmail-quit): Expunge without updating summary. * paths.el (rmail-spool-directory): Use dgux, not dgux-unix. * lpr.el (lpr-command): Use dgux, not dgux-unix. Tue Dec 14 16:19:32 1993 Ulrich Mueller (ulm@vsnhd1.cern.ch) * gud.el (gud-format-command): Use gud-last-last-frame if gud-last-frame is nil. Tue Dec 14 21:50:51 1993 Richard Stallman (rms@srarc2) * isearch.el (isearch-text-char-description): Treat TAB as ctl char. * info.el (Info-insert-dir): For generated menu items, add ::. Mon Dec 13 10:31:05 1993 Ulrich Mueller (ulm@vsnhd1.cern.ch) * gud.el (gud-mipsdbx-massage-args, gud-mipsdbx-marker-filter): New functions for dbx support on Mips under Ultrix. (gud-dbx-mips-p, gud-mipsdbx-marker-acc): New variables. (dbx) If gud-dbx-mips-p is non-nil, overload above two functions and initialize appropriate command strings for dbx. Sun Dec 12 15:49:10 1993 Richard Stallman (rms@srarc2) * loaddefs.el (ctl-x-map): Add C-x r d binding for delete-rectangle. * rmailout.el (rmail-output-to-rmail-file): Call rmail-update-summary. * etags.el (visit-tags-table-buffer): Change "Add to list" question. * mouse.el (mouse-kill-secondary): Fix previous change. * man.el (Man-mode-hook): Renamed from Man-mode-hooks. Sun Dec 12 15:40:41 1993 Michael D. Ernst (mernst@monozygote) * dired-aux.el: Autoload dired-.*-file. Sat Dec 11 16:14:44 1993 Richard Stallman (rms@srarc2) * rmail.el (rmail-resend): Delete more than one Sender, but only in the headers, not in the body. * mouse.el (mouse-kill-secondary): Get rid of CLICK argument. Instead, use this-command-keys. * lpr.el (print-region-new-buffer): Rename args to OSTART and OEND. * isearch.el (isearch-text-char-description): Really call text-char-description for ctl chars. * doctor.el (make-doctor-variables): Fix some local var names. * bytecomp.el (byte-compile-dest-file): If FILENAME is not recognized, append .elc to it. * comint.el (comint-read-input-ring): New arg SILENT. * shell.el (shell-mode): Pass t to comint-read-input-ring. * rmail.el (rmail-resend): Doc fix. Fri Dec 10 21:30:47 1993 Richard Stallman (rms@srarc2) * mouse.el (x-fixed-font-alist): For 6x10, look for normal font, not semicondensed. Thu Dec 9 22:05:57 1993 Richard Stallman (rms@srarc2) * supercite.el (sc-read-string): Don't pass a history arg to read-string. * sendmail.el (mail-default-reply-to): Add autoload cookie. Wed Dec 8 14:00:54 1993 Boris Goldowsky (boris@mink.cs.rochester.edu) * shadowfile.el: (shadow-noquery): Use it. (shadow-copy-file): Use abbreviate-file-name to avoid incorrect warnings. Lucid support commented out (didn't work and caused compiler warnings). Wed Dec 8 11:18:29 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-error-regexp-alist): Generalize `"foo.c", line 13:' regexp to also match `"foo.c", line 13 pos 1...'. * loaddefs.el (point-to-register-compatibility-binding, jump-to-register-compatibility-binding, copy-to-register-compatibility-binding, insert-register-compatibility-binding): Add defaliases for these. (ctl-x-map): Bind / j x g to those, respectively, so \[...] always expands to the C-x r ... bindings. Wed Dec 8 07:38:54 1993 Stephen Gildea (gildea@x.org) * time-stamp.el (time-stamp-month-dd-yyyy): no leading zero on day. Wed Dec 8 21:51:08 1993 Richard Stallman (rms@srarc2) * gud.el (gud-common-init): Call substitute-in-file-name. * doctor.el (doctor-adverbp): Don't die if doctor-make-string gives a string of length < 2. * rmailsum.el (rmail-summary-rmail-update): Special handling for eob. * mail-utils.el (mail-fetch-field): Add autoload cookie. Tue Dec 7 20:52:12 1993 Richard Stallman (rms@srarc2) * comint.el (comint-replace-by-expanded-history): New arg SILENT. (comint-send-input): Pass t as new arg. * bytecomp.el (byte-recompile-directory): Don't treat symlinks as dirs. Mon Dec 6 23:32:56 1993 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * loaddefs.el: Remove autoload for `rlogin-with-args', which no longer exists. Mon Dec 6 08:32:18 1993 Michael D. Ernst (mernst@monozygote) * reposition.el (reposition-window): Fix whitespace-skipping regexp. Mon Dec 6 22:54:36 1993 Richard Stallman (rms@srarc2) * fill.el (fill-region-as-paragraph): Do allow breaking line at a period followed by two spaces, in the case where we are insisting on having at least one complete word. * files.el (hack-local-variables-prop-line): If we can't switch-to-buffer in selected window, try another window, then a new frame. * font-lock.el (font-lock-set-defaults): Do nothing if font-lock-keywords is already set. * gnuspost.el (gnus-post-news): Call gnus-read-distributions-file. Mon Dec 6 21:00:00 1993 Anders Holst (aho@sans.kth.se) * hippie-exp.el (;; Keywords:): Changed to "abbrev". (hippie-expand-ignore-buffers): New variable. (he-regexp-member): New function. (hippie-expand-try-functions-list): Added `try-expand-list'. (try-expand-line-all-buffers, try-expand-list-all-buffers, try-expand-dabbrev-all-buffers): Use `he-regexp-member' and `hippie-expand-ignore-buffers'. (he-list-search): Don't find list containing point. (he-dab-search-regexp): Just match at beginning of words. (he-dabbrev-beg): Never move point forward. Sun Dec 5 18:29:24 1993 Paul Eggert (eggert@twinsun.com) * lunar.el (lunar-phase): Add calendar-time-zone to solar ephemeris correction. This fixes a bug where GMT was being reported as if it were local standard time. Sun Dec 5 09:35:58 1993 Michael D. Ernst (mernst@monozygote) * ispell.el: Don't imply private dictionary is always ispell.words. Sun Dec 5 12:20:26 1993 Richard Stallman (rms@srarc2) * man.el (Man-follow-manual-reference): Strip trailing - from default. * apropos.el (apropos-match-keys): If REGEXP is nil, always act as if it matched. * replace.el (perform-replace): Prompt now says how to get help. * menu-bar.el (menu-bar-edit-menu): Add query-replace menu item. Make a menu-enable property for query-replace. * comint.el (comint-mode-map): Put comint-show-output on C-M-l. * cplus-md.el (c++-indent-line, calculate-c++-indent): (indent-c++-exp): Recognize `friend' without `class'. * rmail.el (rmail): Doc fix. * man.el (Man-getpage-in-background): Use lower case for arg vars. (Man-follow-manual-reference): Check for existence of references before using the minibuffer. Delete period from error message. Delete spurious concat call. Pass arg, not (consp arg), to Man-getpage-in-background. Sun Dec 5 19:45:34 1993 Simon Marshall (simonm@tintin) * comint.el (comint-preinput-scroll-to-bottom): Removed calls to window-minibuffer-p and 'not-minibuf arg to walk-windows. Removed mouse-yank-at-click from command list and doc string. Removed duplicate test for comint-scroll-to-bottom-on-input (scroll). Removed test for 'this within walk-windows code. Sat Dec 4 12:37:59 1993 Michael D. Ernst (mernst@monozygote) * reposition.el (reposition-window): Don't err if comment-height = 0. Sat Dec 4 13:50:48 1993 Richard Stallman (rms@srarc2) * man.el (Man-follow-manual-reference): Try to use current word as a default for the reference to follow. Use interactive to read the reference name. * add-log.el (add-log-current-defun): Remove spurious quote on c++-mode. Recognize c++-c-mode. * rmailout.el (rmail-output-to-rmail-file): Turn off the deleted attribute outside of the save-restriction. * subr.el (remove-hook): Use equal to see if hook is just that fcn. (add-hook): Use member to see if a lambda expr is already in the list. * lpr.el (lpr-headers-switches): New variable. (print-region-1): Use it. * tex-mode.el (tex-send-command): New local var BUF. Use it when calling buffer-modified-tick. * comint.el (comint-postoutput-scroll-to-bottom): Don't select a different buffer permanently. * ange-ftp.el (ange-ftp-gateway-prompt-pattern): Don't match more than one line. * cmuscheme.el (inferior-scheme-mode): Don't let `comint-prompt-regexp' match more than one line. * comint.el (comint-prompt-regexp): Fixed documentation to reflect changes to some prompt regexps. * gud.el (dbx): Let `comint-prompt-regexp' not match more than one line. * inf-lisp.el (inferior-lisp-prompt): Don't match more than one line. * telnet.el (telnet-prompt-pattern) (telnet-check-software-type-initialize): Don't let `telnet-prompt-pattern' match more than one line. * files.el (set-visited-file-name): Don't rename-buffer if buffer already has the desired name. * c-mode.el (c-delete-backslash): Do nothing if empty line. Fri Dec 3 09:30:38 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-workfile-unchanged-p): Add optional argument specifying whether we want to compute the differences if the file is changed. Otherwise, use cmp instead of diff. (vc-next-action-on-file): Use new vc-workfile-unchanged-p option; this avoids recomputing the differences in some cases. (vc-backend-diff): OLDVERS is now optional; all callers changed. New optional argument CMP says to use `cmp' rather than `diff'. Fri Dec 3 00:11:18 1993 Richard Stallman (rms@srarc2) * dired.el (dired-in-this-tree): Call expand-file-name. * outline.el (outline-minor-mode): When turning off the mode, turn ^Ms back to \n's. (outline-mode): Set change-major-mode-hook. * lpr.el (lpr-add-options): New variable. (print-region-1): Obey that. * bookmark.el, compile.el, edmacro.el, dabbrev.el, ispell.el: * macros.el, reposition.el: Don't repeat at load time any bindings that are autoloaded. * tex-mode.el (tex-send-command): Switch to buffer before checking for subproc output in it. * dired.el (dired-goto-file): Call expand-file-name. * page-ext.el (pages-copy-header-and-position): Call end-of-line, not forward-line. (pages-directory): Omit space at end of pages-directory-buffer. * dired-aux.el (dired-insert-subdir-validate): Call expand-file-name. Thu Dec 2 16:05:12 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * sendmail.el (mail-fcc): Take argument and use interactive spec to prompt, rather than calling read-file-name explicitly. This function is useful to call from programs with a computed argument. Thu Dec 2 15:57:47 1993 Richard Stallman (rms@srarc2) * mouse.el (mouse-yank-secondary): Doc fix. * makefile.el (makefile-ignored-files-in-pickup-regex): Supply missing \\. (makefile-insert-target-ref): Fix typo. * gnus.el (gnus-capitalize-newsgroup): Modify a new temporary syntax table, not the current one. * etags.el (etags-goto-tag-location): Improve not-found error msg. * files.el (insert-file): Add * to interactive spec. Thu Dec 2 07:47:48 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-locking-user): Don't assume that the umask permits group-write and other-write. Thu Dec 2 06:54:11 1993 Michael D. Ernst (mernst@monozygote) * vip.el (vip-replace-string): Don't use replace-regexp. * vc.el (vc-record-rename): Don't use replace-regexp. * bibtex.el (hide-bibtex-entry-bodies): Don't use replace-regexp. * allout.el (outline-copy-exposed): Don't use replace-regexp. Wed Dec 1 13:53:53 1993 Morten Welinder (terra@tyr.diku.dk) * desktop.el: Add keywords. (desktop-outvar): clean-up output using fewer quotes and \n for newlines. (desktop-save): print buffer information using \n for newlines. (desktop-save-buffer-p): doc fix. (desktop-save): bug in mark-activity saving. (desktop-buffer-rmail): doc fix. (desktop-buffer-rmail, desktop-buffer-dired, desktop-buffer): use `eq' instead of `equal'. (desktop-clear): end up with one window. Wed Dec 1 21:45:34 1993 Richard Stallman (rms@srarc2) * byte-opt.el: Add side-effect-free props for many functions. (byte-boolean-vars): Add highlight-nonselected-windows. * picture.el (picture-mode): Save the old truncate-lines value. (picture-mode-exit): Restore that value. * bytecomp.el (batch-byte-recompile-directory): Add autoload cookie. Wed Dec 1 04:35:25 1993 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * rlogin.el (rlogin-filter): initialize `region-begin' to (marker-position proc-mark), not just (point), whatever random value that may be. Put bindings for `proc-mark', `region-begin', and `window' in separate setq forms. In determining whether window-start readjustment is needed, do not examine scroll-step; it is irrelevant. Tue Nov 30 17:48:21 1993 Richard Stallman (rms@srarc2) * comint.el (comint-replace-by-expanded-history): Use skip-chars-forward to advance in main loop. Sat Nov 27 02:51:34 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.22 released. * vc.el (vc-buffer-sync): Signal error if user says no. * vc-hooks.el (vc-mode-line): Make buffer read-only for root if file is locked. * mouse.el (mouse-set-font): Update nonstandard faces that are supposed to use a modification of the frame's font. Fri Nov 26 15:41:51 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-variables): Abbreviate truename for comparison. Thu Nov 25 01:51:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * faces.el (make-face-unitalic, make-face-unbold, make-face-bold) (make-face-bold-italic, make-face-italic): If frame is t, do the special handling only if face-font is a list. * etags.el (tags-add-tables): New variable. (visit-tags-table-buffer): Use it. (default-tags-table-function): No longer user var, no longer autoload. * ange-ftp.el (ange-ftp-binary-file-name-regexp): Accept .tgz and .taz files. * tpu-edt.el (tpu-revision): Variable deleted. Wed Nov 24 15:08:12 1993 Rob Riepel (riepel@Snowflake.Stanford.edu) * tpu-edt.el (tpu-quoted-insert): New function. (tpu-reset-control-keys): Remove C-f mapping. Insert (in file) fsets for free/bound cursor, scroll margins, key mappings for same. * tpu-extras.el: Remove free/bound cursor and scroll margin fsets and key mappings. Add autoload cookies. * tpu-doc.el: Add sample test for tpu-set-scroll-margins. Wed Nov 24 00:03:32 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el (comint-send-input): Don't call comint-arguments to set HISTORY, even if comint-input-autoexpand is not `history'. When comint-input-autoexpand is `history', undo part of prev change: do put INPUT back in the buffer in place of expanded hist. * tabify.el: Add a provide. * vc.el (vc-next-action): Doc fix. (vc-checkout-carefully): New variable. (vc-next-action-on-file): Obey vc-checkout-carefully. * vc-hooks.el (vc-make-backup-files): Doc fix. (vc-rcs-status): Use colon, not dash, in the string LOCKS. * rmailsort.el (rmail-sort-messages): In summary buf, go to rmail buf. * subr.el (walk-windows): If start at minibuf window, do return to it. * comint.el (comint-send-input): Don't call comint-arguments while computing the value for history. (comint-delim-arg): Treat quoted delim chars as non-delims. Tue Nov 23 01:23:38 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (count-lines): In selective-display case, adjust value if end is not at bol. * isearch.el (isearch-other-meta-char): Correct the test for a split-up mode line or scroll bar mouse event. * icomplete.el: New file. * info.el (Info-follow-reference): Correct one-off error in comparing start-point. * dired-aux.el (dired-diff): Require diff. * telnet.el (telnet-rsh-program): New variable. (rsh): Use it. (telnet-count): Now buffer-local. * finder.el (finder-known-keywords): Add data, faces, mouse, matching. * edebug.el: Delete periods from error messages. (edebug-functionp): Recognize compiled functions. (edebug-display): Supply missing parens in let. * simple.el (repeat-complex-command): Undo Oct 2 change. * c-mode.el (c-indent-region): Don't goto-char sexpend if it's nil. As first thing, advance to a nonblank line. * view.el (View-scroll-lines-forward): Allow scrolling backward at the end of the buffer. * comint.el (comint-preinput-scroll-to-bottom): If SCROLL is `this', don't bother with walk-windows; just hack the selected window. * avoid.el: New file. * shadowfile.el: New file. Mon Nov 22 11:07:43 1993 Morten Welinder (terra@tyr.diku.dk) * add-log.el (add-change-log-entry): put buffer in change-log-mode. (find-change-log): correct calculation of file one directory out. Mon Nov 22 01:32:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired.el (dired-goto-file): Don't try matching one line twice. * rmailsum.el (rmail-summary-wipe): If rmail buffer is not visible, switch to it in this window. (rmail-summary-mode): Doc fix. * dired.el (dired-readin-insert): Expand default-directory and dirname before comparing them. (dired-internal-noselect): Set default-directory to abbreviated name. * mouse.el (mouse-save-then-kill-delete-region): Call undo-boundary at the beginning and at the end. * gnuspost.el (gnus-inews-do-fcc): If gnus-author-copy-saver is rmail-output, call rmail-output the proper way. * man.el (Man-specified-section-option): New variable. (Man-translate-references): Use that variable. Sun Nov 21 01:11:19 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-start-end): Use MODE mod 3. (mouse-save-then-kill): Test mouse-selection-click-count mod 3. (mouse-drag-secondary, mouse-secondary-save-then-kill): Likewise. * inf-lisp.el (inferior-lisp-proc): Clean up error message. * iso-acc.el (iso-accents-enable): New variable. (key-translation-map): Enable an accent only if in iso-accents-enable. * lisp-mode.el (lisp-eval-defun): Renamed from lisp-send-defun. (lisp-mode-map): Use new name lisp-eval-defun. Move run-lisp to C-x C-z. * sendmail.el (mail-yank-original): Delete windows on selected frame only. * mouse.el (mouse-kill-secondary): Do the kill in proper buffer. Give error if in the wrong buffer. (mouse-secondary-save-then-kill): Give error if click is not in the buffer already used for secondary selection. Don't switch windows; always temporarily switch buffers. * mail-utils.el (mail-fetch-field): Exclude trailing whitespace. Delete duplicate (goto-char (point-min)). * faces.el (x-resolve-font-name): Undo previous change. * info.el (Info-edit): Use proper map in substitute-command-keys. Sat Nov 20 00:49:20 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tex-mode.el (tex-send-command): Wait for output first, if text has not changed since previous tex-send-command. (tex-send-command-modified-tick): New buffer-local variable. * texinfo.el (texinfo-tex-region): Use tex-send-command to do commands. (texinfo-tex-buffer, texinfo-texindex, texinfo-tex-print): Likewise. (texinfo-delete-from-print-queue, texinfo-quit-job): Likewise. * tex-mode.el (tex-start-shell): Don't use -v option. (tex-send-command): Insert text in the buffer, then use comint-send-input to send it. * etags.el (tags-complete-tag): Bind enable-recursive-minibuffers to t. Fri Nov 19 18:36:55 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * startup.el (command-line): Set init-file-had-error to t or nil. (command-line-1): Inhibit startup message if init-file-had-error. Fri Nov 19 17:13:32 1993 Robert J. Chassell (bob@geech.gnu.ai.mit.edu) * texinfmt.el (texinfo-if-set, texinfo-if-clear): Act appropriately when flat neither set nor cleared. Fri Nov 19 10:57:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gnuspost.el (gnus-inews-do-fcc): Use gnus-output-to-rmail if file is an rmail file. Pass extra args to rmail-output. * simple.el (eval-expression): Don't bind minibuffer-history-sexp-flag. (edit-and-eval-command): Likewise. * ange-ftp.el (ange-ftp-parse-dired-listing): Skip extra blank line after the "total" line. * hexl.el (hexlify-buffer): Add autoload cookie. Thu Nov 18 00:24:34 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * iso-acc.el (iso-accents-list): Fix entries for 'y and ~c. (iso-accents-list): Add "s. Wed Nov 17 08:11:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el (comint-scroll-show-maximum-output): Make default nil. * gnus.el (gnus-summary-save-in-mail): Use rmail-output if the file is not an Rmail file. * font-lock.el (font-lock-hack-keywords): Handle next-single-property-change returning nil. Tue Nov 16 01:14:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.21 released. * gnus.el (gnus-summary-save-in-mail): Don't use rmail-output. Instead, use either gnus-output-to-rmail or gnus-output-to-file. Expand filename before use. * rmailout.el (rmail-file-p): Add autoload cookie. * comint.el (comint-send-input): Run comint-output-filter-functions only if process is using comint-output-filter as its filter. * subr.el (remove-hook): Doc fix. * rmail.el (rmail-set-attribute): Do nothing if MSGNUM is 0. * nntp.el (nntp-encode-text): Insert a CR before the newline. * info.el (Info-mode): Doc fix. * loaddefs.el: Delete duplicate etags.el autoloads. * add-log.el (change-log-default-name, add-log-current-defun-function) (add-log-full-name, add-log-mailing-address): Delete autoload cookies. Mon Nov 15 21:37:37 1993 Per Bothner (bothner@cygnus.com) * iso-acc.el (iso-accents-list): Added /A for A-with-ring and /E for AE-ligature, with lowercase versions. These letters are used (with O-with-slash) in Norwegian and Danish. Mon Nov 15 00:17:12 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * appt.el (appt-display-interval): New variable. (appt-check): Obey that variable. * sun.el (sun-raw-prefix): Make this just a variable, not a function name. * startup.el (command-line-1): Display a message in the echo area. * comint.el (comint-read-input-ring, comint-write-input-ring): Treat "" like nil in comint-input-ring-file-name. Mon Nov 15 13:21:51 1993 Robert J. Chassell (bob@grackle.stockbridge.ma.us) * page.el Add `provide'. (narrow-to-page): Enable page-delimiter to span lines. * page-ext.el: Revise documentation. Add `provide'. (pages-directory-for-adding-addresses-narrowing-p): New user option for adding addresses. Default to narrowing. (pages-directory-for-addresses): Intall user settable options. (add-new-page): Insert new page in specified location. (original-page-delimiter): Set default value to "^^L". Mon Nov 15 04:13:48 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * vc.el: vc-static-header-alist shouldn't have been declared const. Sun Nov 14 00:49:35 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmailout.el (rmail-output): New argument FROM-GNUS. * gnus.el (gnus-summary-save-in-mail): Pass new args to rmail-output. * solar.el (solar-equinoxes-solstices): Add autoload. * calendar.el (solar-holidays): Change top-level progn to an if. * mouse.el (mouse-save-then-kill-delete-region): Take args BEG and END. Update the undo list properly. (mouse-save-then-kill): Pass those args. When we kill, clear mouse-save-then-kill-posn and mouse-selection-click-count. (mouse-secondary-save-then-kill): Likewise. Delete the overlay after deleting the selection text. (mouse-selection-click-count): Initialize to 0. (mouse-save-then-kill-delete-region): Handle buffers with no undo list. Handle empty regions. Handle end < beg. * rmailsum.el (rmail-summary-forward): Accept prefix arg and pass it to rmail-forward. Sat Nov 13 01:58:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * compare-w.el (compare-windows-skip-whitespace): Swap the two and's within the or. * help.el (describe-project): New function, on C-h C-p. (help-for-help): Add C-p. Refer to help-command, not help-for-help, in the \\[...]. * paths.el (rmail-spool-directory): Check for irix, not silicon-graphic-unix. * dired.el (dired-chown-program): Likewise. * lpr.el (lpr-command): Likewise. * xscheme.el: Add a provide call. * dired.el (dired-make-relative): Expand DIR if starts with ~. Fri Nov 12 23:48:06 1993 Paul Eggert (eggert@twinsun.com) * cal-dst.el (calendar-absolute-from-time): Undo Sep 14 patch. Fix comments instead, since they didn't match the code. Fri Nov 12 17:16:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el (comint-match-partial-filename): Consider +@: part of filenames; don't consider parens as part of them. * fill.el (fill-individual-paragraphs): Fix skipping headers of yanked message. * rmailsum.el (rmail-summary-edit-map): Inherit text-mode-map properly. Fri Nov 12 03:52:03 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-rename-file): Don't overwrite an existing file. Fix test for unsaved files. Calculate name of new master file properly. Thu Nov 11 02:16:55 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.20 released. * man.el (Man-section-regexp): Allow section names l, n, L, N. Wed Nov 10 21:46:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * map-ynp.el (map-y-or-n-p): Handle help-char values other than chars. * c-mode.el (c-indent-region): When looking for a sexp that ends past this line, make sure it really starts on this line. * replace.el (occur-mode): Run occur-mode-hook. Wed Nov 10 20:53:06 1993 Robert J. Chassell (bob@kropotkin.gnu.ai.mit.edu) * texinfo.el (texinfo-texi2dvi-command): Separate `texi2dvi' command from `tex' command so `texinfo-format-region' can use straight `tex' command. (texinfo-format-buffer): Use `texinfo-texi2dvi-command' (texinfo-delete-from-print-queue): Revise documentation. (texinfo-quit-job): Use comint-send-input. * texinfmt.el (texinfo-format-region): Change `texinfo-[start end]-of-header' to `tex-[start end]-of-header'. Wed Nov 10 15:38:24 1993 Brian Fox (bfox@mole.gnu.ai.mit.edu) * rmail.el (rmail-start-mail): Don't do other frame unless we have a window system, irregardless of the state of rmail-mail-new-frame. * man.el (Man-filter-list): Include anything starting with alphabetics, and containing "Last change:". (manual-entry): Don't call `Man-downcase' since Man-translate-references has already done the right thing. * info.el (Info-extract-menu-item): Quote `*' in the menu-item leadin re-search to prevent us from finding node names which contain the text of another node name within them. * files.el (find-backup-file-name): Don't fatal-error on directories that are hard to read; fall back on ~/%backup%. * hexl.el (hexl-mode): Use `add-hook' to modify buffer local `write-contents-hooks'. (hexl-mode-exit): Remove our hook when turning off Hexl mode. * files.el (file-truename): Treat ~USER like just ~. * subr.el (remove-hook): New function, analogous to add-hook. This is now the recommended way to remove a hook that you have added. * lucid.el (remove-hook): Function deleted. Tue Nov 9 02:11:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * texinfo.el (texinfo-mode-map): Add C-c C-e bindings for texinfmt.el. * texnfo-upd.el (texinfo-sequential-node-update): Add autoload. (texinfo-update-node, texinfo-every-node-update): Add autoload. * comint.el (comint-postoutput-scroll-to-bottom): Don't alter point in a window if it's after the process-mark. Don't treat minibuffer window specially. * menu-bar.el (menu-bar-edit-menu): Add menu items for searching. * etags.el (etags-list-tags): Return t if found the file. (list-tags): Clear first-time when we go around the loop. Supply file name in error message. Remove dir names from files when preparing for completion. Mon Nov 8 18:40:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * shell.el: Doc fixes. Mon Nov 8 19:05:34 1993 Simon Marshall (Simon.Marshall@mail.esrin.esa.it) * comint.el (comint-preinput-scroll-to-bottom): Added comint-magic-space to list of commands recognised as inserting. * comint.el (comint-output-filter): Corrected check for killed buffer. Mon Nov 8 16:16:32 1993 Robert J. Chassell (bob@geech.gnu.ai.mit.edu) * texinfo.el (texinfo-show-structure): Indent appendices properly. Mon Nov 8 07:42:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * disp-table.el (describe-current-display-table): Don't get error if no display table now. (describe-display-table): Put all the output in the temp buffer. * ws-mode.el (wordstar-mode): Add autoload. * pascal.el: New file. * thingatpt.el: New file. * mouse-sel.el: New file. * ispell.el (ispell-message): Delete excess (beginning-of-line). * frame.el (set-frame-configuration): Iconify frames rather than making them invisible. * register.el (jump-to-register): Rename prefix arg to DELETE and invert its sense. * comint.el (comint-postoutput-scroll-to-bottom): Walk the windows even if scroll is nil. Sun Nov 7 03:09:57 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ispell.el (ispell-message): If gnus, but no mail-yank-prefix, use ispell-message-cite-regexp. Turn off case-fold-search for the searching and matching in this function. * ispell.el (ispell-message): Stop if ispell-region returns nil. (ispell-next, ispell-word): Catch ispell-quit, not quit. (ispell-next): Return t if exit normally (no throw to ispell-quit). (ispell-command-loop): For q, throw to ispell-quit. Explicitly handle C-g. (ispell): If we don't call ispell-next, return t. * compare-w.el (compare-windows-skip-whitespace): Return t if there is whitespace before point. * iso-acc.el (iso-accents-mode): Doc fix. * comint.el (comint-postoutput-scroll-to-bottom): Always keep point at end in all buffers if was at end. comint-scroll-to-bottom-on-output controls what to do if point was not already at the end. * iso-acc.el: Support ~ and /. Support 'Y, 'y, "y. Delete the `compose' support. (iso-accents-list): Fix typo in ^A code. Support ~< and ~>. * iso-transl.el: Alter isearch-mode-map so C-x 8 works in search. * frame.el (set-frame-configuration): If NODELETE, make the unwanted frames invisible. Sun Nov 7 11:19:25 1993 Ethan Bradford (ethanb@ptolemy.astro.washington.edu) * ispell.el (ispell-non-empty-string): New function. (ispell-message): Add autoload. Choose a citation regexp automatically. Don't fail if there is no following cited line after filled lines. Fri Nov 5 23:15:57 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * man.el (Man-frame-parameters): New variable. (Man-notify-when-ready): Handle `newframe' as Man-notify value. Thu Nov 4 07:01:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ange-ftp.el (ange-ftp-load): Handle extra args after the file name. Wed Nov 3 15:42:09 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * tex-mode.el (tex-alt-print): New function for menu bar. (tex-define-common-keys, tex-mode-map): Move some items from tex-define-common-keys to tex-mode-map. Add more menu-enable properties. (tex-append): Cope with both the original Pascal-based TeX and the newer C-based TeX. Wed Nov 3 14:59:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.el (other-frame): Subtract 1 from hpos for new mouse position. * sendmail.el (sendmail-send-it): Don't insert Sender. * tex-mode.el (tex-validate-region, tex-region): Enable menu items if only mark is active. Tue Nov 2 19:44:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-drag-region): Set this-command to mouse-set-point if not setting the mark. (mouse-save-then-kill): Consider mark-active only in transient mark md. Wed Oct 27 17:32:56 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tex-mode.el (tex-define-common-keys): Define menu items. Tue Oct 26 16:45:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el (comint-mode-map): Merge menu bar item Output into Input. Rename Completion to Complete. * font-lock.el (font-lock-fontify-buffer): Don't turn font-lock-mode on and off; just call font-lock-set-defaults. Tue Oct 26 14:08:10 1993 Lawrence R. Dodd (dodd@roebling.poly.edu) * ispell.el (ispell-look-command): New user variable. (ispell-do-look, ispell-lookup-build-list): Use it as PROGRAM for call-process instead of just "look". * ispell.el (ispell-complete-word-interior-frag): New command. (ispell-complete-word): New command. (ispell-menu-map): Add bindings for them. (ispell-gnu-look-still-broken-p, ispell-look-dictionary): New vars. * text-mode.el (text-mode-map): Bind ispell-complete-word to M-TAB. Tue Oct 26 14:07:22 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * simple.el (eval-expression): Fix typo: missing paren. (read-expression-map): Use an indirection to minibuffer-local-map rather than copying it. Mon Oct 25 23:28:41 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * bookmark.el (bookmark-load, bookmark-write-file): Bind enable-local-variables instead of enable-local-eval. Mon Oct 25 20:09:53 1993 Karl Fogel (kfogel@mole.gnu.ai.mit.edu) * bookmark.el (bookmark-load, bookmark-write-file): Made enable-local-eval be nil when loading a bookmark file, since bookmark context strings can contain eval forms from the files in which the bookmarks are set, and we don't want them evalled when .emacs-bkmrks is found! Got rid of ###autoload to put a bookmark menu on the menu-bar. Now it will appear on the File menu -- that change is made in menu-bar.el. See below: * menu-bar.el: Added a define-key for menu-bar-bookmark-map, so that bookmarks will appear on the File menu of the menu-bar, right after the Print Buffer item. Mon Oct 25 15:48:39 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el (comint-scroll-to-bottom-on-input): Default to nil. (comint-mode): Use pre-command-hook, not before-change-function. (comint-preinput-scroll-to-bottom): Take no arguments. (comint-output-filter-functions): Renamed from comint-output-filter-hook. (comint-output-filter): Pass STRING as arg to output hook functions. (comint-preinput-scroll-to-bottom): Take an arg. Move point to new process mark if it was at the old one. Scroll so only if point is at or after the process mark. When scrolling, put end of text on bottom line, regardless of point. Mon Oct 25 02:07:36 1993 Brian Fox (bfox@albert.gnu.ai.mit.edu) * ispell.el (ispell): If the buffer to spell has no associated file, or, the associated file has a special handler, use a temporary file with the buffer contents to pass to the local ispell process. * dired.el (provide): Provide "dired" before running user hooks. * ange-ftp.el (ange-ftp-dired-uncache): Fix parens so that `(setq ...' is a result of the if statement, and not a top level expression. * simple.el (eval-expression, edit-and-eval-command): Let minibuffer-history-sexp-flag be 't during the call to read-from-minibuffer. Sun Oct 24 19:18:52 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * iso-acc.el: Define "dead keys" in key-translation-map, not in global-map. (iso-accents-compose): New subroutine to do the composition. Method of doing so is new. (iso-accents-accent-key): Use iso-accents-compose. (iso-accents-compose-key): New function. Sat Oct 23 17:25:41 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * isearch.el (isearch-yank): Handle `kill' as chunk type. (isearch-yank-kill): New command, on M-y and mouse-2. * frame.el (make-frame): Use before-make-frame-hook and after-make-frame-hook. * comint.el (comint-scroll-to-bottom-on-output) (comint-scroll-to-bottom-on-input): Default to nil if baud-rate<=9600. Fri Oct 22 13:10:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * comint.el (comint-filename-prefix): Deleted. * rlogin.el (rlogin, rlogin-mode): Use comint-file-name-prefix, not comint-filename-prefix. Thu Oct 21 22:22:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * shell.el (shell-after-partial-filename): Renamed from shell-after-partial-pathname. * comint.el (comint-after-partial-file-name-command): Renamed from comint-after-partial-pathname-command. (comint-match-partial-file-name, comint-after-partial-file-name): Renamed from comint-match-partial-pathname, etc. Thu Oct 21 23:10:27 1993 Simon Marshall (Simon.Marshall@mail.esrin.esa.it) * shell.el (shell-after-partial-pathname): New subroutine. * shell.el: Renamed shell-command-execonly to shell-completion-execonly for consistency. * shell.el (shell-read-input-ring, shell-input-ring-file-name): Moved to, and renamed in, comint.el. * shell.el (shell-dynamic-complete-command): Make sure local completion-ignore-case is nil. * shell.el (shell-mode): Set buffer-local variable paragraph-start to comint-prompt-regexp so paragraph motion/mark commands work on output groups. Set comint-after-partial-pathname to it. (shell-read-input-ring): Use find-file-noselect. * shell.el (shell-match-cmd-w/optional-arg): Removed. * comint.el (comint-last-output-start): New variable to record where most recent process output started from. (comint-mode): Initialise it. (comint-output-filter): Set it. * comint.el (comint-previous-matching-input-string): Moved to comint-previous-matching-input-position. (comint-previous-matching-input-string): Use it. (comint-search-arg, comint-search-start, comint-previous-input-string): New subroutines. (comint-previous-input, comint-next-input, comint-previous-matching-input, comint-next-matching-input, comint-previous-matching-input-from-input, comint-next-matching-input-from-input): Use them. * comint.el (comint-mode-map): Added signal menu-bar. Moved comint-backward/forward-matching-input to output menu-bar, since they move within the buffer rather than do input. * comint.el (comint-send-input, comint-after-pmark-p, comint-kill-input, comint-proc-query): Removed serialisation of obtaining the process mark's marker-position. * comint.el, shell.el: Commented out comint/shell-load-hooks. * comint.el (comint-dynamic-simple-complete): New subroutine. * comint.el (comint-dynamic-complete-filename-command): New variable. (comint-after-partial-pathname-command): New variable. (comint-after-partial-pathname): New subroutine. (comint-dynamic-complete): Use them. (comint-mode): Make them local. * comint.el, shell.el: Renamed comint-dynamic-complete-command to comint-dynamic-complete-command-command for consistency. Renamed comint-file-name-addsuffix/autolist/recexact to comint-completion-addsuffix/autolist/recexact for consistency. * comint.el (comint-replace-by-expanded-history): Check if input ring size is not big enough for relative reference. * comint.el (comint-read-input-ring, comint-input-ring-file-name): From shell.el. (shell-write-input-ring): New subroutine. * comint.el (comint-file-name-prefix): New variable. (comint-directory): New inline subroutine. (comint-dynamic-complete-filename, comint-dynamic-complete-variable, comint-dynamic-list-filename-completions): Use it. * comint.el (comint-dynamic-complete-filename, comint-dynamic-complete-variable, comint-dynamic-list-filename-completions): Make sure local completion-ignore-case is nil. * comint.el (comint-next-prompt, comint-previous-prompt): Use paragraph-start and paragraph motion commands rather than re-search-forward and re-search-backward commands. * comint.el (comint-dynamic-list-input-ring, comint-previous-matching-input-string): Use ring-empty-p rather than zerop and ring-length. * comint.el (comint-input-ignoredups): New variable. (comint-send-input, shell-read-input-ring): Use it. (comint-mode): Make comint-input-ignoredups local. Doc fix. * comint.el (comint-scroll-to-bottom-on-input): New variable. (comint-scroll-to-bottom-on-output): New variable. (comint-scroll-show-maximum-output): New variable. (comint-output-filter-hook): New variable, defaults to comint-postoutput-scroll-to-bottom. * comint.el (comint-output-filter): Renamed from comint-filter for consistency. Now calls comint-output-filter-hook. * comint.el (comint-preinput-scroll-to-bottom): New subroutine. (comint-postoutput-scroll-to-bottom): New subroutine. (comint-show-maximum-output): New command. (comint-copy-old-input): New command. * comint.el (comint-send-input): Run comint-output-filter-hook if necessary as a kludge to prevent messy redisplays. * comint.el (comint-mode-map): Added comint-show-maximum-output to C-c C-e and menu-bar output, and comint-copy-old-input to C-c C-i and menu-bar input. * comint.el (comint-mode): Make local variables comint-scroll-to-bottom-on-input, before-change-function, comint-scroll-to-bottom-on-output, comint-scroll-show-maximum-output, and comint-output-filter-hook. Thu Oct 21 13:51:51 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (blink-matching-open): Treat / syntax like \ syntax. * texinfmt.el (texinfo-format-begin-end): Bind cmd locally. (texinfo-defun-type): Renamed from command-type in various fns. (texinfo-command-start, texinfo-command-end, texinfo-command-name) (texinfo-defun-type, texinfo-last-node-pos, texinfo-stack) (texinfo-short-index-cmds-alist) (texinfo-short-index-format-cmds-alist, texinfo-format-filename) (texinfo-footnote-number, texinfo-start-of-header) (texinfo-end-of-header, texinfo-raisesections-alist) (texinfo-lowersections-alist): Add defvars. Wed Oct 20 14:06:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cdl.el: New file. Wed Oct 20 08:00:51 1993 Brian Fox (bfox@gnu.ai.mit.edu) * forms.el (forms--set-minor-mode): Rewrite so that describe-mode can parse the value of minor-mode-alist correctly. The string " View" is now dependent on the value of forms-read-only. Wed Oct 20 08:00:51 1993 Johan Vromans (jv@mh.nl) * forms.el: Documentation: `forms-forms-scroll' and `forms-forms-jump' now default to nil. `forms-new-record-filter' and `forms-modified-record-filter' cannot be redefined as functions. Commands and keymaps are changed. Add function key defs. (forms-version): Docstring includes full RCS id. (forms-forms-scroll): Defaults to nil. (forms-forms-jump): Defaults to nil. (forms-mode-edit-map, forms-mode-ro-map): Additional keymaps for edit mode and read-only mode. (forms--new-record-filter, forms--modified-record-filter): Deleted. (forms-mode): Docstring now includes the key bindings, since both edit mode and read-only mode must be supported. Changed `forms-new-record-filter' and `forms-modified-record-filter' semantics: the variable must point to a function and may not be defined as a function anymore. Use three keymaps: `forms-mode-map' (C-c commands), `forms-mode-edit-map' (normal mode) and `forms-mode-ro-map' (read-only mode). The maps are not buffer local. Changed the text of error messages to be more descriptive, and consistent with the documentation. Moved setting up write-file-hooks and revert-buffer-function to function `forms--change-commands'. (forms--process-format-list): Changed error messages to be more descriptive. (forms--set-keymaps): Setup the three keymaps. (forms--mode-commands): Use new command key bindings. (forms--mode-commands1): New helper function for `forms--mode-commands'. (forms--change-commands): Handle setup of local-write-file-hooks and revert-buffer-function. (forms--help): Show new command bindings. (forms--show-record): Replaced `forms--modified-record-filter' by `forms-modified-record-filter'. (forms-jump-record): Changed error message. (forms-toggle-read-only): New function, replaces `forms-view-mode' and `forms-edit-mode'. (forms-view-mode, forms-edit-mode): Deleted. (forms-insert-record): Replaced `forms--new-record-filter' by `forms-new-record-filter'. (forms-insert-record, forms-delete-record): Disallow in read-only mode. (forms-prev-field): New function. Tue Oct 19 09:50:13 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-week-start-day): New var (autoloaded) to allow the calendar week to start on any day, not just Sunday. (calendar-mod): New support function. (calendar-cursor-to-visible-date, generate-calendar-month, calendar-beginning-of-week, calendar-end-of-week): Rewritten to use new var calendar-week-start-day. * holidays.el (holiday-easter-etc): Fix Ascension Day string. * diary.el (list-sexp-diary-entries): Fix doc string. * solar.el (solar-n-hemi-seasons, solar-s-hemi-seasons): New vars. (solar-equinoxes-solstices): Use them to fix names for southern hemisphere. * calendar.el (calendar-day-name-array, calendar-month-name-array, calendar-islamic-month-name-array, calendar-hebrew-month-name-array-common-year, calendar-hebrew-month-name-array-leap-year): Change to defvar. * diary.el (hebrew-calendar-parashiot-names): Change to defvar. Mon Oct 18 03:54:58 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (list-tags): Fix completing-read call interactive spec; TABLE and PREDICATE args were reversed, and more processing was needed on tags-table-files. Mon Oct 18 02:41:47 1993 Noah Friedman (friedman@gnu.ai.mit.edu) * rlogin.el (rlogin-initially-track-cwd): New variable. (rlogin): Use it to determine whether enable directory tracking via ange-ftp. (rlogin-mode): Make `comint-filename-prefix' local here. * rlogin.el (rlogin): Arguments to function are now a string with multiple words (hostname first) and an optional prefix. (rlogin-with-args): Function deleted. * rlogin.el (rlogin): Set process filter after calling `rlogin-mode' since the latter called `comint-mode', which sets its own initial process filter. Mon Oct 18 20:28:36 1993 Barry A. Warsaw, ITB (warsaw@anthem) * reporter.el: (reporter-submit-bug-report, reporter-mailer): reporter-mailer variable can now take a list of mailers, trying each one until an commandp one is found. * reporter.el: Fixed elisp archive address. Handle dumping of buffer local variables via reporter-eval-buffer. Thu Oct 14 18:28:24 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-backend-checkout): Do not set umask to value that does not allow user-write permission while `co' is running; this breaks versions of `co' that need to write temporary files. Wed Oct 13 20:11:51 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * rmailout.el (rmail-output-file-alist): Doc fix. Wed Oct 13 02:20:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * supercite.el, regi.el: New files. * sc-elec.el: Files deleted. * sc.el: Just load supercite. Tue Oct 12 16:57:23 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (abbreviated-home-dir): Doc fix. Mon Oct 11 20:53:34 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * map-ynp.el (map-y-or-n-p): Take new optional arg to not set cursor-in-echo-area. Sun Oct 10 18:13:18 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-retry-setup-hook): New hook variable. (rmail-retry-failure): Use that variable. * pp.el: New file. Sat Oct 9 17:43:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ispell.el (ispell-message-cite-regexp): Add definition. Sat Oct 9 03:12:59 1993 Karl Fogel (kfogel@occs.cs.oberlin.edu) * bookmark.el (bookmark-write): Add numbered backups for bookmark file. (bookmark-version-control): New variable. * bookmark.el (bookmark-jump): bookmark-jump now gives a default value if no bookmark is entered manually. (bookmark-set): Default to bookmark-current-bookmark or buffer-name the way bookmark-jump does. * bookmark.el (ctl-x-map): Check if C-x r is a prefix before using it as one. * bookmark.el: Include string "Bookmarks" in defining [menu-bar bookmark] in global-map in the menu-bar code. * bookmark.el (menu-bar-bookmark-map): Supply t as 4th arg of autoload. * bookmark.el (bookmark-jump-noselect): New subroutine taken from bookmark-jump. Support compressed files. (bookmark-jump): Call bookmark-jump-noselect. Offer to relocate if necessary, but change default dir to that of the old bookmark in read-file-name. * bookmark.el: (bookmark-set, bookmark-rename, bookmark-delete, bookmark-write-file, bookmark-load, Bookmark-menu-show-filenames, Bookmark-menu-hide-filenames, Bookmark-menu-bookmark, Bookmark-menu-save, Bookmark-menu-load): Fixed the save-excursion bugs by wrapping things in save-window-excursion as well. (bookmark-make-menu-bar-alist): Added sorting. (bookmark-map): Added new keybindings. (bookmark-try-default-file): Set bookmarks-already-loaded to t after the load. * bookmark.el (list-bookmarks): Added bookmark menu stuff. (Bookmark-menu-*): New functions. Sat Oct 9 15:59:31 1993 David J. MacKenzie (djm@kropotkin.gnu.ai.mit.edu) * isearch.el, reporter.el: Change comments saying they're not yet part of GNU Emacs. Fri Oct 8 22:01:33 1993 Jonathan I. Kamens (jik@security.ov.com) * timezone.el (timezone-parse-date): Handle new style 22-AUG-1993. * rmail.el (rmail): Really don't get new mail if file name was given. (rmail-reformat-message): Move past Mail-from as well as Summary-line. (rmail-toggle-header): Likewise. (rmail-next-undeleted-message): Return t unless hit end of buffer. (rmail-delete-forward): Likewise. (mail-unsent-separator): Add `Original message follows'. (rmail-resend): Handle mail-self-blind. * files.el (hack-local-variables): If buffer has no file, display its buffer name. * rmailout.el (rmail-output): If message was shown with full headers, copy the full headers (or each message copied) into the file. New local var original-headers-p, header-beginning, mail-from. Bind locals outside the while loop. Kill tembuf only after loop. If message has a saved mail-from field, use that. Detect reaching end of rmail buffer; display # messages copied. Wed Oct 6 23:02:55 1993 Morten Welinder (terra@diku.dk) * desktop.el: Internal clean-up. Save information about current tags files, don't save the tags buffers (to save reload time). Don't save desktop-globals-to-save (desktop files must be erased for this to take effect, sorry.) Save "mark-activity" and allow multi-dir direds. Mon Oct 4 21:56:46 1993 Brian Fox (bfox@albert.gnu.ai.mit.edu) * telnet.el (rsh): Add `host' to args passed to make-comint. Mon Oct 4 20:22:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-convert-to-babyl-format): Protect against nonsensical content-length values. Mon Oct 4 20:51:01 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * vc.el (vc-next-action): Fix (throw ... ) invocation to work with 19; allows vc-next-action on all marked files in a dired buffer to work. (vc-finish-logentry) There isn't necessarily a *VC-log-entry* buffer to remove if this function was called from within a dired buffer. Fix its handling of this case. Sat Oct 2 15:53:27 1993 Brian J. Fox (bfox@ai.mit.edu) * simple.el (edit-and-eval-command): Let `read-from-minibuffer' manipulate the history list, don't manipulate it directly. (repeat-complex-command): Same thing. Fri Oct 1 18:40:22 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mailabbrev.el (build-mail-abbrevs): Pass just 1 arg to substitute-in-file-name. Mon Sep 27 04:36:31 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-find-binary): Fix bug; it always claimed success. Sun Sep 26 16:00:42 1993 Johan Vromans (jv@mh.nl) * forms.el: Version 2.3. Documentation: `forms-forms-scroll' and `forms-forms-jump' now default to nil. `forms-new-record-filter' and `forms-modified-record-filter' cannot be redefined as functions. Commands and keymaps are changed. Add function key defs. (forms-version): Docstring includes full RCS id. (forms-forms-scroll): Defaults to nil. (forms-forms-jump): Defaults to nil. (forms-mode-edit-map, forms-mode-ro-map): Additional keymaps for edit mode and read-only mode. (forms--new-record-filter, forms--modified-record-filter): Deleted. (forms-mode): Docstring now includes the key bindings, since both edit mode and read-only mode must be supported. Changed `forms-new-record-filter' and `forms-modified-record-filter' semantics: the variable must point to a function and may not be defined as a function anymore. Use three keymaps: `forms-mode-map' (C-c commands), `forms-mode-edit-map' (normal mode) and `forms-mode-ro-map' (read-only mode). The maps are not buffer local. Changed the text of error messages to be more descriptive, and consistent with the documentation. Moved setting up write-file-hooks and revert-buffer-function to function `forms--change-commands'. (forms--process-format-list): Changed error messages to be more descriptive. (forms--set-keymaps): Setup the three keymaps. (forms--mode-commands): Use new command key bindings. (forms--mode-commands1): New helper function for `forms--mode-commands'. (forms--change-commands): Handle setup of local-write-file-hooks and revert-buffer-function. (forms--help): Show new command bindings. (forms--show-record): Replaced `forms--modified-record-filter' by `forms-modified-record-filter'. (forms-jump-record): Changed error message. (forms-toggle-read-only): New function, replaces `forms-view-mode' and `forms-edit-mode'. (forms-view-mode, forms-edit-mode): Deleted. (forms-insert-record): Replaced `forms--new-record-filter' by `forms-new-record-filter'. (forms-insert-record, forms-delete-record): Disallow in read-only mode. (forms-prev-field): New function. Sun Sep 26 21:36:07 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * disass.el (disassemble-internal): Allow a call to byte-code as argument. Fri Sep 24 00:08:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ispell.el (ispell-message): Handle cited messages. * frame.el (other-frame): Warp the mouse so that the other frame actually stays selected. Wed Sep 22 12:37:21 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-delete-max-match): New function. (mouse-choose-completion): Use that. Now supports buffers other than minibuffer. * comint.el (comint-version): Deleted--no need for separate version. (comint-input-ring-index): Make this a permanent local. (comint-mode): Don't alter comint-input-ring-index or comint-input-ring if already set meaningfully. Tue Sep 21 16:23:23 1993 Simon Marshall (Simon.Marshall@mail.esrin.esa.it) * comint.el (comint-mode-map): Added keys M-R/S for comint-previous/next-matching-input-from-input and to completion menu-bar. Added comint-forward/backward-matching-input and comint-previous/next-matching-input to completion menu-bar. * comint.el (comint-mode): Doc fix for functionality. * comint.el (comint-exec-1): Uses setenv. (comint-update-env): Removed. * comint.el (comint-input-ring-size): Incremented to 32, as with command history. (comint-dynamic-list-input-ring): Check for zero length ring. Use ring length, not ring size, when generating list. Use buffer " *Input History*". (comint-previous-matching-input-string): Check for zero-length ring. Check last item in case at end of cycle and it's a match. (comint-searching-input-ring): New subroutine. * comint.el (comint-regexp-arg): New subroutine. * comint.el (comint-previous-matching-input-from-input): New command. (comint-next-matching-input-from-input): New command. * comint.el (comint-replace-by-expanded-history): Fix for matching inside quotes. Fix to allow argument subrange specifiers. Fix to identify and reject absolute input number references. * comint.el (comint-within-quotes): New subroutine. (comint-how-many-region): New subroutine. (comint-args): New subroutine. (comint-delim-arg): New subroutine. (comint-arguments): New subroutine. (comint-delimiter-argument-list): New variable. * comint.el (comint-send-input): Inserts input arguments into ring separated by single spaces. * comint.el (comint-filter): Checks the buffer's process to make sure it's still there. Otherwise, set-buffer will fail. * comint.el (comint-backward-matching-input): New command. (comint-forward-matching-input): New command. * comint.el (comint-next-prompt, comint-previous-prompt): Error if reach beg/end of buffer. * comint.el (comint-dynamic-complete): Fix for absolute input number references. (comint-dynamic-complete-filename): Changed listings function to comint-dynamic-list-filename-completions. Uses file-directory-p rather than string-match to test for directories. (comint-dynamic-list-completions): Changed to list the list of completions supplied as the function argument. Use buffer " *Completions*". * comint.el (comint-match-partial-pathname): New subroutine. (comint-dynamic-complete-variable): New command. (comint-dynamic-list-filename-completions): New function. * shell.el (shell-delimiter-argument-list): New variable. (shell-input-ring-file-name): New variable. * shell.el (shell-mode-map): Changed file name completions listing binding to new name comint-dynamic-list-filename-completions. * shell.el (shell-mode): Call new function shell-read-input-ring and shell-dirstack on start up. Doc fix for new functionality. * shell.el (shell-mode): Set shell-input-ring-file-name depending on the command that was invoked for the inferior shell. Set comint-delimiter-argument-list to shell-delimiter-argument-list. * shell.el (shell-read-input-ring): New function. * shell.el (shell-directory-tracker): Use comint-arguments. * shell.el (shell-front-match): Removed. (shell-match-cmd-w/optional-arg): Removed. * shell.el (shell-process-popd): Fixed bug when numeric argument equal to length of stack including current directory. (shell-process-pushd): Fixed missing ()s in cond. * shell.el (shell-dynamic-complete-command): Uses exec-path minus trailing emacs library path. Uses "." for nil elements in exec-path. Uses string-match rather than funcall to test candidate extensions. Uses member on completions list rather than file-exists-p to test for existence. Uses file-directory-p rather than funcall to test for directory. Uses directories only if in current directory. Uses comint-dynamic-list-completions. Tue Sep 21 07:42:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * loaddefs.el (global-map): Add bindings for menu and find keys. (function-key-map): Add translation for labeled help key. * mouse.el (mouse-drag-region): Put the text on the kill ring. Don't set mark if region is empty. (mouse-yank-at-click): Set this-command. (mouse-start-end): Fix double-click-on-closeparen case. (mouse-save-then-kill): When used repeatedly at different places, alter the nearer end of the region. This applies regardless of how the previous selection was made. (mouse-drag-secondary, mouse-secondary-save-then-kill): Rewrite for xterm-style dragging and extending. * comint.el (comint-previous-input): Don't use replace-match; just insert before deleting. (comint-magic-space): Use self-insert command. (comint-history-file-name): New variable. Tue Sep 21 03:18:47 1993 Brian Fox (bfox@albert.gnu.ai.mit.edu) * edebug.el (edebug-enter): Don't call the current function being debugged in pre-command-hook or post-command-hook. Mon Sep 20 23:43:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * edmacro.el: Total rewrite by Gillespie. Mon Sep 20 17:38:06 1993 Simon Marshall (Simon.Marshall@mail.esrin.esa.it) * shell.el (shell-command-regexp, shell-command-execonly) (shell-pushd-tohome, shell-pushd-dextract) (shell-pushd-dunique): New variables. * shell.el (shell-mode-map): Bound shell-forward/backward-command to C-c C-f and C-c C-b. * shell.el (shell-mode): Set comint variables for which shells have different values: comint-get-current-command, comint-dynamic-complete-command. * shell.el (shell-directory-tracker): Parse through command sequences for directory commands. (shell-process-popd): Signal error if can't process argument/stack. Fixed bug when no argument and no stack. (shell-process-cd): Signal error if can't process argument. (shell-process-pushd): Signal error if can't process argument/stack. Handle shell-pushd-tohome, shell-pushd-dextract, and shell-pushd-dunique. * shell.el (shell-forward-command, shell-backward-command) (shell-dynamic-complete-command): New commands. Mon Sep 20 14:57:52 1993 Simon Marshall (Simon.Marshall@mail.esrin.esa.it) * comint.el (comint-mode): Initialize comint-input-ring before running comint-mode-hook. * comint.el (comint-input-autoexpand): New variable. (comint-dynamic-complete-command): New variable. (comint-get-current-command): New variable. * comint.el (comint-read-input-ring): New function. * comint.el (comint-send-input): Handle history expansion. (comint-input-sentinel): Doc fix. * comint.el (comint-mode-map): Added key binding for C-c C-h. Added menu bars for completion, input and output. * comint.el (comint-dynamic-list-input-ring): New function. * comint.el (comint-previous-input-string): New subroutine. (comint-previous-input): Use it. (comint-previous-matching-input-string): New subroutine. (comint-previous-matching-input): Use it. * comint.el (comint-replace-by-expanded-history): New command. (comint-magic-space): New command. (comint-replace-by-expanded-filename): Now replaces expanded match for a filename, and then calls filename completion comint-dynamic-complete-filename to do file name completion. * comint.el (comint-kill-output): Don't kill prompt. (comint-show-output): Don't move point if it's visible where it is, and if point is moved, put it after prompt. * comint.el (comint-dynamic-complete): Totally new definition. (comint-dynamic-complete-filename): New name for old function comint-dynamic-complete, completes files and lists candidates, souped up for configurability. (comint-dynamic-complete-variable): New command. (comint-file-name-autolist): New variable. (comint-file-name-addsuffix): New variable, (comint-file-name-recexact): New variable. Mon Sep 20 11:39:04 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-save-then-kill): If follows a multi-click selection, extend the selection. (mouse-save-then-kill-delete-region): New subroutine. (mouse-selection-click-count): New variable. (mouse-drag-region): Set it. * ispell.el (ispell-message): New command, with menu bar item. Sat Sep 19 22:05:38 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * menu-bar.el (revert-buffer): Enable menu item when the buffer is modified. Fri Sep 17 10:31:48 1993 Brian Fox (bfox@inferno) * simple.el (kill-region): Use `equal' instead of `eq' to compare markers `beg' and `end'. They might be two different markers that point to the same place. * rmail.el (rmail-forward): Insert the forwarded message on the line which follows mail-header-separator, not at the end of the buffer. * diary.el (diary-syntax-table): Make sure that we use a copy of standard-syntax-table, and not the table itself. * compile.el (compile-reinitialize-errors): Use ">=" to compare `find-at-least' to the `length' of compilation-error-list. * simula.el (simula-mode-syntax-table): Make sure that we use a copy of standard-syntax-table, and not the table itself. * compile.el (compile-internal): Back out jimb change of making buffer read-only. It is non-ergonomic. * vc.el (vc-print-log): Delete extraneous lines of RCS output if present. * dired.el (dired-mode): Don't change the value of case-fold-search. Wed Sep 15 12:56:44 1993 Brian Fox (bfox@inferno) * files.el (local-write-file-hooks): Make this variable buffer-local. * dired.el (dired-build-subdir-alist): Call `expand-file-name' to clean up the subdirectory title (removing extra "./"). Tue Aug 31 21:16:29 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-do-command): Remove debugging output. Use (forward-line -1) instead of (previous-line 1). Tue Sep 14 00:58:34 1993 Brian Fox (bfox@inferno) * rmail.el (rmail-convert-file): If the file is empty, don't convert it after inserting the BABYL header. * cal-dst.el (calendar-absolute-from-time): Fix typo by interchanging (floor) and (%). * byte-opt.el (side-effect-free-fns): Add "-" and "1-" to the list. * subr.el (suppress-keymap): Use substitute-key-definition instead of manually checking each key (we were using 127 instead of 255 anyway). * loaddefs.el (ctl-x-map): `C-x r c' now runs `clear-rectangle'. * texinfmt.el (texinfo-format-region texinfo-format-buffer): Add ###autoload cookies. (batch-texinfo-format): Use `buffer-disable-undo' instead of obsolete function `buffer-flush-undo'. * solar.el (s-hemi-seasons n-hemi-seasons): New constants are hemisphere dependent list of season names. The names are "international"; i.e., `vernal' and `autumnal' are used consistently. (solar-equinoxes-solstices): Use new constants, allowing southern hemisphere reports to be meaningful. (sunrise-sunset): Use `frame-width' instead of `screen-width'. * calendar.el (calendar-mode): Fix typos in documentation string. * outline.el (outline-minor-mode): Force update of modeline when outline-minor-mode is toggled. Thu Aug 26 23:07:00 1993 Jim Blandy (blandy@comano.cscs.ch) * add-log.el (add-log-full-name, add-log-mailing-address): New variables. (add-change-log-entry): Don't ask for the login name and site name separately; instead, prompt for a mailing address; that's more useful. Set add-log-full-name and add-log-mailing-address, so that the values specified persist after being specified once. Create a new change log entry if the mailing address doesn't match; don't just compare the date, full name, and login name. Wed Sep 1 10:31:28 1993 Brian Fox (bfox@inferno) * tex-mode.el (slitex-mode): Add ###autoload magic cookie. Fri Aug 27 00:40:59 1993 Brian Fox (bfox@sonderbar) * diff.el (diff): Doc fix. Tue Aug 17 23:50:18 1993 Brian Fox (bfox@inferno) * version.el: Changed comment to refer to actual filename "inc-vers.el" instead of "inc-version.el". Fri Sep 17 17:24:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (mouse-set-region): Put region in kill ring. (mouse-drag-region): Handle double and triple clicks when displaying region and when setting it. (mouse-skip-word, mouse-start-end): New functions. Fri Sep 17 14:42:39 1993 Stig@netcom.com (Jonathan Stigelman) * hilit19.el: - (hilit-rehighlight-region): added (save-restriction (widen)) to avoid hangups in dired. - Also slight improvements to fortran patterns and hilit-default-face-table doc string - added optional case-fold argument to hilit-set-mode-patterns - added hilit-rehighlight-buffer-quietly to dired-after-readin-hook - fixed bug in hilit-string-find that mishandled some strings: "\\" - work-around for bug in next-overlay-change - the pattern matcher now starts it's searches from the end of the most recently highlighted region (which is not necessarily the end of the most recently matched regex). - code moved from hilit-highlight-region to hilit-set-mode-patterns. This will affect you if you pass your patterns directly to hilit-highlight-region....use a pseudo-mode instead. - twiddled C/C++, latex, texinfo, fortran, nroff patterns. - added calendar-mode, icon-mode and pascal-mode patterns - diverged lisp-mode and emacs-lisp-mode...also added lisp keywords. Fri Sep 17 14:52:33 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * yow.el (read-zippyism): New function. * cookie1.el (read-cookie): New function. Fri Sep 17 13:51:33 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (directory-abbrev-alist): Doc fix. Thu Sep 16 10:52:37 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gud.el (perldb): New function, plus subroutines. * text-mode.el (indented-text-mode): Make only blank lines separate or start paragraphs. Doc fix. * font-lock.el (font-lock-fontify-region): Don't add `font-lock' props. (font-lock-unfontify-region): Don't remove `font-lock' props. (font-lock-hack-keywords): Don't add `font-lock' props. Handle values other than t and nil for allow-overlap-p specially. (c-font-lock-keywords-1): Don't override how comments in #if... appear. Highlight text after #else or #endif. Wed Sep 15 19:22:28 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-version-other-window): New function. (vc-backend-checkout): Add optional arg workfile, which specifies where to put the working file. * vc-hooks.el (vc-prefix-map): Bind C-x v ~ to vc-version-other-window. Wed Sep 15 17:45:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-forward): Insert the text right after the header separator. * iso-acc.el: Set up keymap at load time. (iso-accents-mode): Not here. Just setq iso-accents-minor-mode. (iso-accents-minor-mode): Make it local in all buffers. Tue Sep 14 12:51:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * iso-acc.el: New file. Rename `iso-accents' to `iso-accents-mode' and change comments accordingly. Fix doc strings. (iso-accents-minor-mode): Now a user option. (iso-accents-mode): Positive arg means enable. No arg means toggle. Mon Sep 13 19:49:45 1993 Per Cederqvist (ceder@signum.se) * forms.el: Change typos in comments. (forms-delete-record, forms--update): Use `delete-region' instead of `kill-line' to avoid messing around with the kill ring. Mon Sep 13 23:35:33 1993 Johan Vromans (jv@mh.nl) * forms.el: Release 2.1 for Emacs 19.19. (forms--process-format-list): No need to prepend a text item anymore. (forms--ro-modification-start): Renamed to `forms--iif-start. (forms--ro-properties): Renamed to `forms--iif-properties'. (forms--romh): Renamed to `forms--iif-hook'. Rewritten to use `insert-in-front-hooks' instead of `modification-hooks'. (forms--romh-post-command-hook): Renamed to `forms--iif-post-command-hook'. Rewritten to use `insert-in-front-hooks' instead of `modification-hooks'. (forms--make-format, forms--make-format-elt-using-text-properties): Use `insert-in-front-hooks' instead of `modification-hooks'. Remove `forms--electric' code. Use `front-sticky' and `rear-nonsticky' text properties to control the insertion of text between read-only fields. (forms--show-record): Remove `forms--electric' code. Sun Sep 12 07:24:21 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sc.el (sc-glom-headers): Bind mark-active around calling region-... (sc-cite-original): Likewise. Sat Sep 11 06:39:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * font-lock.el (font-lock-fontify-region): Put on `font-lock' property as well as `face' property. (font-lock-hack-keywords): Likewise. * rmail.el (rmail-convert-file): Narrow to exclude the Babyl header. Fri Sep 10 01:05:45 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * paths.el (rmail-spool-directory): Use "/var/mail/" if system-type is netbsd. Thu Sep 9 00:31:27 1993 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * rlogin.el: require 'shell. Wed Sep 8 12:06:37 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-backend-steal): Fix typo when invoking the 'rcs' command to steal the lock. Wed Sep 8 02:22:59 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * shell.el (shell-dirstack-message): Recognize ~ by matching the expansion of "~" with comint-filename-prefix prepended. Strip comint-filename-prefix from elts. * comint.el (comint-filename-prefix): New variable. (comint-replace-by-expanded-filename, comint-dynamic-complete, comint-dynamic-list-completions): Prepend it to absolute file names before completing. * shell.el (shell-cd): New function, like `cd' but prepend comint-filename-prefix. (shell-resync-dirs, shell-process-cd, shell-process-pushd, shell-process-popd): Use shell-cd in place of cd. * rlogin.el (rlogin): After rlogin-mode, set comint-filename-prefix locally to indicate the host, and cd to /HOST:~/. (rlogin-mode-map): Start with (cons 'keymap shell-mode-map), rather than with a full copy of comint-mode-map. * ange-ftp.el (ange-ftp-file-executable-p): New function, handles file-executable-p. Tue Sep 7 13:06:55 1993 Ron Schnell (ronnie@media.mit.edu) * dunnet.el (dun-save-game): Use correct name of endgame question. Tue Sep 7 04:35:26 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (hack-local-variables-prop-line): Ignore any specification for `mode:', since set-auto-mode has already handled it. (set-auto-mode): Clean up. Handle more than one `mode:' spec in -*-. * rmail.el (rmail-convert-file): Exclude the Babyl header when calling rmail-convert-to-babyl-format. * startup.el (command-line): Setq inhibit-startup-message to nil. Mon Sep 6 18:48:08 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * register.el (jump-to-register): Take new optional arg NODELETE (prefix arg); pass through to set-frame-configuration. * frame.el (set-frame-configuration): Take new optional arg NODELETE; if non-nil, don't delete any frames. * register.el (window-configuration-to-register): Fix prompt string in interactive spec. (frame-configuration-to-register): Likewise. * menu-bar.el: Don't clobber existing binding for menu-bar in global-map. Mon Sep 6 22:37:51 1993 Paul Eggert (eggert@twinsun.com) * cal-dst.el (calendar-time-zone-daylight-rules): Remove special case for Israel. Israel has changed its daylight savings time rules. We don't know what the current rules are, but the special case was definitely incorrect. Mon Sep 6 18:15:29 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (tag-exact-match-p): Return true if TAG is the explicit tag name. Mon Sep 6 08:48:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simula.el: Doc fixes. (simula-mode-syntax-table): Copy the syntax table. Mon Aug 30 12:17:43 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (next-file): If arg is neither t nor nil, then eval it to return initial list of files. (tags-loop-continue): Doc fix. (tags-search, tags-query-replace): Take optional final arg and pass to tags-loop-continue (through to next-file) instead of t if non-nil. Sun Aug 29 10:29:22 1993 Paul Eggert (eggert@twinsun.com) * solar.el (solar-degrees-to-quadrant): Use `floor' not `truncate'. (solar-sunrise, solar-sunset, solar-longitude-of-sun): Undo Aug 19 patch; not needed with new `mod'. Sun Aug 29 08:21:25 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * solar.el (solar-equinoxes-solstices): Invert seasons in southern hemisphere. Use "Autumnal" not "Fall". Sat Aug 28 02:41:19 1993 Paul Eggert (eggert@twinsun.com) * cal-dst.el (calendar-time-zone-daylight-rules): Scan through the next few years until at most one rule remains; if none remain, then just use the first candidate rule; it's wrong in general, but it's right for at least one year. This is a better heuristic in case the underlying time zone implementation has bugs (which is all too common). If possible, don't convert back and forth between gregorian and absolute; this speeds things up noticeably. This uses the new calendar-nth-named-absday function. (calendar-current-time-zone): Some locales start DST at a different time of day than they end; allow for this by yielding both times. The performance speedups in calendar.el are great enough that we now no longer need the "Checking time zone data..." message. If current-time-zone yields nil, don't bother with calendar-next-time-zone-transition. Use clearer names for local vars. (calendar-time-zone, calendar-daylight-time-offset, calendar-{standard,daylight}-time-zone-name, calendar-daylight-savings-{starts,ends}): Default to US Eastern rules for information that is not available. (calendar-daylight-savings-{starts,ends}-time): New vars, replacing calendar-daylight-savings-switchover-time, to support locales that start DST at a different time of day than they end. (calendar-absolute-from-time): Fix typo by interchanging floor and mod. * calendar.el (solar-holidays): Use new calendar-daylight-savings-{starts,ends}-time vars instead of old calendar-daylight-savings-switchover-time var. (calendar-last-day-of-month): Tune by testing month before year. (calendar-absolute-from-gregorian): Tune by computing (1- year) once. (calendar-nth-named-absday): New function, used to improve performance in calendar-time-zone-daylight-rules. (calendar-nth-named-day): Use it. * solar.el (solar-time-string): Use new calendar-daylight-savings-{starts,ends}-time vars instead of old calendar-daylight-savings-switchover-time var. Thu Aug 26 20:56:51 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-locked-example): Renamed from vc-quiescent-p. Now yields example of why current directory is not quiescent. All callers changed to use this. * vc-hooks.el (vc-find-file-hook, vc-file-not-found-hook): Use add-hook to install these hooks. Thu Aug 19 14:21:25 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * solar.el (solar-sunrise, solar-sunset, solar-longitude-of-sun): Make both arguments to solar-mod float. (sunrise-sunset): Change screen-width to frame-width. * calendar.el (calendar-absolute-from-iso, american-calendar-display-form, european-calendar-display-form): Fix typos in doc strings doc strings. (calendar-mode-map): Use "[prior]" and "[next]" in key bindings. Wed Aug 18 12:48:40 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * texinfo.el (texinfo-environment-regexp): Match cartouche. * upd-copyr.el (update-copyright): Handle two-digit years with apostrophes. Sat Aug 14 03:54:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.19 released. * menu-bar.el (list-buffers-directory): Add declaration. * files.el (find-file-noselect): If a find-file-not-found-hook succeeds, clear `error'. * faces.el (x-create-frame-with-faces): Check for `on' or `true' as reverseVideo resource value. * frame.el (frame-initialize): Likewise. * outline.el (outline-minor-mode-prefix): New variable. (outline-minor-mode-map): Use it. (outline-level): New var. Everything funcalls this instead of calling outline-level. * frame.el (frame-initialize): Handle reverseVideo x-resource. * subr.el (momentary-string-display): Scroll to keep the string on the screen. Fri Aug 13 02:23:43 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * compile.el (compilation-parse-errors): Don't add multiple errors for one source line. * bibtex.el (bibtex-mode-map): Change C-c e to C-c C-b. * menu-bar.el (mouse-menu-bar-buffers): Use list-buffers-directory. * isearch.el (isearch-edit-string): Use read-event, not read-char. Thu Aug 12 18:20:55 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (backup-inhibited): Doc fix. * saveplace.el: New file. * bookmark.el: New version from Fogel. * mouse.el (mouse-choose-completion): Really go to minibuffer; no save-excursion. Thu Aug 12 14:38:37 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * tar-mode.el (tar-mode-map): Don't bind C-c. Thu Aug 12 01:32:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * paragraphs.el (paragraph-start): Doc fix. * paren.el (show-paren-command-hook): Do nothing if input is pending. Wed Aug 11 17:26:47 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (next-error): Handle zero and negative prefix args. Wed Aug 11 02:01:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired-aux.el (dired-compress-file): Fix previous change. * rmail.el (rmail-forward): Don't bind mail-signature, mail-setup-hook. * mouse.el (mouse-drag-region): Mouse in menu bar means scroll up. * text-mode.el (indented-text-mode): Doc fix. * userlock.el (ask-user-about-supersession-threat): Mention file name when asking question. * paren.el (show-paren-command-hook): Don't use value of make-face. * mouse.el (font-menu-add-default): Use list, not cons, for new elt. Don't get confused if no Misc entry. * emerge.el (emerge-find-difference): Add interactive spec. * mouse.el (mouse-set-point): Use event-end, not event-start. * frame.el (other-frame): Fix error in loop counting. Tue Aug 10 08:02:36 1993 Paul Eggert (eggert@twinsun.com) * autoload.el (generate-file-autoloads): Set float-output-format to nil, not "%.20e", since nil is guaranteed to not lose info on output. * bytecomp.el (byte-compile-from-buffer): Likewise. Tue Aug 10 04:24:09 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * startup.el (site-run-file): New variable. (command-line): Use it. Support -no-site-file. * mouse.el (mouse-drag-region): Doc fix. * texinfo.el (texinfo-delete-from-print-queue) (texinfo-tex-buffer): Load tex-mode to get tex-start-shell, etc. Tue Aug 10 18:19:46 1993 Rob Riepel (riepel@Snowflake.Stanford.edu) * tpu-edt.el (tpu-help): Use variables for "n" and "p". (tpu-help-N, tpu-help-n, tpu-help-P, tpu-help-p): New vars. * tpu-mapper.el: Insert (in buffer) setqs for tpu-help-... variables. Mon Aug 9 21:32:42 1993 Paul Eggert (eggert@twinsun.com) * calendar.el (hebrew-holidays-3): Fix misspelling in var name. * array.el (abs, ceiling, floor): Remove, since they now redefine builtin functions. All `ceiling' callers rewritten to invoke `floor'. * bytecomp.el: `mod' is no longer an alias for `%'. * subr.el: Likewise. * cal-dst.el (calendar-/, calendar-%): Remove, since floor and mod now subsume them. All callers changed. * cal-mayan.el (mayan-mod): Likewise. * ring.el (ring-mod): Likewise. * solar.el (solar-mod): Likewise. * cl-extra.el (floor*): Use `floor' rather than doing all the work. * gnus.el (gnus-caesar-region): Replace `%' by `mod' and simplify. * rnews.el (caesar-region): Likewise. * isearch.el (isearch-ring-adjust1, isearch-ring-advance-edit): Likewise. * simple.el (current-kill): Likewise. * timezone.el (timezone-fix-time): Simplify complicated expression with `floor'. (timezone-zone-to-minute): Replace (max X (- X)) with (abs X). Mon Aug 9 15:28:25 1993 Rob Riepel (riepel@Snowflake.Stanford.edu) * tpu-doc.el: Added section on local variables. * tpu-edt.el (tpu-version): Print version number rather than the RCS revision number. * tpu-edt.el (tpu-next-file-buffer): Bind starting-buffer with let. * tpu-edt.el (tpu-load-xkeys): Check value of tpu-xkeys-file. Make sure to use the "*scratch*" buffer. * tpu-edt.el (tpu-lm-replace): Changed variable searching-forward to tpu-searching-forward. (tpu-substitute): Likewise. (tpu-toggle-search-direction): Likewise. (tpu-search-forward, tpu-search-reverse, tpu-set-search): Likewise. (tpu-search-internal, tpu-adjust-search): Likewise. * tpu-extras.el (tpu-search-internal): Changed variable searching-forward to tpu-searching-forward. * tpu-extras.el: Changed "edit-picture-hook" to "picture-mode-hook" for emacs version 19. * tpu-mapper.el (tpu-gnu-map-key): Repaired the key name generation code to work with the latest version of emacs. Sun Aug 8 00:39:52 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.18 released. * tpu-doc.el (enable-local-variables): setq deleted. * tpu-extras.el (edit-picture-hook): Use add-hook to modify it. * server.el (server-visit-files): Restore current-buffer by hand, not using save-excursion. * gud.el (gud-dbx-marker-filter): Detect signals as well as bpts. * ange-ftp.el (ange-ftp-send-cmd): Bind ange-ftp-this-... in the outermost let, not an inner one. * comint.el (comint-mode-map): Delete C-c C-y binding. * mh-e.el (mh-read-msg-list): Undo previous change. * subr.el (minibuffer-window-active-p): New function. * mouse.el (mouse-set-point): Error if click in inactive minibuffer. (mouse-drag-region): Use mouse-set-point. Don't set a mark if final event wasn't suitable for setting point. * etags.el (etags-goto-tag-location): If match started with Ctrl-m, compensate when setting point. * simple.el (shell-command, shell-command-on-region): Fix bugs in previous change. * dired-aux.el (dired-compress-file): For .z file, run gunzip. When running gzip, see if it made .gz or .z. (dired-compress): Delete any old entry for new-file. Sat Aug 7 20:42:29 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * vc.el (vc-diff, vc-directory-18): Add missing paren to end of vc-diff, and remove extra paren from vc-directory-18. Sat Aug 7 04:18:43 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired-aux.el (dired-diff): Read options right here; don't try to use diff-read-switches. Always call diff with 3 args. (dired-backup-diff): Likewise. * simple.el (do-auto-fill): Don't keep breaking the line if it doesn't help matters. Fri Aug 6 18:10:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * indent.el (indent-region): Fix paren error in last change. * mouse.el (mouse-save-then-kill): Fix paren error in last change. Fri Aug 6 16:25:08 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) Fix {menu,scroll}-bar-mode so prefix arg of M-- works. * scroll-bar.el (scroll-bar-mode): If FLAG is non-nil, set it to its prefix-numeric-value. * menu-bar.el (menu-bar-mode): Defvar removed. (menu-bar-mode): Rewritten to parallel scroll-bar-mode. * info.el (Info-goto-emacs-command-node, Info-goto-emacs-key-command-node): Doc fix. * help.el (help-for-help): Mention C-k and C-f. Fri Aug 6 14:02:22 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (after-find-file): Improve warning message about existing file that can't be read. Thu Aug 5 02:54:42 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * indent.el (indent-region): Rename arg ARG to COLUMN. Don't add fill-prefix to empty line. Don't change whitespace in empty line. * mouse.el (help-admin-map): Fix menu item text. * font-lock.el (font-lock-fontify-region): Handle comment-start-skip = nil. * rmail.el (rmail-resend): Delete any Sender field. Wed Aug 4 00:36:19 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * perl-mode.el (perl-mode): Add autoload cookie. * paths.el (sendmail-program): Try /usr/sbin/sendmail.el also. * mouse.el (mouse-save-then-kill): Don't discard all the normal undo info; just replace the deletion entry. * tpu-edt.el, tpu-doc.el, tpu-extras.el, tpu-mapper.el: New files. * vt-control.el: New file. Wed Aug 4 14:42:17 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * diary.el (list-diary-entries): Split diary-display-hook into two pieces, diary-display-hook and diary-hook. If diary-display-hook is nil, use simple display. (include-other-diary-files): Set those hooks properly for other files. * calendar.el (diary-display-hook): Change default and fix doc string. (diary-hook): New user variable. (diary-date-forms, calendar-date-display-form): Don't autoload them so the European/American style is decided at load time. Tue Aug 3 23:40:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lpr.el (print-region-1): Make END a marker so untabify relocates it. Tue Aug 3 17:38:47 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-minor-mode): Make variable buffer-local. (compilation-minor-mode): Autoload this function. Tue Aug 3 13:44:52 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * man.el (man): Define as alias. * paren.el (window-setup-hook): Add hook function. Tue Aug 3 03:52:36 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * comint.el (comint-dynamic-list-completions): Expand PATHDIR in call to file-name-completion. Tue Aug 3 03:09:18 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * faces.el: Make boldness/italicness affect frames created later. (make-face-bold, make-face-italic, make-face-bold-italic) (make-face-unbold, make-face-unitalic): Update global-face-data. Ignore a list found in the font slot. (make-face-bold-internal, make-face-italic-internal): (make-face-bold-italic-internal): New subroutines. (x-create-frame-with-faces): If global-face-data's font slot indicates bold and/or italic, make it so. Tue Aug 3 02:38:34 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * window.el (shrink-window-if-larger-than-buffer): Pass WINDOW to pos-visible-in-window-p. Tue Aug 3 00:08:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * completion.el (cmpl-read-time-eval): Make it no-op. (cmpl-hours-since-origin): Use truncate to make an integer. (completion-search-reset): Use completion-prefix-min-length. * telnet.el (telnet): If we already have a telnet to HOST, just switch buffers. Mon Aug 2 23:33:34 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * frame.el (other-frame): Skip iconified and invisible frames. Mon Aug 2 21:07:02 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * replace.el (occur-mode-goto-occurrence): Give meaningful error message if there's nowhere useful to go. Mon Aug 2 18:18:52 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * comint.el (comint-dynamic-complete): If called interactively twice in a row, give the completion list. * comint.el (comint-dynamic-complete): Expand PATHDIR in call to file-name-completion. * comint.el (comint-dynamic-completion): Say "Sole completion", not "Unique completion". * frame.el (other-frame): New function, analogous to other-window. (ctl-x-5-map): Bind C-x 5 o to other-frame. Mon Aug 2 00:47:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (add-hook): Change a single function into a list. * lucid.el (remove-hook): Doc string added. Change a single function into a list. * sendmail.el (mail-yank-hooks): Initialize to nil. (mail-yank-original): If mail-yank-hooks is nil, call mail-indent-citation. * c-mode.el (indent-c-exp): Don't document ENDPOS. (c-indent-region): Rewrite to use indent-c-exp on one sexp at a time, then use c-indent-line on the next line, etc. * bytecomp.el (byte-recompile-directory): At end of compiling a file, put back the "Checking DIR..." message. Sun Aug 1 18:22:59 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.el (etags-tags-completion-table): Fixed regexp for today's format. (etags-snarf-tag): Skip explicit tag name if present. Sun Aug 1 20:50:07 1993 Paul Eggert (eggert@twinsun.com) * dissociate.el (dissociated-press): Use `(random N)' instead of while loop. * dunnet.el: (dun-endgame-question, tcom, tloc): Use (random N) instead of combination of %, abs and random. * life.el (life-insert-random-pattern): Simplify (% (abs (random)) N) to (random N). * cookie1.el (pick-random): Remove. All callers changed to use `random' instead. * gomoku.el (random-number): Likewise. * mpuz.el (mpuz-random): Likewise. * emerge.el (emerge-default-[AB]): Use (zerop (% A B)) instead of (= (* (/ A B) B) A). Sun Aug 1 01:17:14 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (event-click-count): New function. * texinfmt.el: Installed the version from the Texinfo package. * dired.el (dired-sort-mode): Variable deleted. Don't display it in mode line. (dired-sort-set-modeline): Set mode-name instead. * etags.el (visit-tags-table-buffer): New local named visit-tags-table-buffer-cont copies cont. (tags-table-including): Set that, instead of cont. * c-mode.el (indent-c-exp): Don't move an { from column 0. Sat Jul 31 01:31:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tar-mode.el: Fix doc strings and error message syntax. Add menu bar items. (tar-subfile-mode): Set a local-write-file-hook rather than using key bindings. (tar-subfile-save-buffer): Return t. * add-log.el (change-log-mode): Use \f for formfeed, to avoid syntax error. * isearch.el (isearch-done): Move point (for small window) before deciding whether to set the mark. * man.el (Man-build-references-alist): When setting word, use only what Man-reference-regexp matched. (Man-reference-regexp): Don't match starting with a period. (Man-first-heading-regexp): Allow leading space. (Man-heading-regexp): Allow leading space. (Man-section-translations-alist): Add entries for xlib. * completion.el (completion-version): New variable. (save-completions-to-file): Use completion-version. * tex-mode.el (validate-tex-buffer): Record mismatches in *Occur*. * files.el (basic-save-buffer): When we read a file name, use set-visited-file-name to put it in. * mouse.el (mouse-choose-completion): Actually choose that alternative, don't just insert its name. * simple.el (shell-command-history): New variable. (shell-command, shell-command-on-region): Use it. Fri Jul 30 14:25:24 1993 Paul Eggert (eggert@twinsun.com) * window.el (shrink-window-if-larger-than-buffer): Do nothing if the window is the only window of its frame. If the buffer ends in newline and point is not at the end of the buffer, do not display the last (empty) line. * vc.el (vc-shrink-to-fit): Deleted. All callers changed to use the new, fixed `shrink-window-if-larger-than-buffer' instead. In some places move it after a (goto-char (point-min)). Fri Jul 30 20:19:06 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * blackbox.el (blackbox-mode-map): Now that we have terminal-independent function-key facilities, we ought to use them. Remove hack which looks for all bindings for the simple motion keys and locally binds them to blackbox keys; add bindings for the [up], [down], [left], and [right] keys. * frame.el (frame-notice-user-settings): If we had to create a new frame in order to obey initial-frame-alist, use delete-frame's FORCE argument to get rid of the old frame even if the new one hasn't been mapped yet. Fri Jul 30 20:18:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fill.el (fill-region-as-paragraph): When we take one word after the fill column, don't stop at period with just one space. When checking whether at beginning of line, if no fill prefix, ignore intervening whitespace. Fri Jul 30 18:38:56 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * gud.el (gud-gdb-marker-filter): Preserve the match data across the filter's execution. * gud.el (gud-gdb-marker-filter): If we received some text after the position marker, append it to any text before the marker, instead of throwing away the text before the marker. Fri Jul 30 03:00:20 1993 David Gillespie (synaptx!daveg@uunet.UU.NET) * cl.el: File totally replaced. * cl-compat.el, cl-extra.el, cl-macs.el, cl-seq.el: New files. * info.el (Info-fontify-node): New function. (Info-fontify): New variable. (Info-mode): Initialize Info-related faces. (Info-select-node): Fontify the node if necessary. * info.el (Info-goto-node): Provide completion for node names. (Info-read-node-name, Info-build-node-completions): New functions. (Info-current-file-completions): New variable. (Info-find-node): Clear completions cache. * info.el (Info-next-reference, Info-prev-reference): New commands. (Info-mode-map): Bind these to TAB and M-TAB. (Info-next-preorder): Special case if sitting on "*Note" reference. * info.el (Info-standalone): New variable. (Info-exit): Exit Emacs if in standalone mode. (info-standalone): New function. * info.el (Info-summary): Added `bury-buffer' call. (Info-no-error): Renamed from `no-error'. (Info-suffix-list): Put ".info" before "" to deal with directory named "foo" next to file "foo.info". Fri Jul 30 03:00:20 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fill.el (fill-region-as-paragraph): Move misplaced paren ending `(if (eobp) nil ...)'. In the loop that avoids breaking after `.' with one space, break if we actually have two spaces. Fri Jul 30 01:32:53 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-error-regexp-alist): Broaden RS6000 regexp to match "lines N-M," or "line N,". Thu Jul 29 19:21:10 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * gud.el (gud-gdb-marker-filter): Do not assume that the position markers from GDB will always be received in one chunk of input; gud-gdb-marker-filter may be called several times, each time providing a little more of the position marker. (gud-gdb-marker-acc): New variable. (gud-gdb-marker-filter): If we have received what could be the beginning of a position marker, hold that text in gud-gdb-marker-acc for the next time we get called, until we have enough information to decide for sure. * gud.el (gud-gdb-marker-filter): Only recognize GDB position markers if they occur at the beginning of the line. They always do, and this reduces the likelihood that the above change will hold back output that isn't really a position marker. * mpuz.el (mpuz-board): Doc fix. Thu Jul 29 01:10:06 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gud.el (dbx): Use %d in gud-break. (gud-format-command): Support %d. Delete spurious progns. * etags.el (etags-goto-tag-location): Handle selective display. * sendmail.el: Do the global key bindings only via loaddefs.el, not when sendmail.el is loaded. * buff-menu.el (Buffer-menu-mode-map): Undo previous change. * rmail.el (rmail-nuke-pinhead-header): Tell replace-match not to alter the case. (rmail-toggle-header, rmail-reformat-message): Ignore case when checking for Summary-line. * calendar.el (calendar-mode-map): Bind C-SPC. Thu Jul 29 04:58:47 1993 Paul Eggert (eggert@twinsun.com) * (vc-mode-line): Set vc-mode to nil if FILE no longer is version-controlled. Thu Jul 29 00:47:52 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * menu-bar.el (delete-frame): Permit it, if > 1 frame is vis or iconic. Wed Jul 28 23:02:45 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * man.el (Man-find-section): HP/UX man pages have section names indented by a single space; recognize them. * gud.el (gud-last-last-frame): Specify initial value. `dbx' doesn't work unless we do. Thu Jul 29 00:00:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * c-mode.el (calculate-c-indent): When checking whether function decl is inside a comment, move back to the `(' that starts the arglist. Wed Jul 28 19:50:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-convert-file): If file needs conversion, convert it all. * macros.el (name-last-kbd-macro): Handle macros that are vectors. * man.el (Man-filter-list): Insert \n newlines in awk script. * time-stamp.el (time-stamp): Add autoload cookie. Wed Jul 28 18:41:55 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * comint.el (comint-replace-by-expanded-filename, comint-dynamic-complete): Say "Sole completion" instead of "Unique completion", for consistency with the rest of the known universe. Wed Jul 28 04:21:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sc.el: Require assoc instead of sc-alist. * sc-alist.el: File deleted. * gnus.el (gnus-apply-kill-hook): Make the value a list of functions. (gnus-mark-article-hook, gnus-select-digest-hook): Likewise. (gnus-select-article-hook, gnus-select-group-hook): Likewise. Tue Jul 27 17:58:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * bytecomp.el (byte-recompile-directory): Doc fix. * term/x-win.el (iconify-or-deiconify-frame): New function. Use it for C-z. Tue Jul 27 19:28:46 1993 Paul Eggert (eggert@twinsun.com) * vc-hooks.el (vc-rcs-status): Removing any trailing "-". Tue Jul 27 01:48:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cplus-md.el (c++-mode-syntax-table): Don't alter syntax of '. * term/x-win.el (x-handle-iconic): New function. (command-switch-alist): Use that. (x-switch-definitions): Delete elt for `-iconic'. * gud.el (dbx): For gud-break, send a file command and a stop command. * diary.el: Doc fixes. Mon Jul 26 15:55:32 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mouse.el (font-menu-add-default): New function. * startup.el (normal-top-level): Call font-menu-add-default. Mon Jul 26 14:32:18 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * simple.el (read-expression-history): New defvar. (eval-expression): Use it has history var in interactive spec. Mon Jul 26 01:54:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.el (frame-notice-user-settings): Don't reapply a parm whose value is ot changed (as far as we know) since frame-initialize. * simple.el (kill-ring-save): Delete spurious `message' call. (set-mark): If POS is nil, call deactivate-mark. * c-mode.el (indent-c-exp): When previous line ends in comma, use calculate-c-indent. Fix the "inner loop" to properly detect a line that ends outside of comments and strings. * cplus-md.el (c++-mode-syntax-table): Handle C-style comments. * files.el (insert-directory): Make sure default-directory is absolute. * dired.el (dired-readin-insert): If we got a list of files, pass nil for WILDCARD arg to dired-insert-directory. Sun Jul 25 16:19:47 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc.el (vc-backend-steal): Pass arg omitted in last change. * term/x-win.el (x-selection-timeout): Use 20000 as default. * mouse.el (x-fixed-font-alist): Give some fonts long patterns. Delete 9x15 bold and 8x13 and 8x13 bold. Add some fonts. * term/x-win.el (x-select-text): Never set the CLIPBOARD selection. (x-cut-buffer-or-selection-value): Try PRIMARY before cut buffer. (x-cut-buffer-max): Set based on x-server-max-request-size. Sat Jul 24 01:33:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * unrmail.el (unrmail): Total rewrite. * rmailout.el (rmail-output): New arg NOATTRIBUTE. * rmailout.el (rmail-output-to-rmail-file): Set rmail-last-rmail-file while reading the interactive args. (rmail-output): Likewise, for rmail-last-file. (rmail-output-to-rmail-file): Use default-file consistently. * replace.el (occur): If no default, don't mention one. * rmail.el (rmail-last-rmail-file): Initialize to a file name. (rmail): Don't set rmail-last-rmail-file. * info.el (Info-select-node): Run Info-selection-hook. * ispell.el (ispell-point): Do nothing if there's no word at START. Fri Jul 23 00:42:36 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * doctor.el (doctor-type-symbol): Win if auto-fill-function is nil. * edt.el (advance-direction): Set kp-f3, not kp-f1. * term/x-win.el (x-select-text): Always set the cut buffer, but sometimes set it to nothing. Don't put large strings in clipboard. * dired.el (dired-readin-insert): Don't use the "whole directory" case if DIR-OR-LIST is a list. * font-lock.el (font-lock-after-change-function): Scan for comments and strings from beg of line. (c-font-lock-keywords-1): Recognize &, like *, before fn name. (perl-font-lock-keywords): Put digit 1 into function-name-face items. Allow whitespace before the open-brace. * sort.el (sort-skip-fields): Really implement fields as runs of nonwhitespace chars. (sort-fields, sort-float-fields, sort-numeric-fields): Don't subtract 1 when calling sort-skip-fields. Thu Jul 22 13:44:22 1993 Ron Schnell (ronnie@media.mit.edu) * dunnet.el (dun-special-object): Fixed so that bus will explode if falls through hole instead of making adventurer trapped in room with no escape and no way off the bus. Thu Jul 22 13:34:32 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el (x-select-text): Limit size of text sent to cut buffer. * subr.el (keyboard-translate): Properly lengthen existing table. * files.el (set-auto-mode): Fix backwards test involving inhibit-local-variables-regexps. * loaddefs.el (ctl-x-map): Correct C-x r t to string-rectangle. * paren.el (show-paren-command-hook): Specify buffer for move-overay. Thu Jul 22 03:59:42 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-backend-revert): Use `co -f' instead of deleting the working file ourselves; that way, if `co' fails, we won't have deleted the working file. (vc-backend-steal): Don't delete the working file. Use `rcs -u -l', not `rcs -u ; rcs -l'; it's faster. Use vc-backend-dispatch -- the old code couldn't have possibly worked. Thu Jul 22 01:34:34 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * map-ynp.el (map-y-or-n-p): If LIST is nil, just return. * mouse.el (mouse-secondary-save-then-kill): When making the undo item, use an integer, not a marker, for the position. * rmail.el (rmail-forward): Call rmail-start-mail for new frame even if just one window. (rmail-start-mail): Return what mail-other-frame returned. * mouse.el (mouse-set-font): Update faces bold, italic and bold-italic. * completion.el (complete): Use sit-for, not cmpl19-sit-for. * simple.el (completion-list-mode): Renamed from completion-mode. (completion-list-mode-map): Likewise. * files.el (parse-colon-path): Really make nil, not ".", for empty path element. Wed Jul 21 00:07:54 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * autoload.el (generate-file-autoloads): Bind float-output-format. Bind print-escape-newlines. * inc-vers.el: Try deleting version.el if it's not writable. * term/lk201.el: Explicitly define kp-f1... * tar-mode.el (tar-parse-info, tar-header-offset, tar-superior-buffer) (tar-superior-descriptor): Make them permanent locals. (tar-mode): Call kill-all-local-variables. Locally set enable-local-variables to nil. * man.el (Man-set-fonts): Don't look for another char after the backspace; instead look for a sequence CHAR BS CHAR BS CHAR BS... Delete all the CHAR BS pairs found, after making the text property. * c-mode.el (indent-c-exp): If ENDPOS, always set OPOINT to the function start. And don't indent a line which is past ENDPOS. Don't indent a comment on the first line if it's the only thing on that line. Call calculate-c-indent-within-comment when appropriate. * mouse.el (mouse-drag-region): Use deactivate-mark. * font-lock.el (perl-font-lock-keywords): Add a `(... . 1)' to the first element of the list. (font-lock-hack-keywords, font-lock-unfontify-region) (font-lock-fontify-region): Bind buffer-read-only to nil, and don't alter buffer-modified-p. (font-lock-fontify-region): Use comment-start-skip, not comment-start. Tue Jul 20 00:34:26 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buff-menu.el (Buffer-menu-mode-map): Bind delete like DEL. * files.el (parse-colon-path): Turn empty substring into nil. * sendmail.el (mail-bury): Check that frame-parameters is defined. * font-lock.el (font-lock-function-name-face): defvar renamed. (font-lock-hack-keywords): Evaluate face specs from keyword list. * dunnet.el: New version from Schnell, to fix possible bad patch run. * subr.el (define-key-after): Fix typo in previous change. * outline.el (outline-mode-map): Delete spurious `outline-' from show and hide command names in menu. * ange-ftp.el (file-name-handler-alist): Have two separate regexps with different hooks. * files.el (ange-ftp-completion-hook-function): New function. * paren.el (show-paren-face): New variable. (show-paren-command-hook): Use it. Call set-face-background properly. * reposition.el (reposition-window): Don't forward-char if eobp. * startup.el (normal-top-level): Call abbreviate-file-name again after calling command-line. * rmailedit.el (rmail-edit-map): Inherit properly from text-mode-map; use the whole thing, not its cdr. * man.el (Man-getpage-in-background): Copy process-environment so we only alter the copy. * mh-e.el (mh-read-msg-list): Add space to message-number regexp. Mon Jul 19 19:27:01 1993 Paul Eggert (eggert@twinsun.com) * vc-hooks.el (vc-rcs-status): Use "-", not " ", to separate locks, so that the RCS minor mode label doesn't contain internal spaces. Mon Jul 19 14:56:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired.el (dired-unmark-all-files-no-query): New command. (dired-mode-map): Use that for the Unmark All item. Fix typo that made the Flag Backup Files item not show up. * mlconvert.el (while): Comment out converter. * calendar.el (hebrew-holidays): Split into 4 sub-variables. Mon Jul 19 16:06:31 1993 Masanobu UMEDA (umerin at orchid) * gnus.el (gnus-emacs-version): New variable. (gnus-version): Updated to 4.1. (gnus-newsrc-to-gnus-format): Use different regexp in 18 and 19. (gnus-group-startup-message): Use gnus-emacs-version. * gnuspost.el (gnus-current-time-zone): Fix typo. (gnus-inews-organization): Fix zero length string operation bug. * metamail.el (metamail-environment): Format changed. It must be a list of strings that have the format ENVVARNAME=VALUE. (metamail-region): Corresponding changes. * metamail.el (metamail-region): Optional 2nd argument NODISPLAY controls redisplay behavior. (metamail-buffer): LIkewise. Mon Jul 19 01:44:43 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * menu-bar.el (mouse-menu-bar-buffers): Add Frames pane if there are multiple panes. Sun Jul 18 21:05:05 1993 Paul Eggert (eggert@twinsun.com) * vc-hooks.el (vc-rcs-status): Omit "LOCKER:" if you are the locker. Sun Jul 18 16:41:08 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * vc.el (vc-comment-to-change-log): Complete rewrite. Do not use vc-update-change-log. Instead, snarf last comment from vc-comment-ring and insert it with add-change-log-entry. * add-log.el (prompt-for-change-log-name): Autoload this (for vc-comment-to-change-log). (add-change-log-entry): Take optional fourth arg NEW-ENTRY. If non-nil, never append to an existing entry. (change-log-fill-paragraph): New function. It might be nice to have a general feature to replace this. The idea I have is a variable giving a regexp matching text which should not be moved from bol by filling. change-log-mode would set this to "^\\s *\\s(". But I don't feel up to implementing that today. (change-log-mode-map): New defvar for keymap. Bind M-q to change-log-fill-paragraph in it. (change-log-mode): Use that as local map. * add-log.el (add-log-current-defun-function): New defvar. (add-change-log-entry): Call its value if non-nil instead of add-log-current-defun. (add-change-log-entry-other-window): Doc fix. * compile.el (compilation-error-list): An elt's cdr's car is again a cons (DIRECTORY . FILE) if it's not a marker. The conversion to using a string containing an expanded file name was never finished, and anyway it utterly broke compilation-search-path and a few other things. (next-error): Expect them that way. (compilation-parse-errors): Make them that way. (compile-file-of-error): Function removed. (compilation-error-filedata, compilation-error-filedata-file-name): New defsubsts. (compilation-next-file): Use them instead of compile-file-of-error. Sun Jul 18 16:01:03 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * autoload.el (update-file-autoloads): Go to the beginning of FILE before searching it for generate-autoload-cookie. * cookie1.el (cookie, cookie-insert, cookie-snarf, shuffle-vector): Autoload these. Sun Jul 18 02:38:03 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.17 released. * makeinfo.el: Don't (require 'texinfmt) - that file doesn't exist any more; all its functions have been moved into other files. * files.el (insert-directory): Doc fix. * files.el (insert-directory): If FULL-DIRECTORY-P is non-nil, add "." component to the end of the path, so that if file is a symlink, we get the contents of the directory, not the symlink itself. Sat Jul 17 13:25:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tar-mode.el (tar-extract): Use view-exit-action to kill viewed buf. * view.el: Doc fixes; some args renamed. * gnus.el (gnus-info-nodes): Update node names. * makeinfo.el (makeinfo-options): Fix option syntax in initial value. * texinfo.el (texinfo-mode): Undo changes mistakenly added with previous batch: texinfo-{start,end}-of-header are now tex-... Sat Jul 17 18:13:11 1993 Johan Vromans (jv@mh.nl) * forms.el: New version 2.0. Redesigned and rewritten to use Emacs 19 text properties. Requires Emacs 19.16 or later. Sat Jul 17 01:58:36 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * term/x-win.el: Include (invocation-name) in the error messages which might occur during startup. * shell.el (shell-process-pushd): Fix syntax error in condition-case. Fri Jul 16 20:16:57 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * menu-bar.el (revert-buffer): Make menu-enable form more accurate using revert-buffer-function and verify-visited-file-modtime. (menu-bar-help-menu): Put back under global-map. (menu-bar-final-items): Set it. * mh-e.el (mh-yank-hooks): Use (mark t). (mh-new-draft-name): Likewise. Fri Jul 16 16:30:18 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * comint.el (comint-{next,prev}-prompt, comint-send-eof): New defuns. (comint-mode-map): Bind C-c C-n, C-c C-p, and C-c C-d to those. Bind C-c C-y to comint-previous-input, for compatibility with v18 shell.el. Fri Jul 16 15:53:38 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * advice.el (ad-start-advice-on-load): Initialize to t. Fri Jul 16 04:45:14 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * term/x-win.el: Make the `-rn NAME' option specify a resource name, as documented, and not a resource database string. Make `-name NAME' act like `-rn NAME' and also set the name of the initial frame. (command-switch-alist): Process the `-rn' and `-name' options using the x-handle-name-rn-switch function. (x-handle-name-rn-switch): New function, which sets the x-resource-name variable. (opening connection): Make sure x-resource-name is valid. If it's not a string, set it to (invocation-name), with any periods or asterisks changed to hyphens. * term/x-win.el: Make the `-xrm STRING' option specify a resource database string. `-rn' used to behave this way. (command-switch-alist): Process the `-xrm' switch using x-handle-xrm-switch. (x-handle-xrm-switch): Renamed from x-handle-rn-switch; this function does the right thing for `-xrm', not for `-rn'. Fri Jul 16 00:11:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-bury): If selected frame is dedicated, and there are other visible frames, delete this frame. * rmail.el (rmail-mail-new-frame): New variable. (rmail-start-mail): New function. (rmail-mail, rmail-continue, rmail-reply, rmail-forward) (rmail-retry-failure): Use rmail-start-mail. Thu Jul 15 01:29:45 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * faces.el (face-equal): Don't mess with face-background-pixmap. * ispell.el (ispell-menu-map): Add missing quote in defalias. (ispell-window-configuration): Initialize to nil. * vc-hooks.el (vc-rcs-status): Make work buffer's name start w/ space. * simple.el (completion-setup-function): Insert the mouse help message only if non-nil `window-system'. * paren.el: Enable the hook only if window-system. Clear blink-paren-function at the same time. (show-paren-command-hook): If after a closeparen, highlight that closeparen as well as matching open. Use a different color for a mismatch, if color screen. Thu Jul 15 01:07:51 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * assoc.el (asort): First argument should be named alist-symbol, not assoc-symbol. Wed Jul 14 23:52:20 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * server.el (server-done): Let save-buffer make the backup, so that make-backup-files remains effective. * loaddefs.el: Delete C-x a C-h binding. * menu-bar.el (help-menu-bar-map): Put the Help item in this map. Wed Jul 14 23:46:02 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * isearch.el (isearch-edit-string): Bind isearch-nonincremental to its own value, not to nil. Wed Jul 14 23:35:51 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * hippie-exp.el: Renamed from hippie.el. Wed Jul 14 23:08:17 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * compile.el (compilation-parse-errors): After skipping two lines, move one char back so point is before the newline. Wed Jul 14 21:55:13 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * gud.el (gud-debugger-startup): Replaced with gud-massage-args. (gud-{gdb,sdb,xdb}-debugger-startup): Replaced with gud-*-massage-args. (gdb, sdb, xdb): Argument is command line, not args for it. Remove debugger name from prompt and put it in the default input instead. Overload gud-massage-args instead of gud-debugger-startup. (gud-chop-words): New function; subr for gud-common-init. (gud-common-init): Argument is command line, not args for it. Rewritten to use gud-chop-words instead of temp buffer and kludge involving read. Find the program name as the first word of the command line. Use make-comint and gud-massage-args in place of gud-debugger-startup. Expand the file name before passing it to gud-massage-args. Wed Jul 14 19:38:00 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * spook.el (snarf-spooks): Restore function. * cookie1.el (cookie-cache): New defvar. (cookie-snarf): Cache cookies in cookie-cache, not in obarray (idiot). Also store the modtime and punt the cache when it changes. Wed Jul 14 19:14:37 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) Changes from Anders Holst, to bring hippie-expand up to version 1.2: * hippie-exp.el (hippie-expand-max-buffers): New variable. (try-expand-line-all-buffers, try-expand-list-all-buffers, try-expand-dabbrev-all-buffers): Use it. (try-expand-list, try-expand-list-all-buffers): New functions. (he-string-beg, he-string-end, he-search-loc): These values are now markers, not integers. Uses changed. (he-reset-string, he-substitute-string): Use a marker to preserve the old position of point. (try-expand-all-abbrevs): handle case the same way as the usual expand-abbrev (which is not a very good way, but for consistency...). (he-dabbrev-beg): Use `skip-syntax' instead of `skip-chars', to adjust its behavior to different modes. (hippie-expand): Don't messages which try function it is using, when the expansion itself is done in the minibuffer (it was very annoying to have the message obscuring the expansion). (try-complete-file-name, try-complete-file-name-partially, try-complete-lisp-symbol, try-complete-lisp-symbol-partially, try-expand-line, try-expand-line-all-buffers, try-expand-all-abbrevs, try-expand-dabbrev, try-expand-dabbrev-all-buffers): No unnecessary "resetting" of the epansion, when no expansion is done (caused the buffer to be marked as changed, although nothing was done, among other things). (he-reset-string): Undoing of last expansion at a later occasion, now undoes correctly (before, it garbled things up). (make-hippie-expand-function): now uses "(function ...)" instead of "'" (matters for compilation). (try-expand-line, try-expand-line-all-buffers, he-line-search-regexp): uses `comint-prompt-regexp' instead of `shell-prompt-pattern', to strip off prompt in process buffers. Wed Jul 14 16:56:19 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * autoload.el (generate-file-autoloads): Fix FILE truename hacking to substring SOURCE-TRUENAME instead of FILE. Tue Jul 13 01:51:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * faces.el (copy-face): New arg NEW-FRAME. (list-faces-display): New command. * simple.el (completion-mode): New major mode. (completion-setup-function): New function. Add it to completion-setup-hook. * mouse.el (mouse-choose-completion): New function. * dunnet.el: Many functions and variables renamed. * sendmail.el (mail-bury): New function. (mail-send-and-exit): Call mail-bury. (mail-dont-send): New command, with menu bar binding. * compare-w.el (compare-windows-skip-whitespace): New function. (compare-windows): Use that. (compare-windows-whitespace): Value is now regexp. * rmail.el (rmail-insert-inbox-text): If inbox is not in the spool dir, try copying before renaming. Tue Jul 13 00:38:53 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * shell.el (shell-prompt-pattern): Don't match more than one line. Doc fix. * bytecomp.el (byte-compile-from-buffer): Bind float-output-format to "%.20e", not "%20e"; the latter is always ignored, since it doesn't have a decimal point after the percent sign. Mon Jul 12 23:17:38 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * autoload.el (generate-file-autoloads): Correctly detect when the buffer receiving the autoload forms is in a parent of or the same directory as FILE, even in the presence of symlinks. Mon Jul 12 23:57:14 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (define-key-after): Error if KEY has two elements. * dired.el (dired-mode-map): Add menu bar items. Mon Jul 12 23:17:38 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * autoload.el (generate-file-autoloads): Correctly detect when the buffer receiving the autoload forms is in a parent of or the same directory as FILE. Mon Jul 12 16:44:47 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * ange-ftp.el: Install the correct regexp in file-name-handler-alist. * term/x-win.el: Recognize affirmative values for reverseVideo properly. Include "on" in the list of recognized values. Mon Jul 12 15:11:55 1993 Paul Eggert (eggert@twinsun.com) * vc-hooks.el (vc-rcs-status): Include head version number in mode line if there are no locks. Mon Jul 12 14:36:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * menu-bar.el (menu-bar-file-menu): Add menu item for dired. * menu-bar.el (ispell-menu-map): New autoload definition. (menu-bar-edit-menu): Add "Spell" item. * ispell.el (ispell-menu-map): New keymap--both fn and var. * loaddefs.el (mode-line-buffer-identification): Doc fix. Sat Jul 10 23:28:50 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * calendar.el (calendar-holidays): Don't autoload this; its value must be set after the user's .emacs file is loaded. Sat Jul 10 01:15:54 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * paren.el (show-paren-command-hook): Do nothing if not window-system. Fri Jul 9 00:04:12 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmailout.el (rmail-output): If file is an Rmail file, use rmail-output-to-rmail-file. (rmail-output-to-rmail-file): If file exists and is not an Rmail file, use rmail-output. If we find an element in rmail-output-file-alist, eval it. (rmail-file-p): New function. (rmail-output-file-alist): Now contains expressions to eval. * font-lock.el: New file. * bytecomp.el (byte-compile-setq-default): Generate a progn of calls to set-default, then compile it. * menu-bar.el (mouse-menu-bar-buffers): Don't lose if all buffer names are short. * dunnet.el: New file. Thu Jul 8 19:31:58 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * loaddefs.el (global-map): Bind M-next to scroll-other-window. * compile.el (compilation-error-regexp-alist): Broaden ``Line N of "FILE": msg'' regexp to also match Ultrix f77: ``Error on line N of FILE: msg''. Thu Jul 8 18:42:14 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * Make everything that deactivates the mark do it consistently. * simple.el (deactivate-mark): New function. (kill-ring-save, pop-mark, keyboard-quit): Call it. * ispell.el (ispell): Call deactivate-mark instead of setting mark-active directly. Do this regardless of transient-mark-mode. * isearch.el (isearch-done): Call deactivate-mark instead of setting mark-active directly. Do this regardless of transient-mark-mode. Thu Jul 8 20:51:51 1993 Richard Stallman (rms@churchy.gnu.ai.mit.edu) * files.el (basic-save-buffer): Use after-save-hook. Thu Jul 8 17:46:22 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * simple.el: Put error-conditions and error-message properties on 'mark-inactive. (mark): Signal 'mark-inactive instead of using error with a message. Thu Jul 8 17:14:43 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * mailabbrev.el (mail-abbrev-end-of-buffer): Fix interactive spec to "P", same as end-of-buffer. Thu Jul 8 15:06:38 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * hanoi.el: Add (provide 'hanoi). Wed Jul 7 18:19:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (file-relative-name): If we use default-directory, call expand-file-name anyway. * texnfo-upd.el (texinfo-update-node): Bind auto-fill-hook as well as auto-fill-function. (texinfo-sequential-node-update): Likewise. Wed Jul 7 09:25:37 1993 Robert J. Chassell (bob at grackle) * texnfo-upd.el: Fix typo re `texinfo-sequential-node-update.' Ensure that no commands depend on the value of case-fold-search. Rewrite messages. Avoid using `mark-whole-buffer'. (texinfo-start-menu-description): New function to insert title as description in a menu. (texinfo-make-menu-list): Remove automatic title insertion. (texinfo-master-menu): Error message if file contains too few nodes for a master menu. Handle the case where no master menu was inserted. (texinfo-insert-master-menu-list): Only attempt to insert detailed master menu if there is one. Insert a master menu only after `Top' node and before next node. (texinfo-check-for-node-name): Offer section title as prompt. (texinfo-copy-next-section-title): Copy title correctly. Handle failure to find @node. (texinfo-copy-menu): Error message if menu empty. (texinfo-pointer-name): Find only those section commands that are accompanied by `@node' lines. (texinfo-section-types-regexp): Look for subh and subs, not just sub. (texinfo-make-one-menu): Copy node-name correctly for message. (texinfo-copy-menu-title): Copy title as it should rather than node line. (texinfo-find-higher-level-node): Stop search at limit. Special handling for `top' and `chapter' levels. (texinfo-copy-menu-title): Rewrite to handle outer include files. (texinfo-multi-file-update): Update all nodes properly (and sooner); rewrite doc string and interactive. Copy title properly. (texinfo-all-menus-update): Fixed typo that caused the function to create a master menu when it shouldn't. Update pre-existing master menu, if there is one. (texinfo-incorporate-descriptions): Use a regexp search to look for both kinds of menu item. (texinfo-menu-indent-description): Likewise. (texinfo-incorporate-menu-entry-names): New function. (texinfo-insert-menu): Handle both kinds of menu item. (texinfo-multi-files-insert-main-menu): Likewise. (texinfo-update-node): Pass t as second arg to push-mark. (texinfo-sequential-node-update): Likewise. (texinfo-insert-node-lines): Bind `title' at a higher level. Don't find previous @node if it's close. Take region to process as arguments. (texinfo-multiple-files-update): Handle prefix arg better within `interactive'. Canonicalize the blank lines. Wed Jul 7 16:13:57 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * autoload.el (update-file-autoloads): Correctly do nothing when there are no cookies. Wed Jul 7 15:58:54 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * menu-bar.el (mouse-menu-choose-yank): Change menu title to "Choose Next Yank". Wed Jul 7 03:19:41 1993 Paul Eggert (eggert@twinsun.com) * vc-hooks.el (vc-rcs-status): Removed unused variable `status'. * rmail.el (rmail-resend): Use RFC 822 style date in Resent-Date: line. * sendmail.el (mail-do-fcc): Likewise, for appending Date: lines to RMAIL mode buffers. Use new `mail-rfc822-time-zone' function to simplify pinhead generation. * mail-utils.el (mail-rfc822-time-zone, mail-rfc822-date): New fns. Wed Jul 7 02:26:31 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * files.el (cd-absolute): Use abbreviate-file-name on expansion of DIR. * gud.el: Add (provide 'gud). * files.el (basic-save-buffer): Invoke after-save-hook, not after-save-hooks. * time.el (display-time-file-nonempty-p): Use file-chase-links. * bytecomp.el (byte-compile-setq-default): Handle multiple pairs args like setq (as the setq-default subr does). * autoload.el: Doc fix. Tue Jul 6 18:07:14 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-variables): Compare truename as well as given name against rmail-file-name. * man.el (Man-mode-line-format): Add a space after global-mode-string. Tue Jul 6 11:05:14 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.16 released. Tue Jul 6 01:21:37 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * vc.el (vc-start-entry): Don't call file-name-nondirectory on FILE before passing it to vc-mode-line. Everyplace else passes vc-mode-line full filenames, and vc-mode-line now needs the real file name to decide which version-control system the file is under. * man.el (Man-build-man-command): Don't leave a pipe symbol at the end of the command list if Man-filter-list is nil. (Man-default-man-args): Don't write out assq and mapconcat. (Man-default-man-entry): Don't default to section 2 for C-mode. Call Man-default-man-args, and let people use Man-auto-section-alist if this is what they want. (manual-entry): Call Man-translate-references, instead of writing it out. (Man-getpage-in-background): Don't apply Man-default-man-args here; manual-entry has already run it, and Man-follow-manual-reference provides the sections itself. Mon Jul 5 00:43:20 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * map-ynp.el (map-y-or-n-p): If we get a switch-frame-event, save it until we're done asking questions, and then unread it. Mon Jul 5 03:20:12 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-name): Move to vc-hooks.el. * vc-hooks.el (vc-name): Moved from vc.el; vc-rcs-status now uses it. (vc-name, vc-backend-deduce): Set both vc-name and vc-backend properties, to avoid calling vc-registered unnecessarily when the other property is needed. (vc-rcs-status): Yield only status of locks; do not try to yield " REV" if there are no locks, since this cannot be done easily if there are branches. Use vc-name instead of duplicating its function incorrectly. Fix off-by-one bug when inserting master header pieces. Read headers 8192 bytes at a time instead of 100. Don't bother to expand-file-name. (vc-rcs-glean-field): Removed. Sun Jul 4 17:29:43 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * outline.el (outline-mode-map): Add menu bar items. (outline-minor-mode-map): Copy menu bar submap from outline-mode-map. * help.el (describe-key-briefly): Don't set `foo'. Sun Jul 4 17:01:01 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * subr.el (posn-point): Properly extract the BUFFER-POSITION field of an event when read-key-sequence has placed it in a singleton list. * comint.el (comint-prompt-regexp): Double the backslashes in the sample prompt regexps, so that they print properly when unquoted. Sun Jul 4 18:54:59 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-backend-diff): Undo "-q" change. This was fixed instead by adding -q support to vcdiff. Sun Jul 4 13:55:13 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * help.el (describe-prefix-bindings): New command. (prefix-help-command): Set it. * hexl.el: Added a keyword. Sun Jul 4 12:46:27 1993 Johan Vromans (jv@mh.nl) * forms.el (forms-new-record-filter): Correct default value. (forms-modified-record-filter): Correct default value. Sun Jul 4 00:53:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * paren.el (show-paren-command-hook): Add message for paren mismatch. * vc-hooks.el (vc-mode-line): Put `RCS' or `SCCS' before version num. Sat Jul 3 21:44:54 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * faces.el (make-face-bold, make-face-italic, make-face-bold-italic, make-face-unbold, make-face-unitalic): Properly pass noerror argument to recursive calls. * frame.el (frame-remove-geometry-params): New function. (frame-initialize): Call it, instead of writing it out. Sat Jul 3 15:03:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (kill-region): Cope with change hooks that change props. Sat Jul 3 06:15:43 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * term/x-win.el: Check the reverseVideo/ReverseVideo resource, correctly distinguish between "on" and "off" values, and put a parameter in default-frame-alist. * frame.el (frame-initialize): Don't call x-get-resource here. Sat Jul 3 03:22:04 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * autoload.el (update-file-autoloads): Do nothing when there are no cookies. Fri Jul 2 18:55:23 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * mouse.el (mouse-drag-region): Correctly handle drags which enter other frames. Fri Jul 2 17:28:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc.el (vc-path): New variable. (vc-do-command): Use vc-path. * menu-bar.el (menu-bar-edit-menu): Rename menu item to Choose Next Paste. Create this item along with all the others. * isearch.el (isearch-other-meta-char): Handle sequences containing mouse clicks in scroll-bar that used another buffer's map. Fri Jul 2 16:06:38 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * vc.el (vc-backend-diff): Pass the "-q" flag only if we're using rcsdiff. Fri Jul 2 14:31:59 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * menu-bar.el: Put mouse-menu-choose-yank binding after paste=>yank binding in menu-bar-edit-menu. Fri Jul 2 13:32:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * bytecomp.el (byte-compile-keep-pending): Handle fset like defalias. (byte-compile-file-form-defmumble): Fix backward if in prev change. Thu Jul 1 20:14:44 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * dired-aux.el (dired-diff): Work even when the mark is inactive. Thu Jul 1 18:10:45 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-send): Don't test buffer-modified-p if buffer is visiting a file. * bytecomp.el (byte-compile-file-form-defmumble): If byte-compile-compatibility, use fset, not defalias. Thu Jul 1 16:33:01 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * simple.el: Add bindings to function-key-map so that the keypad keys act like ordinary self-insertion keys, unless explicitly bound. Thu Jul 1 14:39:35 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mailabbrev.el (build-mail-abbrevs): Do substitute-in-file-name on the abbrev, for `source'. * files.el (set-visited-file-name): Rename the old auto save file. Thu Jun 30 23:31:58 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * menu-bar.el (mouse-menu-choose-yank): Just return when x-popup-menu returns nil. Add menu-enable property to this function. Wed Jun 30 17:50:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * compile.el (compile-abbreviate-directory): New function. (compilation-parse-errors): Use that, to visit files with a dirname more like the one the user specified. Wed Jun 30 15:38:53 1993 Johan Vromans (jv@mh.nl) * forms.el: Add e-mail address and version info. Adjust commentary and doc strings. (forms-mode): Add ###autoload. (forms-find-file): Add ###autoload. (forms-find-file-other-window): Add ###autoload. Wed Jun 30 21:35:59 1993 Paul Eggert (eggert@twinsun.com) * vc.el (vc-update-change-log): Ensure that file names inserted into a ChangeLog are relative to that ChangeLog. Wed Jun 30 12:43:18 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * simple.el (mark-even-if-inactive): New variable. (mark): Test it. * rmail.el: Doc fixes. Wed Jun 30 00:29:08 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * gud.el: Add history lists to the debugging commands, so we don't have to retype the filename every invocation. (gud-gdb-history, gud-sdb-history, gud-dbx-history, gud-xdb-history): New variables. (gdb, sdb, dbx, xdb): Use them when reading the argument string. * mouse.el (mouse-drag-region-1): Commented out. (mouse-drag-region): Commented out, and replaced with new version, which highlights the region as we drag. (mouse-scroll-delay, mouse-drag-overlay): New variables. (mouse-scroll-subr): New function. * sun-fns.el, sun-curs.el: Move these to lisp/term, to be with sun-mouse.el. Tue Jun 29 19:00:38 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * faces.el (global-face-data): Doc fix. * gnus.el (gnus-newsrc-to-gnus-format): Correct regexp which matches .newsrc lines not to match more than one line. Tue Jun 29 13:05:15 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ls-lisp.el (insert-directory): Doc fix. (ls-lisp-format): Provide user name when known. On ms-dos, provide a name for the group, to be prettier. Mon Jun 28 00:47:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (define-key-after): Delete duplicate bindings that come after the new one. Do insert when we reach the end, if haven't before. * paren.el: New file. * faces.el (face-initialize): Create `underline' face. (x-initialize-frame-faces): Set up `underline' face. * faces.el (x-initialize-frame-faces): Check x-display-color-p and x-display-planes to decide whether to try using colors or gray. * man.el (Man-auto-section-alist): Default value nil. (Man-getpage-in-background): Call Man-default-man-args. (Man-filter-list): Don't discard overstrike here. (Man-set-fonts): New function. (Man-bgproc-sentinel): Call Man-set-fonts. (Man-version-number): Var deleted. (Man-version): Command and binding deleted. (Man-mode): Use Manual, not Man, as official mode name. * solar.el: Doc fixes. * c-mode.el (c-forward-conditional): New function. (c-up-conditional): Use c-forward-conditional. (c-backward-conditional): New function. (c-mode-map): Make bindings for them. Sun Jun 27 20:56:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc.el (vc-update-change-log): Restore previous default-directory for running rcs2log. Sat Jun 26 00:18:21 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (define-key-after): New function. Fri Jun 25 13:58:52 1993 Barry A. Warsaw (warsaw@anthem.nlm.nih.gov) * reporter.el (reporter-submit-bug-report): Rename local var curbuf to reporter-eval-buffer. (reporter-dump-variable): Eval varsym in reporter-eval-buffer. * c++-mode.el (c++-fast-backward-syntactic-ws-2) (c++-fast-backward-syntactic-ws-1): Change the proper syntax table depending on whether we are editing C or C++ code. * c++-mode.el (c++-indent-exp): When computing offset for open-brace line, check not at class top level before adding c-indent-level. Fix bug handling member init lists. Fix case where comments follow a continued statement. Fix handling of c-brace-offset < 0. * c++-mode.el (c++-calculate-indent): Fixed indentation when base class declaration is on a separate line then the derived class intro header. Don't skip up past compound statement if we're in a member init list. * c++-mode.el (c++-indent-line): Clean up adjustment of block closing braces. Handle a list as value of c++-block-close-brace-offset. * c++-mode.el (c++-indent-exp): Use c-continued-statement-offset instead of c-indent-level to indent comma separated arg decl lists. * c++-mode.el (c++-fast-backward-syntactic-ws-2): Simplify for new forward-comment semantics. * c++-mode.el (c++-calculate-indent): Change if's to cond in CASE3. Require colon when looking for `case' or `default'. Use c++-compound-offset. (c++-compound-offset): New function. Distinguish statement continuation from enum and initializer lists. Fri Jun 25 18:30:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc-hooks.el (vc-rcs-status): New variable. (vc-mode-line): Display the lock status and head version. (vc-rcs-status, vc-rcs-glean-field): New function. * menu-bar.el (mouse-menu-bar-buffers): Include % and * in each item. Calculate amount of space needed for longest buffer name. * mouse.el (mouse-buffer-menu): Likewise. Fri Jun 25 18:01:47 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * add-log.el (find-change-log): Try get-file-buffer before file-exists-p. Fri Jun 25 17:30:19 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc.el (vc-diff): If `diff' gives empty output, return nil. Wed Jun 23 21:45:19 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * ange-ftp.el: Loosen file-name-handler-alist regexp so we can do host name completion. * hexl.el (hexl-in-save-buffer): New flag. (hexl-save-buffer): Prevent infinite recursion. Tue Jun 22 04:11:33 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * term/x-win.el (command-switch-alist): "-ib" takes a numeric argument; use x-handle-numeric-switch for it. * replace.el (query-replace-map): Fix typo in binding for [return]. Tue Jun 22 00:23:04 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmailsort.el: Don't touch rmail-summary-mode-map. Don't touch rmail-mode-map. Don't require rmail or sort. (rmail-summary-sort-...): Moved to rmailsum.el. (rmail-sort-from-summary): Likewise. * rmail.el: Add autoloads for rmailsort commands. (rmail-mode-map): Add bindings for those commands. * rmailsum.el (rmail-summary-mode-map): Bind summary sort commands. (rmail-summary-sort-...): Moved from rmailsort.el. (rmail-sort-from-summary): Likewise. Require rmailsort. Mon Jun 21 22:01:23 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * compile.el (compile-file-of-error): Remember that compilation-error-list stores file names as strings, not as (DIR . FILE) pairs. * diff.el (diff-parse-differences): Preserve the match data across the call to find-file-noselect. * subr.el (event-end): Modified to account for multi-click events. Mon Jun 21 01:53:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-mode-map): Add local menu bar bindings. (rmail-search-backward): New command. (rmail-mode): Move to the last message. * rmailsum.el (rmail-summary-mode-map): Add local menu bar bindings. (rmail-summary-search-backward): New command. (rmail-summary-search): Don't use save-excursion. * sendmail.el (mail-mode-map): Add local menu bar bindings. * texinfo.el: Set up autoloads for files `makeinfo' and `texnfo-upd'. (texinfo-delete-from-print-queue-command): New var. (texinfo-tex-trailer): New var. (texinfo-tex-region): Use that. (texinfo-tex-buffer): Rewritten; use the actual source file. Binding is now C-c C-t C-b. (texinfo-texindex): Turned back on. (texinfo-quit-job): New command, with binding. (texinfo-delete-from-print-queue): Likewise. (texinfo-show-structure): Indent each line according to depth. Require texnfo-upd. (texinfo-section-types-regexp): Var deleted. (texinfo-insert-@-with-arg): New function. (texinfo-insert-@var, etc.): Use that. (texinfo-insert-@end): New command, now on C-c C-c e. (texinfo-insert-@end-example): Deleted. (texinfo-insert-@table): New command, on C-c C-c t. (texinfo-start-menu-description): New command, on C-c C-c C-d. (texinfo-mode): No longer set tex-trailer. Make the @node for the top node start a page. Use shorter values for tex-end-of-header and tex-start-of-header. (texinfo-mode-map): Add bindings for makeinfo-buffer, etc. Delete bindings for texinfo-format-buffer/region. (texinfo-define-common-keys): New function. * texinfmt.el: File deleted. * makeinfo.el: New file. * metamail.el: New file. * time-stamp.el: New file. Sun Jun 20 20:44:36 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * add-log.el (add-log-current-defun): To find the name of the function being defined in emacs-lisp-mode, lisp-mode, and scheme-mode, skip an opening paren and an s-expression, instead of just one word. This allows us to properly recognize things like define-key and define-macro. * replace.el (query-replace-map): Make RET exit query-replace, just like ESC. Sun Jun 20 18:44:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mh-e.el (mh-yank-cur-msg): Test mark-active. Sat Jun 19 17:14:27 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * version 19.15 released. Sat Jun 19 17:47:40 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * info.el (Info-insert-dir): Remove the call to recursive-edit. Sat Jun 19 15:05:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * info.el (Info-insert-dir): Record file attributes of files used. Recompute the dir if they change. * files.el (insert-file): Report error if file is directory. Fri Jun 18 21:43:43 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * man.el (Man-switches): New variable. (Man-build-man-command): Use it to build the man command. (Man-mode): Mention it in documentation. Fri Jun 18 21:13:02 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmailout.el (rmail-output): Check file can be read before trying to read part of it. * ange-ftp.el (ange-ftp-insert-file-contents): Handle extra args BEG, END. Fri Jun 18 19:25:02 1993 Johan Vromans (jv@mh.nl) * forms.el: Delete local variables list. (forms-forms-scrolls): Deleted. (forms-forms-jumps): Deleted. (forms--change-commands): Use substitute-key-definition. (forms-mode): Call forms--change-commands later on. Fri Jun 18 13:55:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * compile.el (compilation-error-regexp-alist): Generalize the Apollo/BSD4.3 regexp to handle IBM RS6k too. * mouse.el (mouse-secondary-save-then-kill): Don't switch windows. Just set-buffer, and put save-excursion around it. (mouse-set-secondary, mouse-start-secondary): Likewise. (mouse-drag-secondary): Switch windows and move point just temporarily. Fri Jun 18 13:49:53 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * dired.el (dired-summary): dired-do-rename is on "R", not "r". Fri Jun 18 10:14:45 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-version): Update to 5.1. Fixed a variety of spelling error in comments and doc strings. (calendar-sexp-debug): New variable to turn off error catching. (calendar-absolute-from-gregorian): Removed unused vars month, day. (view-calendar-holidays-initially, all-hebrew-calendar-holidays, all-christian-calendar-holidays, all-christian-islamic-holidays, diary-nonmarking-symbol, hebrew-diary-entry-symbol, islamic-diary-entry-symbol, diary-include-string, abbreviated-calendar-year, european-calendar-style, european-calendar-display-form, american-calendar-display-form, calendar-date-display-form, print-diary-entries-hook, list-diary-entries-hook, nongregorian-diary-listing-hook, nongregorian-diary-marking-hook, diary-list-include-blanks, holidays-in-diary-buffer, general-holidays, increment-calendar-month, calendar-sum, calendar-string-spread, calendar-absolute-from-iso, calendar-print-iso-date, hebrew-calendar-elapsed-days, list-yahrzeit-dates, calendar-print-astro-day-number): Fix doc strings. (calendar-nth-named-day): Rewritten to include optional day of month. (general-holidays, calendar-holidays, hebrew-holidays, christian-holidays, islamic-holidays, solar-holidays): Rewritten to include require of cal-dst.el and to show the time of the change to/from daylight savings time. (calendar-current-time-zone, calendar-time-zone, calendar-daylight-time-offset, calendar-standard-time-zone-name, calendar-daylight-time-zone-name, calendar-daylight-savings-starts, calendar-daylight-savings-ends, calendar-daylight-savings-switchover-time): Moved to cal-dst.el. (calendar-location-name, calendar-time-display-form, calendar-latitude, calendar-longitude): Moved to solar.el. (calendar-holidays): Unquote it! * solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed solar-equinoxes-solstices. (calendar-time-display-form, calendar-latitude, calendar-longitude): Moved from calendar.el. (calendar-time-zone, calendar-standard-time-zone-name, calendar-daylight-time-zone-name, calendar-daylight-savings-starts, calendar-daylight-savings-ends): Take default values from calendar-current-time-zone, instead of being overwritten in open code if they were set to nil. (solar-time-string): Subtract calendar-daylight-time-offset when computing dst-ends. Avoid rounding errors when rounding time to the nearest minute. * diary.el (list-sexp-diary-entries, hebrew-calendar-year-Saturday-incomplete-Sunday, hebrew-calendar-year-Monday-incomplete-Tuesday, hebrew-calendar-year-Tuesday-regular-Thursday, hebrew-calendar-year-Thursday-complete-Sunday, hebrew-calendar-year-Saturday-complete-Thursday, hebrew-calendar-year-Monday-complete-Saturday, hebrew-calendar-year-Thursday-incomplete-Sunday): Fix doc strings. (diary-sexp-entry): Use calendar-sexp-debug to turn off error catching. * diary-ins.el (insert-cyclic-diary-entry): Fix date form. * cal-mayan.el (calendar-mayan-days-before-absolute-zero, calendar-mayan-haab-difference, calendar-mayan-tzolkin-difference, calendar-mayan-tzolkin-haab-on-or-before, calendar-previous-calendar-round-date, calendar-absolute-from-mayan-long-count, calendar-print-mayan-date): Fix doc strings. * holidays.el (calendar-holiday-function-fixed, calendar-holiday-function-float, calendar-holiday-function-julian, calendar-holiday-function-islamic, calendar-holiday-function-hebrew, calendar-holiday-function-sexp, calendar-holiday-function-advent, calendar-holiday-function-easter-etc, calendar-holiday-function-greek-orthodox-easter, calendar-holiday-function-rosh-hashanah-etc, calendar-holiday-function-hanukkah, calendar-holiday-function-passover-etc, calendar-holiday-function-tisha-b-av-etc): Renamed without words "calendar" and "function"; changed argument from a list of values to individual values. Fixed doc strings. (calendar-holiday-function-if): Removed. (calendar-holiday-solar-equinoxes-solstices): Renamed solar-equinoxes-solstices. (calendar-holiday-list): Rewrote to accomodate the name changes above and the unquoting of calendar-holidays. (calendar-cursor-holidays): Change screen-width to frame-width. (holiday-sexp): Rewritten. * lunar.el (lunar-phase): Use time conversion from solar.el * cal-dst.el: New file. (calendar-/, calendar-%, calendar-absolute-from-time, calendar-time-from-absolute, calendar-next-time-zone-transition, calendar-time-zone-daylight-rules): New functions. (calendar-current-time-zone): Moved from calendar.el and rewritten. (calendar-current-time-zone-cache): New variable. (calendar-current-time-zone, calendar-time-zone, calendar-daylight-time-offset, calendar-standard-time-zone-name, calendar-daylight-time-zone-name, calendar-daylight-savings-starts, calendar-daylight-savings-ends, calendar-daylight-savings-switchover-time): Moved from calendar.el. Thu Jun 17 19:29:56 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.14 released. Thu Jun 17 19:41:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-citation-hook): New hook var. (mail-yank-original): Use that hook if not nil. * sc.el: Change usage comment. Thu Jun 17 18:57:01 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * faces.el (make-face-bold, make-face-italic, make-face-bold-italic, make-face-unbold, make-face-unitalic): Always pass the frame parameter to internal-try-face-font; we only want to set the face for this frame. * faces.el (make-face-bold, make-face-italic, make-face-bold-italic, make-face-unbold, make-face-unitalic): Fix error messages. Thu Jun 17 00:12:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * faces.el (set-face-background-pixmap, face-background-pixmap): Functions commented out. * mouse.el (mouse-start-secondary): New function. (mouse-set-secondary, mouse-drag-secondary): New functions. (mouse-kill-secondary, mouse-secondary-save-then-kill): New functions. * term/vt200.el: Translate F11 (ESC [ 23 ~) to ESC. * term/vt201.el, term/vt220.el, term/vt240.el: Likewise. * autoload.el (generate-file-autoloads): Undo previous change because make-docfile requires defvar doc string to start on first line. * cplus-md.el: Renamed from c++-mode.el. * cplus-md1.el: Renamed from c++-mode-1.el. * vc.el (vc-rename-file): Remove periods from error messages. (vc-backend-logentry-check, vc-revert-buffer): Likewise. (vc-retrieve-snapshot, vc-create-snapshot): Likewise. (vc-diff, vc-finish-logentry, vc-steal-lock): Likewise. (vc-register, vc-next-action-on-file, vc-registration-error): Likewise. (vc-cancel-version): Add space to end of question. * menu-bar.el (mouse-menu-choose-yank): New function. Put it in the edit menu. (yank-menu-length): New variable. Wed Jun 16 20:16:10 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * subr.el (event-basic-type): Deal with listy events properly. Wed Jun 16 23:06:58 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * autoload.el (make-autoload): Use memq once instead eq twice. (generate-file-autoloads): For non-autoloads, copy the defn textually rather than printing it after reading. * autoload.el (generate-autoload-cookie, update-autoloads-here): Doc fixes. Wed Jun 16 17:21:51 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * frame.el (set-frame-configuration): Don't try to set a frame's minibuffer. This parameter can't be changed, so that would signal an error. Wed Jun 16 13:42:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * assoc.el (aput): Doc fix. * ls-lisp.el (insert-directory): If no handler, convert SWITCHES from a string to a list of characters. * disass.el (disassemble-internal): If function is autoload, load it. * lisp.el (parens-require-spaces): Var renamed and sense changed. (insert-parentheses): Corresponding changes. * rmailout.el (rmail-output): Use insert-file-contents to look at beginning of output file. * term/x-win.el (x-switch-definitions): Fix -iconic. * bytecomp.el (byte-compile-file-form-defmumble): Typo in prev change. Tue Jun 15 03:56:34 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * server.el (server-process-filter): Use server-switch-buffer. * gud.el (gud-xdb-directories): Renamed from gud-xdb-paths. Defvar moved earlier. All uses changed. (gud-xdb-debugger-startup): Rename local var `paths'. (gud-xdb-file-name): Likewise. * inf-lisp.el (inferior-lisp-buffer): Move defvar earlier. * mailalias.el (define-mail-alias): Remove excess whitespace better. * mailabbrev.el (define-mail-abbrev): Renamed from define-mail-alias. (build-mail-abbrevs): Use new name. * bytecomp.el (byte-compile-file-form-defmumble): Use defalias for named function, even if no doc string. * dired.el (dired-repeat-over-lines): Going fwd, skip new lines that FUNCTION inserts after the current line. Going backwd, no need for dired-move-to-filename each time. Tue Jun 15 21:10:22 1993 Shane Hartman (shane@nugget.spr.com) * gud.el (xdb): New debugger supported (xdb under HPUX-PARISC). (gud-xdb-debugger-startup): New function. (gud-xdb-file-name, gud-xdb-accumulation): New functions. (gud-xdb-marker-filter, gud-xdb-paths, gud-xdb-find-file): New. Mon Jun 14 14:53:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lisp.el (parens-dont-require-spaces): New variable. (insert-parentheses): Obey that variable. * emerge.el (emerge-make-diff3-list): Pass ancestor second. (emerge-extract-diffs3): Replace group-1 with group-2. (emerge-handle-local-variables): Pass no arg to hack-local-variables. * picture.el (picture-replace-match): New function. * dabbrev.el (dabbrev-expand): Do all changes with replace-match. In picture-mode, use picture-replace-match instead. Mon Jun 14 10:57:43 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * holidays.el: Eval calendar-holidays; don't just use its value. * complete.el: (provide 'complete). Mon Jun 14 03:10:35 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.el (balance-windows): Total rewrite. Sun Jun 13 00:33:55 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * bytecomp.el (byte-compile-file): Undo previous change. (batch-byte-recompile-directory): Doc fix. * isearch.el (isearch-highlight): If no face `isearch', use `region'. * c-mode.el (c-indent-line): Call c-backward-to-start-of-if in the case of else following a close brace. * man.el (Man-getpage-in-background): Use TERM=dumb to prevent terminal control sequences in the output. Sat Jun 12 16:58:04 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (abbreviate-file-name): Match home dir with no / if nothing else follows. * finder.el (finder-find-library): New function. (finder-commentary): Use it. * forms.el, forms-pass.el, forms-d2.el, forms-dat.el, forms.README: Moved from subdir forms-mode. Subdir deleted. Sat Jun 12 16:03:03 1993 Johan Vromans (jv@mh.nl) * forms.el (forms--change-commands): Use (function (lambda ...)) instead of '(lambda...). * forms.el: Provide `forms' as well as `forms-mode'. (forms-new-record-filter, forms-modified-record-filter): Add defvars. Sat Jun 12 02:53:34 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * files.el (make-directory): By default create dir default-dir. Fri Jun 11 11:46:51 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vc.el (vc-backend-diff): Always use -q option. * files.el (file-truename): Don't use expand-file-name to merge a link target into the previous dir. Handle .. and . explicitly. * env.el (setenv): Treat case as significant. * mailabbrev.el (sendmail-pre-abbrev-expand-hook): If last-command-char is not a character, don't check char-syntax. * inf-lisp.el: Doc fixes. (run-lisp): Add autoload. (inferior-lisp-mode-map): Explicitly make local prefix keys. * cmulisp.el: File deleted. * server.el (server-window): New variable. (server-switch-buffer): Use it. * flow-ctrl.el (enable-flow-control): Don't alter the 8-bit flag. * man.el (Man-filter-list): Add an element for X man pages. (Man-goto-page): Continue past errors in Man-build-references-alist. * rmailout.el (rmail-output-to-rmail-file): Use the smart default in the prompt. * register.el (view-register): Handle file name values. * etags.el (etags-tags-completion-table): When skipping the noise before the tag name, let it end with any char not allowed in a tag. * files.el (cd): Use file-name-absolute-p. (cd-absolute): No longer interactive. * echistory.el (electric-history-map): Don't use fillarray; make default bindings instead. Bind up, down, home, next, prior. Fri Jun 11 05:44:40 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * frame.el (frame-initialize): Remember to actually traverse initial-frame-alist. * gud.el (gud-last-last-frame): New variable. (gud-display-frame): Save the frame we displayed in gud-last-last-frame. (gud-refresh): Force gud-display-frame to jump to the last frame displayed, even if it has already done so once. * man.el (manual-entry): Recognize the subject(section) syntax. * picture.el (move-to-column-force): If column is negative, go flush left. * simple.el (hscroll-point-visible): Work as documented in the docstring for hscroll-step. Fri Jun 11 00:04:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lisp-mode.el (lisp-indent-function): Look for either lisp-indent-hook or lisp-indent-function property. * files.el (make-backup-files): Doc fix. * mouse.el (mouse-set-mark-fast): New function. (mouse-show-mark): New function. (mouse-kill-ring-save, mouse-save-then-kill): Use them. (mouse-save-then-kill): Don't let kill-region alter this-command. Check last-command accordingly. (mouse-split-window-vertically): Handle scroll bar events. Thu Jun 10 13:41:06 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * rmail.el (rmail-primary-inbox-list): Use defvar, not defconst. * files.el (basic-save-buffer): Cal auto-save-mode with t as arg if and only if auto save was off and default is on. (set-visited-file-name): Likewise. * simple.el (append-to-buffer): Interactively, supply all 3 args. Allow nonexistent buffers. * files.el (abbreviate-file-name): Make abbreviated-home-dir from `~/', not from just `~'. (hack-one-local-variable): Query for ...-hook(s) and ..-function(s) as the `eval' variable. * ispell.el: Doc fixes. (ispell-command, ispell-command-options): New defvars. (start-ispell): Use them. * ange-ftp.el (ange-ftp-multi-msgs): Add 331-. * man.el (Man-mode): Run Man-mode-hook. * bibtex.el (bibtex-mode-map): Use tex-insert-quote, not TeX-... Thu Jun 10 15:16:11 1993 Shane Hartman (shane@nugget.spr.com) * c++-mode.el (calculate-c++-indent): Respect c-continued-brace-offset (as in c-mode.el). Thu Jun 10 06:39:46 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * frame.el (frame-initialize): When deleting geometry specifications from initial-frame-alist, remember that they may occur more than once, and do, if the -geometry option was specified as well as a .geometry resource. * scroll-bar.el (scroll-bar-mode): Variable deleted. (scroll-bar-mode): Function changed to consult default-frame-alist instead of the variable. * gnus.el (gnus-start-news-server): If no server has been specified, but gnus-nntp-service is nil, don't ask for a server name; use the local host. * ange-ftp.el (ange-ftp-make-directory): Take second optional argument parents, like the original. Implement it. * gnus.el (gnus-newsrc-to-gnus-format): Change regexp which matches .newsrc lines for better performance under the new regexp routines. Thu Jun 10 13:40:44 1993 Dave Gillespie (daveg@synaptics.com) * bytecomp.el: Bug fixes and upgrade to match Zawinski's v2.10. (byte-compile-dest-file): Added support for emacs-lisp-file-regexp. (byte-recompile-directory): Several things involving `noninteractive'. (byte-compile-file): Changed prompting in read-file-name. (byte-compile-insert-header): Put a magic number at top of .elc files, fixed backwards test of byte-compile-compatibility. (byte-compile-form, byte-defop-compiler19, byte-compile-list, byte-compile-concat, byte-compile-insert): Likewise. (byte-compile-condition-case): Added checking for unknown conditions. (batch-byte-recompile-directory): New function. Wed Jun 9 05:43:49 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * compile.el (compilation-error-list): When we haven't yet generated a marker for the source position of an error message, store (FILENAME . LINE-NUMBER), not ((DIRECTORY . FILE) LINE-NUMBER). Doc fix. (next-error, compilation-parse-errors): Adjusted appropriately. * scroll-bar.el (scroll-bar-set-window-start): Remember that the scroll bar numbers reflect the accessible region of the buffer, not the entire buffer. Tue Jun 8 12:28:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired.el (dired-flag-auto-save-files): Ignore `*' added by ls -F. * sc.el (sc-mark): Use mark-marker. Tue Jun 8 08:28:14 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.13 released. Tue Jun 8 00:40:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fortran.el (fortran-indent-new-line): Renamed from fortran-reindent-then-newline-and-indent. * mouse.el (mouse-drag-region-1): Un-comment-out this function. * info.el (Info-follow-reference): Fix completion defaulting. Mon Jun 7 21:47:37 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-current-time-zone): Change variable names to make them more readable. (calendar-time-zone, calendar-standard-time-zone-name, calendar-daylight-time-zone-name, calendar-daylight-savings-ends, calendar-daylight-savings-starts): Don't autload them. Mon Jun 7 00:25:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * apropos.el (safe-documentation): Don't crash on byte-compiled macro. * telnet.el (telnet-simple-send): New function. (telnet): Arrange to use that. * sun-keys.el: File deleted. * texinfo.el (texinfo-section-types-regexp): Add @chapheading. * gud.el: Doc fixes. Delete local variable list at the end. (expr-forward-sexp): Renamed from forw-expr. (expr-backward-sexp): Renamed from back-expr. * case-table.el (describe-buffer-case-table): Merge locals i and ch. Make *Help* current buffer for describe-vector. * bibtex.el: Fix typos in previous change. Add a few menu items. * compile.el (compilation-error-regexp-alist): Make sure each regexp can only match a few characters at the front. Split off the Mips CC regexp from the Apollo regexp. * rmail.el (rmail-variables): Default rmail-inbox-list here. (rmail): Not here. * ange-ftp.el (ange-ftp-real-load): New function. (ange-ftp-load): New function--handles `load'. Sun Jun 6 18:29:36 1993 Paul Eggert (eggert@twinsun.com) * term/sun-mouse.el (mouse-union-first-preferred): Renamed from mouse-union-first-prefered. Sun Jun 6 17:46:25 1993 Paul Eggert (eggert@twinsun.com) * sc.el (sc-consistent-cite-p): Renamed from sc-consistant-cite-p. * etags.el (etags-recognize-tags-table): Fix misspelling of find-tag-regexp-next-line-after-failure-p. * bibtex.el (bibtex-name-alignment): Renamed from bibtex-name-alignement. * allout.el (outlinify-sticky): Renamed from outlineify-sticky. * faces.el (x-create-frame-with-faces): Reversevideo -> ReverseVideo. * frame.el (frame-initialize): Likewise. Sun Jun 6 01:27:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * outline.el (outline-minor-mode): Add autoload cookie. * bibtex.el: Define 2 local menu-bar submaps. (bibtex-x-help, bibtex-x-environment): Deleted. * isearch.el (search-upper-case): Make `no-yanks' the default. (isearch-no-upper-case-p): New arg REGEXP-FLAG. (isearch-search): Pass new arg. (isearch-member-equal): Deleted. (isearch-overlay): New variable. (isearch-highlight, isearch-dehighlight): Rewritten to use overlays. * dired.el (dired-unmark-all-files): Read arg as just a character. Use non-regexp search to find a specific mark. Use subst-char-in-region to make the change. Improve the message at the end. * vip.el (vip-ctl-key-equivalent): Use vip-escape-to-emacs. (vip-escape-to-emacs): Use read-key-sequence and key-binding. Arg EVENTS replaces arg CHAR. (vip-ESC, vip-ctl-c, vip-ctl-x, vip-ctl-h): These callers changed. * compile.el (compile-internal): Alter current buffer only temporarily. Sat Jun 5 13:08:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-do-fcc): Replace the code for appending to buffer. * rmailsum.el (rmail-summary-next-msg): Fix number of dots in regexp. * scroll-bar.el (scroll-bar-drag-1): Calculate position relative to the accessible part of the buffer. * menu-bar.el (menu-bar-help-menu): Add defvar. (menu-bar-edit-menu, menu-bar-file-menu): Likewise. * dired.el (dired-flag-backup-files): Handle `*' made by `ls -F'. * ange-ftp.el (internal-ange-ftp-mode): Renamed from ange-ftp-mode. Callers changed. * menu-bar.el (window-system): Enable menu bars only if window-system is non-nil. * add-log.el (add-log-current-defun): Fix typos in last change. Sat Jun 5 04:39:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * term/x-win.el (x-selection-timeout): Set it, using x-get-resource. Fri Jun 4 07:14:44 1993 Paul Eggert (eggert@twinsun.com) * timezone.el: (timezone-make-date-arpa-standard, timezone-make-date-sortable): Move common code into timezone-fix-time. (timezone-fix-time): Merge common code from above two functions. Yield time zone at end of result vector. Set time zone offset correctly as of the given time, instead of guessing from the current offset. (timezone-make-arpa-date, timezone-zone-to-minute): Convert current-time-zone style timezones into RFC-822 style timezones. (timezone-time-from-absolute, timezone-time-zone-from-absolute, timezone-day-number, timezone-absolute-from-gregorian): More functions borrowed from Reingold's calendar package. (timezone-make-arpa-date, timezone-make-sortable-date): Can safely assume that year includes century, since timezone-fix-time guarantees this. * gnuspost.el (gnus-current-time-zone): New function, which tries current-time-zone, and if that fails falls back on gnus-local-timezone. (gnus-inews-date): Use it. (gnus-inews-valid-date): New optional args TIME (default now) and ZONE (default GMT). (gnus-inews-buggy-date): New optional arg TIME (default now). * gnus.el (gnus-local-timezone): Now used only if current-time-zone does not work. Fri Jun 4 01:16:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mh-e.el (mh-yank-cur-msg): Use (mark t). * simple.el (mark): Doc fix. * add-log.el (add-log-current-defun): Handle Fortran. * rmail.el (rmail-resend): Require sendmail and mailalias. * time.el (display-time-24hr-format): Make it a user option. * edt.el (GOLD-prefix): Define *after* GOLD-map. * dired.el (dired-change-marks): Just ding if one arg is RET. Search for strings, not regexps. Use subst-char-in-region. * isearch.el (isearch-mode): Set isearch-window-configuration only if in slow mode. (isearch-done): Use isearch-window-configuration only if non-nil. (isearch-other-control-char): For mouse event, call isearch-done in the buffer whose keymap was used. * flow-ctrl.el (enable-flow-control): Doc fix. Thu Jun 3 20:01:19 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-holidays): Quote it to delay evaluation until it's needed. * holidays.el (calendar-holiday-list): Eval calendar-holidays. Thu Jun 3 00:47:23 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sendmail.el (mail-do-fcc): Omit first 2 lines when appending to an RMAIL buffer. * simple.el (kill-ring-save): Doc fix. * rmailsum.el (rmail-summary-expunge-and-save): Do save-buffer last. Use two separate save-excursion calls. (rmail-summary-input): Use pop-to-buffer. (rmail-summary-get-new-mail): Gobble rmail-current-message; later go to that message. (rmail-summary-next-msg): Start at end of line, if moving forward. Move to beginning of line, after the loop. (rmail-new-summary): Fix format of elt in minor-mode-alist. * rmail.el (rmail-select-summary): Add a save-excursion. * rmailsum.el (rmail-summary-expunge-and-save): Call set-buffer again after rmail-only-expunge. (rmail-summary-add-label, rmail-summary-kill-label): Fix reading the label. (rmail-summary-rmail-update): Bind window locally. Use unwind-protect, not save-window-excursion. * vc-hooks.el (vc-find-file-hook): Check buffer-file-name is non-nil. * hideif.el (define-hide-ifdef-mode-map): Don't bind C-c LETTER. Use C-c ESC LETTER instead. Handle case where where-is-internal returns nil. * texinfmt.el: Provide texinfmt. * bytecomp.el (byte-compile-insert-header): Fix backwards test of byte-compile-compatibility. * info.el (Info-mode-map): Bind mouse-2, not mouse-3. * view.el (View-scroll-lines-forward): If we exit, do nothing else. * calendar.el (calendar-mode): Doc fix. (calendar-mark-ring): New defvar. * frame.el (frame-initialize): Set cursor-color last. * vip.el (vip-escape-to-emacs): Temporarily restore local map and use read-key-sequence. * rmailsum.el (rmail-summary-by-senders): New function. (rmail-message-senders-p): New function. Thu Jun 3 17:58:59 1993 Dave Gillespie (daveg@synaptics.com) * complete.el (PC-lisp-complete-symbol): Added. (PC-look-for-include-file): Recognize some Lisp notations. (PC-include-file-all-completions): Fixed uppercase variable names. Wed Jun 2 12:56:57 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * info.el (Info-suffix-list): Handle .gz suffix. * ange-ftp.el (ange-ftp-binary-file-name-regexp): Handle .gz. * ehelp.el (electric-help-command-loop): Use equal to compare lists of events. * electric.el (Electric-command-loop): Use eq to compare events. * diff.el (diff): Really do use arg SWITCHES. * frame.el (frame-initialize): Delete geometry parms from initial-frame-alist. Wed Jun 2 09:59:02 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-daylight-savings-starts): Mention use of nil value in documentation string. (calendar-daylight-time-offset): New variable. (calendar-daylight-savings-switchover-time): New variable. (calendar-mode): Mention them. (calendar-time-zone, calendar-print-astro-day-number, calendar-time-display-form): Change Universal Time (UT) to Coordinated Universal Time (UTC). *solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change Universal Time (UT) to Coordinated Universal Time (UTC). (solar-time-string): Use calendar-daylight-time-offset instead of 1 hr, and use calendar-daylight-savings-switchover-time instead of midnight. Add an optional parameter to allow forcing the use of standard or daylight savings time. Fix code so it works in southern hemisphere (start of dst precedes end of dst in a calendar year) and when dst either starts or ends in a calendar year, but not both. Tue Jun 1 17:40:30 1993 Ken Manheimer (klm@coil.nist.gov) * allout.el (outlineify-sticky): Reconciled provisions for non-standard and standard prefix leaders. Tue Jun 1 16:09:26 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.12 released. * reporter.el: New file. * mouse.el (mouse-buffer-menu): Don't select the event's window, if event has frame instead. * tar-mode.el: Typo in autoload cookie. * shell.el (shell-prompt-pattern): Use defvar. * ange-ftp.el (ange-ftp-make-backup-files): Doc fix. * sendmail.el (mail-signature): Do not insert a line with `--'. * menu-bar.el (mouse-menu-bar-buffers): Renamed from mouse-buffer-menu. * subr.el (posn-timestamp): Doc fix. * sort.el (sort-fold-case): New variable. (sort-subr): Bind case-fold-search from sort-fold-case. * simple.el (undo): Pass proper arg to delete-auto-save-file-if-necessary. * desktop.el: New file. * c++-mode-1.el: New file. Tue Jun 1 16:03:30 1993 Ken Manheimer (klm@coil.nist.gov) * allout.el (move-to-column): Pass zero instead of negative arg. Added some free variables defvars, so byte-comple doesn't complain. Included some stub code, eventually will be proper use of Emacs 19 minor-mode-sensitive keymaps. Tue Jun 1 14:01:25 1993 Stephen A. Wood (saw@cebaf.gov) * fortran.el (fortran-mode): Replace comment-indent-hook with comment-indent-function. * fortran.el (fortran-is-in-string-p): Replaced with new version that uses the syntax table. * fortran.el (calculate-fortran-indent): Lines that have a # after whitespace are interpreted as cpp directives and outdented back to column zero. Tue Jun 1 00:27:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lucid.el (map-keymap): Doc fix. * dired-aux.el (dired-compress-file): Use gzip when proper/possible. * sc.el: Fix installation instructions. (sc-cite-original): Add autoload cookie. * sendmail.el (mail-yank-hooks): New hook variable. (mail-yank-original): Run the hook. (mail-indent-citation): New function. * cl.el (cl-mod): Renamed from mod. * Version 19.11 released. * lucid.el (copy-tree): Use let* to bind new before i. * terminal.el (te-pass-through): Delete debugging code left by mistake. * comint.el (comint-filter): Put window-start before the input. * isearch.el (isearch-mode): If enter recursive-edit, also bind isearch-recursive-edit. * cookie1.el: Renamed from cookie.el. Provide cookie1. * yow.el, spook.el: Changed accordingly. Mon May 31 23:21:41 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * outline.el (outline-flag-region): Pass t as NOUNDO arg to subst-char-in-region. No need to restore buffer-modified-p by hand. Mon May 31 20:29:00 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * term/x-win.el (x-invocation-args): Add defvar. Mon May 31 19:59:12 1993 Junio Hamano (junio@twinsun.com) * window.el (count-windows): PROC argument of walk-windows takes an argument. Mon May 31 00:20:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gnus.el (gnus-summary-isearch-article): Call isearch-forward in ordinary fashion with no args. (gnus-inews-article-hook, gnus-prepare-article-hook): Initialize to a list. (gnus-read-newsrc-file): If timestamps are equal, reload .newsrc. * bibtex.el (bibtex-mode): Add autoload. * files.el (inhibit-local-variables-regexps): New variable. (set-auto-mode): Handle inhibit-local-variables-regexps. * tar-mode.el: Don't initialize write-file-hooks. Don't change auto-mode-alist. (tar-regexp): Deleted. (tar-normal-mode): Deleted. (tar-mode): Add autoload. * faces.el (x-resolve-font-name): Clean up error messages. * timer.el (run-at-time): Pass args to start-process in right order. * info.el (Info-get-token): Check that thesecond search succeeded. * edebug.el: Provide edebug. * rmailsum.el (rmail-message-subject-p): Fix typo in string constant. * cl.el (mod): Use cl-floor. (rem): Use cl-truncate. * gud.el (gud-def): Don't use gud-key-prefix at compile time. * window.el (shrink-window-if-larger-than-buffer): Add `interactive'. Do nothing if window contents not entirely visible. * sendmail.el (mail-do-fcc): Put back the newline at the start of the fcc temp buffer. It got lost somewhere. Sun May 30 15:14:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * gnus.el (gnus-nntp-server): Use gnus-default-nntp-server. * info.el (Info-mode-map): Correct Info-top to Info-top-node. * man.el (Man-notify-when-ready): Correct previous change. Sun May 30 18:28:43 1993 Stephen Gildea (gildea@alex.lcs.mit.edu) * mh-e.el (mh-signature-file-name): New variable. mh-e version 3.8.2. Sun May 30 13:21:04 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * faces.el (x-resolve-font-name): Fix args to error; the format string was changed, but not the arguments to be substituted. * faces.el (x-resolve-font-name): Give correct error message depending on whether or not FACE was non-nil. See ChangeLog.3 for earlier changes. emacs-19.30/lisp/README100666 12120 1 713 5224127373 12723 0ustar rmsdaemonThis directory contains source code for the parts of Emacs that are written in Emacs Lisp. *.el files are Emacs Lisp source, and the corresponding *.elc files are byte-compiled versions. Byte-compiled files are architecture-independent. The term subdirectory contains Lisp files that customize Emacs for certain terminal types. When Emacs starts, it checks the TERM environment variable to get the terminal type and loads `term/${TERM}.el' if it exists. emacs-19.30/lisp/dired.todo100666 12241 12 32040 5204744140 14416 0ustar rolandstaff# file dired.todo -*-Outline-*- * Sandy's (sandy@itp.ethz.ch) main point is slowness when omitting (which I use only on demand, and simply don't use if it'd be too slow), so a transaction-free, reversible way of omitting by stashing away the filenames would be good. Hiding could be used, but probably selective-display-ellipses should be nil for omitting files, but t for hiding subdirectories, excluding simultaneous use of hiding and omitting. This would not be a problem if all subdirs had to be hidden together, but one subdir may be hidden while in another the are files to be omitted. * REALLY have to split large shell commands. * Try to cope with ls -lF format like this: lrwxrwxrwx 1 dsmith 0 Mar 30 16:44 root@ Note the missing " -> ". * In dired shell command, provide a way to pass a `*' to the shell, e.g., for grep. * kpc> well, here's an example. i'll have done a recursive find and grep, so kpc> i'll have, say, 61 files out of 450 possible files in the buffer. if kpc> i want to get them in time order and they are in size or name order, kpc> what do i do? if i use s, i'll get 450 files! so much for the kpc> grep.... on the other hand i can't see hitting l or c-u l 61 kpc> times.... I see why you need this. And `l' or `C-u l' would be no good since it always relists a complete subdirectory. kpc> redoing the ls with just the displayed files, if it works, would seem kpc> to be the best. though i don't know if anytuhing can be done about kpc> the consing. Well, if it only happens on demand, it's up to the user to decide whether it's worth an additional garbarge collection or two. And for your application of find-dired buffers, the list would not be very big. * >>> On Tue, 24 Mar 92 09:37:17 EST, >>> pinard%icule.UUCP@Larry.McRCIM.McGill.EDU (Francois Pinard) said: F> All the lines but the last have been hidden by dired-hide-all, while F> the last was first added by dired-maybe-insert-subdir, then hidden by F> dired-hide-subdir. It seems that dired-hide-all properly removes and F> reinserts white lines when it hides or unhide directories, while F> dired-hide-subdir does nothing about them. So, let me suggest that F> dired-hide-subdir removes white lines which preceedes a directory F> while hiding it, and that dired-hide-subdir insures one white line F> before any hidden directory it expands. I think the problem rather lies with the insertion than the hiding. A subdirectory extends from column zero of its headerline to just before the next headerline or end-of-buffer*. This is the region where \r to \n conversion must be done for hiding/unhiding**. The problem is that when `i' appends something (call it DIR-NEW) after a hidden dir (call it DIR-OLD) at the end of the buffer, that old dir does not end in a blank line like all others do. So in the process of inserting the contents of DIR-NEW it inserts an additional \n actually belonging to DIR-OLD (that would have been converted to a \r had it been present already when DIR-OLD was hidden). So a better fix is to have inserted dirs always end in a blank line, even the one at the end of the buffer. This will perhaps also fix some problems with nested dired format. Thank you for bringing this to my attention. I would appreciate any further comments you have on this. -Sebastian ---- * This is an axiom. I programmed dired so that it would be that way, so that the whole buffer would be a disjoint partition of subdirectories. ** Minus the last character (a newline) --- or several hidden subdir headerlines would all be in one hidden line. * dired-visit-hooks each time when a dired buffer is visited. Could be used to revert buffer each time if so desired. * let shell-command guessing based on regexps just be a special case of classes of files. Classes would in general be defined by lisp predicates evaluated on the file line in the dired buffer. Probably they will call dired-get-filename, but they need not. A class `directory' would be easy, for example. With a file class, not only a predicate (for deciding whether this file line belongs to the class) but perhaps also a finder method (to find all files of the class in this buffer) should be associated. File classes could be symbols (=names of boolean functions, or rather objects with predicate as one associated method of the object) or strings (regexps). Symbols should probably be of the form `dired-file-class-*'. `File Classes' should perhaps also work in non-dired buffers (->hyperbole!). `File Classes' could be a concept unifying omitting, shell command guessing and coloring/highlighting of file names under X11. * let C-u C-u i prompt for the dir to be inserted (?) * let `0 ESC (' simply run PREDICATE witout parsing each marked line, in case PREDICATE doesn't need this kind of extra information. * dired-between-files is not really safe, especially since it doesn't know about find-dired.el's `find' line. * From: eggert@twinsun.com (Paul Eggert) Subject: vc errors and nulldiff Date: Tue, 14 Jan 92 15:00:54 PST To: vc-friends@snark.thyrsus.com There are two questions attached to this topic. (1) Has anybody come up with a simple robust way to retrieve the status of an Emacs 18 subprocess? Instead of invoking a command FOO ARG1 ... ARGn, you could invoke the command /bin/sh -c '"$0" ${1+"$@"}; echo \ $?' FOO ARG1 ... ARGn This behaves just like FOO ARG1 ... ARGn, except instead of exiting with the true exit status, it appends the exit status as text to the standard output. The backslash-newline covers the case when the command's output does not end in newline. * dired*.texi: use `selected files' for marked or next N files * get rid of rcs in dired-x, dired-rcs is much faster. * let dired-current-directory return default-directory if dired-subdir-alist is nil (e.g. outside dired buffers, or in a not yet completed find-dired buffer). * wildcards are not well integrated with dired, e.g. entries are added to inappropriate buffers. * Use zero arg to `!' to just toggle a new dired-shell-command-on-each variable for consistency? * [rms] Put everything for copying, renaming, etc. into a separate file again. Put just autoloads in this file for that stuff. Likewise, put everything concerned with inserting, killing, and hiding subdirs into a separate file. For example, dired-tree-lessp and dired-split can go there. These separate files are to make plain dired smaller for most people. * use map-ynp instead of dired-query. * (defun dired-advertise () ;;"Advertise in variable `dired-buffers' what directory we dired." ;; With wildcards we actually advertise too much. +;; @@ There is no need to do this. +;; @@ Just check the subdir alist of the current buffer, +;; @@ and verify the current buffer is in dired-buffers. (if (memq (current-buffer) (dired-buffers-for-dir default-directory)) * [rms] I have an idea that might simplify dired. Suppose all nonempty non-file lines start with a particular character. A character one would never use as a mark. Then it would be very fast and simple to check for file lines. No need for the slowness of looking for the filename. I suggest the character * or > or #. Thus, inserting a subdir would install this marker on the non-file lines created. * shell command on several sets of markers: "diff A Z" Need quoting then, and better recognize marker only when embedded in space? Separate from `!'? * let `[' enter a mode where the permission bits can be edited, and let `]' exit that mode. Recursive edit? Keep list of filenames where perms were edited? Or just one file at a time? * dired-tree-lessp should use file-newer-than-file-p instead of string-lessp if sort on time? * dired-x: dired-mark-sexp (predicate &optional unflag-p) ;; As PREDICATE usually refers to only one or two fields, compiling ;; it instead of computing all fields could be worth while. * dired-ls should perhaps do file-name-nondirectory by itself, as in the only place where it lists a single file (in dired-add-entry) the basename is constructed afterwards. * dired-string-replace-match should have a GLOBAL replace flag. * dired-view-file-other-window? dired-find-file-read-only ? * Use diff-backup from emacs-19. Move latest-backup-file into emacs-19. * emacs-19.el's mkdir/rmdir commands should optionally accept a log-buffer argument. * [davida%puma@sunic.sunet.se (David Axmark)] The things I want most in dired is a way to skip selective parts of the -l listing (I use *long* filenames) from the listing swiches. As think this would require a special 'ls' (a hotted up GNU ls?) and some hacking of the buffer parsing code. It would be very nice to be able to have a format with just date or size or ... Yes, I'd like that too (I use **very long** filenames). Accepting ls switches without -l should not be too hard to implement. Hmm, no permission bits at the beginning of each line might break some parts of the code... But "just date" etc. would mean to prefobnicate ls output each time it is inserted...though that might me done efficiently if based on columns instead of regexps. I'll think about it.. * ls switches without -l shouldn't be that hard, though with loss of certain features (like *@/ marking). It would clean the screen tremendously. [This is possible now, but not documented since not everything works without -l, sk 14-May-1992 14:10] * move VM and RMAIL back into dired.el * `^' fails to find hidden parent dirlines. Other cmds too, probably. Perhaps the goto cmds should optionally unhide their targets. * M-DEL should mention in the prompt if there are no flags to remove, so it can be used for testing, too. Musings ======= * From: jbw@maverick.uswest.com (Joe Wells) Newsgroups: gnu.emacs.help,comp.emacs Subject: Re: stupid (probably) elisp question Date: 2 Aug 91 01:38:08 GMT Organization: U S West Advanced Technologies In-Reply-To: acevedo@athena.mit.edu's message of Wed, 31 Jul 91 14: 46:22 GMT (Gabriel) writes: | > [I would like to perform a regexp replacement on a string. | > How is this possible short of using an intermediate buffer?] | | It's not. Silly, ain't it? After all, buffers are just big | strings, albeit with a lot of state information attached. You could use string-match and concat to do the same thing, without using buffers: Don't do this. Using a scratch buffer is much more efficient, and results in less garbage collection later. Really? Why is this? 1. Replacing a substring in the middle of a string involves generating at least three strings, possibly more if you're doing something really fancy with regexps. Generating strings is expensive, both at the time they are generated and later when they're garbage collected. Since these strings are temporary, they are destined to be garbage collected. 2. Buffers are really fast. Once the gap is moved to the correct location in the buffer, the replacement involves simply writing the new bytes on top of the old bytes, even if the number of bytes changes. Moving the gap is actually pretty cheap, especially if the contents of the buffer are pretty small, like in this case. Just don't kill the buffer after you're done with it. Erase its contents instead and leave it around for the next time your function is called. -- Enjoy, Joe Wells * [jwz] One thing I miss about Lispms is a function called BALANCE-DIRECTORIES. What this would do is get a listing of two directories (possibly on different machines) and compare directories' contents and the files' write-dates, and copy files around until both directories were in synch. There was also an option to tell it to only copy in one direction instead of both, and you could run it on one file (a trivial case) that would copy that file if and only if the destination was not the same or newer. I think this would be a terribly useful feature, though you'd have to do it by comparing the textual representation of the date, since ange-ftp doesn't return correct numeric dates. [A subset of this is possible with copy-dir.el, sk 14-May-1992 14:11] * Actually, there are different meaning of prefix args: - with m, u and M-m, F: include even directories - with *@/~# : unmark instead mark - with mark-using (instead mark-setting) commands: use current file instead of marked files - with diff commands, it lets you edit the commandline * Perhaps the failed files should be given another mark, e.g. `!'. Then I would have to include the code from dired-x.el (just 40 lines) into dired.el to make it possible to switch the current marker character. One could then switch to `!', do something on the `!' files, and pop the old marker character off the stack. * dired-marker-regexp could use "\n" instead "^", is it used in re-search only, never in looking-at. But the speedup is not measurable (below 5%). * < and > should skip "." and "..". [No, use -A in switches instead!] emacs-19.30/site-lisp/ 40777 12120 1 0 6055530470 12726 5ustar rmsdaemonemacs-19.30/src/ 40777 12120 1 0 6055530746 11612 5ustar rmsdaemonemacs-19.30/src/m/ 40777 12120 1 0 6055530656 12046 5ustar rmsdaemonemacs-19.30/src/m/README100666 13437 1 603 5174232274 13132 0ustar jimbdaemonThis directory contains C header files containing machine-specific definitions. Each file describes a particular machine. The emacs configuration script edits ../config.h to include the appropriate one of these files, and then each emacs source file includes config.h. template.h is a generic template for machine descriptions; it describes the parameters a machine file can specify. emacs-19.30/src/m/7300.h100444 75424 13 5444 6045453641 12643 0ustar kwzhuser/* machine description file for AT&T UNIX PC model 7300 Copyright (C) 1986 Free Software Foundation, Inc. Modified for this machine by mtxinu!rtech!gonzo!daveb 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2-2" */ /* Supposedly now these machines have flexnames. /* # define SHORTNAMES */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* XINT must explicitly sign-extend */ #define EXPLICIT_SIGN_EXTEND /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* Now define a symbol for the cpu type, if your compiler does not define it automatically: vax, m68000, ns16000 are the ones defined so far. */ # ifndef mc68k # define mc68k # endif #ifndef m68k #define m68k #endif /* Cause crt0.c to define errno. */ #define NEED_ERRNO /* Data type of load average, as read out of kmem. */ /* These are commented out since it is not supported by this machine. */ /* #define LOAD_AVE_TYPE long */ /* Convert that into an integer that is 100 for a load average of 1.0 */ /* #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0) */ #ifdef __GNUC__ #define HAVE_ALLOCA #else #define SWITCH_ENUM_BUG #define C_ALLOCA #define STACK_DIRECTION -1 #endif /* If you have the PD pty driver installed, uncomment the following line. */ /* #define HAVE_PTYS */ #define HAVE_SYSVIPC /* We don't have memmove. */ #define memmove(d, s, n) safe_bcopy (s, d, n) /* These three lines were new in 18.50. They were said to permit a demand-paged executable, but someone else says they don't work. Someone else says they do. They didn't work because errno was an initialized variable in crt0.c, and because of %splimit (also therein), both of which have been fixed now. */ #define SECTION_ALIGNMENT 0x03ff #define SEGMENT_MASK 0xffff #define LD_SWITCH_MACHINE -z /* Insist on using cc when compiling this. GCC may have been configured to use GAS syntax, which causes problems. */ #define CRT0_COMPILE cc -c -O -Demacs emacs-19.30/src/m/acorn.h100444 75424 13 13032 6045453650 13364 0ustar kwzhuser/* Machine description file for Acorn RISCiX machines. Copyright (C) 1994 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. */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_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. We can't * do this on the arm with gcc, since the first 4 args are in registers. */ #ifdef __GNUC__ #define NO_ARG_ARRAY #else #undef NO_ARG_ARRAY #endif /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #undef WORD_MACHINE /* Define how to take a char and sign-extend into an int. On machines where char is signed, this is a no-op. */ /* ARM note - The RISCiX Norcroft C Compiler has ALL non-32-bit types as unsigned */ #define SIGN_EXTEND_CHAR(c) (((int)(c) << 24) >> 24) /* 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 */ /* ARM note - this is done by the Norcroft compiler - symbol is `__arm' */ /* 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 #ifdef LDAV_SYMBOL #undef LDAV_SYMBOL #endif #define LDAV_SYMBOL "_iavenrun" /* 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 */ /* * Scale factor for scaled integers used to count * %cpu time and load averages. */ /* FSHIFT and FSCALE are defined in param.h, but are required by LOAD_AVE_CVT, so they need to be defined here. */ #ifndef FSHIFT #define FSHIFT 8 /* bits to right of fixed binary point */ #endif #ifndef FSCALE #define FSCALE (1<. */ #define SYSV_SYSTEM_DIR /* For the portable alloca */ #define STACK_DIRECTION -1 #ifdef NO_REMAP /* CRT0_O is defined in s/riscix1-1.h or s/riscix1-2.h, as appropriate. */ #define START_FILES pre-crt0.o CRT0_O #else Cannot do this yet #endif emacs-19.30/src/m/alliant-2800.h100444 75424 13 10763 6045453654 14311 0ustar kwzhuser/* alliant-2800.h - Alliant FX/2800 machine running Concentrix 2800. Copyright (C) 1990 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-3" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_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. */ #undef WORD_MACHINE /* Now define a symbol for the cpu type, if your compiler does not define it automatically: vax, m68000, ns16000, pyramid, orion, tahoe and APOLLO are the ones defined so far. */ #define ALLIANT #define ALLIANT_2800 #define sun /* Use X support for Sun keyboard stuff. */ #define C_OPTIMIZE_SWITCH -Og /* No concurrent code allowed here. */ /* 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 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. */ /* On Alliants, bitfields are unsigned. */ #define EXPLICIT_SIGN_EXTEND /* Concentrix uses a different kernel symbol for load average. */ #undef LDAV_SYMBOL /* Undo definition in s-bsd4-2.h */ #define LDAV_SYMBOL "_Loadavg" /* 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 LOAD_AVE_CVT(x) (x * 100 / LOADAVG_SCALE) /* include for the definition of LOADAVG_SCALE, and also LOADAVG_SIZE, the number of items in the Loadavg array. */ /* 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 UNEXEC unexfx2800.o #define LIBS_MACHINE -lalliant /* 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. */ #undef 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. */ #undef 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. */ /* Actually, Alliant CONCENTRIX does paging "right": data pages are copy-on-write, which means that the pure data areas are shared automatically and remapping is not necessary. */ #define NO_REMAP /* Alliant needs special crt0.o because system version is not reentrant */ #define START_FILES crt0.o /* Alliant dependent code for dumping executing image. See crt0.c code for alliant. */ #define ADJUST_EXEC_HEADER {\ extern int _curbrk, _setbrk;\ _setbrk = _curbrk;\ hdr.a_bss_addr = bss_start;\ unexec_text_start = hdr.a_text_addr;} /* POSIX Compatibility */ /* Use System V.4 style getdents/readdir for 2.2 and up. */ #define SYSV_SYSTEM_DIR /* Use the K&R version of the DEFUN macro. */ #define USE_NONANSI_DEFUN emacs-19.30/src/m/alliant.h100444 75424 13 10512 6045453656 13714 0ustar kwzhuser/* alliant.h Alliant machine running system version 2 or 3. Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. Note that for version 1 of the Alliant system you should use alliant1.h instead of this file. Use alliant4.h for version 4. 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #ifdef ALLIANT_1 #define NO_ARG_ARRAY #endif /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #undef WORD_MACHINE /* Now define a symbol for the cpu type, if your compiler does not define it automatically: vax, m68000, ns16000, pyramid, orion, tahoe and APOLLO are the ones defined so far. */ #define ALLIANT /* 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. */ /* On Alliants, bitfields are unsigned. */ #define EXPLICIT_SIGN_EXTEND /* No load average information available for Alliants. */ #undef LOAD_AVE_TYPE #undef LOAD_AVE_CVT /* 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. */ #undef 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. */ #undef 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. */ #undef C_ALLOCA #define HAVE_ALLOCA #ifdef ALLIANT_1 #define C_ALLOCA #undef HAVE_ALLOCA #endif /* ALLIANT_1 */ /* 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. */ /* Actually, Alliant CONCENTRIX does paging "right": data pages are copy-on-write, which means that the pure data areas are shared automatically and remapping is not necessary. */ #define NO_REMAP /* Alliant needs special crt0.o because system version is not reentrant */ #define START_FILES crt0.o /* Alliant dependent code for dumping executing image. See crt0.c code for alliant. */ #define ADJUST_EXEC_HEADER {\ extern int _curbrk, _setbrk;\ _setbrk = _curbrk;\ hdr.a_bss_addr = bss_start;\ unexec_text_start = hdr.a_text_addr;} /* cc screws up on long names. Try making cpp replace them. */ #ifdef ALLIANT_1 #define Finsert_abbrev_table_description Finsert_abbrev_table_descrip #define internal_with_output_to_temp_buffer internal_with_output_to_tem #endif /* "vector" is a typedef in /usr/include/machine/reg.h, so its use as a variable name causes errors when compiling under ANSI C. */ #define vector xxvector emacs-19.30/src/m/alliant1.h100444 13437 1 424 5122175713 14120 0ustar jimbdaemon/* config.h should include this file for version 1 of Alliant's operating system. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-2" */ #define ALLIANT_1 #include "alliant.h" emacs-19.30/src/m/alliant4.h100444 13437 1 1411 5122176233 14136 0ustar jimbdaemon/* machine description file for Alliant Concentrix 4.0 or later. Use alliant.h for versions 2 and 3. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-2" */ #include "alliant.h" /* Concentrix uses a different kernel symbol for load average. */ #undef LDAV_SYMBOL /* Undo definition in s-bsd4-2.h */ #define LDAV_SYMBOL "_Loadavg" /* 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 LOAD_AVE_CVT(x) (x * 100 / LOADAVG_SCALE) /* include for the definition of LOADAVG_SCALE, and also LOADAVG_SIZE, the number of items in the Loadavg array. */ emacs-19.30/src/m/alpha.h100444 12120 1 20317 6054402147 13406 0ustar rmsdaemon/* machine description file For the alpha chip. Copyright (C) 1994 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="note" NOTE-START Use -opsystem=osf1 NOTE-END */ #define BITS_PER_LONG 64 /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_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 */ /* __alpha defined automatically */ /* Use type EMACS_INT rather than a union, to represent Lisp_Object */ /* This is desirable for most machines. */ #define NO_UNION_TYPE /* Define the type to use. */ #define EMACS_INT long #define EMACS_UINT unsigned long #define SPECIAL_EMACS_INT /* 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 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 HAVE_ALLOCA /* GNU malloc and the relocating allocator do not work together with X. [Who wrote that?] */ /* May 1995: reportedly [Rainer Schoepf ] both the system and the gnu malloc system work with "alpha-dec-osf3.0" and "alpha-dec-osf3.2". */ /* May 1995: it seems to me [Morten Welinder ] that both mallocs work with "alpha-dec-osf2.0", but I daren't break anything right now. Feel free to play if you want. */ /* #define SYSTEM_MALLOC */ /* 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 /* Some really obscure 4.2-based systems (like Sequent DYNIX) * do not support asynchronous I/O (using SIGIO) on sockets, * even though it works fine on tty's. If you have one of * these systems, define the following, and then use it in * config.h (or elsewhere) to decide when (not) to use SIGIO. * * You'd think this would go in an operating-system description file, * but since it only occurs on some, but not all, BSD systems, the * reasonable place to select for it is in the machine description * file. */ /* #define NO_SOCK_SIGIO */ #define HAVE_X11R4 #define HAVE_X11R5 /* Describe layout of the address space in an executing process. */ #define TEXT_START 0x120000000 #define DATA_START 0x140000000 /* This is necessary for mem-limits.h, so that start_of_data gives the correct value */ #define DATA_SEG_BITS 0x140000000 #ifdef OSF1 #define ORDINARY_LINK /* Some systems seem to have this, others don't. */ #ifdef HAVE_LIBDNET #define LIBS_MACHINE -ldnet #else #define LIBS_MACHINE -ldnet_stub #endif #endif /* OSF1 */ #if 0 /* Rainer Schoepf says this loses with X11R6 since it has only shared libraries. */ #ifndef __GNUC__ /* This apparently is for the system ld as opposed to Gnu ld. */ #ifdef OSF1 #define LD_SWITCH_MACHINE -non_shared #endif #endif #endif /* 0 */ #ifdef OSF1 #define LIBS_DEBUG #define START_FILES pre-crt0.o #endif #ifdef LINUX /* This controls a conditional in main. */ #define LINUX_SBRK_BUG #endif /* The program to be used for unexec. */ #define UNEXEC unexalpha.o #define PNTR_COMPARISON_TYPE unsigned long /* On the 64 bit architecture, we can use 60 bits for addresses */ #define VALBITS 60 /* This definition of MARKBIT is necessary because of the comparison of ARRAY_MARK_FLAG and MARKBIT in an #if in lisp.h, which cpp doesn't like. */ #define MARKBIT 0x8000000000000000L /* Define XINT and XUINT so that they can take arguments of type int */ #define XINT(a) (((long) (a) << (BITS_PER_LONG - VALBITS)) >> (BITS_PER_LONG - VALBITS)) #define XUINT(a) ((long) (a) & VALMASK) /* Define XPNTR to avoid or'ing with DATA_SEG_BITS */ #define XPNTR(a) XUINT (a) /* Declare malloc and realloc in a way that is clean. But not in makefiles! */ #ifndef NOT_C_CODE /* We need these because pointers are larger than the default ints. */ #include /* Hack alert! For reasons unknown to mankind the string.h file insists on defining bcopy etc. as taking char pointers as arguments. With Emacs this produces an endless amount of warning which are harmless, but tends to flood the real errors. This hack works around this problem by not prototyping. */ #define bcopy string_h_bcopy #define bzero string_h_bzero #define bcmp string_h_bcmp #include #undef bcopy #undef bzero #undef bcmp /* We need to prototype these for the lib-src programs even if we don't use the system malloc for the Emacs proper. */ #ifdef _MALLOC_INTERNAL /* These declarations are designed to match the ones in gmalloc.c. */ #if defined (__STDC__) && __STDC__ extern void *malloc (), *realloc (), *calloc (); #else extern char *malloc (), *realloc (), *calloc (); #endif #else /* not _MALLOC_INTERNAL */ extern void *malloc (), *realloc (), *calloc (); #endif /* not _MALLOC_INTERNAL */ extern long *xmalloc (), *xrealloc (); #ifdef REL_ALLOC #ifndef _MALLOC_INTERNAL /* "char *" because ralloc.c defines it that way. gmalloc.c thinks it is allowed to prototype these as "void *" so we don't prototype in that case. You're right: it stinks! */ extern char *r_alloc (), *r_re_alloc (); extern void r_alloc_free (); #endif /* not _MALLOC_INTERNAL */ #endif /* REL_ALLOC */ #endif /* not NOT_C_CODE */ #ifdef OSF1 #define PTY_ITERATION for (i = 0; i < 1; i++) /* ick */ #define PTY_NAME_SPRINTF /* none */ #define PTY_TTY_NAME_SPRINTF /* none */ #define PTY_OPEN \ do \ { \ int dummy; \ if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) \ fd = -1; \ close (dummy); \ } \ while (0) #endif #ifdef linux #define COFF /* Linux/Alpha doesn't like it if termio.h and termios.h get included simultaneously. */ #define NO_TERMIO #define TEXT_END ({ extern int _etext; &_etext; }) #define DATA_END ({ extern int _EDATA; &_EDATA; }) #endif emacs-19.30/src/m/altos.h100444 75424 13 3201 6045453660 13362 0ustar kwzhuser/* altos machine description file Altos 3068 Unix System V Release 2 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN #define EXPLICIT_SIGN_EXTEND /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE #define LIB_STANDARD -lc #ifdef __GNUC__ #define alloca __builtin_alloca #define HAVE_ALLOCA #else #define C_ALLOCA /* we have -lPW and alloca but it's broken! */ #endif #define SWITCH_ENUM_BUG #define NO_REMAP #define STACK_DIRECTION -1 #undef TERMINFO #undef CANNOT_DUMP #undef SHORTNAMES #define TERMCAP #define LIBS_TERMCAP -ltermlib #define PURESIZE 220000 #define ALTOS #ifdef __GNUC__ #define COFF_ENCAPSULATE #endif emacs-19.30/src/m/amdahl.h100444 75424 13 11433 6045453662 13516 0ustar kwzhuser/* amdahl machine description file Copyright (C) 1987 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. */ /* This file for amdahl_uts created by modifying the template.h by Jishnu Mukerji 3/1/87 The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2-2" This file works with the Amdahl uts native C compiler. The 5.2u370 compiler is so brain damaged that it is not even worth trying to use it. */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #undef 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 /* not actually used anywhere yet! */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically: vax, m68000, ns16000, pyramid, orion, tahoe and APOLLO are the ones defined so far. */ /* uts gets defined automatically */ /* However for clarity define amdahl_uts */ #define amdahl_uts /* 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 LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0)*/ /* 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 */ #ifdef HAVE_ALLOCA #define LIB_STANDARD -lPW -lc #endif /* 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*/ #define TERMINFO /* The usual definition of XINT, which involves shifting, does not sign-extend properly on this machine. */ #define XINT(i) (((sign_extend_temp=(i)) & 0x00800000) \ ? (sign_extend_temp | 0xFF000000) \ : (sign_extend_temp & 0x00FFFFFF)) #ifdef emacs /* Don't do this when making xmakefile! */ extern int sign_extend_temp; #endif /* The following needed to load the proper crt0.o and to get the proper declaration of data_start in the #undef NO_REMAP case */ #ifndef NO_REMAP #define START_FILES pre-crt0.o /lib/crt0.o #endif /* Perhaps this means that the optimizer isn't safe to use. */ #define C_OPTIMIZE_SWITCH /* Put text and data on non-segment boundary; makes image smaller */ #define LD_SWITCH_MACHINE -N /* When writing the 'xemacs' file, make text segment ro */ #define EXEC_MAGIC 0410 /* Mask for address bits within a memory segment */ #define SEGSIZ 0x10000 /* Should this not be defined elsewhere ? */ #define SEGMENT_MASK (SEGSIZ - 1) /* Tell alloca.c which direction stack grows. */ #define STACK_DIRECTION -1 /* Compensate for error in signal.h. */ #if NSIG==19 #undef NSIG #define NSIG 20 #endif emacs-19.30/src/m/apollo.h100444 75424 13 5530 6045453665 13542 0ustar kwzhuser/* machine description file for Apollo machine. Copyright (C) 1985, 1986, 1994, 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-3" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* Say this machine is a 68000 */ /* #define m68000 */ /* Done by the C compiler */ #define APOLLO /* Assume we use s-bsd4-3.h for system version 10. */ #ifdef BSD4_3 #define APOLLO_SR10 #endif /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* Do not define LOAD_AVE_TYPE or LOAD_AVE_CVT since there is no /dev/kmem */ /* Undefine VIRT_ADDR_VARIES because the virtual addresses of pure and impure space as loaded do not vary. */ #undef VIRT_ADDR_VARIES /* Define HAVE_ALLOCA because we use the system's version of alloca. */ #define HAVE_ALLOCA /* Prevent -lg from being used for debugging. Not needed. */ #define LIBS_DEBUG /* Can't use the system's termcap. It has compressed data sections that interfere with dumping. That means we won't automatically get a vt100 when we start up emacs in a dm pad (a dubious feature at best anyway). */ #undef LIBS_TERMCAP /* Must use the system's malloc and alloca. */ #define SYSTEM_MALLOC /* Define the file we use for UNEXEC. */ #define UNEXEC unexapollo.o /* The Apollo linker does not recognize the -X switch, so we remove it here. */ #define LD_SWITCH_SYSTEM /* Define C_SWITCH_MACHINE to compile for 68020/68030 or PRISM. Define LD_SWITCH_MACHINE to save space by stripping symbols and use X11 libraries. */ #if _ISP__A88K #define C_SWITCH_MACHINE -W0,-ncompress -W0,-opt,2 -A cpu,a88k -A sys,any -A run,bsd4.3 #define LD_SWITCH_MACHINE -A cpu,a88k -A sys,any -A run,bsd4.3 #else #define C_SWITCH_MACHINE -W0,-ncompress -W0,-opt,2 -A cpu,3000 -A sys,any -A run,bsd4.3 #define LD_SWITCH_MACHINE -A cpu,m68k -A sys,any -A run,bsd4.3 #endif #define OLDXMENU_OPTIONS ${C_SWITCH_MACHINE} /* In SR10.4, unistd.h has bad prototype for getpgrp, so we don't include it. */ #undef HAVE_UNISTD_H emacs-19.30/src/m/att3b.h100444 75424 13 11450 6045453703 13300 0ustar kwzhuser/* Machine-dependent configuration for GNU Emacs for AT&T 3b machines. Copyright (C) 1986 Free Software Foundation, Inc. Modified by David Robinson (daver@csvax.caltech.edu) 6/6/86 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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 */ #define ATT3B /* 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 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 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 */ /* Karl Kleinpaste says this isn't needed. */ /* 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. */ /* SysV has alloca in the PW library */ #define LIB_STANDARD -lPW -lc #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 /* #define LD_SWITCH_MACHINE -N */ /* Use Terminfo, not Termcap. */ #define TERMINFO /* -O has been observed to make correct C code in Emacs not work. So don't try to use it. */ #if u3b2 || u3b5 || u3b15 #define C_OPTIMIZE_SWITCH #endif /* Define our page size. */ #define NBPC 2048 /* The usual definition of XINT, which involves shifting, does not sign-extend properly on this machine. */ #define XINT(i) (((sign_extend_temp=(i)) & 0x00800000) \ ? (sign_extend_temp | 0xFF000000) \ : (sign_extend_temp & 0x00FFFFFF)) #ifdef emacs /* Don't do this when making xmakefile! */ extern int sign_extend_temp; #endif #if u3b2 || u3b5 || u3b15 /* On 3b2/5/15, data space has high order bit on. */ #define VALBITS 27 #define VALMASK (((1<> VALBITS) & GCTYPEMASK)) #endif /* 3b2, 3b5 or 3b15 */ #define TEXT_START 0 /* For alloca.c (not actually used, since HAVE_ALLOCA) */ #define STACK_DIRECTION 1 /* (short) negative-int doesn't sign-extend correctly */ #define SHORT_CAST_BUG /* 3B2s with WIN/3B have winsize defined in ptem.h */ #if u3b2 #define NEED_PTEM_H #endif /* u3b2 */ /* 3b2 does not have memmove, I'm told. */ /* It is safe to have no parens around the args in the safe_bcopy call, and parens would screw up the prototype decl for memmove. */ #define memmove(d, s, n) safe_bcopy (s, d, n) /* This affects filemode.c. */ #define NO_MODE_T emacs-19.30/src/m/aviion.h100444 75424 13 10501 6045453710 13542 0ustar kwzhuser/* machine description file for Data General AViiON. Copyright (C) 1985, 1986, 1991 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. */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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 /* Define DATA_SEG_BITS if pointers need to be corrected with a segment field. */ #ifdef FIX_ADDRESS #define DATA_SEG_BITS 0xef000000 #endif /* 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 */ #ifndef m88k #define m88k #endif /* 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 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 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 alloca(x) __builtin_alloca(x) /* 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 /* Define ADDR_CORRECT(ADDR) to be a macro to correct an int which is the bit pattern of a pointer to a byte into an int which is the number of a byte. This macro has a default definition which is usually right. This default definition is a no-op on most machines (where a pointer looks like an int) but not on all machines. */ #define ADDR_CORRECT(ADDR) ((int)ADDR) /* Cast pointers to this type to compare them. */ #define PNTR_COMPARISON_TYPE void * /* Some machines that use COFF executables require that each section start on a certain boundary *in the COFF file*. Such machines should define SECTION_ALIGNMENT to a mask of the low-order bits that must be zero on such a boundary. This mask is used to control padding between segments in the COFF file. If SECTION_ALIGNMENT is not defined, the segments are written consecutively with no attempt at alignment. This is right for unmodified system V. */ #define SECTION_ALIGNMENT 0x7 emacs-19.30/src/m/celerity.h100444 75424 13 3414 6045453712 14064 0ustar kwzhuser/* machine description file for Celerity. 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* XINT must explicitly sign extend */ #define EXPLICIT_SIGN_EXTEND /* celerity preprocessor defines "accel", however the following is clearer */ #define celerity /* #define NO_UNION_TYPE would be preferable, but it does not work, and the reason is not yet known. */ #define NO_UNION_TYPE /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) /* A machine-specific loader switch is needed. */ #define LD_SWITCH_MACHINE -k100000 /* alloca is provided by the system. */ #define HAVE_ALLOCA /* (short) negative-int doesn't sign-extend correctly */ #define SHORT_CAST_BUG emacs-19.30/src/m/clipper.h100444 75424 13 6464 6045453714 13714 0ustar kwzhuser/* machine description file for clipper 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 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. */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_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 */ #define clipper 1 /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* crt0.c should define a symbol `start' and do .globl with a dot. */ #define DOT_GLOBAL_START /* 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 */ /* USG systems I know of running on Vaxes do not actually support the load average, so disable it for them. */ /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) /* 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 */ /* Karl Kleinpaste says this isn't needed. */ /* 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 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 */ #ifdef USG #define TEXT_START 0 #endif /* USG */ #define LD_TEXT_START_ADDR 8000 emacs-19.30/src/m/cnvrgnt.h100444 75424 13 6647 6045453716 13744 0ustar kwzhuser/* machine description file for convergent S series. Copyright (C) 1989 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. */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #define m68000 /* 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. These are commented out since it is not supported by this machine. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) /* 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. */ #undef 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 #undef 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 /* Change some things to avoid bugs in compiler. */ #define SWITCH_ENUM_BUG /* fork(2) and vfork() are the same here. */ #define HAVE_VFORK /* grows towards lower addresses. */ #define STACK_DIRECTION -1 /* some errno.h's don't actually allocate the variable itself. Cause crt0.c to define errno. */ #define NEED_ERRNO emacs-19.30/src/m/convex.h100444 75424 13 13144 6045327610 13564 0ustar kwzhuser/* machine description file for Convex (all models). Copyright (C) 1987, 1994 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-3" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. * Maybe it would be better to simply correct the code. */ #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. */ #ifndef convex /* The compiler doesn't always do this. */ #define convex #endif /* Use type int rather than a union, to represent Lisp_Object */ /* This is desirable for most machines. */ #define NO_UNION_TYPE #ifndef __GNUC__ /* David M. Cooke and Ralph Sobek agree must ignore one arg when compiled with convex compiler. */ #define CRT0_DUMMIES ignore, #else #define CRT0_DUMMIES #endif /* crt0.c should define a symbol `start' and do .globl with a dot. */ #define DOT_GLOBAL_START /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) (int) ((x) * 100.0) /* 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 /* Must use the system's termcap. It does special things. */ #define LIBS_TERMCAP -ltermcap /* 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 */ /* Addresses on the Convex have the high bit set. */ #define DATA_SEG_BITS (1 << (BITS_PER_INT-1)) /* Right shift is logical shift. And the usual way of handling such machines, which involves copying the number into sign_extend_temp, does not work for reasons as yet unknown. */ #define XINT(a) sign_extend_lisp_int (a) /* Convex uses a special version of unexec. */ #define UNEXEC unexconvex.o /* you gotta define 'COFF' for post 6.1 unexec. */ #define COFF #define TEXT_START 0x80001000 /* Posix stuff for Convex OS 8.1 and up. */ #define LD_SWITCH_MACHINE \ -e__start -L /usr/lib \ '-A__iob=___ap$$iob' '-A_use_libc_sema=___ap$$use_libc_sema' /* Use . */ #define SYSV_SYSTEM_DIR #ifdef _POSIX_SOURCE /* These symbols have been undefined to advance the state of the art. */ #define S_IFMT _S_IFMT #define S_IFDIR _S_IFDIR #define S_IREAD _S_IREAD #define S_IWRITE _S_IWRITE #define S_IEXEC _S_IEXEC #endif /* Ptys may start below ptyp0; call a routine to hunt for where. */ #undef FIRST_PTY_LETTER #define FIRST_PTY_LETTER first_pty_letter() #if 0 /* * Force a K&R compilation and libraries with the Convex V 4.0 C compiler */ #define C_SWITCH_MACHINE -pcc #define LIB_STANDARD -lc_old #define LIBS_MACHINE -lC2_old #define LD_SWITCH_MACHINE -X -NL -fn -Enoposix -A__iob=___ap\$$iob \ -A_use_libc_sema=___ap\$$use_libc_sema -L /usr/lib #endif /* Avoid error in xrdb.c - d.m.cooke@larc.nasa.gov. */ #define DECLARE_GETPWUID_WITH_UID_T /* Call getpgrp properly. */ #define GETPGRP_NO_ARG /* Tested for both Convex C and GNUC by d.m.cooke@larc.nasa.gov. */ #define LIBS_MACHINE -lC2 /* Avoid error in getloadavg.c. */ #define NLIST_NAME_UNION 1 #if 0 /* This is supposed to be an improvement. It would be good for people to try enabling this code and report the results. */ /* gcc -nostdlib prevents some math symbols from being included. So we have to use -nostartfiles instead. */ #define LINKER $(CC) -nostartfiles #define ORDINARY_LINK #undef LD_SWITCH_MACHINE #define LD_SWITCH_MACHINE \ -L /usr/lib \ '-A__iob=___ap$$iob' '-A_use_libc_sema=___ap$$use_libc_sema' #endif emacs-19.30/src/m/cydra5.h100444 75424 13 10213 6045453720 13445 0ustar kwzhuser/* machine description file for Cydrome's CYDRA 5 mini super computer Copyright (C) 1988 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-3" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #undef NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #undef 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 */ /* 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 LOAD_AVE_CVT(x) x /* 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 data space precedes text space, numerically. */ #undef 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 #undef HAVE_ALLOCA /* The data segment in this machine always starts at address 0x10000000. An address of data cannot be stored correctly in a Lisp object; we always lose the high bits. We must tell XPNTR to add them back. */ #define DATA_SEG_BITS 0x20000000 #define DATA_START 0x20000000 /* 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 #define BROKEN_FIONREAD /* We son't even have it */ #define LIBS_MACHINE -lsocket -lnsl /* Stack grows downward in memory. */ #define STACK_DIRECTION -1 /* The data section in a coff file must be aligned in the file. */ #define DATA_SECTION_ALIGNMENT 0xFFF /* Compiler won't allow switch (x) when x is an enum. */ #define SWITCH_ENUM_BUG /* Explain how pty filenames work. */ #define PTY_ITERATION for (i = 47; i >= 0; i--) #define PTY_NAME_SPRINTF sprintf (ptyname, "/dev/pty%03x", i); #define PTY_TTY_NAME_SPRINTF sprintf (ptyname, "/dev/ptm%03x", i); /* We can't do interrupt-driven input, so don't let user try. */ #undef SIGIO emacs-19.30/src/m/delta.h100444 75424 13 16427 6045453722 13366 0ustar kwzhuser/* Machine description file for the Motorola Delta. Tested on mvme147 board using R3V7 without X. Tested with gcc. Tested on mvme167 board using R3V7 without X. Tested with cc, gnucc, gcc. Copyright (C) 1986, 1993, 1994 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-3" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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 */ #define m68000 #define MOTOROLA_DELTA /* 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 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 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 data space precedes text 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 /* Some really obscure 4.2-based systems (like Sequent DYNIX) * do not support asynchronous I/O (using SIGIO) on sockets, * even though it works fine on tty's. If you have one of * these systems, define the following, and then use it in * config.h (or elsewhere) to decide when (not) to use SIGIO. * * You'd think this would go in an operating-system description file, * but since it only occurs on some, but not all, BSD systems, the * reasonable place to select for it is in the machine description * file. */ /* #define NO_SOCK_SIGIO */ /* Undefine this if you don't want the machine slow down when a buffer is modified. */ #define CLASH_DETECTION /* Machine specific stuff */ #define HAVE_PTYS #define SYSV_PTYS #ifdef HAVE_INET_SOCKETS /* this comes from autoconf */ # define HAVE_SOCKETS /* NSE may or may not have been installed */ #endif #define SIGNALS_VIA_CHARACTERS #define BROKEN_CLOSEDIR /* builtin closedir is interruptible */ #undef HAVE_BCOPY /* b* functions are just stubs to mem* ones */ #define bcopy(from,to,bytes) memcpy(to,from,bytes) #define bzero(to,bytes) memset(to,0,bytes) #define bcmp memcmp #define memmove(t,f,s) safe_bcopy(f,t,s) /* for overlapping copies */ #undef KERNEL_FILE #define KERNEL_FILE "/sysv68" #undef LDAV_SYMBOL #ifdef SIGIO /* R3V7 has SIGIO, but interrupt input does not work yet. Let's go on with cbreak code. */ /* # define INTERRUPT_INPUT */ #endif /* The standard C library is -lc881, not -lc. -lbsd brings sigblock and sigsetmask. DO NOT USE -lPW. That version of alloca is broken in versions R3V5, R3V6, R3V7. -riku@field.fi -pot@cnuce.cnr.it. */ #define LIB_STANDARD -lc881 #define LIB_MATH -lm881 #define LIBS_TERMCAP -lcurses #define LIBS_SYSTEM -lbsd #undef sigsetmask #ifdef HAVE_X_WINDOWS # define HAVE_RANDOM # define BROKEN_FIONREAD /* pearce@ll.mit.edu says this is needed. */ # define HAVE_XSCREENNUMBEROFSCREEN # undef LIB_X11_LIB /* no shared libraries */ # define LIB_X11_LIB -lX11 # undef USG_SHARED_LIBRARIES /* once again, no shared libs */ # undef LIBX11_SYSTEM /* no -lpt as usg5-3.h expects */ # define LIBX11_SYSTEM -lnls -lnsl_s #endif /* HAVE_X_WINDOWS */ #ifdef __GNUC__ /* Use builtin alloca. Also be sure that no other ones are tried out. */ # define alloca __builtin_alloca # define HAVE_ALLOCA /* Union lisp objects do not yet work as of 19.15. */ /* # undef NO_UNION_TYPE */ /* We are assuming here that the `true' GNU gcc has not been installed, and we are using the gnucc provided by Motorola. No support exists for compiling with GNU gcc, as I do not have it on my machine to try it out. -pot@cnuce.cnr.it If __STDC__ is defined gnucc has been called without the -traditional option, that is, we are inside configure. If THIS_IS_CONFIGURE is not defined, then configure is trying to figure out what the right option for real compilation are. Let us set -traditional, because gmalloc.c includes , and we don't have that (as of SYSV68 R3V7). */ # define C_SWITCH_MACHINE -mfp0ret -traditional -Dconst= -fdelayed-branch -fstrength-reduce -fno-inline -fcaller-saves # define LIB_GCC /lib/gnulib881 #else /* Not __GNUC__, use the alloca in alloca.s. */ /* Try to guess if we are using the Green Hills Compiler */ # if defined mc68000 && defined MC68000 /* Required only for use with Green Hills compiler: -ga Because alloca relies on stack frames. This option forces the Green Hills compiler to create stack frames even for functions with few local variables. */ # define C_SWITCH_MACHINE -ga -O # define GAP_USE_BCOPY /* *++to = *++from is inefficient */ # define BCOPY_UPWARD_SAFE 0 # define BCOPY_DOWNWARD_SAFE 1 /* bcopy does: mov.b (%a1)+,(%a0)+ */ # else /* We are using the standard AT&T Portable C Compiler */ # define SWITCH_ENUM_BUG # endif #endif /* not __GNUC__ */ emacs-19.30/src/m/delta88k.h100444 75424 13 12011 6045453737 13710 0ustar kwzhuser/* Machine description file for Motorola System V/88 machines Copyright (C) 1985 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-3" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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 */ #ifndef m88000 /* Some 88k C compilers already define this */ #define m88000 #endif /* Now define a symbol for the cpu type, if your compiler does not define it automatically. */ /* 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. */ /* No load average on Motorola machines. */ /* #define LOAD_AVE_TYPE double */ /* Convert that into an integer that is 100 for a load average of 1.0 */ /* #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) */ /* 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 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 /* 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. */ /* BEM: Distributed asm alloca doesn't work. Don't know about libPW.a. C ALLOCA is safe and fast enough for now. */ #ifdef __GNUC__ #define HAVE_ALLOCA /* ... and be sure that no other ones are tried out. */ #undef C_ALLOCA #else /* not __GNUC__ */ #undef HAVE_ALLOCA #define C_ALLOCA /* Use the alloca() supplied in alloca.c. */ #define STACK_DIRECTION -1 /* The stack grows towards lower addresses. */ #endif /* __GNUC__ */ /* Motorola SysV has PTYs. Not all usg3-5 systems do, so this is defined here. */ #define HAVE_PTYS #define SYSV_PTYS /* Ditto for IPC. */ /* * we now have job control in R32V1 */ #undef NOMULTIPLEJOBS /* * we have bcopy, bzero, bcmp in libc.a (what isn't in libc.a?) */ #define BSTRING /* * sockets are in R32V1 */ #define HAVE_SOCKETS /* * we have the wrong name for networking libs */ #ifdef USG5_4 /* rms: not needed; LIB_X11_LIB deals with this. */ /* #define LIBX11_SYSTEM -lX11 */ #else #undef LIB_X11_LIB /* We don't have the shared libs as assumed in usg5-3.h. */ #undef LIBX11_SYSTEM #define LIBX11_SYSTEM -lnsl -lbsd #endif /* USG5_4 */ #define BROKEN_FIONREAD /* previously defined in usg5-4, if we choose to use that. */ #ifndef LIBS_SYSTEM #ifdef USG5_4 #define LIBS_SYSTEM -lsocket -lnsl #else #define LIBS_SYSTEM -lbsd -lg #endif /* USG5_4 */ #endif #define HAVE_TERMIOS #undef HAVE_TERMIO #define NO_TERMIO #undef sigsetmask #define NO_SIOCTL_H #ifdef USG5_4 #ifdef HAVE_X_WINDOWS #else #undef BSTRING #endif /* HAVE_X_WINDOWS */ #endif /* USG5_4 */ #define NO_PTY_H #define USE_GETOBAUD emacs-19.30/src/m/dpx2.h100444 75424 13 14137 6045453741 13147 0ustar kwzhuser/* 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 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. */ /* 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 ?) */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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... */ # 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 /* * useful if you have INET loaded */ # define LIBS_MACHINE -linet #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 /* 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 #define HAVE_TCATTR /* we also have this */ #define HAVE_PTYS #define SYSV_PTYS /* It doesn't seem we have sigpause */ #undef HAVE_SYSV_SIGPAUSE #define POSIX_SIGNALS /* We don't need the definition from usg5-3.h with POSIX_SIGNALS. */ #undef sigsetmask /* 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 /* system closedir sometimes complains about wrong descriptor for no apparent reasons. Use the provided closedir in sysdep.c instead */ #ifdef HAVE_CLOSEDIR #undef HAVE_CLOSEDIR #endif /* Send signals to subprocesses by "typing" signal chars at them. */ #define SIGNALS_VIA_CHARACTERS /* This is to prevent memory clobbering on the DPX/2 200. */ #define LD_SWITCH_MACHINE -N -T32 /* end of dpx2.h */ emacs-19.30/src/m/dual.h100444 75424 13 3770 6045453744 13203 0ustar kwzhuser/* machine description file for Dual machines using unisoft port. Copyright (C) 1985 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Dual running System V (-machine=dual -opsystem=usg5-2) As of 17.46, this works except for a few changes needed in unexec.c. Dual running Uniplus (-machine=dual -opsystem=unipl5-2) Works, as of 17.51. NOTE-END */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* XINT must explicitly sign-extend */ #define EXPLICIT_SIGN_EXTEND /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* Now define a symbol for the cpu type, if your compiler does not define it automatically: vax, m68000, ns16000 are the ones defined so far. */ #ifndef m68000 #define m68000 #endif /* Data type of load average, as read out of kmem. */ /* These are commented out since it does not really work in uniplus */ /* #define LOAD_AVE_TYPE long */ /* Convert that into an integer that is 100 for a load average of 1.0 */ /* #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0) */ /* Change some things to avoid bugs in compiler */ #define SWITCH_ENUM_BUG 1 emacs-19.30/src/m/elxsi.h100444 75424 13 10337 6045453752 13416 0ustar kwzhuser/* machine description file for Elxsi machine (running enix). Copyright (C) 1986, 1992 Free Software Foundation, Inc. Adapted by John Salmon 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2" */ /* This file was modified by Matt Crawford to work under Elxsi's 12.0 release of BSD unix. */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_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: vax, m68000, ns16000, pyramid, orion, tahoe and APOLLO are the ones defined so far. */ #ifndef elxsi #define elxsi #endif /* 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 /* Name of kernel load average variable */ #undef LDAV_SYMBOL #define LDAV_SYMBOL "avenrun" /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) (int) ((x) * 100.0) /* 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. Earlier versions couldn't dump. Changes for 12.0 release are in 19.1. Dumping should work now. */ /* #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*/ /* This is a guess for an alternate solution to whatever problem motivated defining _sobuf in sysdep,c with extern char *_sobuf. */ #define _sobuf xsobuf /* Address of start of text segment as loaded. */ #define TEXT_START 0x800 /* Tell crt0.c not to define environ. */ #define DONT_NEED_ENVIRON /* The elxsi has no debugger, so might as well optimize instead of trying to make a symbol table. */ #define C_DEBUG_SWITCH -O /* Elxsi uses COFF under both Sys V and BSD environments */ #define COFF #define ADJUST_EXEC_HEADER {\ extern int _init_brk;\ _init_brk = bss_start;\ } emacs-19.30/src/m/gec63.h100444 75424 13 3753 6045453754 13167 0ustar kwzhuser/* machine description file for gec63 Copyright (C) 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* Say this machine is a 68000 */ #define gec63 /* Use an int to represent Lisp_Object */ #define NO_UNION_TYPE /* GEC63 has alloca in the PW/ux63 library. */ #define LIB_STANDARD -lPW -lc #define HAVE_ALLOCA /* Do not define LOAD_AVE_TYPE or LOAD_AVE_CVT since there is no /dev/kmem */ #undef ADDR_CORRECT(x) #define NO_ARG_ARRAY #undef TERMCAP #define TERMINFO #define NO_REMAP /* The rest of the file certainly needs updating for Emacs 19.29! */ /* Define sizes of portions of a Lisp_Object. */ #define VALBITS 24 #define VALAMASK (((1<> VALBITS) & GCTYPEMASK)) #define XSETTYPE(a, b) ((a) = ((a) & VALAMASK) + ((int)(b) << VALBITS)) #define XPNTR(a) ((a) & VALAMASK) #define XSET(var, type, ptr) \ ((var) = ((int)(type) << VALBITS) + ((int) (ptr) & VALAMASK)) /* Move some garbage-collector flag bits to different bit positions. */ #define ARRAY_MARK_FLAG (1 << 27) emacs-19.30/src/m/gould-np1.h100444 13437 1 4746 5122176136 14254 0ustar jimbdaemon/* machine description file for Gould NP1 with UTX/32 3.0 (first release for NP1). */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-3" */ /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* UTX 3.0 uses a cross between COFF and a.out format, but closer to COFF. */ /* at least currently, already defined by cpp, but make sure */ #ifndef COFF #define COFF #endif COFF #include "gould.h" /* undefine what gould.h defined */ #undef ADJUST_EXEC_HEADER /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* UTX 3.0 uses a cross between COFF and a.out format, but closer to COFF. */ #ifndef COFF /* at least currently, already defined by cpp */ #define COFF #endif COFF /* make Gould NP1 and PN COFF look like USG COFF */ /* NP1 COFF */ #undef aouthdr /* Since gould.h already defined these */ #undef a_dtbase #ifdef IN_UNEXEC #define aouthdr exec #define ADJUST_TEXT_SCNHDR_SIZE /* Gould COFF - these are already defined in gould.h */ /* * #define COFF_WITH_BSD_SYMTAB * #define HEADER_INCL_IN_TEXT * #define magic a_magic * #define tsize a_text * #define dsize a_data * #define bsize a_bss * #define entry a_entry * #define text_start a_txbase * #define data_start a_dtbase */ /* End Gould COFF */ #endif /* IN_UNEXEC */ /* NP1 supports a slightly different set than PowerNode */ #define BAUD_CONVERT { 0, 50, 75, 110, 134, 150, 300, 450, 600, 1200, \ 1800, 2000, 2400, 3600, 4800, 7200, 9600, \ 19200, 38400 } #define LD_SWITCH_SYSTEM -BS -e start /* Undef C_DEBUG_SWITCH because it may have been set in gould.h */ /* It will compile and load and works with dbx. Runs under an incomplete port of gdb, but gdb doesn't always find things correctly. */ #undef C_DEBUG_SWITCH #define C_DEBUG_SWITCH -g #define LIBS_DEBUG -lg /* The data segment in this machine always starts at address 0x1000000 = 16M. An address of data cannot be stored correctly in a Lisp object; we always lose the high bits. We must tell XPNTR to add them back. */ #define DATA_SEG_BITS 0x1000000 #define DATA_START 0x1000000 /* The text segment always starts at 0. This way we don't need to have a label _start defined. */ #define TEXT_START 0 /* Data isn't right next to text on an NP1 */ #define NO_REMAP /* The bcopy bug has reappeared */ #undef BSTRING #ifndef GOULD_NP1 #define GOULD_NP1 #endif emacs-19.30/src/m/gould.h100444 75424 13 13504 6045453757 13410 0ustar kwzhuser/* machine description file for Gould PowerNodes with UTX/32 2.0 and 2.1. (See MACHINES for older versions.) * NOTE: If you are running a pre-release of UTX/32 2.1 you should #define * RELEASE2_1 in config.h. This may also be necessary with un-updated * official releases of 2.1 Copyright (C) 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Gould Power Node (-machine=gould -opsystem=bsd4-2 or bsd4-3) (gould.h; s-bsd4-2.h or s-bsd4-3.h) 18.36 worked on versions 1.2 and 2.0 of the operating system. On UTX/32 2.0, use -opsystem=bsd4-3 On UTX/32 1.2 and UTX/32S 1.0, use -opsystem=bsd4-2 and note that compiling lib-src/sorted-doc tickles a compiler bug: remove the -g flag to cc in the makefile. UTX/32 1.3 has a bug in the bcopy library routine. Fix it by #undef BSTRING in gould.h. Version 19 incorporates support for releases 2.1 and later of UTX/32. A site running a pre-release of 2.1 should #define RELEASE2_1 in config.h. NOTE-END */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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 */ #ifndef GOULD #define GOULD #endif /* sel is an old preprocessor name on gould machines - it is no longer needed and interferes with a variable in xmenu.c */ #undef sel /* 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 double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0) /* 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 STACK_DIRECTION -1 /* grows towards lower addresses on Gould UTX/32 */ /* No need to extend the user stack. */ /* If this is a 2.1 system, COFF will be predefined by cpp. If it's */ /* pre-2.1 COFF won't be defined, which is as it should be. */ #ifdef COFF #define HEADER_INCL_IN_TEXT #define COFF_BSD_SYMBOLS /* Seems to be necessary with coff */ #define NO_REMAP #ifndef GOULD_NP1 /* gould-np1.h includes this file */ /* keep the old value - don't skip over the headers */ #define KEEP_OLD_TEXT_SCNPTR #define KEEP_OLD_PADDR #ifndef RELEASE2_1 #define ADJUST_TEXTBASE #endif /*RELEASE2_1*/ #endif /* GOULD_NP1 */ #ifdef IN_UNEXEC /* make Gould NP and PN COFF look like USG COFF */ /* PN COFF */ #define aouthdr old_exec /* PN COFF doesn't have a data_start or a_dtbase field in its */ /* optional header, so substitute a junk field */ #define a_dtbase a_ccvers /* Gould COFF */ #define magic a_magic #define tsize a_text #define dsize a_data #define bsize a_bss #define entry a_entry #define text_start a_txbase #define data_start a_dtbase #endif /* IN_UNEXEC */ /* Define how to search all pty names. * This is for UTX 2.1 and greater on PN and all NP versions. It is only * accident that this happens to correspond to the same versions of UTX * as COFF does, but we'll take advantage of that here. */ /*#define USE_PTY_PAIR*/ #endif /* COFF */ /* -g is sometimes broken on the Gould. */ #define C_DEBUG_SWITCH /* Comparing pointers as unsigned ints tickles a bug in older compilers. */ #define PNTR_COMPARISON_TYPE int /* The GOULD machine counts the a.out file header as part of the text. */ #define A_TEXT_OFFSET(HDR) sizeof (HDR) /* Machine-dependent action when about to dump an executable file. */ #ifndef COFF #define ADJUST_EXEC_HEADER \ unexec_text_start = hdr.a_txbase + sizeof (hdr); #endif /* We use the system's crt0.o. Somehow it avoids losing with `environ' the way most standard crt0.o's do. */ #define START_FILES pre-crt0.o /lib/crt0.o emacs-19.30/src/m/hp800.h100444 75424 13 12721 6045327715 13127 0ustar kwzhuser/* machine description file for hp9000 series 800 machines. Copyright (C) 1987 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="hpux" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #undef 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 */ #ifndef hp9000s800 # define hp9000s800 #endif /* 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 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 double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) (x * 100.0)) /* 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. */ #undef 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 */ /* the data segment on this machine always starts at address 0x40000000. */ #define DATA_SEG_BITS 0x40000000 #define DATA_START 0x40000000 #define TEXT_START 0x00000000 #define STACK_DIRECTION 1 /* 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 /* This machine requires completely different unexec code which lives in a separate file. Specify the file name. */ #define UNEXEC unexhp9k800.o #define LIBS_MACHINE #define LIBS_DEBUG /* Define NEED_BSDTTY if you have such. */ #define NEED_BSDTTY /* The standard definitions of these macros would work ok, but these are faster because the constants are short. */ #define XUINT(a) (((unsigned)(a) << BITS_PER_INT-VALBITS) >> BITS_PER_INT-VALBITS) #define XSET(var, type, ptr) \ ((var) = ((int)(type) << VALBITS) + (((unsigned) (ptr) << BITS_PER_INT-VALBITS) >> BITS_PER_INT-VALBITS)) #define XMARKBIT(a) ((a) < 0) #define XSETMARKBIT(a,b) ((a) = ((b) ? (a)|MARKBIT : (a) & ~MARKBIT)) #if 0 /* Loses when sign bit of type field is set. */ #define XUNMARK(a) ((a) = (((a) << BITS_PER_INT-GCTYPEBITS-VALBITS) >> BITS_PER_INT-GCTYPEBITS-VALBITS)) #endif /* The symbol in the kernel where the load average is found is named _avenrun. At this time there are two major flavors of hp-ux (there is the s800 and s300 (s200) flavors). The differences are thusly moved to the corresponding machine description file. */ /* no underscore please */ #define LDAV_SYMBOL "avenrun" #if 0 /* Supposedly no longer true. */ /* In hpux, for unknown reasons, S_IFLNK is defined even though symbolic links do not exist. Make sure our conditionals based on S_IFLNK are not confused. Here we assume that stat.h is included before config.h so that we can override it here. */ #undef S_IFLNK #endif /* Define the BSTRING functions in terms of the sysV functions. */ /* On HPUX 8.05, including types.h can include strings.h which declares these as functions. Hence the #ifndef. */ #ifndef HAVE_BCOPY #define bcopy(a,b,s) memcpy (b,a,s) #define bzero(a,s) memset (a,0,s) #define bcmp memcmp #endif /* On USG systems these have different names. */ #define index strchr #define rindex strrchr /* Include the file bsdtty.h, since this machine has job control. */ #define NEED_BSDTTY emacs-19.30/src/m/hp9000s300.h100444 75424 13 14344 6045453762 13623 0ustar kwzhuser/* machine description file for hp9000 series 200 or 300 on either HPUX or BSD. Copyright (C) 1985 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START HP 9000 series 200 or 300 (-machine=hp9000s300) These machines are 68000-series CPUs running HP-UX (a derivative of sysV with some BSD features) or BSD 4.3 ported by Utah. If you're running HP-UX, specify `-opsystem=hpux'. If you're running BSD, specify `-opsystem=bsd4-3'. NOTE-END */ /* I don't understand why we have to do this at all! -JimB */ #if 0 /* Do this here at the top of the file; including sys/wait.h may include , which defines BIG_ENDIAN, which will conflict with our definition of BIG_ENDIAN if we do this at the bottom. */ #ifndef NOT_C_CODE #ifndef NO_SHORTNAMES #include #define WAITTYPE int #endif #define WRETCODE(w) (((w) >> 8) & 0377) #endif #endif /* Define NOMULTIPLEJOBS on versions of HPUX before 6.5. */ /* #define NOMULTIPLEJOBS */ /* Define this symbol if you are running a version of HP-UX which predates version 6.01 */ /* #define HPUX_5 */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #ifndef hp9000s300 #define hp9000s300 #endif /* 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 /* 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 */ /* For University of Utah 4.3bsd implementation on HP300s. The #ifndef __GNUC__ definitions are required for the "standard" cc, a very old, brain-dead version of PCC. */ #ifdef BSD4_3 /* Tell crt0.c that this is an ordinary 68020. */ #undef hp9000s300 #define m68000 #define CRT0_DUMMIES bogus_a6, #define HAVE_ALLOCA #ifndef __GNUC__ #define LIBS_DEBUG /* don't have -lg that works */ #define C_DEBUG_SWITCH /* don't support -g */ #endif #undef LOAD_AVE_TYPE #undef LOAD_AVE_CVT #define LOAD_AVE_TYPE long #define LOAD_AVE_CVT(x) ((int) (((double) (x)) / 2048.0 * 100.0)) #endif /* BSD4_3 */ #ifndef BSD4_3 /* The following definitions are for HPUX only. */ /* The symbol in the kernel where the load average is found is named _avenrun on this machine. */ #define LDAV_SYMBOL "_avenrun" /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) #ifdef __GNUC__ #define HAVE_ALLOCA #endif /* This library is needed with -g, on the 200/300 only. */ #if !defined(__GNUC__) || defined(__HPUX_ASM__) #define LIBS_DEBUG /usr/lib/end.o #endif /* Need a TEXT_START. On the HP9000/s300 that is 0. */ #ifdef __GNUC__ #define TEXT_START 0 #endif /* The symbol FIONREAD is defined, but the feature does not work on the 200/300. */ #define BROKEN_FIONREAD /* In older versions of hpux, for unknown reasons, S_IFLNK is defined even though symbolic links do not exist. Make sure our conditionals based on S_IFLNK are not confused. Here we assume that stat.h is included before config.h so that we can override it here. Version 6 of HP-UX has symbolic links. */ #ifdef HPUX_5 #undef S_IFLNK #endif /* Define the BSTRING functions in terms of the sysV functions. Version 6 of HP-UX supplies these in the BSD library, but that library has reported bugs in `signal'. */ /* #ifdef HPUX_5 */ #define bcopy(a,b,s) memcpy (b,a,s) #define bzero(a,s) memset (a,0,s) #define bcmp memcmp /* #endif */ /* On USG systems these have different names. Version 6 of HP-UX supplies these in the BSD library, which we currently want to avoid using. */ /* #ifdef HPUX_5 */ #define index strchr #define rindex strrchr /* #endif */ /* Define C_SWITCH_MACHINE to be +X if you want the s200/300 * Emacs to run on both 68010 and 68020 based hp-ux's. * * Define OLD_HP_ASSEMBLER if you have an ancient assembler * * Define HPUX_68010 if you are using the new assembler but * compiling for a s200 (upgraded) or s310. 68010 based * processor without 68881. */ /* These switches increase the size of some internal C compiler tables. They are required for compiling the X11 interface files. */ #ifndef HPUX_5 #ifndef __GNUC__ #define C_SWITCH_MACHINE -Wc,-Nd4000,-Ns3000 #endif #endif /* Define NEED_BSDTTY if you have such. */ #ifndef NOMULTIPLEJOBS #define NEED_BSDTTY #endif #endif /* not BSD4_3 */ emacs-19.30/src/m/i860.h100444 75424 13 6772 6045453764 12753 0ustar kwzhuser/* machine description file for i860. 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_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 */ #define INTEL860 /* 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 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 /* The X11 include files for i860-sysv4 need the macro SVR4 defined. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 8/9/94. */ #ifdef USG5_4 #ifndef SVR4 #define SVR4 #endif #endif emacs-19.30/src/m/ibm370aix.h100666 12120 1 1464 5673331276 14026 0ustar rmsdaemon/* m/ file for IBM 370 running AIX. */ #include "ibmps2-aix.h" #define AIX /* Include unistd.h, even though we don't define POSIX. */ #define NEED_UNISTD_H /* these were defined in "ibmps2-aix.h" */ #undef INTEL386 #undef aix386 /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN #undef TEXT_START #undef SEGMENT_MASK #undef DATA_SECTION_ALIGNMENT #define TEXT_START 0 #define SEGMENT_MASK 0 #define DATA_SECTION_ALIGNMENT 0x00001000 #undef LOAD_AVE_CVT #undef LOAD_AVE_TYPE /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_CVT(x) (int)(((double) (x)) * 100.0 / 1.0) #define LOAD_AVE_TYPE double #undef LIBS_MACHINE #define LIBS_MACHINE #undef HAVE_VFORK #undef LD_SWITCH_MACHINE #define LD_SWITCH_MACHINE -xa emacs-19.30/src/m/ibmps2-aix.h100444 75424 13 15616 6045453770 14252 0ustar kwzhuser/* machine description file for ibm ps/2 aix386. Copyright (C) 1989 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Use -opsystem=usg5-3 on AIX 1.2. -opsystem=usg5-2-2 should work on either AIX 1.1 or 1.2, but may not work with certain new X window managers, and may be suboptimal. NOTE-END */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_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 */ #define INTEL386 #define aix386 #define IBMAIX /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* crt0.c, if it is used, should use the i386-bsd style of entry. with no extra dummy args. On USG and XENIX, NO_REMAP says this isn't used. */ #define CRT0_DUMMIES bogus_fp, /* crt0.c should define a symbol `start' and do .globl with a dot. */ #define DOT_GLOBAL_START /* USG systems do not actually support the load average, so disable it for them. */ /* 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 addresses, macros, change some setup for dump */ #define NO_REMAP #undef static /* Since NO_REMAP, problem with statics doesn't exist */ #ifdef USG5_3 #define TEXT_START 0x00000000 #else #define TEXT_START 0x00400000 #define TEXT_END 0 #define DATA_START 0x00800000 #define DATA_END 0 /* The data segment in this machine always starts at address 0x00800000. An address of data cannot be stored correctly in a Lisp object; we always lose the high bits. We must tell XPNTR to add them back. */ #define DATA_SEG_BITS 0x00800000 #endif #if 0 /* I refuse to promulgate a recommendation that would make users unable to debug - RMS. */ /* delete the following line to foil optimization, enable debugging */ #define C_DEBUG_SWITCH -O #endif #define BSTRING #define HAVE_VFORK #undef HAVE_TERMIO #define HAVE_TERMIOS /* Send signals to subprocesses by "typing" special chars at them. */ #define SIGNALS_VIA_CHARACTERS /* * Define SYSV_SYSTEM_DIR to use the V.3 getdents/readir * library functions. Almost, but not quite the same as * the 4.2 functions */ #define SYSV_SYSTEM_DIR /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ #undef NONSYSTEM_DIR_LIBRARY /* AIX utimes allegedly causes SIGSEGV. */ #undef HAVE_UTIMES /* override configuration decision */ /* AIX defines FIONREAD, but it does not work. */ #define BROKEN_FIONREAD /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE long /* For AIX (sysV) */ /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) (int) (((double) (x)/65535.0) * 100.0) /* This page was added in June 1990. It may be incorrect for some versions of aix, so delete it if it causes trouble. */ /* AIX has sigsetmask() */ #undef sigsetmask /* AIX386 has BSD4.3 PTYs */ #define HAVE_PTYS /* AIX has IPC. It also has sockets, and either can be used for client/server. I would suggest the client/server code be changed to use HAVE_SOCKETS rather than BSD as the conditional if sockets provide any advantages. */ #define HAVE_SYSVIPC /* AIX has sockets */ #define HAVE_SOCKETS /* #define SKTPAIR */ /* SKTPAIR works, but what is advantage over pipes? */ /* Specify the font for X to use. */ #define X_DEFAULT_FONT "8x13" /* AIX has a wait.h. */ #define HAVE_WAIT_HEADER /* sioctl.h should not be included, says bytheway@cs.utah.edu. */ #undef NEED_SIOCTL /* I'm guessing that that means it doesn't want ptem.h either. */ #undef NEED_PTEM_H /* aix has `union wait' */ #define HAVE_UNION_WAIT /* Here override various assumptions in ymakefile */ /* 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. */ #ifdef __GNUC__ #define HAVE_ALLOCA #define alloca(n) __builtin_alloca(n) #if __GNUC__ < 2 #define LIB_STANDARD /usr/local/lib/gcc-gnulib -lbsd -lrts -lc #endif /* -g fails to work, so it is omitted. */ /* tranle says that -fstrength-reduce does not help. */ #define C_DEBUG_SWITCH #else #define C_ALLOCA #define STACK_DIRECTION -1 /* tell alloca.c which way it grows */ #define LIBS_MACHINE -lbsd -lrts #endif #define OBJECTS_MACHINE hftctl.o #define LD_SWITCH_MACHINE -T0x00400000 -K -e start #define LIBS_DEBUG /* no -lg on aix ps/2 */ #ifdef USG5_3 #define XICCC #define HAVE_GETWD #undef LD_SWITCH_MACHINE #define LD_SWITCH_MACHINE -T0x0 -K -e start /* Things defined in s-usg5-3.h that need to be overridden. */ #undef NOMULTIPLEJOBS #undef BROKEN_TIOCGETC #undef BROKEN_TIOCGWINSZ #undef LIBX10_SYSTEM #undef LIBX11_SYSTEM #undef LIB_X11_LIB #endif /* Shared libraries are supported in a patch release of ps/2 1.2.1. If the system has them, the user can turn them on, and this code will make them work. */ #define USG_SHARED_LIBRARIES /* Assume that by 19's release everyone has this. */ #ifdef USG_SHARED_LIBRARIES #define ORDINARY_LINK #undef LIB_STANDARD #undef LD_SWITCH_MACHINE #if __GNUC__ > 1 #define LD_SWITCH_MACHINE -shlib #endif #endif emacs-19.30/src/m/ibmrs6000.h100444 75424 13 12410 6045453773 13711 0ustar kwzhuser/* R2 AIX machine/system dependent defines Copyright (C) 1988 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="aix3-1" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #ifdef USG5_4 #undef WORDS_BIG_ENDIAN #else #define WORDS_BIG_ENDIAN #endif /* 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 /* Now define a symbol for the cpu type, if your compiler does not define it automatically. */ #define IBMR2AIX /* Use type int rather than a union, to represent Lisp_Object */ /* This is desirable for most machines. */ #define NO_UNION_TYPE /* 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. */ #ifdef USG5_4 #define CANNOT_DUMP #endif #ifndef UNEXEC #define UNEXEC unexaix.o #endif /* Define addresses, macros, change some setup for dump */ #define NO_REMAP #ifndef USG5_4 #define TEXT_START 0x10000000 #define TEXT_END 0 #define DATA_START 0x20000000 #define DATA_END 0 #endif /* The data segment in this machine always starts at address 0x20000000. An address of data cannot be stored correctly in a Lisp object; we always lose the high bits. We must tell XPNTR to add them back. */ #ifndef USG5_4 #define DATA_SEG_BITS 0x20000000 #else #define DATA_SEG_BITS 0 #endif #ifdef CANNOT_DUMP /* Define shared memory segment symbols */ #define PURE_SEG_BITS 0x30000000 /* Use shared memory. */ /* This is turned off because it does not always work. See etc/AIX.DUMP. */ /* #define HAVE_SHM */ #define SHMKEY 5305035 /* used for shared memory code segments */ #endif /* CANNOT_DUMP */ #define N_BADMAG(x) BADMAG(x) #define N_TXTOFF(x) A_TEXTPOS(x) #define N_SYMOFF(x) A_SYMPOS(x) #define A_TEXT_OFFSET(HDR) sizeof(HDR) /* #define ADJUST_EXEC_HEADER \ unexec_text_start += sizeof(hdr); \ unexec_data_start = ohdr.a_dbase */ #undef ADDR_CORRECT #define ADDR_CORRECT(x) ((int)(x)) /* 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. */ /* Note: aix3-2.h defines HAVE_ALLOCA; aix3-1.h doesn't. */ #ifndef HAVE_ALLOCA #define C_ALLOCA #define STACK_DIRECTION -1 /* tell alloca.c which way it grows */ #endif /* Specify the font for X to use. This used to be Rom14.500; that's nice on the X server shipped with the RS/6000, but it's not available on other servers. */ #define X_DEFAULT_FONT "fixed" /* Here override various assumptions in ymakefile */ #ifdef AIXHFT #define OBJECTS_MACHINE hftctl.o #endif #ifndef USG5_4 #define C_SWITCH_MACHINE -D_BSD #endif #ifdef AIX3_2 /* -lpthreads seems to be necessary for Xlib in X11R6, and should be harmless on older versions of X where it happens to exist. */ #ifdef HAVE_LIBPTHREADS #define LIBS_MACHINE -lrts -lIM -liconv -lpthreads #else /* IBM's X11R5 use -lIM and -liconv in AIX 3.2.2. */ #define LIBS_MACHINE -lrts -lIM -liconv #endif #else #ifdef USG5_4 #define LIBS_MACHINE #else #define LIBS_MACHINE -lIM #endif #endif #define START_FILES #define HAVE_SYSVIPC #define HAVE_GETWD /*** BUILD 9008 - FIONREAD problem still exists in X-Windows. ***/ #define BROKEN_FIONREAD /* Don't try to include sioctl.h or ptem.h. */ #undef NEED_SIOCTL #undef NEED_PTEM_H #define ORDINARY_LINK #ifndef USG5_4 /* sfreed@unm.edu says add -bI:/usr/lpp/X11/bin/smt.exp for AIX 3.2.4. */ /* marc@sti.com (Marc Pawliger) says ibmrs6000.inp is needed to avoid linker error for updated X11R5 libraries, which references pthread library which most machines don't have. We use the name .inp instead of .imp because .inp is a better convention to use in make-dist for naming random input files. */ #ifdef AIX4 #define LD_SWITCH_MACHINE -Wl,-bnodelcsect #else /* not AIX4 */ #ifdef HAVE_AIX_SMT_EXP #define LD_SWITCH_MACHINE -Wl,-bnso,-bnodelcsect,-bI:/lib/syscalls.exp,-bI:$(srcdir)/m/ibmrs6000.inp,-bI:/usr/lpp/X11/bin/smt.exp #else #define LD_SWITCH_MACHINE -Wl,-bnso,-bnodelcsect,-bI:/lib/syscalls.exp,-bI:$(srcdir)/m/ibmrs6000.inp #endif #endif /* not AIX4 */ /* AIX supposedly doesn't use this interface, but on the RS/6000 it apparently does. */ #define NLIST_STRUCT #endif /* USG5_4 */ emacs-19.30/src/m/ibmrt-aix.h100444 75424 13 12660 6045453776 14175 0ustar kwzhuser/* RTPC AIX machine/system dependent defines Copyright (C) 1988 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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 /* Now define a symbol for the cpu type, if your compiler does not define it automatically. */ #ifndef IBMAIX #define IBMAIX #endif /* Use type int rather than a union, to represent Lisp_Object */ /* This is desirable for most machines. */ #define NO_UNION_TYPE /* No load average information appears in the AIX kernel. VRM has this info, and if anyone desires they should fix fns.c to get it out of VRM */ /* 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 addresses, macros, change some setup for dump */ #undef COFF #define NO_REMAP #undef static /* Since NO_REMAP, problem with statics doesn't exist */ #define TEXT_START 0x10000000 #define TEXT_END 0 #define DATA_START 0x20000000 #define DATA_END 0 /* The data segment in this machine always starts at address 0x20000000. An address of data cannot be stored correctly in a Lisp object; we always lose the high bits. We must tell XPNTR to add them back. */ #define DATA_SEG_BITS 0x20000000 #define N_BADMAG(x) BADMAG(x) #define N_TXTOFF(x) A_TEXTPOS(x) #define N_SYMOFF(x) A_SYMPOS(x) #define A_TEXT_OFFSET(HDR) sizeof(HDR) #define ADJUST_EXEC_HEADER \ unexec_text_start += sizeof(hdr); \ unexec_data_start = ohdr.a_dbase #undef ADDR_CORRECT #define ADDR_CORRECT(x) ((int)(x)) /* This is the offset of the executable's text, from the start of the file. */ #define A_TEXT_SEEK(HDR) (N_TXTOFF (hdr) + sizeof (hdr)) /* 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 STACK_DIRECTION -1 /* tell alloca.c which way it grows */ /* AIX has PTYs, so define here, along with macros needed to make them work. */ #define HAVE_PTYS #define PTY_ITERATION for (i=0; i<256; i++) #define PTY_NAME_SPRINTF sprintf (ptyname, "/dev/ptc%d", i); #define PTY_TTY_NAME_SPRINTF \ { /* Check that server side not already open */ \ if ((ioctl (*ptyv, PTYSTATUS, 0) & 0xFFFF) != 0) \ { \ close (*ptyv); \ continue; \ } \ /* And finally to be sure we can open it later */ \ sprintf (ptyname, "/dev/pts%d", i); \ signal (SIGHUP,SIG_IGN); \ } /* ignore hangup at process end */ /* TIOCNOTTY doesn't occur on AIX, but the rest of the conditionalized code in process.c does the right thing if we fake this out. */ #define TIOCNOTTY IOCTYPE /* AIX has IPC. It also has sockets, and either can be used for client/server. I would suggest the client/server code be changed to use HAVE_SOCKETS rather than BSD as the conditional if sockets provide any advantages. */ #define HAVE_SYSVIPC /* AIX has sockets */ #define HAVE_SOCKETS /* #define SKTPAIR */ /* SKTPAIR works, but what is advantage over pipes? */ /* Specify the font for X to use. */ #define X_DEFAULT_FONT "Rom14.500" /* Here override various assumptions in ymakefile */ /* On AIX 2.2.1, use these definitions instead #define C_SWITCH_MACHINE -I/usr/include -Nn2000 #define LIBS_MACHINE -lX -lrts */ #define C_SWITCH_MACHINE -I/usr/include -I/usr/include/bsd -Nn2000 #define LIBS_MACHINE -lXMenu -lX -lsock -lbsd -lrts #define OBJECTS_MACHINE hftctl.o #define START_FILES /lib/crt0.o /* -lXMenu, -lX must precede -lsock, -lbsd */ #define LD_SWITCH_MACHINE -n -T0x10000000 -K -e start #if 0 /* I refuse to promulgate a recommendation that would make users unable to debug - RMS. */ /* delete the following line to foil optimization, enable debugging */ #define C_DEBUG_SWITCH -O #endif /* Setup to do some things BSD way - these won't work previous to AIX 2.1.2 */ #include #define BSTRING #define HAVE_GETTIMEOFDAY #define HAVE_VFORK /* AIX utimes allegedly causes SIGSEGV. */ #undef HAVE_UTIMES /* override configuration decision */ /* AIX defines FIONREAD, but it does not work. */ #define BROKEN_FIONREAD /* rocky@watson.ibm.com says this is needed. */ #define HAVE_FTIME emacs-19.30/src/m/ibmrt.h100444 75424 13 7745 6045454000 13363 0ustar kwzhuser/* RTPC machine dependent defines Copyright (C) 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #define ibmrt #define romp /* unfortunately old include files are hanging around. */ /* 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 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 double /* For AIS (sysV) */ /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0) /* 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. */ #undef 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 HAVE_ALLOCA /* The data segment in this machine starts at a fixed address. An address of data cannot be stored correctly in a Lisp object; we always lose the high bits. We must tell XPNTR to add them back. */ #define DATA_SEG_BITS 0x10000000 #define DATA_START 0x10000000 /* The text segment always starts at a fixed address. This way we don't need to have a label _start defined. */ #define TEXT_START 0 /* Taking a pointer to a char casting it as int pointer */ /* and then taking the int which the int pointer points to */ /* is practically guaranteed to give erroneous results */ #define NEED_ERRNO #define SKTPAIR /* BSD has BSTRING. */ #define BSTRING /* Special switches to give the C compiler. */ #ifndef __GNUC__ #define C_SWITCH_MACHINE -Dalloca=_Alloca #endif /* Don't attempt to relabel some of the data as text when dumping. It does not work because their virtual addresses are not consecutive. This enables us to use the standard crt0.o. */ #define NO_REMAP /* Use the bitmap files that come with Emacs. */ #define EMACS_BITMAP_FILES emacs-19.30/src/m/intel386.h100444 75424 13 15072 6045327772 13651 0ustar kwzhuser/* Machine description file for intel 386. Copyright (C) 1987 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Intel 386 (-machine=intel386 or -machine=is386.h) The possibilities for -opsystem are: bsd4-2, usg5-2-2, usg5-3, isc2-2, 386-ix, esix, linux, sco3.2v4, and xenix. 18.58 should support a wide variety of operating systems. Use isc2-2 for Interactive 386/ix version 2.2. Use 386ix for prior versions. Use esix for Esix. Use linux for Linux. It isn't clear what to do on an SCO system. -machine=is386 is used for an Integrated Solutions 386 machine. It may also be correct for Microport systems. Cubix QBx/386 (-machine=intel386 -opsystem=usg5-3) Changes merged in 19.1. Systems before 2/A/0 may fail to compile etags.c due to a compiler bug. Prime EXL (-machine=intel386 -opsystem=usg5-3) Minor changes merged in 19.1. NOTE-END */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_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 */ #define INTEL386 /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* crt0.c, if it is used, should use the i386-bsd style of entry. with no extra dummy args. On USG and XENIX, NO_REMAP says this isn't used. */ #define CRT0_DUMMIES bogus_fp, /* crt0.c should define a symbol `start' and do .globl with a dot. */ #define DOT_GLOBAL_START #ifdef XENIX /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE short /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) (((double) (x)) * 100.0 / FSCALE) #define FSCALE 256.0 /* determined by experimentation... */ #endif #ifdef SOLARIS2 /* 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 */ /* This is totally uncalibrated. */ #define LOAD_AVE_CVT(x) ((int) (((double) (x)) * 100.0 / FSCALE)) /* J.W.Hawtin@lut.ac.uk say Solaris 2.4 as well as Solaris 2.1 on X86 requires -lkvm as well */ #define LIBS_MACHINE -lkvm #ifndef SOLARIS2_4 /* J.W.hawtin@lut.ac.uk says Solaris 2.1 on the X86 has FSCALE defined in a system header. */ #define HAVE_VFORK #else /* SOLARIS2_4 */ #ifndef __GNUC__ #if 0 /* wisner@gryphon.com says this screws up cpp */ #define C_SWITCH_MACHINE -Xa #endif #ifndef NOT_C_CODE #ifdef HAVE_ALLOCA_H #include #endif /* HAVE_ALLOCA_H */ #endif /* not NOT_C_CODE */ #endif /* not __GNUC__ */ #endif /* SOLARIS2_4 */ /* configure thinks solaris X86 has gethostname, but it does not work, so undefine it. */ #undef HAVE_GETHOSTNAME #else /* not SOLARIS2 */ #ifdef USG5_4 /* Older USG systems do not support the load average. */ /* 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 */ /* This is totally uncalibrated. */ #define LOAD_AVE_CVT(x) ((int) (((double) (x)) * 100.0 / FSCALE)) #define FSCALE 256.0 #endif #endif /* not SOLARIS2 */ /* 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 */ #ifdef XENIX /* 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 #define STACK_DIRECTION -1 /* Since cannot purify, use standard Xenix 386 startup code. */ #define START_FILES /lib/386/Sseg.o pre-crt0.o /lib/386/Scrt0.o /* These really use terminfo. */ #define LIBS_TERMCAP /lib/386/Slibcurses.a \ /lib/386/Slibtinfo.a /lib/386/Slibx.a /* Standard libraries for this machine. Since `-l' doesn't work in `ld'. */ /* '__fltused' is unresolved w/o Slibcfp.a */ #define LIB_STANDARD /lib/386/Slibcfp.a /lib/386/Slibc.a #else /* not XENIX */ /* this brings in alloca() if we're using cc */ #ifdef USG #ifndef LIB_STANDARD #ifdef USG5_4 #define LIB_STANDARD -lc #else /* not USG5_4 */ #define LIB_STANDARD -lPW -lc #endif /* not USG5_4 */ #endif /* LIB_STANDARD */ #define HAVE_ALLOCA #define NO_REMAP #define TEXT_START 0 #endif /* USG */ #endif /* not XENIX */ #ifdef BSD #define HAVE_ALLOCA #endif /* BSD */ /* If compiling with GCC, let GCC implement alloca. */ #if defined(__GNUC__) && !defined(alloca) #define alloca(n) __builtin_alloca(n) #define HAVE_ALLOCA #endif #ifdef USG5_4 #define DATA_SEG_BITS 0x08000000 #endif #ifdef MSDOS #define NO_REMAP #endif #ifdef WINDOWSNT #define VIRT_ADDR_VARIES #define DATA_END get_data_end () #define DATA_START get_data_start () #define HAVE_ALLOCA #define NO_ARG_ARRAY #endif #ifdef linux /* libc-linux/sysdeps/linux/i386/ulimit.c says that due to shared library, */ /* we cannot get the maximum address for brk */ #define ULIMIT_BREAK_VALUE (32*1024*1024) #define SEGMENT_MASK ((SEGMENT_SIZE)-1) #endif emacs-19.30/src/m/iris4d.h100444 75424 13 13233 6045330026 13452 0ustar kwzhuser/* machine description file for Iris-4D machines. Use with s/irix*.h. Copyright (C) 1987 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. */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #undef 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 */ #ifndef mips #define mips #endif #ifndef IRIS_4D #define IRIS_4D #endif /* 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 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 /* jg@genmagic.genmagic.com (John Giannandrea) says this is unnecessary. */ #if 0 /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE long /* This doesn't quite work on the 4D */ /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) (int)(((double)(x)*100)/1024.0) /* s-iris3-6.h uses /vmunix */ #undef KERNEL_FILE #define KERNEL_FILE "/unix" #endif /* 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. */ #undef 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 */ /* Sjoerd.Mullender@cwi.nl says no need. */ /* #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 /* This machine requires completely different unexec code which lives in a separate file. Specify the file name. */ #ifdef USG5_4 #undef UNEXEC #define UNEXEC unexelfsgi.o #else #define UNEXEC unexmips.o #endif #define TEXT_START 0x400000 /* * DATA_SEG_BITS forces extra bits to be or'd in with any pointers which * were stored in a Lisp_Object (as Emacs uses fewer than 32 bits for * the value field of a LISP_OBJECT). */ #define DATA_START 0x10000000 #define DATA_SEG_BITS 0x10000000 #undef LIBS_MACHINE /* -lsun in case using Yellow Pages for passwords. */ #define LIBS_MACHINE -lmld #define LIBS_DEBUG /* Define this if you have a fairly recent system, in which crt1.o and crt1.n should be used. */ #define HAVE_CRTN #ifndef USG5_4 #ifdef HAVE_CRTN /* Must define START-FILES so that the linker can find /usr/lib/crt0.o. */ #define START_FILES pre-crt0.o /usr/lib/crt1.o #define LIB_STANDARD -lc /usr/lib/crtn.o #else #define START_FILES pre-crt0.o /usr/lib/crt0.o /* The entry-point label (start of text segment) is `start', not `__start'. */ #define DEFAULT_ENTRY_ADDRESS start #define LIB_STANDARD -lc #endif #endif /* Use terminfo instead of termcap. */ #define TERMINFO /* Letter to use in finding device name of first pty, if system supports pty's. 'a' means it is /dev/ptya0 */ #undef FIRST_PTY_LETTER #define FIRST_PTY_LETTER 'q' /* Define STACK_DIRECTION for alloca.c */ #undef STACK_DIRECTION #define STACK_DIRECTION -1 /* The standard definitions of these macros would work ok, but these are faster because the constants are short. */ #define XUINT(a) (((unsigned)(a) << BITS_PER_INT-VALBITS) >> BITS_PER_INT-VALBITS) #define XSET(var, type, ptr) \ ((var) = ((int)(type) << VALBITS) + (((unsigned) (ptr) << BITS_PER_INT-VALBITS) >> BITS_PER_INT-VALBITS)) #define XMARKBIT(a) ((a) < 0) #define XSETMARKBIT(a,b) ((a) = ((a) & ~MARKBIT) | ((b) ? MARKBIT : 0)) #define XUNMARK(a) ((a) = (((unsigned)(a) << BITS_PER_INT-GCTYPEBITS-VALBITS) >> BITS_PER_INT-GCTYPEBITS-VALBITS)) #ifndef __GNUC__ /* Turn off some "helpful" error checks for type mismatches that we can't fix without breaking other machines. */ #ifdef IRIX_FORCE_32_BITS #define C_SWITCH_MACHINE -32 #endif #endif /* not __GNUC__ */ emacs-19.30/src/m/iris5d.h100444 75424 13 13200 6045330055 13447 0ustar kwzhuser/* machine description file for Iris-4D machines. Use with s-iris3-6.h Copyright (C) 1987 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="irix3-3" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #undef 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 */ #ifndef mips #define mips #endif #ifndef IRIS_4D #define IRIS_4D #endif /* 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 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 /* This doesn't quite work on the 4D */ /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) (int)(((double)(x)*100)/1024.0) /* s-iris3-6.h uses /vmunix */ #undef KERNEL_FILE #define KERNEL_FILE "/unix" /* 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. */ #undef 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 /* This machine requires completely different unexec code which lives in a separate file. Specify the file name. */ #ifdef UNEXEC #undef UNEXEC #endif #define UNEXEC unexelfsgi.o #define TEXT_START 0x400000 /* * DATA_SEG_BITS forces extra bits to be or'd in with any pointers which * were stored in a Lisp_Object (as Emacs uses fewer than 32 bits for * the value field of a LISP_OBJECT). */ #define DATA_START 0x10000000 #define DATA_SEG_BITS 0x10000000 #undef LIBS_MACHINE /* -lsun in case using Yellow Pages for passwords. */ #define LIBS_MACHINE -lsun -lmld #define LIBS_DEBUG /* Define this if you have a fairly recent system, in which crt1.o and crt1.n should be used. */ #define HAVE_CRTN #ifdef HAVE_CRTN /* Must define START-FILES so that the linker can find /usr/lib/crt0.o. */ #define START_FILES pre-crt0.o /usr/lib/crt1.o #define LIB_STANDARD -lbsd -lc /usr/lib/crtn.o #else #define START_FILES pre-crt0.o /usr/lib/crt0.o /* The entry-point label (start of text segment) is `start', not `__start'. */ #define DEFAULT_ENTRY_ADDRESS start #define LIB_STANDARD -lbsd -lc #endif /* Use terminfo instead of termcap. */ #define TERMINFO /* sioctl.h should be included where appropriate. */ #define NEED_SIOCTL /* Letter to use in finding device name of first pty, if system supports pty's. 'a' means it is /dev/ptya0 */ #undef FIRST_PTY_LETTER #define FIRST_PTY_LETTER 'q' /* Define STACK_DIRECTION for alloca.c */ #define STACK_DIRECTION -1 /* The standard definitions of these macros would work ok, but these are faster because the constants are short. */ #define XUINT(a) (((unsigned)(a) << BITS_PER_INT-VALBITS) >> BITS_PER_INT-VALBITS) #define XSET(var, type, ptr) \ ((var) = ((int)(type) << VALBITS) + (((unsigned) (ptr) << BITS_PER_INT-VALBITS) >> BITS_PER_INT-VALBITS)) #define XMARKBIT(a) ((a) < 0) #define XSETMARKBIT(a,b) ((a) = ((a) & ~MARKBIT) | ((b) ? MARKBIT : 0)) #define XUNMARK(a) ((a) = (((unsigned)(a) << BITS_PER_INT-GCTYPEBITS-VALBITS) >> BITS_PER_INT-GCTYPEBITS-VALBITS)) #ifndef __GNUC__ /* Turn off some "helpful" error checks for type mismatches that we can't fix without breaking other machines. */ #define C_SWITCH_MACHINE -cckr #endif emacs-19.30/src/m/irist.h100444 75424 13 11630 6045454001 13405 0ustar kwzhuser/* machine description file for Silicon Graphics Iris 2500 Turbos; also possibly for non-turbo Irises with system release 2.5. 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Version 18 said to work; use -opsystem=irist3-5 for system version 2.5 and -opsystem=iris3-6 for system versions 3.6 and up. NOTE-END */ #if 0 Message-Id: <8705050653.AA20004@orville.arpa> Subject: gnu emacs 18.41 on iris [23].5 machines Date: 04 May 87 23:53:11 PDT (Mon) From: raible@orville.arpa Aside from the SIGIOT, I know of only one bug, a real strange one: I wrote a utimes interface, which copies elements from timevals to utimbufs. This code is known good. The problem is that in emacs, the utime doesn't seem to take effect (i.e. doesn't change the dates at all) unless I call report_file_error *after* the utime returns! if (utime (name, &utb) < 0) return; else /* XXX XXX XXX */ /* For some reason, if this is taken out, then the utime above breaks! */ /* (i.e. it doesn't set the time. This just makes no sense... */ /* Eric - May 4, 1987 */ report_file_error ("Worked just find\n", Qnil); Without any sort of debugger that works on emacs (I know... but I don't have *time* right now to start with gdb), it was quite time consuming to track it down to this. But since this code is only used for an optional 4th argument to one command (copy-file), it would say that it is non-critical... #endif /* 0 */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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 */ #ifndef m68000 #define m68000 #endif /* 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 1.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 */ /* There is an inconsistency between the sgi assembler, linker which barfs on these. */ #define internal_with_output_to_temp_buffer stupid_long_name1 #define Finsert_abbrev_table_description stupid_long_name2 emacs-19.30/src/m/is386.h100444 13437 1 1463 5122176144 13312 0ustar jimbdaemon/* machine description file for Integrated Solutions 386 machine. */ #include "intel386.h" /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Intel 386 (-machine=intel386 or -machine=is386.h) The possibilities for -opsystem are: bsd4-2, usg5-2-2, usg5-3, isc2-2, 386-ix, esix, or xenix. 18.58 should support a wide variety of operating systems. Use isc2-2 for Interactive 386/ix version 2.2. Use 386ix for prior versions. Use esix for Esix. It isn't clear what to do on an SCO system. -machine=is386 is used for an Integrated Solutions 386 machine. It may also be correct for Microport systems. NOTE-END */ #define LIBX10_MACHINE -lnsl_s #define LIBX11_MACHINE -lnsl_s #define LIBS_DEBUG -lg emacs-19.30/src/m/isi-ov.h100444 75424 13 4555 6045454004 13454 0ustar kwzhuser/* machine description file for ISI 68000's 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Use `-opsystem=bsd4-2' or `-opsystem=bsd4-3'. NOTE-END */ #define ISI68K /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* Say this machine is a 68000 */ #define m68000 /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* XINT must explicitly sign-extend */ #define EXPLICIT_SIGN_EXTEND /* Data type of load average, as read out of kmem. */ #ifdef BSD4_3 #define LOAD_AVE_TYPE long #else #define LOAD_AVE_TYPE double #endif BSD4_3 /* Convert that into an integer that is 100 for a load average of 1.0 */ #ifdef BSD4_3 #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) #else #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) #endif /* Mask for address bits within a memory segment */ #define SEGMENT_MASK 0x1ffff /* use the -20 switch to get the 68020 code */ /* #define C_SWITCH_MACHINE -20 */ /* Use the version of the library for the 68020 because the standard library requires some special hacks in crt0 which the GNU crt0 does not have. */ #define LIB_STANDARD -lmc /* macros to make unexec work right */ #define A_TEXT_OFFSET(HDR) sizeof(HDR) #define A_TEXT_SEEK(HDR) sizeof(HDR) /* A few changes for the newer systems. */ #ifdef BSD4_3 #define HAVE_ALLOCA /* The following line affects crt0.c. */ #undef m68k #undef LIB_STANDARD #define LIB_STANDARD -lmc -lc #define C_DEBUG_SWITCH -20 -O -X23 #endif emacs-19.30/src/m/m68k.h100444 12120 1 5077 6045360741 13077 0ustar rmsdaemon/* Machine description file for generic Motorola 68k. Copyright (C) 1985, 1995 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. */ /* The following three symbols give information on the size of various data types. */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #ifndef m68k #define m68k #endif /* 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 /* 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 */ #ifdef linux #ifdef __ELF__ #define DATA_SEG_BITS 0x80000000 #endif #define NO_REMAP #define TEXT_START 0 #endif /* If compiling with GCC, let GCC implement alloca. */ #if defined(__GNUC__) && !defined(alloca) #define alloca(n) __builtin_alloca(n) #define HAVE_ALLOCA #endif emacs-19.30/src/m/masscomp.h100444 75424 13 10501 6045454007 14077 0ustar kwzhuser/* machine description file for Masscomp 5000 series running RTU, ucb universe. Copyright (C) 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="rtu" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #undef NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #undef WORD_MACHINE /* Now define a symbol for the cpu type, if your compiler does not define it automatically: vax, m68000, ns16000, pyramid, orion, tahoe and APOLLO are the ones defined so far. */ /* Masscomp predefines mc68000. */ #define m68000 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. */ #undef EXPLICIT_SIGN_EXTEND /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) /* 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. */ #undef 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. */ #undef 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. */ /* On return from a subroutine, the 68020 compiler restores old contents of register variables relative to sp, so alloca() screws up such routines. The following definitions should work on all Masscomps. On the MC-5500 (a 68000) one can #undef C_ALLOCA and #define HAVE_ALLOCA. */ #ifdef mc500 #undef C_ALLOCA #define HAVE_ALLOCA #else #define C_ALLOCA #undef HAVE_ALLOCA #endif /* 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. */ #undef NO_REMAP /* crt0.c should use the vax-bsd style of entry, with a dummy arg. */ #define CRT0_DUMMIES bogus_fp, /* Name of file the to look in for the kernel symbol table (for load average) */ #define KERNEL_FILE "/unix" /* This triggers some stuff to avoid a compiler bug */ #define MASSC_REGISTER_BUG /* Prevent -lg from being used for debugging. Not implemented? */ #define LIBS_DEBUG /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIO /* Adjust a header field for the executable file about to be dumped. */ #define ADJUST_EXEC_HEADER \ hdr.a_stamp = STAMP13; /* really want the latest stamp, whatever it is */ emacs-19.30/src/m/mega68.h100444 75424 13 2716 6045454011 13330 0ustar kwzhuser/* machine description file for Megatest 68000's. Copyright (C) 1985 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* XINT must explicitly sign-extend */ #define EXPLICIT_SIGN_EXTEND /* Say this machine is a 68000 */ #define m68000 /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) emacs-19.30/src/m/mg1.h100444 75424 13 10363 6045454013 12744 0ustar kwzhuser/* machine description file for Whitechapel Computer Works MG1 (ns16000 based). Copyright (C) 1985 Free Software Foundation, Inc. MG-1 version by L.M.McLoughlin 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START We are in the dark about what operating system runs on the Whitechapel systems. Consult share-lib/MACHINES for information on which operating systems Emacs has already been ported to; one of them might work. If you find an existing system name that works or write your own configuration files, please let the Free Software Foundation in on your work; we'd like to distribute this information. NOTE-END */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_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. */ /* ns16000 call sequence used on mg1 means that &arg = the args as an array */ #undef NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* ns16000 addresses are byte addresses */ #undef WORD_MACHINE /* Now define a symbol for the cpu type, if your compiler does not define it automatically: vax, m68000, ns16000, pyramid, orion, tahoe and APOLLO are the ones defined so far. */ /* Say this machine is a 16000 and an mg1, cpp says its a 32000 */ #define ns16000 #define mg1 /* Use type int rather than a union, to represent Lisp_Object */ /* This is desirable for most machines. */ /* Not sure on mg-1 but this shouldn't hurt! */ #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. */ /* mg1 its an unsigned long */ #define LOAD_AVE_TYPE unsigned 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. */ /* ns16000's have an unexec, so should the mg-1 */ #undef 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. */ /* hmmmm... not sure. copied sequent.h */ #undef 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. */ /* hmmmm... again not sure. so copied sequent.h again! */ #undef C_ALLOCA #undef 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. */ /* mapping seems screwy */ #define NO_REMAP /* Avoids a compiler bug */ /* borrowed from sequent.h */ emacs-19.30/src/m/mips-siemens.h100444 75424 13 13025 6045330122 14661 0ustar kwzhuser/* m- file for Mips machines. Copyright (C) 1987, 1992, 1993, 1995 Free Software Foundation, Inc. This file contains some changes for our SVR4 based SINIX-Mips 5.4. I hope this is helpful to port the emacs to our RM?00 series and maybe to the DC/OSx (Mips-based) machines of Pyramid Inc. (Marco.Walther@mch.sni.de) 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Use m-mips4.h for RISCOS version 4; use s-bsd4-3.h with the BSD world. Note that the proper m- file for the Decstation is m-pmax.h. This is the m- file for SNI RM*00 machines. Use s- sinix5-4.h file! With this the file mips-siemens.h is obsolete. NOTE-END */ /* 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. */ #undef WORD_MACHINE /* Define how to take a char and sign-extend into an int. On machines where char is signed, this is a no-op. */ #define SIGN_EXTEND_CHAR(c) ((signed char)(c)) /* 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 */ #ifndef mips # define mips #endif /* 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 LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / 256.0) /* CDC EP/IX 1.4.3 uses /unix */ #undef KERNEL_FILE #define KERNEL_FILE "/unix" /* 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. */ #undef 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. */ #ifdef __GNUC__ #define HAVE_ALLOCA #else #define C_ALLOCA #endif /* 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 /* Describe layout of the address space in an executing process. */ /* MARCO ??? */ #define TEXT_START 0x400000 /* #define DATA_START 0x10000000 #define DATA_SEG_BITS 0x10000000 */ #ifdef UNEXEC #undef UNEXEC #endif #define UNEXEC unexelfsni.o #undef ORDINARY_LINK #undef LIBS_DEBUG /* Alter some of the options used when linking. */ #define LIBS_MACHINE -lmld #define START_FILES pre-crt0.o /usr/ccs/lib/crt1.o /usr/ccs/lib/crti.o /usr/ccs/lib/values-Xt.o #ifdef LIB_STANDARD #undef LIB_STANDARD #endif #define LIB_STANDARD -lc /usr/ccs/lib/crtn.o #ifdef __GNUC__ #define C_DEBUG_SWITCH #define C_OPTIMIZE_SWITCH -O #define LD_SWITCH_MACHINE #else #define C_DEBUG_SWITCH -DSYSV #define C_OPTIMIZE_SWITCH -DSYSV #define LD_SWITCH_MACHINE #endif #if defined(HAVE_X_WINDOWS) && defined(HAVE_X11) #define HAVE_VFORK /* Graciously provided by libX.a */ #endif /* The standard definitions of these macros would work ok, but these are faster because the constants are short. */ #define XUINT(a) (((unsigned)(a) << (BITS_PER_INT-VALBITS)) >> (BITS_PER_INT-VALBITS)) #define XSET(var, type, ptr) \ ((var) = \ ((int)(type) << VALBITS) \ + (((unsigned) (ptr) << (BITS_PER_INT-VALBITS)) >> (BITS_PER_INT-VALBITS))) #define XSETINT(a, b) XSET(a, XTYPE(a), b) #define XSETUINT(a, b) XSET(a, XTYPE(a), b) #define XSETPNTR(a, b) XSET(a, XTYPE(a), b) #define XUNMARK(a) \ ((a) = \ (((unsigned)(a) << (BITS_PER_INT-GCTYPEBITS-VALBITS)) \ >> (BITS_PER_INT-GCTYPEBITS-VALBITS))) emacs-19.30/src/m/mips.h100444 75424 13 13755 6045330154 13237 0ustar kwzhuser/* m- file for Mips machines. Copyright (C) 1987, 1992 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Use m-mips4.h for RISCOS version 4; use s-bsd4-3.h with the BSD world. Note that the proper m- file for the Decstation is m-pmax.h. NOTE-END */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #undef WORD_MACHINE /* Define how to take a char and sign-extend into an int. On machines where char is signed, this is a no-op. */ #define SIGN_EXTEND_CHAR(c) ((signed char)(c)) /* 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 */ #ifndef mips # define mips #endif /* 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 LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / 256.0) /* CDC EP/IX 1.4.3 uses /unix */ #undef KERNEL_FILE #define KERNEL_FILE "/unix" /* 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. */ #undef 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. */ #ifdef __GNUC__ #define HAVE_ALLOCA #else #define C_ALLOCA #endif /* 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 /* This machine requires completely different unexec code which lives in a separate file. Specify the file name. */ #define UNEXEC unexmips.o /* Describe layout of the address space in an executing process. */ #define TEXT_START 0x400000 #define DATA_START 0x800000 /* Alter some of the options used when linking. */ #ifndef NEWSOS5 #ifdef BSD /* DECstations don't have this library. #define LIBS_MACHINE -lmld */ #define LD_SWITCH_MACHINE -D 800000 #define LIBS_DEBUG #define LINKER /bsd43/bin/ld #else /* not BSD */ #define LIBS_MACHINE -lmld #define LD_SWITCH_MACHINE -D 800000 -g3 #define START_FILES pre-crt0.o /usr/lib/crt1.o #define LIB_STANDARD -lbsd -lc /usr/lib/crtn.o #define LIBS_TERMCAP -lcurses #define C_SWITCH_MACHINE -I/usr/include/bsd #define C_DEBUG_SWITCH -O -g3 #if defined(HAVE_X_WINDOWS) && defined(HAVE_X11) #define HAVE_VFORK /* Graciously provided by libX.a */ #endif #endif /* not BSD */ #endif /* not NEWSOS5 */ /* The standard definitions of these macros would work ok, but these are faster because the constants are short. */ #define XUINT(a) (((unsigned)(a) << (BITS_PER_INT-VALBITS)) >> (BITS_PER_INT-VALBITS)) #define XSET(var, type, ptr) \ ((var) = \ ((int)(type) << VALBITS) \ + (((unsigned) (ptr) << (BITS_PER_INT-VALBITS)) >> (BITS_PER_INT-VALBITS))) #define XUNMARK(a) \ ((a) = \ (((unsigned)(a) << (BITS_PER_INT-GCTYPEBITS-VALBITS)) \ >> (BITS_PER_INT-GCTYPEBITS-VALBITS))) #ifndef NEWSOS5 #ifdef USG /* Cancel certain parts of standard sysV support. */ #undef NONSYSTEM_DIR_LIBRARY #define SYSV_SYSTEM_DIR #undef static /* Don't try to use SIGIO or FIONREAD even though they are defined. */ #undef SIGIO #define BROKEN_FIONREAD /* Describe special kernel features. */ #define HAVE_SYSVIPC #if defined(emacs) && !defined(INHIBIT_BSD_TIME) #include #endif /* The `select' in the system won't work for pipes, so don't use it. */ #undef HAVE_SELECT /* override configuration decision */ #define HAVE_GETWD #define HAVE_GETTIMEOFDAY #define HAVE_PTYS #define HAVE_SOCKETS #undef NOMULTIPLEJOBS /* ??? */ #define IRIS #endif /* USG */ #ifdef BSD #define COFF #define TERMINFO #undef MAIL_USE_FLOCK /* Someone should check this. */ #undef HAVE_UNION_WAIT #endif /* BSD */ #endif /* not NEWSOS5 */ emacs-19.30/src/m/mips4.h100444 12120 1 3026 5601420605 13327 0ustar rmsdaemon/* machine description file for Mips running RISCOS version 4. */ #include "mips.h" /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Use -opsystem=usg5-2-2 normally, or -opsystem=bsd4-3 with the BSD world. NOTE-END */ #if 0 /* Define MIPS2 if you have an R6000 or R4000. */ #define MIPS2 #endif #ifdef __GNUC__ #define C_DEBUG_SWITCH -g -O #else /* We used to have -systype bsd43, but a configure change now takes care of that option. */ #ifdef MIPS2 #define C_DEBUG_SWITCH -DMips -g3 -Wf,-XNd4000 -O -Olimit 2000 -mips2 #else #define C_DEBUG_SWITCH -DMips -g3 -Wf,-XNd4000 -O -Olimit 2000 #endif #endif #ifdef TERMINFO #undef TERMINFO #endif #define START_FILES pre-crt0.o /lib/crt1.o /* Used to have -lisode, but jlp@math.byu.edu says remove it (for RISCOS 4.52). */ /* ethanb@ptolemy.astro.washington.edu says crtn.o uses _ctype and therefore we must search libc again after crtn.o. The -L is used to force second -lc to find the sysv version of libc.a, which is needed because the BSD libc.a doesn't have _ctype. */ #define LIB_STANDARD -lmld -lc /lib/crtn.o -L/usr/lib -lc #define COFF #undef LD_SWITCH_MACHINE #define LD_SWITCH_MACHINE -systype bsd43 -g3 -D 800000 #define NO_MODE_T /* These are needed on Riscos 4.0. It appears that's the only system which uses mips4.h and defined BSD. */ #ifdef BSD #undef HAVE_STRERROR #undef HAVE_XRMSETDATABASE #undef HAVE_XSCREENRESOURCESTRING #undef HAVE_SETSID #endif emacs-19.30/src/m/ncr386.h100444 12120 1 773 5742103270 13306 0ustar rmsdaemon#include "intel386.h" #ifndef __GNUC__ /* Allow emacs to link with "bcopy()" unresolved. Works around a problem where /usr/lib/libX11.so provides bcopy, but /usr/ccs/lib/libX11.so does not. */ #define LD_SWITCH_X_DEFAULT -Wl,-z,nodefs #else /* __GNUC__ */ /* Assuming we are using GNU ld, pass a -R option to it so that shared libraries will be found at execution time just as they are found at link time. */ #define LD_SWITCH_X_DEFAULT -Xlinker LD_SWITCH_X_SITE_AUX #endif /* __GNUC__ */ emacs-19.30/src/m/news-risc.h100444 12120 1 1743 5603326360 14216 0ustar rmsdaemon/* news-risc.h is for the "RISC News". */ #include "mips.h" #ifdef NEWSOS5 /* NEWS-OS 5.0.2 */ #define LIBS_MACHINE -lmld #ifdef __GNUC__ #define C_DEBUG_SWITCH -g #define C_OPTIMIZE_SWITCH -g -O #define LD_SWITCH_MACHINE -g -Xlinker -D -Xlinker 800000 #else #define C_DEBUG_SWITCH -g3 #define C_OPTIMIZE_SWITCH -g3 #define LD_SWITCH_MACHINE -g3 -D 800000 -non_shared #endif #else /* not NEWSOS5 */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-3" */ #define COFF #undef LD_SWITCH_MACHINE #define LD_SWITCH_MACHINE -x -D 800000 /* #define C_OPTIMIZE_SWITCH -O2 */ #define C_OPTIMIZE_SWITCH -O #ifndef __GNUC__ #define C_DEBUG_SWITCH -g3 #endif #undef TERMINFO /* We have no mode_t. */ #define NO_MODE_T /* Don't use the definitions in m/mips.h. */ #undef LINKER #undef LIBS_MACHINE #define LIBS_MACHINE -lmld #undef KERNEL_FILE #define KERNEL_FILE "/vmunix" #endif /* not NEWSOS5 */ emacs-19.30/src/m/news.h100444 75424 13 3462 6045454016 13221 0ustar kwzhuser/* machine description file for Sony's NEWS workstations, NEWS-OS 3.0. Copyright (C) 1985, 1986, 1989 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Use -opsystem=bsd4-2, or -opsystem=bsd4-3 for system release 3. NOTE-END */ /* Say this machine is a 68000 */ #ifndef m68000 #define m68000 #endif /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* One CRT0 Dummy variable */ #if 0 /* larry@mitra.com says Sony's as doesn't like this. */ #define CRT0_DUMMIES one_dummy, #endif /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* The News machine has alloca. */ #define HAVE_ALLOCA /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) /* Must use the system's termcap. It does special things. */ #define LIBS_TERMCAP -ltermcap emacs-19.30/src/m/next.h100444 75424 13 6567 6045454034 13234 0ustar kwzhuser/* Configuration file for the NeXT machine. Copyright (C) 1990 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. */ /* Say this machine is a next if not previously defined */ #ifndef NeXT #define NeXT #endif /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ /* Let the compiler tell us. */ #ifdef __BIG_ENDIAN__ #define WORDS_BIG_ENDIAN #endif /* Define how to take a char and sign-extend into an int. On machines where char is signed, this is a no-op. */ #define SIGN_EXTEND_CHAR(c) (c) /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* XINT must explicitly sign-extend */ #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 LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) /* Say that the text segment of a.out includes the header; the header actually occupies the first few bytes of the text segment and is counted in hdr.a_text. */ #define A_TEXT_OFFSET(HDR) sizeof (HDR) /* Mask for address bits within a memory segment */ #define SEGSIZ 0x20000 #define SEGMENT_MASK (SEGSIZ - 1) #define HAVE_ALLOCA #define SYSTEM_MALLOC #define HAVE_UNIX_DOMAIN #define LIB_X11_LIB -L/usr/lib/X11 -lX11 /* This avoids a problem in Xos.h when using co-Xist 3.01. */ #define X_NOT_POSIX /* Conflicts in process.c between ioctl.h & tty.h use of t_foo fields */ #define NO_T_CHARS_DEFINES /* Use our own unexec routines */ #define UNEXEC unexnext.o /* We don't have a g library either, so override the -lg LIBS_DEBUG switch */ #define LIBS_DEBUG /* We don't have a libgcc.a, so we can't let LIB_GCC default to -lgcc */ #define LIB_GCC #if 0 /* ohl@chico.harvard.edu says to do this. */ /* Compile "strict bsd" to avoid warnings from include files */ #define C_SWITCH_MACHINE -bsd #endif /* Link this program just by running cc. */ #define ORDINARY_LINK /* start_of_text isn't actually used, so make it compile without error. */ #define TEXT_START 0 /* This seems to be right for end_of_text, but it may not be used anyway. */ #define TEXT_END get_etext () /* This seems to be right for end_of_data, but it may not be used anyway. */ #define DATA_END get_edata () /* Defining KERNEL_FILE causes lossage because sys/file.h stupidly gets confused by it. */ #undef KERNEL_FILE #define LD_SWITCH_MACHINE -X -noseglinkedit #define environ _environ #if 0 /* This is ok for NeXT system version 3.0 or above. */ /* Where to find the kernel, for load average. */ #define KERNEL_FILE "/mach" #endif /* This should be true for recent NeXT systems. At least since 3.2. */ #define HAVE_MACH_MACH_H emacs-19.30/src/m/nh3000.h100444 75424 13 10016 6045454036 13170 0ustar kwzhuser/* machine description for Harris Night Hawk Series 1200 and Series 3000 MC68030-based systems (FPP on these is custom). These systems are also known as "ecx" and "gcx". Copyright (C) 1994 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. */ /* This file manually constructed for Harris Night Hawk 4000 (and 5000) * series Motorola 88100 and 88110 based machines. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="" */ /* 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 */ #ifndef gcx #define gcx #endif /* 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 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 /* Some really obscure 4.2-based systems (like Sequent DYNIX) * do not support asynchronous I/O (using SIGIO) on sockets, * even though it works fine on tty's. If you have one of * these systems, define the following, and then use it in * config.h (or elsewhere) to decide when (not) to use SIGIO. * * You'd think this would go in an operating-system description file, * but since it only occurs on some, but not all, BSD systems, the * reasonable place to select for it is in the machine description * file. */ /* #define NO_SOCK_SIGIO */ emacs-19.30/src/m/nh4000.h100444 75424 13 7705 6045454041 13160 0ustar kwzhuser/* machine description for Harris NightHawk 88k based machines (includes nh4000 and nh5000 machines). Copyright (C) 1994 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. */ /* This file manually constructed for Harris Night Hawk 4000 (and 5000) * series Motorola 88100 and 88110 based machines. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="" */ /* 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 */ #ifndef m88000 #define m88000 #endif /* 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 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 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 /* Some really obscure 4.2-based systems (like Sequent DYNIX) * do not support asynchronous I/O (using SIGIO) on sockets, * even though it works fine on tty's. If you have one of * these systems, define the following, and then use it in * config.h (or elsewhere) to decide when (not) to use SIGIO. * * You'd think this would go in an operating-system description file, * but since it only occurs on some, but not all, BSD systems, the * reasonable place to select for it is in the machine description * file. */ /* #define NO_SOCK_SIGIO */ emacs-19.30/src/m/ns16000.h100444 75424 13 5206 6045454043 13252 0ustar kwzhuser/* machine description file for ns16000. Copyright (C) 1985 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START For the Encore, use `-opsystem=umax'. For a Tektronix 16000 box (a 6130, perhaps?), use `-opsystem=bsd4-2'. Use `-machine=ns16000' for both. NOTE-END */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_BIG_ENDIAN /* Say this machine is a 16000 */ #define ns16000 1 /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* Data type of load average, as read out of kmem. */ #ifndef USG #define LOAD_AVE_TYPE double #endif /* Convert that into an integer that is 100 for a load average of 1.0 */ #ifndef USG #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) #endif #ifdef USG /* Control assembler syntax used in alloca.s. */ #define NS5 /* On early NS systems ulimit was buggy. If set emacs uses this value * for the maximum sbrk value instead of getting it from ulimit. */ #define ULIMIT_BREAK_VALUE 0x7E0000 /* Early NS compilers have this bug. I believe it has been fixed in later * releases. */ #define SHORT_CAST_BUG #define SEGMENT_MASK (NBPS - 1) /* Variables to get crt0.c to come out correctly */ #define CRT0_DUMMIES bogus_fp, #define DOT_GLOBAL_START /* Control how emacsclient communicates. */ #define HAVE_SYSVIPC /* Set this to /bin/mail unless you have a better mail posting program */ #define MAIL_PROGRAM_NAME "/usr/local/bin/remail" /* Tell sysdep.c not to define bzero, etc. */ #undef BSTRING #define BSTRING /* Macro definitions to emulate BSD functions with SysV ones */ #undef bcopy #undef bzero #undef bcmp #define bcopy(a,b,s) memcpy(b,a,s) #define bzero(a,s) memset(a,0,s) #define bcmp memcmp /* This avoids problems with uninitialized static variables going in .data. */ #define static #endif /* USG */ emacs-19.30/src/m/ns32000.h100444 75424 13 7016 6045454045 13253 0ustar kwzhuser/* machine description file for National Semiconductor 32000, running Genix. 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_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 */ /* 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 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 */ #ifdef __NetBSD__ #define HAVE_ALLOCA #endif /* 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 */ #define TEXT_START 0 #define STACK_DIRECTION -1 #ifndef __NetBSD__ #define EXEC_MAGIC 0410 #define PURESIZE 140000 #define START_FILES pre-crt0.o /lib/crt0.o #endif emacs-19.30/src/m/nu.h100444 75424 13 4016 6045454047 12667 0ustar kwzhuser/* machine description file for TI Nu machines using system V. Copyright (C) 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* XINT must explicitly sign-extend */ #define EXPLICIT_SIGN_EXTEND /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* Now define a symbol for the cpu type, if your compiler does not define it automatically: vax, m68000, ns16000 are the ones defined so far. */ #ifndef m68000 #define m68000 #endif #ifndef NU #define NU #endif /* Data type of load average, as read out of kmem. */ /* These are commented out since it does not really work in uniplus */ /* #define LOAD_AVE_TYPE long */ /* Convert that into an integer that is 100 for a load average of 1.0 */ /* #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0) */ /* Change some things to avoid bugs in compiler */ #define SWITCH_ENUM_BUG 1 /* The NU machine has a compiler that can handle long names. */ #undef SHORTNAMES /* Specify alignment requirement for start of text and data sections in the executable file. */ #define SECTION_ALIGNMENT pagemask emacs-19.30/src/m/orion.h100444 75424 13 4124 6045454051 13366 0ustar kwzhuser/* machine description file for HLH Orion. Copyright (C) 1985 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_BIG_ENDIAN /* Now define a symbol for the cpu type, if your compiler does not define it automatically. */ #ifndef orion #define orion #endif /* 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 /* 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 */ #define EXPLICIT_SIGN_EXTEND /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #ifndef FSCALE #define FSCALE 1.0 #endif #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) /* It is necessary to use the portable imitation of alloca, since a true stack-allocating one is impossible. */ #define C_ALLOCA emacs-19.30/src/m/orion105.h100444 75424 13 4257 6045454053 13625 0ustar kwzhuser/* machine description file for HLH Orion 1/05 (Clipper). Copyright (C) 1985 Free Software Foundation, Inc. Lee McLoughlin 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_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. */ /* Use type int rather than a union, to represent Lisp_Object */ /* This is desirable for most machines. */ #define NO_UNION_TYPE /* Data type of load average, as read out of kmem. */ /* This used to be `double'. */ #define LOAD_AVE_TYPE long /* Convert that into an integer that is 100 for a load average of 1.0 */ /* This used to be 1.0. */ #ifndef FSCALE #define FSCALE 256 #endif #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) /* HLH have a SIGWINCH defined (but unimplemented) so we need a sigmask */ #ifndef sigmask #define sigmask(m) (1 << ((m) - 1)) #endif #define HAVE_ALLOCA /* Here is where programs actually start running */ #define TEXT_START 0x8000 #define LD_TEXT_START_ADDR 8000 /* Arguments to ignore before argc in crt0.c. */ #define DUMMIES dummy1, dummy2, emacs-19.30/src/m/paragon.h100666 12120 1 500 5660702422 13707 0ustar rmsdaemon/* m/ file for Paragon i860 machine. */ #include "i860.h" #define COFF #define SYSTEM_MALLOC #define TEXT_START 0x10000 #define LD_DATA_START 0x140000 #undef LD_SWITCH_SYSTEM #define LD_SWITCH_SYSTEM -d LD_DATA_START #define LIB_STANDARD -lc -lic #define KEEP_OLD_TEXT_SCNPTR #define KEEP_OLD_PADDR #define drem fmod emacs-19.30/src/m/pfa50.h100444 75424 13 4632 6045454054 13162 0ustar kwzhuser/* Machine description file for PFU A-series. Copyright (C) 1988 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. */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* Say this machine is a 68000 */ #define m68000 #define mc68000 1 /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* XINT must explicitly sign-extend */ #define EXPLICIT_SIGN_EXTEND /* The symbol FIONREAD is defined, but the feature does not work. */ #define BROKEN_FIONREAD /* 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 /* Define TEXT_START_ADDR if your linker don't set execute point to _start. If it needed, temacs always CORE-DUMP. */ #define TEXT_START_ADDR __start /* Define START_FILES if your machine used _start. */ #define START_FILES crt0.o /* Define LD_SWITCH_MACHINE if your linker needs it. */ #define LD_SWITCH_MACHINE -e __start #if pfa50 || pfa70 /* On A-50/60/70/80, data space has high order byte use. */ #define VALBITS 26 #define VALMASK (((1<> VALBITS) & GCTYPEMASK)) #endif /* pfa50, pfa70 */ /* SX/A has alloca in the PW library. */ #define LIB_STANDARD -lPW -lc #define HAVE_ALLOCA /* SX/A uses terminfo and lib/curses */ #define TERMINFO #define HAVE_PTYS #define HAVE_SOCKETS /* SX/A use SystemV style getdents/readdir. */ /* SX/A does not have sigblock(2) */ #define sigblock(mask) (0) #define NO_SIOCTL_H #undef SIGIO emacs-19.30/src/m/plexus.h100444 75424 13 7257 6045454057 13600 0ustar kwzhuser/* machine description file for the Plexus running System V.2. Copyright (C) 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #undef NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #undef WORD_MACHINE /* Now define a symbol for the cpu type, if your compiler does not define it automatically: vax, m68000, ns16000, pyramid, orion, tahoe and APOLLO are the ones defined so far. */ /* Plexus predefines m68 instead of m68000. */ #define m68000 m68 /* 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. */ #undef EXPLICIT_SIGN_EXTEND /* Data type of load average, as read out of kmem. */ #undef LOAD_AVE_TYPE /* Convert that into an integer that is 100 for a load average of 1.0 */ #undef LOAD_AVE_CVT /* 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. */ #undef 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. */ #undef 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. */ #undef 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. */ #undef NO_REMAP /* Use the following on ld so we can use the gnu crt0 The plexus ld looks for start */ #define LD_SWITCH_MACHINE -e __start /* Use the PW library, which contains alloca. */ #define LIB_STANDARD -lPW -lc /* crt0.c should use the vax-bsd style of entry, with no dummy args. */ #define CRT0_DUMMIES zero1, zero2, /* This triggers some stuff to avoid a compiler bug */ #define TAHOE_REGISTER_BUG emacs-19.30/src/m/pmax.h100444 12120 1 6070 6024444626 13253 0ustar rmsdaemon/* Machine description file for DEC MIPS machines. */ #include "mips.h" /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Use -opsystem=osf1 for OSF/1, and -opsystem=bsd4-3 otherwise. NOTE-END */ #undef WORDS_BIG_ENDIAN #undef LIB_STANDARD #undef START_FILES #undef COFF #undef TERMINFO #define MAIL_USE_FLOCK #define HAVE_UNION_WAIT #ifdef MACH #define START_FILES pre-crt0.o /usr/lib/crt0.o #else /* This line starts being needed with ultrix 4.0. */ /* You must delete it for version 3.1. */ #define START_FILES pre-crt0.o /usr/lib/cmplrs/cc/crt0.o #endif /* Supposedly the following will overcome a kernel bug. */ #undef LD_SWITCH_MACHINE #undef DATA_START #define DATA_START 0x10000000 #define DATA_SEG_BITS 0x10000000 #if 0 /* I don't see any such conflict in Ultrix 4.2, 4.2a, or 4.3. And the relocating allocator is a real win. -JimB */ /* In Ultrix 4.1, XvmsAlloc.o in libX11.a seems to insist on defining malloc itself. This should avoid conflicting with it. */ #define SYSTEM_MALLOC #endif /* Override what mips.h says about this. */ #undef LINKER /* Ultrix 4.2 (perhaps also 4.1) implements O_NONBLOCK but it doesn't work right; and it causes hanging in read_process_output. */ #define BROKEN_O_NONBLOCK #if defined (OSF1) || defined (MACH) #undef C_ALLOCA #define HAVE_ALLOCA #endif /* mcc@timessqr.gc.cuny.edu says this makes Emacs work with DECnet. */ #ifdef HAVE_LIBDNET #define LIBS_MACHINE -ldnet #endif /* mcc@timessqr.gc.cuny.edu says it is /vmunix on Ultrix 4.2a. */ #undef KERNEL_FILE #define KERNEL_FILE "/vmunix" #ifndef MACH /* Jim Wilson writes: [...] The X11 include files that Dec distributes with Ultrix are bogus. When __STDC__ is defined (which is true with gcc), the X11 include files try to define prototypes. The prototypes however use types which haven't been defined yet, and thus we get syntax/parse errors. You can not fix this by changing the include files, because the prototypes create circular dependencies, in particular Xutil.h depends on types defined in Xlib.h, and Xlib.h depends on types defined in Xutil.h. So, no matter which order you try to include them in, it will still fail. Compiling with -DNeedFunctionPrototypes=0 will solve the problem by directly inhibiting the bad prototypes. This could perhaps just be put in an a Ultrix configuration file. Using the MIT X11 distribution instead of the one provided by Dec will also solve the problem, but I doubt you can convince everyone to do this. */ /* Addendum: the MIT X11 distribution neglects to define certain symbols when NeedFunctionPrototypes is 0, but still tries to use them when NeedVarargsProrotypes is 1 (which is its default value). So if we're going to disable non-variadic prototypes, we also need to disable variadic prototypes. --kwzh@gnu.ai.mit.edu */ #define C_SWITCH_X_MACHINE -DNeedFunctionPrototypes=0 -DNeedVarargsPrototypes=0 #endif /* Enable a fix in process.c. */ #define SET_CHILD_PTY_PGRP emacs-19.30/src/m/pyramid.h100444 75424 13 3556 6045454060 13715 0ustar kwzhuser/* machine description file for pyramid. 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #ifdef __GNUC__ #define NO_ARG_ARRAY #endif /* XINT must explicitly sign extend */ #define EXPLICIT_SIGN_EXTEND /* pyramid preprocessor defines "pyr", however the following is clearer */ #define pyramid /* Don't use the union types any more. They were used until Emacs 17.45. */ #define NO_UNION_TYPE /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) /* Don't use the ordinary -g for debugging in cc */ #define C_DEBUG_SWITCH -gx /* Reenable this #define for old versions of the Pyramid system. */ /* #define PYRAMID_OLD */ emacs-19.30/src/m/pyrmips.h100666 12120 1 303 5265211704 13763 0ustar rmsdaemon/* Configuration file for the Pyramid machine that uses the MIPS cpu. */ /* This does not fully work. */ #include "m-pyramid.h" #define SYSTEM_MALLOC #define HAVE_ALLOCA #define CANNOT_DUMP emacs-19.30/src/m/sequent-ptx.h100444 12120 1 10713 5653562564 14633 0ustar rmsdaemon/* machine description file for SEQUENT machines running DYNIX/ptx 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="ptx" */ #include "intel386.h" /* Define how to take a char and sign-extend into an int. On machines where char is signed, this is a no-op. */ /* CHECK THIS */ #define SIGN_EXTEND_CHAR(c) (c) /* 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. */ /* BTW: ptx defines _SEQUENT_, i386 */ /* Use type int rather than a union, to represent Lisp_Object */ /* This is desirable for most machines. */ #define NO_UNION_TYPE /* crt0.c should use the vax-bsd style of entry, with these dummy args. */ /* Already defined. Assume prior definition works for PTX. */ #if 0 #undef CRT0_DUMMIES #define CRT0_DUMMIES dummy1, dummy2, dummy3, #endif /* 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 unsigned 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. */ #ifndef __GNUC__ #define C_ALLOCA #undef HAVE_ALLOCA #endif /* 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. */ /* On PTX, can't seem to get a valid executable unless NO_REMAP is defined. This did work in the Sequent patched Emacs 18.57. */ #ifndef NO_REMAP #define NO_REMAP #endif /* #undef NO_REMAP */ /* If a valid PTX executable could be dumped without NO_REMAP defined, here's a guess at some defines to make it work. */ #ifndef NO_REMAP /* PTX has getpagesize() but it returns 296. Using the default method of including getpagesize.h in unexec.c returns 4096 which seems more reasonable. */ #undef HAVE_GETPAGESIZE /* Override magic number for a.out header. */ #define EXEC_MAGIC 0411 /* from a.out.h: separated I&D */ #define ADJUST_TEXT_SCNHDR_SIZE #define ADJUST_TEXTBASE /* The file sections in the Symmetry a.out must be on 4K boundaries. */ /* #define DATA_SECTION_ALIGNMENT (4096-1) */ #endif /* ifndef NO_REMAP */ /* Avoids a compiler bug. */ #define TAHOE_REGISTER_BUG /* (short) negative-int doesn't sign-extend correctly. */ #define SHORT_CAST_BUG /* Cause compilations to be done in parallel in ymakefile. */ #define MAKE_PARALLEL $& /* Use terminfo library. */ #define LIBS_TERMCAP -ltermlib emacs-19.30/src/m/sequent.h100444 75424 13 13365 6045454062 13755 0ustar kwzhuser/* machine description file for SEQUENT BALANCE machines 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Use -opsystem=bsd4-2, or -opsystem=bsd4-3 on newer systems. NOTE-END */ /* NOTE: this file works for DYNIX release 2.0 (not tested on 1.3) on NS32000's */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_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: vax, m68000, ns16000, pyramid, orion, tahoe and APOLLO are the ones defined so far. */ /* BTW: DYNIX defines sequent, ns32000, and ns16000 (GENIX compatibility) */ #ifndef sequent /* pre DYNIX 2.1 releases */ # define sequent #endif /* Use type int rather than a union, to represent Lisp_Object */ /* This is desirable for most machines. */ #define NO_UNION_TYPE /* crt0.c should use the vax-bsd style of entry, with these dummy args. */ #define CRT0_DUMMIES bogus_fp, /* crt0.c should define a symbol `start' and do .globl with a dot. */ #define DOT_GLOBAL_START /* 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 unsigned 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 /* Name of file the to look in for the kernel symbol table (for load average) */ #undef KERNEL_FILE #define KERNEL_FILE "/dynix" /* Avoids a compiler bug */ #define TAHOE_REGISTER_BUG /* Say that the text segment of a.out includes the header; the header actually occupies the first few bytes of the text segment and is counted in hdr.a_text. Furthermore, the value written in the a_text in the file must have N_ADDRADJ added to it. */ #define A_TEXT_OFFSET(HDR) (sizeof (HDR) + N_ADDRADJ (HDR)) /* This is the offset of the executable's text, from the start of the file. */ #define A_TEXT_SEEK(HDR) (N_TXTOFF (hdr) + sizeof (hdr)) /* (short) negative-int doesn't sign-extend correctly */ #define SHORT_CAST_BUG /* Cause compilations to be done in parallel in ymakefile. */ #define MAKE_PARALLEL & /* Say that mailer interlocking uses flock. */ #define MAIL_USE_FLOCK /* On many 4.2-based systems, there's a rather tricky bug * with the interpretation of the pid/pgrp value given to * the F_SETOWN fcntl() call. It works as documented EXCEPT * when applied to filedescriptors for sockets, in which case * the sign must be reversed. If your emacs subprocesses get * SIGIO's when they shouldn't, while running on a socket * (e.g. under X windows), you should probably define this. */ #define F_SETOWN_SOCK_NEG /* Some really obscure 4.2-based systems (like Sequent DYNIX) * do not support asynchronous I/O (using SIGIO) on sockets, * even though it works fine on tty's. If you have one of * these systems, define the following, and then use it in * config.h (or elsewhere) to decide when (not) to use SIGIO. */ #define NO_SOCK_SIGIO /* Define how to search all pty names. This is for Dynix 3.0; delete next 5 definitions for older systems. */ #define PTY_MAJOR "pqrstuvwPQRSTUVW" #define PTY_MINOR "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" #define PTY_ITERATION \ register int ma, mi; \ for (ma = 0; ma < sizeof(PTY_MAJOR) - 1; ma++) \ for (mi = 0; mi < sizeof(PTY_MINOR) - 1; mi++) #define PTY_NAME_SPRINTF \ sprintf (ptyname, "/dev/pty%c%c", PTY_MAJOR[ma], PTY_MINOR[mi]); #define PTY_TTY_NAME_SPRINTF \ sprintf (ptyname, "/dev/tty%c%c", PTY_MAJOR[ma], PTY_MINOR[mi]); emacs-19.30/src/m/sgi3000.h100444 13437 1 23 5122175717 13457 0ustar jimbdaemon#include "irist.h" emacs-19.30/src/m/sparc.h100444 75424 13 6646 6045454064 13367 0ustar kwzhuser/* machine description file for Sun 4 SPARC. Copyright (C) 1987 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Use -opsystem=sunos4 for operating system version 4, and -opsystem=bsd4-2 for earlier versions. NOTE-END */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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 /* Say this machine is a sparc */ #ifndef sparc #define sparc #endif #ifdef __GNUC__ # define C_OPTIMIZE_SWITCH -O #else /* This level of optimization is reported to work. */ # define C_OPTIMIZE_SWITCH -O2 #endif /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* XINT must explicitly sign-extend */ #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 LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) /* 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 HAVE_ALLOCA #ifndef NOT_C_CODE #if __GNUC__ < 2 /* Modern versions of GCC handle alloca directly. */ #include #endif #endif /* Must use the system's termcap, if we use any termcap. It does special things. */ #ifndef TERMINFO #define LIBS_TERMCAP -ltermcap #endif /* Mask for address bits within a memory segment */ #define SEGMENT_MASK (SEGSIZ - 1) /* Arrange to link with sun windows, if requested. */ /* For details on emacstool and sunfns, see etc/SUN-SUPPORT */ /* These programs require Sun UNIX 4.2 Release 3.2 or greater */ #ifdef HAVE_SUN_WINDOWS #define OTHER_FILES ${etcdir}emacstool #define LIBS_MACHINE -lsuntool -lsunwindow -lpixrect #define OBJECTS_MACHINE sunfns.o #define SYMS_MACHINE syms_of_sunfns () #define PURESIZE 130000 #endif #ifndef __NetBSD__ /* This really belongs in s/sun.h. */ /* Say that the text segment of a.out includes the header; the header actually occupies the first few bytes of the text segment and is counted in hdr.a_text. */ #define A_TEXT_OFFSET(HDR) sizeof (HDR) /* This is the offset of the executable's text, from the start of the file. */ #define A_TEXT_SEEK(HDR) (N_TXTOFF (hdr) + sizeof (hdr)) #endif /* __NetBSD__ */ emacs-19.30/src/m/sps7.h100444 75424 13 5711 6045454066 13145 0ustar kwzhuser/* machine description file for Bull SPS-7. Copyright (C) 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* Say this machine is a 68000 */ #ifndef m68000 #define m68000 #endif #define sps7 /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* XINT must explicitly sign-extend */ #define EXPLICIT_SIGN_EXTEND /* Data type of load average, as read out of kmem. */ /* Suspect there is something weird about this machine, so turn it off. */ /* #define LOAD_AVE_TYPE long */ /* Convert that into an integer that is 100 for a load average of 1.0 */ /* #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0) */ #define SMX #define V3x /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ #define HAVE_SOCKETS /* Have the socketpair call */ #define SKTPAIR /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ #define CLASH_DETECTION /* Use Berkeley style interface to nlist */ #define NLIST_STRUCT /* Define this to cause -N to be passed to ld. This is needed * in uniplus because of its funny memory space layout. * SMX--If you are using 32 bit (COFF) use "-N", else don't use anything. */ #define LD_SWITCH_MACHINE -N -T32 -e __start /* If you are compiling for a 68020, then use -lc32 else use -lc */ #define LIB_STANDARD -lc32 /* Fore 16 bit, -linet, for 32 bit -linet32 (be sure you have it!). */ #define LIBS_MACHINE -linet32 /* Use -T32 for 68020, -T16 otherwise */ #define C_SWITCH_MACHINE -T32 /* Here we assume that signal.h is included before config.h so that we can override it here. */ #undef SIGIO /* Other than 68020 use ld16, as32, or undefine (defaults ld and as). */ #define ASS as32 #ifdef V3x #define EXEC_MAGIC 0x10b #define SEGMENT_MASK (NBPS-1) #define ADJUST_EXEC_HEADER f_hdr.f_magic = SMROMAGIC;\ f_ohdr.stsize = 0; #endif emacs-19.30/src/m/stride.h100444 75424 13 7113 6045454067 13542 0ustar kwzhuser/* Definitions file for GNU Emacs running on Stride Micro System-V.2.2 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #undef NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #undef WORD_MACHINE /* Now define a symbol for the cpu type, if your compiler does not define it automatically: vax, m68000, ns16000, pyramid, orion, tahoe, APOLLO and STRIDE are the ones defined so far. */ #define m68000 /* because the SGS compiler defines "m68k" */ #ifndef STRIDE #define STRIDE #endif /* 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 double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) /* 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. */ #undef 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. */ #undef VIRT_ADDR_VARIES /* The STRIDE system is more powerful than standard USG5. */ #define HAVE_PTYS #define HAVE_GETTIMEOFDAY #define BSTRING #define SKTPAIR #define HAVE_SOCKETS #define MAIL_USE_FLOCK #undef TERMINFO #define EXEC_MAGIC 0413 /* USG wins again: Foo! I can't get SIGIO to work properly on the Stride, because I'm running a System V variant, and don't have a reliable way to block SIGIO signals without losing them. So, I've gone back to non-SIGIO mode, so please append this line to the file "stride.h": */ #undef SIGIO /* Specify alignment requirement for start of text and data sections in the executable file. */ #define SECTION_ALIGNMENT (getpagesize() - 1) /* * UniStride has this in /lib/libc.a. */ #undef NONSYSTEM_DIR_LIBRARY /* UniStride defines getwd. */ #define HAVE_GETWD /* Define this macro if system defines a type `union wait'. */ #define HAVE_UNION_WAIT emacs-19.30/src/m/sun1.h100444 75424 13 4606 6045454071 13135 0ustar kwzhuser/* machine description file for Sun 68000's 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Sun 1, 2 and 3 (-machine=sun1, -machine=sun2, -machine=sun3; -opsystem=bsd4-2 or -opsystem=sunos4) Whether you should use sun1, sun2 or sun3 depends on the VERSION OF THE OPERATING SYSTEM you have. There are three machine types for different versions of SunOS. All are derived from Berkeley 4.2, meaning that you should use -opsystem=bsd4-2. Emacs 17 has run on all of them. You will need to use sun3 on Sun 2's running SunOS release 3. For SunOS release 4 on a Sun 3, use -machine=sun3 and -opsystem=sunos4. See the file share-lib/SUNBUG for how to solve problems caused by bugs in the "export" version of SunOS 4. NOTE-END */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* Say this machine is a 68000 */ #define m68000 /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* Sun can't write competent compilers */ #define COMPILER_REGISTER_BUG /* XINT must explicitly sign-extend */ #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 LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) /* Must use the system's termcap. It does special things. */ #define LIBS_TERMCAP -ltermcap /* Mask for address bits within a memory segment */ #define SEGMENT_MASK (SEGSIZ - 1) emacs-19.30/src/m/sun2.h100444 75424 13 6064 6045454074 13141 0ustar kwzhuser/* machine description file for Sun 68000's OPERATING SYSTEM version 2. Note that "sun2.h" refers to the operating system version, not the CPU model number. See the MACHINES file for details. 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Sun 1, 2 and 3 (-machine=sun1, -machine=sun2, -machine=sun3; -opsystem=bsd4-2 or -opsystem=sunos4) Whether you should use sun1, sun2 or sun3 depends on the VERSION OF THE OPERATING SYSTEM you have. There are three machine types for different versions of SunOS. All are derived from Berkeley 4.2, meaning that you should use -opsystem=bsd4-2. Emacs 17 has run on all of them. You will need to use sun3 on Sun 2's running SunOS release 3. For SunOS release 4 on a Sun 3, use -machine=sun3 and -opsystem=sunos4. See the file share-lib/SUNBUG for how to solve problems caused by bugs in the "export" version of SunOS 4. NOTE-END */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* Say this machine is a 68000 */ #ifndef m68000 #define m68000 #endif /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* Sun can't write competent compilers */ #define COMPILER_REGISTER_BUG /* XINT must explicitly sign-extend */ #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 LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) /* Say that this is a Sun 2; must check for and maybe reinitialize the "sky" board. */ #define sun2 /* Must use the system's termcap. It does special things. */ #define LIBS_TERMCAP -ltermcap /* Mask for address bits within a memory segment */ #define SEGMENT_MASK (SEGSIZ - 1) /* Arrange to link with sun windows, if requested. */ /* For details on emacstool and sunfns, see etc/SUN-SUPPORT */ /* These programs require Sun UNIX 4.2 Release 3.2 or greater */ #ifdef HAVE_SUN_WINDOWS #define OTHER_FILES ${libsrc}emacstool #define LIBS_MACHINE -lsuntool -lsunwindow -lpixrect #define OBJECTS_MACHINE sunfns.o #define SYMS_MACHINE syms_of_sunfns () #define PURESIZE 132000 #endif emacs-19.30/src/m/sun3-68881.h100444 13437 1 1532 5122175721 14017 0ustar jimbdaemon/* sun3-68881.h, for a Sun 3, using the 68881. */ #include "sun3.h" /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Sun with 68881 co-processor (-machine=sun3-68881; -opsystem=bsd4-2 or -opsystem=sunos4) Versions 1, 2, and 3 of the operating system are derived from Berkeley 4.2, meaning that you should use -opsystem=bsd4-2. For SunOS release 4 on a Sun 3 with a 68881, use -machine=sun3-68881 and -opsystem=sunos4. See the file share-lib/SUNBUG for how to solve problems caused by bugs in the "export" version of SunOS 4. NOTE-END */ /* In case we are using floating point, work together with crt0.c. */ #ifndef __GNUC__ #define C_SWITCH_MACHINE -f68881 #endif #define sun_68881 #define START_FILES crt0.o /usr/lib/Mcrt1.o emacs-19.30/src/m/sun3-fpa.h100444 13437 1 1515 5122175721 14070 0ustar jimbdaemon/* sun3-fpa.h, for a Sun 3, using the Sun fpa. */ #include "sun3.h" /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Sun with FPA co-processor (-machine=sun3-fpa; -opsystem=bsd4-2 or -opsystem=sunos4) Versions 1, 2, and 3 of the operating system are derived from Berkeley 4.2, meaning that you should use -opsystem=bsd4-2. For SunOS release 4 on a Sun 3 with an FPA, use -machine=sun3-fpa and -opsystem=sunos4. See the file share-lib/SUNBUG for how to solve problems caused by bugs in the "export" version of SunOS 4. NOTE-END */ /* In case we are using floating point, work together with crt0.c. */ #ifndef __GNUC__ #define C_SWITCH_MACHINE -ffpa #endif #define sun_fpa #define START_FILES crt0.o /usr/lib/Wcrt1.o emacs-19.30/src/m/sun3-soft.h100444 13437 1 1632 5122175722 14276 0ustar jimbdaemon/* sun3-soft.h, for a Sun 3, using the Sun with software floating point. */ #include "sun3.h" /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Sun with software floating point (-machine=sun3-soft; -opsystem=bsd4-2 or -opsystem=sunos4) Versions 1, 2, and 3 of the operating system are derived from Berkeley 4.2, meaning that you should use -opsystem=bsd4-2. If you want to use software floating point on SunOS release 4 on a Sun 3, use -machine=sun3-68881 and -opsystem=sunos4. See the file share-lib/SUNBUG for how to solve problems caused by bugs in the "export" version of SunOS 4. NOTE-END */ /* In case we are using floating point, work together with crt0.c. */ #ifndef __GNUC__ #define C_SWITCH_MACHINE -fsoft #endif #define sun_soft #define START_FILES crt0.o /usr/lib/Fcrt1.o emacs-19.30/src/m/sun3.h100444 13437 1 3317 5122176162 13326 0ustar jimbdaemon/* machine description file for Sun 68000's OPERATING SYSTEM version 3 (for either 68000 or 68020 systems). */ #include "sun2.h" #undef sun2 #ifndef sun3 #define sun3 #endif /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Sun 1, 2 and 3 (-machine=sun1, -machine=sun2, -machine=sun3; -opsystem=bsd4-2 or -opsystem=sunos4) Whether you should use sun1, sun2 or sun3 depends on the VERSION OF THE OPERATING SYSTEM you have. There are three machine types for different versions of SunOS. All are derived from Berkeley 4.2, meaning that you should use -opsystem=bsd4-2. Emacs 17 has run on all of them. You will need to use sun3 on Sun 2's running SunOS release 3. For SunOS release 4 on a Sun 3, use -machine=sun3 and -opsystem=sunos4. See the file share-lib/SUNBUG for how to solve problems caused by bugs in the "export" version of SunOS 4. NOTE-END */ /* Say that the text segment of a.out includes the header; the header actually occupies the first few bytes of the text segment and is counted in hdr.a_text. */ #define A_TEXT_OFFSET(HDR) sizeof (HDR) /* This is the offset of the executable's text, from the start of the file. */ #define A_TEXT_SEEK(HDR) (N_TXTOFF (hdr) + sizeof (hdr)) /* In case we are using floating point, work together with crt0.c. */ #ifndef __GNUC__ #define C_SWITCH_MACHINE -fsoft #endif /* This line is needed if you are linking with X windows and the library xlib was compiled to use the 68881. For maximum cleanliness, don't edit this file; instead, insert this line in config.h. */ /* #define START_FILES crt0.o /usr/lib/Mcrt1.o */ emacs-19.30/src/m/sun386.h100444 12120 1 5130 5574410167 13352 0ustar rmsdaemon/* machine description file for Sun's 386-based RoadRunner. This file borrows heavily from "sun2.h", but since that file is heavily cpu-specific, it was easier not to include it. Copyright (C) 1988 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Use s-sunos4-0.h for operating system version 4.0, and s-sunos4-1.h for later versions. See the file share-lib/SUNBUG for how to solve problems caused by bugs in the "export" version of SunOS 4. NOTE-END */ /* Say this machine is a bird */ #ifndef roadrunner #define roadrunner #endif /* Actual cpu-specific defs */ #include "intel386.h" /* 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 LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) /* Underscores are not prepended to C symbols on this machine. */ #undef LDAV_SYMBOL #define LDAV_SYMBOL "avenrun" /* Must use the system's termcap. It does special things. */ #define LIBS_TERMCAP -ltermcap /* Arrange to link with sun windows, if requested. */ /* For details on emacstool and sunfns, see etc/SUN-SUPPORT */ /* These programs require Sun UNIX 4.2 Release 3.2 or greater */ #ifdef HAVE_SUN_WINDOWS #define OTHER_FILES ${etcdir}emacstool #define LIBS_MACHINE -lsuntool -lsunwindow -lpixrect #define OBJECTS_MACHINE sunfns.o #define SYMS_MACHINE syms_of_sunfns () #define PURESIZE 132000 #endif /* Roadrunner uses 'COFF' format */ #define COFF #define C_SWITCH_MACHINE -Bstatic /* avoid dynamic linking */ #define LD_SWITCH_MACHINE -n -Bstatic /* Get rid of the -e __start that s-sunos4.h does. */ #undef LD_SWITCH_SYSTEM #ifdef USG /* USG detects Solaris. j.w.hawtin@lut.ac.uk says Solaris 2.1 on the 386 needs this. */ #define LIBS_MACHINE -lkvm #endif emacs-19.30/src/m/symmetry.h100444 12120 1 6724 5653562504 14210 0ustar rmsdaemon/* machine description file for SEQUENT SYMMETRY machines 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 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. */ /* CHANGE: [Eric H. Herrin II; eric@ms.uky.edu - 15 Sept 1988] * Modified the sequent.h file for the Sequent Symmetry machine. * Biggest change was to align the sections in the a.out to 4K * boundaries (this is the page size). */ /* NOTICE: this file works for DYNIX release 3.0.12 on Sequent Symmetry * (Intel 80386) machines. Hasn't been tested on anything else. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-3" */ #include "intel386.h" /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE unsigned 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 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*/ /* Name of file the to look in for the kernel symbol table (for load average) */ #undef KERNEL_FILE #define KERNEL_FILE "/dynix" /* Avoids a compiler bug */ #define TAHOE_REGISTER_BUG /* Say that the text segment of a.out includes the header; the header actually occupies the first few bytes of the text segment and is counted in hdr.a_text. Furthermore, the value written in the a_text in the file must have N_ADDRADJ added to it. */ #define A_TEXT_OFFSET(HDR) (sizeof (HDR) + N_ADDRADJ (HDR)) /* This is the offset of the executable's text, from the start of the file. */ #define A_TEXT_SEEK(HDR) (N_TXTOFF (hdr) + sizeof (hdr)) /* The file sections in the Symmetry a.out must be on 4K boundaries. */ #define SEGSIZ 4096 #define SECTION_ALIGNMENT (SEGSIZ-1) /* (short) negative-int doesn't sign-extend correctly */ #define SHORT_CAST_BUG /* Cause compilations to be done in parallel in ymakefile. */ #define MAKE_PARALLEL & /* Define how to search all pty names. This is for Dynix 3.0; delete next 5 definitions for older systems. */ #define PTY_MAJOR "pqrstuvwPQRSTUVW" #define PTY_MINOR "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" #define PTY_ITERATION \ register int ma, mi; \ for (ma = 0; ma < sizeof(PTY_MAJOR) - 1; ma++) \ for (mi = 0; mi < sizeof(PTY_MINOR) - 1; mi++) #define PTY_NAME_SPRINTF \ sprintf (pty_name, "/dev/pty%c%c", PTY_MAJOR[ma], PTY_MINOR[mi]); #define PTY_TTY_NAME_SPRINTF \ sprintf (pty_name, "/dev/tty%c%c", PTY_MAJOR[ma], PTY_MINOR[mi]); emacs-19.30/src/m/tad68k.h100444 75424 13 10320 6045454106 13355 0ustar kwzhuser/* Machine-dependent configuration for GNU Emacs for Tadpole 68k machines Copyright (C) 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-3" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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 */ /* 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 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 */ /* Karl Kleinpaste says this isn't needed. */ /* 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. */ /* SysV has alloca in the PW library */ #define LIB_STANDARD -lPW -lc #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 */ /* Use Terminfo, not Termcap. */ #define TERMINFO /* TPIX extras */ #define TPIX /* used in various source files */ #define BSTRING /* we do have the BSTRING functions */ #define CLASH_DETECTION /* we want to know about clashes */ #undef ADDR_CORRECT /* don't need this bug fix */ #define fchmod /* we don't have fchmod() */ #define SECTION_ALIGNMENT (2048-1) /* 2k boundaries required in unexec */ #define SEGMENT_MASK (128*1024-1) /* 128k offsets required in unexec */ #define C_DEBUG_SWITCH -O /* build with -O (TPIX has GCC 1.34) */ #define BROKEN_TIOCGWINSZ /* Don't try to use TIOCGWINSZ. */ /* omit next four lines if no TCP installed */ #define select gnu_select /* avoid select() name clash */ #define HAVE_PTYS /* we do have PTYs if we have TCP */ #define HAVE_SOCKETS /* we do have sockets if we have TCP */ #define LIBS_SYSTEM -lsocket /* get TCP networking functions */ emacs-19.30/src/m/tahoe.h100444 75424 13 3645 6045454107 13351 0ustar kwzhuser/* machine description file for tahoe. Copyright (C) 1985 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START Use -opsystem=bsd4-2 or -opsystem=bsd4-3, depending on the version of Berkeley you are running. NOTE-END */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_BIG_ENDIAN /* XINT must explicitly sign-extend */ #define EXPLICIT_SIGN_EXTEND /* Say this machine is a tahoe */ #ifndef tahoe #define tahoe #endif /* not tahoe */ /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* crt0.c should use the vax-bsd style of entry, with no dummy args. */ #define CRT0_DUMMIES /* crt0.c should define a symbol `start' and do .globl with a dot. */ #define DOT_GLOBAL_START /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) /* This triggers some stuff to avoid a compiler bug */ #define TAHOE_REGISTER_BUG /* System provides alloca. */ #define HAVE_ALLOCA emacs-19.30/src/m/tandem-s2.h100444 75424 12 1313 5637122414 14154 0ustar kwzhstaff/* machine description file for the Tandem Integrity S2. */ #include "mips.h" /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-3" */ /* This overrides some of the usual support for the mips and system V.3. */ /* The operating system apparently defines TIOCGETC but it doesn't work. */ #undef BROKEN_TIOCGETC /* rs@ai.mit.edu said this was necessary for it to work. However, some user of this machine ought to try to get subprocesses to work. */ #undef subprocesses /* Correct some library file names. */ #define START_FILES pre-crt0.o /usr/lib/crt1.o1.31 #define LIB_STANDARD -lbsd -lc /usr/lib/crtn.o1.31 emacs-19.30/src/m/targon31.h100444 75424 13 6715 6045454112 13704 0ustar kwzhuser/* targon31 machine description file 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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: vax, m68000, ns16000, pyramid, orion, tahoe and APOLLO are the ones defined so far. */ /* #define m68k is defined by the Compiler */ /* #define m68000 */ /* 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 double */ /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0) /* 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 */ /* Supposedly NO_REMAP is not needed with the following change. */ #define SEGMENT_MASK 0xffff #define SWITCH_ENUM_BUG 1 emacs-19.30/src/m/tek4300.h100444 75424 13 6257 6045454114 13343 0ustar kwzhuser/* machine description file for tek4300. Copyright (C) 1988 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-3" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #undef NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #undef WORD_MACHINE /* Now define a symbol for the cpu type, if your compiler does not define it automatically. */ #ifndef tek4300 #define tek4300 #endif /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* 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 LOAD_AVE_CVT(x) (x) /* 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 /* Define C_ALLOCA if this machine does not support a true alloca and the one written in C should be used instead. */ #define C_ALLOCA /* setjmp and longjmp can safely replace _setjmp and _longjmp, */ #define _longjmp longjmp #define _setjmp setjmp /* The text segment always starts at a fixed address. This way we don't need to have a label _start defined. */ #define TEXT_START 0 /* The Tektronix exec struct for ZMAGIC files is struct zexec */ #define EXEC_HDR_TYPE struct zexec /* The entry-point label (start of text segment) is `start', not `__start'. */ #define DEFAULT_ENTRY_ADDRESS start /* Use the system's malloc calls, gmalloc.c won't work for us. */ #define SYSTEM_MALLOC /* In building xmakefile, "cc -E -g" forcibly reads from stdin. Since we can't remove the CFLAGS from that "cc -E" invocation, make sure we never pass -g. If you want to debug, remove the following, and fix src/Makefile.in so it doesn't pass ${CFLAGS} when creating xmakefile. */ #define C_DEBUG_SWITCH /* eirik@elf.ithaca.ny.us said this was needed in 19.22. */ #define NO_MODE_T /* Process groups work in the traditional BSD manner. */ #define BSD_PGRPS emacs-19.30/src/m/tekxd88.h100444 75424 13 12101 6045454126 13554 0ustar kwzhuser/* Configuration file for the Tektronix XD88 running UTekV 3.2e, contributed by Kaveh Ghazi (ghazi@caip.rutgers.edu) 1/15/93. You probably need to use gnu make (version 3.63 or higher.) Copyright (C) 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. */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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 */ #ifndef m88000 /* Some 88k C compilers already define this */ #define m88000 #endif /* Define how to take a char and sign-extend into an int. On machines where char is signed, this is a no-op. */ #define SIGN_EXTEND_CHAR(c) (c) /* 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 double */ /* No load average on XD88. */ /* Convert that into an integer that is 100 for a load average of 1.0 */ /* #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) */ /* 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 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 /* 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. */ #ifdef __GNUC__ # define alloca __builtin_alloca /* Use the gcc builtin alloca() ... */ # define HAVE_ALLOCA /* ... and be sure that no other ones are tried out. */ # undef C_ALLOCA # define C_OPTIMIZE_SWITCH -O2 #else /* not __GNUC__ */ # undef HAVE_ALLOCA # define C_ALLOCA /* Use the alloca() supplied in alloca.c. */ # define STACK_DIRECTION -1 /* The stack grows towards lower addresses. */ # define C_OPTIMIZE_SWITCH -O #endif /* __GNUC__ */ #undef NOMULTIPLEJOBS /* we have job control */ #define HAVE_SOCKETS /* sockets are available */ #define BROKEN_FIONREAD /* is this needed ? */ #define BSTRING /* its in libc but not declared in any header file. */ #undef sigsetmask /* XD88 has sigsetmask() */ #undef LIB_X11_LIB /* Don't use shared libraries defined in usg5-3.h */ #undef LIBX11_SYSTEM #define HAVE_TERMIOS /* We have termios. */ #undef HAVE_TERMIO /* Make sure termios ifdef code is used, not termio. */ #define NO_TERMIO /* Don't include both termios.h and termio.h */ #define HAVE_PTYS /* XD88 SysV has PTYs. */ #define SYSV_PTYS /* Requires */ #ifdef ghs /* Stands for "Green Hills Software", defined only in /bin/cc */ /* -X18 means do not allocate programmer-defined local variables to a register unless they are declared register. (Copied from perl-4.036 Green Hills C hints file. Might be needed for setjmp, I don't know.) */ # define C_SWITCH_MACHINE -X18 /* We need /lib/default.ld so that /bin/ld can read its link directives. */ # define LD_SWITCH_SYSTEM /lib/default.ld #endif /* ghs */ /* We need this to get dumping to work */ #define KEEP_OLD_TEXT_SCNPTR emacs-19.30/src/m/template.h100444 75424 13 10345 6045454130 14073 0ustar kwzhuser/* machine description file template. 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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 */ /* 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 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 /* Some really obscure 4.2-based systems (like Sequent DYNIX) * do not support asynchronous I/O (using SIGIO) on sockets, * even though it works fine on tty's. If you have one of * these systems, define the following, and then use it in * config.h (or elsewhere) to decide when (not) to use SIGIO. * * You'd think this would go in an operating-system description file, * but since it only occurs on some, but not all, BSD systems, the * reasonable place to select for it is in the machine description * file. */ #define NO_SOCK_SIGIO /* After adding support for a new system, modify the large case statement in the `configure' script to recognize reasonable configuration names, and add a description of the system to `etc/MACHINES'. If you've just fixed a problem in an existing configuration file, you should also check `etc/MACHINES' to make sure its descriptions of known problems in that configuration should be updated. */ emacs-19.30/src/m/tower32.h100444 75424 13 7521 6045454132 13551 0ustar kwzhuser/* machine description file for the NCR Tower 32 running System V.2. Copyright (C) 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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: vax, m68000, ns16000, pyramid, orion, tahoe and APOLLO are the ones defined so far. */ #define m68000 /* 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 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 /* Change some things to avoid bugs in compiler */ #define SWITCH_ENUM_BUG 1 /* The standard C library is -lcieee, not -lc. Also use the PW library, which contains alloca. */ #define LIB_STANDARD -lPW -lcieee /* crt0.c should use the vax-bsd style of entry. Beware that if you have OS release 2.00.00 or later, *and* change src/ymakefile so that CFLAGS includes C_OPTIMIZE_SWITCH rather than C_DEBUG_SWITCH, you need to uncomment CRT0_DUMMIES and C_OPTIMIZE_SWITCH below. */ /* With the optimizer OFF */ #define CRT0_DUMMIES zero, bogus_fp, /* With the optimizer ON */ /* #define CRT0_DUMMIES */ /* #define C_OPTIMIZE_SWITCH -O2 */ /* emacs's magic number isn't temacs's; temacs is writeable text (the default!). */ #include #define EXEC_MAGIC AOUT1MAGIC #define EXEC_PAGESIZE DATACLICK emacs-19.30/src/m/tower32v3.h100444 75424 13 7775 6045454134 14037 0ustar kwzhuser/* machine description file for the NCR Tower 32 running System V.3. Copyright (C) 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-3" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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: vax, m68000, ns16000, pyramid, orion, tahoe and APOLLO are the ones defined so far. */ #define m68000 /* 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 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 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. */ #ifdef __GNUC__ #define HAVE_ALLOCA #define alloca __builtin_alloca #define C_OPTIMIZE_SWITCH -O -fstrength-reduce -fomit-frame-pointer #define LIB_STANDARD -lc /lib/crtn.o #else /* This section is correct if you do *not* change src/ymakefile so that CFLAGS includes C_OPTIMIZE_SWITCH rather than C_DEBUG_SWITCH. */ #define HAVE_ALLOCA #define C_DEBUG_SWITCH -g -O0 #define LIB_STANDARD -lc -lPW /lib/crtn.o /* This section is correct if you do enable C_OPTIMIZE_SWITCH. */ /* #define C_ALLOCA */ /* #define STACK_DIRECTION -1 */ /* #define C_OPTIMIZE_SWITCH -O2 */ /* #define LIB_STANDARD -lc /lib/crtn.o */ #endif /* The OS maps the data section far away from the text section. */ #define NO_REMAP #define TEXT_START 0 #undef static #define START_FILES pre-crt0.o /lib/crt1.o /* The OS has an implementation of symlinks that is semantically different from BSD, but for some silly reason it partly has the same syntax. */ #undef S_IFLNK /* The OS needs stream.h+ptem.h included in sysdep.c. */ #define NO_SIOCTL_H #define NEED_PTEM_H emacs-19.30/src/m/ustation.h100444 75424 13 10357 6045454137 14140 0ustar kwzhuser/* machine description file for U-station (Nihon Unisys, SS5E; Sumitomo Denkoh, U-Station E30). Copyright (C) 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-3" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #undef NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #undef WORD_MACHINE /* Now define a symbol for the cpu type, if your compiler does not define it automatically: vax, m68000, ns16000, pyramid, orion, tahoe and APOLLO are the ones defined so far. */ /* Masscomp predefines mc68000. */ #define m68000 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. */ #undef EXPLICIT_SIGN_EXTEND /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) /* 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. */ #undef 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 data space precedes text space, numerically. */ #undef 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. */ /* On return from a subroutine, the 68020 compiler restores old contents of register variables relative to sp, so alloca() screws up such routines. The following definitions should work on all Masscomps. On the MC-5500 (a 68000) one can #undef C_ALLOCA and #define HAVE_ALLOCA. */ #define C_ALLOCA #undef 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. */ #undef NO_REMAP /* Name of file the to look in for the kernel symbol table (for load average) */ #define KERNEL_FILE "/unix" /* This triggers some stuff to avoid a compiler bug */ #define MASSC_REGISTER_BUG /* Prevent -lg from being used for debugging. Not implemented? */ #define LIBS_DEBUG /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIO /* -lnet is not standard library */ #undef LIBS_SYSTEM /* Compiler's bug */ #define SWITCH_ENUM_BUG /* Termcap is available */ #define LIBS_TERMCAP -ltermcap #define EXEC_PAGESIZE 1024 #define PURESIZE 130000 #undef SIGIO #undef SIGTSTP emacs-19.30/src/m/vax.h100444 75424 13 5726 6045454141 13047 0ustar kwzhuser/* machine description file for vax. 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="note" NOTE-START The vax (-machine=vax) runs zillions of different operating systems. Vax running Berkeley Unix (-opsystem=bsd4-1, -opsystem=bsd4-2 or -opsystem=bsd4-3) Works. Vax running Ultrix (-opsystem=bsd4-2) Works. See under Ultrix in share-lib/MACHINES for problems using X windows on Ultrix. Vax running System V rel 2 (-opsystem=usg5-2) 18.27 Works. Vax running System V rel 0 (-opsystem=usg5-0) Works as of 18.36. Vax running VMS (-opsystem=vms) 18.36 believed to work. Addition of features is necessary to make this Emacs version more usable. NOTE-END */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef WORDS_BIG_ENDIAN /* #define vax -- appears to be done automatically */ /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* crt0.c should use the vax-bsd style of entry, with no dummy args. */ #define CRT0_DUMMIES /* crt0.c should define a symbol `start' and do .globl with a dot. */ #define DOT_GLOBAL_START #ifdef BSD /* USG systems I know of running on Vaxes do not actually support the load average, so disable it for them. */ /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) #endif /* BSD */ #ifdef VMS /* Data type of load average, as read out of driver. */ #define LOAD_AVE_TYPE float /* Convert that into an integer that is 100 for a load average of 1.0 */ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) #endif /* VMS */ /* Vax sysV has alloca in the PW library. */ #ifdef USG #define LIB_STANDARD -lPW -lc #define HAVE_ALLOCA /* There is some bug in unexec in for usg 5.2 on a vax which nobody who runs such a system has yet tracked down. */ #ifndef USG5_0 #define NO_REMAP #endif /* USG 5_0 */ #define TEXT_START 0 #endif /* USG */ #ifdef BSD #define HAVE_ALLOCA #endif /* BSD */ #ifdef VMS #define C_ALLOCA #endif #ifdef BSD4_2 #define HAVE_FTIME #endif emacs-19.30/src/m/wicat.h100444 75424 13 10432 6045454143 13370 0ustar kwzhuser/* machine description file for WICAT machines. Copyright (C) 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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. */ #undef NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #undef WORD_MACHINE /* Now define a symbol for the cpu type, if your compiler does not define it automatically: vax, m68000, ns16000 are the ones defined so far. */ #ifndef m68000 #define m68000 #endif /* This flag is used only in alloca.s. */ #define WICAT /* Use type int rather than a union, to represent Lisp_Object */ #define NO_UNION_TYPE /* XINT must explicitly sign-extend */ #define EXPLICIT_SIGN_EXTEND /* Data type of load average, as read out of kmem. */ #undef LOAD_AVE_TYPE /* Convert that into an integer that is 100 for a load average of 1.0 */ #undef LOAD_AVE_CVT /* 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. */ #undef 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. */ #undef 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. */ /* For the Wicat C compiler version 4.2, this can be removed and the alloca in alloca.s used. */ #define C_ALLOCA #define STACK_DIRECTION -1 /* grows towards lower addresses on WICAT */ /* 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. */ #undef NO_REMAP /* For WICAT, define TAHOE_REGISTER_BUG if you have a pre-4.2 C compiler */ #define TAHOE_REGISTER_BUG /* pagesize definition */ #define EXEC_PAGESIZE 0x1000 /* Delete this for WICAT sys V releases before 2.0. */ #define LIB_STANDARD -lc-nofp /* Special magic number */ #define EXEC_MAGIC MC68ROMAGIC /* Special switches to give to ld. */ #define LD_SWITCH_MACHINE -e __start -N /* Sigh...cannot define this for WICAT cuz 0 length memcpy blows chunks */ #undef BSTRING #ifdef BSTRING #undef bcopy #undef bzero #undef bcmp #define bcopy(a,b,s) memcpy(b,a,s) #define bzero(a,s) memset(a,0,s) #define bcmp memcmp #endif /* * Define optimflags if you want to optimize. * - Set to null string for pre-4.2 C compiler * - Set to "-O -Wopt,-O-f" for 4.2 */ #define C_OPTIMIZE_SWITCH /* -O -Wopt,-O-f */ /* For WICAT version supporting PTYs and select (currently internal only) */ #ifdef HAVE_PTYS #undef FIRST_PTY_LETTER #define FIRST_PTY_LETTER 'q' #endif /* there is a select() in libcurses.a that causes a conflict so use termlib */ #ifdef HAVE_SELECT #undef TERMINFO #define LIBS_TERMCAP select.o -ltermlib #endif emacs-19.30/src/m/windowsnt.h100444 75424 13 10745 6045454146 14327 0ustar kwzhuser/* Machine description file for Windows NT. Copyright (C) 1993, 1994 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="" */ /* 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 */ /* 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 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 1 #define CANNOT_UNEXEC 1 */ /* Start and end of text and data. */ #define DATA_END get_data_end () #define DATA_START get_data_start () /* 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. */ /* Text does preceed data space, but this is never a safe assumption. */ #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 */ #include #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 */ /* Some really obscure 4.2-based systems (like Sequent DYNIX) * do not support asynchronous I/O (using SIGIO) on sockets, * even though it works fine on tty's. If you have one of * these systems, define the following, and then use it in * config.h (or elsewhere) to decide when (not) to use SIGIO. * * You'd think this would go in an operating-system description file, * but since it only occurs on some, but not all, BSD systems, the * reasonable place to select for it is in the machine description * file. */ /* #define NO_SOCK_SIGIO */ /* After adding support for a new system, modify the large case statement in the `configure' script to recognize reasonable configuration names, and add a description of the system to `etc/MACHINES'. If you've just fixed a problem in an existing configuration file, you should also check `etc/MACHINES' to make sure its descriptions of known problems in that configuration should be updated. */ emacs-19.30/src/m/xps100.h100444 75424 13 6770 6045454150 13304 0ustar kwzhuser/* xps100.h for the Honeywell XPS100 running UNIX System V.2 Mark J. Hewitt (mjh@uk.co.kernel) 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 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. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-2" */ /* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define WORDS_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 */ /* 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 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 #define STACK_DIRECTION -1 #define TERMINFO #define SWITCH_ENUM_BUG #define LIB_STANDARD -lc #define LD_SWITCH_MACHINE -X #define SECTION_ALIGNMENT (0x3ff) emacs-19.30/src/m/ibmrs6000.inp100666 12120 1 21 5625713317 14225 0ustar rmsdaemon#! pthread_yield emacs-19.30/src/s/ 40777 12120 1 0 6055530664 12053 5ustar rmsdaemonemacs-19.30/src/s/README100666 13437 1 623 5174232335 13140 0ustar jimbdaemonThis directory contains C header files containing operating-system-specific definitions. Each file describes a particular operating system. The emacs configuration script edits ../config.h to include the appropriate one of these files, and then each emacs source file includes config.h. template.h is a generic template for system descriptions; it describes the parameters a system file can specify. emacs-19.30/src/s/3700.h100444 12241 12 0 5444561054 13154 0ustar rolandstaffemacs-19.30/src/s/386-ix.h100444 75424 12 577 5637122412 13317 0ustar kwzhstaff/* Interactive 386/ix. */ #include "usg5-3.h" #define BROKEN_TIOCGETC /* There are some reports that the following is needed with some version of this system. #undef LIBX11_SYSTEM #define LIBX11_SYSTEM -linet */ /* This is said to be needed as a result of having _insque rather than insque in -loldX. This may not always be the right thing. */ #define WRONG_NAME_INSQUE emacs-19.30/src/s/386bsd.h100444 12120 1 1146 6024444657 13330 0ustar rmsdaemon/* s/ file for 386bsd system. */ /* Get most of the stuff from bsd4.3 */ #include "bsd4-3.h" #undef LIB_STANDARD #define LIB_STANDARD -lc $(GNULIB_VAR) /* The following should be set to /netbsd if you are running netbsd > 0.8 Or just link /netbsd -> /386bsd */ #undef KERNEL_FILE #define KERNEL_FILE "/386bsd" #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) /* Need to use GNU make, as system make has problems */ #define MAKE_COMMAND gmake #define LIBS_DEBUG /* For mem-limits.h. */ #define BSD4_2 /* This affects a declaration in xrdb.c. */ #define DECLARE_GETPWUID_WITH_UID_T emacs-19.30/src/s/aix3-1.h100444 12120 1 13673 6015656241 13343 0ustar rmsdaemon/* Definitions file for GNU Emacs running on IBM AIX version 3.1 Copyright (C) 1985, 1986, 1990 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #define USG /* System III, System V, etc */ #define USG5 /* Specify IBM AIX version of system */ #ifndef AIX #define AIX #endif /* turn off c prototypes */ #ifndef _NO_PROTO #define _NO_PROTO #endif /* This symbol should be defined on AIX Version 3 ??????? */ #ifndef _AIX #define _AIX #endif /* Specify "_BSD" to invoke Berkeley compatibility in header files */ /*#ifndef _BSD #define _BSD #endif */ /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "aix" /* nomultiplejobs should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ /* #define NOMULTIPLEJOBS */ /* Default is to set interrupt_input to 0: don't do input buffering within Emacs */ /* #define INTERRUPT_INPUT */ /* In AIX, you allocate a pty by opening /dev/ptc to get the master side. To get the name of the slave side, you just ttyname() the master side. */ #define PTY_ITERATION for (c = 0; !c ; c++) #define PTY_NAME_SPRINTF strcpy (pty_name, "/dev/ptc"); #define PTY_TTY_NAME_SPRINTF strcpy (pty_name, ttyname (fd)); /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIOS /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ #define HAVE_SOCKETS /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ /* #define NONSYSTEM_DIR_LIBRARY */ /* * Define SYSV_SYSTEM_DIR to use the V.3 getdents/readir * library functions. Almost, but not quite the same as * the 4.2 functions */ #define SYSV_SYSTEM_DIR /* Define this symbol if your system has the functions bcopy, etc. */ #define BSTRING /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is supposed to work now on system V release 2. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* #define COFF */ /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* Define SHORTNAMES if the C compiler can distinguish only short names. It means that the stuff in ../shortnames must be run to convert the long names to short ones. */ /* #define SHORTNAMES */ /* We do NOT use the Berkeley (and usg5.2.2) interface to nlist. */ /* #define NLIST_STRUCT */ /* The file containing the kernel's symbol table is called /unix. */ #define KERNEL_FILE "/unix" /* The symbol in the kernel where the load average is found is named avenrun. */ #define LDAV_SYMBOL "avenrun" /* Special itemss needed to make Emacs run on this system. */ /* * Make the sigsetmask function go away. Don't know what the * ramifications of this are, but doesn't seem possible to * emulate it properly anyway at this point. */ #define sigsetmask(mask) /* Null expansion */ /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp #define _longjmp longjmp /* On USG systems the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define open sys_open #define write sys_write #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_IO /* On USG systems these have different names */ #define index strchr #define rindex strrchr /* USG systems tend to put everything declared static into the initialized data area, which becomes pure after dumping Emacs. Foil this. Emacs carefully avoids static vars inside functions. */ #undef static /* Compiler bug bites on many systems when default ADDR_CORRECT is used. */ /* #define ADDR_CORRECT(x) (x) */ #ifndef __GNUC__ #define LINKER cc #endif /* Prevent -lg from being used for debugging. Not needed. */ #define LIBS_DEBUG /* No need to specify -lc when linking. */ #define LIB_STANDARD /* Use terminfo instead of termcap. */ #define TERMINFO /* The following definition seems to be needed in AIX version 3.1.6.8. It may not have been needed in certain earlier versions. */ #define HAVE_TCATTR #define SYSTEM_MALLOC /* Include unistd.h, even though we don't define POSIX. */ #define NEED_UNISTD_H /* AIX doesn't define this. */ #define unix 1 /* AIX 3.1 has the HFT features. */ #define AIXHFT emacs-19.30/src/s/aix3-2-5.h100444 12120 1 1310 6015655123 13445 0ustar rmsdaemon/* s- file for building Emacs on AIX 3.2.5. */ #include "aix3-2.h" /* For AIX, it turns out compiling emacs under AIX 3.2.4 REQUIRES "cc -g" because "cc -O" crashes. Under AIX 3.2.5, "cc -O" is required because "cc -g" crashes. Go figure. --floppy@merlin.mit.edu */ #ifndef __GNUC__ #undef C_DEBUG_SWITCH #undef C_OPTIMIZE_SWITCH #define C_DEBUG_SWITCH -O #define C_OPTIMIZE_SWITCH -O #endif /* Perry Smith says these are correct. */ #define SIGNALS_VIA_CHARACTERS #define MAIL_USE_LOCKF #define CLASH_DETECTION /* Perry Smith says these are correct. */ #define POSIX_SIGNALS #undef sigmask #undef sigsetmask #undef _setjmp #undef _longjmp emacs-19.30/src/s/aix3-2.h100444 75424 13 1760 5535404370 13256 0ustar kwzhuser/* s- file for building Emacs on AIX 3.2. */ #include "aix3-1.h" #define AIX3_2 /* No need to define this--the header files indicate X11R4, and that's supposedly what 3.2 will come with. */ #undef SPECIFY_X11R4 #ifndef __GNUC__ /* Some programs in src produce warnings saying certain subprograms are to comples and need a MAXMEM value greater than 2000 for additional optimization. --nils@exp-math.uni-essen.de */ #define C_SWITCH_SYSTEM -ma -qmaxmem=4000 #endif #define HAVE_ALLOCA #undef rindex #undef index #define HAVE_FSYNC /* With this defined, a gcc-compiled Emacs crashed in realloc under AIX 3.2, and a cc-compiled Emacs works with this undefined. --karl@cs.umb.edu. */ #undef SYSTEM_MALLOC /* For AIX, it turns out compiling emacs under AIX 3.2.4 REQUIRES "cc -g" because "cc -O" crashes. Under AIX 3.2.5, "cc -O" is required because "cc -g" crashes. Go figure. --floppy@merlin.mit.edu */ #ifndef __GNUC__ #define C_SWITCH_DEBUG -g #define C_SWITCH_OPTIMIZE #endif emacs-19.30/src/s/aix4-1.h100444 12120 1 515 6015654610 13271 0ustar rmsdaemon#define AIX4_1 #include "aix4.h" #if 0 /* Tomotake FURUHATA says this is needed in Mule, but we don't know why. Anyway, it's not needed now. */ #define SYSTEM_MALLOC #endif /* olson@mcs.anl.gov says -li18n is needed by -lXm. */ #define LIB_MOTIF -lXm -li18n #ifdef __GNUC__ #undef _NO_PROTO #endif emacs-19.30/src/s/aix4.h100444 12120 1 134 6015654662 13137 0ustar rmsdaemon#define AIX4 #include "aix3-2-5.h" /* AIX 4 does not have HFT any more. */ #undef AIXHFT emacs-19.30/src/s/alliant-2800.h100444 13437 1 0 5266607437 14376 0ustar jimbdaemonemacs-19.30/src/s/alliant.h100444 13437 1 0 5266607445 14006 0ustar jimbdaemonemacs-19.30/src/s/altos.h100444 13437 1 0 5266607453 13503 0ustar jimbdaemonemacs-19.30/src/s/amdahl.h100444 13437 1 0 5266607460 13605 0ustar jimbdaemonemacs-19.30/src/s/bsd386.h100444 12120 1 2070 6024444662 13321 0ustar rmsdaemon/* s/ file for bsd386 system. */ #include "bsd4-3.h" #ifndef __bsdi__ #define __bsdi__ 1 #endif #define DECLARE_GETPWUID_WITH_UID_T #define SIGNALS_VIA_CHARACTERS #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) #define A_TEXT_OFFSET(x) (sizeof (struct exec)) #define A_TEXT_SEEK(hdr) (N_TXTOFF(hdr) + A_TEXT_OFFSET(hdr)) #define LIBS_DEBUG #define LIB_X11_LIB -L/usr/X11/lib -lX11 #define LIBS_SYSTEM -lutil -lkvm -lcompat #define HAVE_GETLOADAVG #undef BSD_PGRPS /* System uses OXTABS instead of the expected TAB3. (Copied from netbsd.h.) */ #define TABDLY OXTABS #define TAB3 OXTABS #define SYSV_SYSTEM_DIR #define HAVE_TERMIOS #define NO_TERMIO /* This silences a few compilation warnings. */ #ifdef emacs #undef BSD #include /* To get BSD defined consistently. */ #endif #define WAITTYPE int /* get this since it won't be included if WAITTYPE is defined */ #ifdef emacs #include #endif #define WRETCODE(w) WEXITSTATUS(w) #ifndef WCOREDUMP #define WCOREDUMP(w) ((w) & 0200) #endif #define GETPGRP_NO_ARG 1 emacs-19.30/src/s/bsd4-1.h100444 75424 12 7046 5637122412 13371 0ustar kwzhstaff/* Definitions file for GNU Emacs running on bsd 4.1. 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 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #define BSD4_1 #define BSD /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "berkeley-unix" /* nomultiplejobs should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ /* #define NOMULTIPLEJOBS */ /* Default is to set interrupt_input to 1: do input buffering within Emacs */ #define INTERRUPT_INPUT /* First pty name is /dev/ptyp0. */ #define FIRST_PTY_LETTER 'p' /* * Define HAVE_PTYS if the system supports pty devices. */ /* #define HAVE_PTYS */ /* Define this macro if system defines a type `union wait'. */ #define HAVE_UNION_WAIT /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ /* #define HAVE_SOCKETS */ /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ #define NONSYSTEM_DIR_LIBRARY /* Define this symbol if your system has the functions bcopy, etc. */ /* #define BSTRING */ /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* #define COFF */ /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ #undef CLASH_DETECTION /* Might work; not tried yet. */ /* We use the Berkeley (and usg5.2.2) interface to nlist. */ #define NLIST_STRUCT /* The file containing the kernel's symbol table is called /vmunix. */ #define KERNEL_FILE "/vmunix" /* The symbol in the kernel where the load average is found is named _avenrun. */ #define LDAV_SYMBOL "_avenrun" /* Special hacks needed to make Emacs run on this system. */ /* Make the function `signal' act as in 4.2. */ #define signal sigset #define _longjmp longjmp #define _setjmp setjmp #define lstat stat /* sys_open handles the necessary 4.2 features for open. */ #define open sys_open /* Names of flags for open. */ #define O_RDONLY 0 #define O_WRONLY 1 #define O_RDWR 2 #define O_EXCL 2000 #define O_CREAT 1000 /* Special library needed for linking for 4.1. */ #define LIBS_SYSTEM -ljobs emacs-19.30/src/s/bsd4-2.h100444 75424 12 6460 5637122412 13371 0ustar kwzhstaff/* Definitions file for GNU Emacs running on bsd 4.2 Copyright (C) 1985, 1986, 1994 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #ifndef BSD4_2 #define BSD4_2 1 #endif /* BSD4_2 */ #ifndef BSD #define BSD 42 #endif /* BSD */ /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "berkeley-unix" /* nomultiplejobs should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ /* #define NOMULTIPLEJOBS */ /* Default is to set interrupt_input to 1: do input buffering within Emacs */ #define INTERRUPT_INPUT /* First pty name is /dev/ptyp0. */ #define FIRST_PTY_LETTER 'p' /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* Define this macro if system defines a type `union wait'. */ #define HAVE_UNION_WAIT /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ #define HAVE_SOCKETS /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ /* #define NONSYSTEM_DIR_LIBRARY */ /* Define this symbol if your system has the functions bcopy, etc. */ #define BSTRING /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* #define COFF */ /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ #define CLASH_DETECTION /* We use the Berkeley (and usg5.2.2) interface to nlist. */ #define NLIST_STRUCT /* The file containing the kernel's symbol table is called /vmunix. */ #define KERNEL_FILE "/vmunix" /* The symbol in the kernel where the load average is found is named _avenrun. */ #define LDAV_SYMBOL "_avenrun" /* Send signals to subprocesses by "typing" special chars at them. */ #define SIGNALS_VIA_CHARACTERS /* We do have vfork. */ #define HAVE_VFORK /* Process groups work in the traditional BSD manner. */ #define BSD_PGRPS emacs-19.30/src/s/bsd4-3.h100444 75424 12 6555 5637122411 13376 0ustar kwzhstaff/* Definitions file for GNU Emacs running on bsd 4.3 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 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ /* We give these symbols the numeric values found in to avoid warnings about redefined macros. */ #ifndef BSD4_3 #define BSD4_3 1 #endif /* BSD4_3 */ #ifndef BSD #define BSD 43 #endif /* BSD */ /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "berkeley-unix" /* nomultiplejobs should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ /* #define NOMULTIPLEJOBS */ /* Do not use interrupt_input = 1 by default, because in 4.3 we can make noninterrupt input work properly. */ #undef INTERRUPT_INPUT /* First pty name is /dev/ptyp0. */ #define FIRST_PTY_LETTER 'p' /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* Define this macro if system defines a type `union wait'. */ #define HAVE_UNION_WAIT /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ #define HAVE_SOCKETS /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ /* #define NONSYSTEM_DIR_LIBRARY */ /* Define this symbol if your system has the functions bcopy, etc. */ #define BSTRING /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* #define COFF */ /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ #define MAIL_USE_FLOCK /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ #define CLASH_DETECTION /* We use the Berkeley (and usg5.2.2) interface to nlist. */ #define NLIST_STRUCT /* The file containing the kernel's symbol table is called /vmunix. */ #define KERNEL_FILE "/vmunix" /* The symbol in the kernel where the load average is found is named _avenrun. */ #define LDAV_SYMBOL "_avenrun" /* Send signals to subprocesses by "typing" special chars at them. */ #define SIGNALS_VIA_CHARACTERS /* We do have vfork. */ #define HAVE_VFORK emacs-19.30/src/s/bsdos2.h100666 12120 1 302 5752767673 13507 0ustar rmsdaemon/* s/ file for BSDI BSD/OS 2.x system. */ #include "bsd386.h" #define TEXT_START 0x1020 /* for QMAGIC */ #define START_FILES pre-crt0.o /usr/lib/crt0.o #define HAVE_TERMIOS #define NO_TERMIO emacs-19.30/src/s/cxux.h100444 75424 12 16024 5637122411 13401 0ustar kwzhstaff/* Header file for Harris CXUX. Copyright (C) 1994 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ /* #define UNIPLUS */ #define USG5 #define USG /* #define HPUX */ /* #define UMAX */ /* #define BSD4_1 */ /* #define BSD4_2 */ /* #define BSD4_3 */ /* #define BSD */ /* #define VMS */ #ifndef _CX_UX #define _CX_UX 1 #endif /* Define this symbol if you are running CX/UX 7.0 or later (7.0 introduced * support for ELF files, and while we still build emacs in COFF format, the * way it is linked is different for 7.0). */ /* #define USING_CX_UX_7 */ #ifdef USING_CX_UX_7 #define LINKER /usr/sde/coff/usr/bin/ld #define LD_SWITCH_SYSTEM -L/usr/sde/coff/usr/lib -zzero_word #define START_FILES pre-crt0.o /usr/sde/coff/usr/lib/crt0.o /usr/sde/coff/usr/lib/m88100.o #else /* !USING_CX_UX_7 */ #ifdef _M88K #define START_FILES pre-crt0.o /lib/crt0.o #else #define START_FILES cxux-crt0.o /lib/crt0.o #endif #endif /* USING_CX_UX_7 */ /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "usg-unix-v" #define C_SWITCH_SYSTEM -Xa #define POSIX_SIGNALS /* With POSIX signals, also need to use sigaction rather than signal to * setup signal handlers */ #define signal sys_signal /* NOMULTIPLEJOBS should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ /* #define NOMULTIPLEJOBS */ /* Emacs can read input using SIGIO and buffering characters itself, or using CBREAK mode and making C-g cause SIGINT. The choice is controlled by the variable interrupt_input. Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO) Emacs uses the presence or absence of the SIGIO macro to indicate whether or not signal-driven I/O is possible. It uses INTERRUPT_INPUT to decide whether to use it by default. SIGIO can be used only on systems that implement it (4.2 and 4.3). CBREAK mode has two disadvatages 1) At least in 4.2, it is impossible to handle the Meta key properly. I hear that in system V this problem does not exist. 2) Control-G causes output to be discarded. I do not know whether this can be fixed in system V. Another method of doing input is planned but not implemented. It would have Emacs fork off a separate process to read the input and send it to the true Emacs process through a pipe. */ #define INTERRUPT_INPUT /* #define BROKEN_FIONREAD */ /* Letter to use in finding device name of first pty, if system supports pty's. 'a' means it is /dev/ptya0 */ #define FIRST_PTY_LETTER 'A' #define PTY_ITERATION for (c = 'A'; c <= 'P'; c++) for (i = 0; i < 16; i++) /* * Define HAVE_TERMIOS if the system provides POSIX-style * functions and macros for terminal control. * * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. * * Do not define both. HAVE_TERMIOS is prefered, if it is * supported on your system. */ #define HAVE_TERMIOS /* #define HAVE_TERMIO */ #define NO_TERMIO /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ /* #define NONSYSTEM_DIR_LIBRARY */ #define SYSV_SYSTEM_DIR /* Define this symbol if your system has the functions bcopy, etc. */ #define BSTRING /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ #define COFF /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ #define MAIL_USE_FLOCK /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ #define CLASH_DETECTION /* Define this if your operating system declares signal handlers to have a type other than the usual. `The usual' is `void' for ANSI C systems (i.e. when the __STDC__ macro is defined), and `int' for pre-ANSI systems. If you're using GCC on an older system, __STDC__ will be defined, but the system's include files will still say that signal returns int or whatever; in situations like that, define this to be what the system's include files want. */ /* #define SIGTYPE int */ #define SIGTYPE void /* If the character used to separate elements of the executable path is not ':', #define this to be the appropriate character constant. */ /* #define SEPCHAR ':' */ /* Here, on a separate page, add any special hacks needed to make Emacs work on this system. For example, you might define certain system call names that don't exist on your system, or that do different things on your system and must be used only through an encapsulation (Which you should place, by convention, in sysdep.c). */ /* Yes! The Night Hawk has sockets! */ #define HAVE_SOCKETS /* We use the Berkeley (and usg5.2.2) interface to nlist. */ #define NLIST_STRUCT /* The symbol in the kernel where the load average is found is named _avenrun. */ #define LDAV_SYMBOL "_avenrun" #define KERNEL_FILE "/unix" /* There are too many kludges required to redefine malloc - use the system one */ #define SYSTEM_MALLOC #define _setjmp setjmp #define _longjmp longjmp /* const really does work, but I can't get configure to run the C compiler * with the right options so it figures that out. */ #undef const #define HAVE_GETWD #ifdef sigmask #undef sigmask #endif /* * already declares getpwuid, and with a uid_t argument in ANSI C * mode. Define this so xrdb.c will compile */ #ifdef __STDC__ #define DECLARE_GETPWUID_WITH_UID_T #endif /* Some compilers tend to put everything declared static into the initialized data area, which becomes pure after dumping Emacs. On these systems, you must #define static as nothing to foil this. Note that emacs carefully avoids static vars inside functions. */ /* #define static */ emacs-19.30/src/s/cxux7.h100444 12120 1 361 5515152125 13341 0ustar rmsdaemon/* Define this symbol if you are running CX/UX 7.0 or later (7.0 introduced * support for ELF files, and while we still build emacs in COFF format, the * way it is linked is different for 7.0). */ #define USING_CX_UX_7 #include "cxux.h" emacs-19.30/src/s/dgux.h100444 12120 1 24527 6050677227 13316 0ustar rmsdaemon/* Definitions file for GNU Emacs running on Data General's DG/UX version 4.32 upto and including 5.4.1. Copyright (C) 1994 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ /* #define UNIPLUS */ /* #define USG5 */ /* #define USG */ /* #define HPUX */ /* #define UMAX */ /* #define BSD4_1 */ #define BSD4_2 #define BSD4_3 #define BSD4_4 #define BSD /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "dgux" /* NOMULTIPLEJOBS should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ /* #define NOMULTIPLEJOBS */ /* Emacs can read input using SIGIO and buffering characters itself, or using CBREAK mode and making C-g cause SIGINT. The choice is controlled by the variable interrupt_input. Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO) SIGIO can be used only on systems that implement it (4.2 and 4.3). CBREAK mode has two disadvantages 1) At least in 4.2, it is impossible to handle the Meta key properly. I hear that in system V this problem does not exist. 2) Control-G causes output to be discarded. I do not know whether this can be fixed in system V. Another method of doing input is planned but not implemented. It would have Emacs fork off a separate process to read the input and send it to the true Emacs process through a pipe. */ #define INTERRUPT_INPUT /* * Define HAVE_SOCKETS if the system supports sockets. */ #define HAVE_SOCKETS /* * Define HAVE_UNIX_DOMAIN if the system supports Unix * domain sockets. */ #define HAVE_UNIX_DOMAIN /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* (Assume) we do have vfork. */ #define HAVE_VFORK /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ /* #define NONSYSTEM_DIR_LIBRARY */ /* Define this symbol if your system has the functions bcopy, etc. */ #define BSTRING /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". DGUX can use either COFF or ELF; the default is ELF. To compile for COFF (or BCS) use the TARGET_BINARY_INTERFACE environment variable. */ #if defined(_DGUXCOFF_TARGET) || defined(_DGUXBCS_TARGET) #undef ELF #ifndef COFF #define COFF #endif /* COFF */ #else /* defined(_DGUXCOFF_TARGET) || defined(_DGUXBCS_TARGET) */ #undef COFF #ifndef ELF #define ELF #endif /* ELF */ #endif /* defined(_DGUXCOFF_TARGET) || defined(_DGUXBCS_TARGET) */ #ifndef COFF /* People will probably find this apparently unreliable till the NFS dumping bug is fixed. */ /* It is possible to undump to ELF with DG/UX 5.4, but for revisions below 5.4.1 the undump MUST be done on a local file system, or the kernel will panic. ELF executables have the advantage of using shared libraries, while COFF executables will still work on 4.2x systems. */ #define UNEXEC unexelf.o /* This makes sure that all segments in the executable are undumped, not just text, data, and bss. In the case of Mxdb and shared libraries, additional information is stored in other sections. It does not hurt to have this defined if you don't use Mxdb or shared libraries. In fact, it makes no difference. */ /* Necessary for shared libraries and Mxdb debugging information. */ #define USG_SHARED_LIBRARIES #endif /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* Define a replacement for the baud rate switch, since DG/UX uses a different from BSD. */ #define BAUD_CONVERT { 0, 110, 134, 150, 300, 600, 1200, 1800, 2400, \ 4800, 9600, 19200, 38400 } /* * Define NLIST_STRUCT if the system has nlist.h */ #define NLIST_STRUCT /* * Make WM Interface Compliant. */ #define XICCC /* Here, on a separate page, add any special hacks needed to make Emacs work on this system. For example, you might define certain system call names that don't exist on your system, or that do different things on your system and must be used only through an encapsulation (Which you should place, by convention, in sysdep.c). */ /* Some compilers tend to put everything declared static into the initialized data area, which becomes pure after dumping Emacs. On these systems, you must #define static as nothing to foil this. Note that emacs carefully avoids static vars inside functions. */ /* #define static */ /* DG/UX SPECIFIC ADDITIONS TO TEMPLATE FOLLOW: */ /* Use the Berkeley flavors of the library routines, instead of System V. */ #define setpgrp(pid,pgrp) setpgrp2(pid,pgrp) #define getpgrp(pid) getpgrp2(pid) /* Act like Berkeley. */ #define _setjmp(env) sigsetjmp(env,0) #define _longjmp(env,val) longjmp(env,val) /* Use TERMINFO instead of termcap */ #define TERMINFO /* * Send signals to subprocesses using characters. * */ #define SIGNALS_VIA_CHARACTERS /* * Define HAVE_TERMIOS since this is POSIX, * for terminal control. Prevent redundant inclusion of termio.h. */ #define HAVE_TERMIOS #define NO_TERMIO /* * Use a Berkeley style sys/wait.h. * This makes WIF* macros operate on structures instead of ints. */ #define _BSD_WAIT_FLAVOR /* * Use BSD and POSIX-style signals. This is crucial! */ /* #define SYSTEM_MALLOC */ /* MAKING_MAKEFILE must be defined in "ymakefile" before including config.h */ #ifndef NOT_C_CODE /* Make sure signal.h is included so macros below don't mess with it. */ /* DG/UX include files prevent multiple inclusion. */ #include /* but undefine the sigmask and sigpause macros since they will get #define'd later. */ #undef sigmask #undef sigpause #define POSIX_SIGNALS /* Define this if you use System 5 Release 4 Streams */ #define open sys_open #define close sys_close #define read sys_read #define write sys_write #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_CLOSE /* can't hurt to define these, even though read/write should auto restart */ #define INTERRUPTIBLE_IO /* Can't use sys_signal because then etc/server.c would need sysdep.o. */ extern struct sigaction act, oact; #define signal(SIG,FUNC) berk_signal(SIG,FUNC) #endif /* not NOT_C_CODE */ #ifndef __GNUC__ #error You must use GCC to compiler Emascs on DGUX #endif #define ORDINARY_LINK #define START_FILES pre-crt0.o #define LIB_GCC /usr/lib/gcc/libgcc.a #ifdef _M88KBCS_TARGET /* Karl Berry says: the environment recommended by gcc (88/open, a.k.a. m88kbcs) doesn't support some system functions, and gcc doesn't make it easy to switch environments. */ #define NO_GET_LOAD_AVG #endif /* definitions for xmakefile production */ #ifdef COFF /* Define the following to use all of the available pty's. */ #define PTY_ITERATION \ for (c = 'p'; c < 't'; c++) \ for (i = 0; (((c == 'p') && (i < 64)) || ((c != 'p') && (i < 16))); i++) #define PTY_NAME_SPRINTF \ if (c == 'p') \ sprintf (pty_name, "/dev/pty%c%d", c, i); \ else \ sprintf (pty_name, "/dev/pty%c%x", c, i); #define PTY_TTY_NAME_SPRINTF \ if (c == 'p') \ sprintf (pty_name, "/dev/tty%c%d", c, i); \ else \ sprintf (pty_name, "/dev/tty%c%x", c, i); #define C_DEBUG_SWITCH -g #else /* not COFF */ /* We are generating ELF object format. This makes the system more SVR4 like. */ #define SVR4 /* Pseudo-terminal support under SVR4 only loops to deal with errors. */ #define PTY_ITERATION for (i = 0; i < 1; i++) /* This sets the name of the master side of the PTY. */ #define PTY_NAME_SPRINTF strcpy (pty_name, "/dev/ptmx"); /* This sets the name of the slave side of the PTY. On SysVr4, grantpt(3) forks a subprocess, so keep sigchld_handler() from intercepting that death. If any child but grantpt's should die within, it should be caught after sigrelse(2). */ #define PTY_TTY_NAME_SPRINTF \ { \ char *ptsname(), *ptyname; \ \ sigblock(sigmask(SIGCLD)); \ if (grantpt(fd) == -1) \ fatal("could not grant slave pty"); \ sigunblock(sigmask(SIGCLD)); \ if (unlockpt(fd) == -1) \ fatal("could not unlock slave pty"); \ if (!(ptyname = ptsname(fd))) \ fatal ("could not enable slave pty"); \ strncpy(pty_name, ptyname, sizeof(pty_name)); \ pty_name[sizeof(pty_name) - 1] = 0; \ } /* Push various streams modules onto a PTY channel. */ #define SETUP_SLAVE_PTY \ if (ioctl (xforkin, I_PUSH, "ptem") == -1) \ fatal ("ioctl I_PUSH ptem", errno); \ if (ioctl (xforkin, I_PUSH, "ldterm") == -1) \ fatal ("ioctl I_PUSH ldterm", errno); \ if (ioctl (xforkin, I_PUSH, "ttcompat") == -1) \ fatal ("ioctl I_PUSH ttcompat", errno); #ifdef __GNUC__ #define C_DEBUG_SWITCH -g -V2 -mversion-03.00 -mstandard #endif #endif /* ELF */ /* Extra stuff which probably should be someplace else but is here out of expediency. */ #define LIB_X11_LIB -lX11 #define LIB_MOTIF -lXm -lgen /* Process groups work in the traditional BSD manner. */ #define BSD_PGRPS emacs-19.30/src/s/dgux5-4r2.h100444 12120 1 3055 5562602535 13756 0ustar rmsdaemon/* Definitions file for GNU Emacs running on Data General's DG/UX 5.4 Release 2.xx systems. Copyright (C) 1994 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. */ #include "dgux.h" /* There is a known kernel bug in DGUX 5.4R2.xx when using INTERRUPT_INPUT and invoking Emacs with a job control shell (csh, ksh, etc.) in the background. This bug manifests itself by outputting `stop on tty output' and hanging. The workaround is to set BROKEN_FIONREAD. -pmr@pajato.com */ #ifndef BROKEN_FIONREAD #define BROKEN_FIONREAD #endif #ifdef INTERRUPT_INPUT #undef INTERRUPT_INPUT #endif /* In DGUX 5.4R2.xx the function inet_addr() returns a `struct in_addr' instead of the more common `unsigned long'. -pmr@pajato.com */ #define HAVE_BROKEN_INET_ADDR #if 0 /* Shawn M. Carey found this caused trouble on DGUX 5.4.2. */ #define LIBS_SYSTEM -ldgc #endif emacs-19.30/src/s/dgux5-4r3.h100444 12120 1 3656 5562602361 13763 0ustar rmsdaemon/* Definitions file for GNU Emacs running on Data General's DG/UX version 5.4 Release 3.00 and above. Copyright (C) 1994 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. */ /* NOTE: DGUX5.4R3.00 will not build with the delivered gcc-2.4.5 compiler. You must upgraded to at least gcc-2.5.8. If you are running DGUX 5.4R3.00 check on the system dg-rtp.dg.com:/pub/gnu for gcc-2.5.8 or later compiler. -pmr@pajato.com */ #include "dgux5-4r2.h" /* DGUX 5.4R3.00 brought the definition of `struct inet_addr' into compliance wiht the majority of Unix systems. The workaround introduced in 5.4R2 is no longer necessary. */ #ifdef HAVE_BROKEN_INET_ADDR #undef HAVE_BROKEN_INET_ADDR #endif /* The `stop on tty output' problem which occurs when using INTERRUPT_INPUT and when Emacs is invoked under X11 using a job control shell (csh, ksh, etc.) in the background has not been fixed in DGUX 5.4R3.00. -pmr@pajato.com */ #if 0 #ifdef BROKEN_FIONREAD #undef BROKEN_FIONREAD #endif #ifndef INTERRUPT_INPUT #define INTERRUPT_INPUT #endif #endif /* Under DGUX 5.4R3.00, getting a debuggable executable has been greatly simplified and applies to either COFF or ELF environments. */ #ifdef C_DEBUG_SWITCH #undef C_DEBUG_SWITCH #define C_DEBUG_SWITCH -g #endif emacs-19.30/src/s/domain.h100666 12120 1 135 5662520026 13541 0ustar rmsdaemon#include "bsd4-3.h" /* Inhibit using -X, which is the default. */ #define LD_SWITCH_SYSTEM emacs-19.30/src/s/esix.h100444 75424 12 1222 5637122411 13334 0ustar kwzhstaff/* Definitions for ESIX, a variant of v.5.3 for the 386. */ /* These are based on reports for ESIX 5.3.2 D. */ #include "usg5-3.h" /* Some versions of V.3 have this, but not all. ESIX does. */ #define HAVE_PTYS #define SYSV_PTYS /* Have -lg be used for debugging. */ #undef LIBS_DEBUG #define LIBS_DEBUG -lg /* If using Roell's X server, define X11R4 */ #ifdef X11R4 /* Roell's X server */ #define select sys_select /* Emacs select() not good enough? */ #undef LIBX11_SYSTEM #define LIBX11_SYSTEM -lpt #endif /* X11R4 */ /* ESIX does not need , but needs */ #define NO_SIOCTL_H #define NEED_PTEM_H #define BROKEN_FIONREAD emacs-19.30/src/s/gnu.h100444 12120 1 3471 6024444670 13106 0ustar rmsdaemon/* Definitions file for GNU Emacs running on the GNU Hurd. Copyright (C) 1994, 1995 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. */ /* Get most of the stuff from bsd4.3 */ #include "bsd4-3.h" /* For mem-limits.h. */ #define BSD4_2 #undef SYSTEM_TYPE #define SYSTEM_TYPE "gnu" /* XXX should getloadavg be in libc? Should we have a libutil? #define HAVE_GETLOADAVG */ #define SIGNALS_VIA_CHARACTERS #define HAVE_TERMIOS #define NO_TERMIO #define LIBS_DEBUG /* XXX emacs should not expect TAB3 to be defined. */ #define TABDLY OXTABS #define TAB3 OXTABS #define SYSV_SYSTEM_DIR /* GNU has POSIX-style pgrp behavior. */ #undef BSD_PGRPS #define GETPGRP_NO_ARG #define HAVE_WAIT_HEADER #define WAIT_USE_INT #define HAVE_UNION_WAIT /* GNU needs its own crt0, and libc defines data_start. */ #define ORDINARY_LINK #define DATA_START ({ extern int data_start; (char *) &data_start; }) /* GNU now always uses the ELF format. */ #define UNEXEC unexelf.o /* ptys are not done yet. */ #undef HAVE_PTYS /* Some losing code fails to include this and then assumes that because it is braindead that O_RDONLY==0. */ #ifndef NOT_C_CODE #include #endif emacs-19.30/src/s/esix5r4.h100444 12120 1 1236 5403557370 13617 0ustar rmsdaemon/* Definitions for ESIX System V 4.0.4, a variant of V.4 for the 386. */ /* Redone by zircon!joe@uunet.uu.net (Joe Kelsey). */ #include "usg5-4.h" #define SYSTEM_MALLOC 1 #if defined (HAVE_XFREE386) # undef LIB_STANDARD # define LIB_STANDARD -lc #else # define LIB_X11_LIB -lsocket -lc -lX11 # undef LIB_STANDARD # ifdef ORDINARY_LINK # define LIB_STANDARD -lnsl -lns -lelf /usr/ucblib/libucb.a # else # define LIB_STANDARD -lnsl -lns -lelf /usr/ucblib/libucb.a /usr/ccs/lib/crtn.o # endif /* Resolve BSD string functions in X Window library from libucb.a. */ # define BSTRING /* zircon!joe says this makes X windows work. */ # define BROKEN_FIONREAD #endif emacs-19.30/src/s/freebsd.h100444 12120 1 4413 6024444665 13730 0ustar rmsdaemon/* s/ file for freebsd system. */ /* '__FreeBSD__' is defined by the preprocessor on FreeBSD-1.1 and up. Earlier versions do not have shared libraries, so inhibit them. You can inhibit them on newer systems if you wish by defining NO_SHARED_LIBS. */ #ifndef __FreeBSD__ #define NO_SHARED_LIBS #endif #if 0 /* This much, alone, seemed sufficient as of 19.23. But it seems better to be independent of netbsd.h. */ #include "netbsd.h" #undef LIB_GCC #define LIB_GCC -lgcc #undef NEED_ERRNO #endif /* 0 */ /* Get most of the stuff from bsd4.3 */ #include "bsd4-3.h" /* For mem-limits.h. */ #define BSD4_2 /* These aren't needed, since we have getloadavg. */ #undef KERNEL_FILE #undef LDAV_SYMBOL #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) #define LIBS_DEBUG #define LIBS_SYSTEM -lutil #define LIBS_TERMCAP -ltermcap #define LIB_GCC -lgcc #define SYSV_SYSTEM_DIR /* freebsd has POSIX-style pgrp behavior. */ #undef BSD_PGRPS #define GETPGRP_NO_ARG #ifndef NO_SHARED_LIBS #define LD_SWITCH_SYSTEM -e start -dc -dp #define HAVE_TEXT_START /* No need to define `start_of_text'. */ #define START_FILES pre-crt0.o /usr/lib/crt0.o #define UNEXEC unexsunos4.o #define RUN_TIME_REMAP #ifndef N_TRELOFF #define N_PAGSIZ(x) __LDPGSZ #define N_BSSADDR(x) (N_ALIGN(x, N_DATADDR(x)+x.a_data)) #define N_TRELOFF(x) N_RELOFF(x) #endif #else /* NO_SHARED_LIBS */ #ifdef __FreeBSD__ /* shared libs are available, but the user prefers not to use them. */ #define LD_SWITCH_SYSTEM -Bstatic #define A_TEXT_OFFSET(x) (sizeof (struct exec)) #define A_TEXT_SEEK(hdr) (N_TXTOFF(hdr) + A_TEXT_OFFSET(hdr)) #endif /* __FreeBSD__ */ #endif /* NO_SHARED_LIBS */ #define HAVE_WAIT_HEADER #define HAVE_GETLOADAVG /*#define HAVE_GETPAGESIZE /* configure now puts this in config.h */ #define HAVE_TERMIOS #define NO_TERMIO #define DECLARE_GETPWUID_WITH_UID_T /* freebsd uses OXTABS instead of the expected TAB3. */ #define TABDLY OXTABS #define TAB3 OXTABS /* this silences a few compilation warnings */ #undef BSD #if __FreeBSD__ == 1 #define BSD 199103 #elif __FreeBSD__ == 2 #define BSD 199306 #endif #define WAITTYPE int /* get this since it won't be included if WAITTYPE is defined */ #ifdef emacs #include #endif #define WRETCODE(w) (_W_INT(w) >> 8) emacs-19.30/src/s/hpux.h100444 75424 12 15453 5637122377 13416 0ustar kwzhstaff/* Definitions file for GNU Emacs running on HPUX release 7.0. Based on AT&T System V.2. 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 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #define USG /* System III, System V, etc */ #define USG5 #define HPUX /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "hpux" /* `nomultiplejobs' should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). On hpux this depends on the precise kind of machine in use, so the m- file defines this symbol if appropriate. */ /* Default is to set interrupt_input to 0: don't do input buffering within Emacs */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'p' means it is /dev/ptym/ptyp0 */ #define FIRST_PTY_LETTER 'p' /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIO /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ #define HAVE_SOCKETS /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ /* #define NONSYSTEM_DIR_LIBRARY */ /* Define this symbol if your system has the functions bcopy, etc. * s800 and later versions of s300 (s200) kernels have equivalents * of the BSTRING functions of BSD. If your s200 kernel doesn't have * em comment out this section. */ #define BSTRING /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* #define COFF */ /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Say we have the SYSV style of interprocess communication. */ #define HAVE_SYSVIPC /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ #define CLASH_DETECTION /* Define SHORTNAMES if the C compiler can distinguish only short names. It means that the stuff in ../shortnames must be run to convert the long names to short ones. Some USG systems support long names. If yours is one, DO NOT change this file! Do #undef SHORTNAMES in the m- file or in config.h. */ /* #define SHORTNAMES */ /* We use the Berkeley (and usg5.2.2) interface to nlist. */ #define NLIST_STRUCT /* The file containing the kernel's symbol table is called /hp-ux. */ #define KERNEL_FILE "/hp-ux" /* The symbol in the kernel where the load average is found depends on the cpu type, so we let the m- files define LDAV_SYMBOL. */ /* Special hacks needed to make Emacs run on this system. */ /* * Make the sigsetmask function go away. Don't know what the * ramifications of this are, but doesn't seem possible to * emulate it properly anyway at this point. */ /* HPUX has sigsetmask */ /* #define sigsetmask(mask) / * Null expansion * / */ /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ /* HP-UX has _setjmp and _longjmp */ /* #define _setjmp setjmp #define _longjmp longjmp */ /* On USG systems the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define open sys_open #define write sys_write #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_IO /* Use the system provided termcap(3) library */ #define TERMINFO /* The 48-bit versions are more winning for Emacs; the ordinary ones don't give even 32 bits. */ #define random lrand48 #define srandom srand48 /* In hpux, the symbol SIGIO is defined, but the feature doesn't work in the way Emacs needs it to. Here we assume that signal.h is included before config.h so that we can override it here. */ #undef SIGIO /* USG systems tend to put everything declared static into the initialized data area, which becomes pure after dumping Emacs. Foil this. Emacs carefully avoids static vars inside functions. */ #define static /* Define extra libraries to load. This should have -lBSD, but that library is said to make `signal' fail to work. */ #ifdef HPUX_NET #define LIBS_SYSTEM -ln #else #define LIBS_SYSTEM #endif /* Some additional system facilities exist. */ #define HAVE_VFORK #define HAVE_PERROR /* Delete this line for version 6. */ /* The following maps shared exec file to demand loaded exec. Don't do this as demand loaded exec is broken in hpux. */ #if 0 /* Adjust a header field for the executable file about to be dumped. */ #define ADJUST_EXEC_HEADER \ hdr.a_magic = ((ohdr.a_magic.file_type == OLDMAGIC.file_type) ? \ NEWMAGIC : ohdr.a_magic); #endif /* Baud-rate values in tty status have nonstandard meanings. */ #define BAUD_CONVERT \ { 0, 50, 75, 110, 135, 150, 200, 300, 600, 900, 1200, \ 1800, 2400, 3600, 4800, 7200, 9600, 19200, 38400 } /* This is needed for HPUX version 6.2; it may not be needed for 6.2.1. */ #define SHORT_CAST_BUG /* This is how to get the device name of the tty end of a pty. */ #define PTY_TTY_NAME_SPRINTF \ sprintf (pty_name, "/dev/pty/tty%c%x", c, i); /* This is how to get the device name of the control end of a pty. */ #define PTY_NAME_SPRINTF \ sprintf (pty_name, "/dev/ptym/pty%c%x", c, i); /* This triggers a conditional in xfaces.c. */ #define XOS_NEEDS_TIME_H emacs-19.30/src/s/hpux10.h100666 12120 1 660 6054451226 13423 0ustar rmsdaemon#include "hpux9shr.h" /* We have to go this route, rather than hpux9's approach of renaming the functions via macros. The system's stdlib.h has fully prototyped declarations, which yields a conflicting definition of srand48; it tries to redeclare what was once srandom to be srand48. So we go with HAVE_LRAND48 being defined. */ #undef srandom #undef srand48 #undef HAVE_RANDOM #define HPUX10 #define FORCE_ALLOCA_H emacs-19.30/src/s/hpux8.h100444 12120 1 4044 5640001262 13353 0ustar rmsdaemon/* system description file for hpux version 8. This contains changes that were suggested "for the hp700". They were not needed for the 800. Our conjecture that they are needed for hpux version 8, which is what runs on the 700. */ #include "hpux.h" #define HPUX8 /* dob@inel.gov says HPUX 8.07 needs this. He was using X11R5, I think. */ #define LIBX11_SYSTEM -lXext #define LIB_X11_LIB -L/usr/lib/X11R5 -L/usr/lib/X11R4 -lX11 #define C_SWITCH_X_SYSTEM -I/usr/include/X11R5 -I/usr/include/X11R4 #define LD_SWITCH_X_DEFAULT -L/usr/lib/X11R5 -L/usr/lib/X11R4 /* Don't use shared libraries. unexec doesn't handle them. Note GCC automatically passes -a archive to ld, and it has its own conflicting -a. */ #ifdef __GNUC__ /* No need to specify roundabout way of linking temacs. */ #define ORDINARY_LINK #ifdef HPUX_USE_SHLIBS #define LD_SWITCH_SYSTEM #else #define LD_SWITCH_SYSTEM -Xlinker -a -Xlinker archive #endif #else /* not __GNUC__ */ #if (defined(hp9000s700) || defined(__hp9000s700)) #ifdef HPUX_USE_SHLIBS #define LD_SWITCH_SYSTEM -L/lib/pa1.1 #else #define LD_SWITCH_SYSTEM -a archive -L/lib/pa1.1 #endif #else /* not (defined(hp9000s700) || defined(__hp9000s700)) */ #ifdef HPUX_USE_SHLIBS #define LD_SWITCH_SYSTEM #else #define LD_SWITCH_SYSTEM -a archive #endif #endif /* not (defined(hp9000s700) || defined(__hp9000s700)) */ #endif /* not __GNUC__ */ /* Some hpux 8 machines seem to have TIOCGWINSZ, and none have sioctl.h, so might as well define this. */ #define NO_SIOCTL_H #if 0 /* autoconf should be detecting the presence or absence of random and srandom now. */ /* If you use X11R4 you must define this. If you use X11R5 you must comment this out */ /* #define HAVE_RANDOM */ #define random foo_random #define srandom foo_srandom #endif #if 0 /* This seems to be spurious. */ /* "X11R5" on hpux8 doesn't have this function, which is supposed to exist in X11R5. Maybe things will work if we just don't call it. */ #define NO_XRM_SET_DATABASE #endif /* Enable a special hack in XTread_socket. */ #define X_IO_BUG emacs-19.30/src/s/hpux9-x11r4.h100666 12120 1 356 5774120711 14232 0ustar rmsdaemon/* System description file for hpux version 9 using X11R4. */ #include "hpux9.h" #undef C_SWITCH_X_SYSTEM #define C_SWITCH_X_SYSTEM -I/usr/include/Motif1.1 #undef LD_SWITCH_X_DEFAULT #define LD_SWITCH_X_DEFAULT -L/usr/lib/Motif1.1 emacs-19.30/src/s/hpux9.h100444 12120 1 3164 6051046166 13367 0ustar rmsdaemon/* System description file for hpux version 9. */ #include "hpux8.h" #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 #undef REL_ALLOC #endif #ifndef __GNUC__ /* Make room for enough symbols, so dispnew.c does not fail. */ #define C_SWITCH_SYSTEM -Wp,-H200000 -D_BSD #else #define C_SWITCH_SYSTEM -D_BSD #endif #if 0 /* These definitions run into a bug in hpux whereby trying to disable the vdsusp character has no effect. supposedly there is no particular need for this. */ /* neal@ctd.comsat.com */ #undef HAVE_TERMIO #define HAVE_TERMIOS #define NO_TERMIO #endif /* According to ngorelic@speclab.cr.usgs.gov, references to the X11R4 directoriess in these variables (inherited from hpux8.h) cause the wrong libraries to be found, and the options to specify the X11R5 directories are unnecessary since the R5 files are found without them. */ #undef LIB_X11_LIB #undef C_SWITCH_X_SYSTEM #undef LD_SWITCH_X_DEFAULT /* However, HPUX 9 has Motif includes in a strange place. So search that place. These definitions assume that X11R5 is being used -- if X11R4 is used, "s/hpux9-x11r4.h" gets loaded instead. */ #define C_SWITCH_X_SYSTEM -I/usr/include/Motif1.2 #define LD_SWITCH_X_DEFAULT -L/usr/lib/Motif1.2 /* HP-UX doesn't supply Xmu. */ #define LIBXMU /* Unfortunately without libXmu we cannot support EditRes. */ #define NO_EDITRES /* zoo@armadillo.com says we don't need -lXext in HPUX 9. */ #undef LIBX11_SYSTEM emacs-19.30/src/s/hpux9shr.h100444 12120 1 322 5677300061 14055 0ustar rmsdaemon#define ORDINARY_LINK #define HPUX_USE_SHLIBS #define RUN_TIME_REMAP #include "hpux9.h" /* We must turn off -g since it forces -static. */ #ifdef __GNUC__ #undef C_DEBUG_SWITCH #define C_DEBUG_SWITCH #endif emacs-19.30/src/s/hpux9shxr4.h100666 12120 1 261 5774120730 14342 0ustar rmsdaemon#include "hpux9shr.h" #undef C_SWITCH_X_SYSTEM #define C_SWITCH_X_SYSTEM -I/usr/include/Motif1.1 #undef LD_SWITCH_X_DEFAULT #define LD_SWITCH_X_DEFAULT -L/usr/lib/Motif1.1 emacs-19.30/src/s/iris3-5.h100444 12120 1 11677 5660743365 13547 0ustar rmsdaemon/* Definitions file for GNU Emacs running on Silicon Graphics 3.5 Copyright (C) 1987 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #define USG #define USG5 #define IRIS /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "irix" /* nomultiplejobs should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ #define NOMULTIPLEJOBS /* Default is to set interrupt_input to 0: don't do input buffering within Emacs */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'a' means it is /dev/ptya0 */ #define FIRST_PTY_LETTER 'a' /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIO /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ #define HAVE_SOCKETS /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ /* #define NONSYSTEM_DIR_LIBRARY */ /* Define this symbol if your system has the functions bcopy, etc. */ #define BSTRING /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* #define COFF */ /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ #define MAIL_USE_FLOCK /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* We use the Berkeley (and usg5.2.2) interface to nlist. */ #define NLIST_STRUCT /* The file containing the kernel's symbol table is called /vmunix. */ #define KERNEL_FILE "/vmunix" /* The symbol in the kernel where the load average is found is named _avenrun. */ #define LDAV_SYMBOL "_avenrun" /* Special hacks needed to make Emacs run on this system. */ /* * Make the sigsetmask function go away. Don't know what the * ramifications of this are, but doesn't seem possible to * emulate it properly anyway at this point. */ #define sigsetmask(mask) /* Null expansion */ /* The IRIS defines SIGIO in signal.h, but doesn't implement it. */ #undef SIGIO #define LIBS_MACHINE -lbsd -ldbm -lPW #define C_SWITCH_MACHINE -I/usr/include/bsd /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp #define _longjmp longjmp /* On USG systems the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define open sys_open #define write sys_write #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_IO /* On USG systems these have different names */ #define index strchr #define rindex strrchr /* USG systems tend to put everything declared static into the initialized data area, which becomes pure after dumping Emacs. Foil this. Emacs carefully avoids static vars inside functions. */ /* #define static */ /* Compiler bug bites on many systems when default ADDR_CORRECT is used. */ #define ADDR_CORRECT(x) (int)((char *)(x) - (char*)0) /* some errno.h's don't actually allocate the variable itself */ #define NEED_ERRNO /* The symbol FIONREAD is defined, but the feature does not work. */ #define BROKEN_FIONREAD /* This is how to get the device name of the tty end of a pty. */ #define PTY_TTY_NAME_SPRINTF \ sprintf (ptyname, "/dev/ttyq%d", minor (stb.st_rdev)); emacs-19.30/src/s/iris3-6.h100444 12120 1 11704 5660743370 13533 0ustar rmsdaemon/* Definitions file for GNU Emacs running on Silicon Graphics system 3.6. Copyright (C) 1987 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #define USG #define USG5 #define IRIS /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "irix" /* nomultiplejobs should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ #define NOMULTIPLEJOBS /* Default is to set interrupt_input to 0: don't do input buffering within Emacs */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'a' means it is /dev/ptya0 */ #define FIRST_PTY_LETTER 'a' /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIO /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ #define HAVE_SOCKETS /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ /* #define NONSYSTEM_DIR_LIBRARY */ /* Define this symbol if your system has the functions bcopy, etc. */ #define BSTRING /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* #define COFF */ /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ #define MAIL_USE_FLOCK /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* We use the Berkeley (and usg5.2.2) interface to nlist. */ #define NLIST_STRUCT /* The file containing the kernel's symbol table is called /vmunix. */ #define KERNEL_FILE "/vmunix" /* The symbol in the kernel where the load average is found is named _avenrun. */ #define LDAV_SYMBOL "_avenrun" /* Special hacks needed to make Emacs run on this system. */ /* * Make the sigsetmask function go away. Don't know what the * ramifications of this are, but doesn't seem possible to * emulate it properly anyway at this point. */ #define sigsetmask(mask) /* Null expansion */ #define sigblock(x) x /* The IRIS defines SIGIO in signal.h, but doesn't implement it. */ #undef SIGIO #define LIBS_MACHINE -lbsd -ldbm -lPW #define C_SWITCH_MACHINE -I/usr/include/bsd /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp #define _longjmp longjmp /* On USG systems the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define open sys_open #define write sys_write #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_IO /* On USG systems these have different names */ #define index strchr #define rindex strrchr /* USG systems tend to put everything declared static into the initialized data area, which becomes pure after dumping Emacs. Foil this. Emacs carefully avoids static vars inside functions. */ /* #define static */ /* Compiler bug bites on many systems when default ADDR_CORRECT is used. */ #define ADDR_CORRECT(x) (int)((char *)(x) - (char*)0) /* some errno.h's don't actually allocate the variable itself */ #define NEED_ERRNO /* This is how to get the device name of the tty end of a pty. */ #define PTY_TTY_NAME_SPRINTF \ sprintf (ptyname, "/dev/ttyq%d", minor (stb.st_rdev)); /* The C library does have the getwd function. */ #define HAVE_GETWD emacs-19.30/src/s/irix3-3.h100444 12120 1 11115 6005275757 13534 0ustar rmsdaemon/* Definitions file for GNU Emacs running on Silicon Graphics Irix system 3.3. Copyright (C) 1987,1990 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #define USG #define USG5 #define IRIS #ifndef IRIX #define IRIX #endif /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "irix" /* nomultiplejobs should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ /* #define NOMULTIPLEJOBS */ /* Default is to set interrupt_input to 0: don't do input buffering within Emacs */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'a' means it is /dev/ptya0 */ #define FIRST_PTY_LETTER 'a' /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIO /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ #define HAVE_SOCKETS /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ /* #define NONSYSTEM_DIR_LIBRARY */ /* Define this symbol if your system has the functions bcopy, etc. */ #define BSTRING /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* #define COFF */ /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ #define MAIL_USE_FLOCK /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* We use the Berkeley (and usg5.2.2) interface to nlist. */ #define NLIST_STRUCT /* The file containing the kernel's symbol table is called /unix. */ #define KERNEL_FILE "/unix" /* The symbol in the kernel where the load average is found is named _avenrun. */ #define LDAV_SYMBOL "avenrun" /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp #define _longjmp longjmp /* On USG systems the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define open sys_open #define write sys_write #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_IO /* On USG systems these have different names */ #define index strchr #define rindex strrchr /* USG systems tend to put everything declared static into the initialized data area, which becomes pure after dumping Emacs. Foil this. Emacs carefully avoids static vars inside functions. */ /* #define static */ /* This is how to get the device name of the tty end of a pty. */ #define PTY_TTY_NAME_SPRINTF \ sprintf (ptyname, "/dev/ttyq%d", minor (stb.st_rdev)); /* getwd is defined. */ #define HAVE_GETWD #define HAVE_SYSVIPC /* sioctl.h should be included where appropriate. */ #define NEED_SIOCTL /* This affects child_setup. */ #define SETPGRP_RELEASES_CTTY /* This was formerly in LIBS_MACHINE in iris4d.h, but it is not needed for newer system versions. */ #define LIBS_SYSTEM -lsun emacs-19.30/src/s/irix4-0.h100666 12120 1 2773 5720022213 13506 0ustar rmsdaemon#include "irix3-3.h" #define USG5_3 #define IRIX4 #define HAVE_ALLOCA #ifndef NOT_C_CODE #include #endif #undef NEED_SIOCTL /* Include unistd.h, even though we don't define POSIX. */ #define NEED_UNISTD_H /* Make process_send_signal work by "typing" a signal character on the pty. */ #define SIGNALS_VIA_CHARACTERS /* use K&R C */ #ifndef __GNUC__ #define C_SWITCH_SYSTEM -cckr #endif /* SGI has all the fancy wait stuff, but we can't include sys/wait.h because it defines BIG_ENDIAN and LITTLE_ENDIAN (ugh!.) Instead we'll just define WNOHANG right here. (An implicit decl is good enough for wait3.) */ #define WNOHANG 0x1 /* No need to use sprintf to get the tty name--we get that from _getpty. */ #undef PTY_TTY_NAME_SPRINTF #define PTY_TTY_NAME_SPRINTF /* No need to get the pty name at all. */ #define PTY_NAME_SPRINTF /* We need only try once to open a pty. */ #define PTY_ITERATION /* Here is how to do it. */ /* It is necessary to prevent SIGCHLD signals within _getpty. So we block them. */ #define PTY_OPEN \ { \ int mask = sigblock (sigmask (SIGCHLD)); \ char *name = _getpty (&fd, O_RDWR | O_NDELAY, 0600, 0); \ sigsetmask(mask); \ if (name == 0) \ return -1; \ if (fd < 0) \ return -1; \ if (fstat (fd, &stb) < 0) \ return -1; \ strcpy (pty_name, name); \ } /* jpff@maths.bath.ac.uk reports `struct exception' is not defined on this system, so inhibit use of matherr. */ #define NO_MATHERR emacs-19.30/src/s/irix5-0.h100444 75424 1 5655 5764637321 13731 0ustar kwzhdaemon#include "usg5-4.h" #define IRIX5 #define SETPGRP_RELEASES_CTTY #ifdef LIBS_SYSTEM #undef LIBS_SYSTEM #endif #ifdef LIB_STANDARD #undef LIB_STANDARD #endif #ifdef SYSTEM_TYPE #undef SYSTEM_TYPE #endif #define SYSTEM_TYPE "irix" #ifdef SETUP_SLAVE_PTY #undef SETUP_SLAVE_PTY #endif /* thomas@mathematik.uni-bremen.de says this is needed. */ /* Make process_send_signal work by "typing" a signal character on the pty. */ #define SIGNALS_VIA_CHARACTERS /* Define HAVE_ALLOCA to say that the system provides a properly working alloca function and it should be used. */ #define HAVE_ALLOCA #undef C_ALLOCA #ifndef NOT_C_CODE #ifndef __GNUC__ #include #endif #endif /* SGI has all the fancy wait stuff, but we can't include sys/wait.h because it defines BIG_ENDIAN and LITTLE_ENDIAN (ugh!.) Instead we'll just define WNOHANG right here. (An implicit decl is good enough for wait3.) */ /* #define WNOHANG 0x1 */ /* No need to use sprintf to get the tty name--we get that from _getpty. */ #ifdef PTY_TTY_NAME_SPRINTF #undef PTY_TTY_NAME_SPRINTF #endif #define PTY_TTY_NAME_SPRINTF /* No need to get the pty name at all. */ #ifdef PTY_NAME_SPRINTF #undef PTY_NAME_SPRINTF #endif #define PTY_NAME_SPRINTF #ifdef emacs char *_getpty(); #endif /* We need only try once to open a pty. */ #define PTY_ITERATION /* Here is how to do it. */ #define PTY_OPEN \ { \ struct sigaction ocstat, cstat; \ char * name; \ sigemptyset(&cstat.sa_mask); \ cstat.sa_handler = SIG_DFL; \ cstat.sa_flags = 0; \ sigaction(SIGCLD, &cstat, &ocstat); \ name = _getpty (&fd, O_RDWR | O_NDELAY, 0600, 0); \ sigaction(SIGCLD, &ocstat, (struct sigaction *)0); \ if (name == 0) \ return -1; \ if (fd < 0) \ return -1; \ if (fstat (fd, &stb) < 0) \ return -1; \ strcpy (pty_name, name); \ } /* Since we use POSIX constructs in PTY_OPEN, we must force POSIX throughout. */ #define POSIX_SIGNALS /* jpff@maths.bath.ac.uk reports `struct exception' is not defined on this system, so inhibit use of matherr. */ #define NO_MATHERR /* Info from simon@lia.di.epfl.ch (Simon Leinen) suggests this is needed. */ #define GETPGRP_NO_ARG /* Ulimit(UL_GMEMLIM) is busted... */ #define ULIMIT_BREAK_VALUE 0x14000000 /* Tell process_send_signal to use VSUSP instead of VSWTCH. */ #define PREFER_VSUSP /* Because unexelfsgi.c cannot handle a ".sbss" section yet, we must tell the linker to avoid making one. SGI's cc does this by default, but GCC (at least 2.5.8 and 2.6.0) doesn't. */ #ifdef __GNUC__ #define LD_SWITCH_SYSTEM -G 0 #endif /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ #define MAIL_USE_FLOCK /* use K&R C */ #ifndef __GNUC__ #define C_SWITCH_SYSTEM -cckr #endif emacs-19.30/src/s/irix5-2.h100444 12120 1 374 6016170743 13471 0ustar rmsdaemon#include "irix5-0.h" /* as of version 5.2, irix no longer uses flock, according to jackr@wpd.sgi.com. */ #undef MAIL_USE_FLOCK /* C-g in select is not handled properly with restartable system calls. So don't use them. */ #undef SA_RESTART emacs-19.30/src/s/irix6-0.h100444 12120 1 267 5774633326 13504 0ustar rmsdaemon#include "irix5-0.h" /* Irix 6 tries to do 64 bits, but doesn't do it fully, so inhibit that. */ #define IRIX_FORCE_32_BITS #ifndef __GNUC__ #define LD_SWITCH_SYSTEM -32 #endif emacs-19.30/src/s/isc2-2.h100444 12120 1 5032 6051312547 13304 0ustar rmsdaemon/* system description file for Interactive (ISC) Unix version 2.2 on the 386. */ #include "usg5-3.h" /* select (in -linet) works okay on X ptys, but not on the serial port. karl@cs.umb.edu says that with that select call, subprocesses made by (e.g.) M-x grep don't exit cleanly, they just hang. Similar problems have been observed in ISC 3.0. */ #define BROKEN_SELECT_NON_X /* Although ISC has sockets, again in -linet, again it's not what Emacs needs. With this defined, interrupt-shell-subjob and the like do nothing. --karl@cs.umb.edu #define HAVE_SOCKETS */ /* This keeps the .cdbx section that gcc puts out when generating stabs-in-coff output, so Emacs can be debugged. --karl@cs.umb.edu. */ #define USG_SHARED_LIBRARIES /* We can support lock files. */ #define CLASH_DETECTION #define NO_FCHMOD #define HAVE_PTYS #define MAXNAMLEN 512 #define O_NDELAY O_NONBLOCK #define MEMORY_IN_STRING_H /* Tell gmalloc.c that we don't have memmove (system include files to the contrary!). */ #define MEMMOVE_MISSING /* Send a signal to a subprocess by "typing" a signal character. */ #define SIGNALS_VIA_CHARACTERS /* -lPW is only needed if not using Gcc. We used to include -lcposix here for the rename function, but some people say ISC's rename doesn't work correctly with Emacs so we use Emacs' emulation instead. */ #if defined (__GNUC__) # define LIB_STANDARD_1 -lcposix #else /* !__GNUC__ */ # define LIB_STANDARD_1 -lPW #endif /* !__GNUC__ */ /* LIB_STANDARD_1 is used both here and in LIBS_SYSTEM (the latter for the sake of configure). */ #define LIB_STANDARD LIB_STANDARD_1 -lc #define NO_X_DESTROY_DATABASE /* -linet may be needed to avoid undefined symbols such as gethostname, inet_addr, gethostbyname, socket, connect, ... But if we are not compiling with X support, it's not needed. */ #ifdef HAVE_X_WINDOWS #define LIBS_SYSTEM -linet LIB_STANDARD_1 #else #define LIBS_SYSTEM LIB_STANDARD_1 #endif /* This system has job control. */ #undef NOMULTIPLEJOBS /* Inhibit asm code in netinet/in.h. Strictly speaking, only necessary when -traditional is being used, but it doesn't hurt to unconditionally define this. */ #define NO_ASM /* -traditional is not necessary if the system header files are fixed to define getc and putc in the absence of _POSIX_SOURCE. GCC's from 2.4.4 on do this. */ #if !defined (__GNUC__) || __GNUC__ < 2 # define C_SWITCH_SYSTEM -traditional #endif /* Some versions of ISC are said to define S_IFLNK even tho they don't really support symlinks. */ #undef S_IFLNK emacs-19.30/src/s/isc3-0.h100444 75424 13 3066 6025342361 13246 0ustar kwzhuser/* s- file for Interactive (ISC) Unix version 3.0 on the 386. */ #include "isc2-2.h" /* This has been moved into isc2-2.h. */ /* #define HAVE_SOCKETS */ /* This appears on 3.0, presumably as part of what SunSoft call X2. */ #undef NO_X_DESTROY_DATABASE #ifdef __GNUC__ /* Currently we use -lcposix only with gcc */ #define POSIX_SIGNALS /* We don't need the definition from usg5-3.h with POSIX_SIGNALS. */ #undef sigsetmask #undef HAVE_SYSV_SIGPAUSE #endif /* People say that using -traditional causes lossage with `const', so we might as well try getting rid of -traditional. */ #undef C_SWITCH_SYSTEM /* We indirectly #include s/usg5-3.h, which says to use libX11_s and libc_s. Martin Tomes says that ISC has no libX11_s, and that linking with libc_s causes sbrk not to work. */ #undef LIB_X11_LIB #undef LIBX11_SYSTEM #define LIBX11_SYSTEM -lpt -lnls -lnsl_s /* TIOCGWINSZ isn't broken; you just have to know where to find it. */ #undef BROKEN_TIOCGWINSZ #define NEED_SIOCTL /* We need either _XOPEN_SOURCE or _POSIX_SOURCE to import the posix signal symbols; might as well use _XOPEN_SOURCE. Defining _SYSV3 ensures that we don't lose the traditional symbols as a side effect from this or __STDC__ being defined. */ #define C_SWITCH_SYSTEM -D_XOPEN_SOURCE -D_SYSV3 #ifdef __GNUC__ /* Currently we use -lcposix only with gcc */ /* This works around a bug in ISC 4.0 and 3.0; it fails to clear the "POSIX process" flag on an exec. It won't be needed for 4.1. */ #define EXTRA_INITIALIZE __setostype (0) #endif emacs-19.30/src/s/isc4-0.h100444 12120 1 1242 6006532606 13303 0ustar rmsdaemon#include "isc3-0.h" #undef LIBS_SYSTEM #ifdef HAVE_X_WINDOWS #define LIBS_SYSTEM -linet -lcposix #else #define LIBS_SYSTEM -lcposix #endif #define ISC4_0 /* fmcphers@csugrad.cs.vt.edu reported this was necessary. He used GCC. I don't know what is needed with other compilers. */ #ifdef __GNUC__ #undef LIBX11_SYSTEM #define LIBX11_SYSTEM -lpt -lnls -lnsl_s -lcposix -lc #endif /* Tobias Herbert says this is needed. */ #ifndef POSIX_SIGNALS #ifndef sigblock #ifndef SIG_BLOCK #define SIG_BLOCK 0 #endif #define sigblock(sig) (sigprocmask (SIG_BLOCK, SIGEMPTYMASK | sig, NULL)) #endif #endif /* not POSIX_SIGNALS */ emacs-19.30/src/s/isc4-1.h100444 12120 1 1616 6013304203 13275 0ustar rmsdaemon#include "isc3-0.h" /* ISC 4.1 has renamed __setostype, but also has fixed the bug for which we needed to call it; so just do nothing. uddeborg@carmen.se. */ #undef EXTRA_INITIALIZE #define ISC4_1 #undef LIBS_SYSTEM #define LIBS_SYSTEM -linet /* uddeborg@carmen.se recommends the rest of this file. */ /* A special startup file is used when compiling with Posix. */ #define START_FILES pre-crt0.o /lib/crtp1.o /* -lPW is only needed if not using Gcc. */ #undef LIB_STANDARD #if defined (__GNUC__) # define LIB_STANDARD -lcposix -lc /lib/crtn.o #else /* !__GNUC__ */ # define LIB_STANDARD -lPW -lcposix -lc /lib/crtn.o #endif /* !__GNUC__ */ /* We have Posix termios. */ #define HAVE_TERMIOS /* According to template.h HAVE_TERMIO and HAVE_TERMIOS shouldn't be */ /* defined at the same time. */ #undef HAVE_TERMIO #define HAVE_SOCKETS #define NO_SOCKETS_IN_FILE_SYSTEM #define NEED_NET_ERRNO_H emacs-19.30/src/s/linux.h100444 12120 1 21332 6054461053 13465 0ustar rmsdaemon/* This file is the configuration file for GNU/Linux operating systems. Copyright (C) 1985, 1986, 1992, 1994 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. */ /* This file was put together by Michael K. Johnson and Rik Faith. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ /* #define UNIPLUS */ /* #define USG5 */ #define USG /* #define BSD */ #define LINUX /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "linux" /* All the best software is free. */ /* Emacs can read input using SIGIO and buffering characters itself, or using CBREAK mode and making C-g cause SIGINT. The choice is controlled by the variable interrupt_input. Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO) SIGIO can be used only on systems that implement it (4.2 and 4.3). CBREAK mode has two disadvantages 1) At least in 4.2, it is impossible to handle the Meta key properly. I hear that in system V this problem does not exist. 2) Control-G causes output to be discarded. I do not know whether this can be fixed in system V. Another method of doing input is planned but not implemented. It would have Emacs fork off a separate process to read the input and send it to the true Emacs process through a pipe. */ /* There have been suggestions made to add SIGIO to Linux. If this is done, you may, at your discretion, uncomment the line below. */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'p' means it is /dev/ptyp0 */ #define FIRST_PTY_LETTER 'p' /* * Define HAVE_TERMIOS if the system provides POSIX-style * functions and macros for terminal control. */ #define HAVE_TERMIOS /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* Uncomment this later when other problems are dealt with -mkj */ #define HAVE_SOCKETS /* Define this symbol if your system has the functions bcopy, etc. */ #define BSTRING /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* Both are used in Linux by different mail programs. I assume that most people are using newer mailers that have heard of flock. Change this if you need to. */ #define MAIL_USE_FLOCK /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ #define CLASH_DETECTION /* Here, on a separate page, add any special hacks needed to make Emacs work on this system. For example, you might define certain system call names that don't exist on your system, or that do different things on your system and must be used only through an encapsulation (Which you should place, by convention, in sysdep.c). */ /* On POSIX systems the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define write sys_write #define open sys_open #define close sys_close #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_CLOSE #define INTERRUPTIBLE_IO /* If you mount the proc file system somewhere other than /proc you will have to uncomment the following and make the proper changes */ /* #define LINUX_LDAV_FILE "/proc/loadavg" */ /* This is needed for disknew.c:update_frame */ #ifdef emacs #include /* Get the definition of _IO_STDIO_H. */ #if defined(_IO_STDIO_H) || defined(_STDIO_USES_IOSTREAM) /* new C libio names */ #define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \ ((FILE)->_IO_write_ptr - (FILE)->_IO_write_base) #else /* !_IO_STDIO_H */ /* old C++ iostream names */ #define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \ ((FILE)->_pptr - (FILE)->_pbase) #endif /* !_IO_STDIO_H */ #endif /* emacs */ /* Ask GCC where to find libgcc.a. */ #define LIB_GCC `$(CC) $(C_SWITCH_X_SITE) -print-libgcc-file-name` #ifndef __ELF__ /* Linux has crt0.o in a non-standard place */ #define START_FILES pre-crt0.o /usr/lib/crt0.o #else #define START_FILES pre-crt0.o /usr/lib/crt1.o /usr/lib/crti.o #endif /* As of version 1.1.51, Linux does not actually implement SIGIO. */ /* Here we assume that signal.h is already included. */ #ifdef emacs #undef SIGIO /* Some versions of Linux define SIGURG and SIGPOLL as aliases for SIGIO. This prevents lossage in process.c. */ #undef SIGURG #undef SIGPOLL #endif /* This is needed for sysdep.c */ #define NO_SIOCTL_H /* don't have sioctl.h */ #define HAVE_VFORK #define HAVE_SYS_SIGLIST #define HAVE_GETWD /* cure conflict with getcwd? */ #define SYSV_SYSTEM_DIR /* use dirent.h */ #define POSIX /* affects getpagesize.h and systty.h */ #define POSIX_SIGNALS /* Best not to include -lg, unless it is last on the command line */ #define LIBS_DEBUG #define LIBS_TERMCAP -ltermcap -lcurses /* save some space with shared libs*/ #ifndef __ELF__ #define LIB_STANDARD -lc /* avoid -lPW */ #else #undef LIB_GCC #define LIB_GCC #define LIB_STANDARD -lgcc -lc -lgcc /usr/lib/crtn.o #endif /* Don't use -g in test compiles in configure. This is so we will use the same shared libs for that linking that are used when linking temacs. */ #ifdef THIS_IS_CONFIGURE #define C_DEBUG_SWITCH #endif /* Let's try this out, just in case. Nah. Rik Faith says it doesn't work well. */ /* #define SIGNALS_VIA_CHARACTERS */ /* Rob Malouf says: SYSV IPC is standard a standard part of Linux since version 0.99pl10, and is a very common addition to previous versions. */ #ifdef TERM #define LIBS_SYSTEM -lclient #define C_SWITCH_SYSTEM -D_BSD_SOURCE -I/usr/src/term #else /* alane@wozzle.linet.org says that -lipc is not a separate library, since libc-4.4.1. So -lipc was deleted. */ #define LIBS_SYSTEM #define C_SWITCH_SYSTEM -D_BSD_SOURCE #endif /* Paul Abrahams says this is needed. */ #define LIB_MOTIF -lXm -lXpm #define HAVE_SYSVIPC #ifdef __ELF__ #define UNEXEC unexelf.o #define UNEXEC_USE_MAP_PRIVATE #endif #ifdef LINUX_QMAGIC #define HAVE_TEXT_START #define UNEXEC unexsunos4.o #define N_PAGSIZ(x) PAGE_SIZE #else /* not LINUX_QMAGIC */ #define A_TEXT_OFFSET(hdr) (N_MAGIC(hdr) == QMAGIC ? sizeof (struct exec) : 0) #define A_TEXT_SEEK(hdr) (N_TXTOFF(hdr) + A_TEXT_OFFSET(hdr)) #define ADJUST_EXEC_HEADER \ unexec_text_start = N_TXTADDR(ohdr) + A_TEXT_OFFSET(ohdr) #endif /* not LINUX_QMAGIC */ #if 0 /* In 19.23 and 19.24, configure sometimes fails to define these. It has to do with the fact that configure uses CFLAGS when linking while Makefile.in.in (erroneously) fails to do so when linking temacs. */ #ifndef HAVE_GETTIMEOFDAY #define HAVE_GETTIMEOFDAY #endif #ifndef HAVE_MKDIR #define HAVE_MKDIR #endif #ifndef HAVE_RMDIR #define HAVE_RMDIR #endif #ifndef HAVE_XSCREENNUMBEROFSCREEN #define HAVE_XSCREENNUMBEROFSCREEN #endif #endif /* 0 */ /* This is to work around mysterious gcc failures in some system versions. It is unlikely that Emacs changes will work around this problem; therefore, this should remain permanently. */ #ifndef HAVE_XRMSETDATABASE #define HAVE_XRMSETDATABASE #endif /* The regex.o routines are a part of the GNU C-library used with Linux. */ /* However, sometimes they disagree with the src/regex.h that comes with Emacs, and that can make trouble in etags.c because it gets the regex.h from Emacs and the function definitions in libc. So turn this off. */ /* #define REGEXP_IN_LIBC */ emacs-19.30/src/s/mach-bsd4-3.h100444 12120 1 266 5774402056 14201 0ustar rmsdaemon/* I don't care if this doesn't do more than including bsd4-3.h; Mach is not bsd4-3 and the moment you forget it chances are that you're in deep shit. */ #include "bsd4-3.h" emacs-19.30/src/s/msdos.h100444 12120 1 15251 6054301757 13462 0ustar rmsdaemon/* System description file for MS-DOS Copyright (C) 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. */ /* Note: lots of stuff here was taken from s-msdos.h in demacs. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ /* #define UNIPLUS */ /* #define USG5 */ /* #define USG */ /* #define HPUX */ /* #define UMAX */ /* #define BSD4_1 */ /* #define BSD4_2 */ /* #define BSD4_3 */ /* #define BSD */ /* #define VMS */ #ifndef MSDOS #define MSDOS #endif #ifdef __GO32__ #ifndef __DJGPP__ #define __DJGPP__ 1 /* V2 defines __DJGPP__ == 2 */ #else You lose; /* Emacs for DOS must be compiled with DJGPP V1 */ #endif #else You lose; /* Emacs for DOS must be compiled with DJGPP */ #endif #define DOS_NT /* MSDOS or WINDOWSNT */ #undef BSD #undef VMS /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "ms-dos" #define SYMS_SYSTEM syms_of_dosfns();syms_of_msdos() /* NOMULTIPLEJOBS should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ #define NOMULTIPLEJOBS /* Emacs can read input using SIGIO and buffering characters itself, or using CBREAK mode and making C-g cause SIGINT. The choice is controlled by the variable interrupt_input. Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO) SIGIO can be used only on systems that implement it (4.2 and 4.3). CBREAK mode has two disadvatages 1) At least in 4.2, it is impossible to handle the Meta key properly. I hear that in system V this problem does not exist. 2) Control-G causes output to be discarded. I do not know whether this can be fixed in system V. Another method of doing input is planned but not implemented. It would have Emacs fork off a separate process to read the input and send it to the true Emacs process through a pipe. */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'a' means it is /dev/ptya0 */ /* #define FIRST_PTY_LETTER 'a' */ /* * Define HAVE_PTYS if the system supports pty devices. */ /* #define HAVE_PTYS */ /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ /* #define NONSYSTEM_DIR_LIBRARY */ #define SYSV_SYSTEM_DIR /* Define this symbol if your system has the functions bcopy, etc. */ #define BSTRING /* Define this is the compiler understands `volatile'. */ #define HAVE_VOLATILE /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #undef subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ #define COFF /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* Here, on a separate page, add any special hacks needed to make Emacs work on this system. For example, you might define certain system call names that don't exist on your system, or that do different things on your system and must be used only through an encapsulation (Which you should place, by convention, in sysdep.c). */ /* we use djgcc's malloc */ /* #define SYSTEM_MALLOC */ /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp #define _longjmp longjmp #define NO_MODE_T /* New chdir () routine. */ #ifdef chdir #undef chdir #endif #define chdir sys_chdir #define LIBS_SYSTEM -lpc /* This somehow needs to be defined even though we use COFF. */ #define TEXT_START -1 #define ORDINARY_LINK /* command.com does not understand `...` so we define this. */ #define LIB_GCC -Lgcc #define DONT_NEED_ENVIRON #define SEPCHAR ';' #define NULL_DEVICE "nul" #define EXEC_SUFFIXES ".exe:.com:.bat:" #define O_RDONLY 0x0001 #define O_WRONLY 0x0002 #define O_RDWR 0x0004 #define O_CREAT 0x0100 #define O_TRUNC 0x0200 #define O_EXCL 0x0400 #define O_APPEND 0x0800 #define O_TEXT 0x4000 #define O_BINARY 0x8000 #define HAVE_INVERSE_HYPERBOLIC #define FLOAT_CHECK_DOMAIN #define NO_MATHERR /* When $TERM is "internal" then this is substituted: */ #define INTERNAL_TERMINAL "pc|bios|IBM PC with colour display:\ :co#80:li#25:km:ms:cm=:cl=:ce=:" /* Define this to a function (Fdowncase, Fupcase) if your file system likes that */ #define FILE_SYSTEM_CASE Fdowncase /* Define this to be the separator between devices and paths */ #define DEVICE_SEP ':' /* We'll support either convention on MSDOG. */ #define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\') #define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_)) /* Call init_gettimeofday when TZ changes. */ #define LOCALTIME_CACHE #define tzset init_gettimeofday /* bcopy under djgpp is quite safe */ #define GAP_USE_BCOPY #define BCOPY_UPWARD_SAFE 1 #define BCOPY_DOWNWARD_SAFE 1 /* Mode line description of a buffer's type. */ #define MODE_LINE_BINARY_TEXT(buf) (NILP(buf->buffer_file_type) ? "T" : "B") /* We have (the code to control) a mouse. */ #define HAVE_MOUSE /* We have support for faces. */ #define HAVE_FACES /* Define one of these for easier conditionals. */ #ifdef HAVE_X_WINDOWS /* We need a little extra space, see ../../lisp/loadup.el */ #define SYSTEM_PURESIZE_EXTRA 15000 #define HAVE_X11R5 #define LIBX11_SYSTEM -lxext -lsys #else /* We need a little extra space, see ../../lisp/loadup.el */ #define SYSTEM_PURESIZE_EXTRA 85000 #endif emacs-19.30/src/s/netbsd.h100444 12120 1 2700 6024444673 13571 0ustar rmsdaemon/* s/ file for netbsd system. */ /* Get most of the stuff from bsd4.3 */ #include "bsd4-3.h" /* For mem-limits.h. */ #define BSD4_2 #undef KERNEL_FILE #undef LDAV_SYMBOL #define HAVE_GETLOADAVG #define HAVE_UNION_WAIT #define SIGNALS_VIA_CHARACTERS #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) /* netbsd uses OXTABS instead of the expected TAB3. */ #define TABDLY OXTABS #define TAB3 OXTABS #define A_TEXT_OFFSET(x) (sizeof (struct exec)) #define A_TEXT_SEEK(hdr) (N_TXTOFF(hdr) + A_TEXT_OFFSET(hdr)) #define HAVE_TERMIOS #define NO_TERMIO #define LIBS_DEBUG /* -lutil is not needed for NetBSD >0.9. */ /* #define LIBS_SYSTEM -lutil */ #define LIBS_TERMCAP -ltermcap #define NEED_ERRNO #define SYSV_SYSTEM_DIR /* Netbsd has POSIX-style pgrp behavior. */ #undef BSD_PGRPS #define GETPGRP_NO_ARG #ifndef NO_SHARED_LIBS /* These definitions should work for either dynamic or static linking, whichever is the default for `cc -nostdlib'. */ #define HAVE_TEXT_START /* No need to define `start_of_text'. */ #define START_FILES pre-crt0.o /usr/lib/crt0.o #define UNEXEC unexsunos4.o #define RUN_TIME_REMAP /* Try to make this work for both 0.9 and >0.9. */ #ifndef N_TRELOFF #define N_PAGSIZ(x) __LDPGSZ #define N_BSSADDR(x) (N_ALIGN(x, N_DATADDR(x)+x.a_data)) #define N_TRELOFF(x) N_RELOFF(x) #endif #endif /* not NO_SHARED_LIBS */ #define HAVE_WAIT_HEADER #define WAIT_USE_INT #define NO_MATHERR #define AMPERSAND_FULL_NAME emacs-19.30/src/s/newsos5.h100444 12120 1 3153 5532727314 13717 0ustar rmsdaemon/* Definitions file for GNU Emacs running on Sony's NEWS-OS 5.0.2 Copyright (C) 1992, 1994 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. */ /* Use the SysVr4 file for at least base configuration. */ #include "usg5-4.h" #define NEWSOS5 /* These will be defined by "m-mips.h". */ #undef START_FILES #undef LIB_STANDARD #undef LIBS_SYSTEM #define LIBS_SYSTEM -lsocket -lnsl -lgen /* Disable use of "unexelf.c" and shared libraries, because "unexelf.c" doesn't work correctly on NEWS-OS. "unexmips.c" does work correctly if the program is linked statically without ELF. */ #undef UNEXEC #undef USG_SHARED_LIBRARIES /* Use `ld' directly rather than ordinary link, because ordinary link can't produce a non-ELF executable. */ #undef ORDINARY_LINK #define LINKER /usr/lib/cmplrs/cc/ld #define START_FILES pre-crt0.o /usr/ccs/lib/crt1.o #define LIB_STANDARD -lc /usr/ccs/lib/crtn.o /usr/ccs/lib/values-Xt.o #ifndef HAVE_SOCKETS #define HAVE_SOCKETS #endif emacs-19.30/src/s/nextstep.h100666 12120 1 5421 6010603371 14160 0ustar rmsdaemon/* Configuration file for the NeXTstep system. Copyright (C) 1990, 1995 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. */ #include "bsd4-3.h" /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. We'll need to undo the bsd one. */ #undef SYSTEM_TYPE #define SYSTEM_TYPE "next-mach" #ifndef NeXT #define NeXT #endif /* 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 LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) /* Defining KERNEL_FILE causes lossage because sys/file.h stupidly gets confused by it. */ #undef KERNEL_FILE #define HAVE_ALLOCA #define SYSTEM_MALLOC #define environ _environ /* This should be true for recent NeXT systems. At least since 3.2. */ #define HAVE_MACH_MACH_H #if 0 /* I think these are never used--let's see. -- rms. */ /* Mask for address bits within a memory segment */ #define SEGSIZ 0x20000 #define SEGMENT_MASK (SEGSIZ - 1) #define HAVE_UNIX_DOMAIN /* Conflicts in process.c between ioctl.h & tty.h use of t_foo fields */ #define NO_T_CHARS_DEFINES /* This avoids a problem in Xos.h when using co-Xist 3.01. */ #define X_NOT_POSIX #endif /* 0 */ /* Definitions for how to link. */ /* Link this program just by running cc. */ #define ORDINARY_LINK #define LD_SWITCH_SYSTEM -X -noseglinkedit /* Don't use -lc on the NeXT. */ #define LIB_STANDARD -lsys_s #define LIB_MATH -lm #define START_FILES pre-crt0.o #define LIB_X11_LIB -L/usr/lib/X11 -lX11 /* We don't have a g library either, so override the -lg LIBS_DEBUG switch */ #define LIBS_DEBUG /* We don't have a libgcc.a, so we can't let LIB_GCC default to -lgcc */ #define LIB_GCC /* Definitions for how to dump. */ #define UNEXEC unexnext.o /* start_of_text isn't actually used, so make it compile without error. */ #define TEXT_START 0 /* This seems to be right for end_of_text, but it may not be used anyway. */ #define TEXT_END get_etext () /* This seems to be right for end_of_data, but it may not be used anyway. */ #define DATA_END get_edata () emacs-19.30/src/s/osf1.h100444 75424 1 1114 5762265141 13361 0ustar kwzhdaemon#include "bsd4-3.h" /* Identify OSF1 for the m- files. */ #define OSF1 /* Define _BSD to tell the include files we're running under the BSD universe and not the SYSV universe. */ #define C_SWITCH_SYSTEM -D_BSD #define LIBS_SYSTEM -lbsd #define GETPGRP_NO_ARG #define read sys_read #define write sys_write #define open sys_open #define close sys_close #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_CLOSE #define INTERRUPTIBLE_IO #define SYSV_SYSTEM_DIR /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ #define COFF emacs-19.30/src/s/ptx.h100444 75424 1 12336 5764116161 13353 0ustar kwzhdaemon/* Definitions file for GNU Emacs running on Sequent DYNIX/ptx 1.x/2.x Copyright (C) 1987, 1990 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. */ /* This file was written by Bill Burton . Parts were adapted from m-ptx1-2.h and process.c as distributed with the Emacs 18.57 on the Sequent Public software tape. Other parts were adapted from usg5-4.h. */ /* Use the SysVr3 file for base configuration even though much is changed. */ #include "usg5-3.h" /* Undo these defines because they are incorrect or need to be changed. */ #undef LIB_X11_LIB #undef LIBX10_SYSTEM #undef LIBX11_SYSTEM #undef USG_SHARED_LIBRARIES /* *defines* stat as a static function. If "static" is blank, then many files will have a public definition for stat. */ #undef static /* PTX supports job control. */ #undef NOMULTIPLEJOBS /* PTX has System V streams. */ #define SYSV_STREAMS /* Leave out -lPW since it conflicts with term.o and because we're not sure if the alloca found there by autoconf should be trusted on PTX. */ #define LIB_STANDARD -lc /* Local define. If TCP/IP is not installed, comment this out. */ #define TCPIP_INSTALLED #ifdef TCPIP_INSTALLED #define HAVE_SOCKETS #else #undef subprocesses #endif #ifdef HAVE_X_WINDOWS #define LIBX11_SYSTEM -lsocket -linet -lnsl /* This is also defined so that lib-src/profile can link. */ #define LIBS_SYSTEM -lseq #else /* ! HAVE_X_WINDOWS */ #ifdef HAVE_SOCKETS #define LIBS_SYSTEM -lsocket -linet -lnsl -lseq #else #define LIBS_SYSTEM -lseq #endif #endif /* ! HAVE_X_WINDOWS */ /* No */ #define NO_SIOCTL_H /* If we have X windows, configure should find gettimeofday in -lX11. Since we emulate gettimeofday below, we really have it anyway. */ #ifndef HAVE_GETTIMEOFDAY #define HAVE_GETTIMEOFDAY #endif #ifdef emacs #include /* Support for pty's */ #include /*#undef SIGIO*/ /* SIGIO is already undef'd elsewhere. PTX has SIGIO, but it's just an alias for SIGPOLL. */ /* Emulate gettimeofday() except for the time zone information which Emacs doesn't use anyway. Get_process_stats() is in -lseq. */ #include #define gettimeofday(tp, tzp) get_process_stats (tp, PS_SELF, 0, 0) /* Define timezone since it's not in sys/time.h. Unfortunately, this causes trouble when building with X since this struct is defined in . */ struct timezone { int tz_minuteswest; int tz_dsttime; }; /* Unfortunately, this define is not checked in all files including so we can't use it. */ /* #define XOS_NEEDS_TIME_H */ /* In ptx/WINDOWS, this prevents problems with the timezone struct being redefined in . It seems the necessary include files are included via systime.h so leaving them out here is not a problem. This may not work in X11R5 or X11R6. */ #define __TIMEVAL__ #endif /* emacs */ /* PTX doesn't have FIONREAD at all. */ #undef INTERRUPT_INPUT #define BROKEN_FIONREAD /* We can support this */ #define CLASH_DETECTION /* PTX has termios */ #define HAVE_TERMIOS #undef HAVE_TERMIO #undef BROKEN_TIOCGWINSZ #undef BROKEN_TIOCGETC /* It is possible to receive SIGCHLD when there are no children waiting, because a previous waitsys cleaned up the carcass of child without clearing the SIGCHLD pending info. So, use a non-blocking wait3 instead, which maps to waitpid in SysVr4. */ /* Not sure if this is used but PTX does support waitpid. */ /*#define HAVE_WAIT_HEADER*/ /*#define WAITTYPE int*/ #define wait3(status, options, rusage) \ waitpid ((pid_t) -1, (status), (options)) /*#define WRETCODE(w) (w >> 8)*/ /* PTX has pty's but not like System V */ #define HAVE_PTYS #undef SYSV_PTYS /* Provide pty support which is defined into process.c:allocate_pty. Basic ideas for handling getpseudotty were lifted from process.c in Emacs 18.57 included on the Sequent Public Software tape. However, this implementation bears almost no resemblance to the original and does not require that process.c be patched. */ #define PTY_ITERATION \ char *mastername, *slavename; \ while (1) #define PTY_OPEN \ if (failed_count++ >= 5) break; \ if ((fd = getpseudotty (&slavename, &mastername)) < 0) { \ error("Out of ptys."); \ continue; \ } \ strcpy (pty_name, slavename); /* Define these to prevent the default logic in process.c:allocate_pty from being used. */ #define PTY_NAME_SPRINTF #define PTY_TTY_NAME_SPRINTF /* PTX doesn't seem to have memmove. */ #define MEMMOVE_MISSING emacs-19.30/src/s/riscix1-1.h100666 12120 1 1607 5640125632 14037 0ustar rmsdaemon/* Definitions file for GNU Emacs running on RISCiX 1.1 (bsd 4.3) Copyright (C) 1994 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. */ #define RISCiX_1_1 1 #define RISCiX 11 #define CRT0_O /lib/crt0.o #include "bsd4-3.h" emacs-19.30/src/s/riscix1-2.h100666 12120 1 1613 5640125646 14042 0ustar rmsdaemon/* Definitions file for GNU Emacs running on RISCiX 1.2 (bsd 4.3) Copyright (C) 1994 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. */ #define RISCiX_1_2 1 #define RISCiX 12 #define CRT0_O /usr/lib/crt0.o #include "bsd4-3.h" emacs-19.30/src/s/riscos5.h100444 12120 1 404 5775320643 13662 0ustar rmsdaemon#include "bsd4-3.h" /* This file has changes that Jost Krieger says are necessary. */ /* No declaration in system header files. */ extern double atof (); #define LD_SWITCH_SYSTEM -non_shared #define GETPGRP_NO_ARG emacs-19.30/src/s/rtu.h100444 75424 12 12113 5637122407 13224 0ustar kwzhstaff/* Definitions file for GNU Emacs running on RTU 3.0, ucb universe. Copyright (C) 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 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #define BSD4_2 #define BSD #define RTU /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "rtu" /* NOMULTIPLEJOBS should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ #define NOMULTIPLEJOBS /* Emacs can read input using SIGIO and buffering characters itself, or using CBREAK mode and making C-g cause SIGINT. The choice is controlled by the variable interrupt_input. Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO) SIGIO can be used only on systems that implement it (4.2 and 4.3). CBREAK mode has two disadvantages 1) At least in 4.2, it is impossible to handle the Meta key properly. I hear that in system V this problem does not exist. 2) Control-G causes output to be discarded. I do not know whether this can be fixed in system V. Another method of doing input is planned but not implemented. It would have Emacs fork off a separate process to read the input and send it to the true Emacs process through a pipe. */ #undef INTERRUPT_INPUT /* Letter to use in finding device name of first pty, if system supports pty's. 'a' means it is /dev/ptya0 */ #define FIRST_PTY_LETTER 'z' /* i.e. no PTY_LETTERs */ /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* Define this macro if system defines a type `union wait'. */ #define HAVE_UNION_WAIT /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ #define HAVE_SOCKETS /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ #define NONSYSTEM_DIR_LIBRARY /* Define this symbol if your system has the functions bcopy, etc. */ /* The system library bcopy() is broken in RTU. For one thing, it expects the length to be less than 64k. */ #undef BSTRING /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ #undef COFF /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ #undef MAIL_USE_FLOCK /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ #undef CLASH_DETECTION /* We use the Berkeley (and usg5.2.2) interface to nlist. */ #define NLIST_STRUCT /* The symbol in the kernel where the load average is found is named _avenrun. */ #define LDAV_SYMBOL "_avenrun" /* Special hacks needed to make Emacs run on this system. */ /* On RTU systems (like USG) the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define open sys_open #define write sys_write #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_IO /* The "fsync" call on RTU versions 3.0 and 3.1 is badly broken! This hack below isn't the best solution, but without it this program will cause the whole system to hang! !@#$#%$ Masscomp! */ #define fsync(x) 0 /* "Comment out" fsync calls */ /* RTU has IPC instead of Unix-domain sockets. */ #define HAVE_SYSVIPC /* This is how to get the device name of the tty end of a pty. */ #define PTY_TTY_NAME_SPRINTF \ sprintf (pty_name, "/dev/ttyp%x", i); /* This is how to get the device name of the control end of a pty. */ #define PTY_NAME_SPRINTF \ sprintf (pty_name, "/dev/pty%x", i); /* (Assume) we do have vfork. */ #define HAVE_VFORK /* Process groups work in the traditional BSD manner. */ #define BSD_PGRPS emacs-19.30/src/s/sco4.h100444 75424 1 10205 6002547470 13376 0ustar kwzhdaemon/* System description file for SCO 3.2v4. Copyright (C) 1993, 1994 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. */ /* Contributed by Ian Lance Taylor, ian@cygnus.com. */ /* SCO is sort of like SVR3. */ #include "usg5-3.h" #define SCO_R4 #if 0 /* Turned off rather than make the Lisp code check for this. -- rms. I am assuming that (at least most of) the tests for usg-unix-v do the right thing for sco3.2v4 also. Things that *might* be wrong as a result of turning off these lines include the values of ange-ftp-remote-shell-file-name (now remsh) dired-chown-program (now just chown) lpr-command (now lp) nntp-buggy-select (now t) rmail-spool-directory (now /usr/mail?) and the actions of the function print-region-1. */ /* SYSTEM_TYPE should indicate the kind of system you are using. */ #undef SYSTEM_TYPE #define SYSTEM_TYPE "SCO 3.2v4" #endif /* SCO supports job control. */ #undef NOMULTIPLEJOBS /* SCO has termios. */ #define HAVE_TERMIOS /* SCO has ptys with unusual names. */ #define HAVE_PTYS #define PTY_ITERATION \ for (i = 0; ; i++) #define PTY_NAME_SPRINTF \ sprintf (pty_name, "/dev/ptyp%d", i); #define PTY_TTY_NAME_SPRINTF \ sprintf (pty_name, "/dev/ttyp%d", i); /* Sockets are an option on SCO. If you have X, you have them. They also exist if you have TCP, but we don't know how to test for that. */ #ifdef HAVE_X_WINDOWS #define HAVE_SOCKETS #endif /* Must use 'cc' to link when build with motif toolkit. */ #ifndef __GNUC__ #define LINKER cc #endif /* This is safe since we already assumed HAVE_SOCKET if using X windows. */ #undef LIBX11_SYSTEM #define LIBX11_SYSTEM -lpt -lnls -lnsl_s -lc_s -lsocket #ifdef HAVE_INET_SOCKETS /* This comes from autoconf. */ #define HAVE_SOCKETS #endif #ifdef HAVE_SOCKETS #define LIBS_SYSTEM -lsocket -lPW /* SCO has gettimeofday in socket library */ /* Autoconf should determine this, but for now, play safe to avoid error rather than deleting this and risking the wrong result. */ #ifndef HAVE_GETTIMEOFDAY #define HAVE_GETTIMEOFDAY #endif #endif /* This enables configure to tell that we have alloca. */ #ifndef LIBS_SYSTEM #define LIBS_SYSTEM -lPW #endif #ifdef HAVE_X11R5 /* configure can't get this right linking fails unless -lsocket is used. */ #undef HAVE_XSCREENNUMBEROFSCREEN #define HAVE_XSCREENNUMBEROFSCREEN #endif /* We don't have -loldX, and we don't need it. */ #define LIB_XMENU_LIB /* SCO does have TIOCGWINSZ. */ #undef BROKEN_TIOCGWINSZ #define NEED_PTEM_H /* We need to link with crt1.o and crtn.o. */ #define START_FILES pre-crt0.o /lib/crt1.o #define LIB_STANDARD -lc /lib/crtn.o /* Send signals to subprocesses by "typing" signal chars at them. */ #define SIGNALS_VIA_CHARACTERS /* Specify program for etc/fakemail to run. Define SMAIL if you are using smail, don't for MMDF. */ #ifdef SMAIL #define MAIL_PROGRAM_NAME "/bin/smail -q0" #else #define MAIL_PROGRAM_NAME "/usr/lib/mail/execmail" #endif /* miano@acosta.enet.dec.com says these are needed. */ #define bcopy(b1,b2,len) memmove (b2, b1, len) #define bzero(b,len) memset (b, 0, len) #define bcmp(b1,b2,len) memcmp (b1, b2, len) /* Tell process_send_signal to use VSUSP instead of VSWTCH. */ #define PREFER_VSUSP /* wjs@wang.com (William Smith) says this is needed on 3.2.4.2. */ #define POSIX_SIGNALS /* wjs@wiis.wang.com says SCO 3.2 v4.2 "has sockets", but only for network connections. It doesn't have the kind of sockets that emacsclient.c and emacsserver.c would use. */ #define NO_SOCKETS_IN_FILE_SYSTEM emacs-19.30/src/s/sol2-3.h100444 75424 1 4265 5761475330 13544 0ustar kwzhdaemon#include "sol2.h" /* Solaris 2.3 has a bug in XListFontsWithInfo. */ #define BROKEN_XLISTFONTSWITHINFO /* Override LD_SWITCH_SYSTEM: add -L /usr/ccs/lib to the sol2.h value. */ #undef LD_SWITCH_SYSTEM #ifndef __GNUC__ #define LD_SWITCH_SYSTEM -L /usr/ccs/lib LD_SWITCH_X_SITE_AUX #else /* GCC */ /* We use ./prefix-args because we don't know whether LD_SWITCH_X_SITE_AUX has anything in it. It can be empty. This works ok in src. Luckily lib-src does not use LD_SWITCH_SYSTEM. */ #define LD_SWITCH_SYSTEM -L /usr/ccs/lib \ `./prefix-args -Xlinker LD_SWITCH_X_SITE_AUX` #endif /* GCC */ /* Info from fnf@cygnus.com suggests this is appropriate. */ #define POSIX_SIGNALS /* We don't need the definition from usg5-3.h with POSIX_SIGNALS. */ #undef sigsetmask /* This is the same definition as in usg5-4.h, but with sigblock/sigunblock rather than sighold/sigrelse, which appear to be BSD4.1 specific and won't work if POSIX_SIGNALS is defined. It may also be appropriate for SVR4.x (x<2) but I'm not sure. fnf@cygnus.com */ /* This sets the name of the slave side of the PTY. On SysVr4, grantpt(3) forks a subprocess, so keep sigchld_handler() from intercepting that death. If any child but grantpt's should die within, it should be caught after sigrelse(2). */ #undef PTY_TTY_NAME_SPRINTF #define PTY_TTY_NAME_SPRINTF \ { \ char *ptsname(), *ptyname; \ \ sigblock(sigmask(SIGCLD)); \ if (grantpt(fd) == -1) \ fatal("could not grant slave pty"); \ sigunblock(sigmask(SIGCLD)); \ if (unlockpt(fd) == -1) \ fatal("could not unlock slave pty"); \ if (!(ptyname = ptsname(fd))) \ fatal ("could not enable slave pty"); \ strncpy(pty_name, ptyname, sizeof(pty_name)); \ pty_name[sizeof(pty_name) - 1] = 0; \ } /* David Miller says vfork fails on 2.4. Brendan Kehoe says it also fails on 2.3. So we'll use the alternate definition in sysdep.c. But a header file has a declaration that would conflict with the definition of vfork in sysdep.c. So we'll choose the return type to match the system header. */ #undef HAVE_VFORK #define VFORK_RETURN_TYPE pid_t emacs-19.30/src/s/sol2-4.h100444 75424 1 1262 5762725172 13542 0ustar kwzhdaemon/* Handle Solaris 2.4. */ #include "sol2-3.h" #define SOLARIS2_4 /* Get rid of -traditional and let const really do its thing. */ #ifdef __GNUC__ #undef C_SWITCH_SYSTEM #undef const #endif /* __GNUC__ */ #undef LD_SWITCH_SYSTEM #ifndef __GNUC__ #define LD_SWITCH_SYSTEM -L /usr/ccs/lib LD_SWITCH_X_SITE_AUX -R /usr/dt/lib -L /usr/dt/lib #else /* GCC */ /* We use ./prefix-args because we don't know whether LD_SWITCH_X_SITE_AUX has anything in it. It can be empty. This works ok in src. Luckily lib-src does not use LD_SWITCH_SYSTEM. */ #define LD_SWITCH_SYSTEM -L /usr/ccs/lib \ `./prefix-args -Xlinker LD_SWITCH_X_SITE_AUX` -R /usr/dt/lib -L /usr/dt/lib #endif /* GCC */ emacs-19.30/src/s/sol2-5.h100444 75424 1 60 6007217061 13460 0ustar kwzhdaemon/* Handle Solaris 2.5. */ #include "sol2-4.h" emacs-19.30/src/s/sol2.h100444 12120 1 2011 5741160632 13157 0ustar rmsdaemon#include "usg5-4.h" #define SOLARIS2 /* eggert@twinsun.com said these work in Solaris. Perhaps they work in all kinds of SVR4, but this is more conservative. */ #undef BROKEN_TIOCGETC #undef BROKEN_TIOCGWINSZ /* This triggers a conditional in xfaces.c. */ #define XOS_NEEDS_TIME_H #define POSIX /* Here is how to find X Windows. LD_SWITCH_X_SITE_AUX gives an -R option says where to find X windows at run time. */ #ifndef __GNUC__ #define LD_SWITCH_SYSTEM LD_SWITCH_X_SITE_AUX #else /* GCC */ /* We use ./prefix-args because we don't know whether LD_SWITCH_X_SITE_AUX has anything in it. It can be empty. This works ok in src. Luckily lib-src does not use LD_SWITCH_SYSTEM. */ #define LD_SWITCH_SYSTEM `./prefix-args -Xlinker LD_SWITCH_X_SITE_AUX` #endif /* GCC */ #define HAVE_VFORK /* Gregory Neil Shapiro reports the Motif header files are in this directory on Solaris 2.4. Let's guess that's true for some earlier versions too. */ #define C_SWITCH_X_SYSTEM -I/usr/dt/include emacs-19.30/src/s/sunos4-0.h100444 12120 1 1605 5635760273 13711 0ustar rmsdaemon#include "bsd4-2.h" #ifndef SUNOS4 #define SUNOS4 #endif #if 0 /* This may have been needed for an earlier version of Sun OS 4. It seems to cause warnings in 4.0.3 and 4.1. */ #define O_NDELAY FNDELAY /* Non-blocking I/O (4.2 style) */ #endif /* We use the Sun syntax -Bstatic unconditionally, because even when we use GCC, these are passed through to the linker, not handled by GCC directly. */ #define LD_SWITCH_SYSTEM -e __start -Bstatic /* In SunOS 4.1, a static function called by tzsetwall reportedly clears the byte just past an eight byte region it mallocs, corrupting GNU malloc's memory pool. But Sun's malloc doesn't seem to mind. */ #define SYSTEM_MALLOC #ifdef __GNUC__ /* We must define mkdir with this arg prototype to match GCC's fixed stat.h. */ #define MKDIR_PROTOTYPE \ int mkdir (const char *dpath, unsigned short dmode) #endif /* __GNUC__ */ emacs-19.30/src/s/sunos4-1-2.h100666 11732 1 62 5446745053 14157 0ustar bfoxdaemon #include "sunos4-1.h" /* #undef SYSTEM_MALLOC */ emacs-19.30/src/s/sunos4-1-3.h100444 12120 1 423 5775153416 14027 0ustar rmsdaemon#include "sunos4-1.h" /* jik@gza.com says this works now. */ /* The bug that corrupts GNU malloc's memory pool is fixed in SunOS 4.1.3. */ #undef SYSTEM_MALLOC /* barrie@calvin.demon.co.uk says memmove is missing. */ #ifndef SYSTEM_MALLOC #define MEMMOVE_MISSING #endif emacs-19.30/src/s/sunos4-1.h100444 12120 1 2775 5653562123 13715 0ustar rmsdaemon#include "sunos4-0.h" /* 4.1.1 makes these system calls interruptible. */ #define read sys_read #define write sys_write #define open sys_open #define close sys_close #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_CLOSE #define INTERRUPTIBLE_IO /* Cause the compilation of oldxmenu to use the right -I option. */ #define OLDXMENU_OPTIONS CFLAGS=C_SWITCH_SYSTEM #if 0 /* This isn't right. Apparently some sites do have -lresolv but don't use that. On those systems, the code below loses. There's no way to win automatically unless someone figures out a way of determining automatically which way is right on any given system. */ /* Some systems do not run the Network Information Service, but have modified the shared C library to include resolver support without also changing the C archive library (/usr/lib/libc.a). If we detect the presence of libresolv.a, use -lresolv to supplement libc.a. We used to have #ifdef HAVE_GETHOSTNAME is to prevent configure from setting libsrc_libs to -lresolv in lib-src/Makefile. But nowadays configure is smarter about computing libsrc_libs, and would not be fooled. Anyway, why not use -lresolv in lib-src? */ /* #ifdef HAVE_GETHOSTNAME */ #ifdef HAVE_LIBRESOLV #define LIBS_SYSTEM -lresolv #endif /* #endif */ #endif #if 0 /* Not necessary, since SYSTEM_MALLOC is defined in sunos4-0.h. */ /* Tell GNU malloc to compensate for a bug in localtime. */ #define SUNOS_LOCALTIME_BUG #endif /* Define dlopen, dlclose, dlsym. */ #define USE_DL_STUBS emacs-19.30/src/s/sunos4shr.h100444 12120 1 2723 6002634761 14262 0ustar rmsdaemon/* This file permits building Emacs with a shared libc on Sunos 4. To make this work, you must completely replace your C shared library using one of the SunOS 4.1.x jumbo replacement patches from Sun. Here are the patch numbers for Sunos 4.1.3: 100890-10 SunOS 4.1.3: domestic libc jumbo patch 100891-10 SunOS 4.1.3: international libc jumbo patch */ #include "sunos4-1.h" /* Say that the text segment of a.out includes the header; the header actually occupies the first few bytes of the text segment and is counted in hdr.a_text. */ /* Misleading! Actually gets loaded after crt0.o */ #define START_FILES pre-crt0.o /* * Kludge! can't get at symbol "start" in std crt0.o * Who the #$%&* decided to remove the __ characters! * Someone needs to fix this in sysdep.c with an #ifdef BROKEN_START in * sysdep.c. We do not use this address so any value should do really. Still * may need it in the future? */ #define BROKEN_START #define TEXT_START 0x2020 #define UNEXEC unexsunos4.o #define RUN_TIME_REMAP #define ORDINARY_LINK #define SUNOS4_SHARED_LIBRARIES #undef LD_SWITCH_SYSTEM #undef SYSTEM_MALLOC #ifndef GNU_MALLOC #define GNU_MALLOC #endif #ifndef REL_ALLOC #define REL_ALLOC #endif /* khera@cs.duke.edu says this is needed. */ #define memmove(to, from, size) bcopy (from, to, size) #undef USE_DL_STUBS #ifdef __GNUC__ #define LIBXMU -Xlinker -Bstatic -lXmu -Xlinker -Bdynamic #else #define LIBXMU -Bstatic -lXmu -Bdynamic #endif emacs-19.30/src/s/template.h100444 75424 12 13603 5637122402 14225 0ustar kwzhstaff/* Template for system description header files. This file describes the parameters that system description files should define or not. Copyright (C) 1985, 1986, 1992 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ /* #define UNIPLUS */ /* #define USG5 */ /* #define USG */ /* #define HPUX */ /* #define UMAX */ /* #define BSD4_1 */ /* #define BSD4_2 */ /* #define BSD4_3 */ /* #define BSD */ /* #define VMS */ /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "berkeley-unix" /* NOMULTIPLEJOBS should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ /* #define NOMULTIPLEJOBS */ /* Emacs can read input using SIGIO and buffering characters itself, or using CBREAK mode and making C-g cause SIGINT. The choice is controlled by the variable interrupt_input. Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO) Emacs uses the presence or absence of the SIGIO macro to indicate whether or not signal-driven I/O is possible. It uses INTERRUPT_INPUT to decide whether to use it by default. SIGIO can be used only on systems that implement it (4.2 and 4.3). CBREAK mode has two disadvantages 1) At least in 4.2, it is impossible to handle the Meta key properly. I hear that in system V this problem does not exist. 2) Control-G causes output to be discarded. I do not know whether this can be fixed in system V. Another method of doing input is planned but not implemented. It would have Emacs fork off a separate process to read the input and send it to the true Emacs process through a pipe. */ #define INTERRUPT_INPUT /* Letter to use in finding device name of first pty, if system supports pty's. 'a' means it is /dev/ptya0 */ #define FIRST_PTY_LETTER 'a' /* * Define HAVE_TERMIOS if the system provides POSIX-style * functions and macros for terminal control. * * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. * * Do not define both. HAVE_TERMIOS is preferred, if it is * supported on your system. */ #define HAVE_TERMIOS /* #define HAVE_TERMIO */ /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ #define NONSYSTEM_DIR_LIBRARY /* Define this symbol if your system has the functions bcopy, etc. */ #define BSTRING /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* #define COFF */ /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ #define MAIL_USE_FLOCK /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ #define CLASH_DETECTION /* Define this if your operating system declares signal handlers to have a type other than the usual. `The usual' is `void' for ANSI C systems (i.e. when the __STDC__ macro is defined), and `int' for pre-ANSI systems. If you're using GCC on an older system, __STDC__ will be defined, but the system's include files will still say that signal returns int or whatever; in situations like that, define this to be what the system's include files want. */ /* #define SIGTYPE int */ /* If the character used to separate elements of the executable path is not ':', #define this to be the appropriate character constant. */ /* #define SEPCHAR ':' */ /* ============================================================ */ /* Here, add any special hacks needed to make Emacs work on this system. For example, you might define certain system call names that don't exist on your system, or that do different things on your system and must be used only through an encapsulation (Which you should place, by convention, in sysdep.c). */ /* Some compilers tend to put everything declared static into the initialized data area, which becomes pure after dumping Emacs. On these systems, you must #define static as nothing to foil this. Note that emacs carefully avoids static vars inside functions. */ /* #define static */ /* ============================================================ */ /* After adding support for a new system, modify the large case statement in the `configure' script to recognize reasonable configuration names, and add a description of the system to `etc/MACHINES'. If you've just fixed a problem in an existing configuration file, you should also check `etc/MACHINES' to make sure its descriptions of known problems in that configuration should be updated. */ emacs-19.30/src/s/ultrix4-3.h100666 12120 1 277 5673331047 14061 0ustar rmsdaemon#include "bsd4-3.h" #define NEED_UNISTD_H #define HAVE_TERMIOS #define PREFER_VSUSP /* Must set the line discipline to this, to make termio work. */ #define SET_LINE_DISCIPLINE TERMIODISC emacs-19.30/src/s/umax.h100444 75424 12 12052 5637122402 13361 0ustar kwzhstaff/* Definitions file for GNU Emacs running on UMAX 4.2 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 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ /* #define UNIPLUS */ /* #define USG5 */ /* #define USG */ /* #define BSD4_1 */ #define BSD4_2 /* #define BSD4_3 */ #define BSD #define UMAX4_2 #define UMAX /* #define VMS */ /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "berkeley-unix" /* NOMULTIPLEJOBS should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ /* #define NOMULTIPLEJOBS */ /* Emacs can read input using SIGIO and buffering characters itself, or using CBREAK mode and making C-g cause SIGINT. The choice is controlled by the variable interrupt_input. Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO) SIGIO can be used only on systems that implement it (4.2 and 4.3). CBREAK mode has two disadvantages 1) At least in 4.2, it is impossible to handle the Meta key properly. I hear that in system V this problem does not exist. 2) Control-G causes output to be discarded. I do not know whether this can be fixed in system V. Another method of doing input is planned but not implemented. It would have Emacs fork off a separate process to read the input and send it to the true Emacs process through a pipe. */ #define INTERRUPT_INPUT /* Letter to use in finding device name of first pty, if system supports pty's. 'a' means it is /dev/ptya0 */ #define FIRST_PTY_LETTER 'p' /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* Define this macro if system defines a type `union wait'. */ #define HAVE_UNION_WAIT /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ #define HAVE_SOCKETS /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ /* #define NONSYSTEM_DIR_LIBRARY */ /* Define this symbol if your system has the functions bcopy, etc. */ #define BSTRING /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ #define COFF /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ #define MAIL_USE_FLOCK /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ #define CLASH_DETECTION /* We use the Berkeley (and usg5.2.2) interface to nlist. */ #define NLIST_STRUCT /* The file containing the kernel's symbol table is called /vmunix. */ #define KERNEL_FILE "/vmunix" /* The symbol in the kernel where the load average is found is named _avenrun. */ #define LDAV_SYMBOL "_avenrun" /* Here, on a separate page, add any special hacks needed to make Emacs work on this system. For example, you might define certain system call names that don't exist on your system, or that do different things on your system and must be used only through an encapsulation (Which you should place, by convention, in sysdep.c). */ /* Specify alignment requirement for start of text and data sections in the executable file. */ #define SECTION_ALIGNMENT pagemask #define SEGMENT_MASK (64 * 1024 - 1) /* crt0.c needs this for compilation because it uses asm. */ #define C_SWITCH_ASM -q nodirect_code /* Encore machines with APC processor boards align sections on 4M boundaries, so it is not easy to remap the start of the text segment in the unexec() routine. For them you need the following two lines. For DPC processors you can enable these or not, as you wish, but you will get better performance without them. */ /* #define NO_REMAP #define TEXT_START 0 */ /* (Assume) we do have vfork. */ #define HAVE_VFORK /* Process groups work in the traditional BSD manner. */ #define BSD_PGRPS emacs-19.30/src/s/umips.h100444 75424 12 3446 5637122401 13532 0ustar kwzhstaff/* Definitions file for GNU Emacs running on Mips operating system. That system can emulate either BSD or Sys V, in either case with changes. If BSD is defined, we assume BSD is being emulated; otherwise, Sys V. */ #ifdef BSD #include "bsd4-3.h" #define C_SWITCH_SYSTEM -systype bsd43 #define LD_SWITCH_SYSTEM -systype bsd43 #define LIBS_SYSTEM -lmld #define LIBS_DEBUG #define START_FILES pre-crt0.o /lib/crt1.o #define LIB_STANDARD -lc /usr/lib/crtn.o #define COFF #define TERMINFO #undef MAIL_USE_FLOCK /* Someone should check this. */ #undef HAVE_UNION_WAIT #else /* not BSD */ #include "usg5-2-2.h" #define LIBS_SYSTEM -lmld #define LIBS_DEBUG #define START_FILES pre-crt0.o /usr/lib/crt1.o #define LIB_STANDARD -lbsd -lc /usr/lib/crtn.o /* #define LIBS_TERMCAP -lcurses */ #define C_SWITCH_SYSTEM -I/usr/include/bsd /* Cancel certain parts of standard sysV support. */ #undef NONSYSTEM_DIR_LIBRARY #define SYSV_SYSTEM_DIR #undef static /* Don't try to use SIGIO or FIONREAD even though they are defined. */ #undef SIGIO #define BROKEN_FIONREAD /* Describe special kernel features. */ #define HAVE_SYSVIPC #if defined(emacs) #include #endif /* The `select' in the system won't work for pipes, so don't use it. */ #define BROKEN_SELECT #define HAVE_DUP2 #define HAVE_GETWD #define HAVE_GETTIMEOFDAY #define HAVE_PTYS #define HAVE_SOCKETS /* #define BSTRING Supposedly removed. */ #undef NOMULTIPLEJOBS #define CLASH_DETECTION #if defined(HAVE_X_WINDOWS) && defined(HAVE_X11) #define HAVE_VFORK /* Graciously provided by libX.a */ #endif #define utimes utime /* Someone should check this. */ /* ??? */ #define IRIS #endif /* not BSD */ /* High order bit must be stripped off nlist return values */ #define FIXUP_KERNEL_SYMBOL_ADDR(NL) (NL)[0].n_value &= 0x7fffffff; emacs-19.30/src/s/unipl5-0.h100444 75424 12 11722 5637122401 13762 0ustar kwzhstaff/* Definitions file for GNU Emacs running on UniSoft's UniPlus 5.0 Support for this system is not finished; don't expect this to work. 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 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #define USG /* System III, System V, etc */ #define USG5 #define UNIPLUS /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "unisoft-unix" /* NOMULTIPLEJOBS should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ /* #define NOMULTIPLEJOBS */ /* Default is to set interrupt_input to 0: don't do input buffering within Emacs */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'a' means it is /dev/ptya0 */ /* #define FIRST_PTY_LETTER 'a' */ /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIO /* * Define HAVE_PTYS if the system supports pty devices. */ /* #define HAVE_PTYS */ /* Define this macro if system defines a type `union wait'. */ #define HAVE_UNION_WAIT /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ /* #define HAVE_SOCKETS */ /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ #define NONSYSTEM_DIR_LIBRARY /* Define this symbol if your system has the functions bcopy, etc. */ /* #define BSTRING */ /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ /* #define subprocesses */ /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* #define COFF */ /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* Define SHORTNAMES if the C compiler can distinguish only short names. It means that the stuff in ../shortnames must be run to convert the long names to short ones. Some USG systems support long names. If yours is one, DO NOT change this file! Do #undef SHORTNAMES in the m- file or in config.h. */ #define SHORTNAMES /* We do NOT use the Berkeley (and usg5.2.2) interface to nlist. */ /* #define NLIST_STRUCT */ /* The file containing the kernel's symbol table is called /unix. */ #define KERNEL_FILE "/unix" /* The symbol in the kernel where the load average is found is named avenrun. */ #define LDAV_SYMBOL "avenrun" /* Special hacks needed to make Emacs run on this system. */ /* * Make the sigsetmask function go away. Don't know what the * ramifications of this are, but doesn't seem possible to * emulate it properly anyway at this point. */ #define sigsetmask(mask) /* Null expansion */ /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp #define _longjmp longjmp /* On USG systems the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define open sys_open #define write sys_write #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_IO /* On USG systems these have different names */ #define index strchr #define rindex strrchr /* Compiler bug bites when default ADDR_CORRECT is used. */ #define ADDR_CORRECT(x) (x) /* Special library needed for linking for Uniplus */ #define LIBS_SYSTEM -lnet /* A system-specific loader switch is needed. */ #define LD_SWITCH_SYSTEM -N -L/lib/libg /usr/lib/unshared.ld emacs-19.30/src/s/unipl5-2.h100444 75424 12 11221 5637122401 13756 0ustar kwzhstaff/* Definitions file for GNU Emacs running on UniSoft's UniPlus 5.2 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 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #define USG /* System III, System V, etc */ #define USG5 #define UNIPLUS /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "unisoft-unix" /* nomultiplejobs should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ /* #define NOMULTIPLEJOBS */ /* Default is to set interrupt_input to 0: don't do input buffering within Emacs */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'p' means it is /dev/ptyp0 */ #define FIRST_PTY_LETTER 'p' /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIO /* * Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS /* Define this macro if system defines a type `union wait'. */ #define HAVE_UNION_WAIT /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ /* #define HAVE_SOCKETS */ /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ #define NONSYSTEM_DIR_LIBRARY /* Define this symbol if your system has the functions bcopy, etc. */ /* #define BSTRING */ /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. It is supported under UniPlus System V Release 2. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ #define COFF /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* Uniplus 5.2 supports long names in C */ /* #define SHORTNAMES */ /* We do NOT use the Berkeley (and usg5.2.2) interface to nlist. */ /* #define NLIST_STRUCT */ /* The file containing the kernel's symbol table is called /unix. */ #define KERNEL_FILE "/unix" /* The symbol in the kernel where the load average is found is named avenrun. */ #define LDAV_SYMBOL "avenrun" /* Special hacks needed to make Emacs run on this system. */ /* * Make the sigsetmask function go away. Don't know what the * ramifications of this are, but doesn't seem possible to * emulate it properly anyway at this point. */ #define sigsetmask(mask) /* Null expansion */ /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp #define _longjmp longjmp /* On USG systems the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define open sys_open #define write sys_write #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_IO /* On USG systems these have different names */ #define index strchr #define rindex strrchr /* Compiler bug bites when default ADDR_CORRECT is used. */ #define ADDR_CORRECT(x) (x) /* Special library needed for linking for Uniplus */ #define LIBS_SYSTEM -lnet /* A system-specific loader switch is needed. */ #define LD_SWITCH_SYSTEM -N -L/lib/libg /usr/lib/unshared.ld emacs-19.30/src/s/usg5-0.h100444 75424 12 11347 5637122401 13434 0ustar kwzhstaff/* Definitions file for GNU Emacs running on AT&T's System V.0 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 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #define USG /* System III, System V, etc */ #define USG5 #define USG5_0 /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "usg-unix-v" /* nomultiplejobs should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ #define NOMULTIPLEJOBS /* Default is to set interrupt_input to 0: don't do input buffering within Emacs */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'p' means it is /dev/ptyp0 */ #define FIRST_PTY_LETTER 'p' /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIO /* * Define HAVE_PTYS if the system supports pty devices. */ /* #define HAVE_PTYS */ /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ /* #define HAVE_SOCKETS */ /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ #define NONSYSTEM_DIR_LIBRARY /* Define this symbol if your system has the functions bcopy, etc. */ /* #define BSTRING */ /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is supposed to work now on system V release 2. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ #define COFF /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* Define SHORTNAMES if the C compiler can distinguish only short names. It means that the stuff in ../shortnames must be run to convert the long names to short ones. */ #define SHORTNAMES /* We do NOT use the Berkeley (and usg5.2.2) interface to nlist. */ /* #define NLIST_STRUCT */ /* The file containing the kernel's symbol table is called /unix. */ #define KERNEL_FILE "/unix" /* The symbol in the kernel where the load average is found is named avenrun. */ #define LDAV_SYMBOL "avenrun" /* Special hacks needed to make Emacs run on this system. */ /* * Make the sigsetmask function go away. Don't know what the * ramifications of this are, but doesn't seem possible to * emulate it properly anyway at this point. */ #define sigsetmask(mask) /* Null expansion */ /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp #define _longjmp longjmp /* On USG systems the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define open sys_open #define write sys_write #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_IO /* On USG systems these have different names */ #define index strchr #define rindex strrchr /* USG systems tend to put everything declared static into the initialized data area, which becomes pure after dumping Emacs. Foil this. Emacs carefully avoids static vars inside functions. */ #define static /* Compiler bug bites on many systems when default ADDR_CORRECT is used. */ #define ADDR_CORRECT(x) (x) /* Prevent -lg from being used for debugging. Not implemented? */ #define LIBS_DEBUG emacs-19.30/src/s/usg5-2-2.h100444 75424 12 11426 5637122400 13572 0ustar kwzhstaff/* Definitions file for GNU Emacs running on AT&T's System V Release 2.2 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 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #define USG /* System III, System V, etc */ #define USG5 /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "usg-unix-v" /* nomultiplejobs should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ #define NOMULTIPLEJOBS /* Default is to set interrupt_input to 0: don't do input buffering within Emacs */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'p' means it is /dev/ptyp0 */ #define FIRST_PTY_LETTER 'p' /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIO /* * Define HAVE_PTYS if the system supports pty devices. */ /* #define HAVE_PTYS */ /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ /* #define HAVE_SOCKETS */ /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ #define NONSYSTEM_DIR_LIBRARY /* Define this symbol if your system has the functions bcopy, etc. */ /* #define BSTRING */ /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is supposed to work now on system V release 2. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ #define COFF /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* Define SHORTNAMES if the C compiler can distinguish only short names. It means that the stuff in ../shortnames must be run to convert the long names to short ones. */ /* #define SHORTNAMES */ /* We use the Berkeley (and usg5.2.2) interface to nlist. */ #define NLIST_STRUCT /* The file containing the kernel's symbol table is called /unix. */ #define KERNEL_FILE "/unix" /* The symbol in the kernel where the load average is found is named avenrun. */ #define LDAV_SYMBOL "avenrun" /* Special hacks needed to make Emacs run on this system. */ /* * Make the sigsetmask function go away. Don't know what the * ramifications of this are, but doesn't seem possible to * emulate it properly anyway at this point. */ #define sigsetmask(mask) /* Null expansion */ /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp #define _longjmp longjmp /* On USG systems the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define open sys_open #define write sys_write #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_IO /* On USG systems these have different names */ #define index strchr #define rindex strrchr /* USG systems tend to put everything declared static into the initialized data area, which becomes pure after dumping Emacs. Foil this. Emacs carefully avoids static vars inside functions. */ #define static /* Compiler bug bites on many systems when default ADDR_CORRECT is used. */ #define ADDR_CORRECT(x) (x) /* Prevent -lg from being used for debugging. Not implemented? */ #define LIBS_DEBUG /* Use terminfo instead of termcap. */ #define TERMINFO emacs-19.30/src/s/usg5-2.h100444 75424 12 11443 5637122400 13432 0ustar kwzhstaff/* Definitions file for GNU Emacs running on AT&T's System V Release 2.0 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 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #define USG /* System III, System V, etc */ #define USG5 /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "usg-unix-v" /* nomultiplejobs should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ #define NOMULTIPLEJOBS /* Default is to set interrupt_input to 0: don't do input buffering within Emacs */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'p' means it is /dev/ptyp0 */ #define FIRST_PTY_LETTER 'p' /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIO /* * Define HAVE_PTYS if the system supports pty devices. */ /* #define HAVE_PTYS */ /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ /* #define HAVE_SOCKETS */ /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ #define NONSYSTEM_DIR_LIBRARY /* Define this symbol if your system has the functions bcopy, etc. */ /* #define BSTRING */ /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is supposed to work now on system V release 2. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ #define COFF /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* Define SHORTNAMES if the C compiler can distinguish only short names. It means that the stuff in ../shortnames must be run to convert the long names to short ones. */ /* #define SHORTNAMES */ /* We do NOT use the Berkeley (and usg5.2.2) interface to nlist. */ /* #define NLIST_STRUCT */ /* The file containing the kernel's symbol table is called /unix. */ #define KERNEL_FILE "/unix" /* The symbol in the kernel where the load average is found is named avenrun. */ #define LDAV_SYMBOL "avenrun" /* Special hacks needed to make Emacs run on this system. */ /* * Make the sigsetmask function go away. Don't know what the * ramifications of this are, but doesn't seem possible to * emulate it properly anyway at this point. */ #define sigsetmask(mask) /* Null expansion */ /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp #define _longjmp longjmp /* On USG systems the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define open sys_open #define write sys_write #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_IO /* On USG systems these have different names */ #define index strchr #define rindex strrchr /* USG systems tend to put everything declared static into the initialized data area, which becomes pure after dumping Emacs. Foil this. Emacs carefully avoids static vars inside functions. */ #define static /* Compiler bug bites on many systems when default ADDR_CORRECT is used. */ #define ADDR_CORRECT(x) (x) /* Prevent -lg from being used for debugging. Not implemented? */ #define LIBS_DEBUG /* Use terminfo instead of termcap. */ #define TERMINFO emacs-19.30/src/s/usg5-3.h100444 75424 12 13656 5637122400 13443 0ustar kwzhstaff/* Definitions file for GNU Emacs running on AT&T's System V Release 3 Copyright (C) 1987 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #define USG /* System III, System V, etc */ #define USG5 #define USG5_3 /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "usg-unix-v" /* nomultiplejobs should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ #define NOMULTIPLEJOBS /* Default is to set interrupt_input to 0: don't do input buffering within Emacs */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'p' means it is /dev/ptyp0 */ #define FIRST_PTY_LETTER 'p' /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIO /* * Define HAVE_PTYS if the system supports pty devices. */ /* Some versions of V.3 have this, but not all. #define HAVE_PTYS #define SYSV_PTYS */ /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ /* #define HAVE_SOCKETS */ /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ /* #define NONSYSTEM_DIR_LIBRARY */ /* * Define SYSV_SYSTEM_DIR to use the V.3 getdents/readir * library functions. Almost, but not quite the same as * the 4.2 functions */ #define SYSV_SYSTEM_DIR /* Define this symbol if your system has the functions bcopy, etc. */ /* #define BSTRING */ /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is supposed to work now on system V release 2. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ #define COFF /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* Define SHORTNAMES if the C compiler can distinguish only short names. It means that the stuff in ../shortnames must be run to convert the long names to short ones. */ /* #define SHORTNAMES */ /* We use the Berkeley (and usg5.2.2) interface to nlist. */ #define NLIST_STRUCT /* The file containing the kernel's symbol table is called /unix. */ #define KERNEL_FILE "/unix" /* The symbol in the kernel where the load average is found is named avenrun. */ #define LDAV_SYMBOL "avenrun" /* Define this if system V IPC is available. */ #define HAVE_SYSVIPC /* Special hacks needed to make Emacs run on this system. */ /* * Make the sigsetmask function go away. Don't know what the * ramifications of this are, but doesn't seem possible to * emulate it properly anyway at this point. */ #define sigsetmask(mask) /* Null expansion */ /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp #define _longjmp longjmp /* On USG systems the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define write sys_write #define open sys_open #define close sys_close #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_CLOSE #define INTERRUPTIBLE_IO /* On USG systems these have different names */ #define index strchr #define rindex strrchr /* USG systems tend to put everything declared static into the initialized data area, which becomes pure after dumping Emacs. Foil this. Emacs carefully avoids static vars inside functions. */ #define static /* Compiler bug bites on many systems when default ADDR_CORRECT is used. */ #define ADDR_CORRECT(x) (x) /* Use terminfo instead of termcap. */ #define TERMINFO /* Some variants have TIOCGETC, but the structures to go with it are not declared. */ #define BROKEN_TIOCGETC /* AT&T SVr3 X wants to be linked with shared libraries */ #define LIB_X11_LIB -lX11_s /* X needs to talk on the network, so search the network library. */ #define LIBX10_SYSTEM -lnsl_s #define LIBX11_SYSTEM -lpt -lnls -lnsl_s -lc_s /* The docs for system V/386 suggest v.3 has sigpause, so let's give it a try. */ #define HAVE_SYSV_SIGPAUSE /* Some variants have TIOCGWINSZ, but the structures to go with it are not declared. */ #define BROKEN_TIOCGWINSZ /* If we're using the System V X port, BSD bstring functions will be handy */ #ifdef HAVE_X_WINDOWS #define BSTRING #endif /* HAVE_X_WINDOWS */ /* Enable support for shared libraries in unexec. */ #define USG_SHARED_LIBRARIES /* On USG systems signal handlers return void */ #define SIGTYPE void emacs-19.30/src/s/usg5-4-2.h100444 12120 1 3640 5774723011 13476 0ustar rmsdaemon/* s/ file for System V release 4.2. */ #include "usg5-4.h" /* pcg@aber.ac.uk says this is useless since fork does copy-on-write #define HAVE_VFORK */ /* fnf@cygnus.com says these exist. */ #define HAVE_TCATTR #if 0 /* autoconf should take care of this. */ #define HAVE_GETHOSTNAME #define HAVE_RANDOM #endif /* #define HAVE_GETWD (appears to be buggy on SVR4.2) */ /* Info from fnf@cygnus.com suggests this is appropriate. */ #define POSIX_SIGNALS /* We don't need the definition from usg5-3.h with POSIX_SIGNALS. */ #undef sigsetmask #undef HAVE_SYSV_SIGPAUSE /* Motif needs -lgen. */ #undef LIBS_SYSTEM #define LIBS_SYSTEM -lsocket -lnsl -lelf -lgen /* This is the same definition as in usg5-4.h, but with sigblock/sigunblock rather than sighold/sigrelse, which appear to be BSD4.1 specific and won't work if POSIX_SIGNALS is defined. It may also be appropriate for SVR4.x (x<2) but I'm not sure. fnf@cygnus.com */ /* This sets the name of the slave side of the PTY. On SysVr4, grantpt(3) forks a subprocess, so keep sigchld_handler() from intercepting that death. If any child but grantpt's should die within, it should be caught after sigrelse(2). */ #undef PTY_TTY_NAME_SPRINTF #define PTY_TTY_NAME_SPRINTF \ { \ char *ptsname(), *ptyname; \ \ sigblock(sigmask(SIGCLD)); \ if (grantpt(fd) == -1) \ fatal("could not grant slave pty"); \ sigunblock(sigmask(SIGCLD)); \ if (unlockpt(fd) == -1) \ fatal("could not unlock slave pty"); \ if (!(ptyname = ptsname(fd))) \ fatal ("could not enable slave pty"); \ strncpy(pty_name, ptyname, sizeof(pty_name)); \ pty_name[sizeof(pty_name) - 1] = 0; \ } /* Use libw.a along with X11R6 Xt. */ #define NEED_LIBW /* ryanr@ellingtn.ftc.nrcs.usda.gov (Richard Anthony Ryan) says -lXimp is needed in UNIX_SV ... 4.2 1.1.2. */ #define LIB_MOTIF -lXm -lXimp #define VFORK_RETURN_TYPE pid_t emacs-19.30/src/s/usg5-4.h100444 12120 1 13501 6051312746 13352 0ustar rmsdaemon/* Definitions file for GNU Emacs running on AT&T's System V Release 4 Copyright (C) 1987, 1990 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. */ /* This file written by James Van Artsdalen of Dell Computer Corporation. * james@bigtex.cactus.org. Subsequently improved for Dell 2.2 by Eric * S. Raymond . */ /* Use the SysVr3 file for at least base configuration. */ #include "usg5-3.h" #define USG5_4 /* We do have multiple jobs. Handle ^Z. */ #undef NOMULTIPLEJOBS #define LIBS_SYSTEM -lsocket -lnsl -lelf #define ORDINARY_LINK #if 0 #ifdef ORDINARY_LINK #define LIB_STANDARD -lc /usr/ucblib/libucb.a #else #define START_FILES pre-crt0.o /usr/ccs/lib/crt1.o /usr/ccs/lib/crti.o /usr/ccs/lib/values-Xt.o #define LIB_STANDARD -lc /usr/ucblib/libucb.a /usr/ccs/lib/crtn.o #endif #else #ifdef ORDINARY_LINK #define LIB_STANDARD #else #define START_FILES pre-crt0.o /usr/ccs/lib/crt1.o /usr/ccs/lib/crti.o /usr/ccs/lib/values-Xt.o #define LIB_STANDARD -lc /usr/ccs/lib/crtn.o #endif #endif /* there are no -lg libraries on this system, and no libPW */ #define LIBS_DEBUG /* This is turned off because nobody actually uses LIBS_STANDARD (Nov 1995). That name is a typo. The next step is to delete this entirely. */ /* #define LIBS_STANDARD -lc */ /* No */ #define NO_SIOCTL_H /* Undump with ELF */ #undef COFF #define UNEXEC unexelf.o /* *defines* stat(2) as a static function. If "static" * is blank, then many files will have a public definition for stat(2). */ #undef static /* Get FIONREAD from . Get to get struct * tchars. But get first to make sure ttold.h doesn't * interfere. And don't try to use SIGIO yet. */ #ifndef NOT_C_CODE #include #endif #ifdef emacs #include #include #include #include #include #include #include #undef SIGIO #endif /* Some SVr4s don't define NSIG in sys/signal.h for ANSI environments; * instead, there's a system variable _sys_nsig. Unfortunately, we need the * constant to dimension an array. So wire in the appropriate value here. */ #ifndef NSIG #define NSIG 32 #endif /* We need bss_end from emacs.c for undumping */ #ifndef USG_SHARED_LIBRARIES #define USG_SHARED_LIBRARIES #endif /* We can support this */ #define CLASH_DETECTION #define HAVE_PTYS #define HAVE_TERMIOS #undef BROKEN_TIOCGWINSZ #undef BROKEN_TIOCGETC /* It is possible to receive SIGCHLD when there are no children waiting, because a previous waitsys(2) cleaned up the carcass of child without clearing the SIGCHLD pending info. So, use a non-blocking wait3 instead, which maps to waitpid(2) in SysVr4. */ #define HAVE_WAIT_HEADER #define WAITTYPE int #define wait3(status, options, rusage) \ waitpid ((pid_t) -1, (status), (options)) #define WRETCODE(w) (w >> 8) /* TIOCGPGRP is broken in SysVr4, so we can't send signals to PTY subprocesses the usual way. But TIOCSIGNAL does work for PTYs, and this is all we need. */ #define TIOCSIGSEND TIOCSIGNAL /* This change means that we don't loop through allocate_pty too many times in the (rare) event of a failure. */ #undef FIRST_PTY_LETTER #define FIRST_PTY_LETTER 'z' /* This sets the name of the master side of the PTY. */ #define PTY_NAME_SPRINTF strcpy (pty_name, "/dev/ptmx"); /* This sets the name of the slave side of the PTY. On SysVr4, grantpt(3) forks a subprocess, so keep sigchld_handler() from intercepting that death. If any child but grantpt's should die within, it should be caught after sigrelse(2). */ #define PTY_TTY_NAME_SPRINTF \ { \ char *ptsname (), *ptyname; \ \ sighold (SIGCLD); \ if (grantpt (fd) == -1) \ { close (fd); return -1; } \ sigrelse (SIGCLD); \ if (unlockpt (fd) == -1) \ { close (fd); return -1; } \ if (!(ptyname = ptsname (fd))) \ { close (fd); return -1; } \ strncpy (pty_name, ptyname, sizeof (pty_name)); \ pty_name[sizeof (pty_name) - 1] = 0; \ } /* Push various streams modules onto a PTY channel. */ #define SETUP_SLAVE_PTY \ if (ioctl (xforkin, I_PUSH, "ptem") == -1) \ fatal ("ioctl I_PUSH ptem", errno); \ if (ioctl (xforkin, I_PUSH, "ldterm") == -1) \ fatal ("ioctl I_PUSH ldterm", errno); \ if (ioctl (xforkin, I_PUSH, "ttcompat") == -1) \ fatal ("ioctl I_PUSH ttcompat", errno); /* Undo the SVr3 X11 library definition */ #undef LIB_X11_LIB /* The definition of this in s-usg5-3.h is not needed in 5.4. */ /* liblnsl_s should never be used. The _s suffix implies a shared library, as opposed to a DLL. Share libraries were used in SVR3, and are available only in order to allow SVR3 binaries to run. They should not be linked in to new binaries. -- caraway!pinkas@caraway.intel.com. */ #undef LIBX10_SYSTEM #undef LIBX11_SYSTEM /* Tell x11term.c and keyboard.c we have the system V streams feature. */ #define SYSV_STREAMS /* This definition was suggested for next release. So give it a try. */ #define HAVE_SOCKETS #define bcopy(src,dst,n) memmove (dst,src,n) #define bcmp(src,dst,n) memcmp (src,dst,n) #define bzero(s,n) memset (s,0,n) emacs-19.30/src/s/vms.h100444 75424 12 16764 5637122377 13245 0ustar kwzhstaff/* system description header for VMS Copyright (C) 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 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ #ifndef VMS /* Decus cpp doesn't define this but VAX C does */ #define VMS #endif /* VMS */ /* Note that this file is used indirectly via vms4-0.h, or some other such file. These other files define a symbol VMS4_0, VMS4_2, etc. */ /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "vax-vms" /* NOMULTIPLEJOBS should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ /* #define NOMULTIPLEJOBS */ /* INTERRUPT_INPUT controls a default for Unix systems. VMS uses a separate mechanism. */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'a' means it is /dev/ptya0 */ #define FIRST_PTY_LETTER 'a' /* * Define HAVE_PTYS if the system supports pty devices. */ /* #define HAVE_PTYS */ /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ /* #define HAVE_SOCKETS */ /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ #define NONSYSTEM_DIR_LIBRARY /* Define this symbol if your system has the functions bcopy, etc. */ /* #define BSTRING */ /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* #define COFF */ /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* Define the maximum record length for print strings, if needed. */ #define MAX_PRINT_CHARS 300 /* Here, on a separate page, add any special hacks needed to make Emacs work on this system. For example, you might define certain system call names that don't exist on your system, or that do different things on your system and must be used only through an encapsulation (Which you should place, by convention, in sysdep.c). */ /* Do you have the shareable library bug? If you link with a shareable library that contains psects with the NOSHR attribute and also refer to those psects in your program, the linker give you a private version of the psect which is not related to the version used by the shareable library. The end result is that your references to variables in that psect have absolutely nothing to do with library references to what is supposed to be the same variable. If you intend to link with the standard C library (NOT the shareable one) you don't need to define this. (This is NOT fixed in V4.4...) */ #define SHAREABLE_LIB_BUG /* Partially due to the above mentioned bug and also so that we don't need to require that people have a shareable C library, the default for Emacs is to link with the non-shared library. If you want to link with the shared library, define this and remake xmakefile and fileio.c. This allows us to ship a guaranteed executable image. */ #define LINK_CRTL_SHARE /* Define this if you want to read the file SYS$SYSTEM:SYSUAF.DAT for user information. If you do use this, you must either make SYSUAF.DAT world readable or install Emacs with SYSPRV. */ /* #define READ_SYSUAF */ /* On VMS these have a different name */ #define index strchr #define rindex strrchr #define unlink delete #ifndef _GNUC_ extern double mth$dmod(double, double); #define drem mth$dmod #endif /* Some time rountines are missing in the VAX C RTL, or needs some extra bit of code */ #define tzset sys_tzset #define localtime sys_localtime #define gmtime sys_gmtime /* On later versions of VMS these exist in the C run time library, but we are using our own implementations. Hide their names to avoid linker errors */ #define rename sys_rename #define execvp sys_execvp #define system sys_system #ifndef GNU_MALLOC /* Hide these names so that we don't get linker errors */ #define malloc sys_malloc #define free sys_free #define realloc sys_realloc #define calloc sys_calloc /* Don't use the standard brk and sbrk */ #define sbrk sys_sbrk #define brk sys_brk #endif /* On VMS we want to avoid reading and writing very large amounts of data at once, so we redefine read and write here. */ #define read sys_read #define write sys_write /* sys_creat just calls the real creat with additional args of "rfm=var", "rat=cr" to get "normal" VMS files... */ #define creat sys_creat /* fwrite forces an RMS PUT on every call. This is abysmally slow, so we emulate fwrite with fputc, which forces buffering and is much faster! */ #define fwrite sys_fwrite /* getuid only returns the member number, which is not unique on most VMS systems. We emulate it with (getgid()<<16 | getuid()). */ #define getuid sys_getuid /* If user asks for TERM, check first for EMACS_TERM. */ #define getenv sys_getenv /* Standard C abort is less useful than it should be. */ #define abort sys_abort /* Case conflicts with C library fread. */ #define Fread F_read /* Case conflicts with C library srandom. */ #define Srandom S_random /* variable length too long... maybe */ #if 0 #define do_line_insertion_deletion_costs do_line_insertion_deletion_cost #endif /* Cause initialization of vmsfns.c to be run. */ #define SYMS_SYSTEM syms_of_vmsfns () /* VAXCRTL access doesn't deal with SYSPRV very well (among other oddites...) Here, we use $CHKPRO to really determine access. */ #define access sys_access #define PAGESIZE 512 #define _longjmp longjmp #define _setjmp setjmp globalref char sdata[]; #define DATA_START (((int) sdata + 511) & ~511) #define TEXT_START 512 /* Baud-rate values from tty status are not standard. */ #define BAUD_CONVERT \ { 0, 50, 75, 110, 134, 150, 300, 600, 1200, 1800, \ 2000, 2400, 3600, 4800, 7200, 9600, 19200 } #define PURESIZE 330000 /* Stdio FILE type has extra indirect on VMS, so must alter this macro. */ #define PENDING_OUTPUT_COUNT(FILE) ((*(FILE))->_ptr - (*(FILE))->_base) #define NULL_DEVICE "NLA0:" #define TERMCAP_NAME "emacs_library:[etc]termcap.dat" #define EXEC_SUFFIXES ".exe:.com" /* Case conflict with Xlib XFree () */ #define xfree emacs_xfree /* What separator do we use in paths? */ #define SEPCHAR ',' emacs-19.30/src/s/vms4-0.h100444 13437 1 40 5122177635 13426 0ustar jimbdaemon#include "vms.h" #define VMS4_0 emacs-19.30/src/s/vms4-2.h100444 13437 1 41 5122177636 13432 0ustar jimbdaemon#include "vms.h" #define VMS4_2 emacs-19.30/src/s/vms4-4.h100444 13437 1 41 5122177636 13434 0ustar jimbdaemon#include "vms.h" #define VMS4_4 emacs-19.30/src/s/vms5-5.h100666 12120 1 361 5267476204 13340 0ustar rmsdaemon#include "vms.h" #define VMS5_5 #define VMS4_4 /* The bug that SHAREABLE_LIB_BUG fixes is gone in version 5.5 of VMS. And defining it causes lossage because sys_errlist has a different number of elements. */ #undef SHAREABLE_LIB_BUG emacs-19.30/src/s/windows95.h100444 23073 1 132 5775062555 15025 0ustar voelkerdaemon/* System description file for Windows 95. */ #include "windowsnt.h" #define WINDOWS95 emacs-19.30/src/s/windowsnt.h100444 23073 1 24336 6047602071 15247 0ustar voelkerdaemon/* System description file for Windows NT. Copyright (C) 1993, 1994, 1995 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ /* #define UNIPLUS */ /* #define USG5 */ /* #define USG */ /* #define HPUX */ /* #define UMAX */ /* #define BSD4_1 */ /* #define BSD4_2 */ /* #define BSD4_3 */ /* #define BSD */ /* #define VMS */ #ifndef WINDOWSNT #define WINDOWSNT #endif #ifndef DOS_NT #define DOS_NT /* MSDOS or WINDOWSNT */ #endif /* If you are compiling with a non-C calling convention but need to declare vararg routines differently, put it here */ #define _VARARGS_ __cdecl /* If you are providing a function to something that will call the function back (like a signal handler and signal, or main) its calling convention must be whatever standard the libraries expect */ #define _CALLBACK_ __cdecl /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "windows-nt" #define SYMS_SYSTEM syms_of_ntterm () #define NO_MATHERR #define HAVE_FREXP #define HAVE_FMOD /* NOMULTIPLEJOBS should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ /* #define NOMULTIPLEJOBS */ /* Emacs can read input using SIGIO and buffering characters itself, or using CBREAK mode and making C-g cause SIGINT. The choice is controlled by the variable interrupt_input. Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO) Emacs uses the presence or absence of the SIGIO macro to indicate whether or not signal-driven I/O is possible. It uses INTERRUPT_INPUT to decide whether to use it by default. SIGIO can be used only on systems that implement it (4.2 and 4.3). CBREAK mode has two disadvantages 1) At least in 4.2, it is impossible to handle the Meta key properly. I hear that in system V this problem does not exist. 2) Control-G causes output to be discarded. I do not know whether this can be fixed in system V. Another method of doing input is planned but not implemented. It would have Emacs fork off a separate process to read the input and send it to the true Emacs process through a pipe. */ #define INTERRUPT_INPUT /* Letter to use in finding device name of first pty, if system supports pty's. 'a' means it is /dev/ptya0 */ #define FIRST_PTY_LETTER 'a' /* * Define HAVE_TERMIOS if the system provides POSIX-style * functions and macros for terminal control. * * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. * * Do not define both. HAVE_TERMIOS is preferred, if it is * supported on your system. */ /* #define HAVE_TERMIOS */ /* #define HAVE_TERMIO */ /* * Define HAVE_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL struct timeval { long tv_sec; /* seconds */ long tv_usec; /* microseconds */ }; struct timezone { int tz_minuteswest; /* minutes west of Greenwich */ int tz_dsttime; /* type of dst correction */ }; void gettimeofday (struct timeval *, struct timezone *); /* * Define HAVE_SELECT if the system supports the `select' system call. */ /* #define HAVE_SELECT */ /* * Define HAVE_PTYS if the system supports pty devices. */ /* #define HAVE_PTYS */ /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ /* #define NONSYSTEM_DIR_LIBRARY */ /* Define this symbol if your system has the functions bcopy, etc. */ #define BSTRING #define bzero(b, l) memset(b, 0, l) #define bcopy(s, d, l) memcpy(d, s, l) #define bcmp(a, b, l) memcmp(a, b, l) /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is generally OS dependent, and not supported under most USG systems. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ #define COFF /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ /* #define MAIL_USE_FLOCK */ /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* #define CLASH_DETECTION */ /* Define this if your operating system declares signal handlers to have a type other than the usual. `The usual' is `void' for ANSI C systems (i.e. when the __STDC__ macro is defined), and `int' for pre-ANSI systems. If you're using GCC on an older system, __STDC__ will be defined, but the system's include files will still say that signal returns int or whatever; in situations like that, define this to be what the system's include files want. */ /* #define SIGTYPE int */ /* If the character used to separate elements of the executable path is not ':', #define this to be the appropriate character constant. */ #define SEPCHAR ';' /* ============================================================ */ /* Here, add any special hacks needed to make Emacs work on this system. For example, you might define certain system call names that don't exist on your system, or that do different things on your system and must be used only through an encapsulation (Which you should place, by convention, in sysdep.c). */ /* Define this to be the separator between path elements */ #define DIRECTORY_SEP '\\' /* Define this to be the separator between devices and paths */ #define DEVICE_SEP ':' /* We'll support either convention on NT. */ #define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\') #define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_)) /* The null device on Windows NT. */ #define NULL_DEVICE "NUL:" #define EXEC_SUFFIXES ".exe:.com:.bat:" #ifndef MAXPATHLEN #define MAXPATHLEN _MAX_PATH #endif #define LISP_FLOAT_TYPE #define HAVE_DUP2 1 #define HAVE_RENAME 1 #define HAVE_RMDIR 1 #define HAVE_MKDIR 1 #define HAVE_GETHOSTNAME 1 #define HAVE_RANDOM 1 #define USE_UTIME 1 #define HAVE_MOUSE 1 #define HAVE_TZNAME 1 #ifdef HAVE_NTGUI #define HAVE_WINDOW_SYSTEM #define HAVE_FACES #endif #define MODE_LINE_BINARY_TEXT(_b_) (NILP ((_b_)->buffer_file_type) ? "T" : "B") /* These have to be defined because our compilers treat __STDC__ as being defined (most of them anyway). */ #define access _access #define chdir _chdir #define chmod _chmod #define close _close #define creat _creat #define dup _dup #define dup2 _dup2 #define execlp _execlp #define execvp _execvp #define getpid _getpid #define index strchr #define isatty _isatty #define link _link #define lseek _lseek #define mkdir _mkdir #define mktemp _mktemp #define open _open #define pipe _pipe #define read _read #define rmdir _rmdir #define sleep nt_sleep #define unlink _unlink #define umask _umask #define utime _utime #define write _write #define _longjmp longjmp #define spawnve win32_spawnve #define wait win32_wait #define signal win32_signal #define rindex strrchr #define ctime nt_ctime /* Place a wrapper around ctime (see nt.c). */ #ifdef HAVE_NTGUI #define abort win32_abort #endif /* Defines that we need that aren't in the standard signal.h */ #define SIGHUP 1 /* Hang up */ #define SIGQUIT 3 /* Quit process */ #define SIGTRAP 5 /* Trace trap */ #define SIGKILL 9 /* Die, die die */ #define SIGPIPE 13 /* Write on pipe with no readers */ #define SIGALRM 14 /* Alarm */ #define SIGCHLD 18 /* Death of child */ /* For integration with MSDOS support. */ #define getdisk() (_getdrive () - 1) #define getdefdir(_drv, _buf) _getdcwd (_drv, _buf, MAXPATHLEN) #define EMACS_CONFIGURATION get_emacs_configuration () #define EMACS_CONFIG_OPTIONS "NT" /* Not very meaningful yet. */ /* Define this so that winsock.h definitions don't get included when windows.h is... I don't know if they do the right thing for emacs. For this to have proper effect, config.h must always be included before windows.h. */ #define _WINSOCKAPI_ 1 /* Defines size_t and alloca (). */ #include /* We have to handle stat specially. However, #defining stat to something else not only redefines uses of the function, but also redefines uses of the type struct stat. What unfortunate parallel naming. */ #include struct nt_stat { struct _stat statbuf; }; #ifdef stat #undef stat #endif #define stat nt_stat #define st_dev statbuf.st_dev #define st_ino statbuf.st_ino #define st_mode statbuf.st_mode #define st_nlink statbuf.st_nlink #define st_uid statbuf.st_uid #define st_gid statbuf.st_gid #define st_rdev statbuf.st_rdev #define st_size statbuf.st_size #define st_atime statbuf.st_atime #define st_mtime statbuf.st_mtime #define st_ctime statbuf.st_ctime /* Define for those source files that do not include enough NT system files. */ #ifndef NULL #ifdef __cplusplus #define NULL 0 #else #define NULL ((void *)0) #endif #endif /* For proper declaration of environ. */ #include /* Emacs takes care of ensuring that these are defined. */ #ifdef max #undef max #undef min #endif /* ============================================================ */ emacs-19.30/src/s/xenix.h100444 75424 12 14325 5637122377 13562 0ustar kwzhstaff/* Definitions file for GNU Emacs running SCO Xenix 386 Release 2.2 Copyright (C) 1988 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. */ /* * Define symbols to identify the version of Unix this is. * Define all the symbols that apply correctly. */ /* #define UNIPLUS */ #define XENIX #define USG5 #define USG /* #define HPUX */ /* #define UMAX */ /* #define BSD4_1 */ /* #define BSD4_2 */ /* #define BSD4_3 */ /* #define BSD */ /* #define VMS */ /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "xenix" /* NOMULTIPLEJOBS should be defined if your system's shell does not have "job control" (the ability to stop a program, run some other program, then continue the first one). */ #define NOMULTIPLEJOBS /* Emacs can read input using SIGIO and buffering characters itself, or using CBREAK mode and making C-g cause SIGINT. The choice is controlled by the variable interrupt_input. Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO) SIGIO can be used only on systems that implement it (4.2 and 4.3). CBREAK mode has two disadvantages: 1) At least in 4.2, it is impossible to handle the Meta key properly. I hear that in system V this problem does not exist. 2) Control-G causes output to be discarded. I do not know whether this can be fixed in system V. Another method of doing input is planned but not implemented. It would have Emacs fork off a separate process to read the input and send it to the true Emacs process through a pipe. */ /* #define INTERRUPT_INPUT */ /* Letter to use in finding device name of first pty, if system supports pty's. 'p' means it is /dev/ptyp0 */ /* #define FIRST_PTY_LETTER 'p' */ /* * Define HAVE_TERMIO if the system provides sysV-style ioctls * for terminal control. */ #define HAVE_TERMIO /* * Define HAVE_PTYS if the system supports pty devices. */ /* #define HAVE_PTYS */ /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ /* #define HAVE_SOCKETS */ /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. */ #define NONSYSTEM_DIR_LIBRARY /* Define this symbol if your system has the functions bcopy, etc. */ /* #define BSTRING */ /* subprocesses should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). This is supposed to work now on system V release 2. */ #define subprocesses /* If your system uses COFF (Common Object File Format) then define the preprocessor symbol "COFF". */ /* #define COFF */ /* Xenix requires completely different unexec code which lives in a separate file. Specify the file name. */ #define UNEXEC unexenix.o /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ #define MAIL_USE_FLOCK /* Define CLASH_DETECTION if you want lock files to be written so that Emacs can tell instantly when you try to modify a file that someone else has modified in his Emacs. */ /* The way this is implemented requires long filenames... */ /* #define CLASH_DETECTION */ /* Define SHORTNAMES if the C compiler can distinguish only short names. It means that the stuff in ../shortnames must be run to convert the long names to short ones. */ /* #define SHORTNAMES */ /* We do not use the Berkeley (and usg5.2.2) interface to nlist. */ /* #define NLIST_STRUCT */ /* Compensate for one incompatibility between Xenix and V.0. */ #define n_zeroes n_name[0] /* The file containing the kernel's symbol table is called /xenix. */ #define KERNEL_FILE "/xenix" /* The symbol in the kernel where the load average is found is named avenrun. */ #define LDAV_SYMBOL "_avenrun" /* Special hacks needed to make Emacs run on this system. */ /* * Make the sigsetmask function go away. Don't know what the * ramifications of this are, but doesn't seem possible to * emulate it properly anyway at this point. */ #define sigsetmask(mask) /* Null expansion */ /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp #define _longjmp longjmp /* On USG systems the system calls are interruptible by signals that the user program has elected to catch. Thus the system call must be retried in these cases. To handle this without massive changes in the source code, we remap the standard system call names to names for our own functions in sysdep.c that do the system call with retries. */ #define read sys_read #define open sys_open #define write sys_write #define INTERRUPTIBLE_OPEN #define INTERRUPTIBLE_IO /* On USG systems these have different names */ #define index strchr #define rindex strrchr /* Compiler bug bites on many systems when default ADDR_CORRECT is used. */ #define ADDR_CORRECT(x) (x) /* Prevent -lg from being used for debugging. Not implemented? */ #define LIBS_DEBUG /* Switches for linking temacs. */ #define LD_SWITCH_SYSTEM -i /* Xenix implements sysV style IPC. */ #define HAVE_SYSVIPC /* Use terminfo instead of termcap. */ /* Tell Emacs to use Terminfo. */ #define TERMINFO /* Tell Xenix curses to BE Terminfo. */ #define M_TERMINFO /* Control program name for etc/fakemail to run. */ #ifdef SMAIL #define MAIL_PROGRAM_NAME "/usr/bin/smail -q0" #else #define MAIL_PROGRAM_NAME "/usr/lib/mail/execmail" #endif /* Some variants have TIOCGETC, but the structures to go with it are not declared. */ #define BROKEN_TIOCGETC emacs-19.30/src/bitmaps/ 40777 12120 1 0 6055530650 13243 5ustar rmsdaemonemacs-19.30/src/bitmaps/README100666 13437 1 206 5350754306 14335 0ustar jimbdaemonThis directory contains bitmap files that Emacs uses from /usr/include/X11/bitmaps. That directory doesn't seem to exist under VMS. emacs-19.30/src/bitmaps/cntrpmsk.xbm100666 12120 1 461 5531057315 15672 0ustar rmsdaemon#define cntr_ptrmsk_width 16 #define cntr_ptrmsk_height 16 static unsigned char cntr_ptrmsk_bits[] = { 0xc0, 0x03, 0xc0, 0x03, 0xe0, 0x07, 0xe0, 0x07, 0xf0, 0x0f, 0xf0, 0x0f, 0xf8, 0x1f, 0xf8, 0x1f, 0xfc, 0x3f, 0xfc, 0x3f, 0xfc, 0x3f, 0xdc, 0x3b, 0xc0, 0x03, 0xc0, 0x03, 0xc0, 0x03, 0xc0, 0x03}; emacs-19.30/src/bitmaps/cntrptr.xbm100666 12120 1 532 5531057315 15524 0ustar rmsdaemon#define cntr_ptr_width 16 #define cntr_ptr_height 16 #define cntr_ptr_x_hot 7 #define cntr_ptr_y_hot 1 static unsigned char cntr_ptr_bits[] = { 0x00, 0x00, 0x80, 0x01, 0x80, 0x01, 0xc0, 0x03, 0xc0, 0x03, 0xe0, 0x07, 0xe0, 0x07, 0xf0, 0x0f, 0xf0, 0x0f, 0x98, 0x19, 0x88, 0x11, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00}; emacs-19.30/src/bitmaps/crosswv.xbm100666 12120 1 461 5531057546 15545 0ustar rmsdaemon#define cross_weave_width 16 #define cross_weave_height 16 static unsigned char cross_weave_bits[] = { 0x55, 0x55, 0x88, 0x88, 0x55, 0x55, 0x22, 0x22, 0x55, 0x55, 0x88, 0x88, 0x55, 0x55, 0x22, 0x22, 0x55, 0x55, 0x88, 0x88, 0x55, 0x55, 0x22, 0x22, 0x55, 0x55, 0x88, 0x88, 0x55, 0x55, 0x22, 0x22}; emacs-19.30/src/bitmaps/dimple1.xbm100666 12120 1 445 5531057567 15377 0ustar rmsdaemon#define dimple1_width 16 #define dimple1_height 16 static unsigned char dimple1_bits[] = { 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00}; emacs-19.30/src/bitmaps/dimple3.xbm100666 12120 1 445 5531057606 15373 0ustar rmsdaemon#define dimple3_width 16 #define dimple3_height 16 static unsigned char dimple3_bits[] = { 0x11, 0x11, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x11, 0x11, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x11, 0x11, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x11, 0x11, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; emacs-19.30/src/bitmaps/gray.xbm100666 12120 1 140 5531057317 14767 0ustar rmsdaemon#define gray_width 2 #define gray_height 2 static unsigned char gray_bits[] = { 0x01, 0x02}; emacs-19.30/src/bitmaps/gray1.xbm100666 12120 1 143 5531057624 15054 0ustar rmsdaemon#define gray1_width 2 #define gray1_height 2 static unsigned char gray1_bits[] = { 0x01, 0x02}; emacs-19.30/src/bitmaps/gray3.xbm100666 12120 1 157 5531057642 15063 0ustar rmsdaemon#define gray3_width 4 #define gray3_height 4 static unsigned char gray3_bits[] = { 0x01, 0x00, 0x04, 0x00}; emacs-19.30/src/bitmaps/leftpmsk.xbm100666 12120 1 461 5531057312 15653 0ustar rmsdaemon#define left_ptrmsk_width 16 #define left_ptrmsk_height 16 static unsigned char left_ptrmsk_bits[] = { 0x0c, 0x00, 0x1c, 0x00, 0x3c, 0x00, 0x7c, 0x00, 0xfc, 0x00, 0xfc, 0x01, 0xfc, 0x03, 0xfc, 0x07, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x01, 0xdc, 0x03, 0xcc, 0x03, 0x80, 0x07, 0x80, 0x07, 0x00, 0x03}; emacs-19.30/src/bitmaps/leftptr.xbm100666 12120 1 532 5531057313 15506 0ustar rmsdaemon#define left_ptr_width 16 #define left_ptr_height 16 #define left_ptr_x_hot 3 #define left_ptr_y_hot 1 static unsigned char left_ptr_bits[] = { 0x00, 0x00, 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01, 0xf8, 0x03, 0xf8, 0x07, 0xf8, 0x00, 0xd8, 0x00, 0x88, 0x01, 0x80, 0x01, 0x00, 0x03, 0x00, 0x03, 0x00, 0x00}; emacs-19.30/src/bitmaps/rtpmsk.xbm100666 12120 1 464 5531057314 15353 0ustar rmsdaemon#define right_ptrmsk_width 16 #define right_ptrmsk_height 16 static unsigned char right_ptrmsk_bits[] = { 0x00, 0x30, 0x00, 0x38, 0x00, 0x3c, 0x00, 0x3e, 0x00, 0x3f, 0x80, 0x3f, 0xc0, 0x3f, 0xe0, 0x3f, 0xf0, 0x3f, 0xf0, 0x3f, 0x80, 0x3f, 0xc0, 0x3b, 0xc0, 0x33, 0xe0, 0x01, 0xe0, 0x01, 0xc0, 0x00}; emacs-19.30/src/bitmaps/rtptr.xbm100666 12120 1 540 5531057311 15176 0ustar rmsdaemon#define right_ptr_width 16 #define right_ptr_height 16 #define right_ptr_x_hot 12 #define right_ptr_y_hot 1 static unsigned char right_ptr_bits[] = { 0x00, 0x00, 0x00, 0x10, 0x00, 0x18, 0x00, 0x1c, 0x00, 0x1e, 0x00, 0x1f, 0x80, 0x1f, 0xc0, 0x1f, 0xe0, 0x1f, 0x00, 0x1f, 0x00, 0x1b, 0x80, 0x11, 0x80, 0x01, 0xc0, 0x00, 0xc0, 0x00, 0x00, 0x00}; emacs-19.30/src/bitmaps/stipple.xbm100666 12120 1 216 5531057316 15510 0ustar rmsdaemon#define stipple_width 16 #define stipple_height 4 static unsigned char stipple_bits[] = { 0x55, 0x55, 0xee, 0xee, 0x55, 0x55, 0xba, 0xbb}; emacs-19.30/src/COPYING100666 12120 1 43070 6055530746 12766 0ustar rmsdaemon GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. 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. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. emacs-19.30/src/abbrev.c100444 75424 1 42634 5764720112 13533 0ustar kwzhdaemon/* Primitives for word-abbrev mode. Copyright (C) 1985, 1986, 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. */ #include #include #include "lisp.h" #include "commands.h" #include "buffer.h" #include "window.h" #include "syntax.h" /* An abbrev table is an obarray. Each defined abbrev is represented by a symbol in that obarray whose print name is the abbreviation. The symbol's value is a string which is the expansion. If its function definition is non-nil, it is called after the expansion is done. The plist slot of the abbrev symbol is its usage count. */ /* List of all abbrev-table name symbols: symbols whose values are abbrev tables. */ Lisp_Object Vabbrev_table_name_list; /* The table of global abbrevs. These are in effect in any buffer in which abbrev mode is turned on. */ Lisp_Object Vglobal_abbrev_table; /* The local abbrev table used by default (in Fundamental Mode buffers) */ Lisp_Object Vfundamental_mode_abbrev_table; /* Set nonzero when an abbrev definition is changed */ int abbrevs_changed; int abbrev_all_caps; /* Non-nil => use this location as the start of abbrev to expand (rather than taking the word before point as the abbrev) */ Lisp_Object Vabbrev_start_location; /* Buffer that Vabbrev_start_location applies to */ Lisp_Object Vabbrev_start_location_buffer; /* The symbol representing the abbrev most recently expanded */ Lisp_Object Vlast_abbrev; /* A string for the actual text of the abbrev most recently expanded. This has more info than Vlast_abbrev since case is significant. */ Lisp_Object Vlast_abbrev_text; /* Character address of start of last abbrev expanded */ int last_abbrev_point; /* Hook to run before expanding any abbrev. */ Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook; DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0, "Create a new, empty abbrev table object.") () { return Fmake_vector (make_number (59), make_number (0)); } DEFUN ("clear-abbrev-table", Fclear_abbrev_table, Sclear_abbrev_table, 1, 1, 0, "Undefine all abbrevs in abbrev table TABLE, leaving it empty.") (table) Lisp_Object table; { int i, size; CHECK_VECTOR (table, 0); size = XVECTOR (table)->size; abbrevs_changed = 1; for (i = 0; i < size; i++) XVECTOR (table)->contents[i] = make_number (0); return Qnil; } DEFUN ("define-abbrev", Fdefine_abbrev, Sdefine_abbrev, 3, 5, 0, "Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK.\n\ NAME and EXPANSION are strings.\n\ To undefine an abbrev, define it with EXPANSION = nil.\n\ If HOOK is non-nil, it should be a function of no arguments;\n\ it is called after EXPANSION is inserted.") (table, name, expansion, hook, count) Lisp_Object table, name, expansion, hook, count; { Lisp_Object sym, oexp, ohook, tem; CHECK_VECTOR (table, 0); CHECK_STRING (name, 1); if (!NILP (expansion)) CHECK_STRING (expansion, 2); if (NILP (count)) count = make_number (0); else CHECK_NUMBER (count, 0); sym = Fintern (name, table); oexp = XSYMBOL (sym)->value; ohook = XSYMBOL (sym)->function; if (!((EQ (oexp, expansion) || (STRINGP (oexp) && STRINGP (expansion) && (tem = Fstring_equal (oexp, expansion), !NILP (tem)))) && (EQ (ohook, hook) || (tem = Fequal (ohook, hook), !NILP (tem))))) abbrevs_changed = 1; Fset (sym, expansion); Ffset (sym, hook); Fsetplist (sym, count); return name; } DEFUN ("define-global-abbrev", Fdefine_global_abbrev, Sdefine_global_abbrev, 2, 2, "sDefine global abbrev: \nsExpansion for %s: ", "Define ABBREV as a global abbreviation for EXPANSION.") (name, expansion) Lisp_Object name, expansion; { Fdefine_abbrev (Vglobal_abbrev_table, Fdowncase (name), expansion, Qnil, make_number (0)); return name; } DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev, Sdefine_mode_abbrev, 2, 2, "sDefine mode abbrev: \nsExpansion for %s: ", "Define ABBREV as a mode-specific abbreviation for EXPANSION.") (name, expansion) Lisp_Object name, expansion; { if (NILP (current_buffer->abbrev_table)) error ("Major mode has no abbrev table"); Fdefine_abbrev (current_buffer->abbrev_table, Fdowncase (name), expansion, Qnil, make_number (0)); return name; } DEFUN ("abbrev-symbol", Fabbrev_symbol, Sabbrev_symbol, 1, 2, 0, "Return the symbol representing abbrev named ABBREV.\n\ This symbol's name is ABBREV, but it is not the canonical symbol of that name;\n\ it is interned in an abbrev-table rather than the normal obarray.\n\ The value is nil if that abbrev is not defined.\n\ Optional second arg TABLE is abbrev table to look it up in.\n\ The default is to try buffer's mode-specific abbrev table, then global table.") (abbrev, table) Lisp_Object abbrev, table; { Lisp_Object sym; CHECK_STRING (abbrev, 0); if (!NILP (table)) sym = Fintern_soft (abbrev, table); else { sym = Qnil; if (!NILP (current_buffer->abbrev_table)) sym = Fintern_soft (abbrev, current_buffer->abbrev_table); if (NILP (XSYMBOL (sym)->value)) sym = Qnil; if (NILP (sym)) sym = Fintern_soft (abbrev, Vglobal_abbrev_table); } if (NILP (XSYMBOL (sym)->value)) return Qnil; return sym; } DEFUN ("abbrev-expansion", Fabbrev_expansion, Sabbrev_expansion, 1, 2, 0, "Return the string that ABBREV expands into in the current buffer.\n\ Optionally specify an abbrev table as second arg;\n\ then ABBREV is looked up in that table only.") (abbrev, table) Lisp_Object abbrev, table; { Lisp_Object sym; sym = Fabbrev_symbol (abbrev, table); if (NILP (sym)) return sym; return Fsymbol_value (sym); } /* Expand the word before point, if it is an abbrev. Returns 1 if an expansion is done. */ DEFUN ("expand-abbrev", Fexpand_abbrev, Sexpand_abbrev, 0, 0, "", "Expand the abbrev before point, if there is an abbrev there.\n\ Effective when explicitly called even when `abbrev-mode' is nil.\n\ Returns t if expansion took place.") () { register char *buffer, *p; register int wordstart, wordend, idx; int whitecnt; int uccount = 0, lccount = 0; register Lisp_Object sym; Lisp_Object expansion, hook, tem; int oldmodiff = MODIFF; Lisp_Object value; if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, Qpre_abbrev_expand_hook); /* If the hook changes the buffer, treat that as having "done an expansion". */ value = (MODIFF != oldmodiff ? Qt : Qnil); wordstart = 0; if (!(BUFFERP (Vabbrev_start_location_buffer) && XBUFFER (Vabbrev_start_location_buffer) == current_buffer)) Vabbrev_start_location = Qnil; if (!NILP (Vabbrev_start_location)) { tem = Vabbrev_start_location; CHECK_NUMBER_COERCE_MARKER (tem, 0); wordstart = XINT (tem); Vabbrev_start_location = Qnil; if (wordstart < BEGV || wordstart > ZV) wordstart = 0; if (wordstart && wordstart != ZV && FETCH_CHAR (wordstart) == '-') del_range (wordstart, wordstart + 1); } if (!wordstart) wordstart = scan_words (point, -1); if (!wordstart) return value; wordend = scan_words (wordstart, 1); if (!wordend) return value; if (wordend > point) wordend = point; whitecnt = point - wordend; if (wordend <= wordstart) return value; p = buffer = (char *) alloca (wordend - wordstart); for (idx = wordstart; idx < wordend; idx++) { register int c = FETCH_CHAR (idx); if (UPPERCASEP (c)) c = DOWNCASE (c), uccount++; else if (! NOCASEP (c)) lccount++; *p++ = c; } if (VECTORP (current_buffer->abbrev_table)) sym = oblookup (current_buffer->abbrev_table, buffer, p - buffer); else XSETFASTINT (sym, 0); if (INTEGERP (sym) || NILP (XSYMBOL (sym)->value)) sym = oblookup (Vglobal_abbrev_table, buffer, p - buffer); if (INTEGERP (sym) || NILP (XSYMBOL (sym)->value)) return value; if (INTERACTIVE && !EQ (minibuf_window, selected_window)) { /* Add an undo boundary, in case we are doing this for a self-inserting command which has avoided making one so far. */ SET_PT (wordend); Fundo_boundary (); } SET_PT (wordstart); Vlast_abbrev_text = Fbuffer_substring (make_number (wordstart), make_number (wordend)); del_range (wordstart, wordend); /* Now sym is the abbrev symbol. */ Vlast_abbrev = sym; last_abbrev_point = wordstart; if (INTEGERP (XSYMBOL (sym)->plist)) XSETINT (XSYMBOL (sym)->plist, XINT (XSYMBOL (sym)->plist) + 1); /* Increment use count */ expansion = XSYMBOL (sym)->value; insert_from_string (expansion, 0, XSTRING (expansion)->size, 1); SET_PT (point + whitecnt); if (uccount && !lccount) { /* Abbrev was all caps */ /* If expansion is multiple words, normally capitalize each word */ /* This used to be if (!... && ... >= ...) Fcapitalize; else Fupcase but Megatest 68000 compiler can't handle that */ if (!abbrev_all_caps) if (scan_words (point, -1) > scan_words (wordstart, 1)) { Fupcase_initials_region (make_number (wordstart), make_number (point)); goto caped; } /* If expansion is one word, or if user says so, upcase it all. */ Fupcase_region (make_number (wordstart), make_number (point)); caped: ; } else if (uccount) { /* Abbrev included some caps. Cap first initial of expansion */ int pos = wordstart; /* Find the initial. */ while (pos < point && SYNTAX (*BUF_CHAR_ADDRESS (current_buffer, pos)) != Sword) pos++; /* Change just that. */ Fupcase_initials_region (make_number (pos), make_number (pos + 1)); } hook = XSYMBOL (sym)->function; if (!NILP (hook)) call0 (hook); return Qt; } DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexpand_abbrev, 0, 0, "", "Undo the expansion of the last abbrev that expanded.\n\ This differs from ordinary undo in that other editing done since then\n\ is not undone.") () { int opoint = point; int adjust = 0; if (last_abbrev_point < BEGV || last_abbrev_point > ZV) return Qnil; SET_PT (last_abbrev_point); if (STRINGP (Vlast_abbrev_text)) { /* This isn't correct if Vlast_abbrev->function was used to do the expansion */ Lisp_Object val; val = XSYMBOL (Vlast_abbrev)->value; if (!STRINGP (val)) error ("value of abbrev-symbol must be a string"); adjust = XSTRING (val)->size; del_range (point, point + adjust); /* Don't inherit properties here; just copy from old contents. */ insert_from_string (Vlast_abbrev_text, 0, XSTRING (Vlast_abbrev_text)->size, 0); adjust -= XSTRING (Vlast_abbrev_text)->size; Vlast_abbrev_text = Qnil; } SET_PT (last_abbrev_point < opoint ? opoint - adjust : opoint); return Qnil; } static write_abbrev (sym, stream) Lisp_Object sym, stream; { Lisp_Object name; if (NILP (XSYMBOL (sym)->value)) return; insert (" (", 5); XSETSTRING (name, XSYMBOL (sym)->name); Fprin1 (name, stream); insert (" ", 1); Fprin1 (XSYMBOL (sym)->value, stream); insert (" ", 1); Fprin1 (XSYMBOL (sym)->function, stream); insert (" ", 1); Fprin1 (XSYMBOL (sym)->plist, stream); insert (")\n", 2); } static describe_abbrev (sym, stream) Lisp_Object sym, stream; { Lisp_Object one; if (NILP (XSYMBOL (sym)->value)) return; one = make_number (1); Fprin1 (Fsymbol_name (sym), stream); Findent_to (make_number (15), one); Fprin1 (XSYMBOL (sym)->plist, stream); Findent_to (make_number (20), one); Fprin1 (XSYMBOL (sym)->value, stream); if (!NILP (XSYMBOL (sym)->function)) { Findent_to (make_number (45), one); Fprin1 (XSYMBOL (sym)->function, stream); } Fterpri (stream); } DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description, Sinsert_abbrev_table_description, 1, 2, 0, "Insert before point a full description of abbrev table named NAME.\n\ NAME is a symbol whose value is an abbrev table.\n\ If optional 2nd arg HUMAN is non-nil, a human-readable description is inserted.\n\ Otherwise the description is an expression,\n\ a call to `define-abbrev-table', which would\n\ define the abbrev table NAME exactly as it is currently defined.") (name, readable) Lisp_Object name, readable; { Lisp_Object table; Lisp_Object stream; CHECK_SYMBOL (name, 0); table = Fsymbol_value (name); CHECK_VECTOR (table, 0); XSETBUFFER (stream, current_buffer); if (!NILP (readable)) { insert_string ("("); Fprin1 (name, stream); insert_string (")\n\n"); map_obarray (table, describe_abbrev, stream); insert_string ("\n\n"); } else { insert_string ("(define-abbrev-table '"); Fprin1 (name, stream); insert_string (" '(\n"); map_obarray (table, write_abbrev, stream); insert_string (" ))\n\n"); } return Qnil; } DEFUN ("define-abbrev-table", Fdefine_abbrev_table, Sdefine_abbrev_table, 2, 2, 0, "Define TABNAME (a symbol) as an abbrev table name.\n\ Define abbrevs in it according to DEFINITIONS, which is a list of elements\n\ of the form (ABBREVNAME EXPANSION HOOK USECOUNT).") (tabname, defns) Lisp_Object tabname, defns; { Lisp_Object name, exp, hook, count; Lisp_Object table, elt; CHECK_SYMBOL (tabname, 0); table = Fboundp (tabname); if (NILP (table) || (table = Fsymbol_value (tabname), NILP (table))) { table = Fmake_abbrev_table (); Fset (tabname, table); Vabbrev_table_name_list = Fcons (tabname, Vabbrev_table_name_list); } CHECK_VECTOR (table, 0); for (;!NILP (defns); defns = Fcdr (defns)) { elt = Fcar (defns); name = Fcar (elt); elt = Fcdr (elt); exp = Fcar (elt); elt = Fcdr (elt); hook = Fcar (elt); elt = Fcdr (elt); count = Fcar (elt); Fdefine_abbrev (table, name, exp, hook, count); } return Qnil; } syms_of_abbrev () { DEFVAR_LISP ("abbrev-table-name-list", &Vabbrev_table_name_list, "List of symbols whose values are abbrev tables."); Vabbrev_table_name_list = Fcons (intern ("fundamental-mode-abbrev-table"), Fcons (intern ("global-abbrev-table"), Qnil)); DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table, "The abbrev table whose abbrevs affect all buffers.\n\ Each buffer may also have a local abbrev table.\n\ If it does, the local table overrides the global one\n\ for any particular abbrev defined in both."); Vglobal_abbrev_table = Fmake_abbrev_table (); DEFVAR_LISP ("fundamental-mode-abbrev-table", &Vfundamental_mode_abbrev_table, "The abbrev table of mode-specific abbrevs for Fundamental Mode."); Vfundamental_mode_abbrev_table = Fmake_abbrev_table (); current_buffer->abbrev_table = Vfundamental_mode_abbrev_table; DEFVAR_LISP ("last-abbrev", &Vlast_abbrev, "The abbrev-symbol of the last abbrev expanded. See `abbrev-symbol'."); DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text, "The exact text of the last abbrev expanded.\n\ nil if the abbrev has already been unexpanded."); DEFVAR_INT ("last-abbrev-location", &last_abbrev_point, "The location of the start of the last abbrev expanded."); Vlast_abbrev = Qnil; Vlast_abbrev_text = Qnil; last_abbrev_point = 0; DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location, "Buffer position for `expand-abbrev' to use as the start of the abbrev.\n\ nil means use the word before point as the abbrev.\n\ Calling `expand-abbrev' sets this to nil."); Vabbrev_start_location = Qnil; DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer, "Buffer that `abbrev-start-location' has been set for.\n\ Trying to expand an abbrev in any other buffer clears `abbrev-start-location'."); Vabbrev_start_location_buffer = Qnil; DEFVAR_PER_BUFFER ("local-abbrev-table", ¤t_buffer->abbrev_table, Qnil, "Local (mode-specific) abbrev table of current buffer."); DEFVAR_BOOL ("abbrevs-changed", &abbrevs_changed, "Set non-nil by defining or altering any word abbrevs.\n\ This causes `save-some-buffers' to offer to save the abbrevs."); abbrevs_changed = 0; DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps, "*Set non-nil means expand multi-word abbrevs all caps if abbrev was so."); abbrev_all_caps = 0; DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook, "Function or functions to be called before abbrev expansion is done.\n\ This is the first thing that `expand-abbrev' does, and so this may change\n\ the current abbrev table before abbrev lookup happens."); Vpre_abbrev_expand_hook = Qnil; Qpre_abbrev_expand_hook = intern ("pre-abbrev-expand-hook"); staticpro (&Qpre_abbrev_expand_hook); defsubr (&Smake_abbrev_table); defsubr (&Sclear_abbrev_table); defsubr (&Sdefine_abbrev); defsubr (&Sdefine_global_abbrev); defsubr (&Sdefine_mode_abbrev); defsubr (&Sabbrev_expansion); defsubr (&Sabbrev_symbol); defsubr (&Sexpand_abbrev); defsubr (&Sunexpand_abbrev); defsubr (&Sinsert_abbrev_table_description); defsubr (&Sdefine_abbrev_table); } emacs-19.30/src/alloc.c100444 12120 1 215131 6054206571 13175 0ustar rmsdaemon/* Storage allocation and gc for GNU Emacs Lisp interpreter. Copyright (C) 1985, 86, 88, 93, 94, 95 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. */ /* Note that this declares bzero on OSF/1. How dumb. */ #include #include #include "lisp.h" #include "intervals.h" #include "puresize.h" #ifndef standalone #include "buffer.h" #include "window.h" #include "frame.h" #include "blockinput.h" #include "keyboard.h" #endif #include "syssignal.h" extern char *sbrk (); /* The following come from gmalloc.c. */ #if defined (__STDC__) && __STDC__ #include #define __malloc_size_t size_t #else #define __malloc_size_t unsigned int #endif extern __malloc_size_t _bytes_used; extern int __malloc_extra_blocks; #define max(A,B) ((A) > (B) ? (A) : (B)) #define min(A,B) ((A) < (B) ? (A) : (B)) /* Macro to verify that storage intended for Lisp objects is not out of range to fit in the space for a pointer. ADDRESS is the start of the block, and SIZE is the amount of space within which objects can start. */ #define VALIDATE_LISP_STORAGE(address, size) \ do \ { \ Lisp_Object val; \ XSETCONS (val, (char *) address + size); \ if ((char *) XCONS (val) != (char *) address + size) \ { \ xfree (address); \ memory_full (); \ } \ } while (0) /* Value of _bytes_used, when spare_memory was freed. */ static __malloc_size_t bytes_used_when_full; /* Number of bytes of consing done since the last gc */ int consing_since_gc; /* Count the amount of consing of various sorts of space. */ int cons_cells_consed; int floats_consed; int vector_cells_consed; int symbols_consed; int string_chars_consed; int misc_objects_consed; int intervals_consed; /* Number of bytes of consing since gc before another gc should be done. */ int gc_cons_threshold; /* Nonzero during gc */ int gc_in_progress; #ifndef VIRT_ADDR_VARIES extern #endif /* VIRT_ADDR_VARIES */ int malloc_sbrk_used; #ifndef VIRT_ADDR_VARIES extern #endif /* VIRT_ADDR_VARIES */ int malloc_sbrk_unused; /* Two limits controlling how much undo information to keep. */ int undo_limit; int undo_strong_limit; /* Points to memory space allocated as "spare", to be freed if we run out of memory. */ static char *spare_memory; /* Amount of spare memory to keep in reserve. */ #define SPARE_MEMORY (1 << 14) /* Number of extra blocks malloc should get when it needs more core. */ static int malloc_hysteresis; /* Nonzero when malloc is called for allocating Lisp object space. */ int allocating_for_lisp; /* Non-nil means defun should do purecopy on the function definition */ Lisp_Object Vpurify_flag; #ifndef HAVE_SHM EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,}; /* Force it into data space! */ #define PUREBEG (char *) pure #else #define pure PURE_SEG_BITS /* Use shared memory segment */ #define PUREBEG (char *)PURE_SEG_BITS /* This variable is used only by the XPNTR macro when HAVE_SHM is defined. If we used the PURESIZE macro directly there, that would make most of emacs dependent on puresize.h, which we don't want - you should be able to change that without too much recompilation. So map_in_data initializes pure_size, and the dependencies work out. */ EMACS_INT pure_size; #endif /* not HAVE_SHM */ /* Index in pure at which next pure object will be allocated. */ int pureptr; /* If nonzero, this is a warning delivered by malloc and not yet displayed. */ char *pending_malloc_warning; /* Pre-computed signal argument for use when memory is exhausted. */ Lisp_Object memory_signal_data; /* Maximum amount of C stack to save when a GC happens. */ #ifndef MAX_SAVE_STACK #define MAX_SAVE_STACK 16000 #endif /* Define DONT_COPY_FLAG to be some bit which will always be zero in a pointer to a Lisp_Object, when that pointer is viewed as an integer. (On most machines, pointers are even, so we can use the low bit. Word-addressible architectures may need to override this in the m-file.) When linking references to small strings through the size field, we use this slot to hold the bit that would otherwise be interpreted as the GC mark bit. */ #ifndef DONT_COPY_FLAG #define DONT_COPY_FLAG 1 #endif /* no DONT_COPY_FLAG */ /* Buffer in which we save a copy of the C stack at each GC. */ char *stack_copy; int stack_copy_size; /* Non-zero means ignore malloc warnings. Set during initialization. */ int ignore_warnings; Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots; static void mark_object (), mark_buffer (), mark_kboards (); static void clear_marks (), gc_sweep (); static void compact_strings (); /* Versions of malloc and realloc that print warnings as memory gets full. */ Lisp_Object malloc_warning_1 (str) Lisp_Object str; { Fprinc (str, Vstandard_output); write_string ("\nKilling some buffers may delay running out of memory.\n", -1); write_string ("However, certainly by the time you receive the 95% warning,\n", -1); write_string ("you should clean up, kill this Emacs, and start a new one.", -1); return Qnil; } /* malloc calls this if it finds we are near exhausting storage */ malloc_warning (str) char *str; { pending_malloc_warning = str; } display_malloc_warning () { register Lisp_Object val; val = build_string (pending_malloc_warning); pending_malloc_warning = 0; internal_with_output_to_temp_buffer (" *Danger*", malloc_warning_1, val); } /* Called if malloc returns zero */ memory_full () { #ifndef SYSTEM_MALLOC bytes_used_when_full = _bytes_used; #endif /* The first time we get here, free the spare memory. */ if (spare_memory) { free (spare_memory); spare_memory = 0; } /* This used to call error, but if we've run out of memory, we could get infinite recursion trying to build the string. */ while (1) Fsignal (Qerror, memory_signal_data); } /* Called if we can't allocate relocatable space for a buffer. */ void buffer_memory_full () { /* If buffers use the relocating allocator, no need to free spare_memory, because we may have plenty of malloc space left that we could get, and if we don't, the malloc that fails will itself cause spare_memory to be freed. If buffers don't use the relocating allocator, treat this like any other failing malloc. */ #ifndef REL_ALLOC memory_full (); #endif /* This used to call error, but if we've run out of memory, we could get infinite recursion trying to build the string. */ while (1) Fsignal (Qerror, memory_signal_data); } /* like malloc routines but check for no memory and block interrupt input. */ long * xmalloc (size) int size; { register long *val; BLOCK_INPUT; val = (long *) malloc (size); UNBLOCK_INPUT; if (!val && size) memory_full (); return val; } long * xrealloc (block, size) long *block; int size; { register long *val; BLOCK_INPUT; /* We must call malloc explicitly when BLOCK is 0, since some reallocs don't do this. */ if (! block) val = (long *) malloc (size); else val = (long *) realloc (block, size); UNBLOCK_INPUT; if (!val && size) memory_full (); return val; } void xfree (block) long *block; { BLOCK_INPUT; free (block); UNBLOCK_INPUT; } /* Arranging to disable input signals while we're in malloc. This only works with GNU malloc. To help out systems which can't use GNU malloc, all the calls to malloc, realloc, and free elsewhere in the code should be inside a BLOCK_INPUT/UNBLOCK_INPUT pairs; unfortunately, we have no idea what C library functions might call malloc, so we can't really protect them unless you're using GNU malloc. Fortunately, most of the major operating can use GNU malloc. */ #ifndef SYSTEM_MALLOC extern void * (*__malloc_hook) (); static void * (*old_malloc_hook) (); extern void * (*__realloc_hook) (); static void * (*old_realloc_hook) (); extern void (*__free_hook) (); static void (*old_free_hook) (); /* This function is used as the hook for free to call. */ static void emacs_blocked_free (ptr) void *ptr; { BLOCK_INPUT; __free_hook = old_free_hook; free (ptr); /* If we released our reserve (due to running out of memory), and we have a fair amount free once again, try to set aside another reserve in case we run out once more. */ if (spare_memory == 0 /* Verify there is enough space that even with the malloc hysteresis this call won't run out again. The code here is correct as long as SPARE_MEMORY is substantially larger than the block size malloc uses. */ && (bytes_used_when_full > _bytes_used + max (malloc_hysteresis, 4) * SPARE_MEMORY)) spare_memory = (char *) malloc (SPARE_MEMORY); __free_hook = emacs_blocked_free; UNBLOCK_INPUT; } /* If we released our reserve (due to running out of memory), and we have a fair amount free once again, try to set aside another reserve in case we run out once more. This is called when a relocatable block is freed in ralloc.c. */ void refill_memory_reserve () { if (spare_memory == 0) spare_memory = (char *) malloc (SPARE_MEMORY); } /* This function is the malloc hook that Emacs uses. */ static void * emacs_blocked_malloc (size) unsigned size; { void *value; BLOCK_INPUT; __malloc_hook = old_malloc_hook; __malloc_extra_blocks = malloc_hysteresis; value = (void *) malloc (size); __malloc_hook = emacs_blocked_malloc; UNBLOCK_INPUT; return value; } static void * emacs_blocked_realloc (ptr, size) void *ptr; unsigned size; { void *value; BLOCK_INPUT; __realloc_hook = old_realloc_hook; value = (void *) realloc (ptr, size); __realloc_hook = emacs_blocked_realloc; UNBLOCK_INPUT; return value; } void uninterrupt_malloc () { old_free_hook = __free_hook; __free_hook = emacs_blocked_free; old_malloc_hook = __malloc_hook; __malloc_hook = emacs_blocked_malloc; old_realloc_hook = __realloc_hook; __realloc_hook = emacs_blocked_realloc; } #endif /* Interval allocation. */ #ifdef USE_TEXT_PROPERTIES #define INTERVAL_BLOCK_SIZE \ ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval)) struct interval_block { struct interval_block *next; struct interval intervals[INTERVAL_BLOCK_SIZE]; }; struct interval_block *interval_block; static int interval_block_index; INTERVAL interval_free_list; static void init_intervals () { allocating_for_lisp = 1; interval_block = (struct interval_block *) malloc (sizeof (struct interval_block)); allocating_for_lisp = 0; interval_block->next = 0; bzero ((char *) interval_block->intervals, sizeof interval_block->intervals); interval_block_index = 0; interval_free_list = 0; } #define INIT_INTERVALS init_intervals () INTERVAL make_interval () { INTERVAL val; if (interval_free_list) { val = interval_free_list; interval_free_list = interval_free_list->parent; } else { if (interval_block_index == INTERVAL_BLOCK_SIZE) { register struct interval_block *newi; allocating_for_lisp = 1; newi = (struct interval_block *) xmalloc (sizeof (struct interval_block)); allocating_for_lisp = 0; VALIDATE_LISP_STORAGE (newi, sizeof *newi); newi->next = interval_block; interval_block = newi; interval_block_index = 0; } val = &interval_block->intervals[interval_block_index++]; } consing_since_gc += sizeof (struct interval); intervals_consed++; RESET_INTERVAL (val); return val; } static int total_free_intervals, total_intervals; /* Mark the pointers of one interval. */ static void mark_interval (i, dummy) register INTERVAL i; Lisp_Object dummy; { if (XMARKBIT (i->plist)) abort (); mark_object (&i->plist); XMARK (i->plist); } static void mark_interval_tree (tree) 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 expands to an assignment to its argument, and most C compilers don't support casts on the left operand of `='. */ #define UNMARK_BALANCE_INTERVALS(i) \ { \ if (! NULL_INTERVAL_P (i)) \ { \ XUNMARK (* (Lisp_Object *) (&(i)->parent)); \ (i) = balance_intervals (i); \ } \ } #else /* no interval use */ #define INIT_INTERVALS #define UNMARK_BALANCE_INTERVALS(i) #define MARK_INTERVAL_TREE(i) #endif /* no interval use */ /* Floating point allocation. */ #ifdef LISP_FLOAT_TYPE /* Allocation of float cells, just like conses */ /* We store float cells inside of float_blocks, allocating a new float_block with malloc whenever necessary. Float cells reclaimed by GC are put on a free list to be reallocated before allocating any new float cells from the latest float_block. Each float_block is just under 1020 bytes long, since malloc really allocates in units of powers of two and uses 4 bytes for its own overhead. */ #define FLOAT_BLOCK_SIZE \ ((1020 - sizeof (struct float_block *)) / sizeof (struct Lisp_Float)) struct float_block { struct float_block *next; struct Lisp_Float floats[FLOAT_BLOCK_SIZE]; }; struct float_block *float_block; int float_block_index; struct Lisp_Float *float_free_list; void init_float () { allocating_for_lisp = 1; float_block = (struct float_block *) malloc (sizeof (struct float_block)); allocating_for_lisp = 0; float_block->next = 0; bzero ((char *) float_block->floats, sizeof float_block->floats); float_block_index = 0; float_free_list = 0; } /* Explicitly free a float cell. */ free_float (ptr) struct Lisp_Float *ptr; { *(struct Lisp_Float **)&ptr->type = float_free_list; float_free_list = ptr; } Lisp_Object make_float (float_value) double float_value; { register Lisp_Object val; if (float_free_list) { XSETFLOAT (val, float_free_list); float_free_list = *(struct Lisp_Float **)&float_free_list->type; } else { if (float_block_index == FLOAT_BLOCK_SIZE) { register struct float_block *new; allocating_for_lisp = 1; new = (struct float_block *) xmalloc (sizeof (struct float_block)); allocating_for_lisp = 0; VALIDATE_LISP_STORAGE (new, sizeof *new); new->next = float_block; float_block = new; float_block_index = 0; } XSETFLOAT (val, &float_block->floats[float_block_index++]); } XFLOAT (val)->data = float_value; XSETFASTINT (XFLOAT (val)->type, 0); /* bug chasing -wsr */ consing_since_gc += sizeof (struct Lisp_Float); floats_consed++; return val; } #endif /* LISP_FLOAT_TYPE */ /* Allocation of cons cells */ /* We store cons cells inside of cons_blocks, allocating a new cons_block with malloc whenever necessary. Cons cells reclaimed by GC are put on a free list to be reallocated before allocating any new cons cells from the latest cons_block. Each cons_block is just under 1020 bytes long, since malloc really allocates in units of powers of two and uses 4 bytes for its own overhead. */ #define CONS_BLOCK_SIZE \ ((1020 - sizeof (struct cons_block *)) / sizeof (struct Lisp_Cons)) struct cons_block { struct cons_block *next; struct Lisp_Cons conses[CONS_BLOCK_SIZE]; }; struct cons_block *cons_block; int cons_block_index; struct Lisp_Cons *cons_free_list; void init_cons () { allocating_for_lisp = 1; cons_block = (struct cons_block *) malloc (sizeof (struct cons_block)); allocating_for_lisp = 0; cons_block->next = 0; bzero ((char *) cons_block->conses, sizeof cons_block->conses); cons_block_index = 0; cons_free_list = 0; } /* Explicitly free a cons cell. */ free_cons (ptr) struct Lisp_Cons *ptr; { *(struct Lisp_Cons **)&ptr->car = cons_free_list; cons_free_list = ptr; } DEFUN ("cons", Fcons, Scons, 2, 2, 0, "Create a new cons, give it CAR and CDR as components, and return it.") (car, cdr) Lisp_Object car, cdr; { register Lisp_Object val; if (cons_free_list) { XSETCONS (val, cons_free_list); cons_free_list = *(struct Lisp_Cons **)&cons_free_list->car; } else { if (cons_block_index == CONS_BLOCK_SIZE) { register struct cons_block *new; allocating_for_lisp = 1; new = (struct cons_block *) xmalloc (sizeof (struct cons_block)); allocating_for_lisp = 0; VALIDATE_LISP_STORAGE (new, sizeof *new); new->next = cons_block; cons_block = new; cons_block_index = 0; } XSETCONS (val, &cons_block->conses[cons_block_index++]); } XCONS (val)->car = car; XCONS (val)->cdr = cdr; consing_since_gc += sizeof (struct Lisp_Cons); cons_cells_consed++; return val; } DEFUN ("list", Flist, Slist, 0, MANY, 0, "Return a newly created list with specified arguments as elements.\n\ Any number of arguments, even zero arguments, are allowed.") (nargs, args) int nargs; register Lisp_Object *args; { register Lisp_Object val; val = Qnil; while (nargs > 0) { nargs--; val = Fcons (args[nargs], val); } return val; } DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, "Return a newly created list of length LENGTH, with each element being INIT.") (length, init) register Lisp_Object length, init; { register Lisp_Object val; register int size; CHECK_NATNUM (length, 0); size = XFASTINT (length); val = Qnil; while (size-- > 0) val = Fcons (init, val); return val; } /* Allocation of vectors */ struct Lisp_Vector *all_vectors; struct Lisp_Vector * allocate_vectorlike (len) EMACS_INT len; { struct Lisp_Vector *p; allocating_for_lisp = 1; p = (struct Lisp_Vector *)xmalloc (sizeof (struct Lisp_Vector) + (len - 1) * sizeof (Lisp_Object)); allocating_for_lisp = 0; VALIDATE_LISP_STORAGE (p, 0); consing_since_gc += (sizeof (struct Lisp_Vector) + (len - 1) * sizeof (Lisp_Object)); vector_cells_consed += len; p->next = all_vectors; all_vectors = p; return p; } DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0, "Return a newly created vector of length LENGTH, with each element being INIT.\n\ See also the function `vector'.") (length, init) register Lisp_Object length, init; { Lisp_Object vector; register EMACS_INT sizei; register int index; register struct Lisp_Vector *p; CHECK_NATNUM (length, 0); sizei = XFASTINT (length); p = allocate_vectorlike (sizei); p->size = sizei; for (index = 0; index < sizei; index++) p->contents[index] = init; XSETVECTOR (vector, p); return vector; } DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, "Return a newly created char-table, with purpose PURPOSE.\n\ Each element is initialized to INIT, which defaults to nil.\n\ PURPOSE should be a symbol which has a `char-table-extra-slot' property.\n\ The property's value should be an integer between 0 and 10.") (purpose, init) register Lisp_Object purpose, init; { Lisp_Object vector; Lisp_Object n; CHECK_SYMBOL (purpose, 1); n = Fget (purpose, Qchar_table_extra_slots); CHECK_NUMBER (n, 0); if (XINT (n) < 0 || XINT (n) > 10) args_out_of_range (n, Qnil); /* Add 2 to the size for the defalt and parent slots. */ vector = Fmake_vector (make_number (CHAR_TABLE_STANDARD_SLOTS + XINT (n)), init); XCHAR_TABLE (vector)->parent = Qnil; XCHAR_TABLE (vector)->purpose = purpose; XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); return vector; } DEFUN ("vector", Fvector, Svector, 0, MANY, 0, "Return a newly created vector with specified arguments as elements.\n\ Any number of arguments, even zero arguments, are allowed.") (nargs, args) register int nargs; Lisp_Object *args; { register Lisp_Object len, val; register int index; register struct Lisp_Vector *p; XSETFASTINT (len, nargs); val = Fmake_vector (len, Qnil); p = XVECTOR (val); for (index = 0; index < nargs; index++) p->contents[index] = args[index]; return val; } DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, "Create a byte-code object with specified arguments as elements.\n\ The arguments should be the arglist, bytecode-string, constant vector,\n\ stack size, (optional) doc string, and (optional) interactive spec.\n\ The first four arguments are required; at most six have any\n\ significance.") (nargs, args) register int nargs; Lisp_Object *args; { register Lisp_Object len, val; register int index; register struct Lisp_Vector *p; XSETFASTINT (len, nargs); if (!NILP (Vpurify_flag)) val = make_pure_vector (len); else val = Fmake_vector (len, Qnil); p = XVECTOR (val); for (index = 0; index < nargs; index++) { if (!NILP (Vpurify_flag)) args[index] = Fpurecopy (args[index]); p->contents[index] = args[index]; } XSETCOMPILED (val, val); return val; } /* Allocation of symbols. Just like allocation of conses! Each symbol_block is just under 1020 bytes long, since malloc really allocates in units of powers of two and uses 4 bytes for its own overhead. */ #define SYMBOL_BLOCK_SIZE \ ((1020 - sizeof (struct symbol_block *)) / sizeof (struct Lisp_Symbol)) struct symbol_block { struct symbol_block *next; struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE]; }; struct symbol_block *symbol_block; int symbol_block_index; struct Lisp_Symbol *symbol_free_list; void init_symbol () { allocating_for_lisp = 1; symbol_block = (struct symbol_block *) malloc (sizeof (struct symbol_block)); allocating_for_lisp = 0; symbol_block->next = 0; bzero ((char *) symbol_block->symbols, sizeof symbol_block->symbols); symbol_block_index = 0; symbol_free_list = 0; } DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, "Return a newly allocated uninterned symbol whose name is NAME.\n\ Its value and function definition are void, and its property list is nil.") (str) Lisp_Object str; { register Lisp_Object val; register struct Lisp_Symbol *p; CHECK_STRING (str, 0); if (symbol_free_list) { XSETSYMBOL (val, symbol_free_list); symbol_free_list = *(struct Lisp_Symbol **)&symbol_free_list->value; } else { if (symbol_block_index == SYMBOL_BLOCK_SIZE) { struct symbol_block *new; allocating_for_lisp = 1; new = (struct symbol_block *) xmalloc (sizeof (struct symbol_block)); allocating_for_lisp = 0; VALIDATE_LISP_STORAGE (new, sizeof *new); new->next = symbol_block; symbol_block = new; symbol_block_index = 0; } XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]); } p = XSYMBOL (val); p->name = XSTRING (str); p->plist = Qnil; p->value = Qunbound; p->function = Qunbound; p->next = 0; consing_since_gc += sizeof (struct Lisp_Symbol); symbols_consed++; return val; } /* Allocation of markers and other objects that share that structure. Works like allocation of conses. */ #define MARKER_BLOCK_SIZE \ ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc)) struct marker_block { struct marker_block *next; union Lisp_Misc markers[MARKER_BLOCK_SIZE]; }; struct marker_block *marker_block; int marker_block_index; union Lisp_Misc *marker_free_list; void init_marker () { allocating_for_lisp = 1; marker_block = (struct marker_block *) malloc (sizeof (struct marker_block)); allocating_for_lisp = 0; marker_block->next = 0; bzero ((char *) marker_block->markers, sizeof marker_block->markers); marker_block_index = 0; marker_free_list = 0; } /* Return a newly allocated Lisp_Misc object, with no substructure. */ Lisp_Object allocate_misc () { Lisp_Object val; if (marker_free_list) { XSETMISC (val, marker_free_list); marker_free_list = marker_free_list->u_free.chain; } else { if (marker_block_index == MARKER_BLOCK_SIZE) { struct marker_block *new; allocating_for_lisp = 1; new = (struct marker_block *) xmalloc (sizeof (struct marker_block)); allocating_for_lisp = 0; VALIDATE_LISP_STORAGE (new, sizeof *new); new->next = marker_block; marker_block = new; marker_block_index = 0; } XSETMISC (val, &marker_block->markers[marker_block_index++]); } consing_since_gc += sizeof (union Lisp_Misc); misc_objects_consed++; return val; } DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, "Return a newly allocated marker which does not point at any place.") () { register Lisp_Object val; register struct Lisp_Marker *p; val = allocate_misc (); XMISCTYPE (val) = Lisp_Misc_Marker; p = XMARKER (val); p->buffer = 0; p->bufpos = 0; p->chain = Qnil; p->insertion_type = 0; return val; } /* Allocation of strings */ /* Strings reside inside of string_blocks. The entire data of the string, both the size and the contents, live in part of the `chars' component of a string_block. The `pos' component is the index within `chars' of the first free byte. first_string_block points to the first string_block ever allocated. Each block points to the next one with its `next' field. The `prev' fields chain in reverse order. The last one allocated is the one currently being filled. current_string_block points to it. The string_blocks that hold individual large strings go in a separate chain, started by large_string_blocks. */ /* String blocks contain this many useful bytes. 8188 is power of 2, minus 4 for malloc overhead. */ #define STRING_BLOCK_SIZE (8188 - sizeof (struct string_block_head)) /* A string bigger than this gets its own specially-made string block if it doesn't fit in the current one. */ #define STRING_BLOCK_OUTSIZE 1024 struct string_block_head { struct string_block *next, *prev; int pos; }; struct string_block { struct string_block *next, *prev; EMACS_INT pos; char chars[STRING_BLOCK_SIZE]; }; /* This points to the string block we are now allocating strings. */ struct string_block *current_string_block; /* This points to the oldest string block, the one that starts the chain. */ struct string_block *first_string_block; /* Last string block in chain of those made for individual large strings. */ struct string_block *large_string_blocks; /* If SIZE is the length of a string, this returns how many bytes the string occupies in a string_block (including padding). */ #define STRING_FULLSIZE(size) (((size) + sizeof (struct Lisp_String) + PAD) \ & ~(PAD - 1)) #define PAD (sizeof (EMACS_INT)) #if 0 #define STRING_FULLSIZE(SIZE) \ (((SIZE) + 2 * sizeof (EMACS_INT)) & ~(sizeof (EMACS_INT) - 1)) #endif void init_strings () { allocating_for_lisp = 1; current_string_block = (struct string_block *) malloc (sizeof (struct string_block)); allocating_for_lisp = 0; first_string_block = current_string_block; consing_since_gc += sizeof (struct string_block); current_string_block->next = 0; current_string_block->prev = 0; current_string_block->pos = 0; large_string_blocks = 0; } DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, "Return a newly created string of length LENGTH, with each element being INIT.\n\ Both LENGTH and INIT must be numbers.") (length, init) Lisp_Object length, init; { register Lisp_Object val; register unsigned char *p, *end, c; CHECK_NATNUM (length, 0); CHECK_NUMBER (init, 1); val = make_uninit_string (XFASTINT (length)); c = XINT (init); p = XSTRING (val)->data; end = p + XSTRING (val)->size; while (p != end) *p++ = c; *p = 0; return val; } DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, "Return a newly created bitstring of length LENGTH, with INIT as each element.\n\ Both LENGTH and INIT must be numbers. INIT matters only in whether it is t or nil.") (length, init) Lisp_Object length, init; { register Lisp_Object val; struct Lisp_Bool_Vector *p; int real_init, i; int length_in_chars, length_in_elts, bits_per_value; CHECK_NATNUM (length, 0); bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR; length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value; length_in_chars = length_in_elts * sizeof (EMACS_INT); val = Fmake_vector (make_number (length_in_elts), Qnil); p = XBOOL_VECTOR (val); /* Get rid of any bits that would cause confusion. */ p->vector_size = 0; XSETBOOL_VECTOR (val, p); p->size = XFASTINT (length); real_init = (NILP (init) ? 0 : -1); for (i = 0; i < length_in_chars ; i++) p->data[i] = real_init; return val; } Lisp_Object make_string (contents, length) char *contents; int length; { register Lisp_Object val; val = make_uninit_string (length); bcopy (contents, XSTRING (val)->data, length); return val; } Lisp_Object build_string (str) char *str; { return make_string (str, strlen (str)); } Lisp_Object make_uninit_string (length) int length; { register Lisp_Object val; register int fullsize = STRING_FULLSIZE (length); if (length < 0) abort (); if (fullsize <= STRING_BLOCK_SIZE - current_string_block->pos) /* This string can fit in the current string block */ { XSETSTRING (val, ((struct Lisp_String *) (current_string_block->chars + current_string_block->pos))); current_string_block->pos += fullsize; } else if (fullsize > STRING_BLOCK_OUTSIZE) /* This string gets its own string block */ { register struct string_block *new; allocating_for_lisp = 1; new = (struct string_block *) xmalloc (sizeof (struct string_block_head) + fullsize); allocating_for_lisp = 0; VALIDATE_LISP_STORAGE (new, 0); consing_since_gc += sizeof (struct string_block_head) + fullsize; new->pos = fullsize; new->next = large_string_blocks; large_string_blocks = new; XSETSTRING (val, ((struct Lisp_String *) ((struct string_block_head *)new + 1))); } else /* Make a new current string block and start it off with this string */ { register struct string_block *new; allocating_for_lisp = 1; new = (struct string_block *) xmalloc (sizeof (struct string_block)); allocating_for_lisp = 0; VALIDATE_LISP_STORAGE (new, sizeof *new); consing_since_gc += sizeof (struct string_block); current_string_block->next = new; new->prev = current_string_block; new->next = 0; current_string_block = new; new->pos = fullsize; XSETSTRING (val, (struct Lisp_String *) current_string_block->chars); } string_chars_consed += fullsize; XSTRING (val)->size = length; XSTRING (val)->data[length] = 0; INITIALIZE_INTERVAL (XSTRING (val), NULL_INTERVAL); return val; } /* Return a newly created vector or string with specified arguments as elements. If all the arguments are characters that can fit in a string of events, make a string; otherwise, make a vector. Any number of arguments, even zero arguments, are allowed. */ Lisp_Object make_event_array (nargs, args) register int nargs; Lisp_Object *args; { int i; for (i = 0; i < nargs; i++) /* The things that fit in a string are characters that are in 0...127, after discarding the meta bit and all the bits above it. */ if (!INTEGERP (args[i]) || (XUINT (args[i]) & ~(-CHAR_META)) >= 0200) return Fvector (nargs, args); /* Since the loop exited, we know that all the things in it are characters, so we can make a string. */ { Lisp_Object result; result = Fmake_string (nargs, make_number (0)); for (i = 0; i < nargs; i++) { XSTRING (result)->data[i] = XINT (args[i]); /* Move the meta bit to the right place for a string char. */ if (XINT (args[i]) & CHAR_META) XSTRING (result)->data[i] |= 0x80; } return result; } } /* Pure storage management. */ /* Must get an error if pure storage is full, since if it cannot hold a large string it may be able to hold conses that point to that string; then the string is not protected from gc. */ Lisp_Object make_pure_string (data, length) char *data; int length; { register Lisp_Object new; register int size = sizeof (EMACS_INT) + INTERVAL_PTR_SIZE + length + 1; if (pureptr + size > PURESIZE) error ("Pure Lisp storage exhausted"); XSETSTRING (new, PUREBEG + pureptr); XSTRING (new)->size = length; bcopy (data, XSTRING (new)->data, length); XSTRING (new)->data[length] = 0; /* We must give strings in pure storage some kind of interval. So we give them a null one. */ #if defined (USE_TEXT_PROPERTIES) XSTRING (new)->intervals = NULL_INTERVAL; #endif pureptr += (size + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT) * sizeof (EMACS_INT); return new; } Lisp_Object pure_cons (car, cdr) Lisp_Object car, cdr; { register Lisp_Object new; if (pureptr + sizeof (struct Lisp_Cons) > PURESIZE) error ("Pure Lisp storage exhausted"); XSETCONS (new, PUREBEG + pureptr); pureptr += sizeof (struct Lisp_Cons); XCONS (new)->car = Fpurecopy (car); XCONS (new)->cdr = Fpurecopy (cdr); return new; } #ifdef LISP_FLOAT_TYPE Lisp_Object make_pure_float (num) double num; { register Lisp_Object new; /* Make sure that PUREBEG + pureptr is aligned on at least a sizeof (double) boundary. Some architectures (like the sparc) require this, and I suspect that floats are rare enough that it's no tragedy for those that do. */ { int alignment; char *p = PUREBEG + pureptr; #ifdef __GNUC__ #if __GNUC__ >= 2 alignment = __alignof (struct Lisp_Float); #else alignment = sizeof (struct Lisp_Float); #endif #else alignment = sizeof (struct Lisp_Float); #endif p = (char *) (((unsigned long) p + alignment - 1) & - alignment); pureptr = p - PUREBEG; } if (pureptr + sizeof (struct Lisp_Float) > PURESIZE) error ("Pure Lisp storage exhausted"); XSETFLOAT (new, PUREBEG + pureptr); pureptr += sizeof (struct Lisp_Float); XFLOAT (new)->data = num; XSETFASTINT (XFLOAT (new)->type, 0); /* bug chasing -wsr */ return new; } #endif /* LISP_FLOAT_TYPE */ Lisp_Object make_pure_vector (len) EMACS_INT len; { register Lisp_Object new; register EMACS_INT size = sizeof (struct Lisp_Vector) + (len - 1) * sizeof (Lisp_Object); if (pureptr + size > PURESIZE) error ("Pure Lisp storage exhausted"); XSETVECTOR (new, PUREBEG + pureptr); pureptr += size; XVECTOR (new)->size = len; return new; } DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, "Make a copy of OBJECT in pure storage.\n\ Recursively copies contents of vectors and cons cells.\n\ Does not copy symbols.") (obj) register Lisp_Object obj; { if (NILP (Vpurify_flag)) return obj; if ((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE) && (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure) return obj; if (CONSP (obj)) return pure_cons (XCONS (obj)->car, XCONS (obj)->cdr); #ifdef LISP_FLOAT_TYPE else if (FLOATP (obj)) return make_pure_float (XFLOAT (obj)->data); #endif /* LISP_FLOAT_TYPE */ else if (STRINGP (obj)) return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size); else if (COMPILEDP (obj) || VECTORP (obj)) { register struct Lisp_Vector *vec; register int i, size; size = XVECTOR (obj)->size; if (size & PSEUDOVECTOR_FLAG) size &= PSEUDOVECTOR_SIZE_MASK; vec = XVECTOR (make_pure_vector (size)); for (i = 0; i < size; i++) vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]); if (COMPILEDP (obj)) XSETCOMPILED (obj, vec); else XSETVECTOR (obj, vec); return obj; } else if (MARKERP (obj)) error ("Attempt to copy a marker to pure storage"); else return obj; } /* Recording what needs to be marked for gc. */ struct gcpro *gcprolist; #define NSTATICS 768 Lisp_Object *staticvec[NSTATICS] = {0}; int staticidx = 0; /* Put an entry in staticvec, pointing at the variable whose address is given */ void staticpro (varaddress) Lisp_Object *varaddress; { staticvec[staticidx++] = varaddress; if (staticidx >= NSTATICS) abort (); } struct catchtag { Lisp_Object tag; Lisp_Object val; struct catchtag *next; /* jmp_buf jmp; /* We don't need this for GC purposes */ }; struct backtrace { struct backtrace *next; Lisp_Object *function; Lisp_Object *args; /* Points to vector of args. */ int nargs; /* length of vector */ /* if nargs is UNEVALLED, args points to slot holding list of unevalled args */ char evalargs; }; /* Garbage collection! */ int total_conses, total_markers, total_symbols, total_string_size, total_vector_size; int total_free_conses, total_free_markers, total_free_symbols; #ifdef LISP_FLOAT_TYPE int total_free_floats, total_floats; #endif /* LISP_FLOAT_TYPE */ /* Temporarily prevent garbage collection. */ int inhibit_garbage_collection () { int count = specpdl_ptr - specpdl; Lisp_Object number; int nbits = min (VALBITS, BITS_PER_INT); XSETINT (number, ((EMACS_INT) 1 << (nbits - 1)) - 1); specbind (Qgc_cons_threshold, number); return count; } DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", "Reclaim storage for Lisp objects no longer needed.\n\ Returns info on amount of space in use:\n\ ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)\n\ (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS\n\ (USED-FLOATS . FREE-FLOATS))\n\ Garbage collection happens automatically if you cons more than\n\ `gc-cons-threshold' bytes of Lisp data since previous garbage collection.") () { register struct gcpro *tail; register struct specbinding *bind; struct catchtag *catch; struct handler *handler; register struct backtrace *backlist; register Lisp_Object tem; char *omessage = echo_area_glyphs; int omessage_length = echo_area_glyphs_length; char stack_top_variable; register int i; /* In case user calls debug_print during GC, don't let that cause a recursive GC. */ consing_since_gc = 0; /* Save a copy of the contents of the stack, for debugging. */ #if MAX_SAVE_STACK > 0 if (NILP (Vpurify_flag)) { i = &stack_top_variable - stack_bottom; if (i < 0) i = -i; if (i < MAX_SAVE_STACK) { if (stack_copy == 0) stack_copy = (char *) xmalloc (stack_copy_size = i); else if (stack_copy_size < i) stack_copy = (char *) xrealloc (stack_copy, (stack_copy_size = i)); if (stack_copy) { if ((EMACS_INT) (&stack_top_variable - stack_bottom) > 0) bcopy (stack_bottom, stack_copy, i); else bcopy (&stack_top_variable, stack_copy, i); } } } #endif /* MAX_SAVE_STACK > 0 */ if (!noninteractive) message1_nolog ("Garbage collecting..."); /* Don't keep command history around forever */ tem = Fnthcdr (make_number (30), Vcommand_history); if (CONSP (tem)) XCONS (tem)->cdr = Qnil; /* Likewise for undo information. */ { register struct buffer *nextb = all_buffers; while (nextb) { /* If a buffer's undo list is Qt, that means that undo is turned off in that buffer. Calling truncate_undo_list on Qt tends to return NULL, which effectively turns undo back on. So don't call truncate_undo_list if undo_list is Qt. */ if (! EQ (nextb->undo_list, Qt)) nextb->undo_list = truncate_undo_list (nextb->undo_list, undo_limit, undo_strong_limit); nextb = nextb->next; } } gc_in_progress = 1; /* clear_marks (); */ /* In each "large string", set the MARKBIT of the size field. That enables mark_object to recognize them. */ { register struct string_block *b; for (b = large_string_blocks; b; b = b->next) ((struct Lisp_String *)(&b->chars[0]))->size |= MARKBIT; } /* Mark all the special slots that serve as the roots of accessibility. Usually the special slots to mark are contained in particular structures. Then we know no slot is marked twice because the structures don't overlap. In some cases, the structures point to the slots to be marked. For these, we use MARKBIT to avoid double marking of the slot. */ for (i = 0; i < staticidx; i++) mark_object (staticvec[i]); for (tail = gcprolist; tail; tail = tail->next) for (i = 0; i < tail->nvars; i++) if (!XMARKBIT (tail->var[i])) { mark_object (&tail->var[i]); XMARK (tail->var[i]); } for (bind = specpdl; bind != specpdl_ptr; bind++) { mark_object (&bind->symbol); mark_object (&bind->old_value); } for (catch = catchlist; catch; catch = catch->next) { mark_object (&catch->tag); mark_object (&catch->val); } for (handler = handlerlist; handler; handler = handler->next) { mark_object (&handler->handler); mark_object (&handler->var); } for (backlist = backtrace_list; backlist; backlist = backlist->next) { if (!XMARKBIT (*backlist->function)) { mark_object (backlist->function); XMARK (*backlist->function); } if (backlist->nargs == UNEVALLED || backlist->nargs == MANY) i = 0; else i = backlist->nargs - 1; for (; i >= 0; i--) if (!XMARKBIT (backlist->args[i])) { mark_object (&backlist->args[i]); XMARK (backlist->args[i]); } } mark_kboards (); gc_sweep (); /* Clear the mark bits that we set in certain root slots. */ for (tail = gcprolist; tail; tail = tail->next) for (i = 0; i < tail->nvars; i++) XUNMARK (tail->var[i]); for (backlist = backtrace_list; backlist; backlist = backlist->next) { XUNMARK (*backlist->function); if (backlist->nargs == UNEVALLED || backlist->nargs == MANY) i = 0; else i = backlist->nargs - 1; for (; i >= 0; i--) XUNMARK (backlist->args[i]); } XUNMARK (buffer_defaults.name); XUNMARK (buffer_local_symbols.name); /* clear_marks (); */ gc_in_progress = 0; consing_since_gc = 0; if (gc_cons_threshold < 10000) gc_cons_threshold = 10000; if (omessage || minibuf_level > 0) message2_nolog (omessage, omessage_length); else if (!noninteractive) message1_nolog ("Garbage collecting...done"); return Fcons (Fcons (make_number (total_conses), make_number (total_free_conses)), Fcons (Fcons (make_number (total_symbols), make_number (total_free_symbols)), Fcons (Fcons (make_number (total_markers), make_number (total_free_markers)), Fcons (make_number (total_string_size), Fcons (make_number (total_vector_size), #ifdef LISP_FLOAT_TYPE Fcons (Fcons (make_number (total_floats), make_number (total_free_floats)), Qnil) #else /* not LISP_FLOAT_TYPE */ Qnil #endif /* not LISP_FLOAT_TYPE */ ))))); } #if 0 static void clear_marks () { /* Clear marks on all conses */ { register struct cons_block *cblk; register int lim = cons_block_index; for (cblk = cons_block; cblk; cblk = cblk->next) { register int i; for (i = 0; i < lim; i++) XUNMARK (cblk->conses[i].car); lim = CONS_BLOCK_SIZE; } } /* Clear marks on all symbols */ { register struct symbol_block *sblk; register int lim = symbol_block_index; for (sblk = symbol_block; sblk; sblk = sblk->next) { register int i; for (i = 0; i < lim; i++) { XUNMARK (sblk->symbols[i].plist); } lim = SYMBOL_BLOCK_SIZE; } } /* Clear marks on all markers */ { register struct marker_block *sblk; register int lim = marker_block_index; for (sblk = marker_block; sblk; sblk = sblk->next) { register int i; for (i = 0; i < lim; i++) if (sblk->markers[i].u_marker.type == Lisp_Misc_Marker) XUNMARK (sblk->markers[i].u_marker.chain); lim = MARKER_BLOCK_SIZE; } } /* Clear mark bits on all buffers */ { register struct buffer *nextb = all_buffers; while (nextb) { XUNMARK (nextb->name); nextb = nextb->next; } } } #endif /* Mark reference to a Lisp_Object. If the object referred to has not been seen yet, recursively mark all the references contained in it. If the object referenced is a short string, the referencing slot is threaded into a chain of such slots, pointed to from the `size' field of the string. The actual string size lives in the last slot in the chain. We recognize the end because it is < (unsigned) STRING_BLOCK_SIZE. */ #define LAST_MARKED_SIZE 500 Lisp_Object *last_marked[LAST_MARKED_SIZE]; int last_marked_index; static void mark_object (argptr) Lisp_Object *argptr; { Lisp_Object *objptr = argptr; register Lisp_Object obj; loop: obj = *objptr; loop2: XUNMARK (obj); if ((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE) && (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure) return; last_marked[last_marked_index++] = objptr; if (last_marked_index == LAST_MARKED_SIZE) last_marked_index = 0; switch (SWITCH_ENUM_CAST (XGCTYPE (obj))) { case Lisp_String: { register struct Lisp_String *ptr = XSTRING (obj); MARK_INTERVAL_TREE (ptr->intervals); if (ptr->size & MARKBIT) /* A large string. Just set ARRAY_MARK_FLAG. */ ptr->size |= ARRAY_MARK_FLAG; else { /* A small string. Put this reference into the chain of references to it. If the address includes MARKBIT, put that bit elsewhere when we store OBJPTR into the size field. */ if (XMARKBIT (*objptr)) { XSETFASTINT (*objptr, ptr->size); XMARK (*objptr); } else XSETFASTINT (*objptr, ptr->size); if ((EMACS_INT) objptr & DONT_COPY_FLAG) abort (); ptr->size = (EMACS_INT) objptr; if (ptr->size & MARKBIT) ptr->size ^= MARKBIT | DONT_COPY_FLAG; } } break; case Lisp_Vectorlike: if (GC_BUFFERP (obj)) { if (!XMARKBIT (XBUFFER (obj)->name)) mark_buffer (obj); } else if (GC_SUBRP (obj)) break; else if (GC_COMPILEDP (obj)) /* We could treat this just like a vector, but it is better to save the COMPILED_CONSTANTS element for last and avoid recursion there. */ { register struct Lisp_Vector *ptr = XVECTOR (obj); register EMACS_INT size = ptr->size; /* See comment above under Lisp_Vector. */ struct Lisp_Vector *volatile ptr1 = ptr; register int i; if (size & ARRAY_MARK_FLAG) break; /* Already marked */ ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */ size &= PSEUDOVECTOR_SIZE_MASK; for (i = 0; i < size; i++) /* and then mark its elements */ { if (i != COMPILED_CONSTANTS) mark_object (&ptr1->contents[i]); } /* This cast should be unnecessary, but some Mips compiler complains (MIPS-ABI + SysVR4, DC/OSx, etc). */ objptr = (Lisp_Object *) &ptr1->contents[COMPILED_CONSTANTS]; goto loop; } #ifdef MULTI_FRAME else if (GC_FRAMEP (obj)) { /* See comment above under Lisp_Vector for why this is volatile. */ register struct frame *volatile ptr = XFRAME (obj); register EMACS_INT size = ptr->size; if (size & ARRAY_MARK_FLAG) break; /* Already marked */ ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */ mark_object (&ptr->name); mark_object (&ptr->icon_name); mark_object (&ptr->focus_frame); mark_object (&ptr->selected_window); mark_object (&ptr->minibuffer_window); mark_object (&ptr->param_alist); mark_object (&ptr->scroll_bars); mark_object (&ptr->condemned_scroll_bars); mark_object (&ptr->menu_bar_items); mark_object (&ptr->face_alist); mark_object (&ptr->menu_bar_vector); mark_object (&ptr->buffer_predicate); } #endif /* MULTI_FRAME */ else if (GC_BOOL_VECTOR_P (obj)) ; else { register struct Lisp_Vector *ptr = XVECTOR (obj); register EMACS_INT size = ptr->size; /* The reason we use ptr1 is to avoid an apparent hardware bug that happens occasionally on the FSF's HP 300s. The bug is that a2 gets clobbered by recursive calls to mark_object. The clobberage seems to happen during function entry, perhaps in the moveml instruction. Yes, this is a crock, but we have to do it. */ struct Lisp_Vector *volatile ptr1 = ptr; register int i; if (size & ARRAY_MARK_FLAG) break; /* Already marked */ ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */ if (size & PSEUDOVECTOR_FLAG) size &= PSEUDOVECTOR_SIZE_MASK; for (i = 0; i < size; i++) /* and then mark its elements */ mark_object (&ptr1->contents[i]); } break; case Lisp_Symbol: { /* See comment above under Lisp_Vector for why this is volatile. */ register struct Lisp_Symbol *volatile ptr = XSYMBOL (obj); struct Lisp_Symbol *ptrx; if (XMARKBIT (ptr->plist)) break; XMARK (ptr->plist); mark_object ((Lisp_Object *) &ptr->value); mark_object (&ptr->function); mark_object (&ptr->plist); XSETTYPE (*(Lisp_Object *) &ptr->name, Lisp_String); mark_object (&ptr->name); ptr = ptr->next; if (ptr) { /* For the benefit of the last_marked log. */ objptr = (Lisp_Object *)&XSYMBOL (obj)->next; ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */ XSETSYMBOL (obj, ptrx); /* We can't goto loop here because *objptr doesn't contain an actual Lisp_Object with valid datatype field. */ goto loop2; } } break; case Lisp_Misc: switch (XMISCTYPE (obj)) { case Lisp_Misc_Marker: XMARK (XMARKER (obj)->chain); /* DO NOT mark thru the marker's chain. The buffer's markers chain does not preserve markers from gc; instead, markers are removed from the chain when freed by gc. */ break; case Lisp_Misc_Buffer_Local_Value: case Lisp_Misc_Some_Buffer_Local_Value: { register struct Lisp_Buffer_Local_Value *ptr = XBUFFER_LOCAL_VALUE (obj); if (XMARKBIT (ptr->car)) break; XMARK (ptr->car); /* If the cdr is nil, avoid recursion for the car. */ if (EQ (ptr->cdr, Qnil)) { objptr = &ptr->car; goto loop; } mark_object (&ptr->car); /* See comment above under Lisp_Vector for why not use ptr here. */ objptr = &XBUFFER_LOCAL_VALUE (obj)->cdr; goto loop; } case Lisp_Misc_Intfwd: case Lisp_Misc_Boolfwd: case Lisp_Misc_Objfwd: case Lisp_Misc_Buffer_Objfwd: case Lisp_Misc_Kboard_Objfwd: /* Don't bother with Lisp_Buffer_Objfwd, since all markable slots in current buffer marked anyway. */ /* Don't need to do Lisp_Objfwd, since the places they point are protected with staticpro. */ break; case Lisp_Misc_Overlay: { struct Lisp_Overlay *ptr = XOVERLAY (obj); if (!XMARKBIT (ptr->plist)) { XMARK (ptr->plist); mark_object (&ptr->start); mark_object (&ptr->end); objptr = &ptr->plist; goto loop; } } break; default: abort (); } break; case Lisp_Cons: { register struct Lisp_Cons *ptr = XCONS (obj); if (XMARKBIT (ptr->car)) break; XMARK (ptr->car); /* If the cdr is nil, avoid recursion for the car. */ if (EQ (ptr->cdr, Qnil)) { objptr = &ptr->car; goto loop; } mark_object (&ptr->car); /* See comment above under Lisp_Vector for why not use ptr here. */ objptr = &XCONS (obj)->cdr; goto loop; } #ifdef LISP_FLOAT_TYPE case Lisp_Float: XMARK (XFLOAT (obj)->type); break; #endif /* LISP_FLOAT_TYPE */ case Lisp_Int: break; default: abort (); } } /* Mark the pointers in a buffer structure. */ static void mark_buffer (buf) Lisp_Object buf; { register struct buffer *buffer = XBUFFER (buf); register Lisp_Object *ptr; Lisp_Object base_buffer; /* This is the buffer's markbit */ mark_object (&buffer->name); XMARK (buffer->name); MARK_INTERVAL_TREE (BUF_INTERVALS (buffer)); #if 0 mark_object (buffer->syntax_table); /* Mark the various string-pointers in the buffer object. Since the strings may be relocated, we must mark them in their actual slots. So gc_sweep must convert each slot back to an ordinary C pointer. */ XSETSTRING (*(Lisp_Object *)&buffer->upcase_table, buffer->upcase_table); mark_object ((Lisp_Object *)&buffer->upcase_table); XSETSTRING (*(Lisp_Object *)&buffer->downcase_table, buffer->downcase_table); mark_object ((Lisp_Object *)&buffer->downcase_table); XSETSTRING (*(Lisp_Object *)&buffer->sort_table, buffer->sort_table); mark_object ((Lisp_Object *)&buffer->sort_table); XSETSTRING (*(Lisp_Object *)&buffer->folding_sort_table, buffer->folding_sort_table); mark_object ((Lisp_Object *)&buffer->folding_sort_table); #endif for (ptr = &buffer->name + 1; (char *)ptr < (char *)buffer + sizeof (struct buffer); ptr++) mark_object (ptr); /* If this is an indirect buffer, mark its base buffer. */ if (buffer->base_buffer && !XMARKBIT (buffer->base_buffer->name)) { XSETBUFFER (base_buffer, buffer->base_buffer); mark_buffer (base_buffer); } } /* Mark the pointers in the kboard objects. */ static void mark_kboards () { KBOARD *kb; Lisp_Object *p; for (kb = all_kboards; kb; kb = kb->next_kboard) { if (kb->kbd_macro_buffer) for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++) mark_object (p); mark_object (&kb->Vprefix_arg); mark_object (&kb->kbd_queue); mark_object (&kb->Vlast_kbd_macro); mark_object (&kb->Vsystem_key_alist); mark_object (&kb->system_key_syms); } } /* Sweep: find all structures not marked, and free them. */ static void gc_sweep () { total_string_size = 0; compact_strings (); /* Put all unmarked conses on free list */ { register struct cons_block *cblk; register int lim = cons_block_index; register int num_free = 0, num_used = 0; cons_free_list = 0; for (cblk = cons_block; cblk; cblk = cblk->next) { register int i; for (i = 0; i < lim; i++) if (!XMARKBIT (cblk->conses[i].car)) { num_free++; *(struct Lisp_Cons **)&cblk->conses[i].car = cons_free_list; cons_free_list = &cblk->conses[i]; } else { num_used++; XUNMARK (cblk->conses[i].car); } lim = CONS_BLOCK_SIZE; } total_conses = num_used; total_free_conses = num_free; } #ifdef LISP_FLOAT_TYPE /* Put all unmarked floats on free list */ { register struct float_block *fblk; register int lim = float_block_index; register int num_free = 0, num_used = 0; float_free_list = 0; for (fblk = float_block; fblk; fblk = fblk->next) { register int i; for (i = 0; i < lim; i++) if (!XMARKBIT (fblk->floats[i].type)) { num_free++; *(struct Lisp_Float **)&fblk->floats[i].type = float_free_list; float_free_list = &fblk->floats[i]; } else { num_used++; XUNMARK (fblk->floats[i].type); } lim = FLOAT_BLOCK_SIZE; } total_floats = num_used; total_free_floats = num_free; } #endif /* LISP_FLOAT_TYPE */ #ifdef USE_TEXT_PROPERTIES /* Put all unmarked intervals on free list */ { register struct interval_block *iblk; register int lim = interval_block_index; register int num_free = 0, num_used = 0; interval_free_list = 0; for (iblk = interval_block; iblk; iblk = iblk->next) { register int i; for (i = 0; i < lim; i++) { if (! XMARKBIT (iblk->intervals[i].plist)) { iblk->intervals[i].parent = interval_free_list; interval_free_list = &iblk->intervals[i]; num_free++; } else { num_used++; XUNMARK (iblk->intervals[i].plist); } } lim = INTERVAL_BLOCK_SIZE; } total_intervals = num_used; total_free_intervals = num_free; } #endif /* USE_TEXT_PROPERTIES */ /* Put all unmarked symbols on free list */ { register struct symbol_block *sblk; register int lim = symbol_block_index; register int num_free = 0, num_used = 0; symbol_free_list = 0; for (sblk = symbol_block; sblk; sblk = sblk->next) { register int i; for (i = 0; i < lim; i++) if (!XMARKBIT (sblk->symbols[i].plist)) { *(struct Lisp_Symbol **)&sblk->symbols[i].value = symbol_free_list; symbol_free_list = &sblk->symbols[i]; num_free++; } else { num_used++; sblk->symbols[i].name = XSTRING (*(Lisp_Object *) &sblk->symbols[i].name); XUNMARK (sblk->symbols[i].plist); } lim = SYMBOL_BLOCK_SIZE; } total_symbols = num_used; total_free_symbols = num_free; } #ifndef standalone /* Put all unmarked markers on free list. Dechain each one first from the buffer it points into, but only if it's a real marker. */ { register struct marker_block *mblk; register int lim = marker_block_index; register int num_free = 0, num_used = 0; marker_free_list = 0; for (mblk = marker_block; mblk; mblk = mblk->next) { register int i; EMACS_INT already_free = -1; for (i = 0; i < lim; i++) { Lisp_Object *markword; switch (mblk->markers[i].u_marker.type) { case Lisp_Misc_Marker: markword = &mblk->markers[i].u_marker.chain; break; case Lisp_Misc_Buffer_Local_Value: case Lisp_Misc_Some_Buffer_Local_Value: markword = &mblk->markers[i].u_buffer_local_value.car; break; case Lisp_Misc_Overlay: markword = &mblk->markers[i].u_overlay.plist; break; case Lisp_Misc_Free: /* If the object was already free, keep it on the free list. */ markword = &already_free; break; default: markword = 0; break; } if (markword && !XMARKBIT (*markword)) { Lisp_Object tem; if (mblk->markers[i].u_marker.type == Lisp_Misc_Marker) { /* tem1 avoids Sun compiler bug */ struct Lisp_Marker *tem1 = &mblk->markers[i].u_marker; XSETMARKER (tem, tem1); unchain_marker (tem); } /* Set the type of the freed object to Lisp_Misc_Free. We could leave the type alone, since nobody checks it, but this might catch bugs faster. */ mblk->markers[i].u_marker.type = Lisp_Misc_Free; mblk->markers[i].u_free.chain = marker_free_list; marker_free_list = &mblk->markers[i]; num_free++; } else { num_used++; if (markword) XUNMARK (*markword); } } lim = MARKER_BLOCK_SIZE; } total_markers = num_used; total_free_markers = num_free; } /* Free all unmarked buffers */ { register struct buffer *buffer = all_buffers, *prev = 0, *next; while (buffer) if (!XMARKBIT (buffer->name)) { if (prev) prev->next = buffer->next; else all_buffers = buffer->next; next = buffer->next; xfree (buffer); buffer = next; } else { XUNMARK (buffer->name); UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer)); #if 0 /* Each `struct Lisp_String *' was turned into a Lisp_Object for purposes of marking and relocation. Turn them back into C pointers now. */ buffer->upcase_table = XSTRING (*(Lisp_Object *)&buffer->upcase_table); buffer->downcase_table = XSTRING (*(Lisp_Object *)&buffer->downcase_table); buffer->sort_table = XSTRING (*(Lisp_Object *)&buffer->sort_table); buffer->folding_sort_table = XSTRING (*(Lisp_Object *)&buffer->folding_sort_table); #endif prev = buffer, buffer = buffer->next; } } #endif /* standalone */ /* Free all unmarked vectors */ { register struct Lisp_Vector *vector = all_vectors, *prev = 0, *next; total_vector_size = 0; while (vector) if (!(vector->size & ARRAY_MARK_FLAG)) { if (prev) prev->next = vector->next; else all_vectors = vector->next; next = vector->next; xfree (vector); vector = next; } else { vector->size &= ~ARRAY_MARK_FLAG; if (vector->size & PSEUDOVECTOR_FLAG) total_vector_size += (PSEUDOVECTOR_SIZE_MASK & vector->size); else total_vector_size += vector->size; prev = vector, vector = vector->next; } } /* Free all "large strings" not marked with ARRAY_MARK_FLAG. */ { 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; } } } } /* Compactify strings, relocate references, and free empty string blocks. */ static void compact_strings () { /* String block of old strings we are scanning. */ register struct string_block *from_sb; /* A preceding string block (or maybe the same one) where we are copying the still-live strings to. */ register struct string_block *to_sb; int pos; int to_pos; to_sb = first_string_block; to_pos = 0; /* Scan each existing string block sequentially, string by string. */ for (from_sb = first_string_block; from_sb; from_sb = from_sb->next) { pos = 0; /* POS is the index of the next string in the block. */ while (pos < from_sb->pos) { register struct Lisp_String *nextstr = (struct Lisp_String *) &from_sb->chars[pos]; register struct Lisp_String *newaddr; register EMACS_INT size = nextstr->size; /* NEXTSTR is the old address of the next string. Just skip it if it isn't marked. */ if (((EMACS_UINT) size & ~DONT_COPY_FLAG) > STRING_BLOCK_SIZE) { /* It is marked, so its size field is really a chain of refs. Find the end of the chain, where the actual size lives. */ while (((EMACS_UINT) size & ~DONT_COPY_FLAG) > STRING_BLOCK_SIZE) { if (size & DONT_COPY_FLAG) size ^= MARKBIT | DONT_COPY_FLAG; size = *(EMACS_INT *)size & ~MARKBIT; } total_string_size += size; /* If it won't fit in TO_SB, close it out, and move to the next sb. Keep doing so until TO_SB reaches a large enough, empty enough string block. We know that TO_SB cannot advance past FROM_SB here since FROM_SB is large enough to contain this string. Any string blocks skipped here will be patched out and freed later. */ while (to_pos + STRING_FULLSIZE (size) > max (to_sb->pos, STRING_BLOCK_SIZE)) { to_sb->pos = to_pos; to_sb = to_sb->next; to_pos = 0; } /* Compute new address of this string and update TO_POS for the space being used. */ newaddr = (struct Lisp_String *) &to_sb->chars[to_pos]; to_pos += STRING_FULLSIZE (size); /* Copy the string itself to the new place. */ if (nextstr != newaddr) bcopy (nextstr, newaddr, size + 1 + sizeof (EMACS_INT) + INTERVAL_PTR_SIZE); /* Go through NEXTSTR's chain of references and make each slot in the chain point to the new address of this string. */ size = newaddr->size; while (((EMACS_UINT) size & ~DONT_COPY_FLAG) > STRING_BLOCK_SIZE) { register Lisp_Object *objptr; if (size & DONT_COPY_FLAG) size ^= MARKBIT | DONT_COPY_FLAG; objptr = (Lisp_Object *)size; size = XFASTINT (*objptr) & ~MARKBIT; if (XMARKBIT (*objptr)) { XSETSTRING (*objptr, newaddr); XMARK (*objptr); } else XSETSTRING (*objptr, newaddr); } /* Store the actual size in the size field. */ newaddr->size = size; #ifdef USE_TEXT_PROPERTIES /* 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); XSETSTRING (* (Lisp_Object *) &newaddr->intervals->parent, newaddr); } #endif /* USE_TEXT_PROPERTIES */ } pos += STRING_FULLSIZE (size); } } /* Close out the last string block still used and free any that follow. */ to_sb->pos = to_pos; current_string_block = to_sb; from_sb = to_sb->next; to_sb->next = 0; while (from_sb) { to_sb = from_sb->next; xfree (from_sb); from_sb = to_sb; } /* Free any empty string blocks further back in the chain. This loop will never free first_string_block, but it is very unlikely that that one will become empty, so why bother checking? */ from_sb = first_string_block; while (to_sb = from_sb->next) { if (to_sb->pos == 0) { if (from_sb->next = to_sb->next) from_sb->next->prev = from_sb; xfree (to_sb); } else from_sb = to_sb; } } /* Debugging aids. */ DEFUN ("memory-limit", Fmemory_limit, Smemory_limit, 0, 0, 0, "Return the address of the last byte Emacs has allocated, divided by 1024.\n\ This may be helpful in debugging Emacs's memory usage.\n\ We divide the value by 1024 to make sure it fits in a Lisp integer.") () { Lisp_Object end; XSETINT (end, (EMACS_INT) sbrk (0) / 1024); return end; } DEFUN ("memory-use-counts", Fmemory_use_counts, Smemory_use_counts, 0, 0, 0, "Return a list of counters that measure how much consing there has been.\n\ Each of these counters increments for a certain kind of object.\n\ The counters wrap around from the largest positive integer to zero.\n\ Garbage collection does not decrease them.\n\ The elements of the value are as follows:\n\ (CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS MISCS INTERVALS)\n\ All are in units of 1 = one object consed\n\ except for VECTOR-CELLS and STRING-CHARS, which count the total length of\n\ objects consed.\n\ MISCS include overlays, markers, and some internal types.\n\ Frames, windows, buffers, and subprocesses count as vectors\n\ (but the contents of a buffer's text do not count here).") () { Lisp_Object lisp_cons_cells_consed; Lisp_Object lisp_floats_consed; Lisp_Object lisp_vector_cells_consed; Lisp_Object lisp_symbols_consed; Lisp_Object lisp_string_chars_consed; Lisp_Object lisp_misc_objects_consed; Lisp_Object lisp_intervals_consed; XSETINT (lisp_cons_cells_consed, cons_cells_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); XSETINT (lisp_floats_consed, floats_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); XSETINT (lisp_vector_cells_consed, vector_cells_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); XSETINT (lisp_symbols_consed, symbols_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); XSETINT (lisp_string_chars_consed, string_chars_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); XSETINT (lisp_misc_objects_consed, misc_objects_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); XSETINT (lisp_intervals_consed, intervals_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); return Fcons (lisp_cons_cells_consed, Fcons (lisp_floats_consed, Fcons (lisp_vector_cells_consed, Fcons (lisp_symbols_consed, Fcons (lisp_string_chars_consed, Fcons (lisp_misc_objects_consed, Fcons (lisp_intervals_consed, Qnil))))))); } /* Initialization */ init_alloc_once () { /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */ pureptr = 0; #ifdef HAVE_SHM pure_size = PURESIZE; #endif all_vectors = 0; ignore_warnings = 1; init_strings (); init_cons (); init_symbol (); init_marker (); #ifdef LISP_FLOAT_TYPE init_float (); #endif /* LISP_FLOAT_TYPE */ INIT_INTERVALS; #ifdef REL_ALLOC malloc_hysteresis = 32; #else malloc_hysteresis = 0; #endif spare_memory = (char *) malloc (SPARE_MEMORY); ignore_warnings = 0; gcprolist = 0; staticidx = 0; consing_since_gc = 0; gc_cons_threshold = 100000 * sizeof (Lisp_Object); #ifdef VIRT_ADDR_VARIES malloc_sbrk_unused = 1<<22; /* A large number */ malloc_sbrk_used = 100000; /* as reasonable as any number */ #endif /* VIRT_ADDR_VARIES */ } init_alloc () { gcprolist = 0; } void syms_of_alloc () { DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold, "*Number of bytes of consing between garbage collections.\n\ Garbage collection can happen automatically once this many bytes have been\n\ allocated since the last garbage collection. All data types count.\n\n\ Garbage collection happens automatically only when `eval' is called.\n\n\ By binding this temporarily to a large number, you can effectively\n\ prevent garbage collection during a part of the program."); DEFVAR_INT ("pure-bytes-used", &pureptr, "Number of bytes of sharable Lisp data allocated so far."); #if 0 DEFVAR_INT ("data-bytes-used", &malloc_sbrk_used, "Number of bytes of unshared memory allocated in this session."); DEFVAR_INT ("data-bytes-free", &malloc_sbrk_unused, "Number of bytes of unshared memory remaining available in this session."); #endif DEFVAR_LISP ("purify-flag", &Vpurify_flag, "Non-nil means loading Lisp code in order to dump an executable.\n\ This means that certain objects should be allocated in shared (pure) space."); DEFVAR_INT ("undo-limit", &undo_limit, "Keep no more undo information once it exceeds this size.\n\ This limit is applied when garbage collection happens.\n\ The size is counted as the number of bytes occupied,\n\ which includes both saved text and other data."); undo_limit = 20000; DEFVAR_INT ("undo-strong-limit", &undo_strong_limit, "Don't keep more than this much size of undo information.\n\ A command which pushes past this size is itself forgotten.\n\ This limit is applied when garbage collection happens.\n\ The size is counted as the number of bytes occupied,\n\ which includes both saved text and other data."); undo_strong_limit = 30000; /* We build this in advance because if we wait until we need it, we might not be able to allocate the memory to hold it. */ memory_signal_data = Fcons (Qerror, Fcons (build_string ("Memory exhausted--use M-x save-some-buffers RET"), Qnil)); staticpro (&memory_signal_data); staticpro (&Qgc_cons_threshold); Qgc_cons_threshold = intern ("gc-cons-threshold"); staticpro (&Qchar_table_extra_slots); Qchar_table_extra_slots = intern ("char-table-extra-slots"); defsubr (&Scons); defsubr (&Slist); defsubr (&Svector); defsubr (&Smake_byte_code); defsubr (&Smake_list); defsubr (&Smake_vector); defsubr (&Smake_char_table); defsubr (&Smake_string); defsubr (&Smake_bool_vector); defsubr (&Smake_symbol); defsubr (&Smake_marker); defsubr (&Spurecopy); defsubr (&Sgarbage_collect); defsubr (&Smemory_limit); defsubr (&Smemory_use_counts); } emacs-19.30/src/alloca.c100444 21570 1 33405 5641641234 13302 0ustar djmdaemon/* alloca.c -- allocate automatically reclaimed memory (Mostly) portable public-domain implementation -- D A Gwyn This implementation of the PWB library alloca function, which is used to allocate space off the run-time stack so that it is automatically reclaimed upon procedure exit, was inspired by discussions with J. Q. Johnson of Cornell. J.Otto Tennant contributed the Cray support. There are some preprocessor constants that can be defined when compiling for your specific system, for improved efficiency; however, the defaults should be okay. The general concept of this implementation is to keep track of all alloca-allocated blocks, and reclaim any that are found to be deeper in the stack than the current invocation. This heuristic does not reclaim storage as soon as it becomes invalid, but it will do so eventually. As a special case, alloca(0) reclaims storage without allocating any. It is a good idea to use alloca(0) in your main control loop, etc. to force garbage collection. */ #ifdef HAVE_CONFIG_H #include #endif #ifdef emacs #include "blockinput.h" #endif /* If compiling with GCC 2, this file's not needed. */ #if !defined (__GNUC__) || __GNUC__ < 2 /* If someone has defined alloca as a macro, there must be some other way alloca is supposed to work. */ #ifndef alloca #ifdef emacs #ifdef static /* actually, only want this if static is defined as "" -- this is for usg, in which emacs must undefine static in order to make unexec workable */ #ifndef STACK_DIRECTION you lose -- must know STACK_DIRECTION at compile-time #endif /* STACK_DIRECTION undefined */ #endif /* static */ #endif /* emacs */ /* If your stack is a linked list of frames, you have to provide an "address metric" ADDRESS_FUNCTION macro. */ #if defined (CRAY) && defined (CRAY_STACKSEG_END) long i00afunc (); #define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg)) #else #define ADDRESS_FUNCTION(arg) &(arg) #endif #if __STDC__ typedef void *pointer; #else typedef char *pointer; #endif #define NULL 0 /* Different portions of Emacs need to call different versions of malloc. The Emacs executable needs alloca to call xmalloc, because ordinary malloc isn't protected from input signals. On the other hand, the utilities in lib-src need alloca to call malloc; some of them are very simple, and don't have an xmalloc routine. Non-Emacs programs expect this to call use xmalloc. Callers below should use malloc. */ #ifndef emacs #define malloc xmalloc #endif extern pointer malloc (); /* Define STACK_DIRECTION if you know the direction of stack growth for your system; otherwise it will be automatically deduced at run-time. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ #ifndef STACK_DIRECTION #define STACK_DIRECTION 0 /* Direction unknown. */ #endif #if STACK_DIRECTION != 0 #define STACK_DIR STACK_DIRECTION /* Known at compile-time. */ #else /* STACK_DIRECTION == 0; need run-time code. */ static int stack_dir; /* 1 or -1 once known. */ #define STACK_DIR stack_dir static void find_stack_direction () { static char *addr = NULL; /* Address of first `dummy', once known. */ auto char dummy; /* To get stack address. */ if (addr == NULL) { /* Initial entry. */ addr = ADDRESS_FUNCTION (dummy); find_stack_direction (); /* Recurse once. */ } else { /* Second entry. */ if (ADDRESS_FUNCTION (dummy) > addr) stack_dir = 1; /* Stack grew upward. */ else stack_dir = -1; /* Stack grew downward. */ } } #endif /* STACK_DIRECTION == 0 */ /* An "alloca header" is used to: (a) chain together all alloca'ed blocks; (b) keep track of stack depth. It is very important that sizeof(header) agree with malloc alignment chunk size. The following default should work okay. */ #ifndef ALIGN_SIZE #define ALIGN_SIZE sizeof(double) #endif typedef union hdr { char align[ALIGN_SIZE]; /* To force sizeof(header). */ struct { union hdr *next; /* For chaining headers. */ char *deep; /* For stack depth measure. */ } h; } header; static header *last_alloca_header = NULL; /* -> last alloca header. */ /* Return a pointer to at least SIZE bytes of storage, which will be automatically reclaimed upon exit from the procedure that called alloca. Originally, this space was supposed to be taken from the current stack frame of the caller, but that method cannot be made to work for some implementations of C, for example under Gould's UTX/32. */ pointer alloca (size) unsigned size; { auto char probe; /* Probes stack depth: */ register char *depth = ADDRESS_FUNCTION (probe); #if STACK_DIRECTION == 0 if (STACK_DIR == 0) /* Unknown growth direction. */ find_stack_direction (); #endif /* Reclaim garbage, defined as all alloca'd storage that was allocated from deeper in the stack than currently. */ { register header *hp; /* Traverses linked list. */ #ifdef emacs BLOCK_INPUT; #endif for (hp = last_alloca_header; hp != NULL;) if ((STACK_DIR > 0 && hp->h.deep > depth) || (STACK_DIR < 0 && hp->h.deep < depth)) { register header *np = hp->h.next; free ((pointer) hp); /* Collect garbage. */ hp = np; /* -> next header. */ } else break; /* Rest are not deeper. */ last_alloca_header = hp; /* -> last valid storage. */ #ifdef emacs UNBLOCK_INPUT; #endif } if (size == 0) return NULL; /* No allocation required. */ /* Allocate combined header + user data storage. */ { register pointer new = malloc (sizeof (header) + size); /* Address of header. */ ((header *) new)->h.next = last_alloca_header; ((header *) new)->h.deep = depth; last_alloca_header = (header *) new; /* User storage begins just after header. */ return (pointer) ((char *) new + sizeof (header)); } } #if defined (CRAY) && defined (CRAY_STACKSEG_END) #ifdef DEBUG_I00AFUNC #include #endif #ifndef CRAY_STACK #define CRAY_STACK #ifndef CRAY2 /* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */ struct stack_control_header { long shgrow:32; /* Number of times stack has grown. */ long shaseg:32; /* Size of increments to stack. */ long shhwm:32; /* High water mark of stack. */ long shsize:32; /* Current size of stack (all segments). */ }; /* The stack segment linkage control information occurs at the high-address end of a stack segment. (The stack grows from low addresses to high addresses.) The initial part of the stack segment linkage control information is 0200 (octal) words. This provides for register storage for the routine which overflows the stack. */ struct stack_segment_linkage { long ss[0200]; /* 0200 overflow words. */ long sssize:32; /* Number of words in this segment. */ long ssbase:32; /* Offset to stack base. */ long:32; long sspseg:32; /* Offset to linkage control of previous segment of stack. */ long:32; long sstcpt:32; /* Pointer to task common address block. */ long sscsnm; /* Private control structure number for microtasking. */ long ssusr1; /* Reserved for user. */ long ssusr2; /* Reserved for user. */ long sstpid; /* Process ID for pid based multi-tasking. */ long ssgvup; /* Pointer to multitasking thread giveup. */ long sscray[7]; /* Reserved for Cray Research. */ long ssa0; long ssa1; long ssa2; long ssa3; long ssa4; long ssa5; long ssa6; long ssa7; long sss0; long sss1; long sss2; long sss3; long sss4; long sss5; long sss6; long sss7; }; #else /* CRAY2 */ /* The following structure defines the vector of words returned by the STKSTAT library routine. */ struct stk_stat { long now; /* Current total stack size. */ long maxc; /* Amount of contiguous space which would be required to satisfy the maximum stack demand to date. */ long high_water; /* Stack high-water mark. */ long overflows; /* Number of stack overflow ($STKOFEN) calls. */ long hits; /* Number of internal buffer hits. */ long extends; /* Number of block extensions. */ long stko_mallocs; /* Block allocations by $STKOFEN. */ long underflows; /* Number of stack underflow calls ($STKRETN). */ long stko_free; /* Number of deallocations by $STKRETN. */ long stkm_free; /* Number of deallocations by $STKMRET. */ long segments; /* Current number of stack segments. */ long maxs; /* Maximum number of stack segments so far. */ long pad_size; /* Stack pad size. */ long current_address; /* Current stack segment address. */ long current_size; /* Current stack segment size. This number is actually corrupted by STKSTAT to include the fifteen word trailer area. */ long initial_address; /* Address of initial segment. */ long initial_size; /* Size of initial segment. */ }; /* The following structure describes the data structure which trails any stack segment. I think that the description in 'asdef' is out of date. I only describe the parts that I am sure about. */ struct stk_trailer { long this_address; /* Address of this block. */ long this_size; /* Size of this block (does not include this trailer). */ long unknown2; long unknown3; long link; /* Address of trailer block of previous segment. */ long unknown5; long unknown6; long unknown7; long unknown8; long unknown9; long unknown10; long unknown11; long unknown12; long unknown13; long unknown14; }; #endif /* CRAY2 */ #endif /* not CRAY_STACK */ #ifdef CRAY2 /* Determine a "stack measure" for an arbitrary ADDRESS. I doubt that "lint" will like this much. */ static long i00afunc (long *address) { struct stk_stat status; struct stk_trailer *trailer; long *block, size; long result = 0; /* We want to iterate through all of the segments. The first step is to get the stack status structure. We could do this more quickly and more directly, perhaps, by referencing the $LM00 common block, but I know that this works. */ STKSTAT (&status); /* Set up the iteration. */ trailer = (struct stk_trailer *) (status.current_address + status.current_size - 15); /* There must be at least one stack segment. Therefore it is a fatal error if "trailer" is null. */ if (trailer == 0) abort (); /* Discard segments that do not contain our argument address. */ while (trailer != 0) { block = (long *) trailer->this_address; size = trailer->this_size; if (block == 0 || size == 0) abort (); trailer = (struct stk_trailer *) trailer->link; if ((block <= address) && (address < (block + size))) break; } /* Set the result to the offset in this segment and add the sizes of all predecessor segments. */ result = address - block; if (trailer == 0) { return result; } do { if (trailer->this_size <= 0) abort (); result += trailer->this_size; trailer = (struct stk_trailer *) trailer->link; } while (trailer != 0); /* We are done. Note that if you present a bogus address (one not in any segment), you will get a different number back, formed from subtracting the address of the first block. This is probably not what you want. */ return (result); } #else /* not CRAY2 */ /* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP. Determine the number of the cell within the stack, given the address of the cell. The purpose of this routine is to linearize, in some sense, stack addresses for alloca. */ static long i00afunc (long address) { long stkl = 0; long size, pseg, this_segment, stack; long result = 0; struct stack_segment_linkage *ssptr; /* Register B67 contains the address of the end of the current stack segment. If you (as a subprogram) store your registers on the stack and find that you are past the contents of B67, you have overflowed the segment. B67 also points to the stack segment linkage control area, which is what we are really interested in. */ stkl = CRAY_STACKSEG_END (); ssptr = (struct stack_segment_linkage *) stkl; /* If one subtracts 'size' from the end of the segment, one has the address of the first word of the segment. If this is not the first segment, 'pseg' will be nonzero. */ pseg = ssptr->sspseg; size = ssptr->sssize; this_segment = stkl - size; /* It is possible that calling this routine itself caused a stack overflow. Discard stack segments which do not contain the target address. */ while (!(this_segment <= address && address <= stkl)) { #ifdef DEBUG_I00AFUNC fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl); #endif if (pseg == 0) break; stkl = stkl - pseg; ssptr = (struct stack_segment_linkage *) stkl; size = ssptr->sssize; pseg = ssptr->sspseg; this_segment = stkl - size; } result = address - this_segment; /* If you subtract pseg from the current end of the stack, you get the address of the previous stack segment's end. This seems a little convoluted to me, but I'll bet you save a cycle somewhere. */ while (pseg != 0) { #ifdef DEBUG_I00AFUNC fprintf (stderr, "%011o %011o\n", pseg, size); #endif stkl = stkl - pseg; ssptr = (struct stack_segment_linkage *) stkl; size = ssptr->sssize; pseg = ssptr->sspseg; result += size; } return (result); } #endif /* not CRAY2 */ #endif /* CRAY */ #endif /* no alloca */ #endif /* not GCC version 2 */ emacs-19.30/src/buffer.c100444 12120 1 367274 6050570671 13375 0ustar rmsdaemon/* Buffer manipulation primitives for GNU Emacs. Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995 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. */ #include #include #include #ifndef MAXPATHLEN /* in 4.1, param.h fails to define this. */ #define MAXPATHLEN 1024 #endif /* not MAXPATHLEN */ #include #include "lisp.h" #include "intervals.h" #include "window.h" #include "commands.h" #include "buffer.h" #include "region-cache.h" #include "indent.h" #include "blockinput.h" struct buffer *current_buffer; /* the current buffer */ /* First buffer in chain of all buffers (in reverse order of creation). Threaded through ->next. */ struct buffer *all_buffers; /* This structure holds the default values of the buffer-local variables defined with DEFVAR_PER_BUFFER, that have special slots in each buffer. The default value occupies the same slot in this structure as an individual buffer's value occupies in that buffer. Setting the default value also goes through the alist of buffers and stores into each buffer that does not say it has a local value. */ struct buffer buffer_defaults; /* A Lisp_Object pointer to the above, used for staticpro */ static Lisp_Object Vbuffer_defaults; /* This structure marks which slots in a buffer have corresponding default values in buffer_defaults. Each such slot has a nonzero value in this structure. The value has only one nonzero bit. When a buffer has its own local value for a slot, the bit for that slot (found in the same slot in this structure) is turned on in the buffer's local_var_flags slot. If a slot in this structure is -1, then even though there may be a DEFVAR_PER_BUFFER for the slot, there is no default value for it; and the corresponding slot in buffer_defaults is not used. If a slot is -2, then there is no DEFVAR_PER_BUFFER for it, but there is a default value which is copied into each buffer. If a slot in this structure is negative, then even though there may be a DEFVAR_PER_BUFFER for the slot, there is no default value for it; and the corresponding slot in buffer_defaults is not used. If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is zero, that is a bug */ struct buffer buffer_local_flags; /* This structure holds the names of symbols whose values may be buffer-local. It is indexed and accessed in the same way as the above. */ struct buffer buffer_local_symbols; /* A Lisp_Object pointer to the above, used for staticpro */ static Lisp_Object Vbuffer_local_symbols; /* This structure holds the required types for the values in the buffer-local slots. If a slot contains Qnil, then the corresponding buffer slot may contain a value of any type. If a slot contains an integer, then prospective values' tags must be equal to that integer. When a tag does not match, the function buffer_slot_type_mismatch will signal an error. */ struct buffer buffer_local_types; Lisp_Object Fset_buffer (); void set_buffer_internal (); void set_buffer_internal_1 (); static void call_overlay_mod_hooks (); static void swap_out_buffer_local_variables (); /* Alist of all buffer names vs the buffers. */ /* This used to be a variable, but is no longer, to prevent lossage due to user rplac'ing this alist or its elements. */ Lisp_Object Vbuffer_alist; /* Functions to call before and after each text change. */ Lisp_Object Vbefore_change_function; Lisp_Object Vafter_change_function; Lisp_Object Vbefore_change_functions; Lisp_Object Vafter_change_functions; Lisp_Object Vtransient_mark_mode; /* t means ignore all read-only text properties. A list means ignore such a property if its value is a member of the list. Any non-nil value means ignore buffer-read-only. */ Lisp_Object Vinhibit_read_only; /* List of functions to call that can query about killing a buffer. If any of these functions returns nil, we don't kill it. */ Lisp_Object Vkill_buffer_query_functions; /* List of functions to call before changing an unmodified buffer. */ Lisp_Object Vfirst_change_hook; Lisp_Object Qfirst_change_hook; Lisp_Object Qbefore_change_functions; Lisp_Object Qafter_change_functions; Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local; Lisp_Object Qprotected_field; Lisp_Object QSFundamental; /* A string "Fundamental" */ Lisp_Object Qkill_buffer_hook; Lisp_Object Qget_file_buffer; Lisp_Object Qoverlayp; Lisp_Object Qpriority, Qwindow, Qevaporate, Qbefore_string, Qafter_string; Lisp_Object Qmodification_hooks; Lisp_Object Qinsert_in_front_hooks; Lisp_Object Qinsert_behind_hooks; /* For debugging; temporary. See set_buffer_internal. */ /* Lisp_Object Qlisp_mode, Vcheck_symbol; */ nsberror (spec) Lisp_Object spec; { if (STRINGP (spec)) error ("No buffer named %s", XSTRING (spec)->data); error ("Invalid buffer argument"); } DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 0, 0, "Return a list of all existing live buffers.") () { return Fmapcar (Qcdr, Vbuffer_alist); } /* Like Fassoc, but use Fstring_equal to compare (which ignores text properties), and don't ever QUIT. */ static Lisp_Object assoc_ignore_text_properties (key, list) register Lisp_Object key; Lisp_Object list; { register Lisp_Object tail; for (tail = list; !NILP (tail); tail = Fcdr (tail)) { register Lisp_Object elt, tem; elt = Fcar (tail); tem = Fstring_equal (Fcar (elt), key); if (!NILP (tem)) return elt; } return Qnil; } DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0, "Return the buffer named NAME (a string).\n\ If there is no live buffer named NAME, return nil.\n\ NAME may also be a buffer; if so, the value is that buffer.") (name) register Lisp_Object name; { if (BUFFERP (name)) return name; CHECK_STRING (name, 0); return Fcdr (assoc_ignore_text_properties (name, Vbuffer_alist)); } DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0, "Return the buffer visiting file FILENAME (a string).\n\ The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.\n\ If there is no such live buffer, return nil.\n\ See also `find-buffer-visiting'.") (filename) register Lisp_Object filename; { register Lisp_Object tail, buf, tem; Lisp_Object handler; CHECK_STRING (filename, 0); filename = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qget_file_buffer); if (!NILP (handler)) return call2 (handler, Qget_file_buffer, filename); for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr) { buf = Fcdr (XCONS (tail)->car); if (!BUFFERP (buf)) continue; if (!STRINGP (XBUFFER (buf)->filename)) continue; tem = Fstring_equal (XBUFFER (buf)->filename, filename); if (!NILP (tem)) return buf; } return Qnil; } Lisp_Object get_truename_buffer (filename) register Lisp_Object filename; { register Lisp_Object tail, buf, tem; for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr) { buf = Fcdr (XCONS (tail)->car); if (!BUFFERP (buf)) continue; if (!STRINGP (XBUFFER (buf)->file_truename)) continue; tem = Fstring_equal (XBUFFER (buf)->file_truename, filename); if (!NILP (tem)) return buf; } return Qnil; } /* Incremented for each buffer created, to assign the buffer number. */ int buffer_count; DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0, "Return the buffer named NAME, or create such a buffer and return it.\n\ A new buffer is created if there is no live buffer named NAME.\n\ If NAME starts with a space, the new buffer does not keep undo information.\n\ If NAME is a buffer instead of a string, then it is the value returned.\n\ The value is never nil.") (name) register Lisp_Object name; { register Lisp_Object buf; register struct buffer *b; buf = Fget_buffer (name); if (!NILP (buf)) return buf; if (XSTRING (name)->size == 0) error ("Empty string for buffer name is not allowed"); b = (struct buffer *) xmalloc (sizeof (struct buffer)); b->size = sizeof (struct buffer) / sizeof (EMACS_INT); /* An ordinary buffer uses its own struct buffer_text. */ b->text = &b->own_text; b->base_buffer = 0; BUF_GAP_SIZE (b) = 20; BLOCK_INPUT; BUFFER_ALLOC (BUF_BEG_ADDR (b), BUF_GAP_SIZE (b)); UNBLOCK_INPUT; if (! BUF_BEG_ADDR (b)) buffer_memory_full (); BUF_PT (b) = 1; BUF_GPT (b) = 1; BUF_BEGV (b) = 1; BUF_ZV (b) = 1; BUF_Z (b) = 1; BUF_MODIFF (b) = 1; BUF_SAVE_MODIFF (b) = 1; BUF_INTERVALS (b) = 0; b->newline_cache = 0; b->width_run_cache = 0; b->width_table = Qnil; /* Put this on the chain of all buffers including killed ones. */ b->next = all_buffers; all_buffers = b; /* An ordinary buffer normally doesn't need markers to handle BEGV and ZV. */ b->pt_marker = Qnil; b->begv_marker = Qnil; b->zv_marker = Qnil; name = Fcopy_sequence (name); INITIALIZE_INTERVAL (XSTRING (name), NULL_INTERVAL); b->name = name; if (XSTRING (name)->data[0] != ' ') b->undo_list = Qnil; else b->undo_list = Qt; reset_buffer (b); reset_buffer_local_variables (b); /* Put this in the alist of all live buffers. */ XSETBUFFER (buf, b); Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil)); b->mark = Fmake_marker (); BUF_MARKERS (b) = Qnil; b->name = name; return buf; } DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer, 2, 2, "bMake indirect buffer (to buffer): \nBName of indirect buffer: ", "Create and return an indirect buffer for buffer BASE, named NAME.\n\ BASE should be an existing buffer (or buffer name).\n\ NAME should be a string which is not the name of an existing buffer.") (base_buffer, name) register Lisp_Object base_buffer, name; { register Lisp_Object buf; register struct buffer *b; buf = Fget_buffer (name); if (!NILP (buf)) error ("Buffer name `%s' is in use", XSTRING (name)->data); base_buffer = Fget_buffer (base_buffer); if (NILP (base_buffer)) error ("No such buffer: `%s'", XSTRING (XBUFFER (base_buffer)->name)->data); if (XSTRING (name)->size == 0) error ("Empty string for buffer name is not allowed"); b = (struct buffer *) xmalloc (sizeof (struct buffer)); b->size = sizeof (struct buffer) / sizeof (EMACS_INT); if (XBUFFER (base_buffer)->base_buffer) b->base_buffer = XBUFFER (base_buffer)->base_buffer; else b->base_buffer = XBUFFER (base_buffer); /* Use the base buffer's text object. */ b->text = b->base_buffer->text; BUF_BEGV (b) = BUF_BEGV (b->base_buffer); BUF_ZV (b) = BUF_ZV (b->base_buffer); BUF_PT (b) = BUF_PT (b->base_buffer); b->newline_cache = 0; b->width_run_cache = 0; b->width_table = Qnil; /* Put this on the chain of all buffers including killed ones. */ b->next = all_buffers; all_buffers = b; name = Fcopy_sequence (name); INITIALIZE_INTERVAL (XSTRING (name), NULL_INTERVAL); b->name = name; reset_buffer (b); reset_buffer_local_variables (b); /* Put this in the alist of all live buffers. */ XSETBUFFER (buf, b); Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil)); b->mark = Fmake_marker (); b->name = name; /* Make sure the base buffer has markers for its narrowing. */ if (NILP (b->base_buffer->pt_marker)) { b->base_buffer->pt_marker = Fmake_marker (); Fset_marker (b->base_buffer->pt_marker, make_number (BUF_PT (b->base_buffer)), base_buffer); } if (NILP (b->base_buffer->begv_marker)) { b->base_buffer->begv_marker = Fmake_marker (); Fset_marker (b->base_buffer->begv_marker, make_number (BUF_BEGV (b->base_buffer)), base_buffer); } if (NILP (b->base_buffer->zv_marker)) { b->base_buffer->zv_marker = Fmake_marker (); Fset_marker (b->base_buffer->zv_marker, make_number (BUF_ZV (b->base_buffer)), base_buffer); XMARKER (b->base_buffer->zv_marker)->insertion_type = 1; } /* Give the indirect buffer markers for its narrowing. */ b->pt_marker = Fmake_marker (); Fset_marker (b->pt_marker, make_number (BUF_PT (b)), buf); b->begv_marker = Fmake_marker (); Fset_marker (b->begv_marker, make_number (BUF_BEGV (b)), buf); b->zv_marker = Fmake_marker (); Fset_marker (b->zv_marker, make_number (BUF_ZV (b)), buf); XMARKER (b->zv_marker)->insertion_type = 1; return buf; } /* Reinitialize everything about a buffer except its name and contents and local variables. */ void reset_buffer (b) register struct buffer *b; { b->filename = Qnil; b->file_truename = Qnil; b->directory = (current_buffer) ? current_buffer->directory : Qnil; b->modtime = 0; XSETFASTINT (b->save_length, 0); b->last_window_start = 1; b->backed_up = Qnil; b->auto_save_modified = 0; b->auto_save_failure_time = -1; b->auto_save_file_name = Qnil; b->read_only = Qnil; b->overlays_before = Qnil; b->overlays_after = Qnil; XSETFASTINT (b->overlay_center, 1); b->mark_active = Qnil; b->point_before_scroll = Qnil; b->file_format = Qnil; b->redisplay_end_trigger = Qnil; b->extra1 = Qnil; b->extra2 = Qnil; b->extra3 = Qnil; } /* Reset buffer B's local variables info. Don't use this on a buffer that has already been in use; it does not treat permanent locals consistently. Instead, use Fkill_all_local_variables. */ reset_buffer_local_variables (b) register struct buffer *b; { register int offset; /* Reset the major mode to Fundamental, together with all the things that depend on the major mode. default-major-mode is handled at a higher level. We ignore it here. */ b->major_mode = Qfundamental_mode; b->keymap = Qnil; b->abbrev_table = Vfundamental_mode_abbrev_table; b->mode_name = QSFundamental; b->minor_modes = Qnil; /* If the standard case table has been altered and invalidated, fix up its insides first. */ if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0]) && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1]) && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2]))) Fset_standard_case_table (Vascii_downcase_table); b->downcase_table = Vascii_downcase_table; b->upcase_table = XCHAR_TABLE (Vascii_downcase_table)->extras[0]; b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; b->buffer_file_type = Qnil; b->invisibility_spec = Qt; #if 0 b->sort_table = XSTRING (Vascii_sort_table); b->folding_sort_table = XSTRING (Vascii_folding_sort_table); #endif /* 0 */ /* Reset all per-buffer variables to their defaults. */ b->local_var_alist = Qnil; b->local_var_flags = 0; /* For each slot that has a default value, copy that into the slot. */ for (offset = (char *)&buffer_local_flags.name - (char *)&buffer_local_flags; offset < sizeof (struct buffer); offset += sizeof (Lisp_Object)) /* sizeof EMACS_INT == sizeof Lisp_Object */ { int flag = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags)); if (flag > 0 || flag == -2) *(Lisp_Object *)(offset + (char *)b) = *(Lisp_Object *)(offset + (char *)&buffer_defaults); } } /* We split this away from generate-new-buffer, because rename-buffer and set-visited-file-name ought to be able to use this to really rename the buffer properly. */ DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name, 1, 2, 0, "Return a string that is the name of no existing buffer based on NAME.\n\ If there is no live buffer named NAME, then return NAME.\n\ Otherwise modify name by appending `', incrementing NUMBER\n\ until an unused name is found, and then return that name.\n\ Optional second argument IGNORE specifies a name that is okay to use\n\ \(if it is in the sequence to be tried)\n\ even if a buffer with that name exists.") (name, ignore) register Lisp_Object name, ignore; { register Lisp_Object gentemp, tem; int count; char number[10]; CHECK_STRING (name, 0); tem = Fget_buffer (name); if (NILP (tem)) return name; count = 1; while (1) { sprintf (number, "<%d>", ++count); gentemp = concat2 (name, build_string (number)); tem = Fstring_equal (gentemp, ignore); if (!NILP (tem)) return gentemp; tem = Fget_buffer (gentemp); if (NILP (tem)) return gentemp; } } DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0, "Return the name of BUFFER, as a string.\n\ With no argument or nil as argument, return the name of the current buffer.") (buffer) register Lisp_Object buffer; { if (NILP (buffer)) return current_buffer->name; CHECK_BUFFER (buffer, 0); return XBUFFER (buffer)->name; } DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0, "Return name of file BUFFER is visiting, or nil if none.\n\ No argument or nil as argument means use the current buffer.") (buffer) register Lisp_Object buffer; { if (NILP (buffer)) return current_buffer->filename; CHECK_BUFFER (buffer, 0); return XBUFFER (buffer)->filename; } DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer, 0, 1, 0, "Return the base buffer of indirect buffer BUFFER.\n\ If BUFFER is not indirect, return nil.") (buffer) register Lisp_Object buffer; { struct buffer *base; Lisp_Object base_buffer; if (NILP (buffer)) base = current_buffer->base_buffer; else { CHECK_BUFFER (buffer, 0); base = XBUFFER (buffer)->base_buffer; } if (! base) return Qnil; XSETBUFFER (base_buffer, base); return base_buffer; } DEFUN ("buffer-local-variables", Fbuffer_local_variables, 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.") (buffer) register Lisp_Object buffer; { register struct buffer *buf; register Lisp_Object result; if (NILP (buffer)) buf = current_buffer; else { CHECK_BUFFER (buffer, 0); buf = XBUFFER (buffer); } result = Qnil; { register Lisp_Object tail; for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object val, elt; elt = XCONS (tail)->car; /* Reference each variable in the alist in buf. If inquiring about the current buffer, this gets the current values, so store them into the alist so the alist is up to date. If inquiring about some other buffer, this swaps out any values for that buffer, making the alist up to date automatically. */ val = find_symbol_value (XCONS (elt)->car); /* Use the current buffer value only if buf is the current buffer. */ if (buf != current_buffer) 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. */ { register int offset, mask; for (offset = (char *)&buffer_local_symbols.name - (char *)&buffer_local_symbols; offset < sizeof (struct buffer); offset += (sizeof (EMACS_INT))) /* sizeof EMACS_INT == sizeof Lisp_Object */ { mask = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags)); if (mask == -1 || (buf->local_var_flags & mask)) if (SYMBOLP (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols))) result = Fcons (Fcons (*((Lisp_Object *) (offset + (char *)&buffer_local_symbols)), *(Lisp_Object *)(offset + (char *)buf)), result); } } return result; } DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p, 0, 1, 0, "Return t if BUFFER was modified since its file was last read or saved.\n\ No argument or nil as argument means use current buffer as BUFFER.") (buffer) register Lisp_Object buffer; { register struct buffer *buf; if (NILP (buffer)) buf = current_buffer; else { CHECK_BUFFER (buffer, 0); buf = XBUFFER (buffer); } return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil; } DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p, 1, 1, 0, "Mark current buffer as modified or unmodified according to FLAG.\n\ A non-nil FLAG means mark the buffer modified.") (flag) register Lisp_Object flag; { register int already; register Lisp_Object fn; #ifdef CLASH_DETECTION /* If buffer becoming modified, lock the file. If buffer becoming unmodified, unlock the file. */ fn = current_buffer->file_truename; if (!NILP (fn)) { already = SAVE_MODIFF < MODIFF; if (!already && !NILP (flag)) lock_file (fn); else if (already && NILP (flag)) unlock_file (fn); } #endif /* CLASH_DETECTION */ SAVE_MODIFF = NILP (flag) ? MODIFF : 0; update_mode_lines++; return flag; } DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick, 0, 1, 0, "Return BUFFER's tick counter, incremented for each change in text.\n\ Each buffer has a tick counter which is incremented each time the text in\n\ that buffer is changed. It wraps around occasionally.\n\ No argument or nil as argument means use current buffer as BUFFER.") (buffer) register Lisp_Object buffer; { register struct buffer *buf; if (NILP (buffer)) buf = current_buffer; else { CHECK_BUFFER (buffer, 0); buf = XBUFFER (buffer); } return make_number (BUF_MODIFF (buf)); } DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2, "sRename buffer (to new name): \nP", "Change current buffer's name to NEWNAME (a string).\n\ If second arg UNIQUE is nil or omitted, it is an error if a\n\ buffer named NEWNAME already exists.\n\ If UNIQUE is non-nil, come up with a new name using\n\ `generate-new-buffer-name'.\n\ Interactively, you can set UNIQUE with a prefix argument.\n\ We return the name we actually gave the buffer.\n\ This does not change the name of the visited file (if any).") (newname, unique) register Lisp_Object newname, unique; { register Lisp_Object tem, buf; CHECK_STRING (newname, 0); if (XSTRING (newname)->size == 0) error ("Empty string is invalid as a buffer name"); tem = Fget_buffer (newname); /* Don't short-circuit if UNIQUE is t. That is a useful way to rename the buffer automatically so you can create another with the original name. It makes UNIQUE equivalent to (rename-buffer (generate-new-buffer-name NEWNAME)). */ if (NILP (unique) && XBUFFER (tem) == current_buffer) return current_buffer->name; if (!NILP (tem)) { if (!NILP (unique)) newname = Fgenerate_new_buffer_name (newname, current_buffer->name); else error ("Buffer name `%s' is in use", XSTRING (newname)->data); } current_buffer->name = newname; /* Catch redisplay's attention. Unless we do this, the mode lines for any windows displaying current_buffer will stay unchanged. */ update_mode_lines++; XSETBUFFER (buf, current_buffer); Fsetcar (Frassq (buf, Vbuffer_alist), newname); if (NILP (current_buffer->filename) && !NILP (current_buffer->auto_save_file_name)) call0 (intern ("rename-auto-save-file")); /* Refetch since that last call may have done GC. */ return current_buffer->name; } DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 2, 0, "Return most recently selected buffer other than BUFFER.\n\ Buffers not visible in windows are preferred to visible buffers,\n\ unless optional second argument VISIBLE-OK is non-nil.\n\ If no other buffer exists, the buffer `*scratch*' is returned.\n\ If BUFFER is omitted or nil, some interesting buffer is returned.") (buffer, visible_ok) register Lisp_Object buffer, visible_ok; { register Lisp_Object tail, buf, notsogood, tem; notsogood = Qnil; for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail)) { buf = Fcdr (Fcar (tail)); if (EQ (buf, buffer)) continue; if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ') continue; #ifdef MULTI_FRAME /* If the selected frame has a buffer_predicate, disregard buffers that don't fit the predicate. */ tem = frame_buffer_predicate (); if (!NILP (tem)) { tem = call1 (tem, buf); if (NILP (tem)) continue; } #endif if (NILP (visible_ok)) tem = Fget_buffer_window (buf, Qt); else tem = Qnil; if (NILP (tem)) return buf; if (NILP (notsogood)) notsogood = buf; } if (!NILP (notsogood)) return notsogood; return Fget_buffer_create (build_string ("*scratch*")); } DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 0, 1, "", "Make BUFFER stop keeping undo information.\n\ No argument or nil as argument means do this for the current buffer.") (buffer) register Lisp_Object buffer; { Lisp_Object real_buffer; if (NILP (buffer)) XSETBUFFER (real_buffer, current_buffer); else { real_buffer = Fget_buffer (buffer); if (NILP (real_buffer)) nsberror (buffer); } XBUFFER (real_buffer)->undo_list = Qt; return Qnil; } DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo, 0, 1, "", "Start keeping undo information for buffer BUFFER.\n\ No argument or nil as argument means do this for the current buffer.") (buffer) register Lisp_Object buffer; { Lisp_Object real_buffer; if (NILP (buffer)) XSETBUFFER (real_buffer, current_buffer); else { real_buffer = Fget_buffer (buffer); if (NILP (real_buffer)) nsberror (buffer); } if (EQ (XBUFFER (real_buffer)->undo_list, Qt)) XBUFFER (real_buffer)->undo_list = Qnil; return Qnil; } /* DEFVAR_LISP ("kill-buffer-hook", no_cell, "\ Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\ The buffer being killed will be current while the hook is running.\n\ See `kill-buffer'." */ DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ", "Kill the buffer BUFFER.\n\ The argument may be a buffer or may be the name of a buffer.\n\ An argument of nil means kill the current buffer.\n\n\ Value is t if the buffer is actually killed, nil if user says no.\n\n\ The value of `kill-buffer-hook' (which may be local to that buffer),\n\ if not void, is a list of functions to be called, with no arguments,\n\ before the buffer is actually killed. The buffer to be killed is current\n\ when the hook functions are called.\n\n\ Any processes that have this buffer as the `process-buffer' are killed\n\ with `delete-process'.") (bufname) Lisp_Object bufname; { Lisp_Object buf; register struct buffer *b; register Lisp_Object tem; register struct Lisp_Marker *m; struct gcpro gcpro1, gcpro2; if (NILP (bufname)) buf = Fcurrent_buffer (); else buf = Fget_buffer (bufname); if (NILP (buf)) nsberror (bufname); b = XBUFFER (buf); /* Avoid trouble for buffer already dead. */ if (NILP (b->name)) return Qnil; /* Query if the buffer is still modified. */ if (INTERACTIVE && !NILP (b->filename) && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) { GCPRO2 (buf, bufname); tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ", XSTRING (b->name)->data)); UNGCPRO; if (NILP (tem)) return Qnil; } /* Run hooks with the buffer to be killed the current buffer. */ { register Lisp_Object val; int count = specpdl_ptr - specpdl; Lisp_Object list; record_unwind_protect (save_excursion_restore, save_excursion_save ()); set_buffer_internal (b); /* First run the query functions; if any query is answered no, don't kill the buffer. */ for (list = Vkill_buffer_query_functions; !NILP (list); list = Fcdr (list)) { tem = call0 (Fcar (list)); if (NILP (tem)) return unbind_to (count, Qnil); } /* Then run the hooks. */ if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, Qkill_buffer_hook); unbind_to (count, Qnil); } /* We have no more questions to ask. Verify that it is valid to kill the buffer. This must be done after the questions since anything can happen within do_yes_or_no_p. */ /* Don't kill the minibuffer now current. */ if (EQ (buf, XWINDOW (minibuf_window)->buffer)) return Qnil; if (NILP (b->name)) return Qnil; /* When we kill a base buffer, kill all its indirect buffers. We do it at this stage so nothing terrible happens if they ask questions or their hooks get errors. */ if (! b->base_buffer) { struct buffer *other; GCPRO1 (buf); for (other = all_buffers; other; other = other->next) /* all_buffers contains dead buffers too; don't re-kill them. */ if (other->base_buffer == b && !NILP (other->name)) { Lisp_Object buf; XSETBUFFER (buf, other); Fkill_buffer (buf); } UNGCPRO; } /* Make this buffer not be current. In the process, notice if this is the sole visible buffer and give up if so. */ if (b == current_buffer) { tem = Fother_buffer (buf, Qnil); Fset_buffer (tem); if (b == current_buffer) return Qnil; } /* Now there is no question: we can kill the buffer. */ #ifdef CLASH_DETECTION /* Unlock this buffer's file, if it is locked. */ unlock_buffer (b); #endif /* CLASH_DETECTION */ kill_buffer_processes (buf); tem = Vinhibit_quit; Vinhibit_quit = Qt; Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist); Freplace_buffer_in_windows (buf); Vinhibit_quit = tem; /* Delete any auto-save file, if we saved it in this session. */ if (STRINGP (b->auto_save_file_name) && b->auto_save_modified != 0 && SAVE_MODIFF < b->auto_save_modified) { Lisp_Object tem; tem = Fsymbol_value (intern ("delete-auto-save-files")); if (! NILP (tem)) internal_delete_file (b->auto_save_file_name); } if (b->base_buffer) { /* Unchain all markers that belong to this indirect buffer. Don't unchain the markers that belong to the base buffer or its other indirect buffers. */ for (tem = BUF_MARKERS (b); !NILP (tem); ) { Lisp_Object next; m = XMARKER (tem); next = m->chain; if (m->buffer == b) unchain_marker (tem); tem = next; } } else { /* Unchain all markers of this buffer and its indirect buffers. and leave them pointing nowhere. */ for (tem = BUF_MARKERS (b); !NILP (tem); ) { m = XMARKER (tem); m->buffer = 0; tem = m->chain; m->chain = Qnil; } BUF_MARKERS (b) = Qnil; #ifdef USE_TEXT_PROPERTIES BUF_INTERVALS (b) = NULL_INTERVAL; #endif /* Perhaps we should explicitly free the interval tree here... */ } /* Reset the local variables, so that this buffer's local values won't be protected from GC. They would be protected if they happened to remain encached in their symbols. This gets rid of them for certain. */ swap_out_buffer_local_variables (b); reset_buffer_local_variables (b); b->name = Qnil; BLOCK_INPUT; if (! b->base_buffer) BUFFER_FREE (BUF_BEG_ADDR (b)); if (b->newline_cache) { free_region_cache (b->newline_cache); b->newline_cache = 0; } if (b->width_run_cache) { free_region_cache (b->width_run_cache); b->width_run_cache = 0; } b->width_table = Qnil; UNBLOCK_INPUT; b->undo_list = Qnil; return Qt; } /* Move the assoc for buffer BUF to the front of buffer-alist. Since we do this each time BUF is selected visibly, the more recently selected buffers are always closer to the front of the list. This means that other_buffer is more likely to choose a relevant buffer. */ record_buffer (buf) Lisp_Object buf; { register Lisp_Object link, prev; prev = Qnil; for (link = Vbuffer_alist; CONSP (link); link = XCONS (link)->cdr) { if (EQ (XCONS (XCONS (link)->car)->cdr, buf)) break; prev = link; } /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist); we cannot use Fdelq itself here because it allows quitting. */ if (NILP (prev)) Vbuffer_alist = XCONS (Vbuffer_alist)->cdr; else XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr; XCONS(link)->cdr = Vbuffer_alist; Vbuffer_alist = link; } DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0, "Set an appropriate major mode for BUFFER, according to `default-major-mode'.\n\ Use this function before selecting the buffer, since it may need to inspect\n\ the current buffer's major mode.") (buf) Lisp_Object buf; { int count; Lisp_Object function; function = buffer_defaults.major_mode; if (NILP (function) && NILP (Fget (current_buffer->major_mode, Qmode_class))) function = current_buffer->major_mode; if (NILP (function) || EQ (function, Qfundamental_mode)) return Qnil; count = specpdl_ptr - specpdl; /* To select a nonfundamental mode, select the buffer temporarily and then call the mode function. */ record_unwind_protect (save_excursion_restore, save_excursion_save ()); Fset_buffer (buf); call0 (function); return unbind_to (count, Qnil); } DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ", "Select buffer BUFFER in the current window.\n\ BUFFER may be a buffer or a buffer name.\n\ Optional second arg NORECORD non-nil means\n\ do not put this buffer at the front of the list of recently selected ones.\n\ \n\ WARNING: This is NOT the way to work on another buffer temporarily\n\ within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\ the window-buffer correspondences.") (bufname, norecord) Lisp_Object bufname, norecord; { register Lisp_Object buf; Lisp_Object tem; if (EQ (minibuf_window, selected_window)) error ("Cannot switch buffers in minibuffer window"); tem = Fwindow_dedicated_p (selected_window); if (!NILP (tem)) error ("Cannot switch buffers in a dedicated window"); if (NILP (bufname)) buf = Fother_buffer (Fcurrent_buffer (), Qnil); else { buf = Fget_buffer (bufname); if (NILP (buf)) { buf = Fget_buffer_create (bufname); Fset_buffer_major_mode (buf); } } Fset_buffer (buf); if (NILP (norecord)) record_buffer (buf); Fset_window_buffer (EQ (selected_window, minibuf_window) ? Fnext_window (minibuf_window, Qnil, Qnil) : selected_window, buf); return buf; } DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 2, 0, "Select buffer BUFFER in some window, preferably a different one.\n\ If BUFFER is nil, then some other buffer is chosen.\n\ If `pop-up-windows' is non-nil, windows can be split to do this.\n\ If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\ window even if BUFFER is already visible in the selected window.") (bufname, other) Lisp_Object bufname, other; { register Lisp_Object buf; if (NILP (bufname)) buf = Fother_buffer (Fcurrent_buffer (), Qnil); else { buf = Fget_buffer (bufname); if (NILP (buf)) { buf = Fget_buffer_create (bufname); Fset_buffer_major_mode (buf); } } Fset_buffer (buf); record_buffer (buf); Fselect_window (Fdisplay_buffer (buf, other)); return buf; } DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0, "Return the current buffer as a Lisp object.") () { register Lisp_Object buf; XSETBUFFER (buf, current_buffer); return buf; } /* Set the current buffer to B. */ void set_buffer_internal (b) register struct buffer *b; { register struct buffer *old_buf; register Lisp_Object tail, valcontents; Lisp_Object tem; if (current_buffer == b) return; windows_or_buffers_changed = 1; set_buffer_internal_1 (b); } /* Set the current buffer to B, and do not set windows_or_buffers_changed. This is used by redisplay. */ void set_buffer_internal_1 (b) register struct buffer *b; { register struct buffer *old_buf; register Lisp_Object tail, valcontents; Lisp_Object tem; if (current_buffer == b) return; old_buf = current_buffer; current_buffer = b; last_known_column_point = -1; /* invalidate indentation cache */ if (old_buf) { /* Put the undo list back in the base buffer, so that it appears that an indirect buffer shares the undo list of its base. */ if (old_buf->base_buffer) old_buf->base_buffer->undo_list = old_buf->undo_list; /* If the old current buffer has markers to record PT, BEGV and ZV when it is not current, update them now. */ if (! NILP (old_buf->pt_marker)) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); Fset_marker (old_buf->pt_marker, BUF_PT (old_buf), obuf); } if (! NILP (old_buf->begv_marker)) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); Fset_marker (old_buf->begv_marker, BUF_BEGV (old_buf), obuf); } if (! NILP (old_buf->zv_marker)) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); Fset_marker (old_buf->zv_marker, BUF_ZV (old_buf), obuf); } } /* Get the undo list from the base buffer, so that it appears that an indirect buffer shares the undo list of its base. */ if (b->base_buffer) b->undo_list = b->base_buffer->undo_list; /* If the new current buffer has markers to record PT, BEGV and ZV when it is not current, fetch them now. */ if (! NILP (b->pt_marker)) BUF_PT (b) = marker_position (b->pt_marker); if (! NILP (b->begv_marker)) BUF_BEGV (b) = marker_position (b->begv_marker); if (! NILP (b->zv_marker)) BUF_ZV (b) = marker_position (b->zv_marker); /* Look down buffer's list of local Lisp variables to find and update any that forward into C variables. */ for (tail = b->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr) { valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value; if ((BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) && (tem = XBUFFER_LOCAL_VALUE (valcontents)->car, (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem)))) /* Just reference the variable to cause it to become set for this buffer. */ Fsymbol_value (XCONS (XCONS (tail)->car)->car); } /* Do the same with any others that were local to the previous buffer */ if (old_buf) for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr) { valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value; if ((BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) && (tem = XBUFFER_LOCAL_VALUE (valcontents)->car, (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem)))) /* Just reference the variable to cause it to become set for this buffer. */ Fsymbol_value (XCONS (XCONS (tail)->car)->car); } } /* Switch to buffer B temporarily for redisplay purposes. This avoids certain things that don't need to be done within redisplay. */ void set_buffer_temp (b) struct buffer *b; { register struct buffer *old_buf; if (current_buffer == b) return; old_buf = current_buffer; current_buffer = b; if (old_buf) { /* If the old current buffer has markers to record PT, BEGV and ZV when it is not current, update them now. */ if (! NILP (old_buf->pt_marker)) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); Fset_marker (old_buf->pt_marker, BUF_PT (old_buf), obuf); } if (! NILP (old_buf->begv_marker)) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); Fset_marker (old_buf->begv_marker, BUF_BEGV (old_buf), obuf); } if (! NILP (old_buf->zv_marker)) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); Fset_marker (old_buf->zv_marker, BUF_ZV (old_buf), obuf); } } /* If the new current buffer has markers to record PT, BEGV and ZV when it is not current, fetch them now. */ if (! NILP (b->pt_marker)) BUF_PT (b) = marker_position (b->pt_marker); if (! NILP (b->begv_marker)) BUF_BEGV (b) = marker_position (b->begv_marker); if (! NILP (b->zv_marker)) BUF_ZV (b) = marker_position (b->zv_marker); } DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0, "Make the buffer BUFFER current for editing operations.\n\ BUFFER may be a buffer or the name of an existing buffer.\n\ See also `save-excursion' when you want to make a buffer current temporarily.\n\ This function does not display the buffer, so its effect ends\n\ when the current command terminates.\n\ Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.") (bufname) register Lisp_Object bufname; { register Lisp_Object buffer; buffer = Fget_buffer (bufname); if (NILP (buffer)) nsberror (bufname); if (NILP (XBUFFER (buffer)->name)) error ("Selecting deleted buffer"); set_buffer_internal (XBUFFER (buffer)); return buffer; } DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, Sbarf_if_buffer_read_only, 0, 0, 0, "Signal a `buffer-read-only' error if the current buffer is read-only.") () { if (!NILP (current_buffer->read_only) && NILP (Vinhibit_read_only)) Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil))); return Qnil; } DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "", "Put BUFFER at the end of the list of all buffers.\n\ There it is the least likely candidate for `other-buffer' to return;\n\ thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\ If BUFFER is nil or omitted, bury the current buffer.\n\ Also, if BUFFER is nil or omitted, remove the current buffer from the\n\ selected window if it is displayed there.") (buf) register Lisp_Object buf; { /* Figure out what buffer we're going to bury. */ if (NILP (buf)) { XSETBUFFER (buf, current_buffer); /* If we're burying the current buffer, unshow it. */ Fswitch_to_buffer (Fother_buffer (buf, Qnil), Qnil); } else { Lisp_Object buf1; buf1 = Fget_buffer (buf); if (NILP (buf1)) nsberror (buf); buf = buf1; } /* Move buf to the end of the buffer list. */ { register Lisp_Object aelt, link; aelt = Frassq (buf, Vbuffer_alist); link = Fmemq (aelt, Vbuffer_alist); Vbuffer_alist = Fdelq (aelt, Vbuffer_alist); XCONS (link)->cdr = Qnil; Vbuffer_alist = nconc2 (Vbuffer_alist, link); } return Qnil; } DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*", "Delete the entire contents of the current buffer.\n\ Any narrowing restriction in effect (see `narrow-to-region') is removed,\n\ so the buffer is truly empty after this.") () { Fwiden (); del_range (BEG, Z); current_buffer->last_window_start = 1; /* Prevent warnings, or suspension of auto saving, that would happen if future size is less than past size. Use of erase-buffer implies that the future text is not really related to the past text. */ XSETFASTINT (current_buffer->save_length, 0); return Qnil; } validate_region (b, e) register Lisp_Object *b, *e; { CHECK_NUMBER_COERCE_MARKER (*b, 0); CHECK_NUMBER_COERCE_MARKER (*e, 1); if (XINT (*b) > XINT (*e)) { Lisp_Object tem; tem = *b; *b = *e; *e = tem; } if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e) && XINT (*e) <= ZV)) args_out_of_range (*b, *e); } DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables, 0, 0, 0, "Switch to Fundamental mode by killing current buffer's local variables.\n\ Most local variable bindings are eliminated so that the default values\n\ become effective once more. Also, the syntax table is set from\n\ `standard-syntax-table', the local keymap is set to nil,\n\ and the abbrev table from `fundamental-mode-abbrev-table'.\n\ This function also forces redisplay of the mode line.\n\ \n\ Every function to select a new major mode starts by\n\ calling this function.\n\n\ As a special exception, local variables whose names have\n\ a non-nil `permanent-local' property are not eliminated by this function.\n\ \n\ The first thing this function does is run\n\ the normal hook `change-major-mode-hook'.") () { register Lisp_Object alist, sym, tem; Lisp_Object oalist; if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, intern ("change-major-mode-hook")); oalist = current_buffer->local_var_alist; /* Make sure none of the bindings in oalist remain swapped in, in their symbols. */ swap_out_buffer_local_variables (current_buffer); /* Actually eliminate all local bindings of this buffer. */ reset_buffer_local_variables (current_buffer); /* Redisplay mode lines; we are changing major mode. */ update_mode_lines++; /* Any which are supposed to be permanent, make local again, with the same values they had. */ for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr) { sym = XCONS (XCONS (alist)->car)->car; tem = Fget (sym, Qpermanent_local); if (! NILP (tem)) { Fmake_local_variable (sym); Fset (sym, XCONS (XCONS (alist)->car)->cdr); } } /* Force mode-line redisplay. Useful here because all major mode commands call this function. */ update_mode_lines++; return Qnil; } /* Make sure no local variables remain set up with buffer B for their current values. */ static void swap_out_buffer_local_variables (b) struct buffer *b; { Lisp_Object oalist, alist, sym, tem, buffer; XSETBUFFER (buffer, b); oalist = b->local_var_alist; for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr) { sym = XCONS (XCONS (alist)->car)->car; /* Need not do anything if some other buffer's binding is now encached. */ tem = XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->car; if (XBUFFER (tem) == current_buffer) { /* Symbol is set up for this buffer's old local value. Set it up for the current buffer with the default value. */ tem = XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->cdr; /* Store the symbol's current value into the alist entry it is currently set up for. This is so that, if the local is marked permanent, and we make it local again later in Fkill_all_local_variables, we don't lose the value. */ XCONS (XCONS (tem)->car)->cdr = do_symval_forwarding (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->car); /* Switch to the symbol's default-value alist entry. */ XCONS (tem)->car = tem; /* Mark it as current for buffer B. */ XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->car = buffer; /* Store the current value into any forwarding in the symbol. */ store_symval_forwarding (sym, XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->car, XCONS (tem)->cdr); } } } /* Find all the overlays in the current buffer that contain position POS. Return the number found, and store them in a vector in *VEC_PTR. Store in *LEN_PTR the size allocated for the vector. Store in *NEXT_PTR the next position after POS where an overlay starts, or ZV if there are no more overlays. Store in *PREV_PTR the previous position before POS where an overlay ends, or BEGV if there are no previous overlays. NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info. *VEC_PTR and *LEN_PTR should contain a valid vector and size when this function is called. If EXTEND is non-zero, we make the vector bigger if necessary. If EXTEND is zero, we never extend the vector, and we store only as many overlays as will fit. But we still return the total number of overlays. */ int overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr) int pos; int extend; Lisp_Object **vec_ptr; int *len_ptr; int *next_ptr; int *prev_ptr; { Lisp_Object tail, overlay, start, end, result; int idx = 0; int len = *len_ptr; Lisp_Object *vec = *vec_ptr; int next = ZV; int prev = BEGV; int inhibit_storing = 0; for (tail = current_buffer->overlays_before; GC_CONSP (tail); tail = XCONS (tail)->cdr) { int startpos, endpos; overlay = XCONS (tail)->car; start = OVERLAY_START (overlay); end = OVERLAY_END (overlay); endpos = OVERLAY_POSITION (end); if (endpos < pos) { if (prev < endpos) prev = endpos; break; } if (endpos == pos) continue; startpos = OVERLAY_POSITION (start); if (startpos <= pos) { if (idx == len) { /* The supplied vector is full. Either make it bigger, or don't store any more in it. */ if (extend) { *len_ptr = len *= 2; vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object)); *vec_ptr = vec; } else inhibit_storing = 1; } if (!inhibit_storing) vec[idx] = overlay; /* Keep counting overlays even if we can't return them all. */ idx++; } else if (startpos < next) next = startpos; } for (tail = current_buffer->overlays_after; GC_CONSP (tail); tail = XCONS (tail)->cdr) { int startpos, endpos; overlay = XCONS (tail)->car; start = OVERLAY_START (overlay); end = OVERLAY_END (overlay); startpos = OVERLAY_POSITION (start); if (pos < startpos) { if (startpos < next) next = startpos; break; } endpos = OVERLAY_POSITION (end); if (pos < endpos) { if (idx == len) { if (extend) { *len_ptr = len *= 2; vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object)); *vec_ptr = vec; } else inhibit_storing = 1; } if (!inhibit_storing) vec[idx] = overlay; idx++; } else if (endpos < pos && endpos > prev) prev = endpos; } if (next_ptr) *next_ptr = next; if (prev_ptr) *prev_ptr = prev; return idx; } /* Find all the overlays in the current buffer that overlap the range BEG-END or are empty at BEG. Return the number found, and store them in a vector in *VEC_PTR. Store in *LEN_PTR the size allocated for the vector. Store in *NEXT_PTR the next position after POS where an overlay starts, or ZV if there are no more overlays. Store in *PREV_PTR the previous position before POS where an overlay ends, or BEGV if there are no previous overlays. NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info. *VEC_PTR and *LEN_PTR should contain a valid vector and size when this function is called. If EXTEND is non-zero, we make the vector bigger if necessary. If EXTEND is zero, we never extend the vector, and we store only as many overlays as will fit. But we still return the total number of overlays. */ int overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr) int beg, end; int extend; Lisp_Object **vec_ptr; int *len_ptr; int *next_ptr; int *prev_ptr; { Lisp_Object tail, overlay, ostart, oend, result; int idx = 0; int len = *len_ptr; Lisp_Object *vec = *vec_ptr; int next = ZV; int prev = BEGV; int inhibit_storing = 0; for (tail = current_buffer->overlays_before; GC_CONSP (tail); tail = XCONS (tail)->cdr) { int startpos, endpos; overlay = XCONS (tail)->car; ostart = OVERLAY_START (overlay); oend = OVERLAY_END (overlay); endpos = OVERLAY_POSITION (oend); if (endpos < beg) { if (prev < endpos) prev = endpos; break; } startpos = OVERLAY_POSITION (ostart); /* Count an interval if it either overlaps the range or is empty at the start of the range. */ if ((beg < endpos && startpos < end) || (startpos == endpos && beg == endpos)) { if (idx == len) { /* The supplied vector is full. Either make it bigger, or don't store any more in it. */ if (extend) { *len_ptr = len *= 2; vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object)); *vec_ptr = vec; } else inhibit_storing = 1; } if (!inhibit_storing) vec[idx] = overlay; /* Keep counting overlays even if we can't return them all. */ idx++; } else if (startpos < next) next = startpos; } for (tail = current_buffer->overlays_after; GC_CONSP (tail); tail = XCONS (tail)->cdr) { int startpos, endpos; overlay = XCONS (tail)->car; ostart = OVERLAY_START (overlay); oend = OVERLAY_END (overlay); startpos = OVERLAY_POSITION (ostart); if (end < startpos) { if (startpos < next) next = startpos; break; } endpos = OVERLAY_POSITION (oend); /* Count an interval if it either overlaps the range or is empty at the start of the range. */ if ((beg < endpos && startpos < end) || (startpos == endpos && beg == endpos)) { if (idx == len) { if (extend) { *len_ptr = len *= 2; vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object)); *vec_ptr = vec; } else inhibit_storing = 1; } if (!inhibit_storing) vec[idx] = overlay; idx++; } else if (endpos < beg && endpos > prev) prev = endpos; } if (next_ptr) *next_ptr = next; if (prev_ptr) *prev_ptr = prev; return idx; } /* Fast function to just test if we're at an overlay boundary. */ int overlay_touches_p (pos) int pos; { Lisp_Object tail, overlay; for (tail = current_buffer->overlays_before; GC_CONSP (tail); tail = XCONS (tail)->cdr) { int endpos; overlay = XCONS (tail)->car; if (!GC_OVERLAYP (overlay)) abort (); endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (endpos < pos) break; if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos) return 1; } for (tail = current_buffer->overlays_after; GC_CONSP (tail); tail = XCONS (tail)->cdr) { int startpos; overlay = XCONS (tail)->car; if (!GC_OVERLAYP (overlay)) abort (); startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); if (pos < startpos) break; if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos) return 1; } return 0; } struct sortvec { Lisp_Object overlay; int beg, end; int priority; }; static int compare_overlays (s1, s2) struct sortvec *s1, *s2; { if (s1->priority != s2->priority) return s1->priority - s2->priority; if (s1->beg != s2->beg) return s1->beg - s2->beg; if (s1->end != s2->end) return s2->end - s1->end; return 0; } /* Sort an array of overlays by priority. The array is modified in place. The return value is the new size; this may be smaller than the original size if some of the overlays were invalid or were window-specific. */ int sort_overlays (overlay_vec, noverlays, w) Lisp_Object *overlay_vec; int noverlays; struct window *w; { int i, j; struct sortvec *sortvec; sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec)); /* Put the valid and relevant overlays into sortvec. */ for (i = 0, j = 0; i < noverlays; i++) { Lisp_Object tem; Lisp_Object overlay; overlay = overlay_vec[i]; if (OVERLAY_VALID (overlay) && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0) { /* If we're interested in a specific window, then ignore overlays that are limited to some other window. */ if (w) { Lisp_Object window; window = Foverlay_get (overlay, Qwindow); if (WINDOWP (window) && XWINDOW (window) != w) continue; } /* This overlay is good and counts: put it into sortvec. */ sortvec[j].overlay = overlay; sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay)); sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay)); tem = Foverlay_get (overlay, Qpriority); if (INTEGERP (tem)) sortvec[j].priority = XINT (tem); else sortvec[j].priority = 0; j++; } } noverlays = j; /* Sort the overlays into the proper order: increasing priority. */ if (noverlays > 1) qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays); for (i = 0; i < noverlays; i++) overlay_vec[i] = sortvec[i].overlay; return (noverlays); } struct sortstr { Lisp_Object string, string2; int size; int priority; }; struct sortstrlist { struct sortstr *buf; /* An array that expands as needed; never freed. */ int size; /* Allocated length of that array. */ int used; /* How much of the array is currently in use. */ int bytes; /* Total length of the strings in buf. */ }; /* Buffers for storing information about the overlays touching a given position. These could be automatic variables in overlay_strings, but it's more efficient to hold onto the memory instead of repeatedly allocating and freeing it. */ static struct sortstrlist overlay_heads, overlay_tails; static char *overlay_str_buf; /* Allocated length of overlay_str_buf. */ static int overlay_str_len; /* A comparison function suitable for passing to qsort. */ static int cmp_for_strings (as1, as2) char *as1, *as2; { struct sortstr *s1 = (struct sortstr *)as1; struct sortstr *s2 = (struct sortstr *)as2; if (s1->size != s2->size) return s2->size - s1->size; if (s1->priority != s2->priority) return s1->priority - s2->priority; return 0; } static void record_overlay_string (ssl, str, str2, pri, size) struct sortstrlist *ssl; Lisp_Object str, str2, pri; int size; { if (ssl->used == ssl->size) { if (ssl->buf) ssl->size *= 2; else ssl->size = 5; ssl->buf = ((struct sortstr *) xrealloc (ssl->buf, ssl->size * sizeof (struct sortstr))); } ssl->buf[ssl->used].string = str; ssl->buf[ssl->used].string2 = str2; ssl->buf[ssl->used].size = size; ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0); ssl->used++; ssl->bytes += XSTRING (str)->size; if (STRINGP (str2)) ssl->bytes += XSTRING (str2)->size; } /* Return the concatenation of the strings associated with overlays that begin or end at POS, ignoring overlays that are specific to a window other than W. The strings are concatenated in the appropriate order: shorter overlays nest inside longer ones, and higher priority inside lower. Normally all of the after-strings come first, but zero-sized overlays have their after-strings ride along with the before-strings because it would look strange to print them inside-out. Returns the string length, and stores the contents indirectly through PSTR, if that variable is non-null. The string may be overwritten by subsequent calls. */ int overlay_strings (pos, w, pstr) int pos; struct window *w; char **pstr; { Lisp_Object ov, overlay, window, str; int startpos, endpos; overlay_heads.used = overlay_heads.bytes = 0; overlay_tails.used = overlay_tails.bytes = 0; for (ov = current_buffer->overlays_before; CONSP (ov); ov = XCONS (ov)->cdr) { overlay = XCONS (ov)->car; if (!OVERLAYP (overlay)) abort (); startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (endpos < pos) break; if (endpos != pos && startpos != pos) continue; window = Foverlay_get (overlay, Qwindow); if (WINDOWP (window) && XWINDOW (window) != w) continue; if (startpos == pos && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))) record_overlay_string (&overlay_heads, str, (startpos == endpos ? Foverlay_get (overlay, Qafter_string) : Qnil), Foverlay_get (overlay, Qpriority), endpos - startpos); else if (endpos == pos && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str))) record_overlay_string (&overlay_tails, str, Qnil, Foverlay_get (overlay, Qpriority), endpos - startpos); } for (ov = current_buffer->overlays_after; CONSP (ov); ov = XCONS (ov)->cdr) { overlay = XCONS (ov)->car; if (!OVERLAYP (overlay)) abort (); startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (startpos > pos) break; if (endpos != pos && startpos != pos) continue; window = Foverlay_get (overlay, Qwindow); if (WINDOWP (window) && XWINDOW (window) != w) continue; if (startpos == pos && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))) record_overlay_string (&overlay_heads, str, (startpos == endpos ? Foverlay_get (overlay, Qafter_string) : Qnil), Foverlay_get (overlay, Qpriority), endpos - startpos); else if (endpos == pos && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str))) record_overlay_string (&overlay_tails, str, Qnil, Foverlay_get (overlay, Qpriority), endpos - startpos); } if (overlay_tails.used > 1) qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr), cmp_for_strings); if (overlay_heads.used > 1) qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr), cmp_for_strings); if (overlay_heads.bytes || overlay_tails.bytes) { Lisp_Object tem; int i; char *p; int total = overlay_heads.bytes + overlay_tails.bytes; if (total > overlay_str_len) overlay_str_buf = (char *)xrealloc (overlay_str_buf, overlay_str_len = total); p = overlay_str_buf; for (i = overlay_tails.used; --i >= 0;) { tem = overlay_tails.buf[i].string; bcopy (XSTRING (tem)->data, p, XSTRING (tem)->size); p += XSTRING (tem)->size; } for (i = 0; i < overlay_heads.used; ++i) { tem = overlay_heads.buf[i].string; bcopy (XSTRING (tem)->data, p, XSTRING (tem)->size); p += XSTRING (tem)->size; tem = overlay_heads.buf[i].string2; if (STRINGP (tem)) { bcopy (XSTRING (tem)->data, p, XSTRING (tem)->size); p += XSTRING (tem)->size; } } if (p != overlay_str_buf + total) abort (); if (pstr) *pstr = overlay_str_buf; return total; } return 0; } /* Shift overlays in BUF's overlay lists, to center the lists at POS. */ void recenter_overlay_lists (buf, pos) struct buffer *buf; int pos; { Lisp_Object overlay, tail, next, prev, beg, end; /* See if anything in overlays_before should move to overlays_after. */ /* We don't strictly need prev in this loop; it should always be nil. But we use it for symmetry and in case that should cease to be true with some future change. */ prev = Qnil; for (tail = buf->overlays_before; CONSP (tail); prev = tail, tail = next) { next = XCONS (tail)->cdr; overlay = XCONS (tail)->car; /* If the overlay is not valid, get rid of it. */ if (!OVERLAY_VALID (overlay)) #if 1 abort (); #else { /* Splice the cons cell TAIL out of overlays_before. */ if (!NILP (prev)) XCONS (prev)->cdr = next; else buf->overlays_before = next; tail = prev; continue; } #endif beg = OVERLAY_START (overlay); end = OVERLAY_END (overlay); if (OVERLAY_POSITION (end) > pos) { /* OVERLAY needs to be moved. */ int where = OVERLAY_POSITION (beg); Lisp_Object other, other_prev; /* Splice the cons cell TAIL out of overlays_before. */ if (!NILP (prev)) XCONS (prev)->cdr = next; else buf->overlays_before = next; /* Search thru overlays_after for where to put it. */ other_prev = Qnil; for (other = buf->overlays_after; CONSP (other); other_prev = other, other = XCONS (other)->cdr) { Lisp_Object otherbeg, otheroverlay, follower; int win; otheroverlay = XCONS (other)->car; if (! OVERLAY_VALID (otheroverlay)) abort (); otherbeg = OVERLAY_START (otheroverlay); if (OVERLAY_POSITION (otherbeg) >= where) break; } /* Add TAIL to overlays_after before OTHER. */ XCONS (tail)->cdr = other; if (!NILP (other_prev)) XCONS (other_prev)->cdr = tail; else buf->overlays_after = tail; tail = prev; } else /* We've reached the things that should stay in overlays_before. All the rest of overlays_before must end even earlier, so stop now. */ break; } /* See if anything in overlays_after should be in overlays_before. */ prev = Qnil; for (tail = buf->overlays_after; CONSP (tail); prev = tail, tail = next) { next = XCONS (tail)->cdr; overlay = XCONS (tail)->car; /* If the overlay is not valid, get rid of it. */ if (!OVERLAY_VALID (overlay)) #if 1 abort (); #else { /* Splice the cons cell TAIL out of overlays_after. */ if (!NILP (prev)) XCONS (prev)->cdr = next; else buf->overlays_after = next; tail = prev; continue; } #endif beg = OVERLAY_START (overlay); end = OVERLAY_END (overlay); /* Stop looking, when we know that nothing further can possibly end before POS. */ if (OVERLAY_POSITION (beg) > pos) break; if (OVERLAY_POSITION (end) <= pos) { /* OVERLAY needs to be moved. */ int where = OVERLAY_POSITION (end); Lisp_Object other, other_prev; /* Splice the cons cell TAIL out of overlays_after. */ if (!NILP (prev)) XCONS (prev)->cdr = next; else buf->overlays_after = next; /* Search thru overlays_before for where to put it. */ other_prev = Qnil; for (other = buf->overlays_before; CONSP (other); other_prev = other, other = XCONS (other)->cdr) { Lisp_Object otherend, otheroverlay; int win; otheroverlay = XCONS (other)->car; if (! OVERLAY_VALID (otheroverlay)) abort (); otherend = OVERLAY_END (otheroverlay); if (OVERLAY_POSITION (otherend) <= where) break; } /* Add TAIL to overlays_before before OTHER. */ XCONS (tail)->cdr = other; if (!NILP (other_prev)) XCONS (other_prev)->cdr = tail; else buf->overlays_before = tail; tail = prev; } } XSETFASTINT (buf->overlay_center, pos); } void adjust_overlays_for_insert (pos, length) int pos; int length; { /* After an insertion, the lists are still sorted properly, but we may need to update the value of the overlay center. */ if (XFASTINT (current_buffer->overlay_center) >= pos) XSETFASTINT (current_buffer->overlay_center, XFASTINT (current_buffer->overlay_center) + length); } void adjust_overlays_for_delete (pos, length) int pos; int length; { if (XFASTINT (current_buffer->overlay_center) < pos) /* The deletion was to our right. No change needed; the before- and after-lists are still consistent. */ ; else if (XFASTINT (current_buffer->overlay_center) > pos + length) /* The deletion was to our left. We need to adjust the center value to account for the change in position, but the lists are consistent given the new value. */ XSETFASTINT (current_buffer->overlay_center, XFASTINT (current_buffer->overlay_center) - length); else /* We're right in the middle. There might be things on the after-list that now belong on the before-list. Recentering will move them, and also update the center point. */ recenter_overlay_lists (current_buffer, pos); } /* Fix up overlays that were garbled as a result of permuting markers in the range START through END. Any overlay with at least one endpoint in this range will need to be unlinked from the overlay list and reinserted in its proper place. Such an overlay might even have negative size at this point. If so, we'll reverse the endpoints. Can you think of anything better to do in this situation? */ void fix_overlays_in_range (start, end) register int start, end; { Lisp_Object tem, overlay; Lisp_Object before_list, after_list; Lisp_Object *ptail, *pbefore = &before_list, *pafter = &after_list; int startpos, endpos; /* This algorithm shifts links around instead of consing and GCing. The loop invariant is that before_list (resp. after_list) is a well-formed list except that its last element, the one that *pbefore (resp. *pafter) points to, is still uninitialized. So it's not a bug that before_list isn't initialized, although it may look strange. */ for (ptail = ¤t_buffer->overlays_before; CONSP (*ptail);) { overlay = XCONS (*ptail)->car; endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (endpos < start) break; startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); if (endpos < end || (startpos >= start && startpos < end)) { /* If the overlay is backwards, fix that now. */ if (startpos > endpos) { int tem; Fset_marker (OVERLAY_START (overlay), endpos, Qnil); Fset_marker (OVERLAY_END (overlay), startpos, Qnil); tem = startpos; startpos = endpos; endpos = tem; } /* Add it to the end of the wrong list. Later on, recenter_overlay_lists will move it to the right place. */ if (endpos < XINT (current_buffer->overlay_center)) { *pafter = *ptail; pafter = &XCONS (*ptail)->cdr; } else { *pbefore = *ptail; pbefore = &XCONS (*ptail)->cdr; } *ptail = XCONS (*ptail)->cdr; } else ptail = &XCONS (*ptail)->cdr; } for (ptail = ¤t_buffer->overlays_after; CONSP (*ptail);) { overlay = XCONS (*ptail)->car; startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); if (startpos >= end) break; endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (startpos >= start || (endpos >= start && endpos < end)) { if (startpos > endpos) { int tem; Fset_marker (OVERLAY_START (overlay), endpos, Qnil); Fset_marker (OVERLAY_END (overlay), startpos, Qnil); tem = startpos; startpos = endpos; endpos = tem; } if (endpos < XINT (current_buffer->overlay_center)) { *pafter = *ptail; pafter = &XCONS (*ptail)->cdr; } else { *pbefore = *ptail; pbefore = &XCONS (*ptail)->cdr; } *ptail = XCONS (*ptail)->cdr; } else ptail = &XCONS (*ptail)->cdr; } /* Splice the constructed (wrong) lists into the buffer's lists, and let the recenter function make it sane again. */ *pbefore = current_buffer->overlays_before; current_buffer->overlays_before = before_list; recenter_overlay_lists (current_buffer, XINT (current_buffer->overlay_center)); *pafter = current_buffer->overlays_after; current_buffer->overlays_after = after_list; recenter_overlay_lists (current_buffer, XINT (current_buffer->overlay_center)); } DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0, "Return t if OBJECT is an overlay.") (object) Lisp_Object object; { return (OVERLAYP (object) ? Qt : Qnil); } DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0, "Create a new overlay with range BEG to END in BUFFER.\n\ If omitted, BUFFER defaults to the current buffer.\n\ BEG and END may be integers or markers.\n\ The fourth arg FRONT-ADVANCE, if non-nil, makes the\n\ front delimiter advance when text is inserted there.\n\ The fifth arg REAR-ADVANCE, if non-nil, makes the\n\ rear delimiter advance when text is inserted there.") (beg, end, buffer, front_advance, rear_advance) Lisp_Object beg, end, buffer; Lisp_Object front_advance, rear_advance; { Lisp_Object overlay; struct buffer *b; if (NILP (buffer)) XSETBUFFER (buffer, current_buffer); else CHECK_BUFFER (buffer, 2); if (MARKERP (beg) && ! EQ (Fmarker_buffer (beg), buffer)) error ("Marker points into wrong buffer"); if (MARKERP (end) && ! EQ (Fmarker_buffer (end), buffer)) error ("Marker points into wrong buffer"); CHECK_NUMBER_COERCE_MARKER (beg, 1); CHECK_NUMBER_COERCE_MARKER (end, 1); if (XINT (beg) > XINT (end)) { Lisp_Object temp; temp = beg; beg = end; end = temp; } b = XBUFFER (buffer); beg = Fset_marker (Fmake_marker (), beg, buffer); end = Fset_marker (Fmake_marker (), end, buffer); if (!NILP (front_advance)) XMARKER (beg)->insertion_type = 1; if (!NILP (rear_advance)) XMARKER (end)->insertion_type = 1; overlay = allocate_misc (); XMISCTYPE (overlay) = Lisp_Misc_Overlay; XOVERLAY (overlay)->start = beg; XOVERLAY (overlay)->end = end; XOVERLAY (overlay)->plist = Qnil; /* Put the new overlay on the wrong list. */ end = OVERLAY_END (overlay); if (OVERLAY_POSITION (end) < XINT (b->overlay_center)) b->overlays_after = Fcons (overlay, b->overlays_after); else b->overlays_before = Fcons (overlay, b->overlays_before); /* This puts it in the right list, and in the right order. */ recenter_overlay_lists (b, XINT (b->overlay_center)); /* We don't need to redisplay the region covered by the overlay, because the overlay has no properties at the moment. */ return overlay; } DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0, "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\ If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.\n\ If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current\n\ buffer.") (overlay, beg, end, buffer) Lisp_Object overlay, beg, end, buffer; { struct buffer *b, *ob; Lisp_Object obuffer; int count = specpdl_ptr - specpdl; CHECK_OVERLAY (overlay, 0); if (NILP (buffer)) buffer = Fmarker_buffer (OVERLAY_START (overlay)); if (NILP (buffer)) XSETBUFFER (buffer, current_buffer); CHECK_BUFFER (buffer, 3); if (MARKERP (beg) && ! EQ (Fmarker_buffer (beg), buffer)) error ("Marker points into wrong buffer"); if (MARKERP (end) && ! EQ (Fmarker_buffer (end), buffer)) error ("Marker points into wrong buffer"); CHECK_NUMBER_COERCE_MARKER (beg, 1); CHECK_NUMBER_COERCE_MARKER (end, 1); if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate))) return Fdelete_overlay (overlay); if (XINT (beg) > XINT (end)) { Lisp_Object temp; temp = beg; beg = end; end = temp; } specbind (Qinhibit_quit, Qt); obuffer = Fmarker_buffer (OVERLAY_START (overlay)); b = XBUFFER (buffer); ob = XBUFFER (obuffer); /* If the overlay has changed buffers, do a thorough redisplay. */ if (!EQ (buffer, obuffer)) { /* Redisplay where the overlay was. */ if (!NILP (obuffer)) { Lisp_Object o_beg; Lisp_Object o_end; o_beg = OVERLAY_START (overlay); o_end = OVERLAY_END (overlay); o_beg = OVERLAY_POSITION (o_beg); o_end = OVERLAY_POSITION (o_end); redisplay_region (ob, XINT (o_beg), XINT (o_end)); } /* Redisplay where the overlay is going to be. */ redisplay_region (b, XINT (beg), XINT (end)); } else /* Redisplay the area the overlay has just left, or just enclosed. */ { Lisp_Object o_beg; Lisp_Object o_end; int change_beg, change_end; o_beg = OVERLAY_START (overlay); o_end = OVERLAY_END (overlay); o_beg = OVERLAY_POSITION (o_beg); o_end = OVERLAY_POSITION (o_end); if (XINT (o_beg) == XINT (beg)) redisplay_region (b, XINT (o_end), XINT (end)); else if (XINT (o_end) == XINT (end)) redisplay_region (b, XINT (o_beg), XINT (beg)); else { if (XINT (beg) < XINT (o_beg)) o_beg = beg; if (XINT (end) > XINT (o_end)) o_end = end; redisplay_region (b, XINT (o_beg), XINT (o_end)); } } if (!NILP (obuffer)) { ob->overlays_before = Fdelq (overlay, ob->overlays_before); ob->overlays_after = Fdelq (overlay, ob->overlays_after); } Fset_marker (OVERLAY_START (overlay), beg, buffer); Fset_marker (OVERLAY_END (overlay), end, buffer); /* Put the overlay on the wrong list. */ end = OVERLAY_END (overlay); if (OVERLAY_POSITION (end) < XINT (b->overlay_center)) b->overlays_after = Fcons (overlay, b->overlays_after); else b->overlays_before = Fcons (overlay, b->overlays_before); /* This puts it in the right list, and in the right order. */ recenter_overlay_lists (b, XINT (b->overlay_center)); return unbind_to (count, overlay); } DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0, "Delete the overlay OVERLAY from its buffer.") (overlay) Lisp_Object overlay; { Lisp_Object buffer; struct buffer *b; int count = specpdl_ptr - specpdl; CHECK_OVERLAY (overlay, 0); buffer = Fmarker_buffer (OVERLAY_START (overlay)); if (NILP (buffer)) return Qnil; b = XBUFFER (buffer); specbind (Qinhibit_quit, Qt); b->overlays_before = Fdelq (overlay, b->overlays_before); b->overlays_after = Fdelq (overlay, b->overlays_after); redisplay_region (b, marker_position (OVERLAY_START (overlay)), marker_position (OVERLAY_END (overlay))); Fset_marker (OVERLAY_START (overlay), Qnil, Qnil); Fset_marker (OVERLAY_END (overlay), Qnil, Qnil); return unbind_to (count, Qnil); } /* Overlay dissection functions. */ DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0, "Return the position at which OVERLAY starts.") (overlay) Lisp_Object overlay; { CHECK_OVERLAY (overlay, 0); return (Fmarker_position (OVERLAY_START (overlay))); } DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0, "Return the position at which OVERLAY ends.") (overlay) Lisp_Object overlay; { CHECK_OVERLAY (overlay, 0); return (Fmarker_position (OVERLAY_END (overlay))); } DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0, "Return the buffer OVERLAY belongs to.") (overlay) Lisp_Object overlay; { CHECK_OVERLAY (overlay, 0); return Fmarker_buffer (OVERLAY_START (overlay)); } DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0, "Return a list of the properties on OVERLAY.\n\ This is a copy of OVERLAY's plist; modifying its conses has no effect on\n\ OVERLAY.") (overlay) Lisp_Object overlay; { CHECK_OVERLAY (overlay, 0); return Fcopy_sequence (XOVERLAY (overlay)->plist); } DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0, "Return a list of the overlays that contain position POS.") (pos) Lisp_Object pos; { int noverlays; Lisp_Object *overlay_vec; int len; Lisp_Object result; CHECK_NUMBER_COERCE_MARKER (pos, 0); len = 10; overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object)); /* Put all the overlays we want in a vector in overlay_vec. Store the length in len. */ noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, (int *) 0, (int *) 0); /* Make a list of them all. */ result = Flist (noverlays, overlay_vec); xfree (overlay_vec); return result; } DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0, "Return a list of the overlays that overlap the region BEG ... END.\n\ Overlap means that at least one character is contained within the overlay\n\ and also contained within the specified region.\n\ Empty overlays are included in the result if they are located at BEG\n\ or between BEG and END.") (beg, end) Lisp_Object beg, end; { int noverlays; Lisp_Object *overlay_vec; int len; Lisp_Object result; CHECK_NUMBER_COERCE_MARKER (beg, 0); CHECK_NUMBER_COERCE_MARKER (end, 0); len = 10; overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object)); /* Put all the overlays we want in a vector in overlay_vec. Store the length in len. */ noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len, (int *) 0, (int *) 0); /* Make a list of them all. */ result = Flist (noverlays, overlay_vec); xfree (overlay_vec); return result; } DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change, 1, 1, 0, "Return the next position after POS where an overlay starts or ends.\n\ If there are no more overlay boundaries after POS, return (point-max).") (pos) Lisp_Object pos; { int noverlays; int endpos; Lisp_Object *overlay_vec; int len; int i; CHECK_NUMBER_COERCE_MARKER (pos, 0); len = 10; overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object)); /* Put all the overlays we want in a vector in overlay_vec. Store the length in len. endpos gets the position where the next overlay starts. */ noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, &endpos, (int *) 0); /* If any of these overlays ends before endpos, use its ending point instead. */ for (i = 0; i < noverlays; i++) { Lisp_Object oend; int oendpos; oend = OVERLAY_END (overlay_vec[i]); oendpos = OVERLAY_POSITION (oend); if (oendpos < endpos) endpos = oendpos; } xfree (overlay_vec); return make_number (endpos); } DEFUN ("previous-overlay-change", Fprevious_overlay_change, Sprevious_overlay_change, 1, 1, 0, "Return the previous position before POS where an overlay starts or ends.\n\ If there are no more overlay boundaries before POS, return (point-min).") (pos) Lisp_Object pos; { int noverlays; int prevpos; Lisp_Object *overlay_vec; int len; int i; Lisp_Object tail; CHECK_NUMBER_COERCE_MARKER (pos, 0); len = 10; overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object)); /* At beginning of buffer, we know the answer; avoid bug subtracting 1 below. */ if (XINT (pos) == BEGV) return pos; /* Put all the overlays we want in a vector in overlay_vec. Store the length in len. prevpos gets the position of an overlay end. */ noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, (int *) 0, &prevpos); /* If any of these overlays starts after prevpos, maybe use its starting point instead. */ for (i = 0; i < noverlays; i++) { Lisp_Object ostart; int ostartpos; ostart = OVERLAY_START (overlay_vec[i]); ostartpos = OVERLAY_POSITION (ostart); if (ostartpos > prevpos && ostartpos < XINT (pos)) prevpos = ostartpos; } /* If any overlay ends at pos, consider its starting point too. */ for (tail = current_buffer->overlays_before; GC_CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object overlay, ostart; int ostartpos; overlay = XCONS (tail)->car; ostart = OVERLAY_START (overlay); ostartpos = OVERLAY_POSITION (ostart); if (ostartpos > prevpos && ostartpos < XINT (pos)) prevpos = ostartpos; } xfree (overlay_vec); return make_number (prevpos); } /* These functions are for debugging overlays. */ DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0, "Return a pair of lists giving all the overlays of the current buffer.\n\ The car has all the overlays before the overlay center;\n\ the cdr has all the overlays after the overlay center.\n\ Recentering overlays moves overlays between these lists.\n\ The lists you get are copies, so that changing them has no effect.\n\ However, the overlays you get are the real objects that the buffer uses.") () { Lisp_Object before, after; before = current_buffer->overlays_before; if (CONSP (before)) before = Fcopy_sequence (before); after = current_buffer->overlays_after; if (CONSP (after)) after = Fcopy_sequence (after); return Fcons (before, after); } DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0, "Recenter the overlays of the current buffer around position POS.") (pos) Lisp_Object pos; { CHECK_NUMBER_COERCE_MARKER (pos, 0); recenter_overlay_lists (current_buffer, XINT (pos)); return Qnil; } DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0, "Get the property of overlay OVERLAY with property name NAME.") (overlay, prop) Lisp_Object overlay, prop; { Lisp_Object plist, fallback; CHECK_OVERLAY (overlay, 0); fallback = Qnil; for (plist = XOVERLAY (overlay)->plist; CONSP (plist) && CONSP (XCONS (plist)->cdr); plist = XCONS (XCONS (plist)->cdr)->cdr) { if (EQ (XCONS (plist)->car, prop)) return XCONS (XCONS (plist)->cdr)->car; else if (EQ (XCONS (plist)->car, Qcategory)) { Lisp_Object tem; tem = Fcar (Fcdr (plist)); if (SYMBOLP (tem)) fallback = Fget (tem, prop); } } return fallback; } DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0, "Set one property of overlay OVERLAY: give property PROP value VALUE.") (overlay, prop, value) Lisp_Object overlay, prop, value; { Lisp_Object tail, buffer; int changed; CHECK_OVERLAY (overlay, 0); buffer = Fmarker_buffer (OVERLAY_START (overlay)); for (tail = XOVERLAY (overlay)->plist; CONSP (tail) && CONSP (XCONS (tail)->cdr); tail = XCONS (XCONS (tail)->cdr)->cdr) if (EQ (XCONS (tail)->car, prop)) { changed = !EQ (XCONS (XCONS (tail)->cdr)->car, value); XCONS (XCONS (tail)->cdr)->car = value; goto found; } /* It wasn't in the list, so add it to the front. */ changed = !NILP (value); XOVERLAY (overlay)->plist = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist)); found: if (! NILP (buffer)) { if (changed) redisplay_region (XBUFFER (buffer), marker_position (OVERLAY_START (overlay)), marker_position (OVERLAY_END (overlay))); if (EQ (prop, Qevaporate) && ! NILP (value) && (OVERLAY_POSITION (OVERLAY_START (overlay)) == OVERLAY_POSITION (OVERLAY_END (overlay)))) Fdelete_overlay (overlay); } return value; } /* Subroutine of report_overlay_modification. */ /* Lisp vector holding overlay hook functions to call. Vector elements come in pairs. Each even-index element is a list of hook functions. The following odd-index element is the overlay they came from. Before the buffer change, we fill in this vector as we call overlay hook functions. After the buffer change, we get the functions to call from this vector. This way we always call the same functions before and after the change. */ static Lisp_Object last_overlay_modification_hooks; /* Number of elements actually used in last_overlay_modification_hooks. */ static int last_overlay_modification_hooks_used; /* Add one functionlist/overlay pair to the end of last_overlay_modification_hooks. */ static void add_overlay_mod_hooklist (functionlist, overlay) Lisp_Object functionlist, overlay; { int oldsize = XVECTOR (last_overlay_modification_hooks)->size; if (last_overlay_modification_hooks_used == oldsize) { Lisp_Object old; old = last_overlay_modification_hooks; last_overlay_modification_hooks = Fmake_vector (make_number (oldsize * 2), Qnil); bcopy (XVECTOR (last_overlay_modification_hooks)->contents, XVECTOR (old)->contents, sizeof (Lisp_Object) * oldsize); } XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = functionlist; XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = overlay; } /* Run the modification-hooks of overlays that include any part of the text in START to END. If this change is an insertion, also run the insert-before-hooks of overlay starting at END, and the insert-after-hooks of overlay ending at START. This is called both before and after the modification. AFTER is nonzero when we call after the modification. ARG1, ARG2, ARG3 are arguments to pass to the hook functions. When AFTER is nonzero, they are the start position, the position after the inserted new text, and the length of deleted or replaced old text. */ void report_overlay_modification (start, end, after, arg1, arg2, arg3) Lisp_Object start, end; int after; Lisp_Object arg1, arg2, arg3; { Lisp_Object prop, overlay, tail; /* 1 if this change is an insertion. */ int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end)); int tail_copied; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; overlay = Qnil; tail = Qnil; GCPRO5 (overlay, tail, arg1, arg2, arg3); if (after) { /* Call the functions recorded in last_overlay_modification_hooks rather than scanning the overlays again. First copy the vector contents, in case some of these hooks do subsequent modification of the buffer. */ int size = last_overlay_modification_hooks_used; Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object)); int i; bcopy (XVECTOR (last_overlay_modification_hooks)->contents, copy, size * sizeof (Lisp_Object)); gcpro1.var = copy; gcpro1.nvars = size; for (i = 0; i < size;) { Lisp_Object prop, overlay; prop = copy[i++]; overlay = copy[i++]; call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3); } UNGCPRO; return; } /* We are being called before a change. Scan the overlays to find the functions to call. */ last_overlay_modification_hooks_used = 0; tail_copied = 0; for (tail = current_buffer->overlays_before; CONSP (tail); tail = XCONS (tail)->cdr) { int startpos, endpos; Lisp_Object 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 (insertion && (XFASTINT (start) == startpos || XFASTINT (end) == startpos)) { prop = Foverlay_get (overlay, Qinsert_in_front_hooks); if (!NILP (prop)) { /* Copy TAIL in case the hook recenters the overlay lists. */ if (!tail_copied) tail = Fcopy_sequence (tail); tail_copied = 1; call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3); } } if (insertion && (XFASTINT (start) == endpos || XFASTINT (end) == endpos)) { prop = Foverlay_get (overlay, Qinsert_behind_hooks); if (!NILP (prop)) { if (!tail_copied) tail = Fcopy_sequence (tail); tail_copied = 1; call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3); } } /* Test for intersecting intervals. This does the right thing for both insertion and deletion. */ if (XFASTINT (end) > startpos && XFASTINT (start) < endpos) { prop = Foverlay_get (overlay, Qmodification_hooks); if (!NILP (prop)) { if (!tail_copied) tail = Fcopy_sequence (tail); tail_copied = 1; call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3); } } } tail_copied = 0; for (tail = current_buffer->overlays_after; CONSP (tail); tail = XCONS (tail)->cdr) { int startpos, endpos; Lisp_Object ostart, oend; overlay = XCONS (tail)->car; ostart = OVERLAY_START (overlay); oend = OVERLAY_END (overlay); startpos = OVERLAY_POSITION (ostart); endpos = OVERLAY_POSITION (oend); if (XFASTINT (end) < startpos) break; if (insertion && (XFASTINT (start) == startpos || XFASTINT (end) == startpos)) { prop = Foverlay_get (overlay, Qinsert_in_front_hooks); if (!NILP (prop)) { if (!tail_copied) tail = Fcopy_sequence (tail); tail_copied = 1; call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3); } } if (insertion && (XFASTINT (start) == endpos || XFASTINT (end) == endpos)) { prop = Foverlay_get (overlay, Qinsert_behind_hooks); if (!NILP (prop)) { if (!tail_copied) tail = Fcopy_sequence (tail); tail_copied = 1; call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3); } } /* Test for intersecting intervals. This does the right thing for both insertion and deletion. */ if (XFASTINT (end) > startpos && XFASTINT (start) < endpos) { prop = Foverlay_get (overlay, Qmodification_hooks); if (!NILP (prop)) { if (!tail_copied) tail = Fcopy_sequence (tail); tail_copied = 1; call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3); } } } UNGCPRO; } static void call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3) Lisp_Object list, overlay; int after; Lisp_Object arg1, arg2, arg3; { struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; GCPRO4 (list, arg1, arg2, arg3); if (! after) add_overlay_mod_hooklist (list, overlay); while (!NILP (list)) { if (NILP (arg3)) call4 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2); else call5 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3); list = Fcdr (list); } UNGCPRO; } /* Delete any zero-sized overlays at position POS, if the `evaporate' property is set. */ void evaporate_overlays (pos) int pos; { Lisp_Object tail, overlay, hit_list; hit_list = Qnil; if (pos <= XFASTINT (current_buffer->overlay_center)) for (tail = current_buffer->overlays_before; CONSP (tail); tail = XCONS (tail)->cdr) { int endpos; overlay = XCONS (tail)->car; endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (endpos < pos) break; if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos && ! NILP (Foverlay_get (overlay, Qevaporate))) hit_list = Fcons (overlay, hit_list); } else for (tail = current_buffer->overlays_after; CONSP (tail); tail = XCONS (tail)->cdr) { int startpos; overlay = XCONS (tail)->car; startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); if (startpos > pos) break; if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos && ! NILP (Foverlay_get (overlay, Qevaporate))) hit_list = Fcons (overlay, hit_list); } for (; CONSP (hit_list); hit_list = XCONS (hit_list)->cdr) Fdelete_overlay (XCONS (hit_list)->car); } /* Somebody has tried to store a value with an unacceptable type into the buffer-local slot with offset OFFSET. */ void buffer_slot_type_mismatch (offset) int offset; { Lisp_Object sym; char *type_name; sym = *(Lisp_Object *)(offset + (char *)&buffer_local_symbols); switch (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_types))) { case Lisp_Int: type_name = "integers"; break; case Lisp_String: type_name = "strings"; break; case Lisp_Symbol: type_name = "symbols"; break; default: abort (); } error ("only %s should be stored in the buffer-local variable %s", type_name, XSYMBOL (sym)->name->data); } init_buffer_once () { register Lisp_Object tem; /* Make sure all markable slots in buffer_defaults are initialized reasonably, so mark_buffer won't choke. */ reset_buffer (&buffer_defaults); reset_buffer_local_variables (&buffer_defaults); reset_buffer (&buffer_local_symbols); reset_buffer_local_variables (&buffer_local_symbols); /* Prevent GC from getting confused. */ buffer_defaults.text = &buffer_defaults.own_text; buffer_local_symbols.text = &buffer_local_symbols.own_text; #ifdef USE_TEXT_PROPERTIES BUF_INTERVALS (&buffer_defaults) = 0; BUF_INTERVALS (&buffer_local_symbols) = 0; #endif XSETBUFFER (Vbuffer_defaults, &buffer_defaults); XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols); /* Set up the default values of various buffer slots. */ /* Must do these before making the first buffer! */ /* real setup is done in loaddefs.el */ buffer_defaults.mode_line_format = build_string ("%-"); buffer_defaults.abbrev_mode = Qnil; buffer_defaults.overwrite_mode = Qnil; buffer_defaults.case_fold_search = Qt; buffer_defaults.auto_fill_function = Qnil; buffer_defaults.selective_display = Qnil; #ifndef old buffer_defaults.selective_display_ellipses = Qt; #endif buffer_defaults.abbrev_table = Qnil; buffer_defaults.display_table = Qnil; buffer_defaults.undo_list = Qnil; buffer_defaults.mark_active = Qnil; buffer_defaults.file_format = Qnil; buffer_defaults.overlays_before = Qnil; buffer_defaults.overlays_after = Qnil; XSETFASTINT (buffer_defaults.overlay_center, BEG); XSETFASTINT (buffer_defaults.tab_width, 8); buffer_defaults.truncate_lines = Qnil; buffer_defaults.ctl_arrow = Qt; #ifdef DOS_NT buffer_defaults.buffer_file_type = Qnil; /* TEXT */ #endif XSETFASTINT (buffer_defaults.fill_column, 70); XSETFASTINT (buffer_defaults.left_margin, 0); buffer_defaults.cache_long_line_scans = Qnil; buffer_defaults.file_truename = Qnil; /* Assign the local-flags to the slots that have default values. The local flag is a bit that is used in the buffer to say that it has its own local value for the slot. The local flag bits are in the local_var_flags slot of the buffer. */ /* Nothing can work if this isn't true */ if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort (); /* 0 means not a lisp var, -1 means always local, else mask */ bzero (&buffer_local_flags, sizeof buffer_local_flags); XSETINT (buffer_local_flags.filename, -1); XSETINT (buffer_local_flags.directory, -1); XSETINT (buffer_local_flags.backed_up, -1); XSETINT (buffer_local_flags.save_length, -1); XSETINT (buffer_local_flags.auto_save_file_name, -1); XSETINT (buffer_local_flags.read_only, -1); XSETINT (buffer_local_flags.major_mode, -1); XSETINT (buffer_local_flags.mode_name, -1); XSETINT (buffer_local_flags.undo_list, -1); XSETINT (buffer_local_flags.mark_active, -1); XSETINT (buffer_local_flags.point_before_scroll, -1); XSETINT (buffer_local_flags.file_truename, -1); XSETINT (buffer_local_flags.invisibility_spec, -1); XSETINT (buffer_local_flags.file_format, -1); XSETINT (buffer_local_flags.redisplay_end_trigger, -1); XSETFASTINT (buffer_local_flags.mode_line_format, 1); XSETFASTINT (buffer_local_flags.abbrev_mode, 2); XSETFASTINT (buffer_local_flags.overwrite_mode, 4); XSETFASTINT (buffer_local_flags.case_fold_search, 8); XSETFASTINT (buffer_local_flags.auto_fill_function, 0x10); XSETFASTINT (buffer_local_flags.selective_display, 0x20); #ifndef old XSETFASTINT (buffer_local_flags.selective_display_ellipses, 0x40); #endif XSETFASTINT (buffer_local_flags.tab_width, 0x80); XSETFASTINT (buffer_local_flags.truncate_lines, 0x100); XSETFASTINT (buffer_local_flags.ctl_arrow, 0x200); XSETFASTINT (buffer_local_flags.fill_column, 0x400); XSETFASTINT (buffer_local_flags.left_margin, 0x800); XSETFASTINT (buffer_local_flags.abbrev_table, 0x1000); XSETFASTINT (buffer_local_flags.display_table, 0x2000); XSETFASTINT (buffer_local_flags.syntax_table, 0x8000); XSETFASTINT (buffer_local_flags.cache_long_line_scans, 0x10000); #ifdef DOS_NT XSETFASTINT (buffer_local_flags.buffer_file_type, 0x4000); #endif Vbuffer_alist = Qnil; current_buffer = 0; all_buffers = 0; QSFundamental = build_string ("Fundamental"); Qfundamental_mode = intern ("fundamental-mode"); buffer_defaults.major_mode = Qfundamental_mode; Qmode_class = intern ("mode-class"); Qprotected_field = intern ("protected-field"); Qpermanent_local = intern ("permanent-local"); Qkill_buffer_hook = intern ("kill-buffer-hook"); Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1")); /* super-magic invisible buffer */ Vbuffer_alist = Qnil; Fset_buffer (Fget_buffer_create (build_string ("*scratch*"))); } init_buffer () { char buf[MAXPATHLEN+1]; char *pwd; struct stat dotstat, pwdstat; Lisp_Object temp; int rc; Fset_buffer (Fget_buffer_create (build_string ("*scratch*"))); /* If PWD is accurate, use it instead of calling getwd. This is faster when PWD is right, and may avoid a fatal error. */ if ((pwd = getenv ("PWD")) != 0 && IS_DIRECTORY_SEP (*pwd) && stat (pwd, &pwdstat) == 0 && stat (".", &dotstat) == 0 && dotstat.st_ino == pwdstat.st_ino && dotstat.st_dev == pwdstat.st_dev && strlen (pwd) < MAXPATHLEN) strcpy (buf, pwd); else if (getwd (buf) == 0) fatal ("`getwd' failed: %s\n", buf); #ifndef VMS /* Maybe this should really use some standard subroutine whose definition is filename syntax dependent. */ rc = strlen (buf); if (!(IS_DIRECTORY_SEP (buf[rc - 1]))) { buf[rc] = DIRECTORY_SEP; buf[rc + 1] = '\0'; } #endif /* not VMS */ current_buffer->directory = build_string (buf); temp = get_minibuffer (0); XBUFFER (temp)->directory = current_buffer->directory; } /* initialize the buffer routines */ syms_of_buffer () { extern Lisp_Object Qdisabled; staticpro (&last_overlay_modification_hooks); last_overlay_modification_hooks = Fmake_vector (make_number (10), Qnil); staticpro (&Vbuffer_defaults); staticpro (&Vbuffer_local_symbols); staticpro (&Qfundamental_mode); staticpro (&Qmode_class); staticpro (&QSFundamental); staticpro (&Vbuffer_alist); staticpro (&Qprotected_field); staticpro (&Qpermanent_local); staticpro (&Qkill_buffer_hook); Qoverlayp = intern ("overlayp"); staticpro (&Qoverlayp); Qevaporate = intern ("evaporate"); staticpro (&Qevaporate); Qmodification_hooks = intern ("modification-hooks"); staticpro (&Qmodification_hooks); Qinsert_in_front_hooks = intern ("insert-in-front-hooks"); staticpro (&Qinsert_in_front_hooks); Qinsert_behind_hooks = intern ("insert-behind-hooks"); staticpro (&Qinsert_behind_hooks); Qget_file_buffer = intern ("get-file-buffer"); staticpro (&Qget_file_buffer); Qpriority = intern ("priority"); staticpro (&Qpriority); Qwindow = intern ("window"); staticpro (&Qwindow); Qbefore_string = intern ("before-string"); staticpro (&Qbefore_string); Qafter_string = intern ("after-string"); staticpro (&Qafter_string); Qfirst_change_hook = intern ("first-change-hook"); staticpro (&Qfirst_change_hook); Qbefore_change_functions = intern ("before-change-functions"); staticpro (&Qbefore_change_functions); Qafter_change_functions = intern ("after-change-functions"); staticpro (&Qafter_change_functions); Fput (Qprotected_field, Qerror_conditions, Fcons (Qprotected_field, Fcons (Qerror, Qnil))); Fput (Qprotected_field, Qerror_message, build_string ("Attempt to modify a protected field")); /* All these use DEFVAR_LISP_NOPRO because the slots in buffer_defaults will all be marked via Vbuffer_defaults. */ DEFVAR_LISP_NOPRO ("default-mode-line-format", &buffer_defaults.mode_line_format, "Default value of `mode-line-format' for buffers that don't override it.\n\ This is the same as (default-value 'mode-line-format)."); DEFVAR_LISP_NOPRO ("default-abbrev-mode", &buffer_defaults.abbrev_mode, "Default value of `abbrev-mode' for buffers that do not override it.\n\ This is the same as (default-value 'abbrev-mode)."); DEFVAR_LISP_NOPRO ("default-ctl-arrow", &buffer_defaults.ctl_arrow, "Default value of `ctl-arrow' for buffers that do not override it.\n\ This is the same as (default-value 'ctl-arrow)."); DEFVAR_LISP_NOPRO ("default-truncate-lines", &buffer_defaults.truncate_lines, "Default value of `truncate-lines' for buffers that do not override it.\n\ This is the same as (default-value 'truncate-lines)."); DEFVAR_LISP_NOPRO ("default-fill-column", &buffer_defaults.fill_column, "Default value of `fill-column' for buffers that do not override it.\n\ This is the same as (default-value 'fill-column)."); DEFVAR_LISP_NOPRO ("default-left-margin", &buffer_defaults.left_margin, "Default value of `left-margin' for buffers that do not override it.\n\ This is the same as (default-value 'left-margin)."); DEFVAR_LISP_NOPRO ("default-tab-width", &buffer_defaults.tab_width, "Default value of `tab-width' for buffers that do not override it.\n\ This is the same as (default-value 'tab-width)."); DEFVAR_LISP_NOPRO ("default-case-fold-search", &buffer_defaults.case_fold_search, "Default value of `case-fold-search' for buffers that don't override it.\n\ This is the same as (default-value 'case-fold-search)."); #ifdef DOS_NT DEFVAR_LISP_NOPRO ("default-buffer-file-type", &buffer_defaults.buffer_file_type, "Default file type for buffers that do not override it.\n\ This is the same as (default-value 'buffer-file-type).\n\ The file type is nil for text, t for binary."); #endif DEFVAR_PER_BUFFER ("mode-line-format", ¤t_buffer->mode_line_format, Qnil, 0); /* This doc string is too long for cpp; cpp dies if it isn't in a comment. But make-docfile finds it! DEFVAR_PER_BUFFER ("mode-line-format", ¤t_buffer->mode_line_format, Qnil, "Template for displaying mode line for current buffer.\n\ Each buffer has its own value of this variable.\n\ Value may be a string, a symbol or a list or cons cell.\n\ For a symbol, its value is used (but it is ignored if t or nil).\n\ A string appearing directly as the value of a symbol is processed verbatim\n\ in that the %-constructs below are not recognized.\n\ For a list whose car is a symbol, the symbol's value is taken,\n\ and if that is non-nil, the cadr of the list is processed recursively.\n\ Otherwise, the caddr of the list (if there is one) is processed.\n\ For a list whose car is a string or list, each element is processed\n\ recursively and the results are effectively concatenated.\n\ For a list whose car is an integer, the cdr of the list is processed\n\ and padded (if the number is positive) or truncated (if negative)\n\ to the width specified by that number.\n\ A string is printed verbatim in the mode line except for %-constructs:\n\ (%-constructs are allowed when the string is the entire mode-line-format\n\ or when it is found in a cons-cell or a list)\n\ %b -- print buffer name. %f -- print visited file name.\n\ %* -- print %, * or hyphen. %+ -- print *, % or hyphen.\n\ % means buffer is read-only and * means it is modified.\n\ For a modified read-only buffer, %* gives % and %+ gives *.\n\ %s -- print process status. %l -- print the current line number.\n\ %p -- print percent of buffer above top of window, or Top, Bot or All.\n\ %P -- print percent of buffer above bottom of window, perhaps plus Top,\n\ or print Bottom or All.\n\ %n -- print Narrow if appropriate.\n\ %t -- print T if files is text, B if binary.\n\ %[ -- print one [ for each recursive editing level. %] similar.\n\ %% -- print %. %- -- print infinitely many dashes.\n\ Decimal digits after the % specify field width to which to pad."); */ DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode, "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\ nil here means use current buffer's major mode."); DEFVAR_PER_BUFFER ("major-mode", ¤t_buffer->major_mode, make_number (Lisp_Symbol), "Symbol for current buffer's major mode."); DEFVAR_PER_BUFFER ("mode-name", ¤t_buffer->mode_name, make_number (Lisp_String), "Pretty name of current buffer's major mode (a string)."); DEFVAR_PER_BUFFER ("abbrev-mode", ¤t_buffer->abbrev_mode, Qnil, "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\ Automatically becomes buffer-local when set in any fashion."); DEFVAR_PER_BUFFER ("case-fold-search", ¤t_buffer->case_fold_search, Qnil, "*Non-nil if searches should ignore case.\n\ Automatically becomes buffer-local when set in any fashion."); DEFVAR_PER_BUFFER ("fill-column", ¤t_buffer->fill_column, make_number (Lisp_Int), "*Column beyond which automatic line-wrapping should happen.\n\ Automatically becomes buffer-local when set in any fashion."); DEFVAR_PER_BUFFER ("left-margin", ¤t_buffer->left_margin, make_number (Lisp_Int), "*Column for the default indent-line-function to indent to.\n\ Linefeed indents to this column in Fundamental mode.\n\ Automatically becomes buffer-local when set in any fashion."); DEFVAR_PER_BUFFER ("tab-width", ¤t_buffer->tab_width, make_number (Lisp_Int), "*Distance between tab stops (for display of tab characters), in columns.\n\ Automatically becomes buffer-local when set in any fashion."); DEFVAR_PER_BUFFER ("ctl-arrow", ¤t_buffer->ctl_arrow, Qnil, "*Non-nil means display control chars with uparrow.\n\ Nil means use backslash and octal digits.\n\ Automatically becomes buffer-local when set in any fashion.\n\ This variable does not apply to characters whose display is specified\n\ in the current display table (if there is one)."); DEFVAR_PER_BUFFER ("truncate-lines", ¤t_buffer->truncate_lines, Qnil, "*Non-nil means do not display continuation lines;\n\ give each line of text one screen line.\n\ Automatically becomes buffer-local when set in any fashion.\n\ \n\ Note that this is overridden by the variable\n\ `truncate-partial-width-windows' if that variable is non-nil\n\ and this buffer is not full-frame width."); #ifdef DOS_NT DEFVAR_PER_BUFFER ("buffer-file-type", ¤t_buffer->buffer_file_type, Qnil, "Non-nil if the visited file is a binary file.\n\ This variable is meaningful on MS-DOG and Windows NT.\n\ On those systems, it is automatically local in every buffer.\n\ On other systems, this variable is normally always nil."); #endif DEFVAR_PER_BUFFER ("default-directory", ¤t_buffer->directory, make_number (Lisp_String), "Name of default directory of current buffer. Should end with slash.\n\ Each buffer has its own value of this variable."); DEFVAR_PER_BUFFER ("auto-fill-function", ¤t_buffer->auto_fill_function, Qnil, "Function called (if non-nil) to perform auto-fill.\n\ It is called after self-inserting a space at a column beyond `fill-column'.\n\ Each buffer has its own value of this variable.\n\ NOTE: This variable is not an ordinary hook;\n\ It may not be a list of functions."); DEFVAR_PER_BUFFER ("buffer-file-name", ¤t_buffer->filename, make_number (Lisp_String), "Name of file visited in current buffer, or nil if not visiting a file.\n\ Each buffer has its own value of this variable."); DEFVAR_PER_BUFFER ("buffer-file-truename", ¤t_buffer->file_truename, make_number (Lisp_String), "Abbreviated truename of file visited in current buffer, or nil if none.\n\ The truename of a file is calculated by `file-truename'\n\ and then abbreviated with `abbreviate-file-name'.\n\ Each buffer has its own value of this variable."); DEFVAR_PER_BUFFER ("buffer-auto-save-file-name", ¤t_buffer->auto_save_file_name, make_number (Lisp_String), "Name of file for auto-saving current buffer,\n\ or nil if buffer should not be auto-saved.\n\ Each buffer has its own value of this variable."); DEFVAR_PER_BUFFER ("buffer-read-only", ¤t_buffer->read_only, Qnil, "Non-nil if this buffer is read-only.\n\ Each buffer has its own value of this variable."); DEFVAR_PER_BUFFER ("buffer-backed-up", ¤t_buffer->backed_up, Qnil, "Non-nil if this buffer's file has been backed up.\n\ Backing up is done before the first time the file is saved.\n\ Each buffer has its own value of this variable."); DEFVAR_PER_BUFFER ("buffer-saved-size", ¤t_buffer->save_length, make_number (Lisp_Int), "Length of current buffer when last read in, saved or auto-saved.\n\ 0 initially.\n\ Each buffer has its own value of this variable."); DEFVAR_PER_BUFFER ("selective-display", ¤t_buffer->selective_display, Qnil, "Non-nil enables selective display:\n\ Integer N as value means display only lines\n\ that start with less than n columns of space.\n\ A value of t means, after a ^M, all the rest of the line is invisible.\n\ Then ^M's in the file are written into files as newlines.\n\n\ Automatically becomes buffer-local when set in any fashion."); #ifndef old DEFVAR_PER_BUFFER ("selective-display-ellipses", ¤t_buffer->selective_display_ellipses, Qnil, "t means display ... on previous line when a line is invisible.\n\ Automatically becomes buffer-local when set in any fashion."); #endif DEFVAR_PER_BUFFER ("overwrite-mode", ¤t_buffer->overwrite_mode, Qnil, "Non-nil if self-insertion should replace existing text.\n\ The value should be one of `overwrite-mode-textual',\n\ `overwrite-mode-binary', or nil.\n\ If it is `overwrite-mode-textual', self-insertion still\n\ inserts at the end of a line, and inserts when point is before a tab,\n\ until the tab is filled in.\n\ If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\ Automatically becomes buffer-local when set in any fashion."); #if 0 /* The doc string is too long for some compilers, but make-docfile can find it in this comment. */ DEFVAR_PER_BUFFER ("buffer-display-table", ¤t_buffer->display_table, Qnil, "Display table that controls display of the contents of current buffer.\n\ Automatically becomes buffer-local when set in any fashion.\n\ The display table is a char-table created with `make-display-table'.\n\ The ordinary char-table elements control how to display each possible text\n\ character. Each value should be a vector of characters or nil;\n\ nil means display the character in the default fashion.\n\ There are six extra slots to control the display of\n\ the end of a truncated screen line (extra-slot 0, a single character);\n\ the end of a continued line (extra-slot 1, a single character);\n\ the escape character used to display character codes in octal\n\ (extra-slot 2, a single character);\n\ the character used as an arrow for control characters (extra-slot 3,\n\ a single character);\n\ the decoration indicating the presence of invisible lines (extra-slot 4,\n\ a vector of characters);\n\ the character used to draw the border between side-by-side windows\n\ (extra-slot 5, a single character).\n\ See also the functions `display-table-slot' and `set-display-table-slot'.\n\ If this variable is nil, the value of `standard-display-table' is used.\n\ Each window can have its own, overriding display table."); #endif DEFVAR_PER_BUFFER ("buffer-display-table", ¤t_buffer->display_table, Qnil, 0); /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol, "Don't ask."); */ DEFVAR_LISP ("before-change-function", &Vbefore_change_function, "Function to call before each text change.\n\ Two arguments are passed to the function: the positions of\n\ the beginning and end of the range of old text to be changed.\n\ \(For an insertion, the beginning and end are at the same place.)\n\ No information is given about the length of the text after the change.\n\ \n\ Buffer changes made while executing the `before-change-function'\n\ don't call any before-change or after-change functions.\n\ That's because these variables are temporarily set to nil.\n\ As a result, a hook function cannot straightforwardly alter the value of\n\ these variables. See the Emacs Lisp manual for a way of\n\ accomplishing an equivalent result by using other variables."); Vbefore_change_function = Qnil; DEFVAR_LISP ("after-change-function", &Vafter_change_function, "Function to call after each text change.\n\ Three arguments are passed to the function: the positions of\n\ the beginning and end of the range of changed text,\n\ and the length of the pre-change text replaced by that range.\n\ \(For an insertion, the pre-change length is zero;\n\ for a deletion, that length is the number of characters deleted,\n\ and the post-change beginning and end are at the same place.)\n\ \n\ Buffer changes made while executing the `after-change-function'\n\ don't call any before-change or after-change functions.\n\ That's because these variables are temporarily set to nil.\n\ As a result, a hook function cannot straightforwardly alter the value of\n\ these variables. See the Emacs Lisp manual for a way of\n\ accomplishing an equivalent result by using other variables."); Vafter_change_function = Qnil; DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions, "List of functions to call before each text change.\n\ Two arguments are passed to each function: the positions of\n\ the beginning and end of the range of old text to be changed.\n\ \(For an insertion, the beginning and end are at the same place.)\n\ No information is given about the length of the text after the change.\n\ \n\ Buffer changes made while executing the `before-change-functions'\n\ don't call any before-change or after-change functions.\n\ That's because these variables are temporarily set to nil.\n\ As a result, a hook function cannot straightforwardly alter the value of\n\ these variables. See the Emacs Lisp manual for a way of\n\ accomplishing an equivalent result by using other variables."); Vbefore_change_functions = Qnil; DEFVAR_LISP ("after-change-functions", &Vafter_change_functions, "List of function to call after each text change.\n\ Three arguments are passed to each function: the positions of\n\ the beginning and end of the range of changed text,\n\ and the length of the pre-change text replaced by that range.\n\ \(For an insertion, the pre-change length is zero;\n\ for a deletion, that length is the number of characters deleted,\n\ and the post-change beginning and end are at the same place.)\n\ \n\ Buffer changes made while executing the `after-change-functions'\n\ don't call any before-change or after-change functions.\n\ That's because these variables are temporarily set to nil.\n\ As a result, a hook function cannot straightforwardly alter the value of\n\ these variables. See the Emacs Lisp manual for a way of\n\ accomplishing an equivalent result by using other variables."); Vafter_change_functions = Qnil; DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook, "A list of functions to call before changing a buffer which is unmodified.\n\ The functions are run using the `run-hooks' function."); Vfirst_change_hook = Qnil; #if 0 /* The doc string is too long for some compilers, but make-docfile can find it in this comment. */ DEFVAR_PER_BUFFER ("buffer-undo-list", ¤t_buffer->undo_list, Qnil, "List of undo entries in current buffer.\n\ Recent changes come first; older changes follow newer.\n\ \n\ An entry (BEG . END) represents an insertion which begins at\n\ position BEG and ends at position END.\n\ \n\ An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\ from (abs POSITION). If POSITION is positive, point was at the front\n\ of the text being deleted; if negative, point was at the end.\n\ \n\ An entry (t HIGH . LOW) indicates that the buffer previously had\n\ \"unmodified\" status. HIGH and LOW are the high and low 16-bit portions\n\ of the visited file's modification time, as of that time. If the\n\ modification time of the most recent save is different, this entry is\n\ obsolete.\n\ \n\ An entry (nil PROPERTY VALUE BEG . END) indicates that a text property\n\ was modified between BEG and END. PROPERTY is the property name,\n\ and VALUE is the old value.\n\ \n\ An entry of the form POSITION indicates that point was at the buffer\n\ location given by the integer. Undoing an entry of this form places\n\ point at POSITION.\n\ \n\ nil marks undo boundaries. The undo command treats the changes\n\ between two undo boundaries as a single step to be undone.\n\ \n\ If the value of the variable is t, undo information is not recorded."); #endif DEFVAR_PER_BUFFER ("buffer-undo-list", ¤t_buffer->undo_list, Qnil, 0); DEFVAR_PER_BUFFER ("mark-active", ¤t_buffer->mark_active, Qnil, "Non-nil means the mark and region are currently active in this buffer.\n\ Automatically local in all buffers."); DEFVAR_PER_BUFFER ("cache-long-line-scans", ¤t_buffer->cache_long_line_scans, Qnil, "Non-nil means that Emacs should use caches to handle long lines more quickly.\n\ This variable is buffer-local, in all buffers.\n\ \n\ Normally, the line-motion functions work by scanning the buffer for\n\ newlines. Columnar operations (like move-to-column and\n\ compute-motion) also work by scanning the buffer, summing character\n\ widths as they go. This works well for ordinary text, but if the\n\ buffer's lines are very long (say, more than 500 characters), these\n\ motion functions will take longer to execute. Emacs may also take\n\ longer to update the display.\n\ \n\ If cache-long-line-scans is non-nil, these motion functions cache the\n\ results of their scans, and consult the cache to avoid rescanning\n\ regions of the buffer until the text is modified. The caches are most\n\ beneficial when they prevent the most searching---that is, when the\n\ buffer contains long lines and large regions of characters with the\n\ same, fixed screen width.\n\ \n\ When cache-long-line-scans is non-nil, processing short lines will\n\ become slightly slower (because of the overhead of consulting the\n\ cache), and the caches will use memory roughly proportional to the\n\ number of newlines and characters whose screen width varies.\n\ \n\ The caches require no explicit maintenance; their accuracy is\n\ maintained internally by the Emacs primitives. Enabling or disabling\n\ the cache should not affect the behavior of any of the motion\n\ functions; it should only affect their performance."); DEFVAR_PER_BUFFER ("point-before-scroll", ¤t_buffer->point_before_scroll, Qnil, "Value of point before the last series of scroll operations, or nil."); DEFVAR_PER_BUFFER ("buffer-file-format", ¤t_buffer->file_format, Qnil, "List of formats to use when saving this buffer.\n\ Formats are defined by `format-alist'. This variable is\n\ set when a file is visited. Automatically local in all buffers."); DEFVAR_PER_BUFFER ("buffer-invisibility-spec", ¤t_buffer->invisibility_spec, Qnil, "Invisibility spec of this buffer.\n\ The default is t, which means that text is invisible\n\ if it has a non-nil `invisible' property.\n\ If the value is a list, a text character is invisible if its `invisible'\n\ property is an element in that list.\n\ If an element is a cons cell of the form (PROP . ELLIPSIS),\n\ then characters with property value PROP are invisible,\n\ and they have an ellipsis as well if ELLIPSIS is non-nil."); DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode, "*Non-nil means deactivate the mark when the buffer contents change."); Vtransient_mark_mode = Qnil; DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only, "*Non-nil means disregard read-only status of buffers or characters.\n\ If the value is t, disregard `buffer-read-only' and all `read-only'\n\ text properties. If the value is a list, disregard `buffer-read-only'\n\ and disregard a `read-only' text property if the property value\n\ is a member of the list."); Vinhibit_read_only = Qnil; DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions, "List of functions called with no args to query before killing a buffer."); Vkill_buffer_query_functions = Qnil; defsubr (&Sbuffer_list); defsubr (&Sget_buffer); defsubr (&Sget_file_buffer); defsubr (&Sget_buffer_create); defsubr (&Smake_indirect_buffer); defsubr (&Sgenerate_new_buffer_name); defsubr (&Sbuffer_name); /*defsubr (&Sbuffer_number);*/ defsubr (&Sbuffer_file_name); defsubr (&Sbuffer_base_buffer); defsubr (&Sbuffer_local_variables); defsubr (&Sbuffer_modified_p); defsubr (&Sset_buffer_modified_p); defsubr (&Sbuffer_modified_tick); defsubr (&Srename_buffer); defsubr (&Sother_buffer); defsubr (&Sbuffer_disable_undo); defsubr (&Sbuffer_enable_undo); defsubr (&Skill_buffer); defsubr (&Serase_buffer); defsubr (&Sset_buffer_major_mode); defsubr (&Sswitch_to_buffer); defsubr (&Spop_to_buffer); defsubr (&Scurrent_buffer); defsubr (&Sset_buffer); defsubr (&Sbarf_if_buffer_read_only); defsubr (&Sbury_buffer); defsubr (&Skill_all_local_variables); defsubr (&Soverlayp); defsubr (&Smake_overlay); defsubr (&Sdelete_overlay); defsubr (&Smove_overlay); defsubr (&Soverlay_start); defsubr (&Soverlay_end); defsubr (&Soverlay_buffer); defsubr (&Soverlay_properties); defsubr (&Soverlays_at); defsubr (&Soverlays_in); defsubr (&Snext_overlay_change); defsubr (&Sprevious_overlay_change); defsubr (&Soverlay_recenter); defsubr (&Soverlay_lists); defsubr (&Soverlay_get); defsubr (&Soverlay_put); } keys_of_buffer () { initial_define_key (control_x_map, 'b', "switch-to-buffer"); initial_define_key (control_x_map, 'k', "kill-buffer"); /* This must not be in syms_of_buffer, because Qdisabled is not initialized when that function gets called. */ Fput (intern ("erase-buffer"), Qdisabled, Qt); } emacs-19.30/src/bytecode.c100444 75424 1 54407 6002600575 14065 0ustar kwzhdaemon/* Execution of byte code produced by bytecomp.el. Copyright (C) 1985, 1986, 1987, 1988, 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. hacked on by jwz@lucid.com 17-jun-91 o added a compile-time switch to turn on simple sanity checking; o put back the obsolete byte-codes for error-detection; o added a new instruction, unbind_all, which I will use for tail-recursion elimination; o made temp_output_buffer_show be called with the right number of args; o made the new bytecodes be called with args in the right order; o added metering support. by Hallvard: o added relative jump instructions; o all conditionals now only do QUIT if they jump. */ #include #include "lisp.h" #include "buffer.h" #include "syntax.h" /* * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for * debugging the byte compiler...) * * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. */ /* #define BYTE_CODE_SAFE */ /* #define BYTE_CODE_METER */ #ifdef BYTE_CODE_METER Lisp_Object Vbyte_code_meter, Qbyte_code_meter; int byte_metering_on; #define METER_2(code1, code2) \ XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \ ->contents[(code2)]) #define METER_1(code) METER_2 (0, (code)) #define METER_CODE(last_code, this_code) \ { \ if (byte_metering_on) \ { \ if (METER_1 (this_code) != ((1<contents; #ifdef BYTE_CODE_SAFE register int const_length = XVECTOR (vector)->size; #endif /* Copy of BYTESTR, saved so we can tell if BYTESTR was relocated. */ Lisp_Object string_saved; /* Cached address of beginning of string, valid if BYTESTR equals STRING_SAVED. */ register unsigned char *strbeg; CHECK_STRING (bytestr, 0); if (!VECTORP (vector)) vector = wrong_type_argument (Qvectorp, vector); CHECK_NUMBER (maxdepth, 2); stackp = (Lisp_Object *) alloca (XFASTINT (maxdepth) * sizeof (Lisp_Object)); bzero (stackp, XFASTINT (maxdepth) * sizeof (Lisp_Object)); GCPRO3 (bytestr, vector, *stackp); gcpro3.nvars = XFASTINT (maxdepth); --stackp; stack = stackp; stacke = stackp + XFASTINT (maxdepth); /* Initialize the saved pc-pointer for fetching from the string. */ string_saved = bytestr; pc = XSTRING (string_saved)->data; while (1) { #ifdef BYTE_CODE_SAFE if (stackp > stacke) error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d", pc - XSTRING (string_saved)->data, stacke - stackp); if (stackp < stack) error ("Byte code stack underflow (byte compiler bug), pc %d", pc - XSTRING (string_saved)->data); #endif if (! EQ (string_saved, bytestr)) { pc = pc - XSTRING (string_saved)->data + XSTRING (bytestr)->data; string_saved = bytestr; } #ifdef BYTE_CODE_METER prev_op = this_op; this_op = op = FETCH; METER_CODE (prev_op, op); switch (op) #else switch (op = FETCH) #endif { case Bvarref+6: op = FETCH; goto varref; case Bvarref+7: op = FETCH2; goto varref; case Bvarref: case Bvarref+1: case Bvarref+2: case Bvarref+3: case Bvarref+4: case Bvarref+5: op = op - Bvarref; varref: v1 = vectorp[op]; if (!SYMBOLP (v1)) v2 = Fsymbol_value (v1); else { v2 = XSYMBOL (v1)->value; if (MISCP (v2) || EQ (v2, Qunbound)) v2 = Fsymbol_value (v1); } PUSH (v2); break; case Bvarset+6: op = FETCH; goto varset; case Bvarset+7: op = FETCH2; goto varset; case Bvarset: case Bvarset+1: case Bvarset+2: case Bvarset+3: case Bvarset+4: case Bvarset+5: op -= Bvarset; varset: Fset (vectorp[op], POP); break; case Bvarbind+6: op = FETCH; goto varbind; case Bvarbind+7: op = FETCH2; goto varbind; case Bvarbind: case Bvarbind+1: case Bvarbind+2: case Bvarbind+3: case Bvarbind+4: case Bvarbind+5: op -= Bvarbind; varbind: specbind (vectorp[op], POP); break; case Bcall+6: op = FETCH; goto docall; case Bcall+7: op = FETCH2; goto docall; case Bcall: case Bcall+1: case Bcall+2: case Bcall+3: case Bcall+4: case Bcall+5: op -= Bcall; docall: DISCARD (op); #ifdef BYTE_CODE_METER if (byte_metering_on && SYMBOLP (TOP)) { v1 = TOP; v2 = Fget (v1, Qbyte_code_meter); if (INTEGERP (v2) && XINT (v2) != ((1<data + op; break; case Bgotoifnil: op = FETCH2; if (NILP (POP)) { QUIT; pc = XSTRING (string_saved)->data + op; } break; case Bgotoifnonnil: op = FETCH2; if (!NILP (POP)) { QUIT; pc = XSTRING (string_saved)->data + op; } break; case Bgotoifnilelsepop: op = FETCH2; if (NILP (TOP)) { QUIT; pc = XSTRING (string_saved)->data + op; } else DISCARD (1); break; case Bgotoifnonnilelsepop: op = FETCH2; if (!NILP (TOP)) { QUIT; pc = XSTRING (string_saved)->data + op; } else DISCARD (1); break; case BRgoto: QUIT; pc += *pc - 127; break; case BRgotoifnil: if (NILP (POP)) { QUIT; pc += *pc - 128; } pc++; break; case BRgotoifnonnil: if (!NILP (POP)) { QUIT; pc += *pc - 128; } pc++; break; case BRgotoifnilelsepop: op = *pc++; if (NILP (TOP)) { QUIT; pc += op - 128; } else DISCARD (1); break; case BRgotoifnonnilelsepop: op = *pc++; if (!NILP (TOP)) { QUIT; pc += op - 128; } else DISCARD (1); break; case Breturn: v1 = POP; goto exit; case Bdiscard: DISCARD (1); break; case Bdup: v1 = TOP; PUSH (v1); break; case Bconstant2: PUSH (vectorp[FETCH2]); break; case Bsave_excursion: record_unwind_protect (save_excursion_restore, save_excursion_save ()); break; case Bsave_window_excursion: TOP = Fsave_window_excursion (TOP); break; case Bsave_restriction: record_unwind_protect (save_restriction_restore, save_restriction_save ()); break; case Bcatch: v1 = POP; TOP = internal_catch (TOP, Feval, v1); break; case Bunwind_protect: record_unwind_protect (0, POP); (specpdl_ptr - 1)->symbol = Qnil; break; case Bcondition_case: v1 = POP; v1 = Fcons (POP, v1); TOP = Fcondition_case (Fcons (TOP, v1)); break; case Btemp_output_buffer_setup: temp_output_buffer_setup (XSTRING (TOP)->data); TOP = Vstandard_output; break; case Btemp_output_buffer_show: v1 = POP; temp_output_buffer_show (TOP); TOP = v1; /* pop binding of standard-output */ unbind_to (specpdl_ptr - specpdl - 1, Qnil); break; case Bnth: v1 = POP; v2 = TOP; nth_entry: CHECK_NUMBER (v2, 0); op = XINT (v2); immediate_quit = 1; while (--op >= 0) { if (CONSP (v1)) v1 = XCONS (v1)->cdr; else if (!NILP (v1)) { immediate_quit = 0; v1 = wrong_type_argument (Qlistp, v1); immediate_quit = 1; op++; } } immediate_quit = 0; goto docar; case Bsymbolp: TOP = SYMBOLP (TOP) ? Qt : Qnil; break; case Bconsp: TOP = CONSP (TOP) ? Qt : Qnil; break; case Bstringp: TOP = STRINGP (TOP) ? Qt : Qnil; break; case Blistp: TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil; break; case Beq: v1 = POP; TOP = EQ (v1, TOP) ? Qt : Qnil; break; case Bmemq: v1 = POP; TOP = Fmemq (TOP, v1); break; case Bnot: TOP = NILP (TOP) ? Qt : Qnil; break; case Bcar: v1 = TOP; docar: if (CONSP (v1)) TOP = XCONS (v1)->car; else if (NILP (v1)) TOP = Qnil; else Fcar (wrong_type_argument (Qlistp, v1)); break; case Bcdr: v1 = TOP; if (CONSP (v1)) TOP = XCONS (v1)->cdr; else if (NILP (v1)) TOP = Qnil; else Fcdr (wrong_type_argument (Qlistp, v1)); break; case Bcons: v1 = POP; TOP = Fcons (TOP, v1); break; case Blist1: TOP = Fcons (TOP, Qnil); break; case Blist2: v1 = POP; TOP = Fcons (TOP, Fcons (v1, Qnil)); break; case Blist3: DISCARD (2); TOP = Flist (3, &TOP); break; case Blist4: DISCARD (3); TOP = Flist (4, &TOP); break; case BlistN: op = FETCH; DISCARD (op - 1); TOP = Flist (op, &TOP); break; case Blength: TOP = Flength (TOP); break; case Baref: v1 = POP; TOP = Faref (TOP, v1); break; case Baset: v2 = POP; v1 = POP; TOP = Faset (TOP, v1, v2); break; case Bsymbol_value: TOP = Fsymbol_value (TOP); break; case Bsymbol_function: TOP = Fsymbol_function (TOP); break; case Bset: v1 = POP; TOP = Fset (TOP, v1); break; case Bfset: v1 = POP; TOP = Ffset (TOP, v1); break; case Bget: v1 = POP; TOP = Fget (TOP, v1); break; case Bsubstring: v2 = POP; v1 = POP; TOP = Fsubstring (TOP, v1, v2); break; case Bconcat2: DISCARD (1); TOP = Fconcat (2, &TOP); break; case Bconcat3: DISCARD (2); TOP = Fconcat (3, &TOP); break; case Bconcat4: DISCARD (3); TOP = Fconcat (4, &TOP); break; case BconcatN: op = FETCH; DISCARD (op - 1); TOP = Fconcat (op, &TOP); break; case Bsub1: v1 = TOP; if (INTEGERP (v1)) { XSETINT (v1, XINT (v1) - 1); TOP = v1; } else TOP = Fsub1 (v1); break; case Badd1: v1 = TOP; if (INTEGERP (v1)) { XSETINT (v1, XINT (v1) + 1); TOP = v1; } else TOP = Fadd1 (v1); break; case Beqlsign: v2 = POP; v1 = TOP; CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0); CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0); #ifdef LISP_FLOAT_TYPE if (FLOATP (v1) || FLOATP (v2)) { double f1, f2; f1 = (FLOATP (v1) ? XFLOAT (v1)->data : XINT (v1)); f2 = (FLOATP (v2) ? XFLOAT (v2)->data : XINT (v2)); TOP = (f1 == f2 ? Qt : Qnil); } else #endif TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil); break; case Bgtr: v1 = POP; TOP = Fgtr (TOP, v1); break; case Blss: v1 = POP; TOP = Flss (TOP, v1); break; case Bleq: v1 = POP; TOP = Fleq (TOP, v1); break; case Bgeq: v1 = POP; TOP = Fgeq (TOP, v1); break; case Bdiff: DISCARD (1); TOP = Fminus (2, &TOP); break; case Bnegate: v1 = TOP; if (INTEGERP (v1)) { XSETINT (v1, - XINT (v1)); TOP = v1; } else TOP = Fminus (1, &TOP); break; case Bplus: DISCARD (1); TOP = Fplus (2, &TOP); break; case Bmax: DISCARD (1); TOP = Fmax (2, &TOP); break; case Bmin: DISCARD (1); TOP = Fmin (2, &TOP); break; case Bmult: DISCARD (1); TOP = Ftimes (2, &TOP); break; case Bquo: DISCARD (1); TOP = Fquo (2, &TOP); break; case Brem: v1 = POP; TOP = Frem (TOP, v1); break; case Bpoint: XSETFASTINT (v1, point); PUSH (v1); break; case Bgoto_char: TOP = Fgoto_char (TOP); break; case Binsert: TOP = Finsert (1, &TOP); break; case BinsertN: op = FETCH; DISCARD (op - 1); TOP = Finsert (op, &TOP); break; case Bpoint_max: XSETFASTINT (v1, ZV); PUSH (v1); break; case Bpoint_min: XSETFASTINT (v1, BEGV); PUSH (v1); break; case Bchar_after: TOP = Fchar_after (TOP); break; case Bfollowing_char: v1 = Ffollowing_char (); PUSH (v1); break; case Bpreceding_char: v1 = Fprevious_char (); PUSH (v1); break; case Bcurrent_column: XSETFASTINT (v1, current_column ()); PUSH (v1); break; case Bindent_to: TOP = Findent_to (TOP, Qnil); break; case Beolp: PUSH (Feolp ()); break; case Beobp: PUSH (Feobp ()); break; case Bbolp: PUSH (Fbolp ()); break; case Bbobp: PUSH (Fbobp ()); break; case Bcurrent_buffer: PUSH (Fcurrent_buffer ()); break; case Bset_buffer: TOP = Fset_buffer (TOP); break; case Bread_char: PUSH (Fread_char ()); QUIT; break; case Binteractive_p: PUSH (Finteractive_p ()); break; case Bforward_char: TOP = Fforward_char (TOP); break; case Bforward_word: TOP = Fforward_word (TOP); break; case Bskip_chars_forward: v1 = POP; TOP = Fskip_chars_forward (TOP, v1); break; case Bskip_chars_backward: v1 = POP; TOP = Fskip_chars_backward (TOP, v1); break; case Bforward_line: TOP = Fforward_line (TOP); break; case Bchar_syntax: CHECK_NUMBER (TOP, 0); XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (XINT (TOP))]); break; case Bbuffer_substring: v1 = POP; TOP = Fbuffer_substring (TOP, v1); break; case Bdelete_region: v1 = POP; TOP = Fdelete_region (TOP, v1); break; case Bnarrow_to_region: v1 = POP; TOP = Fnarrow_to_region (TOP, v1); break; case Bwiden: PUSH (Fwiden ()); break; case Bend_of_line: TOP = Fend_of_line (TOP); break; case Bset_marker: v1 = POP; v2 = POP; TOP = Fset_marker (TOP, v2, v1); break; case Bmatch_beginning: TOP = Fmatch_beginning (TOP); break; case Bmatch_end: TOP = Fmatch_end (TOP); break; case Bupcase: TOP = Fupcase (TOP); break; case Bdowncase: TOP = Fdowncase (TOP); break; case Bstringeqlsign: v1 = POP; TOP = Fstring_equal (TOP, v1); break; case Bstringlss: v1 = POP; TOP = Fstring_lessp (TOP, v1); break; case Bequal: v1 = POP; TOP = Fequal (TOP, v1); break; case Bnthcdr: v1 = POP; TOP = Fnthcdr (TOP, v1); break; case Belt: if (CONSP (TOP)) { /* Exchange args and then do nth. */ v2 = POP; v1 = TOP; goto nth_entry; } v1 = POP; TOP = Felt (TOP, v1); break; case Bmember: v1 = POP; TOP = Fmember (TOP, v1); break; case Bassq: v1 = POP; TOP = Fassq (TOP, v1); break; case Bnreverse: TOP = Fnreverse (TOP); break; case Bsetcar: v1 = POP; TOP = Fsetcar (TOP, v1); break; case Bsetcdr: v1 = POP; TOP = Fsetcdr (TOP, v1); break; case Bcar_safe: v1 = TOP; if (CONSP (v1)) TOP = XCONS (v1)->car; else TOP = Qnil; break; case Bcdr_safe: v1 = TOP; if (CONSP (v1)) TOP = XCONS (v1)->cdr; else TOP = Qnil; break; case Bnconc: DISCARD (1); TOP = Fnconc (2, &TOP); break; case Bnumberp: TOP = (NUMBERP (TOP) ? Qt : Qnil); break; case Bintegerp: TOP = INTEGERP (TOP) ? Qt : Qnil; break; #ifdef BYTE_CODE_SAFE case Bset_mark: error ("set-mark is an obsolete bytecode"); break; case Bscan_buffer: error ("scan-buffer is an obsolete bytecode"); break; case Bmark: error ("mark is an obsolete bytecode"); break; #endif default: #ifdef BYTE_CODE_SAFE if (op < Bconstant) error ("unknown bytecode %d (byte compiler bug)", op); if ((op -= Bconstant) >= const_length) error ("no constant number %d (byte compiler bug)", op); PUSH (vectorp[op]); #else PUSH (vectorp[op - Bconstant]); #endif } } exit: UNGCPRO; /* Binds and unbinds are supposed to be compiled balanced. */ if (specpdl_ptr - specpdl != count) #ifdef BYTE_CODE_SAFE error ("binding stack not balanced (serious byte compiler bug)"); #else abort (); #endif return v1; } syms_of_bytecode () { Qbytecode = intern ("byte-code"); staticpro (&Qbytecode); defsubr (&Sbyte_code); #ifdef BYTE_CODE_METER DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter, "A vector of vectors which holds a histogram of byte-code usage.\n\ (aref (aref byte-code-meter 0) CODE) indicates how many times the byte\n\ opcode CODE has been executed.\n\ (aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,\n\ indicates how many times the byte opcodes CODE1 and CODE2 have been\n\ executed in succession."); DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, "If non-nil, keep profiling information on byte code usage.\n\ The variable byte-code-meter indicates how often each byte opcode is used.\n\ If a symbol has a property named `byte-code-meter' whose value is an\n\ integer, it is incremented each time that symbol's function is called."); byte_metering_on = 0; Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0)); Qbyte_code_meter = intern ("byte-code-meter"); staticpro (&Qbyte_code_meter); { int i = 256; while (i--) XVECTOR (Vbyte_code_meter)->contents[i] = Fmake_vector (make_number (256), make_number (0)); } #endif } emacs-19.30/src/callint.c100444 12120 1 60356 6050571062 13514 0ustar rmsdaemon/* Call a Lisp function interactively. Copyright (C) 1985, 1986, 1993, 1994, 1995 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. */ #include #include "lisp.h" #include "buffer.h" #include "commands.h" #include "keyboard.h" #include "window.h" #include "mocklisp.h" extern char *index (); Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus; Lisp_Object Qcall_interactively; Lisp_Object Vcommand_history; Lisp_Object Vcommand_debug_status, Qcommand_debug_status; Lisp_Object Qenable_recursive_minibuffers; /* Non-nil means treat the mark as active even if mark_active is 0. */ Lisp_Object Vmark_even_if_inactive; Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook; Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion; static Lisp_Object preserved_fns; /* Marker used within call-interactively to refer to point. */ static Lisp_Object point_marker; /* Buffer for the prompt text used in Fcall_interactively. */ static char *callint_message; /* Allocated length of that buffer. */ static int callint_message_size; /* This comment supplies the doc string for interactive, for make-docfile to see. We cannot put this in the real DEFUN due to limits in the Unix cpp. DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0, "Specify a way of parsing arguments for interactive use of a function.\n\ For example, write\n\ (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\ to make ARG be the prefix argument when `foo' is called as a command.\n\ The \"call\" to `interactive' is actually a declaration rather than a function;\n\ it tells `call-interactively' how to read arguments\n\ to pass to the function.\n\ When actually called, `interactive' just returns nil.\n\ \n\ The argument of `interactive' is usually a string containing a code letter\n\ followed by a prompt. (Some code letters do not use I/O to get\n\ the argument and do not need prompts.) To prompt for multiple arguments,\n\ give a code letter, its prompt, a newline, and another code letter, etc.\n\ Prompts are passed to format, and may use % escapes to print the\n\ arguments that have already been read.\n\ If the argument is not a string, it is evaluated to get a list of\n\ arguments to pass to the function.\n\ Just `(interactive)' means pass no args when calling interactively.\n\ \nCode letters available are:\n\ a -- Function name: symbol with a function definition.\n\ b -- Name of existing buffer.\n\ B -- Name of buffer, possibly nonexistent.\n\ c -- Character.\n\ C -- Command name: symbol with interactive function definition.\n\ d -- Value of point as number. Does not do I/O.\n\ D -- Directory name.\n\ e -- Parametrized event (i.e., one that's a list) that invoked this command.\n\ If used more than once, the Nth `e' returns the Nth parameterized event.\n\ This skips events that are integers or symbols.\n\ f -- Existing file name.\n\ F -- Possibly nonexistent file name.\n\ k -- Key sequence (downcase the last event if needed to get a definition).\n\ K -- Key sequence to be redefined (do not downcase the last event).\n\ m -- Value of mark as number. Does not do I/O.\n\ n -- Number read using minibuffer.\n\ N -- Raw prefix arg, or if none, do like code `n'.\n\ p -- Prefix arg converted to number. Does not do I/O.\n\ P -- Prefix arg in raw form. Does not do I/O.\n\ r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\ s -- Any string.\n\ S -- Any symbol.\n\ v -- Variable name: symbol that is user-variable-p.\n\ x -- Lisp expression read but not evaluated.\n\ X -- Lisp expression read and evaluated.\n\ In addition, if the string begins with `*'\n\ then an error is signaled if the buffer is read-only.\n\ This happens before reading any arguments.\n\ If the string begins with `@', then Emacs searches the key sequence\n\ which invoked the command for its first mouse click (or any other\n\ event which specifies a window), and selects that window before\n\ reading any arguments. You may use both `@' and `*'; they are\n\ processed in the order that they appear." */ /* ARGSUSED */ DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0, 0 /* See immediately above */) (args) Lisp_Object args; { return Qnil; } /* Quotify EXP: if EXP is constant, return it. If EXP is not constant, return (quote EXP). */ Lisp_Object quotify_arg (exp) register Lisp_Object exp; { if (!INTEGERP (exp) && !STRINGP (exp) && !NILP (exp) && !EQ (exp, Qt)) return Fcons (Qquote, Fcons (exp, Qnil)); return exp; } /* Modify EXP by quotifying each element (except the first). */ Lisp_Object quotify_args (exp) Lisp_Object exp; { register Lisp_Object tail; register struct Lisp_Cons *ptr; for (tail = exp; CONSP (tail); tail = ptr->cdr) { ptr = XCONS (tail); ptr->car = quotify_arg (ptr->car); } return exp; } char *callint_argfuns[] = {"", "point", "mark", "region-beginning", "region-end"}; static void check_mark () { Lisp_Object tem; tem = Fmarker_buffer (current_buffer->mark); 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); } DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0, "Call FUNCTION, reading args according to its interactive calling specs.\n\ Return the value FUNCTION returns.\n\ The function contains a specification of how to do the argument reading.\n\ In the case of user-defined functions, this is specified by placing a call\n\ to the function `interactive' at the top level of the function body.\n\ See `interactive'.\n\ \n\ Optional second arg RECORD-FLAG non-nil\n\ means unconditionally put this command in the command-history.\n\ Otherwise, this is done only if an arg is read using the minibuffer.") (function, record, keys) Lisp_Object function, record, keys; { Lisp_Object *args, *visargs; unsigned char **argstrings; Lisp_Object fun; Lisp_Object funcar; Lisp_Object specs; Lisp_Object teml; Lisp_Object enable; int speccount = specpdl_ptr - specpdl; /* The index of the next element of this_command_keys to examine for the 'e' interactive code. */ int next_event; Lisp_Object prefix_arg; unsigned char *string; unsigned char *tem; /* If varies[i] > 0, the i'th argument shouldn't just have its value in this call quoted in the command history. It should be recorded as a call to the function named callint_argfuns[varies[i]]. */ int *varies; register int i, j; int count, foo; char prompt1[100]; char *tem1; int arg_from_tty = 0; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; int key_count; if (NILP (keys)) keys = this_command_keys, key_count = this_command_key_count; else { CHECK_VECTOR (keys, 3); key_count = XVECTOR (keys)->size; } /* Save this now, since use of minibuffer will clobber it. */ prefix_arg = Vcurrent_prefix_arg; retry: if (SYMBOLP (function)) enable = Fget (function, Qenable_recursive_minibuffers); fun = indirect_function (function); specs = Qnil; string = 0; /* Decode the kind of function. Either handle it and return, or go to `lose' if not interactive, or go to `retry' to specify a different function, or set either STRING or SPECS. */ if (SUBRP (fun)) { string = (unsigned char *) XSUBR (fun)->prompt; if (!string) { lose: function = wrong_type_argument (Qcommandp, function); goto retry; } if ((EMACS_INT) string == 1) /* Let SPECS (which is nil) be used as the args. */ string = 0; } else if (COMPILEDP (fun)) { if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE) goto lose; specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE]; } else if (!CONSP (fun)) goto lose; else if (funcar = Fcar (fun), EQ (funcar, Qautoload)) { GCPRO2 (function, prefix_arg); do_autoload (fun, function); UNGCPRO; goto retry; } else if (EQ (funcar, Qlambda)) { specs = Fassq (Qinteractive, Fcdr (Fcdr (fun))); if (NILP (specs)) goto lose; specs = Fcar (Fcdr (specs)); } else if (EQ (funcar, Qmocklisp)) { single_kboard_state (); return ml_apply (fun, Qinteractive); } else goto lose; /* If either specs or string is set to a string, use it. */ if (STRINGP (specs)) { /* Make a copy of string so that if a GC relocates specs, `string' will still be valid. */ string = (unsigned char *) alloca (XSTRING (specs)->size + 1); bcopy (XSTRING (specs)->data, string, XSTRING (specs)->size + 1); } else if (string == 0) { Lisp_Object input; i = num_input_chars; input = specs; /* Compute the arg values using the user's expression. */ specs = Feval (specs); if (i != num_input_chars || !NILP (record)) { /* We should record this command on the command history. */ Lisp_Object values, car; /* Make a copy of the list of values, for the command history, and turn them into things we can eval. */ values = quotify_args (Fcopy_sequence (specs)); /* If the list of args was produced with an explicit call to `list', look for elements that were computed with (region-beginning) or (region-end), and put those expressions into VALUES instead of the present values. */ if (CONSP (input)) { car = XCONS (input)->car; /* Skip through certain special forms. */ while (EQ (car, Qlet) || EQ (car, Qletx) || EQ (car, Qsave_excursion)) { while (CONSP (XCONS (input)->cdr)) input = XCONS (input)->cdr; input = XCONS (input)->car; if (!CONSP (input)) break; car = XCONS (input)->car; } if (EQ (car, Qlist)) { Lisp_Object intail, valtail; for (intail = Fcdr (input), valtail = values; CONSP (valtail); intail = Fcdr (intail), valtail = Fcdr (valtail)) { Lisp_Object elt; elt = Fcar (intail); if (CONSP (elt)) { Lisp_Object presflag; presflag = Fmemq (Fcar (elt), preserved_fns); if (!NILP (presflag)) Fsetcar (valtail, Fcar (intail)); } } } } Vcommand_history = Fcons (Fcons (function, values), Vcommand_history); } single_kboard_state (); return apply1 (function, specs); } /* Here if function specifies a string to control parsing the defaults */ /* Set next_event to point to the first event with parameters. */ for (next_event = 0; next_event < key_count; next_event++) if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event])) break; /* Handle special starting chars `*' and `@'. Also `-'. */ /* Note that `+' is reserved for user extensions. */ while (1) { if (*string == '+') error ("`+' is not used in `interactive' for ordinary commands"); else if (*string == '*') { string++; if (!NILP (current_buffer->read_only)) Fbarf_if_buffer_read_only (); } /* Ignore this for semi-compatibility with Lucid. */ else if (*string == '-') string++; else if (*string == '@') { Lisp_Object event; event = XVECTOR (keys)->contents[next_event]; if (EVENT_HAS_PARAMETERS (event) && (event = XCONS (event)->cdr, CONSP (event)) && (event = XCONS (event)->car, CONSP (event)) && (event = XCONS (event)->car, WINDOWP (event))) { if (MINI_WINDOW_P (XWINDOW (event)) && ! (minibuf_level > 0 && EQ (event, minibuf_window))) error ("Attempt to select inactive minibuffer window"); /* If the current buffer wants to clean up, let it. */ if (!NILP (Vmouse_leave_buffer_hook)) call1 (Vrun_hooks, Qmouse_leave_buffer_hook); Fselect_window (event); } string++; } else break; } /* Count the number of arguments the interactive spec would have us give to the function. */ tem = string; for (j = 0; *tem; j++) { /* 'r' specifications ("point and mark as 2 numeric args") produce *two* arguments. */ if (*tem == 'r') j++; tem = (unsigned char *) index (tem, '\n'); if (tem) tem++; else tem = (unsigned char *) ""; } count = j; args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object)); visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object)); argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *)); varies = (int *) alloca ((count + 1) * sizeof (int)); for (i = 0; i < (count + 1); i++) { args[i] = Qnil; visargs[i] = Qnil; varies[i] = 0; } GCPRO4 (prefix_arg, function, *args, *visargs); gcpro3.nvars = (count + 1); gcpro4.nvars = (count + 1); if (!NILP (enable)) specbind (Qenable_recursive_minibuffers, Qt); tem = string; for (i = 1; *tem; i++) { strncpy (prompt1, tem + 1, sizeof prompt1 - 1); prompt1[sizeof prompt1 - 1] = 0; tem1 = index (prompt1, '\n'); if (tem1) *tem1 = 0; /* Fill argstrings with a vector of C strings corresponding to the Lisp strings in visargs. */ for (j = 1; j < i; j++) argstrings[j] = EQ (visargs[j], Qnil) ? (unsigned char *) "" : XSTRING (visargs[j])->data; /* Process the format-string in prompt1, putting the output into callint_message. Make callint_message bigger if necessary. We don't use a buffer on the stack, because the contents need to stay stable for a while. */ while (1) { int nchars = doprnt (callint_message, callint_message_size, prompt1, (char *)0, j - 1, argstrings + 1); if (nchars < callint_message_size) break; callint_message_size *= 2; callint_message = (char *) xrealloc (callint_message, callint_message_size); } switch (*tem) { case 'a': /* Symbol defined as a function */ visargs[i] = Fcompleting_read (build_string (callint_message), Vobarray, Qfboundp, Qt, Qnil, Qnil); /* Passing args[i] directly stimulates compiler bug */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); break; case 'b': /* Name of existing buffer */ args[i] = Fcurrent_buffer (); if (EQ (selected_window, minibuf_window)) args[i] = Fother_buffer (args[i], Qnil); args[i] = Fread_buffer (build_string (callint_message), args[i], Qt); break; case 'B': /* Name of buffer, possibly nonexistent */ args[i] = Fread_buffer (build_string (callint_message), Fother_buffer (Fcurrent_buffer (), Qnil), Qnil); break; case 'c': /* Character */ message1 (callint_message); args[i] = Fread_char (); /* Passing args[i] directly stimulates compiler bug */ teml = args[i]; visargs[i] = Fchar_to_string (teml); break; case 'C': /* Command: symbol with interactive function */ visargs[i] = Fcompleting_read (build_string (callint_message), Vobarray, Qcommandp, Qt, Qnil, Qnil); /* Passing args[i] directly stimulates compiler bug */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); break; case 'd': /* Value of point. Does not do I/O. */ Fset_marker (point_marker, make_number (PT), Qnil); args[i] = point_marker; /* visargs[i] = Qnil; */ varies[i] = 1; break; case 'D': /* Directory name. */ args[i] = Fread_file_name (build_string (callint_message), Qnil, current_buffer->directory, Qlambda, Qnil); break; case 'f': /* Existing file name. */ args[i] = Fread_file_name (build_string (callint_message), Qnil, Qnil, Qlambda, Qnil); break; case 'F': /* Possibly nonexistent file name. */ args[i] = Fread_file_name (build_string (callint_message), Qnil, Qnil, Qnil, Qnil); break; case 'k': /* Key sequence. */ args[i] = Fread_key_sequence (build_string (callint_message), Qnil, Qnil, Qnil); teml = args[i]; visargs[i] = Fkey_description (teml); break; case 'K': /* Key sequence to be defined. */ args[i] = Fread_key_sequence (build_string (callint_message), Qnil, Qt, Qnil); teml = args[i]; visargs[i] = Fkey_description (teml); break; case 'e': /* The invoking event. */ if (next_event >= key_count) error ("%s must be bound to an event with parameters", (SYMBOLP (function) ? (char *) XSYMBOL (function)->name->data : "command")); args[i] = XVECTOR (keys)->contents[next_event++]; varies[i] = -1; /* Find the next parameterized event. */ while (next_event < key_count && ! (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))) next_event++; break; case 'm': /* Value of mark. Does not do I/O. */ check_mark (); /* visargs[i] = Qnil; */ args[i] = current_buffer->mark; varies[i] = 2; break; case 'N': /* Prefix arg, else number from minibuffer */ if (!NILP (prefix_arg)) goto have_prefix_arg; case 'n': /* Read number from minibuffer. */ do args[i] = Fread_minibuffer (build_string (callint_message), Qnil); while (! NUMBERP (args[i])); visargs[i] = last_minibuf_string; break; case 'P': /* Prefix arg in raw form. Does no I/O. */ have_prefix_arg: args[i] = prefix_arg; /* visargs[i] = Qnil; */ varies[i] = -1; break; case 'p': /* Prefix arg converted to number. No I/O. */ args[i] = Fprefix_numeric_value (prefix_arg); /* visargs[i] = Qnil; */ varies[i] = -1; break; case 'r': /* Region, point and mark as 2 args. */ check_mark (); Fset_marker (point_marker, make_number (PT), Qnil); /* visargs[i+1] = Qnil; */ foo = marker_position (current_buffer->mark); /* visargs[i] = Qnil; */ args[i] = point < foo ? point_marker : current_buffer->mark; varies[i] = 3; args[++i] = point > foo ? point_marker : current_buffer->mark; varies[i] = 4; break; case 's': /* String read via minibuffer. */ args[i] = Fread_string (build_string (callint_message), Qnil, Qnil); break; case 'S': /* Any symbol. */ visargs[i] = Fread_string (build_string (callint_message), Qnil, Qnil); /* Passing args[i] directly stimulates compiler bug */ teml = visargs[i]; args[i] = Fintern (teml, Qnil); break; case 'v': /* Variable name: symbol that is user-variable-p. */ args[i] = Fread_variable (build_string (callint_message)); visargs[i] = last_minibuf_string; break; case 'x': /* Lisp expression read but not evaluated */ args[i] = Fread_minibuffer (build_string (callint_message), Qnil); visargs[i] = last_minibuf_string; break; case 'X': /* Lisp expression read and evaluated */ args[i] = Feval_minibuffer (build_string (callint_message), Qnil); visargs[i] = last_minibuf_string; break; /* We have a case for `+' so we get an error if anyone tries to define one here. */ case '+': default: error ("Invalid control letter `%c' (%03o) in interactive calling string", *tem, *tem); } if (varies[i] == 0) arg_from_tty = 1; if (NILP (visargs[i]) && STRINGP (args[i])) visargs[i] = args[i]; tem = (unsigned char *) index (tem, '\n'); if (tem) tem++; else tem = (unsigned char *) ""; } unbind_to (speccount, Qnil); QUIT; args[0] = function; if (arg_from_tty || !NILP (record)) { visargs[0] = function; for (i = 1; i < count + 1; i++) { if (varies[i] > 0) visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil); else visargs[i] = quotify_arg (args[i]); } Vcommand_history = Fcons (Flist (count + 1, visargs), Vcommand_history); } /* If we used a marker to hold point, mark, or an end of the region, temporarily, convert it to an integer now. */ for (i = 1; i <= count; i++) if (varies[i] >= 1 && varies[i] <= 4) XSETINT (args[i], marker_position (args[i])); single_kboard_state (); { Lisp_Object val; specbind (Qcommand_debug_status, Qnil); val = Ffuncall (count + 1, args); UNGCPRO; return unbind_to (speccount, val); } } DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value, 1, 1, 0, "Return numeric meaning of raw prefix argument ARG.\n\ A raw prefix argument is what you get from `(interactive \"P\")'.\n\ Its numeric meaning is what you would get from `(interactive \"p\")'.") (raw) Lisp_Object raw; { Lisp_Object val; if (NILP (raw)) XSETFASTINT (val, 1); else if (EQ (raw, Qminus)) XSETINT (val, -1); else if (CONSP (raw) && INTEGERP (XCONS (raw)->car)) XSETINT (val, XINT (XCONS (raw)->car)); else if (INTEGERP (raw)) val = raw; else XSETFASTINT (val, 1); return val; } syms_of_callint () { point_marker = Fmake_marker (); staticpro (&point_marker); preserved_fns = Fcons (intern ("region-beginning"), Fcons (intern ("region-end"), Fcons (intern ("point"), Fcons (intern ("mark"), Qnil)))); staticpro (&preserved_fns); Qlist = intern ("list"); staticpro (&Qlist); Qlet = intern ("let"); staticpro (&Qlet); Qletx = intern ("let*"); staticpro (&Qletx); Qsave_excursion = intern ("save-excursion"); staticpro (&Qsave_excursion); Qminus = intern ("-"); staticpro (&Qminus); Qplus = intern ("+"); staticpro (&Qplus); Qcall_interactively = intern ("call-interactively"); staticpro (&Qcall_interactively); Qcommand_debug_status = intern ("command-debug-status"); staticpro (&Qcommand_debug_status); Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers"); staticpro (&Qenable_recursive_minibuffers); Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook"); staticpro (&Qmouse_leave_buffer_hook); callint_message_size = 100; callint_message = (char *) xmalloc (callint_message_size); DEFVAR_KBOARD ("prefix-arg", Vprefix_arg, "The value of the prefix argument for the next editing command.\n\ It may be a number, or the symbol `-' for just a minus sign as arg,\n\ or a list whose car is a number for just one or more C-U's\n\ or nil if no argument has been specified.\n\ \n\ You cannot examine this variable to find the argument for this command\n\ since it has been set to nil by the time you can look.\n\ Instead, you should use the variable `current-prefix-arg', although\n\ normally commands can get this prefix argument with (interactive \"P\")."); DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg, "The value of the prefix argument for this editing command.\n\ It may be a number, or the symbol `-' for just a minus sign as arg,\n\ or a list whose car is a number for just one or more C-U's\n\ or nil if no argument has been specified.\n\ This is what `(interactive \"P\")' returns."); Vcurrent_prefix_arg = Qnil; DEFVAR_LISP ("command-history", &Vcommand_history, "List of recent commands that read arguments from terminal.\n\ Each command is represented as a form to evaluate."); Vcommand_history = Qnil; DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status, "Debugging status of current interactive command.\n\ Bound each time `call-interactively' is called;\n\ may be set by the debugger as a reminder for itself."); 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\ When the option is non-nil, deactivation of the mark\n\ turns off region highlighting, but commands that use the mark\n\ behave as if the mark were still active."); Vmark_even_if_inactive = Qnil; DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook, "Hook to run when about to switch windows with a mouse command.\n\ Its purpose is to give temporary modes such as Isearch mode\n\ a way to turn themselves off when a mouse command switches windows."); Vmouse_leave_buffer_hook = Qnil; defsubr (&Sinteractive); defsubr (&Scall_interactively); defsubr (&Sprefix_numeric_value); } emacs-19.30/src/callproc.c100444 12120 1 75742 6035300544 13670 0ustar rmsdaemon/* Synchronous subprocess invocation for GNU Emacs. Copyright (C) 1985, 86, 87, 88, 93, 94, 95 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. */ #include #include #include #include extern int errno; extern char *strerror (); /* Define SIGCHLD as an alias for SIGCLD. */ #if !defined (SIGCHLD) && defined (SIGCLD) #define SIGCHLD SIGCLD #endif /* SIGCLD */ #include #include #ifdef USG5 #define INCLUDED_FCNTL #include #endif #ifdef WINDOWSNT #define NOMINMAX #include #include /* for proper declaration of environ */ #include #include "nt.h" #define _P_NOWAIT 1 /* from process.h */ #endif #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ #include "msdos.h" #define INCLUDED_FCNTL #include #include #include #include #endif /* MSDOS */ #ifndef O_RDONLY #define O_RDONLY 0 #endif #ifndef O_WRONLY #define O_WRONLY 1 #endif #include "lisp.h" #include "commands.h" #include "buffer.h" #include #include "process.h" #include "syssignal.h" #include "systty.h" #ifdef VMS extern noshare char **environ; #else extern char **environ; #endif #define max(a, b) ((a) > (b) ? (a) : (b)) #ifdef DOS_NT /* When we are starting external processes we need to know whether they take binary input (no conversion) or text input (\n is converted to \r\n). Similar for output: if newlines are written as \r\n then it's text process output, otherwise it's binary. */ Lisp_Object Vbinary_process_input; Lisp_Object Vbinary_process_output; #endif /* DOS_NT */ Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, Vdoc_directory; Lisp_Object Vconfigure_info_directory; Lisp_Object Vshell_file_name; Lisp_Object Vprocess_environment; #ifdef DOS_NT Lisp_Object Qbuffer_file_type; #endif /* DOS_NT */ /* True iff we are about to fork off a synchronous process or if we are waiting for it. */ int synch_process_alive; /* Nonzero => this is a string explaining death of synchronous subprocess. */ char *synch_process_death; /* If synch_process_death is zero, this is exit code of synchronous subprocess. */ int synch_process_retcode; extern Lisp_Object Vdoc_file_name; /* Clean up when exiting Fcall_process. On MSDOS, delete the temporary file on any kind of termination. On Unix, kill the process and any children on termination by signal. */ /* Nonzero if this is termination due to exit. */ static int call_process_exited; #ifndef VMS /* VMS version is in vmsproc.c. */ static Lisp_Object call_process_kill (fdpid) Lisp_Object fdpid; { close (XFASTINT (Fcar (fdpid))); EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL); synch_process_alive = 0; return Qnil; } Lisp_Object call_process_cleanup (fdpid) Lisp_Object fdpid; { #ifdef MSDOS /* for MSDOS fdpid is really (fd . tempfile) */ register Lisp_Object file; file = Fcdr (fdpid); close (XFASTINT (Fcar (fdpid))); if (strcmp (XSTRING (file)-> data, NULL_DEVICE) != 0) unlink (XSTRING (file)->data); #else /* not MSDOS */ register int pid = XFASTINT (Fcdr (fdpid)); if (call_process_exited) { close (XFASTINT (Fcar (fdpid))); return Qnil; } if (EMACS_KILLPG (pid, SIGINT) == 0) { int count = specpdl_ptr - specpdl; record_unwind_protect (call_process_kill, fdpid); message1 ("Waiting for process to die...(type C-g again to kill it instantly)"); immediate_quit = 1; QUIT; wait_for_termination (pid); immediate_quit = 0; specpdl_ptr = specpdl + count; /* Discard the unwind protect. */ message1 ("Waiting for process to die...done"); } synch_process_alive = 0; close (XFASTINT (Fcar (fdpid))); #endif /* not MSDOS */ return Qnil; } DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0, "Call PROGRAM synchronously in separate process.\n\ The program's input comes from file INFILE (nil means `/dev/null').\n\ Insert output in BUFFER before point; t means current buffer;\n\ nil for BUFFER means discard it; 0 means discard and don't wait.\n\ BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\ REAL-BUFFER says what to do with standard output, as above,\n\ while STDERR-FILE says what to do with standard error in the child.\n\ STDERR-FILE may be nil (discard standard error output),\n\ t (mix it with ordinary output), or a file name string.\n\ \n\ Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\ Remaining arguments are strings passed as command arguments to PROGRAM.\n\ \n\ If BUFFER is 0, `call-process' returns immediately with value nil.\n\ Otherwise it waits for PROGRAM to terminate\n\ and returns a numeric exit status or a signal description string.\n\ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.") (nargs, args) int nargs; register Lisp_Object *args; { Lisp_Object infile, buffer, current_dir, display, path; int fd[2]; int filefd; register int pid; char buf[16384]; char *bufptr = buf; int bufsize = 16384; int count = specpdl_ptr - specpdl; register unsigned char **new_argv = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *)); struct buffer *old = current_buffer; /* File to use for stderr in the child. t means use same as standard output. */ Lisp_Object error_file; #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ char *outf, *tempfile; int outfilefd; #endif #if 0 int mask; #endif CHECK_STRING (args[0], 0); error_file = Qt; #ifndef subprocesses /* Without asynchronous processes we cannot have BUFFER == 0. */ if (nargs >= 3 && INTEGERP (args[2])) error ("Operating system cannot handle asynchronous subprocesses"); #endif /* subprocesses */ if (nargs >= 2 && ! NILP (args[1])) { infile = Fexpand_file_name (args[1], current_buffer->directory); CHECK_STRING (infile, 1); } else infile = build_string (NULL_DEVICE); if (nargs >= 3) { buffer = args[2]; /* If BUFFER is a list, its meaning is (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */ if (CONSP (buffer)) { if (CONSP (XCONS (buffer)->cdr)) error_file = Fexpand_file_name (XCONS (XCONS (buffer)->cdr)->car, Qnil); buffer = XCONS (buffer)->car; } if (!(EQ (buffer, Qnil) || EQ (buffer, Qt) || XFASTINT (buffer) == 0)) { Lisp_Object spec_buffer; spec_buffer = buffer; buffer = Fget_buffer (buffer); /* Mention the buffer name for a better error message. */ if (NILP (buffer)) CHECK_BUFFER (spec_buffer, 2); CHECK_BUFFER (buffer, 2); } } else buffer = Qnil; /* Make sure that the child will be able to chdir to the current buffer's current directory, or its unhandled equivalent. We can't just have the child check for an error when it does the chdir, since it's in a vfork. We have to GCPRO around this because Fexpand_file_name, Funhandled_file_name_directory, and Ffile_accessible_directory_p might call a file name handling function. The argument list is protected by the caller, so all we really have to worry about is buffer. */ { struct gcpro gcpro1, gcpro2, gcpro3; current_dir = current_buffer->directory; GCPRO3 (infile, buffer, current_dir); current_dir = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir), Qnil); if (NILP (Ffile_accessible_directory_p (current_dir))) report_file_error ("Setting current directory", Fcons (current_buffer->directory, Qnil)); UNGCPRO; } display = nargs >= 4 ? args[3] : Qnil; filefd = open (XSTRING (infile)->data, O_RDONLY, 0); if (filefd < 0) { report_file_error ("Opening process input file", Fcons (infile, Qnil)); } /* Search for program; barf if not found. */ { struct gcpro gcpro1; GCPRO1 (current_dir); openp (Vexec_path, args[0], EXEC_SUFFIXES, &path, 1); UNGCPRO; } if (NILP (path)) { close (filefd); report_file_error ("Searching for program", Fcons (args[0], Qnil)); } new_argv[0] = XSTRING (path)->data; { register int i; for (i = 4; i < nargs; i++) { CHECK_STRING (args[i], i); new_argv[i - 3] = XSTRING (args[i])->data; } new_argv[i - 3] = 0; } #ifdef MSDOS /* MW, July 1993 */ /* These vars record information from process termination. Clear them now before process can possibly terminate, to avoid timing error if process terminates soon. */ synch_process_death = 0; synch_process_retcode = 0; if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP"))) strcpy (tempfile = alloca (strlen (outf) + 20), outf); else { tempfile = alloca (20); *tempfile = '\0'; } dostounix_filename (tempfile); if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/') strcat (tempfile, "/"); strcat (tempfile, "detmp.XXX"); mktemp (tempfile); outfilefd = creat (tempfile, S_IREAD | S_IWRITE); if (outfilefd < 0) { close (filefd); report_file_error ("Opening process output file", Fcons (tempfile, Qnil)); } #endif if (INTEGERP (buffer)) fd[1] = open (NULL_DEVICE, O_WRONLY), fd[0] = -1; else { #ifndef MSDOS #ifdef WINDOWSNT pipe_with_inherited_out (fd); #else /* not WINDOWSNT */ pipe (fd); #endif /* not WINDOWSNT */ #endif #if 0 /* Replaced by close_process_descs */ set_exclusive_use (fd[0]); #endif } { /* child_setup must clobber environ in systems with true vfork. Protect it from permanent change. */ register char **save_environ = environ; register int fd1 = fd[1]; int fd_error = fd1; #if 0 /* Some systems don't have sigblock. */ mask = sigblock (sigmask (SIGCHLD)); #endif /* Record that we're about to create a synchronous process. */ synch_process_alive = 1; /* These vars record information from process termination. Clear them now before process can possibly terminate, to avoid timing error if process terminates soon. */ synch_process_death = 0; synch_process_retcode = 0; #ifdef MSDOS /* MW, July 1993 */ /* ??? Someone who knows MSDOG needs to check whether this properly closes all descriptors that it opens. */ pid = run_msdos_command (new_argv, current_dir, filefd, outfilefd); close (outfilefd); fd1 = -1; /* No harm in closing that one! */ fd[0] = open (tempfile, NILP (Vbinary_process_output) ? O_TEXT : O_BINARY); if (fd[0] < 0) { unlink (tempfile); close (filefd); report_file_error ("Cannot re-open temporary file", Qnil); } #else /* not MSDOS */ if (NILP (error_file)) fd_error = open (NULL_DEVICE, O_WRONLY); else if (STRINGP (error_file)) { #ifdef DOS_NT fd_error = open (XSTRING (error_file)->data, O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, S_IREAD | S_IWRITE); #else /* not DOS_NT */ fd_error = creat (XSTRING (error_file)->data, 0666); #endif /* not DOS_NT */ } if (fd_error < 0) { close (filefd); close (fd[0]); if (fd1 >= 0) close (fd1); report_file_error ("Cannot open", error_file); } #ifdef WINDOWSNT pid = child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir); #else /* not WINDOWSNT */ pid = vfork (); if (pid == 0) { if (fd[0] >= 0) close (fd[0]); #ifdef USG setpgrp (); #else setpgrp (pid, pid); #endif /* USG */ child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir); } #endif /* not MSDOS */ #endif /* not WINDOWSNT */ environ = save_environ; /* Close most of our fd's, but not fd[0] since we will use that to read input from. */ close (filefd); if (fd1 >= 0) close (fd1); } if (pid < 0) { if (fd[0] >= 0) close (fd[0]); report_file_error ("Doing vfork", Qnil); } if (INTEGERP (buffer)) { if (fd[0] >= 0) close (fd[0]); #ifndef subprocesses /* If Emacs has been built with asynchronous subprocess support, we don't need to do this, I think because it will then have the facilities for handling SIGCHLD. */ wait_without_blocking (); #endif /* subprocesses */ return Qnil; } /* Enable sending signal if user quits below. */ call_process_exited = 0; #ifdef MSDOS /* MSDOS needs different cleanup information. */ record_unwind_protect (call_process_cleanup, Fcons (make_number (fd[0]), build_string (tempfile))); #else record_unwind_protect (call_process_cleanup, Fcons (make_number (fd[0]), make_number (pid))); #endif /* not MSDOS */ if (BUFFERP (buffer)) Fset_buffer (buffer); immediate_quit = 1; QUIT; { register int nread; int first = 1; int total_read = 0; while (1) { /* Repeatedly read until we've filled as much as possible of the buffer size we have. But don't read less than 1024--save that for the next bufferfull. */ nread = 0; while (nread < bufsize - 1024) { int this_read = read (fd[0], bufptr + nread, bufsize - nread); if (this_read < 0) goto give_up; if (this_read == 0) goto give_up_1; nread += this_read; } give_up_1: /* Now NREAD is the total amount of data in the buffer. */ if (nread == 0) break; immediate_quit = 0; total_read += nread; if (!NILP (buffer)) insert (bufptr, nread); /* Make the buffer bigger as we continue to read more data, but not past 64k. */ if (bufsize < 64 * 1024 && total_read > 32 * bufsize) { bufsize *= 2; bufptr = (char *) alloca (bufsize); } if (!NILP (display) && INTERACTIVE) { if (first) prepare_menu_bars (); first = 0; redisplay_preserve_echo_area (); } immediate_quit = 1; QUIT; } give_up: ; } /* Wait for it to terminate, unless it already has. */ wait_for_termination (pid); immediate_quit = 0; set_buffer_internal (old); /* Don't kill any children that the subprocess may have left behind when exiting. */ call_process_exited = 1; unbind_to (count, Qnil); if (synch_process_death) return build_string (synch_process_death); return make_number (synch_process_retcode); } #endif static Lisp_Object delete_temp_file (name) Lisp_Object name; { /* Use Fdelete_file (indirectly) because that runs a file name handler. We did that when writing the file, so we should do so when deleting. */ internal_delete_file (name); } DEFUN ("call-process-region", Fcall_process_region, Scall_process_region, 3, MANY, 0, "Send text from START to END to a synchronous process running PROGRAM.\n\ Delete the text if fourth arg DELETE is non-nil.\n\ \n\ Insert output in BUFFER before point; t means current buffer;\n\ nil for BUFFER means discard it; 0 means discard and don't wait.\n\ BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\ REAL-BUFFER says what to do with standard output, as above,\n\ while STDERR-FILE says what to do with standard error in the child.\n\ STDERR-FILE may be nil (discard standard error output),\n\ t (mix it with ordinary output), or a file name string.\n\ \n\ Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\ Remaining args are passed to PROGRAM at startup as command args.\n\ \n\ If BUFFER is nil, `call-process-region' returns immediately with value nil.\n\ Otherwise it waits for PROGRAM to terminate\n\ and returns a numeric exit status or a signal description string.\n\ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.") (nargs, args) int nargs; register Lisp_Object *args; { struct gcpro gcpro1; Lisp_Object filename_string; register Lisp_Object start, end; #ifdef DOS_NT char *tempfile; #else char tempfile[20]; #endif int count = specpdl_ptr - specpdl; #ifdef DOS_NT char *outf = '\0'; if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP"))) strcpy (tempfile = alloca (strlen (outf) + 20), outf); else { tempfile = alloca (20); *tempfile = '\0'; } dostounix_filename (tempfile); if (!IS_DIRECTORY_SEP (tempfile[strlen (tempfile) - 1])) strcat (tempfile, "/"); #ifdef WINDOWSNT strcat (tempfile, "emXXXXXX"); #else strcat (tempfile, "detmp.XXX"); #endif #else /* not DOS_NT */ #ifdef VMS strcpy (tempfile, "tmp:emacsXXXXXX."); #else strcpy (tempfile, "/tmp/emacsXXXXXX"); #endif #endif /* not DOS_NT */ mktemp (tempfile); filename_string = build_string (tempfile); GCPRO1 (filename_string); start = args[0]; end = args[1]; #ifdef DOS_NT specbind (Qbuffer_file_type, Vbinary_process_input); Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil); unbind_to (count, Qnil); #else /* not DOS_NT */ Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil); #endif /* not DOS_NT */ record_unwind_protect (delete_temp_file, filename_string); if (!NILP (args[3])) Fdelete_region (start, end); args[3] = filename_string; RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs - 2, args + 2))); } #ifndef VMS /* VMS version is in vmsproc.c. */ /* This is the last thing run in a newly forked inferior either synchronous or asynchronous. Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2. Initialize inferior's priority, pgrp, connected dir and environment. then exec another program based on new_argv. This function may change environ for the superior process. Therefore, the superior process must save and restore the value of environ around the vfork and the call to this function. ENV is the environment for the subprocess. SET_PGRP is nonzero if we should put the subprocess into a separate process group. CURRENT_DIR is an elisp string giving the path of the current directory the subprocess should have. Since we can't really signal a decent error from within the child, this should be verified as an executable directory by the parent. */ child_setup (in, out, err, new_argv, set_pgrp, current_dir) int in, out, err; register char **new_argv; int set_pgrp; Lisp_Object current_dir; { #ifdef MSDOS /* The MSDOS port of gcc cannot fork, vfork, ... so we must call system instead. */ #else /* not MSDOS */ char **env; char *pwd_var; #ifdef WINDOWSNT int cpid; HANDLE handles[4]; #endif /* WINDOWSNT */ int pid = getpid (); #ifdef SET_EMACS_PRIORITY { extern int emacs_priority; if (emacs_priority < 0) nice (- emacs_priority); } #endif #ifdef subprocesses /* Close Emacs's descriptors that this process should not have. */ close_process_descs (); #endif close_load_descs (); /* Note that use of alloca is always safe here. It's obvious for systems that do not have true vfork or that have true (stack) alloca. If using vfork and C_ALLOCA it is safe because that changes the superior's static variables as if the superior had done alloca and will be cleaned up in the usual way. */ { register char *temp; register int i; i = XSTRING (current_dir)->size; pwd_var = (char *) alloca (i + 6); temp = pwd_var + 4; bcopy ("PWD=", pwd_var, 4); bcopy (XSTRING (current_dir)->data, temp, i); if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP; temp[i] = 0; /* We can't signal an Elisp error here; we're in a vfork. Since the callers check the current directory before forking, this should only return an error if the directory's permissions are changed between the check and this chdir, but we should at least check. */ if (chdir (temp) < 0) _exit (errno); /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */ while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1])) temp[--i] = 0; } /* Set `env' to a vector of the strings in Vprocess_environment. */ { register Lisp_Object tem; register char **new_env; register int new_length; new_length = 0; for (tem = Vprocess_environment; CONSP (tem) && STRINGP (XCONS (tem)->car); tem = XCONS (tem)->cdr) new_length++; /* new_length + 2 to include PWD and terminating 0. */ env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *)); /* If we have a PWD envvar, pass one down, but with corrected value. */ if (getenv ("PWD")) *new_env++ = pwd_var; /* Copy the Vprocess_environment strings into new_env. */ for (tem = Vprocess_environment; CONSP (tem) && STRINGP (XCONS (tem)->car); tem = XCONS (tem)->cdr) { char **ep = env; char *string = (char *) XSTRING (XCONS (tem)->car)->data; /* See if this string duplicates any string already in the env. If so, don't put it in. When an env var has multiple definitions, we keep the definition that comes first in process-environment. */ for (; ep != new_env; ep++) { char *p = *ep, *q = string; while (1) { if (*q == 0) /* The string is malformed; might as well drop it. */ goto duplicate; if (*q != *p) break; if (*q == '=') goto duplicate; p++, q++; } } *new_env++ = string; duplicate: ; } *new_env = 0; } #ifdef WINDOWSNT prepare_standard_handles (in, out, err, handles); #else /* not WINDOWSNT */ /* Make sure that in, out, and err are not actually already in descriptors zero, one, or two; this could happen if Emacs is started with its standard in, out, or error closed, as might happen under X. */ { int oin = in, oout = out; /* We have to avoid relocating the same descriptor twice! */ in = relocate_fd (in, 3); if (out == oin) out = in; else out = relocate_fd (out, 3); if (err == oin) err = in; else if (err == oout) err = out; else err = relocate_fd (err, 3); } close (0); close (1); close (2); dup2 (in, 0); dup2 (out, 1); dup2 (err, 2); close (in); close (out); close (err); #endif /* not WINDOWSNT */ #ifdef USG #ifndef SETPGRP_RELEASES_CTTY setpgrp (); /* No arguments but equivalent in this case */ #endif #else setpgrp (pid, pid); #endif /* USG */ /* setpgrp_of_tty is incorrect here; it uses input_fd. */ EMACS_SET_TTY_PGRP (0, &pid); #ifdef vipc something missing here; #endif /* vipc */ #ifdef WINDOWSNT /* Spawn the child. (See ntproc.c:Spawnve). */ cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env); if (cpid == -1) /* An error occurred while trying to spawn the process. */ report_file_error ("Spawning child process", Qnil); reset_standard_handles (in, out, err, handles); return cpid; #else /* not WINDOWSNT */ /* execvp does not accept an environment arg so the only way to pass this environment is to set environ. Our caller is responsible for restoring the ambient value of environ. */ environ = env; execvp (new_argv[0], new_argv); write (1, "Can't exec program: ", 26); write (1, new_argv[0], strlen (new_argv[0])); write (1, "\n", 1); _exit (1); #endif /* not WINDOWSNT */ #endif /* not MSDOS */ } /* Move the file descriptor FD so that its number is not less than MIN. If the file descriptor is moved at all, the original is freed. */ int relocate_fd (fd, min) int fd, min; { if (fd >= min) return fd; else { int new = dup (fd); if (new == -1) { char *message1 = "Error while setting up child: "; char *errmessage = strerror (errno); char *message2 = "\n"; write (2, message1, strlen (message1)); write (2, errmessage, strlen (errmessage)); write (2, message2, strlen (message2)); _exit (1); } /* Note that we hold the original FD open while we recurse, to guarantee we'll get a new FD if we need it. */ new = relocate_fd (new, min); close (fd); return new; } } static int getenv_internal (var, varlen, value, valuelen) char *var; int varlen; char **value; int *valuelen; { Lisp_Object scan; for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr) { Lisp_Object entry; entry = XCONS (scan)->car; if (STRINGP (entry) && XSTRING (entry)->size > varlen && XSTRING (entry)->data[varlen] == '=' #ifdef WINDOWSNT /* NT environment variables are case insensitive. */ && ! strnicmp (XSTRING (entry)->data, var, varlen) #else /* not WINDOWSNT */ && ! bcmp (XSTRING (entry)->data, var, varlen) #endif /* not WINDOWSNT */ ) { *value = (char *) XSTRING (entry)->data + (varlen + 1); *valuelen = XSTRING (entry)->size - (varlen + 1); return 1; } } return 0; } DEFUN ("getenv", Fgetenv, Sgetenv, 1, 1, 0, "Return the value of environment variable VAR, as a string.\n\ VAR should be a string. Value is nil if VAR is undefined in the environment.\n\ This function consults the variable ``process-environment'' for its value.") (var) Lisp_Object var; { char *value; int valuelen; CHECK_STRING (var, 0); if (getenv_internal (XSTRING (var)->data, XSTRING (var)->size, &value, &valuelen)) return make_string (value, valuelen); else return Qnil; } /* A version of getenv that consults process_environment, easily callable from C. */ char * egetenv (var) char *var; { char *value; int valuelen; if (getenv_internal (var, strlen (var), &value, &valuelen)) return value; else return 0; } #endif /* not VMS */ /* This is run before init_cmdargs. */ init_callproc_1 () { char *data_dir = egetenv ("EMACSDATA"); char *doc_dir = egetenv ("EMACSDOC"); Vdata_directory = Ffile_name_as_directory (build_string (data_dir ? data_dir : PATH_DATA)); Vdoc_directory = Ffile_name_as_directory (build_string (doc_dir ? doc_dir : PATH_DOC)); /* Check the EMACSPATH environment variable, defaulting to the PATH_EXEC path from paths.h. */ Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC); Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path)); Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path); } /* This is run after init_cmdargs, when Vinstallation_directory is valid. */ init_callproc () { char *data_dir = egetenv ("EMACSDATA"); register char * sh; Lisp_Object tempdir; if (initialized && !NILP (Vinstallation_directory)) { /* Add to the path the lib-src subdir of the installation dir. */ Lisp_Object tem; tem = Fexpand_file_name (build_string ("lib-src"), Vinstallation_directory); if (NILP (Fmember (tem, Vexec_path))) { #ifndef DOS_NT /* MSDOS uses wrapped binaries, so don't do this. */ Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil)); Vexec_directory = Ffile_name_as_directory (tem); #endif /* not DOS_NT */ } /* Maybe use ../etc as well as ../lib-src. */ if (data_dir == 0) { tem = Fexpand_file_name (build_string ("etc"), Vinstallation_directory); Vdoc_directory = Ffile_name_as_directory (tem); } } /* Look for the files that should be in etc. We don't use Vinstallation_directory, because these files are never installed near the executable, and they are never in the build directory when that's different from the source directory. Instead, if these files are not in the nominal place, we try the source directory. */ if (data_dir == 0) { Lisp_Object tem, tem1, newdir; tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory); tem1 = Ffile_exists_p (tem); if (NILP (tem1)) { newdir = Fexpand_file_name (build_string ("../etc/"), build_string (PATH_DUMPLOADSEARCH)); tem = Fexpand_file_name (build_string ("GNU"), newdir); tem1 = Ffile_exists_p (tem); if (!NILP (tem1)) Vdata_directory = newdir; } } tempdir = Fdirectory_file_name (Vexec_directory); if (access (XSTRING (tempdir)->data, 0) < 0) { fprintf (stderr, "Warning: arch-dependent data dir (%s) does not exist.\n", XSTRING (Vexec_directory)->data); sleep (2); } tempdir = Fdirectory_file_name (Vdata_directory); if (access (XSTRING (tempdir)->data, 0) < 0) { fprintf (stderr, "Warning: arch-independent data dir (%s) does not exist.\n", XSTRING (Vdata_directory)->data); sleep (2); } #ifdef VMS Vshell_file_name = build_string ("*dcl*"); #else sh = (char *) getenv ("SHELL"); Vshell_file_name = build_string (sh ? sh : "/bin/sh"); #endif } set_process_environment () { register char **envp; Vprocess_environment = Qnil; #ifndef CANNOT_DUMP if (initialized) #endif for (envp = environ; *envp; envp++) Vprocess_environment = Fcons (build_string (*envp), Vprocess_environment); } syms_of_callproc () { #ifdef DOS_NT Qbuffer_file_type = intern ("buffer-file-type"); staticpro (&Qbuffer_file_type); DEFVAR_LISP ("binary-process-input", &Vbinary_process_input, "*If non-nil then new subprocesses are assumed to take binary input."); Vbinary_process_input = Qnil; DEFVAR_LISP ("binary-process-output", &Vbinary_process_output, "*If non-nil then new subprocesses are assumed to produce binary output."); Vbinary_process_output = Qnil; #endif /* DOS_NT */ DEFVAR_LISP ("shell-file-name", &Vshell_file_name, "*File name to load inferior shells from.\n\ Initialized from the SHELL environment variable."); DEFVAR_LISP ("exec-path", &Vexec_path, "*List of directories to search programs to run in subprocesses.\n\ Each element is a string (directory name) or nil (try default directory)."); DEFVAR_LISP ("exec-directory", &Vexec_directory, "Directory of architecture-dependent files that come with GNU Emacs,\n\ especially executable programs intended for Emacs to invoke."); DEFVAR_LISP ("data-directory", &Vdata_directory, "Directory of architecture-independent files that come with GNU Emacs,\n\ intended for Emacs to use."); DEFVAR_LISP ("doc-directory", &Vdoc_directory, "Directory containing the DOC file that comes with GNU Emacs.\n\ This is usually the same as data-directory."); DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory, "For internal use by the build procedure only.\n\ This is the name of the directory in which the build procedure installed\n\ Emacs's info files; the default value for Info-default-directory-list\n\ includes this."); Vconfigure_info_directory = build_string (PATH_INFO); DEFVAR_LISP ("process-environment", &Vprocess_environment, "List of environment variables for subprocesses to inherit.\n\ Each element should be a string of the form ENVVARNAME=VALUE.\n\ The environment which Emacs inherits is placed in this variable\n\ when Emacs starts."); #ifndef VMS defsubr (&Scall_process); defsubr (&Sgetenv); #endif defsubr (&Scall_process_region); } emacs-19.30/src/casefiddle.c100444 75424 1 21000 5770115126 14335 0ustar kwzhdaemon/* GNU Emacs case conversion functions. Copyright (C) 1985, 1994 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. */ #include #include "lisp.h" #include "buffer.h" #include "commands.h" #include "syntax.h" enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP}; Lisp_Object casify_object (flag, obj) enum case_action flag; Lisp_Object obj; { register int i, c, len; register int inword = flag == CASE_DOWN; while (1) { if (INTEGERP (obj)) { c = XINT (obj); if (c >= 0 && c <= 0400) { if (inword) XSETFASTINT (obj, DOWNCASE (c)); else if (!UPPERCASEP (c)) XSETFASTINT (obj, UPCASE1 (c)); } return obj; } if (STRINGP (obj)) { obj = Fcopy_sequence (obj); len = XSTRING (obj)->size; for (i = 0; i < len; i++) { c = XSTRING (obj)->data[i]; if (inword && flag != CASE_CAPITALIZE_UP) c = DOWNCASE (c); else if (!UPPERCASEP (c) && (!inword || flag != CASE_CAPITALIZE_UP)) c = UPCASE1 (c); XSTRING (obj)->data[i] = c; if ((int) flag >= (int) CASE_CAPITALIZE) inword = SYNTAX (c) == Sword; } return obj; } obj = wrong_type_argument (Qchar_or_string_p, obj); } } DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0, "Convert argument to upper case and return that.\n\ The argument may be a character or string. The result has the same type.\n\ The argument object is not altered--the value is a copy.\n\ See also `capitalize', `downcase' and `upcase-initials'.") (obj) Lisp_Object obj; { return casify_object (CASE_UP, obj); } DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0, "Convert argument to lower case and return that.\n\ The argument may be a character or string. The result has the same type.\n\ The argument object is not altered--the value is a copy.") (obj) Lisp_Object obj; { return casify_object (CASE_DOWN, obj); } DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0, "Convert argument to capitalized form and return that.\n\ This means that each word's first character is upper case\n\ and the rest is lower case.\n\ The argument may be a character or string. The result has the same type.\n\ The argument object is not altered--the value is a copy.") (obj) Lisp_Object obj; { return casify_object (CASE_CAPITALIZE, obj); } /* Like Fcapitalize but change only the initials. */ DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0, "Convert the initial of each word in the argument to upper case.\n\ Do not change the other letters of each word.\n\ The argument may be a character or string. The result has the same type.\n\ The argument object is not altered--the value is a copy.") (obj) Lisp_Object obj; { return casify_object (CASE_CAPITALIZE_UP, obj); } /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP. b and e specify range of buffer to operate on. */ casify_region (flag, b, e) enum case_action flag; Lisp_Object b, e; { register int i; register int c; register int inword = flag == CASE_DOWN; int start, end; if (EQ (b, e)) /* Not modifying because nothing marked */ return; validate_region (&b, &e); start = XFASTINT (b); end = XFASTINT (e); modify_region (current_buffer, start, end); record_change (start, end - start); for (i = start; i < end; i++) { c = FETCH_CHAR (i); if (inword && flag != CASE_CAPITALIZE_UP) c = DOWNCASE (c); else if (!UPPERCASEP (c) && (!inword || flag != CASE_CAPITALIZE_UP)) c = UPCASE1 (c); FETCH_CHAR (i) = c; if ((int) flag >= (int) CASE_CAPITALIZE) inword = SYNTAX (c) == Sword; } signal_after_change (start, end - start, end - start); } DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r", "Convert the region to upper case. In programs, wants two arguments.\n\ These arguments specify the starting and ending character numbers of\n\ the region to operate on. When used as a command, the text between\n\ point and the mark is operated on.\n\ See also `capitalize-region'.") (b, e) Lisp_Object b, e; { casify_region (CASE_UP, b, e); return Qnil; } DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r", "Convert the region to lower case. In programs, wants two arguments.\n\ These arguments specify the starting and ending character numbers of\n\ the region to operate on. When used as a command, the text between\n\ point and the mark is operated on.") (b, e) Lisp_Object b, e; { casify_region (CASE_DOWN, b, e); return Qnil; } DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r", "Convert the region to capitalized form.\n\ Capitalized form means each word's first character is upper case\n\ and the rest of it is lower case.\n\ In programs, give two arguments, the starting and ending\n\ character positions to operate on.") (b, e) Lisp_Object b, e; { casify_region (CASE_CAPITALIZE, b, e); return Qnil; } /* Like Fcapitalize_region but change only the initials. */ DEFUN ("upcase-initials-region", Fupcase_initials_region, Supcase_initials_region, 2, 2, "r", "Upcase the initial of each word in the region.\n\ Subsequent letters of each word are not changed.\n\ In programs, give two arguments, the starting and ending\n\ character positions to operate on.") (b, e) Lisp_Object b, e; { casify_region (CASE_CAPITALIZE_UP, b, e); return Qnil; } Lisp_Object operate_on_word (arg, newpoint) Lisp_Object arg; int *newpoint; { Lisp_Object val; int farend; int iarg; CHECK_NUMBER (arg, 0); iarg = XINT (arg); farend = scan_words (point, iarg); if (!farend) farend = iarg > 0 ? ZV : BEGV; *newpoint = point > farend ? point : farend; XSETFASTINT (val, farend); return val; } DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p", "Convert following word (or ARG words) to upper case, moving over.\n\ With negative argument, convert previous words but do not move.\n\ See also `capitalize-word'.") (arg) Lisp_Object arg; { Lisp_Object beg, end; int newpoint; XSETFASTINT (beg, point); end = operate_on_word (arg, &newpoint); casify_region (CASE_UP, beg, end); SET_PT (newpoint); return Qnil; } DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p", "Convert following word (or ARG words) to lower case, moving over.\n\ With negative argument, convert previous words but do not move.") (arg) Lisp_Object arg; { Lisp_Object beg, end; int newpoint; XSETFASTINT (beg, point); end = operate_on_word (arg, &newpoint); casify_region (CASE_DOWN, beg, end); SET_PT (newpoint); return Qnil; } DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p", "Capitalize the following word (or ARG words), moving over.\n\ This gives the word(s) a first character in upper case\n\ and the rest lower case.\n\ With negative argument, capitalize previous words but do not move.") (arg) Lisp_Object arg; { Lisp_Object beg, end; int newpoint; XSETFASTINT (beg, point); end = operate_on_word (arg, &newpoint); casify_region (CASE_CAPITALIZE, beg, end); SET_PT (newpoint); return Qnil; } syms_of_casefiddle () { defsubr (&Supcase); defsubr (&Sdowncase); defsubr (&Scapitalize); defsubr (&Supcase_initials); defsubr (&Supcase_region); defsubr (&Sdowncase_region); defsubr (&Scapitalize_region); defsubr (&Supcase_initials_region); defsubr (&Supcase_word); defsubr (&Sdowncase_word); defsubr (&Scapitalize_word); } keys_of_casefiddle () { initial_define_key (control_x_map, Ctl('U'), "upcase-region"); Fput (intern ("upcase-region"), Qdisabled, Qt); initial_define_key (control_x_map, Ctl('L'), "downcase-region"); Fput (intern ("downcase-region"), Qdisabled, Qt); initial_define_key (meta_map, 'u', "upcase-word"); initial_define_key (meta_map, 'l', "downcase-word"); initial_define_key (meta_map, 'c', "capitalize-word"); } emacs-19.30/src/casetab.c100444 12120 1 15730 6044750514 13470 0ustar rmsdaemon/* GNU Emacs routines to deal with case tables. Copyright (C) 1993, 1994 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. */ /* Written by Howard Gayle. See chartab.c for details. */ #include #include "lisp.h" #include "buffer.h" Lisp_Object Qcase_table_p, Qcase_table; Lisp_Object Vascii_downcase_table, Vascii_upcase_table; Lisp_Object Vascii_canon_table, Vascii_eqv_table; static void compute_trt_inverse (); DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0, "Return t iff ARG is a case table.\n\ See `set-case-table' for more information on these data structures.") (table) Lisp_Object table; { Lisp_Object up, canon, eqv; if (! CHAR_TABLE_P (table)) return Qnil; if (! EQ (XCHAR_TABLE (table)->purpose, Qcase_table)) return Qnil; up = XCHAR_TABLE (table)->extras[0]; canon = XCHAR_TABLE (table)->extras[1]; eqv = XCHAR_TABLE (table)->extras[2]; return ((NILP (up) || CHAR_TABLE_P (up)) && ((NILP (canon) && NILP (eqv)) || (CHAR_TABLE_P (canon) && (NILP (eqv) || CHAR_TABLE_P (eqv)))) ? Qt : Qnil); } static Lisp_Object check_case_table (obj) Lisp_Object obj; { register Lisp_Object tem; while (tem = Fcase_table_p (obj), NILP (tem)) obj = wrong_type_argument (Qcase_table_p, obj); return (obj); } DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, 0, 0, 0, "Return the case table of the current buffer.") () { return current_buffer->downcase_table; } DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0, "Return the standard case table.\n\ This is the one used for new buffers.") () { return Vascii_downcase_table; } static Lisp_Object set_case_table (); DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0, "Select a new case table for the current buffer.\n\ A case table is a char-table which maps characters\n\ to their lower-case equivalents. It also has three \"extra\" slots\n\ which may be additional char-tables or nil.\n\ These slots are called UPCASE, CANONICALIZE and EQUIVALENCES.\n\ UPCASE maps each character to its upper-case equivalent;\n\ if lower and upper case characters are in 1-1 correspondence,\n\ you may use nil and the upcase table will be deduced from DOWNCASE.\n\ CANONICALIZE maps each character to a canonical equivalent;\n\ any two characters that are related by case-conversion have the same\n\ canonical equivalent character; it may be nil, in which case it is\n\ deduced from DOWNCASE and UPCASE.\n\ EQUIVALENCES is a map that cyclicly permutes each equivalence class\n\ (of characters with the same canonical equivalent); it may be nil,\n\ in which case it is deduced from CANONICALIZE.") (table) Lisp_Object table; { return set_case_table (table, 0); } DEFUN ("set-standard-case-table", Fset_standard_case_table, Sset_standard_case_table, 1, 1, 0, "Select a new standard case table for new buffers.\n\ See `set-case-table' for more info on case tables.") (table) Lisp_Object table; { return set_case_table (table, 1); } static Lisp_Object set_case_table (table, standard) Lisp_Object table; int standard; { Lisp_Object up, canon, eqv; check_case_table (table); up = XCHAR_TABLE (table)->extras[0]; canon = XCHAR_TABLE (table)->extras[1]; eqv = XCHAR_TABLE (table)->extras[2]; if (NILP (up)) { up = Fmake_char_table (Qcase_table, Qnil); compute_trt_inverse (XCHAR_TABLE (table), XCHAR_TABLE (up)); XCHAR_TABLE (table)->extras[0] = up; } if (NILP (canon)) { register int i; Lisp_Object *upvec = XCHAR_TABLE (up)->contents; Lisp_Object *downvec = XCHAR_TABLE (table)->contents; canon = Fmake_char_table (Qcase_table, Qnil); /* Set up the CANON vector; for each character, this sequence of upcasing and downcasing ought to get the "preferred" lowercase equivalent. */ for (i = 0; i < 256; i++) XCHAR_TABLE (canon)->contents[i] = downvec[upvec[downvec[i]]]; XCHAR_TABLE (table)->extras[1] = canon; } if (NILP (eqv)) { eqv = Fmake_char_table (Qcase_table, Qnil); compute_trt_inverse (XCHAR_TABLE (canon), XCHAR_TABLE (eqv)); XCHAR_TABLE (table)->extras[2] = eqv; } if (standard) Vascii_downcase_table = table; else current_buffer->downcase_table = table; return table; } /* Given a translate table TRT, store the inverse mapping into INVERSE. Since TRT is not one-to-one, INVERSE is not a simple mapping. Instead, it divides the space of characters into equivalence classes. All characters in a given class form one circular list, chained through the elements of INVERSE. */ static void compute_trt_inverse (trt, inverse) struct Lisp_Char_Table *trt, *inverse; { register int i = 0400; register unsigned char c, q; while (i--) inverse->contents[i] = i; i = 0400; while (i--) { if ((q = trt->contents[i]) != (unsigned char) i) { c = inverse->contents[q]; inverse->contents[q] = i; inverse->contents[i] = c; } } } init_casetab_once () { register int i; Lisp_Object down, up; Qcase_table = intern ("case-table"); staticpro (&Qcase_table); /* Intern this now in case it isn't already done. Setting this variable twice is harmless. But don't staticpro it here--that is done in alloc.c. */ Qchar_table_extra_slots = intern ("char-table-extra-slots"); /* Now we are ready to set up this property, so we can create char tables. */ Fput (Qcase_table, Qchar_table_extra_slots, make_number (3)); down = Fmake_char_table (Qcase_table, Qnil); Vascii_downcase_table = down; for (i = 0; i < 256; i++) XCHAR_TABLE (down)->contents[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i; XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down); up = Fmake_char_table (Qcase_table, Qnil); XCHAR_TABLE (down)->extras[0] = up; for (i = 0; i < 256; i++) XCHAR_TABLE (up)->contents[i] = ((i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : ((i >= 'a' && i <= 'z') ? i + ('A' - 'a') : i)); XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up); } syms_of_casetab () { Qcase_table_p = intern ("case-table-p"); staticpro (&Qcase_table_p); staticpro (&Vascii_downcase_table); defsubr (&Scase_table_p); defsubr (&Scurrent_case_table); defsubr (&Sstandard_case_table); defsubr (&Sset_case_table); defsubr (&Sset_standard_case_table); } emacs-19.30/src/cm.c100444 75424 12 25534 5741114611 12547 0ustar kwzhstaff/* Cursor motion subroutines for GNU Emacs. Copyright (C) 1985, 1995 Free Software Foundation, Inc. based primarily on public domain code written by Chris Torek 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. */ #include #include #include "cm.h" #include "termhooks.h" #define BIG 9999 /* 9999 good on VAXen. For 16 bit machines use about 2000.... */ char *tgoto (); extern char *BC, *UP; int cost; /* sums up costs */ /* ARGSUSED */ evalcost (c) char c; { cost++; return c; } cmputc (c) char c; { if (termscript) fputc (c & 0177, termscript); putchar (c & 0177); return c; } /* NEXT TWO ARE DONE WITH MACROS */ #if 0 /* * Assume the cursor is at row row, column col. Normally used only after * clearing the screen, when the cursor is at (0, 0), but what the heck, * let's let the guy put it anywhere. */ static at (row, col) { curY = row; curX = col; } /* * Add n columns to the current cursor position. */ static addcol (n) { curX += n; /* * If cursor hit edge of screen, what happened? * N.B.: DO NOT!! write past edge of screen. If you do, you * deserve what you get. Furthermore, on terminals with * autowrap (but not magicwrap), don't write in the last column * of the last line. */ if (curX == Wcm.cm_cols) { /* * Well, if magicwrap, still there, past the edge of the * screen (!). If autowrap, on the col 0 of the next line. * Otherwise on last column. */ if (Wcm.cm_magicwrap) ; /* "limbo" */ else if (Wcm.cm_autowrap) { curX = 0; curY++; /* Beware end of screen! */ } else curX--; } } #endif /* * Terminals with magicwrap (xn) don't all behave identically. * The VT100 leaves the cursor in the last column but will wrap before * printing the next character. I hear that the Concept terminal does * the wrap immediately but ignores the next newline it sees. And some * terminals just have buggy firmware, and think that the cursor is still * in limbo if we use direct cursor addressing from the phantom column. * The only guaranteed safe thing to do is to emit a CRLF immediately * after we reach the last column; this takes us to a known state. */ void cmcheckmagic () { if (curX == FrameCols) { if (!MagicWrap || curY >= FrameRows - 1) abort (); if (termscript) putc ('\r', termscript); putchar ('\r'); if (termscript) putc ('\n', termscript); putchar ('\n'); curX = 0; curY++; } } /* * (Re)Initialize the cost factors, given the output speed of the terminal * in the variable ospeed. (Note: this holds B300, B9600, etc -- ie stuff * out of .) */ cmcostinit () { char *p; #define COST(x,e) (x ? (cost = 0, tputs (x, 1, e), cost) : BIG) #define CMCOST(x,e) ((x == 0) ? BIG : (p = tgoto(x, 0, 0), COST(p ,e))) Wcm.cc_up = COST (Wcm.cm_up, evalcost); Wcm.cc_down = COST (Wcm.cm_down, evalcost); Wcm.cc_left = COST (Wcm.cm_left, evalcost); Wcm.cc_right = COST (Wcm.cm_right, evalcost); Wcm.cc_home = COST (Wcm.cm_home, evalcost); Wcm.cc_cr = COST (Wcm.cm_cr, evalcost); Wcm.cc_ll = COST (Wcm.cm_ll, evalcost); Wcm.cc_tab = Wcm.cm_tabwidth ? COST (Wcm.cm_tab, evalcost) : BIG; /* * These last three are actually minimum costs. When (if) they are * candidates for the least-cost motion, the real cost is computed. * (Note that "0" is the assumed to generate the minimum cost. * While this is not necessarily true, I have yet to see a terminal * for which is not; all the terminals that have variable-cost * cursor motion seem to take straight numeric values. --ACT) */ Wcm.cc_abs = CMCOST (Wcm.cm_abs, evalcost); Wcm.cc_habs = CMCOST (Wcm.cm_habs, evalcost); Wcm.cc_vabs = CMCOST (Wcm.cm_vabs, evalcost); #undef CMCOST #undef COST } /* * Calculate the cost to move from (srcy, srcx) to (dsty, dstx) using * up and down, and left and right, motions, and tabs. If doit is set * actually perform the motion. */ static calccost (srcy, srcx, dsty, dstx, doit) { register int deltay, deltax, c, totalcost; int ntabs, n2tabs, tabx, tab2x, tabcost; register char *p; /* If have just wrapped on a terminal with xn, don't believe the cursor position: give up here and force use of absolute positioning. */ if (curX == Wcm.cm_cols) goto fail; totalcost = 0; if ((deltay = dsty - srcy) == 0) goto x; if (deltay < 0) p = Wcm.cm_up, c = Wcm.cc_up, deltay = -deltay; else p = Wcm.cm_down, c = Wcm.cc_down; if (c == BIG) { /* caint get thar from here */ if (doit) printf ("OOPS"); return c; } totalcost = c * deltay; if (doit) while (--deltay >= 0) tputs (p, 1, cmputc); x: if ((deltax = dstx - srcx) == 0) goto done; if (deltax < 0) { p = Wcm.cm_left, c = Wcm.cc_left, deltax = -deltax; goto dodelta; /* skip all the tab junk */ } /* Tabs (the toughie) */ if (Wcm.cc_tab >= BIG || !Wcm.cm_usetabs) goto olddelta; /* forget it! */ /* * ntabs is # tabs towards but not past dstx; n2tabs is one more * (ie past dstx), but this is only valid if that is not past the * right edge of the screen. We can check that at the same time * as we figure out where we would be if we use the tabs (which * we will put into tabx (for ntabs) and tab2x (for n2tabs)). */ ntabs = (deltax + srcx % Wcm.cm_tabwidth) / Wcm.cm_tabwidth; n2tabs = ntabs + 1; tabx = (srcx / Wcm.cm_tabwidth + ntabs) * Wcm.cm_tabwidth; tab2x = tabx + Wcm.cm_tabwidth; if (tab2x >= Wcm.cm_cols) /* too far (past edge) */ n2tabs = 0; /* * Now set tabcost to the cost for using ntabs, and c to the cost * for using n2tabs, then pick the minimum. */ /* cost for ntabs + cost for right motion */ tabcost = ntabs ? ntabs * Wcm.cc_tab + (dstx - tabx) * Wcm.cc_right : BIG; /* cost for n2tabs + cost for left motion */ c = n2tabs ? n2tabs * Wcm.cc_tab + (tab2x - dstx) * Wcm.cc_left : BIG; if (c < tabcost) /* then cheaper to overshoot & back up */ ntabs = n2tabs, tabcost = c, tabx = tab2x; if (tabcost >= BIG) /* caint use tabs */ goto newdelta; /* * See if tabcost is less than just moving right */ if (tabcost < (deltax * Wcm.cc_right)) { totalcost += tabcost; /* use the tabs */ if (doit) while (--ntabs >= 0) tputs (Wcm.cm_tab, 1, cmputc); srcx = tabx; } /* * Now might as well just recompute the delta. */ newdelta: if ((deltax = dstx - srcx) == 0) goto done; olddelta: if (deltax > 0) p = Wcm.cm_right, c = Wcm.cc_right; else p = Wcm.cm_left, c = Wcm.cc_left, deltax = -deltax; dodelta: if (c == BIG) { /* caint get thar from here */ fail: if (doit) printf ("OOPS"); return BIG; } totalcost += c * deltax; if (doit) while (--deltax >= 0) tputs (p, 1, cmputc); done: return totalcost; } #if 0 losecursor () { curY = -1; } #endif #define USEREL 0 #define USEHOME 1 #define USELL 2 #define USECR 3 cmgoto (row, col) { int homecost, crcost, llcost, relcost, directcost; int use; char *p, *dcm; /* First the degenerate case */ if (row == curY && col == curX) /* already there */ return; if (curY >= 0 && curX >= 0) { /* We may have quick ways to go to the upper-left, bottom-left, * start-of-line, or start-of-next-line. Or it might be best to * start where we are. Examine the options, and pick the cheapest. */ relcost = calccost (curY, curX, row, col, 0); use = USEREL; if ((homecost = Wcm.cc_home) < BIG) homecost += calccost (0, 0, row, col, 0); if (homecost < relcost) relcost = homecost, use = USEHOME; if ((llcost = Wcm.cc_ll) < BIG) llcost += calccost (Wcm.cm_rows - 1, 0, row, col, 0); if (llcost < relcost) relcost = llcost, use = USELL; if ((crcost = Wcm.cc_cr) < BIG) { if (Wcm.cm_autolf) if (curY + 1 >= Wcm.cm_rows) crcost = BIG; else crcost += calccost (curY + 1, 0, row, col, 0); else crcost += calccost (curY, 0, row, col, 0); } if (crcost < relcost) relcost = crcost, use = USECR; directcost = Wcm.cc_abs, dcm = Wcm.cm_abs; if (row == curY && Wcm.cc_habs < BIG) directcost = Wcm.cc_habs, dcm = Wcm.cm_habs; else if (col == curX && Wcm.cc_vabs < BIG) directcost = Wcm.cc_vabs, dcm = Wcm.cm_vabs; } else { directcost = 0, relcost = 100000; dcm = Wcm.cm_abs; } /* * In the following comparison, the = in <= is because when the costs * are the same, it looks nicer (I think) to move directly there. */ if (directcost <= relcost) { /* compute REAL direct cost */ cost = 0; p = dcm == Wcm.cm_habs ? tgoto (dcm, row, col) : tgoto (dcm, col, row); tputs (p, 1, evalcost); if (cost <= relcost) { /* really is cheaper */ tputs (p, 1, cmputc); curY = row, curX = col; return; } } switch (use) { case USEHOME: tputs (Wcm.cm_home, 1, cmputc); curY = 0, curX = 0; break; case USELL: tputs (Wcm.cm_ll, 1, cmputc); curY = Wcm.cm_rows - 1, curX = 0; break; case USECR: tputs (Wcm.cm_cr, 1, cmputc); if (Wcm.cm_autolf) curY++; curX = 0; break; } (void) calccost (curY, curX, row, col, 1); curY = row, curX = col; } /* Clear out all terminal info. Used before copying into it the info on the actual terminal. */ Wcm_clear () { bzero (&Wcm, sizeof Wcm); UP = 0; BC = 0; } /* * Initialized stuff * Return 0 if can do CM. * Return -1 if cannot. * Return -2 if size not specified. */ Wcm_init () { #if 0 if (Wcm.cm_abs && !Wcm.cm_ds) return 0; #endif if (Wcm.cm_abs) return 0; /* Require up and left, and, if no absolute, down and right */ if (!Wcm.cm_up || !Wcm.cm_left) return - 1; if (!Wcm.cm_abs && (!Wcm.cm_down || !Wcm.cm_right)) return - 1; /* Check that we know the size of the screen.... */ if (Wcm.cm_rows <= 0 || Wcm.cm_cols <= 0) return - 2; return 0; } emacs-19.30/src/cmds.c100444 12120 1 26760 6013602240 13005 0ustar rmsdaemon/* Simple built-in editing commands. Copyright (C) 1985, 1993, 1994, 1995 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. */ #include #include "lisp.h" #include "commands.h" #include "buffer.h" #include "syntax.h" #include "window.h" #include "keyboard.h" Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function; /* A possible value for a buffer's overwrite-mode variable. */ Lisp_Object Qoverwrite_mode_binary; /* Non-nil means put this face on the next self-inserting character. */ Lisp_Object Vself_insert_face; /* This is the command that set up Vself_insert_face. */ Lisp_Object Vself_insert_face_command; extern Lisp_Object Qface; DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p", "Move point right ARG characters (left if ARG negative).\n\ On reaching end of buffer, stop and signal error.") (n) Lisp_Object n; { if (NILP (n)) XSETFASTINT (n, 1); else CHECK_NUMBER (n, 0); /* This used to just set point to point + XINT (n), and then check to see if it was within boundaries. But now that SET_PT can potentially do a lot of stuff (calling entering and exiting hooks, etcetera), that's not a good approach. So we validate the proposed position, then set point. */ { int new_point = point + XINT (n); if (new_point < BEGV) { SET_PT (BEGV); Fsignal (Qbeginning_of_buffer, Qnil); } if (new_point > ZV) { SET_PT (ZV); Fsignal (Qend_of_buffer, Qnil); } SET_PT (new_point); } return Qnil; } DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p", "Move point left ARG characters (right if ARG negative).\n\ On attempt to pass beginning or end of buffer, stop and signal error.") (n) Lisp_Object n; { if (NILP (n)) XSETFASTINT (n, 1); else CHECK_NUMBER (n, 0); XSETINT (n, - XINT (n)); return Fforward_char (n); } DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p", "Move ARG lines forward (backward if ARG is negative).\n\ Precisely, if point is on line I, move to the start of line I + ARG.\n\ If there isn't room, go as far as possible (no error).\n\ Returns the count of lines left to move. If moving forward,\n\ that is ARG - number of lines moved; if backward, ARG + number moved.\n\ With positive ARG, a non-empty line at the end counts as one line\n\ successfully moved (for the return value).") (n) Lisp_Object n; { int pos2 = point; int pos; int count, shortage, negp; if (NILP (n)) count = 1; else { CHECK_NUMBER (n, 0); count = XINT (n); } negp = count <= 0; pos = scan_buffer ('\n', pos2, 0, count - negp, &shortage, 1); if (shortage > 0 && (negp || (ZV > BEGV && pos != pos2 && FETCH_CHAR (pos - 1) != '\n'))) shortage--; SET_PT (pos); return make_number (negp ? - shortage : shortage); } DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line, 0, 1, "p", "Move point to beginning of current line.\n\ With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\ If scan reaches end of buffer, stop there without error.") (n) Lisp_Object n; { if (NILP (n)) XSETFASTINT (n, 1); else CHECK_NUMBER (n, 0); Fforward_line (make_number (XINT (n) - 1)); return Qnil; } DEFUN ("end-of-line", Fend_of_line, Send_of_line, 0, 1, "p", "Move point to end of current line.\n\ With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\ If scan reaches end of buffer, stop there without error.") (n) Lisp_Object n; { register int pos; register int stop; if (NILP (n)) XSETFASTINT (n, 1); else CHECK_NUMBER (n, 0); SET_PT (find_before_next_newline (PT, 0, XINT (n) - (XINT (n) <= 0))); return Qnil; } DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP", "Delete the following ARG characters (previous, with negative arg).\n\ Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\ Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\ ARG was explicitly specified.") (n, killflag) Lisp_Object n, killflag; { CHECK_NUMBER (n, 0); if (NILP (killflag)) { if (XINT (n) < 0) { if (point + XINT (n) < BEGV) Fsignal (Qbeginning_of_buffer, Qnil); else del_range (point + XINT (n), point); } else { if (point + XINT (n) > ZV) Fsignal (Qend_of_buffer, Qnil); else del_range (point, point + XINT (n)); } } else { call1 (Qkill_forward_chars, n); } return Qnil; } DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char, 1, 2, "p\nP", "Delete the previous ARG characters (following, with negative ARG).\n\ Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\ Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\ ARG was explicitly specified.") (n, killflag) Lisp_Object n, killflag; { CHECK_NUMBER (n, 0); return Fdelete_char (make_number (-XINT (n)), killflag); } DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p", "Insert the character you type.\n\ Whichever character you type to run this command is inserted.") (arg) Lisp_Object arg; { CHECK_NUMBER (arg, 0); /* Barf if the key that invoked this was not a character. */ if (!INTEGERP (last_command_char)) bitch_at_user (); else if (XINT (arg) >= 2 && NILP (current_buffer->overwrite_mode)) { XSETFASTINT (arg, XFASTINT (arg) - 2); /* The first one might want to expand an abbrev. */ internal_self_insert (XINT (last_command_char), 1); /* The bulk of the copies of this char can be inserted simply. We don't have to handle a user-specified face specially because it will get inherited from the first char inserted. */ Finsert_char (last_command_char, arg, Qt); /* The last one might want to auto-fill. */ internal_self_insert (XINT (last_command_char), 0); } else while (XINT (arg) > 0) { /* Ok since old and new vals both nonneg */ XSETFASTINT (arg, XFASTINT (arg) - 1); internal_self_insert (XINT (last_command_char), XFASTINT (arg) != 0); } return Qnil; } /* Insert character C1. If NOAUTOFILL is nonzero, don't do autofill even if it is enabled. If this insertion is suitable for direct output (completely simple), return 0. A value of 1 indicates this *might* not have been simple. A value of 2 means this did things that call for an undo boundary. */ internal_self_insert (c1, noautofill) char c1; int noautofill; { extern Lisp_Object Fexpand_abbrev (); int hairy = 0; Lisp_Object tem; register enum syntaxcode synt; register int c = c1; Lisp_Object overwrite; overwrite = current_buffer->overwrite_mode; if (!NILP (Vbefore_change_function) || !NILP (Vafter_change_function) || !NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions)) hairy = 1; if (!NILP (overwrite) && point < ZV && (EQ (overwrite, Qoverwrite_mode_binary) || (c != '\n' && FETCH_CHAR (point) != '\n')) && (EQ (overwrite, Qoverwrite_mode_binary) || FETCH_CHAR (point) != '\t' || XINT (current_buffer->tab_width) <= 0 || XFASTINT (current_buffer->tab_width) > 20 || !((current_column () + 1) % XFASTINT (current_buffer->tab_width)))) { del_range (point, point + 1); hairy = 2; } if (!NILP (current_buffer->abbrev_mode) && SYNTAX (c) != Sword && NILP (current_buffer->read_only) && point > BEGV && SYNTAX (FETCH_CHAR (point - 1)) == Sword) { int modiff = MODIFF; Fexpand_abbrev (); /* We can't trust the value of Fexpand_abbrev, but if Fexpand_abbrev changed the buffer, assume it expanded something. */ if (MODIFF != modiff) hairy = 2; } if ((c == ' ' || c == '\n') && !noautofill && !NILP (current_buffer->auto_fill_function)) { insert_and_inherit (&c1, 1); if (c1 == '\n') /* After inserting a newline, move to previous line and fill */ /* that. Must have the newline in place already so filling and */ /* justification, if any, know where the end is going to be. */ SET_PT (point - 1); call0 (current_buffer->auto_fill_function); if (c1 == '\n') SET_PT (point + 1); hairy = 2; } else insert_and_inherit (&c1, 1); #ifdef HAVE_FACES /* If previous command specified a face to use, use it. */ if (!NILP (Vself_insert_face) && EQ (current_kboard->Vlast_command, Vself_insert_face_command)) { Lisp_Object before, after; XSETINT (before, PT - 1); XSETINT (after, PT); Fput_text_property (before, after, Qface, Vself_insert_face, Qnil); Vself_insert_face = Qnil; } #endif synt = SYNTAX (c); if ((synt == Sclose || synt == Smath) && !NILP (Vblink_paren_function) && INTERACTIVE && !noautofill) { call0 (Vblink_paren_function); hairy = 2; } return hairy; } /* module initialization */ syms_of_cmds () { Qkill_backward_chars = intern ("kill-backward-chars"); staticpro (&Qkill_backward_chars); Qkill_forward_chars = intern ("kill-forward-chars"); staticpro (&Qkill_forward_chars); Qoverwrite_mode_binary = intern ("overwrite-mode-binary"); staticpro (&Qoverwrite_mode_binary); DEFVAR_LISP ("self-insert-face", &Vself_insert_face, "If non-nil, set the face of the next self-inserting character to this.\n\ See also `self-insert-face-command'."); Vself_insert_face = Qnil; DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command, "This is the command that set up `self-insert-face'.\n\ If `last-command' does not equal this value, we ignore `self-insert-face'."); Vself_insert_face_command = Qnil; DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function, "Function called, if non-nil, whenever a close parenthesis is inserted.\n\ More precisely, a char with closeparen syntax is self-inserted."); Vblink_paren_function = Qnil; defsubr (&Sforward_char); defsubr (&Sbackward_char); defsubr (&Sforward_line); defsubr (&Sbeginning_of_line); defsubr (&Send_of_line); defsubr (&Sdelete_char); defsubr (&Sdelete_backward_char); defsubr (&Sself_insert_command); } keys_of_cmds () { int n; initial_define_key (global_map, Ctl ('I'), "self-insert-command"); for (n = 040; n < 0177; n++) initial_define_key (global_map, n, "self-insert-command"); #ifdef MSDOS for (n = 0200; n < 0240; n++) initial_define_key (global_map, n, "self-insert-command"); #endif for (n = 0240; n < 0400; n++) initial_define_key (global_map, n, "self-insert-command"); initial_define_key (global_map, Ctl ('A'), "beginning-of-line"); initial_define_key (global_map, Ctl ('B'), "backward-char"); initial_define_key (global_map, Ctl ('D'), "delete-char"); initial_define_key (global_map, Ctl ('E'), "end-of-line"); initial_define_key (global_map, Ctl ('F'), "forward-char"); initial_define_key (global_map, 0177, "delete-backward-char"); } emacs-19.30/src/data.c100444 12120 1 222373 6053523336 13022 0ustar rmsdaemon/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter. Copyright (C) 1985, 86, 88, 93, 94, 95 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. */ #include #include #include "lisp.h" #include "puresize.h" #ifndef standalone #include "buffer.h" #include "keyboard.h" #endif #include "syssignal.h" #ifdef LISP_FLOAT_TYPE #ifdef STDC_HEADERS #include #endif /* Work around a problem that happens because math.h on hpux 7 defines two static variables--which, in Emacs, are not really static, because `static' is defined as nothing. The problem is that they are here, in floatfns.c, and in lread.c. These macros prevent the name conflict. */ #if defined (HPUX) && !defined (HPUX8) #define _MAXLDBL data_c_maxldbl #define _NMAXLDBL data_c_nmaxldbl #endif #include #endif /* LISP_FLOAT_TYPE */ #if !defined (atof) extern double atof (); #endif /* !atof */ Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound; Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range; Lisp_Object Qvoid_variable, Qvoid_function, Qcyclic_function_indirection; 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, Qwholenump, Qsymbolp, Qlistp, Qconsp; Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp; Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp; Lisp_Object Qbuffer_or_string_p; Lisp_Object Qboundp, Qfboundp; Lisp_Object Qchar_table_p, Qvector_or_char_table_p; Lisp_Object Qcdr; Lisp_Object Qad_advice_info, Qad_activate; Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error; Lisp_Object Qoverflow_error, Qunderflow_error; #ifdef LISP_FLOAT_TYPE Lisp_Object Qfloatp; Lisp_Object Qnumberp, Qnumber_or_marker_p; #endif static Lisp_Object Qinteger, Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; static Lisp_Object Qfloat, Qwindow_configuration, Qprocess, Qwindow; static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; static Lisp_Object swap_in_symval_forwarding (); Lisp_Object wrong_type_argument (predicate, value) register Lisp_Object predicate, value; { register Lisp_Object tem; do { if (!EQ (Vmocklisp_arguments, Qt)) { if (STRINGP (value) && (EQ (predicate, Qintegerp) || EQ (predicate, Qinteger_or_marker_p))) return Fstring_to_number (value); if (INTEGERP (value) && EQ (predicate, Qstringp)) return Fnumber_to_string (value); } /* If VALUE is not even a valid Lisp object, abort here where we can get a backtrace showing where it came from. */ if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit) abort (); value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil))); tem = call1 (predicate, value); } while (NILP (tem)); return value; } pure_write_error () { error ("Attempt to modify read-only object"); } void args_out_of_range (a1, a2) Lisp_Object a1, a2; { while (1) Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Qnil))); } void args_out_of_range_3 (a1, a2, a3) Lisp_Object a1, a2, a3; { while (1) Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Fcons (a3, Qnil)))); } Lisp_Object make_number (num) int num; { register Lisp_Object val; XSETINT (val, num); return val; } /* On some machines, XINT needs a temporary location. Here it is, in case it is needed. */ int sign_extend_temp; /* On a few machines, XINT can only be done by calling this. */ int sign_extend_lisp_int (num) EMACS_INT num; { if (num & (((EMACS_INT) 1) << (VALBITS - 1))) return num | (((EMACS_INT) (-1)) << VALBITS); else return num & ((((EMACS_INT) 1) << VALBITS) - 1); } /* Data type predicates */ DEFUN ("eq", Feq, Seq, 2, 2, 0, "T if the two args are the same Lisp object.") (obj1, obj2) Lisp_Object obj1, obj2; { if (EQ (obj1, obj2)) return Qt; return Qnil; } DEFUN ("null", Fnull, Snull, 1, 1, 0, "T if OBJECT is nil.") (object) Lisp_Object object; { if (NILP (object)) return Qt; return Qnil; } DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0, "Return a symbol representing the type of OBJECT.\n\ The symbol returned names the object's basic type;\n\ for example, (type-of 1) returns `integer'.") (object) Lisp_Object object; { switch (XGCTYPE (object)) { case Lisp_Int: return Qinteger; case Lisp_Symbol: return Qsymbol; case Lisp_String: return Qstring; case Lisp_Cons: return Qcons; case Lisp_Misc: switch (XMISCTYPE (object)) { case Lisp_Misc_Marker: return Qmarker; case Lisp_Misc_Overlay: return Qoverlay; case Lisp_Misc_Float: return Qfloat; } abort (); case Lisp_Vectorlike: if (GC_WINDOW_CONFIGURATIONP (object)) return Qwindow_configuration; if (GC_PROCESSP (object)) return Qprocess; if (GC_WINDOWP (object)) return Qwindow; if (GC_SUBRP (object)) return Qsubr; if (GC_COMPILEDP (object)) return Qcompiled_function; if (GC_BUFFERP (object)) return Qbuffer; #ifdef MULTI_FRAME if (GC_FRAMEP (object)) return Qframe; #endif return Qvector; #ifdef LISP_FLOAT_TYPE case Lisp_Float: return Qfloat; #endif default: abort (); } } DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, "T if OBJECT is a cons cell.") (object) Lisp_Object object; { if (CONSP (object)) return Qt; return Qnil; } DEFUN ("atom", Fatom, Satom, 1, 1, 0, "T if OBJECT is not a cons cell. This includes nil.") (object) Lisp_Object object; { if (CONSP (object)) return Qnil; return Qt; } DEFUN ("listp", Flistp, Slistp, 1, 1, 0, "T if OBJECT is a list. This includes nil.") (object) Lisp_Object object; { if (CONSP (object) || NILP (object)) return Qt; return Qnil; } DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, "T if OBJECT is not a list. Lists include nil.") (object) Lisp_Object object; { if (CONSP (object) || NILP (object)) return Qnil; return Qt; } DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, "T if OBJECT is a symbol.") (object) Lisp_Object object; { if (SYMBOLP (object)) return Qt; return Qnil; } DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, "T if OBJECT is a vector.") (object) Lisp_Object object; { if (VECTORP (object)) return Qt; return Qnil; } DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, "T if OBJECT is a string.") (object) Lisp_Object object; { if (STRINGP (object)) return Qt; return Qnil; } DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0, "T if OBJECT is a char-table.") (object) Lisp_Object object; { if (CHAR_TABLE_P (object)) return Qt; return Qnil; } DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p, Svector_or_char_table_p, 1, 1, 0, "T if OBJECT is a char-table or vector.") (object) Lisp_Object object; { if (VECTORP (object) || CHAR_TABLE_P (object)) return Qt; return Qnil; } DEFUN ("bool-vector-p", Fbool_vector_p, Sbool_vector_p, 1, 1, 0, "T if OBJECT is a bool-vector.") (object) Lisp_Object object; { if (BOOL_VECTOR_P (object)) return Qt; return Qnil; } DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, "T if OBJECT is an array (string or vector).") (object) Lisp_Object object; { if (VECTORP (object) || STRINGP (object)) return Qt; return Qnil; } DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0, "T if OBJECT is a sequence (list or array).") (object) register Lisp_Object object; { if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object) || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object)) return Qt; return Qnil; } DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, "T if OBJECT is an editor buffer.") (object) Lisp_Object object; { if (BUFFERP (object)) return Qt; return Qnil; } DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0, "T if OBJECT is a marker (editor pointer).") (object) Lisp_Object object; { if (MARKERP (object)) return Qt; return Qnil; } DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, "T if OBJECT is a built-in function.") (object) Lisp_Object object; { if (SUBRP (object)) return Qt; return Qnil; } DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, 1, 1, 0, "T if OBJECT is a byte-compiled function object.") (object) Lisp_Object object; { if (COMPILEDP (object)) return Qt; return Qnil; } DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, "T if OBJECT is a character (an integer) or a string.") (object) register Lisp_Object object; { if (INTEGERP (object) || STRINGP (object)) return Qt; return Qnil; } DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, "T if OBJECT is an integer.") (object) Lisp_Object object; { if (INTEGERP (object)) return Qt; return Qnil; } DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0, "T if OBJECT is an integer or a marker (editor pointer).") (object) register Lisp_Object object; { if (MARKERP (object) || INTEGERP (object)) return Qt; return Qnil; } DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, "T if OBJECT is a nonnegative integer.") (object) Lisp_Object object; { if (NATNUMP (object)) return Qt; return Qnil; } DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0, "T if OBJECT is a number (floating point or integer).") (object) Lisp_Object object; { if (NUMBERP (object)) return Qt; else return Qnil; } DEFUN ("number-or-marker-p", Fnumber_or_marker_p, Snumber_or_marker_p, 1, 1, 0, "T if OBJECT is a number or a marker.") (object) Lisp_Object object; { if (NUMBERP (object) || MARKERP (object)) return Qt; return Qnil; } #ifdef LISP_FLOAT_TYPE DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0, "T if OBJECT is a floating point number.") (object) Lisp_Object object; { if (FLOATP (object)) return Qt; return Qnil; } #endif /* LISP_FLOAT_TYPE */ /* Extract and set components of lists */ DEFUN ("car", Fcar, Scar, 1, 1, 0, "Return the car of LIST. If arg is nil, return nil.\n\ Error if arg is not nil and not a cons cell. See also `car-safe'.") (list) register Lisp_Object list; { while (1) { if (CONSP (list)) return XCONS (list)->car; else if (EQ (list, Qnil)) return Qnil; else list = wrong_type_argument (Qlistp, list); } } DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, "Return the car of OBJECT if it is a cons cell, or else nil.") (object) Lisp_Object object; { if (CONSP (object)) return XCONS (object)->car; else return Qnil; } DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0, "Return the cdr of LIST. If arg is nil, return nil.\n\ Error if arg is not nil and not a cons cell. See also `cdr-safe'.") (list) register Lisp_Object list; { while (1) { if (CONSP (list)) return XCONS (list)->cdr; else if (EQ (list, Qnil)) return Qnil; else list = wrong_type_argument (Qlistp, list); } } DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0, "Return the cdr of OBJECT if it is a cons cell, or else nil.") (object) Lisp_Object object; { if (CONSP (object)) return XCONS (object)->cdr; else return Qnil; } DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, "Set the car of CELL to be NEWCAR. Returns NEWCAR.") (cell, newcar) register Lisp_Object cell, newcar; { if (!CONSP (cell)) cell = wrong_type_argument (Qconsp, cell); CHECK_IMPURE (cell); XCONS (cell)->car = newcar; return newcar; } DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0, "Set the cdr of CELL to be NEWCDR. Returns NEWCDR.") (cell, newcdr) register Lisp_Object cell, newcdr; { if (!CONSP (cell)) cell = wrong_type_argument (Qconsp, cell); CHECK_IMPURE (cell); XCONS (cell)->cdr = newcdr; return newcdr; } /* Extract and set components of symbols */ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, "T if SYMBOL's value is not void.") (sym) register Lisp_Object sym; { Lisp_Object valcontents; CHECK_SYMBOL (sym, 0); valcontents = XSYMBOL (sym)->value; if (BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) valcontents = swap_in_symval_forwarding (sym, valcontents); return (EQ (valcontents, Qunbound) ? Qnil : Qt); } DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, "T if SYMBOL's function definition is not void.") (sym) register Lisp_Object sym; { CHECK_SYMBOL (sym, 0); return (EQ (XSYMBOL (sym)->function, Qunbound) ? Qnil : Qt); } DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, "Make SYMBOL's value be void.") (sym) register Lisp_Object sym; { CHECK_SYMBOL (sym, 0); if (NILP (sym) || EQ (sym, Qt)) return Fsignal (Qsetting_constant, Fcons (sym, Qnil)); Fset (sym, Qunbound); return sym; } DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, "Make SYMBOL's function definition be void.") (sym) register Lisp_Object sym; { CHECK_SYMBOL (sym, 0); if (NILP (sym) || EQ (sym, Qt)) return Fsignal (Qsetting_constant, Fcons (sym, Qnil)); XSYMBOL (sym)->function = Qunbound; return sym; } DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0, "Return SYMBOL's function definition. Error if that is void.") (symbol) register Lisp_Object symbol; { CHECK_SYMBOL (symbol, 0); if (EQ (XSYMBOL (symbol)->function, Qunbound)) return Fsignal (Qvoid_function, Fcons (symbol, Qnil)); return XSYMBOL (symbol)->function; } DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, "Return SYMBOL's property list.") (sym) register Lisp_Object sym; { CHECK_SYMBOL (sym, 0); return XSYMBOL (sym)->plist; } DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, "Return SYMBOL's name, a string.") (sym) register Lisp_Object sym; { register Lisp_Object name; CHECK_SYMBOL (sym, 0); XSETSTRING (name, XSYMBOL (sym)->name); return name; } DEFUN ("fset", Ffset, Sfset, 2, 2, 0, "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.") (sym, newdef) register Lisp_Object sym, newdef; { CHECK_SYMBOL (sym, 0); if (NILP (sym) || EQ (sym, Qt)) return Fsignal (Qsetting_constant, Fcons (sym, Qnil)); if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (sym)->function, Qunbound)) Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function), Vautoload_queue); XSYMBOL (sym)->function = newdef; /* Handle automatic advice activation */ if (CONSP (XSYMBOL (sym)->plist) && !NILP (Fget (sym, Qad_advice_info))) { call2 (Qad_activate, sym, Qnil); newdef = XSYMBOL (sym)->function; } return newdef; } /* This name should be removed once it is eliminated from elsewhere. */ DEFUN ("defalias", Fdefalias, Sdefalias, 2, 2, 0, "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\ Associates the function with the current load file, if any.") (sym, newdef) register Lisp_Object sym, newdef; { CHECK_SYMBOL (sym, 0); if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (sym)->function, Qunbound)) Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function), Vautoload_queue); XSYMBOL (sym)->function = newdef; /* Handle automatic advice activation */ if (CONSP (XSYMBOL (sym)->plist) && !NILP (Fget (sym, Qad_advice_info))) { call2 (Qad_activate, sym, Qnil); newdef = XSYMBOL (sym)->function; } LOADHIST_ATTACH (sym); return newdef; } DEFUN ("define-function", Fdefine_function, Sdefine_function, 2, 2, 0, "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\ Associates the function with the current load file, if any.") (sym, newdef) register Lisp_Object sym, newdef; { CHECK_SYMBOL (sym, 0); if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (sym)->function, Qunbound)) Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function), Vautoload_queue); XSYMBOL (sym)->function = newdef; /* Handle automatic advice activation */ if (CONSP (XSYMBOL (sym)->plist) && !NILP (Fget (sym, Qad_advice_info))) { call2 (Qad_activate, sym, Qnil); newdef = XSYMBOL (sym)->function; } LOADHIST_ATTACH (sym); return newdef; } DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0, "Set SYMBOL's property list to NEWVAL, and return NEWVAL.") (sym, newplist) register Lisp_Object sym, newplist; { CHECK_SYMBOL (sym, 0); XSYMBOL (sym)->plist = newplist; return newplist; } /* Getting and setting values of symbols */ /* Given the raw contents of a symbol value cell, return the Lisp value of the symbol. This does not handle buffer-local variables; use swap_in_symval_forwarding for that. */ Lisp_Object do_symval_forwarding (valcontents) register Lisp_Object valcontents; { register Lisp_Object val; int offset; if (MISCP (valcontents)) switch (XMISCTYPE (valcontents)) { case Lisp_Misc_Intfwd: XSETINT (val, *XINTFWD (valcontents)->intvar); return val; case Lisp_Misc_Boolfwd: return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil); case Lisp_Misc_Objfwd: return *XOBJFWD (valcontents)->objvar; case Lisp_Misc_Buffer_Objfwd: offset = XBUFFER_OBJFWD (valcontents)->offset; return *(Lisp_Object *)(offset + (char *)current_buffer); case Lisp_Misc_Kboard_Objfwd: offset = XKBOARD_OBJFWD (valcontents)->offset; return *(Lisp_Object *)(offset + (char *)current_kboard); } return valcontents; } /* Store NEWVAL into SYM, where VALCONTENTS is found in the value cell of SYM. If SYM is buffer-local, VALCONTENTS should be the buffer-independent contents of the value cell: forwarded just one step past the buffer-localness. */ void store_symval_forwarding (sym, valcontents, newval) Lisp_Object sym; register Lisp_Object valcontents, newval; { switch (SWITCH_ENUM_CAST (XTYPE (valcontents))) { case Lisp_Misc: switch (XMISCTYPE (valcontents)) { case Lisp_Misc_Intfwd: CHECK_NUMBER (newval, 1); *XINTFWD (valcontents)->intvar = XINT (newval); if (*XINTFWD (valcontents)->intvar != XINT (newval)) error ("Value out of range for variable `%s'", XSYMBOL (sym)->name->data); break; case Lisp_Misc_Boolfwd: *XBOOLFWD (valcontents)->boolvar = NILP (newval) ? 0 : 1; break; case Lisp_Misc_Objfwd: *XOBJFWD (valcontents)->objvar = newval; break; case Lisp_Misc_Buffer_Objfwd: { int offset = XBUFFER_OBJFWD (valcontents)->offset; Lisp_Object type; type = *(Lisp_Object *)(offset + (char *)&buffer_local_types); if (! NILP (type) && ! NILP (newval) && XTYPE (newval) != XINT (type)) buffer_slot_type_mismatch (offset); *(Lisp_Object *)(offset + (char *)current_buffer) = newval; } break; case Lisp_Misc_Kboard_Objfwd: (*(Lisp_Object *)((char *)current_kboard + XKBOARD_OBJFWD (valcontents)->offset)) = newval; break; default: goto def; } break; default: def: valcontents = XSYMBOL (sym)->value; if (BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) XBUFFER_LOCAL_VALUE (valcontents)->car = newval; else XSYMBOL (sym)->value = newval; } } /* Set up the buffer-local symbol SYM for validity in the current buffer. VALCONTENTS is the contents of its value cell. Return the value forwarded one step past the buffer-local indicator. */ static Lisp_Object swap_in_symval_forwarding (sym, valcontents) Lisp_Object sym, valcontents; { /* valcontents is a pointer to a struct resembling the cons (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)). CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's local_var_alist, that being the element whose car is this variable. Or it can be a pointer to the (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have an element in its alist for this variable. If the current buffer is not BUFFER, we store the current REALVALUE value into CURRENT-ALIST-ELEMENT, then find the appropriate alist element for the buffer now current and set up CURRENT-ALIST-ELEMENT. Then we set REALVALUE out of that element, and store into BUFFER. Note that REALVALUE can be a forwarding pointer. */ register Lisp_Object tem1; tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car; if (NILP (tem1) || current_buffer != XBUFFER (tem1)) { tem1 = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car; Fsetcdr (tem1, do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car)); tem1 = assq_no_quit (sym, current_buffer->local_var_alist); if (NILP (tem1)) tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr; XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car = tem1; XSETBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car, current_buffer); store_symval_forwarding (sym, XBUFFER_LOCAL_VALUE (valcontents)->car, Fcdr (tem1)); } return XBUFFER_LOCAL_VALUE (valcontents)->car; } /* Find the value of a symbol, returning Qunbound if it's not bound. This is helpful for code which just wants to get a variable's value if it has one, without signalling an error. Note that it must not be possible to quit within this function. Great care is required for this. */ Lisp_Object find_symbol_value (sym) Lisp_Object sym; { register Lisp_Object valcontents, tem1; register Lisp_Object val; CHECK_SYMBOL (sym, 0); valcontents = XSYMBOL (sym)->value; if (BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) valcontents = swap_in_symval_forwarding (sym, valcontents); if (MISCP (valcontents)) { switch (XMISCTYPE (valcontents)) { case Lisp_Misc_Intfwd: XSETINT (val, *XINTFWD (valcontents)->intvar); return val; case Lisp_Misc_Boolfwd: return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil); case Lisp_Misc_Objfwd: return *XOBJFWD (valcontents)->objvar; case Lisp_Misc_Buffer_Objfwd: return *(Lisp_Object *)(XBUFFER_OBJFWD (valcontents)->offset + (char *)current_buffer); case Lisp_Misc_Kboard_Objfwd: return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset + (char *)current_kboard); } } return valcontents; } DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0, "Return SYMBOL's value. Error if that is void.") (sym) Lisp_Object sym; { Lisp_Object val; val = find_symbol_value (sym); if (EQ (val, Qunbound)) return Fsignal (Qvoid_variable, Fcons (sym, Qnil)); else return val; } DEFUN ("set", Fset, Sset, 2, 2, 0, "Set SYMBOL's value to NEWVAL, and return NEWVAL.") (sym, newval) register Lisp_Object sym, newval; { int voide = EQ (newval, Qunbound); register Lisp_Object valcontents, tem1, current_alist_element; CHECK_SYMBOL (sym, 0); if (NILP (sym) || EQ (sym, Qt)) return Fsignal (Qsetting_constant, Fcons (sym, Qnil)); valcontents = XSYMBOL (sym)->value; if (BUFFER_OBJFWDP (valcontents)) { register int idx = XBUFFER_OBJFWD (valcontents)->offset; register int mask = XINT (*((Lisp_Object *) (idx + (char *)&buffer_local_flags))); if (mask > 0) current_buffer->local_var_flags |= mask; } else if (BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) { /* valcontents is actually a pointer to a struct resembling a cons, with contents something like: (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE). BUFFER is the last buffer for which this symbol's value was made up to date. CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's local_var_alist, that being the element whose car is this variable. Or it can be a pointer to the (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have an element in its alist for this variable (that is, if BUFFER sees the default value of this variable). If we want to examine or set the value and BUFFER is current, we just examine or set REALVALUE. If BUFFER is not current, we store the current REALVALUE value into CURRENT-ALIST-ELEMENT, then find the appropriate alist element for the buffer now current and set up CURRENT-ALIST-ELEMENT. Then we set REALVALUE out of that element, and store into BUFFER. If we are setting the variable and the current buffer does not have an alist entry for this variable, an alist entry is created. Note that REALVALUE can be a forwarding pointer. Each time it is examined or set, forwarding must be done. */ /* What value are we caching right now? */ current_alist_element = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car; /* If the current buffer is not the buffer whose binding is currently cached, or if it's a Lisp_Buffer_Local_Value and we're looking at the default value, the cache is invalid; we need to write it out, and find the new CURRENT-ALIST-ELEMENT. */ if ((current_buffer != XBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car)) || (BUFFER_LOCAL_VALUEP (valcontents) && EQ (XCONS (current_alist_element)->car, current_alist_element))) { /* Write out the cached value for the old buffer; copy it back to its alist element. This works if the current buffer only sees the default value, too. */ Fsetcdr (current_alist_element, do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car)); /* Find the new value for CURRENT-ALIST-ELEMENT. */ tem1 = Fassq (sym, current_buffer->local_var_alist); if (NILP (tem1)) { /* This buffer still sees the default value. */ /* If the variable is a Lisp_Some_Buffer_Local_Value, make CURRENT-ALIST-ELEMENT point to itself, indicating that we're seeing the default value. */ if (SOME_BUFFER_LOCAL_VALUEP (valcontents)) tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr; /* If it's a Lisp_Buffer_Local_Value, give this buffer a new assoc for a local value and set CURRENT-ALIST-ELEMENT to point to that. */ else { tem1 = Fcons (sym, Fcdr (current_alist_element)); current_buffer->local_var_alist = Fcons (tem1, current_buffer->local_var_alist); } } /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */ XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car = tem1; /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */ XSETBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car, current_buffer); } valcontents = XBUFFER_LOCAL_VALUE (valcontents)->car; } /* If storing void (making the symbol void), forward only through buffer-local indicator, not through Lisp_Objfwd, etc. */ if (voide) store_symval_forwarding (sym, Qnil, newval); else store_symval_forwarding (sym, valcontents, newval); return newval; } /* Access or set a buffer-local symbol's default value. */ /* Return the default value of SYM, but don't check for voidness. Return Qunbound if it is void. */ Lisp_Object default_value (sym) Lisp_Object sym; { register Lisp_Object valcontents; CHECK_SYMBOL (sym, 0); valcontents = XSYMBOL (sym)->value; /* For a built-in buffer-local variable, get the default value rather than letting do_symval_forwarding get the current value. */ if (BUFFER_OBJFWDP (valcontents)) { register int idx = XBUFFER_OBJFWD (valcontents)->offset; if (XINT (*(Lisp_Object *) (idx + (char *) &buffer_local_flags)) != 0) return *(Lisp_Object *)(idx + (char *) &buffer_defaults); } /* Handle user-created local variables. */ if (BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) { /* If var is set up for a buffer that lacks a local value for it, the current value is nominally the default value. But the current value slot may be more up to date, since ordinary setq stores just that slot. So use that. */ Lisp_Object current_alist_element, alist_element_car; current_alist_element = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car; alist_element_car = XCONS (current_alist_element)->car; if (EQ (alist_element_car, current_alist_element)) return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car); else return XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->cdr; } /* For other variables, get the current value. */ return do_symval_forwarding (valcontents); } DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0, "Return T if SYMBOL has a non-void default value.\n\ This is the value that is seen in buffers that do not have their own values\n\ for this variable.") (sym) Lisp_Object sym; { register Lisp_Object value; value = default_value (sym); return (EQ (value, Qunbound) ? Qnil : Qt); } DEFUN ("default-value", Fdefault_value, Sdefault_value, 1, 1, 0, "Return SYMBOL's default value.\n\ This is the value that is seen in buffers that do not have their own values\n\ for this variable. The default value is meaningful for variables with\n\ local bindings in certain buffers.") (sym) Lisp_Object sym; { register Lisp_Object value; value = default_value (sym); if (EQ (value, Qunbound)) return Fsignal (Qvoid_variable, Fcons (sym, Qnil)); return value; } DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0, "Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.\n\ The default value is seen in buffers that do not have their own values\n\ for this variable.") (sym, value) Lisp_Object sym, value; { register Lisp_Object valcontents, current_alist_element, alist_element_buffer; CHECK_SYMBOL (sym, 0); valcontents = XSYMBOL (sym)->value; /* Handle variables like case-fold-search that have special slots in the buffer. Make them work apparently like Lisp_Buffer_Local_Value variables. */ if (BUFFER_OBJFWDP (valcontents)) { register int idx = XBUFFER_OBJFWD (valcontents)->offset; register struct buffer *b; register int mask = XINT (*((Lisp_Object *) (idx + (char *)&buffer_local_flags))); if (mask > 0) { *(Lisp_Object *)(idx + (char *) &buffer_defaults) = value; for (b = all_buffers; b; b = b->next) if (!(b->local_var_flags & mask)) *(Lisp_Object *)(idx + (char *) b) = value; } return value; } if (!BUFFER_LOCAL_VALUEP (valcontents) && !SOME_BUFFER_LOCAL_VALUEP (valcontents)) return Fset (sym, value); /* Store new value into the DEFAULT-VALUE slot */ XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->cdr = value; /* If that slot is current, we must set the REALVALUE slot too */ current_alist_element = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car; alist_element_buffer = Fcar (current_alist_element); if (EQ (alist_element_buffer, current_alist_element)) store_symval_forwarding (sym, XBUFFER_LOCAL_VALUE (valcontents)->car, value); return value; } DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0, "Set the default value of variable VAR to VALUE.\n\ VAR, the variable name, is literal (not evaluated);\n\ VALUE is an expression and it is evaluated.\n\ The default value of a variable is seen in buffers\n\ that do not have their own values for the variable.\n\ \n\ More generally, you can use multiple variables and values, as in\n\ (setq-default SYM VALUE SYM VALUE...)\n\ This sets each SYM's default value to the corresponding VALUE.\n\ The VALUE for the Nth SYM can refer to the new default values\n\ of previous SYMs.") (args) Lisp_Object args; { register Lisp_Object args_left; register Lisp_Object val, sym; struct gcpro gcpro1; if (NILP (args)) return Qnil; args_left = args; GCPRO1 (args); do { val = Feval (Fcar (Fcdr (args_left))); sym = Fcar (args_left); Fset_default (sym, val); args_left = Fcdr (Fcdr (args_left)); } while (!NILP (args_left)); UNGCPRO; return val; } /* Lisp functions for creating and removing buffer-local variables. */ DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local, 1, 1, "vMake Variable Buffer Local: ", "Make VARIABLE have a separate value for each buffer.\n\ At any time, the value for the current buffer is in effect.\n\ There is also a default value which is seen in any buffer which has not yet\n\ set its own value.\n\ Using `set' or `setq' to set the variable causes it to have a separate value\n\ for the current buffer if it was previously using the default value.\n\ The function `default-value' gets the default value and `set-default' sets it.") (sym) register Lisp_Object sym; { register Lisp_Object tem, valcontents, newval; CHECK_SYMBOL (sym, 0); valcontents = XSYMBOL (sym)->value; if (EQ (sym, Qnil) || EQ (sym, Qt) || KBOARD_OBJFWDP (valcontents)) error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data); if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents)) return sym; if (SOME_BUFFER_LOCAL_VALUEP (valcontents)) { XMISCTYPE (XSYMBOL (sym)->value) = Lisp_Misc_Buffer_Local_Value; return sym; } if (EQ (valcontents, Qunbound)) XSYMBOL (sym)->value = Qnil; tem = Fcons (Qnil, Fsymbol_value (sym)); XCONS (tem)->car = tem; newval = allocate_misc (); XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value; XBUFFER_LOCAL_VALUE (newval)->car = XSYMBOL (sym)->value; XBUFFER_LOCAL_VALUE (newval)->cdr = Fcons (Fcurrent_buffer (), tem); XSYMBOL (sym)->value = newval; return sym; } DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable, 1, 1, "vMake Local Variable: ", "Make VARIABLE have a separate value in the current buffer.\n\ Other buffers will continue to share a common default value.\n\ \(The buffer-local value of VARIABLE starts out as the same value\n\ VARIABLE previously had. If VARIABLE was void, it remains void.\)\n\ See also `make-variable-buffer-local'.\n\n\ If the variable is already arranged to become local when set,\n\ this function causes a local value to exist for this buffer,\n\ just as setting the variable would do.\n\ \n\ Do not use `make-local-variable' to make a hook variable buffer-local.\n\ Use `make-local-hook' instead.") (sym) register Lisp_Object sym; { register Lisp_Object tem, valcontents; CHECK_SYMBOL (sym, 0); valcontents = XSYMBOL (sym)->value; if (EQ (sym, Qnil) || EQ (sym, Qt) || KBOARD_OBJFWDP (valcontents)) error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data); if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents)) { tem = Fboundp (sym); /* Make sure the symbol has a local value in this particular buffer, by setting it to the same value it already has. */ Fset (sym, (EQ (tem, Qt) ? Fsymbol_value (sym) : Qunbound)); return sym; } /* Make sure sym is set up to hold per-buffer values */ if (!SOME_BUFFER_LOCAL_VALUEP (valcontents)) { Lisp_Object newval; tem = Fcons (Qnil, do_symval_forwarding (valcontents)); XCONS (tem)->car = tem; newval = allocate_misc (); XMISCTYPE (newval) = Lisp_Misc_Some_Buffer_Local_Value; XBUFFER_LOCAL_VALUE (newval)->car = XSYMBOL (sym)->value; XBUFFER_LOCAL_VALUE (newval)->cdr = Fcons (Qnil, tem); XSYMBOL (sym)->value = newval; } /* Make sure this buffer has its own value of sym */ tem = Fassq (sym, current_buffer->local_var_alist); if (NILP (tem)) { /* Swap out any local binding for some other buffer, and make sure the current value is permanently recorded, if it's the default value. */ find_symbol_value (sym); current_buffer->local_var_alist = Fcons (Fcons (sym, XCONS (XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->cdr)->cdr), current_buffer->local_var_alist); /* Make sure symbol does not think it is set up for this buffer; force it to look once again for this buffer's value */ { Lisp_Object *pvalbuf; valcontents = XSYMBOL (sym)->value; pvalbuf = &XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car; if (current_buffer == XBUFFER (*pvalbuf)) *pvalbuf = Qnil; } } /* If the symbol forwards into a C variable, then swap in the variable for this buffer immediately. If C code modifies the variable before we swap in, then that new value will clobber the default value the next time we swap. */ valcontents = XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->car; if (INTFWDP (valcontents) || BOOLFWDP (valcontents) || OBJFWDP (valcontents)) swap_in_symval_forwarding (sym, XSYMBOL (sym)->value); return sym; } DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable, 1, 1, "vKill Local Variable: ", "Make VARIABLE no longer have a separate value in the current buffer.\n\ From now on the default value will apply in this buffer.") (sym) register Lisp_Object sym; { register Lisp_Object tem, valcontents; CHECK_SYMBOL (sym, 0); valcontents = XSYMBOL (sym)->value; if (BUFFER_OBJFWDP (valcontents)) { register int idx = XBUFFER_OBJFWD (valcontents)->offset; register int mask = XINT (*((Lisp_Object*) (idx + (char *)&buffer_local_flags))); if (mask > 0) { *(Lisp_Object *)(idx + (char *) current_buffer) = *(Lisp_Object *)(idx + (char *) &buffer_defaults); current_buffer->local_var_flags &= ~mask; } return sym; } if (!BUFFER_LOCAL_VALUEP (valcontents) && !SOME_BUFFER_LOCAL_VALUEP (valcontents)) return sym; /* Get rid of this buffer's alist element, if any */ tem = Fassq (sym, current_buffer->local_var_alist); if (!NILP (tem)) current_buffer->local_var_alist = Fdelq (tem, current_buffer->local_var_alist); /* Make sure symbol does not think it is set up for this buffer; force it to look once again for this buffer's value */ { Lisp_Object *pvalbuf; valcontents = XSYMBOL (sym)->value; pvalbuf = &XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car; if (current_buffer == XBUFFER (*pvalbuf)) *pvalbuf = Qnil; } return sym; } DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p, 1, 2, 0, "Non-nil if VARIABLE has a local binding in buffer BUFFER.\n\ BUFFER defaults to the current buffer.") (sym, buffer) register Lisp_Object sym, buffer; { Lisp_Object valcontents; register struct buffer *buf; if (NILP (buffer)) buf = current_buffer; else { CHECK_BUFFER (buffer, 0); buf = XBUFFER (buffer); } CHECK_SYMBOL (sym, 0); valcontents = XSYMBOL (sym)->value; if (BUFFER_LOCAL_VALUEP (valcontents) || SOME_BUFFER_LOCAL_VALUEP (valcontents)) { Lisp_Object tail, elt; for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr) { elt = XCONS (tail)->car; if (EQ (sym, XCONS (elt)->car)) return Qt; } } if (BUFFER_OBJFWDP (valcontents)) { int offset = XBUFFER_OBJFWD (valcontents)->offset; int mask = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags)); if (mask == -1 || (buf->local_var_flags & mask)) return Qt; } return Qnil; } DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p, 1, 2, 0, "Non-nil if VARIABLE will be local in buffer BUFFER if it is set there.\n\ BUFFER defaults to the current buffer.") (sym, buffer) register Lisp_Object sym, buffer; { Lisp_Object valcontents; register struct buffer *buf; if (NILP (buffer)) buf = current_buffer; else { CHECK_BUFFER (buffer, 0); buf = XBUFFER (buffer); } CHECK_SYMBOL (sym, 0); valcontents = XSYMBOL (sym)->value; /* This means that make-variable-buffer-local was done. */ if (BUFFER_LOCAL_VALUEP (valcontents)) return Qt; /* All these slots become local if they are set. */ if (BUFFER_OBJFWDP (valcontents)) return Qt; if (SOME_BUFFER_LOCAL_VALUEP (valcontents)) { Lisp_Object tail, elt; for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr) { elt = XCONS (tail)->car; if (EQ (sym, XCONS (elt)->car)) return Qt; } } return Qnil; } /* Find the function at the end of a chain of symbol function indirections. */ /* If OBJECT is a symbol, find the end of its function chain and return the value found there. If OBJECT is not a symbol, just return it. If there is a cycle in the function chain, signal a cyclic-function-indirection error. This is like Findirect_function, except that it doesn't signal an error if the chain ends up unbound. */ Lisp_Object indirect_function (object) register Lisp_Object object; { Lisp_Object tortoise, hare; hare = tortoise = object; for (;;) { if (!SYMBOLP (hare) || EQ (hare, Qunbound)) break; hare = XSYMBOL (hare)->function; if (!SYMBOLP (hare) || EQ (hare, Qunbound)) break; hare = XSYMBOL (hare)->function; tortoise = XSYMBOL (tortoise)->function; if (EQ (hare, tortoise)) Fsignal (Qcyclic_function_indirection, Fcons (object, Qnil)); } return hare; } DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 1, 0, "Return the function at the end of OBJECT's function chain.\n\ If OBJECT is a symbol, follow all function indirections and return the final\n\ function binding.\n\ If OBJECT is not a symbol, just return it.\n\ Signal a void-function error if the final symbol is unbound.\n\ Signal a cyclic-function-indirection error if there is a loop in the\n\ function chain of symbols.") (object) register Lisp_Object object; { Lisp_Object result; result = indirect_function (object); if (EQ (result, Qunbound)) return Fsignal (Qvoid_function, Fcons (object, Qnil)); return result; } /* Extract and set vector and string elements */ DEFUN ("aref", Faref, Saref, 2, 2, 0, "Return the element of ARRAY at index INDEX.\n\ ARRAY may be a vector, a string, a char-table, a bool-vector,\n\ or a byte-code object. INDEX starts at 0.") (array, idx) register Lisp_Object array; Lisp_Object idx; { register int idxval; CHECK_NUMBER (idx, 1); idxval = XINT (idx); if (STRINGP (array)) { Lisp_Object val; if (idxval < 0 || idxval >= XSTRING (array)->size) args_out_of_range (array, idx); XSETFASTINT (val, (unsigned char) XSTRING (array)->data[idxval]); return val; } else if (BOOL_VECTOR_P (array)) { int val; if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size) args_out_of_range (array, idx); val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR]; return (val & (1 << (idxval % BITS_PER_CHAR)) ? Qt : Qnil); } else if (CHAR_TABLE_P (array)) { Lisp_Object val; if (idxval < 0) args_out_of_range (array, idx); #if 1 if ((unsigned) idxval >= CHAR_TABLE_ORDINARY_SLOTS) args_out_of_range (array, idx); return val = XCHAR_TABLE (array)->contents[idxval]; #else /* 0 */ if ((unsigned) idxval < CHAR_TABLE_ORDINARY_SLOTS) val = XCHAR_TABLE (array)->data[idxval]; else { int charset; unsigned char c1, c2; Lisp_Object val, temp; BREAKUP_NON_ASCII_CHAR (idxval, charset, c1, c2); try_parent_char_table: val = XCHAR_TABLE (array)->contents[charset]; if (c1 == 0 || !CHAR_TABLE_P (val)) return val; temp = XCHAR_TABLE (val)->contents[c1]; if (NILP (temp)) val = XCHAR_TABLE (val)->defalt; else val = temp; if (NILP (val) && !NILP (XCHAR_TABLE (array)->parent)) { array = XCHAR_TABLE (array)->parent; goto try_parent_char_table; } if (c2 == 0 || !CHAR_TABLE_P (val)) return val; temp = XCHAR_TABLE (val)->contents[c2]; if (NILP (temp)) val = XCHAR_TABLE (val)->defalt; else val = temp; if (NILP (val) && !NILP (XCHAR_TABLE (array)->parent)) { array = XCHAR_TABLE (array)->parent; goto try_parent_char_table; } return val; } #endif /* 0 */ } else { int size; if (VECTORP (array)) size = XVECTOR (array)->size; else if (COMPILEDP (array)) size = XVECTOR (array)->size & PSEUDOVECTOR_SIZE_MASK; else wrong_type_argument (Qarrayp, array); if (idxval < 0 || idxval >= size) args_out_of_range (array, idx); return XVECTOR (array)->contents[idxval]; } } DEFUN ("aset", Faset, Saset, 3, 3, 0, "Store into the element of ARRAY at index IDX the value NEWELT.\n\ ARRAY may be a vector or a string. IDX starts at 0.") (array, idx, newelt) register Lisp_Object array; Lisp_Object idx, newelt; { register int idxval; CHECK_NUMBER (idx, 1); idxval = XINT (idx); if (!VECTORP (array) && !STRINGP (array) && !BOOL_VECTOR_P (array) && ! CHAR_TABLE_P (array)) array = wrong_type_argument (Qarrayp, array); CHECK_IMPURE (array); if (VECTORP (array)) { if (idxval < 0 || idxval >= XVECTOR (array)->size) args_out_of_range (array, idx); XVECTOR (array)->contents[idxval] = newelt; } else if (BOOL_VECTOR_P (array)) { int val; if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size) args_out_of_range (array, idx); val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR]; if (! NILP (newelt)) val |= 1 << (idxval % BITS_PER_CHAR); else val &= ~(1 << (idxval % BITS_PER_CHAR)); XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR] = val; } else if (CHAR_TABLE_P (array)) { Lisp_Object val; if (idxval < 0) args_out_of_range (array, idx); #if 1 if (idxval >= CHAR_TABLE_ORDINARY_SLOTS) args_out_of_range (array, idx); XCHAR_TABLE (array)->contents[idxval] = newelt; return newelt; #else /* 0 */ if (idxval < CHAR_TABLE_ORDINARY_SLOTS) val = XCHAR_TABLE (array)->contents[idxval]; else { int charset; unsigned char c1, c2; Lisp_Object val, val2; BREAKUP_NON_ASCII_CHAR (idxval, charset, c1, c2); if (c1 == 0) return XCHAR_TABLE (array)->contents[charset] = newelt; val = XCHAR_TABLE (array)->contents[charset]; if (!CHAR_TABLE_P (val)) XCHAR_TABLE (array)->contents[charset] = val = Fmake_char_table (Qnil); if (c2 == 0) return XCHAR_TABLE (val)->contents[c1] = newelt; val2 = XCHAR_TABLE (val)->contents[c2]; if (!CHAR_TABLE_P (val2)) XCHAR_TABLE (val)->contents[charset] = val2 = Fmake_char_table (Qnil); return XCHAR_TABLE (val2)->contents[c2] = newelt; } #endif /* 0 */ } else { if (idxval < 0 || idxval >= XSTRING (array)->size) args_out_of_range (array, idx); CHECK_NUMBER (newelt, 2); XSTRING (array)->data[idxval] = XINT (newelt); } return newelt; } /* Arithmetic functions */ enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal }; Lisp_Object arithcompare (num1, num2, comparison) Lisp_Object num1, num2; enum comparison comparison; { double f1, f2; int floatp = 0; #ifdef LISP_FLOAT_TYPE CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0); CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 0); if (FLOATP (num1) || FLOATP (num2)) { floatp = 1; f1 = (FLOATP (num1)) ? XFLOAT (num1)->data : XINT (num1); f2 = (FLOATP (num2)) ? XFLOAT (num2)->data : XINT (num2); } #else CHECK_NUMBER_COERCE_MARKER (num1, 0); CHECK_NUMBER_COERCE_MARKER (num2, 0); #endif /* LISP_FLOAT_TYPE */ switch (comparison) { case equal: if (floatp ? f1 == f2 : XINT (num1) == XINT (num2)) return Qt; return Qnil; case notequal: if (floatp ? f1 != f2 : XINT (num1) != XINT (num2)) return Qt; return Qnil; case less: if (floatp ? f1 < f2 : XINT (num1) < XINT (num2)) return Qt; return Qnil; case less_or_equal: if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2)) return Qt; return Qnil; case grtr: if (floatp ? f1 > f2 : XINT (num1) > XINT (num2)) return Qt; return Qnil; case grtr_or_equal: if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2)) return Qt; return Qnil; default: abort (); } } DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0, "T if two args, both numbers or markers, are equal.") (num1, num2) register Lisp_Object num1, num2; { return arithcompare (num1, num2, equal); } DEFUN ("<", Flss, Slss, 2, 2, 0, "T if first arg is less than second arg. Both must be numbers or markers.") (num1, num2) register Lisp_Object num1, num2; { return arithcompare (num1, num2, less); } DEFUN (">", Fgtr, Sgtr, 2, 2, 0, "T if first arg is greater than second arg. Both must be numbers or markers.") (num1, num2) register Lisp_Object num1, num2; { return arithcompare (num1, num2, grtr); } DEFUN ("<=", Fleq, Sleq, 2, 2, 0, "T if first arg is less than or equal to second arg.\n\ Both must be numbers or markers.") (num1, num2) register Lisp_Object num1, num2; { return arithcompare (num1, num2, less_or_equal); } DEFUN (">=", Fgeq, Sgeq, 2, 2, 0, "T if first arg is greater than or equal to second arg.\n\ Both must be numbers or markers.") (num1, num2) register Lisp_Object num1, num2; { return arithcompare (num1, num2, grtr_or_equal); } DEFUN ("/=", Fneq, Sneq, 2, 2, 0, "T if first arg is not equal to second arg. Both must be numbers or markers.") (num1, num2) register Lisp_Object num1, num2; { return arithcompare (num1, num2, notequal); } DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, "T if NUMBER is zero.") (num) register Lisp_Object num; { #ifdef LISP_FLOAT_TYPE CHECK_NUMBER_OR_FLOAT (num, 0); if (FLOATP (num)) { if (XFLOAT(num)->data == 0.0) return Qt; return Qnil; } #else CHECK_NUMBER (num, 0); #endif /* LISP_FLOAT_TYPE */ if (!XINT (num)) return Qt; return Qnil; } /* Convert between long values and pairs of Lisp integers. */ Lisp_Object long_to_cons (i) unsigned long i; { unsigned int top = i >> 16; unsigned int bot = i & 0xFFFF; if (top == 0) return make_number (bot); if (top == (unsigned long)-1 >> 16) return Fcons (make_number (-1), make_number (bot)); return Fcons (make_number (top), make_number (bot)); } unsigned long cons_to_long (c) Lisp_Object c; { Lisp_Object top, bot; if (INTEGERP (c)) return XINT (c); top = XCONS (c)->car; bot = XCONS (c)->cdr; if (CONSP (bot)) bot = XCONS (bot)->car; return ((XINT (top) << 16) | XINT (bot)); } DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0, "Convert NUM to a string by printing it in decimal.\n\ Uses a minus sign if negative.\n\ NUM may be an integer or a floating point number.") (num) Lisp_Object num; { char buffer[VALBITS]; #ifndef LISP_FLOAT_TYPE CHECK_NUMBER (num, 0); #else CHECK_NUMBER_OR_FLOAT (num, 0); if (FLOATP (num)) { char pigbuf[350]; /* see comments in float_to_string */ float_to_string (pigbuf, XFLOAT(num)->data); return build_string (pigbuf); } #endif /* LISP_FLOAT_TYPE */ if (sizeof (int) == sizeof (EMACS_INT)) sprintf (buffer, "%d", XINT (num)); else if (sizeof (long) == sizeof (EMACS_INT)) sprintf (buffer, "%ld", XINT (num)); else abort (); return build_string (buffer); } DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 1, 0, "Convert STRING to a number by parsing it as a decimal number.\n\ This parses both integers and floating point numbers.\n\ It ignores leading spaces and tabs.") (str) register Lisp_Object str; { Lisp_Object value; unsigned char *p; CHECK_STRING (str, 0); p = XSTRING (str)->data; /* Skip any whitespace at the front of the number. Some versions of atoi do this anyway, so we might as well make Emacs lisp consistent. */ while (*p == ' ' || *p == '\t') p++; #ifdef LISP_FLOAT_TYPE if (isfloat_string (p)) return make_float (atof (p)); #endif /* LISP_FLOAT_TYPE */ if (sizeof (int) == sizeof (EMACS_INT)) XSETINT (value, atoi (p)); else if (sizeof (long) == sizeof (EMACS_INT)) XSETINT (value, atol (p)); else abort (); return value; } enum arithop { Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin }; extern Lisp_Object float_arith_driver (); Lisp_Object arith_driver (code, nargs, args) enum arithop code; int nargs; register Lisp_Object *args; { register Lisp_Object val; register int argnum; register EMACS_INT accum; register EMACS_INT next; switch (SWITCH_ENUM_CAST (code)) { case Alogior: case Alogxor: case Aadd: case Asub: accum = 0; break; case Amult: accum = 1; break; case Alogand: accum = -1; break; } for (argnum = 0; argnum < nargs; argnum++) { val = args[argnum]; /* using args[argnum] as argument to CHECK_NUMBER_... */ #ifdef LISP_FLOAT_TYPE CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum); if (FLOATP (val)) /* time to do serious math */ return (float_arith_driver ((double) accum, argnum, code, nargs, args)); #else CHECK_NUMBER_COERCE_MARKER (val, argnum); #endif /* LISP_FLOAT_TYPE */ args[argnum] = val; /* runs into a compiler bug. */ next = XINT (args[argnum]); switch (SWITCH_ENUM_CAST (code)) { case Aadd: accum += next; break; case Asub: if (!argnum && nargs != 1) next = - next; accum -= next; break; case Amult: accum *= next; break; case Adiv: if (!argnum) accum = next; else { if (next == 0) Fsignal (Qarith_error, Qnil); accum /= next; } break; case Alogand: accum &= next; break; case Alogior: accum |= next; break; case Alogxor: accum ^= next; break; case Amax: if (!argnum || next > accum) accum = next; break; case Amin: if (!argnum || next < accum) accum = next; break; } } XSETINT (val, accum); return val; } #ifdef LISP_FLOAT_TYPE #undef isnan #define isnan(x) ((x) != (x)) Lisp_Object float_arith_driver (accum, argnum, code, nargs, args) double accum; register int argnum; enum arithop code; int nargs; register Lisp_Object *args; { register Lisp_Object val; double next; for (; argnum < nargs; argnum++) { val = args[argnum]; /* using args[argnum] as argument to CHECK_NUMBER_... */ CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum); if (FLOATP (val)) { next = XFLOAT (val)->data; } else { args[argnum] = val; /* runs into a compiler bug. */ next = XINT (args[argnum]); } switch (SWITCH_ENUM_CAST (code)) { case Aadd: accum += next; break; case Asub: if (!argnum && nargs != 1) next = - next; accum -= next; break; case Amult: accum *= next; break; case Adiv: if (!argnum) accum = next; else { if (next == 0) Fsignal (Qarith_error, Qnil); accum /= next; } break; case Alogand: case Alogior: case Alogxor: return wrong_type_argument (Qinteger_or_marker_p, val); case Amax: if (!argnum || isnan (next) || next > accum) accum = next; break; case Amin: if (!argnum || isnan (next) || next < accum) accum = next; break; } } return make_float (accum); } #endif /* LISP_FLOAT_TYPE */ DEFUN ("+", Fplus, Splus, 0, MANY, 0, "Return sum of any number of arguments, which are numbers or markers.") (nargs, args) int nargs; Lisp_Object *args; { return arith_driver (Aadd, nargs, args); } DEFUN ("-", Fminus, Sminus, 0, MANY, 0, "Negate number or subtract numbers or markers.\n\ With one arg, negates it. With more than one arg,\n\ subtracts all but the first from the first.") (nargs, args) int nargs; Lisp_Object *args; { return arith_driver (Asub, nargs, args); } DEFUN ("*", Ftimes, Stimes, 0, MANY, 0, "Returns product of any number of arguments, which are numbers or markers.") (nargs, args) int nargs; Lisp_Object *args; { return arith_driver (Amult, nargs, args); } DEFUN ("/", Fquo, Squo, 2, MANY, 0, "Returns first argument divided by all the remaining arguments.\n\ The arguments must be numbers or markers.") (nargs, args) int nargs; Lisp_Object *args; { return arith_driver (Adiv, nargs, args); } DEFUN ("%", Frem, Srem, 2, 2, 0, "Returns remainder of first arg divided by second.\n\ Both must be integers or markers.") (num1, num2) register Lisp_Object num1, num2; { Lisp_Object val; CHECK_NUMBER_COERCE_MARKER (num1, 0); CHECK_NUMBER_COERCE_MARKER (num2, 1); if (XFASTINT (num2) == 0) Fsignal (Qarith_error, Qnil); XSETINT (val, XINT (num1) % XINT (num2)); return val; } #ifndef HAVE_FMOD double fmod (f1, f2) double f1, f2; { if (f2 < 0.0) f2 = -f2; return (f1 - f2 * floor (f1/f2)); } #endif /* ! HAVE_FMOD */ DEFUN ("mod", Fmod, Smod, 2, 2, 0, "Returns X modulo Y.\n\ The result falls between zero (inclusive) and Y (exclusive).\n\ Both X and Y must be numbers or markers.") (num1, num2) register Lisp_Object num1, num2; { Lisp_Object val; EMACS_INT i1, i2; #ifdef LISP_FLOAT_TYPE CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0); CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 1); if (FLOATP (num1) || FLOATP (num2)) { double f1, f2; f1 = FLOATP (num1) ? XFLOAT (num1)->data : XINT (num1); f2 = FLOATP (num2) ? XFLOAT (num2)->data : XINT (num2); if (f2 == 0) Fsignal (Qarith_error, Qnil); f1 = fmod (f1, f2); /* If the "remainder" comes out with the wrong sign, fix it. */ if (f2 < 0 ? f1 > 0 : f1 < 0) f1 += f2; return (make_float (f1)); } #else /* not LISP_FLOAT_TYPE */ CHECK_NUMBER_COERCE_MARKER (num1, 0); CHECK_NUMBER_COERCE_MARKER (num2, 1); #endif /* not LISP_FLOAT_TYPE */ i1 = XINT (num1); i2 = XINT (num2); if (i2 == 0) Fsignal (Qarith_error, Qnil); i1 %= i2; /* If the "remainder" comes out with the wrong sign, fix it. */ if (i2 < 0 ? i1 > 0 : i1 < 0) i1 += i2; XSETINT (val, i1); return val; } DEFUN ("max", Fmax, Smax, 1, MANY, 0, "Return largest of all the arguments (which must be numbers or markers).\n\ The value is always a number; markers are converted to numbers.") (nargs, args) int nargs; Lisp_Object *args; { return arith_driver (Amax, nargs, args); } DEFUN ("min", Fmin, Smin, 1, MANY, 0, "Return smallest of all the arguments (which must be numbers or markers).\n\ The value is always a number; markers are converted to numbers.") (nargs, args) int nargs; Lisp_Object *args; { return arith_driver (Amin, nargs, args); } DEFUN ("logand", Flogand, Slogand, 0, MANY, 0, "Return bitwise-and of all the arguments.\n\ Arguments may be integers, or markers converted to integers.") (nargs, args) int nargs; Lisp_Object *args; { return arith_driver (Alogand, nargs, args); } DEFUN ("logior", Flogior, Slogior, 0, MANY, 0, "Return bitwise-or of all the arguments.\n\ Arguments may be integers, or markers converted to integers.") (nargs, args) int nargs; Lisp_Object *args; { return arith_driver (Alogior, nargs, args); } DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0, "Return bitwise-exclusive-or of all the arguments.\n\ Arguments may be integers, or markers converted to integers.") (nargs, args) int nargs; Lisp_Object *args; { return arith_driver (Alogxor, nargs, args); } DEFUN ("ash", Fash, Sash, 2, 2, 0, "Return VALUE with its bits shifted left by COUNT.\n\ If COUNT is negative, shifting is actually to the right.\n\ In this case, the sign bit is duplicated.") (value, count) register Lisp_Object value, count; { register Lisp_Object val; CHECK_NUMBER (value, 0); CHECK_NUMBER (count, 1); if (XINT (count) > 0) XSETINT (val, XINT (value) << XFASTINT (count)); else XSETINT (val, XINT (value) >> -XINT (count)); return val; } DEFUN ("lsh", Flsh, Slsh, 2, 2, 0, "Return VALUE with its bits shifted left by COUNT.\n\ If COUNT is negative, shifting is actually to the right.\n\ In this case, zeros are shifted in on the left.") (value, count) register Lisp_Object value, count; { register Lisp_Object val; CHECK_NUMBER (value, 0); CHECK_NUMBER (count, 1); if (XINT (count) > 0) XSETINT (val, (EMACS_UINT) XUINT (value) << XFASTINT (count)); else XSETINT (val, (EMACS_UINT) XUINT (value) >> -XINT (count)); return val; } DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, "Return NUMBER plus one. NUMBER may be a number or a marker.\n\ Markers are converted to integers.") (num) register Lisp_Object num; { #ifdef LISP_FLOAT_TYPE CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num, 0); if (FLOATP (num)) return (make_float (1.0 + XFLOAT (num)->data)); #else CHECK_NUMBER_COERCE_MARKER (num, 0); #endif /* LISP_FLOAT_TYPE */ XSETINT (num, XINT (num) + 1); return num; } DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0, "Return NUMBER minus one. NUMBER may be a number or a marker.\n\ Markers are converted to integers.") (num) register Lisp_Object num; { #ifdef LISP_FLOAT_TYPE CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num, 0); if (FLOATP (num)) return (make_float (-1.0 + XFLOAT (num)->data)); #else CHECK_NUMBER_COERCE_MARKER (num, 0); #endif /* LISP_FLOAT_TYPE */ XSETINT (num, XINT (num) - 1); return num; } DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, "Return the bitwise complement of ARG. ARG must be an integer.") (num) register Lisp_Object num; { CHECK_NUMBER (num, 0); XSETINT (num, ~XINT (num)); return num; } void syms_of_data () { Lisp_Object error_tail, arith_tail; Qquote = intern ("quote"); Qlambda = intern ("lambda"); Qsubr = intern ("subr"); Qerror_conditions = intern ("error-conditions"); Qerror_message = intern ("error-message"); Qtop_level = intern ("top-level"); Qerror = intern ("error"); Qquit = intern ("quit"); Qwrong_type_argument = intern ("wrong-type-argument"); Qargs_out_of_range = intern ("args-out-of-range"); Qvoid_function = intern ("void-function"); Qcyclic_function_indirection = intern ("cyclic-function-indirection"); Qvoid_variable = intern ("void-variable"); Qsetting_constant = intern ("setting-constant"); Qinvalid_read_syntax = intern ("invalid-read-syntax"); Qinvalid_function = intern ("invalid-function"); Qwrong_number_of_arguments = intern ("wrong-number-of-arguments"); Qno_catch = intern ("no-catch"); Qend_of_file = intern ("end-of-file"); Qarith_error = intern ("arith-error"); Qbeginning_of_buffer = intern ("beginning-of-buffer"); Qend_of_buffer = intern ("end-of-buffer"); Qbuffer_read_only = intern ("buffer-read-only"); Qmark_inactive = intern ("mark-inactive"); Qlistp = intern ("listp"); Qconsp = intern ("consp"); Qsymbolp = intern ("symbolp"); Qintegerp = intern ("integerp"); Qnatnump = intern ("natnump"); Qwholenump = intern ("wholenump"); Qstringp = intern ("stringp"); Qarrayp = intern ("arrayp"); Qsequencep = intern ("sequencep"); Qbufferp = intern ("bufferp"); Qvectorp = intern ("vectorp"); Qchar_or_string_p = intern ("char-or-string-p"); Qmarkerp = intern ("markerp"); Qbuffer_or_string_p = intern ("buffer-or-string-p"); Qinteger_or_marker_p = intern ("integer-or-marker-p"); Qboundp = intern ("boundp"); Qfboundp = intern ("fboundp"); #ifdef LISP_FLOAT_TYPE Qfloatp = intern ("floatp"); Qnumberp = intern ("numberp"); Qnumber_or_marker_p = intern ("number-or-marker-p"); #endif /* LISP_FLOAT_TYPE */ Qchar_table_p = intern ("char-table-p"); Qvector_or_char_table_p = intern ("vector-or-char-table-p"); Qcdr = intern ("cdr"); /* Handle automatic advice activation */ Qad_advice_info = intern ("ad-advice-info"); Qad_activate = intern ("ad-activate"); error_tail = Fcons (Qerror, Qnil); /* ERROR is used as a signaler for random errors for which nothing else is right */ Fput (Qerror, Qerror_conditions, error_tail); Fput (Qerror, Qerror_message, build_string ("error")); Fput (Qquit, Qerror_conditions, Fcons (Qquit, Qnil)); Fput (Qquit, Qerror_message, build_string ("Quit")); Fput (Qwrong_type_argument, Qerror_conditions, Fcons (Qwrong_type_argument, error_tail)); Fput (Qwrong_type_argument, Qerror_message, build_string ("Wrong type argument")); Fput (Qargs_out_of_range, Qerror_conditions, Fcons (Qargs_out_of_range, error_tail)); Fput (Qargs_out_of_range, Qerror_message, build_string ("Args out of range")); Fput (Qvoid_function, Qerror_conditions, Fcons (Qvoid_function, error_tail)); Fput (Qvoid_function, Qerror_message, build_string ("Symbol's function definition is void")); Fput (Qcyclic_function_indirection, Qerror_conditions, Fcons (Qcyclic_function_indirection, error_tail)); Fput (Qcyclic_function_indirection, Qerror_message, build_string ("Symbol's chain of function indirections contains a loop")); Fput (Qvoid_variable, Qerror_conditions, Fcons (Qvoid_variable, error_tail)); Fput (Qvoid_variable, Qerror_message, build_string ("Symbol's value as variable is void")); Fput (Qsetting_constant, Qerror_conditions, Fcons (Qsetting_constant, error_tail)); Fput (Qsetting_constant, Qerror_message, build_string ("Attempt to set a constant symbol")); Fput (Qinvalid_read_syntax, Qerror_conditions, Fcons (Qinvalid_read_syntax, error_tail)); Fput (Qinvalid_read_syntax, Qerror_message, build_string ("Invalid read syntax")); Fput (Qinvalid_function, Qerror_conditions, Fcons (Qinvalid_function, error_tail)); Fput (Qinvalid_function, Qerror_message, build_string ("Invalid function")); Fput (Qwrong_number_of_arguments, Qerror_conditions, Fcons (Qwrong_number_of_arguments, error_tail)); Fput (Qwrong_number_of_arguments, Qerror_message, build_string ("Wrong number of arguments")); Fput (Qno_catch, Qerror_conditions, Fcons (Qno_catch, error_tail)); Fput (Qno_catch, Qerror_message, build_string ("No catch for tag")); Fput (Qend_of_file, Qerror_conditions, Fcons (Qend_of_file, error_tail)); Fput (Qend_of_file, Qerror_message, build_string ("End of file during parsing")); arith_tail = Fcons (Qarith_error, error_tail); Fput (Qarith_error, Qerror_conditions, arith_tail); Fput (Qarith_error, Qerror_message, build_string ("Arithmetic error")); Fput (Qbeginning_of_buffer, Qerror_conditions, Fcons (Qbeginning_of_buffer, error_tail)); Fput (Qbeginning_of_buffer, Qerror_message, build_string ("Beginning of buffer")); Fput (Qend_of_buffer, Qerror_conditions, Fcons (Qend_of_buffer, error_tail)); Fput (Qend_of_buffer, Qerror_message, build_string ("End of buffer")); Fput (Qbuffer_read_only, Qerror_conditions, Fcons (Qbuffer_read_only, error_tail)); Fput (Qbuffer_read_only, Qerror_message, build_string ("Buffer is read-only")); #ifdef LISP_FLOAT_TYPE Qrange_error = intern ("range-error"); Qdomain_error = intern ("domain-error"); Qsingularity_error = intern ("singularity-error"); Qoverflow_error = intern ("overflow-error"); Qunderflow_error = intern ("underflow-error"); Fput (Qdomain_error, Qerror_conditions, Fcons (Qdomain_error, arith_tail)); Fput (Qdomain_error, Qerror_message, build_string ("Arithmetic domain error")); Fput (Qrange_error, Qerror_conditions, Fcons (Qrange_error, arith_tail)); Fput (Qrange_error, Qerror_message, build_string ("Arithmetic range error")); Fput (Qsingularity_error, Qerror_conditions, Fcons (Qsingularity_error, Fcons (Qdomain_error, arith_tail))); Fput (Qsingularity_error, Qerror_message, build_string ("Arithmetic singularity error")); Fput (Qoverflow_error, Qerror_conditions, Fcons (Qoverflow_error, Fcons (Qdomain_error, arith_tail))); Fput (Qoverflow_error, Qerror_message, build_string ("Arithmetic overflow error")); Fput (Qunderflow_error, Qerror_conditions, Fcons (Qunderflow_error, Fcons (Qdomain_error, arith_tail))); Fput (Qunderflow_error, Qerror_message, build_string ("Arithmetic underflow error")); staticpro (&Qrange_error); staticpro (&Qdomain_error); staticpro (&Qsingularity_error); staticpro (&Qoverflow_error); staticpro (&Qunderflow_error); #endif /* LISP_FLOAT_TYPE */ staticpro (&Qnil); staticpro (&Qt); staticpro (&Qquote); staticpro (&Qlambda); staticpro (&Qsubr); staticpro (&Qunbound); staticpro (&Qerror_conditions); staticpro (&Qerror_message); staticpro (&Qtop_level); staticpro (&Qerror); staticpro (&Qquit); staticpro (&Qwrong_type_argument); staticpro (&Qargs_out_of_range); staticpro (&Qvoid_function); staticpro (&Qcyclic_function_indirection); staticpro (&Qvoid_variable); staticpro (&Qsetting_constant); staticpro (&Qinvalid_read_syntax); staticpro (&Qwrong_number_of_arguments); staticpro (&Qinvalid_function); staticpro (&Qno_catch); staticpro (&Qend_of_file); staticpro (&Qarith_error); staticpro (&Qbeginning_of_buffer); staticpro (&Qend_of_buffer); staticpro (&Qbuffer_read_only); staticpro (&Qmark_inactive); staticpro (&Qlistp); staticpro (&Qconsp); staticpro (&Qsymbolp); staticpro (&Qintegerp); staticpro (&Qnatnump); staticpro (&Qwholenump); staticpro (&Qstringp); staticpro (&Qarrayp); staticpro (&Qsequencep); staticpro (&Qbufferp); staticpro (&Qvectorp); staticpro (&Qchar_or_string_p); staticpro (&Qmarkerp); staticpro (&Qbuffer_or_string_p); staticpro (&Qinteger_or_marker_p); #ifdef LISP_FLOAT_TYPE staticpro (&Qfloatp); staticpro (&Qnumberp); staticpro (&Qnumber_or_marker_p); #endif /* LISP_FLOAT_TYPE */ staticpro (&Qchar_table_p); staticpro (&Qvector_or_char_table_p); staticpro (&Qboundp); staticpro (&Qfboundp); staticpro (&Qcdr); staticpro (&Qad_advice_info); staticpro (&Qad_activate); /* Types that type-of returns. */ Qinteger = intern ("integer"); Qsymbol = intern ("symbol"); Qstring = intern ("string"); Qcons = intern ("cons"); Qmarker = intern ("marker"); Qoverlay = intern ("overlay"); Qfloat = intern ("float"); Qwindow_configuration = intern ("window-configuration"); Qprocess = intern ("process"); Qwindow = intern ("window"); /* Qsubr = intern ("subr"); */ Qcompiled_function = intern ("compiled-function"); Qbuffer = intern ("buffer"); Qframe = intern ("frame"); Qvector = intern ("vector"); staticpro (&Qinteger); staticpro (&Qsymbol); staticpro (&Qstring); staticpro (&Qcons); staticpro (&Qmarker); staticpro (&Qoverlay); staticpro (&Qfloat); staticpro (&Qwindow_configuration); staticpro (&Qprocess); staticpro (&Qwindow); /* staticpro (&Qsubr); */ staticpro (&Qcompiled_function); staticpro (&Qbuffer); staticpro (&Qframe); staticpro (&Qvector); defsubr (&Seq); defsubr (&Snull); defsubr (&Stype_of); defsubr (&Slistp); defsubr (&Snlistp); defsubr (&Sconsp); defsubr (&Satom); defsubr (&Sintegerp); defsubr (&Sinteger_or_marker_p); defsubr (&Snumberp); defsubr (&Snumber_or_marker_p); #ifdef LISP_FLOAT_TYPE defsubr (&Sfloatp); #endif /* LISP_FLOAT_TYPE */ defsubr (&Snatnump); defsubr (&Ssymbolp); defsubr (&Sstringp); defsubr (&Svectorp); defsubr (&Schar_table_p); defsubr (&Svector_or_char_table_p); defsubr (&Sbool_vector_p); defsubr (&Sarrayp); defsubr (&Ssequencep); defsubr (&Sbufferp); defsubr (&Smarkerp); defsubr (&Ssubrp); defsubr (&Sbyte_code_function_p); defsubr (&Schar_or_string_p); defsubr (&Scar); defsubr (&Scdr); defsubr (&Scar_safe); defsubr (&Scdr_safe); defsubr (&Ssetcar); defsubr (&Ssetcdr); defsubr (&Ssymbol_function); defsubr (&Sindirect_function); defsubr (&Ssymbol_plist); defsubr (&Ssymbol_name); defsubr (&Smakunbound); defsubr (&Sfmakunbound); defsubr (&Sboundp); defsubr (&Sfboundp); defsubr (&Sfset); defsubr (&Sdefalias); defsubr (&Sdefine_function); defsubr (&Ssetplist); defsubr (&Ssymbol_value); defsubr (&Sset); defsubr (&Sdefault_boundp); defsubr (&Sdefault_value); defsubr (&Sset_default); defsubr (&Ssetq_default); defsubr (&Smake_variable_buffer_local); defsubr (&Smake_local_variable); defsubr (&Skill_local_variable); defsubr (&Slocal_variable_p); defsubr (&Slocal_variable_if_set_p); defsubr (&Saref); defsubr (&Saset); defsubr (&Snumber_to_string); defsubr (&Sstring_to_number); defsubr (&Seqlsign); defsubr (&Slss); defsubr (&Sgtr); defsubr (&Sleq); defsubr (&Sgeq); defsubr (&Sneq); defsubr (&Szerop); defsubr (&Splus); defsubr (&Sminus); defsubr (&Stimes); defsubr (&Squo); defsubr (&Srem); defsubr (&Smod); defsubr (&Smax); defsubr (&Smin); defsubr (&Slogand); defsubr (&Slogior); defsubr (&Slogxor); defsubr (&Slsh); defsubr (&Sash); defsubr (&Sadd1); defsubr (&Ssub1); defsubr (&Slognot); XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function; } SIGTYPE arith_error (signo) int signo; { #ifdef USG /* USG systems forget handlers when they are used; must reestablish each time */ signal (signo, arith_error); #endif /* USG */ #ifdef VMS /* VMS systems are like USG. */ signal (signo, arith_error); #endif /* VMS */ #ifdef BSD4_1 sigrelse (SIGFPE); #else /* not BSD4_1 */ sigsetmask (SIGEMPTYMASK); #endif /* not BSD4_1 */ Fsignal (Qarith_error, Qnil); } init_data () { /* Don't do this if just dumping out. We don't want to call `signal' in this case so that we don't have trouble with dumping signal-delivering routines in an inconsistent state. */ #ifndef CANNOT_DUMP if (!initialized) return; #endif /* CANNOT_DUMP */ signal (SIGFPE, arith_error); #ifdef uts signal (SIGEMT, arith_error); #endif /* uts */ } emacs-19.30/src/dired.c100444 12120 1 51225 6021730420 13141 0ustar rmsdaemon/* Lisp functions for making directory listings. Copyright (C) 1985, 1986, 1993, 1994 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. */ #include #include #include #include #ifdef VMS #include #include #include #endif /* The d_nameln member of a struct dirent includes the '\0' character on some systems, but not on others. What's worse, you can't tell at compile-time which one it will be, since it really depends on the sort of system providing the filesystem you're reading from, not the system you are running on. Paul Eggert says this occurs when Emacs is running on a SunOS 4.1.2 host, reading a directory that is remote-mounted from a Solaris 2.1 host and is in a native Solaris 2.1 filesystem. Since applying strlen to the name always works, we'll just do that. */ #define NAMLEN(p) strlen (p->d_name) #ifdef SYSV_SYSTEM_DIR #include #define DIRENTRY struct dirent #else /* not SYSV_SYSTEM_DIR */ #ifdef NONSYSTEM_DIR_LIBRARY #include "ndir.h" #else /* not NONSYSTEM_DIR_LIBRARY */ #ifdef MSDOS #include #else #include #endif #endif /* not NONSYSTEM_DIR_LIBRARY */ #ifndef MSDOS #define DIRENTRY struct direct extern DIR *opendir (); extern struct direct *readdir (); #endif /* not MSDOS */ #endif /* not SYSV_SYSTEM_DIR */ #ifdef MSDOS #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0) #else #define DIRENTRY_NONEMPTY(p) ((p)->d_ino) #endif #include "lisp.h" #include "buffer.h" #include "commands.h" #include "regex.h" /* Returns a search buffer, with a fastmap allocated and ready to go. */ extern struct re_pattern_buffer *compile_pattern (); #define min(a, b) ((a) < (b) ? (a) : (b)) /* if system does not have symbolic links, it does not have lstat. In that case, use ordinary stat instead. */ #ifndef S_IFLNK #define lstat stat #endif extern int completion_ignore_case; extern Lisp_Object Vcompletion_regexp_list; Lisp_Object Vcompletion_ignored_extensions; Lisp_Object Qcompletion_ignore_case; Lisp_Object Qdirectory_files; Lisp_Object Qfile_name_completion; Lisp_Object Qfile_name_all_completions; Lisp_Object Qfile_attributes; DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0, "Return a list of names of files in DIRECTORY.\n\ There are three optional arguments:\n\ If FULL is non-nil, absolute pathnames of the files are returned.\n\ If MATCH is non-nil, only pathnames containing that regexp are returned.\n\ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\ NOSORT is useful if you plan to sort the result yourself.") (dirname, full, match, nosort) Lisp_Object dirname, full, match, nosort; { DIR *d; int dirnamelen; Lisp_Object list, name, dirfilename; Lisp_Object handler; struct re_pattern_buffer *bufp; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (dirname, Qdirectory_files); if (!NILP (handler)) { Lisp_Object args[6]; args[0] = handler; args[1] = Qdirectory_files; args[2] = dirname; args[3] = full; args[4] = match; args[5] = nosort; return Ffuncall (6, args); } { struct gcpro gcpro1, gcpro2; /* Because of file name handlers, these functions might call Ffuncall, and cause a GC. */ GCPRO1 (match); dirname = Fexpand_file_name (dirname, Qnil); UNGCPRO; GCPRO2 (match, dirname); dirfilename = Fdirectory_file_name (dirname); UNGCPRO; } if (!NILP (match)) { CHECK_STRING (match, 3); /* MATCH might be a flawed regular expression. Rather than catching and signalling our own errors, we just call compile_pattern to do the work for us. */ #ifdef VMS bufp = compile_pattern (match, 0, buffer_defaults.downcase_table->contents, 0); #else bufp = compile_pattern (match, 0, 0, 0); #endif } /* Now *bufp is the compiled form of MATCH; don't call anything which might compile a new regexp until we're done with the loop! */ /* Do this opendir after anything which might signal an error; if an error is signalled while the directory stream is open, we have to make sure it gets closed, and setting up an unwind_protect to do so would be a pain. */ d = opendir (XSTRING (dirfilename)->data); if (! d) report_file_error ("Opening directory", Fcons (dirname, Qnil)); list = Qnil; dirnamelen = XSTRING (dirname)->size; /* Loop reading blocks */ while (1) { DIRENTRY *dp = readdir (d); int len; if (!dp) break; len = NAMLEN (dp); if (DIRENTRY_NONEMPTY (dp)) { if (NILP (match) || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0))) { if (!NILP (full)) { int afterdirindex = dirnamelen; int total = len + dirnamelen; int needsep = 0; /* Decide whether we need to add a directory separator. */ #ifndef VMS if (dirnamelen == 0 || !IS_ANY_SEP (XSTRING (dirname)->data[dirnamelen - 1])) needsep = 1; #endif /* VMS */ name = make_uninit_string (total + needsep); bcopy (XSTRING (dirname)->data, XSTRING (name)->data, dirnamelen); if (needsep) XSTRING (name)->data[afterdirindex++] = DIRECTORY_SEP; bcopy (dp->d_name, XSTRING (name)->data + afterdirindex, len); } else name = make_string (dp->d_name, len); list = Fcons (name, list); } } } closedir (d); if (!NILP (nosort)) return list; return Fsort (Fnreverse (list), Qstring_lessp); } Lisp_Object file_name_completion (); DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion, 2, 2, 0, "Complete file name FILE in directory DIR.\n\ Returns the longest string\n\ common to all filenames in DIR that start with FILE.\n\ If there is only one and FILE matches it exactly, returns t.\n\ Returns nil if DIR contains no name starting with FILE.") (file, dirname) Lisp_Object file, dirname; { Lisp_Object handler; /* If the directory name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (dirname, Qfile_name_completion); if (!NILP (handler)) return call3 (handler, Qfile_name_completion, file, dirname); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (file, Qfile_name_completion); if (!NILP (handler)) return call3 (handler, Qfile_name_completion, file, dirname); return file_name_completion (file, dirname, 0, 0); } DEFUN ("file-name-all-completions", Ffile_name_all_completions, Sfile_name_all_completions, 2, 2, 0, "Return a list of all completions of file name FILE in directory DIR.\n\ These are all file names in directory DIR which begin with FILE.") (file, dirname) Lisp_Object file, dirname; { Lisp_Object handler; /* If the directory name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (dirname, Qfile_name_all_completions); if (!NILP (handler)) return call3 (handler, Qfile_name_all_completions, file, dirname); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (file, Qfile_name_all_completions); if (!NILP (handler)) return call3 (handler, Qfile_name_all_completions, file, dirname); return file_name_completion (file, dirname, 1, 0); } Lisp_Object file_name_completion (file, dirname, all_flag, ver_flag) Lisp_Object file, dirname; int all_flag, ver_flag; { DIR *d; DIRENTRY *dp; int bestmatchsize, skip; register int compare, matchsize; unsigned char *p1, *p2; int matchcount = 0; Lisp_Object bestmatch, tem, elt, name; struct stat st; int directoryp; int passcount; int count = specpdl_ptr - specpdl; struct gcpro gcpro1, gcpro2, gcpro3; #ifdef VMS extern DIRENTRY * readdirver (); DIRENTRY *((* readfunc) ()); /* Filename completion on VMS ignores case, since VMS filesys does. */ specbind (Qcompletion_ignore_case, Qt); readfunc = readdir; if (ver_flag) readfunc = readdirver; file = Fupcase (file); #else /* not VMS */ CHECK_STRING (file, 0); #endif /* not VMS */ #ifdef FILE_SYSTEM_CASE file = FILE_SYSTEM_CASE (file); #endif bestmatch = Qnil; GCPRO3 (file, dirname, bestmatch); dirname = Fexpand_file_name (dirname, Qnil); /* With passcount = 0, ignore files that end in an ignored extension. If nothing found then try again with passcount = 1, don't ignore them. If looking for all completions, start with passcount = 1, so always take even the ignored ones. ** It would not actually be helpful to the user to ignore any possible completions when making a list of them.** */ for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++) { if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data))) report_file_error ("Opening directory", Fcons (dirname, Qnil)); /* Loop reading blocks */ /* (att3b compiler bug requires do a null comparison this way) */ while (1) { DIRENTRY *dp; int len; #ifdef VMS dp = (*readfunc) (d); #else dp = readdir (d); #endif if (!dp) break; len = NAMLEN (dp); if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) goto quit; if (! DIRENTRY_NONEMPTY (dp) || len < XSTRING (file)->size || 0 <= scmp (dp->d_name, XSTRING (file)->data, XSTRING (file)->size)) continue; if (file_name_completion_stat (dirname, dp, &st) < 0) continue; directoryp = ((st.st_mode & S_IFMT) == S_IFDIR); tem = Qnil; if (directoryp) { #ifndef TRIVIAL_DIRECTORY_ENTRY #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, "..")) #endif /* "." and ".." are never interesting as completions, but are actually in the way in a directory contains only one file. */ if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name)) continue; } else { /* Compare extensions-to-be-ignored against end of this file name */ /* if name is not an exact match against specified string */ if (!passcount && len > XSTRING (file)->size) /* and exit this for loop if a match is found */ for (tem = Vcompletion_ignored_extensions; CONSP (tem); tem = XCONS (tem)->cdr) { elt = XCONS (tem)->car; if (!STRINGP (elt)) continue; skip = len - XSTRING (elt)->size; if (skip < 0) continue; if (0 <= scmp (dp->d_name + skip, XSTRING (elt)->data, XSTRING (elt)->size)) continue; break; } } /* If an ignored-extensions match was found, don't process this name as a completion. */ if (!passcount && CONSP (tem)) continue; if (!passcount) { Lisp_Object regexps; Lisp_Object zero; XSETFASTINT (zero, 0); /* Ignore this element if it fails to match all the regexps. */ for (regexps = Vcompletion_regexp_list; CONSP (regexps); regexps = XCONS (regexps)->cdr) { tem = Fstring_match (XCONS (regexps)->car, elt, zero); if (NILP (tem)) break; } if (CONSP (regexps)) continue; } /* Update computation of how much all possible completions match */ matchcount++; if (all_flag || NILP (bestmatch)) { /* This is a possible completion */ if (directoryp) { /* This completion is a directory; make it end with '/' */ name = Ffile_name_as_directory (make_string (dp->d_name, len)); } else name = make_string (dp->d_name, len); if (all_flag) { bestmatch = Fcons (name, bestmatch); } else { bestmatch = name; bestmatchsize = XSTRING (name)->size; } } else { compare = min (bestmatchsize, len); p1 = XSTRING (bestmatch)->data; p2 = (unsigned char *) dp->d_name; matchsize = scmp(p1, p2, compare); if (matchsize < 0) matchsize = compare; if (completion_ignore_case) { /* If this is an exact match except for case, use it as the best match rather than one that is not an exact match. This way, we get the case pattern of the actual match. */ if ((matchsize == len && matchsize + !!directoryp < XSTRING (bestmatch)->size) || /* If there is no exact match ignoring case, prefer a match that does not change the case of the input. */ (((matchsize == len) == (matchsize + !!directoryp == XSTRING (bestmatch)->size)) /* If there is more than one exact match aside from case, and one of them is exact including case, prefer that one. */ && !bcmp (p2, XSTRING (file)->data, XSTRING (file)->size) && bcmp (p1, XSTRING (file)->data, XSTRING (file)->size))) { bestmatch = make_string (dp->d_name, len); if (directoryp) bestmatch = Ffile_name_as_directory (bestmatch); } } /* If this dirname all matches, see if implicit following slash does too. */ if (directoryp && compare == matchsize && bestmatchsize > matchsize && IS_ANY_SEP (p1[matchsize])) matchsize++; bestmatchsize = matchsize; } } closedir (d); } UNGCPRO; bestmatch = unbind_to (count, bestmatch); if (all_flag || NILP (bestmatch)) return bestmatch; if (matchcount == 1 && bestmatchsize == XSTRING (file)->size) return Qt; return Fsubstring (bestmatch, make_number (0), make_number (bestmatchsize)); quit: if (d) closedir (d); Vquit_flag = Qnil; return Fsignal (Qquit, Qnil); } file_name_completion_stat (dirname, dp, st_addr) Lisp_Object dirname; DIRENTRY *dp; struct stat *st_addr; { int len = NAMLEN (dp); int pos = XSTRING (dirname)->size; int value; char *fullname = (char *) alloca (len + pos + 2); bcopy (XSTRING (dirname)->data, fullname, pos); #ifndef VMS if (!IS_DIRECTORY_SEP (fullname[pos - 1])) fullname[pos++] = DIRECTORY_SEP; #endif bcopy (dp->d_name, fullname + pos, len); fullname[pos + len] = 0; #ifdef S_IFLNK /* We want to return success if a link points to a nonexistent file, but we want to return the status for what the link points to, in case it is a directory. */ value = lstat (fullname, st_addr); stat (fullname, st_addr); return value; #else return stat (fullname, st_addr); #endif } #ifdef VMS DEFUN ("file-name-all-versions", Ffile_name_all_versions, Sfile_name_all_versions, 2, 2, 0, "Return a list of all versions of file name FILE in directory DIR.") (file, dirname) Lisp_Object file, dirname; { return file_name_completion (file, dirname, 1, 1); } DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0, "Return the maximum number of versions allowed for FILE.\n\ Returns nil if the file cannot be opened or if there is no version limit.") (filename) Lisp_Object filename; { Lisp_Object retval; struct FAB fab; struct RAB rab; struct XABFHC xabfhc; int status; filename = Fexpand_file_name (filename, Qnil); fab = cc$rms_fab; xabfhc = cc$rms_xabfhc; fab.fab$l_fna = XSTRING (filename)->data; fab.fab$b_fns = strlen (fab.fab$l_fna); fab.fab$l_xab = (char *) &xabfhc; status = sys$open (&fab, 0, 0); if (status != RMS$_NORMAL) /* Probably non-existent file */ return Qnil; sys$close (&fab, 0, 0); if (xabfhc.xab$w_verlimit == 32767) return Qnil; /* No version limit */ else return make_number (xabfhc.xab$w_verlimit); } #endif /* VMS */ Lisp_Object make_time (time) int time; { return Fcons (make_number (time >> 16), Fcons (make_number (time & 0177777), Qnil)); } DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0, "Return a list of attributes of file FILENAME.\n\ Value is nil if specified file cannot be opened.\n\ Otherwise, list elements are:\n\ 0. t for directory, string (name linked to) for symbolic link, or nil.\n\ 1. Number of links to file.\n\ 2. File uid.\n\ 3. File gid.\n\ 4. Last access time, as a list of two integers.\n\ First integer has high-order 16 bits of time, second has low 16 bits.\n\ 5. Last modification time, likewise.\n\ 6. Last status change time, likewise.\n\ 7. Size in bytes (-1, if number is out of range).\n\ 8. File modes, as a string of ten letters or dashes as in ls -l.\n\ 9. t iff file's gid would change if file were deleted and recreated.\n\ 10. inode number.\n\ 11. Device number.\n\ \n\ If file does not exist, returns nil.") (filename) Lisp_Object filename; { Lisp_Object values[12]; Lisp_Object dirname; struct stat s; struct stat sdir; char modes[10]; Lisp_Object handler; filename = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qfile_attributes); if (!NILP (handler)) return call2 (handler, Qfile_attributes, filename); if (lstat (XSTRING (filename)->data, &s) < 0) return Qnil; #ifdef MSDOS { char *tmpnam = XSTRING (Ffile_name_nondirectory (filename))->data; int l = strlen (tmpnam); if (l >= 5 && S_ISREG (s.st_mode) && (stricmp (&tmpnam[l - 4], ".com") == 0 || stricmp (&tmpnam[l - 4], ".exe") == 0 || stricmp (&tmpnam[l - 4], ".bat") == 0)) { s.st_mode |= S_IEXEC; } } #endif /* MSDOS */ switch (s.st_mode & S_IFMT) { default: values[0] = Qnil; break; case S_IFDIR: values[0] = Qt; break; #ifdef S_IFLNK case S_IFLNK: values[0] = Ffile_symlink_p (filename); break; #endif } values[1] = make_number (s.st_nlink); values[2] = make_number (s.st_uid); values[3] = make_number (s.st_gid); values[4] = make_time (s.st_atime); values[5] = make_time (s.st_mtime); values[6] = make_time (s.st_ctime); values[7] = make_number ((int) s.st_size); /* If the size is out of range, give back -1. */ if (XINT (values[7]) != s.st_size) XSETINT (values[7], -1); filemodestring (&s, modes); values[8] = make_string (modes, 10); #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */ #define BSD4_2 /* A new meaning to the term `backwards compatibility' */ #endif #ifdef BSD4_2 /* file gid will be dir gid */ dirname = Ffile_name_directory (filename); if (! NILP (dirname) && stat (XSTRING (dirname)->data, &sdir) == 0) values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil; else /* if we can't tell, assume worst */ values[9] = Qt; #else /* file gid will be egid */ #ifdef WINDOWSNT values[9] = Qnil; /* sorry, no group IDs on NT */ #else /* not WINDOWSNT */ values[9] = (s.st_gid != getegid ()) ? Qt : Qnil; #endif /* not WINDOWSNT */ #endif /* BSD4_2 (or BSD4_3) */ #ifdef BSD4_3 #undef BSD4_2 /* ok, you can look again without throwing up */ #endif #ifdef WINDOWSNT /* Fill in the inode and device values specially...see nt.c. */ if (!get_inode_and_device_vals (filename, &values[10], &values[11])) { return Qnil; } #else /* not WINDOWSNT */ values[10] = make_number (s.st_ino); values[11] = make_number (s.st_dev); #endif /* not WINDOWSNT */ return Flist (sizeof(values) / sizeof(values[0]), values); } syms_of_dired () { Qdirectory_files = intern ("directory-files"); Qfile_name_completion = intern ("file-name-completion"); Qfile_name_all_completions = intern ("file-name-all-completions"); Qfile_attributes = intern ("file-attributes"); defsubr (&Sdirectory_files); defsubr (&Sfile_name_completion); #ifdef VMS defsubr (&Sfile_name_all_versions); defsubr (&Sfile_version_limit); #endif /* VMS */ defsubr (&Sfile_name_all_completions); defsubr (&Sfile_attributes); #ifdef VMS Qcompletion_ignore_case = intern ("completion-ignore-case"); staticpro (&Qcompletion_ignore_case); #endif /* VMS */ DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions, "*Completion ignores filenames ending in any string in this list.\n\ This variable does not affect lists of possible completions,\n\ but does affect the commands that actually do completions."); Vcompletion_ignored_extensions = Qnil; } emacs-19.30/src/dispnew.c100444 12120 1 224206 6051302004 13540 0ustar rmsdaemon/* Updating of data structures for redisplay. Copyright (C) 1985, 86, 87, 88, 93, 94, 95 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. */ #include #include #include #include #include "lisp.h" #include "termchar.h" #include "termopts.h" #include "termhooks.h" /* cm.h must come after dispextern.h on Windows. */ #include "dispextern.h" #include "cm.h" #include "buffer.h" #include "frame.h" #include "window.h" #include "commands.h" #include "disptab.h" #include "indent.h" #include "intervals.h" #include "systty.h" #include "syssignal.h" #ifdef HAVE_X_WINDOWS #include "xterm.h" #endif /* HAVE_X_WINDOWS */ #ifdef HAVE_NTGUI #include "w32term.h" #endif /* HAVE_NTGUI */ /* Include systime.h after xterm.h to avoid double inclusion of time.h. */ #include "systime.h" #include #define max(a, b) ((a) > (b) ? (a) : (b)) #define min(a, b) ((a) < (b) ? (a) : (b)) /* Get number of chars of output now in the buffer of a stdio stream. This ought to be built in in stdio, but it isn't. Some s- files override this because their stdio internals differ. */ #ifdef __GNU_LIBRARY__ /* The s- file might have overridden the definition with one that works for the system's C library. But we are using the GNU C library, so this is the right definition for every system. */ #ifdef GNU_LIBRARY_PENDING_OUTPUT_COUNT #define PENDING_OUTPUT_COUNT GNU_LIBRARY_PENDING_OUTPUT_COUNT #else #undef PENDING_OUTPUT_COUNT #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__bufp - (FILE)->__buffer) #endif #else /* not __GNU_LIBRARY__ */ #ifndef PENDING_OUTPUT_COUNT #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base) #endif #endif static void change_frame_size_1 (); /* Nonzero upon entry to redisplay means do not assume anything about current contents of actual terminal frame; clear and redraw it. */ int frame_garbaged; /* Nonzero means last display completed. Zero means it was preempted. */ int display_completed; /* Lisp variable visible-bell; enables use of screen-flash instead of audible bell. */ int visible_bell; /* Invert the color of the whole frame, at a low level. */ int inverse_video; /* Line speed of the terminal. */ int baud_rate; /* nil or a symbol naming the window system under which emacs is running ('x is the only current possibility). */ Lisp_Object Vwindow_system; /* Version number of X windows: 10, 11 or nil. */ Lisp_Object Vwindow_system_version; /* Vector of glyph definitions. Indexed by glyph number, the contents are a string which is how to output the glyph. If Vglyph_table is nil, a glyph is output by using its low 8 bits as a character code. */ Lisp_Object Vglyph_table; /* Display table to use for vectors that don't specify their own. */ Lisp_Object Vstandard_display_table; /* Nonzero means reading single-character input with prompt so put cursor on minibuffer after the prompt. positive means at end of text in echo area; negative means at beginning of line. */ int cursor_in_echo_area; Lisp_Object Qdisplay_table; /* The currently selected frame. In a single-frame version, this variable always holds the address of the_only_frame. */ FRAME_PTR selected_frame; /* A frame which is not just a minibuffer, or 0 if there are no such frames. This is usually the most recent such frame that was selected. In a single-frame version, this variable always holds the address of the_only_frame. */ FRAME_PTR last_nonminibuf_frame; /* In a single-frame version, the information that would otherwise exist inside frame objects lives in the following structure instead. NOTE: the_only_frame is not checked for garbage collection; don't store collectible objects in any of its fields! You're not/The only frame in town/... */ #ifndef MULTI_FRAME struct frame the_only_frame; #endif /* This is a vector, made larger whenever it isn't large enough, which is used inside `update_frame' to hold the old contents of the FRAME_PHYS_LINES of the frame being updated. */ struct frame_glyphs **ophys_lines; /* Length of vector currently allocated. */ int ophys_lines_length; FILE *termscript; /* Stdio stream being used for copy of all output. */ struct cm Wcm; /* Structure for info on cursor positioning */ extern short ospeed; /* Output speed (from sg_ospeed) */ int delayed_size_change; /* 1 means SIGWINCH happened when not safe. */ #ifdef MULTI_FRAME DEFUN ("redraw-frame", Fredraw_frame, Sredraw_frame, 1, 1, 0, "Clear frame FRAME and output again what is supposed to appear on it.") (frame) Lisp_Object frame; { FRAME_PTR f; CHECK_LIVE_FRAME (frame, 0); f = XFRAME (frame); update_begin (f); /* set_terminal_modes (); */ clear_frame (); clear_frame_records (f); update_end (f); fflush (stdout); windows_or_buffers_changed++; /* Mark all windows as INaccurate, so that every window will have its redisplay done. */ mark_window_display_accurate (FRAME_ROOT_WINDOW (f), 0); f->garbaged = 0; return Qnil; } redraw_frame (f) FRAME_PTR f; { Lisp_Object frame; XSETFRAME (frame, f); Fredraw_frame (frame); } #else DEFUN ("redraw-frame", Fredraw_frame, Sredraw_frame, 1, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame) Lisp_Object frame; { update_begin (0); set_terminal_modes (); clear_frame (); update_end (0); fflush (stdout); clear_frame_records (0); windows_or_buffers_changed++; /* Mark all windows as INaccurate, so that every window will have its redisplay done. */ mark_window_display_accurate (FRAME_ROOT_WINDOW (0), 0); return Qnil; } #endif DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "", "Clear and redisplay all visible frames.") () { Lisp_Object tail, frame; FOR_EACH_FRAME (tail, frame) if (FRAME_VISIBLE_P (XFRAME (frame))) Fredraw_frame (frame); return Qnil; } /* This is used when frame_garbaged is set. Redraw the individual frames marked as garbaged. */ void redraw_garbaged_frames () { Lisp_Object tail, frame; FOR_EACH_FRAME (tail, frame) if (FRAME_VISIBLE_P (XFRAME (frame)) && FRAME_GARBAGED_P (XFRAME (frame))) Fredraw_frame (frame); } static struct frame_glyphs * make_frame_glyphs (frame, empty) register FRAME_PTR frame; int empty; { register int i; register width = FRAME_WIDTH (frame); register height = FRAME_HEIGHT (frame); register struct frame_glyphs *new = (struct frame_glyphs *) xmalloc (sizeof (struct frame_glyphs)); SET_GLYPHS_FRAME (new, frame); new->height = height; new->width = width; new->used = (int *) xmalloc (height * sizeof (int)); new->glyphs = (GLYPH **) xmalloc (height * sizeof (GLYPH *)); new->charstarts = (int **) xmalloc (height * sizeof (int *)); new->highlight = (char *) xmalloc (height * sizeof (char)); new->enable = (char *) xmalloc (height * sizeof (char)); bzero (new->enable, height * sizeof (char)); new->bufp = (int *) xmalloc (height * sizeof (int)); #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (frame)) { new->top_left_x = (short *) xmalloc (height * sizeof (short)); new->top_left_y = (short *) xmalloc (height * sizeof (short)); new->pix_width = (short *) xmalloc (height * sizeof (short)); new->pix_height = (short *) xmalloc (height * sizeof (short)); new->max_ascent = (short *) xmalloc (height * sizeof (short)); } #endif /* HAVE_WINDOW_SYSTEM */ if (empty) { /* Make the buffer used by decode_mode_spec. This buffer is also used as temporary storage when updating the frame. See scroll.c. */ unsigned int total_glyphs = (width + 2) * sizeof (GLYPH); unsigned int total_charstarts = (width + 2) * sizeof (int); new->total_contents = (GLYPH *) xmalloc (total_glyphs); bzero (new->total_contents, total_glyphs); new->total_charstarts = (int *) xmalloc (total_charstarts); bzero (new->total_charstarts, total_glyphs); } else { unsigned int total_glyphs = height * (width + 2) * sizeof (GLYPH); new->total_contents = (GLYPH *) xmalloc (total_glyphs); bzero (new->total_contents, total_glyphs); for (i = 0; i < height; i++) new->glyphs[i] = new->total_contents + i * (width + 2) + 1; if (!FRAME_TERMCAP_P (frame)) { unsigned int total_charstarts = height * (width + 2) * sizeof (int); new->total_charstarts = (int *) xmalloc (total_charstarts); bzero (new->total_charstarts, total_charstarts); for (i = 0; i < height; i++) new->charstarts[i] = new->total_charstarts + i * (width + 2) + 1; } else { /* Without a window system, we don't really need charstarts. So use a small amount of space to make enough data structure to prevent crashes in display_text_line. */ new->total_charstarts = (int *) xmalloc ((width + 2) * sizeof (int)); for (i = 0; i < height; i++) new->charstarts[i] = new->total_charstarts; } } return new; } void free_frame_glyphs (frame, glyphs) FRAME_PTR frame; struct frame_glyphs *glyphs; { if (glyphs->total_contents) xfree (glyphs->total_contents); if (glyphs->total_charstarts) xfree (glyphs->total_charstarts); xfree (glyphs->used); xfree (glyphs->glyphs); xfree (glyphs->highlight); xfree (glyphs->enable); xfree (glyphs->bufp); if (glyphs->charstarts) xfree (glyphs->charstarts); #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (frame)) { xfree (glyphs->top_left_x); xfree (glyphs->top_left_y); xfree (glyphs->pix_width); xfree (glyphs->pix_height); xfree (glyphs->max_ascent); } #endif /* HAVE_WINDOW_SYSTEM */ xfree (glyphs); } void remake_frame_glyphs (frame) FRAME_PTR frame; { if (FRAME_CURRENT_GLYPHS (frame)) free_frame_glyphs (frame, FRAME_CURRENT_GLYPHS (frame)); if (FRAME_DESIRED_GLYPHS (frame)) free_frame_glyphs (frame, FRAME_DESIRED_GLYPHS (frame)); if (FRAME_TEMP_GLYPHS (frame)) free_frame_glyphs (frame, FRAME_TEMP_GLYPHS (frame)); if (FRAME_MESSAGE_BUF (frame)) { /* Reallocate the frame's message buffer; remember that echo_area_glyphs may be pointing here. */ char *old_message_buf = FRAME_MESSAGE_BUF (frame); FRAME_MESSAGE_BUF (frame) = (char *) xrealloc (FRAME_MESSAGE_BUF (frame), FRAME_WIDTH (frame) + 1); if (echo_area_glyphs == old_message_buf) echo_area_glyphs = FRAME_MESSAGE_BUF (frame); if (previous_echo_glyphs == old_message_buf) previous_echo_glyphs = FRAME_MESSAGE_BUF (frame); } else FRAME_MESSAGE_BUF (frame) = (char *) xmalloc (FRAME_WIDTH (frame) + 1); FRAME_CURRENT_GLYPHS (frame) = make_frame_glyphs (frame, 0); FRAME_DESIRED_GLYPHS (frame) = make_frame_glyphs (frame, 0); FRAME_TEMP_GLYPHS (frame) = make_frame_glyphs (frame, 1); if (! FRAME_TERMCAP_P (frame) || frame == selected_frame) SET_FRAME_GARBAGED (frame); } /* Return the hash code of contents of line VPOS in frame-matrix M. */ static int line_hash_code (m, vpos) register struct frame_glyphs *m; int vpos; { register GLYPH *body, *end; register int h = 0; if (!m->enable[vpos]) return 0; /* Give all highlighted lines the same hash code so as to encourage scrolling to leave them in place. */ if (m->highlight[vpos]) return -1; body = m->glyphs[vpos]; if (must_write_spaces) while (1) { GLYPH g = *body++; if (g == 0) break; h = (((h << 4) + (h >> 24)) & 0x0fffffff) + g - SPACEGLYPH; } else while (1) { GLYPH g = *body++; if (g == 0) break; h = (((h << 4) + (h >> 24)) & 0x0fffffff) + g; } if (h) return h; return 1; } /* Return number of characters in line in M at vpos VPOS, except don't count leading and trailing spaces unless the terminal requires those to be explicitly output. */ static unsigned int line_draw_cost (m, vpos) struct frame_glyphs *m; int vpos; { register GLYPH *beg = m->glyphs[vpos]; register GLYPH *end = m->glyphs[vpos] + m->used[vpos]; register int i; register int tlen = GLYPH_TABLE_LENGTH; register Lisp_Object *tbase = GLYPH_TABLE_BASE; /* Ignore trailing and leading spaces if we can. */ if (!must_write_spaces) { while ((end != beg) && (*end == SPACEGLYPH)) --end; if (end == beg) return (0); /* All blank line. */ while (*beg == SPACEGLYPH) ++beg; } /* If we don't have a glyph-table, each glyph is one character, so return the number of glyphs. */ if (tbase == 0) return end - beg; /* Otherwise, scan the glyphs and accumulate their total size in I. */ i = 0; while ((beg <= end) && *beg) { register GLYPH g = *beg++; if (GLYPH_SIMPLE_P (tbase, tlen, g)) i += 1; else i += GLYPH_LENGTH (tbase, g); } return i; } /* The functions on this page are the interface from xdisp.c to redisplay. The only other interface into redisplay is through setting FRAME_CURSOR_X (frame) and FRAME_CURSOR_Y (frame) and SET_FRAME_GARBAGED (frame). */ /* cancel_line eliminates any request to display a line at position `vpos' */ cancel_line (vpos, frame) int vpos; register FRAME_PTR frame; { FRAME_DESIRED_GLYPHS (frame)->enable[vpos] = 0; } clear_frame_records (frame) register FRAME_PTR frame; { bzero (FRAME_CURRENT_GLYPHS (frame)->enable, FRAME_HEIGHT (frame)); } /* Clear out all display lines for a coming redisplay. */ void init_desired_glyphs (frame) register FRAME_PTR frame; { register struct frame_glyphs *desired_glyphs = FRAME_DESIRED_GLYPHS (frame); int vpos; int height = FRAME_HEIGHT (frame); for (vpos = 0; vpos < height; vpos++) desired_glyphs->enable[vpos] = 0; } /* Prepare to display on line VPOS starting at HPOS within it. */ void get_display_line (frame, vpos, hpos) register FRAME_PTR frame; int vpos; register int hpos; { register struct frame_glyphs *glyphs; register struct frame_glyphs *desired_glyphs = FRAME_DESIRED_GLYPHS (frame); register GLYPH *p; if (vpos < 0) abort (); if (! desired_glyphs->enable[vpos]) { desired_glyphs->used[vpos] = 0; desired_glyphs->highlight[vpos] = 0; desired_glyphs->enable[vpos] = 1; } if (hpos > desired_glyphs->used[vpos]) { GLYPH *g = desired_glyphs->glyphs[vpos] + desired_glyphs->used[vpos]; GLYPH *end = desired_glyphs->glyphs[vpos] + hpos; desired_glyphs->used[vpos] = hpos; while (g != end) *g++ = SPACEGLYPH; } } /* Like bcopy except never gets confused by overlap. */ void safe_bcopy (from, to, size) char *from, *to; int size; { if (size <= 0 || from == to) return; /* If the source and destination don't overlap, then bcopy can handle it. If they do overlap, but the destination is lower in memory than the source, we'll assume bcopy can handle that. */ if (to < from || from + size <= to) bcopy (from, to, size); /* Otherwise, we'll copy from the end. */ else { register char *endf = from + size; register char *endt = to + size; /* If TO - FROM is large, then we should break the copy into nonoverlapping chunks of TO - FROM bytes each. However, if TO - FROM is small, then the bcopy function call overhead makes this not worth it. The crossover point could be about anywhere. Since I don't think the obvious copy loop is too bad, I'm trying to err in its favor. */ if (to - from < 64) { do *--endt = *--endf; while (endf != from); } else { for (;;) { endt -= (to - from); endf -= (to - from); if (endt < to) break; bcopy (endf, endt, to - from); } /* If SIZE wasn't a multiple of TO - FROM, there will be a little left over. The amount left over is (endt + (to - from)) - to, which is endt - from. */ bcopy (from, to, endt - from); } } } /* Rotate a vector of SIZE bytes right, by DISTANCE bytes. DISTANCE may be negative. */ static void rotate_vector (vector, size, distance) char *vector; int size; int distance; { char *temp = (char *) alloca (size); if (distance < 0) distance += size; bcopy (vector, temp + distance, size - distance); bcopy (vector + size - distance, temp, distance); bcopy (temp, vector, size); } /* Scroll lines from vpos FROM up to but not including vpos END down by AMOUNT lines (AMOUNT may be negative). Returns nonzero if done, zero if terminal cannot scroll them. */ int scroll_frame_lines (frame, from, end, amount, newpos) register FRAME_PTR frame; int from, end, amount, newpos; { register int i; register struct frame_glyphs *current_frame = FRAME_CURRENT_GLYPHS (frame); int pos_adjust; int width = FRAME_WIDTH (frame); if (!line_ins_del_ok) return 0; if (amount == 0) return 1; if (amount > 0) { update_begin (frame); set_terminal_window (end + amount); if (!scroll_region_ok) ins_del_lines (end, -amount); ins_del_lines (from, amount); set_terminal_window (0); rotate_vector (current_frame->glyphs + from, sizeof (GLYPH *) * (end + amount - from), amount * sizeof (GLYPH *)); rotate_vector (current_frame->charstarts + from, sizeof (int *) * (end + amount - from), amount * sizeof (int *)); safe_bcopy (current_frame->used + from, current_frame->used + from + amount, (end - from) * sizeof current_frame->used[0]); safe_bcopy (current_frame->highlight + from, current_frame->highlight + from + amount, (end - from) * sizeof current_frame->highlight[0]); safe_bcopy (current_frame->enable + from, current_frame->enable + from + amount, (end - from) * sizeof current_frame->enable[0]); /* Adjust the lines by an amount that puts the first of them at NEWPOS. */ pos_adjust = newpos - current_frame->charstarts[from + amount][0]; /* Offset each char position in the charstarts lines we moved by pos_adjust. */ for (i = from + amount; i < end + amount; i++) { int *line = current_frame->charstarts[i]; int col; for (col = 0; col < width; col++) if (line[col] > 0) line[col] += pos_adjust; } for (i = from; i < from + amount; i++) { int *line = current_frame->charstarts[i]; int col; line[0] = -1; for (col = 0; col < width; col++) line[col] = 0; } /* Mark the lines made empty by scrolling as enabled, empty and normal video. */ bzero (current_frame->used + from, amount * sizeof current_frame->used[0]); bzero (current_frame->highlight + from, amount * sizeof current_frame->highlight[0]); for (i = from; i < from + amount; i++) { current_frame->glyphs[i][0] = '\0'; current_frame->charstarts[i][0] = -1; current_frame->enable[i] = 1; } safe_bcopy (current_frame->bufp + from, current_frame->bufp + from + amount, (end - from) * sizeof current_frame->bufp[0]); #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (frame)) { safe_bcopy (current_frame->top_left_x + from, current_frame->top_left_x + from + amount, (end - from) * sizeof current_frame->top_left_x[0]); safe_bcopy (current_frame->top_left_y + from, current_frame->top_left_y + from + amount, (end - from) * sizeof current_frame->top_left_y[0]); safe_bcopy (current_frame->pix_width + from, current_frame->pix_width + from + amount, (end - from) * sizeof current_frame->pix_width[0]); safe_bcopy (current_frame->pix_height + from, current_frame->pix_height + from + amount, (end - from) * sizeof current_frame->pix_height[0]); safe_bcopy (current_frame->max_ascent + from, current_frame->max_ascent + from + amount, (end - from) * sizeof current_frame->max_ascent[0]); } #endif /* HAVE_WINDOW_SYSTEM */ update_end (frame); } if (amount < 0) { update_begin (frame); set_terminal_window (end); ins_del_lines (from + amount, amount); if (!scroll_region_ok) ins_del_lines (end + amount, -amount); set_terminal_window (0); rotate_vector (current_frame->glyphs + from + amount, sizeof (GLYPH *) * (end - from - amount), amount * sizeof (GLYPH *)); rotate_vector (current_frame->charstarts + from + amount, sizeof (int *) * (end - from - amount), amount * sizeof (int *)); safe_bcopy (current_frame->used + from, current_frame->used + from + amount, (end - from) * sizeof current_frame->used[0]); safe_bcopy (current_frame->highlight + from, current_frame->highlight + from + amount, (end - from) * sizeof current_frame->highlight[0]); safe_bcopy (current_frame->enable + from, current_frame->enable + from + amount, (end - from) * sizeof current_frame->enable[0]); /* Adjust the lines by an amount that puts the first of them at NEWPOS. */ pos_adjust = newpos - current_frame->charstarts[from + amount][0]; /* Offset each char position in the charstarts lines we moved by pos_adjust. */ for (i = from + amount; i < end + amount; i++) { int *line = current_frame->charstarts[i]; int col; for (col = 0; col < width; col++) if (line[col] > 0) line[col] += pos_adjust; } for (i = end + amount; i < end; i++) { int *line = current_frame->charstarts[i]; int col; line[0] = -1; for (col = 0; col < width; col++) line[col] = 0; } /* Mark the lines made empty by scrolling as enabled, empty and normal video. */ bzero (current_frame->used + end + amount, - amount * sizeof current_frame->used[0]); bzero (current_frame->highlight + end + amount, - amount * sizeof current_frame->highlight[0]); for (i = end + amount; i < end; i++) { current_frame->glyphs[i][0] = '\0'; current_frame->charstarts[i][0] = 0; current_frame->enable[i] = 1; } safe_bcopy (current_frame->bufp + from, current_frame->bufp + from + amount, (end - from) * sizeof current_frame->bufp[0]); #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (frame)) { safe_bcopy (current_frame->top_left_x + from, current_frame->top_left_x + from + amount, (end - from) * sizeof current_frame->top_left_x[0]); safe_bcopy (current_frame->top_left_y + from, current_frame->top_left_y + from + amount, (end - from) * sizeof current_frame->top_left_y[0]); safe_bcopy (current_frame->pix_width + from, current_frame->pix_width + from + amount, (end - from) * sizeof current_frame->pix_width[0]); safe_bcopy (current_frame->pix_height + from, current_frame->pix_height + from + amount, (end - from) * sizeof current_frame->pix_height[0]); safe_bcopy (current_frame->max_ascent + from, current_frame->max_ascent + from + amount, (end - from) * sizeof current_frame->max_ascent[0]); } #endif /* HAVE_WINDOW_SYSTEM */ update_end (frame); } return 1; } /* After updating a window W that isn't the full frame wide, copy all the columns that W does not occupy into the FRAME_DESIRED_GLYPHS (frame) from the FRAME_PHYS_GLYPHS (frame) so that update_frame will not change those columns. */ preserve_other_columns (w) struct window *w; { register int vpos; register struct frame_glyphs *current_frame, *desired_frame; register FRAME_PTR frame = XFRAME (w->frame); int start = XFASTINT (w->left); int end = XFASTINT (w->left) + XFASTINT (w->width); int bot = XFASTINT (w->top) + XFASTINT (w->height); current_frame = FRAME_CURRENT_GLYPHS (frame); desired_frame = FRAME_DESIRED_GLYPHS (frame); for (vpos = XFASTINT (w->top); vpos < bot; vpos++) { if (current_frame->enable[vpos] && desired_frame->enable[vpos]) { if (start > 0) { int len; bcopy (current_frame->glyphs[vpos], desired_frame->glyphs[vpos], start * sizeof (current_frame->glyphs[vpos][0])); bcopy (current_frame->charstarts[vpos], desired_frame->charstarts[vpos], start * sizeof (current_frame->charstarts[vpos][0])); len = min (start, current_frame->used[vpos]); if (desired_frame->used[vpos] < len) desired_frame->used[vpos] = len; } if (current_frame->used[vpos] > end && desired_frame->used[vpos] < current_frame->used[vpos]) { while (desired_frame->used[vpos] < end) { int used = desired_frame->used[vpos]++; desired_frame->glyphs[vpos][used] = SPACEGLYPH; desired_frame->glyphs[vpos][used] = 0; } bcopy (current_frame->glyphs[vpos] + end, desired_frame->glyphs[vpos] + end, ((current_frame->used[vpos] - end) * sizeof (current_frame->glyphs[vpos][0]))); bcopy (current_frame->charstarts[vpos] + end, desired_frame->charstarts[vpos] + end, ((current_frame->used[vpos] - end) * sizeof (current_frame->charstarts[vpos][0]))); desired_frame->used[vpos] = current_frame->used[vpos]; } } } } #if 0 /* If window w does not need to be updated and isn't the full frame wide, copy all the columns that w does occupy into the FRAME_DESIRED_LINES (frame) from the FRAME_PHYS_LINES (frame) so that update_frame will not change those columns. Have not been able to figure out how to use this correctly. */ preserve_my_columns (w) struct window *w; { register int vpos, fin; register struct frame_glyphs *l1, *l2; register FRAME_PTR frame = XFRAME (w->frame); int start = XFASTINT (w->left); int end = XFASTINT (w->left) + XFASTINT (w->width); int bot = XFASTINT (w->top) + XFASTINT (w->height); for (vpos = XFASTINT (w->top); vpos < bot; vpos++) { if ((l1 = FRAME_DESIRED_GLYPHS (frame)->glyphs[vpos + 1]) && (l2 = FRAME_PHYS_GLYPHS (frame)->glyphs[vpos + 1])) { if (l2->length > start && l1->length < l2->length) { fin = l2->length; if (fin > end) fin = end; while (l1->length < start) l1->body[l1->length++] = ' '; bcopy (l2->body + start, l1->body + start, fin - start); l1->length = fin; } } } } #endif /* Adjust by ADJUST the charstart values in window W after vpos VPOS, which counts relative to the frame (not relative to W itself). */ void adjust_window_charstarts (w, vpos, adjust) struct window *w; int vpos; int adjust; { int left = XFASTINT (w->left); int top = XFASTINT (w->top); int right = left + window_internal_width (w); int bottom = top + window_internal_height (w); int i; for (i = vpos + 1; i < bottom; i++) { int *charstart = FRAME_CURRENT_GLYPHS (XFRAME (WINDOW_FRAME (w)))->charstarts[i]; int j; for (j = left; j < right; j++) if (charstart[j] > 0) charstart[j] += adjust; } } /* Check the charstarts values in the area of window W for internal consistency. We cannot check that they are "right"; we can only look for something nonsensical. */ verify_charstarts (w) struct window *w; { FRAME_PTR f = XFRAME (WINDOW_FRAME (w)); int i; int top = XFASTINT (w->top); int bottom = top + window_internal_height (w); int left = XFASTINT (w->left); int right = left + window_internal_width (w); int next_line; int truncate = (XINT (w->hscroll) || (truncate_partial_width_windows && (XFASTINT (w->width) < FRAME_WIDTH (f))) || !NILP (XBUFFER (w->buffer)->truncate_lines)); for (i = top; i < bottom; i++) { int j; int last; int *charstart = FRAME_CURRENT_GLYPHS (f)->charstarts[i]; if (i != top) { if (truncate) { /* If we are truncating lines, allow a jump in charstarts from one line to the next. */ if (charstart[left] < next_line) abort (); } else { if (charstart[left] != next_line) abort (); } } for (j = left; j < right; j++) if (charstart[j] > 0) last = charstart[j]; /* Record where the next line should start. */ next_line = last; if (BUF_ZV (XBUFFER (w->buffer)) != last) { /* If there's a newline between the two lines, count that. */ int endchar = *BUF_CHAR_ADDRESS (XBUFFER (w->buffer), last); if (endchar == '\n') next_line++; } } } /* On discovering that the redisplay for a window was no good, cancel the columns of that window, so that when the window is displayed over again get_display_line will not complain. */ cancel_my_columns (w) struct window *w; { register int vpos; register struct frame_glyphs *desired_glyphs = FRAME_DESIRED_GLYPHS (XFRAME (w->frame)); register int start = XFASTINT (w->left); register int bot = XFASTINT (w->top) + XFASTINT (w->height); for (vpos = XFASTINT (w->top); vpos < bot; vpos++) if (desired_glyphs->enable[vpos] && desired_glyphs->used[vpos] >= start) desired_glyphs->used[vpos] = start; } /* These functions try to perform directly and immediately on the frame the necessary output for one change in the buffer. They may return 0 meaning nothing was done if anything is difficult, or 1 meaning the output was performed properly. They assume that the frame was up to date before the buffer change being displayed. They make various other assumptions too; see command_loop_1 where these are called. */ int direct_output_for_insert (g) int g; { register FRAME_PTR frame = selected_frame; register struct frame_glyphs *current_frame = FRAME_CURRENT_GLYPHS (frame); #ifndef COMPILER_REGISTER_BUG register #endif /* COMPILER_REGISTER_BUG */ struct window *w = XWINDOW (selected_window); #ifndef COMPILER_REGISTER_BUG register #endif /* COMPILER_REGISTER_BUG */ int hpos = FRAME_CURSOR_X (frame); #ifndef COMPILER_REGISTER_BUG register #endif /* COMPILER_REGISTER_BUG */ int vpos = FRAME_CURSOR_Y (frame); /* Give up if about to continue line. */ if (hpos >= XFASTINT (w->left) + window_internal_width (w) - 1 /* Avoid losing if cursor is in invisible text off left margin */ || (XINT (w->hscroll) && hpos == XFASTINT (w->left)) /* Give up if cursor outside window (in minibuf, probably) */ || cursor_in_echo_area || FRAME_CURSOR_Y (frame) < XFASTINT (w->top) || FRAME_CURSOR_Y (frame) >= XFASTINT (w->top) + XFASTINT (w->height) /* Give up if cursor not really at FRAME_CURSOR_X, FRAME_CURSOR_Y */ || !display_completed /* Give up if buffer appears in two places. */ || buffer_shared > 1 #ifdef USE_TEXT_PROPERTIES /* Intervals have already been adjusted, point is after the character that was just inserted. */ /* Give up if character is invisible. */ /* Give up if character has a face property. At the moment we only lose at end of line or end of buffer and only with faces that have some background */ /* Instead of wasting time, give up if character has any text properties */ || ! NILP (Ftext_properties_at (make_number (point - 1), Qnil)) #endif /* Give up if w is minibuffer and a message is being displayed there */ || (MINI_WINDOW_P (w) && echo_area_glyphs)) return 0; { int face = 0; #ifdef HAVE_FACES int dummy; if (FRAME_WINDOW_P (frame)) face = compute_char_face (frame, w, point - 1, -1, -1, &dummy, point, 0); #endif current_frame->glyphs[vpos][hpos] = MAKE_GLYPH (frame, g, face); current_frame->charstarts[vpos][hpos] = point - 1; /* Record the entry for after the newly inserted character. */ current_frame->charstarts[vpos][hpos + 1] = point; adjust_window_charstarts (w, vpos, 1); } unchanged_modified = MODIFF; beg_unchanged = GPT - BEG; XSETFASTINT (w->last_point, point); XSETFASTINT (w->last_point_x, hpos); XSETFASTINT (w->last_modified, MODIFF); reassert_line_highlight (0, vpos); write_glyphs (¤t_frame->glyphs[vpos][hpos], 1); fflush (stdout); ++FRAME_CURSOR_X (frame); if (hpos == current_frame->used[vpos]) { current_frame->used[vpos] = hpos + 1; current_frame->glyphs[vpos][hpos + 1] = 0; } return 1; } int direct_output_forward_char (n) int n; { register FRAME_PTR frame = selected_frame; register struct window *w = XWINDOW (selected_window); Lisp_Object position; int hpos = FRAME_CURSOR_X (frame); /* Give up if in truncated text at end of line. */ if (hpos >= XFASTINT (w->left) + window_internal_width (w) - 1) return 0; /* Avoid losing if cursor is in invisible text off left margin or about to go off either side of window. */ if ((FRAME_CURSOR_X (frame) == XFASTINT (w->left) && (XINT (w->hscroll) || n < 0)) || (n > 0 && (FRAME_CURSOR_X (frame) + 1 >= window_internal_width (w) - 1)) || cursor_in_echo_area) return 0; /* Can't use direct output if highlighting a region. */ if (!NILP (Vtransient_mark_mode) && !NILP (current_buffer->mark_active)) return 0; /* Can't use direct output at an overlay boundary; it might have before-string or after-string properties. */ if (overlay_touches_p (PT) || overlay_touches_p (PT - n)) return 0; #ifdef USE_TEXT_PROPERTIES /* Don't use direct output next to an invisible character since we might need to do something special. */ XSETFASTINT (position, point); if (XFASTINT (position) < ZV && ! NILP (Fget_char_property (position, Qinvisible, selected_window))) return 0; XSETFASTINT (position, point - 1); if (XFASTINT (position) >= BEGV && ! NILP (Fget_char_property (position, Qinvisible, selected_window))) return 0; #endif FRAME_CURSOR_X (frame) += n; XSETFASTINT (w->last_point_x, FRAME_CURSOR_X (frame)); XSETFASTINT (w->last_point, point); cursor_to (FRAME_CURSOR_Y (frame), FRAME_CURSOR_X (frame)); fflush (stdout); return 1; } static void update_line (); /* Update frame F based on the data in FRAME_DESIRED_GLYPHS. Value is nonzero if redisplay stopped due to pending input. FORCE nonzero means do not stop for pending input. */ int update_frame (f, force, inhibit_hairy_id) FRAME_PTR f; int force; int inhibit_hairy_id; { register struct frame_glyphs *current_frame; register struct frame_glyphs *desired_frame = 0; register int i; int pause; int preempt_count = baud_rate / 2400 + 1; extern input_pending; #ifdef HAVE_WINDOW_SYSTEM register int downto, leftmost; #endif if (baud_rate != FRAME_COST_BAUD_RATE (f)) calculate_costs (f); if (preempt_count <= 0) preempt_count = 1; if (FRAME_HEIGHT (f) == 0) abort (); /* Some bug zeros some core */ detect_input_pending (); if (input_pending && !force) { pause = 1; goto do_pause; } update_begin (f); if (!line_ins_del_ok) inhibit_hairy_id = 1; /* These are separate to avoid a possible bug in the AIX C compiler. */ current_frame = FRAME_CURRENT_GLYPHS (f); desired_frame = FRAME_DESIRED_GLYPHS (f); /* See if any of the desired lines are enabled; don't compute for i/d line if just want cursor motion. */ for (i = 0; i < FRAME_HEIGHT (f); i++) if (desired_frame->enable[i]) break; /* Try doing i/d line, if not yet inhibited. */ if (!inhibit_hairy_id && i < FRAME_HEIGHT (f)) force |= scrolling (f); /* Update the individual lines as needed. Do bottom line first. */ if (desired_frame->enable[FRAME_HEIGHT (f) - 1]) update_line (f, FRAME_HEIGHT (f) - 1); #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) { leftmost = downto = FRAME_INTERNAL_BORDER_WIDTH (f); if (desired_frame->enable[0]) { current_frame->top_left_x[FRAME_HEIGHT (f) - 1] = leftmost; current_frame->top_left_y[FRAME_HEIGHT (f) - 1] = PIXEL_HEIGHT (f) - FRAME_INTERNAL_BORDER_WIDTH (f) - current_frame->pix_height[FRAME_HEIGHT (f) - 1]; current_frame->top_left_x[0] = leftmost; current_frame->top_left_y[0] = downto; } } #endif /* HAVE_WINDOW_SYSTEM */ /* Now update the rest of the lines. */ for (i = 0; i < FRAME_HEIGHT (f) - 1 && (force || !input_pending); i++) { if (desired_frame->enable[i]) { if (FRAME_TERMCAP_P (f)) { /* Flush out every so many lines. Also flush out if likely to have more than 1k buffered otherwise. I'm told that some telnet connections get really screwed by more than 1k output at once. */ int outq = PENDING_OUTPUT_COUNT (stdout); if (outq > 900 || (outq > 20 && ((i - 1) % preempt_count == 0))) { fflush (stdout); if (preempt_count == 1) { #ifdef EMACS_OUTQSIZE if (EMACS_OUTQSIZE (0, &outq) < 0) /* Probably not a tty. Ignore the error and reset * the outq count. */ outq = PENDING_OUTPUT_COUNT (stdout); #endif outq *= 10; if (baud_rate <= outq && baud_rate > 0) sleep (outq / baud_rate); } } if ((i - 1) % preempt_count == 0) detect_input_pending (); } update_line (f, i); #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) { current_frame->top_left_y[i] = downto; current_frame->top_left_x[i] = leftmost; } #endif /* HAVE_WINDOW_SYSTEM */ } #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) downto += current_frame->pix_height[i]; #endif /* HAVE_WINDOW_SYSTEM */ } pause = (i < FRAME_HEIGHT (f) - 1) ? i : 0; /* Now just clean up termcap drivers and set cursor, etc. */ if (!pause) { if ((cursor_in_echo_area /* If we are showing a message instead of the minibuffer, show the cursor for the message instead of for the (now hidden) minibuffer contents. */ || (EQ (minibuf_window, selected_window) && EQ (minibuf_window, echo_area_window) && echo_area_glyphs != 0)) /* These cases apply only to the frame that contains the active minibuffer window. */ && FRAME_HAS_MINIBUF_P (f) && EQ (FRAME_MINIBUF_WINDOW (f), minibuf_window)) { int top = XINT (XWINDOW (FRAME_MINIBUF_WINDOW (f))->top); int row, col; if (cursor_in_echo_area < 0) { row = top; col = 0; } else { /* If the minibuffer is several lines high, find the last line that has any text on it. */ row = FRAME_HEIGHT (f); do { row--; if (current_frame->enable[row]) col = current_frame->used[row]; else col = 0; } while (row > top && col == 0); if (col >= FRAME_WIDTH (f)) { col = 0; if (row < FRAME_HEIGHT (f) - 1) row++; } } cursor_to (row, col); } else cursor_to (FRAME_CURSOR_Y (f), max (min (FRAME_CURSOR_X (f), FRAME_WIDTH (f) - 1), 0)); } update_end (f); if (termscript) fflush (termscript); fflush (stdout); /* Here if output is preempted because input is detected. */ do_pause: if (FRAME_HEIGHT (f) == 0) abort (); /* Some bug zeros some core */ display_completed = !pause; bzero (FRAME_DESIRED_GLYPHS (f)->enable, FRAME_HEIGHT (f)); return pause; } /* Called when about to quit, to check for doing so at an improper time. */ void quit_error_check () { #if 0 if (FRAME_DESIRED_GLYPHS (selected_frame) == 0) return; if (FRAME_DESIRED_GLYPHS (selected_frame)->enable[0]) abort (); if (FRAME_DESIRED_GLYPHS (selected_frame)->enable[FRAME_HEIGHT (selected_frame) - 1]) abort (); #endif } /* Decide what insert/delete line to do, and do it */ extern void scrolling_1 (); scrolling (frame) FRAME_PTR frame; { int unchanged_at_top, unchanged_at_bottom; int window_size; int changed_lines; int *old_hash = (int *) alloca (FRAME_HEIGHT (frame) * sizeof (int)); int *new_hash = (int *) alloca (FRAME_HEIGHT (frame) * sizeof (int)); int *draw_cost = (int *) alloca (FRAME_HEIGHT (frame) * sizeof (int)); int *old_draw_cost = (int *) alloca (FRAME_HEIGHT (frame) * sizeof (int)); register int i; int free_at_end_vpos = FRAME_HEIGHT (frame); register struct frame_glyphs *current_frame = FRAME_CURRENT_GLYPHS (frame); register struct frame_glyphs *desired_frame = FRAME_DESIRED_GLYPHS (frame); /* Compute hash codes of all the lines. Also calculate number of changed lines, number of unchanged lines at the beginning, and number of unchanged lines at the end. */ changed_lines = 0; unchanged_at_top = 0; unchanged_at_bottom = FRAME_HEIGHT (frame); for (i = 0; i < FRAME_HEIGHT (frame); i++) { /* Give up on this scrolling if some old lines are not enabled. */ if (!current_frame->enable[i]) return 0; old_hash[i] = line_hash_code (current_frame, i); if (! desired_frame->enable[i]) new_hash[i] = old_hash[i]; else new_hash[i] = line_hash_code (desired_frame, i); if (old_hash[i] != new_hash[i]) { changed_lines++; unchanged_at_bottom = FRAME_HEIGHT (frame) - i - 1; } else if (i == unchanged_at_top) unchanged_at_top++; draw_cost[i] = line_draw_cost (desired_frame, i); old_draw_cost[i] = line_draw_cost (current_frame, i); } /* If changed lines are few, don't allow preemption, don't scroll. */ if (!scroll_region_ok && changed_lines < baud_rate / 2400 || unchanged_at_bottom == FRAME_HEIGHT (frame)) return 1; window_size = (FRAME_HEIGHT (frame) - unchanged_at_top - unchanged_at_bottom); if (scroll_region_ok) free_at_end_vpos -= unchanged_at_bottom; else if (memory_below_frame) free_at_end_vpos = -1; /* If large window, fast terminal and few lines in common between current frame and desired frame, don't bother with i/d calc. */ if (!scroll_region_ok && window_size >= 18 && baud_rate > 2400 && (window_size >= 10 * scrolling_max_lines_saved (unchanged_at_top, FRAME_HEIGHT (frame) - unchanged_at_bottom, old_hash, new_hash, draw_cost))) return 0; scrolling_1 (frame, window_size, unchanged_at_top, unchanged_at_bottom, draw_cost + unchanged_at_top - 1, old_draw_cost + unchanged_at_top - 1, old_hash + unchanged_at_top - 1, new_hash + unchanged_at_top - 1, free_at_end_vpos - unchanged_at_top); return 0; } /* Return the offset in its buffer of the character at location col, line in the given window. */ int buffer_posn_from_coords (window, col, line) struct window *window; int col, line; { int hscroll = XINT (window->hscroll); int window_left = XFASTINT (window->left); /* The actual width of the window is window->width less one for the DISP_CONTINUE_GLYPH, and less one if it's not the rightmost window. */ int window_width = window_internal_width (window) - 1; int startp = marker_position (window->start); /* Since compute_motion will only operate on the current buffer, we need to save the old one and restore it when we're done. */ struct buffer *old_current_buffer = current_buffer; struct position *posn; current_buffer = XBUFFER (window->buffer); /* We can't get a correct result in this case, but at least prevent compute_motion from crashing. */ if (startp < BEGV) startp = BEGV; /* It would be nice if we could use FRAME_CURRENT_GLYPHS (XFRAME (window->frame))->bufp to avoid scanning from the very top of the window, but it isn't maintained correctly, and I'm not even sure I will keep it. */ posn = compute_motion (startp, 0, ((window == XWINDOW (minibuf_window) && startp == BEG ? minibuf_prompt_width : 0) + (hscroll ? 1 - hscroll : 0)), 0, ZV, line, col, window_width, hscroll, 0, window); current_buffer = old_current_buffer; /* compute_motion considers frame points past the end of a line to be *after* the newline, i.e. at the start of the next line. This is reasonable, but not really what we want. So if the result is on a line below LINE, back it up one character. */ if (posn->vpos > line) return posn->bufpos - 1; else return posn->bufpos; } static int count_blanks (r) register GLYPH *r; { register GLYPH *p = r; while (*p++ == SPACEGLYPH); return p - r - 1; } static int count_match (str1, str2) GLYPH *str1, *str2; { register GLYPH *p1 = str1; register GLYPH *p2 = str2; while (*p1++ == *p2++); return p1 - str1 - 1; } /* Char insertion/deletion cost vector, from term.c */ extern int *char_ins_del_vector; #define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_WIDTH((f))]) static void update_line (frame, vpos) register FRAME_PTR frame; int vpos; { register GLYPH *obody, *nbody, *op1, *op2, *np1, *temp; int *temp1; int tem; int osp, nsp, begmatch, endmatch, olen, nlen; int save; register struct frame_glyphs *current_frame = FRAME_CURRENT_GLYPHS (frame); register struct frame_glyphs *desired_frame = FRAME_DESIRED_GLYPHS (frame); if (desired_frame->highlight[vpos] != (current_frame->enable[vpos] && current_frame->highlight[vpos])) { change_line_highlight (desired_frame->highlight[vpos], vpos, (current_frame->enable[vpos] ? current_frame->used[vpos] : 0)); current_frame->enable[vpos] = 0; } else reassert_line_highlight (desired_frame->highlight[vpos], vpos); if (! current_frame->enable[vpos]) { olen = 0; } else { obody = current_frame->glyphs[vpos]; olen = current_frame->used[vpos]; if (! current_frame->highlight[vpos]) { if (!must_write_spaces) while (olen > 0 && obody[olen - 1] == SPACEGLYPH) olen--; } else { /* For an inverse-video line, remember we gave it spaces all the way to the frame edge so that the reverse video extends all the way across. */ while (olen < FRAME_WIDTH (frame) - 1) obody[olen++] = SPACEGLYPH; } } /* One way or another, this will enable the line being updated. */ current_frame->enable[vpos] = 1; current_frame->used[vpos] = desired_frame->used[vpos]; current_frame->highlight[vpos] = desired_frame->highlight[vpos]; current_frame->bufp[vpos] = desired_frame->bufp[vpos]; #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (frame)) { current_frame->pix_width[vpos] = current_frame->used[vpos] * FONT_WIDTH (FRAME_FONT (frame)); current_frame->pix_height[vpos] = FRAME_LINE_HEIGHT (frame); } #endif /* HAVE_WINDOW_SYSTEM */ if (!desired_frame->enable[vpos]) { nlen = 0; goto just_erase; } nbody = desired_frame->glyphs[vpos]; nlen = desired_frame->used[vpos]; /* Pretend trailing spaces are not there at all, unless for one reason or another we must write all spaces. */ if (! desired_frame->highlight[vpos]) { if (!must_write_spaces) /* We know that the previous character byte contains 0. */ while (nbody[nlen - 1] == SPACEGLYPH) nlen--; } else { /* For an inverse-video line, give it extra trailing spaces all the way to the frame edge so that the reverse video extends all the way across. */ while (nlen < FRAME_WIDTH (frame) - 1) nbody[nlen++] = SPACEGLYPH; } /* If there's no i/d char, quickly do the best we can without it. */ if (!char_ins_del_ok) { int i,j; #if 0 if (FRAME_X_P (frame)) { /* Under X, erase everything we are going to rewrite, and rewrite everything from the first char that's changed. This is part of supporting fonts like Courier whose chars can overlap outside the char width. */ for (i = 0; i < nlen; i++) if (i >= olen || nbody[i] != obody[i]) break; cursor_to (vpos, i); if (i != olen) clear_end_of_line (olen); write_glyphs (nbody + i, nlen - i); } else {} #endif /* 0 */ for (i = 0; i < nlen; i++) { if (i >= olen || nbody[i] != obody[i]) /* A non-matching char. */ { cursor_to (vpos, i); for (j = 1; (i + j < nlen && (i + j >= olen || nbody[i+j] != obody[i+j])); j++); /* Output this run of non-matching chars. */ write_glyphs (nbody + i, j); i += j - 1; /* Now find the next non-match. */ } } /* Clear the rest of the line, or the non-clear part of it. */ if (olen > nlen) { cursor_to (vpos, nlen); clear_end_of_line (olen); } /* Exchange contents between current_frame and new_frame. */ temp = desired_frame->glyphs[vpos]; desired_frame->glyphs[vpos] = current_frame->glyphs[vpos]; current_frame->glyphs[vpos] = temp; /* Exchange charstarts between current_frame and new_frame. */ temp1 = desired_frame->charstarts[vpos]; desired_frame->charstarts[vpos] = current_frame->charstarts[vpos]; current_frame->charstarts[vpos] = temp1; return; } if (!olen) { nsp = (must_write_spaces || desired_frame->highlight[vpos]) ? 0 : count_blanks (nbody); if (nlen > nsp) { cursor_to (vpos, nsp); write_glyphs (nbody + nsp, nlen - nsp); } /* Exchange contents between current_frame and new_frame. */ temp = desired_frame->glyphs[vpos]; desired_frame->glyphs[vpos] = current_frame->glyphs[vpos]; current_frame->glyphs[vpos] = temp; /* Exchange charstarts between current_frame and new_frame. */ temp1 = desired_frame->charstarts[vpos]; desired_frame->charstarts[vpos] = current_frame->charstarts[vpos]; current_frame->charstarts[vpos] = temp1; return; } obody[olen] = 1; save = nbody[nlen]; nbody[nlen] = 0; /* Compute number of leading blanks in old and new contents. */ osp = count_blanks (obody); if (!desired_frame->highlight[vpos]) nsp = count_blanks (nbody); else nsp = 0; /* Compute number of matching chars starting with first nonblank. */ begmatch = count_match (obody + osp, nbody + nsp); /* Spaces in new match implicit space past the end of old. */ /* A bug causing this to be a no-op was fixed in 18.29. */ if (!must_write_spaces && osp + begmatch == olen) { np1 = nbody + nsp; while (np1[begmatch] == SPACEGLYPH) begmatch++; } /* Avoid doing insert/delete char just cause number of leading spaces differs when the following text does not match. */ if (begmatch == 0 && osp != nsp) osp = nsp = min (osp, nsp); /* Find matching characters at end of line */ op1 = obody + olen; np1 = nbody + nlen; op2 = op1 + begmatch - min (olen - osp, nlen - nsp); while (op1 > op2 && op1[-1] == np1[-1]) { op1--; np1--; } endmatch = obody + olen - op1; /* Put correct value back in nbody[nlen]. This is important because direct_output_for_insert can write into the line at a later point. If this screws up the zero at the end of the line, re-establish it. */ nbody[nlen] = save; obody[olen] = 0; /* tem gets the distance to insert or delete. endmatch is how many characters we save by doing so. Is it worth it? */ tem = (nlen - nsp) - (olen - osp); if (endmatch && tem && (!char_ins_del_ok || endmatch <= char_ins_del_cost (frame)[tem])) endmatch = 0; /* nsp - osp is the distance to insert or delete. If that is nonzero, begmatch is known to be nonzero also. begmatch + endmatch is how much we save by doing the ins/del. Is it worth it? */ if (nsp != osp && (!char_ins_del_ok || begmatch + endmatch <= char_ins_del_cost (frame)[nsp - osp])) { begmatch = 0; endmatch = 0; osp = nsp = min (osp, nsp); } /* Now go through the line, inserting, writing and deleting as appropriate. */ if (osp > nsp) { cursor_to (vpos, nsp); delete_glyphs (osp - nsp); } else if (nsp > osp) { /* If going to delete chars later in line and insert earlier in the line, must delete first to avoid losing data in the insert */ if (endmatch && nlen < olen + nsp - osp) { cursor_to (vpos, nlen - endmatch + osp - nsp); delete_glyphs (olen + nsp - osp - nlen); olen = nlen - (nsp - osp); } cursor_to (vpos, osp); insert_glyphs ((char *)0, nsp - osp); } olen += nsp - osp; tem = nsp + begmatch + endmatch; if (nlen != tem || olen != tem) { cursor_to (vpos, nsp + begmatch); if (!endmatch || nlen == olen) { /* If new text being written reaches right margin, there is no need to do clear-to-eol at the end. (and it would not be safe, since cursor is not going to be "at the margin" after the text is done) */ if (nlen == FRAME_WIDTH (frame)) olen = 0; write_glyphs (nbody + nsp + begmatch, nlen - tem); #ifdef obsolete /* the following code loses disastrously if tem == nlen. Rather than trying to fix that case, I am trying the simpler solution found above. */ /* If the text reaches to the right margin, it will lose one way or another (depending on AutoWrap) to clear to end of line after outputting all the text. So pause with one character to go and clear the line then. */ if (nlen == FRAME_WIDTH (frame) && fast_clear_end_of_line && olen > nlen) { /* endmatch must be zero, and tem must equal nsp + begmatch */ write_glyphs (nbody + tem, nlen - tem - 1); clear_end_of_line (olen); olen = 0; /* Don't let it be cleared again later */ write_glyphs (nbody + nlen - 1, 1); } else write_glyphs (nbody + nsp + begmatch, nlen - tem); #endif /* OBSOLETE */ } else if (nlen > olen) { write_glyphs (nbody + nsp + begmatch, olen - tem); insert_glyphs (nbody + nsp + begmatch + olen - tem, nlen - olen); olen = nlen; } else if (olen > nlen) { write_glyphs (nbody + nsp + begmatch, nlen - tem); delete_glyphs (olen - nlen); olen = nlen; } } just_erase: /* If any unerased characters remain after the new line, erase them. */ if (olen > nlen) { cursor_to (vpos, nlen); clear_end_of_line (olen); } /* Exchange contents between current_frame and new_frame. */ temp = desired_frame->glyphs[vpos]; desired_frame->glyphs[vpos] = current_frame->glyphs[vpos]; current_frame->glyphs[vpos] = temp; /* Exchange charstarts between current_frame and new_frame. */ temp1 = desired_frame->charstarts[vpos]; desired_frame->charstarts[vpos] = current_frame->charstarts[vpos]; current_frame->charstarts[vpos] = temp1; } /* A vector of size >= 2 * NFRAMES + 3 * NBUFFERS + 1, containing the session's frames, frame names, buffers, buffer-read-only flags, and buffer-modified-flags, and a trailing sentinel (so we don't need to add length checks). */ static Lisp_Object frame_and_buffer_state; DEFUN ("frame-or-buffer-changed-p", Fframe_or_buffer_changed_p, Sframe_or_buffer_changed_p, 0, 0, 0, "Return non-nil if the frame and buffer state appears to have changed.\n\ The state variable is an internal vector containing all frames and buffers,\n\ aside from buffers whose names start with space,\n\ along with the buffers' read-only and modified flags, which allows a fast\n\ check to see whether the menu bars might need to be recomputed.\n\ If this function returns non-nil, it updates the internal vector to reflect\n\ the current state.\n") () { Lisp_Object tail, frame, buf; Lisp_Object *vecp; int n; vecp = XVECTOR (frame_and_buffer_state)->contents; FOR_EACH_FRAME (tail, frame) { if (!EQ (*vecp++, frame)) goto changed; if (!EQ (*vecp++, XFRAME (frame)->name)) goto changed; } /* Check that the buffer info matches. No need to test for the end of the vector because the last element of the vector is lambda and that will always cause a mismatch. */ for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr) { buf = XCONS (XCONS (tail)->car)->cdr; /* Ignore buffers that aren't included in buffer lists. */ if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ') continue; if (!EQ (*vecp++, buf)) goto changed; if (!EQ (*vecp++, XBUFFER (buf)->read_only)) goto changed; if (!EQ (*vecp++, Fbuffer_modified_p (buf))) goto changed; } /* Detect deletion of a buffer at the end of the list. */ if (*vecp == Qlambda) return Qnil; changed: /* Start with 1 so there is room for at least one lambda at the end. */ n = 1; FOR_EACH_FRAME (tail, frame) n += 2; for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr) n += 3; /* Reallocate the vector if it's grown, or if it's shrunk a lot. */ if (n > XVECTOR (frame_and_buffer_state)->size || n + 20 < XVECTOR (frame_and_buffer_state)->size / 2) /* Add 20 extra so we grow it less often. */ frame_and_buffer_state = Fmake_vector (make_number (n + 20), Qlambda); vecp = XVECTOR (frame_and_buffer_state)->contents; FOR_EACH_FRAME (tail, frame) { *vecp++ = frame; *vecp++ = XFRAME (frame)->name; } for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr) { buf = XCONS (XCONS (tail)->car)->cdr; /* Ignore buffers that aren't included in buffer lists. */ if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ') continue; *vecp++ = buf; *vecp++ = XBUFFER (buf)->read_only; *vecp++ = Fbuffer_modified_p (buf); } /* Fill up the vector with lambdas (always at least one). */ *vecp++ = Qlambda; while (vecp - XVECTOR (frame_and_buffer_state)->contents < XVECTOR (frame_and_buffer_state)->size) *vecp++ = Qlambda; /* Make sure we didn't overflow the vector. */ if (vecp - XVECTOR (frame_and_buffer_state)->contents > XVECTOR (frame_and_buffer_state)->size) abort (); return Qt; } DEFUN ("open-termscript", Fopen_termscript, Sopen_termscript, 1, 1, "FOpen termscript file: ", "Start writing all terminal output to FILE as well as the terminal.\n\ FILE = nil means just close any termscript file currently open.") (file) Lisp_Object file; { if (termscript != 0) fclose (termscript); termscript = 0; if (! NILP (file)) { file = Fexpand_file_name (file, Qnil); termscript = fopen (XSTRING (file)->data, "w"); if (termscript == 0) report_file_error ("Opening termscript", Fcons (file, Qnil)); } return Qnil; } #ifdef SIGWINCH SIGTYPE window_change_signal (signalnum) /* If we don't have an argument, */ int signalnum; /* some compilers complain in signal calls. */ { int width, height; extern int errno; int old_errno = errno; get_frame_size (&width, &height); /* The frame size change obviously applies to a termcap-controlled frame. Find such a frame in the list, and assume it's the only one (since the redisplay code always writes to stdout, not a FILE * specified in the frame structure). Record the new size, but don't reallocate the data structures now. Let that be done later outside of the signal handler. */ { Lisp_Object tail, frame; FOR_EACH_FRAME (tail, frame) { if (FRAME_TERMCAP_P (XFRAME (frame))) { change_frame_size (XFRAME (frame), height, width, 0, 1); break; } } } signal (SIGWINCH, window_change_signal); errno = old_errno; } #endif /* SIGWINCH */ /* Do any change in frame size that was requested by a signal. */ do_pending_window_change () { /* If window_change_signal should have run before, run it now. */ while (delayed_size_change) { Lisp_Object tail, frame; delayed_size_change = 0; FOR_EACH_FRAME (tail, frame) { FRAME_PTR f = XFRAME (frame); int height = FRAME_NEW_HEIGHT (f); int width = FRAME_NEW_WIDTH (f); if (height != 0 || width != 0) change_frame_size (f, height, width, 0, 0); } } } /* Change the frame height and/or width. Values may be given as zero to indicate no change is to take place. If DELAY is non-zero, then assume we're being called from a signal handler, and queue the change for later - perhaps the next redisplay. Since this tries to resize windows, we can't call it from a signal handler. */ change_frame_size (f, newheight, newwidth, pretend, delay) register FRAME_PTR f; int newheight, newwidth, pretend; { Lisp_Object tail, frame; if (FRAME_TERMCAP_P (f)) { /* When using termcap, all frames use the same screen, so a change in size affects all termcap frames. */ FOR_EACH_FRAME (tail, frame) if (FRAME_TERMCAP_P (XFRAME (frame))) change_frame_size_1 (XFRAME (frame), newheight, newwidth, pretend, delay); } else change_frame_size_1 (f, newheight, newwidth, pretend, delay); } static void change_frame_size_1 (frame, newheight, newwidth, pretend, delay) register FRAME_PTR frame; int newheight, newwidth, pretend, delay; { /* If we can't deal with the change now, queue it for later. */ if (delay) { FRAME_NEW_HEIGHT (frame) = newheight; FRAME_NEW_WIDTH (frame) = newwidth; delayed_size_change = 1; return; } /* This size-change overrides any pending one for this frame. */ FRAME_NEW_HEIGHT (frame) = 0; FRAME_NEW_WIDTH (frame) = 0; /* If an argument is zero, set it to the current value. */ newheight || (newheight = FRAME_HEIGHT (frame)); newwidth || (newwidth = FRAME_WIDTH (frame)); /* Round up to the smallest acceptable size. */ check_frame_size (frame, &newheight, &newwidth); /* If we're not changing the frame size, quit now. */ if (newheight == FRAME_HEIGHT (frame) && newwidth == FRAME_WIDTH (frame)) return; if (newheight != FRAME_HEIGHT (frame)) { if (FRAME_HAS_MINIBUF_P (frame) && ! FRAME_MINIBUF_ONLY_P (frame)) { /* Frame has both root and minibuffer. */ set_window_height (FRAME_ROOT_WINDOW (frame), newheight - 1 - FRAME_MENU_BAR_LINES (frame), 0); XSETFASTINT (XWINDOW (FRAME_MINIBUF_WINDOW (frame))->top, newheight - 1); set_window_height (FRAME_MINIBUF_WINDOW (frame), 1, 0); } else /* Frame has just one top-level window. */ set_window_height (FRAME_ROOT_WINDOW (frame), newheight - FRAME_MENU_BAR_LINES (frame), 0); if (FRAME_TERMCAP_P (frame) && !pretend) FrameRows = newheight; #if 0 if (frame->output_method == output_termcap) { frame_height = newheight; if (!pretend) FrameRows = newheight; } #endif } if (newwidth != FRAME_WIDTH (frame)) { set_window_width (FRAME_ROOT_WINDOW (frame), newwidth, 0); if (FRAME_HAS_MINIBUF_P (frame)) set_window_width (FRAME_MINIBUF_WINDOW (frame), newwidth, 0); if (FRAME_TERMCAP_P (frame) && !pretend) FrameCols = newwidth; #if 0 if (frame->output_method == output_termcap) { frame_width = newwidth; if (!pretend) FrameCols = newwidth; } #endif } FRAME_HEIGHT (frame) = newheight; FRAME_WIDTH (frame) = newwidth; if (FRAME_CURSOR_X (frame) >= FRAME_WIDTH (frame)) FRAME_CURSOR_X (frame) = FRAME_WIDTH (frame) - 1; if (FRAME_CURSOR_Y (frame) >= FRAME_HEIGHT (frame)) FRAME_CURSOR_Y (frame) = FRAME_HEIGHT (frame) - 1; remake_frame_glyphs (frame); calculate_costs (frame); } DEFUN ("send-string-to-terminal", Fsend_string_to_terminal, Ssend_string_to_terminal, 1, 1, 0, "Send STRING to the terminal without alteration.\n\ Control characters in STRING will have terminal-dependent effects.") (str) Lisp_Object str; { CHECK_STRING (str, 0); fwrite (XSTRING (str)->data, 1, XSTRING (str)->size, stdout); fflush (stdout); if (termscript) { fwrite (XSTRING (str)->data, 1, XSTRING (str)->size, termscript); fflush (termscript); } return Qnil; } DEFUN ("ding", Fding, Sding, 0, 1, 0, "Beep, or flash the screen.\n\ Also, unless an argument is given,\n\ terminate any keyboard macro currently executing.") (arg) Lisp_Object arg; { if (!NILP (arg)) { if (noninteractive) putchar (07); else ring_bell (); fflush (stdout); } else bitch_at_user (); return Qnil; } bitch_at_user () { if (noninteractive) putchar (07); else if (!INTERACTIVE) /* Stop executing a keyboard macro. */ error ("Keyboard macro terminated by a command ringing the bell"); else ring_bell (); fflush (stdout); } DEFUN ("sleep-for", Fsleep_for, Ssleep_for, 1, 2, 0, "Pause, without updating display, for SECONDS seconds.\n\ SECONDS may be a floating-point value, meaning that you can wait for a\n\ fraction of a second. Optional second arg MILLISECONDS specifies an\n\ additional wait period, in milliseconds; this may be useful if your\n\ Emacs was built without floating point support.\n\ \(Not all operating systems support waiting for a fraction of a second.)") (seconds, milliseconds) Lisp_Object seconds, milliseconds; { int sec, usec; if (NILP (milliseconds)) XSETINT (milliseconds, 0); else CHECK_NUMBER (milliseconds, 1); usec = XINT (milliseconds) * 1000; #ifdef LISP_FLOAT_TYPE { double duration = extract_float (seconds); sec = (int) duration; usec += (duration - sec) * 1000000; } #else CHECK_NUMBER (seconds, 0); sec = XINT (seconds); #endif #ifndef EMACS_HAS_USECS if (sec == 0 && usec != 0) error ("millisecond `sleep-for' not supported on %s", SYSTEM_TYPE); #endif /* Assure that 0 <= usec < 1000000. */ if (usec < 0) { /* We can't rely on the rounding being correct if user is negative. */ if (-1000000 < usec) sec--, usec += 1000000; else sec -= -usec / 1000000, usec = 1000000 - (-usec % 1000000); } else sec += usec / 1000000, usec %= 1000000; if (sec <= 0) return Qnil; { Lisp_Object zero; XSETFASTINT (zero, 0); wait_reading_process_input (sec, usec, zero, 0); } /* We should always have wait_reading_process_input; we have a dummy implementation for systems which don't support subprocesses. */ #if 0 /* No wait_reading_process_input */ immediate_quit = 1; QUIT; #ifdef VMS sys_sleep (sec); #else /* not VMS */ /* The reason this is done this way (rather than defined (H_S) && defined (H_T)) is because the VMS preprocessor doesn't grok `defined' */ #ifdef HAVE_SELECT EMACS_GET_TIME (end_time); EMACS_SET_SECS_USECS (timeout, sec, usec); EMACS_ADD_TIME (end_time, end_time, timeout); while (1) { EMACS_GET_TIME (timeout); EMACS_SUB_TIME (timeout, end_time, timeout); if (EMACS_TIME_NEG_P (timeout) || !select (1, 0, 0, 0, &timeout)) break; } #else /* not HAVE_SELECT */ sleep (sec); #endif /* HAVE_SELECT */ #endif /* not VMS */ immediate_quit = 0; #endif /* no subprocesses */ return Qnil; } /* This is just like wait_reading_process_input, except that it does the redisplay. It's also much like Fsit_for, except that it can be used for waiting for input as well. */ Lisp_Object sit_for (sec, usec, reading, display) int sec, usec, reading, display; { Lisp_Object read_kbd; if (detect_input_pending ()) return Qnil; if (display) redisplay_preserve_echo_area (); if (sec == 0 && usec == 0) return Qt; #ifdef SIGIO gobble_input (0); #endif XSETINT (read_kbd, reading ? -1 : 1); wait_reading_process_input (sec, usec, read_kbd, display); /* wait_reading_process_input should always be available now; it is simulated in a simple way on systems that don't support subprocesses. */ #if 0 /* No wait_reading_process_input available. */ immediate_quit = 1; QUIT; waitchannels = 1; #ifdef VMS input_wait_timeout (XINT (arg)); #else /* not VMS */ #ifndef HAVE_TIMEVAL timeout_sec = sec; select (1, &waitchannels, 0, 0, &timeout_sec); #else /* HAVE_TIMEVAL */ timeout.tv_sec = sec; timeout.tv_usec = usec; select (1, &waitchannels, 0, 0, &timeout); #endif /* HAVE_TIMEVAL */ #endif /* not VMS */ immediate_quit = 0; #endif return detect_input_pending () ? Qnil : Qt; } DEFUN ("sit-for", Fsit_for, Ssit_for, 1, 3, 0, "Perform redisplay, then wait for SECONDS seconds or until input is available.\n\ SECONDS may be a floating-point value, meaning that you can wait for a\n\ fraction of a second. Optional second arg MILLISECONDS specifies an\n\ additional wait period, in milliseconds; this may be useful if your\n\ Emacs was built without floating point support.\n\ \(Not all operating systems support waiting for a fraction of a second.)\n\ Optional third arg non-nil means don't redisplay, just wait for input.\n\ Redisplay is preempted as always if input arrives, and does not happen\n\ if input is available before it starts.\n\ Value is t if waited the full time with no input arriving.") (seconds, milliseconds, nodisp) Lisp_Object seconds, milliseconds, nodisp; { int sec, usec; if (NILP (milliseconds)) XSETINT (milliseconds, 0); else CHECK_NUMBER (milliseconds, 1); usec = XINT (milliseconds) * 1000; #ifdef LISP_FLOAT_TYPE { double duration = extract_float (seconds); sec = (int) duration; usec += (duration - sec) * 1000000; } #else CHECK_NUMBER (seconds, 0); sec = XINT (seconds); #endif #ifndef EMACS_HAS_USECS if (usec != 0 && sec == 0) error ("millisecond `sit-for' not supported on %s", SYSTEM_TYPE); #endif return sit_for (sec, usec, 0, NILP (nodisp)); } char *terminal_type; /* Initialization done when Emacs fork is started, before doing stty. */ /* Determine terminal type and set terminal_driver */ /* Then invoke its decoding routine to set up variables in the terminal package */ init_display () { #ifdef HAVE_X_WINDOWS extern int display_arg; #endif meta_key = 0; inverse_video = 0; cursor_in_echo_area = 0; terminal_type = (char *) 0; /* Now is the time to initialize this; it's used by init_sys_modes during startup. */ Vwindow_system = Qnil; /* If the user wants to use a window system, we shouldn't bother initializing the terminal. This is especially important when the terminal is so dumb that emacs gives up before and doesn't bother using the window system. If the DISPLAY environment variable is set, try to use X, and die with an error message if that doesn't work. */ #ifdef HAVE_X_WINDOWS if (! display_arg) { #ifdef VMS display_arg = (getenv ("DECW$DISPLAY") != 0); #else display_arg = (getenv ("DISPLAY") != 0); #endif } if (!inhibit_window_system && display_arg) { Vwindow_system = intern ("x"); #ifdef HAVE_X11 Vwindow_system_version = make_number (11); #else Vwindow_system_version = make_number (10); #endif return; } #endif /* HAVE_X_WINDOWS */ #ifdef HAVE_NTGUI if (!inhibit_window_system) { Vwindow_system = intern ("win32"); Vwindow_system_version = make_number (1); return; } #endif /* HAVE_NTGUI */ /* If no window system has been specified, try to use the terminal. */ if (! isatty (0)) { fprintf (stderr, "emacs: standard input is not a tty\n"); exit (1); } /* Look at the TERM variable */ terminal_type = (char *) getenv ("TERM"); if (!terminal_type) { #ifdef VMS fprintf (stderr, "Please specify your terminal type.\n\ For types defined in VMS, use set term /device=TYPE.\n\ For types not defined in VMS, use define emacs_term \"TYPE\".\n\ \(The quotation marks are necessary since terminal types are lower case.)\n"); #else fprintf (stderr, "Please set the environment variable TERM; see tset(1).\n"); #endif exit (1); } #ifdef VMS /* VMS DCL tends to upcase things, so downcase term type. Hardly any uppercase letters in terminal types; should be none. */ { char *new = (char *) xmalloc (strlen (terminal_type) + 1); char *p; strcpy (new, terminal_type); for (p = new; *p; p++) if (isupper (*p)) *p = tolower (*p); terminal_type = new; } #endif term_init (terminal_type); remake_frame_glyphs (selected_frame); calculate_costs (selected_frame); /* X and Y coordinates of the cursor between updates. */ FRAME_CURSOR_X (selected_frame) = 0; FRAME_CURSOR_Y (selected_frame) = 0; #ifdef SIGWINCH #ifndef CANNOT_DUMP if (initialized) #endif /* CANNOT_DUMP */ signal (SIGWINCH, window_change_signal); #endif /* SIGWINCH */ } syms_of_display () { #ifdef MULTI_FRAME defsubr (&Sredraw_frame); #endif defsubr (&Sredraw_display); defsubr (&Sframe_or_buffer_changed_p); defsubr (&Sopen_termscript); defsubr (&Sding); defsubr (&Ssit_for); defsubr (&Ssleep_for); defsubr (&Ssend_string_to_terminal); frame_and_buffer_state = Fmake_vector (make_number (20), Qlambda); staticpro (&frame_and_buffer_state); Qdisplay_table = intern ("display-table"); staticpro (&Qdisplay_table); DEFVAR_INT ("baud-rate", &baud_rate, "*The output baud rate of the terminal.\n\ On most systems, changing this value will affect the amount of padding\n\ and the other strategic decisions made during redisplay."); DEFVAR_BOOL ("inverse-video", &inverse_video, "*Non-nil means invert the entire frame display.\n\ This means everything is in inverse video which otherwise would not be."); DEFVAR_BOOL ("visible-bell", &visible_bell, "*Non-nil means try to flash the frame to represent a bell."); DEFVAR_BOOL ("no-redraw-on-reenter", &no_redraw_on_reenter, "*Non-nil means no need to redraw entire frame after suspending.\n\ A non-nil value is useful if the terminal can automatically preserve\n\ Emacs's frame display when you reenter Emacs.\n\ It is up to you to set this variable if your terminal can do that."); DEFVAR_LISP ("window-system", &Vwindow_system, "A symbol naming the window-system under which Emacs is running\n\ \(such as `x'), or nil if emacs is running on an ordinary terminal."); DEFVAR_LISP ("window-system-version", &Vwindow_system_version, "The version number of the window system in use.\n\ For X windows, this is 10 or 11."); DEFVAR_BOOL ("cursor-in-echo-area", &cursor_in_echo_area, "Non-nil means put cursor in minibuffer, at end of any message there."); DEFVAR_LISP ("glyph-table", &Vglyph_table, "Table defining how to output a glyph code to the frame.\n\ If not nil, this is a vector indexed by glyph code to define the glyph.\n\ Each element can be:\n\ integer: a glyph code which this glyph is an alias for.\n\ string: output this glyph using that string (not impl. in X windows).\n\ nil: this glyph mod 256 is char code to output,\n\ and this glyph / 256 is face code for X windows (see `face-id')."); Vglyph_table = Qnil; DEFVAR_LISP ("standard-display-table", &Vstandard_display_table, "Display table to use for buffers that specify none.\n\ See `buffer-display-table' for more information."); Vstandard_display_table = Qnil; /* Initialize `window-system', unless init_display already decided it. */ #ifdef CANNOT_DUMP if (noninteractive) #endif { Vwindow_system = Qnil; Vwindow_system_version = Qnil; } } emacs-19.30/src/doc.c100444 12120 1 44557 6051145032 12633 0ustar rmsdaemon/* Record indices of function doc strings stored in a file. Copyright (C) 1985, 1986, 1993, 1994, 1995 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. */ #include #include #include /* Must be after sys/types.h for USG and BSD4_1*/ #ifdef USG5 #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifndef O_RDONLY #define O_RDONLY 0 #endif #include "lisp.h" #include "buffer.h" #include "keyboard.h" Lisp_Object Vdoc_file_name; extern char *index (); extern Lisp_Object Voverriding_local_map; /* For VMS versions with limited file name syntax, convert the name to something VMS will allow. */ static void munge_doc_file_name (name) char *name; { #ifdef VMS #ifndef VMS4_4 /* For VMS versions with limited file name syntax, convert the name to something VMS will allow. */ p = name; while (*p) { if (*p == '-') *p = '_'; p++; } #endif /* not VMS4_4 */ #ifdef VMS4_4 strcpy (name, sys_translate_unix (name)); #endif /* VMS4_4 */ #endif /* VMS */ } /* Extract a doc string from a file. FILEPOS says where to get it. If it is an integer, use that position in the standard DOC-... file. If it is (FILE . INTEGER), use FILE as the file name and INTEGER as the position in that file. But if INTEGER is negative, make it positive. (A negative integer is used for user variables, so we can distinguish them without actually fetching the doc string.) */ static Lisp_Object get_doc_string (filepos) Lisp_Object filepos; { char buf[512 * 32 + 1]; char *buffer; int buffer_size; int free_it; char *from, *to; register int fd; register char *name; register char *p, *p1; int minsize; int position; Lisp_Object file, tem; if (INTEGERP (filepos)) { file = Vdoc_file_name; position = XINT (filepos); } else if (CONSP (filepos)) { file = XCONS (filepos)->car; position = XINT (XCONS (filepos)->cdr); if (position < 0) position = - position; } else return Qnil; if (!STRINGP (Vdoc_directory)) return Qnil; if (!STRINGP (file)) return Qnil; /* Put the file name in NAME as a C string. If it is relative, combine it with Vdoc_directory. */ tem = Ffile_name_absolute_p (file); if (NILP (tem)) { minsize = XSTRING (Vdoc_directory)->size; /* sizeof ("../etc/") == 8 */ if (minsize < 8) minsize = 8; name = (char *) alloca (minsize + XSTRING (file)->size + 8); strcpy (name, XSTRING (Vdoc_directory)->data); strcat (name, XSTRING (file)->data); munge_doc_file_name (name); } else { name = (char *) XSTRING (file)->data; } fd = open (name, O_RDONLY, 0); if (fd < 0) { #ifndef CANNOT_DUMP if (!NILP (Vpurify_flag)) { /* Preparing to dump; DOC file is probably not installed. So check in ../etc. */ strcpy (name, "../etc/"); strcat (name, XSTRING (file)->data); munge_doc_file_name (name); fd = open (name, O_RDONLY, 0); } #endif if (fd < 0) error ("Cannot open doc string file \"%s\"", name); } if (0 > lseek (fd, position, 0)) { close (fd); error ("Position %ld out of range in doc string file \"%s\"", position, name); } /* Read the doc string into a buffer. Use the fixed buffer BUF if it is big enough; otherwise allocate one and set FREE_IT. We store the buffer in use in BUFFER and its size in BUFFER_SIZE. */ buffer = buf; buffer_size = sizeof buf; free_it = 0; p = buf; while (1) { int space_left = buffer_size - (p - buffer); int nread; /* Switch to a bigger buffer if we need one. */ if (space_left == 0) { if (free_it) { int offset = p - buffer; buffer = (char *) xrealloc (buffer, buffer_size *= 2); p = buffer + offset; } else { buffer = (char *) xmalloc (buffer_size *= 2); bcopy (buf, buffer, p - buf); p = buffer + (p - buf); } free_it = 1; space_left = buffer_size - (p - buffer); } /* Don't read too too much at one go. */ if (space_left > 1024 * 8) space_left = 1024 * 8; nread = read (fd, p, space_left); if (nread < 0) { close (fd); error ("Read error on documentation file"); } p[nread] = 0; if (!nread) break; p1 = index (p, '\037'); if (p1) { *p1 = 0; p = p1; break; } p += nread; } close (fd); /* Scan the text and perform quoting with ^A (char code 1). ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */ from = buffer; to = buffer; while (from != p) { if (*from == 1) { int c; from++; c = *from++; if (c == 1) *to++ = c; else if (c == '0') *to++ = 0; else if (c == '_') *to++ = 037; else error ("Invalid data in documentation file -- ^A followed by code 0%o", c); } else *to++ = *from++; } tem = make_string (buffer, to - buffer); if (free_it) free (buffer); return tem; } /* Get a string from position FILEPOS and pass it through the Lisp reader. We use this for fetching the bytecode string and constants vector of a compiled function from the .elc file. */ Lisp_Object read_doc_string (filepos) Lisp_Object filepos; { return Fread (get_doc_string (filepos)); } DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0, "Return the documentation string of FUNCTION.\n\ Unless a non-nil second argument is given, the\n\ string is passed through `substitute-command-keys'.") (function, raw) Lisp_Object function, raw; { Lisp_Object fun; Lisp_Object funcar; Lisp_Object tem, doc; fun = Findirect_function (function); if (SUBRP (fun)) { if (XSUBR (fun)->doc == 0) return Qnil; if ((EMACS_INT) XSUBR (fun)->doc >= 0) doc = build_string (XSUBR (fun)->doc); else doc = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc)); } else if (COMPILEDP (fun)) { if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING) return Qnil; tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING]; if (STRINGP (tem)) doc = tem; else if (NATNUMP (tem) || CONSP (tem)) doc = get_doc_string (tem); else return Qnil; } else if (STRINGP (fun) || VECTORP (fun)) { return build_string ("Keyboard macro."); } else if (CONSP (fun)) { funcar = Fcar (fun); if (!SYMBOLP (funcar)) return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); else if (EQ (funcar, Qkeymap)) return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\ subcommands.)"); else if (EQ (funcar, Qlambda) || EQ (funcar, Qautoload)) { Lisp_Object tem1; tem1 = Fcdr (Fcdr (fun)); tem = Fcar (tem1); if (STRINGP (tem)) doc = tem; /* Handle a doc reference--but these never come last in the function body, so reject them if they are last. */ else if ((NATNUMP (tem) || CONSP (tem)) && ! NILP (XCONS (tem1)->cdr)) doc = get_doc_string (tem); else return Qnil; } else if (EQ (funcar, Qmocklisp)) return Qnil; else if (EQ (funcar, Qmacro)) return Fdocumentation (Fcdr (fun), raw); else goto oops; } else { oops: Fsignal (Qinvalid_function, Fcons (fun, Qnil)); } if (NILP (raw)) { struct gcpro gcpro1; GCPRO1 (doc); doc = Fsubstitute_command_keys (doc); UNGCPRO; } return doc; } DEFUN ("documentation-property", Fdocumentation_property, Sdocumentation_property, 2, 3, 0, "Return the documentation string that is SYMBOL's PROP property.\n\ This is like `get', but it can refer to strings stored in the\n\ `etc/DOC' file; and if the value is a string, it is passed through\n\ `substitute-command-keys'. A non-nil third argument avoids this\n\ translation.") (sym, prop, raw) Lisp_Object sym, prop, raw; { register Lisp_Object tem; tem = Fget (sym, prop); if (INTEGERP (tem)) tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem))); else if (CONSP (tem)) tem = get_doc_string (tem); if (NILP (raw) && STRINGP (tem)) return Fsubstitute_command_keys (tem); return tem; } /* Scanning the DOC files and placing docstring offsets into functions. */ static void store_function_docstring (fun, offset) Lisp_Object fun; /* Use EMACS_INT because we get this from pointer subtraction. */ EMACS_INT offset; { fun = indirect_function (fun); /* The type determines where the docstring is stored. */ /* Lisp_Subrs have a slot for it. */ if (SUBRP (fun)) XSUBR (fun)->doc = (char *) - offset; /* If it's a lisp form, stick it in the form. */ else if (CONSP (fun)) { Lisp_Object tem; tem = XCONS (fun)->car; if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) { tem = Fcdr (Fcdr (fun)); if (CONSP (tem) && INTEGERP (XCONS (tem)->car)) XSETFASTINT (XCONS (tem)->car, offset); } else if (EQ (tem, Qmacro)) store_function_docstring (XCONS (fun)->cdr, offset); } /* Bytecode objects sometimes have slots for it. */ else if (COMPILEDP (fun)) { /* This bytecode object must have a slot for the docstring, since we've found a docstring for it. */ if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING) XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset); } } DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation, 1, 1, 0, "Used during Emacs initialization, before dumping runnable Emacs,\n\ to find pointers to doc strings stored in `etc/DOC...' and\n\ record them in function definitions.\n\ One arg, FILENAME, a string which does not include a directory.\n\ The file is found in `../etc' now; found in the `data-directory'\n\ when doc strings are referred to later in the dumped Emacs.") (filename) Lisp_Object filename; { int fd; char buf[1024 + 1]; register int filled; register int pos; register char *p, *end; Lisp_Object sym, fun, tem; char *name; extern char *index (); #ifndef CANNOT_DUMP if (NILP (Vpurify_flag)) error ("Snarf-documentation can only be called in an undumped Emacs"); #endif CHECK_STRING (filename, 0); #ifndef CANNOT_DUMP name = (char *) alloca (XSTRING (filename)->size + 14); strcpy (name, "../etc/"); #else /* CANNOT_DUMP */ CHECK_STRING (Vdoc_directory, 0); name = (char *) alloca (XSTRING (filename)->size + XSTRING (Vdoc_directory)->size + 1); strcpy (name, XSTRING (Vdoc_directory)->data); #endif /* CANNOT_DUMP */ strcat (name, XSTRING (filename)->data); /*** Add this line ***/ #ifdef VMS #ifndef VMS4_4 /* For VMS versions with limited file name syntax, convert the name to something VMS will allow. */ p = name; while (*p) { if (*p == '-') *p = '_'; p++; } #endif /* not VMS4_4 */ #ifdef VMS4_4 strcpy (name, sys_translate_unix (name)); #endif /* VMS4_4 */ #endif /* VMS */ fd = open (name, O_RDONLY, 0); if (fd < 0) report_file_error ("Opening doc string file", Fcons (build_string (name), Qnil)); Vdoc_file_name = filename; filled = 0; pos = 0; while (1) { if (filled < 512) filled += read (fd, &buf[filled], sizeof buf - 1 - filled); if (!filled) break; buf[filled] = 0; p = buf; end = buf + (filled < 512 ? filled : filled - 128); while (p != end && *p != '\037') p++; /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */ if (p != end) { end = index (p, '\n'); sym = oblookup (Vobarray, p + 2, end - p - 2); if (SYMBOLP (sym)) { /* Attach a docstring to a variable? */ if (p[1] == 'V') { /* Install file-position as variable-documentation property and make it negative for a user-variable (doc starts with a `*'). */ Fput (sym, Qvariable_documentation, make_number ((pos + end + 1 - buf) * (end[1] == '*' ? -1 : 1))); } /* Attach a docstring to a function? */ else if (p[1] == 'F') store_function_docstring (sym, pos + end + 1 - buf); else error ("DOC file invalid at position %d", pos); } } pos += end - buf; filled -= end - buf; bcopy (end, buf, filled); } close (fd); return Qnil; } DEFUN ("substitute-command-keys", Fsubstitute_command_keys, Ssubstitute_command_keys, 1, 1, 0, "Substitute key descriptions for command names in STRING.\n\ Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\ replaced by either: a keystroke sequence that will invoke COMMAND,\n\ or \"M-x COMMAND\" if COMMAND is not on any keys.\n\ Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\ \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\ Substrings of the form \\=\\ specify to use the value of MAPVAR\n\ as the keymap for future \\=\\[COMMAND] substrings.\n\ \\=\\= quotes the following character and is discarded;\n\ thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.") (str) Lisp_Object str; { unsigned char *buf; int changed = 0; register unsigned char *strp; register unsigned char *bufp; int idx; int bsize; unsigned char *new; Lisp_Object tem; Lisp_Object keymap; unsigned char *start; int length; Lisp_Object name; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; if (NILP (str)) return Qnil; CHECK_STRING (str, 0); tem = Qnil; keymap = Qnil; name = Qnil; GCPRO4 (str, tem, keymap, name); /* KEYMAP is either nil (which means search all the active keymaps) or a specified local map (which means search just that and the global map). If non-nil, it might come from Voverriding_local_map, or from a \\ construct in STR itself.. */ keymap = current_kboard->Voverriding_terminal_local_map; if (NILP (keymap)) keymap = Voverriding_local_map; bsize = XSTRING (str)->size; bufp = buf = (unsigned char *) xmalloc (bsize); strp = (unsigned char *) XSTRING (str)->data; while (strp < (unsigned char *) XSTRING (str)->data + XSTRING (str)->size) { if (strp[0] == '\\' && strp[1] == '=') { /* \= quotes the next character; thus, to put in \[ without its special meaning, use \=\[. */ changed = 1; *bufp++ = strp[2]; strp += 3; } else if (strp[0] == '\\' && strp[1] == '[') { Lisp_Object firstkey; changed = 1; strp += 2; /* skip \[ */ start = strp; while ((strp - (unsigned char *) XSTRING (str)->data < XSTRING (str)->size) && *strp != ']') strp++; length = strp - start; strp++; /* skip ] */ /* Save STRP in IDX. */ idx = strp - (unsigned char *) XSTRING (str)->data; tem = Fintern (make_string (start, length), Qnil); tem = Fwhere_is_internal (tem, keymap, Qt, Qnil); /* Disregard menu bar bindings; it is positively annoying to mention them when there's no menu bar, and it isn't terribly useful even when there is a menu bar. */ if (!NILP (tem)) { firstkey = Faref (tem, make_number (0)); if (EQ (firstkey, Qmenu_bar)) tem = Qnil; } if (NILP (tem)) /* but not on any keys */ { new = (unsigned char *) xrealloc (buf, bsize += 4); bufp += new - buf; buf = new; bcopy ("M-x ", bufp, 4); bufp += 4; goto subst; } else { /* function is on a key */ tem = Fkey_description (tem); goto subst_string; } } /* \{foo} is replaced with a summary of the keymap (symbol-value foo). \ just sets the keymap used for \[cmd]. */ else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<')) { struct buffer *oldbuf; changed = 1; strp += 2; /* skip \{ or \< */ start = strp; while ((strp - (unsigned char *) XSTRING (str)->data < XSTRING (str)->size) && *strp != '}' && *strp != '>') strp++; length = strp - start; strp++; /* skip } or > */ /* Save STRP in IDX. */ idx = strp - (unsigned char *) XSTRING (str)->data; /* Get the value of the keymap in TEM, or nil if undefined. Do this while still in the user's current buffer in case it is a local variable. */ name = Fintern (make_string (start, length), Qnil); tem = Fboundp (name); if (! NILP (tem)) { tem = Fsymbol_value (name); if (! NILP (tem)) tem = get_keymap_1 (tem, 0, 1); } /* Now switch to a temp buffer. */ oldbuf = current_buffer; set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); if (NILP (tem)) { name = Fsymbol_name (name); insert_string ("\nUses keymap \""); insert_from_string (name, 0, XSTRING (name)->size, 1); insert_string ("\", which is not currently defined.\n"); if (start[-1] == '<') keymap = Qnil; } else if (start[-1] == '<') keymap = tem; else describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0); tem = Fbuffer_string (); Ferase_buffer (); set_buffer_internal (oldbuf); subst_string: start = XSTRING (tem)->data; length = XSTRING (tem)->size; subst: new = (unsigned char *) xrealloc (buf, bsize += length); bufp += new - buf; buf = new; bcopy (start, bufp, length); bufp += length; /* Check STR again in case gc relocated it. */ strp = (unsigned char *) XSTRING (str)->data + idx; } else /* just copy other chars */ *bufp++ = *strp++; } if (changed) /* don't bother if nothing substituted */ tem = make_string (buf, bufp - buf); else tem = str; xfree (buf); RETURN_UNGCPRO (tem); } syms_of_doc () { DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name, "Name of file containing documentation strings of built-in symbols."); Vdoc_file_name = Qnil; defsubr (&Sdocumentation); defsubr (&Sdocumentation_property); defsubr (&Ssnarf_documentation); defsubr (&Ssubstitute_command_keys); } emacs-19.30/src/doprnt.c100444 12120 1 15674 6052423325 13377 0ustar rmsdaemon/* Output like sprintf to a buffer of specified size. Also takes args differently: pass one pointer to an array of strings in addition to the format string which is separate. Copyright (C) 1985 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. */ #include #include #include #include "lisp.h" extern long *xmalloc (), *xrealloc (); static int doprnt1 (); /* Generate output from a format-spec FORMAT, terminated at position FORMAT_END. Output goes in BUFFER, which has room for BUFSIZE chars. If the output does not fit, truncate it to fit. Returns the number of characters stored into BUFFER. ARGS points to the vector of arguments, and NARGS says how many. A double counts as two arguments. String arguments are passed as C strings. Integers are passed as C integers. */ doprnt (buffer, bufsize, format, format_end, nargs, args) char *buffer; register int bufsize; char *format; char *format_end; int nargs; char **args; { return doprnt1 (0, buffer, bufsize, format, format_end, nargs, args); } /* Like doprnt except that strings in ARGS are passed as Lisp_Object. */ doprnt_lisp (buffer, bufsize, format, format_end, nargs, args) char *buffer; register int bufsize; char *format; char *format_end; int nargs; char **args; { return doprnt1 (1, buffer, bufsize, format, format_end, nargs, args); } static int doprnt1 (lispstrings, buffer, bufsize, format, format_end, nargs, args) int lispstrings; char *buffer; register int bufsize; char *format; char *format_end; int nargs; char **args; { int cnt = 0; /* Number of arg to gobble next */ register char *fmt = format; /* Pointer into format string */ register char *bufptr = buffer; /* Pointer into output buffer.. */ /* Use this for sprintf unless we need something really big. */ char tembuf[100]; /* Size of sprintf_buffer. */ int size_allocated = 100; /* Buffer to use for sprintf. Either tembuf or same as BIG_BUFFER. */ char *sprintf_buffer = tembuf; /* Buffer we have got with malloc. */ char *big_buffer = 0; register int tem; char *string; char fixed_buffer[20]; /* Default buffer for small formatting. */ char *fmtcpy; int minlen; int size; /* Field width factor; e.g., %90d */ char charbuf[2]; /* Used for %c. */ if (format_end == 0) format_end = format + strlen (format); if ((format_end - format + 1) < sizeof (fixed_buffer)) fmtcpy = fixed_buffer; else fmtcpy = (char *) alloca (format_end - format + 1); bufsize--; /* Loop until end of format string or buffer full. */ while (fmt != format_end && bufsize > 0) { if (*fmt == '%') /* Check for a '%' character */ { int size_bound; fmt++; /* Copy this one %-spec into fmtcpy. */ string = fmtcpy; *string++ = '%'; while (1) { *string++ = *fmt; if (! (*fmt >= '0' && *fmt <= '9') && *fmt != '-' && *fmt != ' '&& *fmt != '.') break; fmt++; } *string = 0; /* Get an idea of how much space we might need. */ size_bound = atoi (&fmtcpy[1]); /* Avoid pitfall of negative "size" parameter ("%-200d"). */ if (size_bound < 0) size_bound = -size_bound; size_bound += 50; if (size_bound > (unsigned) (1 << (BITS_PER_INT - 1))) error ("Format padding too large"); /* Make sure we have that much. */ if (size_bound > size_allocated) { if (big_buffer) big_buffer = (char *) xrealloc (big_buffer, size_bound); else big_buffer = (char *) xmalloc (size_bound); sprintf_buffer = big_buffer; size_allocated = size_bound; } minlen = 0; switch (*fmt++) { default: error ("Invalid format operation %%%c", fmt[-1]); /* case 'b': */ case 'd': case 'o': case 'x': if (cnt == nargs) error ("Not enough arguments for format string"); if (sizeof (int) == sizeof (EMACS_INT)) ; else if (sizeof (long) == sizeof (EMACS_INT)) /* Insert an `l' the right place. */ string[1] = string[0], string[0] = string[-1], string[-1] = 'l', string++; else abort (); sprintf (sprintf_buffer, fmtcpy, args[cnt++]); /* Now copy into final output, truncating as nec. */ string = sprintf_buffer; goto doit; case 'f': case 'e': case 'g': { union { double d; char *half[2]; } u; if (cnt + 1 == nargs) error ("not enough arguments for format string"); u.half[0] = args[cnt++]; u.half[1] = args[cnt++]; sprintf (sprintf_buffer, fmtcpy, u.d); /* Now copy into final output, truncating as nec. */ string = sprintf_buffer; goto doit; } case 'S': string[-1] = 's'; case 's': if (cnt == nargs) error ("not enough arguments for format string"); if (fmtcpy[1] != 's') minlen = atoi (&fmtcpy[1]); if (lispstrings) { string = (char *) XSTRING (((Lisp_Object *) args)[cnt])->data; tem = XSTRING (((Lisp_Object *) args)[cnt])->size; cnt++; } else { string = args[cnt++]; tem = strlen (string); } goto doit1; /* Copy string into final output, truncating if no room. */ doit: tem = strlen (string); doit1: if (minlen > 0) { while (minlen > tem && bufsize > 0) { *bufptr++ = ' '; bufsize--; minlen--; } minlen = 0; } if (tem > bufsize) tem = bufsize; bcopy (string, bufptr, tem); bufptr += tem; bufsize -= tem; if (minlen < 0) { while (minlen < - tem && bufsize > 0) { *bufptr++ = ' '; bufsize--; minlen++; } minlen = 0; } continue; case 'c': if (cnt == nargs) error ("not enough arguments for format string"); *charbuf = (EMACS_INT) args[cnt++]; string = charbuf; tem = 1; if (fmtcpy[1] != 'c') minlen = atoi (&fmtcpy[1]); goto doit1; case '%': fmt--; /* Drop thru and this % will be treated as normal */ } } *bufptr++ = *fmt++; /* Just some characters; Copy 'em */ bufsize--; }; /* If we had to malloc something, free it. */ if (big_buffer) xfree (big_buffer); *bufptr = 0; /* Make sure our string end with a '\0' */ return bufptr - buffer; } emacs-19.30/src/dosfns.c100444 12120 1 32274 6054273103 13357 0ustar rmsdaemon/* MS-DOS specific Lisp utilities. Coded by Manabu Higashida, 1991. Major changes May-July 1993 Morten Welinder (only 10% original code left) Copyright (C) 1991, 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. */ #include #ifdef MSDOS /* The entire file is within this conditional */ #include #include #include "lisp.h" #include "buffer.h" #include "termchar.h" #include "termhooks.h" #include "frame.h" #include "dosfns.h" #include "msdos.h" #include DEFUN ("mode25", Fmode25, Smode25, 0, 0, "", "\ Changes the number of rows to 25.") () { union REGS regs; #ifdef HAVE_X_WINDOWS if (!inhibit_window_system) return Qnil; #endif mouse_off (); regs.x.ax = 3; int86 (0x10, ®s, ®s); regs.x.ax = 0x1101; regs.h.bl = 0; int86 (0x10, ®s, ®s); regs.x.ax = 0x1200; regs.h.bl = 32; int86 (0x10, ®s, ®s); regs.x.ax = 3; int86 (0x10, ®s, ®s); Fset_frame_size (Fselected_frame (), ScreenCols (), ScreenRows ()); Frecenter (Qnil); Fredraw_display (); if (have_mouse) mouse_init (); return Qnil; } DEFUN ("mode4350", Fmode4350, Smode4350, 0, 0, "", "\ Changes the number of rows to 43 (EGA) or 50 (VGA).") () { union REGS regs; #ifdef HAVE_X_WINDOWS if (!inhibit_window_system) return Qnil; #endif mouse_off (); regs.x.ax = 3; int86 (0x10, ®s, ®s); regs.x.ax = 0x1112; regs.h.bl = 0; int86 (0x10, ®s, ®s); regs.x.ax = 0x1200; regs.h.bl = 32; int86 (0x10, ®s, ®s); regs.x.ax = 0x0100; regs.x.cx = 7; int86 (0x10, ®s, ®s); Fset_frame_size (Fselected_frame (), ScreenCols (), ScreenRows ()); Frecenter (Qnil); Fredraw_display (); if (have_mouse) mouse_init (); return Qnil; } DEFUN ("int86", Fint86, Sint86, 2, 2, 0, "Call specific MSDOS interrupt number INTERRUPT with REGISTERS.\n\ Return the updated REGISTER vector.\n\ \n\ INTERRUPT should be an integer in the range 0 to 255.\n\ REGISTERS should be a vector produced by `make-register' and\n\ `set-register-value'.") (intno, regs) Lisp_Object intno, regs; { register int i; int no; union REGS inregs, outregs; Lisp_Object val; CHECK_NUMBER (intno, 0); no = (unsigned long) XINT (intno); CHECK_VECTOR (regs, 1); if (no < 0 || no > 0xff || XVECTOR (regs)-> size != 8) return Qnil; for (i = 0; i < 8; i++) CHECK_NUMBER (XVECTOR (regs)->contents[i], 1); inregs.x.ax = (unsigned long) XFASTINT (XVECTOR (regs)->contents[0]); inregs.x.bx = (unsigned long) XFASTINT (XVECTOR (regs)->contents[1]); inregs.x.cx = (unsigned long) XFASTINT (XVECTOR (regs)->contents[2]); inregs.x.dx = (unsigned long) XFASTINT (XVECTOR (regs)->contents[3]); inregs.x.si = (unsigned long) XFASTINT (XVECTOR (regs)->contents[4]); inregs.x.di = (unsigned long) XFASTINT (XVECTOR (regs)->contents[5]); inregs.x.cflag = (unsigned long) XFASTINT (XVECTOR (regs)->contents[6]); inregs.x.flags = (unsigned long) XFASTINT (XVECTOR (regs)->contents[7]); int86 (no, &inregs, &outregs); XVECTOR (regs)->contents[0] = make_number (outregs.x.ax); XVECTOR (regs)->contents[1] = make_number (outregs.x.bx); XVECTOR (regs)->contents[2] = make_number (outregs.x.cx); XVECTOR (regs)->contents[3] = make_number (outregs.x.dx); XVECTOR (regs)->contents[4] = make_number (outregs.x.si); XVECTOR (regs)->contents[5] = make_number (outregs.x.di); XVECTOR (regs)->contents[6] = make_number (outregs.x.cflag); XVECTOR (regs)->contents[7] = make_number (outregs.x.flags); return regs; } DEFUN ("msdos-memget", Fdos_memget, Sdos_memget, 2, 2, 0, "Read DOS memory at offset ADDRESS into VECTOR.\n\ Return the updated VECTOR.") (addr, v) Lisp_Object addr, v; { register int i; int offs, len; char *buf; Lisp_Object val; CHECK_NUMBER (addr, 0); offs = (unsigned long) XINT (addr); CHECK_VECTOR (v, 1); len = XVECTOR (v)-> size; if (len < 1 || len > 2048 || addr < 0 || addr > 0xfffff - len) return Qnil; buf = alloca (len); dosmemget (offs, len, buf); for (i = 0; i < len; i++) XVECTOR (v)->contents[i] = make_number (buf[i]); return v; } DEFUN ("msdos-memput", Fdos_memput, Sdos_memput, 2, 2, 0, "Write DOS memory at offset ADDRESS from VECTOR.") (addr, v) Lisp_Object addr, v; { register int i; int offs, len; char *buf; Lisp_Object val; CHECK_NUMBER (addr, 0); offs = (unsigned long) XINT (addr); CHECK_VECTOR (v, 1); len = XVECTOR (v)-> size; if (len < 1 || len > 2048 || addr < 0 || addr > 0xfffff - len) return Qnil; buf = alloca (len); for (i = 0; i < len; i++) { CHECK_NUMBER (XVECTOR (v)->contents[i], 1); buf[i] = (unsigned char) XFASTINT (XVECTOR (v)->contents[i]) & 0xFF; } dosmemput (buf, len, offs); return Qt; } DEFUN ("msdos-set-keyboard", Fmsdos_set_keyboard, Smsdos_set_keyboard, 1, 2, 0, "Set keyboard layout according to COUNTRY.\n\ If the optional argument ALLKEYS is non-nil, the keyboard is mapped for\n\ all keys; otherwise it is only used when the ALT key is pressed.\n\ The current keyboard layout is available in dos-keyboard-code.") (country_code, allkeys) Lisp_Object country_code; { CHECK_NUMBER (country_code, 0); if (!dos_set_keyboard (XINT (country_code), !NILP (allkeys))) return Qnil; return Qt; } #ifndef HAVE_X_WINDOWS /* Later we might want to control the mouse interface with this function, e.g., with respect to non-80 column screen modes. */ DEFUN ("msdos-mouse-p", Fmsdos_mouse_p, Smsdos_mouse_p, 0, 0, 0, "\ Report whether a mouse is present.") () { if (have_mouse) return Qt; else return Qnil; } DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0, "Move the mouse pointer to the center of character cell (X,Y) in FRAME.\n\ WARNING: If you use this under X windows,\n\ you should call `unfocus-frame' afterwards.") (frame, x, y) Lisp_Object frame, x, y; { mouse_moveto (XINT (x), XINT (y)); return Qnil; } /* Function to translate colour names to integers. See lisp/term/pc-win.el for its definition. */ Lisp_Object Qmsdos_color_translate; #endif DEFUN ("msdos-mouse-init", Fmsdos_mouse_init, Smsdos_mouse_init, 0, 0, "", "Initialize and enable mouse if available.") () { if (have_mouse) { have_mouse = 1; mouse_init (); return Qt; } return Qnil; } DEFUN ("msdos-mouse-enable", Fmsdos_mouse_enable, Smsdos_mouse_enable, 0, 0, "", "Enable mouse if available.") () { if (have_mouse) { have_mouse = 1; mouse_on (); } return have_mouse ? Qt : Qnil; } DEFUN ("msdos-mouse-disable", Fmsdos_mouse_disable, Smsdos_mouse_disable, 0, 0, "", "Disable mouse if available.") () { mouse_off (); if (have_mouse) have_mouse = -1; return Qnil; } DEFUN ("insert-startup-screen", Finsert_startup_screen, Sinsert_startup_screen, 0, 0, "", "\ Insert copy of screen contents prior to starting emacs.\n\ Return nil if startup screen is not available.") () { char *s; int rows, cols; int i, j; if (!dos_get_saved_screen (&s, &rows, &cols)) return Qnil; for (i = 0; i < rows; i++) { for (j = 0; j < cols; j++) { insert_char (*s, 1); s += 2; } insert_char ('\n', 1); } return Qt; } /* country info */ int dos_country_code; int dos_codepage; int dos_timezone_offset; int dos_decimal_point; int dos_keyboard_layout; unsigned char dos_country_info[DOS_COUNTRY_INFO]; int dos_hyper_key; int dos_super_key; int dos_keypad_mode; Lisp_Object Vdos_version; Lisp_Object Vdos_display_scancodes; Lisp_Object Vdos_menubar_clock; Lisp_Object Vdos_timer_hooks; void init_dosfns () { union REGS regs; _go32_dpmi_seginfo info; _go32_dpmi_registers dpmiregs; #ifndef SYSTEM_MALLOC get_lim_data (); /* why the hell isn't this called elsewhere? */ #endif regs.x.ax = 0x3000; intdos (®s, ®s); Vdos_version = Fcons (make_number (regs.h.al), make_number (regs.h.ah)); /* Obtain the country code by calling Dos via Dpmi. Don't rely on GO32. */ info.size = (sizeof(dos_country_info) + 15) / 16; if (_go32_dpmi_allocate_dos_memory (&info)) dos_country_code = 1; else { dpmiregs.x.ax = 0x3800; dpmiregs.x.ds = info.rm_segment; dpmiregs.x.dx = 0; dpmiregs.x.ss = dpmiregs.x.sp = 0; _go32_dpmi_simulate_int (0x21, &dpmiregs); dos_country_code = dpmiregs.x.bx; dosmemget (info.rm_segment * 16, DOS_COUNTRY_INFO, dos_country_info); _go32_dpmi_free_dos_memory (&info); } dos_set_keyboard (dos_country_code, 0); regs.x.ax = 0x6601; intdos (®s, ®s); if (regs.x.cflag) /* Estimate code page from country code */ switch (dos_country_code) { case 45: /* Denmark */ case 47: /* Norway */ dos_codepage = 865; break; default: /* US */ dos_codepage = 437; } else dos_codepage = regs.x.bx & 0xffff; } /* * Define everything */ syms_of_dosfns () { defsubr (&Smode25); defsubr (&Smode4350); defsubr (&Sint86); defsubr (&Sdos_memget); defsubr (&Sdos_memput); defsubr (&Smsdos_mouse_init); defsubr (&Smsdos_mouse_enable); defsubr (&Smsdos_set_keyboard); defsubr (&Sinsert_startup_screen); defsubr (&Smsdos_mouse_disable); #ifndef HAVE_X_WINDOWS defsubr (&Smsdos_mouse_p); defsubr (&Sset_mouse_position); Qmsdos_color_translate = intern ("msdos-color-translate"); staticpro (&Qmsdos_color_translate); #endif DEFVAR_INT ("dos-country-code", &dos_country_code, "The country code returned by Dos when Emacs was started.\n\ Usually this is the international telephone prefix."); DEFVAR_INT ("dos-codepage", &dos_codepage, "The codepage active when Emacs was started.\n\ The following are known:\n\ 437 United States\n\ 850 Multilingual (Latin I)\n\ 852 Slavic (Latin II)\n\ 857 Turkish\n\ 860 Portugal\n\ 861 Iceland\n\ 863 Canada (French)\n\ 865 Norway/Denmark"); DEFVAR_INT ("dos-timezone-offset", &dos_timezone_offset, "The current timezone offset to UTC in minutes. Implicitly modified when the TZ variable is changed."); DEFVAR_LISP ("dos-version", &Vdos_version, "The (MAJOR . MINOR) Dos version (subject to modification with setver)."); DEFVAR_LISP ("dos-display-scancodes", &Vdos_display_scancodes, "*When non-nil, the keyboard scan-codes are displayed at the bottom right\n\ corner of the display (typically at the end of the mode line).\n\ The output format is: scan code:char code*modifiers."); Vdos_display_scancodes = Qnil; DEFVAR_LISP ("dos-menubar-clock", &Vdos_menubar_clock, "*When non-nil, the current time is displayed in the upper right\n\ corner of the screen (typically at the end of the menu bar)."); Vdos_menubar_clock = Qt; DEFVAR_LISP ("dos-timer-hooks", &Vdos_timer_hooks, "List of hooks which are run every second."); Vdos_timer_hooks = Qnil; DEFVAR_INT ("dos-hyper-key", &dos_hyper_key, "*If set to 1, use right ALT key as hyper key.\n\ If set to 2, use right CTRL key as hyper key."); dos_hyper_key = 0; DEFVAR_INT ("dos-super-key", &dos_super_key, "*If set to 1, use right ALT key as super key.\n\ If set to 2, use right CTRL key as super key."); dos_super_key = 0; DEFVAR_INT ("dos-keypad-mode", &dos_keypad_mode, "*Controls what key code is returned by a key in the numeric keypad.\n\ The `numlock ON' action is only taken if no modifier keys are pressed.\n\ The value is an integer constructed by adding the following bits together:\n\ \n\ 0x00 Digit key returns digit (if numlock ON)\n\ 0x01 Digit key returns kp-digit (if numlock ON)\n\ 0x02 Digit key returns M-digit (if numlock ON)\n\ 0x03 Digit key returns edit key (if numlock ON)\n\ \n\ 0x00 Grey key returns char (if numlock ON)\n\ 0x04 Grey key returns kp-key (if numlock ON)\n\ \n\ 0x00 Digit key returns digit (if numlock OFF)\n\ 0x10 Digit key returns kp-digit (if numlock OFF)\n\ 0x20 Digit key returns M-digit (if numlock OFF)\n\ 0x30 Digit key returns edit key (if numlock OFF)\n\ \n\ 0x00 Grey key returns char (if numlock OFF)\n\ 0x40 Grey key returns kp-key (if numlock OFF)\n\ \n\ 0x200 ALT-0..ALT-9 in top-row produces shifted codes."); dos_keypad_mode = 0x75; DEFVAR_INT ("dos-keyboard-layout", &dos_keyboard_layout, "Contains the country code for the current keyboard layout.\n\ Use msdos-set-keyboard to select another keyboard layout."); dos_keyboard_layout = 1; /* US */ DEFVAR_INT ("dos-decimal-point", &dos_decimal_point, "If non-zero, it contains the character to be returned when the\n\ decimal point key in the numeric keypad is pressed when Num Lock is on.\n\ If zero, the decimal point key returns the country code specific value."); dos_decimal_point = 0; } #endif /* MSDOS */ emacs-19.30/src/ecrt0.c100666 12120 1 35510 5770116050 13103 0ustar rmsdaemon/* C code startup routine. Copyright (C) 1985, 1986, 1992 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. */ /* The standard Vax 4.2 Unix crt0.c cannot be used for Emacs because it makes `envron' an initialized variable. It is easiest to have a special crt0.c on all machines though I don't know whether other machines actually need it. */ /* On the vax and 68000, in BSD4.2 and USG5.2, this is the data format on startup: (vax) ap and fp are unpredictable as far as I know; don't use them. sp -> word containing argc word pointing to first arg string [word pointing to next arg string]... 0 or more times 0 Optionally: [word pointing to environment variable]... 1 or more times ... 0 And always: first arg string [next arg string]... 0 or more times */ /* On the 16000, at least in the one 4.2 system I know about, the initial data format is sp -> word containing argc word containing argp word pointing to first arg string, and so on as above */ #ifdef emacs #include #endif /* ******** WARNING ******** Do not insert any data definitions before data_start! Since this is the first file linked, the address of the following variable should correspond to the start of initialized data space. On some systems this is a constant that is independent of the text size for shared executables. On others, it is a function of the text size. In short, this seems to be the most portable way to discover the start of initialized data space dynamically at runtime, for either shared or unshared executables, on either swapping or virtual systems. It only requires that the linker allocate objects in the order encountered, a reasonable model for most Unix systems. Similarly, note that the address of _start() should be the start of text space. Fred Fish, UniSoft Systems Inc. */ int data_start = 0; #ifdef NEED_ERRNO int errno; #endif #ifndef DONT_NEED_ENVIRON char **environ; #endif #ifndef static /* On systems where the static storage class is usable, this function should be declared as static. Otherwise, the static keyword has been defined to be something else, and code for those systems must take care of this declaration appropriately. */ static start1 (); #endif #ifdef APOLLO extern char *malloc(), *realloc(), *(*_libc_malloc) (), *(*_libc_realloc)(); extern void free(), (*_libc_free) (); extern int main(); std_$call void unix_$main(); _start() { _libc_malloc = malloc; _libc_realloc = realloc; _libc_free = free; unix_$main(main); /* no return */ } #endif /* APOLLO */ #if defined(orion) || defined(pyramid) || defined(celerity) || defined(ALLIANT) || defined(clipper) || defined(sps7) #if defined(sps7) && defined(V3x) asm(" section 10"); asm(" ds.b 0xb0"); #endif #ifdef ALLIANT /* _start must initialize _curbrk and _minbrk on the first startup; when starting up after dumping, it must initialize them to what they were before the dumping, since they are in the shared library and are not dumped. See ADJUST_EXEC_HEADER in m-alliant.h. */ extern unsigned char *_curbrk, *_minbrk; extern unsigned char end; unsigned char *_setbrk = &end; #ifdef ALLIANT_2800 unsigned char *_end = &end; #endif #endif #ifndef DUMMIES #define DUMMIES #endif _start (DUMMIES argc, argv, envp) int argc; char **argv, **envp; { #ifdef ALLIANT #ifdef ALLIANT_2800 _curbrk = _end; _minbrk = _end; #else _curbrk = _setbrk; _minbrk = _setbrk; #endif #endif environ = envp; exit (main (argc, argv, envp)); } #endif /* orion or pyramid or celerity or alliant or clipper */ #if defined (ns16000) && !defined (sequent) && !defined (UMAX) && !defined (CRT0_DUMMIES) _start () { /* On 16000, _start pushes fp onto stack */ start1 (); } /* ignore takes care of skipping the fp value pushed in start. */ static start1 (ignore, argc, argv) int ignore; int argc; register char **argv; { environ = argv + argc + 1; if (environ == *argv) environ--; exit (main (argc, argv, environ)); } #endif /* ns16000, not sequent and not UMAX, and not the CRT0_DUMMIES method */ #ifdef UMAX _start() { asm(" exit [] # undo enter"); asm(" .set exitsc,1"); asm(" .set sigcatchall,0x400"); asm(" .globl _exit"); asm(" .globl start"); asm(" .globl __start"); asm(" .globl _main"); asm(" .globl _environ"); asm(" .globl _sigvec"); asm(" .globl sigentry"); asm("start:"); asm(" br .xstart"); asm(" .org 0x20"); asm(" .double p_glbl,0,0xf00000,0"); asm(" .org 0x30"); asm(".xstart:"); asm(" adjspb $8"); asm(" movd 8(sp),0(sp) # argc"); asm(" addr 12(sp),r0"); asm(" movd r0,4(sp) # argv"); asm("L1:"); asm(" movd r0,r1"); asm(" addqd $4,r0"); asm(" cmpqd $0,0(r1) # null args term ?"); asm(" bne L1"); asm(" cmpd r0,0(4(sp)) # end of 'env' or 'argv' ?"); asm(" blt L2"); asm(" addqd $-4,r0 # envp's are in list"); asm("L2:"); asm(" movd r0,8(sp) # env"); asm(" movd r0,@_environ # indir is 0 if no env ; not 0 if env"); asm(" movqd $0,tos # setup intermediate signal handler"); asm(" addr @sv,tos"); asm(" movzwd $sigcatchall,tos"); asm(" jsr @_sigvec"); asm(" adjspb $-12"); asm(" jsr @_main"); asm(" adjspb $-12"); asm(" movd r0,tos"); asm(" jsr @_exit"); asm(" adjspb $-4"); asm(" addr @exitsc,r0"); asm(" svc"); asm(" .align 4 # sigvec arg"); asm("sv:"); asm(" .double sigentry"); asm(" .double 0"); asm(" .double 0"); asm(" .comm p_glbl,1"); } #endif /* UMAX */ #ifdef CRT0_DUMMIES /* Define symbol "start": here; some systems want that symbol. */ #ifdef DOT_GLOBAL_START asm(" .text "); asm(" .globl start "); asm(" start: "); #endif /* DOT_GLOBAL_START */ #ifdef NODOT_GLOBAL_START asm(" text "); asm(" global start "); asm(" start: "); #endif /* NODOT_GLOBAL_START */ #ifdef m68000 /* GCC 2.1, when optimization is turned off, seems to want to push a word of garbage on the stack, which screws up the CRT0_DUMMIES hack. So we hand-code _start in assembly language. */ asm(".text "); asm(" .even "); asm(".globl __start "); asm("__start: "); asm(" link a6,#0 "); asm(" jbsr _start1 "); asm(" unlk a6 "); asm(" rts "); #else /* not m68000 */ _start () { /* On vax, nothing is pushed here */ /* On sequent, bogus fp is pushed here */ start1 (); } #endif /* possibly m68000 */ static start1 (CRT0_DUMMIES argc, xargv) int argc; char *xargv; { register char **argv = &xargv; environ = argv + argc + 1; if ((char *)environ == xargv) environ--; exit (main (argc, argv, environ)); /* Refer to `start1' so GCC will not think it is never called and optimize it out. */ (void) &start1; } #else /* not CRT0_DUMMIES */ /* "m68k" and "m68000" both stand for m68000 processors, but with different program-entry conventions. This is a kludge. Now that the CRT0_DUMMIES mechanism above exists, most of these machines could use the vax code above with some suitable definition of CRT0_DUMMIES. Then the symbol m68k could be flushed. But I don't want to risk breaking these machines in a version 17 patch release, so that change is being put off. */ #ifdef m68k /* Can't do it all from C */ asm (" global _start"); asm (" text"); asm ("_start:"); #ifndef NU #ifdef STRIDE asm (" comm havefpu%,2"); #else /* m68k, not STRIDE */ asm (" comm splimit%,4"); #endif /* STRIDE */ asm (" global exit"); asm (" text"); #ifdef STRIDE asm (" trap &3"); asm (" mov.w %d0,havefpu%"); #else /* m68k, not STRIDE */ asm (" mov.l %d0,splimit%"); #endif /* STRIDE */ #endif /* not NU */ asm (" jsr start1"); asm (" mov.l %d0,(%sp)"); asm (" jsr exit"); asm (" mov.l &1,%d0"); /* d0 = 1 => exit */ asm (" trap &0"); #else /* m68000, not m68k */ #ifdef m68000 #ifdef ISI68K /* Added by ESM Sun May 24 12:44:02 1987 to get new ISI library to work */ /* Edited by Ray Mon May 15 15:59:56 EST 1989 so we can compile with gcc */ #if defined(BSD4_3) && !defined(__GNUC__) static foo () { #endif asm (" .globl is68020"); asm ("is68020:"); #ifndef BSD4_3 asm (" .long 0x00000000"); asm (" .long 0xffffffff"); /* End of stuff added by ESM */ #endif asm (" .text"); asm (" .globl __start"); asm ("__start:"); asm (" .word 0"); asm (" link a6,#0"); asm (" jbsr _start1"); asm (" unlk a6"); asm (" rts"); #if defined(BSD4_3) && !defined(__GNUC__) } #endif #else /* not ISI68K */ _start () { #ifdef sun #ifdef LISP_FLOAT_TYPE finitfp_(); #endif #endif /* On 68000, _start pushes a6 onto stack */ start1 (); } #endif /* not ISI68k */ #endif /* m68000 */ #endif /* m68k */ #if defined(m68k) || defined(m68000) /* ignore takes care of skipping the a6 value pushed in start. */ static #if defined(m68k) start1 (argc, xargv) #else start1 (ignore, argc, xargv) #endif int argc; char *xargv; { register char **argv = &xargv; environ = argv + argc + 1; if ((char *)environ == xargv) environ--; #ifdef sun_68881 asm(" jsr f68881_used"); #endif #ifdef sun_fpa asm(" jsr ffpa_used"); #endif #ifdef sun_soft asm(" jsr start_float"); #endif exit (main (argc, argv, environ)); } #endif /* m68k or m68000 */ #endif /* not CRT0_DUMMIES */ #ifdef hp9000s300 int argc_value; char **argv_value; #ifdef OLD_HP_ASSEMBLER asm(" text"); asm(" globl __start"); asm(" globl _exit"); asm(" globl _main"); asm("__start"); asm(" dc.l 0"); asm(" subq.w #0x1,d0"); asm(" move.w d0,float_soft"); asm(" move.l 0x4(a7),d0"); asm(" beq.s skip_1"); asm(" move.l d0,a0"); asm(" clr.l -0x4(a0)"); asm("skip_1"); asm(" move.l a7,a0"); asm(" subq.l #0x8,a7"); asm(" move.l (a0),(a7)"); asm(" move.l (a0),_argc_value"); asm(" addq.l #0x4,a0"); asm(" move.l a0,0x4(a7)"); asm(" move.l a0,_argv_value"); asm("incr_loop"); asm(" tst.l (a0)+"); asm(" bne.s incr_loop"); asm(" move.l 0x4(a7),a1"); asm(" cmp.l (a1),a0"); asm(" blt.s skip_2"); asm(" subq.l #0x4,a0"); asm("skip_2"); asm(" move.l a0,0x8(a7)"); asm(" move.l a0,_environ"); asm(" jsr _main"); asm(" addq.l #0x8,a7"); asm(" move.l d0,-(a7)"); asm(" jsr _exit"); asm(" move.w #0x1,d0"); asm(" trap #0x0"); asm(" comm float_soft,4"); /* float_soft is allocated in this way because C would put an underscore character in its name otherwise. */ #else /* new hp assembler */ asm(" text"); asm(" global float_loc"); asm(" set float_loc,0xFFFFB000"); asm(" global fpa_loc"); asm(" set fpa_loc,0xfff08000"); asm(" global __start"); asm(" global _exit"); asm(" global _main"); asm("__start:"); asm(" byte 0,0,0,0"); asm(" subq.w &1,%d0"); asm(" mov.w %d0,float_soft"); asm(" mov.w %d1,flag_68881"); #ifndef HPUX_68010 asm(" beq.b skip_float"); asm(" fmov.l &0x7400,%fpcr"); /* asm(" fmov.l &0x7480,%fpcr"); */ #endif /* HPUX_68010 */ asm("skip_float:"); asm(" mov.l %a0,%d0"); asm(" add.l %d0,%d0"); asm(" subx.w %d1,%d1"); asm(" mov.w %d1,flag_68010"); asm(" add.l %d0,%d0"); asm(" subx.w %d1,%d1"); asm(" mov.w %d1,flag_fpa"); asm(" tst.l %d2"); asm(" ble.b skip_3"); asm(" lsl flag_68881"); asm(" lsl flag_fpa"); asm("skip_3:"); asm(" mov.l 4(%a7),%d0"); asm(" beq.b skip_1"); asm(" mov.l %d0,%a0"); asm(" clr.l -4(%a0)"); asm("skip_1:"); asm(" mov.l %a7,%a0"); asm(" subq.l &8,%a7"); asm(" mov.l (%a0),(%a7)"); asm(" mov.l (%a0),_argc_value"); asm(" addq.l &4,%a0"); asm(" mov.l %a0,4(%a7)"); asm(" mov.l %a0,_argv_value"); asm("incr_loop:"); asm(" tst.l (%a0)+"); asm(" bne.b incr_loop"); asm(" mov.l 4(%a7),%a1"); asm(" cmp.l %a0,(%a1)"); asm(" blt.b skip_2"); asm(" subq.l &4,%a0"); asm("skip_2:"); asm(" mov.l %a0,8(%a7)"); asm(" mov.l %a0,_environ"); asm(" jsr _main"); asm(" addq.l &8,%a7"); asm(" mov.l %d0,-(%a7)"); asm(" jsr _exit"); asm(" mov.w &1,%d0"); asm(" trap &0"); asm(" comm float_soft, 4"); asm(" comm flag_68881, 4"); asm(" comm flag_68010, 4"); asm(" comm flag_68040, 4"); asm(" comm flag_fpa, 4"); #endif /* new hp assembler */ #endif /* hp9000s300 */ #ifdef GOULD /* startup code has to be in near text rather than fartext as allocated by the C compiler. */ asm(" .text"); asm(" .align 2"); asm(" .globl __start"); asm(" .text"); asm("__start:"); /* setup base register b1 (function base). */ asm(" .using b1,."); asm(" tpcbr b1"); /* setup base registers b3 through b7 (data references). */ asm(" file basevals,b3"); /* setup base register b2 (stack pointer); it should be aligned on a 8-word boundary; but because it is pointing to argc, its value should be remembered (in r5). */ asm(" movw b2,r4"); asm(" movw b2,r5"); asm(" andw #~0x1f,r4"); asm(" movw r4,b2"); /* allocate stack frame to do some work. */ asm(" subea 16w,b2"); /* initialize signal catching for UTX/32 1.2; this is necessary to make restart from saved image work. */ asm(" movea sigcatch,r1"); asm(" movw r1,8w[b2]"); asm(" svc #1,#150"); /* setup address of argc for start1. */ asm(" movw r5,8w[b2]"); asm(" func #1,_start1"); asm(" halt"); /* space for ld to store base register initial values. */ asm(" .align 5"); asm("basevals:"); asm(" .word __base3,__base4,__base5,__base6,__base7"); static start1 (xargc) int *xargc; { register int argc; register char **argv; argc = *xargc; argv = (char **)(xargc) + 1; environ = argv + argc + 1; if (environ == argv) environ--; exit (main (argc, argv, environ)); } #endif /* GOULD */ #ifdef elxsi #include extern char **environ; extern int errno; extern void _init_doscan(), _init_iob(); extern char end[]; char *_init_brk = end; _start() { environ = exec_cache.ac_envp; brk (_init_brk); errno = 0; _init_doscan (); _init_iob (); _exit (exit (main (exec_cache.ac_argc, exec_cache.ac_argv, exec_cache.ac_envp))); } #endif /* elxsi */ #ifdef sparc asm (".global __start"); asm (".text"); asm ("__start:"); asm (" mov 0, %fp"); asm (" ld [%sp + 64], %o0"); asm (" add %sp, 68, %o1"); asm (" sll %o0, 2, %o2"); asm (" add %o2, 4, %o2"); asm (" add %o1, %o2, %o2"); asm (" sethi %hi(_environ), %o3"); asm (" st %o2, [%o3+%lo(_environ)]"); asm (" andn %sp, 7, %sp"); asm (" call _main"); asm (" sub %sp, 24, %sp"); asm (" call __exit"); asm (" nop"); #endif /* sparc */ #if __FreeBSD__ == 2 char *__progname; #endif #ifdef __bsdi__ #include /* for version number */ #if defined(_BSDI_VERSION) && (_BSDI_VERSION >= 199501) char *__progname; #endif #endif /* __bsdi__ */ emacs-19.30/src/editfns.c100444 12120 1 212277 6054431120 13535 0ustar rmsdaemon/* Lisp functions pertaining to editing. Copyright (C) 1985,86,87,89,93,94,95 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. */ #include #include #ifdef VMS #include "vms-pwd.h" #else #include #endif #include "lisp.h" #include "intervals.h" #include "buffer.h" #include "window.h" #include "systime.h" #define min(a, b) ((a) < (b) ? (a) : (b)) #define max(a, b) ((a) > (b) ? (a) : (b)) extern char **environ; extern Lisp_Object make_time (); extern void insert_from_buffer (); static long difftm (); static void set_time_zone_rule (); /* Some static data, and a function to initialize it for each run */ Lisp_Object Vsystem_name; Lisp_Object Vuser_real_login_name; /* login name of current user ID */ Lisp_Object Vuser_full_name; /* full name of current user */ Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER */ void init_editfns () { char *user_name; register unsigned char *p, *q, *r; struct passwd *pw; /* password entry for the current user */ extern char *index (); Lisp_Object tem; /* Set up system_name even when dumping. */ init_system_name (); #ifndef CANNOT_DUMP /* Don't bother with this on initial start when just dumping out */ if (!initialized) return; #endif /* not CANNOT_DUMP */ pw = (struct passwd *) getpwuid (getuid ()); #ifdef MSDOS /* We let the real user name default to "root" because that's quite accurate on MSDOG and because it lets Emacs find the init file. (The DVX libraries override the Djgpp libraries here.) */ Vuser_real_login_name = build_string (pw ? pw->pw_name : "root"); #else Vuser_real_login_name = build_string (pw ? pw->pw_name : "unknown"); #endif /* Get the effective user name, by consulting environment variables, or the effective uid if those are unset. */ user_name = (char *) getenv ("LOGNAME"); if (!user_name) #ifdef WINDOWSNT user_name = (char *) getenv ("USERNAME"); /* it's USERNAME on NT */ #else /* WINDOWSNT */ user_name = (char *) getenv ("USER"); #endif /* WINDOWSNT */ if (!user_name) { pw = (struct passwd *) getpwuid (geteuid ()); user_name = (char *) (pw ? pw->pw_name : "unknown"); } Vuser_login_name = build_string (user_name); /* If the user name claimed in the environment vars differs from the real uid, use the claimed name to find the full name. */ tem = Fstring_equal (Vuser_login_name, Vuser_real_login_name); if (NILP (tem)) pw = (struct passwd *) getpwnam (XSTRING (Vuser_login_name)->data); p = (unsigned char *) (pw ? USER_FULL_NAME : "unknown"); q = (unsigned char *) index (p, ','); Vuser_full_name = make_string (p, q ? q - p : strlen (p)); #ifdef AMPERSAND_FULL_NAME p = XSTRING (Vuser_full_name)->data; q = (unsigned char *) index (p, '&'); /* Substitute the login name for the &, upcasing the first character. */ if (q) { r = (unsigned char *) alloca (strlen (p) + XSTRING (Vuser_login_name)->size + 1); bcopy (p, r, q - p); r[q - p] = 0; strcat (r, XSTRING (Vuser_login_name)->data); r[q - p] = UPCASE (r[q - p]); strcat (r, q + 1); Vuser_full_name = build_string (r); } #endif /* AMPERSAND_FULL_NAME */ p = (unsigned char *) getenv ("NAME"); if (p) Vuser_full_name = build_string (p); } DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0, "Convert arg CHAR to a one-character string containing that character.") (n) Lisp_Object n; { char c; CHECK_NUMBER (n, 0); c = XINT (n); return make_string (&c, 1); } DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0, "Convert arg STRING to a character, the first character of that string.") (str) register Lisp_Object str; { register Lisp_Object val; register struct Lisp_String *p; CHECK_STRING (str, 0); p = XSTRING (str); if (p->size) XSETFASTINT (val, ((unsigned char *) p->data)[0]); else XSETFASTINT (val, 0); return val; } static Lisp_Object buildmark (val) int val; { register Lisp_Object mark; mark = Fmake_marker (); Fset_marker (mark, make_number (val), Qnil); return mark; } DEFUN ("point", Fpoint, Spoint, 0, 0, 0, "Return value of point, as an integer.\n\ Beginning of buffer is position (point-min)") () { Lisp_Object temp; XSETFASTINT (temp, point); return temp; } DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0, "Return value of point, as a marker object.") () { return buildmark (point); } int clip_to_bounds (lower, num, upper) int lower, num, upper; { if (num < lower) return lower; else if (num > upper) return upper; else return num; } DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ", "Set point to POSITION, a number or marker.\n\ Beginning of buffer is position (point-min), end is (point-max).") (n) register Lisp_Object n; { CHECK_NUMBER_COERCE_MARKER (n, 0); SET_PT (clip_to_bounds (BEGV, XINT (n), ZV)); return n; } static Lisp_Object region_limit (beginningp) 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"); if ((point < XFASTINT (m)) == beginningp) return (make_number (point)); else return (m); } DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0, "Return position of beginning of region, as an integer.") () { return (region_limit (1)); } DEFUN ("region-end", Fregion_end, Sregion_end, 0, 0, 0, "Return position of end of region, as an integer.") () { return (region_limit (0)); } DEFUN ("mark-marker", Fmark_marker, Smark_marker, 0, 0, 0, "Return this buffer's mark, as a marker object.\n\ Watch out! Moving this marker changes the mark position.\n\ If you set the marker not to point anywhere, the buffer will have no mark.") () { return current_buffer->mark; } Lisp_Object save_excursion_save () { register int visible = (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer); return Fcons (Fpoint_marker (), Fcons (Fcopy_marker (current_buffer->mark, Qnil), Fcons (visible ? Qt : Qnil, current_buffer->mark_active))); } Lisp_Object save_excursion_restore (info) register Lisp_Object info; { register Lisp_Object tem, tem1, omark, nmark; tem = Fmarker_buffer (Fcar (info)); /* If buffer being returned to is now deleted, avoid error */ /* Otherwise could get error here while unwinding to top level and crash */ /* In that case, Fmarker_buffer returns nil now. */ if (NILP (tem)) return Qnil; Fset_buffer (tem); tem = Fcar (info); Fgoto_char (tem); unchain_marker (tem); tem = Fcar (Fcdr (info)); omark = Fmarker_position (current_buffer->mark); Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ()); nmark = Fmarker_position (tem); unchain_marker (tem); tem = Fcdr (Fcdr (info)); #if 0 /* We used to make the current buffer visible in the selected window if that was true previously. That avoids some anomalies. But it creates others, and it wasn't documented, and it is simpler and cleaner never to alter the window/buffer connections. */ tem1 = Fcar (tem); if (!NILP (tem1) && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) Fswitch_to_buffer (Fcurrent_buffer (), Qnil); #endif /* 0 */ tem1 = current_buffer->mark_active; current_buffer->mark_active = Fcdr (tem); if (!NILP (Vrun_hooks)) { /* If mark is active now, and either was not active or was at a different place, run the activate hook. */ if (! NILP (current_buffer->mark_active)) { if (! EQ (omark, nmark)) call1 (Vrun_hooks, intern ("activate-mark-hook")); } /* If mark has ceased to be active, run deactivate hook. */ else if (! NILP (tem1)) call1 (Vrun_hooks, intern ("deactivate-mark-hook")); } return Qnil; } DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0, "Save point, mark, and current buffer; execute BODY; restore those things.\n\ Executes BODY just like `progn'.\n\ The values of point, mark and the current buffer are restored\n\ even in case of abnormal exit (throw or error).\n\ The state of activation of the mark is also restored.") (args) Lisp_Object args; { register Lisp_Object val; int count = specpdl_ptr - specpdl; record_unwind_protect (save_excursion_restore, save_excursion_save ()); val = Fprogn (args); return unbind_to (count, val); } DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 0, 0, "Return the number of characters in the current buffer.") () { Lisp_Object temp; XSETFASTINT (temp, Z - BEG); return temp; } DEFUN ("point-min", Fpoint_min, Spoint_min, 0, 0, 0, "Return the minimum permissible value of point in the current buffer.\n\ This is 1, unless narrowing (a buffer restriction) is in effect.") () { Lisp_Object temp; XSETFASTINT (temp, BEGV); return temp; } DEFUN ("point-min-marker", Fpoint_min_marker, Spoint_min_marker, 0, 0, 0, "Return a marker to the minimum permissible value of point in this buffer.\n\ This is the beginning, unless narrowing (a buffer restriction) is in effect.") () { return buildmark (BEGV); } DEFUN ("point-max", Fpoint_max, Spoint_max, 0, 0, 0, "Return the maximum permissible value of point in the current buffer.\n\ This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\ is in effect, in which case it is less.") () { Lisp_Object temp; XSETFASTINT (temp, ZV); return temp; } DEFUN ("point-max-marker", Fpoint_max_marker, Spoint_max_marker, 0, 0, 0, "Return a marker to the maximum permissible value of point in this buffer.\n\ This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\ is in effect, in which case it is less.") () { return buildmark (ZV); } DEFUN ("following-char", Ffollowing_char, Sfollowing_char, 0, 0, 0, "Return the character following point, as a number.\n\ At the end of the buffer or accessible region, return 0.") () { Lisp_Object temp; if (point >= ZV) XSETFASTINT (temp, 0); else XSETFASTINT (temp, FETCH_CHAR (point)); return temp; } DEFUN ("preceding-char", Fprevious_char, Sprevious_char, 0, 0, 0, "Return the character preceding point, as a number.\n\ At the beginning of the buffer or accessible region, return 0.") () { Lisp_Object temp; if (point <= BEGV) XSETFASTINT (temp, 0); else XSETFASTINT (temp, FETCH_CHAR (point - 1)); return temp; } DEFUN ("bobp", Fbobp, Sbobp, 0, 0, 0, "Return T if point is at the beginning of the buffer.\n\ If the buffer is narrowed, this means the beginning of the narrowed part.") () { if (point == BEGV) return Qt; return Qnil; } DEFUN ("eobp", Feobp, Seobp, 0, 0, 0, "Return T if point is at the end of the buffer.\n\ If the buffer is narrowed, this means the end of the narrowed part.") () { if (point == ZV) return Qt; return Qnil; } DEFUN ("bolp", Fbolp, Sbolp, 0, 0, 0, "Return T if point is at the beginning of a line.") () { if (point == BEGV || FETCH_CHAR (point - 1) == '\n') return Qt; return Qnil; } DEFUN ("eolp", Feolp, Seolp, 0, 0, 0, "Return T if point is at the end of a line.\n\ `End of a line' includes point being at the end of the buffer.") () { if (point == ZV || FETCH_CHAR (point) == '\n') return Qt; return Qnil; } DEFUN ("char-after", Fchar_after, Schar_after, 1, 1, 0, "Return character in current buffer at position POS.\n\ POS is an integer or a buffer pointer.\n\ If POS is out of range, the value is nil.") (pos) Lisp_Object pos; { register Lisp_Object val; register int n; CHECK_NUMBER_COERCE_MARKER (pos, 0); n = XINT (pos); if (n < BEGV || n >= ZV) return Qnil; XSETFASTINT (val, FETCH_CHAR (n)); return val; } DEFUN ("user-login-name", Fuser_login_name, Suser_login_name, 0, 1, 0, "Return the name under which the user logged in, as a string.\n\ This is based on the effective uid, not the real uid.\n\ Also, if the environment variable LOGNAME or USER is set,\n\ that determines the value of this function.\n\n\ If optional argument UID is an integer, return the login name of the user\n\ with that uid, or nil if there is no such user.") (uid) Lisp_Object uid; { struct passwd *pw; /* Set up the user name info if we didn't do it before. (That can happen if Emacs is dumpable but you decide to run `temacs -l loadup' and not dump. */ if (INTEGERP (Vuser_login_name)) init_editfns (); if (NILP (uid)) return Vuser_login_name; CHECK_NUMBER (uid, 0); pw = (struct passwd *) getpwuid (XINT (uid)); return (pw ? build_string (pw->pw_name) : Qnil); } DEFUN ("user-real-login-name", Fuser_real_login_name, Suser_real_login_name, 0, 0, 0, "Return the name of the user's real uid, as a string.\n\ This ignores the environment variables LOGNAME and USER, so it differs from\n\ `user-login-name' when running under `su'.") () { /* Set up the user name info if we didn't do it before. (That can happen if Emacs is dumpable but you decide to run `temacs -l loadup' and not dump. */ if (INTEGERP (Vuser_login_name)) init_editfns (); return Vuser_real_login_name; } DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0, "Return the effective uid of Emacs, as an integer.") () { return make_number (geteuid ()); } DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0, "Return the real uid of Emacs, as an integer.") () { return make_number (getuid ()); } DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 0, 0, "Return the full name of the user logged in, as a string.") () { return Vuser_full_name; } DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0, "Return the name of the machine you are running on, as a string.") () { return Vsystem_name; } /* For the benefit of callers who don't want to include lisp.h */ char * get_system_name () { return (char *) XSTRING (Vsystem_name)->data; } DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0, "Return the process ID of Emacs, as an integer.") () { return make_number (getpid ()); } DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, "Return the current time, as the number of seconds since 1970-01-01 00:00:00.\n\ The time is returned as a list of three integers. The first has the\n\ most significant 16 bits of the seconds, while the second has the\n\ least significant 16 bits. The third integer gives the microsecond\n\ count.\n\ \n\ The microsecond count is zero on systems that do not provide\n\ resolution finer than a second.") () { EMACS_TIME t; Lisp_Object result[3]; EMACS_GET_TIME (t); XSETINT (result[0], (EMACS_SECS (t) >> 16) & 0xffff); XSETINT (result[1], (EMACS_SECS (t) >> 0) & 0xffff); XSETINT (result[2], EMACS_USECS (t)); return Flist (3, result); } static int lisp_time_argument (specified_time, result) Lisp_Object specified_time; time_t *result; { if (NILP (specified_time)) return time (result) != -1; else { Lisp_Object high, low; high = Fcar (specified_time); CHECK_NUMBER (high, 0); low = Fcdr (specified_time); if (CONSP (low)) low = Fcar (low); CHECK_NUMBER (low, 0); *result = (XINT (high) << 16) + (XINT (low) & 0xffff); return *result >> 16 == XINT (high); } } DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 2, 2, 0, "Use FORMAT-STRING to format the time TIME.\n\ TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from\n\ `current-time' and `file-attributes'.\n\ FORMAT-STRING may contain %-sequences to substitute parts of the time.\n\ %a is replaced by the abbreviated name of the day of week.\n\ %A is replaced by the full name of the day of week.\n\ %b is replaced by the abbreviated name of the month.\n\ %B is replaced by the full name of the month.\n\ %c is a synonym for \"%x %X\".\n\ %C is a locale-specific synonym, which defaults to \"%A, %B %e, %Y\" in the C locale.\n\ %d is replaced by the day of month, zero-padded.\n\ %D is a synonym for \"%m/%d/%y\".\n\ %e is replaced by the day of month, blank-padded.\n\ %h is a synonym for \"%b\".\n\ %H is replaced by the hour (00-23).\n\ %I is replaced by the hour (00-12).\n\ %j is replaced by the day of the year (001-366).\n\ %k is replaced by the hour (0-23), blank padded.\n\ %l is replaced by the hour (1-12), blank padded.\n\ %m is replaced by the month (01-12).\n\ %M is replaced by the minut (00-59).\n\ %n is a synonym for \"\\n\".\n\ %p is replaced by AM or PM, as appropriate.\n\ %r is a synonym for \"%I:%M:%S %p\".\n\ %R is a synonym for \"%H:%M\".\n\ %S is replaced by the seconds (00-60).\n\ %t is a synonym for \"\\t\".\n\ %T is a synonym for \"%H:%M:%S\".\n\ %U is replaced by the week of the year (01-52), first day of week is Sunday.\n\ %w is replaced by the day of week (0-6), Sunday is day 0.\n\ %W is replaced by the week of the year (01-52), first day of week is Monday.\n\ %x is a locale-specific synonym, which defaults to \"%D\" in the C locale.\n\ %X is a locale-specific synonym, which defaults to \"%T\" in the C locale.\n\ %y is replaced by the year without century (00-99).\n\ %Y is replaced by the year with century.\n\ %Z is replaced by the time zone abbreviation.\n\ \n\ The number of options reflects the `strftime' function.") (format_string, time) Lisp_Object format_string, time; { time_t value; int size; CHECK_STRING (format_string, 1); if (! lisp_time_argument (time, &value)) error ("Invalid time specification"); /* This is probably enough. */ size = XSTRING (format_string)->size * 6 + 50; while (1) { char *buf = (char *) alloca (size); if (emacs_strftime (buf, size, XSTRING (format_string)->data, localtime (&value))) return build_string (buf); /* If buffer was too small, make it bigger. */ size *= 2; } } DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 1, 0, "Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).\n\ The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)\n\ or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'\n\ to use the current time. The list has the following nine members:\n\ SEC is an integer between 0 and 60; SEC is 60 for a leap second, which\n\ only some operating systems support. MINUTE is an integer between 0 and 59.\n\ HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.\n\ MONTH is an integer between 1 and 12. YEAR is an integer indicating the\n\ four-digit year. DOW is the day of week, an integer between 0 and 6, where\n\ 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.\n\ ZONE is an integer indicating the number of seconds east of Greenwich.\n\ \(Note that Common Lisp has different meanings for DOW and ZONE.)") (specified_time) Lisp_Object specified_time; { time_t time_spec; struct tm save_tm; struct tm *decoded_time; Lisp_Object list_args[9]; if (! lisp_time_argument (specified_time, &time_spec)) error ("Invalid time specification"); decoded_time = localtime (&time_spec); XSETFASTINT (list_args[0], decoded_time->tm_sec); XSETFASTINT (list_args[1], decoded_time->tm_min); XSETFASTINT (list_args[2], decoded_time->tm_hour); XSETFASTINT (list_args[3], decoded_time->tm_mday); XSETFASTINT (list_args[4], decoded_time->tm_mon + 1); XSETFASTINT (list_args[5], decoded_time->tm_year + 1900); XSETFASTINT (list_args[6], decoded_time->tm_wday); list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil; /* Make a copy, in case gmtime modifies the struct. */ save_tm = *decoded_time; decoded_time = gmtime (&time_spec); if (decoded_time == 0) list_args[8] = Qnil; else XSETINT (list_args[8], difftm (&save_tm, decoded_time)); return Flist (9, list_args); } DEFUN ("encode-time", Fencode_time, Sencode_time, 6, 7, 0, "Convert SEC, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.\n\ This is the reverse operation of `decode-time', which see. ZONE defaults\n\ to the current time zone rule if not specified; if specified, it can\n\ be a string (as from `set-time-zone-rule'), or it can be a list\n\ (as from `current-time-zone') or an integer (as from `decode-time')\n\ applied without consideration for daylight savings time.\n\ Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;\n\ for example, a DAY of 0 means the day preceding the given month.\n\ Year numbers less than 100 are treated just like other year numbers.\n\ If you want them to stand for years in this century, you must do that yourself.") (sec, minute, hour, day, month, year, zone) Lisp_Object sec, minute, hour, day, month, year, zone; { time_t time; struct tm tm; CHECK_NUMBER (sec, 0); CHECK_NUMBER (minute, 1); CHECK_NUMBER (hour, 2); CHECK_NUMBER (day, 3); CHECK_NUMBER (month, 4); CHECK_NUMBER (year, 5); tm.tm_sec = XINT (sec); tm.tm_min = XINT (minute); tm.tm_hour = XINT (hour); tm.tm_mday = XINT (day); tm.tm_mon = XINT (month) - 1; tm.tm_year = XINT (year) - 1900; tm.tm_isdst = -1; if (CONSP (zone)) zone = Fcar (zone); if (NILP (zone)) time = mktime (&tm); else { char tzbuf[100]; char *tzstring; char **oldenv = environ, **newenv; if (STRINGP (zone)) tzstring = (char *) XSTRING (zone)->data; else if (INTEGERP (zone)) { int abszone = abs (XINT (zone)); sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0), abszone / (60*60), (abszone/60) % 60, abszone % 60); tzstring = tzbuf; } else error ("Invalid time zone specification"); /* Set TZ before calling mktime; merely adjusting mktime's returned value doesn't suffice, since that would mishandle leap seconds. */ set_time_zone_rule (tzstring); time = mktime (&tm); /* Restore TZ to previous value. */ newenv = environ; environ = oldenv; free (newenv); #ifdef LOCALTIME_CACHE tzset (); #endif } if (time == (time_t) -1) error ("Specified time is not representable"); return make_time (time); } DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 1, 0, "Return the current time, as a human-readable string.\n\ Programs can use this function to decode a time,\n\ since the number of columns in each field is fixed.\n\ The format is `Sun Sep 16 01:03:52 1973'.\n\ If an argument is given, it specifies a time to format\n\ instead of the current time. The argument should have the form:\n\ (HIGH . LOW)\n\ or the form:\n\ (HIGH LOW . IGNORED).\n\ Thus, you can use times obtained from `current-time'\n\ and from `file-attributes'.") (specified_time) Lisp_Object specified_time; { time_t value; char buf[30]; register char *tem; if (! lisp_time_argument (specified_time, &value)) value = -1; tem = (char *) ctime (&value); strncpy (buf, tem, 24); buf[24] = 0; return build_string (buf); } #define TM_YEAR_ORIGIN 1900 /* Yield A - B, measured in seconds. */ static long difftm (a, b) struct tm *a, *b; { int ay = a->tm_year + (TM_YEAR_ORIGIN - 1); int by = b->tm_year + (TM_YEAR_ORIGIN - 1); /* Some compilers can't handle this as a single return statement. */ long days = ( /* difference in day of year */ a->tm_yday - b->tm_yday /* + intervening leap days */ + ((ay >> 2) - (by >> 2)) - (ay/100 - by/100) + ((ay/100 >> 2) - (by/100 >> 2)) /* + difference in years * 365 */ + (long)(ay-by) * 365 ); return (60*(60*(24*days + (a->tm_hour - b->tm_hour)) + (a->tm_min - b->tm_min)) + (a->tm_sec - b->tm_sec)); } DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 1, 0, "Return the offset and name for the local time zone.\n\ This returns a list of the form (OFFSET NAME).\n\ OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).\n\ A negative value means west of Greenwich.\n\ NAME is a string giving the name of the time zone.\n\ If an argument is given, it specifies when the time zone offset is determined\n\ instead of using the current time. The argument should have the form:\n\ (HIGH . LOW)\n\ or the form:\n\ (HIGH LOW . IGNORED).\n\ Thus, you can use times obtained from `current-time'\n\ and from `file-attributes'.\n\ \n\ Some operating systems cannot provide all this information to Emacs;\n\ in this case, `current-time-zone' returns a list containing nil for\n\ the data it can't find.") (specified_time) Lisp_Object specified_time; { time_t value; struct tm *t; if (lisp_time_argument (specified_time, &value) && (t = gmtime (&value)) != 0) { struct tm gmt; long offset; char *s, buf[6]; gmt = *t; /* Make a copy, in case localtime modifies *t. */ t = localtime (&value); offset = difftm (t, &gmt); s = 0; #ifdef HAVE_TM_ZONE if (t->tm_zone) s = (char *)t->tm_zone; #else /* not HAVE_TM_ZONE */ #ifdef HAVE_TZNAME if (t->tm_isdst == 0 || t->tm_isdst == 1) s = tzname[t->tm_isdst]; #endif #endif /* not HAVE_TM_ZONE */ if (!s) { /* No local time zone name is available; use "+-NNNN" instead. */ int am = (offset < 0 ? -offset : offset) / 60; sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60); s = buf; } return Fcons (make_number (offset), Fcons (build_string (s), Qnil)); } else return Fmake_list (2, Qnil); } DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0, "Set the local time zone using TZ, a string specifying a time zone rule.\n\ If TZ is nil, use implementation-defined default time zone information.") (tz) Lisp_Object tz; { static char **environbuf; char *tzstring; if (NILP (tz)) tzstring = 0; else { CHECK_STRING (tz, 0); tzstring = (char *) XSTRING (tz)->data; } set_time_zone_rule (tzstring); if (environbuf) free (environbuf); environbuf = environ; return Qnil; } /* Set the local time zone rule to TZSTRING. This allocates memory into `environ', which it is the caller's responsibility to free. */ static void set_time_zone_rule (tzstring) char *tzstring; { int envptrs; char **from, **to, **newenv; for (from = environ; *from; from++) continue; envptrs = from - environ + 2; newenv = to = (char **) xmalloc (envptrs * sizeof (char *) + (tzstring ? strlen (tzstring) + 4 : 0)); if (tzstring) { char *t = (char *) (to + envptrs); strcpy (t, "TZ="); strcat (t, tzstring); *to++ = t; } for (from = environ; *from; from++) if (strncmp (*from, "TZ=", 3) != 0) *to++ = *from; *to = 0; environ = newenv; #ifdef LOCALTIME_CACHE tzset (); #endif } void insert1 (arg) Lisp_Object arg; { Finsert (1, &arg); } /* Callers passing one argument to Finsert need not gcpro the argument "array", since the only element of the array will not be used after calling insert or insert_from_string, so we don't care if it gets trashed. */ DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0, "Insert the arguments, either strings or characters, at point.\n\ Point moves forward so that it ends up after the inserted text.\n\ Any other markers at the point of insertion remain before the text.") (nargs, args) int nargs; register Lisp_Object *args; { register int argnum; register Lisp_Object tem; char str[1]; for (argnum = 0; argnum < nargs; argnum++) { tem = args[argnum]; retry: if (INTEGERP (tem)) { str[0] = XINT (tem); insert (str, 1); } else if (STRINGP (tem)) { insert_from_string (tem, 0, XSTRING (tem)->size, 0); } else { tem = wrong_type_argument (Qchar_or_string_p, tem); goto retry; } } return Qnil; } DEFUN ("insert-and-inherit", Finsert_and_inherit, Sinsert_and_inherit, 0, MANY, 0, "Insert the arguments at point, inheriting properties from adjoining text.\n\ Point moves forward so that it ends up after the inserted text.\n\ Any other markers at the point of insertion remain before the text.") (nargs, args) int nargs; register Lisp_Object *args; { register int argnum; register Lisp_Object tem; char str[1]; for (argnum = 0; argnum < nargs; argnum++) { tem = args[argnum]; retry: if (INTEGERP (tem)) { str[0] = XINT (tem); insert_and_inherit (str, 1); } else if (STRINGP (tem)) { insert_from_string (tem, 0, XSTRING (tem)->size, 1); } else { tem = wrong_type_argument (Qchar_or_string_p, tem); goto retry; } } return Qnil; } DEFUN ("insert-before-markers", Finsert_before_markers, Sinsert_before_markers, 0, MANY, 0, "Insert strings or characters at point, relocating markers after the text.\n\ Point moves forward so that it ends up after the inserted text.\n\ Any other markers at the point of insertion also end up after the text.") (nargs, args) int nargs; register Lisp_Object *args; { register int argnum; register Lisp_Object tem; char str[1]; for (argnum = 0; argnum < nargs; argnum++) { tem = args[argnum]; retry: if (INTEGERP (tem)) { str[0] = XINT (tem); insert_before_markers (str, 1); } else if (STRINGP (tem)) { insert_from_string_before_markers (tem, 0, XSTRING (tem)->size, 0); } else { tem = wrong_type_argument (Qchar_or_string_p, tem); goto retry; } } return Qnil; } DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers, Sinsert_and_inherit_before_markers, 0, MANY, 0, "Insert text at point, relocating markers and inheriting properties.\n\ Point moves forward so that it ends up after the inserted text.\n\ Any other markers at the point of insertion also end up after the text.") (nargs, args) int nargs; register Lisp_Object *args; { register int argnum; register Lisp_Object tem; char str[1]; for (argnum = 0; argnum < nargs; argnum++) { tem = args[argnum]; retry: if (INTEGERP (tem)) { str[0] = XINT (tem); insert_before_markers_and_inherit (str, 1); } else if (STRINGP (tem)) { insert_from_string_before_markers (tem, 0, XSTRING (tem)->size, 1); } else { tem = wrong_type_argument (Qchar_or_string_p, tem); goto retry; } } return Qnil; } DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 3, 0, "Insert COUNT (second arg) copies of CHAR (first arg).\n\ Point and all markers are affected as in the function `insert'.\n\ Both arguments are required.\n\ The optional third arg INHERIT, if non-nil, says to inherit text properties\n\ from adjoining text, if those properties are sticky.") (chr, count, inherit) Lisp_Object chr, count, inherit; { register unsigned char *string; register int strlen; register int i, n; CHECK_NUMBER (chr, 0); CHECK_NUMBER (count, 1); n = XINT (count); if (n <= 0) return Qnil; strlen = min (n, 256); string = (unsigned char *) alloca (strlen); for (i = 0; i < strlen; i++) string[i] = XFASTINT (chr); while (n >= strlen) { if (!NILP (inherit)) insert_and_inherit (string, strlen); else insert (string, strlen); n -= strlen; } if (n > 0) { if (!NILP (inherit)) insert_and_inherit (string, n); else insert (string, n); } return Qnil; } /* Making strings from buffer contents. */ /* Return a Lisp_String containing the text of the current buffer from START to END. If text properties are in use and the current buffer has properties in the range specified, the resulting string will also have them. We don't want to use plain old make_string here, because it calls make_uninit_string, which can cause the buffer arena to be compacted. make_string has no way of knowing that the data has been moved, and thus copies the wrong data into the string. This doesn't effect most of the other users of make_string, so it should be left as is. But we should use this function when conjuring buffer substrings. */ Lisp_Object make_buffer_string (start, end) int start, end; { Lisp_Object result, tem, tem1; if (start < GPT && GPT < end) move_gap (start); result = make_uninit_string (end - start); bcopy (&FETCH_CHAR (start), XSTRING (result)->data, end - start); tem = Fnext_property_change (make_number (start), Qnil, make_number (end)); tem1 = Ftext_properties_at (make_number (start), Qnil); #ifdef USE_TEXT_PROPERTIES if (XINT (tem) != end || !NILP (tem1)) copy_intervals_to_string (result, current_buffer, start, end - start); #endif return result; } DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0, "Return the contents of part of the current buffer as a string.\n\ The two arguments START and END are character positions;\n\ they can be in either order.") (b, e) Lisp_Object b, e; { register int beg, end; validate_region (&b, &e); beg = XINT (b); end = XINT (e); return make_buffer_string (beg, end); } DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0, "Return the contents of the current buffer as a string.\n\ If narrowing is in effect, this function returns only the visible part\n\ of the buffer.") () { return make_buffer_string (BEGV, ZV); } DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring, 1, 3, 0, "Insert before point a substring of the contents of buffer BUFFER.\n\ BUFFER may be a buffer or a buffer name.\n\ Arguments START and END are character numbers specifying the substring.\n\ They default to the beginning and the end of BUFFER.") (buf, b, e) Lisp_Object buf, b, e; { register int beg, end, temp; register struct buffer *bp; Lisp_Object buffer; buffer = Fget_buffer (buf); if (NILP (buffer)) nsberror (buf); bp = XBUFFER (buffer); if (NILP (b)) beg = BUF_BEGV (bp); else { CHECK_NUMBER_COERCE_MARKER (b, 0); beg = XINT (b); } if (NILP (e)) end = BUF_ZV (bp); else { CHECK_NUMBER_COERCE_MARKER (e, 1); end = XINT (e); } if (beg > end) temp = beg, beg = end, end = temp; if (!(BUF_BEGV (bp) <= beg && end <= BUF_ZV (bp))) args_out_of_range (b, e); insert_from_buffer (bp, beg, end - beg, 0); return Qnil; } DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, Scompare_buffer_substrings, 6, 6, 0, "Compare two substrings of two buffers; return result as number.\n\ the value is -N if first string is less after N-1 chars,\n\ +N if first string is greater after N-1 chars, or 0 if strings match.\n\ Each substring is represented as three arguments: BUFFER, START and END.\n\ That makes six args in all, three for each substring.\n\n\ The value of `case-fold-search' in the current buffer\n\ determines whether case is significant or ignored.") (buffer1, start1, end1, buffer2, start2, end2) Lisp_Object buffer1, start1, end1, buffer2, start2, end2; { register int begp1, endp1, begp2, endp2, temp, len1, len2, length, i; register struct buffer *bp1, *bp2; register unsigned char *trt = (!NILP (current_buffer->case_fold_search) ? XSTRING (current_buffer->case_canon_table)->data : 0); /* Find the first buffer and its substring. */ if (NILP (buffer1)) bp1 = current_buffer; else { Lisp_Object buf1; buf1 = Fget_buffer (buffer1); if (NILP (buf1)) nsberror (buffer1); bp1 = XBUFFER (buf1); } if (NILP (start1)) begp1 = BUF_BEGV (bp1); else { CHECK_NUMBER_COERCE_MARKER (start1, 1); begp1 = XINT (start1); } if (NILP (end1)) endp1 = BUF_ZV (bp1); else { CHECK_NUMBER_COERCE_MARKER (end1, 2); endp1 = XINT (end1); } if (begp1 > endp1) temp = begp1, begp1 = endp1, endp1 = temp; if (!(BUF_BEGV (bp1) <= begp1 && begp1 <= endp1 && endp1 <= BUF_ZV (bp1))) args_out_of_range (start1, end1); /* Likewise for second substring. */ if (NILP (buffer2)) bp2 = current_buffer; else { Lisp_Object buf2; buf2 = Fget_buffer (buffer2); if (NILP (buf2)) nsberror (buffer2); bp2 = XBUFFER (buffer2); } if (NILP (start2)) begp2 = BUF_BEGV (bp2); else { CHECK_NUMBER_COERCE_MARKER (start2, 4); begp2 = XINT (start2); } if (NILP (end2)) endp2 = BUF_ZV (bp2); else { CHECK_NUMBER_COERCE_MARKER (end2, 5); endp2 = XINT (end2); } if (begp2 > endp2) temp = begp2, begp2 = endp2, endp2 = temp; if (!(BUF_BEGV (bp2) <= begp2 && begp2 <= endp2 && endp2 <= BUF_ZV (bp2))) args_out_of_range (start2, end2); len1 = endp1 - begp1; len2 = endp2 - begp2; length = len1; if (len2 < length) length = len2; for (i = 0; i < length; i++) { int c1 = *BUF_CHAR_ADDRESS (bp1, begp1 + i); int c2 = *BUF_CHAR_ADDRESS (bp2, begp2 + i); if (trt) { c1 = trt[c1]; c2 = trt[c2]; } if (c1 < c2) return make_number (- 1 - i); if (c1 > c2) return make_number (i + 1); } /* The strings match as far as they go. If one is shorter, that one is less. */ if (length < len1) return make_number (length + 1); else if (length < len2) return make_number (- length - 1); /* Same length too => they are equal. */ return make_number (0); } static Lisp_Object subst_char_in_region_unwind (arg) Lisp_Object arg; { return current_buffer->undo_list = arg; } static Lisp_Object subst_char_in_region_unwind_1 (arg) Lisp_Object arg; { return current_buffer->filename = arg; } DEFUN ("subst-char-in-region", Fsubst_char_in_region, Ssubst_char_in_region, 4, 5, 0, "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\ If optional arg NOUNDO is non-nil, don't record this change for undo\n\ and don't mark the buffer as really changed.") (start, end, fromchar, tochar, noundo) Lisp_Object start, end, fromchar, tochar, noundo; { register int pos, stop, look; int changed = 0; int count = specpdl_ptr - specpdl; validate_region (&start, &end); CHECK_NUMBER (fromchar, 2); CHECK_NUMBER (tochar, 3); pos = XINT (start); stop = XINT (end); look = XINT (fromchar); /* If we don't want undo, turn off putting stuff on the list. That's faster than getting rid of things, and it prevents even the entry for a first change. Also inhibit locking the file. */ if (!NILP (noundo)) { record_unwind_protect (subst_char_in_region_unwind, current_buffer->undo_list); current_buffer->undo_list = Qt; /* Don't do file-locking. */ record_unwind_protect (subst_char_in_region_unwind_1, current_buffer->filename); current_buffer->filename = Qnil; } while (pos < stop) { if (FETCH_CHAR (pos) == look) { if (! changed) { modify_region (current_buffer, XINT (start), stop); if (! NILP (noundo)) { if (MODIFF - 1 == SAVE_MODIFF) SAVE_MODIFF++; if (MODIFF - 1 == current_buffer->auto_save_modified) current_buffer->auto_save_modified++; } changed = 1; } if (NILP (noundo)) record_change (pos, 1); FETCH_CHAR (pos) = XINT (tochar); } pos++; } if (changed) signal_after_change (XINT (start), stop - XINT (start), stop - XINT (start)); unbind_to (count, Qnil); return Qnil; } DEFUN ("translate-region", Ftranslate_region, Stranslate_region, 3, 3, 0, "From START to END, translate characters according to TABLE.\n\ TABLE is a string; the Nth character in it is the mapping\n\ for the character with code N. Returns the number of characters changed.") (start, end, table) Lisp_Object start; Lisp_Object end; register Lisp_Object table; { register int pos, stop; /* Limits of the region. */ register unsigned char *tt; /* Trans table. */ register int oc; /* Old character. */ register int nc; /* New character. */ int cnt; /* Number of changes made. */ Lisp_Object z; /* Return. */ int size; /* Size of translate table. */ validate_region (&start, &end); CHECK_STRING (table, 2); size = XSTRING (table)->size; tt = XSTRING (table)->data; pos = XINT (start); stop = XINT (end); modify_region (current_buffer, pos, stop); cnt = 0; for (; pos < stop; ++pos) { oc = FETCH_CHAR (pos); if (oc < size) { nc = tt[oc]; if (nc != oc) { record_change (pos, 1); FETCH_CHAR (pos) = nc; signal_after_change (pos, 1, 1); ++cnt; } } } XSETFASTINT (z, cnt); return (z); } DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r", "Delete the text between point and mark.\n\ When called from a program, expects two arguments,\n\ positions (integers or markers) specifying the stretch to be deleted.") (b, e) Lisp_Object b, e; { validate_region (&b, &e); del_range (XINT (b), XINT (e)); return Qnil; } DEFUN ("widen", Fwiden, Swiden, 0, 0, "", "Remove restrictions (narrowing) from current buffer.\n\ This allows the buffer's full text to be seen and edited.") () { BEGV = BEG; SET_BUF_ZV (current_buffer, Z); current_buffer->clip_changed = 1; /* Changing the buffer bounds invalidates any recorded current column. */ invalidate_current_column (); return Qnil; } DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r", "Restrict editing in this buffer to the current region.\n\ The rest of the text becomes temporarily invisible and untouchable\n\ but is not deleted; if you save the buffer in a file, the invisible\n\ text is included in the file. \\[widen] makes all visible again.\n\ See also `save-restriction'.\n\ \n\ When calling from a program, pass two arguments; positions (integers\n\ or markers) bounding the text that should remain visible.") (b, e) register Lisp_Object b, e; { CHECK_NUMBER_COERCE_MARKER (b, 0); CHECK_NUMBER_COERCE_MARKER (e, 1); if (XINT (b) > XINT (e)) { Lisp_Object tem; tem = b; b = e; e = tem; } if (!(BEG <= XINT (b) && XINT (b) <= XINT (e) && XINT (e) <= Z)) args_out_of_range (b, e); BEGV = XFASTINT (b); SET_BUF_ZV (current_buffer, XFASTINT (e)); if (point < XFASTINT (b)) SET_PT (XFASTINT (b)); if (point > XFASTINT (e)) SET_PT (XFASTINT (e)); current_buffer->clip_changed = 1; /* Changing the buffer bounds invalidates any recorded current column. */ invalidate_current_column (); return Qnil; } Lisp_Object save_restriction_save () { register Lisp_Object bottom, top; /* Note: I tried using markers here, but it does not win because insertion at the end of the saved region does not advance mh and is considered "outside" the saved region. */ XSETFASTINT (bottom, BEGV - BEG); XSETFASTINT (top, Z - ZV); return Fcons (Fcurrent_buffer (), Fcons (bottom, top)); } Lisp_Object save_restriction_restore (data) Lisp_Object data; { register struct buffer *buf; register int newhead, newtail; register Lisp_Object tem; buf = XBUFFER (XCONS (data)->car); data = XCONS (data)->cdr; tem = XCONS (data)->car; newhead = XINT (tem); tem = XCONS (data)->cdr; newtail = XINT (tem); if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf)) { newhead = 0; newtail = 0; } BUF_BEGV (buf) = BUF_BEG (buf) + newhead; SET_BUF_ZV (buf, BUF_Z (buf) - newtail); current_buffer->clip_changed = 1; /* If point is outside the new visible range, move it inside. */ SET_BUF_PT (buf, clip_to_bounds (BUF_BEGV (buf), BUF_PT (buf), BUF_ZV (buf))); return Qnil; } DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0, "Execute BODY, saving and restoring current buffer's restrictions.\n\ The buffer's restrictions make parts of the beginning and end invisible.\n\ \(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\ This special form, `save-restriction', saves the current buffer's restrictions\n\ when it is entered, and restores them when it is exited.\n\ So any `narrow-to-region' within BODY lasts only until the end of the form.\n\ The old restrictions settings are restored\n\ even in case of abnormal exit (throw or error).\n\ \n\ The value returned is the value of the last form in BODY.\n\ \n\ `save-restriction' can get confused if, within the BODY, you widen\n\ and then make changes outside the area within the saved restrictions.\n\ \n\ Note: if you are using both `save-excursion' and `save-restriction',\n\ use `save-excursion' outermost:\n\ (save-excursion (save-restriction ...))") (body) Lisp_Object body; { register Lisp_Object val; int count = specpdl_ptr - specpdl; record_unwind_protect (save_restriction_restore, save_restriction_save ()); val = Fprogn (body); return unbind_to (count, val); } /* Buffer for the most recent text displayed by Fmessage. */ static char *message_text; /* Allocated length of that buffer. */ static int message_length; DEFUN ("message", Fmessage, Smessage, 1, MANY, 0, "Print a one-line message at the bottom of the screen.\n\ The first argument is a format control string, and the rest are data\n\ to be formatted under control of the string. See `format' for details.\n\ \n\ If the first argument is nil, clear any existing message; let the\n\ minibuffer contents show.") (nargs, args) int nargs; Lisp_Object *args; { if (NILP (args[0])) { message (0); return Qnil; } else { register Lisp_Object val; val = Fformat (nargs, args); /* Copy the data so that it won't move when we GC. */ if (! message_text) { message_text = (char *)xmalloc (80); message_length = 80; } if (XSTRING (val)->size > message_length) { message_length = XSTRING (val)->size; message_text = (char *)xrealloc (message_text, message_length); } bcopy (XSTRING (val)->data, message_text, XSTRING (val)->size); message2 (message_text, XSTRING (val)->size); return val; } } DEFUN ("message-box", Fmessage_box, Smessage_box, 1, MANY, 0, "Display a message, in a dialog box if possible.\n\ If a dialog box is not available, use the echo area.\n\ The first argument is a control string.\n\ It may contain %s or %d or %c to print successive following arguments.\n\ %s means print an argument as a string, %d means print as number in decimal,\n\ %c means print a number as a single character.\n\ The argument used by %s must be a string or a symbol;\n\ the argument used by %d or %c must be a number.\n\ If the first argument is nil, clear any existing message; let the\n\ minibuffer contents show.") (nargs, args) int nargs; Lisp_Object *args; { if (NILP (args[0])) { message (0); return Qnil; } else { register Lisp_Object val; val = Fformat (nargs, args); #ifdef HAVE_X_MENU { Lisp_Object pane, menu, obj; struct gcpro gcpro1; pane = Fcons (Fcons (build_string ("OK"), Qt), Qnil); GCPRO1 (pane); menu = Fcons (val, pane); obj = Fx_popup_dialog (Qt, menu); UNGCPRO; return val; } #else /* Copy the data so that it won't move when we GC. */ if (! message_text) { message_text = (char *)xmalloc (80); message_length = 80; } if (XSTRING (val)->size > message_length) { message_length = XSTRING (val)->size; message_text = (char *)xrealloc (message_text, message_length); } bcopy (XSTRING (val)->data, message_text, XSTRING (val)->size); message2 (message_text, XSTRING (val)->size); return val; #endif } } #ifdef HAVE_X_MENU extern Lisp_Object last_nonmenu_event; #endif DEFUN ("message-or-box", Fmessage_or_box, Smessage_or_box, 1, MANY, 0, "Display a message in a dialog box or in the echo area.\n\ If this command was invoked with the mouse, use a dialog box.\n\ Otherwise, use the echo area.\n\ \n\ The first argument is a control string.\n\ It may contain %s or %d or %c to print successive following arguments.\n\ %s means print an argument as a string, %d means print as number in decimal,\n\ %c means print a number as a single character.\n\ The argument used by %s must be a string or a symbol;\n\ the argument used by %d or %c must be a number.\n\ If the first argument is nil, clear any existing message; let the\n\ minibuffer contents show.") (nargs, args) int nargs; Lisp_Object *args; { #ifdef HAVE_X_MENU if (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) return Fmessage_box (nargs, args); #endif return Fmessage (nargs, args); } DEFUN ("format", Fformat, Sformat, 1, MANY, 0, "Format a string out of a control-string and arguments.\n\ The first argument is a control string.\n\ The other arguments are substituted into it to make the result, a string.\n\ It may contain %-sequences meaning to substitute the next argument.\n\ %s means print a string argument. Actually, prints any object, with `princ'.\n\ %d means print as number in decimal (%o octal, %x hex).\n\ %e means print a number in exponential notation.\n\ %f means print a number in decimal-point notation.\n\ %g means print a number in exponential notation\n\ or decimal-point notation, whichever uses fewer characters.\n\ %c means print a number as a single character.\n\ %S means print any object as an s-expression (using prin1).\n\ The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.\n\ Use %% to put a single % into the output.") (nargs, args) int nargs; register Lisp_Object *args; { register int n; /* The number of the next arg to substitute */ register int total = 5; /* An estimate of the final length */ char *buf; register unsigned char *format, *end; int length; extern char *index (); /* It should not be necessary to GCPRO ARGS, because the caller in the interpreter should take care of that. */ CHECK_STRING (args[0], 0); format = XSTRING (args[0])->data; end = format + XSTRING (args[0])->size; n = 0; while (format != end) if (*format++ == '%') { int minlen; /* Process a numeric arg and skip it. */ minlen = atoi (format); if (minlen < 0) minlen = - minlen; while ((*format >= '0' && *format <= '9') || *format == '-' || *format == ' ' || *format == '.') format++; if (*format == '%') format++; else if (++n >= nargs) error ("Not enough arguments for format string"); else if (*format == 'S') { /* For `S', prin1 the argument and then treat like a string. */ register Lisp_Object tem; tem = Fprin1_to_string (args[n], Qnil); args[n] = tem; goto string; } else if (SYMBOLP (args[n])) { XSETSTRING (args[n], XSYMBOL (args[n])->name); goto string; } else if (STRINGP (args[n])) { string: if (*format != 's' && *format != 'S') error ("format specifier doesn't match argument type"); total += XSTRING (args[n])->size; /* We have to put an arbitrary limit on minlen since otherwise it could make alloca fail. */ if (minlen < XSTRING (args[n])->size + 1000) total += minlen; } /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */ else if (INTEGERP (args[n]) && *format != 's') { #ifdef LISP_FLOAT_TYPE /* The following loop assumes the Lisp type indicates the proper way to pass the argument. So make sure we have a flonum if the argument should be a double. */ if (*format == 'e' || *format == 'f' || *format == 'g') args[n] = Ffloat (args[n]); #endif total += 30; /* We have to put an arbitrary limit on minlen since otherwise it could make alloca fail. */ if (minlen < 1000) total += minlen; } #ifdef LISP_FLOAT_TYPE else if (FLOATP (args[n]) && *format != 's') { if (! (*format == 'e' || *format == 'f' || *format == 'g')) args[n] = Ftruncate (args[n]); total += 30; /* We have to put an arbitrary limit on minlen since otherwise it could make alloca fail. */ if (minlen < 1000) total += minlen; } #endif else { /* Anything but a string, convert to a string using princ. */ register Lisp_Object tem; tem = Fprin1_to_string (args[n], Qt); args[n] = tem; goto string; } } { 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 (INTEGERP (args[n])) /* 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 (FLOATP (args[n])) { union { double d; char *half[2]; } u; u.d = XFLOAT (args[n])->data; strings[i++] = (unsigned char *) u.half[0]; strings[i++] = (unsigned char *) u.half[1]; } #endif else if (i == 0) /* The first string is treated differently because it is the format string. */ strings[i++] = XSTRING (args[n])->data; else strings[i++] = (unsigned char *) XFASTINT (args[n]); } /* Make room in result for all the non-%-codes in the control string. */ total += XSTRING (args[0])->size; /* Format it in bigger and bigger buf's until it all fits. */ while (1) { buf = (char *) alloca (total + 1); buf[total - 1] = 0; length = doprnt_lisp (buf, total + 1, strings[0], end, i-1, strings + 1); if (buf[total - 1] == 0) break; total *= 2; } } /* UNGCPRO; */ return make_string (buf, length); } /* VARARGS 1 */ Lisp_Object #ifdef NO_ARG_ARRAY format1 (string1, arg0, arg1, arg2, arg3, arg4) EMACS_INT arg0, arg1, arg2, arg3, arg4; #else format1 (string1) #endif char *string1; { char buf[100]; #ifdef NO_ARG_ARRAY EMACS_INT args[5]; args[0] = arg0; args[1] = arg1; args[2] = arg2; args[3] = arg3; args[4] = arg4; doprnt (buf, sizeof buf, string1, (char *)0, 5, args); #else doprnt (buf, sizeof buf, string1, (char *)0, 5, &string1 + 1); #endif return build_string (buf); } DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0, "Return t if two characters match, optionally ignoring case.\n\ Both arguments must be characters (i.e. integers).\n\ Case is ignored if `case-fold-search' is non-nil in the current buffer.") (c1, c2) register Lisp_Object c1, c2; { Lisp_Object *downcase = DOWNCASE_TABLE; CHECK_NUMBER (c1, 0); CHECK_NUMBER (c2, 1); if (!NILP (current_buffer->case_fold_search) ? ((XINT (downcase[0xff & XFASTINT (c1)]) == XINT (downcase[0xff & XFASTINT (c2)])) && (XFASTINT (c1) & ~0xff) == (XFASTINT (c2) & ~0xff)) : XINT (c1) == XINT (c2)) return Qt; return Qnil; } /* Transpose the markers in two regions of the current buffer, and adjust the ones between them if necessary (i.e.: if the regions differ in size). Traverses the entire marker list of the buffer to do so, adding an appropriate amount to some, subtracting from some, and leaving the rest untouched. Most of this is copied from adjust_markers in insdel.c. It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */ void transpose_markers (start1, end1, start2, end2) register int start1, end1, start2, end2; { register int amt1, amt2, diff, mpos; register Lisp_Object marker; /* Update point as if it were a marker. */ if (PT < start1) ; else if (PT < end1) TEMP_SET_PT (PT + (end2 - end1)); else if (PT < start2) TEMP_SET_PT (PT + (end2 - start2) - (end1 - start1)); else if (PT < end2) TEMP_SET_PT (PT - (start2 - start1)); /* We used to adjust the endpoints here to account for the gap, but that isn't good enough. Even if we assume the caller has tried to move the gap out of our way, it might still be at start1 exactly, for example; and that places it `inside' the interval, for our purposes. The amount of adjustment is nontrivial if there's a `denormalized' marker whose position is between GPT and GPT + GAP_SIZE, so it's simpler to leave the dirty work to Fmarker_position, below. */ /* The difference between the region's lengths */ diff = (end2 - start2) - (end1 - start1); /* For shifting each marker in a region by the length of the other * region plus the distance between the regions. */ amt1 = (end2 - start2) + (start2 - end1); amt2 = (end1 - start1) + (start2 - end1); for (marker = BUF_MARKERS (current_buffer); !NILP (marker); marker = XMARKER (marker)->chain) { mpos = Fmarker_position (marker); if (mpos >= start1 && mpos < end2) { if (mpos < end1) mpos += amt1; else if (mpos < start2) mpos += diff; else mpos -= amt2; if (mpos > GPT) mpos += GAP_SIZE; XMARKER (marker)->bufpos = mpos; } } } DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5, 0, "Transpose region START1 to END1 with START2 to END2.\n\ The regions may not be overlapping, because the size of the buffer is\n\ never changed in a transposition.\n\ \n\ Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose\n\ any markers that happen to be located in the regions.\n\ \n\ Transposing beyond buffer boundaries is an error.") (startr1, endr1, startr2, endr2, leave_markers) Lisp_Object startr1, endr1, startr2, endr2, leave_markers; { register int start1, end1, start2, end2, gap, len1, len_mid, len2; unsigned char *start1_addr, *start2_addr, *temp; #ifdef USE_TEXT_PROPERTIES INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2; cur_intv = BUF_INTERVALS (current_buffer); #endif /* USE_TEXT_PROPERTIES */ validate_region (&startr1, &endr1); validate_region (&startr2, &endr2); start1 = XFASTINT (startr1); end1 = XFASTINT (endr1); start2 = XFASTINT (startr2); end2 = XFASTINT (endr2); gap = GPT; /* Swap the regions if they're reversed. */ if (start2 < end1) { register int glumph = start1; start1 = start2; start2 = glumph; glumph = end1; end1 = end2; end2 = glumph; } len1 = end1 - start1; len2 = end2 - start2; if (start2 < end1) error ("transposed regions not properly ordered"); else if (start1 == end1 || start2 == end2) error ("transposed region may not be of length 0"); /* The possibilities are: 1. Adjacent (contiguous) regions, or separate but equal regions (no, really equal, in this case!), or 2. Separate regions of unequal size. The worst case is usually No. 2. It means that (aside from potential need for getting the gap out of the way), there also needs to be a shifting of the text between the two regions. So if they are spread far apart, we are that much slower... sigh. */ /* It must be pointed out that the really studly thing to do would be not to move the gap at all, but to leave it in place and work around it if necessary. This would be extremely efficient, especially considering that people are likely to do transpositions near where they are working interactively, which is exactly where the gap would be found. However, such code would be much harder to write and to read. So, if you are reading this comment and are feeling squirrely, by all means have a go! I just didn't feel like doing it, so I will simply move the gap the minimum distance to get it out of the way, and then deal with an unbroken array. */ /* Make sure the gap won't interfere, by moving it out of the text we will operate on. */ if (start1 < gap && gap < end2) { if (gap - start1 < end2 - gap) move_gap (start1); else move_gap (end2); } /* Hmmm... how about checking to see if the gap is large enough to use as the temporary storage? That would avoid an allocation... interesting. Later, don't fool with it now. */ /* Working without memmove, for portability (sigh), so must be careful of overlapping subsections of the array... */ if (end1 == start2) /* adjacent regions */ { modify_region (current_buffer, start1, end2); record_change (start1, len1 + len2); #ifdef USE_TEXT_PROPERTIES tmp_interval1 = copy_intervals (cur_intv, start1, len1); tmp_interval2 = copy_intervals (cur_intv, start2, len2); Fset_text_properties (start1, end2, Qnil, Qnil); #endif /* USE_TEXT_PROPERTIES */ /* First region smaller than second. */ if (len1 < len2) { /* We use alloca only if it is small, because we want to avoid stack overflow. */ if (len2 > 20000) temp = (unsigned char *) xmalloc (len2); else temp = (unsigned char *) alloca (len2); /* Don't precompute these addresses. We have to compute them at the last minute, because the relocating allocator might have moved the buffer around during the xmalloc. */ start1_addr = BUF_CHAR_ADDRESS (current_buffer, start1); start2_addr = BUF_CHAR_ADDRESS (current_buffer, start2); bcopy (start2_addr, temp, len2); bcopy (start1_addr, start1_addr + len2, len1); bcopy (temp, start1_addr, len2); if (len2 > 20000) free (temp); } else /* First region not smaller than second. */ { if (len1 > 20000) temp = (unsigned char *) xmalloc (len1); else temp = (unsigned char *) alloca (len1); start1_addr = BUF_CHAR_ADDRESS (current_buffer, start1); start2_addr = BUF_CHAR_ADDRESS (current_buffer, start2); bcopy (start1_addr, temp, len1); bcopy (start2_addr, start1_addr, len2); bcopy (temp, start1_addr + len2, len1); if (len1 > 20000) free (temp); } #ifdef USE_TEXT_PROPERTIES graft_intervals_into_buffer (tmp_interval1, start1 + len2, len1, current_buffer, 0); graft_intervals_into_buffer (tmp_interval2, start1, len2, current_buffer, 0); #endif /* USE_TEXT_PROPERTIES */ } /* Non-adjacent regions, because end1 != start2, bleagh... */ else { if (len1 == len2) /* Regions are same size, though, how nice. */ { modify_region (current_buffer, start1, end1); modify_region (current_buffer, start2, end2); record_change (start1, len1); record_change (start2, len2); #ifdef USE_TEXT_PROPERTIES tmp_interval1 = copy_intervals (cur_intv, start1, len1); tmp_interval2 = copy_intervals (cur_intv, start2, len2); Fset_text_properties (start1, end1, Qnil, Qnil); Fset_text_properties (start2, end2, Qnil, Qnil); #endif /* USE_TEXT_PROPERTIES */ if (len1 > 20000) temp = (unsigned char *) xmalloc (len1); else temp = (unsigned char *) alloca (len1); start1_addr = BUF_CHAR_ADDRESS (current_buffer, start1); start2_addr = BUF_CHAR_ADDRESS (current_buffer, start2); bcopy (start1_addr, temp, len1); bcopy (start2_addr, start1_addr, len2); bcopy (temp, start2_addr, len1); if (len1 > 20000) free (temp); #ifdef USE_TEXT_PROPERTIES graft_intervals_into_buffer (tmp_interval1, start2, len1, current_buffer, 0); graft_intervals_into_buffer (tmp_interval2, start1, len2, current_buffer, 0); #endif /* USE_TEXT_PROPERTIES */ } else if (len1 < len2) /* Second region larger than first */ /* Non-adjacent & unequal size, area between must also be shifted. */ { len_mid = start2 - end1; modify_region (current_buffer, start1, end2); record_change (start1, (end2 - start1)); #ifdef USE_TEXT_PROPERTIES tmp_interval1 = copy_intervals (cur_intv, start1, len1); tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); tmp_interval2 = copy_intervals (cur_intv, start2, len2); Fset_text_properties (start1, end2, Qnil, Qnil); #endif /* USE_TEXT_PROPERTIES */ /* holds region 2 */ if (len2 > 20000) temp = (unsigned char *) xmalloc (len2); else temp = (unsigned char *) alloca (len2); start1_addr = BUF_CHAR_ADDRESS (current_buffer, start1); start2_addr = BUF_CHAR_ADDRESS (current_buffer, start2); bcopy (start2_addr, temp, len2); bcopy (start1_addr, start1_addr + len_mid + len2, len1); safe_bcopy (start1_addr + len1, start1_addr + len2, len_mid); bcopy (temp, start1_addr, len2); if (len2 > 20000) free (temp); #ifdef USE_TEXT_PROPERTIES graft_intervals_into_buffer (tmp_interval1, end2 - len1, len1, current_buffer, 0); graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, len_mid, current_buffer, 0); graft_intervals_into_buffer (tmp_interval2, start1, len2, current_buffer, 0); #endif /* USE_TEXT_PROPERTIES */ } else /* Second region smaller than first. */ { len_mid = start2 - end1; record_change (start1, (end2 - start1)); modify_region (current_buffer, start1, end2); #ifdef USE_TEXT_PROPERTIES tmp_interval1 = copy_intervals (cur_intv, start1, len1); tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); tmp_interval2 = copy_intervals (cur_intv, start2, len2); Fset_text_properties (start1, end2, Qnil, Qnil); #endif /* USE_TEXT_PROPERTIES */ /* holds region 1 */ if (len1 > 20000) temp = (unsigned char *) xmalloc (len1); else temp = (unsigned char *) alloca (len1); start1_addr = BUF_CHAR_ADDRESS (current_buffer, start1); start2_addr = BUF_CHAR_ADDRESS (current_buffer, start2); bcopy (start1_addr, temp, len1); bcopy (start2_addr, start1_addr, len2); bcopy (start1_addr + len1, start1_addr + len2, len_mid); bcopy (temp, start1_addr + len2 + len_mid, len1); if (len1 > 20000) free (temp); #ifdef USE_TEXT_PROPERTIES graft_intervals_into_buffer (tmp_interval1, end2 - len1, len1, current_buffer, 0); graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, len_mid, current_buffer, 0); graft_intervals_into_buffer (tmp_interval2, start1, len2, current_buffer, 0); #endif /* USE_TEXT_PROPERTIES */ } } /* todo: this will be slow, because for every transposition, we traverse the whole friggin marker list. Possible solutions: somehow get a list of *all* the markers across multiple transpositions and do it all in one swell phoop. Or maybe modify Emacs' marker code to keep an ordered list or tree. This might be nicer, and more beneficial in the long run, but would be a bunch of work. Plus the way they're arranged now is nice. */ if (NILP (leave_markers)) { transpose_markers (start1, end1, start2, end2); fix_overlays_in_range (start1, end2); } return Qnil; } void syms_of_editfns () { DEFVAR_LISP ("system-name", &Vsystem_name, "The name of the machine Emacs is running on."); DEFVAR_LISP ("user-full-name", &Vuser_full_name, "The full name of the user logged in."); DEFVAR_LISP ("user-login-name", &Vuser_login_name, "The user's name, taken from environment variables if possible."); DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name, "The user's name, based upon the real uid only."); defsubr (&Schar_equal); defsubr (&Sgoto_char); defsubr (&Sstring_to_char); defsubr (&Schar_to_string); defsubr (&Sbuffer_substring); defsubr (&Sbuffer_string); defsubr (&Spoint_marker); defsubr (&Smark_marker); defsubr (&Spoint); defsubr (&Sregion_beginning); defsubr (&Sregion_end); /* defsubr (&Smark); */ /* defsubr (&Sset_mark); */ defsubr (&Ssave_excursion); defsubr (&Sbufsize); defsubr (&Spoint_max); defsubr (&Spoint_min); defsubr (&Spoint_min_marker); defsubr (&Spoint_max_marker); defsubr (&Sbobp); defsubr (&Seobp); defsubr (&Sbolp); defsubr (&Seolp); defsubr (&Sfollowing_char); defsubr (&Sprevious_char); defsubr (&Schar_after); defsubr (&Sinsert); defsubr (&Sinsert_before_markers); defsubr (&Sinsert_and_inherit); defsubr (&Sinsert_and_inherit_before_markers); defsubr (&Sinsert_char); defsubr (&Suser_login_name); defsubr (&Suser_real_login_name); defsubr (&Suser_uid); defsubr (&Suser_real_uid); defsubr (&Suser_full_name); defsubr (&Semacs_pid); defsubr (&Scurrent_time); defsubr (&Sformat_time_string); defsubr (&Sdecode_time); defsubr (&Sencode_time); defsubr (&Scurrent_time_string); defsubr (&Scurrent_time_zone); defsubr (&Sset_time_zone_rule); defsubr (&Ssystem_name); defsubr (&Smessage); defsubr (&Smessage_box); defsubr (&Smessage_or_box); defsubr (&Sformat); defsubr (&Sinsert_buffer_substring); defsubr (&Scompare_buffer_substrings); defsubr (&Ssubst_char_in_region); defsubr (&Stranslate_region); defsubr (&Sdelete_region); defsubr (&Swiden); defsubr (&Snarrow_to_region); defsubr (&Ssave_restriction); defsubr (&Stranspose_regions); } emacs-19.30/src/emacs.c100444 12120 1 113366 6054401720 13173 0ustar rmsdaemon/* Fully extensible Emacs, running on Unix, intended for GNU. Copyright (C) 1985, 86, 87, 93, 94, 95 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. */ #include #include #include #include #include #include #ifdef VMS #include #endif #ifdef BSD #include #endif #include "lisp.h" #include "commands.h" #include "intervals.h" #include "systty.h" #include "syssignal.h" #include "process.h" #ifndef O_RDWR #define O_RDWR 2 #endif extern void malloc_warning (); extern char *index (); extern char *strerror (); /* Command line args from shell, as list of strings */ Lisp_Object Vcommand_line_args; /* The name under which Emacs was invoked, with any leading directory names discarded. */ Lisp_Object Vinvocation_name; /* The directory name from which Emacs was invoked. */ Lisp_Object Vinvocation_directory; /* The directory name in which to find subdirs such as lisp and etc. nil means get them only from PATH_LOADSEARCH. */ Lisp_Object Vinstallation_directory; /* Hook run by `kill-emacs' before it does really anything. */ Lisp_Object Vkill_emacs_hook; /* Set nonzero after Emacs has started up the first time. Prevents reinitialization of the Lisp world and keymaps on subsequent starts. */ int initialized; /* Variable whose value is symbol giving operating system type. */ Lisp_Object Vsystem_type; /* Variable whose value is string giving configuration built for. */ Lisp_Object Vsystem_configuration; /* Variable whose value is string giving configuration options, for use when reporting bugs. */ Lisp_Object Vsystem_configuration_options; /* If non-zero, emacs should not attempt to use an window-specific code, but instead should use the virtual terminal under which it was started */ int inhibit_window_system; /* If nonzero, set Emacs to run at this priority. This is also used in child_setup and sys_suspend to make sure subshells run at normal priority; Those functions have their own extern declaration. */ int emacs_priority; /* If non-zero a filter or a sentinel is running. Tested to save the match data on the first attempt to change it inside asynchronous code. */ int running_asynch_code; #ifdef BSD_PGRPS /* See sysdep.c. */ extern int inherited_pgroup; #endif #ifdef HAVE_X_WINDOWS /* If non-zero, -d was specified, meaning we're using some window system. */ int display_arg; #endif /* An address near the bottom of the stack. Tells GC how to save a copy of the stack. */ char *stack_bottom; #ifdef HAVE_WINDOW_SYSTEM extern Lisp_Object Vwindow_system; #endif /* HAVE_WINDOW_SYSTEM */ extern Lisp_Object Vauto_save_list_file_name; #ifdef USG_SHARED_LIBRARIES /* If nonzero, this is the place to put the end of the writable segment at startup. */ unsigned int bss_end = 0; #endif /* Nonzero means running Emacs without interactive terminal. */ int noninteractive; /* Value of Lisp variable `noninteractive'. Normally same as C variable `noninteractive' but nothing terrible happens if user sets this one. */ int noninteractive1; /* Save argv and argc. */ char **initial_argv; int initial_argc; static void sort_args (); /* Signal code for the fatal signal that was received */ int fatal_error_code; /* Nonzero if handling a fatal error already */ int fatal_error_in_progress; /* Handle bus errors, illegal instruction, etc. */ SIGTYPE fatal_error_signal (sig) int sig; { fatal_error_code = sig; signal (sig, SIG_DFL); /* If fatal error occurs in code below, avoid infinite recursion. */ if (! fatal_error_in_progress) { fatal_error_in_progress = 1; shut_down_emacs (sig, 0, Qnil); } #ifdef VMS LIB$STOP (SS$_ABORT); #else /* Signal the same code; this time it will really be fatal. Remember that since we're in a signal handler, the signal we're going to send is probably blocked, so we have to unblock it if we want to really receive it. */ #ifndef MSDOS sigunblock (sigmask (fatal_error_code)); #endif kill (getpid (), fatal_error_code); #endif /* not VMS */ } #ifdef SIGDANGER /* Handler for SIGDANGER. */ SIGTYPE memory_warning_signal (sig) int sig; { signal (sig, memory_warning_signal); malloc_warning ("Operating system warns that virtual memory is running low.\n"); /* It might be unsafe to call do_auto_save now. */ force_auto_save_soon (); } #endif /* Code for dealing with Lisp access to the Unix command line */ static init_cmdargs (argc, argv, skip_args) int argc; char **argv; int skip_args; { register int i; Lisp_Object name, dir; initial_argv = argv; initial_argc = argc; Vinvocation_name = Ffile_name_nondirectory (build_string (argv[0])); Vinvocation_directory = Ffile_name_directory (build_string (argv[0])); /* If we got no directory in argv[0], search PATH to find where Emacs actually came from. */ if (NILP (Vinvocation_directory)) { Lisp_Object found; int yes = openp (Vexec_path, Vinvocation_name, EXEC_SUFFIXES, &found, 1); if (yes == 1) Vinvocation_directory = Ffile_name_directory (found); } if (!NILP (Vinvocation_directory) && NILP (Ffile_name_absolute_p (Vinvocation_directory))) /* Emacs was started with relative path, like ./emacs */ Vinvocation_directory = Fexpand_file_name (Vinvocation_directory, Qnil); Vinstallation_directory = Qnil; if (!NILP (Vinvocation_directory)) { dir = Vinvocation_directory; name = Fexpand_file_name (Vinvocation_name, dir); while (1) { Lisp_Object tem, lib_src_exists; Lisp_Object etc_exists, info_exists; /* See if dir contains subdirs for use by Emacs. Check for the ones that would exist in a build directory, not including lisp and info. */ tem = Fexpand_file_name (build_string ("lib-src"), dir); lib_src_exists = Ffile_exists_p (tem); if (!NILP (lib_src_exists)) { tem = Fexpand_file_name (build_string ("etc"), dir); etc_exists = Ffile_exists_p (tem); if (!NILP (etc_exists)) { Vinstallation_directory = Ffile_name_as_directory (dir); break; } } /* See if dir's parent contains those subdirs. */ tem = Fexpand_file_name (build_string ("../lib-src"), dir); lib_src_exists = Ffile_exists_p (tem); if (!NILP (lib_src_exists)) { tem = Fexpand_file_name (build_string ("../etc"), dir); etc_exists = Ffile_exists_p (tem); if (!NILP (etc_exists)) { tem = Fexpand_file_name (build_string (".."), dir); Vinstallation_directory = Ffile_name_as_directory (tem); break; } } /* If the Emacs executable is actually a link, next try the dir that the link points into. */ tem = Ffile_symlink_p (name); if (!NILP (tem)) { name = Fexpand_file_name (tem, dir); dir = Ffile_name_directory (name); } else break; } } Vcommand_line_args = Qnil; for (i = argc - 1; i >= 0; i--) { if (i == 0 || i > skip_args) Vcommand_line_args = Fcons (build_string (argv[i]), Vcommand_line_args); } } DEFUN ("invocation-name", Finvocation_name, Sinvocation_name, 0, 0, 0, "Return the program name that was used to run Emacs.\n\ Any directory names are omitted.") () { return Fcopy_sequence (Vinvocation_name); } DEFUN ("invocation-directory", Finvocation_directory, Sinvocation_directory, 0, 0, 0, "Return the directory name in which the Emacs executable was located") () { return Fcopy_sequence (Vinvocation_directory); } #ifdef VMS #ifdef LINK_CRTL_SHARE #ifdef SHAREABLE_LIB_BUG extern noshare char **environ; #endif /* SHAREABLE_LIB_BUG */ #endif /* LINK_CRTL_SHARE */ #endif /* VMS */ #ifndef ORDINARY_LINK /* We don't include crtbegin.o and crtend.o in the link, so these functions and variables might be missed. Provide dummy definitions to avoid error. (We don't have any real constructors or destructors.) */ #ifdef __GNUC__ #ifndef GCC_CTORS_IN_LIBC __do_global_ctors () {} __do_global_ctors_aux () {} __do_global_dtors () {} /* Linux has a bug in its library; avoid an error. */ #ifndef LINUX char * __CTOR_LIST__[2] = { (char *) (-1), 0 }; #endif char * __DTOR_LIST__[2] = { (char *) (-1), 0 }; #endif /* GCC_CTORS_IN_LIBC */ __main () {} #endif /* __GNUC__ */ #endif /* ORDINARY_LINK */ /* Test whether the next argument in ARGV matches SSTR or a prefix of LSTR (at least MINLEN characters). If so, then if VALPTR is non-null (the argument is supposed to have a value) store in *VALPTR either the next argument or the portion of this one after the equal sign. ARGV is read starting at position *SKIPPTR; this index is advanced by the number of arguments used. Too bad we can't just use getopt for all of this, but we don't have enough information to do it right. */ static int argmatch (argv, argc, sstr, lstr, minlen, valptr, skipptr) char **argv; int argc; char *sstr; char *lstr; int minlen; char **valptr; int *skipptr; { char *p; int arglen; char *arg; /* Don't access argv[argc]; give up in advance. */ if (argc <= *skipptr + 1) return 0; arg = argv[*skipptr+1]; if (arg == NULL) return 0; if (strcmp (arg, sstr) == 0) { if (valptr != NULL) { *valptr = argv[*skipptr+2]; *skipptr += 2; } else *skipptr += 1; return 1; } arglen = (valptr != NULL && (p = index (arg, '=')) != NULL ? p - arg : strlen (arg)); if (lstr == 0 || arglen < minlen || strncmp (arg, lstr, arglen) != 0) return 0; else if (valptr == NULL) { *skipptr += 1; return 1; } else if (p != NULL) { *valptr = p+1; *skipptr += 1; return 1; } else if (argv[*skipptr+2] != NULL) { *valptr = argv[*skipptr+2]; *skipptr += 2; return 1; } else { return 0; } } /* ARGSUSED */ main (argc, argv, envp) int argc; char **argv; char **envp; { char stack_bottom_variable; int skip_args = 0; extern int errno; extern sys_nerr; #ifdef LINUX_SBRK_BUG __sbrk (1); #endif sort_args (argc, argv); if (argmatch (argv, argc, "-version", "--version", 3, NULL, &skip_args)) { Lisp_Object tem; tem = Fsymbol_value (intern ("emacs-version")); if (!STRINGP (tem)) { fprintf (stderr, "Invalid value of `emacs-version'\n"); exit (1); } else { printf ("%s\n", XSTRING (tem)->data); exit (0); } } /* Map in shared memory, if we are using that. */ #ifdef HAVE_SHM if (argmatch (argv, argc, "-nl", "--no-shared-memory", 6, NULL, &skip_args)) { map_in_data (0); /* The shared memory was just restored, which clobbered this. */ skip_args = 1; } else { map_in_data (1); /* The shared memory was just restored, which clobbered this. */ skip_args = 0; } #endif #ifdef NeXT { extern int malloc_cookie; /* This helps out unexnext.c. */ if (initialized) if (malloc_jumpstart (malloc_cookie) != 0) printf ("malloc jumpstart failed!\n"); } #endif /* NeXT */ #ifdef VMS /* If -map specified, map the data file in */ { char *file; if (argmatch (argv, argc, "-map", "--map-data", 3, &mapin_file, &skip_args)) mapin_data (file); } #ifdef LINK_CRTL_SHARE #ifdef SHAREABLE_LIB_BUG /* Bletcherous shared libraries! */ if (!stdin) stdin = fdopen (0, "r"); if (!stdout) stdout = fdopen (1, "w"); if (!stderr) stderr = fdopen (2, "w"); if (!environ) environ = envp; #endif /* SHAREABLE_LIB_BUG */ #endif /* LINK_CRTL_SHARE */ #endif /* VMS */ /* Record (approximately) where the stack begins. */ stack_bottom = &stack_bottom_variable; #ifdef RUN_TIME_REMAP if (initialized) run_time_remap (argv[0]); #endif #ifdef USG_SHARED_LIBRARIES if (bss_end) brk ((void *)bss_end); #endif clearerr (stdin); #ifndef SYSTEM_MALLOC if (! initialized) { /* Arrange to get warning messages as memory fills up. */ memory_warnings (0, malloc_warning); /* Arrange to disable interrupt input while malloc and friends are running. */ uninterrupt_malloc (); } #endif /* not SYSTEM_MALLOC */ #ifdef MSDOS /* We do all file input/output as binary files. When we need to translate newlines, we do that manually. */ _fmode = O_BINARY; (stdin)->_flag &= ~_IOTEXT; (stdout)->_flag &= ~_IOTEXT; (stderr)->_flag &= ~_IOTEXT; #endif /* MSDOS */ #ifdef SET_EMACS_PRIORITY if (emacs_priority) nice (emacs_priority); setuid (getuid ()); #endif /* SET_EMACS_PRIORITY */ #ifdef EXTRA_INITIALIZE EXTRA_INITIALIZE; #endif inhibit_window_system = 0; /* Handle the -t switch, which specifies filename to use as terminal */ { char *term; if (argmatch (argv, argc, "-t", "--terminal", 4, &term, &skip_args)) { int result; close (0); close (1); result = open (term, O_RDWR, 2 ); if (result < 0) { char *errstring = strerror (errno); fprintf (stderr, "emacs: %s: %s\n", term, errstring); exit (1); } dup (0); if (! isatty (0)) { fprintf (stderr, "emacs: %s: not a tty\n", term); exit (1); } fprintf (stderr, "Using %s\n", term); #ifdef HAVE_WINDOW_SYSTEM inhibit_window_system = 1; /* -t => -nw */ #endif } } if (argmatch (argv, argc, "-nw", "--no-windows", 6, NULL, &skip_args)) inhibit_window_system = 1; /* Handle the -batch switch, which means don't do interactive display. */ noninteractive = 0; if (argmatch (argv, argc, "-batch", "--batch", 5, NULL, &skip_args)) noninteractive = 1; /* Handle the --help option, which gives a usage message.. */ if (argmatch (argv, argc, "-help", "--help", 3, NULL, &skip_args)) { printf ("\ Usage: %s [-t term] [--terminal term] [-nw] [--no-windows] [--batch]\n\ [-q] [--no-init-file] [-u user] [--user user] [--debug-init]\n\ [--version] [--no-site-file]\n\ [-f func] [--funcall func] [-l file] [--load file] [--insert file]\n\ [+linenum] file-to-visit [--kill]\n", argv[0]); exit (0); } #ifdef HAVE_X_WINDOWS /* Stupid kludge to catch command-line display spec. We can't handle this argument entirely in window system dependent code because we don't even know which window system dependent code to run until we've recognized this argument. */ { char *displayname; int i; int count_before = skip_args; if (argmatch (argv, argc, "-d", "--display", 3, &displayname, &skip_args)) display_arg = 1; else if (argmatch (argv, argc, "-display", 0, 3, &displayname, &skip_args)) display_arg = 1; /* If we have the form --display=NAME, convert it into -d name. This requires inserting a new element into argv. */ if (displayname != 0 && skip_args - count_before == 1) { char **new = (char **) xmalloc (sizeof (char *) * (argc + 2)); int j; for (j = 0; j < count_before + 1; j++) new[j] = argv[j]; new[count_before + 1] = "-d"; new[count_before + 2] = displayname; for (j = count_before + 2; j count_before && argv[count_before + 1][1] == '-') argv[count_before] = "-d"; /* Don't actually discard this arg. */ skip_args = count_before; } #endif if (! noninteractive) { #ifdef BSD_PGRPS if (initialized) { inherited_pgroup = EMACS_GETPGRP (0); setpgrp (0, getpid ()); } #else #if defined (USG5) && defined (INTERRUPT_INPUT) setpgrp (); #endif #endif } #ifdef POSIX_SIGNALS init_signals (); #endif if ( #ifndef CANNOT_DUMP ! noninteractive || initialized #else 1 #endif ) { /* Don't catch these signals in batch mode if not initialized. On some machines, this sets static data that would make signal fail to work right when the dumped Emacs is run. */ signal (SIGHUP, fatal_error_signal); signal (SIGQUIT, fatal_error_signal); signal (SIGILL, fatal_error_signal); signal (SIGTRAP, fatal_error_signal); #ifdef SIGABRT signal (SIGABRT, fatal_error_signal); #endif #ifdef SIGHWE signal (SIGHWE, fatal_error_signal); #endif #ifdef SIGPRE signal (SIGPRE, fatal_error_signal); #endif #ifdef SIGORE signal (SIGORE, fatal_error_signal); #endif #ifdef SIGUME signal (SIGUME, fatal_error_signal); #endif #ifdef SIGDLK signal (SIGDLK, fatal_error_signal); #endif #ifdef SIGCPULIM signal (SIGCPULIM, fatal_error_signal); #endif #ifdef SIGIOT /* This is missing on some systems - OS/2, for example. */ signal (SIGIOT, fatal_error_signal); #endif #ifdef SIGEMT signal (SIGEMT, fatal_error_signal); #endif signal (SIGFPE, fatal_error_signal); #ifdef SIGBUS signal (SIGBUS, fatal_error_signal); #endif signal (SIGSEGV, fatal_error_signal); #ifdef SIGSYS signal (SIGSYS, fatal_error_signal); #endif signal (SIGTERM, fatal_error_signal); #ifdef SIGXCPU signal (SIGXCPU, fatal_error_signal); #endif #ifdef SIGXFSZ signal (SIGXFSZ, fatal_error_signal); #endif /* SIGXFSZ */ #ifdef SIGDANGER /* This just means available memory is getting low. */ signal (SIGDANGER, memory_warning_signal); #endif #ifdef AIX /* 20 is SIGCHLD, 21 is SIGTTIN, 22 is SIGTTOU. */ signal (SIGXCPU, fatal_error_signal); #ifndef _I386 signal (SIGIOINT, fatal_error_signal); #endif signal (SIGGRANT, fatal_error_signal); signal (SIGRETRACT, fatal_error_signal); signal (SIGSOUND, fatal_error_signal); signal (SIGMSG, fatal_error_signal); #endif /* AIX */ } noninteractive1 = noninteractive; /* Perform basic initializations (not merely interning symbols) */ if (!initialized) { init_alloc_once (); init_obarray (); init_eval_once (); init_syntax_once (); /* Create standard syntax table. */ /* Must be done before init_buffer */ init_casetab_once (); init_buffer_once (); /* Create buffer table and some buffers */ init_minibuf_once (); /* Create list of minibuffers */ /* Must precede init_window_once */ init_window_once (); /* Init the window system */ } init_alloc (); init_eval (); init_data (); running_asynch_code = 0; #ifdef MSDOS /* Call early 'cause init_environment needs it. */ init_dosfns (); /* Set defaults for several environment variables. */ if (initialized) init_environment (argc, argv, skip_args); else init_gettimeofday (); #endif #ifdef WINDOWSNT /* Initialize environment from registry settings. */ init_environment (); #endif /* egetenv is a pretty low-level facility, which may get called in many circumstances; it seems flimsy to put off initializing it until calling init_callproc. */ set_process_environment (); /* AIX crashes are reported in system versions 3.2.3 and 3.2.4 if this is not done. Do it after set_process_environment so that we don't pollute Vprocess_environment. */ #ifdef AIX putenv ("LANG=C"); #endif init_buffer (); /* Init default directory of main buffer */ init_callproc_1 (); /* Must precede init_cmdargs and init_sys_modes. */ init_cmdargs (argc, argv, skip_args); /* Must precede init_lread. */ init_callproc (); /* Must follow init_cmdargs but not init_sys_modes. */ init_lread (); if (!noninteractive) { #ifdef VMS init_vms_input ();/* init_display calls get_frame_size, that needs this */ #endif /* VMS */ init_display (); /* Determine terminal type. init_sys_modes uses results */ } init_keyboard (); /* This too must precede init_sys_modes */ #ifdef VMS init_vmsproc (); /* And this too. */ #endif /* VMS */ init_sys_modes (); /* Init system terminal modes (RAW or CBREAK, etc.) */ init_xdisp (); init_macros (); init_editfns (); #ifdef LISP_FLOAT_TYPE init_floatfns (); #endif #ifdef VMS init_vmsfns (); #endif /* VMS */ init_process (); #ifdef CLASH_DETECTION init_filelock (); #endif /* CLASH_DETECTION */ /* Intern the names of all standard functions and variables; define standard keys */ if (!initialized) { /* The basic levels of Lisp must come first */ /* And data must come first of all for the sake of symbols like error-message */ syms_of_data (); syms_of_alloc (); syms_of_lread (); syms_of_print (); syms_of_eval (); syms_of_fns (); syms_of_floatfns (); syms_of_abbrev (); syms_of_buffer (); syms_of_bytecode (); syms_of_callint (); syms_of_casefiddle (); syms_of_casetab (); syms_of_callproc (); syms_of_cmds (); #ifndef NO_DIR_LIBRARY syms_of_dired (); #endif /* not NO_DIR_LIBRARY */ syms_of_display (); syms_of_doc (); syms_of_editfns (); syms_of_emacs (); syms_of_fileio (); #ifdef CLASH_DETECTION syms_of_filelock (); #endif /* CLASH_DETECTION */ syms_of_indent (); syms_of_keyboard (); syms_of_keymap (); syms_of_macros (); syms_of_marker (); syms_of_minibuf (); syms_of_mocklisp (); syms_of_process (); syms_of_search (); syms_of_frame (); syms_of_syntax (); syms_of_term (); syms_of_undo (); /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ syms_of_textprop (); #ifdef VMS syms_of_vmsproc (); #endif /* VMS */ syms_of_window (); syms_of_xdisp (); #ifdef HAVE_X_WINDOWS syms_of_xterm (); syms_of_xfns (); syms_of_xfaces (); #ifdef HAVE_X11 syms_of_xselect (); #endif #ifdef HAVE_X_MENU syms_of_xmenu (); #endif /* HAVE_X_MENU */ #endif /* HAVE_X_WINDOWS */ #if defined (MSDOS) && !defined (HAVE_X_WINDOWS) syms_of_xfaces (); syms_of_xmenu (); #endif #ifdef HAVE_NTGUI syms_of_win32term (); syms_of_win32fns (); syms_of_win32faces (); syms_of_win32select (); syms_of_win32menu (); #endif /* HAVE_NTGUI */ #ifdef SYMS_SYSTEM SYMS_SYSTEM; #endif #ifdef SYMS_MACHINE SYMS_MACHINE; #endif keys_of_casefiddle (); keys_of_cmds (); keys_of_buffer (); keys_of_keyboard (); keys_of_keymap (); keys_of_macros (); keys_of_minibuf (); keys_of_window (); keys_of_frame (); } if (!initialized) { char *file; /* Handle -l loadup-and-dump, args passed by Makefile. */ if (argmatch (argv, argc, "-l", "--load", 3, &file, &skip_args)) Vtop_level = Fcons (intern ("load"), Fcons (build_string (file), Qnil)); #ifdef CANNOT_DUMP /* Unless next switch is -nl, load "loadup.el" first thing. */ if (!argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args)) Vtop_level = Fcons (intern ("load"), Fcons (build_string ("loadup.el"), Qnil)); #endif /* CANNOT_DUMP */ } if (initialized) { /* Erase any pre-dump messages in the message log, to avoid confusion */ Lisp_Object old_log_max; old_log_max = Vmessage_log_max; XSETFASTINT (Vmessage_log_max, 0); message_dolog ("", 0, 1); Vmessage_log_max = old_log_max; } initialized = 1; #ifdef LOCALTIME_CACHE /* Some versions of localtime have a bug. They cache the value of the time zone rather than looking it up every time. Since localtime() is called to bolt the undumping time into the undumped emacs, this results in localtime ignoring the TZ environment variable. This flushes the new TZ value into localtime. */ tzset (); #endif /* defined (LOCALTIME_CACHE) */ /* Enter editor command loop. This never returns. */ Frecursive_edit (); /* NOTREACHED */ } /* Sort the args so we can find the most important ones at the beginning of argv. */ /* First, here's a table of all the standard options. */ struct standard_args { char *name; char *longname; int priority; int nargs; }; struct standard_args standard_args[] = { { "-version", "--version", 110, 0 }, { "-help", "--help", 110, 0 }, { "-nl", "--no-shared-memory", 100, 0 }, #ifdef VMS { "-map", "--map-data", 100, 0 }, #endif { "-t", "--terminal", 90, 1 }, { "-d", "--display", 80, 1 }, { "-display", 0, 80, 1 }, { "-nw", "--no-windows", 70, 0 }, { "-batch", "--batch", 60, 0 }, { "-q", "--no-init-file", 50, 0 }, { "-no-init-file", 0, 50, 0 }, { "-no-site-file", "--no-site-file", 40, 0 }, { "-u", "--user", 30, 1 }, { "-user", 0, 30, 1 }, { "-debug-init", "--debug-init", 20, 0 }, { "-i", "--icon-type", 15, 0 }, { "-itype", 0, 15, 0 }, { "-iconic", "--iconic", 15, 0 }, { "-bg", "--background-color", 10, 1 }, { "-background", 0, 10, 1 }, { "-fg", "--foreground-color", 10, 1 }, { "-foreground", 0, 10, 1 }, { "-bd", "--border-color", 10, 1 }, { "-bw", "--border-width", 10, 1 }, { "-ib", "--internal-border", 10, 1 }, { "-ms", "--mouse-color", 10, 1 }, { "-cr", "--cursor-color", 10, 1 }, { "-fn", "--font", 10, 1 }, { "-font", 0, 10, 1 }, { "-g", "--geometry", 10, 1 }, { "-geometry", 0, 10, 1 }, { "-T", "--title", 10, 1 }, { "-name", "--name", 10, 1 }, { "-xrm", "--xrm", 10, 1 }, { "-r", "--reverse-video", 5, 0 }, { "-rv", 0, 5, 0 }, { "-reverse", 0, 5, 0 }, { "-vb", "--vertical-scroll-bars", 5, 0 }, /* These have the same priority as ordinary file name args, so they are not reordered with respect to those. */ { "-L", "--directory", 0, 1 }, { "-directory", 0, 0, 1 }, { "-l", "--load", 0, 1 }, { "-load", 0, 0, 1 }, { "-f", "--funcall", 0, 1 }, { "-funcall", 0, 0, 1 }, { "-eval", "--eval", 0, 1 }, { "-insert", "--insert", 0, 1 }, /* This should be processed after ordinary file name args and the like. */ { "-kill", "--kill", -10, 0 }, }; /* Reorder the elements of ARGV (assumed to have ARGC elements) so that the highest priority ones come first. Do not change the order of elements of equal priority. If an option takes an argument, keep it and its argument together. */ static void sort_args (argc, argv) int argc; char **argv; { char **new = (char **) xmalloc (sizeof (char *) * argc); /* For each element of argv, the corresponding element of options is: 0 for an option that takes no arguments, 1 for an option that takes one argument, etc. -1 for an ordinary non-option argument. */ int *options = (int *) xmalloc (sizeof (int) * argc); int *priority = (int *) xmalloc (sizeof (int) * argc); int to = 1; int from; int i; /* Categorize all the options, and figure out which argv elts are option arguments. */ for (from = 1; from < argc; from++) { options[from] = -1; priority[from] = 0; if (argv[from][0] == '-') { int match, thislen; char *equals; /* Look for a match with a known old-fashioned option. */ for (i = 0; i < sizeof (standard_args) / sizeof (standard_args[0]); i++) if (!strcmp (argv[from], standard_args[i].name)) { options[from] = standard_args[i].nargs; priority[from] = standard_args[i].priority; from += standard_args[i].nargs; goto done; } /* Look for a match with a known long option. MATCH is -1 if no match so far, -2 if two or more matches so far, >= 0 (the table index of the match) if just one match so far. */ if (argv[from][1] == '-') { match = -1; thislen = strlen (argv[from]); equals = index (argv[from], '='); if (equals != 0) thislen = equals - argv[from]; for (i = 0; i < sizeof (standard_args) / sizeof (standard_args[0]); i++) if (standard_args[i].longname && !strncmp (argv[from], standard_args[i].longname, thislen)) { if (match == -1) match = i; else match = -2; } /* If we found exactly one match, use that. */ if (match >= 0) { options[from] = standard_args[match].nargs; priority[from] = standard_args[match].priority; /* If --OPTION=VALUE syntax is used, this option uses just one argv element. */ if (equals != 0) options[from] = 0; from += options[from]; } } done: ; } } /* Copy the arguments, in order of decreasing priority, to NEW. */ new[0] = argv[0]; while (to < argc) { int best = -1; int best_priority = -9999; /* Find the highest priority remaining option. If several have equal priority, take the first of them. */ for (from = 1; from < argc; from++) { if (argv[from] != 0 && priority[from] > best_priority) { best_priority = priority[from]; best = from; } /* Skip option arguments--they are tied to the options. */ if (options[from] > 0) from += options[from]; } if (best < 0) abort (); /* Copy the highest priority remaining option, with its args, to NEW. */ new[to++] = argv[best]; for (i = 0; i < options[best]; i++) new[to++] = argv[best + i + 1]; /* Clear out this option in ARGV. */ argv[best] = 0; for (i = 0; i < options[best]; i++) argv[best + i + 1] = 0; } bcopy (new, argv, sizeof (char *) * argc); } DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 1, "P", "Exit the Emacs job and kill it.\n\ If ARG is an integer, return ARG as the exit program code.\n\ If ARG is a string, stuff it as keyboard input.\n\n\ The value of `kill-emacs-hook', if not void,\n\ is a list of functions (of no args),\n\ all of which are called before Emacs is actually killed.") (arg) Lisp_Object arg; { Lisp_Object hook, hook1; int i; struct gcpro gcpro1; GCPRO1 (arg); if (feof (stdin)) arg = Qt; if (!NILP (Vrun_hooks) && !noninteractive) call1 (Vrun_hooks, intern ("kill-emacs-hook")); UNGCPRO; /* Is it really necessary to do this deassign when we are going to exit anyway? */ /* #ifdef VMS stop_vms_input (); #endif */ shut_down_emacs (0, 0, STRINGP (arg) ? arg : Qnil); /* If we have an auto-save list file, kill it because we are exiting Emacs deliberately (not crashing). Do it after shut_down_emacs, which does an auto-save. */ if (STRINGP (Vauto_save_list_file_name)) unlink (XSTRING (Vauto_save_list_file_name)->data); exit (INTEGERP (arg) ? XINT (arg) #ifdef VMS : 1 #else : 0 #endif ); /* NOTREACHED */ } /* Perform an orderly shutdown of Emacs. Autosave any modified buffers, kill any child processes, clean up the terminal modes (if we're in the foreground), and other stuff like that. Don't perform any redisplay; this may be called when Emacs is shutting down in the background, or after its X connection has died. If SIG is a signal number, print a message for it. This is called by fatal signal handlers, X protocol error handlers, and Fkill_emacs. */ void shut_down_emacs (sig, no_x, stuff) int sig, no_x; Lisp_Object stuff; { /* Prevent running of hooks from now on. */ Vrun_hooks = Qnil; /* If we are controlling the terminal, reset terminal modes */ #ifdef EMACS_HAVE_TTY_PGRP { int pgrp = EMACS_GETPGRP (0); int tpgrp; if (EMACS_GET_TTY_PGRP (0, &tpgrp) != -1 && tpgrp == pgrp) { fflush (stdout); reset_sys_modes (); if (sig && sig != SIGTERM) fprintf (stderr, "Fatal error (%d).", sig); } } #else fflush (stdout); reset_sys_modes (); #endif stuff_buffered_input (stuff); kill_buffer_processes (Qnil); Fdo_auto_save (Qt, Qnil); #ifdef CLASH_DETECTION unlock_all_files (); #endif #ifdef VMS kill_vms_processes (); #endif #if 0 /* This triggers a bug in XCloseDisplay and is not needed. */ #ifdef HAVE_X_WINDOWS /* It's not safe to call intern here. Maybe we are crashing. */ if (!noninteractive && SYMBOLP (Vwindow_system) && XSYMBOL (Vwindow_system)->name->size == 1 && XSYMBOL (Vwindow_system)->name->data[0] == 'x' && ! no_x) Fx_close_current_connection (); #endif /* HAVE_X_WINDOWS */ #endif #ifdef SIGIO /* There is a tendency for a SIGIO signal to arrive within exit, and cause a SIGHUP because the input descriptor is already closed. */ unrequest_sigio (); signal (SIGIO, SIG_IGN); #endif } #ifndef CANNOT_DUMP #ifdef HAVE_SHM DEFUN ("dump-emacs-data", Fdump_emacs_data, Sdump_emacs_data, 1, 1, 0, "Dump current state of Emacs into data file FILENAME.\n\ This function exists on systems that use HAVE_SHM.") (intoname) Lisp_Object intoname; { extern char my_edata[]; Lisp_Object tem; CHECK_STRING (intoname, 0); intoname = Fexpand_file_name (intoname, Qnil); tem = Vpurify_flag; Vpurify_flag = Qnil; fflush (stdout); /* Tell malloc where start of impure now is */ /* Also arrange for warnings when nearly out of space. */ #ifndef SYSTEM_MALLOC memory_warnings (my_edata, malloc_warning); #endif map_out_data (XSTRING (intoname)->data); Vpurify_flag = tem; return Qnil; } #else /* not HAVE_SHM */ DEFUN ("dump-emacs", Fdump_emacs, Sdump_emacs, 2, 2, 0, "Dump current state of Emacs into executable file FILENAME.\n\ Take symbols from SYMFILE (presumably the file you executed to run Emacs).\n\ This is used in the file `loadup.el' when building Emacs.\n\ \n\ Bind `command-line-processed' to nil before dumping,\n\ if you want the dumped Emacs to process its command line\n\ and announce itself normally when it is run.") (intoname, symname) Lisp_Object intoname, symname; { extern char my_edata[]; Lisp_Object tem; CHECK_STRING (intoname, 0); intoname = Fexpand_file_name (intoname, Qnil); if (!NILP (symname)) { CHECK_STRING (symname, 0); if (XSTRING (symname)->size) symname = Fexpand_file_name (symname, Qnil); } tem = Vpurify_flag; Vpurify_flag = Qnil; fflush (stdout); #ifdef VMS mapout_data (XSTRING (intoname)->data); #else /* Tell malloc where start of impure now is */ /* Also arrange for warnings when nearly out of space. */ #ifndef SYSTEM_MALLOC #ifndef WINDOWSNT /* On Windows, this was done before dumping, and that once suffices. Meanwhile, my_edata is not valid on Windows. */ memory_warnings (my_edata, malloc_warning); #endif /* not WINDOWSNT */ #endif unexec (XSTRING (intoname)->data, !NILP (symname) ? XSTRING (symname)->data : 0, my_edata, 0, 0); #endif /* not VMS */ Vpurify_flag = tem; return Qnil; } #endif /* not HAVE_SHM */ #endif /* not CANNOT_DUMP */ #ifndef SEPCHAR #define SEPCHAR ':' #endif Lisp_Object decode_env_path (evarname, defalt) char *evarname, *defalt; { register char *path, *p; Lisp_Object lpath; /* It's okay to use getenv here, because this function is only used to initialize variables when Emacs starts up, and isn't called after that. */ if (evarname != 0) path = (char *) getenv (evarname); else path = 0; if (!path) path = defalt; lpath = Qnil; while (1) { p = index (path, SEPCHAR); if (!p) p = path + strlen (path); lpath = Fcons (p - path ? make_string (path, p - path) : build_string ("."), lpath); if (*p) path = p + 1; else break; } return Fnreverse (lpath); } syms_of_emacs () { #ifndef CANNOT_DUMP #ifdef HAVE_SHM defsubr (&Sdump_emacs_data); #else defsubr (&Sdump_emacs); #endif #endif defsubr (&Skill_emacs); defsubr (&Sinvocation_name); defsubr (&Sinvocation_directory); DEFVAR_LISP ("command-line-args", &Vcommand_line_args, "Args passed by shell to Emacs, as a list of strings."); DEFVAR_LISP ("system-type", &Vsystem_type, "Value is symbol indicating type of operating system you are using."); Vsystem_type = intern (SYSTEM_TYPE); DEFVAR_LISP ("system-configuration", &Vsystem_configuration, "Value is string indicating configuration Emacs was built for."); Vsystem_configuration = build_string (EMACS_CONFIGURATION); DEFVAR_LISP ("system-configuration-options", &Vsystem_configuration_options, "String containing the configuration options Emacs was built with."); Vsystem_configuration_options = build_string (EMACS_CONFIG_OPTIONS); DEFVAR_BOOL ("noninteractive", &noninteractive1, "Non-nil means Emacs is running without interactive terminal."); DEFVAR_LISP ("kill-emacs-hook", &Vkill_emacs_hook, "Hook to be run whenever kill-emacs is called.\n\ Since kill-emacs may be invoked when the terminal is disconnected (or\n\ in other similar situations), functions placed on this hook should not\n\ expect to be able to interact with the user. To ask for confirmation,\n\ see `kill-emacs-query-functions' instead."); Vkill_emacs_hook = Qnil; DEFVAR_INT ("emacs-priority", &emacs_priority, "Priority for Emacs to run at.\n\ This value is effective only if set before Emacs is dumped,\n\ and only if the Emacs executable is installed with setuid to permit\n\ it to change priority. (Emacs sets its uid back to the real uid.)\n\ Currently, you need to define SET_EMACS_PRIORITY in `config.h'\n\ before you compile Emacs, to enable the code for this feature."); emacs_priority = 0; DEFVAR_LISP ("invocation-name", &Vinvocation_name, "The program name that was used to run Emacs.\n\ Any directory names are omitted."); DEFVAR_LISP ("invocation-directory", &Vinvocation_directory, "The directory in which the Emacs executable was found, to run it.\n\ The value is nil if that directory's name is not known."); DEFVAR_LISP ("installation-directory", &Vinstallation_directory, "A directory within which to look for the `lib-src' and `etc' directories.\n\ This is non-nil when we can't find those directories in their standard\n\ installed locations, but we can find them\n\ near where the Emacs executable was found."); Vinstallation_directory = Qnil; } emacs-19.30/src/eval.c100444 75424 1 232163 6050716046 13237 0ustar kwzhdaemon/* Evaluator for GNU Emacs Lisp interpreter. Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995 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. */ #include #include "lisp.h" #include "blockinput.h" #ifndef standalone #include "commands.h" #include "keyboard.h" #else #define INTERACTIVE 1 #endif #include /* This definition is duplicated in alloc.c and keyboard.c */ /* Putting it in lisp.h makes cc bomb out! */ struct backtrace { struct backtrace *next; Lisp_Object *function; Lisp_Object *args; /* Points to vector of args. */ int nargs; /* Length of vector. If nargs is UNEVALLED, args points to slot holding list of unevalled args */ char evalargs; /* Nonzero means call value of debugger when done with this operation. */ char debug_on_exit; }; struct backtrace *backtrace_list; /* This structure helps implement the `catch' and `throw' control structure. A struct catchtag contains all the information needed to restore the state of the interpreter after a non-local jump. Handlers for error conditions (represented by `struct handler' structures) just point to a catch tag to do the cleanup required for their jumps. catchtag structures are chained together in the C calling stack; the `next' member points to the next outer catchtag. A call like (throw TAG VAL) searches for a catchtag whose `tag' member is TAG, and then unbinds to it. The `val' member is used to hold VAL while the stack is unwound; `val' is returned as the value of the catch form. All the other members are concerned with restoring the interpreter state. */ struct catchtag { Lisp_Object tag; Lisp_Object val; struct catchtag *next; struct gcpro *gcpro; jmp_buf jmp; struct backtrace *backlist; struct handler *handlerlist; int lisp_eval_depth; int pdlcount; int poll_suppress_count; }; struct catchtag *catchlist; Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun; Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag; Lisp_Object Qmocklisp_arguments, Vmocklisp_arguments, Qmocklisp; Lisp_Object Qand_rest, Qand_optional; Lisp_Object Qdebug_on_error; Lisp_Object Vrun_hooks; /* Non-nil means record all fset's and provide's, to be undone if the file being autoloaded is not fully loaded. They are recorded by being consed onto the front of Vautoload_queue: (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide. */ Lisp_Object Vautoload_queue; /* Current number of specbindings allocated in specpdl. */ int specpdl_size; /* Pointer to beginning of specpdl. */ struct specbinding *specpdl; /* Pointer to first unused element in specpdl. */ struct specbinding *specpdl_ptr; /* Maximum size allowed for specpdl allocation */ int max_specpdl_size; /* Depth in Lisp evaluations and function calls. */ int lisp_eval_depth; /* Maximum allowed depth in Lisp evaluations and function calls. */ int max_lisp_eval_depth; /* Nonzero means enter debugger before next function call */ int debug_on_next_call; /* List of conditions (non-nil atom means all) which cause a backtrace if an error is handled by the command loop's error handler. */ Lisp_Object Vstack_trace_on_error; /* List of conditions (non-nil atom means all) which enter the debugger if an error is handled by the command loop's error handler. */ Lisp_Object Vdebug_on_error; /* Nonzero means enter debugger if a quit signal is handled by the command loop's error handler. */ int debug_on_quit; /* The value of num_nonmacro_input_chars as of the last time we started to enter the debugger. If we decide to enter the debugger again when this is still equal to num_nonmacro_input_chars, then we know that the debugger itself has an error, and we should just signal the error instead of entering an infinite loop of debugger invocations. */ int when_entered_debugger; Lisp_Object Vdebugger; void specbind (), record_unwind_protect (); Lisp_Object run_hook_with_args (); Lisp_Object funcall_lambda (); extern Lisp_Object ml_apply (); /* Apply a mocklisp function to unevaluated argument list */ init_eval_once () { specpdl_size = 50; specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding)); max_specpdl_size = 600; max_lisp_eval_depth = 200; Vrun_hooks = Qnil; } init_eval () { specpdl_ptr = specpdl; catchlist = 0; handlerlist = 0; backtrace_list = 0; Vquit_flag = Qnil; debug_on_next_call = 0; lisp_eval_depth = 0; /* This is less than the initial value of num_nonmacro_input_chars. */ when_entered_debugger = -1; } Lisp_Object call_debugger (arg) Lisp_Object arg; { if (lisp_eval_depth + 20 > max_lisp_eval_depth) max_lisp_eval_depth = lisp_eval_depth + 20; if (specpdl_size + 40 > max_specpdl_size) max_specpdl_size = specpdl_size + 40; debug_on_next_call = 0; when_entered_debugger = num_nonmacro_input_chars; return apply1 (Vdebugger, arg); } do_debug_on_call (code) Lisp_Object code; { debug_on_next_call = 0; backtrace_list->debug_on_exit = 1; call_debugger (Fcons (code, Qnil)); } /* NOTE!!! Every function that can call EVAL must protect its args and temporaries from garbage collection while it needs them. The definition of `For' shows what you have to do. */ DEFUN ("or", For, Sor, 0, UNEVALLED, 0, "Eval args until one of them yields non-nil, then return that value.\n\ The remaining args are not evalled at all.\n\ If all args return nil, return nil.") (args) Lisp_Object args; { register Lisp_Object val; Lisp_Object args_left; struct gcpro gcpro1; if (NILP(args)) return Qnil; args_left = args; GCPRO1 (args_left); do { val = Feval (Fcar (args_left)); if (!NILP (val)) break; args_left = Fcdr (args_left); } while (!NILP(args_left)); UNGCPRO; return val; } DEFUN ("and", Fand, Sand, 0, UNEVALLED, 0, "Eval args until one of them yields nil, then return nil.\n\ The remaining args are not evalled at all.\n\ If no arg yields nil, return the last arg's value.") (args) Lisp_Object args; { register Lisp_Object val; Lisp_Object args_left; struct gcpro gcpro1; if (NILP(args)) return Qt; args_left = args; GCPRO1 (args_left); do { val = Feval (Fcar (args_left)); if (NILP (val)) break; args_left = Fcdr (args_left); } while (!NILP(args_left)); UNGCPRO; return val; } DEFUN ("if", Fif, Sif, 2, UNEVALLED, 0, "(if COND THEN ELSE...): if COND yields non-nil, do THEN, else do ELSE...\n\ Returns the value of THEN or the value of the last of the ELSE's.\n\ THEN must be one expression, but ELSE... can be zero or more expressions.\n\ If COND yields nil, and there are no ELSE's, the value is nil.") (args) Lisp_Object args; { register Lisp_Object cond; struct gcpro gcpro1; GCPRO1 (args); cond = Feval (Fcar (args)); UNGCPRO; if (!NILP (cond)) return Feval (Fcar (Fcdr (args))); return Fprogn (Fcdr (Fcdr (args))); } DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0, "(cond CLAUSES...): try each clause until one succeeds.\n\ Each clause looks like (CONDITION BODY...). CONDITION is evaluated\n\ and, if the value is non-nil, this clause succeeds:\n\ then the expressions in BODY are evaluated and the last one's\n\ value is the value of the cond-form.\n\ If no clause succeeds, cond returns nil.\n\ If a clause has one element, as in (CONDITION),\n\ CONDITION's value if non-nil is returned from the cond-form.") (args) Lisp_Object args; { register Lisp_Object clause, val; struct gcpro gcpro1; val = Qnil; GCPRO1 (args); while (!NILP (args)) { clause = Fcar (args); val = Feval (Fcar (clause)); if (!NILP (val)) { if (!EQ (XCONS (clause)->cdr, Qnil)) val = Fprogn (XCONS (clause)->cdr); break; } args = XCONS (args)->cdr; } UNGCPRO; return val; } DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0, "(progn BODY...): eval BODY forms sequentially and return value of last one.") (args) Lisp_Object args; { register Lisp_Object val, tem; Lisp_Object args_left; struct gcpro gcpro1; /* In Mocklisp code, symbols at the front of the progn arglist are to be bound to zero. */ if (!EQ (Vmocklisp_arguments, Qt)) { val = make_number (0); while (!NILP (args) && (tem = Fcar (args), SYMBOLP (tem))) { QUIT; specbind (tem, val), args = Fcdr (args); } } if (NILP(args)) return Qnil; args_left = args; GCPRO1 (args_left); do { val = Feval (Fcar (args_left)); args_left = Fcdr (args_left); } while (!NILP(args_left)); UNGCPRO; return val; } DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0, "(prog1 FIRST BODY...): eval FIRST and BODY sequentially; value from FIRST.\n\ The value of FIRST is saved during the evaluation of the remaining args,\n\ whose values are discarded.") (args) Lisp_Object args; { Lisp_Object val; register Lisp_Object args_left; struct gcpro gcpro1, gcpro2; register int argnum = 0; if (NILP(args)) return Qnil; args_left = args; val = Qnil; GCPRO2 (args, val); do { if (!(argnum++)) val = Feval (Fcar (args_left)); else Feval (Fcar (args_left)); args_left = Fcdr (args_left); } while (!NILP(args_left)); UNGCPRO; return val; } DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0, "(prog2 X Y BODY...): eval X, Y and BODY sequentially; value from Y.\n\ The value of Y is saved during the evaluation of the remaining args,\n\ whose values are discarded.") (args) Lisp_Object args; { Lisp_Object val; register Lisp_Object args_left; struct gcpro gcpro1, gcpro2; register int argnum = -1; val = Qnil; if (NILP (args)) return Qnil; args_left = args; val = Qnil; GCPRO2 (args, val); do { if (!(argnum++)) val = Feval (Fcar (args_left)); else Feval (Fcar (args_left)); args_left = Fcdr (args_left); } while (!NILP (args_left)); UNGCPRO; return val; } DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0, "(setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL.\n\ The symbols SYM are variables; they are literal (not evaluated).\n\ The values VAL are expressions; they are evaluated.\n\ Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.\n\ The second VAL is not computed until after the first SYM is set, and so on;\n\ each VAL can use the new value of variables set earlier in the `setq'.\n\ The return value of the `setq' form is the value of the last VAL.") (args) Lisp_Object args; { register Lisp_Object args_left; register Lisp_Object val, sym; struct gcpro gcpro1; if (NILP(args)) return Qnil; args_left = args; GCPRO1 (args); do { val = Feval (Fcar (Fcdr (args_left))); sym = Fcar (args_left); Fset (sym, val); args_left = Fcdr (Fcdr (args_left)); } while (!NILP(args_left)); UNGCPRO; return val; } DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0, "Return the argument, without evaluating it. `(quote x)' yields `x'.") (args) Lisp_Object args; { return Fcar (args); } DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0, "Like `quote', but preferred for objects which are functions.\n\ In byte compilation, `function' causes its argument to be compiled.\n\ `quote' cannot do that.") (args) Lisp_Object args; { return Fcar (args); } DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0, "Return t if function in which this appears was called interactively.\n\ This means that the function was called with call-interactively (which\n\ includes being called as the binding of a key)\n\ and input is currently coming from the keyboard (not in keyboard macro).") () { register struct backtrace *btp; register Lisp_Object fun; if (!INTERACTIVE) return Qnil; btp = backtrace_list; /* If this isn't a byte-compiled function, there may be a frame at the top for Finteractive_p itself. If so, skip it. */ fun = Findirect_function (*btp->function); if (SUBRP (fun) && XSUBR (fun) == &Sinteractive_p) btp = btp->next; /* If we're running an Emacs 18-style byte-compiled function, there may be a frame for Fbytecode. Now, given the strictest definition, this function isn't really being called interactively, but because that's the way Emacs 18 always builds byte-compiled functions, we'll accept it for now. */ if (EQ (*btp->function, Qbytecode)) btp = btp->next; /* If this isn't a byte-compiled function, then we may now be looking at several frames for special forms. Skip past them. */ while (btp && btp->nargs == UNEVALLED) btp = btp->next; /* btp now points at the frame of the innermost function that isn't a special form, ignoring frames for Finteractive_p and/or Fbytecode at the top. If this frame is for a built-in function (such as load or eval-region) return nil. */ fun = Findirect_function (*btp->function); if (SUBRP (fun)) return Qnil; /* btp points to the frame of a Lisp function that called interactive-p. Return t if that function was called interactively. */ if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively)) return Qt; return Qnil; } DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0, "(defun NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.\n\ The definition is (lambda ARGLIST [DOCSTRING] BODY...).\n\ See also the function `interactive'.") (args) Lisp_Object args; { register Lisp_Object fn_name; register Lisp_Object defn; fn_name = Fcar (args); defn = Fcons (Qlambda, Fcdr (args)); if (!NILP (Vpurify_flag)) defn = Fpurecopy (defn); Ffset (fn_name, defn); LOADHIST_ATTACH (fn_name); return fn_name; } DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0, "(defmacro NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.\n\ The definition is (macro lambda ARGLIST [DOCSTRING] BODY...).\n\ When the macro is called, as in (NAME ARGS...),\n\ the function (lambda ARGLIST BODY...) is applied to\n\ the list ARGS... as it appears in the expression,\n\ and the result should be a form to be evaluated instead of the original.") (args) Lisp_Object args; { register Lisp_Object fn_name; register Lisp_Object defn; fn_name = Fcar (args); defn = Fcons (Qmacro, Fcons (Qlambda, Fcdr (args))); if (!NILP (Vpurify_flag)) defn = Fpurecopy (defn); Ffset (fn_name, defn); LOADHIST_ATTACH (fn_name); return fn_name; } DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0, "(defvar SYMBOL INITVALUE DOCSTRING): define SYMBOL as a variable.\n\ You are not required to define a variable in order to use it,\n\ but the definition can supply documentation and an initial value\n\ in a way that tags can recognize.\n\n\ INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.\n\ If SYMBOL is buffer-local, its default value is what is set;\n\ buffer-local values are not affected.\n\ INITVALUE and DOCSTRING are optional.\n\ If DOCSTRING starts with *, this variable is identified as a user option.\n\ This means that M-x set-variable and M-x edit-options recognize it.\n\ If INITVALUE is missing, SYMBOL's value is not set.") (args) Lisp_Object args; { register Lisp_Object sym, tem, tail; sym = Fcar (args); tail = Fcdr (args); if (!NILP (Fcdr (Fcdr (tail)))) error ("too many arguments"); if (!NILP (tail)) { tem = Fdefault_boundp (sym); if (NILP (tem)) Fset_default (sym, Feval (Fcar (Fcdr (args)))); } tail = Fcdr (Fcdr (args)); if (!NILP (Fcar (tail))) { tem = Fcar (tail); if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fput (sym, Qvariable_documentation, tem); } LOADHIST_ATTACH (sym); return sym; } DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0, "(defconst SYMBOL INITVALUE DOCSTRING): define SYMBOL as a constant variable.\n\ The intent is that programs do not change this value, but users may.\n\ Always sets the value of SYMBOL to the result of evalling INITVALUE.\n\ If SYMBOL is buffer-local, its default value is what is set;\n\ buffer-local values are not affected.\n\ DOCSTRING is optional.\n\ If DOCSTRING starts with *, this variable is identified as a user option.\n\ This means that M-x set-variable and M-x edit-options recognize it.\n\n\ Note: do not use `defconst' for user options in libraries that are not\n\ normally loaded, since it is useful for users to be able to specify\n\ their own values for such variables before loading the library.\n\ Since `defconst' unconditionally assigns the variable,\n\ it would override the user's choice.") (args) Lisp_Object args; { register Lisp_Object sym, tem; sym = Fcar (args); if (!NILP (Fcdr (Fcdr (Fcdr (args))))) error ("too many arguments"); Fset_default (sym, Feval (Fcar (Fcdr (args)))); tem = Fcar (Fcdr (Fcdr (args))); if (!NILP (tem)) { if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fput (sym, Qvariable_documentation, tem); } LOADHIST_ATTACH (sym); return sym; } DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0, "Returns t if VARIABLE is intended to be set and modified by users.\n\ \(The alternative is a variable used internally in a Lisp program.)\n\ Determined by whether the first character of the documentation\n\ for the variable is `*'.") (variable) Lisp_Object variable; { Lisp_Object documentation; documentation = Fget (variable, Qvariable_documentation); if (INTEGERP (documentation) && XINT (documentation) < 0) return Qt; if (STRINGP (documentation) && ((unsigned char) XSTRING (documentation)->data[0] == '*')) return Qt; /* If it is (STRING . INTEGER), a negative integer means a user variable. */ if (CONSP (documentation) && STRINGP (XCONS (documentation)->car) && INTEGERP (XCONS (documentation)->cdr) && XINT (XCONS (documentation)->cdr) < 0) return Qt; return Qnil; } DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0, "(let* VARLIST BODY...): bind variables according to VARLIST then eval BODY.\n\ The value of the last form in BODY is returned.\n\ Each element of VARLIST is a symbol (which is bound to nil)\n\ or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\ Each VALUEFORM can refer to the symbols already bound by this VARLIST.") (args) Lisp_Object args; { Lisp_Object varlist, val, elt; int count = specpdl_ptr - specpdl; struct gcpro gcpro1, gcpro2, gcpro3; GCPRO3 (args, elt, varlist); varlist = Fcar (args); while (!NILP (varlist)) { QUIT; elt = Fcar (varlist); if (SYMBOLP (elt)) specbind (elt, Qnil); else if (! NILP (Fcdr (Fcdr (elt)))) Fsignal (Qerror, Fcons (build_string ("`let' bindings can have only one value-form"), elt)); else { val = Feval (Fcar (Fcdr (elt))); specbind (Fcar (elt), val); } varlist = Fcdr (varlist); } UNGCPRO; val = Fprogn (Fcdr (args)); return unbind_to (count, val); } DEFUN ("let", Flet, Slet, 1, UNEVALLED, 0, "(let VARLIST BODY...): bind variables according to VARLIST then eval BODY.\n\ The value of the last form in BODY is returned.\n\ Each element of VARLIST is a symbol (which is bound to nil)\n\ or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\ All the VALUEFORMs are evalled before any symbols are bound.") (args) Lisp_Object args; { Lisp_Object *temps, tem; register Lisp_Object elt, varlist; int count = specpdl_ptr - specpdl; register int argnum; struct gcpro gcpro1, gcpro2; varlist = Fcar (args); /* Make space to hold the values to give the bound variables */ elt = Flength (varlist); temps = (Lisp_Object *) alloca (XFASTINT (elt) * sizeof (Lisp_Object)); /* Compute the values and store them in `temps' */ GCPRO2 (args, *temps); gcpro2.nvars = 0; for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist)) { QUIT; elt = Fcar (varlist); if (SYMBOLP (elt)) temps [argnum++] = Qnil; else if (! NILP (Fcdr (Fcdr (elt)))) Fsignal (Qerror, Fcons (build_string ("`let' bindings can have only one value-form"), elt)); else temps [argnum++] = Feval (Fcar (Fcdr (elt))); gcpro2.nvars = argnum; } UNGCPRO; varlist = Fcar (args); for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist)) { elt = Fcar (varlist); tem = temps[argnum++]; if (SYMBOLP (elt)) specbind (elt, tem); else specbind (Fcar (elt), tem); } elt = Fprogn (Fcdr (args)); return unbind_to (count, elt); } DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0, "(while TEST BODY...): if TEST yields non-nil, eval BODY... and repeat.\n\ The order of execution is thus TEST, BODY, TEST, BODY and so on\n\ until TEST returns nil.") (args) Lisp_Object args; { Lisp_Object test, body, tem; struct gcpro gcpro1, gcpro2; GCPRO2 (test, body); test = Fcar (args); body = Fcdr (args); while (tem = Feval (test), (!EQ (Vmocklisp_arguments, Qt) ? XINT (tem) : !NILP (tem))) { QUIT; Fprogn (body); } UNGCPRO; return Qnil; } DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0, "Return result of expanding macros at top level of FORM.\n\ If FORM is not a macro call, it is returned unchanged.\n\ Otherwise, the macro is expanded and the expansion is considered\n\ in place of FORM. When a non-macro-call results, it is returned.\n\n\ The second optional arg ENVIRONMENT species an environment of macro\n\ definitions to shadow the loaded ones for use in file byte-compilation.") (form, env) register Lisp_Object form; Lisp_Object env; { /* With cleanups from Hallvard Furuseth. */ register Lisp_Object expander, sym, def, tem; while (1) { /* Come back here each time we expand a macro call, in case it expands into another macro call. */ if (!CONSP (form)) break; /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */ def = sym = XCONS (form)->car; tem = Qnil; /* Trace symbols aliases to other symbols until we get a symbol that is not an alias. */ while (SYMBOLP (def)) { QUIT; sym = def; tem = Fassq (sym, env); if (NILP (tem)) { def = XSYMBOL (sym)->function; if (!EQ (def, Qunbound)) continue; } break; } /* Right now TEM is the result from SYM in ENV, and if TEM is nil then DEF is SYM's function definition. */ if (NILP (tem)) { /* SYM is not mentioned in ENV. Look at its function definition. */ if (EQ (def, Qunbound) || !CONSP (def)) /* Not defined or definition not suitable */ break; if (EQ (XCONS (def)->car, Qautoload)) { /* Autoloading function: will it be a macro when loaded? */ tem = Fnth (make_number (4), def); if (EQ (tem, Qt) || EQ (tem, Qmacro)) /* Yes, load it and try again. */ { do_autoload (def, sym); continue; } else break; } else if (!EQ (XCONS (def)->car, Qmacro)) break; else expander = XCONS (def)->cdr; } else { expander = XCONS (tem)->cdr; if (NILP (expander)) break; } form = apply1 (expander, XCONS (form)->cdr); } return form; } DEFUN ("catch", Fcatch, Scatch, 1, UNEVALLED, 0, "(catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'.\n\ TAG is evalled to get the tag to use. Then the BODY is executed.\n\ Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.\n\ If no throw happens, `catch' returns the value of the last BODY form.\n\ If a throw happens, it specifies the value to return from `catch'.") (args) Lisp_Object args; { register Lisp_Object tag; struct gcpro gcpro1; GCPRO1 (args); tag = Feval (Fcar (args)); UNGCPRO; return internal_catch (tag, Fprogn, Fcdr (args)); } /* Set up a catch, then call C function FUNC on argument ARG. FUNC should return a Lisp_Object. This is how catches are done from within C code. */ Lisp_Object internal_catch (tag, func, arg) Lisp_Object tag; Lisp_Object (*func) (); Lisp_Object arg; { /* This structure is made part of the chain `catchlist'. */ struct catchtag c; /* Fill in the components of c, and put it on the list. */ c.next = catchlist; c.tag = tag; c.val = Qnil; c.backlist = backtrace_list; c.handlerlist = handlerlist; c.lisp_eval_depth = lisp_eval_depth; c.pdlcount = specpdl_ptr - specpdl; c.poll_suppress_count = poll_suppress_count; c.gcpro = gcprolist; catchlist = &c; /* Call FUNC. */ if (! _setjmp (c.jmp)) c.val = (*func) (arg); /* Throw works by a longjmp that comes right here. */ catchlist = c.next; return c.val; } /* Unwind the specbind, catch, and handler stacks back to CATCH, and jump to that CATCH, returning VALUE as the value of that catch. This is the guts Fthrow and Fsignal; they differ only in the way they choose the catch tag to throw to. A catch tag for a condition-case form has a TAG of Qnil. Before each catch is discarded, unbind all special bindings and execute all unwind-protect clauses made above that catch. Unwind the handler stack as we go, so that the proper handlers are in effect for each unwind-protect clause we run. At the end, restore some static info saved in CATCH, and longjmp to the location specified in the This is used for correct unwinding in Fthrow and Fsignal. */ static void unwind_to_catch (catch, value) struct catchtag *catch; Lisp_Object value; { register int last_time; /* Save the value in the tag. */ catch->val = value; /* Restore the polling-suppression count. */ set_poll_suppress_count (catch->poll_suppress_count); do { last_time = catchlist == catch; /* Unwind the specpdl stack, and then restore the proper set of handlers. */ unbind_to (catchlist->pdlcount, Qnil); handlerlist = catchlist->handlerlist; catchlist = catchlist->next; } while (! last_time); gcprolist = catch->gcpro; backtrace_list = catch->backlist; lisp_eval_depth = catch->lisp_eval_depth; _longjmp (catch->jmp, 1); } DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0, "(throw TAG VALUE): throw to the catch for TAG and return VALUE from it.\n\ Both TAG and VALUE are evalled.") (tag, val) register Lisp_Object tag, val; { register struct catchtag *c; while (1) { if (!NILP (tag)) for (c = catchlist; c; c = c->next) { if (EQ (c->tag, tag)) unwind_to_catch (c, val); } tag = Fsignal (Qno_catch, Fcons (tag, Fcons (val, Qnil))); } } DEFUN ("unwind-protect", Funwind_protect, Sunwind_protect, 1, UNEVALLED, 0, "Do BODYFORM, protecting with UNWINDFORMS.\n\ Usage looks like (unwind-protect BODYFORM UNWINDFORMS...).\n\ If BODYFORM completes normally, its value is returned\n\ after executing the UNWINDFORMS.\n\ If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.") (args) Lisp_Object args; { Lisp_Object val; int count = specpdl_ptr - specpdl; record_unwind_protect (0, Fcdr (args)); val = Feval (Fcar (args)); return unbind_to (count, val); } /* Chain of condition handlers currently in effect. The elements of this chain are contained in the stack frames of Fcondition_case and internal_condition_case. When an error is signaled (by calling Fsignal, below), this chain is searched for an element that applies. */ struct handler *handlerlist; DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0, "Regain control when an error is signaled.\n\ Usage looks like (condition-case VAR BODYFORM HANDLERS...).\n\ executes BODYFORM and returns its value if no error happens.\n\ Each element of HANDLERS looks like (CONDITION-NAME BODY...)\n\ where the BODY is made of Lisp expressions.\n\n\ A handler is applicable to an error\n\ if CONDITION-NAME is one of the error's condition names.\n\ If an error happens, the first applicable handler is run.\n\ \n\ The car of a handler may be a list of condition names\n\ instead of a single condition name.\n\ \n\ When a handler handles an error,\n\ control returns to the condition-case and the handler BODY... is executed\n\ with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).\n\ VAR may be nil; then you do not get access to the signal information.\n\ \n\ The value of the last BODY form is returned from the condition-case.\n\ See also the function `signal' for more info.") (args) Lisp_Object args; { Lisp_Object val; struct catchtag c; struct handler h; register Lisp_Object var, bodyform, handlers; var = Fcar (args); bodyform = Fcar (Fcdr (args)); handlers = Fcdr (Fcdr (args)); CHECK_SYMBOL (var, 0); for (val = handlers; ! NILP (val); val = Fcdr (val)) { Lisp_Object tem; tem = Fcar (val); if (! (NILP (tem) || (CONSP (tem) && (SYMBOLP (XCONS (tem)->car) || CONSP (XCONS (tem)->car))))) error ("Invalid condition handler", tem); } c.tag = Qnil; c.val = Qnil; c.backlist = backtrace_list; c.handlerlist = handlerlist; c.lisp_eval_depth = lisp_eval_depth; c.pdlcount = specpdl_ptr - specpdl; c.poll_suppress_count = poll_suppress_count; c.gcpro = gcprolist; if (_setjmp (c.jmp)) { if (!NILP (h.var)) specbind (h.var, c.val); val = Fprogn (Fcdr (h.chosen_clause)); /* Note that this just undoes the binding of h.var; whoever longjumped to us unwound the stack to c.pdlcount before throwing. */ unbind_to (c.pdlcount, Qnil); return val; } c.next = catchlist; catchlist = &c; h.var = var; h.handler = handlers; h.next = handlerlist; h.tag = &c; handlerlist = &h; val = Feval (bodyform); catchlist = c.next; handlerlist = h.next; return val; } Lisp_Object internal_condition_case (bfun, handlers, hfun) Lisp_Object (*bfun) (); Lisp_Object handlers; Lisp_Object (*hfun) (); { Lisp_Object val; struct catchtag c; struct handler h; /* Since Fsignal resets this to 0, it had better be 0 now or else we have a potential bug. */ if (interrupt_input_blocked != 0) abort (); c.tag = Qnil; c.val = Qnil; c.backlist = backtrace_list; c.handlerlist = handlerlist; c.lisp_eval_depth = lisp_eval_depth; c.pdlcount = specpdl_ptr - specpdl; c.poll_suppress_count = poll_suppress_count; c.gcpro = gcprolist; if (_setjmp (c.jmp)) { return (*hfun) (c.val); } c.next = catchlist; catchlist = &c; h.handler = handlers; h.var = Qnil; h.next = handlerlist; h.tag = &c; handlerlist = &h; val = (*bfun) (); catchlist = c.next; handlerlist = h.next; return val; } Lisp_Object internal_condition_case_1 (bfun, arg, handlers, hfun) Lisp_Object (*bfun) (); Lisp_Object arg; Lisp_Object handlers; Lisp_Object (*hfun) (); { Lisp_Object val; struct catchtag c; struct handler h; c.tag = Qnil; c.val = Qnil; c.backlist = backtrace_list; c.handlerlist = handlerlist; c.lisp_eval_depth = lisp_eval_depth; c.pdlcount = specpdl_ptr - specpdl; c.poll_suppress_count = poll_suppress_count; c.gcpro = gcprolist; if (_setjmp (c.jmp)) { return (*hfun) (c.val); } c.next = catchlist; catchlist = &c; h.handler = handlers; h.var = Qnil; h.next = handlerlist; h.tag = &c; handlerlist = &h; val = (*bfun) (arg); catchlist = c.next; handlerlist = h.next; return val; } static Lisp_Object find_handler_clause (); DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, "Signal an error. Args are ERROR-SYMBOL and associated DATA.\n\ This function does not return.\n\n\ An error symbol is a symbol with an `error-conditions' property\n\ that is a list of condition names.\n\ A handler for any of those names will get to handle this signal.\n\ The symbol `error' should normally be one of them.\n\ \n\ DATA should be a list. Its elements are printed as part of the error message.\n\ If the signal is handled, DATA is made available to the handler.\n\ See also the function `condition-case'.") (error_symbol, data) Lisp_Object error_symbol, data; { register struct handler *allhandlers = handlerlist; Lisp_Object conditions; extern int gc_in_progress; extern int waiting_for_input; Lisp_Object debugger_value; quit_error_check (); immediate_quit = 0; if (gc_in_progress || waiting_for_input) abort (); #ifdef HAVE_X_WINDOWS TOTALLY_UNBLOCK_INPUT; #endif conditions = Fget (error_symbol, Qerror_conditions); for (; handlerlist; handlerlist = handlerlist->next) { register Lisp_Object clause; clause = find_handler_clause (handlerlist->handler, conditions, error_symbol, data, &debugger_value); #if 0 /* Most callers are not prepared to handle gc if this returns. So, since this feature is not very useful, take it out. */ /* If have called debugger and user wants to continue, just return nil. */ if (EQ (clause, Qlambda)) return debugger_value; #else if (EQ (clause, Qlambda)) { /* We can't return values to code which signalled an error, but we can continue code which has signalled a quit. */ if (EQ (error_symbol, Qquit)) return Qnil; else error ("Cannot return from the debugger in an error"); } #endif if (!NILP (clause)) { Lisp_Object unwind_data; struct handler *h = handlerlist; handlerlist = allhandlers; if (EQ (data, memory_signal_data)) unwind_data = memory_signal_data; else unwind_data = Fcons (error_symbol, data); h->chosen_clause = clause; unwind_to_catch (h->tag, unwind_data); } } handlerlist = allhandlers; /* If no handler is present now, try to run the debugger, and if that fails, throw to top level. */ find_handler_clause (Qerror, conditions, error_symbol, data, &debugger_value); Fthrow (Qtop_level, Qt); } /* Return nonzero iff LIST is a non-nil atom or a list containing one of CONDITIONS. */ static int wants_debugger (list, conditions) Lisp_Object list, conditions; { if (NILP (list)) return 0; if (! CONSP (list)) return 1; while (CONSP (conditions)) { Lisp_Object this, tail; this = XCONS (conditions)->car; for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr) if (EQ (XCONS (tail)->car, this)) return 1; conditions = XCONS (conditions)->cdr; } return 0; } /* Value of Qlambda means we have called debugger and user has continued. Store value returned from debugger into *DEBUGGER_VALUE_PTR. */ static Lisp_Object find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) Lisp_Object handlers, conditions, sig, data; Lisp_Object *debugger_value_ptr; { register Lisp_Object h; register Lisp_Object tem; if (EQ (handlers, Qt)) /* t is used by handlers for all conditions, set up by C code. */ return Qt; if (EQ (handlers, Qerror)) /* error is used similarly, but means display a backtrace too */ { if (wants_debugger (Vstack_trace_on_error, conditions)) internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace, Qnil); if ((EQ (sig, Qquit) ? debug_on_quit : wants_debugger (Vdebug_on_error, conditions)) && when_entered_debugger < num_nonmacro_input_chars) { int count = specpdl_ptr - specpdl; specbind (Qdebug_on_error, Qnil); *debugger_value_ptr = call_debugger (Fcons (Qerror, Fcons (Fcons (sig, data), Qnil))); return unbind_to (count, Qlambda); } return Qt; } for (h = handlers; CONSP (h); h = Fcdr (h)) { Lisp_Object handler, condit; handler = Fcar (h); if (!CONSP (handler)) continue; condit = Fcar (handler); /* Handle a single condition name in handler HANDLER. */ if (SYMBOLP (condit)) { tem = Fmemq (Fcar (handler), conditions); if (!NILP (tem)) return handler; } /* Handle a list of condition names in handler HANDLER. */ else if (CONSP (condit)) { while (CONSP (condit)) { tem = Fmemq (Fcar (condit), conditions); if (!NILP (tem)) return handler; condit = XCONS (condit)->cdr; } } } return Qnil; } /* dump an error message; called like printf */ /* VARARGS 1 */ void error (m, a1, a2, a3) char *m; char *a1, *a2, *a3; { char buf[200]; int size = 200; int mlen; char *buffer = buf; char *args[3]; int allocated = 0; Lisp_Object string; args[0] = a1; args[1] = a2; args[2] = a3; mlen = strlen (m); while (1) { int used = doprnt (buf, size, m, m + mlen, 3, args); if (used < size) break; size *= 2; if (allocated) buffer = (char *) xrealloc (buffer, size); else { buffer = (char *) xmalloc (size); allocated = 1; } } string = build_string (buf); if (allocated) free (buffer); Fsignal (Qerror, Fcons (string, Qnil)); } DEFUN ("commandp", Fcommandp, Scommandp, 1, 1, 0, "T if FUNCTION makes provisions for interactive calling.\n\ This means it contains a description for how to read arguments to give it.\n\ The value is nil for an invalid function or a symbol with no function\n\ definition.\n\ \n\ Interactively callable functions include strings and vectors (treated\n\ as keyboard macros), lambda-expressions that contain a top-level call\n\ to `interactive', autoload definitions made by `autoload' with non-nil\n\ fourth argument, and some of the built-in functions of Lisp.\n\ \n\ Also, a symbol satisfies `commandp' if its function definition does so.") (function) Lisp_Object function; { register Lisp_Object fun; register Lisp_Object funcar; register Lisp_Object tem; register int i = 0; fun = function; fun = indirect_function (fun); if (EQ (fun, Qunbound)) return Qnil; /* Emacs primitives are interactive if their DEFUN specifies an interactive spec. */ if (SUBRP (fun)) { if (XSUBR (fun)->prompt) return Qt; else return Qnil; } /* Bytecode objects are interactive if they are long enough to have an element whose index is COMPILED_INTERACTIVE, which is where the interactive spec is stored. */ else if (COMPILEDP (fun)) return ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE ? Qt : Qnil); /* Strings and vectors are keyboard macros. */ if (STRINGP (fun) || VECTORP (fun)) return Qt; /* Lists may represent commands. */ if (!CONSP (fun)) return Qnil; funcar = Fcar (fun); if (!SYMBOLP (funcar)) return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); if (EQ (funcar, Qlambda)) return Fassq (Qinteractive, Fcdr (Fcdr (fun))); if (EQ (funcar, Qmocklisp)) return Qt; /* All mocklisp functions can be called interactively */ if (EQ (funcar, Qautoload)) return Fcar (Fcdr (Fcdr (Fcdr (fun)))); else return Qnil; } /* ARGSUSED */ DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0, "Define FUNCTION to autoload from FILE.\n\ FUNCTION is a symbol; FILE is a file name string to pass to `load'.\n\ Third arg DOCSTRING is documentation for the function.\n\ Fourth arg INTERACTIVE if non-nil says function can be called interactively.\n\ Fifth arg TYPE indicates the type of the object:\n\ nil or omitted says FUNCTION is a function,\n\ `keymap' says FUNCTION is really a keymap, and\n\ `macro' or t says FUNCTION is really a macro.\n\ Third through fifth args give info about the real definition.\n\ They default to nil.\n\ If FUNCTION is already defined other than as an autoload,\n\ this does nothing and returns nil.") (function, file, docstring, interactive, type) Lisp_Object function, file, docstring, interactive, type; { #ifdef NO_ARG_ARRAY Lisp_Object args[4]; #endif CHECK_SYMBOL (function, 0); CHECK_STRING (file, 1); /* If function is defined and not as an autoload, don't override */ if (!EQ (XSYMBOL (function)->function, Qunbound) && !(CONSP (XSYMBOL (function)->function) && EQ (XCONS (XSYMBOL (function)->function)->car, Qautoload))) return Qnil; #ifdef NO_ARG_ARRAY args[0] = file; args[1] = docstring; args[2] = interactive; args[3] = type; return Ffset (function, Fcons (Qautoload, Flist (4, &args[0]))); #else /* NO_ARG_ARRAY */ return Ffset (function, Fcons (Qautoload, Flist (4, &file))); #endif /* not NO_ARG_ARRAY */ } Lisp_Object un_autoload (oldqueue) Lisp_Object oldqueue; { register Lisp_Object queue, first, second; /* Queue to unwind is current value of Vautoload_queue. oldqueue is the shadowed value to leave in Vautoload_queue. */ queue = Vautoload_queue; Vautoload_queue = oldqueue; while (CONSP (queue)) { first = Fcar (queue); second = Fcdr (first); first = Fcar (first); if (EQ (second, Qnil)) Vfeatures = first; else Ffset (first, second); queue = Fcdr (queue); } return Qnil; } do_autoload (fundef, funname) Lisp_Object fundef, funname; { int count = specpdl_ptr - specpdl; Lisp_Object fun, val, queue, first, second; fun = funname; CHECK_SYMBOL (funname, 0); /* Value saved here is to be restored into Vautoload_queue */ record_unwind_protect (un_autoload, Vautoload_queue); Vautoload_queue = Qt; Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil); /* Save the old autoloads, in case we ever do an unload. */ queue = Vautoload_queue; while (CONSP (queue)) { first = Fcar (queue); second = Fcdr (first); first = Fcar (first); /* Note: This test is subtle. The cdr of an autoload-queue entry may be an atom if the autoload entry was generated by a defalias or fset. */ if (CONSP (second)) Fput (first, Qautoload, (Fcdr (second))); queue = Fcdr (queue); } /* Once loading finishes, don't undo it. */ Vautoload_queue = Qt; unbind_to (count, Qnil); fun = Findirect_function (fun); if (!NILP (Fequal (fun, fundef))) error ("Autoloading failed to define function %s", XSYMBOL (funname)->name->data); } DEFUN ("eval", Feval, Seval, 1, 1, 0, "Evaluate FORM and return its value.") (form) Lisp_Object form; { Lisp_Object fun, val, original_fun, original_args; Lisp_Object funcar; struct backtrace backtrace; struct gcpro gcpro1, gcpro2, gcpro3; if (SYMBOLP (form)) { if (EQ (Vmocklisp_arguments, Qt)) return Fsymbol_value (form); val = Fsymbol_value (form); if (NILP (val)) XSETFASTINT (val, 0); else if (EQ (val, Qt)) XSETFASTINT (val, 1); return val; } if (!CONSP (form)) return form; QUIT; if (consing_since_gc > gc_cons_threshold) { GCPRO1 (form); Fgarbage_collect (); UNGCPRO; } if (++lisp_eval_depth > max_lisp_eval_depth) { if (max_lisp_eval_depth < 100) max_lisp_eval_depth = 100; if (lisp_eval_depth > max_lisp_eval_depth) error ("Lisp nesting exceeds max-lisp-eval-depth"); } original_fun = Fcar (form); original_args = Fcdr (form); backtrace.next = backtrace_list; backtrace_list = &backtrace; backtrace.function = &original_fun; /* This also protects them from gc */ backtrace.args = &original_args; backtrace.nargs = UNEVALLED; backtrace.evalargs = 1; backtrace.debug_on_exit = 0; if (debug_on_next_call) do_debug_on_call (Qt); /* At this point, only original_fun and original_args have values that will be used below */ retry: fun = Findirect_function (original_fun); if (SUBRP (fun)) { Lisp_Object numargs; Lisp_Object argvals[7]; Lisp_Object args_left; register int i, maxargs; args_left = original_args; numargs = Flength (args_left); if (XINT (numargs) < XSUBR (fun)->min_args || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs))) return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil))); if (XSUBR (fun)->max_args == UNEVALLED) { backtrace.evalargs = 0; val = (*XSUBR (fun)->function) (args_left); goto done; } if (XSUBR (fun)->max_args == MANY) { /* Pass a vector of evaluated arguments */ Lisp_Object *vals; register int argnum = 0; vals = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object)); GCPRO3 (args_left, fun, fun); gcpro3.var = vals; gcpro3.nvars = 0; while (!NILP (args_left)) { vals[argnum++] = Feval (Fcar (args_left)); args_left = Fcdr (args_left); gcpro3.nvars = argnum; } backtrace.args = vals; backtrace.nargs = XINT (numargs); val = (*XSUBR (fun)->function) (XINT (numargs), vals); UNGCPRO; goto done; } GCPRO3 (args_left, fun, fun); gcpro3.var = argvals; gcpro3.nvars = 0; maxargs = XSUBR (fun)->max_args; for (i = 0; i < maxargs; args_left = Fcdr (args_left)) { argvals[i] = Feval (Fcar (args_left)); gcpro3.nvars = ++i; } UNGCPRO; backtrace.args = argvals; backtrace.nargs = XINT (numargs); switch (i) { case 0: val = (*XSUBR (fun)->function) (); goto done; case 1: val = (*XSUBR (fun)->function) (argvals[0]); goto done; case 2: val = (*XSUBR (fun)->function) (argvals[0], argvals[1]); goto done; case 3: val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2]); goto done; case 4: val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2], argvals[3]); goto done; case 5: val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2], argvals[3], argvals[4]); goto done; case 6: val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2], argvals[3], argvals[4], argvals[5]); goto done; case 7: val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2], argvals[3], argvals[4], argvals[5], argvals[6]); goto done; default: /* Someone has created a subr that takes more arguments than is supported by this code. We need to either rewrite the subr to use a different argument protocol, or add more cases to this switch. */ abort (); } } if (COMPILEDP (fun)) val = apply_lambda (fun, original_args, 1); else { if (!CONSP (fun)) return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); funcar = Fcar (fun); if (!SYMBOLP (funcar)) return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); if (EQ (funcar, Qautoload)) { do_autoload (fun, original_fun); goto retry; } if (EQ (funcar, Qmacro)) val = Feval (apply1 (Fcdr (fun), original_args)); else if (EQ (funcar, Qlambda)) val = apply_lambda (fun, original_args, 1); else if (EQ (funcar, Qmocklisp)) val = ml_apply (fun, original_args); else return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); } done: if (!EQ (Vmocklisp_arguments, Qt)) { if (NILP (val)) XSETFASTINT (val, 0); else if (EQ (val, Qt)) XSETFASTINT (val, 1); } lisp_eval_depth--; if (backtrace.debug_on_exit) val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); backtrace_list = backtrace.next; return val; } DEFUN ("apply", Fapply, Sapply, 2, MANY, 0, "Call FUNCTION with our remaining args, using our last arg as list of args.\n\ Then return the value FUNCTION returns.\n\ Thus, (apply '+ 1 2 '(3 4)) returns 10.") (nargs, args) int nargs; Lisp_Object *args; { register int i, numargs; register Lisp_Object spread_arg; register Lisp_Object *funcall_args; Lisp_Object fun; struct gcpro gcpro1; fun = args [0]; funcall_args = 0; spread_arg = args [nargs - 1]; CHECK_LIST (spread_arg, nargs); numargs = XINT (Flength (spread_arg)); if (numargs == 0) return Ffuncall (nargs - 1, args); else if (numargs == 1) { args [nargs - 1] = XCONS (spread_arg)->car; return Ffuncall (nargs, args); } numargs += nargs - 2; fun = indirect_function (fun); if (EQ (fun, Qunbound)) { /* Let funcall get the error */ fun = args[0]; goto funcall; } if (SUBRP (fun)) { if (numargs < XSUBR (fun)->min_args || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) goto funcall; /* Let funcall get the error */ else if (XSUBR (fun)->max_args > numargs) { /* Avoid making funcall cons up a yet another new vector of arguments by explicitly supplying nil's for optional values */ funcall_args = (Lisp_Object *) alloca ((1 + XSUBR (fun)->max_args) * sizeof (Lisp_Object)); for (i = numargs; i < XSUBR (fun)->max_args;) funcall_args[++i] = Qnil; GCPRO1 (*funcall_args); gcpro1.nvars = 1 + XSUBR (fun)->max_args; } } funcall: /* We add 1 to numargs because funcall_args includes the function itself as well as its arguments. */ if (!funcall_args) { funcall_args = (Lisp_Object *) alloca ((1 + numargs) * sizeof (Lisp_Object)); GCPRO1 (*funcall_args); gcpro1.nvars = 1 + numargs; } bcopy (args, funcall_args, nargs * sizeof (Lisp_Object)); /* Spread the last arg we got. Its first element goes in the slot that it used to occupy, hence this value of I. */ i = nargs - 1; while (!NILP (spread_arg)) { funcall_args [i++] = XCONS (spread_arg)->car; spread_arg = XCONS (spread_arg)->cdr; } RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args)); } /* Run hook variables in various ways. */ enum run_hooks_condition {to_completion, until_success, until_failure}; DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 1, MANY, 0, "Run each hook in HOOKS. Major mode functions use this.\n\ Each argument should be a symbol, a hook variable.\n\ These symbols are processed in the order specified.\n\ If a hook symbol has a non-nil value, that value may be a function\n\ or a list of functions to be called to run the hook.\n\ If the value is a function, it is called with no arguments.\n\ If it is a list, the elements are called, in order, with no arguments.\n\ \n\ To make a hook variable buffer-local, use `make-local-hook',\n\ not `make-local-variable'.") (nargs, args) int nargs; Lisp_Object *args; { Lisp_Object hook[1]; register int i; for (i = 0; i < nargs; i++) { hook[0] = args[i]; run_hook_with_args (1, hook, to_completion); } return Qnil; } DEFUN ("run-hook-with-args", Frun_hook_with_args, Srun_hook_with_args, 1, MANY, 0, "Run HOOK with the specified arguments ARGS.\n\ HOOK should be a symbol, a hook variable. If HOOK has a non-nil\n\ value, that value may be a function or a list of functions to be\n\ called to run the hook. If the value is a function, it is called with\n\ the given arguments and its return value is returned. If it is a list\n\ of functions, those functions are called, in order,\n\ with the given arguments ARGS.\n\ It is best not to depend on the value return by `run-hook-with-args',\n\ as that may change.\n\ \n\ To make a hook variable buffer-local, use `make-local-hook',\n\ not `make-local-variable'.") (nargs, args) int nargs; Lisp_Object *args; { return run_hook_with_args (nargs, args, to_completion); } DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success, Srun_hook_with_args_until_success, 1, MANY, 0, "Run HOOK with the specified arguments ARGS.\n\ HOOK should be a symbol, a hook variable. Its value should\n\ be a list of functions. We call those functions, one by one,\n\ passing arguments ARGS to each of them, until one of them\n\ returns a non-nil value. Then we return that value.\n\ If all the functions return nil, we return nil.\n\ \n\ To make a hook variable buffer-local, use `make-local-hook',\n\ not `make-local-variable'.") (nargs, args) int nargs; Lisp_Object *args; { return run_hook_with_args (nargs, args, until_success); } DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure, Srun_hook_with_args_until_failure, 1, MANY, 0, "Run HOOK with the specified arguments ARGS.\n\ HOOK should be a symbol, a hook variable. Its value should\n\ be a list of functions. We call those functions, one by one,\n\ passing arguments ARGS to each of them, until one of them\n\ returns nil. Then we return nil.\n\ If all the functions return non-nil, we return non-nil.\n\ \n\ To make a hook variable buffer-local, use `make-local-hook',\n\ not `make-local-variable'.") (nargs, args) int nargs; Lisp_Object *args; { return run_hook_with_args (nargs, args, until_failure); } /* ARGS[0] should be a hook symbol. Call each of the functions in the hook value, passing each of them as arguments all the rest of ARGS (all NARGS - 1 elements). COND specifies a condition to test after each call to decide whether to stop. The caller (or its caller, etc) must gcpro all of ARGS, except that it isn't necessary to gcpro ARGS[0]. */ Lisp_Object run_hook_with_args (nargs, args, cond) int nargs; Lisp_Object *args; enum run_hooks_condition cond; { Lisp_Object sym, val, ret; struct gcpro gcpro1, gcpro2; sym = args[0]; val = find_symbol_value (sym); ret = (cond == until_failure ? Qt : Qnil); if (EQ (val, Qunbound) || NILP (val)) return ret; else if (!CONSP (val) || EQ (XCONS (val)->car, Qlambda)) { args[0] = val; return Ffuncall (nargs, args); } else { GCPRO2 (sym, val); for (; CONSP (val) && ((cond == to_completion) || (cond == until_success ? NILP (ret) : !NILP (ret))); val = XCONS (val)->cdr) { if (EQ (XCONS (val)->car, Qt)) { /* t indicates this hook has a local binding; it means to run the global binding too. */ Lisp_Object globals; for (globals = Fdefault_value (sym); CONSP (globals) && ((cond == to_completion) || (cond == until_success ? NILP (ret) : !NILP (ret))); globals = XCONS (globals)->cdr) { args[0] = XCONS (globals)->car; /* In a global value, t should not occur. If it does, we must ignore it to avoid an endless loop. */ if (!EQ (args[0], Qt)) ret = Ffuncall (nargs, args); } } else { args[0] = XCONS (val)->car; ret = Ffuncall (nargs, args); } } UNGCPRO; return ret; } } /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual present value of that symbol. Call each element of FUNLIST, passing each of them the rest of ARGS. The caller (or its caller, etc) must gcpro all of ARGS, except that it isn't necessary to gcpro ARGS[0]. */ Lisp_Object run_hook_list_with_args (funlist, nargs, args) Lisp_Object funlist; int nargs; Lisp_Object *args; { Lisp_Object sym; Lisp_Object val; struct gcpro gcpro1, gcpro2; sym = args[0]; GCPRO2 (sym, val); for (val = funlist; CONSP (val); val = XCONS (val)->cdr) { if (EQ (XCONS (val)->car, Qt)) { /* t indicates this hook has a local binding; it means to run the global binding too. */ Lisp_Object globals; for (globals = Fdefault_value (sym); CONSP (globals); globals = XCONS (globals)->cdr) { args[0] = XCONS (globals)->car; /* In a global value, t should not occur. If it does, we must ignore it to avoid an endless loop. */ if (!EQ (args[0], Qt)) Ffuncall (nargs, args); } } else { args[0] = XCONS (val)->car; Ffuncall (nargs, args); } } UNGCPRO; return Qnil; } /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */ void run_hook_with_args_2 (hook, arg1, arg2) Lisp_Object hook, arg1, arg2; { Lisp_Object temp[3]; temp[0] = hook; temp[1] = arg1; temp[2] = arg2; Frun_hook_with_args (3, temp); } /* Apply fn to arg */ Lisp_Object apply1 (fn, arg) Lisp_Object fn, arg; { struct gcpro gcpro1; GCPRO1 (fn); if (NILP (arg)) RETURN_UNGCPRO (Ffuncall (1, &fn)); gcpro1.nvars = 2; #ifdef NO_ARG_ARRAY { Lisp_Object args[2]; args[0] = fn; args[1] = arg; gcpro1.var = args; RETURN_UNGCPRO (Fapply (2, args)); } #else /* not NO_ARG_ARRAY */ RETURN_UNGCPRO (Fapply (2, &fn)); #endif /* not NO_ARG_ARRAY */ } /* Call function fn on no arguments */ Lisp_Object call0 (fn) Lisp_Object fn; { struct gcpro gcpro1; GCPRO1 (fn); RETURN_UNGCPRO (Ffuncall (1, &fn)); } /* Call function fn with 1 argument arg1 */ /* ARGSUSED */ Lisp_Object call1 (fn, arg1) Lisp_Object fn, arg1; { struct gcpro gcpro1; #ifdef NO_ARG_ARRAY Lisp_Object args[2]; args[0] = fn; args[1] = arg1; GCPRO1 (args[0]); gcpro1.nvars = 2; RETURN_UNGCPRO (Ffuncall (2, args)); #else /* not NO_ARG_ARRAY */ GCPRO1 (fn); gcpro1.nvars = 2; RETURN_UNGCPRO (Ffuncall (2, &fn)); #endif /* not NO_ARG_ARRAY */ } /* Call function fn with 2 arguments arg1, arg2 */ /* ARGSUSED */ Lisp_Object call2 (fn, arg1, arg2) Lisp_Object fn, arg1, arg2; { struct gcpro gcpro1; #ifdef NO_ARG_ARRAY Lisp_Object args[3]; args[0] = fn; args[1] = arg1; args[2] = arg2; GCPRO1 (args[0]); gcpro1.nvars = 3; RETURN_UNGCPRO (Ffuncall (3, args)); #else /* not NO_ARG_ARRAY */ GCPRO1 (fn); gcpro1.nvars = 3; RETURN_UNGCPRO (Ffuncall (3, &fn)); #endif /* not NO_ARG_ARRAY */ } /* Call function fn with 3 arguments arg1, arg2, arg3 */ /* ARGSUSED */ Lisp_Object call3 (fn, arg1, arg2, arg3) Lisp_Object fn, arg1, arg2, arg3; { struct gcpro gcpro1; #ifdef NO_ARG_ARRAY Lisp_Object args[4]; args[0] = fn; args[1] = arg1; args[2] = arg2; args[3] = arg3; GCPRO1 (args[0]); gcpro1.nvars = 4; RETURN_UNGCPRO (Ffuncall (4, args)); #else /* not NO_ARG_ARRAY */ GCPRO1 (fn); gcpro1.nvars = 4; RETURN_UNGCPRO (Ffuncall (4, &fn)); #endif /* not NO_ARG_ARRAY */ } /* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */ /* ARGSUSED */ Lisp_Object call4 (fn, arg1, arg2, arg3, arg4) Lisp_Object fn, arg1, arg2, arg3, arg4; { struct gcpro gcpro1; #ifdef NO_ARG_ARRAY Lisp_Object args[5]; args[0] = fn; args[1] = arg1; args[2] = arg2; args[3] = arg3; args[4] = arg4; GCPRO1 (args[0]); gcpro1.nvars = 5; RETURN_UNGCPRO (Ffuncall (5, args)); #else /* not NO_ARG_ARRAY */ GCPRO1 (fn); gcpro1.nvars = 5; RETURN_UNGCPRO (Ffuncall (5, &fn)); #endif /* not NO_ARG_ARRAY */ } /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */ /* ARGSUSED */ Lisp_Object call5 (fn, arg1, arg2, arg3, arg4, arg5) Lisp_Object fn, arg1, arg2, arg3, arg4, arg5; { struct gcpro gcpro1; #ifdef NO_ARG_ARRAY Lisp_Object args[6]; args[0] = fn; args[1] = arg1; args[2] = arg2; args[3] = arg3; args[4] = arg4; args[5] = arg5; GCPRO1 (args[0]); gcpro1.nvars = 6; RETURN_UNGCPRO (Ffuncall (6, args)); #else /* not NO_ARG_ARRAY */ GCPRO1 (fn); gcpro1.nvars = 6; RETURN_UNGCPRO (Ffuncall (6, &fn)); #endif /* not NO_ARG_ARRAY */ } /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */ /* ARGSUSED */ Lisp_Object call6 (fn, arg1, arg2, arg3, arg4, arg5, arg6) Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6; { struct gcpro gcpro1; #ifdef NO_ARG_ARRAY Lisp_Object args[7]; args[0] = fn; args[1] = arg1; args[2] = arg2; args[3] = arg3; args[4] = arg4; args[5] = arg5; args[6] = arg6; GCPRO1 (args[0]); gcpro1.nvars = 7; RETURN_UNGCPRO (Ffuncall (7, args)); #else /* not NO_ARG_ARRAY */ GCPRO1 (fn); gcpro1.nvars = 7; RETURN_UNGCPRO (Ffuncall (7, &fn)); #endif /* not NO_ARG_ARRAY */ } DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, "Call first argument as a function, passing remaining arguments to it.\n\ Return the value that function returns.\n\ Thus, (funcall 'cons 'x 'y) returns (x . y).") (nargs, args) int nargs; Lisp_Object *args; { Lisp_Object fun; Lisp_Object funcar; int numargs = nargs - 1; Lisp_Object lisp_numargs; Lisp_Object val; struct backtrace backtrace; register Lisp_Object *internal_args; register int i; QUIT; if (consing_since_gc > gc_cons_threshold) Fgarbage_collect (); if (++lisp_eval_depth > max_lisp_eval_depth) { if (max_lisp_eval_depth < 100) max_lisp_eval_depth = 100; if (lisp_eval_depth > max_lisp_eval_depth) error ("Lisp nesting exceeds max-lisp-eval-depth"); } backtrace.next = backtrace_list; backtrace_list = &backtrace; backtrace.function = &args[0]; backtrace.args = &args[1]; backtrace.nargs = nargs - 1; backtrace.evalargs = 0; backtrace.debug_on_exit = 0; if (debug_on_next_call) do_debug_on_call (Qlambda); retry: fun = args[0]; fun = Findirect_function (fun); if (SUBRP (fun)) { if (numargs < XSUBR (fun)->min_args || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) { XSETFASTINT (lisp_numargs, numargs); return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (lisp_numargs, Qnil))); } if (XSUBR (fun)->max_args == UNEVALLED) return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); if (XSUBR (fun)->max_args == MANY) { val = (*XSUBR (fun)->function) (numargs, args + 1); goto done; } if (XSUBR (fun)->max_args > numargs) { internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object)); bcopy (args + 1, internal_args, numargs * sizeof (Lisp_Object)); for (i = numargs; i < XSUBR (fun)->max_args; i++) internal_args[i] = Qnil; } else internal_args = args + 1; switch (XSUBR (fun)->max_args) { case 0: val = (*XSUBR (fun)->function) (); goto done; case 1: val = (*XSUBR (fun)->function) (internal_args[0]); goto done; case 2: val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1]); goto done; case 3: val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1], internal_args[2]); goto done; case 4: val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1], internal_args[2], internal_args[3]); goto done; case 5: val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1], internal_args[2], internal_args[3], internal_args[4]); goto done; case 6: val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1], internal_args[2], internal_args[3], internal_args[4], internal_args[5]); goto done; case 7: val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1], internal_args[2], internal_args[3], internal_args[4], internal_args[5], internal_args[6]); goto done; default: /* If a subr takes more than 6 arguments without using MANY or UNEVALLED, we need to extend this function to support it. Until this is done, there is no way to call the function. */ abort (); } } if (COMPILEDP (fun)) val = funcall_lambda (fun, numargs, args + 1); else { if (!CONSP (fun)) return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); funcar = Fcar (fun); if (!SYMBOLP (funcar)) return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); if (EQ (funcar, Qlambda)) val = funcall_lambda (fun, numargs, args + 1); else if (EQ (funcar, Qmocklisp)) val = ml_apply (fun, Flist (numargs, args + 1)); else if (EQ (funcar, Qautoload)) { do_autoload (fun, args[0]); goto retry; } else return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); } done: lisp_eval_depth--; if (backtrace.debug_on_exit) val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); backtrace_list = backtrace.next; return val; } Lisp_Object apply_lambda (fun, args, eval_flag) Lisp_Object fun, args; int eval_flag; { Lisp_Object args_left; Lisp_Object numargs; register Lisp_Object *arg_vector; struct gcpro gcpro1, gcpro2, gcpro3; register int i; register Lisp_Object tem; numargs = Flength (args); arg_vector = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object)); args_left = args; GCPRO3 (*arg_vector, args_left, fun); gcpro1.nvars = 0; for (i = 0; i < XINT (numargs);) { tem = Fcar (args_left), args_left = Fcdr (args_left); if (eval_flag) tem = Feval (tem); arg_vector[i++] = tem; gcpro1.nvars = i; } UNGCPRO; if (eval_flag) { backtrace_list->args = arg_vector; backtrace_list->nargs = i; } backtrace_list->evalargs = 0; tem = funcall_lambda (fun, XINT (numargs), arg_vector); /* Do the debug-on-exit now, while arg_vector still exists. */ if (backtrace_list->debug_on_exit) tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil))); /* Don't do it again when we return to eval. */ backtrace_list->debug_on_exit = 0; return tem; } /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR and return the result of evaluation. FUN must be either a lambda-expression or a compiled-code object. */ Lisp_Object funcall_lambda (fun, nargs, arg_vector) Lisp_Object fun; int nargs; register Lisp_Object *arg_vector; { Lisp_Object val, tem; register Lisp_Object syms_left; Lisp_Object numargs; register Lisp_Object next; int count = specpdl_ptr - specpdl; register int i; int optional = 0, rest = 0; specbind (Qmocklisp_arguments, Qt); /* t means NOT mocklisp! */ XSETFASTINT (numargs, nargs); if (CONSP (fun)) syms_left = Fcar (Fcdr (fun)); else if (COMPILEDP (fun)) syms_left = XVECTOR (fun)->contents[COMPILED_ARGLIST]; else abort (); i = 0; for (; !NILP (syms_left); syms_left = Fcdr (syms_left)) { QUIT; next = Fcar (syms_left); while (!SYMBOLP (next)) next = Fsignal (Qinvalid_function, Fcons (fun, Qnil)); if (EQ (next, Qand_rest)) rest = 1; else if (EQ (next, Qand_optional)) optional = 1; else if (rest) { specbind (next, Flist (nargs - i, &arg_vector[i])); i = nargs; } else if (i < nargs) { tem = arg_vector[i++]; specbind (next, tem); } else if (!optional) return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil))); else specbind (next, Qnil); } if (i < nargs) return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil))); if (CONSP (fun)) val = Fprogn (Fcdr (Fcdr (fun))); else { /* If we have not actually read the bytecode string and constants vector yet, fetch them from the file. */ if (CONSP (XVECTOR (fun)->contents[COMPILED_BYTECODE])) Ffetch_bytecode (fun); val = Fbyte_code (XVECTOR (fun)->contents[COMPILED_BYTECODE], XVECTOR (fun)->contents[COMPILED_CONSTANTS], XVECTOR (fun)->contents[COMPILED_STACK_DEPTH]); } return unbind_to (count, val); } DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, 1, 1, 0, "If byte-compiled OBJECT is lazy-loaded, fetch it now.") (object) Lisp_Object object; { Lisp_Object tem; if (COMPILEDP (object) && CONSP (XVECTOR (object)->contents[COMPILED_BYTECODE])) { tem = read_doc_string (XVECTOR (object)->contents[COMPILED_BYTECODE]); if (!CONSP (tem)) error ("invalid byte code"); XVECTOR (object)->contents[COMPILED_BYTECODE] = XCONS (tem)->car; XVECTOR (object)->contents[COMPILED_CONSTANTS] = XCONS (tem)->cdr; } return object; } void grow_specpdl () { register int count = specpdl_ptr - specpdl; if (specpdl_size >= max_specpdl_size) { if (max_specpdl_size < 400) max_specpdl_size = 400; if (specpdl_size >= max_specpdl_size) { if (!NILP (Vdebug_on_error)) /* Leave room for some specpdl in the debugger. */ max_specpdl_size = specpdl_size + 100; Fsignal (Qerror, Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil)); } } specpdl_size *= 2; if (specpdl_size > max_specpdl_size) specpdl_size = max_specpdl_size; specpdl = (struct specbinding *) xrealloc (specpdl, specpdl_size * sizeof (struct specbinding)); specpdl_ptr = specpdl + count; } void specbind (symbol, value) Lisp_Object symbol, value; { Lisp_Object ovalue; CHECK_SYMBOL (symbol, 0); if (specpdl_ptr == specpdl + specpdl_size) grow_specpdl (); specpdl_ptr->symbol = symbol; specpdl_ptr->func = 0; specpdl_ptr->old_value = ovalue = find_symbol_value (symbol); specpdl_ptr++; if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue)) store_symval_forwarding (symbol, ovalue, value); else Fset (symbol, value); } void record_unwind_protect (function, arg) Lisp_Object (*function)(); Lisp_Object arg; { if (specpdl_ptr == specpdl + specpdl_size) grow_specpdl (); specpdl_ptr->func = function; specpdl_ptr->symbol = Qnil; specpdl_ptr->old_value = arg; specpdl_ptr++; } Lisp_Object unbind_to (count, value) int count; Lisp_Object value; { int quitf = !NILP (Vquit_flag); struct gcpro gcpro1; GCPRO1 (value); Vquit_flag = Qnil; while (specpdl_ptr != specpdl + count) { --specpdl_ptr; if (specpdl_ptr->func != 0) (*specpdl_ptr->func) (specpdl_ptr->old_value); /* Note that a "binding" of nil is really an unwind protect, so in that case the "old value" is a list of forms to evaluate. */ else if (NILP (specpdl_ptr->symbol)) Fprogn (specpdl_ptr->old_value); else Fset (specpdl_ptr->symbol, specpdl_ptr->old_value); } if (NILP (Vquit_flag) && quitf) Vquit_flag = Qt; UNGCPRO; return value; } #if 0 /* Get the value of symbol's global binding, even if that binding is not now dynamically visible. */ Lisp_Object top_level_value (symbol) Lisp_Object symbol; { register struct specbinding *ptr = specpdl; CHECK_SYMBOL (symbol, 0); for (; ptr != specpdl_ptr; ptr++) { if (EQ (ptr->symbol, symbol)) return ptr->old_value; } return Fsymbol_value (symbol); } Lisp_Object top_level_set (symbol, newval) Lisp_Object symbol, newval; { register struct specbinding *ptr = specpdl; CHECK_SYMBOL (symbol, 0); for (; ptr != specpdl_ptr; ptr++) { if (EQ (ptr->symbol, symbol)) { ptr->old_value = newval; return newval; } } return Fset (symbol, newval); } #endif /* 0 */ DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, "Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.\n\ The debugger is entered when that frame exits, if the flag is non-nil.") (level, flag) Lisp_Object level, flag; { register struct backtrace *backlist = backtrace_list; register int i; CHECK_NUMBER (level, 0); for (i = 0; backlist && i < XINT (level); i++) { backlist = backlist->next; } if (backlist) backlist->debug_on_exit = !NILP (flag); return flag; } DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "", "Print a trace of Lisp function calls currently active.\n\ Output stream used is value of `standard-output'.") () { register struct backtrace *backlist = backtrace_list; register int i; Lisp_Object tail; Lisp_Object tem; extern Lisp_Object Vprint_level; struct gcpro gcpro1; XSETFASTINT (Vprint_level, 3); tail = Qnil; GCPRO1 (tail); while (backlist) { write_string (backlist->debug_on_exit ? "* " : " ", 2); if (backlist->nargs == UNEVALLED) { Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil); write_string ("\n", -1); } else { tem = *backlist->function; Fprin1 (tem, Qnil); /* This can QUIT */ write_string ("(", -1); if (backlist->nargs == MANY) { for (tail = *backlist->args, i = 0; !NILP (tail); tail = Fcdr (tail), i++) { if (i) write_string (" ", -1); Fprin1 (Fcar (tail), Qnil); } } else { for (i = 0; i < backlist->nargs; i++) { if (i) write_string (" ", -1); Fprin1 (backlist->args[i], Qnil); } } write_string (")\n", -1); } backlist = backlist->next; } Vprint_level = Qnil; UNGCPRO; return Qnil; } DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 1, "", "Return the function and arguments N frames up from current execution point.\n\ If that frame has not evaluated the arguments yet (or is a special form),\n\ the value is (nil FUNCTION ARG-FORMS...).\n\ If that frame has evaluated its arguments and called its function already,\n\ the value is (t FUNCTION ARG-VALUES...).\n\ A &rest arg is represented as the tail of the list ARG-VALUES.\n\ FUNCTION is whatever was supplied as car of evaluated list,\n\ or a lambda expression for macro calls.\n\ If N is more than the number of frames, the value is nil.") (nframes) Lisp_Object nframes; { register struct backtrace *backlist = backtrace_list; register int i; Lisp_Object tem; CHECK_NATNUM (nframes, 0); /* Find the frame requested. */ for (i = 0; backlist && i < XFASTINT (nframes); i++) backlist = backlist->next; if (!backlist) return Qnil; if (backlist->nargs == UNEVALLED) return Fcons (Qnil, Fcons (*backlist->function, *backlist->args)); else { if (backlist->nargs == MANY) tem = *backlist->args; else tem = Flist (backlist->nargs, backlist->args); return Fcons (Qt, Fcons (*backlist->function, tem)); } } syms_of_eval () { DEFVAR_INT ("max-specpdl-size", &max_specpdl_size, "Limit on number of Lisp variable bindings & unwind-protects before error."); DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth, "Limit on depth in `eval', `apply' and `funcall' before error.\n\ This limit is to catch infinite recursions for you before they cause\n\ actual stack overflow in C, which would be fatal for Emacs.\n\ You can safely make it considerably larger than its default value,\n\ if that proves inconveniently small."); DEFVAR_LISP ("quit-flag", &Vquit_flag, "Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.\n\ Typing C-g sets `quit-flag' non-nil, regardless of `inhibit-quit'."); Vquit_flag = Qnil; DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit, "Non-nil inhibits C-g quitting from happening immediately.\n\ Note that `quit-flag' will still be set by typing C-g,\n\ so a quit will be signalled as soon as `inhibit-quit' is nil.\n\ To prevent this happening, set `quit-flag' to nil\n\ before making `inhibit-quit' nil."); Vinhibit_quit = Qnil; Qinhibit_quit = intern ("inhibit-quit"); staticpro (&Qinhibit_quit); Qautoload = intern ("autoload"); staticpro (&Qautoload); Qdebug_on_error = intern ("debug-on-error"); staticpro (&Qdebug_on_error); Qmacro = intern ("macro"); staticpro (&Qmacro); /* Note that the process handling also uses Qexit, but we don't want to staticpro it twice, so we just do it here. */ Qexit = intern ("exit"); staticpro (&Qexit); Qinteractive = intern ("interactive"); staticpro (&Qinteractive); Qcommandp = intern ("commandp"); staticpro (&Qcommandp); Qdefun = intern ("defun"); staticpro (&Qdefun); Qand_rest = intern ("&rest"); staticpro (&Qand_rest); Qand_optional = intern ("&optional"); staticpro (&Qand_optional); DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error, "*Non-nil means automatically display a backtrace buffer\n\ after any error that is handled by the editor command loop.\n\ If the value is a list, an error only means to display a backtrace\n\ if one of its condition symbols appears in the list."); Vstack_trace_on_error = Qnil; DEFVAR_LISP ("debug-on-error", &Vdebug_on_error, "*Non-nil means enter debugger if an error is signaled.\n\ Does not apply to errors handled by `condition-case'.\n\ If the value is a list, an error only means to enter the debugger\n\ if one of its condition symbols appears in the list.\n\ See also variable `debug-on-quit'."); Vdebug_on_error = Qnil; DEFVAR_BOOL ("debug-on-quit", &debug_on_quit, "*Non-nil means enter debugger if quit is signaled (C-g, for example).\n\ Does not apply if quit is handled by a `condition-case'."); debug_on_quit = 0; DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call, "Non-nil means enter debugger before next `eval', `apply' or `funcall'."); DEFVAR_LISP ("debugger", &Vdebugger, "Function to call to invoke debugger.\n\ If due to frame exit, args are `exit' and the value being returned;\n\ this function's value will be returned instead of that.\n\ If due to error, args are `error' and a list of the args to `signal'.\n\ If due to `apply' or `funcall' entry, one arg, `lambda'.\n\ If due to `eval' entry, one arg, t."); Vdebugger = Qnil; Qmocklisp_arguments = intern ("mocklisp-arguments"); staticpro (&Qmocklisp_arguments); DEFVAR_LISP ("mocklisp-arguments", &Vmocklisp_arguments, "While in a mocklisp function, the list of its unevaluated args."); Vmocklisp_arguments = Qt; DEFVAR_LISP ("run-hooks", &Vrun_hooks, "Set to the function `run-hooks', if that function has been defined.\n\ Otherwise, nil (in a bare Emacs without preloaded Lisp code)."); staticpro (&Vautoload_queue); Vautoload_queue = Qnil; defsubr (&Sor); defsubr (&Sand); defsubr (&Sif); defsubr (&Scond); defsubr (&Sprogn); defsubr (&Sprog1); defsubr (&Sprog2); defsubr (&Ssetq); defsubr (&Squote); defsubr (&Sfunction); defsubr (&Sdefun); defsubr (&Sdefmacro); defsubr (&Sdefvar); defsubr (&Sdefconst); defsubr (&Suser_variable_p); defsubr (&Slet); defsubr (&SletX); defsubr (&Swhile); defsubr (&Smacroexpand); defsubr (&Scatch); defsubr (&Sthrow); defsubr (&Sunwind_protect); defsubr (&Scondition_case); defsubr (&Ssignal); defsubr (&Sinteractive_p); defsubr (&Scommandp); defsubr (&Sautoload); defsubr (&Seval); defsubr (&Sapply); defsubr (&Sfuncall); defsubr (&Srun_hooks); defsubr (&Srun_hook_with_args); defsubr (&Srun_hook_with_args_until_success); defsubr (&Srun_hook_with_args_until_failure); defsubr (&Sfetch_bytecode); defsubr (&Sbacktrace_debug); defsubr (&Sbacktrace); defsubr (&Sbacktrace_frame); } emacs-19.30/src/fileio.c100444 12120 1 374043 6052151044 13352 0ustar rmsdaemon/* File IO for GNU Emacs. Copyright (C) 1985, 86, 87, 88, 93, 94, 95 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. */ #include #include #include #ifdef HAVE_UNISTD_H #include #endif #if !defined (S_ISLNK) && defined (S_IFLNK) # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK) #endif #if !defined (S_ISREG) && defined (S_IFREG) # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) #endif #ifdef VMS #include "vms-pwd.h" #else #include #endif #ifdef MSDOS #include "msdos.h" #include #endif #include #ifdef VMS #include "vmsdir.h" #include #include #include #endif #include #ifndef vax11c extern int errno; #endif extern char *strerror (); #ifdef APOLLO #include #endif #ifndef USG #ifndef VMS #ifndef BSD4_1 #ifndef WINDOWSNT #define HAVE_FSYNC #endif #endif #endif #endif #include "lisp.h" #include "intervals.h" #include "buffer.h" #include "window.h" #ifdef WINDOWSNT #define NOMINMAX 1 #include #include #include #endif /* not WINDOWSNT */ #ifdef VMS #include #include #include #include #endif #include "systime.h" #ifdef HPUX #include #ifndef HPUX8 #ifndef HPUX9 #include #endif #endif #endif #ifndef O_WRONLY #define O_WRONLY 1 #endif #ifndef O_RDONLY #define O_RDONLY 0 #endif #define min(a, b) ((a) < (b) ? (a) : (b)) #define max(a, b) ((a) > (b) ? (a) : (b)) /* Nonzero during writing of auto-save files */ int auto_saving; /* Set by auto_save_1 to mode of original file so Fwrite_region will create a new file with the same mode as the original */ int auto_save_mode_bits; /* Alist of elements (REGEXP . HANDLER) for file names whose I/O is done with a special handler. */ Lisp_Object Vfile_name_handler_alist; /* Format for auto-save files */ Lisp_Object Vauto_save_file_format; /* Lisp functions for translating file formats */ Lisp_Object Qformat_decode, Qformat_annotate_function; /* Functions to be called to process text properties in inserted file. */ Lisp_Object Vafter_insert_file_functions; /* Functions to be called to create text property annotations for file. */ Lisp_Object Vwrite_region_annotate_functions; /* During build_annotations, each time an annotation function is called, this holds the annotations made by the previous functions. */ Lisp_Object Vwrite_region_annotations_so_far; /* File name in which we write a list of all our auto save files. */ Lisp_Object Vauto_save_list_file_name; /* Nonzero means, when reading a filename in the minibuffer, start out by inserting the default directory into the minibuffer. */ int insert_default_directory; /* On VMS, nonzero means write new files with record format stmlf. Zero means use var format. */ int vms_stmlf_recfm; /* These variables describe handlers that have "already" had a chance to handle the current operation. Vinhibit_file_name_handlers is a list of file name handlers. Vinhibit_file_name_operation is the operation being handled. If we try to handle that operation, we ignore those handlers. */ static Lisp_Object Vinhibit_file_name_handlers; static Lisp_Object Vinhibit_file_name_operation; Lisp_Object Qfile_error, Qfile_already_exists; Lisp_Object Qfile_name_history; Lisp_Object Qcar_less_than_car; report_file_error (string, data) char *string; Lisp_Object data; { Lisp_Object errstring; errstring = build_string (strerror (errno)); /* System error messages are capitalized. Downcase the initial unless it is followed by a slash. */ if (XSTRING (errstring)->data[1] != '/') XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]); while (1) Fsignal (Qfile_error, Fcons (build_string (string), Fcons (errstring, data))); } close_file_unwind (fd) Lisp_Object fd; { close (XFASTINT (fd)); } /* Restore point, having saved it as a marker. */ restore_point_unwind (location) Lisp_Object location; { SET_PT (marker_position (location)); Fset_marker (location, Qnil, Qnil); } Lisp_Object Qexpand_file_name; Lisp_Object Qsubstitute_in_file_name; Lisp_Object Qdirectory_file_name; Lisp_Object Qfile_name_directory; Lisp_Object Qfile_name_nondirectory; Lisp_Object Qunhandled_file_name_directory; Lisp_Object Qfile_name_as_directory; Lisp_Object Qcopy_file; Lisp_Object Qmake_directory_internal; Lisp_Object Qdelete_directory; Lisp_Object Qdelete_file; Lisp_Object Qrename_file; Lisp_Object Qadd_name_to_file; Lisp_Object Qmake_symbolic_link; Lisp_Object Qfile_exists_p; Lisp_Object Qfile_executable_p; Lisp_Object Qfile_readable_p; Lisp_Object Qfile_symlink_p; Lisp_Object Qfile_writable_p; Lisp_Object Qfile_directory_p; Lisp_Object Qfile_regular_p; Lisp_Object Qfile_accessible_directory_p; Lisp_Object Qfile_modes; Lisp_Object Qset_file_modes; Lisp_Object Qfile_newer_than_file_p; Lisp_Object Qinsert_file_contents; Lisp_Object Qwrite_region; Lisp_Object Qverify_visited_file_modtime; Lisp_Object Qset_visited_file_modtime; DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 2, 2, 0, "Return FILENAME's handler function for OPERATION, if it has one.\n\ Otherwise, return nil.\n\ A file name is handled if one of the regular expressions in\n\ `file-name-handler-alist' matches it.\n\n\ If OPERATION equals `inhibit-file-name-operation', then we ignore\n\ any handlers that are members of `inhibit-file-name-handlers',\n\ but we still do run any other handlers. This lets handlers\n\ use the standard functions without calling themselves recursively.") (filename, operation) Lisp_Object filename, operation; { /* This function must not munge the match data. */ Lisp_Object chain, inhibited_handlers; CHECK_STRING (filename, 0); if (EQ (operation, Vinhibit_file_name_operation)) inhibited_handlers = Vinhibit_file_name_handlers; else inhibited_handlers = Qnil; for (chain = Vfile_name_handler_alist; CONSP (chain); chain = XCONS (chain)->cdr) { Lisp_Object elt; elt = XCONS (chain)->car; if (CONSP (elt)) { Lisp_Object string; string = XCONS (elt)->car; if (STRINGP (string) && fast_string_match (string, filename) >= 0) { Lisp_Object handler, tem; handler = XCONS (elt)->cdr; tem = Fmemq (handler, inhibited_handlers); if (NILP (tem)) return handler; } } QUIT; } return Qnil; } DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, 1, 1, 0, "Return the directory component in file name NAME.\n\ Return nil if NAME does not include a directory.\n\ Otherwise return a directory spec.\n\ Given a Unix syntax file name, returns a string ending in slash;\n\ on VMS, perhaps instead a string ending in `:', `]' or `>'.") (file) Lisp_Object file; { register unsigned char *beg; register unsigned char *p; Lisp_Object handler; CHECK_STRING (file, 0); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (file, Qfile_name_directory); if (!NILP (handler)) return call2 (handler, Qfile_name_directory, file); #ifdef FILE_SYSTEM_CASE file = FILE_SYSTEM_CASE (file); #endif beg = XSTRING (file)->data; p = beg + XSTRING (file)->size; while (p != beg && !IS_ANY_SEP (p[-1]) #ifdef VMS && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' #endif /* VMS */ ) p--; if (p == beg) return Qnil; #ifdef DOS_NT /* Expansion of "c:" to drive and default directory. */ /* (NT does the right thing.) */ if (p == beg + 2 && beg[1] == ':') { int drive = (*beg) - 'a'; /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */ unsigned char *res = alloca (MAXPATHLEN + 5); unsigned char *res1; #ifdef WINDOWSNT res1 = res; /* The NT version places the drive letter at the beginning already. */ #else /* not WINDOWSNT */ /* On MSDOG we must put the drive letter in by hand. */ res1 = res + 2; #endif /* not WINDOWSNT */ if (getdefdir (drive + 1, res)) { #ifdef MSDOS res[0] = drive + 'a'; res[1] = ':'; #endif /* MSDOS */ if (IS_DIRECTORY_SEP (res[strlen (res) - 1])) strcat (res, "/"); beg = res; p = beg + strlen (beg); } } #endif /* DOS_NT */ return make_string (beg, p - beg); } DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory, 1, 1, 0, "Return file name NAME sans its directory.\n\ For example, in a Unix-syntax file name,\n\ this is everything after the last slash,\n\ or the entire name if it contains no slash.") (file) Lisp_Object file; { register unsigned char *beg, *p, *end; Lisp_Object handler; CHECK_STRING (file, 0); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (file, Qfile_name_nondirectory); if (!NILP (handler)) return call2 (handler, Qfile_name_nondirectory, file); beg = XSTRING (file)->data; end = p = beg + XSTRING (file)->size; while (p != beg && !IS_ANY_SEP (p[-1]) #ifdef VMS && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' #endif /* VMS */ ) p--; return make_string (p, end - p); } DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0, "Return a directly usable directory name somehow associated with FILENAME.\n\ A `directly usable' directory name is one that may be used without the\n\ intervention of any file handler.\n\ If FILENAME is a directly usable file itself, return\n\ (file-name-directory FILENAME).\n\ The `call-process' and `start-process' functions use this function to\n\ get a current directory to run processes in.") (filename) Lisp_Object filename; { Lisp_Object handler; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory); if (!NILP (handler)) return call2 (handler, Qunhandled_file_name_directory, filename); return Ffile_name_directory (filename); } char * file_name_as_directory (out, in) char *out, *in; { int size = strlen (in) - 1; strcpy (out, in); #ifdef VMS /* Is it already a directory string? */ if (in[size] == ':' || in[size] == ']' || in[size] == '>') return out; /* Is it a VMS directory file name? If so, hack VMS syntax. */ else if (! index (in, '/') && ((size > 3 && ! strcmp (&in[size - 3], ".DIR")) || (size > 3 && ! strcmp (&in[size - 3], ".dir")) || (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4) || ! strncmp (&in[size - 5], ".dir", 4)) && (in[size - 1] == '.' || in[size - 1] == ';') && in[size] == '1'))) { register char *p, *dot; char brack; /* x.dir -> [.x] dir:x.dir --> dir:[x] dir:[x]y.dir --> dir:[x.y] */ p = in + size; while (p != in && *p != ':' && *p != '>' && *p != ']') p--; if (p != in) { strncpy (out, in, p - in); out[p - in] = '\0'; if (*p == ':') { brack = ']'; strcat (out, ":["); } else { brack = *p; strcat (out, "."); } p++; } else { brack = ']'; strcpy (out, "[."); } dot = index (p, '.'); if (dot) { /* blindly remove any extension */ size = strlen (out) + (dot - p); strncat (out, p, dot - p); } else { strcat (out, p); size = strlen (out); } out[size++] = brack; out[size] = '\0'; } #else /* not VMS */ /* For Unix syntax, Append a slash if necessary */ if (!IS_ANY_SEP (out[size])) { out[size + 1] = DIRECTORY_SEP; out[size + 2] = '\0'; } #endif /* not VMS */ return out; } DEFUN ("file-name-as-directory", Ffile_name_as_directory, Sfile_name_as_directory, 1, 1, 0, "Return a string representing file FILENAME interpreted as a directory.\n\ This operation exists because a directory is also a file, but its name as\n\ a directory is different from its name as a file.\n\ The result can be used as the value of `default-directory'\n\ or passed as second argument to `expand-file-name'.\n\ For a Unix-syntax file name, just appends a slash.\n\ On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.") (file) Lisp_Object file; { char *buf; Lisp_Object handler; CHECK_STRING (file, 0); if (NILP (file)) return Qnil; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (file, Qfile_name_as_directory); if (!NILP (handler)) return call2 (handler, Qfile_name_as_directory, file); buf = (char *) alloca (XSTRING (file)->size + 10); return build_string (file_name_as_directory (buf, XSTRING (file)->data)); } /* * Convert from directory name to filename. * On VMS: * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1 * On UNIX, it's simple: just make sure there is a terminating / * Value is nonzero if the string output is different from the input. */ directory_file_name (src, dst) char *src, *dst; { long slen; #ifdef VMS long rlen; char * ptr, * rptr; char bracket; struct FAB fab = cc$rms_fab; struct NAM nam = cc$rms_nam; char esa[NAM$C_MAXRSS]; #endif /* VMS */ slen = strlen (src); #ifdef VMS if (! index (src, '/') && (src[slen - 1] == ']' || src[slen - 1] == ':' || src[slen - 1] == '>')) { /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */ fab.fab$l_fna = src; fab.fab$b_fns = slen; fab.fab$l_nam = &nam; fab.fab$l_fop = FAB$M_NAM; nam.nam$l_esa = esa; nam.nam$b_ess = sizeof esa; nam.nam$b_nop |= NAM$M_SYNCHK; /* We call SYS$PARSE to handle such things as [--] for us. */ if (SYS$PARSE(&fab, 0, 0) == RMS$_NORMAL) { slen = nam.nam$b_esl; if (esa[slen - 1] == ';' && esa[slen - 2] == '.') slen -= 2; esa[slen] = '\0'; src = esa; } if (src[slen - 1] != ']' && src[slen - 1] != '>') { /* what about when we have logical_name:???? */ if (src[slen - 1] == ':') { /* Xlate logical name and see what we get */ ptr = strcpy (dst, src); /* upper case for getenv */ while (*ptr) { if ('a' <= *ptr && *ptr <= 'z') *ptr -= 040; ptr++; } dst[slen - 1] = 0; /* remove colon */ if (!(src = egetenv (dst))) return 0; /* should we jump to the beginning of this procedure? Good points: allows us to use logical names that xlate to Unix names, Bad points: can be a problem if we just translated to a device name... For now, I'll punt and always expect VMS names, and hope for the best! */ slen = strlen (src); if (src[slen - 1] != ']' && src[slen - 1] != '>') { /* no recursion here! */ strcpy (dst, src); return 0; } } else { /* not a directory spec */ strcpy (dst, src); return 0; } } bracket = src[slen - 1]; /* If bracket is ']' or '>', bracket - 2 is the corresponding opening bracket. */ ptr = index (src, bracket - 2); if (ptr == 0) { /* no opening bracket */ strcpy (dst, src); return 0; } if (!(rptr = rindex (src, '.'))) rptr = ptr; slen = rptr - src; strncpy (dst, src, slen); dst[slen] = '\0'; if (*rptr == '.') { dst[slen++] = bracket; dst[slen] = '\0'; } else { /* If we have the top-level of a rooted directory (i.e. xx:[000000]), then translate the device and recurse. */ if (dst[slen - 1] == ':' && dst[slen - 2] != ':' /* skip decnet nodes */ && strcmp(src + slen, "[000000]") == 0) { dst[slen - 1] = '\0'; if ((ptr = egetenv (dst)) && (rlen = strlen (ptr) - 1) > 0 && (ptr[rlen] == ']' || ptr[rlen] == '>') && ptr[rlen - 1] == '.') { char * buf = (char *) alloca (strlen (ptr) + 1); strcpy (buf, ptr); buf[rlen - 1] = ']'; buf[rlen] = '\0'; return directory_file_name (buf, dst); } else dst[slen - 1] = ':'; } strcat (dst, "[000000]"); slen += 8; } rptr++; rlen = strlen (rptr) - 1; strncat (dst, rptr, rlen); dst[slen + rlen] = '\0'; strcat (dst, ".DIR.1"); return 1; } #endif /* VMS */ /* Process as Unix format: just remove any final slash. But leave "/" unchanged; do not change it to "". */ strcpy (dst, src); #ifdef APOLLO /* Handle // as root for apollo's. */ if ((slen > 2 && dst[slen - 1] == '/') || (slen > 1 && dst[0] != '/' && dst[slen - 1] == '/')) dst[slen - 1] = 0; #else if (slen > 1 && IS_DIRECTORY_SEP (dst[slen - 1]) #ifdef DOS_NT && !IS_ANY_SEP (dst[slen - 2]) #endif ) dst[slen - 1] = 0; #endif return 1; } DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name, 1, 1, 0, "Returns the file name of the directory named DIR.\n\ This is the name of the file that holds the data for the directory DIR.\n\ This operation exists because a directory is also a file, but its name as\n\ a directory is different from its name as a file.\n\ In Unix-syntax, this function just removes the final slash.\n\ On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\ it returns a file name such as \"[X]Y.DIR.1\".") (directory) Lisp_Object directory; { char *buf; Lisp_Object handler; CHECK_STRING (directory, 0); if (NILP (directory)) return Qnil; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (directory, Qdirectory_file_name); if (!NILP (handler)) return call2 (handler, Qdirectory_file_name, directory); #ifdef VMS /* 20 extra chars is insufficient for VMS, since we might perform a logical name translation. an equivalence string can be up to 255 chars long, so grab that much extra space... - sss */ buf = (char *) alloca (XSTRING (directory)->size + 20 + 255); #else buf = (char *) alloca (XSTRING (directory)->size + 20); #endif directory_file_name (XSTRING (directory)->data, buf); return build_string (buf); } DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0, "Generate temporary file name (string) starting with PREFIX (a string).\n\ The Emacs process number forms part of the result,\n\ so there is no danger of generating a name being used by another process.") (prefix) Lisp_Object prefix; { Lisp_Object val; val = concat2 (prefix, build_string ("XXXXXX")); mktemp (XSTRING (val)->data); return val; } DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, "Convert FILENAME to absolute, and canonicalize it.\n\ Second arg DEFAULT is directory to start with if FILENAME is relative\n\ (does not start with slash); if DEFAULT is nil or missing,\n\ the current buffer's value of default-directory is used.\n\ Path components that are `.' are removed, and \n\ path components followed by `..' are removed, along with the `..' itself;\n\ note that these simplifications are done without checking the resulting\n\ paths in the file system.\n\ An initial `~/' expands to your home directory.\n\ An initial `~USER/' expands to USER's home directory.\n\ See also the function `substitute-in-file-name'.") (name, defalt) Lisp_Object name, defalt; { unsigned char *nm; register unsigned char *newdir, *p, *o; int tlen; unsigned char *target; struct passwd *pw; #ifdef VMS unsigned char * colon = 0; unsigned char * close = 0; unsigned char * slash = 0; unsigned char * brack = 0; int lbrack = 0, rbrack = 0; int dots = 0; #endif /* VMS */ #ifdef DOS_NT /* Demacs 1.1.2 91/10/20 Manabu Higashida */ int drive = -1; int relpath = 0; unsigned char *tmp, *defdir; #endif /* DOS_NT */ Lisp_Object handler; CHECK_STRING (name, 0); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (name, Qexpand_file_name); if (!NILP (handler)) return call3 (handler, Qexpand_file_name, name, defalt); /* Use the buffer's default-directory if DEFALT is omitted. */ if (NILP (defalt)) defalt = current_buffer->directory; CHECK_STRING (defalt, 1); if (!NILP (defalt)) { handler = Ffind_file_name_handler (defalt, Qexpand_file_name); if (!NILP (handler)) return call3 (handler, Qexpand_file_name, name, defalt); } o = XSTRING (defalt)->data; /* Make sure DEFALT is properly expanded. It would be better to do this down below where we actually use defalt. Unfortunately, calling Fexpand_file_name recursively could invoke GC, and the strings might be relocated. This would be annoying because we have pointers into strings lying around that would need adjusting, and people would add new pointers to the code and forget to adjust them, resulting in intermittent bugs. Putting this call here avoids all that crud. The EQ test avoids infinite recursion. */ if (! NILP (defalt) && !EQ (defalt, name) /* This saves time in a common case. */ && ! (XSTRING (defalt)->size >= 3 && IS_DIRECTORY_SEP (XSTRING (defalt)->data[0]) && IS_DEVICE_SEP (XSTRING (defalt)->data[1]))) { struct gcpro gcpro1; GCPRO1 (name); defalt = Fexpand_file_name (defalt, Qnil); UNGCPRO; } #ifdef VMS /* Filenames on VMS are always upper case. */ name = Fupcase (name); #endif #ifdef FILE_SYSTEM_CASE name = FILE_SYSTEM_CASE (name); #endif nm = XSTRING (name)->data; #ifdef MSDOS /* First map all backslashes to slashes. */ dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm)); #endif #ifdef DOS_NT /* Now strip drive name. */ { unsigned char *colon = rindex (nm, ':'); if (colon) if (nm == colon) nm++; else { drive = colon[-1]; nm = colon + 1; if (!IS_DIRECTORY_SEP (*nm)) { defdir = alloca (MAXPATHLEN + 1); relpath = getdefdir (tolower (drive) - 'a' + 1, defdir); } } } #endif /* DOS_NT */ /* Handle // and /~ in middle of file name by discarding everything through the first / of that sequence. */ p = nm; while (*p) { /* Since we know the path is absolute, we can assume that each element starts with a "/". */ /* "//" anywhere isn't necessarily hairy; we just start afresh with the second slash. */ if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]) #if defined (APOLLO) || defined (WINDOWSNT) /* // at start of filename is meaningful on Apollo and WindowsNT systems */ && nm != p #endif /* APOLLO || WINDOWSNT */ ) nm = p + 1; /* "~" is hairy as the start of any path element. */ if (IS_DIRECTORY_SEP (p[0]) && p[1] == '~') nm = p + 1; p++; } /* If nm is absolute, flush ...// and detect /./ and /../. If no /./ or /../ we can return right away. */ if ( IS_DIRECTORY_SEP (nm[0]) #ifdef VMS || index (nm, ':') #endif /* VMS */ ) { /* If it turns out that the filename we want to return is just a suffix of FILENAME, we don't need to go through and edit things; we just need to construct a new string using data starting at the middle of FILENAME. If we set lose to a non-zero value, that means we've discovered that we can't do that cool trick. */ int lose = 0; p = nm; while (*p) { /* Since we know the path is absolute, we can assume that each element starts with a "/". */ /* "." and ".." are hairy. */ if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && (IS_DIRECTORY_SEP (p[2]) || p[2] == 0 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)))) lose = 1; #ifdef VMS if (p[0] == '\\') lose = 1; if (p[0] == '/') { /* if dev:[dir]/, move nm to / */ if (!slash && p > nm && (brack || colon)) { nm = (brack ? brack + 1 : colon + 1); lbrack = rbrack = 0; brack = 0; colon = 0; } slash = p; } if (p[0] == '-') #ifndef VMS4_4 /* VMS pre V4.4,convert '-'s in filenames. */ if (lbrack == rbrack) { if (dots < 2) /* this is to allow negative version numbers */ p[0] = '_'; } else #endif /* VMS4_4 */ if (lbrack > rbrack && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') && (p[1] == '.' || p[1] == ']' || p[1] == '>'))) lose = 1; #ifndef VMS4_4 else p[0] = '_'; #endif /* VMS4_4 */ /* count open brackets, reset close bracket pointer */ if (p[0] == '[' || p[0] == '<') lbrack++, brack = 0; /* count close brackets, set close bracket pointer */ if (p[0] == ']' || p[0] == '>') rbrack++, brack = p; /* detect ][ or >< */ if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<')) lose = 1; if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~') nm = p + 1, lose = 1; if (p[0] == ':' && (colon || slash)) /* if dev1:[dir]dev2:, move nm to dev2: */ if (brack) { nm = brack + 1; brack = 0; } /* if /pathname/dev:, move nm to dev: */ else if (slash) nm = slash + 1; /* if node::dev:, move colon following dev */ else if (colon && colon[-1] == ':') colon = p; /* if dev1:dev2:, move nm to dev2: */ else if (colon && colon[-1] != ':') { nm = colon + 1; colon = 0; } if (p[0] == ':' && !colon) { if (p[1] == ':') p++; colon = p; } if (lbrack == rbrack) if (p[0] == ';') dots = 2; else if (p[0] == '.') dots++; #endif /* VMS */ p++; } if (!lose) { #ifdef VMS if (index (nm, '/')) return build_string (sys_translate_unix (nm)); #endif /* VMS */ #ifndef DOS_NT if (nm == XSTRING (name)->data) return name; return build_string (nm); #endif /* not DOS_NT */ } } /* Now determine directory to start with and put it in newdir */ newdir = 0; if (nm[0] == '~') /* prefix ~ */ { if (IS_DIRECTORY_SEP (nm[1]) #ifdef VMS || nm[1] == ':' #endif /* VMS */ || nm[1] == 0) /* ~ by itself */ { if (!(newdir = (unsigned char *) egetenv ("HOME"))) newdir = (unsigned char *) ""; #ifdef DOS_NT /* Problem when expanding "~\" if HOME is not on current drive. Ulrich Leodolter, Wed Jan 11 10:20:35 1995 */ if (newdir[1] == ':') drive = newdir[0]; dostounix_filename (newdir); #endif nm++; #ifdef VMS nm++; /* Don't leave the slash in nm. */ #endif /* VMS */ } else /* ~user/filename */ { for (p = nm; *p && (!IS_DIRECTORY_SEP (*p) #ifdef VMS && *p != ':' #endif /* VMS */ ); p++); o = (unsigned char *) alloca (p - nm + 1); bcopy ((char *) nm, o, p - nm); o [p - nm] = 0; #ifdef WINDOWSNT newdir = (unsigned char *) egetenv ("HOME"); dostounix_filename (newdir); #else /* not WINDOWSNT */ pw = (struct passwd *) getpwnam (o + 1); if (pw) { newdir = (unsigned char *) pw -> pw_dir; #ifdef VMS nm = p + 1; /* skip the terminator */ #else nm = p; #endif /* VMS */ } #endif /* not WINDOWSNT */ /* If we don't find a user of that name, leave the name unchanged; don't move nm forward to p. */ } } if (!IS_ANY_SEP (nm[0]) #ifdef VMS && !index (nm, ':') #endif /* not VMS */ #ifdef DOS_NT && drive == -1 #endif /* DOS_NT */ && !newdir) { newdir = XSTRING (defalt)->data; } #ifdef DOS_NT if (newdir == 0 && relpath) newdir = defdir; #endif /* DOS_NT */ if (newdir != 0) { /* Get rid of any slash at the end of newdir. */ int length = strlen (newdir); /* Adding `length > 1 &&' makes ~ expand into / when homedir is the root dir. People disagree about whether that is right. Anyway, we can't take the risk of this change now. */ #ifdef DOS_NT if (newdir[1] != ':' && length > 1) #endif if (IS_DIRECTORY_SEP (newdir[length - 1])) { unsigned char *temp = (unsigned char *) alloca (length); bcopy (newdir, temp, length - 1); temp[length - 1] = 0; newdir = temp; } tlen = length + 1; } else tlen = 0; /* Now concatenate the directory and name to new space in the stack frame */ tlen += strlen (nm) + 1; #ifdef DOS_NT /* Add reserved space for drive name. (The Microsoft x86 compiler produces incorrect code if the following two lines are combined.) */ target = (unsigned char *) alloca (tlen + 2); target += 2; #else /* not DOS_NT */ target = (unsigned char *) alloca (tlen); #endif /* not DOS_NT */ *target = 0; if (newdir) { #ifndef VMS if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0])) strcpy (target, newdir); else #endif file_name_as_directory (target, newdir); } strcat (target, nm); #ifdef VMS if (index (target, '/')) strcpy (target, sys_translate_unix (target)); #endif /* VMS */ /* Now canonicalize by removing /. and /foo/.. if they appear. */ p = target; o = target; while (*p) { #ifdef VMS if (*p != ']' && *p != '>' && *p != '-') { if (*p == '\\') p++; *o++ = *p++; } else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2) /* brackets are offset from each other by 2 */ { p += 2; if (*p != '.' && *p != '-' && o[-1] != '.') /* convert [foo][bar] to [bar] */ while (o[-1] != '[' && o[-1] != '<') o--; else if (*p == '-' && *o != '.') *--p = '.'; } else if (p[0] == '-' && o[-1] == '.' && (p[1] == '.' || p[1] == ']' || p[1] == '>')) /* flush .foo.- ; leave - if stopped by '[' or '<' */ { do o--; while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<'); if (p[1] == '.') /* foo.-.bar ==> bar. */ p += 2; else if (o[-1] == '.') /* '.foo.-]' ==> ']' */ p++, o--; /* else [foo.-] ==> [-] */ } else { #ifndef VMS4_4 if (*p == '-' && o[-1] != '[' && o[-1] != '<' && o[-1] != '.' && p[1] != ']' && p[1] != '>' && p[1] != '.') *p = '_'; #endif /* VMS4_4 */ *o++ = *p++; } #else /* not VMS */ if (!IS_DIRECTORY_SEP (*p)) { *o++ = *p++; } else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]) #if defined (APOLLO) || defined (WINDOWSNT) /* // at start of filename is meaningful in Apollo and WindowsNT systems */ && o != target #endif /* APOLLO */ ) { o = target; p++; } else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && (IS_DIRECTORY_SEP (p[2]) || p[2] == 0)) { /* If "/." is the entire filename, keep the "/". Otherwise, just delete the whole "/.". */ if (o == target && p[2] == '\0') *o++ = *p; p += 2; } else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.' /* `/../' is the "superroot" on certain file systems. */ && o != target && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)) { while (o != target && (--o) && !IS_DIRECTORY_SEP (*o)) ; #if defined (APOLLO) || defined (WINDOWSNT) if (o == target + 1 && IS_DIRECTORY_SEP (o[-1]) && IS_DIRECTORY_SEP (o[0])) ++o; else #endif /* APOLLO || WINDOWSNT */ if (o == target && IS_ANY_SEP (*o)) ++o; p += 3; } else { *o++ = *p++; } #endif /* not VMS */ } #ifdef DOS_NT /* at last, set drive name. */ if (target[1] != ':' #ifdef WINDOWSNT /* Allow network paths that look like "\\foo" */ && !(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])) #endif /* WINDOWSNT */ ) { target -= 2; target[0] = (drive < 0 ? getdisk () + 'A' : drive); target[1] = ':'; } #endif /* DOS_NT */ return make_string (target, o - target); } #if 0 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */ DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, "Convert FILENAME to absolute, and canonicalize it.\n\ Second arg DEFAULT is directory to start with if FILENAME is relative\n\ (does not start with slash); if DEFAULT is nil or missing,\n\ the current buffer's value of default-directory is used.\n\ Filenames containing `.' or `..' as components are simplified;\n\ initial `~/' expands to your home directory.\n\ See also the function `substitute-in-file-name'.") (name, defalt) Lisp_Object name, defalt; { unsigned char *nm; register unsigned char *newdir, *p, *o; int tlen; unsigned char *target; struct passwd *pw; int lose; #ifdef VMS unsigned char * colon = 0; unsigned char * close = 0; unsigned char * slash = 0; unsigned char * brack = 0; int lbrack = 0, rbrack = 0; int dots = 0; #endif /* VMS */ CHECK_STRING (name, 0); #ifdef VMS /* Filenames on VMS are always upper case. */ name = Fupcase (name); #endif nm = XSTRING (name)->data; /* If nm is absolute, flush ...// and detect /./ and /../. If no /./ or /../ we can return right away. */ if ( nm[0] == '/' #ifdef VMS || index (nm, ':') #endif /* VMS */ ) { p = nm; lose = 0; while (*p) { if (p[0] == '/' && p[1] == '/' #ifdef APOLLO /* // at start of filename is meaningful on Apollo system */ && nm != p #endif /* APOLLO */ ) nm = p + 1; if (p[0] == '/' && p[1] == '~') nm = p + 1, lose = 1; if (p[0] == '/' && p[1] == '.' && (p[2] == '/' || p[2] == 0 || (p[2] == '.' && (p[3] == '/' || p[3] == 0)))) lose = 1; #ifdef VMS if (p[0] == '\\') lose = 1; if (p[0] == '/') { /* if dev:[dir]/, move nm to / */ if (!slash && p > nm && (brack || colon)) { nm = (brack ? brack + 1 : colon + 1); lbrack = rbrack = 0; brack = 0; colon = 0; } slash = p; } if (p[0] == '-') #ifndef VMS4_4 /* VMS pre V4.4,convert '-'s in filenames. */ if (lbrack == rbrack) { if (dots < 2) /* this is to allow negative version numbers */ p[0] = '_'; } else #endif /* VMS4_4 */ if (lbrack > rbrack && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') && (p[1] == '.' || p[1] == ']' || p[1] == '>'))) lose = 1; #ifndef VMS4_4 else p[0] = '_'; #endif /* VMS4_4 */ /* count open brackets, reset close bracket pointer */ if (p[0] == '[' || p[0] == '<') lbrack++, brack = 0; /* count close brackets, set close bracket pointer */ if (p[0] == ']' || p[0] == '>') rbrack++, brack = p; /* detect ][ or >< */ if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<')) lose = 1; if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~') nm = p + 1, lose = 1; if (p[0] == ':' && (colon || slash)) /* if dev1:[dir]dev2:, move nm to dev2: */ if (brack) { nm = brack + 1; brack = 0; } /* if /pathname/dev:, move nm to dev: */ else if (slash) nm = slash + 1; /* if node::dev:, move colon following dev */ else if (colon && colon[-1] == ':') colon = p; /* if dev1:dev2:, move nm to dev2: */ else if (colon && colon[-1] != ':') { nm = colon + 1; colon = 0; } if (p[0] == ':' && !colon) { if (p[1] == ':') p++; colon = p; } if (lbrack == rbrack) if (p[0] == ';') dots = 2; else if (p[0] == '.') dots++; #endif /* VMS */ p++; } if (!lose) { #ifdef VMS if (index (nm, '/')) return build_string (sys_translate_unix (nm)); #endif /* VMS */ if (nm == XSTRING (name)->data) return name; return build_string (nm); } } /* Now determine directory to start with and put it in NEWDIR */ newdir = 0; if (nm[0] == '~') /* prefix ~ */ if (nm[1] == '/' #ifdef VMS || nm[1] == ':' #endif /* VMS */ || nm[1] == 0)/* ~/filename */ { if (!(newdir = (unsigned char *) egetenv ("HOME"))) newdir = (unsigned char *) ""; nm++; #ifdef VMS nm++; /* Don't leave the slash in nm. */ #endif /* VMS */ } else /* ~user/filename */ { /* Get past ~ to user */ unsigned char *user = nm + 1; /* Find end of name. */ unsigned char *ptr = (unsigned char *) index (user, '/'); int len = ptr ? ptr - user : strlen (user); #ifdef VMS unsigned char *ptr1 = index (user, ':'); if (ptr1 != 0 && ptr1 - user < len) len = ptr1 - user; #endif /* VMS */ /* Copy the user name into temp storage. */ o = (unsigned char *) alloca (len + 1); bcopy ((char *) user, o, len); o[len] = 0; /* Look up the user name. */ pw = (struct passwd *) getpwnam (o + 1); if (!pw) error ("\"%s\" isn't a registered user", o + 1); newdir = (unsigned char *) pw->pw_dir; /* Discard the user name from NM. */ nm += len; } if (nm[0] != '/' #ifdef VMS && !index (nm, ':') #endif /* not VMS */ && !newdir) { if (NILP (defalt)) defalt = current_buffer->directory; CHECK_STRING (defalt, 1); newdir = XSTRING (defalt)->data; } /* Now concatenate the directory and name to new space in the stack frame */ tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1; target = (unsigned char *) alloca (tlen); *target = 0; if (newdir) { #ifndef VMS if (nm[0] == 0 || nm[0] == '/') strcpy (target, newdir); else #endif file_name_as_directory (target, newdir); } strcat (target, nm); #ifdef VMS if (index (target, '/')) strcpy (target, sys_translate_unix (target)); #endif /* VMS */ /* Now canonicalize by removing /. and /foo/.. if they appear */ p = target; o = target; while (*p) { #ifdef VMS if (*p != ']' && *p != '>' && *p != '-') { if (*p == '\\') p++; *o++ = *p++; } else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2) /* brackets are offset from each other by 2 */ { p += 2; if (*p != '.' && *p != '-' && o[-1] != '.') /* convert [foo][bar] to [bar] */ while (o[-1] != '[' && o[-1] != '<') o--; else if (*p == '-' && *o != '.') *--p = '.'; } else if (p[0] == '-' && o[-1] == '.' && (p[1] == '.' || p[1] == ']' || p[1] == '>')) /* flush .foo.- ; leave - if stopped by '[' or '<' */ { do o--; while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<'); if (p[1] == '.') /* foo.-.bar ==> bar. */ p += 2; else if (o[-1] == '.') /* '.foo.-]' ==> ']' */ p++, o--; /* else [foo.-] ==> [-] */ } else { #ifndef VMS4_4 if (*p == '-' && o[-1] != '[' && o[-1] != '<' && o[-1] != '.' && p[1] != ']' && p[1] != '>' && p[1] != '.') *p = '_'; #endif /* VMS4_4 */ *o++ = *p++; } #else /* not VMS */ if (*p != '/') { *o++ = *p++; } else if (!strncmp (p, "//", 2) #ifdef APOLLO /* // at start of filename is meaningful in Apollo system */ && o != target #endif /* APOLLO */ ) { o = target; p++; } else if (p[0] == '/' && p[1] == '.' && (p[2] == '/' || p[2] == 0)) p += 2; else if (!strncmp (p, "/..", 3) /* `/../' is the "superroot" on certain file systems. */ && o != target && (p[3] == '/' || p[3] == 0)) { while (o != target && *--o != '/') ; #ifdef APOLLO if (o == target + 1 && o[-1] == '/' && o[0] == '/') ++o; else #endif /* APOLLO */ if (o == target && *o == '/') ++o; p += 3; } else { *o++ = *p++; } #endif /* not VMS */ } return make_string (target, o - target); } #endif DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, Ssubstitute_in_file_name, 1, 1, 0, "Substitute environment variables referred to in FILENAME.\n\ `$FOO' where FOO is an environment variable name means to substitute\n\ the value of that variable. The variable name should be terminated\n\ with a character not a letter, digit or underscore; otherwise, enclose\n\ the entire variable name in braces.\n\ If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\ On VMS, `$' substitution is not done; this function does little and only\n\ duplicates what `expand-file-name' does.") (string) Lisp_Object string; { unsigned char *nm; register unsigned char *s, *p, *o, *x, *endp; unsigned char *target; int total = 0; int substituted = 0; unsigned char *xnm; Lisp_Object handler; CHECK_STRING (string, 0); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name); if (!NILP (handler)) return call2 (handler, Qsubstitute_in_file_name, string); nm = XSTRING (string)->data; #ifdef MSDOS dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm)); substituted = !strcmp (nm, XSTRING (string)->data); #endif endp = nm + XSTRING (string)->size; /* If /~ or // appears, discard everything through first slash. */ for (p = nm; p != endp; p++) { if ((p[0] == '~' || #ifdef APOLLO /* // at start of file name is meaningful in Apollo system */ (p[0] == '/' && p - 1 != nm) #else /* not APOLLO */ #ifdef WINDOWSNT (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) #else /* not WINDOWSNT */ p[0] == '/' #endif /* not WINDOWSNT */ #endif /* not APOLLO */ ) && p != nm && (0 #ifdef VMS || p[-1] == ':' || p[-1] == ']' || p[-1] == '>' #endif /* VMS */ || IS_DIRECTORY_SEP (p[-1]))) { nm = p; substituted = 1; } #ifdef DOS_NT if (p[0] && p[1] == ':') { nm = p; substituted = 1; } #endif /* DOS_NT */ } #ifdef VMS return build_string (nm); #else /* See if any variables are substituted into the string and find the total length of their values in `total' */ for (p = nm; p != endp;) if (*p != '$') p++; else { p++; if (p == endp) goto badsubst; else if (*p == '$') { /* "$$" means a single "$" */ p++; total -= 1; substituted = 1; continue; } else if (*p == '{') { o = ++p; while (p != endp && *p != '}') p++; if (*p != '}') goto missingclose; s = p; } else { o = p; while (p != endp && (isalnum (*p) || *p == '_')) p++; s = p; } /* Copy out the variable name */ target = (unsigned char *) alloca (s - o + 1); strncpy (target, o, s - o); target[s - o] = 0; #ifdef DOS_NT strupr (target); /* $home == $HOME etc. */ #endif /* DOS_NT */ /* Get variable value */ o = (unsigned char *) egetenv (target); if (!o) goto badvar; total += strlen (o); substituted = 1; } if (!substituted) return string; /* If substitution required, recopy the string and do it */ /* Make space in stack frame for the new copy */ xnm = (unsigned char *) alloca (XSTRING (string)->size + total + 1); x = xnm; /* Copy the rest of the name through, replacing $ constructs with values */ for (p = nm; *p;) if (*p != '$') *x++ = *p++; else { p++; if (p == endp) goto badsubst; else if (*p == '$') { *x++ = *p++; continue; } else if (*p == '{') { o = ++p; while (p != endp && *p != '}') p++; if (*p != '}') goto missingclose; s = p++; } else { o = p; while (p != endp && (isalnum (*p) || *p == '_')) p++; s = p; } /* Copy out the variable name */ target = (unsigned char *) alloca (s - o + 1); strncpy (target, o, s - o); target[s - o] = 0; #ifdef DOS_NT strupr (target); /* $home == $HOME etc. */ #endif /* DOS_NT */ /* Get variable value */ o = (unsigned char *) egetenv (target); if (!o) goto badvar; strcpy (x, o); x += strlen (o); } *x = 0; /* If /~ or // appears, discard everything through first slash. */ for (p = xnm; p != x; p++) if ((p[0] == '~' #ifdef APOLLO /* // at start of file name is meaningful in Apollo system */ || (p[0] == '/' && p - 1 != xnm) #else /* not APOLLO */ #ifdef WINDOWSNT || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm) #else /* not WINDOWSNT */ || p[0] == '/' #endif /* not WINDOWSNT */ #endif /* not APOLLO */ ) && p != nm && IS_DIRECTORY_SEP (p[-1])) xnm = p; #ifdef DOS_NT else if (p[0] && p[1] == ':') xnm = p; #endif return make_string (xnm, x - xnm); badsubst: error ("Bad format environment-variable substitution"); missingclose: error ("Missing \"}\" in environment-variable substitution"); badvar: error ("Substituting nonexistent environment variable \"%s\"", target); /* NOTREACHED */ #endif /* not VMS */ } /* A slightly faster and more convenient way to get (directory-file-name (expand-file-name FOO)). */ Lisp_Object expand_and_dir_to_file (filename, defdir) Lisp_Object filename, defdir; { register Lisp_Object abspath; abspath = Fexpand_file_name (filename, defdir); #ifdef VMS { register int c = XSTRING (abspath)->data[XSTRING (abspath)->size - 1]; if (c == ':' || c == ']' || c == '>') abspath = Fdirectory_file_name (abspath); } #else /* Remove final slash, if any (unless path is root). stat behaves differently depending! */ if (XSTRING (abspath)->size > 1 && IS_DIRECTORY_SEP (XSTRING (abspath)->data[XSTRING (abspath)->size - 1]) && !IS_DEVICE_SEP (XSTRING (abspath)->data[XSTRING (abspath)->size-2])) /* We cannot take shortcuts; they might be wrong for magic file names. */ abspath = Fdirectory_file_name (abspath); #endif return abspath; } /* Signal an error if the file ABSNAME already exists. If INTERACTIVE is nonzero, ask the user whether to proceed, and bypass the error if the user says to go ahead. QUERYSTRING is a name for the action that is being considered to alter the file. *STATPTR is used to store the stat information if the file exists. If the file does not exist, STATPTR->st_mode is set to 0. */ void barf_or_query_if_file_exists (absname, querystring, interactive, statptr) Lisp_Object absname; unsigned char *querystring; int interactive; struct stat *statptr; { register Lisp_Object tem; struct stat statbuf; struct gcpro gcpro1; /* stat is a good way to tell whether the file exists, regardless of what access permissions it has. */ if (stat (XSTRING (absname)->data, &statbuf) >= 0) { if (! interactive) Fsignal (Qfile_already_exists, Fcons (build_string ("File already exists"), Fcons (absname, Qnil))); GCPRO1 (absname); tem = do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ", XSTRING (absname)->data, querystring)); UNGCPRO; if (NILP (tem)) Fsignal (Qfile_already_exists, Fcons (build_string ("File already exists"), Fcons (absname, Qnil))); if (statptr) *statptr = statbuf; } else { if (statptr) statptr->st_mode = 0; } return; } DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4, "fCopy file: \nFCopy %s to file: \np\nP", "Copy FILE to NEWNAME. Both args must be strings.\n\ Signals a `file-already-exists' error if file NEWNAME already exists,\n\ unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\ A number as third arg means request confirmation if NEWNAME already exists.\n\ This is what happens in interactive use with M-x.\n\ Fourth arg KEEP-TIME non-nil means give the new file the same\n\ last-modified time as the old one. (This works on only some systems.)\n\ A prefix arg makes KEEP-TIME non-nil.") (filename, newname, ok_if_already_exists, keep_date) Lisp_Object filename, newname, ok_if_already_exists, keep_date; { int ifd, ofd, n; char buf[16 * 1024]; struct stat st, out_st; Lisp_Object handler; struct gcpro gcpro1, gcpro2; int count = specpdl_ptr - specpdl; int input_file_statable_p; GCPRO2 (filename, newname); CHECK_STRING (filename, 0); CHECK_STRING (newname, 1); filename = Fexpand_file_name (filename, Qnil); newname = Fexpand_file_name (newname, Qnil); /* If the input file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qcopy_file); /* Likewise for output file name. */ if (NILP (handler)) handler = Ffind_file_name_handler (newname, Qcopy_file); if (!NILP (handler)) RETURN_UNGCPRO (call5 (handler, Qcopy_file, filename, newname, ok_if_already_exists, keep_date)); if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) barf_or_query_if_file_exists (newname, "copy to it", INTEGERP (ok_if_already_exists), &out_st); else if (stat (XSTRING (newname)->data, &out_st) < 0) out_st.st_mode = 0; ifd = open (XSTRING (filename)->data, O_RDONLY); if (ifd < 0) report_file_error ("Opening input file", Fcons (filename, Qnil)); record_unwind_protect (close_file_unwind, make_number (ifd)); /* We can only copy regular files and symbolic links. Other files are not copyable by us. */ input_file_statable_p = (fstat (ifd, &st) >= 0); #ifndef DOS_NT if (out_st.st_mode != 0 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) { errno = 0; report_file_error ("Input and output files are the same", Fcons (filename, Fcons (newname, Qnil))); } #endif #if defined (S_ISREG) && defined (S_ISLNK) if (input_file_statable_p) { if (!(S_ISREG (st.st_mode)) && !(S_ISLNK (st.st_mode))) { #if defined (EISDIR) /* Get a better looking error message. */ errno = EISDIR; #endif /* EISDIR */ report_file_error ("Non-regular file", Fcons (filename, Qnil)); } } #endif /* S_ISREG && S_ISLNK */ #ifdef VMS /* Create the copy file with the same record format as the input file */ ofd = sys_creat (XSTRING (newname)->data, 0666, ifd); #else #ifdef MSDOS /* System's default file type was set to binary by _fmode in emacs.c. */ ofd = creat (XSTRING (newname)->data, S_IREAD | S_IWRITE); #else /* not MSDOS */ ofd = creat (XSTRING (newname)->data, 0666); #endif /* not MSDOS */ #endif /* VMS */ if (ofd < 0) report_file_error ("Opening output file", Fcons (newname, Qnil)); record_unwind_protect (close_file_unwind, make_number (ofd)); immediate_quit = 1; QUIT; while ((n = read (ifd, buf, sizeof buf)) > 0) if (write (ofd, buf, n) != n) report_file_error ("I/O error", Fcons (newname, Qnil)); immediate_quit = 0; /* Closing the output clobbers the file times on some systems. */ if (close (ofd) < 0) report_file_error ("I/O error", Fcons (newname, Qnil)); if (input_file_statable_p) { if (!NILP (keep_date)) { EMACS_TIME atime, mtime; EMACS_SET_SECS_USECS (atime, st.st_atime, 0); EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); if (set_file_times (XSTRING (newname)->data, atime, mtime)) report_file_error ("I/O error", Fcons (newname, Qnil)); } #ifndef MSDOS chmod (XSTRING (newname)->data, st.st_mode & 07777); #else /* MSDOS */ #if defined (__DJGPP__) && __DJGPP__ > 1 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits, and if it can't, it tells so. Otherwise, under MSDOS we usually get only the READ bit, which will make the copied file read-only, so it's better not to chmod at all. */ if ((_djstat_flags & _STFAIL_WRITEBIT) == 0) chmod (XSTRING (newname)->data, st.st_mode & 07777); #endif /* DJGPP version 2 or newer */ #endif /* MSDOS */ } close (ifd); /* Discard the unwind protects. */ specpdl_ptr = specpdl + count; UNGCPRO; return Qnil; } DEFUN ("make-directory-internal", Fmake_directory_internal, Smake_directory_internal, 1, 1, 0, "Create a directory. One argument, a file name string.") (dirname) Lisp_Object dirname; { unsigned char *dir; Lisp_Object handler; CHECK_STRING (dirname, 0); dirname = Fexpand_file_name (dirname, Qnil); handler = Ffind_file_name_handler (dirname, Qmake_directory_internal); if (!NILP (handler)) return call2 (handler, Qmake_directory_internal, dirname); dir = XSTRING (dirname)->data; #ifdef WINDOWSNT if (mkdir (dir) != 0) #else if (mkdir (dir, 0777) != 0) #endif report_file_error ("Creating directory", Flist (1, &dirname)); return Qnil; } DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ", "Delete a directory. One argument, a file name or directory name string.") (dirname) Lisp_Object dirname; { unsigned char *dir; Lisp_Object handler; CHECK_STRING (dirname, 0); dirname = Fdirectory_file_name (Fexpand_file_name (dirname, Qnil)); dir = XSTRING (dirname)->data; handler = Ffind_file_name_handler (dirname, Qdelete_directory); if (!NILP (handler)) return call2 (handler, Qdelete_directory, dirname); if (rmdir (dir) != 0) report_file_error ("Removing directory", Flist (1, &dirname)); return Qnil; } DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ", "Delete specified file. One argument, a file name string.\n\ If file has multiple names, it continues to exist with the other names.") (filename) Lisp_Object filename; { Lisp_Object handler; CHECK_STRING (filename, 0); filename = Fexpand_file_name (filename, Qnil); handler = Ffind_file_name_handler (filename, Qdelete_file); if (!NILP (handler)) return call2 (handler, Qdelete_file, filename); if (0 > unlink (XSTRING (filename)->data)) report_file_error ("Removing old name", Flist (1, &filename)); return Qnil; } static Lisp_Object internal_delete_file_1 (ignore) Lisp_Object ignore; { return Qt; } /* Delete file FILENAME, returning 1 if successful and 0 if failed. */ int internal_delete_file (filename) Lisp_Object filename; { return NILP (internal_condition_case_1 (Fdelete_file, filename, Qt, internal_delete_file_1)); } DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, "fRename file: \nFRename %s to file: \np", "Rename FILE as NEWNAME. Both args strings.\n\ If file has names other than FILE, it continues to have those names.\n\ Signals a `file-already-exists' error if a file NEWNAME already exists\n\ unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ A number as third arg means request confirmation if NEWNAME already exists.\n\ This is what happens in interactive use with M-x.") (filename, newname, ok_if_already_exists) Lisp_Object filename, newname, ok_if_already_exists; { #ifdef NO_ARG_ARRAY Lisp_Object args[2]; #endif Lisp_Object handler; struct gcpro gcpro1, gcpro2; GCPRO2 (filename, newname); CHECK_STRING (filename, 0); CHECK_STRING (newname, 1); filename = Fexpand_file_name (filename, Qnil); newname = Fexpand_file_name (newname, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qrename_file); if (NILP (handler)) handler = Ffind_file_name_handler (newname, Qrename_file); if (!NILP (handler)) RETURN_UNGCPRO (call4 (handler, Qrename_file, filename, newname, ok_if_already_exists)); if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) barf_or_query_if_file_exists (newname, "rename to it", INTEGERP (ok_if_already_exists), 0); #ifndef BSD4_1 if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data)) #else #ifdef WINDOWSNT if (!MoveFile (XSTRING (filename)->data, XSTRING (newname)->data)) #else /* not WINDOWSNT */ if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data) || 0 > unlink (XSTRING (filename)->data)) #endif /* not WINDOWSNT */ #endif { #ifdef WINDOWSNT /* Why two? And why doesn't MS document what MoveFile will return? */ if (GetLastError () == ERROR_FILE_EXISTS || GetLastError () == ERROR_ALREADY_EXISTS) #else /* not WINDOWSNT */ if (errno == EXDEV) #endif /* not WINDOWSNT */ { Fcopy_file (filename, newname, /* We have already prompted if it was an integer, so don't have copy-file prompt again. */ NILP (ok_if_already_exists) ? Qnil : Qt, Qt); Fdelete_file (filename); } else #ifdef NO_ARG_ARRAY { args[0] = filename; args[1] = newname; report_file_error ("Renaming", Flist (2, args)); } #else report_file_error ("Renaming", Flist (2, &filename)); #endif } UNGCPRO; return Qnil; } DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3, "fAdd name to file: \nFName to add to %s: \np", "Give FILE additional name NEWNAME. Both args strings.\n\ Signals a `file-already-exists' error if a file NEWNAME already exists\n\ unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ A number as third arg means request confirmation if NEWNAME already exists.\n\ This is what happens in interactive use with M-x.") (filename, newname, ok_if_already_exists) Lisp_Object filename, newname, ok_if_already_exists; { #ifdef NO_ARG_ARRAY Lisp_Object args[2]; #endif Lisp_Object handler; struct gcpro gcpro1, gcpro2; GCPRO2 (filename, newname); CHECK_STRING (filename, 0); CHECK_STRING (newname, 1); filename = Fexpand_file_name (filename, Qnil); newname = Fexpand_file_name (newname, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qadd_name_to_file); if (!NILP (handler)) RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename, newname, ok_if_already_exists)); /* If the new name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (newname, Qadd_name_to_file); if (!NILP (handler)) RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename, newname, ok_if_already_exists)); if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) barf_or_query_if_file_exists (newname, "make it a new name", INTEGERP (ok_if_already_exists), 0); #ifdef WINDOWSNT /* Windows does not support this operation. */ report_file_error ("Adding new name", Flist (2, &filename)); #else /* not WINDOWSNT */ unlink (XSTRING (newname)->data); if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data)) { #ifdef NO_ARG_ARRAY args[0] = filename; args[1] = newname; report_file_error ("Adding new name", Flist (2, args)); #else report_file_error ("Adding new name", Flist (2, &filename)); #endif } #endif /* not WINDOWSNT */ UNGCPRO; return Qnil; } #ifdef S_IFLNK DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3, "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\ Signals a `file-already-exists' error if a file LINKNAME already exists\n\ unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ A number as third arg means request confirmation if LINKNAME already exists.\n\ This happens for interactive use with M-x.") (filename, linkname, ok_if_already_exists) Lisp_Object filename, linkname, ok_if_already_exists; { #ifdef NO_ARG_ARRAY Lisp_Object args[2]; #endif Lisp_Object handler; struct gcpro gcpro1, gcpro2; GCPRO2 (filename, linkname); CHECK_STRING (filename, 0); CHECK_STRING (linkname, 1); /* If the link target has a ~, we must expand it to get a truly valid file name. Otherwise, do not expand; we want to permit links to relative file names. */ if (XSTRING (filename)->data[0] == '~') filename = Fexpand_file_name (filename, Qnil); linkname = Fexpand_file_name (linkname, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qmake_symbolic_link); if (!NILP (handler)) RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname, ok_if_already_exists)); /* If the new link name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link); if (!NILP (handler)) RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname, ok_if_already_exists)); if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) barf_or_query_if_file_exists (linkname, "make it a link", INTEGERP (ok_if_already_exists), 0); if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) { /* If we didn't complain already, silently delete existing file. */ if (errno == EEXIST) { unlink (XSTRING (linkname)->data); if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) { UNGCPRO; return Qnil; } } #ifdef NO_ARG_ARRAY args[0] = filename; args[1] = linkname; report_file_error ("Making symbolic link", Flist (2, args)); #else report_file_error ("Making symbolic link", Flist (2, &filename)); #endif } UNGCPRO; return Qnil; } #endif /* S_IFLNK */ #ifdef VMS DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name, 2, 2, "sDefine logical name: \nsDefine logical name %s as: ", "Define the job-wide logical name NAME to have the value STRING.\n\ If STRING is nil or a null string, the logical name NAME is deleted.") (varname, string) Lisp_Object varname; Lisp_Object string; { CHECK_STRING (varname, 0); if (NILP (string)) delete_logical_name (XSTRING (varname)->data); else { CHECK_STRING (string, 1); if (XSTRING (string)->size == 0) delete_logical_name (XSTRING (varname)->data); else define_logical_name (XSTRING (varname)->data, XSTRING (string)->data); } return string; } #endif /* VMS */ #ifdef HPUX_NET DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0, "Open a network connection to PATH using LOGIN as the login string.") (path, login) Lisp_Object path, login; { int netresult; CHECK_STRING (path, 0); CHECK_STRING (login, 0); netresult = netunam (XSTRING (path)->data, XSTRING (login)->data); if (netresult == -1) return Qnil; else return Qt; } #endif /* HPUX_NET */ DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p, 1, 1, 0, "Return t if file FILENAME specifies an absolute path name.\n\ On Unix, this is a name starting with a `/' or a `~'.") (filename) Lisp_Object filename; { unsigned char *ptr; CHECK_STRING (filename, 0); ptr = XSTRING (filename)->data; if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~' #ifdef VMS /* ??? This criterion is probably wrong for '<'. */ || index (ptr, ':') || index (ptr, '<') || (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']')) && ptr[1] != '.') #endif /* VMS */ #ifdef DOS_NT || (*ptr != 0 && ptr[1] == ':' && (ptr[2] == '/' || ptr[2] == '\\')) #endif ) return Qt; else return Qnil; } /* Return nonzero if file FILENAME exists and can be executed. */ static int check_executable (filename) char *filename; { #ifdef DOS_NT int len = strlen (filename); char *suffix; struct stat st; if (stat (filename, &st) < 0) return 0; return (S_ISREG (st.st_mode) && len >= 5 && (stricmp ((suffix = filename + len-4), ".com") == 0 || stricmp (suffix, ".exe") == 0 || stricmp (suffix, ".bat") == 0) || (st.st_mode & S_IFMT) == S_IFDIR); #else /* not DOS_NT */ #ifdef HAVE_EACCESS return (eaccess (filename, 1) >= 0); #else /* Access isn't quite right because it uses the real uid and we really want to test with the effective uid. But Unix doesn't give us a right way to do it. */ return (access (filename, 1) >= 0); #endif #endif /* not DOS_NT */ } /* Return nonzero if file FILENAME exists and can be written. */ static int check_writable (filename) char *filename; { #ifdef MSDOS struct stat st; if (stat (filename, &st) < 0) return 0; return (st.st_mode & S_IWRITE || (st.st_mode & S_IFMT) == S_IFDIR); #else /* not MSDOS */ #ifdef HAVE_EACCESS return (eaccess (filename, 2) >= 0); #else /* Access isn't quite right because it uses the real uid and we really want to test with the effective uid. But Unix doesn't give us a right way to do it. Opening with O_WRONLY could work for an ordinary file, but would lose for directories. */ return (access (filename, 2) >= 0); #endif #endif /* not MSDOS */ } DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0, "Return t if file FILENAME exists. (This does not mean you can read it.)\n\ See also `file-readable-p' and `file-attributes'.") (filename) Lisp_Object filename; { Lisp_Object abspath; Lisp_Object handler; struct stat statbuf; CHECK_STRING (filename, 0); abspath = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qfile_exists_p); if (!NILP (handler)) return call2 (handler, Qfile_exists_p, abspath); return (stat (XSTRING (abspath)->data, &statbuf) >= 0) ? Qt : Qnil; } DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, "Return t if FILENAME can be executed by you.\n\ For a directory, this means you can access files in that directory.") (filename) Lisp_Object filename; { Lisp_Object abspath; Lisp_Object handler; CHECK_STRING (filename, 0); abspath = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qfile_executable_p); if (!NILP (handler)) return call2 (handler, Qfile_executable_p, abspath); return (check_executable (XSTRING (abspath)->data) ? Qt : Qnil); } DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, "Return t if file FILENAME exists and you can read it.\n\ See also `file-exists-p' and `file-attributes'.") (filename) Lisp_Object filename; { Lisp_Object abspath; Lisp_Object handler; int desc; CHECK_STRING (filename, 0); abspath = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qfile_readable_p); if (!NILP (handler)) return call2 (handler, Qfile_readable_p, abspath); desc = open (XSTRING (abspath)->data, O_RDONLY); if (desc < 0) return Qnil; close (desc); return Qt; } /* Having this before file-symlink-p mysteriously caused it to be forgotten on the RT/PC. */ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, "Return t if file FILENAME can be written or created by you.") (filename) Lisp_Object filename; { Lisp_Object abspath, dir; Lisp_Object handler; struct stat statbuf; CHECK_STRING (filename, 0); abspath = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qfile_writable_p); if (!NILP (handler)) return call2 (handler, Qfile_writable_p, abspath); if (stat (XSTRING (abspath)->data, &statbuf) >= 0) return (check_writable (XSTRING (abspath)->data) ? Qt : Qnil); dir = Ffile_name_directory (abspath); #ifdef VMS if (!NILP (dir)) dir = Fdirectory_file_name (dir); #endif /* VMS */ #ifdef MSDOS if (!NILP (dir)) dir = Fdirectory_file_name (dir); #endif /* MSDOS */ return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "") ? Qt : Qnil); } DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0, "Return non-nil if file FILENAME is the name of a symbolic link.\n\ The value is the name of the file to which it is linked.\n\ Otherwise returns nil.") (filename) Lisp_Object filename; { #ifdef S_IFLNK char *buf; int bufsize; int valsize; Lisp_Object val; Lisp_Object handler; CHECK_STRING (filename, 0); filename = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qfile_symlink_p); if (!NILP (handler)) return call2 (handler, Qfile_symlink_p, filename); bufsize = 100; while (1) { buf = (char *) xmalloc (bufsize); bzero (buf, bufsize); valsize = readlink (XSTRING (filename)->data, buf, bufsize); if (valsize < bufsize) break; /* Buffer was not long enough */ xfree (buf); bufsize *= 2; } if (valsize == -1) { xfree (buf); return Qnil; } val = make_string (buf, valsize); xfree (buf); return val; #else /* not S_IFLNK */ return Qnil; #endif /* not S_IFLNK */ } DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, "Return t if file FILENAME is the name of a directory as a file.\n\ A directory name spec may be given instead; then the value is t\n\ if the directory so specified exists and really is a directory.") (filename) Lisp_Object filename; { register Lisp_Object abspath; struct stat st; Lisp_Object handler; abspath = expand_and_dir_to_file (filename, current_buffer->directory); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qfile_directory_p); if (!NILP (handler)) return call2 (handler, Qfile_directory_p, abspath); if (stat (XSTRING (abspath)->data, &st) < 0) return Qnil; return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; } DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0, "Return t if file FILENAME is the name of a directory as a file,\n\ and files in that directory can be opened by you. In order to use a\n\ directory as a buffer's current directory, this predicate must return true.\n\ A directory name spec may be given instead; then the value is t\n\ if the directory so specified exists and really is a readable and\n\ searchable directory.") (filename) Lisp_Object filename; { Lisp_Object handler; int tem; struct gcpro gcpro1; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p); if (!NILP (handler)) return call2 (handler, Qfile_accessible_directory_p, filename); /* It's an unlikely combination, but yes we really do need to gcpro: Suppose that file-accessible-directory-p has no handler, but file-directory-p does have a handler; this handler causes a GC which relocates the string in `filename'; and finally file-directory-p returns non-nil. Then we would end up passing a garbaged string to file-executable-p. */ GCPRO1 (filename); tem = (NILP (Ffile_directory_p (filename)) || NILP (Ffile_executable_p (filename))); UNGCPRO; return tem ? Qnil : Qt; } DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0, "Return t if file FILENAME is the name of a regular file.\n\ This is the sort of file that holds an ordinary stream of data bytes.") (filename) Lisp_Object filename; { register Lisp_Object abspath; struct stat st; Lisp_Object handler; abspath = expand_and_dir_to_file (filename, current_buffer->directory); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qfile_regular_p); if (!NILP (handler)) return call2 (handler, Qfile_regular_p, abspath); if (stat (XSTRING (abspath)->data, &st) < 0) return Qnil; return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; } DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, "Return mode bits of FILE, as an integer.") (filename) Lisp_Object filename; { Lisp_Object abspath; struct stat st; Lisp_Object handler; abspath = expand_and_dir_to_file (filename, current_buffer->directory); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qfile_modes); if (!NILP (handler)) return call2 (handler, Qfile_modes, abspath); if (stat (XSTRING (abspath)->data, &st) < 0) return Qnil; #ifdef DOS_NT if (check_executable (XSTRING (abspath)->data)) st.st_mode |= S_IEXEC; #endif /* DOS_NT */ return make_number (st.st_mode & 07777); } DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0, "Set mode bits of FILE to MODE (an integer).\n\ Only the 12 low bits of MODE are used.") (filename, mode) Lisp_Object filename, mode; { Lisp_Object abspath; Lisp_Object handler; abspath = Fexpand_file_name (filename, current_buffer->directory); CHECK_NUMBER (mode, 1); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath, Qset_file_modes); if (!NILP (handler)) return call3 (handler, Qset_file_modes, abspath, mode); if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0) report_file_error ("Doing chmod", Fcons (abspath, Qnil)); return Qnil; } DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0, "Set the file permission bits for newly created files.\n\ The argument MODE should be an integer; only the low 9 bits are used.\n\ This setting is inherited by subprocesses.") (mode) Lisp_Object mode; { CHECK_NUMBER (mode, 0); umask ((~ XINT (mode)) & 0777); return Qnil; } DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0, "Return the default file protection for created files.\n\ The value is an integer.") () { int realmask; Lisp_Object value; realmask = umask (0); umask (realmask); XSETINT (value, (~ realmask) & 0777); return value; } #ifdef unix DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "", "Tell Unix to finish all pending disk updates.") () { sync (); return Qnil; } #endif /* unix */ DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0, "Return t if file FILE1 is newer than file FILE2.\n\ If FILE1 does not exist, the answer is nil;\n\ otherwise, if FILE2 does not exist, the answer is t.") (file1, file2) Lisp_Object file1, file2; { Lisp_Object abspath1, abspath2; struct stat st; int mtime1; Lisp_Object handler; struct gcpro gcpro1, gcpro2; CHECK_STRING (file1, 0); CHECK_STRING (file2, 0); abspath1 = Qnil; GCPRO2 (abspath1, file2); abspath1 = expand_and_dir_to_file (file1, current_buffer->directory); abspath2 = expand_and_dir_to_file (file2, current_buffer->directory); UNGCPRO; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p); if (NILP (handler)) handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p); if (!NILP (handler)) return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2); if (stat (XSTRING (abspath1)->data, &st) < 0) return Qnil; mtime1 = st.st_mtime; if (stat (XSTRING (abspath2)->data, &st) < 0) return Qt; return (mtime1 > st.st_mtime) ? Qt : Qnil; } #ifdef DOS_NT Lisp_Object Qfind_buffer_file_type; #endif /* DOS_NT */ DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, 1, 5, 0, "Insert contents of file FILENAME after point.\n\ Returns list of absolute file name and length of data inserted.\n\ If second argument VISIT is non-nil, the buffer's visited filename\n\ and last save file modtime are set, and it is marked unmodified.\n\ If visiting and the file does not exist, visiting is completed\n\ before the error is signaled.\n\n\ The optional third and fourth arguments BEG and END\n\ specify what portion of the file to insert.\n\ If VISIT is non-nil, BEG and END must be nil.\n\ If optional fifth argument REPLACE is non-nil,\n\ it means replace the current buffer contents (in the accessible portion)\n\ with the file contents. This is better than simply deleting and inserting\n\ the whole thing because (1) it preserves some marker positions\n\ and (2) it puts less data in the undo list.") (filename, visit, beg, end, replace) Lisp_Object filename, visit, beg, end, replace; { struct stat st; register int fd; register int inserted = 0; register int how_much; int count = specpdl_ptr - specpdl; struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object handler, val, insval; Lisp_Object p; int total; int not_regular = 0; if (current_buffer->base_buffer && ! NILP (visit)) error ("Cannot do file visiting in an indirect buffer"); if (!NILP (current_buffer->read_only)) Fbarf_if_buffer_read_only (); val = Qnil; p = Qnil; GCPRO3 (filename, val, p); CHECK_STRING (filename, 0); filename = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qinsert_file_contents); if (!NILP (handler)) { val = call6 (handler, Qinsert_file_contents, filename, visit, beg, end, replace); goto handled; } fd = -1; #ifndef APOLLO if (stat (XSTRING (filename)->data, &st) < 0) #else if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0 || fstat (fd, &st) < 0) #endif /* not APOLLO */ { if (fd >= 0) close (fd); badopen: if (NILP (visit)) report_file_error ("Opening input file", Fcons (filename, Qnil)); st.st_mtime = -1; how_much = 0; goto notfound; } #ifdef S_IFREG /* This code will need to be changed in order to work on named pipes, and it's probably just not worth it. So we should at least signal an error. */ if (!S_ISREG (st.st_mode)) { if (NILP (visit)) Fsignal (Qfile_error, Fcons (build_string ("not a regular file"), Fcons (filename, Qnil))); not_regular = 1; goto notfound; } #endif if (fd < 0) if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0) goto badopen; /* Replacement should preserve point as it preserves markers. */ if (!NILP (replace)) record_unwind_protect (restore_point_unwind, Fpoint_marker ()); record_unwind_protect (close_file_unwind, make_number (fd)); /* Supposedly happens on VMS. */ if (st.st_size < 0) error ("File size is negative"); if (!NILP (beg) || !NILP (end)) if (!NILP (visit)) error ("Attempt to visit less than an entire file"); if (!NILP (beg)) CHECK_NUMBER (beg, 0); else XSETFASTINT (beg, 0); if (!NILP (end)) CHECK_NUMBER (end, 0); else { XSETINT (end, st.st_size); if (XINT (end) != st.st_size) error ("maximum buffer size exceeded"); } /* If requested, replace the accessible part of the buffer with the file contents. Avoid replacing text at the beginning or end of the buffer that matches the file contents; that preserves markers pointing to the unchanged parts. */ #ifdef DOS_NT /* On MSDOS, replace mode doesn't really work, except for binary files, and it's not worth supporting just for them. */ if (!NILP (replace)) { replace = Qnil; XSETFASTINT (beg, 0); XSETFASTINT (end, st.st_size); del_range_1 (BEGV, ZV, 0); } #else /* not DOS_NT */ if (!NILP (replace)) { unsigned char buffer[1 << 14]; int same_at_start = BEGV; int same_at_end = ZV; int overlap; immediate_quit = 1; QUIT; /* Count how many chars at the start of the file match the text at the beginning of the buffer. */ while (1) { int nread, bufpos; nread = read (fd, buffer, sizeof buffer); if (nread < 0) error ("IO error reading %s: %s", XSTRING (filename)->data, strerror (errno)); else if (nread == 0) break; bufpos = 0; while (bufpos < nread && same_at_start < ZV && FETCH_CHAR (same_at_start) == buffer[bufpos]) same_at_start++, bufpos++; /* If we found a discrepancy, stop the scan. Otherwise loop around and scan the next bufferfull. */ if (bufpos != nread) break; } immediate_quit = 0; /* If the file matches the buffer completely, there's no need to replace anything. */ if (same_at_start - BEGV == st.st_size) { close (fd); specpdl_ptr--; /* Truncate the buffer to the size of the file. */ del_range_1 (same_at_start, same_at_end, 0); goto handled; } immediate_quit = 1; QUIT; /* Count how many chars at the end of the file match the text at the end of the buffer. */ while (1) { int total_read, nread, bufpos, curpos, trial; /* At what file position are we now scanning? */ curpos = st.st_size - (ZV - same_at_end); /* If the entire file matches the buffer tail, stop the scan. */ if (curpos == 0) break; /* How much can we scan in the next step? */ trial = min (curpos, sizeof buffer); if (lseek (fd, curpos - trial, 0) < 0) report_file_error ("Setting file position", Fcons (filename, Qnil)); total_read = 0; while (total_read < trial) { nread = read (fd, buffer + total_read, trial - total_read); if (nread <= 0) error ("IO error reading %s: %s", XSTRING (filename)->data, strerror (errno)); total_read += nread; } /* Scan this bufferfull from the end, comparing with the Emacs buffer. */ bufpos = total_read; /* Compare with same_at_start to avoid counting some buffer text as matching both at the file's beginning and at the end. */ while (bufpos > 0 && same_at_end > same_at_start && FETCH_CHAR (same_at_end - 1) == buffer[bufpos - 1]) same_at_end--, bufpos--; /* If we found a discrepancy, stop the scan. Otherwise loop around and scan the preceding bufferfull. */ if (bufpos != 0) break; /* If display current starts at beginning of line, keep it that way. */ if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) XWINDOW (selected_window)->start_at_line_beg = Fbolp (); } immediate_quit = 0; /* Don't try to reuse the same piece of text twice. */ overlap = same_at_start - BEGV - (same_at_end + st.st_size - ZV); if (overlap > 0) same_at_end += overlap; /* Arrange to read only the nonmatching middle part of the file. */ XSETFASTINT (beg, same_at_start - BEGV); XSETFASTINT (end, st.st_size - (ZV - same_at_end)); del_range_1 (same_at_start, same_at_end, 0); /* Insert from the file at the proper position. */ SET_PT (same_at_start); } #endif /* not DOS_NT */ total = XINT (end) - XINT (beg); { register Lisp_Object temp; /* Make sure point-max won't overflow after this insertion. */ XSETINT (temp, total); if (total != XINT (temp)) error ("maximum buffer size exceeded"); } if (NILP (visit) && total > 0) prepare_to_modify_buffer (point, point); move_gap (point); if (GAP_SIZE < total) make_gap (total - GAP_SIZE); if (XINT (beg) != 0 || !NILP (replace)) { if (lseek (fd, XINT (beg), 0) < 0) report_file_error ("Setting file position", Fcons (filename, Qnil)); } how_much = 0; while (inserted < total) { /* try is reserved in some compilers (Microsoft C) */ int trytry = min (total - inserted, 64 << 10); int this; /* Allow quitting out of the actual I/O. */ immediate_quit = 1; QUIT; this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, trytry); immediate_quit = 0; if (this <= 0) { how_much = this; break; } GPT += this; GAP_SIZE -= this; ZV += this; Z += this; inserted += this; } #ifdef DOS_NT /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */ /* Determine file type from name and remove LFs from CR-LFs if the file is deemed to be a text file. */ { current_buffer->buffer_file_type = call1 (Qfind_buffer_file_type, filename); if (NILP (current_buffer->buffer_file_type)) { int reduced_size = inserted - crlf_to_lf (inserted, &FETCH_CHAR (point - 1) + 1); ZV -= reduced_size; Z -= reduced_size; GPT -= reduced_size; GAP_SIZE += reduced_size; inserted -= reduced_size; } } #endif /* DOS_NT */ if (inserted > 0) { record_insert (point, inserted); /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ offset_intervals (current_buffer, point, inserted); MODIFF++; } close (fd); /* Discard the unwind protect for closing the file. */ specpdl_ptr--; if (how_much < 0) error ("IO error reading %s: %s", XSTRING (filename)->data, strerror (errno)); notfound: handled: if (!NILP (visit)) { if (!EQ (current_buffer->undo_list, Qt)) current_buffer->undo_list = Qnil; #ifdef APOLLO stat (XSTRING (filename)->data, &st); #endif if (NILP (handler)) { current_buffer->modtime = st.st_mtime; current_buffer->filename = filename; } SAVE_MODIFF = MODIFF; current_buffer->auto_save_modified = MODIFF; XSETFASTINT (current_buffer->save_length, Z - BEG); #ifdef CLASH_DETECTION if (NILP (handler)) { if (!NILP (current_buffer->file_truename)) unlock_file (current_buffer->file_truename); unlock_file (filename); } #endif /* CLASH_DETECTION */ if (not_regular) Fsignal (Qfile_error, Fcons (build_string ("not a regular file"), Fcons (filename, Qnil))); /* If visiting nonexistent file, return nil. */ if (current_buffer->modtime == -1) report_file_error ("Opening input file", Fcons (filename, Qnil)); } /* Decode file format */ if (inserted > 0) { insval = call3 (Qformat_decode, Qnil, make_number (inserted), visit); CHECK_NUMBER (insval, 0); inserted = XFASTINT (insval); } if (inserted > 0 && NILP (visit) && total > 0) signal_after_change (point, 0, inserted); if (inserted > 0) { p = Vafter_insert_file_functions; while (!NILP (p)) { insval = call1 (Fcar (p), make_number (inserted)); if (!NILP (insval)) { CHECK_NUMBER (insval, 0); inserted = XFASTINT (insval); } QUIT; p = Fcdr (p); } } if (NILP (val)) val = Fcons (filename, Fcons (make_number (inserted), Qnil)); RETURN_UNGCPRO (unbind_to (count, val)); } static Lisp_Object build_annotations (); /* If build_annotations switched buffers, switch back to BUF. Kill the temporary buffer that was selected in the meantime. */ static Lisp_Object build_annotations_unwind (buf) Lisp_Object buf; { Lisp_Object tembuf; if (XBUFFER (buf) == current_buffer) return Qnil; tembuf = Fcurrent_buffer (); Fset_buffer (buf); Fkill_buffer (tembuf); return Qnil; } DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 6, "r\nFWrite region to file: ", "Write current region into specified file.\n\ When called from a program, takes three arguments:\n\ START, END and FILENAME. START and END are buffer positions.\n\ Optional fourth argument APPEND if non-nil means\n\ append to existing file contents (if any).\n\ Optional fifth argument VISIT if t means\n\ set the last-save-file-modtime of buffer to this file's modtime\n\ and mark buffer not modified.\n\ If VISIT is a string, it is a second file name;\n\ the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\ VISIT is also the file name to lock and unlock for clash detection.\n\ If VISIT is neither t nor nil nor a string,\n\ that means do not print the \"Wrote file\" message.\n\ The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\ use for locking and unlocking, overriding FILENAME and VISIT.\n\ Kludgy feature: if START is a string, then that string is written\n\ to the file, instead of any buffer contents, and END is ignored.") (start, end, filename, append, visit, lockname) Lisp_Object start, end, filename, append, visit, lockname; { register int desc; int failure; int save_errno; unsigned char *fn; struct stat st; int tem; int count = specpdl_ptr - specpdl; int count1; #ifdef VMS unsigned char *fname = 0; /* If non-0, original filename (must rename) */ #endif /* VMS */ Lisp_Object handler; Lisp_Object visit_file; Lisp_Object annotations; int visiting, quietly; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; struct buffer *given_buffer; #ifdef DOS_NT int buffer_file_type = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY; #endif /* DOS_NT */ if (current_buffer->base_buffer && ! NILP (visit)) error ("Cannot do file visiting in an indirect buffer"); if (!NILP (start) && !STRINGP (start)) validate_region (&start, &end); GCPRO3 (filename, visit, lockname); filename = Fexpand_file_name (filename, Qnil); if (STRINGP (visit)) visit_file = Fexpand_file_name (visit, Qnil); else visit_file = filename; UNGCPRO; visiting = (EQ (visit, Qt) || STRINGP (visit)); quietly = !NILP (visit); annotations = Qnil; if (NILP (lockname)) lockname = visit_file; GCPRO5 (start, filename, annotations, visit_file, lockname); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qwrite_region); /* If FILENAME has no handler, see if VISIT has one. */ if (NILP (handler) && STRINGP (visit)) handler = Ffind_file_name_handler (visit, Qwrite_region); if (!NILP (handler)) { Lisp_Object val; val = call6 (handler, Qwrite_region, start, end, filename, append, visit); if (visiting) { SAVE_MODIFF = MODIFF; XSETFASTINT (current_buffer->save_length, Z - BEG); current_buffer->filename = visit_file; } UNGCPRO; return val; } /* Special kludge to simplify auto-saving. */ if (NILP (start)) { XSETFASTINT (start, BEG); XSETFASTINT (end, Z); } record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ()); count1 = specpdl_ptr - specpdl; given_buffer = current_buffer; annotations = build_annotations (start, end); if (current_buffer != given_buffer) { start = BEGV; end = ZV; } #ifdef CLASH_DETECTION if (!auto_saving) lock_file (lockname); #endif /* CLASH_DETECTION */ fn = XSTRING (filename)->data; desc = -1; if (!NILP (append)) #ifdef DOS_NT desc = open (fn, O_WRONLY | buffer_file_type); #else /* not DOS_NT */ desc = open (fn, O_WRONLY); #endif /* not DOS_NT */ if (desc < 0) #ifdef VMS if (auto_saving) /* Overwrite any previous version of autosave file */ { vms_truncate (fn); /* if fn exists, truncate to zero length */ desc = open (fn, O_RDWR); if (desc < 0) desc = creat_copy_attrs (STRINGP (current_buffer->filename) ? XSTRING (current_buffer->filename)->data : 0, fn); } else /* Write to temporary name and rename if no errors */ { Lisp_Object temp_name; temp_name = Ffile_name_directory (filename); if (!NILP (temp_name)) { temp_name = Fmake_temp_name (concat2 (temp_name, build_string ("$$SAVE$$"))); fname = XSTRING (filename)->data; fn = XSTRING (temp_name)->data; desc = creat_copy_attrs (fname, fn); if (desc < 0) { /* If we can't open the temporary file, try creating a new version of the original file. VMS "creat" creates a new version rather than truncating an existing file. */ fn = fname; fname = 0; desc = creat (fn, 0666); #if 0 /* This can clobber an existing file and fail to replace it, if the user runs out of space. */ if (desc < 0) { /* We can't make a new version; try to truncate and rewrite existing version if any. */ vms_truncate (fn); desc = open (fn, O_RDWR); } #endif } } else desc = creat (fn, 0666); } #else /* not VMS */ #ifdef DOS_NT desc = open (fn, O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type, S_IREAD | S_IWRITE); #else /* not DOS_NT */ desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666); #endif /* not DOS_NT */ #endif /* not VMS */ UNGCPRO; if (desc < 0) { #ifdef CLASH_DETECTION save_errno = errno; if (!auto_saving) unlock_file (lockname); errno = save_errno; #endif /* CLASH_DETECTION */ report_file_error ("Opening output file", Fcons (filename, Qnil)); } record_unwind_protect (close_file_unwind, make_number (desc)); if (!NILP (append)) if (lseek (desc, 0, 2) < 0) { #ifdef CLASH_DETECTION if (!auto_saving) unlock_file (lockname); #endif /* CLASH_DETECTION */ report_file_error ("Lseek error", Fcons (filename, Qnil)); } #ifdef VMS /* * Kludge Warning: The VMS C RTL likes to insert carriage returns * if we do writes that don't end with a carriage return. Furthermore * it cannot handle writes of more then 16K. The modified * version of "sys_write" in SYSDEP.C (see comment there) copes with * this EXCEPT for the last record (iff it doesn't end with a carriage * return). This implies that if your buffer doesn't end with a carriage * return, you get one free... tough. However it also means that if * we make two calls to sys_write (a la the following code) you can * get one at the gap as well. The easiest way to fix this (honest) * is to move the gap to the next newline (or the end of the buffer). * Thus this change. * * Yech! */ if (GPT > BEG && GPT_ADDR[-1] != '\n') move_gap (find_next_newline (GPT, 1)); #endif failure = 0; immediate_quit = 1; if (STRINGP (start)) { failure = 0 > a_write (desc, XSTRING (start)->data, XSTRING (start)->size, 0, &annotations); save_errno = errno; } else if (XINT (start) != XINT (end)) { int nwritten = 0; if (XINT (start) < GPT) { register int end1 = XINT (end); tem = XINT (start); failure = 0 > a_write (desc, &FETCH_CHAR (tem), min (GPT, end1) - tem, tem, &annotations); nwritten += min (GPT, end1) - tem; save_errno = errno; } if (XINT (end) > GPT && !failure) { tem = XINT (start); tem = max (tem, GPT); failure = 0 > a_write (desc, &FETCH_CHAR (tem), XINT (end) - tem, tem, &annotations); nwritten += XINT (end) - tem; save_errno = errno; } } else { /* If file was empty, still need to write the annotations */ failure = 0 > a_write (desc, "", 0, XINT (start), &annotations); save_errno = errno; } immediate_quit = 0; #ifdef HAVE_FSYNC /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun). Disk full in NFS may be reported here. */ /* mib says that closing the file will try to write as fast as NFS can do it, and that means the fsync here is not crucial for autosave files. */ if (!auto_saving && fsync (desc) < 0) { /* If fsync fails with EINTR, don't treat that as serious. */ if (errno != EINTR) failure = 1, save_errno = errno; } #endif /* Spurious "file has changed on disk" warnings have been observed on Suns as well. It seems that `close' can change the modtime, under nfs. (This has supposedly been fixed in Sunos 4, but who knows about all the other machines with NFS?) */ #if 0 /* On VMS and APOLLO, must do the stat after the close since closing changes the modtime. */ #ifndef VMS #ifndef APOLLO /* Recall that #if defined does not work on VMS. */ #define FOO fstat (desc, &st); #endif #endif #endif /* NFS can report a write failure now. */ if (close (desc) < 0) failure = 1, save_errno = errno; #ifdef VMS /* If we wrote to a temporary name and had no errors, rename to real name. */ if (fname) { if (!failure) failure = (rename (fn, fname) != 0), save_errno = errno; fn = fname; } #endif /* VMS */ #ifndef FOO stat (fn, &st); #endif /* Discard the unwind protect for close_file_unwind. */ specpdl_ptr = specpdl + count1; /* Restore the original current buffer. */ visit_file = unbind_to (count, visit_file); #ifdef CLASH_DETECTION if (!auto_saving) unlock_file (lockname); #endif /* CLASH_DETECTION */ /* Do this before reporting IO error to avoid a "file has changed on disk" warning on next attempt to save. */ if (visiting) current_buffer->modtime = st.st_mtime; if (failure) error ("IO error writing %s: %s", fn, strerror (save_errno)); if (visiting) { SAVE_MODIFF = MODIFF; XSETFASTINT (current_buffer->save_length, Z - BEG); current_buffer->filename = visit_file; update_mode_lines++; } else if (quietly) return Qnil; if (!auto_saving) message ("Wrote %s", XSTRING (visit_file)->data); return Qnil; } Lisp_Object merge (); DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, "Return t if (car A) is numerically less than (car B).") (a, b) Lisp_Object a, b; { return Flss (Fcar (a), Fcar (b)); } /* Build the complete list of annotations appropriate for writing out the text between START and END, by calling all the functions in write-region-annotate-functions and merging the lists they return. If one of these functions switches to a different buffer, we assume that buffer contains altered text. Therefore, the caller must make sure to restore the current buffer in all cases, as save-excursion would do. */ static Lisp_Object build_annotations (start, end) Lisp_Object start, end; { Lisp_Object annotations; Lisp_Object p, res; struct gcpro gcpro1, gcpro2; annotations = Qnil; p = Vwrite_region_annotate_functions; GCPRO2 (annotations, p); while (!NILP (p)) { struct buffer *given_buffer = current_buffer; Vwrite_region_annotations_so_far = annotations; res = call2 (Fcar (p), start, end); /* If the function makes a different buffer current, assume that means this buffer contains altered text to be output. Reset START and END from the buffer bounds and discard all previous annotations because they should have been dealt with by this function. */ if (current_buffer != given_buffer) { start = BEGV; end = ZV; annotations = Qnil; } Flength (res); /* Check basic validity of return value */ annotations = merge (annotations, res, Qcar_less_than_car); p = Fcdr (p); } /* Now do the same for annotation functions implied by the file-format */ if (auto_saving && (!EQ (Vauto_save_file_format, Qt))) p = Vauto_save_file_format; else p = current_buffer->file_format; while (!NILP (p)) { struct buffer *given_buffer = current_buffer; Vwrite_region_annotations_so_far = annotations; res = call3 (Qformat_annotate_function, Fcar (p), start, end); if (current_buffer != given_buffer) { start = BEGV; end = ZV; annotations = Qnil; } Flength (res); annotations = merge (annotations, res, Qcar_less_than_car); p = Fcdr (p); } UNGCPRO; return annotations; } /* Write to descriptor DESC the LEN characters starting at ADDR, assuming they start at position POS in the buffer. Intersperse with them the annotations from *ANNOT (those which fall within the range of positions POS to POS + LEN), each at its appropriate position. Modify *ANNOT by discarding elements as we output them. The return value is negative in case of system call failure. */ int a_write (desc, addr, len, pos, annot) int desc; register char *addr; register int len; int pos; Lisp_Object *annot; { Lisp_Object tem; int nextpos; int lastpos = pos + len; while (NILP (*annot) || CONSP (*annot)) { tem = Fcar_safe (Fcar (*annot)); if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos) nextpos = XFASTINT (tem); else return e_write (desc, addr, lastpos - pos); if (nextpos > pos) { if (0 > e_write (desc, addr, nextpos - pos)) return -1; addr += nextpos - pos; pos = nextpos; } tem = Fcdr (Fcar (*annot)); if (STRINGP (tem)) { if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size)) return -1; } *annot = Fcdr (*annot); } } int e_write (desc, addr, len) int desc; register char *addr; register int len; { char buf[16 * 1024]; register char *p, *end; if (!EQ (current_buffer->selective_display, Qt)) return write (desc, addr, len) - len; else { p = buf; end = p + sizeof buf; while (len--) { if (p == end) { if (write (desc, buf, sizeof buf) != sizeof buf) return -1; p = buf; } *p = *addr++; if (*p++ == '\015') p[-1] = '\n'; } if (p != buf) if (write (desc, buf, p - buf) != p - buf) return -1; } return 0; } DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, Sverify_visited_file_modtime, 1, 1, 0, "Return t if last mod time of BUF's visited file matches what BUF records.\n\ This means that the file has not been changed since it was visited or saved.") (buf) Lisp_Object buf; { struct buffer *b; struct stat st; Lisp_Object handler; CHECK_BUFFER (buf, 0); b = XBUFFER (buf); if (!STRINGP (b->filename)) return Qt; if (b->modtime == 0) return Qt; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (b->filename, Qverify_visited_file_modtime); if (!NILP (handler)) return call2 (handler, Qverify_visited_file_modtime, buf); if (stat (XSTRING (b->filename)->data, &st) < 0) { /* If the file doesn't exist now and didn't exist before, we say that it isn't modified, provided the error is a tame one. */ if (errno == ENOENT || errno == EACCES || errno == ENOTDIR) st.st_mtime = -1; else st.st_mtime = 0; } if (st.st_mtime == b->modtime /* If both are positive, accept them if they are off by one second. */ || (st.st_mtime > 0 && b->modtime > 0 && (st.st_mtime == b->modtime + 1 || st.st_mtime == b->modtime - 1))) return Qt; return Qnil; } DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, Sclear_visited_file_modtime, 0, 0, 0, "Clear out records of last mod time of visited file.\n\ Next attempt to save will certainly not complain of a discrepancy.") () { current_buffer->modtime = 0; return Qnil; } DEFUN ("visited-file-modtime", Fvisited_file_modtime, Svisited_file_modtime, 0, 0, 0, "Return the current buffer's recorded visited file modification time.\n\ The value is a list of the form (HIGH . LOW), like the time values\n\ that `file-attributes' returns.") () { return long_to_cons ((unsigned long) current_buffer->modtime); } DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, Sset_visited_file_modtime, 0, 1, 0, "Update buffer's recorded modification time from the visited file's time.\n\ Useful if the buffer was not read from the file normally\n\ or if the file itself has been changed for some known benign reason.\n\ An argument specifies the modification time value to use\n\ \(instead of that of the visited file), in the form of a list\n\ \(HIGH . LOW) or (HIGH LOW).") (time_list) Lisp_Object time_list; { if (!NILP (time_list)) current_buffer->modtime = cons_to_long (time_list); else { register Lisp_Object filename; struct stat st; Lisp_Object handler; filename = Fexpand_file_name (current_buffer->filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime); if (!NILP (handler)) /* The handler can find the file name the same way we did. */ return call2 (handler, Qset_visited_file_modtime, Qnil); else if (stat (XSTRING (filename)->data, &st) >= 0) current_buffer->modtime = st.st_mtime; } return Qnil; } Lisp_Object auto_save_error () { ring_bell (); message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data); Fsleep_for (make_number (1), Qnil); message ("Autosaving...error!for %s", XSTRING (current_buffer->name)->data); Fsleep_for (make_number (1), Qnil); message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data); Fsleep_for (make_number (1), Qnil); return Qnil; } Lisp_Object auto_save_1 () { unsigned char *fn; struct stat st; /* Get visited file's mode to become the auto save file's mode. */ if (stat (XSTRING (current_buffer->filename)->data, &st) >= 0) /* But make sure we can overwrite it later! */ auto_save_mode_bits = st.st_mode | 0600; else auto_save_mode_bits = 0666; return Fwrite_region (Qnil, Qnil, current_buffer->auto_save_file_name, Qnil, Qlambda, Qnil); } static Lisp_Object do_auto_save_unwind (desc) /* used as unwind-protect function */ Lisp_Object desc; { auto_saving = 0; close (XINT (desc)); return Qnil; } DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "", "Auto-save all buffers that need it.\n\ This is all buffers that have auto-saving enabled\n\ and are changed since last auto-saved.\n\ Auto-saving writes the buffer into a file\n\ so that your editing is not lost if the system crashes.\n\ This file is not the file you visited; that changes only when you save.\n\ Normally we run the normal hook `auto-save-hook' before saving.\n\n\ Non-nil first argument means do not print any message if successful.\n\ Non-nil second argument means save only current buffer.") (no_message, current_only) Lisp_Object no_message, current_only; { struct buffer *old = current_buffer, *b; Lisp_Object tail, buf; int auto_saved = 0; char *omessage = echo_area_glyphs; int omessage_length = echo_area_glyphs_length; extern int minibuf_level; int do_handled_files; Lisp_Object oquit; int listdesc; int count = specpdl_ptr - specpdl; int *ptr; /* Ordinarily don't quit within this function, but don't make it impossible to quit (in case we get hung in I/O). */ oquit = Vquit_flag; Vquit_flag = Qnil; /* No GCPRO needed, because (when it matters) all Lisp_Object variables point to non-strings reached from Vbuffer_alist. */ if (minibuf_level) no_message = Qt; if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, intern ("auto-save-hook")); if (STRINGP (Vauto_save_list_file_name)) { Lisp_Object listfile; listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil); #ifdef DOS_NT listdesc = open (XSTRING (listfile)->data, O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, S_IREAD | S_IWRITE); #else /* not DOS_NT */ listdesc = creat (XSTRING (listfile)->data, 0666); #endif /* not DOS_NT */ } else listdesc = -1; /* Arrange to close that file whether or not we get an error. Also reset auto_saving to 0. */ if (listdesc >= 0) record_unwind_protect (do_auto_save_unwind, make_number (listdesc)); auto_saving = 1; /* First, save all files which don't have handlers. If Emacs is crashing, the handlers may tweak what is causing Emacs to crash in the first place, and it would be a shame if Emacs failed to autosave perfectly ordinary files because it couldn't handle some ange-ftp'd file. */ for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr) { buf = XCONS (XCONS (tail)->car)->cdr; b = XBUFFER (buf); /* Record all the buffers that have auto save mode in the special file that lists them. For each of these buffers, Record visited name (if any) and auto save name. */ if (STRINGP (b->auto_save_file_name) && listdesc >= 0 && do_handled_files == 0) { if (!NILP (b->filename)) { write (listdesc, XSTRING (b->filename)->data, XSTRING (b->filename)->size); } write (listdesc, "\n", 1); write (listdesc, XSTRING (b->auto_save_file_name)->data, XSTRING (b->auto_save_file_name)->size); write (listdesc, "\n", 1); } if (!NILP (current_only) && b != current_buffer) continue; /* Don't auto-save indirect buffers. The base buffer takes care of it. */ if (b->base_buffer) continue; /* Check for auto save enabled and file changed since last auto save and file changed since last real save. */ if (STRINGP (b->auto_save_file_name) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) && b->auto_save_modified < BUF_MODIFF (b) /* -1 means we've turned off autosaving for a while--see below. */ && XINT (b->save_length) >= 0 && (do_handled_files || NILP (Ffind_file_name_handler (b->auto_save_file_name, Qwrite_region)))) { EMACS_TIME before_time, after_time; EMACS_GET_TIME (before_time); /* If we had a failure, don't try again for 20 minutes. */ if (b->auto_save_failure_time >= 0 && EMACS_SECS (before_time) - b->auto_save_failure_time < 1200) continue; if ((XFASTINT (b->save_length) * 10 > (BUF_Z (b) - BUF_BEG (b)) * 13) /* A short file is likely to change a large fraction; spare the user annoying messages. */ && XFASTINT (b->save_length) > 5000 /* These messages are frequent and annoying for `*mail*'. */ && !EQ (b->filename, Qnil) && NILP (no_message)) { /* It has shrunk too much; turn off auto-saving here. */ message ("Buffer %s has shrunk a lot; auto save turned off there", XSTRING (b->name)->data); /* Turn off auto-saving until there's a real save, and prevent any more warnings. */ XSETINT (b->save_length, -1); Fsleep_for (make_number (1), Qnil); continue; } set_buffer_internal (b); if (!auto_saved && NILP (no_message)) message1 ("Auto-saving..."); internal_condition_case (auto_save_1, Qt, auto_save_error); auto_saved++; b->auto_save_modified = BUF_MODIFF (b); XSETFASTINT (current_buffer->save_length, Z - BEG); set_buffer_internal (old); EMACS_GET_TIME (after_time); /* If auto-save took more than 60 seconds, assume it was an NFS failure that got a timeout. */ if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60) b->auto_save_failure_time = EMACS_SECS (after_time); } } /* Prevent another auto save till enough input events come in. */ record_auto_save (); if (auto_saved && NILP (no_message)) { if (omessage) message2 (omessage, omessage_length); else message1 ("Auto-saving...done"); } Vquit_flag = oquit; unbind_to (count, Qnil); return Qnil; } DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, Sset_buffer_auto_saved, 0, 0, 0, "Mark current buffer as auto-saved with its current text.\n\ No auto-save file will be written until the buffer changes again.") () { current_buffer->auto_save_modified = MODIFF; XSETFASTINT (current_buffer->save_length, Z - BEG); current_buffer->auto_save_failure_time = -1; return Qnil; } DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, Sclear_buffer_auto_save_failure, 0, 0, 0, "Clear any record of a recent auto-save failure in the current buffer.") () { current_buffer->auto_save_failure_time = -1; return Qnil; } DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p, 0, 0, 0, "Return t if buffer has been auto-saved since last read in or saved.") () { return (SAVE_MODIFF < current_buffer->auto_save_modified) ? Qt : Qnil; } /* Reading and completing file names */ extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions (); /* In the string VAL, change each $ to $$ and return the result. */ static Lisp_Object double_dollars (val) Lisp_Object val; { register unsigned char *old, *new; register int n; int osize, count; osize = XSTRING (val)->size; /* Quote "$" as "$$" to get it past substitute-in-file-name */ for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--) if (*old++ == '$') count++; if (count > 0) { old = XSTRING (val)->data; val = Fmake_string (make_number (osize + count), make_number (0)); new = XSTRING (val)->data; for (n = osize; n > 0; n--) if (*old != '$') *new++ = *old++; else { *new++ = '$'; *new++ = '$'; old++; } } return val; } DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal, 3, 3, 0, "Internal subroutine for read-file-name. Do not call this.") (string, dir, action) Lisp_Object string, dir, action; /* action is nil for complete, t for return list of completions, lambda for verify final value */ { Lisp_Object name, specdir, realdir, val, orig_string; int changed; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; realdir = dir; name = string; orig_string = Qnil; specdir = Qnil; changed = 0; /* No need to protect ACTION--we only compare it with t and nil. */ GCPRO5 (string, realdir, name, specdir, orig_string); if (XSTRING (string)->size == 0) { if (EQ (action, Qlambda)) { UNGCPRO; return Qnil; } } else { orig_string = string; string = Fsubstitute_in_file_name (string); changed = NILP (Fstring_equal (string, orig_string)); name = Ffile_name_nondirectory (string); val = Ffile_name_directory (string); if (! NILP (val)) realdir = Fexpand_file_name (val, realdir); } if (NILP (action)) { specdir = Ffile_name_directory (string); val = Ffile_name_completion (name, realdir); UNGCPRO; if (!STRINGP (val)) { if (changed) return double_dollars (string); return val; } if (!NILP (specdir)) val = concat2 (specdir, val); #ifndef VMS return double_dollars (val); #else /* not VMS */ return val; #endif /* not VMS */ } UNGCPRO; if (EQ (action, Qt)) return Ffile_name_all_completions (name, realdir); /* Only other case actually used is ACTION = lambda */ #ifdef VMS /* Supposedly this helps commands such as `cd' that read directory names, but can someone explain how it helps them? -- RMS */ if (XSTRING (name)->size == 0) return Qt; #endif /* VMS */ return Ffile_exists_p (string); } DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0, "Read file name, prompting with PROMPT and completing in directory DIR.\n\ Value is not expanded---you must call `expand-file-name' yourself.\n\ Default name to DEFAULT if user enters a null string.\n\ (If DEFAULT is omitted, the visited file name is used,\n\ except that if INITIAL is specified, that combined with DIR is used.)\n\ Fourth arg MUSTMATCH non-nil means require existing file's name.\n\ Non-nil and non-t means also require confirmation after completion.\n\ Fifth arg INITIAL specifies text to start with.\n\ DIR defaults to current buffer's directory default.") (prompt, dir, defalt, mustmatch, initial) Lisp_Object prompt, dir, defalt, mustmatch, initial; { Lisp_Object val, insdef, insdef1, tem; struct gcpro gcpro1, gcpro2; register char *homedir; int count; if (NILP (dir)) dir = current_buffer->directory; if (NILP (defalt)) { if (! NILP (initial)) defalt = Fexpand_file_name (initial, dir); else defalt = current_buffer->filename; } /* If dir starts with user's homedir, change that to ~. */ homedir = (char *) egetenv ("HOME"); if (homedir != 0 && STRINGP (dir) && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) && IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)])) { dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1, XSTRING (dir)->size - strlen (homedir) + 1); XSTRING (dir)->data[0] = '~'; } if (insert_default_directory) { insdef = dir; if (!NILP (initial)) { Lisp_Object args[2], pos; args[0] = insdef; args[1] = initial; insdef = Fconcat (2, args); pos = make_number (XSTRING (double_dollars (dir))->size); insdef1 = Fcons (double_dollars (insdef), pos); } else insdef1 = double_dollars (insdef); } else if (!NILP (initial)) { insdef = initial; insdef1 = Fcons (double_dollars (insdef), 0); } else insdef = Qnil, insdef1 = Qnil; #ifdef VMS count = specpdl_ptr - specpdl; specbind (intern ("completion-ignore-case"), Qt); #endif GCPRO2 (insdef, defalt); val = Fcompleting_read (prompt, intern ("read-file-name-internal"), dir, mustmatch, insdef1, Qfile_name_history); #ifdef VMS unbind_to (count, Qnil); #endif UNGCPRO; if (NILP (val)) error ("No file name specified"); tem = Fstring_equal (val, insdef); if (!NILP (tem) && !NILP (defalt)) return defalt; if (XSTRING (val)->size == 0 && NILP (insdef)) { if (!NILP (defalt)) return defalt; else error ("No default file name"); } return Fsubstitute_in_file_name (val); } #if 0 /* Old version */ DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (prompt, dir, defalt, mustmatch, initial) Lisp_Object prompt, dir, defalt, mustmatch, initial; { Lisp_Object val, insdef, tem; struct gcpro gcpro1, gcpro2; register char *homedir; int count; if (NILP (dir)) dir = current_buffer->directory; if (NILP (defalt)) defalt = current_buffer->filename; /* If dir starts with user's homedir, change that to ~. */ homedir = (char *) egetenv ("HOME"); if (homedir != 0 && STRINGP (dir) && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) && XSTRING (dir)->data[strlen (homedir)] == '/') { dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1, XSTRING (dir)->size - strlen (homedir) + 1); XSTRING (dir)->data[0] = '~'; } if (!NILP (initial)) insdef = initial; else if (insert_default_directory) insdef = dir; else insdef = build_string (""); #ifdef VMS count = specpdl_ptr - specpdl; specbind (intern ("completion-ignore-case"), Qt); #endif GCPRO2 (insdef, defalt); val = Fcompleting_read (prompt, intern ("read-file-name-internal"), dir, mustmatch, insert_default_directory ? insdef : Qnil, Qfile_name_history); #ifdef VMS unbind_to (count, Qnil); #endif UNGCPRO; if (NILP (val)) error ("No file name specified"); tem = Fstring_equal (val, insdef); if (!NILP (tem) && !NILP (defalt)) return defalt; return Fsubstitute_in_file_name (val); } #endif /* Old version */ syms_of_fileio () { Qexpand_file_name = intern ("expand-file-name"); Qsubstitute_in_file_name = intern ("substitute-in-file-name"); Qdirectory_file_name = intern ("directory-file-name"); Qfile_name_directory = intern ("file-name-directory"); Qfile_name_nondirectory = intern ("file-name-nondirectory"); Qunhandled_file_name_directory = intern ("unhandled-file-name-directory"); Qfile_name_as_directory = intern ("file-name-as-directory"); Qcopy_file = intern ("copy-file"); Qmake_directory_internal = intern ("make-directory-internal"); Qdelete_directory = intern ("delete-directory"); Qdelete_file = intern ("delete-file"); Qrename_file = intern ("rename-file"); Qadd_name_to_file = intern ("add-name-to-file"); Qmake_symbolic_link = intern ("make-symbolic-link"); Qfile_exists_p = intern ("file-exists-p"); Qfile_executable_p = intern ("file-executable-p"); Qfile_readable_p = intern ("file-readable-p"); Qfile_symlink_p = intern ("file-symlink-p"); Qfile_writable_p = intern ("file-writable-p"); Qfile_directory_p = intern ("file-directory-p"); Qfile_regular_p = intern ("file-regular-p"); Qfile_accessible_directory_p = intern ("file-accessible-directory-p"); Qfile_modes = intern ("file-modes"); Qset_file_modes = intern ("set-file-modes"); Qfile_newer_than_file_p = intern ("file-newer-than-file-p"); Qinsert_file_contents = intern ("insert-file-contents"); Qwrite_region = intern ("write-region"); Qverify_visited_file_modtime = intern ("verify-visited-file-modtime"); Qset_visited_file_modtime = intern ("set-visited-file-modtime"); staticpro (&Qexpand_file_name); staticpro (&Qsubstitute_in_file_name); staticpro (&Qdirectory_file_name); staticpro (&Qfile_name_directory); staticpro (&Qfile_name_nondirectory); staticpro (&Qunhandled_file_name_directory); staticpro (&Qfile_name_as_directory); staticpro (&Qcopy_file); staticpro (&Qmake_directory_internal); staticpro (&Qdelete_directory); staticpro (&Qdelete_file); staticpro (&Qrename_file); staticpro (&Qadd_name_to_file); staticpro (&Qmake_symbolic_link); staticpro (&Qfile_exists_p); staticpro (&Qfile_executable_p); staticpro (&Qfile_readable_p); staticpro (&Qfile_symlink_p); staticpro (&Qfile_writable_p); staticpro (&Qfile_directory_p); staticpro (&Qfile_regular_p); staticpro (&Qfile_accessible_directory_p); staticpro (&Qfile_modes); staticpro (&Qset_file_modes); staticpro (&Qfile_newer_than_file_p); staticpro (&Qinsert_file_contents); staticpro (&Qwrite_region); staticpro (&Qverify_visited_file_modtime); Qfile_name_history = intern ("file-name-history"); Fset (Qfile_name_history, Qnil); staticpro (&Qfile_name_history); Qfile_error = intern ("file-error"); staticpro (&Qfile_error); Qfile_already_exists = intern("file-already-exists"); staticpro (&Qfile_already_exists); #ifdef DOS_NT Qfind_buffer_file_type = intern ("find-buffer-file-type"); staticpro (&Qfind_buffer_file_type); #endif /* DOS_NT */ DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format, "*Format in which to write auto-save files.\n\ Should be a list of symbols naming formats that are defined in `format-alist'.\n\ If it is t, which is the default, auto-save files are written in the\n\ same format as a regular save would use."); Vauto_save_file_format = Qt; Qformat_decode = intern ("format-decode"); staticpro (&Qformat_decode); Qformat_annotate_function = intern ("format-annotate-function"); staticpro (&Qformat_annotate_function); Qcar_less_than_car = intern ("car-less-than-car"); staticpro (&Qcar_less_than_car); Fput (Qfile_error, Qerror_conditions, Fcons (Qfile_error, Fcons (Qerror, Qnil))); Fput (Qfile_error, Qerror_message, build_string ("File error")); Fput (Qfile_already_exists, Qerror_conditions, Fcons (Qfile_already_exists, Fcons (Qfile_error, Fcons (Qerror, Qnil)))); Fput (Qfile_already_exists, Qerror_message, build_string ("File already exists")); DEFVAR_BOOL ("insert-default-directory", &insert_default_directory, "*Non-nil means when reading a filename start with default dir in minibuffer."); insert_default_directory = 1; DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm, "*Non-nil means write new files with record format `stmlf'.\n\ nil means use format `var'. This variable is meaningful only on VMS."); vms_stmlf_recfm = 0; DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist, "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\ If a file name matches REGEXP, then all I/O on that file is done by calling\n\ HANDLER.\n\ \n\ The first argument given to HANDLER is the name of the I/O primitive\n\ to be handled; the remaining arguments are the arguments that were\n\ passed to that primitive. For example, if you do\n\ (file-exists-p FILENAME)\n\ and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\ (funcall HANDLER 'file-exists-p FILENAME)\n\ The function `find-file-name-handler' checks this list for a handler\n\ for its argument."); Vfile_name_handler_alist = Qnil; DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions, "A list of functions to be called at the end of `insert-file-contents'.\n\ Each is passed one argument, the number of bytes inserted. It should return\n\ the new byte count, and leave point the same. If `insert-file-contents' is\n\ intercepted by a handler from `file-name-handler-alist', that handler is\n\ responsible for calling the after-insert-file-functions if appropriate."); Vafter_insert_file_functions = Qnil; DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions, "A list of functions to be called at the start of `write-region'.\n\ Each is passed two arguments, START and END as for `write-region'. It should\n\ return a list of pairs (POSITION . STRING) of strings to be effectively\n\ inserted at the specified positions of the file being written (1 means to\n\ insert before the first byte written). The POSITIONs must be sorted into\n\ increasing order. If there are several functions in the list, the several\n\ lists are merged destructively."); Vwrite_region_annotate_functions = Qnil; DEFVAR_LISP ("write-region-annotations-so-far", &Vwrite_region_annotations_so_far, "When an annotation function is called, this holds the previous annotations.\n\ These are the annotations made by other annotation functions\n\ that were already called. See also `write-region-annotate-functions'."); Vwrite_region_annotations_so_far = Qnil; DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers, "A list of file name handlers that temporarily should not be used.\n\ This applies only to the operation `inhibit-file-name-operation'."); Vinhibit_file_name_handlers = Qnil; DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation, "The operation for which `inhibit-file-name-handlers' is applicable."); Vinhibit_file_name_operation = Qnil; DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name, "File name in which we write a list of all auto save file names."); Vauto_save_list_file_name = Qnil; defsubr (&Sfind_file_name_handler); defsubr (&Sfile_name_directory); defsubr (&Sfile_name_nondirectory); defsubr (&Sunhandled_file_name_directory); defsubr (&Sfile_name_as_directory); defsubr (&Sdirectory_file_name); defsubr (&Smake_temp_name); defsubr (&Sexpand_file_name); defsubr (&Ssubstitute_in_file_name); defsubr (&Scopy_file); defsubr (&Smake_directory_internal); defsubr (&Sdelete_directory); defsubr (&Sdelete_file); defsubr (&Srename_file); defsubr (&Sadd_name_to_file); #ifdef S_IFLNK defsubr (&Smake_symbolic_link); #endif /* S_IFLNK */ #ifdef VMS defsubr (&Sdefine_logical_name); #endif /* VMS */ #ifdef HPUX_NET defsubr (&Ssysnetunam); #endif /* HPUX_NET */ defsubr (&Sfile_name_absolute_p); defsubr (&Sfile_exists_p); defsubr (&Sfile_executable_p); defsubr (&Sfile_readable_p); defsubr (&Sfile_writable_p); defsubr (&Sfile_symlink_p); defsubr (&Sfile_directory_p); defsubr (&Sfile_accessible_directory_p); defsubr (&Sfile_regular_p); defsubr (&Sfile_modes); defsubr (&Sset_file_modes); defsubr (&Sset_default_file_modes); defsubr (&Sdefault_file_modes); defsubr (&Sfile_newer_than_file_p); defsubr (&Sinsert_file_contents); defsubr (&Swrite_region); defsubr (&Scar_less_than_car); defsubr (&Sverify_visited_file_modtime); defsubr (&Sclear_visited_file_modtime); defsubr (&Svisited_file_modtime); defsubr (&Sset_visited_file_modtime); defsubr (&Sdo_auto_save); defsubr (&Sset_buffer_auto_saved); defsubr (&Sclear_buffer_auto_save_failure); defsubr (&Srecent_auto_save_p); defsubr (&Sread_file_name_internal); defsubr (&Sread_file_name); #ifdef unix defsubr (&Sunix_sync); #endif } emacs-19.30/src/filelock.c100444 12120 1 27213 6011264125 13645 0ustar rmsdaemon/* Copyright (C) 1985, 1986, 1987, 1993, 1994 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. */ #include #include #include #ifdef VMS #include "vms-pwd.h" #else #include #endif #include #include #ifdef USG #include #endif /* USG */ #include "lisp.h" #include #include "buffer.h" #ifdef SYSV_SYSTEM_DIR #include #else /* not SYSV_SYSTEM_DIR */ #ifdef NONSYSTEM_DIR_LIBRARY #include "ndir.h" #else /* not NONSYSTEM_DIR_LIBRARY */ #ifdef MSDOS #include #else #include #endif #endif /* not NONSYSTEM_DIR_LIBRARY */ #ifndef MSDOS extern DIR *opendir (); #endif /* not MSDOS */ #endif /* not SYSV_SYSTEM_DIR */ extern int errno; extern char *egetenv (); extern char *strcpy (); #ifdef DECLARE_GETPWUID_WITH_UID_T extern struct passwd *getpwuid (uid_t); #else extern struct passwd *getpwuid (); #endif #ifdef CLASH_DETECTION /* If system does not have symbolic links, it does not have lstat. In that case, use ordinary stat instead. */ #ifndef S_IFLNK #define lstat stat #endif /* The name of the directory in which we keep lock files, with a '/' appended. */ char *lock_dir; /* The name of the file in the lock directory which is used to arbitrate access to the entire directory. */ #define SUPERLOCK_NAME "!!!SuperLock!!!" /* The name of the superlock file. This is SUPERLOCK_NAME appended to lock_dir. */ char *superlock_file; /* Set LOCK to the name of the lock file for the filename FILE. char *LOCK; Lisp_Object FILE; */ #ifndef HAVE_LONG_FILE_NAMES #define MAKE_LOCK_NAME(lock, file) \ (lock = (char *) alloca (14 + strlen (lock_dir) + 1), \ fill_in_lock_short_file_name (lock, (file))) fill_in_lock_short_file_name (lockfile, fn) register char *lockfile; register Lisp_Object fn; { register union { unsigned int word [2]; unsigned char byte [8]; } crc; register unsigned char *p, new; /* 7-bytes cyclic code for burst correction on byte-by-byte basis. the used polynomial is D^7 + D^6 + D^3 +1. pot@cnuce.cnr.it */ crc.word[0] = crc.word[1] = 0; for (p = XSTRING (fn)->data; new = *p++; ) { new += crc.byte[6]; crc.byte[6] = crc.byte[5] + new; crc.byte[5] = crc.byte[4]; crc.byte[4] = crc.byte[3]; crc.byte[3] = crc.byte[2] + new; crc.byte[2] = crc.byte[1]; crc.byte[1] = crc.byte[0]; crc.byte[0] = new; } sprintf (lockfile, "%s%.2x%.2x%.2x%.2x%.2x%.2x%.2x", lock_dir, crc.byte[0], crc.byte[1], crc.byte[2], crc.byte[3], crc.byte[4], crc.byte[5], crc.byte[6]); } #else /* defined HAVE_LONG_FILE_NAMES */ #define MAKE_LOCK_NAME(lock, file) \ (lock = (char *) alloca (XSTRING (file)->size + strlen (lock_dir) + 1), \ fill_in_lock_file_name (lock, (file))) fill_in_lock_file_name (lockfile, fn) register char *lockfile; register Lisp_Object fn; { register char *p; strcpy (lockfile, lock_dir); p = lockfile + strlen (lockfile); strcpy (p, XSTRING (fn)->data); for (; *p; p++) { if (*p == '/') *p = '!'; } } #endif /* !defined HAVE_LONG_FILE_NAMES */ static Lisp_Object lock_file_owner_name (lfname) char *lfname; { struct stat s; struct passwd *the_pw; if (lstat (lfname, &s) == 0) the_pw = getpwuid (s.st_uid); return (the_pw == 0 ? Qnil : build_string (the_pw->pw_name)); } /* lock_file locks file fn, meaning it serves notice on the world that you intend to edit that file. This should be done only when about to modify a file-visiting buffer previously unmodified. Do not (normally) call lock_buffer for a buffer already modified, as either the file is already locked, or the user has already decided to go ahead without locking. When lock_buffer returns, either the lock is locked for us, or the user has said to go ahead without locking. If the file is locked by someone else, lock_buffer calls ask-user-about-lock (a Lisp function) with two arguments, the file name and the name of the user who did the locking. This function can signal an error, or return t meaning take away the lock, or return nil meaning ignore the lock. */ /* The lock file name is the file name with "/" replaced by "!" and put in the Emacs lock directory. */ /* (ie., /ka/king/junk.tex -> /!/!ka!king!junk.tex). */ /* If HAVE_LONG_FILE_NAMES is not defined, the lock file name is the hex representation of a 14-bytes CRC generated from the file name and put in the Emacs lock directory (not very nice, but it works). (ie., /ka/king/junk.tex -> /!/12a82c62f1c6da). */ void lock_file (fn) register Lisp_Object fn; { register Lisp_Object attack, orig_fn; register char *lfname; orig_fn = fn; fn = Fexpand_file_name (fn, Qnil); MAKE_LOCK_NAME (lfname, fn); /* See if this file is visited and has changed on disk since it was visited. */ { register Lisp_Object subject_buf; subject_buf = get_truename_buffer (orig_fn); if (!NILP (subject_buf) && NILP (Fverify_visited_file_modtime (subject_buf)) && !NILP (Ffile_exists_p (fn))) call1 (intern ("ask-user-about-supersession-threat"), fn); } /* Try to lock the lock. */ if (lock_if_free (lfname) <= 0) /* Return now if we have locked it, or if lock dir does not exist */ return; /* Else consider breaking the lock */ attack = call2 (intern ("ask-user-about-lock"), fn, lock_file_owner_name (lfname)); if (!NILP (attack)) /* User says take the lock */ { lock_superlock (lfname); lock_file_1 (lfname, O_WRONLY) ; unlink (superlock_file); return; } /* User says ignore the lock */ } /* Lock the lock file named LFNAME. If MODE is O_WRONLY, we do so even if it is already locked. If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free. Return 1 if successful, 0 if not. */ int lock_file_1 (lfname, mode) int mode; char *lfname; { register int fd; char buf[20]; if ((fd = open (lfname, mode, 0666)) >= 0) { #ifdef USG chmod (lfname, 0666); #else fchmod (fd, 0666); #endif sprintf (buf, "%d ", getpid ()); write (fd, buf, strlen (buf)); close (fd); return 1; } else return 0; } /* Lock the lock named LFNAME if possible. Return 0 in that case. Return positive if lock is really locked by someone else. Return -1 if cannot lock for any other reason. */ int lock_if_free (lfname) register char *lfname; { register int clasher; while (lock_file_1 (lfname, O_WRONLY | O_EXCL | O_CREAT) == 0) { if (errno != EEXIST) return -1; clasher = current_lock_owner (lfname); if (clasher != 0) if (clasher != getpid ()) return (clasher); else return (0); /* Try again to lock it */ } return 0; } /* Return the pid of the process that claims to own the lock file LFNAME, or 0 if nobody does or the lock is obsolete, or -1 if something is wrong with the locking mechanism. */ int current_lock_owner (lfname) char *lfname; { int owner = current_lock_owner_1 (lfname); if (owner == 0 && errno == ENOENT) return (0); /* Is it locked by a process that exists? */ if (owner != 0 && (kill (owner, 0) >= 0 || errno == EPERM)) return (owner); if (unlink (lfname) < 0) return (-1); return (0); } int current_lock_owner_1 (lfname) char *lfname; { register int fd; char buf[20]; int tem; fd = open (lfname, O_RDONLY, 0666); if (fd < 0) return 0; tem = read (fd, buf, sizeof buf); close (fd); return (tem <= 0 ? 0 : atoi (buf)); } void unlock_file (fn) register Lisp_Object fn; { register char *lfname; fn = Fexpand_file_name (fn, Qnil); MAKE_LOCK_NAME (lfname, fn); lock_superlock (lfname); if (current_lock_owner_1 (lfname) == getpid ()) unlink (lfname); unlink (superlock_file); } lock_superlock (lfname) char *lfname; { register int i, fd; DIR *lockdir; for (i = -20; i < 0 && (fd = open (superlock_file, O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0; i++) { if (errno != EEXIST) return; /* This seems to be necessary to prevent Emacs from hanging when the competing process has already deleted the superlock, but it's still in the NFS cache. So we force NFS to synchronize the cache. */ if (lockdir = opendir (lock_dir)) closedir (lockdir); sleep (1); } if (fd >= 0) { #ifdef USG chmod (superlock_file, 0666); #else fchmod (fd, 0666); #endif write (fd, lfname, strlen (lfname)); close (fd); } } void unlock_all_files () { register Lisp_Object tail; register struct buffer *b; for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr) { b = XBUFFER (XCONS (XCONS (tail)->car)->cdr); if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) unlock_file (b->file_truename); } } DEFUN ("lock-buffer", Flock_buffer, Slock_buffer, 0, 1, 0, "Lock FILE, if current buffer is modified.\n\ FILE defaults to current buffer's visited file,\n\ or else nothing is done if current buffer isn't visiting a file.") (fn) Lisp_Object fn; { if (NILP (fn)) fn = current_buffer->file_truename; else CHECK_STRING (fn, 0); if (SAVE_MODIFF < MODIFF && !NILP (fn)) lock_file (fn); return Qnil; } DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer, 0, 0, 0, "Unlock the file visited in the current buffer,\n\ if it should normally be locked.") () { if (SAVE_MODIFF < MODIFF && STRINGP (current_buffer->file_truename)) unlock_file (current_buffer->file_truename); return Qnil; } /* Unlock the file visited in buffer BUFFER. */ unlock_buffer (buffer) struct buffer *buffer; { if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer) && STRINGP (buffer->file_truename)) unlock_file (buffer->file_truename); } DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0, "Return nil if the FILENAME is not locked,\n\ t if it is locked by you, else a string of the name of the locker.") (fn) Lisp_Object fn; { register char *lfname; int owner; fn = Fexpand_file_name (fn, Qnil); MAKE_LOCK_NAME (lfname, fn); owner = current_lock_owner (lfname); if (owner <= 0) return (Qnil); else if (owner == getpid ()) return (Qt); return (lock_file_owner_name (lfname)); } /* Initialization functions. */ init_filelock () { char *new_name; lock_dir = egetenv ("EMACSLOCKDIR"); if (! lock_dir) lock_dir = PATH_LOCK; /* Copy the name in case egetenv got it from a Lisp string. */ new_name = (char *) xmalloc (strlen (lock_dir) + 2); strcpy (new_name, lock_dir); lock_dir = new_name; /* Make sure it ends with a slash. */ if (lock_dir[strlen (lock_dir) - 1] != '/') strcat (lock_dir, "/"); superlock_file = (char *) xmalloc ((strlen (lock_dir) + sizeof (SUPERLOCK_NAME))); strcpy (superlock_file, lock_dir); strcat (superlock_file, SUPERLOCK_NAME); } syms_of_filelock () { defsubr (&Sunlock_buffer); defsubr (&Slock_buffer); defsubr (&Sfile_locked_p); } #endif /* CLASH_DETECTION */ emacs-19.30/src/filemode.c100444 74504 1 13527 5656462716 14724 0ustar meyeringdaemon/* filemode.c -- make a string describing file modes Copyright (C) 1985, 1990, 1993 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifdef HAVE_CONFIG_H #include #endif #include #include #if !S_IRUSR # if S_IREAD # define S_IRUSR S_IREAD # else # define S_IRUSR 00400 # endif #endif #if !S_IWUSR # if S_IWRITE # define S_IWUSR S_IWRITE # else # define S_IWUSR 00200 # endif #endif #if !S_IXUSR # if S_IEXEC # define S_IXUSR S_IEXEC # else # define S_IXUSR 00100 # endif #endif #ifdef STAT_MACROS_BROKEN #undef S_ISBLK #undef S_ISCHR #undef S_ISDIR #undef S_ISFIFO #undef S_ISLNK #undef S_ISMPB #undef S_ISMPC #undef S_ISNWK #undef S_ISREG #undef S_ISSOCK #endif /* STAT_MACROS_BROKEN. */ #if !defined(S_ISBLK) && defined(S_IFBLK) #define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK) #endif #if !defined(S_ISCHR) && defined(S_IFCHR) #define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR) #endif #if !defined(S_ISDIR) && defined(S_IFDIR) #define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR) #endif #if !defined(S_ISREG) && defined(S_IFREG) #define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) #endif #if !defined(S_ISFIFO) && defined(S_IFIFO) #define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO) #endif #if !defined(S_ISLNK) && defined(S_IFLNK) #define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK) #endif #if !defined(S_ISSOCK) && defined(S_IFSOCK) #define S_ISSOCK(m) (((m) & S_IFMT) == S_IFSOCK) #endif #if !defined(S_ISMPB) && defined(S_IFMPB) /* V7 */ #define S_ISMPB(m) (((m) & S_IFMT) == S_IFMPB) #define S_ISMPC(m) (((m) & S_IFMT) == S_IFMPC) #endif #if !defined(S_ISNWK) && defined(S_IFNWK) /* HP/UX */ #define S_ISNWK(m) (((m) & S_IFMT) == S_IFNWK) #endif void mode_string (); static char ftypelet (); static void rwx (); static void setst (); /* filemodestring - fill in string STR with an ls-style ASCII representation of the st_mode field of file stats block STATP. 10 characters are stored in STR; no terminating null is added. The characters stored in STR are: 0 File type. 'd' for directory, 'c' for character special, 'b' for block special, 'm' for multiplex, 'l' for symbolic link, 's' for socket, 'p' for fifo, '-' for regular, '?' for any other file type 1 'r' if the owner may read, '-' otherwise. 2 'w' if the owner may write, '-' otherwise. 3 'x' if the owner may execute, 's' if the file is set-user-id, '-' otherwise. 'S' if the file is set-user-id, but the execute bit isn't set. 4 'r' if group members may read, '-' otherwise. 5 'w' if group members may write, '-' otherwise. 6 'x' if group members may execute, 's' if the file is set-group-id, '-' otherwise. 'S' if it is set-group-id but not executable. 7 'r' if any user may read, '-' otherwise. 8 'w' if any user may write, '-' otherwise. 9 'x' if any user may execute, 't' if the file is "sticky" (will be retained in swap space after execution), '-' otherwise. 'T' if the file is sticky but not executable. */ void filemodestring (statp, str) struct stat *statp; char *str; { mode_string (statp->st_mode, str); } /* Like filemodestring, but only the relevant part of the `struct stat' is given as an argument. */ void mode_string (mode, str) unsigned short mode; char *str; { str[0] = ftypelet ((long) mode); rwx ((mode & 0700) << 0, &str[1]); rwx ((mode & 0070) << 3, &str[4]); rwx ((mode & 0007) << 6, &str[7]); setst (mode, str); } /* Return a character indicating the type of file described by file mode BITS: 'd' for directories 'b' for block special files 'c' for character special files 'm' for multiplexor files 'l' for symbolic links 's' for sockets 'p' for fifos '-' for regular files '?' for any other file type. */ static char ftypelet (bits) long bits; { #ifdef S_ISBLK if (S_ISBLK (bits)) return 'b'; #endif if (S_ISCHR (bits)) return 'c'; if (S_ISDIR (bits)) return 'd'; if (S_ISREG (bits)) return '-'; #ifdef S_ISFIFO if (S_ISFIFO (bits)) return 'p'; #endif #ifdef S_ISLNK if (S_ISLNK (bits)) return 'l'; #endif #ifdef S_ISSOCK if (S_ISSOCK (bits)) return 's'; #endif #ifdef S_ISMPC if (S_ISMPC (bits)) return 'm'; #endif #ifdef S_ISNWK if (S_ISNWK (bits)) return 'n'; #endif return '?'; } /* Look at read, write, and execute bits in BITS and set flags in CHARS accordingly. */ static void rwx (bits, chars) unsigned short bits; char *chars; { chars[0] = (bits & S_IRUSR) ? 'r' : '-'; chars[1] = (bits & S_IWUSR) ? 'w' : '-'; chars[2] = (bits & S_IXUSR) ? 'x' : '-'; } /* Set the 's' and 't' flags in file attributes string CHARS, according to the file mode BITS. */ static void setst (bits, chars) unsigned short bits; char *chars; { #ifdef S_ISUID if (bits & S_ISUID) { if (chars[3] != 'x') /* Set-uid, but not executable by owner. */ chars[3] = 'S'; else chars[3] = 's'; } #endif #ifdef S_ISGID if (bits & S_ISGID) { if (chars[6] != 'x') /* Set-gid, but not executable by group. */ chars[6] = 'S'; else chars[6] = 's'; } #endif #ifdef S_ISVTX if (bits & S_ISVTX) { if (chars[9] != 'x') /* Sticky, but not executable by others. */ chars[9] = 'T'; else chars[9] = 't'; } #endif } emacs-19.30/src/floatfns.c100444 12120 1 57551 6050552351 13705 0ustar rmsdaemon/* Primitive operations on floating point for GNU Emacs Lisp interpreter. Copyright (C) 1988, 1993, 1994 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. */ /* ANSI C requires only these float functions: acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod, frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh. Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh. Define HAVE_CBRT if you have cbrt. Define HAVE_RINT if you have rint. If you don't define these, then the appropriate routines will be simulated. Define HAVE_MATHERR if on a system supporting the SysV matherr callback. (This should happen automatically.) Define FLOAT_CHECK_ERRNO if the float library routines set errno. This has no effect if HAVE_MATHERR is defined. Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL. (What systems actually do this? Please let us know.) Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by either setting errno, or signalling SIGFPE/SIGILL. Otherwise, domain and range checking will happen before calling the float routines. This has no effect if HAVE_MATHERR is defined (since matherr will be called when a domain error occurs.) */ #include #include #include "lisp.h" #include "syssignal.h" Lisp_Object Qarith_error; #ifdef LISP_FLOAT_TYPE /* Work around a problem that happens because math.h on hpux 7 defines two static variables--which, in Emacs, are not really static, because `static' is defined as nothing. The problem is that they are defined both here and in lread.c. These macros prevent the name conflict. */ #if defined (HPUX) && !defined (HPUX8) #define _MAXLDBL floatfns_maxldbl #define _NMAXLDBL floatfns_nmaxldbl #endif #include /* This declaration is omitted on some systems, like Ultrix. */ #if !defined (HPUX) && defined (HAVE_LOGB) && !defined (logb) extern double logb (); #endif /* not HPUX and HAVE_LOGB and no logb macro */ #if defined(DOMAIN) && defined(SING) && defined(OVERFLOW) /* If those are defined, then this is probably a `matherr' machine. */ # ifndef HAVE_MATHERR # define HAVE_MATHERR # endif #endif #ifdef NO_MATHERR #undef HAVE_MATHERR #endif #ifdef HAVE_MATHERR # ifdef FLOAT_CHECK_ERRNO # undef FLOAT_CHECK_ERRNO # endif # ifdef FLOAT_CHECK_DOMAIN # undef FLOAT_CHECK_DOMAIN # endif #endif #ifndef NO_FLOAT_CHECK_ERRNO #define FLOAT_CHECK_ERRNO #endif #ifdef FLOAT_CHECK_ERRNO # include extern int errno; #endif /* Avoid traps on VMS from sinh and cosh. All the other functions set errno instead. */ #ifdef VMS #undef cosh #undef sinh #define cosh(x) ((exp(x)+exp(-x))*0.5) #define sinh(x) ((exp(x)-exp(-x))*0.5) #endif /* VMS */ #ifndef HAVE_RINT #define rint(x) (floor((x)+0.5)) #endif static SIGTYPE float_error (); /* Nonzero while executing in floating point. This tells float_error what to do. */ static int in_float; /* If an argument is out of range for a mathematical function, here is the actual argument value to use in the error message. */ static Lisp_Object float_error_arg, float_error_arg2; static char *float_error_fn_name; /* Evaluate the floating point expression D, recording NUM as the original argument for error messages. D is normally an assignment expression. Handle errors which may result in signals or may set errno. Note that float_error may be declared to return void, so you can't just cast the zero after the colon to (SIGTYPE) to make the types check properly. */ #ifdef FLOAT_CHECK_ERRNO #define IN_FLOAT(d, name, num) \ do { \ float_error_arg = num; \ float_error_fn_name = name; \ in_float = 1; errno = 0; (d); in_float = 0; \ switch (errno) { \ case 0: break; \ case EDOM: domain_error (float_error_fn_name, float_error_arg); \ case ERANGE: range_error (float_error_fn_name, float_error_arg); \ default: arith_error (float_error_fn_name, float_error_arg); \ } \ } while (0) #define IN_FLOAT2(d, name, num, num2) \ do { \ float_error_arg = num; \ float_error_arg2 = num2; \ float_error_fn_name = name; \ in_float = 1; errno = 0; (d); in_float = 0; \ switch (errno) { \ case 0: break; \ case EDOM: domain_error (float_error_fn_name, float_error_arg); \ case ERANGE: range_error (float_error_fn_name, float_error_arg); \ default: arith_error (float_error_fn_name, float_error_arg); \ } \ } while (0) #else #define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0) #define IN_FLOAT2(d, name, num, num2) (in_float = 1, (d), in_float = 0) #endif /* Convert float to Lisp_Int if it fits, else signal a range error using the given arguments. */ #define FLOAT_TO_INT(x, i, name, num) \ do \ { \ if ((x) >= (((EMACS_INT) 1) << (VALBITS-1)) || \ (x) <= - (((EMACS_INT) 1) << (VALBITS-1)) - 1) \ range_error (name, num); \ XSETINT (i, (EMACS_INT)(x)); \ } \ while (0) #define FLOAT_TO_INT2(x, i, name, num1, num2) \ do \ { \ if ((x) >= (((EMACS_INT) 1) << (VALBITS-1)) || \ (x) <= - (((EMACS_INT) 1) << (VALBITS-1)) - 1) \ range_error2 (name, num1, num2); \ XSETINT (i, (EMACS_INT)(x)); \ } \ while (0) #define arith_error(op,arg) \ Fsignal (Qarith_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) #define range_error(op,arg) \ Fsignal (Qrange_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) #define range_error2(op,a1,a2) \ Fsignal (Qrange_error, Fcons (build_string ((op)), \ Fcons ((a1), Fcons ((a2), Qnil)))) #define domain_error(op,arg) \ Fsignal (Qdomain_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) #define domain_error2(op,a1,a2) \ Fsignal (Qdomain_error, Fcons (build_string ((op)), \ Fcons ((a1), Fcons ((a2), Qnil)))) /* Extract a Lisp number as a `double', or signal an error. */ double extract_float (num) Lisp_Object num; { CHECK_NUMBER_OR_FLOAT (num, 0); if (FLOATP (num)) return XFLOAT (num)->data; return (double) XINT (num); } /* Trig functions. */ DEFUN ("acos", Facos, Sacos, 1, 1, 0, "Return the inverse cosine of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN if (d > 1.0 || d < -1.0) domain_error ("acos", arg); #endif IN_FLOAT (d = acos (d), "acos", arg); return make_float (d); } DEFUN ("asin", Fasin, Sasin, 1, 1, 0, "Return the inverse sine of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN if (d > 1.0 || d < -1.0) domain_error ("asin", arg); #endif IN_FLOAT (d = asin (d), "asin", arg); return make_float (d); } DEFUN ("atan", Fatan, Satan, 1, 1, 0, "Return the inverse tangent of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = atan (d), "atan", arg); return make_float (d); } DEFUN ("cos", Fcos, Scos, 1, 1, 0, "Return the cosine of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = cos (d), "cos", arg); return make_float (d); } DEFUN ("sin", Fsin, Ssin, 1, 1, 0, "Return the sine of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = sin (d), "sin", arg); return make_float (d); } DEFUN ("tan", Ftan, Stan, 1, 1, 0, "Return the tangent of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); double c = cos (d); #ifdef FLOAT_CHECK_DOMAIN if (c == 0.0) domain_error ("tan", arg); #endif IN_FLOAT (d = sin (d) / c, "tan", arg); return make_float (d); } #if 0 /* Leave these out unless we find there's a reason for them. */ DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, "Return the bessel function j0 of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = j0 (d), "bessel-j0", arg); return make_float (d); } DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, "Return the bessel function j1 of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = j1 (d), "bessel-j1", arg); return make_float (d); } DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, "Return the order N bessel function output jn of ARG.\n\ The first arg (the order) is truncated to an integer.") (arg1, arg2) register Lisp_Object arg1, arg2; { int i1 = extract_float (arg1); double f2 = extract_float (arg2); IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", arg1); return make_float (f2); } DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, "Return the bessel function y0 of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = y0 (d), "bessel-y0", arg); return make_float (d); } DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, "Return the bessel function y1 of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = y1 (d), "bessel-y0", arg); return make_float (d); } DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, "Return the order N bessel function output yn of ARG.\n\ The first arg (the order) is truncated to an integer.") (arg1, arg2) register Lisp_Object arg1, arg2; { int i1 = extract_float (arg1); double f2 = extract_float (arg2); IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", arg1); return make_float (f2); } #endif #if 0 /* Leave these out unless we see they are worth having. */ DEFUN ("erf", Ferf, Serf, 1, 1, 0, "Return the mathematical error function of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = erf (d), "erf", arg); return make_float (d); } DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, "Return the complementary error function of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = erfc (d), "erfc", arg); return make_float (d); } DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, "Return the log gamma of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = lgamma (d), "log-gamma", arg); return make_float (d); } DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, "Return the cube root of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); #ifdef HAVE_CBRT IN_FLOAT (d = cbrt (d), "cube-root", arg); #else if (d >= 0.0) IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", arg); else IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", arg); #endif return make_float (d); } #endif DEFUN ("exp", Fexp, Sexp, 1, 1, 0, "Return the exponential base e of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN if (d > 709.7827) /* Assume IEEE doubles here */ range_error ("exp", arg); else if (d < -709.0) return make_float (0.0); else #endif IN_FLOAT (d = exp (d), "exp", arg); return make_float (d); } DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, "Return the exponential ARG1 ** ARG2.") (arg1, arg2) register Lisp_Object arg1, arg2; { double f1, f2; CHECK_NUMBER_OR_FLOAT (arg1, 0); CHECK_NUMBER_OR_FLOAT (arg2, 0); if (INTEGERP (arg1) /* common lisp spec */ && INTEGERP (arg2)) /* don't promote, if both are ints */ { /* this can be improved by pre-calculating */ EMACS_INT acc, x, y; /* some binary powers of x then accumulating */ Lisp_Object val; x = XINT (arg1); y = XINT (arg2); acc = 1; if (y < 0) { if (x == 1) acc = 1; else if (x == -1) acc = (y & 1) ? -1 : 1; else acc = 0; } else { while (y > 0) { if (y & 1) acc *= x; x *= x; y = (unsigned)y >> 1; } } XSETINT (val, acc); return val; } f1 = FLOATP (arg1) ? XFLOAT (arg1)->data : XINT (arg1); f2 = FLOATP (arg2) ? XFLOAT (arg2)->data : XINT (arg2); /* Really should check for overflow, too */ if (f1 == 0.0 && f2 == 0.0) f1 = 1.0; #ifdef FLOAT_CHECK_DOMAIN else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2))) domain_error2 ("expt", arg1, arg2); #endif IN_FLOAT2 (f1 = pow (f1, f2), "expt", arg1, arg2); return make_float (f1); } DEFUN ("log", Flog, Slog, 1, 2, 0, "Return the natural logarithm of ARG.\n\ If second optional argument BASE is given, return log ARG using that base.") (arg, base) register Lisp_Object arg, base; { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN if (d <= 0.0) domain_error2 ("log", arg, base); #endif if (NILP (base)) IN_FLOAT (d = log (d), "log", arg); else { double b = extract_float (base); #ifdef FLOAT_CHECK_DOMAIN if (b <= 0.0 || b == 1.0) domain_error2 ("log", arg, base); #endif if (b == 10.0) IN_FLOAT2 (d = log10 (d), "log", arg, base); else IN_FLOAT2 (d = log (d) / log (b), "log", arg, base); } return make_float (d); } DEFUN ("log10", Flog10, Slog10, 1, 1, 0, "Return the logarithm base 10 of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN if (d <= 0.0) domain_error ("log10", arg); #endif IN_FLOAT (d = log10 (d), "log10", arg); return make_float (d); } DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, "Return the square root of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN if (d < 0.0) domain_error ("sqrt", arg); #endif IN_FLOAT (d = sqrt (d), "sqrt", arg); return make_float (d); } #if 0 /* Not clearly worth adding. */ DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, "Return the inverse hyperbolic cosine of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN if (d < 1.0) domain_error ("acosh", arg); #endif #ifdef HAVE_INVERSE_HYPERBOLIC IN_FLOAT (d = acosh (d), "acosh", arg); #else IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", arg); #endif return make_float (d); } DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, "Return the inverse hyperbolic sine of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); #ifdef HAVE_INVERSE_HYPERBOLIC IN_FLOAT (d = asinh (d), "asinh", arg); #else IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", arg); #endif return make_float (d); } DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, "Return the inverse hyperbolic tangent of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN if (d >= 1.0 || d <= -1.0) domain_error ("atanh", arg); #endif #ifdef HAVE_INVERSE_HYPERBOLIC IN_FLOAT (d = atanh (d), "atanh", arg); #else IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", arg); #endif return make_float (d); } DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, "Return the hyperbolic cosine of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN if (d > 710.0 || d < -710.0) range_error ("cosh", arg); #endif IN_FLOAT (d = cosh (d), "cosh", arg); return make_float (d); } DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, "Return the hyperbolic sine of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); #ifdef FLOAT_CHECK_DOMAIN if (d > 710.0 || d < -710.0) range_error ("sinh", arg); #endif IN_FLOAT (d = sinh (d), "sinh", arg); return make_float (d); } DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, "Return the hyperbolic tangent of ARG.") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = tanh (d), "tanh", arg); return make_float (d); } #endif DEFUN ("abs", Fabs, Sabs, 1, 1, 0, "Return the absolute value of ARG.") (arg) register Lisp_Object arg; { CHECK_NUMBER_OR_FLOAT (arg, 0); if (FLOATP (arg)) IN_FLOAT (arg = make_float (fabs (XFLOAT (arg)->data)), "abs", arg); else if (XINT (arg) < 0) XSETINT (arg, - XINT (arg)); return arg; } DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, "Return the floating point number equal to ARG.") (arg) register Lisp_Object arg; { CHECK_NUMBER_OR_FLOAT (arg, 0); if (INTEGERP (arg)) return make_float ((double) XINT (arg)); else /* give 'em the same float back */ return arg; } DEFUN ("logb", Flogb, Slogb, 1, 1, 0, "Returns largest integer <= the base 2 log of the magnitude of ARG.\n\ This is the same as the exponent of a float.") (arg) Lisp_Object arg; { Lisp_Object val; EMACS_INT value; double f = extract_float (arg); if (f == 0.0) value = -(VALMASK >> 1); else { #ifdef HAVE_LOGB IN_FLOAT (value = logb (f), "logb", arg); #else #ifdef HAVE_FREXP int ivalue; IN_FLOAT (frexp (f, &ivalue), "logb", arg); value = ivalue - 1; #else int i; double d; if (f < 0.0) f = -f; value = -1; while (f < 0.5) { for (i = 1, d = 0.5; d * d >= f; i += i) d *= d; f /= d; value -= i; } while (f >= 1.0) { for (i = 1, d = 2.0; d * d <= f; i += i) d *= d; f /= d; value += i; } #endif #endif } XSETINT (val, value); return val; } /* the rounding functions */ DEFUN ("ceiling", Fceiling, Sceiling, 1, 1, 0, "Return the smallest integer no less than ARG. (Round toward +inf.)") (arg) register Lisp_Object arg; { CHECK_NUMBER_OR_FLOAT (arg, 0); if (FLOATP (arg)) { double d; IN_FLOAT (d = ceil (XFLOAT (arg)->data), "ceiling", arg); FLOAT_TO_INT (d, arg, "ceiling", arg); } return arg; } #endif /* LISP_FLOAT_TYPE */ DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, "Return the largest integer no greater than ARG. (Round towards -inf.)\n\ With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.") (arg, divisor) register Lisp_Object arg, divisor; { CHECK_NUMBER_OR_FLOAT (arg, 0); if (! NILP (divisor)) { EMACS_INT i1, i2; CHECK_NUMBER_OR_FLOAT (divisor, 1); #ifdef LISP_FLOAT_TYPE if (FLOATP (arg) || FLOATP (divisor)) { double f1, f2; f1 = FLOATP (arg) ? XFLOAT (arg)->data : XINT (arg); f2 = (FLOATP (divisor) ? XFLOAT (divisor)->data : XINT (divisor)); if (f2 == 0) Fsignal (Qarith_error, Qnil); IN_FLOAT2 (f1 = floor (f1 / f2), "floor", arg, divisor); FLOAT_TO_INT2 (f1, arg, "floor", arg, divisor); return arg; } #endif i1 = XINT (arg); i2 = XINT (divisor); if (i2 == 0) Fsignal (Qarith_error, Qnil); /* With C's /, the result is implementation-defined if either operand is negative, so use only nonnegative operands. */ i1 = (i2 < 0 ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2)) : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2)); XSETINT (arg, i1); return arg; } #ifdef LISP_FLOAT_TYPE if (FLOATP (arg)) { double d; IN_FLOAT (d = floor (XFLOAT (arg)->data), "floor", arg); FLOAT_TO_INT (d, arg, "floor", arg); } #endif return arg; } #ifdef LISP_FLOAT_TYPE DEFUN ("round", Fround, Sround, 1, 1, 0, "Return the nearest integer to ARG.") (arg) register Lisp_Object arg; { CHECK_NUMBER_OR_FLOAT (arg, 0); if (FLOATP (arg)) { double d; /* Screw the prevailing rounding mode. */ IN_FLOAT (d = rint (XFLOAT (arg)->data), "round", arg); FLOAT_TO_INT (d, arg, "round", arg); } return arg; } DEFUN ("truncate", Ftruncate, Struncate, 1, 1, 0, "Truncate a floating point number to an int.\n\ Rounds the value toward zero.") (arg) register Lisp_Object arg; { CHECK_NUMBER_OR_FLOAT (arg, 0); if (FLOATP (arg)) { double d; d = XFLOAT (arg)->data; FLOAT_TO_INT (d, arg, "truncate", arg); } return arg; } /* It's not clear these are worth adding. */ DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, "Return the smallest integer no less than ARG, as a float.\n\ \(Round toward +inf.\)") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = ceil (d), "fceiling", arg); return make_float (d); } DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, "Return the largest integer no greater than ARG, as a float.\n\ \(Round towards -inf.\)") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = floor (d), "ffloor", arg); return make_float (d); } DEFUN ("fround", Ffround, Sfround, 1, 1, 0, "Return the nearest integer to ARG, as a float.") (arg) register Lisp_Object arg; { double d = extract_float (arg); IN_FLOAT (d = rint (d), "fround", arg); return make_float (d); } DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, "Truncate a floating point number to an integral float value.\n\ Rounds the value toward zero.") (arg) register Lisp_Object arg; { double d = extract_float (arg); if (d >= 0.0) IN_FLOAT (d = floor (d), "ftruncate", arg); else IN_FLOAT (d = ceil (d), "ftruncate", arg); return make_float (d); } #ifdef FLOAT_CATCH_SIGILL static SIGTYPE float_error (signo) int signo; { if (! in_float) fatal_error_signal (signo); #ifdef BSD #ifdef BSD4_1 sigrelse (SIGILL); #else /* not BSD4_1 */ sigsetmask (SIGEMPTYMASK); #endif /* not BSD4_1 */ #else /* Must reestablish handler each time it is called. */ signal (SIGILL, float_error); #endif /* BSD */ in_float = 0; Fsignal (Qarith_error, Fcons (float_error_arg, Qnil)); } /* Another idea was to replace the library function `infnan' where SIGILL is signaled. */ #endif /* FLOAT_CATCH_SIGILL */ #ifdef HAVE_MATHERR int matherr (x) struct exception *x; { Lisp_Object args; if (! in_float) /* Not called from emacs-lisp float routines; do the default thing. */ return 0; if (!strcmp (x->name, "pow")) x->name = "expt"; args = Fcons (build_string (x->name), Fcons (make_float (x->arg1), ((!strcmp (x->name, "log") || !strcmp (x->name, "pow")) ? Fcons (make_float (x->arg2), Qnil) : Qnil))); switch (x->type) { case DOMAIN: Fsignal (Qdomain_error, args); break; case SING: Fsignal (Qsingularity_error, args); break; case OVERFLOW: Fsignal (Qoverflow_error, args); break; case UNDERFLOW: Fsignal (Qunderflow_error, args); break; default: Fsignal (Qarith_error, args); break; } return (1); /* don't set errno or print a message */ } #endif /* HAVE_MATHERR */ init_floatfns () { #ifdef FLOAT_CATCH_SIGILL signal (SIGILL, float_error); #endif in_float = 0; } #else /* not LISP_FLOAT_TYPE */ init_floatfns () {} #endif /* not LISP_FLOAT_TYPE */ syms_of_floatfns () { #ifdef LISP_FLOAT_TYPE defsubr (&Sacos); defsubr (&Sasin); defsubr (&Satan); defsubr (&Scos); defsubr (&Ssin); defsubr (&Stan); #if 0 defsubr (&Sacosh); defsubr (&Sasinh); defsubr (&Satanh); defsubr (&Scosh); defsubr (&Ssinh); defsubr (&Stanh); defsubr (&Sbessel_y0); defsubr (&Sbessel_y1); defsubr (&Sbessel_yn); defsubr (&Sbessel_j0); defsubr (&Sbessel_j1); defsubr (&Sbessel_jn); defsubr (&Serf); defsubr (&Serfc); defsubr (&Slog_gamma); defsubr (&Scube_root); #endif defsubr (&Sfceiling); defsubr (&Sffloor); defsubr (&Sfround); defsubr (&Sftruncate); defsubr (&Sexp); defsubr (&Sexpt); defsubr (&Slog); defsubr (&Slog10); defsubr (&Ssqrt); defsubr (&Sabs); defsubr (&Sfloat); defsubr (&Slogb); defsubr (&Sceiling); defsubr (&Sround); defsubr (&Struncate); #endif /* LISP_FLOAT_TYPE */ defsubr (&Sfloor); } emacs-19.30/src/fns.c100444 23073 1 141340 6047602131 13542 0ustar voelkerdaemon/* Random utility Lisp functions. Copyright (C) 1985, 86, 87, 93, 94, 95 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. */ #include /* Note on some machines this defines `vector' as a typedef, so make sure we don't use that name in this file. */ #undef vector #define vector ***** #include "lisp.h" #include "commands.h" #include "buffer.h" #include "keyboard.h" #include "intervals.h" #ifndef NULL #define NULL (void *)0 #endif extern Lisp_Object Flookup_key (); Lisp_Object Qstring_lessp, Qprovide, Qrequire; Lisp_Object Qyes_or_no_p_history; static int internal_equal (); DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, "Return the argument unchanged.") (arg) Lisp_Object arg; { return arg; } extern long get_random (); extern void seed_random (); extern long time (); DEFUN ("random", Frandom, Srandom, 0, 1, 0, "Return a pseudo-random number.\n\ All integers representable in Lisp are equally likely.\n\ On most systems, this is 28 bits' worth.\n\ With positive integer argument N, return random number in interval [0,N).\n\ With argument t, set the random number seed from the current time and pid.") (limit) Lisp_Object limit; { EMACS_INT val; Lisp_Object lispy_val; unsigned long denominator; if (EQ (limit, Qt)) seed_random (getpid () + time (NULL)); if (NATNUMP (limit) && XFASTINT (limit) != 0) { /* Try to take our random number from the higher bits of VAL, not the lower, since (says Gentzel) the low bits of `random' are less random than the higher ones. We do this by using the quotient rather than the remainder. At the high end of the RNG it's possible to get a quotient larger than limit; discarding these values eliminates the bias that would otherwise appear when using a large limit. */ denominator = ((unsigned long)1 << VALBITS) / XFASTINT (limit); do val = get_random () / denominator; while (val >= XFASTINT (limit)); } else val = get_random (); XSETINT (lispy_val, val); return lispy_val; } /* Random data-structure functions */ DEFUN ("length", Flength, Slength, 1, 1, 0, "Return the length of vector, list or string SEQUENCE.\n\ A byte-code function object is also allowed.") (obj) register Lisp_Object obj; { register Lisp_Object tail, val; register int i; retry: if (STRINGP (obj)) XSETFASTINT (val, XSTRING (obj)->size); else if (VECTORP (obj)) XSETFASTINT (val, XVECTOR (obj)->size); else if (CHAR_TABLE_P (obj)) XSETFASTINT (val, CHAR_TABLE_ORDINARY_SLOTS); else if (BOOL_VECTOR_P (obj)) XSETFASTINT (val, XBOOL_VECTOR (obj)->size); else if (COMPILEDP (obj)) XSETFASTINT (val, XVECTOR (obj)->size & PSEUDOVECTOR_SIZE_MASK); else if (CONSP (obj)) { for (i = 0, tail = obj; !NILP (tail); i++) { QUIT; tail = Fcdr (tail); } XSETFASTINT (val, i); } else if (NILP (obj)) XSETFASTINT (val, 0); else { obj = wrong_type_argument (Qsequencep, obj); goto retry; } return val; } /* This does not check for quits. That is safe since it must terminate. */ DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0, "Return the length of a list, but avoid error or infinite loop.\n\ This function never gets an error. If LIST is not really a list,\n\ it returns 0. If LIST is circular, it returns a finite value\n\ which is at least the number of distinct elements.") (list) Lisp_Object list; { Lisp_Object tail, halftail, length; int len = 0; /* halftail is used to detect circular lists. */ halftail = list; for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr) { if (EQ (tail, halftail) && len != 0) break; len++; if ((len & 1) == 0) halftail = XCONS (halftail)->cdr; } XSETINT (length, len); return length; } DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0, "T if two strings have identical contents.\n\ Case is significant, but text properties are ignored.\n\ Symbols are also allowed; their print names are used instead.") (s1, s2) register Lisp_Object s1, s2; { if (SYMBOLP (s1)) XSETSTRING (s1, XSYMBOL (s1)->name); if (SYMBOLP (s2)) XSETSTRING (s2, XSYMBOL (s2)->name); CHECK_STRING (s1, 0); CHECK_STRING (s2, 1); if (XSTRING (s1)->size != XSTRING (s2)->size || bcmp (XSTRING (s1)->data, XSTRING (s2)->data, XSTRING (s1)->size)) return Qnil; return Qt; } DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0, "T if first arg string is less than second in lexicographic order.\n\ Case is significant.\n\ Symbols are also allowed; their print names are used instead.") (s1, s2) register Lisp_Object s1, s2; { register int i; register unsigned char *p1, *p2; register int end; if (SYMBOLP (s1)) XSETSTRING (s1, XSYMBOL (s1)->name); if (SYMBOLP (s2)) XSETSTRING (s2, XSYMBOL (s2)->name); CHECK_STRING (s1, 0); CHECK_STRING (s2, 1); p1 = XSTRING (s1)->data; p2 = XSTRING (s2)->data; end = XSTRING (s1)->size; if (end > XSTRING (s2)->size) end = XSTRING (s2)->size; for (i = 0; i < end; i++) { if (p1[i] != p2[i]) return p1[i] < p2[i] ? Qt : Qnil; } return i < XSTRING (s2)->size ? Qt : Qnil; } static Lisp_Object concat (); /* ARGSUSED */ Lisp_Object concat2 (s1, s2) Lisp_Object s1, s2; { #ifdef NO_ARG_ARRAY Lisp_Object args[2]; args[0] = s1; args[1] = s2; return concat (2, args, Lisp_String, 0); #else return concat (2, &s1, Lisp_String, 0); #endif /* NO_ARG_ARRAY */ } /* ARGSUSED */ Lisp_Object concat3 (s1, s2, s3) Lisp_Object s1, s2, s3; { #ifdef NO_ARG_ARRAY Lisp_Object args[3]; args[0] = s1; args[1] = s2; args[2] = s3; return concat (3, args, Lisp_String, 0); #else return concat (3, &s1, Lisp_String, 0); #endif /* NO_ARG_ARRAY */ } DEFUN ("append", Fappend, Sappend, 0, MANY, 0, "Concatenate all the arguments and make the result a list.\n\ The result is a list whose elements are the elements of all the arguments.\n\ Each argument may be a list, vector or string.\n\ The last argument is not copied, just used as the tail of the new list.") (nargs, args) int nargs; Lisp_Object *args; { return concat (nargs, args, Lisp_Cons, 1); } DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0, "Concatenate all the arguments and make the result a string.\n\ The result is a string whose elements are the elements of all the arguments.\n\ Each argument may be a string or a list or vector of characters (integers).\n\ \n\ Do not use individual integers as arguments!\n\ The behavior of `concat' in that case will be changed later!\n\ If your program passes an integer as an argument to `concat',\n\ you should change it right away not to do so.") (nargs, args) int nargs; Lisp_Object *args; { return concat (nargs, args, Lisp_String, 0); } DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0, "Concatenate all the arguments and make the result a vector.\n\ The result is a vector whose elements are the elements of all the arguments.\n\ Each argument may be a list, vector or string.") (nargs, args) int nargs; Lisp_Object *args; { return concat (nargs, args, Lisp_Vectorlike, 0); } DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, "Return a copy of a list, vector or string.\n\ The elements of a list or vector are not copied; they are shared\n\ with the original.") (arg) Lisp_Object arg; { if (NILP (arg)) return arg; if (CHAR_TABLE_P (arg)) { int i, size; Lisp_Object copy; /* Calculate the number of extra slots. */ size = CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (arg)); copy = Fmake_char_table (XCHAR_TABLE (arg)->purpose, Qnil); /* Copy all the slots, including the extra ones. */ bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents, (XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK) * sizeof (Lisp_Object)); /* Recursively copy any char-tables in the ordinary slots. */ for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++) if (CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i])) XCHAR_TABLE (copy)->contents[i] = Fcopy_sequence (XCHAR_TABLE (copy)->contents[i]); return copy; } if (BOOL_VECTOR_P (arg)) { Lisp_Object val; int size_in_chars = (XBOOL_VECTOR (arg)->size + BITS_PER_CHAR) / BITS_PER_CHAR; val = Fmake_bool_vector (Flength (arg), Qnil); bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data, size_in_chars); return val; } if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg)) arg = wrong_type_argument (Qsequencep, arg); return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0); } static Lisp_Object concat (nargs, args, target_type, last_special) int nargs; Lisp_Object *args; enum Lisp_Type target_type; int last_special; { Lisp_Object val; Lisp_Object len; register Lisp_Object tail; register Lisp_Object this; int toindex; register int leni; register int argnum; Lisp_Object last_tail; Lisp_Object prev; /* In append, the last arg isn't treated like the others */ if (last_special && nargs > 0) { nargs--; last_tail = args[nargs]; } else last_tail = Qnil; for (argnum = 0; argnum < nargs; argnum++) { this = args[argnum]; if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this) || COMPILEDP (this) || BOOL_VECTOR_P (this))) { if (INTEGERP (this)) args[argnum] = Fnumber_to_string (this); else args[argnum] = wrong_type_argument (Qsequencep, this); } } for (argnum = 0, leni = 0; argnum < nargs; argnum++) { this = args[argnum]; len = Flength (this); leni += XFASTINT (len); } XSETFASTINT (len, leni); if (target_type == Lisp_Cons) val = Fmake_list (len, Qnil); else if (target_type == Lisp_Vectorlike) val = Fmake_vector (len, Qnil); else val = Fmake_string (len, len); /* In append, if all but last arg are nil, return last arg */ if (target_type == Lisp_Cons && EQ (val, Qnil)) return last_tail; if (CONSP (val)) tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */ else toindex = 0; prev = Qnil; for (argnum = 0; argnum < nargs; argnum++) { Lisp_Object thislen; int thisleni; register int thisindex = 0; this = args[argnum]; if (!CONSP (this)) thislen = Flength (this), thisleni = XINT (thislen); if (STRINGP (this) && STRINGP (val) && ! NULL_INTERVAL_P (XSTRING (this)->intervals)) { copy_text_properties (make_number (0), thislen, this, make_number (toindex), val, Qnil); } while (1) { register Lisp_Object elt; /* Fetch next element of `this' arg into `elt', or break if `this' is exhausted. */ if (NILP (this)) break; if (CONSP (this)) elt = Fcar (this), this = Fcdr (this); else { if (thisindex >= thisleni) break; if (STRINGP (this)) XSETFASTINT (elt, XSTRING (this)->data[thisindex++]); else if (BOOL_VECTOR_P (this)) { int size_in_chars = ((XBOOL_VECTOR (this)->size + BITS_PER_CHAR) / BITS_PER_CHAR); int byte; byte = XBOOL_VECTOR (val)->data[thisindex / BITS_PER_CHAR]; if (byte & (1 << thisindex)) elt = Qt; else elt = Qnil; } else elt = XVECTOR (this)->contents[thisindex++]; } /* Store into result */ if (toindex < 0) { XCONS (tail)->car = elt; prev = tail; tail = XCONS (tail)->cdr; } else if (VECTORP (val)) XVECTOR (val)->contents[toindex++] = elt; else { while (!INTEGERP (elt)) elt = wrong_type_argument (Qintegerp, elt); { #ifdef MASSC_REGISTER_BUG /* Even removing all "register"s doesn't disable this bug! Nothing simpler than this seems to work. */ unsigned char *p = & XSTRING (val)->data[toindex++]; *p = XINT (elt); #else XSTRING (val)->data[toindex++] = XINT (elt); #endif } } } } if (!NILP (prev)) XCONS (prev)->cdr = last_tail; return val; } DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0, "Return a copy of ALIST.\n\ This is an alist which represents the same mapping from objects to objects,\n\ but does not share the alist structure with ALIST.\n\ The objects mapped (cars and cdrs of elements of the alist)\n\ are shared, however.\n\ Elements of ALIST that are not conses are also shared.") (alist) Lisp_Object alist; { register Lisp_Object tem; CHECK_LIST (alist, 0); if (NILP (alist)) return alist; alist = concat (1, &alist, Lisp_Cons, 0); for (tem = alist; CONSP (tem); tem = XCONS (tem)->cdr) { register Lisp_Object car; car = XCONS (tem)->car; if (CONSP (car)) XCONS (tem)->car = Fcons (XCONS (car)->car, XCONS (car)->cdr); } return alist; } DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0, "Return a substring of STRING, starting at index FROM and ending before TO.\n\ TO may be nil or omitted; then the substring runs to the end of STRING.\n\ If FROM or TO is negative, it counts from the end.") (string, from, to) Lisp_Object string; register Lisp_Object from, to; { Lisp_Object res; CHECK_STRING (string, 0); CHECK_NUMBER (from, 1); if (NILP (to)) to = Flength (string); else CHECK_NUMBER (to, 2); if (XINT (from) < 0) XSETINT (from, XINT (from) + XSTRING (string)->size); if (XINT (to) < 0) XSETINT (to, XINT (to) + XSTRING (string)->size); if (!(0 <= XINT (from) && XINT (from) <= XINT (to) && XINT (to) <= XSTRING (string)->size)) args_out_of_range_3 (string, from, to); res = make_string (XSTRING (string)->data + XINT (from), XINT (to) - XINT (from)); copy_text_properties (from, to, string, make_number (0), res, Qnil); return res; } DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, "Take cdr N times on LIST, returns the result.") (n, list) Lisp_Object n; register Lisp_Object list; { register int i, num; CHECK_NUMBER (n, 0); num = XINT (n); for (i = 0; i < num && !NILP (list); i++) { QUIT; list = Fcdr (list); } return list; } DEFUN ("nth", Fnth, Snth, 2, 2, 0, "Return the Nth element of LIST.\n\ N counts from zero. If LIST is not that long, nil is returned.") (n, list) Lisp_Object n, list; { return Fcar (Fnthcdr (n, list)); } DEFUN ("elt", Felt, Selt, 2, 2, 0, "Return element of SEQUENCE at index N.") (seq, n) register Lisp_Object seq, n; { CHECK_NUMBER (n, 0); while (1) { if (CONSP (seq) || NILP (seq)) return Fcar (Fnthcdr (n, seq)); else if (STRINGP (seq) || VECTORP (seq) || BOOL_VECTOR_P (seq) || CHAR_TABLE_P (seq)) return Faref (seq, n); else seq = wrong_type_argument (Qsequencep, seq); } } DEFUN ("member", Fmember, Smember, 2, 2, 0, "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.\n\ The value is actually the tail of LIST whose car is ELT.") (elt, list) register Lisp_Object elt; Lisp_Object list; { register Lisp_Object tail; for (tail = list; !NILP (tail); tail = Fcdr (tail)) { register Lisp_Object tem; tem = Fcar (tail); if (! NILP (Fequal (elt, tem))) return tail; QUIT; } return Qnil; } DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, "Return non-nil if ELT is an element of LIST. Comparison done with EQ.\n\ The value is actually the tail of LIST whose car is ELT.") (elt, list) register Lisp_Object elt; Lisp_Object list; { register Lisp_Object tail; for (tail = list; !NILP (tail); tail = Fcdr (tail)) { register Lisp_Object tem; tem = Fcar (tail); if (EQ (elt, tem)) return tail; QUIT; } return Qnil; } DEFUN ("assq", Fassq, Sassq, 2, 2, 0, "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\ The value is actually the element of LIST whose car is KEY.\n\ Elements of LIST that are not conses are ignored.") (key, list) register Lisp_Object key; Lisp_Object list; { register Lisp_Object tail; for (tail = list; !NILP (tail); tail = Fcdr (tail)) { register Lisp_Object elt, tem; elt = Fcar (tail); if (!CONSP (elt)) continue; tem = Fcar (elt); if (EQ (key, tem)) return elt; QUIT; } return Qnil; } /* Like Fassq but never report an error and do not allow quits. Use only on lists known never to be circular. */ Lisp_Object assq_no_quit (key, list) register Lisp_Object key; Lisp_Object list; { register Lisp_Object tail; for (tail = list; CONSP (tail); tail = Fcdr (tail)) { register Lisp_Object elt, tem; elt = Fcar (tail); if (!CONSP (elt)) continue; tem = Fcar (elt); if (EQ (key, tem)) return elt; } return Qnil; } DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\ The value is actually the element of LIST whose car equals KEY.") (key, list) register Lisp_Object key; Lisp_Object list; { register Lisp_Object tail; for (tail = list; !NILP (tail); tail = Fcdr (tail)) { register Lisp_Object elt, tem; elt = Fcar (tail); if (!CONSP (elt)) continue; tem = Fequal (Fcar (elt), key); if (!NILP (tem)) return elt; QUIT; } return Qnil; } DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\ The value is actually the element of LIST whose cdr is ELT.") (key, list) register Lisp_Object key; Lisp_Object list; { register Lisp_Object tail; for (tail = list; !NILP (tail); tail = Fcdr (tail)) { register Lisp_Object elt, tem; elt = Fcar (tail); if (!CONSP (elt)) continue; tem = Fcdr (elt); if (EQ (key, tem)) return elt; QUIT; } return Qnil; } DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, "Return non-nil if KEY is `equal' to the cdr of an element of LIST.\n\ The value is actually the element of LIST whose cdr equals KEY.") (key, list) register Lisp_Object key; Lisp_Object list; { register Lisp_Object tail; for (tail = list; !NILP (tail); tail = Fcdr (tail)) { register Lisp_Object elt, tem; elt = Fcar (tail); if (!CONSP (elt)) continue; tem = Fequal (Fcdr (elt), key); if (!NILP (tem)) return elt; QUIT; } return Qnil; } DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, "Delete by side effect any occurrences of ELT as a member of LIST.\n\ The modified LIST is returned. Comparison is done with `eq'.\n\ If the first member of LIST is ELT, there is no way to remove it by side effect;\n\ therefore, write `(setq foo (delq element foo))'\n\ to be sure of changing the value of `foo'.") (elt, list) register Lisp_Object elt; Lisp_Object list; { register Lisp_Object tail, prev; register Lisp_Object tem; tail = list; prev = Qnil; while (!NILP (tail)) { tem = Fcar (tail); if (EQ (elt, tem)) { if (NILP (prev)) list = Fcdr (tail); else Fsetcdr (prev, Fcdr (tail)); } else prev = tail; tail = Fcdr (tail); QUIT; } return list; } DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0, "Delete by side effect any occurrences of ELT as a member of LIST.\n\ The modified LIST is returned. Comparison is done with `equal'.\n\ If the first member of LIST is ELT, deleting it is not a side effect;\n\ it is simply using a different list.\n\ Therefore, write `(setq foo (delete element foo))'\n\ to be sure of changing the value of `foo'.") (elt, list) register Lisp_Object elt; Lisp_Object list; { register Lisp_Object tail, prev; register Lisp_Object tem; tail = list; prev = Qnil; while (!NILP (tail)) { tem = Fcar (tail); if (! NILP (Fequal (elt, tem))) { if (NILP (prev)) list = Fcdr (tail); else Fsetcdr (prev, Fcdr (tail)); } else prev = tail; tail = Fcdr (tail); QUIT; } return list; } DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0, "Reverse LIST by modifying cdr pointers.\n\ Returns the beginning of the reversed list.") (list) Lisp_Object list; { register Lisp_Object prev, tail, next; if (NILP (list)) return list; prev = Qnil; tail = list; while (!NILP (tail)) { QUIT; next = Fcdr (tail); Fsetcdr (tail, prev); prev = tail; tail = next; } return prev; } DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0, "Reverse LIST, copying. Returns the beginning of the reversed list.\n\ See also the function `nreverse', which is used more often.") (list) Lisp_Object list; { Lisp_Object length; register Lisp_Object *vec; register Lisp_Object tail; register int i; length = Flength (list); vec = (Lisp_Object *) alloca (XINT (length) * sizeof (Lisp_Object)); for (i = XINT (length) - 1, tail = list; i >= 0; i--, tail = Fcdr (tail)) vec[i] = Fcar (tail); return Flist (XINT (length), vec); } Lisp_Object merge (); DEFUN ("sort", Fsort, Ssort, 2, 2, 0, "Sort LIST, stably, comparing elements using PREDICATE.\n\ Returns the sorted list. LIST is modified by side effects.\n\ PREDICATE is called with two elements of LIST, and should return T\n\ if the first element is \"less\" than the second.") (list, pred) Lisp_Object list, pred; { Lisp_Object front, back; register Lisp_Object len, tem; struct gcpro gcpro1, gcpro2; register int length; front = list; len = Flength (list); length = XINT (len); if (length < 2) return list; XSETINT (len, (length / 2) - 1); tem = Fnthcdr (len, list); back = Fcdr (tem); Fsetcdr (tem, Qnil); GCPRO2 (front, back); front = Fsort (front, pred); back = Fsort (back, pred); UNGCPRO; return merge (front, back, pred); } Lisp_Object merge (org_l1, org_l2, pred) Lisp_Object org_l1, org_l2; Lisp_Object pred; { Lisp_Object value; register Lisp_Object tail; Lisp_Object tem; register Lisp_Object l1, l2; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; l1 = org_l1; l2 = org_l2; tail = Qnil; value = Qnil; /* It is sufficient to protect org_l1 and org_l2. When l1 and l2 are updated, we copy the new values back into the org_ vars. */ GCPRO4 (org_l1, org_l2, pred, value); while (1) { if (NILP (l1)) { UNGCPRO; if (NILP (tail)) return l2; Fsetcdr (tail, l2); return value; } if (NILP (l2)) { UNGCPRO; if (NILP (tail)) return l1; Fsetcdr (tail, l1); return value; } tem = call2 (pred, Fcar (l2), Fcar (l1)); if (NILP (tem)) { tem = l1; l1 = Fcdr (l1); org_l1 = l1; } else { tem = l2; l2 = Fcdr (l2); org_l2 = l2; } if (NILP (tail)) value = tem; else Fsetcdr (tail, tem); tail = tem; } } DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0, "Extract a value from a property list.\n\ PLIST is a property list, which is a list of the form\n\ \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value\n\ corresponding to the given PROP, or nil if PROP is not\n\ one of the properties on the list.") (val, prop) Lisp_Object val; register Lisp_Object prop; { register Lisp_Object tail; for (tail = val; !NILP (tail); tail = Fcdr (Fcdr (tail))) { register Lisp_Object tem; tem = Fcar (tail); if (EQ (prop, tem)) return Fcar (Fcdr (tail)); } return Qnil; } DEFUN ("get", Fget, Sget, 2, 2, 0, "Return the value of SYMBOL's PROPNAME property.\n\ This is the last value stored with `(put SYMBOL PROPNAME VALUE)'.") (symbol, propname) Lisp_Object symbol, propname; { CHECK_SYMBOL (symbol, 0); return Fplist_get (XSYMBOL (symbol)->plist, propname); } DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0, "Change value in PLIST of PROP to VAL.\n\ PLIST is a property list, which is a list of the form\n\ \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.\n\ If PROP is already a property on the list, its value is set to VAL,\n\ otherwise the new PROP VAL pair is added. The new plist is returned;\n\ use `(setq x (plist-put x prop val))' to be sure to use the new value.\n\ The PLIST is modified by side effects.") (plist, prop, val) Lisp_Object plist; register Lisp_Object prop; Lisp_Object val; { register Lisp_Object tail, prev; Lisp_Object newcell; prev = Qnil; for (tail = plist; CONSP (tail) && CONSP (XCONS (tail)->cdr); tail = XCONS (XCONS (tail)->cdr)->cdr) { if (EQ (prop, XCONS (tail)->car)) { Fsetcar (XCONS (tail)->cdr, val); return plist; } prev = tail; } newcell = Fcons (prop, Fcons (val, Qnil)); if (NILP (prev)) return newcell; else Fsetcdr (XCONS (prev)->cdr, newcell); return plist; } DEFUN ("put", Fput, Sput, 3, 3, 0, "Store SYMBOL's PROPNAME property with value VALUE.\n\ It can be retrieved with `(get SYMBOL PROPNAME)'.") (symbol, propname, value) Lisp_Object symbol, propname, value; { CHECK_SYMBOL (symbol, 0); XSYMBOL (symbol)->plist = Fplist_put (XSYMBOL (symbol)->plist, propname, value); return value; } DEFUN ("equal", Fequal, Sequal, 2, 2, 0, "T if two Lisp objects have similar structure and contents.\n\ They must have the same data type.\n\ Conses are compared by comparing the cars and the cdrs.\n\ Vectors and strings are compared element by element.\n\ Numbers are compared by value, but integers cannot equal floats.\n\ (Use `=' if you want integers and floats to be able to be equal.)\n\ Symbols must match exactly.") (o1, o2) register Lisp_Object o1, o2; { return internal_equal (o1, o2, 0) ? Qt : Qnil; } static int internal_equal (o1, o2, depth) register Lisp_Object o1, o2; int depth; { if (depth > 200) error ("Stack overflow in equal"); tail_recurse: QUIT; if (EQ (o1, o2)) return 1; if (XTYPE (o1) != XTYPE (o2)) return 0; switch (XTYPE (o1)) { #ifdef LISP_FLOAT_TYPE case Lisp_Float: return (extract_float (o1) == extract_float (o2)); #endif case Lisp_Cons: if (!internal_equal (XCONS (o1)->car, XCONS (o2)->car, depth + 1)) return 0; o1 = XCONS (o1)->cdr; o2 = XCONS (o2)->cdr; goto tail_recurse; case Lisp_Misc: if (XMISCTYPE (o1) != XMISCTYPE (o2)) return 0; if (OVERLAYP (o1)) { if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o1), depth + 1) || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o1), depth + 1)) return 0; o1 = XOVERLAY (o1)->plist; o2 = XOVERLAY (o2)->plist; goto tail_recurse; } if (MARKERP (o1)) { return (XMARKER (o1)->buffer == XMARKER (o2)->buffer && (XMARKER (o1)->buffer == 0 || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos)); } break; case Lisp_Vectorlike: { register int i, size; size = XVECTOR (o1)->size; /* Pseudovectors have the type encoded in the size field, so this test actually checks that the objects have the same type as well as the same size. */ if (XVECTOR (o2)->size != size) return 0; /* Boolvectors are compared much like strings. */ if (BOOL_VECTOR_P (o1)) { int size_in_chars = (XBOOL_VECTOR (o1)->size + BITS_PER_CHAR) / BITS_PER_CHAR; if (XBOOL_VECTOR (o1)->size != XBOOL_VECTOR (o2)->size) return 0; if (bcmp (XBOOL_VECTOR (o1)->data, XBOOL_VECTOR (o2)->data, size_in_chars)) return 0; return 1; } /* Aside from them, only true vectors, char-tables, and compiled functions are sensible to compare, so eliminate the others now. */ if (size & PSEUDOVECTOR_FLAG) { if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE))) return 0; size &= PSEUDOVECTOR_SIZE_MASK; } for (i = 0; i < size; i++) { Lisp_Object v1, v2; v1 = XVECTOR (o1)->contents [i]; v2 = XVECTOR (o2)->contents [i]; if (!internal_equal (v1, v2, depth + 1)) return 0; } return 1; } break; case Lisp_String: if (XSTRING (o1)->size != XSTRING (o2)->size) return 0; if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, XSTRING (o1)->size)) return 0; #ifdef USE_TEXT_PROPERTIES /* If the strings have intervals, verify they match; if not, they are unequal. */ if ((XSTRING (o1)->intervals != 0 || XSTRING (o2)->intervals != 0) && ! compare_string_intervals (o1, o2)) return 0; #endif return 1; } return 0; } DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0, "Store each element of ARRAY with ITEM.\n\ ARRAY is a vector, string, char-table, or bool-vector.") (array, item) Lisp_Object array, item; { register int size, index, charval; retry: if (VECTORP (array)) { register Lisp_Object *p = XVECTOR (array)->contents; size = XVECTOR (array)->size; for (index = 0; index < size; index++) p[index] = item; } else if (CHAR_TABLE_P (array)) { register Lisp_Object *p = XCHAR_TABLE (array)->contents; size = CHAR_TABLE_ORDINARY_SLOTS; for (index = 0; index < size; index++) p[index] = item; XCHAR_TABLE (array)->defalt = Qnil; } else if (STRINGP (array)) { register unsigned char *p = XSTRING (array)->data; CHECK_NUMBER (item, 1); charval = XINT (item); size = XSTRING (array)->size; for (index = 0; index < size; index++) p[index] = charval; } else if (BOOL_VECTOR_P (array)) { register unsigned char *p = XBOOL_VECTOR (array)->data; int size_in_chars = (XBOOL_VECTOR (array)->size + BITS_PER_CHAR) / BITS_PER_CHAR; charval = (! NILP (item) ? -1 : 0); for (index = 0; index < size_in_chars; index++) p[index] = charval; } else { array = wrong_type_argument (Qarrayp, array); goto retry; } return array; } DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype, 1, 1, 0, "Return the subtype of char-table CHAR-TABLE. The value is a symbol.") (chartable) Lisp_Object chartable; { CHECK_CHAR_TABLE (chartable, 0); return XCHAR_TABLE (chartable)->purpose; } DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent, 1, 1, 0, "Return the parent char-table of CHAR-TABLE.\n\ The value is either nil or another char-table.\n\ If CHAR-TABLE holds nil for a given character,\n\ then the actual applicable value is inherited from the parent char-table\n\ \(or from its parents, if necessary).") (chartable) Lisp_Object chartable; { CHECK_CHAR_TABLE (chartable, 0); return XCHAR_TABLE (chartable)->parent; } DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent, 2, 2, 0, "Set the parent char-table of CHAR-TABLE to PARENT.\n\ PARENT must be either nil or another char-table.") (chartable, parent) Lisp_Object chartable, parent; { Lisp_Object temp; CHECK_CHAR_TABLE (chartable, 0); if (!NILP (parent)) { CHECK_CHAR_TABLE (parent, 0); for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent) if (EQ (temp, chartable)) error ("Attempt to make a chartable be its own parent"); } XCHAR_TABLE (chartable)->parent = parent; return parent; } DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot, 2, 2, 0, "Return the value in extra-slot number N of char-table CHAR-TABLE.") (chartable, n) Lisp_Object chartable, n; { CHECK_CHAR_TABLE (chartable, 1); CHECK_NUMBER (n, 2); if (XINT (n) < 0 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (chartable))) args_out_of_range (chartable, n); return XCHAR_TABLE (chartable)->extras[XINT (n)]; } DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot, Sset_char_table_extra_slot, 3, 3, 0, "Set extra-slot number N of CHAR-TABLE to VALUE.") (chartable, n, value) Lisp_Object chartable, n, value; { CHECK_CHAR_TABLE (chartable, 1); CHECK_NUMBER (n, 2); if (XINT (n) < 0 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (chartable))) args_out_of_range (chartable, n); return XCHAR_TABLE (chartable)->extras[XINT (n)] = value; } DEFUN ("char-table-range", Fchar_table_range, Schar_table_range, 2, 2, 0, "Return the value in CHARTABLE for a range of characters RANGE.\n\ RANGE should be t (for all characters), nil (for the default value)\n\ a vector which identifies a character set or a row of a character set,\n\ or a character code.") (chartable, range) Lisp_Object chartable, range; { int i; CHECK_CHAR_TABLE (chartable, 0); if (EQ (range, Qnil)) return XCHAR_TABLE (chartable)->defalt; else if (INTEGERP (range)) return Faref (chartable, range); else if (VECTORP (range)) { for (i = 0; i < XVECTOR (range)->size - 1; i++) chartable = Faref (chartable, XVECTOR (range)->contents[i]); if (EQ (XVECTOR (range)->contents[i], Qnil)) return XCHAR_TABLE (chartable)->defalt; else return Faref (chartable, XVECTOR (range)->contents[i]); } else error ("Invalid RANGE argument to `char-table-range'"); } DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range, 3, 3, 0, "Set the value in CHARTABLE for a range of characters RANGE to VALUE.\n\ RANGE should be t (for all characters), nil (for the default value)\n\ a vector which identifies a character set or a row of a character set,\n\ or a character code.") (chartable, range, value) Lisp_Object chartable, range, value; { int i; CHECK_CHAR_TABLE (chartable, 0); if (EQ (range, Qt)) for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++) XCHAR_TABLE (chartable)->contents[i] = value; else if (EQ (range, Qnil)) XCHAR_TABLE (chartable)->defalt = value; else if (INTEGERP (range)) Faset (chartable, range, value); else if (VECTORP (range)) { for (i = 0; i < XVECTOR (range)->size - 1; i++) chartable = Faref (chartable, XVECTOR (range)->contents[i]); if (EQ (XVECTOR (range)->contents[i], Qnil)) XCHAR_TABLE (chartable)->defalt = value; else Faset (chartable, XVECTOR (range)->contents[i], value); } else error ("Invalid RANGE argument to `set-char-table-range'"); return value; } /* Map C_FUNCTION or FUNCTION over CHARTABLE, calling it for each character or group of characters that share a value. DEPTH is the current depth in the originally specified chartable, and INDICES contains the vector indices for the levels our callers have descended. */ void map_char_table (c_function, function, chartable, depth, indices) Lisp_Object (*c_function) (), function, chartable, depth, *indices; { int i; int size = CHAR_TABLE_ORDINARY_SLOTS; /* Make INDICES longer if we are about to fill it up. */ if ((depth % 10) == 9) { Lisp_Object *new_indices = (Lisp_Object *) alloca ((depth += 10) * sizeof (Lisp_Object)); bcopy (indices, new_indices, depth * sizeof (Lisp_Object)); indices = new_indices; } for (i = 0; i < size; i++) { Lisp_Object elt; indices[depth] = i; elt = XCHAR_TABLE (chartable)->contents[i]; if (CHAR_TABLE_P (elt)) map_char_table (chartable, c_function, function, depth + 1, indices); else if (c_function) (*c_function) (depth + 1, indices, elt); /* Here we should handle all cases where the range is a single character by passing that character as a number. Currently, that is all the time, but with the MULE code this will have to be changed. */ else if (depth == 0) call2 (function, make_number (i), elt); else call2 (function, Fvector (depth + 1, indices), elt); } } DEFUN ("map-char-table", Fmap_char_table, Smap_char_table, 2, 2, 0, "Call FUNCTION for each range of like characters in CHARTABLE.\n\ FUNCTION is called with two arguments--a key and a value.\n\ The key is always a possible RANGE argument to `set-char-table-range'.") (function, chartable) Lisp_Object function, chartable; { Lisp_Object keyvec; Lisp_Object *indices = (Lisp_Object *) alloca (10 * sizeof (Lisp_Object)); map_char_table (NULL, function, chartable, 0, indices); return Qnil; } /* ARGSUSED */ Lisp_Object nconc2 (s1, s2) Lisp_Object s1, s2; { #ifdef NO_ARG_ARRAY Lisp_Object args[2]; args[0] = s1; args[1] = s2; return Fnconc (2, args); #else return Fnconc (2, &s1); #endif /* NO_ARG_ARRAY */ } DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0, "Concatenate any number of lists by altering them.\n\ Only the last argument is not altered, and need not be a list.") (nargs, args) int nargs; Lisp_Object *args; { register int argnum; register Lisp_Object tail, tem, val; val = Qnil; for (argnum = 0; argnum < nargs; argnum++) { tem = args[argnum]; if (NILP (tem)) continue; if (NILP (val)) val = tem; if (argnum + 1 == nargs) break; if (!CONSP (tem)) tem = wrong_type_argument (Qlistp, tem); while (CONSP (tem)) { tail = tem; tem = Fcdr (tail); QUIT; } tem = args[argnum + 1]; Fsetcdr (tail, tem); if (NILP (tem)) args[argnum + 1] = tail; } return val; } /* This is the guts of all mapping functions. Apply fn to each element of seq, one by one, storing the results into elements of vals, a C vector of Lisp_Objects. leni is the length of vals, which should also be the length of seq. */ static void mapcar1 (leni, vals, fn, seq) int leni; Lisp_Object *vals; Lisp_Object fn, seq; { register Lisp_Object tail; Lisp_Object dummy; register int i; struct gcpro gcpro1, gcpro2, gcpro3; /* Don't let vals contain any garbage when GC happens. */ for (i = 0; i < leni; i++) vals[i] = Qnil; GCPRO3 (dummy, fn, seq); gcpro1.var = vals; gcpro1.nvars = leni; /* We need not explicitly protect `tail' because it is used only on lists, and 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */ if (VECTORP (seq)) { for (i = 0; i < leni; i++) { dummy = XVECTOR (seq)->contents[i]; vals[i] = call1 (fn, dummy); } } else if (STRINGP (seq)) { for (i = 0; i < leni; i++) { XSETFASTINT (dummy, XSTRING (seq)->data[i]); vals[i] = call1 (fn, dummy); } } else /* Must be a list, since Flength did not get an error */ { tail = seq; for (i = 0; i < leni; i++) { vals[i] = call1 (fn, Fcar (tail)); tail = Fcdr (tail); } } UNGCPRO; } DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0, "Apply FN to each element of SEQ, and concat the results as strings.\n\ In between each pair of results, stick in SEP.\n\ Thus, \" \" as SEP results in spaces between the values returned by FN.") (fn, seq, sep) Lisp_Object fn, seq, sep; { Lisp_Object len; register int leni; int nargs; register Lisp_Object *args; register int i; struct gcpro gcpro1; len = Flength (seq); leni = XINT (len); nargs = leni + leni - 1; if (nargs < 0) return build_string (""); args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object)); GCPRO1 (sep); mapcar1 (leni, args, fn, seq); UNGCPRO; for (i = leni - 1; i >= 0; i--) args[i + i] = args[i]; for (i = 1; i < nargs; i += 2) args[i] = sep; return Fconcat (nargs, args); } DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0, "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\ The result is a list just as long as SEQUENCE.\n\ SEQUENCE may be a list, a vector or a string.") (fn, seq) Lisp_Object fn, seq; { register Lisp_Object len; register int leni; register Lisp_Object *args; len = Flength (seq); leni = XFASTINT (len); args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object)); mapcar1 (leni, args, fn, seq); return Flist (leni, args); } /* Anything that calls this function must protect from GC! */ DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0, "Ask user a \"y or n\" question. Return t if answer is \"y\".\n\ Takes one argument, which is the string to display to ask the question.\n\ It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\ No confirmation of the answer is requested; a single character is enough.\n\ Also accepts Space to mean yes, or Delete to mean no.") (prompt) Lisp_Object prompt; { register Lisp_Object obj, key, def, answer_string, map; register int answer; Lisp_Object xprompt; Lisp_Object args[2]; int ocech = cursor_in_echo_area; struct gcpro gcpro1, gcpro2; map = Fsymbol_value (intern ("query-replace-map")); CHECK_STRING (prompt, 0); xprompt = prompt; GCPRO2 (prompt, xprompt); while (1) { #if defined (HAVE_X_MENU) || defined (HAVE_NTGUI) if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) && using_x_p ()) { Lisp_Object pane, menu; redisplay_preserve_echo_area (); pane = Fcons (Fcons (build_string ("Yes"), Qt), Fcons (Fcons (build_string ("No"), Qnil), Qnil)); menu = Fcons (prompt, pane); obj = Fx_popup_dialog (Qt, menu); answer = !NILP (obj); break; } #endif cursor_in_echo_area = 1; message_nolog ("%s(y or n) ", XSTRING (xprompt)->data); obj = read_filtered_event (1, 0, 0); cursor_in_echo_area = 0; /* If we need to quit, quit with cursor_in_echo_area = 0. */ QUIT; key = Fmake_vector (make_number (1), obj); def = Flookup_key (map, key); answer_string = Fsingle_key_description (obj); if (EQ (def, intern ("skip"))) { answer = 0; break; } else if (EQ (def, intern ("act"))) { answer = 1; break; } else if (EQ (def, intern ("recenter"))) { Frecenter (Qnil); xprompt = prompt; continue; } else if (EQ (def, intern ("quit"))) Vquit_flag = Qt; /* We want to exit this command for exit-prefix, and this is the only way to do it. */ else if (EQ (def, intern ("exit-prefix"))) Vquit_flag = Qt; QUIT; /* If we don't clear this, then the next call to read_char will return quit_char again, and we'll enter an infinite loop. */ Vquit_flag = Qnil; Fding (Qnil); Fdiscard_input (); if (EQ (xprompt, prompt)) { args[0] = build_string ("Please answer y or n. "); args[1] = prompt; xprompt = Fconcat (2, args); } } UNGCPRO; if (! noninteractive) { cursor_in_echo_area = -1; message_nolog ("%s(y or n) %c", XSTRING (xprompt)->data, answer ? 'y' : 'n'); cursor_in_echo_area = ocech; } return answer ? Qt : Qnil; } /* This is how C code calls `yes-or-no-p' and allows the user to redefined it. Anything that calls this function must protect from GC! */ Lisp_Object do_yes_or_no_p (prompt) Lisp_Object prompt; { return call1 (intern ("yes-or-no-p"), prompt); } /* Anything that calls this function must protect from GC! */ DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0, "Ask user a yes-or-no question. Return t if answer is yes.\n\ Takes one argument, which is the string to display to ask the question.\n\ It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\ The user must confirm the answer with RET,\n\ and can edit it until it has been confirmed.") (prompt) Lisp_Object prompt; { register Lisp_Object ans; Lisp_Object args[2]; struct gcpro gcpro1; Lisp_Object menu; CHECK_STRING (prompt, 0); #if defined (HAVE_X_MENU) || defined (HAVE_NTGUI) if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) && using_x_p ()) { Lisp_Object pane, menu, obj; redisplay_preserve_echo_area (); pane = Fcons (Fcons (build_string ("Yes"), Qt), Fcons (Fcons (build_string ("No"), Qnil), Qnil)); GCPRO1 (pane); menu = Fcons (prompt, pane); obj = Fx_popup_dialog (Qt, menu); UNGCPRO; return obj; } #endif args[0] = prompt; args[1] = build_string ("(yes or no) "); prompt = Fconcat (2, args); GCPRO1 (prompt); while (1) { ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil, Qyes_or_no_p_history)); if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes")) { UNGCPRO; return Qt; } if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no")) { UNGCPRO; return Qnil; } Fding (Qnil); Fdiscard_input (); message ("Please answer yes or no."); Fsleep_for (make_number (2), Qnil); } } DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0, "Return list of 1 minute, 5 minute and 15 minute load averages.\n\ Each of the three load averages is multiplied by 100,\n\ then converted to integer.\n\ If the 5-minute or 15-minute load averages are not available, return a\n\ shortened list, containing only those averages which are available.") () { double load_ave[3]; int loads = getloadavg (load_ave, 3); Lisp_Object ret; if (loads < 0) error ("load-average not implemented for this operating system"); ret = Qnil; while (loads > 0) ret = Fcons (make_number ((int) (load_ave[--loads] * 100.0)), ret); return ret; } Lisp_Object Vfeatures; DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0, "Returns t if FEATURE is present in this Emacs.\n\ Use this to conditionalize execution of lisp code based on the presence or\n\ absence of emacs or environment extensions.\n\ Use `provide' to declare that a feature is available.\n\ This function looks at the value of the variable `features'.") (feature) Lisp_Object feature; { register Lisp_Object tem; CHECK_SYMBOL (feature, 0); tem = Fmemq (feature, Vfeatures); return (NILP (tem)) ? Qnil : Qt; } DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0, "Announce that FEATURE is a feature of the current Emacs.") (feature) Lisp_Object feature; { register Lisp_Object tem; CHECK_SYMBOL (feature, 0); if (!NILP (Vautoload_queue)) Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue); tem = Fmemq (feature, Vfeatures); if (NILP (tem)) Vfeatures = Fcons (feature, Vfeatures); LOADHIST_ATTACH (Fcons (Qprovide, feature)); return feature; } DEFUN ("require", Frequire, Srequire, 1, 2, 0, "If feature FEATURE is not loaded, load it from FILENAME.\n\ If FEATURE is not a member of the list `features', then the feature\n\ is not loaded; so load the file FILENAME.\n\ If FILENAME is omitted, the printname of FEATURE is used as the file name.") (feature, file_name) Lisp_Object feature, file_name; { register Lisp_Object tem; CHECK_SYMBOL (feature, 0); tem = Fmemq (feature, Vfeatures); LOADHIST_ATTACH (Fcons (Qrequire, feature)); if (NILP (tem)) { int count = specpdl_ptr - specpdl; /* Value saved here is to be restored into Vautoload_queue */ record_unwind_protect (un_autoload, Vautoload_queue); Vautoload_queue = Qt; Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name, Qnil, Qt, Qnil); tem = Fmemq (feature, Vfeatures); if (NILP (tem)) error ("Required feature %s was not provided", XSYMBOL (feature)->name->data ); /* Once loading finishes, don't undo it. */ Vautoload_queue = Qt; feature = unbind_to (count, feature); } return feature; } syms_of_fns () { Qstring_lessp = intern ("string-lessp"); staticpro (&Qstring_lessp); Qprovide = intern ("provide"); staticpro (&Qprovide); Qrequire = intern ("require"); staticpro (&Qrequire); Qyes_or_no_p_history = intern ("yes-or-no-p-history"); staticpro (&Qyes_or_no_p_history); DEFVAR_LISP ("features", &Vfeatures, "A list of symbols which are the features of the executing emacs.\n\ Used by `featurep' and `require', and altered by `provide'."); Vfeatures = Qnil; defsubr (&Sidentity); defsubr (&Srandom); defsubr (&Slength); defsubr (&Ssafe_length); defsubr (&Sstring_equal); defsubr (&Sstring_lessp); defsubr (&Sappend); defsubr (&Sconcat); defsubr (&Svconcat); defsubr (&Scopy_sequence); defsubr (&Scopy_alist); defsubr (&Ssubstring); defsubr (&Snthcdr); defsubr (&Snth); defsubr (&Selt); defsubr (&Smember); defsubr (&Smemq); defsubr (&Sassq); defsubr (&Sassoc); defsubr (&Srassq); defsubr (&Srassoc); defsubr (&Sdelq); defsubr (&Sdelete); defsubr (&Snreverse); defsubr (&Sreverse); defsubr (&Ssort); defsubr (&Splist_get); defsubr (&Sget); defsubr (&Splist_put); defsubr (&Sput); defsubr (&Sequal); defsubr (&Sfillarray); defsubr (&Schar_table_subtype); defsubr (&Schar_table_parent); defsubr (&Sset_char_table_parent); defsubr (&Schar_table_extra_slot); defsubr (&Sset_char_table_extra_slot); defsubr (&Schar_table_range); defsubr (&Sset_char_table_range); defsubr (&Smap_char_table); defsubr (&Snconc); defsubr (&Smapcar); defsubr (&Smapconcat); defsubr (&Sy_or_n_p); defsubr (&Syes_or_no_p); defsubr (&Sload_average); defsubr (&Sfeaturep); defsubr (&Srequire); defsubr (&Sprovide); } emacs-19.30/src/frame.c100444 12120 1 213054 6051146010 13163 0ustar rmsdaemon/* Generic frame functions. Copyright (C) 1993, 1994, 1995 Free Software Foundation. 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. */ #include #include #include "lisp.h" #include "frame.h" #include "termhooks.h" #include "window.h" #ifdef MSDOS #include "msdos.h" #endif /* Evaluate this expression to rebuild the section of syms_of_frame that initializes and staticpros the symbols declared below. Note that Emacs 18 has a bug that keeps C-x C-e from being able to evaluate this expression. (progn ;; Accumulate a list of the symbols we want to initialize from the ;; declarations at the top of the file. (goto-char (point-min)) (search-forward "/\*&&& symbols declared here &&&*\/\n") (let (symbol-list) (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)") (setq symbol-list (cons (buffer-substring (match-beginning 1) (match-end 1)) symbol-list)) (forward-line 1)) (setq symbol-list (nreverse symbol-list)) ;; Delete the section of syms_of_... where we initialize the symbols. (search-forward "\n /\*&&& init symbols here &&&*\/\n") (let ((start (point))) (while (looking-at "^ Q") (forward-line 2)) (kill-region start (point))) ;; Write a new symbol initialization section. (while symbol-list (insert (format " %s = intern (\"" (car symbol-list))) (let ((start (point))) (insert (substring (car symbol-list) 1)) (subst-char-in-region start (point) ?_ ?-)) (insert (format "\");\n staticpro (&%s);\n" (car symbol-list))) (setq symbol-list (cdr symbol-list))))) */ /* We need most of these symbols even if not MULTI_FRAME; easiest to define them all, all of the time. */ /*&&& symbols declared here &&&*/ Lisp_Object Qframep; Lisp_Object Qframe_live_p; Lisp_Object Qheight; Lisp_Object Qicon; Lisp_Object Qminibuffer; Lisp_Object Qmodeline; Lisp_Object Qname; Lisp_Object Qonly; Lisp_Object Qunsplittable; Lisp_Object Qmenu_bar_lines; Lisp_Object Qwidth; Lisp_Object Qx; Lisp_Object Qwin32; Lisp_Object Qvisible; Lisp_Object Qbuffer_predicate; Lisp_Object Vterminal_frame; Lisp_Object Vdefault_frame_alist; Lisp_Object Qmouse_leave_buffer_hook; static void syms_of_frame_1 () { /*&&& init symbols here &&&*/ Qframep = intern ("framep"); staticpro (&Qframep); Qframe_live_p = intern ("frame-live-p"); staticpro (&Qframe_live_p); Qheight = intern ("height"); staticpro (&Qheight); Qicon = intern ("icon"); staticpro (&Qicon); Qminibuffer = intern ("minibuffer"); staticpro (&Qminibuffer); Qmodeline = intern ("modeline"); staticpro (&Qmodeline); Qname = intern ("name"); staticpro (&Qname); Qonly = intern ("only"); staticpro (&Qonly); Qunsplittable = intern ("unsplittable"); staticpro (&Qunsplittable); Qmenu_bar_lines = intern ("menu-bar-lines"); staticpro (&Qmenu_bar_lines); Qwidth = intern ("width"); staticpro (&Qwidth); Qx = intern ("x"); staticpro (&Qx); Qwin32 = intern ("win32"); staticpro (&Qwin32); Qvisible = intern ("visible"); staticpro (&Qvisible); Qbuffer_predicate = intern ("buffer-predicate"); staticpro (&Qbuffer_predicate); Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook"); staticpro (&Qmouse_leave_buffer_hook); DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist, "Alist of default values for frame creation.\n\ These may be set in your init file, like this:\n\ (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1))\n\ These override values given in window system configuration data,\n\ including X Windows' defaults database.\n\ For values specific to the first Emacs frame, see `initial-frame-alist'.\n\ For values specific to the separate minibuffer frame, see\n\ `minibuffer-frame-alist'.\n\ The `menu-bar-lines' element of the list controls whether new frames\n\ have menu bars; `menu-bar-mode' works by altering this element."); Vdefault_frame_alist = Qnil; } static void set_menu_bar_lines_1 (window, n) Lisp_Object window; int n; { struct window *w = XWINDOW (window); XSETFASTINT (w->last_modified, 0); XSETFASTINT (w->top, XFASTINT (w->top) + n); XSETFASTINT (w->height, XFASTINT (w->height) - n); /* Handle just the top child in a vertical split. */ if (!NILP (w->vchild)) set_menu_bar_lines_1 (w->vchild, n); /* Adjust all children in a horizontal split. */ for (window = w->hchild; !NILP (window); window = w->next) { w = XWINDOW (window); set_menu_bar_lines_1 (window, n); } } static void set_menu_bar_lines (f, value, oldval) struct frame *f; Lisp_Object value, oldval; { int nlines; int olines = FRAME_MENU_BAR_LINES (f); /* Right now, menu bars don't work properly in minibuf-only frames; most of the commands try to apply themselves to the minibuffer frame itslef, and get an error because you can't switch buffers in or split the minibuffer window. */ if (FRAME_MINIBUF_ONLY_P (f)) return; if (INTEGERP (value)) nlines = XINT (value); else nlines = 0; if (nlines != olines) { windows_or_buffers_changed++; FRAME_WINDOW_SIZES_CHANGED (f) = 1; FRAME_MENU_BAR_LINES (f) = nlines; set_menu_bar_lines_1 (f->root_window, nlines - olines); } } #ifdef MULTI_FRAME #include "buffer.h" /* These help us bind and responding to switch-frame events. */ #include "commands.h" #include "keyboard.h" Lisp_Object Vemacs_iconified; Lisp_Object Vframe_list; extern Lisp_Object Vminibuffer_list; extern Lisp_Object get_minibuffer (); extern Lisp_Object Fhandle_switch_frame (); extern Lisp_Object Fredirect_frame_focus (); extern Lisp_Object x_get_focus_frame (); DEFUN ("framep", Fframep, Sframep, 1, 1, 0, "Return non-nil if OBJECT is a frame.\n\ Value is t for a termcap frame (a character-only terminal),\n\ `x' for an Emacs frame that is really an X window,\n\ `pc' for a direct-write MS-DOS frame.\n\ See also `frame-live-p'.") (object) Lisp_Object object; { if (!FRAMEP (object)) return Qnil; switch (XFRAME (object)->output_method) { case output_termcap: return Qt; case output_x_window: return Qx; case output_win32: return Qwin32; /* The `pc' case is in the Fframep below. */ default: abort (); } } DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0, "Return non-nil if OBJECT is a frame which has not been deleted.\n\ Value is nil if OBJECT is not a live frame. If object is a live\n\ frame, the return value indicates what sort of output device it is\n\ displayed on. Value is t for a termcap frame (a character-only\n\ terminal), `x' for an Emacs frame being displayed in an X window.") (object) Lisp_Object object; { return ((FRAMEP (object) && FRAME_LIVE_P (XFRAME (object))) ? Fframep (object) : Qnil); } struct frame * make_frame (mini_p) int mini_p; { Lisp_Object frame; register struct frame *f; register Lisp_Object root_window; register Lisp_Object mini_window; register struct Lisp_Vector *vec; int i; vec = allocate_vectorlike ((EMACS_INT) VECSIZE (struct frame)); for (i = 0; i < VECSIZE (struct frame); i++) XSETFASTINT (vec->contents[i], 0); vec->size = VECSIZE (struct frame); f = (struct frame *)vec; XSETFRAME (frame, f); f->cursor_x = 0; f->cursor_y = 0; f->current_glyphs = 0; f->desired_glyphs = 0; f->visible = 0; f->async_visible = 0; f->output_data.nothing = 0; f->iconified = 0; f->async_iconified = 0; f->wants_modeline = 1; f->auto_raise = 0; f->auto_lower = 0; f->no_split = 0; f->garbaged = 0; f->has_minibuffer = mini_p; f->focus_frame = Qnil; f->explicit_name = 0; f->can_have_scroll_bars = 0; f->has_vertical_scroll_bars = 0; f->param_alist = Qnil; f->scroll_bars = Qnil; f->condemned_scroll_bars = Qnil; f->face_alist = Qnil; f->menu_bar_items = Qnil; f->menu_bar_vector = Qnil; f->menu_bar_items_used = 0; f->buffer_predicate = Qnil; #ifdef MULTI_KBOARD f->kboard = initial_kboard; #endif f->namebuf = 0; root_window = make_window (); if (mini_p) { mini_window = make_window (); XWINDOW (root_window)->next = mini_window; XWINDOW (mini_window)->prev = root_window; XWINDOW (mini_window)->mini_p = Qt; XWINDOW (mini_window)->frame = frame; f->minibuffer_window = mini_window; } else { mini_window = Qnil; XWINDOW (root_window)->next = Qnil; f->minibuffer_window = Qnil; } XWINDOW (root_window)->frame = frame; /* 10 is arbitrary, just so that there is "something there." Correct size will be set up later with change_frame_size. */ f->width = 10; f->height = 10; XSETFASTINT (XWINDOW (root_window)->width, 10); XSETFASTINT (XWINDOW (root_window)->height, (mini_p ? 9 : 10)); if (mini_p) { XSETFASTINT (XWINDOW (mini_window)->width, 10); XSETFASTINT (XWINDOW (mini_window)->top, 9); XSETFASTINT (XWINDOW (mini_window)->height, 1); } /* Choose a buffer for the frame's root window. */ { Lisp_Object buf; XWINDOW (root_window)->buffer = Qt; buf = Fcurrent_buffer (); /* If buf is a 'hidden' buffer (i.e. one whose name starts with a space), try to find another one. */ if (XSTRING (Fbuffer_name (buf))->data[0] == ' ') buf = Fother_buffer (buf, Qnil); Fset_window_buffer (root_window, buf); } if (mini_p) { XWINDOW (mini_window)->buffer = Qt; Fset_window_buffer (mini_window, (NILP (Vminibuffer_list) ? get_minibuffer (0) : Fcar (Vminibuffer_list))); } f->root_window = root_window; f->selected_window = root_window; /* Make sure this window seems more recently used than a newly-created, never-selected window. */ XSETFASTINT (XWINDOW (f->selected_window)->use_time, ++window_select_count); return f; } /* Make a frame using a separate minibuffer window on another frame. MINI_WINDOW is the minibuffer window to use. nil means use the default (the global minibuffer). */ struct frame * make_frame_without_minibuffer (mini_window, kb, display) register Lisp_Object mini_window; KBOARD *kb; Lisp_Object display; { register struct frame *f; if (!NILP (mini_window)) CHECK_LIVE_WINDOW (mini_window, 0); #ifdef MULTI_KBOARD if (!NILP (mini_window) && XFRAME (XWINDOW (mini_window)->frame)->kboard != kb) error ("frame and minibuffer must be on the same display"); #endif /* Make a frame containing just a root window. */ f = make_frame (0); if (NILP (mini_window)) { /* Use default-minibuffer-frame if possible. */ if (!FRAMEP (kb->Vdefault_minibuffer_frame) || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))) { /* If there's no minibuffer frame to use, create one. */ kb->Vdefault_minibuffer_frame = call1 (intern ("make-initial-minibuffer-frame"), display); } mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window; } /* Install the chosen minibuffer window, with proper buffer. */ f->minibuffer_window = mini_window; Fset_window_buffer (mini_window, (NILP (Vminibuffer_list) ? get_minibuffer (0) : Fcar (Vminibuffer_list))); return f; } /* Make a frame containing only a minibuffer window. */ struct frame * make_minibuffer_frame () { /* First make a frame containing just a root window, no minibuffer. */ register struct frame *f = make_frame (0); register Lisp_Object mini_window; register Lisp_Object frame; XSETFRAME (frame, f); f->auto_raise = 0; f->auto_lower = 0; f->no_split = 1; f->wants_modeline = 0; f->has_minibuffer = 1; /* Now label the root window as also being the minibuffer. Avoid infinite looping on the window chain by marking next pointer as nil. */ mini_window = f->minibuffer_window = f->root_window; XWINDOW (mini_window)->mini_p = Qt; XWINDOW (mini_window)->next = Qnil; XWINDOW (mini_window)->prev = Qnil; XWINDOW (mini_window)->frame = frame; /* Put the proper buffer in that window. */ Fset_window_buffer (mini_window, (NILP (Vminibuffer_list) ? get_minibuffer (0) : Fcar (Vminibuffer_list))); return f; } /* Construct a frame that refers to the terminal (stdin and stdout). */ static int terminal_frame_count; struct frame * make_terminal_frame () { register struct frame *f; Lisp_Object frame; char name[20]; #ifdef MULTI_KBOARD if (!initial_kboard) { initial_kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); init_kboard (initial_kboard); initial_kboard->next_kboard = all_kboards; all_kboards = initial_kboard; } #endif /* The first call must initialize Vframe_list. */ if (! (NILP (Vframe_list) || CONSP (Vframe_list))) Vframe_list = Qnil; f = make_frame (1); XSETFRAME (frame, f); Vframe_list = Fcons (frame, Vframe_list); terminal_frame_count++; if (terminal_frame_count == 1) { f->name = build_string ("Emacs"); } else { sprintf (name, "Emacs-%d", terminal_frame_count); f->name = build_string (name); } f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */ f->async_visible = 1; /* Don't let visible be cleared later. */ f->output_data.nothing = 1; /* Nonzero means frame isn't deleted. */ return f; } DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame, 1, 1, 0, "Create an additional terminal frame.\n\ You can create multiple frames on a text-only terminal in this way.\n\ Only the selected terminal frame is actually displayed.\n\ This function takes one argument, an alist specifying frame parameters.\n\ In practice, generally you don't need to specify any parameters.\n\ Note that changing the size of one terminal frame automatically affects all.") (parms) Lisp_Object parms; { struct frame *f; Lisp_Object frame; if (selected_frame->output_method != output_termcap) error ("Not using an ASCII terminal now; cannot make a new ASCII frame"); f = make_terminal_frame (); change_frame_size (f, FRAME_HEIGHT (selected_frame), FRAME_WIDTH (selected_frame), 0, 0); remake_frame_glyphs (f); calculate_costs (f); XSETFRAME (frame, f); Fmodify_frame_parameters (frame, parms); f->face_alist = selected_frame->face_alist; return frame; } Lisp_Object do_switch_frame (frame, no_enter, track) Lisp_Object frame, no_enter; int track; { /* If FRAME is a switch-frame event, extract the frame we should switch to. */ if (CONSP (frame) && EQ (XCONS (frame)->car, Qswitch_frame) && CONSP (XCONS (frame)->cdr)) frame = XCONS (XCONS (frame)->cdr)->car; /* This used to say CHECK_LIVE_FRAME, but apparently it's possible for a switch-frame event to arrive after a frame is no longer live, especially when deleting the initial frame during startup. */ CHECK_FRAME (frame, 0); if (! FRAME_LIVE_P (XFRAME (frame))) return Qnil; if (selected_frame == XFRAME (frame)) return frame; /* This is too greedy; it causes inappropriate focus redirection that's hard to get rid of. */ #if 0 /* If a frame's focus has been redirected toward the currently selected frame, we should change the redirection to point to the newly selected frame. This means that if the focus is redirected from a minibufferless frame to a surrogate minibuffer frame, we can use `other-window' to switch between all the frames using that minibuffer frame, and the focus redirection will follow us around. */ if (track) { Lisp_Object tail; for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object focus; if (!FRAMEP (XCONS (tail)->car)) abort (); focus = FRAME_FOCUS_FRAME (XFRAME (XCONS (tail)->car)); if (FRAMEP (focus) && XFRAME (focus) == selected_frame) Fredirect_frame_focus (XCONS (tail)->car, frame); } } #else /* ! 0 */ /* Instead, apply it only to the frame we're pointing to. */ #ifdef HAVE_WINDOW_SYSTEM if (track && (FRAME_WINDOW_P (XFRAME (frame)))) { Lisp_Object focus, xfocus; xfocus = x_get_focus_frame (XFRAME (frame)); if (FRAMEP (xfocus)) { focus = FRAME_FOCUS_FRAME (XFRAME (xfocus)); if (FRAMEP (focus) && XFRAME (focus) == selected_frame) Fredirect_frame_focus (xfocus, frame); } } #endif /* HAVE_X_WINDOWS */ #endif /* ! 0 */ selected_frame = XFRAME (frame); if (! FRAME_MINIBUF_ONLY_P (selected_frame)) last_nonminibuf_frame = selected_frame; Fselect_window (XFRAME (frame)->selected_window); /* We want to make sure that the next event generates a frame-switch event to the appropriate frame. This seems kludgy to me, but before you take it out, make sure that evaluating something like (select-window (frame-root-window (new-frame))) doesn't end up with your typing being interpreted in the new frame instead of the one you're actually typing in. */ internal_last_event_frame = Qnil; return frame; } DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e", "Select the frame FRAME.\n\ Subsequent editing commands apply to its selected window.\n\ The selection of FRAME lasts until the next time the user does\n\ something to select a different frame, or until the next time this\n\ function is called.") (frame, no_enter) Lisp_Object frame, no_enter; { return do_switch_frame (frame, no_enter, 1); } DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 2, "e", "Handle a switch-frame event EVENT.\n\ Switch-frame events are usually bound to this function.\n\ A switch-frame event tells Emacs that the window manager has requested\n\ that the user's events be directed to the frame mentioned in the event.\n\ This function selects the selected window of the frame of EVENT.\n\ \n\ If EVENT is frame object, handle it as if it were a switch-frame event\n\ to that frame.") (frame, no_enter) Lisp_Object frame, no_enter; { /* Preserve prefix arg that the command loop just cleared. */ current_kboard->Vprefix_arg = Vcurrent_prefix_arg; call1 (Vrun_hooks, Qmouse_leave_buffer_hook); return do_switch_frame (frame, no_enter, 0); } DEFUN ("ignore-event", Fignore_event, Signore_event, 0, 0, "", "Do nothing, but preserve any prefix argument already specified.\n\ This is a suitable binding for iconify-frame and make-frame-visible.") () { current_kboard->Vprefix_arg = Vcurrent_prefix_arg; return Qnil; } DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0, "Return the frame that is now selected.") () { Lisp_Object tem; XSETFRAME (tem, selected_frame); return tem; } DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0, "Return the frame object that window WINDOW is on.") (window) Lisp_Object window; { CHECK_LIVE_WINDOW (window, 0); return XWINDOW (window)->frame; } DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0, "Returns the topmost, leftmost window of FRAME.\n\ If omitted, FRAME defaults to the currently selected frame.") (frame) Lisp_Object frame; { Lisp_Object w; if (NILP (frame)) w = selected_frame->root_window; else { CHECK_LIVE_FRAME (frame, 0); w = XFRAME (frame)->root_window; } while (NILP (XWINDOW (w)->buffer)) { if (! NILP (XWINDOW (w)->hchild)) w = XWINDOW (w)->hchild; else if (! NILP (XWINDOW (w)->vchild)) w = XWINDOW (w)->vchild; else abort (); } return w; } DEFUN ("active-minibuffer-window", Factive_minibuffer_window, Sactive_minibuffer_window, 0, 0, 0, "Return the currently active minibuffer window, or nil if none.") () { return minibuf_level ? minibuf_window : Qnil; } DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0, "Returns the root-window of FRAME.\n\ If omitted, FRAME defaults to the currently selected frame.") (frame) Lisp_Object frame; { if (NILP (frame)) XSETFRAME (frame, selected_frame); else CHECK_LIVE_FRAME (frame, 0); return XFRAME (frame)->root_window; } DEFUN ("frame-selected-window", Fframe_selected_window, Sframe_selected_window, 0, 1, 0, "Return the selected window of frame object FRAME.\n\ If omitted, FRAME defaults to the currently selected frame.") (frame) Lisp_Object frame; { if (NILP (frame)) XSETFRAME (frame, selected_frame); else CHECK_LIVE_FRAME (frame, 0); return XFRAME (frame)->selected_window; } DEFUN ("set-frame-selected-window", Fset_frame_selected_window, Sset_frame_selected_window, 2, 2, 0, "Set the selected window of frame object FRAME to WINDOW.\n\ If FRAME is nil, the selected frame is used.\n\ If FRAME is the selected frame, this makes WINDOW the selected window.") (frame, window) Lisp_Object frame, window; { if (NILP (frame)) XSETFRAME (frame, selected_frame); else CHECK_LIVE_FRAME (frame, 0); CHECK_LIVE_WINDOW (window, 1); if (! EQ (frame, WINDOW_FRAME (XWINDOW (window)))) error ("In `set-frame-selected-window', WINDOW is not on FRAME"); if (XFRAME (frame) == selected_frame) return Fselect_window (window); return XFRAME (frame)->selected_window = window; } DEFUN ("frame-list", Fframe_list, Sframe_list, 0, 0, 0, "Return a list of all frames.") () { return Fcopy_sequence (Vframe_list); } /* Return the next frame in the frame list after FRAME. If MINIBUF is nil, exclude minibuffer-only frames. If MINIBUF is a window, include only its own frame and any frame now using that window as the minibuffer. If MINIBUF is `visible', include all visible frames. If MINIBUF is 0, include all visible and iconified frames. Otherwise, include all frames. */ Lisp_Object next_frame (frame, minibuf) Lisp_Object frame; Lisp_Object minibuf; { Lisp_Object tail; int passed = 0; /* There must always be at least one frame in Vframe_list. */ if (! CONSP (Vframe_list)) abort (); /* If this frame is dead, it won't be in Vframe_list, and we'll loop forever. Forestall that. */ CHECK_LIVE_FRAME (frame, 0); while (1) for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object f; f = XCONS (tail)->car; if (passed && FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame))) { /* Decide whether this frame is eligible to be returned. */ /* If we've looped all the way around without finding any eligible frames, return the original frame. */ if (EQ (f, frame)) return f; /* Let minibuf decide if this frame is acceptable. */ if (NILP (minibuf)) { if (! FRAME_MINIBUF_ONLY_P (XFRAME (f))) return f; } else if (EQ (minibuf, Qvisible)) { FRAME_SAMPLE_VISIBILITY (XFRAME (f)); if (FRAME_VISIBLE_P (XFRAME (f))) return f; } else if (XFASTINT (minibuf) == 0) { FRAME_SAMPLE_VISIBILITY (XFRAME (f)); if (FRAME_VISIBLE_P (XFRAME (f)) || FRAME_ICONIFIED_P (XFRAME (f))) return f; } else if (WINDOWP (minibuf)) { if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf) /* Check that F either is, or has forwarded its focus to, MINIBUF's frame. */ && (EQ (WINDOW_FRAME (XWINDOW (minibuf)), f) || EQ (WINDOW_FRAME (XWINDOW (minibuf)), FRAME_FOCUS_FRAME (XFRAME (f))))) return f; } else return f; } if (EQ (frame, f)) passed++; } } /* Return the previous frame in the frame list before FRAME. If MINIBUF is nil, exclude minibuffer-only frames. If MINIBUF is a window, include only its own frame and any frame now using that window as the minibuffer. If MINIBUF is `visible', include all visible frames. If MINIBUF is 0, include all visible and iconified frames. Otherwise, include all frames. */ Lisp_Object prev_frame (frame, minibuf) Lisp_Object frame; Lisp_Object minibuf; { Lisp_Object tail; Lisp_Object prev; /* There must always be at least one frame in Vframe_list. */ if (! CONSP (Vframe_list)) abort (); prev = Qnil; for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object f; f = XCONS (tail)->car; if (!FRAMEP (f)) abort (); if (EQ (frame, f) && !NILP (prev)) return prev; if (FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame))) { /* Decide whether this frame is eligible to be returned, according to minibuf. */ if (NILP (minibuf)) { if (! FRAME_MINIBUF_ONLY_P (XFRAME (f))) prev = f; } else if (WINDOWP (minibuf)) { if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf) /* Check that F either is, or has forwarded its focus to, MINIBUF's frame. */ && (EQ (WINDOW_FRAME (XWINDOW (minibuf)), f) || EQ (WINDOW_FRAME (XWINDOW (minibuf)), FRAME_FOCUS_FRAME (XFRAME (f))))) prev = f; } else if (EQ (minibuf, Qvisible)) { FRAME_SAMPLE_VISIBILITY (XFRAME (f)); if (FRAME_VISIBLE_P (XFRAME (f))) prev = f; } else if (XFASTINT (minibuf) == 0) { FRAME_SAMPLE_VISIBILITY (XFRAME (f)); if (FRAME_VISIBLE_P (XFRAME (f)) || FRAME_ICONIFIED_P (XFRAME (f))) prev = f; } else prev = f; } } /* We've scanned the entire list. */ if (NILP (prev)) /* We went through the whole frame list without finding a single acceptable frame. Return the original frame. */ return frame; else /* There were no acceptable frames in the list before FRAME; otherwise, we would have returned directly from the loop. Since PREV is the last acceptable frame in the list, return it. */ return prev; } DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0, "Return the next frame in the frame list after FRAME.\n\ It considers only frames on the same terminal as FRAME.\n\ By default, skip minibuffer-only frames.\n\ If omitted, FRAME defaults to the selected frame.\n\ If optional argument MINIFRAME is nil, exclude minibuffer-only frames.\n\ If MINIFRAME is a window, include only its own frame\n\ and any frame now using that window as the minibuffer.\n\ If MINIFRAME is `visible', include all visible frames.\n\ If MINIFRAME is 0, include all visible and iconified frames.\n\ Otherwise, include all frames.") (frame, miniframe) Lisp_Object frame, miniframe; { Lisp_Object tail; if (NILP (frame)) XSETFRAME (frame, selected_frame); else CHECK_LIVE_FRAME (frame, 0); return next_frame (frame, miniframe); } DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0, "Return the previous frame in the frame list before FRAME.\n\ It considers only frames on the same terminal as FRAME.\n\ By default, skip minibuffer-only frames.\n\ If omitted, FRAME defaults to the selected frame.\n\ If optional argument MINIFRAME is nil, exclude minibuffer-only frames.\n\ If MINIFRAME is a window, include only its own frame\n\ and any frame now using that window as the minibuffer.\n\ If MINIFRAME is `visible', include all visible frames.\n\ If MINIFRAME is 0, include all visible and iconified frames.\n\ Otherwise, include all frames.") (frame, miniframe) Lisp_Object frame, miniframe; { Lisp_Object tail; if (NILP (frame)) XSETFRAME (frame, selected_frame); else CHECK_LIVE_FRAME (frame, 0); return prev_frame (frame, miniframe); } /* Return 1 if it is ok to delete frame F; 0 if all frames aside from F are invisible. (Exception: if F is the terminal frame, and we are using X, return 1.) */ int other_visible_frames (f) FRAME_PTR f; { /* We know the selected frame is visible, so if F is some other frame, it can't be the sole visible one. */ if (f == selected_frame) { Lisp_Object frames; int count = 0; for (frames = Vframe_list; CONSP (frames); frames = XCONS (frames)->cdr) { Lisp_Object this; this = XCONS (frames)->car; /* Verify that the frame's window still exists and we can still talk to it. And note any recent change in visibility. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (this))) { x_sync (XFRAME (this)); FRAME_SAMPLE_VISIBILITY (XFRAME (this)); } #endif if (FRAME_VISIBLE_P (XFRAME (this)) || FRAME_ICONIFIED_P (XFRAME (this)) /* Allow deleting the terminal frame when at least one X frame exists! */ || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f))) count++; } return count > 1; } return 1; } DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "", "Delete FRAME, permanently eliminating it from use.\n\ If omitted, FRAME defaults to the selected frame.\n\ A frame may not be deleted if its minibuffer is used by other frames.\n\ Normally, you may not delete a frame if all other frames are invisible,\n\ but if the second optional argument FORCE is non-nil, you may do so.") (frame, force) Lisp_Object frame, force; { struct frame *f; int minibuffer_selected; if (EQ (frame, Qnil)) { f = selected_frame; XSETFRAME (frame, f); } else { CHECK_FRAME (frame, 0); f = XFRAME (frame); } if (! FRAME_LIVE_P (f)) return Qnil; if (NILP (force) && !other_visible_frames (f)) error ("Attempt to delete the sole visible or iconified frame"); /* Does this frame have a minibuffer, and is it the surrogate minibuffer for any other frame? */ if (FRAME_HAS_MINIBUF_P (XFRAME (frame))) { Lisp_Object frames; for (frames = Vframe_list; CONSP (frames); frames = XCONS (frames)->cdr) { Lisp_Object this; this = XCONS (frames)->car; if (! EQ (this, frame) && EQ (frame, WINDOW_FRAME (XWINDOW (FRAME_MINIBUF_WINDOW (XFRAME (this)))))) error ("Attempt to delete a surrogate minibuffer frame"); } } minibuffer_selected = EQ (minibuf_window, selected_window); /* Don't let the frame remain selected. */ if (f == selected_frame) { Lisp_Object tail, frame1; /* Look for another visible frame on the same terminal. */ frame1 = next_frame (frame, Qvisible); /* If there is none, find *some* other frame. */ if (NILP (frame1) || EQ (frame1, frame)) { FOR_EACH_FRAME (tail, frame1) { if (! EQ (frame, frame1)) break; } } do_switch_frame (frame1, Qnil, 0); } /* Don't allow minibuf_window to remain on a deleted frame. */ if (EQ (f->minibuffer_window, minibuf_window)) { Fset_window_buffer (selected_frame->minibuffer_window, XWINDOW (minibuf_window)->buffer); minibuf_window = selected_frame->minibuffer_window; /* If the dying minibuffer window was selected, select the new one. */ if (minibuffer_selected) Fselect_window (minibuf_window); } /* Clear any X selections for this frame. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (f)) x_clear_frame_selections (f); #endif /* Mark all the windows that used to be on FRAME as deleted, and then remove the reference to them. */ delete_all_subwindows (XWINDOW (f->root_window)); f->root_window = Qnil; Vframe_list = Fdelq (frame, Vframe_list); FRAME_SET_VISIBLE (f, 0); if (f->namebuf) free (f->namebuf); if (FRAME_CURRENT_GLYPHS (f)) free_frame_glyphs (f, FRAME_CURRENT_GLYPHS (f)); if (FRAME_DESIRED_GLYPHS (f)) free_frame_glyphs (f, FRAME_DESIRED_GLYPHS (f)); if (FRAME_TEMP_GLYPHS (f)) free_frame_glyphs (f, FRAME_TEMP_GLYPHS (f)); if (FRAME_INSERT_COST (f)) free (FRAME_INSERT_COST (f)); if (FRAME_DELETEN_COST (f)) free (FRAME_DELETEN_COST (f)); if (FRAME_INSERTN_COST (f)) free (FRAME_INSERTN_COST (f)); if (FRAME_DELETE_COST (f)) free (FRAME_DELETE_COST (f)); /* Since some events are handled at the interrupt level, we may get an event for f at any time; if we zero out the frame's display now, then we may trip up the event-handling code. Instead, we'll promise that the display of the frame must be valid until we have called the window-system-dependent frame destruction routine. */ /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) x_destroy_window (f); #endif f->output_data.nothing = 0; /* If we've deleted the last_nonminibuf_frame, then try to find another one. */ if (f == last_nonminibuf_frame) { Lisp_Object frames; last_nonminibuf_frame = 0; for (frames = Vframe_list; CONSP (frames); frames = XCONS (frames)->cdr) { f = XFRAME (XCONS (frames)->car); if (!FRAME_MINIBUF_ONLY_P (f)) { last_nonminibuf_frame = f; break; } } } /* If we've deleted this keyboard's default_minibuffer_frame, try to find another one. Prefer minibuffer-only frames, but also notice frames with other windows. */ if (EQ (frame, FRAME_KBOARD (f)->Vdefault_minibuffer_frame)) { Lisp_Object frames; /* The last frame we saw with a minibuffer, minibuffer-only or not. */ Lisp_Object frame_with_minibuf; /* Some frame we found on the same kboard, or nil if there are none. */ Lisp_Object frame_on_same_kboard; frame_on_same_kboard = Qnil; frame_with_minibuf = Qnil; for (frames = Vframe_list; CONSP (frames); frames = XCONS (frames)->cdr) { Lisp_Object this; struct frame *f1; this = XCONS (frames)->car; if (!FRAMEP (this)) abort (); f1 = XFRAME (this); /* Consider only frames on the same kboard and only those with minibuffers. */ if (FRAME_KBOARD (f) == FRAME_KBOARD (f1) && FRAME_HAS_MINIBUF_P (f1)) { frame_with_minibuf = this; if (FRAME_MINIBUF_ONLY_P (f1)) break; } if (FRAME_KBOARD (f) == FRAME_KBOARD (f1)) frame_on_same_kboard = this; } if (!NILP (frame_on_same_kboard)) { /* We know that there must be some frame with a minibuffer out there. If this were not true, all of the frames present would have to be minibufferless, which implies that at some point their minibuffer frames must have been deleted, but that is prohibited at the top; you can't delete surrogate minibuffer frames. */ if (NILP (frame_with_minibuf)) abort (); FRAME_KBOARD (f)->Vdefault_minibuffer_frame = frame_with_minibuf; } else /* No frames left on this kboard--say no minibuffer either. */ FRAME_KBOARD (f)->Vdefault_minibuffer_frame = Qnil; } return Qnil; } /* Return mouse position in character cell units. */ DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0, "Return a list (FRAME X . Y) giving the current mouse frame and position.\n\ The position is given in character cells, where (0, 0) is the\n\ upper-left corner.\n\ If Emacs is running on a mouseless terminal or hasn't been programmed\n\ to read the mouse position, it returns the selected frame for FRAME\n\ and nil for X and Y.") () { FRAME_PTR f; Lisp_Object lispy_dummy; enum scroll_bar_part party_dummy; Lisp_Object x, y; int col, row; unsigned long long_dummy; f = selected_frame; x = y = Qnil; #ifdef HAVE_MOUSE /* It's okay for the hook to refrain from storing anything. */ if (mouse_position_hook) (*mouse_position_hook) (&f, 0, &lispy_dummy, &party_dummy, &x, &y, &long_dummy); if (! NILP (x)) { col = XINT (x); row = XINT (y); pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1); XSETINT (x, col); XSETINT (y, row); } #endif XSETFRAME (lispy_dummy, f); return Fcons (lispy_dummy, Fcons (x, y)); } DEFUN ("mouse-pixel-position", Fmouse_pixel_position, Smouse_pixel_position, 0, 0, 0, "Return a list (FRAME X . Y) giving the current mouse frame and position.\n\ The position is given in pixel units, where (0, 0) is the\n\ upper-left corner.\n\ If Emacs is running on a mouseless terminal or hasn't been programmed\n\ to read the mouse position, it returns the selected frame for FRAME\n\ and nil for X and Y.") () { FRAME_PTR f; Lisp_Object lispy_dummy; enum scroll_bar_part party_dummy; Lisp_Object x, y; int col, row; unsigned long long_dummy; f = selected_frame; x = y = Qnil; #ifdef HAVE_MOUSE /* It's okay for the hook to refrain from storing anything. */ if (mouse_position_hook) (*mouse_position_hook) (&f, 0, &lispy_dummy, &party_dummy, &x, &y, &long_dummy); #endif XSETFRAME (lispy_dummy, f); return Fcons (lispy_dummy, Fcons (x, y)); } DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0, "Move the mouse pointer to the center of character cell (X,Y) in FRAME.\n\ Note, this is a no-op for an X frame that is not visible.\n\ If you have just created a frame, you must wait for it to become visible\n\ before calling this function on it, like this.\n\ (while (not (frame-visible-p frame)) (sleep-for .5))") (frame, x, y) Lisp_Object frame, x, y; { CHECK_LIVE_FRAME (frame, 0); CHECK_NUMBER (x, 2); CHECK_NUMBER (y, 1); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ x_set_mouse_position (XFRAME (frame), x, y); #endif return Qnil; } DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position, Sset_mouse_pixel_position, 3, 3, 0, "Move the mouse pointer to pixel position (X,Y) in FRAME.\n\ Note, this is a no-op for an X frame that is not visible.\n\ If you have just created a frame, you must wait for it to become visible\n\ before calling this function on it, like this.\n\ (while (not (frame-visible-p frame)) (sleep-for .5))") (frame, x, y) Lisp_Object frame, x, y; { CHECK_LIVE_FRAME (frame, 0); CHECK_NUMBER (x, 2); CHECK_NUMBER (y, 1); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ x_set_mouse_pixel_position (XFRAME (frame), x, y); #endif return Qnil; } DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible, 0, 1, "", "Make the frame FRAME visible (assuming it is an X-window).\n\ If omitted, FRAME defaults to the currently selected frame.") (frame) Lisp_Object frame; { if (NILP (frame)) XSETFRAME (frame, selected_frame); CHECK_LIVE_FRAME (frame, 0); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (frame))) { FRAME_SAMPLE_VISIBILITY (XFRAME (frame)); x_make_frame_visible (XFRAME (frame)); } #endif /* Make menu bar update for the Buffers and Frams menus. */ windows_or_buffers_changed++; return frame; } DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible, 0, 2, "", "Make the frame FRAME invisible (assuming it is an X-window).\n\ If omitted, FRAME defaults to the currently selected frame.\n\ Normally you may not make FRAME invisible if all other frames are invisible,\n\ but if the second optional argument FORCE is non-nil, you may do so.") (frame, force) Lisp_Object frame, force; { if (NILP (frame)) XSETFRAME (frame, selected_frame); CHECK_LIVE_FRAME (frame, 0); if (NILP (force) && !other_visible_frames (XFRAME (frame))) error ("Attempt to make invisible the sole visible or iconified frame"); #if 0 /* This isn't logically necessary, and it can do GC. */ /* Don't let the frame remain selected. */ if (XFRAME (frame) == selected_frame) do_switch_frame (next_frame (frame, Qt), Qnil, 0) #endif /* Don't allow minibuf_window to remain on a deleted frame. */ if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window)) { Fset_window_buffer (selected_frame->minibuffer_window, XWINDOW (minibuf_window)->buffer); minibuf_window = selected_frame->minibuffer_window; } /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (frame))) x_make_frame_invisible (XFRAME (frame)); #endif /* Make menu bar update for the Buffers and Frams menus. */ windows_or_buffers_changed++; return Qnil; } DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame, 0, 1, "", "Make the frame FRAME into an icon.\n\ If omitted, FRAME defaults to the currently selected frame.") (frame) Lisp_Object frame; { if (NILP (frame)) XSETFRAME (frame, selected_frame); CHECK_LIVE_FRAME (frame, 0); #if 0 /* This isn't logically necessary, and it can do GC. */ /* Don't let the frame remain selected. */ if (XFRAME (frame) == selected_frame) Fhandle_switch_frame (next_frame (frame, Qt), Qnil); #endif /* Don't allow minibuf_window to remain on a deleted frame. */ if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window)) { Fset_window_buffer (selected_frame->minibuffer_window, XWINDOW (minibuf_window)->buffer); minibuf_window = selected_frame->minibuffer_window; } /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (frame))) x_iconify_frame (XFRAME (frame)); #endif /* Make menu bar update for the Buffers and Frams menus. */ windows_or_buffers_changed++; return Qnil; } DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p, 1, 1, 0, "Return t if FRAME is now \"visible\" (actually in use for display).\n\ A frame that is not \"visible\" is not updated and, if it works through\n\ a window system, it may not show at all.\n\ Return the symbol `icon' if frame is visible only as an icon.") (frame) Lisp_Object frame; { CHECK_LIVE_FRAME (frame, 0); FRAME_SAMPLE_VISIBILITY (XFRAME (frame)); if (FRAME_VISIBLE_P (XFRAME (frame))) return Qt; if (FRAME_ICONIFIED_P (XFRAME (frame))) return Qicon; return Qnil; } DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list, 0, 0, 0, "Return a list of all frames now \"visible\" (being updated).") () { Lisp_Object tail, frame; struct frame *f; Lisp_Object value; value = Qnil; for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) { frame = XCONS (tail)->car; if (!FRAMEP (frame)) continue; f = XFRAME (frame); if (FRAME_VISIBLE_P (f)) value = Fcons (frame, value); } return value; } DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 0, 1, "", "Bring FRAME to the front, so it occludes any frames it overlaps.\n\ If FRAME is invisible, make it visible.\n\ If you don't specify a frame, the selected frame is used.\n\ If Emacs is displaying on an ordinary terminal or some other device which\n\ doesn't support multiple overlapping frames, this function does nothing.") (frame) Lisp_Object frame; { if (NILP (frame)) XSETFRAME (frame, selected_frame); CHECK_LIVE_FRAME (frame, 0); /* Do like the documentation says. */ Fmake_frame_visible (frame); if (frame_raise_lower_hook) (*frame_raise_lower_hook) (XFRAME (frame), 1); return Qnil; } /* Should we have a corresponding function called Flower_Power? */ DEFUN ("lower-frame", Flower_frame, Slower_frame, 0, 1, "", "Send FRAME to the back, so it is occluded by any frames that overlap it.\n\ If you don't specify a frame, the selected frame is used.\n\ If Emacs is displaying on an ordinary terminal or some other device which\n\ doesn't support multiple overlapping frames, this function does nothing.") (frame) Lisp_Object frame; { if (NILP (frame)) XSETFRAME (frame, selected_frame); CHECK_LIVE_FRAME (frame, 0); if (frame_raise_lower_hook) (*frame_raise_lower_hook) (XFRAME (frame), 0); return Qnil; } DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus, 1, 2, 0, "Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME.\n\ In other words, switch-frame events caused by events in FRAME will\n\ request a switch to FOCUS-FRAME, and `last-event-frame' will be\n\ FOCUS-FRAME after reading an event typed at FRAME.\n\ \n\ If FOCUS-FRAME is omitted or nil, any existing redirection is\n\ cancelled, and the frame again receives its own keystrokes.\n\ \n\ Focus redirection is useful for temporarily redirecting keystrokes to\n\ a surrogate minibuffer frame when a frame doesn't have its own\n\ minibuffer window.\n\ \n\ A frame's focus redirection can be changed by select-frame. If frame\n\ FOO is selected, and then a different frame BAR is selected, any\n\ frames redirecting their focus to FOO are shifted to redirect their\n\ focus to BAR. This allows focus redirection to work properly when the\n\ user switches from one frame to another using `select-window'.\n\ \n\ This means that a frame whose focus is redirected to itself is treated\n\ differently from a frame whose focus is redirected to nil; the former\n\ is affected by select-frame, while the latter is not.\n\ \n\ The redirection lasts until `redirect-frame-focus' is called to change it.") (frame, focus_frame) Lisp_Object frame, focus_frame; { /* Note that we don't check for a live frame here. It's reasonable to redirect the focus of a frame you're about to delete, if you know what other frame should receive those keystrokes. */ CHECK_FRAME (frame, 0); if (! NILP (focus_frame)) CHECK_LIVE_FRAME (focus_frame, 1); XFRAME (frame)->focus_frame = focus_frame; /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (!NILP (focus_frame) && ! EQ (focus_frame, frame) && (FRAME_WINDOW_P (XFRAME (focus_frame)))) Ffocus_frame (focus_frame); #endif if (frame_rehighlight_hook) (*frame_rehighlight_hook) (XFRAME (frame)); return Qnil; } DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0, "Return the frame to which FRAME's keystrokes are currently being sent.\n\ This returns nil if FRAME's focus is not redirected.\n\ See `redirect-frame-focus'.") (frame) Lisp_Object frame; { CHECK_LIVE_FRAME (frame, 0); return FRAME_FOCUS_FRAME (XFRAME (frame)); } /* Return the value of frame parameter PROP in frame FRAME. */ Lisp_Object get_frame_param (frame, prop) register struct frame *frame; Lisp_Object prop; { register Lisp_Object tem; tem = Fassq (prop, frame->param_alist); if (EQ (tem, Qnil)) return tem; return Fcdr (tem); } /* Return the buffer-predicate of the selected frame. */ Lisp_Object frame_buffer_predicate () { return selected_frame->buffer_predicate; } /* Modify the alist in *ALISTPTR to associate PROP with VAL. If the alist already has an element for PROP, we change it. */ void store_in_alist (alistptr, prop, val) Lisp_Object *alistptr, val; Lisp_Object prop; { register Lisp_Object tem; tem = Fassq (prop, *alistptr); if (EQ (tem, Qnil)) *alistptr = Fcons (Fcons (prop, val), *alistptr); else Fsetcdr (tem, val); } void store_frame_param (f, prop, val) struct frame *f; Lisp_Object prop, val; { register Lisp_Object tem; tem = Fassq (prop, f->param_alist); if (EQ (tem, Qnil)) f->param_alist = Fcons (Fcons (prop, val), f->param_alist); else Fsetcdr (tem, val); if (EQ (prop, Qbuffer_predicate)) f->buffer_predicate = val; if (! FRAME_WINDOW_P (f)) if (EQ (prop, Qmenu_bar_lines)) set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f))); if (EQ (prop, Qminibuffer) && WINDOWP (val)) { if (! MINI_WINDOW_P (XWINDOW (val))) error ("Surrogate minibuffer windows must be minibuffer windows."); if (FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f)) error ("can't change the surrogate minibuffer of a frame with its own minibuffer"); /* Install the chosen minibuffer window, with proper buffer. */ f->minibuffer_window = val; } } DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0, "Return the parameters-alist of frame FRAME.\n\ It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.\n\ The meaningful PARMs depend on the kind of frame.\n\ If FRAME is omitted, return information on the currently selected frame.") (frame) Lisp_Object frame; { Lisp_Object alist; FRAME_PTR f; if (EQ (frame, Qnil)) f = selected_frame; else { CHECK_FRAME (frame, 0); f = XFRAME (frame); } if (!FRAME_LIVE_P (f)) return Qnil; alist = Fcopy_alist (f->param_alist); store_in_alist (&alist, Qname, f->name); store_in_alist (&alist, Qheight, make_number (FRAME_HEIGHT (f))); store_in_alist (&alist, Qwidth, make_number (FRAME_WIDTH (f))); store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil)); store_in_alist (&alist, Qminibuffer, (! FRAME_HAS_MINIBUF_P (f) ? Qnil : FRAME_MINIBUF_ONLY_P (f) ? Qonly : FRAME_MINIBUF_WINDOW (f))); store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil)); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) x_report_frame_params (f, &alist); else #endif { /* This ought to be correct in f->param_alist for an X frame. */ Lisp_Object lines; XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f)); store_in_alist (&alist, Qmenu_bar_lines, lines); } return alist; } DEFUN ("modify-frame-parameters", Fmodify_frame_parameters, Smodify_frame_parameters, 2, 2, 0, "Modify the parameters of frame FRAME according to ALIST.\n\ ALIST is an alist of parameters to change and their new values.\n\ Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.\n\ The meaningful PARMs depend on the kind of frame; undefined PARMs are ignored.") (frame, alist) Lisp_Object frame, alist; { FRAME_PTR f; register Lisp_Object tail, elt, prop, val; if (EQ (frame, Qnil)) f = selected_frame; else { CHECK_LIVE_FRAME (frame, 0); f = XFRAME (frame); } /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) x_set_frame_parameters (f, alist); else #endif for (tail = alist; !EQ (tail, Qnil); tail = Fcdr (tail)) { elt = Fcar (tail); prop = Fcar (elt); val = Fcdr (elt); store_frame_param (f, prop, val); } return Qnil; } DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height, 0, 1, 0, "Height in pixels of a line in the font in frame FRAME.\n\ If FRAME is omitted, the selected frame is used.\n\ For a terminal frame, the value is always 1.") (frame) Lisp_Object frame; { struct frame *f; if (NILP (frame)) f = selected_frame; else { CHECK_FRAME (frame, 0); f = XFRAME (frame); } #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) return make_number (x_char_height (f)); else #endif return make_number (1); } DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width, 0, 1, 0, "Width in pixels of characters in the font in frame FRAME.\n\ If FRAME is omitted, the selected frame is used.\n\ The width is the same for all characters, because\n\ currently Emacs supports only fixed-width fonts.\n\ For a terminal screen, the value is always 1.") (frame) Lisp_Object frame; { struct frame *f; if (NILP (frame)) f = selected_frame; else { CHECK_FRAME (frame, 0); f = XFRAME (frame); } #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) return make_number (x_char_width (f)); else #endif return make_number (1); } DEFUN ("frame-pixel-height", Fframe_pixel_height, Sframe_pixel_height, 0, 1, 0, "Return a FRAME's height in pixels.\n\ For a terminal frame, the result really gives the height in characters.\n\ If FRAME is omitted, the selected frame is used.") (frame) Lisp_Object frame; { struct frame *f; if (NILP (frame)) f = selected_frame; else { CHECK_FRAME (frame, 0); f = XFRAME (frame); } #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) return make_number (x_pixel_height (f)); else #endif return make_number (FRAME_HEIGHT (f)); } DEFUN ("frame-pixel-width", Fframe_pixel_width, Sframe_pixel_width, 0, 1, 0, "Return FRAME's width in pixels.\n\ For a terminal frame, the result really gives the width in characters.\n\ If FRAME is omitted, the selected frame is used.") (frame) Lisp_Object frame; { struct frame *f; if (NILP (frame)) f = selected_frame; else { CHECK_FRAME (frame, 0); f = XFRAME (frame); } #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) return make_number (x_pixel_width (f)); else #endif return make_number (FRAME_WIDTH (f)); } DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0, "Specify that the frame FRAME has LINES lines.\n\ Optional third arg non-nil means that redisplay should use LINES lines\n\ but that the idea of the actual height of the frame should not be changed.") (frame, rows, pretend) Lisp_Object frame, rows, pretend; { register struct frame *f; CHECK_NUMBER (rows, 0); if (NILP (frame)) f = selected_frame; else { CHECK_LIVE_FRAME (frame, 0); f = XFRAME (frame); } /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) { if (XINT (rows) != f->height) x_set_window_size (f, 1, f->width, XINT (rows)); } else #endif change_frame_size (f, XINT (rows), 0, !NILP (pretend), 0); return Qnil; } DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0, "Specify that the frame FRAME has COLS columns.\n\ Optional third arg non-nil means that redisplay should use COLS columns\n\ but that the idea of the actual width of the frame should not be changed.") (frame, cols, pretend) Lisp_Object frame, cols, pretend; { register struct frame *f; CHECK_NUMBER (cols, 0); if (NILP (frame)) f = selected_frame; else { CHECK_LIVE_FRAME (frame, 0); f = XFRAME (frame); } /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) { if (XINT (cols) != f->width) x_set_window_size (f, 1, XINT (cols), f->height); } else #endif change_frame_size (f, 0, XINT (cols), !NILP (pretend), 0); return Qnil; } DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0, "Sets size of FRAME to COLS by ROWS, measured in characters.") (frame, cols, rows) Lisp_Object frame, cols, rows; { register struct frame *f; int mask; CHECK_LIVE_FRAME (frame, 0); CHECK_NUMBER (cols, 2); CHECK_NUMBER (rows, 1); f = XFRAME (frame); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) { if (XINT (rows) != f->height || XINT (cols) != f->width) x_set_window_size (f, 1, XINT (cols), XINT (rows)); } else #endif change_frame_size (f, XINT (rows), XINT (cols), 0, 0); return Qnil; } DEFUN ("set-frame-position", Fset_frame_position, Sset_frame_position, 3, 3, 0, "Sets position of FRAME in pixels to XOFFSET by YOFFSET.\n\ This is actually the position of the upper left corner of the frame.\n\ Negative values for XOFFSET or YOFFSET are interpreted relative to\n\ the rightmost or bottommost possible position (that stays within the screen).") (frame, xoffset, yoffset) Lisp_Object frame, xoffset, yoffset; { register struct frame *f; int mask; CHECK_LIVE_FRAME (frame, 0); CHECK_NUMBER (xoffset, 1); CHECK_NUMBER (yoffset, 2); f = XFRAME (frame); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) x_set_offset (f, XINT (xoffset), XINT (yoffset), 1); #endif return Qt; } syms_of_frame () { syms_of_frame_1 (); staticpro (&Vframe_list); DEFVAR_LISP ("terminal-frame", &Vterminal_frame, "The initial frame-object, which represents Emacs's stdout."); DEFVAR_LISP ("emacs-iconified", &Vemacs_iconified, "Non-nil if all of emacs is iconified and frame updates are not needed."); Vemacs_iconified = Qnil; DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame, "Minibufferless frames use this frame's minibuffer.\n\ \n\ Emacs cannot create minibufferless frames unless this is set to an\n\ appropriate surrogate.\n\ \n\ Emacs consults this variable only when creating minibufferless\n\ frames; once the frame is created, it sticks with its assigned\n\ minibuffer, no matter what this variable is set to. This means that\n\ this variable doesn't necessarily say anything meaningful about the\n\ current set of frames, or where the minibuffer is currently being\n\ displayed."); defsubr (&Sactive_minibuffer_window); defsubr (&Sframep); defsubr (&Sframe_live_p); defsubr (&Smake_terminal_frame); defsubr (&Shandle_switch_frame); defsubr (&Signore_event); defsubr (&Sselect_frame); defsubr (&Sselected_frame); defsubr (&Swindow_frame); defsubr (&Sframe_root_window); defsubr (&Sframe_first_window); defsubr (&Sframe_selected_window); defsubr (&Sset_frame_selected_window); defsubr (&Sframe_list); defsubr (&Snext_frame); defsubr (&Sprevious_frame); defsubr (&Sdelete_frame); defsubr (&Smouse_position); defsubr (&Smouse_pixel_position); defsubr (&Sset_mouse_position); defsubr (&Sset_mouse_pixel_position); #if 0 defsubr (&Sframe_configuration); defsubr (&Srestore_frame_configuration); #endif defsubr (&Smake_frame_visible); defsubr (&Smake_frame_invisible); defsubr (&Siconify_frame); defsubr (&Sframe_visible_p); defsubr (&Svisible_frame_list); defsubr (&Sraise_frame); defsubr (&Slower_frame); defsubr (&Sredirect_frame_focus); defsubr (&Sframe_focus); defsubr (&Sframe_parameters); defsubr (&Smodify_frame_parameters); defsubr (&Sframe_char_height); defsubr (&Sframe_char_width); defsubr (&Sframe_pixel_height); defsubr (&Sframe_pixel_width); defsubr (&Sset_frame_height); defsubr (&Sset_frame_width); defsubr (&Sset_frame_size); defsubr (&Sset_frame_position); } keys_of_frame () { initial_define_lispy_key (global_map, "switch-frame", "handle-switch-frame"); initial_define_lispy_key (global_map, "delete-frame", "handle-delete-frame"); initial_define_lispy_key (global_map, "iconify-frame", "ignore-event"); initial_define_lispy_key (global_map, "make-frame-visible", "ignore-event"); } #else /* not MULTI_FRAME */ /* If we're not using multi-frame stuff, we still need to provide some support functions. */ /* Unless this function is defined, providing set-frame-height and set-frame-width doesn't help compatibility any, since they both want this as their first argument. */ DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) () { /* For your possible information, this code is unfolded into the second WINDOW_FRAME in frame.h. */ Lisp_Object tem; XSETFASTINT (tem, 0); return tem; } DEFUN ("active-minibuffer-window", Factive_minibuffer_window, Sactive_minibuffer_window, 0, 0, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) () { return minibuf_level ? minibuf_window : Qnil; } DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (window) Lisp_Object window; { /* For your possible information, this code is unfolded into the second WINDOW_FRAME in frame.h. */ Lisp_Object tem; XSETFASTINT (tem, 0); return tem; } DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0, 0) (frame) Lisp_Object frame; { Lisp_Object w; w = FRAME_ROOT_WINDOW (selected_frame); while (NILP (XWINDOW (w)->buffer)) { if (! NILP (XWINDOW (w)->hchild)) w = XWINDOW (w)->hchild; else if (! NILP (XWINDOW (w)->vchild)) w = XWINDOW (w)->vchild; else abort (); } return w; } DEFUN ("framep", Fframep, Sframep, 1, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (object) Lisp_Object object; { #ifdef MSDOS if (FRAME_X_P (object)) return intern ("pc"); #endif return Qnil; } DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame, rows, pretend) Lisp_Object frame, rows, pretend; { CHECK_NUMBER (rows, 0); change_frame_size (0, XINT (rows), 0, !NILP (pretend), 0); return Qnil; } DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 3, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame, cols, pretend) Lisp_Object frame, cols, pretend; { CHECK_NUMBER (cols, 0); change_frame_size (0, 0, XINT (cols), !NILP (pretend), 0); return Qnil; } DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame, cols, rows) Lisp_Object frame, cols, rows; { CHECK_NUMBER (cols, 2); CHECK_NUMBER (rows, 1); change_frame_size (0, XINT (rows), XINT (cols), 0, 0); return Qnil; } DEFUN ("frame-height", Fframe_height, Sframe_height, 0, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame) Lisp_Object frame; { return make_number (FRAME_HEIGHT (selected_frame)); } DEFUN ("frame-width", Fframe_width, Sframe_width, 0, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame) Lisp_Object frame; { return make_number (FRAME_WIDTH (selected_frame)); } DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height, 0, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame) Lisp_Object frame; { return make_number (1); } DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width, 0, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame) Lisp_Object frame; { return make_number (1); } DEFUN ("frame-pixel-height", Fframe_pixel_height, Sframe_pixel_height, 0, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame) Lisp_Object frame; { return make_number (FRAME_HEIGHT (f)); } DEFUN ("frame-pixel-width", Fframe_pixel_width, Sframe_pixel_width, 0, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame) Lisp_Object frame; { return make_number (FRAME_WIDTH (f)); } /* These are for backward compatibility with Emacs 18. */ DEFUN ("set-screen-height", Fset_screen_height, Sset_screen_height, 1, 2, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (lines, pretend) Lisp_Object lines, pretend; { CHECK_NUMBER (lines, 0); change_frame_size (0, XINT (lines), 0, !NILP (pretend), 0); return Qnil; } DEFUN ("set-screen-width", Fset_screen_width, Sset_screen_width, 1, 2, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (cols, pretend) Lisp_Object cols, pretend; { CHECK_NUMBER (cols, 0); change_frame_size (0, 0, XINT (cols), !NILP (pretend), 0); return Qnil; } DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) () { #ifdef HAVE_MOUSE if (mouse_position_hook) { FRAME_PTR f; Lisp_Object lispy_dummy; enum scroll_bar_part party_dummy; Lisp_Object x, y; unsigned long long_dummy; (*mouse_position_hook) (&f, 0, &lispy_dummy, &party_dummy, &x, &y, &long_dummy); return Fcons (Fselected_frame (), Fcons (x, y)); } #endif return Fcons (Qnil, Fcons (Qnil, Qnil)); } void store_in_alist (alistptr, prop, val) Lisp_Object *alistptr, val; Lisp_Object prop; { register Lisp_Object tem; tem = Fassq (prop, *alistptr); if (EQ (tem, Qnil)) *alistptr = Fcons (Fcons (prop, val), *alistptr); else Fsetcdr (tem, val); } DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame) Lisp_Object frame; { Lisp_Object alist; FRAME_PTR f; if (EQ (frame, Qnil)) f = selected_frame; else { CHECK_FRAME (frame, 0); f = XFRAME (frame); } if (!FRAME_LIVE_P (f)) return Qnil; alist = Qnil; #ifdef MSDOS if (FRAME_X_P (f)) { static char *colornames[16] = { "black", "blue", "green", "cyan", "red", "magenta", "brown", "lightgray", "darkgray", "lightblue", "lightgreen", "lightcyan", "lightred", "lightmagenta", "yellow", "white" }; store_in_alist (&alist, intern ("foreground-color"), build_string (colornames[FRAME_FOREGROUND_PIXEL (f)])); store_in_alist (&alist, intern ("background-color"), build_string (colornames[FRAME_BACKGROUND_PIXEL (f)])); } #endif store_in_alist (&alist, intern ("font"), build_string ("default")); store_in_alist (&alist, Qname, build_string ("emacs")); store_in_alist (&alist, Qheight, make_number (FRAME_HEIGHT (f))); store_in_alist (&alist, Qwidth, make_number (FRAME_WIDTH (f))); store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil)); store_in_alist (&alist, Qminibuffer, FRAME_MINIBUF_WINDOW (f)); store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil)); store_in_alist (&alist, Qmenu_bar_lines, (FRAME_MENU_BAR_LINES (f))); return alist; } DEFUN ("modify-frame-parameters", Fmodify_frame_parameters, Smodify_frame_parameters, 2, 2, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame, alist) Lisp_Object frame, alist; { Lisp_Object tail, elt, prop, val; FRAME_PTR f; if (NILP (frame)) f = selected_frame; else { CHECK_LIVE_FRAME (frame, 0); f = XFRAME (frame); } #ifdef MSDOS if (FRAME_X_P (frame)) IT_set_frame_parameters (XFRAME (frame), alist); else #endif for (tail = alist; !EQ (tail, Qnil); tail = Fcdr (tail)) { elt = Fcar (tail); prop = Fcar (elt); val = Fcdr (elt); if (EQ (prop, Qmenu_bar_lines)) set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f))); } return Qnil; } DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame) Lisp_Object frame; { return Qt; } DEFUN ("frame-visible-p", Fframe_visible_p, Sframe_visible_p, 1, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (frame) Lisp_Object frame; { return Qt; } DEFUN ("frame-list", Fframe_list, Sframe_list, 0, 0, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) () { return Fcons (Fselected_frame (), Qnil); } syms_of_frame () { syms_of_frame_1 (); DEFVAR_LISP ("terminal-frame", &Vterminal_frame, /* Don't confuse make-docfile by having two doc strings for this variable. make-docfile does not pay attention to #if, for good reason! */ 0); XSETFASTINT (Vterminal_frame, 0); defsubr (&Sselected_frame); defsubr (&Sactive_minibuffer_window); defsubr (&Swindow_frame); defsubr (&Sframe_first_window); defsubr (&Sframep); defsubr (&Sframe_char_height); defsubr (&Sframe_char_width); defsubr (&Sframe_pixel_height); defsubr (&Sframe_pixel_width); defsubr (&Sset_frame_height); defsubr (&Sset_frame_width); defsubr (&Sset_frame_size); defsubr (&Sset_screen_height); defsubr (&Sset_screen_width); defsubr (&Sframe_height); Ffset (intern ("screen-height"), intern ("frame-height")); defsubr (&Sframe_width); Ffset (intern ("screen-width"), intern ("frame-width")); defsubr (&Smouse_position); defsubr (&Sframe_parameters); defsubr (&Smodify_frame_parameters); defsubr (&Sframe_live_p); defsubr (&Sframe_visible_p); defsubr (&Sframe_list); #ifdef MSDOS /* A comment in dispnew.c says the_only_frame is not protected. */ the_only_frame.face_alist = Qnil; staticpro (&the_only_frame.face_alist); the_only_frame.menu_bar_items = Qnil; staticpro (&the_only_frame.menu_bar_items); the_only_frame.menu_bar_vector = Qnil; staticpro (&the_only_frame.menu_bar_vector); the_only_frame.menu_bar_items = menu_bar_items (Qnil); #endif } keys_of_frame () { } #endif /* not MULTI_FRAME */ emacs-19.30/src/getloadavg.c100444 12241 1 54320 6011475664 14667 0ustar rolanddaemon/* Get the system load averages. Copyright (C) 1985, 86, 87, 88, 89, 91, 92, 93, 1994, 1995 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ /* Compile-time symbols that this file uses: FIXUP_KERNEL_SYMBOL_ADDR() Adjust address in returned struct nlist. KERNEL_FILE Pathname of the kernel to nlist. LDAV_CVT() Scale the load average from the kernel. Returns a double. LDAV_SYMBOL Name of kernel symbol giving load average. LOAD_AVE_TYPE Type of the load average array in the kernel. Must be defined unless one of apollo, DGUX, NeXT, or UMAX is defined; otherwise, no load average is available. NLIST_STRUCT Include nlist.h, not a.out.h, and the nlist n_name element is a pointer, not an array. NLIST_NAME_UNION struct nlist has an n_un member, not n_name. LINUX_LDAV_FILE [__linux__]: File containing load averages. Specific system predefines this file uses, aside from setting default values if not emacs: apollo BSD Real BSD, not just BSD-like. convex DGUX eunice UNIX emulator under VMS. hpux NeXT sgi sequent Sequent Dynix 3.x.x (BSD) _SEQUENT_ Sequent DYNIX/ptx 1.x.x (SYSV) sony_news NEWS-OS (works at least for 4.1C) UMAX UMAX4_3 VMS __linux__ Linux: assumes /proc filesystem mounted. Support from Michael K. Johnson. __NetBSD__ NetBSD: assumes /kern filesystem mounted. In addition, to avoid nesting many #ifdefs, we internally set LDAV_DONE to indicate that the load average has been computed. We also #define LDAV_PRIVILEGED if a program will require special installation to be able to call getloadavg. */ /* This should always be first. */ #ifdef HAVE_CONFIG_H #include #endif #include /* Both the Emacs and non-Emacs sections want this. Some configuration files' definitions for the LOAD_AVE_CVT macro (like sparc.h's) use macros like FSCALE, defined here. */ #ifdef unix #include #endif /* Exclude all the code except the test program at the end if the system has its own `getloadavg' function. The declaration of `errno' is needed by the test program as well as the function itself, so it comes first. */ #include #ifndef errno extern int errno; #endif #ifndef HAVE_GETLOADAVG /* The existing Emacs configuration files define a macro called LOAD_AVE_CVT, which accepts a value of type LOAD_AVE_TYPE, and returns the load average multiplied by 100. What we actually want is a macro called LDAV_CVT, which returns the load average as an unmultiplied double. For backwards compatibility, we'll define LDAV_CVT in terms of LOAD_AVE_CVT, but future machine config files should just define LDAV_CVT directly. */ #if !defined(LDAV_CVT) && defined(LOAD_AVE_CVT) #define LDAV_CVT(n) (LOAD_AVE_CVT (n) / 100.0) #endif #if !defined (BSD) && defined (ultrix) /* Ultrix behaves like BSD on Vaxen. */ #define BSD #endif #ifdef NeXT /* NeXT in the 2.{0,1,2} releases defines BSD in , which conflicts with the definition understood in this file, that this really is BSD. */ #undef BSD /* NeXT defines FSCALE in . However, we take FSCALE being defined to mean that the nlist method should be used, which is not true. */ #undef FSCALE #endif /* Set values that are different from the defaults, which are set a little farther down with #ifndef. */ /* Some shorthands. */ #if defined (HPUX) && !defined (hpux) #define hpux #endif #if defined(hp300) && !defined(hpux) #define MORE_BSD #endif #if defined(ultrix) && defined(mips) #define decstation #endif #if defined(sun) && defined(SVR4) #define SUNOS_5 #endif #if defined (__osf__) && (defined (__alpha) || defined (__alpha__)) #define OSF_ALPHA #include #endif #if defined (__osf__) && (defined (mips) || defined (__mips__)) #define OSF_MIPS #include #endif /* UTek's /bin/cc on the 4300 has no architecture specific cpp define by default, but _MACH_IND_SYS_TYPES is defined in . Combine that with a couple of other things and we'll have a unique match. */ #if !defined (tek4300) && defined (unix) && defined (m68k) && defined (mc68000) && defined (mc68020) && defined (_MACH_IND_SYS_TYPES) #define tek4300 /* Define by emacs, but not by other users. */ #endif /* VAX C can't handle multi-line #ifs, or lines longer than 256 chars. */ #ifndef LOAD_AVE_TYPE #ifdef MORE_BSD #define LOAD_AVE_TYPE long #endif #ifdef sun #define LOAD_AVE_TYPE long #endif #ifdef decstation #define LOAD_AVE_TYPE long #endif #ifdef _SEQUENT_ #define LOAD_AVE_TYPE long #endif #ifdef sgi #define LOAD_AVE_TYPE long #endif #ifdef SVR4 #define LOAD_AVE_TYPE long #endif #ifdef sony_news #define LOAD_AVE_TYPE long #endif #ifdef sequent #define LOAD_AVE_TYPE long #endif #ifdef OSF_ALPHA #define LOAD_AVE_TYPE long #endif #if defined (ardent) && defined (titan) #define LOAD_AVE_TYPE long #endif #ifdef tek4300 #define LOAD_AVE_TYPE long #endif #if defined(alliant) && defined(i860) /* Alliant FX/2800 */ #define LOAD_AVE_TYPE long #endif #ifdef _AIX #define LOAD_AVE_TYPE long #endif #ifdef convex #define LOAD_AVE_TYPE double #ifndef LDAV_CVT #define LDAV_CVT(n) (n) #endif #endif #endif /* No LOAD_AVE_TYPE. */ #ifdef OSF_ALPHA /* defines an incorrect value for FSCALE on Alpha OSF/1, according to ghazi@noc.rutgers.edu. */ #undef FSCALE #define FSCALE 1024.0 #endif #if defined(alliant) && defined(i860) /* Alliant FX/2800 */ /* defines an incorrect value for FSCALE on an Alliant FX/2800 Concentrix 2.2, according to ghazi@noc.rutgers.edu. */ #undef FSCALE #define FSCALE 100.0 #endif #ifndef FSCALE /* SunOS and some others define FSCALE in sys/param.h. */ #ifdef MORE_BSD #define FSCALE 2048.0 #endif #if defined(MIPS) || defined(SVR4) || defined(decstation) #define FSCALE 256 #endif #if defined (sgi) || defined (sequent) /* Sometimes both MIPS and sgi are defined, so FSCALE was just defined above under #ifdef MIPS. But we want the sgi value. */ #undef FSCALE #define FSCALE 1000.0 #endif #if defined (ardent) && defined (titan) #define FSCALE 65536.0 #endif #ifdef tek4300 #define FSCALE 100.0 #endif #ifdef _AIX #define FSCALE 65536.0 #endif #endif /* Not FSCALE. */ #if !defined (LDAV_CVT) && defined (FSCALE) #define LDAV_CVT(n) (((double) (n)) / FSCALE) #endif /* VAX C can't handle multi-line #ifs, or lines longer that 256 characters. */ #ifndef NLIST_STRUCT #ifdef MORE_BSD #define NLIST_STRUCT #endif #ifdef sun #define NLIST_STRUCT #endif #ifdef decstation #define NLIST_STRUCT #endif #ifdef hpux #define NLIST_STRUCT #endif #if defined (_SEQUENT_) || defined (sequent) #define NLIST_STRUCT #endif #ifdef sgi #define NLIST_STRUCT #endif #ifdef SVR4 #define NLIST_STRUCT #endif #ifdef sony_news #define NLIST_STRUCT #endif #ifdef OSF_ALPHA #define NLIST_STRUCT #endif #if defined (ardent) && defined (titan) #define NLIST_STRUCT #endif #ifdef tek4300 #define NLIST_STRUCT #endif #ifdef butterfly #define NLIST_STRUCT #endif #if defined(alliant) && defined(i860) /* Alliant FX/2800 */ #define NLIST_STRUCT #endif #ifdef _AIX #define NLIST_STRUCT #endif #endif /* defined (NLIST_STRUCT) */ #if defined(sgi) || (defined(mips) && !defined(BSD)) #define FIXUP_KERNEL_SYMBOL_ADDR(nl) ((nl)[0].n_value &= ~(1 << 31)) #endif #if !defined (KERNEL_FILE) && defined (sequent) #define KERNEL_FILE "/dynix" #endif #if !defined (KERNEL_FILE) && defined (hpux) #define KERNEL_FILE "/hp-ux" #endif #if !defined(KERNEL_FILE) && (defined(_SEQUENT_) || defined(MIPS) || defined(SVR4) || defined(ISC) || defined (sgi) || defined(SVR4) || (defined (ardent) && defined (titan))) #define KERNEL_FILE "/unix" #endif #if !defined (LDAV_SYMBOL) && defined (alliant) #define LDAV_SYMBOL "_Loadavg" #endif #if !defined(LDAV_SYMBOL) && ((defined(hpux) && !defined(hp9000s300)) || defined(_SEQUENT_) || defined(SVR4) || defined(ISC) || defined(sgi) || (defined (ardent) && defined (titan)) || defined (_AIX)) #define LDAV_SYMBOL "avenrun" #endif #ifdef HAVE_UNISTD_H #include #endif #include /* LOAD_AVE_TYPE should only get defined if we're going to use the nlist method. */ #if !defined(LOAD_AVE_TYPE) && (defined(BSD) || defined(LDAV_CVT) || defined(KERNEL_FILE) || defined(LDAV_SYMBOL)) #define LOAD_AVE_TYPE double #endif #ifdef LOAD_AVE_TYPE #ifndef VMS #ifndef NLIST_STRUCT #include #else /* NLIST_STRUCT */ #include #endif /* NLIST_STRUCT */ #ifdef SUNOS_5 #include #include #endif #ifndef KERNEL_FILE #define KERNEL_FILE "/vmunix" #endif /* KERNEL_FILE */ #ifndef LDAV_SYMBOL #define LDAV_SYMBOL "_avenrun" #endif /* LDAV_SYMBOL */ #else /* VMS */ #ifndef eunice #include #include #else /* eunice */ #include #endif /* eunice */ #endif /* VMS */ #ifndef LDAV_CVT #define LDAV_CVT(n) ((double) (n)) #endif /* !LDAV_CVT */ #endif /* LOAD_AVE_TYPE */ #ifdef NeXT #ifdef HAVE_MACH_MACH_H #include #else #include #endif #endif /* NeXT */ #ifdef sgi #include #endif /* sgi */ #ifdef UMAX #include #include #include #include #include #ifdef UMAX_43 #include #include #include #include #include #else /* Not UMAX_43. */ #include #include #include #include #include #include #endif /* Not UMAX_43. */ #endif /* UMAX */ #ifdef DGUX #include #endif #if defined(HAVE_FCNTL_H) || defined(_POSIX_VERSION) #include #else #include #endif /* Avoid static vars inside a function since in HPUX they dump as pure. */ #ifdef NeXT static processor_set_t default_set; static int getloadavg_initialized; #endif /* NeXT */ #ifdef UMAX static unsigned int cpus = 0; static unsigned int samples; #endif /* UMAX */ #ifdef DGUX static struct dg_sys_info_load_info load_info; /* what-a-mouthful! */ #endif /* DGUX */ #ifdef LOAD_AVE_TYPE /* File descriptor open to /dev/kmem or VMS load ave driver. */ static int channel; /* Nonzero iff channel is valid. */ static int getloadavg_initialized; /* Offset in kmem to seek to read load average, or 0 means invalid. */ static long offset; #if !defined(VMS) && !defined(sgi) static struct nlist nl[2]; #endif /* Not VMS or sgi */ #ifdef SUNOS_5 static kvm_t *kd; #endif /* SUNOS_5 */ #endif /* LOAD_AVE_TYPE */ /* 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. */ int getloadavg (loadavg, nelem) double loadavg[]; int nelem; { int elem = 0; /* Return value. */ #ifdef NO_GET_LOAD_AVG #define LDAV_DONE /* Set errno to zero to indicate that there was no particular error; this function just can't work at all on this system. */ errno = 0; elem = -1; #endif #if !defined (LDAV_DONE) && defined (__linux__) #define LDAV_DONE #undef LOAD_AVE_TYPE #ifndef LINUX_LDAV_FILE #define LINUX_LDAV_FILE "/proc/loadavg" #endif char ldavgbuf[40]; double load_ave[3]; int fd, count; fd = open (LINUX_LDAV_FILE, O_RDONLY); if (fd == -1) return -1; count = read (fd, ldavgbuf, 40); (void) close (fd); if (count <= 0) return -1; count = sscanf (ldavgbuf, "%lf %lf %lf", &load_ave[0], &load_ave[1], &load_ave[2]); if (count < 1) return -1; for (elem = 0; elem < nelem && elem < count; elem++) loadavg[elem] = load_ave[elem]; return elem; #endif /* __linux__ */ #if !defined (LDAV_DONE) && defined (__NetBSD__) #define LDAV_DONE #undef LOAD_AVE_TYPE #ifndef NETBSD_LDAV_FILE #define NETBSD_LDAV_FILE "/kern/loadavg" #endif unsigned long int load_ave[3], scale; int count; FILE *fp; fp = fopen (NETBSD_LDAV_FILE, "r"); if (fp == NULL) return -1; count = fscanf (fp, "%lu %lu %lu %lu\n", &load_ave[0], &load_ave[1], &load_ave[2], &scale); (void) fclose (fp); if (count != 4) return -1; for (elem = 0; elem < nelem; elem++) loadavg[elem] = (double) load_ave[elem] / (double) scale; return elem; #endif /* __NetBSD__ */ #if !defined (LDAV_DONE) && defined (NeXT) #define LDAV_DONE /* The NeXT code was adapted from iscreen 3.2. */ host_t host; struct processor_set_basic_info info; 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) { if (processor_set_default (host_self (), &default_set) == KERN_SUCCESS) getloadavg_initialized = 1; } if (getloadavg_initialized) { info_count = PROCESSOR_SET_BASIC_INFO_COUNT; if (processor_set_info (default_set, PROCESSOR_SET_BASIC_INFO, &host, (processor_set_info_t) &info, &info_count) != KERN_SUCCESS) getloadavg_initialized = 0; else { if (nelem > 0) loadavg[elem++] = (double) info.load_average / LOAD_SCALE; } } if (!getloadavg_initialized) return -1; #endif /* NeXT */ #if !defined (LDAV_DONE) && defined (UMAX) #define LDAV_DONE /* UMAX 4.2, which runs on the Encore Multimax multiprocessor, does not have a /dev/kmem. Information about the workings of the running kernel can be gathered with inq_stats system calls. We only know how to get the 1-minute average for this system. */ struct proc_summary proc_sum_data; struct stat_descr proc_info; double load; register unsigned int i, j; if (cpus == 0) { register unsigned int c, i; struct cpu_config conf; struct stat_descr desc; desc.sd_next = 0; desc.sd_subsys = SUBSYS_CPU; desc.sd_type = CPUTYPE_CONFIG; desc.sd_addr = (char *) &conf; desc.sd_size = sizeof conf; if (inq_stats (1, &desc)) return -1; c = 0; for (i = 0; i < conf.config_maxclass; ++i) { struct class_stats stats; bzero ((char *) &stats, sizeof stats); desc.sd_type = CPUTYPE_CLASS; desc.sd_objid = i; desc.sd_addr = (char *) &stats; desc.sd_size = sizeof stats; if (inq_stats (1, &desc)) return -1; c += stats.class_numcpus; } cpus = c; samples = cpus < 2 ? 3 : (2 * cpus / 3); } proc_info.sd_next = 0; proc_info.sd_subsys = SUBSYS_PROC; proc_info.sd_type = PROCTYPE_SUMMARY; proc_info.sd_addr = (char *) &proc_sum_data; proc_info.sd_size = sizeof (struct proc_summary); proc_info.sd_sizeused = 0; if (inq_stats (1, &proc_info) != 0) return -1; load = proc_sum_data.ps_nrunnable; j = 0; for (i = samples - 1; i > 0; --i) { load += proc_sum_data.ps_nrun[j]; if (j++ == PS_NRUNSIZE) j = 0; } if (nelem > 0) loadavg[elem++] = load / samples / cpus; #endif /* UMAX */ #if !defined (LDAV_DONE) && defined (DGUX) #define LDAV_DONE /* This call can return -1 for an error, but with good args it's not supposed to fail. The first argument is for no apparent reason of type `long int *'. */ dg_sys_info ((long int *) &load_info, DG_SYS_INFO_LOAD_INFO_TYPE, DG_SYS_INFO_LOAD_VERSION_0); if (nelem > 0) loadavg[elem++] = load_info.one_minute; if (nelem > 1) loadavg[elem++] = load_info.five_minute; if (nelem > 2) loadavg[elem++] = load_info.fifteen_minute; #endif /* DGUX */ #if !defined (LDAV_DONE) && defined (apollo) #define LDAV_DONE /* Apollo code from lisch@mentorg.com (Ray Lischner). This system call is not documented. The load average is obtained as three long integers, for the load average over the past minute, five minutes, and fifteen minutes. Each value is a scaled integer, with 16 bits of integer part and 16 bits of fraction part. I'm not sure which operating system first supported this system call, but I know that SR10.2 supports it. */ extern void proc1_$get_loadav (); unsigned long load_ave[3]; proc1_$get_loadav (load_ave); if (nelem > 0) loadavg[elem++] = load_ave[0] / 65536.0; if (nelem > 1) loadavg[elem++] = load_ave[1] / 65536.0; if (nelem > 2) loadavg[elem++] = load_ave[2] / 65536.0; #endif /* apollo */ #if !defined (LDAV_DONE) && defined (OSF_MIPS) #define LDAV_DONE struct tbl_loadavg load_ave; table (TBL_LOADAVG, 0, &load_ave, 1, sizeof (load_ave)); loadavg[elem++] = (load_ave.tl_lscale == 0 ? load_ave.tl_avenrun.d[0] : (load_ave.tl_avenrun.l[0] / (double) load_ave.tl_lscale)); #endif /* OSF_MIPS */ #if !defined (LDAV_DONE) && defined (OSF_ALPHA) #define LDAV_DONE struct tbl_loadavg load_ave; table (TBL_LOADAVG, 0, &load_ave, 1, sizeof (load_ave)); for (elem = 0; elem < nelem; elem++) loadavg[elem] = (load_ave.tl_lscale == 0 ? load_ave.tl_avenrun.d[elem] : (load_ave.tl_avenrun.l[elem] / (double) load_ave.tl_lscale)); #endif /* OSF_ALPHA */ #if !defined (LDAV_DONE) && defined (VMS) /* VMS specific code -- read from the Load Ave driver. */ LOAD_AVE_TYPE load_ave[3]; static int getloadavg_initialized = 0; #ifdef eunice struct { int dsc$w_length; char *dsc$a_pointer; } descriptor; #endif /* Ensure that there is a channel open to the load ave device. */ if (!getloadavg_initialized) { /* Attempt to open the channel. */ #ifdef eunice descriptor.dsc$w_length = 18; descriptor.dsc$a_pointer = "$$VMS_LOAD_AVERAGE"; #else $DESCRIPTOR (descriptor, "LAV0:"); #endif if (sys$assign (&descriptor, &channel, 0, 0) & 1) getloadavg_initialized = 1; } /* Read the load average vector. */ if (getloadavg_initialized && !(sys$qiow (0, channel, IO$_READVBLK, 0, 0, 0, load_ave, 12, 0, 0, 0, 0) & 1)) { sys$dassgn (channel); getloadavg_initialized = 0; } if (!getloadavg_initialized) return -1; #endif /* VMS */ #if !defined (LDAV_DONE) && defined(LOAD_AVE_TYPE) && !defined(VMS) /* UNIX-specific code -- read the average from /dev/kmem. */ #define LDAV_PRIVILEGED /* This code requires special installation. */ LOAD_AVE_TYPE load_ave[3]; /* Get the address of LDAV_SYMBOL. */ if (offset == 0) { #ifndef sgi #ifndef NLIST_STRUCT strcpy (nl[0].n_name, LDAV_SYMBOL); strcpy (nl[1].n_name, ""); #else /* NLIST_STRUCT */ #ifdef NLIST_NAME_UNION nl[0].n_un.n_name = LDAV_SYMBOL; nl[1].n_un.n_name = 0; #else /* not NLIST_NAME_UNION */ nl[0].n_name = LDAV_SYMBOL; nl[1].n_name = 0; #endif /* not NLIST_NAME_UNION */ #endif /* NLIST_STRUCT */ #ifndef SUNOS_5 if ( #if !(defined (_AIX) && !defined (ps2)) nlist (KERNEL_FILE, nl) #else /* _AIX */ knlist (nl, 1, sizeof (nl[0])) #endif >= 0) /* Omit "&& nl[0].n_type != 0 " -- it breaks on Sun386i. */ { #ifdef FIXUP_KERNEL_SYMBOL_ADDR FIXUP_KERNEL_SYMBOL_ADDR (nl); #endif offset = nl[0].n_value; } #endif /* !SUNOS_5 */ #else /* sgi */ int ldav_off; ldav_off = sysmp (MP_KERNADDR, MPKA_AVENRUN); if (ldav_off != -1) offset = (long) ldav_off & 0x7fffffff; #endif /* sgi */ } /* Make sure we have /dev/kmem open. */ if (!getloadavg_initialized) { #ifndef SUNOS_5 channel = open ("/dev/kmem", 0); if (channel >= 0) { /* Set the channel to close on exec, so it does not litter any child's descriptor table. */ #ifdef FD_SETFD #ifndef FD_CLOEXEC #define FD_CLOEXEC 1 #endif (void) fcntl (channel, F_SETFD, FD_CLOEXEC); #endif 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; } #endif /* SUNOS_5 */ } /* If we can, get the load average values. */ if (offset && getloadavg_initialized) { /* Try to read the load. */ #ifndef SUNOS_5 if (lseek (channel, offset, 0) == -1L || read (channel, (char *) load_ave, sizeof (load_ave)) != sizeof (load_ave)) { close (channel); getloadavg_initialized = 0; } #else /* SUNOS_5 */ if (kvm_read (kd, offset, (char *) load_ave, sizeof (load_ave)) != sizeof (load_ave)) { kvm_close (kd); getloadavg_initialized = 0; } #endif /* SUNOS_5 */ } if (offset == 0 || !getloadavg_initialized) return -1; #endif /* LOAD_AVE_TYPE and not VMS */ #if !defined (LDAV_DONE) && defined (LOAD_AVE_TYPE) /* Including VMS. */ if (nelem > 0) loadavg[elem++] = LDAV_CVT (load_ave[0]); if (nelem > 1) loadavg[elem++] = LDAV_CVT (load_ave[1]); if (nelem > 2) loadavg[elem++] = LDAV_CVT (load_ave[2]); #define LDAV_DONE #endif /* !LDAV_DONE && LOAD_AVE_TYPE */ #ifdef LDAV_DONE return elem; #else /* Set errno to zero to indicate that there was no particular error; this function just can't work at all on this system. */ errno = 0; return -1; #endif } #endif /* ! HAVE_GETLOADAVG */ #ifdef TEST void main (argc, argv) int argc; char **argv; { int naptime = 0; if (argc > 1) naptime = atoi (argv[1]); while (1) { double avg[3]; int loads; errno = 0; /* Don't be misled if it doesn't set errno. */ loads = getloadavg (avg, 3); if (loads == -1) { perror ("Error getting load average"); exit (1); } if (loads > 0) printf ("1-minute: %f ", avg[0]); if (loads > 1) printf ("5-minute: %f ", avg[1]); if (loads > 2) printf ("15-minute: %f ", avg[2]); if (loads > 0) putchar ('\n'); if (naptime == 0) break; sleep (naptime); } exit (0); } #endif /* TEST */ emacs-19.30/src/gmalloc1.c100666 12120 1 133652 6040313261 13605 0ustar rmsdaemon/* DO NOT EDIT THIS FILE -- it is automagically generated. -*- C -*- */ #define _MALLOC_INTERNAL /* The malloc headers and source files from the C library follow here. */ /* Declarations for `malloc' and friends. Copyright 1990, 1991, 1992, 1993, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_H #define _MALLOC_H 1 #ifdef _MALLOC_INTERNAL #ifdef HAVE_CONFIG_H #include #endif #ifdef emacs /* Avoid our `valloc' declaration, since it may conflict with a bogus declaration in Emacs's config.h (and `valloc' is unused). */ #define valloc emacs_loser_valloc #endif #if defined(_LIBC) || defined(STDC_HEADERS) || defined(USG) #include #else #ifndef memset #define memset(s, zero, n) bzero ((s), (n)) #endif #ifndef memcpy #define memcpy(d, s, n) bcopy ((s), (d), (n)) #endif #endif #if defined (__GNU_LIBRARY__) || (defined (__STDC__) && __STDC__) #include #else #ifndef CHAR_BIT #define CHAR_BIT 8 #endif #endif #ifdef HAVE_UNISTD_H #include #endif #endif /* _MALLOC_INTERNAL. */ #ifdef __cplusplus extern "C" { #endif #if defined (__cplusplus) || (defined (__STDC__) && __STDC__) #undef __P #define __P(args) args #undef __ptr_t #define __ptr_t void * #else /* Not C++ or ANSI C. */ #undef __P #define __P(args) () #undef const #define const #undef __ptr_t #define __ptr_t char * #endif /* C++ or ANSI C. */ #if defined (__STDC__) && __STDC__ #include #define __malloc_size_t size_t #define __malloc_ptrdiff_t ptrdiff_t #else #define __malloc_size_t unsigned int #define __malloc_ptrdiff_t int #endif #ifndef NULL #define NULL 0 #endif /* Allocate SIZE bytes of memory. */ extern __ptr_t malloc __P ((__malloc_size_t __size)); /* Re-allocate the previously allocated block in __ptr_t, making the new block SIZE bytes long. */ extern __ptr_t realloc __P ((__ptr_t __ptr, __malloc_size_t __size)); /* Allocate NMEMB elements of SIZE bytes each, all initialized to 0. */ extern __ptr_t calloc __P ((__malloc_size_t __nmemb, __malloc_size_t __size)); /* Free a block allocated by `malloc', `realloc' or `calloc'. */ extern void free __P ((__ptr_t __ptr)); /* Allocate SIZE bytes allocated to ALIGNMENT bytes. */ extern __ptr_t memalign __P ((__malloc_size_t __alignment, __malloc_size_t __size)); /* Allocate SIZE bytes on a page boundary. */ extern __ptr_t valloc __P ((__malloc_size_t __size)); #ifdef _MALLOC_INTERNAL /* The allocator divides the heap into blocks of fixed size; large requests receive one or more whole blocks, and small requests receive a fragment of a block. Fragment sizes are powers of two, and all fragments of a block are the same size. When all the fragments in a block have been freed, the block itself is freed. */ #define INT_BIT (CHAR_BIT * sizeof(int)) #define BLOCKLOG (INT_BIT > 16 ? 12 : 9) #define BLOCKSIZE (1 << BLOCKLOG) #define BLOCKIFY(SIZE) (((SIZE) + BLOCKSIZE - 1) / BLOCKSIZE) /* Determine the amount of memory spanned by the initial heap table (not an absolute limit). */ #define HEAP (INT_BIT > 16 ? 4194304 : 65536) /* Number of contiguous free blocks allowed to build up at the end of memory before they will be returned to the system. */ #define FINAL_FREE_BLOCKS 8 /* Data structure giving per-block information. */ typedef union { /* Heap information for a busy block. */ struct { /* Zero for a large (multiblock) object, or positive giving the logarithm to the base two of the fragment size. */ int type; union { struct { __malloc_size_t nfree; /* Free frags in a fragmented block. */ __malloc_size_t first; /* First free fragment of the block. */ } frag; /* For a large object, in its first block, this has the number of blocks in the object. In the other blocks, this has a negative number which says how far back the first block is. */ __malloc_ptrdiff_t size; } info; } busy; /* Heap information for a free block (that may be the first of a free cluster). */ struct { __malloc_size_t size; /* Size (in blocks) of a free cluster. */ __malloc_size_t next; /* Index of next free cluster. */ __malloc_size_t prev; /* Index of previous free cluster. */ } free; } malloc_info; /* Pointer to first block of the heap. */ extern char *_heapbase; /* Table indexed by block number giving per-block information. */ extern malloc_info *_heapinfo; /* Address to block number and vice versa. */ #define BLOCK(A) (((char *) (A) - _heapbase) / BLOCKSIZE + 1) #define ADDRESS(B) ((__ptr_t) (((B) - 1) * BLOCKSIZE + _heapbase)) /* Current search index for the heap table. */ extern __malloc_size_t _heapindex; /* Limit of valid info table indices. */ extern __malloc_size_t _heaplimit; /* Doubly linked lists of free fragments. */ struct list { struct list *next; struct list *prev; }; /* Free list headers for each fragment size. */ extern struct list _fraghead[]; /* List of blocks allocated with `memalign' (or `valloc'). */ struct alignlist { struct alignlist *next; __ptr_t aligned; /* The address that memaligned returned. */ __ptr_t exact; /* The address that malloc returned. */ }; extern struct alignlist *_aligned_blocks; /* Instrumentation. */ extern __malloc_size_t _chunks_used; extern __malloc_size_t _bytes_used; extern __malloc_size_t _chunks_free; extern __malloc_size_t _bytes_free; /* Internal versions of `malloc', `realloc', and `free' used when these functions need to call each other. They are the same but don't call the hooks. */ extern __ptr_t _malloc_internal __P ((__malloc_size_t __size)); extern __ptr_t _realloc_internal __P ((__ptr_t __ptr, __malloc_size_t __size)); extern void _free_internal __P ((__ptr_t __ptr)); #endif /* _MALLOC_INTERNAL. */ /* Given an address in the middle of a malloc'd object, return the address of the beginning of the object. */ extern __ptr_t malloc_find_object_address __P ((__ptr_t __ptr)); /* Underlying allocation function; successive calls should return contiguous pieces of memory. */ extern __ptr_t (*__morecore) __P ((__malloc_ptrdiff_t __size)); /* Default value of `__morecore'. */ extern __ptr_t __default_morecore __P ((__malloc_ptrdiff_t __size)); /* If not NULL, this function is called after each time `__morecore' is called to increase the data size. */ extern void (*__after_morecore_hook) __P ((void)); /* Number of extra blocks to get each time we ask for more core. This reduces the frequency of calling `(*__morecore)'. */ extern __malloc_size_t __malloc_extra_blocks; /* Nonzero if `malloc' has been called and done its initialization. */ extern int __malloc_initialized; /* Hooks for debugging versions. */ extern void (*__malloc_initialize_hook) __P ((void)); extern void (*__free_hook) __P ((__ptr_t __ptr)); extern __ptr_t (*__malloc_hook) __P ((__malloc_size_t __size)); extern __ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, __malloc_size_t __size)); extern __ptr_t (*__memalign_hook) __P ((__malloc_size_t __size, __malloc_size_t __alignment)); /* Return values for `mprobe': these are the kinds of inconsistencies that `mcheck' enables detection of. */ enum mcheck_status { MCHECK_DISABLED = -1, /* Consistency checking is not turned on. */ MCHECK_OK, /* Block is fine. */ MCHECK_FREE, /* Block freed twice. */ MCHECK_HEAD, /* Memory before the block was clobbered. */ MCHECK_TAIL /* Memory after the block was clobbered. */ }; /* Activate a standard collection of debugging hooks. This must be called before `malloc' is ever called. ABORTFUNC is called with an error code (see enum above) when an inconsistency is detected. If ABORTFUNC is null, the standard function prints on stderr and then calls `abort'. */ extern int mcheck __P ((void (*__abortfunc) __P ((enum mcheck_status)))); /* Check for aberrations in a particular malloc'd block. You must have called `mcheck' already. These are the same checks that `mcheck' does when you free or reallocate a block. */ extern enum mcheck_status mprobe __P ((__ptr_t __ptr)); /* Activate a standard collection of tracing hooks. */ extern void mtrace __P ((void)); extern void muntrace __P ((void)); /* Statistics available to the user. */ struct mstats { __malloc_size_t bytes_total; /* Total size of the heap. */ __malloc_size_t chunks_used; /* Chunks allocated by the user. */ __malloc_size_t bytes_used; /* Byte total of user-allocated chunks. */ __malloc_size_t chunks_free; /* Chunks in the free list. */ __malloc_size_t bytes_free; /* Byte total of chunks in the free list. */ }; /* Pick up the current statistics. */ extern struct mstats mstats __P ((void)); /* Call WARNFUN with a warning message when memory usage is high. */ extern void memory_warnings __P ((__ptr_t __start, void (*__warnfun) __P ((const char *)))); /* Relocating allocator. */ /* Allocate SIZE bytes, and store the address in *HANDLEPTR. */ extern __ptr_t r_alloc __P ((__ptr_t *__handleptr, __malloc_size_t __size)); /* Free the storage allocated in HANDLEPTR. */ extern void r_alloc_free __P ((__ptr_t *__handleptr)); /* Adjust the block at HANDLEPTR to be SIZE bytes long. */ extern __ptr_t r_re_alloc __P ((__ptr_t *__handleptr, __malloc_size_t __size)); #ifdef __cplusplus } #endif #endif /* malloc.h */ /* Memory allocator `malloc'. Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif #include /* How to really get more memory. */ __ptr_t (*__morecore) __P ((ptrdiff_t __size)) = __default_morecore; /* Debugging hook for `malloc'. */ __ptr_t (*__malloc_hook) __P ((__malloc_size_t __size)); /* Pointer to the base of the first block. */ char *_heapbase; /* Block information table. Allocated with align/__free (not malloc/free). */ malloc_info *_heapinfo; /* Number of info entries. */ static __malloc_size_t heapsize; /* Search index in the info table. */ __malloc_size_t _heapindex; /* Limit of valid info table indices. */ __malloc_size_t _heaplimit; /* Free lists for each fragment size. */ struct list _fraghead[BLOCKLOG]; /* Instrumentation. */ __malloc_size_t _chunks_used; __malloc_size_t _bytes_used; __malloc_size_t _chunks_free; __malloc_size_t _bytes_free; /* Are you experienced? */ int __malloc_initialized; __malloc_size_t __malloc_extra_blocks; void (*__malloc_initialize_hook) __P ((void)); void (*__after_morecore_hook) __P ((void)); static __ptr_t get_contiguous_space __P ((__malloc_ptrdiff_t, __ptr_t)); /* Aligned allocation. */ static __ptr_t align __P ((__malloc_size_t)); static __ptr_t align (size) __malloc_size_t size; { __ptr_t result; unsigned long int adj; result = (*__morecore) (size); adj = (unsigned long int) ((unsigned long int) ((char *) result - (char *) NULL)) % BLOCKSIZE; if (adj != 0) { adj = BLOCKSIZE - adj; (void) (*__morecore) (adj); result = (char *) result + adj; } if (__after_morecore_hook) (*__after_morecore_hook) (); return result; } /* This is called when `_heapinfo' and `heapsize' have just been set to describe a new info table. Set up the table to describe itself and account for it in the statistics. */ static void register_heapinfo __P ((void)); #ifdef __GNUC__ __inline__ #endif static void register_heapinfo () { __malloc_size_t block, blocks; block = BLOCK (_heapinfo); blocks = BLOCKIFY (heapsize * sizeof (malloc_info)); /* Account for the _heapinfo block itself in the statistics. */ _bytes_used += blocks * BLOCKSIZE; ++_chunks_used; /* Describe the heapinfo block itself in the heapinfo. */ _heapinfo[block].busy.type = 0; _heapinfo[block].busy.info.size = blocks; /* Leave back-pointers for malloc_find_address. */ while (--blocks > 0) _heapinfo[block + blocks].busy.info.size = -blocks; } /* Set everything up and remember that we have. */ static int initialize __P ((void)); static int initialize () { if (__malloc_initialize_hook) (*__malloc_initialize_hook) (); heapsize = HEAP / BLOCKSIZE; _heapinfo = (malloc_info *) align (heapsize * sizeof (malloc_info)); if (_heapinfo == NULL) return 0; memset (_heapinfo, 0, heapsize * sizeof (malloc_info)); _heapinfo[0].free.size = 0; _heapinfo[0].free.next = _heapinfo[0].free.prev = 0; _heapindex = 0; _heapbase = (char *) _heapinfo; _heaplimit = BLOCK (_heapbase + heapsize * sizeof (malloc_info)); register_heapinfo (); __malloc_initialized = 1; return 1; } static int morecore_recursing; /* Get neatly aligned memory, initializing or growing the heap info table as necessary. */ static __ptr_t morecore __P ((__malloc_size_t)); static __ptr_t morecore (size) __malloc_size_t size; { __ptr_t result; malloc_info *newinfo, *oldinfo; __malloc_size_t newsize; if (morecore_recursing) /* Avoid recursion. The caller will know how to handle a null return. */ return NULL; result = align (size); if (result == NULL) return NULL; /* Check if we need to grow the info table. */ if ((__malloc_size_t) BLOCK ((char *) result + size) > heapsize) { /* Calculate the new _heapinfo table size. We do not account for the added blocks in the table itself, as we hope to place them in existing free space, which is already covered by part of the existing table. */ newsize = heapsize; do newsize *= 2; while ((__malloc_size_t) BLOCK ((char *) result + size) > newsize); /* First try to allocate the new info table in core we already have, in the usual way using realloc. If realloc cannot extend it in place or relocate it to existing sufficient core, we will get called again, and the code above will notice the `morecore_recursing' flag and return null. */ { int save = errno; /* Don't want to clobber errno with ENOMEM. */ morecore_recursing = 1; newinfo = (malloc_info *) _realloc_internal (_heapinfo, newsize * sizeof (malloc_info)); morecore_recursing = 0; if (newinfo == NULL) errno = save; else { /* We found some space in core, and realloc has put the old table's blocks on the free list. Now zero the new part of the table and install the new table location. */ memset (&newinfo[heapsize], 0, (newsize - heapsize) * sizeof (malloc_info)); _heapinfo = newinfo; heapsize = newsize; goto got_heap; } } /* Allocate new space for the malloc info table. */ while (1) { newinfo = (malloc_info *) align (newsize * sizeof (malloc_info)); /* Did it fail? */ if (newinfo == NULL) { (*__morecore) (-size); return NULL; } /* Is it big enough to record status for its own space? If so, we win. */ if ((__malloc_size_t) BLOCK ((char *) newinfo + newsize * sizeof (malloc_info)) > newsize) break; /* Must try again. First give back most of what we just got. */ (*morecore) (- newsize * sizeof (malloc_info)); newsize *= 2; } /* Copy the old table to the beginning of the new, and zero the rest of the new table. */ memcpy (newinfo, _heapinfo, heapsize * sizeof (malloc_info)); memset (&newinfo[heapsize], 0, (newsize - heapsize) * sizeof (malloc_info)); oldinfo = _heapinfo; _heapinfo = newinfo; heapsize = newsize; register_heapinfo (); /* Reset _heaplimit so _free_internal never decides it can relocate or resize the info table. */ _heaplimit = 0; _free_internal (oldinfo); /* The new heap limit includes the new table just allocated. */ _heaplimit = BLOCK ((char *) newinfo + heapsize * sizeof (malloc_info)); return result; } got_heap: _heaplimit = BLOCK ((char *) result + size); return result; } /* Allocate memory from the heap. */ __ptr_t _malloc_internal (size) __malloc_size_t size; { __ptr_t result; __malloc_size_t block, blocks, lastblocks, start; register __malloc_size_t i; struct list *next; /* ANSI C allows `malloc (0)' to either return NULL, or to return a valid address you can realloc and free (though not dereference). It turns out that some extant code (sunrpc, at least Ultrix's version) expects `malloc (0)' to return non-NULL and breaks otherwise. Be compatible. */ #if 0 if (size == 0) return NULL; #endif if (!__malloc_initialized) if (!initialize ()) return NULL; if (size < sizeof (struct list)) size = sizeof (struct list); #ifdef SUNOS_LOCALTIME_BUG if (size < 16) size = 16; #endif /* Determine the allocation policy based on the request size. */ if (size <= BLOCKSIZE / 2) { /* Small allocation to receive a fragment of a block. Determine the logarithm to base two of the fragment size. */ register __malloc_size_t log = 1; --size; while ((size /= 2) != 0) ++log; /* Look in the fragment lists for a free fragment of the desired size. */ next = _fraghead[log].next; if (next != NULL) { /* There are free fragments of this size. Pop a fragment out of the fragment list and return it. Update the block's nfree and first counters. */ result = (__ptr_t) next; next->prev->next = next->next; if (next->next != NULL) next->next->prev = next->prev; block = BLOCK (result); if (--_heapinfo[block].busy.info.frag.nfree != 0) _heapinfo[block].busy.info.frag.first = (unsigned long int) ((unsigned long int) ((char *) next->next - (char *) NULL) % BLOCKSIZE) >> log; /* Update the statistics. */ ++_chunks_used; _bytes_used += 1 << log; --_chunks_free; _bytes_free -= 1 << log; } else { /* No free fragments of the desired size, so get a new block and break it into fragments, returning the first. */ result = malloc (BLOCKSIZE); if (result == NULL) return NULL; /* Link all fragments but the first into the free list. */ for (i = 1; i < (__malloc_size_t) (BLOCKSIZE >> log); ++i) { next = (struct list *) ((char *) result + (i << log)); next->next = _fraghead[log].next; next->prev = &_fraghead[log]; next->prev->next = next; if (next->next != NULL) next->next->prev = next; } /* Initialize the nfree and first counters for this block. */ block = BLOCK (result); _heapinfo[block].busy.type = log; _heapinfo[block].busy.info.frag.nfree = i - 1; _heapinfo[block].busy.info.frag.first = i - 1; _chunks_free += (BLOCKSIZE >> log) - 1; _bytes_free += BLOCKSIZE - (1 << log); _bytes_used -= BLOCKSIZE - (1 << log); } } else { /* Large allocation to receive one or more blocks. Search the free list in a circle starting at the last place visited. If we loop completely around without finding a large enough space we will have to get more memory from the system. */ blocks = BLOCKIFY (size); start = block = _heapindex; while (_heapinfo[block].free.size < blocks) { block = _heapinfo[block].free.next; if (block == start) { /* Need to get more from the system. Get a little extra. */ __malloc_size_t wantblocks = blocks + __malloc_extra_blocks; block = _heapinfo[0].free.prev; lastblocks = _heapinfo[block].free.size; /* Check to see if the new core will be contiguous with the final free block; if so we don't need to get as much. */ if (_heaplimit != 0 && block + lastblocks == _heaplimit && /* Try to get the extra space we want, contiguously. */ get_contiguous_space ((wantblocks - lastblocks) * BLOCKSIZE, ADDRESS (block + lastblocks))) { /* We got it contiguously. */ /* Which block we are extending (the `final free block' referred to above) might have changed, if it got combined with a freed info table. */ block = _heapinfo[0].free.prev; _heapinfo[block].free.size += (wantblocks - lastblocks); _bytes_free += (wantblocks - lastblocks) * BLOCKSIZE; continue; } result = morecore (wantblocks * BLOCKSIZE); if (result == NULL) return NULL; block = BLOCK (result); /* Put the new block at the end of the free list. */ _heapinfo[block].free.size = wantblocks; _heapinfo[block].free.prev = _heapinfo[0].free.prev; _heapinfo[block].free.next = 0; _heapinfo[0].free.prev = block; _heapinfo[_heapinfo[block].free.prev].free.next = block; ++_chunks_free; /* Now loop to use some of that block for this allocation. */ } } /* At this point we have found a suitable free list entry. Figure out how to remove what we need from the list. */ result = ADDRESS (block); if (_heapinfo[block].free.size > blocks) { /* The block we found has a bit left over, so relink the tail end back into the free list. */ _heapinfo[block + blocks].free.size = _heapinfo[block].free.size - blocks; _heapinfo[block + blocks].free.next = _heapinfo[block].free.next; _heapinfo[block + blocks].free.prev = _heapinfo[block].free.prev; _heapinfo[_heapinfo[block].free.prev].free.next = _heapinfo[_heapinfo[block].free.next].free.prev = _heapindex = block + blocks; } else { /* The block exactly matches our requirements, so just remove it from the list. */ _heapinfo[_heapinfo[block].free.next].free.prev = _heapinfo[block].free.prev; _heapinfo[_heapinfo[block].free.prev].free.next = _heapindex = _heapinfo[block].free.next; --_chunks_free; } _heapinfo[block].busy.type = 0; _heapinfo[block].busy.info.size = blocks; ++_chunks_used; _bytes_used += blocks * BLOCKSIZE; _bytes_free -= blocks * BLOCKSIZE; /* Mark all the blocks of the object just allocated except for the first with a negative number so you can find the first block by adding that adjustment. */ while (--blocks > 0) _heapinfo[block + blocks].busy.info.size = -blocks; } return result; } __ptr_t malloc (size) __malloc_size_t size; { return (__malloc_hook != NULL ? *__malloc_hook : _malloc_internal) (size); } #ifndef _LIBC /* On some ANSI C systems, some libc functions call _malloc, _free and _realloc. Make them use the GNU functions. */ __ptr_t _malloc (size) __malloc_size_t size; { return malloc (size); } void _free (ptr) __ptr_t ptr; { free (ptr); } __ptr_t _realloc (ptr, size) __ptr_t ptr; __malloc_size_t size; { return realloc (ptr, size); } #endif /* Free a block of memory allocated by `malloc'. Copyright 1990, 1991, 1992, 1994, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif /* Cope with systems lacking `memmove'. */ #ifndef memmove #if (defined (MEMMOVE_MISSING) || \ !defined(_LIBC) && !defined(STDC_HEADERS) && !defined(USG)) #ifdef emacs #undef __malloc_safe_bcopy #define __malloc_safe_bcopy safe_bcopy #endif /* This function is defined in realloc.c. */ extern void __malloc_safe_bcopy __P ((__ptr_t, __ptr_t, __malloc_size_t)); #define memmove(to, from, size) __malloc_safe_bcopy ((from), (to), (size)) #endif #endif /* Debugging hook for free. */ void (*__free_hook) __P ((__ptr_t __ptr)); /* List of blocks allocated by memalign. */ struct alignlist *_aligned_blocks = NULL; /* Return memory to the heap. Like `free' but don't call a __free_hook if there is one. */ void _free_internal (ptr) __ptr_t ptr; { int type; __malloc_size_t block, blocks; register __malloc_size_t i; struct list *prev, *next; __ptr_t curbrk; const __malloc_size_t lesscore_threshold /* Threshold of free space at which we will return some to the system. */ = FINAL_FREE_BLOCKS + 2 * __malloc_extra_blocks; block = BLOCK (ptr); type = _heapinfo[block].busy.type; switch (type) { case 0: /* Get as many statistics as early as we can. */ --_chunks_used; _bytes_used -= _heapinfo[block].busy.info.size * BLOCKSIZE; _bytes_free += _heapinfo[block].busy.info.size * BLOCKSIZE; /* Find the free cluster previous to this one in the free list. Start searching at the last block referenced; this may benefit programs with locality of allocation. */ i = _heapindex; if (i > block) while (i > block) i = _heapinfo[i].free.prev; else { do i = _heapinfo[i].free.next; while (i > 0 && i < block); i = _heapinfo[i].free.prev; } /* Determine how to link this block into the free list. */ if (block == i + _heapinfo[i].free.size) { /* Coalesce this block with its predecessor. */ _heapinfo[i].free.size += _heapinfo[block].busy.info.size; block = i; } else { /* Really link this block back into the free list. */ _heapinfo[block].free.size = _heapinfo[block].busy.info.size; _heapinfo[block].free.next = _heapinfo[i].free.next; _heapinfo[block].free.prev = i; _heapinfo[i].free.next = block; _heapinfo[_heapinfo[block].free.next].free.prev = block; ++_chunks_free; } /* Now that the block is linked in, see if we can coalesce it with its successor (by deleting its successor from the list and adding in its size). */ if (block + _heapinfo[block].free.size == _heapinfo[block].free.next) { _heapinfo[block].free.size += _heapinfo[_heapinfo[block].free.next].free.size; _heapinfo[block].free.next = _heapinfo[_heapinfo[block].free.next].free.next; _heapinfo[_heapinfo[block].free.next].free.prev = block; --_chunks_free; } /* How many trailing free blocks are there now? */ blocks = _heapinfo[block].free.size; /* Where is the current end of accessible core? */ curbrk = (*__morecore) (0); if (_heaplimit != 0 && curbrk == ADDRESS (_heaplimit)) { /* The end of the malloc heap is at the end of accessible core. It's possible that moving _heapinfo will allow us to return some space to the system. */ __malloc_size_t info_block = BLOCK (_heapinfo); __malloc_size_t info_blocks = _heapinfo[info_block].busy.info.size; __malloc_size_t prev_block = _heapinfo[block].free.prev; __malloc_size_t prev_blocks = _heapinfo[prev_block].free.size; __malloc_size_t next_block = _heapinfo[block].free.next; __malloc_size_t next_blocks = _heapinfo[next_block].free.size; if (/* Win if this block being freed is last in core, the info table is just before it, the previous free block is just before the info table, and the two free blocks together form a useful amount to return to the system. */ (block + blocks == _heaplimit && info_block + info_blocks == block && prev_block != 0 && prev_block + prev_blocks == info_block && blocks + prev_blocks >= lesscore_threshold) || /* Nope, not the case. We can also win if this block being freed is just before the info table, and the table extends to the end of core or is followed only by a free block, and the total free space is worth returning to the system. */ (block + blocks == info_block && ((info_block + info_blocks == _heaplimit && blocks >= lesscore_threshold) || (info_block + info_blocks == next_block && next_block + next_blocks == _heaplimit && blocks + next_blocks >= lesscore_threshold))) ) { malloc_info *newinfo; __malloc_size_t oldlimit = _heaplimit; /* Free the old info table, clearing _heaplimit to avoid recursion into this code. We don't want to return the table's blocks to the system before we have copied them to the new location. */ _heaplimit = 0; _free_internal (_heapinfo); _heaplimit = oldlimit; /* Tell malloc to search from the beginning of the heap for free blocks, so it doesn't reuse the ones just freed. */ _heapindex = 0; /* Allocate new space for the info table and move its data. */ newinfo = (malloc_info *) _malloc_internal (info_blocks * BLOCKSIZE); memmove (newinfo, _heapinfo, info_blocks * BLOCKSIZE); _heapinfo = newinfo; /* We should now have coalesced the free block with the blocks freed from the old info table. Examine the entire trailing free block to decide below whether to return some to the system. */ block = _heapinfo[0].free.prev; blocks = _heapinfo[block].free.size; } /* Now see if we can return stuff to the system. */ if (block + blocks == _heaplimit && blocks >= lesscore_threshold) { register __malloc_size_t bytes = blocks * BLOCKSIZE; _heaplimit -= blocks; (*__morecore) (-bytes); _heapinfo[_heapinfo[block].free.prev].free.next = _heapinfo[block].free.next; _heapinfo[_heapinfo[block].free.next].free.prev = _heapinfo[block].free.prev; block = _heapinfo[block].free.prev; --_chunks_free; _bytes_free -= bytes; } } /* Set the next search to begin at this block. */ _heapindex = block; break; default: /* Do some of the statistics. */ --_chunks_used; _bytes_used -= 1 << type; ++_chunks_free; _bytes_free += 1 << type; /* Get the address of the first free fragment in this block. */ prev = (struct list *) ((char *) ADDRESS (block) + (_heapinfo[block].busy.info.frag.first << type)); if (_heapinfo[block].busy.info.frag.nfree == (BLOCKSIZE >> type) - 1) { /* If all fragments of this block are free, remove them from the fragment list and free the whole block. */ next = prev; for (i = 1; i < (__malloc_size_t) (BLOCKSIZE >> type); ++i) next = next->next; prev->prev->next = next; if (next != NULL) next->prev = prev->prev; _heapinfo[block].busy.type = 0; _heapinfo[block].busy.info.size = 1; /* Keep the statistics accurate. */ ++_chunks_used; _bytes_used += BLOCKSIZE; _chunks_free -= BLOCKSIZE >> type; _bytes_free -= BLOCKSIZE; free (ADDRESS (block)); } else if (_heapinfo[block].busy.info.frag.nfree != 0) { /* If some fragments of this block are free, link this fragment into the fragment list after the first free fragment of this block. */ next = (struct list *) ptr; next->next = prev->next; next->prev = prev; prev->next = next; if (next->next != NULL) next->next->prev = next; ++_heapinfo[block].busy.info.frag.nfree; } else { /* No fragments of this block are free, so link this fragment into the fragment list and announce that it is the first free fragment of this block. */ prev = (struct list *) ptr; _heapinfo[block].busy.info.frag.nfree = 1; _heapinfo[block].busy.info.frag.first = (unsigned long int) ((unsigned long int) ((char *) ptr - (char *) NULL) % BLOCKSIZE >> type); prev->next = _fraghead[type].next; prev->prev = &_fraghead[type]; prev->prev->next = prev; if (prev->next != NULL) prev->next->prev = prev; } break; } } /* Return memory to the heap. */ void free (ptr) __ptr_t ptr; { register struct alignlist *l; if (ptr == NULL) return; for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == ptr) { l->aligned = NULL; /* Mark the slot in the list as free. */ ptr = l->exact; break; } if (__free_hook != NULL) (*__free_hook) (ptr); else _free_internal (ptr); } /* Define the `cfree' alias for `free'. */ #ifdef weak_alias weak_alias (free, cfree) #else void cfree (ptr) __ptr_t ptr; { free (ptr); } #endif /* Change the size of a block allocated by `malloc'. Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif /* Cope with systems lacking `memmove'. */ #if (defined (MEMMOVE_MISSING) || \ !defined(_LIBC) && !defined(STDC_HEADERS) && !defined(USG)) #ifdef emacs #undef __malloc_safe_bcopy #define __malloc_safe_bcopy safe_bcopy #else /* Snarfed directly from Emacs src/dispnew.c: XXX Should use system bcopy if it handles overlap. */ /* Like bcopy except never gets confused by overlap. */ void __malloc_safe_bcopy (afrom, ato, size) __ptr_t afrom; __ptr_t ato; __malloc_size_t size; { char *from = afrom, *to = ato; if (size <= 0 || from == to) return; /* If the source and destination don't overlap, then bcopy can handle it. If they do overlap, but the destination is lower in memory than the source, we'll assume bcopy can handle that. */ if (to < from || from + size <= to) bcopy (from, to, size); /* Otherwise, we'll copy from the end. */ else { register char *endf = from + size; register char *endt = to + size; /* If TO - FROM is large, then we should break the copy into nonoverlapping chunks of TO - FROM bytes each. However, if TO - FROM is small, then the bcopy function call overhead makes this not worth it. The crossover point could be about anywhere. Since I don't think the obvious copy loop is too bad, I'm trying to err in its favor. */ if (to - from < 64) { do *--endt = *--endf; while (endf != from); } else { for (;;) { endt -= (to - from); endf -= (to - from); if (endt < to) break; bcopy (endf, endt, to - from); } /* If SIZE wasn't a multiple of TO - FROM, there will be a little left over. The amount left over is (endt + (to - from)) - to, which is endt - from. */ bcopy (from, to, endt - from); } } } #endif /* emacs */ #ifndef memmove extern void __malloc_safe_bcopy __P ((__ptr_t, __ptr_t, __malloc_size_t)); #define memmove(to, from, size) __malloc_safe_bcopy ((from), (to), (size)) #endif #endif #define min(A, B) ((A) < (B) ? (A) : (B)) /* Debugging hook for realloc. */ __ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, __malloc_size_t __size)); /* Resize the given region to the new size, returning a pointer to the (possibly moved) region. This is optimized for speed; some benchmarks seem to indicate that greater compactness is achieved by unconditionally allocating and copying to a new region. This module has incestuous knowledge of the internals of both free and malloc. */ __ptr_t _realloc_internal (ptr, size) __ptr_t ptr; __malloc_size_t size; { __ptr_t result; int type; __malloc_size_t block, blocks, oldlimit; if (size == 0) { _free_internal (ptr); return _malloc_internal (0); } else if (ptr == NULL) return _malloc_internal (size); block = BLOCK (ptr); type = _heapinfo[block].busy.type; switch (type) { case 0: /* Maybe reallocate a large block to a small fragment. */ if (size <= BLOCKSIZE / 2) { result = _malloc_internal (size); if (result != NULL) { memcpy (result, ptr, size); _free_internal (ptr); return result; } } /* The new size is a large allocation as well; see if we can hold it in place. */ blocks = BLOCKIFY (size); if (blocks < _heapinfo[block].busy.info.size) { /* The new size is smaller; return excess memory to the free list. */ _heapinfo[block + blocks].busy.type = 0; _heapinfo[block + blocks].busy.info.size = _heapinfo[block].busy.info.size - blocks; _heapinfo[block].busy.info.size = blocks; /* We have just created a new chunk by splitting a chunk in two. Now we will free this chunk; increment the statistics counter so it doesn't become wrong when _free_internal decrements it. */ ++_chunks_used; _free_internal (ADDRESS (block + blocks)); result = ptr; } else if (blocks == _heapinfo[block].busy.info.size) /* No size change necessary. */ result = ptr; else { /* Won't fit, so allocate a new region that will. Free the old region first in case there is sufficient adjacent free space to grow without moving. */ blocks = _heapinfo[block].busy.info.size; /* Prevent free from actually returning memory to the system. */ oldlimit = _heaplimit; _heaplimit = 0; _free_internal (ptr); _heaplimit = oldlimit; result = _malloc_internal (size); if (result == NULL) { /* Now we're really in trouble. We have to unfree the thing we just freed. Unfortunately it might have been coalesced with its neighbors. */ if (_heapindex == block) (void) _malloc_internal (blocks * BLOCKSIZE); else { __ptr_t previous = _malloc_internal ((block - _heapindex) * BLOCKSIZE); (void) _malloc_internal (blocks * BLOCKSIZE); _free_internal (previous); } return NULL; } if (ptr != result) memmove (result, ptr, blocks * BLOCKSIZE); } break; default: /* Old size is a fragment; type is logarithm to base two of the fragment size. */ if (size > (__malloc_size_t) (1 << (type - 1)) && size <= (__malloc_size_t) (1 << type)) /* The new size is the same kind of fragment. */ result = ptr; else { /* The new size is different; allocate a new space, and copy the lesser of the new size and the old. */ result = _malloc_internal (size); if (result == NULL) return NULL; memcpy (result, ptr, min (size, (__malloc_size_t) 1 << type)); _free_internal (ptr); } break; } return result; } __ptr_t realloc (ptr, size) __ptr_t ptr; __malloc_size_t size; { return (__realloc_hook != NULL ? *__realloc_hook : _realloc_internal) (ptr, size); } /* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif /* Allocate an array of NMEMB elements each SIZE bytes long. The entire array is initialized to zeros. */ __ptr_t calloc (nmemb, size) register __malloc_size_t nmemb; register __malloc_size_t size; { register __ptr_t result = malloc (nmemb * size); if (result != NULL) (void) memset (result, 0, nmemb * size); return result; } /* Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. This file is part of the GNU C Library. The GNU C Library 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. The GNU C Library 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 the GNU C Library; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif #ifndef __GNU_LIBRARY__ #define __sbrk sbrk #endif #ifdef __GNU_LIBRARY__ /* It is best not to declare this and cast its result on foreign operating systems with potentially hostile include files. */ extern __ptr_t __sbrk __P ((int increment)); #endif #ifndef NULL #define NULL 0 #endif /* Allocate INCREMENT more bytes of data space, and return the start of data space, or NULL on errors. If INCREMENT is negative, shrink data space. */ __ptr_t __default_morecore (increment) __malloc_ptrdiff_t increment; { __ptr_t result = (__ptr_t) __sbrk (increment); if (result == (__ptr_t) -1) return NULL; return result; } /* Get SIZE bytes, if we can get them starting at END. Return the address of the space we got. If we cannot get space at END, fail and return -1. */ static __ptr_t get_contiguous_space (size, position) __malloc_ptrdiff_t size; __ptr_t position; { __ptr_t before; __ptr_t after; before = (*morecore) (0); /* If we can tell in advance that the break is at the wrong place, fail now. */ if (before != position) return (__ptr_t) (-1); /* Allocate SIZE bytes and get the address of them. */ after = (*morecore) (size); if (after == (__ptr_t) -1) return (__ptr_t) (-1); /* It was not contiguous--reject it. */ if (after != position) { morecore (- size); return (__ptr_t) (-1); } return after; } /* Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif __ptr_t (*__memalign_hook) __P ((size_t __size, size_t __alignment)); __ptr_t memalign (alignment, size) __malloc_size_t alignment; __malloc_size_t size; { __ptr_t result; unsigned long int adj; if (__memalign_hook) return (*__memalign_hook) (alignment, size); size = ((size + alignment - 1) / alignment) * alignment; result = malloc (size); if (result == NULL) return NULL; adj = (unsigned long int) ((unsigned long int) ((char *) result - (char *) NULL)) % alignment; if (adj != 0) { struct alignlist *l; for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == NULL) /* This slot is free. Use it. */ break; if (l == NULL) { l = (struct alignlist *) malloc (sizeof (struct alignlist)); if (l == NULL) { free (result); return NULL; } l->next = _aligned_blocks; _aligned_blocks = l; } l->exact = result; result = l->aligned = (char *) result + alignment - adj; } return result; } emacs-19.30/src/gmalloc2.c100666 12120 1 135526 6054447350 13624 0ustar rmsdaemon/* DO NOT EDIT THIS FILE -- it is automagically generated. -*- C -*- */ #define _MALLOC_INTERNAL /* The malloc headers and source files from the C library follow here. */ /* Declarations for `malloc' and friends. Copyright 1990, 1991, 1992, 1993, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_H #define _MALLOC_H 1 #ifdef _MALLOC_INTERNAL #ifdef HAVE_CONFIG_H #include #endif #if defined(_LIBC) || defined(STDC_HEADERS) || defined(USG) #include #else #ifndef memset #define memset(s, zero, n) bzero ((s), (n)) #endif #ifndef memcpy #define memcpy(d, s, n) bcopy ((s), (d), (n)) #endif #endif #if defined (__GNU_LIBRARY__) || (defined (__STDC__) && __STDC__) #include #else #ifndef CHAR_BIT #define CHAR_BIT 8 #endif #endif #ifdef HAVE_UNISTD_H #include #endif #endif /* _MALLOC_INTERNAL. */ #ifdef __cplusplus extern "C" { #endif #if defined (__cplusplus) || (defined (__STDC__) && __STDC__) #undef __P #define __P(args) args #undef __ptr_t #define __ptr_t void * #else /* Not C++ or ANSI C. */ #undef __P #define __P(args) () #undef const #define const #undef __ptr_t #define __ptr_t char * #endif /* C++ or ANSI C. */ #if defined (__STDC__) && __STDC__ #include #define __malloc_size_t size_t #define __malloc_ptrdiff_t ptrdiff_t #else #define __malloc_size_t unsigned int #define __malloc_ptrdiff_t int #endif #ifndef NULL #define NULL 0 #endif /* Allocate SIZE bytes of memory. */ extern __ptr_t malloc __P ((__malloc_size_t __size)); /* Re-allocate the previously allocated block in __ptr_t, making the new block SIZE bytes long. */ extern __ptr_t realloc __P ((__ptr_t __ptr, __malloc_size_t __size)); /* Allocate NMEMB elements of SIZE bytes each, all initialized to 0. */ extern __ptr_t calloc __P ((__malloc_size_t __nmemb, __malloc_size_t __size)); /* Free a block allocated by `malloc', `realloc' or `calloc'. */ extern void free __P ((__ptr_t __ptr)); /* Allocate SIZE bytes allocated to ALIGNMENT bytes. */ extern __ptr_t memalign __P ((__malloc_size_t __alignment, __malloc_size_t __size)); /* Allocate SIZE bytes on a page boundary. */ #if ! (defined (_MALLOC_INTERNAL) && defined (emacs)) /* Avoid conflict. */ extern __ptr_t valloc __P ((__malloc_size_t __size)); #endif #ifdef _MALLOC_INTERNAL /* The allocator divides the heap into blocks of fixed size; large requests receive one or more whole blocks, and small requests receive a fragment of a block. Fragment sizes are powers of two, and all fragments of a block are the same size. When all the fragments in a block have been freed, the block itself is freed. */ #define INT_BIT (CHAR_BIT * sizeof(int)) #define BLOCKLOG (INT_BIT > 16 ? 12 : 9) #define BLOCKSIZE (1 << BLOCKLOG) #define BLOCKIFY(SIZE) (((SIZE) + BLOCKSIZE - 1) / BLOCKSIZE) /* Determine the amount of memory spanned by the initial heap table (not an absolute limit). */ #define HEAP (INT_BIT > 16 ? 4194304 : 65536) /* Number of contiguous free blocks allowed to build up at the end of memory before they will be returned to the system. */ #define FINAL_FREE_BLOCKS 8 /* Data structure giving per-block information. */ typedef union { /* Heap information for a busy block. */ struct { /* Zero for a large (multiblock) object, or positive giving the logarithm to the base two of the fragment size. */ int type; union { struct { __malloc_size_t nfree; /* Free frags in a fragmented block. */ __malloc_size_t first; /* First free fragment of the block. */ } frag; /* For a large object, in its first block, this has the number of blocks in the object. In the other blocks, this has a negative number which says how far back the first block is. */ __malloc_ptrdiff_t size; } info; } busy; /* Heap information for a free block (that may be the first of a free cluster). */ struct { __malloc_size_t size; /* Size (in blocks) of a free cluster. */ __malloc_size_t next; /* Index of next free cluster. */ __malloc_size_t prev; /* Index of previous free cluster. */ } free; } malloc_info; /* Pointer to first block of the heap. */ extern char *_heapbase; /* Table indexed by block number giving per-block information. */ extern malloc_info *_heapinfo; /* Address to block number and vice versa. */ #define BLOCK(A) (((char *) (A) - _heapbase) / BLOCKSIZE + 1) #define ADDRESS(B) ((__ptr_t) (((B) - 1) * BLOCKSIZE + _heapbase)) /* Current search index for the heap table. */ extern __malloc_size_t _heapindex; /* Limit of valid info table indices. */ extern __malloc_size_t _heaplimit; /* Doubly linked lists of free fragments. */ struct list { struct list *next; struct list *prev; }; /* Free list headers for each fragment size. */ extern struct list _fraghead[]; /* List of blocks allocated with `memalign' (or `valloc'). */ struct alignlist { struct alignlist *next; __ptr_t aligned; /* The address that memaligned returned. */ __ptr_t exact; /* The address that malloc returned. */ }; extern struct alignlist *_aligned_blocks; /* Instrumentation. */ extern __malloc_size_t _chunks_used; extern __malloc_size_t _bytes_used; extern __malloc_size_t _chunks_free; extern __malloc_size_t _bytes_free; /* Internal versions of `malloc', `realloc', and `free' used when these functions need to call each other. They are the same but don't call the hooks. */ extern __ptr_t _malloc_internal __P ((__malloc_size_t __size)); extern __ptr_t _realloc_internal __P ((__ptr_t __ptr, __malloc_size_t __size)); extern void _free_internal __P ((__ptr_t __ptr)); #endif /* _MALLOC_INTERNAL. */ /* Given an address in the middle of a malloc'd object, return the address of the beginning of the object. */ extern __ptr_t malloc_find_object_address __P ((__ptr_t __ptr)); /* Underlying allocation function; successive calls should return contiguous pieces of memory. */ extern __ptr_t (*__morecore) __P ((__malloc_ptrdiff_t __size)); /* Default value of `__morecore'. */ extern __ptr_t __default_morecore __P ((__malloc_ptrdiff_t __size)); /* If not NULL, this function is called after each time `__morecore' is called to increase the data size. */ extern void (*__after_morecore_hook) __P ((void)); /* Number of extra blocks to get each time we ask for more core. This reduces the frequency of calling `(*__morecore)'. */ extern __malloc_size_t __malloc_extra_blocks; /* Nonzero if `malloc' has been called and done its initialization. */ extern int __malloc_initialized; /* Hooks for debugging versions. */ extern void (*__malloc_initialize_hook) __P ((void)); extern void (*__free_hook) __P ((__ptr_t __ptr)); extern __ptr_t (*__malloc_hook) __P ((__malloc_size_t __size)); extern __ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, __malloc_size_t __size)); extern __ptr_t (*__memalign_hook) __P ((__malloc_size_t __size, __malloc_size_t __alignment)); /* Return values for `mprobe': these are the kinds of inconsistencies that `mcheck' enables detection of. */ enum mcheck_status { MCHECK_DISABLED = -1, /* Consistency checking is not turned on. */ MCHECK_OK, /* Block is fine. */ MCHECK_FREE, /* Block freed twice. */ MCHECK_HEAD, /* Memory before the block was clobbered. */ MCHECK_TAIL /* Memory after the block was clobbered. */ }; /* Activate a standard collection of debugging hooks. This must be called before `malloc' is ever called. ABORTFUNC is called with an error code (see enum above) when an inconsistency is detected. If ABORTFUNC is null, the standard function prints on stderr and then calls `abort'. */ extern int mcheck __P ((void (*__abortfunc) __P ((enum mcheck_status)))); /* Check for aberrations in a particular malloc'd block. You must have called `mcheck' already. These are the same checks that `mcheck' does when you free or reallocate a block. */ extern enum mcheck_status mprobe __P ((__ptr_t __ptr)); /* Activate a standard collection of tracing hooks. */ extern void mtrace __P ((void)); extern void muntrace __P ((void)); /* Statistics available to the user. */ struct mstats { __malloc_size_t bytes_total; /* Total size of the heap. */ __malloc_size_t chunks_used; /* Chunks allocated by the user. */ __malloc_size_t bytes_used; /* Byte total of user-allocated chunks. */ __malloc_size_t chunks_free; /* Chunks in the free list. */ __malloc_size_t bytes_free; /* Byte total of chunks in the free list. */ }; /* Pick up the current statistics. */ extern struct mstats mstats __P ((void)); /* Call WARNFUN with a warning message when memory usage is high. */ extern void memory_warnings __P ((__ptr_t __start, void (*__warnfun) __P ((const char *)))); /* Relocating allocator. */ /* Allocate SIZE bytes, and store the address in *HANDLEPTR. */ extern __ptr_t r_alloc __P ((__ptr_t *__handleptr, __malloc_size_t __size)); /* Free the storage allocated in HANDLEPTR. */ extern void r_alloc_free __P ((__ptr_t *__handleptr)); /* Adjust the block at HANDLEPTR to be SIZE bytes long. */ extern __ptr_t r_re_alloc __P ((__ptr_t *__handleptr, __malloc_size_t __size)); #ifdef __cplusplus } #endif #endif /* malloc.h */ /* Memory allocator `malloc'. Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif #include /* How to really get more memory. */ __ptr_t (*__morecore) __P ((ptrdiff_t __size)) = __default_morecore; /* Debugging hook for `malloc'. */ __ptr_t (*__malloc_hook) __P ((__malloc_size_t __size)); /* Pointer to the base of the first block. */ char *_heapbase; /* Block information table. Allocated with align/__free (not malloc/free). */ malloc_info *_heapinfo; /* Number of info entries. */ static __malloc_size_t heapsize; /* Search index in the info table. */ __malloc_size_t _heapindex; /* Limit of valid info table indices. */ __malloc_size_t _heaplimit; /* Free lists for each fragment size. */ struct list _fraghead[BLOCKLOG]; /* Instrumentation. */ __malloc_size_t _chunks_used; __malloc_size_t _bytes_used; __malloc_size_t _chunks_free; __malloc_size_t _bytes_free; /* Are you experienced? */ int __malloc_initialized; __malloc_size_t __malloc_extra_blocks; void (*__malloc_initialize_hook) __P ((void)); void (*__after_morecore_hook) __P ((void)); /* Aligned allocation. */ static __ptr_t align __P ((__malloc_size_t)); static __ptr_t align (size) __malloc_size_t size; { __ptr_t result; unsigned long int adj; result = (*__morecore) (size); adj = (unsigned long int) ((unsigned long int) ((char *) result - (char *) NULL)) % BLOCKSIZE; if (adj != 0) { __ptr_t new; adj = BLOCKSIZE - adj; new = (*__morecore) (adj); if (new != result + size) abort (); result = (char *) result + adj; } if (__after_morecore_hook) (*__after_morecore_hook) (); return result; } /* Get SIZE bytes, if we can get them starting at END. Return the address of the space we got. If we cannot get space at END, fail and return -1. */ static __ptr_t get_contiguous_space __P ((__malloc_ptrdiff_t, __ptr_t)); static __ptr_t get_contiguous_space (size, position) __malloc_ptrdiff_t size; __ptr_t position; { __ptr_t before; __ptr_t after; before = (*__morecore) (0); /* If we can tell in advance that the break is at the wrong place, fail now. */ if (before != position) return 0; /* Allocate SIZE bytes and get the address of them. */ after = (*__morecore) (size); if (!after) return 0; /* It was not contiguous--reject it. */ if (after != position) { (*__morecore) (- size); return 0; } return after; } /* This is called when `_heapinfo' and `heapsize' have just been set to describe a new info table. Set up the table to describe itself and account for it in the statistics. */ static void register_heapinfo __P ((void)); #ifdef __GNUC__ __inline__ #endif static void register_heapinfo () { __malloc_size_t block, blocks; block = BLOCK (_heapinfo); blocks = BLOCKIFY (heapsize * sizeof (malloc_info)); /* Account for the _heapinfo block itself in the statistics. */ _bytes_used += blocks * BLOCKSIZE; ++_chunks_used; /* Describe the heapinfo block itself in the heapinfo. */ _heapinfo[block].busy.type = 0; _heapinfo[block].busy.info.size = blocks; /* Leave back-pointers for malloc_find_address. */ while (--blocks > 0) _heapinfo[block + blocks].busy.info.size = -blocks; } /* Set everything up and remember that we have. */ static int initialize __P ((void)); static int initialize () { if (__malloc_initialize_hook) (*__malloc_initialize_hook) (); heapsize = HEAP / BLOCKSIZE; _heapinfo = (malloc_info *) align (heapsize * sizeof (malloc_info)); if (_heapinfo == NULL) return 0; memset (_heapinfo, 0, heapsize * sizeof (malloc_info)); _heapinfo[0].free.size = 0; _heapinfo[0].free.next = _heapinfo[0].free.prev = 0; _heapindex = 0; _heapbase = (char *) _heapinfo; _heaplimit = BLOCK (_heapbase + heapsize * sizeof (malloc_info)); register_heapinfo (); __malloc_initialized = 1; return 1; } static int morecore_recursing; /* Get neatly aligned memory, initializing or growing the heap info table as necessary. */ static __ptr_t morecore __P ((__malloc_size_t)); static __ptr_t morecore (size) __malloc_size_t size; { __ptr_t result; malloc_info *newinfo, *oldinfo; __malloc_size_t newsize; if (morecore_recursing) /* Avoid recursion. The caller will know how to handle a null return. */ return NULL; result = align (size); if (result == NULL) return NULL; /* Check if we need to grow the info table. */ if ((__malloc_size_t) BLOCK ((char *) result + size) > heapsize) { /* Calculate the new _heapinfo table size. We do not account for the added blocks in the table itself, as we hope to place them in existing free space, which is already covered by part of the existing table. */ newsize = heapsize; do newsize *= 2; while ((__malloc_size_t) BLOCK ((char *) result + size) > newsize); /* First try to allocate the new info table in core we already have, in the usual way using realloc. If realloc cannot extend it in place or relocate it to existing sufficient core, we will get called again, and the code above will notice the `morecore_recursing' flag and return null. */ { int save = errno; /* Don't want to clobber errno with ENOMEM. */ morecore_recursing = 1; newinfo = (malloc_info *) _realloc_internal (_heapinfo, newsize * sizeof (malloc_info)); morecore_recursing = 0; if (newinfo == NULL) errno = save; else { /* We found some space in core, and realloc has put the old table's blocks on the free list. Now zero the new part of the table and install the new table location. */ memset (&newinfo[heapsize], 0, (newsize - heapsize) * sizeof (malloc_info)); _heapinfo = newinfo; heapsize = newsize; goto got_heap; } } /* Allocate new space for the malloc info table. */ while (1) { newinfo = (malloc_info *) align (newsize * sizeof (malloc_info)); /* Did it fail? */ if (newinfo == NULL) { (*__morecore) (-size); return NULL; } /* Is it big enough to record status for its own space? If so, we win. */ if ((__malloc_size_t) BLOCK ((char *) newinfo + newsize * sizeof (malloc_info)) < newsize) break; /* Must try again. First give back most of what we just got. */ (*__morecore) (- newsize * sizeof (malloc_info)); newsize *= 2; } /* Copy the old table to the beginning of the new, and zero the rest of the new table. */ memcpy (newinfo, _heapinfo, heapsize * sizeof (malloc_info)); memset (&newinfo[heapsize], 0, (newsize - heapsize) * sizeof (malloc_info)); oldinfo = _heapinfo; _heapinfo = newinfo; heapsize = newsize; register_heapinfo (); /* Reset _heaplimit so _free_internal never decides it can relocate or resize the info table. */ _heaplimit = 0; _free_internal (oldinfo); /* The new heap limit includes the new table just allocated. */ _heaplimit = BLOCK ((char *) newinfo + heapsize * sizeof (malloc_info)); return result; } got_heap: _heaplimit = BLOCK ((char *) result + size); return result; } /* Allocate memory from the heap. */ __ptr_t _malloc_internal (size) __malloc_size_t size; { __ptr_t result; __malloc_size_t block, blocks, lastblocks, start; register __malloc_size_t i; struct list *next; /* ANSI C allows `malloc (0)' to either return NULL, or to return a valid address you can realloc and free (though not dereference). It turns out that some extant code (sunrpc, at least Ultrix's version) expects `malloc (0)' to return non-NULL and breaks otherwise. Be compatible. */ #if 0 if (size == 0) return NULL; #endif if (!__malloc_initialized) if (!initialize ()) return NULL; if (size < sizeof (struct list)) size = sizeof (struct list); #ifdef SUNOS_LOCALTIME_BUG if (size < 16) size = 16; #endif /* Determine the allocation policy based on the request size. */ if (size <= BLOCKSIZE / 2) { /* Small allocation to receive a fragment of a block. Determine the logarithm to base two of the fragment size. */ register __malloc_size_t log = 1; --size; while ((size /= 2) != 0) ++log; /* Look in the fragment lists for a free fragment of the desired size. */ next = _fraghead[log].next; if (next != NULL) { /* There are free fragments of this size. Pop a fragment out of the fragment list and return it. Update the block's nfree and first counters. */ result = (__ptr_t) next; next->prev->next = next->next; if (next->next != NULL) next->next->prev = next->prev; block = BLOCK (result); if (--_heapinfo[block].busy.info.frag.nfree != 0) _heapinfo[block].busy.info.frag.first = (unsigned long int) ((unsigned long int) ((char *) next->next - (char *) NULL) % BLOCKSIZE) >> log; /* Update the statistics. */ ++_chunks_used; _bytes_used += 1 << log; --_chunks_free; _bytes_free -= 1 << log; } else { /* No free fragments of the desired size, so get a new block and break it into fragments, returning the first. */ result = malloc (BLOCKSIZE); if (result == NULL) return NULL; /* Link all fragments but the first into the free list. */ next = (struct list *) ((char *) result + (1 << log)); next->next = NULL; next->prev = &_fraghead[log]; _fraghead[log].next = next; for (i = 2; i < (__malloc_size_t) (BLOCKSIZE >> log); ++i) { next = (struct list *) ((char *) result + (i << log)); next->next = _fraghead[log].next; next->prev = &_fraghead[log]; next->prev->next = next; next->next->prev = next; } /* Initialize the nfree and first counters for this block. */ block = BLOCK (result); _heapinfo[block].busy.type = log; _heapinfo[block].busy.info.frag.nfree = i - 1; _heapinfo[block].busy.info.frag.first = i - 1; _chunks_free += (BLOCKSIZE >> log) - 1; _bytes_free += BLOCKSIZE - (1 << log); _bytes_used -= BLOCKSIZE - (1 << log); } } else { /* Large allocation to receive one or more blocks. Search the free list in a circle starting at the last place visited. If we loop completely around without finding a large enough space we will have to get more memory from the system. */ blocks = BLOCKIFY (size); start = block = _heapindex; while (_heapinfo[block].free.size < blocks) { block = _heapinfo[block].free.next; if (block == start) { /* Need to get more from the system. Get a little extra. */ __malloc_size_t wantblocks = blocks + __malloc_extra_blocks; block = _heapinfo[0].free.prev; lastblocks = _heapinfo[block].free.size; /* Check to see if the new core will be contiguous with the final free block; if so we don't need to get as much. */ if (_heaplimit != 0 && block + lastblocks == _heaplimit && get_contiguous_space ((wantblocks - lastblocks) * BLOCKSIZE, ADDRESS (block + lastblocks))) { /* We got it contiguously. Which block we are extending (the `final free block' referred to above) might have changed, if it got combined with a freed info table. */ block = _heapinfo[0].free.prev; _heapinfo[block].free.size += (wantblocks - lastblocks); _bytes_free += (wantblocks - lastblocks) * BLOCKSIZE; continue; } result = morecore (wantblocks * BLOCKSIZE); if (result == NULL) return NULL; block = BLOCK (result); /* Put the new block at the end of the free list. */ _heapinfo[block].free.size = wantblocks; _heapinfo[block].free.prev = _heapinfo[0].free.prev; _heapinfo[block].free.next = 0; _heapinfo[0].free.prev = block; _heapinfo[_heapinfo[block].free.prev].free.next = block; ++_chunks_free; /* Now loop to use some of that block for this allocation. */ } } /* At this point we have found a suitable free list entry. Figure out how to remove what we need from the list. */ result = ADDRESS (block); if (_heapinfo[block].free.size > blocks) { /* The block we found has a bit left over, so relink the tail end back into the free list. */ _heapinfo[block + blocks].free.size = _heapinfo[block].free.size - blocks; _heapinfo[block + blocks].free.next = _heapinfo[block].free.next; _heapinfo[block + blocks].free.prev = _heapinfo[block].free.prev; _heapinfo[_heapinfo[block].free.prev].free.next = _heapinfo[_heapinfo[block].free.next].free.prev = _heapindex = block + blocks; } else { /* The block exactly matches our requirements, so just remove it from the list. */ _heapinfo[_heapinfo[block].free.next].free.prev = _heapinfo[block].free.prev; _heapinfo[_heapinfo[block].free.prev].free.next = _heapindex = _heapinfo[block].free.next; --_chunks_free; } _heapinfo[block].busy.type = 0; _heapinfo[block].busy.info.size = blocks; ++_chunks_used; _bytes_used += blocks * BLOCKSIZE; _bytes_free -= blocks * BLOCKSIZE; /* Mark all the blocks of the object just allocated except for the first with a negative number so you can find the first block by adding that adjustment. */ while (--blocks > 0) _heapinfo[block + blocks].busy.info.size = -blocks; } return result; } __ptr_t malloc (size) __malloc_size_t size; { return (__malloc_hook != NULL ? *__malloc_hook : _malloc_internal) (size); } #ifndef _LIBC /* On some ANSI C systems, some libc functions call _malloc, _free and _realloc. Make them use the GNU functions. */ __ptr_t _malloc (size) __malloc_size_t size; { return malloc (size); } void _free (ptr) __ptr_t ptr; { free (ptr); } __ptr_t _realloc (ptr, size) __ptr_t ptr; __malloc_size_t size; { return realloc (ptr, size); } #endif /* Free a block of memory allocated by `malloc'. Copyright 1990, 1991, 1992, 1994, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif /* Cope with systems lacking `memmove'. */ #ifndef memmove #if (defined (MEMMOVE_MISSING) || \ !defined(_LIBC) && !defined(STDC_HEADERS) && !defined(USG)) #ifdef emacs #undef __malloc_safe_bcopy #define __malloc_safe_bcopy safe_bcopy #endif /* This function is defined in realloc.c. */ extern void __malloc_safe_bcopy __P ((__ptr_t, __ptr_t, __malloc_size_t)); #define memmove(to, from, size) __malloc_safe_bcopy ((from), (to), (size)) #endif #endif /* Debugging hook for free. */ void (*__free_hook) __P ((__ptr_t __ptr)); /* List of blocks allocated by memalign. */ struct alignlist *_aligned_blocks = NULL; /* Return memory to the heap. Like `free' but don't call a __free_hook if there is one. */ void _free_internal (ptr) __ptr_t ptr; { int type; __malloc_size_t block, blocks; register __malloc_size_t i; struct list *prev, *next; __ptr_t curbrk; const __malloc_size_t lesscore_threshold /* Threshold of free space at which we will return some to the system. */ = FINAL_FREE_BLOCKS + 2 * __malloc_extra_blocks; register struct alignlist *l; if (ptr == NULL) return; for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == ptr) { l->aligned = NULL; /* Mark the slot in the list as free. */ ptr = l->exact; break; } block = BLOCK (ptr); type = _heapinfo[block].busy.type; switch (type) { case 0: /* Get as many statistics as early as we can. */ --_chunks_used; _bytes_used -= _heapinfo[block].busy.info.size * BLOCKSIZE; _bytes_free += _heapinfo[block].busy.info.size * BLOCKSIZE; /* Find the free cluster previous to this one in the free list. Start searching at the last block referenced; this may benefit programs with locality of allocation. */ i = _heapindex; if (i > block) while (i > block) i = _heapinfo[i].free.prev; else { do i = _heapinfo[i].free.next; while (i > 0 && i < block); i = _heapinfo[i].free.prev; } /* Determine how to link this block into the free list. */ if (block == i + _heapinfo[i].free.size) { /* Coalesce this block with its predecessor. */ _heapinfo[i].free.size += _heapinfo[block].busy.info.size; block = i; } else { /* Really link this block back into the free list. */ _heapinfo[block].free.size = _heapinfo[block].busy.info.size; _heapinfo[block].free.next = _heapinfo[i].free.next; _heapinfo[block].free.prev = i; _heapinfo[i].free.next = block; _heapinfo[_heapinfo[block].free.next].free.prev = block; ++_chunks_free; } /* Now that the block is linked in, see if we can coalesce it with its successor (by deleting its successor from the list and adding in its size). */ if (block + _heapinfo[block].free.size == _heapinfo[block].free.next) { _heapinfo[block].free.size += _heapinfo[_heapinfo[block].free.next].free.size; _heapinfo[block].free.next = _heapinfo[_heapinfo[block].free.next].free.next; _heapinfo[_heapinfo[block].free.next].free.prev = block; --_chunks_free; } /* How many trailing free blocks are there now? */ blocks = _heapinfo[block].free.size; /* Where is the current end of accessible core? */ curbrk = (*__morecore) (0); if (_heaplimit != 0 && curbrk == ADDRESS (_heaplimit)) { /* The end of the malloc heap is at the end of accessible core. It's possible that moving _heapinfo will allow us to return some space to the system. */ __malloc_size_t info_block = BLOCK (_heapinfo); __malloc_size_t info_blocks = _heapinfo[info_block].busy.info.size; __malloc_size_t prev_block = _heapinfo[block].free.prev; __malloc_size_t prev_blocks = _heapinfo[prev_block].free.size; __malloc_size_t next_block = _heapinfo[block].free.next; __malloc_size_t next_blocks = _heapinfo[next_block].free.size; if (/* Win if this block being freed is last in core, the info table is just before it, the previous free block is just before the info table, and the two free blocks together form a useful amount to return to the system. */ (block + blocks == _heaplimit && info_block + info_blocks == block && prev_block != 0 && prev_block + prev_blocks == info_block && blocks + prev_blocks >= lesscore_threshold) || /* Nope, not the case. We can also win if this block being freed is just before the info table, and the table extends to the end of core or is followed only by a free block, and the total free space is worth returning to the system. */ (block + blocks == info_block && ((info_block + info_blocks == _heaplimit && blocks >= lesscore_threshold) || (info_block + info_blocks == next_block && next_block + next_blocks == _heaplimit && blocks + next_blocks >= lesscore_threshold))) ) { malloc_info *newinfo; __malloc_size_t oldlimit = _heaplimit; /* Free the old info table, clearing _heaplimit to avoid recursion into this code. We don't want to return the table's blocks to the system before we have copied them to the new location. */ _heaplimit = 0; _free_internal (_heapinfo); _heaplimit = oldlimit; /* Tell malloc to search from the beginning of the heap for free blocks, so it doesn't reuse the ones just freed. */ _heapindex = 0; /* Allocate new space for the info table and move its data. */ newinfo = (malloc_info *) _malloc_internal (info_blocks * BLOCKSIZE); memmove (newinfo, _heapinfo, info_blocks * BLOCKSIZE); _heapinfo = newinfo; /* We should now have coalesced the free block with the blocks freed from the old info table. Examine the entire trailing free block to decide below whether to return some to the system. */ block = _heapinfo[0].free.prev; blocks = _heapinfo[block].free.size; } /* Now see if we can return stuff to the system. */ if (block + blocks == _heaplimit && blocks >= lesscore_threshold) { register __malloc_size_t bytes = blocks * BLOCKSIZE; _heaplimit -= blocks; (*__morecore) (-bytes); _heapinfo[_heapinfo[block].free.prev].free.next = _heapinfo[block].free.next; _heapinfo[_heapinfo[block].free.next].free.prev = _heapinfo[block].free.prev; block = _heapinfo[block].free.prev; --_chunks_free; _bytes_free -= bytes; } } /* Set the next search to begin at this block. */ _heapindex = block; break; default: /* Do some of the statistics. */ --_chunks_used; _bytes_used -= 1 << type; ++_chunks_free; _bytes_free += 1 << type; /* Get the address of the first free fragment in this block. */ prev = (struct list *) ((char *) ADDRESS (block) + (_heapinfo[block].busy.info.frag.first << type)); if (_heapinfo[block].busy.info.frag.nfree == (BLOCKSIZE >> type) - 1) { /* If all fragments of this block are free, remove them from the fragment list and free the whole block. */ next = prev; for (i = 1; i < (__malloc_size_t) (BLOCKSIZE >> type); ++i) next = next->next; prev->prev->next = next; if (next != NULL) next->prev = prev->prev; _heapinfo[block].busy.type = 0; _heapinfo[block].busy.info.size = 1; /* Keep the statistics accurate. */ ++_chunks_used; _bytes_used += BLOCKSIZE; _chunks_free -= BLOCKSIZE >> type; _bytes_free -= BLOCKSIZE; free (ADDRESS (block)); } else if (_heapinfo[block].busy.info.frag.nfree != 0) { /* If some fragments of this block are free, link this fragment into the fragment list after the first free fragment of this block. */ next = (struct list *) ptr; next->next = prev->next; next->prev = prev; prev->next = next; if (next->next != NULL) next->next->prev = next; ++_heapinfo[block].busy.info.frag.nfree; } else { /* No fragments of this block are free, so link this fragment into the fragment list and announce that it is the first free fragment of this block. */ prev = (struct list *) ptr; _heapinfo[block].busy.info.frag.nfree = 1; _heapinfo[block].busy.info.frag.first = (unsigned long int) ((unsigned long int) ((char *) ptr - (char *) NULL) % BLOCKSIZE >> type); prev->next = _fraghead[type].next; prev->prev = &_fraghead[type]; prev->prev->next = prev; if (prev->next != NULL) prev->next->prev = prev; } break; } } /* Return memory to the heap. */ void free (ptr) __ptr_t ptr; { if (__free_hook != NULL) (*__free_hook) (ptr); else _free_internal (ptr); } /* Define the `cfree' alias for `free'. */ #ifdef weak_alias weak_alias (free, cfree) #else void cfree (ptr) __ptr_t ptr; { free (ptr); } #endif /* Change the size of a block allocated by `malloc'. Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif /* Cope with systems lacking `memmove'. */ #if (defined (MEMMOVE_MISSING) || \ !defined(_LIBC) && !defined(STDC_HEADERS) && !defined(USG)) #ifdef emacs #undef __malloc_safe_bcopy #define __malloc_safe_bcopy safe_bcopy #else /* Snarfed directly from Emacs src/dispnew.c: XXX Should use system bcopy if it handles overlap. */ /* Like bcopy except never gets confused by overlap. */ void __malloc_safe_bcopy (afrom, ato, size) __ptr_t afrom; __ptr_t ato; __malloc_size_t size; { char *from = afrom, *to = ato; if (size <= 0 || from == to) return; /* If the source and destination don't overlap, then bcopy can handle it. If they do overlap, but the destination is lower in memory than the source, we'll assume bcopy can handle that. */ if (to < from || from + size <= to) bcopy (from, to, size); /* Otherwise, we'll copy from the end. */ else { register char *endf = from + size; register char *endt = to + size; /* If TO - FROM is large, then we should break the copy into nonoverlapping chunks of TO - FROM bytes each. However, if TO - FROM is small, then the bcopy function call overhead makes this not worth it. The crossover point could be about anywhere. Since I don't think the obvious copy loop is too bad, I'm trying to err in its favor. */ if (to - from < 64) { do *--endt = *--endf; while (endf != from); } else { for (;;) { endt -= (to - from); endf -= (to - from); if (endt < to) break; bcopy (endf, endt, to - from); } /* If SIZE wasn't a multiple of TO - FROM, there will be a little left over. The amount left over is (endt + (to - from)) - to, which is endt - from. */ bcopy (from, to, endt - from); } } } #endif /* emacs */ #ifndef memmove extern void __malloc_safe_bcopy __P ((__ptr_t, __ptr_t, __malloc_size_t)); #define memmove(to, from, size) __malloc_safe_bcopy ((from), (to), (size)) #endif #endif #define min(A, B) ((A) < (B) ? (A) : (B)) /* Debugging hook for realloc. */ __ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, __malloc_size_t __size)); /* Resize the given region to the new size, returning a pointer to the (possibly moved) region. This is optimized for speed; some benchmarks seem to indicate that greater compactness is achieved by unconditionally allocating and copying to a new region. This module has incestuous knowledge of the internals of both free and malloc. */ __ptr_t _realloc_internal (ptr, size) __ptr_t ptr; __malloc_size_t size; { __ptr_t result; int type; __malloc_size_t block, blocks, oldlimit; if (size == 0) { _free_internal (ptr); return _malloc_internal (0); } else if (ptr == NULL) return _malloc_internal (size); block = BLOCK (ptr); type = _heapinfo[block].busy.type; switch (type) { case 0: /* Maybe reallocate a large block to a small fragment. */ if (size <= BLOCKSIZE / 2) { result = _malloc_internal (size); if (result != NULL) { memcpy (result, ptr, size); _free_internal (ptr); return result; } } /* The new size is a large allocation as well; see if we can hold it in place. */ blocks = BLOCKIFY (size); if (blocks < _heapinfo[block].busy.info.size) { /* The new size is smaller; return excess memory to the free list. */ _heapinfo[block + blocks].busy.type = 0; _heapinfo[block + blocks].busy.info.size = _heapinfo[block].busy.info.size - blocks; _heapinfo[block].busy.info.size = blocks; /* We have just created a new chunk by splitting a chunk in two. Now we will free this chunk; increment the statistics counter so it doesn't become wrong when _free_internal decrements it. */ ++_chunks_used; _free_internal (ADDRESS (block + blocks)); result = ptr; } else if (blocks == _heapinfo[block].busy.info.size) /* No size change necessary. */ result = ptr; else { /* Won't fit, so allocate a new region that will. Free the old region first in case there is sufficient adjacent free space to grow without moving. */ blocks = _heapinfo[block].busy.info.size; /* Prevent free from actually returning memory to the system. */ oldlimit = _heaplimit; _heaplimit = 0; _free_internal (ptr); _heaplimit = oldlimit; result = _malloc_internal (size); if (result == NULL) { /* Now we're really in trouble. We have to unfree the thing we just freed. Unfortunately it might have been coalesced with its neighbors. */ if (_heapindex == block) (void) _malloc_internal (blocks * BLOCKSIZE); else { __ptr_t previous = _malloc_internal ((block - _heapindex) * BLOCKSIZE); (void) _malloc_internal (blocks * BLOCKSIZE); _free_internal (previous); } return NULL; } if (ptr != result) memmove (result, ptr, blocks * BLOCKSIZE); } break; default: /* Old size is a fragment; type is logarithm to base two of the fragment size. */ if (size > (__malloc_size_t) (1 << (type - 1)) && size <= (__malloc_size_t) (1 << type)) /* The new size is the same kind of fragment. */ result = ptr; else { /* The new size is different; allocate a new space, and copy the lesser of the new size and the old. */ result = _malloc_internal (size); if (result == NULL) return NULL; memcpy (result, ptr, min (size, (__malloc_size_t) 1 << type)); _free_internal (ptr); } break; } return result; } __ptr_t realloc (ptr, size) __ptr_t ptr; __malloc_size_t size; { return (__realloc_hook != NULL ? *__realloc_hook : _realloc_internal) (ptr, size); } /* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif /* Allocate an array of NMEMB elements each SIZE bytes long. The entire array is initialized to zeros. */ __ptr_t calloc (nmemb, size) register __malloc_size_t nmemb; register __malloc_size_t size; { register __ptr_t result = malloc (nmemb * size); if (result != NULL) (void) memset (result, 0, nmemb * size); return result; } /* Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. This file is part of the GNU C Library. The GNU C Library 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. The GNU C Library 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 the GNU C Library; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif #ifndef __GNU_LIBRARY__ #define __sbrk sbrk #endif #ifdef __GNU_LIBRARY__ /* It is best not to declare this and cast its result on foreign operating systems with potentially hostile include files. */ #include extern __ptr_t __sbrk __P ((ptrdiff_t increment)); #endif #ifndef NULL #define NULL 0 #endif /* Allocate INCREMENT more bytes of data space, and return the start of data space, or NULL on errors. If INCREMENT is negative, shrink data space. */ __ptr_t __default_morecore (increment) __malloc_ptrdiff_t increment; { __ptr_t result = (__ptr_t) __sbrk (increment); if (result == (__ptr_t) -1) return NULL; return result; } /* Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif __ptr_t (*__memalign_hook) __P ((size_t __size, size_t __alignment)); __ptr_t memalign (alignment, size) __malloc_size_t alignment; __malloc_size_t size; { __ptr_t result; unsigned long int adj, lastadj; if (__memalign_hook) return (*__memalign_hook) (alignment, size); /* Allocate a block with enough extra space to pad the block with up to (ALIGNMENT - 1) bytes if necessary. */ result = malloc (size + alignment - 1); if (result == NULL) return NULL; /* Figure out how much we will need to pad this particular block to achieve the required alignment. */ adj = (unsigned long int) ((char *) result - (char *) NULL) % alignment; do { /* Reallocate the block with only as much excess as it needs. */ free (result); result = malloc (adj + size); if (result == NULL) /* Impossible unless interrupted. */ return NULL; lastadj = adj; adj = (unsigned long int) ((char *) result - (char *) NULL) % alignment; /* It's conceivable we might have been so unlucky as to get a different block with weaker alignment. If so, this block is too short to contain SIZE after alignment correction. So we must try again and get another block, slightly larger. */ } while (adj > lastadj); if (adj != 0) { /* Record this block in the list of aligned blocks, so that `free' can identify the pointer it is passed, which will be in the middle of an allocated block. */ struct alignlist *l; for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == NULL) /* This slot is free. Use it. */ break; if (l == NULL) { l = (struct alignlist *) malloc (sizeof (struct alignlist)); if (l == NULL) { free (result); return NULL; } l->next = _aligned_blocks; _aligned_blocks = l; } l->exact = result; result = l->aligned = (char *) result + alignment - adj; } return result; } emacs-19.30/src/hftctl.c100444 12120 1 26525 5577474476 13402 0ustar rmsdaemon/* IBM has disclaimed copyright on this module. */ /***************************************************************/ /* */ /* Function: hftctl */ /* */ /* Syntax: */ /* #include */ /* #include */ /* */ /* int hftctl(fildes, request, arg ) */ /* int fildes, request; */ /* char *arg; */ /* */ /* Description: */ /* */ /* Does the following: */ /* 1. determines if fildes is pty */ /* does normal ioctl it is not */ /* 2. places fildes into raw mode */ /* 3. converts ioctl arguments to datastream */ /* 4. waits for 2 secs for acknowledgement before */ /* timing out. */ /* 5. places response in callers buffer ( just like */ /* ioctl. */ /* 6. returns fildes to its original mode */ /* */ /* User of this program should review steps 1,4, and 3. */ /* hftctl makes no check on the request type. It must be */ /* a HFT ioctl that is supported remotely. */ /* This program will use the SIGALRM and alarm(2). Any */ /* Previous alarms are lost. */ /* */ /* Users of this program are free to modify it any way */ /* they want. */ /* */ /* Return Value: */ /* */ /* If ioctl fails, a value of -1 is returned and errno */ /* is set to indicate the error. */ /* */ /***************************************************************/ #include #include #include #include #include #include #include #include #include #include #include #include #include /* #include */ #define REMOTE 0x01 #undef ioctl static char SCCSid[] = "com/gnuemacs/src,3.1,9021-90/05/03-5/3/90"; /*************** LOCAL DEFINES **********************************/ #define QDEV ((HFQPDEVCH<<8)|HFQPDEVCL) #define QLOC ((HFQLOCCH<<8)|HFQLOCCL) #define QPS ((HFQPRESCH<<8)|HFQPRESCL) #ifndef TCGETS #define TCGETS TCGETA #endif #ifndef TCSETS #define TCSETS TCSETA #endif /*************** EXTERNAL / GLOBAL DATA AREA ********************/ static int hfqry(); static int hfskbd(); char *xmalloc(); extern int errno; static jmp_buf hftenv; static int is_ack_vtd; static SIGTYPE (*sav_alrm) (); static struct hfctlreq req = { 0x1b,'[','x',0,0,0,21,HFCTLREQCH,HFCTLREQCL}; static struct hfctlack ACK = { 0x1b,'[','x',0,0,0,21,HFCTLACKCH,HFCTLACKCL}; /* FUNC signal(); */ /*************** LOCAL MACROS ***********************************/ #define HFTYPE(p) ((p->hf_typehi<<8)|(p->hf_typelo)) #define BYTE4(p) ((p)[0]<<24 | (p)[1]<<16 | (p)[2]<<8 | (p)[3]) /* read a buffer */ #define RD_BUF(f,p,l) \ while ((l)) \ if ((j = read((f),(p),(l))) < 0) \ if (errno != EINTR) return (-1); \ else continue; \ else { (l) -= j; (p) += j; } /*************** function prototypes ***************************/ #ifdef __STDC__ static GT_ACK (int fd, int req, char *buf); static WR_REQ (int fd, int request, int cmdlen, char *cmd, int resplen); static void hft_alrm(int sig); #else static GT_ACK (); static WR_REQ (); static void hft_alrm (); #endif /*************** HFTCTL FUNCTION *******************************/ hftctl (fd, request, arg) int fd; int request; union { struct hfintro *intro; struct hfquery *query; char *c; } arg; { int i; int fd_flag; /* fcntl flags */ register union { struct hfintro *cmd; /* p.cmd - intro des. */ struct hfqphdevc *ph; /* p.ph - physical dev.*/ char *c; /* p.c - char ptr */ } p; /* general pointer */ int pty_new; /* pty modes */ int pty_old; int retcode; struct termios term_new; /* terminal attributes */ struct termios term_old; struct devinfo devInfo; /* defined in sys/devinfo.h */ if (ioctl (fd, IOCINFO, &devInfo) == -1) return(-1); if (devInfo.devtype != DD_PSEU) /* is it a pty? */ return (ioctl(fd, request, arg)); /* no, do IOCTL */ /******* START PTY **************/ /** Pty found, possible HFT */ /** set new file des as raw */ /** as you can. */ /********************************/ /* Get current state of file */ /* descriptor & save */ if ((fd_flag = fcntl (fd, F_GETFL, 0)) == -1) return (-1); if (ioctl (fd, TCGETS, &term_old) == -1) return (-1); /* set terminal attr to raw */ /* and to delay on read */ pty_new = pty_old | REMOTE; memcpy (&term_new, &term_old, sizeof (term_new)); term_new.c_iflag = 0; term_new.c_oflag = 0; term_new.c_lflag = 0; /* term_new.c_line = 0; */ for (i = 1; i <= 5; i++) term_new.c_cc[i] = 0; term_new.c_cc[0] = -1; ioctl (fd, TCSETS, &term_new); if (fcntl (fd, F_SETFL, fd_flag & ~O_NDELAY) == -1) return(-1); /* call spacific function */ if (request == HFSKBD) retcode = hfskbd (fd, request, arg.c); else /* assume HFQUERY */ retcode = hfqry (fd, request, arg.c); fcntl (fd, F_SETFL, fd_flag); /* reset terminal to original */ ioctl (fd, TCSETS, &term_old); return (retcode); /* return error */ } /*************** HFSKBD FUNCTION ******************************/ static int hfskbd (fd, request, arg) int fd; int request; struct hfbuf *arg; { WR_REQ(fd, request, arg->hf_buflen, arg->hf_bufp,0); return (GT_ACK(fd, request, arg->hf_bufp)); } /*************** HFQUERY FUNCTION ******************************/ static int hfqry (fd, request, arg) int fd; int request; struct hfquery *arg; { WR_REQ(fd, request, arg->hf_cmdlen, arg->hf_cmd, arg->hf_resplen); return (GT_ACK(fd, request, arg->hf_resp)); } /*************** GT_ACK FUNCTION ******************************/ static int GT_ACK (fd, req, buf) int fd; int req; char *buf; { struct hfctlack ack; int i = sizeof (ack); int j = 0; union { char *c; struct hfctlack *ack; } p; is_ack_vtd = 0; /* flag no ACT VTD yet */ if (setjmp (hftenv)) /* set environment in case */ { /* of time out */ errno = ENODEV; /* if time out, set errno */ return (-1); /* flag error */ } alarm(3); /* time out in 3 secs */ sav_alrm = signal (SIGALRM, hft_alrm); /* prepare to catch time out */ p.ack = &ack; while (! is_ack_vtd) /* do until valid ACK VTD */ { RD_BUF(fd, p.c, i); /* read until a ACK VTD is fill*/ if (! memcmp (&ack, &ACK, sizeof (HFINTROSZ)) /* the ACK intro & */ && (ack.hf_request == req)) /* is it the response we want ?*/ { /* yes, ACK VTD found */ is_ack_vtd = 1; /* quickly, flag it */ break; /* get the %$%#@ out of here */ } p.ack = &ack; /* no, then skip 1st */ ++p.c; /* char and start over */ i = sizeof (ack) - 1; /* one less ESC to cry over */ while ((*p.c != 0x1b) && i) /* scan for next ESC */ { ++p.c; --i; } /* if any */ (i ? memcpy (&ack, p.c, i) : 0); /* if any left over, then move */ p.ack = &ack; /* ESC to front of ack struct */ p.c += i; /* skip over whats been read */ i = sizeof (ack) - i; /* set whats left to be read */ } /***** TRY AGAIN */ alarm(0); /* ACK VTD received, reset alrm*/ signal (SIGALRM, sav_alrm); /* reset signal */ if (i = ack.hf_arg_len) /* any data following ? */ { /* yes, */ RD_BUF(fd,buf,i); /* read until it is received */ } if (errno = ack.hf_retcode) /* set errno based on returned */ return (-1); /* code, if 0, then no error */ else return (0); /* if set, then error returned */ } /*************** HFT_ALRM FUNCTION ******************************/ static void hft_alrm (sig) /* Function hft_alrm - handle */ int sig; /* alarm signal */ { signal (SIGALRM, sav_alrm); /* reset to previous */ if (is_ack_vtd) /* has ack vtd arrived ? */ return; /* yes, then continue */ else /* no, then return with error */ longjmp (hftenv, -1); } /*********************************************************************/ /*** ***/ /*** NOTE: Both the HFCTLREQ and the arg structure should be ***/ /*** sent in one io write operation. If terminal ***/ /*** emulators are in NODELAY mode then multiple writes ***/ /*** may cause bogus information to be read by the emulator ***/ /*** depending on the timing. ***/ /*** ***/ /*********************************************************************/ static int WR_REQ (fd, request, cmdlen, cmd, resplen) int fd; int request; int cmdlen; char *cmd; int resplen; { struct { char *c; struct hfctlreq *req; } p; int size; req.hf_request = request; req.hf_arg_len = cmdlen; req.hf_rsp_len = resplen; if (cmdlen) /* if arg structure to pass */ { size = sizeof (struct hfctlreq) + cmdlen; if ((p.c = xmalloc(size)) == NULL) /* malloc one area */ return (-1); memcpy (p.c, &req, sizeof (req)); /* copy CTL REQ struct */ memcpy (p.c + sizeof (req), cmd, cmdlen); /* copy arg struct */ } else { p.req = &req; /* otherwise use only CTL REQ */ size = sizeof (req); } /* write request to terminal */ if (write(fd,p.c,size) == -1) return (-1); if (p.req != &req) /* free if allocated */ xfree (p.c); return (0); } emacs-19.30/src/indent.c100444 12120 1 112166 6052200471 13357 0ustar rmsdaemon/* Indentation functions. Copyright (C) 1985,86,87,88,93,94,95 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. */ #include #include "lisp.h" #include "buffer.h" #include "indent.h" #include "frame.h" #include "window.h" #include "termchar.h" #include "termopts.h" #include "disptab.h" #include "intervals.h" #include "region-cache.h" /* Indentation can insert tabs if this is non-zero; otherwise always uses spaces */ int indent_tabs_mode; #define min(a, b) ((a) < (b) ? (a) : (b)) #define max(a, b) ((a) > (b) ? (a) : (b)) #define CR 015 /* These three values memoize the current column to avoid recalculation */ /* Some things in set last_known_column_point to -1 to mark the memoized value as invalid */ /* Last value returned by current_column */ int last_known_column; /* Value of point when current_column was called */ int last_known_column_point; /* Value of MODIFF when current_column was called */ int last_known_column_modified; /* Get the display table to use for the current buffer. */ struct Lisp_Char_Table * buffer_display_table () { Lisp_Object thisbuf; thisbuf = current_buffer->display_table; if (DISP_TABLE_P (thisbuf)) return XCHAR_TABLE (thisbuf); if (DISP_TABLE_P (Vstandard_display_table)) return XCHAR_TABLE (Vstandard_display_table); return 0; } /* Width run cache considerations. */ /* Return the width of character C under display table DP. */ static int character_width (c, dp) int c; struct Lisp_Char_Table *dp; { Lisp_Object elt; /* These width computations were determined by examining the cases in display_text_line. */ /* Everything can be handled by the display table, if it's present and the element is right. */ if (dp && (elt = DISP_CHAR_VECTOR (dp, c), VECTORP (elt))) return XVECTOR (elt)->size; /* Some characters are special. */ if (c == '\n' || c == '\t' || c == '\015') return 0; /* Printing characters have width 1. */ else if (c >= 040 && c < 0177) return 1; /* Everybody else (control characters, metacharacters) has other widths. We could return their actual widths here, but they depend on things like ctl_arrow and crud like that, and they're not very common at all. So we'll just claim we don't know their widths. */ else return 0; } /* Return true iff the display table DISPTAB specifies the same widths for characters as WIDTHTAB. We use this to decide when to invalidate the buffer's width_run_cache. */ int disptab_matches_widthtab (disptab, widthtab) struct Lisp_Char_Table *disptab; struct Lisp_Vector *widthtab; { int i; if (widthtab->size != 256) abort (); for (i = 0; i < 256; i++) if (character_width (i, disptab) != XFASTINT (widthtab->contents[i])) return 0; return 1; } /* Recompute BUF's width table, using the display table DISPTAB. */ void recompute_width_table (buf, disptab) struct buffer *buf; struct Lisp_Char_Table *disptab; { int i; struct Lisp_Vector *widthtab; if (!VECTORP (buf->width_table)) buf->width_table = Fmake_vector (make_number (256), make_number (0)); widthtab = XVECTOR (buf->width_table); if (widthtab->size != 256) abort (); for (i = 0; i < 256; i++) XSETFASTINT (widthtab->contents[i], character_width (i, disptab)); } /* Allocate or free the width run cache, as requested by the current state of current_buffer's cache_long_line_scans variable. */ static void width_run_cache_on_off () { if (NILP (current_buffer->cache_long_line_scans)) { /* It should be off. */ if (current_buffer->width_run_cache) { free_region_cache (current_buffer->width_run_cache); current_buffer->width_run_cache = 0; current_buffer->width_table = Qnil; } } else { /* It should be on. */ if (current_buffer->width_run_cache == 0) { current_buffer->width_run_cache = new_region_cache (); recompute_width_table (current_buffer, buffer_display_table ()); } } } DEFUN ("current-column", Fcurrent_column, Scurrent_column, 0, 0, 0, "Return the horizontal position of point. Beginning of line is column 0.\n\ This is calculated by adding together the widths of all the displayed\n\ representations of the character between the start of the previous line\n\ and point. (eg control characters will have a width of 2 or 4, tabs\n\ will have a variable width)\n\ Ignores finite width of frame, which means that this function may return\n\ values greater than (frame-width).\n\ Whether the line is visible (if `selective-display' is t) has no effect;\n\ however, ^M is treated as end of line when `selective-display' is t.") () { Lisp_Object temp; XSETFASTINT (temp, current_column ()); return temp; } /* Cancel any recorded value of the horizontal position. */ invalidate_current_column () { last_known_column_point = 0; } int current_column () { register int col; register unsigned char *ptr, *stop; register int tab_seen; int post_tab; register int c; register int tab_width = XINT (current_buffer->tab_width); int ctl_arrow = !NILP (current_buffer->ctl_arrow); register struct Lisp_Char_Table *dp = buffer_display_table (); int stopchar; if (point == last_known_column_point && MODIFF == last_known_column_modified) return last_known_column; /* Make a pointer for decrementing through the chars before point. */ ptr = &FETCH_CHAR (point - 1) + 1; /* Make a pointer to where consecutive chars leave off, going backwards from point. */ if (point == BEGV) stop = ptr; else if (point <= GPT || BEGV > GPT) stop = BEGV_ADDR; else stop = GAP_END_ADDR; if (tab_width <= 0 || tab_width > 1000) tab_width = 8; col = 0, tab_seen = 0, post_tab = 0; while (1) { if (ptr == stop) { /* We stopped either for the beginning of the buffer or for the gap. */ if (ptr == BEGV_ADDR) break; /* It was the gap. Jump back over it. */ stop = BEGV_ADDR; ptr = GPT_ADDR; /* Check whether that brings us to beginning of buffer. */ if (BEGV >= GPT) break; } c = *--ptr; if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, c))) col += XVECTOR (DISP_CHAR_VECTOR (dp, c))->size; else if (c >= 040 && c < 0177) col++; else if (c == '\n') break; else if (c == '\r' && EQ (current_buffer->selective_display, Qt)) break; else if (c == '\t') { if (tab_seen) col = ((col + tab_width) / tab_width) * tab_width; post_tab += col; col = 0; tab_seen = 1; } else col += (ctl_arrow && c < 0200) ? 2 : 4; } if (tab_seen) { col = ((col + tab_width) / tab_width) * tab_width; col += post_tab; } last_known_column = col; last_known_column_point = point; last_known_column_modified = MODIFF; return col; } /* Return the width in columns of the part of STRING from BEG to END. If BEG is nil, that stands for the beginning of STRING. If END is nil, that stands for the end of STRING. */ static int string_display_width (string, beg, end) Lisp_Object string, beg, end; { register int col; register unsigned char *ptr, *stop; register int tab_seen; int post_tab; register int c; register int tab_width = XINT (current_buffer->tab_width); int ctl_arrow = !NILP (current_buffer->ctl_arrow); register struct Lisp_Char_Table *dp = buffer_display_table (); int b, e; if (NILP (end)) e = XSTRING (string)->size; else { CHECK_NUMBER (end, 0); e = XINT (end); } if (NILP (beg)) b = 0; else { CHECK_NUMBER (beg, 0); b = XINT (beg); } /* Make a pointer for decrementing through the chars before point. */ ptr = XSTRING (string)->data + e; /* Make a pointer to where consecutive chars leave off, going backwards from point. */ stop = XSTRING (string)->data + b; if (tab_width <= 0 || tab_width > 1000) tab_width = 8; col = 0, tab_seen = 0, post_tab = 0; while (1) { if (ptr == stop) break; c = *--ptr; if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, c))) col += XVECTOR (DISP_CHAR_VECTOR (dp, c))->size; else if (c >= 040 && c < 0177) col++; else if (c == '\n') break; else if (c == '\t') { if (tab_seen) col = ((col + tab_width) / tab_width) * tab_width; post_tab += col; col = 0; tab_seen = 1; } else col += (ctl_arrow && c < 0200) ? 2 : 4; } if (tab_seen) { col = ((col + tab_width) / tab_width) * tab_width; col += post_tab; } return col; } DEFUN ("indent-to", Findent_to, Sindent_to, 1, 2, "NIndent to column: ", "Indent from point with tabs and spaces until COLUMN is reached.\n\ Optional second argument MIN says always do at least MIN spaces\n\ even if that goes past COLUMN; by default, MIN is zero.") (col, minimum) Lisp_Object col, minimum; { int mincol; register int fromcol; register int tab_width = XINT (current_buffer->tab_width); CHECK_NUMBER (col, 0); if (NILP (minimum)) XSETFASTINT (minimum, 0); CHECK_NUMBER (minimum, 1); fromcol = current_column (); mincol = fromcol + XINT (minimum); if (mincol < XINT (col)) mincol = XINT (col); if (fromcol == mincol) return make_number (mincol); if (tab_width <= 0 || tab_width > 1000) tab_width = 8; if (indent_tabs_mode) { Lisp_Object n; XSETFASTINT (n, mincol / tab_width - fromcol / tab_width); if (XFASTINT (n) != 0) { Finsert_char (make_number ('\t'), n, Qt); fromcol = (mincol / tab_width) * tab_width; } } XSETFASTINT (col, mincol - fromcol); Finsert_char (make_number (' '), col, Qt); last_known_column = mincol; last_known_column_point = point; last_known_column_modified = MODIFF; XSETINT (col, mincol); return col; } DEFUN ("current-indentation", Fcurrent_indentation, Scurrent_indentation, 0, 0, 0, "Return the indentation of the current line.\n\ This is the horizontal position of the character\n\ following any initial whitespace.") () { Lisp_Object val; XSETFASTINT (val, position_indentation (find_next_newline (point, -1))); return val; } position_indentation (pos) register int pos; { register int column = 0; register int tab_width = XINT (current_buffer->tab_width); register unsigned char *p; register unsigned char *stop; if (tab_width <= 0 || tab_width > 1000) tab_width = 8; stop = &FETCH_CHAR (BUFFER_CEILING_OF (pos)) + 1; p = &FETCH_CHAR (pos); while (1) { while (p == stop) { if (pos == ZV) return column; pos += p - &FETCH_CHAR (pos); p = &FETCH_CHAR (pos); stop = &FETCH_CHAR (BUFFER_CEILING_OF (pos)) + 1; } switch (*p++) { case ' ': column++; break; case '\t': column += tab_width - column % tab_width; break; default: return column; } } } /* Test whether the line beginning at POS is indented beyond COLUMN. Blank lines are treated as if they had the same indentation as the preceding line. */ int indented_beyond_p (pos, column) int pos, column; { while (pos > BEGV && FETCH_CHAR (pos) == '\n') pos = find_next_newline_no_quit (pos - 1, -1); return (position_indentation (pos) >= column); } DEFUN ("move-to-column", Fmove_to_column, Smove_to_column, 1, 2, "p", "Move point to column COLUMN in the current line.\n\ The column of a character is calculated by adding together the widths\n\ as displayed of the previous characters in the line.\n\ This function ignores line-continuation;\n\ there is no upper limit on the column number a character can have\n\ and horizontal scrolling has no effect.\n\ \n\ If specified column is within a character, point goes after that character.\n\ If it's past end of line, point goes to end of line.\n\n\ A non-nil second (optional) argument FORCE means, if the line\n\ is too short to reach column COLUMN then add spaces/tabs to get there,\n\ and if COLUMN is in the middle of a tab character, change it to spaces.\n\ \n\ The return value is the current column.") (column, force) Lisp_Object column, force; { register int pos; register int col = current_column (); register int goal; register int end; register int tab_width = XINT (current_buffer->tab_width); register int ctl_arrow = !NILP (current_buffer->ctl_arrow); register struct Lisp_Char_Table *dp = buffer_display_table (); Lisp_Object val; int prev_col; int c; if (tab_width <= 0 || tab_width > 1000) tab_width = 8; CHECK_NATNUM (column, 0); goal = XINT (column); retry: pos = point; end = ZV; /* If we're starting past the desired column, back up to beginning of line and scan from there. */ if (col > goal) { pos = find_next_newline (pos, -1); col = 0; } while (col < goal && pos < end) { c = FETCH_CHAR (pos); if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, c))) { col += XVECTOR (DISP_CHAR_VECTOR (dp, c))->size; pos++; continue; } if (c == '\n') break; if (c == '\r' && EQ (current_buffer->selective_display, Qt)) break; pos++; if (c == '\t') { prev_col = col; col += tab_width; col = col / tab_width * tab_width; } else if (ctl_arrow && (c < 040 || c == 0177)) col += 2; else if (c < 040 || c >= 0177) col += 4; else col++; } SET_PT (pos); /* If a tab char made us overshoot, change it to spaces and scan through it again. */ if (!NILP (force) && col > goal && c == '\t' && prev_col < goal) { int old_point; del_range (point - 1, point); Findent_to (make_number (goal), Qnil); old_point = point; Findent_to (make_number (col), Qnil); SET_PT (old_point); /* Set the last_known... vars consistently. */ col = goal; } /* If line ends prematurely, add space to the end. */ if (col < goal && !NILP (force)) Findent_to (make_number (col = goal), Qnil); last_known_column = col; last_known_column_point = point; last_known_column_modified = MODIFF; XSETFASTINT (val, col); return val; } /* compute_motion: compute buffer posn given screen posn and vice versa */ struct position val_compute_motion; /* Scan the current buffer forward from offset FROM, pretending that this is at line FROMVPOS, column FROMHPOS, until reaching buffer offset TO or line TOVPOS, column TOHPOS (whichever comes first), and return the ending buffer position and screen location. If we can't hit the requested column exactly (because of a tab or other multi-column character), overshoot. DID_MOTION is 1 if FROMHPOS has already accounted for overlay strings at FROM. This is the case if FROMVPOS and FROMVPOS came from an earlier call to compute_motion. The other common case is that FROMHPOS is zero and FROM is a position that "belongs" at column zero, but might be shifted by overlay strings; in this case DID_MOTION should be 0. WIDTH is the number of columns available to display text; compute_motion uses this to handle continuation lines and such. HSCROLL is the number of columns not being displayed at the left margin; this is usually taken from a window's hscroll member. TAB_OFFSET is the number of columns of the first tab that aren't being displayed, perhaps because of a continuation line or something. compute_motion returns a pointer to a struct position. The bufpos member gives the buffer position at the end of the scan, and hpos and vpos give its cartesian location. prevhpos is the column at which the character before bufpos started, and contin is non-zero if we reached the current line by continuing the previous. Note that FROMHPOS and TOHPOS should be expressed in real screen columns, taking HSCROLL and the truncation glyph at the left margin into account. That is, beginning-of-line moves you to the hpos -HSCROLL + (HSCROLL > 0). Note that FROMHPOS and TOHPOS should be expressed in real screen columns, taking HSCROLL and the truncation glyph at the left margin into account. That is, beginning-of-line moves you to the hpos -HSCROLL + (HSCROLL > 0). For example, to find the buffer position of column COL of line LINE of a certain window, pass the window's starting location as FROM and the window's upper-left coordinates as FROMVPOS and FROMHPOS. Pass the buffer's ZV as TO, to limit the scan to the end of the visible section of the buffer, and pass LINE and COL as TOVPOS and TOHPOS. When displaying in window w, a typical formula for WIDTH is: window_width - 1 - (has_vertical_scroll_bars ? FRAME_SCROLL_BAR_COLS (XFRAME (window->frame)) : (window_width + window_left != frame_width)) where window_width is XFASTINT (w->width), window_left is XFASTINT (w->left), has_vertical_scroll_bars is FRAME_HAS_VERTICAL_SCROLL_BARS (XFRAME (WINDOW_FRAME (window))) and frame_width = FRAME_WIDTH (XFRAME (window->frame)) Or you can let window_internal_width do this all for you, and write: window_internal_width (w) - 1 The `-1' accounts for the continuation-line backslashes; the rest accounts for window borders if the window is split horizontally, and the scroll bars if they are turned on. */ struct position * compute_motion (from, fromvpos, fromhpos, did_motion, to, tovpos, tohpos, width, hscroll, tab_offset, win) int from, fromvpos, fromhpos, to, tovpos, tohpos; int did_motion; register int width; int hscroll, tab_offset; struct window *win; { register int hpos = fromhpos; register int vpos = fromvpos; register int pos; register int c; register int tab_width = XFASTINT (current_buffer->tab_width); register int ctl_arrow = !NILP (current_buffer->ctl_arrow); register struct Lisp_Char_Table *dp = window_display_table (win); int selective = (INTEGERP (current_buffer->selective_display) ? XINT (current_buffer->selective_display) : !NILP (current_buffer->selective_display) ? -1 : 0); int prev_vpos = vpos, prev_hpos = 0; int selective_rlen = (selective && dp && VECTORP (DISP_INVIS_VECTOR (dp)) ? XVECTOR (DISP_INVIS_VECTOR (dp))->size : 0); /* The next location where the `invisible' property changes, or an overlay starts or ends. */ int next_boundary = from; /* For computing runs of characters with similar widths. Invariant: width_run_width is zero, or all the characters from width_run_start to width_run_end have a fixed width of width_run_width. */ int width_run_start = from; int width_run_end = from; int width_run_width = 0; Lisp_Object *width_table; Lisp_Object buffer; /* The next buffer pos where we should consult the width run cache. */ int next_width_run = from; XSETBUFFER (buffer, current_buffer); width_run_cache_on_off (); if (dp == buffer_display_table ()) width_table = (VECTORP (current_buffer->width_table) ? XVECTOR (current_buffer->width_table)->contents : 0); else /* If the window has its own display table, we can't use the width run cache, because that's based on the buffer's display table. */ width_table = 0; if (tab_width <= 0 || tab_width > 1000) tab_width = 8; pos = from; while (1) { while (pos == next_boundary) { /* If the caller says that the screen position came from an earlier call to compute_motion, then we've already accounted for the overlay strings at point. This is only true the first time through, so clear the flag after testing it. */ if (!did_motion) /* We need to skip past the overlay strings. Currently those strings must contain single-column printing characters; if we want to relax that restriction, something will have to be changed here. */ hpos += overlay_strings (pos, win, (char **)0); did_motion = 0; if (pos >= to) break; { Lisp_Object prop, position, end, limit, proplimit; XSETFASTINT (position, pos); /* Give faster response for overlay lookup near POS. */ recenter_overlay_lists (current_buffer, pos); /* We must not advance farther than the next overlay change. The overlay change might change the invisible property; or there might be overlay strings to be displayed there. */ limit = Fnext_overlay_change (position); /* As for text properties, this gives a lower bound for where the invisible text property could change. */ proplimit = Fnext_property_change (position, buffer, Qt); if (XFASTINT (limit) < XFASTINT (proplimit)) proplimit = limit; /* PROPLIMIT is now a lower bound for the next change in invisible status. If that is plenty far away, use that lower bound. */ if (XFASTINT (proplimit) > pos + 100 || XFASTINT (proplimit) >= to) next_boundary = XFASTINT (proplimit); /* Otherwise, scan for the next `invisible' property change. */ else { /* Don't scan terribly far. */ XSETFASTINT (proplimit, min (pos + 100, to)); /* No matter what. don't go past next overlay change. */ if (XFASTINT (limit) < XFASTINT (proplimit)) proplimit = limit; end = Fnext_single_property_change (position, Qinvisible, buffer, proplimit); next_boundary = XFASTINT (end); } /* if the `invisible' property is set, we can skip to the next property change */ prop = Fget_char_property (position, Qinvisible, Fcurrent_buffer ()); if (TEXT_PROP_MEANS_INVISIBLE (prop)) pos = next_boundary; } } /* Handle right margin. */ if (hpos >= width && (hpos > width || (pos < ZV && FETCH_CHAR (pos) != '\n'))) { if (hscroll || (truncate_partial_width_windows && width + 1 < FRAME_WIDTH (XFRAME (WINDOW_FRAME (win)))) || !NILP (current_buffer->truncate_lines)) { /* Truncating: skip to newline. */ pos = find_before_next_newline (pos, to, 1); hpos = width; /* If we just skipped next_boundary, loop around in the main while and handle it. */ if (pos >= next_boundary) next_boundary = pos + 1; } else { /* Continuing. */ vpos += hpos / width; tab_offset += hpos - hpos % width; hpos %= width; } } /* Stop if past the target buffer position or screen position. */ if (pos >= to) break; if (vpos > tovpos || (vpos == tovpos && hpos >= tohpos)) break; prev_vpos = vpos; prev_hpos = hpos; /* Consult the width run cache to see if we can avoid inspecting the text character-by-character. */ if (current_buffer->width_run_cache && pos >= next_width_run) { int run_end; int common_width = region_cache_forward (current_buffer, current_buffer->width_run_cache, pos, &run_end); /* A width of zero means the character's width varies (like a tab), is meaningless (like a newline), or we just don't want to skip over it for some other reason. */ if (common_width != 0) { int run_end_hpos; /* Don't go past the final buffer posn the user requested. */ if (run_end > to) run_end = to; run_end_hpos = hpos + (run_end - pos) * common_width; /* Don't go past the final horizontal position the user requested. */ if (vpos == tovpos && run_end_hpos > tohpos) { run_end = pos + (tohpos - hpos) / common_width; run_end_hpos = hpos + (run_end - pos) * common_width; } /* Don't go past the margin. */ if (run_end_hpos >= width) { run_end = pos + (width - hpos) / common_width; run_end_hpos = hpos + (run_end - pos) * common_width; } hpos = run_end_hpos; if (run_end > pos) prev_hpos = hpos - common_width; pos = run_end; } next_width_run = run_end + 1; } /* We have to scan the text character-by-character. */ else { c = FETCH_CHAR (pos); pos++; /* Perhaps add some info to the width_run_cache. */ if (current_buffer->width_run_cache) { /* Is this character part of the current run? If so, extend the run. */ if (pos - 1 == width_run_end && width_table[c] == width_run_width) width_run_end = pos; /* The previous run is over, since this is a character at a different position, or a different width. */ else { /* Have we accumulated a run to put in the cache? (Currently, we only cache runs of width == 1). */ if (width_run_start < width_run_end && width_run_width == 1) know_region_cache (current_buffer, current_buffer->width_run_cache, width_run_start, width_run_end); /* Start recording a new width run. */ width_run_width = width_table[c]; width_run_start = pos - 1; width_run_end = pos; } } if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, c))) hpos += XVECTOR (DISP_CHAR_VECTOR (dp, c))->size; else if (c >= 040 && c < 0177) hpos++; else if (c == '\t') { int tem = (hpos + tab_offset + hscroll - (hscroll > 0)) % tab_width; if (tem < 0) tem += tab_width; hpos += tab_width - tem; } else if (c == '\n') { if (selective > 0 && indented_beyond_p (pos, selective)) { /* Skip any number of invisible lines all at once */ do pos = find_before_next_newline (pos, to, 1) + 1; while (pos < to && indented_beyond_p (pos, selective)); /* Allow for the " ..." that is displayed for them. */ if (selective_rlen) { hpos += selective_rlen; if (hpos >= width) hpos = width; } --pos; /* We have skipped the invis text, but not the newline after. */ } else { /* A visible line. */ vpos++; hpos = 0; hpos -= hscroll; /* Count the truncation glyph on column 0 */ if (hscroll > 0) hpos++; tab_offset = 0; } } else if (c == CR && selective < 0) { /* In selective display mode, everything from a ^M to the end of the line is invisible. Stop *before* the real newline. */ pos = find_before_next_newline (pos, to, 1); /* If we just skipped next_boundary, loop around in the main while and handle it. */ if (pos > next_boundary) next_boundary = pos; /* Allow for the " ..." that is displayed for them. */ if (selective_rlen) { hpos += selective_rlen; if (hpos >= width) hpos = width; } } else hpos += (ctl_arrow && c < 0200) ? 2 : 4; } } /* Remember any final width run in the cache. */ if (current_buffer->width_run_cache && width_run_width == 1 && width_run_start < width_run_end) know_region_cache (current_buffer, current_buffer->width_run_cache, width_run_start, width_run_end); val_compute_motion.bufpos = pos; val_compute_motion.hpos = hpos; val_compute_motion.vpos = vpos; val_compute_motion.prevhpos = prev_hpos; /* Nonzero if have just continued a line */ val_compute_motion.contin = (pos != from && (val_compute_motion.vpos != prev_vpos) && c != '\n'); return &val_compute_motion; } #if 0 /* The doc string is too long for some compilers, but make-docfile can find it in this comment. */ DEFUN ("compute-motion", Ffoo, Sfoo, 7, 7, 0, "Scan through the current buffer, calculating screen position.\n\ Scan the current buffer forward from offset FROM,\n\ assuming it is at position FROMPOS--a cons of the form (HPOS . VPOS)--\n\ to position TO or position TOPOS--another cons of the form (HPOS . VPOS)--\n\ and return the ending buffer position and screen location.\n\ \n\ There are three additional arguments:\n\ \n\ WIDTH is the number of columns available to display text;\n\ this affects handling of continuation lines.\n\ This is usually the value returned by `window-width', less one (to allow\n\ for the continuation glyph).\n\ \n\ OFFSETS is either nil or a cons cell (HSCROLL . TAB-OFFSET).\n\ HSCROLL is the number of columns not being displayed at the left\n\ margin; this is usually taken from a window's hscroll member.\n\ TAB-OFFSET is the number of columns of the first tab that aren't\n\ being displayed, perhaps because the line was continued within it.\n\ If OFFSETS is nil, HSCROLL and TAB-OFFSET are assumed to be zero.\n\ \n\ WINDOW is the window to operate on. Currently this is used only to\n\ find the display table. It does not matter what buffer WINDOW displays;\n\ `compute-motion' always operates on the current buffer.\n\ \n\ The value is a list of five elements:\n\ (POS HPOS VPOS PREVHPOS CONTIN)\n\ POS is the buffer position where the scan stopped.\n\ VPOS is the vertical position where the scan stopped.\n\ HPOS is the horizontal position where the scan stopped.\n\ \n\ PREVHPOS is the horizontal position one character back from POS.\n\ CONTIN is t if a line was continued after (or within) the previous character.\n\ \n\ For example, to find the buffer position of column COL of line LINE\n\ of a certain window, pass the window's starting location as FROM\n\ and the window's upper-left coordinates as FROMPOS.\n\ Pass the buffer's (point-max) as TO, to limit the scan to the end of the\n\ visible section of the buffer, and pass LINE and COL as TOPOS.") (from, frompos, to, topos, width, offsets, window) #endif DEFUN ("compute-motion", Fcompute_motion, Scompute_motion, 7, 7, 0, 0) (from, frompos, to, topos, width, offsets, window) Lisp_Object from, frompos, to, topos; Lisp_Object width, offsets, window; { Lisp_Object bufpos, hpos, vpos, prevhpos, contin; struct position *pos; int hscroll, tab_offset; CHECK_NUMBER_COERCE_MARKER (from, 0); CHECK_CONS (frompos, 0); CHECK_NUMBER (XCONS (frompos)->car, 0); CHECK_NUMBER (XCONS (frompos)->cdr, 0); CHECK_NUMBER_COERCE_MARKER (to, 0); CHECK_CONS (topos, 0); CHECK_NUMBER (XCONS (topos)->car, 0); CHECK_NUMBER (XCONS (topos)->cdr, 0); CHECK_NUMBER (width, 0); if (!NILP (offsets)) { CHECK_CONS (offsets, 0); CHECK_NUMBER (XCONS (offsets)->car, 0); CHECK_NUMBER (XCONS (offsets)->cdr, 0); hscroll = XINT (XCONS (offsets)->car); tab_offset = XINT (XCONS (offsets)->cdr); } else hscroll = tab_offset = 0; if (NILP (window)) window = Fselected_window (); else CHECK_LIVE_WINDOW (window, 0); pos = compute_motion (XINT (from), XINT (XCONS (frompos)->cdr), XINT (XCONS (frompos)->car), 0, XINT (to), XINT (XCONS (topos)->cdr), XINT (XCONS (topos)->car), XINT (width), hscroll, tab_offset, XWINDOW (window)); XSETFASTINT (bufpos, pos->bufpos); XSETINT (hpos, pos->hpos); XSETINT (vpos, pos->vpos); XSETINT (prevhpos, pos->prevhpos); return Fcons (bufpos, Fcons (hpos, Fcons (vpos, Fcons (prevhpos, Fcons (pos->contin ? Qt : Qnil, Qnil))))); } /* Return the column of position POS in window W's buffer. The result is rounded down to a multiple of the internal width of W. This is the amount of indentation of position POS that is not visible in its horizontal position in the window. */ int pos_tab_offset (w, pos) struct window *w; register int pos; { int opoint = PT; int col; int width = window_internal_width (w) - 1; if (pos == BEGV || FETCH_CHAR (pos - 1) == '\n') return 0; TEMP_SET_PT (pos); col = current_column (); TEMP_SET_PT (opoint); return col - (col % width); } /* Fvertical_motion and vmotion */ struct position val_vmotion; struct position * vmotion (from, vtarget, w) register int from, vtarget; struct window *w; { int width = window_internal_width (w) - 1; int hscroll = XINT (w->hscroll); struct position pos; /* vpos is cumulative vertical position, changed as from is changed */ register int vpos = 0; Lisp_Object prevline; register int first; int lmargin = hscroll > 0 ? 1 - hscroll : 0; int selective = (INTEGERP (current_buffer->selective_display) ? XINT (current_buffer->selective_display) : !NILP (current_buffer->selective_display) ? -1 : 0); Lisp_Object window; int start_hpos = 0; int did_motion; XSETWINDOW (window, w); /* The omission of the clause && marker_position (w->start) == BEG here is deliberate; I think we want to measure from the prompt position even if the minibuffer window has scrolled. */ if (EQ (window, minibuf_window)) { if (minibuf_prompt_width == 0 && STRINGP (minibuf_prompt)) minibuf_prompt_width = string_display_width (minibuf_prompt, Qnil, Qnil); start_hpos = minibuf_prompt_width; } if (vpos >= vtarget) { /* To move upward, go a line at a time until we have gone at least far enough */ first = 1; while ((vpos > vtarget || first) && from > BEGV) { Lisp_Object propval; XSETFASTINT (prevline, find_next_newline_no_quit (from - 1, -1)); while (XFASTINT (prevline) > BEGV && ((selective > 0 && indented_beyond_p (XFASTINT (prevline), selective)) #ifdef USE_TEXT_PROPERTIES /* watch out for newlines with `invisible' property */ || (propval = Fget_char_property (prevline, Qinvisible, window), TEXT_PROP_MEANS_INVISIBLE (propval)) #endif )) XSETFASTINT (prevline, find_next_newline_no_quit (XFASTINT (prevline) - 1, -1)); pos = *compute_motion (XFASTINT (prevline), 0, lmargin + (XFASTINT (prevline) == BEG ? start_hpos : 0), 0, from, 1 << (BITS_PER_INT - 2), 0, width, hscroll, 0, w); vpos -= pos.vpos; first = 0; from = XFASTINT (prevline); } /* If we made exactly the desired vertical distance, or if we hit beginning of buffer, return point found */ if (vpos >= vtarget) { val_vmotion.bufpos = from; val_vmotion.vpos = vpos; val_vmotion.hpos = lmargin; val_vmotion.contin = 0; val_vmotion.prevhpos = 0; return &val_vmotion; } /* Otherwise find the correct spot by moving down */ } /* Moving downward is simple, but must calculate from beg of line to determine hpos of starting point */ if (from > BEGV && FETCH_CHAR (from - 1) != '\n') { Lisp_Object propval; XSETFASTINT (prevline, find_next_newline_no_quit (from, -1)); while (XFASTINT (prevline) > BEGV && ((selective > 0 && indented_beyond_p (XFASTINT (prevline), selective)) #ifdef USE_TEXT_PROPERTIES /* watch out for newlines with `invisible' property */ || (propval = Fget_char_property (prevline, Qinvisible, window), TEXT_PROP_MEANS_INVISIBLE (propval)) #endif )) XSETFASTINT (prevline, find_next_newline_no_quit (XFASTINT (prevline) - 1, -1)); pos = *compute_motion (XFASTINT (prevline), 0, lmargin + (XFASTINT (prevline) == BEG ? start_hpos : 0), 0, from, 1 << (BITS_PER_INT - 2), 0, width, hscroll, 0, w); did_motion = 1; } else { pos.hpos = lmargin + (from == BEG ? start_hpos : 0); pos.vpos = 0; did_motion = 0; } return compute_motion (from, vpos, pos.hpos, did_motion, ZV, vtarget, - (1 << (BITS_PER_INT - 2)), width, hscroll, pos.vpos * width, w); } DEFUN ("vertical-motion", Fvertical_motion, Svertical_motion, 1, 2, 0, "Move to start of screen line LINES lines down.\n\ If LINES is negative, this is moving up.\n\ \n\ The optional second argument WINDOW specifies the window to use for\n\ parameters such as width, horizontal scrolling, and so on.\n\ the default is the selected window.\n\ It does not matter what buffer is displayed in WINDOW.\n\ `vertical-motion' always uses the current buffer.\n\ \n\ Sets point to position found; this may be start of line\n\ or just the start of a continuation line.\n\ Returns number of lines moved; may be closer to zero than LINES\n\ if beginning or end of buffer was reached.") (lines, window) Lisp_Object lines, window; { struct position pos; CHECK_NUMBER (lines, 0); if (! NILP (window)) CHECK_WINDOW (window, 0); else window = selected_window; pos = *vmotion (point, (int) XINT (lines), XWINDOW (window)); SET_PT (pos.bufpos); return make_number (pos.vpos); } /* file's initialization. */ syms_of_indent () { DEFVAR_BOOL ("indent-tabs-mode", &indent_tabs_mode, "*Indentation can insert tabs if this is non-nil.\n\ Setting this variable automatically makes it local to the current buffer."); indent_tabs_mode = 1; defsubr (&Scurrent_indentation); defsubr (&Sindent_to); defsubr (&Scurrent_column); defsubr (&Smove_to_column); defsubr (&Svertical_motion); defsubr (&Scompute_motion); } emacs-19.30/src/insdel.c100444 75424 1 55600 6045304402 13536 0ustar kwzhdaemon/* Buffer insertion/deletion and gap motion for GNU Emacs. Copyright (C) 1985, 1986, 1993, 1994, 1995 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. */ #include #include "lisp.h" #include "intervals.h" #include "buffer.h" #include "window.h" #include "blockinput.h" #define min(x, y) ((x) < (y) ? (x) : (y)) static void insert_from_string_1 (); static void insert_from_buffer_1 (); static void gap_left (); static void gap_right (); static void adjust_markers (); static void adjust_point (); /* Move gap to position `pos'. Note that this can quit! */ void move_gap (pos) int pos; { if (pos < GPT) gap_left (pos, 0); else if (pos > GPT) gap_right (pos); } /* Move the gap to POS, which is less than the current GPT. If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */ static void gap_left (pos, newgap) register int pos; int newgap; { register unsigned char *to, *from; register int i; int new_s1; pos--; if (!newgap) { if (unchanged_modified == MODIFF) { beg_unchanged = pos; end_unchanged = Z - pos - 1; } else { if (Z - GPT < end_unchanged) end_unchanged = Z - GPT; if (pos < beg_unchanged) beg_unchanged = pos; } } i = GPT; to = GAP_END_ADDR; from = GPT_ADDR; new_s1 = GPT - BEG; /* Now copy the characters. To move the gap down, copy characters up. */ while (1) { /* I gets number of characters left to copy. */ i = new_s1 - pos; if (i == 0) break; /* If a quit is requested, stop copying now. Change POS to be where we have actually moved the gap to. */ if (QUITP) { pos = new_s1; break; } /* Move at most 32000 chars before checking again for a quit. */ if (i > 32000) i = 32000; #ifdef GAP_USE_BCOPY if (i >= 128 /* bcopy is safe if the two areas of memory do not overlap or on systems where bcopy is always safe for moving upward. */ && (BCOPY_UPWARD_SAFE || to - from >= 128)) { /* If overlap is not safe, avoid it by not moving too many characters at once. */ if (!BCOPY_UPWARD_SAFE && i > to - from) i = to - from; new_s1 -= i; from -= i, to -= i; bcopy (from, to, i); } else #endif { new_s1 -= i; while (--i >= 0) *--to = *--from; } } /* Adjust markers, and buffer data structure, to put the gap at POS. POS is where the loop above stopped, which may be what was specified or may be where a quit was detected. */ adjust_markers (pos + 1, GPT, GAP_SIZE); GPT = pos + 1; QUIT; } static void gap_right (pos) register int pos; { register unsigned char *to, *from; register int i; int new_s1; pos--; if (unchanged_modified == MODIFF) { beg_unchanged = pos; end_unchanged = Z - pos - 1; } else { if (Z - pos - 1 < end_unchanged) end_unchanged = Z - pos - 1; if (GPT - BEG < beg_unchanged) beg_unchanged = GPT - BEG; } i = GPT; from = GAP_END_ADDR; to = GPT_ADDR; new_s1 = GPT - 1; /* Now copy the characters. To move the gap up, copy characters down. */ while (1) { /* I gets number of characters left to copy. */ i = pos - new_s1; if (i == 0) break; /* If a quit is requested, stop copying now. Change POS to be where we have actually moved the gap to. */ if (QUITP) { pos = new_s1; break; } /* Move at most 32000 chars before checking again for a quit. */ if (i > 32000) i = 32000; #ifdef GAP_USE_BCOPY if (i >= 128 /* bcopy is safe if the two areas of memory do not overlap or on systems where bcopy is always safe for moving downward. */ && (BCOPY_DOWNWARD_SAFE || from - to >= 128)) { /* If overlap is not safe, avoid it by not moving too many characters at once. */ if (!BCOPY_DOWNWARD_SAFE && i > from - to) i = from - to; new_s1 += i; bcopy (from, to, i); from += i, to += i; } else #endif { new_s1 += i; while (--i >= 0) *to++ = *from++; } } adjust_markers (GPT + GAP_SIZE, pos + 1 + GAP_SIZE, - GAP_SIZE); GPT = pos + 1; QUIT; } /* Add `amount' to the position of every marker in the current buffer whose current position is between `from' (exclusive) and `to' (inclusive). Also, any markers past the outside of that interval, in the direction of adjustment, are first moved back to the near end of the interval and then adjusted by `amount'. */ static void adjust_markers (from, to, amount) register int from, to, amount; { Lisp_Object marker; register struct Lisp_Marker *m; register int mpos; marker = BUF_MARKERS (current_buffer); while (!NILP (marker)) { m = XMARKER (marker); mpos = m->bufpos; if (amount > 0) { if (mpos > to && mpos < to + amount) mpos = to + amount; } else { if (mpos > from + amount && mpos <= from) mpos = from + amount; } if (mpos > from && mpos <= to) mpos += amount; m->bufpos = mpos; marker = m->chain; } } /* Adjust markers whose insertion-type is t for an insertion of AMOUNT characters at POS. */ static void adjust_markers_for_insert (pos, amount) register int pos, amount; { Lisp_Object marker; marker = BUF_MARKERS (current_buffer); while (!NILP (marker)) { register struct Lisp_Marker *m = XMARKER (marker); if (m->insertion_type && m->bufpos == pos) m->bufpos += amount; marker = m->chain; } } /* Add the specified amount to point. This is used only when the value of point changes due to an insert or delete; it does not represent a conceptual change in point as a marker. In particular, point is not crossing any interval boundaries, so there's no need to use the usual SET_PT macro. In fact it would be incorrect to do so, because either the old or the new value of point is out of synch with the current set of intervals. */ static void adjust_point (amount) int amount; { BUF_PT (current_buffer) += amount; } /* Make the gap INCREMENT characters longer. */ void make_gap (increment) int increment; { unsigned char *result; Lisp_Object tem; int real_gap_loc; int old_gap_size; /* If we have to get more space, get enough to last a while. */ increment += 2000; /* Don't allow a buffer size that won't fit in an int even if it will fit in a Lisp integer. That won't work because so many places use `int'. */ if (Z - BEG + GAP_SIZE + increment >= ((unsigned) 1 << (min (BITS_PER_INT, VALBITS) - 1))) error ("Buffer exceeds maximum size"); BLOCK_INPUT; result = BUFFER_REALLOC (BEG_ADDR, (Z - BEG + GAP_SIZE + increment)); if (result == 0) { UNBLOCK_INPUT; memory_full (); } /* We can't unblock until the new address is properly stored. */ BEG_ADDR = result; UNBLOCK_INPUT; /* Prevent quitting in move_gap. */ tem = Vinhibit_quit; Vinhibit_quit = Qt; real_gap_loc = GPT; old_gap_size = GAP_SIZE; /* Call the newly allocated space a gap at the end of the whole space. */ GPT = Z + GAP_SIZE; GAP_SIZE = increment; /* Move the new gap down to be consecutive with the end of the old one. This adjusts the markers properly too. */ gap_left (real_gap_loc + old_gap_size, 1); /* Now combine the two into one large gap. */ GAP_SIZE += old_gap_size; GPT = real_gap_loc; Vinhibit_quit = tem; } /* Insert a string of specified length before point. DO NOT use this for the contents of a Lisp string or a Lisp buffer! prepare_to_modify_buffer could relocate the text. */ void insert (string, length) register unsigned char *string; register length; { if (length > 0) { insert_1 (string, length, 0, 1); signal_after_change (PT-length, 0, length); } } void insert_and_inherit (string, length) register unsigned char *string; register length; { if (length > 0) { insert_1 (string, length, 1, 1); signal_after_change (PT-length, 0, length); } } void insert_1 (string, length, inherit, prepare) register unsigned char *string; register int length; int inherit, prepare; { register Lisp_Object temp; if (prepare) prepare_to_modify_buffer (PT, PT); if (PT != GPT) move_gap (PT); if (GAP_SIZE < length) make_gap (length - GAP_SIZE); record_insert (PT, length); MODIFF++; bcopy (string, GPT_ADDR, length); #ifdef USE_TEXT_PROPERTIES if (BUF_INTERVALS (current_buffer) != 0) /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */ offset_intervals (current_buffer, PT, length); #endif GAP_SIZE -= length; GPT += length; ZV += length; Z += length; adjust_overlays_for_insert (PT, length); adjust_markers_for_insert (PT, length); adjust_point (length); #ifdef USE_TEXT_PROPERTIES if (!inherit && BUF_INTERVALS (current_buffer) != 0) Fset_text_properties (make_number (PT - length), make_number (PT), Qnil, Qnil); #endif } /* Insert the part of the text of STRING, a Lisp object assumed to be of type string, consisting of the LENGTH characters starting at position POS. If the text of STRING has properties, they are absorbed into the buffer. It does not work to use `insert' for this, because a GC could happen before we bcopy the stuff into the buffer, and relocate the string without insert noticing. */ void insert_from_string (string, pos, length, inherit) Lisp_Object string; register int pos, length; int inherit; { if (length > 0) { insert_from_string_1 (string, pos, length, inherit); signal_after_change (PT-length, 0, length); } } static void insert_from_string_1 (string, pos, length, inherit) Lisp_Object string; register int pos, length; int inherit; { register Lisp_Object temp; struct gcpro gcpro1; /* Make sure point-max won't overflow after this insertion. */ XSETINT (temp, length + Z); if (length + Z != XINT (temp)) error ("maximum buffer size exceeded"); GCPRO1 (string); prepare_to_modify_buffer (PT, PT); if (PT != GPT) move_gap (PT); if (GAP_SIZE < length) make_gap (length - GAP_SIZE); record_insert (PT, length); MODIFF++; UNGCPRO; bcopy (XSTRING (string)->data, GPT_ADDR, length); /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ offset_intervals (current_buffer, PT, length); GAP_SIZE -= length; GPT += length; ZV += length; Z += length; adjust_overlays_for_insert (PT, length); adjust_markers_for_insert (PT, length); /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ graft_intervals_into_buffer (XSTRING (string)->intervals, PT, length, current_buffer, inherit); adjust_point (length); } /* Insert text from BUF, starting at POS and having length LENGTH, into the current buffer. If the text in BUF has properties, they are absorbed into the current buffer. It does not work to use `insert' for this, because a malloc could happen and relocate BUF's text before the bcopy happens. */ void insert_from_buffer (buf, pos, length, inherit) struct buffer *buf; int pos, length; int inherit; { if (length > 0) { insert_from_buffer_1 (buf, pos, length, inherit); signal_after_change (PT-length, 0, length); } } static void insert_from_buffer_1 (buf, pos, length, inherit) struct buffer *buf; int pos, length; int inherit; { register Lisp_Object temp; int chunk; /* Make sure point-max won't overflow after this insertion. */ XSETINT (temp, length + Z); if (length + Z != XINT (temp)) error ("maximum buffer size exceeded"); prepare_to_modify_buffer (PT, PT); if (PT != GPT) move_gap (PT); if (GAP_SIZE < length) make_gap (length - GAP_SIZE); record_insert (PT, length); MODIFF++; if (pos < BUF_GPT (buf)) { chunk = BUF_GPT (buf) - pos; if (chunk > length) chunk = length; bcopy (BUF_CHAR_ADDRESS (buf, pos), GPT_ADDR, chunk); } else chunk = 0; if (chunk < length) bcopy (BUF_CHAR_ADDRESS (buf, pos + chunk), GPT_ADDR + chunk, length - chunk); #ifdef USE_TEXT_PROPERTIES if (BUF_INTERVALS (current_buffer) != 0) offset_intervals (current_buffer, PT, length); #endif GAP_SIZE -= length; GPT += length; ZV += length; Z += length; adjust_overlays_for_insert (PT, length); adjust_markers_for_insert (PT, length); adjust_point (length); /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf), pos, length), PT - length, length, current_buffer, inherit); } /* Insert the character C before point */ void insert_char (c) unsigned char c; { insert (&c, 1); } /* Insert the null-terminated string S before point */ void insert_string (s) char *s; { insert (s, strlen (s)); } /* Like `insert' except that all markers pointing at the place where the insertion happens are adjusted to point after it. Don't use this function to insert part of a Lisp string, since gc could happen and relocate it. */ void insert_before_markers (string, length) unsigned char *string; register int length; { if (length > 0) { register int opoint = PT; insert_1 (string, length, 0, 1); adjust_markers (opoint - 1, opoint, length); signal_after_change (PT-length, 0, length); } } void insert_before_markers_and_inherit (string, length) unsigned char *string; register int length; { if (length > 0) { register int opoint = PT; insert_1 (string, length, 1, 1); adjust_markers (opoint - 1, opoint, length); signal_after_change (PT-length, 0, length); } } /* Insert part of a Lisp string, relocating markers after. */ void insert_from_string_before_markers (string, pos, length, inherit) Lisp_Object string; register int pos, length; int inherit; { if (length > 0) { register int opoint = PT; insert_from_string_1 (string, pos, length, inherit); adjust_markers (opoint - 1, opoint, length); signal_after_change (PT-length, 0, length); } } /* Delete characters in current buffer from FROM up to (but not including) TO. */ void del_range (from, to) register int from, to; { del_range_1 (from, to, 1); } /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */ void del_range_1 (from, to, prepare) register int from, to, prepare; { register int numdel; /* Make args be valid */ if (from < BEGV) from = BEGV; if (to > ZV) to = ZV; if ((numdel = to - from) <= 0) return; /* Make sure the gap is somewhere in or next to what we are deleting. */ if (from > GPT) gap_right (from); if (to < GPT) gap_left (to, 0); if (prepare) prepare_to_modify_buffer (from, to); record_delete (from, numdel); MODIFF++; /* Relocate point as if it were a marker. */ if (from < PT) adjust_point (from - (PT < to ? PT : to)); /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ offset_intervals (current_buffer, from, - numdel); /* Relocate all markers pointing into the new, larger gap to point at the end of the text before the gap. */ adjust_markers (to + GAP_SIZE, to + GAP_SIZE, - numdel - GAP_SIZE); /* Adjust the overlay center as needed. This must be done after adjusting the markers that bound the overlays. */ adjust_overlays_for_delete (from, numdel); GAP_SIZE += numdel; ZV -= numdel; Z -= numdel; GPT = from; if (GPT - BEG < beg_unchanged) beg_unchanged = GPT - BEG; if (Z - GPT < end_unchanged) end_unchanged = Z - GPT; evaporate_overlays (from); signal_after_change (from, numdel, 0); } /* Call this if you're about to change the region of BUFFER from START to END. This checks the read-only properties of the region, calls the necessary modification hooks, and warns the next redisplay that it should pay attention to that area. */ void modify_region (buffer, start, end) struct buffer *buffer; int start, end; { struct buffer *old_buffer = current_buffer; if (buffer != old_buffer) set_buffer_internal (buffer); prepare_to_modify_buffer (start, end); if (start - 1 < beg_unchanged || unchanged_modified == MODIFF) beg_unchanged = start - 1; if (Z - end < end_unchanged || unchanged_modified == MODIFF) end_unchanged = Z - end; if (MODIFF <= SAVE_MODIFF) record_first_change (); MODIFF++; buffer->point_before_scroll = Qnil; if (buffer != old_buffer) set_buffer_internal (old_buffer); } /* Check that it is okay to modify the buffer between START and END. Run the before-change-function, if any. If intervals are in use, verify that the text to be modified is not read-only, and call any modification properties the text may have. */ void prepare_to_modify_buffer (start, end) Lisp_Object start, end; { if (!NILP (current_buffer->read_only)) Fbarf_if_buffer_read_only (); /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ if (BUF_INTERVALS (current_buffer) != 0) verify_interval_modification (current_buffer, start, end); #ifdef CLASH_DETECTION if (!NILP (current_buffer->file_truename) /* Make binding buffer-file-name to nil effective. */ && !NILP (current_buffer->filename) && SAVE_MODIFF >= MODIFF) lock_file (current_buffer->file_truename); #else /* At least warn if this file has changed on disk since it was visited. */ if (!NILP (current_buffer->filename) && SAVE_MODIFF >= MODIFF && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ())) && !NILP (Ffile_exists_p (current_buffer->filename))) call1 (intern ("ask-user-about-supersession-threat"), current_buffer->filename); #endif /* not CLASH_DETECTION */ signal_before_change (start, end); if (current_buffer->newline_cache) invalidate_region_cache (current_buffer, current_buffer->newline_cache, start - BEG, Z - end); if (current_buffer->width_run_cache) invalidate_region_cache (current_buffer, current_buffer->width_run_cache, start - BEG, Z - end); Vdeactivate_mark = Qt; } /* Signal a change to the buffer immediately before it happens. START and END are the bounds of the text to be changed, as Lisp objects. */ void signal_before_change (start, end) Lisp_Object start, end; { /* If buffer is unmodified, run a special hook for that case. */ if (SAVE_MODIFF >= MODIFF && !NILP (Vfirst_change_hook) && !NILP (Vrun_hooks)) call1 (Vrun_hooks, Qfirst_change_hook); /* Run the before-change-function if any. We don't bother "binding" this variable to nil because it is obsolete anyway and new code should not use it. */ if (!NILP (Vbefore_change_function)) call2 (Vbefore_change_function, start, end); /* Now run the before-change-functions if any. */ if (!NILP (Vbefore_change_functions)) { Lisp_Object args[3]; Lisp_Object before_change_functions; Lisp_Object after_change_functions; struct gcpro gcpro1, gcpro2; /* "Bind" before-change-functions and after-change-functions to nil--but in a way that errors don't know about. That way, if there's an error in them, they will stay nil. */ before_change_functions = Vbefore_change_functions; after_change_functions = Vafter_change_functions; Vbefore_change_functions = Qnil; Vafter_change_functions = Qnil; GCPRO2 (before_change_functions, after_change_functions); /* Actually run the hook functions. */ args[0] = Qbefore_change_functions; args[1] = start; args[2] = end; run_hook_list_with_args (before_change_functions, 3, args); /* "Unbind" the variables we "bound" to nil. */ Vbefore_change_functions = before_change_functions; Vafter_change_functions = after_change_functions; UNGCPRO; } if (!NILP (current_buffer->overlays_before) || !NILP (current_buffer->overlays_after)) report_overlay_modification (start, end, 0, start, end, Qnil); } /* Signal a change immediately after it happens. POS is the address of the start of the changed text. LENDEL is the number of characters of the text before the change. (Not the whole buffer; just the part that was changed.) LENINS is the number of characters in the changed text. (Hence POS + LENINS - LENDEL is the position after the changed text.) */ void signal_after_change (pos, lendel, lenins) int pos, lendel, lenins; { /* Run the after-change-function if any. We don't bother "binding" this variable to nil because it is obsolete anyway and new code should not use it. */ if (!NILP (Vafter_change_function)) call3 (Vafter_change_function, make_number (pos), make_number (pos + lenins), make_number (lendel)); if (!NILP (Vafter_change_functions)) { Lisp_Object args[4]; Lisp_Object before_change_functions; Lisp_Object after_change_functions; struct gcpro gcpro1, gcpro2; /* "Bind" before-change-functions and after-change-functions to nil--but in a way that errors don't know about. That way, if there's an error in them, they will stay nil. */ before_change_functions = Vbefore_change_functions; after_change_functions = Vafter_change_functions; Vbefore_change_functions = Qnil; Vafter_change_functions = Qnil; GCPRO2 (before_change_functions, after_change_functions); /* Actually run the hook functions. */ args[0] = Qafter_change_functions; XSETFASTINT (args[1], pos); XSETFASTINT (args[2], pos + lenins); XSETFASTINT (args[3], lendel); run_hook_list_with_args (after_change_functions, 4, args); /* "Unbind" the variables we "bound" to nil. */ Vbefore_change_functions = before_change_functions; Vafter_change_functions = after_change_functions; UNGCPRO; } if (!NILP (current_buffer->overlays_before) || !NILP (current_buffer->overlays_after)) report_overlay_modification (make_number (pos), make_number (pos + lenins - lendel), 1, make_number (pos), make_number (pos + lenins), make_number (lendel)); /* After an insertion, call the text properties insert-behind-hooks or insert-in-front-hooks. */ if (lendel == 0) report_interval_modification (pos, pos + lenins); } emacs-19.30/src/intervals.c100444 12120 1 143511 6025216430 14105 0ustar rmsdaemon/* Code for doing intervals. Copyright (C) 1993, 1994, 1995 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. */ /* NOTES: Have to ensure that we can't put symbol nil on a plist, or some functions may work incorrectly. An idea: Have the owner of the tree keep count of splits and/or insertion lengths (in intervals), and balance after every N. Need to call *_left_hook when buffer is killed. Scan for zero-length, or 0-length to see notes about handling zero length interval-markers. There are comments around about freeing intervals. It might be faster to explicitly free them (put them on the free list) than to GC them. */ #include #include "lisp.h" #include "intervals.h" #include "buffer.h" #include "puresize.h" #include "keyboard.h" /* The rest of the file is within this conditional. */ #ifdef USE_TEXT_PROPERTIES /* Test for membership, allowing for t (actually any non-cons) to mean the universal set. */ #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set)) #define min(x, y) ((x) < (y) ? (x) : (y)) Lisp_Object merge_properties_sticky (); /* Utility functions for intervals. */ /* Create the root interval of some object, a buffer or string. */ INTERVAL create_root_interval (parent) Lisp_Object parent; { INTERVAL new; CHECK_IMPURE (parent); new = make_interval (); if (BUFFERP (parent)) { new->total_length = (BUF_Z (XBUFFER (parent)) - BUF_BEG (XBUFFER (parent))); BUF_INTERVALS (XBUFFER (parent)) = new; } else if (STRINGP (parent)) { new->total_length = XSTRING (parent)->size; XSTRING (parent)->intervals = new; } new->parent = (INTERVAL) parent; new->position = 1; return new; } /* Make the interval TARGET have exactly the properties of SOURCE */ void copy_properties (source, target) register INTERVAL source, target; { if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target)) return; COPY_INTERVAL_CACHE (source, target); target->plist = Fcopy_sequence (source->plist); } /* Merge the properties of interval SOURCE into the properties of interval TARGET. That is to say, each property in SOURCE is added to TARGET if TARGET has no such property as yet. */ static void merge_properties (source, target) register INTERVAL source, target; { register Lisp_Object o, sym, val; if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target)) return; MERGE_INTERVAL_CACHE (source, target); o = source->plist; while (! EQ (o, Qnil)) { sym = Fcar (o); val = Fmemq (sym, target->plist); if (NILP (val)) { o = Fcdr (o); val = Fcar (o); target->plist = Fcons (sym, Fcons (val, target->plist)); o = Fcdr (o); } else o = Fcdr (Fcdr (o)); } } /* Return 1 if the two intervals have the same properties, 0 otherwise. */ int intervals_equal (i0, i1) INTERVAL i0, i1; { register Lisp_Object i0_cdr, i0_sym, i1_val; register i1_len; if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1)) return 1; if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1)) return 0; i1_len = XFASTINT (Flength (i1->plist)); if (i1_len & 0x1) /* Paranoia -- plists are always even */ abort (); i1_len /= 2; i0_cdr = i0->plist; while (!NILP (i0_cdr)) { /* Lengths of the two plists were unequal. */ if (i1_len == 0) return 0; i0_sym = Fcar (i0_cdr); i1_val = Fmemq (i0_sym, i1->plist); /* i0 has something i1 doesn't. */ if (EQ (i1_val, Qnil)) return 0; /* i0 and i1 both have sym, but it has different values in each. */ i0_cdr = Fcdr (i0_cdr); if (! EQ (Fcar (Fcdr (i1_val)), Fcar (i0_cdr))) return 0; i0_cdr = Fcdr (i0_cdr); i1_len--; } /* Lengths of the two plists were unequal. */ if (i1_len > 0) return 0; return 1; } static int icount; static int idepth; static int zero_length; /* Traverse an interval tree TREE, performing FUNCTION on each node. Pass FUNCTION two args: an interval, and ARG. */ void traverse_intervals (tree, position, depth, function, arg) INTERVAL tree; int position, depth; void (* function) (); Lisp_Object arg; { if (NULL_INTERVAL_P (tree)) return; traverse_intervals (tree->left, position, depth + 1, function, arg); position += LEFT_TOTAL_LENGTH (tree); tree->position = position; (*function) (tree, arg); position += LENGTH (tree); traverse_intervals (tree->right, position, depth + 1, function, arg); } #if 0 /* These functions are temporary, for debugging purposes only. */ INTERVAL search_interval, found_interval; void check_for_interval (i) register INTERVAL i; { if (i == search_interval) { found_interval = i; icount++; } } INTERVAL search_for_interval (i, tree) register INTERVAL i, tree; { icount = 0; search_interval = i; found_interval = NULL_INTERVAL; traverse_intervals (tree, 1, 0, &check_for_interval, Qnil); return found_interval; } static void inc_interval_count (i) INTERVAL i; { icount++; if (LENGTH (i) == 0) zero_length++; if (depth > idepth) idepth = depth; } int count_intervals (i) register INTERVAL i; { icount = 0; idepth = 0; zero_length = 0; traverse_intervals (i, 1, 0, &inc_interval_count, Qnil); return icount; } static INTERVAL root_interval (interval) INTERVAL interval; { register INTERVAL i = interval; while (! ROOT_INTERVAL_P (i)) i = i->parent; return i; } #endif /* Assuming that a left child exists, perform the following operation: A B / \ / \ B => A / \ / \ c c */ static INTERVAL rotate_right (interval) INTERVAL interval; { INTERVAL i; INTERVAL B = interval->left; int old_total = interval->total_length; /* Deal with any Parent of A; make it point to B. */ if (! ROOT_INTERVAL_P (interval)) if (AM_LEFT_CHILD (interval)) interval->parent->left = B; else interval->parent->right = B; B->parent = interval->parent; /* Make B the parent of A */ i = B->right; B->right = interval; interval->parent = B; /* Make A point to c */ interval->left = i; if (! NULL_INTERVAL_P (i)) i->parent = interval; /* A's total length is decreased by the length of B and its left child. */ interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval); /* B must have the same total length of A. */ B->total_length = old_total; return B; } /* Assuming that a right child exists, perform the following operation: A B / \ / \ B => A / \ / \ c c */ static INTERVAL rotate_left (interval) INTERVAL interval; { INTERVAL i; INTERVAL B = interval->right; int old_total = interval->total_length; /* Deal with any parent of A; make it point to B. */ if (! ROOT_INTERVAL_P (interval)) if (AM_LEFT_CHILD (interval)) interval->parent->left = B; else interval->parent->right = B; B->parent = interval->parent; /* Make B the parent of A */ i = B->left; B->left = interval; interval->parent = B; /* Make A point to c */ interval->right = i; if (! NULL_INTERVAL_P (i)) i->parent = interval; /* A's total length is decreased by the length of B and its right child. */ interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval); /* B must have the same total length of A. */ B->total_length = old_total; return B; } /* Balance an interval tree with the assumption that the subtrees themselves are already balanced. */ static INTERVAL balance_an_interval (i) INTERVAL i; { register int old_diff, new_diff; while (1) { old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i); if (old_diff > 0) { new_diff = i->total_length - i->left->total_length + RIGHT_TOTAL_LENGTH (i->left) - LEFT_TOTAL_LENGTH (i->left); if (abs (new_diff) >= old_diff) break; i = rotate_right (i); balance_an_interval (i->right); } else if (old_diff < 0) { new_diff = i->total_length - i->right->total_length + LEFT_TOTAL_LENGTH (i->right) - RIGHT_TOTAL_LENGTH (i->right); if (abs (new_diff) >= -old_diff) break; i = rotate_left (i); balance_an_interval (i->left); } else break; } return i; } /* Balance INTERVAL, potentially stuffing it back into its parent Lisp Object. */ static INLINE INTERVAL balance_possible_root_interval (interval) register INTERVAL interval; { Lisp_Object parent; if (interval->parent == NULL_INTERVAL) return interval; parent = (Lisp_Object) (interval->parent); interval = balance_an_interval (interval); if (BUFFERP (parent)) BUF_INTERVALS (XBUFFER (parent)) = interval; else if (STRINGP (parent)) XSTRING (parent)->intervals = interval; return interval; } /* Balance the interval tree TREE. Balancing is by weight (the amount of text). */ static INTERVAL balance_intervals_internal (tree) register INTERVAL tree; { /* Balance within each side. */ if (tree->left) balance_intervals (tree->left); if (tree->right) balance_intervals (tree->right); return balance_an_interval (tree); } /* Advertised interface to balance intervals. */ INTERVAL balance_intervals (tree) INTERVAL tree; { if (tree == NULL_INTERVAL) return NULL_INTERVAL; return balance_intervals_internal (tree); } /* 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 those of the original interval. The property list of the new interval is reset, thus it is up to the caller to do the right thing with the result. Note that this does not change the position of INTERVAL; if it is a root, it is still a root after this operation. */ INTERVAL split_interval_right (interval, offset) INTERVAL interval; int offset; { INTERVAL new = make_interval (); int position = interval->position; int new_length = LENGTH (interval) - offset; new->position = position + offset; new->parent = interval; if (NULL_RIGHT_CHILD (interval)) { interval->right = new; new->total_length = new_length; return new; } /* Insert the new node between INTERVAL and its right child. */ new->right = interval->right; interval->right->parent = new; interval->right = new; new->total_length = new_length + new->right->total_length; balance_an_interval (new); balance_possible_root_interval (interval); return new; } /* 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 those of the original interval. The property list of the new interval is reset, thus it is up to the caller to do the right thing with the result. Note that this does not change the position of INTERVAL; if it is a root, it is still a root after this operation. */ INTERVAL split_interval_left (interval, offset) INTERVAL interval; int offset; { INTERVAL new = make_interval (); int position = interval->position; int new_length = offset; new->position = interval->position; interval->position = interval->position + offset; new->parent = interval; if (NULL_LEFT_CHILD (interval)) { interval->left = new; new->total_length = new_length; return new; } /* Insert the new node between INTERVAL and its left child. */ new->left = interval->left; new->left->parent = new; interval->left = new; new->total_length = new_length + new->left->total_length; balance_an_interval (new); balance_possible_root_interval (interval); return new; } /* Find the interval containing text position POSITION in the text represented by the interval tree TREE. POSITION is a buffer position; the earliest position is 1. If POSITION is at the end of the buffer, return the interval containing the last character. The `position' field, which is a cache of an interval's position, is updated in the interval found. Other functions (e.g., next_interval) will update this cache based on the result of find_interval. */ INLINE INTERVAL find_interval (tree, position) register INTERVAL tree; register int position; { /* The distance from the left edge of the subtree at TREE to POSITION. */ register int relative_position = position - BEG; if (NULL_INTERVAL_P (tree)) return NULL_INTERVAL; if (relative_position > TOTAL_LENGTH (tree)) abort (); /* Paranoia */ tree = balance_possible_root_interval (tree); while (1) { if (relative_position < LEFT_TOTAL_LENGTH (tree)) { tree = tree->left; } else if (! NULL_RIGHT_CHILD (tree) && relative_position >= (TOTAL_LENGTH (tree) - RIGHT_TOTAL_LENGTH (tree))) { relative_position -= (TOTAL_LENGTH (tree) - RIGHT_TOTAL_LENGTH (tree)); tree = tree->right; } else { tree->position = (position - relative_position /* the left edge of *tree */ + LEFT_TOTAL_LENGTH (tree)); /* the left edge of this interval */ return tree; } } } /* Find the succeeding interval (lexicographically) to INTERVAL. Sets the `position' field based on that of INTERVAL (see find_interval). */ INTERVAL next_interval (interval) register INTERVAL interval; { register INTERVAL i = interval; register int next_position; if (NULL_INTERVAL_P (i)) return NULL_INTERVAL; next_position = interval->position + LENGTH (interval); if (! NULL_RIGHT_CHILD (i)) { i = i->right; while (! NULL_LEFT_CHILD (i)) i = i->left; i->position = next_position; return i; } while (! NULL_PARENT (i)) { if (AM_LEFT_CHILD (i)) { i = i->parent; i->position = next_position; return i; } i = i->parent; } return NULL_INTERVAL; } /* Find the preceding interval (lexicographically) to INTERVAL. Sets the `position' field based on that of INTERVAL (see find_interval). */ INTERVAL previous_interval (interval) register INTERVAL interval; { register INTERVAL i; register position_of_previous; if (NULL_INTERVAL_P (interval)) return NULL_INTERVAL; if (! NULL_LEFT_CHILD (interval)) { i = interval->left; while (! NULL_RIGHT_CHILD (i)) i = i->right; i->position = interval->position - LENGTH (i); return i; } i = interval; while (! NULL_PARENT (i)) { if (AM_RIGHT_CHILD (i)) { i = i->parent; i->position = interval->position - LENGTH (i); return i; } i = i->parent; } return NULL_INTERVAL; } #if 0 /* Traverse a path down the interval tree TREE to the interval containing POSITION, adjusting all nodes on the path for an addition of LENGTH characters. Insertion between two intervals (i.e., point == i->position, where i is second interval) means text goes into second interval. Modifications are needed to handle the hungry bits -- after simply finding the interval at position (don't add length going down), if it's the beginning of the interval, get the previous interval and check the hugry bits of both. Then add the length going back up to the root. */ static INTERVAL adjust_intervals_for_insertion (tree, position, length) INTERVAL tree; int position, length; { register int relative_position; register INTERVAL this; if (TOTAL_LENGTH (tree) == 0) /* Paranoia */ abort (); /* If inserting at point-max of a buffer, that position will be out of range */ if (position > TOTAL_LENGTH (tree)) position = TOTAL_LENGTH (tree); relative_position = position; this = tree; while (1) { if (relative_position <= LEFT_TOTAL_LENGTH (this)) { this->total_length += length; this = this->left; } else if (relative_position > (TOTAL_LENGTH (this) - RIGHT_TOTAL_LENGTH (this))) { relative_position -= (TOTAL_LENGTH (this) - RIGHT_TOTAL_LENGTH (this)); this->total_length += length; this = this->right; } else { /* If we are to use zero-length intervals as buffer pointers, then this code will have to change. */ this->total_length += length; this->position = LEFT_TOTAL_LENGTH (this) + position - relative_position + 1; return tree; } } } #endif /* Effect an adjustment corresponding to the addition of LENGTH characters of text. Do this by finding the interval containing POSITION in the interval tree TREE, and then adjusting all of its ancestors by adding LENGTH to them. If POSITION is the first character of an interval, meaning that point is actually between the two intervals, make the new text belong to the interval which is "sticky". If both intervals are "sticky", then make them belong to the left-most interval. Another possibility would be to create a new interval for this text, and make it have the merged properties of both ends. */ static INTERVAL adjust_intervals_for_insertion (tree, position, length) INTERVAL tree; int position, length; { register INTERVAL i; register INTERVAL temp; int eobp = 0; if (TOTAL_LENGTH (tree) == 0) /* Paranoia */ abort (); /* If inserting at point-max of a buffer, that position will be out of range. Remember that buffer positions are 1-based. */ if (position >= BEG + TOTAL_LENGTH (tree)){ position = BEG + TOTAL_LENGTH (tree); eobp = 1; } i = find_interval (tree, position); /* If in middle of an interval which is not sticky either way, we must not just give its properties to the insertion. So split this interval at the insertion point. */ if (! (position == i->position || eobp) && END_NONSTICKY_P (i) && ! FRONT_STICKY_P (i)) { temp = split_interval_right (i, position - i->position); copy_properties (i, temp); i = temp; } /* If we are positioned between intervals, check the stickiness of both of them. We have to do this too, if we are at BEG or Z. */ if (position == i->position || eobp) { register INTERVAL prev; if (position == BEG) prev = 0; else if (eobp) { prev = i; i = 0; } else prev = previous_interval (i); /* Even if we are positioned between intervals, we default to the left one if it exists. We extend it now and split off a part later, if stickyness demands it. */ for (temp = prev ? prev : i;! NULL_INTERVAL_P (temp); temp = temp->parent) { temp->total_length += length; temp = balance_possible_root_interval (temp); } /* If at least one interval has sticky properties, we check the stickyness property by property. */ if (END_NONSTICKY_P (prev) || FRONT_STICKY_P (i)) { Lisp_Object pleft, pright; struct interval newi; pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist; pright = NULL_INTERVAL_P (i) ? Qnil : i->plist; newi.plist = merge_properties_sticky (pleft, pright); if(! prev) /* i.e. position == BEG */ { if (! intervals_equal (i, &newi)) { i = split_interval_left (i, length); i->plist = newi.plist; } } else if (! intervals_equal (prev, &newi)) { prev = split_interval_right (prev, position - prev->position); prev->plist = newi.plist; if (! NULL_INTERVAL_P (i) && intervals_equal (prev, i)) merge_interval_right (prev); } /* We will need to update the cache here later. */ } else if (! prev && ! NILP (i->plist)) { /* Just split off a new interval at the left. Since I wasn't front-sticky, the empty plist is ok. */ i = split_interval_left (i, length); } } /* Otherwise just extend the interval. */ else { for (temp = i; ! NULL_INTERVAL_P (temp); temp = temp->parent) { temp->total_length += length; temp = balance_possible_root_interval (temp); } } return tree; } /* Any property might be front-sticky on the left, rear-sticky on the left, front-sticky on the right, or rear-sticky on the right; the 16 combinations can be arranged in a matrix with rows denoting the left conditions and columns denoting the right conditions: _ __ _ _ FR FR FR FR FR__ 0 1 2 3 _FR 4 5 6 7 FR 8 9 A B FR C D E F left-props = '(front-sticky (p8 p9 pa pb pc pd pe pf) rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb) p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L p8 L p9 L pa L pb L pc L pd L pe L pf L) right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf) rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe) p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R p8 R p9 R pa R pb R pc R pd R pe R pf R) We inherit from whoever has a sticky side facing us. If both sides do (cases 2, 3, E, and F), then we inherit from whichever side has a non-nil value for the current property. If both sides do, then we take from the left. When we inherit a property, we get its stickiness as well as its value. So, when we merge the above two lists, we expect to get this: result = '(front-sticky (p6 p7 pa pb pc pd pe pf) rear-nonsticky (p6 pa) p0 L p1 L p2 L p3 L p6 R p7 R pa R pb R pc L pd L pe L pf L) The optimizable special cases are: left rear-nonsticky = nil, right front-sticky = nil (inherit left) left rear-nonsticky = t, right front-sticky = t (inherit right) left rear-nonsticky = t, right front-sticky = nil (inherit none) */ Lisp_Object merge_properties_sticky (pleft, pright) Lisp_Object pleft, pright; { register Lisp_Object props, front, rear; Lisp_Object lfront, lrear, rfront, rrear; register Lisp_Object tail1, tail2, sym, lval, rval; int use_left, use_right; props = Qnil; front = Qnil; rear = Qnil; lfront = textget (pleft, Qfront_sticky); lrear = textget (pleft, Qrear_nonsticky); rfront = textget (pright, Qfront_sticky); rrear = textget (pright, Qrear_nonsticky); /* Go through each element of PRIGHT. */ for (tail1 = pright; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) { sym = Fcar (tail1); /* Sticky properties get special treatment. */ if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky)) continue; rval = Fcar (Fcdr (tail1)); for (tail2 = pleft; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) if (EQ (sym, Fcar (tail2))) break; lval = (NILP (tail2) ? Qnil : Fcar( Fcdr (tail2))); use_left = ! TMEM (sym, lrear); use_right = TMEM (sym, rfront); if (use_left && use_right) { use_left = ! NILP (lval); use_right = ! NILP (rval); } if (use_left) { /* We build props as (value sym ...) rather than (sym value ...) because we plan to nreverse it when we're done. */ if (! NILP (lval)) props = Fcons (lval, Fcons (sym, props)); if (TMEM (sym, lfront)) front = Fcons (sym, front); if (TMEM (sym, lrear)) rear = Fcons (sym, rear); } else if (use_right) { if (! NILP (rval)) props = Fcons (rval, Fcons (sym, props)); if (TMEM (sym, rfront)) front = Fcons (sym, front); if (TMEM (sym, rrear)) rear = Fcons (sym, rear); } } /* Now go through each element of PLEFT. */ for (tail2 = pleft; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) { sym = Fcar (tail2); /* Sticky properties get special treatment. */ if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky)) continue; /* If sym is in PRIGHT, we've already considered it. */ for (tail1 = pright; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) if (EQ (sym, Fcar (tail1))) break; if (! NILP (tail1)) continue; lval = Fcar (Fcdr (tail2)); /* Since rval is known to be nil in this loop, the test simplifies. */ if (! TMEM (sym, lrear)) { if (! NILP (lval)) props = Fcons (lval, Fcons (sym, props)); if (TMEM (sym, lfront)) front = Fcons (sym, front); } else if (TMEM (sym, rfront)) { /* The value is nil, but we still inherit the stickiness from the right. */ front = Fcons (sym, front); if (TMEM (sym, rrear)) rear = Fcons (sym, rear); } } props = Fnreverse (props); if (! NILP (rear)) props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props)); if (! NILP (front)) props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props)); return props; } /* Delete an node I from its interval tree by merging its subtrees into one subtree which is then returned. Caller is responsible for storing the resulting subtree into its parent. */ static INTERVAL delete_node (i) register INTERVAL i; { register INTERVAL migrate, this; register int migrate_amt; if (NULL_INTERVAL_P (i->left)) return i->right; if (NULL_INTERVAL_P (i->right)) return i->left; migrate = i->left; migrate_amt = i->left->total_length; this = i->right; this->total_length += migrate_amt; while (! NULL_INTERVAL_P (this->left)) { this = this->left; this->total_length += migrate_amt; } this->left = migrate; migrate->parent = this; return i->right; } /* Delete interval I from its tree by calling `delete_node' and properly connecting the resultant subtree. I is presumed to be empty; that is, no adjustments are made for the length of I. */ void delete_interval (i) register INTERVAL i; { register INTERVAL parent; int amt = LENGTH (i); if (amt > 0) /* Only used on zero-length intervals now. */ abort (); if (ROOT_INTERVAL_P (i)) { Lisp_Object owner; owner = (Lisp_Object) i->parent; parent = delete_node (i); if (! NULL_INTERVAL_P (parent)) parent->parent = (INTERVAL) owner; if (BUFFERP (owner)) BUF_INTERVALS (XBUFFER (owner)) = parent; else if (STRINGP (owner)) XSTRING (owner)->intervals = parent; else abort (); return; } parent = i->parent; if (AM_LEFT_CHILD (i)) { parent->left = delete_node (i); if (! NULL_INTERVAL_P (parent->left)) parent->left->parent = parent; } else { parent->right = delete_node (i); if (! NULL_INTERVAL_P (parent->right)) parent->right->parent = parent; } } /* Find the interval in TREE corresponding to the relative position FROM and delete as much as possible of AMOUNT from that interval. Return the amount actually deleted, and if the interval was zeroed-out, delete that interval node from the tree. Note that FROM is actually origin zero, aka relative to the leftmost edge of tree. This is appropriate since we call ourselves recursively on subtrees. Do this by recursing down TREE to the interval in question, and deleting the appropriate amount of text. */ static int interval_deletion_adjustment (tree, from, amount) register INTERVAL tree; register int from, amount; { register int relative_position = from; if (NULL_INTERVAL_P (tree)) return 0; /* Left branch */ if (relative_position < LEFT_TOTAL_LENGTH (tree)) { int subtract = interval_deletion_adjustment (tree->left, relative_position, amount); tree->total_length -= subtract; return subtract; } /* Right branch */ else if (relative_position >= (TOTAL_LENGTH (tree) - RIGHT_TOTAL_LENGTH (tree))) { int subtract; relative_position -= (tree->total_length - RIGHT_TOTAL_LENGTH (tree)); subtract = interval_deletion_adjustment (tree->right, relative_position, amount); tree->total_length -= subtract; return subtract; } /* Here -- this node. */ else { /* How much can we delete from this interval? */ int my_amount = ((tree->total_length - RIGHT_TOTAL_LENGTH (tree)) - relative_position); if (amount > my_amount) amount = my_amount; tree->total_length -= amount; if (LENGTH (tree) == 0) delete_interval (tree); return amount; } /* Never reach here. */ } /* Effect the adjustments necessary to the interval tree of BUFFER to correspond to the deletion of LENGTH characters from that buffer text. The deletion is effected at position START (which is a buffer position, i.e. origin 1). */ static void adjust_intervals_for_deletion (buffer, start, length) struct buffer *buffer; int start, length; { register int left_to_delete = length; register INTERVAL tree = BUF_INTERVALS (buffer); register int deleted; if (NULL_INTERVAL_P (tree)) return; if (start > BEG + TOTAL_LENGTH (tree) || start + length > BEG + TOTAL_LENGTH (tree)) abort (); if (length == TOTAL_LENGTH (tree)) { BUF_INTERVALS (buffer) = NULL_INTERVAL; return; } if (ONLY_INTERVAL_P (tree)) { tree->total_length -= length; return; } if (start > BEG + TOTAL_LENGTH (tree)) start = BEG + TOTAL_LENGTH (tree); while (left_to_delete > 0) { left_to_delete -= interval_deletion_adjustment (tree, start - 1, left_to_delete); tree = BUF_INTERVALS (buffer); if (left_to_delete == tree->total_length) { BUF_INTERVALS (buffer) = NULL_INTERVAL; return; } } } /* Make the adjustments necessary to the interval tree of BUFFER to represent an addition or deletion of LENGTH characters starting at position START. Addition or deletion is indicated by the sign of LENGTH. */ INLINE void offset_intervals (buffer, start, length) struct buffer *buffer; int start, length; { if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0) return; if (length > 0) adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length); else adjust_intervals_for_deletion (buffer, start, -length); } /* Merge interval I with its lexicographic successor. The resulting interval is returned, and has the properties of the original successor. The properties of I are lost. I is removed from the interval tree. IMPORTANT: The caller must verify that this is not the last (rightmost) interval. */ INTERVAL merge_interval_right (i) register INTERVAL i; { register int absorb = LENGTH (i); register INTERVAL successor; /* Zero out this interval. */ i->total_length -= absorb; /* Find the succeeding interval. */ if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb as we descend. */ { successor = i->right; while (! NULL_LEFT_CHILD (successor)) { successor->total_length += absorb; successor = successor->left; } successor->total_length += absorb; delete_interval (i); return successor; } successor = i; while (! NULL_PARENT (successor)) /* It's above us. Subtract as we ascend. */ { if (AM_LEFT_CHILD (successor)) { successor = successor->parent; delete_interval (i); return successor; } successor = successor->parent; successor->total_length -= absorb; } /* This must be the rightmost or last interval and cannot be merged right. The caller should have known. */ abort (); } /* Merge interval I with its lexicographic predecessor. The resulting interval is returned, and has the properties of the original predecessor. The properties of I are lost. Interval node I is removed from the tree. IMPORTANT: The caller must verify that this is not the first (leftmost) interval. */ INTERVAL merge_interval_left (i) register INTERVAL i; { register int absorb = LENGTH (i); register INTERVAL predecessor; /* Zero out this interval. */ i->total_length -= absorb; /* Find the preceding interval. */ if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down, adding ABSORB as we go. */ { predecessor = i->left; while (! NULL_RIGHT_CHILD (predecessor)) { predecessor->total_length += absorb; predecessor = predecessor->right; } predecessor->total_length += absorb; delete_interval (i); return predecessor; } predecessor = i; while (! NULL_PARENT (predecessor)) /* It's above us. Go up, subtracting ABSORB. */ { if (AM_RIGHT_CHILD (predecessor)) { predecessor = predecessor->parent; delete_interval (i); return predecessor; } predecessor = predecessor->parent; predecessor->total_length -= absorb; } /* This must be the leftmost or first interval and cannot be merged left. The caller should have known. */ abort (); } /* Make an exact copy of interval tree SOURCE which descends from PARENT. This is done by recursing through SOURCE, copying the current interval and its properties, and then adjusting the pointers of the copy. */ static INTERVAL reproduce_tree (source, parent) INTERVAL source, parent; { register INTERVAL t = make_interval (); bcopy (source, t, INTERVAL_SIZE); copy_properties (source, t); t->parent = parent; if (! NULL_LEFT_CHILD (source)) t->left = reproduce_tree (source->left, t); if (! NULL_RIGHT_CHILD (source)) t->right = reproduce_tree (source->right, t); return t; } #if 0 /* Nobody calls this. Perhaps it's a vestige of an earlier design. */ /* Make a new interval of length LENGTH starting at START in the group of intervals INTERVALS, which is actually an interval tree. Returns the new interval. Generate an error if the new positions would overlap an existing interval. */ static INTERVAL make_new_interval (intervals, start, length) INTERVAL intervals; int start, length; { INTERVAL slot; slot = find_interval (intervals, start); if (start + length > slot->position + LENGTH (slot)) error ("Interval would overlap"); if (start == slot->position && length == LENGTH (slot)) return slot; if (slot->position == start) { /* New right node. */ split_interval_right (slot, length); return slot; } if (slot->position + LENGTH (slot) == start + length) { /* 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; } #endif /* Insert the intervals of SOURCE into BUFFER at POSITION. LENGTH is the length of the text in SOURCE. 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, and we don't want to inherit the surrounding text's properties, this function simply returns -- offset_intervals should handle placing the text in the correct interval, depending on the sticky bits. If the inserted text had properties (intervals), then there are two cases -- either insertion happened in the middle of some interval, or between two intervals. If the text goes into the middle of an interval, then new intervals are created in the middle with only the properties of the new text, *unless* the macro MERGE_INSERTIONS is true, in which case the new text has the union of its properties and those of the text into which it was inserted. If the text goes between two intervals, then if neither interval had its appropriate sticky property set (front_sticky, rear_sticky), the new text has only its properties. If one of the sticky properties is set, then the new text "sticks" to that region and its properties depend on merging as above. If both the preceding and succeeding intervals to the new text are "sticky", then the new text retains only its properties, as if neither sticky property were set. Perhaps we should consider merging all three sets of properties onto the new text... */ void graft_intervals_into_buffer (source, position, length, buffer, inherit) INTERVAL source; int position, length; struct buffer *buffer; int inherit; { register INTERVAL under, over, this, prev; register INTERVAL tree; int middle; tree = BUF_INTERVALS (buffer); /* If the new text has no properties, it becomes part of whatever interval it was inserted into. */ if (NULL_INTERVAL_P (source)) { Lisp_Object buf; if (!inherit && ! NULL_INTERVAL_P (tree)) { XSETBUFFER (buf, buffer); Fset_text_properties (make_number (position), make_number (position + length), Qnil, buf); } if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer))) BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer)); return; } if (NULL_INTERVAL_P (tree)) { /* The inserted text constitutes the whole buffer, so simply copy over the interval structure. */ if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source)) { Lisp_Object buf; XSETBUFFER (buf, buffer); BUF_INTERVALS (buffer) = reproduce_tree (source, buf); /* Explicitly free the old tree here. */ return; } /* Create an interval tree in which to place a copy of the intervals of the inserted string. */ { Lisp_Object buf; XSETBUFFER (buf, buffer); tree = create_root_interval (buf); } } else if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (source)) /* If the buffer contains only the new string, but there was already some interval tree there, then it may be some zero length intervals. Eventually, do something clever about inserting properly. For now, just waste the old intervals. */ { BUF_INTERVALS (buffer) = reproduce_tree (source, tree->parent); /* Explicitly free the old tree here. */ return; } /* Paranoia -- the text has already been added, so this buffer should be of non-zero length. */ else if (TOTAL_LENGTH (tree) == 0) abort (); this = under = find_interval (tree, position); if (NULL_INTERVAL_P (under)) /* Paranoia */ abort (); over = find_interval (source, 1); /* Here for insertion in the middle of an interval. Split off an equivalent interval to the right, then don't bother with it any more. */ if (position > under->position) { INTERVAL end_unchanged = split_interval_left (this, position - under->position); copy_properties (under, end_unchanged); under->position = position; prev = 0; middle = 1; } else { prev = previous_interval (under); if (prev && !END_NONSTICKY_P (prev)) prev = 0; } /* Insertion is now at beginning of UNDER. */ /* The inserted text "sticks" to the interval `under', which means it gets those properties. The properties of under are the result of adjust_intervals_for_insertion, so stickyness has already been taken care of. */ while (! NULL_INTERVAL_P (over)) { if (LENGTH (over) < LENGTH (under)) { this = split_interval_left (under, LENGTH (over)); copy_properties (under, this); } else this = under; copy_properties (over, this); if (inherit) merge_properties (over, this); else copy_properties (over, this); over = next_interval (over); } if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer))) BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer)); return; } /* Get the value of property PROP from PLIST, which is the plist of an interval. We check for direct properties, for categories with property PROP, and for PROP appearing on the default-text-properties list. */ Lisp_Object textget (plist, prop) Lisp_Object plist; register Lisp_Object prop; { register Lisp_Object tail, fallback; fallback = Qnil; for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail))) { register Lisp_Object tem; tem = Fcar (tail); if (EQ (prop, tem)) return Fcar (Fcdr (tail)); if (EQ (tem, Qcategory)) { tem = Fcar (Fcdr (tail)); if (SYMBOLP (tem)) fallback = Fget (tem, prop); } } if (! NILP (fallback)) return fallback; if (CONSP (Vdefault_text_properties)) return Fplist_get (Vdefault_text_properties, prop); return Qnil; } /* Set point in BUFFER to POSITION. If the target position is before an intangible character, move to an ok place. */ void set_point (position, buffer) register int position; register struct buffer *buffer; { register INTERVAL to, from, toprev, fromprev, target; int buffer_point; register Lisp_Object obj; int backwards = (position < BUF_PT (buffer)) ? 1 : 0; int old_position = BUF_PT (buffer); buffer->point_before_scroll = Qnil; if (position == BUF_PT (buffer)) return; /* Check this now, before checking if the buffer has any intervals. That way, we can catch conditions which break this sanity check whether or not there are intervals in the buffer. */ if (position > BUF_Z (buffer) || position < BUF_BEG (buffer)) abort (); if (NULL_INTERVAL_P (BUF_INTERVALS (buffer))) { BUF_PT (buffer) = position; return; } /* Set TO to the interval containing the char after POSITION, and TOPREV to the interval containing the char before POSITION. Either one may be null. They may be equal. */ to = find_interval (BUF_INTERVALS (buffer), position); if (position == BUF_BEGV (buffer)) toprev = 0; else if (to->position == position) toprev = previous_interval (to); else toprev = to; buffer_point = (BUF_PT (buffer) == BUF_ZV (buffer) ? BUF_ZV (buffer) - 1 : BUF_PT (buffer)); /* Set FROM to the interval containing the char after PT, and FROMPREV to the interval containing the char before PT. Either one may be null. They may be equal. */ /* We could cache this and save time. */ from = find_interval (BUF_INTERVALS (buffer), buffer_point); if (buffer_point == BUF_BEGV (buffer)) fromprev = 0; else if (from->position == BUF_PT (buffer)) fromprev = previous_interval (from); else if (buffer_point != BUF_PT (buffer)) fromprev = from, from = 0; else fromprev = from; /* Moving within an interval. */ if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to)) { BUF_PT (buffer) = position; return; } /* If the new position is between two intangible characters with the same intangible property value, move forward or backward until a change in that property. */ if (NILP (Vinhibit_point_motion_hooks) && ! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev)) { if (backwards) { Lisp_Object intangible_propval; intangible_propval = textget (to->plist, Qintangible); /* If following char is intangible, skip back over all chars with matching intangible property. */ if (! NILP (intangible_propval)) while (to == toprev || ((! NULL_INTERVAL_P (toprev) && EQ (textget (toprev->plist, Qintangible), intangible_propval)))) { to = toprev; toprev = previous_interval (toprev); if (NULL_INTERVAL_P (toprev)) position = BUF_BEGV (buffer); else /* This is the only line that's not dual to the following loop. That's because we want the position at the end of TOPREV. */ position = to->position; } } else { Lisp_Object intangible_propval; intangible_propval = textget (toprev->plist, Qintangible); /* If previous char is intangible, skip fwd over all chars with matching intangible property. */ if (! NILP (intangible_propval)) while (to == toprev || ((! NULL_INTERVAL_P (to) && EQ (textget (to->plist, Qintangible), intangible_propval)))) { toprev = to; to = next_interval (to); if (NULL_INTERVAL_P (to)) position = BUF_ZV (buffer); else position = to->position; } } } /* Here TO is the interval after the stopping point and TOPREV is the interval before the stopping point. One or the other may be null. */ BUF_PT (buffer) = position; /* We run point-left and point-entered hooks here, iff the two intervals are not equivalent. These hooks take (old_point, new_point) as arguments. */ if (NILP (Vinhibit_point_motion_hooks) && (! intervals_equal (from, to) || ! intervals_equal (fromprev, toprev))) { Lisp_Object leave_after, leave_before, enter_after, enter_before; if (fromprev) leave_after = textget (fromprev->plist, Qpoint_left); else leave_after = Qnil; if (from) leave_before = textget (from->plist, Qpoint_left); else leave_before = Qnil; if (toprev) enter_after = textget (toprev->plist, Qpoint_entered); else enter_after = Qnil; if (to) enter_before = textget (to->plist, Qpoint_entered); else enter_before = Qnil; if (! EQ (leave_before, enter_before) && !NILP (leave_before)) call2 (leave_before, old_position, position); if (! EQ (leave_after, enter_after) && !NILP (leave_after)) call2 (leave_after, old_position, position); if (! EQ (enter_before, leave_before) && !NILP (enter_before)) call2 (enter_before, old_position, position); if (! EQ (enter_after, leave_after) && !NILP (enter_after)) call2 (enter_after, old_position, position); } } /* Set point temporarily, without checking any text properties. */ INLINE void temp_set_point (position, buffer) int position; struct buffer *buffer; { BUF_PT (buffer) = position; } /* Return the proper local map for position POSITION in BUFFER. Use the map specified by the local-map property, if any. Otherwise, use BUFFER's local map. */ Lisp_Object get_local_map (position, buffer) register int position; register struct buffer *buffer; { Lisp_Object prop, tem, lispy_position, lispy_buffer; int old_begv, old_zv; /* Perhaps we should just change `position' to the limit. */ if (position > BUF_Z (buffer) || position < BUF_BEG (buffer)) abort (); /* Ignore narrowing, so that a local map continues to be valid even if the visible region contains no characters and hence no properties. */ old_begv = BUF_BEGV (buffer); old_zv = BUF_ZV (buffer); BUF_BEGV (buffer) = BUF_BEG (buffer); BUF_ZV (buffer) = BUF_Z (buffer); /* There are no properties at the end of the buffer, so in that case check for a local map on the last character of the buffer instead. */ if (position == BUF_Z (buffer) && BUF_Z (buffer) > BUF_BEG (buffer)) --position; XSETFASTINT (lispy_position, position); XSETBUFFER (lispy_buffer, buffer); prop = Fget_char_property (lispy_position, Qlocal_map, lispy_buffer); BUF_BEGV (buffer) = old_begv; BUF_ZV (buffer) = old_zv; /* Use the local map only if it is valid. */ if (!NILP (prop) && (tem = Fkeymapp (prop), !NILP (tem))) return prop; return buffer->keymap; } /* Produce an interval tree reflecting the intervals in TREE from START to START + LENGTH. */ INTERVAL copy_intervals (tree, start, length) INTERVAL tree; int start, length; { register INTERVAL i, new, t; register int got, prevlen; if (NULL_INTERVAL_P (tree) || length <= 0) return NULL_INTERVAL; i = find_interval (tree, start); if (NULL_INTERVAL_P (i) || LENGTH (i) == 0) abort (); /* If there is only one interval and it's the default, return nil. */ if ((start - i->position + 1 + length) < LENGTH (i) && DEFAULT_INTERVAL_P (i)) return NULL_INTERVAL; new = make_interval (); new->position = 1; got = (LENGTH (i) - (start - i->position)); new->total_length = length; copy_properties (i, new); t = new; prevlen = got; while (got < length) { i = next_interval (i); t = split_interval_right (t, prevlen); copy_properties (i, t); prevlen = LENGTH (i); got += prevlen; } return balance_an_interval (new); } /* Give STRING the properties of BUFFER from POSITION to LENGTH. */ INLINE void copy_intervals_to_string (string, buffer, position, length) Lisp_Object string, buffer; int position, length; { INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (XBUFFER (buffer)), position, length); if (NULL_INTERVAL_P (interval_copy)) return; interval_copy->parent = (INTERVAL) string; XSTRING (string)->intervals = interval_copy; } /* Return 1 if string S1 and S2 have identical properties; 0 otherwise. Assume they have identical characters. */ int compare_string_intervals (s1, s2) Lisp_Object s1, s2; { INTERVAL i1, i2; int pos = 1; int end = XSTRING (s1)->size + 1; /* We specify 1 as position because the interval functions always use positions starting at 1. */ i1 = find_interval (XSTRING (s1)->intervals, 1); i2 = find_interval (XSTRING (s2)->intervals, 1); while (pos < end) { /* Determine how far we can go before we reach the end of I1 or I2. */ int len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos; int len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos; int distance = min (len1, len2); /* If we ever find a mismatch between the strings, they differ. */ if (! intervals_equal (i1, i2)) return 0; /* Advance POS till the end of the shorter interval, and advance one or both interval pointers for the new position. */ pos += distance; if (len1 == distance) i1 = next_interval (i1); if (len2 == distance) i2 = next_interval (i2); } return 1; } #endif /* USE_TEXT_PROPERTIES */ emacs-19.30/src/keyboard.c100444 12120 1 670631 6055443127 13716 0ustar rmsdaemon/* Keyboard and mouse input; editor command loop. Copyright (C) 1985,86,87,88,89,93,94,95 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. */ /* Allow config.h to undefine symbols found here. */ #include #include #include #include "termchar.h" #include "termopts.h" #include "lisp.h" #include "termhooks.h" #include "macros.h" #include "frame.h" #include "window.h" #include "commands.h" #include "buffer.h" #include "disptab.h" #include "dispextern.h" #include "keyboard.h" #include "intervals.h" #include "blockinput.h" #include #include #ifdef MSDOS #include "msdos.h" #include #else /* not MSDOS */ #ifndef VMS #include #endif #endif /* not MSDOS */ #include "syssignal.h" #include "systty.h" /* This is to get the definitions of the XK_ symbols. */ #ifdef HAVE_X_WINDOWS #include "xterm.h" #endif #ifdef HAVE_NTGUI #include "w32term.h" #endif /* HAVE_NTGUI */ /* Include systime.h after xterm.h to avoid double inclusion of time.h. */ #include "systime.h" extern int errno; /* Variables for blockinput.h: */ /* Non-zero if interrupt input is blocked right now. */ int interrupt_input_blocked; /* Nonzero means an input interrupt has arrived during the current critical section. */ int interrupt_input_pending; /* File descriptor to use for input. */ extern int input_fd; #ifdef HAVE_WINDOW_SYSTEM /* Make all keyboard buffers much bigger when using X windows. */ #define KBD_BUFFER_SIZE 4096 #else /* No X-windows, character input */ #define KBD_BUFFER_SIZE 256 #endif /* No X-windows */ /* Following definition copied from eval.c */ struct backtrace { struct backtrace *next; Lisp_Object *function; Lisp_Object *args; /* Points to vector of args. */ int nargs; /* length of vector. If nargs is UNEVALLED, args points to slot holding list of unevalled args */ char evalargs; }; #ifdef MULTI_KBOARD KBOARD *initial_kboard; KBOARD *current_kboard; KBOARD *all_kboards; int single_kboard; #else KBOARD the_only_kboard; #endif /* 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) int recent_keys_index; /* Index for storing next element into recent_keys */ int total_keys; /* Total number of elements stored into recent_keys */ Lisp_Object recent_keys; /* A vector, holding the last 100 keystrokes */ /* Vector holding the key sequence that invoked the current command. It is reused for each command, and it may be longer than the current sequence; this_command_key_count indicates how many elements actually mean something. It's easier to staticpro a single Lisp_Object than an array. */ Lisp_Object this_command_keys; int this_command_key_count; /* Record values of this_command_key_count and echo_length () before this command was read. */ static int before_command_key_count; static int before_command_echo_length; /* Values of before_command_key_count and before_command_echo_length saved by reset-this-command-lengths. */ static int before_command_key_count_1; static int before_command_echo_length_1; /* Flag set by reset-this-command-lengths, saying to reset the lengths when add_command_key is called. */ static int before_command_restore_flag; extern int minbuf_level; extern struct backtrace *backtrace_list; /* Nonzero means do menu prompting. */ static int menu_prompting; /* Character to see next line of menu prompt. */ static Lisp_Object menu_prompt_more_char; /* For longjmp to where kbd input is being done. */ static jmp_buf getcjmp; /* True while doing kbd input. */ int waiting_for_input; /* True while displaying for echoing. Delays C-g throwing. */ static int echoing; /* True means we can start echoing at the next input pause even though there is something in the echo area. */ static char *ok_to_echo_at_next_pause; /* Nonzero means disregard local maps for the menu bar. */ static int inhibit_local_menu_bar_menus; /* Nonzero means C-g should cause immediate error-signal. */ int immediate_quit; /* Character to recognize as the help char. */ Lisp_Object Vhelp_char; /* List of other event types to recognize as meaning "help". */ Lisp_Object Vhelp_event_list; /* Form to execute when help char is typed. */ Lisp_Object Vhelp_form; /* Command to run when the help character follows a prefix key. */ Lisp_Object Vprefix_help_command; /* List of items that should move to the end of the menu bar. */ Lisp_Object Vmenu_bar_final_items; /* Non-nil means show the equivalent key-binding for any M-x command that has one. The value can be a length of time to show the message for. If the value is non-nil and not a number, we wait 2 seconds. */ Lisp_Object Vsuggest_key_bindings; /* Character that causes a quit. Normally C-g. If we are running on an ordinary terminal, this must be an ordinary ASCII char, since we want to make it our interrupt character. If we are not running on an ordinary terminal, it still needs to be an ordinary ASCII char. This character needs to be recognized in the input interrupt handler. At this point, the keystroke is represented as a struct input_event, while the desired quit character is specified as a lispy event. The mapping from struct input_events to lispy events cannot run in an interrupt handler, and the reverse mapping is difficult for anything but ASCII keystrokes. FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an ASCII character. */ int quit_char; extern Lisp_Object current_global_map; extern int minibuf_level; /* If non-nil, this is a map that overrides all other local maps. */ Lisp_Object Voverriding_local_map; /* If non-nil, Voverriding_local_map applies to the menu bar. */ Lisp_Object Voverriding_local_map_menu_flag; /* Keymap that defines special misc events that should be processed immediately at a low level. */ Lisp_Object Vspecial_event_map; /* Current depth in recursive edits. */ int command_loop_level; /* Total number of times command_loop has read a key sequence. */ int num_input_keys; /* Last input character read as a command. */ Lisp_Object last_command_char; /* Last input character read as a command, not counting menus reached by the mouse. */ Lisp_Object last_nonmenu_event; /* Last input character read for any purpose. */ Lisp_Object last_input_char; /* If not Qnil, a list of objects to be read as subsequent command input. */ Lisp_Object Vunread_command_events; /* If not -1, an event to be read as subsequent command input. */ int unread_command_char; /* If not Qnil, this is a switch-frame event which we decided to put off until the end of a key sequence. This should be read as the next command input, after any unread_command_events. read_key_sequence uses this to delay switch-frame events until the end of the key sequence; Fread_char uses it to put off switch-frame events until a non-ASCII event is acceptable as input. */ Lisp_Object unread_switch_frame; /* A mask of extra modifier bits to put into every keyboard char. */ int extra_keyboard_modifiers; /* Char to use as prefix when a meta character is typed in. This is bound on entry to minibuffer in case ESC is changed there. */ Lisp_Object meta_prefix_char; /* Last size recorded for a current buffer which is not a minibuffer. */ static int last_non_minibuf_size; /* Number of idle seconds before an auto-save and garbage collection. */ static Lisp_Object Vauto_save_timeout; /* Total number of times read_char has returned. */ int num_input_chars; /* Total number of times read_char has returned, outside of macros. */ int num_nonmacro_input_chars; /* Auto-save automatically when this many characters have been typed since the last time. */ static int auto_save_interval; /* Value of num_nonmacro_input_chars as of last auto save. */ int last_auto_save; /* The command being executed by the command loop. Commands may set this, and the value set will be copied into current_kboard->Vlast_command instead of the actual command. */ Lisp_Object this_command; /* The value of point when the last command was executed. */ int last_point_position; /* The buffer that was current when the last command was started. */ Lisp_Object last_point_position_buffer; #ifdef MULTI_FRAME /* The frame in which the last input event occurred, or Qmacro if the last event came from a macro. We use this to determine when to generate switch-frame events. This may be cleared by functions like Fselect_frame, to make sure that a switch-frame event is generated by the next character. */ Lisp_Object internal_last_event_frame; #endif /* A user-visible version of the above, intended to allow users to figure out where the last event came from, if the event doesn't carry that information itself (i.e. if it was a character). */ Lisp_Object Vlast_event_frame; /* The timestamp of the last input event we received from the X server. X Windows wants this for selection ownership. */ unsigned long last_event_timestamp; Lisp_Object Qself_insert_command; Lisp_Object Qforward_char; Lisp_Object Qbackward_char; Lisp_Object Qundefined; /* read_key_sequence stores here the command definition of the key sequence that it reads. */ Lisp_Object read_key_sequence_cmd; /* Form to evaluate (if non-nil) when Emacs is started. */ Lisp_Object Vtop_level; /* User-supplied string to translate input characters through. */ Lisp_Object Vkeyboard_translate_table; /* Keymap mapping ASCII function key sequences onto their preferred forms. */ extern Lisp_Object Vfunction_key_map; /* Another keymap that maps key sequences into key sequences. This one takes precedence over ordinary definitions. */ extern Lisp_Object Vkey_translation_map; /* Non-nil means deactivate the mark at end of this command. */ Lisp_Object Vdeactivate_mark; /* Menu bar specified in Lucid Emacs fashion. */ Lisp_Object Vlucid_menu_bar_dirty_flag; Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook; /* Hooks to run before and after each command. */ Lisp_Object Qpre_command_hook, Vpre_command_hook; Lisp_Object Qpost_command_hook, Vpost_command_hook; Lisp_Object Qcommand_hook_internal, Vcommand_hook_internal; /* Hook run after a command if there's no more input soon. */ Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook; /* Delay time in microseconds before running post-command-idle-hook. */ int post_command_idle_delay; /* List of deferred actions to be performed at a later time. The precise format isn't relevant here; we just check whether it is nil. */ Lisp_Object Vdeferred_action_list; /* Function to call to handle deferred actions, when there are any. */ Lisp_Object Vdeferred_action_function; Lisp_Object Qdeferred_action_function; /* File in which we write all commands we read. */ FILE *dribble; /* Nonzero if input is available. */ int input_pending; /* 1 if should obey 0200 bit in input chars as "Meta", 2 if should keep 0200 bit in input chars. 0 to ignore the 0200 bit. */ int meta_key; extern char *pending_malloc_warning; /* Circular buffer for pre-read keyboard input. */ static struct input_event kbd_buffer[KBD_BUFFER_SIZE]; /* Vector to GCPRO the frames and windows mentioned in kbd_buffer. The interrupt-level event handlers will never enqueue an event on a frame which is not in Vframe_list, and once an event is dequeued, internal_last_event_frame or the event itself points to the frame. So that's all fine. But while the event is sitting in the queue, it's completely unprotected. Suppose the user types one command which will run for a while and then delete a frame, and then types another event at the frame that will be deleted, before the command gets around to it. Suppose there are no references to this frame elsewhere in Emacs, and a GC occurs before the second event is dequeued. Now we have an event referring to a freed frame, which will crash Emacs when it is dequeued. Similar things happen when an event on a scroll bar is enqueued; the window may be deleted while the event is in the queue. So, we use this vector to protect the frame_or_window field in the event queue. That way, they'll be dequeued as dead frames or windows, but still valid lisp objects. If kbd_buffer[i].kind != no_event, then (XVECTOR (kbd_buffer_frame_or_window)->contents[i] == kbd_buffer[i].frame_or_window. */ static Lisp_Object kbd_buffer_frame_or_window; /* Pointer to next available character in kbd_buffer. If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty. This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the the next available char is in kbd_buffer[0]. */ static struct input_event *kbd_fetch_ptr; /* Pointer to next place to store character in kbd_buffer. This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next character should go in kbd_buffer[0]. */ static volatile struct input_event *kbd_store_ptr; /* The above pair of variables forms a "queue empty" flag. When we enqueue a non-hook event, we increment kbd_store_ptr. When we dequeue a non-hook event, we increment kbd_fetch_ptr. We say that there is input available iff the two pointers are not equal. Why not just have a flag set and cleared by the enqueuing and dequeuing functions? Such a flag could be screwed up by interrupts at inopportune times. */ /* If this flag is non-nil, we check mouse_moved to see when the mouse moves, and motion events will appear in the input stream. Otherwise, mouse motion is ignored. */ static Lisp_Object do_mouse_tracking; /* Symbols to head events. */ Lisp_Object Qmouse_movement; Lisp_Object Qscroll_bar_movement; Lisp_Object Qswitch_frame; Lisp_Object Qdelete_frame; Lisp_Object Qiconify_frame; Lisp_Object Qmake_frame_visible; /* Symbols to denote kinds of events. */ Lisp_Object Qfunction_key; Lisp_Object Qmouse_click; /* Lisp_Object Qmouse_movement; - also an event header */ /* Properties of event headers. */ Lisp_Object Qevent_kind; Lisp_Object Qevent_symbol_elements; Lisp_Object Qmenu_enable; /* An event header symbol HEAD may have a property named Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS); BASE is the base, unmodified version of HEAD, and MODIFIERS is the mask of modifiers applied to it. If present, this is used to help speed up parse_modifiers. */ Lisp_Object Qevent_symbol_element_mask; /* An unmodified event header BASE may have a property named Qmodifier_cache, which is an alist mapping modifier masks onto modified versions of BASE. If present, this helps speed up apply_modifiers. */ Lisp_Object Qmodifier_cache; /* Symbols to use for parts of windows. */ Lisp_Object Qmode_line; Lisp_Object Qvertical_line; Lisp_Object Qvertical_scroll_bar; Lisp_Object Qmenu_bar; extern Lisp_Object Qmenu_enable; Lisp_Object recursive_edit_unwind (), command_loop (); Lisp_Object Fthis_command_keys (); Lisp_Object Qextended_command_history; extern char *x_get_keysym_name (); Lisp_Object Qpolling_period; extern Lisp_Object Vprint_level, Vprint_length; /* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt happens. */ EMACS_TIME *input_available_clear_time; /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode. Default is 1 if INTERRUPT_INPUT is defined. */ int interrupt_input; /* Nonzero while interrupts are temporarily deferred during redisplay. */ int interrupts_deferred; /* nonzero means use ^S/^Q for flow control. */ int flow_control; /* Allow m- file to inhibit use of FIONREAD. */ #ifdef BROKEN_FIONREAD #undef FIONREAD #endif /* We are unable to use interrupts if FIONREAD is not available, so flush SIGIO so we won't try. */ #ifndef FIONREAD #ifdef SIGIO #undef SIGIO #endif #endif /* If we support a window system, turn on the code to poll periodically to detect C-g. It isn't actually used when doing interrupt input. */ #ifdef HAVE_WINDOW_SYSTEM #define POLL_FOR_INPUT #endif /* Non-nil enables Column Number mode. */ Lisp_Object Vcolumn_number_mode; /* Global variable declarations. */ /* Function for init_keyboard to call with no args (if nonzero). */ void (*keyboard_init_hook) (); static int read_avail_input (); static void get_input_pending (); static int readable_events (); static Lisp_Object read_char_x_menu_prompt (); static Lisp_Object read_char_minibuf_menu_prompt (); static Lisp_Object make_lispy_event (); #ifdef HAVE_MOUSE static Lisp_Object make_lispy_movement (); #endif static Lisp_Object modify_event_symbol (); static Lisp_Object make_lispy_switch_frame (); static int parse_solitary_modifier (); /* > 0 if we are to echo keystrokes. */ static int echo_keystrokes; /* Nonzero means don't try to suspend even if the operating system seems to support it. */ static int cannot_suspend; #define min(a,b) ((a)<(b)?(a):(b)) #define max(a,b) ((a)>(b)?(a):(b)) /* Install the string STR as the beginning of the string of echoing, so that it serves as a prompt for the next character. Also start echoing. */ echo_prompt (str) char *str; { int len = strlen (str); if (len > ECHOBUFSIZE - 4) len = ECHOBUFSIZE - 4; bcopy (str, current_kboard->echobuf, len); current_kboard->echoptr = current_kboard->echobuf + len; *current_kboard->echoptr = '\0'; current_kboard->echo_after_prompt = len; echo (); } /* Add C to the echo string, if echoing is going on. C can be a character, which is printed prettily ("M-C-x" and all that jazz), or a symbol, whose name is printed. */ echo_char (c) Lisp_Object c; { extern char *push_key_description (); if (current_kboard->immediate_echo) { char *ptr = current_kboard->echoptr; if (ptr != current_kboard->echobuf) *ptr++ = ' '; /* If someone has passed us a composite event, use its head symbol. */ c = EVENT_HEAD (c); if (INTEGERP (c)) { if (ptr - current_kboard->echobuf > ECHOBUFSIZE - 6) return; ptr = push_key_description (XINT (c), ptr); } else if (SYMBOLP (c)) { struct Lisp_String *name = XSYMBOL (c)->name; if ((ptr - current_kboard->echobuf) + name->size + 4 > ECHOBUFSIZE) return; bcopy (name->data, ptr, name->size); ptr += name->size; } if (current_kboard->echoptr == current_kboard->echobuf && help_char_p (c)) { strcpy (ptr, " (Type ? for further options)"); ptr += strlen (ptr); } *ptr = 0; current_kboard->echoptr = ptr; echo (); } } /* Temporarily add a dash to the end of the echo string if it's not empty, so that it serves as a mini-prompt for the very next character. */ echo_dash () { if (!current_kboard->immediate_echo && current_kboard->echoptr == current_kboard->echobuf) return; /* Do nothing if we just printed a prompt. */ if (current_kboard->echo_after_prompt == current_kboard->echoptr - current_kboard->echobuf) return; /* Do nothing if not echoing at all. */ if (current_kboard->echoptr == 0) return; /* Put a dash at the end of the buffer temporarily, but make it go away when the next character is added. */ current_kboard->echoptr[0] = '-'; current_kboard->echoptr[1] = 0; echo (); } /* Display the current echo string, and begin echoing if not already doing so. */ echo () { if (!current_kboard->immediate_echo) { int i; current_kboard->immediate_echo = 1; for (i = 0; i < this_command_key_count; i++) { Lisp_Object c; c = XVECTOR (this_command_keys)->contents[i]; if (! (EVENT_HAS_PARAMETERS (c) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement))) echo_char (c); } echo_dash (); } echoing = 1; message1_nolog (current_kboard->echobuf); echoing = 0; if (waiting_for_input && !NILP (Vquit_flag)) quit_throw_to_read_char (); } /* Turn off echoing, for the start of a new command. */ cancel_echoing () { current_kboard->immediate_echo = 0; current_kboard->echoptr = current_kboard->echobuf; current_kboard->echo_after_prompt = -1; ok_to_echo_at_next_pause = 0; } /* Return the length of the current echo string. */ static int echo_length () { return current_kboard->echoptr - current_kboard->echobuf; } /* Truncate the current echo message to its first LEN chars. This and echo_char get used by read_key_sequence when the user switches frames while entering a key sequence. */ static void echo_truncate (len) int len; { current_kboard->echobuf[len] = '\0'; current_kboard->echoptr = current_kboard->echobuf + len; truncate_echo_area (len); } /* Functions for manipulating this_command_keys. */ static void add_command_key (key) Lisp_Object key; { int size = XVECTOR (this_command_keys)->size; /* If reset-this-command-length was called recently, obey it now. See the doc string of that function for an explanation of why. */ if (before_command_restore_flag) { this_command_key_count = before_command_key_count_1; echo_truncate (before_command_echo_length_1); before_command_restore_flag = 0; } if (this_command_key_count >= size) { Lisp_Object new_keys; new_keys = Fmake_vector (make_number (size * 2), Qnil); bcopy (XVECTOR (this_command_keys)->contents, XVECTOR (new_keys)->contents, size * sizeof (Lisp_Object)); this_command_keys = new_keys; } XVECTOR (this_command_keys)->contents[this_command_key_count++] = key; } Lisp_Object recursive_edit_1 () { int count = specpdl_ptr - specpdl; Lisp_Object val; if (command_loop_level > 0) { specbind (Qstandard_output, Qt); specbind (Qstandard_input, Qt); } val = command_loop (); if (EQ (val, Qt)) Fsignal (Qquit, Qnil); return unbind_to (count, Qnil); } /* When an auto-save happens, record the "time", and don't do again soon. */ record_auto_save () { last_auto_save = num_nonmacro_input_chars; } /* Make an auto save happen as soon as possible at command level. */ force_auto_save_soon () { last_auto_save = - auto_save_interval - 1; record_asynch_buffer_change (); } DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "", "Invoke the editor command loop recursively.\n\ To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\ that tells this function to return.\n\ Alternately, `(throw 'exit t)' makes this function signal an error.\n\ This function is called by the editor initialization to begin editing.") () { int count = specpdl_ptr - specpdl; Lisp_Object val; command_loop_level++; update_mode_lines = 1; record_unwind_protect (recursive_edit_unwind, (command_loop_level && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) ? Fcurrent_buffer () : Qnil); recursive_edit_1 (); return unbind_to (count, Qnil); } Lisp_Object recursive_edit_unwind (buffer) Lisp_Object buffer; { if (!NILP (buffer)) Fset_buffer (buffer); command_loop_level--; update_mode_lines = 1; return Qnil; } static void any_kboard_state () { #ifdef MULTI_KBOARD #if 0 /* Theory: if there's anything in Vunread_command_events, it will right away be read by read_key_sequence, and then if we do switch KBOARDS, it will go into the side queue then. So we don't need to do anything special here -- rms. */ if (CONSP (Vunread_command_events)) { current_kboard->kbd_queue = nconc2 (Vunread_command_events, current_kboard->kbd_queue); current_kboard->kbd_queue_has_data = 1; } Vunread_command_events = Qnil; #endif single_kboard = 0; #endif } /* Switch to the single-kboard state, making current_kboard the only KBOARD from which further input is accepted. */ void single_kboard_state () { #ifdef MULTI_KBOARD single_kboard = 1; #endif } /* Maintain a stack of kboards, so other parts of Emacs can switch temporarily to the kboard of a given frame and then revert to the previous status. */ struct kboard_stack { KBOARD *kboard; struct kboard_stack *next; }; static struct kboard_stack *kboard_stack; void push_frame_kboard (f) FRAME_PTR f; { #ifdef MULTI_KBOARD struct kboard_stack *p = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack)); p->next = kboard_stack; p->kboard = current_kboard; kboard_stack = p; current_kboard = FRAME_KBOARD (f); #endif } void pop_frame_kboard () { #ifdef MULTI_KBOARD struct kboard_stack *p = kboard_stack; current_kboard = p->kboard; kboard_stack = p->next; xfree (p); #endif } /* Handle errors that are not handled at inner levels by printing an error message and returning to the editor command loop. */ Lisp_Object cmd_error (data) Lisp_Object data; { Lisp_Object old_level, old_length; Vstandard_output = Qt; Vstandard_input = Qt; Vexecuting_macro = Qnil; current_kboard->Vprefix_arg = Qnil; cancel_echoing (); /* Avoid unquittable loop if data contains a circular list. */ old_level = Vprint_level; old_length = Vprint_length; XSETFASTINT (Vprint_level, 10); XSETFASTINT (Vprint_length, 10); cmd_error_internal (data, NULL); Vprint_level = old_level; Vprint_length = old_length; Vquit_flag = Qnil; Vinhibit_quit = Qnil; #ifdef MULTI_KBOARD any_kboard_state (); #endif return make_number (0); } cmd_error_internal (data, context) Lisp_Object data; char *context; { Lisp_Object errmsg, tail, errname, file_error; Lisp_Object stream; struct gcpro gcpro1; int i; Vquit_flag = Qnil; Vinhibit_quit = Qt; echo_area_glyphs = 0; /* If the window system or terminal frame hasn't been initialized yet, or we're not interactive, it's best to dump this message out to stderr and exit. */ if (! FRAME_MESSAGE_BUF (selected_frame) || noninteractive) stream = Qexternal_debugging_output; else { Fdiscard_input (); bitch_at_user (); stream = Qt; } if (context != 0) write_string_1 (context, -1, stream); errname = Fcar (data); if (EQ (errname, Qerror)) { data = Fcdr (data); if (!CONSP (data)) data = Qnil; errmsg = Fcar (data); file_error = Qnil; } else { errmsg = Fget (errname, Qerror_message); file_error = Fmemq (Qfile_error, Fget (errname, Qerror_conditions)); } /* Print an error message including the data items. This is done by printing it into a scratch buffer and then making a copy of the text in the buffer. */ if (!CONSP (data)) data = Qnil; tail = Fcdr (data); GCPRO1 (tail); /* For file-error, make error message by concatenating all the data items. They are all strings. */ if (!NILP (file_error) && !NILP (tail)) errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr; if (STRINGP (errmsg)) Fprinc (errmsg, stream); else write_string_1 ("peculiar error", -1, stream); for (i = 0; CONSP (tail); tail = Fcdr (tail), i++) { write_string_1 (i ? ", " : ": ", 2, stream); if (!NILP (file_error)) Fprinc (Fcar (tail), stream); else Fprin1 (Fcar (tail), stream); } UNGCPRO; /* If the window system or terminal frame hasn't been initialized yet, or we're in -batch mode, this error should cause Emacs to exit. */ if (! FRAME_MESSAGE_BUF (selected_frame) || noninteractive) { Fterpri (stream); Fkill_emacs (make_number (-1)); } } Lisp_Object command_loop_1 (); Lisp_Object command_loop_2 (); Lisp_Object top_level_1 (); /* Entry to editor-command-loop. This level has the catches for exiting/returning to editor command loop. It returns nil to exit recursive edit, t to abort it. */ Lisp_Object command_loop () { if (command_loop_level > 0 || minibuf_level > 0) { return internal_catch (Qexit, command_loop_2, Qnil); } else while (1) { internal_catch (Qtop_level, top_level_1, Qnil); internal_catch (Qtop_level, command_loop_2, Qnil); /* End of file in -batch run causes exit here. */ if (noninteractive) Fkill_emacs (Qt); } } /* Here we catch errors in execution of commands within the editing loop, and reenter the editing loop. When there is an error, cmd_error runs and returns a non-nil value to us. A value of nil means that cmd_loop_1 itself returned due to end of file (or end of kbd macro). */ Lisp_Object command_loop_2 () { register Lisp_Object val; do val = internal_condition_case (command_loop_1, Qerror, cmd_error); while (!NILP (val)); return Qnil; } Lisp_Object top_level_2 () { return Feval (Vtop_level); } Lisp_Object top_level_1 () { /* On entry to the outer level, run the startup file */ if (!NILP (Vtop_level)) internal_condition_case (top_level_2, Qerror, cmd_error); else if (!NILP (Vpurify_flag)) message ("Bare impure Emacs (standard Lisp code not loaded)"); else message ("Bare Emacs (standard Lisp code not loaded)"); return Qnil; } DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "", "Exit all recursive editing levels.") () { Fthrow (Qtop_level, Qnil); } DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "", "Exit from the innermost recursive edit or minibuffer.") () { if (command_loop_level > 0 || minibuf_level > 0) Fthrow (Qexit, Qnil); error ("No recursive edit is in progress"); } DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "", "Abort the command that requested this recursive edit or minibuffer input.") () { if (command_loop_level > 0 || minibuf_level > 0) Fthrow (Qexit, Qt); error ("No recursive edit is in progress"); } /* This is the actual command reading loop, sans error-handling encapsulation. */ Lisp_Object Fcommand_execute (); static int read_key_sequence (); void safe_run_hooks (); Lisp_Object command_loop_1 () { Lisp_Object cmd, tem; int lose; int nonundocount; Lisp_Object keybuf[30]; int i; int no_redisplay; int no_direct; int prev_modiff; struct buffer *prev_buffer; #ifdef MULTI_KBOARD int was_locked = single_kboard; #endif current_kboard->Vprefix_arg = Qnil; Vdeactivate_mark = Qnil; waiting_for_input = 0; cancel_echoing (); nonundocount = 0; no_redisplay = 0; this_command_key_count = 0; /* Make sure this hook runs after commands that get errors and throw to top level. */ /* Note that the value cell will never directly contain nil if the symbol is a local variable. */ if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks)) safe_run_hooks (Qpost_command_hook); if (!NILP (Vdeferred_action_list)) call0 (Vdeferred_action_function); if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks)) { if (NILP (Vunread_command_events) && NILP (Vexecuting_macro) && !NILP (sit_for (0, post_command_idle_delay, 0, 1))) safe_run_hooks (Qpost_command_idle_hook); } /* Do this after running Vpost_command_hook, for consistency. */ current_kboard->Vlast_command = this_command; while (1) { /* Make sure the current window's buffer is selected. */ if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer) set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer)); /* Display any malloc warning that just came out. Use while because displaying one warning can cause another. */ while (pending_malloc_warning) display_malloc_warning (); no_direct = 0; Vdeactivate_mark = Qnil; /* If minibuffer on and echo area in use, wait 2 sec and redraw minibuffer. */ if (minibuf_level && echo_area_glyphs && EQ (minibuf_window, echo_area_window)) { /* Bind inhibit-quit to t so that C-g gets read in rather than quitting back to the minibuffer. */ int count = specpdl_ptr - specpdl; specbind (Qinhibit_quit, Qt); Fsit_for (make_number (2), Qnil, Qnil); unbind_to (count, Qnil); echo_area_glyphs = 0; no_direct = 1; if (!NILP (Vquit_flag)) { Vquit_flag = Qnil; Vunread_command_events = Fcons (make_number (quit_char), Qnil); } } #ifdef C_ALLOCA alloca (0); /* Cause a garbage collection now */ /* Since we can free the most stuff here. */ #endif /* C_ALLOCA */ #if 0 #ifdef MULTI_FRAME /* Select the frame that the last event came from. Usually, switch-frame events will take care of this, but if some lisp code swallows a switch-frame event, we'll fix things up here. Is this a good idea? */ if (FRAMEP (internal_last_event_frame) && XFRAME (internal_last_event_frame) != selected_frame) Fselect_frame (internal_last_event_frame, Qnil); #endif #endif /* If it has changed current-menubar from previous value, really recompute the menubar from the value. */ if (! NILP (Vlucid_menu_bar_dirty_flag) && !NILP (Ffboundp (Qrecompute_lucid_menubar))) call0 (Qrecompute_lucid_menubar); before_command_key_count = this_command_key_count; before_command_echo_length = echo_length (); this_command = Qnil; /* Read next key sequence; i gets its length. */ i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0], Qnil, 0, 1); ++num_input_keys; /* Now we have read a key sequence of length I, or else I is 0 and we found end of file. */ 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; goto finalize; } last_command_char = keybuf[i - 1]; /* If the previous command tried to force a specific window-start, forget about that, in case this command moves point far away from that position. But also throw away beg_unchanged and end_unchanged information in that case, so that redisplay will update the whole window properly. */ if (!NILP (XWINDOW (selected_window)->force_start)) { XWINDOW (selected_window)->force_start = Qnil; beg_unchanged = end_unchanged = 0; } cmd = read_key_sequence_cmd; if (!NILP (Vexecuting_macro)) { if (!NILP (Vquit_flag)) { Vexecuting_macro = Qt; QUIT; /* Make some noise. */ /* Will return since macro now empty. */ } } /* Do redisplay processing after this command except in special cases identified below that set no_redisplay to 1. (actually, there's currently no way to prevent the redisplay, and no_redisplay is ignored. Perhaps someday we will really implement it.) */ no_redisplay = 0; prev_buffer = current_buffer; prev_modiff = MODIFF; last_point_position = PT; XSETBUFFER (last_point_position_buffer, prev_buffer); /* Execute the command. */ this_command = cmd; /* Note that the value cell will never directly contain nil if the symbol is a local variable. */ if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks)) safe_run_hooks (Qpre_command_hook); if (NILP (this_command)) { /* nil means key is undefined. */ bitch_at_user (); current_kboard->defining_kbd_macro = Qnil; update_mode_lines = 1; current_kboard->Vprefix_arg = Qnil; } else { if (NILP (current_kboard->Vprefix_arg) && ! no_direct) { /* Recognize some common commands in common situations and do them directly. */ if (EQ (this_command, Qforward_char) && PT < ZV) { struct Lisp_Char_Table *dp = window_display_table (XWINDOW (selected_window)); lose = FETCH_CHAR (PT); SET_PT (PT + 1); if ((dp ? (VECTORP (DISP_CHAR_VECTOR (dp, lose)) ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1 : (NILP (DISP_CHAR_VECTOR (dp, lose)) && (lose >= 0x20 && lose < 0x7f))) : (lose >= 0x20 && lose < 0x7f)) && (XFASTINT (XWINDOW (selected_window)->last_modified) >= MODIFF) && (XFASTINT (XWINDOW (selected_window)->last_point) == PT - 1) && !windows_or_buffers_changed && EQ (current_buffer->selective_display, Qnil) && !detect_input_pending () && NILP (Vcolumn_number_mode) && NILP (Vexecuting_macro)) no_redisplay = direct_output_forward_char (1); goto directly_done; } else if (EQ (this_command, Qbackward_char) && PT > BEGV) { struct Lisp_Char_Table *dp = window_display_table (XWINDOW (selected_window)); SET_PT (PT - 1); lose = FETCH_CHAR (PT); if ((dp ? (VECTORP (DISP_CHAR_VECTOR (dp, lose)) ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1 : (NILP (DISP_CHAR_VECTOR (dp, lose)) && (lose >= 0x20 && lose < 0x7f))) : (lose >= 0x20 && lose < 0x7f)) && (XFASTINT (XWINDOW (selected_window)->last_modified) >= MODIFF) && (XFASTINT (XWINDOW (selected_window)->last_point) == PT + 1) && !windows_or_buffers_changed && EQ (current_buffer->selective_display, Qnil) && !detect_input_pending () && NILP (Vcolumn_number_mode) && NILP (Vexecuting_macro)) no_redisplay = direct_output_forward_char (-1); goto directly_done; } else if (EQ (this_command, Qself_insert_command) /* Try this optimization only on ascii keystrokes. */ && INTEGERP (last_command_char)) { unsigned char c = XINT (last_command_char); int value; if (NILP (Vexecuting_macro) && !EQ (minibuf_window, selected_window)) { if (!nonundocount || nonundocount >= 20) { Fundo_boundary (); nonundocount = 0; } nonundocount++; } lose = ((XFASTINT (XWINDOW (selected_window)->last_modified) < MODIFF) || (XFASTINT (XWINDOW (selected_window)->last_point) != PT) || MODIFF <= SAVE_MODIFF || windows_or_buffers_changed || !EQ (current_buffer->selective_display, Qnil) || detect_input_pending () || !NILP (Vcolumn_number_mode) || !NILP (Vexecuting_macro)); value = internal_self_insert (c, 0); if (value) lose = 1; if (value == 2) nonundocount = 0; if (!lose && (PT == ZV || FETCH_CHAR (PT) == '\n')) { struct Lisp_Char_Table *dp = window_display_table (XWINDOW (selected_window)); int lose = c; if (dp) { Lisp_Object obj; obj = DISP_CHAR_VECTOR (dp, lose); if (NILP (obj)) { /* Do it only for char codes that by default display as themselves. */ if (lose >= 0x20 && lose <= 0x7e) no_redisplay = direct_output_for_insert (lose); } else if (VECTORP (obj) && XVECTOR (obj)->size == 1 && (obj = XVECTOR (obj)->contents[0], INTEGERP (obj)) /* Insist face not specified in glyph. */ && (XINT (obj) & ((-1) << 8)) == 0) no_redisplay = direct_output_for_insert (XINT (obj)); } else { if (lose >= 0x20 && lose <= 0x7e) no_redisplay = direct_output_for_insert (lose); } } goto directly_done; } } /* Here for a command that isn't executed directly */ nonundocount = 0; if (NILP (current_kboard->Vprefix_arg)) Fundo_boundary (); Fcommand_execute (this_command, Qnil, Qnil); } directly_done: ; /* Note that the value cell will never directly contain nil if the symbol is a local variable. */ if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks)) safe_run_hooks (Qpost_command_hook); if (!NILP (Vdeferred_action_list)) safe_run_hooks (Qdeferred_action_function); if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks)) { if (NILP (Vunread_command_events) && NILP (Vexecuting_macro) && !NILP (sit_for (0, post_command_idle_delay, 0, 1))) safe_run_hooks (Qpost_command_idle_hook); } /* If there is a prefix argument, 1) We don't want Vlast_command to be ``universal-argument'' (that would be dumb), so don't set Vlast_command, 2) we want to leave echoing on so that the prefix will be echoed as part of this key sequence, so don't call cancel_echoing, and 3) we want to leave this_command_key_count non-zero, so that read_char will realize that it is re-reading a character, and not echo it a second time. If the command didn't actually create a prefix arg, but is merely a frame event that is transparent to prefix args, then the above doesn't apply. */ if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_char)) { current_kboard->Vlast_command = this_command; cancel_echoing (); this_command_key_count = 0; } if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks)) { if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode)) { current_buffer->mark_active = Qnil; call1 (Vrun_hooks, intern ("deactivate-mark-hook")); } else if (current_buffer != prev_buffer || MODIFF != prev_modiff) call1 (Vrun_hooks, intern ("activate-mark-hook")); } finalize: /* Install chars successfully executed in kbd macro. */ if (!NILP (current_kboard->defining_kbd_macro) && NILP (current_kboard->Vprefix_arg)) finalize_kbd_macro_chars (); #ifdef MULTI_KBOARD if (!was_locked) any_kboard_state (); #endif } } /* Subroutine for safe_run_hooks: run the hook HOOK. */ static Lisp_Object safe_run_hooks_1 (hook) Lisp_Object hook; { return call1 (Vrun_hooks, Vinhibit_quit); } /* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */ static Lisp_Object safe_run_hooks_error (data) Lisp_Object data; { Fset (Vinhibit_quit, Qnil); } /* If we get an error while running the hook, cause the hook variable to be nil. Also inhibit quits, so that C-g won't cause the hook to mysteriously evaporate. */ void safe_run_hooks (hook) Lisp_Object hook; { Lisp_Object value; int count = specpdl_ptr - specpdl; specbind (Qinhibit_quit, hook); internal_condition_case (safe_run_hooks_1, Qerror, safe_run_hooks_error); unbind_to (count, Qnil); } /* Number of seconds between polling for input. */ int polling_period; /* Nonzero means polling for input is temporarily suppressed. */ int poll_suppress_count; /* Nonzero if polling_for_input is actually being used. */ int polling_for_input; #ifdef POLL_FOR_INPUT /* Handle an alarm once each second and read pending input so as to handle a C-g if it comces in. */ SIGTYPE input_poll_signal (signalnum) /* If we don't have an argument, */ int signalnum; /* some compilers complain in signal calls. */ { if (interrupt_input_blocked == 0 && !waiting_for_input) read_avail_input (0); signal (SIGALRM, input_poll_signal); alarm (polling_period); } #endif /* Begin signals to poll for input, if they are appropriate. This function is called unconditionally from various places. */ start_polling () { #ifdef POLL_FOR_INPUT if (read_socket_hook && !interrupt_input) { poll_suppress_count--; if (poll_suppress_count == 0) { signal (SIGALRM, input_poll_signal); polling_for_input = 1; alarm (polling_period); } } #endif } /* Nonzero if we are using polling to handle input asynchronously. */ int input_polling_used () { #ifdef POLL_FOR_INPUT return read_socket_hook && !interrupt_input; #else return 0; #endif } /* Turn off polling. */ stop_polling () { #ifdef POLL_FOR_INPUT if (read_socket_hook && !interrupt_input) { if (poll_suppress_count == 0) { polling_for_input = 0; alarm (0); } poll_suppress_count++; } #endif } /* Set the value of poll_suppress_count to COUNT and start or stop polling accordingly. */ void set_poll_suppress_count (count) int count; { #ifdef POLL_FOR_INPUT if (count == 0 && poll_suppress_count != 0) { poll_suppress_count = 1; start_polling (); } else if (count != 0 && poll_suppress_count == 0) { stop_polling (); } poll_suppress_count = count; #endif } /* Bind polling_period to a value at least N. But don't decrease it. */ bind_polling_period (n) int n; { #ifdef POLL_FOR_INPUT int new = polling_period; if (n > new) new = n; stop_polling (); specbind (Qpolling_period, make_number (new)); /* Start a new alarm with the new period. */ start_polling (); #endif } /* Apply the control modifier to CHARACTER. */ int make_ctrl_char (c) int c; { /* Save the upper bits here. */ int upper = c & ~0177; c &= 0177; /* Everything in the columns containing the upper-case letters denotes a control character. */ if (c >= 0100 && c < 0140) { int oc = c; c &= ~0140; /* Set the shift modifier for a control char made from a shifted letter. But only for letters! */ if (oc >= 'A' && oc <= 'Z') c |= shift_modifier; } /* The lower-case letters denote control characters too. */ else if (c >= 'a' && c <= 'z') c &= ~0140; /* Include the bits for control and shift only if the basic ASCII code can't indicate them. */ else if (c >= ' ') c |= ctrl_modifier; /* Replace the high bits. */ c |= (upper & ~ctrl_modifier); return c; } /* Input of single characters from keyboard */ Lisp_Object print_help (); static Lisp_Object kbd_buffer_get_event (); static void record_char (); #ifdef MULTI_KBOARD static jmp_buf wrong_kboard_jmpbuf; #endif /* read a character from the keyboard; call the redisplay if needed */ /* commandflag 0 means do not do auto-saving, but do do redisplay. -1 means do not do redisplay, but do do autosaving. 1 means do both. */ /* The arguments MAPS and NMAPS are for menu prompting. MAPS is an array of keymaps; NMAPS is the length of MAPS. PREV_EVENT is the previous input event, or nil if we are reading the first event of a key sequence. If USED_MOUSE_MENU is non-null, 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 null, we don't dereference it. Value is t if we showed a menu and the user rejected it. */ Lisp_Object read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) int commandflag; int nmaps; Lisp_Object *maps; Lisp_Object prev_event; int *used_mouse_menu; { register Lisp_Object c; int count; jmp_buf local_getcjmp; jmp_buf save_jump; int key_already_recorded = 0; Lisp_Object tem, save; Lisp_Object also_record; also_record = Qnil; before_command_key_count = this_command_key_count; before_command_echo_length = echo_length (); retry: if (CONSP (Vunread_command_events)) { c = XCONS (Vunread_command_events)->car; Vunread_command_events = XCONS (Vunread_command_events)->cdr; /* Undo what read_char_x_menu_prompt did when it unread additional keys returned by Fx_popup_menu. */ if (CONSP (c) && (SYMBOLP (XCONS (c)->car) || INTEGERP (XCONS (c)->car)) && NILP (XCONS (c)->cdr)) c = XCONS (c)->car; if (this_command_key_count == 0) goto reread_first; else goto reread; } if (unread_command_char != -1) { XSETINT (c, unread_command_char); unread_command_char = -1; if (this_command_key_count == 0) goto reread_first; else goto reread; } /* If there is no function key translated before reset-this-command-lengths takes effect, forget about it. */ before_command_restore_flag = 0; if (!NILP (Vexecuting_macro)) { #ifdef MULTI_FRAME /* We set this to Qmacro; since that's not a frame, nobody will try to switch frames on us, and the selected window will remain unchanged. Since this event came from a macro, it would be misleading to leave internal_last_event_frame set to wherever the last real event came from. Normally, a switch-frame event selects internal_last_event_frame after each command is read, but events read from a macro should never cause a new frame to be selected. */ Vlast_event_frame = internal_last_event_frame = Qmacro; #endif /* Exit the macro if we are at the end. Also, some things replace the macro with t to force an early exit. */ if (EQ (Vexecuting_macro, Qt) || executing_macro_index >= XFASTINT (Flength (Vexecuting_macro))) { XSETINT (c, -1); return c; } c = Faref (Vexecuting_macro, make_number (executing_macro_index)); if (STRINGP (Vexecuting_macro) && (XINT (c) & 0x80)) XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80)); executing_macro_index++; goto from_macro; } if (!NILP (unread_switch_frame)) { c = unread_switch_frame; unread_switch_frame = Qnil; /* This event should make it into this_command_keys, and get echoed again, so we go to reread_first, rather than reread. */ goto reread_first; } if (commandflag >= 0 && !input_pending && !detect_input_pending ()) redisplay (); /* Message turns off echoing unless more keystrokes turn it on again. */ if (echo_area_glyphs && *echo_area_glyphs && echo_area_glyphs != current_kboard->echobuf && ok_to_echo_at_next_pause != echo_area_glyphs) cancel_echoing (); else /* If already echoing, continue. */ echo_dash (); /* Try reading a character via menu prompting in the minibuf. Try this before the sit-for, because the sit-for would do the wrong thing if we are supposed to do menu prompting. If EVENT_HAS_PARAMETERS then we are reading after a mouse event so don't try a minibuf menu. */ c = Qnil; if (nmaps > 0 && INTERACTIVE && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event) /* Don't bring up a menu if we already have another event. */ && NILP (Vunread_command_events) && unread_command_char < 0 && !detect_input_pending ()) { c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps); if (! NILP (c)) { key_already_recorded = 1; goto non_reread_1; } } /* Make a longjmp point for quits to use, but don't alter getcjmp just yet. We will do that below, temporarily for short sections of code, when appropriate. local_getcjmp must be in effect around any call to sit_for or kbd_buffer_get_event; it *must not* be in effect when we call redisplay. */ if (_setjmp (local_getcjmp)) { XSETINT (c, quit_char); #ifdef MULTI_FRAME XSETFRAME (internal_last_event_frame, selected_frame); Vlast_event_frame = internal_last_event_frame; #endif /* If we report the quit char as an event, don't do so more than once. */ if (!NILP (Vinhibit_quit)) Vquit_flag = Qnil; #ifdef MULTI_KBOARD { KBOARD *kb = FRAME_KBOARD (selected_frame); if (kb != current_kboard) { Lisp_Object *tailp = &kb->kbd_queue; /* We shouldn't get here if we were in single-kboard mode! */ if (single_kboard) abort (); while (CONSP (*tailp)) tailp = &XCONS (*tailp)->cdr; if (!NILP (*tailp)) abort (); *tailp = Fcons (c, Qnil); kb->kbd_queue_has_data = 1; current_kboard = kb; longjmp (wrong_kboard_jmpbuf, 1); } } #endif goto non_reread; } /* If in middle of key sequence and minibuffer not active, start echoing if enough time elapses. */ if (minibuf_level == 0 && !current_kboard->immediate_echo && this_command_key_count > 0 && ! noninteractive && echo_keystrokes > 0 && (echo_area_glyphs == 0 || *echo_area_glyphs == 0 || ok_to_echo_at_next_pause == echo_area_glyphs)) { Lisp_Object tem0; /* After a mouse event, start echoing right away. This is because we are probably about to display a menu, and we don't want to delay before doing so. */ if (EVENT_HAS_PARAMETERS (prev_event)) echo (); else { save_getcjmp (save_jump); restore_getcjmp (local_getcjmp); tem0 = sit_for (echo_keystrokes, 0, 1, 1); restore_getcjmp (save_jump); if (EQ (tem0, Qt)) echo (); } } /* Maybe auto save due to number of keystrokes. */ if (commandflag != 0 && auto_save_interval > 0 && num_nonmacro_input_chars - last_auto_save > max (auto_save_interval, 20) && !detect_input_pending ()) { Fdo_auto_save (Qnil, Qnil); /* Hooks can actually change some buffers in auto save. */ redisplay (); } /* Try reading using an X menu. This is never confused with reading using the minibuf because the recursive call of read_char in read_char_minibuf_menu_prompt does not pass on any keymaps. */ if (nmaps > 0 && INTERACTIVE && !NILP (prev_event) && EVENT_HAS_PARAMETERS (prev_event) && !EQ (XCONS (prev_event)->car, Qmenu_bar) /* Don't bring up a menu if we already have another event. */ && NILP (Vunread_command_events) && unread_command_char < 0) c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu); /* Maybe autosave and/or garbage collect due to idleness. */ if (INTERACTIVE && NILP (c)) { int delay_level, buffer_size; /* Slow down auto saves logarithmically in size of current buffer, and garbage collect while we're at it. */ if (! MINI_WINDOW_P (XWINDOW (selected_window))) last_non_minibuf_size = Z - BEG; buffer_size = (last_non_minibuf_size >> 8) + 1; delay_level = 0; while (buffer_size > 64) delay_level++, buffer_size -= buffer_size >> 2; if (delay_level < 4) delay_level = 4; /* delay_level is 4 for files under around 50k, 7 at 100k, 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */ /* Auto save if enough time goes by without input. */ if (commandflag != 0 && num_nonmacro_input_chars > last_auto_save && INTEGERP (Vauto_save_timeout) && XINT (Vauto_save_timeout) > 0) { Lisp_Object tem0; int delay = delay_level * XFASTINT (Vauto_save_timeout) / 4; save_getcjmp (save_jump); restore_getcjmp (local_getcjmp); tem0 = sit_for (delay, 0, 1, 1); restore_getcjmp (save_jump); if (EQ (tem0, Qt)) { Fdo_auto_save (Qnil, Qnil); /* If we have auto-saved and there is still no input available, garbage collect if there has been enough consing going on to make it worthwhile. */ if (!detect_input_pending () && consing_since_gc > gc_cons_threshold / 2) Fgarbage_collect (); redisplay (); } } } /* Read something from current KBOARD's side queue, if possible. */ if (NILP (c)) { if (current_kboard->kbd_queue_has_data) { if (!CONSP (current_kboard->kbd_queue)) abort (); c = XCONS (current_kboard->kbd_queue)->car; current_kboard->kbd_queue = XCONS (current_kboard->kbd_queue)->cdr; if (NILP (current_kboard->kbd_queue)) current_kboard->kbd_queue_has_data = 0; input_pending = readable_events (); #ifdef MULTI_FRAME if (EVENT_HAS_PARAMETERS (c) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame)) internal_last_event_frame = XCONS (XCONS (c)->cdr)->car; Vlast_event_frame = internal_last_event_frame; #endif } } #ifdef MULTI_KBOARD /* If current_kboard's side queue is empty check the other kboards. If one of them has data that we have not yet seen here, switch to it and process the data waiting for it. Note: if the events queued up for another kboard have already been seen here, and therefore are not a complete command, the kbd_queue_has_data field is 0, so we skip that kboard here. That's to avoid an infinite loop switching between kboards here. */ if (NILP (c) && !single_kboard) { KBOARD *kb; for (kb = all_kboards; kb; kb = kb->next_kboard) if (kb->kbd_queue_has_data) { current_kboard = kb; longjmp (wrong_kboard_jmpbuf, 1); } } #endif wrong_kboard: stop_polling (); /* Finally, we read from the main queue, and if that gives us something we can't use yet, we put it on the appropriate side queue and try again. */ if (NILP (c)) { KBOARD *kb; /* Actually read a character, waiting if necessary. */ save_getcjmp (save_jump); restore_getcjmp (local_getcjmp); c = kbd_buffer_get_event (&kb, used_mouse_menu); restore_getcjmp (save_jump); #ifdef MULTI_KBOARD if (! NILP (c) && (kb != current_kboard)) { Lisp_Object *tailp = &kb->kbd_queue; while (CONSP (*tailp)) tailp = &XCONS (*tailp)->cdr; if (!NILP (*tailp)) abort (); *tailp = Fcons (c, Qnil); kb->kbd_queue_has_data = 1; c = Qnil; if (single_kboard) goto wrong_kboard; current_kboard = kb; longjmp (wrong_kboard_jmpbuf, 1); } #endif } /* Terminate Emacs in batch mode if at eof. */ if (noninteractive && INTEGERP (c) && XINT (c) < 0) Fkill_emacs (make_number (1)); if (INTEGERP (c)) { /* Add in any extra modifiers, where appropriate. */ if ((extra_keyboard_modifiers & CHAR_CTL) || ((extra_keyboard_modifiers & 0177) < ' ' && (extra_keyboard_modifiers & 0177) != 0)) XSETINT (c, make_ctrl_char (XINT (c))); /* Transfer any other modifier bits directly from extra_keyboard_modifiers to c. Ignore the actual character code in the low 16 bits of extra_keyboard_modifiers. */ XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL)); } non_reread: start_polling (); if (NILP (c)) { if (commandflag >= 0 && !input_pending && !detect_input_pending ()) redisplay (); goto wrong_kboard; } non_reread_1: /* Buffer switch events are only for internal wakeups so don't show them to the user. */ if (BUFFERP (c)) return c; if (key_already_recorded) return c; /* Process special events within read_char and loop around to read another event. */ save = Vquit_flag; Vquit_flag = Qnil; tem = get_keyelt (access_keymap (get_keymap_1 (Vspecial_event_map, 0, 0), c, 0, 0), 1); Vquit_flag = save; if (!NILP (tem)) { last_input_char = c; Fcommand_execute (tem, Qnil, Fvector (1, &last_input_char)); goto retry; } /* Wipe the echo area. */ echo_area_glyphs = 0; /* Handle things that only apply to characters. */ if (INTEGERP (c)) { /* If kbd_buffer_get_event gave us an EOF, return that. */ if (XINT (c) == -1) return c; if (STRINGP (Vkeyboard_translate_table) && XSTRING (Vkeyboard_translate_table)->size > XFASTINT (c)) XSETINT (c, XSTRING (Vkeyboard_translate_table)->data[XFASTINT (c)]); else if ((VECTORP (Vkeyboard_translate_table) && XVECTOR (Vkeyboard_translate_table)->size > XFASTINT (c)) || CHAR_TABLE_P (Vkeyboard_translate_table)) { Lisp_Object d; d = Faref (Vkeyboard_translate_table, c); /* nil in keyboard-translate-table means no translation. */ if (!NILP (d)) c = d; } } /* If this event is a mouse click in the menu bar, return just menu-bar for now. Modify the mouse click event so we won't do this twice, then queue it up. */ if (EVENT_HAS_PARAMETERS (c) && CONSP (XCONS (c)->cdr) && CONSP (EVENT_START (c)) && CONSP (XCONS (EVENT_START (c))->cdr)) { Lisp_Object posn; posn = POSN_BUFFER_POSN (EVENT_START (c)); /* Handle menu-bar events: insert the dummy prefix event `menu-bar'. */ if (EQ (posn, Qmenu_bar)) { /* Change menu-bar to (menu-bar) as the event "position". */ POSN_BUFFER_POSN (EVENT_START (c)) = Fcons (posn, Qnil); also_record = c; Vunread_command_events = Fcons (c, Vunread_command_events); c = posn; } } record_char (c); if (! NILP (also_record)) record_char (also_record); from_macro: reread_first: before_command_key_count = this_command_key_count; before_command_echo_length = echo_length (); /* Don't echo mouse motion events. */ if (echo_keystrokes && ! (EVENT_HAS_PARAMETERS (c) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement))) { echo_char (c); if (! NILP (also_record)) echo_char (also_record); /* Once we reread a character, echoing can happen the next time we pause to read a new one. */ ok_to_echo_at_next_pause = echo_area_glyphs; } /* Record this character as part of the current key. */ add_command_key (c); if (! NILP (also_record)) add_command_key (also_record); /* Re-reading in the middle of a command */ reread: last_input_char = c; num_input_chars++; /* Process the help character specially if enabled */ if (!NILP (Vhelp_form) && help_char_p (c)) { Lisp_Object tem0; count = specpdl_ptr - specpdl; record_unwind_protect (Fset_window_configuration, Fcurrent_window_configuration (Qnil)); tem0 = Feval (Vhelp_form); if (STRINGP (tem0)) internal_with_output_to_temp_buffer ("*Help*", print_help, tem0); cancel_echoing (); do c = read_char (0, 0, 0, Qnil, 0); while (BUFFERP (c)); /* Remove the help from the frame */ unbind_to (count, Qnil); redisplay (); if (EQ (c, make_number (040))) { cancel_echoing (); do c = read_char (0, 0, 0, Qnil, 0); while (BUFFERP (c)); } } return c; } /* Return 1 if should recognize C as "the help character". */ int help_char_p (c) Lisp_Object c; { Lisp_Object tail; if (EQ (c, Vhelp_char)) return 1; for (tail = Vhelp_event_list; CONSP (tail); tail = XCONS (tail)->cdr) if (EQ (c, XCONS (tail)->car)) return 1; return 0; } /* Record the input event C in various ways. */ static void record_char (c) Lisp_Object c; { total_keys++; XVECTOR (recent_keys)->contents[recent_keys_index] = c; if (++recent_keys_index >= NUM_RECENT_KEYS) recent_keys_index = 0; /* Write c to the dribble file. If c is a lispy event, write the event's symbol to the dribble file, in . Bleaugh. If you, dear reader, have a better idea, you've got the source. :-) */ if (dribble) { if (INTEGERP (c)) { if (XUINT (c) < 0x100) putc (XINT (c), dribble); else fprintf (dribble, " 0x%x", (int) XUINT (c)); } else { Lisp_Object dribblee; /* If it's a structured event, take the event header. */ dribblee = EVENT_HEAD (c); if (SYMBOLP (dribblee)) { putc ('<', dribble); fwrite (XSYMBOL (dribblee)->name->data, sizeof (char), XSYMBOL (dribblee)->name->size, dribble); putc ('>', dribble); } } fflush (dribble); } store_kbd_macro_char (c); num_nonmacro_input_chars++; } Lisp_Object print_help (object) Lisp_Object object; { struct buffer *old = current_buffer; Fprinc (object, Qnil); set_buffer_internal (XBUFFER (Vstandard_output)); call0 (intern ("help-mode")); set_buffer_internal (old); return Qnil; } /* Copy out or in the info on where C-g should throw to. This is used when running Lisp code from within get_char, in case get_char is called recursively. See read_process_output. */ save_getcjmp (temp) jmp_buf temp; { bcopy (getcjmp, temp, sizeof getcjmp); } restore_getcjmp (temp) jmp_buf temp; { bcopy (temp, getcjmp, sizeof getcjmp); } #ifdef HAVE_MOUSE /* Restore mouse tracking enablement. See Ftrack_mouse for the only use of this function. */ static Lisp_Object tracking_off (old_value) Lisp_Object old_value; { do_mouse_tracking = old_value; if (NILP (old_value)) { /* Redisplay may have been preempted because there was input available, and it assumes it will be called again after the input has been processed. If the only input available was the sort that we have just disabled, then we need to call redisplay. */ if (!readable_events ()) { redisplay_preserve_echo_area (); get_input_pending (&input_pending); } } } DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0, "Evaluate BODY with mouse movement events enabled.\n\ Within a `track-mouse' form, mouse motion generates input events that\n\ you can read with `read-event'.\n\ Normally, mouse motion is ignored.") (args) Lisp_Object args; { int count = specpdl_ptr - specpdl; Lisp_Object val; record_unwind_protect (tracking_off, do_mouse_tracking); do_mouse_tracking = Qt; val = Fprogn (args); return unbind_to (count, val); } /* If mouse has moved on some frame, return one of those frames. Return 0 otherwise. */ static FRAME_PTR some_mouse_moved () { Lisp_Object tail, frame; FOR_EACH_FRAME (tail, frame) { if (XFRAME (frame)->mouse_moved) return XFRAME (frame); } return 0; } #endif /* HAVE_MOUSE */ /* Low level keyboard/mouse input. kbd_buffer_store_event places events in kbd_buffer, and kbd_buffer_get_event retrieves them. */ /* Return true iff there are any events in the queue that read-char would return. If this returns false, a read-char would block. */ static int readable_events () { if (kbd_fetch_ptr != kbd_store_ptr) return 1; #ifdef HAVE_MOUSE if (!NILP (do_mouse_tracking) && some_mouse_moved ()) return 1; #endif if (single_kboard) { if (current_kboard->kbd_queue_has_data) return 1; } else { KBOARD *kb; for (kb = all_kboards; kb; kb = kb->next_kboard) if (kb->kbd_queue_has_data) return 1; } return 0; } /* Set this for debugging, to have a way to get out */ int stop_character; #ifdef MULTI_KBOARD static KBOARD * event_to_kboard (event) struct input_event *event; { Lisp_Object frame; frame = event->frame_or_window; if (CONSP (frame)) frame = XCONS (frame)->car; else if (WINDOWP (frame)) frame = WINDOW_FRAME (XWINDOW (frame)); /* There are still some events that don't set this field. For now, just ignore the problem. Also ignore dead frames here. */ if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame))) return 0; else return FRAME_KBOARD (XFRAME (frame)); } #endif /* Store an event obtained at interrupt level into kbd_buffer, fifo */ void kbd_buffer_store_event (event) register struct input_event *event; { if (event->kind == no_event) abort (); if (event->kind == ascii_keystroke) { register int c = event->code & 0377; if (event->modifiers & ctrl_modifier) c = make_ctrl_char (c); c |= (event->modifiers & (meta_modifier | alt_modifier | hyper_modifier | super_modifier)); if (c == quit_char) { extern SIGTYPE interrupt_signal (); #ifdef MULTI_KBOARD KBOARD *kb; struct input_event *sp; if (single_kboard && (kb = FRAME_KBOARD (XFRAME (event->frame_or_window)), kb != current_kboard)) { kb->kbd_queue = Fcons (make_lispy_switch_frame (event->frame_or_window), Fcons (make_number (c), Qnil)); kb->kbd_queue_has_data = 1; for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++) { if (sp == kbd_buffer + KBD_BUFFER_SIZE) sp = kbd_buffer; if (event_to_kboard (sp) == kb) { sp->kind = no_event; sp->frame_or_window = Qnil; } } return; } #endif #ifdef MULTI_FRAME /* If this results in a quit_char being returned to Emacs as input, set Vlast_event_frame properly. If this doesn't get returned to Emacs as an event, the next event read will set Vlast_event_frame again, so this is safe to do. */ { Lisp_Object focus; focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window)); if (NILP (focus)) focus = event->frame_or_window; internal_last_event_frame = focus; Vlast_event_frame = focus; } #endif last_event_timestamp = event->timestamp; interrupt_signal (); return; } if (c && c == stop_character) { sys_suspend (); return; } } /* Don't insert two buffer_switch_event's in a row. Just ignore the second one. */ else if (event->kind == buffer_switch_event && kbd_fetch_ptr != kbd_store_ptr && kbd_store_ptr->kind == buffer_switch_event) return; if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE) kbd_store_ptr = kbd_buffer; /* Don't let the very last slot in the buffer become full, since that would make the two pointers equal, and that is indistinguishable from an empty buffer. Discard the event if it would fill the last slot. */ if (kbd_fetch_ptr - 1 != kbd_store_ptr) { volatile struct input_event *sp = kbd_store_ptr; sp->kind = event->kind; if (event->kind == selection_request_event) { /* We must not use the ordinary copying code for this case, since `part' is an enum and copying it might not copy enough in this case. */ bcopy (event, (char *) sp, sizeof (*event)); } else { sp->code = event->code; sp->part = event->part; sp->frame_or_window = event->frame_or_window; sp->modifiers = event->modifiers; sp->x = event->x; sp->y = event->y; sp->timestamp = event->timestamp; } (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_store_ptr - kbd_buffer] = event->frame_or_window); kbd_store_ptr++; } } /* Read one event from the event buffer, waiting if necessary. The value is a Lisp object representing the event. The value is nil for an event that should be ignored, or that was handled here. We always read and discard one event. */ static Lisp_Object kbd_buffer_get_event (kbp, used_mouse_menu) KBOARD **kbp; int *used_mouse_menu; { register int c; Lisp_Object obj; if (noninteractive) { c = getchar (); XSETINT (obj, c); *kbp = current_kboard; return obj; } /* Wait until there is input available. */ for (;;) { if (kbd_fetch_ptr != kbd_store_ptr) break; #ifdef HAVE_MOUSE if (!NILP (do_mouse_tracking) && some_mouse_moved ()) break; #endif /* If the quit flag is set, then read_char will return quit_char, so that counts as "available input." */ if (!NILP (Vquit_flag)) quit_throw_to_read_char (); /* One way or another, wait until input is available; then, if interrupt handlers have not read it, read it now. */ #ifdef OLDVMS wait_for_kbd_input (); #else /* Note SIGIO has been undef'd if FIONREAD is missing. */ #ifdef SIGIO gobble_input (0); #endif /* SIGIO */ if (kbd_fetch_ptr != kbd_store_ptr) break; #ifdef HAVE_MOUSE if (!NILP (do_mouse_tracking) && some_mouse_moved ()) break; #endif { Lisp_Object minus_one; XSETINT (minus_one, -1); wait_reading_process_input (0, 0, minus_one, 1); if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr) /* Pass 1 for EXPECT since we just waited to have input. */ read_avail_input (1); } #endif /* not VMS */ } /* At this point, we know that there is a readable event available somewhere. If the event queue is empty, then there must be a mouse movement enabled and available. */ if (kbd_fetch_ptr != kbd_store_ptr) { struct input_event *event; event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE) ? kbd_fetch_ptr : kbd_buffer); last_event_timestamp = event->timestamp; #ifdef MULTI_KBOARD *kbp = event_to_kboard (event); if (*kbp == 0) *kbp = current_kboard; /* Better than returning null ptr? */ #else *kbp = &the_only_kboard; #endif obj = Qnil; /* These two kinds of events get special handling and don't actually appear to the command loop. We return nil for them. */ if (event->kind == selection_request_event) { #ifdef HAVE_X11 struct input_event copy; /* Remove it from the buffer before processing it, since otherwise swallow_events will see it and process it again. */ copy = *event; kbd_fetch_ptr = event + 1; input_pending = readable_events (); x_handle_selection_request (©); #else /* We're getting selection request events, but we don't have a window system. */ abort (); #endif } else if (event->kind == selection_clear_event) { #ifdef HAVE_X11 struct input_event copy; /* Remove it from the buffer before processing it. */ copy = *event; kbd_fetch_ptr = event + 1; input_pending = readable_events (); x_handle_selection_clear (©); #else /* We're getting selection request events, but we don't have a window system. */ abort (); #endif } #if defined (HAVE_X11) || defined (HAVE_NTGUI) else if (event->kind == delete_window_event) { /* Make an event (delete-frame (FRAME)). */ obj = Fcons (event->frame_or_window, Qnil); obj = Fcons (Qdelete_frame, Fcons (obj, Qnil)); kbd_fetch_ptr = event + 1; } else if (event->kind == iconify_event) { /* Make an event (iconify-frame (FRAME)). */ obj = Fcons (event->frame_or_window, Qnil); obj = Fcons (Qiconify_frame, Fcons (obj, Qnil)); kbd_fetch_ptr = event + 1; } else if (event->kind == deiconify_event) { /* Make an event (make-frame-visible (FRAME)). */ obj = Fcons (event->frame_or_window, Qnil); obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil)); kbd_fetch_ptr = event + 1; } #endif else if (event->kind == buffer_switch_event) { /* The value doesn't matter here; only the type is tested. */ XSETBUFFER (obj, current_buffer); kbd_fetch_ptr = event + 1; } #ifdef USE_X_TOOLKIT else if (event->kind == menu_bar_activate_event) { kbd_fetch_ptr = event + 1; input_pending = readable_events (); x_activate_menubar (XFRAME (event->frame_or_window)); } #endif /* Just discard these, by returning nil. With MULTI_KBOARD, these events are used as placeholders when we need to randomly delete events from the queue. (They shouldn't otherwise be found in the buffer, but on some machines it appears they do show up even without MULTI_KBOARD.) */ else if (event->kind == no_event) kbd_fetch_ptr = event + 1; /* If this event is on a different frame, return a switch-frame this time, and leave the event in the queue for next time. */ else { #ifdef MULTI_FRAME Lisp_Object frame; Lisp_Object focus; frame = event->frame_or_window; if (CONSP (frame)) frame = XCONS (frame)->car; else if (WINDOWP (frame)) frame = WINDOW_FRAME (XWINDOW (frame)); focus = FRAME_FOCUS_FRAME (XFRAME (frame)); if (! NILP (focus)) frame = focus; if (! EQ (frame, internal_last_event_frame) && XFRAME (frame) != selected_frame) obj = make_lispy_switch_frame (frame); internal_last_event_frame = frame; #endif /* MULTI_FRAME */ /* If we didn't decide to make a switch-frame event, go ahead and build a real event from the queue entry. */ if (NILP (obj)) { obj = make_lispy_event (event); #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) /* If this was a menu selection, then set the flag to inhibit writing to last_nonmenu_event. Don't do this if the event we're returning is (menu-bar), though; that indicates the beginning of the menu sequence, and we might as well leave that as the `event with parameters' for this selection. */ if (event->kind == menu_bar_event && !(CONSP (obj) && EQ (XCONS (obj)->car, Qmenu_bar)) && used_mouse_menu) *used_mouse_menu = 1; #endif /* Wipe out this event, to catch bugs. */ event->kind = no_event; XVECTOR (kbd_buffer_frame_or_window)->contents[event - kbd_buffer] = Qnil; kbd_fetch_ptr = event + 1; } } } #ifdef HAVE_MOUSE /* Try generating a mouse motion event. */ else if (!NILP (do_mouse_tracking) && some_mouse_moved ()) { FRAME_PTR f = some_mouse_moved (); Lisp_Object bar_window; enum scroll_bar_part part; Lisp_Object x, y; unsigned long time; *kbp = current_kboard; /* Note that this uses F to determine which display to look at. If there is no valid info, it does not store anything so x remains nil. */ x = Qnil; (*mouse_position_hook) (&f, 0, &bar_window, &part, &x, &y, &time); obj = Qnil; #ifdef MULTI_FRAME /* Decide if we should generate a switch-frame event. Don't generate switch-frame events for motion outside of all Emacs frames. */ if (!NILP (x) && f) { Lisp_Object frame; frame = FRAME_FOCUS_FRAME (f); if (NILP (frame)) XSETFRAME (frame, f); if (! EQ (frame, internal_last_event_frame) && XFRAME (frame) != selected_frame) obj = make_lispy_switch_frame (frame); internal_last_event_frame = frame; } #endif /* If we didn't decide to make a switch-frame event, go ahead and return a mouse-motion event. */ if (!NILP (x) && NILP (obj)) obj = make_lispy_movement (f, bar_window, part, x, y, time); } #endif /* HAVE_MOUSE */ else /* We were promised by the above while loop that there was something for us to read! */ abort (); input_pending = readable_events (); #ifdef MULTI_FRAME Vlast_event_frame = internal_last_event_frame; #endif return (obj); } /* Process any events that are not user-visible, then return, without reading any user-visible events. */ void swallow_events () { while (kbd_fetch_ptr != kbd_store_ptr) { struct input_event *event; event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE) ? kbd_fetch_ptr : kbd_buffer); last_event_timestamp = event->timestamp; /* These two kinds of events get special handling and don't actually appear to the command loop. */ if (event->kind == selection_request_event) { #ifdef HAVE_X11 struct input_event copy; /* Remove it from the buffer before processing it, since otherwise swallow_events called recursively could see it and process it again. */ copy = *event; kbd_fetch_ptr = event + 1; input_pending = readable_events (); x_handle_selection_request (©); #else /* We're getting selection request events, but we don't have a window system. */ abort (); #endif } else if (event->kind == selection_clear_event) { #ifdef HAVE_X11 struct input_event copy; /* Remove it from the buffer before processing it, */ copy = *event; kbd_fetch_ptr = event + 1; input_pending = readable_events (); x_handle_selection_clear (©); #else /* We're getting selection request events, but we don't have a window system. */ abort (); #endif } else break; } get_input_pending (&input_pending); } /* Caches for modify_event_symbol. */ static Lisp_Object accent_key_syms; static Lisp_Object func_key_syms; static Lisp_Object mouse_syms; /* This is a list of keysym codes for special "accent" characters. It parallels lispy_accent_keys. */ static int lispy_accent_codes[] = { #ifdef XK_dead_circumflex XK_dead_circumflex, #else 0, #endif #ifdef XK_dead_grave XK_dead_grave, #else 0, #endif #ifdef XK_dead_tilde XK_dead_tilde, #else 0, #endif #ifdef XK_dead_diaeresis XK_dead_diaeresis, #else 0, #endif #ifdef XK_dead_macron XK_dead_macron, #else 0, #endif #ifdef XK_dead_degree XK_dead_degree, #else 0, #endif #ifdef XK_dead_acute XK_dead_acute, #else 0, #endif #ifdef XK_dead_cedilla XK_dead_cedilla, #else 0, #endif #ifdef XK_dead_breve XK_dead_breve, #else 0, #endif #ifdef XK_dead_ogonek XK_dead_ogonek, #else 0, #endif #ifdef XK_dead_caron XK_dead_caron, #else 0, #endif #ifdef XK_dead_doubleacute XK_dead_doubleacute, #else 0, #endif #ifdef XK_dead_abovedot XK_dead_abovedot, #else 0, #endif }; /* This is a list of Lisp names for special "accent" characters. It parallels lispy_accent_codes. */ static char *lispy_accent_keys[] = { "dead-circumflex", "dead-grave", "dead-tilde", "dead-diaeresis", "dead-macron", "dead-degree", "dead-acute", "dead-cedilla", "dead-breve", "dead-ogonek", "dead-caron", "dead-doubleacute", "dead-abovedot", }; #ifdef HAVE_NTGUI #define FUNCTION_KEY_OFFSET 0x0 char *lispy_function_keys[] = { 0, /* 0 */ 0, /* VK_LBUTTON 0x01 */ 0, /* VK_RBUTTON 0x02 */ "cancel", /* VK_CANCEL 0x03 */ 0, /* VK_MBUTTON 0x04 */ 0, 0, 0, /* 0x05 .. 0x07 */ "backspace", /* VK_BACK 0x08 */ "tab", /* VK_TAB 0x09 */ 0, 0, /* 0x0A .. 0x0B */ "clear", /* VK_CLEAR 0x0C */ "return", /* VK_RETURN 0x0D */ 0, 0, /* 0x0E .. 0x0F */ "shift", /* VK_SHIFT 0x10 */ "control", /* VK_CONTROL 0x11 */ "menu", /* VK_MENU 0x12 */ "pause", /* VK_PAUSE 0x13 */ "capital", /* VK_CAPITAL 0x14 */ 0, 0, 0, 0, 0, 0, /* 0x15 .. 0x1A */ 0, /* VK_ESCAPE 0x1B */ 0, 0, 0, 0, /* 0x1C .. 0x1F */ 0, /* VK_SPACE 0x20 */ "prior", /* VK_PRIOR 0x21 */ "next", /* VK_NEXT 0x22 */ "end", /* VK_END 0x23 */ "home", /* VK_HOME 0x24 */ "left", /* VK_LEFT 0x25 */ "up", /* VK_UP 0x26 */ "right", /* VK_RIGHT 0x27 */ "down", /* VK_DOWN 0x28 */ "select", /* VK_SELECT 0x29 */ "print", /* VK_PRINT 0x2A */ "execute", /* VK_EXECUTE 0x2B */ "snapshot", /* VK_SNAPSHOT 0x2C */ "insert", /* VK_INSERT 0x2D */ "delete", /* VK_DELETE 0x2E */ "help", /* VK_HELP 0x2F */ /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */ /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* VK_LWIN 0x5B */ 0, /* VK_RWIN 0x5C */ 0, /* VK_APPS 0x5D */ 0, 0, /* 0x5E .. 0x5F */ "kp-0", /* VK_NUMPAD0 0x60 */ "kp-1", /* VK_NUMPAD1 0x61 */ "kp-2", /* VK_NUMPAD2 0x62 */ "kp-3", /* VK_NUMPAD3 0x63 */ "kp-4", /* VK_NUMPAD4 0x64 */ "kp-5", /* VK_NUMPAD5 0x65 */ "kp-6", /* VK_NUMPAD6 0x66 */ "kp-7", /* VK_NUMPAD7 0x67 */ "kp-8", /* VK_NUMPAD8 0x68 */ "kp-9", /* VK_NUMPAD9 0x69 */ "kp-multiply", /* VK_MULTIPLY 0x6A */ "kp-add", /* VK_ADD 0x6B */ "kp-separator", /* VK_SEPARATOR 0x6C */ "kp-subtract", /* VK_SUBTRACT 0x6D */ "kp-decimal", /* VK_DECIMAL 0x6E */ "kp-divide", /* VK_DIVIDE 0x6F */ "f1", /* VK_F1 0x70 */ "f2", /* VK_F2 0x71 */ "f3", /* VK_F3 0x72 */ "f4", /* VK_F4 0x73 */ "f5", /* VK_F5 0x74 */ "f6", /* VK_F6 0x75 */ "f7", /* VK_F7 0x76 */ "f8", /* VK_F8 0x77 */ "f9", /* VK_F9 0x78 */ "f10", /* VK_F10 0x79 */ "f11", /* VK_F11 0x7A */ "f12", /* VK_F12 0x7B */ "f13", /* VK_F13 0x7C */ "f14", /* VK_F14 0x7D */ "f15", /* VK_F15 0x7E */ "f16", /* VK_F16 0x7F */ "f17", /* VK_F17 0x80 */ "f18", /* VK_F18 0x81 */ "f19", /* VK_F19 0x82 */ "f20", /* VK_F20 0x83 */ "f21", /* VK_F21 0x84 */ "f22", /* VK_F22 0x85 */ "f23", /* VK_F23 0x86 */ "f24", /* VK_F24 0x87 */ 0, 0, 0, 0, /* 0x88 .. 0x8B */ 0, 0, 0, 0, /* 0x8C .. 0x8F */ "kp-numlock", /* VK_NUMLOCK 0x90 */ "scroll", /* VK_SCROLL 0x91 */ 0, 0, 0, 0, 0, /* 0x92 .. 0x96 */ 0, 0, 0, 0, 0, /* 0x97 .. 0x9B */ 0, 0, 0, 0, /* 0x9C .. 0x9F */ /* * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys. * Used only as parameters to GetAsyncKeyState() and GetKeyState(). * No other API or message will distinguish left and right keys this way. */ /* 0xA0 .. 0xEF */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xF0 .. 0xF5 */ 0, 0, 0, 0, 0, 0, "attn", /* VK_ATTN 0xF6 */ "crsel", /* VK_CRSEL 0xF7 */ "exsel", /* VK_EXSEL 0xF8 */ "ereof", /* VK_EREOF 0xF9 */ "play", /* VK_PLAY 0xFA */ "zoom", /* VK_ZOOM 0xFB */ "noname", /* VK_NONAME 0xFC */ "pa1", /* VK_PA1 0xFD */ "oem_clear", /* VK_OEM_CLEAR 0xFE */ }; #else #define FUNCTION_KEY_OFFSET 0xff00 /* You'll notice that this table is arranged to be conveniently indexed by X Windows keysym values. */ static char *lispy_function_keys[] = { /* X Keysym value */ 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00 */ "backspace", "tab", "linefeed", "clear", 0, "return", 0, 0, 0, 0, 0, /* 0xff10 */ "pause", 0, 0, 0, 0, 0, 0, 0, "escape", 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff20...2f */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff30...3f */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */ "home", /* 0xff50 */ /* IsCursorKey */ "left", "up", "right", "down", "prior", "next", "end", "begin", 0, /* 0xff59 */ 0, 0, 0, 0, 0, 0, "select", /* 0xff60 */ /* IsMiscFunctionKey */ "print", "execute", "insert", 0, /* 0xff64 */ "undo", "redo", "menu", "find", "cancel", "help", "break", /* 0xff6b */ 0, 0, 0, 0, 0, 0, 0, 0, "backtab", 0, 0, /* 0xff76 */ 0, 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff7f */ "kp-space", /* 0xff80 */ /* IsKeypadKey */ 0, 0, 0, 0, 0, 0, 0, 0, "kp-tab", /* 0xff89 */ 0, 0, 0, "kp-enter", /* 0xff8d */ 0, 0, 0, "kp-f1", /* 0xff91 */ "kp-f2", "kp-f3", "kp-f4", "kp-home", /* 0xff95 */ "kp-left", "kp-up", "kp-right", "kp-down", "kp-prior", /* kp-page-up */ "kp-next", /* kp-page-down */ "kp-end", "kp-begin", "kp-insert", "kp-delete", 0, /* 0xffa0 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, "kp-multiply", /* 0xffaa */ "kp-add", "kp-separator", "kp-subtract", "kp-decimal", "kp-divide", /* 0xffaf */ "kp-0", /* 0xffb0 */ "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9", 0, /* 0xffba */ 0, 0, "kp-equal", /* 0xffbd */ "f1", /* 0xffbe */ /* IsFunctionKey */ "f2", "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */ "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18", "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */ "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34", "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */ 0, 0, 0, 0, 0, 0, 0, "delete" }; #endif /* HAVE_NTGUI */ static char *lispy_mouse_names[] = { "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5" }; /* Scroll bar parts. */ Lisp_Object Qabove_handle, Qhandle, Qbelow_handle; /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */ Lisp_Object *scroll_bar_parts[] = { &Qabove_handle, &Qhandle, &Qbelow_handle }; /* A vector, indexed by button number, giving the down-going location of currently depressed buttons, both scroll bar and non-scroll bar. The elements have the form (BUTTON-NUMBER MODIFIER-MASK . REST) where REST is the cdr of a position as it would be reported in the event. The make_lispy_event function stores positions here to tell the difference between click and drag events, and to store the starting location to be included in drag events. */ static Lisp_Object button_down_location; /* Information about the most recent up-going button event: Which button, what location, and what time. */ static int last_mouse_button; static int last_mouse_x; static int last_mouse_y; static unsigned long button_down_time; /* The maximum time between clicks to make a double-click, or Qnil to disable double-click detection, or Qt for no time limit. */ Lisp_Object Vdouble_click_time; /* The number of clicks in this multiple-click. */ int double_click_count; /* Given a struct input_event, build the lisp event which represents it. If EVENT is 0, build a mouse movement event from the mouse movement buffer, which should have a movement event in it. Note that events must be passed to this function in the order they are received; this function stores the location of button presses in order to build drag events when the button is released. */ static Lisp_Object make_lispy_event (event) struct input_event *event; { int i; switch (SWITCH_ENUM_CAST (event->kind)) { /* A simple keystroke. */ case ascii_keystroke: { Lisp_Object lispy_c; int c = event->code & 0377; /* Turn ASCII characters into control characters when proper. */ if (event->modifiers & ctrl_modifier) c = make_ctrl_char (c); /* Add in the other modifier bits. We took care of ctrl_modifier just above, and the shift key was taken care of by the X code, and applied to control characters by make_ctrl_char. */ c |= (event->modifiers & (meta_modifier | alt_modifier | hyper_modifier | super_modifier)); button_down_time = 0; XSETFASTINT (lispy_c, c); return lispy_c; } /* A function key. The symbol may need to have modifier prefixes tacked onto it. */ case non_ascii_keystroke: button_down_time = 0; for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++) if (event->code == lispy_accent_codes[i]) return modify_event_symbol (i, event->modifiers, Qfunction_key, Qnil, lispy_accent_keys, &accent_key_syms, (sizeof (lispy_accent_keys) / sizeof (lispy_accent_keys[0]))); /* Handle system-specific keysyms. */ if (event->code & (1 << 28)) { /* We need to use an alist rather than a vector as the cache since we can't make a vector long enuf. */ if (NILP (current_kboard->system_key_syms)) current_kboard->system_key_syms = Fcons (Qnil, Qnil); return modify_event_symbol (event->code, event->modifiers, Qfunction_key, current_kboard->Vsystem_key_alist, 0, ¤t_kboard->system_key_syms, (unsigned)-1); } return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET, event->modifiers, Qfunction_key, Qnil, lispy_function_keys, &func_key_syms, (sizeof (lispy_function_keys) / sizeof (lispy_function_keys[0]))); break; #ifdef HAVE_MOUSE /* A mouse click. Figure out where it is, decide whether it's a press, click or drag, and build the appropriate structure. */ case mouse_click: case scroll_bar_click: { int button = event->code; int is_double; Lisp_Object position; Lisp_Object *start_pos_ptr; Lisp_Object start_pos; if (button < 0 || button >= NUM_MOUSE_BUTTONS) abort (); /* Build the position as appropriate for this mouse click. */ if (event->kind == mouse_click) { int part; FRAME_PTR f = XFRAME (event->frame_or_window); Lisp_Object window; Lisp_Object posn; int row, column; /* Ignore mouse events that were made on frame that have been deleted. */ if (! FRAME_LIVE_P (f)) return Qnil; pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y), &column, &row, NULL, 1); #ifndef USE_X_TOOLKIT /* In the non-toolkit version, clicks on the menu bar are ordinary button events in the event buffer. Distinguish them, and invoke the menu. (In the toolkit version, the toolkit handles the menu bar and Emacs doesn't know about it until after the user makes a selection.) */ if (row >= 0 && row < FRAME_MENU_BAR_LINES (f) && (event->modifiers & down_modifier)) { Lisp_Object items, item; int hpos; int i; #if 0 /* Activate the menu bar on the down event. If the up event comes in before the menu code can deal with it, just ignore it. */ if (! (event->modifiers & down_modifier)) return Qnil; #endif item = Qnil; items = FRAME_MENU_BAR_ITEMS (f); for (i = 0; i < XVECTOR (items)->size; i += 3) { Lisp_Object pos, string; string = XVECTOR (items)->contents[i + 1]; pos = XVECTOR (items)->contents[i + 2]; if (NILP (string)) break; if (column >= XINT (pos) && column < XINT (pos) + XSTRING (string)->size) { item = XVECTOR (items)->contents[i]; break; } } position = Fcons (event->frame_or_window, Fcons (Qmenu_bar, Fcons (Fcons (event->x, event->y), Fcons (make_number (event->timestamp), Qnil)))); return Fcons (item, Fcons (position, Qnil)); } #endif /* not USE_X_TOOLKIT */ window = window_from_coordinates (f, column, row, &part); if (!WINDOWP (window)) { window = event->frame_or_window; posn = Qnil; } else { int pixcolumn, pixrow; column -= XINT (XWINDOW (window)->left); row -= XINT (XWINDOW (window)->top); glyph_to_pixel_coords (f, column, row, &pixcolumn, &pixrow); XSETINT (event->x, pixcolumn); XSETINT (event->y, pixrow); if (part == 1) posn = Qmode_line; else if (part == 2) posn = Qvertical_line; else XSETINT (posn, buffer_posn_from_coords (XWINDOW (window), column, row)); } position = Fcons (window, Fcons (posn, Fcons (Fcons (event->x, event->y), Fcons (make_number (event->timestamp), Qnil)))); } else { Lisp_Object window; Lisp_Object portion_whole; Lisp_Object part; window = event->frame_or_window; portion_whole = Fcons (event->x, event->y); part = *scroll_bar_parts[(int) event->part]; position = Fcons (window, Fcons (Qvertical_scroll_bar, Fcons (portion_whole, Fcons (make_number (event->timestamp), Fcons (part, Qnil))))); } start_pos_ptr = &XVECTOR (button_down_location)->contents[button]; start_pos = *start_pos_ptr; *start_pos_ptr = Qnil; is_double = (button == last_mouse_button && XINT (event->x) == last_mouse_x && XINT (event->y) == last_mouse_y && button_down_time != 0 && (EQ (Vdouble_click_time, Qt) || (INTEGERP (Vdouble_click_time) && ((int)(event->timestamp - button_down_time) < XINT (Vdouble_click_time))))); last_mouse_button = button; last_mouse_x = XINT (event->x); last_mouse_y = XINT (event->y); /* If this is a button press, squirrel away the location, so we can decide later whether it was a click or a drag. */ if (event->modifiers & down_modifier) { if (is_double) { double_click_count++; event->modifiers |= ((double_click_count > 2) ? triple_modifier : double_modifier); } else double_click_count = 1; button_down_time = event->timestamp; *start_pos_ptr = Fcopy_alist (position); } /* Now we're releasing a button - check the co-ordinates to see if this was a click or a drag. */ else if (event->modifiers & up_modifier) { /* If we did not see a down before this up, ignore the up. Probably this happened because the down event chose a menu item. It would be an annoyance to treat the release of the button that chose the menu item as a separate event. */ if (!CONSP (start_pos)) return Qnil; event->modifiers &= ~up_modifier; #if 0 /* Formerly we treated an up with no down as a click event. */ if (!CONSP (start_pos)) event->modifiers |= click_modifier; else #endif { /* The third element of every position should be the (x,y) pair. */ Lisp_Object down; down = Fnth (make_number (2), start_pos); if (EQ (event->x, XCONS (down)->car) && EQ (event->y, XCONS (down)->cdr)) { event->modifiers |= click_modifier; } else { button_down_time = 0; event->modifiers |= drag_modifier; } /* Don't check is_double; treat this as multiple if the down-event was multiple. */ if (double_click_count > 1) event->modifiers |= ((double_click_count > 2) ? triple_modifier : double_modifier); } } else /* Every mouse event should either have the down_modifier or the up_modifier set. */ abort (); { /* Get the symbol we should use for the mouse click. */ Lisp_Object head; head = modify_event_symbol (button, event->modifiers, Qmouse_click, Qnil, lispy_mouse_names, &mouse_syms, (sizeof (lispy_mouse_names) / sizeof (lispy_mouse_names[0]))); if (event->modifiers & drag_modifier) return Fcons (head, Fcons (start_pos, Fcons (position, Qnil))); else if (event->modifiers & (double_modifier | triple_modifier)) return Fcons (head, Fcons (position, Fcons (make_number (double_click_count), Qnil))); else return Fcons (head, Fcons (position, Qnil)); } } #endif /* HAVE_MOUSE */ #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) case menu_bar_event: /* The event value is in the cdr of the frame_or_window slot. */ if (!CONSP (event->frame_or_window)) abort (); return XCONS (event->frame_or_window)->cdr; #endif /* The 'kind' field of the event is something we don't recognize. */ default: abort (); } } #ifdef HAVE_MOUSE static Lisp_Object make_lispy_movement (frame, bar_window, part, x, y, time) FRAME_PTR frame; Lisp_Object bar_window; enum scroll_bar_part part; Lisp_Object x, y; unsigned long time; { #ifdef MULTI_FRAME /* Is it a scroll bar movement? */ if (frame && ! NILP (bar_window)) { Lisp_Object part_sym; part_sym = *scroll_bar_parts[(int) part]; return Fcons (Qscroll_bar_movement, (Fcons (Fcons (bar_window, Fcons (Qvertical_scroll_bar, Fcons (Fcons (x, y), Fcons (make_number (time), Fcons (part_sym, Qnil))))), Qnil))); } /* Or is it an ordinary mouse movement? */ else #endif /* MULTI_FRAME */ { int area; Lisp_Object window; Lisp_Object posn; int column, row; #ifdef MULTI_FRAME if (frame) #else if (1) #endif { /* It's in a frame; which window on that frame? */ pixel_to_glyph_coords (frame, XINT (x), XINT (y), &column, &row, NULL, 1); window = window_from_coordinates (frame, column, row, &area); } else window = Qnil; if (WINDOWP (window)) { int pixcolumn, pixrow; column -= XINT (XWINDOW (window)->left); row -= XINT (XWINDOW (window)->top); glyph_to_pixel_coords (frame, column, row, &pixcolumn, &pixrow); XSETINT (x, pixcolumn); XSETINT (y, pixrow); if (area == 1) posn = Qmode_line; else if (area == 2) posn = Qvertical_line; else XSETINT (posn, buffer_posn_from_coords (XWINDOW (window), column, row)); } #ifdef MULTI_FRAME else if (frame != 0) { XSETFRAME (window, frame); posn = Qnil; } #endif else { window = Qnil; posn = Qnil; XSETFASTINT (x, 0); XSETFASTINT (y, 0); } return Fcons (Qmouse_movement, Fcons (Fcons (window, Fcons (posn, Fcons (Fcons (x, y), Fcons (make_number (time), Qnil)))), Qnil)); } } #endif /* HAVE_MOUSE */ /* Construct a switch frame event. */ static Lisp_Object make_lispy_switch_frame (frame) Lisp_Object frame; { return Fcons (Qswitch_frame, Fcons (frame, Qnil)); } /* Manipulating modifiers. */ /* Parse the name of SYMBOL, and return the set of modifiers it contains. If MODIFIER_END is non-zero, set *MODIFIER_END to the position in SYMBOL's name of the end of the modifiers; the string from this position is the unmodified symbol name. This doesn't use any caches. */ static int parse_modifiers_uncached (symbol, modifier_end) Lisp_Object symbol; int *modifier_end; { struct Lisp_String *name; int i; int modifiers; CHECK_SYMBOL (symbol, 1); modifiers = 0; name = XSYMBOL (symbol)->name; for (i = 0; i+2 <= name->size; ) { int this_mod_end = 0; int this_mod = 0; /* See if the name continues with a modifier word. Check that the word appears, but don't check what follows it. Set this_mod and this_mod_end to record what we find. */ switch (name->data[i]) { #define SINGLE_LETTER_MOD(BIT) \ (this_mod_end = i + 1, this_mod = BIT) case 'A': SINGLE_LETTER_MOD (alt_modifier); break; case 'C': SINGLE_LETTER_MOD (ctrl_modifier); break; case 'H': SINGLE_LETTER_MOD (hyper_modifier); break; case 'M': SINGLE_LETTER_MOD (meta_modifier); break; case 'S': SINGLE_LETTER_MOD (shift_modifier); break; case 's': SINGLE_LETTER_MOD (super_modifier); break; #undef SINGLE_LETTER_MOD } /* If we found no modifier, stop looking for them. */ if (this_mod_end == 0) break; /* Check there is a dash after the modifier, so that it really is a modifier. */ if (this_mod_end >= name->size || name->data[this_mod_end] != '-') break; /* This modifier is real; look for another. */ modifiers |= this_mod; i = this_mod_end + 1; } /* Should we include the `click' modifier? */ if (! (modifiers & (down_modifier | drag_modifier | double_modifier | triple_modifier)) && i + 7 == name->size && strncmp (name->data + i, "mouse-", 6) == 0 && ('0' <= name->data[i + 6] && name->data[i + 6] <= '9')) modifiers |= click_modifier; if (modifier_end) *modifier_end = i; return modifiers; } /* Return a symbol whose name is the modifier prefixes for MODIFIERS prepended to the string BASE[0..BASE_LEN-1]. This doesn't use any caches. */ static Lisp_Object apply_modifiers_uncached (modifiers, base, base_len) int modifiers; char *base; int base_len; { /* Since BASE could contain nulls, we can't use intern here; we have to use Fintern, which expects a genuine Lisp_String, and keeps a reference to it. */ char *new_mods = (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-")); int mod_len; { char *p = new_mods; /* Only the event queue may use the `up' modifier; it should always be turned into a click or drag event before presented to lisp code. */ if (modifiers & up_modifier) abort (); if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; } if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; } if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; } if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; } if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; } if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; } if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; } if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; } if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; } if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; } /* The click modifier is denoted by the absence of other modifiers. */ *p = '\0'; mod_len = p - new_mods; } { Lisp_Object new_name; new_name = make_uninit_string (mod_len + base_len); bcopy (new_mods, XSTRING (new_name)->data, mod_len); bcopy (base, XSTRING (new_name)->data + mod_len, base_len); return Fintern (new_name, Qnil); } } static char *modifier_names[] = { "up", "down", "drag", "click", "double", "triple", 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "alt", "super", "hyper", "shift", "control", "meta" }; #define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0])) static Lisp_Object modifier_symbols; /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */ static Lisp_Object lispy_modifier_list (modifiers) int modifiers; { Lisp_Object modifier_list; int i; modifier_list = Qnil; for (i = 0; (1<contents[i], modifier_list); return modifier_list; } /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK), where UNMODIFIED is the unmodified form of SYMBOL, MASK is the set of modifiers present in SYMBOL's name. This is similar to parse_modifiers_uncached, but uses the cache in SYMBOL's Qevent_symbol_element_mask property, and maintains the Qevent_symbol_elements property. */ static Lisp_Object parse_modifiers (symbol) Lisp_Object symbol; { Lisp_Object elements; elements = Fget (symbol, Qevent_symbol_element_mask); if (CONSP (elements)) return elements; else { int end; int modifiers = parse_modifiers_uncached (symbol, &end); Lisp_Object unmodified; Lisp_Object mask; unmodified = Fintern (make_string (XSYMBOL (symbol)->name->data + end, XSYMBOL (symbol)->name->size - end), Qnil); if (modifiers & ~(((EMACS_INT)1 << VALBITS) - 1)) abort (); XSETFASTINT (mask, modifiers); elements = Fcons (unmodified, Fcons (mask, Qnil)); /* Cache the parsing results on SYMBOL. */ Fput (symbol, Qevent_symbol_element_mask, elements); Fput (symbol, Qevent_symbol_elements, Fcons (unmodified, lispy_modifier_list (modifiers))); /* Since we know that SYMBOL is modifiers applied to unmodified, it would be nice to put that in unmodified's cache. But we can't, since we're not sure that parse_modifiers is canonical. */ return elements; } } /* Apply the modifiers MODIFIERS to the symbol BASE. BASE must be unmodified. This is like apply_modifiers_uncached, but uses BASE's Qmodifier_cache property, if present. It also builds Qevent_symbol_elements properties, since it has that info anyway. apply_modifiers copies the value of BASE's Qevent_kind property to the modified symbol. */ static Lisp_Object apply_modifiers (modifiers, base) int modifiers; Lisp_Object base; { Lisp_Object cache, index, entry, new_symbol; /* Mask out upper bits. We don't know where this value's been. */ modifiers &= ((EMACS_INT)1 << VALBITS) - 1; /* The click modifier never figures into cache indices. */ cache = Fget (base, Qmodifier_cache); XSETFASTINT (index, (modifiers & ~click_modifier)); entry = assq_no_quit (index, cache); if (CONSP (entry)) new_symbol = XCONS (entry)->cdr; else { /* We have to create the symbol ourselves. */ new_symbol = apply_modifiers_uncached (modifiers, XSYMBOL (base)->name->data, XSYMBOL (base)->name->size); /* Add the new symbol to the base's cache. */ entry = Fcons (index, new_symbol); Fput (base, Qmodifier_cache, Fcons (entry, cache)); /* We have the parsing info now for free, so add it to the caches. */ XSETFASTINT (index, modifiers); Fput (new_symbol, Qevent_symbol_element_mask, Fcons (base, Fcons (index, Qnil))); Fput (new_symbol, Qevent_symbol_elements, Fcons (base, lispy_modifier_list (modifiers))); } /* Make sure this symbol is of the same kind as BASE. You'd think we could just set this once and for all when we intern the symbol above, but reorder_modifiers may call us when BASE's property isn't set right; we can't assume that just because it has a Qmodifier_cache property it must have its Qevent_kind set right as well. */ if (NILP (Fget (new_symbol, Qevent_kind))) { Lisp_Object kind; kind = Fget (base, Qevent_kind); if (! NILP (kind)) Fput (new_symbol, Qevent_kind, kind); } return new_symbol; } /* Given a symbol whose name begins with modifiers ("C-", "M-", etc), return a symbol with the modifiers placed in the canonical order. Canonical order is alphabetical, except for down and drag, which always come last. The 'click' modifier is never written out. Fdefine_key calls this to make sure that (for example) C-M-foo and M-C-foo end up being equivalent in the keymap. */ Lisp_Object reorder_modifiers (symbol) Lisp_Object symbol; { /* It's hopefully okay to write the code this way, since everything will soon be in caches, and no consing will be done at all. */ Lisp_Object parsed; parsed = parse_modifiers (symbol); return apply_modifiers ((int) XINT (XCONS (XCONS (parsed)->cdr)->car), XCONS (parsed)->car); } /* For handling events, we often want to produce a symbol whose name is a series of modifier key prefixes ("M-", "C-", etcetera) attached to some base, like the name of a function key or mouse button. modify_event_symbol produces symbols of this sort. NAME_TABLE should point to an array of strings, such that NAME_TABLE[i] is the name of the i'th symbol. TABLE_SIZE is the number of elements in the table. Alternatively, NAME_ALIST is an alist mapping codes into symbol names. NAME_ALIST is used if it is non-nil; otherwise NAME_TABLE is used. SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will persist between calls to modify_event_symbol that it can use to store a cache of the symbols it's generated for this NAME_TABLE before. The object stored there may be a vector or an alist. SYMBOL_NUM is the number of the base name we want from NAME_TABLE. MODIFIERS is a set of modifier bits (as given in struct input_events) whose prefixes should be applied to the symbol name. SYMBOL_KIND is the value to be placed in the event_kind property of the returned symbol. The symbols we create are supposed to have an `event-symbol-elements' property, which lists the modifiers present in the symbol's name. */ static Lisp_Object modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist, name_table, symbol_table, table_size) int symbol_num; unsigned modifiers; Lisp_Object symbol_kind; Lisp_Object name_alist; char **name_table; Lisp_Object *symbol_table; unsigned int table_size; { Lisp_Object value; Lisp_Object symbol_int; /* Get rid of the "vendor-specific" bit here. */ XSETINT (symbol_int, symbol_num & 0xffffff); /* Is this a request for a valid symbol? */ if (symbol_num < 0 || symbol_num >= table_size) return Qnil; if (CONSP (*symbol_table)) value = Fcdr (assq_no_quit (symbol_int, *symbol_table)); /* If *symbol_table doesn't seem to be initialized properly, fix that. *symbol_table should be a lisp vector TABLE_SIZE elements long, where the Nth element is the symbol for NAME_TABLE[N], or nil if we've never used that symbol before. */ else { if (! VECTORP (*symbol_table) || XVECTOR (*symbol_table)->size != table_size) { Lisp_Object size; XSETFASTINT (size, table_size); *symbol_table = Fmake_vector (size, Qnil); } value = XVECTOR (*symbol_table)->contents[symbol_num]; } /* Have we already used this symbol before? */ if (NILP (value)) { /* No; let's create it. */ if (!NILP (name_alist)) value = Fcdr_safe (Fassq (symbol_int, name_alist)); else if (name_table[symbol_num]) value = intern (name_table[symbol_num]); #ifdef HAVE_WINDOW_SYSTEM if (NILP (value)) { char *name = x_get_keysym_name (symbol_num); if (name) value = intern (name); } #endif if (NILP (value)) { char buf[20]; sprintf (buf, "key-%d", symbol_num); value = intern (buf); } if (CONSP (*symbol_table)) *symbol_table = Fcons (value, *symbol_table); else XVECTOR (*symbol_table)->contents[symbol_num] = value; /* Fill in the cache entries for this symbol; this also builds the Qevent_symbol_elements property, which the user cares about. */ apply_modifiers (modifiers & click_modifier, value); Fput (value, Qevent_kind, symbol_kind); } /* Apply modifiers to that symbol. */ return apply_modifiers (modifiers, value); } /* Convert a list that represents an event type, such as (ctrl meta backspace), into the usual representation of that event type as a number or a symbol. */ DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0, "Convert the event description LIST to an event type.\n\ LIST should contain one base event type (a character or symbol)\n\ and zero or more modifier names (control, meta, hyper, super, shift, alt,\n\ drag, down, double or triple).\n\ The return value is an event type (a character or symbol) which\n\ has the same base event type and all the specified modifiers.") (event) Lisp_Object event; { Lisp_Object base; int modifiers = 0; Lisp_Object rest; base = Qnil; rest = event; while (CONSP (rest)) { Lisp_Object elt; int this = 0; elt = XCONS (rest)->car; /* Given a symbol, see if it is a modifier name. */ if (SYMBOLP (elt)) this = parse_solitary_modifier (elt); if (this != 0) modifiers |= this; else if (!NILP (base)) error ("Two bases given in one event"); else base = elt; rest = XCONS (rest)->cdr; } /* Let the symbol A refer to the character A. */ if (SYMBOLP (base) && XSYMBOL (base)->name->size == 1) XSETINT (base, XSYMBOL (base)->name->data[0]); if (INTEGERP (base)) { /* Turn (shift a) into A. */ if ((modifiers & shift_modifier) != 0 && (XINT (base) >= 'a' && XINT (base) <= 'z')) { XSETINT (base, XINT (base) - ('a' - 'A')); modifiers &= ~shift_modifier; } /* Turn (control a) into C-a. */ if (modifiers & ctrl_modifier) return make_number ((modifiers & ~ctrl_modifier) | make_ctrl_char (XINT (base))); else return make_number (modifiers | XINT (base)); } else if (SYMBOLP (base)) return apply_modifiers (modifiers, base); else error ("Invalid base event"); } /* Try to recognize SYMBOL as a modifier name. Return the modifier flag bit, or 0 if not recognized. */ static int parse_solitary_modifier (symbol) Lisp_Object symbol; { struct Lisp_String *name = XSYMBOL (symbol)->name; switch (name->data[0]) { #define SINGLE_LETTER_MOD(BIT) \ if (name->size == 1) \ return BIT; #define MULTI_LETTER_MOD(BIT, NAME, LEN) \ if (LEN == name->size \ && ! strncmp (name->data, NAME, LEN)) \ return BIT; case 'A': SINGLE_LETTER_MOD (alt_modifier); break; case 'a': MULTI_LETTER_MOD (alt_modifier, "alt", 3); break; case 'C': SINGLE_LETTER_MOD (ctrl_modifier); break; case 'c': MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4); MULTI_LETTER_MOD (ctrl_modifier, "control", 7); break; case 'H': SINGLE_LETTER_MOD (hyper_modifier); break; case 'h': MULTI_LETTER_MOD (hyper_modifier, "hyper", 5); break; case 'M': SINGLE_LETTER_MOD (meta_modifier); break; case 'm': MULTI_LETTER_MOD (meta_modifier, "meta", 4); break; case 'S': SINGLE_LETTER_MOD (shift_modifier); break; case 's': MULTI_LETTER_MOD (shift_modifier, "shift", 5); MULTI_LETTER_MOD (super_modifier, "super", 5); SINGLE_LETTER_MOD (super_modifier); break; case 'd': MULTI_LETTER_MOD (drag_modifier, "drag", 4); MULTI_LETTER_MOD (down_modifier, "down", 4); MULTI_LETTER_MOD (double_modifier, "double", 6); break; case 't': MULTI_LETTER_MOD (triple_modifier, "triple", 6); break; #undef SINGLE_LETTER_MOD #undef MULTI_LETTER_MOD } return 0; } /* Return 1 if EVENT is a list whose elements are all integers or symbols. Such a list is not valid as an event, but it can be a Lucid-style event type list. */ int lucid_event_type_list_p (object) Lisp_Object object; { Lisp_Object tail; if (! CONSP (object)) return 0; for (tail = object; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object elt; elt = XCONS (tail)->car; if (! (INTEGERP (elt) || SYMBOLP (elt))) return 0; } return NILP (tail); } /* Store into *addr a value nonzero if terminal input chars are available. Serves the purpose of ioctl (0, FIONREAD, addr) but works even if FIONREAD does not exist. (In fact, this may actually read some input.) */ static void get_input_pending (addr) int *addr; { /* First of all, have we already counted some input? */ *addr = !NILP (Vquit_flag) || readable_events (); /* If input is being read as it arrives, and we have none, there is none. */ if (*addr > 0 || (interrupt_input && ! interrupts_deferred)) return; /* Try to read some input and see how much we get. */ gobble_input (0); *addr = !NILP (Vquit_flag) || readable_events (); } /* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */ int gobble_input (expected) int expected; { #ifndef VMS #ifdef SIGIO if (interrupt_input) { SIGMASKTYPE mask; mask = sigblockx (SIGIO); read_avail_input (expected); sigsetmask (mask); } else #ifdef POLL_FOR_INPUT if (read_socket_hook && !interrupt_input && poll_suppress_count == 0) { SIGMASKTYPE mask; mask = sigblockx (SIGALRM); read_avail_input (expected); sigsetmask (mask); } else #endif #endif read_avail_input (expected); #endif } /* Put a buffer_switch_event in the buffer so that read_key_sequence will notice the new current buffer. */ record_asynch_buffer_change () { struct input_event event; Lisp_Object tem; event.kind = buffer_switch_event; event.frame_or_window = Qnil; #ifdef subprocesses /* We don't need a buffer-switch event unless Emacs is waiting for input. The purpose of the event is to make read_key_sequence look up the keymaps again. If we aren't in read_key_sequence, we don't need one, and the event could cause trouble by messing up (input-pending-p). */ tem = Fwaiting_for_user_input_p (); if (NILP (tem)) return; #else /* We never need these events if we have no asynchronous subprocesses. */ return; #endif /* Make sure no interrupt happens while storing the event. */ #ifdef SIGIO if (interrupt_input) { SIGMASKTYPE mask; mask = sigblockx (SIGIO); kbd_buffer_store_event (&event); sigsetmask (mask); } else #endif { stop_polling (); kbd_buffer_store_event (&event); start_polling (); } } #ifndef VMS /* Read any terminal input already buffered up by the system into the kbd_buffer, but do not wait. EXPECTED should be nonzero if the caller knows there is some input. Except on VMS, all input is read by this function. If interrupt_input is nonzero, this function MUST be called only when SIGIO is blocked. Returns the number of keyboard chars read, or -1 meaning this is a bad time to try to read input. */ static int read_avail_input (expected) int expected; { struct input_event buf[KBD_BUFFER_SIZE]; register int i; int nread; if (read_socket_hook) /* No need for FIONREAD or fcntl; just say don't wait. */ nread = (*read_socket_hook) (input_fd, buf, KBD_BUFFER_SIZE, expected, expected); else { /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than the kbd_buffer can really hold. That may prevent loss of characters on some systems when input is stuffed at us. */ unsigned char cbuf[KBD_BUFFER_SIZE - 1]; int n_to_read; /* Determine how many characters we should *try* to read. */ #ifdef WINDOWSNT return 0; #else /* not WINDOWSNT */ #ifdef MSDOS n_to_read = dos_keysns (); if (n_to_read == 0) return 0; #else /* not MSDOS */ #ifdef FIONREAD /* Find out how much input is available. */ if (ioctl (input_fd, FIONREAD, &n_to_read) < 0) /* Formerly simply reported no input, but that sometimes led to a failure of Emacs to terminate. SIGHUP seems appropriate if we can't reach the terminal. */ /* ??? Is it really right to send the signal just to this process rather than to the whole process group? Perhaps on systems with FIONREAD Emacs is alone in its group. */ kill (getpid (), SIGHUP); if (n_to_read == 0) return 0; if (n_to_read > sizeof cbuf) n_to_read = sizeof cbuf; #else /* no FIONREAD */ #if defined (USG) || defined (DGUX) /* Read some input if available, but don't wait. */ n_to_read = sizeof cbuf; fcntl (input_fd, F_SETFL, O_NDELAY); #else you lose; #endif #endif #endif /* not MSDOS */ #endif /* not WINDOWSNT */ /* Now read; for one reason or another, this will not block. NREAD is set to the number of chars read. */ do { #ifdef MSDOS cbuf[0] = dos_keyread (); nread = 1; #else nread = read (input_fd, cbuf, n_to_read); #endif #if defined (AIX) && (! defined (aix386) && defined (_BSD)) /* The kernel sometimes fails to deliver SIGHUP for ptys. This looks incorrect, but it isn't, because _BSD causes O_NDELAY to be defined in fcntl.h as O_NONBLOCK, and that causes a value other than 0 when there is no input. */ if (nread == 0) kill (0, SIGHUP); #endif } while ( /* We used to retry the read if it was interrupted. But this does the wrong thing when O_NDELAY causes an EAGAIN error. Does anybody know of a situation where a retry is actually needed? */ #if 0 nread < 0 && (errno == EAGAIN #ifdef EFAULT || errno == EFAULT #endif #ifdef EBADSLT || errno == EBADSLT #endif ) #else 0 #endif ); #ifndef FIONREAD #if defined (USG) || defined (DGUX) fcntl (input_fd, F_SETFL, 0); #endif /* USG or DGUX */ #endif /* no FIONREAD */ for (i = 0; i < nread; i++) { buf[i].kind = ascii_keystroke; buf[i].modifiers = 0; if (meta_key == 1 && (cbuf[i] & 0x80)) buf[i].modifiers = meta_modifier; if (meta_key != 2) cbuf[i] &= ~0x80; buf[i].code = cbuf[i]; #ifdef MULTI_FRAME XSETFRAME (buf[i].frame_or_window, selected_frame); #else buf[i].frame_or_window = Qnil; #endif } } /* Scan the chars for C-g and store them in kbd_buffer. */ for (i = 0; i < nread; i++) { kbd_buffer_store_event (&buf[i]); /* Don't look at input that follows a C-g too closely. This reduces lossage due to autorepeat on C-g. */ if (buf[i].kind == ascii_keystroke && buf[i].code == quit_char) break; } return nread; } #endif /* not VMS */ #ifdef SIGIO /* for entire page */ /* Note SIGIO has been undef'd if FIONREAD is missing. */ SIGTYPE input_available_signal (signo) int signo; { /* Must preserve main program's value of errno. */ int old_errno = errno; #ifdef BSD4_1 extern int select_alarmed; #endif #ifdef USG /* USG systems forget handlers when they are used; must reestablish each time */ signal (signo, input_available_signal); #endif /* USG */ #ifdef BSD4_1 sigisheld (SIGIO); #endif if (input_available_clear_time) EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); while (1) { int nread; nread = read_avail_input (1); /* -1 means it's not ok to read the input now. UNBLOCK_INPUT will read it later; now, avoid infinite loop. 0 means there was no keyboard input available. */ if (nread <= 0) break; #ifdef BSD4_1 select_alarmed = 1; /* Force the select emulator back to life */ #endif } #ifdef BSD4_1 sigfree (); #endif errno = old_errno; } #endif /* SIGIO */ /* Send ourselves a SIGIO. This function exists so that the UNBLOCK_INPUT macro in blockinput.h can have some way to take care of input we put off dealing with, without assuming that every file which uses UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */ void reinvoke_input_signal () { #ifdef SIGIO kill (0, SIGIO); #endif } /* Return the prompt-string of a sparse keymap. This is the first element which is a string. Return nil if there is none. */ Lisp_Object map_prompt (map) Lisp_Object map; { while (CONSP (map)) { register Lisp_Object tem; tem = Fcar (map); if (STRINGP (tem)) return tem; map = Fcdr (map); } return Qnil; } static void menu_bar_item (); static void menu_bar_one_keymap (); /* These variables hold the vector under construction within menu_bar_items and its subroutines, and the current index for storing into that vector. */ static Lisp_Object menu_bar_items_vector; static int menu_bar_items_index; /* Return a vector of menu items for a menu bar, appropriate to the current buffer. Each item has three elements in the vector: KEY STRING MAPLIST. OLD is an old vector we can optionally reuse, or nil. */ Lisp_Object menu_bar_items (old) Lisp_Object old; { /* The number of keymaps we're scanning right now, and the number of keymaps we have allocated space for. */ int nmaps; /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1] in the current keymaps, or nil where it is not a prefix. */ Lisp_Object *maps; Lisp_Object def, tem, tail; Lisp_Object result; int mapno; Lisp_Object oquit; int i; struct gcpro gcpro1; /* In order to build the menus, we need to call the keymap accessors. They all call QUIT. But this function is called during redisplay, during which a quit is fatal. So inhibit quitting while building the menus. We do this instead of specbind because (1) errors will clear it anyway and (2) this avoids risk of specpdl overflow. */ oquit = Vinhibit_quit; Vinhibit_quit = Qt; if (!NILP (old)) menu_bar_items_vector = old; else menu_bar_items_vector = Fmake_vector (make_number (24), Qnil); menu_bar_items_index = 0; GCPRO1 (menu_bar_items_vector); /* Build our list of keymaps. If we recognize a function key and replace its escape sequence in keybuf with its symbol, or if the sequence starts with a mouse click and we need to switch buffers, we jump back here to rebuild the initial keymaps from the current buffer. */ { Lisp_Object *tmaps; /* Should overriding-terminal-local-map and overriding-local-map apply? */ if (!NILP (Voverriding_local_map_menu_flag)) { /* Yes, use them (if non-nil) as well as the global map. */ maps = (Lisp_Object *) alloca (3 * sizeof (maps[0])); nmaps = 0; if (!NILP (current_kboard->Voverriding_terminal_local_map)) maps[nmaps++] = current_kboard->Voverriding_terminal_local_map; if (!NILP (Voverriding_local_map)) maps[nmaps++] = Voverriding_local_map; } else { /* No, so use major and minor mode keymaps. */ nmaps = current_minor_maps (NULL, &tmaps); maps = (Lisp_Object *) alloca ((nmaps + 2) * sizeof (maps[0])); bcopy (tmaps, maps, nmaps * sizeof (maps[0])); #ifdef USE_TEXT_PROPERTIES maps[nmaps++] = get_local_map (PT, current_buffer); #else maps[nmaps++] = current_buffer->keymap; #endif } maps[nmaps++] = current_global_map; } /* Look up in each map the dummy prefix key `menu-bar'. */ result = Qnil; for (mapno = nmaps - 1; mapno >= 0; mapno--) { if (! NILP (maps[mapno])) def = get_keyelt (access_keymap (maps[mapno], Qmenu_bar, 1, 0)); else def = Qnil; tem = Fkeymapp (def); if (!NILP (tem)) menu_bar_one_keymap (def); } /* Move to the end those items that should be at the end. */ for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCONS (tail)->cdr) { int i; int end = menu_bar_items_index; for (i = 0; i < end; i += 3) if (EQ (XCONS (tail)->car, XVECTOR (menu_bar_items_vector)->contents[i])) { Lisp_Object tem0, tem1, tem2; /* Move the item at index I to the end, shifting all the others forward. */ tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0]; tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1]; tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2]; if (end > i + 3) bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 3], &XVECTOR (menu_bar_items_vector)->contents[i], (end - i - 3) * sizeof (Lisp_Object)); XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem0; XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem1; XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem2; break; } } /* Add nil, nil, nil at the end. */ i = menu_bar_items_index; if (i + 3 > XVECTOR (menu_bar_items_vector)->size) { Lisp_Object tem; int newsize = 2 * i; tem = Fmake_vector (make_number (2 * i), Qnil); bcopy (XVECTOR (menu_bar_items_vector)->contents, XVECTOR (tem)->contents, i * sizeof (Lisp_Object)); menu_bar_items_vector = tem; } /* Add this item. */ XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil; XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil; XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil; menu_bar_items_index = i; Vinhibit_quit = oquit; UNGCPRO; return menu_bar_items_vector; } /* Scan one map KEYMAP, accumulating any menu items it defines in menu_bar_items_vector. */ static void menu_bar_one_keymap (keymap) Lisp_Object keymap; { Lisp_Object tail, item, key, binding, item_string, table; /* Loop over all keymap entries that have menu strings. */ for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr) { item = XCONS (tail)->car; if (CONSP (item)) { key = XCONS (item)->car; binding = XCONS (item)->cdr; if (CONSP (binding)) { item_string = XCONS (binding)->car; if (STRINGP (item_string)) menu_bar_item (key, item_string, Fcdr (binding)); } else if (EQ (binding, Qundefined)) menu_bar_item (key, Qnil, binding); } else if (VECTORP (item)) { /* Loop over the char values represented in the vector. */ int len = XVECTOR (item)->size; int c; for (c = 0; c < len; c++) { Lisp_Object character; XSETFASTINT (character, c); binding = XVECTOR (item)->contents[c]; if (CONSP (binding)) { item_string = XCONS (binding)->car; if (STRINGP (item_string)) menu_bar_item (key, item_string, Fcdr (binding)); } else if (EQ (binding, Qundefined)) menu_bar_item (key, Qnil, binding); } } } } /* This is used as the handler when calling internal_condition_case_1. */ static Lisp_Object menu_bar_item_1 (arg) Lisp_Object arg; { return Qnil; } /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF. If there's already an item for KEY, add this DEF to it. */ static void menu_bar_item (key, item_string, def) Lisp_Object key, item_string, def; { Lisp_Object tem; Lisp_Object enabled; int i; if (EQ (def, Qundefined)) { /* If a map has an explicit `undefined' as definition, discard any previously made menu bar item. */ for (i = 0; i < menu_bar_items_index; i += 3) if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i])) { if (menu_bar_items_index > i + 3) bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 3], &XVECTOR (menu_bar_items_vector)->contents[i], (menu_bar_items_index - i - 3) * sizeof (Lisp_Object)); menu_bar_items_index -= 3; return; } /* If there's no definition for this key yet, just ignore `undefined'. */ return; } /* See if this entry is enabled. */ enabled = Qt; if (SYMBOLP (def)) { /* No property, or nil, means enable. Otherwise, enable if value is not nil. */ tem = Fget (def, Qmenu_enable); if (!NILP (tem)) /* (condition-case nil (eval tem) (error nil)) */ enabled = internal_condition_case_1 (Feval, tem, Qerror, menu_bar_item_1); } /* Ignore this item if it's not enabled. */ if (NILP (enabled)) return; /* Find any existing item for this KEY. */ for (i = 0; i < menu_bar_items_index; i += 3) if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i])) break; /* If we did not find this KEY, add it at the end. */ if (i == menu_bar_items_index) { /* If vector is too small, get a bigger one. */ if (i + 3 > XVECTOR (menu_bar_items_vector)->size) { Lisp_Object tem; int newsize = 2 * i; tem = Fmake_vector (make_number (2 * i), Qnil); bcopy (XVECTOR (menu_bar_items_vector)->contents, XVECTOR (tem)->contents, i * sizeof (Lisp_Object)); menu_bar_items_vector = tem; } /* Add this item. */ XVECTOR (menu_bar_items_vector)->contents[i++] = key; XVECTOR (menu_bar_items_vector)->contents[i++] = item_string; XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (def, Qnil); menu_bar_items_index = i; } /* We did find an item for this KEY. Add DEF to its list of maps. */ else { Lisp_Object old; old = XVECTOR (menu_bar_items_vector)->contents[i + 2]; XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (def, old); } } /* 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 the first event of a key sequence. If USED_MOUSE_MENU is non-null, 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 null, we don't dereference it. The prompting is done based on the prompt-string of the map and the strings associated with various map elements. This can be done with X menus or with menus put in the minibuf. These are done in different ways, depending on how the input will be read. Menus using X are done after auto-saving in read-char, getting the input event from Fx_popup_menu; menus using the minibuf use read_char recursively and do auto-saving in the inner call of read_char. */ static Lisp_Object read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu) int nmaps; Lisp_Object *maps; Lisp_Object prev_event; int *used_mouse_menu; { int mapno; register Lisp_Object name; Lisp_Object rest, vector; if (used_mouse_menu) *used_mouse_menu = 0; /* Use local over global Menu maps */ if (! menu_prompting) return Qnil; /* Optionally disregard all but the global map. */ if (inhibit_local_menu_bar_menus) { maps += (nmaps - 1); nmaps = 1; } /* Get the menu name from the first map that has one (a prompt string). */ for (mapno = 0; mapno < nmaps; mapno++) { name = map_prompt (maps[mapno]); if (!NILP (name)) break; } /* If we don't have any menus, just read a character normally. */ if (mapno >= nmaps) return Qnil; #if (defined (HAVE_X_WINDOWS) && defined (HAVE_X_MENU)) || defined (MSDOS) || defined (HAVE_NTGUI) /* If we got to this point via a mouse click, use a real menu for mouse selection. */ if (EVENT_HAS_PARAMETERS (prev_event) && !EQ (XCONS (prev_event)->car, Qmenu_bar)) { /* Display the menu and get the selection. */ Lisp_Object *realmaps = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); Lisp_Object value; int nmaps1 = 0; /* Use the maps that are not nil. */ for (mapno = 0; mapno < nmaps; mapno++) if (!NILP (maps[mapno])) realmaps[nmaps1++] = maps[mapno]; value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps)); if (CONSP (value)) { Lisp_Object tem; /* If we got multiple events, unread all but the first. There is no way to prevent those unread events from showing up later in last_nonmenu_event. So turn symbol and integer events into lists, to indicate that they came from a mouse menu, so that when present in last_nonmenu_event they won't confuse things. */ for (tem = XCONS (value)->cdr; !NILP (tem); tem = XCONS (tem)->cdr) if (SYMBOLP (XCONS (tem)->car) || INTEGERP (XCONS (tem)->car)) XCONS (tem)->car = Fcons (XCONS (tem)->car, Qnil); /* If we got more than one event, put all but the first onto this list to be read later. Return just the first event now. */ Vunread_command_events = nconc2 (XCONS (value)->cdr, Vunread_command_events); value = XCONS (value)->car; } else if (NILP (value)) value = Qt; if (used_mouse_menu) *used_mouse_menu = 1; return value; } #endif /* (HAVE_X_WINDOWS && HAVE_X_MENU) || MSDOS || HAVE_NTGUI */ return Qnil ; } static Lisp_Object read_char_minibuf_menu_prompt (commandflag, nmaps, maps) int commandflag ; int nmaps; Lisp_Object *maps; { int mapno; register Lisp_Object name; int nlength; int width = FRAME_WIDTH (selected_frame) - 4; char *menu = (char *) alloca (width + 4); int idx = -1; int nobindings = 1; Lisp_Object rest, vector; if (! menu_prompting) return Qnil; /* Get the menu name from the first map that has one (a prompt string). */ for (mapno = 0; mapno < nmaps; mapno++) { name = map_prompt (maps[mapno]); if (!NILP (name)) break; } /* If we don't have any menus, just read a character normally. */ if (mapno >= nmaps) return Qnil; /* Prompt string always starts with map's prompt, and a space. */ strcpy (menu, XSTRING (name)->data); nlength = XSTRING (name)->size; menu[nlength++] = ':'; menu[nlength++] = ' '; menu[nlength] = 0; /* Start prompting at start of first map. */ mapno = 0; rest = maps[mapno]; /* Present the documented bindings, a line at a time. */ while (1) { int notfirst = 0; int i = nlength; Lisp_Object obj; int ch; Lisp_Object orig_defn_macro; /* Loop over elements of map. */ while (i < width) { Lisp_Object s, elt; /* If reached end of map, start at beginning of next map. */ if (NILP (rest)) { mapno++; /* At end of last map, wrap around to first map if just starting, or end this line if already have something on it. */ if (mapno == nmaps) { mapno = 0; if (notfirst || nobindings) break; } rest = maps[mapno]; } /* Look at the next element of the map. */ if (idx >= 0) elt = XVECTOR (vector)->contents[idx]; else elt = Fcar_safe (rest); if (idx < 0 && VECTORP (elt)) { /* If we found a dense table in the keymap, advanced past it, but start scanning its contents. */ rest = Fcdr_safe (rest); vector = elt; idx = 0; } else { /* An ordinary element. */ Lisp_Object event; if (idx < 0) { s = Fcar_safe (Fcdr_safe (elt)); /* alist */ event = Fcar_safe (elt); } else { s = Fcar_safe (elt); /* vector */ XSETINT (event, idx); } /* Ignore the element if it has no prompt string. */ if (STRINGP (s) && INTEGERP (event)) { /* 1 if the char to type matches the string. */ int char_matches; Lisp_Object upcased_event, downcased_event; Lisp_Object desc; upcased_event = Fupcase (event); downcased_event = Fdowncase (event); char_matches = (XINT (upcased_event) == XSTRING (s)->data[0] || XINT (downcased_event) == XSTRING (s)->data[0]); if (! char_matches) desc = Fsingle_key_description (event); /* If we have room for the prompt string, add it to this line. If this is the first on the line, always add it. */ if ((XSTRING (s)->size + i + 2 + (char_matches ? 0 : XSTRING (desc)->size + 3)) < width || !notfirst) { int thiswidth; /* Punctuate between strings. */ if (notfirst) { strcpy (menu + i, ", "); i += 2; } notfirst = 1; nobindings = 0 ; /* If the char to type doesn't match the string's first char, explicitly show what char to type. */ if (! char_matches) { /* Add as much of string as fits. */ thiswidth = XSTRING (desc)->size; if (thiswidth + i > width) thiswidth = width - i; bcopy (XSTRING (desc)->data, menu + i, thiswidth); i += thiswidth; strcpy (menu + i, " = "); i += 3; } /* Add as much of string as fits. */ thiswidth = XSTRING (s)->size; if (thiswidth + i > width) thiswidth = width - i; bcopy (XSTRING (s)->data, menu + i, thiswidth); i += thiswidth; menu[i] = 0; } else { /* If this element does not fit, end the line now, and save the element for the next line. */ strcpy (menu + i, "..."); break; } } /* Move past this element. */ if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size) /* Handle reaching end of dense table. */ idx = -1; if (idx >= 0) idx++; else rest = Fcdr_safe (rest); } } /* Prompt with that and read response. */ message1 (menu); /* Make believe its not a keyboard macro in case the help char is pressed. Help characters are not recorded because menu prompting is not used on replay. */ orig_defn_macro = current_kboard->defining_kbd_macro; current_kboard->defining_kbd_macro = Qnil; do obj = read_char (commandflag, 0, 0, Qnil, 0); while (BUFFERP (obj)); current_kboard->defining_kbd_macro = orig_defn_macro; if (!INTEGERP (obj)) return obj; else ch = XINT (obj); if (! EQ (obj, menu_prompt_more_char) && (!INTEGERP (menu_prompt_more_char) || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char)))))) { if (!NILP (current_kboard->defining_kbd_macro)) store_kbd_macro_char (obj); return obj; } /* Help char - go round again */ } } /* Reading key sequences. */ /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a keymap, or nil otherwise. Return the index of the first keymap in which KEY has any binding, or NMAPS if no map has a binding. If KEY is a meta ASCII character, treat it like meta-prefix-char followed by the corresponding non-meta character. Keymaps in CURRENT with non-prefix bindings for meta-prefix-char become nil in NEXT. If KEY has no bindings in any of the CURRENT maps, NEXT is left unmodified. NEXT may be the same array as CURRENT. */ static int follow_key (key, nmaps, current, defs, next) Lisp_Object key; Lisp_Object *current, *defs, *next; int nmaps; { int i, first_binding; int did_meta = 0; /* If KEY is a meta ASCII character, treat it like meta-prefix-char followed by the corresponding non-meta character. Put the results into DEFS, since we are going to alter that anyway. Do not alter CURRENT or NEXT. */ if (INTEGERP (key) && (XINT (key) & CHAR_META)) { for (i = 0; i < nmaps; i++) if (! NILP (current[i])) { Lisp_Object def; def = get_keyelt (access_keymap (current[i], meta_prefix_char, 1, 0)); /* Note that since we pass the resulting bindings through get_keymap_1, non-prefix bindings for meta-prefix-char disappear. */ defs[i] = get_keymap_1 (def, 0, 1); } else defs[i] = Qnil; did_meta = 1; XSETINT (key, XFASTINT (key) & ~CHAR_META); } first_binding = nmaps; for (i = nmaps - 1; i >= 0; i--) { if (! NILP (current[i])) { Lisp_Object map; if (did_meta) map = defs[i]; else map = current[i]; defs[i] = get_keyelt (access_keymap (map, key, 1, 0)); if (! NILP (defs[i])) first_binding = i; } else defs[i] = Qnil; } /* Given the set of bindings we've found, produce the next set of maps. */ if (first_binding < nmaps) for (i = 0; i < nmaps; i++) next[i] = NILP (defs[i]) ? Qnil : get_keymap_1 (defs[i], 0, 1); return first_binding; } /* Read a sequence of keys that ends with a non prefix character, storing it in KEYBUF, a buffer of size BUFSIZE. 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. Where a key sequence ends depends on the currently active keymaps. These include any minor mode keymaps active in the current buffer, the current buffer's local map, and the global map. If a key sequence has no other bindings, we check Vfunction_key_map to see if some trailing subsequence might be the beginning of a function key's sequence. If so, we try to read the whole function key, and substitute its symbolic name into the key sequence. We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and `double-' events into similar click events, if that would make them bound. We try to turn `triple-' events first into `double-' events, then into clicks. If we get a mouse click in a mode line, vertical divider, or other non-text area, we treat the click as if it were prefixed by the symbol denoting that area - `mode-line', `vertical-line', or whatever. If the sequence starts with a mouse click, we read the key sequence with respect to the buffer clicked on, not the current buffer. If the user switches frames in the midst of a key sequence, we put off the switch-frame event until later; the next call to read_char will return it. */ static int read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, can_return_switch_frame) Lisp_Object *keybuf; int bufsize; Lisp_Object prompt; int dont_downcase_last; int can_return_switch_frame; { int count = specpdl_ptr - specpdl; /* How many keys there are in the current key sequence. */ int t; /* The length of the echo buffer when we started reading, and the length of this_command_keys when we started reading. */ int echo_start; int keys_start; /* The number of keymaps we're scanning right now, and the number of keymaps we have allocated space for. */ int nmaps; int nmaps_allocated = 0; /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in the current keymaps. */ Lisp_Object *defs; /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1] in the current keymaps, or nil where it is not a prefix. */ Lisp_Object *submaps; /* The local map to start out with at start of key sequence. */ Lisp_Object orig_local_map; /* 1 if we have already considered switching to the local-map property of the place where a mouse click occurred. */ int localized_local_map = 0; /* The index in defs[] of the first keymap that has a binding for this key sequence. In other words, the lowest i such that defs[i] is non-nil. */ int first_binding; /* If t < mock_input, then KEYBUF[t] should be read as the next input key. We use this to recover after recognizing a function key. Once we realize that a suffix of the current key sequence is actually a function key's escape sequence, we replace the suffix with the function key's binding from Vfunction_key_map. Now keybuf contains a new and different key sequence, so the echo area, this_command_keys, and the submaps and defs arrays are wrong. In this situation, we set mock_input to t, set t to 0, and jump to restart_sequence; the loop will read keys from keybuf up until mock_input, thus rebuilding the state; and then it will resume reading characters from the keyboard. */ int mock_input = 0; /* If the sequence is unbound in submaps[], then keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map, and fkey_map is its binding. These might be > t, indicating that all function key scanning should hold off until t reaches them. We do this when we've just recognized a function key, to avoid searching for the function key's again in Vfunction_key_map. */ int fkey_start = 0, fkey_end = 0; Lisp_Object fkey_map; /* Likewise, for key_translation_map. */ int keytran_start = 0, keytran_end = 0; Lisp_Object keytran_map; /* If we receive a ``switch-frame'' event in the middle of a key sequence, we put it off for later. While we're reading, we keep the event here. */ Lisp_Object delayed_switch_frame; /* See the comment below... */ #if defined (GOBBLE_FIRST_EVENT) Lisp_Object first_event; #endif Lisp_Object original_uppercase; int original_uppercase_position = -1; /* Gets around Microsoft compiler limitations. */ int dummyflag = 0; struct buffer *starting_buffer; /* Nonzero if we seem to have got the beginning of a binding in function_key_map. */ int function_key_possible = 0; int key_translation_possible = 0; /* Save the status of key translation before each step, so that we can restore this after downcasing. */ Lisp_Object prev_fkey_map; Lisp_Object prev_fkey_start; Lisp_Object prev_fkey_end; Lisp_Object prev_keytran_map; Lisp_Object prev_keytran_start; Lisp_Object prev_keytran_end; int junk; last_nonmenu_event = Qnil; delayed_switch_frame = Qnil; fkey_map = Vfunction_key_map; keytran_map = Vkey_translation_map; /* If there is no function-key-map, turn off function key scanning. */ if (NILP (Fkeymapp (Vfunction_key_map))) fkey_start = fkey_end = bufsize + 1; /* If there is no key-translation-map, turn off scanning. */ if (NILP (Fkeymapp (Vkey_translation_map))) keytran_start = keytran_end = bufsize + 1; if (INTERACTIVE) { if (!NILP (prompt)) echo_prompt (XSTRING (prompt)->data); else if (cursor_in_echo_area && echo_keystrokes) /* This doesn't put in a dash if the echo buffer is empty, so you don't always see a dash hanging out in the minibuffer. */ echo_dash (); } /* Record the initial state of the echo area and this_command_keys; we will need to restore them if we replay a key sequence. */ if (INTERACTIVE) echo_start = echo_length (); keys_start = this_command_key_count; #if defined (GOBBLE_FIRST_EVENT) /* This doesn't quite work, because some of the things that read_char does cannot safely be bypassed. It seems too risky to try to make this work right. */ /* Read the first char of the sequence specially, before setting up any keymaps, in case a filter runs and switches buffers on us. */ first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event, &junk); #endif /* GOBBLE_FIRST_EVENT */ orig_local_map = get_local_map (PT, current_buffer); /* We jump here when the key sequence has been thoroughly changed, and we need to rescan it starting from the beginning. When we jump here, keybuf[0..mock_input] holds the sequence we should reread. */ replay_sequence: starting_buffer = current_buffer; function_key_possible = 0; key_translation_possible = 0; /* Build our list of keymaps. If we recognize a function key and replace its escape sequence in keybuf with its symbol, or if the sequence starts with a mouse click and we need to switch buffers, we jump back here to rebuild the initial keymaps from the current buffer. */ { Lisp_Object *maps; if (!NILP (current_kboard->Voverriding_terminal_local_map) || !NILP (Voverriding_local_map)) { if (3 > nmaps_allocated) { submaps = (Lisp_Object *) alloca (3 * sizeof (submaps[0])); defs = (Lisp_Object *) alloca (3 * sizeof (defs[0])); nmaps_allocated = 3; } nmaps = 0; if (!NILP (current_kboard->Voverriding_terminal_local_map)) submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map; if (!NILP (Voverriding_local_map)) submaps[nmaps++] = Voverriding_local_map; } else { nmaps = current_minor_maps (0, &maps); if (nmaps + 2 > nmaps_allocated) { submaps = (Lisp_Object *) alloca ((nmaps+2) * sizeof (submaps[0])); defs = (Lisp_Object *) alloca ((nmaps+2) * sizeof (defs[0])); nmaps_allocated = nmaps + 2; } bcopy (maps, submaps, nmaps * sizeof (submaps[0])); #ifdef USE_TEXT_PROPERTIES submaps[nmaps++] = orig_local_map; #else submaps[nmaps++] = current_buffer->keymap; #endif } submaps[nmaps++] = current_global_map; } /* Find an accurate initial value for first_binding. */ for (first_binding = 0; first_binding < nmaps; first_binding++) if (! NILP (submaps[first_binding])) break; /* Start from the beginning in keybuf. */ t = 0; /* These are no-ops the first time through, but if we restart, they revert the echo area and this_command_keys to their original state. */ this_command_key_count = keys_start; if (INTERACTIVE && t < mock_input) echo_truncate (echo_start); /* If the best binding for the current key sequence is a keymap, or we may be looking at a function key's escape sequence, keep on reading. */ while ((first_binding < nmaps && ! NILP (submaps[first_binding])) || (first_binding >= nmaps && fkey_start < t /* mock input is never part of a function key's sequence. */ && mock_input <= fkey_start) || (first_binding >= nmaps && keytran_start < t && key_translation_possible) /* Don't return in the middle of a possible function key sequence, if the only bindings we found were via case conversion. Thus, if ESC O a has a function-key-map translation and ESC o has a binding, don't return after ESC O, so that we can translate ESC O plus the next character. */ ) { Lisp_Object key; int used_mouse_menu = 0; /* Where the last real key started. If we need to throw away a key that has expanded into more than one element of keybuf (say, a mouse click on the mode line which is being treated as [mode-line (mouse-...)], then we backtrack to this point of keybuf. */ int last_real_key_start; /* These variables are analogous to echo_start and keys_start; while those allow us to restart the entire key sequence, echo_local_start and keys_local_start allow us to throw away just one key. */ int echo_local_start, keys_local_start, local_first_binding; if (t >= bufsize) error ("Key sequence too long"); if (INTERACTIVE) echo_local_start = echo_length (); keys_local_start = this_command_key_count; local_first_binding = first_binding; replay_key: /* These are no-ops, unless we throw away a keystroke below and jumped back up to replay_key; in that case, these restore the variables to their original state, allowing us to replay the loop. */ if (INTERACTIVE && t < mock_input) echo_truncate (echo_local_start); this_command_key_count = keys_local_start; first_binding = local_first_binding; /* By default, assume each event is "real". */ last_real_key_start = t; /* Does mock_input indicate that we are re-reading a key sequence? */ if (t < mock_input) { key = keybuf[t]; add_command_key (key); if (echo_keystrokes) echo_char (key); } /* If not, we should actually read a character. */ else { struct buffer *buf = current_buffer; { #ifdef MULTI_KBOARD KBOARD *interrupted_kboard = current_kboard; struct frame *interrupted_frame = selected_frame; if (setjmp (wrong_kboard_jmpbuf)) { if (!NILP (delayed_switch_frame)) { interrupted_kboard->kbd_queue = Fcons (delayed_switch_frame, interrupted_kboard->kbd_queue); delayed_switch_frame = Qnil; } while (t > 0) interrupted_kboard->kbd_queue = Fcons (keybuf[--t], interrupted_kboard->kbd_queue); /* If the side queue is non-empty, ensure it begins with a switch-frame, so we'll replay it in the right context. */ if (CONSP (interrupted_kboard->kbd_queue) && (key = XCONS (interrupted_kboard->kbd_queue)->car, !(EVENT_HAS_PARAMETERS (key) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame)))) { Lisp_Object frame; XSETFRAME (frame, interrupted_frame); interrupted_kboard->kbd_queue = Fcons (make_lispy_switch_frame (frame), interrupted_kboard->kbd_queue); } mock_input = 0; orig_local_map = get_local_map (PT, current_buffer); goto replay_sequence; } #endif key = read_char (NILP (prompt), nmaps, submaps, last_nonmenu_event, &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 zero, so that's what we'll do. */ if (INTEGERP (key) && XINT (key) == -1) { t = 0; /* The Microsoft C compiler can't handle the goto that would go here. */ dummyflag = 1; break; } /* If the current buffer has been changed from under us, the keymap may have changed, so replay the sequence. */ if (BUFFERP (key)) { mock_input = t; orig_local_map = get_local_map (PT, current_buffer); goto replay_sequence; } /* If we have a quit that was typed in another frame, and quit_throw_to_read_char switched buffers, replay to get the right keymap. */ if (XINT (key) == quit_char && current_buffer != starting_buffer) { keybuf[t++] = key; mock_input = t; Vquit_flag = Qnil; orig_local_map = get_local_map (PT, current_buffer); goto replay_sequence; } Vquit_flag = Qnil; } /* Clicks in non-text areas get prefixed by the symbol in their CHAR-ADDRESS field. For example, a click on the mode line is prefixed by the symbol `mode-line'. Furthermore, key sequences beginning with mouse clicks are read using the keymaps of the buffer clicked on, not the current buffer. So we may have to switch the buffer here. When we turn one event into two events, we must make sure that neither of the two looks like the original--so that, if we replay the events, they won't be expanded again. If not for this, such reexpansion could happen either here or when user programs play with this-command-keys. */ if (EVENT_HAS_PARAMETERS (key)) { Lisp_Object kind; kind = EVENT_HEAD_KIND (EVENT_HEAD (key)); if (EQ (kind, Qmouse_click)) { Lisp_Object window, posn; window = POSN_WINDOW (EVENT_START (key)); posn = POSN_BUFFER_POSN (EVENT_START (key)); if (CONSP (posn)) { /* We're looking at the second event of a sequence which we expanded before. Set last_real_key_start appropriately. */ if (t > 0) last_real_key_start = t - 1; } /* Key sequences beginning with mouse clicks are read using the keymaps in the buffer clicked on, not the current buffer. If we're at the beginning of a key sequence, switch buffers. */ if (last_real_key_start == 0 && WINDOWP (window) && BUFFERP (XWINDOW (window)->buffer) && XBUFFER (XWINDOW (window)->buffer) != current_buffer) { keybuf[t] = key; mock_input = t + 1; /* Arrange to go back to the original buffer once we're done reading the key sequence. Note that we can't use save_excursion_{save,restore} here, because they save point as well as the current buffer; we don't want to save point, because redisplay may change it, to accommodate a Fset_window_start or something. We don't want to do this at the top of the function, because we may get input from a subprocess which wants to change the selected window and stuff (say, emacsclient). */ record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); set_buffer_internal (XBUFFER (XWINDOW (window)->buffer)); orig_local_map = get_local_map (PT, current_buffer); goto replay_sequence; } /* For a mouse click, get the local text-property keymap of the place clicked on, rather than point. */ if (last_real_key_start == 0 && CONSP (XCONS (key)->cdr) && ! localized_local_map) { Lisp_Object map_here, start, pos; localized_local_map = 1; start = EVENT_START (key); if (CONSP (start) && CONSP (XCONS (start)->cdr)) { pos = POSN_BUFFER_POSN (start); if (INTEGERP (pos) && XINT (pos) >= BEG && XINT (pos) <= Z) { map_here = get_local_map (XINT (pos), current_buffer); if (!EQ (map_here, orig_local_map)) { orig_local_map = map_here; keybuf[t] = key; mock_input = t + 1; goto replay_sequence; } } } } /* Expand mode-line and scroll-bar events into two events: use posn as a fake prefix key. */ if (SYMBOLP (posn)) { if (t + 1 >= bufsize) error ("Key sequence too long"); keybuf[t] = posn; keybuf[t+1] = key; mock_input = t + 2; /* Zap the position in key, so we know that we've expanded it, and don't try to do so again. */ POSN_BUFFER_POSN (EVENT_START (key)) = Fcons (posn, Qnil); goto replay_key; } } else if (EQ (kind, Qswitch_frame)) { /* If we're at the beginning of a key sequence, and the caller says it's okay, go ahead and return this event. If we're in the midst of a key sequence, delay it until the end. */ if (t > 0 || !can_return_switch_frame) { delayed_switch_frame = key; goto replay_key; } } else if (CONSP (XCONS (key)->cdr) && CONSP (EVENT_START (key)) && CONSP (XCONS (EVENT_START (key))->cdr)) { Lisp_Object posn; posn = POSN_BUFFER_POSN (EVENT_START (key)); /* Handle menu-bar events: insert the dummy prefix event `menu-bar'. */ if (EQ (posn, Qmenu_bar)) { if (t + 1 >= bufsize) error ("Key sequence too long"); keybuf[t] = posn; keybuf[t+1] = key; /* Zap the position in key, so we know that we've expanded it, and don't try to do so again. */ POSN_BUFFER_POSN (EVENT_START (key)) = Fcons (posn, Qnil); mock_input = t + 2; goto replay_sequence; } else if (CONSP (posn)) { /* We're looking at the second event of a sequence which we expanded before. Set last_real_key_start appropriately. */ if (last_real_key_start == t && t > 0) last_real_key_start = t - 1; } } } /* We have finally decided that KEY is something we might want to look up. */ first_binding = (follow_key (key, nmaps - first_binding, submaps + first_binding, defs + first_binding, submaps + first_binding) + first_binding); /* If KEY wasn't bound, we'll try some fallbacks. */ if (first_binding >= nmaps) { Lisp_Object head; head = EVENT_HEAD (key); if (help_char_p (head) && t > 0) { read_key_sequence_cmd = Vprefix_help_command; keybuf[t++] = key; last_nonmenu_event = key; /* The Microsoft C compiler can't handle the goto that would go here. */ dummyflag = 1; break; } if (SYMBOLP (head)) { Lisp_Object breakdown; int modifiers; breakdown = parse_modifiers (head); modifiers = XINT (XCONS (XCONS (breakdown)->cdr)->car); /* Attempt to reduce an unbound mouse event to a simpler event that is bound: Drags reduce to clicks. Double-clicks reduce to clicks. Triple-clicks reduce to double-clicks, then to clicks. Down-clicks are eliminated. Double-downs reduce to downs, then are eliminated. Triple-downs reduce to double-downs, then to downs, then are eliminated. */ if (modifiers & (down_modifier | drag_modifier | double_modifier | triple_modifier)) { while (modifiers & (down_modifier | drag_modifier | double_modifier | triple_modifier)) { Lisp_Object new_head, new_click; if (modifiers & triple_modifier) modifiers ^= (double_modifier | triple_modifier); else if (modifiers & double_modifier) modifiers &= ~double_modifier; else if (modifiers & drag_modifier) modifiers &= ~drag_modifier; else { /* Dispose of this `down' event by simply jumping back to replay_key, to get another event. Note that if this event came from mock input, then just jumping back to replay_key will just hand it to us again. So we have to wipe out any mock input. We could delete keybuf[t] and shift everything after that to the left by one spot, but we'd also have to fix up any variable that points into keybuf, and shifting isn't really necessary anyway. Adding prefixes for non-textual mouse clicks creates two characters of mock input, and both must be thrown away. If we're only looking at the prefix now, we can just jump back to replay_key. On the other hand, if we've already processed the prefix, and now the actual click itself is giving us trouble, then we've lost the state of the keymaps we want to backtrack to, and we need to replay the whole sequence to rebuild it. Beyond that, only function key expansion could create more than two keys, but that should never generate mouse events, so it's okay to zero mock_input in that case too. Isn't this just the most wonderful code ever? */ if (t == last_real_key_start) { mock_input = 0; goto replay_key; } else { mock_input = last_real_key_start; goto replay_sequence; } } new_head = apply_modifiers (modifiers, XCONS (breakdown)->car); new_click = Fcons (new_head, Fcons (EVENT_START (key), Qnil)); /* Look for a binding for this new key. follow_key promises that it didn't munge submaps the last time we called it, since key was unbound. */ first_binding = (follow_key (new_click, nmaps - local_first_binding, submaps + local_first_binding, defs + local_first_binding, submaps + local_first_binding) + local_first_binding); /* If that click is bound, go for it. */ if (first_binding < nmaps) { key = new_click; break; } /* Otherwise, we'll leave key set to the drag event. */ } } } } keybuf[t++] = key; /* Normally, last_nonmenu_event gets the previous key we read. But when a mouse popup menu is being used, we don't update last_nonmenu_event; it continues to hold the mouse event that preceded the first level of menu. */ if (!used_mouse_menu) last_nonmenu_event = key; prev_fkey_map = fkey_map; prev_fkey_start = fkey_start; prev_fkey_end = fkey_end; prev_keytran_map = keytran_map; prev_keytran_start = keytran_start; prev_keytran_end = keytran_end; /* If the sequence is unbound, see if we can hang a function key off the end of it. We only want to scan real keyboard input for function key sequences, so if mock_input says that we're re-reading old events, don't examine it. */ if (first_binding >= nmaps && t >= mock_input) { Lisp_Object fkey_next; /* Continue scan from fkey_end until we find a bound suffix. If we fail, increment fkey_start and start fkey_end from there. */ while (fkey_end < t) { Lisp_Object key; key = keybuf[fkey_end++]; /* Look up meta-characters by prefixing them with meta_prefix_char. I hate this. */ if (INTEGERP (key) && XINT (key) & meta_modifier) { fkey_next = get_keymap_1 (get_keyelt (access_keymap (fkey_map, meta_prefix_char, 1, 0)), 0, 1); XSETFASTINT (key, XFASTINT (key) & ~meta_modifier); } else fkey_next = fkey_map; fkey_next = get_keyelt (access_keymap (fkey_next, key, 1, 0)); #if 0 /* I didn't turn this on, because it might cause trouble for the mapping of return into C-m and tab into C-i. */ /* Optionally don't map function keys into other things. This enables the user to redefine kp- keys easily. */ if (SYMBOLP (key) && !NILP (Vinhibit_function_key_mapping)) fkey_next = Qnil; #endif /* If the function key map gives a function, not an array, then call the function with no args and use its value instead. */ if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next)) && fkey_end == t) { struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object tem; tem = fkey_next; GCPRO3 (fkey_map, keytran_map, delayed_switch_frame); fkey_next = call1 (fkey_next, prompt); UNGCPRO; /* If the function returned something invalid, barf--don't ignore it. (To ignore it safely, we would need to gcpro a bunch of other variables.) */ if (! (VECTORP (fkey_next) || STRINGP (fkey_next))) error ("Function in function-key-map returns invalid key sequence"); } function_key_possible = ! NILP (fkey_next); /* If keybuf[fkey_start..fkey_end] is bound in the function key map and it's a suffix of the current 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 = XFASTINT (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++) XSETFASTINT (keybuf[fkey_start + i], XSTRING (fkey_next)->data[i]); } mock_input = t; fkey_start = fkey_end = t; fkey_map = Vfunction_key_map; /* Do pass the results through key-translation-map. */ keytran_start = keytran_end = 0; keytran_map = Vkey_translation_map; goto replay_sequence; } fkey_map = get_keymap_1 (fkey_next, 0, 1); /* If we no longer have a bound suffix, try a new positions for fkey_start. */ if (NILP (fkey_map)) { fkey_end = ++fkey_start; fkey_map = Vfunction_key_map; function_key_possible = 0; } } } /* Look for this sequence in key-translation-map. */ { Lisp_Object keytran_next; /* Scan from keytran_end until we find a bound suffix. */ while (keytran_end < t) { Lisp_Object key; key = keybuf[keytran_end++]; /* Look up meta-characters by prefixing them with meta_prefix_char. I hate this. */ if (INTEGERP (key) && XINT (key) & meta_modifier) { keytran_next = get_keymap_1 (get_keyelt (access_keymap (keytran_map, meta_prefix_char, 1, 0)), 0, 1); XSETFASTINT (key, XFASTINT (key) & ~meta_modifier); } else keytran_next = keytran_map; keytran_next = get_keyelt (access_keymap (keytran_next, key, 1, 0)); /* If the key translation map gives a function, not an array, then call the function with no args and use its value instead. */ if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next)) && keytran_end == t) { struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object tem; tem = keytran_next; GCPRO3 (fkey_map, keytran_map, delayed_switch_frame); keytran_next = call1 (keytran_next, prompt); UNGCPRO; /* If the function returned something invalid, barf--don't ignore it. (To ignore it safely, we would need to gcpro a bunch of other variables.) */ if (! (VECTORP (keytran_next) || STRINGP (keytran_next))) error ("Function in key-translation-map returns invalid key sequence"); } key_translation_possible = ! NILP (keytran_next); /* If keybuf[keytran_start..keytran_end] is bound in the key translation map and it's a suffix of the current sequence (i.e. keytran_end == t), replace it with the binding and restart with keytran_start at the end. */ if ((VECTORP (keytran_next) || STRINGP (keytran_next)) && keytran_end == t) { int len = XFASTINT (Flength (keytran_next)); t = keytran_start + len; if (t >= bufsize) error ("Key sequence too long"); if (VECTORP (keytran_next)) bcopy (XVECTOR (keytran_next)->contents, keybuf + keytran_start, (t - keytran_start) * sizeof (keybuf[0])); else if (STRINGP (keytran_next)) { int i; for (i = 0; i < len; i++) XSETFASTINT (keybuf[keytran_start + i], XSTRING (keytran_next)->data[i]); } mock_input = t; keytran_start = keytran_end = t; keytran_map = Vkey_translation_map; /* Don't pass the results of key-translation-map through function-key-map. */ fkey_start = fkey_end = t; fkey_map = Vkey_translation_map; goto replay_sequence; } keytran_map = get_keymap_1 (keytran_next, 0, 1); /* If we no longer have a bound suffix, try a new positions for keytran_start. */ if (NILP (keytran_map)) { keytran_end = ++keytran_start; keytran_map = Vkey_translation_map; key_translation_possible = 0; } } } /* If KEY is not defined in any of the keymaps, and cannot be part of a function key or translation, and is an upper case letter use the corresponding lower-case letter instead. */ if (first_binding == nmaps && ! function_key_possible && ! key_translation_possible && INTEGERP (key) && ((((XINT (key) & 0x3ffff) < XSTRING (current_buffer->downcase_table)->size) && UPPERCASEP (XINT (key) & 0x3ffff)) || (XINT (key) & shift_modifier))) { Lisp_Object new_key; original_uppercase = key; original_uppercase_position = t - 1; if (XINT (new_key) & shift_modifier) XSETINT (new_key, XINT (key) & ~shift_modifier); else XSETINT (new_key, (DOWNCASE (XINT (key) & 0x3ffff) | (XINT (key) & ~0x3ffff))); /* We have to do this unconditionally, regardless of whether the lower-case char is defined in the keymaps, because they might get translated through function-key-map. */ keybuf[t - 1] = new_key; mock_input = t; fkey_map = prev_fkey_map; fkey_start = prev_fkey_start; fkey_end = prev_fkey_end; keytran_map = prev_keytran_map; keytran_start = prev_keytran_start; keytran_end = prev_keytran_end; goto replay_sequence; } /* If KEY is not defined in any of the keymaps, and cannot be part of a function key or translation, and is a shifted function key, use the corresponding unshifted function key instead. */ if (first_binding == nmaps && ! function_key_possible && ! key_translation_possible && SYMBOLP (key)) { Lisp_Object breakdown; int modifiers; breakdown = parse_modifiers (key); modifiers = XINT (XCONS (XCONS (breakdown)->cdr)->car); if (modifiers & shift_modifier) { Lisp_Object new_key; original_uppercase = key; original_uppercase_position = t - 1; modifiers &= ~shift_modifier; new_key = apply_modifiers (modifiers, XCONS (breakdown)->car); keybuf[t - 1] = new_key; mock_input = t; fkey_map = prev_fkey_map; fkey_start = prev_fkey_start; fkey_end = prev_fkey_end; keytran_map = prev_keytran_map; keytran_start = prev_keytran_start; keytran_end = prev_keytran_end; goto replay_sequence; } } } if (!dummyflag) read_key_sequence_cmd = (first_binding < nmaps ? defs[first_binding] : Qnil); unread_switch_frame = delayed_switch_frame; unbind_to (count, Qnil); /* Don't downcase the last character if the caller says don't. Don't downcase it if the result is undefined, either. */ if ((dont_downcase_last || first_binding >= nmaps) && t - 1 == original_uppercase_position) keybuf[t - 1] = original_uppercase; /* Occasionally we fabricate events, perhaps by expanding something according to function-key-map, or by adding a prefix symbol to a mouse click in the scroll bar or modeline. In this cases, return the entire generated key sequence, even if we hit an unbound prefix or a definition before the end. This means that you will be able to push back the event properly, and also means that read-key-sequence will always return a logical unit. Better ideas? */ for (; t < mock_input; t++) { if (echo_keystrokes) echo_char (keybuf[t]); add_command_key (keybuf[t]); } return t; } #if 0 /* This doc string is too long for some compilers. This commented-out definition serves for DOC. */ DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0, "Read a sequence of keystrokes and return as a string or vector.\n\ The sequence is sufficient to specify a non-prefix command in the\n\ current local and global maps.\n\ \n\ First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\ Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\ as a continuation of the previous key.\n\ \n\ The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not\n\ convert the last event to lower case. (Normally any upper case event\n\ is converted to lower case if the original event is undefined and the lower\n\ case equivalent is defined.) A non-nil value is appropriate for reading\n\ a key sequence to be defined.\n\ \n\ A C-g typed while in this function is treated like any other character,\n\ and `quit-flag' is not set.\n\ \n\ If the key sequence starts with a mouse click, then the sequence is read\n\ using the keymaps of the buffer of the window clicked in, not the buffer\n\ of the selected window as normal.\n\ ""\n\ `read-key-sequence' drops unbound button-down events, since you normally\n\ only care about the click or drag events which follow them. If a drag\n\ or multi-click event is unbound, but the corresponding click event would\n\ be bound, `read-key-sequence' turns the event into a click event at the\n\ drag's starting position. This means that you don't have to distinguish\n\ between click and drag, double, or triple events unless you want to.\n\ \n\ `read-key-sequence' prefixes mouse events on mode lines, the vertical\n\ lines separating windows, and scroll bars with imaginary keys\n\ `mode-line', `vertical-line', and `vertical-scroll-bar'.\n\ \n\ Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this\n\ function will process a switch-frame event if the user switches frames\n\ before typing anything. If the user switches frames in the middle of a\n\ key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME\n\ is nil, then the event will be put off until after the current key sequence.\n\ \n\ `read-key-sequence' checks `function-key-map' for function key\n\ sequences, where they wouldn't conflict with ordinary bindings. See\n\ `function-key-map' for more details.") (prompt, continue_echo, dont_downcase_last, can_return_switch_frame) #endif DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0, 0) (prompt, continue_echo, dont_downcase_last, can_return_switch_frame) Lisp_Object prompt, continue_echo, dont_downcase_last; Lisp_Object can_return_switch_frame; { Lisp_Object keybuf[30]; register int i; struct gcpro gcpro1, gcpro2; if (!NILP (prompt)) CHECK_STRING (prompt, 0); QUIT; bzero (keybuf, sizeof keybuf); GCPRO1 (keybuf[0]); gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0])); if (NILP (continue_echo)) this_command_key_count = 0; i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])), prompt, ! NILP (dont_downcase_last), ! NILP (can_return_switch_frame)); if (i == -1) { Vquit_flag = Qt; QUIT; } UNGCPRO; return make_event_array (i, keybuf); } DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 3, 0, "Execute CMD as an editor command.\n\ CMD must be a symbol that satisfies the `commandp' predicate.\n\ Optional second arg RECORD-FLAG non-nil\n\ means unconditionally put this command in `command-history'.\n\ Otherwise, that is done only if an arg is read using the minibuffer.\n\ The argument KEYS specifies the value to use instead of (this-command-keys)\n\ when reading the arguments; if it is nil, (this_command_key_count) is used.") (cmd, record, keys) Lisp_Object cmd, record, keys; { register Lisp_Object final; register Lisp_Object tem; Lisp_Object prefixarg; struct backtrace backtrace; extern int debug_on_next_call; prefixarg = current_kboard->Vprefix_arg; current_kboard->Vprefix_arg = Qnil; Vcurrent_prefix_arg = prefixarg; debug_on_next_call = 0; if (SYMBOLP (cmd)) { tem = Fget (cmd, Qdisabled); if (!NILP (tem) && !NILP (Vrun_hooks)) { tem = Fsymbol_value (Qdisabled_command_hook); if (!NILP (tem)) return call1 (Vrun_hooks, Qdisabled_command_hook); } } while (1) { final = Findirect_function (cmd); if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload))) do_autoload (final, cmd); else break; } if (STRINGP (final) || VECTORP (final)) { /* If requested, place the macro in the command history. For other sorts of commands, call-interactively takes care of this. */ if (!NILP (record)) Vcommand_history = Fcons (Fcons (Qexecute_kbd_macro, Fcons (final, Fcons (prefixarg, Qnil))), Vcommand_history); return Fexecute_kbd_macro (final, prefixarg); } if (CONSP (final) || SUBRP (final) || COMPILEDP (final)) { backtrace.next = backtrace_list; backtrace_list = &backtrace; backtrace.function = &Qcall_interactively; backtrace.args = &cmd; backtrace.nargs = 1; backtrace.evalargs = 0; tem = Fcall_interactively (cmd, record, keys); backtrace_list = backtrace.next; return tem; } return Qnil; } DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command, 1, 1, "P", "Read function name, then read its arguments and call it.") (prefixarg) Lisp_Object prefixarg; { Lisp_Object function; char buf[40]; Lisp_Object saved_keys; struct gcpro gcpro1; saved_keys = Fvector (this_command_key_count, XVECTOR (this_command_keys)->contents); buf[0] = 0; GCPRO1 (saved_keys); if (EQ (prefixarg, Qminus)) strcpy (buf, "- "); else if (CONSP (prefixarg) && XINT (XCONS (prefixarg)->car) == 4) strcpy (buf, "C-u "); else if (CONSP (prefixarg) && INTEGERP (XCONS (prefixarg)->car)) { if (sizeof (int) == sizeof (EMACS_INT)) sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car)); else if (sizeof (long) == sizeof (EMACS_INT)) sprintf (buf, "%ld ", XINT (XCONS (prefixarg)->car)); else abort (); } else if (INTEGERP (prefixarg)) { if (sizeof (int) == sizeof (EMACS_INT)) sprintf (buf, "%d ", XINT (prefixarg)); else if (sizeof (long) == sizeof (EMACS_INT)) sprintf (buf, "%ld ", XINT (prefixarg)); else abort (); } /* This isn't strictly correct if execute-extended-command is bound to anything else. Perhaps it should use this_command_keys? */ strcat (buf, "M-x "); /* Prompt with buf, and then read a string, completing from and restricting to the set of all defined commands. Don't provide any initial input. Save the command read on the extended-command history list. */ function = Fcompleting_read (build_string (buf), Vobarray, Qcommandp, Qt, Qnil, Qextended_command_history); /* Set this_command_keys to the concatenation of saved_keys and function, followed by a RET. */ { struct Lisp_String *str; Lisp_Object *keys; int i; Lisp_Object tem; this_command_key_count = 0; keys = XVECTOR (saved_keys)->contents; for (i = 0; i < XVECTOR (saved_keys)->size; i++) add_command_key (keys[i]); str = XSTRING (function); for (i = 0; i < str->size; i++) { XSETFASTINT (tem, str->data[i]); add_command_key (tem); } XSETFASTINT (tem, '\015'); add_command_key (tem); } UNGCPRO; function = Fintern (function, Qnil); current_kboard->Vprefix_arg = prefixarg; this_command = function; /* If enabled, show which key runs this command. */ if (!NILP (Vsuggest_key_bindings) && SYMBOLP (function)) { Lisp_Object bindings; bindings = Fwhere_is_internal (function, Voverriding_local_map, Qt, Qnil); if (!NILP (bindings)) { message ("You can run the command `%s' by typing %s", XSYMBOL (function)->name->data, XSTRING (Fkey_description (bindings))->data); Fsit_for ((NUMBERP (Vsuggest_key_bindings) ? Vsuggest_key_bindings : make_number (2)), Qnil, Qnil); } } return Fcommand_execute (function, Qt, Qnil); } /* Find the set of keymaps now active. Store into *MAPS_P a vector holding the various maps and return the number of them. The vector was malloc'd and the caller should free it. */ int current_active_maps (maps_p) Lisp_Object **maps_p; { Lisp_Object *tmaps, *maps; int nmaps; /* Should overriding-terminal-local-map and overriding-local-map apply? */ if (!NILP (Voverriding_local_map_menu_flag)) { /* Yes, use them (if non-nil) as well as the global map. */ maps = (Lisp_Object *) xmalloc (3 * sizeof (maps[0])); nmaps = 0; if (!NILP (current_kboard->Voverriding_terminal_local_map)) maps[nmaps++] = current_kboard->Voverriding_terminal_local_map; if (!NILP (Voverriding_local_map)) maps[nmaps++] = Voverriding_local_map; } else { /* No, so use major and minor mode keymaps. */ nmaps = current_minor_maps (NULL, &tmaps); maps = (Lisp_Object *) xmalloc ((nmaps + 2) * sizeof (maps[0])); bcopy (tmaps, maps, nmaps * sizeof (maps[0])); #ifdef USE_TEXT_PROPERTIES maps[nmaps++] = get_local_map (PT, current_buffer); #else maps[nmaps++] = current_buffer->keymap; #endif } maps[nmaps++] = current_global_map; *maps_p = maps; return nmaps; } detect_input_pending () { if (!input_pending) get_input_pending (&input_pending); return input_pending; } /* This is called in some cases before a possible quit. It cases the next call to detect_input_pending to recompute input_pending. So calling this function unnecessarily can't do any harm. */ clear_input_pending () { input_pending = 0; } DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0, "T if command input is currently available with no waiting.\n\ Actually, the value is nil only if we can be sure that no input is available.") () { if (!NILP (Vunread_command_events) || unread_command_char != -1) return (Qt); return detect_input_pending () ? Qt : Qnil; } DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0, "Return vector of last 100 events, not counting those from keyboard macros.") () { Lisp_Object *keys = XVECTOR (recent_keys)->contents; Lisp_Object val; if (total_keys < NUM_RECENT_KEYS) return Fvector (total_keys, keys); else { val = Fvector (NUM_RECENT_KEYS, keys); bcopy (keys + recent_keys_index, XVECTOR (val)->contents, (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object)); bcopy (keys, XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index, recent_keys_index * sizeof (Lisp_Object)); return val; } } DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0, "Return the key sequence that invoked this command.\n\ The value is a string or a vector.") () { return make_event_array (this_command_key_count, XVECTOR (this_command_keys)->contents); } DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, Sreset_this_command_lengths, 0, 0, 0, "Used for complicated reasons in `universal-argument-other-key'.\n\ \n\ `universal-argument-other-key' rereads the event just typed.\n\ It then gets translated through `function-key-map'.\n\ The translated event gets included in the echo area and in\n\ the value of `this-command-keys' in addition to the raw original event.\n\ That is not right.\n\ \n\ Calling this function directs the translated event to replace\n\ the original event, so that only one version of the event actually\n\ appears in the echo area and in the value of `this-command-keys.'.") () { before_command_restore_flag = 1; before_command_key_count_1 = before_command_key_count; before_command_echo_length_1 = before_command_echo_length; } DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0, "Return the current depth in recursive edits.") () { Lisp_Object temp; XSETFASTINT (temp, command_loop_level + minibuf_level); return temp; } DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1, "FOpen dribble file: ", "Start writing all keyboard characters to a dribble file called FILE.\n\ If FILE is nil, close any open dribble file.") (file) Lisp_Object file; { if (NILP (file)) { if (dribble) { fclose (dribble); dribble = 0; } } else { file = Fexpand_file_name (file, Qnil); dribble = fopen (XSTRING (file)->data, "w"); } return Qnil; } DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0, "Discard the contents of the terminal input buffer.\n\ Also cancel any kbd macro being defined.") () { current_kboard->defining_kbd_macro = Qnil; update_mode_lines++; Vunread_command_events = Qnil; unread_command_char = -1; discard_tty_input (); /* Without the cast, GCC complains that this assignment loses the volatile qualifier of kbd_store_ptr. Is there anything wrong with that? */ kbd_fetch_ptr = (struct input_event *) kbd_store_ptr; Ffillarray (kbd_buffer_frame_or_window, Qnil); input_pending = 0; return Qnil; } DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "", "Stop Emacs and return to superior process. You can resume later.\n\ If `cannot-suspend' is non-nil, or if the system doesn't support job\n\ control, run a subshell instead.\n\n\ If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\ to be read as terminal input by Emacs's parent, after suspension.\n\ \n\ Before suspending, run the normal hook `suspend-hook'.\n\ After resumption run the normal hook `suspend-resume-hook'.\n\ \n\ Some operating systems cannot stop the Emacs process and resume it later.\n\ On such systems, Emacs starts a subshell instead of suspending.") (stuffstring) Lisp_Object stuffstring; { Lisp_Object tem; int count = specpdl_ptr - specpdl; int old_height, old_width; int width, height; struct gcpro gcpro1, gcpro2; extern init_sys_modes (); if (!NILP (stuffstring)) CHECK_STRING (stuffstring, 0); /* Run the functions in suspend-hook. */ if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, intern ("suspend-hook")); GCPRO1 (stuffstring); get_frame_size (&old_width, &old_height); reset_sys_modes (); /* sys_suspend can get an error if it tries to fork a subshell and the system resources aren't available for that. */ record_unwind_protect (init_sys_modes, 0); stuff_buffered_input (stuffstring); if (cannot_suspend) sys_subshell (); else sys_suspend (); unbind_to (count, Qnil); /* Check if terminal/window size has changed. Note that this is not useful when we are running directly with a window system; but suspend should be disabled in that case. */ 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. */ if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, intern ("suspend-resume-hook")); UNGCPRO; return Qnil; } /* If STUFFSTRING is a string, stuff its contents as pending terminal input. Then in any case stuff anything Emacs has read ahead and not used. */ stuff_buffered_input (stuffstring) Lisp_Object stuffstring; { /* stuff_char works only in BSD, versions 4.2 and up. */ #ifdef BSD #ifndef BSD4_1 register unsigned char *p; if (STRINGP (stuffstring)) { register int count; p = XSTRING (stuffstring)->data; count = XSTRING (stuffstring)->size; while (count-- > 0) stuff_char (*p++); stuff_char ('\n'); } /* Anything we have read ahead, put back for the shell to read. */ /* ?? What should this do when we have multiple keyboards?? Should we ignore anything that was typed in at the "wrong" kboard? */ for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++) { if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) kbd_fetch_ptr = kbd_buffer; if (kbd_fetch_ptr->kind == ascii_keystroke) stuff_char (kbd_fetch_ptr->code); kbd_fetch_ptr->kind = no_event; (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_fetch_ptr - kbd_buffer] = Qnil); } input_pending = 0; #endif #endif /* BSD and not BSD4_1 */ } set_waiting_for_input (time_to_clear) EMACS_TIME *time_to_clear; { input_available_clear_time = time_to_clear; /* Tell interrupt_signal to throw back to read_char, */ waiting_for_input = 1; /* If interrupt_signal was called before and buffered a C-g, make it run again now, to avoid timing error. */ if (!NILP (Vquit_flag)) quit_throw_to_read_char (); } clear_waiting_for_input () { /* Tell interrupt_signal not to throw back to read_char, */ waiting_for_input = 0; input_available_clear_time = 0; } /* This routine is called at interrupt level in response to C-G. If interrupt_input, this is the handler for SIGINT. Otherwise, it is called from kbd_buffer_store_event, in handling SIGIO or SIGTINT. If `waiting_for_input' is non zero, then unless `echoing' is nonzero, immediately throw back to read_char. Otherwise it sets the Lisp variable quit-flag not-nil. This causes eval to throw, when it gets a chance. If quit-flag is already non-nil, it stops the job right away. */ SIGTYPE interrupt_signal (signalnum) /* If we don't have an argument, */ int signalnum; /* some compilers complain in signal calls. */ { char c; /* Must preserve main program's value of errno. */ int old_errno = errno; #ifdef USG if (!read_socket_hook && NILP (Vwindow_system)) { /* USG systems forget handlers when they are used; must reestablish each time */ signal (SIGINT, interrupt_signal); signal (SIGQUIT, interrupt_signal); } #endif /* USG */ cancel_echoing (); if (!NILP (Vquit_flag) && FRAME_TERMCAP_P (selected_frame)) { fflush (stdout); reset_sys_modes (); sigfree (); #ifdef SIGTSTP /* Support possible in later USG versions */ /* * On systems which can suspend the current process and return to the original * shell, this command causes the user to end up back at the shell. * The "Auto-save" and "Abort" questions are not asked until * the user elects to return to emacs, at which point he can save the current * job and either dump core or continue. */ sys_suspend (); #else #ifdef VMS if (sys_suspend () == -1) { printf ("Not running as a subprocess;\n"); printf ("you can continue or abort.\n"); } #else /* not VMS */ /* Perhaps should really fork an inferior shell? But that would not provide any way to get back to the original shell, ever. */ printf ("No support for stopping a process on this operating system;\n"); printf ("you can continue or abort.\n"); #endif /* not VMS */ #endif /* not SIGTSTP */ #ifdef MSDOS /* We must remain inside the screen area when the internal terminal is used. Note that [Enter] is not echoed by dos. */ cursor_to (0, 0); #endif /* It doesn't work to autosave while GC is in progress; the code used for auto-saving doesn't cope with the mark bit. */ if (!gc_in_progress) { printf ("Auto-save? (y or n) "); fflush (stdout); if (((c = getchar ()) & ~040) == 'Y') { Fdo_auto_save (Qt, Qnil); #ifdef MSDOS printf ("\r\nAuto-save done"); #else /* not MSDOS */ printf ("Auto-save done\n"); #endif /* not MSDOS */ } while (c != '\n') c = getchar (); } else { /* During GC, it must be safe to reenable quitting again. */ Vinhibit_quit = Qnil; #ifdef MSDOS printf ("\r\n"); #endif /* not MSDOS */ printf ("Garbage collection in progress; cannot auto-save now\r\n"); printf ("but will instead do a real quit after garbage collection ends\r\n"); fflush (stdout); } #ifdef MSDOS printf ("\r\nAbort? (y or n) "); #else /* not MSDOS */ #ifdef VMS printf ("Abort (and enter debugger)? (y or n) "); #else /* not VMS */ printf ("Abort (and dump core)? (y or n) "); #endif /* not VMS */ #endif /* not MSDOS */ fflush (stdout); if (((c = getchar ()) & ~040) == 'Y') abort (); while (c != '\n') c = getchar (); #ifdef MSDOS printf ("\r\nContinuing...\r\n"); #else /* not MSDOS */ printf ("Continuing...\n"); #endif /* not MSDOS */ fflush (stdout); init_sys_modes (); } else { /* If executing a function that wants to be interrupted out of and the user has not deferred quitting by binding `inhibit-quit' then quit right away. */ if (immediate_quit && NILP (Vinhibit_quit)) { immediate_quit = 0; sigfree (); Fsignal (Qquit, Qnil); } else /* Else request quit when it's safe */ Vquit_flag = Qt; } if (waiting_for_input && !echoing) quit_throw_to_read_char (); errno = old_errno; } /* Handle a C-g by making read_char return C-g. */ quit_throw_to_read_char () { quit_error_check (); sigfree (); /* Prevent another signal from doing this before we finish. */ clear_waiting_for_input (); input_pending = 0; Vunread_command_events = Qnil; unread_command_char = -1; #if 0 /* Currently, sit_for is called from read_char without turning off polling. And that can call set_waiting_for_input. It seems to be harmless. */ #ifdef POLL_FOR_INPUT /* May be > 1 if in recursive minibuffer. */ if (poll_suppress_count == 0) abort (); #endif #endif #ifdef MULTI_FRAME if (FRAMEP (internal_last_event_frame) && XFRAME (internal_last_event_frame) != selected_frame) do_switch_frame (make_lispy_switch_frame (internal_last_event_frame), Qnil, 0); #endif _longjmp (getcjmp, 1); } DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0, "Set mode of reading keyboard input.\n\ First arg INTERRUPT non-nil means use input interrupts;\n\ nil means use CBREAK mode.\n\ Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\ (no effect except in CBREAK mode).\n\ Third arg META t means accept 8-bit input (for a Meta key).\n\ META nil means ignore the top bit, on the assumption it is parity.\n\ Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\ Optional fourth arg QUIT if non-nil specifies character to use for quitting.\n\ See also `current-input-mode'.") (interrupt, flow, meta, quit) Lisp_Object interrupt, flow, meta, quit; { if (!NILP (quit) && (!INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400)) error ("set-input-mode: QUIT must be an ASCII character"); #ifdef POLL_FOR_INPUT stop_polling (); #endif #ifndef MSDOS /* this causes startup screen to be restored and messes with the mouse */ reset_sys_modes (); #endif #ifdef SIGIO /* Note SIGIO has been undef'd if FIONREAD is missing. */ if (read_socket_hook) { /* When using X, don't give the user a real choice, because we haven't implemented the mechanisms to support it. */ #ifdef NO_SOCK_SIGIO interrupt_input = 0; #else /* not NO_SOCK_SIGIO */ interrupt_input = 1; #endif /* NO_SOCK_SIGIO */ } else interrupt_input = !NILP (interrupt); #else /* not SIGIO */ interrupt_input = 0; #endif /* not SIGIO */ /* Our VMS input only works by interrupts, as of now. */ #ifdef VMS interrupt_input = 1; #endif flow_control = !NILP (flow); if (NILP (meta)) meta_key = 0; else if (EQ (meta, Qt)) meta_key = 1; else meta_key = 2; if (!NILP (quit)) /* Don't let this value be out of range. */ quit_char = XINT (quit) & (meta_key ? 0377 : 0177); #ifndef MSDOS init_sys_modes (); #endif #ifdef POLL_FOR_INPUT poll_suppress_count = 1; start_polling (); #endif return Qnil; } DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0, "Return information about the way Emacs currently reads keyboard input.\n\ The value is a list of the form (INTERRUPT FLOW META QUIT), where\n\ INTERRUPT is non-nil if Emacs is using interrupt-driven input; if\n\ nil, Emacs is using CBREAK mode.\n\ FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\ terminal; this does not apply if Emacs uses interrupt-driven input.\n\ META is t if accepting 8-bit input with 8th bit as Meta flag.\n\ META nil means ignoring the top bit, on the assumption it is parity.\n\ META is neither t nor nil if accepting 8-bit input and using\n\ all 8 bits as the character code.\n\ QUIT is the character Emacs currently uses to quit.\n\ The elements of this list correspond to the arguments of\n\ `set-input-mode'.") () { Lisp_Object val[4]; val[0] = interrupt_input ? Qt : Qnil; val[1] = flow_control ? Qt : Qnil; val[2] = meta_key == 2 ? make_number (0) : meta_key == 1 ? Qt : Qnil; XSETFASTINT (val[3], quit_char); return Flist (sizeof (val) / sizeof (val[0]), val); } /* * Set up a new kboard object with reasonable initial values. */ void init_kboard (kb) KBOARD *kb; { kb->Voverriding_terminal_local_map = Qnil; kb->Vlast_command = Qnil; kb->Vprefix_arg = Qnil; kb->kbd_queue = Qnil; kb->kbd_queue_has_data = 0; kb->immediate_echo = 0; kb->echoptr = kb->echobuf; kb->echo_after_prompt = -1; kb->kbd_macro_buffer = 0; kb->kbd_macro_bufsize = 0; kb->defining_kbd_macro = Qnil; kb->Vlast_kbd_macro = Qnil; kb->reference_count = 0; kb->Vsystem_key_alist = Qnil; kb->system_key_syms = Qnil; kb->Vdefault_minibuffer_frame = Qnil; } /* * Destroy the contents of a kboard object, but not the object itself. * We use this just before deleteing it, or if we're going to initialize * it a second time. */ static void wipe_kboard (kb) KBOARD *kb; { if (kb->kbd_macro_buffer) xfree (kb->kbd_macro_buffer); } #ifdef MULTI_KBOARD void delete_kboard (kb) KBOARD *kb; { KBOARD **kbp; for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard) if (*kbp == NULL) abort (); *kbp = kb->next_kboard; wipe_kboard (kb); xfree (kb); } #endif init_keyboard () { /* This is correct before outermost invocation of the editor loop */ command_loop_level = -1; immediate_quit = 0; quit_char = Ctl ('g'); Vunread_command_events = Qnil; unread_command_char = -1; total_keys = 0; recent_keys_index = 0; kbd_fetch_ptr = kbd_buffer; kbd_store_ptr = kbd_buffer; kbd_buffer_frame_or_window = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil); #ifdef HAVE_MOUSE do_mouse_tracking = Qnil; #endif input_pending = 0; #ifdef MULTI_FRAME /* This means that command_loop_1 won't try to select anything the first time through. */ internal_last_event_frame = Qnil; Vlast_event_frame = internal_last_event_frame; #endif #ifdef MULTI_KBOARD current_kboard = initial_kboard; #endif wipe_kboard (current_kboard); init_kboard (current_kboard); if (initialized) Ffillarray (kbd_buffer_frame_or_window, Qnil); kbd_buffer_frame_or_window = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil); if (!noninteractive && !read_socket_hook && NILP (Vwindow_system)) { signal (SIGINT, interrupt_signal); #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS) /* For systems with SysV TERMIO, C-g is set up for both SIGINT and SIGQUIT and we can't tell which one it will give us. */ signal (SIGQUIT, interrupt_signal); #endif /* HAVE_TERMIO */ } /* Note SIGIO has been undef'd if FIONREAD is missing. */ #ifdef SIGIO if (!noninteractive) signal (SIGIO, input_available_signal); #endif /* SIGIO */ /* Use interrupt input by default, if it works and noninterrupt input has deficiencies. */ #ifdef INTERRUPT_INPUT interrupt_input = 1; #else interrupt_input = 0; #endif /* Our VMS input only works by interrupts, as of now. */ #ifdef VMS interrupt_input = 1; #endif sigfree (); dribble = 0; if (keyboard_init_hook) (*keyboard_init_hook) (); #ifdef POLL_FOR_INPUT poll_suppress_count = 1; start_polling (); #endif } /* This type's only use is in syms_of_keyboard, to initialize the event header symbols and put properties on them. */ struct event_head { Lisp_Object *var; char *name; Lisp_Object *kind; }; struct event_head head_table[] = { &Qmouse_movement, "mouse-movement", &Qmouse_movement, &Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement, &Qswitch_frame, "switch-frame", &Qswitch_frame, &Qdelete_frame, "delete-frame", &Qdelete_frame, &Qiconify_frame, "iconify-frame", &Qiconify_frame, &Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible, }; 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); Qforward_char = intern ("forward-char"); staticpro (&Qforward_char); Qbackward_char = intern ("backward-char"); staticpro (&Qbackward_char); Qdisabled = intern ("disabled"); staticpro (&Qdisabled); Qundefined = intern ("undefined"); staticpro (&Qundefined); Qpre_command_hook = intern ("pre-command-hook"); staticpro (&Qpre_command_hook); Qpost_command_hook = intern ("post-command-hook"); staticpro (&Qpost_command_hook); Qpost_command_idle_hook = intern ("post-command-idle-hook"); staticpro (&Qpost_command_idle_hook); Qdeferred_action_function = intern ("deferred-action-function"); staticpro (&Qdeferred_action_function); Qcommand_hook_internal = intern ("command-hook-internal"); staticpro (&Qcommand_hook_internal); Qfunction_key = intern ("function-key"); staticpro (&Qfunction_key); Qmouse_click = intern ("mouse-click"); staticpro (&Qmouse_click); Qmenu_enable = intern ("menu-enable"); staticpro (&Qmenu_enable); Qmode_line = intern ("mode-line"); staticpro (&Qmode_line); Qvertical_line = intern ("vertical-line"); staticpro (&Qvertical_line); Qvertical_scroll_bar = intern ("vertical-scroll-bar"); staticpro (&Qvertical_scroll_bar); Qmenu_bar = intern ("menu-bar"); staticpro (&Qmenu_bar); Qabove_handle = intern ("above-handle"); staticpro (&Qabove_handle); Qhandle = intern ("handle"); staticpro (&Qhandle); Qbelow_handle = intern ("below-handle"); staticpro (&Qbelow_handle); Qevent_kind = intern ("event-kind"); staticpro (&Qevent_kind); Qevent_symbol_elements = intern ("event-symbol-elements"); staticpro (&Qevent_symbol_elements); Qevent_symbol_element_mask = intern ("event-symbol-element-mask"); staticpro (&Qevent_symbol_element_mask); Qmodifier_cache = intern ("modifier-cache"); staticpro (&Qmodifier_cache); Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar"); staticpro (&Qrecompute_lucid_menubar); Qactivate_menubar_hook = intern ("activate-menubar-hook"); staticpro (&Qactivate_menubar_hook); Qpolling_period = intern ("polling-period"); staticpro (&Qpolling_period); { struct event_head *p; for (p = head_table; p < head_table + (sizeof (head_table) / sizeof (head_table[0])); p++) { *p->var = intern (p->name); staticpro (p->var); Fput (*p->var, Qevent_kind, *p->kind); Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil)); } } button_down_location = Fmake_vector (make_number (NUM_MOUSE_BUTTONS), Qnil); staticpro (&button_down_location); { int i; int len = sizeof (modifier_names) / sizeof (modifier_names[0]); modifier_symbols = Fmake_vector (make_number (len), Qnil); for (i = 0; i < len; i++) if (modifier_names[i]) XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]); staticpro (&modifier_symbols); } recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil); staticpro (&recent_keys); this_command_keys = Fmake_vector (make_number (40), Qnil); staticpro (&this_command_keys); Qextended_command_history = intern ("extended-command-history"); Fset (Qextended_command_history, Qnil); staticpro (&Qextended_command_history); kbd_buffer_frame_or_window = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil); staticpro (&kbd_buffer_frame_or_window); accent_key_syms = Qnil; staticpro (&accent_key_syms); func_key_syms = Qnil; staticpro (&func_key_syms); mouse_syms = Qnil; staticpro (&mouse_syms); unread_switch_frame = Qnil; staticpro (&unread_switch_frame); defsubr (&Sevent_convert_list); defsubr (&Sread_key_sequence); defsubr (&Srecursive_edit); #ifdef HAVE_MOUSE defsubr (&Strack_mouse); #endif defsubr (&Sinput_pending_p); defsubr (&Scommand_execute); defsubr (&Srecent_keys); defsubr (&Sthis_command_keys); defsubr (&Sreset_this_command_lengths); defsubr (&Ssuspend_emacs); defsubr (&Sabort_recursive_edit); defsubr (&Sexit_recursive_edit); defsubr (&Srecursion_depth); defsubr (&Stop_level); defsubr (&Sdiscard_input); defsubr (&Sopen_dribble_file); defsubr (&Sset_input_mode); defsubr (&Scurrent_input_mode); defsubr (&Sexecute_extended_command); DEFVAR_LISP ("last-command-char", &last_command_char, "Last input event that was part of a command."); DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char, "Last input event that was part of a command."); DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event, "Last input event in a command, except for mouse menu events.\n\ Mouse menus give back keys that don't look like mouse events;\n\ this variable holds the actual mouse event that led to the menu,\n\ so that you can determine whether the command was run by mouse or not."); DEFVAR_LISP ("last-input-char", &last_input_char, "Last input event."); DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char, "Last input event."); DEFVAR_LISP ("unread-command-events", &Vunread_command_events, "List of objects to be read as next command input events."); DEFVAR_INT ("unread-command-char", &unread_command_char, "If not -1, an object to be read as next command input event."); DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char, "Meta-prefix character code. Meta-foo as command input\n\ turns into this character followed by foo."); XSETINT (meta_prefix_char, 033); DEFVAR_KBOARD ("last-command", Vlast_command, "The last command executed. Normally a symbol with a function definition,\n\ but can be whatever was found in the keymap, or whatever the variable\n\ `this-command' was set to by that command.\n\ \n\ The value `mode-exit' is special; it means that the previous command\n\ read an event that told it to exit, and it did so and unread that event.\n\ In other words, the present command is the event that made the previous\n\ command exit.\n\ \n\ The value `kill-region' is special; it means that the previous command\n\ was a kill command."); DEFVAR_LISP ("this-command", &this_command, "The command now being executed.\n\ The command can set this variable; whatever is put here\n\ will be in `last-command' during the following command."); this_command = Qnil; DEFVAR_INT ("auto-save-interval", &auto_save_interval, "*Number of keyboard input characters between auto-saves.\n\ Zero means disable autosaving due to number of characters typed."); auto_save_interval = 300; DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout, "*Number of seconds idle time before auto-save.\n\ Zero or nil means disable auto-saving due to idleness.\n\ After auto-saving due to this many seconds of idle time,\n\ Emacs also does a garbage collection if that seems to be warranted."); XSETFASTINT (Vauto_save_timeout, 30); DEFVAR_INT ("echo-keystrokes", &echo_keystrokes, "*Nonzero means echo unfinished commands after this many seconds of pause."); echo_keystrokes = 1; DEFVAR_INT ("polling-period", &polling_period, "*Interval between polling for input during Lisp execution.\n\ The reason for polling is to make C-g work to stop a running program.\n\ Polling is needed only when using X windows and SIGIO does not work.\n\ Polling is automatically disabled in all other cases."); polling_period = 2; DEFVAR_LISP ("double-click-time", &Vdouble_click_time, "*Maximum time between mouse clicks to make a double-click.\n\ Measured in milliseconds. nil means disable double-click recognition;\n\ t means double-clicks have no time limit and are detected\n\ by position only."); Vdouble_click_time = make_number (500); DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus, "*Non-nil means inhibit local map menu bar menus."); inhibit_local_menu_bar_menus = 0; DEFVAR_INT ("num-input-keys", &num_input_keys, "Number of complete keys read from the keyboard so far."); num_input_keys = 0; DEFVAR_LISP ("last-event-frame", &Vlast_event_frame, "The frame in which the most recently read event occurred.\n\ If the last event came from a keyboard macro, this is set to `macro'."); Vlast_event_frame = Qnil; DEFVAR_LISP ("help-char", &Vhelp_char, "Character to recognize as meaning Help.\n\ When it is read, do `(eval help-form)', and display result if it's a string.\n\ If the value of `help-form' is nil, this char can be read normally."); XSETINT (Vhelp_char, Ctl ('H')); DEFVAR_LISP ("help-event-list", &Vhelp_event_list, "List of input events to recognize as meaning Help.\n\ These work just like the value of `help-char' (see that)."); Vhelp_event_list = Qnil; DEFVAR_LISP ("help-form", &Vhelp_form, "Form to execute when character `help-char' is read.\n\ If the form returns a string, that string is displayed.\n\ If `help-form' is nil, the help char is not recognized."); Vhelp_form = Qnil; DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command, "Command to run when `help-char' character follows a prefix key.\n\ This command is used only when there is no actual binding\n\ for that character after that prefix key."); Vprefix_help_command = Qnil; DEFVAR_LISP ("top-level", &Vtop_level, "Form to evaluate when Emacs starts up.\n\ Useful to set before you dump a modified Emacs."); Vtop_level = Qnil; DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table, "Translate table for keyboard input, or nil.\n\ Each character is looked up in this string and the contents used instead.\n\ The value may be a string, a vector, or a char-table.\n\ If it is a string or vector of length N,\n\ character codes N and up are untranslated.\n\ In a vector or a char-table, an element which is nil means \"no translation\"."); Vkeyboard_translate_table = Qnil; DEFVAR_BOOL ("cannot-suspend", &cannot_suspend, "Non-nil means to always spawn a subshell instead of suspending,\n\ even if the operating system has support for stopping a process."); cannot_suspend = 0; DEFVAR_BOOL ("menu-prompting", &menu_prompting, "Non-nil means prompt with menus when appropriate.\n\ This is done when reading from a keymap that has a prompt string,\n\ for elements that have prompt strings.\n\ The menu is displayed on the screen\n\ if X menus were enabled at configuration\n\ time and the previous event was a mouse click prefix key.\n\ Otherwise, menu prompting uses the echo area."); menu_prompting = 1; DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char, "Character to see next line of menu prompt.\n\ Type this character while in a menu prompt to rotate around the lines of it."); XSETINT (menu_prompt_more_char, ' '); DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers, "A mask of additional modifier keys to use with every keyboard character.\n\ Emacs applies the modifiers of the character stored here to each keyboard\n\ character it reads. For example, after evaluating the expression\n\ (setq extra-keyboard-modifiers ?\\C-x)\n\ all input characters will have the control modifier applied to them.\n\ \n\ Note that the character ?\\C-@, equivalent to the integer zero, does\n\ not count as a control character; rather, it counts as a character\n\ with no modifiers; thus, setting `extra-keyboard-modifiers' to zero\n\ cancels any modification."); extra_keyboard_modifiers = 0; DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark, "If an editing command sets this to t, deactivate the mark afterward.\n\ The command loop sets this to nil before each command,\n\ and tests the value when the command returns.\n\ Buffer modification stores t in this variable."); Vdeactivate_mark = Qnil; DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal, "Temporary storage of pre-command-hook or post-command-hook."); Vcommand_hook_internal = Qnil; DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook, "Normal hook run before each command is executed.\n\ Errors running the hook are caught and ignored."); Vpre_command_hook = Qnil; DEFVAR_LISP ("post-command-hook", &Vpost_command_hook, "Normal hook run after each command is executed.\n\ Errors running the hook are caught and ignored."); Vpost_command_hook = Qnil; DEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook, "Normal hook run after each command is executed, if idle.\n\ Errors running the hook are caught and ignored."); Vpost_command_idle_hook = Qnil; DEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay, "Delay time before running `post-command-idle-delay'.\n\ This is measured in microseconds."); post_command_idle_delay = 100000; DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag, "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 list are event types that may have menu bar bindings."); Vmenu_bar_final_items = Qnil; DEFVAR_KBOARD ("overriding-terminal-local-map", Voverriding_terminal_local_map, "Keymap that overrides all other local keymaps.\n\ If this variable is non-nil, it is used as a keymap instead of the\n\ buffer's local map, and the minor mode keymaps and text property keymaps."); DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map, "Keymap that overrides all other local keymaps.\n\ If this variable is non-nil, it is used as a keymap instead of the\n\ buffer's local map, and the minor mode keymaps and text property keymaps."); Voverriding_local_map = Qnil; DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag, "Non-nil means `overriding-local-map' applies to the menu bar.\n\ Otherwise, the menu bar continues to reflect the buffer's local map\n\ and the minor mode maps regardless of `overriding-local-map'."); Voverriding_local_map_menu_flag = Qnil; DEFVAR_LISP ("special-event-map", &Vspecial_event_map, "Keymap defining bindings for special events to execute at low level."); Vspecial_event_map = Fcons (intern ("keymap"), Qnil); DEFVAR_LISP ("track-mouse", &do_mouse_tracking, "*Non-nil means generate motion events for mouse motion."); DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist, "Alist of system-specific X windows key symbols.\n\ Each element should have the form (N . SYMBOL) where N is the\n\ numeric keysym code (sans the \"system-specific\" bit 1<<28)\n\ and SYMBOL is its name."); DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list, "List of deferred actions to be performed at a later time.\n\ The precise format isn't relevant here; we just check whether it is nil."); Vdeferred_action_list = Qnil; DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function, "Function to call to handle deferred actions, after each command.\n\ This function is called with no arguments after each command\n\ whenever `deferred-action-list' is non-nil."); Vdeferred_action_function = Qnil; DEFVAR_LISP ("suggest-key-bindings", &Vsuggest_key_bindings, "Non-nil means show the equivalent key-binding when M-x command has one.\n\ The value can be a length of time to show the message for.\n\ If the value is non-nil and not a number, we wait 2 seconds."); Vsuggest_key_bindings = Qt; DEFVAR_LISP ("column-number-mode", &Vcolumn_number_mode, "Non-nil enables display of the current column number in the mode line."); Vcolumn_number_mode = Qnil; } keys_of_keyboard () { initial_define_key (global_map, Ctl ('Z'), "suspend-emacs"); initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs"); initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit"); initial_define_key (global_map, Ctl (']'), "abort-recursive-edit"); initial_define_key (meta_map, 'x', "execute-extended-command"); initial_define_lispy_key (Vspecial_event_map, "delete-frame", "handle-delete-frame"); initial_define_lispy_key (Vspecial_event_map, "iconify-frame", "ignore-event"); initial_define_lispy_key (Vspecial_event_map, "make-frame-visible", "ignore-event"); } emacs-19.30/src/keymap.c100444 12120 1 222176 6045224040 13367 0ustar rmsdaemon/* Manipulation of keymaps Copyright (C) 1985, 86, 87, 88, 93, 94, 95 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. */ #include #include #undef NULL #include "lisp.h" #include "commands.h" #include "buffer.h" #include "keyboard.h" #include "termhooks.h" #include "blockinput.h" #define min(a, b) ((a) < (b) ? (a) : (b)) /* The number of elements in keymap vectors. */ #define DENSE_TABLE_SIZE (0200) /* Actually allocate storage for these variables */ Lisp_Object current_global_map; /* Current global keymap */ Lisp_Object global_map; /* default global key bindings */ Lisp_Object meta_map; /* The keymap used for globally bound ESC-prefixed default commands */ Lisp_Object control_x_map; /* The keymap used for globally bound C-x-prefixed default commands */ /* was MinibufLocalMap */ Lisp_Object Vminibuffer_local_map; /* The keymap used by the minibuf for local bindings when spaces are allowed in the minibuf */ /* was MinibufLocalNSMap */ Lisp_Object Vminibuffer_local_ns_map; /* The keymap used by the minibuf for local bindings when spaces are not encouraged in the minibuf */ /* keymap used for minibuffers when doing completion */ /* was MinibufLocalCompletionMap */ Lisp_Object Vminibuffer_local_completion_map; /* keymap used for minibuffers when doing completion and require a match */ /* was MinibufLocalMustMatchMap */ Lisp_Object Vminibuffer_local_must_match_map; /* Alist of minor mode variables and keymaps. */ Lisp_Object Vminor_mode_map_alist; /* Keymap mapping ASCII function key sequences onto their preferred forms. Initialized by the terminal-specific lisp files. See DEFVAR for more documentation. */ Lisp_Object Vfunction_key_map; /* Keymap mapping ASCII function key sequences onto their preferred forms. */ Lisp_Object Vkey_translation_map; /* A list of all commands given new bindings since a certain time when nil was stored here. This is used to speed up recomputation of menu key equivalents when Emacs starts up. t means don't record anything here. */ Lisp_Object Vdefine_key_rebound_commands; Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii; /* A char with the CHAR_META bit set in a vector or the 0200 bit set in a string key sequence is equivalent to prefixing with this character. */ extern Lisp_Object meta_prefix_char; extern Lisp_Object Voverriding_local_map; static Lisp_Object define_as_prefix (); static Lisp_Object describe_buffer_bindings (); static void describe_command (), describe_translation (); static void describe_map (); /* Keymap object support - constructors and predicates. */ DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0, "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\ VECTOR is a vector which holds the bindings for the ASCII\n\ characters. ALIST is an assoc-list which holds bindings for function keys,\n\ mouse events, and any other things that appear in the input stream.\n\ All entries in it are initially nil, meaning \"command undefined\".\n\n\ The optional arg STRING supplies a menu name for the keymap\n\ in case you use it as a menu with `x-popup-menu'.") (string) Lisp_Object string; { Lisp_Object tail; if (!NILP (string)) tail = Fcons (string, Qnil); else tail = Qnil; return Fcons (Qkeymap, Fcons (Fmake_vector (make_number (DENSE_TABLE_SIZE), Qnil), tail)); } DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0, "Construct and return a new sparse-keymap list.\n\ Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\ which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\ which binds the function key or mouse event SYMBOL to DEFINITION.\n\ Initially the alist is nil.\n\n\ The optional arg STRING supplies a menu name for the keymap\n\ in case you use it as a menu with `x-popup-menu'.") (string) Lisp_Object string; { if (!NILP (string)) return Fcons (Qkeymap, Fcons (string, Qnil)); return Fcons (Qkeymap, Qnil); } /* This function is used for installing the standard key bindings at initialization time. For example: initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */ void initial_define_key (keymap, key, defname) Lisp_Object keymap; int key; char *defname; { store_in_keymap (keymap, make_number (key), intern (defname)); } void initial_define_lispy_key (keymap, keyname, defname) Lisp_Object keymap; char *keyname; char *defname; { store_in_keymap (keymap, intern (keyname), intern (defname)); } /* Define character fromchar in map frommap as an alias for character tochar in map tomap. Subsequent redefinitions of the latter WILL affect the former. */ #if 0 void synkey (frommap, fromchar, tomap, tochar) struct Lisp_Vector *frommap, *tomap; int fromchar, tochar; { Lisp_Object v, c; XSETVECTOR (v, tomap); XSETFASTINT (c, tochar); frommap->contents[fromchar] = Fcons (v, c); } #endif /* 0 */ DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0, "Return t if ARG is a keymap.\n\ \n\ A keymap is a list (keymap . ALIST),\n\ or a symbol whose function definition is itself a keymap.\n\ ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\ a vector of densely packed bindings for small character codes\n\ is also allowed as an element.") (object) Lisp_Object object; { return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt); } /* Check that OBJECT is a keymap (after dereferencing through any symbols). If it is, return it. If AUTOLOAD is non-zero and OBJECT is a symbol whose function value is an autoload form, do the autoload and try again. If AUTOLOAD is nonzero, callers must assume GC is possible. ERROR controls how we respond if OBJECT isn't a keymap. If ERROR is non-zero, signal an error; otherwise, just return Qnil. Note that most of the time, we don't want to pursue autoloads. Functions like Faccessible_keymaps which scan entire keymap trees shouldn't load every autoloaded keymap. I'm not sure about this, but it seems to me that only read_key_sequence, Flookup_key, and Fdefine_key should cause keymaps to be autoloaded. */ Lisp_Object get_keymap_1 (object, error, autoload) Lisp_Object object; int error, autoload; { Lisp_Object tem; autoload_retry: tem = indirect_function (object); if (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap)) return tem; /* Should we do an autoload? Autoload forms for keymaps have Qkeymap as their fifth element. */ if (autoload && SYMBOLP (object) && CONSP (tem) && EQ (XCONS (tem)->car, Qautoload)) { Lisp_Object tail; tail = Fnth (make_number (4), tem); if (EQ (tail, Qkeymap)) { struct gcpro gcpro1, gcpro2; GCPRO2 (tem, object); do_autoload (tem, object); UNGCPRO; goto autoload_retry; } } if (error) wrong_type_argument (Qkeymapp, object); else return Qnil; } /* Follow any symbol chaining, and return the keymap denoted by OBJECT. If OBJECT doesn't denote a keymap at all, signal an error. */ Lisp_Object get_keymap (object) Lisp_Object object; { return get_keymap_1 (object, 1, 0); } /* Look up IDX in MAP. IDX may be any sort of event. Note that this does only one level of lookup; IDX must be a single event, not a sequence. If T_OK is non-zero, bindings for Qt are treated as default bindings; any key left unmentioned by other tables and bindings is given the binding of Qt. If T_OK is zero, bindings for Qt are not treated specially. If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */ Lisp_Object access_keymap (map, idx, t_ok, noinherit) Lisp_Object map; Lisp_Object idx; int t_ok; int noinherit; { int noprefix = 0; Lisp_Object val; /* If idx is a list (some sort of mouse click, perhaps?), the index we want to use is the car of the list, which ought to be a symbol. */ idx = EVENT_HEAD (idx); /* If idx is a symbol, it might have modifiers, which need to be put in the canonical order. */ if (SYMBOLP (idx)) idx = reorder_modifiers (idx); else if (INTEGERP (idx)) /* Clobber the high bits that can be present on a machine with more than 24 bits of integer. */ XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); { Lisp_Object tail; Lisp_Object t_binding; t_binding = Qnil; for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object binding; binding = XCONS (tail)->car; if (SYMBOLP (binding)) { /* If NOINHERIT, stop finding prefix definitions after we pass a second occurrence of the `keymap' symbol. */ if (noinherit && EQ (binding, Qkeymap) && ! EQ (tail, map)) noprefix = 1; } else if (CONSP (binding)) { if (EQ (XCONS (binding)->car, idx)) { val = XCONS (binding)->cdr; if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) return Qnil; return val; } if (t_ok && EQ (XCONS (binding)->car, Qt)) t_binding = XCONS (binding)->cdr; } else if (VECTORP (binding)) { if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size) { val = XVECTOR (binding)->contents[XFASTINT (idx)]; if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) return Qnil; return val; } } QUIT; } return t_binding; } } /* Given OBJECT which was found in a slot in a keymap, trace indirect definitions to get the actual definition of that slot. An indirect definition is a list of the form (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one and INDEX is the object to look up in KEYMAP to yield the definition. Also if OBJECT has a menu string as the first element, remove that. Also remove a menu help string as second element. If AUTOLOAD is nonzero, load autoloadable keymaps that are referred to with indirection. */ Lisp_Object get_keyelt (object, autoload) register Lisp_Object object; int autoload; { while (1) { register Lisp_Object map, tem; /* If the contents are (KEYMAP . ELEMENT), go indirect. */ map = get_keymap_1 (Fcar_safe (object), 0, autoload); tem = Fkeymapp (map); if (!NILP (tem)) object = access_keymap (map, Fcdr (object), 0, 0); /* If the keymap contents looks like (STRING . DEFN), use DEFN. Keymap alist elements like (CHAR MENUSTRING . DEFN) will be used by HierarKey menus. */ else if (CONSP (object) && STRINGP (XCONS (object)->car)) { object = XCONS (object)->cdr; /* Also remove a menu help string, if any, following the menu item name. */ if (CONSP (object) && STRINGP (XCONS (object)->car)) object = XCONS (object)->cdr; /* Also remove the sublist that caches key equivalences, if any. */ if (CONSP (object) && CONSP (XCONS (object)->car)) { Lisp_Object carcar; carcar = XCONS (XCONS (object)->car)->car; if (NILP (carcar) || VECTORP (carcar)) object = XCONS (object)->cdr; } } else /* Anything else is really the value. */ return object; } } Lisp_Object store_in_keymap (keymap, idx, def) Lisp_Object keymap; register Lisp_Object idx; register Lisp_Object def; { /* If we are preparing to dump, and DEF is a menu element with a menu item string, copy it to ensure it is not pure. */ if (!NILP (Vpurify_flag) && CONSP (def) && STRINGP (XCONS (def)->car)) def = Fcons (XCONS (def)->car, XCONS (def)->cdr); if (!CONSP (keymap) || ! EQ (XCONS (keymap)->car, Qkeymap)) error ("attempt to define a key in a non-keymap"); /* If idx is a list (some sort of mouse click, perhaps?), the index we want to use is the car of the list, which ought to be a symbol. */ idx = EVENT_HEAD (idx); /* If idx is a symbol, it might have modifiers, which need to be put in the canonical order. */ if (SYMBOLP (idx)) idx = reorder_modifiers (idx); else if (INTEGERP (idx)) /* Clobber the high bits that can be present on a machine with more than 24 bits of integer. */ XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); /* Scan the keymap for a binding of idx. */ { Lisp_Object tail; /* The cons after which we should insert new bindings. If the keymap has a table element, we record its position here, so new bindings will go after it; this way, the table will stay towards the front of the alist and character lookups in dense keymaps will remain fast. Otherwise, this just points at the front of the keymap. */ Lisp_Object insertion_point; insertion_point = keymap; for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object elt; elt = XCONS (tail)->car; if (VECTORP (elt)) { if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (elt)->size) { XVECTOR (elt)->contents[XFASTINT (idx)] = def; return def; } insertion_point = tail; } else if (CONSP (elt)) { if (EQ (idx, XCONS (elt)->car)) { XCONS (elt)->cdr = def; return def; } } else if (SYMBOLP (elt)) { /* If we find a 'keymap' symbol in the spine of KEYMAP, then we must have found the start of a second keymap being used as the tail of KEYMAP, and a binding for IDX should be inserted before it. */ if (EQ (elt, Qkeymap)) goto keymap_end; } QUIT; } keymap_end: /* We have scanned the entire keymap, and not found a binding for IDX. Let's add one. */ XCONS (insertion_point)->cdr = Fcons (Fcons (idx, def), XCONS (insertion_point)->cdr); } return def; } DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0, "Return a copy of the keymap KEYMAP.\n\ The copy starts out with the same definitions of KEYMAP,\n\ but changing either the copy or KEYMAP does not affect the other.\n\ Any key definitions that are subkeymaps are recursively copied.\n\ However, a key definition which is a symbol whose definition is a keymap\n\ is not copied.") (keymap) Lisp_Object keymap; { register Lisp_Object copy, tail; copy = Fcopy_alist (get_keymap (keymap)); for (tail = copy; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object elt; elt = XCONS (tail)->car; if (VECTORP (elt)) { int i; elt = Fcopy_sequence (elt); XCONS (tail)->car = elt; for (i = 0; i < XVECTOR (elt)->size; i++) if (!SYMBOLP (XVECTOR (elt)->contents[i]) && ! NILP (Fkeymapp (XVECTOR (elt)->contents[i]))) XVECTOR (elt)->contents[i] = Fcopy_keymap (XVECTOR (elt)->contents[i]); } else if (CONSP (elt)) { /* Skip the optional menu string. */ if (CONSP (XCONS (elt)->cdr) && STRINGP (XCONS (XCONS (elt)->cdr)->car)) { Lisp_Object tem; /* Copy the cell, since copy-alist didn't go this deep. */ XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car, XCONS (XCONS (elt)->cdr)->cdr); elt = XCONS (elt)->cdr; /* Also skip the optional menu help string. */ if (CONSP (XCONS (elt)->cdr) && STRINGP (XCONS (XCONS (elt)->cdr)->car)) { XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car, XCONS (XCONS (elt)->cdr)->cdr); elt = XCONS (elt)->cdr; } /* There may also be a list that caches key equivalences. Just delete it for the new keymap. */ if (CONSP (XCONS (elt)->cdr) && CONSP (XCONS (XCONS (elt)->cdr)->car) && (NILP (tem = XCONS (XCONS (XCONS (elt)->cdr)->car)->car) || VECTORP (tem))) XCONS (elt)->cdr = XCONS (XCONS (elt)->cdr)->cdr; } if (CONSP (elt) && ! SYMBOLP (XCONS (elt)->cdr) && ! NILP (Fkeymapp (XCONS (elt)->cdr))) XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr); } } return copy; } /* Simple Keymap mutators and accessors. */ /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\ KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\ meaning a sequence of keystrokes and events.\n\ Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\ can be included if you use a vector.\n\ DEF is anything that can be a key's definition:\n\ nil (means key is undefined in this keymap),\n\ a command (a Lisp function suitable for interactive calling)\n\ a string (treated as a keyboard macro),\n\ a keymap (to define a prefix key),\n\ a symbol. When the key is looked up, the symbol will stand for its\n\ function definition, which should at that time be one of the above,\n\ or another symbol whose function definition is used, etc.\n\ a cons (STRING . DEFN), meaning that DEFN is the definition\n\ (DEFN should be a valid definition in its own right),\n\ or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\ \n\ If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\ the front of KEYMAP.") (keymap, key, def) Lisp_Object keymap; Lisp_Object key; Lisp_Object def; { register int idx; register Lisp_Object c; register Lisp_Object tem; register Lisp_Object cmd; int metized = 0; int meta_bit; int length; struct gcpro gcpro1, gcpro2, gcpro3; keymap = get_keymap_1 (keymap, 1, 1); if (!VECTORP (key) && !STRINGP (key)) key = wrong_type_argument (Qarrayp, key); length = XFASTINT (Flength (key)); if (length == 0) return Qnil; if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt)) Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands); GCPRO3 (keymap, key, def); if (VECTORP (key)) meta_bit = meta_modifier; else meta_bit = 0x80; idx = 0; while (1) { c = Faref (key, make_number (idx)); if (CONSP (c) && lucid_event_type_list_p (c)) c = Fevent_convert_list (c); if (INTEGERP (c) && (XINT (c) & meta_bit) && !metized) { c = meta_prefix_char; metized = 1; } else { if (INTEGERP (c)) XSETINT (c, XINT (c) & ~meta_bit); metized = 0; idx++; } if (! INTEGERP (c) && ! SYMBOLP (c) && ! CONSP (c)) error ("Key sequence contains invalid events"); if (idx == length) RETURN_UNGCPRO (store_in_keymap (keymap, c, def)); cmd = get_keyelt (access_keymap (keymap, c, 0, 1), 1); /* If this key is undefined, make it a prefix. */ if (NILP (cmd)) cmd = define_as_prefix (keymap, c); keymap = get_keymap_1 (cmd, 0, 1); if (NILP (keymap)) /* We must use Fkey_description rather than just passing key to error; key might be a vector, not a string. */ error ("Key sequence %s uses invalid prefix characters", XSTRING (Fkey_description (key))->data); } } /* Value is number if KEY is too long; NIL if valid but has no definition. */ /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\ nil means undefined. See doc of `define-key' for kinds of definitions.\n\ \n\ A number as value means KEY is \"too long\";\n\ that is, characters or symbols in it except for the last one\n\ fail to be a valid sequence of prefix characters in KEYMAP.\n\ The number is how many characters at the front of KEY\n\ it takes to reach a non-prefix command.\n\ \n\ Normally, `lookup-key' ignores bindings for t, which act as default\n\ bindings, used when nothing else in the keymap applies; this makes it\n\ useable as a general function for probing keymaps. However, if the\n\ third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\ recognize the default bindings, just as `read-key-sequence' does.") (keymap, key, accept_default) register Lisp_Object keymap; Lisp_Object key; Lisp_Object accept_default; { register int idx; register Lisp_Object tem; register Lisp_Object cmd; register Lisp_Object c; int metized = 0; int length; int t_ok = ! NILP (accept_default); int meta_bit; struct gcpro gcpro1; keymap = get_keymap_1 (keymap, 1, 1); if (!VECTORP (key) && !STRINGP (key)) key = wrong_type_argument (Qarrayp, key); length = XFASTINT (Flength (key)); if (length == 0) return keymap; if (VECTORP (key)) meta_bit = meta_modifier; else meta_bit = 0x80; GCPRO1 (key); idx = 0; while (1) { c = Faref (key, make_number (idx)); if (CONSP (c) && lucid_event_type_list_p (c)) c = Fevent_convert_list (c); if (INTEGERP (c) && (XINT (c) & meta_bit) && !metized) { c = meta_prefix_char; metized = 1; } else { if (INTEGERP (c)) XSETINT (c, XINT (c) & ~meta_bit); metized = 0; idx++; } cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0), 1); if (idx == length) RETURN_UNGCPRO (cmd); keymap = get_keymap_1 (cmd, 0, 1); if (NILP (keymap)) RETURN_UNGCPRO (make_number (idx)); QUIT; } } /* Make KEYMAP define event C as a keymap (i.e., as a prefix). Assume that currently it does not define C at all. Return the keymap. */ static Lisp_Object define_as_prefix (keymap, c) Lisp_Object keymap, c; { Lisp_Object inherit, cmd; cmd = Fmake_sparse_keymap (Qnil); /* If this key is defined as a prefix in an inherited keymap, make it a prefix in this map, and make its definition inherit the other prefix definition. */ inherit = access_keymap (keymap, c, 0, 0); if (NILP (inherit)) { /* If there's an inherited keymap and it doesn't define this key, make it define this key. */ Lisp_Object tail; for (tail = Fcdr (keymap); CONSP (tail); tail = XCONS (tail)->cdr) if (EQ (XCONS (tail)->car, Qkeymap)) break; if (!NILP (tail)) inherit = define_as_prefix (tail, c); } cmd = nconc2 (cmd, inherit); store_in_keymap (keymap, c, cmd); return cmd; } /* Append a key to the end of a key sequence. We always make a vector. */ Lisp_Object append_key (key_sequence, key) Lisp_Object key_sequence, key; { Lisp_Object args[2]; args[0] = key_sequence; args[1] = Fcons (key, Qnil); return Fvconcat (2, args); } /* Global, local, and minor mode keymap stuff. */ /* We can't put these variables inside current_minor_maps, since under some systems, static gets macro-defined to be the empty string. Ickypoo. */ static Lisp_Object *cmm_modes, *cmm_maps; static int cmm_size; /* Error handler used in current_minor_maps. */ static Lisp_Object current_minor_maps_error () { return Qnil; } /* Store a pointer to an array of the keymaps of the currently active minor modes in *buf, and return the number of maps it contains. This function always returns a pointer to the same buffer, and may free or reallocate it, so if you want to keep it for a long time or hand it out to lisp code, copy it. This procedure will be called for every key sequence read, so the nice lispy approach (return a new assoclist, list, what have you) for each invocation would result in a lot of consing over time. If we used xrealloc/xmalloc and ran out of memory, they would throw back to the command loop, which would try to read a key sequence, which would call this function again, resulting in an infinite loop. Instead, we'll use realloc/malloc and silently truncate the list, let the key sequence be read, and hope some other piece of code signals the error. */ int current_minor_maps (modeptr, mapptr) Lisp_Object **modeptr, **mapptr; { int i = 0; Lisp_Object alist, assoc, var, val; for (alist = Vminor_mode_map_alist; CONSP (alist); alist = XCONS (alist)->cdr) if ((assoc = XCONS (alist)->car, CONSP (assoc)) && (var = XCONS (assoc)->car, SYMBOLP (var)) && (val = find_symbol_value (var), ! EQ (val, Qunbound)) && ! NILP (val)) { Lisp_Object temp; if (i >= cmm_size) { Lisp_Object *newmodes, *newmaps; if (cmm_maps) { BLOCK_INPUT; cmm_size *= 2; newmodes = (Lisp_Object *) realloc (cmm_modes, cmm_size * sizeof (Lisp_Object)); newmaps = (Lisp_Object *) realloc (cmm_maps, cmm_size * sizeof (Lisp_Object)); UNBLOCK_INPUT; } else { BLOCK_INPUT; cmm_size = 30; newmodes = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object)); newmaps = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object)); UNBLOCK_INPUT; } if (newmaps && newmodes) { cmm_modes = newmodes; cmm_maps = newmaps; } else break; } /* Get the keymap definition--or nil if it is not defined. */ temp = internal_condition_case_1 (Findirect_function, XCONS (assoc)->cdr, Qerror, current_minor_maps_error); if (!NILP (temp)) { cmm_modes[i] = var; cmm_maps [i] = temp; i++; } } if (modeptr) *modeptr = cmm_modes; if (mapptr) *mapptr = cmm_maps; return i; } /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0, "Return the binding for command KEY in current keymaps.\n\ KEY is a string or vector, a sequence of keystrokes.\n\ The binding is probably a symbol with a function definition.\n\ \n\ Normally, `key-binding' ignores bindings for t, which act as default\n\ bindings, used when nothing else in the keymap applies; this makes it\n\ usable as a general function for probing keymaps. However, if the\n\ optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\ recognize the default bindings, just as `read-key-sequence' does.") (key, accept_default) Lisp_Object key, accept_default; { Lisp_Object *maps, value; int nmaps, i; struct gcpro gcpro1; GCPRO1 (key); if (!NILP (current_kboard->Voverriding_terminal_local_map)) { value = Flookup_key (current_kboard->Voverriding_terminal_local_map, key, accept_default); if (! NILP (value) && !INTEGERP (value)) RETURN_UNGCPRO (value); } else if (!NILP (Voverriding_local_map)) { value = Flookup_key (Voverriding_local_map, key, accept_default); if (! NILP (value) && !INTEGERP (value)) RETURN_UNGCPRO (value); } else { nmaps = current_minor_maps (0, &maps); /* Note that all these maps are GCPRO'd in the places where we found them. */ for (i = 0; i < nmaps; i++) if (! NILP (maps[i])) { value = Flookup_key (maps[i], key, accept_default); if (! NILP (value) && !INTEGERP (value)) RETURN_UNGCPRO (value); } if (! NILP (current_buffer->keymap)) { value = Flookup_key (current_buffer->keymap, key, accept_default); if (! NILP (value) && !INTEGERP (value)) RETURN_UNGCPRO (value); } } value = Flookup_key (current_global_map, key, accept_default); UNGCPRO; if (! NILP (value) && !INTEGERP (value)) return value; return Qnil; } /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0, "Return the binding for command KEYS in current local keymap only.\n\ KEYS is a string, a sequence of keystrokes.\n\ The binding is probably a symbol with a function definition.\n\ \n\ If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\ bindings; see the description of `lookup-key' for more details about this.") (keys, accept_default) Lisp_Object keys, accept_default; { register Lisp_Object map; map = current_buffer->keymap; if (NILP (map)) return Qnil; return Flookup_key (map, keys, accept_default); } /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0, "Return the binding for command KEYS in current global keymap only.\n\ KEYS is a string, a sequence of keystrokes.\n\ The binding is probably a symbol with a function definition.\n\ This function's return values are the same as those of lookup-key\n\ \(which see).\n\ \n\ If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\ bindings; see the description of `lookup-key' for more details about this.") (keys, accept_default) Lisp_Object keys, accept_default; { return Flookup_key (current_global_map, keys, accept_default); } /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0, "Find the visible minor mode bindings of KEY.\n\ Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\ the symbol which names the minor mode binding KEY, and BINDING is\n\ KEY's definition in that mode. In particular, if KEY has no\n\ minor-mode bindings, return nil. If the first binding is a\n\ non-prefix, all subsequent bindings will be omitted, since they would\n\ be ignored. Similarly, the list doesn't include non-prefix bindings\n\ that come after prefix bindings.\n\ \n\ If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\ bindings; see the description of `lookup-key' for more details about this.") (key, accept_default) Lisp_Object key, accept_default; { Lisp_Object *modes, *maps; int nmaps; Lisp_Object binding; int i, j; struct gcpro gcpro1, gcpro2; nmaps = current_minor_maps (&modes, &maps); /* Note that all these maps are GCPRO'd in the places where we found them. */ binding = Qnil; GCPRO2 (key, binding); for (i = j = 0; i < nmaps; i++) if (! NILP (maps[i]) && ! NILP (binding = Flookup_key (maps[i], key, accept_default)) && !INTEGERP (binding)) { if (! NILP (get_keymap (binding))) maps[j++] = Fcons (modes[i], binding); else if (j == 0) RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil)); } UNGCPRO; return Flist (j, maps); } DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 0, "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\ A new sparse keymap is stored as COMMAND's function definition and its value.\n\ If a second optional argument MAPVAR is given, the map is stored as\n\ its value instead of as COMMAND's value; but COMMAND is still defined\n\ as a function.") (name, mapvar) Lisp_Object name, mapvar; { Lisp_Object map; map = Fmake_sparse_keymap (Qnil); Ffset (name, map); if (!NILP (mapvar)) Fset (mapvar, map); else Fset (name, map); return name; } DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0, "Select KEYMAP as the global keymap.") (keymap) Lisp_Object keymap; { keymap = get_keymap (keymap); current_global_map = keymap; record_asynch_buffer_change (); return Qnil; } DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0, "Select KEYMAP as the local keymap.\n\ If KEYMAP is nil, that means no local keymap.") (keymap) Lisp_Object keymap; { if (!NILP (keymap)) keymap = get_keymap (keymap); current_buffer->keymap = keymap; record_asynch_buffer_change (); return Qnil; } DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0, "Return current buffer's local keymap, or nil if it has none.") () { return current_buffer->keymap; } DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0, "Return the current global keymap.") () { return current_global_map; } DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0, "Return a list of keymaps for the minor modes of the current buffer.") () { Lisp_Object *maps; int nmaps = current_minor_maps (0, &maps); return Flist (nmaps, maps); } /* Help functions for describing and documenting keymaps. */ /* This function cannot GC. */ DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, 1, 2, 0, "Find all keymaps accessible via prefix characters from KEYMAP.\n\ Returns a list of elements of the form (KEYS . MAP), where the sequence\n\ KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\ so that the KEYS increase in length. The first element is (\"\" . KEYMAP).\n\ An optional argument PREFIX, if non-nil, should be a key sequence;\n\ then the value includes only maps for prefixes that start with PREFIX.") (startmap, prefix) Lisp_Object startmap, prefix; { Lisp_Object maps, good_maps, tail; int prefixlen = 0; /* no need for gcpro because we don't autoload any keymaps. */ if (!NILP (prefix)) prefixlen = XINT (Flength (prefix)); if (!NILP (prefix)) { /* If a prefix was specified, start with the keymap (if any) for that prefix, so we don't waste time considering other prefixes. */ Lisp_Object tem; tem = Flookup_key (startmap, prefix, Qt); /* Flookup_key may give us nil, or a number, if the prefix is not defined in this particular map. It might even give us a list that isn't a keymap. */ tem = get_keymap_1 (tem, 0, 0); if (!NILP (tem)) maps = Fcons (Fcons (prefix, tem), Qnil); else return Qnil; } else maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil), get_keymap (startmap)), Qnil); /* For each map in the list maps, look at any other maps it points to, and stick them at the end if they are not already in the list. This is a breadth-first traversal, where tail is the queue of nodes, and maps accumulates a list of all nodes visited. */ for (tail = maps; CONSP (tail); tail = XCONS (tail)->cdr) { register Lisp_Object thisseq, thismap; Lisp_Object last; /* Does the current sequence end in the meta-prefix-char? */ int is_metized; thisseq = Fcar (Fcar (tail)); thismap = Fcdr (Fcar (tail)); last = make_number (XINT (Flength (thisseq)) - 1); is_metized = (XINT (last) >= 0 && EQ (Faref (thisseq, last), meta_prefix_char)); for (; CONSP (thismap); thismap = XCONS (thismap)->cdr) { Lisp_Object elt; elt = XCONS (thismap)->car; QUIT; if (VECTORP (elt)) { register int i; /* Vector keymap. Scan all the elements. */ for (i = 0; i < XVECTOR (elt)->size; i++) { register Lisp_Object tem; register Lisp_Object cmd; cmd = get_keyelt (XVECTOR (elt)->contents[i], 0); if (NILP (cmd)) continue; tem = Fkeymapp (cmd); if (!NILP (tem)) { cmd = get_keymap (cmd); /* Ignore keymaps that are already added to maps. */ tem = Frassq (cmd, maps); if (NILP (tem)) { /* If the last key in thisseq is meta-prefix-char, turn it into a meta-ized keystroke. We know that the event we're about to append is an ascii keystroke since we're processing a keymap table. */ if (is_metized) { int meta_bit = meta_modifier; tem = Fcopy_sequence (thisseq); Faset (tem, last, make_number (i | meta_bit)); /* This new sequence is the same length as thisseq, so stick it in the list right after this one. */ XCONS (tail)->cdr = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr); } else { tem = append_key (thisseq, make_number (i)); nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil)); } } } } } else if (CONSP (elt)) { register Lisp_Object cmd, tem, filter; cmd = get_keyelt (XCONS (elt)->cdr, 0); /* Ignore definitions that aren't keymaps themselves. */ tem = Fkeymapp (cmd); if (!NILP (tem)) { /* Ignore keymaps that have been seen already. */ cmd = get_keymap (cmd); tem = Frassq (cmd, maps); if (NILP (tem)) { /* Let elt be the event defined by this map entry. */ elt = XCONS (elt)->car; /* If the last key in thisseq is meta-prefix-char, and this entry is a binding for an ascii keystroke, turn it into a meta-ized keystroke. */ if (is_metized && INTEGERP (elt)) { tem = Fcopy_sequence (thisseq); Faset (tem, last, make_number (XINT (elt) | meta_modifier)); /* This new sequence is the same length as thisseq, so stick it in the list right after this one. */ XCONS (tail)->cdr = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr); } else nconc2 (tail, Fcons (Fcons (append_key (thisseq, elt), cmd), Qnil)); } } } } } if (NILP (prefix)) return maps; /* Now find just the maps whose access prefixes start with PREFIX. */ good_maps = Qnil; for (; CONSP (maps); maps = XCONS (maps)->cdr) { Lisp_Object elt, thisseq; elt = XCONS (maps)->car; thisseq = XCONS (elt)->car; /* The access prefix must be at least as long as PREFIX, and the first elements must match those of PREFIX. */ if (XINT (Flength (thisseq)) >= prefixlen) { int i; for (i = 0; i < prefixlen; i++) { Lisp_Object i1; XSETFASTINT (i1, i); if (!EQ (Faref (thisseq, i1), Faref (prefix, i1))) break; } if (i == prefixlen) good_maps = Fcons (elt, good_maps); } } return Fnreverse (good_maps); } Lisp_Object Qsingle_key_description, Qkey_description; /* This function cannot GC. */ DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0, "Return a pretty description of key-sequence KEYS.\n\ Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\ spaces are put between sequence elements, etc.") (keys) Lisp_Object keys; { int len; int i; Lisp_Object sep; Lisp_Object *args; if (STRINGP (keys)) { Lisp_Object vector; vector = Fmake_vector (Flength (keys), Qnil); for (i = 0; i < XSTRING (keys)->size; i++) { if (XSTRING (keys)->data[i] & 0x80) XSETFASTINT (XVECTOR (vector)->contents[i], meta_modifier | (XSTRING (keys)->data[i] & ~0x80)); else XSETFASTINT (XVECTOR (vector)->contents[i], XSTRING (keys)->data[i]); } keys = vector; } else if (!VECTORP (keys)) keys = wrong_type_argument (Qarrayp, keys); /* In effect, this computes (mapconcat 'single-key-description keys " ") but we shouldn't use mapconcat because it can do GC. */ len = XVECTOR (keys)->size; sep = build_string (" "); /* This has one extra element at the end that we don't pass to Fconcat. */ args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object)); for (i = 0; i < len; i++) { args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]); args[i * 2 + 1] = sep; } return Fconcat (len * 2 - 1, args); } char * push_key_description (c, p) register unsigned int c; register char *p; { /* Clear all the meaningless bits above the meta bit. */ c &= meta_modifier | ~ - meta_modifier; if (c & alt_modifier) { *p++ = 'A'; *p++ = '-'; c -= alt_modifier; } if (c & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; c -= ctrl_modifier; } if (c & hyper_modifier) { *p++ = 'H'; *p++ = '-'; c -= hyper_modifier; } if (c & meta_modifier) { *p++ = 'M'; *p++ = '-'; c -= meta_modifier; } if (c & shift_modifier) { *p++ = 'S'; *p++ = '-'; c -= shift_modifier; } if (c & super_modifier) { *p++ = 's'; *p++ = '-'; c -= super_modifier; } if (c < 040) { if (c == 033) { *p++ = 'E'; *p++ = 'S'; *p++ = 'C'; } else if (c == '\t') { *p++ = 'T'; *p++ = 'A'; *p++ = 'B'; } else if (c == Ctl('J')) { *p++ = 'L'; *p++ = 'F'; *p++ = 'D'; } else if (c == Ctl('M')) { *p++ = 'R'; *p++ = 'E'; *p++ = 'T'; } else { *p++ = 'C'; *p++ = '-'; if (c > 0 && c <= Ctl ('Z')) *p++ = c + 0140; else *p++ = c + 0100; } } else if (c == 0177) { *p++ = 'D'; *p++ = 'E'; *p++ = 'L'; } else if (c == ' ') { *p++ = 'S'; *p++ = 'P'; *p++ = 'C'; } else if (c < 256) *p++ = c; else { *p++ = '\\'; *p++ = (7 & (c >> 15)) + '0'; *p++ = (7 & (c >> 12)) + '0'; *p++ = (7 & (c >> 9)) + '0'; *p++ = (7 & (c >> 6)) + '0'; *p++ = (7 & (c >> 3)) + '0'; *p++ = (7 & (c >> 0)) + '0'; } return p; } /* This function cannot GC. */ DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0, "Return a pretty description of command character KEY.\n\ Control characters turn into C-whatever, etc.") (key) Lisp_Object key; { char tem[20]; key = EVENT_HEAD (key); if (INTEGERP (key)) /* Normal character */ { *push_key_description (XUINT (key), tem) = 0; return build_string (tem); } else if (SYMBOLP (key)) /* Function key or event-symbol */ return Fsymbol_name (key); else if (STRINGP (key)) /* Buffer names in the menubar. */ return Fcopy_sequence (key); else error ("KEY must be an integer, cons, symbol, or string"); } char * push_text_char_description (c, p) register unsigned int c; register char *p; { if (c >= 0200) { *p++ = 'M'; *p++ = '-'; c -= 0200; } if (c < 040) { *p++ = '^'; *p++ = c + 64; /* 'A' - 1 */ } else if (c == 0177) { *p++ = '^'; *p++ = '?'; } else *p++ = c; return p; } /* This function cannot GC. */ DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0, "Return a pretty description of file-character CHAR.\n\ Control characters turn into \"^char\", etc.") (chr) Lisp_Object chr; { char tem[6]; CHECK_NUMBER (chr, 0); *push_text_char_description (XINT (chr) & 0377, tem) = 0; return build_string (tem); } /* Return non-zero if SEQ contains only ASCII characters, perhaps with a meta bit. */ static int ascii_sequence_p (seq) Lisp_Object seq; { int i; int len = XINT (Flength (seq)); for (i = 0; i < len; i++) { Lisp_Object ii, elt; XSETFASTINT (ii, i); elt = Faref (seq, ii); if (!INTEGERP (elt) || (XUINT (elt) & ~CHAR_META) >= 0x80) return 0; } return 1; } /* where-is - finding a command in a set of keymaps. */ /* This function can GC if Flookup_key autoloads any keymaps. */ DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0, "Return list of keys that invoke DEFINITION.\n\ If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\ If KEYMAP is nil, search all the currently active keymaps.\n\ \n\ If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\ rather than a list of all possible key sequences.\n\ If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\ no matter what it is.\n\ If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\ and entirely reject menu bindings.\n\ \n\ If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\ to other keymaps or slots. This makes it possible to search for an\n\ indirect definition itself.") (definition, keymap, firstonly, noindirect) Lisp_Object definition, keymap; Lisp_Object firstonly, noindirect; { Lisp_Object maps; Lisp_Object found, sequence; int keymap_specified = !NILP (keymap); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; /* 1 means ignore all menu bindings entirely. */ int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii); if (! keymap_specified) { #ifdef USE_TEXT_PROPERTIES keymap = get_local_map (PT, current_buffer); #else keymap = current_buffer->keymap; #endif } if (!NILP (keymap)) maps = nconc2 (Faccessible_keymaps (get_keymap (keymap), Qnil), Faccessible_keymaps (get_keymap (current_global_map), Qnil)); else maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil); /* Put the minor mode keymaps on the front. */ if (! keymap_specified) { Lisp_Object minors; minors = Fnreverse (Fcurrent_minor_mode_maps ()); while (!NILP (minors)) { maps = nconc2 (Faccessible_keymaps (get_keymap (XCONS (minors)->car), Qnil), maps); minors = XCONS (minors)->cdr; } } GCPRO5 (definition, keymap, maps, found, sequence); found = Qnil; sequence = Qnil; for (; !NILP (maps); maps = Fcdr (maps)) { /* Key sequence to reach map, and the map that it reaches */ register Lisp_Object this, map; /* If Fcar (map) is a VECTOR, the current element within that vector. */ int i = 0; /* In order to fold [META-PREFIX-CHAR CHAR] sequences into [M-CHAR] sequences, check if last character of the sequence is the meta-prefix char. */ Lisp_Object last; int last_is_meta; this = Fcar (Fcar (maps)); map = Fcdr (Fcar (maps)); last = make_number (XINT (Flength (this)) - 1); last_is_meta = (XINT (last) >= 0 && EQ (Faref (this, last), meta_prefix_char)); QUIT; while (CONSP (map)) { /* Because the code we want to run on each binding is rather large, we don't want to have two separate loop bodies for sparse keymap bindings and tables; we want to iterate one loop body over both keymap and vector bindings. For this reason, if Fcar (map) is a vector, we don't advance map to the next element until i indicates that we have finished off the vector. */ Lisp_Object elt, key, binding; elt = XCONS (map)->car; QUIT; /* Set key and binding to the current key and binding, and advance map and i to the next binding. */ if (VECTORP (elt)) { /* In a vector, look at each element. */ binding = XVECTOR (elt)->contents[i]; XSETFASTINT (key, i); i++; /* If we've just finished scanning a vector, advance map to the next element, and reset i in anticipation of the next vector we may find. */ if (i >= XVECTOR (elt)->size) { map = XCONS (map)->cdr; i = 0; } } else if (CONSP (elt)) { key = Fcar (Fcar (map)); binding = Fcdr (Fcar (map)); map = XCONS (map)->cdr; } else /* We want to ignore keymap elements that are neither vectors nor conses. */ { map = XCONS (map)->cdr; continue; } /* Search through indirections unless that's not wanted. */ if (NILP (noindirect)) { if (nomenus) { while (1) { Lisp_Object map, tem; /* If the contents are (KEYMAP . ELEMENT), go indirect. */ map = get_keymap_1 (Fcar_safe (definition), 0, 0); tem = Fkeymapp (map); if (!NILP (tem)) definition = access_keymap (map, Fcdr (definition), 0, 0); else break; } /* If the contents are (STRING ...), reject. */ if (CONSP (definition) && STRINGP (XCONS (definition)->car)) continue; } else binding = get_keyelt (binding, 0); } /* End this iteration if this element does not match the target. */ if (CONSP (definition)) { Lisp_Object tem; tem = Fequal (binding, definition); if (NILP (tem)) continue; } else if (!EQ (binding, definition)) continue; /* We have found a match. Construct the key sequence where we found it. */ if (INTEGERP (key) && last_is_meta) { sequence = Fcopy_sequence (this); Faset (sequence, last, make_number (XINT (key) | meta_modifier)); } else sequence = append_key (this, key); /* Verify that this key binding is not shadowed by another binding for the same key, before we say it exists. Mechanism: look for local definition of this key and if it is defined and does not match what we found then ignore this key. Either nil or number as value from Flookup_key means undefined. */ if (keymap_specified) { binding = Flookup_key (keymap, sequence, Qnil); if (!NILP (binding) && !INTEGERP (binding)) { if (CONSP (definition)) { Lisp_Object tem; tem = Fequal (binding, definition); if (NILP (tem)) continue; } else if (!EQ (binding, definition)) continue; } } else { binding = Fkey_binding (sequence, Qnil); if (!EQ (binding, definition)) continue; } /* It is a true unshadowed match. Record it, unless it's already been seen (as could happen when inheriting keymaps). */ if (NILP (Fmember (sequence, found))) found = Fcons (sequence, found); /* If firstonly is Qnon_ascii, then we can return the first binding we find. If firstonly is not Qnon_ascii but not nil, then we should return the first ascii-only binding we find. */ if (EQ (firstonly, Qnon_ascii)) RETURN_UNGCPRO (sequence); else if (! NILP (firstonly) && ascii_sequence_p (sequence)) RETURN_UNGCPRO (sequence); } } UNGCPRO; found = Fnreverse (found); /* firstonly may have been t, but we may have gone all the way through the keymaps without finding an all-ASCII key sequence. So just return the best we could find. */ if (! NILP (firstonly)) return Fcar (found); return found; } /* describe-bindings - summarizing all the bindings in a set of keymaps. */ DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "", "Show a list of all defined keys, and their definitions.\n\ The list is put in a buffer, which is displayed.\n\ An optional argument PREFIX, if non-nil, should be a key sequence;\n\ then we display only bindings that start with that prefix.") (prefix) Lisp_Object prefix; { register Lisp_Object thisbuf; XSETBUFFER (thisbuf, current_buffer); internal_with_output_to_temp_buffer ("*Help*", describe_buffer_bindings, Fcons (thisbuf, prefix)); return Qnil; } /* ARG is (BUFFER . PREFIX). */ static Lisp_Object describe_buffer_bindings (arg) Lisp_Object arg; { Lisp_Object descbuf, prefix, shadow; register Lisp_Object start1; struct gcpro gcpro1; char *alternate_heading = "\ Alternate Characters (use anywhere the nominal character is listed):\n\ nominal alternate\n\ ------- ---------\n"; descbuf = XCONS (arg)->car; prefix = XCONS (arg)->cdr; shadow = Qnil; GCPRO1 (shadow); Fset_buffer (Vstandard_output); /* Report on alternates for keys. */ if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix)) { int c; unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data; int translate_len = XSTRING (Vkeyboard_translate_table)->size; for (c = 0; c < translate_len; c++) if (translate[c] != c) { char buf[20]; char *bufend; if (alternate_heading) { insert_string (alternate_heading); alternate_heading = 0; } bufend = push_key_description (translate[c], buf); insert (buf, bufend - buf); Findent_to (make_number (16), make_number (1)); bufend = push_key_description (c, buf); insert (buf, bufend - buf); insert ("\n", 1); } insert ("\n", 1); } if (!NILP (Vkey_translation_map)) describe_map_tree (Vkey_translation_map, 0, Qnil, prefix, "Key translations", 0, 1, 0); { int i, nmaps; Lisp_Object *modes, *maps; /* Temporarily switch to descbuf, so that we can get that buffer's minor modes correctly. */ Fset_buffer (descbuf); if (!NILP (current_kboard->Voverriding_terminal_local_map) || !NILP (Voverriding_local_map)) nmaps = 0; else nmaps = current_minor_maps (&modes, &maps); Fset_buffer (Vstandard_output); /* Print the minor mode maps. */ for (i = 0; i < nmaps; i++) { /* The title for a minor mode keymap is constructed at run time. We let describe_map_tree do the actual insertion because it takes care of other features when doing so. */ char *title, *p; if (!SYMBOLP (modes[i])) abort(); p = title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size); *p++ = '`'; bcopy (XSYMBOL (modes[i])->name->data, p, XSYMBOL (modes[i])->name->size); p += XSYMBOL (modes[i])->name->size; *p++ = '\''; bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1); p += sizeof (" Minor Mode Bindings") - 1; *p = 0; describe_map_tree (maps[i], 0, shadow, prefix, title, 0, 0, 0); shadow = Fcons (maps[i], shadow); } } /* Print the (major mode) local map. */ if (!NILP (current_kboard->Voverriding_terminal_local_map)) start1 = current_kboard->Voverriding_terminal_local_map; else if (!NILP (Voverriding_local_map)) start1 = Voverriding_local_map; else start1 = XBUFFER (descbuf)->keymap; if (!NILP (start1)) { describe_map_tree (start1, 0, shadow, prefix, "Major Mode Bindings", 0, 0, 0); shadow = Fcons (start1, shadow); } describe_map_tree (current_global_map, 0, shadow, prefix, "Global Bindings", 0, 0, 1); /* Print the function-key-map translations under this prefix. */ if (!NILP (Vfunction_key_map)) describe_map_tree (Vfunction_key_map, 0, Qnil, prefix, "Function key map translations", 0, 1, 0); call0 (intern ("help-mode")); Fset_buffer (descbuf); UNGCPRO; return Qnil; } /* Insert a desription of the key bindings in STARTMAP, followed by those of all maps reachable through STARTMAP. If PARTIAL is nonzero, omit certain "uninteresting" commands (such as `undefined'). If SHADOW is non-nil, it is a list of maps; don't mention keys which would be shadowed by any of them. PREFIX, if non-nil, says mention only keys that start with PREFIX. TITLE, if not 0, is a string to insert at the beginning. TITLE should not end with a colon or a newline; we supply that. If NOMENU is not 0, then omit menu-bar commands. If TRANSL is nonzero, the definitions are actually key translations so print strings and vectors differently. If ALWAYS_TITLE is nonzero, print the title even if there are no maps to look through. */ void describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl, always_title) Lisp_Object startmap, shadow, prefix; int partial; char *title; int nomenu; int transl; int always_title; { Lisp_Object maps, seen, sub_shadows; struct gcpro gcpro1, gcpro2, gcpro3; int something = 0; char *key_heading = "\ key binding\n\ --- -------\n"; maps = Faccessible_keymaps (startmap, prefix); seen = Qnil; sub_shadows = Qnil; GCPRO3 (maps, seen, sub_shadows); if (nomenu) { Lisp_Object list; /* Delete from MAPS each element that is for the menu bar. */ for (list = maps; !NILP (list); list = XCONS (list)->cdr) { Lisp_Object elt, prefix, tem; elt = Fcar (list); prefix = Fcar (elt); if (XVECTOR (prefix)->size >= 1) { tem = Faref (prefix, make_number (0)); if (EQ (tem, Qmenu_bar)) maps = Fdelq (elt, maps); } } } if (!NILP (maps) || always_title) { if (title) { insert_string (title); if (!NILP (prefix)) { insert_string (" Starting With "); insert1 (Fkey_description (prefix)); } insert_string (":\n"); } insert_string (key_heading); something = 1; } for (; !NILP (maps); maps = Fcdr (maps)) { register Lisp_Object elt, prefix, tail; elt = Fcar (maps); prefix = Fcar (elt); sub_shadows = Qnil; for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object shmap; shmap = XCONS (tail)->car; /* If the sequence by which we reach this keymap is zero-length, then the shadow map for this keymap is just SHADOW. */ if ((STRINGP (prefix) && XSTRING (prefix)->size == 0) || (VECTORP (prefix) && XVECTOR (prefix)->size == 0)) ; /* If the sequence by which we reach this keymap actually has some elements, then the sequence's definition in SHADOW is what we should use. */ else { shmap = Flookup_key (shmap, Fcar (elt), Qt); if (INTEGERP (shmap)) shmap = Qnil; } /* If shmap is not nil and not a keymap, it completely shadows this map, so don't describe this map at all. */ if (!NILP (shmap) && NILP (Fkeymapp (shmap))) goto skip; if (!NILP (shmap)) sub_shadows = Fcons (shmap, sub_shadows); } describe_map (Fcdr (elt), Fcar (elt), transl ? describe_translation : describe_command, partial, sub_shadows, &seen); skip: ; } if (something) insert_string ("\n"); UNGCPRO; } static void describe_command (definition) Lisp_Object definition; { register Lisp_Object tem1; Findent_to (make_number (16), make_number (1)); if (SYMBOLP (definition)) { XSETSTRING (tem1, XSYMBOL (definition)->name); insert1 (tem1); insert_string ("\n"); } else if (STRINGP (definition) || VECTORP (definition)) insert_string ("Keyboard Macro\n"); else { tem1 = Fkeymapp (definition); if (!NILP (tem1)) insert_string ("Prefix Command\n"); else insert_string ("??\n"); } } static void describe_translation (definition) Lisp_Object definition; { register Lisp_Object tem1; Findent_to (make_number (16), make_number (1)); if (SYMBOLP (definition)) { XSETSTRING (tem1, XSYMBOL (definition)->name); insert1 (tem1); insert_string ("\n"); } else if (STRINGP (definition) || VECTORP (definition)) { insert1 (Fkey_description (definition)); insert_string ("\n"); } else { tem1 = Fkeymapp (definition); if (!NILP (tem1)) insert_string ("Prefix Command\n"); else insert_string ("??\n"); } } /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map. Returns the first non-nil binding found in any of those maps. */ static Lisp_Object shadow_lookup (shadow, key, flag) Lisp_Object shadow, key, flag; { Lisp_Object tail, value; for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr) { value = Flookup_key (XCONS (tail)->car, key, flag); if (!NILP (value)) return value; } return Qnil; } /* Describe the contents of map MAP, assuming that this map itself is reached by the sequence of prefix keys KEYS (a string or vector). PARTIAL, SHADOW are as in `describe_map_tree' above. */ static void describe_map (map, keys, elt_describer, partial, shadow, seen) register Lisp_Object map; Lisp_Object keys; int (*elt_describer) (); int partial; Lisp_Object shadow; Lisp_Object *seen; { Lisp_Object elt_prefix; Lisp_Object tail, definition, event; Lisp_Object tem; Lisp_Object suppress; Lisp_Object kludge; int first = 1; struct gcpro gcpro1, gcpro2, gcpro3; if (!NILP (keys) && XFASTINT (Flength (keys)) > 0) { /* Call Fkey_description first, to avoid GC bug for the other string. */ tem = Fkey_description (keys); elt_prefix = concat2 (tem, build_string (" ")); } else elt_prefix = Qnil; if (partial) suppress = intern ("suppress-keymap"); /* This vector gets used to present single keys to Flookup_key. Since that is done once per keymap element, we don't want to cons up a fresh vector every time. */ kludge = Fmake_vector (make_number (1), Qnil); definition = Qnil; GCPRO3 (elt_prefix, definition, kludge); for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr) { QUIT; if (VECTORP (XCONS (tail)->car)) describe_vector (XCONS (tail)->car, elt_prefix, elt_describer, partial, shadow, map); else if (CONSP (XCONS (tail)->car)) { event = XCONS (XCONS (tail)->car)->car; /* Ignore bindings whose "keys" are not really valid events. (We get these in the frames and buffers menu.) */ if (! (SYMBOLP (event) || INTEGERP (event))) continue; definition = get_keyelt (XCONS (XCONS (tail)->car)->cdr, 0); /* Don't show undefined commands or suppressed commands. */ if (NILP (definition)) continue; if (SYMBOLP (definition) && partial) { tem = Fget (definition, suppress); if (!NILP (tem)) continue; } /* Don't show a command that isn't really visible because a local definition of the same key shadows it. */ XVECTOR (kludge)->contents[0] = event; if (!NILP (shadow)) { tem = shadow_lookup (shadow, kludge, Qt); if (!NILP (tem)) continue; } tem = Flookup_key (map, kludge, Qt); if (! EQ (tem, definition)) continue; if (first) { insert ("\n", 1); first = 0; } if (!NILP (elt_prefix)) insert1 (elt_prefix); /* THIS gets the string to describe the character EVENT. */ insert1 (Fsingle_key_description (event)); /* Print a description of the definition of this character. elt_describer will take care of spacing out far enough for alignment purposes. */ (*elt_describer) (definition); } else if (EQ (XCONS (tail)->car, Qkeymap)) { /* The same keymap might be in the structure twice, if we're using an inherited keymap. So skip anything we've already encountered. */ tem = Fassq (tail, *seen); if (CONSP (tem) && !NILP (Fequal (XCONS (tem)->car, keys))) break; *seen = Fcons (Fcons (tail, keys), *seen); } } UNGCPRO; } static int describe_vector_princ (elt) Lisp_Object elt; { Findent_to (make_number (16), make_number (1)); Fprinc (elt, Qnil); Fterpri (Qnil); } DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0, "Insert a description of contents of VECTOR.\n\ This is text showing the elements of vector matched against indices.") (vector) Lisp_Object vector; { int count = specpdl_ptr - specpdl; specbind (Qstandard_output, Fcurrent_buffer ()); CHECK_VECTOR_OR_CHAR_TABLE (vector, 0); describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil, Qnil); return unbind_to (count, Qnil); } /* Insert in the current buffer a description of the contents of VECTOR. We call ELT_DESCRIBER to insert the description of one value found in VECTOR. ELT_PREFIX describes what "comes before" the keys or indices defined by this vector. If the vector is in a keymap, ELT_PREFIX is a prefix key which leads to this keymap. If the vector is a chartable, ELT_PREFIX is the vector of bytes that lead to the character set or portion of a character set described by this chartable. If PARTIAL is nonzero, it means do not mention suppressed commands (that assumes the vector is in a keymap). SHADOW is a list of keymaps that shadow this map. If it is non-nil, then we look up the key in those maps and we don't mention it now if it is defined by any of them. ENTIRE_MAP is the keymap in which this vector appears. If the definition in effect in the whole map does not match the one in this vector, we ignore this one. */ describe_vector (vector, elt_prefix, elt_describer, partial, shadow, entire_map) register Lisp_Object vector; Lisp_Object elt_prefix; int (*elt_describer) (); int partial; Lisp_Object shadow; Lisp_Object entire_map; { Lisp_Object this; Lisp_Object dummy; Lisp_Object definition; Lisp_Object tem2; register int i; Lisp_Object suppress; Lisp_Object kludge; Lisp_Object chartable_kludge; int first = 1; int size; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; definition = Qnil; chartable_kludge = Qnil; /* This vector gets used to present single keys to Flookup_key. Since that is done once per vector element, we don't want to cons up a fresh vector every time. */ kludge = Fmake_vector (make_number (1), Qnil); GCPRO4 (elt_prefix, definition, kludge, chartable_kludge); if (partial) suppress = intern ("suppress-keymap"); /* This does the right thing for char-tables as well as ordinary vectors. */ size = XFASTINT (Flength (vector)); for (i = 0; i < size; i++) { QUIT; definition = get_keyelt (XVECTOR (vector)->contents[i], 0); if (NILP (definition)) continue; /* Don't mention suppressed commands. */ if (SYMBOLP (definition) && partial) { this = Fget (definition, suppress); if (!NILP (this)) continue; } /* If this binding is shadowed by some other map, ignore it. */ if (!NILP (shadow)) { Lisp_Object tem; XVECTOR (kludge)->contents[0] = make_number (i); tem = shadow_lookup (shadow, kludge, Qt); if (!NILP (tem)) continue; } /* Ignore this definition if it is shadowed by an earlier one in the same keymap. */ if (!NILP (entire_map)) { Lisp_Object tem; XVECTOR (kludge)->contents[0] = make_number (i); tem = Flookup_key (entire_map, kludge, Qt); if (! EQ (tem, definition)) continue; } /* If we find a char-table within a char-table, scan it recursively; it defines the details for a character set or a portion of a character set. */ if (CHAR_TABLE_P (vector) && CHAR_TABLE_P (definition)) { int outer_level = !NILP (elt_prefix) ? XVECTOR (elt_prefix)->size : 0; if (NILP (chartable_kludge)) { chartable_kludge = Fmake_vector (make_number (outer_level + 1), Qnil); if (outer_level != 0) bcopy (XVECTOR (elt_prefix)->contents, XVECTOR (chartable_kludge)->contents, outer_level * sizeof (Lisp_Object)); } XVECTOR (chartable_kludge)->contents[outer_level] = make_number (i); describe_vector (definition, chartable_kludge, elt_describer, partial, shadow, entire_map); continue; } if (first) { insert ("\n", 1); first = 0; } if (CHAR_TABLE_P (vector)) { if (!NILP (elt_prefix)) { /* Must combine elt_prefix with i to produce a character code, then insert that character's description. */ } else { /* Get the string to describe the character I, and print it. */ XSETFASTINT (dummy, i); /* THIS gets the string to describe the character DUMMY. */ this = Fsingle_key_description (dummy); insert1 (this); } } else { /* Output the prefix that applies to every entry in this map. */ if (!NILP (elt_prefix)) insert1 (elt_prefix); /* Get the string to describe the character I, and print it. */ XSETFASTINT (dummy, i); /* THIS gets the string to describe the character DUMMY. */ this = Fsingle_key_description (dummy); insert1 (this); } /* Find all consecutive characters that have the same definition. */ while (i + 1 < XVECTOR (vector)->size && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1], 0), EQ (tem2, definition))) i++; /* If we have a range of more than one character, print where the range reaches to. */ if (i != XINT (dummy)) { insert (" .. ", 4); if (CHAR_TABLE_P (vector)) { if (!NILP (elt_prefix)) { /* Must combine elt_prefix with i to produce a character code, then insert that character's description. */ } else { XSETFASTINT (dummy, i); this = Fsingle_key_description (dummy); insert1 (this); } } else { if (!NILP (elt_prefix)) insert1 (elt_prefix); XSETFASTINT (dummy, i); insert1 (Fsingle_key_description (dummy)); } } /* Print a description of the definition of this character. elt_describer will take care of spacing out far enough for alignment purposes. */ (*elt_describer) (definition); } UNGCPRO; } /* Apropos - finding all symbols whose names match a regexp. */ Lisp_Object apropos_predicate; Lisp_Object apropos_accumulate; static void apropos_accum (symbol, string) Lisp_Object symbol, string; { register Lisp_Object tem; tem = Fstring_match (string, Fsymbol_name (symbol), Qnil); if (!NILP (tem) && !NILP (apropos_predicate)) tem = call1 (apropos_predicate, symbol); if (!NILP (tem)) apropos_accumulate = Fcons (symbol, apropos_accumulate); } DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0, "Show all symbols whose names contain match for REGEXP.\n\ If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done\n\ for each symbol and a symbol is mentioned only if that returns non-nil.\n\ Return list of symbols found.") (string, pred) Lisp_Object string, pred; { struct gcpro gcpro1, gcpro2; CHECK_STRING (string, 0); apropos_predicate = pred; GCPRO2 (apropos_predicate, apropos_accumulate); apropos_accumulate = Qnil; map_obarray (Vobarray, apropos_accum, string); apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp); UNGCPRO; return apropos_accumulate; } syms_of_keymap () { Lisp_Object tem; Qkeymap = intern ("keymap"); staticpro (&Qkeymap); /* Initialize the keymaps standardly used. Each one is the value of a Lisp variable, and is also pointed to by a C variable */ global_map = Fcons (Qkeymap, Fcons (Fmake_vector (make_number (0400), Qnil), Qnil)); Fset (intern ("global-map"), global_map); meta_map = Fmake_keymap (Qnil); Fset (intern ("esc-map"), meta_map); Ffset (intern ("ESC-prefix"), meta_map); control_x_map = Fmake_keymap (Qnil); Fset (intern ("ctl-x-map"), control_x_map); Ffset (intern ("Control-X-prefix"), control_x_map); DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands, "List of commands given new key bindings recently.\n\ This is used for internal purposes during Emacs startup;\n\ don't alter it yourself."); Vdefine_key_rebound_commands = Qt; DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map, "Default keymap to use when reading from the minibuffer."); Vminibuffer_local_map = Fmake_sparse_keymap (Qnil); DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map, "Local keymap for the minibuffer when spaces are not allowed."); Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil); DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map, "Local keymap for minibuffer input with completion."); Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil); DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map, "Local keymap for minibuffer input with completion, for exact match."); Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil); current_global_map = global_map; DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist, "Alist of keymaps to use for minor modes.\n\ Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\ key sequences and look up bindings iff VARIABLE's value is non-nil.\n\ If two active keymaps bind the same key, the keymap appearing earlier\n\ in the list takes precedence."); Vminor_mode_map_alist = Qnil; DEFVAR_LISP ("function-key-map", &Vfunction_key_map, "Keymap mapping ASCII function key sequences onto their preferred forms.\n\ This allows Emacs to recognize function keys sent from ASCII\n\ terminals at any point in a key sequence.\n\ \n\ The `read-key-sequence' function replaces any subsequence bound by\n\ `function-key-map' with its binding. More precisely, when the active\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\ The events that come from bindings in `function-key-map' are not\n\ themselves looked up in `function-key-map'.\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); DEFVAR_LISP ("key-translation-map", &Vkey_translation_map, "Keymap of key translations that can override keymaps.\n\ This keymap works like `function-key-map', but comes after that,\n\ and applies even for keys that have ordinary bindings."); Vkey_translation_map = Qnil; Qsingle_key_description = intern ("single-key-description"); staticpro (&Qsingle_key_description); Qkey_description = intern ("key-description"); staticpro (&Qkey_description); Qkeymapp = intern ("keymapp"); staticpro (&Qkeymapp); Qnon_ascii = intern ("non-ascii"); staticpro (&Qnon_ascii); defsubr (&Skeymapp); defsubr (&Smake_keymap); defsubr (&Smake_sparse_keymap); defsubr (&Scopy_keymap); defsubr (&Skey_binding); defsubr (&Slocal_key_binding); defsubr (&Sglobal_key_binding); defsubr (&Sminor_mode_key_binding); defsubr (&Sdefine_key); defsubr (&Slookup_key); defsubr (&Sdefine_prefix_command); defsubr (&Suse_global_map); defsubr (&Suse_local_map); defsubr (&Scurrent_local_map); defsubr (&Scurrent_global_map); defsubr (&Scurrent_minor_mode_maps); defsubr (&Saccessible_keymaps); defsubr (&Skey_description); defsubr (&Sdescribe_vector); defsubr (&Ssingle_key_description); defsubr (&Stext_char_description); defsubr (&Swhere_is_internal); defsubr (&Sdescribe_bindings); defsubr (&Sapropos_internal); } keys_of_keymap () { Lisp_Object tem; initial_define_key (global_map, 033, "ESC-prefix"); initial_define_key (global_map, Ctl('X'), "Control-X-prefix"); } emacs-19.30/src/lastfile.c100444 75424 1 2731 5770115135 14047 0ustar kwzhdaemon/* Mark end of data space to dump as pure, for GNU Emacs. Copyright (C) 1985 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. */ /* How this works: Fdump_emacs dumps everything up to my_edata as text space (pure). The files of Emacs are written so as to have no initialized data that can ever need to be altered except at the first startup. This is so that those words can be dumped as sharable text. It is not possible to exercise such control over library files. So it is necessary to refrain from making their data areas shared. Therefore, this file is loaded following all the files of Emacs but before library files. As a result, the symbol my_edata indicates the point in data space between data coming from Emacs and data coming from libraries. */ char my_edata[] = "End of Emacs initialized data"; emacs-19.30/src/lread.c100444 12120 1 174674 6053713743 13215 0ustar rmsdaemon/* Lisp parsing and input streams. Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995 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. */ #include #include #include #include #include #include #include "lisp.h" #ifndef standalone #include "buffer.h" #include #include "commands.h" #include "keyboard.h" #include "termhooks.h" #endif #ifdef lint #include #endif /* lint */ #ifndef X_OK #define X_OK 01 #endif #ifdef LISP_FLOAT_TYPE #ifdef STDC_HEADERS #include #endif #ifdef MSDOS #include "msdos.h" #endif #include #endif /* LISP_FLOAT_TYPE */ #ifndef O_RDONLY #define O_RDONLY 0 #endif extern int errno; Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list; Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist; Lisp_Object Qascii_character, Qload, Qload_file_name; Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; extern Lisp_Object Qevent_symbol_element_mask; /* non-zero if inside `load' */ int load_in_progress; /* Directory in which the sources were found. */ Lisp_Object Vsource_directory; /* Search path for files to be loaded. */ Lisp_Object Vload_path; /* This is the user-visible association list that maps features to lists of defs in their load files. */ Lisp_Object Vload_history; /* This is used to build the load history. */ Lisp_Object Vcurrent_load_list; /* Name of file actually being read by `load'. */ Lisp_Object Vload_file_name; /* Function to use for reading, in `load' and friends. */ Lisp_Object Vload_read_function; /* Nonzero means load should forcibly load all dynamic doc strings. */ static int load_force_doc_strings; /* List of descriptors now open for Fload. */ static Lisp_Object load_descriptor_list; /* File for get_file_char to read from. Use by load. */ static FILE *instream; /* When nonzero, read conses in pure space */ static int read_pure; /* For use within read-from-string (this reader is non-reentrant!!) */ static int read_from_string_index; static int read_from_string_limit; /* This contains the last string skipped with #@. */ static char *saved_doc_string; /* Length of buffer allocated in saved_doc_string. */ static int saved_doc_string_size; /* Length of actual data in saved_doc_string. */ static int saved_doc_string_length; /* This is the file position that string came from. */ static int saved_doc_string_position; /* Nonzero means inside a new-style backquote with no surrounding parentheses. Fread initializes this to zero, so we need not specbind it or worry about what happens to it when there is an error. */ static int new_backquote_flag; /* Handle unreading and rereading of characters. Write READCHAR to read a character, UNREAD(c) to unread c to be read again. */ #define READCHAR readchar (readcharfun) #define UNREAD(c) unreadchar (readcharfun, c) static int readchar (readcharfun) Lisp_Object readcharfun; { Lisp_Object tem; register struct buffer *inbuffer; register int c, mpos; if (BUFFERP (readcharfun)) { inbuffer = XBUFFER (readcharfun); if (BUF_PT (inbuffer) >= BUF_ZV (inbuffer)) return -1; c = *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer, BUF_PT (inbuffer)); SET_BUF_PT (inbuffer, BUF_PT (inbuffer) + 1); return c; } if (MARKERP (readcharfun)) { inbuffer = XMARKER (readcharfun)->buffer; mpos = marker_position (readcharfun); if (mpos > BUF_ZV (inbuffer) - 1) return -1; c = *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer, mpos); if (mpos != BUF_GPT (inbuffer)) XMARKER (readcharfun)->bufpos++; else Fset_marker (readcharfun, make_number (mpos + 1), Fmarker_buffer (readcharfun)); return c; } if (EQ (readcharfun, Qget_file_char)) { c = getc (instream); #ifdef EINTR /* Interrupted reads have been observed while reading over the network */ while (c == EOF && ferror (instream) && errno == EINTR) { clearerr (instream); c = getc (instream); } #endif return c; } if (STRINGP (readcharfun)) { register int c; /* This used to be return of a conditional expression, but that truncated -1 to a char on VMS. */ if (read_from_string_index < read_from_string_limit) c = XSTRING (readcharfun)->data[read_from_string_index++]; else c = -1; return c; } tem = call0 (readcharfun); if (NILP (tem)) return -1; return XINT (tem); } /* Unread the character C in the way appropriate for the stream READCHARFUN. If the stream is a user function, call it with the char as argument. */ static void unreadchar (readcharfun, c) Lisp_Object readcharfun; int c; { if (c == -1) /* Don't back up the pointer if we're unreading the end-of-input mark, since readchar didn't advance it when we read it. */ ; else if (BUFFERP (readcharfun)) { if (XBUFFER (readcharfun) == current_buffer) SET_PT (point - 1); else SET_BUF_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1); } else if (MARKERP (readcharfun)) XMARKER (readcharfun)->bufpos--; else if (STRINGP (readcharfun)) read_from_string_index--; else if (EQ (readcharfun, Qget_file_char)) ungetc (c, instream); else call1 (readcharfun, make_number (c)); } static Lisp_Object read0 (), read1 (), read_list (), read_vector (); /* get a character from the tty */ extern Lisp_Object read_char (); /* Read input events until we get one that's acceptable for our purposes. If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed until we get a character we like, and then stuffed into unread_switch_frame. If ASCII_REQUIRED is non-zero, we check function key events to see if the unmodified version of the symbol has a Qascii_character property, and use that character, if present. If ERROR_NONASCII is non-zero, we signal an error if the input we get isn't an ASCII character with modifiers. If it's zero but ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII character. */ Lisp_Object read_filtered_event (no_switch_frame, ascii_required, error_nonascii) int no_switch_frame, ascii_required, error_nonascii; { #ifdef standalone return make_number (getchar ()); #else register Lisp_Object val, delayed_switch_frame; delayed_switch_frame = Qnil; /* Read until we get an acceptable event. */ retry: val = read_char (0, 0, 0, Qnil, 0); if (BUFFERP (val)) goto retry; /* switch-frame events are put off until after the next ASCII character. This is better than signalling an error just because the last characters were typed to a separate minibuffer frame, for example. Eventually, some code which can deal with switch-frame events will read it and process it. */ if (no_switch_frame && EVENT_HAS_PARAMETERS (val) && EQ (EVENT_HEAD (val), Qswitch_frame)) { delayed_switch_frame = val; goto retry; } if (ascii_required) { /* Convert certain symbols to their ASCII equivalents. */ if (SYMBOLP (val)) { Lisp_Object tem, tem1, tem2; tem = Fget (val, Qevent_symbol_element_mask); if (!NILP (tem)) { tem1 = Fget (Fcar (tem), Qascii_character); /* Merge this symbol's modifier bits with the ASCII equivalent of its basic code. */ if (!NILP (tem1)) XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem)))); } } /* If we don't have a character now, deal with it appropriately. */ if (!INTEGERP (val)) { if (error_nonascii) { Vunread_command_events = Fcons (val, Qnil); error ("Non-character input-event"); } else goto retry; } } if (! NILP (delayed_switch_frame)) unread_switch_frame = delayed_switch_frame; return val; #endif } DEFUN ("read-char", Fread_char, Sread_char, 0, 0, 0, "Read a character from the command input (keyboard or macro).\n\ It is returned as a number.\n\ If the user generates an event which is not a character (i.e. a mouse\n\ click or function key event), `read-char' signals an error. As an\n\ exception, switch-frame events are put off until non-ASCII events can\n\ be read.\n\ If you want to read non-character events, or ignore them, call\n\ `read-event' or `read-char-exclusive' instead.") () { return read_filtered_event (1, 1, 1); } DEFUN ("read-event", Fread_event, Sread_event, 0, 0, 0, "Read an event object from the input stream.") () { return read_filtered_event (0, 0, 0); } DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 0, 0, "Read a character from the command input (keyboard or macro).\n\ It is returned as a number. Non character events are ignored.") () { return read_filtered_event (1, 1, 0); } DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, "Don't use this yourself.") () { register Lisp_Object val; XSETINT (val, getc (instream)); return val; } static void readevalloop (); static Lisp_Object load_unwind (); static Lisp_Object load_descriptor_unwind (); DEFUN ("load", Fload, Sload, 1, 4, 0, "Execute a file of Lisp code named FILE.\n\ First try FILE with `.elc' appended, then try with `.el',\n\ then try FILE unmodified.\n\ This function searches the directories in `load-path'.\n\ If optional second arg NOERROR is non-nil,\n\ report no error if FILE doesn't exist.\n\ Print messages at start and end of loading unless\n\ optional third arg NOMESSAGE is non-nil.\n\ If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\ suffixes `.elc' or `.el' to the specified name FILE.\n\ Return t if file exists.") (file, noerror, nomessage, nosuffix) Lisp_Object file, noerror, nomessage, nosuffix; { register FILE *stream; register int fd = -1; register Lisp_Object lispstream; int count = specpdl_ptr - specpdl; Lisp_Object temp; struct gcpro gcpro1; Lisp_Object found; /* 1 means inhibit the message at the beginning. */ int nomessage1 = 0; Lisp_Object handler; #ifdef DOS_NT char *dosmode = "rt"; #endif /* DOS_NT */ CHECK_STRING (file, 0); /* If file name is magic, call the handler. */ handler = Ffind_file_name_handler (file, Qload); if (!NILP (handler)) return call5 (handler, Qload, file, noerror, nomessage, nosuffix); /* Do this after the handler to avoid the need to gcpro noerror, nomessage and nosuffix. (Below here, we care only whether they are nil or not.) */ file = Fsubstitute_in_file_name (file); /* Avoid weird lossage with null string as arg, since it would try to load a directory as a Lisp file */ if (XSTRING (file)->size > 0) { GCPRO1 (file); fd = openp (Vload_path, file, !NILP (nosuffix) ? "" : ".elc:.el:", &found, 0); UNGCPRO; } if (fd < 0) { if (NILP (noerror)) while (1) Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"), Fcons (file, Qnil))); else return Qnil; } if (!bcmp (&(XSTRING (found)->data[XSTRING (found)->size - 4]), ".elc", 4)) { struct stat s1, s2; int result; #ifdef DOS_NT dosmode = "rb"; #endif /* DOS_NT */ stat ((char *)XSTRING (found)->data, &s1); XSTRING (found)->data[XSTRING (found)->size - 1] = 0; result = stat ((char *)XSTRING (found)->data, &s2); if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime) { message ("Source file `%s' newer than byte-compiled file", XSTRING (found)->data); /* Don't immediately overwrite this message. */ if (!noninteractive) nomessage1 = 1; } XSTRING (found)->data[XSTRING (found)->size - 1] = 'c'; } #ifdef DOS_NT close (fd); stream = fopen ((char *) XSTRING (found)->data, dosmode); #else /* not DOS_NT */ stream = fdopen (fd, "r"); #endif /* not DOS_NT */ if (stream == 0) { close (fd); error ("Failure to create stdio stream for %s", XSTRING (file)->data); } if (NILP (nomessage) && !nomessage1) message ("Loading %s...", XSTRING (file)->data); GCPRO1 (file); lispstream = Fcons (Qnil, Qnil); XSETFASTINT (XCONS (lispstream)->car, (EMACS_UINT)stream >> 16); XSETFASTINT (XCONS (lispstream)->cdr, (EMACS_UINT)stream & 0xffff); record_unwind_protect (load_unwind, lispstream); record_unwind_protect (load_descriptor_unwind, load_descriptor_list); specbind (Qload_file_name, found); load_descriptor_list = Fcons (make_number (fileno (stream)), load_descriptor_list); load_in_progress++; readevalloop (Qget_file_char, stream, file, Feval, 0); unbind_to (count, Qnil); /* Run any load-hooks for this file. */ temp = Fassoc (file, Vafter_load_alist); if (!NILP (temp)) Fprogn (Fcdr (temp)); UNGCPRO; if (saved_doc_string) free (saved_doc_string); saved_doc_string = 0; saved_doc_string_size = 0; if (!noninteractive && NILP (nomessage)) message ("Loading %s...done", XSTRING (file)->data); return Qt; } static Lisp_Object load_unwind (stream) /* used as unwind-protect function in load */ Lisp_Object stream; { fclose ((FILE *) (XFASTINT (XCONS (stream)->car) << 16 | XFASTINT (XCONS (stream)->cdr))); if (--load_in_progress < 0) load_in_progress = 0; return Qnil; } static Lisp_Object load_descriptor_unwind (oldlist) Lisp_Object oldlist; { load_descriptor_list = oldlist; return Qnil; } /* Close all descriptors in use for Floads. This is used when starting a subprocess. */ void close_load_descs () { Lisp_Object tail; for (tail = load_descriptor_list; !NILP (tail); tail = XCONS (tail)->cdr) close (XFASTINT (XCONS (tail)->car)); } static int complete_filename_p (pathname) Lisp_Object pathname; { register unsigned char *s = XSTRING (pathname)->data; return (IS_DIRECTORY_SEP (s[0]) || (XSTRING (pathname)->size > 2 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])) #ifdef ALTOS || *s == '@' #endif #ifdef VMS || index (s, ':') #endif /* VMS */ ); } /* Search for a file whose name is STR, looking in directories in the Lisp list PATH, and trying suffixes from SUFFIX. SUFFIX is a string containing possible suffixes separated by colons. On success, returns a file descriptor. On failure, returns -1. EXEC_ONLY nonzero means don't open the files, just look for one that is executable. In this case, returns 1 on success. If STOREPTR is nonzero, it points to a slot where the name of the file actually found should be stored as a Lisp string. Nil is stored there on failure. */ int openp (path, str, suffix, storeptr, exec_only) Lisp_Object path, str; char *suffix; Lisp_Object *storeptr; int exec_only; { register int fd; int fn_size = 100; char buf[100]; register char *fn = buf; int absolute = 0; int want_size; register Lisp_Object filename; struct stat st; struct gcpro gcpro1; GCPRO1 (str); if (storeptr) *storeptr = Qnil; if (complete_filename_p (str)) absolute = 1; for (; !NILP (path); path = Fcdr (path)) { char *nsuffix; filename = Fexpand_file_name (str, Fcar (path)); if (!complete_filename_p (filename)) /* If there are non-absolute elts in PATH (eg ".") */ /* Of course, this could conceivably lose if luser sets default-directory to be something non-absolute... */ { filename = Fexpand_file_name (filename, current_buffer->directory); if (!complete_filename_p (filename)) /* Give up on this path element! */ continue; } /* Calculate maximum size of any filename made from this path element/specified file name and any possible suffix. */ want_size = strlen (suffix) + XSTRING (filename)->size + 1; if (fn_size < want_size) fn = (char *) alloca (fn_size = 100 + want_size); nsuffix = suffix; /* Loop over suffixes. */ while (1) { char *esuffix = (char *) index (nsuffix, ':'); int lsuffix = esuffix ? esuffix - nsuffix : strlen (nsuffix); /* Concatenate path element/specified name with the suffix. */ strncpy (fn, XSTRING (filename)->data, XSTRING (filename)->size); fn[XSTRING (filename)->size] = 0; if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */ strncat (fn, nsuffix, lsuffix); /* Ignore file if it's a directory. */ if (stat (fn, &st) >= 0 && (st.st_mode & S_IFMT) != S_IFDIR) { /* Check that we can access or open it. */ if (exec_only) fd = (access (fn, X_OK) == 0) ? 1 : -1; else fd = open (fn, O_RDONLY, 0); if (fd >= 0) { /* We succeeded; return this descriptor and filename. */ if (storeptr) *storeptr = build_string (fn); UNGCPRO; return fd; } } /* Advance to next suffix. */ if (esuffix == 0) break; nsuffix += lsuffix + 1; } if (absolute) break; } UNGCPRO; return -1; } /* Merge the list we've accumulated of globals from the current input source into the load_history variable. The details depend on whether the source has an associated file name or not. */ static void build_load_history (stream, source) FILE *stream; Lisp_Object source; { register Lisp_Object tail, prev, newelt; register Lisp_Object tem, tem2; register int foundit, loading; /* Don't bother recording anything for preloaded files. */ if (!NILP (Vpurify_flag)) return; loading = stream || !NARROWED; tail = Vload_history; prev = Qnil; foundit = 0; while (!NILP (tail)) { tem = Fcar (tail); /* Find the feature's previous assoc list... */ if (!NILP (Fequal (source, Fcar (tem)))) { foundit = 1; /* If we're loading, remove it. */ if (loading) { if (NILP (prev)) Vload_history = Fcdr (tail); else Fsetcdr (prev, Fcdr (tail)); } /* Otherwise, cons on new symbols that are not already members. */ else { tem2 = Vcurrent_load_list; while (CONSP (tem2)) { newelt = Fcar (tem2); if (NILP (Fmemq (newelt, tem))) Fsetcar (tail, Fcons (Fcar (tem), Fcons (newelt, Fcdr (tem)))); tem2 = Fcdr (tem2); QUIT; } } } else prev = tail; tail = Fcdr (tail); QUIT; } /* If we're loading, cons the new assoc onto the front of load-history, the most-recently-loaded position. Also do this if we didn't find an existing member for the current source. */ if (loading || !foundit) Vload_history = Fcons (Fnreverse (Vcurrent_load_list), Vload_history); } Lisp_Object unreadpure () /* Used as unwind-protect function in readevalloop */ { read_pure = 0; return Qnil; } static void readevalloop (readcharfun, stream, sourcename, evalfun, printflag) Lisp_Object readcharfun; FILE *stream; Lisp_Object sourcename; Lisp_Object (*evalfun) (); int printflag; { register int c; register Lisp_Object val; int count = specpdl_ptr - specpdl; struct gcpro gcpro1; struct buffer *b = 0; if (BUFFERP (readcharfun)) b = XBUFFER (readcharfun); else if (MARKERP (readcharfun)) b = XMARKER (readcharfun)->buffer; specbind (Qstandard_input, readcharfun); specbind (Qcurrent_load_list, Qnil); GCPRO1 (sourcename); LOADHIST_ATTACH (sourcename); while (1) { if (b != 0 && NILP (b->name)) error ("Reading from killed buffer"); instream = stream; c = READCHAR; if (c == ';') { while ((c = READCHAR) != '\n' && c != -1); continue; } if (c < 0) break; /* Ignore whitespace here, so we can detect eof. */ if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r') continue; if (!NILP (Vpurify_flag) && c == '(') { int count1 = specpdl_ptr - specpdl; record_unwind_protect (unreadpure, Qnil); val = read_list (-1, readcharfun); unbind_to (count1, Qnil); } else { UNREAD (c); if (NILP (Vload_read_function)) val = read0 (readcharfun); else val = call1 (Vload_read_function, readcharfun); } val = (*evalfun) (val); if (printflag) { Vvalues = Fcons (val, Vvalues); if (EQ (Vstandard_output, Qt)) Fprin1 (val, Qnil); else Fprint (val, Qnil); } } build_load_history (stream, sourcename); UNGCPRO; unbind_to (count, Qnil); } #ifndef standalone DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 2, "", "Execute the current buffer as Lisp code.\n\ Programs can pass two arguments, BUFFER and PRINTFLAG.\n\ BUFFER is the buffer to evaluate (nil means use current buffer).\n\ PRINTFLAG controls printing of output:\n\ nil means discard it; anything else is stream for print.\n\ \n\ If there is no error, point does not move. If there is an error,\n\ point remains at the end of the last character read from the buffer.") (bufname, printflag) Lisp_Object bufname, printflag; { int count = specpdl_ptr - specpdl; Lisp_Object tem, buf; if (NILP (bufname)) buf = Fcurrent_buffer (); else buf = Fget_buffer (bufname); if (NILP (buf)) error ("No such buffer."); if (NILP (printflag)) tem = Qsymbolp; else tem = printflag; specbind (Qstandard_output, tem); record_unwind_protect (save_excursion_restore, save_excursion_save ()); BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); readevalloop (buf, 0, XBUFFER (buf)->filename, Feval, !NILP (printflag)); unbind_to (count, Qnil); return Qnil; } #if 0 DEFUN ("eval-current-buffer", Feval_current_buffer, Seval_current_buffer, 0, 1, "", "Execute the current buffer as Lisp code.\n\ Programs can pass argument PRINTFLAG which controls printing of output:\n\ nil means discard it; anything else is stream for print.\n\ \n\ If there is no error, point does not move. If there is an error,\n\ point remains at the end of the last character read from the buffer.") (printflag) Lisp_Object printflag; { int count = specpdl_ptr - specpdl; Lisp_Object tem, cbuf; cbuf = Fcurrent_buffer () if (NILP (printflag)) tem = Qsymbolp; else tem = printflag; specbind (Qstandard_output, tem); record_unwind_protect (save_excursion_restore, save_excursion_save ()); SET_PT (BEGV); readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, !NILP (printflag)); return unbind_to (count, Qnil); } #endif DEFUN ("eval-region", Feval_region, Seval_region, 2, 3, "r", "Execute the region as Lisp code.\n\ When called from programs, expects two arguments,\n\ giving starting and ending indices in the current buffer\n\ of the text to be executed.\n\ Programs can pass third argument PRINTFLAG which controls output:\n\ nil means discard it; anything else is stream for printing it.\n\ \n\ If there is no error, point does not move. If there is an error,\n\ point remains at the end of the last character read from the buffer.") (b, e, printflag) Lisp_Object b, e, printflag; { int count = specpdl_ptr - specpdl; Lisp_Object tem, cbuf; cbuf = Fcurrent_buffer (); if (NILP (printflag)) tem = Qsymbolp; else tem = printflag; specbind (Qstandard_output, tem); if (NILP (printflag)) record_unwind_protect (save_excursion_restore, save_excursion_save ()); record_unwind_protect (save_restriction_restore, save_restriction_save ()); /* This both uses b and checks its type. */ Fgoto_char (b); Fnarrow_to_region (make_number (BEGV), e); readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, !NILP (printflag)); return unbind_to (count, Qnil); } #endif /* standalone */ DEFUN ("read", Fread, Sread, 0, 1, 0, "Read one Lisp expression as text from STREAM, return as Lisp object.\n\ If STREAM is nil, use the value of `standard-input' (which see).\n\ STREAM or the value of `standard-input' may be:\n\ a buffer (read from point and advance it)\n\ a marker (read from where it points and advance it)\n\ a function (call it with no arguments for each character,\n\ call it with a char as argument to push a char back)\n\ a string (takes text from string, starting at the beginning)\n\ t (read text line using minibuffer and use it).") (stream) Lisp_Object stream; { extern Lisp_Object Fread_minibuffer (); if (NILP (stream)) stream = Vstandard_input; if (EQ (stream, Qt)) stream = Qread_char; new_backquote_flag = 0; #ifndef standalone if (EQ (stream, Qread_char)) return Fread_minibuffer (build_string ("Lisp expression: "), Qnil); #endif if (STRINGP (stream)) return Fcar (Fread_from_string (stream, Qnil, Qnil)); return read0 (stream); } DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0, "Read one Lisp expression which is represented as text by STRING.\n\ Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\ START and END optionally delimit a substring of STRING from which to read;\n\ they default to 0 and (length STRING) respectively.") (string, start, end) Lisp_Object string, start, end; { int startval, endval; Lisp_Object tem; CHECK_STRING (string,0); if (NILP (end)) endval = XSTRING (string)->size; else { CHECK_NUMBER (end,2); endval = XINT (end); if (endval < 0 || endval > XSTRING (string)->size) args_out_of_range (string, end); } if (NILP (start)) startval = 0; else { CHECK_NUMBER (start,1); startval = XINT (start); if (startval < 0 || startval > endval) args_out_of_range (string, start); } read_from_string_index = startval; read_from_string_limit = endval; new_backquote_flag = 0; tem = read0 (string); return Fcons (tem, make_number (read_from_string_index)); } /* Use this for recursive reads, in contexts where internal tokens are not allowed. */ static Lisp_Object read0 (readcharfun) Lisp_Object readcharfun; { register Lisp_Object val; char c; val = read1 (readcharfun, &c, 0); if (c) Fsignal (Qinvalid_read_syntax, Fcons (make_string (&c, 1), Qnil)); return val; } static int read_buffer_size; static char *read_buffer; static int read_escape (readcharfun) Lisp_Object readcharfun; { register int c = READCHAR; switch (c) { case 'a': return '\007'; case 'b': return '\b'; case 'd': return 0177; case 'e': return 033; case 'f': return '\f'; case 'n': return '\n'; case 'r': return '\r'; case 't': return '\t'; case 'v': return '\v'; case '\n': return -1; case 'M': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') c = read_escape (readcharfun); return c | meta_modifier; case 'S': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') c = read_escape (readcharfun); return c | shift_modifier; case 'H': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') c = read_escape (readcharfun); return c | hyper_modifier; case 'A': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') c = read_escape (readcharfun); return c | alt_modifier; case 's': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') c = read_escape (readcharfun); return c | super_modifier; case 'C': c = READCHAR; if (c != '-') error ("Invalid escape character syntax"); case '^': c = READCHAR; if (c == '\\') c = read_escape (readcharfun); if ((c & 0177) == '?') return 0177 | c; /* ASCII control chars are made from letters (both cases), as well as the non-letters within 0100...0137. */ else if ((c & 0137) >= 0101 && (c & 0137) <= 0132) return (c & (037 | ~0177)); else if ((c & 0177) >= 0100 && (c & 0177) <= 0137) return (c & (037 | ~0177)); else return c | ctrl_modifier; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': /* An octal escape, as in ANSI C. */ { register int i = c - '0'; register int count = 0; while (++count < 3) { if ((c = READCHAR) >= '0' && c <= '7') { i *= 8; i += c - '0'; } else { UNREAD (c); break; } } return i; } case 'x': /* A hex escape, as in ANSI C. */ { int i = 0; while (1) { c = READCHAR; if (c >= '0' && c <= '9') { i *= 16; i += c - '0'; } else if ((c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F')) { i *= 16; if (c >= 'a' && c <= 'f') i += c - 'a' + 10; else i += c - 'A' + 10; } else { UNREAD (c); break; } } return i; } default: return c; } } /* If the next token is ')' or ']' or '.', we store that character in *PCH and the return value is not interesting. Else, we store zero in *PCH and we read and return one lisp object. FIRST_IN_LIST is nonzero if this is the first element of a list. */ static Lisp_Object read1 (readcharfun, pch, first_in_list) register Lisp_Object readcharfun; char *pch; int first_in_list; { register int c; *pch = 0; retry: c = READCHAR; if (c < 0) return Fsignal (Qend_of_file, Qnil); switch (c) { case '(': return read_list (0, readcharfun); case '[': return read_vector (readcharfun); case ')': case ']': { *pch = c; return Qnil; } case '#': c = READCHAR; if (c == '^') { c = READCHAR; if (c == '[') { Lisp_Object tmp; tmp = read_vector (readcharfun); if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS || XVECTOR (tmp)->size > CHAR_TABLE_STANDARD_SLOTS + 10) error ("Invalid size char-table"); XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp)); return tmp; } Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#^", 2), Qnil)); } if (c == '&') { Lisp_Object length; length = read1 (readcharfun, pch, first_in_list); c = READCHAR; if (c == '"') { Lisp_Object tmp, val; int size_in_chars = ((XFASTINT (length) + BITS_PER_CHAR) / BITS_PER_CHAR); UNREAD (c); tmp = read1 (readcharfun, pch, first_in_list); if (size_in_chars != XSTRING (tmp)->size) Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&", 2), Qnil)); val = Fmake_bool_vector (length, Qnil); bcopy (XSTRING (tmp)->data, XBOOL_VECTOR (val)->data, size_in_chars); return val; } Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&", 2), Qnil)); } if (c == '[') { /* Accept compiled functions at read-time so that we don't have to build them using function calls. */ Lisp_Object tmp; tmp = read_vector (readcharfun); return Fmake_byte_code (XVECTOR (tmp)->size, XVECTOR (tmp)->contents); } #ifdef USE_TEXT_PROPERTIES if (c == '(') { Lisp_Object tmp; struct gcpro gcpro1; char ch; /* Read the string itself. */ tmp = read1 (readcharfun, &ch, 0); if (ch != 0 || !STRINGP (tmp)) Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil)); GCPRO1 (tmp); /* Read the intervals and their properties. */ while (1) { Lisp_Object beg, end, plist; beg = read1 (readcharfun, &ch, 0); if (ch == ')') break; if (ch == 0) end = read1 (readcharfun, &ch, 0); if (ch == 0) plist = read1 (readcharfun, &ch, 0); if (ch) Fsignal (Qinvalid_read_syntax, Fcons (build_string ("invalid string property list"), Qnil)); Fset_text_properties (beg, end, plist, tmp); } UNGCPRO; return tmp; } #endif /* #@NUMBER is used to skip NUMBER following characters. That's used in .elc files to skip over doc strings and function definitions. */ if (c == '@') { int i, nskip = 0; /* Read a decimal integer. */ while ((c = READCHAR) >= 0 && c >= '0' && c <= '9') { nskip *= 10; nskip += c - '0'; } if (c >= 0) UNREAD (c); #ifndef DOS_NT /* I don't know if filepos works right on MSDOS and Windoze. */ if (load_force_doc_strings && EQ (readcharfun, Qget_file_char)) { /* If we are supposed to force doc strings into core right now, record the last string that we skipped, and record where in the file it comes from. */ if (saved_doc_string_size == 0) { saved_doc_string_size = nskip + 100; saved_doc_string = (char *) malloc (saved_doc_string_size); } if (nskip > saved_doc_string_size) { saved_doc_string_size = nskip + 100; saved_doc_string = (char *) realloc (saved_doc_string, saved_doc_string_size); } saved_doc_string_position = ftell (instream); /* Copy that many characters into saved_doc_string. */ for (i = 0; i < nskip && c >= 0; i++) saved_doc_string[i] = c = READCHAR; saved_doc_string_length = i; } else #endif /* not DOS_NT */ { /* Skip that many characters. */ for (i = 0; i < nskip && c >= 0; i++) c = READCHAR; } goto retry; } if (c == '$') return Vload_file_name; if (c == '\'') return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil)); UNREAD (c); Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil)); case ';': while ((c = READCHAR) >= 0 && c != '\n'); goto retry; case '\'': { return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil)); } case '`': if (first_in_list) goto default_label; else { Lisp_Object value; new_backquote_flag = 1; value = read0 (readcharfun); new_backquote_flag = 0; return Fcons (Qbackquote, Fcons (value, Qnil)); } case ',': if (new_backquote_flag) { Lisp_Object comma_type = Qnil; Lisp_Object value; int ch = READCHAR; if (ch == '@') comma_type = Qcomma_at; else if (ch == '.') comma_type = Qcomma_dot; else { if (ch >= 0) UNREAD (ch); comma_type = Qcomma; } new_backquote_flag = 0; value = read0 (readcharfun); new_backquote_flag = 1; return Fcons (comma_type, Fcons (value, Qnil)); } else goto default_label; case '?': { register Lisp_Object val; c = READCHAR; if (c < 0) return Fsignal (Qend_of_file, Qnil); if (c == '\\') XSETINT (val, read_escape (readcharfun)); else XSETINT (val, c); return val; } case '\"': { register char *p = read_buffer; register char *end = read_buffer + read_buffer_size; register int c; int cancel = 0; while ((c = READCHAR) >= 0 && c != '\"') { if (p == end) { char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2); p += new - read_buffer; read_buffer += new - read_buffer; end = read_buffer + read_buffer_size; } if (c == '\\') c = read_escape (readcharfun); /* c is -1 if \ newline has just been seen */ if (c == -1) { if (p == read_buffer) cancel = 1; } else { /* Allow `\C- ' and `\C-?'. */ if (c == (CHAR_CTL | ' ')) c = 0; else if (c == (CHAR_CTL | '?')) c = 127; if (c & CHAR_META) /* Move the meta bit to the right place for a string. */ c = (c & ~CHAR_META) | 0x80; if (c & ~0xff) error ("Invalid modifier in string"); *p++ = c; } } if (c < 0) return Fsignal (Qend_of_file, Qnil); /* If purifying, and string starts with \ newline, return zero instead. This is for doc strings that we are really going to find in etc/DOC.nn.nn */ if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel) return make_number (0); if (read_pure) return make_pure_string (read_buffer, p - read_buffer); else return make_string (read_buffer, p - read_buffer); } case '.': { #ifdef LISP_FLOAT_TYPE /* If a period is followed by a number, then we should read it as a floating point number. Otherwise, it denotes a dotted pair. */ int next_char = READCHAR; UNREAD (next_char); if (! (next_char >= '0' && next_char <= '9')) #endif { *pch = c; return Qnil; } /* Otherwise, we fall through! Note that the atom-reading loop below will now loop at least once, assuring that we will not try to UNREAD two characters in a row. */ } default: default_label: if (c <= 040) goto retry; { register char *p = read_buffer; int quoted = 0; { register char *end = read_buffer + read_buffer_size; while (c > 040 && !(c == '\"' || c == '\'' || c == ';' || c == '?' || c == '(' || c == ')' #ifndef LISP_FLOAT_TYPE /* If we have floating-point support, then we need to allow . */ || c =='.' #endif /* not LISP_FLOAT_TYPE */ || c == '[' || c == ']' || c == '#' )) { if (p == end) { register char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2); p += new - read_buffer; read_buffer += new - read_buffer; end = read_buffer + read_buffer_size; } if (c == '\\') { c = READCHAR; quoted = 1; } *p++ = c; c = READCHAR; } if (p == end) { char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2); p += new - read_buffer; read_buffer += new - read_buffer; /* end = read_buffer + read_buffer_size; */ } *p = 0; if (c >= 0) UNREAD (c); } if (!quoted) { register char *p1; register Lisp_Object val; p1 = read_buffer; if (*p1 == '+' || *p1 == '-') p1++; /* Is it an integer? */ if (p1 != p) { while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++; #ifdef LISP_FLOAT_TYPE /* Integers can have trailing decimal points. */ if (p1 > read_buffer && p1 < p && *p1 == '.') p1++; #endif if (p1 == p) /* It is an integer. */ { #ifdef LISP_FLOAT_TYPE if (p1[-1] == '.') p1[-1] = '\0'; #endif if (sizeof (int) == sizeof (EMACS_INT)) XSETINT (val, atoi (read_buffer)); else if (sizeof (long) == sizeof (EMACS_INT)) XSETINT (val, atol (read_buffer)); else abort (); return val; } } #ifdef LISP_FLOAT_TYPE if (isfloat_string (read_buffer)) return make_float (atof (read_buffer)); #endif } return intern (read_buffer); } } } #ifdef LISP_FLOAT_TYPE #define LEAD_INT 1 #define DOT_CHAR 2 #define TRAIL_INT 4 #define E_CHAR 8 #define EXP_INT 16 int isfloat_string (cp) register char *cp; { register state; state = 0; if (*cp == '+' || *cp == '-') cp++; if (*cp >= '0' && *cp <= '9') { state |= LEAD_INT; while (*cp >= '0' && *cp <= '9') cp++; } if (*cp == '.') { state |= DOT_CHAR; cp++; } if (*cp >= '0' && *cp <= '9') { state |= TRAIL_INT; while (*cp >= '0' && *cp <= '9') cp++; } if (*cp == 'e') { state |= E_CHAR; cp++; if (*cp == '+' || *cp == '-') cp++; } if (*cp >= '0' && *cp <= '9') { state |= EXP_INT; while (*cp >= '0' && *cp <= '9') cp++; } return (((*cp == 0) || (*cp == ' ') || (*cp == '\t') || (*cp == '\n') || (*cp == '\r') || (*cp == '\f')) && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT) || state == (DOT_CHAR|TRAIL_INT) || state == (LEAD_INT|E_CHAR|EXP_INT) || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT) || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT))); } #endif /* LISP_FLOAT_TYPE */ static Lisp_Object read_vector (readcharfun) Lisp_Object readcharfun; { register int i; register int size; register Lisp_Object *ptr; register Lisp_Object tem, vector; register struct Lisp_Cons *otem; Lisp_Object len; tem = read_list (1, readcharfun); len = Flength (tem); vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil)); size = XVECTOR (vector)->size; ptr = XVECTOR (vector)->contents; for (i = 0; i < size; i++) { ptr[i] = read_pure ? Fpurecopy (Fcar (tem)) : Fcar (tem); otem = XCONS (tem); tem = Fcdr (tem); free_cons (otem); } return vector; } /* flag = 1 means check for ] to terminate rather than ) and . flag = -1 means check for starting with defun and make structure pure. */ static Lisp_Object read_list (flag, readcharfun) int flag; register Lisp_Object readcharfun; { /* -1 means check next element for defun, 0 means don't check, 1 means already checked and found defun. */ int defunflag = flag < 0 ? -1 : 0; Lisp_Object val, tail; register Lisp_Object elt, tem; struct gcpro gcpro1, gcpro2; /* 0 is the normal case. 1 means this list is a doc reference; replace it with the number 0. 2 means this list is a doc reference; replace it with the doc string. */ int doc_reference = 0; /* Initialize this to 1 if we are reading a list. */ int first_in_list = flag <= 0; val = Qnil; tail = Qnil; while (1) { char ch; GCPRO2 (val, tail); elt = read1 (readcharfun, &ch, first_in_list); UNGCPRO; first_in_list = 0; /* While building, if the list starts with #$, treat it specially. */ if (EQ (elt, Vload_file_name) && !NILP (Vpurify_flag)) { if (NILP (Vdoc_file_name)) /* We have not yet called Snarf-documentation, so assume this file is described in the DOC-MM.NN file and Snarf-documentation will fill in the right value later. For now, replace the whole list with 0. */ doc_reference = 1; else /* We have already called Snarf-documentation, so make a relative file name for this file, so it can be found properly in the installed Lisp directory. We don't use Fexpand_file_name because that would make the directory absolute now. */ elt = concat2 (build_string ("../lisp/"), Ffile_name_nondirectory (elt)); } else if (EQ (elt, Vload_file_name) && load_force_doc_strings) doc_reference = 2; if (ch) { if (flag > 0) { if (ch == ']') return val; Fsignal (Qinvalid_read_syntax, Fcons (make_string (") or . in a vector", 18), Qnil)); } if (ch == ')') return val; if (ch == '.') { GCPRO2 (val, tail); if (!NILP (tail)) XCONS (tail)->cdr = read0 (readcharfun); else val = read0 (readcharfun); read1 (readcharfun, &ch, 0); UNGCPRO; if (ch == ')') { if (doc_reference == 1) return make_number (0); if (doc_reference == 2) { /* Get a doc string from the file we are loading. If it's in saved_doc_string, get it from there. */ int pos = XINT (XCONS (val)->cdr); if (pos >= saved_doc_string_position && pos < (saved_doc_string_position + saved_doc_string_length)) { int start = pos - saved_doc_string_position; int from, to; /* Process quoting with ^A, and find the end of the string, which is marked with ^_ (037). */ for (from = start, to = start; saved_doc_string[from] != 037;) { int c = saved_doc_string[from++]; if (c == 1) { c = saved_doc_string[from++]; if (c == 1) saved_doc_string[to++] = c; else if (c == '0') saved_doc_string[to++] = 0; else if (c == '_') saved_doc_string[to++] = 037; } else saved_doc_string[to++] = c; } return make_string (saved_doc_string + start, to - start); } else return read_doc_string (val); } return val; } return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil)); } return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil)); } tem = (read_pure && flag <= 0 ? pure_cons (elt, Qnil) : Fcons (elt, Qnil)); if (!NILP (tail)) XCONS (tail)->cdr = tem; else val = tem; tail = tem; if (defunflag < 0) defunflag = EQ (elt, Qdefun); else if (defunflag > 0) read_pure = 1; } } Lisp_Object Vobarray; Lisp_Object initial_obarray; /* oblookup stores the bucket number here, for the sake of Funintern. */ int oblookup_last_bucket_number; static int hash_string (); Lisp_Object oblookup (); /* Get an error if OBARRAY is not an obarray. If it is one, return it. */ Lisp_Object check_obarray (obarray) Lisp_Object obarray; { while (!VECTORP (obarray) || XVECTOR (obarray)->size == 0) { /* If Vobarray is now invalid, force it to be valid. */ if (EQ (Vobarray, obarray)) Vobarray = initial_obarray; obarray = wrong_type_argument (Qvectorp, obarray); } return obarray; } /* Intern the C string STR: return a symbol with that name, interned in the current obarray. */ Lisp_Object intern (str) char *str; { Lisp_Object tem; int len = strlen (str); Lisp_Object obarray; obarray = Vobarray; if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0) obarray = check_obarray (obarray); tem = oblookup (obarray, str, len); if (SYMBOLP (tem)) return tem; return Fintern ((!NILP (Vpurify_flag) ? make_pure_string (str, len) : make_string (str, len)), obarray); } DEFUN ("intern", Fintern, Sintern, 1, 2, 0, "Return the canonical symbol whose name is STRING.\n\ If there is none, one is created by this function and returned.\n\ A second optional argument specifies the obarray to use;\n\ it defaults to the value of `obarray'.") (str, obarray) Lisp_Object str, obarray; { register Lisp_Object tem, sym, *ptr; if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); CHECK_STRING (str, 0); tem = oblookup (obarray, XSTRING (str)->data, XSTRING (str)->size); if (!INTEGERP (tem)) return tem; if (!NILP (Vpurify_flag)) str = Fpurecopy (str); sym = Fmake_symbol (str); ptr = &XVECTOR (obarray)->contents[XINT (tem)]; if (SYMBOLP (*ptr)) XSYMBOL (sym)->next = XSYMBOL (*ptr); else XSYMBOL (sym)->next = 0; *ptr = sym; return sym; } DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0, "Return the canonical symbol whose name is STRING, or nil if none exists.\n\ A second optional argument specifies the obarray to use;\n\ it defaults to the value of `obarray'.") (str, obarray) Lisp_Object str, obarray; { register Lisp_Object tem; if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); CHECK_STRING (str, 0); tem = oblookup (obarray, XSTRING (str)->data, XSTRING (str)->size); if (!INTEGERP (tem)) return tem; return Qnil; } DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0, "Delete the symbol named NAME, if any, from OBARRAY.\n\ The value is t if a symbol was found and deleted, nil otherwise.\n\ NAME may be a string or a symbol. If it is a symbol, that symbol\n\ is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\ OBARRAY defaults to the value of the variable `obarray'.") (name, obarray) Lisp_Object name, obarray; { register Lisp_Object string, tem; int hash; if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); if (SYMBOLP (name)) XSETSTRING (string, XSYMBOL (name)->name); else { CHECK_STRING (name, 0); string = name; } tem = oblookup (obarray, XSTRING (string)->data, XSTRING (string)->size); if (INTEGERP (tem)) return Qnil; /* If arg was a symbol, don't delete anything but that symbol itself. */ if (SYMBOLP (name) && !EQ (name, tem)) return Qnil; hash = oblookup_last_bucket_number; if (EQ (XVECTOR (obarray)->contents[hash], tem)) { if (XSYMBOL (tem)->next) XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next); else XSETINT (XVECTOR (obarray)->contents[hash], 0); } else { Lisp_Object tail, following; for (tail = XVECTOR (obarray)->contents[hash]; XSYMBOL (tail)->next; tail = following) { XSETSYMBOL (following, XSYMBOL (tail)->next); if (EQ (following, tem)) { XSYMBOL (tail)->next = XSYMBOL (following)->next; break; } } } return Qt; } /* Return the symbol in OBARRAY whose names matches the string of SIZE characters at PTR. If there is no such symbol in OBARRAY, return nil. Also store the bucket number in oblookup_last_bucket_number. */ Lisp_Object oblookup (obarray, ptr, size) Lisp_Object obarray; register char *ptr; register int size; { int hash; int obsize; register Lisp_Object tail; Lisp_Object bucket, tem; if (!VECTORP (obarray) || (obsize = XVECTOR (obarray)->size) == 0) { obarray = check_obarray (obarray); obsize = XVECTOR (obarray)->size; } /* This is sometimes needed in the middle of GC. */ obsize &= ~ARRAY_MARK_FLAG; /* Combining next two lines breaks VMS C 2.3. */ hash = hash_string (ptr, size); hash %= obsize; bucket = XVECTOR (obarray)->contents[hash]; oblookup_last_bucket_number = hash; if (XFASTINT (bucket) == 0) ; else if (!SYMBOLP (bucket)) error ("Bad data in guts of obarray"); /* Like CADR error message */ else for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next)) { if (XSYMBOL (tail)->name->size == size && !bcmp (XSYMBOL (tail)->name->data, ptr, size)) return tail; else if (XSYMBOL (tail)->next == 0) break; } XSETINT (tem, hash); return tem; } static int hash_string (ptr, len) unsigned char *ptr; int len; { register unsigned char *p = ptr; register unsigned char *end = p + len; register unsigned char c; register int hash = 0; while (p != end) { c = *p++; if (c >= 0140) c -= 40; hash = ((hash<<3) + (hash>>28) + c); } return hash & 07777777777; } void map_obarray (obarray, fn, arg) Lisp_Object obarray; int (*fn) (); Lisp_Object arg; { register int i; register Lisp_Object tail; CHECK_VECTOR (obarray, 1); for (i = XVECTOR (obarray)->size - 1; i >= 0; i--) { tail = XVECTOR (obarray)->contents[i]; if (XFASTINT (tail) != 0) while (1) { (*fn) (tail, arg); if (XSYMBOL (tail)->next == 0) break; XSETSYMBOL (tail, XSYMBOL (tail)->next); } } } mapatoms_1 (sym, function) Lisp_Object sym, function; { call1 (function, sym); } DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0, "Call FUNCTION on every symbol in OBARRAY.\n\ OBARRAY defaults to the value of `obarray'.") (function, obarray) Lisp_Object function, obarray; { Lisp_Object tem; if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); map_obarray (obarray, mapatoms_1, function); return Qnil; } #define OBARRAY_SIZE 1511 void init_obarray () { Lisp_Object oblength; int hash; Lisp_Object *tem; XSETFASTINT (oblength, OBARRAY_SIZE); Qnil = Fmake_symbol (make_pure_string ("nil", 3)); Vobarray = Fmake_vector (oblength, make_number (0)); initial_obarray = Vobarray; staticpro (&initial_obarray); /* Intern nil in the obarray */ /* These locals are to kludge around a pyramid compiler bug. */ hash = hash_string ("nil", 3); /* Separate statement here to avoid VAXC bug. */ hash %= OBARRAY_SIZE; tem = &XVECTOR (Vobarray)->contents[hash]; *tem = Qnil; Qunbound = Fmake_symbol (make_pure_string ("unbound", 7)); XSYMBOL (Qnil)->function = Qunbound; XSYMBOL (Qunbound)->value = Qunbound; XSYMBOL (Qunbound)->function = Qunbound; Qt = intern ("t"); XSYMBOL (Qnil)->value = Qnil; XSYMBOL (Qnil)->plist = Qnil; XSYMBOL (Qt)->value = Qt; /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ Vpurify_flag = Qt; Qvariable_documentation = intern ("variable-documentation"); read_buffer_size = 100; read_buffer = (char *) malloc (read_buffer_size); } void defsubr (sname) struct Lisp_Subr *sname; { Lisp_Object sym; sym = intern (sname->symbol_name); XSETSUBR (XSYMBOL (sym)->function, sname); } #ifdef NOTDEF /* use fset in subr.el now */ void defalias (sname, string) struct Lisp_Subr *sname; char *string; { Lisp_Object sym; sym = intern (string); XSETSUBR (XSYMBOL (sym)->function, sname); } #endif /* NOTDEF */ /* Define an "integer variable"; a symbol whose value is forwarded to a C variable of type int. Sample call: */ /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */ void defvar_int (namestring, address) char *namestring; int *address; { Lisp_Object sym, val; sym = intern (namestring); val = allocate_misc (); XMISCTYPE (val) = Lisp_Misc_Intfwd; XINTFWD (val)->intvar = address; XSYMBOL (sym)->value = val; } /* Similar but define a variable whose value is T if address contains 1, NIL if address contains 0 */ void defvar_bool (namestring, address) char *namestring; int *address; { Lisp_Object sym, val; sym = intern (namestring); val = allocate_misc (); XMISCTYPE (val) = Lisp_Misc_Boolfwd; XBOOLFWD (val)->boolvar = address; XSYMBOL (sym)->value = val; } /* Similar but define a variable whose value is the Lisp Object stored at address. Two versions: with and without gc-marking of the C variable. The nopro version is used when that variable will be gc-marked for some other reason, since marking the same slot twice can cause trouble with strings. */ void defvar_lisp_nopro (namestring, address) char *namestring; Lisp_Object *address; { Lisp_Object sym, val; sym = intern (namestring); val = allocate_misc (); XMISCTYPE (val) = Lisp_Misc_Objfwd; XOBJFWD (val)->objvar = address; XSYMBOL (sym)->value = val; } void defvar_lisp (namestring, address) char *namestring; Lisp_Object *address; { defvar_lisp_nopro (namestring, address); staticpro (address); } #ifndef standalone /* Similar but define a variable whose value is the Lisp Object stored in the current buffer. address is the address of the slot in the buffer that is current now. */ void defvar_per_buffer (namestring, address, type, doc) char *namestring; Lisp_Object *address; Lisp_Object type; char *doc; { Lisp_Object sym, val; int offset; extern struct buffer buffer_local_symbols; sym = intern (namestring); val = allocate_misc (); offset = (char *)address - (char *)current_buffer; XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd; XBUFFER_OBJFWD (val)->offset = offset; XSYMBOL (sym)->value = val; *(Lisp_Object *)(offset + (char *)&buffer_local_symbols) = sym; *(Lisp_Object *)(offset + (char *)&buffer_local_types) = type; if (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags)) == 0) /* Did a DEFVAR_PER_BUFFER without initializing the corresponding slot of buffer_local_flags */ abort (); } #endif /* standalone */ /* Similar but define a variable whose value is the Lisp Object stored at a particular offset in the current kboard object. */ void defvar_kboard (namestring, offset) char *namestring; int offset; { Lisp_Object sym, val; sym = intern (namestring); val = allocate_misc (); XMISCTYPE (val) = Lisp_Misc_Kboard_Objfwd; XKBOARD_OBJFWD (val)->offset = offset; XSYMBOL (sym)->value = val; } init_lread () { char *normal; int turn_off_warning = 0; /* Compute the default load-path. */ #ifdef CANNOT_DUMP normal = PATH_LOADSEARCH; Vload_path = decode_env_path (0, normal); #else if (NILP (Vpurify_flag)) normal = PATH_LOADSEARCH; else normal = PATH_DUMPLOADSEARCH; /* In a dumped Emacs, we normally have to reset the value of Vload_path from PATH_LOADSEARCH, since the value that was dumped uses ../lisp, instead of the path of the installed elisp libraries. However, if it appears that Vload_path was changed from the default before dumping, don't override that value. */ if (initialized) { Lisp_Object dump_path; dump_path = decode_env_path (0, PATH_DUMPLOADSEARCH); Vsource_directory = Fexpand_file_name (build_string ("../"), Fcar (dump_path)); if (! NILP (Fequal (dump_path, Vload_path))) { Vload_path = decode_env_path (0, normal); if (!NILP (Vinstallation_directory)) { /* Add to the path the lisp subdir of the installation dir, if it exists. */ Lisp_Object tem, tem1; tem = Fexpand_file_name (build_string ("lisp"), Vinstallation_directory); tem1 = Ffile_exists_p (tem); if (!NILP (tem1)) { if (NILP (Fmember (tem, Vload_path))) { turn_off_warning = 1; Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil)); } } else /* That dir doesn't exist, so add the build-time Lisp dirs instead. */ Vload_path = nconc2 (Vload_path, dump_path); /* Add site-list under the installation dir, if it exists. */ tem = Fexpand_file_name (build_string ("site-lisp"), Vinstallation_directory); tem1 = Ffile_exists_p (tem); if (!NILP (tem1)) { if (NILP (Fmember (tem, Vload_path))) Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil)); } } } } else Vload_path = decode_env_path (0, normal); #endif #ifndef WINDOWSNT /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is almost never correct, thereby causing a warning to be printed out that confuses users. Since PATH_LOADSEARCH is always overriden by the EMACSLOADPATH environment variable below, disable the warning on NT. */ /* Warn if dirs in the *standard* path don't exist. */ if (!turn_off_warning) { Lisp_Object path_tail; for (path_tail = Vload_path; !NILP (path_tail); path_tail = XCONS (path_tail)->cdr) { Lisp_Object dirfile; dirfile = Fcar (path_tail); if (STRINGP (dirfile)) { dirfile = Fdirectory_file_name (dirfile); if (access (XSTRING (dirfile)->data, 0) < 0) fprintf (stderr, "Warning: Lisp directory `%s' does not exist.\n", XSTRING (Fcar (path_tail))->data); } } } #endif /* WINDOWSNT */ /* If the EMACSLOADPATH environment variable is set, use its value. This doesn't apply if we're dumping. */ #ifndef CANNOT_DUMP if (NILP (Vpurify_flag) && egetenv ("EMACSLOADPATH")) #endif Vload_path = decode_env_path ("EMACSLOADPATH", normal); Vvalues = Qnil; load_in_progress = 0; load_descriptor_list = Qnil; } void syms_of_lread () { defsubr (&Sread); defsubr (&Sread_from_string); defsubr (&Sintern); defsubr (&Sintern_soft); defsubr (&Sunintern); defsubr (&Sload); defsubr (&Seval_buffer); defsubr (&Seval_region); defsubr (&Sread_char); defsubr (&Sread_char_exclusive); defsubr (&Sread_event); defsubr (&Sget_file_char); defsubr (&Smapatoms); DEFVAR_LISP ("obarray", &Vobarray, "Symbol table for use by `intern' and `read'.\n\ It is a vector whose length ought to be prime for best results.\n\ The vector's contents don't make sense if examined from Lisp programs;\n\ to find all the symbols in an obarray, use `mapatoms'."); DEFVAR_LISP ("values", &Vvalues, "List of values of all expressions which were read, evaluated and printed.\n\ Order is reverse chronological."); DEFVAR_LISP ("standard-input", &Vstandard_input, "Stream for read to get input from.\n\ See documentation of `read' for possible values."); Vstandard_input = Qt; DEFVAR_LISP ("load-path", &Vload_path, "*List of directories to search for files to load.\n\ Each element is a string (directory name) or nil (try default directory).\n\ Initialized based on EMACSLOADPATH environment variable, if any,\n\ otherwise to default specified by file `paths.h' when Emacs was built."); DEFVAR_BOOL ("load-in-progress", &load_in_progress, "Non-nil iff inside of `load'."); DEFVAR_LISP ("after-load-alist", &Vafter_load_alist, "An alist of expressions to be evalled when particular files are loaded.\n\ Each element looks like (FILENAME FORMS...).\n\ When `load' is run and the file-name argument is FILENAME,\n\ the FORMS in the corresponding element are executed at the end of loading.\n\n\ FILENAME must match exactly! Normally FILENAME is the name of a library,\n\ with no directory specified, since that is how `load' is normally called.\n\ An error in FORMS does not undo the load,\n\ but does prevent execution of the rest of the FORMS."); Vafter_load_alist = Qnil; DEFVAR_LISP ("load-history", &Vload_history, "Alist mapping source file names to symbols and features.\n\ Each alist element is a list that starts with a file name,\n\ except for one element (optional) that starts with nil and describes\n\ definitions evaluated from buffers not visiting files.\n\ The remaining elements of each list are symbols defined as functions\n\ or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'."); Vload_history = Qnil; DEFVAR_LISP ("load-file-name", &Vload_file_name, "Full name of file being loaded by `load'."); Vload_file_name = Qnil; DEFVAR_LISP ("current-load-list", &Vcurrent_load_list, "Used for internal purposes by `load'."); Vcurrent_load_list = Qnil; DEFVAR_LISP ("load-read-function", &Vload_read_function, "Function used by `load' and `eval-region' for reading expressions.\n\ The default is nil, which means use the function `read'."); Vload_read_function = Qnil; DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings, "Non-nil means `load' should force-load all dynamic doc strings.\n\ This is useful when the file being loaded is a temporary copy."); load_force_doc_strings = 0; DEFVAR_LISP ("source-directory", &Vsource_directory, "Directory in which Emacs sources were found when Emacs was built.\n\ You cannot count on them to still be there!"); Vsource_directory = Qnil; load_descriptor_list = Qnil; staticpro (&load_descriptor_list); Qcurrent_load_list = intern ("current-load-list"); staticpro (&Qcurrent_load_list); Qstandard_input = intern ("standard-input"); staticpro (&Qstandard_input); Qread_char = intern ("read-char"); staticpro (&Qread_char); Qget_file_char = intern ("get-file-char"); staticpro (&Qget_file_char); Qbackquote = intern ("`"); staticpro (&Qbackquote); Qcomma = intern (","); staticpro (&Qcomma); Qcomma_at = intern (",@"); staticpro (&Qcomma_at); Qcomma_dot = intern (",."); staticpro (&Qcomma_dot); Qascii_character = intern ("ascii-character"); staticpro (&Qascii_character); Qfunction = intern ("function"); staticpro (&Qfunction); Qload = intern ("load"); staticpro (&Qload); Qload_file_name = intern ("load-file-name"); staticpro (&Qload_file_name); } emacs-19.30/src/macros.c100444 12120 1 17725 6012504125 13346 0ustar rmsdaemon/* Keyboard macros. Copyright (C) 1985, 1986, 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. */ #include #include "lisp.h" #include "macros.h" #include "commands.h" #include "buffer.h" #include "window.h" #include "keyboard.h" Lisp_Object Qexecute_kbd_macro; Lisp_Object Vexecuting_macro; int executing_macro_index; Lisp_Object Fexecute_kbd_macro (); DEFUN ("start-kbd-macro", Fstart_kbd_macro, Sstart_kbd_macro, 1, 1, "P", "Record subsequent keyboard input, defining a keyboard macro.\n\ The commands are recorded even as they are executed.\n\ Use \\[end-kbd-macro] to finish recording and make the macro available.\n\ Use \\[name-last-kbd-macro] to give it a permanent name.\n\ Non-nil arg (prefix arg) means append to last macro defined;\n\ This begins by re-executing that macro as if you typed it again.") (append) Lisp_Object append; { if (!NILP (current_kboard->defining_kbd_macro)) error ("Already defining kbd macro"); if (!current_kboard->kbd_macro_buffer) { current_kboard->kbd_macro_bufsize = 30; current_kboard->kbd_macro_buffer = (Lisp_Object *)malloc (30 * sizeof (Lisp_Object)); } update_mode_lines++; if (NILP (append)) { current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_buffer; current_kboard->kbd_macro_end = current_kboard->kbd_macro_buffer; message("Defining kbd macro..."); } else { message("Appending to kbd macro..."); current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_end; Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, make_number (1)); } current_kboard->defining_kbd_macro = Qt; return Qnil; } DEFUN ("end-kbd-macro", Fend_kbd_macro, Send_kbd_macro, 0, 1, "p", "Finish defining a keyboard macro.\n\ The definition was started by \\[start-kbd-macro].\n\ The macro is now available for use via \\[call-last-kbd-macro],\n\ or it can be given a name with \\[name-last-kbd-macro] and then invoked\n\ under that name.\n\ \n\ With numeric arg, repeat macro now that many times,\n\ counting the definition just completed as the first repetition.\n\ An argument of zero means repeat until error.") (arg) Lisp_Object arg; { if (NILP (current_kboard->defining_kbd_macro)) error ("Not defining kbd macro."); if (NILP (arg)) XSETFASTINT (arg, 1); else CHECK_NUMBER (arg, 0); if (!NILP (current_kboard->defining_kbd_macro)) { current_kboard->defining_kbd_macro = Qnil; update_mode_lines++; current_kboard->Vlast_kbd_macro = make_event_array ((current_kboard->kbd_macro_end - current_kboard->kbd_macro_buffer), current_kboard->kbd_macro_buffer); message("Keyboard macro defined"); } if (XFASTINT (arg) == 0) Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, arg); else { XSETINT (arg, XINT (arg)-1); if (XINT (arg) > 0) Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, arg); } return Qnil; } /* Store character c into kbd macro being defined */ store_kbd_macro_char (c) Lisp_Object c; { if (!NILP (current_kboard->defining_kbd_macro)) { if ((current_kboard->kbd_macro_ptr - current_kboard->kbd_macro_buffer) == current_kboard->kbd_macro_bufsize) { register Lisp_Object *new; current_kboard->kbd_macro_bufsize *= 2; new = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer, (current_kboard->kbd_macro_bufsize * sizeof (Lisp_Object))); current_kboard->kbd_macro_ptr += new - current_kboard->kbd_macro_buffer; current_kboard->kbd_macro_end += new - current_kboard->kbd_macro_buffer; current_kboard->kbd_macro_buffer = new; } *current_kboard->kbd_macro_ptr++ = c; } } /* Declare that all chars stored so far in the kbd macro being defined really belong to it. This is done in between editor commands. */ finalize_kbd_macro_chars () { current_kboard->kbd_macro_end = current_kboard->kbd_macro_ptr; } DEFUN ("cancel-kbd-macro-events", Fcancel_kbd_macro_events, Scancel_kbd_macro_events, 0, 0, 0, "Cancel the events added to a keyboard macro for this command.") () { current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_end; } DEFUN ("call-last-kbd-macro", Fcall_last_kbd_macro, Scall_last_kbd_macro, 0, 1, "p", "Call the last keyboard macro that you defined with \\[start-kbd-macro].\n\ \n\ A prefix argument serves as a repeat count. Zero means repeat until error.\n\ \n\ To make a macro permanent so you can call it even after\n\ defining others, use \\[name-last-kbd-macro].") (prefix) Lisp_Object prefix; { if (! NILP (current_kboard->defining_kbd_macro)) error ("Can't execute anonymous macro while defining one"); else if (NILP (current_kboard->Vlast_kbd_macro)) error ("No kbd macro has been defined"); else Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, prefix); return Qnil; } /* Restore Vexecuting_macro and executing_macro_index - called when the unwind-protect in Fexecute_kbd_macro gets invoked. */ static Lisp_Object pop_kbd_macro (info) Lisp_Object info; { Lisp_Object tem; Vexecuting_macro = Fcar (info); tem = Fcdr (info); executing_macro_index = XINT (tem); return Qnil; } DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 2, 0, "Execute MACRO as string of editor command characters.\n\ If MACRO is a symbol, its function definition is used.\n\ COUNT is a repeat count, or nil for once, or 0 for infinite loop.") (macro, prefixarg) Lisp_Object macro, prefixarg; { Lisp_Object final; Lisp_Object tem; int count = specpdl_ptr - specpdl; int repeat = 1; struct gcpro gcpro1; if (!NILP (prefixarg)) prefixarg = Fprefix_numeric_value (prefixarg), repeat = XINT (prefixarg); final = indirect_function (macro); if (!STRINGP (final) && !VECTORP (final)) error ("Keyboard macros must be strings or vectors."); XSETFASTINT (tem, executing_macro_index); tem = Fcons (Vexecuting_macro, tem); record_unwind_protect (pop_kbd_macro, tem); GCPRO1 (final); do { Vexecuting_macro = final; executing_macro_index = 0; current_kboard->Vprefix_arg = Qnil; command_loop_1 (); QUIT; } while (--repeat && (STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro))); UNGCPRO; return unbind_to (count, Qnil); } init_macros () { Vexecuting_macro = Qnil; } syms_of_macros () { Qexecute_kbd_macro = intern ("execute-kbd-macro"); staticpro (&Qexecute_kbd_macro); defsubr (&Sstart_kbd_macro); defsubr (&Send_kbd_macro); defsubr (&Scall_last_kbd_macro); defsubr (&Sexecute_kbd_macro); defsubr (&Scancel_kbd_macro_events); DEFVAR_KBOARD ("defining-kbd-macro", defining_kbd_macro, "Non-nil while a keyboard macro is being defined. Don't set this!"); DEFVAR_LISP ("executing-macro", &Vexecuting_macro, "Currently executing keyboard macro (string or vector); nil if none executing."); DEFVAR_LISP_NOPRO ("executing-kbd-macro", &Vexecuting_macro, "Currently executing keyboard macro (string or vector); nil if none executing."); DEFVAR_KBOARD ("last-kbd-macro", Vlast_kbd_macro, "Last kbd macro defined, as a string or vector; nil if none defined."); } keys_of_macros () { initial_define_key (control_x_map, ('e'), "call-last-kbd-macro"); initial_define_key (control_x_map, ('('), "start-kbd-macro"); initial_define_key (control_x_map, (')'), "end-kbd-macro"); } emacs-19.30/src/marker.c100444 12120 1 20055 6044772110 13337 0ustar rmsdaemon/* Markers: examining, setting and killing. Copyright (C) 1985 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. */ #include #include "lisp.h" #include "buffer.h" /* Operations on markers. */ DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0, "Return the buffer that MARKER points into, or nil if none.\n\ Returns nil if MARKER points into a dead buffer.") (marker) register Lisp_Object marker; { register Lisp_Object buf; CHECK_MARKER (marker, 0); if (XMARKER (marker)->buffer) { XSETBUFFER (buf, XMARKER (marker)->buffer); /* Return marker's buffer only if it is not dead. */ if (!NILP (XBUFFER (buf)->name)) return buf; } return Qnil; } DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0, "Return the position MARKER points at, as a character number.") (marker) Lisp_Object marker; { register Lisp_Object pos; register int i; register struct buffer *buf; CHECK_MARKER (marker, 0); if (XMARKER (marker)->buffer) { buf = XMARKER (marker)->buffer; i = XMARKER (marker)->bufpos; if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf)) i -= BUF_GAP_SIZE (buf); else if (i > BUF_GPT (buf)) i = BUF_GPT (buf); if (i < BUF_BEG (buf) || i > BUF_Z (buf)) abort (); XSETFASTINT (pos, i); return pos; } return Qnil; } DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0, "Position MARKER before character number NUMBER in BUFFER.\n\ BUFFER defaults to the current buffer.\n\ If NUMBER is nil, makes marker point nowhere.\n\ Then it no longer slows down editing in any buffer.\n\ Returns MARKER.") (marker, pos, buffer) Lisp_Object marker, pos, buffer; { register int charno; register struct buffer *b; register struct Lisp_Marker *m; CHECK_MARKER (marker, 0); /* If position is nil or a marker that points nowhere, make this marker point nowhere. */ if (NILP (pos) || (MARKERP (pos) && !XMARKER (pos)->buffer)) { unchain_marker (marker); return marker; } CHECK_NUMBER_COERCE_MARKER (pos, 1); if (NILP (buffer)) b = current_buffer; else { CHECK_BUFFER (buffer, 1); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ if (EQ (b->name, Qnil)) { unchain_marker (marker); return marker; } } charno = XINT (pos); m = XMARKER (marker); if (charno < BUF_BEG (b)) charno = BUF_BEG (b); if (charno > BUF_Z (b)) charno = BUF_Z (b); if (charno > BUF_GPT (b)) charno += BUF_GAP_SIZE (b); m->bufpos = charno; if (m->buffer != b) { unchain_marker (marker); m->buffer = b; m->chain = BUF_MARKERS (b); BUF_MARKERS (b) = marker; } return marker; } /* This version of Fset_marker won't let the position be outside the visible part. */ Lisp_Object set_marker_restricted (marker, pos, buffer) Lisp_Object marker, pos, buffer; { register int charno; register struct buffer *b; register struct Lisp_Marker *m; CHECK_MARKER (marker, 0); /* If position is nil or a marker that points nowhere, make this marker point nowhere. */ if (NILP (pos) || (MARKERP (pos) && !XMARKER (pos)->buffer)) { unchain_marker (marker); return marker; } CHECK_NUMBER_COERCE_MARKER (pos, 1); if (NILP (buffer)) b = current_buffer; else { CHECK_BUFFER (buffer, 1); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ if (EQ (b->name, Qnil)) { unchain_marker (marker); return marker; } } charno = XINT (pos); m = XMARKER (marker); if (charno < BUF_BEGV (b)) charno = BUF_BEGV (b); if (charno > BUF_ZV (b)) charno = BUF_ZV (b); if (charno > BUF_GPT (b)) charno += BUF_GAP_SIZE (b); m->bufpos = charno; if (m->buffer != b) { unchain_marker (marker); m->buffer = b; m->chain = BUF_MARKERS (b); BUF_MARKERS (b) = marker; } return marker; } /* This is called during garbage collection, so we must be careful to ignore and preserve mark bits, including those in chain fields of markers. */ unchain_marker (marker) register Lisp_Object marker; { register Lisp_Object tail, prev, next; register EMACS_INT omark; register struct buffer *b; b = XMARKER (marker)->buffer; if (b == 0) return; if (EQ (b->name, Qnil)) abort (); tail = BUF_MARKERS (b); prev = Qnil; while (XSYMBOL (tail) != XSYMBOL (Qnil)) { next = XMARKER (tail)->chain; XUNMARK (next); if (XMARKER (marker) == XMARKER (tail)) { if (NILP (prev)) { BUF_MARKERS (b) = next; /* Deleting first marker from the buffer's chain. Crash if new first marker in chain does not say it belongs to the same buffer, or at least that they have the same base buffer. */ if (!NILP (next) && b->text != XMARKER (next)->buffer->text) abort (); } else { omark = XMARKBIT (XMARKER (prev)->chain); XMARKER (prev)->chain = next; XSETMARKBIT (XMARKER (prev)->chain, omark); } break; } else prev = tail; tail = next; } XMARKER (marker)->buffer = 0; } /* Return the buffer position of marker MARKER, as a C integer. */ int marker_position (marker) Lisp_Object marker; { register struct Lisp_Marker *m = XMARKER (marker); register struct buffer *buf = m->buffer; register int i = m->bufpos; if (!buf) error ("Marker does not point anywhere"); if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf)) i -= BUF_GAP_SIZE (buf); else if (i > BUF_GPT (buf)) i = BUF_GPT (buf); if (i < BUF_BEG (buf) || i > BUF_Z (buf)) abort (); return i; } DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0, "Return a new marker pointing at the same place as MARKER.\n\ If argument is a number, makes a new marker pointing\n\ at that position in the current buffer.\n\ The optional argument TYPE specifies the insertion type of the new marker;\n\ see `marker-insertion-type'.") (marker, type) register Lisp_Object marker, type; { register Lisp_Object new; if (INTEGERP (marker) || MARKERP (marker)) { new = Fmake_marker (); Fset_marker (new, marker, (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil)); XMARKER (new)->insertion_type = !NILP (type); return new; } else marker = wrong_type_argument (Qinteger_or_marker_p, marker); } DEFUN ("marker-insertion-type", Fmarker_insertion_type, Smarker_insertion_type, 1, 1, 0, "Return insertion type of MARKER: t if it stays after inserted text.\n\ nil means the marker stays before text inserted there.") (marker) register Lisp_Object marker; { register Lisp_Object buf; CHECK_MARKER (marker, 0); return XMARKER (marker)->insertion_type ? Qt : Qnil; } DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type, Sset_marker_insertion_type, 2, 2, 0, "Set the insertion-type of MARKER to TYPE.\n\ If TYPE is t, it means the marker advances when you insert text at it.\n\ If TYPE is nil, it means the marker stays behind when you insert text at it.") (marker, type) Lisp_Object marker, type; { CHECK_MARKER (marker, 0); XMARKER (marker)->insertion_type = ! NILP (type); return type; } syms_of_marker () { defsubr (&Smarker_position); defsubr (&Smarker_buffer); defsubr (&Sset_marker); defsubr (&Scopy_marker); defsubr (&Smarker_insertion_type); defsubr (&Sset_marker_insertion_type); } emacs-19.30/src/minibuf.c100444 12120 1 160165 6054145343 13541 0ustar rmsdaemon/* Minibuffer input and completion. Copyright (C) 1985, 1986, 1993, 1994, 1995 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. */ #include #include "lisp.h" #include "commands.h" #include "buffer.h" #include "dispextern.h" #include "frame.h" #include "window.h" #include "syntax.h" #include "keyboard.h" #define min(a, b) ((a) < (b) ? (a) : (b)) extern int quit_char; /* List of buffers for use as minibuffers. The first element of the list is used for the outermost minibuffer invocation, the next element is used for a recursive minibuffer invocation, etc. The list is extended at the end as deeper minibuffer recursions are encountered. */ Lisp_Object Vminibuffer_list; /* Data to remember during recursive minibuffer invocations */ Lisp_Object minibuf_save_list; /* Depth in minibuffer invocations. */ int minibuf_level; /* Nonzero means display completion help for invalid input */ int auto_help; /* Fread_minibuffer leaves the input here as a string. */ Lisp_Object last_minibuf_string; /* Nonzero means let functions called when within a minibuffer invoke recursive minibuffers (to read arguments, or whatever) */ int enable_recursive_minibuffers; /* help-form is bound to this while in the minibuffer. */ Lisp_Object Vminibuffer_help_form; /* Variable which is the history list to add minibuffer values to. */ Lisp_Object Vminibuffer_history_variable; /* Current position in the history list (adjusted by M-n and M-p). */ Lisp_Object Vminibuffer_history_position; Lisp_Object Qminibuffer_history; Lisp_Object Qread_file_name_internal; /* Normal hooks for entry to and exit from minibuffer. */ Lisp_Object Qminibuffer_setup_hook, Vminibuffer_setup_hook; Lisp_Object Qminibuffer_exit_hook, Vminibuffer_exit_hook; /* Nonzero means completion ignores case. */ int completion_ignore_case; /* List of regexps that should restrict possible completions. */ Lisp_Object Vcompletion_regexp_list; /* Nonzero means raise the minibuffer frame when the minibuffer is entered. */ int minibuffer_auto_raise; /* If last completion attempt reported "Complete but not unique" then this is the string completed then; otherwise this is nil. */ static Lisp_Object last_exact_completion; Lisp_Object Quser_variable_p; /* Non-nil means it is the window for C-M-v to scroll when the minibuffer is selected. */ extern Lisp_Object Vminibuf_scroll_window; extern Lisp_Object Voverriding_local_map; /* Put minibuf on currently selected frame's minibuffer. We do this whenever the user starts a new minibuffer or when a minibuffer exits. */ void choose_minibuf_frame () { if (selected_frame != 0 && !EQ (minibuf_window, selected_frame->minibuffer_window)) { #ifdef MSDOS selected_frame->minibuffer_window = minibuf_window; #else /* I don't think that any frames may validly have a null minibuffer window anymore. */ if (NILP (selected_frame->minibuffer_window)) abort (); Fset_window_buffer (selected_frame->minibuffer_window, XWINDOW (minibuf_window)->buffer); minibuf_window = selected_frame->minibuffer_window; #endif } } /* Actual minibuffer invocation. */ void read_minibuf_unwind (); Lisp_Object get_minibuffer (); Lisp_Object read_minibuf (); /* Read from the minibuffer using keymap MAP, initial contents INITIAL (a string), putting point minus BACKUP_N chars from the end of INITIAL, prompting with PROMPT (a string), using history list HISTVAR with initial position HISTPOS. (BACKUP_N should be <= 0.) Normally return the result as a string (the text that was read), but if EXPFLAG is nonzero, read it and return the object read. If HISTVAR is given, save the value read on that history only if it doesn't match the front of that history list exactly. The value is pushed onto the list as the string that was read. */ Lisp_Object read_minibuf (map, initial, prompt, backup_n, expflag, histvar, histpos) Lisp_Object map; Lisp_Object initial; Lisp_Object prompt; Lisp_Object backup_n; int expflag; Lisp_Object histvar; Lisp_Object histpos; { Lisp_Object val; int count = specpdl_ptr - specpdl; Lisp_Object mini_frame; struct gcpro gcpro1, gcpro2, gcpro3; single_kboard_state (); val = Qnil; /* Don't need to protect PROMPT, HISTVAR, and HISTPOS because we store them away before we can GC. Don't need to protect BACKUP_N because we use the value only if it is an integer. */ GCPRO3 (map, initial, val); if (!STRINGP (prompt)) prompt = build_string (""); if (!enable_recursive_minibuffers && minibuf_level > 0 && (EQ (selected_window, minibuf_window))) error ("Command attempted to use minibuffer while in minibuffer"); /* Could we simply bind these variables instead? */ minibuf_save_list = Fcons (Voverriding_local_map, Fcons (minibuf_window, minibuf_save_list)); minibuf_save_list = Fcons (minibuf_prompt, Fcons (make_number (minibuf_prompt_width), Fcons (Vhelp_form, Fcons (Vcurrent_prefix_arg, Fcons (Vminibuffer_history_position, Fcons (Vminibuffer_history_variable, minibuf_save_list)))))); minibuf_prompt_width = 0; /* xdisp.c puts in the right value. */ minibuf_prompt = Fcopy_sequence (prompt); Vminibuffer_history_position = histpos; Vminibuffer_history_variable = histvar; choose_minibuf_frame (); record_unwind_protect (Fset_window_configuration, Fcurrent_window_configuration (Qnil)); /* If the minibuffer window is on a different frame, save that frame's configuration too. */ #ifdef MULTI_FRAME mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); if (XFRAME (mini_frame) != selected_frame) record_unwind_protect (Fset_window_configuration, Fcurrent_window_configuration (mini_frame)); /* If the minibuffer is on an iconified or invisible frame, make it visible now. */ Fmake_frame_visible (mini_frame); if (minibuffer_auto_raise) Fraise_frame (mini_frame); #endif val = current_buffer->directory; Fset_buffer (get_minibuffer (minibuf_level)); /* The current buffer's default directory is usually the right thing for our minibuffer here. However, if you're typing a command at a minibuffer-only frame when minibuf_level is zero, then buf IS the current_buffer, so reset_buffer leaves buf's default directory unchanged. This is a bummer when you've just started up Emacs and buf's default directory is Qnil. Here's a hack; can you think of something better to do? Find another buffer with a better directory, and use that one instead. */ if (STRINGP (val)) current_buffer->directory = val; else { Lisp_Object buf_list; for (buf_list = Vbuffer_alist; CONSP (buf_list); buf_list = XCONS (buf_list)->cdr) { Lisp_Object other_buf; other_buf = XCONS (XCONS (buf_list)->car)->cdr; if (STRINGP (XBUFFER (other_buf)->directory)) { current_buffer->directory = XBUFFER (other_buf)->directory; break; } } } #ifdef MULTI_FRAME if (XFRAME (mini_frame) != selected_frame) Fredirect_frame_focus (Fselected_frame (), mini_frame); #endif Fmake_local_variable (Qprint_escape_newlines); print_escape_newlines = 1; record_unwind_protect (read_minibuf_unwind, Qnil); Vminibuf_scroll_window = selected_window; Fset_window_buffer (minibuf_window, Fcurrent_buffer ()); Fselect_window (minibuf_window); XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0); Ferase_buffer (); minibuf_level++; if (!NILP (initial)) { Finsert (1, &initial); if (!NILP (backup_n) && INTEGERP (backup_n)) Fforward_char (backup_n); } echo_area_glyphs = 0; /* This is in case the minibuffer-setup-hook calls Fsit_for. */ previous_echo_glyphs = 0; Vhelp_form = Vminibuffer_help_form; current_buffer->keymap = map; /* Run our hook, but not if it is empty. (run-hooks would do nothing if it is empty, but it's important to save time here in the usual case. */ if (!NILP (Vminibuffer_setup_hook) && !EQ (Vminibuffer_setup_hook, Qunbound) && !NILP (Vrun_hooks)) call1 (Vrun_hooks, Qminibuffer_setup_hook); /* ??? MCC did redraw_screen here if switching screens. */ recursive_edit_1 (); /* If cursor is on the minibuffer line, show the user we have exited by putting it in column 0. */ if ((FRAME_CURSOR_Y (selected_frame) >= XFASTINT (XWINDOW (minibuf_window)->top)) && !noninteractive) { FRAME_CURSOR_X (selected_frame) = 0; update_frame (selected_frame, 1, 1); } /* Make minibuffer contents into a string */ val = make_buffer_string (1, Z); bcopy (GAP_END_ADDR, XSTRING (val)->data + GPT - BEG, Z - GPT); /* VAL is the string of minibuffer text. */ last_minibuf_string = val; /* Add the value to the appropriate history list unless it is empty. */ if (XSTRING (val)->size != 0 && SYMBOLP (Vminibuffer_history_variable) && ! EQ (XSYMBOL (Vminibuffer_history_variable)->value, Qunbound)) { /* If the caller wanted to save the value read on a history list, then do so if the value is not already the front of the list. */ Lisp_Object histval; histval = Fsymbol_value (Vminibuffer_history_variable); /* The value of the history variable must be a cons or nil. Other values are unacceptable. We silently ignore these values. */ if (NILP (histval) || (CONSP (histval) && NILP (Fequal (last_minibuf_string, Fcar (histval))))) Fset (Vminibuffer_history_variable, Fcons (last_minibuf_string, histval)); } /* If Lisp form desired instead of string, parse it. */ if (expflag) { Lisp_Object expr_and_pos; unsigned char *p; expr_and_pos = Fread_from_string (val, Qnil, Qnil); /* Ignore trailing whitespace; any other trailing junk is an error. */ for (p = XSTRING (val)->data + XINT (Fcdr (expr_and_pos)); *p; p++) if (*p != ' ' && *p != '\t' && *p != '\n') error ("Trailing garbage following expression"); val = Fcar (expr_and_pos); } /* The appropriate frame will get selected in set-window-configuration. */ RETURN_UNGCPRO (unbind_to (count, val)); } /* Return a buffer to be used as the minibuffer at depth `depth'. depth = 0 is the lowest allowed argument, and that is the value used for nonrecursive minibuffer invocations */ Lisp_Object get_minibuffer (depth) int depth; { Lisp_Object tail, num, buf; char name[24]; extern Lisp_Object nconc2 (); XSETFASTINT (num, depth); tail = Fnthcdr (num, Vminibuffer_list); if (NILP (tail)) { tail = Fcons (Qnil, Qnil); Vminibuffer_list = nconc2 (Vminibuffer_list, tail); } buf = Fcar (tail); if (NILP (buf) || NILP (XBUFFER (buf)->name)) { sprintf (name, " *Minibuf-%d*", depth); buf = Fget_buffer_create (build_string (name)); /* Although the buffer's name starts with a space, undo should be enabled in it. */ Fbuffer_enable_undo (buf); XCONS (tail)->car = buf; } else { int count = specpdl_ptr - specpdl; reset_buffer (XBUFFER (buf)); record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); Fset_buffer (buf); Fkill_all_local_variables (); unbind_to (count, Qnil); } return buf; } /* This function is called on exiting minibuffer, whether normally or not, and it restores the current window, buffer, etc. */ void read_minibuf_unwind (data) Lisp_Object data; { Lisp_Object old_deactivate_mark; /* We are exiting the minibuffer one way or the other, so run the hook. */ if (!NILP (Vminibuffer_exit_hook) && !EQ (Vminibuffer_exit_hook, Qunbound) && !NILP (Vrun_hooks)) safe_run_hooks (Qminibuffer_exit_hook); /* Erase the minibuffer we were using at this level. */ Fset_buffer (XWINDOW (minibuf_window)->buffer); /* Prevent error in erase-buffer. */ current_buffer->read_only = Qnil; old_deactivate_mark = Vdeactivate_mark; Ferase_buffer (); Vdeactivate_mark = old_deactivate_mark; /* If this was a recursive minibuffer, tie the minibuffer window back to the outer level minibuffer buffer */ minibuf_level--; /* Make sure minibuffer window is erased, not ignored */ windows_or_buffers_changed++; XSETFASTINT (XWINDOW (minibuf_window)->last_modified, 0); /* Restore prompt, etc from outer minibuffer */ minibuf_prompt = Fcar (minibuf_save_list); minibuf_save_list = Fcdr (minibuf_save_list); minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list)); minibuf_save_list = Fcdr (minibuf_save_list); Vhelp_form = Fcar (minibuf_save_list); minibuf_save_list = Fcdr (minibuf_save_list); Vcurrent_prefix_arg = Fcar (minibuf_save_list); minibuf_save_list = Fcdr (minibuf_save_list); Vminibuffer_history_position = Fcar (minibuf_save_list); minibuf_save_list = Fcdr (minibuf_save_list); Vminibuffer_history_variable = Fcar (minibuf_save_list); minibuf_save_list = Fcdr (minibuf_save_list); Voverriding_local_map = Fcar (minibuf_save_list); minibuf_save_list = Fcdr (minibuf_save_list); minibuf_window = Fcar (minibuf_save_list); minibuf_save_list = Fcdr (minibuf_save_list); } /* This comment supplies the doc string for read-from-minibuffer, for make-docfile to see. We cannot put this in the real DEFUN due to limits in the Unix cpp. DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0, "Read a string from the minibuffer, prompting with string PROMPT.\n\ If optional second arg INITIAL-CONTENTS is non-nil, it is a string\n\ to be inserted into the minibuffer before reading input.\n\ If INITIAL-CONTENTS is (STRING . POSITION), the initial input\n\ is STRING, but point is placed POSITION characters into the string.\n\ Third arg KEYMAP is a keymap to use whilst reading;\n\ if omitted or nil, the default is `minibuffer-local-map'.\n\ If fourth arg READ is non-nil, then interpret the result as a lisp object\n\ and return that object:\n\ in other words, do `(car (read-from-string INPUT-STRING))'\n\ Fifth arg HIST, if non-nil, specifies a history list\n\ and optionally the initial position in the list.\n\ It can be a symbol, which is the history list variable to use,\n\ or it can be a cons cell (HISTVAR . HISTPOS).\n\ In that case, HISTVAR is the history list variable to use,\n\ and HISTPOS is the initial position (the position in the list\n\ which INITIAL-CONTENTS corresponds to).\n\ Positions are counted starting from 1 at the beginning of the list." */ DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0, 0 /* See immediately above */) (prompt, initial_contents, keymap, read, hist) Lisp_Object prompt, initial_contents, keymap, read, hist; { int pos = 0; Lisp_Object histvar, histpos, position; position = Qnil; CHECK_STRING (prompt, 0); if (!NILP (initial_contents)) { if (CONSP (initial_contents)) { position = Fcdr (initial_contents); initial_contents = Fcar (initial_contents); } CHECK_STRING (initial_contents, 1); if (!NILP (position)) { CHECK_NUMBER (position, 0); /* Convert to distance from end of input. */ pos = XINT (position) - 1 - XSTRING (initial_contents)->size; } } if (NILP (keymap)) keymap = Vminibuffer_local_map; else keymap = get_keymap (keymap,2); if (SYMBOLP (hist)) { histvar = hist; histpos = Qnil; } else { histvar = Fcar_safe (hist); histpos = Fcdr_safe (hist); } if (NILP (histvar)) histvar = Qminibuffer_history; if (NILP (histpos)) XSETFASTINT (histpos, 0); return read_minibuf (keymap, initial_contents, prompt, make_number (pos), !NILP (read), histvar, histpos); } DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0, "Return a Lisp object read using the minibuffer.\n\ Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\ is a string to insert in the minibuffer before reading.") (prompt, initial_contents) Lisp_Object prompt, initial_contents; { CHECK_STRING (prompt, 0); if (!NILP (initial_contents)) CHECK_STRING (initial_contents, 1); return read_minibuf (Vminibuffer_local_map, initial_contents, prompt, Qnil, 1, Qminibuffer_history, make_number (0)); } DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0, "Return value of Lisp expression read using the minibuffer.\n\ Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\ is a string to insert in the minibuffer before reading.") (prompt, initial_contents) Lisp_Object prompt, initial_contents; { return Feval (Fread_minibuffer (prompt, initial_contents)); } /* Functions that use the minibuffer to read various things. */ DEFUN ("read-string", Fread_string, Sread_string, 1, 3, 0, "Read a string from the minibuffer, prompting with string PROMPT.\n\ If non-nil, second arg INITIAL-INPUT is a string to insert before reading.\n\ The third arg HISTORY, if non-nil, specifies a history list\n\ and optionally the initial position in the list.\n\ See `read-from-minibuffer' for details of HISTORY argument.") (prompt, initial_input, history) Lisp_Object prompt, initial_input, history; { return Fread_from_minibuffer (prompt, initial_input, Qnil, Qnil, history); } DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 2, 0, "Args PROMPT and INIT, strings. Read a string from the terminal, not allowing blanks.\n\ Prompt with PROMPT, and provide INIT as an initial value of the input string.") (prompt, init) Lisp_Object prompt, init; { CHECK_STRING (prompt, 0); if (! NILP (init)) CHECK_STRING (init, 1); return read_minibuf (Vminibuffer_local_ns_map, init, prompt, Qnil, 0, Qminibuffer_history, make_number (0)); } DEFUN ("read-command", Fread_command, Sread_command, 1, 1, 0, "One arg PROMPT, a string. Read the name of a command and return as a symbol.\n\ Prompts with PROMPT.") (prompt) Lisp_Object prompt; { return Fintern (Fcompleting_read (prompt, Vobarray, Qcommandp, Qt, Qnil, Qnil), Qnil); } #ifdef NOTDEF DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0, "One arg PROMPT, a string. Read the name of a function and return as a symbol.\n\ Prompts with PROMPT.") (prompt) Lisp_Object prompt; { return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil, Qnil), Qnil); } #endif /* NOTDEF */ DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 1, 0, "One arg PROMPT, a string. Read the name of a user variable and return\n\ it as a symbol. Prompts with PROMPT.\n\ A user variable is one whose documentation starts with a `*' character.") (prompt) Lisp_Object prompt; { return Fintern (Fcompleting_read (prompt, Vobarray, Quser_variable_p, Qt, Qnil, Qnil), Qnil); } DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0, "One arg PROMPT, a string. Read the name of a buffer and return as a string.\n\ Prompts with PROMPT.\n\ Optional second arg is value to return if user enters an empty line.\n\ If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are allowed.") (prompt, def, require_match) Lisp_Object prompt, def, require_match; { Lisp_Object tem; Lisp_Object args[3]; struct gcpro gcpro1; if (BUFFERP (def)) def = XBUFFER (def)->name; if (!NILP (def)) { args[0] = build_string ("%s(default %s) "); args[1] = prompt; args[2] = def; prompt = Fformat (3, args); } GCPRO1 (def); tem = Fcompleting_read (prompt, Vbuffer_alist, Qnil, require_match, Qnil, Qnil); UNGCPRO; if (XSTRING (tem)->size) return tem; return def; } DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0, "Return common substring of all completions of STRING in ALIST.\n\ Each car of each element of ALIST is tested to see if it begins with STRING.\n\ All that match are compared together; the longest initial sequence\n\ common to all matches is returned as a string.\n\ If there is no match at all, nil is returned.\n\ For an exact match, t is returned.\n\ \n\ ALIST can be an obarray instead of an alist.\n\ Then the print names of all symbols in the obarray are the possible matches.\n\ \n\ ALIST can also be a function to do the completion itself.\n\ It receives three arguments: the values STRING, PREDICATE and nil.\n\ Whatever it returns becomes the value of `try-completion'.\n\ \n\ If optional third argument PREDICATE is non-nil,\n\ it is used to test each possible match.\n\ The match is a candidate only if PREDICATE returns non-nil.\n\ The argument given to PREDICATE is the alist element\n\ or the symbol from the obarray.") (string, alist, pred) Lisp_Object string, alist, pred; { Lisp_Object bestmatch, tail, elt, eltstring; int bestmatchsize; int compare, matchsize; int list = CONSP (alist) || NILP (alist); int index, obsize; int matchcount = 0; Lisp_Object bucket, zero, end, tem; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; CHECK_STRING (string, 0); if (!list && !VECTORP (alist)) return call3 (alist, string, pred, Qnil); bestmatch = Qnil; /* If ALIST is not a list, set TAIL just for gc pro. */ tail = alist; if (! list) { index = 0; obsize = XVECTOR (alist)->size; bucket = XVECTOR (alist)->contents[index]; } while (1) { /* Get the next element of the alist or obarray. */ /* Exit the loop if the elements are all used up. */ /* elt gets the alist element or symbol. eltstring gets the name to check as a completion. */ if (list) { if (NILP (tail)) break; elt = Fcar (tail); eltstring = Fcar (elt); tail = Fcdr (tail); } else { if (XFASTINT (bucket) != 0) { elt = bucket; eltstring = Fsymbol_name (elt); if (XSYMBOL (bucket)->next) XSETSYMBOL (bucket, XSYMBOL (bucket)->next); else XSETFASTINT (bucket, 0); } else if (++index >= obsize) break; else { bucket = XVECTOR (alist)->contents[index]; continue; } } /* Is this element a possible completion? */ if (STRINGP (eltstring) && XSTRING (string)->size <= XSTRING (eltstring)->size && 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data, XSTRING (string)->size)) { /* Yes. */ Lisp_Object regexps; Lisp_Object zero; XSETFASTINT (zero, 0); /* Ignore this element if it fails to match all the regexps. */ for (regexps = Vcompletion_regexp_list; CONSP (regexps); regexps = XCONS (regexps)->cdr) { tem = Fstring_match (XCONS (regexps)->car, eltstring, zero); if (NILP (tem)) break; } if (CONSP (regexps)) continue; /* Ignore this element if there is a predicate and the predicate doesn't like it. */ if (!NILP (pred)) { if (EQ (pred, Qcommandp)) tem = Fcommandp (elt); else { GCPRO4 (tail, string, eltstring, bestmatch); tem = call1 (pred, elt); UNGCPRO; } if (NILP (tem)) continue; } /* Update computation of how much all possible completions match */ matchcount++; if (NILP (bestmatch)) bestmatch = eltstring, bestmatchsize = XSTRING (eltstring)->size; else { compare = min (bestmatchsize, XSTRING (eltstring)->size); matchsize = scmp (XSTRING (bestmatch)->data, XSTRING (eltstring)->data, compare); if (matchsize < 0) matchsize = compare; if (completion_ignore_case) { /* If this is an exact match except for case, use it as the best match rather than one that is not an exact match. This way, we get the case pattern of the actual match. */ if ((matchsize == XSTRING (eltstring)->size && matchsize < XSTRING (bestmatch)->size) || /* If there is more than one exact match ignoring case, and one of them is exact including case, prefer that one. */ /* If there is no exact match ignoring case, prefer a match that does not change the case of the input. */ ((matchsize == XSTRING (eltstring)->size) == (matchsize == XSTRING (bestmatch)->size) && !bcmp (XSTRING (eltstring)->data, XSTRING (string)->data, XSTRING (string)->size) && bcmp (XSTRING (bestmatch)->data, XSTRING (string)->data, XSTRING (string)->size))) bestmatch = eltstring; } bestmatchsize = matchsize; } } } if (NILP (bestmatch)) return Qnil; /* No completions found */ /* If we are ignoring case, and there is no exact match, and no additional text was supplied, don't change the case of what the user typed. */ if (completion_ignore_case && bestmatchsize == XSTRING (string)->size && XSTRING (bestmatch)->size > bestmatchsize) return string; /* Return t if the supplied string is an exact match (counting case); it does not require any change to be made. */ if (matchcount == 1 && bestmatchsize == XSTRING (string)->size && !bcmp (XSTRING (bestmatch)->data, XSTRING (string)->data, bestmatchsize)) return Qt; XSETFASTINT (zero, 0); /* Else extract the part in which */ XSETFASTINT (end, bestmatchsize); /* all completions agree */ return Fsubstring (bestmatch, zero, end); } /* Compare exactly LEN chars of strings at S1 and S2, ignoring case if appropriate. Return -1 if strings match, else number of chars that match at the beginning. */ int scmp (s1, s2, len) register unsigned char *s1, *s2; int len; { register int l = len; if (completion_ignore_case) { while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++)) l--; } else { while (l && *s1++ == *s2++) l--; } if (l == 0) return -1; else return len - l; } DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0, "Search for partial matches to STRING in ALIST.\n\ Each car of each element of ALIST is tested to see if it begins with STRING.\n\ The value is a list of all the strings from ALIST that match.\n\ \n\ ALIST can be an obarray instead of an alist.\n\ Then the print names of all symbols in the obarray are the possible matches.\n\ \n\ ALIST can also be a function to do the completion itself.\n\ It receives three arguments: the values STRING, PREDICATE and t.\n\ Whatever it returns becomes the value of `all-completion'.\n\ \n\ If optional third argument PREDICATE is non-nil,\n\ it is used to test each possible match.\n\ The match is a candidate only if PREDICATE returns non-nil.\n\ The argument given to PREDICATE is the alist element\n\ or the symbol from the obarray.\n\ \n\ If the optional fourth argument HIDE-SPACES is non-nil,\n\ strings in ALIST that start with a space\n\ are ignored unless STRING itself starts with a space.") (string, alist, pred, hide_spaces) Lisp_Object string, alist, pred, hide_spaces; { Lisp_Object tail, elt, eltstring; Lisp_Object allmatches; int list = CONSP (alist) || NILP (alist); int index, obsize; Lisp_Object bucket, tem; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; CHECK_STRING (string, 0); if (!list && !VECTORP (alist)) { return call3 (alist, string, pred, Qt); } allmatches = Qnil; /* If ALIST is not a list, set TAIL just for gc pro. */ tail = alist; if (! list) { index = 0; obsize = XVECTOR (alist)->size; bucket = XVECTOR (alist)->contents[index]; } while (1) { /* Get the next element of the alist or obarray. */ /* Exit the loop if the elements are all used up. */ /* elt gets the alist element or symbol. eltstring gets the name to check as a completion. */ if (list) { if (NILP (tail)) break; elt = Fcar (tail); eltstring = Fcar (elt); tail = Fcdr (tail); } else { if (XFASTINT (bucket) != 0) { elt = bucket; eltstring = Fsymbol_name (elt); if (XSYMBOL (bucket)->next) XSETSYMBOL (bucket, XSYMBOL (bucket)->next); else XSETFASTINT (bucket, 0); } else if (++index >= obsize) break; else { bucket = XVECTOR (alist)->contents[index]; continue; } } /* Is this element a possible completion? */ if (STRINGP (eltstring) && XSTRING (string)->size <= XSTRING (eltstring)->size /* If HIDE_SPACES, reject alternatives that start with space unless the input starts with space. */ && ((XSTRING (string)->size > 0 && XSTRING (string)->data[0] == ' ') || XSTRING (eltstring)->data[0] != ' ' || NILP (hide_spaces)) && 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data, XSTRING (string)->size)) { /* Yes. */ Lisp_Object regexps; Lisp_Object zero; XSETFASTINT (zero, 0); /* Ignore this element if it fails to match all the regexps. */ for (regexps = Vcompletion_regexp_list; CONSP (regexps); regexps = XCONS (regexps)->cdr) { tem = Fstring_match (XCONS (regexps)->car, eltstring, zero); if (NILP (tem)) break; } if (CONSP (regexps)) continue; /* Ignore this element if there is a predicate and the predicate doesn't like it. */ if (!NILP (pred)) { if (EQ (pred, Qcommandp)) tem = Fcommandp (elt); else { GCPRO4 (tail, eltstring, allmatches, string); tem = call1 (pred, elt); UNGCPRO; } if (NILP (tem)) continue; } /* Ok => put it on the list. */ allmatches = Fcons (eltstring, allmatches); } } return Fnreverse (allmatches); } Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table; Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate; Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm; /* This comment supplies the doc string for completing-read, for make-docfile to see. We cannot put this in the real DEFUN due to limits in the Unix cpp. DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0, "Read a string in the minibuffer, with completion.\n\ Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST.\n\ PROMPT is a string to prompt with; normally it ends in a colon and a space.\n\ TABLE is an alist whose elements' cars are strings, or an obarray.\n\ PREDICATE limits completion to a subset of TABLE.\n\ See `try-completion' and `all-completions' for more details on completion, TABLE, and PREDICATE.\n\ \n\ If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless\n\ the input is (or completes to) an element of TABLE or is null.\n\ If it is also not t, Return does not exit if it does non-null completion.\n\ If the input is null, `completing-read' returns nil,\n\ regardless of the value of REQUIRE-MATCH.\n\ \n\ If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.\n\ If it is (STRING . POSITION), the initial input\n\ is STRING, but point is placed POSITION characters into the string.\n\ HIST, if non-nil, specifies a history list\n\ and optionally the initial position in the list.\n\ It can be a symbol, which is the history list variable to use,\n\ or it can be a cons cell (HISTVAR . HISTPOS).\n\ In that case, HISTVAR is the history list variable to use,\n\ and HISTPOS is the initial position (the position in the list\n\ which INITIAL-CONTENTS corresponds to).\n\ Positions are counted starting from 1 at the beginning of the list.\n\ Completion ignores case if the ambient value of\n\ `completion-ignore-case' is non-nil." */ DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0, 0 /* See immediately above */) (prompt, table, pred, require_match, init, hist) Lisp_Object prompt, table, pred, require_match, init, hist; { Lisp_Object val, histvar, histpos, position; int pos = 0; int count = specpdl_ptr - specpdl; specbind (Qminibuffer_completion_table, table); specbind (Qminibuffer_completion_predicate, pred); specbind (Qminibuffer_completion_confirm, EQ (require_match, Qt) ? Qnil : Qt); last_exact_completion = Qnil; position = Qnil; if (!NILP (init)) { if (CONSP (init)) { position = Fcdr (init); init = Fcar (init); } CHECK_STRING (init, 0); if (!NILP (position)) { CHECK_NUMBER (position, 0); /* Convert to distance from end of input. */ pos = XINT (position) - XSTRING (init)->size; } } if (SYMBOLP (hist)) { histvar = hist; histpos = Qnil; } else { histvar = Fcar_safe (hist); histpos = Fcdr_safe (hist); } if (NILP (histvar)) histvar = Qminibuffer_history; if (NILP (histpos)) XSETFASTINT (histpos, 0); val = read_minibuf (NILP (require_match) ? Vminibuffer_local_completion_map : Vminibuffer_local_must_match_map, init, prompt, make_number (pos), 0, histvar, histpos); return unbind_to (count, val); } /* Temporarily display the string M at the end of the current minibuffer contents. This is used to display things like "[No Match]" when the user requests a completion for a prefix that has no possible completions, and other quick, unobtrusive messages. */ temp_echo_area_glyphs (m) char *m; { int osize = ZV; int opoint = PT; Lisp_Object oinhibit; oinhibit = Vinhibit_quit; /* Clear out any old echo-area message to make way for our new thing. */ message (0); SET_PT (osize); insert_string (m); SET_PT (opoint); Vinhibit_quit = Qt; Fsit_for (make_number (2), Qnil, Qnil); del_range (osize, ZV); SET_PT (opoint); if (!NILP (Vquit_flag)) { Vquit_flag = Qnil; Vunread_command_events = Fcons (make_number (quit_char), Qnil); } Vinhibit_quit = oinhibit; } Lisp_Object Fminibuffer_completion_help (); Lisp_Object assoc_for_completion (); /* A subroutine of Fintern_soft. */ extern Lisp_Object oblookup (); /* Test whether TXT is an exact completion. */ Lisp_Object test_completion (txt) Lisp_Object txt; { Lisp_Object tem; if (CONSP (Vminibuffer_completion_table) || NILP (Vminibuffer_completion_table)) return assoc_for_completion (txt, Vminibuffer_completion_table); else if (VECTORP (Vminibuffer_completion_table)) { /* Bypass intern-soft as that loses for nil */ tem = oblookup (Vminibuffer_completion_table, XSTRING (txt)->data, XSTRING (txt)->size); if (!SYMBOLP (tem)) return Qnil; else if (!NILP (Vminibuffer_completion_predicate)) return call1 (Vminibuffer_completion_predicate, tem); else return Qt; } else return call3 (Vminibuffer_completion_table, txt, Vminibuffer_completion_predicate, Qlambda); } /* returns: * 0 no possible completion * 1 was already an exact and unique completion * 3 was already an exact completion * 4 completed to an exact completion * 5 some completion happened * 6 no completion happened */ int do_completion () { Lisp_Object completion, tem; int completedp; Lisp_Object last; struct gcpro gcpro1, gcpro2; completion = Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table, Vminibuffer_completion_predicate); last = last_exact_completion; last_exact_completion = Qnil; GCPRO2 (completion, last); if (NILP (completion)) { bitch_at_user (); temp_echo_area_glyphs (" [No match]"); UNGCPRO; return 0; } if (EQ (completion, Qt)) /* exact and unique match */ { UNGCPRO; return 1; } /* compiler bug */ tem = Fstring_equal (completion, Fbuffer_string()); if (completedp = NILP (tem)) { Ferase_buffer (); /* Some completion happened */ Finsert (1, &completion); } /* It did find a match. Do we match some possibility exactly now? */ tem = test_completion (Fbuffer_string ()); if (NILP (tem)) { /* not an exact match */ UNGCPRO; if (completedp) return 5; else if (auto_help) Fminibuffer_completion_help (); else temp_echo_area_glyphs (" [Next char not unique]"); return 6; } else if (completedp) { UNGCPRO; return 4; } /* If the last exact completion and this one were the same, it means we've already given a "Complete but not unique" message and the user's hit TAB again, so now we give him help. */ last_exact_completion = completion; if (!NILP (last)) { tem = Fbuffer_string (); if (!NILP (Fequal (tem, last))) Fminibuffer_completion_help (); } UNGCPRO; return 3; } /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */ Lisp_Object assoc_for_completion (key, list) register Lisp_Object key; Lisp_Object list; { register Lisp_Object tail; if (completion_ignore_case) key = Fupcase (key); for (tail = list; !NILP (tail); tail = Fcdr (tail)) { register Lisp_Object elt, tem, thiscar; elt = Fcar (tail); if (!CONSP (elt)) continue; thiscar = Fcar (elt); if (!STRINGP (thiscar)) continue; if (completion_ignore_case) thiscar = Fupcase (thiscar); tem = Fequal (thiscar, key); if (!NILP (tem)) return elt; QUIT; } return Qnil; } DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "", "Complete the minibuffer contents as far as possible.\n\ Return nil if there is no valid completion, else t.\n\ If no characters can be completed, display a list of possible completions.\n\ If you repeat this command after it displayed such a list,\n\ scroll the window of possible completions.") () { register int i; Lisp_Object window, tem; /* If the previous command was not this, then mark the completion buffer obsolete. */ if (! EQ (current_kboard->Vlast_command, this_command)) Vminibuf_scroll_window = Qnil; window = Vminibuf_scroll_window; /* If there's a fresh completion window with a live buffer, and this command is repeated, scroll that window. */ if (! NILP (window) && ! NILP (XWINDOW (window)->buffer) && !NILP (XBUFFER (XWINDOW (window)->buffer)->name)) { struct buffer *obuf = current_buffer; Fset_buffer (XWINDOW (window)->buffer); tem = Fpos_visible_in_window_p (make_number (ZV), window); if (! NILP (tem)) /* If end is in view, scroll up to the beginning. */ Fset_window_start (window, BEGV, Qnil); else /* Else scroll down one screen. */ Fscroll_other_window (Qnil); set_buffer_internal (obuf); return Qnil; } i = do_completion (); switch (i) { case 0: return Qnil; case 1: temp_echo_area_glyphs (" [Sole completion]"); break; case 3: temp_echo_area_glyphs (" [Complete, but not unique]"); break; } return Qt; } /* Subroutines of Fminibuffer_complete_and_exit. */ /* This one is called by internal_condition_case to do the real work. */ Lisp_Object complete_and_exit_1 () { return make_number (do_completion ()); } /* This one is called by internal_condition_case if an error happens. Pretend the current value is an exact match. */ Lisp_Object complete_and_exit_2 (ignore) Lisp_Object ignore; { return make_number (1); } DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit, Sminibuffer_complete_and_exit, 0, 0, "", "If the minibuffer contents is a valid completion then exit.\n\ Otherwise try to complete it. If completion leads to a valid completion,\n\ a repetition of this command will exit.") () { register int i; Lisp_Object val; /* Allow user to specify null string */ if (BEGV == ZV) goto exit; if (!NILP (test_completion (Fbuffer_string ()))) goto exit; /* Call do_completion, but ignore errors. */ val = internal_condition_case (complete_and_exit_1, Qerror, complete_and_exit_2); i = XFASTINT (val); switch (i) { case 1: case 3: goto exit; case 4: if (!NILP (Vminibuffer_completion_confirm)) { temp_echo_area_glyphs (" [Confirm]"); return Qnil; } else goto exit; default: return Qnil; } exit: Fthrow (Qexit, Qnil); /* NOTREACHED */ } DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word, 0, 0, "", "Complete the minibuffer contents at most a single word.\n\ After one word is completed as much as possible, a space or hyphen\n\ is added, provided that matches some possible completion.\n\ Return nil if there is no valid completion, else t.") () { Lisp_Object completion, tem; register int i; register unsigned char *completion_string; struct gcpro gcpro1, gcpro2; /* We keep calling Fbuffer_string rather than arrange for GC to hold onto a pointer to one of the strings thus made. */ completion = Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table, Vminibuffer_completion_predicate); if (NILP (completion)) { bitch_at_user (); temp_echo_area_glyphs (" [No match]"); return Qnil; } if (EQ (completion, Qt)) return Qnil; #if 0 /* How the below code used to look, for reference. */ tem = Fbuffer_string (); b = XSTRING (tem)->data; i = ZV - 1 - XSTRING (completion)->size; p = XSTRING (completion)->data; if (i > 0 || 0 <= scmp (b, p, ZV - 1)) { i = 1; /* Set buffer to longest match of buffer tail and completion head. */ while (0 <= scmp (b + i, p, ZV - 1 - i)) i++; del_range (1, i + 1); SET_PT (ZV); } #else /* Rewritten code */ { register unsigned char *buffer_string; int buffer_length, completion_length; tem = Fbuffer_string (); GCPRO2 (completion, tem); /* If reading a file name, expand any $ENVVAR refs in the buffer and in TEM. */ if (EQ (Vminibuffer_completion_table, Qread_file_name_internal)) { Lisp_Object substituted; substituted = Fsubstitute_in_file_name (tem); if (! EQ (substituted, tem)) { tem = substituted; Ferase_buffer (); insert_from_string (tem, 0, XSTRING (tem)->size, 0); } } buffer_string = XSTRING (tem)->data; completion_string = XSTRING (completion)->data; buffer_length = XSTRING (tem)->size; /* ie ZV - BEGV */ completion_length = XSTRING (completion)->size; i = buffer_length - completion_length; /* Mly: I don't understand what this is supposed to do AT ALL */ if (i > 0 || 0 <= scmp (buffer_string, completion_string, buffer_length)) { /* Set buffer to longest match of buffer tail and completion head. */ if (i <= 0) i = 1; buffer_string += i; buffer_length -= i; while (0 <= scmp (buffer_string++, completion_string, buffer_length--)) i++; del_range (1, i + 1); SET_PT (ZV); } UNGCPRO; } #endif /* Rewritten code */ i = ZV - BEGV; /* If completion finds next char not unique, consider adding a space or a hyphen. */ if (i == XSTRING (completion)->size) { GCPRO1 (completion); tem = Ftry_completion (concat2 (Fbuffer_string (), build_string (" ")), Vminibuffer_completion_table, Vminibuffer_completion_predicate); UNGCPRO; if (STRINGP (tem)) completion = tem; else { GCPRO1 (completion); tem = Ftry_completion (concat2 (Fbuffer_string (), build_string ("-")), Vminibuffer_completion_table, Vminibuffer_completion_predicate); UNGCPRO; if (STRINGP (tem)) completion = tem; } } /* Now find first word-break in the stuff found by completion. i gets index in string of where to stop completing. */ completion_string = XSTRING (completion)->data; for (; i < XSTRING (completion)->size; i++) if (SYNTAX (completion_string[i]) != Sword) break; if (i < XSTRING (completion)->size) i = i + 1; /* If got no characters, print help for user. */ if (i == ZV - BEGV) { if (auto_help) Fminibuffer_completion_help (); return Qnil; } /* Otherwise insert in minibuffer the chars we got */ Ferase_buffer (); insert_from_string (completion, 0, i, 1); return Qt; } DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list, 1, 1, 0, "Display the list of completions, COMPLETIONS, using `standard-output'.\n\ Each element may be just a symbol or string\n\ or may be a list of two strings to be printed as if concatenated.\n\ `standard-output' must be a buffer.\n\ At the end, run the normal hook `completion-setup-hook'.\n\ It can find the completion buffer in `standard-output'.") (completions) Lisp_Object completions; { Lisp_Object tail, elt; register int i; int column = 0; struct gcpro gcpro1, gcpro2; struct buffer *old = current_buffer; int first = 1; /* Note that (when it matters) every variable points to a non-string that is pointed to by COMPLETIONS, except for ELT. ELT can be pointing to a string when terpri or Findent_to calls a change hook. */ elt = Qnil; GCPRO2 (completions, elt); if (BUFFERP (Vstandard_output)) set_buffer_internal (XBUFFER (Vstandard_output)); if (NILP (completions)) write_string ("There are no possible completions of what you have typed.", -1); else { write_string ("Possible completions are:", -1); for (tail = completions, i = 0; !NILP (tail); tail = Fcdr (tail), i++) { Lisp_Object tem; int length; Lisp_Object startpos, endpos; elt = Fcar (tail); /* Compute the length of this element. */ if (CONSP (elt)) { tem = Fcar (elt); CHECK_STRING (tem, 0); length = XINT (XSTRING (tem)->size); tem = Fcar (Fcdr (elt)); CHECK_STRING (tem, 0); length += XINT (XSTRING (tem)->size); } else { CHECK_STRING (elt, 0); length = XINT (XSTRING (elt)->size); } /* This does a bad job for narrower than usual windows. Sadly, the window it will appear in is not known until after the text has been made. */ if (BUFFERP (Vstandard_output)) XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output))); /* If the previous completion was very wide, or we have two on this line already, don't put another on the same line. */ if (column > 33 || first /* If this is really wide, don't put it second on a line. */ || column > 0 && length > 45) { Fterpri (Qnil); column = 0; } /* Otherwise advance to column 35. */ else { if (BUFFERP (Vstandard_output)) { tem = Findent_to (make_number (35), make_number (2)); column = XINT (tem); } else { do { write_string (" ", -1); column++; } while (column < 35); } } if (BUFFERP (Vstandard_output)) { XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output))); Fset_text_properties (startpos, endpos, Qnil, Vstandard_output); } /* Output this element and update COLUMN. */ if (CONSP (elt)) { Fprinc (Fcar (elt), Qnil); Fprinc (Fcar (Fcdr (elt)), Qnil); } else Fprinc (elt, Qnil); column += length; /* If output is to a buffer, recompute COLUMN in a way that takes account of character widths. */ if (BUFFERP (Vstandard_output)) { tem = Fcurrent_column (); column = XINT (tem); } first = 0; } } UNGCPRO; if (BUFFERP (Vstandard_output)) set_buffer_internal (old); if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, intern ("completion-setup-hook")); return Qnil; } DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help, 0, 0, "", "Display a list of possible completions of the current minibuffer contents.") () { Lisp_Object completions; message ("Making completion list..."); completions = Fall_completions (Fbuffer_string (), Vminibuffer_completion_table, Vminibuffer_completion_predicate, Qt); echo_area_glyphs = 0; if (NILP (completions)) { bitch_at_user (); temp_echo_area_glyphs (" [No completions]"); } else internal_with_output_to_temp_buffer ("*Completions*", Fdisplay_completion_list, Fsort (completions, Qstring_lessp)); return Qnil; } DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "", "Terminate minibuffer input.") () { if (INTEGERP (last_command_char)) internal_self_insert (last_command_char, 0); else bitch_at_user (); Fthrow (Qexit, Qnil); } DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "", "Terminate this minibuffer argument.") () { Fthrow (Qexit, Qnil); } DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0, "Return current depth of activations of minibuffer, a nonnegative integer.") () { return make_number (minibuf_level); } DEFUN ("minibuffer-prompt", Fminibuffer_prompt, Sminibuffer_prompt, 0, 0, 0, "Return the prompt string of the currently-active minibuffer.\n\ If no minibuffer is active, return nil.") () { return Fcopy_sequence (minibuf_prompt); } DEFUN ("minibuffer-prompt-width", Fminibuffer_prompt_width, Sminibuffer_prompt_width, 0, 0, 0, "Return the display width of the minibuffer prompt.") () { Lisp_Object width; XSETFASTINT (width, minibuf_prompt_width); return width; } init_minibuf_once () { Vminibuffer_list = Qnil; staticpro (&Vminibuffer_list); } syms_of_minibuf () { minibuf_level = 0; minibuf_prompt = Qnil; staticpro (&minibuf_prompt); minibuf_save_list = Qnil; staticpro (&minibuf_save_list); Qread_file_name_internal = intern ("read-file-name-internal"); staticpro (&Qread_file_name_internal); Qminibuffer_completion_table = intern ("minibuffer-completion-table"); staticpro (&Qminibuffer_completion_table); Qminibuffer_completion_confirm = intern ("minibuffer-completion-confirm"); staticpro (&Qminibuffer_completion_confirm); Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate"); staticpro (&Qminibuffer_completion_predicate); staticpro (&last_exact_completion); last_exact_completion = Qnil; staticpro (&last_minibuf_string); last_minibuf_string = Qnil; Quser_variable_p = intern ("user-variable-p"); staticpro (&Quser_variable_p); Qminibuffer_history = intern ("minibuffer-history"); staticpro (&Qminibuffer_history); Qminibuffer_setup_hook = intern ("minibuffer-setup-hook"); staticpro (&Qminibuffer_setup_hook); Qminibuffer_exit_hook = intern ("minibuffer-exit-hook"); staticpro (&Qminibuffer_exit_hook); DEFVAR_LISP ("minibuffer-setup-hook", &Vminibuffer_setup_hook, "Normal hook run just after entry to minibuffer."); Vminibuffer_setup_hook = Qnil; DEFVAR_LISP ("minibuffer-exit-hook", &Vminibuffer_exit_hook, "Normal hook run just after exit from minibuffer."); Vminibuffer_exit_hook = Qnil; DEFVAR_BOOL ("completion-auto-help", &auto_help, "*Non-nil means automatically provide help for invalid completion input."); auto_help = 1; DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case, "Non-nil means don't consider case significant in completion."); completion_ignore_case = 0; DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers, "*Non-nil means to allow minibuffer commands while in the minibuffer.\n\ More precisely, this variable makes a difference when the minibuffer window\n\ is the selected window. If you are in some other window, minibuffer commands\n\ are allowed even if a minibuffer is active."); enable_recursive_minibuffers = 0; DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table, "Alist or obarray used for completion in the minibuffer.\n\ This becomes the ALIST argument to `try-completion' and `all-completion'.\n\ \n\ The value may alternatively be a function, which is given three arguments:\n\ STRING, the current buffer contents;\n\ PREDICATE, the predicate for filtering possible matches;\n\ CODE, which says what kind of things to do.\n\ CODE can be nil, t or `lambda'.\n\ nil means to return the best completion of STRING, or nil if there is none.\n\ t means to return a list of all possible completions of STRING.\n\ `lambda' means to return t if STRING is a valid completion as it stands."); Vminibuffer_completion_table = Qnil; DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate, "Within call to `completing-read', this holds the PREDICATE argument."); Vminibuffer_completion_predicate = Qnil; DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm, "Non-nil => demand confirmation of completion before exiting minibuffer."); Vminibuffer_completion_confirm = Qnil; DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form, "Value that `help-form' takes on inside the minibuffer."); Vminibuffer_help_form = Qnil; DEFVAR_LISP ("minibuffer-history-variable", &Vminibuffer_history_variable, "History list symbol to add minibuffer values to.\n\ Each string of minibuffer input, as it appears on exit from the minibuffer,\n\ is added with\n\ (set minibuffer-history-variable\n\ (cons STRING (symbol-value minibuffer-history-variable)))"); XSETFASTINT (Vminibuffer_history_variable, 0); DEFVAR_LISP ("minibuffer-history-position", &Vminibuffer_history_position, "Current position of redoing in the history list."); Vminibuffer_history_position = Qnil; DEFVAR_BOOL ("minibuffer-auto-raise", &minibuffer_auto_raise, "*Non-nil means entering the minibuffer raises the minibuffer's frame."); minibuffer_auto_raise = 0; DEFVAR_LISP ("completion-regexp-list", &Vcompletion_regexp_list, "List of regexps that should restrict possible completions."); Vcompletion_regexp_list = Qnil; defsubr (&Sread_from_minibuffer); defsubr (&Seval_minibuffer); defsubr (&Sread_minibuffer); defsubr (&Sread_string); defsubr (&Sread_command); defsubr (&Sread_variable); defsubr (&Sread_buffer); defsubr (&Sread_no_blanks_input); defsubr (&Sminibuffer_depth); defsubr (&Sminibuffer_prompt); defsubr (&Sminibuffer_prompt_width); defsubr (&Stry_completion); defsubr (&Sall_completions); defsubr (&Scompleting_read); defsubr (&Sminibuffer_complete); defsubr (&Sminibuffer_complete_word); defsubr (&Sminibuffer_complete_and_exit); defsubr (&Sdisplay_completion_list); defsubr (&Sminibuffer_completion_help); defsubr (&Sself_insert_and_exit); defsubr (&Sexit_minibuffer); } keys_of_minibuf () { initial_define_key (Vminibuffer_local_map, Ctl ('g'), "abort-recursive-edit"); initial_define_key (Vminibuffer_local_map, Ctl ('m'), "exit-minibuffer"); initial_define_key (Vminibuffer_local_map, Ctl ('j'), "exit-minibuffer"); initial_define_key (Vminibuffer_local_ns_map, Ctl ('g'), "abort-recursive-edit"); initial_define_key (Vminibuffer_local_ns_map, Ctl ('m'), "exit-minibuffer"); initial_define_key (Vminibuffer_local_ns_map, Ctl ('j'), "exit-minibuffer"); initial_define_key (Vminibuffer_local_ns_map, ' ', "exit-minibuffer"); initial_define_key (Vminibuffer_local_ns_map, '\t', "exit-minibuffer"); initial_define_key (Vminibuffer_local_ns_map, '?', "self-insert-and-exit"); initial_define_key (Vminibuffer_local_completion_map, Ctl ('g'), "abort-recursive-edit"); initial_define_key (Vminibuffer_local_completion_map, Ctl ('m'), "exit-minibuffer"); initial_define_key (Vminibuffer_local_completion_map, Ctl ('j'), "exit-minibuffer"); initial_define_key (Vminibuffer_local_completion_map, '\t', "minibuffer-complete"); initial_define_key (Vminibuffer_local_completion_map, ' ', "minibuffer-complete-word"); initial_define_key (Vminibuffer_local_completion_map, '?', "minibuffer-completion-help"); initial_define_key (Vminibuffer_local_must_match_map, Ctl ('g'), "abort-recursive-edit"); initial_define_key (Vminibuffer_local_must_match_map, Ctl ('m'), "minibuffer-complete-and-exit"); initial_define_key (Vminibuffer_local_must_match_map, Ctl ('j'), "minibuffer-complete-and-exit"); initial_define_key (Vminibuffer_local_must_match_map, '\t', "minibuffer-complete"); initial_define_key (Vminibuffer_local_must_match_map, ' ', "minibuffer-complete-word"); initial_define_key (Vminibuffer_local_must_match_map, '?', "minibuffer-completion-help"); } emacs-19.30/src/mktime.c100666 12241 1 34362 6032173025 14037 0ustar rolanddaemon/* Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. Contributed by Noel Cragg (noel@cs.oberlin.edu), with fixes by Michael E. Calwas (calwas@ttd.teradyne.com) and Wade Hampton (tasi029@tmn.com). NOTE: The canonical source of this file is maintained with the GNU C Library. Bugs can be reported to bug-glibc@prep.ai.mit.edu. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* Define this to have a standalone program to test this implementation of mktime. */ /* #define DEBUG */ #ifdef HAVE_CONFIG_H #include #endif #include /* Some systems define `time_t' here. */ #include #ifndef __isleap /* Nonzero if YEAR is a leap year (every 4 years, except every 100th isn't, and every 400th is). */ #define __isleap(year) \ ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0)) #endif #ifndef __P #if defined (__GNUC__) || (defined (__STDC__) && __STDC__) #define __P(args) args #else #define __P(args) () #endif /* GCC. */ #endif /* Not __P. */ /* How many days are in each month. */ const unsigned short int __mon_lengths[2][12] = { /* Normal years. */ { 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 }, /* Leap years. */ { 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 } }; static int times_through_search; /* This library routine should never hang -- make sure we always return when we're searching for a value */ #ifdef DEBUG #include #include int debugging_enabled = 0; /* Print the values in a `struct tm'. */ static void printtm (it) struct tm *it; { printf ("%02d/%02d/%04d %02d:%02d:%02d (%s) yday:%03d dst:%d gmtoffset:%ld", it->tm_mon + 1, it->tm_mday, it->tm_year + 1900, it->tm_hour, it->tm_min, it->tm_sec, it->tm_zone, it->tm_yday, it->tm_isdst, it->tm_gmtoff); } #endif static time_t dist_tm (t1, t2) struct tm *t1; struct tm *t2; { time_t distance = 0; unsigned long int v1, v2; int diff_flag = 0; v1 = v2 = 0; #define doit(x, secs) \ v1 += t1->x * secs; \ v2 += t2->x * secs; \ if (!diff_flag) \ { \ if (t1->x < t2->x) \ diff_flag = -1; \ else if (t1->x > t2->x) \ diff_flag = 1; \ } doit (tm_year, 31536000); /* Okay, not all years have 365 days. */ doit (tm_mon, 2592000); /* Okay, not all months have 30 days. */ doit (tm_mday, 86400); doit (tm_hour, 3600); doit (tm_min, 60); doit (tm_sec, 1); #undef doit /* We should also make sure that the sign of DISTANCE is correct -- if DIFF_FLAG is positive, the distance should be positive and vice versa. */ distance = (v1 > v2) ? (v1 - v2) : (v2 - v1); if (diff_flag < 0) distance = -distance; if (times_through_search > 20) /* Arbitrary # of calls, but makes sure we never hang if there's a problem with this algorithm. */ { distance = diff_flag; } /* We need this DIFF_FLAG business because it is forseeable that the distance may be zero when, in actuality, the two structures are different. This is usually the case when the dates are 366 days apart and one of the years is a leap year. */ if (distance == 0 && diff_flag) distance = 86400 * diff_flag; return distance; } /* MKTIME converts the values in a struct tm to a time_t. The values in tm_wday and tm_yday are ignored; other values can be put outside of legal ranges since they will be normalized. This routine takes care of that normalization. */ void do_normalization (tmptr) struct tm *tmptr; { #define normalize(foo,x,y,bar); \ while (tmptr->foo < x) \ { \ tmptr->bar--; \ tmptr->foo = (y - (x - tmptr->foo) + 1); \ } \ while (tmptr->foo > y) \ { \ tmptr->foo = (x + (tmptr->foo - y) - 1); \ tmptr->bar++; \ } normalize (tm_sec, 0, 59, tm_min); normalize (tm_min, 0, 59, tm_hour); normalize (tm_hour, 0, 23, tm_mday); /* Do the month first, so day range can be found. */ normalize (tm_mon, 0, 11, tm_year); /* Since the day range modifies the month, we should be careful how we reference the array of month lengths -- it is possible that the month will go negative, hence the modulo... Also, tm_year is the year - 1900, so we have to 1900 to have it work correctly. */ normalize (tm_mday, 1, __mon_lengths[__isleap (tmptr->tm_year + 1900)] [((tmptr->tm_mon < 0) ? (12 + (tmptr->tm_mon % 12)) : (tmptr->tm_mon % 12)) ], tm_mon); /* Do the month again, because the day may have pushed it out of range. */ normalize (tm_mon, 0, 11, tm_year); /* Do the day again, because the month may have changed the range. */ normalize (tm_mday, 1, __mon_lengths[__isleap (tmptr->tm_year + 1900)] [((tmptr->tm_mon < 0) ? (12 + (tmptr->tm_mon % 12)) : (tmptr->tm_mon % 12)) ], tm_mon); #ifdef DEBUG if (debugging_enabled) { printf (" After normalizing:\n "); printtm (tmptr); putchar ('\n'); } #endif } /* Here's where the work gets done. */ #define BAD_STRUCT_TM ((time_t) -1) time_t __mktime_internal (timeptr, producer) struct tm *timeptr; struct tm *(*producer) __P ((const time_t *, struct tm *)); { struct tm our_tm; /* our working space */ struct tm *me = &our_tm; /* a pointer to the above */ time_t result; /* the value we return */ *me = *timeptr; /* copy the struct tm that was passed in by the caller */ /***************************/ /* Normalize the structure */ /***************************/ /* This routine assumes that the value of TM_ISDST is -1, 0, or 1. If the user didn't pass it in that way, fix it. */ if (me->tm_isdst > 0) me->tm_isdst = 1; else if (me->tm_isdst < 0) me->tm_isdst = -1; do_normalization (me); /* Get out of here if it's not possible to represent this struct. If any of the values in the normalized struct tm are negative, our algorithms won't work. Luckily, we only need to check the year at this point; normalization guarantees that all values will be in correct ranges EXCEPT the year. */ if (me->tm_year < 0) return BAD_STRUCT_TM; /*************************************************/ /* Find the appropriate time_t for the structure */ /*************************************************/ /* Modified b-search -- make intelligent guesses as to where the time might lie along the timeline, assuming that our target time lies a linear distance (w/o considering time jumps of a particular region). Assume that time does not fluctuate at all along the timeline -- e.g., assume that a day will always take 86400 seconds, etc. -- and come up with a hypothetical value for the time_t representation of the struct tm TARGET, in relation to the guess variable -- it should be pretty close! After testing this, the maximum number of iterations that I had on any number that I tried was 3! Not bad. The reason this is not a subroutine is that we will modify some fields in the struct tm (yday and mday). I've never felt good about side-effects when writing structured code... */ { struct tm *guess_tm; struct tm guess_struct; time_t guess = 0; time_t distance = 0; time_t last_distance = 0; times_through_search = 0; do { guess += distance; times_through_search++; guess_tm = (*producer) (&guess, &guess_struct); #ifdef DEBUG if (debugging_enabled) { printf (" Guessing time_t == %d\n ", (int) guess); printtm (guess_tm); putchar ('\n'); } #endif /* How far is our guess from the desired struct tm? */ distance = dist_tm (me, guess_tm); /* Handle periods of time where a period of time is skipped. For example, 2:15 3 April 1994 does not exist, because DST is in effect. The distance function will alternately return values of 3600 and -3600, because it doesn't know that the requested time doesn't exist. In these situations (even if the skip is not exactly an hour) the distances returned will be the same, but alternating in sign. We want the later time, so check to see that the distance is oscillating and we've chosen the correct of the two possibilities. Useful: 3 Apr 94 765356300, 30 Oct 94 783496000 */ if ((distance == -last_distance) && (distance < last_distance)) { /* If the caller specified that the DST flag was off, it's not possible to represent this time. */ if (me->tm_isdst == 0) { #ifdef DEBUG printf (" Distance is oscillating -- dst flag nixes struct!\n"); #endif return BAD_STRUCT_TM; } #ifdef DEBUG printf (" Distance is oscillating -- chose the later time.\n"); #endif distance = 0; } if ((distance == 0) && (me->tm_isdst != -1) && (me->tm_isdst != guess_tm->tm_isdst)) { /* If we're in this code, we've got the right time but the wrong daylight savings flag. We need to move away from the time that we have and approach the other time from the other direction. That is, if I've requested the non-DST version of a time and I get the DST version instead, I want to put us forward in time and search backwards to get the other time. I checked all of the configuration files for the tz package -- no entry saves more than two hours, so I think we'll be safe by moving 24 hours in one direction. IF THE AMOUNT OF TIME SAVED IN THE CONFIGURATION FILES CHANGES, THIS VALUE MAY NEED TO BE ADJUSTED. Luckily, we can never have more than one level of overlaps, or this would never work. */ #define SKIP_VALUE 86400 if (guess_tm->tm_isdst == 0) /* we got the later one, but want the earlier one */ distance = -SKIP_VALUE; else distance = SKIP_VALUE; #ifdef DEBUG printf (" Got the right time, wrong DST value -- adjusting\n"); #endif } last_distance = distance; } while (distance != 0); /* Check to see that the dst flag matches */ if (me->tm_isdst != -1) { if (me->tm_isdst != guess_tm->tm_isdst) { #ifdef DEBUG printf (" DST flag doesn't match! FIXME?\n"); #endif return BAD_STRUCT_TM; } } result = guess; /* Success! */ /* On successful completion, the values of tm_wday and tm_yday have to be set appropriately. */ /* me->tm_yday = guess_tm->tm_yday; me->tm_mday = guess_tm->tm_mday; */ *me = *guess_tm; } /* Update the caller's version of the structure */ *timeptr = *me; return result; } #if ! HAVE_LOCALTIME_R && ! defined (localtime_r) #ifdef _LIBC #define localtime_r __localtime_r #else /* Approximate localtime_r as best we can in its absence. */ #define localtime_r my_localtime_r /* Avoid clash with system localtime_r. */ static struct tm * localtime_r (t, tp) const time_t *t; struct tm *tp; { struct tm *l = localtime (t); if (! l) return 0; *tp = *l; return tp; } #endif /* ! _LIBC */ #endif /* ! HAVE_LOCALTIME_R && ! defined (localtime_r) */ time_t #ifdef DEBUG /* make it work even if the system's libc has it's own mktime routine */ my_mktime (timeptr) #else mktime (timeptr) #endif struct tm *timeptr; { return __mktime_internal (timeptr, localtime_r); } #ifdef weak_alias weak_alias (mktime, timelocal) #endif #ifdef DEBUG void main (argc, argv) int argc; char *argv[]; { int time; int result_time; struct tm *tmptr; if (argc == 1) { long q; printf ("starting long test...\n"); for (q = 10000000; q < 1000000000; q += 599) { struct tm *tm = localtime ((time_t *) &q); if ((q % 10000) == 0) { printf ("%ld\n", q); fflush (stdout); } if (q != my_mktime (tm)) { printf ("failed for %ld\n", q); fflush (stdout); } } printf ("test finished\n"); exit (0); } if (argc != 2) { printf ("wrong # of args\n"); exit (0); } debugging_enabled = 1; /* We want to see the info */ ++argv; time = atoi (*argv); tmptr = localtime ((time_t *) &time); printf ("Localtime tells us that a time_t of %d represents\n ", time); printtm (tmptr); putchar ('\n'); printf (" Given localtime's return val, mktime returns %d which is\n ", (int) my_mktime (tmptr)); printtm (tmptr); putchar ('\n'); #if 0 tmptr->tm_sec -= 20; tmptr->tm_min -= 20; tmptr->tm_hour -= 20; tmptr->tm_mday -= 20; tmptr->tm_mon -= 20; tmptr->tm_year -= 20; tmptr->tm_gmtoff -= 20000; /* This has no effect! */ tmptr->tm_zone = NULL; /* Nor does this! */ tmptr->tm_isdst = -1; #endif tmptr->tm_hour += 1; tmptr->tm_isdst = -1; printf ("\n\nchanged ranges: "); printtm (tmptr); putchar ('\n'); result_time = my_mktime (tmptr); printf ("\nmktime: %d\n", result_time); tmptr->tm_isdst = 0; printf ("\n\nchanged ranges: "); printtm (tmptr); putchar ('\n'); result_time = my_mktime (tmptr); printf ("\nmktime: %d\n", result_time); } #endif /* DEBUG */ /* Local Variables: compile-command: "gcc -g mktime.c -o mktime -DDEBUG" End: */ emacs-19.30/src/mocklisp.c100444 75424 1 13643 5770115136 14112 0ustar kwzhdaemon/* Mocklisp compatibility functions for GNU Emacs Lisp interpreter. Copyright (C) 1985, 1986, 1995 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. */ /* Compatibility for mocklisp */ #include #include "lisp.h" #include "buffer.h" /* Now in lisp code ("macrocode...") * DEFUN ("ml-defun", Fml_defun, Sml_defun, 0, UNEVALLED, 0, * "Define mocklisp functions") * (args) * Lisp_Object args; * { * Lisp_Object elt; * * while (!NILP (args)) * { * elt = Fcar (args); * Ffset (Fcar (elt), Fcons (Qmocklisp, Fcdr (elt))); * args = Fcdr (args); * } * return Qnil; * } */ DEFUN ("ml-if", Fml_if, Sml_if, 0, UNEVALLED, 0, "Mocklisp version of `if'.") (args) Lisp_Object args; { register Lisp_Object val; struct gcpro gcpro1; GCPRO1 (args); while (!NILP (args)) { val = Feval (Fcar (args)); args = Fcdr (args); if (NILP (args)) break; if (XINT (val)) { val = Feval (Fcar (args)); break; } args = Fcdr (args); } UNGCPRO; return val; } /* Now converted to regular "while" by hairier conversion code. * DEFUN ("ml-while", Fml_while, Sml_while, 1, UNEVALLED, 0, "while for mocklisp programs") * (args) * Lisp_Object args; * { * Lisp_Object test, body, tem; * struct gcpro gcpro1, gcpro2; * * GCPRO2 (test, body); * * test = Fcar (args); * body = Fcdr (args); * while (tem = Feval (test), XINT (tem)) * { * QUIT; * Fprogn (body); * } * * UNGCPRO; * return Qnil; *} /* This is the main entry point to mocklisp execution. When eval sees a mocklisp function being called, it calls here with the unevaluated argument list */ Lisp_Object ml_apply (function, args) Lisp_Object function, args; { register int count = specpdl_ptr - specpdl; register Lisp_Object val; specbind (Qmocklisp_arguments, args); val = Fprogn (Fcdr (function)); return unbind_to (count, val); } DEFUN ("ml-nargs", Fml_nargs, Sml_nargs, 0, 0, 0, "Number of arguments to currently executing mocklisp function.") () { if (EQ (Vmocklisp_arguments, Qinteractive)) return make_number (0); return Flength (Vmocklisp_arguments); } DEFUN ("ml-arg", Fml_arg, Sml_arg, 1, 2, 0, "Argument number N to currently executing mocklisp function.") (n, prompt) Lisp_Object n, prompt; { if (EQ (Vmocklisp_arguments, Qinteractive)) return Fread_string (prompt, Qnil); CHECK_NUMBER (n, 0); XSETINT (n, XINT (n) - 1); /* Mocklisp likes to be origin-1 */ return Fcar (Fnthcdr (n, Vmocklisp_arguments)); } DEFUN ("ml-interactive", Fml_interactive, Sml_interactive, 0, 0, 0, "True if currently executing mocklisp function was called interactively.") () { return (EQ (Vmocklisp_arguments, Qinteractive)) ? Qt : Qnil; } DEFUN ("ml-provide-prefix-argument", Fml_provide_prefix_argument, Sml_provide_prefix_argument, 2, UNEVALLED, 0, "Evaluate second argument, using first argument as prefix arg value.") (args) Lisp_Object args; { struct gcpro gcpro1; GCPRO1 (args); Vcurrent_prefix_arg = Feval (Fcar (args)); UNGCPRO; return Feval (Fcar (Fcdr (args))); } DEFUN ("ml-prefix-argument-loop", Fml_prefix_argument_loop, Sml_prefix_argument_loop, 0, UNEVALLED, 0, "") (args) Lisp_Object args; { register Lisp_Object tem; register int i; struct gcpro gcpro1; /* Set `arg' in case we call a built-in function that looks at it. Still are a few. */ if (NILP (Vcurrent_prefix_arg)) i = 1; else { tem = Vcurrent_prefix_arg; if (CONSP (tem)) tem = Fcar (tem); if (EQ (tem, Qminus)) i = -1; else i = XINT (tem); } GCPRO1 (args); while (i-- > 0) Fprogn (args); UNGCPRO; return Qnil; } #if 0 /* Now in mlsupport.el */ DEFUN ("ml-substr", Fml_substr, Sml_substr, 3, 3, 0, "Return a substring of STRING, starting at index FROM and of length LENGTH.\n\ If either FROM or LENGTH is negative, the length of STRING is added to it.") (string, from, to) Lisp_Object string, from, to; { CHECK_STRING (string, 0); CHECK_NUMBER (from, 1); CHECK_NUMBER (to, 2); if (XINT (from) < 0) XSETINT (from, XINT (from) + XSTRING (string)->size); if (XINT (to) < 0) XSETINT (to, XINT (to) + XSTRING (string)->size); XSETINT (to, XINT (to) + XINT (from)); return Fsubstring (string, from, to); } #endif /* 0 */ DEFUN ("insert-string", Finsert_string, Sinsert_string, 0, MANY, 0, "Mocklisp-compatibility insert function.\n\ Like the function `insert' except that any argument that is a number\n\ is converted into a string by expressing it in decimal.") (nargs, args) int nargs; Lisp_Object *args; { register int argnum; register Lisp_Object tem; for (argnum = 0; argnum < nargs; argnum++) { tem = args[argnum]; retry: if (INTEGERP (tem)) tem = Fnumber_to_string (tem); if (STRINGP (tem)) insert1 (tem); else { tem = wrong_type_argument (Qstringp, tem); goto retry; } } return Qnil; } syms_of_mocklisp () { Qmocklisp = intern ("mocklisp"); staticpro (&Qmocklisp); /*defsubr (&Sml_defun);*/ defsubr (&Sml_if); /*defsubr (&Sml_while);*/ defsubr (&Sml_arg); defsubr (&Sml_nargs); defsubr (&Sml_interactive); defsubr (&Sml_provide_prefix_argument); defsubr (&Sml_prefix_argument_loop); /*defsubr (&Sml_substr);*/ defsubr (&Sinsert_string); } emacs-19.30/src/msdos.c100444 12120 1 166411 6055503377 13243 0ustar rmsdaemon/* MS-DOS specific C utilities. Copyright (C) 1993, 1994, 1995 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. */ /* Contributed by Morten Welinder */ /* New display, keyboard, and mouse control by Kim F. Storm */ /* Note: some of the stuff here was taken from end of sysdep.c in demacs. */ #include #ifdef MSDOS #include "lisp.h" #include #include #include #include #include #include "dosfns.h" #include "msdos.h" #include "systime.h" #include "termhooks.h" #include "dispextern.h" #include "termopts.h" #include "frame.h" #include "window.h" #include #include #include /* #include */ /* Damn that local process.h! Instead we can define P_WAIT ourselves. */ #define P_WAIT 1 static unsigned long event_timestamp () { struct time t; unsigned long s; gettime (&t); s = t.ti_min; s *= 60; s += t.ti_sec; s *= 1000; s += t.ti_hund * 10; return s; } /* ------------------------ Mouse control --------------------------- * * Coordinates are in screen positions and zero based. * Mouse buttons are numbered from left to right and also zero based. */ int have_mouse; /* 0: no, 1: enabled, -1: disabled */ static int mouse_visible; static int mouse_last_x; static int mouse_last_y; static int mouse_button_translate[NUM_MOUSE_BUTTONS]; static int mouse_button_count; void mouse_on () { union REGS regs; if (have_mouse > 0 && !mouse_visible) { if (termscript) fprintf (termscript, ""); regs.x.ax = 0x0001; int86 (0x33, ®s, ®s); mouse_visible = 1; } } void mouse_off () { union REGS regs; if (have_mouse > 0 && mouse_visible) { if (termscript) fprintf (termscript, ""); regs.x.ax = 0x0002; int86 (0x33, ®s, ®s); mouse_visible = 0; } } void mouse_moveto (x, y) int x, y; { union REGS regs; if (termscript) fprintf (termscript, "", x, y); regs.x.ax = 0x0004; mouse_last_x = regs.x.cx = x * 8; mouse_last_y = regs.x.dx = y * 8; int86 (0x33, ®s, ®s); } static int mouse_pressed (b, xp, yp) int b, *xp, *yp; { union REGS regs; if (b >= mouse_button_count) return 0; regs.x.ax = 0x0005; regs.x.bx = mouse_button_translate[b]; int86 (0x33, ®s, ®s); if (regs.x.bx) *xp = regs.x.cx / 8, *yp = regs.x.dx / 8; return (regs.x.bx != 0); } static int mouse_released (b, xp, yp) int b, *xp, *yp; { union REGS regs; if (b >= mouse_button_count) return 0; regs.x.ax = 0x0006; regs.x.bx = mouse_button_translate[b]; int86 (0x33, ®s, ®s); if (regs.x.bx) *xp = regs.x.cx / 8, *yp = regs.x.dx / 8; return (regs.x.bx != 0); } static void mouse_get_xy (int *x, int *y) { union REGS regs; regs.x.ax = 0x0003; int86 (0x33, ®s, ®s); *x = regs.x.cx / 8; *y = regs.x.dx / 8; } void mouse_get_pos (f, insist, bar_window, part, x, y, time) FRAME_PTR *f; int insist; Lisp_Object *bar_window, *x, *y; enum scroll_bar_part *part; unsigned long *time; { int ix, iy; union REGS regs; regs.x.ax = 0x0003; int86 (0x33, ®s, ®s); *f = selected_frame; *bar_window = Qnil; mouse_get_xy (&ix, &iy); selected_frame->mouse_moved = 0; *x = make_number (ix); *y = make_number (iy); *time = event_timestamp (); } static void mouse_check_moved () { int x, y; mouse_get_xy (&x, &y); selected_frame->mouse_moved |= (x != mouse_last_x || y != mouse_last_y); mouse_last_x = x; mouse_last_y = y; } void mouse_init () { union REGS regs; if (termscript) fprintf (termscript, ""); regs.x.ax = 0x0021; int86 (0x33, ®s, ®s); regs.x.ax = 0x0007; regs.x.cx = 0; regs.x.dx = 8 * (ScreenCols () - 1); int86 (0x33, ®s, ®s); regs.x.ax = 0x0008; regs.x.cx = 0; regs.x.dx = 8 * (ScreenRows () - 1); int86 (0x33, ®s, ®s); mouse_moveto (0, 0); mouse_visible = 0; } /* ------------------------- Screen control ---------------------- * */ static int internal_terminal = 0; #ifndef HAVE_X_WINDOWS extern unsigned char ScreenAttrib; static int screen_face; static int highlight; static int screen_size_X; static int screen_size_Y; static int screen_size; static int current_pos_X; static int current_pos_Y; static int new_pos_X; static int new_pos_Y; static void *startup_screen_buffer; static int startup_screen_size_X; static int startup_screen_size_Y; static int startup_pos_X; static int startup_pos_Y; static int term_setup_done; /* Similar to the_only_frame. */ struct x_output the_only_x_display; /* This is never dereferenced. */ Display *x_current_display; #define SCREEN_SET_CURSOR() \ if (current_pos_X != new_pos_X || current_pos_Y != new_pos_Y) \ ScreenSetCursor (current_pos_Y = new_pos_Y, current_pos_X = new_pos_X) static dos_direct_output (y, x, buf, len) int y; int x; char *buf; int len; { int t = (int) ScreenPrimary + 2 * (x + y * screen_size_X); while (--len >= 0) { dosmemput (buf++, 1, t); t += 2; } } #endif /* Flash the screen as a substitute for BEEPs. */ #if (__DJGPP__ < 2) static void do_visible_bell (xorattr) unsigned char xorattr; { asm volatile (" movb $1,%%dl visible_bell_0: movl _ScreenPrimary,%%eax call dosmemsetup movl %%eax,%%ebx movl %1,%%ecx movb %0,%%al incl %%ebx visible_bell_1: xorb %%al,%%gs:(%%ebx) addl $2,%%ebx decl %%ecx jne visible_bell_1 decb %%dl jne visible_bell_3 visible_bell_2: movzwl %%ax,%%eax movzwl %%ax,%%eax movzwl %%ax,%%eax movzwl %%ax,%%eax decw %%cx jne visible_bell_2 jmp visible_bell_0 visible_bell_3:" : /* no output */ : "m" (xorattr), "g" (screen_size) : "%eax", "%ebx", /* "%gs",*/ "%ecx", "%edx"); } static void ScreenVisualBell (void) { /* This creates an xor-mask that will swap the default fore- and background colors. */ do_visible_bell (((the_only_x_display.foreground_pixel ^ the_only_x_display.background_pixel) * 0x11) & 0x7f); } #endif #ifndef HAVE_X_WINDOWS /* * If we write a character in the position where the mouse is, * the mouse cursor may need to be refreshed. */ static void mouse_off_maybe () { int x, y; if (!mouse_visible) return; mouse_get_xy (&x, &y); if (y != new_pos_Y || x < new_pos_X) return; mouse_off (); } static IT_ring_bell () { if (visible_bell) { mouse_off (); ScreenVisualBell (); } else { union REGS inregs, outregs; inregs.h.ah = 2; inregs.h.dl = 7; intdos (&inregs, &outregs); } } static void IT_set_face (int face) { struct face *fp; extern struct face *intern_face (/* FRAME_PTR, struct face * */); if (face == 1 || (face == 0 && highlight)) fp = FRAME_MODE_LINE_FACE (foo); else if (face <= 0 || face >= FRAME_N_COMPUTED_FACES (foo)) fp = FRAME_DEFAULT_FACE (foo); else fp = intern_face (selected_frame, FRAME_COMPUTED_FACES (foo)[face]); if (termscript) fprintf (termscript, "", FACE_FOREGROUND (fp), FACE_BACKGROUND (fp)); screen_face = face; ScreenAttrib = (FACE_BACKGROUND (fp) << 4) | FACE_FOREGROUND (fp); } static IT_write_glyphs (GLYPH *str, int len) { int newface; int ch, l = len; unsigned char *buf, *bp; if (len == 0) return; buf = bp = alloca (len * 2); while (--l >= 0) { newface = FAST_GLYPH_FACE (*str); if (newface != screen_face) IT_set_face (newface); ch = FAST_GLYPH_CHAR (*str); *bp++ = (unsigned char)ch; *bp++ = ScreenAttrib; if (termscript) fputc (ch, termscript); str++; } mouse_off_maybe (); dosmemput (buf, 2 * len, (int)ScreenPrimary + 2 * (new_pos_X + screen_size_X * new_pos_Y)); new_pos_X += len; } static IT_clear_end_of_line (first_unused) { char *spaces, *sp; int i, j; IT_set_face (0); if (termscript) fprintf (termscript, ""); i = (j = screen_size_X - new_pos_X) * 2; spaces = sp = alloca (i); while (--j >= 0) { *sp++ = ' '; *sp++ = ScreenAttrib; } mouse_off_maybe (); dosmemput (spaces, i, (int)ScreenPrimary + 2 * (new_pos_X + screen_size_X * new_pos_Y)); } static IT_clear_screen (void) { if (termscript) fprintf (termscript, ""); IT_set_face (0); mouse_off (); ScreenClear (); new_pos_X = new_pos_Y = 0; } static IT_clear_to_end (void) { if (termscript) fprintf (termscript, ""); while (new_pos_Y < screen_size_Y) { new_pos_X = 0; IT_clear_end_of_line (0); new_pos_Y++; } } static IT_cursor_to (int y, int x) { if (termscript) fprintf (termscript, "\n", x, y); new_pos_X = x; new_pos_Y = y; } static IT_reassert_line_highlight (new, vpos) int new, vpos; { highlight = new; IT_set_face (0); /* To possibly clear the highlighting. */ } static IT_change_line_highlight (new_highlight, vpos, first_unused_hpos) { highlight = new_highlight; IT_set_face (0); /* To possibly clear the highlighting. */ IT_cursor_to (vpos, 0); IT_clear_end_of_line (first_unused_hpos); } static IT_update_begin () { highlight = 0; IT_set_face (0); /* To possibly clear the highlighting. */ screen_face = -1; } static IT_update_end () { } /* This was more or less copied from xterm.c */ static void IT_set_menu_bar_lines (window, n) Lisp_Object window; int n; { struct window *w = XWINDOW (window); XSETFASTINT (w->last_modified, 0); XSETFASTINT (w->top, XFASTINT (w->top) + n); XSETFASTINT (w->height, XFASTINT (w->height) - n); /* Handle just the top child in a vertical split. */ if (!NILP (w->vchild)) IT_set_menu_bar_lines (w->vchild, n); /* Adjust all children in a horizontal split. */ for (window = w->hchild; !NILP (window); window = w->next) { w = XWINDOW (window); IT_set_menu_bar_lines (window, n); } } /* * IT_set_terminal_modes is called when emacs is started, * resumed, and whenever the screen is redrawn! */ static IT_set_terminal_modes (void) { char *colors; FRAME_PTR f; struct face *fp; if (termscript) fprintf (termscript, "\n"); highlight = 0; screen_size_X = ScreenCols (); screen_size_Y = ScreenRows (); screen_size = screen_size_X * screen_size_Y; new_pos_X = new_pos_Y = 0; current_pos_X = current_pos_Y = -1; if (term_setup_done) return; term_setup_done = 1; startup_screen_size_X = screen_size_X; startup_screen_size_Y = screen_size_Y; ScreenGetCursor (&startup_pos_Y, &startup_pos_X); ScreenRetrieve (startup_screen_buffer = xmalloc (screen_size * 2)); if (termscript) fprintf (termscript, "\n"); } /* * IT_reset_terminal_modes is called when emacs is * suspended or killed. */ static IT_reset_terminal_modes (void) { if (termscript) fprintf (termscript, "\n"); highlight = 0; if (!term_setup_done) return; ScreenUpdate (startup_screen_buffer); ScreenSetCursor (startup_pos_Y, startup_pos_X); xfree (startup_screen_buffer); if (termscript) fprintf (termscript, "\n"); term_setup_done = 0; } static IT_set_terminal_window (void) { } void IT_set_frame_parameters (frame, alist) FRAME_PTR frame; Lisp_Object alist; { Lisp_Object tail; int redraw; extern unsigned long load_color (); FRAME_PTR f = (FRAME_PTR) &the_only_frame; redraw = 0; for (tail = alist; CONSP (tail); tail = Fcdr (tail)) { Lisp_Object elt, prop, val; elt = Fcar (tail); prop = Fcar (elt); val = Fcdr (elt); CHECK_SYMBOL (prop, 1); if (EQ (prop, intern ("foreground-color"))) { unsigned long new_color = load_color (f, val); if (new_color != ~0) { FRAME_FOREGROUND_PIXEL (f) = new_color; redraw = 1; } } else if (EQ (prop, intern ("background-color"))) { unsigned long new_color = load_color (f, val); if (new_color != ~0) { FRAME_BACKGROUND_PIXEL (f) = new_color & ~8; redraw = 1; } } else if (EQ (prop, intern ("menu-bar-lines"))) { int new; int old = FRAME_MENU_BAR_LINES (the_only_frame); if (INTEGERP (val)) new = XINT (val); else new = 0; FRAME_MENU_BAR_LINES (f) = new; IT_set_menu_bar_lines (the_only_frame.root_window, new - old); } } if (redraw) { recompute_basic_faces (f); Fredraw_frame (Fselected_frame ()); } } #endif /* !HAVE_X_WINDOWS */ /* Do we need the internal terminal? */ void internal_terminal_init () { char *term = getenv ("TERM"); char *colors; #ifdef HAVE_X_WINDOWS if (!inhibit_window_system) return; #endif internal_terminal = (!noninteractive) && term && !strcmp (term, "internal"); if (getenv ("EMACSTEST")) termscript = fopen (getenv ("EMACSTEST"), "wt"); #ifndef HAVE_X_WINDOWS if (!internal_terminal || inhibit_window_system) { the_only_frame.output_method = output_termcap; return; } Vwindow_system = intern ("pc"); Vwindow_system_version = make_number (1); bzero (&the_only_x_display, sizeof the_only_x_display); the_only_x_display.background_pixel = 7; /* White */ the_only_x_display.foreground_pixel = 0; /* Black */ colors = getenv ("EMACSCOLORS"); if (colors && strlen (colors) >= 2) { the_only_x_display.foreground_pixel = colors[0] & 0x07; the_only_x_display.background_pixel = colors[1] & 0x07; } the_only_x_display.line_height = 1; the_only_frame.output_data.x = &the_only_x_display; the_only_frame.output_method = output_msdos_raw; the_only_x_display.font = (XFontStruct *)1; /* must *not* be zero */ init_frame_faces ((FRAME_PTR) &the_only_frame); ring_bell_hook = IT_ring_bell; write_glyphs_hook = IT_write_glyphs; cursor_to_hook = raw_cursor_to_hook = IT_cursor_to; clear_to_end_hook = IT_clear_to_end; clear_end_of_line_hook = IT_clear_end_of_line; clear_frame_hook = IT_clear_screen; change_line_highlight_hook = IT_change_line_highlight; update_begin_hook = IT_update_begin; update_end_hook = IT_update_end; reassert_line_highlight_hook = IT_reassert_line_highlight; /* These hooks are called by term.c without being checked. */ set_terminal_modes_hook = IT_set_terminal_modes; reset_terminal_modes_hook = IT_reset_terminal_modes; set_terminal_window_hook = IT_set_terminal_window; #endif } dos_get_saved_screen (screen, rows, cols) char **screen; int *rows; int *cols; { #ifndef HAVE_X_WINDOWS *screen = startup_screen_buffer; *cols = startup_screen_size_X; *rows = startup_screen_size_Y; return 1; #else return 0; #endif } /* ----------------------- Keyboard control ---------------------- * * Keymaps reflect the following keyboard layout: * * 0 1 2 3 4 5 6 7 8 9 10 11 12 BS * TAB 15 16 17 18 19 20 21 22 23 24 25 26 (41) * CLOK 30 31 32 33 34 35 36 37 38 39 40 (41) RET * SH () 45 46 47 48 49 50 51 52 53 54 SHIFT * SPACE */ static int extended_kbd; /* 101 (102) keyboard present. */ struct dos_keyboard_map { char *unshifted; char *shifted; char *alt_gr; }; static struct dos_keyboard_map us_keyboard = { /* 0 1 2 3 4 5 */ /* 01234567890123456789012345678901234567890 12345678901234 */ "`1234567890-= qwertyuiop[] asdfghjkl;'\\ zxcvbnm,./ ", /* 0123456789012345678901234567890123456789 012345678901234 */ "~!@#$%^&*()_+ QWERTYUIOP{} ASDFGHJKL:\"| ZXCVBNM<>? ", 0 /* no Alt-Gr key */ }; static struct dos_keyboard_map fr_keyboard = { /* 0 1 2 3 4 5 */ /* 012 3456789012345678901234567890123456789012345678901234 */ "ý&‚\",(-Š_€…)= azertyuiop^$ qsdfghjklm—* wxcvbnm;:! ", /* 0123456789012345678901234567890123456789012345678901234 */ " 1234567890ø+ AZERTYUIOPùœ QSDFGHJKLM%æ WXCVBN?./õ ", /* 01234567 89012345678901234567890123456789012345678901234 */ " ~#{[|`\\^@]} Ï " }; static struct dos_keyboard_map dk_keyboard = { /* 0 1 2 3 4 5 */ /* 0123456789012345678901234567890123456789012345678901234 */ "«1234567890+| qwertyuiop†~ asdfghjkl‘›' zxcvbnm,.- ", /* 01 23456789012345678901234567890123456789012345678901234 */ "õ!\"#$%&/()=?` QWERTYUIOP^ ASDFGHJKL’* ZXCVBNM;:_ ", /* 0123456789012345678901234567890123456789012345678901234 */ " @œ$ {[]} | " }; static struct keyboard_layout_list { int country_code; struct dos_keyboard_map *keyboard_map; } keyboard_layout_list[] = { 1, &us_keyboard, 33, &fr_keyboard, 45, &dk_keyboard }; static struct dos_keyboard_map *keyboard; static int keyboard_map_all; int dos_set_keyboard (code, always) int code; int always; { int i; /* Initialize to US settings, for countries that don't have their own. */ keyboard = keyboard_layout_list[0].keyboard_map; keyboard_map_all = always; dos_keyboard_layout = 1; for (i = 0; i < (sizeof (keyboard_layout_list)/sizeof (struct keyboard_layout_list)); i++) if (code == keyboard_layout_list[i].country_code) { keyboard = keyboard_layout_list[i].keyboard_map; keyboard_map_all = always; dos_keyboard_layout = code; return 1; } return 0; } #define Ignore 0x0000 #define Normal 0x0000 /* normal key - alt changes scan-code */ #define FctKey 0x1000 /* func key if c == 0, else c */ #define Special 0x2000 /* func key even if c != 0 */ #define ModFct 0x3000 /* special if mod-keys, else 'c' */ #define Map 0x4000 /* alt scan-code, map to unshift/shift key */ #define KeyPad 0x5000 /* map to insert/kp-0 depending on c == 0xe0 */ #define Grey 0x6000 /* Grey keypad key */ #define Alt 0x0100 /* alt scan-code */ #define Ctrl 0x0200 /* ctrl scan-code */ #define Shift 0x0400 /* shift scan-code */ static struct { unsigned char char_code; /* normal code */ unsigned char meta_code; /* M- code */ unsigned char keypad_code; /* keypad code */ unsigned char editkey_code; /* edit key */ } keypad_translate_map[] = { '0', '0', 0xb0, /* kp-0 */ 0x63, /* insert */ '1', '1', 0xb1, /* kp-1 */ 0x57, /* end */ '2', '2', 0xb2, /* kp-2 */ 0x54, /* down */ '3', '3', 0xb3, /* kp-3 */ 0x56, /* next */ '4', '4', 0xb4, /* kp-4 */ 0x51, /* left */ '5', '5', 0xb5, /* kp-5 */ 0xb5, /* kp-5 */ '6', '6', 0xb6, /* kp-6 */ 0x53, /* right */ '7', '7', 0xb7, /* kp-7 */ 0x50, /* home */ '8', '8', 0xb8, /* kp-8 */ 0x52, /* up */ '9', '9', 0xb9, /* kp-9 */ 0x55, /* prior */ '.', '-', 0xae, /* kp-decimal */ 0xff /* delete */ }; static struct { unsigned char char_code; /* normal code */ unsigned char keypad_code; /* keypad code */ } grey_key_translate_map[] = { '/', 0xaf, /* kp-decimal */ '*', 0xaa, /* kp-multiply */ '-', 0xad, /* kp-subtract */ '+', 0xab, /* kp-add */ '\r', 0x8d /* kp-enter */ }; static unsigned short ibmpc_translate_map[] = { /* --------------- 00 to 0f --------------- */ Normal | 0xff, /* Ctrl Break + Alt-NNN */ Alt | ModFct | 0x1b, /* Escape */ Normal | 1, /* '1' */ Normal | 2, /* '2' */ Normal | 3, /* '3' */ Normal | 4, /* '4' */ Normal | 5, /* '5' */ Normal | 6, /* '6' */ Normal | 7, /* '7' */ Normal | 8, /* '8' */ Normal | 9, /* '9' */ Normal | 10, /* '0' */ Normal | 11, /* '-' */ Normal | 12, /* '=' */ Special | 0x08, /* Backspace */ ModFct | 0x74, /* Tab/Backtab */ /* --------------- 10 to 1f --------------- */ Map | 15, /* 'q' */ Map | 16, /* 'w' */ Map | 17, /* 'e' */ Map | 18, /* 'r' */ Map | 19, /* 't' */ Map | 20, /* 'y' */ Map | 21, /* 'u' */ Map | 22, /* 'i' */ Map | 23, /* 'o' */ Map | 24, /* 'p' */ Map | 25, /* '[' */ Map | 26, /* ']' */ ModFct | 0x0d, /* Return */ Ignore, /* Ctrl */ Map | 30, /* 'a' */ Map | 31, /* 's' */ /* --------------- 20 to 2f --------------- */ Map | 32, /* 'd' */ Map | 33, /* 'f' */ Map | 34, /* 'g' */ Map | 35, /* 'h' */ Map | 36, /* 'j' */ Map | 37, /* 'k' */ Map | 38, /* 'l' */ Map | 39, /* ';' */ Map | 40, /* '\'' */ Map | 0, /* '`' */ Ignore, /* Left shift */ Map | 41, /* '\\' */ Map | 45, /* 'z' */ Map | 46, /* 'x' */ Map | 47, /* 'c' */ Map | 48, /* 'v' */ /* --------------- 30 to 3f --------------- */ Map | 49, /* 'b' */ Map | 50, /* 'n' */ Map | 51, /* 'm' */ Map | 52, /* ',' */ Map | 53, /* '.' */ Map | 54, /* '/' */ Ignore, /* Right shift */ Grey | 1, /* Grey * */ Ignore, /* Alt */ Normal | ' ', /* ' ' */ Ignore, /* Caps Lock */ FctKey | 0xbe, /* F1 */ FctKey | 0xbf, /* F2 */ FctKey | 0xc0, /* F3 */ FctKey | 0xc1, /* F4 */ FctKey | 0xc2, /* F5 */ /* --------------- 40 to 4f --------------- */ FctKey | 0xc3, /* F6 */ FctKey | 0xc4, /* F7 */ FctKey | 0xc5, /* F8 */ FctKey | 0xc6, /* F9 */ FctKey | 0xc7, /* F10 */ Ignore, /* Num Lock */ Ignore, /* Scroll Lock */ KeyPad | 7, /* Home */ KeyPad | 8, /* Up */ KeyPad | 9, /* Page Up */ Grey | 2, /* Grey - */ KeyPad | 4, /* Left */ KeyPad | 5, /* Keypad 5 */ KeyPad | 6, /* Right */ Grey | 3, /* Grey + */ KeyPad | 1, /* End */ /* --------------- 50 to 5f --------------- */ KeyPad | 2, /* Down */ KeyPad | 3, /* Page Down */ KeyPad | 0, /* Insert */ KeyPad | 10, /* Delete */ Shift | FctKey | 0xbe, /* (Shift) F1 */ Shift | FctKey | 0xbf, /* (Shift) F2 */ Shift | FctKey | 0xc0, /* (Shift) F3 */ Shift | FctKey | 0xc1, /* (Shift) F4 */ Shift | FctKey | 0xc2, /* (Shift) F5 */ Shift | FctKey | 0xc3, /* (Shift) F6 */ Shift | FctKey | 0xc4, /* (Shift) F7 */ Shift | FctKey | 0xc5, /* (Shift) F8 */ Shift | FctKey | 0xc6, /* (Shift) F9 */ Shift | FctKey | 0xc7, /* (Shift) F10 */ Ctrl | FctKey | 0xbe, /* (Ctrl) F1 */ Ctrl | FctKey | 0xbf, /* (Ctrl) F2 */ /* --------------- 60 to 6f --------------- */ Ctrl | FctKey | 0xc0, /* (Ctrl) F3 */ Ctrl | FctKey | 0xc1, /* (Ctrl) F4 */ Ctrl | FctKey | 0xc2, /* (Ctrl) F5 */ Ctrl | FctKey | 0xc3, /* (Ctrl) F6 */ Ctrl | FctKey | 0xc4, /* (Ctrl) F7 */ Ctrl | FctKey | 0xc5, /* (Ctrl) F8 */ Ctrl | FctKey | 0xc6, /* (Ctrl) F9 */ Ctrl | FctKey | 0xc7, /* (Ctrl) F10 */ Alt | FctKey | 0xbe, /* (Alt) F1 */ Alt | FctKey | 0xbf, /* (Alt) F2 */ Alt | FctKey | 0xc0, /* (Alt) F3 */ Alt | FctKey | 0xc1, /* (Alt) F4 */ Alt | FctKey | 0xc2, /* (Alt) F5 */ Alt | FctKey | 0xc3, /* (Alt) F6 */ Alt | FctKey | 0xc4, /* (Alt) F7 */ Alt | FctKey | 0xc5, /* (Alt) F8 */ /* --------------- 70 to 7f --------------- */ Alt | FctKey | 0xc6, /* (Alt) F9 */ Alt | FctKey | 0xc7, /* (Alt) F10 */ Ctrl | FctKey | 0x6d, /* (Ctrl) Sys Rq */ Ctrl | KeyPad | 4, /* (Ctrl) Left */ Ctrl | KeyPad | 6, /* (Ctrl) Right */ Ctrl | KeyPad | 1, /* (Ctrl) End */ Ctrl | KeyPad | 3, /* (Ctrl) Page Down */ Ctrl | KeyPad | 7, /* (Ctrl) Home */ Alt | Map | 1, /* '1' */ Alt | Map | 2, /* '2' */ Alt | Map | 3, /* '3' */ Alt | Map | 4, /* '4' */ Alt | Map | 5, /* '5' */ Alt | Map | 6, /* '6' */ Alt | Map | 7, /* '7' */ Alt | Map | 8, /* '8' */ /* --------------- 80 to 8f --------------- */ Alt | Map | 9, /* '9' */ Alt | Map | 10, /* '0' */ Alt | Map | 11, /* '-' */ Alt | Map | 12, /* '=' */ Ctrl | KeyPad | 9, /* (Ctrl) Page Up */ FctKey | 0xc8, /* F11 */ FctKey | 0xc9, /* F12 */ Shift | FctKey | 0xc8, /* (Shift) F11 */ Shift | FctKey | 0xc9, /* (Shift) F12 */ Ctrl | FctKey | 0xc8, /* (Ctrl) F11 */ Ctrl | FctKey | 0xc9, /* (Ctrl) F12 */ Alt | FctKey | 0xc8, /* (Alt) F11 */ Alt | FctKey | 0xc9, /* (Alt) F12 */ Ctrl | KeyPad | 8, /* (Ctrl) Up */ Ctrl | Grey | 2, /* (Ctrl) Grey - */ Ctrl | KeyPad | 5, /* (Ctrl) Keypad 5 */ /* --------------- 90 to 9f --------------- */ Ctrl | Grey | 3, /* (Ctrl) Grey + */ Ctrl | KeyPad | 2, /* (Ctrl) Down */ Ctrl | KeyPad | 0, /* (Ctrl) Insert */ Ctrl | KeyPad | 10, /* (Ctrl) Delete */ Ctrl | FctKey | 0x09, /* (Ctrl) Tab */ Ctrl | Grey | 0, /* (Ctrl) Grey / */ Ctrl | Grey | 1, /* (Ctrl) Grey * */ Alt | FctKey | 0x50, /* (Alt) Home */ Alt | FctKey | 0x52, /* (Alt) Up */ Alt | FctKey | 0x55, /* (Alt) Page Up */ Ignore, /* NO KEY */ Alt | FctKey | 0x51, /* (Alt) Left */ Ignore, /* NO KEY */ Alt | FctKey | 0x53, /* (Alt) Right */ Ignore, /* NO KEY */ Alt | FctKey | 0x57, /* (Alt) End */ /* --------------- a0 to af --------------- */ Alt | KeyPad | 2, /* (Alt) Down */ Alt | KeyPad | 3, /* (Alt) Page Down */ Alt | KeyPad | 0, /* (Alt) Insert */ Alt | KeyPad | 10, /* (Alt) Delete */ Alt | Grey | 0, /* (Alt) Grey / */ Alt | FctKey | 0x09, /* (Alt) Tab */ Alt | Grey | 4 /* (Alt) Keypad Enter */ }; /* These bit-positions corresponds to values returned by BIOS */ #define SHIFT_P 0x0003 /* two bits! */ #define CTRL_P 0x0004 #define ALT_P 0x0008 #define SCRLOCK_P 0x0010 #define NUMLOCK_P 0x0020 #define CAPSLOCK_P 0x0040 #define ALT_GR_P 0x0800 #define SUPER_P 0x4000 /* pseudo */ #define HYPER_P 0x8000 /* pseudo */ static int dos_get_modifiers (keymask) int *keymask; { union REGS regs; int mask; int modifiers = 0; /* Calculate modifier bits */ regs.h.ah = extended_kbd ? 0x12 : 0x02; int86 (0x16, ®s, ®s); if (!extended_kbd) { mask = regs.h.al & (SHIFT_P | CTRL_P | ALT_P | SCRLOCK_P | NUMLOCK_P | CAPSLOCK_P); } else { mask = regs.h.al & (SHIFT_P | SCRLOCK_P | NUMLOCK_P | CAPSLOCK_P); /* Do not break international keyboard support. */ /* When Keyb.Com is loaded, the right Alt key is */ /* used for accessing characters like { and } */ if (regs.h.ah & 2) /* Left ALT pressed ? */ mask |= ALT_P; if ((regs.h.ah & 8) != 0) /* Right ALT pressed ? */ { mask |= ALT_GR_P; if (dos_hyper_key == 1) { mask |= HYPER_P; modifiers |= hyper_modifier; } else if (dos_super_key == 1) { mask |= SUPER_P; modifiers |= super_modifier; } } if (regs.h.ah & 1) /* Left CTRL pressed mask |= CTRL_P; if (regs.h.ah & 4) /* Right CTRL pressed ? */ { if (dos_hyper_key == 2) { mask |= HYPER_P; modifiers |= hyper_modifier; } else if (dos_super_key == 2) { mask |= SUPER_P; modifiers |= super_modifier; } else mask |= CTRL_P; } } if (mask & SHIFT_P) modifiers |= shift_modifier; if (mask & CTRL_P) modifiers |= ctrl_modifier; if (mask & ALT_P) modifiers |= meta_modifier; if (keymask) *keymask = mask; return modifiers; } #define NUM_RECENT_DOSKEYS (100) int recent_doskeys_index; /* Index for storing next element into recent_doskeys */ int total_doskeys; /* Total number of elements stored into recent_doskeys */ Lisp_Object recent_doskeys; /* A vector, holding the last 100 keystrokes */ DEFUN ("recent-doskeys", Frecent_doskeys, Srecent_doskeys, 0, 0, 0, "Return vector of last 100 keyboard input values seen in dos_rawgetc.\n\ Each input key receives two values in this vector: first the ASCII code,\n\ and then the scan code.") () { Lisp_Object *keys = XVECTOR (recent_doskeys)->contents; Lisp_Object val; if (total_doskeys < NUM_RECENT_DOSKEYS) return Fvector (total_doskeys, keys); else { val = Fvector (NUM_RECENT_DOSKEYS, keys); bcopy (keys + recent_doskeys_index, XVECTOR (val)->contents, (NUM_RECENT_DOSKEYS - recent_doskeys_index) * sizeof (Lisp_Object)); bcopy (keys, XVECTOR (val)->contents + NUM_RECENT_DOSKEYS - recent_doskeys_index, recent_doskeys_index * sizeof (Lisp_Object)); return val; } } /* Get a char from keyboard. Function keys are put into the event queue. */ static int dos_rawgetc () { struct input_event event; union REGS regs; #ifndef HAVE_X_WINDOWS SCREEN_SET_CURSOR (); if (!mouse_visible) mouse_on (); #endif /* The following condition is equivalent to `kbhit ()', except that it uses the bios to do its job. This pleases DESQview/X. */ while ((regs.h.ah = extended_kbd ? 0x11 : 0x01), int86 (0x16, ®s, ®s), (regs.x.flags & 0x40) == 0) { union REGS regs; register unsigned char c; int sc, code, mask, kp_mode; int modifiers; regs.h.ah = extended_kbd ? 0x10 : 0x00; int86 (0x16, ®s, ®s); c = regs.h.al; sc = regs.h.ah; total_doskeys += 2; XVECTOR (recent_doskeys)->contents[recent_doskeys_index++] = make_number (c); if (recent_doskeys_index == NUM_RECENT_DOSKEYS) recent_doskeys_index = 0; XVECTOR (recent_doskeys)->contents[recent_doskeys_index++] = make_number (sc); if (recent_doskeys_index == NUM_RECENT_DOSKEYS) recent_doskeys_index = 0; modifiers = dos_get_modifiers (&mask); #ifndef HAVE_X_WINDOWS if (!NILP (Vdos_display_scancodes)) { char buf[10]; sprintf (buf, "%02x:%02x*%04x", (unsigned) (sc&0xff), (unsigned) c, mask); dos_direct_output (screen_size_Y - 2, screen_size_X - 12, buf, 10); } #endif if (sc == 0xe0) { switch (c) { case 10: /* Ctrl Grey Enter */ code = Ctrl | Grey | 4; break; case 13: /* Grey Enter */ code = Grey | 4; break; case '/': /* Grey / */ code = Grey | 0; break; default: continue; }; c = 0; } else { if (sc >= (sizeof (ibmpc_translate_map) / sizeof (short))) continue; if ((code = ibmpc_translate_map[sc]) == Ignore) continue; } if (c == 0) { if (code & Alt) modifiers |= meta_modifier; if (code & Ctrl) modifiers |= ctrl_modifier; if (code & Shift) modifiers |= shift_modifier; } switch (code & 0xf000) { case ModFct: if (c && !(mask & (SHIFT_P | ALT_P | CTRL_P | HYPER_P | SUPER_P))) return c; c = 0; /* Special */ case FctKey: if (c != 0) return c; case Special: code |= 0xff00; break; case Normal: if (sc == 0) { if (c == 0) /* ctrl-break */ continue; return c; /* ALT-nnn */ } if (!keyboard_map_all) { if (c != ' ') return c; code = c; break; } case Map: if (c && !(mask & ALT_P) && !((mask & SHIFT_P) && (mask & CTRL_P))) if (!keyboard_map_all) return c; code &= 0xff; if (mask & ALT_P && code <= 10 && code > 0 && dos_keypad_mode & 0x200) mask |= SHIFT_P; /* ALT-1 => M-! etc. */ if (mask & SHIFT_P) { code = keyboard->shifted[code]; mask -= SHIFT_P; modifiers &= ~shift_modifier; } else if ((mask & ALT_GR_P) && keyboard->alt_gr && keyboard->alt_gr[code] != ' ') code = keyboard->alt_gr[code]; else code = keyboard->unshifted[code]; break; case KeyPad: code &= 0xff; if (c == 0xe0) /* edit key */ kp_mode = 3; else if ((mask & (NUMLOCK_P|CTRL_P|SHIFT_P|ALT_P)) == NUMLOCK_P) /* numlock on */ kp_mode = dos_keypad_mode & 0x03; else kp_mode = (dos_keypad_mode >> 4) & 0x03; switch (kp_mode) { case 0: if (code == 10 && dos_decimal_point) return dos_decimal_point; return keypad_translate_map[code].char_code; case 1: code = 0xff00 | keypad_translate_map[code].keypad_code; break; case 2: code = keypad_translate_map[code].meta_code; modifiers = meta_modifier; break; case 3: code = 0xff00 | keypad_translate_map[code].editkey_code; break; } break; case Grey: code &= 0xff; kp_mode = ((mask & (NUMLOCK_P|CTRL_P|SHIFT_P|ALT_P)) == NUMLOCK_P) ? 0x04 : 0x40; if (dos_keypad_mode & kp_mode) code = 0xff00 | grey_key_translate_map[code].keypad_code; else code = grey_key_translate_map[code].char_code; break; } make_event: if (code == 0) continue; if (code >= 0x100) event.kind = non_ascii_keystroke; else event.kind = ascii_keystroke; event.code = code; event.modifiers = modifiers; XSETFRAME (event.frame_or_window, selected_frame); event.timestamp = event_timestamp (); kbd_buffer_store_event (&event); } if (have_mouse > 0) { int but, press, x, y, ok; /* Check for mouse movement *before* buttons. */ mouse_check_moved (); for (but = 0; but < NUM_MOUSE_BUTTONS; but++) for (press = 0; press < 2; press++) { if (press) ok = mouse_pressed (but, &x, &y); else ok = mouse_released (but, &x, &y); if (ok) { event.kind = mouse_click; event.code = but; event.modifiers = dos_get_modifiers (0) | (press ? down_modifier : up_modifier); event.x = x; event.y = y; XSETFRAME (event.frame_or_window, selected_frame); event.timestamp = event_timestamp (); kbd_buffer_store_event (&event); } } } return -1; } static int prev_get_char = -1; /* Return 1 if a key is ready to be read without suspending execution. */ dos_keysns () { if (prev_get_char != -1) return 1; else return ((prev_get_char = dos_rawgetc ()) != -1); } /* Read a key. Return -1 if no key is ready. */ dos_keyread () { if (prev_get_char != -1) { int c = prev_get_char; prev_get_char = -1; return c; } else return dos_rawgetc (); } #ifndef HAVE_X_WINDOWS /* See xterm.c for more info. */ void pixel_to_glyph_coords (f, pix_x, pix_y, x, y, bounds, noclip) FRAME_PTR f; register int pix_x, pix_y; register int *x, *y; void /* XRectangle */ *bounds; int noclip; { if (bounds) abort (); /* Ignore clipping. */ *x = pix_x; *y = pix_y; } void glyph_to_pixel_coords (f, x, y, pix_x, pix_y) FRAME_PTR f; register int x, y; register int *pix_x, *pix_y; { *pix_x = x; *pix_y = y; } /* Simulation of X's menus. Nothing too fancy here -- just make it work for now. Actually, I don't know the meaning of all the parameters of the functions here -- I only know how they are called by xmenu.c. I could of course grab the nearest Xlib manual (down the hall, second-to-last door on the left), but I don't think it's worth the effort. */ static XMenu * IT_menu_create () { XMenu *menu; menu = (XMenu *) xmalloc (sizeof (XMenu)); menu->allocated = menu->count = menu->panecount = menu->width = 0; return menu; } /* Allocate some (more) memory for MENU ensuring that there is room for one for item. */ static void IT_menu_make_room (XMenu *menu) { if (menu->allocated == 0) { int count = menu->allocated = 10; menu->text = (char **) xmalloc (count * sizeof (char *)); menu->submenu = (XMenu **) xmalloc (count * sizeof (XMenu *)); menu->panenumber = (int *) xmalloc (count * sizeof (int)); } else if (menu->allocated == menu->count) { int count = menu->allocated = menu->allocated + 10; menu->text = (char **) xrealloc (menu->text, count * sizeof (char *)); menu->submenu = (XMenu **) xrealloc (menu->submenu, count * sizeof (XMenu *)); menu->panenumber = (int *) xrealloc (menu->panenumber, count * sizeof (int)); } } /* Search the given menu structure for a given pane number. */ static XMenu * IT_menu_search_pane (XMenu *menu, int pane) { int i; XMenu *try; for (i = 0; i < menu->count; i++) if (menu->submenu[i]) { if (pane == menu->panenumber[i]) return menu->submenu[i]; if ((try = IT_menu_search_pane (menu->submenu[i], pane))) return try; } return (XMenu *) 0; } /* Determine how much screen space a given menu needs. */ static void IT_menu_calc_size (XMenu *menu, int *width, int *height) { int i, h2, w2, maxsubwidth, maxheight; maxsubwidth = 0; maxheight = menu->count; for (i = 0; i < menu->count; i++) { if (menu->submenu[i]) { IT_menu_calc_size (menu->submenu[i], &w2, &h2); if (w2 > maxsubwidth) maxsubwidth = w2; if (i + h2 > maxheight) maxheight = i + h2; } } *width = menu->width + maxsubwidth; *height = maxheight; } /* Display MENU at (X,Y) using FACES. */ static void IT_menu_display (XMenu *menu, int y, int x, int *faces) { int i, j, face, width; GLYPH *text, *p; char *q; int mx, my; int enabled, mousehere; int row, col; width = menu->width; text = (GLYPH *) xmalloc ((width + 2) * sizeof (GLYPH)); ScreenGetCursor (&row, &col); mouse_get_xy (&mx, &my); IT_update_begin (); for (i = 0; i < menu->count; i++) { IT_cursor_to (y + i, x); enabled = (!menu->submenu[i] && menu->panenumber[i]) || (menu->submenu[i]); mousehere = (y + i == my && x <= mx && mx < x + width + 2); face = faces[enabled + mousehere * 2]; p = text; *p++ = FAST_MAKE_GLYPH (' ', face); for (j = 0, q = menu->text[i]; *q; j++) *p++ = FAST_MAKE_GLYPH (*q++, face); for (; j < width; j++) *p++ = FAST_MAKE_GLYPH (' ', face); *p++ = FAST_MAKE_GLYPH (menu->submenu[i] ? 16 : ' ', face); IT_write_glyphs (text, width + 2); } IT_update_end (); IT_cursor_to (row, col); xfree (text); } /* --------------------------- X Menu emulation ---------------------- */ /* Create a brand new menu structure. */ XMenu * XMenuCreate (Display *foo1, Window foo2, char *foo3) { return IT_menu_create (); } /* Create a new pane and place it on the outer-most level. It is not clear that it should be placed out there, but I don't know what else to do. */ int XMenuAddPane (Display *foo, XMenu *menu, char *txt, int enable) { int len; if (!enable) abort (); IT_menu_make_room (menu); menu->submenu[menu->count] = IT_menu_create (); menu->text[menu->count] = txt; menu->panenumber[menu->count] = ++menu->panecount; menu->count++; if ((len = strlen (txt)) > menu->width) menu->width = len; return menu->panecount; } /* Create a new item in a menu pane. */ int XMenuAddSelection (Display *bar, XMenu *menu, int pane, int foo, char *txt, int enable) { int len; if (pane) if (!(menu = IT_menu_search_pane (menu, pane))) return XM_FAILURE; IT_menu_make_room (menu); menu->submenu[menu->count] = (XMenu *) 0; menu->text[menu->count] = txt; menu->panenumber[menu->count] = enable; menu->count++; if ((len = strlen (txt)) > menu->width) menu->width = len; return XM_SUCCESS; } /* Decide where the menu would be placed if requested at (X,Y). */ void XMenuLocate (Display *foo0, XMenu *menu, int foo1, int foo2, int x, int y, int *ulx, int *uly, int *width, int *height) { if (menu->count == 1 && menu->submenu[0]) /* Special case: the menu consists of only one pane. */ IT_menu_calc_size (menu->submenu[0], width, height); else IT_menu_calc_size (menu, width, height); *ulx = x + 1; *uly = y; *width += 2; } struct IT_menu_state { void *screen_behind; XMenu *menu; int pane; int x, y; }; /* Display menu, wait for user's response, and return that response. */ int XMenuActivate (Display *foo, XMenu *menu, int *pane, int *selidx, int x0, int y0, unsigned ButtonMask, char **txt) { struct IT_menu_state *state; int statecount; int x, y, i, b; int screensize; int faces[4], selectface; int leave, result, onepane; /* Just in case we got here without a mouse present... */ if (have_mouse <= 0) return XM_IA_SELECT; state = alloca (menu->panecount * sizeof (struct IT_menu_state)); screensize = screen_size * 2; faces[0] = compute_glyph_face (&the_only_frame, face_name_id_number (&the_only_frame, intern ("msdos-menu-passive-face")), 0); faces[1] = compute_glyph_face (&the_only_frame, face_name_id_number (&the_only_frame, intern ("msdos-menu-active-face")), 0); selectface = face_name_id_number (&the_only_frame, intern ("msdos-menu-select-face")); faces[2] = compute_glyph_face (&the_only_frame, selectface, faces[0]); faces[3] = compute_glyph_face (&the_only_frame, selectface, faces[1]); statecount = 1; state[0].menu = menu; mouse_off (); ScreenRetrieve (state[0].screen_behind = xmalloc (screensize)); if ((onepane = menu->count == 1 && menu->submenu[0])) { menu->width = menu->submenu[0]->width; state[0].menu = menu->submenu[0]; } else { state[0].menu = menu; } state[0].x = x0 - 1; state[0].y = y0; state[0].pane = onepane; mouse_last_x = -1; /* A hack that forces display. */ leave = 0; while (!leave) { if (!mouse_visible) mouse_on (); mouse_check_moved (); if (selected_frame->mouse_moved) { selected_frame->mouse_moved = 0; result = XM_IA_SELECT; mouse_get_xy (&x, &y); for (i = 0; i < statecount; i++) if (state[i].x <= x && x < state[i].x + state[i].menu->width + 2) { int dy = y - state[i].y; if (0 <= dy && dy < state[i].menu->count) { if (!state[i].menu->submenu[dy]) if (state[i].menu->panenumber[dy]) result = XM_SUCCESS; else result = XM_IA_SELECT; *pane = state[i].pane - 1; *selidx = dy; /* We hit some part of a menu, so drop extra menues that have been opened. That does not include an open and active submenu. */ if (i != statecount - 2 || state[i].menu->submenu[dy] != state[i+1].menu) while (i != statecount - 1) { statecount--; mouse_off (); ScreenUpdate (state[statecount].screen_behind); xfree (state[statecount].screen_behind); } if (i == statecount - 1 && state[i].menu->submenu[dy]) { IT_menu_display (state[i].menu, state[i].y, state[i].x, faces); state[statecount].menu = state[i].menu->submenu[dy]; state[statecount].pane = state[i].menu->panenumber[dy]; mouse_off (); ScreenRetrieve (state[statecount].screen_behind = xmalloc (screensize)); state[statecount].x = state[i].x + state[i].menu->width + 2; state[statecount].y = y; statecount++; } } } IT_menu_display (state[statecount - 1].menu, state[statecount - 1].y, state[statecount - 1].x, faces); } for (b = 0; b < mouse_button_count; b++) { (void) mouse_pressed (b, &x, &y); if (mouse_released (b, &x, &y)) leave = 1; } } mouse_off (); ScreenUpdate (state[0].screen_behind); while (statecount--) xfree (state[statecount].screen_behind); return result; } /* Dispose of a menu. */ void XMenuDestroy (Display *foo, XMenu *menu) { int i; if (menu->allocated) { for (i = 0; i < menu->count; i++) if (menu->submenu[i]) XMenuDestroy (foo, menu->submenu[i]); xfree (menu->text); xfree (menu->submenu); xfree (menu->panenumber); } xfree (menu); } int x_pixel_width (struct frame *f) { return FRAME_WIDTH (f); } int x_pixel_height (struct frame *f) { return FRAME_HEIGHT (f); } #endif /* !HAVE_X_WINDOWS */ /* ----------------------- DOS / UNIX conversion --------------------- */ /* Destructively turn backslashes into slashes. */ void dostounix_filename (p) register char *p; { while (*p) { if (*p == '\\') *p = '/'; p++; } } /* Destructively turn slashes into backslashes. */ void unixtodos_filename (p) register char *p; { while (*p) { if (*p == '/') *p = '\\'; p++; } } /* Get the default directory for a given drive. 0=def, 1=A, 2=B, ... */ int getdefdir (drive, dst) int drive; char *dst; { union REGS regs; *dst++ = '/'; regs.h.dl = drive; regs.x.si = (int) dst; regs.h.ah = 0x47; intdos (®s, ®s); return !regs.x.cflag; } /* Remove all CR's that are followed by a LF. */ int crlf_to_lf (n, buf) register int n; register unsigned char *buf; { unsigned char *np = buf; unsigned char *startp = buf; unsigned char *endp = buf + n; unsigned char c; if (n == 0) return n; while (buf < endp - 1) { if (*buf == 0x0d) { if (*(++buf) != 0x0a) *np++ = 0x0d; } else *np++ = *buf++; } if (buf < endp) *np++ = *buf++; return np - startp; } /* The Emacs root directory as determined by init_environment. */ static char emacsroot[MAXPATHLEN]; char * rootrelativepath (rel) char *rel; { static char result[MAXPATHLEN + 10]; strcpy (result, emacsroot); strcat (result, "/"); strcat (result, rel); return result; } /* Define a lot of environment variables if not already defined. Don't remove anything unless you know what you're doing -- lots of code will break if one or more of these are missing. */ void init_environment (argc, argv, skip_args) int argc; char **argv; int skip_args; { char *s, *t, *root; int len; /* Find our root from argv[0]. Assuming argv[0] is, say, "c:/emacs/bin/emacs.exe" our root will be "c:/emacs". */ root = alloca (MAXPATHLEN + 20); _fixpath (argv[0], root); strlwr (root); len = strlen (root); while (len > 0 && root[len] != '/' && root[len] != ':') len--; root[len] = '\0'; if (len > 4 && strcmp (root + len - 4, "/bin") == 0) root[len - 4] = '\0'; else strcpy (root, "c:/emacs"); /* Only under debuggers, I think. */ len = strlen (root); strcpy (emacsroot, root); /* We default HOME to our root. */ setenv ("HOME", root, 0); /* We default EMACSPATH to root + "/bin". */ strcpy (root + len, "/bin"); setenv ("EMACSPATH", root, 0); /* I don't expect anybody to ever use other terminals so the internal terminal is the default. */ setenv ("TERM", "internal", 0); #ifdef HAVE_X_WINDOWS /* Emacs expects DISPLAY to be set. */ setenv ("DISPLAY", "unix:0.0", 0); #endif /* SHELL is a bit tricky -- COMSPEC is the closest we come, but we must downcase it and mirror the backslashes. */ s = getenv ("COMSPEC"); if (!s) s = "c:/command.com"; t = alloca (strlen (s) + 1); strcpy (t, s); strlwr (t); dostounix_filename (t); setenv ("SHELL", t, 0); /* PATH is also downcased and backslashes mirrored. */ s = getenv ("PATH"); if (!s) s = ""; t = alloca (strlen (s) + 3); /* Current directory is always considered part of MsDos's path but it is not normally mentioned. Now it is. */ strcat (strcpy (t, ".;"), s); strlwr (t); dostounix_filename (t); /* Not a single file name, but this should work. */ setenv ("PATH", t, 1); /* In some sense all dos users have root privileges, so... */ setenv ("USER", "root", 0); setenv ("NAME", getenv ("USER"), 0); /* Time zone determined from country code. To make this possible, the country code may not span more than one time zone. In other words, in the USA, you lose. */ if (!getenv ("TZ")) switch (dos_country_code) { case 31: /* Belgium */ case 32: /* The Netherlands */ case 33: /* France */ case 34: /* Spain */ case 36: /* Hungary */ case 38: /* Yugoslavia (or what's left of it?) */ case 39: /* Italy */ case 41: /* Switzerland */ case 42: /* Tjekia */ case 45: /* Denmark */ case 46: /* Sweden */ case 47: /* Norway */ case 48: /* Poland */ case 49: /* Germany */ /* Daylight saving from last Sunday in March to last Sunday in September, both at 2AM. */ setenv ("TZ", "MET-01METDST-02,M3.5.0/02:00,M9.5.0/02:00", 0); break; case 44: /* United Kingdom */ case 351: /* Portugal */ case 354: /* Iceland */ setenv ("TZ", "GMT+00", 0); break; case 81: /* Japan */ case 82: /* Korea */ setenv ("TZ", "JST-09", 0); break; case 90: /* Turkey */ case 358: /* Finland */ setenv ("TZ", "EET-02", 0); break; case 972: /* Israel */ /* This is an approximation. (For exact rules, use the `zoneinfo/israel' file which comes with DJGPP, but you need to install it in `/usr/share/zoneinfo/' directory first.) */ setenv ("TZ", "IST-02IDT-03,M4.1.6/00:00,M9.5.6/01:00", 0); break; } init_gettimeofday (); } static int break_stat; /* BREAK check mode status. */ static int stdin_stat; /* stdin IOCTL status. */ /* These must be global. */ static _go32_dpmi_seginfo ctrl_break_vector; static _go32_dpmi_registers ctrl_break_regs; static int ctrlbreakinstalled = 0; /* Interrupt level detection of Ctrl-Break. Don't do anything fancy here! */ void ctrl_break_func (regs) _go32_dpmi_registers *regs; { Vquit_flag = Qt; } void install_ctrl_break_check () { if (!ctrlbreakinstalled) { /* Don't press Ctrl-Break if you don't have either DPMI or Emacs was compiler with Djgpp 1.11 maintenance level 5 or later! */ ctrlbreakinstalled = 1; ctrl_break_vector.pm_offset = (int) ctrl_break_func; _go32_dpmi_allocate_real_mode_callback_iret (&ctrl_break_vector, &ctrl_break_regs); _go32_dpmi_set_real_mode_interrupt_vector (0x1b, &ctrl_break_vector); } } /* * Turn off Dos' Ctrl-C checking and inhibit interpretation of * control chars by Dos. * Determine the keyboard type. */ int dos_ttraw () { union REGS inregs, outregs; static int first_time = 1; break_stat = getcbrk (); setcbrk (0); install_ctrl_break_check (); if (first_time) { inregs.h.ah = 0xc0; int86 (0x15, &inregs, &outregs); extended_kbd = (!outregs.x.cflag) && (outregs.h.ah == 0); have_mouse = 0; if (internal_terminal #ifdef HAVE_X_WINDOWS && inhibit_window_system #endif ) { inregs.x.ax = 0x0021; int86 (0x33, &inregs, &outregs); have_mouse = (outregs.x.ax & 0xffff) == 0xffff; if (!have_mouse) { /* Reportedly, the above doesn't work for some mouse drivers. There is an additional detection method that should work, but might be a little slower. Use that as an alternative. */ inregs.x.ax = 0x0000; int86 (0x33, &inregs, &outregs); have_mouse = (outregs.x.ax & 0xffff) == 0xffff; } if (have_mouse) { have_mouse = 1; /* enable mouse */ mouse_visible = 0; if (outregs.x.bx == 3) { mouse_button_count = 3; mouse_button_translate[0] = 0; /* Left */ mouse_button_translate[1] = 2; /* Middle */ mouse_button_translate[2] = 1; /* Right */ } else { mouse_button_count = 2; mouse_button_translate[0] = 0; mouse_button_translate[1] = 1; } mouse_position_hook = &mouse_get_pos; mouse_init (); } } first_time = 0; } inregs.x.ax = 0x4400; /* Get IOCTL status. */ inregs.x.bx = 0x00; /* 0 = stdin. */ intdos (&inregs, &outregs); stdin_stat = outregs.h.dl; inregs.x.dx = stdin_stat | 0x0020; /* raw mode */ inregs.x.ax = 0x4401; /* Set IOCTL status */ intdos (&inregs, &outregs); return !outregs.x.cflag; } /* Restore status of standard input and Ctrl-C checking. */ int dos_ttcooked () { union REGS inregs, outregs; setcbrk (break_stat); mouse_off (); inregs.x.ax = 0x4401; /* Set IOCTL status. */ inregs.x.bx = 0x00; /* 0 = stdin. */ inregs.x.dx = stdin_stat; intdos (&inregs, &outregs); return !outregs.x.cflag; } /* Run command as specified by ARGV in directory DIR. The command is run with input from TEMPIN and output to file TEMPOUT. */ int run_msdos_command (argv, dir, tempin, tempout) unsigned char **argv; Lisp_Object dir; int tempin, tempout; { char *saveargv1, *saveargv2, **envv; char oldwd[MAXPATHLEN + 1]; /* Fixed size is safe on MSDOS. */ int msshell, result = -1; int in, out, inbak, outbak, errbak; int x, y; Lisp_Object cmd; /* Get current directory as MSDOS cwd is not per-process. */ getwd (oldwd); cmd = Ffile_name_nondirectory (build_string (argv[0])); msshell = !NILP (Fmember (cmd, Fsymbol_value (intern ("msdos-shells")))) && !strcmp ("-c", argv[1]); if (msshell) { saveargv1 = argv[1]; saveargv2 = argv[2]; argv[1] = "/c"; if (argv[2]) { char *p = alloca (strlen (argv[2]) + 1); strcpy (argv[2] = p, saveargv2); while (*p && isspace (*p)) p++; while (*p && !isspace (*p)) if (*p == '/') *p++ = '\\'; else p++; } } /* Build the environment array. */ { extern Lisp_Object Vprocess_environment; Lisp_Object tmp, lst; int i, len; lst = Vprocess_environment; len = XFASTINT (Flength (lst)); envv = alloca ((len + 1) * sizeof (char *)); for (i = 0; i < len; i++) { tmp = Fcar (lst); lst = Fcdr (lst); CHECK_STRING (tmp, 0); envv[i] = alloca (XSTRING (tmp)->size + 1); strcpy (envv[i], XSTRING (tmp)->data); } envv[len] = (char *) 0; } if (STRINGP (dir)) chdir (XSTRING (dir)->data); inbak = dup (0); outbak = dup (1); errbak = dup (2); if (inbak < 0 || outbak < 0 || errbak < 0) goto done; /* Allocation might fail due to lack of descriptors. */ if (have_mouse > 0) mouse_get_xy (&x, &y); dos_ttcooked (); /* do it here while 0 = stdin */ dup2 (tempin, 0); dup2 (tempout, 1); dup2 (tempout, 2); result = spawnve (P_WAIT, argv[0], argv, envv); dup2 (inbak, 0); dup2 (outbak, 1); dup2 (errbak, 2); close (inbak); close (outbak); close (errbak); dos_ttraw (); if (have_mouse > 0) { mouse_init (); mouse_moveto (x, y); } done: chdir (oldwd); if (msshell) { argv[1] = saveargv1; argv[2] = saveargv2; } return result; } croak (badfunc) char *badfunc; { fprintf (stderr, "%s not yet implemented\r\n", badfunc); reset_sys_modes (); exit (1); } /* ------------------------- Compatibility functions ------------------- * gethostname * gettimeofday */ /* * Hostnames for a pc are not really funny, * but they are used in change log so we emulate the best we can. */ gethostname (p, size) char *p; int size; { char *q = egetenv ("HOSTNAME"); if (!q) q = "pc"; strcpy (p, q); return 0; } /* When time zones are set from Ms-Dos too many C-libraries are playing tricks with time values. We solve this by defining our own version of `gettimeofday' bypassing GO32. Our version needs to be initialized once and after each call to `tzset' with TZ changed. That is accomplished by aliasing tzset to init_gettimeofday. */ static struct tm time_rec; int gettimeofday (struct timeval *tp, struct timezone *tzp) { if (tp) { struct time t; struct tm tm; gettime (&t); if (t.ti_hour < time_rec.tm_hour) /* midnight wrap */ { struct date d; getdate (&d); time_rec.tm_year = d.da_year - 1900; time_rec.tm_mon = d.da_mon - 1; time_rec.tm_mday = d.da_day; } time_rec.tm_hour = t.ti_hour; time_rec.tm_min = t.ti_min; time_rec.tm_sec = t.ti_sec; tm = time_rec; tm.tm_gmtoff = dos_timezone_offset; tp->tv_sec = mktime (&tm); /* may modify tm */ tp->tv_usec = t.ti_hund * (1000000 / 100); } /* Ignore tzp; it's obsolescent. */ return 0; } /* * A list of unimplemented functions that we silently ignore. */ unsigned alarm (s) unsigned s; {} fork () { return 0; } int kill (x, y) int x, y; { return -1; } nice (p) int p; {} void volatile pause () {} request_sigio () {} setpgrp () {return 0; } setpriority (x,y,z) int x,y,z; { return 0; } sigsetmask (x) int x; { return 0; } unrequest_sigio () {} int run_dos_timer_hooks = 0; #ifndef HAVE_SELECT #include "sysselect.h" static int last_ti_sec = -1; static int dos_menubar_clock_displayed = 0; static void check_timer (t) struct time *t; { gettime (t); if (t->ti_sec == last_ti_sec) return; last_ti_sec = t->ti_sec; if (!NILP (Vdos_menubar_clock)) { char clock_str[16]; int len; int min = t->ti_min; int hour = t->ti_hour; if (dos_timezone_offset) { int tz = dos_timezone_offset; min -= tz % 60; if (min < 0) min += 60, hour--; else if (min >= 60) min -= 60, hour++; if ((hour -= (tz / 60)) < 0) hour += 24; else hour %= 24; } if ((dos_country_info[0x11] & 0x01) == 0) /* 12 hour clock */ { hour %= 12; if (hour == 0) hour = 12; } len = sprintf (clock_str, "%2d.%02d.%02d", hour, min, t->ti_sec); dos_direct_output (0, screen_size_X - len - 1, clock_str, len); dos_menubar_clock_displayed = 1; } else if (dos_menubar_clock_displayed) { /* Erase last displayed time. */ dos_direct_output (0, screen_size_X - 9, " ", 8); dos_menubar_clock_displayed = 0; } if (!NILP (Vdos_timer_hooks)) run_dos_timer_hooks++; } /* Only event queue is checked. */ int sys_select (nfds, rfds, wfds, efds, timeout) int nfds; SELECT_TYPE *rfds, *wfds, *efds; EMACS_TIME *timeout; { int check_input; long timeoutval, clnow, cllast; struct time t; check_input = 0; if (rfds) { check_input = FD_ISSET (0, rfds); FD_ZERO (rfds); } if (wfds) FD_ZERO (wfds); if (efds) FD_ZERO (efds); if (nfds != 1) abort (); /* If we are looking only for the terminal, with no timeout, just read it and wait -- that's more efficient. */ if (!timeout) { while (! detect_input_pending ()) check_timer (&t); } else { timeoutval = EMACS_SECS (*timeout) * 100 + EMACS_USECS (*timeout) / 10000; check_timer (&t); cllast = t.ti_sec * 100 + t.ti_hund; while (!check_input || !detect_input_pending ()) { check_timer (&t); clnow = t.ti_sec * 100 + t.ti_hund; if (clnow < cllast) /* time wrap */ timeoutval -= clnow + 6000 - cllast; else timeoutval -= clnow - cllast; if (timeoutval <= 0) /* Stop on timer being cleared */ return 0; cllast = clnow; } } FD_SET (0, rfds); return 1; } #endif /* * Define overlayed functions: * * chdir -> sys_chdir * tzset -> init_gettimeofday * abort -> dos_abort */ #ifdef chdir #undef chdir extern int chdir (); int sys_chdir (path) const char* path; { int len = strlen (path); char *tmp = (char *)path; if (*tmp && tmp[1] == ':') { if (getdisk () != tolower (tmp[0]) - 'a') setdisk (tolower (tmp[0]) - 'a'); tmp += 2; /* strip drive: KFS 1995-07-06 */ len -= 2; } if (len > 1 && (tmp[len - 1] == '/')) { char *tmp1 = (char *) alloca (len + 1); strcpy (tmp1, tmp); tmp1[len - 1] = 0; tmp = tmp1; } return chdir (tmp); } #endif #ifdef tzset #undef tzset extern void tzset (void); void init_gettimeofday () { time_t ltm, gtm; struct tm *lstm; tzset (); ltm = gtm = time (NULL); ltm = mktime (lstm = localtime (<m)); gtm = mktime (gmtime (>m)); time_rec.tm_hour = 99; /* force gettimeofday to get date */ time_rec.tm_isdst = lstm->tm_isdst; dos_timezone_offset = time_rec.tm_gmtoff = (int)(gtm - ltm) / 60; } #endif #ifdef abort #undef abort void dos_abort (file, line) char *file; int line; { char buffer1[200], buffer2[400]; int i, j; sprintf (buffer1, "", file, line); for (i = j = 0; buffer1[i]; i++) { buffer2[j++] = buffer1[i]; buffer2[j++] = 0x70; } dosmemput (buffer2, j, (int)ScreenPrimary); ScreenSetCursor (2, 0); abort (); } #endif syms_of_msdos () { recent_doskeys = Fmake_vector (make_number (NUM_RECENT_DOSKEYS), Qnil); staticpro (&recent_doskeys); defsubr (&Srecent_doskeys); } #endif /* MSDOS */ emacs-19.30/src/nt.c100444 23073 1 46377 6047603064 13401 0ustar voelkerdaemon/* Utility and Unix shadow routines for GNU Emacs on Windows NT. Copyright (C) 1994, 1995 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. Geoff Voelker (voelker@cs.washington.edu) 7-29-94 */ /* Define stat before including config.h. */ #include #include int nt_stat (char *filename, struct stat *statbuf) { int r, l = strlen (filename); char *str = NULL; extern long *xmalloc (); extern void xfree (); /* stat has a bug when passed a name of a directory with a trailing backslash (but a trailing forward slash works fine). */ if (filename[l - 1] == '\\') { str = (char *) xmalloc (l + 1); strcpy (str, filename); str[l - 1] = '/'; r = stat (str, statbuf); xfree (str); return r; } else return stat (filename, statbuf); } /* Place a wrapper around the NT version of ctime. It returns NULL on network directories, so we handle that case here. Define it before including config.h. (Ulrich Leodolter, 1/11/95). */ char * nt_ctime (const time_t *t) { char *str = (char *) ctime (t); return (str ? str : "Sun Jan 01 00:00:00 1970"); } #include #include #include #include #include #include #include #define getwd _getwd #include "lisp.h" #undef getwd #include #include "ndir.h" #include "ntheap.h" extern int report_file_error (char *, Lisp_Object); /* Get the current working directory. */ int getwd (char *dir) { return GetCurrentDirectory (MAXPATHLEN, dir); } /* Emulate gethostname. */ int gethostname (char *buffer, int size) { /* NT only allows small host names, so the buffer is certainly large enough. */ return !GetComputerName (buffer, &size); } /* Emulate getloadavg. */ int getloadavg (double loadavg[], int nelem) { int i; /* A faithful emulation is going to have to be saved for a rainy day. */ for (i = 0; i < nelem; i++) { loadavg[i] = 0.0; } return i; } /* Emulate sleep...we could have done this with a define, but that would necessitate including windows.h in the files that used it. This is much easier. */ void nt_sleep (int seconds) { Sleep (seconds * 1000); } /* Emulate the Unix directory procedures opendir, closedir, and readdir. We can't use the procedures supplied in sysdep.c, so we provide them here. */ struct direct dir_static; /* simulated directory contents */ static int dir_finding; static HANDLE dir_find_handle; DIR * opendir (char *filename) { DIR *dirp; /* Opening is done by FindFirstFile. However, a read is inherent to this operation, so we have a flag to handle the open at read time. This flag essentially means "there is a find-handle open and it needs to be closed." */ if (!(dirp = (DIR *) malloc (sizeof (DIR)))) { return 0; } dirp->dd_fd = 0; dirp->dd_loc = 0; dirp->dd_size = 0; /* This is tacky, but we need the directory name for our implementation of readdir. */ strncpy (dirp->dd_buf, filename, DIRBLKSIZ); return dirp; } void closedir (DIR *dirp) { /* If we have a find-handle open, close it. */ if (dir_finding) { FindClose (dir_find_handle); dir_finding = 0; } xfree ((char *) dirp); } struct direct * readdir (DIR *dirp) { WIN32_FIND_DATA find_data; /* If we aren't dir_finding, do a find-first, otherwise do a find-next. */ if (!dir_finding) { char filename[MAXNAMLEN + 3]; int ln; strncpy (filename, dirp->dd_buf, MAXNAMLEN); ln = strlen (filename)-1; if (filename[ln] != '\\' && filename[ln] != ':') strcat (filename, "\\"); strcat (filename, "*.*"); dir_find_handle = FindFirstFile (filename, &find_data); if (dir_find_handle == INVALID_HANDLE_VALUE) return NULL; dir_finding = 1; } else { if (!FindNextFile (dir_find_handle, &find_data)) return NULL; } /* NT's unique ID for a file is 64 bits, so we have to fake it here. This should work as long as we never use 0. */ dir_static.d_ino = 1; dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3 + dir_static.d_namlen - dir_static.d_namlen % 4; dir_static.d_namlen = strlen (find_data.cFileName); strncpy (dir_static.d_name, find_data.cFileName, MAXNAMLEN); return &dir_static; } /* Emulate getpwuid and getpwnam. */ int getuid (); /* forward declaration */ #define PASSWD_FIELD_SIZE 256 static char the_passwd_name[PASSWD_FIELD_SIZE]; static char the_passwd_passwd[PASSWD_FIELD_SIZE]; static char the_passwd_gecos[PASSWD_FIELD_SIZE]; static char the_passwd_dir[PASSWD_FIELD_SIZE]; static char the_passwd_shell[PASSWD_FIELD_SIZE]; static struct passwd the_passwd = { the_passwd_name, the_passwd_passwd, 0, 0, 0, the_passwd_gecos, the_passwd_dir, the_passwd_shell, }; struct passwd * getpwuid (int uid) { int size = PASSWD_FIELD_SIZE; if (!GetUserName (the_passwd.pw_name, &size)) return NULL; the_passwd.pw_passwd[0] = '\0'; the_passwd.pw_uid = 0; the_passwd.pw_gid = 0; strcpy (the_passwd.pw_gecos, the_passwd.pw_name); the_passwd.pw_dir[0] = '\0'; the_passwd.pw_shell[0] = '\0'; return &the_passwd; } struct passwd * getpwnam (char *name) { struct passwd *pw; pw = getpwuid (getuid ()); if (!pw) return pw; if (strcmp (name, pw->pw_name)) return NULL; return pw; } /* We don't have scripts to automatically determine the system configuration for Emacs before it's compiled, and we don't want to have to make the user enter it, so we define EMACS_CONFIGURATION to invoke this runtime routine. */ static char configuration_buffer[32]; char * get_emacs_configuration (void) { char *arch, *oem, *os; /* Determine the processor type. */ switch (get_processor_type ()) { #ifdef PROCESSOR_INTEL_386 case PROCESSOR_INTEL_386: case PROCESSOR_INTEL_486: case PROCESSOR_INTEL_PENTIUM: arch = "i386"; break; #endif #ifdef PROCESSOR_INTEL_860 case PROCESSOR_INTEL_860: arch = "i860"; break; #endif #ifdef PROCESSOR_MIPS_R2000 case PROCESSOR_MIPS_R2000: case PROCESSOR_MIPS_R3000: case PROCESSOR_MIPS_R4000: arch = "mips"; break; #endif #ifdef PROCESSOR_ALPHA_21064 case PROCESSOR_ALPHA_21064: arch = "alpha"; break; #endif default: arch = "unknown"; break; } /* Let oem be "*" until we figure out how to decode the OEM field. */ oem = "*"; #ifdef WINDOWS95 os = "win"; #else os = "nt"; #endif sprintf (configuration_buffer, "%s-%s-%s%d.%d", arch, oem, os, get_nt_major_version (), get_nt_minor_version ()); return configuration_buffer; } /* Conjure up inode and device numbers that will serve the purpose of Emacs. Return 1 upon success, 0 upon failure. */ int get_inode_and_device_vals (Lisp_Object filename, Lisp_Object *p_inode, Lisp_Object *p_device) { /* File uids on NT are found using a handle to a file, which implies that it has been opened. Since we want to be able to stat an arbitrary file, we must open it, get the info, and then close it. Also, NT file uids are 64-bits. This is a problem. */ HANDLE handle; BOOL result; DWORD attrs; BY_HANDLE_FILE_INFORMATION info; /* We have to stat files and directories differently, so check to see what filename references. */ attrs = GetFileAttributes (XSTRING (filename)->data); if (attrs == 0xFFFFFFFF) { return 0; } if (attrs & FILE_ATTRIBUTE_DIRECTORY) { /* Conjure up bogus, but unique, values. */ attrs = GetTickCount (); *p_inode = make_number (attrs); *p_device = make_number (attrs); return 1; } /* FIXME: It shouldn't be opened without READ access, but NT on x86 doesn't allow GetFileInfo in that case (NT on mips does). */ handle = CreateFile (XSTRING (filename)->data, GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (handle == INVALID_HANDLE_VALUE) return 0; result = GetFileInformationByHandle (handle, &info); CloseHandle (handle); if (!result) return 0; *p_inode = make_number (info.nFileIndexLow); /* use the low value */ *p_device = make_number (info.dwVolumeSerialNumber); return 1; } /* The following pipe routines are used to support our fork emulation. Since NT's crt dup always creates inherited handles, we must be careful in setting up pipes. First create non-inherited pipe handles, then create an inherited handle to the write end by dup-ing it, and then close the non-inherited end that was just duped. This gives us one non-inherited handle on the read end and one inherited handle to the write end. As the parent, we close the inherited handle to the write end after spawning the child. */ /* From callproc.c */ extern Lisp_Object Vbinary_process_input; extern Lisp_Object Vbinary_process_output; void pipe_with_inherited_out (int fds[2]) { int inherit_out; unsigned int flags = _O_NOINHERIT; if (!NILP (Vbinary_process_output)) flags |= _O_BINARY; _pipe (fds, 0, flags); inherit_out = dup (fds[1]); close (fds[1]); fds[1] = inherit_out; } void pipe_with_inherited_in (int fds[2]) { int inherit_in; unsigned int flags = _O_NOINHERIT; if (!NILP (Vbinary_process_input)) flags |= _O_BINARY; _pipe (fds, 0, flags); inherit_in = dup (fds[0]); close (fds[0]); fds[0] = inherit_in; } /* The following two routines are used to manipulate stdin, stdout, and stderr of our child processes. Assuming that in, out, and err are inherited, we make them stdin, stdout, and stderr of the child as follows: - Save the parent's current standard handles. - Set the parent's standard handles to the handles being passed in. (Note that _get_osfhandle is an io.h procedure that maps crt file descriptors to NT file handles.) - Spawn the child, which inherits in, out, and err as stdin, stdout, and stderr. (see Spawnve) - Reset the parent's standard handles to the saved handles. (see reset_standard_handles) We assume that the caller closes in, out, and err after calling us. */ void prepare_standard_handles (int in, int out, int err, HANDLE handles[4]) { HANDLE parent, stdin_save, stdout_save, stderr_save, err_handle; #ifdef WINDOWS95 /* The Win95 beta doesn't set the standard handles correctly. Handicap subprocesses until we get a version that works correctly. Undefining the subprocesses macro reveals other incompatibilities, so, since we're expecting subprocs to work in the near future, disable them here. */ report_file_error ("Subprocesses currently disabled on Win95", Qnil); #endif parent = GetCurrentProcess (); stdin_save = GetStdHandle (STD_INPUT_HANDLE); stdout_save = GetStdHandle (STD_OUTPUT_HANDLE); stderr_save = GetStdHandle (STD_ERROR_HANDLE); #ifndef HAVE_NTGUI if (!DuplicateHandle (parent, GetStdHandle (STD_INPUT_HANDLE), parent, &stdin_save, 0, FALSE, DUPLICATE_SAME_ACCESS)) report_file_error ("Duplicating parent's input handle", Qnil); if (!DuplicateHandle (parent, GetStdHandle (STD_OUTPUT_HANDLE), parent, &stdout_save, 0, FALSE, DUPLICATE_SAME_ACCESS)) report_file_error ("Duplicating parent's output handle", Qnil); if (!DuplicateHandle (parent, GetStdHandle (STD_ERROR_HANDLE), parent, &stderr_save, 0, FALSE, DUPLICATE_SAME_ACCESS)) report_file_error ("Duplicating parent's error handle", Qnil); #endif /* !HAVE_NTGUI */ if (!SetStdHandle (STD_INPUT_HANDLE, (HANDLE) _get_osfhandle (in))) report_file_error ("Changing stdin handle", Qnil); if (!SetStdHandle (STD_OUTPUT_HANDLE, (HANDLE) _get_osfhandle (out))) report_file_error ("Changing stdout handle", Qnil); /* We lose data if we use the same handle to the pipe for stdout and stderr, so make a duplicate. This took a while to find. */ if (out == err) { if (!DuplicateHandle (parent, (HANDLE) _get_osfhandle (err), parent, &err_handle, 0, TRUE, DUPLICATE_SAME_ACCESS)) report_file_error ("Duplicating out handle to make err handle.", Qnil); } else { err_handle = (HANDLE) _get_osfhandle (err); } if (!SetStdHandle (STD_ERROR_HANDLE, err_handle)) report_file_error ("Changing stderr handle", Qnil); handles[0] = stdin_save; handles[1] = stdout_save; handles[2] = stderr_save; handles[3] = err_handle; } void reset_standard_handles (int in, int out, int err, HANDLE handles[4]) { HANDLE stdin_save = handles[0]; HANDLE stdout_save = handles[1]; HANDLE stderr_save = handles[2]; HANDLE err_handle = handles[3]; int i; #ifndef HAVE_NTGUI if (!SetStdHandle (STD_INPUT_HANDLE, stdin_save)) report_file_error ("Resetting input handle", Qnil); if (!SetStdHandle (STD_OUTPUT_HANDLE, stdout_save)) { i = GetLastError (); report_file_error ("Resetting output handle", Qnil); } if (!SetStdHandle (STD_ERROR_HANDLE, stderr_save)) report_file_error ("Resetting error handle", Qnil); #endif /* !HAVE_NTGUI */ if (out == err) { /* If out and err are the same handle, then we duplicated out and stuck it in err_handle. Close the duplicate to clean up. */ if (!CloseHandle (err_handle)) report_file_error ("Closing error handle duplicated from out.", Qnil); } } int random () { /* rand () on NT gives us 15 random bits...hack together 30 bits. */ return ((rand () << 15) | rand ()); } void srandom (int seed) { srand (seed); } /* Destructively turn backslashes into slashes. */ void dostounix_filename (p) register char *p; { while (*p) { if (*p == '\\') *p = '/'; p++; } } /* Routines that are no-ops on NT but are defined to get Emacs to compile. */ int sigsetmask (int signal_mask) { return 0; } int sigblock (int sig) { return 0; } int kill (int pid, int signal) { return 0; } int setpgrp (int pid, int gid) { return 0; } int alarm (int seconds) { return 0; } int unrequest_sigio (void) { return 0; } int request_sigio (void) { return 0; } int getuid () { return 0; } int geteuid () { return 0; } /* Remove all CR's that are followed by a LF. (From msdos.c...probably should figure out a way to share it, although this code isn't going to ever change.) */ int crlf_to_lf (n, buf) register int n; register unsigned char *buf; { unsigned char *np = buf; unsigned char *startp = buf; unsigned char *endp = buf + n; if (n == 0) return n; while (buf < endp - 1) { if (*buf == 0x0d) { if (*(++buf) != 0x0a) *np++ = 0x0d; } else *np++ = *buf++; } if (buf < endp) *np++ = *buf++; return np - startp; } #define REG_ROOT "SOFTWARE\\GNU\\Emacs\\" LPBYTE nt_get_resource (key, lpdwtype) char *key; LPDWORD lpdwtype; { LPBYTE lpvalue; HKEY hrootkey = NULL; DWORD cbData; BOOL ok = FALSE; /* Check both the current user and the local machine to see if we have any resources. */ if (RegOpenKeyEx (HKEY_CURRENT_USER, REG_ROOT, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS) { lpvalue = NULL; if (RegQueryValueEx (hrootkey, key, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS && (lpvalue = (LPBYTE) xmalloc (cbData)) != NULL && RegQueryValueEx (hrootkey, key, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS) { return (lpvalue); } if (lpvalue) xfree (lpvalue); RegCloseKey (hrootkey); } if (RegOpenKeyEx (HKEY_LOCAL_MACHINE, REG_ROOT, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS) { lpvalue = NULL; if (RegQueryValueEx (hrootkey, key, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS && (lpvalue = (LPBYTE) xmalloc (cbData)) != NULL && RegQueryValueEx (hrootkey, key, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS) { return (lpvalue); } if (lpvalue) xfree (lpvalue); RegCloseKey (hrootkey); } return (NULL); } void init_environment () { /* Open a console window to display messages during dumping. */ if (!initialized) AllocConsole (); /* Check for environment variables and use registry if they don't exist */ { int i; LPBYTE lpval; DWORD dwType; static char * env_vars[] = { "emacs_path", "EMACSLOADPATH", "SHELL", "EMACSDATA", "EMACSPATH", "EMACSLOCKDIR", "INFOPATH", "EMACSDOC", "TERM", }; for (i = 0; i < (sizeof (env_vars) / sizeof (env_vars[0])); i++) { if (!getenv (env_vars[i]) && (lpval = nt_get_resource (env_vars[i], &dwType)) != NULL) { if (dwType == REG_EXPAND_SZ) { char buf1[500], buf2[500]; ExpandEnvironmentStrings ((LPSTR) lpval, buf1, 500); _snprintf (buf2, 499, "%s=%s", env_vars[i], buf1); putenv (strdup (buf2)); } else if (dwType == REG_SZ) { char buf[500]; _snprintf (buf, 499, "%s=%s", env_vars[i], lpval); putenv (strdup (buf)); } xfree (lpval); } } } } #ifdef HAVE_TIMEVAL #include /* Emulate gettimeofday (Ulrich Leodolter, 1/11/95). */ void gettimeofday (struct timeval *tv, struct timezone *tz) { struct _timeb tb; _ftime (&tb); tv->tv_sec = tb.time; tv->tv_usec = tb.millitm * 1000L; if (tz) { tz->tz_minuteswest = tb.timezone; /* minutes west of Greenwich */ tz->tz_dsttime = tb.dstflag; /* type of dst correction */ } } #endif /* HAVE_TIMEVAL */ #ifdef PIGSFLY Keep this around...we might need it later. #ifdef WINDOWSNT { /* * Find the user's real name by opening the process token and looking * up the name associated with the user-sid in that token. */ char b[256], Name[256], RefD[256]; DWORD length = 256, rlength = 256, trash; HANDLE Token; SID_NAME_USE User; if (1) Vuser_real_login_name = build_string ("foo"); else if (!OpenProcessToken (GetCurrentProcess (), TOKEN_QUERY, &Token)) { Vuser_real_login_name = build_string ("unknown"); } else if (!GetTokenInformation (Token, TokenUser, (PVOID)b, 256, &trash)) { CloseHandle (Token); Vuser_real_login_name = build_string ("unknown"); } else if (!LookupAccountSid ((void *)0, (PSID)b, Name, &length, RefD, &rlength, &User)) { CloseHandle (Token); Vuser_real_login_name = build_string ("unknown"); } else Vuser_real_login_name = build_string (Name); } #else /* not WINDOWSNT */ #endif /* not WINDOWSNT */ #endif /* PIGSFLY */ emacs-19.30/src/ntheap.c100444 23073 1 15412 5775062542 14230 0ustar voelkerdaemon/* Heap management routines for GNU Emacs on Windows NT. Copyright (C) 1994 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. Geoff Voelker (voelker@cs.washington.edu) 7-29-94 */ #include "config.h" #include #include #include "ntheap.h" /* This gives us the page size and the size of the allocation unit on NT. */ SYSTEM_INFO sysinfo_cache; unsigned long syspage_mask = 0; /* These are defined to get Emacs to compile, but are not used. */ int edata; int etext; /* The major and minor versions of NT. */ int nt_major_version; int nt_minor_version; /* Cache information describing the NT system for later use. */ void cache_system_info (void) { union { struct info { char major; char minor; short platform; } info; DWORD data; } version; /* Cache the version of the operating system. */ version.data = GetVersion (); nt_major_version = version.info.major; nt_minor_version = version.info.minor; /* Cache page size, allocation unit, processor type, etc. */ GetSystemInfo (&sysinfo_cache); syspage_mask = sysinfo_cache.dwPageSize - 1; } /* Round ADDRESS up to be aligned with ALIGN. */ unsigned char * round_to_next (unsigned char *address, unsigned long align) { unsigned long tmp; tmp = (unsigned long) address; tmp = (tmp + align - 1) / align; return (unsigned char *) (tmp * align); } /* Info for keeping track of our heap. */ unsigned char *data_region_base = NULL; unsigned char *data_region_end = NULL; unsigned char *real_data_region_end = NULL; unsigned long data_region_size = 0; unsigned long reserved_heap_size = 0; /* The start of the data segment. */ unsigned char * get_data_start (void) { return data_region_base; } /* The end of the data segment. */ unsigned char * get_data_end (void) { return data_region_end; } #ifndef WINDOWS95 static char * allocate_heap (void) { unsigned long base = 0x00030000; unsigned long end = 0x00D00000; reserved_heap_size = end - base; return VirtualAlloc ((void *) base, get_reserved_heap_size (), MEM_RESERVE, PAGE_NOACCESS); } #else static char * allocate_heap (void) { unsigned long start = 0x400000; unsigned long stop = 0xD00000; unsigned long increment = 0x100000; char *ptr, *begin = NULL, *end = NULL; int i; for (i = start; i < stop; i += increment) { ptr = VirtualAlloc ((void *) i, increment, MEM_RESERVE, PAGE_NOACCESS); if (ptr) begin = begin ? begin : ptr; else if (begin) { end = ptr; break; } } if (begin && !end) end = (char *) i; if (!begin) /* We couldn't allocate any memory for the heap. Exit. */ exit (-2); reserved_heap_size = end - begin; return begin; } #endif /* Emulate Unix sbrk. */ void * sbrk (unsigned long increment) { void *result; long size = (long) increment; /* Allocate our heap if we haven't done so already. */ if (!data_region_base) { data_region_base = allocate_heap (); if (!data_region_base) return NULL; /* Ensure that the addresses don't use the upper 8 bits since the Lisp type goes there (yucko). */ if (((unsigned long) data_region_base & 0xFF000000) != 0) { printf ("Error: The heap was allocated in upper memory.\n"); exit (1); } data_region_end = data_region_base; real_data_region_end = data_region_end; data_region_size = get_reserved_heap_size (); } result = data_region_end; /* If size is negative, shrink the heap by decommitting pages. */ if (size < 0) { int new_size; unsigned char *new_data_region_end; size = -size; /* Sanity checks. */ if ((data_region_end - size) < data_region_base) return NULL; /* We can only decommit full pages, so allow for partial deallocation [cga]. */ new_data_region_end = (data_region_end - size); new_data_region_end = (unsigned char *) ((long) (new_data_region_end + syspage_mask) & ~syspage_mask); new_size = real_data_region_end - new_data_region_end; real_data_region_end = new_data_region_end; if (new_size > 0) { /* Decommit size bytes from the end of the heap. */ if (!VirtualFree (real_data_region_end, new_size, MEM_DECOMMIT)) return NULL; } data_region_end -= size; } /* If size is positive, grow the heap by committing reserved pages. */ else if (size > 0) { /* Sanity checks. */ if ((data_region_end + size) > (data_region_base + get_reserved_heap_size ())) return NULL; /* Commit more of our heap. */ if (VirtualAlloc (data_region_end, size, MEM_COMMIT, PAGE_READWRITE) == NULL) return NULL; data_region_end += size; /* We really only commit full pages, so record where the real end of committed memory is [cga]. */ real_data_region_end = (unsigned char *) ((long) (data_region_end + syspage_mask) & ~syspage_mask); } return result; } /* Recreate the heap from the data that was dumped to the executable. EXECUTABLE_PATH tells us where to find the executable. */ void recreate_heap (char *executable_path) { unsigned char *tmp; /* First reserve the upper part of our heap. (We reserve first because there have been problems in the past where doing the mapping first has loaded DLLs into the VA space of our heap.) */ tmp = VirtualAlloc ((void *) get_heap_end (), get_reserved_heap_size () - get_committed_heap_size (), MEM_RESERVE, PAGE_NOACCESS); if (!tmp) exit (1); /* We read in the data for the .bss section from the executable first and map in the heap from the executable second to prevent any funny interactions between file I/O and file mapping. */ read_in_bss (executable_path); map_in_heap (executable_path); } /* Round the heap up to the given alignment. */ void round_heap (unsigned long align) { unsigned long needs_to_be; unsigned long need_to_alloc; needs_to_be = (unsigned long) round_to_next (get_heap_end (), align); need_to_alloc = needs_to_be - (unsigned long) get_heap_end (); if (need_to_alloc) sbrk (need_to_alloc); } emacs-19.30/src/ntinevt.c100444 75424 1 37007 6002547444 13760 0ustar kwzhdaemon/* Input event support for Windows NT port of GNU Emacs. Copyright (C) 1992, 1993, 1995 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. Drew Bliss 01-Oct-93 Adapted from ntkbd.c by Tim Fleehart */ #include "config.h" #include #include #include #include "lisp.h" #include "frame.h" #include "blockinput.h" #include "termhooks.h" /* stdin, from ntterm */ extern HANDLE keyboard_handle; /* Info for last mouse motion */ static COORD movement_pos; static DWORD movement_time; /* from keyboard.c */ extern void reinvoke_input_signal (void); /* from dispnew.c */ extern int change_frame_size (FRAME_PTR, int, int, int, int); /* Event queue */ #define EVENT_QUEUE_SIZE 50 static INPUT_RECORD event_queue[EVENT_QUEUE_SIZE]; static INPUT_RECORD *queue_ptr = event_queue, *queue_end = event_queue; static int fill_queue (BOOL block) { BOOL rc; DWORD events_waiting; if (queue_ptr < queue_end) return queue_end-queue_ptr; if (!block) { /* Check to see if there are some events to read before we try because we can't block. */ if (!GetNumberOfConsoleInputEvents (keyboard_handle, &events_waiting)) return -1; if (events_waiting == 0) return 0; } rc = ReadConsoleInput (keyboard_handle, event_queue, EVENT_QUEUE_SIZE, &events_waiting); if (!rc) return -1; queue_ptr = event_queue; queue_end = event_queue + events_waiting; return (int) events_waiting; } /* In a generic, multi-frame world this should take a console handle and return the frame for it Right now, there's only one frame so return it. */ static FRAME_PTR get_frame (void) { return selected_frame; } /* Translate console modifiers to emacs modifiers. German keyboard support (Kai Morgan Zeise 2/18/95). */ static int win32_kbd_mods_to_emacs (DWORD mods) { int retval = 0; /* If AltGr has been pressed, remove it. */ if ((mods & (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED)) == (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED)) mods &= ~ (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED); if (mods & (RIGHT_ALT_PRESSED | LEFT_ALT_PRESSED)) retval = meta_modifier; if (mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED)) { retval |= ctrl_modifier; if ((mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED)) == (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED)) retval |= meta_modifier; } if (((mods & (SHIFT_PRESSED | CAPSLOCK_ON)) == SHIFT_PRESSED) || ((mods & (SHIFT_PRESSED | CAPSLOCK_ON)) == CAPSLOCK_ON)) retval |= shift_modifier; return retval; } /* Patch up NT keyboard events when info is missing that should be there, assuming that map_virt_key says that the key is a valid ASCII char. */ static char win32_number_shift_map[] = { ')', '!', '@', '#', '$', '%', '^', '&', '*', '(' }; #define WIN32_KEY_SHIFTED(mods, no, yes) \ ((mods & (SHIFT_PRESSED | CAPSLOCK_ON)) ? yes : no) static void win32_kbd_patch_key (KEY_EVENT_RECORD *event) { unsigned int key_code = event->wVirtualKeyCode; unsigned int mods = event->dwControlKeyState; int mapped_punct = 0; /* map_virt_key says its a valid key, but the uChar.AsciiChar field is empty. patch up the uChar.AsciiChar field using wVirtualKeyCode. */ if (event->uChar.AsciiChar == 0 && ((key_code >= '0' && key_code <= '9') || (key_code >= 'A' && key_code <= 'Z') || (key_code >= 0xBA && key_code <= 0xC0) || (key_code >= 0xDB && key_code <= 0xDE) )) { if (key_code >= '0' && key_code <= '9') { event->uChar.AsciiChar = WIN32_KEY_SHIFTED (mods, key_code, win32_number_shift_map[key_code - '0']); return; } switch (key_code) { case 0xBA: mapped_punct = WIN32_KEY_SHIFTED (mods, ';', ':'); break; case 0xBB: mapped_punct = WIN32_KEY_SHIFTED (mods, '=', '+'); break; case 0xBC: mapped_punct = WIN32_KEY_SHIFTED (mods, ',', '<'); break; case 0xBD: mapped_punct = WIN32_KEY_SHIFTED (mods, '-', '_'); break; case 0xBE: mapped_punct = WIN32_KEY_SHIFTED (mods, '.', '>'); break; case 0xBF: mapped_punct = WIN32_KEY_SHIFTED (mods, '/', '?'); break; case 0xC0: mapped_punct = WIN32_KEY_SHIFTED (mods, '`', '~'); break; case 0xDB: mapped_punct = WIN32_KEY_SHIFTED (mods, '[', '{'); break; case 0xDC: mapped_punct = WIN32_KEY_SHIFTED (mods, '\\', '|'); break; case 0xDD: mapped_punct = WIN32_KEY_SHIFTED (mods, ']', '}'); break; case 0xDE: mapped_punct = WIN32_KEY_SHIFTED (mods, '\'', '"'); break; default: mapped_punct = 0; break; } if (mapped_punct) { event->uChar.AsciiChar = mapped_punct; return; } /* otherwise, it's a letter. */ event->uChar.AsciiChar = WIN32_KEY_SHIFTED (mods, key_code - 'A' + 'a', key_code); } } /* Map virtual key codes into: -1 - Ignore this key -2 - ASCII char Other - Map non-ASCII keys into X keysyms so that they are looked up correctly in keyboard.c Return, escape and tab are mapped to ASCII rather than coming back as non-ASCII to be more compatible with old-style keyboard support. */ static int map_virt_key[256] = { -1, -1, /* VK_LBUTTON */ -1, /* VK_RBUTTON */ 0x69, /* VK_CANCEL */ -1, /* VK_MBUTTON */ -1, -1, -1, 8, /* VK_BACK */ -2, /* VK_TAB */ -1, -1, 11, /* VK_CLEAR */ -2, /* VK_RETURN */ -1, -1, -1, /* VK_SHIFT */ -1, /* VK_CONTROL */ -1, /* VK_MENU */ 0x13, /* VK_PAUSE */ -1, /* VK_CAPITAL */ -1, -1, -1, -1, -1, -1, -2, /* VK_ESCAPE */ -1, -1, -1, -1, -2, /* VK_SPACE */ 0x55, /* VK_PRIOR */ 0x56, /* VK_NEXT */ 0x57, /* VK_END */ 0x50, /* VK_HOME */ 0x51, /* VK_LEFT */ 0x52, /* VK_UP */ 0x53, /* VK_RIGHT */ 0x54, /* VK_DOWN */ 0x60, /* VK_SELECT */ 0x61, /* VK_PRINT */ 0x62, /* VK_EXECUTE */ -1, /* VK_SNAPSHOT */ 0x63, /* VK_INSERT */ 0xff, /* VK_DELETE */ 0x6a, /* VK_HELP */ -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, /* 0 - 9 */ -1, -1, -1, -1, -1, -1, -1, -2, -2, -2, -2, -2, -2, -2, -2, /* A - Z */ -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -1, -1, -1, -1, -1, 0xb0, /* VK_NUMPAD0 */ 0xb1, /* VK_NUMPAD1 */ 0xb2, /* VK_NUMPAD2 */ 0xb3, /* VK_NUMPAD3 */ 0xb4, /* VK_NUMPAD4 */ 0xb5, /* VK_NUMPAD5 */ 0xb6, /* VK_NUMPAD6 */ 0xb7, /* VK_NUMPAD7 */ 0xb8, /* VK_NUMPAD8 */ 0xb9, /* VK_NUMPAD9 */ 0xaa, /* VK_MULTIPLY */ 0xab, /* VK_ADD */ 0xac, /* VK_SEPARATOR */ 0xad, /* VK_SUBTRACT */ 0xae, /* VK_DECIMAL */ 0xaf, /* VK_DIVIDE */ 0xbe, /* VK_F1 */ 0xbf, /* VK_F2 */ 0xc0, /* VK_F3 */ 0xc1, /* VK_F4 */ 0xc2, /* VK_F5 */ 0xc3, /* VK_F6 */ 0xc4, /* VK_F7 */ 0xc5, /* VK_F8 */ 0xc6, /* VK_F9 */ 0xc7, /* VK_F10 */ 0xc8, /* VK_F11 */ 0xc9, /* VK_F12 */ 0xca, /* VK_F13 */ 0xcb, /* VK_F14 */ 0xcc, /* VK_F15 */ 0xcd, /* VK_F16 */ 0xce, /* VK_F17 */ 0xcf, /* VK_F18 */ 0xd0, /* VK_F19 */ 0xd1, /* VK_F20 */ 0xd2, /* VK_F21 */ 0xd3, /* VK_F22 */ 0xd4, /* VK_F23 */ 0xd5, /* VK_F24 */ -1, -1, -1, -1, -1, -1, -1, -1, 0x7f, /* VK_NUMLOCK */ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 0x9f */ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 0xaf */ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 0xb9 */ -2, /* ; */ -2, /* = */ -2, /* , */ -2, /* \ */ -2, /* . */ -2, /* / */ -2, /* ` */ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 0xcf */ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 0xda */ -2, -2, -2, -2, -2, /* 0xdf */ -2, -2, -2, -2, -2, -1, /* 0xe5 */ -2, /* oxe6 */ -1, -1, /* 0xe8 */ -2, -2, -2, -2, -2, -2, -2, /* 0xef */ -2, -2, -2, -2, -2, -2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1 /* 0xff */ }; static int key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev) { int map; static BOOL map_virt_key_init_done; /* Skip key-up events. */ if (event->bKeyDown == FALSE) return 0; if (event->wVirtualKeyCode > 0xff) { printf ("Unknown key code %d\n", event->wVirtualKeyCode); return 0; } /* Patch needed for German keyboard. Ulrich Leodolter (1/11/95). */ if (! map_virt_key_init_done) { short vk; if ((vk = VkKeyScan (0x3c)) >= 0 && vk < 256) map_virt_key[vk] = -2; /* less */ if ((vk = VkKeyScan (0x3e)) >= 0 && vk < 256) map_virt_key[vk] = -2; /* greater */ map_virt_key_init_done = TRUE; } /* BUGBUG - Ignores the repeat count It's questionable whether we want to obey the repeat count anyway since keys usually aren't repeated unless key events back up in the queue. If they're backing up then we don't generally want to honor them later since that leads to significant slop in cursor motion when the system is under heavy load. */ map = map_virt_key[event->wVirtualKeyCode]; if (map == -1) { return 0; } else if (map == -2) { /* ASCII */ emacs_ev->kind = ascii_keystroke; win32_kbd_patch_key (event); XSETINT (emacs_ev->code, event->uChar.AsciiChar); } else { /* non-ASCII */ emacs_ev->kind = non_ascii_keystroke; /* * make_lispy_event () now requires non-ascii codes to have * the full X keysym values (2nd byte is 0xff). add it on. */ map |= 0xff00; XSETINT (emacs_ev->code, map); } XSETFRAME (emacs_ev->frame_or_window, get_frame ()); emacs_ev->modifiers = win32_kbd_mods_to_emacs (event->dwControlKeyState); emacs_ev->timestamp = GetTickCount (); return 1; } /* Mouse position hook. */ void win32_mouse_position (FRAME_PTR *f, int insist, Lisp_Object *bar_window, enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y, unsigned long *time) { BLOCK_INPUT; insist = insist; *f = get_frame (); *bar_window = Qnil; *part = 0; selected_frame->mouse_moved = 0; *x = movement_pos.X; *y = movement_pos.Y; *time = movement_time; UNBLOCK_INPUT; } /* Remember mouse motion and notify emacs. */ static void mouse_moved_to (int x, int y) { /* If we're in the same place, ignore it */ if (x != movement_pos.X || y != movement_pos.Y) { selected_frame->mouse_moved = 1; movement_pos.X = x; movement_pos.Y = y; movement_time = GetTickCount (); } } /* Consoles return button bits in a strange order: least significant - Leftmost button next - Rightmost button next - Leftmost+1 next - Leftmost+2... Assume emacs likes three button mice, so Left == 0 Middle == 1 Right == 2 Others increase from there. */ static int emacs_button_translation[NUM_MOUSE_BUTTONS] = { 0, 2, 1, 3, 4, }; static int do_mouse_event (MOUSE_EVENT_RECORD *event, struct input_event *emacs_ev) { static DWORD button_state = 0; DWORD but_change, mask; int i; if (event->dwEventFlags == MOUSE_MOVED) { /* For movement events we just note that the mouse has moved so that emacs will generate drag events. */ mouse_moved_to (event->dwMousePosition.X, event->dwMousePosition.Y); return 0; } /* It looks like the console code sends us a mouse event with dwButtonState == 0 when a window is activated. Ignore this case. */ if (event->dwButtonState == button_state) return 0; emacs_ev->kind = mouse_click; /* Find out what button has changed state since the last button event. */ but_change = button_state ^ event->dwButtonState; mask = 1; for (i = 0; i < NUM_MOUSE_BUTTONS; i++, mask <<= 1) if (but_change & mask) { XSETINT (emacs_ev->code, emacs_button_translation[i]); break; } /* If the changed button is out of emacs' range (highly unlikely) ignore this event. */ if (i == NUM_MOUSE_BUTTONS) return 0; button_state = event->dwButtonState; emacs_ev->timestamp = GetTickCount (); emacs_ev->modifiers = win32_kbd_mods_to_emacs (event->dwControlKeyState) | ((event->dwButtonState & mask) ? down_modifier : up_modifier); XSETFASTINT (emacs_ev->x, event->dwMousePosition.X); XSETFASTINT (emacs_ev->y, event->dwMousePosition.Y); XSETFRAME (emacs_ev->frame_or_window, get_frame ()); return 1; } static void resize_event (WINDOW_BUFFER_SIZE_RECORD *event) { FRAME_PTR f = get_frame (); change_frame_size (f, event->dwSize.Y, event->dwSize.X, 0, 1); SET_FRAME_GARBAGED (f); } int win32_read_socket (int sd, struct input_event *bufp, int numchars, int waitp, int expected) { BOOL no_events = TRUE; int nev, ret = 0, add; if (interrupt_input_blocked) { interrupt_input_pending = 1; return -1; } interrupt_input_pending = 0; BLOCK_INPUT; for (;;) { nev = fill_queue (waitp != 0); if (nev <= 0) { /* If nev == -1, there was some kind of error If nev == 0 then waitp must be zero and no events were available so return. */ UNBLOCK_INPUT; return nev; } while (nev > 0 && numchars > 0) { switch (queue_ptr->EventType) { case KEY_EVENT: add = key_event (&queue_ptr->Event.KeyEvent, bufp); bufp += add; ret += add; numchars -= add; break; case MOUSE_EVENT: add = do_mouse_event (&queue_ptr->Event.MouseEvent, bufp); bufp += add; ret += add; numchars -= add; break; case WINDOW_BUFFER_SIZE_EVENT: resize_event (&queue_ptr->Event.WindowBufferSizeEvent); break; case MENU_EVENT: case FOCUS_EVENT: /* Internal event types, ignored. */ break; } queue_ptr++; nev--; } if (ret > 0 || expected == 0) break; } UNBLOCK_INPUT; return ret; } emacs-19.30/src/ntproc.c100444 23073 1 51272 6047603075 14255 0ustar voelkerdaemon/* Process support for Windows NT port of GNU EMACS. Copyright (C) 1992, 1995 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. Drew Bliss Oct 14, 1993 Adapted from alarm.c by Tim Fleehart */ #include #include #include #include #include #include #include #include "lisp.h" #include "nt.h" #include "systime.h" /* #define FULL_DEBUG */ typedef void (_CALLBACK_ *signal_handler)(int); /* Defined in process.h which conflicts with the local copy */ #define _P_NOWAIT 1 typedef struct _child_process { int fd; HANDLE char_avail; HANDLE char_consumed; char chr; BOOL status; HANDLE process; DWORD pid; HANDLE thrd; } child_process; #define MAX_CHILDREN MAXDESC #ifdef EMACSDEBUG void _CRTAPI1 _DebPrint (char *fmt, ...) { char buf[256]; va_list args; va_start (args, fmt); vsprintf (buf, fmt, args); va_end (args); OutputDebugString (buf); } #endif /* Child process management list. */ static int child_proc_count = 0; static child_process child_procs[MAX_CHILDREN]; static child_process *dead_child = NULL; #define CHILD_ACTIVE(cp) ((cp)->process != NULL) #define DEACTIVATE_CHILD(cp) ((cp)->process = NULL) /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */ static signal_handler sig_handlers[NSIG]; /* Fake signal implementation to record the SIGCHLD handler. */ signal_handler win32_signal (int sig, signal_handler handler) { signal_handler old; if (sig != SIGCHLD) { errno = EINVAL; return SIG_ERR; } old = sig_handlers[sig]; sig_handlers[sig] = handler; return old; } /* Find an unused process slot. */ static child_process * new_child (void) { child_process *cp; if (child_proc_count == MAX_CHILDREN) return NULL; for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--) if (!CHILD_ACTIVE (cp)) return cp; return &child_procs[child_proc_count++]; } /* Find a child by pid. */ static child_process * find_child_pid (DWORD pid) { child_process *cp; for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--) if (CHILD_ACTIVE (cp) && pid == cp->pid) return cp; return NULL; } /* Find a child by fd. */ static child_process * find_child_fd (int fd) { child_process *cp; for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--) if (CHILD_ACTIVE (cp) && fd == cp->fd) return cp; return NULL; } /* Thread proc for child process reader threads The threads just sit in a loop waiting for input When they detect input, they signal the char_avail input to wake up the select emulator When the select emulator processes their input, it pulses char_consumed so that the reader thread goes back to reading. */ DWORD WINAPI reader_thread (void *arg) { child_process *cp; /* Our identity */ cp = (child_process *)arg; /* We have to wait for the go-ahead before we can start */ if (WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0) return 0; /* If something went wrong, quit */ if (!cp->status) return 0; for (;;) { /* Use read to get CRLF translation */ if (read (cp->fd, &cp->chr, sizeof (char)) == sizeof (char)) { cp->status = TRUE; } else { #ifdef FULL_DEBUG DebPrint (("reader_thread.read failed with %lu for fd %ld\n", GetLastError (), cp->fd)); #endif cp->status = FALSE; } if (!SetEvent (cp->char_avail)) { DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n", GetLastError (), cp->fd)); break; } /* If the read died, the child has died so let the thread die */ if (!cp->status) break; /* Wait until our input is acknowledged before reading again */ if (WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0) { DebPrint (("reader_thread.WaitForSingleObject failed with " "%lu for fd %ld\n", GetLastError (), cp->fd)); break; } } return 0; } static BOOL create_child (char *exe, char *cmdline, char *env, PROCESS_INFORMATION *info) { child_process *cp; DWORD id; STARTUPINFO start; SECURITY_ATTRIBUTES sec_attrs; SECURITY_DESCRIPTOR sec_desc; cp = new_child (); if (cp == NULL) goto EH_Fail; cp->fd = -1; cp->char_avail = CreateEvent (NULL, FALSE, FALSE, NULL); if (cp->char_avail == NULL) goto EH_Fail; cp->char_consumed = CreateEvent (NULL, FALSE, FALSE, NULL); if (cp->char_consumed == NULL) goto EH_char_avail; cp->thrd = CreateThread (NULL, 1024, reader_thread, cp, 0, &id); if (cp->thrd == NULL) goto EH_char_consumed; memset (&start, 0, sizeof (start)); start.cb = sizeof (start); #ifdef HAVE_NTGUI start.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW; start.wShowWindow = SW_HIDE; start.hStdInput = GetStdHandle (STD_INPUT_HANDLE); start.hStdOutput = GetStdHandle (STD_OUTPUT_HANDLE); start.hStdError = GetStdHandle (STD_ERROR_HANDLE); #endif /* HAVE_NTGUI */ /* Explicitly specify no security */ if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION)) goto EH_thrd; if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE)) goto EH_thrd; sec_attrs.nLength = sizeof (sec_attrs); sec_attrs.lpSecurityDescriptor = &sec_desc; sec_attrs.bInheritHandle = FALSE; if (!CreateProcess (exe, cmdline, &sec_attrs, NULL, TRUE, CREATE_NEW_PROCESS_GROUP, env, NULL, &start, info)) goto EH_thrd; cp->process = info->hProcess; cp->pid = info->dwProcessId; return TRUE; EH_thrd: id = GetLastError (); cp->status = FALSE; SetEvent (cp->char_consumed); EH_char_consumed: CloseHandle (cp->char_consumed); EH_char_avail: CloseHandle (cp->char_avail); EH_Fail: return FALSE; } /* create_child doesn't know what emacs' file handle will be for waiting on output from the child, so we need to make this additional call to register the handle with the process This way the select emulator knows how to match file handles with entries in child_procs. */ void register_child (int pid, int fd) { child_process *cp; cp = find_child_pid (pid); if (cp == NULL) { DebPrint (("register_child unable to find pid %lu\n", pid)); return; } #ifdef FULL_DEBUG DebPrint (("register_child registered fd %d with pid %lu\n", fd, pid)); #endif cp->fd = fd; cp->status = TRUE; /* Tell the reader thread to start */ if (!SetEvent (cp->char_consumed)) { DebPrint (("register_child.SetEvent failed with %lu for fd %ld\n", GetLastError (), cp->fd)); } } /* When a process dies its pipe will break so the reader thread will signal failure to the select emulator. The select emulator then calls this routine to clean up. Since the thread signaled failure we can assume it is exiting. */ static void remove_child (child_process *cp) { /* Reap the thread */ if (WaitForSingleObject (cp->thrd, INFINITE) != WAIT_OBJECT_0) { DebPrint (("remove_child.WaitForSingleObject (thread) failed " "with %lu for fd %ld\n", GetLastError (), cp->fd)); } CloseHandle (cp->thrd); CloseHandle (cp->char_consumed); CloseHandle (cp->char_avail); /* Reap the process */ if (WaitForSingleObject (cp->process, INFINITE) != WAIT_OBJECT_0) { DebPrint (("remove_child.WaitForSingleObject (process) failed " "with %lu for fd %ld\n", GetLastError (), cp->fd)); } CloseHandle (cp->process); DEACTIVATE_CHILD (cp); } /* Wait for any of our existing child processes to die When it does, close its handle Return the pid and fill in the status if non-NULL. */ /* From callproc.c */ extern int synch_process_alive; extern int synch_process_retcode; int win32_wait (int *status) { DWORD active, retval; int nh; child_process *cp, *cps[MAX_CHILDREN]; HANDLE wait_hnd[MAX_CHILDREN]; nh = 0; if (dead_child != NULL) { /* We want to wait for a specific child */ wait_hnd[nh] = dead_child->process; cps[nh] = dead_child; nh++; } else { for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--) if (CHILD_ACTIVE (cp)) { wait_hnd[nh] = cp->process; cps[nh] = cp; nh++; } } if (nh == 0) { /* Nothing to wait on, so fail */ errno = ECHILD; return -1; } active = WaitForMultipleObjects (nh, wait_hnd, FALSE, INFINITE); if (active == WAIT_FAILED) { errno = EBADF; return -1; } else if (active == WAIT_TIMEOUT) { /* Should never happen */ errno = EINVAL; return -1; } else if (active >= WAIT_OBJECT_0 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS) { active -= WAIT_OBJECT_0; } else if (active >= WAIT_ABANDONED_0 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS) { active -= WAIT_ABANDONED_0; } if (!GetExitCodeProcess (wait_hnd[active], &retval)) { DebPrint (("Wait.GetExitCodeProcess failed with %lu\n", GetLastError ())); retval = 1; } if (retval == STILL_ACTIVE) { /* Should never happen */ DebPrint (("Wait.WaitForMultipleObjects returned an active process\n")); errno = EINVAL; return -1; } /* Massage the exit code from the process to match the format expected by the WIFSTOPPED et al macros in syswait.h. Only WIFSIGNALLED and WIFEXITED are supported; WIFSTOPPED doesn't make sense under NT. */ if (retval == STATUS_CONTROL_C_EXIT) retval = SIGINT; else retval <<= 8; cp = cps[active]; if (status) { *status = retval; } else if (synch_process_alive) { synch_process_alive = 0; synch_process_retcode = retval; TerminateThread (cp->thrd, 0); CloseHandle (cp->thrd); CloseHandle (cp->char_consumed); CloseHandle (cp->char_avail); CloseHandle (cp->process); DEACTIVATE_CHILD (cp); } return cp->pid; } /* We pass our process ID to our children by setting up an environment variable in their environment. */ char ppid_env_var_buffer[64]; /* When a new child process is created we need to register it in our list, so intercept spawn requests. */ int win32_spawnve (int mode, char *cmdname, char **argv, char **envp) { Lisp_Object program, full; char *cmdline, *env, *parg, **targ; int arglen; PROCESS_INFORMATION pi; /* Handle executable names without an executable suffix. */ program = make_string (cmdname, strlen (cmdname)); if (NILP (Ffile_executable_p (program))) { struct gcpro gcpro1; full = Qnil; GCPRO1 (program); openp (Vexec_path, program, EXEC_SUFFIXES, &full, 1); UNGCPRO; if (NILP (full)) { errno = EINVAL; return -1; } cmdname = XSTRING (full)->data; argv[0] = cmdname; } if (child_proc_count == MAX_CHILDREN) { errno = EAGAIN; return -1; } /* We don't care about the other modes */ if (mode != _P_NOWAIT) { errno = EINVAL; return -1; } /* we have to do some conjuring here to put argv and envp into the form CreateProcess wants... argv needs to be a space separated/null terminated list of parameters, and envp is a null separated/double-null terminated list of parameters. Since I have no idea how large argv and envp are likely to be we figure out list lengths on the fly and allocate them. */ /* do argv... */ arglen = 0; targ = argv; while (*targ) { arglen += strlen (*targ++) + 1; } cmdline = malloc (arglen); if (cmdline == NULL) { errno = ENOMEM; goto EH_Fail; } targ = argv; parg = cmdline; while (*targ) { strcpy (parg, *targ); parg += strlen (*targ++); *parg++ = ' '; } *--parg = '\0'; /* and envp... */ arglen = 1; targ = envp; while (*targ) { arglen += strlen (*targ++) + 1; } sprintf (ppid_env_var_buffer, "__PARENT_PROCESS_ID=%d", GetCurrentProcessId ()); arglen += strlen (ppid_env_var_buffer) + 1; env = malloc (arglen); if (env == NULL) { errno = ENOMEM; goto EH_cmdline; } targ = envp; parg = env; while (*targ) { strcpy (parg, *targ); parg += strlen (*targ++); *parg++ = '\0'; } strcpy (parg, ppid_env_var_buffer); parg += strlen (ppid_env_var_buffer); *parg++ = '\0'; *parg = '\0'; /* Now create the process. */ if (!create_child (cmdname, cmdline, env, &pi)) { errno = ENOEXEC; goto EH_env; } return pi.dwProcessId; EH_env: free (env); EH_cmdline: free (cmdline); EH_Fail: return -1; } /* Emulate the select call Wait for available input on any of the given rfds, or timeout if a timeout is given and no input is detected wfds and efds are not supported and must be NULL. */ /* From ntterm.c */ extern HANDLE keyboard_handle; /* From process.c */ extern int proc_buffered_char[]; int sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds, EMACS_TIME *timeout) { SELECT_TYPE orfds; DWORD timeout_ms; int i, nh, nr; DWORD active; child_process *cp, *cps[MAX_CHILDREN + 1]; HANDLE wait_hnd[MAX_CHILDREN + 1]; #ifdef HAVE_NTGUI1 BOOL keyboardwait = FALSE ; #endif /* HAVE_NTGUI */ /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */ if (rfds == NULL && wfds == NULL && efds == NULL && timeout != NULL) { #ifdef HAVE_TIMEVAL Sleep (timeout->tv_sec * 1000 + timeout->tv_usec / 1000); #else Sleep ((*timeout) * 1000); #endif return 0; } /* Otherwise, we only handle rfds, so fail otherwise. */ if (rfds == NULL || wfds != NULL || efds != NULL) { errno = EINVAL; return -1; } orfds = *rfds; FD_ZERO (rfds); nr = 0; /* Build a list of handles to wait on. */ nh = 0; for (i = 0; i < nfds; i++) if (FD_ISSET (i, &orfds)) { if (i == 0) { #ifdef HAVE_NTGUI1 keyboardwait = TRUE ; #else /* Handle stdin specially */ wait_hnd[nh] = keyboard_handle; cps[nh] = NULL; nh++; #endif /* HAVE_NTGUI */ /* Check for any emacs-generated input in the queue since it won't be detected in the wait */ if (detect_input_pending ()) { FD_SET (i, rfds); nr++; } } else { /* Child process input */ cp = find_child_fd (i); if (cp) { #ifdef FULL_DEBUG DebPrint (("select waiting on child %d fd %d\n", cp-child_procs, i)); #endif wait_hnd[nh] = cp->char_avail; cps[nh] = cp; nh++; } else { /* Unable to find something to wait on for this fd, fail */ DebPrint (("select unable to find child process " "for fd %ld\n", i)); nh = 0; break; } } } /* Never do this in win32 since we will not get paint messages */ #ifndef HAVE_NTGUI1 /* Nothing to look for, so we didn't find anything */ if (nh == 0) { if (timeout) #ifdef HAVE_TIMEVAL Sleep (timeout->tv_sec * 1000 + timeout->tv_usec / 1000); #else Sleep ((*timeout) * 1000); #endif return 0; } #endif /* !HAVE_NTGUI */ /* Check for immediate return without waiting */ if (nr > 0) return nr; /* Wait for input If a child process dies while this is waiting, its pipe will break so the reader thread will signal an error condition, thus, the wait will wake up */ #ifdef HAVE_TIMEVAL timeout_ms = timeout ? (timeout->tv_sec * 1000 + timeout->tv_usec / 1000) : INFINITE; #else timeout_ms = timeout ? *timeout*1000 : INFINITE; #endif #ifdef HAVE_NTGUI1 active = MsgWaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms,QS_ALLINPUT); #else active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms); #endif /* HAVE_NTGUI */ if (active == WAIT_FAILED) { DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n", nh, timeout_ms, GetLastError ())); /* Is there a better error? */ errno = EBADF; return -1; } else if (active == WAIT_TIMEOUT) { return 0; } #ifdef HAVE_NTGUI1 else if (active == WAIT_OBJECT_0 + nh) { /* Keyboard input available */ FD_SET (0, rfds); /* This shouldn't be necessary, but apparently just setting the input fd is not good enough for emacs */ // read_input_waiting (); return (1) ; } #endif /* HAVE_NTGUI */ else if (active >= WAIT_OBJECT_0 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS) { active -= WAIT_OBJECT_0; } else if (active >= WAIT_ABANDONED_0 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS) { active -= WAIT_ABANDONED_0; } if (cps[active] == NULL) { /* Keyboard input available */ FD_SET (0, rfds); nr++; /* This shouldn't be necessary, but apparently just setting the input fd is not good enough for emacs */ read_input_waiting (); } else { /* Child process */ cp = cps[active]; /* If status is FALSE the read failed so don't report input */ if (cp->status) { FD_SET (cp->fd, rfds); proc_buffered_char[cp->fd] = cp->chr; nr++; } else { /* The SIGCHLD handler will do a Wait so we know it won't return until the process is dead We force Wait to only wait for this process to avoid it picking up other children that happen to be dead but that we haven't noticed yet SIG_DFL for SIGCHLD is ignore? */ if (sig_handlers[SIGCHLD] != SIG_DFL && sig_handlers[SIGCHLD] != SIG_IGN) { #ifdef FULL_DEBUG DebPrint (("select calling SIGCHLD handler for pid %d\n", cp->pid)); #endif dead_child = cp; sig_handlers[SIGCHLD](SIGCHLD); dead_child = NULL; } /* Clean up the child process entry in the table */ remove_child (cp); } } return nr; } /* Substitute for certain kill () operations */ int win32_kill_process (int pid, int sig) { child_process *cp; /* Only handle signals that will result in the process dying */ if (sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP) { errno = EINVAL; return -1; } cp = find_child_pid (pid); if (cp == NULL) { DebPrint (("win32_kill_process didn't find a child with pid %lu\n", pid)); errno = ECHILD; return -1; } if (sig == SIGINT) { /* Fake Ctrl-Break. */ if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid)) { DebPrint (("win32_kill_process.GenerateConsoleCtrlEvent return %d " "for pid %lu\n", GetLastError (), pid)); errno = EINVAL; return -1; } } else { /* Kill the process. On Win32 this doesn't kill child processes so it doesn't work very well for shells which is why it's not used in every case. */ if (!TerminateProcess (cp->process, 0xff)) { DebPrint (("win32_kill_process.TerminateProcess returned %d " "for pid %lu\n", GetLastError (), pid)); errno = EINVAL; return -1; } } return 0; } /* If the channel is a pipe this read might block since we don't know how many characters are available, so check and read only what's there We also need to wake up the reader thread once we've read our data. */ int read_child_output (int fd, char *buf, int max) { HANDLE h; int to_read, nchars; DWORD waiting; child_process *cp; h = (HANDLE)_get_osfhandle (fd); if (GetFileType (h) == FILE_TYPE_PIPE) { PeekNamedPipe (h, NULL, 0, NULL, &waiting, NULL); to_read = min (waiting, (DWORD)max); } else to_read = max; /* Use read to get CRLF translation */ nchars = read (fd, buf, to_read); if (GetFileType (h) == FILE_TYPE_PIPE) { /* Wake up the reader thread for this process */ cp = find_child_fd (fd); if (cp) { if (!SetEvent (cp->char_consumed)) DebPrint (("read_child_output.SetEvent failed with " "%lu for fd %ld\n", GetLastError (), fd)); } else DebPrint (("read_child_output couldn't find a child with fd %d\n", fd)); } return nchars; } emacs-19.30/src/ntterm.c100444 23073 1 36405 6047603101 14250 0ustar voelkerdaemon/* Terminal hooks for Windows NT port of GNU Emacs. Copyright (C) 1992 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. Tim Fleehart (apollo@online.com) 1-17-92 Geoff Voelker (voelker@cs.washington.edu) 9-12-93 */ #include #include #include #include #include "lisp.h" #include "frame.h" #include "disptab.h" #include "termhooks.h" #include "ntinevt.h" /* from window.c */ extern Lisp_Object Frecenter (); /* from keyboard.c */ extern int detect_input_pending (); /* from sysdep.c */ extern int read_input_pending (); extern FRAME_PTR updating_frame; extern int meta_key; static void move_cursor (int row, int col); static void clear_to_end (void); static void clear_frame (void); static void clear_end_of_line (int); static void ins_del_lines (int vpos, int n); static void change_line_highlight (int, int, int); static void reassert_line_highlight (int, int); static void insert_glyphs (GLYPH *start, int len); static void write_glyphs (GLYPH *string, int len); static void delete_glyphs (int n); void nt_ring_bell (void); static void reset_terminal_modes (void); static void set_terminal_modes (void); static void set_terminal_window (int size); static void update_begin (FRAME_PTR f); static void update_end (FRAME_PTR f); static void reset_kbd (void); static void unset_kbd (void); static int hl_mode (int new_highlight); void DebPrint () { } /* Init hook called in init_keyboard. */ void (*keyboard_init_hook)(void) = reset_kbd; COORD cursor_coords; HANDLE prev_screen, cur_screen; UCHAR char_attr, char_attr_normal, char_attr_reverse; HANDLE keyboard_handle; /* Setting this as the ctrl handler prevents emacs from being killed when someone hits ^C in a 'suspended' session (child shell). Also ignore Ctrl-Break signals. */ BOOL ctrl_c_handler (unsigned long type) { return (type == CTRL_C_EVENT || type == CTRL_BREAK_EVENT); } /* If we're updating a frame, use it as the current frame Otherwise, use the selected frame. */ #define PICK_FRAME() (updating_frame ? updating_frame : selected_frame) /* Move the cursor to (row, col). */ void move_cursor (int row, int col) { cursor_coords.X = col; cursor_coords.Y = row; if (updating_frame == (FRAME_PTR) NULL) { SetConsoleCursorPosition (cur_screen, cursor_coords); } } /* Clear from cursor to end of screen. */ void clear_to_end (void) { FRAME_PTR f = PICK_FRAME (); clear_end_of_line (FRAME_WIDTH (f) - 1); ins_del_lines (cursor_coords.Y, FRAME_HEIGHT (f) - cursor_coords.Y - 1); } /* Clear the frame. */ void clear_frame (void) { SMALL_RECT scroll; COORD dest; CHAR_INFO fill; FRAME_PTR f = PICK_FRAME (); hl_mode (0); scroll.Top = 0; scroll.Bottom = FRAME_HEIGHT (f) - 1; scroll.Left = 0; scroll.Right = FRAME_WIDTH (f) - 1; dest.Y = FRAME_HEIGHT (f); dest.X = 0; fill.Char.AsciiChar = 0x20; fill.Attributes = char_attr; ScrollConsoleScreenBuffer (cur_screen, &scroll, NULL, dest, &fill); move_cursor (0, 0); } static GLYPH glyph_base[256]; static BOOL ceol_initialized = FALSE; /* Clear from Cursor to end (what's "standout marker"?). */ void clear_end_of_line (int end) { if (!ceol_initialized) { int i; for (i = 0; i < 256; i++) { glyph_base[i] = SPACEGLYPH; /* empty space */ } ceol_initialized = TRUE; } write_glyphs (glyph_base, end - cursor_coords.X); /* fencepost ? */ } /* Insert n lines at vpos. if n is negative delete -n lines. */ void ins_del_lines (int vpos, int n) { int i, nb, save_highlight; SMALL_RECT scroll; COORD dest; CHAR_INFO fill; FRAME_PTR f = PICK_FRAME (); if (n < 0) { scroll.Top = vpos - n; scroll.Bottom = FRAME_HEIGHT (f); dest.Y = vpos; } else { scroll.Top = vpos; scroll.Bottom = FRAME_HEIGHT (f) - n; dest.Y = vpos + n; } scroll.Left = 0; scroll.Right = FRAME_WIDTH (f); dest.X = 0; save_highlight = hl_mode (0); fill.Char.AsciiChar = 0x20; fill.Attributes = char_attr; ScrollConsoleScreenBuffer (cur_screen, &scroll, NULL, dest, &fill); /* Here we have to deal with a win32 console flake: If the scroll region looks like abc and we scroll c to a and fill with d we get cbd... if we scroll block c one line at a time to a, we get cdd... Emacs expects cdd consistently... So we have to deal with that here... (this also occurs scrolling the same way in the other direction. */ if (n > 0) { if (scroll.Bottom < dest.Y) { for (i = scroll.Bottom; i < dest.Y; i++) { move_cursor (i, 0); clear_end_of_line (FRAME_WIDTH (f)); } } } else { nb = dest.Y + (scroll.Bottom - scroll.Top) + 1; if (nb < scroll.Top) { for (i = nb; i < scroll.Top; i++) { move_cursor (i, 0); clear_end_of_line (FRAME_WIDTH (f)); } } } cursor_coords.X = 0; cursor_coords.Y = vpos; hl_mode (save_highlight); } /* Changes attribute to use when drawing characters to control. */ static int hl_mode (int new_highlight) { static int highlight = 0; int old_highlight; old_highlight = highlight; highlight = (new_highlight != 0); if (highlight) { char_attr = char_attr_reverse; } else { char_attr = char_attr_normal; } return old_highlight; } /* Call this when about to modify line at position VPOS and change whether it is highlighted. */ void change_line_highlight (int new_highlight, int vpos, int first_unused_hpos) { hl_mode (new_highlight); move_cursor (vpos, 0); clear_end_of_line (first_unused_hpos); } /* External interface to control of standout mode. Call this when about to * modify line at position VPOS and not change whether it is highlighted. */ void reassert_line_highlight (int highlight, int vpos) { hl_mode (highlight); vpos; /* pedantic compiler silencer */ } #undef LEFT #undef RIGHT #define LEFT 1 #define RIGHT 0 void scroll_line (int dist, int direction) { /* The idea here is to implement a horizontal scroll in one line to implement delete and half of insert. */ SMALL_RECT scroll; COORD dest; CHAR_INFO fill; FRAME_PTR f = PICK_FRAME (); scroll.Top = cursor_coords.Y; scroll.Bottom = cursor_coords.Y; if (direction == LEFT) { scroll.Left = cursor_coords.X + dist; scroll.Right = FRAME_WIDTH (f) - 1; } else { scroll.Left = cursor_coords.X; scroll.Right = FRAME_WIDTH (f) - dist - 1; } dest.X = cursor_coords.X; dest.Y = cursor_coords.Y; fill.Char.AsciiChar = 0x20; fill.Attributes = char_attr; ScrollConsoleScreenBuffer (cur_screen, &scroll, NULL, dest, &fill); } /* If start is zero insert blanks instead of a string at start ?. */ void insert_glyphs (register GLYPH *start, register int len) { scroll_line (len, RIGHT); /* Move len chars to the right starting at cursor_coords, fill with blanks */ if (start) { /* Print the first len characters of start, cursor_coords.X adjusted by write_glyphs. */ write_glyphs (start, len); } else { clear_end_of_line (cursor_coords.X + len); } } void write_glyphs (register GLYPH *string, register int len) { register unsigned int glyph_len = GLYPH_TABLE_LENGTH; Lisp_Object *glyph_table = GLYPH_TABLE_BASE; FRAME_PTR f = PICK_FRAME (); register char *ptr; GLYPH glyph; WORD *attrs; char *chars; int i; attrs = alloca (len * sizeof (*attrs)); chars = alloca (len * sizeof (*chars)); if (attrs == NULL || chars == NULL) { printf ("alloca failed in write_glyphs\n"); return; } /* We have to deal with the glyph indirection...go over the glyph buffer and extract the characters. */ ptr = chars; while (--len >= 0) { glyph = *string++; if (glyph > glyph_len) { *ptr++ = glyph & 0xFF; continue; } GLYPH_FOLLOW_ALIASES (glyph_table, glyph_len, glyph); #ifndef HAVE_NTGUI if (GLYPH_FACE (fixfix, glyph) != 0) printf ("Glyph face is %d\n", GLYPH_FACE (fixfix, glyph)); #endif /* !HAVE_NTGUI */ if (GLYPH_SIMPLE_P (glyph_table, glyph_len, glyph)) { *ptr++ = glyph & 0xFF; continue; } for (i = 0; i < GLYPH_LENGTH (glyph_table, glyph); i++) { *ptr++ = (GLYPH_STRING (glyph_table, glyph))[i]; } } /* Number of characters we have in the buffer. */ len = ptr-chars; /* Fill in the attributes for these characters. */ for (i = 0; i < len; i++) attrs[i] = char_attr; /* Write the attributes. */ if (!WriteConsoleOutputAttribute (cur_screen, attrs, len, cursor_coords, &i)) { printf ("Failed writing console attributes: %d\n", GetLastError ()); fflush (stdout); } /* Write the characters. */ if (!WriteConsoleOutputCharacter (cur_screen, chars, len, cursor_coords, &i)) { printf ("Failed writing console characters: %d\n", GetLastError ()); fflush (stdout); } cursor_coords.X += len; move_cursor (cursor_coords.Y, cursor_coords.X); } void delete_glyphs (int n) { /* delete chars means scroll chars from cursor_coords.X + n to cursor_coords.X, anything beyond the edge of the screen should come out empty... */ scroll_line (n, LEFT); } static unsigned int sound_type = 0xFFFFFFFF; void nt_ring_bell (void) { if (sound_type == 0xFFFFFFFF) Beep (666, 100); else MessageBeep (sound_type); } DEFUN ("set-message-beep", Fset_message_beep, Sset_message_beep, 1, 1, 0, "Set the sound generated when the bell is rung.\n\ SOUND is 'asterisk, 'exclamation, 'hand, 'question, or 'ok\n\ to use the corresponding system sound for the bell.\n\ SOUND is nil to use the normal beep.") (sound) Lisp_Object sound; { CHECK_SYMBOL (sound, 0); if (NILP (sound)) sound_type = 0xFFFFFFFF; else if (EQ (sound, intern ("asterisk"))) sound_type = MB_ICONASTERISK; else if (EQ (sound, intern ("exclamation"))) sound_type = MB_ICONEXCLAMATION; else if (EQ (sound, intern ("hand"))) sound_type = MB_ICONHAND; else if (EQ (sound, intern ("question"))) sound_type = MB_ICONQUESTION; else if (EQ (sound, intern ("ok"))) sound_type = MB_OK; else sound_type = 0xFFFFFFFF; return sound; } /* Put our console back up, for ending a suspended session. */ void take_console (void) { reset_kbd (); SetConsoleActiveScreenBuffer (cur_screen); } void reset_terminal_modes (void) { unset_kbd (); SetConsoleActiveScreenBuffer (prev_screen); } void set_terminal_modes (void) { CONSOLE_CURSOR_INFO cci; if (cur_screen == NULL) { reset_kbd (); cur_screen = CreateConsoleScreenBuffer (GENERIC_READ | GENERIC_WRITE, 0, NULL, CONSOLE_TEXTMODE_BUFFER, NULL); if (cur_screen == INVALID_HANDLE_VALUE) { printf ("CreateConsoleScreenBuffer failed in ResetTerm\n"); printf ("LastError = 0x%lx\n", GetLastError ()); fflush (stdout); exit (0); } SetConsoleActiveScreenBuffer (cur_screen); /* make cursor big and visible (100 on Win95 makes it disappear) */ cci.dwSize = 99; cci.bVisible = TRUE; (void) SetConsoleCursorInfo (cur_screen, &cci); } } /* hmmm... perhaps these let us bracket screen changes so that we can flush clumps rather than one-character-at-a-time... we'll start with not moving the cursor while an update is in progress. */ void update_begin (FRAME_PTR f) { } void update_end (FRAME_PTR f) { SetConsoleCursorPosition (cur_screen, cursor_coords); } void set_terminal_window (int size) { } void unset_kbd (void) { SetConsoleMode (keyboard_handle, ENABLE_PROCESSED_INPUT | ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT | ENABLE_MOUSE_INPUT); } void reset_kbd (void) { keyboard_handle = GetStdHandle (STD_INPUT_HANDLE); SetConsoleMode (keyboard_handle, ENABLE_MOUSE_INPUT | ENABLE_WINDOW_INPUT); } typedef int (*term_hook) (); void initialize_win_nt_display (void) { CONSOLE_SCREEN_BUFFER_INFO info; cursor_to_hook = (term_hook) move_cursor; raw_cursor_to_hook = (term_hook) move_cursor; clear_to_end_hook = (term_hook) clear_to_end; clear_frame_hook = (term_hook) clear_frame; clear_end_of_line_hook = (term_hook) clear_end_of_line; ins_del_lines_hook = (term_hook) ins_del_lines; change_line_highlight_hook = (term_hook) change_line_highlight; reassert_line_highlight_hook = (term_hook) reassert_line_highlight; insert_glyphs_hook = (term_hook) insert_glyphs; write_glyphs_hook = (term_hook) write_glyphs; delete_glyphs_hook = (term_hook) delete_glyphs; ring_bell_hook = (term_hook) nt_ring_bell; reset_terminal_modes_hook = (term_hook) reset_terminal_modes; set_terminal_modes_hook = (term_hook) set_terminal_modes; set_terminal_window_hook = (term_hook) set_terminal_window; update_begin_hook = (term_hook) update_begin; update_end_hook = (term_hook) update_end; read_socket_hook = win32_read_socket; mouse_position_hook = win32_mouse_position; prev_screen = GetStdHandle (STD_OUTPUT_HANDLE); set_terminal_modes (); GetConsoleScreenBufferInfo (cur_screen, &info); meta_key = 1; char_attr = info.wAttributes & 0xFF; char_attr_normal = char_attr; char_attr_reverse = ((char_attr & 0xf) << 4) + ((char_attr & 0xf0) >> 4); FRAME_HEIGHT (selected_frame) = info.dwSize.Y; /* lines per page */ FRAME_WIDTH (selected_frame) = info.dwSize.X; /* characters per line */ move_cursor (0, 0); clear_frame (); } DEFUN ("set-screen-color", Fset_screen_color, Sset_screen_color, 2, 2, 0, "Set screen colors.") (foreground, background) Lisp_Object foreground; Lisp_Object background; { char_attr_normal = XFASTINT (foreground) + (XFASTINT (background) << 4); char_attr_reverse = XFASTINT (background) + (XFASTINT (foreground) << 4); Frecenter (Qnil); return Qt; } DEFUN ("set-cursor-size", Fset_cursor_size, Sset_cursor_size, 1, 1, 0, "Set cursor size.") (size) Lisp_Object size; { CONSOLE_CURSOR_INFO cci; cci.dwSize = XFASTINT (size); cci.bVisible = TRUE; (void) SetConsoleCursorInfo (cur_screen, &cci); return Qt; } #ifndef HAVE_NTGUI void pixel_to_glyph_coords (FRAME_PTR f, int pix_x, int pix_y, int *x, int *y, void *bounds, int noclip) { *x = pix_x; *y = pix_y; } void glyph_to_pixel_coords (FRAME_PTR f, int x, int y, int *pix_x, int *pix_y) { *pix_x = x; *pix_y = y; } #endif /* !HAVE_NTGUI */ void syms_of_ntterm () { defsubr (&Sset_screen_color); defsubr (&Sset_cursor_size); defsubr (&Sset_message_beep); } emacs-19.30/src/pre-crt0.c100444 12241 12 616 5444474606 14033 0ustar rolandstaff/* This file is loaded before crt0.o on machines where we do not remap part of the data space into text space in unexec. On these machines, there is no problem with standard crt0.o's that make environ an initialized variable. However, we do need to make sure the label data_start exists anyway. */ /* Create a label to appear at the beginning of data space. */ int data_start = 0; emacs-19.30/src/prefix-args.c100666 13437 1 3104 5405345171 14426 0ustar jimbdaemon/* prefix-args.c - echo each argument, prefixed by a string. Jim Blandy - September 1992 When using GCC 2 as the linker in the build process, options intended for the linker need to be prefixed with the "-Xlinker" option. If an option takes an argument, we need to use -Xlinker twice - once for the option and once for its argument. For example, to run the linker with the options "-Bstatic" "-e" "_start", you'd need to pass the following options to GCC: -Xlinker -Bstatic -Xlinker -e -Xlinker _start. The Emacs makefile used to use a Bourne Shell `for' loop to prefix each linker option with "-Xlinker", but 1) the for loop was hairier than one might hope because it had to work when there were no arguments to pass to the linker - the shell barfs on a loop like this: for arg in ; do echo -Xlinker "$arg"; done and 2) the whole compilation command containing this loop seems to exit with a non-zero status and halt the build under Ultrix. If I can't write a completely portable program to do this in C, I'm quitting and taking up gardening. */ #include main (argc, argv) int argc; char **argv; { char *progname; char *prefix; progname = argv[0]; argc--, argv++; if (argc < 1) { fprintf (stderr, "Usage: %s PREFIX ARGS...\n\ Echo each ARG preceded by PREFIX and a space.\n", progname); exit (2); } prefix = argv[0]; argc--, argv++; for (; argc > 0; argc--, argv++) printf ("%s %s%c", prefix, argv[0], (argc > 1) ? ' ' : '\n'); exit (0); } emacs-19.30/src/print.c100444 12120 1 76443 6050673204 13227 0ustar rmsdaemon/* Lisp object printing and output streams. Copyright (C) 1985, 86, 88, 93, 94, 95 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. */ #include #include #undef NULL #include "lisp.h" #ifndef standalone #include "buffer.h" #include "frame.h" #include "window.h" #include "process.h" #include "dispextern.h" #include "termchar.h" #include "keyboard.h" #endif /* not standalone */ #ifdef USE_TEXT_PROPERTIES #include "intervals.h" #endif Lisp_Object Vstandard_output, Qstandard_output; #ifdef LISP_FLOAT_TYPE Lisp_Object Vfloat_output_format, Qfloat_output_format; #endif /* LISP_FLOAT_TYPE */ /* Avoid actual stack overflow in print. */ int print_depth; /* Detect most circularities to print finite output. */ #define PRINT_CIRCLE 200 Lisp_Object being_printed[PRINT_CIRCLE]; /* Maximum length of list to print in full; noninteger means effectively infinity */ Lisp_Object Vprint_length; /* Maximum depth of list to print in full; noninteger means effectively infinity. */ Lisp_Object Vprint_level; /* Nonzero means print newlines in strings as \n. */ int print_escape_newlines; Lisp_Object Qprint_escape_newlines; /* Nonzero means print newline to stdout before next minibuffer message. Defined in xdisp.c */ extern int noninteractive_need_newline; #ifdef MAX_PRINT_CHARS static int print_chars; static int max_print; #endif /* MAX_PRINT_CHARS */ void print_interval (); #if 0 /* Convert between chars and GLYPHs */ int glyphlen (glyphs) register GLYPH *glyphs; { register int i = 0; while (glyphs[i]) i++; return i; } void str_to_glyph_cpy (str, glyphs) char *str; GLYPH *glyphs; { register GLYPH *gp = glyphs; register char *cp = str; while (*cp) *gp++ = *cp++; } void str_to_glyph_ncpy (str, glyphs, n) char *str; GLYPH *glyphs; register int n; { register GLYPH *gp = glyphs; register char *cp = str; while (n-- > 0) *gp++ = *cp++; } void glyph_to_str_cpy (glyphs, str) GLYPH *glyphs; char *str; { register GLYPH *gp = glyphs; register char *cp = str; while (*gp) *str++ = *gp++ & 0377; } #endif /* Low level output routines for characters and strings */ /* Lisp functions to do output using a stream must have the stream in a variable called printcharfun and must start with PRINTPREPARE and end with PRINTFINISH. Use PRINTCHAR to output one character, or call strout to output a block of characters. Also, each one must have the declarations struct buffer *old = current_buffer; int old_point = -1, start_point; Lisp_Object original; */ #define PRINTPREPARE \ original = printcharfun; \ if (NILP (printcharfun)) printcharfun = Qt; \ if (BUFFERP (printcharfun)) \ { if (XBUFFER (printcharfun) != current_buffer) \ Fset_buffer (printcharfun); \ printcharfun = Qnil;} \ if (MARKERP (printcharfun)) \ { if (!(XMARKER (original)->buffer)) \ error ("Marker does not point anywhere"); \ if (XMARKER (original)->buffer != current_buffer) \ set_buffer_internal (XMARKER (original)->buffer); \ old_point = point; \ SET_PT (marker_position (printcharfun)); \ start_point = point; \ printcharfun = Qnil;} #define PRINTFINISH \ if (MARKERP (original)) \ Fset_marker (original, make_number (point), Qnil); \ if (old_point >= 0) \ SET_PT (old_point + (old_point >= start_point \ ? point - start_point : 0)); \ if (old != current_buffer) \ set_buffer_internal (old) #define PRINTCHAR(ch) printchar (ch, printcharfun) /* Index of first unused element of FRAME_MESSAGE_BUF(mini_frame). */ static int printbufidx; static void printchar (ch, fun) unsigned char ch; Lisp_Object fun; { Lisp_Object ch1; #ifdef MAX_PRINT_CHARS if (max_print) print_chars++; #endif /* MAX_PRINT_CHARS */ #ifndef standalone if (EQ (fun, Qnil)) { QUIT; insert (&ch, 1); return; } if (EQ (fun, Qt)) { FRAME_PTR mini_frame = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))); if (noninteractive) { putchar (ch); noninteractive_need_newline = 1; return; } if (echo_area_glyphs != FRAME_MESSAGE_BUF (mini_frame) || !message_buf_print) { message_log_maybe_newline (); echo_area_glyphs = FRAME_MESSAGE_BUF (mini_frame); printbufidx = 0; echo_area_glyphs_length = 0; message_buf_print = 1; } message_dolog (&ch, 1, 0); if (printbufidx < FRAME_WIDTH (mini_frame) - 1) FRAME_MESSAGE_BUF (mini_frame)[printbufidx++] = ch; FRAME_MESSAGE_BUF (mini_frame)[printbufidx] = 0; echo_area_glyphs_length = printbufidx; return; } #endif /* not standalone */ XSETFASTINT (ch1, ch); call1 (fun, ch1); } static void strout (ptr, size, printcharfun) char *ptr; int size; Lisp_Object printcharfun; { int i = 0; if (EQ (printcharfun, Qnil)) { insert (ptr, size >= 0 ? size : strlen (ptr)); #ifdef MAX_PRINT_CHARS if (max_print) print_chars += size >= 0 ? size : strlen(ptr); #endif /* MAX_PRINT_CHARS */ return; } if (EQ (printcharfun, Qt)) { FRAME_PTR mini_frame = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))); i = size >= 0 ? size : strlen (ptr); #ifdef MAX_PRINT_CHARS if (max_print) print_chars += i; #endif /* MAX_PRINT_CHARS */ if (noninteractive) { fwrite (ptr, 1, i, stdout); noninteractive_need_newline = 1; return; } if (echo_area_glyphs != FRAME_MESSAGE_BUF (mini_frame) || !message_buf_print) { message_log_maybe_newline (); echo_area_glyphs = FRAME_MESSAGE_BUF (mini_frame); printbufidx = 0; echo_area_glyphs_length = 0; message_buf_print = 1; } message_dolog (ptr, i, 0); if (i > FRAME_WIDTH (mini_frame) - printbufidx - 1) i = FRAME_WIDTH (mini_frame) - printbufidx - 1; bcopy (ptr, &FRAME_MESSAGE_BUF (mini_frame) [printbufidx], i); printbufidx += i; echo_area_glyphs_length = printbufidx; FRAME_MESSAGE_BUF (mini_frame) [printbufidx] = 0; return; } if (size >= 0) while (i < size) PRINTCHAR (ptr[i++]); else while (ptr[i]) PRINTCHAR (ptr[i++]); } /* Print the contents of a string STRING using PRINTCHARFUN. It isn't safe to use strout in many cases, because printing one char can relocate. */ print_string (string, printcharfun) Lisp_Object string; Lisp_Object printcharfun; { if (EQ (printcharfun, Qt)) /* strout is safe for output to a frame (echo area). */ strout (XSTRING (string)->data, XSTRING (string)->size, printcharfun); else if (EQ (printcharfun, Qnil)) { #ifdef MAX_PRINT_CHARS if (max_print) print_chars += XSTRING (string)->size; #endif /* MAX_PRINT_CHARS */ insert_from_string (string, 0, XSTRING (string)->size, 1); } else { /* Otherwise, fetch the string address for each character. */ int i; int size = XSTRING (string)->size; struct gcpro gcpro1; GCPRO1 (string); for (i = 0; i < size; i++) PRINTCHAR (XSTRING (string)->data[i]); UNGCPRO; } } DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0, "Output character CHAR to stream PRINTCHARFUN.\n\ PRINTCHARFUN defaults to the value of `standard-output' (which see).") (ch, printcharfun) Lisp_Object ch, printcharfun; { struct buffer *old = current_buffer; int old_point = -1; int start_point; Lisp_Object original; if (NILP (printcharfun)) printcharfun = Vstandard_output; CHECK_NUMBER (ch, 0); PRINTPREPARE; PRINTCHAR (XINT (ch)); PRINTFINISH; return ch; } /* Used from outside of print.c to print a block of SIZE chars at DATA on the default output stream. Do not use this on the contents of a Lisp string. */ write_string (data, size) char *data; int size; { struct buffer *old = current_buffer; Lisp_Object printcharfun; int old_point = -1; int start_point; Lisp_Object original; printcharfun = Vstandard_output; PRINTPREPARE; strout (data, size, printcharfun); PRINTFINISH; } /* Used from outside of print.c to print a block of SIZE chars at DATA on a specified stream PRINTCHARFUN. Do not use this on the contents of a Lisp string. */ write_string_1 (data, size, printcharfun) char *data; int size; Lisp_Object printcharfun; { struct buffer *old = current_buffer; int old_point = -1; int start_point; Lisp_Object original; PRINTPREPARE; strout (data, size, printcharfun); PRINTFINISH; } #ifndef standalone void temp_output_buffer_setup (bufname) char *bufname; { register struct buffer *old = current_buffer; register Lisp_Object buf; Fset_buffer (Fget_buffer_create (build_string (bufname))); current_buffer->directory = old->directory; current_buffer->read_only = Qnil; Ferase_buffer (); XSETBUFFER (buf, current_buffer); specbind (Qstandard_output, buf); set_buffer_internal (old); } Lisp_Object internal_with_output_to_temp_buffer (bufname, function, args) char *bufname; Lisp_Object (*function) (); Lisp_Object args; { int count = specpdl_ptr - specpdl; Lisp_Object buf, val; struct gcpro gcpro1; GCPRO1 (args); record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); temp_output_buffer_setup (bufname); buf = Vstandard_output; UNGCPRO; val = (*function) (args); GCPRO1 (val); temp_output_buffer_show (buf); UNGCPRO; return unbind_to (count, val); } DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer, 1, UNEVALLED, 0, "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\ The buffer is cleared out initially, and marked as unmodified when done.\n\ All output done by BODY is inserted in that buffer by default.\n\ The buffer is displayed in another window, but not selected.\n\ The value of the last form in BODY is returned.\n\ If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\ If variable `temp-buffer-show-function' is non-nil, call it at the end\n\ to get the buffer displayed. It gets one argument, the buffer to display.") (args) Lisp_Object args; { struct gcpro gcpro1; Lisp_Object name; int count = specpdl_ptr - specpdl; Lisp_Object buf, val; GCPRO1(args); name = Feval (Fcar (args)); UNGCPRO; CHECK_STRING (name, 0); temp_output_buffer_setup (XSTRING (name)->data); buf = Vstandard_output; val = Fprogn (Fcdr (args)); temp_output_buffer_show (buf); return unbind_to (count, val); } #endif /* not standalone */ static void print (); DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0, "Output a newline to stream PRINTCHARFUN.\n\ If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.") (printcharfun) Lisp_Object printcharfun; { struct buffer *old = current_buffer; int old_point = -1; int start_point; Lisp_Object original; if (NILP (printcharfun)) printcharfun = Vstandard_output; PRINTPREPARE; PRINTCHAR ('\n'); PRINTFINISH; return Qt; } DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0, "Output the printed representation of OBJECT, any Lisp object.\n\ Quoting characters are printed when needed to make output that `read'\n\ can handle, whenever this is possible.\n\ Output stream is PRINTCHARFUN, or value of `standard-output' (which see).") (obj, printcharfun) Lisp_Object obj, printcharfun; { struct buffer *old = current_buffer; int old_point = -1; int start_point; Lisp_Object original; #ifdef MAX_PRINT_CHARS max_print = 0; #endif /* MAX_PRINT_CHARS */ if (NILP (printcharfun)) printcharfun = Vstandard_output; PRINTPREPARE; print_depth = 0; print (obj, printcharfun, 1); PRINTFINISH; return obj; } /* a buffer which is used to hold output being built by prin1-to-string */ Lisp_Object Vprin1_to_string_buffer; DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0, "Return a string containing the printed representation of OBJECT,\n\ any Lisp object. Quoting characters are used when needed to make output\n\ that `read' can handle, whenever this is possible, unless the optional\n\ second argument NOESCAPE is non-nil.") (obj, noescape) Lisp_Object obj, noescape; { struct buffer *old = current_buffer; int old_point = -1; int start_point; Lisp_Object original, printcharfun; struct gcpro gcpro1; printcharfun = Vprin1_to_string_buffer; PRINTPREPARE; print_depth = 0; print (obj, printcharfun, NILP (noescape)); /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */ PRINTFINISH; set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); obj = Fbuffer_string (); GCPRO1 (obj); Ferase_buffer (); set_buffer_internal (old); UNGCPRO; return obj; } DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0, "Output the printed representation of OBJECT, any Lisp object.\n\ No quoting characters are used; no delimiters are printed around\n\ the contents of strings.\n\ Output stream is PRINTCHARFUN, or value of standard-output (which see).") (obj, printcharfun) Lisp_Object obj, printcharfun; { struct buffer *old = current_buffer; int old_point = -1; int start_point; Lisp_Object original; if (NILP (printcharfun)) printcharfun = Vstandard_output; PRINTPREPARE; print_depth = 0; print (obj, printcharfun, 0); PRINTFINISH; return obj; } DEFUN ("print", Fprint, Sprint, 1, 2, 0, "Output the printed representation of OBJECT, with newlines around it.\n\ Quoting characters are printed when needed to make output that `read'\n\ can handle, whenever this is possible.\n\ Output stream is PRINTCHARFUN, or value of `standard-output' (which see).") (obj, printcharfun) Lisp_Object obj, printcharfun; { struct buffer *old = current_buffer; int old_point = -1; int start_point; Lisp_Object original; struct gcpro gcpro1; #ifdef MAX_PRINT_CHARS print_chars = 0; max_print = MAX_PRINT_CHARS; #endif /* MAX_PRINT_CHARS */ if (NILP (printcharfun)) printcharfun = Vstandard_output; GCPRO1 (obj); PRINTPREPARE; print_depth = 0; PRINTCHAR ('\n'); print (obj, printcharfun, 1); PRINTCHAR ('\n'); PRINTFINISH; #ifdef MAX_PRINT_CHARS max_print = 0; print_chars = 0; #endif /* MAX_PRINT_CHARS */ UNGCPRO; return obj; } /* The subroutine object for external-debugging-output is kept here for the convenience of the debugger. */ Lisp_Object Qexternal_debugging_output; DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0, "Write CHARACTER to stderr.\n\ You can call print while debugging emacs, and pass it this function\n\ to make it write to the debugging output.\n") (character) Lisp_Object character; { CHECK_NUMBER (character, 0); putc (XINT (character), stderr); return character; } /* This is the interface for debugging printing. */ void debug_print (arg) Lisp_Object arg; { Fprin1 (arg, Qexternal_debugging_output); fprintf (stderr, "\r\n"); } #ifdef LISP_FLOAT_TYPE /* * The buffer should be at least as large as the max string size of the * largest float, printed in the biggest notation. This is undoubtably * 20d float_output_format, with the negative of the C-constant "HUGE" * from . * * On the vax the worst case is -1e38 in 20d format which takes 61 bytes. * * I assume that IEEE-754 format numbers can take 329 bytes for the worst * case of -1e307 in 20d float_output_format. What is one to do (short of * re-writing _doprnt to be more sane)? * -wsr */ void float_to_string (buf, data) unsigned char *buf; double data; { unsigned char *cp; int width; if (NILP (Vfloat_output_format) || !STRINGP (Vfloat_output_format)) lose: { sprintf (buf, "%.17g", data); width = -1; } else /* oink oink */ { /* Check that the spec we have is fully valid. This means not only valid for printf, but meant for floats, and reasonable. */ cp = XSTRING (Vfloat_output_format)->data; if (cp[0] != '%') goto lose; if (cp[1] != '.') goto lose; cp += 2; /* Check the width specification. */ width = -1; if ('0' <= *cp && *cp <= '9') { width = 0; do width = (width * 10) + (*cp++ - '0'); while (*cp >= '0' && *cp <= '9'); /* A precision of zero is valid only for %f. */ if (width > DBL_DIG || (width == 0 && *cp != 'f')) goto lose; } if (*cp != 'e' && *cp != 'f' && *cp != 'g') goto lose; if (cp[1] != 0) goto lose; sprintf (buf, XSTRING (Vfloat_output_format)->data, data); } /* 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 valid for that not to produce a decimal point. Note that width can be 0 only for %.0f. */ if (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; } } } #endif /* LISP_FLOAT_TYPE */ static void print (obj, printcharfun, escapeflag) Lisp_Object obj; register Lisp_Object printcharfun; int escapeflag; { char buf[30]; QUIT; #if 1 /* I'm not sure this is really worth doing. */ /* Detect circularities and truncate them. No need to offer any alternative--this is better than an error. */ if (CONSP (obj) || VECTORP (obj) || COMPILEDP (obj)) { int i; for (i = 0; i < print_depth; i++) if (EQ (obj, being_printed[i])) { sprintf (buf, "#%d", i); strout (buf, -1, printcharfun); return; } } #endif being_printed[print_depth] = obj; print_depth++; if (print_depth > PRINT_CIRCLE) error ("Apparently circular structure being printed"); #ifdef MAX_PRINT_CHARS if (max_print && print_chars > max_print) { PRINTCHAR ('\n'); print_chars = 0; } #endif /* MAX_PRINT_CHARS */ switch (XGCTYPE (obj)) { case Lisp_Int: if (sizeof (int) == sizeof (EMACS_INT)) sprintf (buf, "%d", XINT (obj)); else if (sizeof (long) == sizeof (EMACS_INT)) sprintf (buf, "%ld", XINT (obj)); else abort (); strout (buf, -1, printcharfun); break; #ifdef LISP_FLOAT_TYPE case Lisp_Float: { char pigbuf[350]; /* see comments in float_to_string */ float_to_string (pigbuf, XFLOAT(obj)->data); strout (pigbuf, -1, printcharfun); } break; #endif case Lisp_String: if (!escapeflag) print_string (obj, printcharfun); else { register int i; register unsigned char c; struct gcpro gcpro1; GCPRO1 (obj); #ifdef USE_TEXT_PROPERTIES if (!NULL_INTERVAL_P (XSTRING (obj)->intervals)) { PRINTCHAR ('#'); PRINTCHAR ('('); } #endif PRINTCHAR ('\"'); for (i = 0; i < XSTRING (obj)->size; i++) { QUIT; c = XSTRING (obj)->data[i]; if (c == '\n' && print_escape_newlines) { PRINTCHAR ('\\'); PRINTCHAR ('n'); } else if (c == '\f' && print_escape_newlines) { PRINTCHAR ('\\'); PRINTCHAR ('f'); } else { if (c == '\"' || c == '\\') PRINTCHAR ('\\'); PRINTCHAR (c); } } PRINTCHAR ('\"'); #ifdef USE_TEXT_PROPERTIES if (!NULL_INTERVAL_P (XSTRING (obj)->intervals)) { traverse_intervals (XSTRING (obj)->intervals, 0, 0, print_interval, printcharfun); PRINTCHAR (')'); } #endif UNGCPRO; } break; case Lisp_Symbol: { register int confusing; register unsigned char *p = XSYMBOL (obj)->name->data; register unsigned char *end = p + XSYMBOL (obj)->name->size; register unsigned char c; if (p != end && (*p == '-' || *p == '+')) p++; if (p == end) confusing = 0; else { while (p != end && *p >= '0' && *p <= '9') p++; confusing = (end == p); } p = XSYMBOL (obj)->name->data; while (p != end) { QUIT; c = *p++; if (escapeflag) { if (c == '\"' || c == '\\' || c == '\'' || c == ';' || c == '#' || c == '(' || c == ')' || c == ',' || c =='.' || c == '`' || c == '[' || c == ']' || c == '?' || c <= 040 || confusing) PRINTCHAR ('\\'), confusing = 0; } PRINTCHAR (c); } } break; case Lisp_Cons: /* If deeper than spec'd depth, print placeholder. */ if (INTEGERP (Vprint_level) && print_depth > XINT (Vprint_level)) strout ("...", -1, printcharfun); else { PRINTCHAR ('('); { register int i = 0; register int max = 0; if (INTEGERP (Vprint_length)) max = XINT (Vprint_length); /* Could recognize circularities in cdrs here, but that would make printing of long lists quadratic. It's not worth doing. */ while (CONSP (obj)) { if (i++) PRINTCHAR (' '); if (max && i > max) { strout ("...", 3, printcharfun); break; } print (Fcar (obj), printcharfun, escapeflag); obj = Fcdr (obj); } } if (!NILP (obj) && !CONSP (obj)) { strout (" . ", 3, printcharfun); print (obj, printcharfun, escapeflag); } PRINTCHAR (')'); } break; case Lisp_Vectorlike: if (PROCESSP (obj)) { if (escapeflag) { strout ("#name, printcharfun); PRINTCHAR ('>'); } else print_string (XPROCESS (obj)->name, printcharfun); } else if (BOOL_VECTOR_P (obj)) { register int i; register unsigned char c; struct gcpro gcpro1; int size_in_chars = (XBOOL_VECTOR (obj)->size + BITS_PER_CHAR) / BITS_PER_CHAR; GCPRO1 (obj); PRINTCHAR ('#'); PRINTCHAR ('&'); sprintf (buf, "%d", XBOOL_VECTOR (obj)->size); strout (buf, -1, printcharfun); PRINTCHAR ('\"'); for (i = 0; i < size_in_chars; i++) { QUIT; c = XBOOL_VECTOR (obj)->data[i]; if (c == '\n' && print_escape_newlines) { PRINTCHAR ('\\'); PRINTCHAR ('n'); } else if (c == '\f' && print_escape_newlines) { PRINTCHAR ('\\'); PRINTCHAR ('f'); } else { if (c == '\"' || c == '\\') PRINTCHAR ('\\'); PRINTCHAR (c); } } PRINTCHAR ('\"'); UNGCPRO; } else if (SUBRP (obj)) { strout ("#symbol_name, -1, printcharfun); PRINTCHAR ('>'); } #ifndef standalone else if (WINDOWP (obj)) { strout ("#sequence_number)); strout (buf, -1, printcharfun); if (!NILP (XWINDOW (obj)->buffer)) { strout (" on ", -1, printcharfun); print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun); } PRINTCHAR ('>'); } else if (BUFFERP (obj)) { if (NILP (XBUFFER (obj)->name)) strout ("#", -1, printcharfun); else if (escapeflag) { strout ("#name, printcharfun); PRINTCHAR ('>'); } else print_string (XBUFFER (obj)->name, printcharfun); } else if (WINDOW_CONFIGURATIONP (obj)) { strout ("#", -1, printcharfun); } #ifdef MULTI_FRAME else if (FRAMEP (obj)) { strout ((FRAME_LIVE_P (XFRAME (obj)) ? "#name, printcharfun); sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj))); strout (buf, -1, printcharfun); PRINTCHAR ('>'); } #endif #endif /* not standalone */ else { int size = XVECTOR (obj)->size; if (COMPILEDP (obj)) { PRINTCHAR ('#'); size &= PSEUDOVECTOR_SIZE_MASK; } if (CHAR_TABLE_P (obj)) { /* We print a char-table as if it were a vector, lumping the parent and default slots in with the character slots. But we add #^ as a prefix. */ PRINTCHAR ('#'); PRINTCHAR ('^'); size &= PSEUDOVECTOR_SIZE_MASK; } if (size & PSEUDOVECTOR_FLAG) goto badtype; PRINTCHAR ('['); { register int i; register Lisp_Object tem; for (i = 0; i < size; i++) { if (i) PRINTCHAR (' '); tem = XVECTOR (obj)->contents[i]; print (tem, printcharfun, escapeflag); } } PRINTCHAR (']'); } break; #ifndef standalone case Lisp_Misc: switch (XMISCTYPE (obj)) { case Lisp_Misc_Marker: strout ("#buffer)) strout ("in no buffer", -1, printcharfun); else { sprintf (buf, "at %d", marker_position (obj)); strout (buf, -1, printcharfun); strout (" in ", -1, printcharfun); print_string (XMARKER (obj)->buffer->name, printcharfun); } PRINTCHAR ('>'); break; case Lisp_Misc_Overlay: strout ("#buffer)) strout ("in no buffer", -1, printcharfun); else { sprintf (buf, "from %d to %d in ", marker_position (OVERLAY_START (obj)), marker_position (OVERLAY_END (obj))); strout (buf, -1, printcharfun); print_string (XMARKER (OVERLAY_START (obj))->buffer->name, printcharfun); } PRINTCHAR ('>'); break; /* Remaining cases shouldn't happen in normal usage, but let's print them anyway for the benefit of the debugger. */ case Lisp_Misc_Free: strout ("#", -1, printcharfun); break; case Lisp_Misc_Intfwd: sprintf (buf, "#", *XINTFWD (obj)->intvar); strout (buf, -1, printcharfun); break; case Lisp_Misc_Boolfwd: sprintf (buf, "#", (*XBOOLFWD (obj)->boolvar ? "t" : "nil")); strout (buf, -1, printcharfun); break; case Lisp_Misc_Objfwd: strout (buf, "#objvar, printcharfun, escapeflag); PRINTCHAR ('>'); break; case Lisp_Misc_Buffer_Objfwd: strout (buf, "#offset), printcharfun, escapeflag); PRINTCHAR ('>'); break; case Lisp_Misc_Kboard_Objfwd: strout (buf, "#offset), printcharfun, escapeflag); PRINTCHAR ('>'); break; case Lisp_Misc_Buffer_Local_Value: strout ("#car, printcharfun, escapeflag); strout ("[buffer] ", -1, printcharfun); print (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->car, printcharfun, escapeflag); strout ("[alist-elt] ", -1, printcharfun); print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr)->car, printcharfun, escapeflag); strout ("[default-value] ", -1, printcharfun); print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr)->cdr, printcharfun, escapeflag); PRINTCHAR ('>'); break; default: goto badtype; } break; #endif /* standalone */ default: badtype: { /* We're in trouble if this happens! Probably should just abort () */ strout ("#size); else sprintf (buf, "(0x%02x)", (int) XTYPE (obj)); strout (buf, -1, printcharfun); strout (" Save your buffers immediately and please report this bug>", -1, printcharfun); } } print_depth--; } #ifdef USE_TEXT_PROPERTIES /* Print a description of INTERVAL using PRINTCHARFUN. This is part of printing a string that has text properties. */ void print_interval (interval, printcharfun) INTERVAL interval; Lisp_Object printcharfun; { PRINTCHAR (' '); print (make_number (interval->position), printcharfun, 1); PRINTCHAR (' '); print (make_number (interval->position + LENGTH (interval)), printcharfun, 1); PRINTCHAR (' '); print (interval->plist, printcharfun, 1); } #endif /* USE_TEXT_PROPERTIES */ void syms_of_print () { staticpro (&Qprint_escape_newlines); Qprint_escape_newlines = intern ("print-escape-newlines"); DEFVAR_LISP ("standard-output", &Vstandard_output, "Output stream `print' uses by default for outputting a character.\n\ This may be any function of one argument.\n\ It may also be a buffer (output is inserted before point)\n\ or a marker (output is inserted and the marker is advanced)\n\ or the symbol t (output appears in the minibuffer line)."); Vstandard_output = Qt; Qstandard_output = intern ("standard-output"); staticpro (&Qstandard_output); #ifdef LISP_FLOAT_TYPE DEFVAR_LISP ("float-output-format", &Vfloat_output_format, "The format descriptor string used to print floats.\n\ This is a %-spec like those accepted by `printf' in C,\n\ but with some restrictions. It must start with the two characters `%.'.\n\ After that comes an integer precision specification,\n\ and then a letter which controls the format.\n\ The letters allowed are `e', `f' and `g'.\n\ Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\ Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\ Use `g' to choose the shorter of those two formats for the number at hand.\n\ 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 `%.17g'."); Vfloat_output_format = Qnil; Qfloat_output_format = intern ("float-output-format"); staticpro (&Qfloat_output_format); #endif /* LISP_FLOAT_TYPE */ DEFVAR_LISP ("print-length", &Vprint_length, "Maximum length of list to print before abbreviating.\n\ A value of nil means no limit."); Vprint_length = Qnil; DEFVAR_LISP ("print-level", &Vprint_level, "Maximum depth of list nesting to print before abbreviating.\n\ A value of nil means no limit."); Vprint_level = Qnil; DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines, "Non-nil means print newlines in strings as backslash-n.\n\ Also print formfeeds as backslash-f."); print_escape_newlines = 0; /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */ staticpro (&Vprin1_to_string_buffer); defsubr (&Sprin1); defsubr (&Sprin1_to_string); defsubr (&Sprinc); defsubr (&Sprint); defsubr (&Sterpri); defsubr (&Swrite_char); defsubr (&Sexternal_debugging_output); Qexternal_debugging_output = intern ("external-debugging-output"); staticpro (&Qexternal_debugging_output); #ifndef standalone defsubr (&Swith_output_to_temp_buffer); #endif /* not standalone */ } emacs-19.30/src/process.c100444 23073 1 317576 6047603114 14454 0ustar voelkerdaemon/* Asynchronous subprocess control for GNU Emacs. Copyright (C) 1985, 86, 87, 88, 93, 94, 95 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. */ #include #include /* This file is split into two parts by the following preprocessor conditional. The 'then' clause contains all of the support for asynchronous subprocesses. The 'else' clause contains stub versions of some of the asynchronous subprocess routines that are often called elsewhere in Emacs, so we don't have to #ifdef the sections that call them. */ #ifdef subprocesses #include #include #include #include /* some typedefs are used in sys/file.h */ #include #include #ifdef HAVE_UNISTD_H #include #endif #ifdef WINDOWSNT #include #include #endif /* not WINDOWSNT */ #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */ #include #include #include #include #ifdef NEED_NET_ERRNO_H #include #endif /* NEED_NET_ERRNO_H */ #endif /* HAVE_SOCKETS */ /* TERM is a poor-man's SLIP, used on Linux. */ #ifdef TERM #include #endif /* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */ #ifdef HAVE_BROKEN_INET_ADDR #define IN_ADDR struct in_addr #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1) #else #define IN_ADDR unsigned long #define NUMERIC_ADDR_ERROR (numeric_addr == -1) #endif #if defined(BSD) || defined(STRIDE) #include #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5) #include #endif /* HAVE_PTYS and no O_NDELAY */ #endif /* BSD or STRIDE */ #ifdef BROKEN_O_NONBLOCK #undef O_NONBLOCK #endif /* BROKEN_O_NONBLOCK */ #ifdef NEED_BSDTTY #include #endif #ifdef IRIS #include /* for "minor" */ #endif /* not IRIS */ #include "systime.h" #include "systty.h" #include "lisp.h" #include "window.h" #include "buffer.h" #include "process.h" #include "termhooks.h" #include "termopts.h" #include "commands.h" #include "frame.h" Lisp_Object Qprocessp; Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed; Lisp_Object Qlast_nonmenu_event; /* Qexit is declared and initialized in eval.c. */ /* a process object is a network connection when its childp field is neither Qt nor Qnil but is instead a string (name of foreign host we are connected to + name of port we are connected to) */ #ifdef HAVE_SOCKETS static Lisp_Object stream_process; #define NETCONN_P(p) (GC_STRINGP (XPROCESS (p)->childp)) #else #define NETCONN_P(p) 0 #endif /* HAVE_SOCKETS */ /* Define first descriptor number available for subprocesses. */ #ifdef VMS #define FIRST_PROC_DESC 1 #else /* Not VMS */ #define FIRST_PROC_DESC 3 #endif /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals testing SIGCHLD. */ #if !defined (SIGCHLD) && defined (SIGCLD) #define SIGCHLD SIGCLD #endif /* SIGCLD */ #include "syssignal.h" #include "syswait.h" extern int errno; extern char *strerror (); #ifdef VMS extern char *sys_errlist[]; #endif #ifndef HAVE_H_ERRNO extern int h_errno; #endif #ifndef SYS_SIGLIST_DECLARED #ifndef VMS #ifndef BSD4_1 #ifndef WINDOWSNT #ifndef LINUX extern char *sys_siglist[]; #endif /* not LINUX */ #else /* BSD4_1 */ char *sys_siglist[] = { "bum signal!!", "hangup", "interrupt", "quit", "illegal instruction", "trace trap", "iot instruction", "emt instruction", "floating point exception", "kill", "bus error", "segmentation violation", "bad argument to system call", "write on a pipe with no one to read it", "alarm clock", "software termination signal from kill", "status signal", "sendable stop signal not from tty", "stop signal from tty", "continue a stopped process", "child status has changed", "background read attempted from control tty", "background write attempted from control tty", "input record available at control tty", "exceeded CPU time limit", "exceeded file size limit" }; #endif /* not WINDOWSNT */ #endif #endif /* VMS */ #endif /* ! SYS_SIGLIST_DECLARED */ /* t means use pty, nil means use a pipe, maybe other values to come. */ static Lisp_Object Vprocess_connection_type; #ifdef SKTPAIR #ifndef HAVE_SOCKETS #include #endif #endif /* SKTPAIR */ /* These next two vars are non-static since sysdep.c uses them in the emulation of `select'. */ /* Number of events of change of status of a process. */ int process_tick; /* Number of events for which the user or sentinel has been notified. */ int update_tick; #include "sysselect.h" /* If we support a window system, turn on the code to poll periodically to detect C-g. It isn't actually used when doing interrupt input. */ #ifdef HAVE_WINDOW_SYSTEM #define POLL_FOR_INPUT #endif /* Mask of bits indicating the descriptors that we wait for input on. */ static SELECT_TYPE input_wait_mask; /* Mask that excludes keyboard input descriptor (s). */ static SELECT_TYPE non_keyboard_wait_mask; /* The largest descriptor currently in use for a process object. */ static int max_process_desc; /* The largest descriptor currently in use for keyboard input. */ static int max_keyboard_desc; /* Nonzero means delete a process right away if it exits. */ static int delete_exited_processes; /* Indexed by descriptor, gives the process (if any) for that descriptor */ Lisp_Object chan_process[MAXDESC]; /* Alist of elements (NAME . PROCESS) */ Lisp_Object Vprocess_alist; /* Buffered-ahead input char from process, indexed by channel. -1 means empty (no char is buffered). Used on sys V where the only way to tell if there is any output from the process is to read at least one char. Always -1 on systems that support FIONREAD. */ /* Don't make static; need to access externally. */ int proc_buffered_char[MAXDESC]; static Lisp_Object get_process (); /* Maximum number of bytes to send to a pty without an eof. */ static int pty_max_bytes; #ifdef HAVE_PTYS /* The file name of the pty opened by allocate_pty. */ static char pty_name[24]; #endif /* Compute the Lisp form of the process status, p->status, from the numeric status that was returned by `wait'. */ Lisp_Object status_convert (); update_status (p) struct Lisp_Process *p; { union { int i; WAITTYPE wt; } u; u.i = XFASTINT (p->raw_status_low) + (XFASTINT (p->raw_status_high) << 16); p->status = status_convert (u.wt); p->raw_status_low = Qnil; p->raw_status_high = Qnil; } /* Convert a process status word in Unix format to the list that we use internally. */ Lisp_Object status_convert (w) WAITTYPE w; { if (WIFSTOPPED (w)) return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil)); else if (WIFEXITED (w)) return Fcons (Qexit, Fcons (make_number (WRETCODE (w)), WCOREDUMP (w) ? Qt : Qnil)); else if (WIFSIGNALED (w)) return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)), WCOREDUMP (w) ? Qt : Qnil)); else return Qrun; } /* Given a status-list, extract the three pieces of information and store them individually through the three pointers. */ void decode_status (l, symbol, code, coredump) Lisp_Object l; Lisp_Object *symbol; int *code; int *coredump; { Lisp_Object tem; if (SYMBOLP (l)) { *symbol = l; *code = 0; *coredump = 0; } else { *symbol = XCONS (l)->car; tem = XCONS (l)->cdr; *code = XFASTINT (XCONS (tem)->car); tem = XCONS (tem)->cdr; *coredump = !NILP (tem); } } /* Return a string describing a process status list. */ Lisp_Object status_message (status) Lisp_Object status; { Lisp_Object symbol; int code, coredump; Lisp_Object string, string2; decode_status (status, &symbol, &code, &coredump); if (EQ (symbol, Qsignal) || EQ (symbol, Qstop)) { char *signame = 0; if (code < NSIG) { #ifndef VMS /* Cast to suppress warning if the table has const char *. */ signame = (char *) sys_siglist[code]; #else signame = sys_errlist[code]; #endif } if (signame == 0) signame = "unknown"; string = build_string (signame); string2 = build_string (coredump ? " (core dumped)\n" : "\n"); XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]); return concat2 (string, string2); } else if (EQ (symbol, Qexit)) { if (code == 0) return build_string ("finished\n"); string = Fnumber_to_string (make_number (code)); string2 = build_string (coredump ? " (core dumped)\n" : "\n"); return concat2 (build_string ("exited abnormally with code "), concat2 (string, string2)); } else return Fcopy_sequence (Fsymbol_name (symbol)); } #ifdef HAVE_PTYS /* Open an available pty, returning a file descriptor. Return -1 on failure. The file name of the terminal corresponding to the pty is left in the variable pty_name. */ int allocate_pty () { struct stat stb; register c, i; int fd; /* Some systems name their pseudoterminals so that there are gaps in the usual sequence - for example, on HP9000/S700 systems, there are no pseudoterminals with names ending in 'f'. So we wait for three failures in a row before deciding that we've reached the end of the ptys. */ int failed_count = 0; #ifdef PTY_ITERATION PTY_ITERATION #else for (c = FIRST_PTY_LETTER; c <= 'z'; c++) for (i = 0; i < 16; i++) #endif { #ifdef PTY_NAME_SPRINTF PTY_NAME_SPRINTF #else sprintf (pty_name, "/dev/pty%c%x", c, i); #endif /* no PTY_NAME_SPRINTF */ #ifdef PTY_OPEN PTY_OPEN; #else /* no PTY_OPEN */ #ifdef IRIS /* Unusual IRIS code */ *ptyv = open ("/dev/ptc", O_RDWR | O_NDELAY, 0); if (fd < 0) return -1; if (fstat (fd, &stb) < 0) return -1; #else /* not IRIS */ if (stat (pty_name, &stb) < 0) { failed_count++; if (failed_count >= 3) return -1; } else failed_count = 0; #ifdef O_NONBLOCK fd = open (pty_name, O_RDWR | O_NONBLOCK, 0); #else fd = open (pty_name, O_RDWR | O_NDELAY, 0); #endif #endif /* not IRIS */ #endif /* no PTY_OPEN */ if (fd >= 0) { /* check to make certain that both sides are available this avoids a nasty yet stupid bug in rlogins */ #ifdef PTY_TTY_NAME_SPRINTF PTY_TTY_NAME_SPRINTF #else sprintf (pty_name, "/dev/tty%c%x", c, i); #endif /* no PTY_TTY_NAME_SPRINTF */ #ifndef UNIPLUS if (access (pty_name, 6) != 0) { close (fd); #if !defined(IRIS) && !defined(__sgi) continue; #else return -1; #endif /* IRIS */ } #endif /* not UNIPLUS */ setup_pty (fd); return fd; } } return -1; } #endif /* HAVE_PTYS */ Lisp_Object make_process (name) Lisp_Object name; { struct Lisp_Vector *vec; register Lisp_Object val, tem, name1; register struct Lisp_Process *p; char suffix[10]; register int i; vec = allocate_vectorlike ((EMACS_INT) VECSIZE (struct Lisp_Process)); for (i = 0; i < VECSIZE (struct Lisp_Process); i++) vec->contents[i] = Qnil; vec->size = VECSIZE (struct Lisp_Process); p = (struct Lisp_Process *)vec; XSETINT (p->infd, -1); XSETINT (p->outfd, -1); XSETFASTINT (p->pid, 0); XSETFASTINT (p->tick, 0); XSETFASTINT (p->update_tick, 0); p->raw_status_low = Qnil; p->raw_status_high = Qnil; p->status = Qrun; p->mark = Fmake_marker (); /* If name is already in use, modify it until it is unused. */ name1 = name; for (i = 1; ; i++) { tem = Fget_process (name1); if (NILP (tem)) break; sprintf (suffix, "<%d>", i); name1 = concat2 (name, build_string (suffix)); } name = name1; p->name = name; XSETPROCESS (val, p); Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist); return val; } remove_process (proc) register Lisp_Object proc; { register Lisp_Object pair; pair = Frassq (proc, Vprocess_alist); Vprocess_alist = Fdelq (pair, Vprocess_alist); Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil); deactivate_process (proc); } DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0, "Return t if OBJECT is a process.") (obj) Lisp_Object obj; { return PROCESSP (obj) ? Qt : Qnil; } DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0, "Return the process named NAME, or nil if there is none.") (name) register Lisp_Object name; { if (PROCESSP (name)) return name; CHECK_STRING (name, 0); return Fcdr (Fassoc (name, Vprocess_alist)); } DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, "Return the (or, a) process associated with BUFFER.\n\ BUFFER may be a buffer or the name of one.") (name) register Lisp_Object name; { register Lisp_Object buf, tail, proc; if (NILP (name)) return Qnil; buf = Fget_buffer (name); if (NILP (buf)) return Qnil; for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail)) { proc = Fcdr (Fcar (tail)); if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf)) return proc; } return Qnil; } /* This is how commands for the user decode process arguments. It accepts a process, a process name, a buffer, a buffer name, or nil. Buffers denote the first process in the buffer, and nil denotes the current buffer. */ static Lisp_Object get_process (name) register Lisp_Object name; { register Lisp_Object proc, obj; if (STRINGP (name)) { obj = Fget_process (name); if (NILP (obj)) obj = Fget_buffer (name); if (NILP (obj)) error ("Process %s does not exist", XSTRING (name)->data); } else if (NILP (name)) obj = Fcurrent_buffer (); else obj = name; /* Now obj should be either a buffer object or a process object. */ if (BUFFERP (obj)) { proc = Fget_buffer_process (obj); if (NILP (proc)) error ("Buffer %s has no process", XSTRING (XBUFFER (obj)->name)->data); } else { CHECK_PROCESS (obj, 0); proc = obj; } return proc; } DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0, "Delete PROCESS: kill it and forget about it immediately.\n\ PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ nil, indicating the current buffer's process.") (proc) register Lisp_Object proc; { proc = get_process (proc); XPROCESS (proc)->raw_status_low = Qnil; XPROCESS (proc)->raw_status_high = Qnil; if (NETCONN_P (proc)) { XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (0), Qnil)); XSETINT (XPROCESS (proc)->tick, ++process_tick); } else if (XINT (XPROCESS (proc)->infd) >= 0) { Fkill_process (proc, Qnil); /* Do this now, since remove_process will make sigchld_handler do nothing. */ XPROCESS (proc)->status = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil)); XSETINT (XPROCESS (proc)->tick, ++process_tick); status_notify (); } remove_process (proc); return Qnil; } DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0, "Return the status of PROCESS: a symbol, one of these:\n\ run -- for a process that is running.\n\ stop -- for a process stopped but continuable.\n\ exit -- for a process that has exited.\n\ signal -- for a process that has got a fatal signal.\n\ open -- for a network stream connection that is open.\n\ closed -- for a network stream connection that is closed.\n\ nil -- if arg is a process name and no such process exists.\n\ PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ nil, indicating the current buffer's process.") (proc) register Lisp_Object proc; { register struct Lisp_Process *p; register Lisp_Object status; if (STRINGP (proc)) proc = Fget_process (proc); else proc = get_process (proc); if (NILP (proc)) return proc; p = XPROCESS (proc); if (!NILP (p->raw_status_low)) update_status (p); status = p->status; if (CONSP (status)) status = XCONS (status)->car; if (NETCONN_P (proc)) { if (EQ (status, Qrun)) status = Qopen; else if (EQ (status, Qexit)) status = Qclosed; } return status; } DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status, 1, 1, 0, "Return the exit status of PROCESS or the signal number that killed it.\n\ If PROCESS has not yet exited or died, return 0.") (proc) register Lisp_Object proc; { CHECK_PROCESS (proc, 0); if (!NILP (XPROCESS (proc)->raw_status_low)) update_status (XPROCESS (proc)); if (CONSP (XPROCESS (proc)->status)) return XCONS (XCONS (XPROCESS (proc)->status)->cdr)->car; return make_number (0); } DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0, "Return the process id of PROCESS.\n\ This is the pid of the Unix process which PROCESS uses or talks to.\n\ For a network connection, this value is nil.") (proc) register Lisp_Object proc; { CHECK_PROCESS (proc, 0); return XPROCESS (proc)->pid; } DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0, "Return the name of PROCESS, as a string.\n\ This is the name of the program invoked in PROCESS,\n\ possibly modified to make it unique among process names.") (proc) register Lisp_Object proc; { CHECK_PROCESS (proc, 0); return XPROCESS (proc)->name; } DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0, "Return the command that was executed to start PROCESS.\n\ This is a list of strings, the first string being the program executed\n\ and the rest of the strings being the arguments given to it.\n\ For a non-child channel, this is nil.") (proc) register Lisp_Object proc; { CHECK_PROCESS (proc, 0); return XPROCESS (proc)->command; } DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0, "Return the name of the terminal PROCESS uses, or nil if none.\n\ This is the terminal that the process itself reads and writes on,\n\ not the name of the pty that Emacs uses to talk with that terminal.") (proc) register Lisp_Object proc; { CHECK_PROCESS (proc, 0); return XPROCESS (proc)->tty_name; } DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer, 2, 2, 0, "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).") (proc, buffer) register Lisp_Object proc, buffer; { CHECK_PROCESS (proc, 0); if (!NILP (buffer)) CHECK_BUFFER (buffer, 1); XPROCESS (proc)->buffer = buffer; return buffer; } DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer, 1, 1, 0, "Return the buffer PROCESS is associated with.\n\ Output from PROCESS is inserted in this buffer\n\ unless PROCESS has a filter.") (proc) register Lisp_Object proc; { CHECK_PROCESS (proc, 0); return XPROCESS (proc)->buffer; } DEFUN ("process-mark", Fprocess_mark, Sprocess_mark, 1, 1, 0, "Return the marker for the end of the last output from PROCESS.") (proc) register Lisp_Object proc; { CHECK_PROCESS (proc, 0); return XPROCESS (proc)->mark; } DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter, 2, 2, 0, "Give PROCESS the filter function FILTER; nil means no filter.\n\ t means stop accepting output from the process.\n\ When a process has a filter, each time it does output\n\ the entire string of output is passed to the filter.\n\ The filter gets two arguments: the process and the string of output.\n\ If the process has a filter, its buffer is not used for output.") (proc, filter) register Lisp_Object proc, filter; { CHECK_PROCESS (proc, 0); if (EQ (filter, Qt)) { FD_CLR (XINT (XPROCESS (proc)->infd), &input_wait_mask); FD_CLR (XINT (XPROCESS (proc)->infd), &non_keyboard_wait_mask); } else if (EQ (XPROCESS (proc)->filter, Qt)) { FD_SET (XINT (XPROCESS (proc)->infd), &input_wait_mask); FD_SET (XINT (XPROCESS (proc)->infd), &non_keyboard_wait_mask); } XPROCESS (proc)->filter = filter; return filter; } DEFUN ("process-filter", Fprocess_filter, Sprocess_filter, 1, 1, 0, "Returns the filter function of PROCESS; nil if none.\n\ See `set-process-filter' for more info on filter functions.") (proc) register Lisp_Object proc; { CHECK_PROCESS (proc, 0); return XPROCESS (proc)->filter; } DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel, 2, 2, 0, "Give PROCESS the sentinel SENTINEL; nil for none.\n\ The sentinel is called as a function when the process changes state.\n\ It gets two arguments: the process, and a string describing the change.") (proc, sentinel) register Lisp_Object proc, sentinel; { CHECK_PROCESS (proc, 0); XPROCESS (proc)->sentinel = sentinel; return sentinel; } DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel, 1, 1, 0, "Return the sentinel of PROCESS; nil if none.\n\ See `set-process-sentinel' for more info on sentinels.") (proc) register Lisp_Object proc; { CHECK_PROCESS (proc, 0); return XPROCESS (proc)->sentinel; } DEFUN ("set-process-window-size", Fset_process_window_size, Sset_process_window_size, 3, 3, 0, "Tell PROCESS that it has logical window size HEIGHT and WIDTH.") (proc, height, width) register Lisp_Object proc, height, width; { CHECK_PROCESS (proc, 0); CHECK_NATNUM (height, 0); CHECK_NATNUM (width, 0); if (set_window_size (XINT (XPROCESS (proc)->infd), XINT (height), XINT(width)) <= 0) return Qnil; else return Qt; } DEFUN ("process-kill-without-query", Fprocess_kill_without_query, Sprocess_kill_without_query, 1, 2, 0, "Say no query needed if PROCESS is running when Emacs is exited.\n\ Optional second argument if non-nil says to require a query.\n\ Value is t if a query was formerly required.") (proc, value) register Lisp_Object proc, value; { Lisp_Object tem; CHECK_PROCESS (proc, 0); tem = XPROCESS (proc)->kill_without_query; XPROCESS (proc)->kill_without_query = Fnull (value); return Fnull (tem); } #if 0 /* Turned off because we don't currently record this info in the process. Perhaps add it. */ DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0, "Return the connection type of `PROCESS'.\n\ The value is `nil' for a pipe,\n\ `t' or `pty' for a pty, or `stream' for a socket connection.") (process) Lisp_Object process; { return XPROCESS (process)->type; } #endif Lisp_Object list_processes_1 () { register Lisp_Object tail, tem; Lisp_Object proc, minspace, tem1; register struct buffer *old = current_buffer; register struct Lisp_Process *p; register int state; char tembuf[80]; XSETFASTINT (minspace, 1); set_buffer_internal (XBUFFER (Vstandard_output)); Fbuffer_disable_undo (Vstandard_output); current_buffer->truncate_lines = Qt; write_string ("\ Proc Status Buffer Tty Command\n\ ---- ------ ------ --- -------\n", -1); for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail)) { Lisp_Object symbol; proc = Fcdr (Fcar (tail)); p = XPROCESS (proc); if (NILP (p->childp)) continue; Finsert (1, &p->name); Findent_to (make_number (13), minspace); if (!NILP (p->raw_status_low)) update_status (p); symbol = p->status; if (CONSP (p->status)) symbol = XCONS (p->status)->car; if (EQ (symbol, Qsignal)) { Lisp_Object tem; tem = Fcar (Fcdr (p->status)); #ifdef VMS if (XINT (tem) < NSIG) write_string (sys_errlist [XINT (tem)], -1); else #endif Fprinc (symbol, Qnil); } else if (NETCONN_P (proc)) { if (EQ (symbol, Qrun)) write_string ("open", -1); else if (EQ (symbol, Qexit)) write_string ("closed", -1); else Fprinc (symbol, Qnil); } else Fprinc (symbol, Qnil); if (EQ (symbol, Qexit)) { Lisp_Object tem; tem = Fcar (Fcdr (p->status)); if (XFASTINT (tem)) { sprintf (tembuf, " %d", (int) XFASTINT (tem)); write_string (tembuf, -1); } } if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)) remove_process (proc); Findent_to (make_number (22), minspace); if (NILP (p->buffer)) insert_string ("(none)"); else if (NILP (XBUFFER (p->buffer)->name)) insert_string ("(Killed)"); else Finsert (1, &XBUFFER (p->buffer)->name); Findent_to (make_number (37), minspace); if (STRINGP (p->tty_name)) Finsert (1, &p->tty_name); else insert_string ("(none)"); Findent_to (make_number (49), minspace); if (NETCONN_P (proc)) { sprintf (tembuf, "(network stream connection to %s)\n", XSTRING (p->childp)->data); insert_string (tembuf); } else { tem = p->command; while (1) { tem1 = Fcar (tem); Finsert (1, &tem1); tem = Fcdr (tem); if (NILP (tem)) break; insert_string (" "); } insert_string ("\n"); } } return Qnil; } DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "", "Display a list of all processes.\n\ \(Any processes listed as Exited or Signaled are actually eliminated\n\ after the listing is made.)") () { internal_with_output_to_temp_buffer ("*Process List*", list_processes_1, Qnil); return Qnil; } DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0, "Return a list of all processes.") () { return Fmapcar (Qcdr, Vprocess_alist); } /* Starting asynchronous inferior processes. */ static Lisp_Object start_process_unwind (); DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0, "Start a program in a subprocess. Return the process object for it.\n\ Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\ NAME is name for process. It is modified if necessary to make it unique.\n\ BUFFER is the buffer or (buffer-name) to associate with the process.\n\ Process output goes at end of that buffer, unless you specify\n\ an output stream or filter function to handle the output.\n\ BUFFER may be also nil, meaning that this process is not associated\n\ with any buffer\n\ Third arg is program file name. It is searched for as in the shell.\n\ Remaining arguments are strings to give program as arguments.") (nargs, args) int nargs; register Lisp_Object *args; { Lisp_Object buffer, name, program, proc, current_dir, tem; #ifdef VMS register unsigned char *new_argv; int len; #else register unsigned char **new_argv; #endif register int i; int count = specpdl_ptr - specpdl; buffer = args[1]; if (!NILP (buffer)) buffer = Fget_buffer_create (buffer); /* Make sure that the child will be able to chdir to the current buffer's current directory, or its unhandled equivalent. We can't just have the child check for an error when it does the chdir, since it's in a vfork. We have to GCPRO around this because Fexpand_file_name and Funhandled_file_name_directory might call a file name handling function. The argument list is protected by the caller, so all we really have to worry about is buffer. */ { struct gcpro gcpro1, gcpro2; current_dir = current_buffer->directory; GCPRO2 (buffer, current_dir); current_dir = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir), Qnil); if (NILP (Ffile_accessible_directory_p (current_dir))) report_file_error ("Setting current directory", Fcons (current_buffer->directory, Qnil)); UNGCPRO; } name = args[0]; CHECK_STRING (name, 0); program = args[2]; CHECK_STRING (program, 2); #ifdef VMS /* Make a one member argv with all args concatenated together separated by a blank. */ len = XSTRING (program)->size + 2; for (i = 3; i < nargs; i++) { tem = args[i]; CHECK_STRING (tem, i); len += XSTRING (tem)->size + 1; /* count the blank */ } new_argv = (unsigned char *) alloca (len); strcpy (new_argv, XSTRING (program)->data); for (i = 3; i < nargs; i++) { tem = args[i]; CHECK_STRING (tem, i); strcat (new_argv, " "); strcat (new_argv, XSTRING (tem)->data); } /* Need to add code here to check for program existence on VMS */ #else /* not VMS */ new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *)); /* If program file name is not absolute, search our path for it */ if (!IS_DIRECTORY_SEP (XSTRING (program)->data[0]) && !(XSTRING (program)->size > 1 && IS_DEVICE_SEP (XSTRING (program)->data[1]))) { struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; tem = Qnil; GCPRO4 (name, program, buffer, current_dir); openp (Vexec_path, program, EXEC_SUFFIXES, &tem, 1); UNGCPRO; if (NILP (tem)) report_file_error ("Searching for program", Fcons (program, Qnil)); tem = Fexpand_file_name (tem, Qnil); new_argv[0] = XSTRING (tem)->data; } else { if (!NILP (Ffile_directory_p (program))) error ("Specified program for new process is a directory"); new_argv[0] = XSTRING (program)->data; } for (i = 3; i < nargs; i++) { tem = args[i]; CHECK_STRING (tem, i); new_argv[i - 2] = XSTRING (tem)->data; } new_argv[i - 2] = 0; #endif /* not VMS */ proc = make_process (name); /* If an error occurs and we can't start the process, we want to remove it from the process list. This means that each error check in create_process doesn't need to call remove_process itself; it's all taken care of here. */ record_unwind_protect (start_process_unwind, proc); XPROCESS (proc)->childp = Qt; XPROCESS (proc)->command_channel_p = Qnil; XPROCESS (proc)->buffer = buffer; XPROCESS (proc)->sentinel = Qnil; XPROCESS (proc)->filter = Qnil; XPROCESS (proc)->command = Flist (nargs - 2, args + 2); /* Make the process marker point into the process buffer (if any). */ if (!NILP (buffer)) Fset_marker (XPROCESS (proc)->mark, make_number (BUF_ZV (XBUFFER (buffer))), buffer); create_process (proc, new_argv, current_dir); return unbind_to (count, proc); } /* This function is the unwind_protect form for Fstart_process. If PROC doesn't have its pid set, then we know someone has signalled an error and the process wasn't started successfully, so we should remove it from the process list. */ static Lisp_Object start_process_unwind (proc) Lisp_Object proc; { if (!PROCESSP (proc)) abort (); /* Was PROC started successfully? */ if (XINT (XPROCESS (proc)->pid) <= 0) remove_process (proc); return Qnil; } SIGTYPE create_process_1 (signo) int signo; { #ifdef USG /* USG systems forget handlers when they are used; must reestablish each time */ signal (signo, create_process_1); #endif /* USG */ } #if 0 /* This doesn't work; see the note before sigchld_handler. */ #ifdef USG #ifdef SIGCHLD /* Mimic blocking of signals on system V, which doesn't really have it. */ /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */ int sigchld_deferred; SIGTYPE create_process_sigchld () { signal (SIGCHLD, create_process_sigchld); sigchld_deferred = 1; } #endif #endif #endif #ifndef VMS /* VMS version of this function is in vmsproc.c. */ create_process (process, new_argv, current_dir) Lisp_Object process; char **new_argv; Lisp_Object current_dir; { int pid, inchannel, outchannel; int sv[2]; #ifdef SIGCHLD SIGTYPE (*sigchld)(); #endif /* Use volatile to protect variables from being clobbered by longjmp. */ volatile int forkin, forkout; volatile int pty_flag = 0; extern char **environ; inchannel = outchannel = -1; #ifdef HAVE_PTYS if (!NILP (Vprocess_connection_type)) outchannel = inchannel = allocate_pty (); if (inchannel >= 0) { #ifndef USG /* On USG systems it does not work to open the pty's tty here and then close and reopen it in the child. */ #ifdef O_NOCTTY /* Don't let this terminal become our controlling terminal (in case we don't have one). */ forkout = forkin = open (pty_name, O_RDWR | O_NOCTTY, 0); #else forkout = forkin = open (pty_name, O_RDWR, 0); #endif if (forkin < 0) report_file_error ("Opening pty", Qnil); #else forkin = forkout = -1; #endif /* not USG */ pty_flag = 1; } else #endif /* HAVE_PTYS */ #ifdef SKTPAIR { if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0) report_file_error ("Opening socketpair", Qnil); outchannel = inchannel = sv[0]; forkout = forkin = sv[1]; } #else /* not SKTPAIR */ { #ifdef WINDOWSNT pipe_with_inherited_out (sv); inchannel = sv[0]; forkout = sv[1]; pipe_with_inherited_in (sv); forkin = sv[0]; outchannel = sv[1]; #else /* not WINDOWSNT */ pipe (sv); inchannel = sv[0]; forkout = sv[1]; pipe (sv); outchannel = sv[1]; forkin = sv[0]; #endif /* not WINDOWSNT */ } #endif /* not SKTPAIR */ #if 0 /* Replaced by close_process_descs */ set_exclusive_use (inchannel); set_exclusive_use (outchannel); #endif /* Stride people say it's a mystery why this is needed as well as the O_NDELAY, but that it fails without this. */ #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS)) { int one = 1; ioctl (inchannel, FIONBIO, &one); } #endif #ifdef O_NONBLOCK fcntl (inchannel, F_SETFL, O_NONBLOCK); #else #ifdef O_NDELAY fcntl (inchannel, F_SETFL, O_NDELAY); #endif #endif /* Record this as an active process, with its channels. As a result, child_setup will close Emacs's side of the pipes. */ chan_process[inchannel] = process; XSETINT (XPROCESS (process)->infd, inchannel); XSETINT (XPROCESS (process)->outfd, outchannel); /* Record the tty descriptor used in the subprocess. */ if (forkin < 0) XPROCESS (process)->subtty = Qnil; else XSETFASTINT (XPROCESS (process)->subtty, forkin); XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil); XPROCESS (process)->status = Qrun; /* Delay interrupts until we have a chance to store the new fork's pid in its process structure */ #ifdef SIGCHLD #ifdef BSD4_1 sighold (SIGCHLD); #else /* not BSD4_1 */ #if defined (BSD) || defined (UNIPLUS) || defined (HPUX) sigsetmask (sigmask (SIGCHLD)); #else /* ordinary USG */ #if 0 sigchld_deferred = 0; sigchld = signal (SIGCHLD, create_process_sigchld); #endif #endif /* ordinary USG */ #endif /* not BSD4_1 */ #endif /* SIGCHLD */ FD_SET (inchannel, &input_wait_mask); FD_SET (inchannel, &non_keyboard_wait_mask); if (inchannel > max_process_desc) max_process_desc = inchannel; /* Until we store the proper pid, enable sigchld_handler to recognize an unknown pid as standing for this process. It is very important not to let this `marker' value stay in the table after this function has returned; if it does it might cause call-process to hang and subsequent asynchronous processes to get their return values scrambled. */ XSETINT (XPROCESS (process)->pid, -1); { /* child_setup must clobber environ on systems with true vfork. Protect it from permanent change. */ char **save_environ = environ; #ifndef WINDOWSNT pid = vfork (); if (pid == 0) #endif /* not WINDOWSNT */ { int xforkin = forkin; int xforkout = forkout; #if 0 /* This was probably a mistake--it duplicates code later on, but fails to handle all the cases. */ /* Make sure SIGCHLD is not blocked in the child. */ sigsetmask (SIGEMPTYMASK); #endif /* Make the pty be the controlling terminal of the process. */ #ifdef HAVE_PTYS /* First, disconnect its current controlling terminal. */ #ifdef HAVE_SETSID /* We tried doing setsid only if pty_flag, but it caused process_set_signal to fail on SGI when using a pipe. */ setsid (); /* Make the pty's terminal the controlling terminal. */ if (pty_flag) { #ifdef TIOCSCTTY /* We ignore the return value because faith@cs.unc.edu says that is necessary on Linux. */ ioctl (xforkin, TIOCSCTTY, 0); #endif } #else /* not HAVE_SETSID */ #ifdef USG /* It's very important to call setpgrp here and no time afterwards. Otherwise, we lose our controlling tty which is set when we open the pty. */ setpgrp (); #endif /* USG */ #endif /* not HAVE_SETSID */ #if defined (HAVE_TERMIOS) && defined (LDISC1) if (pty_flag && xforkin >= 0) { struct termios t; tcgetattr (xforkin, &t); t.c_lflag = LDISC1; if (tcsetattr (xforkin, TCSANOW, &t) < 0) write (1, "create_process/tcsetattr LDISC1 failed\n", 39); } #else #if defined (NTTYDISC) && defined (TIOCSETD) if (pty_flag && xforkin >= 0) { /* Use new line discipline. */ int ldisc = NTTYDISC; ioctl (xforkin, TIOCSETD, &ldisc); } #endif #endif #ifdef TIOCNOTTY /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you can do TIOCSPGRP only to the process's controlling tty. */ if (pty_flag) { /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here? I can't test it since I don't have 4.3. */ int j = open ("/dev/tty", O_RDWR, 0); ioctl (j, TIOCNOTTY, 0); close (j); #ifndef USG /* In order to get a controlling terminal on some versions of BSD, it is necessary to put the process in pgrp 0 before it opens the terminal. */ #ifdef OSF1 setpgid (0, 0); #else setpgrp (0, 0); #endif #endif } #endif /* TIOCNOTTY */ #if !defined (RTU) && !defined (UNIPLUS) /*** There is a suggestion that this ought to be a conditional on TIOCSPGRP. */ /* Now close the pty (if we had it open) and reopen it. This makes the pty the controlling terminal of the subprocess. */ if (pty_flag) { #ifdef SET_CHILD_PTY_PGRP int pgrp = getpid (); #endif /* I wonder if close (open (pty_name, ...)) would work? */ if (xforkin >= 0) close (xforkin); xforkout = xforkin = open (pty_name, O_RDWR, 0); if (xforkin < 0) { write (1, "Couldn't open the pty terminal ", 31); write (1, pty_name, strlen (pty_name)); write (1, "\n", 1); _exit (1); } #ifdef SET_CHILD_PTY_PGRP ioctl (xforkin, TIOCSPGRP, &pgrp); ioctl (xforkout, TIOCSPGRP, &pgrp); #endif } #endif /* not UNIPLUS and not RTU */ #ifdef SETUP_SLAVE_PTY if (pty_flag) { SETUP_SLAVE_PTY; } #endif /* SETUP_SLAVE_PTY */ #ifdef AIX /* On AIX, we've disabled SIGHUP above once we start a child on a pty. Now reenable it in the child, so it will die when we want it to. */ if (pty_flag) signal (SIGHUP, SIG_DFL); #endif #endif /* HAVE_PTYS */ #ifdef SIGCHLD #ifdef BSD4_1 sigrelse (SIGCHLD); #else /* not BSD4_1 */ #if defined (BSD) || defined (UNIPLUS) || defined (HPUX) sigsetmask (SIGEMPTYMASK); #else /* ordinary USG */ #if 0 signal (SIGCHLD, sigchld); #endif #endif /* ordinary USG */ #endif /* not BSD4_1 */ #endif /* SIGCHLD */ signal (SIGINT, SIG_DFL); signal (SIGQUIT, SIG_DFL); if (pty_flag) child_setup_tty (xforkout); #ifdef WINDOWSNT pid = child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir); #else /* not WINDOWSNT */ child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir); #endif /* not WINDOWSNT */ } environ = save_environ; } if (pid < 0) { if (forkin >= 0) close (forkin); if (forkin != forkout && forkout >= 0) close (forkout); report_file_error ("Doing vfork", Qnil); } XSETFASTINT (XPROCESS (process)->pid, pid); #ifdef WINDOWSNT register_child (pid, inchannel); #endif /* WINDOWSNT */ /* If the subfork execv fails, and it exits, this close hangs. I don't know why. So have an interrupt jar it loose. */ stop_polling (); signal (SIGALRM, create_process_1); alarm (1); XPROCESS (process)->subtty = Qnil; if (forkin >= 0) close (forkin); alarm (0); start_polling (); if (forkin != forkout && forkout >= 0) close (forkout); #ifdef HAVE_PTYS if (pty_flag) XPROCESS (process)->tty_name = build_string (pty_name); else #endif XPROCESS (process)->tty_name = Qnil; #ifdef SIGCHLD #ifdef BSD4_1 sigrelse (SIGCHLD); #else /* not BSD4_1 */ #if defined (BSD) || defined (UNIPLUS) || defined (HPUX) sigsetmask (SIGEMPTYMASK); #else /* ordinary USG */ #if 0 signal (SIGCHLD, sigchld); /* Now really handle any of these signals that came in during this function. */ if (sigchld_deferred) kill (getpid (), SIGCHLD); #endif #endif /* ordinary USG */ #endif /* not BSD4_1 */ #endif /* SIGCHLD */ } #endif /* not VMS */ #ifdef HAVE_SOCKETS /* open a TCP network connection to a given HOST/SERVICE. Treated exactly like a normal process when reading and writing. Only differences are in status display and process deletion. A network connection has no PID; you cannot signal it. All you can do is deactivate and close it via delete-process */ DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream, 4, 4, 0, "Open a TCP connection for a service to a host.\n\ Returns a subprocess-object to represent the connection.\n\ Input and output work as for subprocesses; `delete-process' closes it.\n\ Args are NAME BUFFER HOST SERVICE.\n\ NAME is name for process. It is modified if necessary to make it unique.\n\ BUFFER is the buffer (or buffer-name) to associate with the process.\n\ Process output goes at end of that buffer, unless you specify\n\ an output stream or filter function to handle the output.\n\ BUFFER may be also nil, meaning that this process is not associated\n\ with any buffer\n\ Third arg is name of the host to connect to, or its IP address.\n\ Fourth arg SERVICE is name of the service desired, or an integer\n\ specifying a port number to connect to.") (name, buffer, host, service) Lisp_Object name, buffer, host, service; { Lisp_Object proc; register int i; struct sockaddr_in address; struct servent *svc_info; struct hostent *host_info_ptr, host_info; char *(addr_list[2]); IN_ADDR numeric_addr; int s, outch, inch; char errstring[80]; int port; struct hostent host_info_fixed; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; int retry = 0; int count = specpdl_ptr - specpdl; GCPRO4 (name, buffer, host, service); CHECK_STRING (name, 0); CHECK_STRING (host, 0); if (INTEGERP (service)) port = htons ((unsigned short) XINT (service)); else { CHECK_STRING (service, 0); svc_info = getservbyname (XSTRING (service)->data, "tcp"); if (svc_info == 0) error ("Unknown service \"%s\"", XSTRING (service)->data); port = svc_info->s_port; } #ifndef TERM while (1) { #ifdef TRY_AGAIN h_errno = 0; #endif host_info_ptr = gethostbyname (XSTRING (host)->data); #ifdef TRY_AGAIN if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN)) #endif break; Fsleep_for (make_number (1), Qnil); } if (host_info_ptr == 0) /* Attempt to interpret host as numeric inet address */ { numeric_addr = inet_addr ((char *) XSTRING (host)->data); if (NUMERIC_ADDR_ERROR) error ("Unknown host \"%s\"", XSTRING (host)->data); host_info_ptr = &host_info; host_info.h_name = 0; host_info.h_aliases = 0; host_info.h_addrtype = AF_INET; #ifdef h_addr /* Older machines have only one address slot called h_addr. Newer machines have h_addr_list, but #define h_addr to be its first element. */ host_info.h_addr_list = &(addr_list[0]); #endif host_info.h_addr = (char*)(&numeric_addr); addr_list[1] = 0; host_info.h_length = strlen (addr_list[0]); } bzero (&address, sizeof address); bcopy (host_info_ptr->h_addr, (char *) &address.sin_addr, host_info_ptr->h_length); address.sin_family = host_info_ptr->h_addrtype; address.sin_port = port; s = socket (host_info_ptr->h_addrtype, SOCK_STREAM, 0); if (s < 0) report_file_error ("error creating socket", Fcons (name, Qnil)); /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) when connect is interrupted. So let's not let it get interrupted. Note we do not turn off polling, because polling is only used when not interrupt_input, and thus not normally used on the systems which have this bug. On systems which use polling, there's no way to quit if polling is turned off. */ if (interrupt_input) unrequest_sigio (); /* Slow down polling to every ten seconds. Some kernels have a bug which causes retrying connect to fail after a connect. */ #ifdef POLL_FOR_INPUT bind_polling_period (10); #endif loop: if (connect (s, (struct sockaddr *) &address, sizeof address) == -1 && errno != EISCONN) { int xerrno = errno; if (errno == EINTR) goto loop; if (errno == EADDRINUSE && retry < 20) { /* A delay here is needed on some FreeBSD systems, and it is harmless, since this retrying takes time anyway and should be infrequent. */ Fsleep_for (make_number (1), Qnil); retry++; goto loop; } close (s); if (interrupt_input) request_sigio (); errno = xerrno; report_file_error ("connection failed", Fcons (host, Fcons (name, Qnil))); } #ifdef POLL_FOR_INPUT unbind_to (count, Qnil); #endif if (interrupt_input) request_sigio (); #else /* TERM */ s = connect_server (0); if (s < 0) report_file_error ("error creating socket", Fcons (name, Qnil)); send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port)); send_command (s, C_DUMB, 1, 0); #endif /* TERM */ inch = s; outch = dup (s); if (outch < 0) report_file_error ("error duplicating socket", Fcons (name, Qnil)); if (!NILP (buffer)) buffer = Fget_buffer_create (buffer); proc = make_process (name); chan_process[inch] = proc; #ifdef O_NONBLOCK fcntl (inch, F_SETFL, O_NONBLOCK); #else #ifdef O_NDELAY fcntl (inch, F_SETFL, O_NDELAY); #endif #endif XPROCESS (proc)->childp = host; XPROCESS (proc)->command_channel_p = Qnil; XPROCESS (proc)->buffer = buffer; XPROCESS (proc)->sentinel = Qnil; XPROCESS (proc)->filter = Qnil; XPROCESS (proc)->command = Qnil; XPROCESS (proc)->pid = Qnil; XSETINT (XPROCESS (proc)->infd, s); XSETINT (XPROCESS (proc)->outfd, outch); XPROCESS (proc)->status = Qrun; FD_SET (inch, &input_wait_mask); FD_SET (inch, &non_keyboard_wait_mask); if (inch > max_process_desc) max_process_desc = inch; UNGCPRO; return proc; } #endif /* HAVE_SOCKETS */ deactivate_process (proc) Lisp_Object proc; { register int inchannel, outchannel; register struct Lisp_Process *p = XPROCESS (proc); inchannel = XINT (p->infd); outchannel = XINT (p->outfd); if (inchannel >= 0) { /* Beware SIGCHLD hereabouts. */ flush_pending_output (inchannel); #ifdef VMS { VMS_PROC_STUFF *get_vms_process_pointer (), *vs; sys$dassgn (outchannel); vs = get_vms_process_pointer (p->pid); if (vs) give_back_vms_process_stuff (vs); } #else close (inchannel); if (outchannel >= 0 && outchannel != inchannel) close (outchannel); #endif XSETINT (p->infd, -1); XSETINT (p->outfd, -1); chan_process[inchannel] = Qnil; FD_CLR (inchannel, &input_wait_mask); FD_CLR (inchannel, &non_keyboard_wait_mask); if (inchannel == max_process_desc) { int i; /* We just closed the highest-numbered process input descriptor, so recompute the highest-numbered one now. */ max_process_desc = 0; for (i = 0; i < MAXDESC; i++) if (!NILP (chan_process[i])) max_process_desc = i; } } } /* Close all descriptors currently in use for communication with subprocess. This is used in a newly-forked subprocess to get rid of irrelevant descriptors. */ close_process_descs () { #ifndef WINDOWSNT int i; for (i = 0; i < MAXDESC; i++) { Lisp_Object process; process = chan_process[i]; if (!NILP (process)) { int in = XINT (XPROCESS (process)->infd); int out = XINT (XPROCESS (process)->outfd); if (in >= 0) close (in); if (out >= 0 && in != out) close (out); } } #endif } DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output, 0, 3, 0, "Allow any pending output from subprocesses to be read by Emacs.\n\ It is read into the process' buffers or given to their filter functions.\n\ Non-nil arg PROCESS means do not return until some output has been received\n\ from PROCESS.\n\ Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\ seconds and microseconds to wait; return after that much time whether\n\ or not there is input.\n\ Return non-nil iff we received any output before the timeout expired.") (proc, timeout, timeout_msecs) register Lisp_Object proc, timeout, timeout_msecs; { int seconds; int useconds; if (! NILP (timeout_msecs)) { CHECK_NUMBER (timeout_msecs, 2); useconds = XINT (timeout_msecs); if (!INTEGERP (timeout)) XSETINT (timeout, 0); { int carry = useconds / 1000000; XSETINT (timeout, XINT (timeout) + carry); useconds -= carry * 1000000; /* I think this clause is necessary because C doesn't guarantee a particular rounding direction for negative integers. */ if (useconds < 0) { XSETINT (timeout, XINT (timeout) - 1); useconds += 1000000; } } } else useconds = 0; if (! NILP (timeout)) { CHECK_NUMBER (timeout, 1); seconds = XINT (timeout); if (seconds <= 0) seconds = -1; } else { if (NILP (proc)) seconds = -1; else seconds = 0; } if (NILP (proc)) XSETFASTINT (proc, 0); return (wait_reading_process_input (seconds, useconds, proc, 0) ? Qt : Qnil); } /* This variable is different from waiting_for_input in keyboard.c. It is used to communicate to a lisp process-filter/sentinel (via the function Fwaiting_for_user_input_p below) whether emacs was waiting for user-input when that process-filter was called. waiting_for_input cannot be used as that is by definition 0 when lisp code is being evalled. This is also used in record_asynch_buffer_change. For that purpose, this must be 0 when not inside wait_reading_process_input. */ static int waiting_for_user_input_p; /* Read and dispose of subprocess output while waiting for timeout to elapse and/or keyboard input to be available. TIME_LIMIT is: timeout in seconds, or zero for no limit, or -1 means gobble data immediately available but don't wait for any. MICROSECS is: an additional duration to wait, measured in microseconds. If this is nonzero and time_limit is 0, then the timeout consists of MICROSECS only. READ_KBD is a lisp value: 0 to ignore keyboard input, or 1 to return when input is available, or -1 meaning caller will actually read the input, so don't throw to the quit handler, or a cons cell, meaning wait until its car is non-nil (and gobble terminal input into the buffer if any arrives), or a process object, meaning wait until something arrives from that process. The return value is true iff we read some input from that process. DO_DISPLAY != 0 means redisplay should be done to show subprocess output that arrives. If READ_KBD is a pointer to a struct Lisp_Process, then the function returns true iff we received input from that process before the timeout elapsed. Otherwise, return true iff we received input from any process. */ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) int time_limit, microsecs; Lisp_Object read_kbd; int do_display; { register int channel, nfds, m; static SELECT_TYPE Available; int xerrno; Lisp_Object proc; EMACS_TIME timeout, end_time, garbage; SELECT_TYPE Atemp; int wait_channel = -1; struct Lisp_Process *wait_proc = 0; int got_some_input = 0; Lisp_Object *wait_for_cell = 0; FD_ZERO (&Available); /* If read_kbd is a process to watch, set wait_proc and wait_channel accordingly. */ if (PROCESSP (read_kbd)) { wait_proc = XPROCESS (read_kbd); wait_channel = XINT (wait_proc->infd); XSETFASTINT (read_kbd, 0); } /* If waiting for non-nil in a cell, record where. */ if (CONSP (read_kbd)) { wait_for_cell = &XCONS (read_kbd)->car; XSETFASTINT (read_kbd, 0); } waiting_for_user_input_p = XINT (read_kbd); /* Since we may need to wait several times, compute the absolute time to return at. */ if (time_limit || microsecs) { EMACS_GET_TIME (end_time); EMACS_SET_SECS_USECS (timeout, time_limit, microsecs); EMACS_ADD_TIME (end_time, end_time, timeout); } while (1) { /* If calling from keyboard input, do not quit since we want to return C-g as an input character. Otherwise, do pending quit if requested. */ if (XINT (read_kbd) >= 0) QUIT; /* Exit now if the cell we're waiting for became non-nil. */ if (wait_for_cell && ! NILP (*wait_for_cell)) break; /* Compute time from now till when time limit is up */ /* Exit if already run out */ if (time_limit == -1) { /* -1 specified for timeout means gobble output available now but don't wait at all. */ EMACS_SET_SECS_USECS (timeout, 0, 0); } else if (time_limit || microsecs) { EMACS_GET_TIME (timeout); EMACS_SUB_TIME (timeout, end_time, timeout); if (EMACS_TIME_NEG_P (timeout)) break; } else { EMACS_SET_SECS_USECS (timeout, 100000, 0); } /* Cause C-g and alarm signals to take immediate action, and cause input available signals to zero out timeout. It is important that we do this before checking for process activity. If we get a SIGCHLD after the explicit checks for process activity, timeout is the only way we will know. */ if (XINT (read_kbd) < 0) set_waiting_for_input (&timeout); /* If status of something has changed, and no input is available, notify the user of the change right away. After this explicit check, we'll let the SIGCHLD handler zap timeout to get our attention. */ if (update_tick != process_tick && do_display) { Atemp = input_wait_mask; EMACS_SET_SECS_USECS (timeout, 0, 0); if ((select (MAXDESC, &Atemp, (SELECT_TYPE *)0, (SELECT_TYPE *)0, &timeout) <= 0)) { /* It's okay for us to do this and then continue with the loop, since timeout has already been zeroed out. */ clear_waiting_for_input (); status_notify (); } } /* Don't wait for output from a non-running process. */ if (wait_proc != 0 && !NILP (wait_proc->raw_status_low)) update_status (wait_proc); if (wait_proc != 0 && ! EQ (wait_proc->status, Qrun)) { clear_waiting_for_input (); break; } /* Wait till there is something to do */ if (! XINT (read_kbd) && wait_for_cell == 0) Available = non_keyboard_wait_mask; else Available = input_wait_mask; /* If frame size has changed or the window is newly mapped, redisplay now, before we start to wait. There is a race condition here; if a SIGIO arrives between now and the select and indicates that a frame is trashed, the select may block displaying a trashed screen. */ if (frame_garbaged && do_display) { clear_waiting_for_input (); redisplay_preserve_echo_area (); if (XINT (read_kbd) < 0) set_waiting_for_input (&timeout); } if (XINT (read_kbd) && detect_input_pending ()) { nfds = 0; FD_ZERO (&Available); } else nfds = select (MAXDESC, &Available, (SELECT_TYPE *)0, (SELECT_TYPE *)0, &timeout); xerrno = errno; /* Make C-g and alarm signals set flags again */ clear_waiting_for_input (); /* If we woke up due to SIGWINCH, actually change size now. */ do_pending_window_change (); if (time_limit && nfds == 0) /* timeout elapsed */ break; if (nfds < 0) { if (xerrno == EINTR) FD_ZERO (&Available); #ifdef ultrix /* Ultrix select seems to return ENOMEM when it is interrupted. Treat it just like EINTR. Bleah. Note that we want to test for the "ultrix" CPP symbol, not "__ultrix__"; the latter is only defined under GCC, but not by DEC's bundled CC. -JimB */ else if (xerrno == ENOMEM) FD_ZERO (&Available); #endif #ifdef ALLIANT /* This happens for no known reason on ALLIANT. I am guessing that this is the right response. -- RMS. */ else if (xerrno == EFAULT) FD_ZERO (&Available); #endif else if (xerrno == EBADF) { #ifdef AIX /* AIX doesn't handle PTY closure the same way BSD does. On AIX, the child's closure of the pts gives the parent a SIGHUP, and the ptc file descriptor is automatically closed, yielding EBADF here or at select() call above. So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF in m/ibmrt-aix.h), and here we just ignore the select error. Cleanup occurs c/o status_notify after SIGCLD. */ FD_ZERO (&Available); /* Cannot depend on values returned */ #else abort (); #endif } else error("select error: %s", strerror (xerrno)); } #if defined(sun) && !defined(USG5_4) else if (nfds > 0 && keyboard_bit_set (&Available) && interrupt_input) /* System sometimes fails to deliver SIGIO. David J. Mackenzie says that Emacs doesn't compile under Solaris if this code is enabled, thus the USG5_4 in the CPP conditional. "I haven't noticed any ill effects so far. If you find a Solaris expert somewhere, they might know better." */ kill (getpid (), SIGIO); #endif /* Check for keyboard input */ /* If there is any, return immediately to give it higher priority than subprocesses */ /* We used to do this if wait_for_cell, but that caused infinite recursion in selection request events. */ if ((XINT (read_kbd) || wait_for_cell) && detect_input_pending ()) { swallow_events (); if (detect_input_pending ()) break; } /* Exit now if the cell we're waiting for became non-nil. */ if (wait_for_cell && ! NILP (*wait_for_cell)) break; #ifdef SIGIO /* If we think we have keyboard input waiting, but didn't get SIGIO go read it. This can happen with X on BSD after logging out. In that case, there really is no input and no SIGIO, but select says there is input. */ if (XINT (read_kbd) && interrupt_input && (keyboard_bit_set (&Available))) kill (0, SIGIO); #endif if (! wait_proc) got_some_input |= nfds > 0; /* 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 (); /* Check for data from a process. */ /* Really FIRST_PROC_DESC should be 0 on Unix, but this is safer in the short run. */ for (channel = 0; channel <= max_process_desc; channel++) { if (FD_ISSET (channel, &Available) && FD_ISSET (channel, &non_keyboard_wait_mask)) { int nread; /* If waiting for this channel, arrange to return as soon as no more input to be processed. No more waiting. */ if (wait_channel == channel) { wait_channel = -1; time_limit = -1; got_some_input = 1; } proc = chan_process[channel]; if (NILP (proc)) continue; /* Read data from the process, starting with our buffered-ahead character if we have one. */ nread = read_process_output (proc, channel); if (nread > 0) { /* Since read_process_output can run a filter, which can call accept-process-output, don't try to read from any other processes before doing the select again. */ FD_ZERO (&Available); if (do_display) redisplay_preserve_echo_area (); } #ifdef EWOULDBLOCK else if (nread == -1 && errno == EWOULDBLOCK) ; #else #ifdef O_NONBLOCK else if (nread == -1 && errno == EAGAIN) ; #else #ifdef O_NDELAY else if (nread == -1 && errno == EAGAIN) ; /* Note that we cannot distinguish between no input available now and a closed pipe. With luck, a closed pipe will be accompanied by subprocess termination and SIGCHLD. */ else if (nread == 0 && !NETCONN_P (proc)) ; #endif /* O_NDELAY */ #endif /* O_NONBLOCK */ #endif /* EWOULDBLOCK */ #ifdef HAVE_PTYS /* On some OSs with ptys, when the process on one end of a pty exits, the other end gets an error reading with errno = EIO instead of getting an EOF (0 bytes read). Therefore, if we get an error reading and errno = EIO, just continue, because the child process has exited and should clean itself up soon (e.g. when we get a SIGCHLD). */ else if (nread == -1 && errno == EIO) ; #endif /* HAVE_PTYS */ /* If we can detect process termination, don't consider the process gone just because its pipe is closed. */ #ifdef SIGCHLD else if (nread == 0 && !NETCONN_P (proc)) ; #endif else { /* Preserve status of processes already terminated. */ XSETINT (XPROCESS (proc)->tick, ++process_tick); deactivate_process (proc); if (!NILP (XPROCESS (proc)->raw_status_low)) update_status (XPROCESS (proc)); if (EQ (XPROCESS (proc)->status, Qrun)) XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil)); } } } /* end for each file descriptor */ } /* end while exit conditions not met */ waiting_for_user_input_p = 0; /* If calling from keyboard input, do not quit since we want to return C-g as an input character. Otherwise, do pending quit if requested. */ if (XINT (read_kbd) >= 0) { /* Prevent input_pending from remaining set if we quit. */ clear_input_pending (); QUIT; } return got_some_input; } /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */ static Lisp_Object read_process_output_call (fun_and_args) Lisp_Object fun_and_args; { return apply1 (XCONS (fun_and_args)->car, XCONS (fun_and_args)->cdr); } static Lisp_Object read_process_output_error_handler (error) Lisp_Object error; { cmd_error_internal (error, "error in process filter: "); Vinhibit_quit = Qt; update_echo_area (); Fsleep_for (make_number (2), Qnil); } /* Read pending output from the process channel, starting with our buffered-ahead character if we have one. Yield number of characters read. This function reads at most 1024 characters. If you want to read all available subprocess output, you must call it repeatedly until it returns zero. */ read_process_output (proc, channel) Lisp_Object proc; register int channel; { register int nchars; #ifdef VMS char *chars; #else char chars[1024]; #endif register Lisp_Object outstream; register struct buffer *old = current_buffer; register struct Lisp_Process *p = XPROCESS (proc); register int opoint; #ifdef VMS VMS_PROC_STUFF *vs, *get_vms_process_pointer(); vs = get_vms_process_pointer (p->pid); if (vs) { if (!vs->iosb[0]) return(0); /* Really weird if it does this */ if (!(vs->iosb[0] & 1)) return -1; /* I/O error */ } else error ("Could not get VMS process pointer"); chars = vs->inputBuffer; nchars = clean_vms_buffer (chars, vs->iosb[1]); if (nchars <= 0) { start_vms_process_read (vs); /* Crank up the next read on the process */ return 1; /* Nothing worth printing, say we got 1 */ } #else /* not VMS */ if (proc_buffered_char[channel] < 0) #ifdef WINDOWSNT nchars = read_child_output (channel, chars, sizeof (chars)); #else nchars = read (channel, chars, sizeof chars); #endif else { chars[0] = proc_buffered_char[channel]; proc_buffered_char[channel] = -1; #ifdef WINDOWSNT nchars = read_child_output (channel, chars + 1, sizeof (chars) - 1); #else nchars = read (channel, chars + 1, sizeof chars - 1); #endif if (nchars < 0) nchars = 1; else nchars = nchars + 1; } #endif /* not VMS */ if (nchars <= 0) return nchars; outstream = p->filter; if (!NILP (outstream)) { /* We inhibit quit here instead of just catching it so that hitting ^G when a filter happens to be running won't screw it up. */ int count = specpdl_ptr - specpdl; Lisp_Object odeactivate; Lisp_Object obuffer, okeymap; /* No need to gcpro these, because all we do with them later is test them for EQness, and none of them should be a string. */ odeactivate = Vdeactivate_mark; XSETBUFFER (obuffer, current_buffer); okeymap = current_buffer->keymap; specbind (Qinhibit_quit, Qt); specbind (Qlast_nonmenu_event, Qt); running_asynch_code = 1; internal_condition_case_1 (read_process_output_call, Fcons (outstream, Fcons (proc, Fcons (make_string (chars, nchars), Qnil))), !NILP (Vdebug_on_error) ? Qnil : Qerror, read_process_output_error_handler); running_asynch_code = 0; restore_match_data (); /* Handling the process output should not deactivate the mark. */ Vdeactivate_mark = odeactivate; #if 0 /* Call record_asynch_buffer_change unconditionally, because we might have changed minor modes or other things that affect key bindings. */ if (! EQ (Fcurrent_buffer (), obuffer) || ! EQ (current_buffer->keymap, okeymap)) #endif /* But do it only if the caller is actually going to read events. Otherwise there's no need to make him wake up, and it could cause trouble (for example it would make Fsit_for return). */ if (waiting_for_user_input_p == -1) record_asynch_buffer_change (); #ifdef VMS start_vms_process_read (vs); #endif unbind_to (count, Qnil); return nchars; } /* If no filter, write into buffer if it isn't dead. */ if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name)) { Lisp_Object old_read_only; Lisp_Object old_begv, old_zv; Lisp_Object odeactivate; odeactivate = Vdeactivate_mark; Fset_buffer (p->buffer); opoint = point; old_read_only = current_buffer->read_only; XSETFASTINT (old_begv, BEGV); XSETFASTINT (old_zv, ZV); current_buffer->read_only = Qnil; /* Insert new output into buffer at the current end-of-output marker, thus preserving logical ordering of input and output. */ if (XMARKER (p->mark)->buffer) SET_PT (clip_to_bounds (BEGV, marker_position (p->mark), ZV)); else SET_PT (ZV); /* If the output marker is outside of the visible region, save the restriction and widen. */ if (! (BEGV <= point && point <= ZV)) Fwiden (); /* Make sure opoint floats ahead of any new text, just as point would. */ if (point <= opoint) opoint += nchars; /* Insert after old_begv, but before old_zv. */ if (point < XFASTINT (old_begv)) XSETFASTINT (old_begv, XFASTINT (old_begv) + nchars); if (point <= XFASTINT (old_zv)) XSETFASTINT (old_zv, XFASTINT (old_zv) + nchars); /* Insert before markers in case we are inserting where the buffer's mark is, and the user's next command is Meta-y. */ insert_before_markers (chars, nchars); Fset_marker (p->mark, make_number (point), p->buffer); update_mode_lines++; /* If the restriction isn't what it should be, set it. */ if (XFASTINT (old_begv) != BEGV || XFASTINT (old_zv) != ZV) Fnarrow_to_region (old_begv, old_zv); /* Handling the process output should not deactivate the mark. */ Vdeactivate_mark = odeactivate; current_buffer->read_only = old_read_only; SET_PT (opoint); set_buffer_internal (old); } #ifdef VMS start_vms_process_read (vs); #endif return nchars; } DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p, 0, 0, 0, "Returns non-nil if emacs is waiting for input from the user.\n\ This is intended for use by asynchronous process output filters and sentinels.") () { return (waiting_for_user_input_p ? Qt : Qnil); } /* Sending data to subprocess */ jmp_buf send_process_frame; SIGTYPE send_process_trap () { #ifdef BSD4_1 sigrelse (SIGPIPE); sigrelse (SIGALRM); #endif /* BSD4_1 */ longjmp (send_process_frame, 1); } /* Send some data to process PROC. BUF is the beginning of the data; LEN is the number of characters. OBJECT is the Lisp object that the data comes from. */ send_process (proc, buf, len, object) volatile Lisp_Object proc; char *buf; int len; Lisp_Object object; { /* Use volatile to protect variables from being clobbered by longjmp. */ int rv; volatile unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data; #ifdef VMS struct Lisp_Process *p = XPROCESS (proc); VMS_PROC_STUFF *vs, *get_vms_process_pointer(); #endif /* VMS */ if (! NILP (XPROCESS (proc)->raw_status_low)) update_status (XPROCESS (proc)); if (! EQ (XPROCESS (proc)->status, Qrun)) error ("Process %s not running", procname); #ifdef VMS vs = get_vms_process_pointer (p->pid); if (vs == 0) error ("Could not find this process: %x", p->pid); else if (write_to_vms_process (vs, buf, len)) ; #else if (pty_max_bytes == 0) { #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON) pty_max_bytes = fpathconf (XFASTINT (XPROCESS (proc)->outfd), _PC_MAX_CANON); if (pty_max_bytes < 0) pty_max_bytes = 250; #else pty_max_bytes = 250; #endif /* Deduct one, to leave space for the eof. */ pty_max_bytes--; } if (!setjmp (send_process_frame)) while (len > 0) { int this = len; SIGTYPE (*old_sigpipe)(); int flush_pty = 0; /* Decide how much data we can send in one batch. Long lines need to be split into multiple batches. */ if (!NILP (XPROCESS (proc)->pty_flag)) { /* Starting this at zero is always correct when not the first iteration because the previous iteration ended by sending C-d. It may not be correct for the first iteration if a partial line was sent in a separate send_process call. If that proves worth handling, we need to save linepos in the process object. */ int linepos = 0; char *ptr = buf; char *end = buf + len; /* Scan through this text for a line that is too long. */ while (ptr != end && linepos < pty_max_bytes) { if (*ptr == '\n') linepos = 0; else linepos++; ptr++; } /* If we found one, break the line there and put in a C-d to force the buffer through. */ this = ptr - buf; } /* Send this batch, using one or more write calls. */ while (this > 0) { old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap); rv = write (XINT (XPROCESS (proc)->outfd), buf, this); signal (SIGPIPE, old_sigpipe); if (rv < 0) { if (0 #ifdef EWOULDBLOCK || errno == EWOULDBLOCK #endif #ifdef EAGAIN || errno == EAGAIN #endif ) /* Buffer is full. Wait, accepting input; that may allow the program to finish doing output and read more. */ { Lisp_Object zero; int offset; /* Running filters might relocate buffers or strings. Arrange to relocate BUF. */ if (BUFFERP (object)) offset = BUF_PTR_CHAR_POS (XBUFFER (object), (unsigned char *) buf); else if (STRINGP (object)) offset = buf - (char *) XSTRING (object)->data; XSETFASTINT (zero, 0); wait_reading_process_input (1, 0, zero, 0); if (BUFFERP (object)) buf = (char *) BUF_CHAR_ADDRESS (XBUFFER (object), offset); else if (STRINGP (object)) buf = offset + (char *) XSTRING (object)->data; rv = 0; } else /* This is a real error. */ report_file_error ("writing to process", Fcons (proc, Qnil)); } buf += rv; len -= rv; this -= rv; } /* If we sent just part of the string, put in an EOF to force it through, before we send the rest. */ if (len > 0) Fprocess_send_eof (proc); } #endif else { XPROCESS (proc)->raw_status_low = Qnil; XPROCESS (proc)->raw_status_high = Qnil; XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil)); XSETINT (XPROCESS (proc)->tick, ++process_tick); deactivate_process (proc); #ifdef VMS error ("Error writing to process %s; closed it", procname); #else error ("SIGPIPE raised on process %s; closed it", procname); #endif } } DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region, 3, 3, 0, "Send current contents of region as input to PROCESS.\n\ PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ nil, indicating the current buffer's process.\n\ Called from program, takes three arguments, PROCESS, START and END.\n\ If the region is more than 500 characters long,\n\ it is sent in several bunches. This may happen even for shorter regions.\n\ Output from processes can arrive in between bunches.") (process, start, end) Lisp_Object process, start, end; { Lisp_Object proc; int start1; proc = get_process (process); validate_region (&start, &end); if (XINT (start) < GPT && XINT (end) > GPT) move_gap (start); start1 = XINT (start); send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start), Fcurrent_buffer ()); return Qnil; } DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string, 2, 2, 0, "Send PROCESS the contents of STRING as input.\n\ PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ nil, indicating the current buffer's process.\n\ If STRING is more than 500 characters long,\n\ it is sent in several bunches. This may happen even for shorter strings.\n\ Output from processes can arrive in between bunches.") (process, string) Lisp_Object process, string; { Lisp_Object proc; CHECK_STRING (string, 1); proc = get_process (process); send_process (proc, XSTRING (string)->data, XSTRING (string)->size, string); return Qnil; } /* send a signal number SIGNO to PROCESS. CURRENT_GROUP means send to the process group that currently owns the terminal being used to communicate with PROCESS. This is used for various commands in shell mode. If NOMSG is zero, insert signal-announcements into process's buffers right away. If we can, we try to signal PROCESS by sending control characters down the pty. This allows us to signal inferiors who have changed their uid, for which killpg would return an EPERM error. */ static void process_send_signal (process, signo, current_group, nomsg) Lisp_Object process; int signo; Lisp_Object current_group; int nomsg; { Lisp_Object proc; register struct Lisp_Process *p; int gid; int no_pgrp = 0; proc = get_process (process); p = XPROCESS (proc); if (!EQ (p->childp, Qt)) error ("Process %s is not a subprocess", XSTRING (p->name)->data); if (XINT (p->infd) < 0) error ("Process %s is not active", XSTRING (p->name)->data); if (NILP (p->pty_flag)) current_group = Qnil; /* If we are using pgrps, get a pgrp number and make it negative. */ if (!NILP (current_group)) { #ifdef SIGNALS_VIA_CHARACTERS /* If possible, send signals to the entire pgrp by sending an input character to it. */ /* TERMIOS is the latest and bestest, and seems most likely to work. If the system has it, use it. */ #ifdef HAVE_TERMIOS struct termios t; switch (signo) { case SIGINT: tcgetattr (XINT (p->infd), &t); send_process (proc, &t.c_cc[VINTR], 1, Qnil); return; case SIGQUIT: tcgetattr (XINT (p->infd), &t); send_process (proc, &t.c_cc[VQUIT], 1, Qnil); return; case SIGTSTP: tcgetattr (XINT (p->infd), &t); #if defined (VSWTCH) && !defined (PREFER_VSUSP) send_process (proc, &t.c_cc[VSWTCH], 1, Qnil); #else send_process (proc, &t.c_cc[VSUSP], 1, Qnil); #endif return; } #else /* ! HAVE_TERMIOS */ /* On Berkeley descendants, the following IOCTL's retrieve the current control characters. */ #if defined (TIOCGLTC) && defined (TIOCGETC) struct tchars c; struct ltchars lc; switch (signo) { case SIGINT: ioctl (XINT (p->infd), TIOCGETC, &c); send_process (proc, &c.t_intrc, 1, Qnil); return; case SIGQUIT: ioctl (XINT (p->infd), TIOCGETC, &c); send_process (proc, &c.t_quitc, 1, Qnil); return; #ifdef SIGTSTP case SIGTSTP: ioctl (XINT (p->infd), TIOCGLTC, &lc); send_process (proc, &lc.t_suspc, 1, Qnil); return; #endif /* ! defined (SIGTSTP) */ } #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */ /* On SYSV descendants, the TCGETA ioctl retrieves the current control characters. */ #ifdef TCGETA struct termio t; switch (signo) { case SIGINT: ioctl (XINT (p->infd), TCGETA, &t); send_process (proc, &t.c_cc[VINTR], 1, Qnil); return; case SIGQUIT: ioctl (XINT (p->infd), TCGETA, &t); send_process (proc, &t.c_cc[VQUIT], 1, Qnil); return; #ifdef SIGTSTP case SIGTSTP: ioctl (XINT (p->infd), TCGETA, &t); send_process (proc, &t.c_cc[VSWTCH], 1, Qnil); return; #endif /* ! defined (SIGTSTP) */ } #else /* ! defined (TCGETA) */ Your configuration files are messed up. /* If your system configuration files define SIGNALS_VIA_CHARACTERS, you'd better be using one of the alternatives above! */ #endif /* ! defined (TCGETA) */ #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */ #endif /* ! defined HAVE_TERMIOS */ #endif /* ! defined (SIGNALS_VIA_CHARACTERS) */ #ifdef TIOCGPGRP /* Get the pgrp using the tty itself, if we have that. Otherwise, use the pty to get the pgrp. On pfa systems, saka@pfu.fujitsu.co.JP writes: "TIOCGPGRP symbol defined in sys/ioctl.h at E50. But, TIOCGPGRP does not work on E50 ;-P works fine on E60" His patch indicates that if TIOCGPGRP returns an error, then we should just assume that p->pid is also the process group id. */ { int err; if (!NILP (p->subtty)) err = ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid); else err = ioctl (XINT (p->infd), TIOCGPGRP, &gid); #ifdef pfa if (err == -1) gid = - XFASTINT (p->pid); #endif /* ! defined (pfa) */ } if (gid == -1) no_pgrp = 1; else gid = - gid; #else /* ! defined (TIOCGPGRP ) */ /* Can't select pgrps on this system, so we know that the child itself heads the pgrp. */ gid = - XFASTINT (p->pid); #endif /* ! defined (TIOCGPGRP ) */ } else gid = - XFASTINT (p->pid); switch (signo) { #ifdef SIGCONT case SIGCONT: p->raw_status_low = Qnil; p->raw_status_high = Qnil; p->status = Qrun; XSETINT (p->tick, ++process_tick); if (!nomsg) status_notify (); break; #endif /* ! defined (SIGCONT) */ case SIGINT: #ifdef VMS send_process (proc, "\003", 1, Qnil); /* ^C */ goto whoosh; #endif case SIGQUIT: #ifdef VMS send_process (proc, "\031", 1, Qnil); /* ^Y */ goto whoosh; #endif case SIGKILL: #ifdef VMS sys$forcex (&(XFASTINT (p->pid)), 0, 1); whoosh: #endif flush_pending_output (XINT (p->infd)); break; } /* If we don't have process groups, send the signal to the immediate subprocess. That isn't really right, but it's better than any obvious alternative. */ if (no_pgrp) { kill (XFASTINT (p->pid), signo); return; } /* gid may be a pid, or minus a pgrp's number */ #ifdef TIOCSIGSEND if (!NILP (current_group)) ioctl (XINT (p->infd), TIOCSIGSEND, signo); else { gid = - XFASTINT (p->pid); kill (gid, signo); } #else /* ! defined (TIOCSIGSEND) */ EMACS_KILLPG (-gid, signo); #endif /* ! defined (TIOCSIGSEND) */ } DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0, "Interrupt process PROCESS. May be process or name of one.\n\ PROCESS may be a process, a buffer, or the name of a process or buffer.\n\ nil or no arg means current buffer's process.\n\ Second arg CURRENT-GROUP non-nil means send signal to\n\ the current process-group of the process's controlling terminal\n\ rather than to the process's own process group.\n\ If the process is a shell, this means interrupt current subjob\n\ rather than the shell.") (process, current_group) Lisp_Object process, current_group; { process_send_signal (process, SIGINT, current_group, 0); return process; } DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0, "Kill process PROCESS. May be process or name of one.\n\ See function `interrupt-process' for more details on usage.") (process, current_group) Lisp_Object process, current_group; { process_send_signal (process, SIGKILL, current_group, 0); return process; } DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0, "Send QUIT signal to process PROCESS. May be process or name of one.\n\ See function `interrupt-process' for more details on usage.") (process, current_group) Lisp_Object process, current_group; { process_send_signal (process, SIGQUIT, current_group, 0); return process; } DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0, "Stop process PROCESS. May be process or name of one.\n\ See function `interrupt-process' for more details on usage.") (process, current_group) Lisp_Object process, current_group; { #ifndef SIGTSTP error ("no SIGTSTP support"); #else process_send_signal (process, SIGTSTP, current_group, 0); #endif return process; } DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0, "Continue process PROCESS. May be process or name of one.\n\ See function `interrupt-process' for more details on usage.") (process, current_group) Lisp_Object process, current_group; { #ifdef SIGCONT process_send_signal (process, SIGCONT, current_group, 0); #else error ("no SIGCONT support"); #endif return process; } DEFUN ("signal-process", Fsignal_process, Ssignal_process, 2, 2, "nProcess number: \nnSignal code: ", "Send the process with process id PID the signal with code SIGCODE.\n\ PID must be an integer. The process need not be a child of this Emacs.\n\ SIGCODE may be an integer, or a symbol whose name is a signal name.") (pid, sigcode) Lisp_Object pid, sigcode; { CHECK_NUMBER (pid, 0); #define handle_signal(NAME, VALUE) \ else if (!strcmp (name, NAME)) \ XSETINT (sigcode, VALUE) if (INTEGERP (sigcode)) ; else { unsigned char *name; CHECK_SYMBOL (sigcode, 1); name = XSYMBOL (sigcode)->name->data; if (0) ; #ifdef SIGHUP handle_signal ("SIGHUP", SIGHUP); #endif #ifdef SIGINT handle_signal ("SIGINT", SIGINT); #endif #ifdef SIGQUIT handle_signal ("SIGQUIT", SIGQUIT); #endif #ifdef SIGILL handle_signal ("SIGILL", SIGILL); #endif #ifdef SIGABRT handle_signal ("SIGABRT", SIGABRT); #endif #ifdef SIGEMT handle_signal ("SIGEMT", SIGEMT); #endif #ifdef SIGKILL handle_signal ("SIGKILL", SIGKILL); #endif #ifdef SIGFPE handle_signal ("SIGFPE", SIGFPE); #endif #ifdef SIGBUS handle_signal ("SIGBUS", SIGBUS); #endif #ifdef SIGSEGV handle_signal ("SIGSEGV", SIGSEGV); #endif #ifdef SIGSYS handle_signal ("SIGSYS", SIGSYS); #endif #ifdef SIGPIPE handle_signal ("SIGPIPE", SIGPIPE); #endif #ifdef SIGALRM handle_signal ("SIGALRM", SIGALRM); #endif #ifdef SIGTERM handle_signal ("SIGTERM", SIGTERM); #endif #ifdef SIGURG handle_signal ("SIGURG", SIGURG); #endif #ifdef SIGSTOP handle_signal ("SIGSTOP", SIGSTOP); #endif #ifdef SIGTSTP handle_signal ("SIGTSTP", SIGTSTP); #endif #ifdef SIGCONT handle_signal ("SIGCONT", SIGCONT); #endif #ifdef SIGCHLD handle_signal ("SIGCHLD", SIGCHLD); #endif #ifdef SIGTTIN handle_signal ("SIGTTIN", SIGTTIN); #endif #ifdef SIGTTOU handle_signal ("SIGTTOU", SIGTTOU); #endif #ifdef SIGIO handle_signal ("SIGIO", SIGIO); #endif #ifdef SIGXCPU handle_signal ("SIGXCPU", SIGXCPU); #endif #ifdef SIGXFSZ handle_signal ("SIGXFSZ", SIGXFSZ); #endif #ifdef SIGVTALRM handle_signal ("SIGVTALRM", SIGVTALRM); #endif #ifdef SIGPROF handle_signal ("SIGPROF", SIGPROF); #endif #ifdef SIGWINCH handle_signal ("SIGWINCH", SIGWINCH); #endif #ifdef SIGINFO handle_signal ("SIGINFO", SIGINFO); #endif #ifdef SIGUSR1 handle_signal ("SIGUSR1", SIGUSR1); #endif #ifdef SIGUSR2 handle_signal ("SIGUSR2", SIGUSR2); #endif else error ("Undefined signal name %s", name); } #undef handle_signal #ifdef WINDOWSNT /* Only works for kill-type signals */ return make_number (win32_kill_process (XINT (pid), XINT (sigcode))); #else return make_number (kill (XINT (pid), XINT (sigcode))); #endif } DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0, "Make PROCESS see end-of-file in its input.\n\ Eof comes after any text already sent to it.\n\ PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ nil, indicating the current buffer's process.\n\ If PROCESS is a network connection, or is a process communicating\n\ through a pipe (as opposed to a pty), then you cannot send any more\n\ text to PROCESS after you call this function.") (process) Lisp_Object process; { Lisp_Object proc; proc = get_process (process); /* Make sure the process is really alive. */ if (! NILP (XPROCESS (proc)->raw_status_low)) update_status (XPROCESS (proc)); if (! EQ (XPROCESS (proc)->status, Qrun)) error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data); #ifdef VMS send_process (proc, "\032", 1, Qnil); /* ^z */ #else if (!NILP (XPROCESS (proc)->pty_flag)) send_process (proc, "\004", 1, Qnil); else { close (XINT (XPROCESS (proc)->outfd)); XSETINT (XPROCESS (proc)->outfd, open (NULL_DEVICE, O_WRONLY)); } #endif /* VMS */ return process; } /* Kill all processes associated with `buffer'. If `buffer' is nil, kill all processes */ kill_buffer_processes (buffer) Lisp_Object buffer; { Lisp_Object tail, proc; for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr) { proc = XCONS (XCONS (tail)->car)->cdr; if (GC_PROCESSP (proc) && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))) { if (NETCONN_P (proc)) Fdelete_process (proc); else if (XINT (XPROCESS (proc)->infd) >= 0) process_send_signal (proc, SIGHUP, Qnil, 1); } } } /* On receipt of a signal that a child status has changed, loop asking about children with changed statuses until the system says there are no more. All we do is change the status; we do not run sentinels or print notifications. That is saved for the next time keyboard input is done, in order to avoid timing errors. */ /** WARNING: this can be called during garbage collection. Therefore, it must not be fooled by the presence of mark bits in Lisp objects. */ /** USG WARNING: Although it is not obvious from the documentation in signal(2), on a USG system the SIGCLD handler MUST NOT call signal() before executing at least one wait(), otherwise the handler will be called again, resulting in an infinite loop. The relevant portion of the documentation reads "SIGCLD signals will be queued and the signal-catching function will be continually reentered until the queue is empty". Invoking signal() causes the kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */ SIGTYPE sigchld_handler (signo) int signo; { int old_errno = errno; Lisp_Object proc; register struct Lisp_Process *p; extern EMACS_TIME *input_available_clear_time; #ifdef BSD4_1 extern int sigheld; sigheld |= sigbit (SIGCHLD); #endif while (1) { register int pid; WAITTYPE w; Lisp_Object tail; #ifdef WNOHANG #ifndef WUNTRACED #define WUNTRACED 0 #endif /* no WUNTRACED */ /* Keep trying to get a status until we get a definitive result. */ do { errno = 0; pid = wait3 (&w, WNOHANG | WUNTRACED, 0); } while (pid <= 0 && errno == EINTR); if (pid <= 0) { /* A real failure. We have done all our job, so return. */ /* USG systems forget handlers when they are used; must reestablish each time */ #ifdef USG signal (signo, sigchld_handler); /* WARNING - must come after wait3() */ #endif #ifdef BSD4_1 sigheld &= ~sigbit (SIGCHLD); sigrelse (SIGCHLD); #endif errno = old_errno; return; } #else pid = wait (&w); #endif /* no WNOHANG */ /* Find the process that signaled us, and record its status. */ p = 0; for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr) { proc = XCONS (XCONS (tail)->car)->cdr; p = XPROCESS (proc); if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid) break; p = 0; } /* Look for an asynchronous process whose pid hasn't been filled in yet. */ if (p == 0) for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr) { proc = XCONS (XCONS (tail)->car)->cdr; p = XPROCESS (proc); if (INTEGERP (p->pid) && XINT (p->pid) == -1) break; p = 0; } /* Change the status of the process that was found. */ if (p != 0) { union { int i; WAITTYPE wt; } u; int clear_desc_flag = 0; XSETINT (p->tick, ++process_tick); u.wt = w; XSETINT (p->raw_status_low, u.i & 0xffff); XSETINT (p->raw_status_high, u.i >> 16); /* If process has terminated, stop waiting for its output. */ if ((WIFSIGNALED (w) || WIFEXITED (w)) && XINT (p->infd) >= 0) clear_desc_flag = 1; /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */ if (clear_desc_flag) { FD_CLR (XINT (p->infd), &input_wait_mask); FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); } /* Tell wait_reading_process_input that it needs to wake up and look around. */ if (input_available_clear_time) EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); } /* There was no asynchronous process found for that id. Check if we have a synchronous process. */ else { synch_process_alive = 0; /* Report the status of the synchronous process. */ if (WIFEXITED (w)) synch_process_retcode = WRETCODE (w); else if (WIFSIGNALED (w)) { int code = WTERMSIG (w); char *signame = 0; if (code < NSIG) { #ifndef VMS /* Suppress warning if the table has const char *. */ signame = (char *) sys_siglist[code]; #else signame = sys_errlist[code]; #endif } if (signame == 0) signame = "unknown"; synch_process_death = signame; } /* Tell wait_reading_process_input that it needs to wake up and look around. */ if (input_available_clear_time) EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); } /* On some systems, we must return right away. If any more processes want to signal us, we will get another signal. Otherwise (on systems that have WNOHANG), loop around to use up all the processes that have something to tell us. */ #if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) || defined (WINDOWSNT) #ifdef USG signal (signo, sigchld_handler); #endif errno = old_errno; return; #endif /* USG, but not HPUX with WNOHANG */ } } static Lisp_Object exec_sentinel_unwind (data) Lisp_Object data; { XPROCESS (XCONS (data)->car)->sentinel = XCONS (data)->cdr; return Qnil; } static Lisp_Object exec_sentinel_error_handler (error) Lisp_Object error; { cmd_error_internal (error, "error in process sentinel: "); Vinhibit_quit = Qt; update_echo_area (); Fsleep_for (make_number (2), Qnil); } static void exec_sentinel (proc, reason) Lisp_Object proc, reason; { Lisp_Object sentinel, obuffer, odeactivate, okeymap; register struct Lisp_Process *p = XPROCESS (proc); int count = specpdl_ptr - specpdl; /* No need to gcpro these, because all we do with them later is test them for EQness, and none of them should be a string. */ odeactivate = Vdeactivate_mark; XSETBUFFER (obuffer, current_buffer); okeymap = current_buffer->keymap; sentinel = p->sentinel; if (NILP (sentinel)) return; /* Zilch the sentinel while it's running, to avoid recursive invocations; assure that it gets restored no matter how the sentinel exits. */ p->sentinel = Qnil; record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel)); /* Inhibit quit so that random quits don't screw up a running filter. */ specbind (Qinhibit_quit, Qt); specbind (Qlast_nonmenu_event, Qt); running_asynch_code = 1; internal_condition_case_1 (read_process_output_call, Fcons (sentinel, Fcons (proc, Fcons (reason, Qnil))), !NILP (Vdebug_on_error) ? Qnil : Qerror, exec_sentinel_error_handler); running_asynch_code = 0; restore_match_data (); Vdeactivate_mark = odeactivate; #if 0 if (! EQ (Fcurrent_buffer (), obuffer) || ! EQ (current_buffer->keymap, okeymap)) #endif /* But do it only if the caller is actually going to read events. Otherwise there's no need to make him wake up, and it could cause trouble (for example it would make Fsit_for return). */ if (waiting_for_user_input_p == -1) record_asynch_buffer_change (); unbind_to (count, Qnil); } /* Report all recent events of a change in process status (either run the sentinel or output a message). This is done while Emacs is waiting for keyboard input. */ status_notify () { register Lisp_Object proc, buffer; Lisp_Object tail, msg; struct gcpro gcpro1, gcpro2; tail = Qnil; msg = Qnil; /* We need to gcpro tail; if read_process_output calls a filter which deletes a process and removes the cons to which tail points from Vprocess_alist, and then causes a GC, tail is an unprotected reference. */ GCPRO2 (tail, msg); /* Set this now, so that if new processes are created by sentinels that we run, we get called again to handle their status changes. */ update_tick = process_tick; for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail)) { Lisp_Object symbol; register struct Lisp_Process *p; proc = Fcdr (Fcar (tail)); p = XPROCESS (proc); if (XINT (p->tick) != XINT (p->update_tick)) { XSETINT (p->update_tick, XINT (p->tick)); /* If process is still active, read any output that remains. */ if (XINT (p->infd) >= 0) while (! EQ (p->filter, Qt) && read_process_output (proc, XINT (p->infd)) > 0); buffer = p->buffer; /* Get the text to use for the message. */ if (!NILP (p->raw_status_low)) update_status (p); msg = status_message (p->status); /* If process is terminated, deactivate it or delete it. */ symbol = p->status; if (CONSP (p->status)) symbol = XCONS (p->status)->car; if (EQ (symbol, Qsignal) || EQ (symbol, Qexit) || EQ (symbol, Qclosed)) { if (delete_exited_processes) remove_process (proc); else deactivate_process (proc); } /* Now output the message suitably. */ if (!NILP (p->sentinel)) exec_sentinel (proc, msg); /* Don't bother with a message in the buffer when a process becomes runnable. */ else if (!EQ (symbol, Qrun) && !NILP (buffer)) { Lisp_Object ro, tem; struct buffer *old = current_buffer; int opoint; ro = XBUFFER (buffer)->read_only; /* Avoid error if buffer is deleted (probably that's why the process is dead, too) */ if (NILP (XBUFFER (buffer)->name)) continue; Fset_buffer (buffer); opoint = point; /* Insert new output into buffer at the current end-of-output marker, thus preserving logical ordering of input and output. */ if (XMARKER (p->mark)->buffer) SET_PT (marker_position (p->mark)); else SET_PT (ZV); if (point <= opoint) opoint += XSTRING (msg)->size + XSTRING (p->name)->size + 10; tem = current_buffer->read_only; current_buffer->read_only = Qnil; insert_string ("\nProcess "); Finsert (1, &p->name); insert_string (" "); Finsert (1, &msg); current_buffer->read_only = tem; Fset_marker (p->mark, make_number (point), p->buffer); SET_PT (opoint); set_buffer_internal (old); } } } /* end for */ update_mode_lines++; /* in case buffers use %s in mode-line-format */ redisplay_preserve_echo_area (); UNGCPRO; } /* The first time this is called, assume keyboard input comes from DESC instead of from where we used to expect it. Subsequent calls mean assume input keyboard can come from DESC in addition to other places. */ static int add_keyboard_wait_descriptor_called_flag; void add_keyboard_wait_descriptor (desc) int desc; { if (! add_keyboard_wait_descriptor_called_flag) FD_CLR (0, &input_wait_mask); add_keyboard_wait_descriptor_called_flag = 1; FD_SET (desc, &input_wait_mask); if (desc > max_keyboard_desc) max_keyboard_desc = desc; } /* From now on, do not expect DESC to give keyboard input. */ void delete_keyboard_wait_descriptor (desc) int desc; { int fd; int lim = max_keyboard_desc; FD_CLR (desc, &input_wait_mask); if (desc == max_keyboard_desc) for (fd = 0; fd < lim; fd++) if (FD_ISSET (fd, &input_wait_mask) && !FD_ISSET (fd, &non_keyboard_wait_mask)) max_keyboard_desc = fd; } /* Return nonzero if *MASK has a bit set that corresponds to one of the keyboard input descriptors. */ int keyboard_bit_set (mask) SELECT_TYPE *mask; { int fd; for (fd = 0; fd <= max_keyboard_desc; fd++) if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask) && !FD_ISSET (fd, &non_keyboard_wait_mask)) return 1; return 0; } init_process () { register int i; #ifdef SIGCHLD #ifndef CANNOT_DUMP if (! noninteractive || initialized) #endif signal (SIGCHLD, sigchld_handler); #endif FD_ZERO (&input_wait_mask); FD_ZERO (&non_keyboard_wait_mask); max_process_desc = 0; FD_SET (0, &input_wait_mask); Vprocess_alist = Qnil; for (i = 0; i < MAXDESC; i++) { chan_process[i] = Qnil; proc_buffered_char[i] = -1; } } syms_of_process () { #ifdef HAVE_SOCKETS stream_process = intern ("stream"); #endif Qprocessp = intern ("processp"); staticpro (&Qprocessp); Qrun = intern ("run"); staticpro (&Qrun); Qstop = intern ("stop"); staticpro (&Qstop); Qsignal = intern ("signal"); staticpro (&Qsignal); /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it here again. Qexit = intern ("exit"); staticpro (&Qexit); */ Qopen = intern ("open"); staticpro (&Qopen); Qclosed = intern ("closed"); staticpro (&Qclosed); Qlast_nonmenu_event = intern ("last-nonmenu-event"); staticpro (&Qlast_nonmenu_event); staticpro (&Vprocess_alist); DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes, "*Non-nil means delete processes immediately when they exit.\n\ nil means don't delete them until `list-processes' is run."); delete_exited_processes = 1; DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type, "Control type of device used to communicate with subprocesses.\n\ Values are nil to use a pipe, or t or `pty' to use a pty.\n\ The value has no effect if the system has no ptys or if all ptys are busy:\n\ then a pipe is used in any case.\n\ The value takes effect when `start-process' is called."); Vprocess_connection_type = Qt; defsubr (&Sprocessp); defsubr (&Sget_process); defsubr (&Sget_buffer_process); defsubr (&Sdelete_process); defsubr (&Sprocess_status); defsubr (&Sprocess_exit_status); defsubr (&Sprocess_id); defsubr (&Sprocess_name); defsubr (&Sprocess_tty_name); defsubr (&Sprocess_command); defsubr (&Sset_process_buffer); defsubr (&Sprocess_buffer); defsubr (&Sprocess_mark); defsubr (&Sset_process_filter); defsubr (&Sprocess_filter); defsubr (&Sset_process_sentinel); defsubr (&Sset_process_window_size); defsubr (&Sprocess_sentinel); defsubr (&Sprocess_kill_without_query); defsubr (&Slist_processes); defsubr (&Sprocess_list); defsubr (&Sstart_process); #ifdef HAVE_SOCKETS defsubr (&Sopen_network_stream); #endif /* HAVE_SOCKETS */ defsubr (&Saccept_process_output); defsubr (&Sprocess_send_region); defsubr (&Sprocess_send_string); defsubr (&Sinterrupt_process); defsubr (&Skill_process); defsubr (&Squit_process); defsubr (&Sstop_process); defsubr (&Scontinue_process); defsubr (&Sprocess_send_eof); defsubr (&Ssignal_process); defsubr (&Swaiting_for_user_input_p); /* defsubr (&Sprocess_connection); */ } #else /* not subprocesses */ #include #include #include "lisp.h" #include "systime.h" #include "termopts.h" #include "sysselect.h" extern int frame_garbaged; /* As described above, except assuming that there are no subprocesses: Wait for timeout to elapse and/or keyboard input to be available. time_limit is: timeout in seconds, or zero for no limit, or -1 means gobble data immediately available but don't wait for any. read_kbd is a Lisp_Object: 0 to ignore keyboard input, or 1 to return when input is available, or -1 means caller will actually read the input, so don't throw to the quit handler. We know that read_kbd will never be a Lisp_Process, since `subprocesses' isn't defined. do_display != 0 means redisplay should be done to show subprocess output that arrives. Return true iff we received input from any process. */ int wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) int time_limit, microsecs; Lisp_Object read_kbd; int do_display; { EMACS_TIME end_time, timeout, *timeout_p; int waitchannels; /* What does time_limit really mean? */ if (time_limit || microsecs) { /* It's not infinite. */ timeout_p = &timeout; if (time_limit == -1) /* In fact, it's zero. */ EMACS_SET_SECS_USECS (timeout, 0, 0); else EMACS_SET_SECS_USECS (timeout, time_limit, microsecs); /* How far in the future is that? */ EMACS_GET_TIME (end_time); EMACS_ADD_TIME (end_time, end_time, timeout); } else /* It's infinite. */ timeout_p = 0; /* Turn off periodic alarms (in case they are in use) because the select emulator uses alarms. */ stop_polling (); for (;;) { int nfds; waitchannels = XINT (read_kbd) ? 1 : 0; /* If calling from keyboard input, do not quit since we want to return C-g as an input character. Otherwise, do pending quit if requested. */ if (XINT (read_kbd) >= 0) QUIT; if (timeout_p) { EMACS_GET_TIME (*timeout_p); EMACS_SUB_TIME (*timeout_p, end_time, *timeout_p); if (EMACS_TIME_NEG_P (*timeout_p)) break; } /* Cause C-g and alarm signals to take immediate action, and cause input available signals to zero out timeout. */ if (XINT (read_kbd) < 0) set_waiting_for_input (&timeout); /* If a frame has been newly mapped and needs updating, reprocess its display stuff. */ if (frame_garbaged && do_display) redisplay_preserve_echo_area (); if (XINT (read_kbd) && detect_input_pending ()) nfds = 0; else nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0, timeout_p); /* Make C-g and alarm signals set flags again */ clear_waiting_for_input (); /* If we woke up due to SIGWINCH, actually change size now. */ do_pending_window_change (); if (nfds == -1) { /* If the system call was interrupted, then go around the loop again. */ if (errno == EINTR) waitchannels = 0; } #ifdef sun else if (nfds > 0 && (waitchannels & 1) && interrupt_input) /* System sometimes fails to deliver SIGIO. */ kill (getpid (), SIGIO); #endif #ifdef SIGIO if (XINT (read_kbd) && interrupt_input && (waitchannels & 1)) kill (0, SIGIO); #endif /* If we have timed out (nfds == 0) or found some input (nfds > 0), we should exit. */ if (nfds >= 0) break; } start_polling (); return 0; } DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (name) register Lisp_Object name; { return Qnil; } /* Kill all processes associated with `buffer'. If `buffer' is nil, kill all processes. Since we have no subprocesses, this does nothing. */ kill_buffer_processes (buffer) Lisp_Object buffer; { } init_process () { } syms_of_process () { defsubr (&Sget_buffer_process); } #endif /* not subprocesses */ emacs-19.30/src/ralloc.c100444 12120 1 75012 5735151203 13335 0ustar rmsdaemon/* Block-relocating memory allocator. Copyright (C) 1993, 1995 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. */ /* NOTES: Only relocate the blocs necessary for SIZE in r_alloc_sbrk, rather than all of them. This means allowing for a possible hole between the first bloc and the end of malloc storage. */ #ifdef emacs #include #include "lisp.h" /* Needed for VALBITS. */ #undef NULL /* The important properties of this type are that 1) it's a pointer, and 2) arithmetic on it should work as if the size of the object pointed to has a size of 1. */ #if 0 /* Arithmetic on void* is a GCC extension. */ #ifdef __STDC__ typedef void *POINTER; #else #ifdef HAVE_CONFIG_H #include "config.h" #endif typedef char *POINTER; #endif #endif /* 0 */ /* Unconditionally use char * for this. */ typedef char *POINTER; typedef unsigned long SIZE; /* Declared in dispnew.c, this version doesn't screw up if regions overlap. */ extern void safe_bcopy (); extern int __malloc_extra_blocks; #else /* not emacs */ #include typedef size_t SIZE; typedef void *POINTER; #include #include #include #define safe_bcopy(x, y, z) memmove (y, x, z) #define bzero(x, len) memset (x, 0, len) #endif /* not emacs */ #include "getpagesize.h" #define NIL ((POINTER) 0) /* A flag to indicate whether we have initialized ralloc yet. For Emacs's sake, please do not make this local to malloc_init; on some machines, the dumping procedure makes all static variables read-only. On these machines, the word static is #defined to be the empty string, meaning that r_alloc_initialized becomes an automatic variable, and loses its value each time Emacs is started up. */ static int r_alloc_initialized = 0; static void r_alloc_init (); /* Declarations for working with the malloc, ralloc, and system breaks. */ /* Function to set the real break value. */ static POINTER (*real_morecore) (); /* The break value, as seen by malloc. */ static POINTER virtual_break_value; /* The address of the end of the last data in use by ralloc, including relocatable blocs as well as malloc data. */ static POINTER break_value; /* This is the size of a page. We round memory requests to this boundary. */ static int page_size; /* Whenever we get memory from the system, get this many extra bytes. This must be a multiple of page_size. */ static int extra_bytes; /* Macros for rounding. Note that rounding to any value is possible by changing the definition of PAGE. */ #define PAGE (getpagesize ()) #define ALIGNED(addr) (((unsigned long int) (addr) & (page_size - 1)) == 0) #define ROUNDUP(size) (((unsigned long int) (size) + page_size - 1) \ & ~(page_size - 1)) #define ROUND_TO_PAGE(addr) (addr & (~(page_size - 1))) #define MEM_ALIGN sizeof(double) #define MEM_ROUNDUP(addr) (((unsigned long int)(addr) + MEM_ALIGN - 1) \ & ~(MEM_ALIGN - 1)) /* Data structures of heaps and blocs. */ /* The relocatable objects, or blocs, and the malloc data both reside within one or more heaps. Each heap contains malloc data, running from `start' to `bloc_start', and relocatable objects, running from `bloc_start' to `free'. Relocatable objects may relocate within the same heap or may move into another heap; the heaps themselves may grow but they never move. We try to make just one heap and make it larger as necessary. But sometimes we can't do that, because we can't get continguous space to add onto the heap. When that happens, we start a new heap. */ typedef struct heap { struct heap *next; struct heap *prev; /* Start of memory range of this heap. */ POINTER start; /* End of memory range of this heap. */ POINTER end; /* Start of relocatable data in this heap. */ POINTER bloc_start; /* Start of unused space in this heap. */ POINTER free; /* First bloc in this heap. */ struct bp *first_bloc; /* Last bloc in this heap. */ struct bp *last_bloc; } *heap_ptr; #define NIL_HEAP ((heap_ptr) 0) #define HEAP_PTR_SIZE (sizeof (struct heap)) /* This is the first heap object. If we need additional heap objects, each one resides at the beginning of the space it covers. */ static struct heap heap_base; /* Head and tail of the list of heaps. */ static heap_ptr first_heap, last_heap; /* These structures are allocated in the malloc arena. The linked list is kept in order of increasing '.data' members. The data blocks abut each other; if b->next is non-nil, then b->data + b->size == b->next->data. An element with variable==NIL denotes a freed block, which has not yet been collected. They may only appear while r_alloc_freeze > 0, and will be freed when the arena is thawed. Currently, these blocs are not reusable, while the arena is frozen. Very inefficent. */ typedef struct bp { struct bp *next; struct bp *prev; POINTER *variable; POINTER data; SIZE size; POINTER new_data; /* tmporarily used for relocation */ struct heap *heap; /* Heap this bloc is in. */ } *bloc_ptr; #define NIL_BLOC ((bloc_ptr) 0) #define BLOC_PTR_SIZE (sizeof (struct bp)) /* Head and tail of the list of relocatable blocs. */ static bloc_ptr first_bloc, last_bloc; static int use_relocatable_buffers; /* If >0, no relocation whatsoever takes place. */ static int r_alloc_freeze_level; /* Functions to get and return memory from the system. */ /* Find the heap that ADDRESS falls within. */ static heap_ptr find_heap (address) POINTER address; { heap_ptr heap; for (heap = last_heap; heap; heap = heap->prev) { if (heap->start <= address && address <= heap->end) return heap; } return NIL_HEAP; } /* Find SIZE bytes of space in a heap. Try to get them at ADDRESS (which must fall within some heap's range) if we can get that many within one heap. If enough space is not presently available in our reserve, this means getting more page-aligned space from the system. If the retuned space is not contiguos to the last heap, allocate a new heap, and append it obtain does not try to keep track of whether space is in use or not in use. It just returns the address of SIZE bytes that fall within a single heap. If you call obtain twice in a row with the same arguments, you typically get the same value. to the heap list. It's the caller's responsibility to keep track of what space is in use. Return the address of the space if all went well, or zero if we couldn't allocate the memory. */ static POINTER obtain (address, size) POINTER address; SIZE size; { heap_ptr heap; SIZE already_available; /* Find the heap that ADDRESS falls within. */ for (heap = last_heap; heap; heap = heap->prev) { if (heap->start <= address && address <= heap->end) break; } if (! heap) abort (); /* If we can't fit SIZE bytes in that heap, try successive later heaps. */ while (heap && address + size > heap->end) { heap = heap->next; if (heap == NIL_HEAP) break; address = heap->bloc_start; } /* If we can't fit them within any existing heap, get more space. */ if (heap == NIL_HEAP) { POINTER new = (*real_morecore)(0); SIZE get; already_available = (char *)last_heap->end - (char *)address; if (new != last_heap->end) { /* Someone else called sbrk. Make a new heap. */ heap_ptr new_heap = (heap_ptr) MEM_ROUNDUP (new); POINTER bloc_start = (POINTER) MEM_ROUNDUP ((POINTER)(new_heap + 1)); if ((*real_morecore) (bloc_start - new) != new) return 0; new_heap->start = new; new_heap->end = bloc_start; new_heap->bloc_start = bloc_start; new_heap->free = bloc_start; new_heap->next = NIL_HEAP; new_heap->prev = last_heap; new_heap->first_bloc = NIL_BLOC; new_heap->last_bloc = NIL_BLOC; last_heap->next = new_heap; last_heap = new_heap; address = bloc_start; already_available = 0; } /* Add space to the last heap (which we may have just created). Get some extra, so we can come here less often. */ get = size + extra_bytes - already_available; get = (char *) ROUNDUP ((char *)last_heap->end + get) - (char *) last_heap->end; if ((*real_morecore) (get) != last_heap->end) return 0; last_heap->end += get; } return address; } /* Return unused heap space to the system if there is a lot of unused space now. This can make the last heap smaller; it can also eliminate the last heap entirely. */ static void relinquish () { register heap_ptr h; int excess = 0; /* Add the amount of space beyond break_value in all heaps which have extend beyond break_value at all. */ for (h = last_heap; h && break_value < h->end; h = h->prev) { excess += (char *) h->end - (char *) ((break_value < h->bloc_start) ? h->bloc_start : break_value); } if (excess > extra_bytes * 2 && (*real_morecore) (0) == last_heap->end) { /* Keep extra_bytes worth of empty space. And don't free anything unless we can free at least extra_bytes. */ excess -= extra_bytes; if ((char *)last_heap->end - (char *)last_heap->bloc_start <= excess) { /* This heap should have no blocs in it. */ if (last_heap->first_bloc != NIL_BLOC || last_heap->last_bloc != NIL_BLOC) abort (); /* Return the last heap, with its header, to the system. */ excess = (char *)last_heap->end - (char *)last_heap->start; last_heap = last_heap->prev; last_heap->next = NIL_HEAP; } else { excess = (char *) last_heap->end - (char *) ROUNDUP ((char *)last_heap->end - excess); last_heap->end -= excess; } if ((*real_morecore) (- excess) == 0) abort (); } } /* Return the total size in use by relocating allocator, above where malloc gets space. */ long r_alloc_size_in_use () { return break_value - virtual_break_value; } /* The meat - allocating, freeing, and relocating blocs. */ /* Find the bloc referenced by the address in PTR. Returns a pointer to that block. */ static bloc_ptr find_bloc (ptr) POINTER *ptr; { register bloc_ptr p = first_bloc; while (p != NIL_BLOC) { if (p->variable == ptr && p->data == *ptr) return p; p = p->next; } return p; } /* Allocate a bloc of SIZE bytes and append it to the chain of blocs. Returns a pointer to the new bloc, or zero if we couldn't allocate memory for the new block. */ static bloc_ptr get_bloc (size) SIZE size; { register bloc_ptr new_bloc; register heap_ptr heap; if (! (new_bloc = (bloc_ptr) malloc (BLOC_PTR_SIZE)) || ! (new_bloc->data = obtain (break_value, size))) { if (new_bloc) free (new_bloc); return 0; } break_value = new_bloc->data + size; new_bloc->size = size; new_bloc->next = NIL_BLOC; new_bloc->variable = (POINTER *) NIL; new_bloc->new_data = 0; /* Record in the heap that this space is in use. */ heap = find_heap (new_bloc->data); heap->free = break_value; /* Maintain the correspondence between heaps and blocs. */ new_bloc->heap = heap; heap->last_bloc = new_bloc; if (heap->first_bloc == NIL_BLOC) heap->first_bloc = new_bloc; /* Put this bloc on the doubly-linked list of blocs. */ if (first_bloc) { new_bloc->prev = last_bloc; last_bloc->next = new_bloc; last_bloc = new_bloc; } else { first_bloc = last_bloc = new_bloc; new_bloc->prev = NIL_BLOC; } return new_bloc; } /* Calculate new locations of blocs in the list beginning with BLOC, relocating it to start at ADDRESS, in heap HEAP. If enough space is not presently available in our reserve, call obtain for more space. Store the new location of each bloc in its new_data field. Do not touch the contents of blocs or break_value. */ static int relocate_blocs (bloc, heap, address) bloc_ptr bloc; heap_ptr heap; POINTER address; { register bloc_ptr b = bloc; /* No need to ever call this if arena is frozen, bug somewhere! */ if (r_alloc_freeze_level) abort(); while (b) { /* If bloc B won't fit within HEAP, move to the next heap and try again. */ while (heap && address + b->size > heap->end) { heap = heap->next; if (heap == NIL_HEAP) break; address = heap->bloc_start; } /* If BLOC won't fit in any heap, get enough new space to hold BLOC and all following blocs. */ if (heap == NIL_HEAP) { register bloc_ptr tb = b; register SIZE s = 0; /* Add up the size of all the following blocs. */ while (tb != NIL_BLOC) { if (tb->variable) s += tb->size; tb = tb->next; } /* Get that space. */ address = obtain (address, s); if (address == 0) return 0; heap = last_heap; } /* Record the new address of this bloc and update where the next bloc can start. */ b->new_data = address; if (b->variable) address += b->size; b = b->next; } return 1; } /* Reorder the bloc BLOC to go before bloc BEFORE in the doubly linked list. This is necessary if we put the memory of space of BLOC before that of BEFORE. */ static void reorder_bloc (bloc, before) bloc_ptr bloc, before; { bloc_ptr prev, next; /* Splice BLOC out from where it is. */ prev = bloc->prev; next = bloc->next; if (prev) prev->next = next; if (next) next->prev = prev; /* Splice it in before BEFORE. */ prev = before->prev; if (prev) prev->next = bloc; bloc->prev = prev; before->prev = bloc; bloc->next = before; } /* Update the records of which heaps contain which blocs, starting with heap HEAP and bloc BLOC. */ static void update_heap_bloc_correspondence (bloc, heap) bloc_ptr bloc; heap_ptr heap; { register bloc_ptr b; /* Initialize HEAP's status to reflect blocs before BLOC. */ if (bloc != NIL_BLOC && bloc->prev != NIL_BLOC && bloc->prev->heap == heap) { /* The previous bloc is in HEAP. */ heap->last_bloc = bloc->prev; heap->free = bloc->prev->data + bloc->prev->size; } else { /* HEAP contains no blocs before BLOC. */ heap->first_bloc = NIL_BLOC; heap->last_bloc = NIL_BLOC; heap->free = heap->bloc_start; } /* Advance through blocs one by one. */ for (b = bloc; b != NIL_BLOC; b = b->next) { /* Advance through heaps, marking them empty, till we get to the one that B is in. */ while (heap) { if (heap->bloc_start <= b->data && b->data <= heap->end) break; heap = heap->next; /* We know HEAP is not null now, because there has to be space for bloc B. */ heap->first_bloc = NIL_BLOC; heap->last_bloc = NIL_BLOC; heap->free = heap->bloc_start; } /* Update HEAP's status for bloc B. */ heap->free = b->data + b->size; heap->last_bloc = b; if (heap->first_bloc == NIL_BLOC) heap->first_bloc = b; /* Record that B is in HEAP. */ b->heap = heap; } /* If there are any remaining heaps and no blocs left, mark those heaps as empty. */ heap = heap->next; while (heap) { heap->first_bloc = NIL_BLOC; heap->last_bloc = NIL_BLOC; heap->free = heap->bloc_start; heap = heap->next; } } /* Resize BLOC to SIZE bytes. This relocates the blocs that come after BLOC in memory. */ static int resize_bloc (bloc, size) bloc_ptr bloc; SIZE size; { register bloc_ptr b; heap_ptr heap; POINTER address; SIZE old_size; /* No need to ever call this if arena is frozen, bug somewhere! */ if (r_alloc_freeze_level) abort(); if (bloc == NIL_BLOC || size == bloc->size) return 1; for (heap = first_heap; heap != NIL_HEAP; heap = heap->next) { if (heap->bloc_start <= bloc->data && bloc->data <= heap->end) break; } if (heap == NIL_HEAP) abort (); old_size = bloc->size; bloc->size = size; /* Note that bloc could be moved into the previous heap. */ address = (bloc->prev ? bloc->prev->data + bloc->prev->size : first_heap->bloc_start); while (heap) { if (heap->bloc_start <= address && address <= heap->end) break; heap = heap->prev; } if (! relocate_blocs (bloc, heap, address)) { bloc->size = old_size; return 0; } if (size > old_size) { for (b = last_bloc; b != bloc; b = b->prev) { if (!b->variable) { b->size = 0; b->data = b->new_data; } else { safe_bcopy (b->data, b->new_data, b->size); *b->variable = b->data = b->new_data; } } if (!bloc->variable) { bloc->size = 0; bloc->data = bloc->new_data; } else { safe_bcopy (bloc->data, bloc->new_data, old_size); bzero (bloc->new_data + old_size, size - old_size); *bloc->variable = bloc->data = bloc->new_data; } } else { for (b = bloc; b != NIL_BLOC; b = b->next) { if (!b->variable) { b->size = 0; b->data = b->new_data; } else { safe_bcopy (b->data, b->new_data, b->size); *b->variable = b->data = b->new_data; } } } update_heap_bloc_correspondence (bloc, heap); break_value = (last_bloc ? last_bloc->data + last_bloc->size : first_heap->bloc_start); return 1; } /* Free BLOC from the chain of blocs, relocating any blocs above it. This may return space to the system. */ static void free_bloc (bloc) bloc_ptr bloc; { heap_ptr heap = bloc->heap; if (r_alloc_freeze_level) { bloc->variable = (POINTER *) NIL; return; } resize_bloc (bloc, 0); if (bloc == first_bloc && bloc == last_bloc) { first_bloc = last_bloc = NIL_BLOC; } else if (bloc == last_bloc) { last_bloc = bloc->prev; last_bloc->next = NIL_BLOC; } else if (bloc == first_bloc) { first_bloc = bloc->next; first_bloc->prev = NIL_BLOC; } else { bloc->next->prev = bloc->prev; bloc->prev->next = bloc->next; } /* Update the records of which blocs are in HEAP. */ if (heap->first_bloc == bloc) { if (bloc->next != 0 && bloc->next->heap == heap) heap->first_bloc = bloc->next; else heap->first_bloc = heap->last_bloc = NIL_BLOC; } if (heap->last_bloc == bloc) { if (bloc->prev != 0 && bloc->prev->heap == heap) heap->last_bloc = bloc->prev; else heap->first_bloc = heap->last_bloc = NIL_BLOC; } relinquish (); free (bloc); } /* Interface routines. */ /* Obtain SIZE bytes of storage from the free pool, or the system, as necessary. If relocatable blocs are in use, this means relocating them. This function gets plugged into the GNU malloc's __morecore hook. We provide hysteresis, never relocating by less than extra_bytes. If we're out of memory, we should return zero, to imitate the other __morecore hook values - in particular, __default_morecore in the GNU malloc package. */ POINTER r_alloc_sbrk (size) long size; { register bloc_ptr b; POINTER address; if (! r_alloc_initialized) r_alloc_init (); if (! use_relocatable_buffers) return (*real_morecore) (size); if (size == 0) return virtual_break_value; if (size > 0) { /* Allocate a page-aligned space. GNU malloc would reclaim an extra space if we passed an unaligned one. But we could not always find a space which is contiguos to the previous. */ POINTER new_bloc_start; heap_ptr h = first_heap; SIZE get = ROUNDUP (size); address = (POINTER) ROUNDUP (virtual_break_value); /* Search the list upward for a heap which is large enough. */ while ((char *) h->end < (char *) MEM_ROUNDUP ((char *)address + get)) { h = h->next; if (h == NIL_HEAP) break; address = (POINTER) ROUNDUP (h->start); } /* If not found, obtain more space. */ if (h == NIL_HEAP) { get += extra_bytes + page_size; if (! obtain (address, get)) return 0; if (first_heap == last_heap) address = (POINTER) ROUNDUP (virtual_break_value); else address = (POINTER) ROUNDUP (last_heap->start); h = last_heap; } new_bloc_start = (POINTER) MEM_ROUNDUP ((char *)address + get); if (first_heap->bloc_start < new_bloc_start) { /* This is no clean solution - no idea how to do it better. */ if (r_alloc_freeze_level) return NIL; /* There is a bug here: if the above obtain call succeeded, but the relocate_blocs call below does not succeed, we need to free the memory that we got with obtain. */ /* Move all blocs upward. */ if (! relocate_blocs (first_bloc, h, new_bloc_start)) return 0; /* Note that (POINTER)(h+1) <= new_bloc_start since get >= page_size, so the following does not destroy the heap header. */ for (b = last_bloc; b != NIL_BLOC; b = b->prev) { safe_bcopy (b->data, b->new_data, b->size); *b->variable = b->data = b->new_data; } h->bloc_start = new_bloc_start; update_heap_bloc_correspondence (first_bloc, h); } if (h != first_heap) { /* Give up managing heaps below the one the new virtual_break_value points to. */ first_heap->prev = NIL_HEAP; first_heap->next = h->next; first_heap->start = h->start; first_heap->end = h->end; first_heap->free = h->free; first_heap->first_bloc = h->first_bloc; first_heap->last_bloc = h->last_bloc; first_heap->bloc_start = h->bloc_start; if (first_heap->next) first_heap->next->prev = first_heap; else last_heap = first_heap; } bzero (address, size); } else /* size < 0 */ { SIZE excess = (char *)first_heap->bloc_start - ((char *)virtual_break_value + size); address = virtual_break_value; if (r_alloc_freeze_level == 0 && excess > 2 * extra_bytes) { excess -= extra_bytes; first_heap->bloc_start = (POINTER) MEM_ROUNDUP ((char *)first_heap->bloc_start - excess); relocate_blocs (first_bloc, first_heap, first_heap->bloc_start); for (b = first_bloc; b != NIL_BLOC; b = b->next) { safe_bcopy (b->data, b->new_data, b->size); *b->variable = b->data = b->new_data; } } if ((char *)virtual_break_value + size < (char *)first_heap->start) { /* We found an additional space below the first heap */ first_heap->start = (POINTER) ((char *)virtual_break_value + size); } } virtual_break_value = (POINTER) ((char *)address + size); break_value = (last_bloc ? last_bloc->data + last_bloc->size : first_heap->bloc_start); if (size < 0) relinquish (); return address; } /* Allocate a relocatable bloc of storage of size SIZE. A pointer to the data is returned in *PTR. PTR is thus the address of some variable which will use the data area. The allocation of 0 bytes is valid. In case r_alloc_freeze is set, a best fit of unused blocs could be done before allocating a new area. Not yet done. If we can't allocate the necessary memory, set *PTR to zero, and return zero. */ POINTER r_alloc (ptr, size) POINTER *ptr; SIZE size; { register bloc_ptr new_bloc; if (! r_alloc_initialized) r_alloc_init (); new_bloc = get_bloc (MEM_ROUNDUP (size)); if (new_bloc) { new_bloc->variable = ptr; *ptr = new_bloc->data; } else *ptr = 0; return *ptr; } /* Free a bloc of relocatable storage whose data is pointed to by PTR. Store 0 in *PTR to show there's no block allocated. */ void r_alloc_free (ptr) register POINTER *ptr; { register bloc_ptr dead_bloc; if (! r_alloc_initialized) r_alloc_init (); dead_bloc = find_bloc (ptr); if (dead_bloc == NIL_BLOC) abort (); free_bloc (dead_bloc); *ptr = 0; #ifdef emacs refill_memory_reserve (); #endif } /* Given a pointer at address PTR to relocatable data, resize it to SIZE. Do this by shifting all blocks above this one up in memory, unless SIZE is less than or equal to the current bloc size, in which case do nothing. In case r_alloc_freeze is set, a new bloc is allocated, and the memory copied to it. Not very efficent. We could traverse the bloc_list for a best fit of free blocs first. Change *PTR to reflect the new bloc, and return this value. If more memory cannot be allocated, then leave *PTR unchanged, and return zero. */ POINTER r_re_alloc (ptr, size) POINTER *ptr; SIZE size; { register bloc_ptr bloc; if (! r_alloc_initialized) r_alloc_init (); if (!*ptr) return r_alloc (ptr, size); if (!size) { r_alloc_free (ptr); return r_alloc (ptr, 0); } bloc = find_bloc (ptr); if (bloc == NIL_BLOC) abort (); if (size < bloc->size) { /* Wouldn't it be useful to actually resize the bloc here? */ /* I think so too, but not if it's too expensive... */ if ((bloc->size - MEM_ROUNDUP (size) >= page_size) && r_alloc_freeze_level == 0) { resize_bloc (bloc, MEM_ROUNDUP (size)); /* Never mind if this fails, just do nothing... */ /* It *should* be infallible! */ } } else if (size > bloc->size) { if (r_alloc_freeze_level) { bloc_ptr new_bloc; new_bloc = get_bloc (MEM_ROUNDUP (size)); if (new_bloc) { new_bloc->variable = ptr; *ptr = new_bloc->data; bloc->variable = (POINTER *) NIL; } else return NIL; } else { if (! resize_bloc (bloc, MEM_ROUNDUP (size))) return NIL; } } return *ptr; } /* Disable relocations, after making room for at least SIZE bytes of non-relocatable heap if possible. The relocatable blocs are guaranteed to hold still until thawed, even if this means that malloc must return a null pointer. */ void r_alloc_freeze (size) long size; { if (! r_alloc_initialized) r_alloc_init (); /* If already frozen, we can't make any more room, so don't try. */ if (r_alloc_freeze_level > 0) size = 0; /* If we can't get the amount requested, half is better than nothing. */ while (size > 0 && r_alloc_sbrk (size) == 0) size /= 2; ++r_alloc_freeze_level; if (size > 0) r_alloc_sbrk (-size); } void r_alloc_thaw () { if (! r_alloc_initialized) r_alloc_init (); if (--r_alloc_freeze_level < 0) abort (); /* This frees all unused blocs. It is not too inefficent, as the resize and bcopy is done only once. Afterwards, all unreferenced blocs are already shrunk to zero size. */ if (!r_alloc_freeze_level) { bloc_ptr *b = &first_bloc; while (*b) if (!(*b)->variable) free_bloc (*b); else b = &(*b)->next; } } /* The hook `malloc' uses for the function which gets more space from the system. */ extern POINTER (*__morecore) (); /* Initialize various things for memory allocation. */ static void r_alloc_init () { if (r_alloc_initialized) return; r_alloc_initialized = 1; real_morecore = __morecore; __morecore = r_alloc_sbrk; first_heap = last_heap = &heap_base; first_heap->next = first_heap->prev = NIL_HEAP; first_heap->start = first_heap->bloc_start = virtual_break_value = break_value = (*real_morecore) (0); if (break_value == NIL) abort (); page_size = PAGE; extra_bytes = ROUNDUP (50000); /* Give GNU malloc's morecore some hysteresis so that we move all the relocatable blocks much less often. */ __malloc_extra_blocks = 64; first_heap->end = (POINTER) ROUNDUP (first_heap->start); /* The extra call to real_morecore guarantees that the end of the address space is a multiple of page_size, even if page_size is not really the page size of the system running the binary in which page_size is stored. This allows a binary to be built on a system with one page size and run on a system with a smaller page size. */ (*real_morecore) (first_heap->end - first_heap->start); /* Clear the rest of the last page; this memory is in our address space even though it is after the sbrk value. */ /* Doubly true, with the additional call that explicitly adds the rest of that page to the address space. */ bzero (first_heap->start, first_heap->end - first_heap->start); virtual_break_value = break_value = first_heap->bloc_start = first_heap->end; use_relocatable_buffers = 1; } #ifdef DEBUG #include void r_alloc_check () { int found = 0; heap_ptr h, ph = 0; bloc_ptr b, pb = 0; if (!r_alloc_initialized) return; assert (first_heap); assert (last_heap->end <= (POINTER) sbrk (0)); assert ((POINTER) first_heap < first_heap->start); assert (first_heap->start <= virtual_break_value); assert (virtual_break_value <= first_heap->end); for (h = first_heap; h; h = h->next) { assert (h->prev == ph); assert ((POINTER) ROUNDUP (h->end) == h->end); assert ((POINTER) MEM_ROUNDUP (h->start) == h->start); assert ((POINTER) MEM_ROUNDUP (h->bloc_start) == h->bloc_start); assert (h->start <= h->bloc_start && h->bloc_start <= h->end); if (ph) { assert (ph->end < h->start); assert (h->start <= (POINTER)h && (POINTER)(h+1) <= h->bloc_start); } if (h->bloc_start <= break_value && break_value <= h->end) found = 1; ph = h; } assert (found); assert (last_heap == ph); for (b = first_bloc; b; b = b->next) { assert (b->prev == pb); assert ((POINTER) MEM_ROUNDUP (b->data) == b->data); assert ((SIZE) MEM_ROUNDUP (b->size) == b->size); ph = 0; for (h = first_heap; h; h = h->next) { if (h->bloc_start <= b->data && b->data + b->size <= h->end) break; ph = h; } assert (h); if (pb && pb->data + pb->size != b->data) { assert (ph && b->data == h->bloc_start); while (ph) { if (ph->bloc_start <= pb->data && pb->data + pb->size <= ph->end) { assert (pb->data + pb->size + b->size > ph->end); break; } else { assert (ph->bloc_start + b->size > ph->end); } ph = ph->prev; } } pb = b; } assert (last_bloc == pb); if (last_bloc) assert (last_bloc->data + last_bloc->size == break_value); else assert (first_heap->bloc_start == break_value); } #endif /* DEBUG */ emacs-19.30/src/regex.c100444 12241 1 527051 6052523446 13707 0ustar rolanddaemon/* Extended regular expression matching and search library, version 0.12. (Implements POSIX draft P10003.2/D11.2, except for internationalization features.) Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ /* AIX requires this to be the first thing in the file. */ #if defined (_AIX) && !defined (REGEX_MALLOC) #pragma alloca #endif #undef _GNU_SOURCE #define _GNU_SOURCE #ifdef HAVE_CONFIG_H #include #endif /* We need this for `regex.h', and perhaps for the Emacs include files. */ #include /* This is for other GNU distributions with internationalized messages. */ #if HAVE_LIBINTL_H || defined (_LIBC) # include #else # define gettext(msgid) (msgid) #endif #ifndef gettext_noop /* This define is so xgettext can find the internationalizable strings. */ #define gettext_noop(String) String #endif /* The `emacs' switch turns on certain matching commands that make sense only in Emacs. */ #ifdef emacs #include "lisp.h" #include "buffer.h" #include "syntax.h" #else /* not emacs */ /* If we are not linking with Emacs proper, we can't use the relocating allocator even if config.h says that we can. */ #undef REL_ALLOC #if defined (STDC_HEADERS) || defined (_LIBC) #include #else char *malloc (); char *realloc (); #endif /* When used in Emacs's lib-src, we need to get bzero and bcopy somehow. If nothing else has been done, use the method below. */ #ifdef INHIBIT_STRING_HEADER #if !(defined (HAVE_BZERO) && defined (HAVE_BCOPY)) #if !defined (bzero) && !defined (bcopy) #undef INHIBIT_STRING_HEADER #endif #endif #endif /* This is the normal way of making sure we have a bcopy and a bzero. This is used in most programs--a few other programs avoid this by defining INHIBIT_STRING_HEADER. */ #ifndef INHIBIT_STRING_HEADER #if defined (HAVE_STRING_H) || defined (STDC_HEADERS) || defined (_LIBC) #include #ifndef bcmp #define bcmp(s1, s2, n) memcmp ((s1), (s2), (n)) #endif #ifndef bcopy #define bcopy(s, d, n) memcpy ((d), (s), (n)) #endif #ifndef bzero #define bzero(s, n) memset ((s), 0, (n)) #endif #else #include #endif #endif /* Define the syntax stuff for \<, \>, etc. */ /* This must be nonzero for the wordchar and notwordchar pattern commands in re_match_2. */ #ifndef Sword #define Sword 1 #endif #ifdef SWITCH_ENUM_BUG #define SWITCH_ENUM_CAST(x) ((int)(x)) #else #define SWITCH_ENUM_CAST(x) (x) #endif #ifdef SYNTAX_TABLE extern char *re_syntax_table; #else /* not SYNTAX_TABLE */ /* How many characters in the character set. */ #define CHAR_SET_SIZE 256 static char re_syntax_table[CHAR_SET_SIZE]; static void init_syntax_once () { register int c; static int done = 0; if (done) return; bzero (re_syntax_table, sizeof re_syntax_table); for (c = 'a'; c <= 'z'; c++) re_syntax_table[c] = Sword; for (c = 'A'; c <= 'Z'; c++) re_syntax_table[c] = Sword; for (c = '0'; c <= '9'; c++) re_syntax_table[c] = Sword; re_syntax_table['_'] = Sword; done = 1; } #endif /* not SYNTAX_TABLE */ #define SYNTAX(c) re_syntax_table[c] #endif /* not emacs */ /* Get the interface, including the syntax bits. */ #include "regex.h" /* isalpha etc. are used for the character classes. */ #include /* Jim Meyering writes: "... Some ctype macros are valid only for character codes that isascii says are ASCII (SGI's IRIX-4.0.5 is one such system --when using /bin/cc or gcc but without giving an ansi option). So, all ctype uses should be through macros like ISPRINT... If STDC_HEADERS is defined, then autoconf has verified that the ctype macros don't need to be guarded with references to isascii. ... Defining isascii to 1 should let any compiler worth its salt eliminate the && through constant folding." */ #if defined (STDC_HEADERS) || (!defined (isascii) && !defined (HAVE_ISASCII)) #define ISASCII(c) 1 #else #define ISASCII(c) isascii(c) #endif #ifdef isblank #define ISBLANK(c) (ISASCII (c) && isblank (c)) #else #define ISBLANK(c) ((c) == ' ' || (c) == '\t') #endif #ifdef isgraph #define ISGRAPH(c) (ISASCII (c) && isgraph (c)) #else #define ISGRAPH(c) (ISASCII (c) && isprint (c) && !isspace (c)) #endif #define ISPRINT(c) (ISASCII (c) && isprint (c)) #define ISDIGIT(c) (ISASCII (c) && isdigit (c)) #define ISALNUM(c) (ISASCII (c) && isalnum (c)) #define ISALPHA(c) (ISASCII (c) && isalpha (c)) #define ISCNTRL(c) (ISASCII (c) && iscntrl (c)) #define ISLOWER(c) (ISASCII (c) && islower (c)) #define ISPUNCT(c) (ISASCII (c) && ispunct (c)) #define ISSPACE(c) (ISASCII (c) && isspace (c)) #define ISUPPER(c) (ISASCII (c) && isupper (c)) #define ISXDIGIT(c) (ISASCII (c) && isxdigit (c)) #ifndef NULL #define NULL (void *)0 #endif /* We remove any previous definition of `SIGN_EXTEND_CHAR', since ours (we hope) works properly with all combinations of machines, compilers, `char' and `unsigned char' argument types. (Per Bothner suggested the basic approach.) */ #undef SIGN_EXTEND_CHAR #if __STDC__ #define SIGN_EXTEND_CHAR(c) ((signed char) (c)) #else /* not __STDC__ */ /* As in Harbison and Steele. */ #define SIGN_EXTEND_CHAR(c) ((((unsigned char) (c)) ^ 128) - 128) #endif /* Should we use malloc or alloca? If REGEX_MALLOC is not defined, we use `alloca' instead of `malloc'. This is because using malloc in re_search* or re_match* could cause memory leaks when C-g is used in Emacs; also, malloc is slower and causes storage fragmentation. On the other hand, malloc is more portable, and easier to debug. Because we sometimes use alloca, some routines have to be macros, not functions -- `alloca'-allocated space disappears at the end of the function it is called in. */ #ifdef REGEX_MALLOC #define REGEX_ALLOCATE malloc #define REGEX_REALLOCATE(source, osize, nsize) realloc (source, nsize) #define REGEX_FREE free #else /* not REGEX_MALLOC */ /* Emacs already defines alloca, sometimes. */ #ifndef alloca /* Make alloca work the best possible way. */ #ifdef __GNUC__ #define alloca __builtin_alloca #else /* not __GNUC__ */ #if HAVE_ALLOCA_H #include #else /* not __GNUC__ or HAVE_ALLOCA_H */ #if 0 /* It is a bad idea to declare alloca. We always cast the result. */ #ifndef _AIX /* Already did AIX, up at the top. */ char *alloca (); #endif /* not _AIX */ #endif #endif /* not HAVE_ALLOCA_H */ #endif /* not __GNUC__ */ #endif /* not alloca */ #define REGEX_ALLOCATE alloca /* Assumes a `char *destination' variable. */ #define REGEX_REALLOCATE(source, osize, nsize) \ (destination = (char *) alloca (nsize), \ bcopy (source, destination, osize), \ destination) /* No need to do anything to free, after alloca. */ #define REGEX_FREE(arg) ((void)0) /* Do nothing! But inhibit gcc warning. */ #endif /* not REGEX_MALLOC */ /* Define how to allocate the failure stack. */ #if defined (REL_ALLOC) && defined (REGEX_MALLOC) #define REGEX_ALLOCATE_STACK(size) \ r_alloc (&failure_stack_ptr, (size)) #define REGEX_REALLOCATE_STACK(source, osize, nsize) \ r_re_alloc (&failure_stack_ptr, (nsize)) #define REGEX_FREE_STACK(ptr) \ r_alloc_free (&failure_stack_ptr) #else /* not using relocating allocator */ #ifdef REGEX_MALLOC #define REGEX_ALLOCATE_STACK malloc #define REGEX_REALLOCATE_STACK(source, osize, nsize) realloc (source, nsize) #define REGEX_FREE_STACK free #else /* not REGEX_MALLOC */ #define REGEX_ALLOCATE_STACK alloca #define REGEX_REALLOCATE_STACK(source, osize, nsize) \ REGEX_REALLOCATE (source, osize, nsize) /* No need to explicitly free anything. */ #define REGEX_FREE_STACK(arg) #endif /* not REGEX_MALLOC */ #endif /* not using relocating allocator */ /* True if `size1' is non-NULL and PTR is pointing anywhere inside `string1' or just past its end. This works if PTR is NULL, which is a good thing. */ #define FIRST_STRING_P(ptr) \ (size1 && string1 <= (ptr) && (ptr) <= string1 + size1) /* (Re)Allocate N items of type T using malloc, or fail. */ #define TALLOC(n, t) ((t *) malloc ((n) * sizeof (t))) #define RETALLOC(addr, n, t) ((addr) = (t *) realloc (addr, (n) * sizeof (t))) #define RETALLOC_IF(addr, n, t) \ if (addr) RETALLOC((addr), (n), t); else (addr) = TALLOC ((n), t) #define REGEX_TALLOC(n, t) ((t *) REGEX_ALLOCATE ((n) * sizeof (t))) #define BYTEWIDTH 8 /* In bits. */ #define STREQ(s1, s2) ((strcmp (s1, s2) == 0)) #undef MAX #undef MIN #define MAX(a, b) ((a) > (b) ? (a) : (b)) #define MIN(a, b) ((a) < (b) ? (a) : (b)) typedef char boolean; #define false 0 #define true 1 static int re_match_2_internal (); /* These are the command codes that appear in compiled regular expressions. Some opcodes are followed by argument bytes. A command code can specify any interpretation whatsoever for its arguments. Zero bytes may appear in the compiled regular expression. */ typedef enum { no_op = 0, /* Succeed right away--no more backtracking. */ succeed, /* Followed by one byte giving n, then by n literal bytes. */ exactn, /* Matches any (more or less) character. */ anychar, /* Matches any one char belonging to specified set. First following byte is number of bitmap bytes. Then come bytes for a bitmap saying which chars are in. Bits in each byte are ordered low-bit-first. A character is in the set if its bit is 1. A character too large to have a bit in the map is automatically not in the set. */ charset, /* Same parameters as charset, but match any character that is not one of those specified. */ charset_not, /* Start remembering the text that is matched, for storing in a register. Followed by one byte with the register number, in the range 0 to one less than the pattern buffer's re_nsub field. Then followed by one byte with the number of groups inner to this one. (This last has to be part of the start_memory only because we need it in the on_failure_jump of re_match_2.) */ start_memory, /* Stop remembering the text that is matched and store it in a memory register. Followed by one byte with the register number, in the range 0 to one less than `re_nsub' in the pattern buffer, and one byte with the number of inner groups, just like `start_memory'. (We need the number of inner groups here because we don't have any easy way of finding the corresponding start_memory when we're at a stop_memory.) */ stop_memory, /* Match a duplicate of something remembered. Followed by one byte containing the register number. */ duplicate, /* Fail unless at beginning of line. */ begline, /* Fail unless at end of line. */ endline, /* Succeeds if at beginning of buffer (if emacs) or at beginning of string to be matched (if not). */ begbuf, /* Analogously, for end of buffer/string. */ endbuf, /* Followed by two byte relative address to which to jump. */ jump, /* Same as jump, but marks the end of an alternative. */ jump_past_alt, /* Followed by two-byte relative address of place to resume at in case of failure. */ on_failure_jump, /* Like on_failure_jump, but pushes a placeholder instead of the current string position when executed. */ on_failure_keep_string_jump, /* Throw away latest failure point and then jump to following two-byte relative address. */ pop_failure_jump, /* Change to pop_failure_jump if know won't have to backtrack to match; otherwise change to jump. This is used to jump back to the beginning of a repeat. If what follows this jump clearly won't match what the repeat does, such that we can be sure that there is no use backtracking out of repetitions already matched, then we change it to a pop_failure_jump. Followed by two-byte address. */ maybe_pop_jump, /* Jump to following two-byte address, and push a dummy failure point. This failure point will be thrown away if an attempt is made to use it for a failure. A `+' construct makes this before the first repeat. Also used as an intermediary kind of jump when compiling an alternative. */ dummy_failure_jump, /* Push a dummy failure point and continue. Used at the end of alternatives. */ push_dummy_failure, /* Followed by two-byte relative address and two-byte number n. After matching N times, jump to the address upon failure. */ succeed_n, /* Followed by two-byte relative address, and two-byte number n. Jump to the address N times, then fail. */ jump_n, /* Set the following two-byte relative address to the subsequent two-byte number. The address *includes* the two bytes of number. */ set_number_at, wordchar, /* Matches any word-constituent character. */ notwordchar, /* Matches any char that is not a word-constituent. */ wordbeg, /* Succeeds if at word beginning. */ wordend, /* Succeeds if at word end. */ wordbound, /* Succeeds if at a word boundary. */ notwordbound /* Succeeds if not at a word boundary. */ #ifdef emacs ,before_dot, /* Succeeds if before point. */ at_dot, /* Succeeds if at point. */ after_dot, /* Succeeds if after point. */ /* Matches any character whose syntax is specified. Followed by a byte which contains a syntax code, e.g., Sword. */ syntaxspec, /* Matches any character whose syntax is not that specified. */ notsyntaxspec #endif /* emacs */ } re_opcode_t; /* Common operations on the compiled pattern. */ /* Store NUMBER in two contiguous bytes starting at DESTINATION. */ #define STORE_NUMBER(destination, number) \ do { \ (destination)[0] = (number) & 0377; \ (destination)[1] = (number) >> 8; \ } while (0) /* Same as STORE_NUMBER, except increment DESTINATION to the byte after where the number is stored. Therefore, DESTINATION must be an lvalue. */ #define STORE_NUMBER_AND_INCR(destination, number) \ do { \ STORE_NUMBER (destination, number); \ (destination) += 2; \ } while (0) /* Put into DESTINATION a number stored in two contiguous bytes starting at SOURCE. */ #define EXTRACT_NUMBER(destination, source) \ do { \ (destination) = *(source) & 0377; \ (destination) += SIGN_EXTEND_CHAR (*((source) + 1)) << 8; \ } while (0) #ifdef DEBUG static void extract_number (dest, source) int *dest; unsigned char *source; { int temp = SIGN_EXTEND_CHAR (*(source + 1)); *dest = *source & 0377; *dest += temp << 8; } #ifndef EXTRACT_MACROS /* To debug the macros. */ #undef EXTRACT_NUMBER #define EXTRACT_NUMBER(dest, src) extract_number (&dest, src) #endif /* not EXTRACT_MACROS */ #endif /* DEBUG */ /* Same as EXTRACT_NUMBER, except increment SOURCE to after the number. SOURCE must be an lvalue. */ #define EXTRACT_NUMBER_AND_INCR(destination, source) \ do { \ EXTRACT_NUMBER (destination, source); \ (source) += 2; \ } while (0) #ifdef DEBUG static void extract_number_and_incr (destination, source) int *destination; unsigned char **source; { extract_number (destination, *source); *source += 2; } #ifndef EXTRACT_MACROS #undef EXTRACT_NUMBER_AND_INCR #define EXTRACT_NUMBER_AND_INCR(dest, src) \ extract_number_and_incr (&dest, &src) #endif /* not EXTRACT_MACROS */ #endif /* DEBUG */ /* If DEBUG is defined, Regex prints many voluminous messages about what it is doing (if the variable `debug' is nonzero). If linked with the main program in `iregex.c', you can enter patterns and strings interactively. And if linked with the main program in `main.c' and the other test files, you can run the already-written tests. */ #ifdef DEBUG /* We use standard I/O for debugging. */ #include /* It is useful to test things that ``must'' be true when debugging. */ #include static int debug = 0; #define DEBUG_STATEMENT(e) e #define DEBUG_PRINT1(x) if (debug) printf (x) #define DEBUG_PRINT2(x1, x2) if (debug) printf (x1, x2) #define DEBUG_PRINT3(x1, x2, x3) if (debug) printf (x1, x2, x3) #define DEBUG_PRINT4(x1, x2, x3, x4) if (debug) printf (x1, x2, x3, x4) #define DEBUG_PRINT_COMPILED_PATTERN(p, s, e) \ if (debug) print_partial_compiled_pattern (s, e) #define DEBUG_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2) \ if (debug) print_double_string (w, s1, sz1, s2, sz2) /* Print the fastmap in human-readable form. */ void print_fastmap (fastmap) char *fastmap; { unsigned was_a_range = 0; unsigned i = 0; while (i < (1 << BYTEWIDTH)) { if (fastmap[i++]) { was_a_range = 0; putchar (i - 1); while (i < (1 << BYTEWIDTH) && fastmap[i]) { was_a_range = 1; i++; } if (was_a_range) { printf ("-"); putchar (i - 1); } } } putchar ('\n'); } /* Print a compiled pattern string in human-readable form, starting at the START pointer into it and ending just before the pointer END. */ void print_partial_compiled_pattern (start, end) unsigned char *start; unsigned char *end; { int mcnt, mcnt2; unsigned char *p = start; unsigned char *pend = end; if (start == NULL) { printf ("(null)\n"); return; } /* Loop over pattern commands. */ while (p < pend) { printf ("%d:\t", p - start); switch ((re_opcode_t) *p++) { case no_op: printf ("/no_op"); break; case exactn: mcnt = *p++; printf ("/exactn/%d", mcnt); do { putchar ('/'); putchar (*p++); } while (--mcnt); break; case start_memory: mcnt = *p++; printf ("/start_memory/%d/%d", mcnt, *p++); break; case stop_memory: mcnt = *p++; printf ("/stop_memory/%d/%d", mcnt, *p++); break; case duplicate: printf ("/duplicate/%d", *p++); break; case anychar: printf ("/anychar"); break; case charset: case charset_not: { register int c, last = -100; register int in_range = 0; printf ("/charset [%s", (re_opcode_t) *(p - 1) == charset_not ? "^" : ""); assert (p + *p < pend); for (c = 0; c < 256; c++) if (c / 8 < *p && (p[1 + (c/8)] & (1 << (c % 8)))) { /* Are we starting a range? */ if (last + 1 == c && ! in_range) { putchar ('-'); in_range = 1; } /* Have we broken a range? */ else if (last + 1 != c && in_range) { putchar (last); in_range = 0; } if (! in_range) putchar (c); last = c; } if (in_range) putchar (last); putchar (']'); p += 1 + *p; } break; case begline: printf ("/begline"); break; case endline: printf ("/endline"); break; case on_failure_jump: extract_number_and_incr (&mcnt, &p); printf ("/on_failure_jump to %d", p + mcnt - start); break; case on_failure_keep_string_jump: extract_number_and_incr (&mcnt, &p); printf ("/on_failure_keep_string_jump to %d", p + mcnt - start); break; case dummy_failure_jump: extract_number_and_incr (&mcnt, &p); printf ("/dummy_failure_jump to %d", p + mcnt - start); break; case push_dummy_failure: printf ("/push_dummy_failure"); break; case maybe_pop_jump: extract_number_and_incr (&mcnt, &p); printf ("/maybe_pop_jump to %d", p + mcnt - start); break; case pop_failure_jump: extract_number_and_incr (&mcnt, &p); printf ("/pop_failure_jump to %d", p + mcnt - start); break; case jump_past_alt: extract_number_and_incr (&mcnt, &p); printf ("/jump_past_alt to %d", p + mcnt - start); break; case jump: extract_number_and_incr (&mcnt, &p); printf ("/jump to %d", p + mcnt - start); break; case succeed_n: extract_number_and_incr (&mcnt, &p); extract_number_and_incr (&mcnt2, &p); printf ("/succeed_n to %d, %d times", p + mcnt - start, mcnt2); break; case jump_n: extract_number_and_incr (&mcnt, &p); extract_number_and_incr (&mcnt2, &p); printf ("/jump_n to %d, %d times", p + mcnt - start, mcnt2); break; case set_number_at: extract_number_and_incr (&mcnt, &p); extract_number_and_incr (&mcnt2, &p); printf ("/set_number_at location %d to %d", p + mcnt - start, mcnt2); break; case wordbound: printf ("/wordbound"); break; case notwordbound: printf ("/notwordbound"); break; case wordbeg: printf ("/wordbeg"); break; case wordend: printf ("/wordend"); #ifdef emacs case before_dot: printf ("/before_dot"); break; case at_dot: printf ("/at_dot"); break; case after_dot: printf ("/after_dot"); break; case syntaxspec: printf ("/syntaxspec"); mcnt = *p++; printf ("/%d", mcnt); break; case notsyntaxspec: printf ("/notsyntaxspec"); mcnt = *p++; printf ("/%d", mcnt); break; #endif /* emacs */ case wordchar: printf ("/wordchar"); break; case notwordchar: printf ("/notwordchar"); break; case begbuf: printf ("/begbuf"); break; case endbuf: printf ("/endbuf"); break; default: printf ("?%d", *(p-1)); } putchar ('\n'); } printf ("%d:\tend of pattern.\n", p - start); } void print_compiled_pattern (bufp) struct re_pattern_buffer *bufp; { unsigned char *buffer = bufp->buffer; print_partial_compiled_pattern (buffer, buffer + bufp->used); printf ("%d bytes used/%d bytes allocated.\n", bufp->used, bufp->allocated); if (bufp->fastmap_accurate && bufp->fastmap) { printf ("fastmap: "); print_fastmap (bufp->fastmap); } printf ("re_nsub: %d\t", bufp->re_nsub); printf ("regs_alloc: %d\t", bufp->regs_allocated); printf ("can_be_null: %d\t", bufp->can_be_null); printf ("newline_anchor: %d\n", bufp->newline_anchor); printf ("no_sub: %d\t", bufp->no_sub); printf ("not_bol: %d\t", bufp->not_bol); printf ("not_eol: %d\t", bufp->not_eol); printf ("syntax: %d\n", bufp->syntax); /* Perhaps we should print the translate table? */ } void print_double_string (where, string1, size1, string2, size2) const char *where; const char *string1; const char *string2; int size1; int size2; { unsigned this_char; if (where == NULL) printf ("(null)"); else { if (FIRST_STRING_P (where)) { for (this_char = where - string1; this_char < size1; this_char++) putchar (string1[this_char]); where = string2; } for (this_char = where - string2; this_char < size2; this_char++) putchar (string2[this_char]); } } #else /* not DEBUG */ #undef assert #define assert(e) #define DEBUG_STATEMENT(e) #define DEBUG_PRINT1(x) #define DEBUG_PRINT2(x1, x2) #define DEBUG_PRINT3(x1, x2, x3) #define DEBUG_PRINT4(x1, x2, x3, x4) #define DEBUG_PRINT_COMPILED_PATTERN(p, s, e) #define DEBUG_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2) #endif /* not DEBUG */ /* Set by `re_set_syntax' to the current regexp syntax to recognize. Can also be assigned to arbitrarily: each pattern buffer stores its own syntax, so it can be changed between regex compilations. */ /* This has no initializer because initialized variables in Emacs become read-only after dumping. */ reg_syntax_t re_syntax_options; /* Specify the precise syntax of regexps for compilation. This provides for compatibility for various utilities which historically have different, incompatible syntaxes. The argument SYNTAX is a bit mask comprised of the various bits defined in regex.h. We return the old syntax. */ reg_syntax_t re_set_syntax (syntax) reg_syntax_t syntax; { reg_syntax_t ret = re_syntax_options; re_syntax_options = syntax; return ret; } /* This table gives an error message for each of the error codes listed in regex.h. Obviously the order here has to be same as there. POSIX doesn't require that we do anything for REG_NOERROR, but why not be nice? */ static const char *re_error_msgid[] = { gettext_noop ("Success"), /* REG_NOERROR */ gettext_noop ("No match"), /* REG_NOMATCH */ gettext_noop ("Invalid regular expression"), /* REG_BADPAT */ gettext_noop ("Invalid collation character"), /* REG_ECOLLATE */ gettext_noop ("Invalid character class name"), /* REG_ECTYPE */ gettext_noop ("Trailing backslash"), /* REG_EESCAPE */ gettext_noop ("Invalid back reference"), /* REG_ESUBREG */ gettext_noop ("Unmatched [ or [^"), /* REG_EBRACK */ gettext_noop ("Unmatched ( or \\("), /* REG_EPAREN */ gettext_noop ("Unmatched \\{"), /* REG_EBRACE */ gettext_noop ("Invalid content of \\{\\}"), /* REG_BADBR */ gettext_noop ("Invalid range end"), /* REG_ERANGE */ gettext_noop ("Memory exhausted"), /* REG_ESPACE */ gettext_noop ("Invalid preceding regular expression"), /* REG_BADRPT */ gettext_noop ("Premature end of regular expression"), /* REG_EEND */ gettext_noop ("Regular expression too big"), /* REG_ESIZE */ gettext_noop ("Unmatched ) or \\)"), /* REG_ERPAREN */ }; /* Avoiding alloca during matching, to placate r_alloc. */ /* Define MATCH_MAY_ALLOCATE unless we need to make sure that the searching and matching functions should not call alloca. On some systems, alloca is implemented in terms of malloc, and if we're using the relocating allocator routines, then malloc could cause a relocation, which might (if the strings being searched are in the ralloc heap) shift the data out from underneath the regexp routines. Here's another reason to avoid allocation: Emacs processes input from X in a signal handler; processing X input may call malloc; if input arrives while a matching routine is calling malloc, then we're scrod. But Emacs can't just block input while calling matching routines; then we don't notice interrupts when they come in. So, Emacs blocks input around all regexp calls except the matching calls, which it leaves unprotected, in the faith that they will not malloc. */ /* Normally, this is fine. */ #define MATCH_MAY_ALLOCATE /* When using GNU C, we are not REALLY using the C alloca, no matter what config.h may say. So don't take precautions for it. */ #ifdef __GNUC__ #undef C_ALLOCA #endif /* The match routines may not allocate if (1) they would do it with malloc and (2) it's not safe for them to use malloc. Note that if REL_ALLOC is defined, matching would not use malloc for the failure stack, but we would still use it for the register vectors; so REL_ALLOC should not affect this. */ #if (defined (C_ALLOCA) || defined (REGEX_MALLOC)) && defined (emacs) #undef MATCH_MAY_ALLOCATE #endif /* Failure stack declarations and macros; both re_compile_fastmap and re_match_2 use a failure stack. These have to be macros because of REGEX_ALLOCATE_STACK. */ /* Number of failure points for which to initially allocate space when matching. If this number is exceeded, we allocate more space, so it is not a hard limit. */ #ifndef INIT_FAILURE_ALLOC #define INIT_FAILURE_ALLOC 5 #endif /* Roughly the maximum number of failure points on the stack. Would be exactly that if always used MAX_FAILURE_SPACE each time we failed. This is a variable only so users of regex can assign to it; we never change it ourselves. */ #if defined (MATCH_MAY_ALLOCATE) int re_max_failures = 20000; #else int re_max_failures = 2000; #endif union fail_stack_elt { unsigned char *pointer; int integer; }; typedef union fail_stack_elt fail_stack_elt_t; typedef struct { fail_stack_elt_t *stack; unsigned size; unsigned avail; /* Offset of next open position. */ } fail_stack_type; #define FAIL_STACK_EMPTY() (fail_stack.avail == 0) #define FAIL_STACK_PTR_EMPTY() (fail_stack_ptr->avail == 0) #define FAIL_STACK_FULL() (fail_stack.avail == fail_stack.size) /* Define macros to initialize and free the failure stack. Do `return -2' if the alloc fails. */ #ifdef MATCH_MAY_ALLOCATE #define INIT_FAIL_STACK() \ do { \ fail_stack.stack = (fail_stack_elt_t *) \ REGEX_ALLOCATE_STACK (INIT_FAILURE_ALLOC * sizeof (fail_stack_elt_t)); \ \ if (fail_stack.stack == NULL) \ return -2; \ \ fail_stack.size = INIT_FAILURE_ALLOC; \ fail_stack.avail = 0; \ } while (0) #define RESET_FAIL_STACK() REGEX_FREE_STACK (fail_stack.stack) #else #define INIT_FAIL_STACK() \ do { \ fail_stack.avail = 0; \ } while (0) #define RESET_FAIL_STACK() #endif /* Double the size of FAIL_STACK, up to approximately `re_max_failures' items. Return 1 if succeeds, and 0 if either ran out of memory allocating space for it or it was already too large. REGEX_REALLOCATE_STACK requires `destination' be declared. */ #define DOUBLE_FAIL_STACK(fail_stack) \ ((fail_stack).size > re_max_failures * MAX_FAILURE_ITEMS \ ? 0 \ : ((fail_stack).stack = (fail_stack_elt_t *) \ REGEX_REALLOCATE_STACK ((fail_stack).stack, \ (fail_stack).size * sizeof (fail_stack_elt_t), \ ((fail_stack).size << 1) * sizeof (fail_stack_elt_t)), \ \ (fail_stack).stack == NULL \ ? 0 \ : ((fail_stack).size <<= 1, \ 1))) /* Push pointer POINTER on FAIL_STACK. Return 1 if was able to do so and 0 if ran out of memory allocating space to do so. */ #define PUSH_PATTERN_OP(POINTER, FAIL_STACK) \ ((FAIL_STACK_FULL () \ && !DOUBLE_FAIL_STACK (FAIL_STACK)) \ ? 0 \ : ((FAIL_STACK).stack[(FAIL_STACK).avail++].pointer = POINTER, \ 1)) /* Push a pointer value onto the failure stack. Assumes the variable `fail_stack'. Probably should only be called from within `PUSH_FAILURE_POINT'. */ #define PUSH_FAILURE_POINTER(item) \ fail_stack.stack[fail_stack.avail++].pointer = (unsigned char *) (item) /* This pushes an integer-valued item onto the failure stack. Assumes the variable `fail_stack'. Probably should only be called from within `PUSH_FAILURE_POINT'. */ #define PUSH_FAILURE_INT(item) \ fail_stack.stack[fail_stack.avail++].integer = (item) /* Push a fail_stack_elt_t value onto the failure stack. Assumes the variable `fail_stack'. Probably should only be called from within `PUSH_FAILURE_POINT'. */ #define PUSH_FAILURE_ELT(item) \ fail_stack.stack[fail_stack.avail++] = (item) /* These three POP... operations complement the three PUSH... operations. All assume that `fail_stack' is nonempty. */ #define POP_FAILURE_POINTER() fail_stack.stack[--fail_stack.avail].pointer #define POP_FAILURE_INT() fail_stack.stack[--fail_stack.avail].integer #define POP_FAILURE_ELT() fail_stack.stack[--fail_stack.avail] /* Used to omit pushing failure point id's when we're not debugging. */ #ifdef DEBUG #define DEBUG_PUSH PUSH_FAILURE_INT #define DEBUG_POP(item_addr) *(item_addr) = POP_FAILURE_INT () #else #define DEBUG_PUSH(item) #define DEBUG_POP(item_addr) #endif /* Push the information about the state we will need if we ever fail back to it. Requires variables fail_stack, regstart, regend, reg_info, and num_regs be declared. DOUBLE_FAIL_STACK requires `destination' be declared. Does `return FAILURE_CODE' if runs out of memory. */ #define PUSH_FAILURE_POINT(pattern_place, string_place, failure_code) \ do { \ char *destination; \ /* Must be int, so when we don't save any registers, the arithmetic \ of 0 + -1 isn't done as unsigned. */ \ int this_reg; \ \ DEBUG_STATEMENT (failure_id++); \ DEBUG_STATEMENT (nfailure_points_pushed++); \ DEBUG_PRINT2 ("\nPUSH_FAILURE_POINT #%u:\n", failure_id); \ DEBUG_PRINT2 (" Before push, next avail: %d\n", (fail_stack).avail);\ DEBUG_PRINT2 (" size: %d\n", (fail_stack).size);\ \ DEBUG_PRINT2 (" slots needed: %d\n", NUM_FAILURE_ITEMS); \ DEBUG_PRINT2 (" available: %d\n", REMAINING_AVAIL_SLOTS); \ \ /* Ensure we have enough space allocated for what we will push. */ \ while (REMAINING_AVAIL_SLOTS < NUM_FAILURE_ITEMS) \ { \ if (!DOUBLE_FAIL_STACK (fail_stack)) \ return failure_code; \ \ DEBUG_PRINT2 ("\n Doubled stack; size now: %d\n", \ (fail_stack).size); \ DEBUG_PRINT2 (" slots available: %d\n", REMAINING_AVAIL_SLOTS);\ } \ \ /* Push the info, starting with the registers. */ \ DEBUG_PRINT1 ("\n"); \ \ if (1) \ for (this_reg = lowest_active_reg; this_reg <= highest_active_reg; \ this_reg++) \ { \ DEBUG_PRINT2 (" Pushing reg: %d\n", this_reg); \ DEBUG_STATEMENT (num_regs_pushed++); \ \ DEBUG_PRINT2 (" start: 0x%x\n", regstart[this_reg]); \ PUSH_FAILURE_POINTER (regstart[this_reg]); \ \ DEBUG_PRINT2 (" end: 0x%x\n", regend[this_reg]); \ PUSH_FAILURE_POINTER (regend[this_reg]); \ \ DEBUG_PRINT2 (" info: 0x%x\n ", reg_info[this_reg]); \ DEBUG_PRINT2 (" match_null=%d", \ REG_MATCH_NULL_STRING_P (reg_info[this_reg])); \ DEBUG_PRINT2 (" active=%d", IS_ACTIVE (reg_info[this_reg])); \ DEBUG_PRINT2 (" matched_something=%d", \ MATCHED_SOMETHING (reg_info[this_reg])); \ DEBUG_PRINT2 (" ever_matched=%d", \ EVER_MATCHED_SOMETHING (reg_info[this_reg])); \ DEBUG_PRINT1 ("\n"); \ PUSH_FAILURE_ELT (reg_info[this_reg].word); \ } \ \ DEBUG_PRINT2 (" Pushing low active reg: %d\n", lowest_active_reg);\ PUSH_FAILURE_INT (lowest_active_reg); \ \ DEBUG_PRINT2 (" Pushing high active reg: %d\n", highest_active_reg);\ PUSH_FAILURE_INT (highest_active_reg); \ \ DEBUG_PRINT2 (" Pushing pattern 0x%x: ", pattern_place); \ DEBUG_PRINT_COMPILED_PATTERN (bufp, pattern_place, pend); \ PUSH_FAILURE_POINTER (pattern_place); \ \ DEBUG_PRINT2 (" Pushing string 0x%x: `", string_place); \ DEBUG_PRINT_DOUBLE_STRING (string_place, string1, size1, string2, \ size2); \ DEBUG_PRINT1 ("'\n"); \ PUSH_FAILURE_POINTER (string_place); \ \ DEBUG_PRINT2 (" Pushing failure id: %u\n", failure_id); \ DEBUG_PUSH (failure_id); \ } while (0) /* This is the number of items that are pushed and popped on the stack for each register. */ #define NUM_REG_ITEMS 3 /* Individual items aside from the registers. */ #ifdef DEBUG #define NUM_NONREG_ITEMS 5 /* Includes failure point id. */ #else #define NUM_NONREG_ITEMS 4 #endif /* We push at most this many items on the stack. */ #define MAX_FAILURE_ITEMS ((num_regs - 1) * NUM_REG_ITEMS + NUM_NONREG_ITEMS) /* We actually push this many items. */ #define NUM_FAILURE_ITEMS \ (((0 \ ? 0 : highest_active_reg - lowest_active_reg + 1) \ * NUM_REG_ITEMS) \ + NUM_NONREG_ITEMS) /* How many items can still be added to the stack without overflowing it. */ #define REMAINING_AVAIL_SLOTS ((fail_stack).size - (fail_stack).avail) /* Pops what PUSH_FAIL_STACK pushes. We restore into the parameters, all of which should be lvalues: STR -- the saved data position. PAT -- the saved pattern position. LOW_REG, HIGH_REG -- the highest and lowest active registers. REGSTART, REGEND -- arrays of string positions. REG_INFO -- array of information about each subexpression. Also assumes the variables `fail_stack' and (if debugging), `bufp', `pend', `string1', `size1', `string2', and `size2'. */ #define POP_FAILURE_POINT(str, pat, low_reg, high_reg, regstart, regend, reg_info)\ { \ DEBUG_STATEMENT (fail_stack_elt_t failure_id;) \ int this_reg; \ const unsigned char *string_temp; \ \ assert (!FAIL_STACK_EMPTY ()); \ \ /* Remove failure points and point to how many regs pushed. */ \ DEBUG_PRINT1 ("POP_FAILURE_POINT:\n"); \ DEBUG_PRINT2 (" Before pop, next avail: %d\n", fail_stack.avail); \ DEBUG_PRINT2 (" size: %d\n", fail_stack.size); \ \ assert (fail_stack.avail >= NUM_NONREG_ITEMS); \ \ DEBUG_POP (&failure_id); \ DEBUG_PRINT2 (" Popping failure id: %u\n", failure_id); \ \ /* If the saved string location is NULL, it came from an \ on_failure_keep_string_jump opcode, and we want to throw away the \ saved NULL, thus retaining our current position in the string. */ \ string_temp = POP_FAILURE_POINTER (); \ if (string_temp != NULL) \ str = (const char *) string_temp; \ \ DEBUG_PRINT2 (" Popping string 0x%x: `", str); \ DEBUG_PRINT_DOUBLE_STRING (str, string1, size1, string2, size2); \ DEBUG_PRINT1 ("'\n"); \ \ pat = (unsigned char *) POP_FAILURE_POINTER (); \ DEBUG_PRINT2 (" Popping pattern 0x%x: ", pat); \ DEBUG_PRINT_COMPILED_PATTERN (bufp, pat, pend); \ \ /* Restore register info. */ \ high_reg = (unsigned) POP_FAILURE_INT (); \ DEBUG_PRINT2 (" Popping high active reg: %d\n", high_reg); \ \ low_reg = (unsigned) POP_FAILURE_INT (); \ DEBUG_PRINT2 (" Popping low active reg: %d\n", low_reg); \ \ if (1) \ for (this_reg = high_reg; this_reg >= low_reg; this_reg--) \ { \ DEBUG_PRINT2 (" Popping reg: %d\n", this_reg); \ \ reg_info[this_reg].word = POP_FAILURE_ELT (); \ DEBUG_PRINT2 (" info: 0x%x\n", reg_info[this_reg]); \ \ regend[this_reg] = (const char *) POP_FAILURE_POINTER (); \ DEBUG_PRINT2 (" end: 0x%x\n", regend[this_reg]); \ \ regstart[this_reg] = (const char *) POP_FAILURE_POINTER (); \ DEBUG_PRINT2 (" start: 0x%x\n", regstart[this_reg]); \ } \ else \ { \ for (this_reg = highest_active_reg; this_reg > high_reg; this_reg--) \ { \ reg_info[this_reg].word.integer = 0; \ regend[this_reg] = 0; \ regstart[this_reg] = 0; \ } \ highest_active_reg = high_reg; \ } \ \ set_regs_matched_done = 0; \ DEBUG_STATEMENT (nfailure_points_popped++); \ } /* POP_FAILURE_POINT */ /* Structure for per-register (a.k.a. per-group) information. Other register information, such as the starting and ending positions (which are addresses), and the list of inner groups (which is a bits list) are maintained in separate variables. We are making a (strictly speaking) nonportable assumption here: that the compiler will pack our bit fields into something that fits into the type of `word', i.e., is something that fits into one item on the failure stack. */ typedef union { fail_stack_elt_t word; struct { /* This field is one if this group can match the empty string, zero if not. If not yet determined, `MATCH_NULL_UNSET_VALUE'. */ #define MATCH_NULL_UNSET_VALUE 3 unsigned match_null_string_p : 2; unsigned is_active : 1; unsigned matched_something : 1; unsigned ever_matched_something : 1; } bits; } register_info_type; #define REG_MATCH_NULL_STRING_P(R) ((R).bits.match_null_string_p) #define IS_ACTIVE(R) ((R).bits.is_active) #define MATCHED_SOMETHING(R) ((R).bits.matched_something) #define EVER_MATCHED_SOMETHING(R) ((R).bits.ever_matched_something) /* Call this when have matched a real character; it sets `matched' flags for the subexpressions which we are currently inside. Also records that those subexprs have matched. */ #define SET_REGS_MATCHED() \ do \ { \ if (!set_regs_matched_done) \ { \ unsigned r; \ set_regs_matched_done = 1; \ for (r = lowest_active_reg; r <= highest_active_reg; r++) \ { \ MATCHED_SOMETHING (reg_info[r]) \ = EVER_MATCHED_SOMETHING (reg_info[r]) \ = 1; \ } \ } \ } \ while (0) /* Registers are set to a sentinel when they haven't yet matched. */ static char reg_unset_dummy; #define REG_UNSET_VALUE (®_unset_dummy) #define REG_UNSET(e) ((e) == REG_UNSET_VALUE) /* Subroutine declarations and macros for regex_compile. */ static void store_op1 (), store_op2 (); static void insert_op1 (), insert_op2 (); static boolean at_begline_loc_p (), at_endline_loc_p (); static boolean group_in_compile_stack (); static reg_errcode_t compile_range (); /* Fetch the next character in the uncompiled pattern---translating it if necessary. Also cast from a signed character in the constant string passed to us by the user to an unsigned char that we can use as an array index (in, e.g., `translate'). */ #ifndef PATFETCH #define PATFETCH(c) \ do {if (p == pend) return REG_EEND; \ c = (unsigned char) *p++; \ if (translate) c = (unsigned char) translate[c]; \ } while (0) #endif /* Fetch the next character in the uncompiled pattern, with no translation. */ #define PATFETCH_RAW(c) \ do {if (p == pend) return REG_EEND; \ c = (unsigned char) *p++; \ } while (0) /* Go backwards one character in the pattern. */ #define PATUNFETCH p-- /* If `translate' is non-null, return translate[D], else just D. We cast the subscript to translate because some data is declared as `char *', to avoid warnings when a string constant is passed. But when we use a character as a subscript we must make it unsigned. */ #ifndef TRANSLATE #define TRANSLATE(d) \ (translate ? (char) translate[(unsigned char) (d)] : (d)) #endif /* Macros for outputting the compiled pattern into `buffer'. */ /* If the buffer isn't allocated when it comes in, use this. */ #define INIT_BUF_SIZE 32 /* Make sure we have at least N more bytes of space in buffer. */ #define GET_BUFFER_SPACE(n) \ while (b - bufp->buffer + (n) > bufp->allocated) \ EXTEND_BUFFER () /* Make sure we have one more byte of buffer space and then add C to it. */ #define BUF_PUSH(c) \ do { \ GET_BUFFER_SPACE (1); \ *b++ = (unsigned char) (c); \ } while (0) /* Ensure we have two more bytes of buffer space and then append C1 and C2. */ #define BUF_PUSH_2(c1, c2) \ do { \ GET_BUFFER_SPACE (2); \ *b++ = (unsigned char) (c1); \ *b++ = (unsigned char) (c2); \ } while (0) /* As with BUF_PUSH_2, except for three bytes. */ #define BUF_PUSH_3(c1, c2, c3) \ do { \ GET_BUFFER_SPACE (3); \ *b++ = (unsigned char) (c1); \ *b++ = (unsigned char) (c2); \ *b++ = (unsigned char) (c3); \ } while (0) /* Store a jump with opcode OP at LOC to location TO. We store a relative address offset by the three bytes the jump itself occupies. */ #define STORE_JUMP(op, loc, to) \ store_op1 (op, loc, (to) - (loc) - 3) /* Likewise, for a two-argument jump. */ #define STORE_JUMP2(op, loc, to, arg) \ store_op2 (op, loc, (to) - (loc) - 3, arg) /* Like `STORE_JUMP', but for inserting. Assume `b' is the buffer end. */ #define INSERT_JUMP(op, loc, to) \ insert_op1 (op, loc, (to) - (loc) - 3, b) /* Like `STORE_JUMP2', but for inserting. Assume `b' is the buffer end. */ #define INSERT_JUMP2(op, loc, to, arg) \ insert_op2 (op, loc, (to) - (loc) - 3, arg, b) /* This is not an arbitrary limit: the arguments which represent offsets into the pattern are two bytes long. So if 2^16 bytes turns out to be too small, many things would have to change. */ #define MAX_BUF_SIZE (1L << 16) /* Extend the buffer by twice its current size via realloc and reset the pointers that pointed into the old block to point to the correct places in the new one. If extending the buffer results in it being larger than MAX_BUF_SIZE, then flag memory exhausted. */ #define EXTEND_BUFFER() \ do { \ unsigned char *old_buffer = bufp->buffer; \ if (bufp->allocated == MAX_BUF_SIZE) \ return REG_ESIZE; \ bufp->allocated <<= 1; \ if (bufp->allocated > MAX_BUF_SIZE) \ bufp->allocated = MAX_BUF_SIZE; \ bufp->buffer = (unsigned char *) realloc (bufp->buffer, bufp->allocated);\ if (bufp->buffer == NULL) \ return REG_ESPACE; \ /* If the buffer moved, move all the pointers into it. */ \ if (old_buffer != bufp->buffer) \ { \ b = (b - old_buffer) + bufp->buffer; \ begalt = (begalt - old_buffer) + bufp->buffer; \ if (fixup_alt_jump) \ fixup_alt_jump = (fixup_alt_jump - old_buffer) + bufp->buffer;\ if (laststart) \ laststart = (laststart - old_buffer) + bufp->buffer; \ if (pending_exact) \ pending_exact = (pending_exact - old_buffer) + bufp->buffer; \ } \ } while (0) /* Since we have one byte reserved for the register number argument to {start,stop}_memory, the maximum number of groups we can report things about is what fits in that byte. */ #define MAX_REGNUM 255 /* But patterns can have more than `MAX_REGNUM' registers. We just ignore the excess. */ typedef unsigned regnum_t; /* Macros for the compile stack. */ /* Since offsets can go either forwards or backwards, this type needs to be able to hold values from -(MAX_BUF_SIZE - 1) to MAX_BUF_SIZE - 1. */ typedef int pattern_offset_t; typedef struct { pattern_offset_t begalt_offset; pattern_offset_t fixup_alt_jump; pattern_offset_t inner_group_offset; pattern_offset_t laststart_offset; regnum_t regnum; } compile_stack_elt_t; typedef struct { compile_stack_elt_t *stack; unsigned size; unsigned avail; /* Offset of next open position. */ } compile_stack_type; #define INIT_COMPILE_STACK_SIZE 32 #define COMPILE_STACK_EMPTY (compile_stack.avail == 0) #define COMPILE_STACK_FULL (compile_stack.avail == compile_stack.size) /* The next available element. */ #define COMPILE_STACK_TOP (compile_stack.stack[compile_stack.avail]) /* Set the bit for character C in a list. */ #define SET_LIST_BIT(c) \ (b[((unsigned char) (c)) / BYTEWIDTH] \ |= 1 << (((unsigned char) c) % BYTEWIDTH)) /* Get the next unsigned number in the uncompiled pattern. */ #define GET_UNSIGNED_NUMBER(num) \ { if (p != pend) \ { \ PATFETCH (c); \ while (ISDIGIT (c)) \ { \ if (num < 0) \ num = 0; \ num = num * 10 + c - '0'; \ if (p == pend) \ break; \ PATFETCH (c); \ } \ } \ } #define CHAR_CLASS_MAX_LENGTH 6 /* Namely, `xdigit'. */ #define IS_CHAR_CLASS(string) \ (STREQ (string, "alpha") || STREQ (string, "upper") \ || STREQ (string, "lower") || STREQ (string, "digit") \ || STREQ (string, "alnum") || STREQ (string, "xdigit") \ || STREQ (string, "space") || STREQ (string, "print") \ || STREQ (string, "punct") || STREQ (string, "graph") \ || STREQ (string, "cntrl") || STREQ (string, "blank")) #ifndef MATCH_MAY_ALLOCATE /* If we cannot allocate large objects within re_match_2_internal, we make the fail stack and register vectors global. The fail stack, we grow to the maximum size when a regexp is compiled. The register vectors, we adjust in size each time we compile a regexp, according to the number of registers it needs. */ static fail_stack_type fail_stack; /* Size with which the following vectors are currently allocated. That is so we can make them bigger as needed, but never make them smaller. */ static int regs_allocated_size; static const char ** regstart, ** regend; static const char ** old_regstart, ** old_regend; static const char **best_regstart, **best_regend; static register_info_type *reg_info; static const char **reg_dummy; static register_info_type *reg_info_dummy; /* Make the register vectors big enough for NUM_REGS registers, but don't make them smaller. */ static regex_grow_registers (num_regs) int num_regs; { if (num_regs > regs_allocated_size) { RETALLOC_IF (regstart, num_regs, const char *); RETALLOC_IF (regend, num_regs, const char *); RETALLOC_IF (old_regstart, num_regs, const char *); RETALLOC_IF (old_regend, num_regs, const char *); RETALLOC_IF (best_regstart, num_regs, const char *); RETALLOC_IF (best_regend, num_regs, const char *); RETALLOC_IF (reg_info, num_regs, register_info_type); RETALLOC_IF (reg_dummy, num_regs, const char *); RETALLOC_IF (reg_info_dummy, num_regs, register_info_type); regs_allocated_size = num_regs; } } #endif /* not MATCH_MAY_ALLOCATE */ /* `regex_compile' compiles PATTERN (of length SIZE) according to SYNTAX. Returns one of error codes defined in `regex.h', or zero for success. Assumes the `allocated' (and perhaps `buffer') and `translate' fields are set in BUFP on entry. If it succeeds, results are put in BUFP (if it returns an error, the contents of BUFP are undefined): `buffer' is the compiled pattern; `syntax' is set to SYNTAX; `used' is set to the length of the compiled pattern; `fastmap_accurate' is zero; `re_nsub' is the number of subexpressions in PATTERN; `not_bol' and `not_eol' are zero; The `fastmap' and `newline_anchor' fields are neither examined nor set. */ /* Return, freeing storage we allocated. */ #define FREE_STACK_RETURN(value) \ return (free (compile_stack.stack), value) static reg_errcode_t regex_compile (pattern, size, syntax, bufp) const char *pattern; int size; reg_syntax_t syntax; struct re_pattern_buffer *bufp; { /* We fetch characters from PATTERN here. Even though PATTERN is `char *' (i.e., signed), we declare these variables as unsigned, so they can be reliably used as array indices. */ register unsigned char c, c1; /* A random temporary spot in PATTERN. */ const char *p1; /* Points to the end of the buffer, where we should append. */ register unsigned char *b; /* Keeps track of unclosed groups. */ compile_stack_type compile_stack; /* Points to the current (ending) position in the pattern. */ const char *p = pattern; const char *pend = pattern + size; /* How to translate the characters in the pattern. */ RE_TRANSLATE_TYPE translate = bufp->translate; /* Address of the count-byte of the most recently inserted `exactn' command. This makes it possible to tell if a new exact-match character can be added to that command or if the character requires a new `exactn' command. */ unsigned char *pending_exact = 0; /* Address of start of the most recently finished expression. This tells, e.g., postfix * where to find the start of its operand. Reset at the beginning of groups and alternatives. */ unsigned char *laststart = 0; /* Address of beginning of regexp, or inside of last group. */ unsigned char *begalt; /* Place in the uncompiled pattern (i.e., the {) to which to go back if the interval is invalid. */ const char *beg_interval; /* Address of the place where a forward jump should go to the end of the containing expression. Each alternative of an `or' -- except the last -- ends with a forward jump of this sort. */ unsigned char *fixup_alt_jump = 0; /* Counts open-groups as they are encountered. Remembered for the matching close-group on the compile stack, so the same register number is put in the stop_memory as the start_memory. */ regnum_t regnum = 0; #ifdef DEBUG DEBUG_PRINT1 ("\nCompiling pattern: "); if (debug) { unsigned debug_count; for (debug_count = 0; debug_count < size; debug_count++) putchar (pattern[debug_count]); putchar ('\n'); } #endif /* DEBUG */ /* Initialize the compile stack. */ compile_stack.stack = TALLOC (INIT_COMPILE_STACK_SIZE, compile_stack_elt_t); if (compile_stack.stack == NULL) return REG_ESPACE; compile_stack.size = INIT_COMPILE_STACK_SIZE; compile_stack.avail = 0; /* Initialize the pattern buffer. */ bufp->syntax = syntax; bufp->fastmap_accurate = 0; bufp->not_bol = bufp->not_eol = 0; /* Set `used' to zero, so that if we return an error, the pattern printer (for debugging) will think there's no pattern. We reset it at the end. */ bufp->used = 0; /* Always count groups, whether or not bufp->no_sub is set. */ bufp->re_nsub = 0; #if !defined (emacs) && !defined (SYNTAX_TABLE) /* Initialize the syntax table. */ init_syntax_once (); #endif if (bufp->allocated == 0) { if (bufp->buffer) { /* If zero allocated, but buffer is non-null, try to realloc enough space. This loses if buffer's address is bogus, but that is the user's responsibility. */ RETALLOC (bufp->buffer, INIT_BUF_SIZE, unsigned char); } else { /* Caller did not allocate a buffer. Do it for them. */ bufp->buffer = TALLOC (INIT_BUF_SIZE, unsigned char); } if (!bufp->buffer) FREE_STACK_RETURN (REG_ESPACE); bufp->allocated = INIT_BUF_SIZE; } begalt = b = bufp->buffer; /* Loop through the uncompiled pattern until we're at the end. */ while (p != pend) { PATFETCH (c); switch (c) { case '^': { if ( /* If at start of pattern, it's an operator. */ p == pattern + 1 /* If context independent, it's an operator. */ || syntax & RE_CONTEXT_INDEP_ANCHORS /* Otherwise, depends on what's come before. */ || at_begline_loc_p (pattern, p, syntax)) BUF_PUSH (begline); else goto normal_char; } break; case '$': { if ( /* If at end of pattern, it's an operator. */ p == pend /* If context independent, it's an operator. */ || syntax & RE_CONTEXT_INDEP_ANCHORS /* Otherwise, depends on what's next. */ || at_endline_loc_p (p, pend, syntax)) BUF_PUSH (endline); else goto normal_char; } break; case '+': case '?': if ((syntax & RE_BK_PLUS_QM) || (syntax & RE_LIMITED_OPS)) goto normal_char; handle_plus: case '*': /* If there is no previous pattern... */ if (!laststart) { if (syntax & RE_CONTEXT_INVALID_OPS) FREE_STACK_RETURN (REG_BADRPT); else if (!(syntax & RE_CONTEXT_INDEP_OPS)) goto normal_char; } { /* Are we optimizing this jump? */ boolean keep_string_p = false; /* 1 means zero (many) matches is allowed. */ char zero_times_ok = 0, many_times_ok = 0; /* If there is a sequence of repetition chars, collapse it down to just one (the right one). We can't combine interval operators with these because of, e.g., `a{2}*', which should only match an even number of `a's. */ for (;;) { zero_times_ok |= c != '+'; many_times_ok |= c != '?'; if (p == pend) break; PATFETCH (c); if (c == '*' || (!(syntax & RE_BK_PLUS_QM) && (c == '+' || c == '?'))) ; else if (syntax & RE_BK_PLUS_QM && c == '\\') { if (p == pend) FREE_STACK_RETURN (REG_EESCAPE); PATFETCH (c1); if (!(c1 == '+' || c1 == '?')) { PATUNFETCH; PATUNFETCH; break; } c = c1; } else { PATUNFETCH; break; } /* If we get here, we found another repeat character. */ } /* Star, etc. applied to an empty pattern is equivalent to an empty pattern. */ if (!laststart) break; /* Now we know whether or not zero matches is allowed and also whether or not two or more matches is allowed. */ if (many_times_ok) { /* More than one repetition is allowed, so put in at the end a backward relative jump from `b' to before the next jump we're going to put in below (which jumps from laststart to after this jump). But if we are at the `*' in the exact sequence `.*\n', insert an unconditional jump backwards to the ., instead of the beginning of the loop. This way we only push a failure point once, instead of every time through the loop. */ assert (p - 1 > pattern); /* Allocate the space for the jump. */ GET_BUFFER_SPACE (3); /* We know we are not at the first character of the pattern, because laststart was nonzero. And we've already incremented `p', by the way, to be the character after the `*'. Do we have to do something analogous here for null bytes, because of RE_DOT_NOT_NULL? */ if (TRANSLATE (*(p - 2)) == TRANSLATE ('.') && zero_times_ok && p < pend && TRANSLATE (*p) == TRANSLATE ('\n') && !(syntax & RE_DOT_NEWLINE)) { /* We have .*\n. */ STORE_JUMP (jump, b, laststart); keep_string_p = true; } else /* Anything else. */ STORE_JUMP (maybe_pop_jump, b, laststart - 3); /* We've added more stuff to the buffer. */ b += 3; } /* On failure, jump from laststart to b + 3, which will be the end of the buffer after this jump is inserted. */ GET_BUFFER_SPACE (3); INSERT_JUMP (keep_string_p ? on_failure_keep_string_jump : on_failure_jump, laststart, b + 3); pending_exact = 0; b += 3; if (!zero_times_ok) { /* At least one repetition is required, so insert a `dummy_failure_jump' before the initial `on_failure_jump' instruction of the loop. This effects a skip over that instruction the first time we hit that loop. */ GET_BUFFER_SPACE (3); INSERT_JUMP (dummy_failure_jump, laststart, laststart + 6); b += 3; } } break; case '.': laststart = b; BUF_PUSH (anychar); break; case '[': { boolean had_char_class = false; if (p == pend) FREE_STACK_RETURN (REG_EBRACK); /* Ensure that we have enough space to push a charset: the opcode, the length count, and the bitset; 34 bytes in all. */ GET_BUFFER_SPACE (34); laststart = b; /* We test `*p == '^' twice, instead of using an if statement, so we only need one BUF_PUSH. */ BUF_PUSH (*p == '^' ? charset_not : charset); if (*p == '^') p++; /* Remember the first position in the bracket expression. */ p1 = p; /* Push the number of bytes in the bitmap. */ BUF_PUSH ((1 << BYTEWIDTH) / BYTEWIDTH); /* Clear the whole map. */ bzero (b, (1 << BYTEWIDTH) / BYTEWIDTH); /* charset_not matches newline according to a syntax bit. */ if ((re_opcode_t) b[-2] == charset_not && (syntax & RE_HAT_LISTS_NOT_NEWLINE)) SET_LIST_BIT ('\n'); /* Read in characters and ranges, setting map bits. */ for (;;) { if (p == pend) FREE_STACK_RETURN (REG_EBRACK); PATFETCH (c); /* \ might escape characters inside [...] and [^...]. */ if ((syntax & RE_BACKSLASH_ESCAPE_IN_LISTS) && c == '\\') { if (p == pend) FREE_STACK_RETURN (REG_EESCAPE); PATFETCH (c1); SET_LIST_BIT (c1); continue; } /* Could be the end of the bracket expression. If it's not (i.e., when the bracket expression is `[]' so far), the ']' character bit gets set way below. */ if (c == ']' && p != p1 + 1) break; /* Look ahead to see if it's a range when the last thing was a character class. */ if (had_char_class && c == '-' && *p != ']') FREE_STACK_RETURN (REG_ERANGE); /* Look ahead to see if it's a range when the last thing was a character: if this is a hyphen not at the beginning or the end of a list, then it's the range operator. */ if (c == '-' && !(p - 2 >= pattern && p[-2] == '[') && !(p - 3 >= pattern && p[-3] == '[' && p[-2] == '^') && *p != ']') { reg_errcode_t ret = compile_range (&p, pend, translate, syntax, b); if (ret != REG_NOERROR) FREE_STACK_RETURN (ret); } else if (p[0] == '-' && p[1] != ']') { /* This handles ranges made up of characters only. */ reg_errcode_t ret; /* Move past the `-'. */ PATFETCH (c1); ret = compile_range (&p, pend, translate, syntax, b); if (ret != REG_NOERROR) FREE_STACK_RETURN (ret); } /* See if we're at the beginning of a possible character class. */ else if (syntax & RE_CHAR_CLASSES && c == '[' && *p == ':') { /* Leave room for the null. */ char str[CHAR_CLASS_MAX_LENGTH + 1]; PATFETCH (c); c1 = 0; /* If pattern is `[[:'. */ if (p == pend) FREE_STACK_RETURN (REG_EBRACK); for (;;) { PATFETCH (c); if (c == ':' || c == ']' || p == pend || c1 == CHAR_CLASS_MAX_LENGTH) break; str[c1++] = c; } str[c1] = '\0'; /* If isn't a word bracketed by `[:' and:`]': undo the ending character, the letters, and leave the leading `:' and `[' (but set bits for them). */ if (c == ':' && *p == ']') { int ch; boolean is_alnum = STREQ (str, "alnum"); boolean is_alpha = STREQ (str, "alpha"); boolean is_blank = STREQ (str, "blank"); boolean is_cntrl = STREQ (str, "cntrl"); boolean is_digit = STREQ (str, "digit"); boolean is_graph = STREQ (str, "graph"); boolean is_lower = STREQ (str, "lower"); boolean is_print = STREQ (str, "print"); boolean is_punct = STREQ (str, "punct"); boolean is_space = STREQ (str, "space"); boolean is_upper = STREQ (str, "upper"); boolean is_xdigit = STREQ (str, "xdigit"); if (!IS_CHAR_CLASS (str)) FREE_STACK_RETURN (REG_ECTYPE); /* Throw away the ] at the end of the character class. */ PATFETCH (c); if (p == pend) FREE_STACK_RETURN (REG_EBRACK); for (ch = 0; ch < 1 << BYTEWIDTH; ch++) { /* This was split into 3 if's to avoid an arbitrary limit in some compiler. */ if ( (is_alnum && ISALNUM (ch)) || (is_alpha && ISALPHA (ch)) || (is_blank && ISBLANK (ch)) || (is_cntrl && ISCNTRL (ch))) SET_LIST_BIT (ch); if ( (is_digit && ISDIGIT (ch)) || (is_graph && ISGRAPH (ch)) || (is_lower && ISLOWER (ch)) || (is_print && ISPRINT (ch))) SET_LIST_BIT (ch); if ( (is_punct && ISPUNCT (ch)) || (is_space && ISSPACE (ch)) || (is_upper && ISUPPER (ch)) || (is_xdigit && ISXDIGIT (ch))) SET_LIST_BIT (ch); } had_char_class = true; } else { c1++; while (c1--) PATUNFETCH; SET_LIST_BIT ('['); SET_LIST_BIT (':'); had_char_class = false; } } else { had_char_class = false; SET_LIST_BIT (c); } } /* Discard any (non)matching list bytes that are all 0 at the end of the map. Decrease the map-length byte too. */ while ((int) b[-1] > 0 && b[b[-1] - 1] == 0) b[-1]--; b += b[-1]; } break; case '(': if (syntax & RE_NO_BK_PARENS) goto handle_open; else goto normal_char; case ')': if (syntax & RE_NO_BK_PARENS) goto handle_close; else goto normal_char; case '\n': if (syntax & RE_NEWLINE_ALT) goto handle_alt; else goto normal_char; case '|': if (syntax & RE_NO_BK_VBAR) goto handle_alt; else goto normal_char; case '{': if (syntax & RE_INTERVALS && syntax & RE_NO_BK_BRACES) goto handle_interval; else goto normal_char; case '\\': if (p == pend) FREE_STACK_RETURN (REG_EESCAPE); /* Do not translate the character after the \, so that we can distinguish, e.g., \B from \b, even if we normally would translate, e.g., B to b. */ PATFETCH_RAW (c); switch (c) { case '(': if (syntax & RE_NO_BK_PARENS) goto normal_backslash; handle_open: bufp->re_nsub++; regnum++; if (COMPILE_STACK_FULL) { RETALLOC (compile_stack.stack, compile_stack.size << 1, compile_stack_elt_t); if (compile_stack.stack == NULL) return REG_ESPACE; compile_stack.size <<= 1; } /* These are the values to restore when we hit end of this group. They are all relative offsets, so that if the whole pattern moves because of realloc, they will still be valid. */ COMPILE_STACK_TOP.begalt_offset = begalt - bufp->buffer; COMPILE_STACK_TOP.fixup_alt_jump = fixup_alt_jump ? fixup_alt_jump - bufp->buffer + 1 : 0; COMPILE_STACK_TOP.laststart_offset = b - bufp->buffer; COMPILE_STACK_TOP.regnum = regnum; /* We will eventually replace the 0 with the number of groups inner to this one. But do not push a start_memory for groups beyond the last one we can represent in the compiled pattern. */ if (regnum <= MAX_REGNUM) { COMPILE_STACK_TOP.inner_group_offset = b - bufp->buffer + 2; BUF_PUSH_3 (start_memory, regnum, 0); } compile_stack.avail++; fixup_alt_jump = 0; laststart = 0; begalt = b; /* If we've reached MAX_REGNUM groups, then this open won't actually generate any code, so we'll have to clear pending_exact explicitly. */ pending_exact = 0; break; case ')': if (syntax & RE_NO_BK_PARENS) goto normal_backslash; if (COMPILE_STACK_EMPTY) if (syntax & RE_UNMATCHED_RIGHT_PAREN_ORD) goto normal_backslash; else FREE_STACK_RETURN (REG_ERPAREN); handle_close: if (fixup_alt_jump) { /* Push a dummy failure point at the end of the alternative for a possible future `pop_failure_jump' to pop. See comments at `push_dummy_failure' in `re_match_2'. */ BUF_PUSH (push_dummy_failure); /* We allocated space for this jump when we assigned to `fixup_alt_jump', in the `handle_alt' case below. */ STORE_JUMP (jump_past_alt, fixup_alt_jump, b - 1); } /* See similar code for backslashed left paren above. */ if (COMPILE_STACK_EMPTY) if (syntax & RE_UNMATCHED_RIGHT_PAREN_ORD) goto normal_char; else FREE_STACK_RETURN (REG_ERPAREN); /* Since we just checked for an empty stack above, this ``can't happen''. */ assert (compile_stack.avail != 0); { /* We don't just want to restore into `regnum', because later groups should continue to be numbered higher, as in `(ab)c(de)' -- the second group is #2. */ regnum_t this_group_regnum; compile_stack.avail--; begalt = bufp->buffer + COMPILE_STACK_TOP.begalt_offset; fixup_alt_jump = COMPILE_STACK_TOP.fixup_alt_jump ? bufp->buffer + COMPILE_STACK_TOP.fixup_alt_jump - 1 : 0; laststart = bufp->buffer + COMPILE_STACK_TOP.laststart_offset; this_group_regnum = COMPILE_STACK_TOP.regnum; /* If we've reached MAX_REGNUM groups, then this open won't actually generate any code, so we'll have to clear pending_exact explicitly. */ pending_exact = 0; /* We're at the end of the group, so now we know how many groups were inside this one. */ if (this_group_regnum <= MAX_REGNUM) { unsigned char *inner_group_loc = bufp->buffer + COMPILE_STACK_TOP.inner_group_offset; *inner_group_loc = regnum - this_group_regnum; BUF_PUSH_3 (stop_memory, this_group_regnum, regnum - this_group_regnum); } } break; case '|': /* `\|'. */ if (syntax & RE_LIMITED_OPS || syntax & RE_NO_BK_VBAR) goto normal_backslash; handle_alt: if (syntax & RE_LIMITED_OPS) goto normal_char; /* Insert before the previous alternative a jump which jumps to this alternative if the former fails. */ GET_BUFFER_SPACE (3); INSERT_JUMP (on_failure_jump, begalt, b + 6); pending_exact = 0; b += 3; /* The alternative before this one has a jump after it which gets executed if it gets matched. Adjust that jump so it will jump to this alternative's analogous jump (put in below, which in turn will jump to the next (if any) alternative's such jump, etc.). The last such jump jumps to the correct final destination. A picture: _____ _____ | | | | | v | v a | b | c If we are at `b', then fixup_alt_jump right now points to a three-byte space after `a'. We'll put in the jump, set fixup_alt_jump to right after `b', and leave behind three bytes which we'll fill in when we get to after `c'. */ if (fixup_alt_jump) STORE_JUMP (jump_past_alt, fixup_alt_jump, b); /* Mark and leave space for a jump after this alternative, to be filled in later either by next alternative or when know we're at the end of a series of alternatives. */ fixup_alt_jump = b; GET_BUFFER_SPACE (3); b += 3; laststart = 0; begalt = b; break; case '{': /* If \{ is a literal. */ if (!(syntax & RE_INTERVALS) /* If we're at `\{' and it's not the open-interval operator. */ || ((syntax & RE_INTERVALS) && (syntax & RE_NO_BK_BRACES)) || (p - 2 == pattern && p == pend)) goto normal_backslash; handle_interval: { /* If got here, then the syntax allows intervals. */ /* At least (most) this many matches must be made. */ int lower_bound = -1, upper_bound = -1; beg_interval = p - 1; if (p == pend) { if (syntax & RE_NO_BK_BRACES) goto unfetch_interval; else FREE_STACK_RETURN (REG_EBRACE); } GET_UNSIGNED_NUMBER (lower_bound); if (c == ',') { GET_UNSIGNED_NUMBER (upper_bound); if (upper_bound < 0) upper_bound = RE_DUP_MAX; } else /* Interval such as `{1}' => match exactly once. */ upper_bound = lower_bound; if (lower_bound < 0 || upper_bound > RE_DUP_MAX || lower_bound > upper_bound) { if (syntax & RE_NO_BK_BRACES) goto unfetch_interval; else FREE_STACK_RETURN (REG_BADBR); } if (!(syntax & RE_NO_BK_BRACES)) { if (c != '\\') FREE_STACK_RETURN (REG_EBRACE); PATFETCH (c); } if (c != '}') { if (syntax & RE_NO_BK_BRACES) goto unfetch_interval; else FREE_STACK_RETURN (REG_BADBR); } /* We just parsed a valid interval. */ /* If it's invalid to have no preceding re. */ if (!laststart) { if (syntax & RE_CONTEXT_INVALID_OPS) FREE_STACK_RETURN (REG_BADRPT); else if (syntax & RE_CONTEXT_INDEP_OPS) laststart = b; else goto unfetch_interval; } /* If the upper bound is zero, don't want to succeed at all; jump from `laststart' to `b + 3', which will be the end of the buffer after we insert the jump. */ if (upper_bound == 0) { GET_BUFFER_SPACE (3); INSERT_JUMP (jump, laststart, b + 3); b += 3; } /* Otherwise, we have a nontrivial interval. When we're all done, the pattern will look like: set_number_at set_number_at succeed_n jump_n (The upper bound and `jump_n' are omitted if `upper_bound' is 1, though.) */ else { /* If the upper bound is > 1, we need to insert more at the end of the loop. */ unsigned nbytes = 10 + (upper_bound > 1) * 10; GET_BUFFER_SPACE (nbytes); /* Initialize lower bound of the `succeed_n', even though it will be set during matching by its attendant `set_number_at' (inserted next), because `re_compile_fastmap' needs to know. Jump to the `jump_n' we might insert below. */ INSERT_JUMP2 (succeed_n, laststart, b + 5 + (upper_bound > 1) * 5, lower_bound); b += 5; /* Code to initialize the lower bound. Insert before the `succeed_n'. The `5' is the last two bytes of this `set_number_at', plus 3 bytes of the following `succeed_n'. */ insert_op2 (set_number_at, laststart, 5, lower_bound, b); b += 5; if (upper_bound > 1) { /* More than one repetition is allowed, so append a backward jump to the `succeed_n' that starts this interval. When we've reached this during matching, we'll have matched the interval once, so jump back only `upper_bound - 1' times. */ STORE_JUMP2 (jump_n, b, laststart + 5, upper_bound - 1); b += 5; /* The location we want to set is the second parameter of the `jump_n'; that is `b-2' as an absolute address. `laststart' will be the `set_number_at' we're about to insert; `laststart+3' the number to set, the source for the relative address. But we are inserting into the middle of the pattern -- so everything is getting moved up by 5. Conclusion: (b - 2) - (laststart + 3) + 5, i.e., b - laststart. We insert this at the beginning of the loop so that if we fail during matching, we'll reinitialize the bounds. */ insert_op2 (set_number_at, laststart, b - laststart, upper_bound - 1, b); b += 5; } } pending_exact = 0; beg_interval = NULL; } break; unfetch_interval: /* If an invalid interval, match the characters as literals. */ assert (beg_interval); p = beg_interval; beg_interval = NULL; /* normal_char and normal_backslash need `c'. */ PATFETCH (c); if (!(syntax & RE_NO_BK_BRACES)) { if (p > pattern && p[-1] == '\\') goto normal_backslash; } goto normal_char; #ifdef emacs /* There is no way to specify the before_dot and after_dot operators. rms says this is ok. --karl */ case '=': BUF_PUSH (at_dot); break; case 's': laststart = b; PATFETCH (c); BUF_PUSH_2 (syntaxspec, syntax_spec_code[c]); break; case 'S': laststart = b; PATFETCH (c); BUF_PUSH_2 (notsyntaxspec, syntax_spec_code[c]); break; #endif /* emacs */ case 'w': laststart = b; BUF_PUSH (wordchar); break; case 'W': laststart = b; BUF_PUSH (notwordchar); break; case '<': BUF_PUSH (wordbeg); break; case '>': BUF_PUSH (wordend); break; case 'b': BUF_PUSH (wordbound); break; case 'B': BUF_PUSH (notwordbound); break; case '`': BUF_PUSH (begbuf); break; case '\'': BUF_PUSH (endbuf); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': if (syntax & RE_NO_BK_REFS) goto normal_char; c1 = c - '0'; if (c1 > regnum) FREE_STACK_RETURN (REG_ESUBREG); /* Can't back reference to a subexpression if inside of it. */ if (group_in_compile_stack (compile_stack, c1)) goto normal_char; laststart = b; BUF_PUSH_2 (duplicate, c1); break; case '+': case '?': if (syntax & RE_BK_PLUS_QM) goto handle_plus; else goto normal_backslash; default: normal_backslash: /* You might think it would be useful for \ to mean not to translate; but if we don't translate it it will never match anything. */ c = TRANSLATE (c); goto normal_char; } break; default: /* Expects the character in `c'. */ normal_char: /* If no exactn currently being built. */ if (!pending_exact /* If last exactn not at current position. */ || pending_exact + *pending_exact + 1 != b /* We have only one byte following the exactn for the count. */ || *pending_exact == (1 << BYTEWIDTH) - 1 /* If followed by a repetition operator. */ || *p == '*' || *p == '^' || ((syntax & RE_BK_PLUS_QM) ? *p == '\\' && (p[1] == '+' || p[1] == '?') : (*p == '+' || *p == '?')) || ((syntax & RE_INTERVALS) && ((syntax & RE_NO_BK_BRACES) ? *p == '{' : (p[0] == '\\' && p[1] == '{')))) { /* Start building a new exactn. */ laststart = b; BUF_PUSH_2 (exactn, 0); pending_exact = b - 1; } BUF_PUSH (c); (*pending_exact)++; break; } /* switch (c) */ } /* while p != pend */ /* Through the pattern now. */ if (fixup_alt_jump) STORE_JUMP (jump_past_alt, fixup_alt_jump, b); if (!COMPILE_STACK_EMPTY) FREE_STACK_RETURN (REG_EPAREN); /* If we don't want backtracking, force success the first time we reach the end of the compiled pattern. */ if (syntax & RE_NO_POSIX_BACKTRACKING) BUF_PUSH (succeed); free (compile_stack.stack); /* We have succeeded; set the length of the buffer. */ bufp->used = b - bufp->buffer; #ifdef DEBUG if (debug) { DEBUG_PRINT1 ("\nCompiled pattern: \n"); print_compiled_pattern (bufp); } #endif /* DEBUG */ #ifndef MATCH_MAY_ALLOCATE /* Initialize the failure stack to the largest possible stack. This isn't necessary unless we're trying to avoid calling alloca in the search and match routines. */ { int num_regs = bufp->re_nsub + 1; /* Since DOUBLE_FAIL_STACK refuses to double only if the current size is strictly greater than re_max_failures, the largest possible stack is 2 * re_max_failures failure points. */ if (fail_stack.size < (2 * re_max_failures * MAX_FAILURE_ITEMS)) { fail_stack.size = (2 * re_max_failures * MAX_FAILURE_ITEMS); #ifdef emacs if (! fail_stack.stack) fail_stack.stack = (fail_stack_elt_t *) xmalloc (fail_stack.size * sizeof (fail_stack_elt_t)); else fail_stack.stack = (fail_stack_elt_t *) xrealloc (fail_stack.stack, (fail_stack.size * sizeof (fail_stack_elt_t))); #else /* not emacs */ if (! fail_stack.stack) fail_stack.stack = (fail_stack_elt_t *) malloc (fail_stack.size * sizeof (fail_stack_elt_t)); else fail_stack.stack = (fail_stack_elt_t *) realloc (fail_stack.stack, (fail_stack.size * sizeof (fail_stack_elt_t))); #endif /* not emacs */ } regex_grow_registers (num_regs); } #endif /* not MATCH_MAY_ALLOCATE */ return REG_NOERROR; } /* regex_compile */ /* Subroutines for `regex_compile'. */ /* Store OP at LOC followed by two-byte integer parameter ARG. */ static void store_op1 (op, loc, arg) re_opcode_t op; unsigned char *loc; int arg; { *loc = (unsigned char) op; STORE_NUMBER (loc + 1, arg); } /* Like `store_op1', but for two two-byte parameters ARG1 and ARG2. */ static void store_op2 (op, loc, arg1, arg2) re_opcode_t op; unsigned char *loc; int arg1, arg2; { *loc = (unsigned char) op; STORE_NUMBER (loc + 1, arg1); STORE_NUMBER (loc + 3, arg2); } /* Copy the bytes from LOC to END to open up three bytes of space at LOC for OP followed by two-byte integer parameter ARG. */ static void insert_op1 (op, loc, arg, end) re_opcode_t op; unsigned char *loc; int arg; unsigned char *end; { register unsigned char *pfrom = end; register unsigned char *pto = end + 3; while (pfrom != loc) *--pto = *--pfrom; store_op1 (op, loc, arg); } /* Like `insert_op1', but for two two-byte parameters ARG1 and ARG2. */ static void insert_op2 (op, loc, arg1, arg2, end) re_opcode_t op; unsigned char *loc; int arg1, arg2; unsigned char *end; { register unsigned char *pfrom = end; register unsigned char *pto = end + 5; while (pfrom != loc) *--pto = *--pfrom; store_op2 (op, loc, arg1, arg2); } /* P points to just after a ^ in PATTERN. Return true if that ^ comes after an alternative or a begin-subexpression. We assume there is at least one character before the ^. */ static boolean at_begline_loc_p (pattern, p, syntax) const char *pattern, *p; reg_syntax_t syntax; { const char *prev = p - 2; boolean prev_prev_backslash = prev > pattern && prev[-1] == '\\'; return /* After a subexpression? */ (*prev == '(' && (syntax & RE_NO_BK_PARENS || prev_prev_backslash)) /* After an alternative? */ || (*prev == '|' && (syntax & RE_NO_BK_VBAR || prev_prev_backslash)); } /* The dual of at_begline_loc_p. This one is for $. We assume there is at least one character after the $, i.e., `P < PEND'. */ static boolean at_endline_loc_p (p, pend, syntax) const char *p, *pend; int syntax; { const char *next = p; boolean next_backslash = *next == '\\'; const char *next_next = p + 1 < pend ? p + 1 : 0; return /* Before a subexpression? */ (syntax & RE_NO_BK_PARENS ? *next == ')' : next_backslash && next_next && *next_next == ')') /* Before an alternative? */ || (syntax & RE_NO_BK_VBAR ? *next == '|' : next_backslash && next_next && *next_next == '|'); } /* Returns true if REGNUM is in one of COMPILE_STACK's elements and false if it's not. */ static boolean group_in_compile_stack (compile_stack, regnum) compile_stack_type compile_stack; regnum_t regnum; { int this_element; for (this_element = compile_stack.avail - 1; this_element >= 0; this_element--) if (compile_stack.stack[this_element].regnum == regnum) return true; return false; } /* Read the ending character of a range (in a bracket expression) from the uncompiled pattern *P_PTR (which ends at PEND). We assume the starting character is in `P[-2]'. (`P[-1]' is the character `-'.) Then we set the translation of all bits between the starting and ending characters (inclusive) in the compiled pattern B. Return an error code. We use these short variable names so we can use the same macros as `regex_compile' itself. */ static reg_errcode_t compile_range (p_ptr, pend, translate, syntax, b) const char **p_ptr, *pend; RE_TRANSLATE_TYPE translate; reg_syntax_t syntax; unsigned char *b; { unsigned this_char; const char *p = *p_ptr; int range_start, range_end; if (p == pend) return REG_ERANGE; /* Even though the pattern is a signed `char *', we need to fetch with unsigned char *'s; if the high bit of the pattern character is set, the range endpoints will be negative if we fetch using a signed char *. We also want to fetch the endpoints without translating them; the appropriate translation is done in the bit-setting loop below. */ /* The SVR4 compiler on the 3B2 had trouble with unsigned const char *. */ range_start = ((const unsigned char *) p)[-2]; range_end = ((const unsigned char *) p)[0]; /* Have to increment the pointer into the pattern string, so the caller isn't still at the ending character. */ (*p_ptr)++; /* If the start is after the end, the range is empty. */ if (range_start > range_end) return syntax & RE_NO_EMPTY_RANGES ? REG_ERANGE : REG_NOERROR; /* Here we see why `this_char' has to be larger than an `unsigned char' -- the range is inclusive, so if `range_end' == 0xff (assuming 8-bit characters), we would otherwise go into an infinite loop, since all characters <= 0xff. */ for (this_char = range_start; this_char <= range_end; this_char++) { SET_LIST_BIT (TRANSLATE (this_char)); } return REG_NOERROR; } /* re_compile_fastmap computes a ``fastmap'' for the compiled pattern in BUFP. A fastmap records which of the (1 << BYTEWIDTH) possible characters can start a string that matches the pattern. This fastmap is used by re_search to skip quickly over impossible starting points. The caller must supply the address of a (1 << BYTEWIDTH)-byte data area as BUFP->fastmap. We set the `fastmap', `fastmap_accurate', and `can_be_null' fields in the pattern buffer. Returns 0 if we succeed, -2 if an internal error. */ int re_compile_fastmap (bufp) struct re_pattern_buffer *bufp; { int j, k; #ifdef MATCH_MAY_ALLOCATE fail_stack_type fail_stack; #endif #ifndef REGEX_MALLOC char *destination; #endif /* We don't push any register information onto the failure stack. */ unsigned num_regs = 0; register char *fastmap = bufp->fastmap; unsigned char *pattern = bufp->buffer; unsigned long size = bufp->used; unsigned char *p = pattern; register unsigned char *pend = pattern + size; /* This holds the pointer to the failure stack, when it is allocated relocatably. */ fail_stack_elt_t *failure_stack_ptr; /* Assume that each path through the pattern can be null until proven otherwise. We set this false at the bottom of switch statement, to which we get only if a particular path doesn't match the empty string. */ boolean path_can_be_null = true; /* We aren't doing a `succeed_n' to begin with. */ boolean succeed_n_p = false; assert (fastmap != NULL && p != NULL); INIT_FAIL_STACK (); bzero (fastmap, 1 << BYTEWIDTH); /* Assume nothing's valid. */ bufp->fastmap_accurate = 1; /* It will be when we're done. */ bufp->can_be_null = 0; while (1) { if (p == pend || *p == succeed) { /* We have reached the (effective) end of pattern. */ if (!FAIL_STACK_EMPTY ()) { bufp->can_be_null |= path_can_be_null; /* Reset for next path. */ path_can_be_null = true; p = fail_stack.stack[--fail_stack.avail].pointer; continue; } else break; } /* We should never be about to go beyond the end of the pattern. */ assert (p < pend); switch (SWITCH_ENUM_CAST ((re_opcode_t) *p++)) { /* I guess the idea here is to simply not bother with a fastmap if a backreference is used, since it's too hard to figure out the fastmap for the corresponding group. Setting `can_be_null' stops `re_search_2' from using the fastmap, so that is all we do. */ case duplicate: bufp->can_be_null = 1; goto done; /* Following are the cases which match a character. These end with `break'. */ case exactn: fastmap[p[1]] = 1; break; case charset: for (j = *p++ * BYTEWIDTH - 1; j >= 0; j--) if (p[j / BYTEWIDTH] & (1 << (j % BYTEWIDTH))) fastmap[j] = 1; break; case charset_not: /* Chars beyond end of map must be allowed. */ for (j = *p * BYTEWIDTH; j < (1 << BYTEWIDTH); j++) fastmap[j] = 1; for (j = *p++ * BYTEWIDTH - 1; j >= 0; j--) if (!(p[j / BYTEWIDTH] & (1 << (j % BYTEWIDTH)))) fastmap[j] = 1; break; case wordchar: for (j = 0; j < (1 << BYTEWIDTH); j++) if (SYNTAX (j) == Sword) fastmap[j] = 1; break; case notwordchar: for (j = 0; j < (1 << BYTEWIDTH); j++) if (SYNTAX (j) != Sword) fastmap[j] = 1; break; case anychar: { int fastmap_newline = fastmap['\n']; /* `.' matches anything ... */ for (j = 0; j < (1 << BYTEWIDTH); j++) fastmap[j] = 1; /* ... except perhaps newline. */ if (!(bufp->syntax & RE_DOT_NEWLINE)) fastmap['\n'] = fastmap_newline; /* Return if we have already set `can_be_null'; if we have, then the fastmap is irrelevant. Something's wrong here. */ else if (bufp->can_be_null) goto done; /* Otherwise, have to check alternative paths. */ break; } #ifdef emacs case syntaxspec: k = *p++; for (j = 0; j < (1 << BYTEWIDTH); j++) if (SYNTAX (j) == (enum syntaxcode) k) fastmap[j] = 1; break; case notsyntaxspec: k = *p++; for (j = 0; j < (1 << BYTEWIDTH); j++) if (SYNTAX (j) != (enum syntaxcode) k) fastmap[j] = 1; break; /* All cases after this match the empty string. These end with `continue'. */ case before_dot: case at_dot: case after_dot: continue; #endif /* emacs */ case no_op: case begline: case endline: case begbuf: case endbuf: case wordbound: case notwordbound: case wordbeg: case wordend: case push_dummy_failure: continue; case jump_n: case pop_failure_jump: case maybe_pop_jump: case jump: case jump_past_alt: case dummy_failure_jump: EXTRACT_NUMBER_AND_INCR (j, p); p += j; if (j > 0) continue; /* Jump backward implies we just went through the body of a loop and matched nothing. Opcode jumped to should be `on_failure_jump' or `succeed_n'. Just treat it like an ordinary jump. For a * loop, it has pushed its failure point already; if so, discard that as redundant. */ if ((re_opcode_t) *p != on_failure_jump && (re_opcode_t) *p != succeed_n) continue; p++; EXTRACT_NUMBER_AND_INCR (j, p); p += j; /* If what's on the stack is where we are now, pop it. */ if (!FAIL_STACK_EMPTY () && fail_stack.stack[fail_stack.avail - 1].pointer == p) fail_stack.avail--; continue; case on_failure_jump: case on_failure_keep_string_jump: handle_on_failure_jump: EXTRACT_NUMBER_AND_INCR (j, p); /* For some patterns, e.g., `(a?)?', `p+j' here points to the end of the pattern. We don't want to push such a point, since when we restore it above, entering the switch will increment `p' past the end of the pattern. We don't need to push such a point since we obviously won't find any more fastmap entries beyond `pend'. Such a pattern can match the null string, though. */ if (p + j < pend) { if (!PUSH_PATTERN_OP (p + j, fail_stack)) { RESET_FAIL_STACK (); return -2; } } else bufp->can_be_null = 1; if (succeed_n_p) { EXTRACT_NUMBER_AND_INCR (k, p); /* Skip the n. */ succeed_n_p = false; } continue; case succeed_n: /* Get to the number of times to succeed. */ p += 2; /* Increment p past the n for when k != 0. */ EXTRACT_NUMBER_AND_INCR (k, p); if (k == 0) { p -= 4; succeed_n_p = true; /* Spaghetti code alert. */ goto handle_on_failure_jump; } continue; case set_number_at: p += 4; continue; case start_memory: case stop_memory: p += 2; continue; default: abort (); /* We have listed all the cases. */ } /* switch *p++ */ /* Getting here means we have found the possible starting characters for one path of the pattern -- and that the empty string does not match. We need not follow this path further. Instead, look at the next alternative (remembered on the stack), or quit if no more. The test at the top of the loop does these things. */ path_can_be_null = false; p = pend; } /* while p */ /* Set `can_be_null' for the last path (also the first path, if the pattern is empty). */ bufp->can_be_null |= path_can_be_null; done: RESET_FAIL_STACK (); return 0; } /* re_compile_fastmap */ /* Set REGS to hold NUM_REGS registers, storing them in STARTS and ENDS. Subsequent matches using PATTERN_BUFFER and REGS will use this memory for recording register information. STARTS and ENDS must be allocated using the malloc library routine, and must each be at least NUM_REGS * sizeof (regoff_t) bytes long. If NUM_REGS == 0, then subsequent matches should allocate their own register data. Unless this function is called, the first search or match using PATTERN_BUFFER will allocate its own register data, without freeing the old data. */ void re_set_registers (bufp, regs, num_regs, starts, ends) struct re_pattern_buffer *bufp; struct re_registers *regs; unsigned num_regs; regoff_t *starts, *ends; { if (num_regs) { bufp->regs_allocated = REGS_REALLOCATE; regs->num_regs = num_regs; regs->start = starts; regs->end = ends; } else { bufp->regs_allocated = REGS_UNALLOCATED; regs->num_regs = 0; regs->start = regs->end = (regoff_t *) 0; } } /* Searching routines. */ /* Like re_search_2, below, but only one string is specified, and doesn't let you say where to stop matching. */ int re_search (bufp, string, size, startpos, range, regs) struct re_pattern_buffer *bufp; const char *string; int size, startpos, range; struct re_registers *regs; { return re_search_2 (bufp, NULL, 0, string, size, startpos, range, regs, size); } /* Using the compiled pattern in BUFP->buffer, first tries to match the virtual concatenation of STRING1 and STRING2, starting first at index STARTPOS, then at STARTPOS + 1, and so on. STRING1 and STRING2 have length SIZE1 and SIZE2, respectively. RANGE is how far to scan while trying to match. RANGE = 0 means try only at STARTPOS; in general, the last start tried is STARTPOS + RANGE. In REGS, return the indices of the virtual concatenation of STRING1 and STRING2 that matched the entire BUFP->buffer and its contained subexpressions. Do not consider matching one past the index STOP in the virtual concatenation of STRING1 and STRING2. We return either the position in the strings at which the match was found, -1 if no match, or -2 if error (such as failure stack overflow). */ int re_search_2 (bufp, string1, size1, string2, size2, startpos, range, regs, stop) struct re_pattern_buffer *bufp; const char *string1, *string2; int size1, size2; int startpos; int range; struct re_registers *regs; int stop; { int val; register char *fastmap = bufp->fastmap; register RE_TRANSLATE_TYPE translate = bufp->translate; int total_size = size1 + size2; int endpos = startpos + range; /* Check for out-of-range STARTPOS. */ if (startpos < 0 || startpos > total_size) return -1; /* Fix up RANGE if it might eventually take us outside the virtual concatenation of STRING1 and STRING2. Make sure we won't move STARTPOS below 0 or above TOTAL_SIZE. */ if (endpos < 0) range = 0 - startpos; else if (endpos > total_size) range = total_size - startpos; /* If the search isn't to be a backwards one, don't waste time in a search for a pattern that must be anchored. */ if (bufp->used > 0 && (re_opcode_t) bufp->buffer[0] == begbuf && range > 0) { if (startpos > 0) return -1; else range = 1; } #ifdef emacs /* In a forward search for something that starts with \=. don't keep searching past point. */ if (bufp->used > 0 && (re_opcode_t) bufp->buffer[0] == at_dot && range > 0) { range = PT - startpos; if (range <= 0) return -1; } #endif /* emacs */ /* Update the fastmap now if not correct already. */ if (fastmap && !bufp->fastmap_accurate) if (re_compile_fastmap (bufp) == -2) return -2; /* Loop through the string, looking for a place to start matching. */ for (;;) { /* If a fastmap is supplied, skip quickly over characters that cannot be the start of a match. If the pattern can match the null string, however, we don't need to skip characters; we want the first null string. */ if (fastmap && startpos < total_size && !bufp->can_be_null) { if (range > 0) /* Searching forwards. */ { register const char *d; register int lim = 0; int irange = range; if (startpos < size1 && startpos + range >= size1) lim = range - (size1 - startpos); d = (startpos >= size1 ? string2 - size1 : string1) + startpos; /* Written out as an if-else to avoid testing `translate' inside the loop. */ if (translate) while (range > lim && !fastmap[(unsigned char) translate[(unsigned char) *d++]]) range--; else while (range > lim && !fastmap[(unsigned char) *d++]) range--; startpos += irange - range; } else /* Searching backwards. */ { register char c = (size1 == 0 || startpos >= size1 ? string2[startpos - size1] : string1[startpos]); if (!fastmap[(unsigned char) TRANSLATE (c)]) goto advance; } } /* If can't match the null string, and that's all we have left, fail. */ if (range >= 0 && startpos == total_size && fastmap && !bufp->can_be_null) return -1; val = re_match_2_internal (bufp, string1, size1, string2, size2, startpos, regs, stop); #ifndef REGEX_MALLOC #ifdef C_ALLOCA alloca (0); #endif #endif if (val >= 0) return startpos; if (val == -2) return -2; advance: if (!range) break; else if (range > 0) { range--; startpos++; } else { range++; startpos--; } } return -1; } /* re_search_2 */ /* Declarations and macros for re_match_2. */ static int bcmp_translate (); static boolean alt_match_null_string_p (), common_op_match_null_string_p (), group_match_null_string_p (); /* This converts PTR, a pointer into one of the search strings `string1' and `string2' into an offset from the beginning of that string. */ #define POINTER_TO_OFFSET(ptr) \ (FIRST_STRING_P (ptr) \ ? ((regoff_t) ((ptr) - string1)) \ : ((regoff_t) ((ptr) - string2 + size1))) /* Macros for dealing with the split strings in re_match_2. */ #define MATCHING_IN_FIRST_STRING (dend == end_match_1) /* Call before fetching a character with *d. This switches over to string2 if necessary. */ #define PREFETCH() \ while (d == dend) \ { \ /* End of string2 => fail. */ \ if (dend == end_match_2) \ goto fail; \ /* End of string1 => advance to string2. */ \ d = string2; \ dend = end_match_2; \ } /* Test if at very beginning or at very end of the virtual concatenation of `string1' and `string2'. If only one string, it's `string2'. */ #define AT_STRINGS_BEG(d) ((d) == (size1 ? string1 : string2) || !size2) #define AT_STRINGS_END(d) ((d) == end2) /* Test if D points to a character which is word-constituent. We have two special cases to check for: if past the end of string1, look at the first character in string2; and if before the beginning of string2, look at the last character in string1. */ #define WORDCHAR_P(d) \ (SYNTAX ((d) == end1 ? *string2 \ : (d) == string2 - 1 ? *(end1 - 1) : *(d)) \ == Sword) /* Test if the character before D and the one at D differ with respect to being word-constituent. */ #define AT_WORD_BOUNDARY(d) \ (AT_STRINGS_BEG (d) || AT_STRINGS_END (d) \ || WORDCHAR_P (d - 1) != WORDCHAR_P (d)) /* Free everything we malloc. */ #ifdef MATCH_MAY_ALLOCATE #define FREE_VAR(var) if (var) REGEX_FREE (var); var = NULL #define FREE_VARIABLES() \ do { \ REGEX_FREE_STACK (fail_stack.stack); \ FREE_VAR (regstart); \ FREE_VAR (regend); \ FREE_VAR (old_regstart); \ FREE_VAR (old_regend); \ FREE_VAR (best_regstart); \ FREE_VAR (best_regend); \ FREE_VAR (reg_info); \ FREE_VAR (reg_dummy); \ FREE_VAR (reg_info_dummy); \ } while (0) #else #define FREE_VARIABLES() ((void)0) /* Do nothing! But inhibit gcc warning. */ #endif /* not MATCH_MAY_ALLOCATE */ /* These values must meet several constraints. They must not be valid register values; since we have a limit of 255 registers (because we use only one byte in the pattern for the register number), we can use numbers larger than 255. They must differ by 1, because of NUM_FAILURE_ITEMS above. And the value for the lowest register must be larger than the value for the highest register, so we do not try to actually save any registers when none are active. */ #define NO_HIGHEST_ACTIVE_REG (1 << BYTEWIDTH) #define NO_LOWEST_ACTIVE_REG (NO_HIGHEST_ACTIVE_REG + 1) /* Matching routines. */ #ifndef emacs /* Emacs never uses this. */ /* re_match is like re_match_2 except it takes only a single string. */ int re_match (bufp, string, size, pos, regs) struct re_pattern_buffer *bufp; const char *string; int size, pos; struct re_registers *regs; { int result = re_match_2_internal (bufp, NULL, 0, string, size, pos, regs, size); alloca (0); return result; } #endif /* not emacs */ /* re_match_2 matches the compiled pattern in BUFP against the the (virtual) concatenation of STRING1 and STRING2 (of length SIZE1 and SIZE2, respectively). We start matching at POS, and stop matching at STOP. If REGS is non-null and the `no_sub' field of BUFP is nonzero, we store offsets for the substring each group matched in REGS. See the documentation for exactly how many groups we fill. We return -1 if no match, -2 if an internal error (such as the failure stack overflowing). Otherwise, we return the length of the matched substring. */ int re_match_2 (bufp, string1, size1, string2, size2, pos, regs, stop) struct re_pattern_buffer *bufp; const char *string1, *string2; int size1, size2; int pos; struct re_registers *regs; int stop; { int result = re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop); alloca (0); return result; } /* This is a separate function so that we can force an alloca cleanup afterwards. */ static int re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) struct re_pattern_buffer *bufp; const char *string1, *string2; int size1, size2; int pos; struct re_registers *regs; int stop; { /* General temporaries. */ int mcnt; unsigned char *p1; /* Just past the end of the corresponding string. */ const char *end1, *end2; /* Pointers into string1 and string2, just past the last characters in each to consider matching. */ const char *end_match_1, *end_match_2; /* Where we are in the data, and the end of the current string. */ const char *d, *dend; /* Where we are in the pattern, and the end of the pattern. */ unsigned char *p = bufp->buffer; register unsigned char *pend = p + bufp->used; /* Mark the opcode just after a start_memory, so we can test for an empty subpattern when we get to the stop_memory. */ unsigned char *just_past_start_mem = 0; /* We use this to map every character in the string. */ RE_TRANSLATE_TYPE translate = bufp->translate; /* Failure point stack. Each place that can handle a failure further down the line pushes a failure point on this stack. It consists of restart, regend, and reg_info for all registers corresponding to the subexpressions we're currently inside, plus the number of such registers, and, finally, two char *'s. The first char * is where to resume scanning the pattern; the second one is where to resume scanning the strings. If the latter is zero, the failure point is a ``dummy''; if a failure happens and the failure point is a dummy, it gets discarded and the next next one is tried. */ #ifdef MATCH_MAY_ALLOCATE /* otherwise, this is global. */ fail_stack_type fail_stack; #endif #ifdef DEBUG static unsigned failure_id = 0; unsigned nfailure_points_pushed = 0, nfailure_points_popped = 0; #endif /* This holds the pointer to the failure stack, when it is allocated relocatably. */ fail_stack_elt_t *failure_stack_ptr; /* We fill all the registers internally, independent of what we return, for use in backreferences. The number here includes an element for register zero. */ unsigned num_regs = bufp->re_nsub + 1; /* The currently active registers. */ unsigned lowest_active_reg = NO_LOWEST_ACTIVE_REG; unsigned highest_active_reg = NO_HIGHEST_ACTIVE_REG; /* Information on the contents of registers. These are pointers into the input strings; they record just what was matched (on this attempt) by a subexpression part of the pattern, that is, the regnum-th regstart pointer points to where in the pattern we began matching and the regnum-th regend points to right after where we stopped matching the regnum-th subexpression. (The zeroth register keeps track of what the whole pattern matches.) */ #ifdef MATCH_MAY_ALLOCATE /* otherwise, these are global. */ const char **regstart, **regend; #endif /* If a group that's operated upon by a repetition operator fails to match anything, then the register for its start will need to be restored because it will have been set to wherever in the string we are when we last see its open-group operator. Similarly for a register's end. */ #ifdef MATCH_MAY_ALLOCATE /* otherwise, these are global. */ const char **old_regstart, **old_regend; #endif /* The is_active field of reg_info helps us keep track of which (possibly nested) subexpressions we are currently in. The matched_something field of reg_info[reg_num] helps us tell whether or not we have matched any of the pattern so far this time through the reg_num-th subexpression. These two fields get reset each time through any loop their register is in. */ #ifdef MATCH_MAY_ALLOCATE /* otherwise, this is global. */ register_info_type *reg_info; #endif /* The following record the register info as found in the above variables when we find a match better than any we've seen before. This happens as we backtrack through the failure points, which in turn happens only if we have not yet matched the entire string. */ unsigned best_regs_set = false; #ifdef MATCH_MAY_ALLOCATE /* otherwise, these are global. */ const char **best_regstart, **best_regend; #endif /* Logically, this is `best_regend[0]'. But we don't want to have to allocate space for that if we're not allocating space for anything else (see below). Also, we never need info about register 0 for any of the other register vectors, and it seems rather a kludge to treat `best_regend' differently than the rest. So we keep track of the end of the best match so far in a separate variable. We initialize this to NULL so that when we backtrack the first time and need to test it, it's not garbage. */ const char *match_end = NULL; /* This helps SET_REGS_MATCHED avoid doing redundant work. */ int set_regs_matched_done = 0; /* Used when we pop values we don't care about. */ #ifdef MATCH_MAY_ALLOCATE /* otherwise, these are global. */ const char **reg_dummy; register_info_type *reg_info_dummy; #endif #ifdef DEBUG /* Counts the total number of registers pushed. */ unsigned num_regs_pushed = 0; #endif DEBUG_PRINT1 ("\n\nEntering re_match_2.\n"); INIT_FAIL_STACK (); #ifdef MATCH_MAY_ALLOCATE /* Do not bother to initialize all the register variables if there are no groups in the pattern, as it takes a fair amount of time. If there are groups, we include space for register 0 (the whole pattern), even though we never use it, since it simplifies the array indexing. We should fix this. */ if (bufp->re_nsub) { regstart = REGEX_TALLOC (num_regs, const char *); regend = REGEX_TALLOC (num_regs, const char *); old_regstart = REGEX_TALLOC (num_regs, const char *); old_regend = REGEX_TALLOC (num_regs, const char *); best_regstart = REGEX_TALLOC (num_regs, const char *); best_regend = REGEX_TALLOC (num_regs, const char *); reg_info = REGEX_TALLOC (num_regs, register_info_type); reg_dummy = REGEX_TALLOC (num_regs, const char *); reg_info_dummy = REGEX_TALLOC (num_regs, register_info_type); if (!(regstart && regend && old_regstart && old_regend && reg_info && best_regstart && best_regend && reg_dummy && reg_info_dummy)) { FREE_VARIABLES (); return -2; } } else { /* We must initialize all our variables to NULL, so that `FREE_VARIABLES' doesn't try to free them. */ regstart = regend = old_regstart = old_regend = best_regstart = best_regend = reg_dummy = NULL; reg_info = reg_info_dummy = (register_info_type *) NULL; } #endif /* MATCH_MAY_ALLOCATE */ /* The starting position is bogus. */ if (pos < 0 || pos > size1 + size2) { FREE_VARIABLES (); return -1; } /* Initialize subexpression text positions to -1 to mark ones that no start_memory/stop_memory has been seen for. Also initialize the register information struct. */ for (mcnt = 1; mcnt < num_regs; mcnt++) { regstart[mcnt] = regend[mcnt] = old_regstart[mcnt] = old_regend[mcnt] = REG_UNSET_VALUE; REG_MATCH_NULL_STRING_P (reg_info[mcnt]) = MATCH_NULL_UNSET_VALUE; IS_ACTIVE (reg_info[mcnt]) = 0; MATCHED_SOMETHING (reg_info[mcnt]) = 0; EVER_MATCHED_SOMETHING (reg_info[mcnt]) = 0; } /* We move `string1' into `string2' if the latter's empty -- but not if `string1' is null. */ if (size2 == 0 && string1 != NULL) { string2 = string1; size2 = size1; string1 = 0; size1 = 0; } end1 = string1 + size1; end2 = string2 + size2; /* Compute where to stop matching, within the two strings. */ if (stop <= size1) { end_match_1 = string1 + stop; end_match_2 = string2; } else { end_match_1 = end1; end_match_2 = string2 + stop - size1; } /* `p' scans through the pattern as `d' scans through the data. `dend' is the end of the input string that `d' points within. `d' is advanced into the following input string whenever necessary, but this happens before fetching; therefore, at the beginning of the loop, `d' can be pointing at the end of a string, but it cannot equal `string2'. */ if (size1 > 0 && pos <= size1) { d = string1 + pos; dend = end_match_1; } else { d = string2 + pos - size1; dend = end_match_2; } DEBUG_PRINT1 ("The compiled pattern is: "); DEBUG_PRINT_COMPILED_PATTERN (bufp, p, pend); DEBUG_PRINT1 ("The string to match is: `"); DEBUG_PRINT_DOUBLE_STRING (d, string1, size1, string2, size2); DEBUG_PRINT1 ("'\n"); /* This loops over pattern commands. It exits by returning from the function if the match is complete, or it drops through if the match fails at this starting point in the input data. */ for (;;) { DEBUG_PRINT2 ("\n0x%x: ", p); if (p == pend) { /* End of pattern means we might have succeeded. */ DEBUG_PRINT1 ("end of pattern ... "); /* If we haven't matched the entire string, and we want the longest match, try backtracking. */ if (d != end_match_2) { /* 1 if this match ends in the same string (string1 or string2) as the best previous match. */ boolean same_str_p = (FIRST_STRING_P (match_end) == MATCHING_IN_FIRST_STRING); /* 1 if this match is the best seen so far. */ boolean best_match_p; /* AIX compiler got confused when this was combined with the previous declaration. */ if (same_str_p) best_match_p = d > match_end; else best_match_p = !MATCHING_IN_FIRST_STRING; DEBUG_PRINT1 ("backtracking.\n"); if (!FAIL_STACK_EMPTY ()) { /* More failure points to try. */ /* If exceeds best match so far, save it. */ if (!best_regs_set || best_match_p) { best_regs_set = true; match_end = d; DEBUG_PRINT1 ("\nSAVING match as best so far.\n"); for (mcnt = 1; mcnt < num_regs; mcnt++) { best_regstart[mcnt] = regstart[mcnt]; best_regend[mcnt] = regend[mcnt]; } } goto fail; } /* If no failure points, don't restore garbage. And if last match is real best match, don't restore second best one. */ else if (best_regs_set && !best_match_p) { restore_best_regs: /* Restore best match. It may happen that `dend == end_match_1' while the restored d is in string2. For example, the pattern `x.*y.*z' against the strings `x-' and `y-z-', if the two strings are not consecutive in memory. */ DEBUG_PRINT1 ("Restoring best registers.\n"); d = match_end; dend = ((d >= string1 && d <= end1) ? end_match_1 : end_match_2); for (mcnt = 1; mcnt < num_regs; mcnt++) { regstart[mcnt] = best_regstart[mcnt]; regend[mcnt] = best_regend[mcnt]; } } } /* d != end_match_2 */ succeed_label: DEBUG_PRINT1 ("Accepting match.\n"); /* If caller wants register contents data back, do it. */ if (regs && !bufp->no_sub) { /* Have the register data arrays been allocated? */ if (bufp->regs_allocated == REGS_UNALLOCATED) { /* No. So allocate them with malloc. We need one extra element beyond `num_regs' for the `-1' marker GNU code uses. */ regs->num_regs = MAX (RE_NREGS, num_regs + 1); regs->start = TALLOC (regs->num_regs, regoff_t); regs->end = TALLOC (regs->num_regs, regoff_t); if (regs->start == NULL || regs->end == NULL) { FREE_VARIABLES (); return -2; } bufp->regs_allocated = REGS_REALLOCATE; } else if (bufp->regs_allocated == REGS_REALLOCATE) { /* Yes. If we need more elements than were already allocated, reallocate them. If we need fewer, just leave it alone. */ if (regs->num_regs < num_regs + 1) { regs->num_regs = num_regs + 1; RETALLOC (regs->start, regs->num_regs, regoff_t); RETALLOC (regs->end, regs->num_regs, regoff_t); if (regs->start == NULL || regs->end == NULL) { FREE_VARIABLES (); return -2; } } } else { /* These braces fend off a "empty body in an else-statement" warning under GCC when assert expands to nothing. */ assert (bufp->regs_allocated == REGS_FIXED); } /* Convert the pointer data in `regstart' and `regend' to indices. Register zero has to be set differently, since we haven't kept track of any info for it. */ if (regs->num_regs > 0) { regs->start[0] = pos; regs->end[0] = (MATCHING_IN_FIRST_STRING ? ((regoff_t) (d - string1)) : ((regoff_t) (d - string2 + size1))); } /* Go through the first `min (num_regs, regs->num_regs)' registers, since that is all we initialized. */ for (mcnt = 1; mcnt < MIN (num_regs, regs->num_regs); mcnt++) { if (REG_UNSET (regstart[mcnt]) || REG_UNSET (regend[mcnt])) regs->start[mcnt] = regs->end[mcnt] = -1; else { regs->start[mcnt] = (regoff_t) POINTER_TO_OFFSET (regstart[mcnt]); regs->end[mcnt] = (regoff_t) POINTER_TO_OFFSET (regend[mcnt]); } } /* If the regs structure we return has more elements than were in the pattern, set the extra elements to -1. If we (re)allocated the registers, this is the case, because we always allocate enough to have at least one -1 at the end. */ for (mcnt = num_regs; mcnt < regs->num_regs; mcnt++) regs->start[mcnt] = regs->end[mcnt] = -1; } /* regs && !bufp->no_sub */ DEBUG_PRINT4 ("%u failure points pushed, %u popped (%u remain).\n", nfailure_points_pushed, nfailure_points_popped, nfailure_points_pushed - nfailure_points_popped); DEBUG_PRINT2 ("%u registers pushed.\n", num_regs_pushed); mcnt = d - pos - (MATCHING_IN_FIRST_STRING ? string1 : string2 - size1); DEBUG_PRINT2 ("Returning %d from re_match_2.\n", mcnt); FREE_VARIABLES (); return mcnt; } /* Otherwise match next pattern command. */ switch (SWITCH_ENUM_CAST ((re_opcode_t) *p++)) { /* Ignore these. Used to ignore the n of succeed_n's which currently have n == 0. */ case no_op: DEBUG_PRINT1 ("EXECUTING no_op.\n"); break; case succeed: DEBUG_PRINT1 ("EXECUTING succeed.\n"); goto succeed_label; /* Match the next n pattern characters exactly. The following byte in the pattern defines n, and the n bytes after that are the characters to match. */ case exactn: mcnt = *p++; DEBUG_PRINT2 ("EXECUTING exactn %d.\n", mcnt); /* This is written out as an if-else so we don't waste time testing `translate' inside the loop. */ if (translate) { do { PREFETCH (); if ((unsigned char) translate[(unsigned char) *d++] != (unsigned char) *p++) goto fail; } while (--mcnt); } else { do { PREFETCH (); if (*d++ != (char) *p++) goto fail; } while (--mcnt); } SET_REGS_MATCHED (); break; /* Match any character except possibly a newline or a null. */ case anychar: DEBUG_PRINT1 ("EXECUTING anychar.\n"); PREFETCH (); if ((!(bufp->syntax & RE_DOT_NEWLINE) && TRANSLATE (*d) == '\n') || (bufp->syntax & RE_DOT_NOT_NULL && TRANSLATE (*d) == '\000')) goto fail; SET_REGS_MATCHED (); DEBUG_PRINT2 (" Matched `%d'.\n", *d); d++; break; case charset: case charset_not: { register unsigned char c; boolean not = (re_opcode_t) *(p - 1) == charset_not; DEBUG_PRINT2 ("EXECUTING charset%s.\n", not ? "_not" : ""); PREFETCH (); c = TRANSLATE (*d); /* The character to match. */ /* Cast to `unsigned' instead of `unsigned char' in case the bit list is a full 32 bytes long. */ if (c < (unsigned) (*p * BYTEWIDTH) && p[1 + c / BYTEWIDTH] & (1 << (c % BYTEWIDTH))) not = !not; p += 1 + *p; if (!not) goto fail; SET_REGS_MATCHED (); d++; break; } /* The beginning of a group is represented by start_memory. The arguments are the register number in the next byte, and the number of groups inner to this one in the next. The text matched within the group is recorded (in the internal registers data structure) under the register number. */ case start_memory: DEBUG_PRINT3 ("EXECUTING start_memory %d (%d):\n", *p, p[1]); /* Find out if this group can match the empty string. */ p1 = p; /* To send to group_match_null_string_p. */ if (REG_MATCH_NULL_STRING_P (reg_info[*p]) == MATCH_NULL_UNSET_VALUE) REG_MATCH_NULL_STRING_P (reg_info[*p]) = group_match_null_string_p (&p1, pend, reg_info); /* Save the position in the string where we were the last time we were at this open-group operator in case the group is operated upon by a repetition operator, e.g., with `(a*)*b' against `ab'; then we want to ignore where we are now in the string in case this attempt to match fails. */ old_regstart[*p] = REG_MATCH_NULL_STRING_P (reg_info[*p]) ? REG_UNSET (regstart[*p]) ? d : regstart[*p] : regstart[*p]; DEBUG_PRINT2 (" old_regstart: %d\n", POINTER_TO_OFFSET (old_regstart[*p])); regstart[*p] = d; DEBUG_PRINT2 (" regstart: %d\n", POINTER_TO_OFFSET (regstart[*p])); IS_ACTIVE (reg_info[*p]) = 1; MATCHED_SOMETHING (reg_info[*p]) = 0; /* Clear this whenever we change the register activity status. */ set_regs_matched_done = 0; /* This is the new highest active register. */ highest_active_reg = *p; /* If nothing was active before, this is the new lowest active register. */ if (lowest_active_reg == NO_LOWEST_ACTIVE_REG) lowest_active_reg = *p; /* Move past the register number and inner group count. */ p += 2; just_past_start_mem = p; break; /* The stop_memory opcode represents the end of a group. Its arguments are the same as start_memory's: the register number, and the number of inner groups. */ case stop_memory: DEBUG_PRINT3 ("EXECUTING stop_memory %d (%d):\n", *p, p[1]); /* We need to save the string position the last time we were at this close-group operator in case the group is operated upon by a repetition operator, e.g., with `((a*)*(b*)*)*' against `aba'; then we want to ignore where we are now in the string in case this attempt to match fails. */ old_regend[*p] = REG_MATCH_NULL_STRING_P (reg_info[*p]) ? REG_UNSET (regend[*p]) ? d : regend[*p] : regend[*p]; DEBUG_PRINT2 (" old_regend: %d\n", POINTER_TO_OFFSET (old_regend[*p])); regend[*p] = d; DEBUG_PRINT2 (" regend: %d\n", POINTER_TO_OFFSET (regend[*p])); /* This register isn't active anymore. */ IS_ACTIVE (reg_info[*p]) = 0; /* Clear this whenever we change the register activity status. */ set_regs_matched_done = 0; /* If this was the only register active, nothing is active anymore. */ if (lowest_active_reg == highest_active_reg) { lowest_active_reg = NO_LOWEST_ACTIVE_REG; highest_active_reg = NO_HIGHEST_ACTIVE_REG; } else { /* We must scan for the new highest active register, since it isn't necessarily one less than now: consider (a(b)c(d(e)f)g). When group 3 ends, after the f), the new highest active register is 1. */ unsigned char r = *p - 1; while (r > 0 && !IS_ACTIVE (reg_info[r])) r--; /* If we end up at register zero, that means that we saved the registers as the result of an `on_failure_jump', not a `start_memory', and we jumped to past the innermost `stop_memory'. For example, in ((.)*) we save registers 1 and 2 as a result of the *, but when we pop back to the second ), we are at the stop_memory 1. Thus, nothing is active. */ if (r == 0) { lowest_active_reg = NO_LOWEST_ACTIVE_REG; highest_active_reg = NO_HIGHEST_ACTIVE_REG; } else highest_active_reg = r; } /* If just failed to match something this time around with a group that's operated on by a repetition operator, try to force exit from the ``loop'', and restore the register information for this group that we had before trying this last match. */ if ((!MATCHED_SOMETHING (reg_info[*p]) || just_past_start_mem == p - 1) && (p + 2) < pend) { boolean is_a_jump_n = false; p1 = p + 2; mcnt = 0; switch ((re_opcode_t) *p1++) { case jump_n: is_a_jump_n = true; case pop_failure_jump: case maybe_pop_jump: case jump: case dummy_failure_jump: EXTRACT_NUMBER_AND_INCR (mcnt, p1); if (is_a_jump_n) p1 += 2; break; default: /* do nothing */ ; } p1 += mcnt; /* If the next operation is a jump backwards in the pattern to an on_failure_jump right before the start_memory corresponding to this stop_memory, exit from the loop by forcing a failure after pushing on the stack the on_failure_jump's jump in the pattern, and d. */ if (mcnt < 0 && (re_opcode_t) *p1 == on_failure_jump && (re_opcode_t) p1[3] == start_memory && p1[4] == *p) { /* If this group ever matched anything, then restore what its registers were before trying this last failed match, e.g., with `(a*)*b' against `ab' for regstart[1], and, e.g., with `((a*)*(b*)*)*' against `aba' for regend[3]. Also restore the registers for inner groups for, e.g., `((a*)(b*))*' against `aba' (register 3 would otherwise get trashed). */ if (EVER_MATCHED_SOMETHING (reg_info[*p])) { unsigned r; EVER_MATCHED_SOMETHING (reg_info[*p]) = 0; /* Restore this and inner groups' (if any) registers. */ for (r = *p; r < *p + *(p + 1); r++) { regstart[r] = old_regstart[r]; /* xx why this test? */ if (old_regend[r] >= regstart[r]) regend[r] = old_regend[r]; } } p1++; EXTRACT_NUMBER_AND_INCR (mcnt, p1); PUSH_FAILURE_POINT (p1 + mcnt, d, -2); goto fail; } } /* Move past the register number and the inner group count. */ p += 2; break; /* \ has been turned into a `duplicate' command which is followed by the numeric value of as the register number. */ case duplicate: { register const char *d2, *dend2; int regno = *p++; /* Get which register to match against. */ DEBUG_PRINT2 ("EXECUTING duplicate %d.\n", regno); /* Can't back reference a group which we've never matched. */ if (REG_UNSET (regstart[regno]) || REG_UNSET (regend[regno])) goto fail; /* Where in input to try to start matching. */ d2 = regstart[regno]; /* Where to stop matching; if both the place to start and the place to stop matching are in the same string, then set to the place to stop, otherwise, for now have to use the end of the first string. */ dend2 = ((FIRST_STRING_P (regstart[regno]) == FIRST_STRING_P (regend[regno])) ? regend[regno] : end_match_1); for (;;) { /* If necessary, advance to next segment in register contents. */ while (d2 == dend2) { if (dend2 == end_match_2) break; if (dend2 == regend[regno]) break; /* End of string1 => advance to string2. */ d2 = string2; dend2 = regend[regno]; } /* At end of register contents => success */ if (d2 == dend2) break; /* If necessary, advance to next segment in data. */ PREFETCH (); /* How many characters left in this segment to match. */ mcnt = dend - d; /* Want how many consecutive characters we can match in one shot, so, if necessary, adjust the count. */ if (mcnt > dend2 - d2) mcnt = dend2 - d2; /* Compare that many; failure if mismatch, else move past them. */ if (translate ? bcmp_translate (d, d2, mcnt, translate) : bcmp (d, d2, mcnt)) goto fail; d += mcnt, d2 += mcnt; /* Do this because we've match some characters. */ SET_REGS_MATCHED (); } } break; /* begline matches the empty string at the beginning of the string (unless `not_bol' is set in `bufp'), and, if `newline_anchor' is set, after newlines. */ case begline: DEBUG_PRINT1 ("EXECUTING begline.\n"); if (AT_STRINGS_BEG (d)) { if (!bufp->not_bol) break; } else if (d[-1] == '\n' && bufp->newline_anchor) { break; } /* In all other cases, we fail. */ goto fail; /* endline is the dual of begline. */ case endline: DEBUG_PRINT1 ("EXECUTING endline.\n"); if (AT_STRINGS_END (d)) { if (!bufp->not_eol) break; } /* We have to ``prefetch'' the next character. */ else if ((d == end1 ? *string2 : *d) == '\n' && bufp->newline_anchor) { break; } goto fail; /* Match at the very beginning of the data. */ case begbuf: DEBUG_PRINT1 ("EXECUTING begbuf.\n"); if (AT_STRINGS_BEG (d)) break; goto fail; /* Match at the very end of the data. */ case endbuf: DEBUG_PRINT1 ("EXECUTING endbuf.\n"); if (AT_STRINGS_END (d)) break; goto fail; /* on_failure_keep_string_jump is used to optimize `.*\n'. It pushes NULL as the value for the string on the stack. Then `pop_failure_point' will keep the current value for the string, instead of restoring it. To see why, consider matching `foo\nbar' against `.*\n'. The .* matches the foo; then the . fails against the \n. But the next thing we want to do is match the \n against the \n; if we restored the string value, we would be back at the foo. Because this is used only in specific cases, we don't need to check all the things that `on_failure_jump' does, to make sure the right things get saved on the stack. Hence we don't share its code. The only reason to push anything on the stack at all is that otherwise we would have to change `anychar's code to do something besides goto fail in this case; that seems worse than this. */ case on_failure_keep_string_jump: DEBUG_PRINT1 ("EXECUTING on_failure_keep_string_jump"); EXTRACT_NUMBER_AND_INCR (mcnt, p); DEBUG_PRINT3 (" %d (to 0x%x):\n", mcnt, p + mcnt); PUSH_FAILURE_POINT (p + mcnt, NULL, -2); break; /* Uses of on_failure_jump: Each alternative starts with an on_failure_jump that points to the beginning of the next alternative. Each alternative except the last ends with a jump that in effect jumps past the rest of the alternatives. (They really jump to the ending jump of the following alternative, because tensioning these jumps is a hassle.) Repeats start with an on_failure_jump that points past both the repetition text and either the following jump or pop_failure_jump back to this on_failure_jump. */ case on_failure_jump: on_failure: DEBUG_PRINT1 ("EXECUTING on_failure_jump"); EXTRACT_NUMBER_AND_INCR (mcnt, p); DEBUG_PRINT3 (" %d (to 0x%x)", mcnt, p + mcnt); /* If this on_failure_jump comes right before a group (i.e., the original * applied to a group), save the information for that group and all inner ones, so that if we fail back to this point, the group's information will be correct. For example, in \(a*\)*\1, we need the preceding group, and in \(zz\(a*\)b*\)\2, we need the inner group. */ /* We can't use `p' to check ahead because we push a failure point to `p + mcnt' after we do this. */ p1 = p; /* We need to skip no_op's before we look for the start_memory in case this on_failure_jump is happening as the result of a completed succeed_n, as in \(a\)\{1,3\}b\1 against aba. */ while (p1 < pend && (re_opcode_t) *p1 == no_op) p1++; if (p1 < pend && (re_opcode_t) *p1 == start_memory) { /* We have a new highest active register now. This will get reset at the start_memory we are about to get to, but we will have saved all the registers relevant to this repetition op, as described above. */ highest_active_reg = *(p1 + 1) + *(p1 + 2); if (lowest_active_reg == NO_LOWEST_ACTIVE_REG) lowest_active_reg = *(p1 + 1); } DEBUG_PRINT1 (":\n"); PUSH_FAILURE_POINT (p + mcnt, d, -2); break; /* A smart repeat ends with `maybe_pop_jump'. We change it to either `pop_failure_jump' or `jump'. */ case maybe_pop_jump: EXTRACT_NUMBER_AND_INCR (mcnt, p); DEBUG_PRINT2 ("EXECUTING maybe_pop_jump %d.\n", mcnt); { register unsigned char *p2 = p; /* Compare the beginning of the repeat with what in the pattern follows its end. If we can establish that there is nothing that they would both match, i.e., that we would have to backtrack because of (as in, e.g., `a*a') then we can change to pop_failure_jump, because we'll never have to backtrack. This is not true in the case of alternatives: in `(a|ab)*' we do need to backtrack to the `ab' alternative (e.g., if the string was `ab'). But instead of trying to detect that here, the alternative has put on a dummy failure point which is what we will end up popping. */ /* Skip over open/close-group commands. If what follows this loop is a ...+ construct, look at what begins its body, since we will have to match at least one of that. */ while (1) { if (p2 + 2 < pend && ((re_opcode_t) *p2 == stop_memory || (re_opcode_t) *p2 == start_memory)) p2 += 3; else if (p2 + 6 < pend && (re_opcode_t) *p2 == dummy_failure_jump) p2 += 6; else break; } p1 = p + mcnt; /* p1[0] ... p1[2] are the `on_failure_jump' corresponding to the `maybe_finalize_jump' of this case. Examine what follows. */ /* If we're at the end of the pattern, we can change. */ if (p2 == pend) { /* Consider what happens when matching ":\(.*\)" against ":/". I don't really understand this code yet. */ p[-3] = (unsigned char) pop_failure_jump; DEBUG_PRINT1 (" End of pattern: change to `pop_failure_jump'.\n"); } else if ((re_opcode_t) *p2 == exactn || (bufp->newline_anchor && (re_opcode_t) *p2 == endline)) { register unsigned char c = *p2 == (unsigned char) endline ? '\n' : p2[2]; if ((re_opcode_t) p1[3] == exactn && p1[5] != c) { p[-3] = (unsigned char) pop_failure_jump; DEBUG_PRINT3 (" %c != %c => pop_failure_jump.\n", c, p1[5]); } else if ((re_opcode_t) p1[3] == charset || (re_opcode_t) p1[3] == charset_not) { int not = (re_opcode_t) p1[3] == charset_not; if (c < (unsigned char) (p1[4] * BYTEWIDTH) && p1[5 + c / BYTEWIDTH] & (1 << (c % BYTEWIDTH))) not = !not; /* `not' is equal to 1 if c would match, which means that we can't change to pop_failure_jump. */ if (!not) { p[-3] = (unsigned char) pop_failure_jump; DEBUG_PRINT1 (" No match => pop_failure_jump.\n"); } } } else if ((re_opcode_t) *p2 == charset) { #ifdef DEBUG register unsigned char c = *p2 == (unsigned char) endline ? '\n' : p2[2]; #endif if ((re_opcode_t) p1[3] == exactn && ! ((int) p2[1] * BYTEWIDTH > (int) p1[4] && (p2[1 + p1[4] / BYTEWIDTH] & (1 << (p1[4] % BYTEWIDTH))))) { p[-3] = (unsigned char) pop_failure_jump; DEBUG_PRINT3 (" %c != %c => pop_failure_jump.\n", c, p1[5]); } else if ((re_opcode_t) p1[3] == charset_not) { int idx; /* We win if the charset_not inside the loop lists every character listed in the charset after. */ for (idx = 0; idx < (int) p2[1]; idx++) if (! (p2[2 + idx] == 0 || (idx < (int) p1[4] && ((p2[2 + idx] & ~ p1[5 + idx]) == 0)))) break; if (idx == p2[1]) { p[-3] = (unsigned char) pop_failure_jump; DEBUG_PRINT1 (" No match => pop_failure_jump.\n"); } } else if ((re_opcode_t) p1[3] == charset) { int idx; /* We win if the charset inside the loop has no overlap with the one after the loop. */ for (idx = 0; idx < (int) p2[1] && idx < (int) p1[4]; idx++) if ((p2[2 + idx] & p1[5 + idx]) != 0) break; if (idx == p2[1] || idx == p1[4]) { p[-3] = (unsigned char) pop_failure_jump; DEBUG_PRINT1 (" No match => pop_failure_jump.\n"); } } } } p -= 2; /* Point at relative address again. */ if ((re_opcode_t) p[-1] != pop_failure_jump) { p[-1] = (unsigned char) jump; DEBUG_PRINT1 (" Match => jump.\n"); goto unconditional_jump; } /* Note fall through. */ /* The end of a simple repeat has a pop_failure_jump back to its matching on_failure_jump, where the latter will push a failure point. The pop_failure_jump takes off failure points put on by this pop_failure_jump's matching on_failure_jump; we got through the pattern to here from the matching on_failure_jump, so didn't fail. */ case pop_failure_jump: { /* We need to pass separate storage for the lowest and highest registers, even though we don't care about the actual values. Otherwise, we will restore only one register from the stack, since lowest will == highest in `pop_failure_point'. */ unsigned dummy_low_reg, dummy_high_reg; unsigned char *pdummy; const char *sdummy; DEBUG_PRINT1 ("EXECUTING pop_failure_jump.\n"); POP_FAILURE_POINT (sdummy, pdummy, dummy_low_reg, dummy_high_reg, reg_dummy, reg_dummy, reg_info_dummy); } /* Note fall through. */ /* Unconditionally jump (without popping any failure points). */ case jump: unconditional_jump: EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */ DEBUG_PRINT2 ("EXECUTING jump %d ", mcnt); p += mcnt; /* Do the jump. */ DEBUG_PRINT2 ("(to 0x%x).\n", p); break; /* We need this opcode so we can detect where alternatives end in `group_match_null_string_p' et al. */ case jump_past_alt: DEBUG_PRINT1 ("EXECUTING jump_past_alt.\n"); goto unconditional_jump; /* Normally, the on_failure_jump pushes a failure point, which then gets popped at pop_failure_jump. We will end up at pop_failure_jump, also, and with a pattern of, say, `a+', we are skipping over the on_failure_jump, so we have to push something meaningless for pop_failure_jump to pop. */ case dummy_failure_jump: DEBUG_PRINT1 ("EXECUTING dummy_failure_jump.\n"); /* It doesn't matter what we push for the string here. What the code at `fail' tests is the value for the pattern. */ PUSH_FAILURE_POINT (0, 0, -2); goto unconditional_jump; /* At the end of an alternative, we need to push a dummy failure point in case we are followed by a `pop_failure_jump', because we don't want the failure point for the alternative to be popped. For example, matching `(a|ab)*' against `aab' requires that we match the `ab' alternative. */ case push_dummy_failure: DEBUG_PRINT1 ("EXECUTING push_dummy_failure.\n"); /* See comments just above at `dummy_failure_jump' about the two zeroes. */ PUSH_FAILURE_POINT (0, 0, -2); break; /* Have to succeed matching what follows at least n times. After that, handle like `on_failure_jump'. */ case succeed_n: EXTRACT_NUMBER (mcnt, p + 2); DEBUG_PRINT2 ("EXECUTING succeed_n %d.\n", mcnt); assert (mcnt >= 0); /* Originally, this is how many times we HAVE to succeed. */ if (mcnt > 0) { mcnt--; p += 2; STORE_NUMBER_AND_INCR (p, mcnt); DEBUG_PRINT3 (" Setting 0x%x to %d.\n", p, mcnt); } else if (mcnt == 0) { DEBUG_PRINT2 (" Setting two bytes from 0x%x to no_op.\n", p+2); p[2] = (unsigned char) no_op; p[3] = (unsigned char) no_op; goto on_failure; } break; case jump_n: EXTRACT_NUMBER (mcnt, p + 2); DEBUG_PRINT2 ("EXECUTING jump_n %d.\n", mcnt); /* Originally, this is how many times we CAN jump. */ if (mcnt) { mcnt--; STORE_NUMBER (p + 2, mcnt); goto unconditional_jump; } /* If don't have to jump any more, skip over the rest of command. */ else p += 4; break; case set_number_at: { DEBUG_PRINT1 ("EXECUTING set_number_at.\n"); EXTRACT_NUMBER_AND_INCR (mcnt, p); p1 = p + mcnt; EXTRACT_NUMBER_AND_INCR (mcnt, p); DEBUG_PRINT3 (" Setting 0x%x to %d.\n", p1, mcnt); STORE_NUMBER (p1, mcnt); break; } case wordbound: DEBUG_PRINT1 ("EXECUTING wordbound.\n"); if (AT_WORD_BOUNDARY (d)) break; goto fail; case notwordbound: DEBUG_PRINT1 ("EXECUTING notwordbound.\n"); if (AT_WORD_BOUNDARY (d)) goto fail; break; case wordbeg: DEBUG_PRINT1 ("EXECUTING wordbeg.\n"); if (WORDCHAR_P (d) && (AT_STRINGS_BEG (d) || !WORDCHAR_P (d - 1))) break; goto fail; case wordend: DEBUG_PRINT1 ("EXECUTING wordend.\n"); if (!AT_STRINGS_BEG (d) && WORDCHAR_P (d - 1) && (!WORDCHAR_P (d) || AT_STRINGS_END (d))) break; goto fail; #ifdef emacs case before_dot: DEBUG_PRINT1 ("EXECUTING before_dot.\n"); if (PTR_CHAR_POS ((unsigned char *) d) >= point) goto fail; break; case at_dot: DEBUG_PRINT1 ("EXECUTING at_dot.\n"); if (PTR_CHAR_POS ((unsigned char *) d) != point) goto fail; break; case after_dot: DEBUG_PRINT1 ("EXECUTING after_dot.\n"); if (PTR_CHAR_POS ((unsigned char *) d) <= point) goto fail; break; case syntaxspec: DEBUG_PRINT2 ("EXECUTING syntaxspec %d.\n", mcnt); mcnt = *p++; goto matchsyntax; case wordchar: DEBUG_PRINT1 ("EXECUTING Emacs wordchar.\n"); mcnt = (int) Sword; matchsyntax: PREFETCH (); /* Can't use *d++ here; SYNTAX may be an unsafe macro. */ d++; if (SYNTAX (d[-1]) != (enum syntaxcode) mcnt) goto fail; SET_REGS_MATCHED (); break; case notsyntaxspec: DEBUG_PRINT2 ("EXECUTING notsyntaxspec %d.\n", mcnt); mcnt = *p++; goto matchnotsyntax; case notwordchar: DEBUG_PRINT1 ("EXECUTING Emacs notwordchar.\n"); mcnt = (int) Sword; matchnotsyntax: PREFETCH (); /* Can't use *d++ here; SYNTAX may be an unsafe macro. */ d++; if (SYNTAX (d[-1]) == (enum syntaxcode) mcnt) goto fail; SET_REGS_MATCHED (); break; #else /* not emacs */ case wordchar: DEBUG_PRINT1 ("EXECUTING non-Emacs wordchar.\n"); PREFETCH (); if (!WORDCHAR_P (d)) goto fail; SET_REGS_MATCHED (); d++; break; case notwordchar: DEBUG_PRINT1 ("EXECUTING non-Emacs notwordchar.\n"); PREFETCH (); if (WORDCHAR_P (d)) goto fail; SET_REGS_MATCHED (); d++; break; #endif /* not emacs */ default: abort (); } continue; /* Successfully executed one pattern command; keep going. */ /* We goto here if a matching operation fails. */ fail: if (!FAIL_STACK_EMPTY ()) { /* A restart point is known. Restore to that state. */ DEBUG_PRINT1 ("\nFAIL:\n"); POP_FAILURE_POINT (d, p, lowest_active_reg, highest_active_reg, regstart, regend, reg_info); /* If this failure point is a dummy, try the next one. */ if (!p) goto fail; /* If we failed to the end of the pattern, don't examine *p. */ assert (p <= pend); if (p < pend) { boolean is_a_jump_n = false; /* If failed to a backwards jump that's part of a repetition loop, need to pop this failure point and use the next one. */ switch ((re_opcode_t) *p) { case jump_n: is_a_jump_n = true; case maybe_pop_jump: case pop_failure_jump: case jump: p1 = p + 1; EXTRACT_NUMBER_AND_INCR (mcnt, p1); p1 += mcnt; if ((is_a_jump_n && (re_opcode_t) *p1 == succeed_n) || (!is_a_jump_n && (re_opcode_t) *p1 == on_failure_jump)) goto fail; break; default: /* do nothing */ ; } } if (d >= string1 && d <= end1) dend = end_match_1; } else break; /* Matching at this starting point really fails. */ } /* for (;;) */ if (best_regs_set) goto restore_best_regs; FREE_VARIABLES (); return -1; /* Failure to match. */ } /* re_match_2 */ /* Subroutine definitions for re_match_2. */ /* We are passed P pointing to a register number after a start_memory. Return true if the pattern up to the corresponding stop_memory can match the empty string, and false otherwise. If we find the matching stop_memory, sets P to point to one past its number. Otherwise, sets P to an undefined byte less than or equal to END. We don't handle duplicates properly (yet). */ static boolean group_match_null_string_p (p, end, reg_info) unsigned char **p, *end; register_info_type *reg_info; { int mcnt; /* Point to after the args to the start_memory. */ unsigned char *p1 = *p + 2; while (p1 < end) { /* Skip over opcodes that can match nothing, and return true or false, as appropriate, when we get to one that can't, or to the matching stop_memory. */ switch ((re_opcode_t) *p1) { /* Could be either a loop or a series of alternatives. */ case on_failure_jump: p1++; EXTRACT_NUMBER_AND_INCR (mcnt, p1); /* If the next operation is not a jump backwards in the pattern. */ if (mcnt >= 0) { /* Go through the on_failure_jumps of the alternatives, seeing if any of the alternatives cannot match nothing. The last alternative starts with only a jump, whereas the rest start with on_failure_jump and end with a jump, e.g., here is the pattern for `a|b|c': /on_failure_jump/0/6/exactn/1/a/jump_past_alt/0/6 /on_failure_jump/0/6/exactn/1/b/jump_past_alt/0/3 /exactn/1/c So, we have to first go through the first (n-1) alternatives and then deal with the last one separately. */ /* Deal with the first (n-1) alternatives, which start with an on_failure_jump (see above) that jumps to right past a jump_past_alt. */ while ((re_opcode_t) p1[mcnt-3] == jump_past_alt) { /* `mcnt' holds how many bytes long the alternative is, including the ending `jump_past_alt' and its number. */ if (!alt_match_null_string_p (p1, p1 + mcnt - 3, reg_info)) return false; /* Move to right after this alternative, including the jump_past_alt. */ p1 += mcnt; /* Break if it's the beginning of an n-th alternative that doesn't begin with an on_failure_jump. */ if ((re_opcode_t) *p1 != on_failure_jump) break; /* Still have to check that it's not an n-th alternative that starts with an on_failure_jump. */ p1++; EXTRACT_NUMBER_AND_INCR (mcnt, p1); if ((re_opcode_t) p1[mcnt-3] != jump_past_alt) { /* Get to the beginning of the n-th alternative. */ p1 -= 3; break; } } /* Deal with the last alternative: go back and get number of the `jump_past_alt' just before it. `mcnt' contains the length of the alternative. */ EXTRACT_NUMBER (mcnt, p1 - 2); if (!alt_match_null_string_p (p1, p1 + mcnt, reg_info)) return false; p1 += mcnt; /* Get past the n-th alternative. */ } /* if mcnt > 0 */ break; case stop_memory: assert (p1[1] == **p); *p = p1 + 2; return true; default: if (!common_op_match_null_string_p (&p1, end, reg_info)) return false; } } /* while p1 < end */ return false; } /* group_match_null_string_p */ /* Similar to group_match_null_string_p, but doesn't deal with alternatives: It expects P to be the first byte of a single alternative and END one byte past the last. The alternative can contain groups. */ static boolean alt_match_null_string_p (p, end, reg_info) unsigned char *p, *end; register_info_type *reg_info; { int mcnt; unsigned char *p1 = p; while (p1 < end) { /* Skip over opcodes that can match nothing, and break when we get to one that can't. */ switch ((re_opcode_t) *p1) { /* It's a loop. */ case on_failure_jump: p1++; EXTRACT_NUMBER_AND_INCR (mcnt, p1); p1 += mcnt; break; default: if (!common_op_match_null_string_p (&p1, end, reg_info)) return false; } } /* while p1 < end */ return true; } /* alt_match_null_string_p */ /* Deals with the ops common to group_match_null_string_p and alt_match_null_string_p. Sets P to one after the op and its arguments, if any. */ static boolean common_op_match_null_string_p (p, end, reg_info) unsigned char **p, *end; register_info_type *reg_info; { int mcnt; boolean ret; int reg_no; unsigned char *p1 = *p; switch ((re_opcode_t) *p1++) { case no_op: case begline: case endline: case begbuf: case endbuf: case wordbeg: case wordend: case wordbound: case notwordbound: #ifdef emacs case before_dot: case at_dot: case after_dot: #endif break; case start_memory: reg_no = *p1; assert (reg_no > 0 && reg_no <= MAX_REGNUM); ret = group_match_null_string_p (&p1, end, reg_info); /* Have to set this here in case we're checking a group which contains a group and a back reference to it. */ if (REG_MATCH_NULL_STRING_P (reg_info[reg_no]) == MATCH_NULL_UNSET_VALUE) REG_MATCH_NULL_STRING_P (reg_info[reg_no]) = ret; if (!ret) return false; break; /* If this is an optimized succeed_n for zero times, make the jump. */ case jump: EXTRACT_NUMBER_AND_INCR (mcnt, p1); if (mcnt >= 0) p1 += mcnt; else return false; break; case succeed_n: /* Get to the number of times to succeed. */ p1 += 2; EXTRACT_NUMBER_AND_INCR (mcnt, p1); if (mcnt == 0) { p1 -= 4; EXTRACT_NUMBER_AND_INCR (mcnt, p1); p1 += mcnt; } else return false; break; case duplicate: if (!REG_MATCH_NULL_STRING_P (reg_info[*p1])) return false; break; case set_number_at: p1 += 4; default: /* All other opcodes mean we cannot match the empty string. */ return false; } *p = p1; return true; } /* common_op_match_null_string_p */ /* Return zero if TRANSLATE[S1] and TRANSLATE[S2] are identical for LEN bytes; nonzero otherwise. */ static int bcmp_translate (s1, s2, len, translate) unsigned char *s1, *s2; register int len; RE_TRANSLATE_TYPE translate; { register unsigned char *p1 = s1, *p2 = s2; while (len) { if (translate[*p1++] != translate[*p2++]) return 1; len--; } return 0; } /* Entry points for GNU code. */ /* re_compile_pattern is the GNU regular expression compiler: it compiles PATTERN (of length SIZE) and puts the result in BUFP. Returns 0 if the pattern was valid, otherwise an error string. Assumes the `allocated' (and perhaps `buffer') and `translate' fields are set in BUFP on entry. We call regex_compile to do the actual compilation. */ const char * re_compile_pattern (pattern, length, bufp) const char *pattern; int length; struct re_pattern_buffer *bufp; { reg_errcode_t ret; /* GNU code is written to assume at least RE_NREGS registers will be set (and at least one extra will be -1). */ bufp->regs_allocated = REGS_UNALLOCATED; /* And GNU code determines whether or not to get register information by passing null for the REGS argument to re_match, etc., not by setting no_sub. */ bufp->no_sub = 0; /* Match anchors at newline. */ bufp->newline_anchor = 1; ret = regex_compile (pattern, length, re_syntax_options, bufp); if (!ret) return NULL; return gettext (re_error_msgid[(int) ret]); } /* Entry points compatible with 4.2 BSD regex library. We don't define them unless specifically requested. */ #ifdef _REGEX_RE_COMP /* BSD has one and only one pattern buffer. */ static struct re_pattern_buffer re_comp_buf; char * re_comp (s) const char *s; { reg_errcode_t ret; if (!s) { if (!re_comp_buf.buffer) return gettext ("No previous regular expression"); return 0; } if (!re_comp_buf.buffer) { re_comp_buf.buffer = (unsigned char *) malloc (200); if (re_comp_buf.buffer == NULL) return gettext (re_error_msgid[(int) REG_ESPACE]); re_comp_buf.allocated = 200; re_comp_buf.fastmap = (char *) malloc (1 << BYTEWIDTH); if (re_comp_buf.fastmap == NULL) return gettext (re_error_msgid[(int) REG_ESPACE]); } /* Since `re_exec' always passes NULL for the `regs' argument, we don't need to initialize the pattern buffer fields which affect it. */ /* Match anchors at newlines. */ re_comp_buf.newline_anchor = 1; ret = regex_compile (s, strlen (s), re_syntax_options, &re_comp_buf); if (!ret) return NULL; /* Yes, we're discarding `const' here if !HAVE_LIBINTL. */ return (char *) gettext (re_error_msgid[(int) ret]); } int re_exec (s) const char *s; { const int len = strlen (s); return 0 <= re_search (&re_comp_buf, s, len, 0, len, (struct re_registers *) 0); } #endif /* _REGEX_RE_COMP */ /* POSIX.2 functions. Don't define these for Emacs. */ #ifndef emacs /* regcomp takes a regular expression as a string and compiles it. PREG is a regex_t *. We do not expect any fields to be initialized, since POSIX says we shouldn't. Thus, we set `buffer' to the compiled pattern; `used' to the length of the compiled pattern; `syntax' to RE_SYNTAX_POSIX_EXTENDED if the REG_EXTENDED bit in CFLAGS is set; otherwise, to RE_SYNTAX_POSIX_BASIC; `newline_anchor' to REG_NEWLINE being set in CFLAGS; `fastmap' and `fastmap_accurate' to zero; `re_nsub' to the number of subexpressions in PATTERN. PATTERN is the address of the pattern string. CFLAGS is a series of bits which affect compilation. If REG_EXTENDED is set, we use POSIX extended syntax; otherwise, we use POSIX basic syntax. If REG_NEWLINE is set, then . and [^...] don't match newline. Also, regexec will try a match beginning after every newline. If REG_ICASE is set, then we considers upper- and lowercase versions of letters to be equivalent when matching. If REG_NOSUB is set, then when PREG is passed to regexec, that routine will report only success or failure, and nothing about the registers. It returns 0 if it succeeds, nonzero if it doesn't. (See regex.h for the return codes and their meanings.) */ int regcomp (preg, pattern, cflags) regex_t *preg; const char *pattern; int cflags; { reg_errcode_t ret; unsigned syntax = (cflags & REG_EXTENDED) ? RE_SYNTAX_POSIX_EXTENDED : RE_SYNTAX_POSIX_BASIC; /* regex_compile will allocate the space for the compiled pattern. */ preg->buffer = 0; preg->allocated = 0; preg->used = 0; /* Don't bother to use a fastmap when searching. This simplifies the REG_NEWLINE case: if we used a fastmap, we'd have to put all the characters after newlines into the fastmap. This way, we just try every character. */ preg->fastmap = 0; if (cflags & REG_ICASE) { unsigned i; preg->translate = (RE_TRANSLATE_TYPE) malloc (CHAR_SET_SIZE * sizeof (*(RE_TRANSLATE_TYPE)0)); if (preg->translate == NULL) return (int) REG_ESPACE; /* Map uppercase characters to corresponding lowercase ones. */ for (i = 0; i < CHAR_SET_SIZE; i++) preg->translate[i] = ISUPPER (i) ? tolower (i) : i; } else preg->translate = NULL; /* If REG_NEWLINE is set, newlines are treated differently. */ if (cflags & REG_NEWLINE) { /* REG_NEWLINE implies neither . nor [^...] match newline. */ syntax &= ~RE_DOT_NEWLINE; syntax |= RE_HAT_LISTS_NOT_NEWLINE; /* It also changes the matching behavior. */ preg->newline_anchor = 1; } else preg->newline_anchor = 0; preg->no_sub = !!(cflags & REG_NOSUB); /* POSIX says a null character in the pattern terminates it, so we can use strlen here in compiling the pattern. */ ret = regex_compile (pattern, strlen (pattern), syntax, preg); /* POSIX doesn't distinguish between an unmatched open-group and an unmatched close-group: both are REG_EPAREN. */ if (ret == REG_ERPAREN) ret = REG_EPAREN; return (int) ret; } /* regexec searches for a given pattern, specified by PREG, in the string STRING. If NMATCH is zero or REG_NOSUB was set in the cflags argument to `regcomp', we ignore PMATCH. Otherwise, we assume PMATCH has at least NMATCH elements, and we set them to the offsets of the corresponding matched substrings. EFLAGS specifies `execution flags' which affect matching: if REG_NOTBOL is set, then ^ does not match at the beginning of the string; if REG_NOTEOL is set, then $ does not match at the end. We return 0 if we find a match and REG_NOMATCH if not. */ int regexec (preg, string, nmatch, pmatch, eflags) const regex_t *preg; const char *string; size_t nmatch; regmatch_t pmatch[]; int eflags; { int ret; struct re_registers regs; regex_t private_preg; int len = strlen (string); boolean want_reg_info = !preg->no_sub && nmatch > 0; private_preg = *preg; private_preg.not_bol = !!(eflags & REG_NOTBOL); private_preg.not_eol = !!(eflags & REG_NOTEOL); /* The user has told us exactly how many registers to return information about, via `nmatch'. We have to pass that on to the matching routines. */ private_preg.regs_allocated = REGS_FIXED; if (want_reg_info) { regs.num_regs = nmatch; regs.start = TALLOC (nmatch, regoff_t); regs.end = TALLOC (nmatch, regoff_t); if (regs.start == NULL || regs.end == NULL) return (int) REG_NOMATCH; } /* Perform the searching operation. */ ret = re_search (&private_preg, string, len, /* start: */ 0, /* range: */ len, want_reg_info ? ®s : (struct re_registers *) 0); /* Copy the register information to the POSIX structure. */ if (want_reg_info) { if (ret >= 0) { unsigned r; for (r = 0; r < nmatch; r++) { pmatch[r].rm_so = regs.start[r]; pmatch[r].rm_eo = regs.end[r]; } } /* If we needed the temporary register info, free the space now. */ free (regs.start); free (regs.end); } /* We want zero return to mean success, unlike `re_search'. */ return ret >= 0 ? (int) REG_NOERROR : (int) REG_NOMATCH; } /* Returns a message corresponding to an error code, ERRCODE, returned from either regcomp or regexec. We don't use PREG here. */ size_t regerror (errcode, preg, errbuf, errbuf_size) int errcode; const regex_t *preg; char *errbuf; size_t errbuf_size; { const char *msg; size_t msg_size; if (errcode < 0 || errcode >= (sizeof (re_error_msgid) / sizeof (re_error_msgid[0]))) /* Only error codes returned by the rest of the code should be passed to this routine. If we are given anything else, or if other regex code generates an invalid error code, then the program has a bug. Dump core so we can fix it. */ abort (); msg = gettext (re_error_msgid[errcode]); msg_size = strlen (msg) + 1; /* Includes the null. */ if (errbuf_size != 0) { if (msg_size > errbuf_size) { strncpy (errbuf, msg, errbuf_size - 1); errbuf[errbuf_size - 1] = 0; } else strcpy (errbuf, msg); } return msg_size; } /* Free dynamically allocated space used by PREG. */ void regfree (preg) regex_t *preg; { if (preg->buffer != NULL) free (preg->buffer); preg->buffer = NULL; preg->allocated = 0; preg->used = 0; if (preg->fastmap != NULL) free (preg->fastmap); preg->fastmap = NULL; preg->fastmap_accurate = 0; if (preg->translate != NULL) free (preg->translate); preg->translate = NULL; } #endif /* not emacs */ /* Local variables: make-backup-files: t version-control: t trim-versions-without-asking: nil End: */ emacs-19.30/src/region-cache.c100444 75424 12 64520 5741120131 14464 0ustar kwzhstaff/* Caching facts about regions of the buffer, for optimization. Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1995 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. */ #include #include "lisp.h" #include "buffer.h" #include "region-cache.h" #include /* Data structures. */ /* The region cache. We want something that maps character positions in a buffer onto values. The representation should deal well with long runs of characters with the same value. The tricky part: the representation should be very cheap to maintain in the presence of many insertions and deletions. If the overhead of maintaining the cache is too high, the speedups it offers will be worthless. We represent the region cache as a sorted array of struct boundary's, each of which contains a buffer position and a value; the value applies to all the characters after the buffer position, until the position of the next boundary, or the end of the buffer. The cache always has a boundary whose position is BUF_BEG, so there's always a value associated with every character in the buffer. Since the cache is sorted, this is always the first element of the cache. To facilitate the insertion and deletion of boundaries in the cache, the cache has a gap, just like Emacs's text buffers do. To help boundary positions float along with insertions and deletions, all boundary positions before the cache gap are stored relative to BUF_BEG (buf) (thus they're >= 0), and all boundary positions after the gap are stored relative to BUF_Z (buf) (thus they're <= 0). Look at BOUNDARY_POS to see this in action. See revalidate_region_cache to see how this helps. */ struct boundary { int pos; int value; }; struct region_cache { /* A sorted array of locations where the known-ness of the buffer changes. */ struct boundary *boundaries; /* boundaries[gap_start ... gap_start + gap_len - 1] is the gap. */ int gap_start, gap_len; /* The number of elements allocated to boundaries, not including the gap. */ int cache_len; /* The areas that haven't changed since the last time we cleaned out invalid entries from the cache. These overlap when the buffer is entirely unchanged. */ int beg_unchanged, end_unchanged; /* The first and last positions in the buffer. Because boundaries store their positions relative to the start (BEG) and end (Z) of the buffer, knowing these positions allows us to accurately interpret positions without having to pass the buffer structure or its endpoints around all the time. Yes, buffer_beg is always 1. It's there for symmetry with buffer_end and the BEG and BUF_BEG macros. */ int buffer_beg, buffer_end; }; /* Return the position of boundary i in cache c. */ #define BOUNDARY_POS(c, i) \ ((i) < (c)->gap_start \ ? (c)->buffer_beg + (c)->boundaries[(i)].pos \ : (c)->buffer_end + (c)->boundaries[(c)->gap_len + (i)].pos) /* Return the value for text after boundary i in cache c. */ #define BOUNDARY_VALUE(c, i) \ ((i) < (c)->gap_start \ ? (c)->boundaries[(i)].value \ : (c)->boundaries[(c)->gap_len + (i)].value) /* Set the value for text after boundary i in cache c to v. */ #define SET_BOUNDARY_VALUE(c, i, v) \ ((i) < (c)->gap_start \ ? ((c)->boundaries[(i)].value = (v))\ : ((c)->boundaries[(c)->gap_len + (i)].value = (v))) /* How many elements to add to the gap when we resize the buffer. */ #define NEW_CACHE_GAP (40) /* See invalidate_region_cache; if an invalidation would throw away information about this many characters, call revalidate_region_cache before doing the new invalidation, to preserve that information, instead of throwing it away. */ #define PRESERVE_THRESHOLD (500) static void revalidate_region_cache (); /* Interface: Allocating, initializing, and disposing of region caches. */ struct region_cache * new_region_cache () { struct region_cache *c = (struct region_cache *) xmalloc (sizeof (struct region_cache)); c->gap_start = 0; c->gap_len = NEW_CACHE_GAP; c->cache_len = 0; c->boundaries = (struct boundary *) xmalloc ((c->gap_len + c->cache_len) * sizeof (*c->boundaries)); c->beg_unchanged = 0; c->end_unchanged = 0; c->buffer_beg = 1; c->buffer_end = 1; /* Insert the boundary for the buffer start. */ c->cache_len++; c->gap_len--; c->gap_start++; c->boundaries[0].pos = 0; /* from buffer_beg */ c->boundaries[0].value = 0; return c; } void free_region_cache (c) struct region_cache *c; { xfree (c->boundaries); xfree (c); } /* Finding positions in the cache. */ /* Return the index of the last boundary in cache C at or before POS. In other words, return the boundary that specifies the value for the region POS..(POS + 1). This operation should be logarithmic in the number of cache entries. It would be nice if it took advantage of locality of reference, too, by searching entries near the last entry found. */ static int find_cache_boundary (c, pos) struct region_cache *c; int pos; { int low = 0, high = c->cache_len; while (low + 1 < high) { /* mid is always a valid index, because low < high and ">> 1" rounds down. */ int mid = (low + high) >> 1; int boundary = BOUNDARY_POS (c, mid); if (pos < boundary) high = mid; else low = mid; } /* Some testing. */ if (BOUNDARY_POS (c, low) > pos || (low + 1 < c->cache_len && BOUNDARY_POS (c, low + 1) <= pos)) abort (); return low; } /* Moving the cache gap around, inserting, and deleting. */ /* Move the gap of cache C to index POS, and make sure it has space for at least MIN_SIZE boundaries. */ static void move_cache_gap (c, pos, min_size) struct region_cache *c; int pos; int min_size; { /* Copy these out of the cache and into registers. */ int gap_start = c->gap_start; int gap_len = c->gap_len; int buffer_beg = c->buffer_beg; int buffer_end = c->buffer_end; if (pos < 0 || pos > c->cache_len) abort (); /* We mustn't ever try to put the gap before the dummy start boundary. That must always be start-relative. */ if (pos == 0) abort (); /* Need we move the gap right? */ while (gap_start < pos) { /* Copy one boundary from after to before the gap, and convert its position to start-relative. */ c->boundaries[gap_start].pos = (buffer_end + c->boundaries[gap_start + gap_len].pos - buffer_beg); c->boundaries[gap_start].value = c->boundaries[gap_start + gap_len].value; gap_start++; } /* To enlarge the gap, we need to re-allocate the boundary array, and then shift the area after the gap to the new end. Since the cost is proportional to the amount of stuff after the gap, we do the enlargement here, after a right shift but before a left shift, when the portion after the gap is smallest. */ if (gap_len < min_size) { int i; /* Always make at least NEW_CACHE_GAP elements, as long as we're expanding anyway. */ if (min_size < NEW_CACHE_GAP) min_size = NEW_CACHE_GAP; c->boundaries = (struct boundary *) xrealloc (c->boundaries, ((min_size + c->cache_len) * sizeof (*c->boundaries))); /* Some systems don't provide a version of the copy routine that can be trusted to shift memory upward into an overlapping region. memmove isn't widely available. */ min_size -= gap_len; for (i = c->cache_len - 1; i >= gap_start; i--) { c->boundaries[i + min_size].pos = c->boundaries[i + gap_len].pos; c->boundaries[i + min_size].value = c->boundaries[i + gap_len].value; } gap_len = min_size; } /* Need we move the gap left? */ while (pos < gap_start) { gap_start--; /* Copy one region from before to after the gap, and convert its position to end-relative. */ c->boundaries[gap_start + gap_len].pos = c->boundaries[gap_start].pos + buffer_beg - buffer_end; c->boundaries[gap_start + gap_len].value = c->boundaries[gap_start].value; } /* Assign these back into the cache. */ c->gap_start = gap_start; c->gap_len = gap_len; } /* Insert a new boundary in cache C; it will have cache index INDEX, and have the specified POS and VALUE. */ static void insert_cache_boundary (c, index, pos, value) struct region_cache *c; int index; int pos, value; { /* index must be a valid cache index. */ if (index < 0 || index > c->cache_len) abort (); /* We must never want to insert something before the dummy first boundary. */ if (index == 0) abort (); /* We must only be inserting things in order. */ if (! (BOUNDARY_POS (c, index-1) < pos && (index == c->cache_len || pos < BOUNDARY_POS (c, index)))) abort (); /* The value must be different from the ones around it. However, we temporarily create boundaries that establish the same value as the subsequent boundary, so we're not going to flag that case. */ if (BOUNDARY_VALUE (c, index-1) == value) abort (); move_cache_gap (c, index, 1); c->boundaries[index].pos = pos - c->buffer_beg; c->boundaries[index].value = value; c->gap_start++; c->gap_len--; c->cache_len++; } /* Delete the i'th entry from cache C if START <= i < END. */ static void delete_cache_boundaries (c, start, end) struct region_cache *c; int start, end; { int len = end - start; /* Gotta be in range. */ if (start < 0 || end > c->cache_len) abort (); /* Gotta be in order. */ if (start > end) abort (); /* Can't delete the dummy entry. */ if (start == 0 && end >= 1) abort (); /* Minimize gap motion. If we're deleting nothing, do nothing. */ if (len == 0) ; /* If the gap is before the region to delete, delete from the start forward. */ else if (c->gap_start <= start) { move_cache_gap (c, start, 0); c->gap_len += len; } /* If the gap is after the region to delete, delete from the end backward. */ else if (end <= c->gap_start) { move_cache_gap (c, end, 0); c->gap_start -= len; c->gap_len += len; } /* If the gap is in the region to delete, just expand it. */ else { c->gap_start = start; c->gap_len += len; } c->cache_len -= len; } /* Set the value for a region. */ /* Set the value in cache C for the region START..END to VALUE. */ static void set_cache_region (c, start, end, value) struct region_cache *c; int start, end; int value; { if (start > end) abort (); if (start < c->buffer_beg || end > c->buffer_end) abort (); /* Eliminate this case; then we can assume that start and end-1 are both the locations of real characters in the buffer. */ if (start == end) return; { /* We need to make sure that there are no boundaries in the area between start to end; the whole area will have the same value, so those boundaries will not be necessary. Let start_ix be the cache index of the boundary governing the first character of start..end, and let end_ix be the cache index of the earliest boundary after the last character in start..end. (This tortured terminology is intended to answer all the "< or <=?" sort of questions.) */ int start_ix = find_cache_boundary (c, start); int end_ix = find_cache_boundary (c, end - 1) + 1; /* We must remember the value established by the last boundary before end; if that boundary's domain stretches beyond end, we'll need to create a new boundary at end, and that boundary must have that remembered value. */ int value_at_end = BOUNDARY_VALUE (c, end_ix - 1); /* Delete all boundaries strictly within start..end; this means those whose indices are between start_ix (exclusive) and end_ix (exclusive). */ delete_cache_boundaries (c, start_ix + 1, end_ix); /* Make sure we have the right value established going in to start..end from the left, and no unnecessary boundaries. */ if (BOUNDARY_POS (c, start_ix) == start) { /* Is this boundary necessary? If no, remove it; if yes, set its value. */ if (start_ix > 0 && BOUNDARY_VALUE (c, start_ix - 1) == value) { delete_cache_boundaries (c, start_ix, start_ix + 1); start_ix--; } else SET_BOUNDARY_VALUE (c, start_ix, value); } else { /* Do we need to add a new boundary here? */ if (BOUNDARY_VALUE (c, start_ix) != value) { insert_cache_boundary (c, start_ix + 1, start, value); start_ix++; } } /* This is equivalent to letting end_ix float (like a buffer marker does) with the insertions and deletions we may have done. */ end_ix = start_ix + 1; /* Make sure we have the correct value established as we leave start..end to the right. */ if (end == c->buffer_end) /* There is no text after start..end; nothing to do. */ ; else if (end_ix >= c->cache_len || end < BOUNDARY_POS (c, end_ix)) { /* There is no boundary at end, but we may need one. */ if (value_at_end != value) insert_cache_boundary (c, end_ix, end, value_at_end); } else { /* There is a boundary at end; should it be there? */ if (value == BOUNDARY_VALUE (c, end_ix)) delete_cache_boundaries (c, end_ix, end_ix + 1); } } } /* Interface: Invalidating the cache. Private: Re-validating the cache. */ /* Indicate that a section of BUF has changed, to invalidate CACHE. HEAD is the number of chars unchanged at the beginning of the buffer. TAIL is the number of chars unchanged at the end of the buffer. NOTE: this is *not* the same as the ending position of modified region. (This way of specifying regions makes more sense than absolute buffer positions in the presence of insertions and deletions; the args to pass are the same before and after such an operation.) */ void invalidate_region_cache (buf, c, head, tail) struct buffer *buf; struct region_cache *c; int head, tail; { /* Let chead = c->beg_unchanged, and ctail = c->end_unchanged. If z-tail < beg+chead by a large amount, or z-ctail < beg+head by a large amount, then cutting back chead and ctail to head and tail would lose a lot of information that we could preserve by revalidating the cache before processing this invalidation. Losing that information may be more costly than revalidating the cache now. So go ahead and call revalidate_region_cache if it seems that it might be worthwhile. */ if (((BUF_BEG (buf) + c->beg_unchanged) - (BUF_Z (buf) - tail) > PRESERVE_THRESHOLD) || ((BUF_BEG (buf) + head) - (BUF_Z (buf) - c->end_unchanged) > PRESERVE_THRESHOLD)) revalidate_region_cache (buf, c); if (head < c->beg_unchanged) c->beg_unchanged = head; if (tail < c->end_unchanged) c->end_unchanged = tail; /* We now know nothing about the region between the unchanged head and the unchanged tail (call it the "modified region"), not even its length. If the modified region has shrunk in size (deletions do this), then the cache may now contain boundaries originally located in text that doesn't exist any more. If the modified region has increased in size (insertions do this), then there may now be boundaries in the modified region whose positions are wrong. Even calling BOUNDARY_POS on boundaries still in the unchanged head or tail may well give incorrect answers now, since c->buffer_beg and c->buffer_end may well be wrong now. (Well, okay, c->buffer_beg never changes, so boundaries in the unchanged head will still be okay. But it's the principle of the thing.) So things are generally a mess. But we don't clean up this mess here; that would be expensive, and this function gets called every time any buffer modification occurs. Rather, we can clean up everything in one swell foop, accounting for all the modifications at once, by calling revalidate_region_cache before we try to consult the cache the next time. */ } /* Clean out any cache entries applying to the modified region, and make the positions of the remaining entries accurate again. After calling this function, the mess described in the comment in invalidate_region_cache is cleaned up. This function operates by simply throwing away everything it knows about the modified region. It doesn't care exactly which insertions and deletions took place; it just tosses it all. For example, if you insert a single character at the beginning of the buffer, and a single character at the end of the buffer (for example), without calling this function in between the two insertions, then the entire cache will be freed of useful information. On the other hand, if you do manage to call this function in between the two insertions, then the modified regions will be small in both cases, no information will be tossed, and the cache will know that it doesn't have knowledge of the first and last characters any more. Calling this function may be expensive; it does binary searches in the cache, and causes cache gap motion. */ static void revalidate_region_cache (buf, c) struct buffer *buf; struct region_cache *c; { /* The boundaries now in the cache are expressed relative to the buffer_beg and buffer_end values stored in the cache. Now, buffer_beg and buffer_end may not be the same as BUF_BEG (buf) and BUF_Z (buf), so we have two different "bases" to deal with --- the cache's, and the buffer's. */ /* If the entire buffer is still valid, don't waste time. Yes, this should be a >, not a >=; think about what beg_unchanged and end_unchanged get set to when the only change has been an insertion. */ if (c->buffer_beg + c->beg_unchanged > c->buffer_end - c->end_unchanged) return; /* If all the text we knew about as of the last cache revalidation is still there, then all of the information in the cache is still valid. Because c->buffer_beg and c->buffer_end are out-of-date, the modified region appears from the cache's point of view to be a null region located someplace in the buffer. Now, invalidating that empty string will have no actual affect on the cache; instead, we need to update the cache's basis first (which will give the modified region the same size in the cache as it has in the buffer), and then invalidate the modified region. */ if (c->buffer_beg + c->beg_unchanged == c->buffer_end - c->end_unchanged) { /* Move the gap so that all the boundaries in the unchanged head are expressed beg-relative, and all the boundaries in the unchanged tail are expressed end-relative. That done, we can plug in the new buffer beg and end, and all the positions will be accurate. The boundary which has jurisdiction over the modified region should be left before the gap. */ move_cache_gap (c, (find_cache_boundary (c, (c->buffer_beg + c->beg_unchanged)) + 1), 0); c->buffer_beg = BUF_BEG (buf); c->buffer_end = BUF_Z (buf); /* Now that the cache's basis has been changed, the modified region actually takes up some space in the cache, so we can invalidate it. */ set_cache_region (c, c->buffer_beg + c->beg_unchanged, c->buffer_end - c->end_unchanged, 0); } /* Otherwise, there is a non-empty region in the cache which corresponds to the modified region of the buffer. */ else { int modified_ix; /* These positions are correct, relative to both the cache basis and the buffer basis. */ set_cache_region (c, c->buffer_beg + c->beg_unchanged, c->buffer_end - c->end_unchanged, 0); /* Now the cache contains only boundaries that are in the unchanged head and tail; we've disposed of any boundaries whose positions we can't be sure of given the information we've saved. If we put the cache gap between the unchanged head and the unchanged tail, we can adjust all the boundary positions at once, simply by setting buffer_beg and buffer_end. The boundary which has jurisdiction over the modified region should be left before the gap. */ modified_ix = find_cache_boundary (c, (c->buffer_beg + c->beg_unchanged)) + 1; move_cache_gap (c, modified_ix, 0); c->buffer_beg = BUF_BEG (buf); c->buffer_end = BUF_Z (buf); /* Now, we may have shrunk the buffer when we changed the basis, and brought the boundaries we created for the start and end of the modified region together, giving them the same position. If that's the case, we should collapse them into one boundary. Or we may even delete them both, if the values before and after them are the same. */ if (modified_ix < c->cache_len && (BOUNDARY_POS (c, modified_ix - 1) == BOUNDARY_POS (c, modified_ix))) { int value_after = BOUNDARY_VALUE (c, modified_ix); /* Should we remove both of the boundaries? Yes, if the latter boundary is now establishing the same value that the former boundary's predecessor does. */ if (modified_ix - 1 > 0 && value_after == BOUNDARY_VALUE (c, modified_ix - 2)) delete_cache_boundaries (c, modified_ix - 1, modified_ix + 1); else { /* We do need a boundary here; collapse the two boundaries into one. */ SET_BOUNDARY_VALUE (c, modified_ix - 1, value_after); delete_cache_boundaries (c, modified_ix, modified_ix + 1); } } } /* Now the entire cache is valid. */ c->beg_unchanged = c->end_unchanged = c->buffer_end - c->buffer_beg; } /* Interface: Adding information to the cache. */ /* Assert that the region of BUF between START and END (absolute buffer positions) is "known," for the purposes of CACHE (e.g. "has no newlines", in the case of the line cache). */ void know_region_cache (buf, c, start, end) struct buffer *buf; struct region_cache *c; int start, end; { revalidate_region_cache (buf, c); set_cache_region (c, start, end, 1); } /* Interface: using the cache. */ /* Return true if the text immediately after POS in BUF is known, for the purposes of CACHE. If NEXT is non-zero, set *NEXT to the nearest position after POS where the knownness changes. */ int region_cache_forward (buf, c, pos, next) struct buffer *buf; struct region_cache *c; int pos; int *next; { revalidate_region_cache (buf, c); { int i = find_cache_boundary (c, pos); int i_value = BOUNDARY_VALUE (c, i); int j; /* Beyond the end of the buffer is unknown, by definition. */ if (pos >= BUF_Z (buf)) { if (next) *next = BUF_Z (buf); i_value = 0; } else if (next) { /* Scan forward from i to find the next differing position. */ for (j = i + 1; j < c->cache_len; j++) if (BOUNDARY_VALUE (c, j) != i_value) break; if (j < c->cache_len) *next = BOUNDARY_POS (c, j); else *next = BUF_Z (buf); } return i_value; } } /* Return true if the text immediately before POS in BUF is known, for the purposes of CACHE. If NEXT is non-zero, set *NEXT to the nearest position before POS where the knownness changes. */ int region_cache_backward (buf, c, pos, next) struct buffer *buf; struct region_cache *c; int pos; int *next; { revalidate_region_cache (buf, c); /* Before the beginning of the buffer is unknown, by definition. */ if (pos <= BUF_BEG (buf)) { if (next) *next = BUF_BEG (buf); return 0; } { int i = find_cache_boundary (c, pos - 1); int i_value = BOUNDARY_VALUE (c, i); int j; if (next) { /* Scan backward from i to find the next differing position. */ for (j = i - 1; j >= 0; j--) if (BOUNDARY_VALUE (c, j) != i_value) break; if (j >= 0) *next = BOUNDARY_POS (c, j + 1); else *next = BUF_BEG (buf); } return i_value; } } /* Debugging: pretty-print a cache to the standard error output. */ void pp_cache (c) struct region_cache *c; { int i; int beg_u = c->buffer_beg + c->beg_unchanged; int end_u = c->buffer_end - c->end_unchanged; fprintf (stderr, "basis: %d..%d modified: %d..%d\n", c->buffer_beg, c->buffer_end, beg_u, end_u); for (i = 0; i < c->cache_len; i++) { int pos = BOUNDARY_POS (c, i); putc (((pos < beg_u) ? 'v' : (pos == beg_u) ? '-' : ' '), stderr); putc (((pos > end_u) ? '^' : (pos == end_u) ? '-' : ' '), stderr); fprintf (stderr, "%d : %d\n", pos, BOUNDARY_VALUE (c, i)); } } emacs-19.30/src/scroll.c100444 23073 1 104346 6047603122 14260 0ustar voelkerdaemon/* Calculate what line insertion or deletion to do, and do it, Copyright (C) 1985, 1986, 1990, 1993, 1994 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. */ #include #include "termchar.h" #include "lisp.h" #include "dispextern.h" #include "frame.h" extern struct display_line **ophys_lines; #define max(a, b) ((a) > (b) ? (a) : (b)) #define min(a, b) ((a) < (b) ? (a) : (b)) /* All costs measured in characters. So no cost can exceed the area of a frame, measured in characters. Let's hope this is never more than 1000000 characters. */ #define INFINITY 1000000 struct matrix_elt { /* Cost of outputting through this line if no insert/delete is done just above it. */ int writecost; /* Cost of outputting through this line if an insert is done just above it. */ int insertcost; /* Cost of outputting through this line if a delete is done just above it. */ int deletecost; /* Number of inserts so far in this run of inserts, for the cost in insertcost. */ unsigned char insertcount; /* Number of deletes so far in this run of deletes, for the cost in deletecost. */ unsigned char deletecount; /* Number of writes so far since the last insert or delete for the cost in writecost. */ unsigned char writecount; }; /* Determine, in matrix[i,j], the cost of updating the first j old lines into the first i new lines using the general scrolling method. This involves using insert or delete somewhere if i != j. For each matrix elements, three kinds of costs are recorded: the smallest cost that ends with an insert, the smallest cost that ends with a delete, and the smallest cost that ends with neither one. These are kept separate because on some terminals the cost of doing an insert varies depending on whether one was just done, etc. */ /* draw_cost[VPOS] is the cost of outputting new line at VPOS. old_hash[VPOS] is the hash code of the old line at VPOS. new_hash[VPOS] is the hash code of the new line at VPOS. Note that these are not true frame vpos's, but relative to the place at which the first mismatch between old and new contents appears. */ static void calculate_scrolling (frame, matrix, window_size, lines_below, draw_cost, old_hash, new_hash, free_at_end) FRAME_PTR frame; /* matrix is of size window_size + 1 on each side. */ struct matrix_elt *matrix; int window_size; int *draw_cost; int *old_hash; int *new_hash; int free_at_end; { register int i, j; int frame_height = FRAME_HEIGHT (frame); register struct matrix_elt *p, *p1; register int cost, cost1; int lines_moved = window_size + (scroll_region_ok ? 0 : lines_below); /* first_insert_cost[I] is the cost of doing the first insert-line at the I'th line of the lines we are considering, where I is origin 1 (as it is below). */ int *first_insert_cost = &FRAME_INSERT_COST (frame)[frame_height - 1 - lines_moved]; int *first_delete_cost = &FRAME_DELETE_COST (frame)[frame_height - 1 - lines_moved]; int *next_insert_cost = &FRAME_INSERTN_COST (frame)[frame_height - 1 - lines_moved]; int *next_delete_cost = &FRAME_DELETEN_COST (frame)[frame_height - 1 - lines_moved]; /* Discourage long scrolls on fast lines. Don't scroll nearly a full frame height unless it saves at least 1/4 second. */ int extra_cost = baud_rate / (10 * 4 * FRAME_HEIGHT (frame)); if (baud_rate <= 0) extra_cost = 1; /* initialize the top left corner of the matrix */ matrix->writecost = 0; matrix->insertcost = INFINITY; matrix->deletecost = INFINITY; matrix->insertcount = 0; matrix->deletecount = 0; /* initialize the left edge of the matrix */ cost = first_insert_cost[1] - next_insert_cost[1]; for (i = 1; i <= window_size; i++) { p = matrix + i * (window_size + 1); cost += draw_cost[i] + next_insert_cost[i] + extra_cost; p->insertcost = cost; p->writecost = INFINITY; p->deletecost = INFINITY; p->insertcount = i; p->deletecount = 0; } /* initialize the top edge of the matrix */ cost = first_delete_cost[1] - next_delete_cost[1]; for (j = 1; j <= window_size; j++) { cost += next_delete_cost[j]; matrix[j].deletecost = cost; matrix[j].writecost = INFINITY; matrix[j].insertcost = INFINITY; matrix[j].deletecount = j; matrix[j].insertcount = 0; } /* `i' represents the vpos among new frame contents. `j' represents the vpos among the old frame contents. */ p = matrix + window_size + 2; /* matrix [1, 1] */ for (i = 1; i <= window_size; i++, p++) for (j = 1; j <= window_size; j++, p++) { /* p contains the address of matrix [i, j] */ /* First calculate the cost assuming we do not insert or delete above this line. That is, if we update through line i-1 based on old lines through j-1, and then just change old line j to new line i. */ p1 = p - window_size - 2; /* matrix [i-1, j-1] */ cost = p1->writecost; if (cost > p1->insertcost) cost = p1->insertcost; if (cost > p1->deletecost) cost = p1->deletecost; if (old_hash[j] != new_hash[i]) cost += draw_cost[i]; p->writecost = cost; /* Calculate the cost if we do an insert-line before outputting this line. That is, we update through line i-1 based on old lines through j, do an insert-line on line i, and then output line i from scratch, leaving old lines starting from j for reuse below. */ p1 = p - window_size - 1; /* matrix [i-1, j] */ /* No need to think about doing a delete followed immediately by an insert. It cannot be as good as not doing either of them. */ if (free_at_end == i) { cost = p1->writecost; cost1 = p1->insertcost; } else { cost = p1->writecost + first_insert_cost[i]; if ((int) p1->insertcount > i) abort (); cost1 = p1->insertcost + next_insert_cost[i - p1->insertcount]; } p->insertcost = min (cost, cost1) + draw_cost[i] + extra_cost; p->insertcount = (cost < cost1) ? 1 : p1->insertcount + 1; if ((int) p->insertcount > i) abort (); /* Calculate the cost if we do a delete line after outputting this line. That is, we update through line i based on old lines through j-1, and throw away old line j. */ p1 = p - 1; /* matrix [i, j-1] */ /* No need to think about doing an insert followed immediately by a delete. */ if (free_at_end == i) { cost = p1->writecost; cost1 = p1->deletecost; } else { cost = p1->writecost + first_delete_cost[i]; cost1 = p1->deletecost + next_delete_cost[i]; } p->deletecost = min (cost, cost1); p->deletecount = (cost < cost1) ? 1 : p1->deletecount + 1; } } /* Perform insert-lines and delete-lines operations on FRAME according to the costs in MATRIX, using the general scrolling method. Update the frame's current_glyphs info to record what was done. WINDOW_SIZE is the number of lines being considered for scrolling and UNCHANGED_AT_TOP is the vpos of the first line being considered. These two arguments can specify any contiguous range of lines. We also shuffle the charstarts vectors for the lines along with the glyphs; but the results are not quite right, since we cannot offset them for changes in amount of text in this line or that line. Luckily it doesn't matter, since update_frame and update_line will copy in the proper new charstarts vectors from the frame's desired_glyphs. */ static void do_scrolling (frame, matrix, window_size, unchanged_at_top) FRAME_PTR frame; struct matrix_elt *matrix; int window_size; int unchanged_at_top; { register struct matrix_elt *p; register int i, j; register struct frame_glyphs *current_frame; /* temp_frame->enable[i] means line i has been moved to current_frame. */ register struct frame_glyphs *temp_frame; struct queue { int count, pos; } *queue; int offset = unchanged_at_top; int qi = 0; int window = 0; register int tem; int next; queue = (struct queue *) alloca (FRAME_HEIGHT (frame) * sizeof (struct queue)); current_frame = FRAME_CURRENT_GLYPHS (frame); temp_frame = FRAME_TEMP_GLYPHS (frame); bcopy (current_frame->glyphs, temp_frame->glyphs, current_frame->height * sizeof (GLYPH *)); bcopy (current_frame->charstarts, temp_frame->charstarts, current_frame->height * sizeof (GLYPH *)); bcopy (current_frame->used, temp_frame->used, current_frame->height * sizeof (int)); bcopy (current_frame->highlight, temp_frame->highlight, current_frame->height * sizeof (char)); bzero (temp_frame->enable, temp_frame->height * sizeof (char)); bcopy (current_frame->bufp, temp_frame->bufp, current_frame->height * sizeof (int)); #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (frame)) { bcopy (current_frame->top_left_x, temp_frame->top_left_x, current_frame->height * sizeof (short)); bcopy (current_frame->top_left_y, temp_frame->top_left_y, current_frame->height * sizeof (short)); bcopy (current_frame->pix_width, temp_frame->pix_width, current_frame->height * sizeof (short)); bcopy (current_frame->pix_height, temp_frame->pix_height, current_frame->height * sizeof (short)); bcopy (current_frame->max_ascent, temp_frame->max_ascent, current_frame->height * sizeof (short)); } #endif i = j = window_size; while (i > 0 || j > 0) { p = matrix + i * (window_size + 1) + j; tem = p->insertcost; if (tem < p->writecost && tem < p->deletecost) { /* Insert should be done at vpos i-1, plus maybe some before */ queue[qi].count = p->insertcount; i -= p->insertcount; queue[qi++].pos = i + unchanged_at_top; } else if (p->deletecost < p->writecost) { /* Old line at vpos j-1, and maybe some before it, should be deleted */ j -= p->deletecount; if (!window) { set_terminal_window (window_size + unchanged_at_top); window = 1; } ins_del_lines (j + unchanged_at_top, - p->deletecount); } else { /* Best thing done here is no insert or delete */ /* Old line at vpos j-1 ends up at vpos i-1 */ current_frame->glyphs[i + offset - 1] = temp_frame->glyphs[j + offset - 1]; current_frame->charstarts[i + offset - 1] = temp_frame->charstarts[j + offset - 1]; current_frame->used[i + offset - 1] = temp_frame->used[j + offset - 1]; current_frame->highlight[i + offset - 1] = temp_frame->highlight[j + offset - 1]; temp_frame->enable[j + offset - 1] = 1; i--; j--; } } if (!window && qi) { set_terminal_window (window_size + unchanged_at_top); window = 1; } /* Now do all insertions */ next = unchanged_at_top; for (i = qi - 1; i >= 0; i--) { ins_del_lines (queue[i].pos, queue[i].count); /* Mark the inserted lines as clear, and put into them the line-contents strings that were discarded during the deletions. Those are the ones for which temp_frame->enable was not set. */ tem = queue[i].pos; for (j = tem + queue[i].count - 1; j >= tem; j--) { current_frame->enable[j] = 0; while (temp_frame->enable[next]) next++; current_frame->glyphs[j] = temp_frame->glyphs[next]; current_frame->charstarts[j] = temp_frame->charstarts[next++]; } } if (window) set_terminal_window (0); } /* Determine, in matrix[i,j], the cost of updating the first j old lines into the first i new lines using the direct scrolling method. When the old line and the new line have different hash codes, the calculated cost of updating old line j into new line i includes the cost of outputting new line i, and if i != j, the cost of outputting the old line j is also included, as a penalty for moving the line and then erasing it. In addition, the cost of updating a sequence of lines with constant i - j includes the cost of scrolling the old lines into their new positions, unless i == j. Scrolling is achieved by setting the screen window to avoid affecting other lines below, and inserting or deleting lines at the top of the scrolled region. The cost of scrolling a sequence of lines includes the fixed cost of specifying a scroll region, plus a variable cost which can depend upon the number of lines involved and the distance by which they are scrolled, and an extra cost to discourage long scrolls. As reflected in the matrix, an insert or delete does not correspond directly to the insertion or deletion which is used in scrolling lines. An insert means that the value of i has increased without a corresponding increase in the value of j. A delete means that the value of j has increased without a corresponding increase in the value of i. A write means that i and j are both increased by the same amount, and that the old lines will be moved to their new positions. An insert following a delete is allowed only if i > j. A delete following an insert is allowed only if i < j. These restrictions ensure that the new lines in an insert will always be blank as an effect of the neighboring writes. Thus the calculated cost of an insert is simply the cost of outputting the new line contents. The direct cost of a delete is zero. Inserts and deletes indirectly affect the total cost through their influence on subsequent writes. */ /* The vectors draw_cost, old_hash, and new_hash have the same meanings here as in calculate_scrolling, and old_draw_cost is the equivalent of draw_cost for the old line contents */ static void calculate_direct_scrolling (frame, matrix, window_size, lines_below, draw_cost, old_draw_cost, old_hash, new_hash, free_at_end) FRAME_PTR frame; /* matrix is of size window_size + 1 on each side. */ struct matrix_elt *matrix; int window_size; int *draw_cost; int *old_draw_cost; int *old_hash; int *new_hash; int free_at_end; { register int i, j; int frame_height = FRAME_HEIGHT (frame); register struct matrix_elt *p, *p1; register int cost, cost1, delta; /* first_insert_cost[-I] is the cost of doing the first insert-line at a position I lines above the bottom line in the scroll window. */ int *first_insert_cost = &FRAME_INSERT_COST (frame)[frame_height - 1]; int *first_delete_cost = &FRAME_DELETE_COST (frame)[frame_height - 1]; int *next_insert_cost = &FRAME_INSERTN_COST (frame)[frame_height - 1]; int *next_delete_cost = &FRAME_DELETEN_COST (frame)[frame_height - 1]; int scroll_overhead; /* Discourage long scrolls on fast lines. Don't scroll nearly a full frame height unless it saves at least 1/4 second. */ int extra_cost = baud_rate / (10 * 4 * FRAME_HEIGHT (frame)); if (baud_rate <= 0) extra_cost = 1; /* Overhead of setting the scroll window, plus the extra cost cost of scrolling by a distance of one. The extra cost is added once for consistency with the cost vectors */ scroll_overhead = scroll_region_cost + extra_cost; /* initialize the top left corner of the matrix */ matrix->writecost = 0; matrix->insertcost = INFINITY; matrix->deletecost = INFINITY; matrix->writecount = 0; matrix->insertcount = 0; matrix->deletecount = 0; /* initialize the left edge of the matrix */ cost = 0; for (i = 1; i <= window_size; i++) { p = matrix + i * (window_size + 1); cost += draw_cost[i]; p->insertcost = cost; p->writecost = INFINITY; p->deletecost = INFINITY; p->insertcount = i; p->writecount = 0; p->deletecount = 0; } /* initialize the top edge of the matrix */ for (j = 1; j <= window_size; j++) { matrix[j].deletecost = 0; matrix[j].writecost = INFINITY; matrix[j].insertcost = INFINITY; matrix[j].deletecount = j; matrix[j].writecount = 0; matrix[j].insertcount = 0; } /* `i' represents the vpos among new frame contents. `j' represents the vpos among the old frame contents. */ p = matrix + window_size + 2; /* matrix [1, 1] */ for (i = 1; i <= window_size; i++, p++) for (j = 1; j <= window_size; j++, p++) { /* p contains the address of matrix [i, j] */ /* First calculate the cost assuming we do not insert or delete above this line. That is, if we update through line i-1 based on old lines through j-1, and then just change old line j to new line i. Depending on which choice gives the lower cost, this usually involves either scrolling a single line or extending a sequence of scrolled lines, but when i == j, no scrolling is required. */ p1 = p - window_size - 2; /* matrix [i-1, j-1] */ cost = p1->insertcost; if (cost > p1->deletecost) cost = p1->deletecost; cost1 = p1->writecost; if (i == j) { if (cost > cost1) { cost = cost1; p->writecount = p1->writecount + 1; } else p->writecount = 1; if (old_hash[j] != new_hash[i]) { cost += draw_cost[i]; } } else { if (i > j) { delta = i - j; /* The cost added here for scrolling the first line by a distance N includes the overhead of setting the scroll window, the cost of inserting N lines at a position N lines above the bottom line of the window, and an extra cost which is proportional to N. */ cost += scroll_overhead + first_insert_cost[-delta] + (delta-1) * (next_insert_cost[-delta] + extra_cost); /* In the most general case, the insertion overhead and the multiply factor can grow linearly as the distance from the bottom of the window increases. The incremental cost of scrolling an additional line depends upon the rate of change of these two parameters. Each of these growth rates can be determined by a simple difference. To reduce the cumulative effects of rounding error, we vary the position at which the difference is computed. */ cost1 += first_insert_cost[-j] - first_insert_cost[1-j] + (delta-1) * (next_insert_cost[-j] - next_insert_cost[1-j]); } else { delta = j - i; cost += scroll_overhead + first_delete_cost[-delta] + (delta-1) * (next_delete_cost[-delta] + extra_cost); cost1 += first_delete_cost[-i] - first_delete_cost[1-i] + (delta-1) * ( next_delete_cost[-i] - next_delete_cost[1-i]); } if (cost1 < cost) { cost = cost1; p->writecount = p1->writecount + 1; } else p->writecount = 1; if (old_hash[j] != new_hash[i]) { cost += draw_cost[i] + old_draw_cost[j]; } } p->writecost = cost; /* Calculate the cost if we do an insert-line before outputting this line. That is, we update through line i-1 based on old lines through j, do an insert-line on line i, and then output line i from scratch, leaving old lines starting from j for reuse below. */ p1 = p - window_size - 1; /* matrix [i-1, j] */ cost = p1->writecost; /* If i > j, an insert is allowed after a delete. */ if (i > j && p1->deletecost < cost) cost = p1->deletecost; if (p1->insertcost <= cost) { cost = p1->insertcost; p->insertcount = p1->insertcount + 1; } else p->insertcount = 1; cost += draw_cost[i]; p->insertcost = cost; /* Calculate the cost if we do a delete line after outputting this line. That is, we update through line i based on old lines through j-1, and throw away old line j. */ p1 = p - 1; /* matrix [i, j-1] */ cost = p1->writecost; /* If i < j, a delete is allowed after an insert. */ if (i < j && p1->insertcost < cost) cost = p1->insertcost; cost1 = p1->deletecost; if (p1->deletecost <= cost) { cost = p1->deletecost; p->deletecount = p1->deletecount + 1; } else p->deletecount = 1; p->deletecost = cost; } } /* Perform insert-lines and delete-lines operations on FRAME according to the costs in MATRIX, using the direct scrolling method. Update the frame's current_glyphs info to record what was done. WINDOW_SIZE is the number of lines being considered for scrolling and UNCHANGED_AT_TOP is the vpos of the first line being considered. These two arguments can specify any contiguous range of lines. We also shuffle the charstarts vectors for the lines along with the glyphs; but the results are not quite right, since we cannot offset them for changes in amount of text in this line or that line. Luckily it doesn't matter, since update_frame and update_line will copy in the proper new charstarts vectors from the frame's desired_glyphs. In the direct scrolling method, a new scroll window is selected before each insertion or deletion, so that groups of lines can be scrolled directly to their final vertical positions. This method is described in more detail in calculate_direct_scrolling, where the cost matrix for this approach is constructed. */ static void do_direct_scrolling (frame, matrix, window_size, unchanged_at_top) FRAME_PTR frame; struct matrix_elt *matrix; int window_size; int unchanged_at_top; { register struct matrix_elt *p; register int i, j; register struct frame_glyphs *current_frame; /* temp_frame->enable[i] means line i has been moved to current_frame. */ register struct frame_glyphs *temp_frame; struct alt_queue { int count, pos, window; } *queue; int offset = unchanged_at_top; int qi = 0; int window = 0; register int tem; int next; /* A nonzero value of write_follows indicates that a write has been selected, allowing either an insert or a delete to be selected next. When write_follows is zero, a delete cannot be selected unless j < i, and an insert cannot be selected unless i < j. This corresponds to a similar restriction (with the ordering reversed) in calculate_direct_scrolling, which is intended to ensure that lines marked as inserted will be blank. */ int write_follows = 1; queue = (struct alt_queue *) alloca (FRAME_HEIGHT (frame) * sizeof (struct alt_queue)); current_frame = FRAME_CURRENT_GLYPHS (frame); temp_frame = FRAME_TEMP_GLYPHS (frame); bcopy (current_frame->glyphs, temp_frame->glyphs, current_frame->height * sizeof (GLYPH *)); bcopy (current_frame->charstarts, temp_frame->charstarts, current_frame->height * sizeof (GLYPH *)); bcopy (current_frame->used, temp_frame->used, current_frame->height * sizeof (int)); bcopy (current_frame->highlight, temp_frame->highlight, current_frame->height * sizeof (char)); bzero (temp_frame->enable, temp_frame->height * sizeof (char)); bcopy (current_frame->bufp, temp_frame->bufp, current_frame->height * sizeof (int)); #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (frame)) { bcopy (current_frame->top_left_x, temp_frame->top_left_x, current_frame->height * sizeof (short)); bcopy (current_frame->top_left_y, temp_frame->top_left_y, current_frame->height * sizeof (short)); bcopy (current_frame->pix_width, temp_frame->pix_width, current_frame->height * sizeof (short)); bcopy (current_frame->pix_height, temp_frame->pix_height, current_frame->height * sizeof (short)); bcopy (current_frame->max_ascent, temp_frame->max_ascent, current_frame->height * sizeof (short)); } #endif i = j = window_size; while (i > 0 || j > 0) { p = matrix + i * (window_size + 1) + j; tem = p->insertcost; if (tem < p->writecost && tem < p->deletecost && (write_follows || i < j)) { /* Insert should be done at vpos i-1, plus maybe some before. Setting count to 0 in the queue marks this as an insert. */ write_follows = 0; queue[qi].window = i + unchanged_at_top; queue[qi].count = 0; i -= p->insertcount; queue[qi++].pos = i + unchanged_at_top; } else if (p->deletecost < p->writecost && (write_follows || i > j)) { /* Delete should be done at vpos j-1, plus maybe some before. */ write_follows = 0; j -= p->deletecount; } else { /* One or more lines should be retained. */ write_follows = 1; tem = p->writecount; if (i > j) { /* Immediately scroll a group of lines downward */ set_terminal_window (i + unchanged_at_top); window = 1; ins_del_lines (j - tem + unchanged_at_top, i - j); } else if (i < j) { /* Queue the upward scrolling of a group of lines */ queue[qi].pos = i - tem + unchanged_at_top; queue[qi].window = j + unchanged_at_top; queue[qi++].count = i - j; } /* Now copy the line-contents strings */ while (tem > 0) { i--; j--; tem--; current_frame->glyphs[i + offset] = temp_frame->glyphs[j + offset]; current_frame->charstarts[i + offset] = temp_frame->charstarts[j + offset]; current_frame->used[i + offset] = temp_frame->used[j + offset]; current_frame->highlight[i + offset] = temp_frame->highlight[j + offset]; temp_frame->enable[j + offset] = 1; } } } /* Now do all the upward scrolling, and copy the line-contents strings for the blank lines of the recorded inserts. */ next = unchanged_at_top; for (i = qi - 1; i >= 0; i--) { if (queue[i].count) { set_terminal_window (queue[i].window); window = 1; ins_del_lines (queue[i].pos, queue[i].count); } else { /* Mark the inserted lines as clear, and put into them the line-contents strings that were discarded during the deletions. Those are the ones for which temp_frame->enable was not set. */ tem = queue[i].pos; for (j = queue[i].window - 1; j >= tem; j--) { current_frame->enable[j] = 0; while (temp_frame->enable[next]) next++; current_frame->glyphs[j] = temp_frame->glyphs[next]; current_frame->charstarts[j] = temp_frame->charstarts[next++]; } } } if (window) set_terminal_window (0); } void scrolling_1 (frame, window_size, unchanged_at_top, unchanged_at_bottom, draw_cost, old_draw_cost, old_hash, new_hash, free_at_end) FRAME_PTR frame; int window_size, unchanged_at_top, unchanged_at_bottom; int *draw_cost; int *old_draw_cost; int *old_hash; int *new_hash; int free_at_end; { struct matrix_elt *matrix; matrix = ((struct matrix_elt *) alloca ((window_size + 1) * (window_size + 1) * sizeof *matrix)); if (scroll_region_ok) { calculate_direct_scrolling (frame, matrix, window_size, unchanged_at_bottom, draw_cost, old_draw_cost, old_hash, new_hash, free_at_end); do_direct_scrolling (frame, matrix, window_size, unchanged_at_top); } else { calculate_scrolling (frame, matrix, window_size, unchanged_at_bottom, draw_cost, old_hash, new_hash, free_at_end); do_scrolling (frame, matrix, window_size, unchanged_at_top); } } /* Return number of lines in common between current and desired frame contents described to us only as vectors of hash codes OLDHASH and NEWHASH. Consider only vpos range START to END (not including END). Ignore short lines on the assumption that avoiding redrawing such a line will have little weight. */ int scrolling_max_lines_saved (start, end, oldhash, newhash, cost) int start, end; int *oldhash, *newhash, *cost; { struct { int hash; int count; } lines[01000]; register int i, h; register int matchcount = 0; int avg_length = 0; int threshold; /* Compute a threshold which is 1/4 of average length of these lines. */ for (i = start; i < end; i++) avg_length += cost[i]; avg_length /= end - start; threshold = avg_length / 4; bzero (lines, sizeof lines); /* Put new lines' hash codes in hash table. Ignore lines shorter than the threshold. Thus, if the lines that are in common are mainly the ones that are short, they won't count. */ for (i = start; i < end; i++) { if (cost[i] > threshold) { h = newhash[i] & 0777; lines[h].hash = newhash[i]; lines[h].count++; } } /* Look up old line hash codes in the hash table. Count number of matches between old lines and new. */ for (i = start; i < end; i++) { h = oldhash[i] & 0777; if (oldhash[i] == lines[h].hash) { matchcount++; if (--lines[h].count == 0) lines[h].hash = 0; } } return matchcount; } /* Return a measure of the cost of moving the lines starting with vpos FROM, up to but not including vpos TO, down by AMOUNT lines (AMOUNT may be negative). These are the same arguments that might be given to scroll_frame_lines to perform this scrolling. */ scroll_cost (frame, from, to, amount) FRAME_PTR frame; int from, to, amount; { /* Compute how many lines, at bottom of frame, will not be involved in actual motion. */ int limit = to; int offset; int height = FRAME_HEIGHT (frame); if (amount == 0) return 0; if (! scroll_region_ok) limit = height; else if (amount > 0) limit += amount; if (amount < 0) { int temp = to; to = from + amount; from = temp + amount; amount = - amount; } offset = height - limit; return (FRAME_INSERT_COST (frame)[offset + from] + (amount - 1) * FRAME_INSERTN_COST (frame)[offset + from] + FRAME_DELETE_COST (frame)[offset + to] + (amount - 1) * FRAME_DELETEN_COST (frame)[offset + to]); } /* Calculate the line insertion/deletion overhead and multiply factor values */ static void line_ins_del (frame, ov1, pf1, ovn, pfn, ov, mf) FRAME_PTR frame; int ov1, ovn; int pf1, pfn; register int *ov, *mf; { register int i; register int frame_height = FRAME_HEIGHT (frame); register int insert_overhead = ov1 * 10; register int next_insert_cost = ovn * 10; for (i = frame_height-1; i >= 0; i--) { mf[i] = next_insert_cost / 10; next_insert_cost += pfn; ov[i] = (insert_overhead + next_insert_cost) / 10; insert_overhead += pf1; } } static void ins_del_costs (frame, one_line_string, multi_string, setup_string, cleanup_string, costvec, ncostvec, coefficient) FRAME_PTR frame; char *one_line_string, *multi_string; char *setup_string, *cleanup_string; int *costvec, *ncostvec; int coefficient; { if (multi_string) line_ins_del (frame, string_cost (multi_string) * coefficient, per_line_cost (multi_string) * coefficient, 0, 0, costvec, ncostvec); else if (one_line_string) line_ins_del (frame, string_cost (setup_string) + string_cost (cleanup_string), 0, string_cost (one_line_string), per_line_cost (one_line_string), costvec, ncostvec); else line_ins_del (frame, 9999, 0, 9999, 0, costvec, ncostvec); } /* Calculate the insert and delete line costs. Note that this is done even when running with a window system because we want to know how long scrolling takes (and avoid it). This must be redone whenever the frame height changes. We keep the ID costs in a precomputed array based on the position at which the I or D is performed. Also, there are two kinds of ID costs: the "once-only" and the "repeated". This is to handle both those terminals that are able to insert N lines at a time (once- only) and those that must repeatedly insert one line. The cost to insert N lines at line L is [tt.t_ILov + (frame_height + 1 - L) * tt.t_ILpf] + N * [tt.t_ILnov + (frame_height + 1 - L) * tt.t_ILnpf] ILov represents the basic insert line overhead. ILpf is the padding required to allow the terminal time to move a line: insertion at line L changes (frame_height + 1 - L) lines. The first bracketed expression above is the overhead; the second is the multiply factor. Both are dependent only on the position at which the insert is performed. We store the overhead in FRAME_INSERT_COST (frame) and the multiply factor in FRAME_INSERTN_COST (frame). Note however that any insertion must include at least one multiply factor. Rather than compute this as FRAME_INSERT_COST (frame)[line]+FRAME_INSERTN_COST (frame)[line], we add FRAME_INSERTN_COST (frame) into FRAME_INSERT_COST (frame). This is reasonable because of the particular algorithm used in calcM. Deletion is essentially the same as insertion. */ do_line_insertion_deletion_costs (frame, ins_line_string, multi_ins_string, del_line_string, multi_del_string, setup_string, cleanup_string, coefficient) FRAME_PTR frame; char *ins_line_string, *multi_ins_string; char *del_line_string, *multi_del_string; char *setup_string, *cleanup_string; int coefficient; { if (FRAME_INSERT_COST (frame) != 0) { FRAME_INSERT_COST (frame) = (int *) xrealloc (FRAME_INSERT_COST (frame), FRAME_HEIGHT (frame) * sizeof (int)); FRAME_DELETEN_COST (frame) = (int *) xrealloc (FRAME_DELETEN_COST (frame), FRAME_HEIGHT (frame) * sizeof (int)); FRAME_INSERTN_COST (frame) = (int *) xrealloc (FRAME_INSERTN_COST (frame), FRAME_HEIGHT (frame) * sizeof (int)); FRAME_DELETE_COST (frame) = (int *) xrealloc (FRAME_DELETE_COST (frame), FRAME_HEIGHT (frame) * sizeof (int)); } else { FRAME_INSERT_COST (frame) = (int *) xmalloc (FRAME_HEIGHT (frame) * sizeof (int)); FRAME_DELETEN_COST (frame) = (int *) xmalloc (FRAME_HEIGHT (frame) * sizeof (int)); FRAME_INSERTN_COST (frame) = (int *) xmalloc (FRAME_HEIGHT (frame) * sizeof (int)); FRAME_DELETE_COST (frame) = (int *) xmalloc (FRAME_HEIGHT (frame) * sizeof (int)); } ins_del_costs (frame, ins_line_string, multi_ins_string, setup_string, cleanup_string, FRAME_INSERT_COST (frame), FRAME_INSERTN_COST (frame), coefficient); ins_del_costs (frame, del_line_string, multi_del_string, setup_string, cleanup_string, FRAME_DELETE_COST (frame), FRAME_DELETEN_COST (frame), coefficient); } emacs-19.30/src/search.c100444 12120 1 173402 6042503435 13350 0ustar rmsdaemon/* String search routines for GNU Emacs. Copyright (C) 1985, 1986, 1987, 1993, 1994 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. */ #include #include "lisp.h" #include "syntax.h" #include "buffer.h" #include "region-cache.h" #include "commands.h" #include "blockinput.h" #include #include "regex.h" #define REGEXP_CACHE_SIZE 5 /* If the regexp is non-nil, then the buffer contains the compiled form of that regexp, suitable for searching. */ struct regexp_cache { struct regexp_cache *next; Lisp_Object regexp; struct re_pattern_buffer buf; char fastmap[0400]; /* Nonzero means regexp was compiled to do full POSIX backtracking. */ char posix; }; /* The instances of that struct. */ struct regexp_cache searchbufs[REGEXP_CACHE_SIZE]; /* The head of the linked list; points to the most recently used buffer. */ struct regexp_cache *searchbuf_head; /* Every call to re_match, etc., must pass &search_regs as the regs argument unless you can show it is unnecessary (i.e., if re_match is certainly going to be called again before region-around-match can be called). Since the registers are now dynamically allocated, we need to make sure not to refer to the Nth register before checking that it has been allocated by checking search_regs.num_regs. The regex code keeps track of whether it has allocated the search buffer using bits in the re_pattern_buffer. This means that whenever you compile a new pattern, it completely forgets whether it has allocated any registers, and will allocate new registers the next time you call a searching or matching function. Therefore, we need to call re_set_registers after compiling a new pattern or after setting the match registers, so that the regex functions will be able to free or re-allocate it properly. */ static struct re_registers search_regs; /* The buffer in which the last search was performed, or Qt if the last search was done in a string; Qnil if no searching has been done yet. */ static Lisp_Object last_thing_searched; /* error condition signalled when regexp compile_pattern fails */ Lisp_Object Qinvalid_regexp; static void set_search_regs (); static void save_search_regs (); static int search_buffer (); static void matcher_overflow () { error ("Stack overflow in regexp matcher"); } #ifdef __STDC__ #define CONST const #else #define CONST #endif /* Compile a regexp and signal a Lisp error if anything goes wrong. PATTERN is the pattern to compile. CP is the place to put the result. TRANSLATE is a translation table for ignoring case, or NULL for none. REGP is the structure that says where to store the "register" values that will result from matching this pattern. If it is 0, we should compile the pattern not to record any subexpression bounds. POSIX is nonzero if we want full backtracking (POSIX style) for this pattern. 0 means backtrack only enough to get a valid match. */ static void compile_pattern_1 (cp, pattern, translate, regp, posix) struct regexp_cache *cp; Lisp_Object pattern; Lisp_Object *translate; struct re_registers *regp; int posix; { CONST char *val; reg_syntax_t old; cp->regexp = Qnil; cp->buf.translate = translate; cp->posix = posix; BLOCK_INPUT; old = re_set_syntax (RE_SYNTAX_EMACS | (posix ? 0 : RE_NO_POSIX_BACKTRACKING)); val = (CONST char *) re_compile_pattern ((char *) XSTRING (pattern)->data, XSTRING (pattern)->size, &cp->buf); re_set_syntax (old); UNBLOCK_INPUT; if (val) Fsignal (Qinvalid_regexp, Fcons (build_string (val), Qnil)); cp->regexp = Fcopy_sequence (pattern); } /* Compile a regexp if necessary, but first check to see if there's one in the cache. PATTERN is the pattern to compile. TRANSLATE is a translation table for ignoring case, or NULL for none. REGP is the structure that says where to store the "register" values that will result from matching this pattern. If it is 0, we should compile the pattern not to record any subexpression bounds. POSIX is nonzero if we want full backtracking (POSIX style) for this pattern. 0 means backtrack only enough to get a valid match. */ struct re_pattern_buffer * compile_pattern (pattern, regp, translate, posix) Lisp_Object pattern; struct re_registers *regp; Lisp_Object *translate; int posix; { struct regexp_cache *cp, **cpp; for (cpp = &searchbuf_head; ; cpp = &cp->next) { cp = *cpp; if (!NILP (Fstring_equal (cp->regexp, pattern)) && cp->buf.translate == translate && cp->posix == posix) break; /* If we're at the end of the cache, compile into the last cell. */ if (cp->next == 0) { compile_pattern_1 (cp, pattern, translate, regp, posix); break; } } /* When we get here, cp (aka *cpp) contains the compiled pattern, either because we found it in the cache or because we just compiled it. Move it to the front of the queue to mark it as most recently used. */ *cpp = cp->next; cp->next = searchbuf_head; searchbuf_head = cp; /* Advise the searching functions about the space we have allocated for register data. */ if (regp) re_set_registers (&cp->buf, regp, regp->num_regs, regp->start, regp->end); return &cp->buf; } /* Error condition used for failing searches */ Lisp_Object Qsearch_failed; Lisp_Object signal_failure (arg) Lisp_Object arg; { Fsignal (Qsearch_failed, Fcons (arg, Qnil)); return Qnil; } static Lisp_Object looking_at_1 (string, posix) Lisp_Object string; int posix; { Lisp_Object val; unsigned char *p1, *p2; int s1, s2; register int i; struct re_pattern_buffer *bufp; if (running_asynch_code) save_search_regs (); CHECK_STRING (string, 0); bufp = compile_pattern (string, &search_regs, (!NILP (current_buffer->case_fold_search) ? DOWNCASE_TABLE : 0), posix); immediate_quit = 1; QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ /* Get pointers and sizes of the two strings that make up the visible portion of the buffer. */ p1 = BEGV_ADDR; s1 = GPT - BEGV; p2 = GAP_END_ADDR; s2 = ZV - GPT; if (s1 < 0) { p2 = p1; s2 = ZV - BEGV; s1 = 0; } if (s2 < 0) { s1 = ZV - BEGV; s2 = 0; } i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2, point - BEGV, &search_regs, ZV - BEGV); if (i == -2) matcher_overflow (); val = (0 <= i ? Qt : Qnil); for (i = 0; i < search_regs.num_regs; i++) if (search_regs.start[i] >= 0) { search_regs.start[i] += BEGV; search_regs.end[i] += BEGV; } XSETBUFFER (last_thing_searched, current_buffer); immediate_quit = 0; return val; } DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0, "Return t if text after point matches regular expression REGEXP.\n\ This function modifies the match data that `match-beginning',\n\ `match-end' and `match-data' access; save and restore the match\n\ data if you want to preserve them.") (regexp) Lisp_Object regexp; { return looking_at_1 (regexp, 0); } DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0, "Return t if text after point matches regular expression REGEXP.\n\ Find the longest match, in accord with Posix regular expression rules.\n\ This function modifies the match data that `match-beginning',\n\ `match-end' and `match-data' access; save and restore the match\n\ data if you want to preserve them.") (regexp) Lisp_Object regexp; { return looking_at_1 (regexp, 1); } static Lisp_Object string_match_1 (regexp, string, start, posix) Lisp_Object regexp, string, start; int posix; { int val; int s; struct re_pattern_buffer *bufp; if (running_asynch_code) save_search_regs (); CHECK_STRING (regexp, 0); CHECK_STRING (string, 1); if (NILP (start)) s = 0; else { int len = XSTRING (string)->size; CHECK_NUMBER (start, 2); s = XINT (start); if (s < 0 && -s <= len) s = len + s; else if (0 > s || s > len) args_out_of_range (string, start); } bufp = compile_pattern (regexp, &search_regs, (!NILP (current_buffer->case_fold_search) ? DOWNCASE_TABLE : 0), posix); immediate_quit = 1; val = re_search (bufp, (char *) XSTRING (string)->data, XSTRING (string)->size, s, XSTRING (string)->size - s, &search_regs); immediate_quit = 0; last_thing_searched = Qt; if (val == -2) matcher_overflow (); if (val < 0) return Qnil; return make_number (val); } DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0, "Return index of start of first match for REGEXP in STRING, or nil.\n\ If third arg START is non-nil, start search at that index in STRING.\n\ For index of first char beyond the match, do (match-end 0).\n\ `match-end' and `match-beginning' also give indices of substrings\n\ matched by parenthesis constructs in the pattern.") (regexp, string, start) Lisp_Object regexp, string, start; { return string_match_1 (regexp, string, start, 0); } DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0, "Return index of start of first match for REGEXP in STRING, or nil.\n\ Find the longest match, in accord with Posix regular expression rules.\n\ If third arg START is non-nil, start search at that index in STRING.\n\ For index of first char beyond the match, do (match-end 0).\n\ `match-end' and `match-beginning' also give indices of substrings\n\ matched by parenthesis constructs in the pattern.") (regexp, string, start) Lisp_Object regexp, string, start; { return string_match_1 (regexp, string, start, 1); } /* Match REGEXP against STRING, searching all of STRING, and return the index of the match, or negative on failure. This does not clobber the match data. */ int fast_string_match (regexp, string) Lisp_Object regexp, string; { int val; struct re_pattern_buffer *bufp; bufp = compile_pattern (regexp, 0, 0, 0); immediate_quit = 1; val = re_search (bufp, (char *) XSTRING (string)->data, XSTRING (string)->size, 0, XSTRING (string)->size, 0); immediate_quit = 0; return val; } /* max and min. */ static int max (a, b) int a, b; { return ((a > b) ? a : b); } static int min (a, b) int a, b; { return ((a < b) ? a : b); } /* The newline cache: remembering which sections of text have no newlines. */ /* If the user has requested newline caching, make sure it's on. Otherwise, make sure it's off. This is our cheezy way of associating an action with the change of state of a buffer-local variable. */ static void newline_cache_on_off (buf) struct buffer *buf; { if (NILP (buf->cache_long_line_scans)) { /* It should be off. */ if (buf->newline_cache) { free_region_cache (buf->newline_cache); buf->newline_cache = 0; } } else { /* It should be on. */ if (buf->newline_cache == 0) buf->newline_cache = new_region_cache (); } } /* Search for COUNT instances of the character TARGET between START and END. If COUNT is positive, search forwards; END must be >= START. If COUNT is negative, search backwards for the -COUNTth instance; END must be <= START. If COUNT is zero, do anything you please; run rogue, for all I care. If END is zero, use BEGV or ZV instead, as appropriate for the direction indicated by COUNT. If we find COUNT instances, set *SHORTAGE to zero, and return the position after the COUNTth match. Note that for reverse motion this is not the same as the usual convention for Emacs motion commands. If we don't find COUNT instances before reaching END, set *SHORTAGE to the number of TARGETs left unfound, and return END. If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do except when inside redisplay. */ scan_buffer (target, start, end, count, shortage, allow_quit) register int target; int start, end; int count; int *shortage; int allow_quit; { struct region_cache *newline_cache; int direction; if (count > 0) { direction = 1; if (! end) end = ZV; } else { direction = -1; if (! end) end = BEGV; } newline_cache_on_off (current_buffer); newline_cache = current_buffer->newline_cache; if (shortage != 0) *shortage = 0; immediate_quit = allow_quit; if (count > 0) while (start != end) { /* Our innermost scanning loop is very simple; it doesn't know about gaps, buffer ends, or the newline cache. ceiling is the position of the last character before the next such obstacle --- the last character the dumb search loop should examine. */ register int ceiling = end - 1; /* If we're looking for a newline, consult the newline cache to see where we can avoid some scanning. */ if (target == '\n' && newline_cache) { int next_change; immediate_quit = 0; while (region_cache_forward (current_buffer, newline_cache, start, &next_change)) start = next_change; immediate_quit = allow_quit; /* start should never be after end. */ if (start >= end) start = end - 1; /* Now the text after start is an unknown region, and next_change is the position of the next known region. */ ceiling = min (next_change - 1, ceiling); } /* The dumb loop can only scan text stored in contiguous bytes. BUFFER_CEILING_OF returns the last character position that is contiguous, so the ceiling is the position after that. */ ceiling = min (BUFFER_CEILING_OF (start), ceiling); { /* The termination address of the dumb loop. */ register unsigned char *ceiling_addr = &FETCH_CHAR (ceiling) + 1; register unsigned char *cursor = &FETCH_CHAR (start); unsigned char *base = cursor; while (cursor < ceiling_addr) { unsigned char *scan_start = cursor; /* The dumb loop. */ while (*cursor != target && ++cursor < ceiling_addr) ; /* If we're looking for newlines, cache the fact that the region from start to cursor is free of them. */ if (target == '\n' && newline_cache) know_region_cache (current_buffer, newline_cache, start + scan_start - base, start + cursor - base); /* Did we find the target character? */ if (cursor < ceiling_addr) { if (--count == 0) { immediate_quit = 0; return (start + cursor - base + 1); } cursor++; } } start += cursor - base; } } else while (start > end) { /* The last character to check before the next obstacle. */ register int ceiling = end; /* Consult the newline cache, if appropriate. */ if (target == '\n' && newline_cache) { int next_change; immediate_quit = 0; while (region_cache_backward (current_buffer, newline_cache, start, &next_change)) start = next_change; immediate_quit = allow_quit; /* Start should never be at or before end. */ if (start <= end) start = end + 1; /* Now the text before start is an unknown region, and next_change is the position of the next known region. */ ceiling = max (next_change, ceiling); } /* Stop scanning before the gap. */ ceiling = max (BUFFER_FLOOR_OF (start - 1), ceiling); { /* The termination address of the dumb loop. */ register unsigned char *ceiling_addr = &FETCH_CHAR (ceiling); register unsigned char *cursor = &FETCH_CHAR (start - 1); unsigned char *base = cursor; while (cursor >= ceiling_addr) { unsigned char *scan_start = cursor; while (*cursor != target && --cursor >= ceiling_addr) ; /* If we're looking for newlines, cache the fact that the region from after the cursor to start is free of them. */ if (target == '\n' && newline_cache) know_region_cache (current_buffer, newline_cache, start + cursor - base, start + scan_start - base); /* Did we find the target character? */ if (cursor >= ceiling_addr) { if (++count >= 0) { immediate_quit = 0; return (start + cursor - base); } cursor--; } } start += cursor - base; } } immediate_quit = 0; if (shortage != 0) *shortage = count * direction; return start; } int find_next_newline_no_quit (from, cnt) register int from, cnt; { return scan_buffer ('\n', from, 0, cnt, (int *) 0, 0); } int find_next_newline (from, cnt) register int from, cnt; { return scan_buffer ('\n', from, 0, cnt, (int *) 0, 1); } /* Like find_next_newline, but returns position before the newline, not after, and only search up to TO. This isn't just find_next_newline (...)-1, because you might hit TO. */ int find_before_next_newline (from, to, cnt) int from, to, cnt; { int shortage; int pos = scan_buffer ('\n', from, to, cnt, &shortage, 1); if (shortage == 0) pos--; return pos; } Lisp_Object skip_chars (); DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0, "Move point forward, stopping before a char not in STRING, or at pos LIM.\n\ STRING is like the inside of a `[...]' in a regular expression\n\ except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\ Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\ With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\ Returns the distance traveled, either zero or positive.") (string, lim) Lisp_Object string, lim; { return skip_chars (1, 0, string, lim); } DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0, "Move point backward, stopping after a char not in STRING, or at pos LIM.\n\ See `skip-chars-forward' for details.\n\ Returns the distance traveled, either zero or negative.") (string, lim) Lisp_Object string, lim; { return skip_chars (0, 0, string, lim); } DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0, "Move point forward across chars in specified syntax classes.\n\ SYNTAX is a string of syntax code characters.\n\ Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\ If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\ This function returns the distance traveled, either zero or positive.") (syntax, lim) Lisp_Object syntax, lim; { return skip_chars (1, 1, syntax, lim); } DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0, "Move point backward across chars in specified syntax classes.\n\ SYNTAX is a string of syntax code characters.\n\ Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\ If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\ This function returns the distance traveled, either zero or negative.") (syntax, lim) Lisp_Object syntax, lim; { return skip_chars (0, 1, syntax, lim); } Lisp_Object skip_chars (forwardp, syntaxp, string, lim) int forwardp, syntaxp; Lisp_Object string, lim; { register unsigned char *p, *pend; register unsigned char c; unsigned char fastmap[0400]; int negate = 0; register int i; CHECK_STRING (string, 0); if (NILP (lim)) XSETINT (lim, forwardp ? ZV : BEGV); else CHECK_NUMBER_COERCE_MARKER (lim, 1); /* In any case, don't allow scan outside bounds of buffer. */ /* jla turned this off, for no known reason. bfox turned the ZV part on, and rms turned the BEGV part back on. */ if (XINT (lim) > ZV) XSETFASTINT (lim, ZV); if (XINT (lim) < BEGV) XSETFASTINT (lim, BEGV); p = XSTRING (string)->data; pend = p + XSTRING (string)->size; bzero (fastmap, sizeof fastmap); if (p != pend && *p == '^') { negate = 1; p++; } /* Find the characters specified and set their elements of fastmap. If syntaxp, each character counts as itself. Otherwise, handle backslashes and ranges specially */ while (p != pend) { c = *p++; if (syntaxp) fastmap[c] = 1; else { if (c == '\\') { if (p == pend) break; c = *p++; } if (p != pend && *p == '-') { p++; if (p == pend) break; while (c <= *p) { fastmap[c] = 1; c++; } p++; } else fastmap[c] = 1; } } if (syntaxp && fastmap['-'] != 0) fastmap[' '] = 1; /* If ^ was the first character, complement the fastmap. */ if (negate) for (i = 0; i < sizeof fastmap; i++) fastmap[i] ^= 1; { int start_point = point; immediate_quit = 1; if (syntaxp) { if (forwardp) { while (point < XINT (lim) && fastmap[(unsigned char) syntax_code_spec[(int) SYNTAX (FETCH_CHAR (point))]]) SET_PT (point + 1); } else { while (point > XINT (lim) && fastmap[(unsigned char) syntax_code_spec[(int) SYNTAX (FETCH_CHAR (point - 1))]]) SET_PT (point - 1); } } else { if (forwardp) { while (point < XINT (lim) && fastmap[FETCH_CHAR (point)]) SET_PT (point + 1); } else { while (point > XINT (lim) && fastmap[FETCH_CHAR (point - 1)]) SET_PT (point - 1); } } immediate_quit = 0; return make_number (point - start_point); } } /* Subroutines of Lisp buffer search functions. */ static Lisp_Object search_command (string, bound, noerror, count, direction, RE, posix) Lisp_Object string, bound, noerror, count; int direction; int RE; int posix; { register int np; int lim; int n = direction; if (!NILP (count)) { CHECK_NUMBER (count, 3); n *= XINT (count); } CHECK_STRING (string, 0); if (NILP (bound)) lim = n > 0 ? ZV : BEGV; else { CHECK_NUMBER_COERCE_MARKER (bound, 1); lim = XINT (bound); if (n > 0 ? lim < point : lim > point) error ("Invalid search bound (wrong side of point)"); if (lim > ZV) lim = ZV; if (lim < BEGV) lim = BEGV; } np = search_buffer (string, point, lim, n, RE, (!NILP (current_buffer->case_fold_search) ? XCHAR_TABLE (current_buffer->case_canon_table)->contents : 0), (!NILP (current_buffer->case_fold_search) ? XCHAR_TABLE (current_buffer->case_eqv_table)->contents : 0), posix); if (np <= 0) { if (NILP (noerror)) return signal_failure (string); if (!EQ (noerror, Qt)) { if (lim < BEGV || lim > ZV) abort (); SET_PT (lim); return Qnil; #if 0 /* This would be clean, but maybe programs depend on a value of nil here. */ np = lim; #endif } else return Qnil; } if (np < BEGV || np > ZV) abort (); SET_PT (np); return make_number (np); } static int trivial_regexp_p (regexp) Lisp_Object regexp; { int len = XSTRING (regexp)->size; unsigned char *s = XSTRING (regexp)->data; unsigned char c; while (--len >= 0) { switch (*s++) { case '.': case '*': case '+': case '?': case '[': case '^': case '$': return 0; case '\\': if (--len < 0) return 0; switch (*s++) { case '|': case '(': case ')': case '`': case '\'': case 'b': case 'B': case '<': case '>': case 'w': case 'W': case 's': case 'S': case '=': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': return 0; } } } return 1; } /* Search for the n'th occurrence of STRING in the current buffer, starting at position POS and stopping at position LIM, treating STRING as a literal string if RE is false or as a regular expression if RE is true. If N is positive, searching is forward and LIM must be greater than POS. If N is negative, searching is backward and LIM must be less than POS. Returns -x if only N-x occurrences found (x > 0), or else the position at the beginning of the Nth occurrence (if searching backward) or the end (if searching forward). POSIX is nonzero if we want full backtracking (POSIX style) for this pattern. 0 means backtrack only enough to get a valid match. */ static int search_buffer (string, pos, lim, n, RE, trt, inverse_trt, posix) Lisp_Object string; int pos; int lim; int n; int RE; Lisp_Object *trt; Lisp_Object *inverse_trt; int posix; { int len = XSTRING (string)->size; unsigned char *base_pat = XSTRING (string)->data; register int *BM_tab; int *BM_tab_base; register int direction = ((n > 0) ? 1 : -1); register int dirlen; int infinity, limit, k, stride_for_teases; register unsigned char *pat, *cursor, *p_limit; register int i, j; unsigned char *p1, *p2; int s1, s2; if (running_asynch_code) save_search_regs (); /* Null string is found at starting position. */ if (len == 0) { set_search_regs (pos, 0); return pos; } /* Searching 0 times means don't move. */ if (n == 0) return pos; if (RE && !trivial_regexp_p (string)) { struct re_pattern_buffer *bufp; bufp = compile_pattern (string, &search_regs, trt, posix); immediate_quit = 1; /* Quit immediately if user types ^G, because letting this function finish can take too long. */ QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ /* Get pointers and sizes of the two strings that make up the visible portion of the buffer. */ p1 = BEGV_ADDR; s1 = GPT - BEGV; p2 = GAP_END_ADDR; s2 = ZV - GPT; if (s1 < 0) { p2 = p1; s2 = ZV - BEGV; s1 = 0; } if (s2 < 0) { s1 = ZV - BEGV; s2 = 0; } while (n < 0) { int val; val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, pos - BEGV, lim - pos, &search_regs, /* Don't allow match past current point */ pos - BEGV); if (val == -2) { matcher_overflow (); } if (val >= 0) { j = BEGV; for (i = 0; i < search_regs.num_regs; i++) if (search_regs.start[i] >= 0) { search_regs.start[i] += j; search_regs.end[i] += j; } XSETBUFFER (last_thing_searched, current_buffer); /* Set pos to the new position. */ pos = search_regs.start[0]; } else { immediate_quit = 0; return (n); } n++; } while (n > 0) { int val; val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, pos - BEGV, lim - pos, &search_regs, lim - BEGV); if (val == -2) { matcher_overflow (); } if (val >= 0) { j = BEGV; for (i = 0; i < search_regs.num_regs; i++) if (search_regs.start[i] >= 0) { search_regs.start[i] += j; search_regs.end[i] += j; } XSETBUFFER (last_thing_searched, current_buffer); pos = search_regs.end[0]; } else { immediate_quit = 0; return (0 - n); } n--; } immediate_quit = 0; return (pos); } else /* non-RE case */ { #ifdef C_ALLOCA int BM_tab_space[0400]; BM_tab = &BM_tab_space[0]; #else BM_tab = (int *) alloca (0400 * sizeof (int)); #endif { unsigned char *patbuf = (unsigned char *) alloca (len); pat = patbuf; while (--len >= 0) { /* If we got here and the RE flag is set, it's because we're dealing with a regexp known to be trivial, so the backslash just quotes the next character. */ if (RE && *base_pat == '\\') { len--; base_pat++; } *pat++ = (trt ? trt[*base_pat++] : *base_pat++); } len = pat - patbuf; pat = base_pat = patbuf; } /* The general approach is that we are going to maintain that we know */ /* the first (closest to the present position, in whatever direction */ /* we're searching) character that could possibly be the last */ /* (furthest from present position) character of a valid match. We */ /* advance the state of our knowledge by looking at that character */ /* and seeing whether it indeed matches the last character of the */ /* pattern. If it does, we take a closer look. If it does not, we */ /* move our pointer (to putative last characters) as far as is */ /* logically possible. This amount of movement, which I call a */ /* stride, will be the length of the pattern if the actual character */ /* appears nowhere in the pattern, otherwise it will be the distance */ /* from the last occurrence of that character to the end of the */ /* pattern. */ /* As a coding trick, an enormous stride is coded into the table for */ /* characters that match the last character. This allows use of only */ /* a single test, a test for having gone past the end of the */ /* permissible match region, to test for both possible matches (when */ /* the stride goes past the end immediately) and failure to */ /* match (where you get nudged past the end one stride at a time). */ /* Here we make a "mickey mouse" BM table. The stride of the search */ /* is determined only by the last character of the putative match. */ /* If that character does not match, we will stride the proper */ /* distance to propose a match that superimposes it on the last */ /* instance of a character that matches it (per trt), or misses */ /* it entirely if there is none. */ dirlen = len * direction; infinity = dirlen - (lim + pos + len + len) * direction; if (direction < 0) pat = (base_pat += len - 1); BM_tab_base = BM_tab; BM_tab += 0400; j = dirlen; /* to get it in a register */ /* A character that does not appear in the pattern induces a */ /* stride equal to the pattern length. */ while (BM_tab_base != BM_tab) { *--BM_tab = j; *--BM_tab = j; *--BM_tab = j; *--BM_tab = j; } i = 0; while (i != infinity) { j = pat[i]; i += direction; if (i == dirlen) i = infinity; if (trt != 0) { k = (j = trt[j]); if (i == infinity) stride_for_teases = BM_tab[j]; BM_tab[j] = dirlen - i; /* A translation table is accompanied by its inverse -- see */ /* comment following downcase_table for details */ while ((j = (unsigned char) inverse_trt[j]) != k) BM_tab[j] = dirlen - i; } else { if (i == infinity) stride_for_teases = BM_tab[j]; BM_tab[j] = dirlen - i; } /* stride_for_teases tells how much to stride if we get a */ /* match on the far character but are subsequently */ /* disappointed, by recording what the stride would have been */ /* for that character if the last character had been */ /* different. */ } infinity = dirlen - infinity; pos += dirlen - ((direction > 0) ? direction : 0); /* loop invariant - pos points at where last char (first char if reverse) of pattern would align in a possible match. */ while (n != 0) { /* It's been reported that some (broken) compiler thinks that Boolean expressions in an arithmetic context are unsigned. Using an explicit ?1:0 prevents this. */ if ((lim - pos - ((direction > 0) ? 1 : 0)) * direction < 0) return (n * (0 - direction)); /* First we do the part we can by pointers (maybe nothing) */ QUIT; pat = base_pat; limit = pos - dirlen + direction; limit = ((direction > 0) ? BUFFER_CEILING_OF (limit) : BUFFER_FLOOR_OF (limit)); /* LIMIT is now the last (not beyond-last!) value POS can take on without hitting edge of buffer or the gap. */ limit = ((direction > 0) ? min (lim - 1, min (limit, pos + 20000)) : max (lim, max (limit, pos - 20000))); if ((limit - pos) * direction > 20) { p_limit = &FETCH_CHAR (limit); p2 = (cursor = &FETCH_CHAR (pos)); /* In this loop, pos + cursor - p2 is the surrogate for pos */ while (1) /* use one cursor setting as long as i can */ { if (direction > 0) /* worth duplicating */ { /* Use signed comparison if appropriate to make cursor+infinity sure to be > p_limit. Assuming that the buffer lies in a range of addresses that are all "positive" (as ints) or all "negative", either kind of comparison will work as long as we don't step by infinity. So pick the kind that works when we do step by infinity. */ if ((EMACS_INT) (p_limit + infinity) > (EMACS_INT) p_limit) while ((EMACS_INT) cursor <= (EMACS_INT) p_limit) cursor += BM_tab[*cursor]; else while ((unsigned EMACS_INT) cursor <= (unsigned EMACS_INT) p_limit) cursor += BM_tab[*cursor]; } else { if ((EMACS_INT) (p_limit + infinity) < (EMACS_INT) p_limit) while ((EMACS_INT) cursor >= (EMACS_INT) p_limit) cursor += BM_tab[*cursor]; else while ((unsigned EMACS_INT) cursor >= (unsigned EMACS_INT) p_limit) cursor += BM_tab[*cursor]; } /* If you are here, cursor is beyond the end of the searched region. */ /* This can happen if you match on the far character of the pattern, */ /* because the "stride" of that character is infinity, a number able */ /* to throw you well beyond the end of the search. It can also */ /* happen if you fail to match within the permitted region and would */ /* otherwise try a character beyond that region */ if ((cursor - p_limit) * direction <= len) break; /* a small overrun is genuine */ cursor -= infinity; /* large overrun = hit */ i = dirlen - direction; if (trt != 0) { while ((i -= direction) + direction != 0) if (pat[i] != trt[*(cursor -= direction)]) break; } else { while ((i -= direction) + direction != 0) if (pat[i] != *(cursor -= direction)) break; } cursor += dirlen - i - direction; /* fix cursor */ if (i + direction == 0) { cursor -= direction; set_search_regs (pos + cursor - p2 + ((direction > 0) ? 1 - len : 0), len); if ((n -= direction) != 0) cursor += dirlen; /* to resume search */ else return ((direction > 0) ? search_regs.end[0] : search_regs.start[0]); } else cursor += stride_for_teases; /* we lose - */ } pos += cursor - p2; } else /* Now we'll pick up a clump that has to be done the hard */ /* way because it covers a discontinuity */ { limit = ((direction > 0) ? BUFFER_CEILING_OF (pos - dirlen + 1) : BUFFER_FLOOR_OF (pos - dirlen - 1)); limit = ((direction > 0) ? min (limit + len, lim - 1) : max (limit - len, lim)); /* LIMIT is now the last value POS can have and still be valid for a possible match. */ while (1) { /* This loop can be coded for space rather than */ /* speed because it will usually run only once. */ /* (the reach is at most len + 21, and typically */ /* does not exceed len) */ while ((limit - pos) * direction >= 0) pos += BM_tab[FETCH_CHAR(pos)]; /* now run the same tests to distinguish going off the */ /* end, a match or a phony match. */ if ((pos - limit) * direction <= len) break; /* ran off the end */ /* Found what might be a match. Set POS back to last (first if reverse) char pos. */ pos -= infinity; i = dirlen - direction; while ((i -= direction) + direction != 0) { pos -= direction; if (pat[i] != (trt != 0 ? trt[FETCH_CHAR(pos)] : FETCH_CHAR (pos))) break; } /* Above loop has moved POS part or all the way back to the first char pos (last char pos if reverse). Set it once again at the last (first if reverse) char. */ pos += dirlen - i- direction; if (i + direction == 0) { pos -= direction; set_search_regs (pos + ((direction > 0) ? 1 - len : 0), len); if ((n -= direction) != 0) pos += dirlen; /* to resume search */ else return ((direction > 0) ? search_regs.end[0] : search_regs.start[0]); } else pos += stride_for_teases; } } /* We have done one clump. Can we continue? */ if ((lim - pos) * direction < 0) return ((0 - n) * direction); } return pos; } } /* Record beginning BEG and end BEG + LEN for a match just found in the current buffer. */ static void set_search_regs (beg, len) int beg, len; { /* Make sure we have registers in which to store the match position. */ if (search_regs.num_regs == 0) { search_regs.start = (regoff_t *) xmalloc (2 * sizeof (regoff_t)); search_regs.end = (regoff_t *) xmalloc (2 * sizeof (regoff_t)); search_regs.num_regs = 2; } search_regs.start[0] = beg; search_regs.end[0] = beg + len; XSETBUFFER (last_thing_searched, current_buffer); } /* Given a string of words separated by word delimiters, compute a regexp that matches those exact words separated by arbitrary punctuation. */ static Lisp_Object wordify (string) Lisp_Object string; { register unsigned char *p, *o; register int i, len, punct_count = 0, word_count = 0; Lisp_Object val; CHECK_STRING (string, 0); p = XSTRING (string)->data; len = XSTRING (string)->size; for (i = 0; i < len; i++) if (SYNTAX (p[i]) != Sword) { punct_count++; if (i > 0 && SYNTAX (p[i-1]) == Sword) word_count++; } if (SYNTAX (p[len-1]) == Sword) word_count++; if (!word_count) return build_string (""); val = make_string (p, len - punct_count + 5 * (word_count - 1) + 4); o = XSTRING (val)->data; *o++ = '\\'; *o++ = 'b'; for (i = 0; i < len; i++) if (SYNTAX (p[i]) == Sword) *o++ = p[i]; else if (i > 0 && SYNTAX (p[i-1]) == Sword && --word_count) { *o++ = '\\'; *o++ = 'W'; *o++ = '\\'; *o++ = 'W'; *o++ = '*'; } *o++ = '\\'; *o++ = 'b'; return val; } DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4, "sSearch backward: ", "Search backward from point for STRING.\n\ Set point to the beginning of the occurrence found, and return point.\n\ An optional second argument bounds the search; it is a buffer position.\n\ The match found must not extend before that position.\n\ Optional third argument, if t, means if fail just return nil (no error).\n\ If not nil and not t, position at limit of search and return nil.\n\ Optional fourth argument is repeat count--search for successive occurrences.\n\ See also the functions `match-beginning', `match-end' and `replace-match'.") (string, bound, noerror, count) Lisp_Object string, bound, noerror, count; { return search_command (string, bound, noerror, count, -1, 0, 0); } DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "sSearch: ", "Search forward from point for STRING.\n\ Set point to the end of the occurrence found, and return point.\n\ An optional second argument bounds the search; it is a buffer position.\n\ The match found must not extend after that position. nil is equivalent\n\ to (point-max).\n\ Optional third argument, if t, means if fail just return nil (no error).\n\ If not nil and not t, move to limit of search and return nil.\n\ Optional fourth argument is repeat count--search for successive occurrences.\n\ See also the functions `match-beginning', `match-end' and `replace-match'.") (string, bound, noerror, count) Lisp_Object string, bound, noerror, count; { return search_command (string, bound, noerror, count, 1, 0, 0); } DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4, "sWord search backward: ", "Search backward from point for STRING, ignoring differences in punctuation.\n\ Set point to the beginning of the occurrence found, and return point.\n\ An optional second argument bounds the search; it is a buffer position.\n\ The match found must not extend before that position.\n\ Optional third argument, if t, means if fail just return nil (no error).\n\ If not nil and not t, move to limit of search and return nil.\n\ Optional fourth argument is repeat count--search for successive occurrences.") (string, bound, noerror, count) Lisp_Object string, bound, noerror, count; { return search_command (wordify (string), bound, noerror, count, -1, 1, 0); } DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4, "sWord search: ", "Search forward from point for STRING, ignoring differences in punctuation.\n\ Set point to the end of the occurrence found, and return point.\n\ An optional second argument bounds the search; it is a buffer position.\n\ The match found must not extend after that position.\n\ Optional third argument, if t, means if fail just return nil (no error).\n\ If not nil and not t, move to limit of search and return nil.\n\ Optional fourth argument is repeat count--search for successive occurrences.") (string, bound, noerror, count) Lisp_Object string, bound, noerror, count; { return search_command (wordify (string), bound, noerror, count, 1, 1, 0); } DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4, "sRE search backward: ", "Search backward from point for match for regular expression REGEXP.\n\ Set point to the beginning of the match, and return point.\n\ The match found is the one starting last in the buffer\n\ and yet ending before the origin of the search.\n\ An optional second argument bounds the search; it is a buffer position.\n\ The match found must start at or after that position.\n\ Optional third argument, if t, means if fail just return nil (no error).\n\ If not nil and not t, move to limit of search and return nil.\n\ Optional fourth argument is repeat count--search for successive occurrences.\n\ See also the functions `match-beginning', `match-end' and `replace-match'.") (regexp, bound, noerror, count) Lisp_Object regexp, bound, noerror, count; { return search_command (regexp, bound, noerror, count, -1, 1, 0); } DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4, "sRE search: ", "Search forward from point for regular expression REGEXP.\n\ Set point to the end of the occurrence found, and return point.\n\ An optional second argument bounds the search; it is a buffer position.\n\ The match found must not extend after that position.\n\ Optional third argument, if t, means if fail just return nil (no error).\n\ If not nil and not t, move to limit of search and return nil.\n\ Optional fourth argument is repeat count--search for successive occurrences.\n\ See also the functions `match-beginning', `match-end' and `replace-match'.") (regexp, bound, noerror, count) Lisp_Object regexp, bound, noerror, count; { return search_command (regexp, bound, noerror, count, 1, 1, 0); } DEFUN ("posix-search-backward", Fposix_search_backward, Sposix_search_backward, 1, 4, "sPosix search backward: ", "Search backward from point for match for regular expression REGEXP.\n\ Find the longest match in accord with Posix regular expression rules.\n\ Set point to the beginning of the match, and return point.\n\ The match found is the one starting last in the buffer\n\ and yet ending before the origin of the search.\n\ An optional second argument bounds the search; it is a buffer position.\n\ The match found must start at or after that position.\n\ Optional third argument, if t, means if fail just return nil (no error).\n\ If not nil and not t, move to limit of search and return nil.\n\ Optional fourth argument is repeat count--search for successive occurrences.\n\ See also the functions `match-beginning', `match-end' and `replace-match'.") (regexp, bound, noerror, count) Lisp_Object regexp, bound, noerror, count; { return search_command (regexp, bound, noerror, count, -1, 1, 1); } DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward, 1, 4, "sPosix search: ", "Search forward from point for regular expression REGEXP.\n\ Find the longest match in accord with Posix regular expression rules.\n\ Set point to the end of the occurrence found, and return point.\n\ An optional second argument bounds the search; it is a buffer position.\n\ The match found must not extend after that position.\n\ Optional third argument, if t, means if fail just return nil (no error).\n\ If not nil and not t, move to limit of search and return nil.\n\ Optional fourth argument is repeat count--search for successive occurrences.\n\ See also the functions `match-beginning', `match-end' and `replace-match'.") (regexp, bound, noerror, count) Lisp_Object regexp, bound, noerror, count; { return search_command (regexp, bound, noerror, count, 1, 1, 1); } DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 0, "Replace text matched by last search with NEWTEXT.\n\ If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\ Otherwise maybe capitalize the whole text, or maybe just word initials,\n\ based on the replaced text.\n\ If the replaced text has only capital letters\n\ and has at least one multiletter word, convert NEWTEXT to all caps.\n\ If the replaced text has at least one word starting with a capital letter,\n\ then capitalize each word in NEWTEXT.\n\n\ If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\ Otherwise treat `\\' as special:\n\ `\\&' in NEWTEXT means substitute original matched text.\n\ `\\N' means substitute what matched the Nth `\\(...\\)'.\n\ If Nth parens didn't match, substitute nothing.\n\ `\\\\' means insert one `\\'.\n\ FIXEDCASE and LITERAL are optional arguments.\n\ Leaves point at end of replacement text.\n\ \n\ The optional fourth argument STRING can be a string to modify.\n\ In that case, this function creates and returns a new string\n\ which is made by replacing the part of STRING that was matched.\n\ \n\ The optional fifth argument SUBEXP specifies a subexpression of the match.\n\ It says to replace just that subexpression instead of the whole match.\n\ This is useful only after a regular expression search or match\n\ since only regular expressions have distinguished subexpressions.") (newtext, fixedcase, literal, string, subexp) Lisp_Object newtext, fixedcase, literal, string, subexp; { enum { nochange, all_caps, cap_initial } case_action; register int pos, last; int some_multiletter_word; int some_lowercase; int some_uppercase; int some_nonuppercase_initial; register int c, prevc; int inslen; int sub; CHECK_STRING (newtext, 0); if (! NILP (string)) CHECK_STRING (string, 4); case_action = nochange; /* We tried an initialization */ /* but some C compilers blew it */ if (search_regs.num_regs <= 0) error ("replace-match called before any match found"); if (NILP (subexp)) sub = 0; else { CHECK_NUMBER (subexp, 3); sub = XINT (subexp); if (sub < 0 || sub >= search_regs.num_regs) args_out_of_range (subexp, make_number (search_regs.num_regs)); } if (NILP (string)) { if (search_regs.start[sub] < BEGV || search_regs.start[sub] > search_regs.end[sub] || search_regs.end[sub] > ZV) args_out_of_range (make_number (search_regs.start[sub]), make_number (search_regs.end[sub])); } else { if (search_regs.start[sub] < 0 || search_regs.start[sub] > search_regs.end[sub] || search_regs.end[sub] > XSTRING (string)->size) args_out_of_range (make_number (search_regs.start[sub]), make_number (search_regs.end[sub])); } if (NILP (fixedcase)) { /* Decide how to casify by examining the matched text. */ last = search_regs.end[sub]; prevc = '\n'; case_action = all_caps; /* some_multiletter_word is set nonzero if any original word is more than one letter long. */ some_multiletter_word = 0; some_lowercase = 0; some_nonuppercase_initial = 0; some_uppercase = 0; for (pos = search_regs.start[sub]; pos < last; pos++) { if (NILP (string)) c = FETCH_CHAR (pos); else c = XSTRING (string)->data[pos]; if (LOWERCASEP (c)) { /* Cannot be all caps if any original char is lower case */ some_lowercase = 1; if (SYNTAX (prevc) != Sword) some_nonuppercase_initial = 1; else some_multiletter_word = 1; } else if (!NOCASEP (c)) { some_uppercase = 1; if (SYNTAX (prevc) != Sword) ; else some_multiletter_word = 1; } else { /* If the initial is a caseless word constituent, treat that like a lowercase initial. */ if (SYNTAX (prevc) != Sword) some_nonuppercase_initial = 1; } prevc = c; } /* Convert to all caps if the old text is all caps and has at least one multiletter word. */ if (! some_lowercase && some_multiletter_word) case_action = all_caps; /* Capitalize each word, if the old text has all capitalized words. */ else if (!some_nonuppercase_initial && some_multiletter_word) case_action = cap_initial; else if (!some_nonuppercase_initial && some_uppercase) /* Should x -> yz, operating on X, give Yz or YZ? We'll assume the latter. */ case_action = all_caps; else case_action = nochange; } /* Do replacement in a string. */ if (!NILP (string)) { Lisp_Object before, after; before = Fsubstring (string, make_number (0), make_number (search_regs.start[sub])); after = Fsubstring (string, make_number (search_regs.end[sub]), Qnil); /* Do case substitution into NEWTEXT if desired. */ if (NILP (literal)) { int lastpos = -1; /* We build up the substituted string in ACCUM. */ Lisp_Object accum; Lisp_Object middle; accum = Qnil; for (pos = 0; pos < XSTRING (newtext)->size; pos++) { int substart = -1; int subend; int delbackslash = 0; c = XSTRING (newtext)->data[pos]; if (c == '\\') { c = XSTRING (newtext)->data[++pos]; if (c == '&') { substart = search_regs.start[sub]; subend = search_regs.end[sub]; } else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0') { if (search_regs.start[c - '0'] >= 0) { substart = search_regs.start[c - '0']; subend = search_regs.end[c - '0']; } } else if (c == '\\') delbackslash = 1; } if (substart >= 0) { if (pos - 1 != lastpos + 1) middle = Fsubstring (newtext, make_number (lastpos + 1), make_number (pos - 1)); else middle = Qnil; accum = concat3 (accum, middle, Fsubstring (string, make_number (substart), make_number (subend))); lastpos = pos; } else if (delbackslash) { middle = Fsubstring (newtext, make_number (lastpos + 1), make_number (pos)); accum = concat2 (accum, middle); lastpos = pos; } } if (pos != lastpos + 1) middle = Fsubstring (newtext, make_number (lastpos + 1), make_number (pos)); else middle = Qnil; newtext = concat2 (accum, middle); } if (case_action == all_caps) newtext = Fupcase (newtext); else if (case_action == cap_initial) newtext = Fupcase_initials (newtext); return concat3 (before, newtext, after); } /* We insert the replacement text before the old text, and then delete the original text. This means that markers at the beginning or end of the original will float to the corresponding position in the replacement. */ SET_PT (search_regs.start[sub]); if (!NILP (literal)) Finsert_and_inherit (1, &newtext); else { struct gcpro gcpro1; GCPRO1 (newtext); for (pos = 0; pos < XSTRING (newtext)->size; pos++) { int offset = point - search_regs.start[sub]; c = XSTRING (newtext)->data[pos]; if (c == '\\') { c = XSTRING (newtext)->data[++pos]; if (c == '&') Finsert_buffer_substring (Fcurrent_buffer (), make_number (search_regs.start[sub] + offset), make_number (search_regs.end[sub] + offset)); else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0') { if (search_regs.start[c - '0'] >= 1) Finsert_buffer_substring (Fcurrent_buffer (), make_number (search_regs.start[c - '0'] + offset), make_number (search_regs.end[c - '0'] + offset)); } else insert_char (c); } else insert_char (c); } UNGCPRO; } inslen = point - (search_regs.start[sub]); del_range (search_regs.start[sub] + inslen, search_regs.end[sub] + inslen); if (case_action == all_caps) Fupcase_region (make_number (point - inslen), make_number (point)); else if (case_action == cap_initial) Fupcase_initials_region (make_number (point - inslen), make_number (point)); return Qnil; } static Lisp_Object match_limit (num, beginningp) Lisp_Object num; int beginningp; { register int n; CHECK_NUMBER (num, 0); n = XINT (num); if (n < 0 || n >= search_regs.num_regs) args_out_of_range (num, make_number (search_regs.num_regs)); if (search_regs.num_regs <= 0 || search_regs.start[n] < 0) return Qnil; return (make_number ((beginningp) ? search_regs.start[n] : search_regs.end[n])); } DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0, "Return position of start of text matched by last search.\n\ NUM specifies which parenthesized expression in the last regexp.\n\ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.\n\ Zero means the entire text matched by the whole regexp or whole string.") (num) Lisp_Object num; { return match_limit (num, 1); } DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0, "Return position of end of text matched by last search.\n\ ARG, a number, specifies which parenthesized expression in the last regexp.\n\ Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\ Zero means the entire text matched by the whole regexp or whole string.") (num) Lisp_Object num; { return match_limit (num, 0); } DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 0, 0, "Return a list containing all info on what the last search matched.\n\ Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.\n\ All the elements are markers or nil (nil if the Nth pair didn't match)\n\ if the last match was on a buffer; integers or nil if a string was matched.\n\ Use `store-match-data' to reinstate the data in this list.") () { Lisp_Object *data; int i, len; if (NILP (last_thing_searched)) error ("match-data called before any match found"); data = (Lisp_Object *) alloca ((2 * search_regs.num_regs) * sizeof (Lisp_Object)); len = -1; for (i = 0; i < search_regs.num_regs; i++) { int start = search_regs.start[i]; if (start >= 0) { if (EQ (last_thing_searched, Qt)) { XSETFASTINT (data[2 * i], start); XSETFASTINT (data[2 * i + 1], search_regs.end[i]); } else if (BUFFERP (last_thing_searched)) { data[2 * i] = Fmake_marker (); Fset_marker (data[2 * i], make_number (start), last_thing_searched); data[2 * i + 1] = Fmake_marker (); Fset_marker (data[2 * i + 1], make_number (search_regs.end[i]), last_thing_searched); } else /* last_thing_searched must always be Qt, a buffer, or Qnil. */ abort (); len = i; } else data[2 * i] = data [2 * i + 1] = Qnil; } return Flist (2 * len + 2, data); } DEFUN ("store-match-data", Fstore_match_data, Sstore_match_data, 1, 1, 0, "Set internal data on last search match from elements of LIST.\n\ LIST should have been created by calling `match-data' previously.") (list) register Lisp_Object list; { register int i; register Lisp_Object marker; if (running_asynch_code) save_search_regs (); if (!CONSP (list) && !NILP (list)) list = wrong_type_argument (Qconsp, list); /* Unless we find a marker with a buffer in LIST, assume that this match data came from a string. */ last_thing_searched = Qt; /* Allocate registers if they don't already exist. */ { int length = XFASTINT (Flength (list)) / 2; if (length > search_regs.num_regs) { if (search_regs.num_regs == 0) { search_regs.start = (regoff_t *) xmalloc (length * sizeof (regoff_t)); search_regs.end = (regoff_t *) xmalloc (length * sizeof (regoff_t)); } else { search_regs.start = (regoff_t *) xrealloc (search_regs.start, length * sizeof (regoff_t)); search_regs.end = (regoff_t *) xrealloc (search_regs.end, length * sizeof (regoff_t)); } search_regs.num_regs = length; } } for (i = 0; i < search_regs.num_regs; i++) { marker = Fcar (list); if (NILP (marker)) { search_regs.start[i] = -1; list = Fcdr (list); } else { if (MARKERP (marker)) { if (XMARKER (marker)->buffer == 0) XSETFASTINT (marker, 0); else XSETBUFFER (last_thing_searched, XMARKER (marker)->buffer); } CHECK_NUMBER_COERCE_MARKER (marker, 0); search_regs.start[i] = XINT (marker); list = Fcdr (list); marker = Fcar (list); if (MARKERP (marker) && XMARKER (marker)->buffer == 0) XSETFASTINT (marker, 0); CHECK_NUMBER_COERCE_MARKER (marker, 0); search_regs.end[i] = XINT (marker); } list = Fcdr (list); } return Qnil; } /* If non-zero the match data have been saved in saved_search_regs during the execution of a sentinel or filter. */ static int search_regs_saved; static struct re_registers saved_search_regs; /* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data if asynchronous code (filter or sentinel) is running. */ static void save_search_regs () { if (!search_regs_saved) { saved_search_regs.num_regs = search_regs.num_regs; saved_search_regs.start = search_regs.start; saved_search_regs.end = search_regs.end; search_regs.num_regs = 0; search_regs.start = 0; search_regs.end = 0; search_regs_saved = 1; } } /* Called upon exit from filters and sentinels. */ void restore_match_data () { if (search_regs_saved) { if (search_regs.num_regs > 0) { xfree (search_regs.start); xfree (search_regs.end); } search_regs.num_regs = saved_search_regs.num_regs; search_regs.start = saved_search_regs.start; search_regs.end = saved_search_regs.end; search_regs_saved = 0; } } /* Quote a string to inactivate reg-expr chars */ DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0, "Return a regexp string which matches exactly STRING and nothing else.") (str) Lisp_Object str; { register unsigned char *in, *out, *end; register unsigned char *temp; CHECK_STRING (str, 0); temp = (unsigned char *) alloca (XSTRING (str)->size * 2); /* Now copy the data into the new string, inserting escapes. */ in = XSTRING (str)->data; end = in + XSTRING (str)->size; out = temp; for (; in != end; in++) { if (*in == '[' || *in == ']' || *in == '*' || *in == '.' || *in == '\\' || *in == '?' || *in == '+' || *in == '^' || *in == '$') *out++ = '\\'; *out++ = *in; } return make_string (temp, out - temp); } syms_of_search () { register int i; for (i = 0; i < REGEXP_CACHE_SIZE; ++i) { searchbufs[i].buf.allocated = 100; searchbufs[i].buf.buffer = (unsigned char *) malloc (100); searchbufs[i].buf.fastmap = searchbufs[i].fastmap; searchbufs[i].regexp = Qnil; staticpro (&searchbufs[i].regexp); searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]); } searchbuf_head = &searchbufs[0]; Qsearch_failed = intern ("search-failed"); staticpro (&Qsearch_failed); Qinvalid_regexp = intern ("invalid-regexp"); staticpro (&Qinvalid_regexp); Fput (Qsearch_failed, Qerror_conditions, Fcons (Qsearch_failed, Fcons (Qerror, Qnil))); Fput (Qsearch_failed, Qerror_message, build_string ("Search failed")); Fput (Qinvalid_regexp, Qerror_conditions, Fcons (Qinvalid_regexp, Fcons (Qerror, Qnil))); Fput (Qinvalid_regexp, Qerror_message, build_string ("Invalid regexp")); last_thing_searched = Qnil; staticpro (&last_thing_searched); defsubr (&Slooking_at); defsubr (&Sposix_looking_at); defsubr (&Sstring_match); defsubr (&Sposix_string_match); defsubr (&Sskip_chars_forward); defsubr (&Sskip_chars_backward); defsubr (&Sskip_syntax_forward); defsubr (&Sskip_syntax_backward); defsubr (&Ssearch_forward); defsubr (&Ssearch_backward); defsubr (&Sword_search_forward); defsubr (&Sword_search_backward); defsubr (&Sre_search_forward); defsubr (&Sre_search_backward); defsubr (&Sposix_search_forward); defsubr (&Sposix_search_backward); defsubr (&Sreplace_match); defsubr (&Smatch_beginning); defsubr (&Smatch_end); defsubr (&Smatch_data); defsubr (&Sstore_match_data); defsubr (&Sregexp_quote); } emacs-19.30/src/strftime.c100444 21570 1 26767 5641636704 13727 0ustar djmdaemon/* strftime - custom formatting of date and/or time Copyright (C) 1989, 1991, 1992 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ /* Note: this version of strftime lacks locale support, but it is standalone. Performs `%' substitutions similar to those in printf. Except where noted, substituted fields have a fixed size; numeric fields are padded if necessary. Padding is with zeros by default; for fields that display a single number, padding can be changed or inhibited by following the `%' with one of the modifiers described below. Unknown field specifiers are copied as normal characters. All other characters are copied to the output without change. Supports a superset of the ANSI C field specifiers. Literal character fields: % % n newline t tab Numeric modifiers (a nonstandard extension): - do not pad the field _ pad the field with spaces Time fields: %H hour (00..23) %I hour (01..12) %k hour ( 0..23) %l hour ( 1..12) %M minute (00..59) %p locale's AM or PM %r time, 12-hour (hh:mm:ss [AP]M) %R time, 24-hour (hh:mm) %s time in seconds since 00:00:00, Jan 1, 1970 (a nonstandard extension) %S second (00..61) %T time, 24-hour (hh:mm:ss) %X locale's time representation (%H:%M:%S) %Z time zone (EDT), or nothing if no time zone is determinable Date fields: %a locale's abbreviated weekday name (Sun..Sat) %A locale's full weekday name, variable length (Sunday..Saturday) %b locale's abbreviated month name (Jan..Dec) %B locale's full month name, variable length (January..December) %c locale's date and time (Sat Nov 04 12:02:33 EST 1989) %C century (00..99) %d day of month (01..31) %e day of month ( 1..31) %D date (mm/dd/yy) %h same as %b %j day of year (001..366) %m month (01..12) %U week number of year with Sunday as first day of week (00..53) %w day of week (0..6) %W week number of year with Monday as first day of week (00..53) %x locale's date representation (mm/dd/yy) %y last two digits of year (00..99) %Y year (1970...) David MacKenzie */ #ifdef HAVE_CONFIG_H #include #endif #include #include #if defined(TM_IN_SYS_TIME) || (!defined(HAVE_TM_ZONE) && !defined(HAVE_TZNAME)) #include #else #include #endif #ifndef STDC_HEADERS time_t mktime (); #endif #if defined(HAVE_TZNAME) extern char *tzname[2]; #endif /* Types of padding for numbers in date and time. */ enum padding { none, blank, zero }; static char const* const days[] = { "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" }; static char const * const months[] = { "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December" }; /* Add character C to STRING and increment LENGTH, unless LENGTH would exceed MAX. */ #define add_char(c) \ do \ { \ if (length + 1 <= max) \ string[length++] = (c); \ } \ while (0) /* Add a 2 digit number to STRING, padding if specified. Return the number of characters added, up to MAX. */ static int add_num2 (string, num, max, pad) char *string; int num; int max; enum padding pad; { int top = num / 10; int length = 0; if (top == 0 && pad == blank) add_char (' '); else if (top != 0 || pad == zero) add_char (top + '0'); add_char (num % 10 + '0'); return length; } /* Add a 3 digit number to STRING, padding if specified. Return the number of characters added, up to MAX. */ static int add_num3 (string, num, max, pad) char *string; int num; int max; enum padding pad; { int top = num / 100; int mid = (num - top * 100) / 10; int length = 0; if (top == 0 && pad == blank) add_char (' '); else if (top != 0 || pad == zero) add_char (top + '0'); if (mid == 0 && top == 0 && pad == blank) add_char (' '); else if (mid != 0 || top != 0 || pad == zero) add_char (mid + '0'); add_char (num % 10 + '0'); return length; } /* Like strncpy except return the number of characters copied. */ static int add_str (to, from, max) char *to; const char *from; int max; { int i; for (i = 0; from[i] && i <= max; ++i) to[i] = from[i]; return i; } static int add_num_time_t (string, max, num) char *string; int max; time_t num; { /* This buffer is large enough to hold the character representation (including the trailing NUL) of any unsigned decimal quantity whose binary representation fits in 128 bits. */ char buf[40]; int length; if (sizeof (num) > 16) abort (); sprintf (buf, "%lu", (unsigned long) num); length = add_str (string, buf, max); return length; } /* Return the week in the year of the time in TM, with the weeks starting on Sundays. */ static int sun_week (tm) struct tm *tm; { int dl; /* Set `dl' to the day in the year of the last day of the week previous to the one containing the day specified in TM. If the day specified in TM is in the first week of the year, `dl' will be negative or 0. Otherwise, calculate the number of complete weeks before our week (dl / 7) and add any partial week at the start of the year (dl % 7). */ dl = tm->tm_yday - tm->tm_wday; return dl <= 0 ? 0 : dl / 7 + (dl % 7 != 0); } /* Return the week in the year of the time in TM, with the weeks starting on Mondays. */ static int mon_week (tm) struct tm *tm; { int dl, wday; if (tm->tm_wday == 0) wday = 6; else wday = tm->tm_wday - 1; dl = tm->tm_yday - wday; return dl <= 0 ? 0 : dl / 7 + (dl % 7 != 0); } #if !defined(HAVE_TM_ZONE) && !defined(HAVE_TZNAME) char * zone_name (tp) struct tm *tp; { char *timezone (); struct timeval tv; struct timezone tz; gettimeofday (&tv, &tz); return timezone (tz.tz_minuteswest, tp->tm_isdst); } #endif /* Format the time given in TM according to FORMAT, and put the results in STRING. Return the number of characters (not including terminating null) that were put into STRING, or 0 if the length would have exceeded MAX. */ size_t strftime (string, max, format, tm) char *string; size_t max; const char *format; const struct tm *tm; { enum padding pad; /* Type of padding to apply. */ size_t length = 0; /* Characters put in STRING so far. */ for (; *format && length < max; ++format) { if (*format != '%') add_char (*format); else { ++format; /* Modifiers: */ if (*format == '-') { pad = none; ++format; } else if (*format == '_') { pad = blank; ++format; } else pad = zero; switch (*format) { /* Literal character fields: */ case 0: case '%': add_char ('%'); break; case 'n': add_char ('\n'); break; case 't': add_char ('\t'); break; default: add_char (*format); break; /* Time fields: */ case 'H': case 'k': length += add_num2 (&string[length], tm->tm_hour, max - length, *format == 'H' ? pad : blank); break; case 'I': case 'l': { int hour12; if (tm->tm_hour == 0) hour12 = 12; else if (tm->tm_hour > 12) hour12 = tm->tm_hour - 12; else hour12 = tm->tm_hour; length += add_num2 (&string[length], hour12, max - length, *format == 'I' ? pad : blank); } break; case 'M': length += add_num2 (&string[length], tm->tm_min, max - length, pad); break; case 'p': if (tm->tm_hour < 12) add_char ('A'); else add_char ('P'); add_char ('M'); break; case 'r': length += strftime (&string[length], max - length, "%I:%M:%S %p", tm); break; case 'R': length += strftime (&string[length], max - length, "%H:%M", tm); break; case 's': { struct tm writable_tm; writable_tm = *tm; length += add_num_time_t (&string[length], max - length, mktime (&writable_tm)); } break; case 'S': length += add_num2 (&string[length], tm->tm_sec, max - length, pad); break; case 'T': length += strftime (&string[length], max - length, "%H:%M:%S", tm); break; case 'X': length += strftime (&string[length], max - length, "%H:%M:%S", tm); break; case 'Z': #ifdef HAVE_TM_ZONE length += add_str (&string[length], tm->tm_zone, max - length); #else #ifdef HAVE_TZNAME if (tm->tm_isdst && tzname[1] && *tzname[1]) length += add_str (&string[length], tzname[1], max - length); else length += add_str (&string[length], tzname[0], max - length); #else length += add_str (&string[length], zone_name (tm), max - length); #endif #endif break; /* Date fields: */ case 'a': add_char (days[tm->tm_wday][0]); add_char (days[tm->tm_wday][1]); add_char (days[tm->tm_wday][2]); break; case 'A': length += add_str (&string[length], days[tm->tm_wday], max - length); break; case 'b': case 'h': add_char (months[tm->tm_mon][0]); add_char (months[tm->tm_mon][1]); add_char (months[tm->tm_mon][2]); break; case 'B': length += add_str (&string[length], months[tm->tm_mon], max - length); break; case 'c': length += strftime (&string[length], max - length, "%a %b %d %H:%M:%S %Z %Y", tm); break; case 'C': length += add_num2 (&string[length], (tm->tm_year + 1900) / 100, max - length, pad); break; case 'd': length += add_num2 (&string[length], tm->tm_mday, max - length, pad); break; case 'e': length += add_num2 (&string[length], tm->tm_mday, max - length, blank); break; case 'D': length += strftime (&string[length], max - length, "%m/%d/%y", tm); break; case 'j': length += add_num3 (&string[length], tm->tm_yday + 1, max - length, pad); break; case 'm': length += add_num2 (&string[length], tm->tm_mon + 1, max - length, pad); break; case 'U': length += add_num2 (&string[length], sun_week (tm), max - length, pad); break; case 'w': add_char (tm->tm_wday + '0'); break; case 'W': length += add_num2 (&string[length], mon_week (tm), max - length, pad); break; case 'x': length += strftime (&string[length], max - length, "%m/%d/%y", tm); break; case 'y': length += add_num2 (&string[length], tm->tm_year % 100, max - length, pad); break; case 'Y': add_char ((tm->tm_year + 1900) / 1000 + '0'); length += add_num3 (&string[length], (1900 + tm->tm_year) % 1000, max - length, zero); break; } } } add_char (0); return length - 1; } emacs-19.30/src/sunfns.c100444 75424 1 34075 5770115140 13602 0ustar kwzhdaemon/* Functions for Sun Windows menus and selection buffer. Copyright (C) 1987 Free Software Foundation, Inc. This file is probably totally obsolete. In any case, the FSF is unwilling to support it. We agreed to include it in our distribution only on the understanding that we would spend no time at all on it. If you have complaints about this file, send them to peck@sun.com. If no one at Sun wants to maintain this, then consider it not maintained at all. It would be a bad thing for the GNU project if this file took our effort away from higher-priority things. 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. */ /* Author: Jeff Peck, Sun Microsystems, Inc. Original ideas by David Kastan and Eric Negaard, SRI International Major help from: Steve Greenbaum, Reasoning Systems, Inc. who first discovered the Menu_Base_Kludge. */ /* * Emacs Lisp-Callable functions for sunwindows */ #include #include #include #include #include #include #include #include #include #include #include #undef NULL /* We don't need sunview's idea of NULL */ #include "lisp.h" #include "window.h" #include "buffer.h" #include "termhooks.h" /* conversion to/from character & frame coordinates */ /* From Gosling Emacs SunWindow driver by Chris Torek */ /* Chars to frame coords. Note that we speak in zero origin. */ #define CtoSX(cx) ((cx) * Sun_Font_Xsize) #define CtoSY(cy) ((cy) * Sun_Font_Ysize) /* Frame coords to chars */ #define StoCX(sx) ((sx) / Sun_Font_Xsize) #define StoCY(sy) ((sy) / Sun_Font_Ysize) #define CHECK_GFX(x) if((win_fd<0)&&(Fsun_window_init(),(win_fd<0)))return(x) int win_fd = -1; struct pixfont *Sun_Font; /* The font */ int Sun_Font_Xsize; /* Width of font */ int Sun_Font_Ysize; /* Height of font */ #define Menu_Base_Kludge /* until menu_show_using_fd gets fixed */ #ifdef Menu_Base_Kludge static Frame Menu_Base_Frame; static int Menu_Base_fd; static Lisp_Object sm_kludge_string; #endif struct cursor CurrentCursor; /* The current cursor */ static short CursorData[16]; /* Build cursor here */ static mpr_static(CursorMpr, 16, 16, 1, CursorData); static struct cursor NewCursor = {0, 0, PIX_SRC ^ PIX_DST, &CursorMpr}; #define RIGHT_ARROW_CURSOR /* if you want the right arrow */ #ifdef RIGHT_ARROW_CURSOR /* The default right-arrow cursor, with XOR drawing. */ static short ArrowCursorData[16] = { 0x0001,0x0003,0x0007,0x000F,0x001F,0x003F,0x007F,0x000F, 0x001B,0x0019,0x0030,0x0030,0x0060,0x0060,0x00C0,0x00C0}; static mpr_static(ArrowCursorMpr, 16, 16, 1, ArrowCursorData); struct cursor DefaultCursor = {15, 0, PIX_SRC ^ PIX_DST, &ArrowCursorMpr}; #else /* The default left-arrow cursor, with XOR drawing. */ static short ArrowCursorData[16] = { 0x8000,0xC000,0xE000,0xF000,0xF800,0xFC00,0xFE00,0xF000, 0xD800,0x9800,0x0C00,0x0C00,0x0600,0x0600,0x0300,0x0300}; static mpr_static(ArrowCursorMpr, 16, 16, 1, ArrowCursorData); struct cursor DefaultCursor = {0, 0, PIX_SRC ^ PIX_DST, &ArrowCursorMpr}; #endif /* * Initialize window */ DEFUN ("sun-window-init", Fsun_window_init, Ssun_window_init, 0, 1, 0, "One time setup for using Sun Windows with mouse.\n\ Unless optional argument FORCE is non-nil, is a noop after its first call.\n\ Returns a number representing the file descriptor of the open Sun Window,\n\ or -1 if can not open it.") (force) Lisp_Object force; { char *cp; static int already_initialized = 0; if ((! already_initialized) || (!NILP(force))) { cp = getenv("WINDOW_GFX"); if (cp != 0) win_fd = open(cp, 2); if (win_fd > 0) { Sun_Font = pf_default(); Sun_Font_Xsize = Sun_Font->pf_defaultsize.x; Sun_Font_Ysize = Sun_Font->pf_defaultsize.y; Fsun_change_cursor_icon (Qnil); /* set up the default cursor */ already_initialized = 1; #ifdef Menu_Base_Kludge /* Make a frame to use for putting the menu on, and get its fd. */ Menu_Base_Frame = window_create(0, FRAME, WIN_X, 0, WIN_Y, 0, WIN_ROWS, 1, WIN_COLUMNS, 1, WIN_SHOW, FALSE, FRAME_NO_CONFIRM, 1, 0); Menu_Base_fd = (int) window_get(Menu_Base_Frame, WIN_FD); #endif } } return(make_number(win_fd)); } /* * Mouse sit-for (allows a shorter interval than the regular sit-for * and can be interrupted by the mouse) */ DEFUN ("sit-for-millisecs", Fsit_for_millisecs, Ssit_for_millisecs, 1, 1, 0, "Like sit-for, but ARG is milliseconds. \n\ Perform redisplay, then wait for ARG milliseconds or until\n\ input is available. Returns t if wait completed with no input.\n\ Redisplay does not happen if input is available before it starts.") (n) Lisp_Object n; { struct timeval Timeout; int waitmask = 1; CHECK_NUMBER (n, 0); Timeout.tv_sec = XINT(n) / 1000; Timeout.tv_usec = (XINT(n) - (Timeout.tv_sec * 1000)) * 1000; if (detect_input_pending()) return(Qnil); redisplay_preserve_echo_area (); /* * Check for queued keyboard input/mouse hits again * (A bit screen update can take some time!) */ if (detect_input_pending()) return(Qnil); select(1,&waitmask,0,0,&Timeout); if (detect_input_pending()) return(Qnil); return(Qt); } /* * Sun sleep-for (allows a shorter interval than the regular sleep-for) */ DEFUN ("sleep-for-millisecs", Fsleep_for_millisecs, Ssleep_for_millisecs, 1, 1, 0, "Pause, without updating display, for ARG milliseconds.") (n) Lisp_Object n; { unsigned useconds; CHECK_NUMBER (n, 0); useconds = XINT(n) * 1000; usleep(useconds); return(Qt); } DEFUN ("update-display", Fupdate_display, Supdate_display, 0, 0, 0, "Perform redisplay.") () { redisplay_preserve_echo_area (); return(Qt); } /* * Change the Sun mouse icon */ DEFUN ("sun-change-cursor-icon", Fsun_change_cursor_icon, Ssun_change_cursor_icon, 1, 1, 0, "Change the Sun mouse cursor icon. ICON is a lisp vector whose 1st element\n\ is the X offset of the cursor hot-point, whose 2nd element is the Y offset\n\ of the cursor hot-point and whose 3rd element is the cursor pixel data\n\ expressed as a string. If ICON is nil then the original arrow cursor is used") (Icon) Lisp_Object Icon; { register unsigned char *cp; register short *p; register int i; Lisp_Object X_Hot, Y_Hot, Data; CHECK_GFX (Qnil); /* * If the icon is null, we just restore the DefaultCursor */ if (NILP(Icon)) CurrentCursor = DefaultCursor; else { /* * extract the data from the vector */ CHECK_VECTOR (Icon, 0); if (XVECTOR(Icon)->size < 3) return(Qnil); X_Hot = XVECTOR(Icon)->contents[0]; Y_Hot = XVECTOR(Icon)->contents[1]; Data = XVECTOR(Icon)->contents[2]; CHECK_NUMBER (X_Hot, 0); CHECK_NUMBER (Y_Hot, 0); CHECK_STRING (Data, 0); if (XSTRING(Data)->size != 32) return(Qnil); /* * Setup the new cursor */ NewCursor.cur_xhot = X_Hot; NewCursor.cur_yhot = Y_Hot; cp = XSTRING(Data)->data; p = CursorData; i = 16; while(--i >= 0) *p++ = (cp[0] << 8) | cp[1], cp += 2; CurrentCursor = NewCursor; } win_setcursor(win_fd, &CurrentCursor); return(Qt); } /* * Interface for sunwindows selection */ static Lisp_Object Current_Selection; static sel_write (sel, file) struct selection *sel; FILE *file; { fwrite (XSTRING (Current_Selection)->data, sizeof (char), sel->sel_items, file); } static sel_clear (sel, windowfd) struct selection *sel; int windowfd; { } static sel_read (sel, file) struct selection *sel; FILE *file; { register int i, n; register char *cp; Current_Selection = make_string ("", 0); if (sel->sel_items <= 0) return (0); cp = (char *) malloc(sel->sel_items); if (cp == (char *)0) { error("malloc failed in sel_read"); return(-1); } n = fread(cp, sizeof(char), sel->sel_items, file); if (n > sel->sel_items) { error("fread botch in sel_read"); return(-1); } else if (n < 0) { error("Error reading selection."); return(-1); } /* * The shelltool select saves newlines as carriage returns, * but emacs wants newlines. */ for (i = 0; i < n; i++) if (cp[i] == '\r') cp[i] = '\n'; Current_Selection = make_string (cp, n); free (cp); return (0); } /* * Set the window system "selection" to be the arg STRING */ DEFUN ("sun-set-selection", Fsun_set_selection, Ssun_set_selection, 1, 1, "sSet selection to: ", "Set the current sunwindow selection to STRING.") (str) Lisp_Object str; { struct selection selection; CHECK_STRING (str, 0); Current_Selection = str; CHECK_GFX (Qnil); selection.sel_type = SELTYPE_CHAR; selection.sel_items = XSTRING (str)->size; selection.sel_itembytes = 1; selection.sel_pubflags = 1; selection_set(&selection, sel_write, sel_clear, win_fd); return (Qt); } /* * Stuff the current window system selection into the current buffer */ DEFUN ("sun-get-selection", Fsun_get_selection, Ssun_get_selection, 0, 0, 0, "Return the current sunwindows selection as a string.") () { CHECK_GFX (Current_Selection); selection_get (sel_read, win_fd); return (Current_Selection); } Menu sun_menu_create(); Menu_item sun_item_create (Pair) Lisp_Object Pair; { /* In here, we depend on Lisp supplying zero terminated strings in the data*/ /* so we can just pass the pointers, and not recopy anything */ Menu_item menu_item; Menu submenu; Lisp_Object String; Lisp_Object Value; if (!CONSP(Pair)) wrong_type_argument(Qlistp, Pair); String = Fcar(Pair); CHECK_STRING(String, 0); Value = Fcdr(Pair); if (SYMBOLP (Value)) Value = XSYMBOL(Value)->value; if (VECTORP (Value)) { submenu = sun_menu_create (Value); menu_item = menu_create_item (MENU_RELEASE, MENU_PULLRIGHT_ITEM, XSTRING(String)->data, submenu, 0); } else { menu_item = menu_create_item (MENU_RELEASE, MENU_STRING_ITEM, XSTRING(String)->data, Value, 0); } return menu_item; } Menu sun_menu_create (Vector) Lisp_Object Vector; { Menu menu; int i; CHECK_VECTOR(Vector,0); menu=menu_create(0); for(i = 0; i < XVECTOR(Vector)->size; i++) { menu_set (menu, MENU_APPEND_ITEM, sun_item_create(XVECTOR(Vector)->contents[i]), 0); } return menu; } /* * If the first item of the menu has nil as its value, then make the * item look like a label by inverting it and making it unselectable. * Returns 1 if the label was made, 0 otherwise. */ int make_menu_label (menu) Menu menu; { int made_label_p = 0; if (( menu_get(menu, MENU_NITEMS) > 0 ) && /* At least one item */ ((Lisp_Object) menu_get(menu_get(menu, MENU_NTH_ITEM, 1), MENU_VALUE) == Qnil )) { menu_set(menu_get(menu, MENU_NTH_ITEM, 1), MENU_INVERT, TRUE, MENU_FEEDBACK, FALSE, 0); made_label_p = 1; } return made_label_p; } /* * Do a pop-up menu and return the selected value */ DEFUN ("sun-menu-internal", Fsun_menu_internal, Ssun_menu_internal, 5, 5, 0, "Set up a SunView pop-up menu and return the user's choice.\n\ Arguments WINDOW, X, Y, BUTTON, and MENU.\n\ *** User code should generally use sun-menu-evaluate ***\n\ \n\ Arguments WINDOW, X, Y, BUTTON, and MENU.\n\ Put MENU up in WINDOW at position X, Y.\n\ The BUTTON argument specifies the button to be released that selects an item:\n\ 1 = LEFT BUTTON\n\ 2 = MIDDLE BUTTON\n\ 4 = RIGHT BUTTON\n\ The MENU argument is a vector containing (STRING . VALUE) pairs.\n\ The VALUE of the selected item is returned.\n\ If the VALUE of the first pair is nil, then the first STRING will be used\n\ as a menu label.") (window, X_Position, Y_Position, Button, MEnu) Lisp_Object window, X_Position, Y_Position, Button, MEnu; { Menu menu; int button, xpos, ypos; Event event0; Event *event = &event0; Lisp_Object Value, Pair; CHECK_NUMBER(X_Position, 0); CHECK_NUMBER(Y_Position, 1); CHECK_LIVE_WINDOW(window, 2); CHECK_NUMBER(Button, 3); CHECK_VECTOR(MEnu, 4); CHECK_GFX (Qnil); xpos = CtoSX (XWINDOW(window)->left + XINT(X_Position)); ypos = CtoSY (XWINDOW(window)->top + XINT(Y_Position)); #ifdef Menu_Base_Kludge {static Lisp_Object symbol[2]; symbol[0] = Fintern (sm_kludge_string, Qnil); Pair = Ffuncall (1, symbol); xpos += XINT (XCONS (Pair)->cdr); ypos += XINT (XCONS (Pair)->car); } #endif button = XINT(Button); if(button == 4) button = 3; event_set_id (event, BUT(button)); event_set_down (event); event_set_x (event, xpos); event_set_y (event, ypos); menu = sun_menu_create(MEnu); make_menu_label(menu); #ifdef Menu_Base_Kludge Value = (Lisp_Object) menu_show(menu, Menu_Base_Frame, event, 0); #else /* This confuses the notifier or something: */ Value = (Lisp_Object) menu_show_using_fd(menu, win_fd, event, 0); /* * Right button gets lost, and event sequencing or delivery gets mixed up * So, until that gets fixed, we use this kludge: */ #endif menu_destroy (menu); return ((int)Value ? Value : Qnil); } /* * Define everything */ syms_of_sunfns() { #ifdef Menu_Base_Kludge /* i'm just too lazy to re-write this into C code */ /* so we will call this elisp function from C */ sm_kludge_string = make_pure_string ("sm::menu-kludge", 15); #endif /* Menu_Base_Kludge */ defsubr(&Ssun_window_init); defsubr(&Ssit_for_millisecs); defsubr(&Ssleep_for_millisecs); defsubr(&Supdate_display); defsubr(&Ssun_change_cursor_icon); defsubr(&Ssun_set_selection); defsubr(&Ssun_get_selection); defsubr(&Ssun_menu_internal); } emacs-19.30/src/syntax.c100444 12120 1 143000 6051203554 13417 0ustar rmsdaemon/* GNU Emacs routines to deal with syntax tables; also word and list parsing. Copyright (C) 1985, 1987, 1993, 1994, 1995 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. */ #include #include #include "lisp.h" #include "commands.h" #include "buffer.h" #include "syntax.h" Lisp_Object Qsyntax_table_p, Qsyntax_table; static void scan_sexps_forward (); static int char_quoted (); int words_include_escapes; /* Used as a temporary in SYNTAX_ENTRY and other macros in syntax.h, if not compiled with GCC. No need to mark it, since it is used only very temporarily. */ Lisp_Object syntax_temp; /* This is the internal form of the parse state used in parse-partial-sexp. */ struct lisp_parse_state { int depth; /* Depth at end of parsing */ int instring; /* -1 if not within string, else desired terminator. */ int incomment; /* Nonzero if within a comment at end of parsing */ int comstyle; /* comment style a=0, or b=1 */ int quoted; /* Nonzero if just after an escape char at end of parsing */ int thislevelstart; /* Char number of most recent start-of-expression at current level */ int prevlevelstart; /* Char number of start of containing expression */ int location; /* Char number at which parsing stopped. */ int mindepth; /* Minimum depth seen while scanning. */ int comstart; /* Position just after last comment starter. */ }; /* These variables are a cache for finding the start of a defun. find_start_pos is the place for which the defun start was found. find_start_value is the defun start position found for it. find_start_buffer is the buffer it was found in. find_start_begv is the BEGV value when it was found. find_start_modiff is the value of MODIFF when it was found. */ static int find_start_pos; static int find_start_value; static struct buffer *find_start_buffer; static int find_start_begv; static int find_start_modiff; /* Find a defun-start that is the last one before POS (or nearly the last). We record what we find, so that another call in the same area can return the same value right away. */ static int find_defun_start (pos) int pos; { int tem; int shortage; /* Use previous finding, if it's valid and applies to this inquiry. */ if (current_buffer == find_start_buffer /* Reuse the defun-start even if POS is a little farther on. POS might be in the next defun, but that's ok. Our value may not be the best possible, but will still be usable. */ && pos <= find_start_pos + 1000 && pos >= find_start_value && BEGV == find_start_begv && MODIFF == find_start_modiff) return find_start_value; /* Back up to start of line. */ tem = scan_buffer ('\n', pos, BEGV, -1, &shortage, 1); while (tem > BEGV) { /* Open-paren at start of line means we found our defun-start. */ if (SYNTAX (FETCH_CHAR (tem)) == Sopen) break; /* Move to beg of previous line. */ tem = scan_buffer ('\n', tem, BEGV, -2, &shortage, 1); } /* Record what we found, for the next try. */ find_start_value = tem; find_start_buffer = current_buffer; find_start_modiff = MODIFF; find_start_begv = BEGV; find_start_pos = pos; return find_start_value; } DEFUN ("syntax-table-p", Fsyntax_table_p, Ssyntax_table_p, 1, 1, 0, "Return t if ARG is a syntax table.\n\ Currently, any char-table counts as a syntax table.") (obj) Lisp_Object obj; { if (CHAR_TABLE_P (obj) && XCHAR_TABLE (obj)->purpose == Qsyntax_table) return Qt; return Qnil; } static void check_syntax_table (obj) Lisp_Object obj; { if (!(CHAR_TABLE_P (obj) && XCHAR_TABLE (obj)->purpose == Qsyntax_table)) wrong_type_argument (Qsyntax_table_p, obj); } DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0, "Return the current syntax table.\n\ This is the one specified by the current buffer.") () { return current_buffer->syntax_table; } DEFUN ("standard-syntax-table", Fstandard_syntax_table, Sstandard_syntax_table, 0, 0, 0, "Return the standard syntax table.\n\ This is the one used for new buffers.") () { return Vstandard_syntax_table; } DEFUN ("copy-syntax-table", Fcopy_syntax_table, Scopy_syntax_table, 0, 1, 0, "Construct a new syntax table and return it.\n\ It is a copy of the TABLE, which defaults to the standard syntax table.") (table) Lisp_Object table; { Lisp_Object copy; if (!NILP (table)) check_syntax_table (table); else table = Vstandard_syntax_table; copy = Fcopy_sequence (table); Fset_char_table_parent (copy, Vstandard_syntax_table); return copy; } DEFUN ("set-syntax-table", Fset_syntax_table, Sset_syntax_table, 1, 1, 0, "Select a new syntax table for the current buffer.\n\ One argument, a syntax table.") (table) Lisp_Object table; { check_syntax_table (table); current_buffer->syntax_table = table; /* Indicate that this buffer now has a specified syntax table. */ current_buffer->local_var_flags |= XFASTINT (buffer_local_flags.syntax_table); return table; } /* Convert a letter which signifies a syntax code into the code it signifies. This is used by modify-syntax-entry, and other things. */ unsigned char syntax_spec_code[0400] = { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Swhitespace, 0377, (char) Sstring, 0377, (char) Smath, 0377, 0377, (char) Squote, (char) Sopen, (char) Sclose, 0377, 0377, 0377, (char) Swhitespace, (char) Spunct, (char) Scharquote, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Scomment, 0377, (char) Sendcomment, 0377, (char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */ 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword, 0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */ 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377 }; /* Indexed by syntax code, give the letter that describes it. */ char syntax_code_spec[14] = { ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@' }; /* Look up the value for CHARACTER in syntax table TABLE's parent and its parents. SYNTAX_ENTRY calls this, when TABLE itself has nil for CHARACTER. It's actually used only when not compiled with GCC. */ Lisp_Object syntax_parent_lookup (table, character) Lisp_Object table; int character; { Lisp_Object value; while (1) { table = XCHAR_TABLE (table)->parent; if (NILP (table)) return Qnil; value = XCHAR_TABLE (table)->contents[character]; if (!NILP (value)) return value; } } DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 1, 0, "Return the syntax code of CHAR, described by a character.\n\ For example, if CHAR is a word constituent, the character `?w' is returned.\n\ The characters that correspond to various syntax codes\n\ are listed in the documentation of `modify-syntax-entry'.") (ch) Lisp_Object ch; { int char_int; CHECK_NUMBER (ch, 0); char_int = XINT (ch); return make_number (syntax_code_spec[(int) SYNTAX (char_int)]); } DEFUN ("matching-paren", Fmatching_paren, Smatching_paren, 1, 1, 0, "Return the matching parenthesis of CHAR, or nil if none.") (ch) Lisp_Object ch; { int char_int, code; CHECK_NUMBER (ch, 0); char_int = XINT (ch); code = SYNTAX (char_int); if (code == Sopen || code == Sclose) return make_number (SYNTAX_MATCH (char_int)); return Qnil; } /* This comment supplies the doc string for modify-syntax-entry, for make-docfile to see. We cannot put this in the real DEFUN 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\ the current buffer's syntax table.\n\ The first character of S should be one of the following:\n\ Space or - whitespace syntax. w word constituent.\n\ _ symbol constituent. . punctuation.\n\ ( open-parenthesis. ) close-parenthesis.\n\ \" string quote. \\ escape.\n\ $ paired delimiter. ' expression quote or prefix operator.\n\ < comment starter. > comment ender.\n\ / character-quote. @ inherit from `standard-syntax-table'.\n\ \n\ Only single-character comment start and end sequences are represented thus.\n\ Two-character sequences are represented as described below.\n\ The second character of S is the matching parenthesis,\n\ used only if the first character is `(' or `)'.\n\ Any additional characters are flags.\n\ Defined flags are the characters 1, 2, 3, 4, b, and p.\n\ 1 means C is the start of a two-char comment start sequence.\n\ 2 means C is the second character of such a sequence.\n\ 3 means C is the start of a two-char comment end sequence.\n\ 4 means C is the second character of such a sequence.\n\ \n\ There can be up to two orthogonal comment sequences. This is to support\n\ language modes such as C++. By default, all comment sequences are of style\n\ a, but you can set the comment sequence style to b (on the second character\n\ of a comment-start, or the first character of a comment-end sequence) using\n\ this flag:\n\ b means C is part of comment sequence b.\n\ \n\ p means C is a prefix character for `backward-prefix-chars';\n\ such characters are treated as whitespace when they occur\n\ between expressions.") (char, s, table) */ DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3, /* I really don't know why this is interactive help-form should at least be made useful whilst reading the second arg */ "cSet syntax for character: \nsSet syntax for %s to: ", 0 /* See immediately above */) (c, newentry, syntax_table) Lisp_Object c, newentry, syntax_table; { register unsigned char *p; register enum syntaxcode code; int val; Lisp_Object match; CHECK_NUMBER (c, 0); CHECK_STRING (newentry, 1); if (NILP (syntax_table)) syntax_table = current_buffer->syntax_table; else check_syntax_table (syntax_table); p = XSTRING (newentry)->data; code = (enum syntaxcode) syntax_spec_code[*p++]; if (((int) code & 0377) == 0377) error ("invalid syntax description letter: %c", c); if (code == Sinherit) { SET_RAW_SYNTAX_ENTRY (syntax_table, c, Qnil); return Qnil; } if (*p) { XSETINT (match, *p++); if (XFASTINT (match) == ' ') match = Qnil; } else match = Qnil; val = (int) code; while (*p) switch (*p++) { case '1': val |= 1 << 16; break; case '2': val |= 1 << 17; break; case '3': val |= 1 << 18; break; case '4': val |= 1 << 19; break; case 'p': val |= 1 << 20; break; case 'b': val |= 1 << 21; break; } SET_RAW_SYNTAX_ENTRY (syntax_table, c, Fcons (make_number (val), match)); return Qnil; } /* Dump syntax table to buffer in human-readable format */ static void describe_syntax (value) Lisp_Object value; { register enum syntaxcode code; char desc, match, start1, start2, end1, end2, prefix, comstyle; char str[2]; Lisp_Object first, match_lisp; Findent_to (make_number (16), make_number (1)); if (NILP (value)) { insert_string ("inherit"); return; } if (!CONSP (value)) { insert_string ("invalid"); return; } first = XCONS (value)->car; match_lisp = XCONS (value)->cdr; if (!INTEGERP (first) || !(NILP (match_lisp) || INTEGERP (match_lisp))) { insert_string ("invalid"); return; } code = (enum syntaxcode) (first & 0377); start1 = (XINT (first) >> 16) & 1; start2 = (XINT (first) >> 17) & 1; end1 = (XINT (first) >> 18) & 1; end2 = (XINT (first) >> 19) & 1; prefix = (XINT (first) >> 20) & 1; comstyle = (XINT (first) >> 21) & 1; if ((int) code < 0 || (int) code >= (int) Smax) { insert_string ("invalid"); return; } desc = syntax_code_spec[(int) code]; str[0] = desc, str[1] = 0; insert (str, 1); str[0] = !NILP (match_lisp) ? XINT (match_lisp) : ' '; insert (str, 1); if (start1) insert ("1", 1); if (start2) insert ("2", 1); if (end1) insert ("3", 1); if (end2) insert ("4", 1); if (prefix) insert ("p", 1); if (comstyle) insert ("b", 1); insert_string ("\twhich means: "); switch (SWITCH_ENUM_CAST (code)) { case Swhitespace: insert_string ("whitespace"); break; case Spunct: insert_string ("punctuation"); break; case Sword: insert_string ("word"); break; case Ssymbol: insert_string ("symbol"); break; case Sopen: insert_string ("open"); break; case Sclose: insert_string ("close"); break; case Squote: insert_string ("quote"); break; case Sstring: insert_string ("string"); break; case Smath: insert_string ("math"); break; case Sescape: insert_string ("escape"); break; case Scharquote: insert_string ("charquote"); break; case Scomment: insert_string ("comment"); break; case Sendcomment: insert_string ("endcomment"); break; default: insert_string ("invalid"); return; } if (!NILP (match_lisp)) { insert_string (", matches "); insert_char (XINT (match_lisp)); } if (start1) insert_string (",\n\t is the first character of a comment-start sequence"); if (start2) insert_string (",\n\t is the second character of a comment-start sequence"); if (end1) insert_string (",\n\t is the first character of a comment-end sequence"); if (end2) insert_string (",\n\t is the second character of a comment-end sequence"); if (comstyle) insert_string (" (comment style b)"); if (prefix) insert_string (",\n\t is a prefix character for `backward-prefix-chars'"); insert_string ("\n"); } static Lisp_Object describe_syntax_1 (vector) Lisp_Object vector; { struct buffer *old = current_buffer; set_buffer_internal (XBUFFER (Vstandard_output)); describe_vector (vector, Qnil, describe_syntax, 0, Qnil, Qnil); call0 (intern ("help-mode")); set_buffer_internal (old); return Qnil; } DEFUN ("describe-syntax", Fdescribe_syntax, Sdescribe_syntax, 0, 0, "", "Describe the syntax specifications in the syntax table.\n\ The descriptions are inserted in a buffer, which is then displayed.") () { internal_with_output_to_temp_buffer ("*Help*", describe_syntax_1, current_buffer->syntax_table); return Qnil; } /* Return the position across COUNT words from FROM. If that many words cannot be found before the end of the buffer, return 0. COUNT negative means scan backward and stop at word beginning. */ scan_words (from, count) register int from, count; { register int beg = BEGV; register int end = ZV; register int code; int charcode; immediate_quit = 1; QUIT; while (count > 0) { while (1) { if (from == end) { immediate_quit = 0; return 0; } charcode = FETCH_CHAR (from); code = SYNTAX (charcode); if (words_include_escapes && (code == Sescape || code == Scharquote)) break; if (code == Sword) break; from++; } while (1) { if (from == end) break; charcode = FETCH_CHAR (from); code = SYNTAX (charcode); if (!(words_include_escapes && (code == Sescape || code == Scharquote))) if (code != Sword) break; from++; } count--; } while (count < 0) { while (1) { if (from == beg) { immediate_quit = 0; return 0; } charcode = FETCH_CHAR (from - 1); code = SYNTAX (charcode); if (words_include_escapes && (code == Sescape || code == Scharquote)) break; if (code == Sword) break; from--; } while (1) { if (from == beg) break; charcode = FETCH_CHAR (from - 1); code = SYNTAX (charcode); if (!(words_include_escapes && (code == Sescape || code == Scharquote))) if (code != Sword) break; from--; } count++; } immediate_quit = 0; return from; } DEFUN ("forward-word", Fforward_word, Sforward_word, 1, 1, "p", "Move point forward ARG words (backward if ARG is negative).\n\ Normally returns t.\n\ If an edge of the buffer is reached, point is left there\n\ and nil is returned.") (count) Lisp_Object count; { int val; CHECK_NUMBER (count, 0); if (!(val = scan_words (point, XINT (count)))) { SET_PT (XINT (count) > 0 ? ZV : BEGV); return Qnil; } SET_PT (val); return Qt; } DEFUN ("forward-comment", Fforward_comment, Sforward_comment, 1, 1, 0, "Move forward across up to N comments. If N is negative, move backward.\n\ Stop scanning if we find something other than a comment or whitespace.\n\ Set point to where scanning stops.\n\ If N comments are found as expected, with nothing except whitespace\n\ between them, return t; otherwise return nil.") (count) Lisp_Object count; { register int from; register int stop; register int c, c1; register enum syntaxcode code; int comstyle = 0; /* style of comment encountered */ int found; int count1; CHECK_NUMBER (count, 0); count1 = XINT (count); immediate_quit = 1; QUIT; from = PT; while (count1 > 0) { stop = ZV; do { if (from == stop) { SET_PT (from); immediate_quit = 0; return Qnil; } c = FETCH_CHAR (from); code = SYNTAX (c); from++; comstyle = 0; if (from < stop && SYNTAX_COMSTART_FIRST (c) && (c1 = FETCH_CHAR (from), SYNTAX_COMSTART_SECOND (c1))) { /* We have encountered a comment start sequence and we are ignoring all text inside comments. We must record the comment style this sequence begins so that later, only a comment end of the same style actually ends the comment section. */ code = Scomment; comstyle = SYNTAX_COMMENT_STYLE (c1); from++; } } while (code == Swhitespace || code == Sendcomment); if (code != Scomment) { immediate_quit = 0; SET_PT (from - 1); return Qnil; } /* We're at the start of a comment. */ while (1) { if (from == stop) { immediate_quit = 0; SET_PT (from); return Qnil; } c = FETCH_CHAR (from); from++; if (SYNTAX (c) == Sendcomment && SYNTAX_COMMENT_STYLE (c) == comstyle) /* we have encountered a comment end of the same style as the comment sequence which began this comment section */ break; if (from < stop && SYNTAX_COMEND_FIRST (c) && (c1 = FETCH_CHAR (from), SYNTAX_COMEND_SECOND (c1)) && SYNTAX_COMMENT_STYLE (c) == comstyle) /* we have encountered a comment end of the same style as the comment sequence which began this comment section */ { from++; break; } } /* We have skipped one comment. */ count1--; } while (count1 < 0) { stop = BEGV; while (from > stop) { int quoted; from--; quoted = char_quoted (from); if (quoted) from--; c = FETCH_CHAR (from); code = SYNTAX (c); comstyle = 0; if (code == Sendcomment) comstyle = SYNTAX_COMMENT_STYLE (c); if (from > stop && SYNTAX_COMEND_SECOND (c) && (c1 = FETCH_CHAR (from - 1), SYNTAX_COMEND_FIRST (c1)) && !char_quoted (from - 1)) { /* We must record the comment style encountered so that later, we can match only the proper comment begin sequence of the same style. */ code = Sendcomment; comstyle = SYNTAX_COMMENT_STYLE (c1); from--; } if (code == Sendcomment && !quoted) { #if 0 if (code != SYNTAX (c)) /* For a two-char comment ender, we can assume it does end a comment. So scan back in a simple way. */ { if (from != stop) from--; while (1) { if ((c = FETCH_CHAR (from), SYNTAX (c) == Scomment) && SYNTAX_COMMENT_STYLE (c) == comstyle) break; if (from == stop) { immediate_quit = 0; SET_PT (from); return Qnil; } from--; if (SYNTAX_COMSTART_SECOND (c) && (c1 = FETCH_CHAR (from), SYNTAX_COMSTART_FIRST (c1)) && SYNTAX_COMMENT_STYLE (c) == comstyle && !char_quoted (from)) break; } break; } #endif /* 0 */ /* Look back, counting the parity of string-quotes, and recording the comment-starters seen. When we reach a safe place, assume that's not in a string; then step the main scan to the earliest comment-starter seen an even number of string quotes away from the safe place. OFROM[I] is position of the earliest comment-starter seen which is I+2X quotes from the comment-end. PARITY is current parity of quotes from the comment end. */ { int parity = 0; char my_stringend = 0; int string_lossage = 0; int comment_end = from; int comstart_pos = 0; int comstart_parity = 0; int scanstart = from - 1; /* At beginning of range to scan, we're outside of strings; that determines quote parity to the comment-end. */ while (from != stop) { /* Move back and examine a character. */ from--; c = FETCH_CHAR (from); code = SYNTAX (c); /* If this char is the second of a 2-char comment sequence, back up and give the pair the appropriate syntax. */ if (from > stop && SYNTAX_COMEND_SECOND (c) && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1))) { code = Sendcomment; from--; c = FETCH_CHAR (from); } /* If this char starts a 2-char comment start sequence, treat it like a 1-char comment starter. */ if (from < scanstart && SYNTAX_COMSTART_FIRST (c) && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from + 1)) && comstyle == SYNTAX_COMMENT_STYLE (FETCH_CHAR (from + 1))) code = Scomment; /* Ignore escaped characters. */ if (char_quoted (from)) continue; /* Track parity of quotes. */ if (code == Sstring) { parity ^= 1; if (my_stringend == 0) my_stringend = c; /* If we have two kinds of string delimiters. There's no way to grok this scanning backwards. */ else if (my_stringend != c) string_lossage = 1; } /* Record comment-starters according to that quote-parity to the comment-end. */ if (code == Scomment) { comstart_parity = parity; comstart_pos = from; } /* If we find another earlier comment-ender, any comment-starts earlier than that don't count (because they go with the earlier comment-ender). */ if (code == Sendcomment && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from)) == comstyle) break; /* Assume a defun-start point is outside of strings. */ if (code == Sopen && (from == stop || FETCH_CHAR (from - 1) == '\n')) break; } if (comstart_pos == 0) from = comment_end; /* If the earliest comment starter is followed by uniform paired string quotes or none, we know it can't be inside a string since if it were then the comment ender would be inside one. So it does start a comment. Skip back to it. */ else if (comstart_parity == 0 && !string_lossage) from = comstart_pos; else { /* We had two kinds of string delimiters mixed up together. Decode this going forwards. Scan fwd from the previous comment ender to the one in question; this records where we last passed a comment starter. */ struct lisp_parse_state state; scan_sexps_forward (&state, find_defun_start (comment_end), comment_end - 1, -10000, 0, Qnil, 0); if (state.incomment) from = state.comstart; else /* We can't grok this as a comment; scan it normally. */ from = comment_end; } } /* We have skipped one comment. */ break; } else if ((code != Swhitespace && code != Scomment) || quoted) { immediate_quit = 0; SET_PT (from + 1); return Qnil; } } count1++; } SET_PT (from); immediate_quit = 0; return Qt; } int parse_sexp_ignore_comments; Lisp_Object scan_lists (from, count, depth, sexpflag) register int from; int count, depth, sexpflag; { Lisp_Object val; register int stop; register int c; unsigned char stringterm; int quoted; int mathexit = 0; register enum syntaxcode code; int min_depth = depth; /* Err out if depth gets less than this. */ int comstyle = 0; /* style of comment encountered */ if (depth > 0) min_depth = 0; immediate_quit = 1; QUIT; while (count > 0) { stop = ZV; while (from < stop) { c = FETCH_CHAR (from); code = SYNTAX (c); from++; if (from < stop && SYNTAX_COMSTART_FIRST (c) && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from)) && parse_sexp_ignore_comments) { /* we have encountered a comment start sequence and we are ignoring all text inside comments. we must record the comment style this sequence begins so that later, only a comment end of the same style actually ends the comment section */ code = Scomment; comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from)); from++; } if (SYNTAX_PREFIX (c)) continue; switch (SWITCH_ENUM_CAST (code)) { case Sescape: case Scharquote: if (from == stop) goto lose; from++; /* treat following character as a word constituent */ case Sword: case Ssymbol: if (depth || !sexpflag) break; /* This word counts as a sexp; return at end of it. */ while (from < stop) { switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from)))) { case Scharquote: case Sescape: from++; if (from == stop) goto lose; break; case Sword: case Ssymbol: case Squote: break; default: goto done; } from++; } goto done; case Scomment: if (!parse_sexp_ignore_comments) break; while (1) { if (from == stop) { if (depth == 0) goto done; goto lose; } c = FETCH_CHAR (from); if (SYNTAX (c) == Sendcomment && SYNTAX_COMMENT_STYLE (c) == comstyle) /* we have encountered a comment end of the same style as the comment sequence which began this comment section */ break; from++; if (from < stop && SYNTAX_COMEND_FIRST (c) && SYNTAX_COMEND_SECOND (FETCH_CHAR (from)) && SYNTAX_COMMENT_STYLE (c) == comstyle) /* we have encountered a comment end of the same style as the comment sequence which began this comment section */ { from++; break; } } break; case Smath: if (!sexpflag) break; if (from != stop && c == FETCH_CHAR (from)) from++; if (mathexit) { mathexit = 0; goto close1; } mathexit = 1; case Sopen: if (!++depth) goto done; break; case Sclose: close1: if (!--depth) goto done; if (depth < min_depth) error ("Containing expression ends prematurely"); break; case Sstring: stringterm = FETCH_CHAR (from - 1); while (1) { if (from >= stop) goto lose; if (FETCH_CHAR (from) == stringterm) break; switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from)))) { case Scharquote: case Sescape: from++; } from++; } from++; if (!depth && sexpflag) goto done; break; } } /* Reached end of buffer. Error if within object, return nil if between */ if (depth) goto lose; immediate_quit = 0; return Qnil; /* End of object reached */ done: count--; } while (count < 0) { stop = BEGV; while (from > stop) { from--; if (quoted = char_quoted (from)) from--; c = FETCH_CHAR (from); code = SYNTAX (c); comstyle = 0; if (code == Sendcomment) comstyle = SYNTAX_COMMENT_STYLE (c); if (from > stop && SYNTAX_COMEND_SECOND (c) && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1)) && !char_quoted (from - 1) && parse_sexp_ignore_comments) { /* we must record the comment style encountered so that later, we can match only the proper comment begin sequence of the same style */ code = Sendcomment; comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from - 1)); from--; } if (SYNTAX_PREFIX (c)) continue; switch (SWITCH_ENUM_CAST (quoted ? Sword : code)) { case Sword: case Ssymbol: if (depth || !sexpflag) break; /* This word counts as a sexp; count object finished after passing it. */ while (from > stop) { quoted = char_quoted (from - 1); if (quoted) from--; if (! (quoted || SYNTAX (FETCH_CHAR (from - 1)) == Sword || SYNTAX (FETCH_CHAR (from - 1)) == Ssymbol || SYNTAX (FETCH_CHAR (from - 1)) == Squote)) goto done2; from--; } goto done2; case Smath: if (!sexpflag) break; if (from != stop && c == FETCH_CHAR (from - 1)) from--; if (mathexit) { mathexit = 0; goto open2; } mathexit = 1; case Sclose: if (!++depth) goto done2; break; case Sopen: open2: if (!--depth) goto done2; if (depth < min_depth) error ("Containing expression ends prematurely"); break; case Sendcomment: if (!parse_sexp_ignore_comments) break; #if 0 if (code != SYNTAX (c)) /* For a two-char comment ender, we can assume it does end a comment. So scan back in a simple way. */ { if (from != stop) from--; while (1) { if (SYNTAX (c = FETCH_CHAR (from)) == Scomment && SYNTAX_COMMENT_STYLE (c) == comstyle) break; if (from == stop) { if (depth == 0) goto done2; goto lose; } from--; if (SYNTAX_COMSTART_SECOND (c) && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from)) && SYNTAX_COMMENT_STYLE (c) == comstyle && !char_quoted (from)) break; } break; } #endif /* 0 */ /* Look back, counting the parity of string-quotes, and recording the comment-starters seen. When we reach a safe place, assume that's not in a string; then step the main scan to the earliest comment-starter seen an even number of string quotes away from the safe place. OFROM[I] is position of the earliest comment-starter seen which is I+2X quotes from the comment-end. PARITY is current parity of quotes from the comment end. */ { int parity = 0; char my_stringend = 0; int string_lossage = 0; int comment_end = from; int comstart_pos = 0; int comstart_parity = 0; int scanstart = from - 1; /* At beginning of range to scan, we're outside of strings; that determines quote parity to the comment-end. */ while (from != stop) { /* Move back and examine a character. */ from--; c = FETCH_CHAR (from); code = SYNTAX (c); /* If this char is the second of a 2-char comment sequence, back up and give the pair the appropriate syntax. */ if (from > stop && SYNTAX_COMEND_SECOND (c) && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1))) { code = Sendcomment; from--; c = FETCH_CHAR (from); } /* If this char starts a 2-char comment start sequence, treat it like a 1-char comment starter. */ if (from < scanstart && SYNTAX_COMSTART_FIRST (c) && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from + 1)) && comstyle == SYNTAX_COMMENT_STYLE (FETCH_CHAR (from + 1))) code = Scomment; /* Ignore escaped characters. */ if (char_quoted (from)) continue; /* Track parity of quotes. */ if (code == Sstring) { parity ^= 1; if (my_stringend == 0) my_stringend = c; /* If we have two kinds of string delimiters. There's no way to grok this scanning backwards. */ else if (my_stringend != c) string_lossage = 1; } /* Record comment-starters according to that quote-parity to the comment-end. */ if (code == Scomment) { comstart_parity = parity; comstart_pos = from; } /* If we find another earlier comment-ender, any comment-starts earlier than that don't count (because they go with the earlier comment-ender). */ if (code == Sendcomment && SYNTAX_COMMENT_STYLE (FETCH_CHAR (from)) == comstyle) break; /* Assume a defun-start point is outside of strings. */ if (code == Sopen && (from == stop || FETCH_CHAR (from - 1) == '\n')) break; } if (comstart_pos == 0) from = comment_end; /* If the earliest comment starter is followed by uniform paired string quotes or none, we know it can't be inside a string since if it were then the comment ender would be inside one. So it does start a comment. Skip back to it. */ else if (comstart_parity == 0 && !string_lossage) from = comstart_pos; else { /* We had two kinds of string delimiters mixed up together. Decode this going forwards. Scan fwd from the previous comment ender to the one in question; this records where we last passed a comment starter. */ struct lisp_parse_state state; scan_sexps_forward (&state, find_defun_start (comment_end), comment_end - 1, -10000, 0, Qnil, 0); if (state.incomment) from = state.comstart; else /* We can't grok this as a comment; scan it normally. */ from = comment_end; } } break; case Sstring: stringterm = FETCH_CHAR (from); while (1) { if (from == stop) goto lose; if (!char_quoted (from - 1) && stringterm == FETCH_CHAR (from - 1)) break; from--; } from--; if (!depth && sexpflag) goto done2; break; } } /* Reached start of buffer. Error if within object, return nil if between */ if (depth) goto lose; immediate_quit = 0; return Qnil; done2: count++; } immediate_quit = 0; XSETFASTINT (val, from); return val; lose: error ("Unbalanced parentheses"); /* NOTREACHED */ } static int char_quoted (pos) register int pos; { register enum syntaxcode code; register int beg = BEGV; register int quoted = 0; while (pos > beg && ((code = SYNTAX (FETCH_CHAR (pos - 1))) == Scharquote || code == Sescape)) pos--, quoted = !quoted; return quoted; } DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0, "Scan from character number FROM by COUNT lists.\n\ Returns the character number of the position thus found.\n\ \n\ If DEPTH is nonzero, paren depth begins counting from that value,\n\ only places where the depth in parentheses becomes zero\n\ are candidates for stopping; COUNT such places are counted.\n\ Thus, a positive value for DEPTH means go out levels.\n\ \n\ Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\ \n\ If the beginning or end of (the accessible part of) the buffer is reached\n\ and the depth is wrong, an error is signaled.\n\ If the depth is right but the count is not used up, nil is returned.") (from, count, depth) Lisp_Object from, count, depth; { CHECK_NUMBER (from, 0); CHECK_NUMBER (count, 1); CHECK_NUMBER (depth, 2); return scan_lists (XINT (from), XINT (count), XINT (depth), 0); } DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 2, 0, "Scan from character number FROM by COUNT balanced expressions.\n\ If COUNT is negative, scan backwards.\n\ Returns the character number of the position thus found.\n\ \n\ Comments are ignored if `parse-sexp-ignore-comments' is non-nil.\n\ \n\ If the beginning or end of (the accessible part of) the buffer is reached\n\ in the middle of a parenthetical grouping, an error is signaled.\n\ If the beginning or end is reached between groupings\n\ but before count is used up, nil is returned.") (from, count) Lisp_Object from, count; { CHECK_NUMBER (from, 0); CHECK_NUMBER (count, 1); return scan_lists (XINT (from), XINT (count), 0, 1); } DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars, 0, 0, 0, "Move point backward over any number of chars with prefix syntax.\n\ This includes chars with \"quote\" or \"prefix\" syntax (' or p).") () { int beg = BEGV; int pos = point; while (pos > beg && !char_quoted (pos - 1) && (SYNTAX (FETCH_CHAR (pos - 1)) == Squote || SYNTAX_PREFIX (FETCH_CHAR (pos - 1)))) pos--; SET_PT (pos); return Qnil; } /* Parse forward from FROM to END, assuming that FROM has state OLDSTATE (nil means FROM is start of function), and return a description of the state of the parse at END. If STOPBEFORE is nonzero, stop at the start of an atom. If COMMENTSTOP is nonzero, stop at the start of a comment. */ static void scan_sexps_forward (stateptr, from, end, targetdepth, stopbefore, oldstate, commentstop) struct lisp_parse_state *stateptr; register int from; int end, targetdepth, stopbefore; Lisp_Object oldstate; int commentstop; { struct lisp_parse_state state; register enum syntaxcode code; struct level { int last, prev; }; struct level levelstart[100]; register struct level *curlevel = levelstart; struct level *endlevel = levelstart + 100; char prev; register int depth; /* Paren depth of current scanning location. level - levelstart equals this except when the depth becomes negative. */ int mindepth; /* Lowest DEPTH value seen. */ int start_quoted = 0; /* Nonzero means starting after a char quote */ Lisp_Object tem; immediate_quit = 1; QUIT; if (NILP (oldstate)) { depth = 0; state.instring = -1; state.incomment = 0; state.comstyle = 0; /* comment style a by default */ } else { tem = Fcar (oldstate); if (!NILP (tem)) depth = XINT (tem); else depth = 0; oldstate = Fcdr (oldstate); oldstate = Fcdr (oldstate); oldstate = Fcdr (oldstate); tem = Fcar (oldstate); state.instring = !NILP (tem) ? XINT (tem) : -1; oldstate = Fcdr (oldstate); tem = Fcar (oldstate); state.incomment = !NILP (tem); oldstate = Fcdr (oldstate); tem = Fcar (oldstate); start_quoted = !NILP (tem); /* if the eight element of the list is nil, we are in comment style a. if it is non-nil, we are in comment style b */ oldstate = Fcdr (oldstate); oldstate = Fcdr (oldstate); tem = Fcar (oldstate); state.comstyle = !NILP (tem); } state.quoted = 0; mindepth = depth; curlevel->prev = -1; curlevel->last = -1; /* Enter the loop at a place appropriate for initial state. */ if (state.incomment) goto startincomment; if (state.instring >= 0) { if (start_quoted) goto startquotedinstring; goto startinstring; } if (start_quoted) goto startquoted; while (from < end) { code = SYNTAX (FETCH_CHAR (from)); from++; if (code == Scomment) state.comstart = from-1; else if (from < end && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from - 1)) && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from))) { /* Record the comment style we have entered so that only the comment-end sequence of the same style actually terminates the comment section. */ code = Scomment; state.comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from)); state.comstart = from-1; from++; } if (SYNTAX_PREFIX (FETCH_CHAR (from - 1))) continue; switch (SWITCH_ENUM_CAST (code)) { case Sescape: case Scharquote: if (stopbefore) goto stop; /* this arg means stop at sexp start */ curlevel->last = from - 1; startquoted: if (from == end) goto endquoted; from++; goto symstarted; /* treat following character as a word constituent */ case Sword: case Ssymbol: if (stopbefore) goto stop; /* this arg means stop at sexp start */ curlevel->last = from - 1; symstarted: while (from < end) { switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from)))) { case Scharquote: case Sescape: from++; if (from == end) goto endquoted; break; case Sword: case Ssymbol: case Squote: break; default: goto symdone; } from++; } symdone: curlevel->prev = curlevel->last; break; startincomment: if (commentstop) goto done; if (from != BEGV) { /* Enter the loop in the middle so that we find a 2-char comment ender if we start in the middle of it. */ prev = FETCH_CHAR (from - 1); goto startincomment_1; } /* At beginning of buffer, enter the loop the ordinary way. */ case Scomment: state.incomment = 1; if (commentstop) goto done; while (1) { if (from == end) goto done; prev = FETCH_CHAR (from); if (SYNTAX (prev) == Sendcomment && SYNTAX_COMMENT_STYLE (prev) == state.comstyle) /* Only terminate the comment section if the endcomment of the same style as the start sequence has been encountered. */ break; from++; startincomment_1: if (from < end && SYNTAX_COMEND_FIRST (prev) && SYNTAX_COMEND_SECOND (FETCH_CHAR (from)) && SYNTAX_COMMENT_STYLE (prev) == state.comstyle) /* Only terminate the comment section if the end-comment sequence of the same style as the start sequence has been encountered. */ { from++; break; } } state.incomment = 0; state.comstyle = 0; /* reset the comment style */ break; case Sopen: if (stopbefore) goto stop; /* this arg means stop at sexp start */ depth++; /* curlevel++->last ran into compiler bug on Apollo */ curlevel->last = from - 1; if (++curlevel == endlevel) error ("Nesting too deep for parser"); curlevel->prev = -1; curlevel->last = -1; if (targetdepth == depth) goto done; break; case Sclose: depth--; if (depth < mindepth) mindepth = depth; if (curlevel != levelstart) curlevel--; curlevel->prev = curlevel->last; if (targetdepth == depth) goto done; break; case Sstring: if (stopbefore) goto stop; /* this arg means stop at sexp start */ curlevel->last = from - 1; state.instring = FETCH_CHAR (from - 1); startinstring: while (1) { if (from >= end) goto done; if (FETCH_CHAR (from) == state.instring) break; switch (SWITCH_ENUM_CAST (SYNTAX (FETCH_CHAR (from)))) { case Scharquote: case Sescape: from++; startquotedinstring: if (from >= end) goto endquoted; } from++; } state.instring = -1; curlevel->prev = curlevel->last; from++; break; case Smath: break; } } goto done; stop: /* Here if stopping before start of sexp. */ from--; /* We have just fetched the char that starts it; */ goto done; /* but return the position before it. */ endquoted: state.quoted = 1; done: state.depth = depth; state.mindepth = mindepth; state.thislevelstart = curlevel->prev; state.prevlevelstart = (curlevel == levelstart) ? -1 : (curlevel - 1)->last; state.location = from; immediate_quit = 0; *stateptr = state; } /* This comment supplies the doc string for parse-partial-sexp, for make-docfile to see. We cannot put this in the real DEFUN due to limits in the Unix cpp. DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 2, 6, 0, "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\ Parsing stops at TO or when certain criteria are met;\n\ point is set to where parsing stops.\n\ If fifth arg STATE is omitted or nil,\n\ parsing assumes that FROM is the beginning of a function.\n\ Value is a list of eight elements describing final state of parsing:\n\ 0. depth in parens.\n\ 1. character address of start of innermost containing list; nil if none.\n\ 2. character address of start of last complete sexp terminated.\n\ 3. non-nil if inside a string.\n\ (it is the character that will terminate the string.)\n\ 4. t if inside a comment.\n\ 5. t if following a quote character.\n\ 6. the minimum paren-depth encountered during this scan.\n\ 7. t if in a comment of style `b'.\n\ If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\ in parentheses becomes equal to TARGETDEPTH.\n\ Fourth arg STOPBEFORE non-nil means stop when come to\n\ any character that starts a sexp.\n\ Fifth arg STATE is an eight-list like what this function returns.\n\ It is used to initialize the state of the parse. Its second and third elements are ignored. Sixth args COMMENTSTOP non-nil means stop at the start of a comment.") (from, to, targetdepth, stopbefore, state, commentstop) */ DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0, 0 /* See immediately above */) (from, to, targetdepth, stopbefore, oldstate, commentstop) Lisp_Object from, to, targetdepth, stopbefore, oldstate, commentstop; { struct lisp_parse_state state; int target; if (!NILP (targetdepth)) { CHECK_NUMBER (targetdepth, 3); target = XINT (targetdepth); } else target = -100000; /* We won't reach this depth */ validate_region (&from, &to); scan_sexps_forward (&state, XINT (from), XINT (to), target, !NILP (stopbefore), oldstate, !NILP (commentstop)); SET_PT (state.location); return Fcons (make_number (state.depth), Fcons (state.prevlevelstart < 0 ? Qnil : make_number (state.prevlevelstart), Fcons (state.thislevelstart < 0 ? Qnil : make_number (state.thislevelstart), Fcons (state.instring >= 0 ? make_number (state.instring) : Qnil, Fcons (state.incomment ? Qt : Qnil, Fcons (state.quoted ? Qt : Qnil, Fcons (make_number (state.mindepth), Fcons (state.comstyle ? Qt : Qnil, Qnil)))))))); } init_syntax_once () { register int i; Lisp_Object temp; /* This has to be done here, before we call Fmake_char_table. */ Qsyntax_table = intern ("syntax-table"); staticpro (&Qsyntax_table); /* Intern this now in case it isn't already done. Setting this variable twice is harmless. But don't staticpro it here--that is done in alloc.c. */ Qchar_table_extra_slots = intern ("char-table-extra-slots"); /* Now we are ready to set up this property, so we can create syntax tables. */ Fput (Qsyntax_table, Qchar_table_extra_slots, make_number (0)); temp = Fcons (make_number ((int) Swhitespace), Qnil); Vstandard_syntax_table = Fmake_char_table (Qsyntax_table, temp); temp = Fcons (make_number ((int) Sword), Qnil); for (i = 'a'; i <= 'z'; i++) SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp); for (i = 'A'; i <= 'Z'; i++) SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp); for (i = '0'; i <= '9'; i++) SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '$', temp); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '%', temp); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '(', Fcons (make_number (Sopen), make_number (')'))); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ')', Fcons (make_number (Sclose), make_number ('('))); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '[', Fcons (make_number (Sopen), make_number (']'))); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ']', Fcons (make_number (Sclose), make_number ('['))); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '{', Fcons (make_number (Sopen), make_number ('}'))); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '}', Fcons (make_number (Sclose), make_number ('{'))); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '"', Fcons (make_number ((int) Sstring), Qnil)); SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\\', Fcons (make_number ((int) Sescape), Qnil)); temp = Fcons (make_number ((int) Ssymbol), Qnil); for (i = 0; i < 10; i++) SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, "_-+*/&|<>="[i], temp); temp = Fcons (make_number ((int) Spunct), Qnil); for (i = 0; i < 12; i++) SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ".,;:?!#@~^'`"[i], temp); } syms_of_syntax () { Qsyntax_table_p = intern ("syntax-table-p"); staticpro (&Qsyntax_table_p); DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments, "Non-nil means `forward-sexp', etc., should treat comments as whitespace."); words_include_escapes = 0; DEFVAR_BOOL ("words-include-escapes", &words_include_escapes, "Non-nil means `forward-word', etc., should treat escape chars part of words."); defsubr (&Ssyntax_table_p); defsubr (&Ssyntax_table); defsubr (&Sstandard_syntax_table); defsubr (&Scopy_syntax_table); defsubr (&Sset_syntax_table); defsubr (&Schar_syntax); defsubr (&Smatching_paren); defsubr (&Smodify_syntax_entry); defsubr (&Sdescribe_syntax); defsubr (&Sforward_word); defsubr (&Sforward_comment); defsubr (&Sscan_lists); defsubr (&Sscan_sexps); defsubr (&Sbackward_prefix_chars); defsubr (&Sparse_partial_sexp); } emacs-19.30/src/sysdep.c100444 23073 1 356650 6047603136 14305 0ustar voelkerdaemon/* Interfaces to system-dependent kernel and library entries. Copyright (C) 1985, 86, 87, 88, 93, 94, 95 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. */ #include #include #include #include "lisp.h" #include "blockinput.h" #undef NULL #define min(x,y) ((x) > (y) ? (y) : (x)) /* In this file, open, read and write refer to the system calls, not our sugared interfaces sys_open, sys_read and sys_write. Contrariwise, for systems where we use the system calls directly, define sys_read, etc. here as aliases for them. */ #ifndef read #define sys_read read #define sys_write write #endif /* `read' is not a macro */ #undef read #undef write #ifdef WINDOWSNT #define read _read #define write _write #include extern int errno; #endif /* not WINDOWSNT */ #ifndef close #define sys_close close #else #undef close #endif #ifndef open #define sys_open open #else /* `open' is a macro */ #undef open #endif /* `open' is a macro */ /* Does anyone other than VMS need this? */ #ifndef fwrite #define sys_fwrite fwrite #else #undef fwrite #endif #ifndef HAVE_H_ERRNO extern int h_errno; #endif #include #include #include #include /* Get _POSIX_VDISABLE, if it is available. */ #ifdef HAVE_UNISTD_H #include #endif #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida, MW Aug 1993 */ #include #include "dosfns.h" #include "msdos.h" #include #endif extern int errno; #ifdef VMS #include #include #include #include #include #include #include #include #include #include #ifdef __GNUC__ #include #else #include #endif #undef F_SETFL #ifndef RAB$C_BID #include #endif #define MAXIOSIZE (32 * PAGESIZE) /* Don't I/O more than 32 blocks at a time */ #endif /* VMS */ #ifndef BSD4_1 #ifdef BSD /* this is done this way to avoid defined (BSD) || defined (USG) because the vms compiler doesn't grok `defined' */ #include #endif #ifdef USG #ifndef USG5 #include #endif #endif #endif /* not 4.1 bsd */ #ifndef MSDOS #include #endif #include "systty.h" #include "syswait.h" #ifdef BROKEN_TIOCGWINSZ #undef TIOCGWINSZ #undef TIOCSWINSZ #endif #ifdef USG #include #include #ifndef MEMORY_IN_STRING_H #include #endif #if defined (TIOCGWINSZ) || defined (ISC4_0) #ifdef NEED_SIOCTL #include #endif #ifdef NEED_PTEM_H #include #include #endif #endif /* TIOCGWINSZ or ISC4_0 */ #endif /* USG */ extern int quit_char; #include "frame.h" #include "window.h" #include "termhooks.h" #include "termchar.h" #include "termopts.h" #include "dispextern.h" #include "process.h" #ifdef WINDOWSNT #include /* In process.h which conflicts with the local copy. */ #define _P_WAIT 0 int _CRTAPI1 _spawnlp (int, const char *, const char *, ...); int _CRTAPI1 _getpid (void); #endif #ifdef NONSYSTEM_DIR_LIBRARY #include "ndir.h" #endif /* NONSYSTEM_DIR_LIBRARY */ #include "syssignal.h" #include "systime.h" #ifdef HAVE_UTIME_H #include #endif #ifndef HAVE_UTIMES #ifndef HAVE_STRUCT_UTIMBUF /* We want to use utime rather than utimes, but we couldn't find the structure declaration. We'll use the traditional one. */ struct utimbuf { long actime; long modtime; }; #endif #endif #ifndef VFORK_RETURN_TYPE #define VFORK_RETURN_TYPE int #endif /* LPASS8 is new in 4.3, and makes cbreak mode provide all 8 bits. */ #ifndef LPASS8 #define LPASS8 0 #endif #ifdef BSD4_1 #define LNOFLSH 0100000 #endif static int baud_convert[] = #ifdef BAUD_CONVERT BAUD_CONVERT; #else { 0, 50, 75, 110, 135, 150, 200, 300, 600, 1200, 1800, 2400, 4800, 9600, 19200, 38400 }; #endif extern short ospeed; /* The file descriptor for Emacs's input terminal. Under Unix, this is normally zero except when using X; under VMS, we place the input channel number here. */ int input_fd; /* Specify a different file descriptor for further input operations. */ void change_input_fd (fd) int fd; { input_fd = fd; } /* Discard pending input on descriptor input_fd. */ discard_tty_input () { #ifndef WINDOWSNT struct emacs_tty buf; if (noninteractive) return; /* Discarding input is not safe when the input could contain replies from the X server. So don't do it. */ if (read_socket_hook) return; #ifdef VMS end_kbd_input (); SYS$QIOW (0, input_fd, IO$_READVBLK|IO$M_PURGE, input_iosb, 0, 0, &buf.main, 0, 0, terminator_mask, 0, 0); queue_kbd_input (); #else /* not VMS */ #ifdef APOLLO { int zero = 0; ioctl (input_fd, TIOCFLUSH, &zero); } #else /* not Apollo */ #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ while (dos_keyread () != -1) ; #else /* not MSDOS */ EMACS_GET_TTY (input_fd, &buf); EMACS_SET_TTY (input_fd, &buf, 0); #endif /* not MSDOS */ #endif /* not Apollo */ #endif /* not VMS */ #endif /* not WINDOWSNT */ } #ifdef SIGTSTP /* Arrange for character C to be read as the next input from the terminal. */ stuff_char (c) char c; { if (read_socket_hook) return; /* Should perhaps error if in batch mode */ #ifdef TIOCSTI ioctl (input_fd, TIOCSTI, &c); #else /* no TIOCSTI */ error ("Cannot stuff terminal input characters in this version of Unix"); #endif /* no TIOCSTI */ } #endif /* SIGTSTP */ init_baud_rate () { if (noninteractive) ospeed = 0; else { #ifdef DOS_NT ospeed = 15; #else /* not DOS_NT */ #ifdef VMS struct sensemode sg; SYS$QIOW (0, input_fd, IO$_SENSEMODE, &sg, 0, 0, &sg.class, 12, 0, 0, 0, 0 ); ospeed = sg.xmit_baud; #else /* not VMS */ #ifdef HAVE_TERMIOS struct termios sg; sg.c_cflag = B9600; tcgetattr (input_fd, &sg); ospeed = cfgetospeed (&sg); #if defined (USE_GETOBAUD) && defined (getobaud) /* m88k-motorola-sysv3 needs this (ghazi@noc.rutgers.edu) 9/1/94. */ if (ospeed == 0) ospeed = getobaud (sg.c_cflag); #endif #else /* neither VMS nor TERMIOS */ #ifdef HAVE_TERMIO struct termio sg; sg.c_cflag = B9600; #ifdef HAVE_TCATTR tcgetattr (input_fd, &sg); #else ioctl (input_fd, TCGETA, &sg); #endif ospeed = sg.c_cflag & CBAUD; #else /* neither VMS nor TERMIOS nor TERMIO */ struct sgttyb sg; sg.sg_ospeed = B9600; if (ioctl (input_fd, TIOCGETP, &sg) < 0) abort (); ospeed = sg.sg_ospeed; #endif /* not HAVE_TERMIO */ #endif /* not HAVE_TERMIOS */ #endif /* not VMS */ #endif /* not DOS_NT */ } baud_rate = (ospeed < sizeof baud_convert / sizeof baud_convert[0] ? baud_convert[ospeed] : 9600); if (baud_rate == 0) baud_rate = 1200; } /*ARGSUSED*/ set_exclusive_use (fd) int fd; { #ifdef FIOCLEX ioctl (fd, FIOCLEX, 0); #endif /* Ok to do nothing if this feature does not exist */ } #ifndef subprocesses wait_without_blocking () { #ifdef BSD wait3 (0, WNOHANG | WUNTRACED, 0); #else croak ("wait_without_blocking"); #endif synch_process_alive = 0; } #endif /* not subprocesses */ int wait_debugging; /* Set nonzero to make following function work under dbx (at least for bsd). */ SIGTYPE wait_for_termination_signal () {} /* Wait for subprocess with process id `pid' to terminate and make sure it will get eliminated (not remain forever as a zombie) */ wait_for_termination (pid) int pid; { while (1) { #ifdef subprocesses #ifdef VMS int status; status = SYS$FORCEX (&pid, 0, 0); break; #else /* not VMS */ #if defined (BSD) || (defined (HPUX) && !defined (HPUX_5)) /* Note that kill returns -1 even if the process is just a zombie now. But inevitably a SIGCHLD interrupt should be generated and child_sig will do wait3 and make the process go away. */ /* There is some indication that there is a bug involved with termination of subprocesses, perhaps involving a kernel bug too, but no idea what it is. Just as a hunch we signal SIGCHLD to see if that causes the problem to go away or get worse. */ sigsetmask (sigmask (SIGCHLD)); if (0 > kill (pid, 0)) { sigsetmask (SIGEMPTYMASK); kill (getpid (), SIGCHLD); break; } if (wait_debugging) sleep (1); else sigpause (SIGEMPTYMASK); #else /* not BSD, and not HPUX version >= 6 */ #if defined (UNIPLUS) if (0 > kill (pid, 0)) break; wait (0); #else /* neither BSD nor UNIPLUS: random sysV */ #ifdef POSIX_SIGNALS /* would this work for LINUX as well? */ sigblock (sigmask (SIGCHLD)); if (0 > kill (pid, 0)) { sigunblock (sigmask (SIGCHLD)); break; } sigpause (SIGEMPTYMASK); #else /* not POSIX_SIGNALS */ #ifdef HAVE_SYSV_SIGPAUSE sighold (SIGCHLD); if (0 > kill (pid, 0)) { sigrelse (SIGCHLD); break; } sigpause (SIGCHLD); #else /* not HAVE_SYSV_SIGPAUSE */ #ifdef WINDOWSNT wait (0); break; #else /* not WINDOWSNT */ if (0 > kill (pid, 0)) break; /* Using sleep instead of pause avoids timing error. If the inferior dies just before the sleep, we lose just one second. */ sleep (1); #endif /* not WINDOWSNT */ #endif /* not HAVE_SYSV_SIGPAUSE */ #endif /* not POSIX_SIGNALS */ #endif /* not UNIPLUS */ #endif /* not BSD, and not HPUX version >= 6 */ #endif /* not VMS */ #else /* not subprocesses */ #ifndef BSD4_1 if (kill (pid, 0) < 0) break; wait (0); #else /* BSD4_1 */ int status; status = wait (0); if (status == pid || status == -1) break; #endif /* BSD4_1 */ #endif /* not subprocesses */ } } #ifdef subprocesses /* * flush any pending output * (may flush input as well; it does not matter the way we use it) */ flush_pending_output (channel) int channel; { #ifdef HAVE_TERMIOS /* If we try this, we get hit with SIGTTIN, because the child's tty belongs to the child's pgrp. */ #else #ifdef TCFLSH ioctl (channel, TCFLSH, 1); #else #ifdef TIOCFLUSH int zero = 0; /* 3rd arg should be ignored but some 4.2 kernels actually want the address of an int and nonzero means something different. */ ioctl (channel, TIOCFLUSH, &zero); #endif #endif #endif } #ifndef VMS /* Set up the terminal at the other end of a pseudo-terminal that we will be controlling an inferior through. It should not echo or do line-editing, since that is done in Emacs. No padding needed for insertion into an Emacs buffer. */ child_setup_tty (out) int out; { #ifndef DOS_NT struct emacs_tty s; EMACS_GET_TTY (out, &s); #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS) s.main.c_oflag |= OPOST; /* Enable output postprocessing */ s.main.c_oflag &= ~ONLCR; /* Disable map of NL to CR-NL on output */ #ifdef NLDLY s.main.c_oflag &= ~(NLDLY|CRDLY|TABDLY|BSDLY|VTDLY|FFDLY); /* No output delays */ #endif s.main.c_lflag &= ~ECHO; /* Disable echo */ s.main.c_lflag |= ISIG; /* Enable signals */ #ifdef IUCLC s.main.c_iflag &= ~IUCLC; /* Disable downcasing on input. */ #endif #ifdef OLCUC s.main.c_oflag &= ~OLCUC; /* Disable upcasing on output. */ #endif s.main.c_cflag = (s.main.c_cflag & ~CSIZE) | CS8; /* Don't strip 8th bit */ #if 0 /* Said to be unnecessary: */ s.main.c_cc[VMIN] = 1; /* minimum number of characters to accept */ s.main.c_cc[VTIME] = 0; /* wait forever for at least 1 character */ #endif s.main.c_lflag |= ICANON; /* Enable erase/kill and eof processing */ s.main.c_cc[VEOF] = 04; /* insure that EOF is Control-D */ s.main.c_cc[VERASE] = CDISABLE; /* disable erase processing */ s.main.c_cc[VKILL] = CDISABLE; /* disable kill processing */ #ifdef HPUX s.main.c_cflag = (s.main.c_cflag & ~CBAUD) | B9600; /* baud rate sanity */ #endif /* HPUX */ #ifdef AIX /* AIX enhanced edit loses NULs, so disable it */ #ifndef IBMR2AIX s.main.c_line = 0; s.main.c_iflag &= ~ASCEDIT; #endif /* Also, PTY overloads NUL and BREAK. don't ignore break, but don't signal either, so it looks like NUL. */ s.main.c_iflag &= ~IGNBRK; s.main.c_iflag &= ~BRKINT; /* QUIT and INTR work better as signals, so disable character forms */ s.main.c_cc[VINTR] = 0377; #ifdef SIGNALS_VIA_CHARACTERS /* the QUIT and INTR character are used in process_send_signal so set them here to something useful. */ if (s.main.c_cc[VQUIT] == 0377) s.main.c_cc[VQUIT] = '\\'&037; /* Control-\ */ if (s.main.c_cc[VINTR] == 0377) s.main.c_cc[VINTR] = 'C'&037; /* Control-C */ #else /* no TIOCGPGRP or no TIOCGLTC or no TIOCGETC */ /* QUIT and INTR work better as signals, so disable character forms */ s.main.c_cc[VQUIT] = 0377; s.main.c_cc[VINTR] = 0377; s.main.c_lflag &= ~ISIG; #endif /* no TIOCGPGRP or no TIOCGLTC or no TIOCGETC */ s.main.c_cc[VEOL] = 0377; s.main.c_cflag = (s.main.c_cflag & ~CBAUD) | B9600; /* baud rate sanity */ #endif /* AIX */ #else /* not HAVE_TERMIO */ s.main.sg_flags &= ~(ECHO | CRMOD | ANYP | ALLDELAY | RAW | LCASE | CBREAK | TANDEM); s.main.sg_flags |= LPASS8; s.main.sg_erase = 0377; s.main.sg_kill = 0377; s.lmode = LLITOUT | s.lmode; /* Don't strip 8th bit */ #endif /* not HAVE_TERMIO */ EMACS_SET_TTY (out, &s, 0); #ifdef BSD4_1 if (interrupt_input) reset_sigio (); #endif /* BSD4_1 */ #ifdef RTU { int zero = 0; ioctl (out, FIOASYNC, &zero); } #endif /* RTU */ #endif /* not DOS_NT */ } #endif /* not VMS */ #endif /* subprocesses */ /* Record a signal code and the handler for it. */ struct save_signal { int code; SIGTYPE (*handler) (); }; /* Suspend the Emacs process; give terminal to its superior. */ sys_suspend () { #ifdef VMS /* "Foster" parentage allows emacs to return to a subprocess that attached to the current emacs as a cheaper than starting a whole new process. This is set up by KEPTEDITOR.COM. */ unsigned long parent_id, foster_parent_id; char *fpid_string; fpid_string = getenv ("EMACS_PARENT_PID"); if (fpid_string != NULL) { sscanf (fpid_string, "%x", &foster_parent_id); if (foster_parent_id != 0) parent_id = foster_parent_id; else parent_id = getppid (); } else parent_id = getppid (); xfree (fpid_string); /* On VMS, this was malloc'd */ if (parent_id && parent_id != 0xffffffff) { SIGTYPE (*oldsig)() = (int) signal (SIGINT, SIG_IGN); int status = LIB$ATTACH (&parent_id) & 1; signal (SIGINT, oldsig); return status; } else { struct { int l; char *a; } d_prompt; d_prompt.l = sizeof ("Emacs: "); /* Our special prompt */ d_prompt.a = "Emacs: "; /* Just a reminder */ LIB$SPAWN (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, &d_prompt, 0); return 1; } return -1; #else #if defined(SIGTSTP) && !defined(MSDOS) { int pgrp = EMACS_GETPGRP (0); EMACS_KILLPG (pgrp, SIGTSTP); } #else /* No SIGTSTP */ #ifdef USG_JOBCTRL /* If you don't know what this is don't mess with it */ ptrace (0, 0, 0, 0); /* set for ptrace - caught by csh */ kill (getpid (), SIGQUIT); #else /* No SIGTSTP or USG_JOBCTRL */ /* On a system where suspending is not implemented, instead fork a subshell and let it talk directly to the terminal while we wait. */ sys_subshell (); #endif /* no USG_JOBCTRL */ #endif /* no SIGTSTP */ #endif /* not VMS */ } /* Fork a subshell. */ sys_subshell () { #ifndef VMS #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */ int st; char oldwd[MAXPATHLEN+1]; /* Fixed length is safe on MSDOS. */ #endif int pid; struct save_signal saved_handlers[5]; Lisp_Object dir; unsigned char *str = 0; int len; saved_handlers[0].code = SIGINT; saved_handlers[1].code = SIGQUIT; saved_handlers[2].code = SIGTERM; #ifdef SIGIO saved_handlers[3].code = SIGIO; saved_handlers[4].code = 0; #else saved_handlers[3].code = 0; #endif /* Mentioning current_buffer->buffer would mean including buffer.h, which somehow wedges the hp compiler. So instead... */ dir = intern ("default-directory"); if (NILP (Fboundp (dir))) goto xyzzy; dir = Fsymbol_value (dir); if (!STRINGP (dir)) goto xyzzy; dir = expand_and_dir_to_file (Funhandled_file_name_directory (dir), Qnil); str = (unsigned char *) alloca (XSTRING (dir)->size + 2); len = XSTRING (dir)->size; bcopy (XSTRING (dir)->data, str, len); if (str[len - 1] != '/') str[len++] = '/'; str[len] = 0; xyzzy: #ifdef WINDOWSNT pid = -1; #else /* not WINDOWSNT */ #ifdef MSDOS pid = 0; #else pid = vfork (); if (pid == -1) error ("Can't spawn subshell"); #endif if (pid == 0) #endif /* not WINDOWSNT */ { char *sh = 0; #ifdef MSDOS /* MW, Aug 1993 */ getwd (oldwd); if (sh == 0) sh = (char *) egetenv ("SUSPEND"); /* KFS, 1994-12-14 */ #endif if (sh == 0) sh = (char *) egetenv ("SHELL"); if (sh == 0) sh = "sh"; /* Use our buffer's default directory for the subshell. */ if (str) chdir (str); #ifdef subprocesses close_process_descs (); /* Close Emacs's pipes/ptys */ #endif #ifdef SET_EMACS_PRIORITY { extern int emacs_priority; if (emacs_priority < 0) nice (-emacs_priority); } #endif #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */ st = system (sh); chdir (oldwd); #if 0 /* This is also reported if last command executed in subshell failed, KFS */ if (st) report_file_error ("Can't execute subshell", Fcons (build_string (sh), Qnil)); #endif #else /* not MSDOS */ #ifdef WINDOWSNT /* Waits for process completion */ pid = _spawnlp (_P_WAIT, sh, sh, NULL); if (pid == -1) write (1, "Can't execute subshell", 22); take_console (); #else /* not WINDOWSNT */ execlp (sh, sh, 0); write (1, "Can't execute subshell", 22); _exit (1); #endif /* not WINDOWSNT */ #endif /* not MSDOS */ } save_signal_handlers (saved_handlers); synch_process_alive = 1; #ifndef MSDOS wait_for_termination (pid); #endif restore_signal_handlers (saved_handlers); #endif /* !VMS */ } save_signal_handlers (saved_handlers) struct save_signal *saved_handlers; { while (saved_handlers->code) { saved_handlers->handler = (SIGTYPE (*) ()) signal (saved_handlers->code, SIG_IGN); saved_handlers++; } } restore_signal_handlers (saved_handlers) struct save_signal *saved_handlers; { while (saved_handlers->code) { signal (saved_handlers->code, saved_handlers->handler); saved_handlers++; } } #ifdef F_SETFL int old_fcntl_flags; init_sigio (fd) int fd; { #ifdef FASYNC old_fcntl_flags = fcntl (fd, F_GETFL, 0) & ~FASYNC; fcntl (fd, F_SETFL, old_fcntl_flags | FASYNC); #endif interrupts_deferred = 0; } reset_sigio () { unrequest_sigio (); } #ifdef FASYNC /* F_SETFL does not imply existence of FASYNC */ request_sigio () { if (read_socket_hook) return; #ifdef SIGWINCH sigunblock (sigmask (SIGWINCH)); #endif fcntl (input_fd, F_SETFL, old_fcntl_flags | FASYNC); interrupts_deferred = 0; } unrequest_sigio () { if (read_socket_hook) return; #ifdef SIGWINCH sigblock (sigmask (SIGWINCH)); #endif fcntl (input_fd, F_SETFL, old_fcntl_flags); interrupts_deferred = 1; } #else /* no FASYNC */ #ifdef STRIDE /* Stride doesn't have FASYNC - use FIOASYNC */ request_sigio () { int on = 1; if (read_socket_hook) return; ioctl (input_fd, FIOASYNC, &on); interrupts_deferred = 0; } unrequest_sigio () { int off = 0; if (read_socket_hook) return; ioctl (input_fd, FIOASYNC, &off); interrupts_deferred = 1; } #else /* not FASYNC, not STRIDE */ #ifdef _CX_UX #include request_sigio () { int on = 1; sigset_t st; if (read_socket_hook) return; sigemptyset(&st); sigaddset(&st, SIGIO); ioctl (input_fd, FIOASYNC, &on); interrupts_deferred = 0; sigprocmask(SIG_UNBLOCK, &st, (sigset_t *)0); } unrequest_sigio () { int off = 0; if (read_socket_hook) return; ioctl (input_fd, FIOASYNC, &off); interrupts_deferred = 1; } #else /* ! _CX_UX */ request_sigio () { if (read_socket_hook) return; croak ("request_sigio"); } unrequest_sigio () { if (read_socket_hook) return; croak ("unrequest_sigio"); } #endif /* _CX_UX */ #endif /* STRIDE */ #endif /* FASYNC */ #endif /* F_SETFL */ /* Saving and restoring the process group of Emacs's terminal. */ #ifdef BSD_PGRPS /* The process group of which Emacs was a member when it initially started. If Emacs was in its own process group (i.e. inherited_pgroup == getpid ()), then we know we're running under a shell with job control (Emacs would never be run as part of a pipeline). Everything is fine. If Emacs was not in its own process group, then we know we're running under a shell (or a caller) that doesn't know how to separate itself from Emacs (like sh). Emacs must be in its own process group in order to receive SIGIO correctly. In this situation, we put ourselves in our own pgroup, forcibly set the tty's pgroup to our pgroup, and make sure to restore and reinstate the tty's pgroup just like any other terminal setting. If inherited_group was not the tty's pgroup, then we'll get a SIGTTmumble when we try to change the tty's pgroup, and a CONT if it goes foreground in the future, which is what should happen. */ int inherited_pgroup; /* Split off the foreground process group to Emacs alone. When we are in the foreground, but not started in our own process group, redirect the TTY to point to our own process group. We need to be in our own process group to receive SIGIO properly. */ narrow_foreground_group () { int me = getpid (); setpgrp (0, inherited_pgroup); if (inherited_pgroup != me) EMACS_SET_TTY_PGRP (input_fd, &me); setpgrp (0, me); } /* Set the tty to our original foreground group. */ widen_foreground_group () { if (inherited_pgroup != getpid ()) EMACS_SET_TTY_PGRP (input_fd, &inherited_pgroup); setpgrp (0, inherited_pgroup); } #endif /* BSD_PGRPS */ /* Getting and setting emacs_tty structures. */ /* Set *TC to the parameters associated with the terminal FD. Return zero if all's well, or -1 if we ran into an error we couldn't deal with. */ int emacs_get_tty (fd, settings) int fd; struct emacs_tty *settings; { /* Retrieve the primary parameters - baud rate, character size, etcetera. */ #ifdef HAVE_TCATTR /* We have those nifty POSIX tcmumbleattr functions. */ if (tcgetattr (fd, &settings->main) < 0) return -1; #else #ifdef HAVE_TERMIO /* The SYSV-style interface? */ if (ioctl (fd, TCGETA, &settings->main) < 0) return -1; #else #ifdef VMS /* Vehemently Monstrous System? :-) */ if (! (SYS$QIOW (0, fd, IO$_SENSEMODE, settings, 0, 0, &settings->main.class, 12, 0, 0, 0, 0) & 1)) return -1; #else #ifndef DOS_NT /* I give up - I hope you have the BSD ioctls. */ if (ioctl (fd, TIOCGETP, &settings->main) < 0) return -1; #endif /* not DOS_NT */ #endif #endif #endif /* Suivant - Do we have to get struct ltchars data? */ #ifdef HAVE_LTCHARS if (ioctl (fd, TIOCGLTC, &settings->ltchars) < 0) return -1; #endif /* How about a struct tchars and a wordful of lmode bits? */ #ifdef HAVE_TCHARS if (ioctl (fd, TIOCGETC, &settings->tchars) < 0 || ioctl (fd, TIOCLGET, &settings->lmode) < 0) return -1; #endif /* We have survived the tempest. */ return 0; } /* Set the parameters of the tty on FD according to the contents of *SETTINGS. If FLUSHP is non-zero, we discard input. Return 0 if all went well, and -1 if anything failed. */ int emacs_set_tty (fd, settings, flushp) int fd; struct emacs_tty *settings; int flushp; { /* Set the primary parameters - baud rate, character size, etcetera. */ #ifdef HAVE_TCATTR int i; /* We have those nifty POSIX tcmumbleattr functions. William J. Smith writes: "POSIX 1003.1 defines tcsetattr() to return success if it was able to perform any of the requested actions, even if some of the requested actions could not be performed. We must read settings back to ensure tty setup properly. AIX requires this to keep tty from hanging occasionally." */ /* This make sure that we don't loop indefinitely in here. */ for (i = 0 ; i < 10 ; i++) if (tcsetattr (fd, flushp ? TCSAFLUSH : TCSADRAIN, &settings->main) < 0) { if (errno == EINTR) continue; else return -1; } else { struct termios new; /* Get the current settings, and see if they're what we asked for. */ tcgetattr (fd, &new); /* We cannot use memcmp on the whole structure here because under * aix386 the termios structure has some reserved field that may * not be filled in. */ if ( new.c_iflag == settings->main.c_iflag && new.c_oflag == settings->main.c_oflag && new.c_cflag == settings->main.c_cflag && new.c_lflag == settings->main.c_lflag && memcmp(new.c_cc, settings->main.c_cc, NCCS) == 0) break; else continue; } #else #ifdef HAVE_TERMIO /* The SYSV-style interface? */ if (ioctl (fd, flushp ? TCSETAF : TCSETAW, &settings->main) < 0) return -1; #else #ifdef VMS /* Vehemently Monstrous System? :-) */ if (! (SYS$QIOW (0, fd, IO$_SETMODE, &input_iosb, 0, 0, &settings->main.class, 12, 0, 0, 0, 0) & 1)) return -1; #else #ifndef DOS_NT /* I give up - I hope you have the BSD ioctls. */ if (ioctl (fd, (flushp) ? TIOCSETP : TIOCSETN, &settings->main) < 0) return -1; #endif /* not DOS_NT */ #endif #endif #endif /* Suivant - Do we have to get struct ltchars data? */ #ifdef HAVE_LTCHARS if (ioctl (fd, TIOCSLTC, &settings->ltchars) < 0) return -1; #endif /* How about a struct tchars and a wordful of lmode bits? */ #ifdef HAVE_TCHARS if (ioctl (fd, TIOCSETC, &settings->tchars) < 0 || ioctl (fd, TIOCLSET, &settings->lmode) < 0) return -1; #endif /* We have survived the tempest. */ return 0; } /* The initial tty mode bits */ struct emacs_tty old_tty; /* 1 if we have been through init_sys_modes. */ int term_initted; /* 1 if outer tty status has been recorded. */ int old_tty_valid; #ifdef BSD4_1 /* BSD 4.1 needs to keep track of the lmode bits in order to start sigio. */ int lmode; #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, but if so, this does no harm, and using the same name avoids wasting the other one's space. */ #if defined (USG) || defined (DGUX) unsigned char _sobuf[BUFSIZ+8]; #else char _sobuf[BUFSIZ]; #endif #ifdef HAVE_LTCHARS static struct ltchars new_ltchars = {-1,-1,-1,-1,-1,-1}; #endif #ifdef HAVE_TCHARS static struct tchars new_tchars = {-1,-1,-1,-1,-1,-1}; #endif init_sys_modes () { struct emacs_tty tty; #ifdef VMS #if 0 static int oob_chars[2] = {0, 1 << 7}; /* catch C-g's */ extern int (*interrupt_signal) (); #endif #endif if (noninteractive) return; #ifdef VMS if (!input_ef) input_ef = get_kbd_event_flag (); /* LIB$GET_EF (&input_ef); */ SYS$CLREF (input_ef); waiting_for_ast = 0; if (!timer_ef) timer_ef = get_timer_event_flag (); /* LIB$GET_EF (&timer_ef); */ SYS$CLREF (timer_ef); #if 0 if (!process_ef) { LIB$GET_EF (&process_ef); SYS$CLREF (process_ef); } if (input_ef / 32 != process_ef / 32) croak ("Input and process event flags in different clusters."); #endif if (input_ef / 32 != timer_ef / 32) croak ("Input and timer event flags in different clusters."); #if 0 input_eflist = ((unsigned) 1 << (input_ef % 32)) | ((unsigned) 1 << (process_ef % 32)); #endif timer_eflist = ((unsigned) 1 << (input_ef % 32)) | ((unsigned) 1 << (timer_ef % 32)); #ifndef VMS4_4 sys_access_reinit (); #endif #endif /* not VMS */ #ifdef BSD_PGRPS if (! read_socket_hook && EQ (Vwindow_system, Qnil)) narrow_foreground_group (); #endif #ifdef HAVE_WINDOW_SYSTEM /* Emacs' window system on MSDOG uses the `internal terminal' and therefore needs the initialization code below. */ if (!read_socket_hook && EQ (Vwindow_system, Qnil)) #endif { EMACS_GET_TTY (input_fd, &old_tty); old_tty_valid = 1; tty = old_tty; #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS) #ifdef DGUX /* This allows meta to be sent on 8th bit. */ tty.main.c_iflag &= ~INPCK; /* don't check input for parity */ #endif tty.main.c_iflag |= (IGNBRK); /* Ignore break condition */ tty.main.c_iflag &= ~ICRNL; /* Disable map of CR to NL on input */ #ifdef ISTRIP tty.main.c_iflag &= ~ISTRIP; /* don't strip 8th bit on input */ #endif tty.main.c_lflag &= ~ECHO; /* Disable echo */ tty.main.c_lflag &= ~ICANON; /* Disable erase/kill processing */ #ifdef IEXTEN tty.main.c_lflag &= ~IEXTEN; /* Disable other editing characters. */ #endif tty.main.c_lflag |= ISIG; /* Enable signals */ if (flow_control) { tty.main.c_iflag |= IXON; /* Enable start/stop output control */ #ifdef IXANY tty.main.c_iflag &= ~IXANY; #endif /* IXANY */ } else tty.main.c_iflag &= ~IXON; /* Disable start/stop output control */ tty.main.c_oflag &= ~ONLCR; /* Disable map of NL to CR-NL on output */ tty.main.c_oflag &= ~TAB3; /* Disable tab expansion */ #ifdef CS8 if (meta_key) { tty.main.c_cflag |= CS8; /* allow 8th bit on input */ tty.main.c_cflag &= ~PARENB;/* Don't check parity */ } #endif tty.main.c_cc[VINTR] = quit_char; /* C-g (usually) gives SIGINT */ /* Set up C-g for both SIGQUIT and SIGINT. We don't know which we will get, but we handle both alike so which one it really gives us does not matter. */ tty.main.c_cc[VQUIT] = quit_char; tty.main.c_cc[VMIN] = 1; /* Input should wait for at least 1 char */ tty.main.c_cc[VTIME] = 0; /* no matter how long that takes. */ #ifdef VSWTCH tty.main.c_cc[VSWTCH] = CDISABLE; /* Turn off shell layering use of C-z */ #endif /* VSWTCH */ #if defined (mips) || defined (HAVE_TCATTR) #ifdef VSUSP tty.main.c_cc[VSUSP] = CDISABLE; /* Turn off mips handling of C-z. */ #endif /* VSUSP */ #ifdef V_DSUSP tty.main.c_cc[V_DSUSP] = CDISABLE; /* Turn off mips handling of C-y. */ #endif /* V_DSUSP */ #ifdef VDSUSP /* Some systems have VDSUSP, some have V_DSUSP. */ tty.main.c_cc[VDSUSP] = CDISABLE; #endif /* VDSUSP */ #ifdef VLNEXT tty.main.c_cc[VLNEXT] = CDISABLE; #endif /* VLNEXT */ #ifdef VREPRINT tty.main.c_cc[VREPRINT] = CDISABLE; #endif /* VREPRINT */ #ifdef VWERASE tty.main.c_cc[VWERASE] = CDISABLE; #endif /* VWERASE */ #ifdef VDISCARD tty.main.c_cc[VDISCARD] = CDISABLE; #endif /* VDISCARD */ #ifdef VSTART tty.main.c_cc[VSTART] = CDISABLE; #endif /* VSTART */ #ifdef VSTOP tty.main.c_cc[VSTOP] = CDISABLE; #endif /* VSTOP */ #endif /* mips or HAVE_TCATTR */ #ifdef SET_LINE_DISCIPLINE /* Need to explicitely request TERMIODISC line discipline or Ultrix's termios does not work correctly. */ tty.main.c_line = SET_LINE_DISCIPLINE; #endif #ifdef AIX #ifndef IBMR2AIX /* AIX enhanced edit loses NULs, so disable it. */ tty.main.c_line = 0; tty.main.c_iflag &= ~ASCEDIT; #else tty.main.c_cc[VSTRT] = 255; tty.main.c_cc[VSTOP] = 255; tty.main.c_cc[VSUSP] = 255; tty.main.c_cc[VDSUSP] = 255; #endif /* IBMR2AIX */ /* Also, PTY overloads NUL and BREAK. don't ignore break, but don't signal either, so it looks like NUL. This really serves a purpose only if running in an XTERM window or via TELNET or the like, but does no harm elsewhere. */ tty.main.c_iflag &= ~IGNBRK; tty.main.c_iflag &= ~BRKINT; #endif #else /* if not HAVE_TERMIO */ #ifdef VMS tty.main.tt_char |= TT$M_NOECHO; if (meta_key) tty.main.tt_char |= TT$M_EIGHTBIT; if (flow_control) tty.main.tt_char |= TT$M_TTSYNC; else tty.main.tt_char &= ~TT$M_TTSYNC; tty.main.tt2_char |= TT2$M_PASTHRU | TT2$M_XON; #else /* not VMS (BSD, that is) */ #ifndef DOS_NT tty.main.sg_flags &= ~(ECHO | CRMOD | XTABS); if (meta_key) tty.main.sg_flags |= ANYP; tty.main.sg_flags |= interrupt_input ? RAW : CBREAK; #endif /* not DOS_NT */ #endif /* not VMS (BSD, that is) */ #endif /* not HAVE_TERMIO */ /* If going to use CBREAK mode, we must request C-g to interrupt and turn off start and stop chars, etc. If not going to use CBREAK mode, do this anyway so as to turn off local flow control for user coming over network on 4.2; in this case, only t_stopc and t_startc really matter. */ #ifndef HAVE_TERMIO #ifdef HAVE_TCHARS /* Note: if not using CBREAK mode, it makes no difference how we set this */ tty.tchars = new_tchars; tty.tchars.t_intrc = quit_char; if (flow_control) { tty.tchars.t_startc = '\021'; tty.tchars.t_stopc = '\023'; } tty.lmode = LDECCTQ | LLITOUT | LPASS8 | LNOFLSH | old_tty.lmode; #ifdef ultrix /* Under Ultrix 4.2a, leaving this out doesn't seem to hurt anything, and leaving it in breaks the meta key. Go figure. */ tty.lmode &= ~LLITOUT; #endif #ifdef BSD4_1 lmode = tty.lmode; #endif #endif /* HAVE_TCHARS */ #endif /* not HAVE_TERMIO */ #ifdef HAVE_LTCHARS tty.ltchars = new_ltchars; #endif /* HAVE_LTCHARS */ #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida, MW Aug 1993 */ if (!term_initted) internal_terminal_init (); dos_ttraw (); #endif EMACS_SET_TTY (input_fd, &tty, 0); /* This code added to insure that, if flow-control is not to be used, we have an unlocked terminal at the start. */ #ifdef TCXONC if (!flow_control) ioctl (input_fd, TCXONC, 1); #endif #ifndef APOLLO #ifdef TIOCSTART if (!flow_control) ioctl (input_fd, TIOCSTART, 0); #endif #endif #if defined (HAVE_TERMIOS) || defined (HPUX9) #ifdef TCOON if (!flow_control) tcflow (input_fd, TCOON); #endif #endif #ifdef AIXHFT hft_init (); #ifdef IBMR2AIX { /* IBM's HFT device usually thinks a ^J should be LF/CR. We need it to be only LF. This is the way that is done. */ struct termio tty; if (ioctl (1, HFTGETID, &tty) != -1) write (1, "\033[20l", 5); } #endif #endif /* AIXHFT */ #ifdef VMS /* Appears to do nothing when in PASTHRU mode. SYS$QIOW (0, input_fd, IO$_SETMODE|IO$M_OUTBAND, 0, 0, 0, interrupt_signal, oob_chars, 0, 0, 0, 0); */ queue_kbd_input (0); #endif /* VMS */ } #ifdef F_SETFL #ifndef F_SETOWN_BUG #ifdef F_GETOWN /* F_SETFL does not imply existence of F_GETOWN */ if (interrupt_input && ! read_socket_hook && EQ (Vwindow_system, Qnil)) { old_fcntl_owner = fcntl (input_fd, F_GETOWN, 0); fcntl (input_fd, F_SETOWN, getpid ()); init_sigio (input_fd); } #endif /* F_GETOWN */ #endif /* F_SETOWN_BUG */ #endif /* F_SETFL */ #ifdef BSD4_1 if (interrupt_input) init_sigio (input_fd); #endif #ifdef VMS /* VMS sometimes has this symbol but lacks setvbuf. */ #undef _IOFBF #endif #ifdef _IOFBF /* This symbol is defined on recent USG systems. Someone says without this call USG won't really buffer the file even with a call to setbuf. */ setvbuf (stdout, _sobuf, _IOFBF, sizeof _sobuf); #else setbuf (stdout, _sobuf); #endif #ifdef HAVE_WINDOW_SYSTEM /* Emacs' window system on MSDOG uses the `internal terminal' and therefore needs the initialization code below. */ if (! read_socket_hook && EQ (Vwindow_system, Qnil)) #endif set_terminal_modes (); if (term_initted && no_redraw_on_reenter) { if (display_completed) direct_output_forward_char (0); } else { frame_garbaged = 1; #ifdef MULTI_FRAME if (FRAMEP (Vterminal_frame)) FRAME_GARBAGED_P (XFRAME (Vterminal_frame)) = 1; #endif } term_initted = 1; } /* Return nonzero if safe to use tabs in output. At the time this is called, init_sys_modes has not been done yet. */ tabs_safe_p () { struct emacs_tty tty; EMACS_GET_TTY (input_fd, &tty); return EMACS_TTY_TABS_OK (&tty); } /* Get terminal size from system. Store number of lines into *HEIGHTP and width into *WIDTHP. We store 0 if there's no valid information. */ get_frame_size (widthp, heightp) int *widthp, *heightp; { #ifdef TIOCGWINSZ /* BSD-style. */ struct winsize size; if (ioctl (input_fd, TIOCGWINSZ, &size) == -1) *widthp = *heightp = 0; else { *widthp = size.ws_col; *heightp = size.ws_row; } #else #ifdef TIOCGSIZE /* SunOS - style. */ struct ttysize size; if (ioctl (input_fd, TIOCGSIZE, &size) == -1) *widthp = *heightp = 0; else { *widthp = size.ts_cols; *heightp = size.ts_lines; } #else #ifdef VMS struct sensemode tty; SYS$QIOW (0, input_fd, IO$_SENSEMODE, &tty, 0, 0, &tty.class, 12, 0, 0, 0, 0); *widthp = tty.scr_wid; *heightp = tty.scr_len; #else #ifdef MSDOS *widthp = ScreenCols (); *heightp = ScreenRows (); #else /* system doesn't know size */ *widthp = 0; *heightp = 0; #endif #endif /* not VMS */ #endif /* not SunOS-style */ #endif /* not BSD-style */ } /* Set the logical window size associated with descriptor FD to HEIGHT and WIDTH. This is used mainly with ptys. */ int set_window_size (fd, height, width) int fd, height, width; { #ifdef TIOCSWINSZ /* BSD-style. */ struct winsize size; size.ws_row = height; size.ws_col = width; if (ioctl (fd, TIOCSWINSZ, &size) == -1) return 0; /* error */ else return 1; #else #ifdef TIOCSSIZE /* SunOS - style. */ struct ttysize size; size.ts_lines = height; size.ts_cols = width; if (ioctl (fd, TIOCGSIZE, &size) == -1) return 0; else return 1; #else return -1; #endif /* not SunOS-style */ #endif /* not BSD-style */ } /* Prepare the terminal for exiting Emacs; move the cursor to the bottom of the frame, turn off interrupt-driven I/O, etc. */ reset_sys_modes () { if (noninteractive) { fflush (stdout); return; } if (!term_initted) return; #ifdef HAVE_WINDOW_SYSTEM /* Emacs' window system on MSDOG uses the `internal terminal' and therefore needs the clean-up code below. */ if (read_socket_hook || !EQ (Vwindow_system, Qnil)) return; #endif cursor_to (FRAME_HEIGHT (selected_frame) - 1, 0); clear_end_of_line (FRAME_WIDTH (selected_frame)); /* clear_end_of_line may move the cursor */ cursor_to (FRAME_HEIGHT (selected_frame) - 1, 0); #if defined (IBMR2AIX) && defined (AIXHFT) { /* HFT devices normally use ^J as a LF/CR. We forced it to do the LF only. Now, we need to reset it. */ struct termio tty; if (ioctl (1, HFTGETID, &tty) != -1) write (1, "\033[20h", 5); } #endif reset_terminal_modes (); fflush (stdout); #ifdef BSD #ifndef BSD4_1 /* Avoid possible loss of output when changing terminal modes. */ fsync (fileno (stdout)); #endif #endif #ifdef F_SETFL #ifndef F_SETOWN_BUG #ifdef F_SETOWN /* F_SETFL does not imply existence of F_SETOWN */ if (interrupt_input) { reset_sigio (); fcntl (input_fd, F_SETOWN, old_fcntl_owner); } #endif /* F_SETOWN */ #endif /* F_SETOWN_BUG */ #ifdef O_NDELAY fcntl (input_fd, F_SETFL, fcntl (input_fd, F_GETFL, 0) & ~O_NDELAY); #endif #endif /* F_SETFL */ #ifdef BSD4_1 if (interrupt_input) reset_sigio (); #endif /* BSD4_1 */ if (old_tty_valid) while (EMACS_SET_TTY (input_fd, &old_tty, 0) < 0 && errno == EINTR) ; #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */ dos_ttcooked (); #endif #ifdef SET_LINE_DISCIPLINE /* Ultrix's termios *ignores* any line discipline except TERMIODISC. A different old line discipline is therefore not restored, yet. Restore the old line discipline by hand. */ ioctl (0, TIOCSETD, &old_tty.main.c_line); #endif #ifdef AIXHFT hft_reset (); #endif #ifdef BSD_PGRPS widen_foreground_group (); #endif } #ifdef HAVE_PTYS /* Set up the proper status flags for use of a pty. */ setup_pty (fd) int fd; { /* I'm told that TOICREMOTE does not mean control chars "can't be sent" but rather that they don't have input-editing or signaling effects. That should be good, because we have other ways to do those things in Emacs. However, telnet mode seems not to work on 4.2. So TIOCREMOTE is turned off now. */ /* Under hp-ux, if TIOCREMOTE is turned on, some calls will hang. In particular, the "timeout" feature (which causes a read to return if there is no data available) does this. Also it is known that telnet mode will hang in such a way that Emacs must be stopped (perhaps this is the same problem). If TIOCREMOTE is turned off, then there is a bug in hp-ux which sometimes loses data. Apparently the code which blocks the master process when the internal buffer fills up does not work. Other than this, though, everything else seems to work fine. Since the latter lossage is more benign, we may as well lose that way. -- cph */ #ifdef FIONBIO #ifdef SYSV_PTYS { int on = 1; ioctl (fd, FIONBIO, &on); } #endif #endif #ifdef IBMRTAIX /* On AIX, the parent gets SIGHUP when a pty attached child dies. So, we */ /* ignore SIGHUP once we've started a child on a pty. Note that this may */ /* cause EMACS not to die when it should, i.e., when its own controlling */ /* tty goes away. I've complained to the AIX developers, and they may */ /* change this behavior, but I'm not going to hold my breath. */ signal (SIGHUP, SIG_IGN); #endif } #endif /* HAVE_PTYS */ #ifdef VMS /* Assigning an input channel is done at the start of Emacs execution. This is called each time Emacs is resumed, also, but does nothing because input_chain is no longer zero. */ init_vms_input () { int status; if (input_fd == 0) { status = SYS$ASSIGN (&input_dsc, &input_fd, 0, 0); if (! (status & 1)) LIB$STOP (status); } } /* Deassigning the input channel is done before exiting. */ stop_vms_input () { return SYS$DASSGN (input_fd); } short input_buffer; /* Request reading one character into the keyboard buffer. This is done as soon as the buffer becomes empty. */ queue_kbd_input () { int status; extern kbd_input_ast (); waiting_for_ast = 0; stop_input = 0; status = SYS$QIO (0, input_fd, IO$_READVBLK, &input_iosb, kbd_input_ast, 1, &input_buffer, 1, 0, terminator_mask, 0, 0); } int input_count; /* Ast routine that is called when keyboard input comes in in accord with the SYS$QIO above. */ kbd_input_ast () { register int c = -1; int old_errno = errno; extern EMACS_TIME *input_available_clear_time; if (waiting_for_ast) SYS$SETEF (input_ef); waiting_for_ast = 0; input_count++; #ifdef ASTDEBUG if (input_count == 25) exit (1); printf ("Ast # %d,", input_count); printf (" iosb = %x, %x, %x, %x", input_iosb.offset, input_iosb.status, input_iosb.termlen, input_iosb.term); #endif if (input_iosb.offset) { c = input_buffer; #ifdef ASTDEBUG printf (", char = 0%o", c); #endif } #ifdef ASTDEBUG printf ("\n"); fflush (stdout); sleep (1); #endif if (! stop_input) queue_kbd_input (); if (c >= 0) { struct input_event e; e.kind = ascii_keystroke; XSETINT (e.code, c); XSETFRAME (e.frame_or_window, selected_frame); kbd_buffer_store_event (&e); } if (input_available_clear_time) EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); errno = old_errno; } /* Wait until there is something in kbd_buffer. */ wait_for_kbd_input () { extern int have_process_input, process_exited; /* If already something, avoid doing system calls. */ if (detect_input_pending ()) { return; } /* Clear a flag, and tell ast routine above to set it. */ SYS$CLREF (input_ef); waiting_for_ast = 1; /* Check for timing error: ast happened while we were doing that. */ if (!detect_input_pending ()) { /* No timing error: wait for flag to be set. */ set_waiting_for_input (0); SYS$WFLOR (input_ef, input_eflist); clear_waiting_for_input (0); if (!detect_input_pending ()) /* Check for subprocess input availability */ { int dsp = have_process_input || process_exited; SYS$CLREF (process_ef); if (have_process_input) process_command_input (); if (process_exited) process_exit (); if (dsp) { update_mode_lines++; prepare_menu_bars (); redisplay_preserve_echo_area (); } } } waiting_for_ast = 0; } /* Get rid of any pending QIO, when we are about to suspend or when we want to throw away pending input. We wait for a positive sign that the AST routine has run and therefore there is no I/O request queued when we return. SYS$SETAST is used to avoid a timing error. */ end_kbd_input () { #ifdef ASTDEBUG printf ("At end_kbd_input.\n"); fflush (stdout); sleep (1); #endif if (LIB$AST_IN_PROG ()) /* Don't wait if suspending from kbd_buffer_store_event! */ { SYS$CANCEL (input_fd); return; } SYS$SETAST (0); /* Clear a flag, and tell ast routine above to set it. */ SYS$CLREF (input_ef); waiting_for_ast = 1; stop_input = 1; SYS$CANCEL (input_fd); SYS$SETAST (1); SYS$WAITFR (input_ef); waiting_for_ast = 0; } /* Wait for either input available or time interval expiry. */ input_wait_timeout (timeval) int timeval; /* Time to wait, in seconds */ { int time [2]; static int zero = 0; static int large = -10000000; LIB$EMUL (&timeval, &large, &zero, time); /* Convert to VMS format */ /* If already something, avoid doing system calls. */ if (detect_input_pending ()) { return; } /* Clear a flag, and tell ast routine above to set it. */ SYS$CLREF (input_ef); waiting_for_ast = 1; /* Check for timing error: ast happened while we were doing that. */ if (!detect_input_pending ()) { /* No timing error: wait for flag to be set. */ SYS$CANTIM (1, 0); if (SYS$SETIMR (timer_ef, time, 0, 1) & 1) /* Set timer */ SYS$WFLOR (timer_ef, timer_eflist); /* Wait for timer expiry or input */ } waiting_for_ast = 0; } /* The standard `sleep' routine works some other way and it stops working if you have ever quit out of it. This one continues to work. */ sys_sleep (timeval) int timeval; { int time [2]; static int zero = 0; static int large = -10000000; LIB$EMUL (&timeval, &large, &zero, time); /* Convert to VMS format */ SYS$CANTIM (1, 0); if (SYS$SETIMR (timer_ef, time, 0, 1) & 1) /* Set timer */ SYS$WAITFR (timer_ef); /* Wait for timer expiry only */ } init_sigio (fd) int fd; { request_sigio (); } reset_sigio () { unrequest_sigio (); } request_sigio () { croak ("request sigio"); } unrequest_sigio () { croak ("unrequest sigio"); } #endif /* VMS */ /* Note that VMS compiler won't accept defined (CANNOT_DUMP). */ #ifndef CANNOT_DUMP #define NEED_STARTS #endif #ifndef SYSTEM_MALLOC #ifndef NEED_STARTS #define NEED_STARTS #endif #endif #ifdef NEED_STARTS /* Some systems that cannot dump also cannot implement these. */ /* * Return the address of the start of the text segment prior to * doing an unexec. After unexec the return value is undefined. * See crt0.c for further explanation and _start. * */ #ifndef HAVE_TEXT_START char * start_of_text () { #ifdef TEXT_START return ((char *) TEXT_START); #else #ifdef GOULD extern csrt (); return ((char *) csrt); #else /* not GOULD */ extern int _start (); return ((char *) _start); #endif /* GOULD */ #endif /* TEXT_START */ } #endif /* not HAVE_TEXT_START */ /* * Return the address of the start of the data segment prior to * doing an unexec. After unexec the return value is undefined. * See crt0.c for further information and definition of data_start. * * Apparently, on BSD systems this is etext at startup. On * USG systems (swapping) this is highly mmu dependent and * is also dependent on whether or not the program is running * with shared text. Generally there is a (possibly large) * gap between end of text and start of data with shared text. * * On Uniplus+ systems with shared text, data starts at a * fixed address. Each port (from a given oem) is generally * different, and the specific value of the start of data can * be obtained via the UniPlus+ specific "uvar" system call, * however the method outlined in crt0.c seems to be more portable. * * Probably what will have to happen when a USG unexec is available, * at least on UniPlus, is temacs will have to be made unshared so * that text and data are contiguous. Then once loadup is complete, * unexec will produce a shared executable where the data can be * at the normal shared text boundry and the startofdata variable * will be patched by unexec to the correct value. * */ char * start_of_data () { #ifdef DATA_START return ((char *) DATA_START); #else #ifdef ORDINARY_LINK /* * This is a hack. Since we're not linking crt0.c or pre_crt0.c, * data_start isn't defined. We take the address of environ, which * is known to live at or near the start of the system crt0.c, and * we don't sweat the handful of bytes that might lose. */ extern char **environ; return((char *) &environ); #else extern int data_start; return ((char *) &data_start); #endif /* ORDINARY_LINK */ #endif /* DATA_START */ } #endif /* NEED_STARTS (not CANNOT_DUMP or not SYSTEM_MALLOC) */ #ifndef CANNOT_DUMP /* Some systems that cannot dump also cannot implement these. */ /* * Return the address of the end of the text segment prior to * doing an unexec. After unexec the return value is undefined. */ char * end_of_text () { #ifdef TEXT_END return ((char *) TEXT_END); #else extern int etext; return ((char *) &etext); #endif } /* * Return the address of the end of the data segment prior to * doing an unexec. After unexec the return value is undefined. */ char * end_of_data () { #ifdef DATA_END return ((char *) DATA_END); #else extern int edata; return ((char *) &edata); #endif } #endif /* not CANNOT_DUMP */ /* init_system_name sets up the string for the Lisp function system-name to return. */ #ifdef BSD4_1 #include #endif extern Lisp_Object Vsystem_name; #ifndef BSD4_1 #ifndef VMS #ifdef HAVE_SOCKETS #include #include #endif /* HAVE_SOCKETS */ #endif /* not VMS */ #endif /* not BSD4_1 */ void init_system_name () { #ifdef BSD4_1 Vsystem_name = build_string (sysname); #else #ifdef VMS char *sp, *end; if ((sp = egetenv ("SYS$NODE")) == 0) Vsystem_name = build_string ("vax-vms"); else if ((end = index (sp, ':')) == 0) Vsystem_name = build_string (sp); else Vsystem_name = make_string (sp, end - sp); #else #ifndef HAVE_GETHOSTNAME struct utsname uts; uname (&uts); Vsystem_name = build_string (uts.nodename); #else /* HAVE_GETHOSTNAME */ unsigned int hostname_size = 256; char *hostname = (char *) alloca (hostname_size); /* Try to get the host name; if the buffer is too short, try again. Apparently, the only indication gethostname gives of whether the buffer was large enough is the presence or absence of a '\0' in the string. Eech. */ for (;;) { gethostname (hostname, hostname_size - 1); hostname[hostname_size - 1] = '\0'; /* Was the buffer large enough for the '\0'? */ if (strlen (hostname) < hostname_size - 1) break; hostname_size <<= 1; hostname = (char *) alloca (hostname_size); } #ifdef HAVE_SOCKETS /* Turn the hostname into the official, fully-qualified hostname. Don't do this if we're going to dump; this can confuse system libraries on some machines and make the dumped emacs core dump. */ #ifndef CANNOT_DUMP if (initialized) #endif /* not CANNOT_DUMP */ { struct hostent *hp; int count; for (count = 0; count < 10; count++) { #ifdef TRY_AGAIN h_errno = 0; #endif hp = gethostbyname (hostname); #ifdef TRY_AGAIN if (! (hp == 0 && h_errno == TRY_AGAIN)) #endif break; Fsleep_for (make_number (1), Qnil); } if (hp) { char *fqdn = (char *) hp->h_name; char *p; if (!index (fqdn, '.')) { /* We still don't have a fully qualified domain name. Try to find one in the list of alternate names */ char **alias = hp->h_aliases; while (*alias && !index (*alias, '.')) alias++; if (*alias) fqdn = *alias; } hostname = fqdn; #if 0 /* Convert the host name to lower case. */ /* Using ctype.h here would introduce a possible locale dependence that is probably wrong for hostnames. */ p = hostname; while (*p) { if (*p >= 'A' && *p <= 'Z') *p += 'a' - 'A'; p++; } #endif } } #endif /* HAVE_SOCKETS */ Vsystem_name = build_string (hostname); #endif /* HAVE_GETHOSTNAME */ #endif /* VMS */ #endif /* BSD4_1 */ { unsigned char *p; for (p = XSTRING (Vsystem_name)->data; *p; p++) if (*p == ' ' || *p == '\t') *p = '-'; } } #ifndef MSDOS #ifndef VMS #if !defined (HAVE_SELECT) || defined (BROKEN_SELECT_NON_X) #include "sysselect.h" #undef select #if defined (HAVE_X_WINDOWS) && !defined (HAVE_SELECT) /* Cause explanatory error message at compile time, since the select emulation is not good enough for X. */ int *x = &x_windows_lose_if_no_select_system_call; #endif /* Emulate as much as select as is possible under 4.1 and needed by Gnu Emacs * Only checks read descriptors. */ /* How long to wait between checking fds in select */ #define SELECT_PAUSE 1 int select_alarmed; /* For longjmp'ing back to read_input_waiting. */ jmp_buf read_alarm_throw; /* Nonzero if the alarm signal should throw back to read_input_waiting. The read_socket_hook function sets this to 1 while it is waiting. */ int read_alarm_should_throw; SIGTYPE select_alarm () { select_alarmed = 1; #ifdef BSD4_1 sigrelse (SIGALRM); #else /* not BSD4_1 */ signal (SIGALRM, SIG_IGN); #endif /* not BSD4_1 */ if (read_alarm_should_throw) longjmp (read_alarm_throw, 1); } #ifndef WINDOWSNT /* Only rfds are checked. */ int sys_select (nfds, rfds, wfds, efds, timeout) int nfds; SELECT_TYPE *rfds, *wfds, *efds; EMACS_TIME *timeout; { int ravail = 0, old_alarm; SELECT_TYPE orfds; int timeoutval; int *local_timeout; extern int proc_buffered_char[]; #ifndef subprocesses int process_tick = 0, update_tick = 0; #else extern int process_tick, update_tick; #endif SIGTYPE (*old_trap) (); unsigned char buf; #if defined (HAVE_SELECT) && defined (HAVE_X_WINDOWS) /* If we're using X, then the native select will work; we only need the emulation for non-X usage. */ if (!NILP (Vwindow_system)) return select (nfds, rfds, wfds, efds, timeout); #endif timeoutval = timeout ? EMACS_SECS (*timeout) : 100000; local_timeout = &timeoutval; FD_ZERO (&orfds); if (rfds) { orfds = *rfds; FD_ZERO (rfds); } if (wfds) FD_ZERO (wfds); if (efds) FD_ZERO (efds); /* If we are looking only for the terminal, with no timeout, just read it and wait -- that's more efficient. */ if (*local_timeout == 100000 && process_tick == update_tick && FD_ISSET (0, &orfds)) { int fd; for (fd = 1; fd < nfds; ++fd) if (FD_ISSET (fd, &orfds)) goto hardway; if (! detect_input_pending ()) read_input_waiting (); FD_SET (0, rfds); return 1; } hardway: /* Once a second, till the timer expires, check all the flagged read * descriptors to see if any input is available. If there is some then * set the corresponding bit in the return copy of rfds. */ while (1) { register int to_check, fd; if (rfds) { for (to_check = nfds, fd = 0; --to_check >= 0; fd++) { if (FD_ISSET (fd, &orfds)) { int avail = 0, status = 0; if (fd == 0) avail = detect_input_pending (); /* Special keyboard handler */ else { #ifdef FIONREAD status = ioctl (fd, FIONREAD, &avail); #else /* no FIONREAD */ /* Hoping it will return -1 if nothing available or 0 if all 0 chars requested are read. */ if (proc_buffered_char[fd] >= 0) avail = 1; else { avail = read (fd, &buf, 1); if (avail > 0) proc_buffered_char[fd] = buf; } #endif /* no FIONREAD */ } if (status >= 0 && avail > 0) { FD_SET (fd, rfds); ravail++; } } } } if (*local_timeout == 0 || ravail != 0 || process_tick != update_tick) break; old_alarm = alarm (0); old_trap = signal (SIGALRM, select_alarm); select_alarmed = 0; alarm (SELECT_PAUSE); /* Wait for a SIGALRM (or maybe a SIGTINT) */ while (select_alarmed == 0 && *local_timeout != 0 && process_tick == update_tick) { /* If we are interested in terminal input, wait by reading the terminal. That makes instant wakeup for terminal input at least. */ if (FD_ISSET (0, &orfds)) { read_input_waiting (); if (detect_input_pending ()) select_alarmed = 1; } else pause (); } (*local_timeout) -= SELECT_PAUSE; /* Reset the old alarm if there was one */ alarm (0); signal (SIGALRM, old_trap); if (old_alarm != 0) { /* Reset or forge an interrupt for the original handler. */ old_alarm -= SELECT_PAUSE; if (old_alarm <= 0) kill (getpid (), SIGALRM); /* Fake an alarm with the orig' handler */ else alarm (old_alarm); } if (*local_timeout == 0) /* Stop on timer being cleared */ break; } return ravail; } #endif /* not WINDOWSNT */ /* Read keyboard input into the standard buffer, waiting for at least one character. */ /* Make all keyboard buffers much bigger when using a window system. */ #ifdef HAVE_WINDOW_SYSTEM #define BUFFER_SIZE_FACTOR 16 #else #define BUFFER_SIZE_FACTOR 1 #endif read_input_waiting () { struct input_event e; int nread, i; extern int quit_char; if (read_socket_hook) { struct input_event buf[256]; read_alarm_should_throw = 0; if (! setjmp (read_alarm_throw)) nread = (*read_socket_hook) (0, buf, 256, 1, 0); else nread = -1; /* Scan the chars for C-g and store them in kbd_buffer. */ for (i = 0; i < nread; i++) { kbd_buffer_store_event (&buf[i]); /* Don't look at input that follows a C-g too closely. This reduces lossage due to autorepeat on C-g. */ if (buf[i].kind == ascii_keystroke && buf[i].code == quit_char) break; } } else { char buf[3]; nread = read (fileno (stdin), buf, 1); /* Scan the chars for C-g and store them in kbd_buffer. */ e.kind = ascii_keystroke; XSETFRAME (e.frame_or_window, selected_frame); e.modifiers = 0; for (i = 0; i < nread; i++) { /* Convert chars > 0177 to meta events if desired. We do this under the same conditions that read_avail_input does. */ if (read_socket_hook == 0) { /* If the user says she has a meta key, then believe her. */ if (meta_key == 1 && (buf[i] & 0x80)) e.modifiers = meta_modifier; if (meta_key != 2) buf[i] &= ~0x80; } XSETINT (e.code, buf[i]); kbd_buffer_store_event (&e); /* Don't look at input that follows a C-g too closely. This reduces lossage due to autorepeat on C-g. */ if (buf[i] == quit_char) break; } } } #endif /* not HAVE_SELECT */ #endif /* not VMS */ #endif /* not MSDOS */ #ifdef BSD4_1 /* * Partially emulate 4.2 open call. * open is defined as this in 4.1. * * - added by Michael Bloom @ Citicorp/TTI * */ int sys_open (path, oflag, mode) char *path; int oflag, mode; { if (oflag & O_CREAT) return creat (path, mode); else return open (path, oflag); } init_sigio (fd) int fd; { if (noninteractive) return; lmode = LINTRUP | lmode; ioctl (fd, TIOCLSET, &lmode); } reset_sigio () { if (noninteractive) return; lmode = ~LINTRUP & lmode; ioctl (0, TIOCLSET, &lmode); } request_sigio () { sigrelse (SIGTINT); interrupts_deferred = 0; } unrequest_sigio () { sighold (SIGTINT); interrupts_deferred = 1; } /* still inside #ifdef BSD4_1 */ #ifdef subprocesses int sigheld; /* Mask of held signals */ sigholdx (signum) int signum; { sigheld |= sigbit (signum); sighold (signum); } sigisheld (signum) int signum; { sigheld |= sigbit (signum); } sigunhold (signum) int signum; { sigheld &= ~sigbit (signum); sigrelse (signum); } sigfree () /* Free all held signals */ { int i; for (i = 0; i < NSIG; i++) if (sigheld & sigbit (i)) sigrelse (i); sigheld = 0; } sigbit (i) { return 1 << (i - 1); } #endif /* subprocesses */ #endif /* BSD4_1 */ /* POSIX signals support - DJB */ /* Anyone with POSIX signals should have ANSI C declarations */ #ifdef POSIX_SIGNALS sigset_t old_mask, empty_mask, full_mask, temp_mask; static struct sigaction new_action, old_action; init_signals () { sigemptyset (&empty_mask); sigfillset (&full_mask); } signal_handler_t sys_signal (int signal_number, signal_handler_t action) { #ifdef DGUX /* This gets us restartable system calls for efficiency. The "else" code will works as well. */ return (berk_signal (signal_number, action)); #else sigemptyset (&new_action.sa_mask); new_action.sa_handler = action; #ifdef SA_RESTART /* Emacs mostly works better with restartable system services. If this * flag exists, we probably want to turn it on here. */ new_action.sa_flags = SA_RESTART; #else new_action.sa_flags = 0; #endif sigaction (signal_number, &new_action, &old_action); return (old_action.sa_handler); #endif /* DGUX */ } #ifndef __GNUC__ /* If we're compiling with GCC, we don't need this function, since it can be written as a macro. */ sigset_t sys_sigmask (int sig) { sigset_t mask; sigemptyset (&mask); sigaddset (&mask, sig); return mask; } #endif int sys_sigpause (sigset_t new_mask) { /* pause emulating berk sigpause... */ sigsuspend (&new_mask); return (EINTR); } /* I'd like to have these guys return pointers to the mask storage in here, but there'd be trouble if the code was saving multiple masks. I'll be safe and pass the structure. It normally won't be more than 2 bytes anyhow. - DJB */ sigset_t sys_sigblock (sigset_t new_mask) { sigset_t old_mask; sigprocmask (SIG_BLOCK, &new_mask, &old_mask); return (old_mask); } sigset_t sys_sigunblock (sigset_t new_mask) { sigset_t old_mask; sigprocmask (SIG_UNBLOCK, &new_mask, &old_mask); return (old_mask); } sigset_t sys_sigsetmask (sigset_t new_mask) { sigset_t old_mask; sigprocmask (SIG_SETMASK, &new_mask, &old_mask); return (old_mask); } #endif /* POSIX_SIGNALS */ #ifndef HAVE_RANDOM #ifdef random #define HAVE_RANDOM #endif #endif /* Figure out how many bits the system's random number generator uses. `random' and `lrand48' are assumed to return 31 usable bits. BSD `rand' returns a 31 bit value but the low order bits are unusable; so we'll shift it and treat it like the 15-bit USG `rand'. */ #ifndef RAND_BITS # ifdef HAVE_RANDOM # define RAND_BITS 31 # else /* !HAVE_RANDOM */ # ifdef HAVE_LRAND48 # define RAND_BITS 31 # define random lrand48 # else /* !HAVE_LRAND48 */ # define RAND_BITS 15 # if RAND_MAX == 32767 # define random rand # else /* RAND_MAX != 32767 */ # if RAND_MAX == 2147483647 # define random() (rand () >> 16) # else /* RAND_MAX != 2147483647 */ # ifdef USG # define random rand # else # define random() (rand () >> 16) # endif /* !BSD */ # endif /* RAND_MAX != 2147483647 */ # endif /* RAND_MAX != 32767 */ # endif /* !HAVE_LRAND48 */ # endif /* !HAVE_RANDOM */ #endif /* !RAND_BITS */ void seed_random (arg) long arg; { #ifdef HAVE_RANDOM srandom ((unsigned int)arg); #else # ifdef HAVE_LRAND48 srand48 (arg); # else srand ((unsigned int)arg); # endif #endif } /* * Build a full Emacs-sized word out of whatever we've got. * This suffices even for a 64-bit architecture with a 15-bit rand. */ long get_random () { long val = random (); #if VALBITS > RAND_BITS val = (val << RAND_BITS) ^ random (); #if VALBITS > 2*RAND_BITS val = (val << RAND_BITS) ^ random (); #if VALBITS > 3*RAND_BITS val = (val << RAND_BITS) ^ random (); #if VALBITS > 4*RAND_BITS val = (val << RAND_BITS) ^ random (); #endif /* need at least 5 */ #endif /* need at least 4 */ #endif /* need at least 3 */ #endif /* need at least 2 */ return val & ((1L << VALBITS) - 1); } #ifdef WRONG_NAME_INSQUE insque (q,p) caddr_t q,p; { _insque (q,p); } #endif #ifdef VMS #ifdef getenv /* If any place else asks for the TERM variable, allow it to be overridden with the EMACS_TERM variable before attempting to translate the logical name TERM. As a last resort, ask for VAX C's special idea of the TERM variable. */ #undef getenv char * sys_getenv (name) char *name; { register char *val; static char buf[256]; static struct dsc$descriptor_s equiv = {sizeof (buf), DSC$K_DTYPE_T, DSC$K_CLASS_S, buf}; static struct dsc$descriptor_s d_name = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; short eqlen; if (!strcmp (name, "TERM")) { val = (char *) getenv ("EMACS_TERM"); if (val) return val; } d_name.dsc$w_length = strlen (name); d_name.dsc$a_pointer = name; if (LIB$SYS_TRNLOG (&d_name, &eqlen, &equiv) == 1) { char *str = (char *) xmalloc (eqlen + 1); bcopy (buf, str, eqlen); str[eqlen] = '\0'; /* This is a storage leak, but a pain to fix. With luck, no one will ever notice. */ return str; } return (char *) getenv (name); } #endif /* getenv */ #ifdef abort /* Since VMS doesn't believe in core dumps, the only way to debug this beast is to force a call on the debugger from within the image. */ #undef abort sys_abort () { reset_sys_modes (); LIB$SIGNAL (SS$_DEBUG); } #endif /* abort */ #endif /* VMS */ #ifdef VMS #ifdef LINK_CRTL_SHARE #ifdef SHAREABLE_LIB_BUG /* Variables declared noshare and initialized in sharable libraries cannot be shared. The VMS linker incorrectly forces you to use a private version which is uninitialized... If not for this "feature", we could use the C library definition of sys_nerr and sys_errlist. */ int sys_nerr = 35; char *sys_errlist[] = { "error 0", "not owner", "no such file or directory", "no such process", "interrupted system call", "i/o error", "no such device or address", "argument list too long", "exec format error", "bad file number", "no child process", "no more processes", "not enough memory", "permission denied", "bad address", "block device required", "mount devices busy", "file exists", "cross-device link", "no such device", "not a directory", "is a directory", "invalid argument", "file table overflow", "too many open files", "not a typewriter", "text file busy", "file too big", "no space left on device", "illegal seek", "read-only file system", "too many links", "broken pipe", "math argument", "result too large", "I/O stream empty", "vax/vms specific error code nontranslatable error" }; #endif /* SHAREABLE_LIB_BUG */ #endif /* LINK_CRTL_SHARE */ #endif /* VMS */ #ifndef HAVE_STRERROR #ifndef WINDOWSNT char * strerror (errnum) int errnum; { extern char *sys_errlist[]; extern int sys_nerr; if (errnum >= 0 && errnum < sys_nerr) return sys_errlist[errnum]; return (char *) "Unknown error"; } #endif /* not WINDOWSNT */ #endif /* ! HAVE_STRERROR */ #ifdef INTERRUPTIBLE_OPEN int /* VARARGS 2 */ sys_open (path, oflag, mode) char *path; int oflag, mode; { register int rtnval; while ((rtnval = open (path, oflag, mode)) == -1 && (errno == EINTR)); return (rtnval); } #endif /* INTERRUPTIBLE_OPEN */ #ifdef INTERRUPTIBLE_CLOSE sys_close (fd) int fd; { int did_retry = 0; register int rtnval; while ((rtnval = close (fd)) == -1 && (errno == EINTR)) did_retry = 1; /* If close is interrupted SunOS 4.1 may or may not have closed the file descriptor. If it did the second close will fail with errno = EBADF. That means we have succeeded. */ if (rtnval == -1 && did_retry && errno == EBADF) return 0; return rtnval; } #endif /* INTERRUPTIBLE_CLOSE */ #ifdef INTERRUPTIBLE_IO int sys_read (fildes, buf, nbyte) int fildes; char *buf; unsigned int nbyte; { register int rtnval; while ((rtnval = read (fildes, buf, nbyte)) == -1 && (errno == EINTR)); return (rtnval); } int sys_write (fildes, buf, nbyte) int fildes; char *buf; unsigned int nbyte; { register int rtnval, bytes_written; bytes_written = 0; while (nbyte > 0) { rtnval = write (fildes, buf, nbyte); if (rtnval == -1) { if (errno == EINTR) continue; else return (bytes_written ? bytes_written : -1); } buf += rtnval; nbyte -= rtnval; bytes_written += rtnval; } return (bytes_written); } #endif /* INTERRUPTIBLE_IO */ #ifndef HAVE_VFORK #ifndef WINDOWSNT /* * Substitute fork for vfork on USG flavors. */ VFORK_RETURN_TYPE vfork () { return (fork ()); } #endif /* not WINDOWSNT */ #endif /* not HAVE_VFORK */ #ifdef USG /* * All of the following are for USG. * * On USG systems the system calls are INTERRUPTIBLE by signals * that the user program has elected to catch. Thus the system call * must be retried in these cases. To handle this without massive * changes in the source code, we remap the standard system call names * to names for our own functions in sysdep.c that do the system call * with retries. Actually, for portability reasons, it is good * programming practice, as this example shows, to limit all actual * system calls to a single occurrence in the source. Sure, this * adds an extra level of function call overhead but it is almost * always negligible. Fred Fish, Unisoft Systems Inc. */ #ifndef HAVE_SYS_SIGLIST char *sys_siglist[NSIG + 1] = { #ifdef AIX /* AIX has changed the signals a bit */ "bogus signal", /* 0 */ "hangup", /* 1 SIGHUP */ "interrupt", /* 2 SIGINT */ "quit", /* 3 SIGQUIT */ "illegal instruction", /* 4 SIGILL */ "trace trap", /* 5 SIGTRAP */ "IOT instruction", /* 6 SIGIOT */ "crash likely", /* 7 SIGDANGER */ "floating point exception", /* 8 SIGFPE */ "kill", /* 9 SIGKILL */ "bus error", /* 10 SIGBUS */ "segmentation violation", /* 11 SIGSEGV */ "bad argument to system call", /* 12 SIGSYS */ "write on a pipe with no one to read it", /* 13 SIGPIPE */ "alarm clock", /* 14 SIGALRM */ "software termination signum", /* 15 SIGTERM */ "user defined signal 1", /* 16 SIGUSR1 */ "user defined signal 2", /* 17 SIGUSR2 */ "death of a child", /* 18 SIGCLD */ "power-fail restart", /* 19 SIGPWR */ "bogus signal", /* 20 */ "bogus signal", /* 21 */ "bogus signal", /* 22 */ "bogus signal", /* 23 */ "bogus signal", /* 24 */ "LAN I/O interrupt", /* 25 SIGAIO */ "PTY I/O interrupt", /* 26 SIGPTY */ "I/O intervention required", /* 27 SIGIOINT */ #ifdef AIXHFT "HFT grant", /* 28 SIGGRANT */ "HFT retract", /* 29 SIGRETRACT */ "HFT sound done", /* 30 SIGSOUND */ "HFT input ready", /* 31 SIGMSG */ #endif #else /* not AIX */ "bogus signal", /* 0 */ "hangup", /* 1 SIGHUP */ "interrupt", /* 2 SIGINT */ "quit", /* 3 SIGQUIT */ "illegal instruction", /* 4 SIGILL */ "trace trap", /* 5 SIGTRAP */ "IOT instruction", /* 6 SIGIOT */ "EMT instruction", /* 7 SIGEMT */ "floating point exception", /* 8 SIGFPE */ "kill", /* 9 SIGKILL */ "bus error", /* 10 SIGBUS */ "segmentation violation", /* 11 SIGSEGV */ "bad argument to system call", /* 12 SIGSYS */ "write on a pipe with no one to read it", /* 13 SIGPIPE */ "alarm clock", /* 14 SIGALRM */ "software termination signum", /* 15 SIGTERM */ "user defined signal 1", /* 16 SIGUSR1 */ "user defined signal 2", /* 17 SIGUSR2 */ "death of a child", /* 18 SIGCLD */ "power-fail restart", /* 19 SIGPWR */ #ifdef sun "window size change", /* 20 SIGWINCH */ "urgent socket condition", /* 21 SIGURG */ "pollable event occured", /* 22 SIGPOLL */ "stop (cannot be caught or ignored)", /* 23 SIGSTOP */ "user stop requested from tty", /* 24 SIGTSTP */ "stopped process has been continued", /* 25 SIGCONT */ "background tty read attempted", /* 26 SIGTTIN */ "background tty write attempted", /* 27 SIGTTOU */ "virtual timer expired", /* 28 SIGVTALRM */ "profiling timer expired", /* 29 SIGPROF */ "exceeded cpu limit", /* 30 SIGXCPU */ "exceeded file size limit", /* 31 SIGXFSZ */ "process's lwps are blocked", /* 32 SIGWAITING */ "special signal used by thread library", /* 33 SIGLWP */ #ifdef SIGFREEZE "Special Signal Used By CPR", /* 34 SIGFREEZE */ #endif #ifdef SIGTHAW "Special Signal Used By CPR", /* 35 SIGTHAW */ #endif #endif /* sun */ #endif /* not AIX */ 0 }; #endif /* HAVE_SYS_SIGLIST */ /* * Warning, this function may not duplicate 4.2 action properly * under error conditions. */ #ifndef MAXPATHLEN /* In 4.1, param.h fails to define this. */ #define MAXPATHLEN 1024 #endif #ifndef HAVE_GETWD char * getwd (pathname) char *pathname; { char *npath, *spath; extern char *getcwd (); BLOCK_INPUT; /* getcwd uses malloc */ spath = npath = getcwd ((char *) 0, MAXPATHLEN); if (spath == 0) return spath; /* On Altos 3068, getcwd can return @hostname/dir, so discard up to first slash. Should be harmless on other systems. */ while (*npath && *npath != '/') npath++; strcpy (pathname, npath); free (spath); /* getcwd uses malloc */ UNBLOCK_INPUT; return pathname; } #endif /* HAVE_GETWD */ /* * Emulate rename using unlink/link. Note that this is * only partially correct. Also, doesn't enforce restriction * that files be of same type (regular->regular, dir->dir, etc). */ #ifndef HAVE_RENAME rename (from, to) const char *from; const char *to; { if (access (from, 0) == 0) { unlink (to); if (link (from, to) == 0) if (unlink (from) == 0) return (0); } return (-1); } #endif #ifdef HPUX #ifndef HAVE_PERROR /* HPUX curses library references perror, but as far as we know it won't be called. Anyway this definition will do for now. */ perror () { } #endif /* not HAVE_PERROR */ #endif /* HPUX */ #ifndef HAVE_DUP2 /* * Emulate BSD dup2. First close newd if it already exists. * Then, attempt to dup oldd. If not successful, call dup2 recursively * until we are, then close the unsuccessful ones. */ dup2 (oldd, newd) int oldd; int newd; { register int fd, ret; sys_close (newd); #ifdef F_DUPFD fd = fcntl (oldd, F_DUPFD, newd); if (fd != newd) error ("can't dup2 (%i,%i) : %s", oldd, newd, strerror (errno)); #else fd = dup (old); if (fd == -1) return -1; if (fd == new) return new; ret = dup2 (old,new); sys_close (fd); return ret; #endif } #endif /* not HAVE_DUP2 */ /* * Gettimeofday. Simulate as much as possible. Only accurate * to nearest second. Emacs doesn't use tzp so ignore it for now. * Only needed when subprocesses are defined. */ #ifdef subprocesses #ifndef VMS #ifndef HAVE_GETTIMEOFDAY #ifdef HAVE_TIMEVAL /* ARGSUSED */ gettimeofday (tp, tzp) struct timeval *tp; struct timezone *tzp; { extern long time (); tp->tv_sec = time ((long *)0); tp->tv_usec = 0; if (tzp != 0) tzp->tz_minuteswest = -1; } #endif #endif #endif #endif /* subprocess && !HAVE_GETTIMEOFDAY && HAVE_TIMEVAL && !VMS */ /* * This function will go away as soon as all the stubs fixed. (fnf) */ croak (badfunc) char *badfunc; { printf ("%s not yet implemented\r\n", badfunc); reset_sys_modes (); exit (1); } #endif /* USG */ #ifdef DGUX char *sys_siglist[NSIG + 1] = { "null signal", /* 0 SIGNULL */ "hangup", /* 1 SIGHUP */ "interrupt", /* 2 SIGINT */ "quit", /* 3 SIGQUIT */ "illegal instruction", /* 4 SIGILL */ "trace trap", /* 5 SIGTRAP */ "abort termination", /* 6 SIGABRT */ "SIGEMT", /* 7 SIGEMT */ "floating point exception", /* 8 SIGFPE */ "kill", /* 9 SIGKILL */ "bus error", /* 10 SIGBUS */ "segmentation violation", /* 11 SIGSEGV */ "bad argument to system call", /* 12 SIGSYS */ "write on a pipe with no reader", /* 13 SIGPIPE */ "alarm clock", /* 14 SIGALRM */ "software termination signal", /* 15 SIGTERM */ "user defined signal 1", /* 16 SIGUSR1 */ "user defined signal 2", /* 17 SIGUSR2 */ "child stopped or terminated", /* 18 SIGCLD */ "power-fail restart", /* 19 SIGPWR */ "window size changed", /* 20 SIGWINCH */ "undefined", /* 21 */ "pollable event occurred", /* 22 SIGPOLL */ "sendable stop signal not from tty", /* 23 SIGSTOP */ "stop signal from tty", /* 24 SIGSTP */ "continue a stopped process", /* 25 SIGCONT */ "attempted background tty read", /* 26 SIGTTIN */ "attempted background tty write", /* 27 SIGTTOU */ "undefined", /* 28 */ "undefined", /* 29 */ "undefined", /* 30 */ "undefined", /* 31 */ "undefined", /* 32 */ "socket (TCP/IP) urgent data arrival", /* 33 SIGURG */ "I/O is possible", /* 34 SIGIO */ "exceeded cpu time limit", /* 35 SIGXCPU */ "exceeded file size limit", /* 36 SIGXFSZ */ "virtual time alarm", /* 37 SIGVTALRM */ "profiling time alarm", /* 38 SIGPROF */ "undefined", /* 39 */ "file record locks revoked", /* 40 SIGLOST */ "undefined", /* 41 */ "undefined", /* 42 */ "undefined", /* 43 */ "undefined", /* 44 */ "undefined", /* 45 */ "undefined", /* 46 */ "undefined", /* 47 */ "undefined", /* 48 */ "undefined", /* 49 */ "undefined", /* 50 */ "undefined", /* 51 */ "undefined", /* 52 */ "undefined", /* 53 */ "undefined", /* 54 */ "undefined", /* 55 */ "undefined", /* 56 */ "undefined", /* 57 */ "undefined", /* 58 */ "undefined", /* 59 */ "undefined", /* 60 */ "undefined", /* 61 */ "undefined", /* 62 */ "undefined", /* 63 */ "notification message in mess. queue", /* 64 SIGDGNOTIFY */ 0 }; #endif /* DGUX */ /* Directory routines for systems that don't have them. */ #ifdef SYSV_SYSTEM_DIR #include #if defined(BROKEN_CLOSEDIR) || !defined(HAVE_CLOSEDIR) int closedir (dirp) register DIR *dirp; /* stream from opendir */ { int rtnval; rtnval = sys_close (dirp->dd_fd); /* Some systems (like Solaris) allocate the buffer and the DIR all in one block. Why in the world are we freeing this ourselves anyway? */ #if ! (defined (sun) && defined (USG5_4)) xfree ((char *) dirp->dd_buf); /* directory block defined in */ #endif xfree ((char *) dirp); return rtnval; } #endif /* BROKEN_CLOSEDIR or not HAVE_CLOSEDIR */ #endif /* SYSV_SYSTEM_DIR */ #ifdef NONSYSTEM_DIR_LIBRARY DIR * opendir (filename) char *filename; /* name of directory */ { register DIR *dirp; /* -> malloc'ed storage */ register int fd; /* file descriptor for read */ struct stat sbuf; /* result of fstat */ fd = sys_open (filename, 0); if (fd < 0) return 0; BLOCK_INPUT; if (fstat (fd, &sbuf) < 0 || (sbuf.st_mode & S_IFMT) != S_IFDIR || (dirp = (DIR *) malloc (sizeof (DIR))) == 0) { sys_close (fd); UNBLOCK_INPUT; return 0; /* bad luck today */ } UNBLOCK_INPUT; dirp->dd_fd = fd; dirp->dd_loc = dirp->dd_size = 0; /* refill needed */ return dirp; } void closedir (dirp) register DIR *dirp; /* stream from opendir */ { sys_close (dirp->dd_fd); xfree ((char *) dirp); } #ifndef VMS #define DIRSIZ 14 struct olddir { ino_t od_ino; /* inode */ char od_name[DIRSIZ]; /* filename */ }; #endif /* not VMS */ struct direct dir_static; /* simulated directory contents */ /* ARGUSED */ struct direct * readdir (dirp) register DIR *dirp; /* stream from opendir */ { #ifndef VMS register struct olddir *dp; /* -> directory data */ #else /* VMS */ register struct dir$_name *dp; /* -> directory data */ register struct dir$_version *dv; /* -> version data */ #endif /* VMS */ for (; ;) { if (dirp->dd_loc >= dirp->dd_size) dirp->dd_loc = dirp->dd_size = 0; if (dirp->dd_size == 0 /* refill buffer */ && (dirp->dd_size = sys_read (dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ)) <= 0) return 0; #ifndef VMS dp = (struct olddir *) &dirp->dd_buf[dirp->dd_loc]; dirp->dd_loc += sizeof (struct olddir); if (dp->od_ino != 0) /* not deleted entry */ { dir_static.d_ino = dp->od_ino; strncpy (dir_static.d_name, dp->od_name, DIRSIZ); dir_static.d_name[DIRSIZ] = '\0'; dir_static.d_namlen = strlen (dir_static.d_name); dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3 + dir_static.d_namlen - dir_static.d_namlen % 4; return &dir_static; /* -> simulated structure */ } #else /* VMS */ dp = (struct dir$_name *) dirp->dd_buf; if (dirp->dd_loc == 0) dirp->dd_loc = (dp->dir$b_namecount&1) ? dp->dir$b_namecount + 1 : dp->dir$b_namecount; dv = (struct dir$_version *)&dp->dir$t_name[dirp->dd_loc]; dir_static.d_ino = dv->dir$w_fid_num; dir_static.d_namlen = dp->dir$b_namecount; dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3 + dir_static.d_namlen - dir_static.d_namlen % 4; strncpy (dir_static.d_name, dp->dir$t_name, dp->dir$b_namecount); dir_static.d_name[dir_static.d_namlen] = '\0'; dirp->dd_loc = dirp->dd_size; /* only one record at a time */ return &dir_static; #endif /* VMS */ } } #ifdef VMS /* readdirver is just like readdir except it returns all versions of a file as separate entries. */ /* ARGUSED */ struct direct * readdirver (dirp) register DIR *dirp; /* stream from opendir */ { register struct dir$_name *dp; /* -> directory data */ register struct dir$_version *dv; /* -> version data */ if (dirp->dd_loc >= dirp->dd_size - sizeof (struct dir$_name)) dirp->dd_loc = dirp->dd_size = 0; if (dirp->dd_size == 0 /* refill buffer */ && (dirp->dd_size = sys_read (dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ)) <= 0) return 0; dp = (struct dir$_name *) dirp->dd_buf; if (dirp->dd_loc == 0) dirp->dd_loc = (dp->dir$b_namecount & 1) ? dp->dir$b_namecount + 1 : dp->dir$b_namecount; dv = (struct dir$_version *) &dp->dir$t_name[dirp->dd_loc]; strncpy (dir_static.d_name, dp->dir$t_name, dp->dir$b_namecount); sprintf (&dir_static.d_name[dp->dir$b_namecount], ";%d", dv->dir$w_version); dir_static.d_namlen = strlen (dir_static.d_name); dir_static.d_ino = dv->dir$w_fid_num; dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3 + dir_static.d_namlen - dir_static.d_namlen % 4; dirp->dd_loc = ((char *) (++dv) - dp->dir$t_name); return &dir_static; } #endif /* VMS */ #endif /* NONSYSTEM_DIR_LIBRARY */ int set_file_times (filename, atime, mtime) char *filename; EMACS_TIME atime, mtime; { #ifdef HAVE_UTIMES struct timeval tv[2]; tv[0] = atime; tv[1] = mtime; return utimes (filename, tv); #else /* not HAVE_UTIMES */ struct utimbuf utb; utb.actime = EMACS_SECS (atime); utb.modtime = EMACS_SECS (mtime); return utime (filename, &utb); #endif /* not HAVE_UTIMES */ } /* mkdir and rmdir functions, for systems which don't have them. */ #ifndef HAVE_MKDIR /* * Written by Robert Rother, Mariah Corporation, August 1985. * * If you want it, it's yours. All I ask in return is that if you * figure out how to do this in a Bourne Shell script you send me * a copy. * sdcsvax!rmr or rmr@uscd * * Severely hacked over by John Gilmore to make a 4.2BSD compatible * subroutine. 11Mar86; hoptoad!gnu * * Modified by rmtodd@uokmax 6-28-87 -- when making an already existing dir, * subroutine didn't return EEXIST. It does now. */ /* * Make a directory. */ #ifdef MKDIR_PROTOTYPE MKDIR_PROTOTYPE #else int mkdir (dpath, dmode) char *dpath; int dmode; #endif { int cpid, status, fd; struct stat statbuf; if (stat (dpath, &statbuf) == 0) { errno = EEXIST; /* Stat worked, so it already exists */ return -1; } /* If stat fails for a reason other than non-existence, return error */ if (errno != ENOENT) return -1; synch_process_alive = 1; switch (cpid = fork ()) { case -1: /* Error in fork */ return (-1); /* Errno is set already */ case 0: /* Child process */ /* * Cheap hack to set mode of new directory. Since this * child process is going away anyway, we zap its umask. * FIXME, this won't suffice to set SUID, SGID, etc. on this * directory. Does anybody care? */ status = umask (0); /* Get current umask */ status = umask (status | (0777 & ~dmode)); /* Set for mkdir */ fd = sys_open("/dev/null", 2); if (fd >= 0) { dup2 (fd, 0); dup2 (fd, 1); dup2 (fd, 2); } execl ("/bin/mkdir", "mkdir", dpath, (char *) 0); _exit (-1); /* Can't exec /bin/mkdir */ default: /* Parent process */ wait_for_termination (cpid); } if (synch_process_death != 0 || synch_process_retcode != 0) { errno = EIO; /* We don't know why, but */ return -1; /* /bin/mkdir failed */ } return 0; } #endif /* not HAVE_MKDIR */ #ifndef HAVE_RMDIR int rmdir (dpath) char *dpath; { int cpid, status, fd; struct stat statbuf; if (stat (dpath, &statbuf) != 0) { /* Stat just set errno. We don't have to */ return -1; } synch_process_alive = 1; switch (cpid = fork ()) { case -1: /* Error in fork */ return (-1); /* Errno is set already */ case 0: /* Child process */ fd = sys_open("/dev/null", 2); if (fd >= 0) { dup2 (fd, 0); dup2 (fd, 1); dup2 (fd, 2); } execl ("/bin/rmdir", "rmdir", dpath, (char *) 0); _exit (-1); /* Can't exec /bin/rmdir */ default: /* Parent process */ wait_for_termination (cpid); } if (synch_process_death != 0 || synch_process_retcode != 0) { errno = EIO; /* We don't know why, but */ return -1; /* /bin/rmdir failed */ } return 0; } #endif /* !HAVE_RMDIR */ /* Functions for VMS */ #ifdef VMS #include "vms-pwd.h" #include #include #include /* Return as a string the VMS error string pertaining to STATUS. Reuses the same static buffer each time it is called. */ char * vmserrstr (status) int status; /* VMS status code */ { int bufadr[2]; short len; static char buf[257]; bufadr[0] = sizeof buf - 1; bufadr[1] = (int) buf; if (! (SYS$GETMSG (status, &len, bufadr, 0x1, 0) & 1)) return "untranslatable VMS error status"; buf[len] = '\0'; return buf; } #ifdef access #undef access /* The following is necessary because 'access' emulation by VMS C (2.0) does * not work correctly. (It also doesn't work well in version 2.3.) */ #ifdef VMS4_4 #define DESCRIPTOR(name,string) struct dsc$descriptor_s name = \ { strlen (string), DSC$K_DTYPE_T, DSC$K_CLASS_S, string } typedef union { struct { unsigned short s_buflen; unsigned short s_code; char *s_bufadr; unsigned short *s_retlenadr; } s; int end; } item; #define buflen s.s_buflen #define code s.s_code #define bufadr s.s_bufadr #define retlenadr s.s_retlenadr #define R_OK 4 /* test for read permission */ #define W_OK 2 /* test for write permission */ #define X_OK 1 /* test for execute (search) permission */ #define F_OK 0 /* test for presence of file */ int sys_access (path, mode) char *path; int mode; { static char *user = NULL; char dir_fn[512]; /* translate possible directory spec into .DIR file name, so brain-dead * access can treat the directory like a file. */ if (directory_file_name (path, dir_fn)) path = dir_fn; if (mode == F_OK) return access (path, mode); if (user == NULL && (user = (char *) getenv ("USER")) == NULL) return -1; { int stat; int flags; int acces; unsigned short int dummy; item itemlst[3]; static int constant = ACL$C_FILE; DESCRIPTOR (path_desc, path); DESCRIPTOR (user_desc, user); flags = 0; acces = 0; if ((mode & X_OK) && ((stat = access (path, mode)) < 0 || mode == X_OK)) return stat; if (mode & R_OK) acces |= CHP$M_READ; if (mode & W_OK) acces |= CHP$M_WRITE; itemlst[0].buflen = sizeof (int); itemlst[0].code = CHP$_FLAGS; itemlst[0].bufadr = (char *) &flags; itemlst[0].retlenadr = &dummy; itemlst[1].buflen = sizeof (int); itemlst[1].code = CHP$_ACCESS; itemlst[1].bufadr = (char *) &acces; itemlst[1].retlenadr = &dummy; itemlst[2].end = CHP$_END; stat = SYS$CHECK_ACCESS (&constant, &path_desc, &user_desc, itemlst); return stat == SS$_NORMAL ? 0 : -1; } } #else /* not VMS4_4 */ #include #define ACE$M_WRITE 2 #define ACE$C_KEYID 1 static unsigned short memid, grpid; static unsigned int uic; /* Called from init_sys_modes, so it happens not very often but at least each time Emacs is loaded. */ sys_access_reinit () { uic = 0; } int sys_access (filename, type) char * filename; int type; { struct FAB fab; struct XABPRO xab; int status, size, i, typecode, acl_controlled; unsigned int *aclptr, *aclend, aclbuf[60]; union prvdef prvmask; /* Get UIC and GRP values for protection checking. */ if (uic == 0) { status = LIB$GETJPI (&JPI$_UIC, 0, 0, &uic, 0, 0); if (! (status & 1)) return -1; memid = uic & 0xFFFF; grpid = uic >> 16; } if (type != 2) /* not checking write access */ return access (filename, type); /* Check write protection. */ #define CHECKPRIV(bit) (prvmask.bit) #define WRITEABLE(field) (! ((xab.xab$w_pro >> field) & XAB$M_NOWRITE)) /* Find privilege bits */ status = SYS$SETPRV (0, 0, 0, prvmask); if (! (status & 1)) error ("Unable to find privileges: %s", vmserrstr (status)); if (CHECKPRIV (PRV$V_BYPASS)) return 0; /* BYPASS enabled */ fab = cc$rms_fab; fab.fab$b_fac = FAB$M_GET; fab.fab$l_fna = filename; fab.fab$b_fns = strlen (filename); fab.fab$l_xab = &xab; xab = cc$rms_xabpro; xab.xab$l_aclbuf = aclbuf; xab.xab$w_aclsiz = sizeof (aclbuf); status = SYS$OPEN (&fab, 0, 0); if (! (status & 1)) return -1; SYS$CLOSE (&fab, 0, 0); /* Check system access */ if (CHECKPRIV (PRV$V_SYSPRV) && WRITEABLE (XAB$V_SYS)) return 0; /* Check ACL entries, if any */ acl_controlled = 0; if (xab.xab$w_acllen > 0) { aclptr = aclbuf; aclend = &aclbuf[xab.xab$w_acllen / 4]; while (*aclptr && aclptr < aclend) { size = (*aclptr & 0xff) / 4; typecode = (*aclptr >> 8) & 0xff; if (typecode == ACE$C_KEYID) for (i = size - 1; i > 1; i--) if (aclptr[i] == uic) { acl_controlled = 1; if (aclptr[1] & ACE$M_WRITE) return 0; /* Write access through ACL */ } aclptr = &aclptr[size]; } if (acl_controlled) /* ACL specified, prohibits write access */ return -1; } /* No ACL entries specified, check normal protection */ if (WRITEABLE (XAB$V_WLD)) /* World writeable */ return 0; if (WRITEABLE (XAB$V_GRP) && (unsigned short) (xab.xab$l_uic >> 16) == grpid) return 0; /* Group writeable */ if (WRITEABLE (XAB$V_OWN) && (xab.xab$l_uic & 0xFFFF) == memid) return 0; /* Owner writeable */ return -1; /* Not writeable */ } #endif /* not VMS4_4 */ #endif /* access */ static char vtbuf[NAM$C_MAXRSS+1]; /* translate a vms file spec to a unix path */ char * sys_translate_vms (vfile) char * vfile; { char * p; char * targ; if (!vfile) return 0; targ = vtbuf; /* leading device or logical name is a root directory */ if (p = strchr (vfile, ':')) { *targ++ = '/'; while (vfile < p) *targ++ = *vfile++; vfile++; *targ++ = '/'; } p = vfile; if (*p == '[' || *p == '<') { while (*++vfile != *p + 2) switch (*vfile) { case '.': if (vfile[-1] == *p) *targ++ = '.'; *targ++ = '/'; break; case '-': *targ++ = '.'; *targ++ = '.'; break; default: *targ++ = *vfile; break; } vfile++; *targ++ = '/'; } while (*vfile) *targ++ = *vfile++; return vtbuf; } static char utbuf[NAM$C_MAXRSS+1]; /* translate a unix path to a VMS file spec */ char * sys_translate_unix (ufile) char * ufile; { int slash_seen = 0; char *p; char * targ; if (!ufile) return 0; targ = utbuf; if (*ufile == '/') { ufile++; } while (*ufile) { switch (*ufile) { case '/': if (slash_seen) if (index (&ufile[1], '/')) *targ++ = '.'; else *targ++ = ']'; else { *targ++ = ':'; if (index (&ufile[1], '/')) *targ++ = '['; slash_seen = 1; } break; case '.': if (strncmp (ufile, "./", 2) == 0) { if (!slash_seen) { *targ++ = '['; slash_seen = 1; } ufile++; /* skip the dot */ if (index (&ufile[1], '/')) *targ++ = '.'; else *targ++ = ']'; } else if (strncmp (ufile, "../", 3) == 0) { if (!slash_seen) { *targ++ = '['; slash_seen = 1; } *targ++ = '-'; ufile += 2; /* skip the dots */ if (index (&ufile[1], '/')) *targ++ = '.'; else *targ++ = ']'; } else *targ++ = *ufile; break; default: *targ++ = *ufile; break; } ufile++; } *targ = '\0'; return utbuf; } char * getwd (pathname) char *pathname; { char *ptr, *val; extern char *getcwd (); #define MAXPATHLEN 1024 ptr = xmalloc (MAXPATHLEN); val = getcwd (ptr, MAXPATHLEN); if (val == 0) { xfree (ptr); return val; } strcpy (pathname, ptr); xfree (ptr); return pathname; } getppid () { long item_code = JPI$_OWNER; unsigned long parent_id; int status; if (((status = LIB$GETJPI (&item_code, 0, 0, &parent_id)) & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } return parent_id; } #undef getuid unsigned sys_getuid () { return (getgid () << 16) | getuid (); } int sys_read (fildes, buf, nbyte) int fildes; char *buf; unsigned int nbyte; { return read (fildes, buf, (nbyte < MAXIOSIZE ? nbyte : MAXIOSIZE)); } #if 0 int sys_write (fildes, buf, nbyte) int fildes; char *buf; unsigned int nbyte; { register int nwrote, rtnval = 0; while (nbyte > MAXIOSIZE && (nwrote = write (fildes, buf, MAXIOSIZE)) > 0) { nbyte -= nwrote; buf += nwrote; rtnval += nwrote; } if (nwrote < 0) return rtnval ? rtnval : -1; if ((nwrote = write (fildes, buf, nbyte)) < 0) return rtnval ? rtnval : -1; return (rtnval + nwrote); } #endif /* 0 */ /* * VAX/VMS VAX C RTL really loses. It insists that records * end with a newline (carriage return) character, and if they * don't it adds one (nice of it isn't it!) * * Thus we do this stupidity below. */ int sys_write (fildes, buf, nbytes) int fildes; char *buf; unsigned int nbytes; { register char *p; register char *e; int sum = 0; struct stat st; fstat (fildes, &st); p = buf; while (nbytes > 0) { int len, retval; /* Handle fixed-length files with carriage control. */ if (st.st_fab_rfm == FAB$C_FIX && ((st.st_fab_rat & (FAB$M_FTN | FAB$M_CR)) != 0)) { len = st.st_fab_mrs; retval = write (fildes, p, min (len, nbytes)); if (retval != len) return -1; retval++; /* This skips the implied carriage control */ } else { e = p + min (MAXIOSIZE, nbytes) - 1; while (*e != '\n' && e > p) e--; if (p == e) /* Ok.. so here we add a newline... sigh. */ e = p + min (MAXIOSIZE, nbytes) - 1; len = e + 1 - p; retval = write (fildes, p, len); if (retval != len) return -1; } p += retval; sum += retval; nbytes -= retval; } return sum; } /* Create file NEW copying its attributes from file OLD. If OLD is 0 or does not exist, create based on the value of vms_stmlf_recfm. */ /* Protection value the file should ultimately have. Set by create_copy_attrs, and use by rename_sansversions. */ static unsigned short int fab_final_pro; int creat_copy_attrs (old, new) char *old, *new; { struct FAB fab = cc$rms_fab; struct XABPRO xabpro; char aclbuf[256]; /* Choice of size is arbitrary. See below. */ extern int vms_stmlf_recfm; if (old) { fab.fab$b_fac = FAB$M_GET; fab.fab$l_fna = old; fab.fab$b_fns = strlen (old); fab.fab$l_xab = (char *) &xabpro; xabpro = cc$rms_xabpro; xabpro.xab$l_aclbuf = aclbuf; xabpro.xab$w_aclsiz = sizeof aclbuf; /* Call $OPEN to fill in the fab & xabpro fields. */ if (SYS$OPEN (&fab, 0, 0) & 1) { SYS$CLOSE (&fab, 0, 0); fab.fab$l_alq = 0; /* zero the allocation quantity */ if (xabpro.xab$w_acllen > 0) { if (xabpro.xab$w_acllen > sizeof aclbuf) /* If the acl buffer was too short, redo open with longer one. Wouldn't need to do this if there were some system imposed limit on the size of an ACL, but I can't find any such. */ { xabpro.xab$l_aclbuf = (char *) alloca (xabpro.xab$w_acllen); xabpro.xab$w_aclsiz = xabpro.xab$w_acllen; if (SYS$OPEN (&fab, 0, 0) & 1) SYS$CLOSE (&fab, 0, 0); else old = 0; } } else xabpro.xab$l_aclbuf = 0; } else old = 0; } fab.fab$l_fna = new; fab.fab$b_fns = strlen (new); if (!old) { fab.fab$l_xab = 0; fab.fab$b_rfm = vms_stmlf_recfm ? FAB$C_STMLF : FAB$C_VAR; fab.fab$b_rat = FAB$M_CR; } /* Set the file protections such that we will be able to manipulate this file. Once we are done writing and renaming it, we will set the protections back. */ if (old) fab_final_pro = xabpro.xab$w_pro; else SYS$SETDFPROT (0, &fab_final_pro); xabpro.xab$w_pro &= 0xff0f; /* set O:rewd for now. This is set back later. */ /* Create the new file with either default attrs or attrs copied from old file. */ if (!(SYS$CREATE (&fab, 0, 0) & 1)) return -1; SYS$CLOSE (&fab, 0, 0); /* As this is a "replacement" for creat, return a file descriptor opened for writing. */ return open (new, O_WRONLY); } #ifdef creat #undef creat #include #ifdef __GNUC__ #ifndef va_count #define va_count(X) ((X) = *(((int *) &(va_alist)) - 1)) #endif #endif sys_creat (va_alist) va_dcl { va_list list_incrementer; char *name; int mode; int rfd; /* related file descriptor */ int fd; /* Our new file descriptor */ int count; struct stat st_buf; char rfm[12]; char rat[15]; char mrs[13]; char fsz[13]; extern int vms_stmlf_recfm; va_count (count); va_start (list_incrementer); name = va_arg (list_incrementer, char *); mode = va_arg (list_incrementer, int); if (count > 2) rfd = va_arg (list_incrementer, int); va_end (list_incrementer); if (count > 2) { /* Use information from the related file descriptor to set record format of the newly created file. */ fstat (rfd, &st_buf); switch (st_buf.st_fab_rfm) { case FAB$C_FIX: strcpy (rfm, "rfm = fix"); sprintf (mrs, "mrs = %d", st_buf.st_fab_mrs); strcpy (rat, "rat = "); if (st_buf.st_fab_rat & FAB$M_CR) strcat (rat, "cr"); else if (st_buf.st_fab_rat & FAB$M_FTN) strcat (rat, "ftn"); else if (st_buf.st_fab_rat & FAB$M_PRN) strcat (rat, "prn"); if (st_buf.st_fab_rat & FAB$M_BLK) if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN)) strcat (rat, ", blk"); else strcat (rat, "blk"); return creat (name, 0, rfm, rat, mrs); case FAB$C_VFC: strcpy (rfm, "rfm = vfc"); sprintf (fsz, "fsz = %d", st_buf.st_fab_fsz); strcpy (rat, "rat = "); if (st_buf.st_fab_rat & FAB$M_CR) strcat (rat, "cr"); else if (st_buf.st_fab_rat & FAB$M_FTN) strcat (rat, "ftn"); else if (st_buf.st_fab_rat & FAB$M_PRN) strcat (rat, "prn"); if (st_buf.st_fab_rat & FAB$M_BLK) if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN)) strcat (rat, ", blk"); else strcat (rat, "blk"); return creat (name, 0, rfm, rat, fsz); case FAB$C_STM: strcpy (rfm, "rfm = stm"); break; case FAB$C_STMCR: strcpy (rfm, "rfm = stmcr"); break; case FAB$C_STMLF: strcpy (rfm, "rfm = stmlf"); break; case FAB$C_UDF: strcpy (rfm, "rfm = udf"); break; case FAB$C_VAR: strcpy (rfm, "rfm = var"); break; } strcpy (rat, "rat = "); if (st_buf.st_fab_rat & FAB$M_CR) strcat (rat, "cr"); else if (st_buf.st_fab_rat & FAB$M_FTN) strcat (rat, "ftn"); else if (st_buf.st_fab_rat & FAB$M_PRN) strcat (rat, "prn"); if (st_buf.st_fab_rat & FAB$M_BLK) if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN)) strcat (rat, ", blk"); else strcat (rat, "blk"); } else { strcpy (rfm, vms_stmlf_recfm ? "rfm = stmlf" : "rfm=var"); strcpy (rat, "rat=cr"); } /* Until the VAX C RTL fixes the many bugs with modes, always use mode 0 to get the user's default protection. */ fd = creat (name, 0, rfm, rat); if (fd < 0 && errno == EEXIST) { if (unlink (name) < 0) report_file_error ("delete", build_string (name)); fd = creat (name, 0, rfm, rat); } return fd; } #endif /* creat */ /* fwrite to stdout is S L O W. Speed it up by using fputc...*/ sys_fwrite (ptr, size, num, fp) register char * ptr; FILE * fp; { register int tot = num * size; while (tot--) fputc (*ptr++, fp); } /* * The VMS C library routine creat actually creates a new version of an * existing file rather than truncating the old version. There are times * when this is not the desired behavior, for instance, when writing an * auto save file (you only want one version), or when you don't have * write permission in the directory containing the file (but the file * itself is writable). Hence this routine, which is equivalent to * "close (creat (fn, 0));" on Unix if fn already exists. */ int vms_truncate (fn) char *fn; { struct FAB xfab = cc$rms_fab; struct RAB xrab = cc$rms_rab; int status; xfab.fab$l_fop = FAB$M_TEF; /* free allocated but unused blocks on close */ xfab.fab$b_fac = FAB$M_TRN | FAB$M_GET; /* allow truncate and get access */ xfab.fab$b_shr = FAB$M_NIL; /* allow no sharing - file must be locked */ xfab.fab$l_fna = fn; xfab.fab$b_fns = strlen (fn); xfab.fab$l_dna = ";0"; /* default to latest version of the file */ xfab.fab$b_dns = 2; xrab.rab$l_fab = &xfab; /* This gibberish opens the file, positions to the first record, and deletes all records from there until the end of file. */ if ((SYS$OPEN (&xfab) & 01) == 01) { if ((SYS$CONNECT (&xrab) & 01) == 01 && (SYS$FIND (&xrab) & 01) == 01 && (SYS$TRUNCATE (&xrab) & 01) == 01) status = 0; else status = -1; } else status = -1; SYS$CLOSE (&xfab); return status; } /* Define this symbol to actually read SYSUAF.DAT. This requires either SYSPRV or a readable SYSUAF.DAT. */ #ifdef READ_SYSUAF /* * getuaf.c * * Routine to read the VMS User Authorization File and return * a specific user's record. */ static struct UAF retuaf; struct UAF * get_uaf_name (uname) char * uname; { register status; struct FAB uaf_fab; struct RAB uaf_rab; uaf_fab = cc$rms_fab; uaf_rab = cc$rms_rab; /* initialize fab fields */ uaf_fab.fab$l_fna = "SYS$SYSTEM:SYSUAF.DAT"; uaf_fab.fab$b_fns = 21; uaf_fab.fab$b_fac = FAB$M_GET; uaf_fab.fab$b_org = FAB$C_IDX; uaf_fab.fab$b_shr = FAB$M_GET|FAB$M_PUT|FAB$M_UPD|FAB$M_DEL; /* initialize rab fields */ uaf_rab.rab$l_fab = &uaf_fab; /* open the User Authorization File */ status = SYS$OPEN (&uaf_fab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } status = SYS$CONNECT (&uaf_rab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } /* read the requested record - index is in uname */ uaf_rab.rab$l_kbf = uname; uaf_rab.rab$b_ksz = strlen (uname); uaf_rab.rab$b_rac = RAB$C_KEY; uaf_rab.rab$l_ubf = (char *)&retuaf; uaf_rab.rab$w_usz = sizeof retuaf; status = SYS$GET (&uaf_rab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } /* close the User Authorization File */ status = SYS$DISCONNECT (&uaf_rab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } status = SYS$CLOSE (&uaf_fab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } return &retuaf; } struct UAF * get_uaf_uic (uic) unsigned long uic; { register status; struct FAB uaf_fab; struct RAB uaf_rab; uaf_fab = cc$rms_fab; uaf_rab = cc$rms_rab; /* initialize fab fields */ uaf_fab.fab$l_fna = "SYS$SYSTEM:SYSUAF.DAT"; uaf_fab.fab$b_fns = 21; uaf_fab.fab$b_fac = FAB$M_GET; uaf_fab.fab$b_org = FAB$C_IDX; uaf_fab.fab$b_shr = FAB$M_GET|FAB$M_PUT|FAB$M_UPD|FAB$M_DEL; /* initialize rab fields */ uaf_rab.rab$l_fab = &uaf_fab; /* open the User Authorization File */ status = SYS$OPEN (&uaf_fab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } status = SYS$CONNECT (&uaf_rab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } /* read the requested record - index is in uic */ uaf_rab.rab$b_krf = 1; /* 1st alternate key */ uaf_rab.rab$l_kbf = (char *) &uic; uaf_rab.rab$b_ksz = sizeof uic; uaf_rab.rab$b_rac = RAB$C_KEY; uaf_rab.rab$l_ubf = (char *)&retuaf; uaf_rab.rab$w_usz = sizeof retuaf; status = SYS$GET (&uaf_rab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } /* close the User Authorization File */ status = SYS$DISCONNECT (&uaf_rab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } status = SYS$CLOSE (&uaf_fab); if (!(status&1)) { errno = EVMSERR; vaxc$errno = status; return 0; } return &retuaf; } static struct passwd retpw; struct passwd * cnv_uaf_pw (up) struct UAF * up; { char * ptr; /* copy these out first because if the username is 32 chars, the next section will overwrite the first byte of the UIC */ retpw.pw_uid = up->uaf$w_mem; retpw.pw_gid = up->uaf$w_grp; /* I suppose this is not the best sytle, to possibly overwrite one byte beyond the end of the field, but what the heck... */ ptr = &up->uaf$t_username[UAF$S_USERNAME]; while (ptr[-1] == ' ') ptr--; *ptr = '\0'; strcpy (retpw.pw_name, up->uaf$t_username); /* the rest of these are counted ascii strings */ strncpy (retpw.pw_gecos, &up->uaf$t_owner[1], up->uaf$t_owner[0]); retpw.pw_gecos[up->uaf$t_owner[0]] = '\0'; strncpy (retpw.pw_dir, &up->uaf$t_defdev[1], up->uaf$t_defdev[0]); retpw.pw_dir[up->uaf$t_defdev[0]] = '\0'; strncat (retpw.pw_dir, &up->uaf$t_defdir[1], up->uaf$t_defdir[0]); retpw.pw_dir[up->uaf$t_defdev[0] + up->uaf$t_defdir[0]] = '\0'; strncpy (retpw.pw_shell, &up->uaf$t_defcli[1], up->uaf$t_defcli[0]); retpw.pw_shell[up->uaf$t_defcli[0]] = '\0'; return &retpw; } #else /* not READ_SYSUAF */ static struct passwd retpw; #endif /* not READ_SYSUAF */ struct passwd * getpwnam (name) char * name; { #ifdef READ_SYSUAF struct UAF *up; #else char * user; char * dir; unsigned char * full; #endif /* READ_SYSUAF */ char *ptr = name; while (*ptr) { if ('a' <= *ptr && *ptr <= 'z') *ptr -= 040; ptr++; } #ifdef READ_SYSUAF if (!(up = get_uaf_name (name))) return 0; return cnv_uaf_pw (up); #else if (strcmp (name, getenv ("USER")) == 0) { retpw.pw_uid = getuid (); retpw.pw_gid = getgid (); strcpy (retpw.pw_name, name); if (full = egetenv ("FULLNAME")) strcpy (retpw.pw_gecos, full); else *retpw.pw_gecos = '\0'; strcpy (retpw.pw_dir, egetenv ("HOME")); *retpw.pw_shell = '\0'; return &retpw; } else return 0; #endif /* not READ_SYSUAF */ } struct passwd * getpwuid (uid) unsigned long uid; { #ifdef READ_SYSUAF struct UAF * up; if (!(up = get_uaf_uic (uid))) return 0; return cnv_uaf_pw (up); #else if (uid == sys_getuid ()) return getpwnam (egetenv ("USER")); else return 0; #endif /* not READ_SYSUAF */ } /* return total address space available to the current process. This is the sum of the current p0 size, p1 size and free page table entries available. */ vlimit () { int item_code; unsigned long free_pages; unsigned long frep0va; unsigned long frep1va; register status; item_code = JPI$_FREPTECNT; if (((status = LIB$GETJPI (&item_code, 0, 0, &free_pages)) & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } free_pages *= 512; item_code = JPI$_FREP0VA; if (((status = LIB$GETJPI (&item_code, 0, 0, &frep0va)) & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } item_code = JPI$_FREP1VA; if (((status = LIB$GETJPI (&item_code, 0, 0, &frep1va)) & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } return free_pages + frep0va + (0x7fffffff - frep1va); } define_logical_name (varname, string) char *varname; char *string; { struct dsc$descriptor_s strdsc = {strlen (string), DSC$K_DTYPE_T, DSC$K_CLASS_S, string}; struct dsc$descriptor_s envdsc = {strlen (varname), DSC$K_DTYPE_T, DSC$K_CLASS_S, varname}; struct dsc$descriptor_s lnmdsc = {7, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$JOB"}; return LIB$SET_LOGICAL (&envdsc, &strdsc, &lnmdsc, 0, 0); } delete_logical_name (varname) char *varname; { struct dsc$descriptor_s envdsc = {strlen (varname), DSC$K_DTYPE_T, DSC$K_CLASS_S, varname}; struct dsc$descriptor_s lnmdsc = {7, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$JOB"}; return LIB$DELETE_LOGICAL (&envdsc, &lnmdsc); } ulimit () {} setpgrp () {} execvp () { error ("execvp system call not implemented"); } int rename (from, to) char *from, *to; { int status; struct FAB from_fab = cc$rms_fab, to_fab = cc$rms_fab; struct NAM from_nam = cc$rms_nam, to_nam = cc$rms_nam; char from_esn[NAM$C_MAXRSS]; char to_esn[NAM$C_MAXRSS]; from_fab.fab$l_fna = from; from_fab.fab$b_fns = strlen (from); from_fab.fab$l_nam = &from_nam; from_fab.fab$l_fop = FAB$M_NAM; from_nam.nam$l_esa = from_esn; from_nam.nam$b_ess = sizeof from_esn; to_fab.fab$l_fna = to; to_fab.fab$b_fns = strlen (to); to_fab.fab$l_nam = &to_nam; to_fab.fab$l_fop = FAB$M_NAM; to_nam.nam$l_esa = to_esn; to_nam.nam$b_ess = sizeof to_esn; status = SYS$RENAME (&from_fab, 0, 0, &to_fab); if (status & 1) return 0; else { if (status == RMS$_DEV) errno = EXDEV; else errno = EVMSERR; vaxc$errno = status; return -1; } } /* This function renames a file like `rename', but it strips the version number from the "to" filename, such that the "to" file is will always be a new version. It also sets the file protection once it is finished. The protection that we will use is stored in fab_final_pro, and was set when we did a creat_copy_attrs to create the file that we are renaming. We could use the chmod function, but Eunichs uses 3 bits per user category to describe the protection, and VMS uses 4 (write and delete are separate bits). To maintain portability, the VMS implementation of `chmod' wires the W and D bits together. */ static struct fibdef fib; /* We need this initialized to zero */ char vms_file_written[NAM$C_MAXRSS]; int rename_sans_version (from,to) char *from, *to; { short int chan; int stat; short int iosb[4]; int status; struct FAB to_fab = cc$rms_fab; struct NAM to_nam = cc$rms_nam; struct dsc$descriptor fib_d ={sizeof (fib),0,0,(char*) &fib}; struct dsc$descriptor fib_attr[2] = {{sizeof (fab_final_pro),ATR$C_FPRO,0,(char*) &fab_final_pro},{0,0,0,0}}; char to_esn[NAM$C_MAXRSS]; $DESCRIPTOR (disk,to_esn); to_fab.fab$l_fna = to; to_fab.fab$b_fns = strlen (to); to_fab.fab$l_nam = &to_nam; to_fab.fab$l_fop = FAB$M_NAM; to_nam.nam$l_esa = to_esn; to_nam.nam$b_ess = sizeof to_esn; status = SYS$PARSE (&to_fab, 0, 0); /* figure out the full file name */ if (to_nam.nam$l_fnb && NAM$M_EXP_VER) *(to_nam.nam$l_ver) = '\0'; stat = rename (from, to_esn); if (stat < 0) return stat; strcpy (vms_file_written, to_esn); to_fab.fab$l_fna = vms_file_written; /* this points to the versionless name */ to_fab.fab$b_fns = strlen (vms_file_written); /* Now set the file protection to the correct value */ SYS$OPEN (&to_fab, 0, 0); /* This fills in the nam$w_fid fields */ /* Copy these fields into the fib */ fib.fib$r_fid_overlay.fib$w_fid[0] = to_nam.nam$w_fid[0]; fib.fib$r_fid_overlay.fib$w_fid[1] = to_nam.nam$w_fid[1]; fib.fib$r_fid_overlay.fib$w_fid[2] = to_nam.nam$w_fid[2]; SYS$CLOSE (&to_fab, 0, 0); stat = SYS$ASSIGN (&disk, &chan, 0, 0); /* open a channel to the disk */ if (!stat) LIB$SIGNAL (stat); stat = SYS$QIOW (0, chan, IO$_MODIFY, iosb, 0, 0, &fib_d, 0, 0, 0, &fib_attr, 0); if (!stat) LIB$SIGNAL (stat); stat = SYS$DASSGN (chan); if (!stat) LIB$SIGNAL (stat); strcpy (vms_file_written, to_esn); /* We will write this to the terminal*/ return 0; } link (file, new) char * file, * new; { register status; struct FAB fab; struct NAM nam; unsigned short fid[3]; char esa[NAM$C_MAXRSS]; fab = cc$rms_fab; fab.fab$l_fop = FAB$M_OFP; fab.fab$l_fna = file; fab.fab$b_fns = strlen (file); fab.fab$l_nam = &nam; nam = cc$rms_nam; nam.nam$l_esa = esa; nam.nam$b_ess = NAM$C_MAXRSS; status = SYS$PARSE (&fab); if ((status & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } status = SYS$SEARCH (&fab); if ((status & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } fid[0] = nam.nam$w_fid[0]; fid[1] = nam.nam$w_fid[1]; fid[2] = nam.nam$w_fid[2]; fab.fab$l_fna = new; fab.fab$b_fns = strlen (new); status = SYS$PARSE (&fab); if ((status & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } nam.nam$w_fid[0] = fid[0]; nam.nam$w_fid[1] = fid[1]; nam.nam$w_fid[2] = fid[2]; nam.nam$l_esa = nam.nam$l_name; nam.nam$b_esl = nam.nam$b_name + nam.nam$b_type + nam.nam$b_ver; status = SYS$ENTER (&fab); if ((status & 1) == 0) { errno = EVMSERR; vaxc$errno = status; return -1; } return 0; } croak (badfunc) char *badfunc; { printf ("%s not yet implemented\r\n", badfunc); reset_sys_modes (); exit (1); } long random () { /* Arrange to return a range centered on zero. */ return rand () - (1 << 30); } srandom (seed) { srand (seed); } #endif /* VMS */ #ifdef AIXHFT /* Called from init_sys_modes. */ hft_init () { int junk; /* If we're not on an HFT we shouldn't do any of this. We determine if we are on an HFT by trying to get an HFT error code. If this call fails, we're not on an HFT. */ #ifdef IBMR2AIX if (ioctl (0, HFQERROR, &junk) < 0) return; #else /* not IBMR2AIX */ if (ioctl (0, HFQEIO, 0) < 0) return; #endif /* not IBMR2AIX */ /* On AIX the default hft keyboard mapping uses backspace rather than delete as the rubout key's ASCII code. Here this is changed. The bug is that there's no way to determine the old mapping, so in reset_sys_modes we need to assume that the normal map had been present. Of course, this code also doesn't help if on a terminal emulator which doesn't understand HFT VTD's. */ { struct hfbuf buf; struct hfkeymap keymap; buf.hf_bufp = (char *)&keymap; buf.hf_buflen = sizeof (keymap); keymap.hf_nkeys = 2; keymap.hfkey[0].hf_kpos = 15; keymap.hfkey[0].hf_kstate = HFMAPCHAR | HFSHFNONE; #ifdef IBMR2AIX keymap.hfkey[0].hf_keyidh = '<'; #else /* not IBMR2AIX */ keymap.hfkey[0].hf_page = '<'; #endif /* not IBMR2AIX */ keymap.hfkey[0].hf_char = 127; keymap.hfkey[1].hf_kpos = 15; keymap.hfkey[1].hf_kstate = HFMAPCHAR | HFSHFSHFT; #ifdef IBMR2AIX keymap.hfkey[1].hf_keyidh = '<'; #else /* not IBMR2AIX */ keymap.hfkey[1].hf_page = '<'; #endif /* not IBMR2AIX */ keymap.hfkey[1].hf_char = 127; hftctl (0, HFSKBD, &buf); } /* The HFT system on AIX doesn't optimize for scrolling, so it's really ugly at times. */ line_ins_del_ok = char_ins_del_ok = 0; } /* Reset the rubout key to backspace. */ hft_reset () { struct hfbuf buf; struct hfkeymap keymap; int junk; #ifdef IBMR2AIX if (ioctl (0, HFQERROR, &junk) < 0) return; #else /* not IBMR2AIX */ if (ioctl (0, HFQEIO, 0) < 0) return; #endif /* not IBMR2AIX */ buf.hf_bufp = (char *)&keymap; buf.hf_buflen = sizeof (keymap); keymap.hf_nkeys = 2; keymap.hfkey[0].hf_kpos = 15; keymap.hfkey[0].hf_kstate = HFMAPCHAR | HFSHFNONE; #ifdef IBMR2AIX keymap.hfkey[0].hf_keyidh = '<'; #else /* not IBMR2AIX */ keymap.hfkey[0].hf_page = '<'; #endif /* not IBMR2AIX */ keymap.hfkey[0].hf_char = 8; keymap.hfkey[1].hf_kpos = 15; keymap.hfkey[1].hf_kstate = HFMAPCHAR | HFSHFSHFT; #ifdef IBMR2AIX keymap.hfkey[1].hf_keyidh = '<'; #else /* not IBMR2AIX */ keymap.hfkey[1].hf_page = '<'; #endif /* not IBMR2AIX */ keymap.hfkey[1].hf_char = 8; hftctl (0, HFSKBD, &buf); } #endif /* AIXHFT */ #ifdef USE_DL_STUBS /* These are included on Sunos 4.1 when we do not use shared libraries. X11 libraries may refer to these functions but (we hope) do not actually call them. */ void * dlopen () { return 0; } void * dlsym () { return 0; } int dlclose () { return -1; } #endif /* USE_DL_STUBS */ #ifndef BSTRING #ifndef bzero void bzero (b, length) register char *b; register int length; { #ifdef VMS short zero = 0; long max_str = 65535; while (length > max_str) { (void) LIB$MOVC5 (&zero, &zero, &zero, &max_str, b); length -= max_str; b += max_str; } max_str = length; (void) LIB$MOVC5 (&zero, &zero, &zero, &max_str, b); #else while (length-- > 0) *b++ = 0; #endif /* not VMS */ } #endif /* no bzero */ #endif /* BSTRING */ #if (!defined (BSTRING) && !defined (bcopy)) || defined (NEED_BCOPY) #undef bcopy /* Saying `void' requires a declaration, above, where bcopy is used and that declaration causes pain for systems where bcopy is a macro. */ bcopy (b1, b2, length) register char *b1; register char *b2; register int length; { #ifdef VMS long max_str = 65535; while (length > max_str) { (void) LIB$MOVC3 (&max_str, b1, b2); length -= max_str; b1 += max_str; b2 += max_str; } max_str = length; (void) LIB$MOVC3 (&length, b1, b2); #else while (length-- > 0) *b2++ = *b1++; #endif /* not VMS */ } #endif /* (defined (BSTRING) && !defined (bcopy)) || defined (NEED_BCOPY) */ #ifndef BSTRING #ifndef bcmp int bcmp (b1, b2, length) /* This could be a macro! */ register char *b1; register char *b2; register int length; { #ifdef VMS struct dsc$descriptor_s src1 = {length, DSC$K_DTYPE_T, DSC$K_CLASS_S, b1}; struct dsc$descriptor_s src2 = {length, DSC$K_DTYPE_T, DSC$K_CLASS_S, b2}; return STR$COMPARE (&src1, &src2); #else while (length-- > 0) if (*b1++ != *b2++) return 1; return 0; #endif /* not VMS */ } #endif /* no bcmp */ #endif /* not BSTRING */ emacs-19.30/src/term.c100444 23073 1 145254 6047603145 13741 0ustar voelkerdaemon/* terminal control module for terminals described by TERMCAP Copyright (C) 1985, 86, 87, 93, 94, 95 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. */ #include #include #include #include "termchar.h" #include "termopts.h" #include "cm.h" #undef NULL #include "lisp.h" #include "frame.h" #include "disptab.h" #include "termhooks.h" #include "keyboard.h" extern Lisp_Object Fmake_sparse_keymap (); #define max(a, b) ((a) > (b) ? (a) : (b)) #define min(a, b) ((a) < (b) ? (a) : (b)) #define OUTPUT(a) tputs (a, FRAME_HEIGHT (selected_frame) - curY, cmputc) #define OUTPUT1(a) tputs (a, 1, cmputc) #define OUTPUTL(a, lines) tputs (a, lines, cmputc) #define OUTPUT_IF(a) { if (a) tputs (a, FRAME_HEIGHT (selected_frame) - curY, cmputc); } #define OUTPUT1_IF(a) { if (a) tputs (a, 1, cmputc); } /* Terminal characteristics that higher levels want to look at. These are all extern'd in termchar.h */ int must_write_spaces; /* Nonzero means spaces in the text must actually be output; can't just skip over some columns to leave them blank. */ int min_padding_speed; /* Speed below which no padding necessary */ int line_ins_del_ok; /* Terminal can insert and delete lines */ int char_ins_del_ok; /* Terminal can insert and delete chars */ int scroll_region_ok; /* Terminal supports setting the scroll window */ int scroll_region_cost; /* Cost of setting a scroll window, measured in characters */ int memory_below_frame; /* Terminal remembers lines scrolled off bottom */ int fast_clear_end_of_line; /* Terminal has a `ce' string */ /* Nonzero means no need to redraw the entire frame on resuming a suspended Emacs. This is useful on terminals with multiple pages, where one page is used for Emacs and another for all else. */ int no_redraw_on_reenter; /* Hook functions that you can set to snap out the functions in this file. These are all extern'd in termhooks.h */ int (*cursor_to_hook) (); int (*raw_cursor_to_hook) (); int (*clear_to_end_hook) (); int (*clear_frame_hook) (); int (*clear_end_of_line_hook) (); int (*ins_del_lines_hook) (); int (*change_line_highlight_hook) (); int (*reassert_line_highlight_hook) (); int (*insert_glyphs_hook) (); int (*write_glyphs_hook) (); int (*delete_glyphs_hook) (); int (*ring_bell_hook) (); int (*reset_terminal_modes_hook) (); int (*set_terminal_modes_hook) (); int (*update_begin_hook) (); int (*update_end_hook) (); int (*set_terminal_window_hook) (); int (*read_socket_hook) (); int (*frame_up_to_date_hook) (); /* Return the current position of the mouse. Set *f to the frame the mouse is in, or zero if the mouse is in no Emacs frame. If it is set to zero, all the other arguments are garbage. If the motion started in a scroll bar, set *bar_window to the scroll bar's window, *part to the part the mouse is currently over, *x to the position of the mouse along the scroll bar, and *y to the overall length of the scroll bar. Otherwise, set *bar_window to Qnil, and *x and *y to the column and row of the character cell the mouse is over. Set *time to the time the mouse was at the returned position. This should clear mouse_moved until the next motion event arrives. */ void (*mouse_position_hook) ( /* FRAME_PTR *f, int insist, Lisp_Object *bar_window, enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y, unsigned long *time */ ); /* When reading from a minibuffer in a different frame, Emacs wants to shift the highlight from the selected frame to the minibuffer's frame; under X, this means it lies about where the focus is. This hook tells the window system code to re-decide where to put the highlight. */ void (*frame_rehighlight_hook) ( /* FRAME_PTR f */ ); /* If we're displaying frames using a window system that can stack frames on top of each other, this hook allows you to bring a frame to the front, or bury it behind all the other windows. If this hook is zero, that means the device we're displaying on doesn't support overlapping frames, so there's no need to raise or lower anything. If RAISE is non-zero, F is brought to the front, before all other windows. If RAISE is zero, F is sent to the back, behind all other windows. */ void (*frame_raise_lower_hook) ( /* FRAME_PTR f, int raise */ ); /* Set the vertical scroll bar for WINDOW to have its upper left corner at (TOP, LEFT), and be LENGTH rows high. Set its handle to indicate that we are displaying PORTION characters out of a total of WHOLE characters, starting at POSITION. If WINDOW doesn't yet have a scroll bar, create one for it. */ void (*set_vertical_scroll_bar_hook) ( /* struct window *window, int portion, int whole, int position */ ); /* The following three hooks are used when we're doing a thorough redisplay of the frame. We don't explicitly know which scroll bars are going to be deleted, because keeping track of when windows go away is a real pain - can you say set-window-configuration? Instead, we just assert at the beginning of redisplay that *all* scroll bars are to be removed, and then save scroll bars from the firey pit when we actually redisplay their window. */ /* Arrange for all scroll bars on FRAME to be removed at the next call to `*judge_scroll_bars_hook'. A scroll bar may be spared if `*redeem_scroll_bar_hook' is applied to its window before the judgement. This should be applied to each frame each time its window tree is redisplayed, even if it is not displaying scroll bars at the moment; if the HAS_SCROLL_BARS flag has just been turned off, only calling this and the judge_scroll_bars_hook will get rid of them. If non-zero, this hook should be safe to apply to any frame, whether or not it can support scroll bars, and whether or not it is currently displaying them. */ void (*condemn_scroll_bars_hook)( /* FRAME_PTR *frame */ ); /* Unmark WINDOW's scroll bar for deletion in this judgement cycle. Note that it's okay to redeem a scroll bar that is not condemned. */ void (*redeem_scroll_bar_hook)( /* struct window *window */ ); /* Remove all scroll bars on FRAME that haven't been saved since the last call to `*condemn_scroll_bars_hook'. This should be applied to each frame after each time its window tree is redisplayed, even if it is not displaying scroll bars at the moment; if the HAS_SCROLL_BARS flag has just been turned off, only calling this and condemn_scroll_bars_hook will get rid of them. If non-zero, this hook should be safe to apply to any frame, whether or not it can support scroll bars, and whether or not it is currently displaying them. */ void (*judge_scroll_bars_hook)( /* FRAME_PTR *FRAME */ ); /* Strings, numbers and flags taken from the termcap entry. */ char *TS_ins_line; /* termcap "al" */ char *TS_ins_multi_lines; /* "AL" (one parameter, # lines to insert) */ char *TS_bell; /* "bl" */ char *TS_clr_to_bottom; /* "cd" */ char *TS_clr_line; /* "ce", clear to end of line */ char *TS_clr_frame; /* "cl" */ char *TS_set_scroll_region; /* "cs" (2 params, first line and last line) */ char *TS_set_scroll_region_1; /* "cS" (4 params: total lines, lines above scroll region, lines below it, total lines again) */ char *TS_del_char; /* "dc" */ char *TS_del_multi_chars; /* "DC" (one parameter, # chars to delete) */ char *TS_del_line; /* "dl" */ char *TS_del_multi_lines; /* "DL" (one parameter, # lines to delete) */ char *TS_delete_mode; /* "dm", enter character-delete mode */ char *TS_end_delete_mode; /* "ed", leave character-delete mode */ char *TS_end_insert_mode; /* "ei", leave character-insert mode */ char *TS_ins_char; /* "ic" */ char *TS_ins_multi_chars; /* "IC" (one parameter, # chars to insert) */ char *TS_insert_mode; /* "im", enter character-insert mode */ char *TS_pad_inserted_char; /* "ip". Just padding, no commands. */ char *TS_end_keypad_mode; /* "ke" */ char *TS_keypad_mode; /* "ks" */ char *TS_pad_char; /* "pc", char to use as padding */ char *TS_repeat; /* "rp" (2 params, # times to repeat and character to be repeated) */ char *TS_end_standout_mode; /* "se" */ char *TS_fwd_scroll; /* "sf" */ char *TS_standout_mode; /* "so" */ char *TS_rev_scroll; /* "sr" */ char *TS_end_termcap_modes; /* "te" */ char *TS_termcap_modes; /* "ti" */ char *TS_visible_bell; /* "vb" */ char *TS_end_visual_mode; /* "ve" */ char *TS_visual_mode; /* "vi" */ char *TS_set_window; /* "wi" (4 params, start and end of window, each as vpos and hpos) */ int TF_hazeltine; /* termcap hz flag. */ int TF_insmode_motion; /* termcap mi flag: can move while in insert mode. */ int TF_standout_motion; /* termcap mi flag: can move while in standout mode. */ int TF_underscore; /* termcap ul flag: _ underlines if overstruck on nonblank position. Must clear before writing _. */ int TF_teleray; /* termcap xt flag: many weird consequences. For t1061. */ int TF_xs; /* Nonzero for "xs". If set together with TN_standout_width == 0, it means don't bother to write any end-standout cookies. */ int TN_standout_width; /* termcap sg number: width occupied by standout markers */ static int RPov; /* # chars to start a TS_repeat */ static int delete_in_insert_mode; /* delete mode == insert mode */ static int se_is_so; /* 1 if same string both enters and leaves standout mode */ /* internal state */ /* The largest frame width in any call to calculate_costs. */ int max_frame_width; /* The largest frame height in any call to calculate_costs. */ int max_frame_height; /* Number of chars of space used for standout marker at beginning of line, or'd with 0100. Zero if no standout marker at all. The length of these vectors is max_frame_height. Used IFF TN_standout_width >= 0. */ static char *chars_wasted; static char *copybuf; /* nonzero means supposed to write text in standout mode. */ int standout_requested; int insert_mode; /* Nonzero when in insert mode. */ int standout_mode; /* Nonzero when in standout mode. */ /* Size of window specified by higher levels. This is the number of lines, from the top of frame downwards, which can participate in insert-line/delete-line operations. Effectively it excludes the bottom frame_height - specified_window_size lines from those operations. */ int specified_window; /* Frame currently being redisplayed; 0 if not currently redisplaying. (Direct output does not count). */ FRAME_PTR updating_frame; /* Provided for lisp packages. */ static int system_uses_terminfo; char *tparam (); extern char *tgetstr (); #ifdef WINDOWSNT #ifndef HAVE_NTGUI /* We aren't X windows, but we aren't termcap either. This makes me uncertain as to what value to use for frame.output_method. For this file, we'll define FRAME_TERMCAP_P to be zero so that our output hooks get called instead of the termcap functions. Probably the best long-term solution is to define an output_windows_nt... */ #undef FRAME_TERMCAP_P #define FRAME_TERMCAP_P(_f_) 0 #endif /* not HAVE_NTGUI */ #endif /* WINDOWSNT */ ring_bell () { if (! FRAME_TERMCAP_P (selected_frame)) { (*ring_bell_hook) (); return; } OUTPUT (TS_visible_bell && visible_bell ? TS_visible_bell : TS_bell); } set_terminal_modes () { if (! FRAME_TERMCAP_P (selected_frame)) { (*set_terminal_modes_hook) (); return; } OUTPUT_IF (TS_termcap_modes); OUTPUT_IF (TS_visual_mode); OUTPUT_IF (TS_keypad_mode); losecursor (); } reset_terminal_modes () { if (! FRAME_TERMCAP_P (selected_frame)) { (*reset_terminal_modes_hook) (); return; } if (TN_standout_width < 0) turn_off_highlight (); turn_off_insert (); OUTPUT_IF (TS_end_keypad_mode); OUTPUT_IF (TS_end_visual_mode); OUTPUT_IF (TS_end_termcap_modes); /* Output raw CR so kernel can track the cursor hpos. */ /* But on magic-cookie terminals this can erase an end-standout marker and cause the rest of the frame to be in standout, so move down first. */ if (TN_standout_width >= 0) cmputc ('\n'); cmputc ('\r'); } update_begin (f) FRAME_PTR f; { updating_frame = f; if (! FRAME_TERMCAP_P (updating_frame)) (*update_begin_hook) (f); } update_end (f) FRAME_PTR f; { if (! FRAME_TERMCAP_P (updating_frame)) { (*update_end_hook) (f); updating_frame = 0; return; } turn_off_insert (); background_highlight (); standout_requested = 0; updating_frame = 0; } set_terminal_window (size) int size; { if (! FRAME_TERMCAP_P (updating_frame)) { (*set_terminal_window_hook) (size); return; } specified_window = size ? size : FRAME_HEIGHT (selected_frame); if (!scroll_region_ok) return; set_scroll_region (0, specified_window); } set_scroll_region (start, stop) int start, stop; { char *buf; if (TS_set_scroll_region) { buf = tparam (TS_set_scroll_region, 0, 0, start, stop - 1); } else if (TS_set_scroll_region_1) { buf = tparam (TS_set_scroll_region_1, 0, 0, FRAME_HEIGHT (selected_frame), start, FRAME_HEIGHT (selected_frame) - stop, FRAME_HEIGHT (selected_frame)); } else { buf = tparam (TS_set_window, 0, 0, start, 0, stop, FRAME_WIDTH (selected_frame)); } OUTPUT (buf); xfree (buf); losecursor (); } turn_on_insert () { if (!insert_mode) OUTPUT (TS_insert_mode); insert_mode = 1; } turn_off_insert () { if (insert_mode) OUTPUT (TS_end_insert_mode); insert_mode = 0; } /* Handle highlighting when TN_standout_width (termcap sg) is not specified. In these terminals, output is affected by the value of standout mode when the output is written. These functions are called on all terminals, but do nothing on terminals whose standout mode does not work that way. */ turn_off_highlight () { if (TN_standout_width < 0) { if (standout_mode) OUTPUT_IF (TS_end_standout_mode); standout_mode = 0; } } turn_on_highlight () { if (TN_standout_width < 0) { if (!standout_mode) OUTPUT_IF (TS_standout_mode); standout_mode = 1; } } /* Set standout mode to the state it should be in for empty space inside windows. What this is, depends on the user option inverse-video. */ background_highlight () { if (TN_standout_width >= 0) return; if (inverse_video) turn_on_highlight (); else turn_off_highlight (); } /* Set standout mode to the mode specified for the text to be output. */ static highlight_if_desired () { if (TN_standout_width >= 0) return; if (!inverse_video == !standout_requested) turn_off_highlight (); else turn_on_highlight (); } /* Handle standout mode for terminals in which TN_standout_width >= 0. On these terminals, standout is controlled by markers that live inside the terminal's memory. TN_standout_width is the width that the marker occupies in memory. Standout runs from the marker to the end of the line on some terminals, or to the next turn-off-standout marker (TS_end_standout_mode) string on other terminals. */ /* Write a standout marker or end-standout marker at the front of the line at vertical position vpos. */ write_standout_marker (flag, vpos) int flag, vpos; { if (flag || (TS_end_standout_mode && !TF_teleray && !se_is_so && !(TF_xs && TN_standout_width == 0))) { cmgoto (vpos, 0); cmplus (TN_standout_width); OUTPUT (flag ? TS_standout_mode : TS_end_standout_mode); chars_wasted[curY] = TN_standout_width | 0100; } } /* External interface to control of standout mode. Call this when about to modify line at position VPOS and not change whether it is highlighted. */ reassert_line_highlight (highlight, vpos) int highlight; int vpos; { if (! FRAME_TERMCAP_P ((updating_frame ? updating_frame : selected_frame))) { (*reassert_line_highlight_hook) (highlight, vpos); return; } if (TN_standout_width < 0) /* Handle terminals where standout takes affect at output time */ standout_requested = highlight; else if (chars_wasted[vpos] == 0) /* For terminals with standout markers, write one on this line if there isn't one already. */ write_standout_marker (highlight, vpos); } /* Call this when about to modify line at position VPOS and change whether it is highlighted. */ change_line_highlight (new_highlight, vpos, first_unused_hpos) int new_highlight, vpos, first_unused_hpos; { standout_requested = new_highlight; if (! FRAME_TERMCAP_P (updating_frame)) { (*change_line_highlight_hook) (new_highlight, vpos, first_unused_hpos); return; } cursor_to (vpos, 0); if (TN_standout_width < 0) background_highlight (); /* If line starts with a marker, delete the marker */ else if (TS_clr_line && chars_wasted[curY]) { turn_off_insert (); /* On Teleray, make sure to erase the SO marker. */ if (TF_teleray) { cmgoto (curY - 1, FRAME_WIDTH (selected_frame) - 4); OUTPUT ("\033S"); curY++; /* ESC S moves to next line where the TS_standout_mode was */ curX = 0; } else cmgoto (curY, 0); /* reposition to kill standout marker */ } clear_end_of_line_raw (first_unused_hpos); reassert_line_highlight (new_highlight, curY); } /* Move to absolute position, specified origin 0 */ cursor_to (row, col) int row, col; { if (! FRAME_TERMCAP_P ((updating_frame ? updating_frame : selected_frame)) && cursor_to_hook) { (*cursor_to_hook) (row, col); return; } /* Detect the case where we are called from reset_sys_modes and the costs have never been calculated. Do nothing. */ if (chars_wasted == 0) return; col += chars_wasted[row] & 077; if (curY == row && curX == col) return; if (!TF_standout_motion) background_highlight (); if (!TF_insmode_motion) turn_off_insert (); cmgoto (row, col); } /* Similar but don't take any account of the wasted characters. */ raw_cursor_to (row, col) int row, col; { if (! FRAME_TERMCAP_P ((updating_frame ? updating_frame : selected_frame))) { (*raw_cursor_to_hook) (row, col); return; } if (curY == row && curX == col) return; if (!TF_standout_motion) background_highlight (); if (!TF_insmode_motion) turn_off_insert (); cmgoto (row, col); } /* Erase operations */ /* clear from cursor to end of frame */ clear_to_end () { register int i; if (clear_to_end_hook && ! FRAME_TERMCAP_P (updating_frame)) { (*clear_to_end_hook) (); return; } if (TS_clr_to_bottom) { background_highlight (); OUTPUT (TS_clr_to_bottom); bzero (chars_wasted + curY, FRAME_HEIGHT (selected_frame) - curY); } else { for (i = curY; i < FRAME_HEIGHT (selected_frame); i++) { cursor_to (i, 0); clear_end_of_line_raw (FRAME_WIDTH (selected_frame)); } } } /* Clear entire frame */ clear_frame () { if (clear_frame_hook && ! FRAME_TERMCAP_P ((updating_frame ? updating_frame : selected_frame))) { (*clear_frame_hook) (); return; } if (TS_clr_frame) { background_highlight (); OUTPUT (TS_clr_frame); bzero (chars_wasted, FRAME_HEIGHT (selected_frame)); cmat (0, 0); } else { cursor_to (0, 0); clear_to_end (); } } /* Clear to end of line, but do not clear any standout marker. Assumes that the cursor is positioned at a character of real text, which implies it cannot be before a standout marker unless the marker has zero width. Note that the cursor may be moved. */ clear_end_of_line (first_unused_hpos) int first_unused_hpos; { static GLYPH buf = SPACEGLYPH; if (FRAME_TERMCAP_P (selected_frame) && chars_wasted != 0 && TN_standout_width == 0 && curX == 0 && chars_wasted[curY] != 0) write_glyphs (&buf, 1); clear_end_of_line_raw (first_unused_hpos); } /* Clear from cursor to end of line. Assume that the line is already clear starting at column first_unused_hpos. If the cursor is at a standout marker, erase the marker. Note that the cursor may be moved, on terminals lacking a `ce' string. */ clear_end_of_line_raw (first_unused_hpos) int first_unused_hpos; { register int i; if (clear_end_of_line_hook && ! FRAME_TERMCAP_P ((updating_frame ? updating_frame : selected_frame))) { (*clear_end_of_line_hook) (first_unused_hpos); return; } /* Detect the case where we are called from reset_sys_modes and the costs have never been calculated. Do nothing. */ if (chars_wasted == 0) return; first_unused_hpos += chars_wasted[curY] & 077; if (curX >= first_unused_hpos) return; /* Notice if we are erasing a magic cookie */ if (curX == 0) chars_wasted[curY] = 0; background_highlight (); if (TS_clr_line) { OUTPUT1 (TS_clr_line); } else { /* have to do it the hard way */ turn_off_insert (); /* Do not write in last row last col with Autowrap on. */ if (AutoWrap && curY == FRAME_HEIGHT (selected_frame) - 1 && first_unused_hpos == FRAME_WIDTH (selected_frame)) first_unused_hpos--; for (i = curX; i < first_unused_hpos; i++) { if (termscript) fputc (' ', termscript); putchar (' '); } cmplus (first_unused_hpos - curX); } } write_glyphs (string, len) register GLYPH *string; register int len; { register GLYPH g; register int tlen = GLYPH_TABLE_LENGTH; register Lisp_Object *tbase = GLYPH_TABLE_BASE; if (write_glyphs_hook && ! FRAME_TERMCAP_P ((updating_frame ? updating_frame : selected_frame))) { (*write_glyphs_hook) (string, len); return; } highlight_if_desired (); turn_off_insert (); /* Don't dare write in last column of bottom line, if AutoWrap, since that would scroll the whole frame on some terminals. */ if (AutoWrap && curY + 1 == FRAME_HEIGHT (selected_frame) && (curX + len - (chars_wasted[curY] & 077) == FRAME_WIDTH (selected_frame))) len --; cmplus (len); while (--len >= 0) { g = *string++; /* Check quickly for G beyond length of table. That implies it isn't an alias and is simple. */ if (g >= tlen) { simple: putc (g & 0xff, stdout); if (ferror (stdout)) clearerr (stdout); if (termscript) putc (g & 0xff, termscript); } else { /* G has an entry in Vglyph_table, so process any alias and then test for simpleness. */ while (GLYPH_ALIAS_P (tbase, tlen, g)) g = GLYPH_ALIAS (tbase, g); if (GLYPH_SIMPLE_P (tbase, tlen, g)) goto simple; else { /* Here if G (or its definition as an alias) is not simple. */ fwrite (GLYPH_STRING (tbase, g), 1, GLYPH_LENGTH (tbase, g), stdout); if (ferror (stdout)) clearerr (stdout); if (termscript) fwrite (GLYPH_STRING (tbase, g), 1, GLYPH_LENGTH (tbase, g), termscript); } } } cmcheckmagic (); } /* If start is zero, insert blanks instead of a string at start */ insert_glyphs (start, len) register GLYPH *start; register int len; { char *buf; register GLYPH g; register int tlen = GLYPH_TABLE_LENGTH; register Lisp_Object *tbase = GLYPH_TABLE_BASE; if (insert_glyphs_hook && ! FRAME_TERMCAP_P (updating_frame)) { (*insert_glyphs_hook) (start, len); return; } highlight_if_desired (); if (TS_ins_multi_chars) { buf = tparam (TS_ins_multi_chars, 0, 0, len); OUTPUT1 (buf); xfree (buf); if (start) write_glyphs (start, len); return; } turn_on_insert (); cmplus (len); while (--len >= 0) { OUTPUT1_IF (TS_ins_char); if (!start) g = SPACEGLYPH; else g = *start++; if (GLYPH_SIMPLE_P (tbase, tlen, g)) { putc (g & 0xff, stdout); if (ferror (stdout)) clearerr (stdout); if (termscript) putc (g & 0xff, termscript); } else { fwrite (GLYPH_STRING (tbase, g), 1, GLYPH_LENGTH (tbase, g), stdout); if (ferror (stdout)) clearerr (stdout); if (termscript) fwrite (GLYPH_STRING (tbase, g), 1, GLYPH_LENGTH (tbase, g), termscript); } OUTPUT1_IF (TS_pad_inserted_char); } cmcheckmagic (); } delete_glyphs (n) register int n; { char *buf; register int i; if (delete_glyphs_hook && ! FRAME_TERMCAP_P (updating_frame)) { (*delete_glyphs_hook) (n); return; } if (delete_in_insert_mode) { turn_on_insert (); } else { turn_off_insert (); OUTPUT_IF (TS_delete_mode); } if (TS_del_multi_chars) { buf = tparam (TS_del_multi_chars, 0, 0, n); OUTPUT1 (buf); xfree (buf); } else for (i = 0; i < n; i++) OUTPUT1 (TS_del_char); if (!delete_in_insert_mode) OUTPUT_IF (TS_end_delete_mode); } /* Insert N lines at vpos VPOS. If N is negative, delete -N lines. */ ins_del_lines (vpos, n) int vpos, n; { char *multi = n > 0 ? TS_ins_multi_lines : TS_del_multi_lines; char *single = n > 0 ? TS_ins_line : TS_del_line; char *scroll = n > 0 ? TS_rev_scroll : TS_fwd_scroll; register int i = n > 0 ? n : -n; register char *buf; if (ins_del_lines_hook && ! FRAME_TERMCAP_P (updating_frame)) { (*ins_del_lines_hook) (vpos, n); return; } /* If the lines below the insertion are being pushed into the end of the window, this is the same as clearing; and we know the lines are already clear, since the matching deletion has already been done. So can ignore this. */ /* If the lines below the deletion are blank lines coming out of the end of the window, don't bother, as there will be a matching inslines later that will flush them. */ if (scroll_region_ok && vpos + i >= specified_window) return; if (!memory_below_frame && vpos + i >= FRAME_HEIGHT (selected_frame)) return; if (multi) { raw_cursor_to (vpos, 0); background_highlight (); buf = tparam (multi, 0, 0, i); OUTPUT (buf); xfree (buf); } else if (single) { raw_cursor_to (vpos, 0); background_highlight (); while (--i >= 0) OUTPUT (single); if (TF_teleray) curX = 0; } else { set_scroll_region (vpos, specified_window); if (n < 0) raw_cursor_to (specified_window - 1, 0); else raw_cursor_to (vpos, 0); background_highlight (); while (--i >= 0) OUTPUTL (scroll, specified_window - vpos); set_scroll_region (0, specified_window); } if (TN_standout_width >= 0) { register lower_limit = (scroll_region_ok ? specified_window : FRAME_HEIGHT (selected_frame)); if (n < 0) { bcopy (&chars_wasted[vpos - n], &chars_wasted[vpos], lower_limit - vpos + n); bzero (&chars_wasted[lower_limit + n], - n); } else { bcopy (&chars_wasted[vpos], ©buf[vpos], lower_limit - vpos - n); bcopy (©buf[vpos], &chars_wasted[vpos + n], lower_limit - vpos - n); bzero (&chars_wasted[vpos], n); } } if (!scroll_region_ok && memory_below_frame && n < 0) { cursor_to (FRAME_HEIGHT (selected_frame) + n, 0); clear_to_end (); } } /* Compute cost of sending "str", in characters, not counting any line-dependent padding. */ int string_cost (str) char *str; { cost = 0; if (str) tputs (str, 0, evalcost); return cost; } /* Compute cost of sending "str", in characters, counting any line-dependent padding at one line. */ static int string_cost_one_line (str) char *str; { cost = 0; if (str) tputs (str, 1, evalcost); return cost; } /* Compute per line amount of line-dependent padding, in tenths of characters. */ int per_line_cost (str) register char *str; { cost = 0; if (str) tputs (str, 0, evalcost); cost = - cost; if (str) tputs (str, 10, evalcost); return cost; } #ifndef old /* char_ins_del_cost[n] is cost of inserting N characters. char_ins_del_cost[-n] is cost of deleting N characters. The length of this vector is based on max_frame_width. */ int *char_ins_del_vector; #define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_WIDTH ((f))]) #endif /* ARGSUSED */ static void calculate_ins_del_char_costs (frame) FRAME_PTR frame; { int ins_startup_cost, del_startup_cost; int ins_cost_per_char, del_cost_per_char; register int i; register int *p; if (TS_ins_multi_chars) { ins_cost_per_char = 0; ins_startup_cost = string_cost_one_line (TS_ins_multi_chars); } else if (TS_ins_char || TS_pad_inserted_char || (TS_insert_mode && TS_end_insert_mode)) { ins_startup_cost = (30 * (string_cost (TS_insert_mode) + string_cost (TS_end_insert_mode))) / 100; ins_cost_per_char = (string_cost_one_line (TS_ins_char) + string_cost_one_line (TS_pad_inserted_char)); } else { ins_startup_cost = 9999; ins_cost_per_char = 0; } if (TS_del_multi_chars) { del_cost_per_char = 0; del_startup_cost = string_cost_one_line (TS_del_multi_chars); } else if (TS_del_char) { del_startup_cost = (string_cost (TS_delete_mode) + string_cost (TS_end_delete_mode)); if (delete_in_insert_mode) del_startup_cost /= 2; del_cost_per_char = string_cost_one_line (TS_del_char); } else { del_startup_cost = 9999; del_cost_per_char = 0; } /* Delete costs are at negative offsets */ p = &char_ins_del_cost (frame)[0]; for (i = FRAME_WIDTH (selected_frame); --i >= 0;) *--p = (del_startup_cost += del_cost_per_char); /* Doing nothing is free */ p = &char_ins_del_cost (frame)[0]; *p++ = 0; /* Insert costs are at positive offsets */ for (i = FRAME_WIDTH (frame); --i >= 0;) *p++ = (ins_startup_cost += ins_cost_per_char); } extern do_line_insertion_deletion_costs (); calculate_costs (frame) FRAME_PTR frame; { register char *f = (TS_set_scroll_region ? TS_set_scroll_region : TS_set_scroll_region_1); FRAME_COST_BAUD_RATE (frame) = baud_rate; scroll_region_cost = string_cost (f); #ifdef HAVE_X_WINDOWS if (FRAME_X_P (frame)) { do_line_insertion_deletion_costs (frame, 0, ".5*", 0, ".5*", 0, 0, x_screen_planes (frame)); scroll_region_cost = 0; return; } #endif /* These variables are only used for terminal stuff. They are allocated once for the terminal frame of X-windows emacs, but not used afterwards. char_ins_del_vector (i.e., char_ins_del_cost) isn't used because X turns off char_ins_del_ok. chars_wasted and copybuf are only used here in term.c in cases where the term hook isn't called. */ max_frame_height = max (max_frame_height, FRAME_HEIGHT (frame)); max_frame_width = max (max_frame_width, FRAME_WIDTH (frame)); if (chars_wasted != 0) chars_wasted = (char *) xrealloc (chars_wasted, max_frame_height); else chars_wasted = (char *) xmalloc (max_frame_height); if (copybuf != 0) copybuf = (char *) xrealloc (copybuf, max_frame_height); else copybuf = (char *) xmalloc (max_frame_height); if (char_ins_del_vector != 0) char_ins_del_vector = (int *) xrealloc (char_ins_del_vector, (sizeof (int) + 2 * max_frame_width * sizeof (int))); else char_ins_del_vector = (int *) xmalloc (sizeof (int) + 2 * max_frame_width * sizeof (int)); bzero (chars_wasted, max_frame_height); bzero (copybuf, max_frame_height); bzero (char_ins_del_vector, (sizeof (int) + 2 * max_frame_width * sizeof (int))); if (f && (!TS_ins_line && !TS_del_line)) do_line_insertion_deletion_costs (frame, TS_rev_scroll, TS_ins_multi_lines, TS_fwd_scroll, TS_del_multi_lines, f, f, 1); else do_line_insertion_deletion_costs (frame, TS_ins_line, TS_ins_multi_lines, TS_del_line, TS_del_multi_lines, 0, 0, 1); calculate_ins_del_char_costs (frame); /* Don't use TS_repeat if its padding is worse than sending the chars */ if (TS_repeat && per_line_cost (TS_repeat) * baud_rate < 9000) RPov = string_cost (TS_repeat); else RPov = FRAME_WIDTH (frame) * 2; cmcostinit (); /* set up cursor motion costs */ } struct fkey_table { char *cap, *name; }; /* Termcap capability names that correspond directly to X keysyms. Some of these (marked "terminfo") aren't supplied by old-style (Berkeley) termcap entries. They're listed in X keysym order; except we put the keypad keys first, so that if they clash with other keys (as on the IBM PC keyboard) they get overridden. */ static struct fkey_table keys[] = { "kh", "home", /* termcap */ "kl", "left", /* termcap */ "ku", "up", /* termcap */ "kr", "right", /* termcap */ "kd", "down", /* termcap */ "%8", "prior", /* terminfo */ "%5", "next", /* terminfo */ "@7", "end", /* terminfo */ "@1", "begin", /* terminfo */ "*6", "select", /* terminfo */ "%9", "print", /* terminfo */ "@4", "execute", /* terminfo --- actually the `command' key */ /* * "insert" --- see below */ "&8", "undo", /* terminfo */ "%0", "redo", /* terminfo */ "%7", "menu", /* terminfo --- actually the `options' key */ "@0", "find", /* terminfo */ "@2", "cancel", /* terminfo */ "%1", "help", /* terminfo */ /* * "break" goes here, but can't be reliably intercepted with termcap */ "&4", "reset", /* terminfo --- actually `restart' */ /* * "system" and "user" --- no termcaps */ "kE", "clearline", /* terminfo */ "kA", "insertline", /* terminfo */ "kL", "deleteline", /* terminfo */ "kI", "insertchar", /* terminfo */ "kD", "deletechar", /* terminfo */ "kB", "backtab", /* terminfo */ /* * "kp_backtab", "kp-space", "kp-tab" --- no termcaps */ "@8", "kp-enter", /* terminfo */ /* * "kp-f1", "kp-f2", "kp-f3" "kp-f4", * "kp-multiply", "kp-add", "kp-separator", * "kp-subtract", "kp-decimal", "kp-divide", "kp-0"; * --- no termcaps for any of these. */ "K4", "kp-1", /* terminfo */ /* * "kp-2" --- no termcap */ "K5", "kp-3", /* terminfo */ /* * "kp-4" --- no termcap */ "K2", "kp-5", /* terminfo */ /* * "kp-6" --- no termcap */ "K1", "kp-7", /* terminfo */ /* * "kp-8" --- no termcap */ "K3", "kp-9", /* terminfo */ /* * "kp-equal" --- no termcap */ "k1", "f1", "k2", "f2", "k3", "f3", "k4", "f4", "k5", "f5", "k6", "f6", "k7", "f7", "k8", "f8", "k9", "f9", }; static char **term_get_fkeys_arg; static Lisp_Object term_get_fkeys_1 (); /* Find the escape codes sent by the function keys for Vfunction_key_map. This function scans the termcap function key sequence entries, and adds entries to Vfunction_key_map for each function key it finds. */ void term_get_fkeys (address) char **address; { /* We run the body of the function (term_get_fkeys_1) and ignore all Lisp errors during the call. The only errors should be from Fdefine_key when given a key sequence containing an invalid prefix key. If the termcap defines function keys which use a prefix that is already bound to a command by the default bindings, we should silently ignore that function key specification, rather than giving the user an error and refusing to run at all on such a terminal. */ extern Lisp_Object Fidentity (); term_get_fkeys_arg = address; internal_condition_case (term_get_fkeys_1, Qerror, Fidentity); } static Lisp_Object term_get_fkeys_1 () { int i; char **address = term_get_fkeys_arg; /* This can happen if CANNOT_DUMP or with strange options. */ if (!initialized) Vfunction_key_map = Fmake_sparse_keymap (Qnil); for (i = 0; i < (sizeof (keys)/sizeof (keys[0])); i++) { char *sequence = tgetstr (keys[i].cap, address); if (sequence) Fdefine_key (Vfunction_key_map, build_string (sequence), Fmake_vector (make_number (1), intern (keys[i].name))); } /* The uses of the "k0" capability are inconsistent; sometimes it describes F10, whereas othertimes it describes F0 and "k;" describes F10. We will attempt to politely accommodate both systems by testing for "k;", and if it is present, assuming that "k0" denotes F0, otherwise F10. */ { char *k_semi = tgetstr ("k;", address); char *k0 = tgetstr ("k0", address); char *k0_name = "f10"; if (k_semi) { Fdefine_key (Vfunction_key_map, build_string (k_semi), Fmake_vector (make_number (1), intern ("f10"))); k0_name = "f0"; } if (k0) Fdefine_key (Vfunction_key_map, build_string (k0), Fmake_vector (make_number (1), intern (k0_name))); } /* Set up cookies for numbered function keys above f10. */ { char fcap[3], fkey[4]; fcap[0] = 'F'; fcap[2] = '\0'; for (i = 11; i < 64; i++) { if (i <= 19) fcap[1] = '1' + i - 11; else if (i <= 45) fcap[1] = 'A' + i - 20; else fcap[1] = 'a' + i - 46; { char *sequence = tgetstr (fcap, address); if (sequence) { sprintf (fkey, "f%d", i); Fdefine_key (Vfunction_key_map, build_string (sequence), Fmake_vector (make_number (1), intern (fkey))); } } } } /* * Various mappings to try and get a better fit. */ { #define CONDITIONAL_REASSIGN(cap1, cap2, sym) \ if (!tgetstr (cap1, address)) \ { \ char *sequence = tgetstr (cap2, address); \ if (sequence) \ Fdefine_key (Vfunction_key_map, build_string (sequence), \ Fmake_vector (make_number (1), \ intern (sym))); \ } /* if there's no key_next keycap, map key_npage to `next' keysym */ CONDITIONAL_REASSIGN ("%5", "kN", "next"); /* if there's no key_prev keycap, map key_ppage to `previous' keysym */ CONDITIONAL_REASSIGN ("%8", "kP", "prior"); /* if there's no key_dc keycap, map key_ic to `insert' keysym */ CONDITIONAL_REASSIGN ("kD", "kI", "insert"); /* IBM has their own non-standard dialect of terminfo. If the standard name isn't found, try the IBM name. */ CONDITIONAL_REASSIGN ("kB", "KO", "backtab"); CONDITIONAL_REASSIGN ("@4", "kJ", "execute"); /* actually "action" */ CONDITIONAL_REASSIGN ("@4", "kc", "execute"); /* actually "command" */ CONDITIONAL_REASSIGN ("%7", "ki", "menu"); CONDITIONAL_REASSIGN ("@7", "kw", "end"); CONDITIONAL_REASSIGN ("F1", "k<", "f11"); CONDITIONAL_REASSIGN ("F2", "k>", "f12"); CONDITIONAL_REASSIGN ("%1", "kq", "help"); CONDITIONAL_REASSIGN ("*6", "kU", "select"); #undef CONDITIONAL_REASSIGN } } term_init (terminal_type) char *terminal_type; { char *area; char **address = &area; char buffer[2044]; register char *p; int status; #ifdef WINDOWSNT initialize_win_nt_display (); Wcm_clear (); area = (char *) malloc (2044); if (area == 0) abort (); FrameRows = FRAME_HEIGHT (selected_frame); FrameCols = FRAME_WIDTH (selected_frame); specified_window = FRAME_HEIGHT (selected_frame); delete_in_insert_mode = 1; UseTabs = 0; scroll_region_ok = 0; /* Seems to insert lines when it's not supposed to, messing up the display. In doing a trace, it didn't seem to be called much, so I don't think we're losing anything by turning it off. */ line_ins_del_ok = 0; char_ins_del_ok = 1; baud_rate = 19200; FRAME_CAN_HAVE_SCROLL_BARS (selected_frame) = 0; FRAME_HAS_VERTICAL_SCROLL_BARS (selected_frame) = 0; return; #endif /* WINDOWSNT */ Wcm_clear (); status = tgetent (buffer, terminal_type); if (status < 0) { #ifdef TERMINFO fatal ("Cannot open terminfo database file.\n"); #else fatal ("Cannot open termcap database file.\n"); #endif } if (status == 0) { #ifdef TERMINFO fatal ("Terminal type %s is not defined.\n\ If that is not the actual type of terminal you have,\n\ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\ `setenv TERM ...') to specify the correct type. It may be necessary\n\ to do `unset TERMINFO' (C-shell: `unsetenv TERMINFO') as well.\n", terminal_type); #else fatal ("Terminal type %s is not defined.\n\ If that is not the actual type of terminal you have,\n\ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\ `setenv TERM ...') to specify the correct type. It may be necessary\n\ to do `unset TERMCAP' (C-shell: `unsetenv TERMCAP') as well.\n", terminal_type); #endif } #ifdef TERMINFO area = (char *) malloc (2044); #else area = (char *) malloc (strlen (buffer)); #endif /* not TERMINFO */ if (area == 0) abort (); TS_ins_line = tgetstr ("al", address); TS_ins_multi_lines = tgetstr ("AL", address); TS_bell = tgetstr ("bl", address); BackTab = tgetstr ("bt", address); TS_clr_to_bottom = tgetstr ("cd", address); TS_clr_line = tgetstr ("ce", address); TS_clr_frame = tgetstr ("cl", address); ColPosition = tgetstr ("ch", address); AbsPosition = tgetstr ("cm", address); CR = tgetstr ("cr", address); TS_set_scroll_region = tgetstr ("cs", address); TS_set_scroll_region_1 = tgetstr ("cS", address); RowPosition = tgetstr ("cv", address); TS_del_char = tgetstr ("dc", address); TS_del_multi_chars = tgetstr ("DC", address); TS_del_line = tgetstr ("dl", address); TS_del_multi_lines = tgetstr ("DL", address); TS_delete_mode = tgetstr ("dm", address); TS_end_delete_mode = tgetstr ("ed", address); TS_end_insert_mode = tgetstr ("ei", address); Home = tgetstr ("ho", address); TS_ins_char = tgetstr ("ic", address); TS_ins_multi_chars = tgetstr ("IC", address); TS_insert_mode = tgetstr ("im", address); TS_pad_inserted_char = tgetstr ("ip", address); TS_end_keypad_mode = tgetstr ("ke", address); TS_keypad_mode = tgetstr ("ks", address); LastLine = tgetstr ("ll", address); Right = tgetstr ("nd", address); Down = tgetstr ("do", address); if (!Down) Down = tgetstr ("nl", address); /* Obsolete name for "do" */ #ifdef VMS /* VMS puts a carriage return before each linefeed, so it is not safe to use linefeeds. */ if (Down && Down[0] == '\n' && Down[1] == '\0') Down = 0; #endif /* VMS */ if (tgetflag ("bs")) Left = "\b"; /* can't possibly be longer! */ else /* (Actually, "bs" is obsolete...) */ Left = tgetstr ("le", address); if (!Left) Left = tgetstr ("bc", address); /* Obsolete name for "le" */ TS_pad_char = tgetstr ("pc", address); TS_repeat = tgetstr ("rp", address); TS_end_standout_mode = tgetstr ("se", address); TS_fwd_scroll = tgetstr ("sf", address); TS_standout_mode = tgetstr ("so", address); TS_rev_scroll = tgetstr ("sr", address); Wcm.cm_tab = tgetstr ("ta", address); TS_end_termcap_modes = tgetstr ("te", address); TS_termcap_modes = tgetstr ("ti", address); Up = tgetstr ("up", address); TS_visible_bell = tgetstr ("vb", address); TS_end_visual_mode = tgetstr ("ve", address); TS_visual_mode = tgetstr ("vs", address); TS_set_window = tgetstr ("wi", address); MultiUp = tgetstr ("UP", address); MultiDown = tgetstr ("DO", address); MultiLeft = tgetstr ("LE", address); MultiRight = tgetstr ("RI", address); MagicWrap = tgetflag ("xn"); /* Since we make MagicWrap terminals look like AutoWrap, we need to have the former flag imply the latter. */ AutoWrap = MagicWrap || tgetflag ("am"); memory_below_frame = tgetflag ("db"); TF_hazeltine = tgetflag ("hz"); must_write_spaces = tgetflag ("in"); meta_key = tgetflag ("km") || tgetflag ("MT"); TF_insmode_motion = tgetflag ("mi"); TF_standout_motion = tgetflag ("ms"); TF_underscore = tgetflag ("ul"); TF_xs = tgetflag ("xs"); TF_teleray = tgetflag ("xt"); term_get_fkeys (address); /* Get frame size from system, or else from termcap. */ get_frame_size (&FRAME_WIDTH (selected_frame), &FRAME_HEIGHT (selected_frame)); if (FRAME_WIDTH (selected_frame) <= 0) FRAME_WIDTH (selected_frame) = tgetnum ("co"); if (FRAME_HEIGHT (selected_frame) <= 0) FRAME_HEIGHT (selected_frame) = tgetnum ("li"); if (FRAME_HEIGHT (selected_frame) < 3 || FRAME_WIDTH (selected_frame) < 3) fatal ("Screen size %dx%d is too small.\n", FRAME_HEIGHT (selected_frame), FRAME_WIDTH (selected_frame)); min_padding_speed = tgetnum ("pb"); TN_standout_width = tgetnum ("sg"); TabWidth = tgetnum ("tw"); #ifdef VMS /* These capabilities commonly use ^J. I don't know why, but sending them on VMS does not work; it causes following spaces to be lost, sometimes. For now, the simplest fix is to avoid using these capabilities ever. */ if (Down && Down[0] == '\n') Down = 0; #endif /* VMS */ if (!TS_bell) TS_bell = "\07"; if (!TS_fwd_scroll) TS_fwd_scroll = Down; PC = TS_pad_char ? *TS_pad_char : 0; if (TabWidth < 0) TabWidth = 8; /* Turned off since /etc/termcap seems to have :ta= for most terminals and newer termcap doc does not seem to say there is a default. if (!Wcm.cm_tab) Wcm.cm_tab = "\t"; */ if (TS_standout_mode == 0) { TN_standout_width = tgetnum ("ug"); TS_end_standout_mode = tgetstr ("ue", address); TS_standout_mode = tgetstr ("us", address); } /* If no `se' string, try using a `me' string instead. If that fails, we can't use standout mode at all. */ if (TS_end_standout_mode == 0) { char *s = tgetstr ("me", address); if (s != 0) TS_end_standout_mode = s; else TS_standout_mode = 0; } if (TF_teleray) { Wcm.cm_tab = 0; /* Teleray: most programs want a space in front of TS_standout_mode, but Emacs can do without it (and give one extra column). */ TS_standout_mode = "\033RD"; TN_standout_width = 1; /* But that means we cannot rely on ^M to go to column zero! */ CR = 0; /* LF can't be trusted either -- can alter hpos */ /* if move at column 0 thru a line with TS_standout_mode */ Down = 0; } /* Special handling for certain terminal types known to need it */ if (!strcmp (terminal_type, "supdup")) { memory_below_frame = 1; Wcm.cm_losewrap = 1; } if (!strncmp (terminal_type, "c10", 3) || !strcmp (terminal_type, "perq")) { /* Supply a makeshift :wi string. This string is not valid in general since it works only for windows starting at the upper left corner; but that is all Emacs uses. This string works only if the frame is using the top of the video memory, because addressing is memory-relative. So first check the :ti string to see if that is true. It would be simpler if the :wi string could go in the termcap entry, but it can't because it is not fully valid. If it were in the termcap entry, it would confuse other programs. */ if (!TS_set_window) { p = TS_termcap_modes; while (*p && strcmp (p, "\033v ")) p++; if (*p) TS_set_window = "\033v%C %C %C %C "; } /* Termcap entry often fails to have :in: flag */ must_write_spaces = 1; /* :ti string typically fails to have \E^G! in it */ /* This limits scope of insert-char to one line. */ strcpy (area, TS_termcap_modes); strcat (area, "\033\007!"); TS_termcap_modes = area; area += strlen (area) + 1; p = AbsPosition; /* Change all %+ parameters to %C, to handle values above 96 correctly for the C100. */ while (*p) { if (p[0] == '%' && p[1] == '+') p[1] = 'C'; p++; } } FrameRows = FRAME_HEIGHT (selected_frame); FrameCols = FRAME_WIDTH (selected_frame); specified_window = FRAME_HEIGHT (selected_frame); if (Wcm_init () == -1) /* can't do cursor motion */ #ifdef VMS fatal ("Terminal type \"%s\" is not powerful enough to run Emacs.\n\ It lacks the ability to position the cursor.\n\ If that is not the actual type of terminal you have, use either the\n\ DCL command `SET TERMINAL/DEVICE= ...' for DEC-compatible terminals,\n\ or `define EMACS_TERM \"terminal type\"' for non-DEC terminals.\n", terminal_type); #else /* not VMS */ # ifdef TERMINFO fatal ("Terminal type \"%s\" is not powerful enough to run Emacs.\n\ It lacks the ability to position the cursor.\n\ If that is not the actual type of terminal you have,\n\ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\ `setenv TERM ...') to specify the correct type. It may be necessary\n\ to do `unset TERMINFO' (C-shell: `unsetenv TERMINFO') as well.\n", terminal_type); # else /* TERMCAP */ fatal ("Terminal type \"%s\" is not powerful enough to run Emacs.\n\ It lacks the ability to position the cursor.\n\ If that is not the actual type of terminal you have,\n\ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\ `setenv TERM ...') to specify the correct type. It may be necessary\n\ to do `unset TERMCAP' (C-shell: `unsetenv TERMCAP') as well.\n", terminal_type); # endif /* TERMINFO */ #endif /*VMS */ if (FRAME_HEIGHT (selected_frame) <= 0 || FRAME_WIDTH (selected_frame) <= 0) fatal ("The frame size has not been specified."); delete_in_insert_mode = TS_delete_mode && TS_insert_mode && !strcmp (TS_delete_mode, TS_insert_mode); se_is_so = (TS_standout_mode && TS_end_standout_mode && !strcmp (TS_standout_mode, TS_end_standout_mode)); /* Remove width of standout marker from usable width of line */ if (TN_standout_width > 0) FRAME_WIDTH (selected_frame) -= TN_standout_width; UseTabs = tabs_safe_p () && TabWidth == 8; scroll_region_ok = (Wcm.cm_abs && (TS_set_window || TS_set_scroll_region || TS_set_scroll_region_1)); line_ins_del_ok = (((TS_ins_line || TS_ins_multi_lines) && (TS_del_line || TS_del_multi_lines)) || (scroll_region_ok && TS_fwd_scroll && TS_rev_scroll)); char_ins_del_ok = ((TS_ins_char || TS_insert_mode || TS_pad_inserted_char || TS_ins_multi_chars) && (TS_del_char || TS_del_multi_chars)); fast_clear_end_of_line = TS_clr_line != 0; init_baud_rate (); if (read_socket_hook) /* Baudrate is somewhat */ /* meaningless in this case */ baud_rate = 9600; FRAME_CAN_HAVE_SCROLL_BARS (selected_frame) = 0; FRAME_HAS_VERTICAL_SCROLL_BARS (selected_frame) = 0; } /* VARARGS 1 */ fatal (str, arg1, arg2) char *str, *arg1, *arg2; { fprintf (stderr, "emacs: "); fprintf (stderr, str, arg1, arg2); fflush (stderr); exit (1); } syms_of_term () { DEFVAR_BOOL ("system-uses-terminfo", &system_uses_terminfo, "Non-nil means the system uses terminfo rather than termcap.\n\ This variable can be used by terminal emulator packages."); #ifdef TERMINFO system_uses_terminfo = 1; #else system_uses_terminfo = 0; #endif } emacs-19.30/src/termcap.c100444 21570 1 40544 6022167060 13476 0ustar djmdaemon/* Work-alike for termcap, plus extra features. Copyright (C) 1985, 86, 93, 94, 95 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* Emacs config.h may rename various library functions such as malloc. */ #ifdef HAVE_CONFIG_H #include #endif #ifdef emacs /* Get the O_* definitions for open et al. */ #include #ifdef USG5 #include #endif #else /* not emacs */ #ifdef STDC_HEADERS #include #include #else char *getenv (); char *malloc (); char *realloc (); #endif /* Do this after the include, in case string.h prototypes bcopy. */ #if (defined(HAVE_STRING_H) || defined(STDC_HEADERS)) && !defined(bcopy) #define bcopy(s, d, n) memcpy ((d), (s), (n)) #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef _POSIX_VERSION #include #endif #endif /* not emacs */ #ifndef NULL #define NULL (char *) 0 #endif #ifndef O_RDONLY #define O_RDONLY 0 #endif /* BUFSIZE is the initial size allocated for the buffer for reading the termcap file. It is not a limit. Make it large normally for speed. Make it variable when debugging, so can exercise increasing the space dynamically. */ #ifndef BUFSIZE #ifdef DEBUG #define BUFSIZE bufsize int bufsize = 128; #else #define BUFSIZE 2048 #endif #endif #ifndef TERMCAP_FILE #define TERMCAP_FILE "/etc/termcap" #endif #ifndef emacs static void memory_out () { write (2, "virtual memory exhausted\n", 25); exit (1); } static char * xmalloc (size) unsigned size; { register char *tem = malloc (size); if (!tem) memory_out (); return tem; } static char * xrealloc (ptr, size) char *ptr; unsigned size; { register char *tem = realloc (ptr, size); if (!tem) memory_out (); return tem; } #endif /* not emacs */ /* Looking up capabilities in the entry already found. */ /* The pointer to the data made by tgetent is left here for tgetnum, tgetflag and tgetstr to find. */ static char *term_entry; static char *tgetst1 (); /* Search entry BP for capability CAP. Return a pointer to the capability (in BP) if found, 0 if not found. */ static char * find_capability (bp, cap) register char *bp, *cap; { for (; *bp; bp++) if (bp[0] == ':' && bp[1] == cap[0] && bp[2] == cap[1]) return &bp[4]; return NULL; } int tgetnum (cap) char *cap; { register char *ptr = find_capability (term_entry, cap); if (!ptr || ptr[-1] != '#') return -1; return atoi (ptr); } int tgetflag (cap) char *cap; { register char *ptr = find_capability (term_entry, cap); return ptr && ptr[-1] == ':'; } /* Look up a string-valued capability CAP. If AREA is non-null, it points to a pointer to a block in which to store the string. That pointer is advanced over the space used. If AREA is null, space is allocated with `malloc'. */ char * tgetstr (cap, area) char *cap; char **area; { register char *ptr = find_capability (term_entry, cap); if (!ptr || (ptr[-1] != '=' && ptr[-1] != '~')) return NULL; return tgetst1 (ptr, area); } /* Table, indexed by a character in range 0100 to 0140 with 0100 subtracted, gives meaning of character following \, or a space if no special meaning. Eight characters per line within the string. */ static char esctab[] = " \007\010 \033\014 \ \012 \ \015 \011 \013 \ "; /* PTR points to a string value inside a termcap entry. Copy that value, processing \ and ^ abbreviations, into the block that *AREA points to, or to newly allocated storage if AREA is NULL. Return the address to which we copied the value, or NULL if PTR is NULL. */ static char * tgetst1 (ptr, area) char *ptr; char **area; { register char *p, *r; register int c; register int size; char *ret; register int c1; if (!ptr) return NULL; /* `ret' gets address of where to store the string. */ if (!area) { /* Compute size of block needed (may overestimate). */ p = ptr; while ((c = *p++) && c != ':' && c != '\n') ; ret = (char *) xmalloc (p - ptr + 1); } else ret = *area; /* Copy the string value, stopping at null or colon. Also process ^ and \ abbreviations. */ p = ptr; r = ret; while ((c = *p++) && c != ':' && c != '\n') { if (c == '^') { c = *p++; if (c == '?') c = 0177; else c &= 037; } else if (c == '\\') { c = *p++; if (c >= '0' && c <= '7') { c -= '0'; size = 0; while (++size < 3 && (c1 = *p) >= '0' && c1 <= '7') { c *= 8; c += c1 - '0'; p++; } } else if (c >= 0100 && c < 0200) { c1 = esctab[(c & ~040) - 0100]; if (c1 != ' ') c = c1; } } *r++ = c; } *r = '\0'; /* Update *AREA. */ if (area) *area = r + 1; return ret; } /* Outputting a string with padding. */ short ospeed; /* If OSPEED is 0, we use this as the actual baud rate. */ int tputs_baud_rate; char PC; /* Actual baud rate if positive; - baud rate / 100 if negative. */ static int speeds[] = { #ifdef VMS 0, 50, 75, 110, 134, 150, -3, -6, -12, -18, -20, -24, -36, -48, -72, -96, -192 #else /* not VMS */ 0, 50, 75, 110, 135, 150, -2, -3, -6, -12, -18, -24, -48, -96, -192, -288, -384, -576, -1152 #endif /* not VMS */ }; void tputs (str, nlines, outfun) register char *str; int nlines; register int (*outfun) (); { register int padcount = 0; register int speed; #ifdef emacs extern baud_rate; speed = baud_rate; /* For quite high speeds, convert to the smaller units to avoid overflow. */ if (speed > 10000) speed = - speed / 100; #else if (ospeed == 0) speed = tputs_baud_rate; else speed = speeds[ospeed]; #endif if (!str) return; while (*str >= '0' && *str <= '9') { padcount += *str++ - '0'; padcount *= 10; } if (*str == '.') { str++; padcount += *str++ - '0'; } if (*str == '*') { str++; padcount *= nlines; } while (*str) (*outfun) (*str++); /* PADCOUNT is now in units of tenths of msec. SPEED is measured in characters per 10 seconds or in characters per .1 seconds (if negative). We use the smaller units for larger speeds to avoid overflow. */ padcount *= speed; padcount += 500; padcount /= 1000; if (speed < 0) padcount = -padcount; else { padcount += 50; padcount /= 100; } while (padcount-- > 0) (*outfun) (PC); } /* Finding the termcap entry in the termcap data base. */ struct buffer { char *beg; int size; char *ptr; int ateof; int full; }; /* Forward declarations of static functions. */ static int scan_file (); static char *gobble_line (); static int compare_contin (); static int name_match (); #ifdef VMS #include #include #include static int valid_filename_p (fn) char *fn; { struct FAB fab = cc$rms_fab; struct NAM nam = cc$rms_nam; char esa[NAM$C_MAXRSS]; fab.fab$l_fna = fn; fab.fab$b_fns = strlen(fn); fab.fab$l_nam = &nam; fab.fab$l_fop = FAB$M_NAM; nam.nam$l_esa = esa; nam.nam$b_ess = sizeof esa; return SYS$PARSE(&fab, 0, 0) == RMS$_NORMAL; } #else /* !VMS */ #ifdef MSDOS /* MW, May 1993 */ static int valid_filename_p (fn) char *fn; { return *fn == '/' || fn[1] == ':'; } #else #define valid_filename_p(fn) (*(fn) == '/') #endif #endif /* !VMS */ /* Find the termcap entry data for terminal type NAME and store it in the block that BP points to. Record its address for future use. If BP is null, space is dynamically allocated. Return -1 if there is some difficulty accessing the data base of terminal types, 0 if the data base is accessible but the type NAME is not defined in it, and some other value otherwise. */ int tgetent (bp, name) char *bp, *name; { register char *termcap_name; register int fd; struct buffer buf; register char *bp1; char *bp2; char *term; int malloc_size = 0; register int c; char *tcenv; /* TERMCAP value, if it contains :tc=. */ char *indirect = NULL; /* Terminal type in :tc= in TERMCAP value. */ int filep; #ifdef INTERNAL_TERMINAL /* For the internal terminal we don't want to read any termcap file, so fake it. */ if (!strcmp (name, "internal")) { term = INTERNAL_TERMINAL; if (!bp) { malloc_size = 1 + strlen (term); bp = (char *) xmalloc (malloc_size); } strcpy (bp, term); goto ret; } #endif /* INTERNAL_TERMINAL */ /* For compatibility with programs like `less' that want to put data in the termcap buffer themselves as a fallback. */ if (bp) term_entry = bp; termcap_name = getenv ("TERMCAP"); if (termcap_name && *termcap_name == '\0') termcap_name = NULL; #if defined (MSDOS) && !defined (TEST) if (termcap_name && (*termcap_name == '\\' || *termcap_name == '/' || termcap_name[1] == ':')) dostounix_filename(termcap_name); #endif filep = termcap_name && valid_filename_p (termcap_name); /* If termcap_name is non-null and starts with / (in the un*x case, that is), it is a file name to use instead of /etc/termcap. If it is non-null and does not start with /, it is the entry itself, but only if the name the caller requested matches the TERM variable. */ if (termcap_name && !filep && !strcmp (name, getenv ("TERM"))) { indirect = tgetst1 (find_capability (termcap_name, "tc"), (char **) 0); if (!indirect) { if (!bp) bp = termcap_name; else strcpy (bp, termcap_name); goto ret; } else { /* It has tc=. Need to read /etc/termcap. */ tcenv = termcap_name; termcap_name = NULL; } } if (!termcap_name || !filep) termcap_name = TERMCAP_FILE; /* Here we know we must search a file and termcap_name has its name. */ #ifdef MSDOS fd = open (termcap_name, O_RDONLY|O_TEXT, 0); #else fd = open (termcap_name, O_RDONLY, 0); #endif if (fd < 0) return -1; buf.size = BUFSIZE; /* Add 1 to size to ensure room for terminating null. */ buf.beg = (char *) xmalloc (buf.size + 1); term = indirect ? indirect : name; if (!bp) { malloc_size = indirect ? strlen (tcenv) + 1 : buf.size; bp = (char *) xmalloc (malloc_size); } bp1 = bp; if (indirect) /* Copy the data from the environment variable. */ { strcpy (bp, tcenv); bp1 += strlen (tcenv); } while (term) { /* Scan the file, reading it via buf, till find start of main entry. */ if (scan_file (term, fd, &buf) == 0) { close (fd); free (buf.beg); if (malloc_size) free (bp); return 0; } /* Free old `term' if appropriate. */ if (term != name) free (term); /* If BP is malloc'd by us, make sure it is big enough. */ if (malloc_size) { malloc_size = bp1 - bp + buf.size; termcap_name = (char *) xrealloc (bp, malloc_size); bp1 += termcap_name - bp; bp = termcap_name; } bp2 = bp1; /* Copy the line of the entry from buf into bp. */ termcap_name = buf.ptr; while ((*bp1++ = c = *termcap_name++) && c != '\n') /* Drop out any \ newline sequence. */ if (c == '\\' && *termcap_name == '\n') { bp1--; termcap_name++; } *bp1 = '\0'; /* Does this entry refer to another terminal type's entry? If something is found, copy it into heap and null-terminate it. */ term = tgetst1 (find_capability (bp2, "tc"), (char **) 0); } close (fd); free (buf.beg); if (malloc_size) bp = (char *) xrealloc (bp, bp1 - bp + 1); ret: term_entry = bp; return 1; } /* Given file open on FD and buffer BUFP, scan the file from the beginning until a line is found that starts the entry for terminal type STR. Return 1 if successful, with that line in BUFP, or 0 if no entry is found in the file. */ static int scan_file (str, fd, bufp) char *str; int fd; register struct buffer *bufp; { register char *end; bufp->ptr = bufp->beg; bufp->full = 0; bufp->ateof = 0; *bufp->ptr = '\0'; lseek (fd, 0L, 0); while (!bufp->ateof) { /* Read a line into the buffer. */ end = NULL; do { /* if it is continued, append another line to it, until a non-continued line ends. */ end = gobble_line (fd, bufp, end); } while (!bufp->ateof && end[-2] == '\\'); if (*bufp->ptr != '#' && name_match (bufp->ptr, str)) return 1; /* Discard the line just processed. */ bufp->ptr = end; } return 0; } /* Return nonzero if NAME is one of the names specified by termcap entry LINE. */ static int name_match (line, name) char *line, *name; { register char *tem; if (!compare_contin (line, name)) return 1; /* This line starts an entry. Is it the right one? */ for (tem = line; *tem && *tem != '\n' && *tem != ':'; tem++) if (*tem == '|' && !compare_contin (tem + 1, name)) return 1; return 0; } static int compare_contin (str1, str2) register char *str1, *str2; { register int c1, c2; while (1) { c1 = *str1++; c2 = *str2++; while (c1 == '\\' && *str1 == '\n') { str1++; while ((c1 = *str1++) == ' ' || c1 == '\t'); } if (c2 == '\0') { /* End of type being looked up. */ if (c1 == '|' || c1 == ':') /* If end of name in data base, we win. */ return 0; else return 1; } else if (c1 != c2) return 1; } } /* Make sure that the buffer <- BUFP contains a full line of the file open on FD, starting at the place BUFP->ptr points to. Can read more of the file, discard stuff before BUFP->ptr, or make the buffer bigger. Return the pointer to after the newline ending the line, or to the end of the file, if there is no newline to end it. Can also merge on continuation lines. If APPEND_END is non-null, it points past the newline of a line that is continued; we add another line onto it and regard the whole thing as one line. The caller decides when a line is continued. */ static char * gobble_line (fd, bufp, append_end) int fd; register struct buffer *bufp; char *append_end; { register char *end; register int nread; register char *buf = bufp->beg; register char *tem; if (!append_end) append_end = bufp->ptr; while (1) { end = append_end; while (*end && *end != '\n') end++; if (*end) break; if (bufp->ateof) return buf + bufp->full; if (bufp->ptr == buf) { if (bufp->full == bufp->size) { bufp->size *= 2; /* Add 1 to size to ensure room for terminating null. */ tem = (char *) xrealloc (buf, bufp->size + 1); bufp->ptr = (bufp->ptr - buf) + tem; append_end = (append_end - buf) + tem; bufp->beg = buf = tem; } } else { append_end -= bufp->ptr - buf; bcopy (bufp->ptr, buf, bufp->full -= bufp->ptr - buf); bufp->ptr = buf; } if (!(nread = read (fd, buf + bufp->full, bufp->size - bufp->full))) bufp->ateof = 1; bufp->full += nread; buf[bufp->full] = '\0'; } return end + 1; } #ifdef TEST #ifdef NULL #undef NULL #endif #include main (argc, argv) int argc; char **argv; { char *term; char *buf; term = argv[1]; printf ("TERM: %s\n", term); buf = (char *) tgetent (0, term); if ((int) buf <= 0) { printf ("No entry.\n"); return 0; } printf ("Entry: %s\n", buf); tprint ("cm"); tprint ("AL"); printf ("co: %d\n", tgetnum ("co")); printf ("am: %d\n", tgetflag ("am")); } tprint (cap) char *cap; { char *x = tgetstr (cap, 0); register char *y; printf ("%s: ", cap); if (x) { for (y = x; *y; y++) if (*y <= ' ' || *y == 0177) printf ("\\%0o", *y); else putchar (*y); free (x); } else printf ("none"); putchar ('\n'); } #endif /* TEST */ emacs-19.30/src/terminfo.c100444 12241 12 3265 5444474625 14246 0ustar rolandstaff/* Interface from Emacs to terminfo. 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 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. */ /* Define these variables that serve as global parameters to termcap, so that we do not need to conditionalize the places in Emacs that set them. */ char *UP, *BC, PC; short ospeed; static buffer[512]; /* Interface to curses/terminfo library. Turns out that all of the terminfo-level routines look like their termcap counterparts except for tparm, which replaces tgoto. Not only is the calling sequence different, but the string format is different too. */ char * tparam (string, outstring, len, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) char *string; char *outstring; int arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9; { char *temp; extern char *tparm(); temp = tparm (string, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9); if (outstring == 0) outstring = ((char *) (malloc ((strlen (temp)) + 1))); strcpy (outstring, temp); return outstring; } emacs-19.30/src/textprop.c100444 12120 1 137040 6052445103 13764 0ustar rmsdaemon/* Interface code for dealing with text properties. Copyright (C) 1993, 1994, 1995 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. */ #include #include "lisp.h" #include "intervals.h" #include "buffer.h" #include "window.h" #ifndef NULL #define NULL (void *)0 #endif /* Test for membership, allowing for t (actually any non-cons) to mean the universal set. */ #define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set)) /* NOTES: previous- and next- property change will have to skip zero-length intervals if they are implemented. This could be done inside next_interval and previous_interval. set_properties needs to deal with the interval property cache. It is assumed that for any interval plist, a property appears only once on the list. Although some code i.e., remove_properties, handles the more general case, the uniqueness of properties is necessary for the system to remain consistent. This requirement is enforced by the subrs installing properties onto the intervals. */ /* The rest of the file is within this conditional */ #ifdef USE_TEXT_PROPERTIES /* Types of hooks. */ Lisp_Object Qmouse_left; Lisp_Object Qmouse_entered; Lisp_Object Qpoint_left; Lisp_Object Qpoint_entered; Lisp_Object Qcategory; Lisp_Object Qlocal_map; /* Visual properties text (including strings) may have. */ Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple; Lisp_Object Qinvisible, Qread_only, Qintangible; /* Sticky properties */ Lisp_Object Qfront_sticky, Qrear_nonsticky; /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to the o1's cdr. Otherwise, return zero. This is handy for traversing plists. */ #define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCONS (o1)->cdr, CONSP (o2))) Lisp_Object Vinhibit_point_motion_hooks; Lisp_Object Vdefault_text_properties; /* verify_interval_modification saves insertion hooks here to be run later by report_interval_modification. */ Lisp_Object interval_insert_behind_hooks; Lisp_Object interval_insert_in_front_hooks; /* Extract the interval at the position pointed to by BEGIN from OBJECT, a string or buffer. Additionally, check that the positions pointed to by BEGIN and END are within the bounds of OBJECT, and reverse them if *BEGIN is greater than *END. The objects pointed to by BEGIN and END may be integers or markers; if the latter, they are coerced to integers. When OBJECT is a string, we increment *BEGIN and *END to make them origin-one. Note that buffer points don't correspond to interval indices. For example, point-max is 1 greater than the index of the last character. This difference is handled in the caller, which uses the validated points to determine a length, and operates on that. Exceptions are Ftext_properties_at, Fnext_property_change, and Fprevious_property_change which call this function with BEGIN == END. Handle this case specially. If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise, create an interval tree for OBJECT if one doesn't exist, provided the object actually contains text. In the current design, if there is no text, there can be no text properties. */ #define soft 0 #define hard 1 static INTERVAL validate_interval_range (object, begin, end, force) Lisp_Object object, *begin, *end; int force; { register INTERVAL i; int searchpos; CHECK_STRING_OR_BUFFER (object, 0); CHECK_NUMBER_COERCE_MARKER (*begin, 0); CHECK_NUMBER_COERCE_MARKER (*end, 0); /* If we are asked for a point, but from a subr which operates on a range, then return nothing. */ if (EQ (*begin, *end) && begin != end) return NULL_INTERVAL; if (XINT (*begin) > XINT (*end)) { Lisp_Object n; n = *begin; *begin = *end; *end = n; } if (BUFFERP (object)) { register struct buffer *b = XBUFFER (object); if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end) && XINT (*end) <= BUF_ZV (b))) args_out_of_range (*begin, *end); i = BUF_INTERVALS (b); /* If there's no text, there are no properties. */ if (BUF_BEGV (b) == BUF_ZV (b)) return NULL_INTERVAL; searchpos = XINT (*begin); } else { register struct Lisp_String *s = XSTRING (object); if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end) && XINT (*end) <= s->size)) args_out_of_range (*begin, *end); /* User-level Positions in strings start with 0, but the interval code always wants positions starting with 1. */ XSETFASTINT (*begin, XFASTINT (*begin) + 1); if (begin != end) XSETFASTINT (*end, XFASTINT (*end) + 1); i = s->intervals; if (s->size == 0) return NULL_INTERVAL; searchpos = XINT (*begin); } if (NULL_INTERVAL_P (i)) return (force ? create_root_interval (object) : i); return find_interval (i, searchpos); } /* Validate LIST as a property list. If LIST is not a list, then make one consisting of (LIST nil). Otherwise, verify that LIST is even numbered and thus suitable as a plist. */ static Lisp_Object validate_plist (list) Lisp_Object list; { if (NILP (list)) return Qnil; if (CONSP (list)) { register int i; register Lisp_Object tail; for (i = 0, tail = list; !NILP (tail); i++) { tail = Fcdr (tail); QUIT; } if (i & 1) error ("Odd length text property list"); return list; } return Fcons (list, Fcons (Qnil, Qnil)); } /* Return nonzero if interval I has all the properties, with the same values, of list PLIST. */ static int interval_has_all_properties (plist, i) Lisp_Object plist; INTERVAL i; { register Lisp_Object tail1, tail2, sym1, sym2; register int found; /* Go through each element of PLIST. */ for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) { sym1 = Fcar (tail1); found = 0; /* Go through I's plist, looking for sym1 */ for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) if (EQ (sym1, Fcar (tail2))) { /* Found the same property on both lists. If the values are unequal, return zero. */ if (! EQ (Fcar (Fcdr (tail1)), Fcar (Fcdr (tail2)))) return 0; /* Property has same value on both lists; go to next one. */ found = 1; break; } if (! found) return 0; } return 1; } /* Return nonzero if the plist of interval I has any of the properties of PLIST, regardless of their values. */ static INLINE int interval_has_some_properties (plist, i) Lisp_Object plist; INTERVAL i; { register Lisp_Object tail1, tail2, sym; /* Go through each element of PLIST. */ for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) { sym = Fcar (tail1); /* Go through i's plist, looking for tail1 */ for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) if (EQ (sym, Fcar (tail2))) return 1; } return 0; } /* Changing the plists of individual intervals. */ /* Return the value of PROP in property-list PLIST, or Qunbound if it has none. */ static Lisp_Object property_value (plist, prop) Lisp_Object plist, prop; { Lisp_Object value; while (PLIST_ELT_P (plist, value)) if (EQ (XCONS (plist)->car, prop)) return XCONS (value)->car; else plist = XCONS (value)->cdr; return Qunbound; } /* Set the properties of INTERVAL to PROPERTIES, and record undo info for the previous values. OBJECT is the string or buffer that INTERVAL belongs to. */ static void set_properties (properties, interval, object) Lisp_Object properties, object; INTERVAL interval; { Lisp_Object sym, value; if (BUFFERP (object)) { /* For each property in the old plist which is missing from PROPERTIES, or has a different value in PROPERTIES, make an undo record. */ for (sym = interval->plist; PLIST_ELT_P (sym, value); sym = XCONS (value)->cdr) 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, make an undo record binding it to nil, so it will be removed. */ for (sym = properties; PLIST_ELT_P (sym, value); 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); } } /* Store new properties. */ interval->plist = Fcopy_sequence (properties); } /* Add the properties of PLIST to the interval I, or set the value of I's property to the value of the property on PLIST if they are different. OBJECT should be the string or buffer the interval is in. Return nonzero if this changes I (i.e., if any members of PLIST are actually added to I's plist) */ static int add_properties (plist, i, object) Lisp_Object plist; INTERVAL i; Lisp_Object object; { Lisp_Object tail1, tail2, sym1, val1; register int changed = 0; register int found; struct gcpro gcpro1, gcpro2, gcpro3; tail1 = plist; sym1 = Qnil; val1 = Qnil; /* No need to protect OBJECT, because we can GC only in the case where it is a buffer, and live buffers are always protected. I and its plist are also protected, via OBJECT. */ GCPRO3 (tail1, sym1, val1); /* Go through each element of PLIST. */ for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) { sym1 = Fcar (tail1); val1 = Fcar (Fcdr (tail1)); found = 0; /* Go through I's plist, looking for sym1 */ for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) if (EQ (sym1, Fcar (tail2))) { /* No need to gcpro, because tail2 protects this and it must be a cons cell (we get an error otherwise). */ register Lisp_Object this_cdr; this_cdr = Fcdr (tail2); /* Found the property. Now check its value. */ found = 1; /* The properties have the same value on both lists. Continue to the next property. */ if (EQ (val1, Fcar (this_cdr))) break; /* Record this change in the buffer, for undo purposes. */ if (BUFFERP (object)) { 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); } /* I's property has a different value -- change it */ Fsetcar (this_cdr, val1); changed++; break; } if (! found) { /* Record this change in the buffer, for undo purposes. */ if (BUFFERP (object)) { 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)); changed++; } } UNGCPRO; return changed; } /* For any members of PLIST which are properties of I, remove them from I's plist. OBJECT is the string or buffer containing I. */ static int remove_properties (plist, i, object) Lisp_Object plist; INTERVAL i; Lisp_Object object; { register Lisp_Object tail1, tail2, sym, current_plist; register int changed = 0; current_plist = i->plist; /* Go through each element of plist. */ for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) { sym = Fcar (tail1); /* First, remove the symbol if its at the head of the list */ while (! NILP (current_plist) && EQ (sym, Fcar (current_plist))) { if (BUFFERP (object)) { 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); } current_plist = Fcdr (Fcdr (current_plist)); changed++; } /* Go through i's plist, looking for sym */ tail2 = current_plist; while (! NILP (tail2)) { register Lisp_Object this; this = Fcdr (Fcdr (tail2)); if (EQ (sym, Fcar (this))) { if (BUFFERP (object)) { 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); } Fsetcdr (Fcdr (tail2), Fcdr (Fcdr (this))); changed++; } tail2 = this; } } if (changed) i->plist = current_plist; return changed; } #if 0 /* Remove all properties from interval I. Return non-zero if this changes the interval. */ static INLINE int erase_properties (i) INTERVAL i; { if (NILP (i->plist)) return 0; i->plist = Qnil; return 1; } #endif DEFUN ("text-properties-at", Ftext_properties_at, Stext_properties_at, 1, 2, 0, "Return the list of properties held by the character at POSITION\n\ in optional argument OBJECT, a string or buffer. If nil, OBJECT\n\ defaults to the current buffer.\n\ If POSITION is at the end of OBJECT, the value is nil.") (pos, object) Lisp_Object pos, object; { register INTERVAL i; if (NILP (object)) XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &pos, &pos, soft); if (NULL_INTERVAL_P (i)) return Qnil; /* If POS is at the end of the interval, it means it's the end of OBJECT. There are no properties at the very end, since no character follows. */ if (XINT (pos) == LENGTH (i) + i->position) return Qnil; return i->plist; } DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0, "Return the value of position POS's property PROP, in OBJECT.\n\ OBJECT is optional and defaults to the current buffer.\n\ If POSITION is at the end of OBJECT, the value is nil.") (pos, prop, object) Lisp_Object pos, object; Lisp_Object prop; { return textget (Ftext_properties_at (pos, object), prop); } DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0, "Return the value of position POS's property PROP, in OBJECT.\n\ OBJECT is optional and defaults to the current buffer.\n\ If POS is at the end of OBJECT, the value is nil.\n\ If OBJECT is a buffer, then overlay properties are considered as well as\n\ text properties.\n\ If OBJECT is a window, then that window's buffer is used, but window-specific\n\ overlays are considered only if they are associated with OBJECT.") (pos, prop, object) Lisp_Object pos, object; register Lisp_Object prop; { struct window *w = 0; CHECK_NUMBER_COERCE_MARKER (pos, 0); if (NILP (object)) XSETBUFFER (object, current_buffer); if (WINDOWP (object)) { w = XWINDOW (object); object = w->buffer; } if (BUFFERP (object)) { int posn = XINT (pos); int noverlays; Lisp_Object *overlay_vec, tem; int next_overlay; int len; struct buffer *obuf = current_buffer; set_buffer_temp (XBUFFER (object)); /* First try with room for 40 overlays. */ len = 40; overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); noverlays = overlays_at (posn, 0, &overlay_vec, &len, &next_overlay, NULL); /* If there are more than 40, make enough space for all, and try again. */ if (noverlays > len) { len = noverlays; overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); noverlays = overlays_at (posn, 0, &overlay_vec, &len, &next_overlay, NULL); } noverlays = sort_overlays (overlay_vec, noverlays, w); set_buffer_temp (obuf); /* Now check the overlays in order of decreasing priority. */ while (--noverlays >= 0) { tem = Foverlay_get (overlay_vec[noverlays], prop); if (!NILP (tem)) return (tem); } } /* Not a buffer, or no appropriate overlay, so fall through to the simpler case. */ return (Fget_text_property (pos, prop, object)); } DEFUN ("next-property-change", Fnext_property_change, Snext_property_change, 1, 3, 0, "Return the position of next property change.\n\ Scans characters forward from POS in OBJECT till it finds\n\ a change in some text property, then returns the position of the change.\n\ The optional second argument OBJECT is the string or buffer to scan.\n\ Return nil if the property is constant all the way to the end of OBJECT.\n\ If the value is non-nil, it is a position greater than POS, never equal.\n\n\ If the optional third argument LIMIT is non-nil, don't search\n\ past position LIMIT; return LIMIT if nothing is found before LIMIT.") (pos, object, limit) Lisp_Object pos, object, limit; { register INTERVAL i, next; if (NILP (object)) XSETBUFFER (object, current_buffer); if (! NILP (limit) && ! EQ (limit, Qt)) CHECK_NUMBER_COERCE_MARKER (limit, 0); i = validate_interval_range (object, &pos, &pos, soft); /* If LIMIT is t, return start of next interval--don't bother checking further intervals. */ if (EQ (limit, Qt)) { if (NULL_INTERVAL_P (i)) next = i; else next = next_interval (i); if (NULL_INTERVAL_P (next)) XSETFASTINT (pos, (STRINGP (object) ? XSTRING (object)->size : BUF_ZV (XBUFFER (object)))); else XSETFASTINT (pos, next->position - (STRINGP (object))); return pos; } if (NULL_INTERVAL_P (i)) return limit; next = next_interval (i); while (! NULL_INTERVAL_P (next) && intervals_equal (i, next) && (NILP (limit) || next->position < XFASTINT (limit))) next = next_interval (next); if (NULL_INTERVAL_P (next)) return limit; if (! NILP (limit) && !(next->position < XFASTINT (limit))) return limit; XSETFASTINT (pos, next->position - (STRINGP (object))); return pos; } /* Return 1 if there's a change in some property between BEG and END. */ int property_change_between_p (beg, end) int beg, end; { register INTERVAL i, next; Lisp_Object object, pos; XSETBUFFER (object, current_buffer); XSETFASTINT (pos, beg); i = validate_interval_range (object, &pos, &pos, soft); if (NULL_INTERVAL_P (i)) return 0; next = next_interval (i); while (! NULL_INTERVAL_P (next) && intervals_equal (i, next)) { next = next_interval (next); if (NULL_INTERVAL_P (next)) return 0; if (next->position >= end) return 0; } if (NULL_INTERVAL_P (next)) return 0; return 1; } DEFUN ("next-single-property-change", Fnext_single_property_change, Snext_single_property_change, 2, 4, 0, "Return the position of next property change for a specific property.\n\ Scans characters forward from POS till it finds\n\ a change in the PROP property, then returns the position of the change.\n\ The optional third argument OBJECT is the string or buffer to scan.\n\ The property values are compared with `eq'.\n\ Return nil if the property is constant all the way to the end of OBJECT.\n\ If the value is non-nil, it is a position greater than POS, never equal.\n\n\ If the optional fourth argument LIMIT is non-nil, don't search\n\ past position LIMIT; return LIMIT if nothing is found before LIMIT.") (pos, prop, object, limit) Lisp_Object pos, prop, object, limit; { register INTERVAL i, next; register Lisp_Object here_val; if (NILP (object)) XSETBUFFER (object, current_buffer); if (!NILP (limit)) CHECK_NUMBER_COERCE_MARKER (limit, 0); i = validate_interval_range (object, &pos, &pos, soft); if (NULL_INTERVAL_P (i)) return limit; here_val = textget (i->plist, prop); next = next_interval (i); while (! NULL_INTERVAL_P (next) && EQ (here_val, textget (next->plist, prop)) && (NILP (limit) || next->position < XFASTINT (limit))) next = next_interval (next); if (NULL_INTERVAL_P (next)) return limit; if (! NILP (limit) && !(next->position < XFASTINT (limit))) return limit; XSETFASTINT (pos, next->position - (STRINGP (object))); return pos; } DEFUN ("previous-property-change", Fprevious_property_change, Sprevious_property_change, 1, 3, 0, "Return the position of previous property change.\n\ Scans characters backwards from POS in OBJECT till it finds\n\ a change in some text property, then returns the position of the change.\n\ The optional second argument OBJECT is the string or buffer to scan.\n\ Return nil if the property is constant all the way to the start of OBJECT.\n\ If the value is non-nil, it is a position less than POS, never equal.\n\n\ If the optional third argument LIMIT is non-nil, don't search\n\ back past position LIMIT; return LIMIT if nothing is found until LIMIT.") (pos, object, limit) Lisp_Object pos, object, limit; { register INTERVAL i, previous; if (NILP (object)) XSETBUFFER (object, current_buffer); if (!NILP (limit)) CHECK_NUMBER_COERCE_MARKER (limit, 0); i = validate_interval_range (object, &pos, &pos, soft); if (NULL_INTERVAL_P (i)) return limit; /* Start with the interval containing the char before point. */ if (i->position == XFASTINT (pos)) i = previous_interval (i); previous = previous_interval (i); while (! NULL_INTERVAL_P (previous) && intervals_equal (previous, i) && (NILP (limit) || previous->position + LENGTH (previous) > XFASTINT (limit))) previous = previous_interval (previous); if (NULL_INTERVAL_P (previous)) return limit; if (!NILP (limit) && !(previous->position + LENGTH (previous) > XFASTINT (limit))) return limit; XSETFASTINT (pos, (previous->position + LENGTH (previous) - (STRINGP (object)))); return pos; } DEFUN ("previous-single-property-change", Fprevious_single_property_change, Sprevious_single_property_change, 2, 4, 0, "Return the position of previous property change for a specific property.\n\ Scans characters backward from POS till it finds\n\ a change in the PROP property, then returns the position of the change.\n\ The optional third argument OBJECT is the string or buffer to scan.\n\ The property values are compared with `eq'.\n\ Return nil if the property is constant all the way to the start of OBJECT.\n\ If the value is non-nil, it is a position less than POS, never equal.\n\n\ If the optional fourth argument LIMIT is non-nil, don't search\n\ back past position LIMIT; return LIMIT if nothing is found until LIMIT.") (pos, prop, object, limit) Lisp_Object pos, prop, object, limit; { register INTERVAL i, previous; register Lisp_Object here_val; if (NILP (object)) XSETBUFFER (object, current_buffer); if (!NILP (limit)) CHECK_NUMBER_COERCE_MARKER (limit, 0); i = validate_interval_range (object, &pos, &pos, soft); /* Start with the interval containing the char before point. */ if (! NULL_INTERVAL_P (i) && i->position == XFASTINT (pos)) i = previous_interval (i); if (NULL_INTERVAL_P (i)) return limit; here_val = textget (i->plist, prop); previous = previous_interval (i); while (! NULL_INTERVAL_P (previous) && EQ (here_val, textget (previous->plist, prop)) && (NILP (limit) || previous->position + LENGTH (previous) > XFASTINT (limit))) previous = previous_interval (previous); if (NULL_INTERVAL_P (previous)) return limit; if (!NILP (limit) && !(previous->position + LENGTH (previous) > XFASTINT (limit))) return limit; XSETFASTINT (pos, (previous->position + LENGTH (previous) - (STRINGP (object)))); return pos; } /* Callers note, this can GC when OBJECT is a buffer (or nil). */ DEFUN ("add-text-properties", Fadd_text_properties, Sadd_text_properties, 3, 4, 0, "Add properties to the text from START to END.\n\ The third argument PROPS is a property list\n\ specifying the property values to add.\n\ The optional fourth argument, OBJECT,\n\ is the string or buffer containing the text.\n\ Return t if any property value actually changed, nil otherwise.") (start, end, properties, object) Lisp_Object start, end, properties, object; { register INTERVAL i, unchanged; register int s, len, modified = 0; struct gcpro gcpro1; properties = validate_plist (properties); if (NILP (properties)) return Qnil; if (NILP (object)) XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &start, &end, hard); if (NULL_INTERVAL_P (i)) return Qnil; s = XINT (start); len = XINT (end) - s; /* No need to protect OBJECT, because we GC only if it's a buffer, and live buffers are always protected. */ GCPRO1 (properties); /* If we're not starting on an interval boundary, we have to split this interval. */ if (i->position != s) { /* If this interval already has the properties, we can skip it. */ if (interval_has_all_properties (properties, i)) { int got = (LENGTH (i) - (s - i->position)); if (got >= len) return Qnil; len -= got; i = next_interval (i); } else { unchanged = i; i = split_interval_right (unchanged, s - unchanged->position); copy_properties (unchanged, i); } } /* We are at the beginning of interval I, with LEN chars to scan. */ for (;;) { if (i == 0) abort (); if (LENGTH (i) >= len) { /* We can UNGCPRO safely here, because there will be just one more chance to gc, in the next call to add_properties, and after that we will not need PROPERTIES or OBJECT again. */ UNGCPRO; if (interval_has_all_properties (properties, i)) return modified ? Qt : Qnil; if (LENGTH (i) == len) { add_properties (properties, i, object); return Qt; } /* 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); return Qt; } len -= LENGTH (i); modified += add_properties (properties, i, object); i = next_interval (i); } } /* Callers note, this can GC when OBJECT is a buffer (or nil). */ DEFUN ("put-text-property", Fput_text_property, Sput_text_property, 4, 5, 0, "Set one property of the text from START to END.\n\ The third and fourth arguments PROP and VALUE\n\ specify the property to add.\n\ The optional fifth argument, OBJECT,\n\ is the string or buffer containing the text.") (start, end, prop, value, object) Lisp_Object start, end, prop, value, object; { Fadd_text_properties (start, end, Fcons (prop, Fcons (value, Qnil)), object); return Qnil; } DEFUN ("set-text-properties", Fset_text_properties, Sset_text_properties, 3, 4, 0, "Completely replace properties of text from START to END.\n\ The third argument PROPS is the new property list.\n\ The optional fourth argument, OBJECT,\n\ is the string or buffer containing the text.") (start, end, props, object) Lisp_Object start, end, props, object; { register INTERVAL i, unchanged; register INTERVAL prev_changed = NULL_INTERVAL; register int s, len; Lisp_Object ostart, oend; ostart = start; oend = end; props = validate_plist (props); if (NILP (object)) XSETBUFFER (object, current_buffer); /* If we want no properties for a whole string, get rid of its intervals. */ if (NILP (props) && STRINGP (object) && XFASTINT (start) == 0 && XFASTINT (end) == XSTRING (object)->size) { XSTRING (object)->intervals = 0; return Qt; } i = validate_interval_range (object, &start, &end, soft); if (NULL_INTERVAL_P (i)) { /* If buffer has no props, and we want none, return now. */ if (NILP (props)) return Qnil; /* Restore the original START and END values because validate_interval_range increments them for strings. */ start = ostart; end = oend; i = validate_interval_range (object, &start, &end, hard); /* This can return if start == end. */ if (NULL_INTERVAL_P (i)) return Qnil; } s = XINT (start); len = XINT (end) - s; if (i->position != s) { 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; } set_properties (props, i, object); if (LENGTH (i) == len) return Qt; prev_changed = i; len -= LENGTH (i); i = next_interval (i); } /* We are starting at the beginning of an interval, I */ while (len > 0) { if (i == 0) abort (); if (LENGTH (i) >= len) { if (LENGTH (i) > len) i = split_interval_left (i, len); /* We have to call set_properties even if we are going to merge the intervals, so as to make the undo records and cause redisplay to happen. */ set_properties (props, i, object); if (!NULL_INTERVAL_P (prev_changed)) merge_interval_left (i); return Qt; } len -= LENGTH (i); /* We have to call set_properties even if we are going to merge the intervals, so as to make the undo records and cause redisplay to happen. */ set_properties (props, i, object); if (NULL_INTERVAL_P (prev_changed)) prev_changed = i; else prev_changed = i = merge_interval_left (i); i = next_interval (i); } return Qt; } DEFUN ("remove-text-properties", Fremove_text_properties, Sremove_text_properties, 3, 4, 0, "Remove some properties from text from START to END.\n\ The third argument PROPS is a property list\n\ whose property names specify the properties to remove.\n\ \(The values stored in PROPS are ignored.)\n\ The optional fourth argument, OBJECT,\n\ is the string or buffer containing the text.\n\ Return t if any property was actually removed, nil otherwise.") (start, end, props, object) Lisp_Object start, end, props, object; { register INTERVAL i, unchanged; register int s, len, modified = 0; if (NILP (object)) XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &start, &end, soft); if (NULL_INTERVAL_P (i)) return Qnil; s = XINT (start); len = XINT (end) - s; if (i->position != s) { /* No properties on this first interval -- return if it covers the entire region. */ if (! interval_has_some_properties (props, i)) { int got = (LENGTH (i) - (s - i->position)); if (got >= len) return Qnil; len -= got; i = next_interval (i); } /* Split away the beginning of this interval; what we don't want to modify. */ else { unchanged = i; i = split_interval_right (unchanged, s - unchanged->position); copy_properties (unchanged, i); } } /* We are at the beginning of an interval, with len to scan */ for (;;) { if (i == 0) abort (); if (LENGTH (i) >= len) { if (! interval_has_some_properties (props, i)) return modified ? Qt : Qnil; if (LENGTH (i) == len) { remove_properties (props, i, object); return Qt; } /* 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); return Qt; } len -= LENGTH (i); modified += remove_properties (props, i, object); i = next_interval (i); } } 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)) XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &start, &end, soft); if (NULL_INTERVAL_P (i)) return (!NILP (value) || EQ (start, end) ? Qnil : start); 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 - (STRINGP (object))); } 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)) XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &start, &end, soft); if (NULL_INTERVAL_P (i)) return (NILP (value) || EQ (start, end)) ? Qnil : start; 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 - (STRINGP (object))); } i = next_interval (i); } return Qnil; } #if 0 /* You can use set-text-properties for this. */ DEFUN ("erase-text-properties", Ferase_text_properties, Serase_text_properties, 2, 3, 0, "Remove all properties from the text from START to END.\n\ The optional third argument, OBJECT,\n\ is the string or buffer containing the text.") (start, end, object) Lisp_Object start, end, object; { register INTERVAL i; register INTERVAL prev_changed = NULL_INTERVAL; register int s, len, modified; if (NILP (object)) XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &start, &end, soft); if (NULL_INTERVAL_P (i)) return Qnil; s = XINT (start); len = XINT (end) - s; if (i->position != s) { register int got; register INTERVAL unchanged = i; /* If there are properties here, then this text will be modified. */ if (! NILP (i->plist)) { i = split_interval_right (unchanged, s - unchanged->position); i->plist = Qnil; modified++; if (LENGTH (i) > len) { i = split_interval_right (i, len); copy_properties (unchanged, i); return Qt; } if (LENGTH (i) == len) return Qt; got = LENGTH (i); } /* If the text of I is without any properties, and contains LEN or more characters, then we may return without changing anything.*/ else if (LENGTH (i) - (s - i->position) <= len) return Qnil; /* The amount of text to change extends past I, so just note how much we've gotten. */ else got = LENGTH (i) - (s - i->position); len -= got; prev_changed = i; i = next_interval (i); } /* We are starting at the beginning of an interval, I. */ while (len > 0) { if (LENGTH (i) >= len) { /* If I has no properties, simply merge it if possible. */ if (NILP (i->plist)) { if (! NULL_INTERVAL_P (prev_changed)) merge_interval_left (i); return modified ? Qt : Qnil; } if (LENGTH (i) > len) i = split_interval_left (i, len); if (! NULL_INTERVAL_P (prev_changed)) merge_interval_left (i); else i->plist = Qnil; return Qt; } /* Here if we still need to erase past the end of I */ len -= LENGTH (i); if (NULL_INTERVAL_P (prev_changed)) { modified += erase_properties (i); prev_changed = i; } else { modified += ! NILP (i->plist); /* Merging I will give it the properties of PREV_CHANGED. */ prev_changed = i = merge_interval_left (i); } i = next_interval (i); } return modified ? Qt : Qnil; } #endif /* 0 */ /* I don't think this is the right interface to export; how often do you want to do something like this, other than when you're copying objects around? I think it would be better to have a pair of functions, one which returns the text properties of a region as a list of ranges and plists, and another which applies such a list to another object. */ /* Add properties from SRC to SRC of SRC, starting at POS in DEST. SRC and DEST may each refer to strings or buffers. Optional sixth argument PROP causes only that property to be copied. Properties are copied to DEST as if by `add-text-properties'. Return t if any property value actually changed, nil otherwise. */ /* Note this can GC when DEST is a buffer. */ Lisp_Object copy_text_properties (start, end, src, pos, dest, prop) Lisp_Object start, end, src, pos, dest, prop; { INTERVAL i; Lisp_Object res; Lisp_Object stuff; Lisp_Object plist; int s, e, e2, p, len, modified = 0; struct gcpro gcpro1, gcpro2; i = validate_interval_range (src, &start, &end, soft); if (NULL_INTERVAL_P (i)) return Qnil; CHECK_NUMBER_COERCE_MARKER (pos, 0); { Lisp_Object dest_start, dest_end; dest_start = pos; XSETFASTINT (dest_end, XINT (dest_start) + (XINT (end) - XINT (start))); /* Apply this to a copy of pos; it will try to increment its arguments, which we don't want. */ validate_interval_range (dest, &dest_start, &dest_end, soft); } s = XINT (start); e = XINT (end); p = XINT (pos); stuff = Qnil; while (s < e) { e2 = i->position + LENGTH (i); if (e2 > e) e2 = e; len = e2 - s; plist = i->plist; if (! NILP (prop)) while (! NILP (plist)) { if (EQ (Fcar (plist), prop)) { plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil)); break; } plist = Fcdr (Fcdr (plist)); } if (! NILP (plist)) { /* Must defer modifications to the interval tree in case src and dest refer to the same string or buffer. */ stuff = Fcons (Fcons (make_number (p), Fcons (make_number (p + len), Fcons (plist, Qnil))), stuff); } i = next_interval (i); if (NULL_INTERVAL_P (i)) break; p += len; s = i->position; } GCPRO2 (stuff, dest); while (! NILP (stuff)) { res = Fcar (stuff); res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)), Fcar (Fcdr (Fcdr (res))), dest); if (! NILP (res)) modified++; stuff = Fcdr (stuff); } UNGCPRO; return modified ? Qt : Qnil; } /* Call the modification hook functions in LIST, each with START and END. */ static void call_mod_hooks (list, start, end) Lisp_Object list, start, end; { struct gcpro gcpro1; GCPRO1 (list); while (!NILP (list)) { call2 (Fcar (list), start, end); list = Fcdr (list); } UNGCPRO; } /* Check for read-only intervals and signal an error if we find one. Then check for any modification hooks in the range START up to (but not including) END. Create a list of all these hooks in lexicographic order, eliminating consecutive extra copies of the same hook. Then call those hooks in order, with START and END - 1 as arguments. */ void verify_interval_modification (buf, start, end) struct buffer *buf; int start, end; { register INTERVAL intervals = BUF_INTERVALS (buf); register INTERVAL i, prev; Lisp_Object hooks; register Lisp_Object prev_mod_hooks; Lisp_Object mod_hooks; struct gcpro gcpro1; hooks = Qnil; prev_mod_hooks = Qnil; mod_hooks = Qnil; interval_insert_behind_hooks = Qnil; interval_insert_in_front_hooks = Qnil; if (NULL_INTERVAL_P (intervals)) return; if (start > end) { int temp = start; start = end; end = temp; } /* For an insert operation, check the two chars around the position. */ if (start == end) { INTERVAL prev; Lisp_Object before, after; /* Set I to the interval containing the char after START, and PREV to the interval containing the char before START. Either one may be null. They may be equal. */ i = find_interval (intervals, start); if (start == BUF_BEGV (buf)) prev = 0; else if (i->position == start) prev = previous_interval (i); else if (i->position < start) prev = i; if (start == BUF_ZV (buf)) i = 0; /* If Vinhibit_read_only is set and is not a list, we can skip the read_only checks. */ if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only)) { /* If I and PREV differ we need to check for the read-only property together with its stickyness. If either I or PREV are 0, this check is all we need. We have to take special care, since read-only may be indirectly defined via the category property. */ if (i != prev) { if (! NULL_INTERVAL_P (i)) { after = textget (i->plist, Qread_only); /* If interval I is read-only and read-only is front-sticky, inhibit insertion. Check for read-only as well as category. */ if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only))) { Lisp_Object tem; tem = textget (i->plist, Qfront_sticky); if (TMEM (Qread_only, tem) || (NILP (Fplist_get (i->plist, Qread_only)) && TMEM (Qcategory, tem))) error ("Attempt to insert within read-only text"); } } if (! NULL_INTERVAL_P (prev)) { before = textget (prev->plist, Qread_only); /* If interval PREV is read-only and read-only isn't rear-nonsticky, inhibit insertion. Check for read-only as well as category. */ if (! NILP (before) && NILP (Fmemq (before, Vinhibit_read_only))) { Lisp_Object tem; tem = textget (prev->plist, Qrear_nonsticky); if (! TMEM (Qread_only, tem) && (! NILP (Fplist_get (prev->plist,Qread_only)) || ! TMEM (Qcategory, tem))) error ("Attempt to insert within read-only text"); } } } else if (! NULL_INTERVAL_P (i)) { after = textget (i->plist, Qread_only); /* If interval I is read-only and read-only is front-sticky, inhibit insertion. Check for read-only as well as category. */ if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only))) { Lisp_Object tem; tem = textget (i->plist, Qfront_sticky); if (TMEM (Qread_only, tem) || (NILP (Fplist_get (i->plist, Qread_only)) && TMEM (Qcategory, tem))) error ("Attempt to insert within read-only text"); tem = textget (prev->plist, Qrear_nonsticky); if (! TMEM (Qread_only, tem) && (! NILP (Fplist_get (prev->plist, Qread_only)) || ! TMEM (Qcategory, tem))) error ("Attempt to insert within read-only text"); } } } /* Run both insert hooks (just once if they're the same). */ if (!NULL_INTERVAL_P (prev)) interval_insert_behind_hooks = textget (prev->plist, Qinsert_behind_hooks); if (!NULL_INTERVAL_P (i)) interval_insert_in_front_hooks = textget (i->plist, Qinsert_in_front_hooks); } else { /* Loop over intervals on or next to START...END, collecting their hooks. */ i = find_interval (intervals, start); do { if (! INTERVAL_WRITABLE_P (i)) error ("Attempt to modify read-only text"); mod_hooks = textget (i->plist, Qmodification_hooks); if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks)) { hooks = Fcons (mod_hooks, hooks); prev_mod_hooks = mod_hooks; } i = next_interval (i); } /* Keep going thru the interval containing the char before END. */ while (! NULL_INTERVAL_P (i) && i->position < end); GCPRO1 (hooks); hooks = Fnreverse (hooks); while (! EQ (hooks, Qnil)) { call_mod_hooks (Fcar (hooks), make_number (start), make_number (end)); hooks = Fcdr (hooks); } UNGCPRO; } } /* Run the interval hooks for an insertion. verify_interval_modification chose which hooks to run; this function is called after the insertion happens so it can indicate the range of inserted text. */ void report_interval_modification (start, end) Lisp_Object start, end; { if (! NILP (interval_insert_behind_hooks)) call_mod_hooks (interval_insert_behind_hooks, make_number (start), make_number (end)); if (! NILP (interval_insert_in_front_hooks) && ! EQ (interval_insert_in_front_hooks, interval_insert_behind_hooks)) call_mod_hooks (interval_insert_in_front_hooks, make_number (start), make_number (end)); } void syms_of_textprop () { DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties, "Property-list used as default values.\n\ The value of a property in this list is seen as the value for every\n\ character that does not have its own value for that property."); Vdefault_text_properties = Qnil; DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks, "If non-nil, don't run `point-left' and `point-entered' text properties.\n\ This also inhibits the use of the `intangible' text property."); Vinhibit_point_motion_hooks = Qnil; staticpro (&interval_insert_behind_hooks); staticpro (&interval_insert_in_front_hooks); interval_insert_behind_hooks = Qnil; interval_insert_in_front_hooks = Qnil; /* Common attributes one might give text */ staticpro (&Qforeground); Qforeground = intern ("foreground"); staticpro (&Qbackground); Qbackground = intern ("background"); staticpro (&Qfont); Qfont = intern ("font"); staticpro (&Qstipple); Qstipple = intern ("stipple"); staticpro (&Qunderline); Qunderline = intern ("underline"); staticpro (&Qread_only); Qread_only = intern ("read-only"); staticpro (&Qinvisible); Qinvisible = intern ("invisible"); staticpro (&Qintangible); Qintangible = intern ("intangible"); staticpro (&Qcategory); Qcategory = intern ("category"); staticpro (&Qlocal_map); Qlocal_map = intern ("local-map"); staticpro (&Qfront_sticky); Qfront_sticky = intern ("front-sticky"); staticpro (&Qrear_nonsticky); Qrear_nonsticky = intern ("rear-nonsticky"); /* Properties that text might use to specify certain actions */ staticpro (&Qmouse_left); Qmouse_left = intern ("mouse-left"); staticpro (&Qmouse_entered); Qmouse_entered = intern ("mouse-entered"); staticpro (&Qpoint_left); Qpoint_left = intern ("point-left"); staticpro (&Qpoint_entered); Qpoint_entered = intern ("point-entered"); defsubr (&Stext_properties_at); defsubr (&Sget_text_property); defsubr (&Sget_char_property); defsubr (&Snext_property_change); defsubr (&Snext_single_property_change); defsubr (&Sprevious_property_change); defsubr (&Sprevious_single_property_change); defsubr (&Sadd_text_properties); defsubr (&Sput_text_property); 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); */ } #else lose -- this shouldn't be compiled if USE_TEXT_PROPERTIES isn't defined #endif /* USE_TEXT_PROPERTIES */ emacs-19.30/src/tparam.c100444 21570 1 16516 6022167013 13327 0ustar djmdaemon/* Merge parameters into a termcap entry string. Copyright (C) 1985, 87, 93, 95 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* Emacs config.h may rename various library functions such as malloc. */ #ifdef HAVE_CONFIG_H #include #endif #ifndef emacs #if defined(HAVE_STRING_H) || defined(STDC_HEADERS) #define bcopy(s, d, n) memcpy ((d), (s), (n)) #endif #ifdef STDC_HEADERS #include #include #else char *malloc (); char *realloc (); #endif #endif /* not emacs */ #ifndef NULL #define NULL (char *) 0 #endif #ifndef emacs static void memory_out () { write (2, "virtual memory exhausted\n", 25); exit (1); } static char * xmalloc (size) unsigned size; { register char *tem = malloc (size); if (!tem) memory_out (); return tem; } static char * xrealloc (ptr, size) char *ptr; unsigned size; { register char *tem = realloc (ptr, size); if (!tem) memory_out (); return tem; } #endif /* not emacs */ /* Assuming STRING is the value of a termcap string entry containing `%' constructs to expand parameters, merge in parameter values and store result in block OUTSTRING points to. LEN is the length of OUTSTRING. If more space is needed, a block is allocated with `malloc'. The value returned is the address of the resulting string. This may be OUTSTRING or may be the address of a block got with `malloc'. In the latter case, the caller must free the block. The fourth and following args to tparam serve as the parameter values. */ static char *tparam1 (); /* VARARGS 2 */ char * tparam (string, outstring, len, arg0, arg1, arg2, arg3) char *string; char *outstring; int len; int arg0, arg1, arg2, arg3; { int arg[4]; arg[0] = arg0; arg[1] = arg1; arg[2] = arg2; arg[3] = arg3; return tparam1 (string, outstring, len, NULL, NULL, arg); } char *BC; char *UP; static char tgoto_buf[50]; char * tgoto (cm, hpos, vpos) char *cm; int hpos, vpos; { int args[2]; if (!cm) return NULL; args[0] = vpos; args[1] = hpos; return tparam1 (cm, tgoto_buf, 50, UP, BC, args); } static char * tparam1 (string, outstring, len, up, left, argp) char *string; char *outstring; int len; char *up, *left; register int *argp; { register int c; register char *p = string; register char *op = outstring; char *outend; int outlen = 0; register int tem; int *old_argp = argp; int doleft = 0; int doup = 0; outend = outstring + len; while (1) { /* If the buffer might be too short, make it bigger. */ if (op + 5 >= outend) { register char *new; if (outlen == 0) { outlen = len + 40; new = (char *) xmalloc (outlen); outend += 40; bcopy (outstring, new, op - outstring); } else { outend += outlen; outlen *= 2; new = (char *) xrealloc (outstring, outlen); } op += new - outstring; outend += new - outstring; outstring = new; } c = *p++; if (!c) break; if (c == '%') { c = *p++; tem = *argp; switch (c) { case 'd': /* %d means output in decimal. */ if (tem < 10) goto onedigit; if (tem < 100) goto twodigit; case '3': /* %3 means output in decimal, 3 digits. */ if (tem > 999) { *op++ = tem / 1000 + '0'; tem %= 1000; } *op++ = tem / 100 + '0'; case '2': /* %2 means output in decimal, 2 digits. */ twodigit: tem %= 100; *op++ = tem / 10 + '0'; onedigit: *op++ = tem % 10 + '0'; argp++; break; case 'C': /* For c-100: print quotient of value by 96, if nonzero, then do like %+. */ if (tem >= 96) { *op++ = tem / 96; tem %= 96; } case '+': /* %+x means add character code of char x. */ tem += *p++; case '.': /* %. means output as character. */ if (left) { /* If want to forbid output of 0 and \n and \t, and this is one of them, increment it. */ while (tem == 0 || tem == '\n' || tem == '\t') { tem++; if (argp == old_argp) doup++, outend -= strlen (up); else doleft++, outend -= strlen (left); } } *op++ = tem ? tem : 0200; case 'f': /* %f means discard next arg. */ argp++; break; case 'b': /* %b means back up one arg (and re-use it). */ argp--; break; case 'r': /* %r means interchange following two args. */ argp[0] = argp[1]; argp[1] = tem; old_argp++; break; case '>': /* %>xy means if arg is > char code of x, */ if (argp[0] > *p++) /* then add char code of y to the arg, */ argp[0] += *p; /* and in any case don't output. */ p++; /* Leave the arg to be output later. */ break; case 'a': /* %a means arithmetic. */ /* Next character says what operation. Add or subtract either a constant or some other arg. */ /* First following character is + to add or - to subtract or = to assign. */ /* Next following char is 'p' and an arg spec (0100 plus position of that arg relative to this one) or 'c' and a constant stored in a character. */ tem = p[2] & 0177; if (p[1] == 'p') tem = argp[tem - 0100]; if (p[0] == '-') argp[0] -= tem; else if (p[0] == '+') argp[0] += tem; else if (p[0] == '*') argp[0] *= tem; else if (p[0] == '/') argp[0] /= tem; else argp[0] = tem; p += 3; break; case 'i': /* %i means add one to arg, */ argp[0] ++; /* and leave it to be output later. */ argp[1] ++; /* Increment the following arg, too! */ break; case '%': /* %% means output %; no arg. */ goto ordinary; case 'n': /* %n means xor each of next two args with 140. */ argp[0] ^= 0140; argp[1] ^= 0140; break; case 'm': /* %m means xor each of next two args with 177. */ argp[0] ^= 0177; argp[1] ^= 0177; break; case 'B': /* %B means express arg as BCD char code. */ argp[0] += 6 * (tem / 10); break; case 'D': /* %D means weird Delta Data transformation. */ argp[0] -= 2 * (tem % 16); break; } } else /* Ordinary character in the argument string. */ ordinary: *op++ = c; } *op = 0; while (doup-- > 0) strcat (op, up); while (doleft-- > 0) strcat (op, left); return outstring; } #ifdef DEBUG main (argc, argv) int argc; char **argv; { char buf[50]; int args[3]; args[0] = atoi (argv[2]); args[1] = atoi (argv[3]); args[2] = atoi (argv[4]); tparam1 (argv[1], buf, "LEFT", "UP", args); printf ("%s\n", buf); return 0; } #endif /* DEBUG */ emacs-19.30/src/undo.c100444 12120 1 32711 6005052054 13020 0ustar rmsdaemon/* undo handling for GNU Emacs. Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY. No author or distributor accepts responsibility to anyone for the consequences of using it or for whether it serves any particular purpose or works at all, unless he says so in writing. Refer to the GNU Emacs General Public License for full details. Everyone is granted permission to copy, modify and redistribute GNU Emacs, but only under the conditions described in the GNU Emacs General Public License. A copy of this license is supposed to have been given to you along with GNU Emacs so you can know your rights and responsibilities. It should be in a file named COPYING. Among other things, the copyright notice and this notice must be preserved on all copies. */ #include #include "lisp.h" #include "buffer.h" #include "commands.h" /* Last buffer for which undo information was recorded. */ Lisp_Object last_undo_buffer; Lisp_Object Qinhibit_read_only; /* The first time a command records something for undo. it also allocates the undo-boundary object which will be added to the list at the end of the command. This ensures we can't run out of space while trying to make an undo-boundary. */ Lisp_Object pending_boundary; /* Record an insertion that just happened or is about to happen, for LENGTH characters at position BEG. (It is possible to record an insertion before or after the fact because we don't need to record the contents.) */ record_insert (beg, length) int beg, length; { Lisp_Object lbeg, lend; if (EQ (current_buffer->undo_list, Qt)) return; /* Allocate a cons cell to be the undo boundary after this command. */ if (NILP (pending_boundary)) pending_boundary = Fcons (Qnil, Qnil); if (current_buffer != XBUFFER (last_undo_buffer)) Fundo_boundary (); XSETBUFFER (last_undo_buffer, current_buffer); if (MODIFF <= SAVE_MODIFF) record_first_change (); /* If this is following another insertion and consecutive with it in the buffer, combine the two. */ if (CONSP (current_buffer->undo_list)) { Lisp_Object elt; elt = XCONS (current_buffer->undo_list)->car; if (CONSP (elt) && INTEGERP (XCONS (elt)->car) && INTEGERP (XCONS (elt)->cdr) && XINT (XCONS (elt)->cdr) == beg) { XSETINT (XCONS (elt)->cdr, beg + length); return; } } XSETFASTINT (lbeg, beg); XSETINT (lend, beg + length); current_buffer->undo_list = Fcons (Fcons (lbeg, lend), current_buffer->undo_list); } /* Record that a deletion is about to take place, for LENGTH characters at location BEG. */ record_delete (beg, length) int beg, length; { Lisp_Object lbeg, lend, sbeg; int at_boundary; if (EQ (current_buffer->undo_list, Qt)) return; /* Allocate a cons cell to be the undo boundary after this command. */ if (NILP (pending_boundary)) pending_boundary = Fcons (Qnil, Qnil); if (current_buffer != XBUFFER (last_undo_buffer)) Fundo_boundary (); XSETBUFFER (last_undo_buffer, current_buffer); at_boundary = (CONSP (current_buffer->undo_list) && NILP (XCONS (current_buffer->undo_list)->car)); if (MODIFF <= SAVE_MODIFF) record_first_change (); if (point == beg + length) XSETINT (sbeg, -beg); else XSETFASTINT (sbeg, beg); XSETFASTINT (lbeg, beg); XSETFASTINT (lend, beg + length); /* If we are just after an undo boundary, and point wasn't at start of deleted range, record where it was. */ if (at_boundary && last_point_position != XFASTINT (sbeg) && current_buffer == XBUFFER (last_point_position_buffer)) current_buffer->undo_list = Fcons (make_number (last_point_position), current_buffer->undo_list); current_buffer->undo_list = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg), current_buffer->undo_list); } /* Record that a replacement is about to take place, for LENGTH characters at location BEG. The replacement does not change the number of characters. */ record_change (beg, length) int beg, length; { record_delete (beg, length); record_insert (beg, length); } /* Record that an unmodified buffer is about to be changed. Record the file modification date so that when undoing this entry we can tell whether it is obsolete because the file was saved again. */ record_first_change () { Lisp_Object high, low; struct buffer *base_buffer = current_buffer; if (EQ (current_buffer->undo_list, Qt)) return; if (current_buffer != XBUFFER (last_undo_buffer)) Fundo_boundary (); XSETBUFFER (last_undo_buffer, current_buffer); if (base_buffer->base_buffer) base_buffer = base_buffer->base_buffer; XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff); XSETFASTINT (low, base_buffer->modtime & 0xffff); current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list); } /* Record a change in property PROP (whose old value was VAL) for LENGTH characters starting at position BEG in BUFFER. */ record_property_change (beg, length, prop, value, buffer) int beg, length; Lisp_Object prop, value, buffer; { Lisp_Object lbeg, lend, entry; struct buffer *obuf = current_buffer; int boundary = 0; if (EQ (XBUFFER (buffer)->undo_list, Qt)) return; /* Allocate a cons cell to be the undo boundary after this command. */ if (NILP (pending_boundary)) pending_boundary = Fcons (Qnil, Qnil); if (!EQ (buffer, last_undo_buffer)) boundary = 1; last_undo_buffer = buffer; /* Switch temporarily to the buffer that was changed. */ current_buffer = XBUFFER (buffer); if (boundary) Fundo_boundary (); if (MODIFF <= SAVE_MODIFF) record_first_change (); XSETINT (lbeg, beg); XSETINT (lend, beg + length); entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend)))); current_buffer->undo_list = Fcons (entry, current_buffer->undo_list); current_buffer = obuf; } DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0, "Mark a boundary between units of undo.\n\ An undo command will stop at this point,\n\ but another undo command will undo to the previous boundary.") () { Lisp_Object tem; if (EQ (current_buffer->undo_list, Qt)) return Qnil; tem = Fcar (current_buffer->undo_list); if (!NILP (tem)) { /* One way or another, cons nil onto the front of the undo list. */ if (!NILP (pending_boundary)) { /* If we have preallocated the cons cell to use here, use that one. */ XCONS (pending_boundary)->cdr = current_buffer->undo_list; current_buffer->undo_list = pending_boundary; pending_boundary = Qnil; } else current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list); } return Qnil; } /* At garbage collection time, make an undo list shorter at the end, returning the truncated list. MINSIZE and MAXSIZE are the limits on size allowed, as described below. In practice, these are the values of undo-limit and undo-strong-limit. */ Lisp_Object truncate_undo_list (list, minsize, maxsize) Lisp_Object list; int minsize, maxsize; { Lisp_Object prev, next, last_boundary; int size_so_far = 0; prev = Qnil; next = list; last_boundary = Qnil; /* Always preserve at least the most recent undo record. If the first element is an undo boundary, skip past it. Skip, skip, skip the undo, skip, skip, skip the undo, Skip, skip, skip the undo, skip to the undo bound'ry. (Get it? "Skip to my Loo?") */ if (CONSP (next) && NILP (XCONS (next)->car)) { /* Add in the space occupied by this element and its chain link. */ size_so_far += sizeof (struct Lisp_Cons); /* Advance to next element. */ prev = next; next = XCONS (next)->cdr; } while (CONSP (next) && ! NILP (XCONS (next)->car)) { Lisp_Object elt; elt = XCONS (next)->car; /* Add in the space occupied by this element and its chain link. */ size_so_far += sizeof (struct Lisp_Cons); if (CONSP (elt)) { size_so_far += sizeof (struct Lisp_Cons); if (STRINGP (XCONS (elt)->car)) size_so_far += (sizeof (struct Lisp_String) - 1 + XSTRING (XCONS (elt)->car)->size); } /* Advance to next element. */ prev = next; next = XCONS (next)->cdr; } if (CONSP (next)) last_boundary = prev; while (CONSP (next)) { Lisp_Object elt; elt = XCONS (next)->car; /* When we get to a boundary, decide whether to truncate either before or after it. The lower threshold, MINSIZE, tells us to truncate after it. If its size pushes past the higher threshold MAXSIZE as well, we truncate before it. */ if (NILP (elt)) { if (size_so_far > maxsize) break; last_boundary = prev; if (size_so_far > minsize) break; } /* Add in the space occupied by this element and its chain link. */ size_so_far += sizeof (struct Lisp_Cons); if (CONSP (elt)) { size_so_far += sizeof (struct Lisp_Cons); if (STRINGP (XCONS (elt)->car)) size_so_far += (sizeof (struct Lisp_String) - 1 + XSTRING (XCONS (elt)->car)->size); } /* Advance to next element. */ prev = next; next = XCONS (next)->cdr; } /* If we scanned the whole list, it is short enough; don't change it. */ if (NILP (next)) return list; /* Truncate at the boundary where we decided to truncate. */ if (!NILP (last_boundary)) { XCONS (last_boundary)->cdr = Qnil; return list; } else return Qnil; } DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0, "Undo N records from the front of the list LIST.\n\ Return what remains of the list.") (n, list) Lisp_Object n, list; { struct gcpro gcpro1, gcpro2; Lisp_Object next; int count = specpdl_ptr - specpdl; register int arg; #if 0 /* This is a good feature, but would make undo-start unable to do what is expected. */ Lisp_Object tem; /* If the head of the list is a boundary, it is the boundary preceding this command. Get rid of it and don't count it. */ tem = Fcar (list); if (NILP (tem)) list = Fcdr (list); #endif CHECK_NUMBER (n, 0); arg = XINT (n); next = Qnil; GCPRO2 (next, list); /* Don't let read-only properties interfere with undo. */ if (NILP (current_buffer->read_only)) specbind (Qinhibit_read_only, Qt); while (arg > 0) { while (1) { next = Fcar (list); list = Fcdr (list); /* Exit inner loop at undo boundary. */ if (NILP (next)) break; /* Handle an integer by setting point to that value. */ if (INTEGERP (next)) SET_PT (clip_to_bounds (BEGV, XINT (next), ZV)); else if (CONSP (next)) { Lisp_Object car, cdr; car = Fcar (next); cdr = Fcdr (next); if (EQ (car, Qt)) { /* Element (t high . low) records previous modtime. */ Lisp_Object high, low; int mod_time; struct buffer *base_buffer = current_buffer; high = Fcar (cdr); low = Fcdr (cdr); mod_time = (XFASTINT (high) << 16) + XFASTINT (low); if (current_buffer->base_buffer) base_buffer = current_buffer->base_buffer; /* If this records an obsolete save (not matching the actual disk file) then don't mark unmodified. */ if (mod_time != base_buffer->modtime) continue; #ifdef CLASH_DETECTION Funlock_buffer (); #endif /* CLASH_DETECTION */ Fset_buffer_modified_p (Qnil); } #ifdef USE_TEXT_PROPERTIES else if (EQ (car, Qnil)) { /* Element (nil prop val beg . end) is property change. */ Lisp_Object beg, end, prop, val; prop = Fcar (cdr); cdr = Fcdr (cdr); val = Fcar (cdr); cdr = Fcdr (cdr); beg = Fcar (cdr); end = Fcdr (cdr); Fput_text_property (beg, end, prop, val, Qnil); } #endif /* USE_TEXT_PROPERTIES */ else if (INTEGERP (car) && INTEGERP (cdr)) { /* Element (BEG . END) means range was inserted. */ Lisp_Object end; if (XINT (car) < BEGV || XINT (cdr) > ZV) error ("Changes to be undone are outside visible portion of buffer"); /* Set point first thing, so that undoing this undo does not send point back to where it is now. */ Fgoto_char (car); Fdelete_region (car, cdr); } else if (STRINGP (car) && INTEGERP (cdr)) { /* Element (STRING . POS) means STRING was deleted. */ Lisp_Object membuf; int pos = XINT (cdr); membuf = car; if (pos < 0) { if (-pos < BEGV || -pos > ZV) error ("Changes to be undone are outside visible portion of buffer"); SET_PT (-pos); Finsert (1, &membuf); } else { if (pos < BEGV || pos > ZV) error ("Changes to be undone are outside visible portion of buffer"); SET_PT (pos); /* Insert before markers so that if the mark is currently on the boundary of this deletion, it ends up on the other side of the now-undeleted text from point. Since undo doesn't even keep track of the mark, this isn't really necessary, but it may lead to better behavior in certain situations. */ Finsert_before_markers (1, &membuf); SET_PT (pos); } } } } arg--; } UNGCPRO; return unbind_to (count, list); } syms_of_undo () { Qinhibit_read_only = intern ("inhibit-read-only"); staticpro (&Qinhibit_read_only); pending_boundary = Qnil; staticpro (&pending_boundary); defsubr (&Sprimitive_undo); defsubr (&Sundo_boundary); } emacs-19.30/src/unexaix.c100444 75424 1 56017 5770115140 13747 0ustar kwzhdaemon/* Modified by Andrew.Vignaux@comp.vuw.ac.nz to get it to work :-) */ /* Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. In other words, you are welcome to use, share and improve this program. You are forbidden to forbid anyone else to use, share and improve what you give them. Help stamp out software-hoarding! */ /* * unexec.c - Convert a running program into an a.out file. * * Author: Spencer W. Thomas * Computer Science Dept. * University of Utah * Date: Tue Mar 2 1982 * Modified heavily since then. * * Synopsis: * unexec (new_name, a_name, data_start, bss_start, entry_address) * char *new_name, *a_name; * unsigned data_start, bss_start, entry_address; * * Takes a snapshot of the program and makes an a.out format file in the * file named by the string argument new_name. * If a_name is non-NULL, the symbol table will be taken from the given file. * On some machines, an existing a_name file is required. * * The boundaries within the a.out file may be adjusted with the data_start * and bss_start arguments. Either or both may be given as 0 for defaults. * * Data_start gives the boundary between the text segment and the data * segment of the program. The text segment can contain shared, read-only * program code and literal data, while the data segment is always unshared * and unprotected. Data_start gives the lowest unprotected address. * The value you specify may be rounded down to a suitable boundary * as required by the machine you are using. * * Specifying zero for data_start means the boundary between text and data * should not be the same as when the program was loaded. * If NO_REMAP is defined, the argument data_start is ignored and the * segment boundaries are never changed. * * Bss_start indicates how much of the data segment is to be saved in the * a.out file and restored when the program is executed. It gives the lowest * unsaved address, and is rounded up to a page boundary. The default when 0 * is given assumes that the entire data segment is to be stored, including * the previous data and bss as well as any additional storage allocated with * break (2). * * The new file is set up to start at entry_address. * * If you make improvements I'd like to get them too. * harpo!utah-cs!thomas, thomas@Utah-20 * */ /* There are several compilation parameters affecting unexec: * COFF Define this if your system uses COFF for executables. Otherwise we assume you use Berkeley format. * NO_REMAP Define this if you do not want to try to save Emacs's pure data areas as part of the text segment. Saving them as text is good because it allows users to share more. However, on machines that locate the text area far from the data area, the boundary cannot feasibly be moved. Such machines require NO_REMAP. Also, remapping can cause trouble with the built-in startup routine /lib/crt0.o, which defines `environ' as an initialized variable. Dumping `environ' as pure does not work! So, to use remapping, you must write a startup routine for your machine in Emacs's crt0.c. If NO_REMAP is defined, Emacs uses the system's crt0.o. * SECTION_ALIGNMENT Some machines that use COFF executables require that each section start on a certain boundary *in the COFF file*. Such machines should define SECTION_ALIGNMENT to a mask of the low-order bits that must be zero on such a boundary. This mask is used to control padding between segments in the COFF file. If SECTION_ALIGNMENT is not defined, the segments are written consecutively with no attempt at alignment. This is right for unmodified system V. * SEGMENT_MASK Some machines require that the beginnings and ends of segments *in core* be on certain boundaries. For most machines, a page boundary is sufficient. That is the default. When a larger boundary is needed, define SEGMENT_MASK to a mask of the bits that must be zero on such a boundary. * A_TEXT_OFFSET(HDR) Some machines count the a.out header as part of the size of the text segment (a_text); they may actually load the header into core as the first data in the text segment. Some have additional padding between the header and the real text of the program that is counted in a_text. For these machines, define A_TEXT_OFFSET(HDR) to examine the header structure HDR and return the number of bytes to add to `a_text' before writing it (above and beyond the number of bytes of actual program text). HDR's standard fields are already correct, except that this adjustment to the `a_text' field has not yet been made; thus, the amount of offset can depend on the data in the file. * A_TEXT_SEEK(HDR) If defined, this macro specifies the number of bytes to seek into the a.out file before starting to write the text segment.a * EXEC_MAGIC For machines using COFF, this macro, if defined, is a value stored into the magic number field of the output file. * ADJUST_EXEC_HEADER This macro can be used to generate statements to adjust or initialize nonstandard fields in the file header * ADDR_CORRECT(ADDR) Macro to correct an int which is the bit pattern of a pointer to a byte into an int which is the number of a byte. This macro has a default definition which is usually right. This default definition is a no-op on most machines (where a pointer looks like an int) but not on all machines. */ #define XCOFF #define COFF #define NO_REMAP #ifndef emacs #define PERROR(arg) perror (arg); return -1 #else #include #define PERROR(file) report_error (file, new) #endif #include /* Define getpagesize () if the system does not. Note that this may depend on symbols defined in a.out.h */ #include "getpagesize.h" #ifndef makedev /* Try to detect types.h already loaded */ #include #endif #include #include #include extern char *start_of_text (); /* Start of text */ extern char *start_of_data (); /* Start of initialized data */ extern int _data; extern int _edata; extern int _text; extern int _etext; extern int _end; #ifdef COFF #ifndef USG #ifndef STRIDE #ifndef UMAX #ifndef sun386 /* I have a suspicion that these are turned off on all systems and can be deleted. Try it in version 19. */ #include #include #include #include #endif /* not sun386 */ #endif /* not UMAX */ #endif /* Not STRIDE */ #endif /* not USG */ static long block_copy_start; /* Old executable start point */ static struct filehdr f_hdr; /* File header */ static struct aouthdr f_ohdr; /* Optional file header (a.out) */ long bias; /* Bias to add for growth */ long lnnoptr; /* Pointer to line-number info within file */ #define SYMS_START block_copy_start static long text_scnptr; static long data_scnptr; #ifdef XCOFF static long load_scnptr; static long orig_load_scnptr; static long orig_data_scnptr; #endif static long data_st; #ifndef MAX_SECTIONS #define MAX_SECTIONS 10 #endif #endif /* COFF */ static int pagemask; /* Correct an int which is the bit pattern of a pointer to a byte into an int which is the number of a byte. This is a no-op on ordinary machines, but not on all. */ #ifndef ADDR_CORRECT /* Let m-*.h files override this definition */ #define ADDR_CORRECT(x) ((char *)(x) - (char*)0) #endif #ifdef emacs #include "lisp.h" static report_error (file, fd) char *file; int fd; { if (fd) close (fd); report_file_error ("Cannot unexec", Fcons (build_string (file), Qnil)); } #endif /* emacs */ #define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1 #define ERROR1(msg,x) report_error_1 (new, msg, x, 0); return -1 #define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1 static report_error_1 (fd, msg, a1, a2) int fd; char *msg; int a1, a2; { close (fd); #ifdef emacs error (msg, a1, a2); #else fprintf (stderr, msg, a1, a2); fprintf (stderr, "\n"); #endif } static int make_hdr (); static void mark_x (); static int copy_text_and_data (); static int copy_sym (); /* **************************************************************** * unexec * * driving logic. */ unexec (new_name, a_name, data_start, bss_start, entry_address) char *new_name, *a_name; unsigned data_start, bss_start, entry_address; { int new, a_out = -1; if (a_name && (a_out = open (a_name, 0)) < 0) { PERROR (a_name); } if ((new = creat (new_name, 0666)) < 0) { PERROR (new_name); } if (make_hdr (new,a_out,data_start,bss_start,entry_address,a_name,new_name) < 0 || copy_text_and_data (new) < 0 || copy_sym (new, a_out, a_name, new_name) < 0 #ifdef COFF || adjust_lnnoptrs (new, a_out, new_name) < 0 #endif #ifdef XCOFF || unrelocate_symbols (new, a_out, a_name, new_name) < 0 #endif ) { close (new); /* unlink (new_name); /* Failed, unlink new a.out */ return -1; } close (new); if (a_out >= 0) close (a_out); mark_x (new_name); return 0; } /* **************************************************************** * make_hdr * * Make the header in the new a.out from the header in core. * Modify the text and data sizes. */ static int make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name) int new, a_out; unsigned data_start, bss_start, entry_address; char *a_name; char *new_name; { register int scns; unsigned int bss_end; struct scnhdr section[MAX_SECTIONS]; struct scnhdr * f_thdr; /* Text section header */ struct scnhdr * f_dhdr; /* Data section header */ struct scnhdr * f_bhdr; /* Bss section header */ struct scnhdr * f_lhdr; /* Loader section header */ struct scnhdr * f_tchdr; /* Typechk section header */ struct scnhdr * f_dbhdr; /* Debug section header */ struct scnhdr * f_xhdr; /* Except section header */ load_scnptr = orig_load_scnptr = lnnoptr = 0; pagemask = getpagesize () - 1; /* Adjust text/data boundary. */ #ifdef NO_REMAP data_start = (long) start_of_data (); #endif /* NO_REMAP */ data_start = ADDR_CORRECT (data_start); #ifdef SEGMENT_MASK data_start = data_start & ~SEGMENT_MASK; /* (Down) to segment boundary. */ #else data_start = data_start & ~pagemask; /* (Down) to page boundary. */ #endif bss_end = ADDR_CORRECT (sbrk (0)) + pagemask; bss_end &= ~ pagemask; /* Adjust data/bss boundary. */ if (bss_start != 0) { bss_start = (ADDR_CORRECT (bss_start) + pagemask); /* (Up) to page bdry. */ bss_start &= ~ pagemask; if (bss_start > bss_end) { ERROR1 ("unexec: Specified bss_start (%u) is past end of program", bss_start); } } else bss_start = bss_end; if (data_start > bss_start) /* Can't have negative data size. */ { ERROR2 ("unexec: data_start (%u) can't be greater than bss_start (%u)", data_start, bss_start); } #ifdef COFF /* Salvage as much info from the existing file as possible */ block_copy_start = 0; f_thdr = NULL; f_dhdr = NULL; f_bhdr = NULL; f_lhdr = NULL; f_tchdr = NULL; f_dbhdr = NULL; f_xhdr = NULL; if (a_out >= 0) { if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) { PERROR (a_name); } block_copy_start += sizeof (f_hdr); if (f_hdr.f_opthdr > 0) { if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) { PERROR (a_name); } block_copy_start += sizeof (f_ohdr); } if (f_hdr.f_nscns > MAX_SECTIONS) { ERROR0 ("unexec: too many section headers -- increase MAX_SECTIONS"); } /* Loop through section headers */ for (scns = 0; scns < f_hdr.f_nscns; scns++) { struct scnhdr *s = §ion[scns]; if (read (a_out, s, sizeof (*s)) != sizeof (*s)) { PERROR (a_name); } if (s->s_scnptr > 0L) { if (block_copy_start < s->s_scnptr + s->s_size) block_copy_start = s->s_scnptr + s->s_size; } #define CHECK_SCNHDR(ptr, name, flags) \ if (strcmp(s->s_name, name) == 0) { \ if (s->s_flags != flags) { \ fprintf(stderr, "unexec: %lx flags where %x expected in %s section.\n", \ (unsigned long)s->s_flags, flags, name); \ } \ if (ptr) { \ fprintf(stderr, "unexec: duplicate section header for section %s.\n", \ name); \ } \ ptr = s; \ } CHECK_SCNHDR(f_thdr, _TEXT, STYP_TEXT); CHECK_SCNHDR(f_dhdr, _DATA, STYP_DATA); CHECK_SCNHDR(f_bhdr, _BSS, STYP_BSS); CHECK_SCNHDR(f_lhdr, _LOADER, STYP_LOADER); CHECK_SCNHDR(f_dbhdr, _DEBUG, STYP_DEBUG); CHECK_SCNHDR(f_tchdr, _TYPCHK, STYP_TYPCHK); CHECK_SCNHDR(f_xhdr, _EXCEPT, STYP_EXCEPT); } if (f_thdr == 0) { ERROR1 ("unexec: couldn't find \"%s\" section", _TEXT); } if (f_dhdr == 0) { ERROR1 ("unexec: couldn't find \"%s\" section", _DATA); } if (f_bhdr == 0) { ERROR1 ("unexec: couldn't find \"%s\" section", _BSS); } } else { ERROR0 ("can't build a COFF file from scratch yet"); } orig_data_scnptr = f_dhdr->s_scnptr; orig_load_scnptr = f_lhdr ? f_lhdr->s_scnptr : 0; /* Now we alter the contents of all the f_*hdr variables to correspond to what we want to dump. */ f_hdr.f_flags |= (F_RELFLG | F_EXEC); /* Why? */ #ifdef EXEC_MAGIC f_ohdr.magic = EXEC_MAGIC; #endif #ifndef NO_REMAP f_ohdr.tsize = data_start - f_ohdr.text_start; f_ohdr.text_start = (long) start_of_text (); #endif f_ohdr.dsize = bss_start - ((unsigned) &_data); f_ohdr.bsize = bss_end - bss_start; f_dhdr->s_size = f_ohdr.dsize; f_bhdr->s_size = f_ohdr.bsize; f_bhdr->s_paddr = f_ohdr.dsize; f_bhdr->s_vaddr = f_ohdr.dsize; /* fix scnptr's */ { long ptr; for (scns = 0; scns < f_hdr.f_nscns; scns++) { struct scnhdr *s = §ion[scns]; if (scns == 0) ptr = s->s_scnptr; if (s->s_scnptr != 0) { s->s_scnptr = ptr; } if ((s->s_flags & 0xffff) == STYP_PAD) { /* * the text_start should probably be o_algntext but that doesn't * seem to change */ if (f_ohdr.text_start != 0) /* && scns != 0 */ { s->s_size = 512 - (s->s_scnptr % 512); if (s->s_size == 512) s->s_size = 0; } } ptr = ptr + s->s_size; } bias = ptr - block_copy_start; } /* fix other pointers */ for (scns = 0; scns < f_hdr.f_nscns; scns++) { struct scnhdr *s = §ion[scns]; if (s->s_relptr != 0) { s->s_relptr += bias; } if (s->s_lnnoptr != 0) { if (lnnoptr == 0) lnnoptr = s->s_lnnoptr; s->s_lnnoptr += bias; } } if (f_hdr.f_symptr > 0L) { f_hdr.f_symptr += bias; } data_st = data_start; text_scnptr = f_thdr->s_scnptr; data_scnptr = f_dhdr->s_scnptr; load_scnptr = f_lhdr ? f_lhdr->s_scnptr : 0; block_copy_start = orig_load_scnptr; #ifdef ADJUST_EXEC_HEADER ADJUST_EXEC_HEADER #endif /* ADJUST_EXEC_HEADER */ if (write (new, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) { PERROR (new_name); } if (f_hdr.f_opthdr > 0) { if (write (new, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) { PERROR (new_name); } } for (scns = 0; scns < f_hdr.f_nscns; scns++) { struct scnhdr *s = §ion[scns]; if (write (new, s, sizeof (*s)) != sizeof (*s)) { PERROR (new_name); } } return (0); #endif /* COFF */ } /* **************************************************************** * * Copy the text and data segments from memory to the new a.out */ static int copy_text_and_data (new) int new; { register char *end; register char *ptr; lseek (new, (long) text_scnptr, 0); ptr = start_of_text () + text_scnptr; end = ptr + f_ohdr.tsize; write_segment (new, ptr, end); lseek (new, (long) data_scnptr, 0); ptr = (char *) &_data; end = ptr + f_ohdr.dsize; write_segment (new, ptr, end); return 0; } write_segment (new, ptr, end) int new; register char *ptr, *end; { register int i, nwrite, ret; char buf[80]; extern int errno; char zeros[128]; bzero (zeros, sizeof zeros); for (i = 0; ptr < end;) { /* distance to next multiple of 128. */ nwrite = (((int) ptr + 128) & -128) - (int) ptr; /* But not beyond specified end. */ if (nwrite > end - ptr) nwrite = end - ptr; ret = write (new, ptr, nwrite); /* If write gets a page fault, it means we reached a gap between the old text segment and the old data segment. This gap has probably been remapped into part of the text segment. So write zeros for it. */ if (ret == -1 && errno == EFAULT) { write (new, zeros, nwrite); } else if (nwrite != ret) { sprintf (buf, "unexec write failure: addr 0x%lx, fileno %d, size 0x%x, wrote 0x%x, errno %d", (unsigned long)ptr, new, nwrite, ret, errno); PERROR (buf); } i += nwrite; ptr += nwrite; } } /* **************************************************************** * copy_sym * * Copy the relocation information and symbol table from the a.out to the new */ static int copy_sym (new, a_out, a_name, new_name) int new, a_out; char *a_name, *new_name; { char page[1024]; int n; if (a_out < 0) return 0; if (SYMS_START == 0L) return 0; if (lnnoptr && lnnoptr < SYMS_START) /* if there is line number info */ lseek (a_out, lnnoptr, 0); /* start copying from there */ else lseek (a_out, SYMS_START, 0); /* Position a.out to symtab. */ while ((n = read (a_out, page, sizeof page)) > 0) { if (write (new, page, n) != n) { PERROR (new_name); } } if (n < 0) { PERROR (a_name); } return 0; } /* **************************************************************** * mark_x * * After successfully building the new a.out, mark it executable */ static void mark_x (name) char *name; { struct stat sbuf; int um; int new = 0; /* for PERROR */ um = umask (777); umask (um); if (stat (name, &sbuf) == -1) { PERROR (name); } sbuf.st_mode |= 0111 & ~um; if (chmod (name, sbuf.st_mode) == -1) PERROR (name); } /* * If the COFF file contains a symbol table and a line number section, * then any auxiliary entries that have values for x_lnnoptr must * be adjusted by the amount that the line number section has moved * in the file (bias computed in make_hdr). The #@$%&* designers of * the auxiliary entry structures used the absolute file offsets for * the line number entry rather than an offset from the start of the * line number section! * * When I figure out how to scan through the symbol table and pick out * the auxiliary entries that need adjustment, this routine will * be fixed. As it is now, all such entries are wrong and sdb * will complain. Fred Fish, UniSoft Systems Inc. */ #ifdef COFF /* This function is probably very slow. Instead of reopening the new file for input and output it should copy from the old to the new using the two descriptors already open (WRITEDESC and READDESC). Instead of reading one small structure at a time it should use a reasonable size buffer. But I don't have time to work on such things, so I am installing it as submitted to me. -- RMS. */ adjust_lnnoptrs (writedesc, readdesc, new_name) int writedesc; int readdesc; char *new_name; { register int nsyms; register int naux; register int new; #ifdef amdahl_uts SYMENT symentry; AUXENT auxentry; #else struct syment symentry; union auxent auxentry; #endif if (!lnnoptr || !f_hdr.f_symptr) return 0; if ((new = open (new_name, 2)) < 0) { PERROR (new_name); return -1; } lseek (new, f_hdr.f_symptr, 0); for (nsyms = 0; nsyms < f_hdr.f_nsyms; nsyms++) { read (new, &symentry, SYMESZ); for (naux = 0; naux < symentry.n_numaux; naux++) { read (new, &auxentry, AUXESZ); nsyms++; if (ISFCN (symentry.n_type)) { auxentry.x_sym.x_fcnary.x_fcn.x_lnnoptr += bias; lseek (new, -AUXESZ, 1); write (new, &auxentry, AUXESZ); } } } close (new); } #endif /* COFF */ #ifdef XCOFF /* It is probably a false economy to optimise this routine (it used to read one LDREL and do do two lseeks per iteration) but the wrath of RMS (see above :-) would be too much to bear */ unrelocate_symbols (new, a_out, a_name, new_name) int new, a_out; char *a_name, *new_name; { register int i; register int l; register LDREL *ldrel; LDHDR ldhdr; LDREL ldrel_buf [20]; ulong t_start = (ulong) &_text; ulong d_start = (ulong) &_data; int * p; int dirty; if (load_scnptr == 0) return 0; lseek (a_out, orig_load_scnptr, 0); if (read (a_out, &ldhdr, sizeof (ldhdr)) != sizeof (ldhdr)) { PERROR (new_name); } #define SYMNDX_TEXT 0 #define SYMNDX_DATA 1 #define SYMNDX_BSS 2 l = 0; for (i = 0; i < ldhdr.l_nreloc; i++, l--, ldrel++) { if (l == 0) { lseek (a_out, orig_load_scnptr + LDHDRSZ + LDSYMSZ*ldhdr.l_nsyms + LDRELSZ*i, 0); l = ldhdr.l_nreloc - i; if (l > sizeof (ldrel_buf) / LDRELSZ) l = sizeof (ldrel_buf) / LDRELSZ; if (read (a_out, ldrel_buf, l * LDRELSZ) != l * LDRELSZ) { PERROR (a_name); } ldrel = ldrel_buf; } dirty = 0; /* this code may not be necessary */ /* I originally had == in the "assignment" and it still unrelocated */ /* move the BSS loader symbols to the DATA segment */ if (ldrel->l_rsecnm == f_ohdr.o_snbss) ldrel->l_rsecnm = f_ohdr.o_sndata, dirty++; if (ldrel->l_symndx == SYMNDX_BSS) ldrel->l_symndx = SYMNDX_DATA, dirty++; if (dirty) { lseek (new, load_scnptr + LDHDRSZ + LDSYMSZ*ldhdr.l_nsyms + LDRELSZ*i, 0); if (write (new, ldrel, LDRELSZ) != LDRELSZ) { PERROR (new_name); } } if (ldrel->l_rsecnm == f_ohdr.o_sndata) { int orig_int; #ifdef AIX4_1 lseek (a_out, orig_data_scnptr + (ldrel->l_vaddr - d_start), 0); #else lseek (a_out, orig_data_scnptr + ldrel->l_vaddr, 0); #endif if (read (a_out, (void *) &orig_int, sizeof (orig_int)) != sizeof (orig_int)) { PERROR (a_name); } switch (ldrel->l_symndx) { case SYMNDX_TEXT: #ifdef AIX4_1 p = (int *) (ldrel->l_vaddr); orig_int = * p; #else p = (int *) (d_start + ldrel->l_vaddr); orig_int = * p - (t_start - f_ohdr.text_start); #endif break; case SYMNDX_DATA: case SYMNDX_BSS: #ifdef AIX4_1 p = (int *) (ldrel->l_vaddr); orig_int = * p; #else p = (int *) (d_start + ldrel->l_vaddr); orig_int = * p - (d_start - f_ohdr.data_start); #endif break; } #ifdef AIX4_1 lseek (new, data_scnptr + (ldrel->l_vaddr - d_start), 0); #else lseek (new, data_scnptr + ldrel->l_vaddr, 0); #endif if (write (new, (void *) &orig_int, sizeof (orig_int)) != sizeof (orig_int)) { PERROR (new_name); } } } } #endif /* XCOFF */ emacs-19.30/src/unexalpha.c100444 12120 1 27277 6051203472 14056 0ustar rmsdaemon/* Unexec for DEC alpha. schoepf@sc.ZIB-Berlin.DE (Rainer Schoepf). Copyright (C) 1994 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. */ #include #include #include #include #include #include #include #include #include #include #include static void fatal_unexec (); static void mark_x (); #define READ(_fd, _buffer, _size, _error_message, _error_arg) \ errno = EEOF; \ if (read (_fd, _buffer, _size) != _size) \ fatal_unexec (_error_message, _error_arg); #define WRITE(_fd, _buffer, _size, _error_message, _error_arg) \ if (write (_fd, _buffer, _size) != _size) \ fatal_unexec (_error_message, _error_arg); #define SEEK(_fd, _position, _error_message, _error_arg) \ errno = EEOF; \ if (lseek (_fd, _position, L_SET) != _position) \ fatal_unexec (_error_message, _error_arg); extern int errno; extern char *strerror (); void *sbrk(); #define EEOF -1 static struct scnhdr *text_section; static struct scnhdr *init_section; static struct scnhdr *finit_section; static struct scnhdr *rdata_section; static struct scnhdr *rconst_section; static struct scnhdr *data_section; static struct scnhdr *pdata_section; static struct scnhdr *xdata_section; static struct scnhdr *got_section; static struct scnhdr *lit8_section; static struct scnhdr *lit4_section; static struct scnhdr *sdata_section; static struct scnhdr *sbss_section; static struct scnhdr *bss_section; static unsigned long Brk; struct headers { struct filehdr fhdr; struct aouthdr aout; struct scnhdr section[_MIPS_NSCNS_MAX]; }; /* Define name of label for entry point for the dumped executable. */ #ifndef DEFAULT_ENTRY_ADDRESS #define DEFAULT_ENTRY_ADDRESS __start #endif unexec (new_name, a_name, data_start, bss_start, entry_address) char *new_name, *a_name; unsigned long data_start, bss_start, entry_address; { int new, old; char * oldptr; struct headers ohdr, nhdr; struct stat stat; long pagesize, brk; long newsyms, symrel; int nread; int i; long vaddr, scnptr; #define BUFSIZE 8192 char buffer[BUFSIZE]; if ((old = open (a_name, O_RDONLY)) < 0) fatal_unexec ("opening %s", a_name); new = creat (new_name, 0666); if (new < 0) fatal_unexec ("creating %s", new_name); if ((fstat (old, &stat) == -1)) fatal_unexec ("fstat %s", a_name); oldptr = (char *)mmap (0, stat.st_size, PROT_READ, MAP_FILE|MAP_SHARED, old, 0); if (oldptr == (char *)-1) fatal_unexec ("mmap %s", a_name); close (old); /* This is a copy of the a.out header of the original executable */ ohdr = (*(struct headers *)oldptr); /* This is where we build the new header from the in-memory copy */ nhdr = *((struct headers *)TEXT_START); /* First do some consistency checks */ if (nhdr.fhdr.f_magic != ALPHAMAGIC && nhdr.fhdr.f_magic != ALPHAUMAGIC) { fprintf (stderr, "unexec: input file magic number is %x, not %x or %x.\n", nhdr.fhdr.f_magic, ALPHAMAGIC, ALPHAUMAGIC); exit (1); } if (nhdr.fhdr.f_opthdr != sizeof (nhdr.aout)) { fprintf (stderr, "unexec: input a.out header is %d bytes, not %d.\n", nhdr.fhdr.f_opthdr, sizeof (nhdr.aout)); exit (1); } if (nhdr.aout.magic != ZMAGIC) { fprintf (stderr, "unexec: input file a.out magic number is %o, not %o.\n", nhdr.aout.magic, ZMAGIC); exit (1); } /* Now check the existence of certain header section and grab their addresses. */ #define CHECK_SCNHDR(ptr, name, flags) \ ptr = NULL; \ for (i = 0; i < nhdr.fhdr.f_nscns && !ptr; i++) \ if (strcmp (nhdr.section[i].s_name, name) == 0) \ { \ if (nhdr.section[i].s_flags != flags) \ fprintf (stderr, "unexec: %x flags (%x expected) in %s section.\n", \ nhdr.section[i].s_flags, flags, name); \ ptr = nhdr.section + i; \ } \ CHECK_SCNHDR (text_section, _TEXT, STYP_TEXT); CHECK_SCNHDR (init_section, _INIT, STYP_INIT); #ifdef _FINI CHECK_SCNHDR (finit_section, _FINI, STYP_FINI); #endif /* _FINI */ CHECK_SCNHDR (rdata_section, _RDATA, STYP_RDATA); #ifdef _RCONST CHECK_SCNHDR (rconst_section, _RCONST, STYP_RCONST); #endif #ifdef _PDATA CHECK_SCNHDR (pdata_section, _PDATA, STYP_PDATA); #endif _PDATA #ifdef _GOT CHECK_SCNHDR (got_section, _GOT, STYP_GOT); #endif _GOT CHECK_SCNHDR (data_section, _DATA, STYP_DATA); #ifdef _XDATA CHECK_SCNHDR (xdata_section, _XDATA, STYP_XDATA); #endif /* _XDATA */ #ifdef _LIT8 CHECK_SCNHDR (lit8_section, _LIT8, STYP_LIT8); CHECK_SCNHDR (lit4_section, _LIT4, STYP_LIT4); #endif /* _LIT8 */ CHECK_SCNHDR (sdata_section, _SDATA, STYP_SDATA); CHECK_SCNHDR (sbss_section, _SBSS, STYP_SBSS); CHECK_SCNHDR (bss_section, _BSS, STYP_BSS); pagesize = getpagesize (); brk = (((long) (sbrk (0))) + pagesize - 1) & (-pagesize); /* Remember the current break */ Brk = brk; nhdr.aout.dsize = brk - DATA_START; nhdr.aout.bsize = 0; if (entry_address == 0) { extern DEFAULT_ENTRY_ADDRESS (); nhdr.aout.entry = (unsigned long)DEFAULT_ENTRY_ADDRESS; } else nhdr.aout.entry = entry_address; nhdr.aout.bss_start = nhdr.aout.data_start + nhdr.aout.dsize; if (rdata_section != NULL) { rdata_section->s_size = data_start - DATA_START; /* Adjust start and virtual addresses of rdata_section, too. */ rdata_section->s_vaddr = DATA_START; rdata_section->s_paddr = DATA_START; rdata_section->s_scnptr = text_section->s_scnptr + nhdr.aout.tsize; } data_section->s_vaddr = data_start; data_section->s_paddr = data_start; data_section->s_size = brk - data_start; if (rdata_section != NULL) { data_section->s_scnptr = rdata_section->s_scnptr + rdata_section->s_size; } vaddr = data_section->s_vaddr + data_section->s_size; scnptr = data_section->s_scnptr + data_section->s_size; if (lit8_section != NULL) { lit8_section->s_vaddr = vaddr; lit8_section->s_paddr = vaddr; lit8_section->s_size = 0; lit8_section->s_scnptr = scnptr; } if (lit4_section != NULL) { lit4_section->s_vaddr = vaddr; lit4_section->s_paddr = vaddr; lit4_section->s_size = 0; lit4_section->s_scnptr = scnptr; } if (sdata_section != NULL) { sdata_section->s_vaddr = vaddr; sdata_section->s_paddr = vaddr; sdata_section->s_size = 0; sdata_section->s_scnptr = scnptr; } #ifdef _XDATA if (xdata_section != NULL) { xdata_section->s_vaddr = vaddr; xdata_section->s_paddr = vaddr; xdata_section->s_size = 0; xdata_section->s_scnptr = scnptr; } #endif #ifdef _GOT if (got_section != NULL) { got_section->s_vaddr = vaddr; got_section->s_paddr = vaddr; got_section->s_size = 0; got_section->s_scnptr = scnptr; } #endif /*_GOT */ if (sbss_section != NULL) { sbss_section->s_vaddr = vaddr; sbss_section->s_paddr = vaddr; sbss_section->s_size = 0; sbss_section->s_scnptr = scnptr; } if (bss_section != NULL) { bss_section->s_vaddr = vaddr; bss_section->s_paddr = vaddr; bss_section->s_size = 0; bss_section->s_scnptr = scnptr; } WRITE (new, (char *)TEXT_START, nhdr.aout.tsize, "writing text section to %s", new_name); WRITE (new, (char *)DATA_START, nhdr.aout.dsize, "writing data section to %s", new_name); /* * Construct new symbol table header */ bcopy (oldptr + nhdr.fhdr.f_symptr, buffer, cbHDRR); #define symhdr ((pHDRR)buffer) newsyms = nhdr.aout.tsize + nhdr.aout.dsize; symrel = newsyms - nhdr.fhdr.f_symptr; nhdr.fhdr.f_symptr = newsyms; symhdr->cbLineOffset += symrel; symhdr->cbDnOffset += symrel; symhdr->cbPdOffset += symrel; symhdr->cbSymOffset += symrel; symhdr->cbOptOffset += symrel; symhdr->cbAuxOffset += symrel; symhdr->cbSsOffset += symrel; symhdr->cbSsExtOffset += symrel; symhdr->cbFdOffset += symrel; symhdr->cbRfdOffset += symrel; symhdr->cbExtOffset += symrel; WRITE (new, buffer, cbHDRR, "writing symbol table header of %s", new_name); /* * Copy the symbol table and line numbers */ WRITE (new, oldptr + ohdr.fhdr.f_symptr + cbHDRR, stat.st_size - ohdr.fhdr.f_symptr - cbHDRR, "writing symbol table of %s", new_name); #if 0 /* Not needed for now */ update_dynamic_symbols (oldptr, new_name, new, newsyms, ((pHDRR) (oldptr + ohdr.fhdr.f_symptr))->issExtMax, ((pHDRR) (oldptr + ohdr.fhdr.f_symptr))->cbExtOffset, ((pHDRR) (oldptr + ohdr.fhdr.f_symptr))->cbSsExtOffset); #endif #undef symhdr SEEK (new, 0, "seeking to start of header in %s", new_name); WRITE (new, &nhdr, sizeof (nhdr), "writing header of %s", new_name); close (old); close (new); mark_x (new_name); } #if 0 /* Not needed for now */ /* The following function updates the values of some symbols that are used by the dynamic loader: _edata _end */ update_dynamic_symbols (old, new_name, new, newsyms, nsyms, symoff, stroff) char *old; /* Pointer to old executable */ char *new_name; /* Name of new executable */ int new; /* File descriptor for new executable */ long newsyms; /* Offset of Symbol table in new executable */ int nsyms; /* Number of symbol table entries */ long symoff; /* Offset of External Symbols in old file */ long stroff; /* Offset of string table in old file */ { long i; int found = 0; EXTR n_end, n_edata; /* We go through the symbol table entries until we have found the two symbols. */ /* cbEXTR is the size of an external symbol table entry */ for (i = 0; i < nsyms && found < 2; i += cbEXTR) { register pEXTR x = (pEXTR) (old + symoff + i); char *s; s = old + stroff + x->asym.iss; /* name of the symbol */ if (!strcmp(s,"_edata")) { found++; bcopy (x, &n_edata, cbEXTR); n_edata.asym.value = Brk; SEEK (new, newsyms + cbHDRR + i, "seeking to symbol _edata in %s", new_name); WRITE (new, &n_edata, cbEXTR, "writing symbol table entry for _edata into %s", new_name); } else if (!strcmp(s,"_end")) { found++; bcopy (x, &n_end, cbEXTR); n_end.asym.value = Brk; SEEK (new, newsyms + cbHDRR + i, "seeking to symbol _end in %s", new_name); WRITE (new, &n_end, cbEXTR, "writing symbol table entry for _end into %s", new_name); } } } #endif /* * mark_x * * After successfully building the new a.out, mark it executable */ static void mark_x (name) char *name; { struct stat sbuf; int um = umask (777); umask (um); if (stat (name, &sbuf) < 0) fatal_unexec ("getting protection on %s", name); sbuf.st_mode |= 0111 & ~um; if (chmod (name, sbuf.st_mode) < 0) fatal_unexec ("setting protection on %s", name); } static void fatal_unexec (s, arg) char *s; char *arg; { if (errno == EEOF) fputs ("unexec: unexpected end of file, ", stderr); else fprintf (stderr, "unexec: %s, ", strerror (errno)); fprintf (stderr, s, arg); fputs (".\n", stderr); exit (1); } emacs-19.30/src/unexapollo.c100666 12120 1 26003 5751763650 14266 0ustar rmsdaemon/* unexapollo.c -- COFF File UNEXEC for GNU Emacs on Apollo SR10.x Copyright (C) 1988, 1994 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. */ /* Written by Leonard N. Zubkoff. */ #include "config.h" #include #include #include #include #include #include #include #define DST_RECORD_HDR_SIZE 2 #define LONG_ALIGN(X) (((X)+3)&(~3)) void unexec (target_file_name, source_file_name) char *target_file_name, *source_file_name; { struct filehdr file_header; struct aouthdr domain_header; struct scnhdr *section, *sections, *sections_limit; struct scnhdr *first_data_section, *last_data_section; struct scnhdr *rwdi_section, *blocks_section; struct reloc reloc_entry; unsigned long data_size, old_data_section_size, source_file_offset_past_rwdi; unsigned char buffer[4096]; long delta_before_rwdi, delta_after_rwdi, byte_count; long first_changed_vaddr, old_rwdi_vaddr, i; ios_$id_t target_file, source_file; status_$t status; /* Open the Source File. */ if ((source_file = open (source_file_name, O_RDONLY)) < 0) error ("cannot open source file for input"); /* Read the File Header. */ if (read (source_file, &file_header, sizeof (file_header)) != sizeof (file_header)) error ("cannot read file header"); /* Read the Domain Header. */ if (read (source_file, &domain_header, sizeof (domain_header)) != sizeof (domain_header)) error ("cannot read domain header"); /* Read the Section Headers. */ sections = (struct scnhdr *) malloc (file_header.f_nscns*sizeof (struct scnhdr)); if (sections == (struct scnhdr *) 0) error ("cannot allocate section header storage"); sections_limit = sections + file_header.f_nscns; if (read (source_file, sections, file_header.f_nscns*sizeof (struct scnhdr)) != file_header.f_nscns*sizeof (struct scnhdr)) error ("cannot read section headers"); /* Compute the new Size of the Data Section. */ data_size = sbrk (0) - domain_header.data_start; delta_before_rwdi = delta_after_rwdi = data_size - domain_header.dsize; old_rwdi_vaddr = 0; /* Find and Deallocate the .rwdi Section Information. */ for (rwdi_section = sections; rwdi_section != sections_limit; rwdi_section++) if (strcmp (rwdi_section->s_name, ".rwdi") == 0) { /* If there are relocation entries, we cannot "unrelocate" them. */ if (rwdi_section->s_nreloc > 0) error (".rwdi section needs relocation - cannot dump Emacs"); delta_after_rwdi = delta_before_rwdi - rwdi_section->s_size; old_rwdi_vaddr = rwdi_section->s_vaddr; rwdi_section->s_paddr = 0; rwdi_section->s_vaddr = 0; rwdi_section->s_scnptr = 0; rwdi_section->s_size = 0; source_file_offset_past_rwdi = (rwdi_section+1)->s_scnptr; break; } /* Skip over the Text Section Headers. */ for (section = sections; (section->s_flags & STYP_TEXT) != 0; section++) ; /* Find the First and Last Data Sections and Fixup Section Header Relocation Pointers. */ first_data_section = last_data_section = (struct scnhdr *) 0; for (; section != sections_limit; section++) { if ((section->s_flags & STYP_DATA) != 0) { if (first_data_section == (struct scnhdr *) 0) first_data_section = section; last_data_section = section; } if (section->s_relptr != 0) section->s_relptr += delta_after_rwdi; } /* Increment the Size of the Last Data Section. */ old_data_section_size = last_data_section->s_size; last_data_section->s_size += delta_before_rwdi; /* Update the File Header and Domain Header. */ file_header.f_symptr += delta_after_rwdi; domain_header.dsize = data_size; domain_header.bsize = 0; /* Skip over subsequent Bss Section Headers. */ for (section = last_data_section+1; (section->s_flags & STYP_BSS) != 0; section++) ; /* Update the remaining Section Headers. */ blocks_section = (struct scnhdr *) 0; first_changed_vaddr = 0; for (; section != sections_limit; section++) { long delta = (section < rwdi_section ? delta_before_rwdi : delta_after_rwdi); if (section->s_paddr != 0) section->s_paddr += delta; if (section->s_vaddr != 0) { if (first_changed_vaddr == 0) first_changed_vaddr = section->s_vaddr; section->s_vaddr += delta; } if (section->s_scnptr != 0) section->s_scnptr += delta; if (strcmp (section->s_name, ".blocks") == 0) blocks_section = section; else if (strcmp (section->s_name, ".sri") == 0 && domain_header.o_sri != 0) domain_header.o_sri += delta; else if (strcmp (section->s_name, ".inlib") == 0 && domain_header.o_inlib != 0) domain_header.o_inlib += delta; } /* Open the Target File. */ ios_$create (target_file_name, strlen (target_file_name), coff_$uid, ios_$recreate_mode, ios_$write_opt, &target_file, &status); if (status.all != status_$ok) error ("cannot open target file for output"); /* Write the File Header. */ if (write (target_file, &file_header, sizeof (file_header)) != sizeof (file_header)) error ("cannot write file header"); /* Write the Domain Header. */ if (write (target_file, &domain_header, sizeof (domain_header)) != sizeof (domain_header)) error ("cannot write domain header"); /* Write the Section Headers. */ if (write (target_file, sections, file_header.f_nscns*sizeof (struct scnhdr)) != file_header.f_nscns*sizeof (struct scnhdr)) error ("cannot write section headers"); /* Copy the Allocated Sections. */ for (section = sections; section != first_data_section; section++) if (section->s_scnptr != 0) CopyData (target_file, source_file, LONG_ALIGN(section->s_size)); /* Write the Expanded Data Segment. */ if (write (target_file, first_data_section->s_vaddr, data_size) != data_size) error ("cannot write new data section"); /* Skip over the Last Data Section and Copy until the .rwdi Section. */ if (lseek (source_file, last_data_section->s_scnptr +old_data_section_size, L_SET) == -1) error ("cannot seek past data section"); for (section = last_data_section+1; section != rwdi_section; section++) if (section->s_scnptr != 0) CopyData (target_file, source_file, LONG_ALIGN(section->s_size)); /* Skip over the .rwdi Section and Copy Remainder of Source File. */ if (lseek (source_file, source_file_offset_past_rwdi, L_SET) == -1) error ("cannot seek past .rwdi section"); while ((byte_count = read (source_file, buffer, sizeof (buffer))) > 0) if (write (target_file, buffer, byte_count) != byte_count) error ("cannot write data"); /* Unrelocate .data references to Global Symbols. */ for (section = first_data_section; section <= last_data_section; section++) for (i = 0; i < section->s_nreloc; i++) { if (lseek (source_file, section->s_relptr +i*sizeof (struct reloc)-delta_after_rwdi, L_SET) == -1) error ("cannot seek to relocation info"); if (read (source_file, &reloc_entry, sizeof (reloc_entry)) != sizeof (reloc_entry)) error ("cannot read reloc entry"); if (lseek (source_file, reloc_entry.r_vaddr-section->s_vaddr +section->s_scnptr, L_SET) == -1) error ("cannot seek to data element"); if (lseek (target_file, reloc_entry.r_vaddr-section->s_vaddr +section->s_scnptr, L_SET) == -1) error ("cannot seek to data element"); if (read (source_file, buffer, 4) != 4) error ("cannot read data element"); if (write (target_file, buffer, 4) != 4) error ("cannot write data element"); } /* Correct virtual addresses in .blocks section. */ if (blocks_section != (struct scnhdr *) 0) { dst_rec_t dst_record; dst_rec_comp_unit_t *comp_unit; unsigned short number_of_sections; unsigned long section_base; unsigned long section_offset = 0; /* Find section tables and update section base addresses. */ while (section_offset < blocks_section->s_size) { if (lseek (target_file, blocks_section->s_scnptr+section_offset, L_SET) == -1) error ("cannot seek to comp unit record"); /* Handle pad records before the comp unit record. */ if (read (target_file, &dst_record, DST_RECORD_HDR_SIZE) != DST_RECORD_HDR_SIZE) error ("cannot read dst record tag"); if (dst_record.rec_type == dst_typ_pad) section_offset += DST_RECORD_HDR_SIZE; else if (dst_record.rec_type == dst_typ_comp_unit) { comp_unit = &dst_record.rec_data.comp_unit_; if (read (target_file, comp_unit, sizeof (*comp_unit)) != sizeof (*comp_unit)) error ("cannot read comp unit record"); if (lseek (target_file, blocks_section->s_scnptr +section_offset #if dst_version_major == 1 && dst_version_minor < 4 +comp_unit->section_table #else +comp_unit->section_table.rel_offset #endif +DST_RECORD_HDR_SIZE, L_SET) == -1) error ("cannot seek to section table"); if (read (target_file, &number_of_sections, sizeof (number_of_sections)) != sizeof (number_of_sections)) error ("cannot read section table size"); for (i = 0; i < number_of_sections; i++) { if (read (target_file, §ion_base, sizeof (section_base)) != sizeof (section_base)) error ("cannot read section base value"); if (section_base < first_changed_vaddr) continue; else if (section_base < old_rwdi_vaddr) section_base += delta_before_rwdi; else section_base += delta_after_rwdi; if (lseek (target_file, -sizeof (section_base), L_INCR) == -1) error ("cannot seek to section base value"); if (write (target_file, §ion_base, sizeof (section_base)) != sizeof (section_base)) error ("cannot write section base"); } section_offset += comp_unit->data_size; } else error ("unexpected dst record type"); } } if (close (source_file) == -1) error("cannot close source file"); if (close (target_file) == -1) error ("cannot close target file"); } static CopyData (target_file, source_file, total_byte_count) int target_file, source_file; long total_byte_count; { unsigned char buffer[4096]; long byte_count; while (total_byte_count > 0) { if (total_byte_count > sizeof (buffer)) byte_count = sizeof (buffer); else byte_count = total_byte_count; if (read (source_file, buffer, byte_count) != byte_count) error ("cannot read data"); if (write (target_file, buffer, byte_count) != byte_count) error ("cannot write data"); total_byte_count -= byte_count; } } emacs-19.30/src/unexconvex.c100444 75424 1 41115 5770115141 14462 0ustar kwzhdaemon/* Modified version of unexec for convex machines. Note that the GNU project considers support for the peculiarities of the Convex operating system a peripheral activity which should not be allowed to divert effort from development of the GNU system. Changes in this code will be installed when Convex system maintainers send them in, but aside from that we don't plan to think about it, or about whether other Emacs maintenance might break it. Copyright (C) 1985, 1986, 1988 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. */ /* modified for C-1 arch by jthomp@convex 871103 */ /* Corrected to support convex SOFF object file formats and thread specific * regions. streepy@convex 890302 */ /* * unexec.c - Convert a running program into an a.out file. * * Author: Spencer W. Thomas * Computer Science Dept. * University of Utah * Date: Tue Mar 2 1982 * Modified heavily since then. * * Synopsis: * unexec (new_name, a_name, data_start, bss_start, entry_address) * char *new_name, *a_name; * unsigned data_start, bss_start, entry_address; * * Takes a snapshot of the program and makes an a.out format file in the * file named by the string argument new_name. * If a_name is non-NULL, the symbol table will be taken from the given file. * On some machines, an existing a_name file is required. * * The boundaries within the a.out file may be adjusted with the data_start * and bss_start arguments. Either or both may be given as 0 for defaults. * * Data_start gives the boundary between the text segment and the data * segment of the program. The text segment can contain shared, read-only * program code and literal data, while the data segment is always unshared * and unprotected. Data_start gives the lowest unprotected address. * The value you specify may be rounded down to a suitable boundary * as required by the machine you are using. * * Specifying zero for data_start means the boundary between text and data * should not be the same as when the program was loaded. * If NO_REMAP is defined, the argument data_start is ignored and the * segment boundaries are never changed. * * Bss_start indicates how much of the data segment is to be saved in the * a.out file and restored when the program is executed. It gives the lowest * unsaved address, and is rounded up to a page boundary. The default when 0 * is given assumes that the entire data segment is to be stored, including * the previous data and bss as well as any additional storage allocated with * break (2). * * The new file is set up to start at entry_address. * * If you make improvements I'd like to get them too. * harpo!utah-cs!thomas, thomas@Utah-20 * */ /* There are several compilation parameters affecting unexec: * COFF Define this if your system uses COFF for executables. Otherwise we assume you use Berkeley format. * NO_REMAP Define this if you do not want to try to save Emacs's pure data areas as part of the text segment. Saving them as text is good because it allows users to share more. However, on machines that locate the text area far from the data area, the boundary cannot feasibly be moved. Such machines require NO_REMAP. Also, remapping can cause trouble with the built-in startup routine /lib/crt0.o, which defines `environ' as an initialized variable. Dumping `environ' as pure does not work! So, to use remapping, you must write a startup routine for your machine in Emacs's crt0.c. If NO_REMAP is defined, Emacs uses the system's crt0.o. * SECTION_ALIGNMENT Some machines that use COFF executables require that each section start on a certain boundary *in the COFF file*. Such machines should define SECTION_ALIGNMENT to a mask of the low-order bits that must be zero on such a boundary. This mask is used to control padding between segments in the COFF file. If SECTION_ALIGNMENT is not defined, the segments are written consecutively with no attempt at alignment. This is right for unmodified system V. * SEGMENT_MASK Some machines require that the beginnings and ends of segments *in core* be on certain boundaries. For most machines, a page boundary is sufficient. That is the default. When a larger boundary is needed, define SEGMENT_MASK to a mask of the bits that must be zero on such a boundary. * A_TEXT_OFFSET(HDR) Some machines count the a.out header as part of the size of the text segment (a_text); they may actually load the header into core as the first data in the text segment. Some have additional padding between the header and the real text of the program that is counted in a_text. For these machines, define A_TEXT_OFFSET(HDR) to examine the header structure HDR and return the number of bytes to add to `a_text' before writing it (above and beyond the number of bytes of actual program text). HDR's standard fields are already correct, except that this adjustment to the `a_text' field has not yet been made; thus, the amount of offset can depend on the data in the file. * A_TEXT_SEEK(HDR) If defined, this macro specifies the number of bytes to seek into the a.out file before starting to write the text segment.a * EXEC_MAGIC For machines using COFF, this macro, if defined, is a value stored into the magic number field of the output file. * ADJUST_EXEC_HEADER This macro can be used to generate statements to adjust or initialize nonstandard fields in the file header * ADDR_CORRECT(ADDR) Macro to correct an int which is the bit pattern of a pointer to a byte into an int which is the number of a byte. This macro has a default definition which is usually right. This default definition is a no-op on most machines (where a pointer looks like an int) but not on all machines. */ #include #define PERROR(file) report_error (file, new) #include /* Define getpagesize () if the system does not. Note that this may depend on symbols defined in a.out.h */ #include "getpagesize.h" #include #include #include #include extern char *start_of_text (); /* Start of text */ extern char *start_of_data (); /* Start of initialized data */ #include #include #include #include static long block_copy_start; /* Old executable start point */ static struct filehdr f_hdr; /* File header */ static struct opthdr f_ohdr; /* Optional file header (a.out) */ long bias; /* Bias to add for growth */ #define SYMS_START block_copy_start static long text_scnptr; static long data_scnptr; static int pagemask; static int pagesz; static report_error (file, fd) char *file; int fd; { if (fd) close (fd); error ("Failure operating on %s", file); } #define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1 #define ERROR1(msg,x) report_error_1 (new, msg, x, 0); return -1 #define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1 static report_error_1 (fd, msg, a1, a2) int fd; char *msg; int a1, a2; { close (fd); error (msg, a1, a2); } /* **************************************************************** * unexec * * driving logic. */ unexec (new_name, a_name, data_start, bss_start, entry_address) char *new_name, *a_name; unsigned data_start, bss_start, entry_address; { int new, a_out = -1; if (a_name && (a_out = open (a_name, 0)) < 0) { PERROR (a_name); } if ((new = creat (new_name, 0666)) < 0) { PERROR (new_name); } if (make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name) < 0 || copy_text_and_data (new) < 0 || copy_sym (new, a_out, a_name, new_name) < 0 ) { close (new); return -1; } close (new); if (a_out >= 0) close (a_out); mark_x (new_name); return 0; } /* **************************************************************** * make_hdr * * Make the header in the new a.out from the header in core. * Modify the text and data sizes. */ struct scnhdr *stbl; /* Table of all scnhdr's */ struct scnhdr *f_thdr; /* Text section header */ struct scnhdr *f_dhdr; /* Data section header */ struct scnhdr *f_tdhdr; /* Thread Data section header */ struct scnhdr *f_bhdr; /* Bss section header */ struct scnhdr *f_tbhdr; /* Thread Bss section header */ static int make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name) int new, a_out; unsigned data_start, bss_start, entry_address; char *a_name; char *new_name; { register int scns; unsigned int bss_end; unsigned int eo_data; /* End of initialized data in new exec file */ int scntype; /* Section type */ int i; /* Var for sorting by vaddr */ struct scnhdr scntemp; /* For swapping entries in sort */ extern char *start_of_data(); pagemask = (pagesz = getpagesize()) - 1; /* Adjust text/data boundary. */ if (!data_start) data_start = (unsigned) start_of_data (); data_start = data_start & ~pagemask; /* (Down) to page boundary. */ bss_end = (sbrk(0) + pagemask) & ~pagemask; /* Adjust data/bss boundary. */ if (bss_start != 0) { bss_start = (bss_start + pagemask) & ~pagemask;/* (Up) to page bdry. */ if (bss_start > bss_end) { ERROR1 ("unexec: Specified bss_start (%x) is past end of program", bss_start); } } else bss_start = bss_end; if (data_start > bss_start) { /* Can't have negative data size. */ ERROR2 ("unexec: data_start (%x) can't be greater than bss_start (%x)", data_start, bss_start); } /* Salvage as much info from the existing file as possible */ if (a_out < 0) { ERROR0 ("can't build a COFF file from scratch yet"); /*NOTREACHED*/ } if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) { PERROR (a_name); } block_copy_start += sizeof (f_hdr); if (f_hdr.h_opthdr > 0) { if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) { PERROR (a_name); } block_copy_start += sizeof (f_ohdr); } /* Allocate room for scn headers */ stbl = (struct scnhdr *)malloc( sizeof(struct scnhdr) * f_hdr.h_nscns ); if( stbl == NULL ) { ERROR0( "unexec: malloc of stbl failed" ); } f_tdhdr = f_tbhdr = NULL; /* Loop through section headers, copying them in */ for (scns = 0; scns < f_hdr.h_nscns; scns++) { if( read( a_out, &stbl[scns], sizeof(*stbl)) != sizeof(*stbl)) { PERROR (a_name); } scntype = stbl[scns].s_flags & S_TYPMASK; /* What type of section */ if( stbl[scns].s_scnptr > 0L) { if( block_copy_start < stbl[scns].s_scnptr + stbl[scns].s_size ) block_copy_start = stbl[scns].s_scnptr + stbl[scns].s_size; } if( scntype == S_TEXT) { f_thdr = &stbl[scns]; } else if( scntype == S_DATA) { f_dhdr = &stbl[scns]; #ifdef S_TDATA } else if( scntype == S_TDATA ) { f_tdhdr = &stbl[scns]; } else if( scntype == S_TBSS ) { f_tbhdr = &stbl[scns]; #endif /* S_TDATA (thread stuff) */ } else if( scntype == S_BSS) { f_bhdr = &stbl[scns]; } } /* We will now convert TEXT and DATA into TEXT, BSS into DATA, and leave * all thread stuff alone. */ /* Now we alter the contents of all the f_*hdr variables to correspond to what we want to dump. */ f_thdr->s_vaddr = (long) start_of_text (); f_thdr->s_size = data_start - f_thdr->s_vaddr; f_thdr->s_scnptr = pagesz; f_thdr->s_relptr = 0; f_thdr->s_nrel = 0; eo_data = f_thdr->s_scnptr + f_thdr->s_size; if( f_tdhdr ) { /* Process thread data */ f_tdhdr->s_vaddr = data_start; f_tdhdr->s_size += f_dhdr->s_size - (data_start - f_dhdr->s_vaddr); f_tdhdr->s_scnptr = eo_data; f_tdhdr->s_relptr = 0; f_tdhdr->s_nrel = 0; eo_data += f_tdhdr->s_size; /* And now for DATA */ f_dhdr->s_vaddr = f_bhdr->s_vaddr; /* Take BSS start address */ f_dhdr->s_size = bss_end - f_bhdr->s_vaddr; f_dhdr->s_scnptr = eo_data; f_dhdr->s_relptr = 0; f_dhdr->s_nrel = 0; eo_data += f_dhdr->s_size; } else { f_dhdr->s_vaddr = data_start; f_dhdr->s_size = bss_start - data_start; f_dhdr->s_scnptr = eo_data; f_dhdr->s_relptr = 0; f_dhdr->s_nrel = 0; eo_data += f_dhdr->s_size; } f_bhdr->s_vaddr = bss_start; f_bhdr->s_size = bss_end - bss_start + pagesz /* fudge */; f_bhdr->s_scnptr = 0; f_bhdr->s_relptr = 0; f_bhdr->s_nrel = 0; text_scnptr = f_thdr->s_scnptr; data_scnptr = f_dhdr->s_scnptr; bias = eo_data - block_copy_start; if (f_ohdr.o_symptr > 0L) { f_ohdr.o_symptr += bias; } if (f_hdr.h_strptr > 0) { f_hdr.h_strptr += bias; } if (write (new, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) { PERROR (new_name); } if (write (new, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) { PERROR (new_name); } for( scns = 0; scns < f_hdr.h_nscns; scns++ ) { /* This is a cheesy little loop to write out the section headers * in order of increasing virtual address. Dull but effective. */ for( i = scns+1; i < f_hdr.h_nscns; i++ ) { if( stbl[i].s_vaddr < stbl[scns].s_vaddr ) { /* Swap */ scntemp = stbl[i]; stbl[i] = stbl[scns]; stbl[scns] = scntemp; } } } for( scns = 0; scns < f_hdr.h_nscns; scns++ ) { if( write( new, &stbl[scns], sizeof(*stbl)) != sizeof(*stbl)) { PERROR (new_name); } } return (0); } /* **************************************************************** * copy_text_and_data * * Copy the text and data segments from memory to the new a.out */ static int copy_text_and_data (new) int new; { register int scns; for( scns = 0; scns < f_hdr.h_nscns; scns++ ) write_segment( new, &stbl[scns] ); return 0; } write_segment( new, sptr ) int new; struct scnhdr *sptr; { register char *ptr, *end; register int nwrite, ret; char buf[80]; extern int errno; char zeros[128]; if( sptr->s_scnptr == 0 ) return; /* Nothing to do */ if( lseek( new, (long) sptr->s_scnptr, 0 ) == -1 ) PERROR( "unexecing" ); bzero (zeros, sizeof zeros); ptr = (char *) sptr->s_vaddr; end = ptr + sptr->s_size; while( ptr < end ) { /* distance to next multiple of 128. */ nwrite = (((int) ptr + 128) & -128) - (int) ptr; /* But not beyond specified end. */ if (nwrite > end - ptr) nwrite = end - ptr; ret = write (new, ptr, nwrite); /* If write gets a page fault, it means we reached a gap between the old text segment and the old data segment. This gap has probably been remapped into part of the text segment. So write zeros for it. */ if (ret == -1 && errno == EFAULT) write (new, zeros, nwrite); else if (nwrite != ret) { sprintf (buf, "unexec write failure: addr 0x%x, fileno %d, size 0x%x, wrote 0x%x, errno %d", ptr, new, nwrite, ret, errno); PERROR (buf); } ptr += nwrite; } } /* **************************************************************** * copy_sym * * Copy the relocation information and symbol table from the a.out to the new */ static int copy_sym (new, a_out, a_name, new_name) int new, a_out; char *a_name, *new_name; { char page[1024]; int n; if (a_out < 0) return 0; if (SYMS_START == 0L) return 0; lseek (a_out, SYMS_START, 0); /* Position a.out to symtab. */ lseek( new, (long)f_ohdr.o_symptr, 0 ); while ((n = read (a_out, page, sizeof page)) > 0) { if (write (new, page, n) != n) { PERROR (new_name); } } if (n < 0) { PERROR (a_name); } return 0; } /* **************************************************************** * mark_x * * After successfully building the new a.out, mark it executable */ static mark_x (name) char *name; { struct stat sbuf; int um; int new = 0; /* for PERROR */ um = umask (777); umask (um); if (stat (name, &sbuf) == -1) { PERROR (name); } sbuf.st_mode |= 0111 & ~um; if (chmod (name, sbuf.st_mode) == -1) PERROR (name); } /* Find the first pty letter. This is usually 'p', as in ptyp0, but is sometimes configured down to 'm', 'n', or 'o' for some reason. */ first_pty_letter () { struct stat buf; char pty_name[16]; char c; for (c = 'o'; c >= 'a'; c--) { sprintf (pty_name, "/dev/pty%c0", c); if (stat (pty_name, &buf) < 0) return c + 1; } return 'a'; } emacs-19.30/src/unexec.c100444 12120 1 102265 6034403131 13362 0ustar rmsdaemon/* Copyright (C) 1985,86,87,88,92,93,94 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. */ /* * unexec.c - Convert a running program into an a.out file. * * Author: Spencer W. Thomas * Computer Science Dept. * University of Utah * Date: Tue Mar 2 1982 * Modified heavily since then. * * Synopsis: * unexec (new_name, a_name, data_start, bss_start, entry_address) * char *new_name, *a_name; * unsigned data_start, bss_start, entry_address; * * Takes a snapshot of the program and makes an a.out format file in the * file named by the string argument new_name. * If a_name is non-NULL, the symbol table will be taken from the given file. * On some machines, an existing a_name file is required. * * The boundaries within the a.out file may be adjusted with the data_start * and bss_start arguments. Either or both may be given as 0 for defaults. * * Data_start gives the boundary between the text segment and the data * segment of the program. The text segment can contain shared, read-only * program code and literal data, while the data segment is always unshared * and unprotected. Data_start gives the lowest unprotected address. * The value you specify may be rounded down to a suitable boundary * as required by the machine you are using. * * Specifying zero for data_start means the boundary between text and data * should not be the same as when the program was loaded. * If NO_REMAP is defined, the argument data_start is ignored and the * segment boundaries are never changed. * * Bss_start indicates how much of the data segment is to be saved in the * a.out file and restored when the program is executed. It gives the lowest * unsaved address, and is rounded up to a page boundary. The default when 0 * is given assumes that the entire data segment is to be stored, including * the previous data and bss as well as any additional storage allocated with * break (2). * * The new file is set up to start at entry_address. * * If you make improvements I'd like to get them too. * harpo!utah-cs!thomas, thomas@Utah-20 * */ /* Modified to support SysVr3 shared libraries by James Van Artsdalen * of Dell Computer Corporation. james@bigtex.cactus.org. */ /* There are several compilation parameters affecting unexec: * COFF Define this if your system uses COFF for executables. * COFF_ENCAPSULATE Define this if you are using the GNU coff encapsulated a.out format. This is closer to a.out than COFF. You should *not* define COFF if you define COFF_ENCAPSULATE Otherwise we assume you use Berkeley format. * NO_REMAP Define this if you do not want to try to save Emacs's pure data areas as part of the text segment. Saving them as text is good because it allows users to share more. However, on machines that locate the text area far from the data area, the boundary cannot feasibly be moved. Such machines require NO_REMAP. Also, remapping can cause trouble with the built-in startup routine /lib/crt0.o, which defines `environ' as an initialized variable. Dumping `environ' as pure does not work! So, to use remapping, you must write a startup routine for your machine in Emacs's crt0.c. If NO_REMAP is defined, Emacs uses the system's crt0.o. * SECTION_ALIGNMENT Some machines that use COFF executables require that each section start on a certain boundary *in the COFF file*. Such machines should define SECTION_ALIGNMENT to a mask of the low-order bits that must be zero on such a boundary. This mask is used to control padding between segments in the COFF file. If SECTION_ALIGNMENT is not defined, the segments are written consecutively with no attempt at alignment. This is right for unmodified system V. * SEGMENT_MASK Some machines require that the beginnings and ends of segments *in core* be on certain boundaries. For most machines, a page boundary is sufficient. That is the default. When a larger boundary is needed, define SEGMENT_MASK to a mask of the bits that must be zero on such a boundary. * A_TEXT_OFFSET(HDR) Some machines count the a.out header as part of the size of the text segment (a_text); they may actually load the header into core as the first data in the text segment. Some have additional padding between the header and the real text of the program that is counted in a_text. For these machines, define A_TEXT_OFFSET(HDR) to examine the header structure HDR and return the number of bytes to add to `a_text' before writing it (above and beyond the number of bytes of actual program text). HDR's standard fields are already correct, except that this adjustment to the `a_text' field has not yet been made; thus, the amount of offset can depend on the data in the file. * A_TEXT_SEEK(HDR) If defined, this macro specifies the number of bytes to seek into the a.out file before starting to write the text segment. * EXEC_MAGIC For machines using COFF, this macro, if defined, is a value stored into the magic number field of the output file. * ADJUST_EXEC_HEADER This macro can be used to generate statements to adjust or initialize nonstandard fields in the file header * ADDR_CORRECT(ADDR) Macro to correct an int which is the bit pattern of a pointer to a byte into an int which is the number of a byte. This macro has a default definition which is usually right. This default definition is a no-op on most machines (where a pointer looks like an int) but not on all machines. */ #ifndef emacs #define PERROR(arg) perror (arg); return -1 #else #define IN_UNEXEC #include #define PERROR(file) report_error (file, new) #endif #ifndef CANNOT_DUMP /* all rest of file! */ #ifdef COFF_ENCAPSULATE int need_coff_header = 1; #include /* The location might be a poor assumption */ #else #ifdef MSDOS #include #define filehdr external_filehdr #define scnhdr external_scnhdr #define syment external_syment #define auxent external_auxent #define n_numaux e_numaux #define n_type e_type struct aouthdr { unsigned short magic; /* type of file */ unsigned short vstamp; /* version stamp */ unsigned long tsize; /* text size in bytes, padded to FW bdry*/ unsigned long dsize; /* initialized data " " */ unsigned long bsize; /* uninitialized data " " */ unsigned long entry; /* entry pt. */ unsigned long text_start;/* base of text used for this file */ unsigned long data_start;/* base of data used for this file */ }; #else /* not MSDOS */ #include #endif /* not MSDOS */ #endif /* Define getpagesize if the system does not. Note that this may depend on symbols defined in a.out.h. */ #include "getpagesize.h" #ifndef makedev /* Try to detect types.h already loaded */ #include #endif /* makedev */ #include #include #include #include /* Must be after sys/types.h for USG and BSD4_1*/ #ifdef USG5 #include #endif #ifndef O_RDONLY #define O_RDONLY 0 #endif #ifndef O_RDWR #define O_RDWR 2 #endif extern char *start_of_text (); /* Start of text */ extern char *start_of_data (); /* Start of initialized data */ #ifdef COFF static long block_copy_start; /* Old executable start point */ static struct filehdr f_hdr; /* File header */ static struct aouthdr f_ohdr; /* Optional file header (a.out) */ long bias; /* Bias to add for growth */ long lnnoptr; /* Pointer to line-number info within file */ #define SYMS_START block_copy_start static long text_scnptr; static long data_scnptr; #else /* not COFF */ #ifdef HPUX extern void *sbrk (); #else #if 0 /* Some systems with __STDC__ compilers still declare this `char *' in some header file, and our declaration conflicts. The return value is always cast, so it should be harmless to leave it undefined. Hopefully machines with different size pointers and ints declare sbrk in a header file. */ #ifdef __STDC__ extern void *sbrk (); #else extern char *sbrk (); #endif /* __STDC__ */ #endif #endif /* HPUX */ #define SYMS_START ((long) N_SYMOFF (ohdr)) /* Some machines override the structure name for an a.out header. */ #ifndef EXEC_HDR_TYPE #define EXEC_HDR_TYPE struct exec #endif #ifdef HPUX #ifdef HP9000S200_ID #define MY_ID HP9000S200_ID #else #include #define MY_ID MYSYS #endif /* no HP9000S200_ID */ static MAGIC OLDMAGIC = {MY_ID, SHARE_MAGIC}; static MAGIC NEWMAGIC = {MY_ID, DEMAND_MAGIC}; #define N_TXTOFF(x) TEXT_OFFSET(x) #define N_SYMOFF(x) LESYM_OFFSET(x) static EXEC_HDR_TYPE hdr, ohdr; #else /* not HPUX */ #if defined (USG) && !defined (IBMAIX) && !defined (IRIS) && !defined (COFF_ENCAPSULATE) && !defined (LINUX) static struct bhdr hdr, ohdr; #define a_magic fmagic #define a_text tsize #define a_data dsize #define a_bss bsize #define a_syms ssize #define a_trsize rtsize #define a_drsize rdsize #define a_entry entry #define N_BADMAG(x) \ (((x).fmagic)!=OMAGIC && ((x).fmagic)!=NMAGIC &&\ ((x).fmagic)!=FMAGIC && ((x).fmagic)!=IMAGIC) #define NEWMAGIC FMAGIC #else /* IRIS or IBMAIX or not USG */ static EXEC_HDR_TYPE hdr, ohdr; #define NEWMAGIC ZMAGIC #endif /* IRIS or IBMAIX not USG */ #endif /* not HPUX */ static int unexec_text_start; static int unexec_data_start; #ifdef COFF_ENCAPSULATE /* coffheader is defined in the GNU a.out.encap.h file. */ struct coffheader coffheader; #endif #endif /* not COFF */ static int pagemask; /* Correct an int which is the bit pattern of a pointer to a byte into an int which is the number of a byte. This is a no-op on ordinary machines, but not on all. */ #ifndef ADDR_CORRECT /* Let m-*.h files override this definition */ #define ADDR_CORRECT(x) ((char *)(x) - (char*)0) #endif #ifdef emacs #include "lisp.h" static report_error (file, fd) char *file; int fd; { if (fd) close (fd); report_file_error ("Cannot unexec", Fcons (build_string (file), Qnil)); } #endif /* emacs */ #define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1 #define ERROR1(msg,x) report_error_1 (new, msg, x, 0); return -1 #define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1 static report_error_1 (fd, msg, a1, a2) int fd; char *msg; int a1, a2; { close (fd); #ifdef emacs error (msg, a1, a2); #else fprintf (stderr, msg, a1, a2); fprintf (stderr, "\n"); #endif } static int make_hdr (); static int copy_text_and_data (); static int copy_sym (); static void mark_x (); /* **************************************************************** * unexec * * driving logic. */ unexec (new_name, a_name, data_start, bss_start, entry_address) char *new_name, *a_name; unsigned data_start, bss_start, entry_address; { int new, a_out = -1; if (a_name && (a_out = open (a_name, O_RDONLY)) < 0) { PERROR (a_name); } if ((new = creat (new_name, 0666)) < 0) { PERROR (new_name); } if (make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name) < 0 || copy_text_and_data (new, a_out) < 0 || copy_sym (new, a_out, a_name, new_name) < 0 #ifdef COFF #ifndef COFF_BSD_SYMBOLS || adjust_lnnoptrs (new, a_out, new_name) < 0 #endif #endif ) { close (new); /* unlink (new_name); /* Failed, unlink new a.out */ return -1; } close (new); if (a_out >= 0) close (a_out); mark_x (new_name); return 0; } /* **************************************************************** * make_hdr * * Make the header in the new a.out from the header in core. * Modify the text and data sizes. */ static int make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name) int new, a_out; unsigned data_start, bss_start, entry_address; char *a_name; char *new_name; { int tem; #ifdef COFF auto struct scnhdr f_thdr; /* Text section header */ auto struct scnhdr f_dhdr; /* Data section header */ auto struct scnhdr f_bhdr; /* Bss section header */ auto struct scnhdr scntemp; /* Temporary section header */ register int scns; #endif /* COFF */ #ifdef USG_SHARED_LIBRARIES extern unsigned int bss_end; #else unsigned int bss_end; #endif pagemask = getpagesize () - 1; /* Adjust text/data boundary. */ #ifdef NO_REMAP data_start = (int) start_of_data (); #else /* not NO_REMAP */ if (!data_start) data_start = (int) start_of_data (); #endif /* not NO_REMAP */ data_start = ADDR_CORRECT (data_start); #ifdef SEGMENT_MASK data_start = data_start & ~SEGMENT_MASK; /* (Down) to segment boundary. */ #else data_start = data_start & ~pagemask; /* (Down) to page boundary. */ #endif bss_end = ADDR_CORRECT (sbrk (0)) + pagemask; bss_end &= ~ pagemask; /* Adjust data/bss boundary. */ if (bss_start != 0) { bss_start = (ADDR_CORRECT (bss_start) + pagemask); /* (Up) to page bdry. */ bss_start &= ~ pagemask; if (bss_start > bss_end) { ERROR1 ("unexec: Specified bss_start (%u) is past end of program", bss_start); } } else bss_start = bss_end; if (data_start > bss_start) /* Can't have negative data size. */ { ERROR2 ("unexec: data_start (%u) can't be greater than bss_start (%u)", data_start, bss_start); } #ifdef COFF /* Salvage as much info from the existing file as possible */ if (a_out >= 0) { if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) { PERROR (a_name); } block_copy_start += sizeof (f_hdr); if (f_hdr.f_opthdr > 0) { if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) { PERROR (a_name); } block_copy_start += sizeof (f_ohdr); } /* Loop through section headers, copying them in */ lseek (a_out, sizeof (f_hdr) + f_hdr.f_opthdr, 0); for (scns = f_hdr.f_nscns; scns > 0; scns--) { if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) { PERROR (a_name); } if (scntemp.s_scnptr > 0L) { if (block_copy_start < scntemp.s_scnptr + scntemp.s_size) block_copy_start = scntemp.s_scnptr + scntemp.s_size; } if (strcmp (scntemp.s_name, ".text") == 0) { f_thdr = scntemp; } else if (strcmp (scntemp.s_name, ".data") == 0) { f_dhdr = scntemp; } else if (strcmp (scntemp.s_name, ".bss") == 0) { f_bhdr = scntemp; } } } else { ERROR0 ("can't build a COFF file from scratch yet"); } /* Now we alter the contents of all the f_*hdr variables to correspond to what we want to dump. */ #ifdef USG_SHARED_LIBRARIES /* The amount of data we're adding to the file is distance from the * end of the original .data space to the current end of the .data * space. */ bias = bss_start - (f_ohdr.data_start + f_dhdr.s_size); #endif f_hdr.f_flags |= (F_RELFLG | F_EXEC); #ifdef TPIX f_hdr.f_nscns = 3; #endif #ifdef EXEC_MAGIC f_ohdr.magic = EXEC_MAGIC; #endif #ifndef NO_REMAP f_ohdr.text_start = (long) start_of_text (); f_ohdr.tsize = data_start - f_ohdr.text_start; f_ohdr.data_start = data_start; #endif /* NO_REMAP */ f_ohdr.dsize = bss_start - f_ohdr.data_start; f_ohdr.bsize = bss_end - bss_start; #ifndef KEEP_OLD_TEXT_SCNPTR /* On some machines, the old values are right. ??? Maybe on all machines with NO_REMAP. */ f_thdr.s_size = f_ohdr.tsize; f_thdr.s_scnptr = sizeof (f_hdr) + sizeof (f_ohdr); f_thdr.s_scnptr += (f_hdr.f_nscns) * (sizeof (f_thdr)); #endif /* KEEP_OLD_TEXT_SCNPTR */ #ifdef ADJUST_TEXT_SCNHDR_SIZE /* On some machines, `text size' includes all headers. */ f_thdr.s_size -= f_thdr.s_scnptr; #endif /* ADJUST_TEST_SCNHDR_SIZE */ lnnoptr = f_thdr.s_lnnoptr; #ifdef SECTION_ALIGNMENT /* Some systems require special alignment of the sections in the file itself. */ f_thdr.s_scnptr = (f_thdr.s_scnptr + SECTION_ALIGNMENT) & ~SECTION_ALIGNMENT; #endif /* SECTION_ALIGNMENT */ #ifdef TPIX f_thdr.s_scnptr = 0xd0; #endif text_scnptr = f_thdr.s_scnptr; #ifdef ADJUST_TEXTBASE text_scnptr = sizeof (f_hdr) + sizeof (f_ohdr) + (f_hdr.f_nscns) * (sizeof (f_thdr)); #endif #ifndef KEEP_OLD_PADDR f_dhdr.s_paddr = f_ohdr.data_start; #endif /* KEEP_OLD_PADDR */ f_dhdr.s_vaddr = f_ohdr.data_start; f_dhdr.s_size = f_ohdr.dsize; f_dhdr.s_scnptr = f_thdr.s_scnptr + f_thdr.s_size; #ifdef SECTION_ALIGNMENT /* Some systems require special alignment of the sections in the file itself. */ f_dhdr.s_scnptr = (f_dhdr.s_scnptr + SECTION_ALIGNMENT) & ~SECTION_ALIGNMENT; #endif /* SECTION_ALIGNMENT */ #ifdef DATA_SECTION_ALIGNMENT /* Some systems require special alignment of the data section only. */ f_dhdr.s_scnptr = (f_dhdr.s_scnptr + DATA_SECTION_ALIGNMENT) & ~DATA_SECTION_ALIGNMENT; #endif /* DATA_SECTION_ALIGNMENT */ data_scnptr = f_dhdr.s_scnptr; #ifndef KEEP_OLD_PADDR f_bhdr.s_paddr = f_ohdr.data_start + f_ohdr.dsize; #endif /* KEEP_OLD_PADDR */ f_bhdr.s_vaddr = f_ohdr.data_start + f_ohdr.dsize; f_bhdr.s_size = f_ohdr.bsize; f_bhdr.s_scnptr = 0L; #ifndef USG_SHARED_LIBRARIES bias = f_dhdr.s_scnptr + f_dhdr.s_size - block_copy_start; #endif if (f_hdr.f_symptr > 0L) { f_hdr.f_symptr += bias; } if (f_thdr.s_lnnoptr > 0L) { f_thdr.s_lnnoptr += bias; } #ifdef ADJUST_EXEC_HEADER ADJUST_EXEC_HEADER; #endif /* ADJUST_EXEC_HEADER */ if (write (new, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) { PERROR (new_name); } if (write (new, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) { PERROR (new_name); } #ifndef USG_SHARED_LIBRARIES if (write (new, &f_thdr, sizeof (f_thdr)) != sizeof (f_thdr)) { PERROR (new_name); } if (write (new, &f_dhdr, sizeof (f_dhdr)) != sizeof (f_dhdr)) { PERROR (new_name); } if (write (new, &f_bhdr, sizeof (f_bhdr)) != sizeof (f_bhdr)) { PERROR (new_name); } #else /* USG_SHARED_LIBRARIES */ /* The purpose of this code is to write out the new file's section * header table. * * Scan through the original file's sections. If the encountered * section is one we know (.text, .data or .bss), write out the * correct header. If it is a section we do not know (such as * .lib), adjust the address of where the section data is in the * file, and write out the header. * * If any section precedes .text or .data in the file, this code * will not adjust the file pointer for that section correctly. */ /* This used to use sizeof (f_ohdr) instead of .f_opthdr. .f_opthdr is said to be right when there is no optional header. */ lseek (a_out, sizeof (f_hdr) + f_hdr.f_opthdr, 0); for (scns = f_hdr.f_nscns; scns > 0; scns--) { if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) PERROR (a_name); if (!strcmp (scntemp.s_name, f_thdr.s_name)) /* .text */ { if (write (new, &f_thdr, sizeof (f_thdr)) != sizeof (f_thdr)) PERROR (new_name); } else if (!strcmp (scntemp.s_name, f_dhdr.s_name)) /* .data */ { if (write (new, &f_dhdr, sizeof (f_dhdr)) != sizeof (f_dhdr)) PERROR (new_name); } else if (!strcmp (scntemp.s_name, f_bhdr.s_name)) /* .bss */ { if (write (new, &f_bhdr, sizeof (f_bhdr)) != sizeof (f_bhdr)) PERROR (new_name); } else { if (scntemp.s_scnptr) scntemp.s_scnptr += bias; if (write (new, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) PERROR (new_name); } } #endif /* USG_SHARED_LIBRARIES */ return (0); #else /* if not COFF */ /* Get symbol table info from header of a.out file if given one. */ if (a_out >= 0) { #ifdef COFF_ENCAPSULATE if (read (a_out, &coffheader, sizeof coffheader) != sizeof coffheader) { PERROR(a_name); } if (coffheader.f_magic != COFF_MAGIC) { ERROR1("%s doesn't have legal coff magic number\n", a_name); } #endif if (read (a_out, &ohdr, sizeof hdr) != sizeof hdr) { PERROR (a_name); } if (N_BADMAG (ohdr)) { ERROR1 ("invalid magic number in %s", a_name); } hdr = ohdr; } else { #ifdef COFF_ENCAPSULATE /* We probably could without too much trouble. The code is in gld * but I don't have that much time or incentive. */ ERROR0 ("can't build a COFF file from scratch yet"); #else #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ bzero ((void *)&hdr, sizeof hdr); #else bzero (&hdr, sizeof hdr); #endif #endif } unexec_text_start = (long) start_of_text (); unexec_data_start = data_start; /* Machine-dependent fixup for header, or maybe for unexec_text_start */ #ifdef ADJUST_EXEC_HEADER ADJUST_EXEC_HEADER; #endif /* ADJUST_EXEC_HEADER */ hdr.a_trsize = 0; hdr.a_drsize = 0; if (entry_address != 0) hdr.a_entry = entry_address; hdr.a_bss = bss_end - bss_start; hdr.a_data = bss_start - data_start; #ifdef NO_REMAP hdr.a_text = ohdr.a_text; #else /* not NO_REMAP */ hdr.a_text = data_start - unexec_text_start; #ifdef A_TEXT_OFFSET hdr.a_text += A_TEXT_OFFSET (ohdr); #endif #endif /* not NO_REMAP */ #ifdef COFF_ENCAPSULATE /* We are encapsulating BSD format within COFF format. */ { struct coffscn *tp, *dp, *bp; tp = &coffheader.scns[0]; dp = &coffheader.scns[1]; bp = &coffheader.scns[2]; tp->s_size = hdr.a_text + sizeof(struct exec); dp->s_paddr = data_start; dp->s_vaddr = data_start; dp->s_size = hdr.a_data; bp->s_paddr = dp->s_vaddr + dp->s_size; bp->s_vaddr = bp->s_paddr; bp->s_size = hdr.a_bss; coffheader.tsize = tp->s_size; coffheader.dsize = dp->s_size; coffheader.bsize = bp->s_size; coffheader.text_start = tp->s_vaddr; coffheader.data_start = dp->s_vaddr; } if (write (new, &coffheader, sizeof coffheader) != sizeof coffheader) { PERROR(new_name); } #endif /* COFF_ENCAPSULATE */ if (write (new, &hdr, sizeof hdr) != sizeof hdr) { PERROR (new_name); } #if 0 /* This #ifndef caused a bug on Linux when using QMAGIC. */ /* This adjustment was done above only #ifndef NO_REMAP, so only undo it now #ifndef NO_REMAP. */ /* #ifndef NO_REMAP */ #endif #ifdef A_TEXT_OFFSET hdr.a_text -= A_TEXT_OFFSET (ohdr); #endif return 0; #endif /* not COFF */ } /* **************************************************************** * copy_text_and_data * * Copy the text and data segments from memory to the new a.out */ static int copy_text_and_data (new, a_out) int new, a_out; { register char *end; register char *ptr; #ifdef COFF #ifdef USG_SHARED_LIBRARIES int scns; struct scnhdr scntemp; /* Temporary section header */ /* The purpose of this code is to write out the new file's section * contents. * * Step through the section table. If we know the section (.text, * .data) do the appropriate thing. Otherwise, if the section has * no allocated space in the file (.bss), do nothing. Otherwise, * the section has space allocated in the file, and is not a section * we know. So just copy it. */ lseek (a_out, sizeof (struct filehdr) + sizeof (struct aouthdr), 0); for (scns = f_hdr.f_nscns; scns > 0; scns--) { if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) PERROR ("temacs"); if (!strcmp (scntemp.s_name, ".text")) { lseek (new, (long) text_scnptr, 0); ptr = (char *) f_ohdr.text_start; end = ptr + f_ohdr.tsize; write_segment (new, ptr, end); } else if (!strcmp (scntemp.s_name, ".data")) { lseek (new, (long) data_scnptr, 0); ptr = (char *) f_ohdr.data_start; end = ptr + f_ohdr.dsize; write_segment (new, ptr, end); } else if (!scntemp.s_scnptr) ; /* do nothing - no data for this section */ else { char page[BUFSIZ]; int size, n; long old_a_out_ptr = lseek (a_out, 0, 1); lseek (a_out, scntemp.s_scnptr, 0); for (size = scntemp.s_size; size > 0; size -= sizeof (page)) { n = size > sizeof (page) ? sizeof (page) : size; if (read (a_out, page, n) != n || write (new, page, n) != n) PERROR ("emacs"); } lseek (a_out, old_a_out_ptr, 0); } } #else /* COFF, but not USG_SHARED_LIBRARIES */ lseek (new, (long) text_scnptr, 0); ptr = (char *) f_ohdr.text_start; #ifdef HEADER_INCL_IN_TEXT /* For Gould UTX/32, text starts after headers */ ptr = (char *) (ptr + text_scnptr); #endif /* HEADER_INCL_IN_TEXT */ end = ptr + f_ohdr.tsize; write_segment (new, ptr, end); lseek (new, (long) data_scnptr, 0); ptr = (char *) f_ohdr.data_start; end = ptr + f_ohdr.dsize; write_segment (new, ptr, end); #endif /* USG_SHARED_LIBRARIES */ #else /* if not COFF */ /* Some machines count the header as part of the text segment. That is to say, the header appears in core just before the address that start_of_text returns. For them, N_TXTOFF is the place where the header goes. We must adjust the seek to the place after the header. Note that at this point hdr.a_text does *not* count the extra A_TEXT_OFFSET bytes, only the actual bytes of code. */ #ifdef A_TEXT_SEEK lseek (new, (long) A_TEXT_SEEK (hdr), 0); #else lseek (new, (long) N_TXTOFF (hdr), 0); #endif /* no A_TEXT_SEEK */ #ifdef RISCiX /* Acorn's RISC-iX has a wacky way of initialising the position of the heap. * There is a little table in crt0.o that is filled at link time with * the min and current brk positions, among other things. When start * runs, it copies the table to where these parameters live during * execution. This data is in text space, so it cannot be modified here * before saving the executable, so the data is written manually. In * addition, the table does not have a label, and the nearest accessable * label (mcount) is not prefixed with a '_', thus making it inaccessable * from within C programs. To overcome this, emacs's executable is passed * through the command 'nm %s | fgrep mcount' into a pipe, and the * resultant output is then used to find the address of 'mcount'. As far as * is possible to determine, in RISC-iX releases prior to 1.2, the negative * offset of the table from mcount is 0x2c, whereas from 1.2 onwards it is * 0x30. bss_end has been rounded up to page boundary. This solution is * based on suggestions made by Kevin Welton and Steve Hunt of Acorn, and * avoids the need for a custom version of crt0.o for emacs which has its * table in data space. */ { char command[1024]; char errbuf[1024]; char address_text[32]; int proforma[4]; FILE *pfile; char *temp_ptr; char c; int mcount_address, mcount_offset, count; extern char *_execname; /* The use of _execname is incompatible with RISCiX 1.1 */ sprintf (command, "nm %s | fgrep mcount", _execname); if ( (pfile = popen(command, "r")) == NULL) { sprintf (errbuf, "Could not open pipe"); PERROR (errbuf); } count=0; while ( ((c=getc(pfile)) != EOF) && (c != ' ') && (count < 31)) address_text[count++]=c; address_text[count]=0; if ((count == 0) || pclose(pfile) != NULL) { sprintf (errbuf, "Failed to execute the command '%s'\n", command); PERROR (errbuf); } sscanf(address_text, "%x", &mcount_address); ptr = (char *) unexec_text_start; mcount_offset = (char *)mcount_address - ptr; #ifdef RISCiX_1_1 #define EDATA_OFFSET 0x2c #else #define EDATA_OFFSET 0x30 #endif end = ptr + mcount_offset - EDATA_OFFSET; write_segment (new, ptr, end); proforma[0] = bss_end; /* becomes _edata */ proforma[1] = bss_end; /* becomes _end */ proforma[2] = bss_end; /* becomes _minbrk */ proforma[3] = bss_end; /* becomes _curbrk */ write (new, proforma, 16); temp_ptr = ptr; ptr = end + 16; end = temp_ptr + hdr.a_text; write_segment (new, ptr, end); } #else /* !RISCiX */ ptr = (char *) unexec_text_start; end = ptr + hdr.a_text; write_segment (new, ptr, end); #endif /* RISCiX */ ptr = (char *) unexec_data_start; end = ptr + hdr.a_data; /* This lseek is certainly incorrect when A_TEXT_OFFSET and I believe it is a no-op otherwise. Let's see if its absence ever fails. */ /* lseek (new, (long) N_TXTOFF (hdr) + hdr.a_text, 0); */ write_segment (new, ptr, end); #endif /* not COFF */ return 0; } write_segment (new, ptr, end) int new; register char *ptr, *end; { register int i, nwrite, ret; char buf[80]; extern int errno; /* This is the normal amount to write at once. It is the size of block that NFS uses. */ int writesize = 1 << 13; int pagesize = getpagesize (); char zeros[1 << 13]; bzero (zeros, sizeof (zeros)); for (i = 0; ptr < end;) { /* Distance to next multiple of writesize. */ nwrite = (((int) ptr + writesize) & -writesize) - (int) ptr; /* But not beyond specified end. */ if (nwrite > end - ptr) nwrite = end - ptr; ret = write (new, ptr, nwrite); /* If write gets a page fault, it means we reached a gap between the old text segment and the old data segment. This gap has probably been remapped into part of the text segment. So write zeros for it. */ if (ret == -1 #ifdef EFAULT && errno == EFAULT #endif ) { /* Write only a page of zeros at once, so that we we don't overshoot the start of the valid memory in the old data segment. */ if (nwrite > pagesize) nwrite = pagesize; write (new, zeros, nwrite); } #if 0 /* Now that we have can ask `write' to write more than a page, it is legit for write do less than the whole amount specified. */ else if (nwrite != ret) { sprintf (buf, "unexec write failure: addr 0x%x, fileno %d, size 0x%x, wrote 0x%x, errno %d", ptr, new, nwrite, ret, errno); PERROR (buf); } #endif i += nwrite; ptr += nwrite; } } /* **************************************************************** * copy_sym * * Copy the relocation information and symbol table from the a.out to the new */ static int copy_sym (new, a_out, a_name, new_name) int new, a_out; char *a_name, *new_name; { char page[1024]; int n; if (a_out < 0) return 0; #ifdef COFF if (SYMS_START == 0L) return 0; #endif /* COFF */ #ifdef COFF if (lnnoptr) /* if there is line number info */ lseek (a_out, lnnoptr, 0); /* start copying from there */ else #endif /* COFF */ lseek (a_out, SYMS_START, 0); /* Position a.out to symtab. */ while ((n = read (a_out, page, sizeof page)) > 0) { if (write (new, page, n) != n) { PERROR (new_name); } } if (n < 0) { PERROR (a_name); } return 0; } /* **************************************************************** * mark_x * * After successfully building the new a.out, mark it executable */ static void mark_x (name) char *name; { struct stat sbuf; int um; int new = 0; /* for PERROR */ um = umask (777); umask (um); if (stat (name, &sbuf) == -1) { PERROR (name); } sbuf.st_mode |= 0111 & ~um; if (chmod (name, sbuf.st_mode) == -1) PERROR (name); } #ifdef COFF #ifndef COFF_BSD_SYMBOLS /* * If the COFF file contains a symbol table and a line number section, * then any auxiliary entries that have values for x_lnnoptr must * be adjusted by the amount that the line number section has moved * in the file (bias computed in make_hdr). The #@$%&* designers of * the auxiliary entry structures used the absolute file offsets for * the line number entry rather than an offset from the start of the * line number section! * * When I figure out how to scan through the symbol table and pick out * the auxiliary entries that need adjustment, this routine will * be fixed. As it is now, all such entries are wrong and sdb * will complain. Fred Fish, UniSoft Systems Inc. */ /* This function is probably very slow. Instead of reopening the new file for input and output it should copy from the old to the new using the two descriptors already open (WRITEDESC and READDESC). Instead of reading one small structure at a time it should use a reasonable size buffer. But I don't have time to work on such things, so I am installing it as submitted to me. -- RMS. */ adjust_lnnoptrs (writedesc, readdesc, new_name) int writedesc; int readdesc; char *new_name; { register int nsyms; register int new; #if defined (amdahl_uts) || defined (pfa) SYMENT symentry; AUXENT auxentry; #else struct syment symentry; union auxent auxentry; #endif if (!lnnoptr || !f_hdr.f_symptr) return 0; #ifdef MSDOS if ((new = writedesc) < 0) #else if ((new = open (new_name, O_RDWR)) < 0) #endif { PERROR (new_name); return -1; } lseek (new, f_hdr.f_symptr, 0); for (nsyms = 0; nsyms < f_hdr.f_nsyms; nsyms++) { read (new, &symentry, SYMESZ); if (symentry.n_numaux) { read (new, &auxentry, AUXESZ); nsyms++; if (ISFCN (symentry.n_type) || symentry.n_type == 0x2400) { auxentry.x_sym.x_fcnary.x_fcn.x_lnnoptr += bias; lseek (new, -AUXESZ, 1); write (new, &auxentry, AUXESZ); } } } #ifndef MSDOS close (new); #endif return 0; } #endif /* COFF_BSD_SYMBOLS */ #endif /* COFF */ #endif /* not CANNOT_DUMP */ emacs-19.30/src/unexelf.c100444 75424 1 74177 5756001566 13755 0ustar kwzhdaemon/* Copyright (C) 1985, 1986, 1987, 1988, 1990, 1992 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. In other words, you are welcome to use, share and improve this program. You are forbidden to forbid anyone else to use, share and improve what you give them. Help stamp out software-hoarding! */ /* * unexec.c - Convert a running program into an a.out file. * * Author: Spencer W. Thomas * Computer Science Dept. * University of Utah * Date: Tue Mar 2 1982 * Modified heavily since then. * * Synopsis: * unexec (new_name, a_name, data_start, bss_start, entry_address) * char *new_name, *a_name; * unsigned data_start, bss_start, entry_address; * * Takes a snapshot of the program and makes an a.out format file in the * file named by the string argument new_name. * If a_name is non-NULL, the symbol table will be taken from the given file. * On some machines, an existing a_name file is required. * * The boundaries within the a.out file may be adjusted with the data_start * and bss_start arguments. Either or both may be given as 0 for defaults. * * Data_start gives the boundary between the text segment and the data * segment of the program. The text segment can contain shared, read-only * program code and literal data, while the data segment is always unshared * and unprotected. Data_start gives the lowest unprotected address. * The value you specify may be rounded down to a suitable boundary * as required by the machine you are using. * * Specifying zero for data_start means the boundary between text and data * should not be the same as when the program was loaded. * If NO_REMAP is defined, the argument data_start is ignored and the * segment boundaries are never changed. * * Bss_start indicates how much of the data segment is to be saved in the * a.out file and restored when the program is executed. It gives the lowest * unsaved address, and is rounded up to a page boundary. The default when 0 * is given assumes that the entire data segment is to be stored, including * the previous data and bss as well as any additional storage allocated with * break (2). * * The new file is set up to start at entry_address. * * If you make improvements I'd like to get them too. * harpo!utah-cs!thomas, thomas@Utah-20 * */ /* Even more heavily modified by james@bigtex.cactus.org of Dell Computer Co. * ELF support added. * * Basic theory: the data space of the running process needs to be * dumped to the output file. Normally we would just enlarge the size * of .data, scooting everything down. But we can't do that in ELF, * because there is often something between the .data space and the * .bss space. * * In the temacs dump below, notice that the Global Offset Table * (.got) and the Dynamic link data (.dynamic) come between .data1 and * .bss. It does not work to overlap .data with these fields. * * The solution is to create a new .data segment. This segment is * filled with data from the current process. Since the contents of * various sections refer to sections by index, the new .data segment * is made the last in the table to avoid changing any existing index. * This is an example of how the section headers are changed. "Addr" * is a process virtual address. "Offset" is a file offset. raid:/nfs/raid/src/dist-18.56/src> dump -h temacs temacs: **** SECTION HEADER TABLE **** [No] Type Flags Addr Offset Size Name Link Info Adralgn Entsize [1] 1 2 0x80480d4 0xd4 0x13 .interp 0 0 0x1 0 [2] 5 2 0x80480e8 0xe8 0x388 .hash 3 0 0x4 0x4 [3] 11 2 0x8048470 0x470 0x7f0 .dynsym 4 1 0x4 0x10 [4] 3 2 0x8048c60 0xc60 0x3ad .dynstr 0 0 0x1 0 [5] 9 2 0x8049010 0x1010 0x338 .rel.plt 3 7 0x4 0x8 [6] 1 6 0x8049348 0x1348 0x3 .init 0 0 0x4 0 [7] 1 6 0x804934c 0x134c 0x680 .plt 0 0 0x4 0x4 [8] 1 6 0x80499cc 0x19cc 0x3c56f .text 0 0 0x4 0 [9] 1 6 0x8085f3c 0x3df3c 0x3 .fini 0 0 0x4 0 [10] 1 2 0x8085f40 0x3df40 0x69c .rodata 0 0 0x4 0 [11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 0 0 0x4 0 [12] 1 3 0x8088330 0x3f330 0x20afc .data 0 0 0x4 0 [13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 0 0 0x4 0 [14] 1 3 0x80a96cc 0x606cc 0x1a8 .got 0 0 0x4 0x4 [15] 6 3 0x80a9874 0x60874 0x80 .dynamic 4 0 0x4 0x8 [16] 8 3 0x80a98f4 0x608f4 0x449c .bss 0 0 0x4 0 [17] 2 0 0 0x608f4 0x9b90 .symtab 18 371 0x4 0x10 [18] 3 0 0 0x6a484 0x8526 .strtab 0 0 0x1 0 [19] 3 0 0 0x729aa 0x93 .shstrtab 0 0 0x1 0 [20] 1 0 0 0x72a3d 0x68b7 .comment 0 0 0x1 0 raid:/nfs/raid/src/dist-18.56/src> dump -h xemacs xemacs: **** SECTION HEADER TABLE **** [No] Type Flags Addr Offset Size Name Link Info Adralgn Entsize [1] 1 2 0x80480d4 0xd4 0x13 .interp 0 0 0x1 0 [2] 5 2 0x80480e8 0xe8 0x388 .hash 3 0 0x4 0x4 [3] 11 2 0x8048470 0x470 0x7f0 .dynsym 4 1 0x4 0x10 [4] 3 2 0x8048c60 0xc60 0x3ad .dynstr 0 0 0x1 0 [5] 9 2 0x8049010 0x1010 0x338 .rel.plt 3 7 0x4 0x8 [6] 1 6 0x8049348 0x1348 0x3 .init 0 0 0x4 0 [7] 1 6 0x804934c 0x134c 0x680 .plt 0 0 0x4 0x4 [8] 1 6 0x80499cc 0x19cc 0x3c56f .text 0 0 0x4 0 [9] 1 6 0x8085f3c 0x3df3c 0x3 .fini 0 0 0x4 0 [10] 1 2 0x8085f40 0x3df40 0x69c .rodata 0 0 0x4 0 [11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 0 0 0x4 0 [12] 1 3 0x8088330 0x3f330 0x20afc .data 0 0 0x4 0 [13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 0 0 0x4 0 [14] 1 3 0x80a96cc 0x606cc 0x1a8 .got 0 0 0x4 0x4 [15] 6 3 0x80a9874 0x60874 0x80 .dynamic 4 0 0x4 0x8 [16] 8 3 0x80c6800 0x7d800 0 .bss 0 0 0x4 0 [17] 2 0 0 0x7d800 0x9b90 .symtab 18 371 0x4 0x10 [18] 3 0 0 0x87390 0x8526 .strtab 0 0 0x1 0 [19] 3 0 0 0x8f8b6 0x93 .shstrtab 0 0 0x1 0 [20] 1 0 0 0x8f949 0x68b7 .comment 0 0 0x1 0 [21] 1 3 0x80a98f4 0x608f4 0x1cf0c .data 0 0 0x4 0 * This is an example of how the file header is changed. "Shoff" is * the section header offset within the file. Since that table is * after the new .data section, it is moved. "Shnum" is the number of * sections, which we increment. * * "Phoff" is the file offset to the program header. "Phentsize" and * "Shentsz" are the program and section header entries sizes respectively. * These can be larger than the apparent struct sizes. raid:/nfs/raid/src/dist-18.56/src> dump -f temacs temacs: **** ELF HEADER **** Class Data Type Machine Version Entry Phoff Shoff Flags Ehsize Phentsize Phnum Shentsz Shnum Shstrndx 1 1 2 3 1 0x80499cc 0x34 0x792f4 0 0x34 0x20 5 0x28 21 19 raid:/nfs/raid/src/dist-18.56/src> dump -f xemacs xemacs: **** ELF HEADER **** Class Data Type Machine Version Entry Phoff Shoff Flags Ehsize Phentsize Phnum Shentsz Shnum Shstrndx 1 1 2 3 1 0x80499cc 0x34 0x96200 0 0x34 0x20 5 0x28 22 19 * These are the program headers. "Offset" is the file offset to the * segment. "Vaddr" is the memory load address. "Filesz" is the * segment size as it appears in the file, and "Memsz" is the size in * memory. Below, the third segment is the code and the fourth is the * data: the difference between Filesz and Memsz is .bss raid:/nfs/raid/src/dist-18.56/src> dump -o temacs temacs: ***** PROGRAM EXECUTION HEADER ***** Type Offset Vaddr Paddr Filesz Memsz Flags Align 6 0x34 0x8048034 0 0xa0 0xa0 5 0 3 0xd4 0 0 0x13 0 4 0 1 0x34 0x8048034 0 0x3f2f9 0x3f2f9 5 0x1000 1 0x3f330 0x8088330 0 0x215c4 0x25a60 7 0x1000 2 0x60874 0x80a9874 0 0x80 0 7 0 raid:/nfs/raid/src/dist-18.56/src> dump -o xemacs xemacs: ***** PROGRAM EXECUTION HEADER ***** Type Offset Vaddr Paddr Filesz Memsz Flags Align 6 0x34 0x8048034 0 0xa0 0xa0 5 0 3 0xd4 0 0 0x13 0 4 0 1 0x34 0x8048034 0 0x3f2f9 0x3f2f9 5 0x1000 1 0x3f330 0x8088330 0 0x3e4d0 0x3e4d0 7 0x1000 2 0x60874 0x80a9874 0 0x80 0 7 0 */ /* Modified by wtien@urbana.mcd.mot.com of Motorola Inc. * * The above mechanism does not work if the unexeced ELF file is being * re-layout by other applications (such as `strip'). All the applications * that re-layout the internal of ELF will layout all sections in ascending * order of their file offsets. After the re-layout, the data2 section will * still be the LAST section in the section header vector, but its file offset * is now being pushed far away down, and causes part of it not to be mapped * in (ie. not covered by the load segment entry in PHDR vector), therefore * causes the new binary to fail. * * The solution is to modify the unexec algorithm to insert the new data2 * section header right before the new bss section header, so their file * offsets will be in the ascending order. Since some of the section's (all * sections AFTER the bss section) indexes are now changed, we also need to * modify some fields to make them point to the right sections. This is done * by macro PATCH_INDEX. All the fields that need to be patched are: * * 1. ELF header e_shstrndx field. * 2. section header sh_link and sh_info field. * 3. symbol table entry st_shndx field. * * The above example now should look like: **** SECTION HEADER TABLE **** [No] Type Flags Addr Offset Size Name Link Info Adralgn Entsize [1] 1 2 0x80480d4 0xd4 0x13 .interp 0 0 0x1 0 [2] 5 2 0x80480e8 0xe8 0x388 .hash 3 0 0x4 0x4 [3] 11 2 0x8048470 0x470 0x7f0 .dynsym 4 1 0x4 0x10 [4] 3 2 0x8048c60 0xc60 0x3ad .dynstr 0 0 0x1 0 [5] 9 2 0x8049010 0x1010 0x338 .rel.plt 3 7 0x4 0x8 [6] 1 6 0x8049348 0x1348 0x3 .init 0 0 0x4 0 [7] 1 6 0x804934c 0x134c 0x680 .plt 0 0 0x4 0x4 [8] 1 6 0x80499cc 0x19cc 0x3c56f .text 0 0 0x4 0 [9] 1 6 0x8085f3c 0x3df3c 0x3 .fini 0 0 0x4 0 [10] 1 2 0x8085f40 0x3df40 0x69c .rodata 0 0 0x4 0 [11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 0 0 0x4 0 [12] 1 3 0x8088330 0x3f330 0x20afc .data 0 0 0x4 0 [13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 0 0 0x4 0 [14] 1 3 0x80a96cc 0x606cc 0x1a8 .got 0 0 0x4 0x4 [15] 6 3 0x80a9874 0x60874 0x80 .dynamic 4 0 0x4 0x8 [16] 1 3 0x80a98f4 0x608f4 0x1cf0c .data 0 0 0x4 0 [17] 8 3 0x80c6800 0x7d800 0 .bss 0 0 0x4 0 [18] 2 0 0 0x7d800 0x9b90 .symtab 19 371 0x4 0x10 [19] 3 0 0 0x87390 0x8526 .strtab 0 0 0x1 0 [20] 3 0 0 0x8f8b6 0x93 .shstrtab 0 0 0x1 0 [21] 1 0 0 0x8f949 0x68b7 .comment 0 0 0x1 0 */ #include #include #include #include #include #include #include #include #include #include #ifndef emacs #define fatal(a, b, c) fprintf (stderr, a, b, c), exit (1) #else #include "config.h" extern void fatal (char *, ...); #endif #ifndef ELF_BSS_SECTION_NAME #define ELF_BSS_SECTION_NAME ".bss" #endif /* Get the address of a particular section or program header entry, * accounting for the size of the entries. */ #define OLD_SECTION_H(n) \ (*(Elf32_Shdr *) ((byte *) old_section_h + old_file_h->e_shentsize * (n))) #define NEW_SECTION_H(n) \ (*(Elf32_Shdr *) ((byte *) new_section_h + new_file_h->e_shentsize * (n))) #define OLD_PROGRAM_H(n) \ (*(Elf32_Phdr *) ((byte *) old_program_h + old_file_h->e_phentsize * (n))) #define NEW_PROGRAM_H(n) \ (*(Elf32_Phdr *) ((byte *) new_program_h + new_file_h->e_phentsize * (n))) #define PATCH_INDEX(n) \ do { \ if ((int) (n) >= old_bss_index) \ (n)++; } while (0) typedef unsigned char byte; /* Round X up to a multiple of Y. */ int round_up (x, y) int x, y; { int rem = x % y; if (rem == 0) return x; return x - rem + y; } /* **************************************************************** * unexec * * driving logic. * * In ELF, this works by replacing the old .bss section with a new * .data section, and inserting an empty .bss immediately afterwards. * */ void unexec (new_name, old_name, data_start, bss_start, entry_address) char *new_name, *old_name; unsigned data_start, bss_start, entry_address; { int new_file, old_file, new_file_size; /* Pointers to the base of the image of the two files. */ caddr_t old_base, new_base; /* Pointers to the file, program and section headers for the old and new * files. */ Elf32_Ehdr *old_file_h, *new_file_h; Elf32_Phdr *old_program_h, *new_program_h; Elf32_Shdr *old_section_h, *new_section_h; /* Point to the section name table in the old file */ char *old_section_names; Elf32_Addr old_bss_addr, new_bss_addr; Elf32_Word old_bss_size, new_data2_size; Elf32_Off new_data2_offset; Elf32_Addr new_data2_addr; int n, nn, old_bss_index, old_data_index, new_data2_index; struct stat stat_buf; /* Open the old file & map it into the address space. */ old_file = open (old_name, O_RDONLY); if (old_file < 0) fatal ("Can't open %s for reading: errno %d\n", old_name, errno); if (fstat (old_file, &stat_buf) == -1) fatal ("Can't fstat (%s): errno %d\n", old_name, errno); old_base = mmap (0, stat_buf.st_size, PROT_READ, MAP_SHARED, old_file, 0); if (old_base == (caddr_t) -1) fatal ("Can't mmap (%s): errno %d\n", old_name, errno); #ifdef DEBUG fprintf (stderr, "mmap (%s, %x) -> %x\n", old_name, stat_buf.st_size, old_base); #endif /* Get pointers to headers & section names */ old_file_h = (Elf32_Ehdr *) old_base; old_program_h = (Elf32_Phdr *) ((byte *) old_base + old_file_h->e_phoff); old_section_h = (Elf32_Shdr *) ((byte *) old_base + old_file_h->e_shoff); old_section_names = (char *) old_base + OLD_SECTION_H (old_file_h->e_shstrndx).sh_offset; /* Find the old .bss section. Figure out parameters of the new * data2 and bss sections. */ for (old_bss_index = 1; old_bss_index < (int) old_file_h->e_shnum; old_bss_index++) { #ifdef DEBUG fprintf (stderr, "Looking for .bss - found %s\n", old_section_names + OLD_SECTION_H (old_bss_index).sh_name); #endif if (!strcmp (old_section_names + OLD_SECTION_H (old_bss_index).sh_name, ELF_BSS_SECTION_NAME)) break; } if (old_bss_index == old_file_h->e_shnum) fatal ("Can't find .bss in %s.\n", old_name, 0); old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr; old_bss_size = OLD_SECTION_H (old_bss_index).sh_size; #if defined(emacs) || !defined(DEBUG) new_bss_addr = (Elf32_Addr) sbrk (0); #else new_bss_addr = old_bss_addr + old_bss_size + 0x1234; #endif new_data2_addr = old_bss_addr; new_data2_size = new_bss_addr - old_bss_addr; new_data2_offset = OLD_SECTION_H (old_bss_index).sh_offset; #ifdef DEBUG fprintf (stderr, "old_bss_index %d\n", old_bss_index); fprintf (stderr, "old_bss_addr %x\n", old_bss_addr); fprintf (stderr, "old_bss_size %x\n", old_bss_size); fprintf (stderr, "new_bss_addr %x\n", new_bss_addr); fprintf (stderr, "new_data2_addr %x\n", new_data2_addr); fprintf (stderr, "new_data2_size %x\n", new_data2_size); fprintf (stderr, "new_data2_offset %x\n", new_data2_offset); #endif if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size) fatal (".bss shrank when undumping???\n", 0, 0); /* Set the output file to the right size and mmap it. Set * pointers to various interesting objects. stat_buf still has * old_file data. */ new_file = open (new_name, O_RDWR | O_CREAT, 0666); if (new_file < 0) fatal ("Can't creat (%s): errno %d\n", new_name, errno); new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_data2_size; if (ftruncate (new_file, new_file_size)) fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno); #ifdef UNEXEC_USE_MAP_PRIVATE new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_PRIVATE, new_file, 0); #else new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_SHARED, new_file, 0); #endif if (new_base == (caddr_t) -1) fatal ("Can't mmap (%s): errno %d\n", new_name, errno); new_file_h = (Elf32_Ehdr *) new_base; new_program_h = (Elf32_Phdr *) ((byte *) new_base + old_file_h->e_phoff); new_section_h = (Elf32_Shdr *) ((byte *) new_base + old_file_h->e_shoff + new_data2_size); /* Make our new file, program and section headers as copies of the * originals. */ memcpy (new_file_h, old_file_h, old_file_h->e_ehsize); memcpy (new_program_h, old_program_h, old_file_h->e_phnum * old_file_h->e_phentsize); /* Modify the e_shstrndx if necessary. */ PATCH_INDEX (new_file_h->e_shstrndx); /* Fix up file header. We'll add one section. Section header is * further away now. */ new_file_h->e_shoff += new_data2_size; new_file_h->e_shnum += 1; #ifdef DEBUG fprintf (stderr, "Old section offset %x\n", old_file_h->e_shoff); fprintf (stderr, "Old section count %d\n", old_file_h->e_shnum); fprintf (stderr, "New section offset %x\n", new_file_h->e_shoff); fprintf (stderr, "New section count %d\n", new_file_h->e_shnum); #endif /* Fix up a new program header. Extend the writable data segment so * that the bss area is covered too. Find that segment by looking * for a segment that ends just before the .bss area. Make sure * that no segments are above the new .data2. Put a loop at the end * to adjust the offset and address of any segment that is above * data2, just in case we decide to allow this later. */ for (n = new_file_h->e_phnum - 1; n >= 0; n--) { /* Compute maximum of all requirements for alignment of section. */ int alignment = (NEW_PROGRAM_H (n)).p_align; if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment) alignment = OLD_SECTION_H (old_bss_index).sh_addralign; if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz > old_bss_addr) fatal ("Program segment above .bss in %s\n", old_name, 0); if (NEW_PROGRAM_H (n).p_type == PT_LOAD && (round_up ((NEW_PROGRAM_H (n)).p_vaddr + (NEW_PROGRAM_H (n)).p_filesz, alignment) == round_up (old_bss_addr, alignment))) break; } if (n < 0) fatal ("Couldn't find segment next to .bss in %s\n", old_name, 0); NEW_PROGRAM_H (n).p_filesz += new_data2_size; NEW_PROGRAM_H (n).p_memsz = NEW_PROGRAM_H (n).p_filesz; #if 0 /* Maybe allow section after data2 - does this ever happen? */ for (n = new_file_h->e_phnum - 1; n >= 0; n--) { if (NEW_PROGRAM_H (n).p_vaddr && NEW_PROGRAM_H (n).p_vaddr >= new_data2_addr) NEW_PROGRAM_H (n).p_vaddr += new_data2_size - old_bss_size; if (NEW_PROGRAM_H (n).p_offset >= new_data2_offset) NEW_PROGRAM_H (n).p_offset += new_data2_size; } #endif /* Fix up section headers based on new .data2 section. Any section * whose offset or virtual address is after the new .data2 section * gets its value adjusted. .bss size becomes zero and new address * is set. data2 section header gets added by copying the existing * .data header and modifying the offset, address and size. */ for (old_data_index = 1; old_data_index < (int) old_file_h->e_shnum; old_data_index++) if (!strcmp (old_section_names + OLD_SECTION_H (old_data_index).sh_name, ".data")) break; if (old_data_index == old_file_h->e_shnum) fatal ("Can't find .data in %s.\n", old_name, 0); /* Walk through all section headers, insert the new data2 section right before the new bss section. */ for (n = 1, nn = 1; n < (int) old_file_h->e_shnum; n++, nn++) { caddr_t src; /* If it is bss section, insert the new data2 section before it. */ if (n == old_bss_index) { /* Steal the data section header for this data2 section. */ memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (old_data_index), new_file_h->e_shentsize); NEW_SECTION_H (nn).sh_addr = new_data2_addr; NEW_SECTION_H (nn).sh_offset = new_data2_offset; NEW_SECTION_H (nn).sh_size = new_data2_size; /* Use the bss section's alignment. This will assure that the new data2 section always be placed in the same spot as the old bss section by any other application. */ NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (n).sh_addralign; /* Now copy over what we have in the memory now. */ memcpy (NEW_SECTION_H (nn).sh_offset + new_base, (caddr_t) OLD_SECTION_H (n).sh_addr, new_data2_size); nn++; } memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n), old_file_h->e_shentsize); /* The new bss section's size is zero, and its file offset and virtual address should be off by NEW_DATA2_SIZE. */ if (n == old_bss_index) { /* NN should be `old_bss_index + 1' at this point. */ NEW_SECTION_H (nn).sh_offset += new_data2_size; NEW_SECTION_H (nn).sh_addr += new_data2_size; /* Let the new bss section address alignment be the same as the section address alignment followed the old bss section, so this section will be placed in exactly the same place. */ NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (nn).sh_addralign; NEW_SECTION_H (nn).sh_size = 0; } else { /* Any section that was original placed AFTER the bss section should now be off by NEW_DATA2_SIZE. */ if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset) NEW_SECTION_H (nn).sh_offset += new_data2_size; /* Any section that was originally placed after the section header table should now be off by the size of one section header table entry. */ if (NEW_SECTION_H (nn).sh_offset > new_file_h->e_shoff) NEW_SECTION_H (nn).sh_offset += new_file_h->e_shentsize; } /* If any section hdr refers to the section after the new .data section, make it refer to next one because we have inserted a new section in between. */ PATCH_INDEX (NEW_SECTION_H (nn).sh_link); /* For symbol tables, info is a symbol table index, so don't change it. */ if (NEW_SECTION_H (nn).sh_type != SHT_SYMTAB && NEW_SECTION_H (nn).sh_type != SHT_DYNSYM) PATCH_INDEX (NEW_SECTION_H (nn).sh_info); /* Now, start to copy the content of sections. */ if (NEW_SECTION_H (nn).sh_type == SHT_NULL || NEW_SECTION_H (nn).sh_type == SHT_NOBITS) continue; /* Write out the sections. .data and .data1 (and data2, called ".data" in the strings table) get copied from the current process instead of the old file. */ if (!strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data") || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), ".data1")) src = (caddr_t) OLD_SECTION_H (n).sh_addr; else src = old_base + OLD_SECTION_H (n).sh_offset; memcpy (NEW_SECTION_H (nn).sh_offset + new_base, src, NEW_SECTION_H (nn).sh_size); /* If it is the symbol table, its st_shndx field needs to be patched. */ if (NEW_SECTION_H (nn).sh_type == SHT_SYMTAB || NEW_SECTION_H (nn).sh_type == SHT_DYNSYM) { Elf32_Shdr *spt = &NEW_SECTION_H (nn); unsigned int num = spt->sh_size / spt->sh_entsize; Elf32_Sym * sym = (Elf32_Sym *) (NEW_SECTION_H (nn).sh_offset + new_base); for (; num--; sym++) { if ((sym->st_shndx == SHN_UNDEF) || (sym->st_shndx == SHN_ABS) || (sym->st_shndx == SHN_COMMON)) continue; PATCH_INDEX (sym->st_shndx); } } } /* Update the symbol values of _edata and _end. */ for (n = new_file_h->e_shnum - 1; n; n--) { byte *symnames; Elf32_Sym *symp, *symendp; if (NEW_SECTION_H (n).sh_type != SHT_DYNSYM && NEW_SECTION_H (n).sh_type != SHT_SYMTAB) continue; symnames = ((byte *) new_base + NEW_SECTION_H (NEW_SECTION_H (n).sh_link).sh_offset); symp = (Elf32_Sym *) (NEW_SECTION_H (n).sh_offset + new_base); symendp = (Elf32_Sym *) ((byte *)symp + NEW_SECTION_H (n).sh_size); for (; symp < symendp; symp ++) if (strcmp ((char *) (symnames + symp->st_name), "_end") == 0 || strcmp ((char *) (symnames + symp->st_name), "_edata") == 0) memcpy (&symp->st_value, &new_bss_addr, sizeof (new_bss_addr)); } #ifdef UNEXEC_USE_MAP_PRIVATE if (lseek (new_file, 0, SEEK_SET) == -1) fatal ("Can't rewind (%s): errno %d\n", new_name, errno); if (write (new_file, new_base, new_file_size) != new_file_size) fatal ("Can't write (%s): errno %d\n", new_name, errno); #endif /* Close the files and make the new file executable. */ if (close (old_file)) fatal ("Can't close (%s): errno %d\n", old_name, errno); if (close (new_file)) fatal ("Can't close (%s): errno %d\n", new_name, errno); if (stat (new_name, &stat_buf) == -1) fatal ("Can't stat (%s): errno %d\n", new_name, errno); n = umask (777); umask (n); stat_buf.st_mode |= 0111 & ~n; if (chmod (new_name, stat_buf.st_mode) == -1) fatal ("Can't chmod (%s): errno %d\n", new_name, errno); } emacs-19.30/src/unexelfsgi.c100444 12120 1 77473 6045034455 14253 0ustar rmsdaemon/* Copyright (C) 1985, 1986, 1987, 1988, 1990, 1992 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. In other words, you are welcome to use, share and improve this program. You are forbidden to forbid anyone else to use, share and improve what you give them. Help stamp out software-hoarding! */ /* * unexec.c - Convert a running program into an a.out file. * * Author: Spencer W. Thomas * Computer Science Dept. * University of Utah * Date: Tue Mar 2 1982 * Modified heavily since then. * * Synopsis: * unexec (new_name, a_name, data_start, bss_start, entry_address) * char *new_name, *a_name; * unsigned data_start, bss_start, entry_address; * * Takes a snapshot of the program and makes an a.out format file in the * file named by the string argument new_name. * If a_name is non-NULL, the symbol table will be taken from the given file. * On some machines, an existing a_name file is required. * * The boundaries within the a.out file may be adjusted with the data_start * and bss_start arguments. Either or both may be given as 0 for defaults. * * Data_start gives the boundary between the text segment and the data * segment of the program. The text segment can contain shared, read-only * program code and literal data, while the data segment is always unshared * and unprotected. Data_start gives the lowest unprotected address. * The value you specify may be rounded down to a suitable boundary * as required by the machine you are using. * * Specifying zero for data_start means the boundary between text and data * should not be the same as when the program was loaded. * If NO_REMAP is defined, the argument data_start is ignored and the * segment boundaries are never changed. * * Bss_start indicates how much of the data segment is to be saved in the * a.out file and restored when the program is executed. It gives the lowest * unsaved address, and is rounded up to a page boundary. The default when 0 * is given assumes that the entire data segment is to be stored, including * the previous data and bss as well as any additional storage allocated with * break (2). * * The new file is set up to start at entry_address. * * If you make improvements I'd like to get them too. * harpo!utah-cs!thomas, thomas@Utah-20 * */ /* Even more heavily modified by james@bigtex.cactus.org of Dell Computer Co. * ELF support added. * * Basic theory: the data space of the running process needs to be * dumped to the output file. Normally we would just enlarge the size * of .data, scooting everything down. But we can't do that in ELF, * because there is often something between the .data space and the * .bss space. * * In the temacs dump below, notice that the Global Offset Table * (.got) and the Dynamic link data (.dynamic) come between .data1 and * .bss. It does not work to overlap .data with these fields. * * The solution is to create a new .data segment. This segment is * filled with data from the current process. Since the contents of * various sections refer to sections by index, the new .data segment * is made the last in the table to avoid changing any existing index. * This is an example of how the section headers are changed. "Addr" * is a process virtual address. "Offset" is a file offset. raid:/nfs/raid/src/dist-18.56/src> dump -h temacs temacs: **** SECTION HEADER TABLE **** [No] Type Flags Addr Offset Size Name Link Info Adralgn Entsize [1] 1 2 0x80480d4 0xd4 0x13 .interp 0 0 0x1 0 [2] 5 2 0x80480e8 0xe8 0x388 .hash 3 0 0x4 0x4 [3] 11 2 0x8048470 0x470 0x7f0 .dynsym 4 1 0x4 0x10 [4] 3 2 0x8048c60 0xc60 0x3ad .dynstr 0 0 0x1 0 [5] 9 2 0x8049010 0x1010 0x338 .rel.plt 3 7 0x4 0x8 [6] 1 6 0x8049348 0x1348 0x3 .init 0 0 0x4 0 [7] 1 6 0x804934c 0x134c 0x680 .plt 0 0 0x4 0x4 [8] 1 6 0x80499cc 0x19cc 0x3c56f .text 0 0 0x4 0 [9] 1 6 0x8085f3c 0x3df3c 0x3 .fini 0 0 0x4 0 [10] 1 2 0x8085f40 0x3df40 0x69c .rodata 0 0 0x4 0 [11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 0 0 0x4 0 [12] 1 3 0x8088330 0x3f330 0x20afc .data 0 0 0x4 0 [13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 0 0 0x4 0 [14] 1 3 0x80a96cc 0x606cc 0x1a8 .got 0 0 0x4 0x4 [15] 6 3 0x80a9874 0x60874 0x80 .dynamic 4 0 0x4 0x8 [16] 8 3 0x80a98f4 0x608f4 0x449c .bss 0 0 0x4 0 [17] 2 0 0 0x608f4 0x9b90 .symtab 18 371 0x4 0x10 [18] 3 0 0 0x6a484 0x8526 .strtab 0 0 0x1 0 [19] 3 0 0 0x729aa 0x93 .shstrtab 0 0 0x1 0 [20] 1 0 0 0x72a3d 0x68b7 .comment 0 0 0x1 0 raid:/nfs/raid/src/dist-18.56/src> dump -h xemacs xemacs: **** SECTION HEADER TABLE **** [No] Type Flags Addr Offset Size Name Link Info Adralgn Entsize [1] 1 2 0x80480d4 0xd4 0x13 .interp 0 0 0x1 0 [2] 5 2 0x80480e8 0xe8 0x388 .hash 3 0 0x4 0x4 [3] 11 2 0x8048470 0x470 0x7f0 .dynsym 4 1 0x4 0x10 [4] 3 2 0x8048c60 0xc60 0x3ad .dynstr 0 0 0x1 0 [5] 9 2 0x8049010 0x1010 0x338 .rel.plt 3 7 0x4 0x8 [6] 1 6 0x8049348 0x1348 0x3 .init 0 0 0x4 0 [7] 1 6 0x804934c 0x134c 0x680 .plt 0 0 0x4 0x4 [8] 1 6 0x80499cc 0x19cc 0x3c56f .text 0 0 0x4 0 [9] 1 6 0x8085f3c 0x3df3c 0x3 .fini 0 0 0x4 0 [10] 1 2 0x8085f40 0x3df40 0x69c .rodata 0 0 0x4 0 [11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 0 0 0x4 0 [12] 1 3 0x8088330 0x3f330 0x20afc .data 0 0 0x4 0 [13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 0 0 0x4 0 [14] 1 3 0x80a96cc 0x606cc 0x1a8 .got 0 0 0x4 0x4 [15] 6 3 0x80a9874 0x60874 0x80 .dynamic 4 0 0x4 0x8 [16] 8 3 0x80c6800 0x7d800 0 .bss 0 0 0x4 0 [17] 2 0 0 0x7d800 0x9b90 .symtab 18 371 0x4 0x10 [18] 3 0 0 0x87390 0x8526 .strtab 0 0 0x1 0 [19] 3 0 0 0x8f8b6 0x93 .shstrtab 0 0 0x1 0 [20] 1 0 0 0x8f949 0x68b7 .comment 0 0 0x1 0 [21] 1 3 0x80a98f4 0x608f4 0x1cf0c .data 0 0 0x4 0 * This is an example of how the file header is changed. "Shoff" is * the section header offset within the file. Since that table is * after the new .data section, it is moved. "Shnum" is the number of * sections, which we increment. * * "Phoff" is the file offset to the program header. "Phentsize" and * "Shentsz" are the program and section header entries sizes respectively. * These can be larger than the apparent struct sizes. raid:/nfs/raid/src/dist-18.56/src> dump -f temacs temacs: **** ELF HEADER **** Class Data Type Machine Version Entry Phoff Shoff Flags Ehsize Phentsize Phnum Shentsz Shnum Shstrndx 1 1 2 3 1 0x80499cc 0x34 0x792f4 0 0x34 0x20 5 0x28 21 19 raid:/nfs/raid/src/dist-18.56/src> dump -f xemacs xemacs: **** ELF HEADER **** Class Data Type Machine Version Entry Phoff Shoff Flags Ehsize Phentsize Phnum Shentsz Shnum Shstrndx 1 1 2 3 1 0x80499cc 0x34 0x96200 0 0x34 0x20 5 0x28 22 19 * These are the program headers. "Offset" is the file offset to the * segment. "Vaddr" is the memory load address. "Filesz" is the * segment size as it appears in the file, and "Memsz" is the size in * memory. Below, the third segment is the code and the fourth is the * data: the difference between Filesz and Memsz is .bss raid:/nfs/raid/src/dist-18.56/src> dump -o temacs temacs: ***** PROGRAM EXECUTION HEADER ***** Type Offset Vaddr Paddr Filesz Memsz Flags Align 6 0x34 0x8048034 0 0xa0 0xa0 5 0 3 0xd4 0 0 0x13 0 4 0 1 0x34 0x8048034 0 0x3f2f9 0x3f2f9 5 0x1000 1 0x3f330 0x8088330 0 0x215c4 0x25a60 7 0x1000 2 0x60874 0x80a9874 0 0x80 0 7 0 raid:/nfs/raid/src/dist-18.56/src> dump -o xemacs xemacs: ***** PROGRAM EXECUTION HEADER ***** Type Offset Vaddr Paddr Filesz Memsz Flags Align 6 0x34 0x8048034 0 0xa0 0xa0 5 0 3 0xd4 0 0 0x13 0 4 0 1 0x34 0x8048034 0 0x3f2f9 0x3f2f9 5 0x1000 1 0x3f330 0x8088330 0 0x3e4d0 0x3e4d0 7 0x1000 2 0x60874 0x80a9874 0 0x80 0 7 0 */ /* Modified by wtien@urbana.mcd.mot.com of Motorola Inc. * * The above mechanism does not work if the unexeced ELF file is being * re-layout by other applications (such as `strip'). All the applications * that re-layout the internal of ELF will layout all sections in ascending * order of their file offsets. After the re-layout, the data2 section will * still be the LAST section in the section header vector, but its file offset * is now being pushed far away down, and causes part of it not to be mapped * in (ie. not covered by the load segment entry in PHDR vector), therefore * causes the new binary to fail. * * The solution is to modify the unexec algorithm to insert the new data2 * section header right before the new bss section header, so their file * offsets will be in the ascending order. Since some of the section's (all * sections AFTER the bss section) indexes are now changed, we also need to * modify some fields to make them point to the right sections. This is done * by macro PATCH_INDEX. All the fields that need to be patched are: * * 1. ELF header e_shstrndx field. * 2. section header sh_link and sh_info field. * 3. symbol table entry st_shndx field. * * The above example now should look like: **** SECTION HEADER TABLE **** [No] Type Flags Addr Offset Size Name Link Info Adralgn Entsize [1] 1 2 0x80480d4 0xd4 0x13 .interp 0 0 0x1 0 [2] 5 2 0x80480e8 0xe8 0x388 .hash 3 0 0x4 0x4 [3] 11 2 0x8048470 0x470 0x7f0 .dynsym 4 1 0x4 0x10 [4] 3 2 0x8048c60 0xc60 0x3ad .dynstr 0 0 0x1 0 [5] 9 2 0x8049010 0x1010 0x338 .rel.plt 3 7 0x4 0x8 [6] 1 6 0x8049348 0x1348 0x3 .init 0 0 0x4 0 [7] 1 6 0x804934c 0x134c 0x680 .plt 0 0 0x4 0x4 [8] 1 6 0x80499cc 0x19cc 0x3c56f .text 0 0 0x4 0 [9] 1 6 0x8085f3c 0x3df3c 0x3 .fini 0 0 0x4 0 [10] 1 2 0x8085f40 0x3df40 0x69c .rodata 0 0 0x4 0 [11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 0 0 0x4 0 [12] 1 3 0x8088330 0x3f330 0x20afc .data 0 0 0x4 0 [13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 0 0 0x4 0 [14] 1 3 0x80a96cc 0x606cc 0x1a8 .got 0 0 0x4 0x4 [15] 6 3 0x80a9874 0x60874 0x80 .dynamic 4 0 0x4 0x8 [16] 1 3 0x80a98f4 0x608f4 0x1cf0c .data 0 0 0x4 0 [17] 8 3 0x80c6800 0x7d800 0 .bss 0 0 0x4 0 [18] 2 0 0 0x7d800 0x9b90 .symtab 19 371 0x4 0x10 [19] 3 0 0 0x87390 0x8526 .strtab 0 0 0x1 0 [20] 3 0 0 0x8f8b6 0x93 .shstrtab 0 0 0x1 0 [21] 1 0 0 0x8f949 0x68b7 .comment 0 0 0x1 0 */ #include #include #include #include #include #include #include #include #include #include /* for HDRR declaration */ #include #ifndef emacs #define fatal(a, b, c) fprintf(stderr, a, b, c), exit(1) #else extern void fatal(char *, ...); #endif /* Get the address of a particular section or program header entry, * accounting for the size of the entries. */ #define OLD_SECTION_H(n) \ (*(Elf32_Shdr *) ((byte *) old_section_h + old_file_h->e_shentsize * (n))) #define NEW_SECTION_H(n) \ (*(Elf32_Shdr *) ((byte *) new_section_h + new_file_h->e_shentsize * (n))) #define OLD_PROGRAM_H(n) \ (*(Elf32_Phdr *) ((byte *) old_program_h + old_file_h->e_phentsize * (n))) #define NEW_PROGRAM_H(n) \ (*(Elf32_Phdr *) ((byte *) new_program_h + new_file_h->e_phentsize * (n))) #define PATCH_INDEX(n) \ do { \ if ((n) >= old_bss_index) \ (n)++; } while (0) typedef unsigned char byte; /* Round X up to a multiple of Y. */ int round_up (x, y) int x, y; { int rem = x % y; if (rem == 0) return x; return x - rem + y; } /* Return the index of the section named NAME. SECTION_NAMES, FILE_NAME and FILE_H give information about the file we are looking in. If we don't find the section NAME, that is a fatal error if NOERROR is 0; we return -1 if NOERROR is nonzero. */ static int find_section (name, section_names, file_name, old_file_h, old_section_h, noerror) char *name; char *section_names; char *file_name; Elf32_Ehdr *old_file_h; Elf32_Shdr *old_section_h; int noerror; { int idx; for (idx = 1; idx < old_file_h->e_shnum; idx++) { #ifdef DEBUG fprintf (stderr, "Looking for %s - found %s\n", name, section_names + OLD_SECTION_H (idx).sh_name); #endif if (!strcmp (section_names + OLD_SECTION_H (idx).sh_name, name)) break; } if (idx == old_file_h->e_shnum) { if (noerror) return -1; else fatal ("Can't find .bss in %s.\n", file_name, 0); } return idx; } /* **************************************************************** * unexec * * driving logic. * * In ELF, this works by replacing the old .bss section with a new * .data section, and inserting an empty .bss immediately afterwards. * */ void unexec (new_name, old_name, data_start, bss_start, entry_address) char *new_name, *old_name; unsigned data_start, bss_start, entry_address; { extern unsigned int bss_end; int new_file, old_file, new_file_size; /* Pointers to the base of the image of the two files. */ caddr_t old_base, new_base; /* Pointers to the file, program and section headers for the old and new files. */ Elf32_Ehdr *old_file_h, *new_file_h; Elf32_Phdr *old_program_h, *new_program_h; Elf32_Shdr *old_section_h, *new_section_h; /* Point to the section name table in the old file. */ char *old_section_names; Elf32_Addr old_bss_addr, new_bss_addr; Elf32_Word old_bss_size, new_data2_size; Elf32_Off new_data2_offset; Elf32_Addr new_data2_addr; Elf32_Addr new_offsets_shift; int n, nn, old_bss_index, old_data_index, new_data2_index; int old_mdebug_index; struct stat stat_buf; /* Open the old file & map it into the address space. */ old_file = open (old_name, O_RDONLY); if (old_file < 0) fatal ("Can't open %s for reading: errno %d\n", old_name, errno); if (fstat (old_file, &stat_buf) == -1) fatal ("Can't fstat(%s): errno %d\n", old_name, errno); old_base = mmap (0, stat_buf.st_size, PROT_READ, MAP_SHARED, old_file, 0); if (old_base == (caddr_t) -1) fatal ("Can't mmap(%s): errno %d\n", old_name, errno); #ifdef DEBUG fprintf (stderr, "mmap(%s, %x) -> %x\n", old_name, stat_buf.st_size, old_base); #endif /* Get pointers to headers & section names. */ old_file_h = (Elf32_Ehdr *) old_base; old_program_h = (Elf32_Phdr *) ((byte *) old_base + old_file_h->e_phoff); old_section_h = (Elf32_Shdr *) ((byte *) old_base + old_file_h->e_shoff); old_section_names = (char *) old_base + OLD_SECTION_H (old_file_h->e_shstrndx).sh_offset; /* Find the mdebug section, if any. */ old_mdebug_index = find_section (".mdebug", old_section_names, old_name, old_file_h, old_section_h, 1); /* Find the old .bss section. */ old_bss_index = find_section (".bss", old_section_names, old_name, old_file_h, old_section_h, 0); /* Find the old .data section. Figure out parameters of the new data2 and bss sections. */ old_data_index = find_section (".data", old_section_names, old_name, old_file_h, old_section_h, 0); old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr; old_bss_size = OLD_SECTION_H (old_bss_index).sh_size; #if defined(emacs) || !defined(DEBUG) bss_end = (unsigned int) sbrk (0); new_bss_addr = (Elf32_Addr) bss_end; #else new_bss_addr = old_bss_addr + old_bss_size + 0x1234; #endif new_data2_addr = old_bss_addr; new_data2_size = new_bss_addr - old_bss_addr; new_data2_offset = OLD_SECTION_H (old_data_index).sh_offset + (new_data2_addr - OLD_SECTION_H (old_data_index).sh_addr); new_offsets_shift = new_bss_addr - ((old_bss_addr & ~0xfff) + ((old_bss_addr & 0xfff) ? 0x1000 : 0)); #ifdef DEBUG fprintf (stderr, "old_bss_index %d\n", old_bss_index); fprintf (stderr, "old_bss_addr %x\n", old_bss_addr); fprintf (stderr, "old_bss_size %x\n", old_bss_size); fprintf (stderr, "new_bss_addr %x\n", new_bss_addr); fprintf (stderr, "new_data2_addr %x\n", new_data2_addr); fprintf (stderr, "new_data2_size %x\n", new_data2_size); fprintf (stderr, "new_data2_offset %x\n", new_data2_offset); fprintf (stderr, "new_offsets_shift %x\n", new_offsets_shift); #endif if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size) fatal (".bss shrank when undumping???\n", 0, 0); /* Set the output file to the right size and mmap it. Set pointers to various interesting objects. stat_buf still has old_file data. */ new_file = open (new_name, O_RDWR | O_CREAT, 0666); if (new_file < 0) fatal ("Can't creat (%s): errno %d\n", new_name, errno); new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_offsets_shift; if (ftruncate (new_file, new_file_size)) fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno); new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_SHARED, new_file, 0); if (new_base == (caddr_t) -1) fatal ("Can't mmap (%s): errno %d\n", new_name, errno); new_file_h = (Elf32_Ehdr *) new_base; new_program_h = (Elf32_Phdr *) ((byte *) new_base + old_file_h->e_phoff); new_section_h = (Elf32_Shdr *) ((byte *) new_base + old_file_h->e_shoff + new_offsets_shift); /* Make our new file, program and section headers as copies of the originals. */ memcpy (new_file_h, old_file_h, old_file_h->e_ehsize); memcpy (new_program_h, old_program_h, old_file_h->e_phnum * old_file_h->e_phentsize); /* Modify the e_shstrndx if necessary. */ PATCH_INDEX (new_file_h->e_shstrndx); /* Fix up file header. We'll add one section. Section header is further away now. */ new_file_h->e_shoff += new_offsets_shift; new_file_h->e_shnum += 1; #ifdef DEBUG fprintf (stderr, "Old section offset %x\n", old_file_h->e_shoff); fprintf (stderr, "Old section count %d\n", old_file_h->e_shnum); fprintf (stderr, "New section offset %x\n", new_file_h->e_shoff); fprintf (stderr, "New section count %d\n", new_file_h->e_shnum); #endif /* Fix up a new program header. Extend the writable data segment so that the bss area is covered too. Find that segment by looking for a segment that ends just before the .bss area. Make sure that no segments are above the new .data2. Put a loop at the end to adjust the offset and address of any segment that is above data2, just in case we decide to allow this later. */ for (n = new_file_h->e_phnum - 1; n >= 0; n--) { /* Compute maximum of all requirements for alignment of section. */ int alignment = (NEW_PROGRAM_H (n)).p_align; if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment) alignment = OLD_SECTION_H (old_bss_index).sh_addralign; /* Supposedly this condition is okay for the SGI. */ #if 0 if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz > old_bss_addr) fatal ("Program segment above .bss in %s\n", old_name, 0); #endif if (NEW_PROGRAM_H (n).p_type == PT_LOAD && (round_up ((NEW_PROGRAM_H (n)).p_vaddr + (NEW_PROGRAM_H (n)).p_filesz, alignment) == round_up (old_bss_addr, alignment))) break; } if (n < 0) fatal ("Couldn't find segment next to .bss in %s\n", old_name, 0); NEW_PROGRAM_H (n).p_filesz += new_offsets_shift; NEW_PROGRAM_H (n).p_memsz = NEW_PROGRAM_H (n).p_filesz; #if 1 /* Maybe allow section after data2 - does this ever happen? */ for (n = new_file_h->e_phnum - 1; n >= 0; n--) { if (NEW_PROGRAM_H (n).p_vaddr && NEW_PROGRAM_H (n).p_vaddr >= new_data2_addr) NEW_PROGRAM_H (n).p_vaddr += new_offsets_shift - old_bss_size; if (NEW_PROGRAM_H (n).p_offset >= new_data2_offset) NEW_PROGRAM_H (n).p_offset += new_offsets_shift; } #endif /* Fix up section headers based on new .data2 section. Any section whose offset or virtual address is after the new .data2 section gets its value adjusted. .bss size becomes zero and new address is set. data2 section header gets added by copying the existing .data header and modifying the offset, address and size. */ for (old_data_index = 1; old_data_index < old_file_h->e_shnum; old_data_index++) if (!strcmp (old_section_names + OLD_SECTION_H (old_data_index).sh_name, ".data")) break; if (old_data_index == old_file_h->e_shnum) fatal ("Can't find .data in %s.\n", old_name, 0); /* Walk through all section headers, insert the new data2 section right before the new bss section. */ for (n = 1, nn = 1; n < old_file_h->e_shnum; n++, nn++) { caddr_t src; /* If it is bss section, insert the new data2 section before it. */ if (n == old_bss_index) { /* Steal the data section header for this data2 section. */ memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (old_data_index), new_file_h->e_shentsize); NEW_SECTION_H (nn).sh_addr = new_data2_addr; NEW_SECTION_H (nn).sh_offset = new_data2_offset; NEW_SECTION_H (nn).sh_size = new_data2_size; /* Use the bss section's alignment. This will assure that the new data2 section always be placed in the same spot as the old bss section by any other application. */ NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (n).sh_addralign; /* Now copy over what we have in the memory now. */ memcpy (NEW_SECTION_H (nn).sh_offset + new_base, (caddr_t) OLD_SECTION_H (n).sh_addr, new_data2_size); nn++; memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n), old_file_h->e_shentsize); /* The new bss section's size is zero, and its file offset and virtual address should be off by NEW_OFFSETS_SHIFT. */ NEW_SECTION_H (nn).sh_offset += new_offsets_shift; NEW_SECTION_H (nn).sh_addr = new_bss_addr; /* Let the new bss section address alignment be the same as the section address alignment followed the old bss section, so this section will be placed in exactly the same place. */ NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (nn).sh_addralign; NEW_SECTION_H (nn).sh_size = 0; } else memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n), old_file_h->e_shentsize); /* Any section that was original placed AFTER the bss section must now be adjusted by NEW_OFFSETS_SHIFT. */ if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset) NEW_SECTION_H (nn).sh_offset += new_offsets_shift; /* If any section hdr refers to the section after the new .data section, make it refer to next one because we have inserted a new section in between. */ PATCH_INDEX (NEW_SECTION_H (nn).sh_link); /* For symbol tables, info is a symbol table index, so don't change it. */ if (NEW_SECTION_H (nn).sh_type != SHT_SYMTAB && NEW_SECTION_H (nn).sh_type != SHT_DYNSYM) PATCH_INDEX (NEW_SECTION_H (nn).sh_info); /* Now, start to copy the content of sections. */ if (NEW_SECTION_H (nn).sh_type == SHT_NULL || NEW_SECTION_H (nn).sh_type == SHT_NOBITS) continue; /* Write out the sections. .data and .data1 (and data2, called ".data" in the strings table) get copied from the current process instead of the old file. */ if (!strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data") || !strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data1") || !strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".got")) src = (caddr_t) OLD_SECTION_H (n).sh_addr; else src = old_base + OLD_SECTION_H (n).sh_offset; memcpy (NEW_SECTION_H (nn).sh_offset + new_base, src, NEW_SECTION_H (nn).sh_size); /* Adjust the HDRR offsets in .mdebug and copy the line data if it's in its usual 'hole' in the object. Makes the new file debuggable with dbx. patches up two problems: the absolute file offsets in the HDRR record of .mdebug (see /usr/include/syms.h), and the ld bug that gets the line table in a hole in the elf file rather than in the .mdebug section proper. David Anderson. davea@sgi.com Jan 16,1994. */ if (n == old_mdebug_index) { #define MDEBUGADJUST(__ct,__fileaddr) \ if (n_phdrr->__ct > 0) \ { \ n_phdrr->__fileaddr += movement; \ } HDRR * o_phdrr = (HDRR *)((byte *)old_base + OLD_SECTION_H (n).sh_offset); HDRR * n_phdrr = (HDRR *)((byte *)new_base + NEW_SECTION_H (nn).sh_offset); unsigned movement = new_offsets_shift; MDEBUGADJUST (idnMax, cbDnOffset); MDEBUGADJUST (ipdMax, cbPdOffset); MDEBUGADJUST (isymMax, cbSymOffset); MDEBUGADJUST (ioptMax, cbOptOffset); MDEBUGADJUST (iauxMax, cbAuxOffset); MDEBUGADJUST (issMax, cbSsOffset); MDEBUGADJUST (issExtMax, cbSsExtOffset); MDEBUGADJUST (ifdMax, cbFdOffset); MDEBUGADJUST (crfd, cbRfdOffset); MDEBUGADJUST (iextMax, cbExtOffset); /* The Line Section, being possible off in a hole of the object, requires special handling. */ if (n_phdrr->cbLine > 0) { if (o_phdrr->cbLineOffset > (OLD_SECTION_H (n).sh_offset + OLD_SECTION_H (n).sh_size)) { /* line data is in a hole in elf. do special copy and adjust for this ld mistake. */ n_phdrr->cbLineOffset += movement; memcpy (n_phdrr->cbLineOffset + new_base, o_phdrr->cbLineOffset + old_base, n_phdrr->cbLine); } else { /* somehow line data is in .mdebug as it is supposed to be. */ MDEBUGADJUST (cbLine, cbLineOffset); } } } /* If it is the symbol table, its st_shndx field needs to be patched. */ if (NEW_SECTION_H (nn).sh_type == SHT_SYMTAB || NEW_SECTION_H (nn).sh_type == SHT_DYNSYM) { Elf32_Shdr *spt = &NEW_SECTION_H (nn); unsigned int num = spt->sh_size / spt->sh_entsize; Elf32_Sym * sym = (Elf32_Sym *) (NEW_SECTION_H (nn).sh_offset + new_base); for (; num--; sym++) { if (sym->st_shndx == SHN_UNDEF || sym->st_shndx == SHN_ABS || sym->st_shndx == SHN_COMMON) continue; PATCH_INDEX (sym->st_shndx); } } } /* Close the files and make the new file executable. */ if (close (old_file)) fatal ("Can't close (%s): errno %d\n", old_name, errno); if (close (new_file)) fatal ("Can't close (%s): errno %d\n", new_name, errno); if (stat (new_name, &stat_buf) == -1) fatal ("Can't stat (%s): errno %d\n", new_name, errno); n = umask (777); umask (n); stat_buf.st_mode |= 0111 & ~n; if (chmod (new_name, stat_buf.st_mode) == -1) fatal ("Can't chmod (%s): errno %d\n", new_name, errno); } emacs-19.30/src/unexelfsni.c100444 75424 12 71171 5741120270 14324 0ustar kwzhstaff/* Unexec for Siemens machines running Sinix (modified SVR4). Copyright (C) 1985, 1986, 1987, 1988, 1990, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. In other words, you are welcome to use, share and improve this program. You are forbidden to forbid anyone else to use, share and improve what you give them. Help stamp out software-hoarding! */ /* * unexec.c - Convert a running program into an a.out file. * * Author: Spencer W. Thomas * Computer Science Dept. * University of Utah * Date: Tue Mar 2 1982 * Modified heavily since then. * * Synopsis: * unexec (new_name, a_name, data_start, bss_start, entry_address) * char *new_name, *a_name; * unsigned data_start, bss_start, entry_address; * * Takes a snapshot of the program and makes an a.out format file in the * file named by the string argument new_name. * If a_name is non-NULL, the symbol table will be taken from the given file. * On some machines, an existing a_name file is required. * * The boundaries within the a.out file may be adjusted with the data_start * and bss_start arguments. Either or both may be given as 0 for defaults. * * Data_start gives the boundary between the text segment and the data * segment of the program. The text segment can contain shared, read-only * program code and literal data, while the data segment is always unshared * and unprotected. Data_start gives the lowest unprotected address. * The value you specify may be rounded down to a suitable boundary * as required by the machine you are using. * * Specifying zero for data_start means the boundary between text and data * should not be the same as when the program was loaded. * If NO_REMAP is defined, the argument data_start is ignored and the * segment boundaries are never changed. * * Bss_start indicates how much of the data segment is to be saved in the * a.out file and restored when the program is executed. It gives the lowest * unsaved address, and is rounded up to a page boundary. The default when 0 * is given assumes that the entire data segment is to be stored, including * the previous data and bss as well as any additional storage allocated with * break (2). * * The new file is set up to start at entry_address. * * If you make improvements I'd like to get them too. * harpo!utah-cs!thomas, thomas@Utah-20 * */ /* Even more heavily modified by james@bigtex.cactus.org of Dell Computer Co. * ELF support added. * * Basic theory: the data space of the running process needs to be * dumped to the output file. Normally we would just enlarge the size * of .data, scooting everything down. But we can't do that in ELF, * because there is often something between the .data space and the * .bss space. * * In the temacs dump below, notice that the Global Offset Table * (.got) and the Dynamic link data (.dynamic) come between .data1 and * .bss. It does not work to overlap .data with these fields. * * The solution is to create a new .data segment. This segment is * filled with data from the current process. Since the contents of * various sections refer to sections by index, the new .data segment * is made the last in the table to avoid changing any existing index. */ /* Modified by wtien@urbana.mcd.mot.com of Motorola Inc. * * The above mechanism does not work if the unexeced ELF file is being * re-layout by other applications (such as `strip'). All the applications * that re-layout the internal of ELF will layout all sections in ascending * order of their file offsets. After the re-layout, the data2 section will * still be the LAST section in the section header vector, but its file offset * is now being pushed far away down, and causes part of it not to be mapped * in (ie. not covered by the load segment entry in PHDR vector), therefore * causes the new binary to fail. * * The solution is to modify the unexec algorithm to insert the new data2 * section header right before the new bss section header, so their file * offsets will be in the ascending order. Since some of the section's (all * sections AFTER the bss section) indexes are now changed, we also need to * modify some fields to make them point to the right sections. This is done * by macro PATCH_INDEX. All the fields that need to be patched are: * * 1. ELF header e_shstrndx field. * 2. section header sh_link and sh_info field. * 3. symbol table entry st_shndx field. */ /* * New modifications for Siemens Nixdorf's MIPS-based machines. * Marco.Walther@mch.sni.de * * The problem: Before the bss segment we have a so called sbss segment * (small bss) and maybe an sdata segment. These segments * must also be handled correct. * * /home1/marco/emacs/emacs-19.22/src * dump -hv temacs * * temacs: * * **** SECTION HEADER TABLE **** * [No] Type Flags Addr Offset Size Name * Link Info Adralgn Entsize * * [1] PBIT -A-- 0x4000f4 0xf4 0x13 .interp * 0 0 0x1 0 * * [2] REGI -A-- 0x400108 0x108 0x18 .reginfo * 0 0 0x4 0x18 * * [3] DYNM -A-- 0x400120 0x120 0xb8 .dynamic * 6 0 0x4 0x8 * * [4] HASH -A-- 0x4001d8 0x1d8 0x8a0 .hash * 5 0 0x4 0x4 * * [5] DYNS -A-- 0x400a78 0xa78 0x11f0 .dynsym * 6 2 0x4 0x10 * * [6] STRT -A-- 0x401c68 0x1c68 0xbf9 .dynstr * 0 0 0x1 0 * * [7] REL -A-- 0x402864 0x2864 0x18 .rel.dyn * 5 14 0x4 0x8 * * [8] PBIT -AI- 0x402880 0x2880 0x60 .init * 0 0 0x10 0x1 * * [9] PBIT -AI- 0x4028e0 0x28e0 0x1234 .plt * 0 0 0x4 0x4 * * [10] PBIT -AI- 0x403b20 0x3b20 0xee400 .text * 0 0 0x20 0x1 * * [11] PBIT -AI- 0x4f1f20 0xf1f20 0x60 .fini * 0 0 0x10 0x1 * * [12] PBIT -A-- 0x4f1f80 0xf1f80 0xd90 .rdata * 0 0 0x10 0x1 * * [13] PBIT -A-- 0x4f2d10 0xf2d10 0x17e0 .rodata * 0 0 0x10 0x1 * * [14] PBIT WA-- 0x5344f0 0xf44f0 0x4b3e4 .data <<<<< * 0 0 0x10 0x1 * * [15] PBIT WA-G 0x57f8d4 0x13f8d4 0x2a84 .got * 0 0 0x4 0x4 * * [16] PBIT WA-G 0x582360 0x142360 0x10 .sdata <<<<< * 0 0 0x10 0x1 * * [17] NOBI WA-G 0x582370 0x142370 0xb84 .sbss <<<<< * 0 0 0x4 0 * * [18] NOBI WA-- 0x582f00 0x142370 0x27ec0 .bss <<<<< * 0 0 0x10 0x1 * * [19] SYMT ---- 0 0x142370 0x10e40 .symtab * 20 1108 0x4 0x10 * * [20] STRT ---- 0 0x1531b0 0xed9e .strtab * 0 0 0x1 0 * * [21] STRT ---- 0 0x161f4e 0xb5 .shstrtab * 0 0 0x1 0 * * [22] PBIT ---- 0 0x162003 0x28e2a .comment * 0 0 0x1 0x1 * * [23] PBIT ---- 0 0x18ae2d 0x592 .debug * 0 0 0x1 0 * * [24] PBIT ---- 0 0x18b3bf 0x80 .line * 0 0 0x1 0 * * [25] MDBG ---- 0 0x18b440 0x60 .mdebug * 0 0 0x4 0 * * * dump -hv emacs * * emacs: * * **** SECTION HEADER TABLE **** * [No] Type Flags Addr Offset Size Name * Link Info Adralgn Entsize * * [1] PBIT -A-- 0x4000f4 0xf4 0x13 .interp * 0 0 0x1 0 * * [2] REGI -A-- 0x400108 0x108 0x18 .reginfo * 0 0 0x4 0x18 * * [3] DYNM -A-- 0x400120 0x120 0xb8 .dynamic * 6 0 0x4 0x8 * * [4] HASH -A-- 0x4001d8 0x1d8 0x8a0 .hash * 5 0 0x4 0x4 * * [5] DYNS -A-- 0x400a78 0xa78 0x11f0 .dynsym * 6 2 0x4 0x10 * * [6] STRT -A-- 0x401c68 0x1c68 0xbf9 .dynstr * 0 0 0x1 0 * * [7] REL -A-- 0x402864 0x2864 0x18 .rel.dyn * 5 14 0x4 0x8 * * [8] PBIT -AI- 0x402880 0x2880 0x60 .init * 0 0 0x10 0x1 * * [9] PBIT -AI- 0x4028e0 0x28e0 0x1234 .plt * 0 0 0x4 0x4 * * [10] PBIT -AI- 0x403b20 0x3b20 0xee400 .text * 0 0 0x20 0x1 * * [11] PBIT -AI- 0x4f1f20 0xf1f20 0x60 .fini * 0 0 0x10 0x1 * * [12] PBIT -A-- 0x4f1f80 0xf1f80 0xd90 .rdata * 0 0 0x10 0x1 * * [13] PBIT -A-- 0x4f2d10 0xf2d10 0x17e0 .rodata * 0 0 0x10 0x1 * * [14] PBIT WA-- 0x5344f0 0xf44f0 0x4b3e4 .data <<<<< * 0 0 0x10 0x1 * * [15] PBIT WA-G 0x57f8d4 0x13f8d4 0x2a84 .got * 0 0 0x4 0x4 * * [16] PBIT WA-G 0x582360 0x142360 0xb94 .sdata <<<<< * 0 0 0x10 0x1 * * [17] PBIT WA-- 0x582f00 0x142f00 0x94100 .data <<<<< * 0 0 0x10 0x1 * * [18] NOBI WA-G 0x617000 0x1d7000 0 .sbss <<<<< * 0 0 0x4 0 * * [19] NOBI WA-- 0x617000 0x1d7000 0 .bss <<<<< * 0 0 0x4 0x1 * * [20] SYMT ---- 0 0x1d7000 0x10e40 .symtab * 21 1109 0x4 0x10 * * [21] STRT ---- 0 0x1e7e40 0xed9e .strtab * 0 0 0x1 0 * * [22] STRT ---- 0 0x1f6bde 0xb5 .shstrtab * 0 0 0x1 0 * * [23] PBIT ---- 0 0x1f6c93 0x28e2a .comment * 0 0 0x1 0x1 * * [24] PBIT ---- 0 0x21fabd 0x592 .debug * 0 0 0x1 0 * * [25] PBIT ---- 0 0x22004f 0x80 .line * 0 0 0x1 0 * * [26] MDBG ---- 0 0x2200d0 0x60 .mdebug * 0 0 0x4 0 * */ #include #include #include #include #include #include #include #include #include #include #ifndef emacs #define fatal(a, b, c) fprintf(stderr, a, b, c), exit(1) #else extern void fatal(char *, ...); #endif /* Get the address of a particular section or program header entry, * accounting for the size of the entries. */ #define OLD_SECTION_H(n) \ (*(Elf32_Shdr *) ((byte *) old_section_h + old_file_h->e_shentsize * (n))) #define NEW_SECTION_H(n) \ (*(Elf32_Shdr *) ((byte *) new_section_h + new_file_h->e_shentsize * (n))) #define OLD_PROGRAM_H(n) \ (*(Elf32_Phdr *) ((byte *) old_program_h + old_file_h->e_phentsize * (n))) #define NEW_PROGRAM_H(n) \ (*(Elf32_Phdr *) ((byte *) new_program_h + new_file_h->e_phentsize * (n))) #define PATCH_INDEX(n) \ do { \ if ((n) >= old_sbss_index) \ (n) += 1 + (old_sdata_index ? 0 : 1); } while (0) typedef unsigned char byte; /* Round X up to a multiple of Y. */ int round_up (x, y) int x, y; { int rem = x % y; if (rem == 0) return x; return x - rem + y; } /* **************************************************************** * unexec * * driving logic. * * In ELF, this works by replacing the old .bss section with a new * .data section, and inserting an empty .bss immediately afterwards. * */ void unexec (new_name, old_name, data_start, bss_start, entry_address) char *new_name, *old_name; unsigned data_start, bss_start, entry_address; { extern unsigned int bss_end; int new_file, old_file, new_file_size; /* Pointers to the base of the image of the two files. */ caddr_t old_base, new_base; /* Pointers to the file, program and section headers for the old and new * files. */ Elf32_Ehdr *old_file_h, *new_file_h; Elf32_Phdr *old_program_h, *new_program_h; Elf32_Shdr *old_section_h, *new_section_h; /* Point to the section name table in the old file */ char *old_section_names; Elf32_Addr old_bss_addr, new_bss_addr; Elf32_Addr old_sbss_addr; Elf32_Word old_bss_size, new_data2_size; Elf32_Word old_sbss_size, new_data3_size; Elf32_Off new_data2_offset; Elf32_Off new_data3_offset; Elf32_Addr new_data2_addr; Elf32_Addr new_data3_addr; Elf32_Word old_sdata_size, new_sdata_size; int old_sdata_index = 0; int n, nn, old_data_index, new_data2_align; int old_bss_index; int old_sbss_index; int old_bss_padding; struct stat stat_buf; /* Open the old file & map it into the address space. */ old_file = open (old_name, O_RDONLY); if (old_file < 0) fatal ("Can't open %s for reading: errno %d\n", old_name, errno); if (fstat (old_file, &stat_buf) == -1) fatal ("Can't fstat(%s): errno %d\n", old_name, errno); old_base = mmap (0, stat_buf.st_size, PROT_READ, MAP_SHARED, old_file, 0); if (old_base == (caddr_t) -1) fatal ("Can't mmap(%s): errno %d\n", old_name, errno); #ifdef DEBUG fprintf (stderr, "mmap(%s, %x) -> %x\n", old_name, stat_buf.st_size, old_base); #endif /* Get pointers to headers & section names */ old_file_h = (Elf32_Ehdr *) old_base; old_program_h = (Elf32_Phdr *) ((byte *) old_base + old_file_h->e_phoff); old_section_h = (Elf32_Shdr *) ((byte *) old_base + old_file_h->e_shoff); old_section_names = (char *) old_base + OLD_SECTION_H(old_file_h->e_shstrndx).sh_offset; /* Find the old .sbss section. */ for (old_sbss_index = 1; old_sbss_index < old_file_h->e_shnum; old_sbss_index++) { #ifdef DEBUG fprintf (stderr, "Looking for .sbss - found %s\n", old_section_names + OLD_SECTION_H(old_sbss_index).sh_name); #endif if (!strcmp (old_section_names + OLD_SECTION_H(old_sbss_index).sh_name, ".sbss")) break; } if (old_sbss_index == old_file_h->e_shnum) fatal ("Can't find .sbss in %s.\n", old_name, 0); if (!strcmp(old_section_names + OLD_SECTION_H(old_sbss_index - 1).sh_name, ".sdata")) { old_sdata_index = old_sbss_index - 1; } /* Find the old .bss section. */ for (old_bss_index = 1; old_bss_index < old_file_h->e_shnum; old_bss_index++) { #ifdef DEBUG fprintf (stderr, "Looking for .bss - found %s\n", old_section_names + OLD_SECTION_H(old_bss_index).sh_name); #endif if (!strcmp (old_section_names + OLD_SECTION_H(old_bss_index).sh_name, ".bss")) break; } if (old_bss_index == old_file_h->e_shnum) fatal ("Can't find .bss in %s.\n", old_name, 0); if (old_sbss_index != (old_bss_index - 1)) fatal (".sbss should come immediatly before .bss in %s.\n", old_name, 0); /* Figure out parameters of the new data3 and data2 sections. * Change the sbss and bss sections. */ old_bss_addr = OLD_SECTION_H(old_bss_index).sh_addr; old_bss_size = OLD_SECTION_H(old_bss_index).sh_size; old_sbss_addr = OLD_SECTION_H(old_sbss_index).sh_addr; old_sbss_size = OLD_SECTION_H(old_sbss_index).sh_size; if (old_sdata_index) { old_sdata_size = OLD_SECTION_H(old_sdata_index).sh_size; } #if defined(emacs) || !defined(DEBUG) bss_end = (unsigned int) sbrk (0); new_bss_addr = (Elf32_Addr) bss_end; #else new_bss_addr = old_bss_addr + old_bss_size + 0x1234; #endif if (old_sdata_index) { new_sdata_size = OLD_SECTION_H(old_sbss_index).sh_offset - OLD_SECTION_H(old_sdata_index).sh_offset + old_sbss_size; } new_data3_addr = old_sbss_addr; new_data3_size = old_sbss_size; new_data3_offset = OLD_SECTION_H(old_sbss_index).sh_offset; new_data2_addr = old_bss_addr; new_data2_size = new_bss_addr - old_bss_addr; new_data2_align = (new_data3_offset + old_sbss_size) % OLD_SECTION_H(old_bss_index).sh_addralign; new_data2_align = new_data2_align ? OLD_SECTION_H(old_bss_index).sh_addralign - new_data2_align : 0; new_data2_offset = new_data3_offset + old_sbss_size + new_data2_align; old_bss_padding = OLD_SECTION_H(old_bss_index).sh_offset - OLD_SECTION_H(old_sbss_index).sh_offset; #ifdef DEBUG fprintf (stderr, "old_bss_index %d\n", old_bss_index); fprintf (stderr, "old_bss_addr %x\n", old_bss_addr); fprintf (stderr, "old_bss_size %x\n", old_bss_size); fprintf (stderr, "new_bss_addr %x\n", new_bss_addr); fprintf (stderr, "new_data2_addr %x\n", new_data2_addr); fprintf (stderr, "new_data2_size %x\n", new_data2_size); fprintf (stderr, "new_data2_offset %x\n", new_data2_offset); fprintf (stderr, "old_sbss_index %d\n", old_sbss_index); fprintf (stderr, "old_sbss_addr %x\n", old_sbss_addr); fprintf (stderr, "old_sbss_size %x\n", old_sbss_size); if (old_sdata_index) { fprintf (stderr, "old_sdata_size %x\n", old_sdata_size); fprintf (stderr, "new_sdata_size %x\n", new_sdata_size); } else { fprintf (stderr, "new_data3_addr %x\n", new_data3_addr); fprintf (stderr, "new_data3_size %x\n", new_data3_size); fprintf (stderr, "new_data3_offset %x\n", new_data3_offset); } #endif if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size) fatal (".bss shrank when undumping???\n", 0, 0); /* Set the output file to the right size and mmap(2) it. Set * pointers to various interesting objects. stat_buf still has * old_file data. */ new_file = open (new_name, O_RDWR | O_CREAT, 0666); if (new_file < 0) fatal ("Can't creat(%s): errno %d\n", new_name, errno); new_file_size = stat_buf.st_size + ((1 + (old_sdata_index ? 0 : 1)) * old_file_h->e_shentsize) + new_data2_size + new_data3_size + new_data2_align; if (ftruncate (new_file, new_file_size)) fatal ("Can't ftruncate(%s): errno %d\n", new_name, errno); new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_SHARED, new_file, 0); if (new_base == (caddr_t) -1) fatal ("Can't mmap(%s): errno %d\n", new_name, errno); new_file_h = (Elf32_Ehdr *) new_base; new_program_h = (Elf32_Phdr *) ((byte *) new_base + old_file_h->e_phoff); new_section_h = (Elf32_Shdr *) ((byte *) new_base + old_file_h->e_shoff + new_data2_size + new_data2_align + new_data3_size); /* Make our new file, program and section headers as copies of the * originals. */ memcpy (new_file_h, old_file_h, old_file_h->e_ehsize); memcpy (new_program_h, old_program_h, old_file_h->e_phnum * old_file_h->e_phentsize); /* Modify the e_shstrndx if necessary. */ PATCH_INDEX (new_file_h->e_shstrndx); /* Fix up file header. We'll add one section. Section header is * further away now. */ new_file_h->e_shoff += new_data2_size + new_data2_align + new_data3_size; new_file_h->e_shnum += 1 + (old_sdata_index ? 0 : 1); #ifdef DEBUG fprintf (stderr, "Old section offset %x\n", old_file_h->e_shoff); fprintf (stderr, "Old section count %d\n", old_file_h->e_shnum); fprintf (stderr, "New section offset %x\n", new_file_h->e_shoff); fprintf (stderr, "New section count %d\n", new_file_h->e_shnum); #endif /* Fix up a new program header. Extend the writable data segment so * that the bss area is covered too. Find that segment by looking * for a segment that ends just before the .bss area. Make sure * that no segments are above the new .data2. Put a loop at the end * to adjust the offset and address of any segment that is above * data2, just in case we decide to allow this later. */ for (n = new_file_h->e_phnum - 1; n >= 0; n--) { /* Compute maximum of all requirements for alignment of section. */ int alignment = (NEW_PROGRAM_H (n)).p_align; if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment) alignment = OLD_SECTION_H (old_bss_index).sh_addralign; if ((OLD_SECTION_H (old_sbss_index)).sh_addralign > alignment) alignment = OLD_SECTION_H (old_sbss_index).sh_addralign; /* Supposedly this condition is okay for the SGI. */ #if 0 if (NEW_PROGRAM_H(n).p_vaddr + NEW_PROGRAM_H(n).p_filesz > old_bss_addr) fatal ("Program segment above .bss in %s\n", old_name, 0); #endif if (NEW_PROGRAM_H(n).p_type == PT_LOAD && (round_up ((NEW_PROGRAM_H (n)).p_vaddr + (NEW_PROGRAM_H (n)).p_filesz, alignment) == round_up (old_bss_addr, alignment))) break; } if (n < 0) fatal ("Couldn't find segment next to .bss in %s\n", old_name, 0); NEW_PROGRAM_H(n).p_filesz += new_data2_size + new_data2_align + new_data3_size; NEW_PROGRAM_H(n).p_memsz = NEW_PROGRAM_H(n).p_filesz; #if 1 /* Maybe allow section after data2 - does this ever happen? */ for (n = new_file_h->e_phnum - 1; n >= 0; n--) { if (NEW_PROGRAM_H(n).p_vaddr && NEW_PROGRAM_H(n).p_vaddr >= new_data3_addr) NEW_PROGRAM_H(n).p_vaddr += new_data2_size - old_bss_size + new_data3_size - old_sbss_size; if (NEW_PROGRAM_H(n).p_offset >= new_data3_offset) NEW_PROGRAM_H(n).p_offset += new_data2_size + new_data2_align + new_data3_size; } #endif /* Fix up section headers based on new .data2 section. Any section * whose offset or virtual address is after the new .data2 section * gets its value adjusted. .bss size becomes zero and new address * is set. data2 section header gets added by copying the existing * .data header and modifying the offset, address and size. */ for (old_data_index = 1; old_data_index < old_file_h->e_shnum; old_data_index++) if (!strcmp (old_section_names + OLD_SECTION_H(old_data_index).sh_name, ".data")) break; if (old_data_index == old_file_h->e_shnum) fatal ("Can't find .data in %s.\n", old_name, 0); /* Walk through all section headers, insert the new data2 section right before the new bss section. */ for (n = 1, nn = 1; n < old_file_h->e_shnum; n++, nn++) { caddr_t src; if (n == old_sbss_index) /* If it is sbss section, insert the new data3 section before it. */ { /* Steal the data section header for this data3 section. */ if (!old_sdata_index) { memcpy (&NEW_SECTION_H(nn), &OLD_SECTION_H(old_data_index), new_file_h->e_shentsize); NEW_SECTION_H(nn).sh_addr = new_data3_addr; NEW_SECTION_H(nn).sh_offset = new_data3_offset; NEW_SECTION_H(nn).sh_size = new_data3_size; NEW_SECTION_H(nn).sh_flags = OLD_SECTION_H(n).sh_flags; /* Use the sbss section's alignment. This will assure that the new data3 section always be placed in the same spot as the old sbss section by any other application. */ NEW_SECTION_H(nn).sh_addralign = OLD_SECTION_H(n).sh_addralign; /* Now copy over what we have in the memory now. */ memcpy (NEW_SECTION_H(nn).sh_offset + new_base, (caddr_t) OLD_SECTION_H(n).sh_addr, new_data3_size); /* the new .data2 section should also come before the * new .sbss section */ nn += 2; } else { /* We always have a .sdata section: append the contents of the * old .sbss section. */ memcpy (new_data3_offset + new_base, (caddr_t) OLD_SECTION_H(n).sh_addr, new_data3_size); nn ++; } } else if (n == old_bss_index) /* If it is bss section, insert the new data2 section before it. */ { Elf32_Word tmp_align; Elf32_Addr tmp_addr; tmp_align = OLD_SECTION_H(n).sh_addralign; tmp_addr = OLD_SECTION_H(n).sh_addr; nn -= 2; /* Steal the data section header for this data2 section. */ memcpy (&NEW_SECTION_H(nn), &OLD_SECTION_H(old_data_index), new_file_h->e_shentsize); NEW_SECTION_H(nn).sh_addr = new_data2_addr; NEW_SECTION_H(nn).sh_offset = new_data2_offset; NEW_SECTION_H(nn).sh_size = new_data2_size; /* Use the bss section's alignment. This will assure that the new data2 section always be placed in the same spot as the old bss section by any other application. */ NEW_SECTION_H(nn).sh_addralign = tmp_align; /* Now copy over what we have in the memory now. */ memcpy (NEW_SECTION_H(nn).sh_offset + new_base, (caddr_t) tmp_addr, new_data2_size); nn += 2; } memcpy (&NEW_SECTION_H(nn), &OLD_SECTION_H(n), old_file_h->e_shentsize); if (old_sdata_index && n == old_sdata_index) /* The old .sdata section has now a new size */ NEW_SECTION_H(nn).sh_size = new_sdata_size; /* The new bss section's size is zero, and its file offset and virtual address should be off by NEW_DATA2_SIZE. */ if (n == old_sbss_index) { /* NN should be `old_sbss_index + 2' at this point. */ NEW_SECTION_H(nn).sh_offset += new_data2_size + new_data2_align + new_data3_size; NEW_SECTION_H(nn).sh_addr += new_data2_size + new_data2_align + new_data3_size; /* Let the new bss section address alignment be the same as the section address alignment followed the old bss section, so this section will be placed in exactly the same place. */ NEW_SECTION_H(nn).sh_addralign = OLD_SECTION_H(nn + (old_sdata_index ? 1 : 0)).sh_addralign; NEW_SECTION_H(nn).sh_size = 0; } else if (n == old_bss_index) { /* NN should be `old_bss_index + 2' at this point. */ NEW_SECTION_H(nn).sh_offset += new_data2_size + new_data2_align + new_data3_size - old_bss_padding; NEW_SECTION_H(nn).sh_addr += new_data2_size; /* Let the new bss section address alignment be the same as the section address alignment followed the old bss section, so this section will be placed in exactly the same place. */ NEW_SECTION_H(nn).sh_addralign = OLD_SECTION_H((nn - (old_sdata_index ? 0 : 1))).sh_addralign; NEW_SECTION_H(nn).sh_size = 0; } /* Any section that was original placed AFTER the bss section should now be off by NEW_DATA2_SIZE. */ else if (NEW_SECTION_H(nn).sh_offset >= new_data3_offset) NEW_SECTION_H(nn).sh_offset += new_data2_size + new_data2_align + new_data3_size - old_bss_padding; /* If any section hdr refers to the section after the new .data section, make it refer to next one because we have inserted a new section in between. */ PATCH_INDEX(NEW_SECTION_H(nn).sh_link); PATCH_INDEX(NEW_SECTION_H(nn).sh_info); /* Now, start to copy the content of sections. */ if (NEW_SECTION_H(nn).sh_type == SHT_NULL || NEW_SECTION_H(nn).sh_type == SHT_NOBITS) continue; /* Write out the sections. .data, .data1 and .sdata get copied from * the current process instead of the old file. */ if (!strcmp (old_section_names + OLD_SECTION_H(n).sh_name, ".data") || !strcmp (old_section_names + OLD_SECTION_H(n).sh_name, ".data1") || (old_sdata_index && (n == old_sdata_index))) src = (caddr_t) OLD_SECTION_H(n).sh_addr; else src = old_base + OLD_SECTION_H(n).sh_offset; memcpy (NEW_SECTION_H(nn).sh_offset + new_base, src, ((n == old_sdata_index) ? old_sdata_size : NEW_SECTION_H(nn).sh_size)); /* If it is the symbol table, its st_shndx field needs to be patched. */ if (NEW_SECTION_H(nn).sh_type == SHT_SYMTAB || NEW_SECTION_H(nn).sh_type == SHT_DYNSYM) { Elf32_Shdr *spt = &NEW_SECTION_H(nn); unsigned int num = spt->sh_size / spt->sh_entsize; Elf32_Sym * sym = (Elf32_Sym *) (NEW_SECTION_H(nn).sh_offset + new_base); for (; num--; sym++) { if ((sym->st_shndx == SHN_UNDEF) || (sym->st_shndx == SHN_ABS) || (sym->st_shndx == SHN_COMMON)) continue; PATCH_INDEX(sym->st_shndx); } } } /* Close the files and make the new file executable */ if (close (old_file)) fatal ("Can't close(%s): errno %d\n", old_name, errno); if (close (new_file)) fatal ("Can't close(%s): errno %d\n", new_name, errno); if (stat (new_name, &stat_buf) == -1) fatal ("Can't stat(%s): errno %d\n", new_name, errno); n = umask (777); umask (n); stat_buf.st_mode |= 0111 & ~n; if (chmod (new_name, stat_buf.st_mode) == -1) fatal ("Can't chmod(%s): errno %d\n", new_name, errno); } emacs-19.30/src/unexencap.c100444 12241 12 6176 5444474634 14415 0ustar rolandstaff/* Waiting for papers! */ /* * Do an unexec() for coff encapsulation. Uses the approach I took * for AKCL, so don't be surprised if it doesn't look too much like * the other unexec() routines. Assumes NO_REMAP. Should be easy to * adapt to the emacs style unexec() if that is desired, but this works * just fine for me with GCC/GAS/GLD under System V. - Jordan */ #include #include #include #include #include "/usr/gnu/lib/gcc/gcc-include/a.out.h" filecpy(to, from, n) FILE *to, *from; register int n; { char buffer[BUFSIZ]; for (;;) if (n > BUFSIZ) { fread(buffer, BUFSIZ, 1, from); fwrite(buffer, BUFSIZ, 1, to); n -= BUFSIZ; } else if (n > 0) { fread(buffer, 1, n, from); fwrite(buffer, 1, n, to); break; } else break; } /* **************************************************************** * unexec * * driving logic. * ****************************************************************/ unexec (new_name, a_name, data_start, bss_start, entry_address) char *new_name, *a_name; unsigned data_start, bss_start, entry_address; { struct coffheader header1; struct coffscn *tp, *dp, *bp; struct exec header; int stsize; char *original_file = a_name; char *save_file = new_name; char *data_begin, *data_end; int original_data; FILE *original, *save; register int n; register char *p; extern char *sbrk(); char stdin_buf[BUFSIZ], stdout_buf[BUFSIZ]; fclose(stdin); original = fopen(original_file, "r"); if (stdin != original || original->_file != 0) { fprintf(stderr, "unexec: Can't open the original file.\n"); exit(1); } setbuf(original, stdin_buf); fclose(stdout); unlink(save_file); n = open(save_file, O_CREAT|O_WRONLY, 0777); if (n != 1 || (save = fdopen(n, "w")) != stdout) { fprintf(stderr, "unexec: Can't open the save file.\n"); exit(1); } setbuf(save, stdout_buf); fread(&header1, sizeof(header1), 1, original); tp = &header1.scns[0]; dp = &header1.scns[1]; bp = &header1.scns[2]; fread(&header, sizeof(header), 1, original); data_begin=(char *)N_DATADDR(header); data_end = sbrk(0); original_data = header.a_data; header.a_data = data_end - data_begin; header.a_bss = 0; dp->s_size = header.a_data; bp->s_paddr = dp->s_vaddr + dp->s_size; bp->s_vaddr = bp->s_paddr; bp->s_size = 0; header1.tsize = tp->s_size; header1.dsize = dp->s_size; header1.bsize = bp->s_size; fwrite(&header1, sizeof(header1), 1, save); fwrite(&header, sizeof(header), 1, save); filecpy(save, original, header.a_text); for (n = header.a_data, p = data_begin; ; n -= BUFSIZ, p += BUFSIZ) if (n > BUFSIZ) fwrite(p, BUFSIZ, 1, save); else if (n > 0) { fwrite(p, 1, n, save); break; } else break; fseek(original, original_data, 1); filecpy(save, original, header.a_syms+header.a_trsize+header.a_drsize); fread(&stsize, sizeof(stsize), 1, original); fwrite(&stsize, sizeof(stsize), 1, save); filecpy(save, original, stsize - sizeof(stsize)); fclose(original); fclose(save); } emacs-19.30/src/unexenix.c100444 12241 1 16704 5513624111 14406 0ustar rolanddaemon/* Unexec for Xenix. Note that the GNU project considers support for Xenix operation a peripheral activity which should not be allowed to divert effort from development of the GNU system. Changes in this code will be installed when Xenix users send them in, but aside from that we don't plan to think about it, or about whether other Emacs maintenance might break it. Copyright (C) 1988, 1994 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. */ /* On 80386 Xenix, segmentation screws prevent us from modifying the text segment at all. We basically just plug a new value for "data segment size" into the countless headers and copy the other records straight through. The data segment is ORG'ed at the xs_rbase value of the data segment's xseg record (always @ 0x1880000, thanks to the "sophisticated memory management hardware" of the chip) and extends to sbrk(0), exactly. This code is afraid to malloc (should it be?), and alloca has to be the wimpy, malloc-based version; consequently, data is usually copied in smallish chunks. gb@entity.com */ #include #include #include #include #include #include #include #include static void fatal_unexec (); #define READ(_fd, _buffer, _size, _error_message, _error_arg) \ errno = EEOF; \ if (read(_fd, _buffer, _size) != _size) \ fatal_unexec(_error_message, _error_arg); #define WRITE(_fd, _buffer, _size, _error_message, _error_arg) \ if (write(_fd, _buffer, _size) != _size) \ fatal_unexec(_error_message, _error_arg); #define SEEK(_fd, _position, _error_message, _error_arg) \ errno = EEOF; \ if (lseek(_fd, _position, L_SET) != _position) \ fatal_unexec(_error_message, _error_arg); extern int errno; extern char *strerror (); #define EEOF -1 #ifndef L_SET #define L_SET 0 #endif /* Should check the magic number of the old executable; not yet written. */ check_exec (x) struct xexec *x; { } unexec (new_name, a_name, data_start, bss_start, entry_address) char *new_name, *a_name; unsigned data_start, bss_start, entry_address; { char *sbrk (), *datalim = sbrk (0), *data_org; long segpos, textseen, textpos, textlen, datapos, datadiff, datalen; struct xexec u_xexec, /* a.out header */ *u_xexecp = &u_xexec; struct xext u_xext, /* extended header */ *u_xextp = &u_xext; struct xseg u_xseg, /* segment table entry */ *u_xsegp = &u_xseg; int i, nsegs, isdata = 0, infd, outfd; infd = open (a_name, O_RDONLY, 0); if (infd < 0) fatal_unexec ("opening %s", a_name); outfd = creat (new_name, 0666); if (outfd < 0) fatal_unexec ("creating %s", new_name); READ (infd, u_xexecp, sizeof (struct xexec), "error reading %s", a_name); check_exec (u_xexecp); READ (infd, u_xextp, sizeof (struct xext), "error reading %s", a_name); segpos = u_xextp->xe_segpos; nsegs = u_xextp->xe_segsize / sizeof (struct xseg); SEEK (infd, segpos, "seek error on %s", a_name); for (i = 0; i < nsegs; i ++) { READ (infd, u_xsegp, sizeof (struct xseg), "error reading %s", a_name); switch (u_xsegp->xs_type) { case XS_TTEXT: { if (i == 0) { textpos = u_xsegp->xs_filpos; textlen = u_xsegp->xs_psize; break; } fatal_unexec ("invalid text segment in %s", a_name); } case XS_TDATA: { if (i == 1) { datapos = u_xsegp->xs_filpos; datalen = datalim - (data_org = (char *)(u_xsegp->xs_rbase)); datadiff = datalen - u_xsegp->xs_psize; break; } fatal_unexec ("invalid data segment in %s", a_name); } default: { if (i > 1) break; fatal_unexec ("invalid segment record in %s", a_name); } } } u_xexecp->x_data = datalen; u_xexecp->x_bss = 0; WRITE (outfd, u_xexecp, sizeof (struct xexec), "error writing %s", new_name); WRITE (outfd, u_xextp, sizeof (struct xext), "error writing %s", new_name); SEEK (infd, segpos, "seek error on %s", a_name); SEEK (outfd, segpos, "seek error on %s", new_name); /* Copy the text segment record verbatim. */ copyrec (infd, outfd, sizeof (struct xseg), a_name, new_name); /* Read, modify, write the data segment record. */ READ (infd, u_xsegp, sizeof (struct xseg), "error reading %s", a_name); u_xsegp->xs_psize = u_xsegp->xs_vsize = datalen; u_xsegp->xs_attr &= (~XS_AITER & ~XS_ABSS); WRITE (outfd, u_xsegp, sizeof (struct xseg), "error writing %s", new_name); /* Now copy any additional segment records, adjusting their file position field */ for (i = 2; i < nsegs; i++) { READ (infd, u_xsegp, sizeof (struct xseg), "error reading %s", a_name); u_xsegp->xs_filpos += datadiff; WRITE (outfd, u_xsegp, sizeof (struct xseg), "error writing %s", new_name); } SEEK (infd, textpos, "seek error on %s", a_name); SEEK (outfd, textpos, "seek error on %s", new_name); copyrec (infd, outfd, textlen, a_name, new_name); SEEK (outfd, datapos, "seek error on %s", new_name); WRITE (outfd, data_org, datalen, "write error on %s", new_name); for (i = 2, segpos += (2 * sizeof (struct xseg)); i < nsegs; i++, segpos += sizeof (struct xseg)) { SEEK (infd, segpos, "seek error on %s", a_name); READ (infd, u_xsegp, sizeof (struct xseg), "read error on %s", a_name); SEEK (infd, u_xsegp->xs_filpos, "seek error on %s", a_name); /* We should be at eof in the output file here, but we must seek because the xs_filpos and xs_psize fields in symbol table segments are inconsistent. */ SEEK (outfd, u_xsegp->xs_filpos + datadiff, "seek error on %s", new_name); copyrec (infd, outfd, u_xsegp->xs_psize, a_name, new_name); } close (infd); close (outfd); mark_x (new_name); return 0; } copyrec (infd, outfd, len, in_name, out_name) int infd, outfd, len; char *in_name, *out_name; { char buf[BUFSIZ]; int chunk; while (len) { chunk = BUFSIZ; if (chunk > len) chunk = len; READ (infd, buf, chunk, "error reading %s", in_name); WRITE (outfd, buf, chunk, "error writing %s", out_name); len -= chunk; } } /* * mark_x * * After successfully building the new a.out, mark it executable */ static mark_x (name) char *name; { struct stat sbuf; int um = umask (777); umask (um); if (stat (name, &sbuf) < 0) fatal_unexec ("getting protection on %s", name); sbuf.st_mode |= 0111 & ~um; if (chmod (name, sbuf.st_mode) < 0) fatal_unexec ("setting protection on %s", name); } static void fatal_unexec (s, va_alist) va_dcl { va_list ap; if (errno == EEOF) fputs ("unexec: unexpected end of file, ", stderr); else fprintf (stderr, "unexec: %s, ", strerror (errno)); va_start (ap); _doprnt (s, ap, stderr); fputs (".\n", stderr); exit (1); } emacs-19.30/src/unexfx2800.c100444 12241 12 667 5444474635 14236 0ustar rolandstaff/* Unexec for the Alliant FX/2800. */ #include unexec (new_name, a_name, data_start, bss_start, entry_address) char *new_name, *a_name; unsigned data_start, bss_start, entry_address; { int stat; stat = elf_write_modified_data (a_name, new_name); if (stat < 0) perror ("emacs: elf_write_modified_data"); else if (stat > 0) fprintf (stderr, "Unspecified error from elf_write_modified_data.\n"); } emacs-19.30/src/unexhp9k800.c100444 12120 1 22640 5571735670 14101 0ustar rmsdaemon/* Unexec for HP 9000 Series 800 machines. Bob Desinger Note that the GNU project considers support for HP operation a peripheral activity which should not be allowed to divert effort from development of the GNU system. Changes in this code will be installed when users send them in, but aside from that we don't plan to think about it, or about whether other Emacs maintenance might break it. Unexec creates a copy of the old a.out file, and replaces the old data area with the current data area. When the new file is executed, the process will see the same data structures and data values that the original process had when unexec was called. Unlike other versions of unexec, this one copies symbol table and debug information to the new a.out file. Thus, the new a.out file may be debugged with symbolic debuggers. If you fix any bugs in this, I'd like to incorporate your fixes. Send them to uunet!hpda!hpsemc!jmorris or jmorris%hpsemc@hplabs.HP.COM. CAVEATS: This routine saves the current value of all static and external variables. This means that any data structure that needs to be initialized must be explicitly reset. Variables will not have their expected default values. Unfortunately, the HP-UX signal handler has internal initialization flags which are not explicitly reset. Thus, for signals to work in conjunction with this routine, the following code must executed when the new process starts up. void _sigreturn (); ... sigsetreturn (_sigreturn); */ #include #include #include #include #ifdef emacs #include #endif #ifdef HPUX_USE_SHLIBS #include #endif /* brk value to restore, stored as a global. This is really used only if we used shared libraries. */ static long brk_on_dump = 0; /* Called from main, if we use shared libraries. */ int run_time_remap (ignored) char *ignored; { brk (brk_on_dump); } #undef roundup #define roundup(x,n) (((x) + ((n) - 1)) & ~((n) - 1)) /* n is power of 2 */ #define min(x,y) (((x) < (y)) ? (x) : (y)) /* Create a new a.out file, same as old but with current data space */ unexec (new_name, old_name, new_end_of_text, dummy1, dummy2) char new_name[]; /* name of the new a.out file to be created */ char old_name[]; /* name of the old a.out file */ char *new_end_of_text; /* ptr to new edata/etext; NOT USED YET */ int dummy1, dummy2; /* not used by emacs */ { int old, new; int old_size, new_size; struct header hdr; struct som_exec_auxhdr auxhdr; long i; /* For the greatest flexibility, should create a temporary file in the same directory as the new file. When everything is complete, rename the temp file to the new name. This way, a program could update its own a.out file even while it is still executing. If problems occur, everything is still intact. NOT implemented. */ /* Open the input and output a.out files */ old = open (old_name, O_RDONLY); if (old < 0) { perror (old_name); exit (1); } new = open (new_name, O_CREAT|O_RDWR|O_TRUNC, 0777); if (new < 0) { perror (new_name); exit (1); } /* Read the old headers */ read_header (old, &hdr, &auxhdr); brk_on_dump = sbrk (0); /* Decide how large the new and old data areas are */ old_size = auxhdr.exec_dsize; /* I suspect these two statements are separate to avoid a compiler bug in hpux version 8. */ i = sbrk (0); new_size = i - auxhdr.exec_dmem; /* Copy the old file to the new, up to the data space */ lseek (old, 0, 0); copy_file (old, new, auxhdr.exec_dfile); /* Skip the old data segment and write a new one */ lseek (old, old_size, 1); save_data_space (new, &hdr, &auxhdr, new_size); /* Copy the rest of the file */ copy_rest (old, new); /* Update file pointers since we probably changed size of data area */ update_file_ptrs (new, &hdr, &auxhdr, auxhdr.exec_dfile, new_size-old_size); /* Save the modified header */ write_header (new, &hdr, &auxhdr); /* Close the binary file */ close (old); close (new); return 0; } /* Save current data space in the file, update header. */ save_data_space (file, hdr, auxhdr, size) int file; struct header *hdr; struct som_exec_auxhdr *auxhdr; int size; { /* Write the entire data space out to the file */ if (write (file, auxhdr->exec_dmem, size) != size) { perror ("Can't save new data space"); exit (1); } /* Update the header to reflect the new data size */ auxhdr->exec_dsize = size; auxhdr->exec_bsize = 0; } /* Update the values of file pointers when something is inserted. */ update_file_ptrs (file, hdr, auxhdr, location, offset) int file; struct header *hdr; struct som_exec_auxhdr *auxhdr; unsigned int location; int offset; { struct subspace_dictionary_record subspace; int i; /* Increase the overall size of the module */ hdr->som_length += offset; /* Update the various file pointers in the header */ #define update(ptr) if (ptr > location) ptr = ptr + offset update (hdr->aux_header_location); update (hdr->space_strings_location); update (hdr->init_array_location); update (hdr->compiler_location); update (hdr->symbol_location); update (hdr->fixup_request_location); update (hdr->symbol_strings_location); update (hdr->unloadable_sp_location); update (auxhdr->exec_tfile); update (auxhdr->exec_dfile); /* Do for each subspace dictionary entry */ lseek (file, hdr->subspace_location, 0); for (i = 0; i < hdr->subspace_total; i++) { if (read (file, &subspace, sizeof (subspace)) != sizeof (subspace)) { perror ("Can't read subspace record"); exit (1); } /* If subspace has a file location, update it */ if (subspace.initialization_length > 0 && subspace.file_loc_init_value > location) { subspace.file_loc_init_value += offset; lseek (file, -sizeof (subspace), 1); if (write (file, &subspace, sizeof (subspace)) != sizeof (subspace)) { perror ("Can't update subspace record"); exit (1); } } } /* Do for each initialization pointer record */ /* (I don't think it applies to executable files, only relocatables) */ #undef update } /* Read in the header records from an a.out file. */ read_header (file, hdr, auxhdr) int file; struct header *hdr; struct som_exec_auxhdr *auxhdr; { /* Read the header in */ lseek (file, 0, 0); if (read (file, hdr, sizeof (*hdr)) != sizeof (*hdr)) { perror ("Couldn't read header from a.out file"); exit (1); } if (hdr->a_magic != EXEC_MAGIC && hdr->a_magic != SHARE_MAGIC && hdr->a_magic != DEMAND_MAGIC) { fprintf (stderr, "a.out file doesn't have legal magic number\n"); exit (1); } lseek (file, hdr->aux_header_location, 0); if (read (file, auxhdr, sizeof (*auxhdr)) != sizeof (*auxhdr)) { perror ("Couldn't read auxiliary header from a.out file"); exit (1); } } /* Write out the header records into an a.out file. */ write_header (file, hdr, auxhdr) int file; struct header *hdr; struct som_exec_auxhdr *auxhdr; { /* Update the checksum */ hdr->checksum = calculate_checksum (hdr); /* Write the header back into the a.out file */ lseek (file, 0, 0); if (write (file, hdr, sizeof (*hdr)) != sizeof (*hdr)) { perror ("Couldn't write header to a.out file"); exit (1); } lseek (file, hdr->aux_header_location, 0); if (write (file, auxhdr, sizeof (*auxhdr)) != sizeof (*auxhdr)) { perror ("Couldn't write auxiliary header to a.out file"); exit (1); } } /* Calculate the checksum of a SOM header record. */ calculate_checksum (hdr) struct header *hdr; { int checksum, i, *ptr; checksum = 0; ptr = (int *) hdr; for (i = 0; i < sizeof (*hdr) / sizeof (int) - 1; i++) checksum ^= ptr[i]; return (checksum); } /* Copy size bytes from the old file to the new one. */ copy_file (old, new, size) int new, old; int size; { int len; int buffer[8192]; /* word aligned will be faster */ for (; size > 0; size -= len) { len = min (size, sizeof (buffer)); if (read (old, buffer, len) != len) { perror ("Read failure on a.out file"); exit (1); } if (write (new, buffer, len) != len) { perror ("Write failure in a.out file"); exit (1); } } } /* Copy the rest of the file, up to EOF. */ copy_rest (old, new) int new, old; { int buffer[4096]; int len; /* Copy bytes until end of file or error */ while ((len = read (old, buffer, sizeof (buffer))) > 0) if (write (new, buffer, len) != len) break; if (len != 0) { perror ("Unable to copy the rest of the file"); exit (1); } } #ifdef DEBUG display_header (hdr, auxhdr) struct header *hdr; struct som_exec_auxhdr *auxhdr; { /* Display the header information (debug) */ printf ("\n\nFILE HEADER\n"); printf ("magic number %d \n", hdr->a_magic); printf ("text loc %.8x size %d \n", auxhdr->exec_tmem, auxhdr->exec_tsize); printf ("data loc %.8x size %d \n", auxhdr->exec_dmem, auxhdr->exec_dsize); printf ("entry %x \n", auxhdr->exec_entry); printf ("Bss segment size %u\n", auxhdr->exec_bsize); printf ("\n"); printf ("data file loc %d size %d\n", auxhdr->exec_dfile, auxhdr->exec_dsize); printf ("som_length %d\n", hdr->som_length); printf ("unloadable sploc %d size %d\n", hdr->unloadable_sp_location, hdr->unloadable_sp_size); } #endif /* DEBUG */ emacs-19.30/src/unexmips.c100444 12120 1 24121 5773747503 13744 0ustar rmsdaemon/* Unexec for MIPS (including IRIS4D). Note that the GNU project considers support for MIPS operation a peripheral activity which should not be allowed to divert effort from development of the GNU system. Changes in this code will be installed when users send them in, but aside from that we don't plan to think about it, or about whether other Emacs maintenance might break it. Copyright (C) 1988, 1994 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. */ #include #include #include #include #include #include #ifdef MACH #include /* I don't know why this isn't defined. */ #ifndef STYP_INIT #define STYP_INIT 0x80000000 #endif /* I don't know why this isn't defined. */ #ifndef _RDATA #define _RDATA ".rdata" #define STYP_RDATA 0x00000100 #endif /* Small ("near") data section. */ #ifndef _SDATA #define _SDATA ".sdata" #define STYP_SDATA 0x00000200 #endif /* Small ("near") bss section. */ #ifndef _SBSS #define _SBSS ".sbss" #define STYP_SBSS 0x00000400 #endif /* We don't seem to have a sym.h or syms.h anywhere, so we'll do it the hard way. This stinks. */ typedef struct { short magic; short vstamp; long ilineMax; struct { long foo, offset; } offsets[11]; } HDRR, *pHDRR; #else /* not MACH */ #include #include #include #include #endif /* not MACH */ #if defined (IRIS_4D) || defined (sony) #include "getpagesize.h" #include #endif static void fatal_unexec (); static void mark_x (); #define READ(_fd, _buffer, _size, _error_message, _error_arg) \ errno = EEOF; \ if (read (_fd, _buffer, _size) != _size) \ fatal_unexec (_error_message, _error_arg); #define WRITE(_fd, _buffer, _size, _error_message, _error_arg) \ if (write (_fd, _buffer, _size) != _size) \ fatal_unexec (_error_message, _error_arg); #define SEEK(_fd, _position, _error_message, _error_arg) \ errno = EEOF; \ if (lseek (_fd, _position, L_SET) != _position) \ fatal_unexec (_error_message, _error_arg); extern int errno; extern char *strerror (); #define EEOF -1 static struct scnhdr *text_section; static struct scnhdr *init_section; static struct scnhdr *finit_section; static struct scnhdr *rdata_section; static struct scnhdr *data_section; static struct scnhdr *lit8_section; static struct scnhdr *lit4_section; static struct scnhdr *sdata_section; static struct scnhdr *sbss_section; static struct scnhdr *bss_section; struct headers { struct filehdr fhdr; struct aouthdr aout; struct scnhdr section[10]; }; /* Define name of label for entry point for the dumped executable. */ #ifndef DEFAULT_ENTRY_ADDRESS #define DEFAULT_ENTRY_ADDRESS __start #endif unexec (new_name, a_name, data_start, bss_start, entry_address) char *new_name, *a_name; unsigned data_start, bss_start, entry_address; { int new, old; int pagesize, brk; int newsyms, symrel; int nread; struct headers hdr; int i; int vaddr, scnptr; #define BUFSIZE 8192 char buffer[BUFSIZE]; old = open (a_name, O_RDONLY, 0); if (old < 0) fatal_unexec ("opening %s", a_name); new = creat (new_name, 0666); if (new < 0) fatal_unexec ("creating %s", new_name); hdr = *((struct headers *)TEXT_START); #ifdef MIPS2 if (hdr.fhdr.f_magic != MIPSELMAGIC && hdr.fhdr.f_magic != MIPSEBMAGIC && hdr.fhdr.f_magic != (MIPSELMAGIC | 1) && hdr.fhdr.f_magic != (MIPSEBMAGIC | 1)) { fprintf (stderr, "unexec: input file magic number is %x, not %x, %x, %x or %x.\n", hdr.fhdr.f_magic, MIPSELMAGIC, MIPSEBMAGIC, MIPSELMAGIC | 1, MIPSEBMAGIC | 1); exit(1); } #else /* not MIPS2 */ if (hdr.fhdr.f_magic != MIPSELMAGIC && hdr.fhdr.f_magic != MIPSEBMAGIC) { fprintf (stderr, "unexec: input file magic number is %x, not %x or %x.\n", hdr.fhdr.f_magic, MIPSELMAGIC, MIPSEBMAGIC); exit (1); } #endif /* not MIPS2 */ if (hdr.fhdr.f_opthdr != sizeof (hdr.aout)) { fprintf (stderr, "unexec: input a.out header is %d bytes, not %d.\n", hdr.fhdr.f_opthdr, sizeof (hdr.aout)); exit (1); } if (hdr.aout.magic != ZMAGIC) { fprintf (stderr, "unexec: input file a.out magic number is %o, not %o.\n", hdr.aout.magic, ZMAGIC); exit (1); } #define CHECK_SCNHDR(ptr, name, flags) \ ptr = NULL; \ for (i = 0; i < hdr.fhdr.f_nscns && !ptr; i++) \ if (strcmp (hdr.section[i].s_name, name) == 0) \ { \ if (hdr.section[i].s_flags != flags) \ fprintf (stderr, "unexec: %x flags (%x expected) in %s section.\n", \ hdr.section[i].s_flags, flags, name); \ ptr = hdr.section + i; \ } \ CHECK_SCNHDR (text_section, _TEXT, STYP_TEXT); CHECK_SCNHDR (init_section, _INIT, STYP_INIT); CHECK_SCNHDR (rdata_section, _RDATA, STYP_RDATA); CHECK_SCNHDR (data_section, _DATA, STYP_DATA); #ifdef _LIT8 CHECK_SCNHDR (lit8_section, _LIT8, STYP_LIT8); CHECK_SCNHDR (lit4_section, _LIT4, STYP_LIT4); #endif /* _LIT8 */ CHECK_SCNHDR (sdata_section, _SDATA, STYP_SDATA); CHECK_SCNHDR (sbss_section, _SBSS, STYP_SBSS); CHECK_SCNHDR (bss_section, _BSS, STYP_BSS); #if 0 /* Apparently this error check goes off on irix 3.3, but it doesn't indicate a real problem. */ if (i != hdr.fhdr.f_nscns) fprintf (stderr, "unexec: %d sections found instead of %d.\n", i, hdr.fhdr.f_nscns); #endif text_section->s_scnptr = 0; pagesize = getpagesize (); /* Casting to int avoids compiler error on NEWS-OS 5.0.2. */ brk = (((int) (sbrk (0))) + pagesize - 1) & (-pagesize); hdr.aout.dsize = brk - DATA_START; hdr.aout.bsize = 0; if (entry_address == 0) { extern DEFAULT_ENTRY_ADDRESS (); hdr.aout.entry = (unsigned)DEFAULT_ENTRY_ADDRESS; } else hdr.aout.entry = entry_address; hdr.aout.bss_start = hdr.aout.data_start + hdr.aout.dsize; rdata_section->s_size = data_start - DATA_START; /* Adjust start and virtual addresses of rdata_section, too. */ rdata_section->s_vaddr = DATA_START; rdata_section->s_paddr = DATA_START; rdata_section->s_scnptr = text_section->s_scnptr + hdr.aout.tsize; data_section->s_vaddr = data_start; data_section->s_paddr = data_start; data_section->s_size = brk - data_start; data_section->s_scnptr = rdata_section->s_scnptr + rdata_section->s_size; vaddr = data_section->s_vaddr + data_section->s_size; scnptr = data_section->s_scnptr + data_section->s_size; if (lit8_section != NULL) { lit8_section->s_vaddr = vaddr; lit8_section->s_paddr = vaddr; lit8_section->s_size = 0; lit8_section->s_scnptr = scnptr; } if (lit4_section != NULL) { lit4_section->s_vaddr = vaddr; lit4_section->s_paddr = vaddr; lit4_section->s_size = 0; lit4_section->s_scnptr = scnptr; } if (sdata_section != NULL) { sdata_section->s_vaddr = vaddr; sdata_section->s_paddr = vaddr; sdata_section->s_size = 0; sdata_section->s_scnptr = scnptr; } if (sbss_section != NULL) { sbss_section->s_vaddr = vaddr; sbss_section->s_paddr = vaddr; sbss_section->s_size = 0; sbss_section->s_scnptr = scnptr; } if (bss_section != NULL) { bss_section->s_vaddr = vaddr; bss_section->s_paddr = vaddr; bss_section->s_size = 0; bss_section->s_scnptr = scnptr; } WRITE (new, (char *)TEXT_START, hdr.aout.tsize, "writing text section to %s", new_name); WRITE (new, (char *)DATA_START, hdr.aout.dsize, "writing data section to %s", new_name); SEEK (old, hdr.fhdr.f_symptr, "seeking to start of symbols in %s", a_name); errno = EEOF; nread = read (old, buffer, BUFSIZE); if (nread < sizeof (HDRR)) fatal_unexec ("reading symbols from %s", a_name); newsyms = hdr.aout.tsize + hdr.aout.dsize; symrel = newsyms - hdr.fhdr.f_symptr; hdr.fhdr.f_symptr = newsyms; #define symhdr ((pHDRR)buffer) #ifdef MACH for (i = 0; i < 11; i++) symhdr->offsets[i].offset += symrel; #else symhdr->cbLineOffset += symrel; symhdr->cbDnOffset += symrel; symhdr->cbPdOffset += symrel; symhdr->cbSymOffset += symrel; symhdr->cbOptOffset += symrel; symhdr->cbAuxOffset += symrel; symhdr->cbSsOffset += symrel; symhdr->cbSsExtOffset += symrel; symhdr->cbFdOffset += symrel; symhdr->cbRfdOffset += symrel; symhdr->cbExtOffset += symrel; #endif #undef symhdr do { if (write (new, buffer, nread) != nread) fatal_unexec ("writing symbols to %s", new_name); nread = read (old, buffer, BUFSIZE); if (nread < 0) fatal_unexec ("reading symbols from %s", a_name); #undef BUFSIZE } while (nread != 0); SEEK (new, 0, "seeking to start of header in %s", new_name); WRITE (new, &hdr, sizeof (hdr), "writing header of %s", new_name); close (old); close (new); mark_x (new_name); } /* * mark_x * * After successfully building the new a.out, mark it executable */ static void mark_x (name) char *name; { struct stat sbuf; int um = umask (777); umask (um); if (stat (name, &sbuf) < 0) fatal_unexec ("getting protection on %s", name); sbuf.st_mode |= 0111 & ~um; if (chmod (name, sbuf.st_mode) < 0) fatal_unexec ("setting protection on %s", name); } static void fatal_unexec (s, va_alist) va_dcl { va_list ap; if (errno == EEOF) fputs ("unexec: unexpected end of file, ", stderr); else fprintf (stderr, "unexec: %s, ", strerror (errno)); va_start (ap); _doprnt (s, ap, stderr); fputs (".\n", stderr); exit (1); } emacs-19.30/src/unexnext.c100444 12241 12 21663 5444474636 14325 0ustar rolandstaff/* Dump Emacs in macho format. Copyright (C) 1990, 1993 Free Software Foundation, Inc. Written by Bradley Taylor (btaylor@next.com). 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. */ #undef __STRICT_BSD__ #include #include #include #include #include #include #include #include int malloc_cookie; /* * Kludge: we don't expect any program data beyond VM_HIGHDATA * What is really needed is a way to find out from malloc() which * pages it vm_allocated and write only those out into the data segment. * * This kludge may break when we stop using fixed virtual address * shared libraries. Actually, emacs will probably continue working, but be * much larger on disk than it needs to be (because non-malloced data will * be in the file). */ static const unsigned VM_HIGHDATA = 0x2000000; typedef struct region_t { vm_address_t address; vm_size_t size; vm_prot_t protection; vm_prot_t max_protection; vm_inherit_t inheritance; boolean_t shared; port_t object_name; vm_offset_t offset; } region_t; static void grow( struct load_command ***the_commands, unsigned *the_commands_len ) { if (*the_commands == NULL) { *the_commands_len = 1; *the_commands = malloc(sizeof(*the_commands)); } else { (*the_commands_len)++; *the_commands = realloc(*the_commands, (*the_commands_len * sizeof(**the_commands))); } } static void save_command( struct load_command *command, struct load_command ***the_commands, unsigned *the_commands_len ) { struct load_command **tmp; grow(the_commands, the_commands_len); tmp = &(*the_commands)[*the_commands_len - 1]; *tmp = malloc(command->cmdsize); bcopy(command, *tmp, command->cmdsize); } static void fatal_unexec(char *format, ...) { va_list ap; va_start(ap, format); fprintf(stderr, "unexec: "); vfprintf(stderr, format, ap); fprintf(stderr, "\n"); va_end(ap); } static int read_macho( int fd, struct mach_header *the_header, struct load_command ***the_commands, unsigned *the_commands_len ) { struct load_command command; struct load_command *buf; int i; int size; if (read(fd, the_header, sizeof(*the_header)) != sizeof(*the_header)) { fatal_unexec("cannot read macho header"); return (0); } for (i = 0; i < the_header->ncmds; i++) { if (read(fd, &command, sizeof(struct load_command)) != sizeof(struct load_command)) { fatal_unexec("cannot read macho load command header"); return (0); } size = command.cmdsize - sizeof(struct load_command); if (size < 0) { fatal_unexec("bogus load command size"); return (0); } buf = malloc(command.cmdsize); buf->cmd = command.cmd; buf->cmdsize = command.cmdsize; if (read(fd, ((char *)buf + sizeof(struct load_command)), size) != size) { fatal_unexec("cannot read load command data"); return (0); } save_command(buf, the_commands, the_commands_len); } return (1); } static int filldatagap( vm_address_t start_address, vm_size_t *size, vm_address_t end_address ) { vm_address_t address; vm_size_t gapsize; address = (start_address + *size); gapsize = end_address - address; *size += gapsize; if (vm_allocate(task_self(), &address, gapsize, FALSE) != KERN_SUCCESS) { fatal_unexec("cannot vm_allocate"); return (0); } return (1); } static int get_data_region( vm_address_t *address, vm_size_t *size ) { region_t region; kern_return_t ret; struct section *sect; sect = (struct section *) getsectbyname(SEG_DATA, SECT_DATA); region.address = 0; *address = 0; for (;;) { ret = vm_region(task_self(), ®ion.address, ®ion.size, ®ion.protection, ®ion.max_protection, ®ion.inheritance, ®ion.shared, ®ion.object_name, ®ion.offset); if (ret != KERN_SUCCESS || region.address >= VM_HIGHDATA) { break; } if (*address != 0) { if (region.address > *address + *size) { if (!filldatagap(*address, size, region.address)) { return (0); } } *size += region.size; } else { if (region.address == sect->addr) { *address = region.address; *size = region.size; } } region.address += region.size; } return (1); } static char * my_malloc( vm_size_t size ) { vm_address_t address; if (vm_allocate(task_self(), &address, size, TRUE) != KERN_SUCCESS) { return (NULL); } return ((char *)address); } static void my_free( char *buf, vm_size_t size ) { vm_deallocate(task_self(), (vm_address_t)buf, size); } static int unexec_doit( int infd, int outfd ) { int i; struct load_command **the_commands = NULL; unsigned the_commands_len; struct mach_header the_header; int fgrowth; int fdatastart; int fdatasize; int size; struct stat st; char *buf; vm_address_t data_address; vm_size_t data_size; struct segment_command *segment; if (!read_macho(infd, &the_header, &the_commands, &the_commands_len)) { return (0); } malloc_cookie = malloc_freezedry (); if (!get_data_region(&data_address, &data_size)) { return (0); } /* * DO NOT USE MALLOC IN THIS SECTION */ { /* * Fix offsets */ for (i = 0; i < the_commands_len; i++) { switch (the_commands[i]->cmd) { case LC_SEGMENT: segment = ((struct segment_command *) the_commands[i]); if (strcmp(segment->segname, SEG_DATA) == 0) { fdatastart = segment->fileoff; fdatasize = segment->filesize; fgrowth = (data_size - segment->filesize); segment->vmsize = data_size; segment->filesize = data_size; } break; case LC_SYMTAB: ((struct symtab_command *) the_commands[i])->symoff += fgrowth; ((struct symtab_command *) the_commands[i])->stroff += fgrowth; break; case LC_SYMSEG: ((struct symseg_command *) the_commands[i])->offset += fgrowth; break; default: break; } } /* * Write header */ if (write(outfd, &the_header, sizeof(the_header)) != sizeof(the_header)) { fatal_unexec("cannot write output file"); return (0); } /* * Write commands */ for (i = 0; i < the_commands_len; i++) { if (write(outfd, the_commands[i], the_commands[i]->cmdsize) != the_commands[i]->cmdsize) { fatal_unexec("cannot write output file"); return (0); } } /* * Write original text */ if (lseek(infd, the_header.sizeofcmds + sizeof(the_header), L_SET) < 0) { fatal_unexec("cannot seek input file"); return (0); } size = fdatastart - (sizeof(the_header) + the_header.sizeofcmds); buf = my_malloc(size); if (read(infd, buf, size) != size) { my_free(buf, size); fatal_unexec("cannot read input file"); } if (write(outfd, buf, size) != size) { my_free(buf, size); fatal_unexec("cannot write output file"); return (0); } my_free(buf, size); /* * Write new data */ if (write(outfd, (char *)data_address, data_size) != data_size) { fatal_unexec("cannot write output file"); return (0); } } /* * OKAY TO USE MALLOC NOW */ /* * Write rest of file */ fstat(infd, &st); if (lseek(infd, fdatasize, L_INCR) < 0) { fatal_unexec("cannot seek input file"); return (0); } size = st.st_size - lseek(infd, 0, L_INCR); buf = malloc(size); if (read(infd, buf, size) != size) { free(buf); fatal_unexec("cannot read input file"); return (0); } if (write(outfd, buf, size) != size) { free(buf); fatal_unexec("cannot write output file"); return (0); } free(buf); return (1); } void unexec( char *outfile, char *infile ) { int infd; int outfd; char tmpbuf[L_tmpnam]; char *tmpfile; infd = open(infile, O_RDONLY, 0); if (infd < 0) { fatal_unexec("cannot open input file `%s'", infile); exit(1); } tmpnam(tmpbuf); tmpfile = rindex(tmpbuf, '/'); if (tmpfile == NULL) { tmpfile = tmpbuf; } else { tmpfile++; } outfd = open(tmpfile, O_WRONLY|O_TRUNC|O_CREAT, 0755); if (outfd < 0) { close(infd); fatal_unexec("cannot open tmp file `%s'", tmpfile); exit(1); } if (!unexec_doit(infd, outfd)) { close(infd); close(outfd); unlink(tmpfile); exit(1); } close(infd); close(outfd); if (rename(tmpfile, outfile) < 0) { unlink(tmpfile); fatal_unexec("cannot rename `%s' to `%s'", tmpfile, outfile); exit(1); } } emacs-19.30/src/unexnt.c100444 23073 1 36445 6047603151 14271 0ustar voelkerdaemon/* unexec for GNU Emacs on Windows NT. Copyright (C) 1994 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. Geoff Voelker (voelker@cs.washington.edu) 8-12-94 */ #include /* _fmode */ #include #include #include extern BOOL ctrl_c_handler (unsigned long type); #include "ntheap.h" /* A convenient type for keeping all the info about a mapped file together. */ typedef struct file_data { char *name; unsigned long size; HANDLE file; HANDLE file_mapping; unsigned char *file_base; } file_data; /* Basically, our "initialized" flag. */ BOOL need_to_recreate_heap = FALSE; /* So we can find our heap in the file to recreate it. */ unsigned long heap_index_in_executable = 0; void open_input_file (file_data *p_file, char *name); void open_output_file (file_data *p_file, char *name, unsigned long size); void close_file_data (file_data *p_file); void get_section_info (file_data *p_file); void copy_executable_and_dump_data_section (file_data *, file_data *); void dump_bss_and_heap (file_data *p_infile, file_data *p_outfile); /* Cached info about the .data section in the executable. */ PUCHAR data_start_va = 0; DWORD data_start_file = 0; DWORD data_size = 0; /* Cached info about the .bss section in the executable. */ PUCHAR bss_start = 0; DWORD bss_size = 0; #ifdef HAVE_NTGUI HINSTANCE hinst = NULL; HINSTANCE hprevinst = NULL; LPSTR lpCmdLine = ""; int nCmdShow = 0; int __stdcall WinMain (_hinst, _hPrevInst, _lpCmdLine, _nCmdShow) HINSTANCE _hinst; HINSTANCE _hPrevInst; LPSTR _lpCmdLine; int _nCmdShow; { /* Need to parse command line */ hinst = _hinst; hprevinst = _hPrevInst; lpCmdLine = _lpCmdLine; nCmdShow = _nCmdShow; return (main (__argc,__argv,_environ)); } #endif /* HAVE_NTGUI */ /* Startup code for running on NT. When we are running as the dumped version, we need to bootstrap our heap and .bss section into our address space before we can actually hand off control to the startup code supplied by NT (primarily because that code relies upon malloc ()). */ void _start (void) { #ifdef HAVE_NTGUI extern void WinMainCRTStartup (void); #else extern void mainCRTStartup (void); #endif /* HAVE_NTGUI */ /* Cache system info, e.g., the NT page size. */ cache_system_info (); /* If we're a dumped version of emacs then we need to recreate our heap and play tricks with our .bss section. Do this before start up. (WARNING: Do not put any code before this section that relies upon malloc () and runs in the dumped version. It won't work.) */ if (need_to_recreate_heap) { char executable_path[MAX_PATH]; if (GetModuleFileName (NULL, executable_path, MAX_PATH) == 0) { printf ("Failed to find path for executable.\n"); exit (1); } recreate_heap (executable_path); need_to_recreate_heap = FALSE; } /* The default behavior is to treat files as binary and patch up text files appropriately, in accordance with the MSDOS code. */ _fmode = O_BINARY; /* This prevents ctrl-c's in shells running while we're suspended from having us exit. */ SetConsoleCtrlHandler ((PHANDLER_ROUTINE) ctrl_c_handler, TRUE); /* Invoke the NT CRT startup routine now that our housecleaning is finished. */ #ifdef HAVE_NTGUI WinMainCRTStartup (); #else mainCRTStartup (); #endif /* HAVE_NTGUI */ } /* Dump out .data and .bss sections into a new exectubale. */ void unexec (char *new_name, char *old_name, void *start_data, void *start_bss, void *entry_address) { file_data in_file, out_file; char out_filename[MAX_PATH], in_filename[MAX_PATH]; unsigned long size; char *ptr; /* Make sure that the input and output filenames have the ".exe" extension...patch them up if they don't. */ strcpy (in_filename, old_name); ptr = in_filename + strlen (in_filename) - 4; if (strcmp (ptr, ".exe")) strcat (in_filename, ".exe"); strcpy (out_filename, new_name); ptr = out_filename + strlen (out_filename) - 4; if (strcmp (ptr, ".exe")) strcat (out_filename, ".exe"); printf ("Dumping from %s\n", in_filename); printf (" to %s\n", out_filename); /* We need to round off our heap to NT's allocation unit (64KB). */ round_heap (get_allocation_unit ()); /* Open the undumped executable file. */ open_input_file (&in_file, in_filename); /* Get the interesting section info, like start and size of .bss... */ get_section_info (&in_file); /* The size of the dumped executable is the size of the original executable plus the size of the heap and the size of the .bss section. */ heap_index_in_executable = (unsigned long) round_to_next ((unsigned char *) in_file.size, get_allocation_unit ()); size = heap_index_in_executable + get_committed_heap_size () + bss_size; open_output_file (&out_file, out_filename, size); /* Set the flag (before dumping). */ need_to_recreate_heap = TRUE; copy_executable_and_dump_data_section (&in_file, &out_file); dump_bss_and_heap (&in_file, &out_file); close_file_data (&in_file); close_file_data (&out_file); } /* File handling. */ void open_input_file (file_data *p_file, char *filename) { HANDLE file; HANDLE file_mapping; void *file_base; unsigned long size, upper_size; file = CreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if (file == INVALID_HANDLE_VALUE) { printf ("Failed to open %s (%d)...bailing.\n", filename, GetLastError ()); exit (1); } size = GetFileSize (file, &upper_size); file_mapping = CreateFileMapping (file, NULL, PAGE_READONLY, 0, size, NULL); if (!file_mapping) { printf ("Failed to create file mapping of %s (%d)...bailing.\n", filename, GetLastError ()); exit (1); } file_base = MapViewOfFile (file_mapping, FILE_MAP_READ, 0, 0, size); if (file_base == 0) { printf ("Failed to map view of file of %s (%d)...bailing.\n", filename, GetLastError ()); exit (1); } p_file->name = filename; p_file->size = size; p_file->file = file; p_file->file_mapping = file_mapping; p_file->file_base = file_base; } void open_output_file (file_data *p_file, char *filename, unsigned long size) { HANDLE file; HANDLE file_mapping; void *file_base; int i; file = CreateFile (filename, GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); if (file == INVALID_HANDLE_VALUE) { i = GetLastError (); printf ("open_output_file: Failed to open %s (%d).\n", filename, i); exit (1); } file_mapping = CreateFileMapping (file, NULL, PAGE_READWRITE, 0, size, NULL); if (!file_mapping) { i = GetLastError (); printf ("open_output_file: Failed to create file mapping of %s (%d).\n", filename, i); exit (1); } file_base = MapViewOfFile (file_mapping, FILE_MAP_WRITE, 0, 0, size); if (file_base == 0) { i = GetLastError (); printf ("open_output_file: Failed to map view of file of %s (%d).\n", filename, i); exit (1); } p_file->name = filename; p_file->size = size; p_file->file = file; p_file->file_mapping = file_mapping; p_file->file_base = file_base; } /* Close the system structures associated with the given file. */ static void close_file_data (file_data *p_file) { UnmapViewOfFile (p_file->file_base); CloseHandle (p_file->file_mapping); CloseHandle (p_file->file); } /* Routines to manipulate NT executable file sections. */ static unsigned long get_section_size (PIMAGE_SECTION_HEADER p_section) { /* The section size is in different locations in the different versions. */ switch (get_nt_minor_version ()) { case 10: return p_section->SizeOfRawData; default: return p_section->Misc.VirtualSize; } } /* Flip through the executable and cache the info necessary for dumping. */ static void get_section_info (file_data *p_infile) { PIMAGE_DOS_HEADER dos_header; PIMAGE_NT_HEADERS nt_header; PIMAGE_SECTION_HEADER section; unsigned char *ptr; int i; dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base; if (dos_header->e_magic != IMAGE_DOS_SIGNATURE) { printf ("Unknown EXE header in %s...bailing.\n", p_infile->name); exit (1); } nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) + dos_header->e_lfanew); if (nt_header == NULL) { printf ("Failed to find IMAGE_NT_HEADER in %s...bailing.\n", p_infile->name); exit (1); } /* Check the NT header signature ... */ if (nt_header->Signature != IMAGE_NT_SIGNATURE) { printf ("Invalid IMAGE_NT_SIGNATURE 0x%x in %s...bailing.\n", nt_header->Signature, p_infile->name); } /* Flip through the sections for .data and .bss ... */ section = (PIMAGE_SECTION_HEADER) IMAGE_FIRST_SECTION (nt_header); for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) { if (!strcmp (section->Name, ".bss")) { /* The .bss section. */ ptr = (char *) nt_header->OptionalHeader.ImageBase + section->VirtualAddress; bss_start = ptr; bss_size = get_section_size (section); } if (!strcmp (section->Name, ".data")) { /* From lastfile.c */ extern char my_edata[]; /* The .data section. */ ptr = (char *) nt_header->OptionalHeader.ImageBase + section->VirtualAddress; data_start_va = ptr; data_start_file = section->PointerToRawData; /* We want to only write Emacs data back to the executable, not any of the library data (if library data is included, then a dumped Emacs won't run on system versions other than the one Emacs was dumped on). */ data_size = my_edata - data_start_va; } section++; } } /* The dump routines. */ static void copy_executable_and_dump_data_section (file_data *p_infile, file_data *p_outfile) { unsigned char *data_file, *data_va; unsigned long size, index; /* Get a pointer to where the raw data should go in the executable file. */ data_file = (char *) p_outfile->file_base + data_start_file; /* Get a pointer to the raw data in our address space. */ data_va = data_start_va; size = (DWORD) data_file - (DWORD) p_outfile->file_base; printf ("Copying executable up to data section...\n"); printf ("\t0x%08x Offset in input file.\n", 0); printf ("\t0x%08x Offset in output file.\n", 0); printf ("\t0x%08x Size in bytes.\n", size); memcpy (p_outfile->file_base, p_infile->file_base, size); size = data_size; printf ("Dumping .data section...\n"); printf ("\t0x%08x Address in process.\n", data_va); printf ("\t0x%08x Offset in output file.\n", data_file - p_outfile->file_base); printf ("\t0x%08x Size in bytes.\n", size); memcpy (data_file, data_va, size); index = (DWORD) data_file + size - (DWORD) p_outfile->file_base; size = p_infile->size - index; printf ("Copying rest of executable...\n"); printf ("\t0x%08x Offset in input file.\n", index); printf ("\t0x%08x Offset in output file.\n", index); printf ("\t0x%08x Size in bytes.\n", size); memcpy ((char *) p_outfile->file_base + index, (char *) p_infile->file_base + index, size); } static void dump_bss_and_heap (file_data *p_infile, file_data *p_outfile) { unsigned char *heap_data, *bss_data; unsigned long size, index; printf ("Dumping heap into executable...\n"); index = heap_index_in_executable; size = get_committed_heap_size (); heap_data = get_heap_start (); printf ("\t0x%08x Heap start in process.\n", heap_data); printf ("\t0x%08x Heap offset in executable.\n", index); printf ("\t0x%08x Heap size in bytes.\n", size); memcpy ((PUCHAR) p_outfile->file_base + index, heap_data, size); printf ("Dumping .bss into executable...\n"); index += size; size = bss_size; bss_data = bss_start; printf ("\t0x%08x BSS start in process.\n", bss_data); printf ("\t0x%08x BSS offset in executable.\n", index); printf ("\t0x%08x BSS size in bytes.\n", size); memcpy ((char *) p_outfile->file_base + index, bss_data, size); } /* Reload and remap routines. */ /* Load the dumped .bss section into the .bss area of our address space. */ void read_in_bss (char *filename) { HANDLE file; unsigned long size, index, n_read, total_read; char buffer[512], *bss; int i; file = CreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if (file == INVALID_HANDLE_VALUE) { i = GetLastError (); exit (1); } /* Seek to where the .bss section is tucked away after the heap... */ index = heap_index_in_executable + get_committed_heap_size (); if (SetFilePointer (file, index, NULL, FILE_BEGIN) == 0xFFFFFFFF) { i = GetLastError (); exit (1); } /* Ok, read in the saved .bss section and initialize all uninitialized variables. */ if (!ReadFile (file, bss_start, bss_size, &n_read, NULL)) { i = GetLastError (); exit (1); } CloseHandle (file); } /* Map the heap dumped into the executable file into our address space. */ void map_in_heap (char *filename) { HANDLE file; HANDLE file_mapping; void *file_base; unsigned long size, upper_size, n_read; int i; file = CreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if (file == INVALID_HANDLE_VALUE) { i = GetLastError (); exit (1); } size = GetFileSize (file, &upper_size); file_mapping = CreateFileMapping (file, NULL, PAGE_WRITECOPY, 0, size, NULL); if (!file_mapping) { i = GetLastError (); exit (1); } size = get_committed_heap_size (); file_base = MapViewOfFileEx (file_mapping, FILE_MAP_COPY, 0, heap_index_in_executable, size, get_heap_start ()); if (file_base != 0) { return; } /* If we don't succeed with the mapping, then copy from the data into the heap. */ CloseHandle (file_mapping); if (VirtualAlloc (get_heap_start (), get_committed_heap_size (), MEM_RESERVE | MEM_COMMIT, PAGE_READWRITE) == NULL) { i = GetLastError (); exit (1); } /* Seek to the location of the heap data in the executable. */ i = heap_index_in_executable; if (SetFilePointer (file, i, NULL, FILE_BEGIN) == 0xFFFFFFFF) { i = GetLastError (); exit (1); } /* Read in the data. */ if (!ReadFile (file, get_heap_start (), get_committed_heap_size (), &n_read, NULL)) { i = GetLastError (); exit (1); } CloseHandle (file); } emacs-19.30/src/unexsunos4.c100444 12120 1 25310 6002635053 14206 0ustar rmsdaemon/* Unexec for Sunos 4 using shared libraries. Copyright (C) 1990, 1994 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. */ /* Contributed by Viktor Dukhovni. */ /* * Unexec for Berkeley a.out format + SUNOS shared libraries * The unexeced executable contains the __DYNAMIC area from the * original text file, and then the rest of data + bss + malloced area of * the current process. (The __DYNAMIC area is at the top of the process * data segment, we use "data_start" defined externally to mark the start * of the "real" data segment.) * * For programs that want to remap some of the data segment read only * a run_time_remap is provided. This attempts to remap largest area starting * and ending on page boundaries between "data_start" and "bndry" * For this it to figure out where the text file is located. A path search * is attempted after trying argv[0] and if all fails we simply do not remap * * One feature of run_time_remap () is mandatory: reseting the break. * * Note that we can no longer map data into the text segment, as this causes * the __DYNAMIC struct to become read only, breaking the runtime loader. * Thus we no longer need to mess with a private crt0.c, the standard one * will do just fine, since environ can live in the writable area between * __DYNAMIC and data_start, just make sure that pre-crt0.o (the name * is somewhat abused here) is loaded first! * */ #include #include #include #include #include #include #include /* Do this after the above #include's in case a configuration file wants to define things for this file based on what defines. */ #ifdef emacs #include #endif #if defined (SUNOS4) || defined (__FreeBSD__) || defined (__NetBSD__) #define UNDO_RELOCATION #endif #ifdef UNDO_RELOCATION #include #endif #ifdef HAVE_UNISTD_H #include #endif /* NetBSD needs this bit, but SunOS does not have it. */ #ifndef MAP_FILE #define MAP_FILE 0 #endif /* * for programs other than emacs * define data_start + initialized here, and make sure * this object is loaded first! * emacs will define these elsewhere, and load the object containing * data_start (pre-crt0.o or firstfile.o?) first! * The custom crt0.o *must not* be loaded! */ #ifndef emacs static int data_start = 0; static int initialized = 0; #else extern int initialized; extern unsigned data_start; extern int pureptr; #endif extern char *getenv (); static unsigned brk_value; static struct exec nhdr; static int rd_only_len; static long cookie; unexec (new_name, a_name, bndry, bss_start, entry) char *new_name, *a_name; unsigned bndry, bss_start, entry; { int fd, new; char *old; struct exec ohdr; /* Allocate on the stack, not needed in the next life */ struct stat stat; if ((fd = open (a_name, O_RDONLY)) < 0) { fprintf (stderr, "%s: open: ", a_name); perror (a_name); exit (1); } if ((new = open (new_name, O_WRONLY | O_CREAT, 0666)) == -1) { fprintf (stderr, "%s: open: ", a_name); perror (new_name); exit (1); } if ((fstat (fd, &stat) == -1)) { fprintf (stderr, "%s: ", a_name); perror ("fstat"); exit (1); } old = (char *)mmap (0, stat.st_size, PROT_READ, MAP_FILE|MAP_SHARED, fd, 0); if (old == (char *)-1) { fprintf (stderr, "%s: ", a_name); perror ("mmap"); exit (1); } close (fd); nhdr = ohdr = (*(struct exec *)old); /* * Remember a magic cookie so we know we've got the right binary * when remapping. */ cookie = time (0); /* Save the break, it is reset to &_end (by ld.so?). */ brk_value = (unsigned) sbrk (0); /* * Round up data start to a page boundary (Lose if not a 2 power!) */ data_start = ((((int)&data_start) - 1) & ~(N_PAGSIZ (nhdr) - 1)) + N_PAGSIZ (nhdr); /* * Round down read only pages to a multiple of the page size */ if (bndry) rd_only_len = ((int)bndry & ~(N_PAGSIZ (nhdr) - 1)) - data_start; #ifndef emacs /* Have to do this some time before dumping the data */ initialized = 1; #endif /* Handle new data and bss sizes and optional new entry point. No one actually uses bss_start and entry, but tradition compels one to support them. Could complain if bss_start > brk_value, but the caller is *supposed* to know what she is doing. */ nhdr.a_data = (bss_start ? bss_start : brk_value) - N_DATADDR (nhdr); nhdr.a_bss = bss_start ? brk_value - bss_start : 0; if (entry) nhdr.a_entry = entry; /* * Write out the text segment with new header * Dynamic executables are ZMAGIC with N_TXTOFF==0 and the header * part of the text segment, but no need to rely on this. * So write the TEXT first, then go back replace the header. * Doing it in the other order is less general! */ lseek (new, N_TXTOFF (nhdr), L_SET); write (new, old + N_TXTOFF (ohdr), N_TXTOFF (ohdr) + ohdr.a_text); lseek (new, 0L, L_SET); write (new, &nhdr, sizeof (nhdr)); /* * Write out the head of the old data segment from the file not * from core, this has the unresolved __DYNAMIC relocation data * we need to reload */ lseek (new, N_DATOFF (nhdr), L_SET); write (new, old + N_DATOFF (ohdr), (int)&data_start - N_DATADDR (ohdr)); /* * Copy the rest of the data from core */ write (new, &data_start, N_BSSADDR (nhdr) - (int)&data_start); /* * Copy the symbol table and line numbers */ lseek (new, N_TRELOFF (nhdr), L_SET); write (new, old + N_TRELOFF (ohdr), stat.st_size - N_TRELOFF (ohdr)); /* Some other BSD systems use this file. We don't know whether this change is right for them. */ #ifdef UNDO_RELOCATION /* Undo the relocations done at startup by ld.so. It will do these relocations again when we start the dumped Emacs. Doing them twice gives incorrect results. */ { unsigned long daddr = N_DATADDR (ohdr); unsigned long rel, erel; #ifdef SUNOS4 #ifdef SUNOS4_SHARED_LIBRARIES extern struct link_dynamic _DYNAMIC; /* SunOS4.x's ld_rel is relative to N_TXTADDR. */ if (!ohdr.a_dynamic) /* This was statically linked. */ rel = erel = 0; else if (_DYNAMIC.ld_version < 2) { rel = _DYNAMIC.ld_un.ld_1->ld_rel + N_TXTADDR (ohdr); erel = _DYNAMIC.ld_un.ld_1->ld_hash + N_TXTADDR (ohdr); } else { rel = _DYNAMIC.ld_un.ld_2->ld_rel + N_TXTADDR (ohdr); erel = _DYNAMIC.ld_un.ld_2->ld_hash + N_TXTADDR (ohdr); } #else /* not SUNOS4_SHARED_LIBRARIES */ rel = erel = 0; #endif /* not SUNOS4_SHARED_LIBRARIES */ #ifdef sparc #define REL_INFO_TYPE struct reloc_info_sparc #else #define REL_INFO_TYPE struct relocation_info #endif /* sparc */ #define REL_TARGET_ADDRESS(r) (((REL_INFO_TYPE *)(r))->r_address) #endif /* SUNOS4 */ #if defined (__FreeBSD__) || defined (__NetBSD__) extern struct _dynamic _DYNAMIC; /* FreeBSD's LD_REL is a virtual address itself. */ rel = LD_REL (&_DYNAMIC); erel = rel + LD_RELSZ (&_DYNAMIC); #define REL_INFO_TYPE struct relocation_info #define REL_TARGET_ADDRESS(r) (((REL_INFO_TYPE *)(r))->r_address) #endif for (; rel < erel; rel += sizeof (REL_INFO_TYPE)) { /* This is the virtual address where ld.so will do relocation. */ unsigned long target = REL_TARGET_ADDRESS (rel); /* This is the offset in the data segment. */ unsigned long segoffset = target - daddr; /* If it is located below data_start, we have to do nothing here, because the old data has been already written to the location. */ if (target < (unsigned long)&data_start) continue; lseek (new, N_DATOFF (nhdr) + segoffset, L_SET); write (new, old + N_DATOFF (ohdr) + segoffset, sizeof (unsigned long)); } } #endif /* UNDO_RELOCATION */ fchmod (new, 0755); } void run_time_remap (progname) char *progname; { char aout[MAXPATHLEN]; register char *path, *p; /* Just in case */ if (!initialized) return; /* Restore the break */ brk ((char *) brk_value); /* If nothing to remap: we are done! */ if (rd_only_len == 0) return; /* * Attempt to find the executable * First try argv[0], will almost always succeed as shells tend to give * the full path from the hash list rather than using execvp () */ if (is_it (progname)) return; /* * If argv[0] is a full path and does not exist, not much sense in * searching further */ if (strchr (progname, '/')) return; /* * Try to search for argv[0] on the PATH */ path = getenv ("PATH"); if (path == NULL) return; while (*path) { /* copy through ':' or end */ for (p = aout; *p = *path; ++p, ++path) if (*p == ':') { ++path; /* move past ':' */ break; } *p++ = '/'; strcpy (p, progname); /* * aout is a candidate full path name */ if (is_it (aout)) return; } } is_it (filename) char *filename; { int fd; long filenames_cookie; struct exec hdr; /* * Open an executable and check for a valid header! * Can't bcmp the header with what we had, it may have been stripped! * so we may save looking at non executables with the same name, mostly * directories. */ fd = open (filename, O_RDONLY); if (fd != -1) { if (read (fd, &hdr, sizeof (hdr)) == sizeof (hdr) && !N_BADMAG (hdr) && N_DATOFF (hdr) == N_DATOFF (nhdr) && N_TRELOFF (hdr) == N_TRELOFF (nhdr)) { /* compare cookies */ lseek (fd, N_DATOFF (hdr) + (int)&cookie - N_DATADDR (hdr), L_SET); read (fd, &filenames_cookie, sizeof (filenames_cookie)); if (filenames_cookie == cookie) { /* Eureka */ /* * Do the mapping * The PROT_EXEC may not be needed, but it is safer this way. * should the shared library decide to indirect through * addresses in the data segment not part of __DYNAMIC */ mmap ((char *) data_start, rd_only_len, PROT_READ | PROT_EXEC, MAP_FILE | MAP_SHARED | MAP_FIXED, fd, N_DATOFF (hdr) + data_start - N_DATADDR (hdr)); close (fd); return 1; } } close (fd); } return 0; } emacs-19.30/src/vm-limit.c100444 12241 12 6477 5444474640 14166 0ustar rolandstaff/* Functions for memory limit warnings. Copyright (C) 1990, 1992 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. */ #ifdef emacs #include #include "lisp.h" #endif #ifndef emacs #include typedef size_t SIZE; typedef void *POINTER; #define EXCEEDS_LISP_PTR(x) 0 #endif #include "mem-limits.h" /* Level number of warnings already issued. 0 -- no warnings issued. 1 -- 75% warning already issued. 2 -- 85% warning already issued. 3 -- 95% warning issued; keep warning frequently. */ static int warnlevel; /* Function to call to issue a warning; 0 means don't issue them. */ static void (*warn_function) (); /* Get more memory space, complaining if we're near the end. */ static void check_memory_limits () { extern POINTER (*__morecore) (); register POINTER cp; unsigned long five_percent; unsigned long data_size; if (lim_data == 0) get_lim_data (); five_percent = lim_data / 20; /* Find current end of memory and issue warning if getting near max */ cp = (char *) (*__morecore) (0); data_size = (char *) cp - (char *) data_space_start; if (warn_function) switch (warnlevel) { case 0: if (data_size > five_percent * 15) { warnlevel++; (*warn_function) ("Warning: past 75% of memory limit"); } break; case 1: if (data_size > five_percent * 17) { warnlevel++; (*warn_function) ("Warning: past 85% of memory limit"); } break; case 2: if (data_size > five_percent * 19) { warnlevel++; (*warn_function) ("Warning: past 95% of memory limit"); } break; default: (*warn_function) ("Warning: past acceptable memory limits"); break; } /* If we go down below 70% full, issue another 75% warning when we go up again. */ if (data_size < five_percent * 14) warnlevel = 0; /* If we go down below 80% full, issue another 85% warning when we go up again. */ else if (warnlevel > 1 && data_size < five_percent * 16) warnlevel = 1; /* If we go down below 90% full, issue another 95% warning when we go up again. */ else if (warnlevel > 2 && data_size < five_percent * 18) warnlevel = 2; if (EXCEEDS_LISP_PTR (cp)) (*warn_function) ("Warning: memory in use exceeds lisp pointer size"); } /* Cause reinitialization based on job parameters; also declare where the end of pure storage is. */ void memory_warnings (start, warnfun) POINTER start; void (*warnfun) (); { extern void (* __after_morecore_hook) (); /* From gmalloc.c */ if (start) data_space_start = start; else data_space_start = start_of_data (); warn_function = warnfun; __after_morecore_hook = check_memory_limits; } emacs-19.30/src/vms-pp.c100444 75424 1 15711 5770115142 13506 0ustar kwzhdaemon/* vms_pp - preprocess emacs files in such a way that they can be * compiled on VMS without warnings. * Copyright (C) 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 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. * * Usage: * vms_pp infile outfile * implicit inputs: * The file "vms_pp.trans" has the names and their translations. * description: * Vms_pp takes the input file and scans it, replacing the long * names with shorter names according to the table read in from * vms_pp.trans. The line is then written to the output file. * * Additionally, the "#undef foo" construct is replaced with: * #ifdef foo * #undef foo * #endif * * The construct #if defined(foo) is replaced with * #ifdef foo * #define foo_VAL 1 * #else * #define foo_VAL 0 * #endif * #define defined(XX) XX_val * #if defined(foo) * * This last contruction only works on single line #if's and takes * advantage of a questionable C pre-processor trick. If there are * comments within the #if, that contain "defined", then this will * bomb. */ #include #define Max_table 100 #define Table_name "vms_pp.trans" #define Word_member \ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$" static FILE *in,*out; /* read from, write to */ struct item { /* symbol table entries */ char *name; char *value; }; static struct item name_table[Max_table]; /* symbol table */ static int defined_defined = 0; /* small optimization */ main(argc,argv) int argc; char **argv; { char buffer[1024]; if(argc != 3) { /* check argument count */ fprintf(stderr,"usage: vms_pp infile outfile"); exit(); } init_table(); /* read in translation table */ /* open input and output files */ if((in = fopen(argv[1],"r")) == NULL) { fprintf(stderr,"vms_pp: unable to open file '%s'",argv[1]); exit(); } if((out = fopen(argv[2],"w")) == NULL) { fprintf(stderr,"vms_pp: unable to create file '%s'",argv[2]); exit(); } while(fgets(buffer,1023,in) != NULL) { /* loop through buffer until end */ process_line(buffer); /* process the line */ fputs(buffer,out); /* write out the line */ } } /* buy - allocate and copy a string */ static char *buy(str) char *str; { char *temp; if(!(temp = malloc(strlen(str)+1))) { fprintf(stderr,"vms_pp: can't allocate memory"); exit(); } strcpy(temp,str); return temp; } /* gather_word - return a buffer full of the next word */ static char *gather_word(ptr,word) char *ptr, *word;{ for(; strchr(Word_member,*ptr); ptr++,word++) *word = *ptr; *word = 0; return ptr; } /* skip_white - skip white space */ static char *skip_white(ptr) char *ptr; { while(*ptr == ' ' || *ptr == '\t') ptr++; return ptr; } /* init_table - initialize translation table. */ init_table() { char buf[256],*ptr,word[128]; FILE *in; int i; if((in = fopen(Table_name,"r")) == NULL) { /* open file */ fprintf(stderr,"vms_pp: can't open '%s'",Table_name); exit(); } for(i = 0; fgets(buf,255,in) != NULL;) { /* loop through lines */ ptr = skip_white(buf); if(*ptr == '!') /* skip comments */ continue; ptr = gather_word(ptr,word); /* get long word */ if(*word == 0) { /* bad entry */ fprintf(stderr,"vms_pp: bad input line '%s'\n",buf); continue; } name_table[i].name = buy(word); /* set up the name */ ptr = skip_white(ptr); /* skip white space */ ptr = gather_word(ptr,word); /* get equivalent name */ if(*word == 0) { /* bad entry */ fprintf(stderr,"vms_pp: bad input line '%s'\n",buf); continue; } name_table[i].value = buy(word); /* and the equivalent name */ i++; /* increment to next position */ } for(; i < Max_table; i++) /* mark rest as unused */ name_table[i].name = 0; } /* process_line - do actual line processing */ process_line(buf) char *buf; { char *in_ptr,*out_ptr; char word[128],*ptr; int len; check_pp(buf); /* check for preprocessor lines */ for(in_ptr = out_ptr = buf; *in_ptr;) { if(!strchr(Word_member,*in_ptr)) /* non alpha-numeric? just copy */ *out_ptr++ = *in_ptr++; else { in_ptr = gather_word(in_ptr,word); /* get the 'word' */ if(strlen(word) > 31) /* length is too long */ replace_word(word); /* replace the word */ for(ptr = word; *ptr; ptr++,out_ptr++) /* copy out the word */ *out_ptr = *ptr; } } *out_ptr = 0; } /* check_pp - check for preprocessor lines */ check_pp(buf) char *buf; { char *ptr,*p; char word[128]; ptr = skip_white(buf); /* skip white space */ if(*ptr != '#') /* is this a preprocessor line? */ return; /* no, just return */ ptr = skip_white(++ptr); /* skip white */ ptr = gather_word(ptr,word); /* get command word */ if(!strcmp("undef",word)) { /* undef? */ ptr = skip_white(ptr); ptr = gather_word(ptr,word); /* get the symbol to undef */ fprintf(out,"#ifdef %s\n",word); fputs(buf,out); strcpy(buf,"#endif"); return; } if(!strcmp("if",word)) { /* check for if */ for(;;) { ptr = strchr(ptr,'d'); /* look for d in defined */ if(!ptr) /* are we done? */ return; if(strchr(Word_member,*(ptr-1))){ /* at beginning of word? */ ptr++; continue; /* no, continue looking */ } ptr = gather_word(ptr,word); /* get the word */ if(strcmp(word,"defined")) /* skip if not defined */ continue; ptr = skip_white(ptr); /* skip white */ if(*ptr != '(') /* look for open paren */ continue; /* error, continue */ ptr++; /* skip paren */ ptr = skip_white(ptr); /* more white skipping */ ptr = gather_word(ptr,word); /* get the thing to test */ if(!*word) /* null word is bad */ continue; fprintf(out,"#ifdef %s\n",word); /* generate the code */ fprintf(out,"#define %s_VAL 1\n",word); fprintf(out,"#else\n"); fprintf(out,"#define %s_VAL 0\n",word); fprintf(out,"#endif\n"); if(!defined_defined) { fprintf(out,"#define defined(XXX) XXX/**/_VAL\n"); defined_defined = 1; } } } } /* replace_word - look the word up in the table, and replace it * if a match is found. */ replace_word(word) char *word; { int i; for(i = 0; i < Max_table && name_table[i].name; i++) if(!strcmp(word,name_table[i].name)) { strcpy(word,name_table[i].value); return; } fprintf(stderr,"couldn't find '%s'\n",word); } emacs-19.30/src/vmsfns.c100444 75424 1 63624 5770115142 13606 0ustar kwzhdaemon/* VMS subprocess and command interface. Copyright (C) 1987, 1988 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. */ /* Written by Mukesh Prasad. */ /* * INTERFACE PROVIDED BY EMACS FOR VMS SUBPROCESSES: * * Emacs provides the following functions: * * "spawn-subprocess", which takes as arguments: * * (i) an integer to identify the spawned subprocess in future * operations, * (ii) A function to process input from the subprocess, and * (iii) A function to be called upon subprocess termination. * * First argument is required. If second argument is missing or nil, * the default action is to insert all received messages at the current * location in the current buffer. If third argument is missing or nil, * no action is taken upon subprocess termination. * The input-handler is called as * (input-handler num string) * where num is the identifying integer for the subprocess and string * is a string received from the subprocess. exit-handler is called * with the identifying integer as the argument. * * "send-command-to-subprocess" takes two arguments: * * (i) Subprocess identifying integer. * (ii) String to send as a message to the subprocess. * * "stop-subprocess" takes the subprocess identifying integer as * argument. * * Implementation is done by spawning an asynchronous subprocess, and * communicating to it via mailboxes. */ #ifdef VMS #include #include #undef NULL #include #include "lisp.h" #include #include #include /* #include */ #include #include #include #ifdef VMS4_4 /* I am being cautious; perhaps this exists in older versions */ #include #endif /* #include */ #define CLI$M_NOWAIT 1 /* clidef.h is missing from C library */ #define SYI$_VERSION 4096 /* syidef.h is missing from C library */ #define JPI$_CLINAME 522 /* JPI$_CLINAME is missing from jpidef.h */ #define JPI$_MASTER_PID 805 /* JPI$_MASTER_PID missing from jpidef.h */ #define LIB$_NOSUCHSYM 1409892 /* libclidef.h missing */ #define MSGSIZE 160 /* Maximum size for mailbox operations */ #ifndef PRV$V_ACNT /* these defines added as hack for VMS 5.1-1. SJones, 8-17-89 */ /* this is _really_ nasty and needs to be changed ASAP - should see about using the union defined in SYS$LIBRARY:PRVDEF.H under v5 */ #define PRV$V_ACNT 0x09 #define PRV$V_ALLSPOOL 0x04 #define PRV$V_ALTPRI 0x0D #define PRV$V_BUGCHK 0x17 #define PRV$V_BYPASS 0x1D #define PRV$V_CMEXEC 0x01 #define PRV$V_CMKRNL 0x00 #define PRV$V_DETACH 0x05 #define PRV$V_DIAGNOSE 0x06 #define PRV$V_DOWNGRADE 0x21 #define PRV$V_EXQUOTA 0x13 #define PRV$V_GROUP 0x08 #define PRV$V_GRPNAM 0x03 #define PRV$V_GRPPRV 0x22 #define PRV$V_LOG_IO 0x07 #define PRV$V_MOUNT 0x11 #define PRV$V_NETMBX 0x14 #define PRV$V_NOACNT 0x09 #define PRV$V_OPER 0x12 #define PRV$V_PFNMAP 0x1A #define PRV$V_PHY_IO 0x16 #define PRV$V_PRMCEB 0x0A #define PRV$V_PRMGBL 0x18 #define PRV$V_PRMJNL 0x25 #define PRV$V_PRMMBX 0x0B #define PRV$V_PSWAPM 0x0C #define PRV$V_READALL 0x23 #define PRV$V_SECURITY 0x26 #define PRV$V_SETPRI 0x0D #define PRV$V_SETPRV 0x0E #define PRV$V_SHARE 0x1F #define PRV$V_SHMEM 0x1B #define PRV$V_SYSGBL 0x19 #define PRV$V_SYSLCK 0x1E #define PRV$V_SYSNAM 0x02 #define PRV$V_SYSPRV 0x1C #define PRV$V_TMPJNL 0x24 #define PRV$V_TMPMBX 0x0F #define PRV$V_UPGRADE 0x20 #define PRV$V_VOLPRO 0x15 #define PRV$V_WORLD 0x10 #endif /* IO status block for mailbox operations. */ struct mbx_iosb { short status; short size; int pid; }; /* Structure for maintaining linked list of subprocesses. */ struct process_list { int name; /* Numeric identifier for subprocess */ int process_id; /* VMS process address */ int process_active; /* 1 iff process has not exited yet */ int mbx_chan; /* Mailbox channel to write to process */ struct mbx_iosb iosb; /* IO status block for write operations */ Lisp_Object input_handler; /* Input handler for subprocess */ Lisp_Object exit_handler; /* Exit handler for subprocess */ struct process_list * next; /* Linked list chain */ }; /* Structure for privilege list. */ struct privilege_list { char * name; int mask; }; /* Structure for finding VMS related information. */ struct vms_objlist { char * name; /* Name of object */ Lisp_Object (* objfn)(); /* Function to retrieve VMS object */ }; static int exit_ast (); /* Called upon subprocess exit */ static int create_mbx (); /* Creates mailbox */ static void mbx_msg (); /* Writes null terminated string to mbx */ static void write_to_mbx (); /* Writes message to string */ static void start_mbx_input (); /* Queues I/O request to mailbox */ static int input_mbx_chan = 0; /* Channel to read subprocess input on */ static char input_mbx_name[20]; /* Storage for mailbox device name */ static struct dsc$descriptor_s input_mbx_dsc; /* Descriptor for mailbox device name */ static struct process_list * process_list = 0; /* Linked list of subprocesses */ static char mbx_buffer[MSGSIZE]; /* Buffer to read from subprocesses */ static struct mbx_iosb input_iosb; /* IO status block for mailbox reads */ int have_process_input, /* Non-zero iff subprocess input pending */ process_exited; /* Non-zero iff suprocess exit pending */ /* List of privilege names and mask offsets */ static struct privilege_list priv_list[] = { { "ACNT", PRV$V_ACNT }, { "ALLSPOOL", PRV$V_ALLSPOOL }, { "ALTPRI", PRV$V_ALTPRI }, { "BUGCHK", PRV$V_BUGCHK }, { "BYPASS", PRV$V_BYPASS }, { "CMEXEC", PRV$V_CMEXEC }, { "CMKRNL", PRV$V_CMKRNL }, { "DETACH", PRV$V_DETACH }, { "DIAGNOSE", PRV$V_DIAGNOSE }, { "DOWNGRADE", PRV$V_DOWNGRADE }, /* Isn't VMS as low as you can go? */ { "EXQUOTA", PRV$V_EXQUOTA }, { "GRPPRV", PRV$V_GRPPRV }, { "GROUP", PRV$V_GROUP }, { "GRPNAM", PRV$V_GRPNAM }, { "LOG_IO", PRV$V_LOG_IO }, { "MOUNT", PRV$V_MOUNT }, { "NETMBX", PRV$V_NETMBX }, { "NOACNT", PRV$V_NOACNT }, { "OPER", PRV$V_OPER }, { "PFNMAP", PRV$V_PFNMAP }, { "PHY_IO", PRV$V_PHY_IO }, { "PRMCEB", PRV$V_PRMCEB }, { "PRMGBL", PRV$V_PRMGBL }, { "PRMJNL", PRV$V_PRMJNL }, { "PRMMBX", PRV$V_PRMMBX }, { "PSWAPM", PRV$V_PSWAPM }, { "READALL", PRV$V_READALL }, { "SECURITY", PRV$V_SECURITY }, { "SETPRI", PRV$V_SETPRI }, { "SETPRV", PRV$V_SETPRV }, { "SHARE", PRV$V_SHARE }, { "SHMEM", PRV$V_SHMEM }, { "SYSGBL", PRV$V_SYSGBL }, { "SYSLCK", PRV$V_SYSLCK }, { "SYSNAM", PRV$V_SYSNAM }, { "SYSPRV", PRV$V_SYSPRV }, { "TMPJNL", PRV$V_TMPJNL }, { "TMPMBX", PRV$V_TMPMBX }, { "UPGRADE", PRV$V_UPGRADE }, { "VOLPRO", PRV$V_VOLPRO }, { "WORLD", PRV$V_WORLD }, }; static Lisp_Object vms_account(), vms_cliname(), vms_owner(), vms_grp(), vms_image(), vms_parent(), vms_pid(), vms_prcnam(), vms_terminal(), vms_uic_int(), vms_uic_str(), vms_username(), vms_version_fn(), vms_trnlog(), vms_symbol(), vms_proclist(); /* Table of arguments to Fvms_object, and the handlers that get the data. */ static struct vms_objlist vms_object [] = { { "ACCOUNT", vms_account }, /* Returns account name as a string */ { "CLINAME", vms_cliname }, /* Returns CLI name (string) */ { "OWNER", vms_owner }, /* Returns owner process's PID (int) */ { "GRP", vms_grp }, /* Returns group number of UIC (int) */ { "IMAGE", vms_image }, /* Returns executing image (string) */ { "PARENT", vms_parent }, /* Returns parent proc's PID (int) */ { "PID", vms_pid }, /* Returns process's PID (int) */ { "PRCNAM", vms_prcnam }, /* Returns process's name (string) */ { "TERMINAL", vms_terminal }, /* Returns terminal name (string) */ { "UIC", vms_uic_int }, /* Returns UIC as integer */ { "UICGRP", vms_uic_str }, /* Returns UIC as string */ { "USERNAME", vms_username }, /* Returns username (string) */ { "VERSION", vms_version_fn },/* Returns VMS version (string) */ { "LOGICAL", vms_trnlog }, /* Translates VMS logical name */ { "DCL-SYMBOL", vms_symbol }, /* Translates DCL symbol */ { "PROCLIST", vms_proclist }, /* Returns list of all PIDs on system */ }; Lisp_Object Qdefault_subproc_input_handler; extern int process_ef; /* Event flag for subprocess operations */ DEFUN ("default-subprocess-input-handler", Fdefault_subproc_input_handler, Sdefault_subproc_input_handler, 2, 2, 0, "Default input handler for input from spawned subprocesses.") (name, input) Lisp_Object name, input; { /* Just insert in current buffer */ insert1 (input); insert ("\n", 1); } DEFUN ("spawn-subprocess", Fspawn_subprocess, Sspawn_subprocess, 1, 3, 0, "Spawn an asynchronous VMS suprocess for command processing.") (name, input_handler, exit_handler) Lisp_Object name, input_handler, exit_handler; { int status; char output_mbx_name[20]; struct dsc$descriptor_s output_mbx_dsc; struct process_list *ptr, *p, *prev; CHECK_NUMBER (name, 0); if (! input_mbx_chan) { if (! create_mbx (&input_mbx_dsc, input_mbx_name, &input_mbx_chan, 1)) return Qnil; start_mbx_input (); } ptr = 0; prev = 0; while (ptr) { struct process_list *next = ptr->next; if (ptr->name == XFASTINT (name)) { if (ptr->process_active) return Qt; /* Delete this process and run its exit handler. */ if (prev) prev->next = next; else process_list = next; if (! NILP (ptr->exit_handler)) Feval (Fcons (ptr->exit_handler, Fcons (make_number (ptr->name), Qnil))); sys$dassgn (ptr->mbx_chan); break; } else prev = ptr; ptr = next; } if (! ptr) ptr = xmalloc (sizeof (struct process_list)); if (! create_mbx (&output_mbx_dsc, output_mbx_name, &ptr->mbx_chan, 2)) { free (ptr); return Qnil; } if (NILP (input_handler)) input_handler = Qdefault_subproc_input_handler; ptr->input_handler = input_handler; ptr->exit_handler = exit_handler; message ("Creating subprocess..."); status = lib$spawn (0, &output_mbx_dsc, &input_mbx_dsc, &CLI$M_NOWAIT, 0, &ptr->process_id, 0, 0, exit_ast, &ptr->process_active); if (! (status & 1)) { sys$dassgn (ptr->mbx_chan); free (ptr); error ("Unable to spawn subprocess"); return Qnil; } ptr->name = XFASTINT (name); ptr->next = process_list; ptr->process_active = 1; process_list = ptr; message ("Creating subprocess...done"); return Qt; } static void mbx_msg (ptr, msg) struct process_list *ptr; char *msg; { write_to_mbx (ptr, msg, strlen (msg)); } DEFUN ("send-command-to-subprocess", Fsend_command_to_subprocess, Ssend_command_to_subprocess, 2, 2, "sSend command to subprocess: \nsSend subprocess %s command: ", "Send to VMS subprocess named NAME the string COMMAND.") (name, command) Lisp_Object name, command; { struct process_list * ptr; CHECK_NUMBER (name, 0); CHECK_STRING (command, 1); for (ptr = process_list; ptr; ptr = ptr->next) if (XFASTINT (name) == ptr->name) { write_to_mbx (ptr, XSTRING (command)->data, XSTRING (command)->size); return Qt; } return Qnil; } DEFUN ("stop-subprocess", Fstop_subprocess, Sstop_subprocess, 1, 1, "sStop subprocess: ", "Stop VMS subprocess named NAME.") (name) Lisp_Object name; { struct process_list * ptr; CHECK_NUMBER (name, 0); for (ptr = process_list; ptr; ptr = ptr->next) if (XFASTINT (name) == ptr->name) { ptr->exit_handler = Qnil; if (sys$delprc (&ptr->process_id, 0) & 1) ptr->process_active = 0; return Qt; } return Qnil; } static int exit_ast (active) int * active; { process_exited = 1; *active = 0; sys$setef (process_ef); } /* Process to handle input on the input mailbox. * Searches through the list of processes until the matching PID is found, * then calls its input handler. */ process_command_input () { struct process_list * ptr; char * msg; int msglen; Lisp_Object expr; msg = mbx_buffer; msglen = input_iosb.size; /* Hack around VMS oddity of sending extraneous CR/LF characters for * some of the commands (but not most). */ if (msglen > 0 && *msg == '\r') { msg++; msglen--; } if (msglen > 0 && msg[msglen - 1] == '\n') msglen--; if (msglen > 0 && msg[msglen - 1] == '\r') msglen--; /* Search for the subprocess in the linked list. */ expr = Qnil; for (ptr = process_list; ptr; ptr = ptr->next) if (ptr->process_id == input_iosb.pid) { expr = Fcons (ptr->input_handler, Fcons (make_number (ptr->name), Fcons (make_string (msg, msglen), Qnil))); break; } have_process_input = 0; start_mbx_input (); clear_waiting_for_input (); /* Otherwise Ctl-g will cause crash. JCB */ if (! NILP (expr)) Feval (expr); } /* Searches process list for any processes which have exited. Calls their * exit handlers and removes them from the process list. */ process_exit () { struct process_list * ptr, * prev, * next; process_exited = 0; prev = 0; ptr = process_list; while (ptr) { next = ptr->next; if (! ptr->process_active) { if (prev) prev->next = next; else process_list = next; if (! NILP (ptr->exit_handler)) Feval (Fcons (ptr->exit_handler, Fcons (make_number (ptr->name), Qnil))); sys$dassgn (ptr->mbx_chan); free (ptr); } else prev = ptr; ptr = next; } } /* Called at emacs exit. */ kill_vms_processes () { struct process_list * ptr; for (ptr = process_list; ptr; ptr = ptr->next) if (ptr->process_active) { sys$dassgn (ptr->mbx_chan); sys$delprc (&ptr->process_id, 0); } sys$dassgn (input_mbx_chan); process_list = 0; input_mbx_chan = 0; } /* Creates a temporary mailbox and retrieves its device name in 'buf'. * Makes the descriptor pointed to by 'dsc' refer to this device. * 'buffer_factor' is used to allow sending messages asynchronously * till some point. */ static int create_mbx (dsc, buf, chan, buffer_factor) struct dsc$descriptor_s *dsc; char *buf; int *chan; int buffer_factor; { int strval[2]; int status; status = sys$crembx (0, chan, MSGSIZE, MSGSIZE * buffer_factor, 0, 0, 0); if (! (status & 1)) { message ("Unable to create mailbox. Need TMPMBX privilege."); return 0; } strval[0] = 16; strval[1] = buf; status = lib$getdvi (&DVI$_DEVNAM, chan, 0, 0, strval, &dsc->dsc$w_length); if (! (status & 1)) return 0; dsc->dsc$b_dtype = DSC$K_DTYPE_T; dsc->dsc$b_class = DSC$K_CLASS_S; dsc->dsc$a_pointer = buf; return 1; } /* create_mbx */ /* AST routine to be called upon receiving mailbox input. * Sets flag telling keyboard routines that input is available. */ static int mbx_input_ast () { have_process_input = 1; } /* Issue a QIO request on the input mailbox. */ static void start_mbx_input () { sys$qio (process_ef, input_mbx_chan, IO$_READVBLK, &input_iosb, mbx_input_ast, 0, mbx_buffer, sizeof (mbx_buffer), 0, 0, 0, 0); } /* Send a message to the subprocess input mailbox, without blocking if * possible. */ static void write_to_mbx (ptr, buf, len) struct process_list *ptr; char *buf; int len; { sys$qiow (0, ptr->mbx_chan, IO$_WRITEVBLK | IO$M_NOW, &ptr->iosb, 0, 0, buf, len, 0, 0, 0, 0); } DEFUN ("setprv", Fsetprv, Ssetprv, 1, 3, 0, "Set or reset a VMS privilege. First arg is privilege name.\n\ Second arg is t or nil, indicating whether the privilege is to be\n\ set or reset. Default is nil. Returns t if success, nil if not.\n\ If third arg is non-nil, does not change privilege, but returns t\n\ or nil depending upon whether the privilege is already enabled.") (priv, value, getprv) Lisp_Object priv, value, getprv; { int prvmask[2], prvlen, newmask[2]; char * prvname; int found, i; struct privilege_list * ptr; CHECK_STRING (priv, 0); priv = Fupcase (priv); prvname = XSTRING (priv)->data; prvlen = XSTRING (priv)->size; found = 0; prvmask[0] = 0; prvmask[1] = 0; for (i = 0; i < sizeof (priv_list) / sizeof (priv_list[0]); i++) { ptr = &priv_list[i]; if (prvlen == strlen (ptr->name) && bcmp (prvname, ptr->name, prvlen) == 0) { if (ptr->mask >= 32) prvmask[1] = 1 << (ptr->mask % 32); else prvmask[0] = 1 << ptr->mask; found = 1; break; } } if (! found) error ("Unknown privilege name %s", XSTRING (priv)->data); if (NILP (getprv)) { if (sys$setprv (NILP (value) ? 0 : 1, prvmask, 0, 0) == SS$_NORMAL) return Qt; return Qnil; } /* Get old priv value */ if (sys$setprv (0, 0, 0, newmask) != SS$_NORMAL) return Qnil; if ((newmask[0] & prvmask[0]) || (newmask[1] & prvmask[1])) return Qt; return Qnil; } /* Retrieves VMS system information. */ #ifdef VMS4_4 /* I don't know whether these functions work in old versions */ DEFUN ("vms-system-info", Fvms_system_info, Svms_system_info, 1, 3, 0, "Retrieve VMS process and system information.\n\ The first argument (a string) specifies the type of information desired.\n\ The other arguments depend on the type you select.\n\ For information about a process, the second argument is a process ID\n\ or a process name, with the current process as a default.\n\ These are the possibilities for the first arg (upper or lower case ok):\n\ account Returns account name\n\ cliname Returns CLI name\n\ owner Returns owner process's PID\n\ grp Returns group number\n\ parent Returns parent process's PID\n\ pid Returns process's PID\n\ prcnam Returns process's name\n\ terminal Returns terminal name\n\ uic Returns UIC number\n\ uicgrp Returns formatted [UIC,GRP]\n\ username Returns username\n\ version Returns VMS version\n\ logical Translates VMS logical name (second argument)\n\ dcl-symbol Translates DCL symbol (second argument)\n\ proclist Returns list of all PIDs on system (needs WORLD privilege)." ) (type, arg1, arg2) Lisp_Object type, arg1, arg2; { int i, typelen; char * typename; struct vms_objlist * ptr; CHECK_STRING (type, 0); type = Fupcase (type); typename = XSTRING (type)->data; typelen = XSTRING (type)->size; for (i = 0; i < sizeof (vms_object) / sizeof (vms_object[0]); i++) { ptr = &vms_object[i]; if (typelen == strlen (ptr->name) && bcmp (typename, ptr->name, typelen) == 0) return (* ptr->objfn)(arg1, arg2); } error ("Unknown object type %s", typename); } /* Given a reference to a VMS process, returns its process id. */ static int translate_id (pid, owner) Lisp_Object pid; int owner; /* if pid is null/0, return owner. If this * flag is 0, return self. */ { int status, code, id, i, numeric, size; char * p; int prcnam[2]; if (NILP (pid) || STRINGP (pid) && XSTRING (pid)->size == 0 || INTEGERP (pid) && XFASTINT (pid) == 0) { code = owner ? JPI$_OWNER : JPI$_PID; status = lib$getjpi (&code, 0, 0, &id); if (! (status & 1)) error ("Cannot find %s: %s", owner ? "owner process" : "process id", vmserrstr (status)); return (id); } if (INTEGERP (pid)) return (XFASTINT (pid)); CHECK_STRING (pid, 0); pid = Fupcase (pid); size = XSTRING (pid)->size; p = XSTRING (pid)->data; numeric = 1; id = 0; for (i = 0; i < size; i++, p++) if (isxdigit (*p)) { id *= 16; if (*p >= '0' && *p <= '9') id += *p - '0'; else id += *p - 'A' + 10; } else { numeric = 0; break; } if (numeric) return (id); prcnam[0] = XSTRING (pid)->size; prcnam[1] = XSTRING (pid)->data; status = lib$getjpi (&JPI$_PID, 0, prcnam, &id); if (! (status & 1)) error ("Cannot find process id: %s", vmserrstr (status)); return (id); } /* translate_id */ /* VMS object retrieval functions. */ static Lisp_Object getjpi (jpicode, arg, numeric) int jpicode; /* Type of GETJPI information */ Lisp_Object arg; int numeric; /* 1 if numeric value expected */ { int id, status, numval; char str[128]; int strdsc[2] = { sizeof (str), str }; short strlen; id = translate_id (arg, 0); status = lib$getjpi (&jpicode, &id, 0, &numval, strdsc, &strlen); if (! (status & 1)) error ("Unable to retrieve information: %s", vmserrstr (status)); if (numeric) return (make_number (numval)); return (make_string (str, strlen)); } static Lisp_Object vms_account (arg1, arg2) Lisp_Object arg1, arg2; { return getjpi (JPI$_ACCOUNT, arg1, 0); } static Lisp_Object vms_cliname (arg1, arg2) Lisp_Object arg1, arg2; { return getjpi (JPI$_CLINAME, arg1, 0); } static Lisp_Object vms_grp (arg1, arg2) Lisp_Object arg1, arg2; { return getjpi (JPI$_GRP, arg1, 1); } static Lisp_Object vms_image (arg1, arg2) Lisp_Object arg1, arg2; { return getjpi (JPI$_IMAGNAME, arg1, 0); } static Lisp_Object vms_owner (arg1, arg2) Lisp_Object arg1, arg2; { return getjpi (JPI$_OWNER, arg1, 1); } static Lisp_Object vms_parent (arg1, arg2) Lisp_Object arg1, arg2; { return getjpi (JPI$_MASTER_PID, arg1, 1); } static Lisp_Object vms_pid (arg1, arg2) Lisp_Object arg1, arg2; { return getjpi (JPI$_PID, arg1, 1); } static Lisp_Object vms_prcnam (arg1, arg2) Lisp_Object arg1, arg2; { return getjpi (JPI$_PRCNAM, arg1, 0); } static Lisp_Object vms_terminal (arg1, arg2) Lisp_Object arg1, arg2; { return getjpi (JPI$_TERMINAL, arg1, 0); } static Lisp_Object vms_uic_int (arg1, arg2) Lisp_Object arg1, arg2; { return getjpi (JPI$_UIC, arg1, 1); } static Lisp_Object vms_uic_str (arg1, arg2) Lisp_Object arg1, arg2; { return getjpi (JPI$_UIC, arg1, 0); } static Lisp_Object vms_username (arg1, arg2) Lisp_Object arg1, arg2; { return getjpi (JPI$_USERNAME, arg1, 0); } static Lisp_Object vms_version_fn (arg1, arg2) Lisp_Object arg1, arg2; { char str[40]; int status; int strdsc[2] = { sizeof (str), str }; short strlen; status = lib$getsyi (&SYI$_VERSION, 0, strdsc, &strlen, 0, 0); if (! (status & 1)) error ("Unable to obtain version: %s", vmserrstr (status)); return (make_string (str, strlen)); } static Lisp_Object vms_trnlog (arg1, arg2) Lisp_Object arg1, arg2; { char str[256]; /* Max logical translation is 255 bytes. */ int status, symdsc[2]; int strdsc[2] = { sizeof (str), str }; short length, level; CHECK_STRING (arg1, 0); symdsc[0] = XSTRING (arg1)->size; symdsc[1] = XSTRING (arg1)->data; status = lib$sys_trnlog (symdsc, &length, strdsc); if (! (status & 1)) error ("Unable to translate logical name: %s", vmserrstr (status)); if (status == SS$_NOTRAN) return (Qnil); return (make_string (str, length)); } static Lisp_Object vms_symbol (arg1, arg2) Lisp_Object arg1, arg2; { char str[1025]; /* Max symbol translation is 1024 bytes. */ int status, symdsc[2]; int strdsc[2] = { sizeof (str), str }; short length, level; CHECK_STRING (arg1, 0); symdsc[0] = XSTRING (arg1)->size; symdsc[1] = XSTRING (arg1)->data; status = lib$get_symbol (symdsc, strdsc, &length, &level); if (! (status & 1)) { if (status == LIB$_NOSUCHSYM) return (Qnil); else error ("Unable to translate symbol: %s", vmserrstr (status)); } return (make_string (str, length)); } static Lisp_Object vms_proclist (arg1, arg2) Lisp_Object arg1, arg2; { Lisp_Object retval; int id, status, pid; retval = Qnil; pid = -1; for (;;) { status = lib$getjpi (&JPI$_PID, &pid, 0, &id); if (status == SS$_NOMOREPROC) break; if (! (status & 1)) error ("Unable to get process ID: %s", vmserrstr (status)); retval = Fcons (make_number (id), retval); } return (Fsort (retval, intern ("<"))); } DEFUN ("shrink-to-icon", Fshrink_to_icon, Sshrink_to_icon, 0, 0, 0, "If emacs is running in a workstation window, shrink to an icon.") () { static char result[128]; static $DESCRIPTOR (result_descriptor, result); static $DESCRIPTOR (tt_name, "TT:"); static int chan = 0; static int buf = 0x9d + ('2'<<8) + ('2'<<16) + (0x9c<<24); int status; static int temp = JPI$_TERMINAL; status = lib$getjpi (&temp, 0, 0, 0, &result_descriptor, 0); if (status != SS$_NORMAL) error ("Unable to determine terminal type."); if (result[0] != 'W' || result[1] != 'T') /* see if workstation */ error ("Can't shrink-to-icon on a non workstation terminal"); if (!chan) /* assign channel if not assigned */ if ((status = sys$assign (&tt_name, &chan, 0, 0)) != SS$_NORMAL) error ("Can't assign terminal, %d", status); status = sys$qiow (0, chan, IO$_WRITEVBLK+IO$M_BREAKTHRU, 0, 0, 0, &buf, 4, 0, 0, 0, 0); if (status != SS$_NORMAL) error ("Can't shrink-to-icon, %d", status); } #endif /* VMS4_4 */ init_vmsfns () { process_list = 0; input_mbx_chan = 0; } syms_of_vmsfns () { defsubr (&Sdefault_subproc_input_handler); defsubr (&Sspawn_subprocess); defsubr (&Ssend_command_to_subprocess); defsubr (&Sstop_subprocess); defsubr (&Ssetprv); #ifdef VMS4_4 defsubr (&Svms_system_info); defsubr (&Sshrink_to_icon); #endif /* VMS4_4 */ Qdefault_subproc_input_handler = intern ("default-subprocess-input-handler"); staticpro (&Qdefault_subproc_input_handler); } #endif /* VMS */ emacs-19.30/src/vmsgmalloc.c100444 12241 12 161020 5444474642 14620 0ustar rolandstaff/* DO NOT EDIT THIS FILE -- it is automagically generated. -*- C -*- */ #define _MALLOC_INTERNAL /* The malloc headers and source files from the C library follow here. */ /* Declarations for `malloc' and friends. Copyright 1990, 1991, 1992, 1993 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_H #define _MALLOC_H 1 #ifdef __cplusplus extern "C" { #endif #if defined (__cplusplus) || (defined (__STDC__) && __STDC__) #undef __P #define __P(args) args #undef __const #define __const const #undef __ptr_t #define __ptr_t void * #else /* Not C++ or ANSI C. */ #undef __P #define __P(args) () #undef __const #define __const #undef __ptr_t #define __ptr_t char * #endif /* C++ or ANSI C. */ #ifndef NULL #define NULL 0 #endif #ifdef __STDC__ #include #else #ifdef VMS /* The following are defined in stdio.h, but we need it NOW! But do NOT do it with defines here, for then, VAX C is going to barf when it gets to stdio.h and the typedefs in there! */ typedef unsigned int size_t; typedef int ptrdiff_t; #else /* not VMS */ #undef size_t #define size_t unsigned int #undef ptrdiff_t #define ptrdiff_t int #endif /* VMS */ #endif /* Allocate SIZE bytes of memory. */ extern __ptr_t malloc __P ((size_t __size)); /* Re-allocate the previously allocated block in __ptr_t, making the new block SIZE bytes long. */ extern __ptr_t realloc __P ((__ptr_t __ptr, size_t __size)); /* Allocate NMEMB elements of SIZE bytes each, all initialized to 0. */ extern __ptr_t calloc __P ((size_t __nmemb, size_t __size)); /* Free a block allocated by `malloc', `realloc' or `calloc'. */ extern void free __P ((__ptr_t __ptr)); /* Allocate SIZE bytes allocated to ALIGNMENT bytes. */ extern __ptr_t memalign __P ((size_t __alignment, size_t __size)); /* Allocate SIZE bytes on a page boundary. */ extern __ptr_t valloc __P ((size_t __size)); #ifdef VMS /* VMS hooks to deal with two heaps */ /* Allocate SIZE bytes of memory. */ extern __ptr_t __vms_malloc __P ((size_t __size)); /* Re-allocate the previously allocated block in __ptr_t, making the new block SIZE bytes long. */ extern __ptr_t __vms_realloc __P ((__ptr_t __ptr, size_t __size)); /* Free a block allocated by `malloc', `realloc' or `calloc'. */ extern void __vms_free __P ((__ptr_t __ptr)); #endif #ifdef _MALLOC_INTERNAL #include /* Harmless, gets __GNU_LIBRARY__ defined. */ #if defined(HAVE_CONFIG_H) || defined(emacs) #include #endif #if defined(__GNU_LIBRARY__) || defined(STDC_HEADERS) || defined(USG) #include #else #ifndef memset #define memset(s, zero, n) bzero ((s), (n)) #endif #ifndef memcpy #define memcpy(d, s, n) bcopy ((s), (d), (n)) #endif #ifndef memmove #define memmove(d, s, n) bcopy ((s), (d), (n)) #endif #endif #if defined(__GNU_LIBRARY__) || defined(__STDC__) #include #else #define CHAR_BIT 8 #endif /* The allocator divides the heap into blocks of fixed size; large requests receive one or more whole blocks, and small requests receive a fragment of a block. Fragment sizes are powers of two, and all fragments of a block are the same size. When all the fragments in a block have been freed, the block itself is freed. */ #define INT_BIT (CHAR_BIT * sizeof(int)) #ifdef VMS #define BLOCKLOG 9 #else #define BLOCKLOG (INT_BIT > 16 ? 12 : 9) #endif #define BLOCKSIZE (1 << BLOCKLOG) #define BLOCKIFY(SIZE) (((SIZE) + BLOCKSIZE - 1) / BLOCKSIZE) /* Determine the amount of memory spanned by the initial heap table (not an absolute limit). */ #define HEAP (INT_BIT > 16 ? 4194304 : 65536) /* Number of contiguous free blocks allowed to build up at the end of memory before they will be returned to the system. */ #define FINAL_FREE_BLOCKS 8 /* Data structure giving per-block information. */ typedef union { /* Heap information for a busy block. */ struct { /* Zero for a large block, or positive giving the logarithm to the base two of the fragment size. */ int type; union { struct { size_t nfree; /* Free fragments in a fragmented block. */ size_t first; /* First free fragment of the block. */ } frag; /* Size (in blocks) of a large cluster. */ size_t size; } info; } busy; /* Heap information for a free block (that may be the first of a free cluster). */ struct { size_t size; /* Size (in blocks) of a free cluster. */ size_t next; /* Index of next free cluster. */ size_t prev; /* Index of previous free cluster. */ } free; } malloc_info; /* Pointer to first block of the heap. */ extern char *_heapbase; /* Table indexed by block number giving per-block information. */ extern malloc_info *_heapinfo; /* Address to block number and vice versa. */ #define BLOCK(A) (((char *) (A) - _heapbase) / BLOCKSIZE + 1) #define ADDRESS(B) ((__ptr_t) (((B) - 1) * BLOCKSIZE + _heapbase)) /* Current search index for the heap table. */ extern size_t _heapindex; /* Limit of valid info table indices. */ extern size_t _heaplimit; /* Doubly linked lists of free fragments. */ struct list { struct list *next; struct list *prev; }; /* Free list headers for each fragment size. */ extern struct list _fraghead[]; /* List of blocks allocated with `memalign' (or `valloc'). */ struct alignlist { struct alignlist *next; __ptr_t aligned; /* The address that memaligned returned. */ __ptr_t exact; /* The address that malloc returned. */ }; extern struct alignlist *_aligned_blocks; /* Instrumentation. */ extern size_t _chunks_used; extern size_t _bytes_used; extern size_t _chunks_free; extern size_t _bytes_free; /* Internal version of `free' used in `morecore' (malloc.c). */ extern void _free_internal __P ((__ptr_t __ptr)); #endif /* _MALLOC_INTERNAL. */ /* Underlying allocation function; successive calls should return contiguous pieces of memory. */ /* It does NOT always return contiguous pieces of memory on VMS. */ extern __ptr_t (*__morecore) __P ((ptrdiff_t __size)); /* Underlying deallocation function. It accepts both a pointer and a size to back up. It is implementation dependent what is really used. */ extern __ptr_t (*__lesscore) __P ((__ptr_t __ptr, ptrdiff_t __size)); /* Default value of `__morecore'. */ extern __ptr_t __default_morecore __P ((ptrdiff_t __size)); /* Default value of `__lesscore'. */ extern __ptr_t __default_lesscore __P ((__ptr_t __ptr, ptrdiff_t __size)); #ifdef VMS /* Default value of `__morecore'. */ extern __ptr_t __vms_morecore __P ((ptrdiff_t __size)); /* Default value of `__lesscore'. */ extern __ptr_t __vms_lesscore __P ((__ptr_t __ptr, ptrdiff_t __size)); #endif /* If not NULL, this function is called after each time `__morecore' is called to increase the data size. */ extern void (*__after_morecore_hook) __P ((void)); /* If not NULL, this function is called after each time `__lesscore' is called to increase the data size. */ extern void (*__after_lesscore_hook) __P ((void)); /* Nonzero if `malloc' has been called and done its initialization. */ extern int __malloc_initialized; /* Hooks for debugging versions. */ extern void (*__free_hook) __P ((__ptr_t __ptr)); extern __ptr_t (*__malloc_hook) __P ((size_t __size)); extern __ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, size_t __size)); /* Activate a standard collection of debugging hooks. */ extern int mcheck __P ((void (*__func) __P ((void)))); /* Activate a standard collection of tracing hooks. */ extern void mtrace __P ((void)); /* Statistics available to the user. */ struct mstats { size_t bytes_total; /* Total size of the heap. */ size_t chunks_used; /* Chunks allocated by the user. */ size_t bytes_used; /* Byte total of user-allocated chunks. */ size_t chunks_free; /* Chunks in the free list. */ size_t bytes_free; /* Byte total of chunks in the free list. */ }; /* Pick up the current statistics. */ extern struct mstats mstats __P ((void)); /* Call WARNFUN with a warning message when memory usage is high. */ extern void memory_warnings __P ((__ptr_t __start, void (*__warnfun) __P ((__const char *)))); /* Relocating allocator. */ /* Allocate SIZE bytes, and store the address in *HANDLEPTR. */ extern __ptr_t r_alloc __P ((__ptr_t *__handleptr, size_t __size)); /* Free the storage allocated in HANDLEPTR. */ extern void r_alloc_free __P ((__ptr_t *__handleptr)); /* Adjust the block at HANDLEPTR to be SIZE bytes long. */ extern __ptr_t r_re_alloc __P ((__ptr_t *__handleptr, size_t __size)); #ifdef __cplusplus } #endif #endif /* malloc.h */ /* Memory allocator `malloc'. Copyright 1990, 1991, 1992, 1993 Free Software Foundation Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif #ifdef VMS /* How to really get more memory. */ __ptr_t (*__morecore) __P ((ptrdiff_t __size)) = __vms_morecore; #else /* How to really get more memory. */ __ptr_t (*__morecore) __P ((ptrdiff_t __size)) = __default_morecore; #endif /* Debugging hook for `malloc'. */ #ifdef VMS __ptr_t (*__malloc_hook) __P ((size_t __size)) = __vms_malloc; #else __ptr_t (*__malloc_hook) __P ((size_t __size)); #endif /* Pointer to the base of the first block. */ char *_heapbase; /* Block information table. Allocated with align/__free (not malloc/free). */ malloc_info *_heapinfo; /* Number of info entries. */ static size_t heapsize; /* Search index in the info table. */ size_t _heapindex; /* Limit of valid info table indices. */ size_t _heaplimit; /* Free lists for each fragment size. */ struct list _fraghead[BLOCKLOG]; /* Instrumentation. */ size_t _chunks_used; size_t _bytes_used; size_t _chunks_free; size_t _bytes_free; /* Are you experienced? */ int __malloc_initialized; void (*__after_morecore_hook) __P ((void)); /* Aligned allocation. */ static __ptr_t align __P ((size_t)); static __ptr_t align (size) size_t size; { __ptr_t result; unsigned long int adj; result = (*__morecore) (size); adj = (unsigned long int) ((unsigned long int) ((char *) result - (char *) NULL)) % BLOCKSIZE; if (adj != 0) { adj = BLOCKSIZE - adj; (void) (*__morecore) (adj); result = (char *) result + adj; } if (__after_morecore_hook) (*__after_morecore_hook) (); return result; } /* Set everything up and remember that we have. */ static int initialize __P ((void)); static int initialize () { #ifdef RL_DEBUG extern VMS_present_buffer(); printf("__malloc_initialized = %d\n", __malloc_initialized); VMS_present_buffer(); #endif heapsize = HEAP / BLOCKSIZE; _heapinfo = (malloc_info *) align (heapsize * sizeof (malloc_info)); if (_heapinfo == NULL) return 0; memset (_heapinfo, 0, heapsize * sizeof (malloc_info)); _heapinfo[0].free.size = 0; _heapinfo[0].free.next = _heapinfo[0].free.prev = 0; _heapindex = 0; _heapbase = (char *) _heapinfo; #ifdef RL_DEBUG /* debug */ printf("_heapbase = 0%o/0x%x/%d\n", _heapbase, _heapbase, _heapbase); /* end debug */ #endif __malloc_initialized = 1; return 1; } /* Get neatly aligned memory, initializing or growing the heap info table as necessary. */ static __ptr_t morecore __P ((size_t)); static __ptr_t morecore (size) size_t size; { __ptr_t result; malloc_info *newinfo, *oldinfo; size_t newsize; result = align (size); if (result == NULL) return NULL; /* Check if we need to grow the info table. */ if ((size_t) BLOCK ((char *) result + size) > heapsize) { newsize = heapsize; while ((size_t) BLOCK ((char *) result + size) > newsize) newsize *= 2; newinfo = (malloc_info *) align (newsize * sizeof (malloc_info)); if (newinfo == NULL) { (*__lesscore) (result, size); return NULL; } memset (newinfo, 0, newsize * sizeof (malloc_info)); memcpy (newinfo, _heapinfo, heapsize * sizeof (malloc_info)); oldinfo = _heapinfo; newinfo[BLOCK (oldinfo)].busy.type = 0; newinfo[BLOCK (oldinfo)].busy.info.size = BLOCKIFY (heapsize * sizeof (malloc_info)); _heapinfo = newinfo; _free_internal (oldinfo); heapsize = newsize; } _heaplimit = BLOCK ((char *) result + size); return result; } /* Allocate memory from the heap. */ __ptr_t malloc (size) size_t size; { __ptr_t result; size_t block, blocks, lastblocks, start; register size_t i; struct list *next; if (size == 0) return NULL; if (__malloc_hook != NULL) return (*__malloc_hook) (size); if (!__malloc_initialized) if (!initialize ()) return NULL; if (size < sizeof (struct list)) size = sizeof (struct list); /* Determine the allocation policy based on the request size. */ if (size <= BLOCKSIZE / 2) { /* Small allocation to receive a fragment of a block. Determine the logarithm to base two of the fragment size. */ register size_t log = 1; --size; while ((size /= 2) != 0) ++log; /* Look in the fragment lists for a free fragment of the desired size. */ next = _fraghead[log].next; if (next != NULL) { /* There are free fragments of this size. Pop a fragment out of the fragment list and return it. Update the block's nfree and first counters. */ result = (__ptr_t) next; next->prev->next = next->next; if (next->next != NULL) next->next->prev = next->prev; block = BLOCK (result); if (--_heapinfo[block].busy.info.frag.nfree != 0) _heapinfo[block].busy.info.frag.first = (unsigned long int) ((unsigned long int) ((char *) next->next - (char *) NULL) % BLOCKSIZE) >> log; /* Update the statistics. */ ++_chunks_used; _bytes_used += 1 << log; --_chunks_free; _bytes_free -= 1 << log; } else { /* No free fragments of the desired size, so get a new block and break it into fragments, returning the first. */ result = malloc (BLOCKSIZE); if (result == NULL) return NULL; /* Link all fragments but the first into the free list. */ for (i = 1; i < (size_t) (BLOCKSIZE >> log); ++i) { next = (struct list *) ((char *) result + (i << log)); #ifdef RL_DEBUG printf("DEBUG: malloc (%d): next = %p\n", size, next); #endif next->next = _fraghead[log].next; next->prev = &_fraghead[log]; next->prev->next = next; if (next->next != NULL) next->next->prev = next; } /* Initialize the nfree and first counters for this block. */ block = BLOCK (result); _heapinfo[block].busy.type = log; _heapinfo[block].busy.info.frag.nfree = i - 1; _heapinfo[block].busy.info.frag.first = i - 1; _chunks_free += (BLOCKSIZE >> log) - 1; _bytes_free += BLOCKSIZE - (1 << log); _bytes_used -= BLOCKSIZE - (1 << log); } } else { /* Large allocation to receive one or more blocks. Search the free list in a circle starting at the last place visited. If we loop completely around without finding a large enough space we will have to get more memory from the system. */ blocks = BLOCKIFY (size); start = block = _heapindex; while (_heapinfo[block].free.size < blocks) { block = _heapinfo[block].free.next; if (block == start) { /* Need to get more from the system. Check to see if the new core will be contiguous with the final free block; if so we don't need to get as much. */ block = _heapinfo[0].free.prev; lastblocks = _heapinfo[block].free.size; if (_heaplimit != 0 && block + lastblocks == _heaplimit && (*__morecore) (0) == ADDRESS (block + lastblocks) && (morecore ((blocks - lastblocks) * BLOCKSIZE)) != NULL) { _heapinfo[block].free.size = blocks; _bytes_free += (blocks - lastblocks) * BLOCKSIZE; continue; } result = morecore (blocks * BLOCKSIZE); if (result == NULL) return NULL; block = BLOCK (result); _heapinfo[block].busy.type = 0; _heapinfo[block].busy.info.size = blocks; ++_chunks_used; _bytes_used += blocks * BLOCKSIZE; return result; } } /* At this point we have found a suitable free list entry. Figure out how to remove what we need from the list. */ result = ADDRESS (block); if (_heapinfo[block].free.size > blocks) { /* The block we found has a bit left over, so relink the tail end back into the free list. */ _heapinfo[block + blocks].free.size = _heapinfo[block].free.size - blocks; _heapinfo[block + blocks].free.next = _heapinfo[block].free.next; _heapinfo[block + blocks].free.prev = _heapinfo[block].free.prev; _heapinfo[_heapinfo[block].free.prev].free.next = _heapinfo[_heapinfo[block].free.next].free.prev = _heapindex = block + blocks; } else { /* The block exactly matches our requirements, so just remove it from the list. */ _heapinfo[_heapinfo[block].free.next].free.prev = _heapinfo[block].free.prev; _heapinfo[_heapinfo[block].free.prev].free.next = _heapindex = _heapinfo[block].free.next; --_chunks_free; } _heapinfo[block].busy.type = 0; _heapinfo[block].busy.info.size = blocks; ++_chunks_used; _bytes_used += blocks * BLOCKSIZE; _bytes_free -= blocks * BLOCKSIZE; } return result; } /* Free a block of memory allocated by `malloc'. Copyright 1990, 1991, 1992 Free Software Foundation Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif #ifdef VMS /* How to really get more memory. */ __ptr_t (*__lesscore) __P ((__ptr_t __ptr,ptrdiff_t __size)) = __vms_lesscore; #else /* How to really get more memory. */ __ptr_t (*__lesscore) __P ((__ptr_t __ptr,ptrdiff_t __size)) = __default_lesscore; #endif /* Debugging hook for free. */ #ifdef VMS void (*__free_hook) __P ((__ptr_t __ptr)) = __vms_free; #else void (*__free_hook) __P ((__ptr_t __ptr)); #endif /* List of blocks allocated by memalign. */ struct alignlist *_aligned_blocks = NULL; /* Return memory to the heap. Like `free' but don't call a __free_hook if there is one. */ void _free_internal (ptr) __ptr_t ptr; { int type; size_t block, blocks; register size_t i; struct list *prev, *next; block = BLOCK (ptr); type = _heapinfo[block].busy.type; switch (type) { case 0: /* Get as many statistics as early as we can. */ --_chunks_used; _bytes_used -= _heapinfo[block].busy.info.size * BLOCKSIZE; _bytes_free += _heapinfo[block].busy.info.size * BLOCKSIZE; /* Find the free cluster previous to this one in the free list. Start searching at the last block referenced; this may benefit programs with locality of allocation. */ i = _heapindex; if (i > block) while (i > block) i = _heapinfo[i].free.prev; else { do i = _heapinfo[i].free.next; while (i > 0 && i < block); i = _heapinfo[i].free.prev; } /* Determine how to link this block into the free list. */ if (block == i + _heapinfo[i].free.size) { /* Coalesce this block with its predecessor. */ _heapinfo[i].free.size += _heapinfo[block].busy.info.size; block = i; } else { /* Really link this block back into the free list. */ _heapinfo[block].free.size = _heapinfo[block].busy.info.size; _heapinfo[block].free.next = _heapinfo[i].free.next; _heapinfo[block].free.prev = i; _heapinfo[i].free.next = block; _heapinfo[_heapinfo[block].free.next].free.prev = block; ++_chunks_free; } /* Now that the block is linked in, see if we can coalesce it with its successor (by deleting its successor from the list and adding in its size). */ if (block + _heapinfo[block].free.size == _heapinfo[block].free.next) { _heapinfo[block].free.size += _heapinfo[_heapinfo[block].free.next].free.size; _heapinfo[block].free.next = _heapinfo[_heapinfo[block].free.next].free.next; _heapinfo[_heapinfo[block].free.next].free.prev = block; --_chunks_free; } /* Now see if we can return stuff to the system. */ blocks = _heapinfo[block].free.size; if (blocks >= FINAL_FREE_BLOCKS && block + blocks == _heaplimit && (*__morecore) (0) == ADDRESS (block + blocks)) { register size_t bytes = blocks * BLOCKSIZE; _heaplimit -= blocks; (*__lesscore) (ADDRESS(block), bytes); _heapinfo[_heapinfo[block].free.prev].free.next = _heapinfo[block].free.next; _heapinfo[_heapinfo[block].free.next].free.prev = _heapinfo[block].free.prev; block = _heapinfo[block].free.prev; --_chunks_free; _bytes_free -= bytes; } /* Set the next search to begin at this block. */ _heapindex = block; break; default: /* Do some of the statistics. */ --_chunks_used; _bytes_used -= 1 << type; ++_chunks_free; _bytes_free += 1 << type; /* Get the address of the first free fragment in this block. */ prev = (struct list *) ((char *) ADDRESS (block) + (_heapinfo[block].busy.info.frag.first << type)); #ifdef RL_DEBUG printf("_free_internal(0%o/0x%x/%d) :\n", ptr, ptr, ptr); printf(" block = %d, type = %d, prev = 0%o/0x%x/%d\n", block, type, prev, prev, prev); printf(" _heapinfo[block=%d].busy.info.frag.nfree = %d\n", block, _heapinfo[block].busy.info.frag.nfree); #endif if (_heapinfo[block].busy.info.frag.nfree == (BLOCKSIZE >> type) - 1) { /* If all fragments of this block are free, remove them from the fragment list and free the whole block. */ next = prev; for (i = 1; i < (size_t) (BLOCKSIZE >> type); ++i) next = next->next; prev->prev->next = next; if (next != NULL) next->prev = prev->prev; _heapinfo[block].busy.type = 0; _heapinfo[block].busy.info.size = 1; /* Keep the statistics accurate. */ ++_chunks_used; _bytes_used += BLOCKSIZE; _chunks_free -= BLOCKSIZE >> type; _bytes_free -= BLOCKSIZE; free (ADDRESS (block)); } else if (_heapinfo[block].busy.info.frag.nfree != 0) { /* If some fragments of this block are free, link this fragment into the fragment list after the first free fragment of this block. */ #ifdef RL_DEBUG printf("There's a bug hiding here (%s:%d), so I will print some values\n", __FILE__, __LINE__); #endif next = (struct list *) ptr; #ifdef RL_DEBUG printf(" (struct list *)next (0%o / 0x%x / %d) ->\n", next, next, next); printf(" next = 0%o / 0x%x / %d\n", next->next,next->next,next->next); printf(" prev = 0%o / 0x%x / %d\n", next->prev,next->prev,next->prev); printf(" (struct list *)prev (0%o / 0x%x / %d)->\n", prev, prev, prev); printf(" next = 0%o / 0x%x / %d\n", prev->next,prev->next,prev->next); printf(" prev = 0%o / 0x%x / %d\n", prev->prev,prev->prev,prev->prev); #endif next->next = prev->next; next->prev = prev; prev->next = next; if (next->next != NULL) next->next->prev = next; ++_heapinfo[block].busy.info.frag.nfree; } else { /* No fragments of this block are free, so link this fragment into the fragment list and announce that it is the first free fragment of this block. */ prev = (struct list *) ptr; _heapinfo[block].busy.info.frag.nfree = 1; _heapinfo[block].busy.info.frag.first = (unsigned long int) ((unsigned long int) ((char *) ptr - (char *) NULL) % BLOCKSIZE >> type); prev->next = _fraghead[type].next; prev->prev = &_fraghead[type]; prev->prev->next = prev; if (prev->next != NULL) prev->next->prev = prev; } break; } } /* Return memory to the heap. */ void free (ptr) __ptr_t ptr; { register struct alignlist *l; if (ptr == NULL) return; for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == ptr) { l->aligned = NULL; /* Mark the slot in the list as free. */ ptr = l->exact; break; } if (__free_hook != NULL) (*__free_hook) (ptr); else _free_internal (ptr); } /* Change the size of a block allocated by `malloc'. Copyright 1990, 1991, 1992, 1993 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif #define min(A, B) ((A) < (B) ? (A) : (B)) /* Debugging hook for realloc. */ #ifdef VMS __ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, size_t __size)) = __vms_realloc; #else __ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, size_t __size)); #endif /* Resize the given region to the new size, returning a pointer to the (possibly moved) region. This is optimized for speed; some benchmarks seem to indicate that greater compactness is achieved by unconditionally allocating and copying to a new region. This module has incestuous knowledge of the internals of both free and malloc. */ __ptr_t realloc (ptr, size) __ptr_t ptr; size_t size; { __ptr_t result; int type; size_t block, blocks, oldlimit; if (size == 0) { free (ptr); return malloc (0); } else if (ptr == NULL) return malloc (size); if (__realloc_hook != NULL) return (*__realloc_hook) (ptr, size); block = BLOCK (ptr); type = _heapinfo[block].busy.type; switch (type) { case 0: /* Maybe reallocate a large block to a small fragment. */ if (size <= BLOCKSIZE / 2) { result = malloc (size); if (result != NULL) { memcpy (result, ptr, size); free (ptr); return result; } } /* The new size is a large allocation as well; see if we can hold it in place. */ blocks = BLOCKIFY (size); if (blocks < _heapinfo[block].busy.info.size) { /* The new size is smaller; return excess memory to the free list. */ _heapinfo[block + blocks].busy.type = 0; _heapinfo[block + blocks].busy.info.size = _heapinfo[block].busy.info.size - blocks; _heapinfo[block].busy.info.size = blocks; free (ADDRESS (block + blocks)); result = ptr; } else if (blocks == _heapinfo[block].busy.info.size) /* No size change necessary. */ result = ptr; else { /* Won't fit, so allocate a new region that will. Free the old region first in case there is sufficient adjacent free space to grow without moving. */ blocks = _heapinfo[block].busy.info.size; /* Prevent free from actually returning memory to the system. */ oldlimit = _heaplimit; _heaplimit = 0; free (ptr); _heaplimit = oldlimit; result = malloc (size); if (result == NULL) { /* Now we're really in trouble. We have to unfree the thing we just freed. Unfortunately it might have been coalesced with its neighbors. */ if (_heapindex == block) (void) malloc (blocks * BLOCKSIZE); else { __ptr_t previous = malloc ((block - _heapindex) * BLOCKSIZE); (void) malloc (blocks * BLOCKSIZE); free (previous); } return NULL; } if (ptr != result) memmove (result, ptr, blocks * BLOCKSIZE); } break; default: /* Old size is a fragment; type is logarithm to base two of the fragment size. */ if (size > (size_t) (1 << (type - 1)) && size <= (size_t) (1 << type)) /* The new size is the same kind of fragment. */ result = ptr; else { /* The new size is different; allocate a new space, and copy the lesser of the new size and the old. */ result = malloc (size); if (result == NULL) return NULL; memcpy (result, ptr, min (size, (size_t) 1 << type)); free (ptr); } break; } return result; } /* Copyright (C) 1991, 1992 Free Software Foundation, Inc. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif /* Allocate an array of NMEMB elements each SIZE bytes long. The entire array is initialized to zeros. */ __ptr_t calloc (nmemb, size) register size_t nmemb; register size_t size; { register __ptr_t result = malloc (nmemb * size); if (result != NULL) (void) memset (result, 0, nmemb * size); return result; } /* Copyright (C) 1991, 1992 Free Software Foundation, Inc. This file is part of the GNU C Library. The GNU C Library 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. The GNU C Library 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 the GNU C Library; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif #ifndef __GNU_LIBRARY__ #define __sbrk sbrk #ifdef VMS #define __brk brk #endif #endif extern __ptr_t __sbrk __P ((int increment)); #ifndef NULL #define NULL 0 #endif #if defined(emacs) && defined(VMS) /* Dumping of Emacs on VMS does not include the heap! So let's make a huge array from which initial data will be allocated. VMS_ALLOCATION_SIZE is the amount of memory we preallocate. We don't want it to be too large, because it only gives a larger dump file. The way to check how much is really used is to make VMS_ALLOCATION_SIZE very large, to link Emacs with the debugger, run Emacs, check how much was allocated. Then set VMS_ALLOCATION_SIZE to something suitable, recompile gmalloc, relink Emacs, and you should be off. N.B. This is experimental, but it worked quite fine on Emacs 18. */ #ifndef VMS_ALLOCATION_SIZE #define VMS_ALLOCATION_SIZE (512*(512+128)) #endif int vms_out_initial = 0; char vms_initial_buffer[VMS_ALLOCATION_SIZE]; char *vms_current_brk = vms_initial_buffer; char *vms_end_brk = &vms_initial_buffer[VMS_ALLOCATION_SIZE-1]; __ptr_t __vms_initial_morecore (increment) ptrdiff_t increment; { __ptr_t result = NULL; __ptr_t temp; /* It's far easier to make the alignment here than to make a kludge in align () */ #ifdef RL_DEBUG printf(">>>foo... %p...", vms_current_brk); #endif vms_current_brk += (BLOCKSIZE - ((unsigned long) vms_current_brk & (BLOCKSIZE - 1))) & (BLOCKSIZE - 1); #ifdef RL_DEBUG printf("bar... %p. (%d)\n", vms_current_brk, increment); #endif temp = vms_current_brk + (int) increment; if (temp <= vms_end_brk) { if (increment >= 0) result = vms_current_brk; else result = temp; vms_current_brk = temp; } return result; } __ptr_t __vms_initial_lesscore (ptr, size) __ptr_t ptr; ptrdiff_t size; { if (ptr >= vms_initial_buffer && ptr < vms_initial_buffer+VMS_ALLOCATION_SIZE) { vms_current_brk = ptr; return vms_current_brk; } return vms_current_brk; } VMS_present_buffer() { printf("Vms initial buffer starts at 0%o/0x%x/%d and ends at 0%o/0x%x/%d\n", vms_initial_buffer, vms_initial_buffer, vms_initial_buffer, vms_end_brk, vms_end_brk, vms_end_brk); } #endif /* defined(emacs) && defined(VMS) */ #ifdef VMS /* Unfortunatelly, the VAX C sbrk() is buggy. For example, it returns memory in 512 byte chunks (not a bug, but there's more), AND it adds an extra 512 byte chunk if you ask for a multiple of 512 bytes (you ask for 512 bytes, you get 1024 bytes...). And also, the VAX C sbrk does not handle negative increments... There's a similar problem with brk(). Even if you set the break to an even page boundary, it gives you one extra page... */ static char vms_brk_info_fetched = -1; /* -1 if this is the first time, otherwise bit 0 set if 'increment' needs adjustment bit 1 set if the value to brk() needs adjustment */ static char *vms_brk_start = 0; static char *vms_brk_end = 0; static char *vms_brk_current = 0; #endif /* Allocate INCREMENT more bytes of data space, and return the start of data space, or NULL on errors. If INCREMENT is negative, shrink data space. */ __ptr_t __default_morecore (increment) ptrdiff_t increment; { __ptr_t result; #ifdef VMS __ptr_t temp; #ifdef RL_DEBUG printf("DEBUG: morecore: increment = %x\n", increment); printf(" @ start: vms_brk_info_fetched = %x\n", vms_brk_info_fetched); printf(" vms_brk_start = %p\n", vms_brk_start); printf(" vms_brk_current = %p\n", vms_brk_current); printf(" vms_brk_end = %p\n", vms_brk_end); printf(" @ end: "); #endif if (vms_brk_info_fetched < 0) { vms_brk_current = vms_brk_start = __sbrk (512); vms_brk_end = __sbrk (0); if (vms_brk_end - vms_brk_current == 1024) vms_brk_info_fetched = 1; else vms_brk_info_fetched = 0; vms_brk_end = brk(vms_brk_start); if (vms_brk_end != vms_brk_start) vms_brk_info_fetched |= 2; #ifdef RL_DEBUG printf("vms_brk_info_fetched = %x\n", vms_brk_info_fetched); printf(" vms_brk_start = %p\n", vms_brk_start); printf(" vms_brk_current = %p\n", vms_brk_current); printf(" vms_brk_end = %p\n", vms_brk_end); printf(" "); #endif } if (increment < 0) { printf("BZZZZZT! ERROR: __default_morecore does NOT take negative args\n"); return NULL; } if (increment > 0) { result = vms_brk_current; temp = vms_brk_current + increment; if (temp > vms_brk_end) { __ptr_t foo; foo = __sbrk (0); if (foo == vms_brk_end) { increment = temp - vms_brk_end; if (increment > (vms_brk_info_fetched & 1)) increment -= (vms_brk_info_fetched & 1); foo = __sbrk(increment); #ifdef RL_DEBUG printf("__sbrk(%d) --> %p\n", increment, foo); #endif if (foo == (__ptr_t) -1) return NULL; #ifdef RL_DEBUG printf(" "); #endif } else { result = __sbrk (increment); if (result == (__ptr_t) -1) return NULL; temp = result + increment; } vms_brk_end = __sbrk(0); } vms_brk_current = temp; #ifdef RL_DEBUG printf("vms_brk_current = %p\n", vms_brk_current); printf(" vms_brk_end = %p\n", vms_brk_end); #endif return result; } #ifdef RL_DEBUG printf(" nothing more...\n"); #endif /* OK, so the user wanted to check where the heap limit is. Let's see if the system thinks it is where we think it is. */ temp = __sbrk (0); if (temp != vms_brk_end) { /* the value has changed. Let's trust the system and modify our value */ vms_brk_current = vms_brk_end = temp; } return vms_brk_current; #else /* not VMS */ result = __sbrk ((int) increment); if (result == (__ptr_t) -1) return NULL; return result; #endif /* VMS */ } __ptr_t __default_lesscore (ptr, size) __ptr_t ptr; ptrdiff_t size; { #ifdef VMS if (vms_brk_end != 0) { vms_brk_current = ptr; if (vms_brk_current < vms_brk_start) vms_brk_current = vms_brk_start; vms_brk_end = (char *) vms_brk_current - ((vms_brk_info_fetched >> 1) & 1); #ifdef RL_DEBUG printf("<< #endif #if defined (emacs) || defined (HAVE_CONFIG_H) #include "config.h" #endif #ifdef __GNU_LIBRARY__ extern size_t __getpagesize __P ((void)); #else #if !defined(USG) && !defined(VMS) extern size_t getpagesize __P ((void)); #define __getpagesize() getpagesize() #else #include #ifdef EXEC_PAGESIZE #define __getpagesize() EXEC_PAGESIZE #else /* No EXEC_PAGESIZE. */ #ifdef NBPG #ifndef CLSIZE #define CLSIZE 1 #endif /* No CLSIZE. */ #define __getpagesize() (NBPG * CLSIZE) #else /* No NBPG. */ #define __getpagesize() NBPC #endif /* NBPG. */ #endif /* EXEC_PAGESIZE. */ #endif /* USG. */ #endif static size_t pagesize; __ptr_t valloc (size) size_t size; { if (pagesize == 0) pagesize = __getpagesize (); return memalign (pagesize, size); } /* Copyright (C) 1991, 1992 Free Software Foundation, Inc. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif __ptr_t memalign (alignment, size) size_t alignment; size_t size; { __ptr_t result; unsigned long int adj; size = ((size + alignment - 1) / alignment) * alignment; result = malloc (size); if (result == NULL) return NULL; adj = (unsigned long int) ((unsigned long int) ((char *) result - (char *) NULL)) % alignment; if (adj != 0) { struct alignlist *l; for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == NULL) /* This slot is free. Use it. */ break; if (l == NULL) { l = (struct alignlist *) malloc (sizeof (struct alignlist)); if (l == NULL) { free (result); return NULL; } } l->exact = result; result = l->aligned = (char *) result + alignment - adj; l->next = _aligned_blocks; _aligned_blocks = l; } return result; } #ifdef VMS struct vms_malloc_data { int __malloc_initialized; char *_heapbase; malloc_info *_heapinfo; size_t heapsize; size_t _heapindex; size_t _heaplimit; size_t _chunks_used; size_t _bytes_used; size_t _chunks_free; size_t _bytes_free; } ____vms_malloc_data[] = { { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 } }; struct vms_core_routines { __ptr_t (*__morecore) __P ((ptrdiff_t increment)); __ptr_t (*__lesscore) __P ((__ptr_t address, ptrdiff_t increment)); } ____vms_core_routines[] = { { __vms_initial_morecore, __vms_initial_lesscore }, { __default_morecore, __default_lesscore }, { 0, 0 } }; static int current_vms_data = -1; static int current_vms_core_routines = 0; static void use_vms_core_routines (int i) { current_vms_core_routines = i; current_vms_data = i; } static void use_vms_data (int i) { use_vms_core_routines (i); __malloc_initialized = ____vms_malloc_data[i].__malloc_initialized; _heapbase = ____vms_malloc_data[i]._heapbase; _heapinfo = ____vms_malloc_data[i]._heapinfo; heapsize = ____vms_malloc_data[i].heapsize; _heapindex = ____vms_malloc_data[i]._heapindex; _heaplimit = ____vms_malloc_data[i]._heaplimit; _chunks_used = ____vms_malloc_data[i]._chunks_used; _bytes_used = ____vms_malloc_data[i]._bytes_used; _chunks_free = ____vms_malloc_data[i]._chunks_free; _bytes_free = ____vms_malloc_data[i]._bytes_free; } static void store_vms_data (int i) { ____vms_malloc_data[i].__malloc_initialized = __malloc_initialized; ____vms_malloc_data[i]._heapbase = _heapbase; ____vms_malloc_data[i]._heapinfo = _heapinfo; ____vms_malloc_data[i].heapsize = heapsize; ____vms_malloc_data[i]._heapindex = _heapindex; ____vms_malloc_data[i]._heaplimit = _heaplimit; ____vms_malloc_data[i]._chunks_used = _chunks_used; ____vms_malloc_data[i]._bytes_used = _bytes_used; ____vms_malloc_data[i]._chunks_free = _chunks_free; ____vms_malloc_data[i]._bytes_free = _bytes_free; } static void store_current_vms_data () { switch (current_vms_data) { case 0: case 1: store_vms_data (current_vms_data); break; } } __ptr_t __vms_morecore (increment) ptrdiff_t increment; { return (*____vms_core_routines[current_vms_core_routines].__morecore) (increment); } __ptr_t __vms_lesscore (ptr, increment) __ptr_t ptr; ptrdiff_t increment; { return (*____vms_core_routines[current_vms_core_routines].__lesscore) (ptr,increment); } __ptr_t __vms_malloc (size) size_t size; { __ptr_t result; int old_current_vms_data = current_vms_data; __malloc_hook = 0; store_current_vms_data (); if (____vms_malloc_data[0]._heapbase != 0) use_vms_data (0); else use_vms_core_routines (0); result = malloc (size); store_vms_data (0); if (result == NULL) { use_vms_data (1); result = malloc (size); store_vms_data (1); vms_out_initial = 1; } __malloc_hook = __vms_malloc; if (old_current_vms_data != -1) use_vms_data (current_vms_data); return result; } void __vms_free (ptr) __ptr_t ptr; { int old_current_vms_data = current_vms_data; __free_hook = 0; store_current_vms_data (); if (ptr >= vms_initial_buffer && ptr <= vms_end_brk) { use_vms_data (0); free (ptr); store_vms_data (0); } else { use_vms_data (1); free (ptr); store_vms_data (1); if (_chunks_free == 0 && _chunks_used == 0) vms_out_initial = 0; } __free_hook = __vms_free; if (old_current_vms_data != -1) use_vms_data (current_vms_data); } __ptr_t __vms_realloc (ptr, size) __ptr_t ptr; size_t size; { __ptr_t result; int old_current_vms_data = current_vms_data; __realloc_hook = 0; store_current_vms_data (); if (ptr >= vms_initial_buffer && ptr <= vms_end_brk) { use_vms_data (0); result = realloc (ptr, size); store_vms_data (0); } else { use_vms_data (1); result = realloc (ptr, size); store_vms_data (1); } __realloc_hook = __vms_realloc; if (old_current_vms_data != -1) use_vms_data (current_vms_data); return result; } #endif /* VMS */ /* Standard debugging hooks for `malloc'. Copyright 1990, 1991, 1992 Free Software Foundation Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif /* Old hook values. */ static void (*old_free_hook) __P ((__ptr_t ptr)); static __ptr_t (*old_malloc_hook) __P ((size_t size)); static __ptr_t (*old_realloc_hook) __P ((__ptr_t ptr, size_t size)); /* Function to call when something awful happens. */ static void (*abortfunc) __P ((void)); /* Arbitrary magical numbers. */ #define MAGICWORD 0xfedabeeb #define MAGICBYTE ((char) 0xd7) struct hdr { size_t size; /* Exact size requested by user. */ unsigned long int magic; /* Magic number to check header integrity. */ }; static void checkhdr __P ((__const struct hdr *)); static void checkhdr (hdr) __const struct hdr *hdr; { if (hdr->magic != MAGICWORD || ((char *) &hdr[1])[hdr->size] != MAGICBYTE) (*abortfunc) (); } static void freehook __P ((__ptr_t)); static void freehook (ptr) __ptr_t ptr; { struct hdr *hdr = ((struct hdr *) ptr) - 1; checkhdr (hdr); hdr->magic = 0; __free_hook = old_free_hook; free (hdr); __free_hook = freehook; } static __ptr_t mallochook __P ((size_t)); static __ptr_t mallochook (size) size_t size; { struct hdr *hdr; __malloc_hook = old_malloc_hook; hdr = (struct hdr *) malloc (sizeof (struct hdr) + size + 1); __malloc_hook = mallochook; if (hdr == NULL) return NULL; hdr->size = size; hdr->magic = MAGICWORD; ((char *) &hdr[1])[size] = MAGICBYTE; return (__ptr_t) (hdr + 1); } static __ptr_t reallochook __P ((__ptr_t, size_t)); static __ptr_t reallochook (ptr, size) __ptr_t ptr; size_t size; { struct hdr *hdr = ((struct hdr *) ptr) - 1; checkhdr (hdr); __free_hook = old_free_hook; __malloc_hook = old_malloc_hook; __realloc_hook = old_realloc_hook; hdr = (struct hdr *) realloc ((__ptr_t) hdr, sizeof (struct hdr) + size + 1); __free_hook = freehook; __malloc_hook = mallochook; __realloc_hook = reallochook; if (hdr == NULL) return NULL; hdr->size = size; ((char *) &hdr[1])[size] = MAGICBYTE; return (__ptr_t) (hdr + 1); } int mcheck (func) void (*func) __P ((void)); { extern void abort __P ((void)); static int mcheck_used = 0; abortfunc = (func != NULL) ? func : abort; /* These hooks may not be safely inserted if malloc is already in use. */ if (!__malloc_initialized && !mcheck_used) { old_free_hook = __free_hook; __free_hook = freehook; old_malloc_hook = __malloc_hook; __malloc_hook = mallochook; old_realloc_hook = __realloc_hook; __realloc_hook = reallochook; mcheck_used = 1; } return mcheck_used ? 0 : -1; } /* More debugging hooks for `malloc'. Copyright (C) 1991, 1992 Free Software Foundation, Inc. Written April 2, 1991 by John Gilmore of Cygnus Support. Based on mcheck.c by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif #include #ifndef __GNU_LIBRARY__ extern char *getenv (); #else #include #endif static FILE *mallstream; static char mallenv[]= "MALLOC_TRACE"; static char mallbuf[BUFSIZ]; /* Buffer for the output. */ /* Address to breakpoint on accesses to... */ __ptr_t mallwatch; /* Old hook values. */ static __ptr_t (*tr_old_morecore) __P ((ptrdiff_t increment)); static __ptr_t (*tr_old_lesscore) __P ((__ptr_t ptr, ptrdiff_t increment)); static void (*tr_old_free_hook) __P ((__ptr_t ptr)); static __ptr_t (*tr_old_malloc_hook) __P ((size_t size)); static __ptr_t (*tr_old_realloc_hook) __P ((__ptr_t ptr, size_t size)); /* This function is called when the block being alloc'd, realloc'd, or freed has an address matching the variable "mallwatch". In a debugger, set "mallwatch" to the address of interest, then put a breakpoint on tr_break. */ void tr_break __P ((void)); void tr_break () { } static void tr_freehook __P ((__ptr_t)); static void tr_freehook (ptr) __ptr_t ptr; { fprintf (mallstream, "- %p\n", ptr); /* Be sure to print it first. */ if (ptr == mallwatch) tr_break (); __free_hook = tr_old_free_hook; free (ptr); __free_hook = tr_freehook; } static __ptr_t tr_morecore __P ((ptrdiff_t)); static __ptr_t tr_morecore (increment) ptrdiff_t increment; { __ptr_t p; __morecore = tr_old_morecore; p = (__ptr_t) (*__morecore) (increment); __morecore = tr_morecore; fprintf (mallstream, "$ %p %d\n", p, increment); return p; } static __ptr_t tr_lesscore __P ((__ptr_t, ptrdiff_t)); static __ptr_t tr_lesscore (ptr, increment) __ptr_t ptr; ptrdiff_t increment; { __ptr_t p; __lesscore = tr_old_lesscore; p = (__ptr_t) (*__lesscore) (ptr, increment); __lesscore = tr_lesscore; fprintf (mallstream, "* %p (%p, %d)\n", p, ptr, increment); return p; } static __ptr_t tr_mallochook __P ((size_t)); static __ptr_t tr_mallochook (size) size_t size; { __ptr_t hdr; __malloc_hook = tr_old_malloc_hook; hdr = (__ptr_t) malloc (size); __malloc_hook = tr_mallochook; /* We could be printing a NULL here; that's OK. */ fprintf (mallstream, "+ %p %x\n", hdr, size); if (hdr == mallwatch) tr_break (); return hdr; } static __ptr_t tr_reallochook __P ((__ptr_t, size_t)); static __ptr_t tr_reallochook (ptr, size) __ptr_t ptr; size_t size; { __ptr_t hdr; if (ptr == mallwatch) tr_break (); __free_hook = tr_old_free_hook; __malloc_hook = tr_old_malloc_hook; __realloc_hook = tr_old_realloc_hook; hdr = (__ptr_t) realloc (ptr, size); __free_hook = tr_freehook; __malloc_hook = tr_mallochook; __realloc_hook = tr_reallochook; if (hdr == NULL) /* Failed realloc. */ fprintf (mallstream, "! %p %x\n", ptr, size); else fprintf (mallstream, "< %p\n> %p %x\n", ptr, hdr, size); if (hdr == mallwatch) tr_break (); return hdr; } /* We enable tracing if either the environment variable MALLOC_TRACE is set, or if the variable mallwatch has been patched to an address that the debugging user wants us to stop on. When patching mallwatch, don't forget to set a breakpoint on tr_break! */ void mtrace () { char *mallfile; mallfile = getenv (mallenv); if (mallfile != NULL || mallwatch != NULL) { mallstream = fopen (mallfile != NULL ? mallfile : "/dev/null", "w"); if (mallstream != NULL) { /* Be sure it doesn't malloc its buffer! */ setbuf (mallstream, mallbuf); fprintf (mallstream, "= Start\n"); #if defined(emacs) && defined(VMS) fprintf (mallstream, "= Initial buffer spans %p -- %p\n", vms_initial_buffer, vms_end_brk + 1); #endif tr_old_morecore = __morecore; __morecore = tr_morecore; tr_old_lesscore = __lesscore; __lesscore = tr_lesscore; tr_old_free_hook = __free_hook; __free_hook = tr_freehook; tr_old_malloc_hook = __malloc_hook; __malloc_hook = tr_mallochook; tr_old_realloc_hook = __realloc_hook; __realloc_hook = tr_reallochook; } } } /* Access the statistics maintained by `malloc'. Copyright 1990, 1991, 1992 Free Software Foundation Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif struct mstats mstats () { struct mstats result; result.bytes_total = (char *) (*__morecore) (0) - _heapbase; result.chunks_used = _chunks_used; result.bytes_used = _bytes_used; result.chunks_free = _chunks_free; result.bytes_free = _bytes_free; return result; } emacs-19.30/src/vmsmap.c100444 75424 1 13575 5770115143 13576 0ustar kwzhdaemon/* VMS mapping of data and alloc arena for GNU Emacs. Copyright (C) 1986, 1987 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. */ /* Written by Mukesh Prasad. */ #ifdef VMS #include #include "lisp.h" #include #include #include #include /* RMS block size */ #define BLOCKSIZE 512 /* Maximum number of bytes to be written in one RMS write. * Must be a multiple of BLOCKSIZE. */ #define MAXWRITE (BLOCKSIZE * 30) /* This funniness is to ensure that sdata occurs alphabetically BEFORE the $DATA psect and that edata occurs after ALL Emacs psects. This is because the VMS linker sorts all psects in a cluster alphabetically during the linking, unless you use the cluster_psect command. Emacs uses the cluster command to group all Emacs psects into one cluster; this keeps the dumped data separate from any loaded libraries. */ globaldef {"$D$ATA"} char sdata[512]; /* Start of saved data area */ globaldef {"__DATA"} char edata[512]; /* End of saved data area */ /* Structure to write into first block of map file. */ struct map_data { char * sdata; /* Start of data area */ char * edata; /* End of data area */ int datablk; /* Block in file to map data area from/to */ }; static void fill_fab (), fill_rab (); static int write_data (); extern char *start_of_data (); extern int vms_out_initial; /* Defined in malloc.c */ /* Maps in the data and alloc area from the map file. */ int mapin_data (name) char * name; { struct FAB fab; struct RAB rab; int status, size; int inadr[2]; struct map_data map_data; /* Open map file. */ fab = cc$rms_fab; fab.fab$b_fac = FAB$M_BIO|FAB$M_GET; fab.fab$l_fna = name; fab.fab$b_fns = strlen (name); status = sys$open (&fab); if (status != RMS$_NORMAL) { printf ("Map file not available, running bare Emacs....\n"); return 0; /* Map file not available */ } /* Connect the RAB block */ rab = cc$rms_rab; rab.rab$l_fab = &fab; rab.rab$b_rac = RAB$C_SEQ; rab.rab$l_rop = RAB$M_BIO; status = sys$connect (&rab); if (status != RMS$_NORMAL) lib$stop (status); /* Read the header data */ rab.rab$l_ubf = &map_data; rab.rab$w_usz = sizeof (map_data); rab.rab$l_bkt = 0; status = sys$read (&rab); if (status != RMS$_NORMAL) lib$stop (status); status = sys$close (&fab); if (status != RMS$_NORMAL) lib$stop (status); if (map_data.sdata != start_of_data ()) { printf ("Start of data area has moved: cannot map in data.\n"); return 0; } if (map_data.edata != edata) { printf ("End of data area has moved: cannot map in data.\n"); return 0; } fab.fab$l_fop |= FAB$M_UFO; status = sys$open (&fab); if (status != RMS$_NORMAL) lib$stop (status); /* Map data area. */ inadr[0] = map_data.sdata; inadr[1] = map_data.edata; status = sys$crmpsc (inadr, 0, 0, SEC$M_CRF | SEC$M_WRT, 0, 0, 0, fab.fab$l_stv, 0, map_data.datablk, 0, 0); if (! (status & 1)) lib$stop (status); } /* Writes the data and alloc area to the map file. */ mapout_data (into) char * into; { struct FAB fab; struct RAB rab; int status; struct map_data map_data; int datasize, msize; if (vms_out_initial) { error ("Out of initial allocation. Must rebuild emacs with more memory (VMS_ALLOCATION_SIZE)."); return 0; } map_data.sdata = start_of_data (); map_data.edata = edata; datasize = map_data.edata - map_data.sdata + 1; map_data.datablk = 2 + (sizeof (map_data) + BLOCKSIZE - 1) / BLOCKSIZE; /* Create map file. */ fab = cc$rms_fab; fab.fab$b_fac = FAB$M_BIO|FAB$M_PUT; fab.fab$l_fna = into; fab.fab$b_fns = strlen (into); fab.fab$l_fop = FAB$M_CBT; fab.fab$b_org = FAB$C_SEQ; fab.fab$b_rat = 0; fab.fab$b_rfm = FAB$C_VAR; fab.fab$l_alq = 1 + map_data.datablk + ((datasize + BLOCKSIZE - 1) / BLOCKSIZE); status = sys$create (&fab); if (status != RMS$_NORMAL) { error ("Could not create map file"); return 0; } /* Connect the RAB block */ rab = cc$rms_rab; rab.rab$l_fab = &fab; rab.rab$b_rac = RAB$C_SEQ; rab.rab$l_rop = RAB$M_BIO; status = sys$connect (&rab); if (status != RMS$_NORMAL) { error ("RMS connect to map file failed"); return 0; } /* Write the header */ rab.rab$l_rbf = &map_data; rab.rab$w_rsz = sizeof (map_data); status = sys$write (&rab); if (status != RMS$_NORMAL) { error ("RMS write (header) to map file failed"); return 0; } if (! write_data (&rab, map_data.datablk, map_data.sdata, datasize)) return 0; status = sys$close (&fab); if (status != RMS$_NORMAL) { error ("RMS close on map file failed"); return 0; } return 1; } static int write_data (rab, firstblock, data, length) struct RAB * rab; char * data; { int status; rab->rab$l_bkt = firstblock; while (length > 0) { rab->rab$l_rbf = data; rab->rab$w_rsz = length > MAXWRITE ? MAXWRITE : length; status = sys$write (rab, 0, 0); if (status != RMS$_NORMAL) { error ("RMS write to map file failed"); return 0; } data = &data[MAXWRITE]; length -= MAXWRITE; rab->rab$l_bkt = 0; } return 1; } /* write_data */ #endif /* VMS */ emacs-19.30/src/vmsproc.c100444 75424 1 42445 5770115144 13763 0ustar kwzhdaemon/* Interfaces to subprocesses on VMS. Copyright (C) 1988, 1994 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. */ /* Event flag and `select' emulation 0 is never used 1 is the terminal 23 is the timer event flag 24-31 are reserved by VMS */ #include #include #include #include #include #include "vmsproc.h" #include "lisp.h" #include "buffer.h" #include #include "process.h" #include "commands.h" #include extern Lisp_Object call_process_cleanup (); #define KEYBOARD_EVENT_FLAG 1 #define TIMER_EVENT_FLAG 23 static VMS_PROC_STUFF procList[MAX_EVENT_FLAGS+1]; get_kbd_event_flag () { /* Return the first event flag for keyboard input. */ VMS_PROC_STUFF *vs = &procList[KEYBOARD_EVENT_FLAG]; vs->busy = 1; vs->pid = 0; return (vs->eventFlag); } get_timer_event_flag () { /* Return the last event flag for use by timeouts */ VMS_PROC_STUFF *vs = &procList[TIMER_EVENT_FLAG]; vs->busy = 1; vs->pid = 0; return (vs->eventFlag); } VMS_PROC_STUFF * get_vms_process_stuff () { /* Return a process_stuff structure We use 1-23 as our event flags to simplify implementing a VMS `select' call. */ int i; VMS_PROC_STUFF *vs; for (i=1, vs = procList; ibusy) { vs->busy = 1; vs->inputChan = 0; vs->pid = 0; sys$clref (vs->eventFlag); return (vs); } } return ((VMS_PROC_STUFF *)0); } give_back_vms_process_stuff (vs) VMS_PROC_STUFF *vs; { /* Return an event flag to our pool */ vs->busy = 0; vs->inputChan = 0; vs->pid = 0; } VMS_PROC_STUFF * get_vms_process_pointer (pid) int pid; { /* Given a pid, return the VMS_STUFF pointer */ int i; VMS_PROC_STUFF *vs; /* Don't search the last one */ for (i=0, vs=procList; ibusy && vs->pid == pid) return (vs); } return ((VMS_PROC_STUFF *)0); } start_vms_process_read (vs) VMS_PROC_STUFF *vs; { /* Start an asynchronous read on a VMS process We will catch up with the output sooner or later */ int status; int ProcAst (); status = sys$qio (vs->eventFlag, vs->outputChan, IO$_READVBLK, vs->iosb, 0, vs, vs->inputBuffer, sizeof (vs->inputBuffer), 0, 0, 0, 0); if (status != SS$_NORMAL) return (0); else return (1); } extern int waiting_for_ast; /* in sysdep.c */ extern int timer_ef; extern int input_ef; select (nDesc, rdsc, wdsc, edsc, timeOut) int nDesc; int *rdsc; int *wdsc; int *edsc; int *timeOut; { /* Emulate a select call We know that we only use event flags 1-23 timeout == 100000 & bit 0 set means wait on keyboard input until something shows up. If timeout == 0, we just read the event flags and return what we find. */ int nfds = 0; int status; int time[2]; int delta = -10000000; int zero = 0; int timeout = *timeOut; unsigned long mask, readMask, waitMask; if (rdsc) readMask = *rdsc << 1; /* Unix mask is shifted over 1 */ else readMask = 0; /* Must be a wait call */ sys$clref (KEYBOARD_EVENT_FLAG); sys$setast (0); /* Block interrupts */ sys$readef (KEYBOARD_EVENT_FLAG, &mask); /* See what is set */ mask &= readMask; /* Just examine what we need */ if (mask == 0) { /* Nothing set, we must wait */ if (timeout != 0) { /* Not just inspecting... */ if (!(timeout == 100000 && readMask == (1 << KEYBOARD_EVENT_FLAG))) { lib$emul (&timeout, &delta, &zero, time); sys$setimr (TIMER_EVENT_FLAG, time, 0, 1); waitMask = readMask | (1 << TIMER_EVENT_FLAG); } else waitMask = readMask; if (waitMask & (1 << KEYBOARD_EVENT_FLAG)) { sys$clref (KEYBOARD_EVENT_FLAG); waiting_for_ast = 1; /* Only if reading from 0 */ } sys$setast (1); sys$wflor (KEYBOARD_EVENT_FLAG, waitMask); sys$cantim (1, 0); sys$readef (KEYBOARD_EVENT_FLAG, &mask); if (readMask & (1 << KEYBOARD_EVENT_FLAG)) waiting_for_ast = 0; } } sys$setast (1); /* Count number of descriptors that are ready */ mask &= readMask; if (rdsc) *rdsc = (mask >> 1); /* Back to Unix format */ for (nfds = 0; mask; mask >>= 1) { if (mask & 1) nfds++; } return (nfds); } #define MAX_BUFF 1024 write_to_vms_process (vs, buf, len) VMS_PROC_STUFF *vs; char *buf; int len; { /* Write something to a VMS process. We have to map newlines to carriage returns for VMS. */ char ourBuff[MAX_BUFF]; short iosb[4]; int status; int in, out; while (len > 0) { out = map_nl_to_cr (buf, ourBuff, len, MAX_BUFF); status = sys$qiow (0, vs->inputChan, IO$_WRITEVBLK|IO$M_NOFORMAT, iosb, 0, 0, ourBuff, out, 0, 0, 0, 0); if (status != SS$_NORMAL || (status = iosb[0]) != SS$_NORMAL) { error ("Could not write to subprocess: %x", status); return (0); } len -= out; } return (1); } static map_nl_to_cr (in, out, maxIn, maxOut) char *in; char *out; int maxIn; int maxOut; { /* Copy `in' to `out' remapping `\n' to `\r' */ int c; int o; for (o=0; maxIn-- > 0 && o < maxOut; o++) { c = *in++; *out++ = (c == '\n') ? '\r' : c; } return (o); } clean_vms_buffer (buf, len) char *buf; int len; { /* Sanitize output from a VMS subprocess Strip CR's and NULLs */ char *oBuf = buf; char c; int l = 0; while (len-- > 0) { c = *buf++; if (c == '\r' || c == '\0') ; else { *oBuf++ = c; l++; } } return (l); } /* For the CMU PTY driver */ #define PTYNAME "PYA0:" get_pty_channel (inDevName, outDevName, inChannel, outChannel) char *inDevName; char *outDevName; int *inChannel; int *outChannel; { int PartnerUnitNumber; int status; struct { int l; char *a; } d; struct { short BufLen; short ItemCode; int *BufAddress; int *ItemLength; } g[2]; d.l = strlen (PTYNAME); d.a = PTYNAME; *inChannel = 0; /* Should be `short' on VMS */ *outChannel = 0; *inDevName = *outDevName = '\0'; status = sys$assign (&d, inChannel, 0, 0); if (status == SS$_NORMAL) { *outChannel = *inChannel; g[0].BufLen = sizeof (PartnerUnitNumber); g[0].ItemCode = DVI$_UNIT; g[0].BufAddress = &PartnerUnitNumber; g[0].ItemLength = (int *)0; g[1].BufLen = g[1].ItemCode = 0; status = sys$getdviw (0, *inChannel, 0, &g, 0, 0, 0, 0); if (status == SS$_NORMAL) { sprintf (inDevName, "_TPA%d:", PartnerUnitNumber); strcpy (outDevName, inDevName); } } return (status); } VMSgetwd (buf) char *buf; { /* Return the current directory */ char curdir[256]; char *getenv (); char *s; short len; int status; struct { int l; char *a; } d; s = getenv ("SYS$DISK"); if (s) strcpy (buf, s); else *buf = '\0'; d.l = 255; d.a = curdir; status = sys$setddir (0, &len, &d); if (status & 1) { curdir[len] = '\0'; strcat (buf, curdir); } } static call_process_ast (vs) VMS_PROC_STUFF *vs; { sys$setef (vs->eventFlag); } void child_setup (in, out, err, new_argv, env) int in, out, err; register char **new_argv; char **env; { /* ??? I suspect that maybe this shouldn't be done on VMS. */ #ifdef subprocesses /* Close Emacs's descriptors that this process should not have. */ close_process_descs (); #endif if (STRINGP (current_buffer->directory)) chdir (XSTRING (current_buffer->directory)->data); } DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0, "Call PROGRAM synchronously in a separate process.\n\ Program's input comes from file INFILE (nil means null device, `NLA0:').\n\ Insert output in BUFFER before point; t means current buffer;\n\ nil for BUFFER means discard it; 0 means discard and don't wait.\n\ Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\ Remaining arguments are strings passed as command arguments to PROGRAM.\n\ This function waits for PROGRAM to terminate, unless BUFFER is 0;\n\ if you quit, the process is killed.") (nargs, args) int nargs; register Lisp_Object *args; { Lisp_Object display, buffer, path; char oldDir[512]; int inchannel, outchannel; int len; int call_process_ast (); struct { int l; char *a; } dcmd, din, dout; char inDevName[65]; char outDevName[65]; short iosb[4]; int status; int SpawnFlags = CLI$M_NOWAIT; VMS_PROC_STUFF *vs; VMS_PROC_STUFF *get_vms_process_stuff (); int fd[2]; int filefd; register int pid; char buf[1024]; int count = specpdl_ptr - specpdl; register unsigned char **new_argv; struct buffer *old = current_buffer; CHECK_STRING (args[0], 0); if (nargs <= 1 || NILP (args[1])) args[1] = build_string ("NLA0:"); else args[1] = Fexpand_file_name (args[1], current_buffer->directory); CHECK_STRING (args[1], 1); { register Lisp_Object tem; buffer = tem = args[2]; if (nargs <= 2) buffer = Qnil; else if (!(EQ (tem, Qnil) || EQ (tem, Qt) || XFASTINT (tem) == 0)) { buffer = Fget_buffer (tem); CHECK_BUFFER (buffer, 2); } } display = nargs >= 3 ? args[3] : Qnil; { /* if (args[0] == "*dcl*" then we need to skip pas the "-c", else args[0] is the program to run. */ register int i; int arg0; int firstArg; if (strcmp (XSTRING (args[0])->data, "*dcl*") == 0) { arg0 = 5; firstArg = 6; } else { arg0 = 0; firstArg = 4; } len = XSTRING (args[arg0])->size + 1; for (i = firstArg; i < nargs; i++) { CHECK_STRING (args[i], i); len += XSTRING (args[i])->size + 1; } new_argv = alloca (len); strcpy (new_argv, XSTRING (args[arg0])->data); for (i = firstArg; i < nargs; i++) { strcat (new_argv, " "); strcat (new_argv, XSTRING (args[i])->data); } dcmd.l = len-1; dcmd.a = new_argv; status = get_pty_channel (inDevName, outDevName, &inchannel, &outchannel); if (!(status & 1)) error ("Error getting PTY channel: %x", status); if (INTEGERP (buffer)) { dout.l = strlen ("NLA0:"); dout.a = "NLA0:"; } else { dout.l = strlen (outDevName); dout.a = outDevName; } vs = get_vms_process_stuff (); if (!vs) { sys$dassgn (inchannel); sys$dassgn (outchannel); error ("Too many VMS processes"); } vs->inputChan = inchannel; vs->outputChan = outchannel; } filefd = open (XSTRING (args[1])->data, O_RDONLY, 0); if (filefd < 0) { sys$dassgn (inchannel); sys$dassgn (outchannel); give_back_vms_process_stuff (vs); report_file_error ("Opening process input file", Fcons (args[1], Qnil)); } else close (filefd); din.l = XSTRING (args[1])->size; din.a = XSTRING (args[1])->data; /* Start a read on the process channel */ if (!INTEGERP (buffer)) { start_vms_process_read (vs); SpawnFlags = CLI$M_NOWAIT; } else SpawnFlags = 0; /* On VMS we need to change the current directory of the parent process before forking so that the child inherit that directory. We remember where we were before changing. */ VMSgetwd (oldDir); child_setup (0, 0, 0, 0, 0); status = lib$spawn (&dcmd, &din, &dout, &SpawnFlags, 0, &vs->pid, &vs->exitStatus, 0, call_process_ast, vs); chdir (oldDir); if (status != SS$_NORMAL) { sys$dassgn (inchannel); sys$dassgn (outchannel); give_back_vms_process_stuff (vs); error ("Error calling LIB$SPAWN: %x", status); } pid = vs->pid; if (INTEGERP (buffer)) { #ifndef subprocesses wait_without_blocking (); #endif subprocesses return Qnil; } if (!NILP (display) && INTERACTIVE) prepare_menu_bars (); record_unwind_protect (call_process_cleanup, Fcons (make_number (fd[0]), make_number (pid))); if (BUFFERP (buffer)) Fset_buffer (buffer); immediate_quit = 1; QUIT; while (1) { sys$waitfr (vs->eventFlag); if (vs->iosb[0] & 1) { immediate_quit = 0; if (!NILP (buffer)) { vs->iosb[1] = clean_vms_buffer (vs->inputBuffer, vs->iosb[1]); InsCStr (vs->inputBuffer, vs->iosb[1]); } if (!NILP (display) && INTERACTIVE) redisplay_preserve_echo_area (); immediate_quit = 1; QUIT; if (!start_vms_process_read (vs)) break; /* The other side went away */ } else break; } sys$dassgn (inchannel); sys$dassgn (outchannel); give_back_vms_process_stuff (vs); /* Wait for it to terminate, unless it already has. */ wait_for_termination (pid); immediate_quit = 0; set_current_buffer (old); return unbind_to (count, Qnil); } create_process (process, new_argv) Lisp_Object process; char *new_argv; { int pid, inchannel, outchannel, forkin, forkout; char old_dir[512]; char in_dev_name[65]; char out_dev_name[65]; short iosb[4]; int status; int spawn_flags = CLI$M_NOWAIT; int child_sig (); struct { int l; char *a; } din, dout, dprompt, dcmd; VMS_PROC_STUFF *vs; VMS_PROC_STUFF *get_vms_process_stuff (); status = get_pty_channel (in_dev_name, out_dev_name, &inchannel, &outchannel); if (!(status & 1)) { remove_process (process); error ("Error getting PTY channel: %x", status); } dout.l = strlen (out_dev_name); dout.a = out_dev_name; dprompt.l = strlen (DCL_PROMPT); dprompt.a = DCL_PROMPT; if (strcmp (new_argv, "*dcl*") == 0) { din.l = strlen (in_dev_name); din.a = in_dev_name; dcmd.l = 0; dcmd.a = (char *)0; } else { din.l = strlen ("NLA0:"); din.a = "NLA0:"; dcmd.l = strlen (new_argv); dcmd.a = new_argv; } /* Delay interrupts until we have a chance to store the new fork's pid in its process structure */ sys$setast (0); vs = get_vms_process_stuff (); if (vs == 0) { sys$setast (1); remove_process (process); error ("Too many VMS processes"); } vs->inputChan = inchannel; vs->outputChan = outchannel; /* Start a read on the process channel */ start_vms_process_read (vs); /* Switch current directory so that the child inherits it. */ VMSgetwd (old_dir); child_setup (0, 0, 0, 0, 0); status = lib$spawn (&dcmd, &din, &dout, &spawn_flags, 0, &vs->pid, &vs->exitStatus, 0, child_sig, vs, &dprompt); chdir (old_dir); if (status != SS$_NORMAL) { sys$setast (1); remove_process (process); error ("Error calling LIB$SPAWN: %x", status); } vs->pid &= 0xffff; /* It needs to fit in a FASTINT, we don't need the rest of the bits */ pid = vs->pid; /* ON VMS process->infd holds the (event flag-1) that we use for doing I/O on that process. `input_wait_mask' is the cluster of event flags we can wait on. Event flags returned start at 1 for the keyboard. Since Unix expects descriptor 0 for the keyboard, we substract one from the event flag. */ inchannel = vs->eventFlag-1; /* Record this as an active process, with its channels. As a result, child_setup will close Emacs's side of the pipes. */ chan_process[inchannel] = process; XSETFASTINT (XPROCESS (process)->infd, inchannel); XSETFASTINT (XPROCESS (process)->outfd, outchannel); XPROCESS (process)->status = Qrun /* Delay interrupts until we have a chance to store the new fork's pid in its process structure */ #define NO_ECHO "set term/noecho\r" sys$setast (0); /* Send a command to the process to not echo input The CMU PTY driver does not support SETMODEs. */ write_to_vms_process (vs, NO_ECHO, strlen (NO_ECHO)); XSETFASTINT (XPROCESS (process)->pid, pid); sys$setast (1); } child_sig (vs) VMS_PROC_STUFF *vs; { register int pid; Lisp_Object tail, proc; register struct Lisp_Process *p; int old_errno = errno; pid = vs->pid; sys$setef (vs->eventFlag); for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr) { proc = XCONS (XCONS (tail)->car)->cdr; p = XPROCESS (proc); if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid) break; } if (XSYMBOL (tail) == XSYMBOL (Qnil)) return; p->status = Fcons (Qexit, Fcons (make_number (vs->exitStatus), Qnil)) } syms_of_vmsproc () { defsubr (&Scall_process); } init_vmsproc () { char *malloc (); int i; VMS_PROC_STUFF *vs; for (vs=procList, i=0; ibusy = 0; vs->eventFlag = i; sys$clref (i); vs->inputChan = 0; vs->pid = 0; } procList[0].busy = 1; /* Zero is reserved */ } emacs-19.30/src/vmstime.c100444 12241 12 22373 5444474646 14133 0ustar rolandstaff/* Time support for VMS. Copyright (C) 1993 Free Software Foundation. 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. */ #include #include "vmstime.h" long timezone=0; int daylight=0; static char tzname_default[20]=""; static char tzname_dst[20]=""; char *tzname[2] = { tzname_default, tzname_dst }; static long internal_daylight=0; static char daylight_set=0; static long read_time(const char *nptr, const char **endptr, int sign_allowed_p) { int t; *endptr = nptr; /* This routine trusts the user very much, and does no checks! The only exception is this: */ if (!sign_allowed_p && (*nptr == '-' || *nptr == '+')) return 0; t = strtol(*endptr, endptr, 10) * 3600; if (**endptr != ':' || **endptr == '+' || **endptr == '-') return t; (*endptr)++; t = t + strtol(*endptr, endptr, 10) * 60; if (**endptr != ':' || **endptr == '+' || **endptr == '-') return t; (*endptr)++; return t + strtol(*endptr, endptr, 10); } static void read_dst_time(const char *nptr, const char **endptr, int *m, int *n, int *d, int *leap_p) { time_t bintim = time(0); struct tm *lc = localtime(&bintim); *leap_p = 1; *m = 0; /* When m and n are 0, a Julian */ *n = 0; /* date has been inserted in d */ switch(*nptr) { case 'M': { /* This routine counts on the user to have specified "Mm.n.d", where 1 <= n <= 5, 1 <= m <= 12, 0 <= d <= 6 */ *m = strtol(++nptr, endptr, 10); (*endptr)++; /* Skip the dot */ *n = strtol(*endptr, endptr, 10); (*endptr)++; /* Skip the dot */ *d = strtol(*endptr, endptr, 10); return; } case 'J': *leap_p = 0; /* Never count with leap years */ default: /* trust the user to have inserted a number! */ *d = strtol(++nptr, endptr, 10); return; } } struct vms_vectim { short year, month, day, hour, minute, second, centi_second; }; static void find_dst_time(int m, int n, long d, int hour, int minute, int second, int leap_p, long vms_internal_time[2]) { long status = SYS$GETTIM(vms_internal_time); struct vms_vectim vms_vectime; status = SYS$NUMTIM(&vms_vectime, vms_internal_time); if (m == 0 && n == 0) { long tmp_vms_internal_time[2][2]; long day_of_year; long tmp_operation = LIB$K_DAY_OF_YEAR; status = LIB$CVT_FROM_INTERNAL_TIME(&tmp_operation, &day_of_year, vms_internal_time); vms_vectime.month = 2; vms_vectime.day = 29; status = LIB$CVT_VECTIM(&vms_vectime, tmp_vms_internal_time[0]); if (status & 1) /* This is a leap year */ { if (!leap_p && d > 59) d ++; /* If we don't count with 29th Feb, and this is a leap year, count up, to make day 60 really become the 1st March. */ } /* 1st January, at midnight */ vms_vectime.month = 1; vms_vectime.day = 1; vms_vectime.hour = hour; vms_vectime.minute = minute; vms_vectime.second = second; vms_vectime.centi_second = 0; status = LIB$CVT_VECTIM(&vms_vectime, tmp_vms_internal_time[0]); tmp_operation = LIB$K_DELTA_DAYS; status = LIB$CVT_TO_INTERNAL_TIME(&tmp_operation, &d, tmp_vms_internal_time[1]); /* now, tmp_vms_interval_time[0] contains 1st Jan, 00:00:00, and tmp_vms_interval_time[1] contains delta time +d days. Let's just add them together */ status = LIB$ADD_TIMES(tmp_vms_internal_time[0], tmp_vms_internal_time[1], vms_internal_time); } else { long tmp_vms_internal_time[2]; long day_of_week; long tmp_operation = LIB$K_DAY_OF_YEAR; if (d == 0) /* 0 is Sunday, which isn't compatible with VMS, where day_of_week is 1 -- 7, and 1 is Monday */ { d = 7; /* So a simple conversion is required */ } vms_vectime.month = m; vms_vectime.day = 1; vms_vectime.hour = hour; vms_vectime.minute = minute; vms_vectime.second = second; vms_vectime.centi_second = 0; status = LIB$CVT_VECTIM(&vms_vectime, tmp_vms_internal_time); tmp_operation = LIB$K_DAY_OF_WEEK; status = LIB$CVT_FROM_INTERNAL_TIME(&tmp_operation, &day_of_week, tmp_vms_internal_time); d -= day_of_week; if (d < 0) { d += 7; } vms_vectime.day += (n-1)*7 + d; status = LIB$CVT_VECTIM(&vms_vectime, vms_internal_time); if (!(status & 1)) { vms_vectime.day -= 7; /* n was probably 5 */ status = LIB$CVT_VECTIM(&vms_vectime, vms_internal_time); } } } static cmp_vms_internal_times(long vms_internal_time1[2], long vms_internal_time2[2]) { if (vms_internal_time1[1] < vms_internal_time2[1]) return -1; else if (vms_internal_time1[1] > vms_internal_time2[1]) return 1; if (vms_internal_time1[0] < vms_internal_time2[0]) return -1; else if (vms_internal_time1[0] > vms_internal_time2[0]) return 1; return 0; } /* -------------------------- Global routines ------------------------------ */ #ifdef tzset #undef tzset #endif void sys_tzset() { char *TZ; char *p, *q; if (daylight_set) return; daylight = 0; if ((TZ = getenv("TZ")) == 0) return; p = TZ; q = tzname[0]; while(*p != '\0' && (*p <'0' || *p > '9') && *p != '-' && *p != '+' && *p != ',') *q++ = *p++; *q = '\0'; /* This is special for VMS, so I don't care if it doesn't exist anywhere else */ timezone = read_time(p, &p, 1); q = tzname[1]; while(*p != '\0' && (*p <'0' || *p > '9') && *p != '-' && *p != '+' && *p != ',') *q++ = *p++; *q = '\0'; if (*p != '-' && *p != '+' && !(*p >='0' && *p <= '9')) internal_daylight = timezone - 3600; else internal_daylight = read_time(p, &p, 1); if (*p == ',') { int start_m; int start_n; int start_d; int start_leap_p; int start_hour=2, start_minute=0, start_second=0; p++; read_dst_time(p, &p, &start_m, &start_n, &start_d, &start_leap_p); if (*p == '/') { long tmp = read_time (++p, &p, 0); start_hour = tmp / 3600; start_minute = (tmp % 3600) / 60; start_second = tmp % 60; } if (*p == ',') { int end_m; int end_n; int end_d; int end_leap_p; int end_hour=2, end_minute=0, end_second=0; p++; read_dst_time(p, &p, &end_m, &end_n, &end_d, &end_leap_p); if (*p == '/') { long tmp = read_time (++p, &p, 0); end_hour = tmp / 3600; end_minute = (tmp % 3600) / 60; end_second = tmp % 60; } { long vms_internal_time[3][2]; find_dst_time(start_m, start_n, start_d, start_hour, start_minute, start_second, start_leap_p, vms_internal_time[0]); SYS$GETTIM(&vms_internal_time[1]); find_dst_time(end_m, end_n, end_d, end_hour, end_minute, end_second, end_leap_p, vms_internal_time[2]); if (cmp_vms_internal_times(vms_internal_time[0], vms_internal_time[1]) < 0 && cmp_vms_internal_times(vms_internal_time[1], vms_internal_time[2]) < 0) daylight = 1; } } } } #ifdef localtime #undef localtime #endif struct tm *sys_localtime(time_t *clock) { struct tm *tmp = localtime(clock); sys_tzset(); tmp->tm_isdst = daylight; return tmp; } #ifdef gmtime #undef gmtime #endif struct tm *sys_gmtime(time_t *clock) { static struct tm gmt; struct vms_vectim tmp_vectime; long vms_internal_time[3][2]; long tmp_operation = LIB$K_DELTA_SECONDS; long status; long tmp_offset; char tmp_o_sign; sys_tzset(); if (daylight) tmp_offset = internal_daylight; else tmp_offset = timezone; if (tmp_offset < 0) { tmp_o_sign = -1; tmp_offset = -tmp_offset; } else tmp_o_sign = 1; status = LIB$CVT_TO_INTERNAL_TIME(&tmp_operation, &tmp_offset, vms_internal_time[1]); status = SYS$GETTIM(vms_internal_time[0]); if (tmp_o_sign < 0) { status = LIB$SUB_TIMES(vms_internal_time[0], vms_internal_time[1], vms_internal_time[2]); } else { status = LIB$ADD_TIMES(vms_internal_time[0], vms_internal_time[1], vms_internal_time[2]); } status = SYS$NUMTIM(&tmp_vectime, vms_internal_time[2]); gmt.tm_sec = tmp_vectime.second; gmt.tm_min = tmp_vectime.minute; gmt.tm_hour = tmp_vectime.hour; gmt.tm_mday = tmp_vectime.day; gmt.tm_mon = tmp_vectime.month - 1; gmt.tm_year = tmp_vectime.year % 100; tmp_operation = LIB$K_DAY_OF_WEEK; status = LIB$CVT_FROM_INTERNAL_TIME(&tmp_operation, &gmt.tm_wday, vms_internal_time[2]); if (gmt.tm_wday == 7) gmt.tm_wday = 0; tmp_operation = LIB$K_DAY_OF_YEAR; status = LIB$CVT_FROM_INTERNAL_TIME(&tmp_operation, &gmt.tm_yday, vms_internal_time[2]); gmt.tm_yday--; gmt.tm_isdst = daylight; return &gmt; } emacs-19.30/src/w32faces.c100444 23073 1 70517 6047606403 14366 0ustar voelkerdaemon/* "Face" primitives. Copyright (C) 1993, 1994, 1995 Free Software Foundation. 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. */ /* Ported xfaces.c for win32 - Kevin Gallo */ #include #include #include #include "lisp.h" #include "w32term.h" #include "buffer.h" #include "dispextern.h" #include "frame.h" #include "blockinput.h" #include "window.h" #include "intervals.h" /* An explanation of the face data structures. */ /* ========================= Face Data Structures ========================= Let FACE-NAME be a symbol naming a face. Let FACE-VECTOR be (assq FACE-NAME (frame-face-alist FRAME)) FACE-VECTOR is either nil, or a vector of the form [face NAME ID FONT FOREGROUND BACKGROUND BACKGROUND-PIXMAP UNDERLINE-P] where face is the symbol `face', NAME is the symbol with which this vector is associated (a backpointer), ID is the face ID, an integer used internally by the C code to identify the face, FONT, FOREGROUND, and BACKGROUND are strings naming the fonts and colors to use with the face, BACKGROUND-PIXMAP is the name of an x bitmap filename, which we don't use right now, and UNDERLINE-P is non-nil if the face should be underlined. If any of these elements are nil, that parameter is considered unspecified; parameters from faces specified by lower-priority overlays or text properties, or the parameters of the frame itself, can show through. (lisp/faces.el maintains these lists.) (assq FACE-NAME global-face-data) returns a vector describing the global parameters for that face. Let PARAM-FACE be FRAME->display.x->param_faces[Faref (FACE-VECTOR, 2)]. PARAM_FACE is a struct face whose members are the Xlib analogues of the parameters in FACE-VECTOR. If an element of FACE-VECTOR is nil, then the corresponding member of PARAM_FACE is FACE_DEFAULT. These faces are called "parameter faces", because they're the ones lisp manipulates to control what gets displayed. Elements 0 and 1 of FRAME->display.x->param_faces are special - they describe the default and mode line faces. None of the faces in param_faces have GC's. (See src/dispextern.h for the definiton of struct face. lisp/faces.el maintains the isomorphism between face_alist and param_faces.) The functions compute_char_face and compute_glyph_face find and combine the parameter faces associated with overlays and text properties. The resulting faces are called "computed faces"; none of their members are FACE_DEFAULT; they are completely specified. They then call intern_compute_face to search FRAME->display.x->computed_faces for a matching face, add one if none is found, and return the index into FRAME->display.x->computed_faces. FRAME's glyph matrices use these indices to record the faces of the matrix characters, and the X display hooks consult compute_faces to decide how to display these characters. Elements 0 and 1 of computed_faces always describe the default and mode-line faces. Each computed face belongs to a particular frame. Computed faces have graphics contexts some of the time. intern_face builds a GC for a specified computed face if it doesn't have one already. clear_face_cache clears out the GCs of all computed faces. This is done from time to time so that we don't hold on to lots of GCs that are no longer needed. Constraints: Symbols naming faces must have associations on all frames; for any FRAME, for all FACE-NAME, if (assq FACE-NAME (frame-face-alist FRAME)) is non-nil, it must be non-nil for all frames. Analogously, indices into param_faces must be valid on all frames; if param_faces[i] is a non-zero face pointer on one frame, then it must be filled in on all frames. Code assumes that face ID's can be used on any frame. Some subtleties: Why do we keep param_faces and computed_faces separate? computed_faces contains an element for every combination of facial parameters we have ever displayed. indices into param_faces have to be valid on all frames. If they were the same array, then that array would grow very large on all frames, because any facial combination displayed on any frame would need to be a valid entry on all frames. */ /* Definitions and declarations. */ /* The number of face-id's in use (same for all frames). */ static int next_face_id; /* The number of the face to use to indicate the region. */ static int region_face; /* This is what appears in a slot in a face to signify that the face does not specify that display aspect. */ #define FACE_DEFAULT (~0) Lisp_Object Qface, Qmouse_face; Lisp_Object Qpixmap_spec_p; int face_name_id_number ( /* FRAME_PTR, Lisp_Object name */ ); struct face *intern_face ( /* FRAME_PTR, struct face * */ ); static int new_computed_face ( /* FRAME_PTR, struct face * */ ); static int intern_computed_face ( /* FRAME_PTR, struct face * */ ); static void ensure_face_ready ( /* FRAME_PTR, int id */ ); void recompute_basic_faces ( /* FRAME_PTR f */ ); /* Allocating, copying, and comparing struct faces. */ /* Allocate a new face */ static struct face * allocate_face () { struct face *result = (struct face *) xmalloc (sizeof (struct face)); bzero (result, sizeof (struct face)); result->font = (XFontStruct *) FACE_DEFAULT; result->foreground = FACE_DEFAULT; result->background = FACE_DEFAULT; result->stipple = FACE_DEFAULT; return result; } /* Make a new face that's a copy of an existing one. */ static struct face * copy_face (face) struct face *face; { struct face *result = allocate_face (); result->font = face->font; result->foreground = face->foreground; result->background = face->background; result->stipple = face->stipple; result->underline = face->underline; result->pixmap_h = face->pixmap_h; result->pixmap_w = face->pixmap_w; return result; } static int face_eql (face1, face2) struct face *face1, *face2; { return ( face1->font == face2->font && face1->foreground == face2->foreground && face1->background == face2->background && face1->stipple == face2->stipple && face1->underline == face2->underline); } /* Managing graphics contexts of faces. */ /* Given a computed face, construct its graphics context if necessary. */ struct face * intern_face (f, face) struct frame *f; struct face *face; { face->gc = NULL; return face; } /* Clear out all graphics contexts for all computed faces except for the default and mode line faces. This should be done from time to time just to avoid keeping too many graphics contexts that are no longer needed. */ void clear_face_cache () { /* Nothing extra */ } /* Allocating, freeing, and duplicating fonts, colors, and pixmaps. These functions operate on param faces only. Computed faces get their fonts, colors and pixmaps by merging param faces. */ static XFontStruct * load_font (f, name) struct frame *f; Lisp_Object name; { XFontStruct *font; if (NILP (name)) return (XFontStruct *) FACE_DEFAULT; CHECK_STRING (name, 0); BLOCK_INPUT; font = win32_load_font (FRAME_WIN32_DISPLAY_INFO (f), (char *) XSTRING (name)->data); UNBLOCK_INPUT; if (! font) Fsignal (Qerror, Fcons (build_string ("undefined font"), Fcons (name, Qnil))); return font; } static void unload_font (f, font) struct frame *f; XFontStruct *font; { if (!font || font == ((XFontStruct *) FACE_DEFAULT)) return; BLOCK_INPUT; win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f), font); UNBLOCK_INPUT; } static unsigned long load_color (f, name) struct frame *f; Lisp_Object name; { COLORREF color; int result; if (NILP (name)) return FACE_DEFAULT; CHECK_STRING (name, 0); /* if the colormap is full, defined_color will return a best match to the values in an an existing cell. */ result = defined_color(f, (char *) XSTRING (name)->data, &color, 1); if (! result) Fsignal (Qerror, Fcons (build_string ("undefined color"), Fcons (name, Qnil))); return (unsigned long) color; } static void unload_color (f, pixel) struct frame *f; unsigned long pixel; { } DEFUN ("pixmap-spec-p", Fpixmap_spec_p, Spixmap_spec_p, 1, 1, 0, "Return t if ARG is a valid pixmap specification.") (arg) Lisp_Object arg; { Lisp_Object height, width; return ((STRINGP (arg) || (CONSP (arg) && CONSP (XCONS (arg)->cdr) && CONSP (XCONS (XCONS (arg)->cdr)->cdr) && NILP (XCONS (XCONS (XCONS (arg)->cdr)->cdr)->cdr) && (width = XCONS (arg)->car, INTEGERP (width)) && (height = XCONS (XCONS (arg)->cdr)->car, INTEGERP (height)) && STRINGP (XCONS (XCONS (XCONS (arg)->cdr)->cdr)->car) && XINT (width) > 0 && XINT (height) > 0 /* The string must have enough bits for width * height. */ && ((XSTRING (XCONS (XCONS (XCONS (arg)->cdr)->cdr)->car)->size * (BITS_PER_INT / sizeof (int))) >= XFASTINT (width) * XFASTINT (height)))) ? Qt : Qnil); } /* Load a bitmap according to NAME (which is either a file name or a pixmap spec). Return the bitmap_id (see xfns.c) or get an error if NAME is invalid. Store the bitmap width in *W_PTR and height in *H_PTR. */ static long load_pixmap (f, name, w_ptr, h_ptr) FRAME_PTR f; Lisp_Object name; unsigned int *w_ptr, *h_ptr; { int bitmap_id; Lisp_Object tem; if (NILP (name)) return FACE_DEFAULT; tem = Fpixmap_spec_p (name); if (NILP (tem)) wrong_type_argument (Qpixmap_spec_p, name); BLOCK_INPUT; if (CONSP (name)) { /* Decode a bitmap spec into a bitmap. */ int h, w; Lisp_Object bits; w = XINT (Fcar (name)); h = XINT (Fcar (Fcdr (name))); bits = Fcar (Fcdr (Fcdr (name))); bitmap_id = x_create_bitmap_from_data (f, XSTRING (bits)->data, w, h); } else { /* It must be a string -- a file name. */ bitmap_id = x_create_bitmap_from_file (f, name); } UNBLOCK_INPUT; if (bitmap_id < 0) Fsignal (Qerror, Fcons (build_string ("invalid or undefined bitmap"), Fcons (name, Qnil))); *w_ptr = x_bitmap_width (f, bitmap_id); *h_ptr = x_bitmap_height (f, bitmap_id); return bitmap_id; } /* Managing parameter face arrays for frames. */ void init_frame_faces (f) FRAME_PTR f; { ensure_face_ready (f, 0); ensure_face_ready (f, 1); FRAME_N_COMPUTED_FACES (f) = 0; FRAME_SIZE_COMPUTED_FACES (f) = 0; new_computed_face (f, FRAME_PARAM_FACES (f)[0]); new_computed_face (f, FRAME_PARAM_FACES (f)[1]); recompute_basic_faces (f); #ifdef MULTI_FRAME /* Find another frame. */ { Lisp_Object tail, frame, result; result = Qnil; FOR_EACH_FRAME (tail, frame) if (FRAME_WIN32_P (XFRAME (frame)) && XFRAME (frame) != f) { result = frame; break; } /* If we didn't find any X frames other than f, then we don't need any faces other than 0 and 1, so we're okay. Otherwise, make sure that all faces valid on the selected frame are also valid on this new frame. */ if (FRAMEP (result)) { int i; int n_faces = FRAME_N_PARAM_FACES (XFRAME (result)); struct face **faces = FRAME_PARAM_FACES (XFRAME (result)); for (i = 2; i < n_faces; i++) if (faces[i]) ensure_face_ready (f, i); } } #endif /* MULTI_FRAME */ } /* Called from Fdelete_frame. */ void free_frame_faces (f) struct frame *f; { int i; BLOCK_INPUT; for (i = 0; i < FRAME_N_PARAM_FACES (f); i++) { struct face *face = FRAME_PARAM_FACES (f) [i]; if (face) { unload_font (f, face->font); unload_color (f, face->foreground); unload_color (f, face->background); x_destroy_bitmap (f, face->stipple); xfree (face); } } xfree (FRAME_PARAM_FACES (f)); FRAME_PARAM_FACES (f) = 0; FRAME_N_PARAM_FACES (f) = 0; /* All faces in FRAME_COMPUTED_FACES use resources copied from FRAME_PARAM_FACES; we can free them without fuss. But we do free the GCs and the face objects themselves. */ for (i = 0; i < FRAME_N_COMPUTED_FACES (f); i++) { struct face *face = FRAME_COMPUTED_FACES (f) [i]; if (face) { xfree (face); } } xfree (FRAME_COMPUTED_FACES (f)); FRAME_COMPUTED_FACES (f) = 0; FRAME_N_COMPUTED_FACES (f) = 0; UNBLOCK_INPUT; } /* Interning faces in a frame's face array. */ static int new_computed_face (f, new_face) struct frame *f; struct face *new_face; { int i = FRAME_N_COMPUTED_FACES (f); if (i >= FRAME_SIZE_COMPUTED_FACES (f)) { int new_size = i + 32; FRAME_COMPUTED_FACES (f) = (struct face **) (FRAME_SIZE_COMPUTED_FACES (f) == 0 ? xmalloc (new_size * sizeof (struct face *)) : xrealloc (FRAME_COMPUTED_FACES (f), new_size * sizeof (struct face *))); FRAME_SIZE_COMPUTED_FACES (f) = new_size; } i = FRAME_N_COMPUTED_FACES (f)++; FRAME_COMPUTED_FACES (f)[i] = copy_face (new_face); return i; } /* Find a match for NEW_FACE in a FRAME's computed face array, and add it if we don't find one. */ static int intern_computed_face (f, new_face) struct frame *f; struct face *new_face; { int len = FRAME_N_COMPUTED_FACES (f); int i; /* Search for a computed face already on F equivalent to FACE. */ for (i = 0; i < len; i++) { if (! FRAME_COMPUTED_FACES (f)[i]) abort (); if (face_eql (new_face, FRAME_COMPUTED_FACES (f)[i])) return i; } /* We didn't find one; add a new one. */ return new_computed_face (f, new_face); } /* Make parameter face id ID valid on frame F. */ static void ensure_face_ready (f, id) struct frame *f; int id; { if (FRAME_N_PARAM_FACES (f) <= id) { int n = id + 10; int i; if (!FRAME_N_PARAM_FACES (f)) FRAME_PARAM_FACES (f) = (struct face **) xmalloc (sizeof (struct face *) * n); else FRAME_PARAM_FACES (f) = (struct face **) xrealloc (FRAME_PARAM_FACES (f), sizeof (struct face *) * n); bzero (FRAME_PARAM_FACES (f) + FRAME_N_PARAM_FACES (f), (n - FRAME_N_PARAM_FACES (f)) * sizeof (struct face *)); FRAME_N_PARAM_FACES (f) = n; } if (FRAME_PARAM_FACES (f) [id] == 0) FRAME_PARAM_FACES (f) [id] = allocate_face (); } /* Return non-zero if FONT1 and FONT2 have the same width. We do not check the height, because we can now deal with different heights. We assume that they're both character-cell fonts. */ int same_size_fonts (font1, font2) XFontStruct *font1, *font2; { return (FONT_WIDTH(font1) == FONT_WIDTH(font2)); } /* Update the line_height of frame F according to the biggest font in any face. Return nonzero if if line_height changes. */ int frame_update_line_height (f) FRAME_PTR f; { int i; int biggest = FONT_HEIGHT (f->output_data.win32->font); for (i = 0; i < f->output_data.win32->n_param_faces; i++) if (f->output_data.win32->param_faces[i] != 0 && f->output_data.win32->param_faces[i]->font != (XFontStruct *) FACE_DEFAULT) { int height = FONT_HEIGHT (f->output_data.win32->param_faces[i]->font); if (height > biggest) biggest = height; } if (biggest == f->output_data.win32->line_height) return 0; f->output_data.win32->line_height = biggest; return 1; } /* Modify face TO by copying from FROM all properties which have nondefault settings. */ static void merge_faces (from, to) struct face *from, *to; { /* Only merge the font if it's the same width as the base font. Otherwise ignore it, since we can't handle it properly. */ if (from->font != (XFontStruct *) FACE_DEFAULT && same_size_fonts (from->font, to->font)) to->font = from->font; if (from->foreground != FACE_DEFAULT) to->foreground = from->foreground; if (from->background != FACE_DEFAULT) to->background = from->background; if (from->stipple != FACE_DEFAULT) { to->stipple = from->stipple; to->pixmap_h = from->pixmap_h; to->pixmap_w = from->pixmap_w; } if (from->underline) to->underline = from->underline; } /* Set up the basic set of facial parameters, based on the frame's data; all faces are deltas applied to this. */ static void compute_base_face (f, face) FRAME_PTR f; struct face *face; { face->gc = 0; face->foreground = FRAME_FOREGROUND_PIXEL (f); face->background = FRAME_BACKGROUND_PIXEL (f); face->font = FRAME_FONT (f); face->stipple = 0; face->underline = 0; } /* Return the face ID to use to display a special glyph which selects FACE_CODE as the face ID, assuming that ordinarily the face would be CURRENT_FACE. F is the frame. */ int compute_glyph_face (f, face_code, current_face) struct frame *f; int face_code, current_face; { struct face face; face = *FRAME_COMPUTED_FACES (f)[current_face]; if (face_code >= 0 && face_code < FRAME_N_PARAM_FACES (f) && FRAME_PARAM_FACES (f) [face_code] != 0) merge_faces (FRAME_PARAM_FACES (f) [face_code], &face); return intern_computed_face (f, &face); } /* Return the face ID to use to display a special glyph which selects FACE_CODE as the face ID, assuming that ordinarily the face would be CURRENT_FACE. F is the frame. */ int compute_glyph_face_1 (f, face_name, current_face) struct frame *f; Lisp_Object face_name; int current_face; { struct face face; face = *FRAME_COMPUTED_FACES (f)[current_face]; if (!NILP (face_name)) { int facecode = face_name_id_number (f, face_name); if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f) && FRAME_PARAM_FACES (f) [facecode] != 0) merge_faces (FRAME_PARAM_FACES (f) [facecode], &face); } return intern_computed_face (f, &face); } /* Return the face ID associated with a buffer position POS. Store into *ENDPTR the position at which a different face is needed. This does not take account of glyphs that specify their own face codes. F is the frame in use for display, and W is a window displaying the current buffer. REGION_BEG, REGION_END delimit the region, so it can be highlighted. LIMIT is a position not to scan beyond. That is to limit the time this function can take. If MOUSE is nonzero, use the character's mouse-face, not its face. */ int compute_char_face (f, w, pos, region_beg, region_end, endptr, limit, mouse) struct frame *f; struct window *w; int pos; int region_beg, region_end; int *endptr; int limit; int mouse; { struct face face; Lisp_Object prop, position; int i, j, noverlays; int facecode; Lisp_Object *overlay_vec; Lisp_Object frame; int endpos; Lisp_Object propname; /* W must display the current buffer. We could write this function to use the frame and buffer of W, but right now it doesn't. */ if (XBUFFER (w->buffer) != current_buffer) abort (); XSETFRAME (frame, f); endpos = ZV; if (pos < region_beg && region_beg < endpos) endpos = region_beg; XSETFASTINT (position, pos); if (mouse) propname = Qmouse_face; else propname = Qface; prop = Fget_text_property (position, propname, w->buffer); { Lisp_Object limit1, end; XSETFASTINT (limit1, (limit < endpos ? limit : endpos)); end = Fnext_single_property_change (position, propname, w->buffer, limit1); if (INTEGERP (end)) endpos = XINT (end); } { int next_overlay; int len; /* First try with room for 40 overlays. */ len = 40; overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); noverlays = overlays_at (pos, 0, &overlay_vec, &len, &next_overlay, (int *) 0); /* If there are more than 40, make enough space for all, and try again. */ if (noverlays > len) { len = noverlays; overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); noverlays = overlays_at (pos, 0, &overlay_vec, &len, &next_overlay, (int *) 0); } if (next_overlay < endpos) endpos = next_overlay; } *endptr = endpos; /* Optimize the default case. */ if (noverlays == 0 && NILP (prop) && !(pos >= region_beg && pos < region_end)) return 0; compute_base_face (f, &face); if (CONSP (prop)) { /* We have a list of faces, merge them in reverse order */ Lisp_Object length = Flength (prop); int len = XINT (length); Lisp_Object *faces; /* Put them into an array */ faces = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); for (j = 0; j < len; j++) { faces[j] = Fcar (prop); prop = Fcdr (prop); } /* So that we can merge them in the reverse order */ for (j = len - 1; j >= 0; j--) { facecode = face_name_id_number (f, faces[j]); if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f) && FRAME_PARAM_FACES (f) [facecode] != 0) merge_faces (FRAME_PARAM_FACES (f) [facecode], &face); } } else if (!NILP (prop)) { facecode = face_name_id_number (f, prop); if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f) && FRAME_PARAM_FACES (f) [facecode] != 0) merge_faces (FRAME_PARAM_FACES (f) [facecode], &face); } noverlays = sort_overlays (overlay_vec, noverlays, w); /* Now merge the overlay data in that order. */ for (i = 0; i < noverlays; i++) { prop = Foverlay_get (overlay_vec[i], propname); if (CONSP (prop)) { /* We have a list of faces, merge them in reverse order */ Lisp_Object length = Flength (prop); int len = XINT (length); Lisp_Object *faces; int i; /* Put them into an array */ faces = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); for (j = 0; j < len; j++) { faces[j] = Fcar (prop); prop = Fcdr (prop); } /* So that we can merge them in the reverse order */ for (j = len - 1; j >= 0; j--) { facecode = face_name_id_number (f, faces[j]); if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f) && FRAME_PARAM_FACES (f) [facecode] != 0) merge_faces (FRAME_PARAM_FACES (f) [facecode], &face); } } else if (!NILP (prop)) { Lisp_Object oend; int oendpos; facecode = face_name_id_number (f, prop); if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f) && FRAME_PARAM_FACES (f) [facecode] != 0) merge_faces (FRAME_PARAM_FACES (f)[facecode], &face); oend = OVERLAY_END (overlay_vec[i]); oendpos = OVERLAY_POSITION (oend); if (oendpos < endpos) endpos = oendpos; } } if (pos >= region_beg && pos < region_end) { if (region_end < endpos) endpos = region_end; if (region_face >= 0 && region_face < next_face_id) merge_faces (FRAME_PARAM_FACES (f)[region_face], &face); } *endptr = endpos; return intern_computed_face (f, &face); } /* Recompute the GC's for the default and modeline faces. We call this after changing frame parameters on which those GC's depend. */ void recompute_basic_faces (f) FRAME_PTR f; { /* If the frame's faces haven't been initialized yet, don't worry about this stuff. */ if (FRAME_N_PARAM_FACES (f) < 2) return; BLOCK_INPUT; compute_base_face (f, FRAME_DEFAULT_FACE (f)); compute_base_face (f, FRAME_MODE_LINE_FACE (f)); merge_faces (FRAME_DEFAULT_PARAM_FACE (f), FRAME_DEFAULT_FACE (f)); merge_faces (FRAME_MODE_LINE_PARAM_FACE (f), FRAME_MODE_LINE_FACE (f)); intern_face (f, FRAME_DEFAULT_FACE (f)); intern_face (f, FRAME_MODE_LINE_FACE (f)); UNBLOCK_INPUT; } /* Lisp interface. */ DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist, 1, 1, 0, "") (frame) Lisp_Object frame; { CHECK_FRAME (frame, 0); return XFRAME (frame)->face_alist; } DEFUN ("set-frame-face-alist", Fset_frame_face_alist, Sset_frame_face_alist, 2, 2, 0, "") (frame, value) Lisp_Object frame, value; { CHECK_FRAME (frame, 0); XFRAME (frame)->face_alist = value; return value; } DEFUN ("make-face-internal", Fmake_face_internal, Smake_face_internal, 1, 1, 0, "Create face number FACE-ID on all frames.") (face_id) Lisp_Object face_id; { Lisp_Object rest, frame; int id = XINT (face_id); CHECK_NUMBER (face_id, 0); if (id < 0 || id >= next_face_id) error ("Face id out of range"); FOR_EACH_FRAME (rest, frame) { if (FRAME_WIN32_P (XFRAME (frame))) ensure_face_ready (XFRAME (frame), id); } return Qnil; } DEFUN ("set-face-attribute-internal", Fset_face_attribute_internal, Sset_face_attribute_internal, 4, 4, 0, "") (face_id, attr_name, attr_value, frame) Lisp_Object face_id, attr_name, attr_value, frame; { struct face *face; struct frame *f; int magic_p; int id; int garbaged = 0; CHECK_FRAME (frame, 0); CHECK_NUMBER (face_id, 0); CHECK_SYMBOL (attr_name, 0); f = XFRAME (frame); id = XINT (face_id); if (id < 0 || id >= next_face_id) error ("Face id out of range"); if (! FRAME_WIN32_P (f)) return Qnil; ensure_face_ready (f, id); face = FRAME_PARAM_FACES (f) [XFASTINT (face_id)]; if (EQ (attr_name, intern ("font"))) { XFontStruct *font = load_font (f, attr_value); if (face->font != f->output_data.win32->font) unload_font (f, face->font); face->font = font; if (frame_update_line_height (f)) x_set_window_size (f, 0, f->width, f->height); /* Must clear cache, since it might contain the font we just got rid of. */ garbaged = 1; } else if (EQ (attr_name, intern ("foreground"))) { unsigned long new_color = load_color (f, attr_value); unload_color (f, face->foreground); face->foreground = new_color; garbaged = 1; } else if (EQ (attr_name, intern ("background"))) { unsigned long new_color = load_color (f, attr_value); unload_color (f, face->background); face->background = new_color; garbaged = 1; } else if (EQ (attr_name, intern ("background-pixmap"))) { unsigned int w, h; unsigned long new_pixmap = load_pixmap (f, attr_value, &w, &h); x_destroy_bitmap (f, face->stipple); face->stipple = (Pixmap) new_pixmap; face->pixmap_w = w; face->pixmap_h = h; garbaged = 1; } else if (EQ (attr_name, intern ("underline"))) { int new = !NILP (attr_value); face->underline = new; } else error ("unknown face attribute"); if (id == 0 || id == 1) recompute_basic_faces (f); /* We must redraw the frame whenever any face font or color changes, because it's possible that a merged (display) face contains the font or color we just replaced. And we must inhibit any Expose events until the redraw is done, since they would try to use the invalid display faces. */ if (garbaged) SET_FRAME_GARBAGED (f); return Qnil; } DEFUN ("internal-next-face-id", Finternal_next_face_id, Sinternal_next_face_id, 0, 0, 0, "") () { return make_number (next_face_id++); } /* Return the face id for name NAME on frame FRAME. (It should be the same for all frames, but it's as easy to use the "right" frame to look it up as to use any other one.) */ int face_name_id_number (f, name) FRAME_PTR f; Lisp_Object name; { Lisp_Object tem; tem = Fcdr (assq_no_quit (name, f->face_alist)); if (NILP (tem)) return 0; CHECK_VECTOR (tem, 0); tem = XVECTOR (tem)->contents[2]; CHECK_NUMBER (tem, 0); return XINT (tem); } /* Emacs initialization. */ void syms_of_win32faces () { Qface = intern ("face"); staticpro (&Qface); Qmouse_face = intern ("mouse-face"); staticpro (&Qmouse_face); Qpixmap_spec_p = intern ("pixmap-spec-p"); staticpro (&Qpixmap_spec_p); DEFVAR_INT ("region-face", ®ion_face, "Face number to use to highlight the region\n\ The region is highlighted with this face\n\ when Transient Mark mode is enabled and the mark is active."); defsubr (&Spixmap_spec_p); defsubr (&Sframe_face_alist); defsubr (&Sset_frame_face_alist); defsubr (&Smake_face_internal); defsubr (&Sset_face_attribute_internal); defsubr (&Sinternal_next_face_id); } emacs-19.30/src/w32fns.c100444 23073 1 360443 6047606404 14114 0ustar voelkerdaemon/* Functions for the Win32 window system. Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation. 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. */ /* Added by Kevin Gallo */ #include #include #include #include "lisp.h" #include "w32term.h" #include "frame.h" #include "window.h" #include "buffer.h" #include "dispextern.h" #include "keyboard.h" #include "blockinput.h" #include "paths.h" #include "ntheap.h" #include "termhooks.h" #include extern void abort (); extern void free_frame_menubar (); extern struct scroll_bar *x_window_to_scroll_bar (); /* The colormap for converting color names to RGB values */ Lisp_Object Vwin32_color_map; /* The name we're using in resource queries. */ Lisp_Object Vx_resource_name; /* Non nil if no window manager is in use. */ Lisp_Object Vx_no_window_manager; /* The background and shape of the mouse pointer, and shape when not over text or in the modeline. */ Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape; /* The shape when over mouse-sensitive text. */ Lisp_Object Vx_sensitive_text_pointer_shape; /* Color of chars displayed in cursor box. */ Lisp_Object Vx_cursor_fore_pixel; /* Search path for bitmap files. */ Lisp_Object Vx_bitmap_file_path; /* Evaluate this expression to rebuild the section of syms_of_w32fns that initializes and staticpros the symbols declared below. Note that Emacs 18 has a bug that keeps C-x C-e from being able to evaluate this expression. (progn ;; Accumulate a list of the symbols we want to initialize from the ;; declarations at the top of the file. (goto-char (point-min)) (search-forward "/\*&&& symbols declared here &&&*\/\n") (let (symbol-list) (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)") (setq symbol-list (cons (buffer-substring (match-beginning 1) (match-end 1)) symbol-list)) (forward-line 1)) (setq symbol-list (nreverse symbol-list)) ;; Delete the section of syms_of_... where we initialize the symbols. (search-forward "\n /\*&&& init symbols here &&&*\/\n") (let ((start (point))) (while (looking-at "^ Q") (forward-line 2)) (kill-region start (point))) ;; Write a new symbol initialization section. (while symbol-list (insert (format " %s = intern (\"" (car symbol-list))) (let ((start (point))) (insert (substring (car symbol-list) 1)) (subst-char-in-region start (point) ?_ ?-)) (insert (format "\");\n staticpro (&%s);\n" (car symbol-list))) (setq symbol-list (cdr symbol-list))))) */ /*&&& symbols declared here &&&*/ Lisp_Object Qauto_raise; Lisp_Object Qauto_lower; Lisp_Object Qbackground_color; Lisp_Object Qbar; Lisp_Object Qborder_color; Lisp_Object Qborder_width; Lisp_Object Qbox; Lisp_Object Qcursor_color; Lisp_Object Qcursor_type; Lisp_Object Qfont; Lisp_Object Qforeground_color; Lisp_Object Qgeometry; Lisp_Object Qicon_left; Lisp_Object Qicon_top; Lisp_Object Qicon_type; Lisp_Object Qicon_name; Lisp_Object Qinternal_border_width; Lisp_Object Qleft; Lisp_Object Qmouse_color; Lisp_Object Qnone; Lisp_Object Qparent_id; Lisp_Object Qscroll_bar_width; Lisp_Object Qsuppress_icon; Lisp_Object Qtop; Lisp_Object Qundefined_color; Lisp_Object Qvertical_scroll_bars; Lisp_Object Qvisibility; Lisp_Object Qwindow_id; Lisp_Object Qx_frame_parameter; Lisp_Object Qx_resource_name; Lisp_Object Quser_position; Lisp_Object Quser_size; Lisp_Object Qdisplay; /* The below are defined in frame.c. */ extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth; extern Lisp_Object Qunsplittable, Qmenu_bar_lines; extern Lisp_Object Vwindow_system_version; extern Lisp_Object last_mouse_scroll_bar; extern int last_mouse_scroll_bar_pos; Time last_mouse_movement_time; /* Extract a frame as a FRAME_PTR, defaulting to the selected frame and checking validity for Win32. */ FRAME_PTR check_x_frame (frame) Lisp_Object frame; { FRAME_PTR f; if (NILP (frame)) f = selected_frame; else { CHECK_LIVE_FRAME (frame, 0); f = XFRAME (frame); } if (! FRAME_WIN32_P (f)) error ("non-win32 frame used"); return f; } /* Let the user specify an display with a frame. nil stands for the selected frame--or, if that is not a win32 frame, the first display on the list. */ static struct win32_display_info * check_x_display_info (frame) Lisp_Object frame; { if (NILP (frame)) { if (FRAME_WIN32_P (selected_frame)) return FRAME_WIN32_DISPLAY_INFO (selected_frame); else return &one_win32_display_info; } else if (STRINGP (frame)) return x_display_info_for_name (frame); else { FRAME_PTR f; CHECK_LIVE_FRAME (frame, 0); f = XFRAME (frame); if (! FRAME_WIN32_P (f)) error ("non-win32 frame used"); return FRAME_WIN32_DISPLAY_INFO (f); } } /* Return the Emacs frame-object corresponding to an win32 window. It could be the frame's main window or an icon window. */ /* This function can be called during GC, so use GC_xxx type test macros. */ struct frame * x_window_to_frame (dpyinfo, wdesc) struct win32_display_info *dpyinfo; HWND wdesc; { Lisp_Object tail, frame; struct frame *f; for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr) { frame = XCONS (tail)->car; if (!GC_FRAMEP (frame)) continue; f = XFRAME (frame); if (f->output_data.nothing == 1 || FRAME_WIN32_DISPLAY_INFO (f) != dpyinfo) continue; if (FRAME_WIN32_WINDOW (f) == wdesc) return f; } return 0; } /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap id, which is just an int that this section returns. Bitmaps are reference counted so they can be shared among frames. Bitmap indices are guaranteed to be > 0, so a negative number can be used to indicate no bitmap. If you use x_create_bitmap_from_data, then you must keep track of the bitmaps yourself. That is, creating a bitmap from the same data more than once will not be caught. */ /* Functions to access the contents of a bitmap, given an id. */ int x_bitmap_height (f, id) FRAME_PTR f; int id; { return FRAME_WIN32_DISPLAY_INFO (f)->bitmaps[id - 1].height; } int x_bitmap_width (f, id) FRAME_PTR f; int id; { return FRAME_WIN32_DISPLAY_INFO (f)->bitmaps[id - 1].width; } int x_bitmap_pixmap (f, id) FRAME_PTR f; int id; { return (int) FRAME_WIN32_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap; } /* Allocate a new bitmap record. Returns index of new record. */ static int x_allocate_bitmap_record (f) FRAME_PTR f; { struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (f); int i; if (dpyinfo->bitmaps == NULL) { dpyinfo->bitmaps_size = 10; dpyinfo->bitmaps = (struct win32_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct win32_bitmap_record)); dpyinfo->bitmaps_last = 1; return 1; } if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size) return ++dpyinfo->bitmaps_last; for (i = 0; i < dpyinfo->bitmaps_size; ++i) if (dpyinfo->bitmaps[i].refcount == 0) return i + 1; dpyinfo->bitmaps_size *= 2; dpyinfo->bitmaps = (struct win32_bitmap_record *) xrealloc (dpyinfo->bitmaps, dpyinfo->bitmaps_size * sizeof (struct win32_bitmap_record)); return ++dpyinfo->bitmaps_last; } /* Add one reference to the reference count of the bitmap with id ID. */ void x_reference_bitmap (f, id) FRAME_PTR f; int id; { ++FRAME_WIN32_DISPLAY_INFO (f)->bitmaps[id - 1].refcount; } /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */ int x_create_bitmap_from_data (f, bits, width, height) struct frame *f; char *bits; unsigned int width, height; { struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (f); Pixmap bitmap; int id; bitmap = CreateBitmap (width, height, FRAME_WIN32_DISPLAY_INFO (XFRAME (frame))->n_planes, FRAME_WIN32_DISPLAY_INFO (XFRAME (frame))->n_cbits, bits); if (! bitmap) return -1; id = x_allocate_bitmap_record (f); dpyinfo->bitmaps[id - 1].pixmap = bitmap; dpyinfo->bitmaps[id - 1].file = NULL; dpyinfo->bitmaps[id - 1].hinst = NULL; dpyinfo->bitmaps[id - 1].refcount = 1; dpyinfo->bitmaps[id - 1].depth = 1; dpyinfo->bitmaps[id - 1].height = height; dpyinfo->bitmaps[id - 1].width = width; return id; } /* Create bitmap from file FILE for frame F. */ int x_create_bitmap_from_file (f, file) struct frame *f; Lisp_Object file; { return -1; #if 0 struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (f); unsigned int width, height; Pixmap bitmap; int xhot, yhot, result, id; Lisp_Object found; int fd; char *filename; HINSTANCE hinst; /* Look for an existing bitmap with the same name. */ for (id = 0; id < dpyinfo->bitmaps_last; ++id) { if (dpyinfo->bitmaps[id].refcount && dpyinfo->bitmaps[id].file && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data)) { ++dpyinfo->bitmaps[id].refcount; return id + 1; } } /* Search bitmap-file-path for the file, if appropriate. */ fd = openp (Vx_bitmap_file_path, file, "", &found, 0); if (fd < 0) return -1; close (fd); filename = (char *) XSTRING (found)->data; hinst = LoadLibraryEx (filename, NULL, LOAD_LIBRARY_AS_DATAFILE); if (hinst == NULL) return -1; result = XReadBitmapFile (FRAME_WIN32_DISPLAY (f), FRAME_WIN32_WINDOW (f), filename, &width, &height, &bitmap, &xhot, &yhot); if (result != BitmapSuccess) return -1; id = x_allocate_bitmap_record (f); dpyinfo->bitmaps[id - 1].pixmap = bitmap; dpyinfo->bitmaps[id - 1].refcount = 1; dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1); dpyinfo->bitmaps[id - 1].depth = 1; dpyinfo->bitmaps[id - 1].height = height; dpyinfo->bitmaps[id - 1].width = width; strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data); return id; #endif } /* Remove reference to bitmap with id number ID. */ int x_destroy_bitmap (f, id) FRAME_PTR f; int id; { struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (f); if (id > 0) { --dpyinfo->bitmaps[id - 1].refcount; if (dpyinfo->bitmaps[id - 1].refcount == 0) { BLOCK_INPUT; DeleteObject (dpyinfo->bitmaps[id - 1].pixmap); if (dpyinfo->bitmaps[id - 1].file) { free (dpyinfo->bitmaps[id - 1].file); dpyinfo->bitmaps[id - 1].file = NULL; } UNBLOCK_INPUT; } } } /* Free all the bitmaps for the display specified by DPYINFO. */ static void x_destroy_all_bitmaps (dpyinfo) struct win32_display_info *dpyinfo; { int i; for (i = 0; i < dpyinfo->bitmaps_last; i++) if (dpyinfo->bitmaps[i].refcount > 0) { DeleteObject (dpyinfo->bitmaps[i].pixmap); if (dpyinfo->bitmaps[i].file) free (dpyinfo->bitmaps[i].file); } dpyinfo->bitmaps_last = 0; } /* Connect the frame-parameter names for Win32 frames to the ways of passing the parameter values to the window system. The name of a parameter, as a Lisp symbol, has an `x-frame-parameter' property which is an integer in Lisp but can be interpreted as an `enum x_frame_parm' in C. */ enum x_frame_parm { X_PARM_FOREGROUND_COLOR, X_PARM_BACKGROUND_COLOR, X_PARM_MOUSE_COLOR, X_PARM_CURSOR_COLOR, X_PARM_BORDER_COLOR, X_PARM_ICON_TYPE, X_PARM_FONT, X_PARM_BORDER_WIDTH, X_PARM_INTERNAL_BORDER_WIDTH, X_PARM_NAME, X_PARM_AUTORAISE, X_PARM_AUTOLOWER, X_PARM_VERT_SCROLL_BAR, X_PARM_VISIBILITY, X_PARM_MENU_BAR_LINES }; struct x_frame_parm_table { char *name; void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ ); }; void x_set_foreground_color (); void x_set_background_color (); void x_set_mouse_color (); void x_set_cursor_color (); void x_set_border_color (); void x_set_cursor_type (); void x_set_icon_type (); void x_set_icon_name (); void x_set_font (); void x_set_border_width (); void x_set_internal_border_width (); void x_explicitly_set_name (); void x_set_autoraise (); void x_set_autolower (); void x_set_vertical_scroll_bars (); void x_set_visibility (); void x_set_menu_bar_lines (); void x_set_scroll_bar_width (); void x_set_unsplittable (); static struct x_frame_parm_table x_frame_parms[] = { "foreground-color", x_set_foreground_color, "background-color", x_set_background_color, "mouse-color", x_set_mouse_color, "cursor-color", x_set_cursor_color, "border-color", x_set_border_color, "cursor-type", x_set_cursor_type, "icon-type", x_set_icon_type, "icon-name", x_set_icon_name, "font", x_set_font, "border-width", x_set_border_width, "internal-border-width", x_set_internal_border_width, "name", x_explicitly_set_name, "auto-raise", x_set_autoraise, "auto-lower", x_set_autolower, "vertical-scroll-bars", x_set_vertical_scroll_bars, "visibility", x_set_visibility, "menu-bar-lines", x_set_menu_bar_lines, "scroll-bar-width", x_set_scroll_bar_width, "unsplittable", x_set_unsplittable, }; /* Attach the `x-frame-parameter' properties to the Lisp symbol names of parameters relevant to Win32. */ init_x_parm_symbols () { int i; for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++) Fput (intern (x_frame_parms[i].name), Qx_frame_parameter, make_number (i)); } /* Change the parameters of FRAME as specified by ALIST. If a parameter is not specially recognized, do nothing; otherwise call the `x_set_...' function for that parameter. */ void x_set_frame_parameters (f, alist) FRAME_PTR f; Lisp_Object alist; { Lisp_Object tail; /* If both of these parameters are present, it's more efficient to set them both at once. So we wait until we've looked at the entire list before we set them. */ Lisp_Object width, height; /* Same here. */ Lisp_Object left, top; /* Same with these. */ Lisp_Object icon_left, icon_top; /* Record in these vectors all the parms specified. */ Lisp_Object *parms; Lisp_Object *values; int i; int left_no_change = 0, top_no_change = 0; int icon_left_no_change = 0, icon_top_no_change = 0; i = 0; for (tail = alist; CONSP (tail); tail = Fcdr (tail)) i++; parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object)); values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object)); /* Extract parm names and values into those vectors. */ i = 0; for (tail = alist; CONSP (tail); tail = Fcdr (tail)) { Lisp_Object elt, prop, val; elt = Fcar (tail); parms[i] = Fcar (elt); values[i] = Fcdr (elt); i++; } width = height = top = left = Qunbound; icon_left = icon_top = Qunbound; /* Now process them in reverse of specified order. */ for (i--; i >= 0; i--) { Lisp_Object prop, val; prop = parms[i]; val = values[i]; if (EQ (prop, Qwidth)) width = val; else if (EQ (prop, Qheight)) height = val; else if (EQ (prop, Qtop)) top = val; else if (EQ (prop, Qleft)) left = val; else if (EQ (prop, Qicon_top)) icon_top = val; else if (EQ (prop, Qicon_left)) icon_left = val; else { register Lisp_Object param_index, old_value; param_index = Fget (prop, Qx_frame_parameter); old_value = get_frame_param (f, prop); store_frame_param (f, prop, val); if (NATNUMP (param_index) && (XFASTINT (param_index) < sizeof (x_frame_parms)/sizeof (x_frame_parms[0]))) (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value); } } /* Don't die if just one of these was set. */ if (EQ (left, Qunbound)) { left_no_change = 1; if (f->output_data.win32->left_pos < 0) left = Fcons (Qplus, Fcons (make_number (f->output_data.win32->left_pos), Qnil)); else XSETINT (left, f->output_data.win32->left_pos); } if (EQ (top, Qunbound)) { top_no_change = 1; if (f->output_data.win32->top_pos < 0) top = Fcons (Qplus, Fcons (make_number (f->output_data.win32->top_pos), Qnil)); else XSETINT (top, f->output_data.win32->top_pos); } /* If one of the icon positions was not set, preserve or default it. */ if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left)) { icon_left_no_change = 1; icon_left = Fcdr (Fassq (Qicon_left, f->param_alist)); if (NILP (icon_left)) XSETINT (icon_left, 0); } if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top)) { icon_top_no_change = 1; icon_top = Fcdr (Fassq (Qicon_top, f->param_alist)); if (NILP (icon_top)) XSETINT (icon_top, 0); } /* Don't die if just one of these was set. */ if (EQ (width, Qunbound)) XSETINT (width, FRAME_WIDTH (f)); if (EQ (height, Qunbound)) XSETINT (height, FRAME_HEIGHT (f)); /* Don't set these parameters 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; check_frame_size (f, &height, &width); XSETFRAME (frame, f); if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f)) || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f))) Fset_frame_size (frame, width, height); if ((!NILP (left) || !NILP (top)) && ! (left_no_change && top_no_change) && ! (NUMBERP (left) && XINT (left) == f->output_data.win32->left_pos && NUMBERP (top) && XINT (top) == f->output_data.win32->top_pos)) { int leftpos = 0; int toppos = 0; /* Record the signs. */ f->output_data.win32->size_hint_flags &= ~ (XNegative | YNegative); if (EQ (left, Qminus)) f->output_data.win32->size_hint_flags |= XNegative; else if (INTEGERP (left)) { leftpos = XINT (left); if (leftpos < 0) f->output_data.win32->size_hint_flags |= XNegative; } else if (CONSP (left) && EQ (XCONS (left)->car, Qminus) && CONSP (XCONS (left)->cdr) && INTEGERP (XCONS (XCONS (left)->cdr)->car)) { leftpos = - XINT (XCONS (XCONS (left)->cdr)->car); f->output_data.win32->size_hint_flags |= XNegative; } else if (CONSP (left) && EQ (XCONS (left)->car, Qplus) && CONSP (XCONS (left)->cdr) && INTEGERP (XCONS (XCONS (left)->cdr)->car)) { leftpos = XINT (XCONS (XCONS (left)->cdr)->car); } if (EQ (top, Qminus)) f->output_data.win32->size_hint_flags |= YNegative; else if (INTEGERP (top)) { toppos = XINT (top); if (toppos < 0) f->output_data.win32->size_hint_flags |= YNegative; } else if (CONSP (top) && EQ (XCONS (top)->car, Qminus) && CONSP (XCONS (top)->cdr) && INTEGERP (XCONS (XCONS (top)->cdr)->car)) { toppos = - XINT (XCONS (XCONS (top)->cdr)->car); f->output_data.win32->size_hint_flags |= YNegative; } else if (CONSP (top) && EQ (XCONS (top)->car, Qplus) && CONSP (XCONS (top)->cdr) && INTEGERP (XCONS (XCONS (top)->cdr)->car)) { toppos = XINT (XCONS (XCONS (top)->cdr)->car); } /* Store the numeric value of the position. */ f->output_data.win32->top_pos = toppos; f->output_data.win32->left_pos = leftpos; f->output_data.win32->win_gravity = NorthWestGravity; /* Actually set that position, and convert to absolute. */ x_set_offset (f, leftpos, toppos, -1); } if ((!NILP (icon_left) || !NILP (icon_top)) && ! (icon_left_no_change && icon_top_no_change)) x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top)); } } /* Store the screen positions of frame F into XPTR and YPTR. These are the positions of the containing window manager window, not Emacs's own window. */ void x_real_positions (f, xptr, yptr) FRAME_PTR f; int *xptr, *yptr; { POINT pt; { RECT rect; GetClientRect(FRAME_WIN32_WINDOW(f), &rect); AdjustWindowRect(&rect, f->output_data.win32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f)); pt.x = rect.left; pt.y = rect.top; } ClientToScreen (FRAME_WIN32_WINDOW(f), &pt); *xptr = pt.x; *yptr = pt.y; } /* Insert a description of internally-recorded parameters of frame X into the parameter alist *ALISTPTR that is to be given to the user. Only parameters that are specific to Win32 and whose values are not correctly recorded in the frame's param_alist need to be considered here. */ x_report_frame_params (f, alistptr) struct frame *f; Lisp_Object *alistptr; { char buf[16]; Lisp_Object tem; /* Represent negative positions (off the top or left screen edge) in a way that Fmodify_frame_parameters will understand correctly. */ XSETINT (tem, f->output_data.win32->left_pos); if (f->output_data.win32->left_pos >= 0) store_in_alist (alistptr, Qleft, tem); else store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil))); XSETINT (tem, f->output_data.win32->top_pos); if (f->output_data.win32->top_pos >= 0) store_in_alist (alistptr, Qtop, tem); else store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil))); store_in_alist (alistptr, Qborder_width, make_number (f->output_data.win32->border_width)); store_in_alist (alistptr, Qinternal_border_width, make_number (f->output_data.win32->internal_border_width)); sprintf (buf, "%ld", (long) FRAME_WIN32_WINDOW (f)); store_in_alist (alistptr, Qwindow_id, build_string (buf)); store_in_alist (alistptr, Qicon_name, f->icon_name); FRAME_SAMPLE_VISIBILITY (f); store_in_alist (alistptr, Qvisibility, (FRAME_VISIBLE_P (f) ? Qt : FRAME_ICONIFIED_P (f) ? Qicon : Qnil)); store_in_alist (alistptr, Qdisplay, XCONS (FRAME_WIN32_DISPLAY_INFO (f)->name_list_element)->car); } #if 0 DEFUN ("win32-rgb", Fwin32_rgb, Swin32_rgb, 3, 3, 0, "Convert RGB numbers to a windows color reference.") (red, green, blue) Lisp_Object red, green, blue; { Lisp_Object rgb; CHECK_NUMBER (red, 0); CHECK_NUMBER (green, 0); CHECK_NUMBER (blue, 0); XSET (rgb, Lisp_Int, RGB(XUINT(red), XUINT(green), XUINT(blue))); return (rgb); } #else /* The default colors for the win32 color map */ typedef struct colormap_t { char *name; COLORREF colorref; } colormap_t; colormap_t win32_color_map[] = { {"snow" , RGB (255,250,250)}, {"ghost white" , RGB (248,248,255)}, {"GhostWhite" , RGB (248,248,255)}, {"white smoke" , RGB (245,245,245)}, {"WhiteSmoke" , RGB (245,245,245)}, {"gainsboro" , RGB (220,220,220)}, {"floral white" , RGB (255,250,240)}, {"FloralWhite" , RGB (255,250,240)}, {"old lace" , RGB (253,245,230)}, {"OldLace" , RGB (253,245,230)}, {"linen" , RGB (250,240,230)}, {"antique white" , RGB (250,235,215)}, {"AntiqueWhite" , RGB (250,235,215)}, {"papaya whip" , RGB (255,239,213)}, {"PapayaWhip" , RGB (255,239,213)}, {"blanched almond" , RGB (255,235,205)}, {"BlanchedAlmond" , RGB (255,235,205)}, {"bisque" , RGB (255,228,196)}, {"peach puff" , RGB (255,218,185)}, {"PeachPuff" , RGB (255,218,185)}, {"navajo white" , RGB (255,222,173)}, {"NavajoWhite" , RGB (255,222,173)}, {"moccasin" , RGB (255,228,181)}, {"cornsilk" , RGB (255,248,220)}, {"ivory" , RGB (255,255,240)}, {"lemon chiffon" , RGB (255,250,205)}, {"LemonChiffon" , RGB (255,250,205)}, {"seashell" , RGB (255,245,238)}, {"honeydew" , RGB (240,255,240)}, {"mint cream" , RGB (245,255,250)}, {"MintCream" , RGB (245,255,250)}, {"azure" , RGB (240,255,255)}, {"alice blue" , RGB (240,248,255)}, {"AliceBlue" , RGB (240,248,255)}, {"lavender" , RGB (230,230,250)}, {"lavender blush" , RGB (255,240,245)}, {"LavenderBlush" , RGB (255,240,245)}, {"misty rose" , RGB (255,228,225)}, {"MistyRose" , RGB (255,228,225)}, {"white" , RGB (255,255,255)}, {"black" , RGB ( 0, 0, 0)}, {"dark slate gray" , RGB ( 47, 79, 79)}, {"DarkSlateGray" , RGB ( 47, 79, 79)}, {"dark slate grey" , RGB ( 47, 79, 79)}, {"DarkSlateGrey" , RGB ( 47, 79, 79)}, {"dim gray" , RGB (105,105,105)}, {"DimGray" , RGB (105,105,105)}, {"dim grey" , RGB (105,105,105)}, {"DimGrey" , RGB (105,105,105)}, {"slate gray" , RGB (112,128,144)}, {"SlateGray" , RGB (112,128,144)}, {"slate grey" , RGB (112,128,144)}, {"SlateGrey" , RGB (112,128,144)}, {"light slate gray" , RGB (119,136,153)}, {"LightSlateGray" , RGB (119,136,153)}, {"light slate grey" , RGB (119,136,153)}, {"LightSlateGrey" , RGB (119,136,153)}, {"gray" , RGB (190,190,190)}, {"grey" , RGB (190,190,190)}, {"light grey" , RGB (211,211,211)}, {"LightGrey" , RGB (211,211,211)}, {"light gray" , RGB (211,211,211)}, {"LightGray" , RGB (211,211,211)}, {"midnight blue" , RGB ( 25, 25,112)}, {"MidnightBlue" , RGB ( 25, 25,112)}, {"navy" , RGB ( 0, 0,128)}, {"navy blue" , RGB ( 0, 0,128)}, {"NavyBlue" , RGB ( 0, 0,128)}, {"cornflower blue" , RGB (100,149,237)}, {"CornflowerBlue" , RGB (100,149,237)}, {"dark slate blue" , RGB ( 72, 61,139)}, {"DarkSlateBlue" , RGB ( 72, 61,139)}, {"slate blue" , RGB (106, 90,205)}, {"SlateBlue" , RGB (106, 90,205)}, {"medium slate blue" , RGB (123,104,238)}, {"MediumSlateBlue" , RGB (123,104,238)}, {"light slate blue" , RGB (132,112,255)}, {"LightSlateBlue" , RGB (132,112,255)}, {"medium blue" , RGB ( 0, 0,205)}, {"MediumBlue" , RGB ( 0, 0,205)}, {"royal blue" , RGB ( 65,105,225)}, {"RoyalBlue" , RGB ( 65,105,225)}, {"blue" , RGB ( 0, 0,255)}, {"dodger blue" , RGB ( 30,144,255)}, {"DodgerBlue" , RGB ( 30,144,255)}, {"deep sky blue" , RGB ( 0,191,255)}, {"DeepSkyBlue" , RGB ( 0,191,255)}, {"sky blue" , RGB (135,206,235)}, {"SkyBlue" , RGB (135,206,235)}, {"light sky blue" , RGB (135,206,250)}, {"LightSkyBlue" , RGB (135,206,250)}, {"steel blue" , RGB ( 70,130,180)}, {"SteelBlue" , RGB ( 70,130,180)}, {"light steel blue" , RGB (176,196,222)}, {"LightSteelBlue" , RGB (176,196,222)}, {"light blue" , RGB (173,216,230)}, {"LightBlue" , RGB (173,216,230)}, {"powder blue" , RGB (176,224,230)}, {"PowderBlue" , RGB (176,224,230)}, {"pale turquoise" , RGB (175,238,238)}, {"PaleTurquoise" , RGB (175,238,238)}, {"dark turquoise" , RGB ( 0,206,209)}, {"DarkTurquoise" , RGB ( 0,206,209)}, {"medium turquoise" , RGB ( 72,209,204)}, {"MediumTurquoise" , RGB ( 72,209,204)}, {"turquoise" , RGB ( 64,224,208)}, {"cyan" , RGB ( 0,255,255)}, {"light cyan" , RGB (224,255,255)}, {"LightCyan" , RGB (224,255,255)}, {"cadet blue" , RGB ( 95,158,160)}, {"CadetBlue" , RGB ( 95,158,160)}, {"medium aquamarine" , RGB (102,205,170)}, {"MediumAquamarine" , RGB (102,205,170)}, {"aquamarine" , RGB (127,255,212)}, {"dark green" , RGB ( 0,100, 0)}, {"DarkGreen" , RGB ( 0,100, 0)}, {"dark olive green" , RGB ( 85,107, 47)}, {"DarkOliveGreen" , RGB ( 85,107, 47)}, {"dark sea green" , RGB (143,188,143)}, {"DarkSeaGreen" , RGB (143,188,143)}, {"sea green" , RGB ( 46,139, 87)}, {"SeaGreen" , RGB ( 46,139, 87)}, {"medium sea green" , RGB ( 60,179,113)}, {"MediumSeaGreen" , RGB ( 60,179,113)}, {"light sea green" , RGB ( 32,178,170)}, {"LightSeaGreen" , RGB ( 32,178,170)}, {"pale green" , RGB (152,251,152)}, {"PaleGreen" , RGB (152,251,152)}, {"spring green" , RGB ( 0,255,127)}, {"SpringGreen" , RGB ( 0,255,127)}, {"lawn green" , RGB (124,252, 0)}, {"LawnGreen" , RGB (124,252, 0)}, {"green" , RGB ( 0,255, 0)}, {"chartreuse" , RGB (127,255, 0)}, {"medium spring green" , RGB ( 0,250,154)}, {"MediumSpringGreen" , RGB ( 0,250,154)}, {"green yellow" , RGB (173,255, 47)}, {"GreenYellow" , RGB (173,255, 47)}, {"lime green" , RGB ( 50,205, 50)}, {"LimeGreen" , RGB ( 50,205, 50)}, {"yellow green" , RGB (154,205, 50)}, {"YellowGreen" , RGB (154,205, 50)}, {"forest green" , RGB ( 34,139, 34)}, {"ForestGreen" , RGB ( 34,139, 34)}, {"olive drab" , RGB (107,142, 35)}, {"OliveDrab" , RGB (107,142, 35)}, {"dark khaki" , RGB (189,183,107)}, {"DarkKhaki" , RGB (189,183,107)}, {"khaki" , RGB (240,230,140)}, {"pale goldenrod" , RGB (238,232,170)}, {"PaleGoldenrod" , RGB (238,232,170)}, {"light goldenrod yellow" , RGB (250,250,210)}, {"LightGoldenrodYellow" , RGB (250,250,210)}, {"light yellow" , RGB (255,255,224)}, {"LightYellow" , RGB (255,255,224)}, {"yellow" , RGB (255,255, 0)}, {"gold" , RGB (255,215, 0)}, {"light goldenrod" , RGB (238,221,130)}, {"LightGoldenrod" , RGB (238,221,130)}, {"goldenrod" , RGB (218,165, 32)}, {"dark goldenrod" , RGB (184,134, 11)}, {"DarkGoldenrod" , RGB (184,134, 11)}, {"rosy brown" , RGB (188,143,143)}, {"RosyBrown" , RGB (188,143,143)}, {"indian red" , RGB (205, 92, 92)}, {"IndianRed" , RGB (205, 92, 92)}, {"saddle brown" , RGB (139, 69, 19)}, {"SaddleBrown" , RGB (139, 69, 19)}, {"sienna" , RGB (160, 82, 45)}, {"peru" , RGB (205,133, 63)}, {"burlywood" , RGB (222,184,135)}, {"beige" , RGB (245,245,220)}, {"wheat" , RGB (245,222,179)}, {"sandy brown" , RGB (244,164, 96)}, {"SandyBrown" , RGB (244,164, 96)}, {"tan" , RGB (210,180,140)}, {"chocolate" , RGB (210,105, 30)}, {"firebrick" , RGB (178,34, 34)}, {"brown" , RGB (165,42, 42)}, {"dark salmon" , RGB (233,150,122)}, {"DarkSalmon" , RGB (233,150,122)}, {"salmon" , RGB (250,128,114)}, {"light salmon" , RGB (255,160,122)}, {"LightSalmon" , RGB (255,160,122)}, {"orange" , RGB (255,165, 0)}, {"dark orange" , RGB (255,140, 0)}, {"DarkOrange" , RGB (255,140, 0)}, {"coral" , RGB (255,127, 80)}, {"light coral" , RGB (240,128,128)}, {"LightCoral" , RGB (240,128,128)}, {"tomato" , RGB (255, 99, 71)}, {"orange red" , RGB (255, 69, 0)}, {"OrangeRed" , RGB (255, 69, 0)}, {"red" , RGB (255, 0, 0)}, {"hot pink" , RGB (255,105,180)}, {"HotPink" , RGB (255,105,180)}, {"deep pink" , RGB (255, 20,147)}, {"DeepPink" , RGB (255, 20,147)}, {"pink" , RGB (255,192,203)}, {"light pink" , RGB (255,182,193)}, {"LightPink" , RGB (255,182,193)}, {"pale violet red" , RGB (219,112,147)}, {"PaleVioletRed" , RGB (219,112,147)}, {"maroon" , RGB (176, 48, 96)}, {"medium violet red" , RGB (199, 21,133)}, {"MediumVioletRed" , RGB (199, 21,133)}, {"violet red" , RGB (208, 32,144)}, {"VioletRed" , RGB (208, 32,144)}, {"magenta" , RGB (255, 0,255)}, {"violet" , RGB (238,130,238)}, {"plum" , RGB (221,160,221)}, {"orchid" , RGB (218,112,214)}, {"medium orchid" , RGB (186, 85,211)}, {"MediumOrchid" , RGB (186, 85,211)}, {"dark orchid" , RGB (153, 50,204)}, {"DarkOrchid" , RGB (153, 50,204)}, {"dark violet" , RGB (148, 0,211)}, {"DarkViolet" , RGB (148, 0,211)}, {"blue violet" , RGB (138, 43,226)}, {"BlueViolet" , RGB (138, 43,226)}, {"purple" , RGB (160, 32,240)}, {"medium purple" , RGB (147,112,219)}, {"MediumPurple" , RGB (147,112,219)}, {"thistle" , RGB (216,191,216)}, {"gray0" , RGB ( 0, 0, 0)}, {"grey0" , RGB ( 0, 0, 0)}, {"dark grey" , RGB (169,169,169)}, {"DarkGrey" , RGB (169,169,169)}, {"dark gray" , RGB (169,169,169)}, {"DarkGray" , RGB (169,169,169)}, {"dark blue" , RGB ( 0, 0,139)}, {"DarkBlue" , RGB ( 0, 0,139)}, {"dark cyan" , RGB ( 0,139,139)}, {"DarkCyan" , RGB ( 0,139,139)}, {"dark magenta" , RGB (139, 0,139)}, {"DarkMagenta" , RGB (139, 0,139)}, {"dark red" , RGB (139, 0, 0)}, {"DarkRed" , RGB (139, 0, 0)}, {"light green" , RGB (144,238,144)}, {"LightGreen" , RGB (144,238,144)}, }; DEFUN ("win32-default-color-map", Fwin32_default_color_map, Swin32_default_color_map, 0, 0, 0, "Return the default color map.") () { int i; colormap_t *pc = win32_color_map; Lisp_Object cmap; BLOCK_INPUT; cmap = Qnil; for (i = 0; i < sizeof (win32_color_map) / sizeof (win32_color_map[0]); pc++, i++) cmap = Fcons (Fcons (build_string (pc->name), make_number (pc->colorref)), cmap); UNBLOCK_INPUT; return (cmap); } #endif Lisp_Object win32_to_x_color (rgb) Lisp_Object rgb; { Lisp_Object color; CHECK_NUMBER (rgb, 0); BLOCK_INPUT; color = Frassq (rgb, Vwin32_color_map); UNBLOCK_INPUT; if (!NILP (color)) return (Fcar (color)); else return Qnil; } COLORREF x_to_win32_color (colorname) char * colorname; { register Lisp_Object tail, ret = Qnil; BLOCK_INPUT; for (tail = Vwin32_color_map; !NILP (tail); tail = Fcdr (tail)) { register Lisp_Object elt, tem; elt = Fcar (tail); if (!CONSP (elt)) continue; tem = Fcar (elt); if (lstrcmpi (XSTRING (tem)->data, colorname) == 0) { ret = XUINT(Fcdr (elt)); break; } QUIT; } UNBLOCK_INPUT; return ret; } /* Decide if color named COLOR is valid for the display associated with the selected frame; if so, return the rgb values in COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell. */ int defined_color (f, color, color_def, alloc) FRAME_PTR f; char *color; COLORREF *color_def; int alloc; { register Lisp_Object tem; tem = x_to_win32_color (color); if (!NILP (tem)) { *color_def = XUINT (tem); return 1; } else { return 0; } } /* Given a string ARG naming a color, compute a pixel value from it suitable for screen F. If F is not a color screen, return DEF (default) regardless of what ARG says. */ int x_decode_color (f, arg, def) FRAME_PTR f; Lisp_Object arg; int def; { COLORREF cdef; CHECK_STRING (arg, 0); if (strcmp (XSTRING (arg)->data, "black") == 0) return BLACK_PIX_DEFAULT (f); else if (strcmp (XSTRING (arg)->data, "white") == 0) return WHITE_PIX_DEFAULT (f); if ((FRAME_WIN32_DISPLAY_INFO (f)->n_planes * FRAME_WIN32_DISPLAY_INFO (f)->n_cbits) == 1) return def; /* defined_color is responsible for coping with failures by looking for a near-miss. */ if (defined_color (f, XSTRING (arg)->data, &cdef, 1)) return cdef; /* defined_color failed; return an ultimate default. */ return def; } /* Functions called only from `x_set_frame_param' to set individual parameters. If FRAME_WIN32_WINDOW (f) is 0, the frame is being created and its window does not exist yet. In that case, just record the parameter's new value in the standard place; do not attempt to change the window. */ void x_set_foreground_color (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { f->output_data.win32->foreground_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); if (FRAME_WIN32_WINDOW (f) != 0) { recompute_basic_faces (f); if (FRAME_VISIBLE_P (f)) redraw_frame (f); } } void x_set_background_color (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { Pixmap temp; int mask; f->output_data.win32->background_pixel = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f)); if (FRAME_WIN32_WINDOW (f) != 0) { SetWindowLong (FRAME_WIN32_WINDOW (f), WND_BACKGROUND_INDEX, f->output_data.win32->background_pixel); recompute_basic_faces (f); if (FRAME_VISIBLE_P (f)) redraw_frame (f); } } void x_set_mouse_color (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { #if 0 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor; #endif int mask_color; if (!EQ (Qnil, arg)) f->output_data.win32->mouse_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); mask_color = f->output_data.win32->background_pixel; /* No invisible pointers. */ if (mask_color == f->output_data.win32->mouse_pixel && mask_color == f->output_data.win32->background_pixel) f->output_data.win32->mouse_pixel = f->output_data.win32->foreground_pixel; #if 0 BLOCK_INPUT; /* It's not okay to crash if the user selects a screwy cursor. */ x_catch_errors (FRAME_WIN32_DISPLAY (f)); if (!EQ (Qnil, Vx_pointer_shape)) { CHECK_NUMBER (Vx_pointer_shape, 0); cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XINT (Vx_pointer_shape)); } else cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XC_xterm); x_check_errors (FRAME_WIN32_DISPLAY (f), "bad text pointer cursor: %s"); if (!EQ (Qnil, Vx_nontext_pointer_shape)) { CHECK_NUMBER (Vx_nontext_pointer_shape, 0); nontext_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XINT (Vx_nontext_pointer_shape)); } else nontext_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XC_left_ptr); x_check_errors (FRAME_WIN32_DISPLAY (f), "bad nontext pointer cursor: %s"); if (!EQ (Qnil, Vx_mode_pointer_shape)) { CHECK_NUMBER (Vx_mode_pointer_shape, 0); mode_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XINT (Vx_mode_pointer_shape)); } else mode_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XC_xterm); x_check_errors (FRAME_WIN32_DISPLAY (f), "bad modeline pointer cursor: %s"); if (!EQ (Qnil, Vx_sensitive_text_pointer_shape)) { CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0); cross_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XINT (Vx_sensitive_text_pointer_shape)); } else cross_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XC_crosshair); /* Check and report errors with the above calls. */ x_check_errors (FRAME_WIN32_DISPLAY (f), "can't set cursor shape: %s"); x_uncatch_errors (FRAME_WIN32_DISPLAY (f)); { XColor fore_color, back_color; fore_color.pixel = f->output_data.win32->mouse_pixel; back_color.pixel = mask_color; XQueryColor (FRAME_WIN32_DISPLAY (f), DefaultColormap (FRAME_WIN32_DISPLAY (f), DefaultScreen (FRAME_WIN32_DISPLAY (f))), &fore_color); XQueryColor (FRAME_WIN32_DISPLAY (f), DefaultColormap (FRAME_WIN32_DISPLAY (f), DefaultScreen (FRAME_WIN32_DISPLAY (f))), &back_color); XRecolorCursor (FRAME_WIN32_DISPLAY (f), cursor, &fore_color, &back_color); XRecolorCursor (FRAME_WIN32_DISPLAY (f), nontext_cursor, &fore_color, &back_color); XRecolorCursor (FRAME_WIN32_DISPLAY (f), mode_cursor, &fore_color, &back_color); XRecolorCursor (FRAME_WIN32_DISPLAY (f), cross_cursor, &fore_color, &back_color); } if (FRAME_WIN32_WINDOW (f) != 0) { XDefineCursor (FRAME_WIN32_DISPLAY (f), FRAME_WIN32_WINDOW (f), cursor); } if (cursor != f->output_data.win32->text_cursor && f->output_data.win32->text_cursor != 0) XFreeCursor (FRAME_WIN32_DISPLAY (f), f->output_data.win32->text_cursor); f->output_data.win32->text_cursor = cursor; if (nontext_cursor != f->output_data.win32->nontext_cursor && f->output_data.win32->nontext_cursor != 0) XFreeCursor (FRAME_WIN32_DISPLAY (f), f->output_data.win32->nontext_cursor); f->output_data.win32->nontext_cursor = nontext_cursor; if (mode_cursor != f->output_data.win32->modeline_cursor && f->output_data.win32->modeline_cursor != 0) XFreeCursor (FRAME_WIN32_DISPLAY (f), f->output_data.win32->modeline_cursor); f->output_data.win32->modeline_cursor = mode_cursor; if (cross_cursor != f->output_data.win32->cross_cursor && f->output_data.win32->cross_cursor != 0) XFreeCursor (FRAME_WIN32_DISPLAY (f), f->output_data.win32->cross_cursor); f->output_data.win32->cross_cursor = cross_cursor; XFlush (FRAME_WIN32_DISPLAY (f)); UNBLOCK_INPUT; #endif } void x_set_cursor_color (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { unsigned long fore_pixel; if (!EQ (Vx_cursor_fore_pixel, Qnil)) fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT (f)); else fore_pixel = f->output_data.win32->background_pixel; f->output_data.win32->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); /* Make sure that the cursor color differs from the background color. */ if (f->output_data.win32->cursor_pixel == f->output_data.win32->background_pixel) { f->output_data.win32->cursor_pixel = f->output_data.win32->mouse_pixel; if (f->output_data.win32->cursor_pixel == fore_pixel) fore_pixel = f->output_data.win32->background_pixel; } f->output_data.win32->cursor_foreground_pixel = fore_pixel; if (FRAME_WIN32_WINDOW (f) != 0) { if (FRAME_VISIBLE_P (f)) { x_display_cursor (f, 0); x_display_cursor (f, 1); } } } /* Set the border-color of frame F to value described by ARG. ARG can be a string naming a color. The border-color is used for the border that is drawn by the server. Note that this does not fully take effect if done before F has a window; it must be redone when the window is created. */ void x_set_border_color (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { unsigned char *str; int pix; CHECK_STRING (arg, 0); str = XSTRING (arg)->data; pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); x_set_border_pixel (f, pix); } /* Set the border-color of frame F to pixel value PIX. Note that this does not fully take effect if done before F has an window. */ x_set_border_pixel (f, pix) struct frame *f; int pix; { f->output_data.win32->border_pixel = pix; if (FRAME_WIN32_WINDOW (f) != 0 && f->output_data.win32->border_width > 0) { if (FRAME_VISIBLE_P (f)) redraw_frame (f); } } void x_set_cursor_type (f, arg, oldval) FRAME_PTR f; Lisp_Object arg, oldval; { if (EQ (arg, Qbar)) { FRAME_DESIRED_CURSOR (f) = bar_cursor; f->output_data.win32->cursor_width = 2; } else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar) && INTEGERP (XCONS (arg)->cdr)) { FRAME_DESIRED_CURSOR (f) = bar_cursor; f->output_data.win32->cursor_width = XINT (XCONS (arg)->cdr); } else /* Treat anything unknown as "box cursor". It was bad to signal an error; people have trouble fixing .Xdefaults with Emacs, when it has something bad in it. */ FRAME_DESIRED_CURSOR (f) = filled_box_cursor; /* Make sure the cursor gets redrawn. This is overkill, but how often do people change cursor types? */ update_mode_lines++; } void x_set_icon_type (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { #if 0 Lisp_Object tem; int result; if (STRINGP (arg)) { if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) return; } else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil)) return; BLOCK_INPUT; if (NILP (arg)) result = x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name) ? f->icon_name : f->name))->data); else result = x_bitmap_icon (f, arg); if (result) { UNBLOCK_INPUT; error ("No icon window available"); } /* If the window was unmapped (and its icon was mapped), the new icon is not mapped, so map the window in its stead. */ if (FRAME_VISIBLE_P (f)) { #ifdef USE_X_TOOLKIT XtPopup (f->output_data.win32->widget, XtGrabNone); #endif XMapWindow (FRAME_WIN32_DISPLAY (f), FRAME_WIN32_WINDOW (f)); } XFlush (FRAME_WIN32_DISPLAY (f)); UNBLOCK_INPUT; #endif } /* Return non-nil if frame F wants a bitmap icon. */ Lisp_Object x_icon_type (f) FRAME_PTR f; { Lisp_Object tem; tem = assq_no_quit (Qicon_type, f->param_alist); if (CONSP (tem)) return XCONS (tem)->cdr; else return Qnil; } void x_set_icon_name (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { Lisp_Object tem; int result; if (STRINGP (arg)) { if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) return; } else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil)) return; f->icon_name = arg; #if 0 if (f->output_data.win32->icon_bitmap != 0) return; BLOCK_INPUT; result = x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name) ? f->icon_name : f->name))->data); if (result) { UNBLOCK_INPUT; error ("No icon window available"); } /* If the window was unmapped (and its icon was mapped), the new icon is not mapped, so map the window in its stead. */ if (FRAME_VISIBLE_P (f)) { #ifdef USE_X_TOOLKIT XtPopup (f->output_data.win32->widget, XtGrabNone); #endif XMapWindow (FRAME_WIN32_DISPLAY (f), FRAME_WIN32_WINDOW (f)); } XFlush (FRAME_WIN32_DISPLAY (f)); UNBLOCK_INPUT; #endif } extern Lisp_Object x_new_font (); void x_set_font (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { Lisp_Object result; CHECK_STRING (arg, 1); BLOCK_INPUT; result = x_new_font (f, XSTRING (arg)->data); UNBLOCK_INPUT; if (EQ (result, Qnil)) error ("Font \"%s\" is not defined", XSTRING (arg)->data); else if (EQ (result, Qt)) error ("the characters of the given font have varying widths"); else if (STRINGP (result)) { recompute_basic_faces (f); store_frame_param (f, Qfont, result); } else abort (); } void x_set_border_width (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { CHECK_NUMBER (arg, 0); if (XINT (arg) == f->output_data.win32->border_width) return; if (FRAME_WIN32_WINDOW (f) != 0) error ("Cannot change the border width of a window"); f->output_data.win32->border_width = XINT (arg); } void x_set_internal_border_width (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { int mask; int old = f->output_data.win32->internal_border_width; CHECK_NUMBER (arg, 0); f->output_data.win32->internal_border_width = XINT (arg); if (f->output_data.win32->internal_border_width < 0) f->output_data.win32->internal_border_width = 0; if (f->output_data.win32->internal_border_width == old) return; if (FRAME_WIN32_WINDOW (f) != 0) { BLOCK_INPUT; x_set_window_size (f, 0, f->width, f->height); UNBLOCK_INPUT; SET_FRAME_GARBAGED (f); } } void x_set_visibility (f, value, oldval) struct frame *f; Lisp_Object value, oldval; { Lisp_Object frame; XSETFRAME (frame, f); if (NILP (value)) Fmake_frame_invisible (frame, Qt); else if (EQ (value, Qicon)) Ficonify_frame (frame); else Fmake_frame_visible (frame); } void x_set_menu_bar_lines (f, value, oldval) struct frame *f; Lisp_Object value, oldval; { int nlines; int olines = FRAME_MENU_BAR_LINES (f); /* Right now, menu bars don't work properly in minibuf-only frames; most of the commands try to apply themselves to the minibuffer frame itslef, and get an error because you can't switch buffers in or split the minibuffer window. */ if (FRAME_MINIBUF_ONLY_P (f)) return; if (INTEGERP (value)) nlines = XINT (value); else nlines = 0; FRAME_MENU_BAR_LINES (f) = 0; if (nlines) FRAME_EXTERNAL_MENU_BAR (f) = 1; else { if (FRAME_EXTERNAL_MENU_BAR (f) == 1) free_frame_menubar (f); FRAME_EXTERNAL_MENU_BAR (f) = 0; } } /* Change the name of frame F to NAME. If NAME is nil, set F's name to win32_id_name. If EXPLICIT is non-zero, that indicates that lisp code is setting the name; if NAME is a string, set F's name to NAME and set F->explicit_name; if NAME is Qnil, then clear F->explicit_name. If EXPLICIT is zero, that indicates that Emacs redisplay code is suggesting a new name, which lisp code should override; if F->explicit_name is set, ignore the new name; otherwise, set it. */ void x_set_name (f, name, explicit) struct frame *f; Lisp_Object name; int explicit; { /* Make sure that requests from lisp code override requests from Emacs redisplay code. */ if (explicit) { /* If we're switching from explicit to implicit, we had better update the mode lines and thereby update the title. */ if (f->explicit_name && NILP (name)) update_mode_lines = 1; f->explicit_name = ! NILP (name); } else if (f->explicit_name) return; /* If NAME is nil, set the name to the win32_id_name. */ if (NILP (name)) { /* Check for no change needed in this very common case before we do any consing. */ if (!strcmp (FRAME_WIN32_DISPLAY_INFO (f)->win32_id_name, XSTRING (f->name)->data)) return; name = build_string (FRAME_WIN32_DISPLAY_INFO (f)->win32_id_name); } else CHECK_STRING (name, 0); /* Don't change the name if it's already NAME. */ if (! NILP (Fstring_equal (name, f->name))) return; if (FRAME_WIN32_WINDOW (f)) { BLOCK_INPUT; SetWindowText(FRAME_WIN32_WINDOW (f), XSTRING (name)->data); UNBLOCK_INPUT; } f->name = name; } /* This function should be called when the user's lisp code has specified a name for the frame; the name will override any set by the redisplay code. */ void x_explicitly_set_name (f, arg, oldval) FRAME_PTR f; Lisp_Object arg, oldval; { x_set_name (f, arg, 1); } /* This function should be called by Emacs redisplay code to set the name; names set this way will never override names set by the user's lisp code. */ void x_implicitly_set_name (f, arg, oldval) FRAME_PTR f; Lisp_Object arg, oldval; { x_set_name (f, arg, 0); } void x_set_autoraise (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { f->auto_raise = !EQ (Qnil, arg); } void x_set_autolower (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { f->auto_lower = !EQ (Qnil, arg); } void x_set_unsplittable (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { f->no_split = !NILP (arg); } void x_set_vertical_scroll_bars (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)) { FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg); /* We set this parameter before creating the window for the frame, so we can get the geometry right from the start. However, if the window hasn't been created yet, we shouldn't call x_set_window_size. */ if (FRAME_WIN32_WINDOW (f)) x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f)); } } void x_set_scroll_bar_width (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { if (NILP (arg)) { FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0; FRAME_SCROLL_BAR_COLS (f) = 2; } else if (INTEGERP (arg) && XINT (arg) > 0 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f)) { int wid = FONT_WIDTH (f->output_data.win32->font); FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg); FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid; if (FRAME_WIN32_WINDOW (f)) x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f)); } } /* Subroutines of creating an frame. */ /* Make sure that Vx_resource_name is set to a reasonable value. Fix it up, or set it to `emacs' if it is too hopeless. */ static void validate_x_resource_name () { int len; /* Number of valid characters in the resource name. */ int good_count = 0; /* Number of invalid characters in the resource name. */ int bad_count = 0; Lisp_Object new; int i; if (STRINGP (Vx_resource_name)) { unsigned char *p = XSTRING (Vx_resource_name)->data; int i; len = XSTRING (Vx_resource_name)->size; /* Only letters, digits, - and _ are valid in resource names. Count the valid characters and count the invalid ones. */ for (i = 0; i < len; i++) { int c = p[i]; if (! ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c == '-' || c == '_')) bad_count++; else good_count++; } } else /* Not a string => completely invalid. */ bad_count = 5, good_count = 0; /* If name is valid already, return. */ if (bad_count == 0) return; /* If name is entirely invalid, or nearly so, use `emacs'. */ if (good_count == 0 || (good_count == 1 && bad_count > 0)) { Vx_resource_name = build_string ("emacs"); return; } /* Name is partly valid. Copy it and replace the invalid characters with underscores. */ Vx_resource_name = new = Fcopy_sequence (Vx_resource_name); for (i = 0; i < len; i++) { int c = XSTRING (new)->data[i]; if (! ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c == '-' || c == '_')) XSTRING (new)->data[i] = '_'; } } extern char *x_get_string_resource (); 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, 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 `INSTANCE.COMPONENT.ATTRIBUTE'\n\ and the class is `Emacs.CLASS.SUBCLASS'.") (attribute, class, component, subclass) Lisp_Object attribute, class, component, subclass; { register char *value; char *name_key; char *class_key; CHECK_STRING (attribute, 0); CHECK_STRING (class, 0); if (!NILP (component)) CHECK_STRING (component, 1); if (!NILP (subclass)) CHECK_STRING (subclass, 2); if (NILP (component) != NILP (subclass)) error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither"); validate_x_resource_name (); /* Allocate space for the components, the dots which separate them, and the final '\0'. Make them big enough for the worst case. */ name_key = (char *) alloca (XSTRING (Vx_resource_name)->size + (STRINGP (component) ? XSTRING (component)->size : 0) + XSTRING (attribute)->size + 3); class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1) + XSTRING (class)->size + (STRINGP (subclass) ? XSTRING (subclass)->size : 0) + 3); /* Start with emacs.FRAMENAME for the name (the specific one) and with `Emacs' for the class key (the general one). */ strcpy (name_key, XSTRING (Vx_resource_name)->data); strcpy (class_key, EMACS_CLASS); strcat (class_key, "."); strcat (class_key, XSTRING (class)->data); if (!NILP (component)) { strcat (class_key, "."); strcat (class_key, XSTRING (subclass)->data); strcat (name_key, "."); strcat (name_key, XSTRING (component)->data); } strcat (name_key, "."); strcat (name_key, XSTRING (attribute)->data); value = x_get_string_resource (Qnil, name_key, class_key); if (value != (char *) 0) return build_string (value); else return Qnil; } /* Used when C code wants a resource value. */ char * x_get_resource_string (attribute, class) char *attribute, *class; { register char *value; char *name_key; char *class_key; /* Allocate space for the components, the dots which separate them, and the final '\0'. */ name_key = (char *) alloca (XSTRING (Vinvocation_name)->size + strlen (attribute) + 2); class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2); sprintf (name_key, "%s.%s", XSTRING (Vinvocation_name)->data, attribute); sprintf (class_key, "%s.%s", EMACS_CLASS, class); return x_get_string_resource (selected_frame, name_key, class_key); } /* Types we might convert a resource string into. */ enum resource_types { number, boolean, string, symbol }; /* Return the value of parameter PARAM. First search ALIST, then Vdefault_frame_alist, then the X defaults database, using ATTRIBUTE as the attribute name and CLASS as its class. Convert the resource to the type specified by desired_type. If no default is specified, return Qunbound. If you call x_get_arg, make sure you deal with Qunbound in a reasonable way, and don't let it get stored in any Lisp-visible variables! */ static Lisp_Object x_get_arg (alist, param, attribute, class, type) Lisp_Object alist, param; char *attribute; char *class; enum resource_types type; { register Lisp_Object tem; tem = Fassq (param, alist); if (EQ (tem, Qnil)) tem = Fassq (param, Vdefault_frame_alist); if (EQ (tem, Qnil)) { if (attribute) { tem = Fx_get_resource (build_string (attribute), build_string (class), Qnil, Qnil); if (NILP (tem)) return Qunbound; switch (type) { case number: return make_number (atoi (XSTRING (tem)->data)); case boolean: tem = Fdowncase (tem); if (!strcmp (XSTRING (tem)->data, "on") || !strcmp (XSTRING (tem)->data, "true")) return Qt; else return Qnil; case string: return tem; case symbol: /* As a special case, we map the values `true' and `on' to Qt, and `false' and `off' to Qnil. */ { Lisp_Object lower; lower = Fdowncase (tem); if (!strcmp (XSTRING (lower)->data, "on") || !strcmp (XSTRING (lower)->data, "true")) return Qt; else if (!strcmp (XSTRING (lower)->data, "off") || !strcmp (XSTRING (lower)->data, "false")) return Qnil; else return Fintern (tem, Qnil); } default: abort (); } } else return Qunbound; } return Fcdr (tem); } /* Record in frame F the specified or default value according to ALIST of the parameter named PARAM (a Lisp symbol). If no value is specified for PARAM, look for an X default for XPROP on the frame named NAME. If that is not found either, use the value DEFLT. */ static Lisp_Object x_default_parameter (f, alist, prop, deflt, xprop, xclass, type) struct frame *f; Lisp_Object alist; Lisp_Object prop; Lisp_Object deflt; char *xprop; char *xclass; enum resource_types type; { Lisp_Object tem; tem = x_get_arg (alist, prop, xprop, xclass, type); if (EQ (tem, Qunbound)) tem = deflt; x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil)); return tem; } DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0, "Parse an X-style geometry string STRING.\n\ Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\ The properties returned may include `top', `left', `height', and `width'.\n\ The value of `left' or `top' may be an integer,\n\ or a list (+ N) meaning N pixels relative to top/left corner,\n\ or a list (- N) meaning -N pixels relative to bottom/right corner.") (string) Lisp_Object string; { int geometry, x, y; unsigned int width, height; Lisp_Object result; CHECK_STRING (string, 0); geometry = XParseGeometry ((char *) XSTRING (string)->data, &x, &y, &width, &height); result = Qnil; if (geometry & XValue) { Lisp_Object element; if (x >= 0 && (geometry & XNegative)) element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil))); else if (x < 0 && ! (geometry & XNegative)) element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil))); else element = Fcons (Qleft, make_number (x)); result = Fcons (element, result); } if (geometry & YValue) { Lisp_Object element; if (y >= 0 && (geometry & YNegative)) element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil))); else if (y < 0 && ! (geometry & YNegative)) element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil))); else element = Fcons (Qtop, make_number (y)); result = Fcons (element, result); } if (geometry & WidthValue) result = Fcons (Fcons (Qwidth, make_number (width)), result); if (geometry & HeightValue) result = Fcons (Fcons (Qheight, make_number (height)), result); return result; } /* Calculate the desired size and position of this window, and return the flags saying which aspects were specified. This function does not make the coordinates positive. */ #define DEFAULT_ROWS 40 #define DEFAULT_COLS 80 static int x_figure_window_size (f, parms) struct frame *f; Lisp_Object parms; { register Lisp_Object tem0, tem1, tem2; int height, width, left, top; register int geometry; long window_prompting = 0; /* Default values if we fall through. Actually, if that happens we should get window manager prompting. */ f->width = DEFAULT_COLS; f->height = DEFAULT_ROWS; /* Window managers expect that if program-specified positions are not (0,0), they're intentional, not defaults. */ f->output_data.win32->top_pos = 0; f->output_data.win32->left_pos = 0; tem0 = x_get_arg (parms, Qheight, 0, 0, number); tem1 = x_get_arg (parms, Qwidth, 0, 0, number); tem2 = x_get_arg (parms, Quser_size, 0, 0, number); if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound)) { if (!EQ (tem0, Qunbound)) { CHECK_NUMBER (tem0, 0); f->height = XINT (tem0); } if (!EQ (tem1, Qunbound)) { CHECK_NUMBER (tem1, 0); f->width = XINT (tem1); } if (!NILP (tem2) && !EQ (tem2, Qunbound)) window_prompting |= USSize; else window_prompting |= PSize; } f->output_data.win32->vertical_scroll_bar_extra = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f) ? 0 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f) : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.win32->font))); f->output_data.win32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width); f->output_data.win32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height); tem0 = x_get_arg (parms, Qtop, 0, 0, number); tem1 = x_get_arg (parms, Qleft, 0, 0, number); tem2 = x_get_arg (parms, Quser_position, 0, 0, number); if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound)) { if (EQ (tem0, Qminus)) { f->output_data.win32->top_pos = 0; window_prompting |= YNegative; } else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus) && CONSP (XCONS (tem0)->cdr) && INTEGERP (XCONS (XCONS (tem0)->cdr)->car)) { f->output_data.win32->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car); window_prompting |= YNegative; } else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus) && CONSP (XCONS (tem0)->cdr) && INTEGERP (XCONS (XCONS (tem0)->cdr)->car)) { f->output_data.win32->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car); } else if (EQ (tem0, Qunbound)) f->output_data.win32->top_pos = 0; else { CHECK_NUMBER (tem0, 0); f->output_data.win32->top_pos = XINT (tem0); if (f->output_data.win32->top_pos < 0) window_prompting |= YNegative; } if (EQ (tem1, Qminus)) { f->output_data.win32->left_pos = 0; window_prompting |= XNegative; } else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus) && CONSP (XCONS (tem1)->cdr) && INTEGERP (XCONS (XCONS (tem1)->cdr)->car)) { f->output_data.win32->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car); window_prompting |= XNegative; } else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus) && CONSP (XCONS (tem1)->cdr) && INTEGERP (XCONS (XCONS (tem1)->cdr)->car)) { f->output_data.win32->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car); } else if (EQ (tem1, Qunbound)) f->output_data.win32->left_pos = 0; else { CHECK_NUMBER (tem1, 0); f->output_data.win32->left_pos = XINT (tem1); if (f->output_data.win32->left_pos < 0) window_prompting |= XNegative; } if (!NILP (tem2) && ! EQ (tem2, Qunbound)) window_prompting |= USPosition; else window_prompting |= PPosition; } return window_prompting; } extern LRESULT CALLBACK win32_wnd_proc (); BOOL win32_init_class (hinst) HINSTANCE hinst; { WNDCLASS wc; wc.style = CS_HREDRAW | CS_VREDRAW | CS_OWNDC; wc.lpfnWndProc = (WNDPROC) win32_wnd_proc; wc.cbClsExtra = 0; wc.cbWndExtra = WND_EXTRA_BYTES; wc.hInstance = hinst; wc.hIcon = LoadIcon (hinst, EMACS_CLASS); wc.hCursor = LoadCursor (NULL, IDC_ARROW); wc.hbrBackground = NULL; // GetStockObject (WHITE_BRUSH); wc.lpszMenuName = NULL; wc.lpszClassName = EMACS_CLASS; return (RegisterClass (&wc)); } HWND win32_createscrollbar (f, bar) struct frame *f; struct scroll_bar * bar; { return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE, /* Position and size of scroll bar. */ XINT(bar->left), XINT(bar->top), XINT(bar->width), XINT(bar->height), FRAME_WIN32_WINDOW (f), NULL, hinst, NULL)); } void win32_createwindow (f) struct frame *f; { HWND hwnd; /* Do first time app init */ if (!hprevinst) { win32_init_class (hinst); } FRAME_WIN32_WINDOW (f) = hwnd = CreateWindow (EMACS_CLASS, f->namebuf, f->output_data.win32->dwStyle | WS_CLIPCHILDREN, f->output_data.win32->left_pos, f->output_data.win32->top_pos, PIXEL_WIDTH (f), PIXEL_HEIGHT (f), NULL, NULL, hinst, NULL); if (hwnd) { SetWindowLong (hwnd, WND_X_UNITS_INDEX, FONT_WIDTH (f->output_data.win32->font)); SetWindowLong (hwnd, WND_Y_UNITS_INDEX, f->output_data.win32->line_height); SetWindowLong (hwnd, WND_BACKGROUND_INDEX, f->output_data.win32->background_pixel); } } DWORD win_msg_worker (dw) DWORD dw; { MSG msg; /* Ensure our message queue is created */ PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE); PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0); while (GetMessage (&msg, NULL, 0, 0)) { if (msg.hwnd == NULL) { switch (msg.message) { case WM_EMACS_CREATEWINDOW: win32_createwindow ((struct frame *) msg.wParam); PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0); break; case WM_EMACS_CREATESCROLLBAR: { HWND hwnd = win32_createscrollbar ((struct frame *) msg.wParam, (struct scroll_bar *) msg.lParam); PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, (WPARAM)hwnd, 0); } break; case WM_EMACS_KILL: return (0); } } else { DispatchMessage (&msg); } } return (0); } HDC map_mode (hdc) HDC hdc; { if (hdc) { #if 0 /* Make mapping mode be in 1/20 of point */ SetMapMode (hdc, MM_ANISOTROPIC); SetWindowExtEx (hdc, 1440, 1440, NULL); SetViewportExtEx (hdc, GetDeviceCaps (hdc, LOGPIXELSX), GetDeviceCaps (hdc, LOGPIXELSY), NULL); #endif } return (hdc); } /* Convert between the modifier bits Win32 uses and the modifier bits Emacs uses. */ unsigned int win32_get_modifiers () { return (((GetKeyState (VK_SHIFT)&0x8000) ? shift_modifier : 0) | ((GetKeyState (VK_CONTROL)&0x8000) ? ctrl_modifier : 0) | ((GetKeyState (VK_MENU)&0x8000) ? meta_modifier : 0)); } void my_post_msg (wmsg, hwnd, msg, wParam, lParam) Win32Msg * wmsg; HWND hwnd; UINT msg; WPARAM wParam; LPARAM lParam; { wmsg->msg.hwnd = hwnd; wmsg->msg.message = msg; wmsg->msg.wParam = wParam; wmsg->msg.lParam = lParam; wmsg->msg.time = GetMessageTime (); post_msg (wmsg); } /* Main window procedure */ extern char *lispy_function_keys[]; LRESULT CALLBACK win32_wnd_proc (hwnd, msg, wParam, lParam) HWND hwnd; UINT msg; WPARAM wParam; LPARAM lParam; { struct frame *f; LRESULT ret = 1; struct win32_display_info *dpyinfo = &one_win32_display_info; Win32Msg wmsg; switch (msg) { case WM_ERASEBKGND: { HBRUSH hb; HANDLE oldobj; RECT rect; GetClientRect (hwnd, &rect); hb = CreateSolidBrush (GetWindowLong (hwnd, WND_BACKGROUND_INDEX)); oldobj = SelectObject ((HDC)wParam, hb); FillRect((HDC)wParam, &rect, hb); SelectObject((HDC)wParam, oldobj); DeleteObject (hb); return (0); } case WM_PAINT: { PAINTSTRUCT paintStruct; BeginPaint (hwnd, &paintStruct); wmsg.rect = paintStruct.rcPaint; EndPaint (hwnd, &paintStruct); my_post_msg (&wmsg, hwnd, msg, wParam, lParam); return (0); } case WM_CREATE: { HDC hdc = my_get_dc (hwnd); /* Make mapping mode be in 1/20 of point */ map_mode (hdc); ReleaseDC (hwnd, hdc); } return (0); case WM_KEYDOWN: case WM_SYSKEYDOWN: #if 0 if (! ((wParam >= VK_BACK && wParam <= VK_TAB) || (wParam >= VK_CLEAR && wParam <= VK_RETURN) || (wParam == VK_ESCAPE) || (wParam >= VK_PRIOR && wParam <= VK_HELP) || (wParam >= VK_LWIN && wParam <= VK_APPS) || (wParam >= VK_NUMPAD0 && wParam <= VK_F24) || (wParam >= VK_NUMLOCK && wParam <= VK_SCROLL) || (wParam >= VK_ATTN && wParam <= VK_OEM_CLEAR) || !TranslateMessage (&msg1))) { goto dflt; } #endif /* Check for special characters since translate message seems to always indicate true. */ if (wParam == VK_MENU || wParam == VK_SHIFT || wParam == VK_CONTROL || wParam == VK_CAPITAL) break; /* Anything we do not have a name for needs to be translated or returned as ascii keystroke. */ if (lispy_function_keys[wParam] == 0) { MSG msg1; msg1.hwnd = hwnd; msg1.message = msg; msg1.wParam = wParam; msg1.lParam = lParam; if (TranslateMessage (&msg1)) break; else msg = WM_CHAR; } /* Fall through */ case WM_SYSCHAR: case WM_CHAR: wmsg.dwModifiers = win32_get_modifiers (); my_post_msg (&wmsg, hwnd, msg, wParam, lParam); break; case WM_LBUTTONDOWN: case WM_LBUTTONUP: case WM_MBUTTONDOWN: case WM_MBUTTONUP: case WM_RBUTTONDOWN: case WM_RBUTTONUP: { BOOL up; if (parse_button (msg, NULL, &up)) { if (up) ReleaseCapture (); else SetCapture (hwnd); } } wmsg.dwModifiers = win32_get_modifiers (); my_post_msg (&wmsg, hwnd, msg, wParam, lParam); goto dflt; case WM_MOUSEMOVE: case WM_MOVE: case WM_SIZE: case WM_SETFOCUS: case WM_KILLFOCUS: case WM_CLOSE: case WM_VSCROLL: case WM_SYSCOMMAND: case WM_COMMAND: my_post_msg (&wmsg, hwnd, msg, wParam, lParam); goto dflt; case WM_WINDOWPOSCHANGING: { WINDOWPLACEMENT wp; LPWINDOWPOS lppos = (WINDOWPOS *) lParam; GetWindowPlacement (hwnd, &wp); if (wp.showCmd != SW_SHOWMINIMIZED && ! (lppos->flags & SWP_NOSIZE)) { RECT rect; int wdiff; int hdiff; DWORD dwXUnits; DWORD dwYUnits; RECT wr; GetWindowRect (hwnd, &wr); enter_crit (); dwXUnits = GetWindowLong (hwnd, WND_X_UNITS_INDEX); dwYUnits = GetWindowLong (hwnd, WND_Y_UNITS_INDEX); leave_crit (); memset (&rect, 0, sizeof (rect)); AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE), GetMenu (hwnd) != NULL); /* All windows have an extra pixel so subtract 1 */ wdiff = (lppos->cx - (rect.right - rect.left) - 0) % dwXUnits; hdiff = (lppos->cy - (rect.bottom - rect.top) - 0) % dwYUnits; if (wdiff || hdiff) { /* For right/bottom sizing we can just fix the sizes. However for top/left sizing we will need to fix the X and Y positions as well. */ lppos->cx -= wdiff; lppos->cy -= hdiff; if (wp.showCmd != SW_SHOWMAXIMIZED && ! (lppos->flags & SWP_NOMOVE)) { if (lppos->x != wr.left || lppos->y != wr.top) { lppos->x += wdiff; lppos->y += hdiff; } else { lppos->flags |= SWP_NOMOVE; } } ret = 0; } } } if (ret == 0) return (0); goto dflt; case WM_EMACS_DESTROYWINDOW: DestroyWindow ((HWND) wParam); break; default: dflt: return DefWindowProc (hwnd, msg, wParam, lParam); } return (1); } void my_create_window (f) struct frame * f; { MSG msg; PostThreadMessage (dwWinThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0); GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE); } /* Create and set up the win32 window for frame F. */ static void win32_window (f, window_prompting, minibuffer_only) struct frame *f; long window_prompting; int minibuffer_only; { BLOCK_INPUT; /* Use the resource name as the top-level window name for looking up resources. Make a non-Lisp copy for the window manager, so GC relocation won't bother it. Elsewhere we specify the window name for the window manager. */ { char *str = (char *) XSTRING (Vx_resource_name)->data; f->namebuf = (char *) xmalloc (strlen (str) + 1); strcpy (f->namebuf, str); } my_create_window (f); validate_x_resource_name (); /* x_set_name normally ignores requests to set the name if the requested name is the same as the current name. This is the one place where that assumption isn't correct; f->name is set, but the server hasn't been told. */ { Lisp_Object name; int explicit = f->explicit_name; f->explicit_name = 0; name = f->name; f->name = Qnil; x_set_name (f, name, explicit); } UNBLOCK_INPUT; if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f)) initialize_frame_menubar (f); if (FRAME_WIN32_WINDOW (f) == 0) error ("Unable to create window"); } /* Handle the icon stuff for this window. Perhaps later we might want an x_set_icon_position which can be called interactively as well. */ static void x_icon (f, parms) struct frame *f; Lisp_Object parms; { Lisp_Object icon_x, icon_y; /* Set the position of the icon. Note that win95 groups all icons in the tray. */ icon_x = x_get_arg (parms, Qicon_left, 0, 0, number); icon_y = x_get_arg (parms, Qicon_top, 0, 0, number); if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) { CHECK_NUMBER (icon_x, 0); CHECK_NUMBER (icon_y, 0); } else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) error ("Both left and top icon corners of icon must be specified"); BLOCK_INPUT; if (! EQ (icon_x, Qunbound)) x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y)); UNBLOCK_INPUT; } DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, 1, 1, 0, "Make a new window, which is called a \"frame\" in Emacs terms.\n\ Returns an Emacs frame object.\n\ ALIST is an alist of frame parameters.\n\ If the parameters specify that the frame should not have a minibuffer,\n\ and do not specify a specific minibuffer window to use,\n\ then `default-minibuffer-frame' must be a frame whose minibuffer can\n\ be shared by the new frame.\n\ \n\ This function is an internal primitive--use `make-frame' instead.") (parms) Lisp_Object parms; { struct frame *f; Lisp_Object frame, tem; Lisp_Object name; int minibuffer_only = 0; long window_prompting = 0; int width, height; int count = specpdl_ptr - specpdl; struct gcpro gcpro1; Lisp_Object display; struct win32_display_info *dpyinfo; Lisp_Object parent; struct kboard *kb; /* Use this general default value to start with until we know if this frame has a specified name. */ Vx_resource_name = Vinvocation_name; display = x_get_arg (parms, Qdisplay, 0, 0, string); if (EQ (display, Qunbound)) display = Qnil; dpyinfo = check_x_display_info (display); #ifdef MULTI_KBOARD kb = dpyinfo->kboard; #else kb = &the_only_kboard; #endif name = x_get_arg (parms, Qname, "title", "Title", string); if (!STRINGP (name) && ! EQ (name, Qunbound) && ! NILP (name)) error ("Invalid frame name--not a string or nil"); if (STRINGP (name)) Vx_resource_name = name; /* See if parent window is specified. */ parent = x_get_arg (parms, Qparent_id, NULL, NULL, number); if (EQ (parent, Qunbound)) parent = Qnil; if (! NILP (parent)) CHECK_NUMBER (parent, 0); tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol); if (EQ (tem, Qnone) || NILP (tem)) f = make_frame_without_minibuffer (Qnil, kb, display); else if (EQ (tem, Qonly)) { f = make_minibuffer_frame (); minibuffer_only = 1; } else if (WINDOWP (tem)) f = make_frame_without_minibuffer (tem, kb, display); else f = make_frame (1); /* Note that Windows does support scroll bars. */ FRAME_CAN_HAVE_SCROLL_BARS (f) = 1; XSETFRAME (frame, f); GCPRO1 (frame); f->output_method = output_win32; f->output_data.win32 = (struct win32_output *) xmalloc (sizeof (struct win32_output)); bzero (f->output_data.win32, sizeof (struct win32_output)); /* FRAME_WIN32_DISPLAY_INFO (f) = dpyinfo; */ #ifdef MULTI_KBOARD FRAME_KBOARD (f) = kb; #endif /* Specify the parent under which to make this window. */ if (!NILP (parent)) { f->output_data.win32->parent_desc = (Window) parent; f->output_data.win32->explicit_parent = 1; } else { f->output_data.win32->parent_desc = FRAME_WIN32_DISPLAY_INFO (f)->root_window; f->output_data.win32->explicit_parent = 0; } /* Note that the frame has no physical cursor right now. */ f->phys_cursor_x = -1; /* Set the name; the functions to which we pass f expect the name to be set. */ if (EQ (name, Qunbound) || NILP (name)) { f->name = build_string (dpyinfo->win32_id_name); f->explicit_name = 0; } else { f->name = name; f->explicit_name = 1; /* use the frame's title when getting resources for this frame. */ specbind (Qx_resource_name, name); } /* Extract the window parameters from the supplied values that are needed to determine window geometry. */ { Lisp_Object font; font = x_get_arg (parms, Qfont, "font", "Font", string); BLOCK_INPUT; /* First, try whatever font the caller has specified. */ if (STRINGP (font)) font = x_new_font (f, XSTRING (font)->data); #if 0 /* Try out a font which we hope has bold and italic variations. */ if (!STRINGP (font)) font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1"); if (! STRINGP (font)) font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1"); if (! STRINGP (font)) /* This was formerly the first thing tried, but it finds too many fonts and takes too long. */ font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1"); /* If those didn't work, look for something which will at least work. */ if (! STRINGP (font)) font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1"); if (! STRINGP (font)) font = x_new_font (f, "-*-system-medium-r-normal-*-*-200-*-*-c-120-*-*"); #endif if (! STRINGP (font)) font = x_new_font (f, "-*-terminal-medium-r-normal-*-*-180-*-*-c-120-*-*"); UNBLOCK_INPUT; if (! STRINGP (font)) font = build_string ("-*-system"); x_default_parameter (f, parms, Qfont, font, "font", "Font", string); } x_default_parameter (f, parms, Qborder_width, make_number (2), "borderwidth", "BorderWidth", number); /* This defaults to 2 in order to match xterm. We recognize either internalBorderWidth or internalBorder (which is what xterm calls it). */ if (NILP (Fassq (Qinternal_border_width, parms))) { Lisp_Object value; value = x_get_arg (parms, Qinternal_border_width, "internalBorder", "BorderWidth", number); if (! EQ (value, Qunbound)) parms = Fcons (Fcons (Qinternal_border_width, value), parms); } x_default_parameter (f, parms, Qinternal_border_width, make_number (0), "internalBorderWidth", "BorderWidth", number); x_default_parameter (f, parms, Qvertical_scroll_bars, Qt, "verticalScrollBars", "ScrollBars", boolean); /* Also do the stuff which must be set before the window exists. */ x_default_parameter (f, parms, Qforeground_color, build_string ("black"), "foreground", "Foreground", string); x_default_parameter (f, parms, Qbackground_color, build_string ("white"), "background", "Background", string); x_default_parameter (f, parms, Qmouse_color, build_string ("black"), "pointerColor", "Foreground", string); x_default_parameter (f, parms, Qcursor_color, build_string ("black"), "cursorColor", "Foreground", string); x_default_parameter (f, parms, Qborder_color, build_string ("black"), "borderColor", "BorderColor", string); x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1), "menuBar", "MenuBar", number); x_default_parameter (f, parms, Qscroll_bar_width, Qnil, "scrollBarWidth", "ScrollBarWidth", number); f->output_data.win32->dwStyle = WS_OVERLAPPEDWINDOW; f->output_data.win32->parent_desc = FRAME_WIN32_DISPLAY_INFO (f)->root_window; window_prompting = x_figure_window_size (f, parms); if (window_prompting & XNegative) { if (window_prompting & YNegative) f->output_data.win32->win_gravity = SouthEastGravity; else f->output_data.win32->win_gravity = NorthEastGravity; } else { if (window_prompting & YNegative) f->output_data.win32->win_gravity = SouthWestGravity; else f->output_data.win32->win_gravity = NorthWestGravity; } f->output_data.win32->size_hint_flags = window_prompting; win32_window (f, window_prompting, minibuffer_only); x_icon (f, parms); init_frame_faces (f); /* We need to do this after creating the window, so that the icon-creation functions can say whose icon they're describing. */ x_default_parameter (f, parms, Qicon_type, Qnil, "bitmapIcon", "BitmapIcon", symbol); x_default_parameter (f, parms, Qauto_raise, Qnil, "autoRaise", "AutoRaiseLower", boolean); x_default_parameter (f, parms, Qauto_lower, Qnil, "autoLower", "AutoRaiseLower", boolean); x_default_parameter (f, parms, Qcursor_type, Qbox, "cursorType", "CursorType", symbol); /* Dimensions, especially f->height, must be done via change_frame_size. Change will not be effected unless different from the current f->height. */ width = f->width; height = f->height; f->height = f->width = 0; change_frame_size (f, height, width, 1, 0); /* Tell the server what size and position, etc, we want, and how badly we want them. */ BLOCK_INPUT; x_wm_set_size_hint (f, window_prompting, 0); UNBLOCK_INPUT; tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean); f->no_split = minibuffer_only || EQ (tem, Qt); UNGCPRO; /* It is now ok to make the frame official even if we get an error below. And the frame needs to be on Vframe_list or making it visible won't work. */ Vframe_list = Fcons (frame, Vframe_list); /* Now that the frame is official, it counts as a reference to its display. */ FRAME_WIN32_DISPLAY_INFO (f)->reference_count++; /* Make the window appear on the frame and enable display, unless the caller says not to. However, with explicit parent, Emacs cannot control visibility, so don't try. */ if (! f->output_data.win32->explicit_parent) { Lisp_Object visibility; visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol); if (EQ (visibility, Qunbound)) visibility = Qt; if (EQ (visibility, Qicon)) x_iconify_frame (f); else if (! NILP (visibility)) x_make_frame_visible (f); else /* Must have been Qnil. */ ; } return unbind_to (count, frame); } /* FRAME is used only to get a handle on the X display. We don't pass the display info directly because we're called from frame.c, which doesn't know about that structure. */ Lisp_Object x_get_focus_frame (frame) struct frame *frame; { struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (frame); Lisp_Object xfocus; if (! dpyinfo->win32_focus_frame) return Qnil; XSETFRAME (xfocus, dpyinfo->win32_focus_frame); return xfocus; } DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0, "Set the focus on FRAME.") (frame) Lisp_Object frame; { CHECK_LIVE_FRAME (frame, 0); if (FRAME_WIN32_P (XFRAME (frame))) { BLOCK_INPUT; x_focus_on_frame (XFRAME (frame)); UNBLOCK_INPUT; return frame; } return Qnil; } DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0, "If a frame has been focused, release it.") () { if (FRAME_WIN32_P (selected_frame)) { struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (selected_frame); if (dpyinfo->win32_focus_frame) { BLOCK_INPUT; x_unfocus_frame (dpyinfo->win32_focus_frame); UNBLOCK_INPUT; } } return Qnil; } XFontStruct *win32_load_font (dpyinfo,name) struct win32_display_info *dpyinfo; char * name; { XFontStruct * font = NULL; BOOL ok; { LOGFONT lf; if (!name || !x_to_win32_font(name, &lf)) return (NULL); font = (XFontStruct *) xmalloc (sizeof (XFontStruct)); if (!font) return (NULL); BLOCK_INPUT; font->hfont = CreateFontIndirect(&lf); } if (font->hfont == NULL) { ok = FALSE; } else { HDC hdc; HANDLE oldobj; hdc = my_get_dc (dpyinfo->root_window); oldobj = SelectObject (hdc, font->hfont); ok = GetTextMetrics (hdc, &font->tm); SelectObject (hdc, oldobj); ReleaseDC (dpyinfo->root_window, hdc); } UNBLOCK_INPUT; if (ok) return (font); win32_unload_font(dpyinfo, font); return (NULL); } void win32_unload_font (dpyinfo, font) struct win32_display_info *dpyinfo; XFontStruct * font; { if (font) { if (font->hfont) DeleteObject(font->hfont); xfree (font); } } /* The font conversion stuff between x and win32 */ /* X font string is as follows (from faces.el) * (let ((- "[-?]") * (foundry "[^-]+") * (family "[^-]+") * (weight "\\(bold\\|demibold\\|medium\\)") ; 1 * (weight\? "\\([^-]*\\)") ; 1 * (slant "\\([ior]\\)") ; 2 * (slant\? "\\([^-]?\\)") ; 2 * (swidth "\\([^-]*\\)") ; 3 * (adstyle "[^-]*") ; 4 * (pixelsize "[0-9]+") * (pointsize "[0-9][0-9]+") * (resx "[0-9][0-9]+") * (resy "[0-9][0-9]+") * (spacing "[cmp?*]") * (avgwidth "[0-9]+") * (registry "[^-]+") * (encoding "[^-]+") * ) * (setq x-font-regexp * (concat "\\`\\*?[-?*]" * foundry - family - weight\? - slant\? - swidth - adstyle - * pixelsize - pointsize - resx - resy - spacing - registry - * encoding "[-?*]\\*?\\'" * )) * (setq x-font-regexp-head * (concat "\\`[-?*]" foundry - family - weight\? - slant\? * "\\([-*?]\\|\\'\\)")) * (setq x-font-regexp-slant (concat - slant -)) * (setq x-font-regexp-weight (concat - weight -)) * nil) */ #define FONT_START "[-?]" #define FONT_FOUNDRY "[^-]+" #define FONT_FAMILY "\\([^-]+\\)" /* 1 */ #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */ #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */ #define FONT_SLANT "\\([ior]\\)" /* 3 */ #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */ #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */ #define FONT_ADSTYLE "[^-]*" #define FONT_PIXELSIZE "[^-]*" #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */ #define FONT_RESX "[0-9][0-9]+" #define FONT_RESY "[0-9][0-9]+" #define FONT_SPACING "[cmp?*]" #define FONT_AVGWIDTH "[0-9]+" #define FONT_REGISTRY "[^-]+" #define FONT_ENCODING "[^-]+" #define FONT_REGEXP ("\\`\\*?[-?*]" \ FONT_FOUNDRY "-" \ FONT_FAMILY "-" \ FONT_WEIGHT_Q "-" \ FONT_SLANT_Q "-" \ FONT_SWIDTH "-" \ FONT_ADSTYLE "-" \ FONT_PIXELSIZE "-" \ FONT_POINTSIZE "-" \ "[-?*]\\|\\'") #define FONT_REGEXP_HEAD ("\\`[-?*]" \ FONT_FOUNDRY "-" \ FONT_FAMILY "-" \ FONT_WEIGHT_Q "-" \ FONT_SLANT_Q \ "\\([-*?]\\|\\'\\)") #define FONT_REGEXP_SLANT "-" FONT_SLANT "-" #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-" LONG x_to_win32_weight (lpw) char * lpw; { if (!lpw) return (FW_DONTCARE); if (stricmp (lpw, "bold") == 0) return (FW_BOLD); else if (stricmp (lpw, "demibold") == 0) return (FW_SEMIBOLD); else if (stricmp (lpw, "medium") == 0) return (FW_MEDIUM); else if (stricmp (lpw, "normal") == 0) return (FW_NORMAL); else return (FW_DONTCARE); } char * win32_to_x_weight (fnweight) int fnweight; { if (fnweight >= FW_BOLD) return ("bold"); else if (fnweight >= FW_SEMIBOLD) return ("demibold"); else if (fnweight >= FW_MEDIUM) return ("medium"); else return ("normal"); } BOOL win32_to_x_font (lplogfont, lpxstr, len) LOGFONT * lplogfont; char * lpxstr; int len; { if (!lpxstr) return (FALSE); if (lplogfont) { int height = (lplogfont->lfHeight * 1440) / one_win32_display_info.height_in; int width = (lplogfont->lfWidth * 1440) / one_win32_display_info.width_in; height = abs (height); _snprintf (lpxstr, len - 1, "-*-%s-%s-%c-%s-%s-*-%d-*-*-%c-%d-*-*-", lplogfont->lfFaceName, win32_to_x_weight (lplogfont->lfWeight), lplogfont->lfItalic ? 'i' : 'r', "*", "*", height, ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH) ? 'p' : 'c', width); } else { strncpy (lpxstr, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*-", len - 1); } lpxstr[len - 1] = 0; /* just to be sure */ return (TRUE); } BOOL x_to_win32_font (lpxstr, lplogfont) char * lpxstr; LOGFONT * lplogfont; { if (!lplogfont) return (FALSE); memset (lplogfont, 0, sizeof (*lplogfont)); lplogfont->lfCharSet = OEM_CHARSET; lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS; lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS; lplogfont->lfQuality = DEFAULT_QUALITY; if (lpxstr && *lpxstr == '-') lpxstr++; { int fields; char name[50], weight[20], slant, pitch, height[10], width[10]; fields = (lpxstr ? sscanf (lpxstr, "%*[^-]-%[^-]-%[^-]-%c-%*[^-]-%*[^-]-%*[^-]-%[^-]-%*[^-]-%*[^-]-%c-%[^-]", name, weight, &slant, height, &pitch, width) : 0); if (fields == EOF) return (FALSE); if (fields > 0 && name[0] != '*') { strncpy (lplogfont->lfFaceName, name, LF_FACESIZE); } else { lplogfont->lfFaceName[0] = 0; } fields--; lplogfont->lfWeight = x_to_win32_weight((fields > 0 ? weight : "")); fields--; lplogfont->lfItalic = (fields > 0 && slant == 'i'); fields--; if (fields > 0 && height[0] != '*') lplogfont->lfHeight = (atoi (height) * one_win32_display_info.height_in) / 1440; fields--; lplogfont->lfPitchAndFamily = (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH; fields--; if (fields > 0 && width[0] != '*') lplogfont->lfWidth = (atoi (width) * one_win32_display_info.width_in) / 1440; } return (TRUE); } BOOL win32_font_match (lpszfont1, lpszfont2) char * lpszfont1; char * lpszfont2; { char * s1 = lpszfont1, *e1; char * s2 = lpszfont2, *e2; if (s1 == NULL || s2 == NULL) return (FALSE); if (*s1 == '-') s1++; if (*s2 == '-') s2++; while (1) { int len1, len2; e1 = strchr (s1, '-'); e2 = strchr (s2, '-'); if (e1 == NULL || e2 == NULL) return (TRUE); len1 = e1 - s1; len2 = e2 - s2; if (*s1 != '*' && *s2 != '*' && (len1 != len2 || strnicmp (s1, s2, len1) != 0)) return (FALSE); s1 = e1 + 1; s2 = e2 + 1; } } typedef struct enumfont_t { HDC hdc; int numFonts; XFontStruct *size_ref; Lisp_Object *pattern; Lisp_Object *head; Lisp_Object *tail; } enumfont_t; int CALLBACK enum_font_cb2 (lplf, lptm, FontType, lpef) ENUMLOGFONT * lplf; NEWTEXTMETRIC * lptm; int FontType; enumfont_t * lpef; { if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline || (lplf->elfLogFont.lfCharSet != ANSI_CHARSET && lplf->elfLogFont.lfCharSet != OEM_CHARSET)) return (1); /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */ { char buf[100]; if (!win32_to_x_font (lplf, buf, 100)) return (0); if (NILP (*(lpef->pattern)) || win32_font_match (buf, XSTRING (*(lpef->pattern))->data)) { *lpef->tail = Fcons (build_string (buf), Qnil); lpef->tail = &XCONS (*lpef->tail)->cdr; lpef->numFonts++; } } return (1); } int CALLBACK enum_font_cb1 (lplf, lptm, FontType, lpef) ENUMLOGFONT * lplf; NEWTEXTMETRIC * lptm; int FontType; enumfont_t * lpef; { return EnumFontFamilies (lpef->hdc, lplf->elfLogFont.lfFaceName, (FONTENUMPROC) enum_font_cb2, (LPARAM) lpef); } DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0, "Return a list of the names of available fonts matching PATTERN.\n\ If optional arguments FACE and FRAME are specified, return only fonts\n\ the same size as FACE on FRAME.\n\ \n\ PATTERN is a string, perhaps with wildcard characters;\n\ the * character matches any substring, and\n\ the ? character matches any single character.\n\ PATTERN is case-insensitive.\n\ FACE is a face name--a symbol.\n\ \n\ The return value is a list of strings, suitable as arguments to\n\ set-face-font.\n\ \n\ Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\ even if they match PATTERN and FACE.") (pattern, face, frame) Lisp_Object pattern, face, frame; { int num_fonts; char **names; XFontStruct *info; XFontStruct *size_ref; Lisp_Object namelist; Lisp_Object list; FRAME_PTR f; enumfont_t ef; CHECK_STRING (pattern, 0); if (!NILP (face)) CHECK_SYMBOL (face, 1); f = check_x_frame (frame); /* Determine the width standard for comparison with the fonts we find. */ if (NILP (face)) size_ref = 0; else { int face_id; /* Don't die if we get called with a terminal frame. */ if (! FRAME_WIN32_P (f)) error ("non-win32 frame used in `x-list-fonts'"); face_id = face_name_id_number (f, face); if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f) || FRAME_PARAM_FACES (f) [face_id] == 0) size_ref = f->output_data.win32->font; else { size_ref = FRAME_PARAM_FACES (f) [face_id]->font; if (size_ref == (XFontStruct *) (~0)) size_ref = f->output_data.win32->font; } } /* See if we cached the result for this particular query. */ list = Fassoc (pattern, XCONS (FRAME_WIN32_DISPLAY_INFO (f)->name_list_element)->cdr); /* We have info in the cache for this PATTERN. */ if (!NILP (list)) { Lisp_Object tem, newlist; /* We have info about this pattern. */ list = XCONS (list)->cdr; if (size_ref == 0) return list; BLOCK_INPUT; /* Filter the cached info and return just the fonts that match FACE. */ newlist = Qnil; for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr) { XFontStruct *thisinfo; thisinfo = win32_load_font (FRAME_WIN32_DISPLAY_INFO (f), XSTRING (XCONS (tem)->car)->data); if (thisinfo && same_size_fonts (thisinfo, size_ref)) newlist = Fcons (XCONS (tem)->car, newlist); win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f), thisinfo); } UNBLOCK_INPUT; return newlist; } BLOCK_INPUT; namelist = Qnil; ef.pattern = &pattern; ef.tail = ef.head = &namelist; ef.numFonts = 0; { ef.hdc = my_get_dc (FRAME_WIN32_WINDOW (f)); EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1, (LPARAM)&ef); ReleaseDC (FRAME_WIN32_WINDOW (f), ef.hdc); } UNBLOCK_INPUT; if (ef.numFonts) { int i; Lisp_Object cur; /* Make a list of all the fonts we got back. Store that in the font cache for the display. */ XCONS (FRAME_WIN32_DISPLAY_INFO (f)->name_list_element)->cdr = Fcons (Fcons (pattern, namelist), XCONS (FRAME_WIN32_DISPLAY_INFO (f)->name_list_element)->cdr); /* Make a list of the fonts that have the right width. */ list = Qnil; cur=namelist; for (i = 0; i < ef.numFonts; i++) { int keeper; if (!size_ref) keeper = 1; else { XFontStruct *thisinfo; BLOCK_INPUT; thisinfo = win32_load_font (FRAME_WIN32_DISPLAY_INFO (f), XSTRING (Fcar (cur))->data); keeper = thisinfo && same_size_fonts (thisinfo, size_ref); win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f), thisinfo); UNBLOCK_INPUT; } if (keeper) list = Fcons (build_string (XSTRING (Fcar (cur))->data), list); cur = Fcdr (cur); } list = Fnreverse (list); } return list; } DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0, "Return non-nil if color COLOR is supported on frame FRAME.\n\ If FRAME is omitted or nil, use the selected frame.") (color, frame) Lisp_Object color, frame; { COLORREF foo; FRAME_PTR f = check_x_frame (frame); CHECK_STRING (color, 1); if (defined_color (f, XSTRING (color)->data, &foo, 0)) return Qt; else return Qnil; } DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0, "Return a description of the color named COLOR on frame FRAME.\n\ The value is a list of integer RGB values--(RED GREEN BLUE).\n\ These values appear to range from 0 to 65280 or 65535, depending\n\ on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\ If FRAME is omitted or nil, use the selected frame.") (color, frame) Lisp_Object color, frame; { COLORREF foo; FRAME_PTR f = check_x_frame (frame); CHECK_STRING (color, 1); if (defined_color (f, XSTRING (color)->data, &foo, 0)) { Lisp_Object rgb[3]; rgb[0] = make_number (GetRValue (foo)); rgb[1] = make_number (GetGValue (foo)); rgb[2] = make_number (GetBValue (foo)); return Flist (3, rgb); } else return Qnil; } DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0, "Return t if the X display supports color.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2) return Qnil; return Qt; } DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p, 0, 1, 0, "Return t if the X display supports shades of gray.\n\ Note that color displays do support shades of gray.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1) return Qnil; return Qt; } DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width, 0, 1, 0, "Returns the width in pixels of the X display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); return make_number (dpyinfo->width); } DEFUN ("x-display-pixel-height", Fx_display_pixel_height, Sx_display_pixel_height, 0, 1, 0, "Returns the height in pixels of the X display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); return make_number (dpyinfo->height); } DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes, 0, 1, 0, "Returns the number of bitplanes of the display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); return make_number (dpyinfo->n_planes * dpyinfo->n_cbits); } DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells, 0, 1, 0, "Returns the number of color cells of the display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); HDC hdc; int cap; hdc = my_get_dc (dpyinfo->root_window); cap = GetDeviceCaps (hdc,NUMCOLORS); ReleaseDC (dpyinfo->root_window, hdc); return make_number (cap); } DEFUN ("x-server-max-request-size", Fx_server_max_request_size, Sx_server_max_request_size, 0, 1, 0, "Returns the maximum request size of the server of display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); return make_number (1); } DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, "Returns the vendor ID string of the Win32 system (Microsoft).\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); char *vendor = "Microsoft Corp."; if (! vendor) vendor = ""; return build_string (vendor); } DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0, "Returns the version numbers of the server of display DISPLAY.\n\ The value is a list of three integers: the major and minor\n\ version numbers, and the vendor-specific release\n\ number. See also the function `x-server-vendor'.\n\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); return Fcons (make_number (nt_major_version), Fcons (make_number (nt_minor_version), Qnil)); } DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0, "Returns the number of screens on the server of display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); return make_number (1); } DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0, "Returns the height in millimeters of the X display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); HDC hdc; int cap; hdc = my_get_dc (dpyinfo->root_window); cap = GetDeviceCaps (hdc, VERTSIZE); ReleaseDC (dpyinfo->root_window, hdc); return make_number (cap); } DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0, "Returns the width in millimeters of the X display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); HDC hdc; int cap; hdc = my_get_dc (dpyinfo->root_window); cap = GetDeviceCaps (hdc, HORZSIZE); ReleaseDC (dpyinfo->root_window, hdc); return make_number (cap); } DEFUN ("x-display-backing-store", Fx_display_backing_store, Sx_display_backing_store, 0, 1, 0, "Returns an indication of whether display DISPLAY does backing store.\n\ The value may be `always', `when-mapped', or `not-useful'.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { return intern ("not-useful"); } DEFUN ("x-display-visual-class", Fx_display_visual_class, Sx_display_visual_class, 0, 1, 0, "Returns the visual class of the display DISPLAY.\n\ The value is one of the symbols `static-gray', `gray-scale',\n\ `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); #if 0 switch (dpyinfo->visual->class) { case StaticGray: return (intern ("static-gray")); case GrayScale: return (intern ("gray-scale")); case StaticColor: return (intern ("static-color")); case PseudoColor: return (intern ("pseudo-color")); case TrueColor: return (intern ("true-color")); case DirectColor: return (intern ("direct-color")); default: error ("Display has an unknown visual class"); } #endif error ("Display has an unknown visual class"); } DEFUN ("x-display-save-under", Fx_display_save_under, Sx_display_save_under, 0, 1, 0, "Returns t if the display DISPLAY supports the save-under feature.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); return Qnil; } int x_pixel_width (f) register struct frame *f; { return PIXEL_WIDTH (f); } int x_pixel_height (f) register struct frame *f; { return PIXEL_HEIGHT (f); } int x_char_width (f) register struct frame *f; { return FONT_WIDTH (f->output_data.win32->font); } int x_char_height (f) register struct frame *f; { return f->output_data.win32->line_height; } int x_screen_planes (frame) Lisp_Object frame; { return (FRAME_WIN32_DISPLAY_INFO (XFRAME (frame))->n_planes * FRAME_WIN32_DISPLAY_INFO (XFRAME (frame))->n_cbits); } /* Return the display structure for the display named NAME. Open a new connection if necessary. */ struct win32_display_info * x_display_info_for_name (name) Lisp_Object name; { Lisp_Object names; struct win32_display_info *dpyinfo; CHECK_STRING (name, 0); for (dpyinfo = &one_win32_display_info, names = win32_display_name_list; dpyinfo; dpyinfo = dpyinfo->next, names = XCONS (names)->cdr) { Lisp_Object tem; tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name); if (!NILP (tem)) return dpyinfo; } /* Use this general default value to start with. */ Vx_resource_name = Vinvocation_name; validate_x_resource_name (); dpyinfo = win32_term_init (name, (unsigned char *)0, (char *) XSTRING (Vx_resource_name)->data); if (dpyinfo == 0) error ("Cannot connect to server %s", XSTRING (name)->data); XSETFASTINT (Vwindow_system_version, 3); return dpyinfo; } DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1, 3, 0, "Open a connection to a 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.\n\ If the optional third arg MUST-SUCCEED is non-nil,\n\ terminate Emacs if we can't open the connection.") (display, xrm_string, must_succeed) Lisp_Object display, xrm_string, must_succeed; { unsigned int n_planes; unsigned char *xrm_option; struct win32_display_info *dpyinfo; CHECK_STRING (display, 0); if (! NILP (xrm_string)) CHECK_STRING (xrm_string, 1); Vwin32_color_map = Fwin32_default_color_map (); if (! NILP (xrm_string)) xrm_option = (unsigned char *) XSTRING (xrm_string)->data; else xrm_option = (unsigned char *) 0; /* Use this general default value to start with. */ Vx_resource_name = Vinvocation_name; validate_x_resource_name (); /* This is what opens the connection and sets x_current_display. This also initializes many symbols, such as those used for input. */ dpyinfo = win32_term_init (display, xrm_option, (char *) XSTRING (Vx_resource_name)->data); if (dpyinfo == 0) { if (!NILP (must_succeed)) fatal ("Cannot connect to server %s.\n", XSTRING (display)->data); else error ("Cannot connect to server %s", XSTRING (display)->data); } XSETFASTINT (Vwindow_system_version, 3); return Qnil; } DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection, 1, 1, 0, "Close the connection to DISPLAY's server.\n\ For DISPLAY, specify either a frame or a display name (a string).\n\ If DISPLAY is nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct win32_display_info *dpyinfo = check_x_display_info (display); struct win32_display_info *tail; int i; if (dpyinfo->reference_count > 0) error ("Display still has frames on it"); BLOCK_INPUT; /* Free the fonts in the font table. */ for (i = 0; i < dpyinfo->n_fonts; i++) { if (dpyinfo->font_table[i].name) free (dpyinfo->font_table[i].name); /* Don't free the full_name string; it is always shared with something else. */ win32_unload_font (dpyinfo, dpyinfo->font_table[i].font); } x_destroy_all_bitmaps (dpyinfo); x_delete_display (dpyinfo); UNBLOCK_INPUT; return Qnil; } DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0, "Return the list of display names that Emacs has connections to.") () { Lisp_Object tail, result; result = Qnil; for (tail = win32_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr) result = Fcons (XCONS (XCONS (tail)->car)->car, result); return result; } DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0, "If ON is non-nil, report errors as soon as the erring request is made.\n\ If ON is nil, allow buffering of requests.\n\ This is a noop on Win32 systems.\n\ The optional second argument DISPLAY specifies which display to act on.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If DISPLAY is omitted or nil, that stands for the selected frame's display.") (on, display) Lisp_Object display, on; { struct win32_display_info *dpyinfo = check_x_display_info (display); return Qnil; } /* These are the win32 specialized functions */ DEFUN ("win32-select-font", Fwin32_select_font, Swin32_select_font, 0, 1, 0, "This will display the Win32 font dialog and return an X font string corresponding to the selection.") (frame) Lisp_Object frame; { FRAME_PTR f = check_x_frame (frame); CHOOSEFONT cf; LOGFONT lf; char buf[100]; bzero (&cf, sizeof (cf)); cf.lStructSize = sizeof (cf); cf.hwndOwner = FRAME_WIN32_WINDOW (f); cf.Flags = CF_FIXEDPITCHONLY | CF_FORCEFONTEXIST | CF_SCREENFONTS; cf.lpLogFont = &lf; if (!ChooseFont (&cf) || !win32_to_x_font (&lf, buf, 100)) return Qnil; return build_string (buf); } syms_of_win32fns () { /* The section below is built by the lisp expression at the top of the file, just above where these variables are declared. */ /*&&& init symbols here &&&*/ Qauto_raise = intern ("auto-raise"); staticpro (&Qauto_raise); Qauto_lower = intern ("auto-lower"); staticpro (&Qauto_lower); Qbackground_color = intern ("background-color"); staticpro (&Qbackground_color); Qbar = intern ("bar"); staticpro (&Qbar); Qborder_color = intern ("border-color"); staticpro (&Qborder_color); Qborder_width = intern ("border-width"); staticpro (&Qborder_width); Qbox = intern ("box"); staticpro (&Qbox); Qcursor_color = intern ("cursor-color"); staticpro (&Qcursor_color); Qcursor_type = intern ("cursor-type"); staticpro (&Qcursor_type); Qfont = intern ("font"); staticpro (&Qfont); Qforeground_color = intern ("foreground-color"); staticpro (&Qforeground_color); Qgeometry = intern ("geometry"); staticpro (&Qgeometry); Qicon_left = intern ("icon-left"); staticpro (&Qicon_left); Qicon_top = intern ("icon-top"); staticpro (&Qicon_top); Qicon_type = intern ("icon-type"); staticpro (&Qicon_type); Qicon_name = intern ("icon-name"); staticpro (&Qicon_name); Qinternal_border_width = intern ("internal-border-width"); staticpro (&Qinternal_border_width); Qleft = intern ("left"); staticpro (&Qleft); Qmouse_color = intern ("mouse-color"); staticpro (&Qmouse_color); Qnone = intern ("none"); staticpro (&Qnone); Qparent_id = intern ("parent-id"); staticpro (&Qparent_id); Qscroll_bar_width = intern ("scroll-bar-width"); staticpro (&Qscroll_bar_width); Qsuppress_icon = intern ("suppress-icon"); staticpro (&Qsuppress_icon); Qtop = intern ("top"); staticpro (&Qtop); Qundefined_color = intern ("undefined-color"); staticpro (&Qundefined_color); Qvertical_scroll_bars = intern ("vertical-scroll-bars"); staticpro (&Qvertical_scroll_bars); Qvisibility = intern ("visibility"); staticpro (&Qvisibility); Qwindow_id = intern ("window-id"); staticpro (&Qwindow_id); Qx_frame_parameter = intern ("x-frame-parameter"); staticpro (&Qx_frame_parameter); Qx_resource_name = intern ("x-resource-name"); staticpro (&Qx_resource_name); Quser_position = intern ("user-position"); staticpro (&Quser_position); Quser_size = intern ("user-size"); staticpro (&Quser_size); Qdisplay = intern ("display"); staticpro (&Qdisplay); /* This is the end of symbol initialization. */ Fput (Qundefined_color, Qerror_conditions, Fcons (Qundefined_color, Fcons (Qerror, Qnil))); Fput (Qundefined_color, Qerror_message, build_string ("Undefined color")); DEFVAR_LISP ("win32-color-map", &Vwin32_color_map, "A array of color name mappings for windows."); Vwin32_color_map = Qnil; init_x_parm_symbols (); DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path, "List of directories to search for bitmap files for win32."); Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH"); DEFVAR_LISP ("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 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; Vx_nontext_pointer_shape = Qnil; Vx_mode_pointer_shape = Qnil; DEFVAR_INT ("x-sensitive-text-pointer-shape", &Vx_sensitive_text_pointer_shape, "The shape of the pointer when over mouse-sensitive text.\n\ This variable takes effect when you create a new frame\n\ or when you set the mouse color."); Vx_sensitive_text_pointer_shape = Qnil; DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel, "A string indicating the foreground color of the cursor box."); Vx_cursor_fore_pixel = Qnil; DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager, "Non-nil if no window manager is in use.\n\ Emacs doesn't try to figure this out; this is always nil\n\ unless you set it to something else."); /* We don't have any way to find this out, so set it to nil and maybe the user would like to set it to t. */ Vx_no_window_manager = Qnil; defsubr (&Sx_get_resource); defsubr (&Sx_list_fonts); defsubr (&Sx_display_color_p); defsubr (&Sx_display_grayscale_p); defsubr (&Sx_color_defined_p); defsubr (&Sx_color_values); defsubr (&Sx_server_max_request_size); defsubr (&Sx_server_vendor); defsubr (&Sx_server_version); defsubr (&Sx_display_pixel_width); defsubr (&Sx_display_pixel_height); defsubr (&Sx_display_mm_width); defsubr (&Sx_display_mm_height); defsubr (&Sx_display_screens); defsubr (&Sx_display_planes); defsubr (&Sx_display_color_cells); defsubr (&Sx_display_visual_class); defsubr (&Sx_display_backing_store); defsubr (&Sx_display_save_under); defsubr (&Sx_parse_geometry); defsubr (&Sx_create_frame); defsubr (&Sfocus_frame); defsubr (&Sunfocus_frame); defsubr (&Sx_open_connection); defsubr (&Sx_close_connection); defsubr (&Sx_display_list); defsubr (&Sx_synchronize); /* Win32 specific functions */ defsubr (&Swin32_select_font); } #undef abort void win32_abort() { MessageBox (NULL, "A fatal error has occurred - aborting!", "Emacs Abort Dialog", MB_OK|MB_ICONEXCLAMATION); abort(); } emacs-19.30/src/w32menu.c100444 23073 1 136041 6047606405 14266 0ustar voelkerdaemon/* X Communication module for terminals which understand the X protocol. Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc. This file is part of GNU Emacs. 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. */ /* Written by Kevin Gallo. */ #include #include #include #include "lisp.h" #include "termhooks.h" #include "frame.h" #include "window.h" #include "keyboard.h" #include "blockinput.h" /* This may include sys/types.h, and that somehow loses if this is not done before the other system files. */ #include "w32term.h" /* Load sys/types.h if not already loaded. In some systems loading it twice is suicidal. */ #ifndef makedev #include #endif #include "dispextern.h" #define min(x, y) (((x) < (y)) ? (x) : (y)) #define max(x, y) (((x) > (y)) ? (x) : (y)) typedef struct menu_map { Lisp_Object menu_items; int menu_items_allocated; int menu_items_used; } menu_map; extern Lisp_Object Qmenu_enable; extern Lisp_Object Qmenu_bar; static Lisp_Object win32_dialog_show (); static Lisp_Object win32menu_show (); static HMENU keymap_panes (); static HMENU single_keymap_panes (); static HMENU list_of_panes (); static HMENU list_of_items (); static HMENU create_menu_items (); /* Initialize the menu_items structure if we haven't already done so. Also mark it as currently empty. */ static void init_menu_items (lpmm) menu_map * lpmm; { if (NILP (lpmm->menu_items)) { lpmm->menu_items_allocated = 60; lpmm->menu_items = Fmake_vector (make_number (lpmm->menu_items_allocated), Qnil); } lpmm->menu_items_used = 0; } /* Call when finished using the data for the current menu in menu_items. */ static void discard_menu_items (lpmm) menu_map * lpmm; { lpmm->menu_items = Qnil; lpmm->menu_items_allocated = lpmm->menu_items_used = 0; } /* Make the menu_items vector twice as large. */ static void grow_menu_items (lpmm) menu_map * lpmm; { Lisp_Object new; int old_size = lpmm->menu_items_allocated; lpmm->menu_items_allocated *= 2; new = Fmake_vector (make_number (lpmm->menu_items_allocated), Qnil); bcopy (XVECTOR (lpmm->menu_items)->contents, XVECTOR (new)->contents, old_size * sizeof (Lisp_Object)); lpmm->menu_items = new; } /* Indicate boundary between left and right. */ static void add_left_right_boundary (hmenu) HMENU hmenu; { AppendMenu (hmenu, MF_MENUBARBREAK, 0, NULL); } /* Push one menu item into the current pane. NAME is the string to display. ENABLE if non-nil means this item can be selected. KEY is the key generated by choosing this item. EQUIV is the textual description of the keyboard equivalent for this item (or nil if none). */ static void add_menu_item (lpmm, hmenu, name, enable, key) menu_map * lpmm; HMENU hmenu; Lisp_Object name; UINT enable; Lisp_Object key; { UINT fuFlags; if (NILP (name) || ((char *) XSTRING (name)->data)[0] == 0 || strcmp ((char *) XSTRING (name)->data, "--") == 0) fuFlags = MF_SEPARATOR; else if (enable) fuFlags = MF_STRING; else fuFlags = MF_STRING | MF_GRAYED; AppendMenu (hmenu, fuFlags, lpmm->menu_items_used + 1, (fuFlags == MF_SEPARATOR)?NULL: (char *) XSTRING (name)->data); lpmm->menu_items_used++; #if 0 if (lpmm->menu_items_used >= lpmm->menu_items_allocated) grow_menu_items (lpmm); XSET (XVECTOR (lpmm->menu_items)->contents[lpmm->menu_items_used++], Lisp_Cons, key); #endif } /* Figure out the current keyboard equivalent of a menu item ITEM1. The item string for menu display should be ITEM_STRING. Store the equivalent keyboard key sequence's textual description into *DESCRIP_PTR. Also cache them in the item itself. Return the real definition to execute. */ static Lisp_Object menu_item_equiv_key (item_string, item1, descrip_ptr) Lisp_Object item_string; Lisp_Object item1; Lisp_Object *descrip_ptr; { /* This is the real definition--the function to run. */ Lisp_Object def; /* This is the sublist that records cached equiv key data so we can save time. */ Lisp_Object cachelist; /* These are the saved equivalent keyboard key sequence and its key-description. */ Lisp_Object savedkey, descrip; Lisp_Object def1; int changed = 0; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; /* If a help string follows the item string, skip it. */ if (CONSP (XCONS (item1)->cdr) && STRINGP (XCONS (XCONS (item1)->cdr)->car)) item1 = XCONS (item1)->cdr; def = Fcdr (item1); /* Get out the saved equivalent-keyboard-key info. */ cachelist = savedkey = descrip = Qnil; if (CONSP (def) && CONSP (XCONS (def)->car) && (NILP (XCONS (XCONS (def)->car)->car) || VECTORP (XCONS (XCONS (def)->car)->car))) { cachelist = XCONS (def)->car; def = XCONS (def)->cdr; savedkey = XCONS (cachelist)->car; descrip = XCONS (cachelist)->cdr; } GCPRO4 (def, def1, savedkey, descrip); /* Is it still valid? */ def1 = Qnil; if (!NILP (savedkey)) def1 = Fkey_binding (savedkey, Qnil); /* If not, update it. */ if (! EQ (def1, def) /* If the command is an alias for another (such as easymenu.el and lmenu.el set it up), check if the original command matches the cached command. */ && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function) && EQ (def1, XSYMBOL (def)->function)) /* If something had no key binding before, don't recheck it-- doing that takes too much time and makes menus too slow. */ && !(!NILP (cachelist) && NILP (savedkey))) { changed = 1; descrip = Qnil; savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil); /* If the command is an alias for another (such as easymenu.el and lmenu.el set it up), see if the original command name has equivalent keys. */ if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)) savedkey = Fwhere_is_internal (XSYMBOL (def)->function, Qnil, Qt, Qnil); if (VECTORP (savedkey) && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar)) savedkey = Qnil; if (!NILP (savedkey)) { descrip = Fkey_description (savedkey); descrip = concat2 (make_string (" (", 3), descrip); descrip = concat2 (descrip, make_string (")", 1)); } } /* Cache the data we just got in a sublist of the menu binding. */ if (NILP (cachelist)) XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def); else if (changed) { XCONS (cachelist)->car = savedkey; XCONS (cachelist)->cdr = descrip; } UNGCPRO; *descrip_ptr = descrip; return def; } /* This is used as the handler when calling internal_condition_case_1. */ static Lisp_Object menu_item_enabled_p_1 (arg) Lisp_Object arg; { return Qnil; } /* Return non-nil if the command DEF is enabled when used as a menu item. This is based on looking for a menu-enable property. If NOTREAL is set, don't bother really computing this. */ static Lisp_Object menu_item_enabled_p (def, notreal) Lisp_Object def; { Lisp_Object enabled, tem; enabled = Qt; if (notreal) return enabled; if (XTYPE (def) == Lisp_Symbol) { /* No property, or nil, means enable. Otherwise, enable if value is not nil. */ tem = Fget (def, Qmenu_enable); if (!NILP (tem)) /* (condition-case nil (eval tem) (error nil)) */ enabled = internal_condition_case_1 (Feval, tem, Qerror, menu_item_enabled_p_1); } return enabled; } /* Look through KEYMAPS, a vector of keymaps that is NMAPS long, and generate menu panes for them in menu_items. If NOTREAL is nonzero, don't bother really computing whether an item is enabled. */ static HMENU keymap_panes (lpmm, keymaps, nmaps, notreal) menu_map * lpmm; Lisp_Object *keymaps; int nmaps; int notreal; { int mapno; // init_menu_items (lpmm); if (nmaps > 1) { HMENU hmenu; if (!notreal) { hmenu = CreateMenu (); if (!hmenu) return (NULL); } else { hmenu = NULL; } /* Loop over the given keymaps, making a pane for each map. But don't make a pane that is empty--ignore that map instead. P is the number of panes we have made so far. */ for (mapno = 0; mapno < nmaps; mapno++) { HMENU new_hmenu; new_hmenu = single_keymap_panes (lpmm, keymaps[mapno], Qnil, Qnil, notreal); if (!notreal && new_hmenu) { AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, ""); } } return (hmenu); } else { return (single_keymap_panes (lpmm, keymaps[0], Qnil, Qnil, notreal)); } } /* This is a recursive subroutine of keymap_panes. It handles one keymap, KEYMAP. The other arguments are passed along or point to local variables of the previous function. If NOTREAL is nonzero, don't bother really computing whether an item is enabled. */ HMENU single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal) menu_map * lpmm; Lisp_Object keymap; Lisp_Object pane_name; Lisp_Object prefix; int notreal; { Lisp_Object pending_maps; Lisp_Object tail, item, item1, item_string, table; HMENU hmenu; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; if (!notreal) { hmenu = CreateMenu (); if (hmenu == NULL) return NULL; } else { hmenu = NULL; } pending_maps = Qnil; for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) { /* Look at each key binding, and if it has a menu string, make a menu item from it. */ item = XCONS (tail)->car; if (CONSP (item)) { item1 = XCONS (item)->cdr; if (XTYPE (item1) == Lisp_Cons) { item_string = XCONS (item1)->car; if (XTYPE (item_string) == Lisp_String) { /* This is the real definition--the function to run. */ Lisp_Object def; /* These are the saved equivalent keyboard key sequence and its key-description. */ Lisp_Object descrip; Lisp_Object tem, enabled; /* GCPRO because ...enabled_p will call eval and ..._equiv_key may autoload something. Protecting KEYMAP preserves everything we use; aside from that, must protect whatever might be a string. Since there's no GCPRO5, we refetch item_string instead of protecting it. */ descrip = def = Qnil; GCPRO4 (keymap, pending_maps, def, prefix); def = menu_item_equiv_key (item_string, item1, &descrip); enabled = menu_item_enabled_p (def, notreal); UNGCPRO; item_string = XCONS (item1)->car; tem = Fkeymapp (def); if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) { pending_maps = Fcons (Fcons (def, Fcons (item_string, XCONS (item)->car)), pending_maps); } else { Lisp_Object submap; GCPRO4 (keymap, pending_maps, item, item_string); submap = get_keymap_1 (def, 0, 1); UNGCPRO; if (NILP (submap)) { if (!notreal) { add_menu_item (lpmm, hmenu, item_string, !NILP (enabled), Fcons (XCONS (item)->car, prefix)); } } else /* Display a submenu. */ { HMENU new_hmenu = single_keymap_panes (lpmm, submap, item_string, XCONS (item)->car, notreal); if (!notreal) { AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, (char *) XSTRING (item_string)->data); } } } } } } else if (VECTORP (item)) { /* Loop over the char values represented in the vector. */ int len = XVECTOR (item)->size; int c; for (c = 0; c < len; c++) { Lisp_Object character; XSETFASTINT (character, c); item1 = XVECTOR (item)->contents[c]; if (CONSP (item1)) { item_string = XCONS (item1)->car; if (STRINGP (item_string)) { Lisp_Object def; /* These are the saved equivalent keyboard key sequence and its key-description. */ Lisp_Object descrip; Lisp_Object tem, enabled; /* GCPRO because ...enabled_p will call eval and ..._equiv_key may autoload something. Protecting KEYMAP preserves everything we use; aside from that, must protect whatever might be a string. Since there's no GCPRO5, we refetch item_string instead of protecting it. */ GCPRO4 (keymap, pending_maps, def, descrip); descrip = def = Qnil; def = menu_item_equiv_key (item_string, item1, &descrip); enabled = menu_item_enabled_p (def, notreal); UNGCPRO; item_string = XCONS (item1)->car; tem = Fkeymapp (def); if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) pending_maps = Fcons (Fcons (def, Fcons (item_string, character)), pending_maps); else { Lisp_Object submap; GCPRO4 (keymap, pending_maps, descrip, item_string); submap = get_keymap_1 (def, 0, 1); UNGCPRO; if (NILP (submap)) { if (!notreal) { add_menu_item (lpmm, hmenu, item_string, !NILP (enabled), character); } } else /* Display a submenu. */ { HMENU new_hmenu = single_keymap_panes (lpmm, submap, Qnil, character, notreal); if (!notreal) { AppendMenu (hmenu,MF_POPUP, (UINT)new_hmenu, (char *)XSTRING (item_string)->data); } } } } } } } } /* Process now any submenus which want to be panes at this level. */ while (!NILP (pending_maps)) { Lisp_Object elt, eltcdr, string; elt = Fcar (pending_maps); eltcdr = XCONS (elt)->cdr; string = XCONS (eltcdr)->car; /* We no longer discard the @ from the beginning of the string here. Instead, we do this in win32menu_show. */ { HMENU new_hmenu = single_keymap_panes (lpmm, Fcar (elt), string, XCONS (eltcdr)->cdr, notreal); if (!notreal) { AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, (char *) XSTRING (string)->data); } } pending_maps = Fcdr (pending_maps); } return (hmenu); } /* Push all the panes and items of a menu decsribed by the alist-of-alists MENU. This handles old-fashioned calls to x-popup-menu. */ static HMENU list_of_panes (lpmm, menu) menu_map * lpmm; Lisp_Object menu; { Lisp_Object tail; HMENU hmenu; hmenu = CreateMenu (); if (hmenu == NULL) return NULL; // init_menu_items (lpmm); for (tail = menu; !NILP (tail); tail = Fcdr (tail)) { Lisp_Object elt, pane_name, pane_data; HMENU new_hmenu; elt = Fcar (tail); pane_name = Fcar (elt); CHECK_STRING (pane_name, 0); pane_data = Fcdr (elt); CHECK_CONS (pane_data, 0); new_hmenu = list_of_items (lpmm, pane_data); if (new_hmenu == NULL) goto error; AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, (char *) XSTRING (pane_name)->data); } return (hmenu); error: DestroyMenu (hmenu); return (NULL); } /* Push the items in a single pane defined by the alist PANE. */ static HMENU list_of_items (lpmm, pane) menu_map * lpmm; Lisp_Object pane; { Lisp_Object tail, item, item1; HMENU hmenu; hmenu = CreateMenu (); if (hmenu == NULL) return NULL; for (tail = pane; !NILP (tail); tail = Fcdr (tail)) { item = Fcar (tail); if (STRINGP (item)) add_menu_item (lpmm, hmenu, item, Qnil, Qnil); else if (NILP (item)) add_left_right_boundary (); else { CHECK_CONS (item, 0); item1 = Fcar (item); CHECK_STRING (item1, 1); add_menu_item (lpmm, hmenu, item1, Qt, Fcdr (item)); } } return (hmenu); } HMENU create_menu_items (lpmm, menu, notreal) menu_map * lpmm; Lisp_Object menu; int notreal; { Lisp_Object title; Lisp_Object keymap, tem; HMENU hmenu; title = Qnil; /* Decode the menu items from what was specified. */ keymap = Fkeymapp (menu); tem = Qnil; if (XTYPE (menu) == Lisp_Cons) tem = Fkeymapp (Fcar (menu)); if (!NILP (keymap)) { /* We were given a keymap. Extract menu info from the keymap. */ Lisp_Object prompt; keymap = get_keymap (menu); /* Extract the detailed info to make one pane. */ hmenu = keymap_panes (lpmm, &keymap, 1, notreal); #if 0 /* Search for a string appearing directly as an element of the keymap. That string is the title of the menu. */ prompt = map_prompt (keymap); /* Make that be the pane title of the first pane. */ if (!NILP (prompt) && menu_items_n_panes >= 0) XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt; #endif } else if (!NILP (tem)) { /* We were given a list of keymaps. */ int nmaps = XFASTINT (Flength (menu)); Lisp_Object *maps = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); int i; title = Qnil; /* The first keymap that has a prompt string supplies the menu title. */ for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) { Lisp_Object prompt; maps[i++] = keymap = get_keymap (Fcar (tem)); #if 0 prompt = map_prompt (keymap); if (NILP (title) && !NILP (prompt)) title = prompt; #endif } /* Extract the detailed info to make one pane. */ hmenu = keymap_panes (lpmm, maps, nmaps, notreal); #if 0 /* Make the title be the pane title of the first pane. */ if (!NILP (title) && menu_items_n_panes >= 0) XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title; #endif } else { /* We were given an old-fashioned menu. */ title = Fcar (menu); CHECK_STRING (title, 1); hmenu = list_of_panes (lpmm, Fcdr (menu)); } return (hmenu); } /* This is a recursive subroutine of keymap_panes. It handles one keymap, KEYMAP. The other arguments are passed along or point to local variables of the previous function. If NOTREAL is nonzero, don't bother really computing whether an item is enabled. */ Lisp_Object get_single_keymap_event (keymap, lpnum) Lisp_Object keymap; int * lpnum; { Lisp_Object pending_maps; Lisp_Object tail, item, item1, item_string, table; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; pending_maps = Qnil; for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) { /* Look at each key binding, and if it has a menu string, make a menu item from it. */ item = XCONS (tail)->car; if (XTYPE (item) == Lisp_Cons) { item1 = XCONS (item)->cdr; if (CONSP (item1)) { item_string = XCONS (item1)->car; if (XTYPE (item_string) == Lisp_String) { /* This is the real definition--the function to run. */ Lisp_Object def; /* These are the saved equivalent keyboard key sequence and its key-description. */ Lisp_Object descrip; Lisp_Object tem, enabled; /* GCPRO because ...enabled_p will call eval and ..._equiv_key may autoload something. Protecting KEYMAP preserves everything we use; aside from that, must protect whatever might be a string. Since there's no GCPRO5, we refetch item_string instead of protecting it. */ descrip = def = Qnil; GCPRO3 (keymap, pending_maps, def); def = menu_item_equiv_key (item_string, item1, &descrip); UNGCPRO; item_string = XCONS (item1)->car; tem = Fkeymapp (def); if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) { pending_maps = Fcons (Fcons (def, Fcons (item_string, XCONS (item)->car)), pending_maps); } else { Lisp_Object submap; GCPRO4 (keymap, pending_maps, item, item_string); submap = get_keymap_1 (def, 0, 1); UNGCPRO; if (NILP (submap)) { if (--(*lpnum) == 0) { return (Fcons (XCONS (item)->car, Qnil)); } } else /* Display a submenu. */ { Lisp_Object event = get_single_keymap_event (submap, lpnum); if (*lpnum <= 0) { if (!NILP (XCONS (item)->car)) event = Fcons (XCONS (item)->car, event); return (event); } } } } } } else if (VECTORP (item)) { /* Loop over the char values represented in the vector. */ int len = XVECTOR (item)->size; int c; for (c = 0; c < len; c++) { Lisp_Object character; XSETFASTINT (character, c); item1 = XVECTOR (item)->contents[c]; if (XTYPE (item1) == Lisp_Cons) { item_string = XCONS (item1)->car; if (XTYPE (item_string) == Lisp_String) { Lisp_Object def; /* These are the saved equivalent keyboard key sequence and its key-description. */ Lisp_Object descrip; Lisp_Object tem, enabled; /* GCPRO because ...enabled_p will call eval and ..._equiv_key may autoload something. Protecting KEYMAP preserves everything we use; aside from that, must protect whatever might be a string. Since there's no GCPRO5, we refetch item_string instead of protecting it. */ GCPRO4 (keymap, pending_maps, def, descrip); descrip = def = Qnil; def = menu_item_equiv_key (item_string, item1, &descrip); UNGCPRO; item_string = XCONS (item1)->car; tem = Fkeymapp (def); if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) pending_maps = Fcons (Fcons (def, Fcons (item_string, character)), pending_maps); else { Lisp_Object submap; GCPRO4 (keymap, pending_maps, descrip, item_string); submap = get_keymap_1 (def, 0, 1); UNGCPRO; if (NILP (submap)) { if (--(*lpnum) == 0) { return (Fcons (character, Qnil)); } } else /* Display a submenu. */ { Lisp_Object event = get_single_keymap_event (submap, lpnum); if (*lpnum <= 0) { if (!NILP (character)) event = Fcons (character, event); return (event); } } } } } } } } /* Process now any submenus which want to be panes at this level. */ while (!NILP (pending_maps)) { Lisp_Object elt, eltcdr, string; elt = Fcar (pending_maps); eltcdr = XCONS (elt)->cdr; string = XCONS (eltcdr)->car; /* We no longer discard the @ from the beginning of the string here. Instead, we do this in win32menu_show. */ { Lisp_Object event = get_single_keymap_event (Fcar (elt), lpnum); if (*lpnum <= 0) { if (!NILP (XCONS (eltcdr)->cdr)) event = Fcons (XCONS (eltcdr)->cdr, event); return (event); } } pending_maps = Fcdr (pending_maps); } return (Qnil); } /* Look through KEYMAPS, a vector of keymaps that is NMAPS long, and generate menu panes for them in menu_items. If NOTREAL is nonzero, don't bother really computing whether an item is enabled. */ static Lisp_Object get_keymap_event (keymaps, nmaps, lpnum) Lisp_Object *keymaps; int nmaps; int * lpnum; { int mapno; Lisp_Object event = Qnil; /* Loop over the given keymaps, making a pane for each map. But don't make a pane that is empty--ignore that map instead. P is the number of panes we have made so far. */ for (mapno = 0; mapno < nmaps; mapno++) { event = get_single_keymap_event (keymaps[mapno], lpnum); if (*lpnum <= 0) break; } return (event); } static Lisp_Object get_list_of_items_event (pane, lpnum) Lisp_Object pane; int * lpnum; { Lisp_Object tail, item, item1; for (tail = pane; !NILP (tail); tail = Fcdr (tail)) { item = Fcar (tail); if (STRINGP (item)) { if (-- (*lpnum) == 0) { return (Qnil); } } else if (!NILP (item)) { if (--(*lpnum) == 0) { CHECK_CONS (item, 0); return (Fcdr (item)); } } } return (Qnil); } /* Push all the panes and items of a menu decsribed by the alist-of-alists MENU. This handles old-fashioned calls to x-popup-menu. */ static Lisp_Object get_list_of_panes_event (menu, lpnum) Lisp_Object menu; int * lpnum; { Lisp_Object tail; for (tail = menu; !NILP (tail); tail = Fcdr (tail)) { Lisp_Object elt, pane_name, pane_data; Lisp_Object event; elt = Fcar (tail); pane_data = Fcdr (elt); CHECK_CONS (pane_data, 0); event = get_list_of_items_event (pane_data, lpnum); if (*lpnum <= 0) { return (event); } } return (Qnil); } Lisp_Object get_menu_event (menu, lpnum) Lisp_Object menu; int * lpnum; { Lisp_Object keymap, tem; Lisp_Object event; /* Decode the menu items from what was specified. */ keymap = Fkeymapp (menu); tem = Qnil; if (XTYPE (menu) == Lisp_Cons) tem = Fkeymapp (Fcar (menu)); if (!NILP (keymap)) { keymap = get_keymap (menu); event = get_keymap_event (menu, 1, lpnum); } else if (!NILP (tem)) { /* We were given a list of keymaps. */ int nmaps = XFASTINT (Flength (menu)); Lisp_Object *maps = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); int i; /* The first keymap that has a prompt string supplies the menu title. */ for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) { Lisp_Object prompt; maps[i++] = keymap = get_keymap (Fcar (tem)); } event = get_keymap_event (maps, nmaps, lpnum); } else { /* We were given an old-fashioned menu. */ event = get_list_of_panes_event (Fcdr (menu), lpnum); } return (event); } DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0, "Pop up a deck-of-cards menu and return user's selection.\n\ POSITION is a position specification. This is either a mouse button event\n\ or a list ((XOFFSET YOFFSET) WINDOW)\n\ where XOFFSET and YOFFSET are positions in pixels from the top left\n\ corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\ This controls the position of the center of the first line\n\ in the first pane of the menu, not the top left of the menu as a whole.\n\ If POSITION is t, it means to use the current mouse position.\n\ \n\ MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\ The menu items come from key bindings that have a menu string as well as\n\ a definition; actually, the \"definition\" in such a key binding looks like\n\ \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\ the keymap as a top-level element.\n\n\ You can also use a list of keymaps as MENU.\n\ Then each keymap makes a separate pane.\n\ When MENU is a keymap or a list of keymaps, the return value\n\ is a list of events.\n\n\ Alternatively, you can specify a menu of multiple panes\n\ with a list of the form (TITLE PANE1 PANE2...),\n\ where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\ Each ITEM is normally a cons cell (STRING . VALUE);\n\ but a string can appear as an item--that makes a nonselectable line\n\ in the menu.\n\ With this form of menu, the return value is VALUE from the chosen item.\n\ \n\ If POSITION is nil, don't display the menu at all, just precalculate the\n\ cached information about equivalent key sequences.") (position, menu) Lisp_Object position, menu; { int number_of_panes, panes; Lisp_Object keymap, tem; int xpos, ypos; Lisp_Object title; char *error_name; Lisp_Object selection; int i, j; FRAME_PTR f; Lisp_Object x, y, window; int keymaps = 0; int menubarp = 0; struct gcpro gcpro1; HMENU hmenu; menu_map mm; if (! NILP (position)) { /* Decode the first argument: find the window and the coordinates. */ if (EQ (position, Qt)) { /* Use the mouse's current position. */ FRAME_PTR new_f = 0; Lisp_Object bar_window; int part; unsigned long time; if (mouse_position_hook) (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time); if (new_f != 0) XSETFRAME (window, new_f); else { window = selected_window; XSETFASTINT (x, 0); XSETFASTINT (y, 0); } } else { tem = Fcar (position); if (CONSP (tem)) { window = Fcar (Fcdr (position)); x = Fcar (tem); y = Fcar (Fcdr (tem)); } else { tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ window = Fcar (tem); /* POSN_WINDOW (tem) */ tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */ x = Fcar (tem); y = Fcdr (tem); /* Determine whether this menu is handling a menu bar click. */ tem = Fcar (Fcdr (Fcar (Fcdr (position)))); if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar)) menubarp = 1; } } CHECK_NUMBER (x, 0); CHECK_NUMBER (y, 0); /* Decode where to put the menu. */ if (FRAMEP (window)) { f = XFRAME (window); xpos = 0; ypos = 0; } else if (WINDOWP (window)) { CHECK_LIVE_WINDOW (window, 0); f = XFRAME (WINDOW_FRAME (XWINDOW (window))); xpos = (FONT_WIDTH (f->output_data.win32->font) * XWINDOW (window)->left); ypos = (f->output_data.win32->line_height * XWINDOW (window)->top); } else /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, but I don't want to make one now. */ CHECK_WINDOW (window, 0); xpos += XINT (x); ypos += XINT (y); } title = Qnil; GCPRO1 (title); discard_menu_items (&mm); hmenu = create_menu_items (&mm, menu, NILP (position)); if (NILP (position)) { discard_menu_items (&mm); UNGCPRO; return Qnil; } /* Display them in a menu. */ BLOCK_INPUT; selection = win32menu_show (f, xpos, ypos, menu, &hmenu, &error_name); UNBLOCK_INPUT; discard_menu_items (&mm); DestroyMenu (hmenu); UNGCPRO; if (error_name) error (error_name); return selection; } DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0, "Pop up a dialog box and return user's selection.\n\ POSITION specifies which frame to use.\n\ This is normally a mouse button event or a window or frame.\n\ If POSITION is t, it means to use the frame the mouse is on.\n\ The dialog box appears in the middle of the specified frame.\n\ \n\ CONTENTS specifies the alternatives to display in the dialog box.\n\ It is a list of the form (TITLE ITEM1 ITEM2...).\n\ Each ITEM is a cons cell (STRING . VALUE).\n\ The return value is VALUE from the chosen item.\n\n\ An ITEM may also be just a string--that makes a nonselectable item.\n\ An ITEM may also be nil--that means to put all preceding items\n\ on the left of the dialog box and all following items on the right.\n\ \(By default, approximately half appear on each side.)") (position, contents) Lisp_Object position, contents; { FRAME_PTR f; Lisp_Object window; /* Decode the first argument: find the window or frame to use. */ if (EQ (position, Qt)) { /* Decode the first argument: find the window and the coordinates. */ if (EQ (position, Qt)) window = selected_window; } else if (CONSP (position)) { Lisp_Object tem; tem = Fcar (position); if (XTYPE (tem) == Lisp_Cons) window = Fcar (Fcdr (position)); else { tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ window = Fcar (tem); /* POSN_WINDOW (tem) */ } } else if (WINDOWP (position) || FRAMEP (position)) window = position; /* Decode where to put the menu. */ if (FRAMEP (window)) f = XFRAME (window); else if (WINDOWP (window)) { CHECK_LIVE_WINDOW (window, 0); f = XFRAME (WINDOW_FRAME (XWINDOW (window))); } else /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, but I don't want to make one now. */ CHECK_WINDOW (window, 0); #if 1 /* Display a menu with these alternatives in the middle of frame F. */ { Lisp_Object x, y, frame, newpos; XSETFRAME (frame, f); XSETINT (x, x_pixel_width (f) / 2); XSETINT (y, x_pixel_height (f) / 2); newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil)); return Fx_popup_menu (newpos, Fcons (Fcar (contents), Fcons (contents, Qnil))); } #else { Lisp_Object title; char *error_name; Lisp_Object selection; /* Decode the dialog items from what was specified. */ title = Fcar (contents); CHECK_STRING (title, 1); list_of_panes (Fcons (contents, Qnil)); /* Display them in a dialog box. */ BLOCK_INPUT; selection = win32_dialog_show (f, 0, 0, title, &error_name); UNBLOCK_INPUT; discard_menu_items (); if (error_name) error (error_name); return selection; } #endif } Lisp_Object get_frame_menubar_event (f, num) FRAME_PTR f; int num; { Lisp_Object tail, items; int i; struct gcpro gcpro1; BLOCK_INPUT; GCPRO1 (items); if (NILP (items = FRAME_MENU_BAR_ITEMS (f))) items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); for (i = 0; i < XVECTOR (items)->size; i += 3) { Lisp_Object event; event = get_menu_event (XVECTOR (items)->contents[i + 2], &num); if (num <= 0) { UNGCPRO; UNBLOCK_INPUT; return (Fcons (XVECTOR (items)->contents[i], event)); } } UNGCPRO; UNBLOCK_INPUT; return (Qnil); } void set_frame_menubar (f, first_time) FRAME_PTR f; int first_time; { Lisp_Object tail, items; HMENU hmenu; int i; struct gcpro gcpro1; menu_map mm; BLOCK_INPUT; GCPRO1 (items); if (NILP (items = FRAME_MENU_BAR_ITEMS (f))) items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); hmenu = CreateMenu (); if (!hmenu) goto error; discard_menu_items (&mm); for (i = 0; i < XVECTOR (items)->size; i += 3) { Lisp_Object string; int keymaps; CHAR *error; HMENU new_hmenu; string = XVECTOR (items)->contents[i + 1]; if (NILP (string)) break; new_hmenu = create_menu_items (&mm, XVECTOR (items)->contents[i + 2], 0); if (!new_hmenu) continue; AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, (char *) XSTRING (string)->data); } { HMENU old = GetMenu (FRAME_WIN32_WINDOW (f)); SetMenu (FRAME_WIN32_WINDOW (f), hmenu); DestroyMenu (old); } error: UNGCPRO; UNBLOCK_INPUT; } void free_frame_menubar (f) FRAME_PTR f; { BLOCK_INPUT; { HMENU old = GetMenu (FRAME_WIN32_WINDOW (f)); SetMenu (FRAME_WIN32_WINDOW (f), NULL); DestroyMenu (old); } UNBLOCK_INPUT; } /* Called from Fwin32_create_frame to create the inital menubar of a frame before it is mapped, so that the window is mapped with the menubar already there instead of us tacking it on later and thrashing the window after it is visible. */ void initialize_frame_menubar (f) FRAME_PTR f; { set_frame_menubar (f, 1); } #if 0 /* If the mouse has moved to another menu bar item, return 1 and unread a button press event for that item. Otherwise return 0. */ static int check_mouse_other_menu_bar (f) FRAME_PTR f; { FRAME_PTR new_f; Lisp_Object bar_window; int part; Lisp_Object x, y; unsigned long time; (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time); if (f == new_f && other_menu_bar_item_p (f, x, y)) { unread_menu_bar_button (f, x); return 1; } return 0; } #endif #if 0 static HMENU create_menu (keymaps, error) int keymaps; char **error; { HMENU hmenu = NULL; /* the menu we are currently working on */ HMENU first_hmenu = NULL; HMENU *submenu_stack = (HMENU *) alloca (menu_items_used * sizeof (HMENU)); Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object)); int submenu_depth = 0; int i; if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) { *error = "Empty menu"; return NULL; } i = 0; /* Loop over all panes and items, filling in the tree. */ while (i < menu_items_used) { if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) { submenu_stack[submenu_depth++] = hmenu; i++; } else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) { hmenu = submenu_stack[--submenu_depth]; i++; } #if 0 else if (EQ (XVECTOR (menu_items)->contents[i], Qt) && submenu_depth != 0) i += MENU_ITEMS_PANE_LENGTH; #endif /* Ignore a nil in the item list. It's meaningful only for dialog boxes. */ else if (EQ (XVECTOR (menu_items)->contents[i], Qquote)) i += 1; else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) { /* Create a new pane. */ Lisp_Object pane_name; char *pane_string; pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME]; pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data); if (!hmenu || strcmp (pane_string, "")) { HMENU new_hmenu = CreateMenu (); if (!new_hmenu) { *error = "Could not create menu pane"; goto error; } if (hmenu) { AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, pane_string); } hmenu = new_hmenu; if (!first_hmenu) first_hmenu = hmenu; } i += MENU_ITEMS_PANE_LENGTH; } else { /* Create a new item within current pane. */ Lisp_Object item_name, enable, descrip; UINT fuFlags; item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; if (((char *) XSTRING (item_name)->data)[0] == 0 || strcmp ((char *) XSTRING (item_name)->data, "--") == 0) fuFlags = MF_SEPARATOR; else if (NILP (enable) || !XUINT(enable)) fuFlags = MF_STRING | MF_GRAYED; else fuFlags = MF_STRING; AppendMenu (hmenu, fuFlags, i, (char *) XSTRING (item_name)->data); // if (!NILP (descrip)) // hmenu->key = (char *) XSTRING (descrip)->data; i += MENU_ITEMS_ITEM_LENGTH; } } return (first_hmenu); error: if (first_hmenu) DestroyMenu (first_hmenu); return (NULL); } #endif /* win32menu_show actually displays a menu using the panes and items in menu_items and returns the value selected from it. There are two versions of win32menu_show, one for Xt and one for Xlib. Both assume input is blocked by the caller. */ /* F is the frame the menu is for. X and Y are the frame-relative specified position, relative to the inside upper left corner of the frame F. MENUBARP is 1 if the click that asked for this menu came from the menu bar. KEYMAPS is 1 if this menu was specified with keymaps; in that case, we return a list containing the chosen item's value and perhaps also the pane's prefix. TITLE is the specified menu title. ERROR is a place to store an error message string in case of failure. (We return nil on failure, but the value doesn't actually matter.) */ static Lisp_Object win32menu_show (f, x, y, menu, hmenu, error) FRAME_PTR f; int x; int y; Lisp_Object menu; HMENU hmenu; char **error; { int i , menu_selection; POINT pos; *error = NULL; if (!hmenu) { *error = "Empty menu"; return Qnil; } pos.x = x; pos.y = y; /* Offset the coordinates to root-relative. */ ClientToScreen (FRAME_WIN32_WINDOW (f), &pos); #if 0 /* If the mouse moves out of the menu before we show the menu, don't show it at all. */ if (check_mouse_other_menu_bar (f)) { DestroyMenu (hmenu); return Qnil; } #endif /* Display the menu. */ menu_selection = TrackPopupMenu (hmenu, 0x10, pos.x, pos.y, 0, FRAME_WIN32_WINDOW (f), NULL); if (menu_selection == -1) { *error = "Invalid menu specification"; return Qnil; } /* Find the selected item, and its pane, to return the proper value. */ #if 1 if (menu_selection > 0) { return get_menu_event (menu, menu_selection); } #else if (menu_selection > 0 && menu_selection <= lpmm->menu_items_used) { return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]); } #endif return Qnil; } #if 0 static char * button_names [] = { "button1", "button2", "button3", "button4", "button5", "button6", "button7", "button8", "button9", "button10" }; static Lisp_Object win32_dialog_show (f, menubarp, keymaps, title, error) FRAME_PTR f; int menubarp; int keymaps; Lisp_Object title; char **error; { int i, nb_buttons=0; HMENU hmenu; char dialog_name[6]; /* Number of elements seen so far, before boundary. */ int left_count = 0; /* 1 means we've seen the boundary between left-hand elts and right-hand. */ int boundary_seen = 0; *error = NULL; if (menu_items_n_panes > 1) { *error = "Multiple panes in dialog box"; return Qnil; } /* Create a tree of widget_value objects representing the text label and buttons. */ { Lisp_Object pane_name, prefix; char *pane_string; pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME]; prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX]; pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data); prev_wv = malloc_widget_value (); prev_wv->value = pane_string; if (keymaps && !NILP (prefix)) prev_wv->name++; prev_wv->enabled = 1; prev_wv->name = "message"; first_wv = prev_wv; /* Loop over all panes and items, filling in the tree. */ i = MENU_ITEMS_PANE_LENGTH; while (i < menu_items_used) { /* Create a new item within current pane. */ Lisp_Object item_name, enable, descrip; item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; if (NILP (item_name)) { free_menubar_widget_value_tree (first_wv); *error = "Submenu in dialog items"; return Qnil; } if (EQ (item_name, Qquote)) { /* This is the boundary between left-side elts and right-side elts. Stop incrementing right_count. */ boundary_seen = 1; i++; continue; } if (nb_buttons >= 10) { free_menubar_widget_value_tree (first_wv); *error = "Too many dialog items"; return Qnil; } wv = malloc_widget_value (); prev_wv->next = wv; wv->name = (char *) button_names[nb_buttons]; if (!NILP (descrip)) wv->key = (char *) XSTRING (descrip)->data; wv->value = (char *) XSTRING (item_name)->data; wv->call_data = (void *) &XVECTOR (menu_items)->contents[i]; wv->enabled = !NILP (enable); prev_wv = wv; if (! boundary_seen) left_count++; nb_buttons++; i += MENU_ITEMS_ITEM_LENGTH; } /* If the boundary was not specified, by default put half on the left and half on the right. */ if (! boundary_seen) left_count = nb_buttons - nb_buttons / 2; wv = malloc_widget_value (); wv->name = dialog_name; /* Dialog boxes use a really stupid name encoding which specifies how many buttons to use and how many buttons are on the right. The Q means something also. */ dialog_name[0] = 'Q'; dialog_name[1] = '0' + nb_buttons; dialog_name[2] = 'B'; dialog_name[3] = 'R'; /* Number of buttons to put on the right. */ dialog_name[4] = '0' + nb_buttons - left_count; dialog_name[5] = 0; wv->contents = first_wv; first_wv = wv; } /* Actually create the dialog. */ dialog_id = ++popup_id_tick; menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv, f->output_data.win32->widget, 1, 0, dialog_selection_callback, 0); #if 0 /* This causes crashes, and seems to be redundant -- rms. */ lw_modify_all_widgets (dialog_id, first_wv, True); #endif lw_modify_all_widgets (dialog_id, first_wv->contents, True); /* Free the widget_value objects we used to specify the contents. */ free_menubar_widget_value_tree (first_wv); /* No selection has been chosen yet. */ menu_item_selection = 0; /* Display the menu. */ lw_pop_up_all_widgets (dialog_id); /* Process events that apply to the menu. */ while (1) { XEvent event; XtAppNextEvent (Xt_app_con, &event); if (event.type == ButtonRelease) { XtDispatchEvent (&event); break; } else if (event.type == Expose) process_expose_from_menu (event); XtDispatchEvent (&event); if (XtWindowToWidget(XDISPLAY event.xany.window) != menu) { queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue)); if (queue_tmp != NULL) { queue_tmp->event = event; queue_tmp->next = queue; queue = queue_tmp; } } } pop_down: /* State that no mouse buttons are now held. That is not necessarily true, but the fiction leads to reasonable results, and it is a pain to ask which are actually held now or track this in the loop above. */ win32_mouse_grabbed = 0; /* Unread any events that we got but did not handle. */ while (queue != NULL) { queue_tmp = queue; XPutBackEvent (XDISPLAY &queue_tmp->event); queue = queue_tmp->next; free ((char *)queue_tmp); /* Cause these events to get read as soon as we UNBLOCK_INPUT. */ interrupt_input_pending = 1; } /* Find the selected item, and its pane, to return the proper value. */ if (menu_item_selection != 0) { Lisp_Object prefix; prefix = Qnil; i = 0; while (i < menu_items_used) { Lisp_Object entry; if (EQ (XVECTOR (menu_items)->contents[i], Qt)) { prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; i += MENU_ITEMS_PANE_LENGTH; } else { entry = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; if (menu_item_selection == &XVECTOR (menu_items)->contents[i]) { if (keymaps != 0) { entry = Fcons (entry, Qnil); if (!NILP (prefix)) entry = Fcons (prefix, entry); } return entry; } i += MENU_ITEMS_ITEM_LENGTH; } } } return Qnil; } #endif syms_of_win32menu () { defsubr (&Sx_popup_menu); defsubr (&Sx_popup_dialog); } emacs-19.30/src/w32reg.c100444 23073 1 4636 6047606405 14043 0ustar voelkerdaemon/* Emulate the X Resource Manager through the registry. Copyright (C) 1990, 1993, 1994 Free Software Foundation. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* Written by Kevin Gallo */ #include #include "lisp.h" #include "w32term.h" #include "blockinput.h" #include #include #define REG_ROOT "SOFTWARE\\GNU\\Emacs\\" LPBYTE win32_get_string_resource (name, class, dwexptype) char *name, *class; DWORD dwexptype; { LPBYTE lpvalue = NULL; HKEY hrootkey = NULL; DWORD dwType; DWORD cbData; BOOL ok = FALSE; BLOCK_INPUT; /* Check both the current user and the local machine to see if we have any resources */ if (RegOpenKeyEx (HKEY_CURRENT_USER, REG_ROOT, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS || RegOpenKeyEx (HKEY_LOCAL_MACHINE, REG_ROOT, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS) { char *keyname; if (RegQueryValueEx (hrootkey, name, NULL, &dwType, NULL, &cbData) == ERROR_SUCCESS && dwType == dwexptype) { keyname = name; } else if (RegQueryValueEx (hrootkey, class, NULL, &dwType, NULL, &cbData) == ERROR_SUCCESS && dwType == dwexptype) { keyname = class; } else { keyname = NULL; } ok = (keyname && (lpvalue = (LPBYTE) xmalloc (cbData)) != NULL && RegQueryValueEx (hrootkey, keyname, NULL, NULL, lpvalue, &cbData) == ERROR_SUCCESS); RegCloseKey (hrootkey); } UNBLOCK_INPUT; if (!ok) { if (lpvalue) xfree (lpvalue); return (NULL); } else { return (lpvalue); } } /* Retrieve the string resource specified by NAME with CLASS from database RDB. */ char * x_get_string_resource (rdb, name, class) int rdb; char *name, *class; { return (win32_get_string_resource (name, class, REG_SZ)); } emacs-19.30/src/w32select.c100444 23073 1 11655 6047606405 14564 0ustar voelkerdaemon/* Win32 Selection processing for emacs Copyright (C) 1993, 1994 Free Software Foundation. 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. */ /* Written by Kevin Gallo */ #include #include "lisp.h" #include "w32term.h" /* for all of the win32 includes */ #include "dispextern.h" /* frame.h seems to want this */ #include "frame.h" /* Need this to get the X window of selected_frame */ #include "blockinput.h" #if 0 DEFUN ("win32-open-clipboard", Fwin32_open_clipboard, Swin32_open_clipboard, 0, 1, 0, "This opens the clipboard with the given frame pointer.") (frame) Lisp_Object frame; { BOOL ok = FALSE; if (!NILP (frame)) CHECK_LIVE_FRAME (frame, 0); BLOCK_INPUT; ok = OpenClipboard ((!NILP (frame) && FRAME_WIN32_P (XFRAME (frame))) ? FRAME_WIN32_WINDOW (XFRAME (frame)) : NULL); UNBLOCK_INPUT; return (ok ? frame : Qnil); } DEFUN ("win32-empty-clipboard", Fwin32_empty_clipboard, Swin32_empty_clipboard, 0, 0, 0, "This empties the clipboard and assigns ownership to the window which opened the clipboard.") () { BOOL ok = FALSE; BLOCK_INPUT; ok = EmptyClipboard (); UNBLOCK_INPUT; return (ok ? Qt : Qnil); } DEFUN ("win32-close-clipboard", Fwin32_close_clipboard, Swin32_close_clipboard, 0, 0, 0, "This closes the clipboard.") () { BOOL ok = FALSE; BLOCK_INPUT; ok = CloseClipboard (); UNBLOCK_INPUT; return (ok ? Qt : Qnil); } #endif DEFUN ("win32-set-clipboard-data", Fwin32_set_clipboard_data, Swin32_set_clipboard_data, 1, 2, 0, "This sets the clipboard data to the given text.") (string, frame) Lisp_Object string, frame; { BOOL ok = TRUE; HANDLE htext; CHECK_STRING (string, 0); if (!NILP (frame)) CHECK_LIVE_FRAME (frame, 0); BLOCK_INPUT; /* Allocate twice the amount so we can convert lf to cr-lf */ if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, (2 * XSTRING (string)->size) + 1)) == NULL) goto error; { unsigned char *lptext; if ((lptext = (unsigned char *)GlobalLock (htext)) == NULL) goto error; { int i = XSTRING (string)->size; int newsize = XSTRING (string)->size; register char *p1 = XSTRING (string)->data; register char *p2 = lptext; while (i--) { if (*p1 == '\n') { newsize++; *p2++ = '\r'; } *p2++ = *p1++; } *p2 = 0; } GlobalUnlock (htext); } if (!OpenClipboard ((!NILP (frame) && FRAME_WIN32_P (XFRAME (frame))) ? FRAME_WIN32_WINDOW (XFRAME (frame)) : NULL)) goto error; ok = EmptyClipboard () && SetClipboardData (CF_TEXT, htext); CloseClipboard (); if (ok) goto done; error: ok = FALSE; if (htext) GlobalFree (htext); done: UNBLOCK_INPUT; return (ok ? string : Qnil); } DEFUN ("win32-get-clipboard-data", Fwin32_get_clipboard_data, Swin32_get_clipboard_data, 0, 1, 0, "This gets the clipboard data in text format.") (frame) Lisp_Object frame; { HANDLE htext; Lisp_Object ret = Qnil; if (!NILP (frame)) CHECK_LIVE_FRAME (frame, 0); BLOCK_INPUT; if (!OpenClipboard ((!NILP (frame) && FRAME_WIN32_P (XFRAME (frame))) ? FRAME_WIN32_WINDOW (XFRAME (frame)) : NULL)) goto done; if ((htext = GetClipboardData (CF_TEXT)) == NULL) goto closeclip; { unsigned char *lptext; int nbytes; if ((lptext = (unsigned char *)GlobalLock (htext)) == NULL) goto closeclip; nbytes = strlen (lptext); { char *buf = (char *) xmalloc (nbytes); register char *p1 = lptext; register char *p2 = buf; int i = nbytes; if (buf == NULL) goto closeclip; while (i--) { if (p1[0] == '\r' && i && p1[1] == '\n') { p1++; i--; nbytes--; } *p2++ = *p1++; } ret = make_string (buf, nbytes); xfree (buf); } GlobalUnlock (htext); } closeclip: CloseClipboard (); done: UNBLOCK_INPUT; return (ret); } void syms_of_win32select () { #if 0 defsubr (&Swin32_open_clipboard); defsubr (&Swin32_empty_clipboard); defsubr (&Swin32_close_clipboard); #endif defsubr (&Swin32_set_clipboard_data); defsubr (&Swin32_get_clipboard_data); } emacs-19.30/src/w32term.c100444 23073 1 305665 6047606407 14305 0ustar voelkerdaemon/* Implementation of Win32 GUI terminal Copyright (C) 1989, 1993, 1994, 1995 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. */ /* Added by Kevin Gallo */ #include #include #include #include "lisp.h" #include "blockinput.h" #include #include "systty.h" #include "systime.h" #include #include #include #include #include "frame.h" #include "dispextern.h" #include "termhooks.h" #include "termopts.h" #include "termchar.h" #include "gnu.h" #include "disptab.h" #include "buffer.h" #include "window.h" #include "keyboard.h" #include "intervals.h" extern void free_frame_menubar (); #define x_any_window_to_frame x_window_to_frame #define x_top_window_to_frame x_window_to_frame /* This is display since win32 does not support multiple ones. */ struct win32_display_info one_win32_display_info; /* This is a list of cons cells, each of the form (NAME . FONT-LIST-CACHE), one for each element of win32_display_list and in the same order. NAME is the name of the frame. FONT-LIST-CACHE records previous values returned by x-list-fonts. */ Lisp_Object win32_display_name_list; /* Frame being updated by update_frame. This is declared in term.c. This is set by update_begin and looked at by all the win32 functions. It is zero while not inside an update. In that case, the win32 functions assume that `selected_frame' is the frame to apply to. */ extern struct frame *updating_frame; /* This is a frame waiting to be autoraised, within w32_read_socket. */ struct frame *pending_autoraise_frame; /* During an update, maximum vpos for ins/del line operations to affect. */ static int flexlines; /* During an update, nonzero if chars output now should be highlighted. */ static int highlight; /* Nominal cursor position -- where to draw output. During an update, these are different from the cursor-box position. */ static int curs_x; static int curs_y; DWORD dwWinThreadId = 0; HANDLE hWinThread = NULL; DWORD dwMainThreadId = 0; HANDLE hMainThread = NULL; /* Mouse movement. */ /* Where the mouse was last time we reported a mouse event. */ static FRAME_PTR last_mouse_frame; static RECT last_mouse_glyph; /* The scroll bar in which the last motion event occurred. If the last motion event occurred in a scroll bar, we set this so win32_mouse_position can know whether to report a scroll bar motion or an ordinary motion. If the last motion event didn't occur in a scroll bar, we set this to Qnil, to tell win32_mouse_position to return an ordinary motion event. */ Lisp_Object last_mouse_scroll_bar; int last_mouse_scroll_bar_pos; /* This is a hack. We would really prefer that win32_mouse_position would return the time associated with the position it returns, but there doesn't seem to be any way to wrest the timestamp from the server along with the position query. So, we just keep track of the time of the last movement we received, and return that in hopes that it's somewhat accurate. */ Time last_mouse_movement_time; /* Incremented by w32_read_socket whenever it really tries to read events. */ #ifdef __STDC__ static int volatile input_signal_count; #else static int input_signal_count; #endif extern Lisp_Object Vcommand_line_args, Vsystem_name; extern Lisp_Object Qface, Qmouse_face; extern int errno; /* A mask of extra modifier bits to put into every keyboard char. */ extern int extra_keyboard_modifiers; static Lisp_Object Qvendor_specific_keysyms; void win32_delete_display (); static void redraw_previous_char (); static void redraw_following_char (); static unsigned int win32_get_modifiers (); static int fast_find_position (); static void note_mouse_highlight (); static void clear_mouse_face (); static void show_mouse_face (); static void do_line_dance (); static int win32_cursor_to (); static int win32_clear_end_of_line (); #if 0 /* This is a function useful for recording debugging information about the sequence of occurrences in this file. */ struct record { char *locus; int type; }; struct record event_record[100]; int event_record_index; record_event (locus, type) char *locus; int type; { if (event_record_index == sizeof (event_record) / sizeof (struct record)) event_record_index = 0; event_record[event_record_index].locus = locus; event_record[event_record_index].type = type; event_record_index++; } #endif /* 0 */ /* Return the struct win32_display_info. */ struct win32_display_info * win32_display_info_for_display () { return (&one_win32_display_info); } void win32_fill_rect (f, _hdc, pix, lprect) FRAME_PTR f; HDC _hdc; COLORREF pix; RECT * lprect; { HDC hdc; HBRUSH hb; HANDLE oldobj; RECT rect; if (_hdc) hdc = _hdc; else { if (!f) return; hdc = my_get_dc (FRAME_WIN32_WINDOW (f)); } hb = CreateSolidBrush (pix); oldobj = SelectObject (hdc, hb); FillRect (hdc, lprect, hb); SelectObject (hdc, oldobj); DeleteObject (hb); if (!_hdc) ReleaseDC (FRAME_WIN32_WINDOW (f), hdc); } void win32_clear_window (f) FRAME_PTR f; { RECT rect; GetClientRect (FRAME_WIN32_WINDOW (f), &rect); win32_clear_rect (f, NULL, &rect); } /* Starting and ending updates. These hooks are called by update_frame at the beginning and end of a frame update. We record in `updating_frame' the identity of the frame being updated, so that the win32_... functions do not need to take a frame as argument. Most of the win32_... functions should never be called except during an update, the only exceptions being win32_cursor_to, win32_write_glyphs and win32_reassert_line_highlight. */ static win32_update_begin (f) struct frame *f; { if (f == 0) abort (); flexlines = f->height; highlight = 0; BLOCK_INPUT; if (f == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_frame) { /* Don't do highlighting for mouse motion during the update. */ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_defer = 1; /* If the frame needs to be redrawn, simply forget about any prior mouse highlighting. */ if (FRAME_GARBAGED_P (f)) FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window = Qnil; if (!NILP (FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window)) { int firstline, lastline, i; struct window *w = XWINDOW (FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window); /* Find the first, and the last+1, lines affected by redisplay. */ for (firstline = 0; firstline < f->height; firstline++) if (FRAME_DESIRED_GLYPHS (f)->enable[firstline]) break; lastline = f->height; for (i = f->height - 1; i >= 0; i--) { if (FRAME_DESIRED_GLYPHS (f)->enable[i]) break; else lastline = i; } /* Can we tell that this update does not affect the window where the mouse highlight is? If so, no need to turn off. Likewise, don't do anything if the frame is garbaged; in that case, the FRAME_CURRENT_GLYPHS that we would use are all wrong, and we will redisplay that line anyway. */ if (! (firstline > (XFASTINT (w->top) + window_internal_height (w)) || lastline < XFASTINT (w->top))) clear_mouse_face (FRAME_WIN32_DISPLAY_INFO (f)); } } UNBLOCK_INPUT; } static win32_update_end (f) struct frame *f; { BLOCK_INPUT; do_line_dance (); x_display_cursor (f, 1); if (f == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_frame) FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_defer = 0; UNBLOCK_INPUT; } /* This is called after a redisplay on frame F. */ static win32_frame_up_to_date (f) FRAME_PTR f; { if (FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_deferred_gc || f == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_frame) { note_mouse_highlight (FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_frame, FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_x, FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_y); FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_deferred_gc = 0; } } /* External interface to control of standout mode. Call this when about to modify line at position VPOS and not change whether it is highlighted. */ win32_reassert_line_highlight (new, vpos) int new, vpos; { highlight = new; } /* Call this when about to modify line at position VPOS and change whether it is highlighted. */ static win32_change_line_highlight (new_highlight, vpos, first_unused_hpos) int new_highlight, vpos, first_unused_hpos; { highlight = new_highlight; win32_cursor_to (vpos, 0); win32_clear_end_of_line (updating_frame->width); } /* This is used when starting Emacs and when restarting after suspend. When starting Emacs, no window is mapped. And nothing must be done to Emacs's own window if it is suspended (though that rarely happens). */ static win32_set_terminal_modes () { } /* This is called when exiting or suspending Emacs. Exiting will make the Win32 windows go away, and suspending requires no action. */ static win32_reset_terminal_modes () { } /* Set the nominal cursor position of the frame. This is where display update commands will take effect. This does not affect the place where the cursor-box is displayed. */ static int win32_cursor_to (row, col) register int row, col; { int orow = row; curs_x = col; curs_y = row; if (updating_frame == 0) { BLOCK_INPUT; x_display_cursor (selected_frame, 1); UNBLOCK_INPUT; } } /* Display a sequence of N glyphs found at GP. WINDOW is the window to output to. LEFT and TOP are starting coords. HL is 1 if this text is highlighted, 2 if the cursor is on it, 3 if should appear in its mouse-face. JUST_FOREGROUND if 1 means draw only the foreground; don't alter the background. FONT is the default font to use (for glyphs whose font-code is 0). Since the display generation code is responsible for calling compute_char_face and compute_glyph_face on everything it puts in the display structure, we can assume that the face code on each glyph is a valid index into FRAME_COMPUTED_FACES (f), and the one to which we can actually apply intern_face. Call this function with input blocked. */ static void dumpglyphs (f, left, top, gp, n, hl, just_foreground) struct frame *f; int left, top; register GLYPH *gp; /* Points to first GLYPH. */ register int n; /* Number of glyphs to display. */ int hl; int just_foreground; { /* Holds characters to be displayed. */ char *buf = (char *) alloca (f->width * sizeof (*buf)); register char *cp; /* Steps through buf[]. */ register int tlen = GLYPH_TABLE_LENGTH; register Lisp_Object *tbase = GLYPH_TABLE_BASE; Window window = FRAME_WIN32_WINDOW (f); int orig_left = left; HDC hdc; hdc = my_get_dc (window); while (n > 0) { /* Get the face-code of the next GLYPH. */ int cf, len; int g = *gp; GLYPH_FOLLOW_ALIASES (tbase, tlen, g); cf = FAST_GLYPH_FACE (g); /* Find the run of consecutive glyphs with the same face-code. Extract their character codes into BUF. */ cp = buf; while (n > 0) { g = *gp; GLYPH_FOLLOW_ALIASES (tbase, tlen, g); if (FAST_GLYPH_FACE (g) != cf) break; *cp++ = FAST_GLYPH_CHAR (g); --n; ++gp; } /* LEN gets the length of the run. */ len = cp - buf; /* Now output this run of chars, with the font and pixel values determined by the face code CF. */ { struct face *face = FRAME_DEFAULT_FACE (f); XFontStruct *font = FACE_FONT (face); int stippled = 0; COLORREF fg; COLORREF bg; /* HL = 3 means use a mouse face previously chosen. */ if (hl == 3) cf = FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_face_id; /* First look at the face of the text itself. */ if (cf != 0) { /* It's possible for the display table to specify a face code that is out of range. Use 0 in that case. */ if (cf < 0 || cf >= FRAME_N_COMPUTED_FACES (f) || FRAME_COMPUTED_FACES (f) [cf] == 0) cf = 0; if (cf == 1) face = FRAME_MODE_LINE_FACE (f); else face = intern_face (f, FRAME_COMPUTED_FACES (f) [cf]); font = FACE_FONT (face); if (FACE_STIPPLE (face)) stippled = 1; } /* Then comes the distinction between modeline and normal text. */ else if (hl == 0) ; else if (hl == 1) { face = FRAME_MODE_LINE_FACE (f); font = FACE_FONT (face); if (FACE_STIPPLE (face)) stippled = 1; } fg = face->foreground; bg = face->background; /* Now override that if the cursor's on this character. */ if (hl == 2) { /* The cursor overrides stippling. */ stippled = 0; if ((!face->font || face->font == (XFontStruct *) FACE_DEFAULT || face->font == f->output_data.win32->font) && face->background == f->output_data.win32->background_pixel && face->foreground == f->output_data.win32->foreground_pixel) { bg = f->output_data.win32->cursor_pixel; fg = face->background; } /* Cursor on non-default face: must merge. */ else { bg = f->output_data.win32->cursor_pixel; fg = face->background; /* If the glyph would be invisible, try a different foreground. */ if (fg == bg) fg = face->foreground; if (fg == bg) fg = f->output_data.win32->cursor_foreground_pixel; if (fg == bg) fg = face->foreground; /* Make sure the cursor is distinct from text in this face. */ if (bg == face->background && fg == face->foreground) { bg = face->foreground; fg = face->background; } } } if (font == (XFontStruct *) FACE_DEFAULT) font = f->output_data.win32->font; SetBkMode (hdc, just_foreground ? TRANSPARENT : OPAQUE); SetTextColor (hdc, fg); SetBkColor (hdc, bg); SelectObject (hdc, font->hfont); TextOut (hdc, left, top, buf, len); if (!just_foreground) { /* Clear the rest of the line's height. */ if (f->output_data.win32->line_height != FONT_HEIGHT (font)) win32_fill_area (f, hdc, bg, left, top + FONT_HEIGHT (font), FONT_WIDTH (font) * len, f->output_data.win32->line_height - FONT_HEIGHT (font)); } { int underline_position = 1; if (font->tm.tmDescent <= underline_position) underline_position = font->tm.tmDescent - 1; if (face->underline) win32_fill_area (f, hdc, fg, left, (top + FONT_BASE (font) + underline_position), len * FONT_WIDTH (font), 1); } left += len * FONT_WIDTH (font); } } ReleaseDC (window, hdc); } /* Output some text at the nominal frame cursor position. Advance the cursor over the text. Output LEN glyphs at START. `highlight', set up by win32_reassert_line_highlight or win32_change_line_highlight, controls the pixel values used for foreground and background. */ static win32_write_glyphs (start, len) register GLYPH *start; int len; { register int temp_length; struct frame *f; BLOCK_INPUT; do_line_dance (); f = updating_frame; if (f == 0) { f = selected_frame; /* If not within an update, output at the frame's visible cursor. */ curs_x = f->cursor_x; curs_y = f->cursor_y; } dumpglyphs (f, CHAR_TO_PIXEL_COL (f, curs_x), CHAR_TO_PIXEL_ROW (f, curs_y), start, len, highlight, 0); /* If we drew on top of the cursor, note that it is turned off. */ if (curs_y == f->phys_cursor_y && curs_x <= f->phys_cursor_x && curs_x + len > f->phys_cursor_x) f->phys_cursor_x = -1; if (updating_frame == 0) { f->cursor_x += len; x_display_cursor (f, 1); f->cursor_x -= len; } else curs_x += len; UNBLOCK_INPUT; } /* Clear to the end of the line. Erase the current text line from the nominal cursor position (inclusive) to column FIRST_UNUSED (exclusive). The idea is that everything from FIRST_UNUSED onward is already erased. */ static win32_clear_end_of_line (first_unused) register int first_unused; { struct frame *f = updating_frame; if (f == 0) abort (); if (curs_y < 0 || curs_y >= f->height) return 1; if (first_unused <= 0) return 1; if (first_unused >= f->width) first_unused = f->width; BLOCK_INPUT; do_line_dance (); /* Notice if the cursor will be cleared by this operation. */ if (curs_y == f->phys_cursor_y && curs_x <= f->phys_cursor_x && f->phys_cursor_x < first_unused) f->phys_cursor_x = -1; win32_clear_area (f, NULL, CHAR_TO_PIXEL_COL (f, curs_x), CHAR_TO_PIXEL_ROW (f, curs_y), FONT_WIDTH (f->output_data.win32->font) * (first_unused - curs_x), f->output_data.win32->line_height); UNBLOCK_INPUT; } static win32_clear_frame () { struct frame *f = updating_frame; if (f == 0) f = selected_frame; f->phys_cursor_x = -1; /* Cursor not visible. */ curs_x = 0; /* Nominal cursor position is top left. */ curs_y = 0; BLOCK_INPUT; win32_clear_window (f); /* We have to clear the scroll bars, too. If we have changed colors or something like that, then they should be notified. */ x_scroll_bar_clear (f); UNBLOCK_INPUT; } /* Make audible bell. */ win32_ring_bell () { BLOCK_INPUT; if (visible_bell) FlashWindow (FRAME_WIN32_WINDOW (selected_frame), FALSE); else nt_ring_bell (); UNBLOCK_INPUT; return 1; } /* Insert and delete character. These are not supposed to be used because we are supposed to turn off the feature of using them. */ static win32_insert_glyphs (start, len) register char *start; register int len; { abort (); } static win32_delete_glyphs (n) register int n; { abort (); } /* Specify how many text lines, from the top of the window, should be affected by insert-lines and delete-lines operations. This, and those operations, are used only within an update that is bounded by calls to win32_update_begin and win32_update_end. */ static win32_set_terminal_window (n) register int n; { if (updating_frame == 0) abort (); if ((n <= 0) || (n > updating_frame->height)) flexlines = updating_frame->height; else flexlines = n; } /* These variables need not be per frame because redisplay is done on a frame-by-frame basis and the line dance for one frame is finished before anything is done for another frame. */ /* Array of line numbers from cached insert/delete operations. line_dance[i] is the old position of the line that we want to move to line i, or -1 if we want a blank line there. */ static int *line_dance; /* Allocated length of that array. */ static int line_dance_len; /* Flag indicating whether we've done any work. */ static int line_dance_in_progress; /* Perform an insert-lines or delete-lines operation, inserting N lines or deleting -N lines at vertical position VPOS. */ win32_ins_del_lines (vpos, n) int vpos, n; { register int fence, i; if (vpos >= flexlines) return 1; if (!line_dance_in_progress) { int ht = updating_frame->height; if (ht > line_dance_len) { line_dance = (int *)xrealloc (line_dance, ht * sizeof (int)); line_dance_len = ht; } for (i = 0; i < ht; ++i) line_dance[i] = i; line_dance_in_progress = 1; } if (n >= 0) { if (n > flexlines - vpos) n = flexlines - vpos; fence = vpos + n; for (i = flexlines; --i >= fence;) line_dance[i] = line_dance[i-n]; for (i = fence; --i >= vpos;) line_dance[i] = -1; } else { n = -n; if (n > flexlines - vpos) n = flexlines - vpos; fence = flexlines - n; for (i = vpos; i < fence; ++i) line_dance[i] = line_dance[i + n]; for (i = fence; i < flexlines; ++i) line_dance[i] = -1; } } /* Here's where we actually move the pixels around. Must be called with input blocked. */ static void do_line_dance () { register int i, j, distance; register struct frame *f; int ht; int intborder; HDC hdc; /* Must check this flag first. If it's not set, then not only is the array uninitialized, but we might not even have a frame. */ if (!line_dance_in_progress) return; f = updating_frame; if (f == 0) abort (); ht = f->height; intborder = f->output_data.win32->internal_border_width; x_display_cursor (updating_frame, 0); hdc = my_get_dc (FRAME_WIN32_WINDOW (f)); for (i = 0; i < ht; ++i) if (line_dance[i] != -1 && (distance = line_dance[i]-i) > 0) { for (j = i; (j < ht && line_dance[j] != -1 && line_dance[j]-j == distance); ++j); /* Copy [i,j) upward from [i+distance, j+distance) */ BitBlt (hdc, intborder, CHAR_TO_PIXEL_ROW (f, i+distance), f->width * FONT_WIDTH (f->output_data.win32->font), (j-i) * f->output_data.win32->line_height, hdc, intborder, CHAR_TO_PIXEL_ROW (f, i), SRCCOPY); i = j-1; } for (i = ht; --i >=0; ) if (line_dance[i] != -1 && (distance = line_dance[i]-i) < 0) { for (j = i; (--j >= 0 && line_dance[j] != -1 && line_dance[j]-j == distance);); /* Copy (j, i] downward from (j+distance, i+distance] */ BitBlt (hdc, intborder, CHAR_TO_PIXEL_ROW (f, j+1+distance), f->width * FONT_WIDTH (f->output_data.win32->font), (i-j) * f->output_data.win32->line_height, hdc, intborder, CHAR_TO_PIXEL_ROW (f, j+1), SRCCOPY); i = j+1; } ReleaseDC (FRAME_WIN32_WINDOW (f), hdc); for (i = 0; i < ht; ++i) if (line_dance[i] == -1) { for (j = i; j < ht && line_dance[j] == -1; ++j); /* Clear [i,j) */ win32_clear_area (f, NULL, intborder, CHAR_TO_PIXEL_ROW (f, i), f->width * FONT_WIDTH (f->output_data.win32->font), (j-i) * f->output_data.win32->line_height); i = j-1; } line_dance_in_progress = 0; } /* Support routines for exposure events. */ static void clear_cursor (); /* Output into a rectangle of a window (for frame F) the characters in f->phys_lines that overlap that rectangle. TOP and LEFT are the position of the upper left corner of the rectangle. ROWS and COLS are the size of the rectangle. Call this function with input blocked. */ void dumprectangle (f, left, top, cols, rows) struct frame *f; register int left, top, cols, rows; { register struct frame_glyphs *active_frame = FRAME_CURRENT_GLYPHS (f); int cursor_cleared = 0; int bottom, right; register int y; if (FRAME_GARBAGED_P (f)) return; /* Express rectangle as four edges, instead of position-and-size. */ bottom = top + rows; right = left + cols; /* Convert rectangle edges in pixels to edges in chars. Round down for left and top, up for right and bottom. */ top = PIXEL_TO_CHAR_ROW (f, top); left = PIXEL_TO_CHAR_COL (f, left); bottom += (f->output_data.win32->line_height - 1); right += (FONT_WIDTH (f->output_data.win32->font) - 1); bottom = PIXEL_TO_CHAR_ROW (f, bottom); right = PIXEL_TO_CHAR_COL (f, right); /* Clip the rectangle to what can be visible. */ if (left < 0) left = 0; if (top < 0) top = 0; if (right > f->width) right = f->width; if (bottom > f->height) bottom = f->height; /* Get size in chars of the rectangle. */ cols = right - left; rows = bottom - top; /* If rectangle has zero area, return. */ if (rows <= 0) return; if (cols <= 0) return; /* Turn off the cursor if it is in the rectangle. We will turn it back on afterward. */ if ((f->phys_cursor_x >= left) && (f->phys_cursor_x < right) && (f->phys_cursor_y >= top) && (f->phys_cursor_y < bottom)) { clear_cursor (f); cursor_cleared = 1; } /* Display the text in the rectangle, one text line at a time. */ for (y = top; y < bottom; y++) { GLYPH *line = &active_frame->glyphs[y][left]; if (! active_frame->enable[y] || left > active_frame->used[y]) continue; dumpglyphs (f, CHAR_TO_PIXEL_COL (f, left), CHAR_TO_PIXEL_ROW (f, y), line, min (cols, active_frame->used[y] - left), active_frame->highlight[y], 0); } /* Turn the cursor on if we turned it off. */ if (cursor_cleared) x_display_cursor (f, 1); } static void frame_highlight (f) struct frame *f; { x_display_cursor (f, 1); } static void frame_unhighlight (f) struct frame *f; { x_display_cursor (f, 1); } static void win32_frame_rehighlight (); static void x_frame_rehighlight (); /* The focus has changed. Update the frames as necessary to reflect the new situation. Note that we can't change the selected frame here, because the Lisp code we are interrupting might become confused. Each event gets marked with the frame in which it occurred, so the Lisp code can tell when the switch took place by examining the events. */ void x_new_focus_frame (dpyinfo, frame) struct win32_display_info *dpyinfo; struct frame *frame; { struct frame *old_focus = dpyinfo->win32_focus_frame; int events_enqueued = 0; if (frame != dpyinfo->win32_focus_frame) { /* Set this before calling other routines, so that they see the correct value of win32_focus_frame. */ dpyinfo->win32_focus_frame = frame; if (old_focus && old_focus->auto_lower) x_lower_frame (old_focus); if (dpyinfo->win32_focus_frame && dpyinfo->win32_focus_frame->auto_raise) pending_autoraise_frame = dpyinfo->win32_focus_frame; else pending_autoraise_frame = 0; } x_frame_rehighlight (dpyinfo); } /* Handle an event saying the mouse has moved out of an Emacs frame. */ void x_mouse_leave (dpyinfo) struct win32_display_info *dpyinfo; { x_new_focus_frame (dpyinfo, dpyinfo->win32_focus_event_frame); } /* The focus has changed, or we have redirected a frame's focus to another frame (this happens when a frame uses a surrogate minibuffer frame). Shift the highlight as appropriate. The FRAME argument doesn't necessarily have anything to do with which frame is being highlighted or unhighlighted; we only use it to find the appropriate display info. */ static void win32_frame_rehighlight (frame) struct frame *frame; { x_frame_rehighlight (FRAME_WIN32_DISPLAY_INFO (frame)); } static void x_frame_rehighlight (dpyinfo) struct win32_display_info *dpyinfo; { struct frame *old_highlight = dpyinfo->win32_highlight_frame; if (dpyinfo->win32_focus_frame) { dpyinfo->win32_highlight_frame = ((GC_FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->win32_focus_frame))) ? XFRAME (FRAME_FOCUS_FRAME (dpyinfo->win32_focus_frame)) : dpyinfo->win32_focus_frame); if (! FRAME_LIVE_P (dpyinfo->win32_highlight_frame)) { FRAME_FOCUS_FRAME (dpyinfo->win32_focus_frame) = Qnil; dpyinfo->win32_highlight_frame = dpyinfo->win32_focus_frame; } } else dpyinfo->win32_highlight_frame = 0; if (dpyinfo->win32_highlight_frame != old_highlight) { if (old_highlight) frame_unhighlight (old_highlight); if (dpyinfo->win32_highlight_frame) frame_highlight (dpyinfo->win32_highlight_frame); } } /* Keyboard processing - modifier keys, etc. */ /* Convert a keysym to its name. */ char * x_get_keysym_name (keysym) int keysym; { /* Make static so we can always return it */ static char value[100]; BLOCK_INPUT; GetKeyNameText(keysym, value, 100); UNBLOCK_INPUT; return value; } /* Mouse clicks and mouse movement. Rah. */ /* Given a pixel position (PIX_X, PIX_Y) on the frame F, return glyph co-ordinates in (*X, *Y). Set *BOUNDS to the rectangle that the glyph at X, Y occupies, if BOUNDS != 0. If NOCLIP is nonzero, do not force the value into range. */ void pixel_to_glyph_coords (f, pix_x, pix_y, x, y, bounds, noclip) FRAME_PTR f; register int pix_x, pix_y; register int *x, *y; RECT *bounds; int noclip; { /* Arrange for the division in PIXEL_TO_CHAR_COL etc. to round down even for negative values. */ if (pix_x < 0) pix_x -= FONT_WIDTH ((f)->output_data.win32->font) - 1; if (pix_y < 0) pix_y -= (f)->output_data.win32->line_height - 1; pix_x = PIXEL_TO_CHAR_COL (f, pix_x); pix_y = PIXEL_TO_CHAR_ROW (f, pix_y); if (bounds) { bounds->left = CHAR_TO_PIXEL_COL (f, pix_x); bounds->top = CHAR_TO_PIXEL_ROW (f, pix_y); bounds->right = bounds->left + FONT_WIDTH (f->output_data.win32->font) - 1; bounds->bottom = bounds->top + f->output_data.win32->line_height - 1; } if (!noclip) { if (pix_x < 0) pix_x = 0; else if (pix_x > f->width) pix_x = f->width; if (pix_y < 0) pix_y = 0; else if (pix_y > f->height) pix_y = f->height; } *x = pix_x; *y = pix_y; } void glyph_to_pixel_coords (f, x, y, pix_x, pix_y) FRAME_PTR f; register int x, y; register int *pix_x, *pix_y; { *pix_x = CHAR_TO_PIXEL_COL (f, x); *pix_y = CHAR_TO_PIXEL_ROW (f, y); } BOOL parse_button (message, pbutton, pup) int message; int * pbutton; int * pup; { int button = 0; int up = 0; switch (message) { case WM_LBUTTONDOWN: button = 0; up = 0; break; case WM_LBUTTONUP: button = 0; up = 1; break; case WM_MBUTTONDOWN: button = 1; up = 0; break; case WM_MBUTTONUP: button = 1; up = 1; break; case WM_RBUTTONDOWN: button = 2; up = 0; break; case WM_RBUTTONUP: button = 2; up = 1; break; default: return (FALSE); } if (pup) *pup = up; if (pbutton) *pbutton = button; return (TRUE); } /* Prepare a mouse-event in *RESULT for placement in the input queue. If the event is a button press, then note that we have grabbed the mouse. */ static void construct_mouse_click (result, msg, f) struct input_event *result; Win32Msg *msg; struct frame *f; { int button; int up; parse_button (msg->msg.message, &button, &up); /* Make the event type no_event; we'll change that when we decide otherwise. */ result->kind = mouse_click; result->code = button; result->timestamp = msg->msg.time; result->modifiers = (msg->dwModifiers | (up ? up_modifier : down_modifier)); { int row, column; XSETINT (result->x, LOWORD (msg->msg.lParam)); XSETINT (result->y, HIWORD (msg->msg.lParam)); XSETFRAME (result->frame_or_window, f); } } /* Function to report a mouse movement to the mainstream Emacs code. The input handler calls this. We have received a mouse movement event, which is given in *event. If the mouse is over a different glyph than it was last time, tell the mainstream emacs code by setting mouse_moved. If not, ask for another motion event, so we can check again the next time it moves. */ static void note_mouse_movement (frame, msg) FRAME_PTR frame; MSG *msg; { last_mouse_movement_time = msg->time; if (msg->hwnd != FRAME_WIN32_WINDOW (frame)) { frame->mouse_moved = 1; last_mouse_scroll_bar = Qnil; note_mouse_highlight (frame, -1, -1); } /* Has the mouse moved off the glyph it was on at the last sighting? */ else if (LOWORD (msg->lParam) < last_mouse_glyph.left || LOWORD (msg->lParam) > last_mouse_glyph.right || HIWORD (msg->lParam) < last_mouse_glyph.left || HIWORD (msg->lParam) > last_mouse_glyph.bottom) { frame->mouse_moved = 1; last_mouse_scroll_bar = Qnil; note_mouse_highlight (frame, LOWORD (msg->lParam), HIWORD (msg->lParam)); } } /* This is used for debugging, to turn off note_mouse_highlight. */ static int disable_mouse_highlight; /* Take proper action when the mouse has moved to position X, Y on frame F as regards highlighting characters that have mouse-face properties. Also dehighlighting chars where the mouse was before. X and Y can be negative or out of range. */ static void note_mouse_highlight (f, x, y) FRAME_PTR f; int x, y; { int row, column, portion; RECT new_glyph; Lisp_Object window; struct window *w; if (disable_mouse_highlight) return; FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_x = x; FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_y = y; FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_frame = f; if (FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_defer) return; if (gc_in_progress) { FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_deferred_gc = 1; return; } /* Find out which glyph the mouse is on. */ pixel_to_glyph_coords (f, x, y, &column, &row, &new_glyph, FRAME_WIN32_DISPLAY_INFO (f)->grabbed); /* Which window is that in? */ window = window_from_coordinates (f, column, row, &portion); w = XWINDOW (window); /* If we were displaying active text in another window, clear that. */ if (! EQ (window, FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window)) clear_mouse_face (FRAME_WIN32_DISPLAY_INFO (f)); /* Are we in a window whose display is up to date? And verify the buffer's text has not changed. */ if (WINDOWP (window) && portion == 0 && row >= 0 && column >= 0 && row < FRAME_HEIGHT (f) && column < FRAME_WIDTH (f) && EQ (w->window_end_valid, w->buffer) && w->last_modified == BUF_MODIFF (XBUFFER (w->buffer))) { int *ptr = FRAME_CURRENT_GLYPHS (f)->charstarts[row]; int i, pos; /* Find which buffer position the mouse corresponds to. */ for (i = column; i >= 0; i--) if (ptr[i] > 0) break; pos = ptr[i]; /* Is it outside the displayed active region (if any)? */ if (pos <= 0) clear_mouse_face (FRAME_WIN32_DISPLAY_INFO (f)); else if (! (EQ (window, FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window) && row >= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row && row <= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row && (row > FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row || column >= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_col) && (row < FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row || column < FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_col || FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_past_end))) { Lisp_Object mouse_face, overlay, position; Lisp_Object *overlay_vec; int len, noverlays, ignor1; struct buffer *obuf; int obegv, ozv; /* If we get an out-of-range value, return now; avoid an error. */ if (pos > BUF_Z (XBUFFER (w->buffer))) return; /* Make the window's buffer temporarily current for overlays_at and compute_char_face. */ obuf = current_buffer; current_buffer = XBUFFER (w->buffer); obegv = BEGV; ozv = ZV; BEGV = BEG; ZV = Z; /* Yes. Clear the display of the old active region, if any. */ clear_mouse_face (FRAME_WIN32_DISPLAY_INFO (f)); /* Is this char mouse-active? */ XSETINT (position, pos); len = 10; overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object)); /* Put all the overlays we want in a vector in overlay_vec. Store the length in len. */ noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, NULL, NULL); noverlays = sort_overlays (overlay_vec, noverlays, w); /* Find the highest priority overlay that has a mouse-face prop. */ overlay = Qnil; for (i = 0; i < noverlays; i++) { mouse_face = Foverlay_get (overlay_vec[i], Qmouse_face); if (!NILP (mouse_face)) { overlay = overlay_vec[i]; break; } } free (overlay_vec); /* If no overlay applies, get a text property. */ if (NILP (overlay)) mouse_face = Fget_text_property (position, Qmouse_face, w->buffer); /* Handle the overlay case. */ if (! NILP (overlay)) { /* Find the range of text around this char that should be active. */ Lisp_Object before, after; int ignore; before = Foverlay_start (overlay); after = Foverlay_end (overlay); /* Record this as the current active region. */ fast_find_position (window, before, &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_col, &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row); FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_past_end = !fast_find_position (window, after, &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_col, &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row); FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window = window; FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_face_id = compute_char_face (f, w, pos, 0, 0, &ignore, pos + 1, 1); /* Display it as active. */ show_mouse_face (FRAME_WIN32_DISPLAY_INFO (f), 1); } /* Handle the text property case. */ else if (! NILP (mouse_face)) { /* Find the range of text around this char that should be active. */ Lisp_Object before, after, beginning, end; int ignore; beginning = Fmarker_position (w->start); XSETINT (end, (BUF_Z (XBUFFER (w->buffer)) - XFASTINT (w->window_end_pos))); before = Fprevious_single_property_change (make_number (pos + 1), Qmouse_face, w->buffer, beginning); after = Fnext_single_property_change (position, Qmouse_face, w->buffer, end); /* Record this as the current active region. */ fast_find_position (window, before, &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_col, &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row); FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_past_end = !fast_find_position (window, after, &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_col, &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row); FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window = window; FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_face_id = compute_char_face (f, w, pos, 0, 0, &ignore, pos + 1, 1); /* Display it as active. */ show_mouse_face (FRAME_WIN32_DISPLAY_INFO (f), 1); } BEGV = obegv; ZV = ozv; current_buffer = obuf; } } } /* Find the row and column of position POS in window WINDOW. Store them in *COLUMNP and *ROWP. This assumes display in WINDOW is up to date. If POS is above start of WINDOW, return coords of start of first screen line. If POS is after end of WINDOW, return coords of end of last screen line. Value is 1 if POS is in range, 0 if it was off screen. */ static int fast_find_position (window, pos, columnp, rowp) Lisp_Object window; int pos; int *columnp, *rowp; { struct window *w = XWINDOW (window); FRAME_PTR f = XFRAME (WINDOW_FRAME (w)); int i; int row = 0; int left = w->left; int top = w->top; int height = XFASTINT (w->height) - ! MINI_WINDOW_P (w); int width = window_internal_width (w); int *charstarts; int lastcol; int maybe_next_line = 0; /* Find the right row. */ for (i = 0; i < height; i++) { int linestart = FRAME_CURRENT_GLYPHS (f)->charstarts[top + i][left]; if (linestart > pos) break; /* If the position sought is the end of the buffer, don't include the blank lines at the bottom of the window. */ if (linestart == pos && pos == BUF_ZV (XBUFFER (w->buffer))) { maybe_next_line = 1; break; } if (linestart > 0) row = i; } /* Find the right column with in it. */ charstarts = FRAME_CURRENT_GLYPHS (f)->charstarts[top + row]; lastcol = left; for (i = 0; i < width; i++) { if (charstarts[left + i] == pos) { *rowp = row + top; *columnp = i + left; return 1; } else if (charstarts[left + i] > pos) break; else if (charstarts[left + i] > 0) lastcol = left + i; } /* If we're looking for the end of the buffer, and we didn't find it in the line we scanned, use the start of the following line. */ if (maybe_next_line) { row++; i = 0; } *rowp = row + top; *columnp = lastcol; return 0; } /* Display the active region described by mouse_face_* in its mouse-face if HL > 0, in its normal face if HL = 0. */ static void show_mouse_face (dpyinfo, hl) struct win32_display_info *dpyinfo; int hl; { struct window *w = XWINDOW (dpyinfo->mouse_face_window); int width = window_internal_width (w); FRAME_PTR f = XFRAME (WINDOW_FRAME (w)); int i; int cursor_off = 0; int old_curs_x = curs_x; int old_curs_y = curs_y; /* Set these variables temporarily so that if we have to turn the cursor off and on again we will put it back at the same place. */ curs_x = f->phys_cursor_x; curs_y = f->phys_cursor_y; for (i = FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row; i <= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row; i++) { int column = (i == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row ? FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_col : w->left); int endcolumn = (i == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row ? FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_col : w->left + width); endcolumn = min (endcolumn, FRAME_CURRENT_GLYPHS (f)->used[i]); /* If the cursor's in the text we are about to rewrite, turn the cursor off. */ if (i == curs_y && curs_x >= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_col - 1 && curs_x <= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_col) { x_display_cursor (f, 0); cursor_off = 1; } dumpglyphs (f, CHAR_TO_PIXEL_COL (f, column), CHAR_TO_PIXEL_ROW (f, i), FRAME_CURRENT_GLYPHS (f)->glyphs[i] + column, endcolumn - column, /* Highlight with mouse face if hl > 0. */ hl > 0 ? 3 : 0, 0); } /* If we turned the cursor off, turn it back on. */ if (cursor_off) x_display_cursor (f, 1); curs_x = old_curs_x; curs_y = old_curs_y; /* Change the mouse cursor according to the value of HL. */ if (hl > 0) SetCursor (f->output_data.win32->cross_cursor); else SetCursor (f->output_data.win32->text_cursor); } /* Clear out the mouse-highlighted active region. Redraw it unhighlighted first. */ static void clear_mouse_face (dpyinfo) struct win32_display_info *dpyinfo; { if (! NILP (dpyinfo->mouse_face_window)) show_mouse_face (dpyinfo, 0); dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; dpyinfo->mouse_face_window = Qnil; } struct scroll_bar *x_window_to_scroll_bar (); static void x_scroll_bar_report_motion (); /* Return the current position of the mouse. *fp should be a frame which indicates which display to ask about. If the mouse movement started in a scroll bar, set *fp, *bar_window, and *part to the frame, window, and scroll bar part that the mouse is over. Set *x and *y to the portion and whole of the mouse's position on the scroll bar. If the mouse movement started elsewhere, set *fp to the frame the mouse is on, *bar_window to nil, and *x and *y to the character cell the mouse is over. Set *time to the server timestamp for the time at which the mouse was at this position. Don't store anything if we don't have a valid set of values to report. This clears the mouse_moved flag, so we can wait for the next mouse movement. This also calls XQueryPointer, which will cause the server to give us another MotionNotify when the mouse moves again. */ static void win32_mouse_position (fp, insist, bar_window, part, x, y, time) FRAME_PTR *fp; int insist; Lisp_Object *bar_window; enum scroll_bar_part *part; Lisp_Object *x, *y; unsigned long *time; { FRAME_PTR f1; BLOCK_INPUT; if (! NILP (last_mouse_scroll_bar)) x_scroll_bar_report_motion (fp, bar_window, part, x, y, time); else { POINT pt; Lisp_Object frame, tail; /* Clear the mouse-moved flag for every frame on this display. */ FOR_EACH_FRAME (tail, frame) XFRAME (frame)->mouse_moved = 0; last_mouse_scroll_bar = Qnil; GetCursorPos (&pt); /* Now we have a position on the root; find the innermost window containing the pointer. */ { if (FRAME_WIN32_DISPLAY_INFO (*fp)->grabbed && last_mouse_frame && FRAME_LIVE_P (last_mouse_frame)) { f1 = last_mouse_frame; } else { /* Is win one of our frames? */ f1 = x_window_to_frame (FRAME_WIN32_DISPLAY_INFO (*fp), WindowFromPoint(pt)); } /* If not, is it one of our scroll bars? */ if (! f1) { struct scroll_bar *bar = x_window_to_scroll_bar (WindowFromPoint(pt)); if (bar) { f1 = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); } } if (f1 == 0 && insist) f1 = selected_frame; if (f1) { int ignore1, ignore2; ScreenToClient (FRAME_WIN32_WINDOW (f1), &pt); /* Ok, we found a frame. Store all the values. */ pixel_to_glyph_coords (f1, pt.x, pt.y, &ignore1, &ignore2, &last_mouse_glyph, FRAME_WIN32_DISPLAY_INFO (f1)->grabbed || insist); *bar_window = Qnil; *part = 0; *fp = f1; XSETINT (*x, pt.x); XSETINT (*y, pt.y); *time = last_mouse_movement_time; } } } UNBLOCK_INPUT; } /* Scroll bar support. */ /* Given an window ID, find the struct scroll_bar which manages it. This can be called in GC, so we have to make sure to strip off mark bits. */ struct scroll_bar * x_window_to_scroll_bar (window_id) Window window_id; { Lisp_Object tail, frame; for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) { Lisp_Object frame, bar, condemned; frame = XCONS (tail)->car; /* All elements of Vframe_list should be frames. */ if (! GC_FRAMEP (frame)) abort (); /* Scan this frame's scroll bar list for a scroll bar with the right window ID. */ condemned = FRAME_CONDEMNED_SCROLL_BARS (XFRAME (frame)); for (bar = FRAME_SCROLL_BARS (XFRAME (frame)); /* This trick allows us to search both the ordinary and condemned scroll bar lists with one loop. */ ! GC_NILP (bar) || (bar = condemned, condemned = Qnil, ! GC_NILP (bar)); bar = XSCROLL_BAR (bar)->next) if (SCROLL_BAR_WIN32_WINDOW (XSCROLL_BAR (bar)) == window_id) return XSCROLL_BAR (bar); } return 0; } HWND my_create_scrollbar (f, bar) struct frame * f; struct scroll_bar * bar; { MSG msg; PostThreadMessage (dwWinThreadId, WM_EMACS_CREATESCROLLBAR, (WPARAM) f, (LPARAM) bar); GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE); return ((HWND) msg.wParam); } void my_destroy_window (f, hwnd) struct frame * f; HWND hwnd; { SendMessage (FRAME_WIN32_WINDOW (f), WM_EMACS_DESTROYWINDOW, (WPARAM) hwnd, 0); } /* Open a new window to serve as a scroll bar, and return the scroll bar vector for it. */ static struct scroll_bar * x_scroll_bar_create (window, top, left, width, height) struct window *window; int top, left, width, height; { FRAME_PTR f = XFRAME (WINDOW_FRAME (window)); struct scroll_bar *bar = XSCROLL_BAR (Fmake_vector (make_number (SCROLL_BAR_VEC_SIZE), Qnil)); HWND hwnd; BLOCK_INPUT; XSETWINDOW (bar->window, window); XSETINT (bar->top, top); XSETINT (bar->left, left); XSETINT (bar->width, width); XSETINT (bar->height, height); XSETINT (bar->start, 0); XSETINT (bar->end, 0); bar->dragging = Qnil; /* Requires geometry to be set before call to create the real window */ hwnd = my_create_scrollbar (f, bar); SetScrollRange (hwnd, SB_CTL, 0, height, FALSE); SetScrollPos (hwnd, SB_CTL, 0, TRUE); SET_SCROLL_BAR_WIN32_WINDOW (bar, hwnd); /* Add bar to its frame's list of scroll bars. */ bar->next = FRAME_SCROLL_BARS (f); bar->prev = Qnil; XSETVECTOR (FRAME_SCROLL_BARS (f), bar); if (! NILP (bar->next)) XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); UNBLOCK_INPUT; return bar; } /* Draw BAR's handle in the proper position. If the handle is already drawn from START to END, don't bother redrawing it, unless REBUILD is non-zero; in that case, always redraw it. (REBUILD is handy for drawing the handle after expose events.) Normally, we want to constrain the start and end of the handle to fit inside its rectangle, but if the user is dragging the scroll bar handle, we want to let them drag it down all the way, so that the bar's top is as far down as it goes; otherwise, there's no way to move to the very end of the buffer. */ static void x_scroll_bar_set_handle (bar, start, end, rebuild) struct scroll_bar *bar; int start, end; int rebuild; { int dragging = ! NILP (bar->dragging); Window w = SCROLL_BAR_WIN32_WINDOW (bar); FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); /* If the display is already accurate, do nothing. */ if (! rebuild && start == XINT (bar->start) && end == XINT (bar->end)) return; BLOCK_INPUT; /* Store the adjusted setting in the scroll bar. */ XSETINT (bar->start, start); XSETINT (bar->end, end); /* If we are less than half of the page use start otherwise use end */ SetScrollPos (w, SB_CTL, ((start >> 1) < bar->height)?start:end, TRUE); UNBLOCK_INPUT; } /* Move a scroll bar around on the screen, to accommodate changing window configurations. */ static void x_scroll_bar_move (bar, top, left, width, height) struct scroll_bar *bar; int top, left, width, height; { Window w = SCROLL_BAR_WIN32_WINDOW (bar); FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); BLOCK_INPUT; MoveWindow (w, left, top, width, height, TRUE); SetScrollRange (w, SB_CTL, 0, height, FALSE); XSETINT (bar->left, left); XSETINT (bar->top, top); XSETINT (bar->width, width); XSETINT (bar->height, height); UNBLOCK_INPUT; } /* Destroy the window for BAR, and set its Emacs window's scroll bar to nil. */ static void x_scroll_bar_remove (bar) struct scroll_bar *bar; { FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); BLOCK_INPUT; /* Destroy the window. */ my_destroy_window (f, SCROLL_BAR_WIN32_WINDOW (bar)); /* Disassociate this scroll bar from its window. */ XWINDOW (bar->window)->vertical_scroll_bar = Qnil; UNBLOCK_INPUT; } /* Set the handle of the vertical scroll bar for WINDOW to indicate that we are displaying PORTION characters out of a total of WHOLE characters, starting at POSITION. If WINDOW has no scroll bar, create one. */ static void win32_set_vertical_scroll_bar (window, portion, whole, position) struct window *window; int portion, whole, position; { FRAME_PTR f = XFRAME (WINDOW_FRAME (window)); int top = XINT (window->top); int left = WINDOW_VERTICAL_SCROLL_BAR_COLUMN (window); int height = WINDOW_VERTICAL_SCROLL_BAR_HEIGHT (window); /* Where should this scroll bar be, pixelwise? */ int pixel_top = CHAR_TO_PIXEL_ROW (f, top); int pixel_left = CHAR_TO_PIXEL_COL (f, left); int pixel_width = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f) : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.win32->font))); int pixel_height = VERTICAL_SCROLL_BAR_PIXEL_HEIGHT (f, height); struct scroll_bar *bar; /* Does the scroll bar exist yet? */ if (NILP (window->vertical_scroll_bar)) bar = x_scroll_bar_create (window, pixel_top, pixel_left, pixel_width, pixel_height); else { /* It may just need to be moved and resized. */ bar = XSCROLL_BAR (window->vertical_scroll_bar); x_scroll_bar_move (bar, pixel_top, pixel_left, pixel_width, pixel_height); } /* Set the scroll bar's current state, unless we're currently being dragged. */ if (NILP (bar->dragging)) { int top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (pixel_height); if (whole == 0) x_scroll_bar_set_handle (bar, 0, top_range, 0); else { int start = (int) (((double) position * top_range) / whole); int end = (int) (((double) (position + portion) * top_range) / whole); x_scroll_bar_set_handle (bar, start, end, 0); } } XSETVECTOR (window->vertical_scroll_bar, bar); } /* The following three hooks are used when we're doing a thorough redisplay of the frame. We don't explicitly know which scroll bars are going to be deleted, because keeping track of when windows go away is a real pain - "Can you say set-window-configuration, boys and girls?" Instead, we just assert at the beginning of redisplay that *all* scroll bars are to be removed, and then save a scroll bar from the fiery pit when we actually redisplay its window. */ /* Arrange for all scroll bars on FRAME to be removed at the next call to `*judge_scroll_bars_hook'. A scroll bar may be spared if `*redeem_scroll_bar_hook' is applied to its window before the judgement. */ static void win32_condemn_scroll_bars (frame) FRAME_PTR frame; { /* The condemned list should be empty at this point; if it's not, then the rest of Emacs isn't using the condemn/redeem/judge protocol correctly. */ if (! NILP (FRAME_CONDEMNED_SCROLL_BARS (frame))) abort (); /* Move them all to the "condemned" list. */ FRAME_CONDEMNED_SCROLL_BARS (frame) = FRAME_SCROLL_BARS (frame); FRAME_SCROLL_BARS (frame) = Qnil; } /* Unmark WINDOW's scroll bar for deletion in this judgement cycle. Note that WINDOW isn't necessarily condemned at all. */ static void win32_redeem_scroll_bar (window) struct window *window; { struct scroll_bar *bar; /* We can't redeem this window's scroll bar if it doesn't have one. */ if (NILP (window->vertical_scroll_bar)) abort (); bar = XSCROLL_BAR (window->vertical_scroll_bar); /* Unlink it from the condemned list. */ { FRAME_PTR f = XFRAME (WINDOW_FRAME (window)); if (NILP (bar->prev)) { /* If the prev pointer is nil, it must be the first in one of the lists. */ if (EQ (FRAME_SCROLL_BARS (f), window->vertical_scroll_bar)) /* It's not condemned. Everything's fine. */ return; else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f), window->vertical_scroll_bar)) FRAME_CONDEMNED_SCROLL_BARS (f) = bar->next; else /* If its prev pointer is nil, it must be at the front of one or the other! */ abort (); } else XSCROLL_BAR (bar->prev)->next = bar->next; if (! NILP (bar->next)) XSCROLL_BAR (bar->next)->prev = bar->prev; bar->next = FRAME_SCROLL_BARS (f); bar->prev = Qnil; XSETVECTOR (FRAME_SCROLL_BARS (f), bar); if (! NILP (bar->next)) XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); } } /* Remove all scroll bars on FRAME that haven't been saved since the last call to `*condemn_scroll_bars_hook'. */ static void win32_judge_scroll_bars (f) FRAME_PTR f; { Lisp_Object bar, next; bar = FRAME_CONDEMNED_SCROLL_BARS (f); /* Clear out the condemned list now so we won't try to process any more events on the hapless scroll bars. */ FRAME_CONDEMNED_SCROLL_BARS (f) = Qnil; for (; ! NILP (bar); bar = next) { struct scroll_bar *b = XSCROLL_BAR (bar); x_scroll_bar_remove (b); next = b->next; b->next = b->prev = Qnil; } /* Now there should be no references to the condemned scroll bars, and they should get garbage-collected. */ } /* Handle a mouse click on the scroll bar BAR. If *EMACS_EVENT's kind is set to something other than no_event, it is enqueued. This may be called from a signal handler, so we have to ignore GC mark bits. */ static void x_scroll_bar_handle_click (bar, msg, emacs_event) struct scroll_bar *bar; Win32Msg *msg; struct input_event *emacs_event; { if (! GC_WINDOWP (bar->window)) abort (); emacs_event->kind = scroll_bar_click; emacs_event->code = 0; emacs_event->modifiers = (msg->dwModifiers | ((LOWORD (msg->msg.wParam) == SB_ENDSCROLL) ? up_modifier : down_modifier)); emacs_event->frame_or_window = bar->window; emacs_event->timestamp = msg->msg.time; { int internal_height = VERTICAL_SCROLL_BAR_INSIDE_HEIGHT (XINT (bar->height)); int top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (XINT (bar->height)); int y = GetScrollPos ((HWND) msg->msg.lParam, SB_CTL); switch (LOWORD (msg->msg.wParam)) { case SB_THUMBPOSITION: case SB_THUMBTRACK: emacs_event->part = scroll_bar_handle; if (VERTICAL_SCROLL_BAR_TOP_RANGE (XINT (bar->height)) <= 0xffff) y = HIWORD (msg->msg.wParam); break; case SB_LINEDOWN: emacs_event->part = scroll_bar_handle; if (y < top_range) y++; break; case SB_LINEUP: emacs_event->part = scroll_bar_handle; if (y) y--; break; case SB_PAGEUP: emacs_event->part = scroll_bar_above_handle; break; case SB_PAGEDOWN: emacs_event->part = scroll_bar_below_handle; break; case SB_TOP: emacs_event->part = scroll_bar_handle; y = 0; break; case SB_BOTTOM: emacs_event->part = scroll_bar_handle; y = top_range; break; case SB_ENDSCROLL: emacs_event->part = scroll_bar_handle; x_scroll_bar_set_handle (bar, y , y, 0); break; default: emacs_event->part = scroll_bar_handle; break; } XSETINT (emacs_event->x, y); XSETINT (emacs_event->y, top_range); } } /* Return information to the user about the current position of the mouse on the scroll bar. */ static void x_scroll_bar_report_motion (fp, bar_window, part, x, y, time) FRAME_PTR *fp; Lisp_Object *bar_window; enum scroll_bar_part *part; Lisp_Object *x, *y; unsigned long *time; { struct scroll_bar *bar = XSCROLL_BAR (last_mouse_scroll_bar); Window w = SCROLL_BAR_WIN32_WINDOW (bar); FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); int pos; BLOCK_INPUT; *fp = f; *bar_window = bar->window; pos = GetScrollPos (w, SB_CTL); switch (LOWORD (last_mouse_scroll_bar_pos)) { case SB_THUMBPOSITION: case SB_THUMBTRACK: *part = scroll_bar_handle; if (VERTICAL_SCROLL_BAR_TOP_RANGE (XINT (bar->height)) <= 0xffff) pos = HIWORD (last_mouse_scroll_bar_pos); break; case SB_LINEDOWN: *part = scroll_bar_handle; pos++; break; default: *part = scroll_bar_handle; break; } XSETINT(*x, pos); XSETINT(*y, VERTICAL_SCROLL_BAR_TOP_RANGE (XINT (bar->height))); f->mouse_moved = 0; last_mouse_scroll_bar = Qnil; *time = last_mouse_movement_time; UNBLOCK_INPUT; } /* The screen has been cleared so we may have changed foreground or background colors, and the scroll bars may need to be redrawn. Clear out the scroll bars, and ask for expose events, so we can redraw them. */ x_scroll_bar_clear (f) FRAME_PTR f; { #if 0 Lisp_Object bar; for (bar = FRAME_SCROLL_BARS (f); VECTORP (bar); bar = XSCROLL_BAR (bar)->next) UpdateWindow (SCROLL_BAR_WIN32_WINDOW (XSCROLL_BAR (bar))); #endif } /* The main Win32 event-reading loop - w32_read_socket. */ /* Timestamp of enter window event. This is only used by w32_read_socket, but we have to put it out here, since static variables within functions sometimes don't work. */ static Time enter_timestamp; /* Record the last 100 characters stored to help debug the loss-of-chars-during-GC problem. */ int temp_index; short temp_buffer[100]; /* Read events coming from the Win32 shell. This routine is called by the SIGIO handler. We return as soon as there are no more events to be read. Events representing keys are stored in buffer BUFP, which can hold up to NUMCHARS characters. We return the number of characters stored into the buffer, thus pretending to be `read'. WAITP is nonzero if we should block until input arrives. EXPECTED is nonzero if the caller knows input is available. Some of these messages are reposted back to the message queue since the system calls the winproc directly in a context where we cannot return the data nor can we guarantee the state we are in. So if we dispatch them we will get into an infinite loop. To prevent this from ever happening we will set a variable to indicate we are in the read_socket call and indicate which message we are processing since the winproc gets called recursively with different messages by the system. */ int w32_read_socket (sd, bufp, numchars, waitp, expected) register int sd; register struct input_event *bufp; register int numchars; int waitp; int expected; { int count = 0; int nbytes = 0; int items_pending; /* How many items are in the X queue. */ Win32Msg msg; struct frame *f; int event_found = 0; int prefix; Lisp_Object part; struct win32_display_info *dpyinfo = &one_win32_display_info; if (interrupt_input_blocked) { interrupt_input_pending = 1; return -1; } interrupt_input_pending = 0; BLOCK_INPUT; /* So people can tell when we have read the available input. */ input_signal_count++; if (numchars <= 0) abort (); /* Don't think this happens. */ while (get_next_msg (&msg, 0)) { switch (msg.msg.message) { case WM_ERASEBKGND: f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (f) { win32_clear_rect (f, NULL, &msg.rect); } break; case WM_PAINT: { f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (f) { if (f->async_visible == 0) { f->async_visible = 1; f->async_iconified = 0; SET_FRAME_GARBAGED (f); } else { dumprectangle (f, msg.rect.left, msg.rect.top, msg.rect.right-msg.rect.left+1, msg.rect.bottom-msg.rect.top+1); } } } break; case WM_KEYDOWN: case WM_SYSKEYDOWN: f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (f && !f->iconified) { if (temp_index == sizeof temp_buffer / sizeof (short)) temp_index = 0; temp_buffer[temp_index++] = msg.msg.wParam; bufp->kind = non_ascii_keystroke; bufp->code = msg.msg.wParam; bufp->modifiers = msg.dwModifiers; XSETFRAME (bufp->frame_or_window, f); bufp->timestamp = msg.msg.time; bufp++; numchars--; count++; } break; case WM_SYSCHAR: case WM_CHAR: f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (f && !f->iconified) { if (numchars > 1) { if (temp_index == sizeof temp_buffer / sizeof (short)) temp_index = 0; temp_buffer[temp_index++] = msg.msg.wParam; bufp->kind = ascii_keystroke; bufp->code = msg.msg.wParam; XSETFRAME (bufp->frame_or_window, f); bufp->modifiers = msg.dwModifiers; bufp->timestamp = msg.msg.time; bufp++; numchars--; count++; } else { abort (); } } break; case WM_MOUSEMOVE: if (dpyinfo->grabbed && last_mouse_frame && FRAME_LIVE_P (last_mouse_frame)) f = last_mouse_frame; else f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (f) note_mouse_movement (f, &msg.msg); else clear_mouse_face (FRAME_WIN32_DISPLAY_INFO (f)); break; case WM_LBUTTONDOWN: case WM_LBUTTONUP: case WM_MBUTTONDOWN: case WM_MBUTTONUP: case WM_RBUTTONDOWN: case WM_RBUTTONUP: { int button; int up; if (dpyinfo->grabbed && last_mouse_frame && FRAME_LIVE_P (last_mouse_frame)) f = last_mouse_frame; else f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (f) { if ((!dpyinfo->win32_focus_frame || f == dpyinfo->win32_focus_frame) && (numchars >= 1)) { construct_mouse_click (bufp, &msg, f); bufp++; count++; numchars--; } } parse_button (msg.msg.message, &button, &up); if (up) { dpyinfo->grabbed &= ~ (1 << button); } else { dpyinfo->grabbed |= (1 << button); last_mouse_frame = f; } } break; case WM_VSCROLL: { struct scroll_bar *bar = x_window_to_scroll_bar ((HWND)msg.msg.lParam); if (bar && numchars >= 1) { x_scroll_bar_handle_click (bar, &msg, bufp); bufp++; count++; numchars--; } } break; case WM_MOVE: f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (f && !f->async_iconified) { f->output_data.win32->left_pos = LOWORD (msg.msg.lParam); f->output_data.win32->top_pos = HIWORD (msg.msg.lParam); } break; case WM_SIZE: f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (f && !f->async_iconified && msg.msg.wParam != SIZE_MINIMIZED) { RECT rect; int rows; int columns; int width; int height; GetClientRect(msg.msg.hwnd, &rect); height = rect.bottom - rect.top + 1; width = rect.right - rect.left + 1; rows = PIXEL_TO_CHAR_HEIGHT (f, height); columns = PIXEL_TO_CHAR_WIDTH (f, width); /* Even if the number of character rows and columns has not changed, the font size may have changed, so we need to check the pixel dimensions as well. */ if (columns != f->width || rows != f->height || width != f->output_data.win32->pixel_width || height != f->output_data.win32->pixel_height) { /* I had set this to 0, 0 - I am not sure why?? */ change_frame_size (f, rows, columns, 0, 1); SET_FRAME_GARBAGED (f); f->output_data.win32->pixel_width = width; f->output_data.win32->pixel_height = height; f->output_data.win32->win_gravity = NorthWestGravity; } } break; case WM_SETFOCUS: case WM_KILLFOCUS: f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (msg.msg.message == WM_SETFOCUS) { x_new_focus_frame (dpyinfo, f); } else if (f == dpyinfo->win32_focus_frame) x_new_focus_frame (dpyinfo, 0); break; case WM_SYSCOMMAND: switch (msg.msg.wParam) { case SC_CLOSE: f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (f) { if (numchars == 0) abort (); bufp->kind = delete_window_event; XSETFRAME (bufp->frame_or_window, f); bufp++; count++; numchars--; } break; case SC_MINIMIZE: f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (f) { f->async_visible = 1; f->async_iconified = 1; bufp->kind = iconify_event; XSETFRAME (bufp->frame_or_window, f); bufp++; count++; numchars--; } break; case SC_MAXIMIZE: case SC_RESTORE: f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (f) { f->async_visible = 1; f->async_iconified = 0; /* wait_reading_process_input will notice this and update the frame's display structures. */ SET_FRAME_GARBAGED (f); if (f->iconified) { bufp->kind = deiconify_event; XSETFRAME (bufp->frame_or_window, f); bufp++; count++; numchars--; } else /* Force a redisplay sooner or later to update the frame titles in case this is the second frame. */ record_asynch_buffer_change (); } break; } break; case WM_CLOSE: f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (f) { if (numchars == 0) abort (); bufp->kind = delete_window_event; XSETFRAME (bufp->frame_or_window, f); bufp++; count++; numchars--; } break; case WM_COMMAND: f = x_window_to_frame (dpyinfo, msg.msg.hwnd); if (f) { if (msg.msg.lParam == 0) { /* Came from window menu */ extern Lisp_Object get_frame_menubar_event (); Lisp_Object event = get_frame_menubar_event (f, msg.msg.wParam); struct input_event buf; Lisp_Object frame; XSETFRAME (frame, f); buf.kind = menu_bar_event; /* Store initial menu bar event */ if (!NILP (event)) { buf.frame_or_window = Fcons (frame, Fcons (Qmenu_bar, Qnil)); kbd_buffer_store_event (&buf); } /* Enqueue the events */ while (!NILP (event)) { buf.frame_or_window = Fcons (frame, XCONS (event)->car); kbd_buffer_store_event (&buf); event = XCONS (event)->cdr; } } else { /* Came from popup menu */ } } break; } } /* If the focus was just given to an autoraising frame, raise it now. */ /* ??? This ought to be able to handle more than one such frame. */ if (pending_autoraise_frame) { x_raise_frame (pending_autoraise_frame); pending_autoraise_frame = 0; } UNBLOCK_INPUT; return count; } /* Drawing the cursor. */ /* Draw a hollow box cursor. Don't change the inside of the box. */ static void x_draw_box (f) struct frame *f; { RECT rect; HBRUSH hb; HDC hdc; hdc = my_get_dc (FRAME_WIN32_WINDOW (f)); hb = CreateSolidBrush (f->output_data.win32->cursor_pixel); rect.left = CHAR_TO_PIXEL_COL (f, curs_x); rect.top = CHAR_TO_PIXEL_ROW (f, curs_y); rect.right = rect.left + FONT_WIDTH (f->output_data.win32->font) - 1; rect.bottom = rect.top + f->output_data.win32->line_height - 1; /* rect.left++; */ /* rect.top++; */ rect.right--; rect.bottom--; FrameRect (hdc, &rect, hb); DeleteObject (hb); ReleaseDC (FRAME_WIN32_WINDOW (f), hdc); } /* Clear the cursor of frame F to background color, and mark the cursor as not shown. This is used when the text where the cursor is is about to be rewritten. */ static void clear_cursor (f) struct frame *f; { if (! FRAME_VISIBLE_P (f) || f->phys_cursor_x < 0) return; x_display_cursor (f, 0); f->phys_cursor_x = -1; } /* Redraw the glyph at ROW, COLUMN on frame F, in the style HIGHLIGHT. HIGHLIGHT is as defined for dumpglyphs. Return the glyph drawn. */ static void x_draw_single_glyph (f, row, column, glyph, highlight) struct frame *f; int row, column; GLYPH glyph; int highlight; { dumpglyphs (f, CHAR_TO_PIXEL_COL (f, column), CHAR_TO_PIXEL_ROW (f, row), &glyph, 1, highlight, 0); } static void x_display_bar_cursor (f, on) struct frame *f; int on; { struct frame_glyphs *current_glyphs = FRAME_CURRENT_GLYPHS (f); /* This is pointless on invisible frames, and dangerous on garbaged frames; in the latter case, the frame may be in the midst of changing its size, and curs_x and curs_y may be off the frame. */ if (! FRAME_VISIBLE_P (f) || FRAME_GARBAGED_P (f)) return; if (! on && f->phys_cursor_x < 0) return; /* If we're not updating, then we want to use the current frame's cursor position, not our local idea of where the cursor ought to be. */ if (f != updating_frame) { curs_x = FRAME_CURSOR_X (f); curs_y = FRAME_CURSOR_Y (f); } /* If there is anything wrong with the current cursor state, remove it. */ if (f->phys_cursor_x >= 0 && (!on || f->phys_cursor_x != curs_x || f->phys_cursor_y != curs_y || f->output_data.win32->current_cursor != bar_cursor)) { /* Erase the cursor by redrawing the character underneath it. */ x_draw_single_glyph (f, f->phys_cursor_y, f->phys_cursor_x, f->phys_cursor_glyph, current_glyphs->highlight[f->phys_cursor_y]); f->phys_cursor_x = -1; } /* If we now need a cursor in the new place or in the new form, do it so. */ if (on && (f->phys_cursor_x < 0 || (f->output_data.win32->current_cursor != bar_cursor))) { f->phys_cursor_glyph = ((current_glyphs->enable[curs_y] && curs_x < current_glyphs->used[curs_y]) ? current_glyphs->glyphs[curs_y][curs_x] : SPACEGLYPH); win32_fill_area (f, NULL, f->output_data.win32->cursor_pixel, CHAR_TO_PIXEL_COL (f, curs_x), CHAR_TO_PIXEL_ROW (f, curs_y), max (f->output_data.win32->cursor_width, 1), f->output_data.win32->line_height); f->phys_cursor_x = curs_x; f->phys_cursor_y = curs_y; f->output_data.win32->current_cursor = bar_cursor; } } /* Turn the displayed cursor of frame F on or off according to ON. If ON is nonzero, where to put the cursor is specified by F->cursor_x and F->cursor_y. */ static void x_display_box_cursor (f, on) struct frame *f; int on; { struct frame_glyphs *current_glyphs = FRAME_CURRENT_GLYPHS (f); /* This is pointless on invisible frames, and dangerous on garbaged frames; in the latter case, the frame may be in the midst of changing its size, and curs_x and curs_y may be off the frame. */ if (! FRAME_VISIBLE_P (f) || FRAME_GARBAGED_P (f)) return; /* If cursor is off and we want it off, return quickly. */ if (!on && f->phys_cursor_x < 0) return; /* If we're not updating, then we want to use the current frame's cursor position, not our local idea of where the cursor ought to be. */ if (f != updating_frame) { curs_x = FRAME_CURSOR_X (f); curs_y = FRAME_CURSOR_Y (f); } /* If cursor is currently being shown and we don't want it to be or it is in the wrong place, or we want a hollow box and it's not so, (pout!) erase it. */ if (f->phys_cursor_x >= 0 && (!on || f->phys_cursor_x != curs_x || f->phys_cursor_y != curs_y || (f->output_data.win32->current_cursor != hollow_box_cursor && (f != FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame)))) { int mouse_face_here = 0; struct frame_glyphs *active_glyphs = FRAME_CURRENT_GLYPHS (f); /* If the cursor is in the mouse face area, redisplay that when we clear the cursor. */ if (f == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_frame && (f->phys_cursor_y > FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row || (f->phys_cursor_y == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row && f->phys_cursor_x >= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_col)) && (f->phys_cursor_y < FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row || (f->phys_cursor_y == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row && f->phys_cursor_x < FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_col)) /* Don't redraw the cursor's spot in mouse face if it is at the end of a line (on a newline). The cursor appears there, but mouse highlighting does not. */ && active_glyphs->used[f->phys_cursor_y] > f->phys_cursor_x) mouse_face_here = 1; /* If the font is not as tall as a whole line, we must explicitly clear the line's whole height. */ if (FONT_HEIGHT (f->output_data.win32->font) != f->output_data.win32->line_height) win32_clear_area (f, NULL, CHAR_TO_PIXEL_COL (f, f->phys_cursor_x), CHAR_TO_PIXEL_ROW (f, f->phys_cursor_y), FONT_WIDTH (f->output_data.win32->font), f->output_data.win32->line_height); /* Erase the cursor by redrawing the character underneath it. */ x_draw_single_glyph (f, f->phys_cursor_y, f->phys_cursor_x, f->phys_cursor_glyph, (mouse_face_here ? 3 : current_glyphs->highlight[f->phys_cursor_y])); f->phys_cursor_x = -1; } /* If we want to show a cursor, or we want a box cursor and it's not so, write it in the right place. */ if (on && (f->phys_cursor_x < 0 || (f->output_data.win32->current_cursor != filled_box_cursor && f == FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame))) { f->phys_cursor_glyph = ((current_glyphs->enable[curs_y] && curs_x < current_glyphs->used[curs_y]) ? current_glyphs->glyphs[curs_y][curs_x] : SPACEGLYPH); if (f != FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame) { x_draw_box (f); f->output_data.win32->current_cursor = hollow_box_cursor; } else { x_draw_single_glyph (f, curs_y, curs_x, f->phys_cursor_glyph, 2); f->output_data.win32->current_cursor = filled_box_cursor; } f->phys_cursor_x = curs_x; f->phys_cursor_y = curs_y; } } x_display_cursor (f, on) struct frame *f; int on; { BLOCK_INPUT; if (FRAME_DESIRED_CURSOR (f) == filled_box_cursor) x_display_box_cursor (f, on); else if (FRAME_DESIRED_CURSOR (f) == bar_cursor) x_display_bar_cursor (f, on); else /* Those are the only two we have implemented! */ abort (); UNBLOCK_INPUT; } /* Changing the font of the frame. */ /* Give frame F the font named FONTNAME as its default font, and return the full name of that font. FONTNAME may be a wildcard pattern; in that case, we choose some font that fits the pattern. The return value shows which font we chose. */ Lisp_Object x_new_font (f, fontname) struct frame *f; register char *fontname; { int already_loaded; int n_matching_fonts; XFontStruct *font_info; char new_font_name[101]; /* Get a font which matches this name */ { LOGFONT lf; if (!x_to_win32_font(fontname, &lf) || !win32_to_x_font(&lf, new_font_name, 100)) { return Qnil; } } /* See if we've already loaded a matching font. */ already_loaded = -1; { int i; for (i = 0; i < FRAME_WIN32_DISPLAY_INFO (f)->n_fonts; i++) if (!strcmp (FRAME_WIN32_DISPLAY_INFO (f)->font_table[i].name, new_font_name)) { already_loaded = i; fontname = FRAME_WIN32_DISPLAY_INFO (f)->font_table[i].name; break; } } /* If we have, just return it from the table. */ if (already_loaded >= 0) f->output_data.win32->font = FRAME_WIN32_DISPLAY_INFO (f)->font_table[already_loaded].font; /* Otherwise, load the font and add it to the table. */ else { XFontStruct *font; int n_fonts; font = win32_load_font(FRAME_WIN32_DISPLAY_INFO (f), fontname); if (! font) { return Qnil; } /* Do we need to create the table? */ if (FRAME_WIN32_DISPLAY_INFO (f)->font_table_size == 0) { FRAME_WIN32_DISPLAY_INFO (f)->font_table_size = 16; FRAME_WIN32_DISPLAY_INFO (f)->font_table = (struct font_info *) xmalloc (FRAME_WIN32_DISPLAY_INFO (f)->font_table_size * sizeof (struct font_info)); } /* Do we need to grow the table? */ else if (FRAME_WIN32_DISPLAY_INFO (f)->n_fonts >= FRAME_WIN32_DISPLAY_INFO (f)->font_table_size) { FRAME_WIN32_DISPLAY_INFO (f)->font_table_size *= 2; FRAME_WIN32_DISPLAY_INFO (f)->font_table = (struct font_info *) xrealloc (FRAME_WIN32_DISPLAY_INFO (f)->font_table, (FRAME_WIN32_DISPLAY_INFO (f)->font_table_size * sizeof (struct font_info))); } n_fonts = FRAME_WIN32_DISPLAY_INFO (f)->n_fonts; FRAME_WIN32_DISPLAY_INFO (f)->font_table[n_fonts].name = (char *) xmalloc (strlen (fontname) + 1); bcopy (fontname, FRAME_WIN32_DISPLAY_INFO (f)->font_table[n_fonts].name, strlen (fontname) + 1); f->output_data.win32->font = FRAME_WIN32_DISPLAY_INFO (f)->font_table[n_fonts].font = font; FRAME_WIN32_DISPLAY_INFO (f)->n_fonts++; } /* Compute the scroll bar width in character columns. */ if (f->scroll_bar_pixel_width > 0) { int wid = FONT_WIDTH (f->output_data.win32->font); f->scroll_bar_cols = (f->scroll_bar_pixel_width + wid-1) / wid; } else f->scroll_bar_cols = 2; /* Now make the frame display the given font. */ if (FRAME_WIN32_WINDOW (f) != 0) { frame_update_line_height (f); x_set_window_size (f, 0, f->width, f->height); } else /* If we are setting a new frame's font for the first time, there are no faces yet, so this font's height is the line height. */ f->output_data.win32->line_height = FONT_HEIGHT (f->output_data.win32->font); { Lisp_Object lispy_name; lispy_name = build_string (fontname); return lispy_name; } } x_calc_absolute_position (f) struct frame *f; { Window win, child; POINT pt; int flags = f->output_data.win32->size_hint_flags; pt.x = pt.y = 0; /* Find the position of the outside upper-left corner of the inner window, with respect to the outer window. */ if (f->output_data.win32->parent_desc != FRAME_WIN32_DISPLAY_INFO (f)->root_window) { BLOCK_INPUT; MapWindowPoints (FRAME_WIN32_WINDOW (f), f->output_data.win32->parent_desc, &pt, 1); UNBLOCK_INPUT; } { RECT rt; rt.left = rt.right = rt.top = rt.bottom = 0; BLOCK_INPUT; AdjustWindowRect(&rt, f->output_data.win32->dwStyle, FRAME_EXTERNAL_MENU_BAR (f)); UNBLOCK_INPUT; pt.x += (rt.right - rt.left); pt.y += (rt.bottom - rt.top); } /* Treat negative positions as relative to the leftmost bottommost position that fits on the screen. */ if (flags & XNegative) f->output_data.win32->left_pos = (FRAME_WIN32_DISPLAY_INFO (f)->width - 2 * f->output_data.win32->border_width - pt.x - PIXEL_WIDTH (f) + f->output_data.win32->left_pos); if (flags & YNegative) f->output_data.win32->top_pos = (FRAME_WIN32_DISPLAY_INFO (f)->height - 2 * f->output_data.win32->border_width - pt.y - PIXEL_HEIGHT (f) + f->output_data.win32->top_pos); /* The left_pos and top_pos are now relative to the top and left screen edges, so the flags should correspond. */ f->output_data.win32->size_hint_flags &= ~ (XNegative | YNegative); } /* CHANGE_GRAVITY is 1 when calling from Fset_frame_position, to really change the position, and 0 when calling from x_make_frame_visible (in that case, XOFF and YOFF are the current position values). It is -1 when calling from x_set_frame_parameters, which means, do adjust for borders but don't change the gravity. */ x_set_offset (f, xoff, yoff, change_gravity) struct frame *f; register int xoff, yoff; int change_gravity; { int modified_top, modified_left; if (change_gravity > 0) { f->output_data.win32->top_pos = yoff; f->output_data.win32->left_pos = xoff; f->output_data.win32->size_hint_flags &= ~ (XNegative | YNegative); if (xoff < 0) f->output_data.win32->size_hint_flags |= XNegative; if (yoff < 0) f->output_data.win32->size_hint_flags |= YNegative; f->output_data.win32->win_gravity = NorthWestGravity; } x_calc_absolute_position (f); BLOCK_INPUT; x_wm_set_size_hint (f, (long) 0, 0); /* It is a mystery why we need to add the border_width here when the frame is already visible, but experiment says we do. */ modified_left = f->output_data.win32->left_pos; modified_top = f->output_data.win32->top_pos; if (change_gravity != 0) { modified_left += f->output_data.win32->border_width; modified_top += f->output_data.win32->border_width; } SetWindowPos (FRAME_WIN32_WINDOW (f), NULL, modified_left, modified_top, 0,0, SWP_NOZORDER | SWP_NOSIZE); UNBLOCK_INPUT; } /* Call this to change the size of frame F's x-window. If CHANGE_GRAVITY is 1, we change to top-left-corner window gravity for this size change and subsequent size changes. Otherwise we leave the window gravity unchanged. */ x_set_window_size (f, change_gravity, cols, rows) struct frame *f; int change_gravity; int cols, rows; { int pixelwidth, pixelheight; BLOCK_INPUT; check_frame_size (f, &rows, &cols); f->output_data.win32->vertical_scroll_bar_extra = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f) ? 0 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f) : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.win32->font))); pixelwidth = CHAR_TO_PIXEL_WIDTH (f, cols); pixelheight = CHAR_TO_PIXEL_HEIGHT (f, rows); f->output_data.win32->win_gravity = NorthWestGravity; x_wm_set_size_hint (f, (long) 0, 0); { RECT rect; rect.left = rect.top = 0; rect.right = pixelwidth; rect.bottom = pixelheight; AdjustWindowRect(&rect, f->output_data.win32->dwStyle, FRAME_EXTERNAL_MENU_BAR (f)); /* All windows have an extra pixel */ SetWindowPos (FRAME_WIN32_WINDOW (f), NULL, 0, 0, rect.right - rect.left + 1, rect.bottom - rect.top + 1, SWP_NOZORDER | SWP_NOMOVE); } /* Now, strictly speaking, we can't be sure that this is accurate, but the window manager will get around to dealing with the size change request eventually, and we'll hear how it went when the ConfigureNotify event gets here. We could just not bother storing any of this information here, and let the ConfigureNotify event set everything up, but that might be kind of confusing to the lisp code, since size changes wouldn't be reported in the frame parameters until some random point in the future when the ConfigureNotify event arrives. */ change_frame_size (f, rows, cols, 0, 0); PIXEL_WIDTH (f) = pixelwidth; PIXEL_HEIGHT (f) = pixelheight; /* If cursor was outside the new size, mark it as off. */ if (f->phys_cursor_y >= rows || f->phys_cursor_x >= cols) { f->phys_cursor_x = -1; f->phys_cursor_y = -1; } /* We've set {FRAME,PIXEL}_{WIDTH,HEIGHT} to the values we hope to receive in the ConfigureNotify event; if we get what we asked for, then the event won't cause the screen to become garbaged, so we have to make sure to do it here. */ SET_FRAME_GARBAGED (f); UNBLOCK_INPUT; } /* Mouse warping. */ void x_set_mouse_position (f, x, y) struct frame *f; int x, y; { int pix_x, pix_y; pix_x = CHAR_TO_PIXEL_COL (f, x) + FONT_WIDTH (f->output_data.win32->font) / 2; pix_y = CHAR_TO_PIXEL_ROW (f, y) + f->output_data.win32->line_height / 2; if (pix_x < 0) pix_x = 0; if (pix_x > PIXEL_WIDTH (f)) pix_x = PIXEL_WIDTH (f); if (pix_y < 0) pix_y = 0; if (pix_y > PIXEL_HEIGHT (f)) pix_y = PIXEL_HEIGHT (f); BLOCK_INPUT; SetCursorPos (pix_x, pix_y); UNBLOCK_INPUT; } /* Move the mouse to position pixel PIX_X, PIX_Y relative to frame F. */ void x_set_mouse_pixel_position (f, pix_x, pix_y) struct frame *f; int pix_x, pix_y; { BLOCK_INPUT; SetCursorPos (pix_x, pix_y); UNBLOCK_INPUT; } /* focus shifting, raising and lowering. */ x_focus_on_frame (f) struct frame *f; { } x_unfocus_frame (f) struct frame *f; { } /* Raise frame F. */ x_raise_frame (f) struct frame *f; { if (f->async_visible) { BLOCK_INPUT; SetWindowPos (FRAME_WIN32_WINDOW (f), HWND_TOP, 0, 0, 0, 0, SWP_NOSIZE | SWP_NOMOVE); UNBLOCK_INPUT; } } /* Lower frame F. */ x_lower_frame (f) struct frame *f; { if (f->async_visible) { BLOCK_INPUT; SetWindowPos (FRAME_WIN32_WINDOW (f), HWND_BOTTOM, 0, 0, 0, 0, SWP_NOSIZE | SWP_NOMOVE); UNBLOCK_INPUT; } } static void win32_frame_raise_lower (f, raise) FRAME_PTR f; int raise; { if (raise) x_raise_frame (f); else x_lower_frame (f); } /* Change of visibility. */ /* This tries to wait until the frame is really visible. However, if the window manager asks the user where to position the frame, this will return before the user finishes doing that. The frame will not actually be visible at that time, but it will become visible later when the window manager finishes with it. */ x_make_frame_visible (f) struct frame *f; { BLOCK_INPUT; if (! FRAME_VISIBLE_P (f)) { /* We test FRAME_GARBAGED_P here to make sure we don't call x_set_offset a second time if we get to x_make_frame_visible a second time before the window gets really visible. */ if (! FRAME_ICONIFIED_P (f) && ! f->output_data.win32->asked_for_visible) x_set_offset (f, f->output_data.win32->left_pos, f->output_data.win32->top_pos, 0); f->output_data.win32->asked_for_visible = 1; ShowWindow (FRAME_WIN32_WINDOW (f), SW_SHOW); } /* Synchronize to ensure Emacs knows the frame is visible before we do anything else. We do this loop with input not blocked so that incoming events are handled. */ { Lisp_Object frame; int count = input_signal_count; /* This must come after we set COUNT. */ UNBLOCK_INPUT; XSETFRAME (frame, f); while (1) { /* Once we have handled input events, we should have received the MapNotify if one is coming. So if we have not got it yet, stop looping. Some window managers make their own decisions about visibility. */ if (input_signal_count != count) break; /* Machines that do polling rather than SIGIO have been observed to go into a busy-wait here. So we'll fake an alarm signal to let the handler know that there's something to be read. We used to raise a real alarm, but it seems that the handler isn't always enabled here. This is probably a bug. */ if (input_polling_used ()) { /* It could be confusing if a real alarm arrives while processing the fake one. Turn it off and let the handler reset it. */ alarm (0); input_poll_signal (); } /* Once we have handled input events, we should have received the MapNotify if one is coming. So if we have not got it yet, stop looping. Some window managers make their own decisions about visibility. */ if (input_signal_count != count) break; } FRAME_SAMPLE_VISIBILITY (f); } } /* Change from mapped state to withdrawn state. */ /* Make the frame visible (mapped and not iconified). */ x_make_frame_invisible (f) struct frame *f; { Window window; /* Don't keep the highlight on an invisible frame. */ if (FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame == f) FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame = 0; BLOCK_INPUT; ShowWindow (FRAME_WIN32_WINDOW (f), SW_HIDE); /* We can't distinguish this from iconification just by the event that we get from the server. So we can't win using the usual strategy of letting FRAME_SAMPLE_VISIBILITY set this. So do it by hand, and synchronize with the server to make sure we agree. */ f->visible = 0; FRAME_ICONIFIED_P (f) = 0; f->async_visible = 0; f->async_iconified = 0; UNBLOCK_INPUT; } /* Change window state from mapped to iconified. */ void x_iconify_frame (f) struct frame *f; { int result; /* Don't keep the highlight on an invisible frame. */ if (FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame == f) FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame = 0; if (f->async_iconified) return; BLOCK_INPUT; ShowWindow (FRAME_WIN32_WINDOW (f), SW_SHOWMINIMIZED); f->async_iconified = 1; UNBLOCK_INPUT; } /* Destroy the window of frame F. */ x_destroy_window (f) struct frame *f; { struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (f); BLOCK_INPUT; my_destroy_window (f, FRAME_WIN32_WINDOW (f)); free_frame_menubar (f); free_frame_faces (f); xfree (f->output_data.win32); f->output_data.win32 = 0; if (f == dpyinfo->win32_focus_frame) dpyinfo->win32_focus_frame = 0; if (f == dpyinfo->win32_focus_event_frame) dpyinfo->win32_focus_event_frame = 0; if (f == dpyinfo->win32_highlight_frame) dpyinfo->win32_highlight_frame = 0; dpyinfo->reference_count--; if (f == dpyinfo->mouse_face_mouse_frame) { dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; dpyinfo->mouse_face_window = Qnil; } UNBLOCK_INPUT; } /* Setting window manager hints. */ /* Set the normal size hints for the window manager, for frame F. FLAGS is the flags word to use--or 0 meaning preserve the flags that the window now has. If USER_POSITION is nonzero, we set the USPosition flag (this is useful when FLAGS is 0). */ x_wm_set_size_hint (f, flags, user_position) struct frame *f; long flags; int user_position; { Window window = FRAME_WIN32_WINDOW (f); flexlines = f->height; enter_crit (); SetWindowLong (window, WND_X_UNITS_INDEX, FONT_WIDTH (f->output_data.win32->font)); SetWindowLong (window, WND_Y_UNITS_INDEX, f->output_data.win32->line_height); leave_crit (); } /* Window manager things */ x_wm_set_icon_position (f, icon_x, icon_y) struct frame *f; int icon_x, icon_y; { #if 0 Window window = FRAME_WIN32_WINDOW (f); f->display.x->wm_hints.flags |= IconPositionHint; f->display.x->wm_hints.icon_x = icon_x; f->display.x->wm_hints.icon_y = icon_y; XSetWMHints (FRAME_X_DISPLAY (f), window, &f->display.x->wm_hints); #endif } /* Initialization. */ #ifdef USE_X_TOOLKIT static XrmOptionDescRec emacs_options[] = { {"-geometry", ".geometry", XrmoptionSepArg, NULL}, {"-iconic", ".iconic", XrmoptionNoArg, (XtPointer) "yes"}, {"-internal-border-width", "*EmacsScreen.internalBorderWidth", XrmoptionSepArg, NULL}, {"-ib", "*EmacsScreen.internalBorderWidth", XrmoptionSepArg, NULL}, {"-T", "*EmacsShell.title", XrmoptionSepArg, (XtPointer) NULL}, {"-wn", "*EmacsShell.title", XrmoptionSepArg, (XtPointer) NULL}, {"-title", "*EmacsShell.title", XrmoptionSepArg, (XtPointer) NULL}, {"-iconname", "*EmacsShell.iconName", XrmoptionSepArg, (XtPointer) NULL}, {"-in", "*EmacsShell.iconName", XrmoptionSepArg, (XtPointer) NULL}, {"-mc", "*pointerColor", XrmoptionSepArg, (XtPointer) NULL}, {"-cr", "*cursorColor", XrmoptionSepArg, (XtPointer) NULL} }; #endif /* USE_X_TOOLKIT */ static int win32_initialized = 0; struct win32_display_info * win32_term_init (display_name, xrm_option, resource_name) Lisp_Object display_name; char *xrm_option; char *resource_name; { Lisp_Object frame; char *defaultvalue; struct win32_display_info *dpyinfo; HDC hdc; BLOCK_INPUT; if (!win32_initialized) { win32_initialize (); win32_initialized = 1; } { int argc = 0; char *argv[3]; argv[0] = ""; argc = 1; if (xrm_option) { argv[argc++] = "-xrm"; argv[argc++] = xrm_option; } } dpyinfo = &one_win32_display_info; /* Put this display on the chain. */ dpyinfo->next = NULL; /* Put it on win32_display_name_list as well, to keep them parallel. */ win32_display_name_list = Fcons (Fcons (display_name, Qnil), win32_display_name_list); dpyinfo->name_list_element = XCONS (win32_display_name_list)->car; dpyinfo->win32_id_name = (char *) xmalloc (XSTRING (Vinvocation_name)->size + XSTRING (Vsystem_name)->size + 2); sprintf (dpyinfo->win32_id_name, "%s@%s", XSTRING (Vinvocation_name)->data, XSTRING (Vsystem_name)->data); #if 0 xrdb = x_load_resources (dpyinfo->display, xrm_option, resource_name, EMACS_CLASS); /* Put the rdb where we can find it in a way that works on all versions. */ dpyinfo->xrdb = xrdb; #endif hdc = my_get_dc (GetDesktopWindow ()); dpyinfo->height = GetDeviceCaps (hdc, VERTRES); dpyinfo->width = GetDeviceCaps (hdc, HORZRES); dpyinfo->root_window = GetDesktopWindow (); dpyinfo->n_planes = GetDeviceCaps (hdc, PLANES); dpyinfo->n_cbits = GetDeviceCaps (hdc, BITSPIXEL); dpyinfo->height_in = GetDeviceCaps (hdc, LOGPIXELSX); dpyinfo->width_in = GetDeviceCaps (hdc, LOGPIXELSY); dpyinfo->grabbed = 0; dpyinfo->reference_count = 0; dpyinfo->n_fonts = 0; dpyinfo->font_table_size = 0; dpyinfo->bitmaps = 0; dpyinfo->bitmaps_size = 0; dpyinfo->bitmaps_last = 0; dpyinfo->mouse_face_mouse_frame = 0; dpyinfo->mouse_face_deferred_gc = 0; dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; dpyinfo->mouse_face_face_id = 0; dpyinfo->mouse_face_window = Qnil; dpyinfo->mouse_face_mouse_x = dpyinfo->mouse_face_mouse_y = 0; dpyinfo->mouse_face_defer = 0; dpyinfo->win32_focus_frame = 0; dpyinfo->win32_focus_event_frame = 0; dpyinfo->win32_highlight_frame = 0; ReleaseDC (GetDesktopWindow (), hdc); #ifndef F_SETOWN_BUG #ifdef F_SETOWN #ifdef F_SETOWN_SOCK_NEG /* stdin is a socket here */ fcntl (connection, F_SETOWN, -getpid ()); #else /* ! defined (F_SETOWN_SOCK_NEG) */ fcntl (connection, F_SETOWN, getpid ()); #endif /* ! defined (F_SETOWN_SOCK_NEG) */ #endif /* ! defined (F_SETOWN) */ #endif /* F_SETOWN_BUG */ #ifdef SIGIO if (interrupt_input) init_sigio (connection); #endif /* ! defined (SIGIO) */ UNBLOCK_INPUT; return dpyinfo; } /* Get rid of display DPYINFO, assuming all frames are already gone. */ void x_delete_display (dpyinfo) struct win32_display_info *dpyinfo; { /* Discard this display from win32_display_name_list and win32_display_list. We can't use Fdelq because that can quit. */ if (! NILP (win32_display_name_list) && EQ (XCONS (win32_display_name_list)->car, dpyinfo->name_list_element)) win32_display_name_list = XCONS (win32_display_name_list)->cdr; else { Lisp_Object tail; tail = win32_display_name_list; while (CONSP (tail) && CONSP (XCONS (tail)->cdr)) { if (EQ (XCONS (XCONS (tail)->cdr)->car, dpyinfo->name_list_element)) { XCONS (tail)->cdr = XCONS (XCONS (tail)->cdr)->cdr; break; } tail = XCONS (tail)->cdr; } } xfree (dpyinfo->font_table); xfree (dpyinfo->win32_id_name); } /* Set up use of Win32. */ DWORD win_msg_worker (); win32_initialize () { clear_frame_hook = win32_clear_frame; clear_end_of_line_hook = win32_clear_end_of_line; ins_del_lines_hook = win32_ins_del_lines; change_line_highlight_hook = win32_change_line_highlight; insert_glyphs_hook = win32_insert_glyphs; write_glyphs_hook = win32_write_glyphs; delete_glyphs_hook = win32_delete_glyphs; ring_bell_hook = win32_ring_bell; reset_terminal_modes_hook = win32_reset_terminal_modes; set_terminal_modes_hook = win32_set_terminal_modes; update_begin_hook = win32_update_begin; update_end_hook = win32_update_end; set_terminal_window_hook = win32_set_terminal_window; read_socket_hook = w32_read_socket; frame_up_to_date_hook = win32_frame_up_to_date; cursor_to_hook = win32_cursor_to; reassert_line_highlight_hook = win32_reassert_line_highlight; mouse_position_hook = win32_mouse_position; frame_rehighlight_hook = win32_frame_rehighlight; frame_raise_lower_hook = win32_frame_raise_lower; set_vertical_scroll_bar_hook = win32_set_vertical_scroll_bar; condemn_scroll_bars_hook = win32_condemn_scroll_bars; redeem_scroll_bar_hook = win32_redeem_scroll_bar; judge_scroll_bars_hook = win32_judge_scroll_bars; scroll_region_ok = 1; /* we'll scroll partial frames */ char_ins_del_ok = 0; /* just as fast to write the line */ line_ins_del_ok = 1; /* we'll just blt 'em */ fast_clear_end_of_line = 1; /* X does this well */ memory_below_frame = 0; /* we don't remember what scrolls off the bottom */ baud_rate = 19200; /* Try to use interrupt input; if we can't, then start polling. */ Fset_input_mode (Qt, Qnil, Qt, Qnil); /* Create the window thread - it will terminate itself or when the app terminates */ init_crit (); dwMainThreadId = GetCurrentThreadId (); DuplicateHandle (GetCurrentProcess (), GetCurrentThread (), GetCurrentProcess (), &hMainThread, 0, TRUE, DUPLICATE_SAME_ACCESS); /* Wait for thread to start */ { MSG msg; PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE); hWinThread = CreateThread (NULL, 0, (LPTHREAD_START_ROUTINE) win_msg_worker, 0, 0, &dwWinThreadId); GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE); } /* AttachThreadInput (dwWinThreadId, dwMainThreadId, TRUE); */ } void syms_of_win32term () { staticpro (&win32_display_name_list); win32_display_name_list = Qnil; staticpro (&last_mouse_scroll_bar); last_mouse_scroll_bar = Qnil; staticpro (&Qvendor_specific_keysyms); Qvendor_specific_keysyms = intern ("vendor-specific-keysyms"); } emacs-19.30/src/w32xfns.c100444 23073 1 13475 6047606407 14267 0ustar voelkerdaemon/* Functions taken directly from X sources Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation. 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. */ #include #include #include #include "lisp.h" #include "blockinput.h" #include "w32term.h" #include "windowsx.h" #define myalloc(cb) GlobalAllocPtr (GPTR, cb) #define myfree(lp) GlobalFreePtr (lp) CRITICAL_SECTION critsect; extern HANDLE keyboard_handle; HANDLE hEvent = NULL; void init_crit () { InitializeCriticalSection (&critsect); keyboard_handle = hEvent = CreateEvent (NULL, FALSE, FALSE, NULL); } void enter_crit () { EnterCriticalSection (&critsect); } void leave_crit () { LeaveCriticalSection (&critsect); } void delete_crit () { DeleteCriticalSection (&critsect); if (hEvent) { CloseHandle (hEvent); hEvent = NULL; } } typedef struct int_msg { Win32Msg w32msg; struct int_msg *lpNext; } int_msg; int_msg *lpHead = NULL; int_msg *lpTail = NULL; int nQueue = 0; BOOL get_next_msg (lpmsg, bWait) Win32Msg * lpmsg; BOOL bWait; { BOOL bRet = FALSE; enter_crit (); /* The while loop takes care of multiple sets */ while (!nQueue && bWait) { leave_crit (); WaitForSingleObject (hEvent, INFINITE); enter_crit (); } if (nQueue) { bcopy (&(lpHead->w32msg), lpmsg, sizeof (Win32Msg)); { int_msg * lpCur = lpHead; lpHead = lpHead->lpNext; myfree (lpCur); } nQueue--; bRet = TRUE; } leave_crit (); return (bRet); } BOOL post_msg (lpmsg) Win32Msg * lpmsg; { int_msg * lpNew = (int_msg *) myalloc (sizeof (int_msg)); if (!lpNew) return (FALSE); bcopy (lpmsg, &(lpNew->w32msg), sizeof (Win32Msg)); lpNew->lpNext = NULL; enter_crit (); if (nQueue++) { lpTail->lpNext = lpNew; } else { lpHead = lpNew; SetEvent (hEvent); } lpTail = lpNew; leave_crit (); return (TRUE); } /* * XParseGeometry parses strings of the form * "=x{+-}{+-}", where * width, height, xoffset, and yoffset are unsigned integers. * Example: "=80x24+300-49" * The equal sign is optional. * It returns a bitmask that indicates which of the four values * were actually found in the string. For each value found, * the corresponding argument is updated; for each value * not found, the corresponding argument is left unchanged. */ static int read_integer (string, NextString) register char *string; char **NextString; { register int Result = 0; int Sign = 1; if (*string == '+') string++; else if (*string == '-') { string++; Sign = -1; } for (; (*string >= '0') && (*string <= '9'); string++) { Result = (Result * 10) + (*string - '0'); } *NextString = string; if (Sign >= 0) return (Result); else return (-Result); } int XParseGeometry (string, x, y, width, height) char *string; int *x, *y; unsigned int *width, *height; /* RETURN */ { int mask = NoValue; register char *strind; unsigned int tempWidth, tempHeight; int tempX, tempY; char *nextCharacter; if ((string == NULL) || (*string == '\0')) return (mask); if (*string == '=') string++; /* ignore possible '=' at beg of geometry spec */ strind = (char *)string; if (*strind != '+' && *strind != '-' && *strind != 'x') { tempWidth = read_integer (strind, &nextCharacter); if (strind == nextCharacter) return (0); strind = nextCharacter; mask |= WidthValue; } if (*strind == 'x' || *strind == 'X') { strind++; tempHeight = read_integer (strind, &nextCharacter); if (strind == nextCharacter) return (0); strind = nextCharacter; mask |= HeightValue; } if ((*strind == '+') || (*strind == '-')) { if (*strind == '-') { strind++; tempX = -read_integer (strind, &nextCharacter); if (strind == nextCharacter) return (0); strind = nextCharacter; mask |= XNegative; } else { strind++; tempX = read_integer (strind, &nextCharacter); if (strind == nextCharacter) return (0); strind = nextCharacter; } mask |= XValue; if ((*strind == '+') || (*strind == '-')) { if (*strind == '-') { strind++; tempY = -read_integer (strind, &nextCharacter); if (strind == nextCharacter) return (0); strind = nextCharacter; mask |= YNegative; } else { strind++; tempY = read_integer (strind, &nextCharacter); if (strind == nextCharacter) return (0); strind = nextCharacter; } mask |= YValue; } } /* If strind isn't at the end of the string the it's an invalid geometry specification. */ if (*strind != '\0') return (0); if (mask & XValue) *x = tempX; if (mask & YValue) *y = tempY; if (mask & WidthValue) *width = tempWidth; if (mask & HeightValue) *height = tempHeight; return (mask); } /* The semantics of the use of using_x_p is really using_a_window_system. */ int using_x_p (void) { return 1; } /* x_sync is a no-op on Win32. */ void x_sync (f) void *f; { } emacs-19.30/src/widget.c100444 75424 1 74163 6005303132 13543 0ustar kwzhdaemon/* The emacs frame widget. 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. */ /* Emacs 19 face widget ported by Fred Pierresteguy */ #include #include #include "lisp.h" #include "xterm.h" #include "frame.h" #include "dispextern.h" #include "blockinput.h" #include #include #include #include "widgetprv.h" #include #include #include #include "../lwlib/lwlib.h" #define max(a, b) ((a) > (b) ? (a) : (b)) /* This sucks: this is the first default that x-faces.el tries. This won't be used unless neither the "Emacs.EmacsFrame" resource nor the "Emacs.EmacsFrame" resource is set; the frame may have the wrong default size if this font doesn't exist, but some other font that x-faces.el does. The workaround is to specify some font in the resource database; I don't know a solution other than duplicating the font- searching code from x-faces.el in this file. This also means that if "Emacs.EmacsFrame" is specified as a non- existent font, then Xt is going to substitute "XtDefaultFont" for it, which is a different size than this one. The solution for this is to make x-faces.el try to use XtDefaultFont. The problem with that is that XtDefaultFont is almost certainly variable-width. #### Perhaps we could have this code explicitly set XtDefaultFont to this? */ #define DEFAULT_FACE_FONT "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*" static void EmacsFrameInitialize (/*Widget, Widget, ArgList, Cardinal * */); static void EmacsFrameDestroy (/* Widget */); static void EmacsFrameRealize (/* Widget, XtValueMask*, XSetWindowAttributes* */); void EmacsFrameResize (/* Widget widget */); static Boolean EmacsFrameSetValues (/* Widget, Widget, Widget, ArgList, Cardinal * */); static XtGeometryResult EmacsFrameQueryGeometry (/* Widget, XtWidgetGeometry*, XtWidgetGeometry* */); #undef XtOffset #define XtOffset(p_type,field) \ ((Cardinal) (((char *) (&(((p_type)0)->field))) - ((char *)0))) #define offset(field) XtOffset(EmacsFrame, emacs_frame.field) static XtResource resources[] = { {XtNgeometry, XtCGeometry, XtRString, sizeof(String), offset (geometry), XtRString, (XtPointer) 0}, {XtNiconic, XtCIconic, XtRBoolean, sizeof(Boolean), offset (iconic), XtRImmediate, (XtPointer) False}, {XtNemacsFrame, XtCEmacsFrame, XtRPointer, sizeof (XtPointer), offset (frame), XtRImmediate, 0}, {XtNminibuffer, XtCMinibuffer, XtRInt, sizeof (int), offset (minibuffer), XtRImmediate, (XtPointer)0}, {XtNunsplittable, XtCUnsplittable, XtRBoolean, sizeof (Boolean), offset (unsplittable), XtRImmediate, (XtPointer)0}, {XtNinternalBorderWidth, XtCInternalBorderWidth, XtRInt, sizeof (int), offset (internal_border_width), XtRImmediate, (XtPointer)4}, {XtNinterline, XtCInterline, XtRInt, sizeof (int), offset (interline), XtRImmediate, (XtPointer)0}, {XtNfont, XtCFont, XtRFontStruct, sizeof(XFontStruct *), offset(font),XtRString, DEFAULT_FACE_FONT}, {XtNforeground, XtCForeground, XtRPixel, sizeof(Pixel), offset(foreground_pixel), XtRString, "XtDefaultForeground"}, {XtNcursorColor, XtCForeground, XtRPixel, sizeof(Pixel), offset(cursor_color), XtRString, "XtDefaultForeground"}, {XtNbarCursor, XtCBarCursor, XtRBoolean, sizeof (Boolean), offset (bar_cursor), XtRImmediate, (XtPointer)0}, {XtNvisualBell, XtCVisualBell, XtRBoolean, sizeof (Boolean), offset (visual_bell), XtRImmediate, (XtPointer)0}, {XtNbellVolume, XtCBellVolume, XtRInt, sizeof (int), offset (bell_volume), XtRImmediate, (XtPointer)0}, }; #undef offset /* static XtActionsRec emacsFrameActionsTable [] = { {"keypress", key_press}, {"focus_in", emacs_frame_focus_handler}, {"focus_out", emacs_frame_focus_handler}, }; static char emacsFrameTranslations [] = "\ : keypress()\n\ : focus_in()\n\ : focus_out()\n\ "; */ EmacsFrameClassRec emacsFrameClassRec = { { /* core fields */ /* superclass */ &widgetClassRec, /* class_name */ "EmacsFrame", /* widget_size */ sizeof(EmacsFrameRec), /* class_initialize */ 0, /* class_part_initialize */ 0, /* class_inited */ FALSE, /* initialize */ EmacsFrameInitialize, /* initialize_hook */ 0, /* realize */ EmacsFrameRealize, /* actions */ 0, /*emacsFrameActionsTable*/ /* num_actions */ 0, /*XtNumber (emacsFrameActionsTable)*/ /* resources */ resources, /* resource_count */ XtNumber(resources), /* xrm_class */ NULLQUARK, /* compress_motion */ TRUE, /* compress_exposure */ TRUE, /* compress_enterleave */ TRUE, /* visible_interest */ FALSE, /* destroy */ EmacsFrameDestroy, /* resize */ EmacsFrameResize, /* expose */ XtInheritExpose, /* set_values */ EmacsFrameSetValues, /* set_values_hook */ 0, /* set_values_almost */ XtInheritSetValuesAlmost, /* get_values_hook */ 0, /* accept_focus */ XtInheritAcceptFocus, /* version */ XtVersion, /* callback_private */ 0, /* tm_table */ 0, /*emacsFrameTranslations*/ /* query_geometry */ EmacsFrameQueryGeometry, /* display_accelerator */ XtInheritDisplayAccelerator, /* extension */ 0 } }; WidgetClass emacsFrameClass = (WidgetClass) &emacsFrameClassRec; static void get_default_char_pixel_size (ew, pixel_width, pixel_height) EmacsFrame ew; int* pixel_width; int* pixel_height; { struct frame* f = ew->emacs_frame.frame; *pixel_width = FONT_WIDTH (f->output_data.x->font); *pixel_height = f->output_data.x->line_height; } static void pixel_to_char_size (ew, pixel_width, pixel_height, char_width, char_height) EmacsFrame ew; Dimension pixel_width; Dimension pixel_height; int* char_width; int* char_height; { struct frame* f = ew->emacs_frame.frame; *char_width = PIXEL_TO_CHAR_WIDTH (f, pixel_width); *char_height = PIXEL_TO_CHAR_HEIGHT (f, pixel_height); } static void char_to_pixel_size (ew, char_width, char_height, pixel_width, pixel_height) EmacsFrame ew; int char_width; int char_height; Dimension* pixel_width; Dimension* pixel_height; { struct frame* f = ew->emacs_frame.frame; *pixel_width = CHAR_TO_PIXEL_WIDTH (f, char_width); *pixel_height = CHAR_TO_PIXEL_HEIGHT (f, char_height); } static void round_size_to_char (ew, in_width, in_height, out_width, out_height) EmacsFrame ew; Dimension in_width; Dimension in_height; Dimension* out_width; Dimension* out_height; { int char_width; int char_height; pixel_to_char_size (ew, in_width, in_height, &char_width, &char_height); char_to_pixel_size (ew, char_width, char_height, out_width, out_height); } static Widget get_wm_shell (w) Widget w; { Widget wmshell; for (wmshell = XtParent (w); wmshell && !XtIsWMShell (wmshell); wmshell = XtParent (wmshell)); return wmshell; } static void mark_shell_size_user_specified (wmshell) Widget wmshell; { if (! XtIsWMShell (wmshell)) abort (); /* This is kind of sleazy, but I can't see how else to tell it to make it mark the WM_SIZE_HINTS size as user specified when appropriate. */ ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize; } /* Can't have static frame locals because of some broken compilers. Normally, initializing a variable like this doesn't work in emacs, but it's ok in this file because it must come after lastfile (and thus have its data not go into text space) because Xt needs to write to initialized data objects too. */ static Boolean first_frame_p = True; static void set_frame_size (ew) EmacsFrame ew; { /* The widget hierarchy is argv[0] emacsShell pane Frame-NAME ApplicationShell EmacsShell Paned EmacsFrame We accept geometry specs in this order: *Frame-NAME.geometry *EmacsFrame.geometry Emacs.geometry Other possibilities for widget hierarchies might be argv[0] frame pane Frame-NAME ApplicationShell EmacsShell Paned EmacsFrame or argv[0] Frame-NAME pane Frame-NAME ApplicationShell EmacsShell Paned EmacsFrame or argv[0] Frame-NAME pane emacsTextPane ApplicationShell EmacsFrame Paned EmacsTextPane With the current setup, the text-display-area is the part which is an emacs "frame", since that's the only part managed by emacs proper (the menubar and the parent of the menubar and all that sort of thing are managed by lwlib.) The EmacsShell widget is simply a replacement for the Shell widget which is able to deal with using an externally-supplied window instead of always creating its own. It is not actually emacs specific, and should possibly have class "Shell" instead of "EmacsShell" to simplify the resources. */ /* Geometry of the AppShell */ int app_flags = 0; int app_x = 0; int app_y = 0; unsigned int app_w = 0; unsigned int app_h = 0; /* Geometry of the EmacsFrame */ int frame_flags = 0; int frame_x = 0; int frame_y = 0; unsigned int frame_w = 0; unsigned int frame_h = 0; /* Hairily merged geometry */ int x = 0; int y = 0; unsigned int w = ew->emacs_frame.frame->width; unsigned int h = ew->emacs_frame.frame->height; int flags = 0; Widget wmshell = get_wm_shell ((Widget) ew); /* Each Emacs shell is now independent and top-level. */ Widget app_shell = wmshell; if (! XtIsSubclass (wmshell, shellWidgetClass)) abort (); /* We don't need this for the momment. The geometry is computed in xfns.c. */ #if 0 /* If the EmacsFrame doesn't have a geometry but the shell does, treat that as the geometry of the frame. (Is this bogus? I'm not sure.) */ if (ew->emacs_frame.geometry == 0) XtVaGetValues (wmshell, XtNgeometry, &ew->emacs_frame.geometry, 0); /* If the Shell is iconic, then the EmacsFrame is iconic. (Is this bogus? I'm not sure.) */ if (!ew->emacs_frame.iconic) XtVaGetValues (wmshell, XtNiconic, &ew->emacs_frame.iconic, 0); { char *geom = 0; XtVaGetValues (app_shell, XtNgeometry, &geom, 0); if (geom) app_flags = XParseGeometry (geom, &app_x, &app_y, &app_w, &app_h); } if (ew->emacs_frame.geometry) frame_flags = XParseGeometry (ew->emacs_frame.geometry, &frame_x, &frame_y, &frame_w, &frame_h); if (first_frame_p) { /* If this is the first frame created: ==================================== - Use the ApplicationShell's size/position, if specified. (This is "Emacs.geometry", or the "-geometry" command line arg.) - Else use the EmacsFrame's size/position. (This is "*Frame-NAME.geometry") - If the AppShell is iconic, the frame should be iconic. AppShell comes first so that -geometry always applies to the first frame created, even if there is an "every frame" entry in the resource database. */ if (app_flags & (XValue | YValue)) { x = app_x; y = app_y; flags |= (app_flags & (XValue | YValue | XNegative | YNegative)); } else if (frame_flags & (XValue | YValue)) { x = frame_x; y = frame_y; flags |= (frame_flags & (XValue | YValue | XNegative | YNegative)); } if (app_flags & (WidthValue | HeightValue)) { w = app_w; h = app_h; flags |= (app_flags & (WidthValue | HeightValue)); } else if (frame_flags & (WidthValue | HeightValue)) { w = frame_w; h = frame_h; flags |= (frame_flags & (WidthValue | HeightValue)); } /* If the AppShell is iconic, then the EmacsFrame is iconic. */ if (!ew->emacs_frame.iconic) XtVaGetValues (app_shell, XtNiconic, &ew->emacs_frame.iconic, 0); first_frame_p = False; } else { /* If this is not the first frame created: ======================================== - use the EmacsFrame's size/position if specified - Otherwise, use the ApplicationShell's size, but not position. So that means that one can specify the position of the first frame with "Emacs.geometry" or `-geometry'; but can only specify the position of subsequent frames with "*Frame-NAME.geometry". AppShell comes second so that -geometry does not apply to subsequent frames when there is an "every frame" entry in the resource db, but does apply to the first frame. */ if (frame_flags & (XValue | YValue)) { x = frame_x; y = frame_y; flags |= (frame_flags & (XValue | YValue | XNegative | YNegative)); } if (frame_flags & (WidthValue | HeightValue)) { w = frame_w; h = frame_h; flags |= (frame_flags & (WidthValue | HeightValue)); } else if (app_flags & (WidthValue | HeightValue)) { w = app_w; h = app_h; flags |= (app_flags & (WidthValue | HeightValue)); } } #endif /* 0 */ { struct frame* frame = ew->emacs_frame.frame; Dimension pixel_width, pixel_height; char shell_position [32]; /* Take into account the size of the scrollbar */ frame->output_data.x->vertical_scroll_bar_extra = (!FRAME_HAS_VERTICAL_SCROLL_BARS (frame) ? 0 : FRAME_SCROLL_BAR_PIXEL_WIDTH (frame) > 0 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (frame) : (FRAME_SCROLL_BAR_COLS (frame) * FONT_WIDTH (frame->output_data.x->font))); change_frame_size (frame, h, w, 1, 0); char_to_pixel_size (ew, w, h, &pixel_width, &pixel_height); ew->core.width = pixel_width; ew->core.height = pixel_height; #if 0 /* xfns.c takes care of this now. */ /* If a position was specified, assign it to the shell widget. (Else WM won't do anything with it.) */ if (flags & (XValue | YValue)) { /* the tricky things with the sign is to make sure that -0 is printed -0. */ int len; char *tem; sprintf (shell_position, "=%c%d%c%d", flags & XNegative ? '-' : '+', x < 0 ? -x : x, flags & YNegative ? '-' : '+', y < 0 ? -y : y); len = strlen (shell_position) + 1; tem = (char *) xmalloc (len); strncpy (tem, shell_position, len); XtVaSetValues (wmshell, XtNgeometry, tem, 0); } else if (flags & (WidthValue | HeightValue)) { int len; char *tem; sprintf (shell_position, "=%dx%d", pixel_width, pixel_height); len = strlen (shell_position) + 1; tem = (char *) xmalloc (len); strncpy (tem, shell_position, len); XtVaSetValues (wmshell, XtNgeometry, tem, 0); } /* If the geometry spec we're using has W/H components, mark the size in the WM_SIZE_HINTS as user specified. */ if (flags & (WidthValue | HeightValue)) mark_shell_size_user_specified (wmshell); /* Also assign the iconic status of the frame to the Shell, so that the WM sees it. */ XtVaSetValues (wmshell, XtNiconic, ew->emacs_frame.iconic, 0); #endif /* 0 */ } } /* Nonzero tells update_wm_hints not to do anything (the caller should call update_wm_hints explicitly later.) */ int update_hints_inhibit; static void update_wm_hints (ew) EmacsFrame ew; { Widget wmshell = get_wm_shell ((Widget)ew); int cw; int ch; Dimension rounded_width; Dimension rounded_height; int char_width; int char_height; int base_width; int base_height; int min_rows = 0, min_cols = 0; if (update_hints_inhibit) return; #if 0 check_frame_size (ew->emacs_frame.frame, &min_rows, &min_cols); #endif pixel_to_char_size (ew, ew->core.width, ew->core.height, &char_width, &char_height); char_to_pixel_size (ew, char_width, char_height, &rounded_width, &rounded_height); get_default_char_pixel_size (ew, &cw, &ch); base_width = (wmshell->core.width - ew->core.width + (rounded_width - (char_width * cw))); base_height = (wmshell->core.height - ew->core.height + (rounded_height - (char_height * ch))); /* This is kind of sleazy, but I can't see how else to tell it to make it mark the WM_SIZE_HINTS size as user specified. */ /* ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;*/ XtVaSetValues (wmshell, XtNbaseWidth, base_width, XtNbaseHeight, base_height, XtNwidthInc, cw, XtNheightInc, ch, XtNminWidth, base_width + min_cols * cw, XtNminHeight, base_height + min_rows * ch, 0); } static void create_frame_gcs (ew) EmacsFrame ew; { struct frame *s = ew->emacs_frame.frame; s->output_data.x->normal_gc = XCreateGC (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)), (unsigned long)0, (XGCValues *)0); s->output_data.x->reverse_gc = XCreateGC (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)), (unsigned long)0, (XGCValues *)0); s->output_data.x->cursor_gc = XCreateGC (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)), (unsigned long)0, (XGCValues *)0); } static char setup_frame_cursor_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 }; static void setup_frame_gcs (ew) EmacsFrame ew; { XGCValues gc_values; struct frame* s = ew->emacs_frame.frame; Pixmap blank_stipple, blank_tile; /* We have to initialize all of our GCs to have a stipple/tile, otherwise XGetGCValues returns uninitialized data when we query the stipple (instead of None or something sensible) and it makes things hard. This should be fixed for real by not querying the GCs but instead having some GC-based cache instead of the current face-based cache which doesn't effectively cache all of the GC settings we need to use. */ blank_stipple = XCreateBitmapFromData (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)), setup_frame_cursor_bits, 2, 2); /* use fg = 0, bg = 1 below, but it's irrelevant since this pixmap should never actually get used as a background tile! */ blank_tile = XCreatePixmapFromBitmapData (XtDisplay(ew), RootWindowOfScreen (XtScreen (ew)), setup_frame_cursor_bits, 2, 2, (unsigned long)0, (unsigned long)1, ew->core.depth); /* Normal video */ gc_values.font = ew->emacs_frame.font->fid; gc_values.foreground = ew->emacs_frame.foreground_pixel; gc_values.background = ew->core.background_pixel; gc_values.graphics_exposures = False; gc_values.stipple = blank_stipple; gc_values.tile = blank_tile; XChangeGC (XtDisplay (ew), s->output_data.x->normal_gc, (GCFont | GCForeground | GCBackground | GCGraphicsExposures | GCStipple | GCTile), &gc_values); /* Reverse video style. */ gc_values.font = ew->emacs_frame.font->fid; gc_values.foreground = ew->core.background_pixel; gc_values.background = ew->emacs_frame.foreground_pixel; gc_values.graphics_exposures = False; gc_values.stipple = blank_stipple; gc_values.tile = blank_tile; XChangeGC (XtDisplay (ew), s->output_data.x->reverse_gc, (GCFont | GCForeground | GCBackground | GCGraphicsExposures | GCStipple | GCTile), &gc_values); /* Cursor has to have an empty stipple. */ gc_values.font = ew->emacs_frame.font->fid; gc_values.foreground = ew->core.background_pixel; gc_values.background = ew->emacs_frame.cursor_color; gc_values.graphics_exposures = False; gc_values.tile = blank_tile; gc_values.stipple = XCreateBitmapFromData (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)), setup_frame_cursor_bits, 16, 16); XChangeGC (XtDisplay (ew), s->output_data.x->cursor_gc, (GCFont | GCForeground | GCBackground | GCGraphicsExposures | GCStipple | GCTile), &gc_values); } static void update_various_frame_slots (ew) EmacsFrame ew; { struct x_output *x = ew->emacs_frame.frame->output_data.x; x->pixel_height = ew->core.height; x->pixel_width = ew->core.width; x->internal_border_width = ew->emacs_frame.internal_border_width; } static void update_from_various_frame_slots (ew) EmacsFrame ew; { struct x_output *x = ew->emacs_frame.frame->output_data.x; ew->core.height = x->pixel_height; ew->core.width = x->pixel_width; ew->core.background_pixel = x->background_pixel; ew->emacs_frame.internal_border_width = x->internal_border_width; ew->emacs_frame.font = x->font; ew->emacs_frame.foreground_pixel = x->foreground_pixel; ew->emacs_frame.cursor_color = x->cursor_pixel; ew->core.border_pixel = x->border_pixel; } static void EmacsFrameInitialize (request, new, dum1, dum2) Widget request; Widget new; ArgList dum1; Cardinal *dum2; { EmacsFrame ew = (EmacsFrame)new; if (!ew->emacs_frame.frame) { fprintf (stderr, "can't create an emacs frame widget without a frame\n"); exit (1); } #if 0 /* done in xfns.c */ /* If the "Emacs.EmacsFrame.{default,Face}.{attributeFont,AttributeFont}" resource is set, then it always overrides "Emacs.EmacsFrame.{font,Font}". It's unfortunate that we have to do this, but we need to know the font size for frame-sizing purposes before the faces get initialized. If the "default.attributeFont" isn't set, then we use the font of this EmacsFrame itself, defaulting to XtDefaultFont. Up in the lisp code, the "default" face will use the frame's font if its own is not set, so everything stays in sync -- it's not possible for the frame's font and the default face's font to be different. */ { XFontStruct *f = 0; XtResource face_res; face_res.resource_name = "attributeFont"; face_res.resource_class = "AttributeFont"; face_res.resource_type = XtRFontStruct; face_res.resource_size = sizeof (XFontStruct *); face_res.resource_offset = 0; face_res.default_type = XtRImmediate; face_res.default_addr = 0; XtGetSubresources ((Widget) ew, (XtPointer) &f, "default", "Face", &face_res, 1, NULL, 0); if (f) ew->emacs_frame.font = f; else if (! ew->emacs_frame.font) { fprintf (stderr, "emacs frame widget could not load a font\n"); exit (1); } } /* Update the font field in frame */ ew->emacs_frame.frame->output_data.x->font = ew->emacs_frame.font; #endif update_from_various_frame_slots (ew); set_frame_size (ew); /*create_frame_gcs (ew); setup_frame_gcs (ew); update_various_frame_slots (ew); */ } static void EmacsFrameRealize (widget, mask, attrs) Widget widget; XtValueMask *mask; XSetWindowAttributes *attrs; { EmacsFrame ew = (EmacsFrame)widget; attrs->event_mask = (KeyPressMask | ExposureMask | ButtonPressMask | ButtonReleaseMask | StructureNotifyMask | FocusChangeMask | PointerMotionHintMask | PointerMotionMask | LeaveWindowMask | EnterWindowMask | VisibilityChangeMask | PropertyChangeMask | StructureNotifyMask | SubstructureNotifyMask | SubstructureRedirectMask); *mask |= CWEventMask; XtCreateWindow (widget, InputOutput, (Visual *)CopyFromParent, *mask, attrs); update_wm_hints (ew); } extern void free_frame_faces (/* struct frame * */); static void EmacsFrameDestroy (widget) Widget widget; { EmacsFrame ew = (EmacsFrame) widget; struct frame* s = ew->emacs_frame.frame; if (! s) abort (); if (! s->output_data.x) abort (); if (! s->output_data.x->normal_gc) abort (); /* this would be called from Fdelete_frame() but it needs to free some stuff after the widget has been finalized but before the widget has been freed. */ free_frame_faces (s); BLOCK_INPUT; /* need to be careful that the face-freeing code doesn't free these too */ XFreeGC (XtDisplay (widget), s->output_data.x->normal_gc); XFreeGC (XtDisplay (widget), s->output_data.x->reverse_gc); XFreeGC (XtDisplay (widget), s->output_data.x->cursor_gc); UNBLOCK_INPUT; } void EmacsFrameResize (widget) Widget widget; { EmacsFrame ew = (EmacsFrame)widget; struct frame *f = ew->emacs_frame.frame; int columns; int rows; pixel_to_char_size (ew, ew->core.width, ew->core.height, &columns, &rows); change_frame_size (f, rows, columns, 1, 0); update_wm_hints (ew); update_various_frame_slots (ew); } static Boolean EmacsFrameSetValues (cur_widget, req_widget, new_widget, dum1, dum2) Widget cur_widget; Widget req_widget; Widget new_widget; ArgList dum1; Cardinal *dum2; { EmacsFrame cur = (EmacsFrame)cur_widget; EmacsFrame new = (EmacsFrame)new_widget; Boolean needs_a_refresh = False; Boolean has_to_recompute_size; Boolean has_to_recompute_gcs; Boolean has_to_update_hints; int char_width, char_height; Dimension pixel_width; Dimension pixel_height; has_to_recompute_gcs = (cur->emacs_frame.font != new->emacs_frame.font || (cur->emacs_frame.foreground_pixel != new->emacs_frame.foreground_pixel) || (cur->core.background_pixel != new->core.background_pixel) ); has_to_recompute_size = (cur->emacs_frame.font != new->emacs_frame.font && cur->core.width == new->core.width && cur->core.height == new->core.height); has_to_update_hints = (cur->emacs_frame.font != new->emacs_frame.font); if (has_to_recompute_gcs) { setup_frame_gcs (new); needs_a_refresh = True; } if (has_to_recompute_size) { pixel_width = new->core.width; pixel_height = new->core.height; pixel_to_char_size (new, pixel_width, pixel_height, &char_width, &char_height); char_to_pixel_size (new, char_width, char_height, &pixel_width, &pixel_height); new->core.width = pixel_width; new->core.height = pixel_height; change_frame_size (new->emacs_frame.frame, char_height, char_width, 1, 0); needs_a_refresh = True; } if (has_to_update_hints) update_wm_hints (new); update_various_frame_slots (new); /* #### This doesn't work, I haven't been able to find ANY kludge that will let (x-create-frame '((iconic . t))) work. It seems that changes to wm_shell's iconic slot have no effect after it has been realized, and calling XIconifyWindow doesn't work either (even thought the window has been created.) Perhaps there is some property we could smash directly, but I'm sick of this for now. Xt is a steaming pile of shit! */ if (cur->emacs_frame.iconic != new->emacs_frame.iconic) { Widget wmshell = get_wm_shell ((Widget) cur); XtVaSetValues (wmshell, XtNiconic, new->emacs_frame.iconic, 0); } return needs_a_refresh; } static XtGeometryResult EmacsFrameQueryGeometry (widget, request, result) Widget widget; XtWidgetGeometry* request; XtWidgetGeometry* result; { EmacsFrame ew = (EmacsFrame)widget; int mask = request->request_mode; Dimension ok_width, ok_height; if (mask & (CWWidth | CWHeight)) { round_size_to_char (ew, (mask & CWWidth) ? request->width : ew->core.width, ((mask & CWHeight) ? request->height : ew->core.height), &ok_width, &ok_height); if ((mask & CWWidth) && (ok_width != request->width)) { result->request_mode |= CWWidth; result->width = ok_width; } if ((mask & CWHeight) && (ok_height != request->height)) { result->request_mode |= CWHeight; result->height = ok_height; } } return result->request_mode ? XtGeometryAlmost : XtGeometryYes; } /* Special entrypoints */ void EmacsFrameSetCharSize (widget, columns, rows) Widget widget; int columns; int rows; { EmacsFrame ew = (EmacsFrame) widget; Dimension pixel_width, pixel_height, granted_width, granted_height; XtGeometryResult result; struct frame *f = ew->emacs_frame.frame; Arg al[2]; int ac = 0; if (columns < 3) columns = 3; /* no way buddy */ check_frame_size (f, &rows, &columns); f->output_data.x->vertical_scroll_bar_extra = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f) ? 0 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f) : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font))); char_to_pixel_size (ew, columns, rows, &pixel_width, &pixel_height); /* Manually change the height and width of all our widgets, adjusting each widget by the same increments. */ if (ew->core.width != pixel_width || ew->core.height != pixel_height) { int hdelta = pixel_height - ew->core.height; int wdelta = pixel_width - ew->core.width; int column_widget_height = f->output_data.x->column_widget->core.height; int column_widget_width = f->output_data.x->column_widget->core.width; int outer_widget_height = f->output_data.x->widget->core.height; int outer_widget_width = f->output_data.x->widget->core.width; int old_left = f->output_data.x->widget->core.x; int old_top = f->output_data.x->widget->core.y; lw_refigure_widget (f->output_data.x->column_widget, False); update_hints_inhibit = 1; ac = 0; XtSetArg (al[ac], XtNheight, pixel_height); ac++; XtSetArg (al[ac], XtNwidth, pixel_width); ac++; XtSetValues ((Widget) ew, al, ac); ac = 0; XtSetArg (al[ac], XtNheight, column_widget_height + hdelta); ac++; XtSetArg (al[ac], XtNwidth, column_widget_width + wdelta); ac++; XtSetValues (f->output_data.x->column_widget, al, ac); ac = 0; XtSetArg (al[ac], XtNheight, outer_widget_height + hdelta); ac++; XtSetArg (al[ac], XtNwidth, outer_widget_width + wdelta); ac++; XtSetValues (f->output_data.x->widget, al, ac); lw_refigure_widget (f->output_data.x->column_widget, True); update_hints_inhibit = 0; update_wm_hints (ew); /* These seem to get clobbered. I don't know why. - rms. */ f->output_data.x->widget->core.x = old_left; f->output_data.x->widget->core.y = old_top; } /* We've set {FRAME,PIXEL}_{WIDTH,HEIGHT} to the values we hope to receive in the ConfigureNotify event; if we get what we asked for, then the event won't cause the screen to become garbaged, so we have to make sure to do it here. */ SET_FRAME_GARBAGED (f); } emacs-19.30/src/window.c100444 12120 1 333733 6054414005 13414 0ustar rmsdaemon/* Window creation, deletion and examination for GNU Emacs. Does not include redisplay. Copyright (C) 1985, 86, 87, 93, 94, 95 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. */ #include #include "lisp.h" #include "buffer.h" #include "frame.h" #include "window.h" #include "commands.h" #include "indent.h" #include "termchar.h" #include "disptab.h" #include "keyboard.h" Lisp_Object Qwindowp, Qwindow_live_p; Lisp_Object Fnext_window (), Fdelete_window (), Fselect_window (); Lisp_Object Fset_window_buffer (), Fsplit_window (), Frecenter (); void delete_all_subwindows (); static struct window *decode_window(); /* This is the window in which the terminal's cursor should be left when nothing is being done with it. This must always be a leaf window, and its buffer is selected by the top level editing loop at the end of each command. This value is always the same as FRAME_SELECTED_WINDOW (selected_frame). */ Lisp_Object selected_window; /* The minibuffer window of the selected frame. Note that you cannot test for minibufferness of an arbitrary window by comparing against this; but you can test for minibufferness of the selected window. */ Lisp_Object minibuf_window; /* Non-nil means it is the window for C-M-v to scroll when the minibuffer is selected. */ Lisp_Object Vminibuf_scroll_window; /* Non-nil means this is the buffer whose window C-M-v should scroll. */ Lisp_Object Vother_window_scroll_buffer; /* Non-nil means it's function to call to display temp buffers. */ Lisp_Object Vtemp_buffer_show_function; /* If a window gets smaller than either of these, it is removed. */ int window_min_height; int window_min_width; /* Nonzero implies Fdisplay_buffer should create windows. */ int pop_up_windows; /* Nonzero implies make new frames for Fdisplay_buffer. */ int pop_up_frames; /* Non-nil means use this function instead of default */ Lisp_Object Vpop_up_frame_function; /* Function to call to handle Fdisplay_buffer. */ Lisp_Object Vdisplay_buffer_function; /* List of buffer *names* for buffers that should have their own frames. */ Lisp_Object Vspecial_display_buffer_names; /* List of regexps for buffer names that should have their own frames. */ Lisp_Object Vspecial_display_regexps; /* Function to pop up a special frame. */ Lisp_Object Vspecial_display_function; /* List of buffer *names* for buffers to appear in selected window. */ Lisp_Object Vsame_window_buffer_names; /* List of regexps for buffer names to appear in selected window. */ Lisp_Object Vsame_window_regexps; /* Hook run at end of temp_output_buffer_show. */ Lisp_Object Qtemp_buffer_show_hook; /* Fdisplay_buffer always splits the largest window if that window is more than this high. */ int split_height_threshold; /* Number of lines of continuity in scrolling by screenfuls. */ int next_screen_context_lines; /* Incremented for each window created. */ static int sequence_number; #define min(a, b) ((a) < (b) ? (a) : (b)) DEFUN ("windowp", Fwindowp, Swindowp, 1, 1, 0, "Returns t if OBJ is a window.") (obj) Lisp_Object obj; { return WINDOWP (obj) ? Qt : Qnil; } DEFUN ("window-live-p", Fwindow_live_p, Swindow_live_p, 1, 1, 0, "Returns t if OBJ is a window which is currently visible.") (obj) Lisp_Object obj; { return (WINDOWP (obj) && ! NILP (XWINDOW (obj)->buffer) ? Qt : Qnil); } Lisp_Object make_window () { Lisp_Object val; register struct window *p; register struct Lisp_Vector *vec; int i; vec = allocate_vectorlike ((EMACS_INT) VECSIZE (struct window)); for (i = 0; i < VECSIZE (struct window); i++) vec->contents[i] = Qnil; vec->size = VECSIZE (struct window); p = (struct window *)vec; XSETFASTINT (p->sequence_number, ++sequence_number); XSETFASTINT (p->left, 0); XSETFASTINT (p->top, 0); XSETFASTINT (p->height, 0); XSETFASTINT (p->width, 0); XSETFASTINT (p->hscroll, 0); XSETFASTINT (p->last_point_x, 0); XSETFASTINT (p->last_point_y, 0); p->start = Fmake_marker (); p->pointm = Fmake_marker (); XSETFASTINT (p->use_time, 0); p->frame = Qnil; p->display_table = Qnil; p->dedicated = Qnil; XSETWINDOW (val, p); return val; } DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 0, 0, "Return the window that the cursor now appears in and commands apply to.") () { return selected_window; } DEFUN ("minibuffer-window", Fminibuffer_window, Sminibuffer_window, 0, 1, 0, "Return the window used now for minibuffers.\n\ If the optional argument FRAME is specified, return the minibuffer window\n\ used by that frame.") (frame) Lisp_Object frame; { #ifdef MULTI_FRAME if (NILP (frame)) XSETFRAME (frame, selected_frame); else CHECK_LIVE_FRAME (frame, 0); #endif return FRAME_MINIBUF_WINDOW (XFRAME (frame)); } DEFUN ("window-minibuffer-p", Fwindow_minibuffer_p, Swindow_minibuffer_p, 0, 1, 0, "Returns non-nil if WINDOW is a minibuffer window.") (window) Lisp_Object window; { struct window *w = decode_window (window); return (MINI_WINDOW_P (w) ? Qt : Qnil); } DEFUN ("pos-visible-in-window-p", Fpos_visible_in_window_p, Spos_visible_in_window_p, 0, 2, 0, "Return t if position POS is currently on the frame in WINDOW.\n\ Returns nil if that position is scrolled vertically out of view.\n\ POS defaults to point; WINDOW, to the selected window.") (pos, window) Lisp_Object pos, window; { register struct window *w; register int top; register int height; register int posint; register struct buffer *buf; struct position posval; int hscroll; if (NILP (pos)) posint = PT; else { CHECK_NUMBER_COERCE_MARKER (pos, 0); posint = XINT (pos); } w = decode_window (window); top = marker_position (w->start); hscroll = XINT (w->hscroll); if (posint < top) return Qnil; height = XFASTINT (w->height) - ! MINI_WINDOW_P (w); buf = XBUFFER (w->buffer); if (XFASTINT (w->last_modified) >= BUF_MODIFF (buf)) { /* If frame is up to date, use the info recorded about how much text fit on it. */ if (posint < BUF_Z (buf) - XFASTINT (w->window_end_pos) || (XFASTINT (w->window_end_vpos) < height)) return Qt; return Qnil; } else { if (posint > BUF_ZV (buf)) return Qnil; /* w->start can be out of range. If it is, do something reasonable. */ if (top < BUF_BEGV (buf) || top > BUF_ZV (buf)) return Qnil; /* If that info is not correct, calculate afresh */ posval = *compute_motion (top, 0, (hscroll ? 1 - hscroll : 0), 0, posint, height, 0, window_internal_width (w) - 1, hscroll, 0, w); return posval.vpos < height ? Qt : Qnil; } } static struct window * decode_window (window) register Lisp_Object window; { if (NILP (window)) return XWINDOW (selected_window); CHECK_LIVE_WINDOW (window, 0); return XWINDOW (window); } DEFUN ("window-buffer", Fwindow_buffer, Swindow_buffer, 0, 1, 0, "Return the buffer that WINDOW is displaying.") (window) Lisp_Object window; { return decode_window (window)->buffer; } DEFUN ("window-height", Fwindow_height, Swindow_height, 0, 1, 0, "Return the number of lines in WINDOW (including its mode line).") (window) Lisp_Object window; { return decode_window (window)->height; } DEFUN ("window-width", Fwindow_width, Swindow_width, 0, 1, 0, "Return the number of display columns in WINDOW.\n\ This is the width that is usable columns available for text in WINDOW.\n\ If you want to find out how many columns WINDOW takes up,\n\ use (let ((edges (window-edges))) (- (nth 2 edges) (nth 0 edges))).") (window) Lisp_Object window; { return make_number (window_internal_width (decode_window (window))); } DEFUN ("window-hscroll", Fwindow_hscroll, Swindow_hscroll, 0, 1, 0, "Return the number of columns by which WINDOW is scrolled from left margin.") (window) Lisp_Object window; { return decode_window (window)->hscroll; } DEFUN ("set-window-hscroll", Fset_window_hscroll, Sset_window_hscroll, 2, 2, 0, "Set number of columns WINDOW is scrolled from left margin to NCOL.\n\ NCOL should be zero or positive.") (window, ncol) register Lisp_Object window, ncol; { register struct window *w; CHECK_NUMBER (ncol, 1); if (XINT (ncol) < 0) XSETFASTINT (ncol, 0); w = decode_window (window); if (XINT (w->hscroll) != XINT (ncol)) XBUFFER (w->buffer)->clip_changed = 1; /* Prevent redisplay shortcuts */ w->hscroll = ncol; return ncol; } DEFUN ("window-redisplay-end-trigger", Fwindow_redisplay_end_trigger, Swindow_redisplay_end_trigger, 0, 1, 0, "Return WINDOW's redisplay end trigger value.\n\ See `set-window-redisplay-end-trigger' for more information.") (window) Lisp_Object window; { return decode_window (window)->redisplay_end_trigger; } DEFUN ("set-window-redisplay-end-trigger", Fset_window_redisplay_end_trigger, Sset_window_redisplay_end_trigger, 2, 2, 0, "Set WINDOW's redisplay end trigger value to VALUE.\n\ VALUE should be a buffer position (typically a marker) or nil.\n\ If it is a buffer position, then if redisplay in WINDOW reaches a position\n\ beyond VALUE, the functions in `redisplay-end-trigger-functions' are called\n\ with two arguments: WINDOW, and the end trigger value.\n\ Afterwards the end-trigger value is reset to nil.") (window, value) register Lisp_Object window, value; { register struct window *w; w = decode_window (window); w->redisplay_end_trigger = value; return value; } DEFUN ("window-edges", Fwindow_edges, Swindow_edges, 0, 1, 0, "Return a list of the edge coordinates of WINDOW.\n\ \(LEFT TOP RIGHT BOTTOM), all relative to 0, 0 at top left corner of frame.\n\ RIGHT is one more than the rightmost column used by WINDOW,\n\ and BOTTOM is one more than the bottommost row used by WINDOW\n\ and its mode-line.") (window) Lisp_Object window; { register struct window *w = decode_window (window); return Fcons (w->left, Fcons (w->top, Fcons (make_number (XFASTINT (w->left) + XFASTINT (w->width)), Fcons (make_number (XFASTINT (w->top) + XFASTINT (w->height)), Qnil)))); } /* Test if the character at column *x, row *y is within window *w. If it is not, return 0; if it is in the window's text area, set *x and *y to its location relative to the upper left corner of the window, and return 1; if it is on the window's modeline, return 2; if it is on the border between the window and its right sibling, return 3. */ static int coordinates_in_window (w, x, y) register struct window *w; register int *x, *y; { register int left = XINT (w->left); register int width = XINT (w->width); register int window_height = XINT (w->height); register int top = XFASTINT (w->top); if ( *x < left || *x >= left + width || *y < top || *y >= top + window_height) return 0; /* Is the character is the mode line? */ if (*y == top + window_height - 1 && ! MINI_WINDOW_P (w)) return 2; /* Is the character in the right border? */ if (*x == left + width - 1 && left + width != FRAME_WIDTH (XFRAME (w->frame))) return 3; *x -= left; *y -= top; return 1; } DEFUN ("coordinates-in-window-p", Fcoordinates_in_window_p, Scoordinates_in_window_p, 2, 2, 0, "Return non-nil if COORDINATES are in WINDOW.\n\ COORDINATES is a cons of the form (X . Y), X and Y being distances\n\ measured in characters from the upper-left corner of the frame.\n\ (0 . 0) denotes the character in the upper left corner of the\n\ frame.\n\ If COORDINATES are in the text portion of WINDOW,\n\ the coordinates relative to the window are returned.\n\ If they are in the mode line of WINDOW, `mode-line' is returned.\n\ If they are on the border between WINDOW and its right sibling,\n\ `vertical-line' is returned.") (coordinates, window) register Lisp_Object coordinates, window; { int x, y; CHECK_LIVE_WINDOW (window, 0); CHECK_CONS (coordinates, 1); x = XINT (Fcar (coordinates)); y = XINT (Fcdr (coordinates)); switch (coordinates_in_window (XWINDOW (window), &x, &y)) { case 0: /* NOT in window at all. */ return Qnil; case 1: /* In text part of window. */ return Fcons (x, y); case 2: /* In mode line of window. */ return Qmode_line; case 3: /* On right border of window. */ return Qvertical_line; default: abort (); } } /* Find the window containing column x, row y, and return it as a Lisp_Object. If x, y is on the window's modeline, set *part to 1; if it is on the separating line between the window and its right sibling, set it to 2; otherwise set it to 0. If there is no window under x, y return nil and leave *part unmodified. */ Lisp_Object window_from_coordinates (frame, x, y, part) FRAME_PTR frame; int x, y; int *part; { register Lisp_Object tem, first; tem = first = FRAME_SELECTED_WINDOW (frame); do { int found = coordinates_in_window (XWINDOW (tem), &x, &y); if (found) { *part = found - 1; return tem; } tem = Fnext_window (tem, Qt, Qlambda); } while (! EQ (tem, first)); return Qnil; } DEFUN ("window-at", Fwindow_at, Swindow_at, 2, 3, 0, "Return window containing coordinates X and Y on FRAME.\n\ If omitted, FRAME defaults to the currently selected frame.\n\ The top left corner of the frame is considered to be row 0,\n\ column 0.") (x, y, frame) Lisp_Object x, y, frame; { int part; #ifdef MULTI_FRAME if (NILP (frame)) XSETFRAME (frame, selected_frame); else CHECK_LIVE_FRAME (frame, 2); #endif CHECK_NUMBER (x, 0); CHECK_NUMBER (y, 1); return window_from_coordinates (XFRAME (frame), XINT (x), XINT (y), &part); } DEFUN ("window-point", Fwindow_point, Swindow_point, 0, 1, 0, "Return current value of point in WINDOW.\n\ For a nonselected window, this is the value point would have\n\ if that window were selected.\n\ \n\ Note that, when WINDOW is the selected window and its buffer\n\ is also currently selected, the value returned is the same as (point).\n\ It would be more strictly correct to return the `top-level' value\n\ of point, outside of any save-excursion forms.\n\ But that is hard to define.") (window) Lisp_Object window; { register struct window *w = decode_window (window); if (w == XWINDOW (selected_window) && current_buffer == XBUFFER (w->buffer)) return Fpoint (); return Fmarker_position (w->pointm); } DEFUN ("window-start", Fwindow_start, Swindow_start, 0, 1, 0, "Return position at which display currently starts in WINDOW.\n\ This is updated by redisplay or by calling `set-window-start'.") (window) Lisp_Object window; { return Fmarker_position (decode_window (window)->start); } /* This is text temporarily removed from the doc string below. This function returns nil if the position is not currently known.\n\ That happens when redisplay is preempted and doesn't finish.\n\ If in that case you want to compute where the end of the window would\n\ have been if redisplay had finished, do this:\n\ (save-excursion\n\ (goto-char (window-start window))\n\ (vertical-motion (1- (window-height window)) window)\n\ (point))") */ DEFUN ("window-end", Fwindow_end, Swindow_end, 0, 1, 0, "Return position at which display currently ends in WINDOW.\n\ This is updated by redisplay, when it runs to completion.\n\ Simply changing the buffer text or setting `window-start'\n\ does not update this value.") (window) Lisp_Object window; { Lisp_Object value; struct window *w = decode_window (window); Lisp_Object buf; buf = w->buffer; CHECK_BUFFER (buf, 0); #if 0 /* This change broke some things. We should make it later. */ /* If we don't know the end position, return nil. The user can compute it with vertical-motion if he wants to. It would be nicer to do it automatically, but that's so slow that it would probably bother people. */ if (NILP (w->window_end_valid)) return Qnil; #endif XSETINT (value, BUF_Z (XBUFFER (buf)) - XFASTINT (w->window_end_pos)); return value; } DEFUN ("set-window-point", Fset_window_point, Sset_window_point, 2, 2, 0, "Make point value in WINDOW be at position POS in WINDOW's buffer.") (window, pos) Lisp_Object window, pos; { register struct window *w = decode_window (window); CHECK_NUMBER_COERCE_MARKER (pos, 1); if (w == XWINDOW (selected_window)) Fgoto_char (pos); else set_marker_restricted (w->pointm, pos, w->buffer); return pos; } DEFUN ("set-window-start", Fset_window_start, Sset_window_start, 2, 3, 0, "Make display in WINDOW start at position POS in WINDOW's buffer.\n\ Optional third arg NOFORCE non-nil inhibits next redisplay\n\ from overriding motion of point in order to display at this exact start.") (window, pos, noforce) Lisp_Object window, pos, noforce; { register struct window *w = decode_window (window); CHECK_NUMBER_COERCE_MARKER (pos, 1); set_marker_restricted (w->start, pos, w->buffer); /* this is not right, but much easier than doing what is right. */ w->start_at_line_beg = Qnil; if (NILP (noforce)) w->force_start = Qt; w->update_mode_line = Qt; XSETFASTINT (w->last_modified, 0); if (!EQ (window, selected_window)) windows_or_buffers_changed++; return pos; } DEFUN ("window-dedicated-p", Fwindow_dedicated_p, Swindow_dedicated_p, 1, 1, 0, "Return WINDOW's dedicated object, usually t or nil.\n\ See also `set-window-dedicated-p'.") (window) Lisp_Object window; { return decode_window (window)->dedicated; } DEFUN ("set-window-dedicated-p", Fset_window_dedicated_p, Sset_window_dedicated_p, 2, 2, 0, "Control whether WINDOW is dedicated to the buffer it displays.\n\ If it is dedicated, Emacs will not automatically change\n\ which buffer appears in it.\n\ The second argument is the new value for the dedication flag;\n\ non-nil means yes.") (window, arg) Lisp_Object window, arg; { register struct window *w = decode_window (window); if (NILP (arg)) w->dedicated = Qnil; else w->dedicated = Qt; return w->dedicated; } DEFUN ("window-display-table", Fwindow_display_table, Swindow_display_table, 0, 1, 0, "Return the display-table that WINDOW is using.") (window) Lisp_Object window; { return decode_window (window)->display_table; } /* Get the display table for use currently on window W. This is either W's display table or W's buffer's display table. Ignore the specified tables if they are not valid; if no valid table is specified, return 0. */ struct Lisp_Char_Table * window_display_table (w) struct window *w; { Lisp_Object tem; tem = w->display_table; if (DISP_TABLE_P (tem)) return XCHAR_TABLE (tem); tem = XBUFFER (w->buffer)->display_table; if (DISP_TABLE_P (tem)) return XCHAR_TABLE (tem); tem = Vstandard_display_table; if (DISP_TABLE_P (tem)) return XCHAR_TABLE (tem); return 0; } DEFUN ("set-window-display-table", Fset_window_display_table, Sset_window_display_table, 2, 2, 0, "Set WINDOW's display-table to TABLE.") (window, table) register Lisp_Object window, table; { register struct window *w; register Lisp_Object z; /* Return value. */ w = decode_window (window); w->display_table = table; return table; } /* Record info on buffer window w is displaying when it is about to cease to display that buffer. */ static unshow_buffer (w) register struct window *w; { Lisp_Object buf; buf = w->buffer; if (XBUFFER (buf) != XMARKER (w->pointm)->buffer) abort (); #if 0 if (w == XWINDOW (selected_window) || ! EQ (buf, XWINDOW (selected_window)->buffer)) /* Do this except when the selected window's buffer is being removed from some other window. */ #endif /* last_window_start records the start position that this buffer had in the last window to be disconnected from it. Now that this statement is unconditional, it is possible for the buffer to be displayed in the selected window, while last_window_start reflects another window which was recently showing the same buffer. Some people might say that might be a good thing. Let's see. */ XBUFFER (buf)->last_window_start = marker_position (w->start); /* Point in the selected window's buffer is actually stored in that buffer, and the window's pointm isn't used. So don't clobber point in that buffer. */ if (! EQ (buf, XWINDOW (selected_window)->buffer)) BUF_PT (XBUFFER (buf)) = clip_to_bounds (BUF_BEGV (XBUFFER (buf)), marker_position (w->pointm), BUF_ZV (XBUFFER (buf))); } /* Put replacement into the window structure in place of old. */ static replace_window (old, replacement) Lisp_Object old, replacement; { register Lisp_Object tem; register struct window *o = XWINDOW (old), *p = XWINDOW (replacement); /* If OLD is its frame's root_window, then replacement is the new root_window for that frame. */ if (EQ (old, FRAME_ROOT_WINDOW (XFRAME (o->frame)))) FRAME_ROOT_WINDOW (XFRAME (o->frame)) = replacement; p->left = o->left; p->top = o->top; p->width = o->width; p->height = o->height; p->next = tem = o->next; if (!NILP (tem)) XWINDOW (tem)->prev = replacement; p->prev = tem = o->prev; if (!NILP (tem)) XWINDOW (tem)->next = replacement; p->parent = tem = o->parent; if (!NILP (tem)) { if (EQ (XWINDOW (tem)->vchild, old)) XWINDOW (tem)->vchild = replacement; if (EQ (XWINDOW (tem)->hchild, old)) XWINDOW (tem)->hchild = replacement; } /*** Here, if replacement is a vertical combination and so is its new parent, we should make replacement's children be children of that parent instead. ***/ } DEFUN ("delete-window", Fdelete_window, Sdelete_window, 0, 1, "", "Remove WINDOW from the display. Default is selected window.") (window) register Lisp_Object window; { register Lisp_Object tem, parent, sib; register struct window *p; register struct window *par; /* Because this function is called by other C code on non-leaf windows, the CHECK_LIVE_WINDOW macro would choke inappropriately, so we can't decode_window here. */ if (NILP (window)) window = selected_window; else CHECK_WINDOW (window, 0); p = XWINDOW (window); /* It's okay to delete an already-deleted window. */ if (NILP (p->buffer) && NILP (p->hchild) && NILP (p->vchild)) return Qnil; parent = p->parent; if (NILP (parent)) error ("Attempt to delete minibuffer or sole ordinary window"); par = XWINDOW (parent); windows_or_buffers_changed++; FRAME_WINDOW_SIZES_CHANGED (XFRAME (WINDOW_FRAME (p))) = 1; /* Are we trying to delete any frame's selected window? */ { Lisp_Object frame, pwindow; /* See if the frame's selected window is either WINDOW or any subwindow of it, by finding all that window's parents and comparing each one with WINDOW. */ frame = WINDOW_FRAME (XWINDOW (window)); pwindow = FRAME_SELECTED_WINDOW (XFRAME (frame)); while (!NILP (pwindow)) { if (EQ (window, pwindow)) break; pwindow = XWINDOW (pwindow)->parent; } if (EQ (window, pwindow)) { Lisp_Object alternative; alternative = Fnext_window (window, Qlambda, Qnil); /* If we're about to delete the selected window on the selected frame, then we should use Fselect_window to select the new window. On the other hand, if we're about to delete the selected window on any other frame, we shouldn't do anything but set the frame's selected_window slot. */ if (EQ (window, selected_window)) Fselect_window (alternative); else FRAME_SELECTED_WINDOW (XFRAME (frame)) = alternative; } } tem = p->buffer; /* tem is null for dummy parent windows (which have inferiors but not any contents themselves) */ if (!NILP (tem)) { unshow_buffer (p); unchain_marker (p->pointm); unchain_marker (p->start); } tem = p->next; if (!NILP (tem)) XWINDOW (tem)->prev = p->prev; tem = p->prev; if (!NILP (tem)) XWINDOW (tem)->next = p->next; if (EQ (window, par->hchild)) par->hchild = p->next; if (EQ (window, par->vchild)) par->vchild = p->next; /* Find one of our siblings to give our space to. */ sib = p->prev; if (NILP (sib)) { /* If p gives its space to its next sibling, that sibling needs to have its top/left side pulled back to where p's is. set_window_{height,width} will re-position the sibling's children. */ sib = p->next; XWINDOW (sib)->top = p->top; XWINDOW (sib)->left = p->left; } /* Stretch that sibling. */ if (!NILP (par->vchild)) set_window_height (sib, XFASTINT (XWINDOW (sib)->height) + XFASTINT (p->height), 1); if (!NILP (par->hchild)) set_window_width (sib, XFASTINT (XWINDOW (sib)->width) + XFASTINT (p->width), 1); /* If parent now has only one child, put the child into the parent's place. */ tem = par->hchild; if (NILP (tem)) tem = par->vchild; if (NILP (XWINDOW (tem)->next)) replace_window (parent, tem); /* Since we may be deleting combination windows, we must make sure that not only p but all its children have been marked as deleted. */ if (! NILP (p->hchild)) delete_all_subwindows (XWINDOW (p->hchild)); else if (! NILP (p->vchild)) delete_all_subwindows (XWINDOW (p->vchild)); /* Mark this window as deleted. */ p->buffer = p->hchild = p->vchild = Qnil; return Qnil; } 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\ \n\ Optional second arg MINIBUF t means count the minibuffer window even\n\ if not active. MINIBUF nil or omitted means count the minibuffer iff\n\ it is active. MINIBUF neither t nor nil means not to count the\n\ minibuffer even if it is active.\n\ \n\ Several frames may share a single minibuffer; if the minibuffer\n\ counts, all windows on all frames that share that minibuffer count\n\ too. Therefore, `next-window' can be used to iterate through the\n\ set of windows even when the minibuffer is on another frame. If the\n\ minibuffer does not count, only windows from WINDOW's frame count.\n\ \n\ Optional third arg ALL-FRAMES t means include windows on all frames.\n\ ALL-FRAMES nil or omitted means cycle within the frames as specified\n\ above. ALL-FRAMES = `visible' means include windows on all visible frames.\n\ ALL-FRAMES = 0 means include windows on all visible and iconified frames.\n\ If ALL-FRAMES is a frame, restrict search to windows on that frame.\n\ Anything else means restrict to WINDOW's frame.\n\ \n\ If you use consistent values for MINIBUF and ALL-FRAMES, you can use\n\ `next-window' to iterate through the entire cycle of acceptable\n\ 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; { register Lisp_Object tem; Lisp_Object start_window; if (NILP (window)) window = selected_window; else CHECK_LIVE_WINDOW (window, 0); start_window = window; /* minibuf == nil may or may not include minibuffers. Decide if it does. */ if (NILP (minibuf)) minibuf = (minibuf_level ? minibuf_window : Qlambda); else if (! EQ (minibuf, Qt)) minibuf = Qlambda; /* Now minibuf can be t => count all minibuffer windows, lambda => count none of them, or a specific minibuffer window (the active one) to count. */ #ifdef MULTI_FRAME /* all_frames == nil doesn't specify which frames to include. */ if (NILP (all_frames)) all_frames = (! EQ (minibuf, Qlambda) ? (FRAME_MINIBUF_WINDOW (XFRAME (WINDOW_FRAME (XWINDOW (window))))) : Qnil); else if (EQ (all_frames, Qvisible)) ; else if (XFASTINT (all_frames) == 0) ; else if (FRAMEP (all_frames) && ! EQ (all_frames, Fwindow_frame (window))) /* If all_frames is a frame and window arg isn't on that frame, just return the first window on the frame. */ return Fframe_first_window (all_frames); else if (! EQ (all_frames, Qt)) all_frames = Qnil; /* Now all_frames is t meaning search all frames, nil meaning search just current frame, visible meaning search just visible frames, 0 meaning search visible and iconified frames, or a window, meaning search the frame that window belongs to. */ #endif /* Do this loop at least once, to get the next window, and perhaps again, if we hit the minibuffer and that is not acceptable. */ do { /* Find a window that actually has a next one. This loop climbs up the tree. */ while (tem = XWINDOW (window)->next, NILP (tem)) if (tem = XWINDOW (window)->parent, !NILP (tem)) window = tem; else { /* We've reached the end of this frame. Which other frames are acceptable? */ tem = WINDOW_FRAME (XWINDOW (window)); #ifdef MULTI_FRAME if (! NILP (all_frames)) { Lisp_Object tem1; tem1 = tem; tem = next_frame (tem, all_frames); /* In the case where the minibuffer is active, and we include its frame as well as the selected one, next_frame may get stuck in that frame. If that happens, go back to the selected frame so we can complete the cycle. */ if (EQ (tem, tem1)) XSETFRAME (tem, selected_frame); } #endif tem = FRAME_ROOT_WINDOW (XFRAME (tem)); break; } window = tem; /* If we're in a combination window, find its first child and recurse on that. Otherwise, we've found the window we want. */ while (1) { if (!NILP (XWINDOW (window)->hchild)) window = XWINDOW (window)->hchild; else if (!NILP (XWINDOW (window)->vchild)) window = XWINDOW (window)->vchild; else break; } } /* Which windows are acceptible? Exit the loop and accept this window if this isn't a minibuffer window, or we're accepting all minibuffer windows, or this is the active minibuffer and we are accepting that one, or we've come all the way around and we're back at the original window. */ while (MINI_WINDOW_P (XWINDOW (window)) && ! EQ (minibuf, Qt) && ! EQ (minibuf, window) && ! EQ (window, start_window)); return window; } /* 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\ \n\ Optional second arg MINIBUF t means count the minibuffer window even\n\ if not active. MINIBUF nil or omitted means count the minibuffer iff\n\ it is active. MINIBUF neither t nor nil means not to count the\n\ minibuffer even if it is active.\n\ \n\ Several frames may share a single minibuffer; if the minibuffer\n\ counts, all windows on all frames that share that minibuffer count\n\ too. Therefore, `previous-window' can be used to iterate through\n\ the set of windows even when the minibuffer is on another frame. If\n\ the minibuffer does not count, only windows from WINDOW's frame count\n\ \n\ Optional third arg ALL-FRAMES t means include windows on all frames.\n\ ALL-FRAMES nil or omitted means cycle within the frames as specified\n\ above. ALL-FRAMES = `visible' means include windows on all visible frames.\n\ ALL-FRAMES = 0 means include windows on all visible and iconified frames.\n\ If ALL-FRAMES is a frame, restrict search to windows on that frame.\n\ Anything else means restrict to WINDOW's frame.\n\ \n\ If you use consistent values for MINIBUF and ALL-FRAMES, you can use\n\ `previous-window' to iterate through the entire cycle of acceptable\n\ 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; { register Lisp_Object tem; Lisp_Object start_window; if (NILP (window)) window = selected_window; else CHECK_LIVE_WINDOW (window, 0); start_window = window; /* minibuf == nil may or may not include minibuffers. Decide if it does. */ if (NILP (minibuf)) minibuf = (minibuf_level ? minibuf_window : Qlambda); else if (! EQ (minibuf, Qt)) minibuf = Qlambda; /* Now minibuf can be t => count all minibuffer windows, lambda => count none of them, or a specific minibuffer window (the active one) to count. */ #ifdef MULTI_FRAME /* all_frames == nil doesn't specify which frames to include. Decide which frames it includes. */ if (NILP (all_frames)) all_frames = (! EQ (minibuf, Qlambda) ? (FRAME_MINIBUF_WINDOW (XFRAME (WINDOW_FRAME (XWINDOW (window))))) : Qnil); else if (EQ (all_frames, Qvisible)) ; else if (XFASTINT (all_frames) == 0) ; else if (FRAMEP (all_frames) && ! EQ (all_frames, Fwindow_frame (window))) /* If all_frames is a frame and window arg isn't on that frame, just return the first window on the frame. */ return Fframe_first_window (all_frames); else if (! EQ (all_frames, Qt)) all_frames = Qnil; /* Now all_frames is t meaning search all frames, nil meaning search just current frame, visible meaning search just visible frames, 0 meaning search visible and iconified frames, or a window, meaning search the frame that window belongs to. */ #endif /* Do this loop at least once, to get the previous window, and perhaps again, if we hit the minibuffer and that is not acceptable. */ do { /* Find a window that actually has a previous one. This loop climbs up the tree. */ while (tem = XWINDOW (window)->prev, NILP (tem)) if (tem = XWINDOW (window)->parent, !NILP (tem)) window = tem; else { /* We have found the top window on the frame. Which frames are acceptable? */ tem = WINDOW_FRAME (XWINDOW (window)); #ifdef MULTI_FRAME if (! NILP (all_frames)) /* It's actually important that we use prev_frame here, rather than next_frame. All the windows acceptable according to the given parameters should form a ring; Fnext_window and Fprevious_window should go back and forth around the ring. If we use next_frame here, then Fnext_window and Fprevious_window take different paths through the set of acceptable windows. window_loop assumes that these `ring' requirement are met. */ { Lisp_Object tem1; tem1 = tem; tem = prev_frame (tem, all_frames); /* In the case where the minibuffer is active, and we include its frame as well as the selected one, next_frame may get stuck in that frame. If that happens, go back to the selected frame so we can complete the cycle. */ if (EQ (tem, tem1)) XSETFRAME (tem, selected_frame); } #endif /* If this frame has a minibuffer, find that window first, because it is conceptually the last window in that frame. */ if (FRAME_HAS_MINIBUF_P (XFRAME (tem))) tem = FRAME_MINIBUF_WINDOW (XFRAME (tem)); else tem = FRAME_ROOT_WINDOW (XFRAME (tem)); break; } window = tem; /* If we're in a combination window, find its last child and recurse on that. Otherwise, we've found the window we want. */ while (1) { if (!NILP (XWINDOW (window)->hchild)) window = XWINDOW (window)->hchild; else if (!NILP (XWINDOW (window)->vchild)) window = XWINDOW (window)->vchild; else break; while (tem = XWINDOW (window)->next, !NILP (tem)) window = tem; } } /* Which windows are acceptible? Exit the loop and accept this window if this isn't a minibuffer window, or we're accepting all minibuffer windows, or this is the active minibuffer and we are accepting that one, or we've come all the way around and we're back at the original window. */ while (MINI_WINDOW_P (XWINDOW (window)) && ! EQ (minibuf, Qt) && ! EQ (minibuf, window) && ! EQ (window, start_window)); return window; } DEFUN ("other-window", Fother_window, Sother_window, 1, 2, "p", "Select the ARG'th different window on this frame.\n\ All windows on current frame are arranged in a cyclic order.\n\ This command selects the window ARG steps away in that order.\n\ A negative ARG moves in the opposite order. If the optional second\n\ argument ALL_FRAMES is non-nil, cycle through all frames.") (n, all_frames) register Lisp_Object n, all_frames; { register int i; register Lisp_Object w; CHECK_NUMBER (n, 0); w = selected_window; i = XINT (n); while (i > 0) { w = Fnext_window (w, Qnil, all_frames); i--; } while (i < 0) { w = Fprevious_window (w, Qnil, all_frames); i++; } Fselect_window (w); return Qnil; } /* Look at all windows, performing an operation specified by TYPE with argument OBJ. If FRAMES is Qt, look at all frames; Qnil, look at just the selected frame; Qvisible, look at visible frames; a frame, just look at windows on that frame. If MINI is non-zero, perform the operation on minibuffer windows too. */ enum window_loop { WINDOW_LOOP_UNUSED, GET_BUFFER_WINDOW, /* Arg is buffer */ GET_LRU_WINDOW, /* Arg is t for full-width windows only */ DELETE_OTHER_WINDOWS, /* Arg is window not to delete */ DELETE_BUFFER_WINDOWS, /* Arg is buffer */ GET_LARGEST_WINDOW, UNSHOW_BUFFER /* Arg is buffer */ }; static Lisp_Object window_loop (type, obj, mini, frames) enum window_loop type; register Lisp_Object obj, frames; int mini; { register Lisp_Object w; register Lisp_Object best_window; register Lisp_Object next_window; register Lisp_Object last_window; FRAME_PTR frame; Lisp_Object frame_arg; frame_arg = Qt; #ifdef MULTI_FRAME /* If we're only looping through windows on a particular frame, frame points to that frame. If we're looping through windows on all frames, frame is 0. */ if (FRAMEP (frames)) frame = XFRAME (frames); else if (NILP (frames)) frame = selected_frame; else frame = 0; if (frame) frame_arg = Qlambda; else if (XFASTINT (frames) == 0) frame_arg = frames; else if (EQ (frames, Qvisible)) frame_arg = frames; #else frame = 0; #endif /* frame_arg is Qlambda to stick to one frame, Qvisible to consider all visible frames, or Qt otherwise. */ /* Pick a window to start with. */ if (WINDOWP (obj)) w = obj; else if (frame) w = FRAME_SELECTED_WINDOW (frame); else w = FRAME_SELECTED_WINDOW (selected_frame); /* Figure out the last window we're going to mess with. Since Fnext_window, given the same options, is guaranteed to go in a ring, we can just use Fprevious_window to find the last one. We can't just wait until we hit the first window again, because it might be deleted. */ last_window = Fprevious_window (w, mini ? Qt : Qnil, frame_arg); best_window = Qnil; for (;;) { FRAME_PTR w_frame = XFRAME (WINDOW_FRAME (XWINDOW (w))); /* Pick the next window now, since some operations will delete the current window. */ next_window = Fnext_window (w, mini ? Qt : Qnil, frame_arg); /* Note that we do not pay attention here to whether the frame is visible, since Fnext_window skips non-visible frames if that is desired, under the control of frame_arg. */ if (! MINI_WINDOW_P (XWINDOW (w)) || (mini && minibuf_level > 0)) switch (type) { case GET_BUFFER_WINDOW: if (XBUFFER (XWINDOW (w)->buffer) == XBUFFER (obj)) return w; break; case GET_LRU_WINDOW: /* t as arg means consider only full-width windows */ if (!NILP (obj) && XFASTINT (XWINDOW (w)->width) != FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (w))))) break; /* Ignore dedicated windows and minibuffers. */ if (MINI_WINDOW_P (XWINDOW (w)) || !NILP (XWINDOW (w)->dedicated)) break; if (NILP (best_window) || (XFASTINT (XWINDOW (best_window)->use_time) > XFASTINT (XWINDOW (w)->use_time))) best_window = w; break; case DELETE_OTHER_WINDOWS: if (XWINDOW (w) != XWINDOW (obj)) Fdelete_window (w); break; case DELETE_BUFFER_WINDOWS: if (EQ (XWINDOW (w)->buffer, obj)) { #ifdef MULTI_FRAME FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (w))); /* If this window is dedicated, and in a frame of its own, kill the frame. */ if (EQ (w, FRAME_ROOT_WINDOW (f)) && !NILP (XWINDOW (w)->dedicated) && other_visible_frames (f)) { /* Skip the other windows on this frame. There might be one, the minibuffer! */ if (! EQ (w, last_window)) while (f == XFRAME (WINDOW_FRAME (XWINDOW (next_window)))) { /* As we go, check for the end of the loop. We mustn't start going around a second time. */ if (EQ (next_window, last_window)) { last_window = w; break; } next_window = Fnext_window (next_window, mini ? Qt : Qnil, frame_arg); } /* Now we can safely delete the frame. */ Fdelete_frame (WINDOW_FRAME (XWINDOW (w)), Qnil); } else #endif /* If we're deleting the buffer displayed in the only window on the frame, find a new buffer to display there. */ if (NILP (XWINDOW (w)->parent)) { Lisp_Object new_buffer; new_buffer = Fother_buffer (obj, Qnil); if (NILP (new_buffer)) new_buffer = Fget_buffer_create (build_string ("*scratch*")); Fset_window_buffer (w, new_buffer); if (EQ (w, selected_window)) Fset_buffer (XWINDOW (w)->buffer); } else Fdelete_window (w); } break; case GET_LARGEST_WINDOW: /* Ignore dedicated windows and minibuffers. */ if (MINI_WINDOW_P (XWINDOW (w)) || !NILP (XWINDOW (w)->dedicated)) break; { struct window *best_window_ptr = XWINDOW (best_window); struct window *w_ptr = XWINDOW (w); if (NILP (best_window) || (XFASTINT (w_ptr->height) * XFASTINT (w_ptr->width) > (XFASTINT (best_window_ptr->height) * XFASTINT (best_window_ptr->width)))) best_window = w; } break; case UNSHOW_BUFFER: if (EQ (XWINDOW (w)->buffer, obj)) { /* Find another buffer to show in this window. */ Lisp_Object another_buffer; FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (w))); another_buffer = Fother_buffer (obj, Qnil); if (NILP (another_buffer)) another_buffer = Fget_buffer_create (build_string ("*scratch*")); #ifdef MULTI_FRAME /* If this window is dedicated, and in a frame of its own, kill the frame. */ if (EQ (w, FRAME_ROOT_WINDOW (f)) && !NILP (XWINDOW (w)->dedicated) && other_visible_frames (f)) { /* Skip the other windows on this frame. There might be one, the minibuffer! */ if (! EQ (w, last_window)) while (f == XFRAME (WINDOW_FRAME (XWINDOW (next_window)))) { /* As we go, check for the end of the loop. We mustn't start going around a second time. */ if (EQ (next_window, last_window)) { last_window = w; break; } next_window = Fnext_window (next_window, mini ? Qt : Qnil, frame_arg); } /* Now we can safely delete the frame. */ Fdelete_frame (WINDOW_FRAME (XWINDOW (w)), Qnil); } else #endif { /* Otherwise show a different buffer in the window. */ XWINDOW (w)->dedicated = Qnil; Fset_window_buffer (w, another_buffer); if (EQ (w, selected_window)) Fset_buffer (XWINDOW (w)->buffer); } } break; } if (EQ (w, last_window)) break; w = next_window; } return best_window; } DEFUN ("get-lru-window", Fget_lru_window, Sget_lru_window, 0, 1, 0, "Return the window least recently selected or used for display.\n\ If optional argument FRAME is `visible', search all visible frames.\n\ If FRAME is 0, search all visible and iconified frames.\n\ If FRAME is t, search all frames.\n\ If FRAME is nil, search only the selected frame.\n\ If FRAME is a frame, search only that frame.") (frame) Lisp_Object frame; { register Lisp_Object w; /* First try for a window that is full-width */ w = window_loop (GET_LRU_WINDOW, Qt, 0, frame); if (!NILP (w) && !EQ (w, selected_window)) return w; /* If none of them, try the rest */ return window_loop (GET_LRU_WINDOW, Qnil, 0, frame); } DEFUN ("get-largest-window", Fget_largest_window, Sget_largest_window, 0, 1, 0, "Return the largest window in area.\n\ If optional argument FRAME is `visible', search all visible frames.\n\ If FRAME is 0, search all visible and iconified frames.\n\ If FRAME is t, search all frames.\n\ If FRAME is nil, search only the selected frame.\n\ If FRAME is a frame, search only that frame.") (frame) Lisp_Object frame; { return window_loop (GET_LARGEST_WINDOW, Qnil, 0, frame); } DEFUN ("get-buffer-window", Fget_buffer_window, Sget_buffer_window, 1, 2, 0, "Return a window currently displaying BUFFER, or nil if none.\n\ If optional argument FRAME is `visible', search all visible frames.\n\ If optional argument FRAME is 0, search all visible and iconified frames.\n\ If FRAME is t, search all frames.\n\ If FRAME is nil, search only the selected frame.\n\ If FRAME is a frame, search only that frame.") (buffer, frame) Lisp_Object buffer, frame; { buffer = Fget_buffer (buffer); if (BUFFERP (buffer)) return window_loop (GET_BUFFER_WINDOW, buffer, 1, frame); else return Qnil; } DEFUN ("delete-other-windows", Fdelete_other_windows, Sdelete_other_windows, 0, 1, "", "Make WINDOW (or the selected window) fill its frame.\n\ Only the frame WINDOW is on is affected.\n\ This function tries to reduce display jumps\n\ by keeping the text previously visible in WINDOW\n\ in the same place on the frame. Doing this depends on\n\ the value of (window-start WINDOW), so if calling this function\n\ in a program gives strange scrolling, make sure the window-start\n\ value is reasonable when this function is called.") (window) Lisp_Object window; { struct window *w; int startpos; int top; if (NILP (window)) window = selected_window; else CHECK_LIVE_WINDOW (window, 0); w = XWINDOW (window); startpos = marker_position (w->start); top = XFASTINT (w->top) - FRAME_MENU_BAR_LINES (XFRAME (WINDOW_FRAME (w))); if (MINI_WINDOW_P (w) && top > 0) error ("Can't expand minibuffer to full frame"); window_loop (DELETE_OTHER_WINDOWS, window, 0, WINDOW_FRAME (w)); /* Try to minimize scrolling, by setting the window start to the point will cause the text at the old window start to be at the same place on the frame. But don't try to do this if the window start is outside the visible portion (as might happen when the display is not current, due to typeahead). */ if (startpos >= BUF_BEGV (XBUFFER (w->buffer)) && startpos <= BUF_ZV (XBUFFER (w->buffer))) { struct position pos; struct buffer *obuf = current_buffer; Fset_buffer (w->buffer); /* This computation used to temporarily move point, but that can have unwanted side effects due to text properties. */ pos = *vmotion (startpos, -top, w); Fset_marker (w->start, make_number (pos.bufpos), w->buffer); w->start_at_line_beg = ((pos.bufpos == BEGV || FETCH_CHAR (pos.bufpos - 1) == '\n') ? Qt : Qnil); /* We need to do this, so that the window-scroll-functions get called. */ w->force_start = Qt; set_buffer_internal (obuf); } return Qnil; } DEFUN ("delete-windows-on", Fdelete_windows_on, Sdelete_windows_on, 1, 2, "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 `visible', delete all windows showing BUFFER in any visible 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; } DEFUN ("replace-buffer-in-windows", Freplace_buffer_in_windows, Sreplace_buffer_in_windows, 1, 1, "bReplace buffer in windows: ", "Replace BUFFER with some other buffer in all windows showing it.") (buffer) Lisp_Object buffer; { if (!NILP (buffer)) { buffer = Fget_buffer (buffer); CHECK_BUFFER (buffer, 0); window_loop (UNSHOW_BUFFER, buffer, 0, Qt); } return Qnil; } /* Set the height of WINDOW and all its inferiors. */ /* The smallest acceptable dimensions for a window. Anything smaller might crash Emacs. */ #define MIN_SAFE_WINDOW_WIDTH (2) #define MIN_SAFE_WINDOW_HEIGHT (2) /* Make sure that window_min_height and window_min_width are not too small; if they are, set them to safe minima. */ static void check_min_window_sizes () { /* Smaller values might permit a crash. */ if (window_min_width < MIN_SAFE_WINDOW_WIDTH) window_min_width = MIN_SAFE_WINDOW_WIDTH; if (window_min_height < MIN_SAFE_WINDOW_HEIGHT) window_min_height = MIN_SAFE_WINDOW_HEIGHT; } /* If *ROWS or *COLS are too small a size for FRAME, set them to the minimum allowable size. */ void check_frame_size (frame, rows, cols) FRAME_PTR frame; int *rows, *cols; { /* For height, we have to see: whether the frame has a minibuffer, whether it wants a mode line, and whether it has a menu bar. */ int min_height = (FRAME_MINIBUF_ONLY_P (frame) ? MIN_SAFE_WINDOW_HEIGHT - 1 : (! FRAME_HAS_MINIBUF_P (frame)) ? MIN_SAFE_WINDOW_HEIGHT : 2 * MIN_SAFE_WINDOW_HEIGHT - 1); if (FRAME_MENU_BAR_LINES (frame) > 0) min_height += FRAME_MENU_BAR_LINES (frame); if (*rows < min_height) *rows = min_height; if (*cols < MIN_SAFE_WINDOW_WIDTH) *cols = MIN_SAFE_WINDOW_WIDTH; } /* Normally the window is deleted if it gets too small. nodelete nonzero means do not do this. (The caller should check later and do so if appropriate) */ set_window_height (window, height, nodelete) Lisp_Object window; int height; int nodelete; { register struct window *w = XWINDOW (window); register struct window *c; int oheight = XFASTINT (w->height); int top, pos, lastbot, opos, lastobot; Lisp_Object child; check_min_window_sizes (); if (!nodelete && ! NILP (w->parent) && height < window_min_height) { Fdelete_window (window); return; } XSETFASTINT (w->last_modified, 0); windows_or_buffers_changed++; FRAME_WINDOW_SIZES_CHANGED (XFRAME (WINDOW_FRAME (w))) = 1; XSETFASTINT (w->height, height); if (!NILP (w->hchild)) { for (child = w->hchild; !NILP (child); child = XWINDOW (child)->next) { XWINDOW (child)->top = w->top; set_window_height (child, height, nodelete); } } else if (!NILP (w->vchild)) { lastbot = top = XFASTINT (w->top); lastobot = 0; for (child = w->vchild; !NILP (child); child = c->next) { c = XWINDOW (child); opos = lastobot + XFASTINT (c->height); XSETFASTINT (c->top, lastbot); pos = (((opos * height) << 1) + oheight) / (oheight << 1); /* Avoid confusion: inhibit deletion of child if becomes too small */ set_window_height (child, pos + top - lastbot, 1); /* Now advance child to next window, and set lastbot if child was not just deleted. */ lastbot = pos + top; lastobot = opos; } /* Now delete any children that became too small. */ if (!nodelete) for (child = w->vchild; !NILP (child); child = XWINDOW (child)->next) { set_window_height (child, XINT (XWINDOW (child)->height), 0); } } } /* Recursively set width of WINDOW and its inferiors. */ set_window_width (window, width, nodelete) Lisp_Object window; int width; int nodelete; { register struct window *w = XWINDOW (window); register struct window *c; int owidth = XFASTINT (w->width); int left, pos, lastright, opos, lastoright; Lisp_Object child; if (!nodelete && width < window_min_width && !NILP (w->parent)) { Fdelete_window (window); return; } XSETFASTINT (w->last_modified, 0); windows_or_buffers_changed++; FRAME_WINDOW_SIZES_CHANGED (XFRAME (WINDOW_FRAME (w))) = 1; XSETFASTINT (w->width, width); if (!NILP (w->vchild)) { for (child = w->vchild; !NILP (child); child = XWINDOW (child)->next) { XWINDOW (child)->left = w->left; set_window_width (child, width, nodelete); } } else if (!NILP (w->hchild)) { lastright = left = XFASTINT (w->left); lastoright = 0; for (child = w->hchild; !NILP (child); child = c->next) { c = XWINDOW (child); opos = lastoright + XFASTINT (c->width); XSETFASTINT (c->left, lastright); pos = (((opos * width) << 1) + owidth) / (owidth << 1); /* Inhibit deletion for becoming too small */ set_window_width (child, pos + left - lastright, 1); /* Now advance child to next window, and set lastright if child was not just deleted. */ lastright = pos + left, lastoright = opos; } /* Delete children that became too small */ if (!nodelete) for (child = w->hchild; !NILP (child); child = XWINDOW (child)->next) { set_window_width (child, XINT (XWINDOW (child)->width), 0); } } } int window_select_count; DEFUN ("set-window-buffer", Fset_window_buffer, Sset_window_buffer, 2, 2, 0, "Make WINDOW display BUFFER as its contents.\n\ BUFFER can be a buffer or buffer name.") (window, buffer) register Lisp_Object window, buffer; { register Lisp_Object tem; register struct window *w = decode_window (window); buffer = Fget_buffer (buffer); CHECK_BUFFER (buffer, 1); if (NILP (XBUFFER (buffer)->name)) error ("Attempt to display deleted buffer"); tem = w->buffer; if (NILP (tem)) error ("Window is deleted"); else if (! EQ (tem, Qt)) /* w->buffer is t when the window is first being set up. */ { if (!NILP (w->dedicated) && !EQ (tem, buffer)) error ("Window is dedicated to `%s'", XSTRING (XBUFFER (tem)->name)->data); unshow_buffer (w); } w->buffer = buffer; XSETFASTINT (w->window_end_pos, 0); w->window_end_valid = Qnil; XSETFASTINT(w->hscroll, 0); Fset_marker (w->pointm, make_number (BUF_PT (XBUFFER (buffer))), buffer); set_marker_restricted (w->start, make_number (XBUFFER (buffer)->last_window_start), buffer); w->start_at_line_beg = Qnil; w->force_start = Qnil; XSETFASTINT (w->last_modified, 0); windows_or_buffers_changed++; if (EQ (window, selected_window)) Fset_buffer (buffer); return Qnil; } DEFUN ("select-window", Fselect_window, Sselect_window, 1, 1, 0, "Select WINDOW. Most editing will apply to WINDOW's buffer.\n\ The main editor command loop selects the buffer of the selected window\n\ before each command.") (window) register Lisp_Object window; { register struct window *w; register struct window *ow = XWINDOW (selected_window); CHECK_LIVE_WINDOW (window, 0); w = XWINDOW (window); if (NILP (w->buffer)) error ("Trying to select deleted window or non-leaf window"); XSETFASTINT (w->use_time, ++window_select_count); if (EQ (window, selected_window)) return window; Fset_marker (ow->pointm, make_number (BUF_PT (XBUFFER (ow->buffer))), ow->buffer); selected_window = window; #ifdef MULTI_FRAME if (XFRAME (WINDOW_FRAME (w)) != selected_frame) { XFRAME (WINDOW_FRAME (w))->selected_window = window; /* Use this rather than Fhandle_switch_frame so that FRAME_FOCUS_FRAME is moved appropriately as we move around in the state where a minibuffer in a separate frame is active. */ Fselect_frame (WINDOW_FRAME (w), Qnil); } else selected_frame->selected_window = window; #endif record_buffer (w->buffer); Fset_buffer (w->buffer); /* Go to the point recorded in the window. This is important when the buffer is in more than one window. It also matters when redisplay_window has altered point after scrolling, because it makes the change only in the window. */ { register int new_point = marker_position (w->pointm); if (new_point < BEGV) SET_PT (BEGV); else if (new_point > ZV) SET_PT (ZV); else SET_PT (new_point); } windows_or_buffers_changed++; return window; } /* Deiconify the frame containing the window WINDOW, then return WINDOW. */ static Lisp_Object display_buffer_1 (window) Lisp_Object window; { #ifdef MULTI_FRAME FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (window))); FRAME_SAMPLE_VISIBILITY (f); if (FRAME_ICONIFIED_P (f)) Fmake_frame_visible (WINDOW_FRAME (XWINDOW (window))); #endif return window; } DEFUN ("display-buffer", Fdisplay_buffer, Sdisplay_buffer, 1, 2, "bDisplay buffer: \nP", "Make BUFFER appear in some window but don't select it.\n\ BUFFER can be a buffer or a buffer name.\n\ If BUFFER is shown already in some window, just use that one,\n\ unless the window is the selected window and the optional second\n\ argument NOT-THIS-WINDOW is non-nil (interactively, with prefix arg).\n\ If `pop-up-frames' is non-nil, make a new frame if no window shows BUFFER.\n\ Returns the window displaying BUFFER.") (buffer, not_this_window) register Lisp_Object buffer, not_this_window; { register Lisp_Object window, tem; buffer = Fget_buffer (buffer); CHECK_BUFFER (buffer, 0); if (!NILP (Vdisplay_buffer_function)) return call2 (Vdisplay_buffer_function, buffer, not_this_window); if (NILP (not_this_window) && XBUFFER (XWINDOW (selected_window)->buffer) == XBUFFER (buffer)) return display_buffer_1 (selected_window); /* See if the user has specified this buffer should appear in the selected window. */ if (NILP (not_this_window)) { tem = Fmember (XBUFFER (buffer)->name, Vsame_window_buffer_names); if (!NILP (tem)) { Fswitch_to_buffer (buffer, Qnil); return display_buffer_1 (selected_window); } tem = Fassoc (XBUFFER (buffer)->name, Vsame_window_buffer_names); if (!NILP (tem)) { Fswitch_to_buffer (buffer, Qnil); return display_buffer_1 (selected_window); } for (tem = Vsame_window_regexps; CONSP (tem); tem = XCONS (tem)->cdr) { Lisp_Object car = XCONS (tem)->car; if (STRINGP (car) && fast_string_match (car, XBUFFER (buffer)->name) >= 0) { Fswitch_to_buffer (buffer, Qnil); return display_buffer_1 (selected_window); } else if (CONSP (car) && STRINGP (XCONS (car)->car) && fast_string_match (XCONS (car)->car, XBUFFER (buffer)->name) >= 0) { Fswitch_to_buffer (buffer, Qnil); return display_buffer_1 (selected_window); } } } #ifdef MULTI_FRAME /* If pop_up_frames, look for a window showing BUFFER on any visible or iconified frame. Otherwise search only the current frame. */ if (pop_up_frames || last_nonminibuf_frame == 0) XSETFASTINT (tem, 0); else #endif XSETFRAME (tem, last_nonminibuf_frame); window = Fget_buffer_window (buffer, tem); if (!NILP (window) && (NILP (not_this_window) || !EQ (window, selected_window))) { return display_buffer_1 (window); } /* Certain buffer names get special handling. */ if (! NILP (Vspecial_display_function)) { tem = Fmember (XBUFFER (buffer)->name, Vspecial_display_buffer_names); if (!NILP (tem)) return call1 (Vspecial_display_function, buffer); tem = Fassoc (XBUFFER (buffer)->name, Vspecial_display_buffer_names); if (!NILP (tem)) return call2 (Vspecial_display_function, buffer, XCONS (tem)->cdr); for (tem = Vspecial_display_regexps; CONSP (tem); tem = XCONS (tem)->cdr) { Lisp_Object car = XCONS (tem)->car; if (STRINGP (car) && fast_string_match (car, XBUFFER (buffer)->name) >= 0) return call1 (Vspecial_display_function, buffer); else if (CONSP (car) && STRINGP (XCONS (car)->car) && fast_string_match (XCONS (car)->car, XBUFFER (buffer)->name) >= 0) return call2 (Vspecial_display_function, buffer, XCONS (car)->cdr); } } #ifdef MULTI_FRAME /* If there are no frames open that have more than a minibuffer, we need to create a new frame. */ if (pop_up_frames || last_nonminibuf_frame == 0) { window = Fframe_selected_window (call0 (Vpop_up_frame_function)); Fset_window_buffer (window, buffer); return display_buffer_1 (window); } #endif /* MULTI_FRAME */ if (pop_up_windows #ifdef MULTI_FRAME || FRAME_MINIBUF_ONLY_P (selected_frame) /* If the current frame is a special display frame, don't try to reuse its windows. */ || !NILP (XWINDOW (FRAME_ROOT_WINDOW (selected_frame))->dedicated) #endif ) { Lisp_Object frames; frames = Qnil; #ifdef MULTI_FRAME if (FRAME_MINIBUF_ONLY_P (selected_frame)) XSETFRAME (frames, last_nonminibuf_frame); #endif /* Don't try to create a window if would get an error */ if (split_height_threshold < window_min_height << 1) split_height_threshold = window_min_height << 1; /* Note that both Fget_largest_window and Fget_lru_window ignore minibuffers and dedicated windows. This means they can return nil. */ #ifdef MULTI_FRAME /* If the frame we would try to split cannot be split, try other frames. */ if (FRAME_NO_SPLIT_P (NILP (frames) ? selected_frame : last_nonminibuf_frame)) { /* Try visible frames first. */ window = Fget_largest_window (Qvisible); /* If that didn't work, try iconified frames. */ if (NILP (window)) window = Fget_largest_window (make_number (0)); if (NILP (window)) window = Fget_largest_window (Qt); } else #endif window = Fget_largest_window (frames); /* If we got a tall enough full-width window that can be split, split it. */ if (!NILP (window) && ! FRAME_NO_SPLIT_P (XFRAME (XWINDOW (window)->frame)) && window_height (window) >= split_height_threshold && (XFASTINT (XWINDOW (window)->width) == FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (window)))))) window = Fsplit_window (window, Qnil, Qnil); else { Lisp_Object upper, lower, other; window = Fget_lru_window (frames); /* If the LRU window is selected, and big enough, and can be split, split it. */ if (!NILP (window) && ! FRAME_NO_SPLIT_P (XFRAME (XWINDOW (window)->frame)) && (EQ (window, selected_window) || EQ (XWINDOW (window)->parent, Qnil)) && window_height (window) >= window_min_height << 1) window = Fsplit_window (window, Qnil, Qnil); #ifdef MULTI_FRAME /* If Fget_lru_window returned nil, try other approaches. */ /* Try visible frames first. */ if (NILP (window)) window = Fget_largest_window (Qvisible); /* If that didn't work, try iconified frames. */ if (NILP (window)) window = Fget_largest_window (make_number (0)); /* Try invisible frames. */ if (NILP (window)) window = Fget_largest_window (Qt); /* As a last resort, make a new frame. */ if (NILP (window)) window = Fframe_selected_window (call0 (Vpop_up_frame_function)); #else /* As a last resort, use a non minibuffer window. */ if (NILP (window)) window = Fframe_first_window (Fselected_frame ()); #endif /* If window appears above or below another, even out their heights. */ other = upper = lower = Qnil; if (!NILP (XWINDOW (window)->prev)) other = upper = XWINDOW (window)->prev, lower = window; if (!NILP (XWINDOW (window)->next)) other = lower = XWINDOW (window)->next, upper = window; if (!NILP (other) /* Check that OTHER and WINDOW are vertically arrayed. */ && XWINDOW (other)->top != XWINDOW (window)->top && XWINDOW (other)->height > XWINDOW (window)->height) { int total = XWINDOW (other)->height + XWINDOW (window)->height; Lisp_Object old_selected_window; old_selected_window = selected_window; selected_window = upper; change_window_height (total / 2 - XWINDOW (upper)->height, 0); selected_window = old_selected_window; } } } else window = Fget_lru_window (Qnil); Fset_window_buffer (window, buffer); return display_buffer_1 (window); } void temp_output_buffer_show (buf) register Lisp_Object buf; { register struct buffer *old = current_buffer; register Lisp_Object window; register struct window *w; Fset_buffer (buf); BUF_SAVE_MODIFF (XBUFFER (buf)) = MODIFF; BEGV = BEG; ZV = Z; SET_PT (BEG); XBUFFER (buf)->clip_changed = 1; set_buffer_internal (old); if (!EQ (Vtemp_buffer_show_function, Qnil)) call1 (Vtemp_buffer_show_function, buf); else { window = Fdisplay_buffer (buf, Qnil); #ifdef MULTI_FRAME if (XFRAME (XWINDOW (window)->frame) != selected_frame) Fmake_frame_visible (WINDOW_FRAME (XWINDOW (window))); #endif /* MULTI_FRAME */ Vminibuf_scroll_window = window; w = XWINDOW (window); XSETFASTINT (w->hscroll, 0); set_marker_restricted (w->start, make_number (1), buf); set_marker_restricted (w->pointm, make_number (1), buf); /* Run temp-buffer-show-hook, with the chosen window selected. */ if (!NILP (Vrun_hooks)) { Lisp_Object tem; tem = Fboundp (Qtemp_buffer_show_hook); if (!NILP (tem)) { tem = Fsymbol_value (Qtemp_buffer_show_hook); if (!NILP (tem)) { int count = specpdl_ptr - specpdl; /* Select the window that was chosen, for running the hook. */ record_unwind_protect (Fset_window_configuration, Fcurrent_window_configuration (Qnil)); Fselect_window (window); call1 (Vrun_hooks, Qtemp_buffer_show_hook); unbind_to (count, Qnil); } } } } } static make_dummy_parent (window) Lisp_Object window; { Lisp_Object new; register struct window *o, *p; register struct Lisp_Vector *vec; int i; o = XWINDOW (window); vec = allocate_vectorlike ((EMACS_INT)VECSIZE (struct window)); for (i = 0; i < VECSIZE (struct window); ++i) vec->contents[i] = ((struct Lisp_Vector *)o)->contents[i]; vec->size = VECSIZE (struct window); p = (struct window *)vec; XSETWINDOW (new, p); XSETFASTINT (p->sequence_number, ++sequence_number); /* Put new into window structure in place of window */ replace_window (window, new); o->next = Qnil; o->prev = Qnil; o->vchild = Qnil; o->hchild = Qnil; o->parent = new; p->start = Qnil; p->pointm = Qnil; p->buffer = Qnil; } DEFUN ("split-window", Fsplit_window, Ssplit_window, 0, 3, "", "Split WINDOW, putting SIZE lines in the first of the pair.\n\ WINDOW defaults to selected one and SIZE to half its size.\n\ If optional third arg HOR-FLAG is non-nil, split side by side\n\ and put SIZE columns in the first of the pair.") (window, chsize, horflag) Lisp_Object window, chsize, horflag; { register Lisp_Object new; register struct window *o, *p; register int size; if (NILP (window)) window = selected_window; else CHECK_LIVE_WINDOW (window, 0); o = XWINDOW (window); if (NILP (chsize)) { if (!NILP (horflag)) /* Round odd size up, since this is for the left-hand window, and it will lose a column for the separators. */ size = ((XFASTINT (o->width) + 1) & -2) >> 1; else size = XFASTINT (o->height) >> 1; } else { CHECK_NUMBER (chsize, 1); size = XINT (chsize); } if (MINI_WINDOW_P (o)) error ("Attempt to split minibuffer window"); else if (FRAME_NO_SPLIT_P (XFRAME (WINDOW_FRAME (o)))) error ("Attempt to split unsplittable frame"); check_min_window_sizes (); if (NILP (horflag)) { if (size < window_min_height) error ("Window height %d too small (after splitting)", size); if (size + window_min_height > XFASTINT (o->height)) error ("Window height %d too small (after splitting)", XFASTINT (o->height) - size); if (NILP (o->parent) || NILP (XWINDOW (o->parent)->vchild)) { make_dummy_parent (window); new = o->parent; XWINDOW (new)->vchild = window; } } else { if (size < window_min_width) error ("Window width %d too small (after splitting)", size); if (size + window_min_width > XFASTINT (o->width)) error ("Window width %d too small (after splitting)", XFASTINT (o->width) - size); if (NILP (o->parent) || NILP (XWINDOW (o->parent)->hchild)) { make_dummy_parent (window); new = o->parent; XWINDOW (new)->hchild = window; } } /* Now we know that window's parent is a vertical combination if we are dividing vertically, or a horizontal combination if we are making side-by-side windows */ windows_or_buffers_changed++; FRAME_WINDOW_SIZES_CHANGED (XFRAME (WINDOW_FRAME (o))) = 1; new = make_window (); p = XWINDOW (new); p->frame = o->frame; p->next = o->next; if (!NILP (p->next)) XWINDOW (p->next)->prev = new; p->prev = window; o->next = new; p->parent = o->parent; p->buffer = Qt; Fset_window_buffer (new, o->buffer); /* Apportion the available frame space among the two new windows */ if (!NILP (horflag)) { p->height = o->height; p->top = o->top; XSETFASTINT (p->width, XFASTINT (o->width) - size); XSETFASTINT (o->width, size); XSETFASTINT (p->left, XFASTINT (o->left) + size); } else { p->left = o->left; p->width = o->width; XSETFASTINT (p->height, XFASTINT (o->height) - size); XSETFASTINT (o->height, size); XSETFASTINT (p->top, XFASTINT (o->top) + size); } return new; } DEFUN ("enlarge-window", Fenlarge_window, Senlarge_window, 1, 2, "p", "Make current window ARG lines bigger.\n\ From program, optional second arg non-nil means grow sideways ARG columns.") (n, side) register Lisp_Object n, side; { CHECK_NUMBER (n, 0); change_window_height (XINT (n), !NILP (side)); return Qnil; } DEFUN ("shrink-window", Fshrink_window, Sshrink_window, 1, 2, "p", "Make current window ARG lines smaller.\n\ From program, optional second arg non-nil means shrink sideways ARG columns.") (n, side) register Lisp_Object n, side; { CHECK_NUMBER (n, 0); change_window_height (-XINT (n), !NILP (side)); return Qnil; } int window_height (window) Lisp_Object window; { register struct window *p = XWINDOW (window); return XFASTINT (p->height); } int window_width (window) Lisp_Object window; { register struct window *p = XWINDOW (window); return XFASTINT (p->width); } #define MINSIZE(w) \ (widthflag \ ? window_min_width \ : (MINI_WINDOW_P (XWINDOW (w)) ? 1 : window_min_height)) #define CURBEG(w) \ *(widthflag ? (int *) &(XWINDOW (w)->left) : (int *) &(XWINDOW (w)->top)) #define CURSIZE(w) \ *(widthflag ? (int *) &(XWINDOW (w)->width) : (int *) &(XWINDOW (w)->height)) /* Unlike set_window_height, this function also changes the heights of the siblings so as to keep everything consistent. */ change_window_height (delta, widthflag) register int delta; int widthflag; { register Lisp_Object parent; Lisp_Object window; register struct window *p; int *sizep; int (*sizefun) () = widthflag ? window_width : window_height; register int (*setsizefun) () = (widthflag ? set_window_width : set_window_height); check_min_window_sizes (); window = selected_window; while (1) { p = XWINDOW (window); parent = p->parent; if (NILP (parent)) { if (widthflag) error ("No other window to side of this one"); break; } if (widthflag ? !NILP (XWINDOW (parent)->hchild) : !NILP (XWINDOW (parent)->vchild)) break; window = parent; } sizep = &CURSIZE (window); { register int maxdelta; maxdelta = (!NILP (parent) ? (*sizefun) (parent) - *sizep : !NILP (p->next) ? (*sizefun) (p->next) - MINSIZE (p->next) : !NILP (p->prev) ? (*sizefun) (p->prev) - MINSIZE (p->prev) /* This is a frame with only one window, a minibuffer-only or a minibufferless frame. */ : (delta = 0)); if (delta > maxdelta) /* This case traps trying to make the minibuffer the full frame, or make the only window aside from the minibuffer the full frame. */ delta = maxdelta; } if (*sizep + delta < MINSIZE (window)) { Fdelete_window (window); return; } if (delta == 0) return; if (!NILP (p->next) && (*sizefun) (p->next) - delta >= MINSIZE (p->next)) { (*setsizefun) (p->next, (*sizefun) (p->next) - delta, 0); (*setsizefun) (window, *sizep + delta, 0); CURBEG (p->next) += delta; /* This does not change size of p->next, but it propagates the new top edge to its children */ (*setsizefun) (p->next, (*sizefun) (p->next), 0); } else if (!NILP (p->prev) && (*sizefun) (p->prev) - delta >= MINSIZE (p->prev)) { (*setsizefun) (p->prev, (*sizefun) (p->prev) - delta, 0); CURBEG (window) -= delta; (*setsizefun) (window, *sizep + delta, 0); } else { register int delta1; register int opht = (*sizefun) (parent); /* If trying to grow this window to or beyond size of the parent, make delta1 so big that, on shrinking back down, all the siblings end up with less than one line and are deleted. */ if (opht <= *sizep + delta) delta1 = opht * opht * 2; /* Otherwise, make delta1 just right so that if we add delta1 lines to this window and to the parent, and then shrink the parent back to its original size, the new proportional size of this window will increase by delta. */ else delta1 = (delta * opht * 100) / ((opht - *sizep - delta) * 100); /* Add delta1 lines or columns to this window, and to the parent, keeping things consistent while not affecting siblings. */ CURSIZE (parent) = opht + delta1; (*setsizefun) (window, *sizep + delta1, 0); /* Squeeze out delta1 lines or columns from our parent, shriking this window and siblings proportionately. This brings parent back to correct size. Delta1 was calculated so this makes this window the desired size, taking it all out of the siblings. */ (*setsizefun) (parent, opht, 0); } XSETFASTINT (p->last_modified, 0); } #undef MINSIZE #undef CURBEG #undef CURSIZE /* Return number of lines of text (not counting mode line) in W. */ int window_internal_height (w) struct window *w; { int ht = XFASTINT (w->height); if (MINI_WINDOW_P (w)) return ht; if (!NILP (w->parent) || !NILP (w->vchild) || !NILP (w->hchild) || !NILP (w->next) || !NILP (w->prev) || FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME (w)))) return ht - 1; return ht; } /* Return the number of columns in W. Don't count columns occupied by scroll bars or the vertical bar separating W from the sibling to its right. */ int window_internal_width (w) struct window *w; { FRAME_PTR f = XFRAME (WINDOW_FRAME (w)); int left = XINT (w->left); int width = XINT (w->width); /* If this window is flush against the right edge of the frame, its internal width is its full width. */ if (left + width >= FRAME_WIDTH (f)) return width; /* If we are not flush right, then our rightmost columns are occupied by some sort of separator. */ /* Scroll bars occupy a few columns. */ if (FRAME_HAS_VERTICAL_SCROLL_BARS (f)) return width - FRAME_SCROLL_BAR_COLS (f); /* The column of `|' characters separating side-by-side windows occupies one column only. */ return width - 1; } /* Scroll contents of window WINDOW up N lines. */ void window_scroll (window, n, noerror) Lisp_Object window; int n; int noerror; { register struct window *w = XWINDOW (window); register int opoint = PT; register int pos; register int ht = window_internal_height (w); register Lisp_Object tem; int lose; Lisp_Object bolp, nmoved; /* Always set force_start so that redisplay_window will run thw window-scroll-functions. */ w->force_start = Qt; XSETFASTINT (tem, PT); tem = Fpos_visible_in_window_p (tem, window); if (NILP (tem)) { Fvertical_motion (make_number (- (ht / 2)), window); XSETFASTINT (tem, PT); Fset_marker (w->start, tem, w->buffer); } SET_PT (marker_position (w->start)); lose = n < 0 && PT == BEGV; Fvertical_motion (make_number (n), window); pos = PT; bolp = Fbolp (); SET_PT (opoint); if (lose) { if (noerror) return; else Fsignal (Qbeginning_of_buffer, Qnil); } if (pos < ZV) { set_marker_restricted (w->start, make_number (pos), w->buffer); w->start_at_line_beg = bolp; w->update_mode_line = Qt; XSETFASTINT (w->last_modified, 0); if (pos > opoint) SET_PT (pos); if (n < 0) { SET_PT (pos); tem = Fvertical_motion (make_number (ht), window); if (PT > opoint || XFASTINT (tem) < ht) SET_PT (opoint); else Fvertical_motion (make_number (-1), window); } } else { if (noerror) return; else Fsignal (Qend_of_buffer, Qnil); } } /* This is the guts of Fscroll_up and Fscroll_down. */ static void scroll_command (n, direction) register Lisp_Object n; int direction; { register int defalt; int count = specpdl_ptr - specpdl; /* If selected window's buffer isn't current, make it current for the moment. But don't screw up if window_scroll gets an error. */ if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer) { record_unwind_protect (save_excursion_restore, save_excursion_save ()); Fset_buffer (XWINDOW (selected_window)->buffer); } defalt = (window_internal_height (XWINDOW (selected_window)) - next_screen_context_lines); defalt = direction * (defalt < 1 ? 1 : defalt); if (NILP (n)) window_scroll (selected_window, defalt, 0); else if (EQ (n, Qminus)) window_scroll (selected_window, - defalt, 0); else { n = Fprefix_numeric_value (n); window_scroll (selected_window, XINT (n) * direction, 0); } unbind_to (count, Qnil); } DEFUN ("scroll-up", Fscroll_up, Sscroll_up, 0, 1, "P", "Scroll text of current window upward ARG lines; or near full screen if no ARG.\n\ A near full screen is `next-screen-context-lines' less than a full screen.\n\ Negative ARG means scroll downward.\n\ When calling from a program, supply a number as argument or nil.") (n) Lisp_Object n; { scroll_command (n, 1); return Qnil; } DEFUN ("scroll-down", Fscroll_down, Sscroll_down, 0, 1, "P", "Scroll text of current window downward ARG lines; or near full screen if no ARG.\n\ A near full screen is `next-screen-context-lines' less than a full screen.\n\ Negative ARG means scroll upward.\n\ When calling from a program, supply a number as argument or nil.") (n) Lisp_Object n; { scroll_command (n, -1); return Qnil; } DEFUN ("other-window-for-scrolling", Fother_window_for_scrolling, Sother_window_for_scrolling, 0, 0, 0, "Return the other window for \"other window scroll\" commands.\n\ If in the minibuffer, `minibuffer-scroll-window' if non-nil\n\ specifies the window.\n\ If `other-window-scroll-buffer' is non-nil, a window\n\ showing that buffer is used.") () { Lisp_Object window; if (MINI_WINDOW_P (XWINDOW (selected_window)) && !NILP (Vminibuf_scroll_window)) window = Vminibuf_scroll_window; /* If buffer is specified, scroll that buffer. */ else if (!NILP (Vother_window_scroll_buffer)) { window = Fget_buffer_window (Vother_window_scroll_buffer, Qnil); if (NILP (window)) window = Fdisplay_buffer (Vother_window_scroll_buffer, Qt); } else { /* Nothing specified; look for a neighboring window on the same frame. */ window = Fnext_window (selected_window, Qnil, Qnil); if (EQ (window, selected_window)) /* That didn't get us anywhere; look for a window on another visible frame. */ do window = Fnext_window (window, Qnil, Qt); while (! FRAME_VISIBLE_P (XFRAME (WINDOW_FRAME (XWINDOW (window)))) && ! EQ (window, selected_window)); } CHECK_LIVE_WINDOW (window, 0); if (EQ (window, selected_window)) error ("There is no other window"); return window; } DEFUN ("scroll-other-window", Fscroll_other_window, Sscroll_other_window, 0, 1, "P", "Scroll next window upward ARG lines; or near full screen if no ARG.\n\ The next window is the one below the current one; or the one at the top\n\ if the current one is at the bottom. Negative ARG means scroll downward.\n\ When calling from a program, supply a number as argument or nil.\n\ \n\ If in the minibuffer, `minibuffer-scroll-window' if non-nil\n\ specifies the window to scroll.\n\ If `other-window-scroll-buffer' is non-nil, scroll the window\n\ showing that buffer, popping the buffer up if necessary.") (n) register Lisp_Object n; { register Lisp_Object window; register int defalt; register struct window *w; register int count = specpdl_ptr - specpdl; window = Fother_window_for_scrolling (); w = XWINDOW (window); defalt = window_internal_height (w) - next_screen_context_lines; if (defalt < 1) defalt = 1; /* Don't screw up if window_scroll gets an error. */ record_unwind_protect (save_excursion_restore, save_excursion_save ()); Fset_buffer (w->buffer); SET_PT (marker_position (w->pointm)); if (NILP (n)) window_scroll (window, defalt, 1); else if (EQ (n, Qminus)) window_scroll (window, -defalt, 1); else { if (CONSP (n)) n = Fcar (n); CHECK_NUMBER (n, 0); window_scroll (window, XINT (n), 1); } Fset_marker (w->pointm, make_number (PT), Qnil); unbind_to (count, Qnil); return Qnil; } DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 1, "P", "Scroll selected window display ARG columns left.\n\ Default for ARG is window width minus 2.") (arg) register Lisp_Object arg; { if (NILP (arg)) XSETFASTINT (arg, window_internal_width (XWINDOW (selected_window)) - 2); else arg = Fprefix_numeric_value (arg); return Fset_window_hscroll (selected_window, make_number (XINT (XWINDOW (selected_window)->hscroll) + XINT (arg))); } DEFUN ("scroll-right", Fscroll_right, Sscroll_right, 0, 1, "P", "Scroll selected window display ARG columns right.\n\ Default for ARG is window width minus 2.") (arg) register Lisp_Object arg; { if (NILP (arg)) XSETFASTINT (arg, window_internal_width (XWINDOW (selected_window)) - 2); else arg = Fprefix_numeric_value (arg); return Fset_window_hscroll (selected_window, make_number (XINT (XWINDOW (selected_window)->hscroll) - XINT (arg))); } DEFUN ("recenter", Frecenter, Srecenter, 0, 1, "P", "Center point in window and redisplay frame. With ARG, put point on line ARG.\n\ The desired position of point is always relative to the current window.\n\ Just C-u as prefix means put point in the center of the window.\n\ No arg (i.e., it is nil) erases the entire frame and then\n\ redraws with point in the center of the current window.") (n) register Lisp_Object n; { register struct window *w = XWINDOW (selected_window); register int ht = window_internal_height (w); struct position pos; if (NILP (n)) { extern int frame_garbaged; SET_FRAME_GARBAGED (XFRAME (WINDOW_FRAME (w))); XSETFASTINT (n, ht / 2); } else if (CONSP (n)) /* Just C-u. */ { XSETFASTINT (n, ht / 2); } else { n = Fprefix_numeric_value (n); CHECK_NUMBER (n, 0); } if (XINT (n) < 0) XSETINT (n, XINT (n) + ht); pos = *vmotion (point, - XINT (n), w); Fset_marker (w->start, make_number (pos.bufpos), w->buffer); w->start_at_line_beg = ((pos.bufpos == BEGV || FETCH_CHAR (pos.bufpos - 1) == '\n') ? Qt : Qnil); w->force_start = Qt; return Qnil; } DEFUN ("move-to-window-line", Fmove_to_window_line, Smove_to_window_line, 1, 1, "P", "Position point relative to window.\n\ With no argument, position point at center of window.\n\ An argument specifies frame line; zero means top of window,\n\ negative means relative to bottom of window.") (arg) register Lisp_Object arg; { register struct window *w = XWINDOW (selected_window); register int height = window_internal_height (w); register int start; Lisp_Object window; if (NILP (arg)) XSETFASTINT (arg, height / 2); else { arg = Fprefix_numeric_value (arg); if (XINT (arg) < 0) XSETINT (arg, XINT (arg) + height); } start = marker_position (w->start); XSETWINDOW (window, w); if (start < BEGV || start > ZV) { Fvertical_motion (make_number (- (height / 2)), window); Fset_marker (w->start, make_number (PT), w->buffer); w->start_at_line_beg = Fbolp (); w->force_start = Qt; } else SET_PT (start); return Fvertical_motion (arg, window); } struct save_window_data { int size_from_Lisp_Vector_struct; struct Lisp_Vector *next_from_Lisp_Vector_struct; Lisp_Object frame_width, frame_height, frame_menu_bar_lines; Lisp_Object selected_frame; Lisp_Object current_window; Lisp_Object current_buffer; Lisp_Object minibuf_scroll_window; Lisp_Object root_window; Lisp_Object focus_frame; /* Record the values of window-min-width and window-min-height so that window sizes remain consistent with them. */ Lisp_Object min_width, min_height; /* A vector, interpreted as a struct saved_window */ Lisp_Object saved_windows; }; /* This is saved as a Lisp_Vector */ struct saved_window { /* these first two must agree with struct Lisp_Vector in lisp.h */ int size_from_Lisp_Vector_struct; struct Lisp_Vector *next_from_Lisp_Vector_struct; Lisp_Object window; Lisp_Object buffer, start, pointm, mark; Lisp_Object left, top, width, height, hscroll; Lisp_Object parent, prev; Lisp_Object start_at_line_beg; Lisp_Object display_table; }; #define SAVED_WINDOW_VECTOR_SIZE 14 /* Arg to Fmake_vector */ #define SAVED_WINDOW_N(swv,n) \ ((struct saved_window *) (XVECTOR ((swv)->contents[(n)]))) DEFUN ("window-configuration-p", Fwindow_configuration_p, Swindow_configuration_p, 1, 1, 0, "T if OBJECT is a window-configration object.") (obj) Lisp_Object obj; { if (WINDOW_CONFIGURATIONP (obj)) return Qt; return Qnil; } DEFUN ("set-window-configuration", Fset_window_configuration, Sset_window_configuration, 1, 1, 0, "Set the configuration of windows and buffers as specified by CONFIGURATION.\n\ CONFIGURATION must be a value previously returned\n\ by `current-window-configuration' (which see).") (configuration) Lisp_Object configuration; { register struct save_window_data *data; struct Lisp_Vector *saved_windows; Lisp_Object new_current_buffer; Lisp_Object frame; FRAME_PTR f; while (!WINDOW_CONFIGURATIONP (configuration)) { configuration = wrong_type_argument (intern ("window-configuration-p"), configuration); } data = (struct save_window_data *) XVECTOR (configuration); saved_windows = XVECTOR (data->saved_windows); new_current_buffer = data->current_buffer; if (NILP (XBUFFER (new_current_buffer)->name)) new_current_buffer = Qnil; frame = XWINDOW (SAVED_WINDOW_N (saved_windows, 0)->window)->frame; f = XFRAME (frame); /* If f is a dead frame, don't bother rebuilding its window tree. However, there is other stuff we should still try to do below. */ if (FRAME_LIVE_P (f)) { register struct window *w; register struct saved_window *p; int k; /* If the frame has been resized since this window configuration was made, we change the frame to the size specified in the configuration, restore the configuration, and then resize it back. We keep track of the prevailing height in these variables. */ int previous_frame_height = FRAME_HEIGHT (f); int previous_frame_width = FRAME_WIDTH (f); int previous_frame_menu_bar_lines = FRAME_MENU_BAR_LINES (f); if (XFASTINT (data->frame_height) != previous_frame_height || XFASTINT (data->frame_width) != previous_frame_width) change_frame_size (f, data->frame_height, data->frame_width, 0, 0); #ifdef HAVE_WINDOW_SYSTEM if (XFASTINT (data->frame_menu_bar_lines) != previous_frame_menu_bar_lines) x_set_menu_bar_lines (f, data->frame_menu_bar_lines, 0); #endif windows_or_buffers_changed++; FRAME_WINDOW_SIZES_CHANGED (f) = 1; /* Temporarily avoid any problems with windows that are smaller than they are supposed to be. */ window_min_height = 1; window_min_width = 1; /* Kludge Alert! Mark all windows now on frame as "deleted". Restoring the new configuration "undeletes" any that are in it. Save their current buffers in their height fields, since we may need it later, if a buffer saved in the configuration is now dead. */ delete_all_subwindows (XWINDOW (FRAME_ROOT_WINDOW (f))); for (k = 0; k < saved_windows->size; k++) { p = SAVED_WINDOW_N (saved_windows, k); w = XWINDOW (p->window); w->next = Qnil; if (!NILP (p->parent)) w->parent = SAVED_WINDOW_N (saved_windows, XFASTINT (p->parent))->window; else w->parent = Qnil; if (!NILP (p->prev)) { w->prev = SAVED_WINDOW_N (saved_windows, XFASTINT (p->prev))->window; XWINDOW (w->prev)->next = p->window; } else { w->prev = Qnil; if (!NILP (w->parent)) { if (EQ (p->width, XWINDOW (w->parent)->width)) { XWINDOW (w->parent)->vchild = p->window; XWINDOW (w->parent)->hchild = Qnil; } else { XWINDOW (w->parent)->hchild = p->window; XWINDOW (w->parent)->vchild = Qnil; } } } /* If we squirreled away the buffer in the window's height, restore it now. */ if (BUFFERP (w->height)) w->buffer = w->height; w->left = p->left; w->top = p->top; w->width = p->width; w->height = p->height; w->hscroll = p->hscroll; w->display_table = p->display_table; XSETFASTINT (w->last_modified, 0); /* Reinstall the saved buffer and pointers into it. */ if (NILP (p->buffer)) w->buffer = p->buffer; else { if (!NILP (XBUFFER (p->buffer)->name)) /* If saved buffer is alive, install it. */ { w->buffer = p->buffer; w->start_at_line_beg = p->start_at_line_beg; set_marker_restricted (w->start, Fmarker_position (p->start), w->buffer); set_marker_restricted (w->pointm, Fmarker_position (p->pointm), w->buffer); Fset_marker (XBUFFER (w->buffer)->mark, Fmarker_position (p->mark), w->buffer); /* As documented in Fcurrent_window_configuration, don't save the location of point in the buffer which was current when the window configuration was recorded. */ if (!EQ (p->buffer, new_current_buffer) && XBUFFER (p->buffer) == current_buffer) Fgoto_char (w->pointm); } else if (NILP (w->buffer) || NILP (XBUFFER (w->buffer)->name)) /* Else unless window has a live buffer, get one. */ { w->buffer = Fcdr (Fcar (Vbuffer_alist)); /* This will set the markers to beginning of visible range. */ set_marker_restricted (w->start, make_number (0), w->buffer); set_marker_restricted (w->pointm, make_number (0),w->buffer); w->start_at_line_beg = Qt; } else /* Keeping window's old buffer; make sure the markers are real. */ { /* Set window markers at start of visible range. */ if (XMARKER (w->start)->buffer == 0) set_marker_restricted (w->start, make_number (0), w->buffer); if (XMARKER (w->pointm)->buffer == 0) set_marker_restricted (w->pointm, (make_number (BUF_PT (XBUFFER (w->buffer)))), w->buffer); w->start_at_line_beg = Qt; } } } FRAME_ROOT_WINDOW (f) = data->root_window; Fselect_window (data->current_window); #ifdef MULTI_FRAME if (NILP (data->focus_frame) || (FRAMEP (data->focus_frame) && FRAME_LIVE_P (XFRAME (data->focus_frame)))) Fredirect_frame_focus (frame, data->focus_frame); #endif #if 0 /* I don't understand why this is needed, and it causes problems when the frame's old selected window has been deleted. */ #ifdef MULTI_FRAME if (f != selected_frame && ! FRAME_TERMCAP_P (f)) do_switch_frame (WINDOW_FRAME (XWINDOW (data->root_window)), Qnil, 0); #endif #endif /* Set the screen height to the value it had before this function. */ if (previous_frame_height != FRAME_HEIGHT (f) || previous_frame_width != FRAME_WIDTH (f)) change_frame_size (f, previous_frame_height, previous_frame_width, 0, 0); #ifdef HAVE_WINDOW_SYSTEM if (previous_frame_menu_bar_lines != FRAME_MENU_BAR_LINES (f)) x_set_menu_bar_lines (f, previous_frame_menu_bar_lines, 0); #endif } /* Restore the minimum heights recorded in the configuration. */ window_min_height = XINT (data->min_height); window_min_width = XINT (data->min_width); #ifdef MULTI_FRAME /* Fselect_window will have made f the selected frame, so we reselect the proper frame here. Fhandle_switch_frame will change the selected window too, but that doesn't make the call to Fselect_window above totally superfluous; it still sets f's selected window. */ if (FRAME_LIVE_P (XFRAME (data->selected_frame))) do_switch_frame (data->selected_frame, Qnil, 0); #endif if (!NILP (new_current_buffer)) Fset_buffer (new_current_buffer); Vminibuf_scroll_window = data->minibuf_scroll_window; return (Qnil); } /* Mark all windows now on frame as deleted by setting their buffers to nil. */ void delete_all_subwindows (w) register struct window *w; { if (!NILP (w->next)) delete_all_subwindows (XWINDOW (w->next)); if (!NILP (w->vchild)) delete_all_subwindows (XWINDOW (w->vchild)); if (!NILP (w->hchild)) delete_all_subwindows (XWINDOW (w->hchild)); w->height = w->buffer; /* See Fset_window_configuration for excuse. */ /* We set all three of these fields to nil, to make sure that we can distinguish this dead window from any live window. Live leaf windows will have buffer set, and combination windows will have vchild or hchild set. */ w->buffer = Qnil; w->vchild = Qnil; w->hchild = Qnil; } static int count_windows (window) register struct window *window; { register int count = 1; if (!NILP (window->next)) count += count_windows (XWINDOW (window->next)); if (!NILP (window->vchild)) count += count_windows (XWINDOW (window->vchild)); if (!NILP (window->hchild)) count += count_windows (XWINDOW (window->hchild)); return count; } static int save_window_save (window, vector, i) Lisp_Object window; struct Lisp_Vector *vector; int i; { register struct saved_window *p; register struct window *w; register Lisp_Object tem; for (;!NILP (window); window = w->next) { p = SAVED_WINDOW_N (vector, i); w = XWINDOW (window); XSETFASTINT (w->temslot, i++); p->window = window; p->buffer = w->buffer; p->left = w->left; p->top = w->top; p->width = w->width; p->height = w->height; p->hscroll = w->hscroll; p->display_table = w->display_table; if (!NILP (w->buffer)) { /* Save w's value of point in the window configuration. If w is the selected window, then get the value of point from the buffer; pointm is garbage in the selected window. */ if (EQ (window, selected_window)) { p->pointm = Fmake_marker (); Fset_marker (p->pointm, BUF_PT (XBUFFER (w->buffer)), w->buffer); } else p->pointm = Fcopy_marker (w->pointm, Qnil); p->start = Fcopy_marker (w->start, Qnil); p->start_at_line_beg = w->start_at_line_beg; tem = XBUFFER (w->buffer)->mark; p->mark = Fcopy_marker (tem, Qnil); } else { p->pointm = Qnil; p->start = Qnil; p->mark = Qnil; p->start_at_line_beg = Qnil; } if (NILP (w->parent)) p->parent = Qnil; else p->parent = XWINDOW (w->parent)->temslot; if (NILP (w->prev)) p->prev = Qnil; else p->prev = XWINDOW (w->prev)->temslot; if (!NILP (w->vchild)) i = save_window_save (w->vchild, vector, i); if (!NILP (w->hchild)) i = save_window_save (w->hchild, vector, i); } return i; } DEFUN ("current-window-configuration", Fcurrent_window_configuration, Scurrent_window_configuration, 0, 1, 0, "Return an object representing the current window configuration of FRAME.\n\ If FRAME is nil or omitted, use the selected frame.\n\ This describes the number of windows, their sizes and current buffers,\n\ and for each displayed buffer, where display starts, and the positions of\n\ point and mark. An exception is made for point in the current buffer:\n\ its value is -not- saved.\n\ This also records the currently selected frame, and FRAME's focus\n\ redirection (see `redirect-frame-focus').") (frame) Lisp_Object frame; { register Lisp_Object tem; register int n_windows; register struct save_window_data *data; register struct Lisp_Vector *vec; register int i; FRAME_PTR f; if (NILP (frame)) f = selected_frame; else { CHECK_LIVE_FRAME (frame, 0); f = XFRAME (frame); } n_windows = count_windows (XWINDOW (FRAME_ROOT_WINDOW (f))); vec = allocate_vectorlike (VECSIZE (struct save_window_data)); for (i = 0; i < VECSIZE (struct save_window_data); i++) vec->contents[i] = Qnil; vec->size = VECSIZE (struct save_window_data); data = (struct save_window_data *)vec; XSETFASTINT (data->frame_width, FRAME_WIDTH (f)); XSETFASTINT (data->frame_height, FRAME_HEIGHT (f)); XSETFASTINT (data->frame_menu_bar_lines, FRAME_MENU_BAR_LINES (f)); #ifdef MULTI_FRAME XSETFRAME (data->selected_frame, selected_frame); #endif data->current_window = FRAME_SELECTED_WINDOW (f); XSETBUFFER (data->current_buffer, current_buffer); data->minibuf_scroll_window = Vminibuf_scroll_window; data->root_window = FRAME_ROOT_WINDOW (f); data->focus_frame = FRAME_FOCUS_FRAME (f); XSETINT (data->min_height, window_min_height); XSETINT (data->min_width, window_min_width); tem = Fmake_vector (make_number (n_windows), Qnil); data->saved_windows = tem; for (i = 0; i < n_windows; i++) XVECTOR (tem)->contents[i] = Fmake_vector (make_number (SAVED_WINDOW_VECTOR_SIZE), Qnil); save_window_save (FRAME_ROOT_WINDOW (f), XVECTOR (tem), 0); XSETWINDOW_CONFIGURATION (tem, data); return (tem); } DEFUN ("save-window-excursion", Fsave_window_excursion, Ssave_window_excursion, 0, UNEVALLED, 0, "Execute body, preserving window sizes and contents.\n\ Restore which buffer appears in which window, where display starts,\n\ and the value of point and mark for each window.\n\ Also restore which buffer is current.\n\ But do not preserve point in the current buffer.\n\ Does not restore the value of point in current buffer.") (args) Lisp_Object args; { register Lisp_Object val; register int count = specpdl_ptr - specpdl; record_unwind_protect (Fset_window_configuration, Fcurrent_window_configuration (Qnil)); val = Fprogn (args); return unbind_to (count, val); } init_window_once () { #ifdef MULTI_FRAME selected_frame = make_terminal_frame (); XSETFRAME (Vterminal_frame, selected_frame); minibuf_window = selected_frame->minibuffer_window; selected_window = selected_frame->selected_window; last_nonminibuf_frame = selected_frame; #else /* not MULTI_FRAME */ extern Lisp_Object get_minibuffer (); selected_frame = last_nonminibuf_frame = &the_only_frame; minibuf_window = make_window (); FRAME_ROOT_WINDOW (selected_frame) = make_window (); XWINDOW (FRAME_ROOT_WINDOW (selected_frame))->next = minibuf_window; XWINDOW (minibuf_window)->prev = FRAME_ROOT_WINDOW (selected_frame); XWINDOW (minibuf_window)->mini_p = Qt; /* These values 9 and 10 are arbitrary, just so that there is "something there." Correct values are put in in init_xdisp */ XSETFASTINT (XWINDOW (FRAME_ROOT_WINDOW (selected_frame))->width, 10); XSETFASTINT (XWINDOW (minibuf_window)->width, 10); XSETFASTINT (XWINDOW (FRAME_ROOT_WINDOW (selected_frame))->height, 9); XSETFASTINT (XWINDOW (minibuf_window)->top, 9); XSETFASTINT (XWINDOW (minibuf_window)->height, 1); /* Prevent error in Fset_window_buffer. */ XWINDOW (FRAME_ROOT_WINDOW (selected_frame))->buffer = Qt; XWINDOW (minibuf_window)->buffer = Qt; /* Now set them up for real. */ Fset_window_buffer (FRAME_ROOT_WINDOW (selected_frame), Fcurrent_buffer ()); Fset_window_buffer (minibuf_window, get_minibuffer (0)); selected_window = FRAME_ROOT_WINDOW (selected_frame); /* Make sure this window seems more recently used than a newly-created, never-selected window. Increment window_select_count so the first selection ever will get something newer than this. */ XSETFASTINT (XWINDOW (selected_window)->use_time, ++window_select_count); #endif /* not MULTI_FRAME */ } syms_of_window () { Qwindowp = intern ("windowp"); staticpro (&Qwindowp); Qwindow_live_p = intern ("window-live-p"); staticpro (&Qwindow_live_p); Qtemp_buffer_show_hook = intern ("temp-buffer-show-hook"); staticpro (&Qtemp_buffer_show_hook); #ifndef MULTI_FRAME /* Make sure all windows get marked */ staticpro (&minibuf_window); #endif DEFVAR_LISP ("temp-buffer-show-function", &Vtemp_buffer_show_function, "Non-nil means call as function to display a help buffer.\n\ The function is called with one argument, the buffer to be displayed.\n\ Used by `with-output-to-temp-buffer'.\n\ If this function is used, then it must do the entire job of showing\n\ the buffer; `temp-buffer-show-hook' is not run unless this function runs it."); Vtemp_buffer_show_function = Qnil; DEFVAR_LISP ("display-buffer-function", &Vdisplay_buffer_function, "If non-nil, function to call to handle `display-buffer'.\n\ It will receive two args, the buffer and a flag which if non-nil means\n\ that the currently selected window is not acceptable.\n\ Commands such as `switch-to-buffer-other-window' and `find-file-other-window'\n\ work using this function."); Vdisplay_buffer_function = Qnil; DEFVAR_LISP ("minibuffer-scroll-window", &Vminibuf_scroll_window, "Non-nil means it is the window that C-M-v in minibuffer should scroll."); Vminibuf_scroll_window = Qnil; DEFVAR_LISP ("other-window-scroll-buffer", &Vother_window_scroll_buffer, "If non-nil, this is a buffer and \\[scroll-other-window] should scroll its window."); Vother_window_scroll_buffer = Qnil; DEFVAR_BOOL ("pop-up-frames", &pop_up_frames, "*Non-nil means `display-buffer' should make a separate frame."); pop_up_frames = 0; DEFVAR_LISP ("pop-up-frame-function", &Vpop_up_frame_function, "Function to call to handle automatic new frame creation.\n\ It is called with no arguments and should return a newly created frame.\n\ \n\ A typical value might be `(lambda () (new-frame pop-up-frame-alist))'\n\ where `pop-up-frame-alist' would hold the default frame parameters."); Vpop_up_frame_function = Qnil; DEFVAR_LISP ("special-display-buffer-names", &Vspecial_display_buffer_names, "*List of buffer names that should have their own special frames.\n\ Displaying a buffer whose name is in this list makes a special frame for it\n\ using `special-display-function'.\n\ \n\ An element of the list can be a cons cell instead of just a string.\n\ Then the car should be a buffer name, and the cdr specifies frame\n\ parameters for creating the frame for that buffer.\n\ More precisely, the cdr is passed as the second argument to\n\ the function found in `special-display-function', when making that frame.\n\ See also `special-display-regexps'."); Vspecial_display_buffer_names = Qnil; DEFVAR_LISP ("special-display-regexps", &Vspecial_display_regexps, "*List of regexps saying which buffers should have their own special frames.\n\ If a buffer name matches one of these regexps, it gets its own frame.\n\ Displaying a buffer whose name is in this list makes a special frame for it\n\ using `special-display-function'.\n\ \n\ An element of the list can be a cons cell instead of just a string.\n\ Then the car should be the regexp, and the cdr specifies frame\n\ parameters for creating the frame for buffers that match.\n\ More precisely, the cdr is passed as the second argument to\n\ the function found in `special-display-function', when making that frame.\n\ See also `special-display-buffer-names'."); Vspecial_display_regexps = Qnil; DEFVAR_LISP ("special-display-function", &Vspecial_display_function, "Function to call to make a new frame for a special buffer.\n\ It is called with two arguments, the buffer and optional buffer specific\n\ data, and should return a window displaying that buffer.\n\ The default value makes a separate frame for the buffer,\n\ using `special-display-frame-alist' to specify the frame parameters.\n\ \n\ A buffer is special if its is listed in `special-display-buffer-names'\n\ or matches a regexp in `special-display-regexps'."); Vspecial_display_function = Qnil; DEFVAR_LISP ("same-window-buffer-names", &Vsame_window_buffer_names, "*List of buffer names that should appear in the selected window.\n\ Displaying one of these buffers using `display-buffer' or `pop-to-buffer'\n\ switches to it in the selected window, rather than making it appear\n\ in some other window.\n\ \n\ An element of the list can be a cons cell instead of just a string.\n\ Then the car must be a string, which specifies the buffer name.\n\ This is for compatibility with `special-display-buffer-names';\n\ the cdr of the cons cell is ignored.\n\ \n\ See also `same-window-regexps'."); Vsame_window_buffer_names = Qnil; DEFVAR_LISP ("same-window-regexps", &Vsame_window_regexps, "*List of regexps saying which buffers should appear in the selected window.\n\ If a buffer name matches one of these regexps, then displaying it\n\ using `display-buffer' or `pop-to-buffer' switches to it\n\ in the selected window, rather than making it appear in some other window.\n\ \n\ An element of the list can be a cons cell instead of just a string.\n\ Then the car must be a string, which specifies the buffer name.\n\ This is for compatibility with `special-display-buffer-names';\n\ the cdr of the cons cell is ignored.\n\ \n\ See also `same-window-buffer-names'."); Vsame_window_regexps = Qnil; DEFVAR_BOOL ("pop-up-windows", &pop_up_windows, "*Non-nil means display-buffer should make new windows."); pop_up_windows = 1; DEFVAR_INT ("next-screen-context-lines", &next_screen_context_lines, "*Number of lines of continuity when scrolling by screenfuls."); next_screen_context_lines = 2; DEFVAR_INT ("split-height-threshold", &split_height_threshold, "*display-buffer would prefer to split the largest window if this large.\n\ If there is only one window, it is split regardless of this value."); split_height_threshold = 500; DEFVAR_INT ("window-min-height", &window_min_height, "*Delete any window less than this tall (including its mode line)."); window_min_height = 4; DEFVAR_INT ("window-min-width", &window_min_width, "*Delete any window less than this wide."); window_min_width = 10; defsubr (&Sselected_window); defsubr (&Sminibuffer_window); defsubr (&Swindow_minibuffer_p); defsubr (&Swindowp); defsubr (&Swindow_live_p); defsubr (&Spos_visible_in_window_p); defsubr (&Swindow_buffer); defsubr (&Swindow_height); defsubr (&Swindow_width); defsubr (&Swindow_hscroll); defsubr (&Sset_window_hscroll); defsubr (&Swindow_redisplay_end_trigger); defsubr (&Sset_window_redisplay_end_trigger); defsubr (&Swindow_edges); defsubr (&Scoordinates_in_window_p); defsubr (&Swindow_at); defsubr (&Swindow_point); defsubr (&Swindow_start); defsubr (&Swindow_end); defsubr (&Sset_window_point); defsubr (&Sset_window_start); defsubr (&Swindow_dedicated_p); defsubr (&Sset_window_dedicated_p); defsubr (&Swindow_display_table); defsubr (&Sset_window_display_table); defsubr (&Snext_window); defsubr (&Sprevious_window); defsubr (&Sother_window); defsubr (&Sget_lru_window); defsubr (&Sget_largest_window); defsubr (&Sget_buffer_window); defsubr (&Sdelete_other_windows); defsubr (&Sdelete_windows_on); defsubr (&Sreplace_buffer_in_windows); defsubr (&Sdelete_window); defsubr (&Sset_window_buffer); defsubr (&Sselect_window); defsubr (&Sdisplay_buffer); defsubr (&Ssplit_window); defsubr (&Senlarge_window); defsubr (&Sshrink_window); defsubr (&Sscroll_up); defsubr (&Sscroll_down); defsubr (&Sscroll_left); defsubr (&Sscroll_right); defsubr (&Sother_window_for_scrolling); defsubr (&Sscroll_other_window); defsubr (&Srecenter); defsubr (&Smove_to_window_line); defsubr (&Swindow_configuration_p); defsubr (&Sset_window_configuration); defsubr (&Scurrent_window_configuration); defsubr (&Ssave_window_excursion); } keys_of_window () { initial_define_key (control_x_map, '1', "delete-other-windows"); initial_define_key (control_x_map, '2', "split-window"); initial_define_key (control_x_map, '0', "delete-window"); initial_define_key (control_x_map, 'o', "other-window"); initial_define_key (control_x_map, '^', "enlarge-window"); initial_define_key (control_x_map, '<', "scroll-left"); initial_define_key (control_x_map, '>', "scroll-right"); initial_define_key (global_map, Ctl ('V'), "scroll-up"); initial_define_key (meta_map, Ctl ('V'), "scroll-other-window"); initial_define_key (meta_map, 'v', "scroll-down"); initial_define_key (global_map, Ctl('L'), "recenter"); initial_define_key (meta_map, 'r', "move-to-window-line"); } emacs-19.30/src/xdisp.c100444 12120 1 376667 6052153210 13245 0ustar rmsdaemon/* Display generation from window structure and buffer text. Copyright (C) 1985, 86, 87, 88, 93, 94, 95 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. */ #include #include /*#include */ #undef NULL #include "lisp.h" #include "frame.h" #include "window.h" #include "termchar.h" #include "dispextern.h" #include "buffer.h" #include "indent.h" #include "commands.h" #include "macros.h" #include "disptab.h" #include "termhooks.h" #include "intervals.h" #include "keyboard.h" #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) extern void set_frame_menubar (); #endif extern int interrupt_input; extern int command_loop_level; extern Lisp_Object Qface; extern Lisp_Object Voverriding_local_map; extern Lisp_Object Voverriding_local_map_menu_flag; Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map; Lisp_Object Qwindow_scroll_functions, Vwindow_scroll_functions; Lisp_Object Qredisplay_end_trigger_functions; /* Nonzero means print newline to stdout before next minibuffer message. */ int noninteractive_need_newline; /* Nonzero means print newline to message log before next message. */ static int message_log_need_newline; #define min(a, b) ((a) < (b) ? (a) : (b)) #define max(a, b) ((a) > (b) ? (a) : (b)) #define minmax(floor, val, ceil) \ ((val) < (floor) ? (floor) : (val) > (ceil) ? (ceil) : (val)) /* The buffer position of the first character appearing entirely or partially on the current frame line. Or zero, which disables the optimization for the current frame line. */ static int this_line_bufpos; /* Number of characters past the end of this line, including the terminating newline */ static int this_line_endpos; /* The vertical position of this frame line. */ static int this_line_vpos; /* Hpos value for start of display on this frame line. Usually zero, but negative if first character really began on previous line */ static int this_line_start_hpos; /* Buffer that this_line variables are describing. */ static struct buffer *this_line_buffer; /* Value of echo_area_glyphs when it was last acted on. If this is nonzero, there is a message on the frame in the minibuffer and it should be erased as soon as it is no longer requested to appear. */ char *previous_echo_glyphs; /* Nonzero means truncate lines in all windows less wide than the frame */ int truncate_partial_width_windows; /* Nonzero means we have more than one non-minibuffer-only frame. Not guaranteed to be accurate except while parsing frame-title-format. */ int multiple_frames; Lisp_Object Vglobal_mode_string; /* Marker for where to display an arrow on top of the buffer text. */ Lisp_Object Voverlay_arrow_position; /* String to display for the arrow. */ Lisp_Object Voverlay_arrow_string; /* Like mode-line-format, but for the titlebar on a visible frame. */ Lisp_Object Vframe_title_format; /* Like mode-line-format, but for the titlebar on an iconified frame. */ Lisp_Object Vicon_title_format; /* List of functions to call when a window's size changes. These functions get one arg, a frame on which one or more windows' sizes have changed. */ static Lisp_Object Vwindow_size_change_functions; /* Values of those variables at last redisplay. */ static Lisp_Object last_arrow_position, last_arrow_string; Lisp_Object Qmenu_bar_update_hook; /* Nonzero if overlay arrow has been displayed once in this window. */ static int overlay_arrow_seen; /* Nonzero if visible end of buffer has already been displayed once in this window. (We need this variable in case there are overlay strings that get displayed there.) */ static int zv_strings_seen; /* Nonzero means highlight the region even in nonselected windows. */ static int highlight_nonselected_windows; /* If cursor motion alone moves point off frame, Try scrolling this many lines up or down if that will bring it back. */ static int scroll_step; /* Nonzero if try_window_id has made blank lines at window bottom since the last redisplay that paused */ static int blank_end_of_window; /* Number of windows showing the buffer of the selected window (or another buffer with the same base buffer). keyboard.c refers to this. */ int buffer_shared; /* display_text_line sets these to the frame position (origin 0) of point, whether the window is selected or not. Set one to -1 first to determine whether point was found afterwards. */ static int cursor_vpos; static int cursor_hpos; static int debug_end_pos; /* Nonzero means display mode line highlighted */ int mode_line_inverse_video; static int message_log_check_duplicate (); static void echo_area_display (); void mark_window_display_accurate (); static void redisplay_windows (); static void redisplay_window (); static void update_menu_bar (); static void try_window (); static int try_window_id (); static struct position *display_text_line (); static void display_mode_line (); static int display_mode_element (); static char *decode_mode_spec (); static int display_string (); static void display_menu_bar (); static int display_count_lines (); /* Prompt to display in front of the minibuffer contents */ Lisp_Object minibuf_prompt; /* Width in columns of current minibuffer prompt. */ int minibuf_prompt_width; /* Message to display instead of minibuffer contents This is what the functions error and message make, and command echoing uses it as well. It overrides the minibuf_prompt as well as the buffer. */ char *echo_area_glyphs; /* This is the length of the message in echo_area_glyphs. */ int echo_area_glyphs_length; /* This is the window where the echo area message was displayed. It is always a minibuffer window, but it may not be the same window currently active as a minibuffer. */ Lisp_Object echo_area_window; /* true iff we should redraw the mode lines on the next redisplay */ int update_mode_lines; /* Smallest number of characters before the gap at any time since last redisplay that finished. Valid for current buffer when try_window_id can be called. */ int beg_unchanged; /* Smallest number of characters after the gap at any time since last redisplay that finished. Valid for current buffer when try_window_id can be called. */ int end_unchanged; /* MODIFF as of last redisplay that finished; if it matches MODIFF, beg_unchanged and end_unchanged contain no useful information */ int unchanged_modified; /* Nonzero if window sizes or contents have changed since last redisplay that finished */ int windows_or_buffers_changed; /* Nonzero after display_mode_line if %l was used and it displayed a line number. */ int line_number_displayed; /* Maximum buffer size for which to display line numbers. */ static int line_number_display_limit; /* Number of lines to keep in the message log buffer. t means infinite. nil means don't log at all. */ Lisp_Object Vmessage_log_max; void message_log_maybe_newline () { if (message_log_need_newline) message_dolog ("", 0, 1); } /* Add a string to the message log, optionally terminated with a newline. This function calls low-level routines in order to bypass text property hooks, etc. which might not be safe to run. */ void message_dolog (m, len, nlflag) char *m; int len, nlflag; { if (!NILP (Vmessage_log_max)) { struct buffer *oldbuf; int oldpoint, oldbegv, oldzv; oldbuf = current_buffer; Fset_buffer (Fget_buffer_create (build_string ("*Messages*"))); current_buffer->undo_list = Qt; oldpoint = PT; oldbegv = BEGV; oldzv = ZV; BEGV = BEG; ZV = Z; if (oldpoint == Z) oldpoint += len + nlflag; if (oldzv == Z) oldzv += len + nlflag; TEMP_SET_PT (Z); if (len) insert_1 (m, len, 1, 0); if (nlflag) { int this_bol, prev_bol, dup; insert_1 ("\n", 1, 1, 0); this_bol = scan_buffer ('\n', Z, 0, -2, 0, 0); if (this_bol > BEG) { prev_bol = scan_buffer ('\n', this_bol, 0, -2, 0, 0); dup = message_log_check_duplicate (prev_bol, this_bol); if (dup) { if (oldpoint > prev_bol) oldpoint -= min (this_bol, oldpoint) - prev_bol; if (oldbegv > prev_bol) oldbegv -= min (this_bol, oldbegv) - prev_bol; if (oldzv > prev_bol) oldzv -= min (this_bol, oldzv) - prev_bol; del_range_1 (prev_bol, this_bol, 0); if (dup > 1) { char dupstr[40]; int duplen; /* If you change this format, don't forget to also change message_log_check_duplicate. */ sprintf (dupstr, " [%d times]", dup); duplen = strlen (dupstr); TEMP_SET_PT (Z-1); if (oldpoint == Z) oldpoint += duplen; if (oldzv == Z) oldzv += duplen; insert_1 (dupstr, duplen, 1, 0); } } } if (NATNUMP (Vmessage_log_max)) { int pos = scan_buffer ('\n', Z, 0, -XFASTINT (Vmessage_log_max) - 1, 0, 0); oldpoint -= min (pos, oldpoint) - BEG; oldbegv -= min (pos, oldbegv) - BEG; oldzv -= min (pos, oldzv) - BEG; del_range_1 (BEG, pos, 0); } } BEGV = oldbegv; ZV = oldzv; TEMP_SET_PT (oldpoint); set_buffer_internal (oldbuf); message_log_need_newline = !nlflag; } } /* We are at the end of the buffer after just having inserted a newline. (Note: We depend on the fact we won't be crossing the gap.) Check to see if the most recent message looks a lot like the previous one. Return 0 if different, 1 if the new one should just replace it, or a value N > 1 if we should also append " [N times]". */ static int message_log_check_duplicate (prev_bol, this_bol) int prev_bol, this_bol; { int i; int len = Z - 1 - this_bol; int seen_dots = 0; unsigned char *p1 = BUF_CHAR_ADDRESS (current_buffer, prev_bol); unsigned char *p2 = BUF_CHAR_ADDRESS (current_buffer, this_bol); for (i = 0; i < len; i++) { if (i >= 3 && p1[i-3] == '.' && p1[i-2] == '.' && p1[i-1] == '.' && p1[i] != '\n') seen_dots = 1; if (p1[i] != p2[i]) return seen_dots; } p1 += len; if (*p1 == '\n') return 2; if (*p1++ == ' ' && *p1++ == '[') { int n = 0; while (*p1 >= '0' && *p1 <= '9') n = n * 10 + *p1++ - '0'; if (strncmp (p1, " times]\n", 8) == 0) return n+1; } return 0; } /* Display an echo area message M with a specified length of LEN chars. The string may include null characters. If m is 0, clear out any existing message, and let the minibuffer text show through. Do not pass text that is stored in a Lisp string. */ void message2 (m, len) char *m; int len; { /* First flush out any partial line written with print. */ message_log_maybe_newline (); if (m) message_dolog (m, len, 1); message2_nolog (m, len); } /* The non-logging part of that function. */ void message2_nolog (m, len) char *m; int len; { if (noninteractive) { if (noninteractive_need_newline) putc ('\n', stderr); noninteractive_need_newline = 0; fwrite (m, len, 1, stderr); if (cursor_in_echo_area == 0) fprintf (stderr, "\n"); fflush (stderr); } /* A null message buffer means that the frame hasn't really been initialized yet. Error messages get reported properly by cmd_error, so this must be just an informative message; toss it. */ else if (INTERACTIVE && FRAME_MESSAGE_BUF (selected_frame)) { Lisp_Object mini_window; FRAME_PTR f; /* Get the frame containing the minibuffer that the selected frame is using. */ mini_window = FRAME_MINIBUF_WINDOW (selected_frame); f = XFRAME (WINDOW_FRAME (XWINDOW (mini_window))); #ifdef MULTI_FRAME FRAME_SAMPLE_VISIBILITY (f); if (FRAME_VISIBLE_P (selected_frame) && ! FRAME_VISIBLE_P (f)) Fmake_frame_visible (WINDOW_FRAME (XWINDOW (mini_window))); #endif if (m) { echo_area_glyphs = m; echo_area_glyphs_length = len; } else echo_area_glyphs = previous_echo_glyphs = 0; do_pending_window_change (); echo_area_display (); update_frame (f, 1, 1); do_pending_window_change (); if (frame_up_to_date_hook != 0 && ! gc_in_progress) (*frame_up_to_date_hook) (f); } } void message1 (m) char *m; { message2 (m, (m ? strlen (m) : 0)); } void message1_nolog (m) char *m; { message2_nolog (m, (m ? strlen (m) : 0)); } /* Truncate what will be displayed in the echo area the next time we display it--but don't redisplay it now. */ void truncate_echo_area (len) int len; { /* A null message buffer means that the frame hasn't really been initialized yet. Error messages get reported properly by cmd_error, so this must be just an informative message; toss it. */ if (!noninteractive && INTERACTIVE && FRAME_MESSAGE_BUF (selected_frame)) echo_area_glyphs_length = len; } /* Nonzero if FRAME_MESSAGE_BUF (selected_frame) is being used by print; zero if being used by message. */ int message_buf_print; /* Dump an informative message to the minibuf. If m is 0, clear out any existing message, and let the minibuffer text show through. */ /* VARARGS 1 */ void message (m, a1, a2, a3) char *m; EMACS_INT a1, a2, a3; { if (noninteractive) { if (m) { if (noninteractive_need_newline) putc ('\n', stderr); noninteractive_need_newline = 0; fprintf (stderr, m, a1, a2, a3); if (cursor_in_echo_area == 0) fprintf (stderr, "\n"); fflush (stderr); } } else if (INTERACTIVE) { /* The frame whose minibuffer we're going to display the message on. It may be larger than the selected frame, so we need to use its buffer, not the selected frame's buffer. */ Lisp_Object mini_window; FRAME_PTR f; /* Get the frame containing the minibuffer that the selected frame is using. */ mini_window = FRAME_MINIBUF_WINDOW (selected_frame); f = XFRAME (WINDOW_FRAME (XWINDOW (mini_window))); /* A null message buffer means that the frame hasn't really been initialized yet. Error messages get reported properly by cmd_error, so this must be just an informative message; toss it. */ if (FRAME_MESSAGE_BUF (f)) { if (m) { int len; #ifdef NO_ARG_ARRAY EMACS_INT a[3]; a[0] = a1; a[1] = a2; a[2] = a3; len = doprnt (FRAME_MESSAGE_BUF (f), FRAME_WIDTH (f), m, (char *)0, 3, a); #else len = doprnt (FRAME_MESSAGE_BUF (f), FRAME_WIDTH (f), m, (char *)0, 3, &a1); #endif /* NO_ARG_ARRAY */ message2 (FRAME_MESSAGE_BUF (f), len); } else message1 (0); /* Print should start at the beginning of the message buffer next time. */ message_buf_print = 0; } } } /* The non-logging version of that function. */ void message_nolog (m, a1, a2, a3) char *m; EMACS_INT a1, a2, a3; { Lisp_Object old_log_max; old_log_max = Vmessage_log_max; Vmessage_log_max = Qnil; message (m, a1, a2, a3); Vmessage_log_max = old_log_max; } void update_echo_area () { message2 (echo_area_glyphs, echo_area_glyphs_length); } static void echo_area_display () { register int vpos; FRAME_PTR f; Lisp_Object mini_window; /* Choose the minibuffer window for this display. It is the minibuffer window used by the selected frame. */ mini_window = FRAME_MINIBUF_WINDOW (selected_frame); /* This is the frame that window is in. */ f = XFRAME (WINDOW_FRAME (XWINDOW (mini_window))); if (! FRAME_VISIBLE_P (f)) return; if (frame_garbaged) { redraw_garbaged_frames (); frame_garbaged = 0; } if (echo_area_glyphs || minibuf_level == 0) { echo_area_window = mini_window; vpos = XFASTINT (XWINDOW (mini_window)->top); get_display_line (f, vpos, 0); display_string (XWINDOW (mini_window), vpos, echo_area_glyphs ? echo_area_glyphs : "", echo_area_glyphs ? echo_area_glyphs_length : -1, 0, 0, 0, 0, FRAME_WIDTH (f)); #if 0 /* This just gets in the way. update_frame does the job. */ /* If desired cursor location is on this line, put it at end of text */ if (cursor_in_echo_area) FRAME_CURSOR_Y (f) = vpos; if (FRAME_CURSOR_Y (f) == vpos) FRAME_CURSOR_X (f) = FRAME_DESIRED_GLYPHS (f)->used[vpos]; #endif /* Fill the rest of the minibuffer window with blank lines. */ { int i; for (i = vpos + 1; i < vpos + XFASTINT (XWINDOW (mini_window)->height); i++) { get_display_line (f, i, 0); display_string (XWINDOW (mini_window), vpos, "", 0, 0, 0, 0, 0, FRAME_WIDTH (f)); } } } else if (!EQ (mini_window, selected_window)) windows_or_buffers_changed++; if (EQ (mini_window, selected_window)) this_line_bufpos = 0; previous_echo_glyphs = echo_area_glyphs; } #ifdef HAVE_WINDOW_SYSTEM static char frame_title_buf[512]; static char *frame_title_ptr; static int store_frame_title (str, mincol, maxcol) char *str; int mincol, maxcol; { char *limit; if (maxcol < 0 || maxcol >= sizeof(frame_title_buf)) maxcol = sizeof (frame_title_buf); limit = &frame_title_buf[maxcol]; while (*str != '\0' && frame_title_ptr < limit) *frame_title_ptr++ = *str++; while (frame_title_ptr < &frame_title_buf[mincol]) *frame_title_ptr++ = ' '; return frame_title_ptr - frame_title_buf; } static void x_consider_frame_title (frame) Lisp_Object frame; { Lisp_Object fmt; struct buffer *obuf; int len; FRAME_PTR f = XFRAME (frame); if (!(FRAME_WINDOW_P (f) || FRAME_MINIBUF_ONLY_P (f) || f->explicit_name)) return; /* Do we have more than one visible frame on this X display? */ { Lisp_Object tail; for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) { FRAME_PTR tf = XFRAME (XCONS (tail)->car); if (tf != f && FRAME_KBOARD (tf) == FRAME_KBOARD (f) && !FRAME_MINIBUF_ONLY_P (tf) && (FRAME_VISIBLE_P (tf) || FRAME_ICONIFIED_P (tf))) break; } multiple_frames = CONSP (tail); } obuf = current_buffer; Fset_buffer (XWINDOW (f->selected_window)->buffer); fmt = (FRAME_ICONIFIED_P (f) ? Vicon_title_format : Vframe_title_format); frame_title_ptr = frame_title_buf; len = display_mode_element (XWINDOW (f->selected_window), 0, 0, 0, 0, sizeof (frame_title_buf), fmt); frame_title_ptr = 0; set_buffer_internal (obuf); /* Set the name only if it's changed. This avoids consing in the common case where it hasn't. (If it turns out that we've already wasted too much time by walking through the list with display_mode_element, then we might need to optimize at a higher level than this.) */ if (! STRINGP (f->name) || XSTRING (f->name)->size != len || bcmp (frame_title_buf, XSTRING (f->name)->data, len) != 0) x_implicitly_set_name (f, make_string (frame_title_buf, len), Qnil); } #else #define frame_title_ptr ((char *)0) #define store_frame_title(str, mincol, maxcol) 0 #endif /* Prepare for redisplay by updating menu-bar item lists when appropriate. This can call eval. */ void prepare_menu_bars () { register struct window *w = XWINDOW (selected_window); int all_windows; struct gcpro gcpro1, gcpro2; all_windows = (update_mode_lines || buffer_shared > 1 || windows_or_buffers_changed); /* Update all frame titles based on their buffer names, etc. We do this before the menu bars so that the buffer-menu will show the up-to-date frame titles. This used to be done after the menu bars, for a reason that was stated as follows but which I do not understand: "We do this after the menu bars so that the frame will first create its menu bar using the name `emacs' if no other name has yet been specified." I think that is no longer a concern. */ #ifdef HAVE_WINDOW_SYSTEM if (windows_or_buffers_changed) { Lisp_Object tail, frame; FOR_EACH_FRAME (tail, frame) if (FRAME_VISIBLE_P (XFRAME (frame)) || FRAME_ICONIFIED_P (XFRAME (frame))) x_consider_frame_title (frame); } #endif /* Update the menu bar item lists, if appropriate. This has to be done before any actual redisplay or generation of display lines. */ if (all_windows) { Lisp_Object tail, frame; int count = specpdl_ptr - specpdl; record_unwind_protect (Fstore_match_data, Fmatch_data ()); FOR_EACH_FRAME (tail, frame) { /* If a window on this frame changed size, report that to the user and clear the size-change flag. */ if (FRAME_WINDOW_SIZES_CHANGED (XFRAME (frame))) { Lisp_Object functions; /* Clear flag first in case we get error below. */ FRAME_WINDOW_SIZES_CHANGED (XFRAME (frame)) = 0; functions = Vwindow_size_change_functions; GCPRO2 (tail, functions); while (CONSP (functions)) { call1 (XCONS (functions)->car, frame); functions = XCONS (functions)->cdr; } UNGCPRO; } GCPRO1 (tail); update_menu_bar (XFRAME (frame), 0); UNGCPRO; } unbind_to (count, Qnil); } else update_menu_bar (selected_frame, 1); } /* Do a frame update, taking possible shortcuts into account. This is the main external entry point for redisplay. If the last redisplay displayed an echo area message and that message is no longer requested, we clear the echo area or bring back the minibuffer if that is in use. Do not call eval from within this function. Calls to eval after the call to echo_area_display would confuse the display_line mechanism and would cause a crash. Calls to eval before that point will work most of the time, but can still lose, because this function can be called from signal handlers; with alarms set up; or with synchronous processes running. See Fcall_process; if you called it from here, it could be entered recursively. */ static int do_verify_charstarts; /* Counter is used to clear the face cache no more than once ever 1000 redisplays. */ static int clear_face_cache_count; /* Record the previous terminal frame we displayed. */ static FRAME_PTR previous_terminal_frame; void redisplay () { register struct window *w = XWINDOW (selected_window); register int pause; int must_finish = 0; int all_windows; register int tlbufpos, tlendpos; struct position pos; if (noninteractive) return; #ifdef MULTI_FRAME if (FRAME_TERMCAP_P (selected_frame) && previous_terminal_frame != selected_frame) { /* Since frames on an ASCII terminal share the same display area, displaying a different frame means redisplay the whole thing. */ windows_or_buffers_changed++; SET_FRAME_GARBAGED (selected_frame); XSETFRAME (Vterminal_frame, selected_frame); } previous_terminal_frame = selected_frame; #endif /* Set the visible flags for all frames. Do this before checking for resized or garbaged frames; they want to know if their frames are visible. See the comment in frame.h for FRAME_SAMPLE_VISIBILITY. */ { Lisp_Object tail, frame; FOR_EACH_FRAME (tail, frame) { FRAME_SAMPLE_VISIBILITY (XFRAME (frame)); /* Clear out all the display lines in which we will generate the glyphs to display. */ init_desired_glyphs (XFRAME (frame)); } } /* Notice any pending interrupt request to change frame size. */ do_pending_window_change (); if (frame_garbaged) { redraw_garbaged_frames (); frame_garbaged = 0; } prepare_menu_bars (); if (windows_or_buffers_changed) update_mode_lines++; /* Detect case that we need to write a star in the mode line. */ if (XFASTINT (w->last_modified) < MODIFF && XFASTINT (w->last_modified) <= SAVE_MODIFF) { w->update_mode_line = Qt; if (buffer_shared > 1) update_mode_lines++; } /* If %c is in use, update it if needed. */ if (!NILP (w->column_number_displayed) /* This alternative quickly identifies a common case where no change is needed. */ && !(PT == XFASTINT (w->last_point) && XFASTINT (w->last_modified) >= MODIFF) && XFASTINT (w->column_number_displayed) != current_column ()) w->update_mode_line = Qt; FRAME_SCROLL_BOTTOM_VPOS (XFRAME (w->frame)) = -1; all_windows = update_mode_lines || buffer_shared > 1; /* If specs for an arrow have changed, do thorough redisplay to ensure we remove any arrow that should no longer exist. */ if (! EQ (Voverlay_arrow_position, last_arrow_position) || ! EQ (Voverlay_arrow_string, last_arrow_string)) all_windows = 1; /* Normally the message* functions will have already displayed and updated the echo area, but the frame may have been trashed, or the update may have been preempted, so display the echo area again here. */ if (echo_area_glyphs || previous_echo_glyphs) { echo_area_display (); must_finish = 1; } /* If showing region, and mark has changed, must redisplay whole window. */ if (((!NILP (Vtransient_mark_mode) && !NILP (XBUFFER (w->buffer)->mark_active)) != !NILP (w->region_showing)) || (!NILP (w->region_showing) && !EQ (w->region_showing, Fmarker_position (XBUFFER (w->buffer)->mark)))) this_line_bufpos = -1; tlbufpos = this_line_bufpos; tlendpos = this_line_endpos; if (!all_windows && tlbufpos > 0 && NILP (w->update_mode_line) && !current_buffer->clip_changed && FRAME_VISIBLE_P (XFRAME (w->frame)) /* Make sure recorded data applies to current buffer, etc */ && this_line_buffer == current_buffer && current_buffer == XBUFFER (w->buffer) && NILP (w->force_start) /* Point must be on the line that we have info recorded about */ && PT >= tlbufpos && PT <= Z - tlendpos /* All text outside that line, including its final newline, must be unchanged */ && (XFASTINT (w->last_modified) >= MODIFF || (beg_unchanged >= tlbufpos - 1 && GPT >= tlbufpos /* If selective display, can't optimize if the changes start at the beginning of the line. */ && ((INTEGERP (current_buffer->selective_display) && XINT (current_buffer->selective_display) > 0 ? (beg_unchanged >= tlbufpos && GPT > tlbufpos) : 1)) && end_unchanged >= tlendpos && Z - GPT >= tlendpos))) { if (tlbufpos > BEGV && FETCH_CHAR (tlbufpos - 1) != '\n' && (tlbufpos == ZV || FETCH_CHAR (tlbufpos) == '\n')) /* Former continuation line has disappeared by becoming empty */ goto cancel; else if (XFASTINT (w->last_modified) < MODIFF || MINI_WINDOW_P (w)) { cursor_vpos = -1; overlay_arrow_seen = 0; zv_strings_seen = 0; display_text_line (w, tlbufpos, this_line_vpos, this_line_start_hpos, pos_tab_offset (w, tlbufpos)); /* If line contains point, is not continued, and ends at same distance from eob as before, we win */ if (cursor_vpos >= 0 && this_line_bufpos && this_line_endpos == tlendpos) { /* If this is not the window's last line, we must adjust the charstarts of the lines below. */ if (this_line_vpos + 1 < XFASTINT (w->top) + window_internal_height (w)) { int left = XFASTINT (w->left); int *charstart_next_line = FRAME_CURRENT_GLYPHS (XFRAME (WINDOW_FRAME (w)))->charstarts[this_line_vpos + 1]; int adjust; if (Z - tlendpos == ZV) /* This line ends at end of (accessible part of) buffer. There is no newline to count. */ adjust = Z - tlendpos - charstart_next_line[left]; else /* This line ends in a newline. Must take account of the newline and the rest of the text that follows. */ adjust = Z - tlendpos + 1 - charstart_next_line[left]; adjust_window_charstarts (w, this_line_vpos, adjust); } if (XFASTINT (w->width) != FRAME_WIDTH (XFRAME (WINDOW_FRAME (w)))) preserve_other_columns (w); goto update; } else goto cancel; } else if (PT == XFASTINT (w->last_point) /* Make sure the cursor was last displayed in this window. Otherwise we have to reposition it. */ && XINT (w->top) <= FRAME_CURSOR_Y (selected_frame) && (XINT (w->top) + XINT (w->height) > FRAME_CURSOR_Y (selected_frame))) { if (!must_finish) { do_pending_window_change (); return; } goto update; } /* If highlighting the region, or if the cursor is in the echo area, then we can't just move the cursor. */ else if (! (!NILP (Vtransient_mark_mode) && !NILP (current_buffer->mark_active)) && NILP (w->region_showing) && !cursor_in_echo_area) { pos = *compute_motion (tlbufpos, 0, XINT (w->hscroll) ? 1 - XINT (w->hscroll) : 0, 0, PT, 2, - (1 << (BITS_PER_SHORT - 1)), window_internal_width (w) - 1, XINT (w->hscroll), pos_tab_offset (w, tlbufpos), w); if (pos.vpos < 1) { int width = window_internal_width (w) - 1; FRAME_CURSOR_X (selected_frame) = XFASTINT (w->left) + minmax (0, pos.hpos, width); FRAME_CURSOR_Y (selected_frame) = this_line_vpos; goto update; } else goto cancel; } cancel: /* Text changed drastically or point moved off of line */ cancel_line (this_line_vpos, selected_frame); } this_line_bufpos = 0; all_windows |= buffer_shared > 1; clear_face_cache_count++; if (all_windows) { Lisp_Object tail, frame; #ifdef HAVE_FACES /* Clear the face cache, only when we do a full redisplay and not too often either. */ if (clear_face_cache_count > 1000) { clear_face_cache (); clear_face_cache_count = 0; } #endif /* Recompute # windows showing selected buffer. This will be incremented each time such a window is displayed. */ buffer_shared = 0; FOR_EACH_FRAME (tail, frame) { FRAME_PTR f = XFRAME (frame); if (! FRAME_TERMCAP_P (f) || f == selected_frame) { /* Mark all the scroll bars to be removed; we'll redeem the ones we want when we redisplay their windows. */ if (condemn_scroll_bars_hook) (*condemn_scroll_bars_hook) (f); if (FRAME_VISIBLE_P (f)) redisplay_windows (FRAME_ROOT_WINDOW (f)); /* Any scroll bars which redisplay_windows should have nuked should now go away. */ if (judge_scroll_bars_hook) (*judge_scroll_bars_hook) (f); } } } else if (FRAME_VISIBLE_P (selected_frame)) { redisplay_window (selected_window, 1); if (XFASTINT (w->width) != FRAME_WIDTH (selected_frame)) preserve_other_columns (w); } update: /* Prevent various kinds of signals during display update. stdio is not robust about handling signals, which can cause an apparent I/O error. */ if (interrupt_input) unrequest_sigio (); stop_polling (); #ifdef MULTI_FRAME if (all_windows) { Lisp_Object tail; pause = 0; for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) { FRAME_PTR f; if (!FRAMEP (XCONS (tail)->car)) continue; f = XFRAME (XCONS (tail)->car); if ((! FRAME_TERMCAP_P (f) || f == selected_frame) && FRAME_VISIBLE_P (f)) { pause |= update_frame (f, 0, 0); if (!pause) { mark_window_display_accurate (f->root_window, 1); if (frame_up_to_date_hook != 0) (*frame_up_to_date_hook) (f); } } } } else #endif /* MULTI_FRAME */ { if (FRAME_VISIBLE_P (selected_frame)) pause = update_frame (selected_frame, 0, 0); else pause = 0; /* We may have called echo_area_display at the top of this function. If the echo area is on another frame, that may have put text on a frame other than the selected one, so the above call to update_frame would not have caught it. Catch it here. */ { Lisp_Object mini_window; FRAME_PTR mini_frame; mini_window = FRAME_MINIBUF_WINDOW (selected_frame); mini_frame = XFRAME (WINDOW_FRAME (XWINDOW (mini_window))); if (mini_frame != selected_frame && ! FRAME_TERMCAP_P (mini_frame)) pause |= update_frame (mini_frame, 0, 0); } } /* If frame does not match, prevent doing single-line-update next time. Also, don't forget to check every line to update the arrow. */ if (pause) { this_line_bufpos = 0; if (!NILP (last_arrow_position)) { last_arrow_position = Qt; last_arrow_string = Qt; } /* If we pause after scrolling, some lines in current_frame may be null, so preserve_other_columns won't be able to preserve all the vertical-bar separators. So, avoid using it in that case. */ if (XFASTINT (w->width) != FRAME_WIDTH (selected_frame)) update_mode_lines = 1; } /* Now text on frame agrees with windows, so put info into the windows for partial redisplay to follow */ if (!pause) { register struct buffer *b = XBUFFER (w->buffer); blank_end_of_window = 0; unchanged_modified = BUF_MODIFF (b); beg_unchanged = BUF_GPT (b) - BUF_BEG (b); end_unchanged = BUF_Z (b) - BUF_GPT (b); XSETFASTINT (w->last_point, BUF_PT (b)); XSETFASTINT (w->last_point_x, FRAME_CURSOR_X (selected_frame)); XSETFASTINT (w->last_point_y, FRAME_CURSOR_Y (selected_frame)); if (all_windows) mark_window_display_accurate (FRAME_ROOT_WINDOW (selected_frame), 1); else { b->clip_changed = 0; w->update_mode_line = Qnil; XSETFASTINT (w->last_modified, BUF_MODIFF (b)); w->window_end_valid = w->buffer; last_arrow_position = Voverlay_arrow_position; last_arrow_string = Voverlay_arrow_string; if (do_verify_charstarts) verify_charstarts (w); if (frame_up_to_date_hook != 0) (*frame_up_to_date_hook) (selected_frame); } update_mode_lines = 0; windows_or_buffers_changed = 0; } /* Start SIGIO interrupts coming again. Having them off during the code above makes it less likely one will discard output, but not impossible, since there might be stuff in the system buffer here. But it is much hairier to try to do anything about that. */ if (interrupt_input) request_sigio (); start_polling (); /* Change frame size now if a change is pending. */ do_pending_window_change (); /* If we just did a pending size change, redisplay again for the new size. */ if (windows_or_buffers_changed && !pause) redisplay (); } /* Redisplay, but leave alone any recent echo area message unless another message has been requested in its place. This is useful in situations where you need to redisplay but no user action has occurred, making it inappropriate for the message area to be cleared. See tracking_off and wait_reading_process_input for examples of these situations. */ redisplay_preserve_echo_area () { if (echo_area_glyphs == 0 && previous_echo_glyphs != 0) { echo_area_glyphs = previous_echo_glyphs; redisplay (); echo_area_glyphs = 0; } else redisplay (); } void mark_window_display_accurate (window, flag) Lisp_Object window; int flag; { register struct window *w; for (;!NILP (window); window = w->next) { if (!WINDOWP (window)) abort (); w = XWINDOW (window); if (!NILP (w->buffer)) { XSETFASTINT (w->last_modified, !flag ? 0 : BUF_MODIFF (XBUFFER (w->buffer))); /* Record if we are showing a region, so can make sure to update it fully at next redisplay. */ w->region_showing = (!NILP (Vtransient_mark_mode) && !NILP (XBUFFER (w->buffer)->mark_active) ? Fmarker_position (XBUFFER (w->buffer)->mark) : Qnil); } w->window_end_valid = w->buffer; w->update_mode_line = Qnil; if (!NILP (w->buffer)) XBUFFER (w->buffer)->clip_changed = 0; if (!NILP (w->vchild)) mark_window_display_accurate (w->vchild, flag); if (!NILP (w->hchild)) mark_window_display_accurate (w->hchild, flag); } if (flag) { last_arrow_position = Voverlay_arrow_position; last_arrow_string = Voverlay_arrow_string; } else { /* t is unequal to any useful value of Voverlay_arrow_... */ last_arrow_position = Qt; last_arrow_string = Qt; } } /* Update the menu bar item list for frame F. This has to be done before we start to fill in any display lines, because it can call eval. If SAVE_MATCH_DATA is 1, we must save and restore it here. */ static void update_menu_bar (f, save_match_data) FRAME_PTR f; int save_match_data; { struct buffer *old = current_buffer; Lisp_Object window; register struct window *w; window = FRAME_SELECTED_WINDOW (f); w = XWINDOW (window); if (update_mode_lines) w->update_mode_line = Qt; if (FRAME_X_P (f) ? #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) FRAME_EXTERNAL_MENU_BAR (f) #else FRAME_MENU_BAR_LINES (f) > 0 #endif : FRAME_MENU_BAR_LINES (f) > 0) { /* If the user has switched buffers or windows, we need to recompute to reflect the new bindings. But we'll recompute when update_mode_lines is set too; that means that people can use force-mode-line-update to request that the menu bar be recomputed. The adverse effect on the rest of the redisplay algorithm is about the same as windows_or_buffers_changed anyway. */ if (windows_or_buffers_changed || !NILP (w->update_mode_line) || (XFASTINT (w->last_modified) < MODIFF && (XFASTINT (w->last_modified) <= BUF_SAVE_MODIFF (XBUFFER (w->buffer)))) || ((!NILP (Vtransient_mark_mode) && !NILP (XBUFFER (w->buffer)->mark_active)) != !NILP (w->region_showing))) { struct buffer *prev = current_buffer; int count = specpdl_ptr - specpdl; set_buffer_internal_1 (XBUFFER (w->buffer)); if (save_match_data) record_unwind_protect (Fstore_match_data, Fmatch_data ()); if (NILP (Voverriding_local_map_menu_flag)) { specbind (Qoverriding_terminal_local_map, Qnil); specbind (Qoverriding_local_map, Qnil); } /* Run the Lucid hook. */ call1 (Vrun_hooks, Qactivate_menubar_hook); /* If it has changed current-menubar from previous value, really recompute the menubar from the value. */ if (! NILP (Vlucid_menu_bar_dirty_flag)) call0 (Qrecompute_lucid_menubar); call1 (Vrun_hooks, Qmenu_bar_update_hook); FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) if (FRAME_X_P (f)) set_frame_menubar (f, 0, 0); #endif /* USE_X_TOOLKIT || HAVE_NTGUI */ unbind_to (count, Qnil); set_buffer_internal_1 (prev); } } } int do_id = 1; /* Redisplay WINDOW and its subwindows and siblings. */ static void redisplay_windows (window) Lisp_Object window; { for (; !NILP (window); window = XWINDOW (window)->next) redisplay_window (window, 0); } /* Redisplay window WINDOW and its subwindows. */ static void redisplay_window (window, just_this_one) Lisp_Object window; int just_this_one; { register struct window *w = XWINDOW (window); FRAME_PTR f = XFRAME (WINDOW_FRAME (w)); int height; register int lpoint = PT; struct buffer *old = current_buffer; register int width = window_internal_width (w) - 1; register int startp; register int hscroll = XINT (w->hscroll); struct position pos; int opoint = PT; int tem; int update_mode_line; struct Lisp_Char_Table *dp = window_display_table (w); if (FRAME_HEIGHT (f) == 0) abort (); /* Some bug zeros some core */ /* If this is a combination window, do its children; that's all. */ if (!NILP (w->vchild)) { redisplay_windows (w->vchild); return; } if (!NILP (w->hchild)) { redisplay_windows (w->hchild); return; } if (NILP (w->buffer)) abort (); height = window_internal_height (w); update_mode_line = (!NILP (w->update_mode_line) || update_mode_lines); if (XBUFFER (w->buffer)->clip_changed) update_mode_line = 1; if (MINI_WINDOW_P (w)) { if (w == XWINDOW (echo_area_window) && echo_area_glyphs) /* We've already displayed the echo area glyphs in this window. */ goto finish_scroll_bars; else if (w != XWINDOW (minibuf_window)) { /* This is a minibuffer, but it's not the currently active one, so clear it. */ int vpos = XFASTINT (w->top); int i; for (i = 0; i < height; i++) { get_display_line (f, vpos + i, 0); display_string (w, vpos + i, "", 0, 0, 0, 1, 0, width); } goto finish_scroll_bars; } } /* Otherwise set up data on this window; select its buffer and point value */ if (update_mode_line) set_buffer_internal_1 (XBUFFER (w->buffer)); else set_buffer_temp (XBUFFER (w->buffer)); opoint = PT; /* If %c is in mode line, update it if needed. */ if (!NILP (w->column_number_displayed) /* This alternative quickly identifies a common case where no change is needed. */ && !(PT == XFASTINT (w->last_point) && XFASTINT (w->last_modified) >= MODIFF) && XFASTINT (w->column_number_displayed) != current_column ()) update_mode_line = 1; /* Count number of windows showing the selected buffer. An indirect buffer counts as its base buffer. */ if (!just_this_one) { struct buffer *current_base, *window_base; current_base = current_buffer; window_base = XBUFFER (XWINDOW (selected_window)->buffer); if (current_base->base_buffer) current_base = current_base->base_buffer; if (window_base->base_buffer) window_base = window_base->base_buffer; if (current_base == window_base) buffer_shared++; } /* POINT refers normally to the selected window. For any other window, set up appropriate value. */ if (!EQ (window, selected_window)) { int new_pt = marker_position (w->pointm); if (new_pt < BEGV) { new_pt = BEGV; Fset_marker (w->pointm, make_number (new_pt), Qnil); } else if (new_pt > (ZV - 1)) { new_pt = ZV; Fset_marker (w->pointm, make_number (new_pt), Qnil); } /* We don't use SET_PT so that the point-motion hooks don't run. */ BUF_PT (current_buffer) = new_pt; } /* If any of the character widths specified in the display table have changed, invalidate the width run cache. It's true that this may be a bit late to catch such changes, but the rest of redisplay goes (non-fatally) haywire when the display table is changed, so why should we worry about doing any better? */ if (current_buffer->width_run_cache) { struct Lisp_Char_Table *disptab = buffer_display_table (); if (! disptab_matches_widthtab (disptab, XVECTOR (current_buffer->width_table))) { invalidate_region_cache (current_buffer, current_buffer->width_run_cache, BEG, Z); recompute_width_table (current_buffer, disptab); } } /* If window-start is screwed up, choose a new one. */ if (XMARKER (w->start)->buffer != current_buffer) goto recenter; startp = marker_position (w->start); /* Handle case where place to start displaying has been specified, unless the specified location is outside the accessible range. */ if (!NILP (w->force_start)) { /* Forget any recorded base line for line number display. */ w->base_line_number = Qnil; /* Redisplay the mode line. Select the buffer properly for that. Also, run the hook window-scroll-functions because we have scrolled. */ if (!update_mode_line || ! NILP (Vwindow_scroll_functions)) { Lisp_Object temp[3]; set_buffer_temp (old); set_buffer_internal_1 (XBUFFER (w->buffer)); update_mode_line = 1; w->update_mode_line = Qt; if (! NILP (Vwindow_scroll_functions)) run_hook_with_args_2 (Qwindow_scroll_functions, window, make_number (startp)); } w->force_start = Qnil; XSETFASTINT (w->last_modified, 0); if (startp < BEGV) startp = BEGV; if (startp > ZV) startp = ZV; try_window (window, startp); if (cursor_vpos < 0) { /* If point does not appear, move point so it does appear */ pos = *compute_motion (startp, 0, (((EQ (window, minibuf_window) && startp == BEG) ? minibuf_prompt_width : 0) + (hscroll ? 1 - hscroll : 0)), 0, ZV, height / 2, - (1 << (BITS_PER_SHORT - 1)), width, hscroll, pos_tab_offset (w, startp), w); BUF_PT (current_buffer) = pos.bufpos; if (w != XWINDOW (selected_window)) Fset_marker (w->pointm, make_number (PT), Qnil); else { if (current_buffer == old) lpoint = PT; FRAME_CURSOR_X (f) = (XFASTINT (w->left) + minmax (0, pos.hpos, width)); FRAME_CURSOR_Y (f) = pos.vpos + XFASTINT (w->top); } /* If we are highlighting the region, then we just changed the region, so redisplay to show it. */ if (!NILP (Vtransient_mark_mode) && !NILP (current_buffer->mark_active)) { cancel_my_columns (XWINDOW (window)); try_window (window, startp); } } goto done; } /* Handle case where text has not changed, only point, and it has not moved off the frame */ /* This code is not used for minibuffer for the sake of the case of redisplaying to replace an echo area message; since in that case the minibuffer contents per se are usually unchanged. This code is of no real use in the minibuffer since the handling of this_line_bufpos, etc., in redisplay handles the same cases. */ if (XFASTINT (w->last_modified) >= MODIFF && PT >= startp && !current_buffer->clip_changed && (just_this_one || XFASTINT (w->width) == FRAME_WIDTH (f)) /* If force-mode-line-update was called, really redisplay; that's how redisplay is forced after e.g. changing buffer-invisibility-spec. */ && NILP (w->update_mode_line) /* Can't use this case if highlighting a region. */ && !(!NILP (Vtransient_mark_mode) && !NILP (current_buffer->mark_active)) && NILP (w->region_showing) /* If end pos is out of date, scroll bar and percentage will be wrong */ && INTEGERP (w->window_end_vpos) && XFASTINT (w->window_end_vpos) < XFASTINT (w->height) && !EQ (window, minibuf_window)) { pos = *compute_motion (startp, 0, (hscroll ? 1 - hscroll : 0), 0, PT, height, 0, width, hscroll, pos_tab_offset (w, startp), w); if (pos.vpos < height) { /* Ok, point is still on frame */ if (w == XWINDOW (FRAME_SELECTED_WINDOW (f))) { /* These variables are supposed to be origin 1 */ FRAME_CURSOR_X (f) = (XFASTINT (w->left) + minmax (0, pos.hpos, width)); FRAME_CURSOR_Y (f) = pos.vpos + XFASTINT (w->top); } /* This doesn't do the trick, because if a window to the right of this one must be redisplayed, this does nothing because there is nothing in DesiredFrame yet, and then the other window is redisplayed, making likes that are empty in this window's columns. if (XFASTINT (w->width) != FRAME_WIDTH (f)) preserve_my_columns (w); */ goto done; } /* Don't bother trying redisplay with same start; we already know it will lose */ } /* If current starting point was originally the beginning of a line but no longer is, find a new starting point. */ else if (!NILP (w->start_at_line_beg) && !(startp <= BEGV || FETCH_CHAR (startp - 1) == '\n')) { goto recenter; } else if (just_this_one && !MINI_WINDOW_P (w) && PT >= startp && XFASTINT (w->last_modified) /* or else vmotion on first line won't work. */ && ! NILP (w->start_at_line_beg) && ! EQ (w->window_end_valid, Qnil) && do_id && !current_buffer->clip_changed && !blank_end_of_window && XFASTINT (w->width) == FRAME_WIDTH (f) /* Can't use this case if highlighting a region. */ && !(!NILP (Vtransient_mark_mode) && !NILP (current_buffer->mark_active)) /* Don't use try_window_id if newline doesn't display as the end of a line. */ && !(dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, '\n'))) && NILP (w->region_showing) && EQ (last_arrow_position, Voverlay_arrow_position) && EQ (last_arrow_string, Voverlay_arrow_string) && (tem = try_window_id (FRAME_SELECTED_WINDOW (f))) && tem != -2) { /* tem > 0 means success. tem == -1 means choose new start. tem == -2 means try again with same start, and nothing but whitespace follows the changed stuff. tem == 0 means try again with same start. */ if (tem > 0) goto done; } else if (startp >= BEGV && startp <= ZV /* Avoid starting display at end of buffer! */ && (startp < ZV || startp == BEGV || (XFASTINT (w->last_modified) >= MODIFF))) { /* Try to redisplay starting at same place as before */ /* If point has not moved off frame, accept the results */ try_window (window, startp); if (cursor_vpos >= 0) { if (!just_this_one || current_buffer->clip_changed || beg_unchanged < startp) /* Forget any recorded base line for line number display. */ w->base_line_number = Qnil; goto done; } else cancel_my_columns (w); } XSETFASTINT (w->last_modified, 0); /* Redisplay the mode line. Select the buffer properly for that. */ if (!update_mode_line) { set_buffer_temp (old); set_buffer_internal_1 (XBUFFER (w->buffer)); update_mode_line = 1; w->update_mode_line = Qt; } /* Try to scroll by specified few lines */ if (scroll_step && !current_buffer->clip_changed) { if (PT > startp) { pos = *vmotion (Z - XFASTINT (w->window_end_pos), scroll_step, w); if (pos.vpos >= height) goto scroll_fail; } pos = *vmotion (startp, (PT < startp ? - scroll_step : scroll_step), w); if (PT >= pos.bufpos) { if (! NILP (Vwindow_scroll_functions)) run_hook_with_args_2 (Qwindow_scroll_functions, window, make_number (pos.bufpos)); try_window (window, pos.bufpos); if (cursor_vpos >= 0) { if (!just_this_one || current_buffer->clip_changed || beg_unchanged < startp) /* Forget any recorded base line for line number display. */ w->base_line_number = Qnil; goto done; } else cancel_my_columns (w); } scroll_fail: ; } /* Finally, just choose place to start which centers point */ recenter: /* Forget any previously recorded base line for line number display. */ w->base_line_number = Qnil; pos = *vmotion (PT, - (height / 2), w); if (! NILP (Vwindow_scroll_functions)) run_hook_with_args_2 (Qwindow_scroll_functions, window, make_number (pos.bufpos)); try_window (window, pos.bufpos); startp = marker_position (w->start); w->start_at_line_beg = (startp == BEGV || FETCH_CHAR (startp - 1) == '\n') ? Qt : Qnil; done: if ((update_mode_line /* If window not full width, must redo its mode line if the window to its side is being redone */ || (!just_this_one && width < FRAME_WIDTH (f) - 1) || INTEGERP (w->base_line_pos) || (!NILP (w->column_number_displayed) && XFASTINT (w->column_number_displayed) != current_column ())) && height != XFASTINT (w->height)) display_mode_line (w); if (! line_number_displayed && ! BUFFERP (w->base_line_pos)) { w->base_line_pos = Qnil; w->base_line_number = Qnil; } /* When we reach a frame's selected window, redo the frame's menu bar. */ if (update_mode_line && (FRAME_X_P (f) ? #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) FRAME_EXTERNAL_MENU_BAR (f) #else FRAME_MENU_BAR_LINES (f) > 0 #endif : FRAME_MENU_BAR_LINES (f) > 0) && EQ (FRAME_SELECTED_WINDOW (f), window)) display_menu_bar (w); finish_scroll_bars: if (FRAME_HAS_VERTICAL_SCROLL_BARS (f)) { int start, end, whole; /* Calculate the start and end positions for the current window. At some point, it would be nice to choose between scrollbars which reflect the whole buffer size, with special markers indicating narrowing, and scrollbars which reflect only the visible region. Note that minibuffers sometimes aren't displaying any text. */ if (! MINI_WINDOW_P (w) || (w == XWINDOW (minibuf_window) && ! echo_area_glyphs)) { whole = ZV - BEGV; start = marker_position (w->start) - BEGV; /* I don't think this is guaranteed to be right. For the moment, we'll pretend it is. */ end = (Z - XINT (w->window_end_pos)) - BEGV; if (end < start) end = start; if (whole < (end - start)) whole = end - start; } else start = end = whole = 0; /* Indicate what this scroll bar ought to be displaying now. */ (*set_vertical_scroll_bar_hook) (w, end - start, whole, start); /* Note that we actually used the scroll bar attached to this window, so it shouldn't be deleted at the end of redisplay. */ (*redeem_scroll_bar_hook) (w); } BUF_PT (current_buffer) = opoint; if (update_mode_line) set_buffer_internal_1 (old); else set_buffer_temp (old); BUF_PT (current_buffer) = lpoint; } /* Do full redisplay on one window, starting at position `pos'. */ static void try_window (window, pos) Lisp_Object window; register int pos; { register struct window *w = XWINDOW (window); register int height = window_internal_height (w); register int vpos = XFASTINT (w->top); register int last_text_vpos = vpos; int tab_offset = pos_tab_offset (w, pos); FRAME_PTR f = XFRAME (w->frame); int width = window_internal_width (w) - 1; struct position val; Fset_marker (w->start, make_number (pos), Qnil); cursor_vpos = -1; overlay_arrow_seen = 0; zv_strings_seen = 0; val.hpos = XINT (w->hscroll) ? 1 - XINT (w->hscroll) : 0; while (--height >= 0) { val = *display_text_line (w, pos, vpos, val.hpos, tab_offset); tab_offset += width; /* For the first line displayed, display_text_line subtracts the prompt width from the tab offset. But it does not affect the value of our variable tab_offset. So we do the subtraction again, for the sake of continuation lines of that first line. */ if (MINI_WINDOW_P (w) && vpos == XFASTINT (w->top)) tab_offset -= minibuf_prompt_width; if (val.vpos) tab_offset = 0; vpos++; if (pos != val.bufpos) { int invis = 0; #ifdef USE_TEXT_PROPERTIES Lisp_Object invis_prop; invis_prop = Fget_char_property (val.bufpos-1, Qinvisible, window); invis = TEXT_PROP_MEANS_INVISIBLE (invis_prop); #endif last_text_vpos /* Next line, unless prev line ended in end of buffer with no cr */ = vpos - (val.vpos && (FETCH_CHAR (val.bufpos - 1) != '\n' || invis)); } pos = val.bufpos; } /* If last line is continued in middle of character, include the split character in the text considered on the frame */ if (val.hpos < (XINT (w->hscroll) ? 1 - XINT (w->hscroll) : 0)) pos++; /* If bottom just moved off end of frame, change mode line percentage. */ if (XFASTINT (w->window_end_pos) == 0 && Z != pos) w->update_mode_line = Qt; /* Say where last char on frame will be, once redisplay is finished. */ XSETFASTINT (w->window_end_pos, Z - pos); XSETFASTINT (w->window_end_vpos, last_text_vpos - XFASTINT (w->top)); /* But that is not valid info until redisplay finishes. */ w->window_end_valid = Qnil; } /* Try to redisplay when buffer is modified locally, computing insert/delete line to preserve text outside the bounds of the changes. Return 1 if successful, 0 if if cannot tell what to do, or -1 to tell caller to find a new window start, or -2 to tell caller to do normal redisplay with same window start. */ static int try_window_id (window) Lisp_Object window; { int pos; register struct window *w = XWINDOW (window); register int height = window_internal_height (w); FRAME_PTR f = XFRAME (w->frame); int top = XFASTINT (w->top); int start = marker_position (w->start); int width = window_internal_width (w) - 1; int hscroll = XINT (w->hscroll); int lmargin = hscroll > 0 ? 1 - hscroll : 0; int did_motion; register int vpos; register int i, tem; int last_text_vpos = 0; int stop_vpos; int selective = (INTEGERP (current_buffer->selective_display) ? XINT (current_buffer->selective_display) : !NILP (current_buffer->selective_display) ? -1 : 0); struct position val, bp, ep, xp, pp; int scroll_amount = 0; int delta; int tab_offset, epto, old_tick; if (GPT - BEG < beg_unchanged) beg_unchanged = GPT - BEG; if (Z - GPT < end_unchanged) end_unchanged = Z - GPT; if (beg_unchanged + BEG < start) return 0; /* Give up if changes go above top of window */ /* Find position before which nothing is changed. */ bp = *compute_motion (start, 0, lmargin, 0, min (ZV, beg_unchanged + BEG), height, 0, width, hscroll, pos_tab_offset (w, start), w); if (bp.vpos >= height) { if (PT < bp.bufpos) { /* All changes are beyond the window end, and point is on the screen. We don't need to change the text at all. But we need to update window_end_pos to account for any change in buffer size. */ bp = *compute_motion (start, 0, lmargin, 0, ZV, height, 0, width, hscroll, pos_tab_offset (w, start), w); XSETFASTINT (w->window_end_vpos, height); XSETFASTINT (w->window_end_pos, Z - bp.bufpos); goto findpoint; } return 0; } vpos = bp.vpos; /* Find beginning of that frame line. Must display from there. */ bp = *vmotion (bp.bufpos, 0, w); pos = bp.bufpos; val.hpos = lmargin; if (pos < start) return -1; did_motion = 0; /* If about to start displaying at the beginning of a continuation line, really start with previous frame line, in case it was not continued when last redisplayed */ if ((bp.contin && bp.bufpos - 1 == beg_unchanged && vpos > 0) || /* Likewise if we have to worry about selective display. */ (selective > 0 && bp.bufpos - 1 == beg_unchanged && vpos > 0)) { bp = *vmotion (bp.bufpos, -1, w); --vpos; pos = bp.bufpos; } if (bp.contin && bp.hpos != lmargin) { val.hpos = bp.prevhpos - width + lmargin; did_motion = 1; pos--; } bp.vpos = vpos; /* Find first visible newline after which no more is changed. */ tem = find_next_newline (Z - max (end_unchanged, Z - ZV), 1); if (selective > 0) while (tem < ZV - 1 && (indented_beyond_p (tem, selective))) tem = find_next_newline (tem, 1); /* Compute the cursor position after that newline. */ ep = *compute_motion (pos, vpos, val.hpos, did_motion, tem, height, - (1 << (BITS_PER_SHORT - 1)), width, hscroll, pos_tab_offset (w, bp.bufpos), w); /* If changes reach past the text available on the frame, just display rest of frame. */ if (ep.bufpos > Z - XFASTINT (w->window_end_pos)) stop_vpos = height; else stop_vpos = ep.vpos; /* If no newline before ep, the line ep is on includes some changes that must be displayed. Make sure we don't stop before it. */ /* Also, if changes reach all the way until ep.bufpos, it is possible that something was deleted after the newline before it, so the following line must be redrawn. */ if (stop_vpos == ep.vpos && (ep.bufpos == BEGV || FETCH_CHAR (ep.bufpos - 1) != '\n' || ep.bufpos == Z - end_unchanged)) stop_vpos = ep.vpos + 1; cursor_vpos = -1; overlay_arrow_seen = 0; zv_strings_seen = 0; /* If changes do not reach to bottom of window, figure out how much to scroll the rest of the window */ if (stop_vpos < height) { /* Now determine how far up or down the rest of the window has moved */ epto = pos_tab_offset (w, ep.bufpos); xp = *compute_motion (ep.bufpos, ep.vpos, ep.hpos, 1, Z - XFASTINT (w->window_end_pos), 10000, 0, width, hscroll, epto, w); scroll_amount = xp.vpos - XFASTINT (w->window_end_vpos); /* Is everything on frame below the changes whitespace? If so, no scrolling is really necessary. */ for (i = ep.bufpos; i < xp.bufpos; i++) { tem = FETCH_CHAR (i); if (tem != ' ' && tem != '\n' && tem != '\t') break; } if (i == xp.bufpos) return -2; XSETFASTINT (w->window_end_vpos, XFASTINT (w->window_end_vpos) + scroll_amount); /* Before doing any scrolling, verify that point will be on frame. */ if (PT > ep.bufpos && !(PT <= xp.bufpos && xp.bufpos < height)) { if (PT <= xp.bufpos) { pp = *compute_motion (ep.bufpos, ep.vpos, ep.hpos, 1, PT, height, - (1 << (BITS_PER_SHORT - 1)), width, hscroll, epto, w); } else { pp = *compute_motion (xp.bufpos, xp.vpos, xp.hpos, 1, PT, height, - (1 << (BITS_PER_SHORT - 1)), width, hscroll, pos_tab_offset (w, xp.bufpos), w); } if (pp.bufpos < PT || pp.vpos == height) return 0; cursor_vpos = pp.vpos + top; cursor_hpos = XFASTINT (w->left) + minmax (0, pp.hpos, width); } if (stop_vpos - scroll_amount >= height || ep.bufpos == xp.bufpos) { if (scroll_amount < 0) stop_vpos -= scroll_amount; scroll_amount = 0; /* In this path, we have altered window_end_vpos and not left it negative. We must make sure that, in case display is preempted before the frame changes to reflect what we do here, further updates will not come to try_window_id and assume the frame and window_end_vpos match. */ blank_end_of_window = 1; } else if (!scroll_amount) { /* Even if we don't need to scroll, we must adjust the charstarts of subsequent lines (that we won't redisplay) according to the amount of text inserted or deleted. */ int oldpos = FRAME_CURRENT_GLYPHS (f)->charstarts[ep.vpos + top][0]; int adjust = ep.bufpos - oldpos; adjust_window_charstarts (w, ep.vpos + top - 1, adjust); } else if (bp.bufpos == Z - end_unchanged) { /* If reprinting everything is nearly as fast as scrolling, don't bother scrolling. Can happen if lines are short. */ if (scroll_cost (f, bp.vpos + top - scroll_amount, top + height - max (0, scroll_amount), scroll_amount) > xp.bufpos - bp.bufpos - 20) /* Return "try normal display with same window-start." Too bad we can't prevent further scroll-thinking. */ return -2; /* If pure deletion, scroll up as many lines as possible. In common case of killing a line, this can save the following line from being overwritten by scrolling and therefore having to be redrawn. */ tem = scroll_frame_lines (f, bp.vpos + top - scroll_amount, top + height - max (0, scroll_amount), scroll_amount, bp.bufpos); if (!tem) stop_vpos = height; else { /* scroll_frame_lines did not properly adjust subsequent lines' charstarts in the case where the text of the screen line at bp.vpos has changed. (This can happen in a deletion that ends in mid-line.) To adjust properly, we need to make things constent at the position ep. So do a second adjust to make that happen. Note that stop_vpos >= ep.vpos, so it is sufficient to update the charstarts for lines at ep.vpos and below. */ int oldstart = FRAME_CURRENT_GLYPHS (f)->charstarts[ep.vpos + top][0]; adjust_window_charstarts (w, ep.vpos + top - 1, ep.bufpos - oldstart); } } else if (scroll_amount) { /* If reprinting everything is nearly as fast as scrolling, don't bother scrolling. Can happen if lines are short. */ /* Note that if scroll_amount > 0, xp.bufpos - bp.bufpos is an overestimate of cost of reprinting, since xp.bufpos would end up below the bottom of the window. */ if (scroll_cost (f, ep.vpos + top - scroll_amount, top + height - max (0, scroll_amount), scroll_amount) > xp.bufpos - ep.bufpos - 20) /* Return "try normal display with same window-start." Too bad we can't prevent further scroll-thinking. */ return -2; tem = scroll_frame_lines (f, ep.vpos + top - scroll_amount, top + height - max (0, scroll_amount), scroll_amount, ep.bufpos); if (!tem) stop_vpos = height; } } /* In any case, do not display past bottom of window */ if (stop_vpos >= height) { stop_vpos = height; scroll_amount = 0; } /* Handle case where pos is before w->start -- can happen if part of line had been clipped and is not clipped now */ if (vpos == 0 && pos < marker_position (w->start)) Fset_marker (w->start, make_number (pos), Qnil); /* Redisplay the lines where the text was changed */ last_text_vpos = vpos; tab_offset = pos_tab_offset (w, pos); /* If we are starting display in mid-character, correct tab_offset to account for passing the line that that character really starts in. */ if (val.hpos < lmargin) tab_offset += width; old_tick = MODIFF; while (vpos < stop_vpos) { val = *display_text_line (w, pos, top + vpos++, val.hpos, tab_offset); /* If display_text_line ran a hook and changed some text, redisplay all the way to bottom of buffer So that we show the changes. */ if (old_tick != MODIFF) stop_vpos = height; tab_offset += width; if (val.vpos) tab_offset = 0; if (pos != val.bufpos) last_text_vpos /* Next line, unless prev line ended in end of buffer with no cr */ = vpos - (val.vpos && FETCH_CHAR (val.bufpos - 1) != '\n'); pos = val.bufpos; } /* There are two cases: 1) we have displayed down to the bottom of the window 2) we have scrolled lines below stop_vpos by scroll_amount */ if (vpos == height) { /* If last line is continued in middle of character, include the split character in the text considered on the frame */ if (val.hpos < lmargin) val.bufpos++; XSETFASTINT (w->window_end_vpos, last_text_vpos); XSETFASTINT (w->window_end_pos, Z - val.bufpos); } /* If scrolling made blank lines at window bottom, redisplay to fill those lines */ if (scroll_amount < 0) { /* Don't consider these lines for general-purpose scrolling. That will save time in the scrolling computation. */ FRAME_SCROLL_BOTTOM_VPOS (f) = xp.vpos; vpos = xp.vpos; pos = xp.bufpos; val.hpos = lmargin; if (pos == ZV) vpos = height + scroll_amount; else if (xp.contin && xp.hpos != lmargin) { val.hpos = xp.prevhpos - width + lmargin; pos--; } blank_end_of_window = 1; tab_offset = pos_tab_offset (w, pos); /* If we are starting display in mid-character, correct tab_offset to account for passing the line that that character starts in. */ if (val.hpos < lmargin) tab_offset += width; while (vpos < height) { val = *display_text_line (w, pos, top + vpos++, val.hpos, tab_offset); tab_offset += width; if (val.vpos) tab_offset = 0; pos = val.bufpos; } /* Here is a case where display_text_line sets cursor_vpos wrong. Make it be fixed up, below. */ if (xp.bufpos == ZV && xp.bufpos == PT) cursor_vpos = -1; } /* If bottom just moved off end of frame, change mode line percentage. */ if (XFASTINT (w->window_end_pos) == 0 && Z != val.bufpos) w->update_mode_line = Qt; /* Attempt to adjust end-of-text positions to new bottom line */ if (scroll_amount) { delta = height - xp.vpos; if (delta < 0 || (delta > 0 && xp.bufpos <= ZV) || (delta == 0 && xp.hpos)) { val = *vmotion (Z - XFASTINT (w->window_end_pos), delta, w); XSETFASTINT (w->window_end_pos, Z - val.bufpos); XSETFASTINT (w->window_end_vpos, XFASTINT (w->window_end_vpos) + val.vpos); } } w->window_end_valid = Qnil; /* If point was not in a line that was displayed, find it */ if (cursor_vpos < 0) { findpoint: val = *compute_motion (start, 0, lmargin, 0, PT, 10000, 10000, width, hscroll, pos_tab_offset (w, start), w); /* Admit failure if point is off frame now */ if (val.vpos >= height) { for (vpos = 0; vpos < height; vpos++) cancel_line (vpos + top, f); return 0; } cursor_vpos = val.vpos + top; cursor_hpos = XFASTINT (w->left) + minmax (0, val.hpos, width); } FRAME_CURSOR_X (f) = cursor_hpos; FRAME_CURSOR_Y (f) = cursor_vpos; if (debug_end_pos) { val = *compute_motion (start, 0, lmargin, 0, ZV, height, - (1 << (BITS_PER_SHORT - 1)), width, hscroll, pos_tab_offset (w, start), w); if (val.vpos != XFASTINT (w->window_end_vpos)) abort (); if (XFASTINT (w->window_end_pos) != Z - val.bufpos) abort (); } return 1; } /* Mark a section of BUF as modified, but only for the sake of redisplay. This is useful for recording changes to overlays. We increment the buffer's modification timestamp and set the redisplay caches (windows_or_buffers_changed, beg_unchanged, etc) as if the region of text between START and END had been modified; the redisplay code will check this against the windows' timestamps, and redraw the appropriate area of the buffer. However, if the buffer is unmodified, we bump the last-save timestamp as well, so that incrementing the timestamp doesn't fool Emacs into thinking that the buffer's text has been modified. Tweaking the timestamps shouldn't hurt the first-modification timestamps recorded in the undo records; those values aren't written until just before a real text modification is made, so they will never catch the timestamp value just before this function gets called. */ void redisplay_region (buf, start, end) struct buffer *buf; int start, end; { if (start == end) return; if (start > end) { int temp = start; start = end; end = temp; } /* If this is a buffer not in the selected window, we must do other windows. */ if (buf != XBUFFER (XWINDOW (selected_window)->buffer)) windows_or_buffers_changed = 1; /* If it's not current, we can't use beg_unchanged, end_unchanged for it. */ else if (buf != current_buffer) windows_or_buffers_changed = 1; /* If multiple windows show this buffer, we must do other windows. */ else if (buffer_shared > 1) windows_or_buffers_changed = 1; else { if (unchanged_modified == MODIFF) { beg_unchanged = start - BEG; end_unchanged = Z - end; } else { if (Z - end < end_unchanged) end_unchanged = Z - end; if (start - BEG < beg_unchanged) beg_unchanged = start - BEG; } } /* Increment the buffer's time stamp, but also increment the save and autosave timestamps, so as not to screw up that timekeeping. */ if (BUF_MODIFF (buf) == BUF_SAVE_MODIFF (buf)) BUF_SAVE_MODIFF (buf)++; if (BUF_MODIFF (buf) == buf->auto_save_modified) buf->auto_save_modified++; BUF_MODIFF (buf) ++; } /* Copy LEN glyphs starting address FROM to the rope TO. But don't actually copy the parts that would come in before S. Value is TO, advanced past the copied data. F is the frame we are displaying in. */ static GLYPH * copy_part_of_rope (f, to, s, from, len, face) FRAME_PTR f; register GLYPH *to; /* Copy to here. */ register GLYPH *s; /* Starting point. */ Lisp_Object *from; /* Data to copy. */ int len; int face; /* Face to apply to glyphs which don't specify one. */ { int n = len; register Lisp_Object *fp = from; /* These cache the results of the last call to compute_glyph_face. */ int last_code = -1; int last_merged = 0; #ifdef HAVE_FACES if (! FRAME_TERMCAP_P (f)) while (n--) { int glyph = (INTEGERP (*fp) ? XFASTINT (*fp) : 0); int facecode; if (FAST_GLYPH_FACE (glyph) == 0) /* If GLYPH has no face code, use FACE. */ facecode = face; else if (FAST_GLYPH_FACE (glyph) == last_code) /* If it's same as previous glyph, use same result. */ facecode = last_merged; else { /* Merge this glyph's face and remember the result. */ last_code = FAST_GLYPH_FACE (glyph); last_merged = facecode = compute_glyph_face (f, last_code, face); } if (to >= s) *to = FAST_MAKE_GLYPH (FAST_GLYPH_CHAR (glyph), facecode); ++to; ++fp; } else #endif while (n--) { if (to >= s) *to = (INTEGERP (*fp) ? XFASTINT (*fp) : 0); ++to; ++fp; } return to; } /* Correct a glyph by replacing its specified user-level face code with a displayable computed face code. */ static GLYPH fix_glyph (f, glyph, cface) FRAME_PTR f; GLYPH glyph; int cface; { #ifdef HAVE_FACES if (! FRAME_TERMCAP_P (f)) { if (FAST_GLYPH_FACE (glyph) != 0) cface = compute_glyph_face (f, FAST_GLYPH_FACE (glyph), cface); glyph = FAST_MAKE_GLYPH (FAST_GLYPH_CHAR (glyph), cface); } #endif return glyph; } /* Display one line of window W, starting at position START in W's buffer. Display starting at horizontal position HPOS, expressed relative to W's left edge. In situations where the text at START shouldn't start at the left margin (i.e. when the window is hscrolled, or we're continuing a line which left off in the midst of a multi-column character), HPOS should be negative; we throw away characters up 'til hpos = 0. So, HPOS must take hscrolling into account. TABOFFSET is an offset for ostensible hpos, used in tab stop calculations. Display on position VPOS on the frame. It is origin 0, relative to the top of the frame, not W. Returns a STRUCT POSITION giving character to start next line with and where to display it, including a zero or negative hpos. The vpos field is not really a vpos; it is 1 unless the line is continued */ struct position val_display_text_line; static struct position * display_text_line (w, start, vpos, hpos, taboffset) struct window *w; int start; int vpos; int hpos; int taboffset; { register int pos = start; register int c; register GLYPH *p1; register int pause; register unsigned char *p; GLYPH *endp; register GLYPH *leftmargin; register GLYPH *p1prev; register GLYPH *p1start; int prevpos; int *charstart; FRAME_PTR f = XFRAME (w->frame); int tab_width = XINT (current_buffer->tab_width); int ctl_arrow = !NILP (current_buffer->ctl_arrow); int width = window_internal_width (w) - 1; struct position val; int lastpos; int invis; int last_invis_skip = 0; Lisp_Object last_invis_prop; int hscroll = XINT (w->hscroll); int truncate = (hscroll || (truncate_partial_width_windows && XFASTINT (w->width) < FRAME_WIDTH (f)) || !NILP (current_buffer->truncate_lines)); /* 1 if we should highlight the region. */ int highlight_region = !NILP (Vtransient_mark_mode) && !NILP (current_buffer->mark_active); int region_beg, region_end; int selective = (INTEGERP (current_buffer->selective_display) ? XINT (current_buffer->selective_display) : !NILP (current_buffer->selective_display) ? -1 : 0); register struct frame_glyphs *desired_glyphs = FRAME_DESIRED_GLYPHS (f); register struct Lisp_Char_Table *dp = window_display_table (w); Lisp_Object default_invis_vector[3]; /* Number of characters of ellipsis to display after an invisible line if it calls for an ellipsis. Note that this value can be nonzero regardless of whether selective display is enabled--you must check that separately. */ int selective_rlen = (dp && VECTORP (DISP_INVIS_VECTOR (dp)) ? XVECTOR (DISP_INVIS_VECTOR (dp))->size : !NILP (current_buffer->selective_display_ellipses) ? 3 : 0); /* This is the sequence of Lisp objects to display when there are invisible lines. */ Lisp_Object *invis_vector_contents = (dp && VECTORP (DISP_INVIS_VECTOR (dp)) ? XVECTOR (DISP_INVIS_VECTOR (dp))->contents : default_invis_vector); GLYPH truncator = (dp == 0 || !INTEGERP (DISP_TRUNC_GLYPH (dp)) ? '$' : XINT (DISP_TRUNC_GLYPH (dp))); GLYPH continuer = (dp == 0 || !INTEGERP (DISP_CONTINUE_GLYPH (dp)) ? '\\' : XINT (DISP_CONTINUE_GLYPH (dp))); /* The next buffer location at which the face should change, due to overlays or text property changes. */ int next_face_change; /* The next location where the `invisible' property changes, or an overlay starts or ends. */ int next_boundary; /* The face we're currently using. */ int current_face = 0; int i; XSETFASTINT (default_invis_vector[2], '.'); default_invis_vector[0] = default_invis_vector[1] = default_invis_vector[2]; hpos += XFASTINT (w->left); get_display_line (f, vpos, XFASTINT (w->left)); if (tab_width <= 0 || tab_width > 1000) tab_width = 8; /* Show where to highlight the region. */ if (highlight_region && XMARKER (current_buffer->mark)->buffer != 0 /* Maybe highlight only in selected window. */ && (highlight_nonselected_windows || w == XWINDOW (selected_window))) { region_beg = marker_position (current_buffer->mark); if (PT < region_beg) { region_end = region_beg; region_beg = PT; } else region_end = PT; w->region_showing = Qt; } else region_beg = region_end = -1; if (MINI_WINDOW_P (w) && start == BEG && vpos == XFASTINT (w->top)) { if (! NILP (minibuf_prompt)) { minibuf_prompt_width = (display_string (w, vpos, XSTRING (minibuf_prompt)->data, XSTRING (minibuf_prompt)->size, hpos, /* Display a space if we truncate. */ ' ', 1, -1, /* Truncate the prompt a little before the margin, so user input can at least start on the first line. */ w->width > 10 ? w->width - 4 : -1) - hpos); hpos += minibuf_prompt_width; taboffset -= minibuf_prompt_width; } else minibuf_prompt_width = 0; } /* If we're hscrolled at all, use compute_motion to skip over any text off the left edge of the window. compute_motion may know tricks to do this faster than we can. */ if (hpos < 0) { struct position *left_edge = compute_motion (pos, vpos, hpos, 0, ZV, vpos, 0, width, hscroll, taboffset, w); /* Retrieve the buffer position and column provided by compute_motion. We can't assume that the column will be zero, because you may have multi-column characters crossing the left margin. compute_motion may have moved us past the screen position we requested, if we hit a multi-column character, or the end of the line. If so, back up. */ if (left_edge->vpos > vpos || left_edge->hpos > 0) { pos = left_edge->bufpos - 1; hpos = left_edge->prevhpos; } else { pos = left_edge->bufpos; hpos = left_edge->hpos; } } desired_glyphs->bufp[vpos] = start; p1 = desired_glyphs->glyphs[vpos] + hpos; p1start = p1; charstart = desired_glyphs->charstarts[vpos] + hpos; /* In case we don't ever write anything into it... */ desired_glyphs->charstarts[vpos][XFASTINT (w->left)] = -1; leftmargin = desired_glyphs->glyphs[vpos] + XFASTINT (w->left); endp = leftmargin + width; /* Arrange the overlays nicely for our purposes. Usually, we call display_text_line on only one line at a time, in which case this can't really hurt too much, or we call it on lines which appear one after another in the buffer, in which case all calls to recenter_overlay_lists but the first will be pretty cheap. */ recenter_overlay_lists (current_buffer, pos); /* Loop generating characters. Stop at end of buffer, before newline, if reach or pass continuation column, or at face change. */ pause = pos; next_face_change = pos; next_boundary = pos; p1prev = p1; prevpos = pos; while (1) { if (pos >= pause) { int e_t_h; while (pos == next_boundary) { Lisp_Object position, limit, prop, ww; /* Display the overlay strings here, unless we're at ZV and have already displayed the appropriate strings on an earlier line. */ if (pos < ZV || !zv_strings_seen++) { int ovlen; char *ovstr; ovlen = overlay_strings (pos, w, &ovstr); for (; ovlen; ovlen--, ovstr++) { if (p1 >= leftmargin && p1 < endp) *p1 = MAKE_GLYPH (f, *ovstr, current_face); p1++; } } /* Did we reach point? Record the cursor location. */ if (pos == PT && cursor_vpos < 0) { cursor_vpos = vpos; cursor_hpos = p1 - leftmargin; } if (pos >= ZV) break; XSETFASTINT (position, pos); limit = Fnext_overlay_change (position); #ifdef USE_TEXT_PROPERTIES /* This is just an estimate to give reasonable performance; nothing should go wrong if it is too small. */ if (XFASTINT (limit) > pos + 50) XSETFASTINT (limit, pos + 50); limit = Fnext_single_property_change (position, Qinvisible, Fcurrent_buffer (), limit); #endif next_boundary = XFASTINT (limit); /* if the `invisible' property is set, we can skip to the next property change. */ XSETWINDOW (ww, w); prop = Fget_char_property (position, Qinvisible, ww); if (TEXT_PROP_MEANS_INVISIBLE (prop)) { if (pos < PT && next_boundary >= PT) { cursor_vpos = vpos; cursor_hpos = p1 - leftmargin; } pos = next_boundary; last_invis_skip = pos; last_invis_prop = prop; } } /* Did we reach point? Record the cursor location. */ if (pos == PT && cursor_vpos < 0) { cursor_vpos = vpos; cursor_hpos = p1 - leftmargin; } /* Did we hit the end of the visible region of the buffer? Stop here. */ if (pos >= ZV) { /* Update charstarts for the end of this line. */ /* Do nothing if off the left edge or at the right edge. */ if (p1 >= leftmargin && p1 + 1 != endp) { int *p2x = &charstart[(p1 < leftmargin ? leftmargin : p1) - p1start]; *p2x++ = pos; } break; } /* Figure out where (if at all) the redisplay_end_trigger-hook should run. */ if (MARKERP (w->redisplay_end_trigger) && XMARKER (w->redisplay_end_trigger)->buffer != 0) e_t_h = marker_position (w->redisplay_end_trigger); else if (INTEGERP (w->redisplay_end_trigger)) e_t_h = XINT (w->redisplay_end_trigger); else e_t_h = ZV; /* If we've gone past the place to run a hook, run the hook. */ if (pos >= e_t_h && e_t_h != ZV) { Lisp_Object args[3]; args[0] = Qredisplay_end_trigger_functions; XSETWINDOW (args[1], w); XSETINT (args[2], e_t_h); Frun_hook_with_args (3, args); w->redisplay_end_trigger = Qnil; e_t_h = ZV; /* Notice if it changed the face of this character. */ next_face_change = pos; } #ifdef HAVE_FACES /* Did we hit a face change? Figure out what face we should use now. We also hit this the first time through the loop, to see what face we should start with. */ if (pos >= next_face_change && (FRAME_WINDOW_P (f))) current_face = compute_char_face (f, w, pos, region_beg, region_end, &next_face_change, pos + 50, 0); #endif /* Compute the next place we need to stop and do something special; set PAUSE. */ pause = ZV; if (pos < next_boundary && next_boundary < pause) pause = next_boundary; if (pos < next_face_change && next_face_change < pause) pause = next_face_change; if (e_t_h < pause) pause = e_t_h; /* Wouldn't you hate to read the next line to someone over the phone? */ if (pos < PT && PT < pause) pause = PT; if (pos < GPT && GPT < pause) pause = GPT; p = &FETCH_CHAR (pos); } if (p1 >= endp) break; p1prev = p1; c = *p++; /* Let a display table override all standard display methods. */ if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, c))) { p1 = copy_part_of_rope (f, p1, leftmargin, XVECTOR (DISP_CHAR_VECTOR (dp, c))->contents, XVECTOR (DISP_CHAR_VECTOR (dp, c))->size, current_face); } else if (c >= 040 && c < 0177) { if (p1 >= leftmargin) *p1 = MAKE_GLYPH (f, c, current_face); p1++; } else if (c == '\n') { invis = 0; if (last_invis_skip == pos && TEXT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS (last_invis_prop)) invis = 1; while (pos + 1 < ZV && selective > 0 && indented_beyond_p (pos + 1, selective)) { invis = 1; pos = find_next_newline (pos + 1, 1); if (FETCH_CHAR (pos - 1) == '\n') pos--; } if (invis && selective_rlen > 0 && p1 >= leftmargin) { p1 += selective_rlen; if (p1 - leftmargin > width) p1 = endp; copy_part_of_rope (f, p1prev, p1prev, invis_vector_contents, (p1 - p1prev), current_face); } #ifdef HAVE_FACES /* Draw the face of the newline character as extending all the way to the end of the frame line. */ if (current_face) { if (p1 < leftmargin) p1 = leftmargin; while (p1 < endp) *p1++ = FAST_MAKE_GLYPH (' ', current_face); } #endif /* Update charstarts for the newline that ended this line. */ /* Do nothing here for a char that's entirely off the left edge or if it starts at the right edge. */ if (p1 >= leftmargin && p1prev != endp) { /* Store the newline's position into charstarts for the column where the newline starts. Store -1 for the rest of the glyphs it occupies. */ int *p2x = &charstart[(p1prev < leftmargin ? leftmargin : p1prev) - p1start]; int *p2 = &charstart[(p1 < endp ? p1 : endp) - p1start]; *p2x++ = pos; while (p2x < p2) *p2x++ = -1; } break; } else if (c == '\t') { do { if (p1 >= leftmargin && p1 < endp) *p1 = MAKE_GLYPH (f, ' ', current_face); p1++; } while ((p1 - leftmargin + taboffset + hscroll - (hscroll > 0)) % tab_width); } else if (c == Ctl ('M') && selective == -1) { pos = find_next_newline (pos, 1); if (FETCH_CHAR (pos - 1) == '\n') pos--; if (selective_rlen > 0) { p1 += selective_rlen; if (p1 - leftmargin > width) p1 = endp; copy_part_of_rope (f, p1prev, p1prev, invis_vector_contents, (p1 - p1prev), current_face); } #ifdef HAVE_FACES /* Draw the face of the newline character as extending all the way to the end of the frame line. */ if (current_face) { if (p1 < leftmargin) p1 = leftmargin; while (p1 < endp) *p1++ = FAST_MAKE_GLYPH (' ', current_face); } #endif /* Update charstarts for the ^M that ended this line. */ /* Do nothing here for a char that's entirely off the left edge or if it starts at the right edge. */ if (p1 >= leftmargin && p1prev != endp) { /* Store the newline's position into charstarts for the column where the newline starts. Store -1 for the rest of the glyphs it occupies. */ int *p2x = &charstart[(p1prev < leftmargin ? leftmargin : p1prev) - p1start]; int *p2 = &charstart[(p1 < endp ? p1 : endp) - p1start]; *p2x++ = pos; while (p2x < p2) *p2x++ = -1; } break; } else if (c < 0200 && ctl_arrow) { if (p1 >= leftmargin) *p1 = fix_glyph (f, (dp && INTEGERP (DISP_CTRL_GLYPH (dp)) ? XINT (DISP_CTRL_GLYPH (dp)) : '^'), current_face); p1++; if (p1 >= leftmargin && p1 < endp) *p1 = MAKE_GLYPH (f, c ^ 0100, current_face); p1++; } else { if (p1 >= leftmargin) *p1 = fix_glyph (f, (dp && INTEGERP (DISP_ESCAPE_GLYPH (dp)) ? XINT (DISP_ESCAPE_GLYPH (dp)) : '\\'), current_face); p1++; if (p1 >= leftmargin && p1 < endp) *p1 = MAKE_GLYPH (f, (c >> 6) + '0', current_face); p1++; if (p1 >= leftmargin && p1 < endp) *p1 = MAKE_GLYPH (f, (7 & (c >> 3)) + '0', current_face); p1++; if (p1 >= leftmargin && p1 < endp) *p1 = MAKE_GLYPH (f, (7 & c) + '0', current_face); p1++; } prevpos = pos; pos++; /* Update charstarts for the character just output. */ /* Do nothing here for a char that's entirely off the left edge. */ if (p1 >= leftmargin) { /* Store the char's position into charstarts for the first glyph occupied by this char. Store -1 for the rest of the glyphs it occupies. */ if (p1 != p1prev) { int *p2x = &charstart[(p1prev < leftmargin ? leftmargin : p1prev) - p1start]; int *p2 = &charstart[(p1 < endp ? p1 : endp) - p1start]; if (p2x < p2) *p2x++ = prevpos; while (p2x < p2) *p2x++ = -1; } } } val.hpos = - XINT (w->hscroll); if (val.hpos) val.hpos++; val.vpos = 1; lastpos = pos; /* Store 0 in this charstart line for the positions where there is no character. But do leave what was recorded for the character that ended the line. */ /* Add 1 in the endtest to compensate for the fact that ENDP was made from WIDTH, which is 1 less than the window's actual internal width. */ i = p1 - p1start + 1; if (p1 < leftmargin) i += leftmargin - p1; for (; i < endp - p1start + 1; i++) charstart[i] = 0; /* Handle continuation in middle of a character */ /* by backing up over it */ if (p1 > endp) { /* Don't back up if we never actually displayed any text. This occurs when the minibuffer prompt takes up the whole line. */ if (p1prev) { /* Start the next line with that same character */ pos--; /* but at negative hpos, to skip the columns output on this line. */ val.hpos += p1prev - endp; } /* Keep in this line everything up to the continuation column. */ p1 = endp; } /* Finish deciding which character to start the next line on, and what hpos to start it at. Also set `lastpos' to the last position which counts as "on this line" for cursor-positioning. */ if (pos < ZV) { if (FETCH_CHAR (pos) == '\n') { /* If stopped due to a newline, start next line after it */ pos++; /* Check again for hidden lines, in case the newline occurred exactly at the right margin. */ while (pos < ZV && selective > 0 && indented_beyond_p (pos, selective)) pos = find_next_newline (pos, 1); } else /* Stopped due to right margin of window */ { if (truncate) { *p1++ = fix_glyph (f, truncator, 0); /* Truncating => start next line after next newline, and point is on this line if it is before the newline, and skip none of first char of next line */ do pos = find_next_newline (pos, 1); while (pos < ZV && selective > 0 && indented_beyond_p (pos, selective)); val.hpos = XINT (w->hscroll) ? 1 - XINT (w->hscroll) : 0; lastpos = pos - (FETCH_CHAR (pos - 1) == '\n'); } else { *p1++ = fix_glyph (f, continuer, 0); val.vpos = 0; lastpos--; } } } /* If point is at eol or in invisible text at eol, record its frame location now. */ if (start <= PT && PT <= lastpos && cursor_vpos < 0) { cursor_vpos = vpos; cursor_hpos = p1 - leftmargin; } if (cursor_vpos == vpos) { if (cursor_hpos < 0) cursor_hpos = 0; if (cursor_hpos > width) cursor_hpos = width; cursor_hpos += XFASTINT (w->left); if (w == XWINDOW (FRAME_SELECTED_WINDOW (f))) { if (!(cursor_in_echo_area && FRAME_HAS_MINIBUF_P (f) && EQ (FRAME_MINIBUF_WINDOW (f), minibuf_window))) { FRAME_CURSOR_Y (f) = cursor_vpos; FRAME_CURSOR_X (f) = cursor_hpos; } if (w == XWINDOW (selected_window)) { /* Line is not continued and did not start in middle of character */ if ((hpos - XFASTINT (w->left) == (XINT (w->hscroll) ? 1 - XINT (w->hscroll) : 0)) && val.vpos) { this_line_bufpos = start; this_line_buffer = current_buffer; this_line_vpos = cursor_vpos; this_line_start_hpos = hpos; this_line_endpos = Z - lastpos; } else this_line_bufpos = 0; } } } /* If hscroll and line not empty, insert truncation-at-left marker */ if (hscroll && lastpos != start) { *leftmargin = fix_glyph (f, truncator, 0); if (p1 <= leftmargin) p1 = leftmargin + 1; } if (XFASTINT (w->width) + XFASTINT (w->left) != FRAME_WIDTH (f)) { endp++; if (p1 < leftmargin) p1 = leftmargin; while (p1 < endp) *p1++ = SPACEGLYPH; /* Don't draw vertical bars if we're using scroll bars. They're covered up by the scroll bars, and it's distracting to see them when the scroll bar windows are flickering around to be reconfigured. */ if (FRAME_HAS_VERTICAL_SCROLL_BARS (f)) { int i; for (i = 0; i < FRAME_SCROLL_BAR_COLS (f); i++) *p1++ = SPACEGLYPH; } else *p1++ = (dp && INTEGERP (DISP_BORDER_GLYPH (dp)) ? DISP_BORDER_GLYPH (dp) : '|'); } desired_glyphs->used[vpos] = max (desired_glyphs->used[vpos], p1 - desired_glyphs->glyphs[vpos]); desired_glyphs->glyphs[vpos][desired_glyphs->used[vpos]] = 0; /* If the start of this line is the overlay arrow-position, then put the arrow string into the display-line. */ if (MARKERP (Voverlay_arrow_position) && current_buffer == XMARKER (Voverlay_arrow_position)->buffer && start == marker_position (Voverlay_arrow_position) && STRINGP (Voverlay_arrow_string) && ! overlay_arrow_seen) { unsigned char *p = XSTRING (Voverlay_arrow_string)->data; int i; int len = XSTRING (Voverlay_arrow_string)->size; int arrow_end; if (len > width) len = width; #ifdef HAVE_FACES if (!NULL_INTERVAL_P (XSTRING (Voverlay_arrow_string)->intervals)) { /* If the arrow string has text props, obey them when displaying. */ for (i = 0; i < len; i++) { int c = p[i]; Lisp_Object face, ilisp; int newface; XSETFASTINT (ilisp, i); face = Fget_text_property (ilisp, Qface, Voverlay_arrow_string); newface = compute_glyph_face_1 (f, face, 0); leftmargin[i] = FAST_MAKE_GLYPH (c, newface); } } else #endif /* HAVE_FACES */ { for (i = 0; i < len; i++) leftmargin[i] = p[i]; } /* Bug in SunOS 4.1.1 compiler requires this intermediate variable. */ arrow_end = (leftmargin - desired_glyphs->glyphs[vpos]) + len; if (desired_glyphs->used[vpos] < arrow_end) desired_glyphs->used[vpos] = arrow_end; overlay_arrow_seen = 1; } val.bufpos = pos; val_display_text_line = val; return &val_display_text_line; } /* Redisplay the menu bar in the frame for window W. */ static void display_menu_bar (w) struct window *w; { Lisp_Object items, tail; register int vpos = 0; register FRAME_PTR f = XFRAME (WINDOW_FRAME (w)); int maxendcol = FRAME_WIDTH (f); int hpos = 0; int i; #ifdef HAVE_NTGUI return; #endif #ifdef USE_X_TOOLKIT if (FRAME_X_P (f)) return; #endif /* USE_X_TOOLKIT */ get_display_line (f, vpos, 0); items = FRAME_MENU_BAR_ITEMS (f); for (i = 0; i < XVECTOR (items)->size; i += 3) { Lisp_Object pos, string; string = XVECTOR (items)->contents[i + 1]; if (NILP (string)) break; XSETFASTINT (XVECTOR (items)->contents[i + 2], hpos); if (hpos < maxendcol) hpos = display_string (XWINDOW (FRAME_ROOT_WINDOW (f)), vpos, XSTRING (string)->data, XSTRING (string)->size, hpos, 0, 0, hpos, maxendcol); /* Put a space between items. */ if (hpos < maxendcol) { int hpos1 = hpos + 1; hpos = display_string (w, vpos, "", 0, hpos, 0, 0, min (hpos1, maxendcol), maxendcol); } } FRAME_DESIRED_GLYPHS (f)->bufp[vpos] = 0; FRAME_DESIRED_GLYPHS (f)->highlight[vpos] = mode_line_inverse_video; /* Fill out the line with spaces. */ if (maxendcol > hpos) hpos = display_string (w, vpos, "", 0, hpos, 0, 0, maxendcol, maxendcol); /* Clear the rest of the lines allocated to the menu bar. */ vpos++; while (vpos < FRAME_MENU_BAR_LINES (f)) get_display_line (f, vpos++, 0); } /* Display the mode line for window w */ static void display_mode_line (w) struct window *w; { register int vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1; register int left = XFASTINT (w->left); register int right = XFASTINT (w->width) + left; register FRAME_PTR f = XFRAME (WINDOW_FRAME (w)); line_number_displayed = 0; w->column_number_displayed = Qnil; get_display_line (f, vpos, left); /* Temporarily make frame F's kboard the current kboard so that kboard-local variables in the mode_line_format will get the right values. */ push_frame_kboard (f); display_mode_element (w, vpos, left, 0, right, right, current_buffer->mode_line_format); pop_frame_kboard (); FRAME_DESIRED_GLYPHS (f)->bufp[vpos] = 0; /* Make the mode line inverse video if the entire line is made of mode lines. I.e. if this window is full width, or if it is the child of a full width window (which implies that that window is split side-by-side and the rest of this line is mode lines of the sibling windows). */ if (XFASTINT (w->width) == FRAME_WIDTH (f) || XFASTINT (XWINDOW (w->parent)->width) == FRAME_WIDTH (f)) FRAME_DESIRED_GLYPHS (f)->highlight[vpos] = mode_line_inverse_video; #ifdef HAVE_FACES else if (! FRAME_TERMCAP_P (f) && mode_line_inverse_video) { /* For a partial width window, explicitly set face of each glyph. */ int i; GLYPH *ptr = FRAME_DESIRED_GLYPHS (f)->glyphs[vpos]; for (i = left; i < right; ++i) ptr[i] = FAST_MAKE_GLYPH (FAST_GLYPH_CHAR (ptr[i]), 1); } #endif } /* Contribute ELT to the mode line for window W. How it translates into text depends on its data type. VPOS is the position of the mode line being displayed. HPOS is the position (absolute on frame) where this element's text should start. The output is truncated automatically at the right edge of window W. DEPTH is the depth in recursion. It is used to prevent infinite recursion here. MINENDCOL is the hpos before which the element may not end. The element is padded at the right with spaces if nec to reach this column. MAXENDCOL is the hpos past which this element may not extend. If MINENDCOL is > MAXENDCOL, MINENDCOL takes priority. (This is necessary to make nested padding and truncation work.) Returns the hpos of the end of the text generated by ELT. The next element will receive that value as its HPOS arg, so as to concatenate the elements. */ static int display_mode_element (w, vpos, hpos, depth, minendcol, maxendcol, elt) struct window *w; register int vpos, hpos; int depth; int minendcol; register int maxendcol; register Lisp_Object elt; { tail_recurse: if (depth > 10) goto invalid; depth++; switch (SWITCH_ENUM_CAST (XTYPE (elt))) { case Lisp_String: { /* A string: output it and check for %-constructs within it. */ register unsigned char c; register unsigned char *this = XSTRING (elt)->data; while (hpos < maxendcol && *this) { unsigned char *last = this; while ((c = *this++) != '\0' && c != '%') ; if (this - 1 != last) { register int lim = --this - last + hpos; if (frame_title_ptr) hpos = store_frame_title (last, hpos, min (lim, maxendcol)); else hpos = display_string (w, vpos, last, -1, hpos, 0, 1, hpos, min (lim, maxendcol)); } else /* c == '%' */ { register int minendcol; register int spec_width = 0; /* We can't allow -ve args due to the "%-" construct */ /* Argument specifies minwidth but not maxwidth (maxwidth can be specified by ( . ) mode-line elements) */ while ((c = *this++) >= '0' && c <= '9') { spec_width = spec_width * 10 + (c - '0'); } minendcol = hpos + spec_width; if (minendcol > maxendcol) { spec_width = maxendcol - hpos; minendcol = maxendcol; } if (c == 'M') hpos = display_mode_element (w, vpos, hpos, depth, spec_width, maxendcol, Vglobal_mode_string); else if (c != 0) { char *spec = decode_mode_spec (w, c, spec_width, maxendcol - hpos); if (frame_title_ptr) hpos = store_frame_title (spec, minendcol, maxendcol); else hpos = display_string (w, vpos, spec, -1, hpos, 0, 1, minendcol, maxendcol); } } } } break; case Lisp_Symbol: /* A symbol: process the value of the symbol recursively as if it appeared here directly. Avoid error if symbol void. Special case: if value of symbol is a string, output the string literally. */ { register Lisp_Object tem; tem = Fboundp (elt); if (!NILP (tem)) { tem = Fsymbol_value (elt); /* If value is a string, output that string literally: don't check for % within it. */ if (STRINGP (tem)) { if (frame_title_ptr) hpos = store_frame_title (XSTRING (tem)->data, minendcol, maxendcol); else hpos = display_string (w, vpos, XSTRING (tem)->data, XSTRING (tem)->size, hpos, 0, 1, minendcol, maxendcol); } /* Give up right away for nil or t. */ else if (!EQ (tem, elt)) { elt = tem; goto tail_recurse; } } } break; case Lisp_Cons: { register Lisp_Object car, tem; /* A cons cell: three distinct cases. If first element is a string or a cons, process all the elements and effectively concatenate them. If first element is a negative number, truncate displaying cdr to at most that many characters. If positive, pad (with spaces) to at least that many characters. If first element is a symbol, process the cadr or caddr recursively according to whether the symbol's value is non-nil or nil. */ car = XCONS (elt)->car; if (SYMBOLP (car)) { tem = Fboundp (car); elt = XCONS (elt)->cdr; if (!CONSP (elt)) goto invalid; /* elt is now the cdr, and we know it is a cons cell. Use its car if CAR has a non-nil value. */ if (!NILP (tem)) { tem = Fsymbol_value (car); if (!NILP (tem)) { elt = XCONS (elt)->car; goto tail_recurse; } } /* Symbol's value is nil (or symbol is unbound) Get the cddr of the original list and if possible find the caddr and use that. */ elt = XCONS (elt)->cdr; if (NILP (elt)) break; else if (!CONSP (elt)) goto invalid; elt = XCONS (elt)->car; goto tail_recurse; } else if (INTEGERP (car)) { register int lim = XINT (car); elt = XCONS (elt)->cdr; if (lim < 0) /* Negative int means reduce maximum width. DO NOT change MINENDCOL here! (20 -10 . foo) should truncate foo to 10 col and then pad to 20. */ maxendcol = min (maxendcol, hpos - lim); else if (lim > 0) { /* Padding specified. Don't let it be more than current maximum. */ lim += hpos; if (lim > maxendcol) lim = maxendcol; /* If that's more padding than already wanted, queue it. But don't reduce padding already specified even if that is beyond the current truncation point. */ if (lim > minendcol) minendcol = lim; } goto tail_recurse; } else if (STRINGP (car) || CONSP (car)) { register int limit = 50; /* LIMIT is to protect against circular lists. */ while (CONSP (elt) && --limit > 0 && hpos < maxendcol) { hpos = display_mode_element (w, vpos, hpos, depth, hpos, maxendcol, XCONS (elt)->car); elt = XCONS (elt)->cdr; } } } break; default: invalid: if (frame_title_ptr) hpos = store_frame_title ("*invalid*", minendcol, maxendcol); else hpos = display_string (w, vpos, "*invalid*", -1, hpos, 0, 1, minendcol, maxendcol); return hpos; } if (minendcol > hpos) if (frame_title_ptr) hpos = store_frame_title ("", minendcol, maxendcol); else hpos = display_string (w, vpos, "", 0, hpos, 0, 1, minendcol, maxendcol); return hpos; } /* Write a null-terminated, right justified decimal representation of the positive integer D to BUF using a minimal field width WIDTH. */ static void pint2str (buf, width, d) register char *buf; register int width; register int d; { register char *p = buf; if (d <= 0) *p++ = '0'; else while (d > 0) { *p++ = d % 10 + '0'; d /= 10; } for (width -= (int) (p - buf); width > 0; --width) *p++ = ' '; *p-- = '\0'; while (p > buf) { d = *buf; *buf++ = *p; *p-- = d; } } /* Return a string for the output of a mode line %-spec for window W, generated by character C. SPEC_WIDTH is the field width when padding to the left (%c, %l). The value returned from this function will later be truncated to width MAXWIDTH. */ static char lots_of_dashes[] = "--------------------------------------------------------------------------------------------------------------------------------------------"; static char * decode_mode_spec (w, c, spec_width, maxwidth) struct window *w; register char c; register int spec_width; register int maxwidth; { Lisp_Object obj; FRAME_PTR f = XFRAME (WINDOW_FRAME (w)); char *decode_mode_spec_buf = (char *) FRAME_TEMP_GLYPHS (f)->total_contents; struct buffer *b = XBUFFER (w->buffer); obj = Qnil; if (maxwidth > FRAME_WIDTH (f)) maxwidth = FRAME_WIDTH (f); switch (c) { case '*': if (!NILP (b->read_only)) return "%"; if (BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) return "*"; return "-"; case '+': /* This differs from %* only for a modified read-only buffer. */ if (BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) return "*"; if (!NILP (b->read_only)) return "%"; return "-"; case '&': /* This differs from %* in ignoring read-only-ness. */ if (BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) return "*"; return "-"; case '%': return "%"; case '[': { int i; char *p; if (command_loop_level > 5) return "[[[... "; p = decode_mode_spec_buf; for (i = 0; i < command_loop_level; i++) *p++ = '['; *p = 0; return decode_mode_spec_buf; } case ']': { int i; char *p; if (command_loop_level > 5) return " ...]]]"; p = decode_mode_spec_buf; for (i = 0; i < command_loop_level; i++) *p++ = ']'; *p = 0; return decode_mode_spec_buf; } case '-': { register char *p; register int i; if (maxwidth < sizeof (lots_of_dashes)) return lots_of_dashes; else { for (p = decode_mode_spec_buf, i = maxwidth; i > 0; i--) *p++ = '-'; *p = '\0'; } return decode_mode_spec_buf; } case 'b': obj = b->name; #if 0 if (maxwidth >= 3 && XSTRING (obj)->size > maxwidth) { bcopy (XSTRING (obj)->data, decode_mode_spec_buf, maxwidth - 1); decode_mode_spec_buf[maxwidth - 1] = '\\'; decode_mode_spec_buf[maxwidth] = '\0'; return decode_mode_spec_buf; } #endif break; case 'c': { int col = current_column (); XSETFASTINT (w->column_number_displayed, col); pint2str (decode_mode_spec_buf, spec_width, col); return decode_mode_spec_buf; } case 'F': /* %F displays the frame name. */ #ifdef MULTI_FRAME return (char *) XSTRING (selected_frame->name)->data; #else return "Emacs"; #endif case 'f': obj = b->filename; #if 0 if (NILP (obj)) return "[none]"; else if (STRINGP (obj) && XSTRING (obj)->size > maxwidth) { bcopy ("...", decode_mode_spec_buf, 3); bcopy (XSTRING (obj)->data + XSTRING (obj)->size - maxwidth + 3, decode_mode_spec_buf + 3, maxwidth - 3); return decode_mode_spec_buf; } #endif break; case 'l': { int startpos = marker_position (w->start); int line, linepos, topline; int nlines, junk; Lisp_Object tem; int height = XFASTINT (w->height); /* If we decided that this buffer isn't suitable for line numbers, don't forget that too fast. */ if (EQ (w->base_line_pos, w->buffer)) goto no_value; /* If the buffer is very big, don't waste time. */ if (BUF_ZV (b) - BUF_BEGV (b) > line_number_display_limit) { w->base_line_pos = Qnil; w->base_line_number = Qnil; goto no_value; } if (!NILP (w->base_line_number) && !NILP (w->base_line_pos) && XFASTINT (w->base_line_pos) <= marker_position (w->start)) { line = XFASTINT (w->base_line_number); linepos = XFASTINT (w->base_line_pos); } else { line = 1; linepos = BUF_BEGV (b); } /* Count lines from base line to window start position. */ nlines = display_count_lines (linepos, startpos, startpos, &junk); topline = nlines + line; /* Determine a new base line, if the old one is too close or too far away, or if we did not have one. "Too close" means it's plausible a scroll-down would go back past it. */ if (startpos == BUF_BEGV (b)) { XSETFASTINT (w->base_line_number, topline); XSETFASTINT (w->base_line_pos, BUF_BEGV (b)); } else if (nlines < height + 25 || nlines > height * 3 + 50 || linepos == BUF_BEGV (b)) { int limit = BUF_BEGV (b); int position; int distance = (height * 2 + 30) * 200; if (startpos - distance > limit) limit = startpos - distance; nlines = display_count_lines (startpos, limit, -(height * 2 + 30), &position); /* If we couldn't find the lines we wanted within 200 chars per line, give up on line numbers for this window. */ if (position == startpos - distance) { w->base_line_pos = w->buffer; w->base_line_number = Qnil; goto no_value; } XSETFASTINT (w->base_line_number, topline - nlines); XSETFASTINT (w->base_line_pos, position); } /* Now count lines from the start pos to point. */ nlines = display_count_lines (startpos, PT, PT, &junk); /* Record that we did display the line number. */ line_number_displayed = 1; /* Make the string to show. */ pint2str (decode_mode_spec_buf, spec_width, topline + nlines); return decode_mode_spec_buf; no_value: { char* p = decode_mode_spec_buf; for (spec_width -= 2; spec_width > 0; --spec_width) *p++ = ' '; strcpy (p, "??"); return decode_mode_spec_buf; } } break; case 'm': obj = b->mode_name; break; case 'n': if (BUF_BEGV (b) > BUF_BEG (b) || BUF_ZV (b) < BUF_Z (b)) return " Narrow"; break; case 'p': { int pos = marker_position (w->start); int total = BUF_ZV (b) - BUF_BEGV (b); if (XFASTINT (w->window_end_pos) <= BUF_Z (b) - BUF_ZV (b)) { if (pos <= BUF_BEGV (b)) return "All"; else return "Bottom"; } else if (pos <= BUF_BEGV (b)) return "Top"; else { total = ((pos - BUF_BEGV (b)) * 100 + total - 1) / total; /* We can't normally display a 3-digit number, so get us a 2-digit number that is close. */ if (total == 100) total = 99; sprintf (decode_mode_spec_buf, "%2d%%", total); return decode_mode_spec_buf; } } /* Display percentage of size above the bottom of the screen. */ case 'P': { int toppos = marker_position (w->start); int botpos = BUF_Z (b) - XFASTINT (w->window_end_pos); int total = BUF_ZV (b) - BUF_BEGV (b); if (botpos >= BUF_ZV (b)) { if (toppos <= BUF_BEGV (b)) return "All"; else return "Bottom"; } else { total = ((botpos - BUF_BEGV (b)) * 100 + total - 1) / total; /* We can't normally display a 3-digit number, so get us a 2-digit number that is close. */ if (total == 100) total = 99; if (toppos <= BUF_BEGV (b)) sprintf (decode_mode_spec_buf, "Top%2d%%", total); else sprintf (decode_mode_spec_buf, "%2d%%", total); return decode_mode_spec_buf; } } case 's': /* status of process */ obj = Fget_buffer_process (w->buffer); if (NILP (obj)) return "no process"; #ifdef subprocesses obj = Fsymbol_name (Fprocess_status (obj)); #endif break; case 't': /* indicate TEXT or BINARY */ #ifdef MODE_LINE_BINARY_TEXT return MODE_LINE_BINARY_TEXT (b); #else return "T"; #endif } if (STRINGP (obj)) return (char *) XSTRING (obj)->data; else return ""; } /* Search for COUNT instances of a line boundary, which means either a newline or (if selective display enabled) a carriage return. Start at START. If COUNT is negative, search backwards. If we find COUNT instances, set *SHORTAGE to zero, and return the position after the COUNTth match. Note that for reverse motion this is not the same as the usual convention for Emacs motion commands. If we don't find COUNT instances before reaching the end of the buffer (or the beginning, if scanning backwards), set *SHORTAGE to the number of line boundaries left unfound, and return the end of the buffer we bumped up against. */ static int display_scan_buffer (start, count, shortage) int *shortage, start; register int count; { int limit = ((count > 0) ? ZV - 1 : BEGV); int direction = ((count > 0) ? 1 : -1); register unsigned char *cursor; unsigned char *base; register int ceiling; register unsigned char *ceiling_addr; /* If we are not in selective display mode, check only for newlines. */ if (! (!NILP (current_buffer->selective_display) && !INTEGERP (current_buffer->selective_display))) return scan_buffer ('\n', start, 0, count, shortage, 0); /* The code that follows is like scan_buffer but checks for either newline or carriage return. */ if (shortage != 0) *shortage = 0; if (count > 0) while (start != limit + 1) { ceiling = BUFFER_CEILING_OF (start); ceiling = min (limit, ceiling); ceiling_addr = &FETCH_CHAR (ceiling) + 1; base = (cursor = &FETCH_CHAR (start)); while (1) { while (*cursor != '\n' && *cursor != 015 && ++cursor != ceiling_addr) ; if (cursor != ceiling_addr) { if (--count == 0) { immediate_quit = 0; return (start + cursor - base + 1); } else if (++cursor == ceiling_addr) break; } else break; } start += cursor - base; } else { start--; /* first character we scan */ while (start > limit - 1) { /* we WILL scan under start */ ceiling = BUFFER_FLOOR_OF (start); ceiling = max (limit, ceiling); ceiling_addr = &FETCH_CHAR (ceiling) - 1; base = (cursor = &FETCH_CHAR (start)); cursor++; while (1) { while (--cursor != ceiling_addr && *cursor != '\n' && *cursor != 015) ; if (cursor != ceiling_addr) { if (++count == 0) { immediate_quit = 0; return (start + cursor - base + 1); } } else break; } start += cursor - base; } } if (shortage != 0) *shortage = count * direction; return (start + ((direction == 1 ? 0 : 1))); } /* Count up to N lines starting from FROM. But don't go beyond LIMIT. Return the number of lines thus found (always positive). Store the position after what was found into *POS_PTR. */ static int display_count_lines (from, limit, n, pos_ptr) int from, limit, n; int *pos_ptr; { int oldbegv = BEGV; int oldzv = ZV; int shortage = 0; if (limit < from) BEGV = limit; else ZV = limit; *pos_ptr = display_scan_buffer (from, n, &shortage); ZV = oldzv; BEGV = oldbegv; if (n < 0) /* When scanning backwards, scan_buffer stops *after* the last newline it finds, but does count it. Compensate for that. */ return - n - shortage - (*pos_ptr != limit); return n - shortage; } /* Display STRING on one line of window W, starting at HPOS. Display at position VPOS. Caller should have done get_display_line. If VPOS == -1, display it as the current frame's title. LENGTH is the length of STRING, or -1 meaning STRING is null-terminated. TRUNCATE is GLYPH to display at end if truncated. Zero for none. MINCOL is the first column ok to end at. (Pad with spaces to this col.) MAXCOL is the last column ok to end at. Truncate here. -1 for MINCOL or MAXCOL means no explicit minimum or maximum. Both count from the left edge of the frame, as does HPOS. The right edge of W is an implicit maximum. If TRUNCATE is nonzero, the implicit maximum is one column before the edge. OBEY_WINDOW_WIDTH says to put spaces or vertical bars at the place where the current window ends in this line and not display anything beyond there. Otherwise, only MAXCOL controls where to stop output. Returns ending hpos. */ static int display_string (w, vpos, string, length, hpos, truncate, obey_window_width, mincol, maxcol) struct window *w; unsigned char *string; int length; int vpos, hpos; GLYPH truncate; int obey_window_width; int mincol, maxcol; { register int c; int truncated; register GLYPH *p1; int hscroll = XINT (w->hscroll); int tab_width = XINT (XBUFFER (w->buffer)->tab_width); register GLYPH *start; register GLYPH *end; FRAME_PTR f = XFRAME (WINDOW_FRAME (w)); struct frame_glyphs *desired_glyphs = FRAME_DESIRED_GLYPHS (f); GLYPH *p1start = desired_glyphs->glyphs[vpos] + hpos; int window_width = XFASTINT (w->width); /* Use the standard display table, not the window's display table. We don't want the mode line in rot13. */ register struct Lisp_Char_Table *dp = 0; int i; if (DISP_TABLE_P (Vstandard_display_table)) dp = XCHAR_TABLE (Vstandard_display_table); if (tab_width <= 0 || tab_width > 1000) tab_width = 8; p1 = p1start; start = desired_glyphs->glyphs[vpos] + XFASTINT (w->left); if (obey_window_width) { end = start + window_width - (truncate != 0); if ((window_width + XFASTINT (w->left)) != FRAME_WIDTH (f)) { if (FRAME_HAS_VERTICAL_SCROLL_BARS (f)) { int i; for (i = 0; i < FRAME_SCROLL_BAR_COLS (f); i++) *end-- = ' '; } else *end-- = '|'; } } if (! obey_window_width || (maxcol >= 0 && end - desired_glyphs->glyphs[vpos] > maxcol)) end = desired_glyphs->glyphs[vpos] + maxcol; /* Store 0 in charstart for these columns. */ for (i = (hpos >= 0 ? hpos : 0); i < end - p1start + hpos; i++) desired_glyphs->charstarts[vpos][i] = 0; if (maxcol >= 0 && mincol > maxcol) mincol = maxcol; /* We set truncated to 1 if we get stopped by trying to pass END (that is, trying to pass MAXCOL.) */ truncated = 0; while (1) { if (length == 0) break; c = *string++; /* Specified length. */ if (length >= 0) length--; /* Unspecified length (null-terminated string). */ else if (c == 0) break; if (p1 >= end) { truncated = 1; break; } if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, c))) { p1 = copy_part_of_rope (f, p1, start, XVECTOR (DISP_CHAR_VECTOR (dp, c))->contents, XVECTOR (DISP_CHAR_VECTOR (dp, c))->size, 0); } else if (c >= 040 && c < 0177) { if (p1 >= start) *p1 = c; p1++; } else if (c == '\t') { do { if (p1 >= start && p1 < end) *p1 = SPACEGLYPH; p1++; } while ((p1 - start + hscroll - (hscroll > 0)) % tab_width); } else if (c < 0200 && ! NILP (buffer_defaults.ctl_arrow)) { if (p1 >= start) *p1 = fix_glyph (f, (dp && INTEGERP (DISP_CTRL_GLYPH (dp)) ? XINT (DISP_CTRL_GLYPH (dp)) : '^'), 0); p1++; if (p1 >= start && p1 < end) *p1 = c ^ 0100; p1++; } else { if (p1 >= start) *p1 = fix_glyph (f, (dp && INTEGERP (DISP_ESCAPE_GLYPH (dp)) ? XINT (DISP_ESCAPE_GLYPH (dp)) : '\\'), 0); p1++; if (p1 >= start && p1 < end) *p1 = (c >> 6) + '0'; p1++; if (p1 >= start && p1 < end) *p1 = (7 & (c >> 3)) + '0'; p1++; if (p1 >= start && p1 < end) *p1 = (7 & c) + '0'; p1++; } } if (truncated) { p1 = end; if (truncate) *p1++ = fix_glyph (f, truncate, 0); } else if (mincol >= 0) { end = desired_glyphs->glyphs[vpos] + mincol; while (p1 < end) *p1++ = SPACEGLYPH; } { register int len = p1 - desired_glyphs->glyphs[vpos]; if (len > desired_glyphs->used[vpos]) desired_glyphs->used[vpos] = len; desired_glyphs->glyphs[vpos][desired_glyphs->used[vpos]] = 0; return len; } } /* This is like a combination of memq and assq. Return 1 if PROPVAL appears as an element of LIST or as the car of an element of LIST. If PROPVAL is a list, compare each element against LIST in that way, and return 1 if any element of PROPVAL is found in LIST. Otherwise return 0. This function cannot quit. */ int invisible_p (propval, list) register Lisp_Object propval; Lisp_Object list; { register Lisp_Object tail, proptail; for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr) { register Lisp_Object tem; tem = XCONS (tail)->car; if (EQ (propval, tem)) return 1; if (CONSP (tem) && EQ (propval, XCONS (tem)->car)) return 1; } if (CONSP (propval)) for (proptail = propval; CONSP (proptail); proptail = XCONS (proptail)->cdr) { Lisp_Object propelt; propelt = XCONS (proptail)->car; for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr) { register Lisp_Object tem; tem = XCONS (tail)->car; if (EQ (propelt, tem)) return 1; if (CONSP (tem) && EQ (propelt, XCONS (tem)->car)) return 1; } } return 0; } /* Return 1 if PROPVAL appears as the car of an element of LIST and the cdr of that element is non-nil. If PROPVAL is a list, check each element of PROPVAL in that way, and the first time some element is found, return 1 if the cdr of that element is non-nil. Otherwise return 0. This function cannot quit. */ int invisible_ellipsis_p (propval, list) register Lisp_Object propval; Lisp_Object list; { register Lisp_Object tail, proptail; for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr) { register Lisp_Object tem; tem = XCONS (tail)->car; if (CONSP (tem) && EQ (propval, XCONS (tem)->car)) return ! NILP (XCONS (tem)->cdr); } if (CONSP (propval)) for (proptail = propval; CONSP (proptail); proptail = XCONS (proptail)->cdr) { Lisp_Object propelt; propelt = XCONS (proptail)->car; for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr) { register Lisp_Object tem; tem = XCONS (tail)->car; if (CONSP (tem) && EQ (propelt, XCONS (tem)->car)) return ! NILP (XCONS (tem)->cdr); } } return 0; } void syms_of_xdisp () { staticpro (&Qmenu_bar_update_hook); Qmenu_bar_update_hook = intern ("menu-bar-update-hook"); staticpro (&Qoverriding_terminal_local_map); Qoverriding_terminal_local_map = intern ("overriding-terminal-local-map"); staticpro (&Qoverriding_local_map); Qoverriding_local_map = intern ("overriding-local-map"); staticpro (&Qwindow_scroll_functions); Qwindow_scroll_functions = intern ("window-scroll-functions"); staticpro (&Qredisplay_end_trigger_functions); Qredisplay_end_trigger_functions = intern ("redisplay-end-trigger-functions"); staticpro (&last_arrow_position); staticpro (&last_arrow_string); last_arrow_position = Qnil; last_arrow_string = Qnil; DEFVAR_LISP ("global-mode-string", &Vglobal_mode_string, "String (or mode line construct) included (normally) in `mode-line-format'."); Vglobal_mode_string = Qnil; DEFVAR_LISP ("overlay-arrow-position", &Voverlay_arrow_position, "Marker for where to display an arrow on top of the buffer text.\n\ This must be the beginning of a line in order to work.\n\ See also `overlay-arrow-string'."); Voverlay_arrow_position = Qnil; DEFVAR_LISP ("overlay-arrow-string", &Voverlay_arrow_string, "String to display as an arrow. See also `overlay-arrow-position'."); Voverlay_arrow_string = Qnil; DEFVAR_INT ("scroll-step", &scroll_step, "*The number of lines to try scrolling a window by when point moves out.\n\ If that fails to bring point back on frame, point is centered instead.\n\ If this is zero, point is always centered after it moves off frame."); DEFVAR_INT ("debug-end-pos", &debug_end_pos, "Don't ask"); DEFVAR_BOOL ("truncate-partial-width-windows", &truncate_partial_width_windows, "*Non-nil means truncate lines in all windows less than full frame wide."); truncate_partial_width_windows = 1; DEFVAR_BOOL ("mode-line-inverse-video", &mode_line_inverse_video, "*Non-nil means use inverse video for the mode line."); mode_line_inverse_video = 1; DEFVAR_INT ("line-number-display-limit", &line_number_display_limit, "*Maximum buffer size for which line number should be displayed."); line_number_display_limit = 1000000; DEFVAR_BOOL ("highlight-nonselected-windows", &highlight_nonselected_windows, "*Non-nil means highlight region even in nonselected windows."); highlight_nonselected_windows = 1; DEFVAR_BOOL ("multiple-frames", &multiple_frames, "Non-nil if more than one frame is visible on this display.\n\ Minibuffer-only frames don't count, but iconified frames do.\n\ This variable is not guaranteed to be accurate except while processing\n\ `frame-title-format' and `icon-title-format'."); DEFVAR_LISP ("frame-title-format", &Vframe_title_format, "Template for displaying the titlebar of visible frames.\n\ \(Assuming the window manager supports this feature.)\n\ This variable has the same structure as `mode-line-format' (which see),\n\ and is used only on frames for which no explicit name has been set\n\ \(see `modify-frame-parameters')."); DEFVAR_LISP ("icon-title-format", &Vicon_title_format, "Template for displaying the titlebar of an iconified frame.\n\ \(Assuming the window manager supports this feature.)\n\ This variable has the same structure as `mode-line-format' (which see),\n\ and is used only on frames for which no explicit name has been set\n\ \(see `modify-frame-parameters')."); Vicon_title_format = Vframe_title_format = Fcons (intern ("multiple-frames"), Fcons (build_string ("%b"), Fcons (Fcons (build_string (""), Fcons (intern ("invocation-name"), Fcons (build_string ("@"), Fcons (intern ("system-name"), Qnil)))), Qnil))); DEFVAR_LISP ("message-log-max", &Vmessage_log_max, "Maximum number of lines to keep in the message log buffer.\n\ If nil, disable message logging. If t, log messages but don't truncate\n\ the buffer when it becomes large."); XSETFASTINT (Vmessage_log_max, 50); DEFVAR_LISP ("window-size-change-functions", &Vwindow_size_change_functions, "Functions called before redisplay, if window sizes have changed.\n\ The value should be a list of functions that take one argument.\n\ Just before redisplay, for each frame, if any of its windows have changed\n\ size since the last redisplay, or have been split or deleted,\n\ all the functions in the list are called, with the frame as argument."); Vwindow_size_change_functions = Qnil; DEFVAR_LISP ("window-scroll-functions", &Vwindow_scroll_functions, "List of Functions to call before redisplaying a window with scrolling.\n\ Each function is called with two arguments, the window\n\ and its new display-start position. Note that the value of `window-end'\n\ is not valid when these functions are called."); Vwindow_scroll_functions = Qnil; } /* initialize the window system */ init_xdisp () { Lisp_Object root_window; #ifndef COMPILER_REGISTER_BUG register #endif /* COMPILER_REGISTER_BUG */ struct window *mini_w; this_line_bufpos = 0; mini_w = XWINDOW (minibuf_window); root_window = FRAME_ROOT_WINDOW (XFRAME (WINDOW_FRAME (mini_w))); echo_area_glyphs = 0; previous_echo_glyphs = 0; if (!noninteractive) { FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (root_window))); XSETFASTINT (XWINDOW (root_window)->top, 0); set_window_height (root_window, FRAME_HEIGHT (f) - 1, 0); XSETFASTINT (mini_w->top, FRAME_HEIGHT (f) - 1); set_window_height (minibuf_window, 1, 0); XSETFASTINT (XWINDOW (root_window)->width, FRAME_WIDTH (f)); XSETFASTINT (mini_w->width, FRAME_WIDTH (f)); } } emacs-19.30/src/xfaces.c100444 12120 1 103035 6054611450 13347 0ustar rmsdaemon/* "Face" primitives. Copyright (C) 1993, 1994 Free Software Foundation. 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. */ /* This is derived from work by Lucid (some parts very loosely so). */ #include #include #include #include "lisp.h" #ifdef HAVE_FACES #ifdef HAVE_X_WINDOWS #include "xterm.h" #endif #ifdef MSDOS #include "dosfns.h" #endif #include "buffer.h" #include "dispextern.h" #include "frame.h" #include "blockinput.h" #include "window.h" #include "intervals.h" #ifdef HAVE_X_WINDOWS /* Compensate for bug in Xos.h on some systems, on which it requires time.h. On some such systems, Xos.h tries to redefine struct timeval and struct timezone if USG is #defined while it is #included. */ #ifdef XOS_NEEDS_TIME_H #include #undef USG #include #define USG #define __TIMEVAL__ #else #include #endif #endif /* HAVE_X_WINDOWS */ /* An explanation of the face data structures. */ /* ========================= Face Data Structures ========================= Let FACE-NAME be a symbol naming a face. Let FACE-VECTOR be (assq FACE-NAME (frame-face-alist FRAME)) FACE-VECTOR is either nil, or a vector of the form [face NAME ID FONT FOREGROUND BACKGROUND BACKGROUND-PIXMAP UNDERLINE-P] where face is the symbol `face', NAME is the symbol with which this vector is associated (a backpointer), ID is the face ID, an integer used internally by the C code to identify the face, FONT, FOREGROUND, and BACKGROUND are strings naming the fonts and colors to use with the face, BACKGROUND-PIXMAP is the name of an x bitmap filename, which we don't use right now, and UNDERLINE-P is non-nil if the face should be underlined. If any of these elements are nil, that parameter is considered unspecified; parameters from faces specified by lower-priority overlays or text properties, or the parameters of the frame itself, can show through. (lisp/faces.el maintains these lists.) (assq FACE-NAME global-face-data) returns a vector describing the global parameters for that face. Let PARAM-FACE be FRAME->output_data.x->param_faces[Faref (FACE-VECTOR, 2)]. PARAM_FACE is a struct face whose members are the Xlib analogues of the parameters in FACE-VECTOR. If an element of FACE-VECTOR is nil, then the corresponding member of PARAM_FACE is FACE_DEFAULT. These faces are called "parameter faces", because they're the ones lisp manipulates to control what gets displayed. Elements 0 and 1 of FRAME->output_data.x->param_faces are special - they describe the default and mode line faces. None of the faces in param_faces have GC's. (See src/dispextern.h for the definiton of struct face. lisp/faces.el maintains the isomorphism between face_alist and param_faces.) The functions compute_char_face and compute_glyph_face find and combine the parameter faces associated with overlays and text properties. The resulting faces are called "computed faces"; none of their members are FACE_DEFAULT; they are completely specified. They then call intern_compute_face to search FRAME->output_data.x->computed_faces for a matching face, add one if none is found, and return the index into FRAME->output_data.x->computed_faces. FRAME's glyph matrices use these indices to record the faces of the matrix characters, and the X display hooks consult compute_faces to decide how to display these characters. Elements 0 and 1 of computed_faces always describe the default and mode-line faces. Each computed face belongs to a particular frame. Computed faces have graphics contexts some of the time. intern_face builds a GC for a specified computed face if it doesn't have one already. clear_face_cache clears out the GCs of all computed faces. This is done from time to time so that we don't hold on to lots of GCs that are no longer needed. If a computed face has 0 as its font, it is unused, and can be reused by new_computed_face. Constraints: Symbols naming faces must have associations on all frames; for any FRAME, for all FACE-NAME, if (assq FACE-NAME (frame-face-alist FRAME)) is non-nil, it must be non-nil for all frames. Analogously, indices into param_faces must be valid on all frames; if param_faces[i] is a non-zero face pointer on one frame, then it must be filled in on all frames. Code assumes that face ID's can be used on any frame. Some subtleties: Why do we keep param_faces and computed_faces separate? computed_faces contains an element for every combination of facial parameters we have ever displayed. indices into param_faces have to be valid on all frames. If they were the same array, then that array would grow very large on all frames, because any facial combination displayed on any frame would need to be a valid entry on all frames. */ /* Definitions and declarations. */ /* The number of face-id's in use (same for all frames). */ static int next_face_id; /* The number of the face to use to indicate the region. */ static int region_face; /* This is what appears in a slot in a face to signify that the face does not specify that display aspect. */ #define FACE_DEFAULT (~0) Lisp_Object Qface, Qmouse_face; Lisp_Object Qpixmap_spec_p; int face_name_id_number ( /* FRAME_PTR, Lisp_Object name */ ); struct face *intern_face ( /* FRAME_PTR, struct face * */ ); static int new_computed_face ( /* FRAME_PTR, struct face * */ ); static int intern_computed_face ( /* FRAME_PTR, struct face * */ ); static void ensure_face_ready ( /* FRAME_PTR, int id */ ); void recompute_basic_faces ( /* FRAME_PTR f */ ); /* Allocating, copying, and comparing struct faces. */ /* Allocate a new face */ static struct face * allocate_face () { struct face *result = (struct face *) xmalloc (sizeof (struct face)); bzero (result, sizeof (struct face)); result->font = (XFontStruct *) FACE_DEFAULT; result->foreground = FACE_DEFAULT; result->background = FACE_DEFAULT; result->stipple = FACE_DEFAULT; return result; } /* Make a new face that's a copy of an existing one. */ static struct face * copy_face (face) struct face *face; { struct face *result = allocate_face (); result->font = face->font; result->foreground = face->foreground; result->background = face->background; result->stipple = face->stipple; result->underline = face->underline; result->pixmap_h = face->pixmap_h; result->pixmap_w = face->pixmap_w; return result; } static int face_eql (face1, face2) struct face *face1, *face2; { return ( face1->font == face2->font && face1->foreground == face2->foreground && face1->background == face2->background && face1->stipple == face2->stipple && face1->underline == face2->underline); } /* Managing graphics contexts of faces. */ #ifdef HAVE_X_WINDOWS /* Given a computed face, construct its graphics context if necessary. */ struct face * intern_face (f, face) struct frame *f; struct face *face; { GC gc; XGCValues xgcv; unsigned long mask; if (face->gc) return face; BLOCK_INPUT; if (face->foreground != FACE_DEFAULT) xgcv.foreground = face->foreground; else xgcv.foreground = f->output_data.x->foreground_pixel; if (face->background != FACE_DEFAULT) xgcv.background = face->background; else xgcv.background = f->output_data.x->background_pixel; if (face->font && face->font != (XFontStruct *) FACE_DEFAULT) xgcv.font = face->font->fid; else xgcv.font = f->output_data.x->font->fid; xgcv.graphics_exposures = 0; mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures; if (face->stipple && face->stipple != FACE_DEFAULT) { xgcv.fill_style = FillStippled; xgcv.stipple = x_bitmap_pixmap (f, face->stipple); mask |= GCFillStyle | GCStipple; } gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), mask, &xgcv); face->gc = gc; UNBLOCK_INPUT; return face; } /* Clear out all graphics contexts for all computed faces except for the default and mode line faces. This should be done from time to time just to avoid keeping too many graphics contexts that are no longer needed. */ void clear_face_cache () { Lisp_Object tail, frame; BLOCK_INPUT; FOR_EACH_FRAME (tail, frame) { FRAME_PTR f = XFRAME (frame); if (FRAME_X_P (f)) { int i; Display *dpy = FRAME_X_DISPLAY (f); for (i = 2; i < FRAME_N_COMPUTED_FACES (f); i++) { struct face *face = FRAME_COMPUTED_FACES (f) [i]; if (face->gc) XFreeGC (dpy, face->gc); face->gc = 0; } } } UNBLOCK_INPUT; } /* Allocating, freeing, and duplicating fonts, colors, and pixmaps. These functions operate on param faces only. Computed faces get their fonts, colors and pixmaps by merging param faces. */ static XFontStruct * load_font (f, name) struct frame *f; Lisp_Object name; { XFontStruct *font; if (NILP (name)) return (XFontStruct *) FACE_DEFAULT; CHECK_STRING (name, 0); BLOCK_INPUT; font = XLoadQueryFont (FRAME_X_DISPLAY (f), (char *) XSTRING (name)->data); UNBLOCK_INPUT; if (! font) Fsignal (Qerror, Fcons (build_string ("undefined font"), Fcons (name, Qnil))); return font; } static void unload_font (f, font) struct frame *f; XFontStruct *font; { int len = FRAME_N_COMPUTED_FACES (f); int i; if (!font || font == ((XFontStruct *) FACE_DEFAULT)) return; BLOCK_INPUT; /* Invalidate any computed faces which use this font, and free their GC's if they have any. */ for (i = 2; i < len; i++) { struct face *face = FRAME_COMPUTED_FACES (f)[i]; if (face->font == font) { Display *dpy = FRAME_X_DISPLAY (f); if (face->gc) XFreeGC (dpy, face->gc); face->gc = 0; /* This marks the computed face as available to reuse. */ face->font = 0; } } XFreeFont (FRAME_X_DISPLAY (f), font); UNBLOCK_INPUT; } static unsigned long load_color (f, name) struct frame *f; Lisp_Object name; { XColor color; int result; if (NILP (name)) return FACE_DEFAULT; CHECK_STRING (name, 0); /* if the colormap is full, defined_color will return a best match to the values in an an existing cell. */ result = defined_color(f, (char *) XSTRING (name)->data, &color, 1); if (! result) Fsignal (Qerror, Fcons (build_string ("undefined color"), Fcons (name, Qnil))); return (unsigned long) color.pixel; } static void unload_color (f, pixel) struct frame *f; unsigned long pixel; { Colormap cmap; Display *dpy = FRAME_X_DISPLAY (f); int class = FRAME_X_DISPLAY_INFO (f)->visual->class; if (pixel == FACE_DEFAULT || pixel == BLACK_PIX_DEFAULT (f) || pixel == WHITE_PIX_DEFAULT (f)) return; cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (dpy)); /* If display has an immutable color map, freeing colors is not necessary and some servers don't allow it. So don't do it. */ if (! (class == StaticColor || class == StaticGray || class == TrueColor)) { int len = FRAME_N_COMPUTED_FACES (f); int i; BLOCK_INPUT; /* Invalidate any computed faces which use this color, and free their GC's if they have any. */ for (i = 2; i < len; i++) { struct face *face = FRAME_COMPUTED_FACES (f)[i]; if (face->foreground == pixel || face->background == pixel) { Display *dpy = FRAME_X_DISPLAY (f); if (face->gc) XFreeGC (dpy, face->gc); face->gc = 0; /* This marks the computed face as available to reuse. */ face->font = 0; } } XFreeColors (dpy, cmap, &pixel, 1, (unsigned long)0); UNBLOCK_INPUT; } } DEFUN ("pixmap-spec-p", Fpixmap_spec_p, Spixmap_spec_p, 1, 1, 0, "Return t if ARG is a valid pixmap specification.") (arg) Lisp_Object arg; { Lisp_Object height, width; return ((STRINGP (arg) || (CONSP (arg) && CONSP (XCONS (arg)->cdr) && CONSP (XCONS (XCONS (arg)->cdr)->cdr) && NILP (XCONS (XCONS (XCONS (arg)->cdr)->cdr)->cdr) && (width = XCONS (arg)->car, INTEGERP (width)) && (height = XCONS (XCONS (arg)->cdr)->car, INTEGERP (height)) && STRINGP (XCONS (XCONS (XCONS (arg)->cdr)->cdr)->car) && XINT (width) > 0 && XINT (height) > 0 /* The string must have enough bits for width * height. */ && ((XSTRING (XCONS (XCONS (XCONS (arg)->cdr)->cdr)->car)->size * (BITS_PER_INT / sizeof (int))) >= XFASTINT (width) * XFASTINT (height)))) ? Qt : Qnil); } /* Load a bitmap according to NAME (which is either a file name or a pixmap spec). Return the bitmap_id (see xfns.c) or get an error if NAME is invalid. Store the bitmap width in *W_PTR and height in *H_PTR. */ static long load_pixmap (f, name, w_ptr, h_ptr) FRAME_PTR f; Lisp_Object name; unsigned int *w_ptr, *h_ptr; { int bitmap_id; Lisp_Object tem; if (NILP (name)) return FACE_DEFAULT; tem = Fpixmap_spec_p (name); if (NILP (tem)) wrong_type_argument (Qpixmap_spec_p, name); BLOCK_INPUT; if (CONSP (name)) { /* Decode a bitmap spec into a bitmap. */ int h, w; Lisp_Object bits; w = XINT (Fcar (name)); h = XINT (Fcar (Fcdr (name))); bits = Fcar (Fcdr (Fcdr (name))); bitmap_id = x_create_bitmap_from_data (f, XSTRING (bits)->data, w, h); } else { /* It must be a string -- a file name. */ bitmap_id = x_create_bitmap_from_file (f, name); } UNBLOCK_INPUT; if (bitmap_id < 0) Fsignal (Qerror, Fcons (build_string ("invalid or undefined bitmap"), Fcons (name, Qnil))); *w_ptr = x_bitmap_width (f, bitmap_id); *h_ptr = x_bitmap_height (f, bitmap_id); return bitmap_id; } #else /* !HAVE_X_WINDOWS */ /* Stubs for MSDOS when not under X. */ struct face * intern_face (f, face) struct frame *f; struct face *face; { return face; } void clear_face_cache () { /* No action. */ } #ifdef MSDOS unsigned long load_color (f, name) FRAME_PTR f; Lisp_Object name; { Lisp_Object result; if (NILP (name)) return FACE_DEFAULT; CHECK_STRING (name, 0); result = call1 (Qmsdos_color_translate, name); if (INTEGERP (result)) return XINT (result); else Fsignal (Qerror, Fcons (build_string ("undefined color"), Fcons (name, Qnil))); } #endif #endif /* !HAVE_X_WINDOWS */ /* Managing parameter face arrays for frames. */ void init_frame_faces (f) FRAME_PTR f; { ensure_face_ready (f, 0); ensure_face_ready (f, 1); FRAME_N_COMPUTED_FACES (f) = 0; FRAME_SIZE_COMPUTED_FACES (f) = 0; new_computed_face (f, FRAME_PARAM_FACES (f)[0]); new_computed_face (f, FRAME_PARAM_FACES (f)[1]); recompute_basic_faces (f); #ifdef MULTI_FRAME /* Find another X frame. */ { Lisp_Object tail, frame, result; result = Qnil; FOR_EACH_FRAME (tail, frame) if (FRAME_X_P (XFRAME (frame)) && XFRAME (frame) != f) { result = frame; break; } /* If we didn't find any X frames other than f, then we don't need any faces other than 0 and 1, so we're okay. Otherwise, make sure that all faces valid on the selected frame are also valid on this new frame. */ if (FRAMEP (result)) { int i; int n_faces = FRAME_N_PARAM_FACES (XFRAME (result)); struct face **faces = FRAME_PARAM_FACES (XFRAME (result)); for (i = 2; i < n_faces; i++) if (faces[i]) ensure_face_ready (f, i); } } #endif /* MULTI_FRAME */ } /* Called from Fdelete_frame. */ void free_frame_faces (f) struct frame *f; { Display *dpy = FRAME_X_DISPLAY (f); int i; BLOCK_INPUT; for (i = 0; i < FRAME_N_PARAM_FACES (f); i++) { struct face *face = FRAME_PARAM_FACES (f) [i]; if (face) { unload_font (f, face->font); unload_color (f, face->foreground); unload_color (f, face->background); x_destroy_bitmap (f, face->stipple); xfree (face); } } xfree (FRAME_PARAM_FACES (f)); FRAME_PARAM_FACES (f) = 0; FRAME_N_PARAM_FACES (f) = 0; /* All faces in FRAME_COMPUTED_FACES use resources copied from FRAME_PARAM_FACES; we can free them without fuss. But we do free the GCs and the face objects themselves. */ for (i = 0; i < FRAME_N_COMPUTED_FACES (f); i++) { struct face *face = FRAME_COMPUTED_FACES (f) [i]; if (face) { if (face->gc) XFreeGC (dpy, face->gc); xfree (face); } } xfree (FRAME_COMPUTED_FACES (f)); FRAME_COMPUTED_FACES (f) = 0; FRAME_N_COMPUTED_FACES (f) = 0; UNBLOCK_INPUT; } /* Interning faces in a frame's face array. */ static int new_computed_face (f, new_face) struct frame *f; struct face *new_face; { int len = FRAME_N_COMPUTED_FACES (f); int i; /* Search for an unused computed face in the middle of the table. */ for (i = 0; i < len; i++) { struct face *face = FRAME_COMPUTED_FACES (f)[i]; if (face->font == 0) { FRAME_COMPUTED_FACES (f)[i] = copy_face (new_face); return i; } } if (i >= FRAME_SIZE_COMPUTED_FACES (f)) { int new_size = i + 32; FRAME_COMPUTED_FACES (f) = (struct face **) (FRAME_SIZE_COMPUTED_FACES (f) == 0 ? xmalloc (new_size * sizeof (struct face *)) : xrealloc (FRAME_COMPUTED_FACES (f), new_size * sizeof (struct face *))); FRAME_SIZE_COMPUTED_FACES (f) = new_size; } i = FRAME_N_COMPUTED_FACES (f)++; FRAME_COMPUTED_FACES (f)[i] = copy_face (new_face); return i; } /* Find a match for NEW_FACE in a FRAME's computed face array, and add it if we don't find one. */ static int intern_computed_face (f, new_face) struct frame *f; struct face *new_face; { int len = FRAME_N_COMPUTED_FACES (f); int i; /* Search for a computed face already on F equivalent to FACE. */ for (i = 0; i < len; i++) { if (! FRAME_COMPUTED_FACES (f)[i]) abort (); if (face_eql (new_face, FRAME_COMPUTED_FACES (f)[i])) return i; } /* We didn't find one; add a new one. */ return new_computed_face (f, new_face); } /* Make parameter face id ID valid on frame F. */ static void ensure_face_ready (f, id) struct frame *f; int id; { if (FRAME_N_PARAM_FACES (f) <= id) { int n = id + 10; int i; if (!FRAME_N_PARAM_FACES (f)) FRAME_PARAM_FACES (f) = (struct face **) xmalloc (sizeof (struct face *) * n); else FRAME_PARAM_FACES (f) = (struct face **) xrealloc (FRAME_PARAM_FACES (f), sizeof (struct face *) * n); bzero (FRAME_PARAM_FACES (f) + FRAME_N_PARAM_FACES (f), (n - FRAME_N_PARAM_FACES (f)) * sizeof (struct face *)); FRAME_N_PARAM_FACES (f) = n; } if (FRAME_PARAM_FACES (f) [id] == 0) FRAME_PARAM_FACES (f) [id] = allocate_face (); } #ifdef HAVE_X_WINDOWS /* Return non-zero if FONT1 and FONT2 have the same width. We do not check the height, because we can now deal with different heights. We assume that they're both character-cell fonts. */ int same_size_fonts (font1, font2) XFontStruct *font1, *font2; { XCharStruct *bounds1 = &font1->min_bounds; XCharStruct *bounds2 = &font2->min_bounds; return (bounds1->width == bounds2->width); } /* Update the line_height of frame F according to the biggest font in any face. Return nonzero if if line_height changes. */ int frame_update_line_height (f) FRAME_PTR f; { int i; int biggest = FONT_HEIGHT (f->output_data.x->font); for (i = 0; i < f->output_data.x->n_param_faces; i++) if (f->output_data.x->param_faces[i] != 0 && f->output_data.x->param_faces[i]->font != (XFontStruct *) FACE_DEFAULT) { int height = FONT_HEIGHT (f->output_data.x->param_faces[i]->font); if (height > biggest) biggest = height; } if (biggest == f->output_data.x->line_height) return 0; f->output_data.x->line_height = biggest; return 1; } #endif /* not HAVE_X_WINDOWS */ /* Modify face TO by copying from FROM all properties which have nondefault settings. */ static void merge_faces (from, to) struct face *from, *to; { /* Only merge the font if it's the same width as the base font. Otherwise ignore it, since we can't handle it properly. */ if (from->font != (XFontStruct *) FACE_DEFAULT && same_size_fonts (from->font, to->font)) to->font = from->font; if (from->foreground != FACE_DEFAULT) to->foreground = from->foreground; if (from->background != FACE_DEFAULT) to->background = from->background; if (from->stipple != FACE_DEFAULT) { to->stipple = from->stipple; to->pixmap_h = from->pixmap_h; to->pixmap_w = from->pixmap_w; } if (from->underline) to->underline = from->underline; } /* Set up the basic set of facial parameters, based on the frame's data; all faces are deltas applied to this. */ static void compute_base_face (f, face) FRAME_PTR f; struct face *face; { face->gc = 0; face->foreground = FRAME_FOREGROUND_PIXEL (f); face->background = FRAME_BACKGROUND_PIXEL (f); face->font = FRAME_FONT (f); face->stipple = 0; face->underline = 0; } /* Return the face ID to use to display a special glyph which selects FACE_CODE as the face ID, assuming that ordinarily the face would be CURRENT_FACE. F is the frame. */ int compute_glyph_face (f, face_code, current_face) struct frame *f; int face_code, current_face; { struct face face; face = *FRAME_COMPUTED_FACES (f)[current_face]; if (face_code >= 0 && face_code < FRAME_N_PARAM_FACES (f) && FRAME_PARAM_FACES (f) [face_code] != 0) merge_faces (FRAME_PARAM_FACES (f) [face_code], &face); return intern_computed_face (f, &face); } /* Return the face ID to use to display a special glyph which selects FACE_CODE as the face ID, assuming that ordinarily the face would be CURRENT_FACE. F is the frame. */ int compute_glyph_face_1 (f, face_name, current_face) struct frame *f; Lisp_Object face_name; int current_face; { struct face face; face = *FRAME_COMPUTED_FACES (f)[current_face]; if (!NILP (face_name)) { int facecode = face_name_id_number (f, face_name); if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f) && FRAME_PARAM_FACES (f) [facecode] != 0) merge_faces (FRAME_PARAM_FACES (f) [facecode], &face); } return intern_computed_face (f, &face); } /* Return the face ID associated with a buffer position POS. Store into *ENDPTR the position at which a different face is needed. This does not take account of glyphs that specify their own face codes. F is the frame in use for display, and W is a window displaying the current buffer. REGION_BEG, REGION_END delimit the region, so it can be highlighted. LIMIT is a position not to scan beyond. That is to limit the time this function can take. If MOUSE is nonzero, use the character's mouse-face, not its face. */ int compute_char_face (f, w, pos, region_beg, region_end, endptr, limit, mouse) struct frame *f; struct window *w; int pos; int region_beg, region_end; int *endptr; int limit; int mouse; { struct face face; Lisp_Object prop, position; int i, j, noverlays; int facecode; Lisp_Object *overlay_vec; Lisp_Object frame; int endpos; Lisp_Object propname; /* W must display the current buffer. We could write this function to use the frame and buffer of W, but right now it doesn't. */ if (XBUFFER (w->buffer) != current_buffer) abort (); XSETFRAME (frame, f); endpos = ZV; if (pos < region_beg && region_beg < endpos) endpos = region_beg; XSETFASTINT (position, pos); if (mouse) propname = Qmouse_face; else propname = Qface; prop = Fget_text_property (position, propname, w->buffer); { Lisp_Object limit1, end; XSETFASTINT (limit1, (limit < endpos ? limit : endpos)); end = Fnext_single_property_change (position, propname, w->buffer, limit1); if (INTEGERP (end)) endpos = XINT (end); } { int next_overlay; int len; /* First try with room for 40 overlays. */ len = 40; overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); noverlays = overlays_at (pos, 0, &overlay_vec, &len, &next_overlay, (int *) 0); /* If there are more than 40, make enough space for all, and try again. */ if (noverlays > len) { len = noverlays; overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); noverlays = overlays_at (pos, 0, &overlay_vec, &len, &next_overlay, (int *) 0); } if (next_overlay < endpos) endpos = next_overlay; } *endptr = endpos; /* Optimize the default case. */ if (noverlays == 0 && NILP (prop) && !(pos >= region_beg && pos < region_end)) return 0; compute_base_face (f, &face); if (CONSP (prop)) { /* We have a list of faces, merge them in reverse order */ Lisp_Object length; int len; Lisp_Object *faces; length = Fsafe_length (prop); len = XFASTINT (length); /* Put them into an array */ faces = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); for (j = 0; j < len; j++) { faces[j] = Fcar (prop); prop = Fcdr (prop); } /* So that we can merge them in the reverse order */ for (j = len - 1; j >= 0; j--) { facecode = face_name_id_number (f, faces[j]); if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f) && FRAME_PARAM_FACES (f) [facecode] != 0) merge_faces (FRAME_PARAM_FACES (f) [facecode], &face); } } else if (!NILP (prop)) { facecode = face_name_id_number (f, prop); if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f) && FRAME_PARAM_FACES (f) [facecode] != 0) merge_faces (FRAME_PARAM_FACES (f) [facecode], &face); } noverlays = sort_overlays (overlay_vec, noverlays, w); /* Now merge the overlay data in that order. */ for (i = 0; i < noverlays; i++) { prop = Foverlay_get (overlay_vec[i], propname); if (CONSP (prop)) { /* We have a list of faces, merge them in reverse order */ Lisp_Object length; int len; Lisp_Object *faces; length = Fsafe_length (prop); len = XFASTINT (length); /* Put them into an array */ faces = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); for (j = 0; j < len; j++) { faces[j] = Fcar (prop); prop = Fcdr (prop); } /* So that we can merge them in the reverse order */ for (j = len - 1; j >= 0; j--) { facecode = face_name_id_number (f, faces[j]); if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f) && FRAME_PARAM_FACES (f) [facecode] != 0) merge_faces (FRAME_PARAM_FACES (f) [facecode], &face); } } else if (!NILP (prop)) { Lisp_Object oend; int oendpos; facecode = face_name_id_number (f, prop); if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f) && FRAME_PARAM_FACES (f) [facecode] != 0) merge_faces (FRAME_PARAM_FACES (f)[facecode], &face); oend = OVERLAY_END (overlay_vec[i]); oendpos = OVERLAY_POSITION (oend); if (oendpos < endpos) endpos = oendpos; } } if (pos >= region_beg && pos < region_end) { if (region_end < endpos) endpos = region_end; if (region_face >= 0 && region_face < next_face_id) merge_faces (FRAME_PARAM_FACES (f)[region_face], &face); } *endptr = endpos; return intern_computed_face (f, &face); } /* Recompute the GC's for the default and modeline faces. We call this after changing frame parameters on which those GC's depend. */ void recompute_basic_faces (f) FRAME_PTR f; { /* If the frame's faces haven't been initialized yet, don't worry about this stuff. */ if (FRAME_N_PARAM_FACES (f) < 2) return; BLOCK_INPUT; if (FRAME_DEFAULT_FACE (f)->gc) XFreeGC (FRAME_X_DISPLAY (f), FRAME_DEFAULT_FACE (f)->gc); if (FRAME_MODE_LINE_FACE (f)->gc) XFreeGC (FRAME_X_DISPLAY (f), FRAME_MODE_LINE_FACE (f)->gc); compute_base_face (f, FRAME_DEFAULT_FACE (f)); compute_base_face (f, FRAME_MODE_LINE_FACE (f)); merge_faces (FRAME_DEFAULT_PARAM_FACE (f), FRAME_DEFAULT_FACE (f)); merge_faces (FRAME_MODE_LINE_PARAM_FACE (f), FRAME_MODE_LINE_FACE (f)); intern_face (f, FRAME_DEFAULT_FACE (f)); intern_face (f, FRAME_MODE_LINE_FACE (f)); UNBLOCK_INPUT; } /* Lisp interface. */ DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist, 1, 1, 0, "") (frame) Lisp_Object frame; { CHECK_FRAME (frame, 0); return XFRAME (frame)->face_alist; } DEFUN ("set-frame-face-alist", Fset_frame_face_alist, Sset_frame_face_alist, 2, 2, 0, "") (frame, value) Lisp_Object frame, value; { CHECK_FRAME (frame, 0); XFRAME (frame)->face_alist = value; return value; } DEFUN ("make-face-internal", Fmake_face_internal, Smake_face_internal, 1, 1, 0, "Create face number FACE-ID on all frames.") (face_id) Lisp_Object face_id; { Lisp_Object rest, frame; int id = XINT (face_id); CHECK_NUMBER (face_id, 0); if (id < 0 || id >= next_face_id) error ("Face id out of range"); FOR_EACH_FRAME (rest, frame) { if (FRAME_X_P (XFRAME (frame))) ensure_face_ready (XFRAME (frame), id); } return Qnil; } DEFUN ("set-face-attribute-internal", Fset_face_attribute_internal, Sset_face_attribute_internal, 4, 4, 0, "") (face_id, attr_name, attr_value, frame) Lisp_Object face_id, attr_name, attr_value, frame; { struct face *face; struct frame *f; int magic_p; int id; int garbaged = 0; CHECK_FRAME (frame, 0); CHECK_NUMBER (face_id, 0); CHECK_SYMBOL (attr_name, 0); f = XFRAME (frame); id = XINT (face_id); if (id < 0 || id >= next_face_id) error ("Face id out of range"); if (! FRAME_X_P (f)) return Qnil; ensure_face_ready (f, id); face = FRAME_PARAM_FACES (f) [XFASTINT (face_id)]; if (EQ (attr_name, intern ("font"))) { #if defined (MSDOS) && !defined (HAVE_X_WINDOWS) /* The one and only font. Must *not* be zero (which is taken to mean an unused face nowadays). */ face->font = (XFontStruct *)1 ; #else XFontStruct *font = load_font (f, attr_value); if (face->font != f->output_data.x->font) unload_font (f, face->font); face->font = font; if (frame_update_line_height (f)) x_set_window_size (f, 0, f->width, f->height); /* Must clear cache, since it might contain the font we just got rid of. */ garbaged = 1; #endif } else if (EQ (attr_name, intern ("foreground"))) { unsigned long new_color = load_color (f, attr_value); unload_color (f, face->foreground); face->foreground = new_color; garbaged = 1; } else if (EQ (attr_name, intern ("background"))) { unsigned long new_color = load_color (f, attr_value); unload_color (f, face->background); #if defined (MSDOS) && !defined (HAVE_X_WINDOWS) new_color &= ~8; /* Bright would give blinking characters. */ #endif face->background = new_color; garbaged = 1; } else if (EQ (attr_name, intern ("background-pixmap"))) { unsigned int w, h; unsigned long new_pixmap = load_pixmap (f, attr_value, &w, &h); x_destroy_bitmap (f, face->stipple); face->stipple = new_pixmap; face->pixmap_w = w; face->pixmap_h = h; garbaged = 1; } else if (EQ (attr_name, intern ("underline"))) { int new = !NILP (attr_value); face->underline = new; } else error ("unknown face attribute"); if (id == 0 || id == 1) recompute_basic_faces (f); /* We must redraw the frame whenever any face font or color changes, because it's possible that a merged (display) face contains the font or color we just replaced. And we must inhibit any Expose events until the redraw is done, since they would try to use the invalid display faces. */ if (garbaged) SET_FRAME_GARBAGED (f); return Qnil; } DEFUN ("internal-next-face-id", Finternal_next_face_id, Sinternal_next_face_id, 0, 0, 0, "") () { return make_number (next_face_id++); } /* Return the face id for name NAME on frame FRAME. (It should be the same for all frames, but it's as easy to use the "right" frame to look it up as to use any other one.) */ int face_name_id_number (f, name) FRAME_PTR f; Lisp_Object name; { Lisp_Object tem; tem = Fcdr (assq_no_quit (name, f->face_alist)); if (NILP (tem)) return 0; CHECK_VECTOR (tem, 0); tem = XVECTOR (tem)->contents[2]; CHECK_NUMBER (tem, 0); return XINT (tem); } /* Emacs initialization. */ void syms_of_xfaces () { Qface = intern ("face"); staticpro (&Qface); Qmouse_face = intern ("mouse-face"); staticpro (&Qmouse_face); Qpixmap_spec_p = intern ("pixmap-spec-p"); staticpro (&Qpixmap_spec_p); DEFVAR_INT ("region-face", ®ion_face, "Face number to use to highlight the region\n\ The region is highlighted with this face\n\ when Transient Mark mode is enabled and the mark is active."); #ifdef HAVE_X_WINDOWS defsubr (&Spixmap_spec_p); #endif defsubr (&Sframe_face_alist); defsubr (&Sset_frame_face_alist); defsubr (&Smake_face_internal); defsubr (&Sset_face_attribute_internal); defsubr (&Sinternal_next_face_id); } #endif /* HAVE_FACES */ emacs-19.30/src/xfns.c100444 12120 1 427526 6051046062 13070 0ustar rmsdaemon/* Functions for the X window system. Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation. 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. */ /* Completely rewritten by Richard Stallman. */ /* Rewritten for X11 by Joseph Arceneaux */ #include #include /* This makes the fields of a Display accessible, in Xlib header files. */ #define XLIB_ILLEGAL_ACCESS #include "lisp.h" #include "xterm.h" #include "frame.h" #include "window.h" #include "buffer.h" #include "dispextern.h" #include "keyboard.h" #include "blockinput.h" #include "paths.h" #ifdef HAVE_X_WINDOWS extern void abort (); #ifndef VMS #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */ #include "bitmaps/gray.xbm" #else #include #endif #else #include "[.bitmaps]gray.xbm" #endif #ifdef USE_X_TOOLKIT #include #ifndef USE_MOTIF #include #include #endif /* USE_MOTIF */ #ifdef USG #undef USG /* ####KLUDGE for Solaris 2.2 and up */ #include #define USG #else #include #endif #include "widget.h" #include "../lwlib/lwlib.h" /* Do the EDITRES protocol if running X11R5 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */ #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES) #define HACK_EDITRES extern void _XEditResCheckMessages (); #endif /* R5 + Athena */ /* Unique id counter for widgets created by the Lucid Widget Library. */ extern LWLIB_ID widget_id_tick; /* This is part of a kludge--see lwlib/xlwmenu.c. */ XFontStruct *xlwmenu_default_font; extern void free_frame_menubar (); #endif /* USE_X_TOOLKIT */ #define min(a,b) ((a) < (b) ? (a) : (b)) #define max(a,b) ((a) > (b) ? (a) : (b)) #ifdef HAVE_X11R4 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy)) #else #define MAXREQUEST(dpy) ((dpy)->max_request_size) #endif /* The name we're using in resource queries. */ Lisp_Object Vx_resource_name; /* The background and shape of the mouse pointer, and shape when not over text or in the modeline. */ Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape; /* The shape when over mouse-sensitive text. */ Lisp_Object Vx_sensitive_text_pointer_shape; /* Color of chars displayed in cursor box. */ Lisp_Object Vx_cursor_fore_pixel; /* Nonzero if using X. */ static int x_in_use; /* Non nil if no window manager is in use. */ Lisp_Object Vx_no_window_manager; /* Search path for bitmap files. */ Lisp_Object Vx_bitmap_file_path; /* Evaluate this expression to rebuild the section of syms_of_xfns that initializes and staticpros the symbols declared below. Note that Emacs 18 has a bug that keeps C-x C-e from being able to evaluate this expression. (progn ;; Accumulate a list of the symbols we want to initialize from the ;; declarations at the top of the file. (goto-char (point-min)) (search-forward "/\*&&& symbols declared here &&&*\/\n") (let (symbol-list) (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)") (setq symbol-list (cons (buffer-substring (match-beginning 1) (match-end 1)) symbol-list)) (forward-line 1)) (setq symbol-list (nreverse symbol-list)) ;; Delete the section of syms_of_... where we initialize the symbols. (search-forward "\n /\*&&& init symbols here &&&*\/\n") (let ((start (point))) (while (looking-at "^ Q") (forward-line 2)) (kill-region start (point))) ;; Write a new symbol initialization section. (while symbol-list (insert (format " %s = intern (\"" (car symbol-list))) (let ((start (point))) (insert (substring (car symbol-list) 1)) (subst-char-in-region start (point) ?_ ?-)) (insert (format "\");\n staticpro (&%s);\n" (car symbol-list))) (setq symbol-list (cdr symbol-list))))) */ /*&&& symbols declared here &&&*/ Lisp_Object Qauto_raise; Lisp_Object Qauto_lower; Lisp_Object Qbackground_color; Lisp_Object Qbar; Lisp_Object Qborder_color; Lisp_Object Qborder_width; Lisp_Object Qbox; Lisp_Object Qcursor_color; Lisp_Object Qcursor_type; Lisp_Object Qfont; Lisp_Object Qforeground_color; Lisp_Object Qgeometry; Lisp_Object Qicon_left; Lisp_Object Qicon_top; Lisp_Object Qicon_type; Lisp_Object Qicon_name; Lisp_Object Qinternal_border_width; Lisp_Object Qleft; Lisp_Object Qmouse_color; Lisp_Object Qnone; Lisp_Object Qparent_id; Lisp_Object Qscroll_bar_width; Lisp_Object Qsuppress_icon; Lisp_Object Qtop; Lisp_Object Qundefined_color; Lisp_Object Qvertical_scroll_bars; Lisp_Object Qvisibility; Lisp_Object Qwindow_id; Lisp_Object Qx_frame_parameter; Lisp_Object Qx_resource_name; Lisp_Object Quser_position; Lisp_Object Quser_size; Lisp_Object Qdisplay; /* The below are defined in frame.c. */ extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth; extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate; extern Lisp_Object Vwindow_system_version; /* Error if we are not connected to X. */ void check_x () { if (! x_in_use) error ("X windows are not in use or not initialized"); } /* Nonzero if using X for display. */ int using_x_p () { return x_in_use; } /* Extract a frame as a FRAME_PTR, defaulting to the selected frame and checking validity for X. */ FRAME_PTR check_x_frame (frame) Lisp_Object frame; { FRAME_PTR f; if (NILP (frame)) f = selected_frame; else { CHECK_LIVE_FRAME (frame, 0); f = XFRAME (frame); } if (! FRAME_X_P (f)) error ("non-X frame used"); return f; } /* Let the user specify an X display with a frame. nil stands for the selected frame--or, if that is not an X frame, the first X display on the list. */ static struct x_display_info * check_x_display_info (frame) Lisp_Object frame; { if (NILP (frame)) { if (FRAME_X_P (selected_frame)) return FRAME_X_DISPLAY_INFO (selected_frame); else if (x_display_list != 0) return x_display_list; else error ("X windows are not in use or not initialized"); } else if (STRINGP (frame)) return x_display_info_for_name (frame); else { FRAME_PTR f; CHECK_LIVE_FRAME (frame, 0); f = XFRAME (frame); if (! FRAME_X_P (f)) error ("non-X frame used"); return FRAME_X_DISPLAY_INFO (f); } } /* Return the Emacs frame-object corresponding to an X window. It could be the frame's main window or an icon window. */ /* This function can be called during GC, so use GC_xxx type test macros. */ struct frame * x_window_to_frame (dpyinfo, wdesc) struct x_display_info *dpyinfo; int wdesc; { Lisp_Object tail, frame; struct frame *f; for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr) { frame = XCONS (tail)->car; if (!GC_FRAMEP (frame)) continue; f = XFRAME (frame); if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo) continue; #ifdef USE_X_TOOLKIT if ((f->output_data.x->edit_widget && XtWindow (f->output_data.x->edit_widget) == wdesc) || f->output_data.x->icon_desc == wdesc) return f; #else /* not USE_X_TOOLKIT */ if (FRAME_X_WINDOW (f) == wdesc || f->output_data.x->icon_desc == wdesc) return f; #endif /* not USE_X_TOOLKIT */ } return 0; } #ifdef USE_X_TOOLKIT /* Like x_window_to_frame but also compares the window with the widget's windows. */ struct frame * x_any_window_to_frame (dpyinfo, wdesc) struct x_display_info *dpyinfo; int wdesc; { Lisp_Object tail, frame; struct frame *f; struct x_output *x; for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr) { frame = XCONS (tail)->car; if (!GC_FRAMEP (frame)) continue; f = XFRAME (frame); if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo) continue; x = f->output_data.x; /* This frame matches if the window is any of its widgets. */ if (wdesc == XtWindow (x->widget) || wdesc == XtWindow (x->column_widget) || wdesc == XtWindow (x->edit_widget)) return f; /* Match if the window is this frame's menubar. */ if (lw_window_is_in_menubar (wdesc, x->menubar_widget)) return f; } return 0; } /* Likewise, but exclude the menu bar widget. */ struct frame * x_non_menubar_window_to_frame (dpyinfo, wdesc) struct x_display_info *dpyinfo; int wdesc; { Lisp_Object tail, frame; struct frame *f; struct x_output *x; for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr) { frame = XCONS (tail)->car; if (!GC_FRAMEP (frame)) continue; f = XFRAME (frame); if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo) continue; x = f->output_data.x; /* This frame matches if the window is any of its widgets. */ if (wdesc == XtWindow (x->widget) || wdesc == XtWindow (x->column_widget) || wdesc == XtWindow (x->edit_widget)) return f; } return 0; } /* Likewise, but consider only the menu bar widget. */ struct frame * x_menubar_window_to_frame (dpyinfo, wdesc) struct x_display_info *dpyinfo; int wdesc; { Lisp_Object tail, frame; struct frame *f; struct x_output *x; for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr) { frame = XCONS (tail)->car; if (!GC_FRAMEP (frame)) continue; f = XFRAME (frame); if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo) continue; x = f->output_data.x; /* Match if the window is this frame's menubar. */ if (lw_window_is_in_menubar (wdesc, x->menubar_widget)) return f; } return 0; } /* Return the frame whose principal (outermost) window is WDESC. If WDESC is some other (smaller) window, we return 0. */ struct frame * x_top_window_to_frame (dpyinfo, wdesc) struct x_display_info *dpyinfo; int wdesc; { Lisp_Object tail, frame; struct frame *f; struct x_output *x; for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr) { frame = XCONS (tail)->car; if (!GC_FRAMEP (frame)) continue; f = XFRAME (frame); if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo) continue; x = f->output_data.x; /* This frame matches if the window is its topmost widget. */ if (wdesc == XtWindow (x->widget)) return f; #if 0 /* I don't know why it did this, but it seems logically wrong, and it causes trouble for MapNotify events. */ /* Match if the window is this frame's menubar. */ if (x->menubar_widget && wdesc == XtWindow (x->menubar_widget)) return f; #endif } return 0; } #endif /* USE_X_TOOLKIT */ /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap id, which is just an int that this section returns. Bitmaps are reference counted so they can be shared among frames. Bitmap indices are guaranteed to be > 0, so a negative number can be used to indicate no bitmap. If you use x_create_bitmap_from_data, then you must keep track of the bitmaps yourself. That is, creating a bitmap from the same data more than once will not be caught. */ /* Functions to access the contents of a bitmap, given an id. */ int x_bitmap_height (f, id) FRAME_PTR f; int id; { return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height; } int x_bitmap_width (f, id) FRAME_PTR f; int id; { return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width; } int x_bitmap_pixmap (f, id) FRAME_PTR f; int id; { return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap; } /* Allocate a new bitmap record. Returns index of new record. */ static int x_allocate_bitmap_record (f) FRAME_PTR f; { struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); int i; if (dpyinfo->bitmaps == NULL) { dpyinfo->bitmaps_size = 10; dpyinfo->bitmaps = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record)); dpyinfo->bitmaps_last = 1; return 1; } if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size) return ++dpyinfo->bitmaps_last; for (i = 0; i < dpyinfo->bitmaps_size; ++i) if (dpyinfo->bitmaps[i].refcount == 0) return i + 1; dpyinfo->bitmaps_size *= 2; dpyinfo->bitmaps = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps, dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record)); return ++dpyinfo->bitmaps_last; } /* Add one reference to the reference count of the bitmap with id ID. */ void x_reference_bitmap (f, id) FRAME_PTR f; int id; { ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount; } /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */ int x_create_bitmap_from_data (f, bits, width, height) struct frame *f; char *bits; unsigned int width, height; { struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); Pixmap bitmap; int id; bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), bits, width, height); if (! bitmap) return -1; id = x_allocate_bitmap_record (f); dpyinfo->bitmaps[id - 1].pixmap = bitmap; dpyinfo->bitmaps[id - 1].file = NULL; dpyinfo->bitmaps[id - 1].refcount = 1; dpyinfo->bitmaps[id - 1].depth = 1; dpyinfo->bitmaps[id - 1].height = height; dpyinfo->bitmaps[id - 1].width = width; return id; } /* Create bitmap from file FILE for frame F. */ int x_create_bitmap_from_file (f, file) struct frame *f; Lisp_Object file; { struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); unsigned int width, height; Pixmap bitmap; int xhot, yhot, result, id; Lisp_Object found; int fd; char *filename; /* Look for an existing bitmap with the same name. */ for (id = 0; id < dpyinfo->bitmaps_last; ++id) { if (dpyinfo->bitmaps[id].refcount && dpyinfo->bitmaps[id].file && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data)) { ++dpyinfo->bitmaps[id].refcount; return id + 1; } } /* Search bitmap-file-path for the file, if appropriate. */ fd = openp (Vx_bitmap_file_path, file, "", &found, 0); if (fd < 0) return -1; close (fd); filename = (char *) XSTRING (found)->data; result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), filename, &width, &height, &bitmap, &xhot, &yhot); if (result != BitmapSuccess) return -1; id = x_allocate_bitmap_record (f); dpyinfo->bitmaps[id - 1].pixmap = bitmap; dpyinfo->bitmaps[id - 1].refcount = 1; dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1); dpyinfo->bitmaps[id - 1].depth = 1; dpyinfo->bitmaps[id - 1].height = height; dpyinfo->bitmaps[id - 1].width = width; strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data); return id; } /* Remove reference to bitmap with id number ID. */ int x_destroy_bitmap (f, id) FRAME_PTR f; int id; { struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); if (id > 0) { --dpyinfo->bitmaps[id - 1].refcount; if (dpyinfo->bitmaps[id - 1].refcount == 0) { BLOCK_INPUT; XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap); if (dpyinfo->bitmaps[id - 1].file) { free (dpyinfo->bitmaps[id - 1].file); dpyinfo->bitmaps[id - 1].file = NULL; } UNBLOCK_INPUT; } } } /* Free all the bitmaps for the display specified by DPYINFO. */ static void x_destroy_all_bitmaps (dpyinfo) struct x_display_info *dpyinfo; { int i; for (i = 0; i < dpyinfo->bitmaps_last; i++) if (dpyinfo->bitmaps[i].refcount > 0) { XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap); if (dpyinfo->bitmaps[i].file) free (dpyinfo->bitmaps[i].file); } dpyinfo->bitmaps_last = 0; } /* Connect the frame-parameter names for X frames to the ways of passing the parameter values to the window system. The name of a parameter, as a Lisp symbol, has an `x-frame-parameter' property which is an integer in Lisp but can be interpreted as an `enum x_frame_parm' in C. */ enum x_frame_parm { X_PARM_FOREGROUND_COLOR, X_PARM_BACKGROUND_COLOR, X_PARM_MOUSE_COLOR, X_PARM_CURSOR_COLOR, X_PARM_BORDER_COLOR, X_PARM_ICON_TYPE, X_PARM_FONT, X_PARM_BORDER_WIDTH, X_PARM_INTERNAL_BORDER_WIDTH, X_PARM_NAME, X_PARM_AUTORAISE, X_PARM_AUTOLOWER, X_PARM_VERT_SCROLL_BAR, X_PARM_VISIBILITY, X_PARM_MENU_BAR_LINES }; struct x_frame_parm_table { char *name; void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ ); }; void x_set_foreground_color (); void x_set_background_color (); void x_set_mouse_color (); void x_set_cursor_color (); void x_set_border_color (); void x_set_cursor_type (); void x_set_icon_type (); void x_set_icon_name (); void x_set_font (); void x_set_border_width (); void x_set_internal_border_width (); void x_explicitly_set_name (); void x_set_autoraise (); void x_set_autolower (); void x_set_vertical_scroll_bars (); void x_set_visibility (); void x_set_menu_bar_lines (); void x_set_scroll_bar_width (); void x_set_unsplittable (); static struct x_frame_parm_table x_frame_parms[] = { "foreground-color", x_set_foreground_color, "background-color", x_set_background_color, "mouse-color", x_set_mouse_color, "cursor-color", x_set_cursor_color, "border-color", x_set_border_color, "cursor-type", x_set_cursor_type, "icon-type", x_set_icon_type, "icon-name", x_set_icon_name, "font", x_set_font, "border-width", x_set_border_width, "internal-border-width", x_set_internal_border_width, "name", x_explicitly_set_name, "auto-raise", x_set_autoraise, "auto-lower", x_set_autolower, "vertical-scroll-bars", x_set_vertical_scroll_bars, "visibility", x_set_visibility, "menu-bar-lines", x_set_menu_bar_lines, "scroll-bar-width", x_set_scroll_bar_width, "unsplittable", x_set_unsplittable, }; /* Attach the `x-frame-parameter' properties to the Lisp symbol names of parameters relevant to X. */ init_x_parm_symbols () { int i; for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++) Fput (intern (x_frame_parms[i].name), Qx_frame_parameter, make_number (i)); } /* Change the parameters of FRAME as specified by ALIST. If a parameter is not specially recognized, do nothing; otherwise call the `x_set_...' function for that parameter. */ void x_set_frame_parameters (f, alist) FRAME_PTR f; Lisp_Object alist; { Lisp_Object tail; /* If both of these parameters are present, it's more efficient to set them both at once. So we wait until we've looked at the entire list before we set them. */ Lisp_Object width, height; /* Same here. */ Lisp_Object left, top; /* Same with these. */ Lisp_Object icon_left, icon_top; /* Record in these vectors all the parms specified. */ Lisp_Object *parms; Lisp_Object *values; int i; int left_no_change = 0, top_no_change = 0; int icon_left_no_change = 0, icon_top_no_change = 0; i = 0; for (tail = alist; CONSP (tail); tail = Fcdr (tail)) i++; parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object)); values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object)); /* Extract parm names and values into those vectors. */ i = 0; for (tail = alist; CONSP (tail); tail = Fcdr (tail)) { Lisp_Object elt, prop, val; elt = Fcar (tail); parms[i] = Fcar (elt); values[i] = Fcdr (elt); i++; } width = height = top = left = Qunbound; icon_left = icon_top = Qunbound; /* Now process them in reverse of specified order. */ for (i--; i >= 0; i--) { Lisp_Object prop, val; prop = parms[i]; val = values[i]; if (EQ (prop, Qwidth)) width = val; else if (EQ (prop, Qheight)) height = val; else if (EQ (prop, Qtop)) top = val; else if (EQ (prop, Qleft)) left = val; else if (EQ (prop, Qicon_top)) icon_top = val; else if (EQ (prop, Qicon_left)) icon_left = val; else { register Lisp_Object param_index, old_value; param_index = Fget (prop, Qx_frame_parameter); old_value = get_frame_param (f, prop); store_frame_param (f, prop, val); if (NATNUMP (param_index) && (XFASTINT (param_index) < sizeof (x_frame_parms)/sizeof (x_frame_parms[0]))) (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value); } } /* Don't die if just one of these was set. */ if (EQ (left, Qunbound)) { left_no_change = 1; if (f->output_data.x->left_pos < 0) left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil)); else XSETINT (left, f->output_data.x->left_pos); } if (EQ (top, Qunbound)) { top_no_change = 1; if (f->output_data.x->top_pos < 0) top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil)); else XSETINT (top, f->output_data.x->top_pos); } /* If one of the icon positions was not set, preserve or default it. */ if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left)) { icon_left_no_change = 1; icon_left = Fcdr (Fassq (Qicon_left, f->param_alist)); if (NILP (icon_left)) XSETINT (icon_left, 0); } if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top)) { icon_top_no_change = 1; icon_top = Fcdr (Fassq (Qicon_top, f->param_alist)); if (NILP (icon_top)) XSETINT (icon_top, 0); } /* Don't die if just one of these was set. */ if (EQ (width, Qunbound)) XSETINT (width, FRAME_WIDTH (f)); if (EQ (height, Qunbound)) XSETINT (height, FRAME_HEIGHT (f)); /* Don't set these parameters 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; check_frame_size (f, &height, &width); XSETFRAME (frame, f); if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f)) || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f))) Fset_frame_size (frame, width, height); if ((!NILP (left) || !NILP (top)) && ! (left_no_change && top_no_change) && ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos && NUMBERP (top) && XINT (top) == f->output_data.x->top_pos)) { int leftpos = 0; int toppos = 0; /* Record the signs. */ f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative); if (EQ (left, Qminus)) f->output_data.x->size_hint_flags |= XNegative; else if (INTEGERP (left)) { leftpos = XINT (left); if (leftpos < 0) f->output_data.x->size_hint_flags |= XNegative; } else if (CONSP (left) && EQ (XCONS (left)->car, Qminus) && CONSP (XCONS (left)->cdr) && INTEGERP (XCONS (XCONS (left)->cdr)->car)) { leftpos = - XINT (XCONS (XCONS (left)->cdr)->car); f->output_data.x->size_hint_flags |= XNegative; } else if (CONSP (left) && EQ (XCONS (left)->car, Qplus) && CONSP (XCONS (left)->cdr) && INTEGERP (XCONS (XCONS (left)->cdr)->car)) { leftpos = XINT (XCONS (XCONS (left)->cdr)->car); } if (EQ (top, Qminus)) f->output_data.x->size_hint_flags |= YNegative; else if (INTEGERP (top)) { toppos = XINT (top); if (toppos < 0) f->output_data.x->size_hint_flags |= YNegative; } else if (CONSP (top) && EQ (XCONS (top)->car, Qminus) && CONSP (XCONS (top)->cdr) && INTEGERP (XCONS (XCONS (top)->cdr)->car)) { toppos = - XINT (XCONS (XCONS (top)->cdr)->car); f->output_data.x->size_hint_flags |= YNegative; } else if (CONSP (top) && EQ (XCONS (top)->car, Qplus) && CONSP (XCONS (top)->cdr) && INTEGERP (XCONS (XCONS (top)->cdr)->car)) { toppos = XINT (XCONS (XCONS (top)->cdr)->car); } /* Store the numeric value of the position. */ f->output_data.x->top_pos = toppos; f->output_data.x->left_pos = leftpos; f->output_data.x->win_gravity = NorthWestGravity; /* Actually set that position, and convert to absolute. */ x_set_offset (f, leftpos, toppos, -1); } if ((!NILP (icon_left) || !NILP (icon_top)) && ! (icon_left_no_change && icon_top_no_change)) x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top)); } } /* Store the screen positions of frame F into XPTR and YPTR. These are the positions of the containing window manager window, not Emacs's own window. */ void x_real_positions (f, xptr, yptr) FRAME_PTR f; int *xptr, *yptr; { int win_x, win_y; Window child; /* This is pretty gross, but seems to be the easiest way out of the problem that arises when restarting window-managers. */ #ifdef USE_X_TOOLKIT Window outer = XtWindow (f->output_data.x->widget); #else Window outer = f->output_data.x->window_desc; #endif Window tmp_root_window; Window *tmp_children; int tmp_nchildren; while (1) { x_catch_errors (FRAME_X_DISPLAY (f)); XQueryTree (FRAME_X_DISPLAY (f), outer, &tmp_root_window, &f->output_data.x->parent_desc, &tmp_children, &tmp_nchildren); xfree (tmp_children); win_x = win_y = 0; /* Find the position of the outside upper-left corner of the inner window, with respect to the outer window. */ if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window) { XTranslateCoordinates (FRAME_X_DISPLAY (f), /* From-window, to-window. */ #ifdef USE_X_TOOLKIT XtWindow (f->output_data.x->widget), #else f->output_data.x->window_desc, #endif f->output_data.x->parent_desc, /* From-position, to-position. */ 0, 0, &win_x, &win_y, /* Child of win. */ &child); #if 0 /* The values seem to be right without this and wrong with. */ win_x += f->output_data.x->border_width; win_y += f->output_data.x->border_width; #endif } /* It is possible for the window returned by the XQueryNotify to become invalid by the time we call XTranslateCoordinates. That can happen when you restart some window managers. If so, we get an error in XTranslateCoordinates. Detect that and try the whole thing over. */ if (! x_had_errors_p (FRAME_X_DISPLAY (f))) break; x_uncatch_errors (FRAME_X_DISPLAY (f)); } x_uncatch_errors (FRAME_X_DISPLAY (f)); *xptr = f->output_data.x->left_pos - win_x; *yptr = f->output_data.x->top_pos - win_y; } /* Insert a description of internally-recorded parameters of frame X into the parameter alist *ALISTPTR that is to be given to the user. Only parameters that are specific to the X window system and whose values are not correctly recorded in the frame's param_alist need to be considered here. */ x_report_frame_params (f, alistptr) struct frame *f; Lisp_Object *alistptr; { char buf[16]; Lisp_Object tem; /* Represent negative positions (off the top or left screen edge) in a way that Fmodify_frame_parameters will understand correctly. */ XSETINT (tem, f->output_data.x->left_pos); if (f->output_data.x->left_pos >= 0) store_in_alist (alistptr, Qleft, tem); else store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil))); XSETINT (tem, f->output_data.x->top_pos); if (f->output_data.x->top_pos >= 0) store_in_alist (alistptr, Qtop, tem); else store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil))); store_in_alist (alistptr, Qborder_width, make_number (f->output_data.x->border_width)); store_in_alist (alistptr, Qinternal_border_width, make_number (f->output_data.x->internal_border_width)); sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f)); store_in_alist (alistptr, Qwindow_id, build_string (buf)); store_in_alist (alistptr, Qicon_name, f->icon_name); FRAME_SAMPLE_VISIBILITY (f); store_in_alist (alistptr, Qvisibility, (FRAME_VISIBLE_P (f) ? Qt : FRAME_ICONIFIED_P (f) ? Qicon : Qnil)); store_in_alist (alistptr, Qdisplay, XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->car); } /* Decide if color named COLOR is valid for the display associated with the selected frame; if so, return the rgb values in COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell. */ int defined_color (f, color, color_def, alloc) FRAME_PTR f; char *color; XColor *color_def; int alloc; { register int status; Colormap screen_colormap; Display *display = FRAME_X_DISPLAY (f); BLOCK_INPUT; screen_colormap = DefaultColormap (display, XDefaultScreen (display)); status = XParseColor (display, screen_colormap, color, color_def); if (status && alloc) { status = XAllocColor (display, screen_colormap, color_def); if (!status) { /* If we got to this point, the colormap is full, so we're going to try and get the next closest color. The algorithm used is a least-squares matching, which is what X uses for closest color matching with StaticColor visuals. */ XColor *cells; int no_cells; int nearest; long nearest_delta, trial_delta; int x; no_cells = XDisplayCells (display, XDefaultScreen (display)); cells = (XColor *) alloca (sizeof (XColor) * no_cells); for (x = 0; x < no_cells; x++) cells[x].pixel = x; XQueryColors (display, screen_colormap, cells, no_cells); nearest = 0; /* I'm assuming CSE so I'm not going to condense this. */ nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8)) * ((color_def->red >> 8) - (cells[0].red >> 8))) + (((color_def->green >> 8) - (cells[0].green >> 8)) * ((color_def->green >> 8) - (cells[0].green >> 8))) + (((color_def->blue >> 8) - (cells[0].blue >> 8)) * ((color_def->blue >> 8) - (cells[0].blue >> 8)))); for (x = 1; x < no_cells; x++) { trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8)) * ((color_def->red >> 8) - (cells[x].red >> 8))) + (((color_def->green >> 8) - (cells[x].green >> 8)) * ((color_def->green >> 8) - (cells[x].green >> 8))) + (((color_def->blue >> 8) - (cells[x].blue >> 8)) * ((color_def->blue >> 8) - (cells[x].blue >> 8)))); if (trial_delta < nearest_delta) { nearest = x; nearest_delta = trial_delta; } } color_def->red = cells[nearest].red; color_def->green = cells[nearest].green; color_def->blue = cells[nearest].blue; status = XAllocColor (display, screen_colormap, color_def); } } UNBLOCK_INPUT; if (status) return 1; else return 0; } /* Given a string ARG naming a color, compute a pixel value from it suitable for screen F. If F is not a color screen, return DEF (default) regardless of what ARG says. */ int x_decode_color (f, arg, def) FRAME_PTR f; Lisp_Object arg; int def; { XColor cdef; CHECK_STRING (arg, 0); if (strcmp (XSTRING (arg)->data, "black") == 0) return BLACK_PIX_DEFAULT (f); else if (strcmp (XSTRING (arg)->data, "white") == 0) return WHITE_PIX_DEFAULT (f); if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1) return def; /* defined_color is responsible for coping with failures by looking for a near-miss. */ if (defined_color (f, XSTRING (arg)->data, &cdef, 1)) return cdef.pixel; Fsignal (Qerror, Fcons (build_string ("undefined color"), Fcons (arg, Qnil))); } /* Functions called only from `x_set_frame_param' to set individual parameters. If FRAME_X_WINDOW (f) is 0, the frame is being created and its X-window does not exist yet. In that case, just record the parameter's new value in the standard place; do not attempt to change the window. */ void x_set_foreground_color (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { f->output_data.x->foreground_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); if (FRAME_X_WINDOW (f) != 0) { BLOCK_INPUT; XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc, f->output_data.x->foreground_pixel); XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc, f->output_data.x->foreground_pixel); UNBLOCK_INPUT; recompute_basic_faces (f); if (FRAME_VISIBLE_P (f)) redraw_frame (f); } } void x_set_background_color (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { Pixmap temp; int mask; f->output_data.x->background_pixel = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f)); if (FRAME_X_WINDOW (f) != 0) { BLOCK_INPUT; /* The main frame area. */ XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc, f->output_data.x->background_pixel); XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc, f->output_data.x->background_pixel); XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc, f->output_data.x->background_pixel); XSetWindowBackground (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->background_pixel); { Lisp_Object bar; for (bar = FRAME_SCROLL_BARS (f); !NILP (bar); bar = XSCROLL_BAR (bar)->next) XSetWindowBackground (FRAME_X_DISPLAY (f), SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)), f->output_data.x->background_pixel); } UNBLOCK_INPUT; recompute_basic_faces (f); if (FRAME_VISIBLE_P (f)) redraw_frame (f); } } void x_set_mouse_color (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { Cursor cursor, nontext_cursor, mode_cursor, cross_cursor; int mask_color; if (!EQ (Qnil, arg)) f->output_data.x->mouse_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); mask_color = f->output_data.x->background_pixel; /* No invisible pointers. */ if (mask_color == f->output_data.x->mouse_pixel && mask_color == f->output_data.x->background_pixel) f->output_data.x->mouse_pixel = f->output_data.x->foreground_pixel; BLOCK_INPUT; /* It's not okay to crash if the user selects a screwy cursor. */ x_catch_errors (FRAME_X_DISPLAY (f)); if (!EQ (Qnil, Vx_pointer_shape)) { CHECK_NUMBER (Vx_pointer_shape, 0); cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_pointer_shape)); } else cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm); x_check_errors (FRAME_X_DISPLAY (f), "bad text pointer cursor: %s"); if (!EQ (Qnil, Vx_nontext_pointer_shape)) { CHECK_NUMBER (Vx_nontext_pointer_shape, 0); nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_nontext_pointer_shape)); } else nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_left_ptr); x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s"); if (!EQ (Qnil, Vx_mode_pointer_shape)) { CHECK_NUMBER (Vx_mode_pointer_shape, 0); mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_mode_pointer_shape)); } else mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm); x_check_errors (FRAME_X_DISPLAY (f), "bad modeline pointer cursor: %s"); if (!EQ (Qnil, Vx_sensitive_text_pointer_shape)) { CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0); cross_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_sensitive_text_pointer_shape)); } else cross_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_crosshair); /* Check and report errors with the above calls. */ x_check_errors (FRAME_X_DISPLAY (f), "can't set cursor shape: %s"); x_uncatch_errors (FRAME_X_DISPLAY (f)); { XColor fore_color, back_color; fore_color.pixel = f->output_data.x->mouse_pixel; back_color.pixel = mask_color; XQueryColor (FRAME_X_DISPLAY (f), DefaultColormap (FRAME_X_DISPLAY (f), DefaultScreen (FRAME_X_DISPLAY (f))), &fore_color); XQueryColor (FRAME_X_DISPLAY (f), DefaultColormap (FRAME_X_DISPLAY (f), DefaultScreen (FRAME_X_DISPLAY (f))), &back_color); XRecolorCursor (FRAME_X_DISPLAY (f), cursor, &fore_color, &back_color); XRecolorCursor (FRAME_X_DISPLAY (f), nontext_cursor, &fore_color, &back_color); XRecolorCursor (FRAME_X_DISPLAY (f), mode_cursor, &fore_color, &back_color); XRecolorCursor (FRAME_X_DISPLAY (f), cross_cursor, &fore_color, &back_color); } if (FRAME_X_WINDOW (f) != 0) { XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor); } if (cursor != f->output_data.x->text_cursor && f->output_data.x->text_cursor != 0) XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->text_cursor); f->output_data.x->text_cursor = cursor; if (nontext_cursor != f->output_data.x->nontext_cursor && f->output_data.x->nontext_cursor != 0) XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->nontext_cursor); f->output_data.x->nontext_cursor = nontext_cursor; if (mode_cursor != f->output_data.x->modeline_cursor && f->output_data.x->modeline_cursor != 0) XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->modeline_cursor); f->output_data.x->modeline_cursor = mode_cursor; if (cross_cursor != f->output_data.x->cross_cursor && f->output_data.x->cross_cursor != 0) XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->cross_cursor); f->output_data.x->cross_cursor = cross_cursor; XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; } void x_set_cursor_color (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { unsigned long fore_pixel; if (!EQ (Vx_cursor_fore_pixel, Qnil)) fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT (f)); else fore_pixel = f->output_data.x->background_pixel; f->output_data.x->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); /* Make sure that the cursor color differs from the background color. */ if (f->output_data.x->cursor_pixel == f->output_data.x->background_pixel) { f->output_data.x->cursor_pixel = f->output_data.x->mouse_pixel; if (f->output_data.x->cursor_pixel == fore_pixel) fore_pixel = f->output_data.x->background_pixel; } f->output_data.x->cursor_foreground_pixel = fore_pixel; if (FRAME_X_WINDOW (f) != 0) { BLOCK_INPUT; XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc, f->output_data.x->cursor_pixel); XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc, fore_pixel); UNBLOCK_INPUT; if (FRAME_VISIBLE_P (f)) { x_display_cursor (f, 0); x_display_cursor (f, 1); } } } /* Set the border-color of frame F to value described by ARG. ARG can be a string naming a color. The border-color is used for the border that is drawn by the X server. Note that this does not fully take effect if done before F has an x-window; it must be redone when the window is created. Note: this is done in two routines because of the way X10 works. Note: under X11, this is normally the province of the window manager, and so emacs' border colors may be overridden. */ void x_set_border_color (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { unsigned char *str; int pix; CHECK_STRING (arg, 0); str = XSTRING (arg)->data; pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); x_set_border_pixel (f, pix); } /* Set the border-color of frame F to pixel value PIX. Note that this does not fully take effect if done before F has an x-window. */ x_set_border_pixel (f, pix) struct frame *f; int pix; { f->output_data.x->border_pixel = pix; if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0) { Pixmap temp; int mask; BLOCK_INPUT; XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), (unsigned long)pix); UNBLOCK_INPUT; if (FRAME_VISIBLE_P (f)) redraw_frame (f); } } void x_set_cursor_type (f, arg, oldval) FRAME_PTR f; Lisp_Object arg, oldval; { if (EQ (arg, Qbar)) { FRAME_DESIRED_CURSOR (f) = bar_cursor; f->output_data.x->cursor_width = 2; } else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar) && INTEGERP (XCONS (arg)->cdr)) { FRAME_DESIRED_CURSOR (f) = bar_cursor; f->output_data.x->cursor_width = XINT (XCONS (arg)->cdr); } else /* Treat anything unknown as "box cursor". It was bad to signal an error; people have trouble fixing .Xdefaults with Emacs, when it has something bad in it. */ FRAME_DESIRED_CURSOR (f) = filled_box_cursor; /* Make sure the cursor gets redrawn. This is overkill, but how often do people change cursor types? */ update_mode_lines++; } void x_set_icon_type (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { Lisp_Object tem; int result; if (STRINGP (arg)) { if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) return; } else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil)) return; BLOCK_INPUT; if (NILP (arg)) result = x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name) ? f->icon_name : f->name))->data); else result = x_bitmap_icon (f, arg); if (result) { UNBLOCK_INPUT; error ("No icon window available"); } XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; } /* Return non-nil if frame F wants a bitmap icon. */ Lisp_Object x_icon_type (f) FRAME_PTR f; { Lisp_Object tem; tem = assq_no_quit (Qicon_type, f->param_alist); if (CONSP (tem)) return XCONS (tem)->cdr; else return Qnil; } void x_set_icon_name (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { Lisp_Object tem; int result; if (STRINGP (arg)) { if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) return; } else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil)) return; f->icon_name = arg; if (f->output_data.x->icon_bitmap != 0) return; BLOCK_INPUT; result = x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name) ? f->icon_name : f->name))->data); if (result) { UNBLOCK_INPUT; error ("No icon window available"); } XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; } extern Lisp_Object x_new_font (); void x_set_font (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { Lisp_Object result; CHECK_STRING (arg, 1); BLOCK_INPUT; result = x_new_font (f, XSTRING (arg)->data); UNBLOCK_INPUT; if (EQ (result, Qnil)) error ("Font \"%s\" is not defined", XSTRING (arg)->data); else if (EQ (result, Qt)) error ("the characters of the given font have varying widths"); else if (STRINGP (result)) { recompute_basic_faces (f); store_frame_param (f, Qfont, result); } else abort (); } void x_set_border_width (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { CHECK_NUMBER (arg, 0); if (XINT (arg) == f->output_data.x->border_width) return; if (FRAME_X_WINDOW (f) != 0) error ("Cannot change the border width of a window"); f->output_data.x->border_width = XINT (arg); } void x_set_internal_border_width (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { int mask; int old = f->output_data.x->internal_border_width; CHECK_NUMBER (arg, 0); f->output_data.x->internal_border_width = XINT (arg); if (f->output_data.x->internal_border_width < 0) f->output_data.x->internal_border_width = 0; if (f->output_data.x->internal_border_width == old) return; if (FRAME_X_WINDOW (f) != 0) { BLOCK_INPUT; x_set_window_size (f, 0, f->width, f->height); #if 0 x_set_resize_hint (f); #endif XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; SET_FRAME_GARBAGED (f); } } void x_set_visibility (f, value, oldval) struct frame *f; Lisp_Object value, oldval; { Lisp_Object frame; XSETFRAME (frame, f); if (NILP (value)) Fmake_frame_invisible (frame, Qt); else if (EQ (value, Qicon)) Ficonify_frame (frame); else Fmake_frame_visible (frame); } static void x_set_menu_bar_lines_1 (window, n) Lisp_Object window; int n; { struct window *w = XWINDOW (window); XSETFASTINT (w->top, XFASTINT (w->top) + n); XSETFASTINT (w->height, XFASTINT (w->height) - n); /* Handle just the top child in a vertical split. */ if (!NILP (w->vchild)) x_set_menu_bar_lines_1 (w->vchild, n); /* Adjust all children in a horizontal split. */ for (window = w->hchild; !NILP (window); window = w->next) { w = XWINDOW (window); x_set_menu_bar_lines_1 (window, n); } } void x_set_menu_bar_lines (f, value, oldval) struct frame *f; Lisp_Object value, oldval; { int nlines; int olines = FRAME_MENU_BAR_LINES (f); /* Right now, menu bars don't work properly in minibuf-only frames; most of the commands try to apply themselves to the minibuffer frame itslef, and get an error because you can't switch buffers in or split the minibuffer window. */ if (FRAME_MINIBUF_ONLY_P (f)) return; if (INTEGERP (value)) nlines = XINT (value); else nlines = 0; #ifdef USE_X_TOOLKIT FRAME_MENU_BAR_LINES (f) = 0; if (nlines) { FRAME_EXTERNAL_MENU_BAR (f) = 1; if (f->output_data.x->menubar_widget == 0) /* Make sure next redisplay shows the menu bar. */ XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt; } else { if (FRAME_EXTERNAL_MENU_BAR (f) == 1) free_frame_menubar (f); FRAME_EXTERNAL_MENU_BAR (f) = 0; f->output_data.x->menubar_widget = 0; } #else /* not USE_X_TOOLKIT */ FRAME_MENU_BAR_LINES (f) = nlines; x_set_menu_bar_lines_1 (f->root_window, nlines - olines); #endif /* not USE_X_TOOLKIT */ } /* Change the name of frame F to NAME. If NAME is nil, set F's name to x_id_name. If EXPLICIT is non-zero, that indicates that lisp code is setting the name; if NAME is a string, set F's name to NAME and set F->explicit_name; if NAME is Qnil, then clear F->explicit_name. If EXPLICIT is zero, that indicates that Emacs redisplay code is suggesting a new name, which lisp code should override; if F->explicit_name is set, ignore the new name; otherwise, set it. */ void x_set_name (f, name, explicit) struct frame *f; Lisp_Object name; int explicit; { /* Make sure that requests from lisp code override requests from Emacs redisplay code. */ if (explicit) { /* If we're switching from explicit to implicit, we had better update the mode lines and thereby update the title. */ if (f->explicit_name && NILP (name)) update_mode_lines = 1; f->explicit_name = ! NILP (name); } else if (f->explicit_name) return; /* If NAME is nil, set the name to the x_id_name. */ if (NILP (name)) { /* Check for no change needed in this very common case before we do any consing. */ if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name, XSTRING (f->name)->data)) return; name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name); } else CHECK_STRING (name, 0); /* Don't change the name if it's already NAME. */ if (! NILP (Fstring_equal (name, f->name))) return; if (FRAME_X_WINDOW (f)) { BLOCK_INPUT; #ifdef HAVE_X11R4 { XTextProperty text, icon; Lisp_Object icon_name; text.value = XSTRING (name)->data; text.encoding = XA_STRING; text.format = 8; text.nitems = XSTRING (name)->size; icon_name = (!NILP (f->icon_name) ? f->icon_name : name); icon.value = XSTRING (icon_name)->data; icon.encoding = XA_STRING; icon.format = 8; icon.nitems = XSTRING (icon_name)->size; #ifdef USE_X_TOOLKIT XSetWMName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget), &text); XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget), &icon); #else /* not USE_X_TOOLKIT */ XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text); XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon); #endif /* not USE_X_TOOLKIT */ } #else /* not HAVE_X11R4 */ XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), XSTRING (name)->data); XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), XSTRING (name)->data); #endif /* not HAVE_X11R4 */ UNBLOCK_INPUT; } f->name = name; } /* This function should be called when the user's lisp code has specified a name for the frame; the name will override any set by the redisplay code. */ void x_explicitly_set_name (f, arg, oldval) FRAME_PTR f; Lisp_Object arg, oldval; { x_set_name (f, arg, 1); } /* This function should be called by Emacs redisplay code to set the name; names set this way will never override names set by the user's lisp code. */ void x_implicitly_set_name (f, arg, oldval) FRAME_PTR f; Lisp_Object arg, oldval; { x_set_name (f, arg, 0); } void x_set_autoraise (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { f->auto_raise = !EQ (Qnil, arg); } void x_set_autolower (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { f->auto_lower = !EQ (Qnil, arg); } void x_set_unsplittable (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { f->no_split = !NILP (arg); } void x_set_vertical_scroll_bars (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)) { FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg); /* We set this parameter before creating the X window for the frame, so we can get the geometry right from the start. However, if the window hasn't been created yet, we shouldn't call x_set_window_size. */ if (FRAME_X_WINDOW (f)) x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f)); } } void x_set_scroll_bar_width (f, arg, oldval) struct frame *f; Lisp_Object arg, oldval; { if (NILP (arg)) { FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0; FRAME_SCROLL_BAR_COLS (f) = 2; } else if (INTEGERP (arg) && XINT (arg) > 0 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f)) { int wid = FONT_WIDTH (f->output_data.x->font); FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg); FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid; if (FRAME_X_WINDOW (f)) x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f)); } } /* Subroutines of creating an X frame. */ /* Make sure that Vx_resource_name is set to a reasonable value. Fix it up, or set it to `emacs' if it is too hopeless. */ static void validate_x_resource_name () { int len; /* Number of valid characters in the resource name. */ int good_count = 0; /* Number of invalid characters in the resource name. */ int bad_count = 0; Lisp_Object new; int i; if (STRINGP (Vx_resource_name)) { unsigned char *p = XSTRING (Vx_resource_name)->data; int i; len = XSTRING (Vx_resource_name)->size; /* Only letters, digits, - and _ are valid in resource names. Count the valid characters and count the invalid ones. */ for (i = 0; i < len; i++) { int c = p[i]; if (! ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c == '-' || c == '_')) bad_count++; else good_count++; } } else /* Not a string => completely invalid. */ bad_count = 5, good_count = 0; /* If name is valid already, return. */ if (bad_count == 0) return; /* If name is entirely invalid, or nearly so, use `emacs'. */ if (good_count == 0 || (good_count == 1 && bad_count > 0)) { Vx_resource_name = build_string ("emacs"); return; } /* Name is partly valid. Copy it and replace the invalid characters with underscores. */ Vx_resource_name = new = Fcopy_sequence (Vx_resource_name); for (i = 0; i < len; i++) { int c = XSTRING (new)->data[i]; if (! ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c == '-' || c == '_')) XSTRING (new)->data[i] = '_'; } } extern char *x_get_string_resource (); 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, 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 `INSTANCE.COMPONENT.ATTRIBUTE'\n\ and the class is `Emacs.CLASS.SUBCLASS'.") (attribute, class, component, subclass) Lisp_Object attribute, class, component, subclass; { register char *value; char *name_key; char *class_key; check_x (); CHECK_STRING (attribute, 0); CHECK_STRING (class, 0); if (!NILP (component)) CHECK_STRING (component, 1); if (!NILP (subclass)) CHECK_STRING (subclass, 2); if (NILP (component) != NILP (subclass)) error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither"); validate_x_resource_name (); /* Allocate space for the components, the dots which separate them, and the final '\0'. Make them big enough for the worst case. */ name_key = (char *) alloca (XSTRING (Vx_resource_name)->size + (STRINGP (component) ? XSTRING (component)->size : 0) + XSTRING (attribute)->size + 3); class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1) + XSTRING (class)->size + (STRINGP (subclass) ? XSTRING (subclass)->size : 0) + 3); /* Start with emacs.FRAMENAME for the name (the specific one) and with `Emacs' for the class key (the general one). */ strcpy (name_key, XSTRING (Vx_resource_name)->data); strcpy (class_key, EMACS_CLASS); strcat (class_key, "."); strcat (class_key, XSTRING (class)->data); if (!NILP (component)) { strcat (class_key, "."); strcat (class_key, XSTRING (subclass)->data); strcat (name_key, "."); strcat (name_key, XSTRING (component)->data); } strcat (name_key, "."); strcat (name_key, XSTRING (attribute)->data); value = x_get_string_resource (check_x_display_info (Qnil)->xrdb, name_key, class_key); if (value != (char *) 0) return build_string (value); else return Qnil; } /* Used when C code wants a resource value. */ char * x_get_resource_string (attribute, class) char *attribute, *class; { register char *value; char *name_key; char *class_key; /* Allocate space for the components, the dots which separate them, and the final '\0'. */ name_key = (char *) alloca (XSTRING (Vinvocation_name)->size + strlen (attribute) + 2); class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2); sprintf (name_key, "%s.%s", XSTRING (Vinvocation_name)->data, attribute); sprintf (class_key, "%s.%s", EMACS_CLASS, class); return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame)->xrdb, name_key, class_key); } /* Types we might convert a resource string into. */ enum resource_types { number, boolean, string, symbol }; /* Return the value of parameter PARAM. First search ALIST, then Vdefault_frame_alist, then the X defaults database, using ATTRIBUTE as the attribute name and CLASS as its class. Convert the resource to the type specified by desired_type. If no default is specified, return Qunbound. If you call x_get_arg, make sure you deal with Qunbound in a reasonable way, and don't let it get stored in any Lisp-visible variables! */ static Lisp_Object x_get_arg (alist, param, attribute, class, type) Lisp_Object alist, param; char *attribute; char *class; enum resource_types type; { register Lisp_Object tem; tem = Fassq (param, alist); if (EQ (tem, Qnil)) tem = Fassq (param, Vdefault_frame_alist); if (EQ (tem, Qnil)) { if (attribute) { tem = Fx_get_resource (build_string (attribute), build_string (class), Qnil, Qnil); if (NILP (tem)) return Qunbound; switch (type) { case number: return make_number (atoi (XSTRING (tem)->data)); case boolean: tem = Fdowncase (tem); if (!strcmp (XSTRING (tem)->data, "on") || !strcmp (XSTRING (tem)->data, "true")) return Qt; else return Qnil; case string: return tem; case symbol: /* As a special case, we map the values `true' and `on' to Qt, and `false' and `off' to Qnil. */ { Lisp_Object lower; lower = Fdowncase (tem); if (!strcmp (XSTRING (lower)->data, "on") || !strcmp (XSTRING (lower)->data, "true")) return Qt; else if (!strcmp (XSTRING (lower)->data, "off") || !strcmp (XSTRING (lower)->data, "false")) return Qnil; else return Fintern (tem, Qnil); } default: abort (); } } else return Qunbound; } return Fcdr (tem); } /* Record in frame F the specified or default value according to ALIST of the parameter named PARAM (a Lisp symbol). If no value is specified for PARAM, look for an X default for XPROP on the frame named NAME. If that is not found either, use the value DEFLT. */ static Lisp_Object x_default_parameter (f, alist, prop, deflt, xprop, xclass, type) struct frame *f; Lisp_Object alist; Lisp_Object prop; Lisp_Object deflt; char *xprop; char *xclass; enum resource_types type; { Lisp_Object tem; tem = x_get_arg (alist, prop, xprop, xclass, type); if (EQ (tem, Qunbound)) tem = deflt; x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil)); return tem; } DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0, "Parse an X-style geometry string STRING.\n\ Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\ The properties returned may include `top', `left', `height', and `width'.\n\ The value of `left' or `top' may be an integer,\n\ or a list (+ N) meaning N pixels relative to top/left corner,\n\ or a list (- N) meaning -N pixels relative to bottom/right corner.") (string) Lisp_Object string; { int geometry, x, y; unsigned int width, height; Lisp_Object result; CHECK_STRING (string, 0); geometry = XParseGeometry ((char *) XSTRING (string)->data, &x, &y, &width, &height); #if 0 if (!!(geometry & XValue) != !!(geometry & YValue)) error ("Must specify both x and y position, or neither"); #endif result = Qnil; if (geometry & XValue) { Lisp_Object element; if (x >= 0 && (geometry & XNegative)) element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil))); else if (x < 0 && ! (geometry & XNegative)) element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil))); else element = Fcons (Qleft, make_number (x)); result = Fcons (element, result); } if (geometry & YValue) { Lisp_Object element; if (y >= 0 && (geometry & YNegative)) element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil))); else if (y < 0 && ! (geometry & YNegative)) element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil))); else element = Fcons (Qtop, make_number (y)); result = Fcons (element, result); } if (geometry & WidthValue) result = Fcons (Fcons (Qwidth, make_number (width)), result); if (geometry & HeightValue) result = Fcons (Fcons (Qheight, make_number (height)), result); return result; } /* Calculate the desired size and position of this window, and return the flags saying which aspects were specified. This function does not make the coordinates positive. */ #define DEFAULT_ROWS 40 #define DEFAULT_COLS 80 static int x_figure_window_size (f, parms) struct frame *f; Lisp_Object parms; { register Lisp_Object tem0, tem1, tem2; int height, width, left, top; register int geometry; long window_prompting = 0; /* Default values if we fall through. Actually, if that happens we should get window manager prompting. */ f->width = DEFAULT_COLS; f->height = DEFAULT_ROWS; /* Window managers expect that if program-specified positions are not (0,0), they're intentional, not defaults. */ f->output_data.x->top_pos = 0; f->output_data.x->left_pos = 0; tem0 = x_get_arg (parms, Qheight, 0, 0, number); tem1 = x_get_arg (parms, Qwidth, 0, 0, number); tem2 = x_get_arg (parms, Quser_size, 0, 0, number); if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound)) { if (!EQ (tem0, Qunbound)) { CHECK_NUMBER (tem0, 0); f->height = XINT (tem0); } if (!EQ (tem1, Qunbound)) { CHECK_NUMBER (tem1, 0); f->width = XINT (tem1); } if (!NILP (tem2) && !EQ (tem2, Qunbound)) window_prompting |= USSize; else window_prompting |= PSize; } f->output_data.x->vertical_scroll_bar_extra = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f) ? 0 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f) : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font))); f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width); f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height); tem0 = x_get_arg (parms, Qtop, 0, 0, number); tem1 = x_get_arg (parms, Qleft, 0, 0, number); tem2 = x_get_arg (parms, Quser_position, 0, 0, number); if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound)) { if (EQ (tem0, Qminus)) { f->output_data.x->top_pos = 0; window_prompting |= YNegative; } else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus) && CONSP (XCONS (tem0)->cdr) && INTEGERP (XCONS (XCONS (tem0)->cdr)->car)) { f->output_data.x->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car); window_prompting |= YNegative; } else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus) && CONSP (XCONS (tem0)->cdr) && INTEGERP (XCONS (XCONS (tem0)->cdr)->car)) { f->output_data.x->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car); } else if (EQ (tem0, Qunbound)) f->output_data.x->top_pos = 0; else { CHECK_NUMBER (tem0, 0); f->output_data.x->top_pos = XINT (tem0); if (f->output_data.x->top_pos < 0) window_prompting |= YNegative; } if (EQ (tem1, Qminus)) { f->output_data.x->left_pos = 0; window_prompting |= XNegative; } else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus) && CONSP (XCONS (tem1)->cdr) && INTEGERP (XCONS (XCONS (tem1)->cdr)->car)) { f->output_data.x->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car); window_prompting |= XNegative; } else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus) && CONSP (XCONS (tem1)->cdr) && INTEGERP (XCONS (XCONS (tem1)->cdr)->car)) { f->output_data.x->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car); } else if (EQ (tem1, Qunbound)) f->output_data.x->left_pos = 0; else { CHECK_NUMBER (tem1, 0); f->output_data.x->left_pos = XINT (tem1); if (f->output_data.x->left_pos < 0) window_prompting |= XNegative; } if (!NILP (tem2) && ! EQ (tem2, Qunbound)) window_prompting |= USPosition; else window_prompting |= PPosition; } return window_prompting; } #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS) Status XSetWMProtocols (dpy, w, protocols, count) Display *dpy; Window w; Atom *protocols; int count; { Atom prop; prop = XInternAtom (dpy, "WM_PROTOCOLS", False); if (prop == None) return False; XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace, (unsigned char *) protocols, count); return True; } #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */ #ifdef USE_X_TOOLKIT /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS, WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may already be present because of the toolkit (Motif adds some of them, for example, but Xt doesn't). */ static void hack_wm_protocols (f, widget) FRAME_PTR f; Widget widget; { Display *dpy = XtDisplay (widget); Window w = XtWindow (widget); int need_delete = 1; int need_focus = 1; int need_save = 1; BLOCK_INPUT; { Atom type, *atoms = 0; int format = 0; unsigned long nitems = 0; unsigned long bytes_after; if ((XGetWindowProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols, (long)0, (long)100, False, XA_ATOM, &type, &format, &nitems, &bytes_after, (unsigned char **) &atoms) == Success) && format == 32 && type == XA_ATOM) while (nitems > 0) { nitems--; if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window) need_delete = 0; else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus) need_focus = 0; else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself) need_save = 0; } if (atoms) XFree ((char *) atoms); } { Atom props [10]; int count = 0; if (need_delete) props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window; if (need_focus) props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus; if (need_save) props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself; if (count) XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend, (unsigned char *) props, count); } UNBLOCK_INPUT; } #endif #ifdef USE_X_TOOLKIT /* Create and set up the X widget for frame F. */ static void x_window (f, window_prompting, minibuffer_only) struct frame *f; long window_prompting; int minibuffer_only; { XClassHint class_hints; XSetWindowAttributes attributes; unsigned long attribute_mask; Widget shell_widget; Widget pane_widget; Widget frame_widget; Arg al [25]; int ac; BLOCK_INPUT; /* Use the resource name as the top-level widget name for looking up resources. Make a non-Lisp copy for the window manager, so GC relocation won't bother it. Elsewhere we specify the window name for the window manager. */ { char *str = (char *) XSTRING (Vx_resource_name)->data; f->namebuf = (char *) xmalloc (strlen (str) + 1); strcpy (f->namebuf, str); } ac = 0; XtSetArg (al[ac], XtNallowShellResize, 1); ac++; XtSetArg (al[ac], XtNinput, 1); ac++; XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++; XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++; shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS, applicationShellWidgetClass, FRAME_X_DISPLAY (f), al, ac); f->output_data.x->widget = shell_widget; /* maybe_set_screen_title_format (shell_widget); */ pane_widget = lw_create_widget ("main", "pane", widget_id_tick++, (widget_value *) NULL, shell_widget, False, (lw_callback) NULL, (lw_callback) NULL, (lw_callback) NULL); f->output_data.x->column_widget = pane_widget; /* mappedWhenManaged to false tells to the paned window to not map/unmap the emacs screen when changing menubar. This reduces flickering. */ ac = 0; XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++; XtSetArg (al[ac], XtNshowGrip, 0); ac++; XtSetArg (al[ac], XtNallowResize, 1); ac++; XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++; XtSetArg (al[ac], XtNemacsFrame, f); ac++; frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget, al, ac); f->output_data.x->edit_widget = frame_widget; XtManageChild (frame_widget); /* Do some needed geometry management. */ { int len; char *tem, shell_position[32]; Arg al[2]; int ac = 0; int extra_borders = 0; int menubar_size = (f->output_data.x->menubar_widget ? (f->output_data.x->menubar_widget->core.height + f->output_data.x->menubar_widget->core.border_width) : 0); extern char *lwlib_toolkit_type; if (FRAME_EXTERNAL_MENU_BAR (f)) { Dimension ibw = 0; XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL); menubar_size += ibw; } f->output_data.x->menubar_height = menubar_size; /* Motif seems to need this amount added to the sizes specified for the shell widget. The Athena/Lucid widgets don't. Both conclusions reached experimentally. -- rms. */ if (!strcmp (lwlib_toolkit_type, "motif")) XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth, &extra_borders, NULL); /* Convert our geometry parameters into a geometry string and specify it. Note that we do not specify here whether the position is a user-specified or program-specified one. We pass that information later, in x_wm_set_size_hints. */ { int left = f->output_data.x->left_pos; int xneg = window_prompting & XNegative; int top = f->output_data.x->top_pos; int yneg = window_prompting & YNegative; if (xneg) left = -left; if (yneg) top = -top; if (window_prompting & USPosition) sprintf (shell_position, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f) + extra_borders, PIXEL_HEIGHT (f) + menubar_size + extra_borders, (xneg ? '-' : '+'), left, (yneg ? '-' : '+'), top); else sprintf (shell_position, "=%dx%d", PIXEL_WIDTH (f) + extra_borders, PIXEL_HEIGHT (f) + menubar_size + extra_borders); } len = strlen (shell_position) + 1; tem = (char *) xmalloc (len); strncpy (tem, shell_position, len); XtSetArg (al[ac], XtNgeometry, tem); ac++; XtSetValues (shell_widget, al, ac); } XtManageChild (pane_widget); XtRealizeWidget (shell_widget); FRAME_X_WINDOW (f) = XtWindow (frame_widget); validate_x_resource_name (); class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data; class_hints.res_class = EMACS_CLASS; XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints); #ifdef HAVE_X_I18N { XIM xim; XIC xic = NULL; xim = XOpenIM (FRAME_X_DISPLAY (f), NULL, NULL, NULL); if (xim) { xic = XCreateIC (xim, XNInputStyle, XIMPreeditNothing | XIMStatusNothing, XNClientWindow, FRAME_X_WINDOW(f), XNFocusWindow, FRAME_X_WINDOW(f), NULL); if (xic == 0) XCloseIM (xim); } FRAME_XIC (f) = xic; } #endif f->output_data.x->wm_hints.input = True; f->output_data.x->wm_hints.flags |= InputHint; XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &f->output_data.x->wm_hints); hack_wm_protocols (f, shell_widget); #ifdef HACK_EDITRES XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0); #endif /* Do a stupid property change to force the server to generate a propertyNotify event so that the event_stream server timestamp will be initialized to something relevant to the time we created the window. */ XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget), FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend, (unsigned char*) NULL, 0); /* Make all the standard events reach the Emacs frame. */ attributes.event_mask = STANDARD_EVENT_SET; attribute_mask = CWEventMask; XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget), attribute_mask, &attributes); XtMapWidget (frame_widget); /* x_set_name normally ignores requests to set the name if the requested name is the same as the current name. This is the one place where that assumption isn't correct; f->name is set, but the X server hasn't been told. */ { Lisp_Object name; int explicit = f->explicit_name; f->explicit_name = 0; name = f->name; f->name = Qnil; x_set_name (f, name, explicit); } XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->text_cursor); UNBLOCK_INPUT; if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f)) initialize_frame_menubar (f); lw_set_main_areas (pane_widget, f->output_data.x->menubar_widget, frame_widget); if (FRAME_X_WINDOW (f) == 0) error ("Unable to create window"); } #else /* not USE_X_TOOLKIT */ /* Create and set up the X window for frame F. */ x_window (f) struct frame *f; { XClassHint class_hints; XSetWindowAttributes attributes; unsigned long attribute_mask; attributes.background_pixel = f->output_data.x->background_pixel; attributes.border_pixel = f->output_data.x->border_pixel; attributes.bit_gravity = StaticGravity; attributes.backing_store = NotUseful; attributes.save_under = True; attributes.event_mask = STANDARD_EVENT_SET; attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity #if 0 | CWBackingStore | CWSaveUnder #endif | CWEventMask); BLOCK_INPUT; FRAME_X_WINDOW (f) = XCreateWindow (FRAME_X_DISPLAY (f), f->output_data.x->parent_desc, f->output_data.x->left_pos, f->output_data.x->top_pos, PIXEL_WIDTH (f), PIXEL_HEIGHT (f), f->output_data.x->border_width, CopyFromParent, /* depth */ InputOutput, /* class */ FRAME_X_DISPLAY_INFO (f)->visual, attribute_mask, &attributes); #ifdef HAVE_X_I18N { XIM xim; XIC xic = NULL; xim = XOpenIM (FRAME_X_DISPLAY(f), NULL, NULL, NULL); if (xim) { xic = XCreateIC (xim, XNInputStyle, XIMPreeditNothing | XIMStatusNothing, XNClientWindow, FRAME_X_WINDOW(f), XNFocusWindow, FRAME_X_WINDOW(f), NULL); if (!xic) XCloseIM (xim); } FRAME_XIC (f) = xic; } #endif validate_x_resource_name (); class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data; class_hints.res_class = EMACS_CLASS; XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints); /* The menubar is part of the ordinary display; it does not count in addition to the height of the window. */ f->output_data.x->menubar_height = 0; /* This indicates that we use the "Passive Input" input model. Unless we do this, we don't get the Focus{In,Out} events that we need to draw the cursor correctly. Accursed bureaucrats. XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */ f->output_data.x->wm_hints.input = True; f->output_data.x->wm_hints.flags |= InputHint; XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &f->output_data.x->wm_hints); /* Request "save yourself" and "delete window" commands from wm. */ { Atom protocols[2]; protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window; protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself; XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2); } /* x_set_name normally ignores requests to set the name if the requested name is the same as the current name. This is the one place where that assumption isn't correct; f->name is set, but the X server hasn't been told. */ { Lisp_Object name; int explicit = f->explicit_name; f->explicit_name = 0; name = f->name; f->name = Qnil; x_set_name (f, name, explicit); } XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->text_cursor); UNBLOCK_INPUT; if (FRAME_X_WINDOW (f) == 0) error ("Unable to create window"); } #endif /* not USE_X_TOOLKIT */ /* Handle the icon stuff for this window. Perhaps later we might want an x_set_icon_position which can be called interactively as well. */ static void x_icon (f, parms) struct frame *f; Lisp_Object parms; { Lisp_Object icon_x, icon_y; /* Set the position of the icon. Note that twm groups all icons in an icon window. */ icon_x = x_get_arg (parms, Qicon_left, 0, 0, number); icon_y = x_get_arg (parms, Qicon_top, 0, 0, number); if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) { CHECK_NUMBER (icon_x, 0); CHECK_NUMBER (icon_y, 0); } else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) error ("Both left and top icon corners of icon must be specified"); BLOCK_INPUT; if (! EQ (icon_x, Qunbound)) x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y)); /* Start up iconic or window? */ x_wm_set_window_state (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon) ? IconicState : NormalState)); x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name) ? f->icon_name : f->name))->data); UNBLOCK_INPUT; } /* Make the GC's needed for this window, setting the background, border and mouse colors; also create the mouse cursor and the gray border tile. */ static char cursor_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 }; static void x_make_gc (f) struct frame *f; { XGCValues gc_values; GC temp_gc; XImage tileimage; BLOCK_INPUT; /* Create the GC's of this frame. Note that many default values are used. */ /* Normal video */ gc_values.font = f->output_data.x->font->fid; gc_values.foreground = f->output_data.x->foreground_pixel; gc_values.background = f->output_data.x->background_pixel; gc_values.line_width = 0; /* Means 1 using fast algorithm. */ f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), GCLineWidth | GCFont | GCForeground | GCBackground, &gc_values); /* Reverse video style. */ gc_values.foreground = f->output_data.x->background_pixel; gc_values.background = f->output_data.x->foreground_pixel; f->output_data.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), GCFont | GCForeground | GCBackground | GCLineWidth, &gc_values); /* Cursor has cursor-color background, background-color foreground. */ gc_values.foreground = f->output_data.x->background_pixel; gc_values.background = f->output_data.x->cursor_pixel; gc_values.fill_style = FillOpaqueStippled; gc_values.stipple = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window, cursor_bits, 16, 16); f->output_data.x->cursor_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), (GCFont | GCForeground | GCBackground | GCFillStyle | GCStipple | GCLineWidth), &gc_values); /* Create the gray border tile used when the pointer is not in the frame. Since this depends on the frame's pixel values, this must be done on a per-frame basis. */ f->output_data.x->border_tile = (XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window, gray_bits, gray_width, gray_height, f->output_data.x->foreground_pixel, f->output_data.x->background_pixel, DefaultDepth (FRAME_X_DISPLAY (f), XScreenNumberOfScreen (FRAME_X_SCREEN (f))))); UNBLOCK_INPUT; } DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, 1, 1, 0, "Make a new X window, which is called a \"frame\" in Emacs terms.\n\ Returns an Emacs frame object.\n\ ALIST is an alist of frame parameters.\n\ If the parameters specify that the frame should not have a minibuffer,\n\ and do not specify a specific minibuffer window to use,\n\ then `default-minibuffer-frame' must be a frame whose minibuffer can\n\ be shared by the new frame.\n\ \n\ This function is an internal primitive--use `make-frame' instead.") (parms) Lisp_Object parms; { struct frame *f; Lisp_Object frame, tem; Lisp_Object name; int minibuffer_only = 0; long window_prompting = 0; int width, height; int count = specpdl_ptr - specpdl; struct gcpro gcpro1; Lisp_Object display; struct x_display_info *dpyinfo; Lisp_Object parent; struct kboard *kb; check_x (); /* Use this general default value to start with until we know if this frame has a specified name. */ Vx_resource_name = Vinvocation_name; display = x_get_arg (parms, Qdisplay, 0, 0, string); if (EQ (display, Qunbound)) display = Qnil; dpyinfo = check_x_display_info (display); #ifdef MULTI_KBOARD kb = dpyinfo->kboard; #else kb = &the_only_kboard; #endif name = x_get_arg (parms, Qname, "title", "Title", string); if (!STRINGP (name) && ! EQ (name, Qunbound) && ! NILP (name)) error ("Invalid frame name--not a string or nil"); if (STRINGP (name)) Vx_resource_name = name; /* See if parent window is specified. */ parent = x_get_arg (parms, Qparent_id, NULL, NULL, number); if (EQ (parent, Qunbound)) parent = Qnil; if (! NILP (parent)) CHECK_NUMBER (parent, 0); tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol); if (EQ (tem, Qnone) || NILP (tem)) f = make_frame_without_minibuffer (Qnil, kb, display); else if (EQ (tem, Qonly)) { f = make_minibuffer_frame (); minibuffer_only = 1; } else if (WINDOWP (tem)) f = make_frame_without_minibuffer (tem, kb, display); else f = make_frame (1); /* Note that X Windows does support scroll bars. */ FRAME_CAN_HAVE_SCROLL_BARS (f) = 1; XSETFRAME (frame, f); GCPRO1 (frame); f->output_method = output_x_window; f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output)); bzero (f->output_data.x, sizeof (struct x_output)); f->output_data.x->icon_bitmap = -1; f->icon_name = x_get_arg (parms, Qicon_name, "iconName", "Title", string); if (! STRINGP (f->icon_name)) f->icon_name = Qnil; FRAME_X_DISPLAY_INFO (f) = dpyinfo; #ifdef MULTI_KBOARD FRAME_KBOARD (f) = kb; #endif /* Specify the parent under which to make this X window. */ if (!NILP (parent)) { f->output_data.x->parent_desc = parent; f->output_data.x->explicit_parent = 1; } else { f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window; f->output_data.x->explicit_parent = 0; } /* Note that the frame has no physical cursor right now. */ f->phys_cursor_x = -1; /* Set the name; the functions to which we pass f expect the name to be set. */ if (EQ (name, Qunbound) || NILP (name)) { f->name = build_string (dpyinfo->x_id_name); f->explicit_name = 0; } else { f->name = name; f->explicit_name = 1; /* use the frame's title when getting resources for this frame. */ specbind (Qx_resource_name, name); } /* Extract the window parameters from the supplied values that are needed to determine window geometry. */ { Lisp_Object font; font = x_get_arg (parms, Qfont, "font", "Font", string); BLOCK_INPUT; /* First, try whatever font the caller has specified. */ if (STRINGP (font)) font = x_new_font (f, XSTRING (font)->data); /* Try out a font which we hope has bold and italic variations. */ if (!STRINGP (font)) font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1"); if (! STRINGP (font)) font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1"); if (! STRINGP (font)) /* This was formerly the first thing tried, but it finds too many fonts and takes too long. */ font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1"); /* If those didn't work, look for something which will at least work. */ if (! STRINGP (font)) font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1"); UNBLOCK_INPUT; if (! STRINGP (font)) font = build_string ("fixed"); x_default_parameter (f, parms, Qfont, font, "font", "Font", string); } #ifdef USE_X_TOOLKIT /* Prevent lwlib/xlwmenu.c from crashing because of a bug whereby it fails to get any font. */ xlwmenu_default_font = f->output_data.x->font; #endif x_default_parameter (f, parms, Qborder_width, make_number (2), "borderwidth", "BorderWidth", number); /* This defaults to 2 in order to match xterm. We recognize either internalBorderWidth or internalBorder (which is what xterm calls it). */ if (NILP (Fassq (Qinternal_border_width, parms))) { Lisp_Object value; value = x_get_arg (parms, Qinternal_border_width, "internalBorder", "BorderWidth", number); if (! EQ (value, Qunbound)) parms = Fcons (Fcons (Qinternal_border_width, value), parms); } x_default_parameter (f, parms, Qinternal_border_width, make_number (2), "internalBorderWidth", "BorderWidth", number); x_default_parameter (f, parms, Qvertical_scroll_bars, Qt, "verticalScrollBars", "ScrollBars", boolean); /* Also do the stuff which must be set before the window exists. */ x_default_parameter (f, parms, Qforeground_color, build_string ("black"), "foreground", "Foreground", string); x_default_parameter (f, parms, Qbackground_color, build_string ("white"), "background", "Background", string); x_default_parameter (f, parms, Qmouse_color, build_string ("black"), "pointerColor", "Foreground", string); x_default_parameter (f, parms, Qcursor_color, build_string ("black"), "cursorColor", "Foreground", string); x_default_parameter (f, parms, Qborder_color, build_string ("black"), "borderColor", "BorderColor", string); x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1), "menuBar", "MenuBar", number); x_default_parameter (f, parms, Qscroll_bar_width, Qnil, "scrollBarWidth", "ScrollBarWidth", number); x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate", "BufferPredicate", symbol); f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window; window_prompting = x_figure_window_size (f, parms); if (window_prompting & XNegative) { if (window_prompting & YNegative) f->output_data.x->win_gravity = SouthEastGravity; else f->output_data.x->win_gravity = NorthEastGravity; } else { if (window_prompting & YNegative) f->output_data.x->win_gravity = SouthWestGravity; else f->output_data.x->win_gravity = NorthWestGravity; } f->output_data.x->size_hint_flags = window_prompting; #ifdef USE_X_TOOLKIT x_window (f, window_prompting, minibuffer_only); #else x_window (f); #endif x_icon (f, parms); x_make_gc (f); init_frame_faces (f); /* We need to do this after creating the X window, so that the icon-creation functions can say whose icon they're describing. */ x_default_parameter (f, parms, Qicon_type, Qnil, "bitmapIcon", "BitmapIcon", symbol); x_default_parameter (f, parms, Qauto_raise, Qnil, "autoRaise", "AutoRaiseLower", boolean); x_default_parameter (f, parms, Qauto_lower, Qnil, "autoLower", "AutoRaiseLower", boolean); x_default_parameter (f, parms, Qcursor_type, Qbox, "cursorType", "CursorType", symbol); /* Dimensions, especially f->height, must be done via change_frame_size. Change will not be effected unless different from the current f->height. */ width = f->width; height = f->height; f->height = f->width = 0; change_frame_size (f, height, width, 1, 0); /* Tell the server what size and position, etc, we want, and how badly we want them. */ BLOCK_INPUT; x_wm_set_size_hint (f, window_prompting, 0); UNBLOCK_INPUT; tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean); f->no_split = minibuffer_only || EQ (tem, Qt); UNGCPRO; /* It is now ok to make the frame official even if we get an error below. And the frame needs to be on Vframe_list or making it visible won't work. */ Vframe_list = Fcons (frame, Vframe_list); /* Now that the frame is official, it counts as a reference to its display. */ FRAME_X_DISPLAY_INFO (f)->reference_count++; /* Make the window appear on the frame and enable display, unless the caller says not to. However, with explicit parent, Emacs cannot control visibility, so don't try. */ if (! f->output_data.x->explicit_parent) { Lisp_Object visibility; visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol); if (EQ (visibility, Qunbound)) visibility = Qt; if (EQ (visibility, Qicon)) x_iconify_frame (f); else if (! NILP (visibility)) x_make_frame_visible (f); else /* Must have been Qnil. */ ; } return unbind_to (count, frame); } /* FRAME is used only to get a handle on the X display. We don't pass the display info directly because we're called from frame.c, which doesn't know about that structure. */ Lisp_Object x_get_focus_frame (frame) struct frame *frame; { struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame); Lisp_Object xfocus; if (! dpyinfo->x_focus_frame) return Qnil; XSETFRAME (xfocus, dpyinfo->x_focus_frame); return xfocus; } DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0, "This function is obsolete, and does nothing.") (frame) Lisp_Object frame; { return Qnil; } DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0, "This function is obsolete, and does nothing.") () { return Qnil; } DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0, "Return a list of the names of available fonts matching PATTERN.\n\ If optional arguments FACE and FRAME are specified, return only fonts\n\ the same size as FACE on FRAME.\n\ \n\ PATTERN is a string, perhaps with wildcard characters;\n\ the * character matches any substring, and\n\ the ? character matches any single character.\n\ PATTERN is case-insensitive.\n\ FACE is a face name--a symbol.\n\ \n\ The return value is a list of strings, suitable as arguments to\n\ set-face-font.\n\ \n\ Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\ even if they match PATTERN and FACE.") (pattern, face, frame) Lisp_Object pattern, face, frame; { int num_fonts; char **names; #ifndef BROKEN_XLISTFONTSWITHINFO XFontStruct *info; #endif XFontStruct *size_ref; Lisp_Object list; FRAME_PTR f; check_x (); CHECK_STRING (pattern, 0); if (!NILP (face)) CHECK_SYMBOL (face, 1); f = check_x_frame (frame); /* Determine the width standard for comparison with the fonts we find. */ if (NILP (face)) size_ref = 0; else { int face_id; /* Don't die if we get called with a terminal frame. */ if (! FRAME_X_P (f)) error ("non-X frame used in `x-list-fonts'"); face_id = face_name_id_number (f, face); if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f) || FRAME_PARAM_FACES (f) [face_id] == 0) size_ref = f->output_data.x->font; else { size_ref = FRAME_PARAM_FACES (f) [face_id]->font; if (size_ref == (XFontStruct *) (~0)) size_ref = f->output_data.x->font; } } /* See if we cached the result for this particular query. */ list = Fassoc (pattern, XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr); /* We have info in the cache for this PATTERN. */ if (!NILP (list)) { Lisp_Object tem, newlist; /* We have info about this pattern. */ list = XCONS (list)->cdr; if (size_ref == 0) return list; BLOCK_INPUT; /* Filter the cached info and return just the fonts that match FACE. */ newlist = Qnil; for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr) { XFontStruct *thisinfo; thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), XSTRING (XCONS (tem)->car)->data); if (thisinfo && same_size_fonts (thisinfo, size_ref)) newlist = Fcons (XCONS (tem)->car, newlist); if (thisinfo != 0) XFreeFont (FRAME_X_DISPLAY (f), thisinfo); } UNBLOCK_INPUT; return newlist; } BLOCK_INPUT; /* Solaris 2.3 has a bug in XListFontsWithInfo. */ #ifndef BROKEN_XLISTFONTSWITHINFO if (size_ref) names = XListFontsWithInfo (FRAME_X_DISPLAY (f), XSTRING (pattern)->data, 2000, /* maxnames */ &num_fonts, /* count_return */ &info); /* info_return */ else #endif names = XListFonts (FRAME_X_DISPLAY (f), XSTRING (pattern)->data, 2000, /* maxnames */ &num_fonts); /* count_return */ UNBLOCK_INPUT; list = Qnil; if (names) { int i; Lisp_Object full_list; /* Make a list of all the fonts we got back. Store that in the font cache for the display. */ full_list = Qnil; for (i = 0; i < num_fonts; i++) full_list = Fcons (build_string (names[i]), full_list); XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr = Fcons (Fcons (pattern, full_list), XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr); /* Make a list of the fonts that have the right width. */ list = Qnil; for (i = 0; i < num_fonts; i++) { int keeper; if (!size_ref) keeper = 1; else { #ifdef BROKEN_XLISTFONTSWITHINFO XFontStruct *thisinfo; BLOCK_INPUT; thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]); UNBLOCK_INPUT; keeper = thisinfo && same_size_fonts (thisinfo, size_ref); #else keeper = same_size_fonts (&info[i], size_ref); #endif } if (keeper) list = Fcons (build_string (names[i]), list); } list = Fnreverse (list); BLOCK_INPUT; #ifndef BROKEN_XLISTFONTSWITHINFO if (size_ref) XFreeFontInfo (names, info, num_fonts); else #endif XFreeFontNames (names); UNBLOCK_INPUT; } return list; } DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0, "Return non-nil if color COLOR is supported on frame FRAME.\n\ If FRAME is omitted or nil, use the selected frame.") (color, frame) Lisp_Object color, frame; { XColor foo; FRAME_PTR f = check_x_frame (frame); CHECK_STRING (color, 1); if (defined_color (f, XSTRING (color)->data, &foo, 0)) return Qt; else return Qnil; } DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0, "Return a description of the color named COLOR on frame FRAME.\n\ The value is a list of integer RGB values--(RED GREEN BLUE).\n\ These values appear to range from 0 to 65280 or 65535, depending\n\ on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\ If FRAME is omitted or nil, use the selected frame.") (color, frame) Lisp_Object color, frame; { XColor foo; FRAME_PTR f = check_x_frame (frame); CHECK_STRING (color, 1); if (defined_color (f, XSTRING (color)->data, &foo, 0)) { Lisp_Object rgb[3]; rgb[0] = make_number (foo.red); rgb[1] = make_number (foo.green); rgb[2] = make_number (foo.blue); return Flist (3, rgb); } else return Qnil; } DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0, "Return t if the X display supports color.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); if (dpyinfo->n_planes <= 2) return Qnil; switch (dpyinfo->visual->class) { case StaticColor: case PseudoColor: case TrueColor: case DirectColor: return Qt; default: return Qnil; } } DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p, 0, 1, 0, "Return t if the X display supports shades of gray.\n\ Note that color displays do support shades of gray.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); if (dpyinfo->n_planes <= 1) return Qnil; switch (dpyinfo->visual->class) { case StaticColor: case PseudoColor: case TrueColor: case DirectColor: case StaticGray: case GrayScale: return Qt; default: return Qnil; } } DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width, 0, 1, 0, "Returns the width in pixels of the X display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); return make_number (dpyinfo->width); } DEFUN ("x-display-pixel-height", Fx_display_pixel_height, Sx_display_pixel_height, 0, 1, 0, "Returns the height in pixels of the X display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); return make_number (dpyinfo->height); } DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes, 0, 1, 0, "Returns the number of bitplanes of the X display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); return make_number (dpyinfo->n_planes); } DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells, 0, 1, 0, "Returns the number of color cells of the X display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); return make_number (DisplayCells (dpyinfo->display, XScreenNumberOfScreen (dpyinfo->screen))); } DEFUN ("x-server-max-request-size", Fx_server_max_request_size, Sx_server_max_request_size, 0, 1, 0, "Returns the maximum request size of the X server of display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); return make_number (MAXREQUEST (dpyinfo->display)); } DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, "Returns the vendor ID string of the X server of display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); char *vendor = ServerVendor (dpyinfo->display); if (! vendor) vendor = ""; return build_string (vendor); } DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0, "Returns the version numbers of the X server of display DISPLAY.\n\ The value is a list of three integers: the major and minor\n\ version numbers of the X Protocol in use, and the vendor-specific release\n\ number. See also the function `x-server-vendor'.\n\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); Display *dpy = dpyinfo->display; return Fcons (make_number (ProtocolVersion (dpy)), Fcons (make_number (ProtocolRevision (dpy)), Fcons (make_number (VendorRelease (dpy)), Qnil))); } DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0, "Returns the number of screens on the X server of display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); return make_number (ScreenCount (dpyinfo->display)); } DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0, "Returns the height in millimeters of the X display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); return make_number (HeightMMOfScreen (dpyinfo->screen)); } DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0, "Returns the width in millimeters of the X display DISPLAY.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); return make_number (WidthMMOfScreen (dpyinfo->screen)); } DEFUN ("x-display-backing-store", Fx_display_backing_store, Sx_display_backing_store, 0, 1, 0, "Returns an indication of whether X display DISPLAY does backing store.\n\ The value may be `always', `when-mapped', or `not-useful'.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); switch (DoesBackingStore (dpyinfo->screen)) { case Always: return intern ("always"); case WhenMapped: return intern ("when-mapped"); case NotUseful: return intern ("not-useful"); default: error ("Strange value for BackingStore parameter of screen"); } } DEFUN ("x-display-visual-class", Fx_display_visual_class, Sx_display_visual_class, 0, 1, 0, "Returns the visual class of the X display DISPLAY.\n\ The value is one of the symbols `static-gray', `gray-scale',\n\ `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); switch (dpyinfo->visual->class) { case StaticGray: return (intern ("static-gray")); case GrayScale: return (intern ("gray-scale")); case StaticColor: return (intern ("static-color")); case PseudoColor: return (intern ("pseudo-color")); case TrueColor: return (intern ("true-color")); case DirectColor: return (intern ("direct-color")); default: error ("Display has an unknown visual class"); } } DEFUN ("x-display-save-under", Fx_display_save_under, Sx_display_save_under, 0, 1, 0, "Returns t if the X display DISPLAY supports the save-under feature.\n\ The optional argument DISPLAY specifies which display to ask about.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If omitted or nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); if (DoesSaveUnders (dpyinfo->screen) == True) return Qt; else return Qnil; } int x_pixel_width (f) register struct frame *f; { return PIXEL_WIDTH (f); } int x_pixel_height (f) register struct frame *f; { return PIXEL_HEIGHT (f); } int x_char_width (f) register struct frame *f; { return FONT_WIDTH (f->output_data.x->font); } int x_char_height (f) register struct frame *f; { return f->output_data.x->line_height; } int x_screen_planes (frame) Lisp_Object frame; { return FRAME_X_DISPLAY_INFO (XFRAME (frame))->n_planes; } #if 0 /* These no longer seem like the right way to do things. */ /* Draw a rectangle on the frame with left top corner including the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is CHARS by LINES wide and long and is the color of the cursor. */ void x_rectangle (f, gc, left_char, top_char, chars, lines) register struct frame *f; GC gc; register int top_char, left_char, chars, lines; { int width; int height; int left = (left_char * FONT_WIDTH (f->output_data.x->font) + f->output_data.x->internal_border_width); int top = (top_char * f->output_data.x->line_height + f->output_data.x->internal_border_width); if (chars < 0) width = FONT_WIDTH (f->output_data.x->font) / 2; else width = FONT_WIDTH (f->output_data.x->font) * chars; if (lines < 0) height = f->output_data.x->line_height / 2; else height = f->output_data.x->line_height * lines; XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, left, top, width, height); } DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0, "Draw a rectangle on FRAME between coordinates specified by\n\ numbers X0, Y0, X1, Y1 in the cursor pixel.") (frame, X0, Y0, X1, Y1) register Lisp_Object frame, X0, X1, Y0, Y1; { register int x0, y0, x1, y1, top, left, n_chars, n_lines; CHECK_LIVE_FRAME (frame, 0); CHECK_NUMBER (X0, 0); CHECK_NUMBER (Y0, 1); CHECK_NUMBER (X1, 2); CHECK_NUMBER (Y1, 3); x0 = XINT (X0); x1 = XINT (X1); y0 = XINT (Y0); y1 = XINT (Y1); if (y1 > y0) { top = y0; n_lines = y1 - y0 + 1; } else { top = y1; n_lines = y0 - y1 + 1; } if (x1 > x0) { left = x0; n_chars = x1 - x0 + 1; } else { left = x1; n_chars = x0 - x1 + 1; } BLOCK_INPUT; x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->cursor_gc, left, top, n_chars, n_lines); UNBLOCK_INPUT; return Qt; } DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0, "Draw a rectangle drawn on FRAME between coordinates\n\ X0, Y0, X1, Y1 in the regular background-pixel.") (frame, X0, Y0, X1, Y1) register Lisp_Object frame, X0, Y0, X1, Y1; { register int x0, y0, x1, y1, top, left, n_chars, n_lines; CHECK_LIVE_FRAME (frame, 0); CHECK_NUMBER (X0, 0); CHECK_NUMBER (Y0, 1); CHECK_NUMBER (X1, 2); CHECK_NUMBER (Y1, 3); x0 = XINT (X0); x1 = XINT (X1); y0 = XINT (Y0); y1 = XINT (Y1); if (y1 > y0) { top = y0; n_lines = y1 - y0 + 1; } else { top = y1; n_lines = y0 - y1 + 1; } if (x1 > x0) { left = x0; n_chars = x1 - x0 + 1; } else { left = x1; n_chars = x0 - x1 + 1; } BLOCK_INPUT; x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->reverse_gc, left, top, n_chars, n_lines); UNBLOCK_INPUT; return Qt; } /* Draw lines around the text region beginning at the character position TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the pixel and line characteristics. */ #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)]) static void outline_region (f, gc, top_x, top_y, bottom_x, bottom_y) register struct frame *f; GC gc; int top_x, top_y, bottom_x, bottom_y; { register int ibw = f->output_data.x->internal_border_width; register int font_w = FONT_WIDTH (f->output_data.x->font); register int font_h = f->output_data.x->line_height; int y = top_y; int x = line_len (y); XPoint *pixel_points = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint)); register XPoint *this_point = pixel_points; /* Do the horizontal top line/lines */ if (top_x == 0) { this_point->x = ibw; this_point->y = ibw + (font_h * top_y); this_point++; if (x == 0) this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */ else this_point->x = ibw + (font_w * x); this_point->y = (this_point - 1)->y; } else { this_point->x = ibw; this_point->y = ibw + (font_h * (top_y + 1)); this_point++; this_point->x = ibw + (font_w * top_x); this_point->y = (this_point - 1)->y; this_point++; this_point->x = (this_point - 1)->x; this_point->y = ibw + (font_h * top_y); this_point++; this_point->x = ibw + (font_w * x); this_point->y = (this_point - 1)->y; } /* Now do the right side. */ while (y < bottom_y) { /* Right vertical edge */ this_point++; this_point->x = (this_point - 1)->x; this_point->y = ibw + (font_h * (y + 1)); this_point++; y++; /* Horizontal connection to next line */ x = line_len (y); if (x == 0) this_point->x = ibw + (font_w / 2); else this_point->x = ibw + (font_w * x); this_point->y = (this_point - 1)->y; } /* Now do the bottom and connect to the top left point. */ this_point->x = ibw + (font_w * (bottom_x + 1)); this_point++; this_point->x = (this_point - 1)->x; this_point->y = ibw + (font_h * (bottom_y + 1)); this_point++; this_point->x = ibw; this_point->y = (this_point - 1)->y; this_point++; this_point->x = pixel_points->x; this_point->y = pixel_points->y; XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, pixel_points, (this_point - pixel_points + 1), CoordModeOrigin); } DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0, "Highlight the region between point and the character under the mouse\n\ selected frame.") (event) register Lisp_Object event; { register int x0, y0, x1, y1; register struct frame *f = selected_frame; register int p1, p2; CHECK_CONS (event, 0); BLOCK_INPUT; x0 = XINT (Fcar (Fcar (event))); y0 = XINT (Fcar (Fcdr (Fcar (event)))); /* If the mouse is past the end of the line, don't that area. */ /* ReWrite this... */ x1 = f->cursor_x; y1 = f->cursor_y; if (y1 > y0) /* point below mouse */ outline_region (f, f->output_data.x->cursor_gc, x0, y0, x1, y1); else if (y1 < y0) /* point above mouse */ outline_region (f, f->output_data.x->cursor_gc, x1, y1, x0, y0); else /* same line: draw horizontal rectangle */ { if (x1 > x0) x_rectangle (f, f->output_data.x->cursor_gc, x0, y0, (x1 - x0 + 1), 1); else if (x1 < x0) x_rectangle (f, f->output_data.x->cursor_gc, x1, y1, (x0 - x1 + 1), 1); } XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; return Qnil; } DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0, "Erase any highlighting of the region between point and the character\n\ at X, Y on the selected frame.") (event) register Lisp_Object event; { register int x0, y0, x1, y1; register struct frame *f = selected_frame; BLOCK_INPUT; x0 = XINT (Fcar (Fcar (event))); y0 = XINT (Fcar (Fcdr (Fcar (event)))); x1 = f->cursor_x; y1 = f->cursor_y; if (y1 > y0) /* point below mouse */ outline_region (f, f->output_data.x->reverse_gc, x0, y0, x1, y1); else if (y1 < y0) /* point above mouse */ outline_region (f, f->output_data.x->reverse_gc, x1, y1, x0, y0); else /* same line: draw horizontal rectangle */ { if (x1 > x0) x_rectangle (f, f->output_data.x->reverse_gc, x0, y0, (x1 - x0 + 1), 1); else if (x1 < x0) x_rectangle (f, f->output_data.x->reverse_gc, x1, y1, (x0 - x1 + 1), 1); } UNBLOCK_INPUT; return Qnil; } #if 0 int contour_begin_x, contour_begin_y; int contour_end_x, contour_end_y; int contour_npoints; /* Clip the top part of the contour lines down (and including) line Y_POS. If X_POS is in the middle (rather than at the end) of the line, drop down a line at that character. */ static void clip_contour_top (y_pos, x_pos) { register XPoint *begin = contour_lines[y_pos].top_left; register XPoint *end; register int npoints; register struct display_line *line = selected_frame->phys_lines[y_pos + 1]; if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */ { end = contour_lines[y_pos].top_right; npoints = (end - begin + 1); XDrawLines (x_current_display, contour_window, contour_erase_gc, begin_erase, npoints, CoordModeOrigin); bcopy (end, begin + 1, contour_last_point - end + 1); contour_last_point -= (npoints - 2); XDrawLines (x_current_display, contour_window, contour_erase_gc, begin, 2, CoordModeOrigin); XFlush (x_current_display); /* Now, update contour_lines structure. */ } /* ______. */ else /* |________*/ { register XPoint *p = begin + 1; end = contour_lines[y_pos].bottom_right; npoints = (end - begin + 1); XDrawLines (x_current_display, contour_window, contour_erase_gc, begin_erase, npoints, CoordModeOrigin); p->y = begin->y; p->x = ibw + (font_w * (x_pos + 1)); p++; p->y = begin->y + font_h; p->x = (p - 1)->x; bcopy (end, begin + 3, contour_last_point - end + 1); contour_last_point -= (npoints - 5); XDrawLines (x_current_display, contour_window, contour_erase_gc, begin, 4, CoordModeOrigin); XFlush (x_current_display); /* Now, update contour_lines structure. */ } } /* Erase the top horizontal lines of the contour, and then extend the contour upwards. */ static void extend_contour_top (line) { } static void clip_contour_bottom (x_pos, y_pos) int x_pos, y_pos; { } static void extend_contour_bottom (x_pos, y_pos) { } DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e", "") (event) Lisp_Object event; { register struct frame *f = selected_frame; register int point_x = f->cursor_x; register int point_y = f->cursor_y; register int mouse_below_point; register Lisp_Object obj; register int x_contour_x, x_contour_y; x_contour_x = x_mouse_x; x_contour_y = x_mouse_y; if (x_contour_y > point_y || (x_contour_y == point_y && x_contour_x > point_x)) { mouse_below_point = 1; outline_region (f, f->output_data.x->cursor_gc, point_x, point_y, x_contour_x, x_contour_y); } else { mouse_below_point = 0; outline_region (f, f->output_data.x->cursor_gc, x_contour_x, x_contour_y, point_x, point_y); } while (1) { obj = read_char (-1, 0, 0, Qnil, 0); if (!CONSP (obj)) break; if (mouse_below_point) { if (x_mouse_y <= point_y) /* Flipped. */ { mouse_below_point = 0; outline_region (f, f->output_data.x->reverse_gc, point_x, point_y, x_contour_x, x_contour_y); outline_region (f, f->output_data.x->cursor_gc, x_mouse_x, x_mouse_y, point_x, point_y); } else if (x_mouse_y < x_contour_y) /* Bottom clipped. */ { clip_contour_bottom (x_mouse_y); } else if (x_mouse_y > x_contour_y) /* Bottom extended. */ { extend_bottom_contour (x_mouse_y); } x_contour_x = x_mouse_x; x_contour_y = x_mouse_y; } else /* mouse above or same line as point */ { if (x_mouse_y >= point_y) /* Flipped. */ { mouse_below_point = 1; outline_region (f, f->output_data.x->reverse_gc, x_contour_x, x_contour_y, point_x, point_y); outline_region (f, f->output_data.x->cursor_gc, point_x, point_y, x_mouse_x, x_mouse_y); } else if (x_mouse_y > x_contour_y) /* Top clipped. */ { clip_contour_top (x_mouse_y); } else if (x_mouse_y < x_contour_y) /* Top extended. */ { extend_contour_top (x_mouse_y); } } } unread_command_event = obj; if (mouse_below_point) { contour_begin_x = point_x; contour_begin_y = point_y; contour_end_x = x_contour_x; contour_end_y = x_contour_y; } else { contour_begin_x = x_contour_x; contour_begin_y = x_contour_y; contour_end_x = point_x; contour_end_y = point_y; } } #endif DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e", "") (event) Lisp_Object event; { register Lisp_Object obj; struct frame *f = selected_frame; register struct window *w = XWINDOW (selected_window); register GC line_gc = f->output_data.x->cursor_gc; register GC erase_gc = f->output_data.x->reverse_gc; #if 0 char dash_list[] = {6, 4, 6, 4}; int dashes = 4; XGCValues gc_values; #endif register int previous_y; register int line = (x_mouse_y + 1) * f->output_data.x->line_height + f->output_data.x->internal_border_width; register int left = f->output_data.x->internal_border_width + (w->left * FONT_WIDTH (f->output_data.x->font)); register int right = left + (w->width * FONT_WIDTH (f->output_data.x->font)) - f->output_data.x->internal_border_width; #if 0 BLOCK_INPUT; gc_values.foreground = f->output_data.x->cursor_pixel; gc_values.background = f->output_data.x->background_pixel; gc_values.line_width = 1; gc_values.line_style = LineOnOffDash; gc_values.cap_style = CapRound; gc_values.join_style = JoinRound; line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), GCLineStyle | GCJoinStyle | GCCapStyle | GCLineWidth | GCForeground | GCBackground, &gc_values); XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes); gc_values.foreground = f->output_data.x->background_pixel; gc_values.background = f->output_data.x->foreground_pixel; erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), GCLineStyle | GCJoinStyle | GCCapStyle | GCLineWidth | GCForeground | GCBackground, &gc_values); XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes); UNBLOCK_INPUT; #endif while (1) { BLOCK_INPUT; if (x_mouse_y >= XINT (w->top) && x_mouse_y < XINT (w->top) + XINT (w->height) - 1) { previous_y = x_mouse_y; line = (x_mouse_y + 1) * f->output_data.x->line_height + f->output_data.x->internal_border_width; XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), line_gc, left, line, right, line); } XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; do { obj = read_char (-1, 0, 0, Qnil, 0); if (!CONSP (obj) || (! EQ (Fcar (Fcdr (Fcdr (obj))), Qvertical_scroll_bar)) || x_mouse_grabbed) { BLOCK_INPUT; XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), erase_gc, left, line, right, line); unread_command_event = obj; #if 0 XFreeGC (FRAME_X_DISPLAY (f), line_gc); XFreeGC (FRAME_X_DISPLAY (f), erase_gc); #endif UNBLOCK_INPUT; return Qnil; } } while (x_mouse_y == previous_y); BLOCK_INPUT; XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), erase_gc, left, line, right, line); UNBLOCK_INPUT; } } #endif #if 0 /* These keep track of the rectangle following the pointer. */ int mouse_track_top, mouse_track_left, mouse_track_width; /* Offset in buffer of character under the pointer, or 0. */ int mouse_buffer_offset; DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0, "Track the pointer.") () { static Cursor current_pointer_shape; FRAME_PTR f = x_mouse_frame; BLOCK_INPUT; if (EQ (Vmouse_frame_part, Qtext_part) && (current_pointer_shape != f->output_data.x->nontext_cursor)) { unsigned char c; struct buffer *buf; current_pointer_shape = f->output_data.x->nontext_cursor; XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), current_pointer_shape); buf = XBUFFER (XWINDOW (Vmouse_window)->buffer); c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset)); } else if (EQ (Vmouse_frame_part, Qmodeline_part) && (current_pointer_shape != f->output_data.x->modeline_cursor)) { current_pointer_shape = f->output_data.x->modeline_cursor; XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), current_pointer_shape); } XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; } #endif #if 0 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e", "Draw rectangle around character under mouse pointer, if there is one.") (event) Lisp_Object event; { struct window *w = XWINDOW (Vmouse_window); struct frame *f = XFRAME (WINDOW_FRAME (w)); struct buffer *b = XBUFFER (w->buffer); Lisp_Object obj; if (! EQ (Vmouse_window, selected_window)) return Qnil; if (EQ (event, Qnil)) { int x, y; x_read_mouse_position (selected_frame, &x, &y); } BLOCK_INPUT; mouse_track_width = 0; mouse_track_left = mouse_track_top = -1; do { if ((x_mouse_x != mouse_track_left && (x_mouse_x < mouse_track_left || x_mouse_x > (mouse_track_left + mouse_track_width))) || x_mouse_y != mouse_track_top) { int hp = 0; /* Horizontal position */ int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y]; int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y]; int tab_width = XINT (b->tab_width); int ctl_arrow_p = !NILP (b->ctl_arrow); unsigned char c; int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1; int in_mode_line = 0; if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y]) break; /* Erase previous rectangle. */ if (mouse_track_width) { x_rectangle (f, f->output_data.x->reverse_gc, mouse_track_left, mouse_track_top, mouse_track_width, 1); if ((mouse_track_left == f->phys_cursor_x || mouse_track_left == f->phys_cursor_x - 1) && mouse_track_top == f->phys_cursor_y) { x_display_cursor (f, 1); } } mouse_track_left = x_mouse_x; mouse_track_top = x_mouse_y; mouse_track_width = 0; if (mouse_track_left > len) /* Past the end of line. */ goto draw_or_not; if (mouse_track_top == mode_line_vpos) { in_mode_line = 1; goto draw_or_not; } if (tab_width <= 0 || tab_width > 20) tab_width = 8; do { c = FETCH_CHAR (p); if (len == f->width && hp == len - 1 && c != '\n') goto draw_or_not; switch (c) { case '\t': mouse_track_width = tab_width - (hp % tab_width); p++; hp += mouse_track_width; if (hp > x_mouse_x) { mouse_track_left = hp - mouse_track_width; goto draw_or_not; } continue; case '\n': mouse_track_width = -1; goto draw_or_not; default: if (ctl_arrow_p && (c < 040 || c == 0177)) { if (p > ZV) goto draw_or_not; mouse_track_width = 2; p++; hp +=2; if (hp > x_mouse_x) { mouse_track_left = hp - mouse_track_width; goto draw_or_not; } } else { mouse_track_width = 1; p++; hp++; } continue; } } while (hp <= x_mouse_x); draw_or_not: if (mouse_track_width) /* Over text; use text pointer shape. */ { XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->text_cursor); x_rectangle (f, f->output_data.x->cursor_gc, mouse_track_left, mouse_track_top, mouse_track_width, 1); } else if (in_mode_line) XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->modeline_cursor); else XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->nontext_cursor); } XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; obj = read_char (-1, 0, 0, Qnil, 0); BLOCK_INPUT; } while (CONSP (obj) /* Mouse event */ && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */ && EQ (Vmouse_depressed, Qnil) /* Only motion events */ && EQ (Vmouse_window, selected_window) /* In this window */ && x_mouse_frame); unread_command_event = obj; if (mouse_track_width) { x_rectangle (f, f->output_data.x->reverse_gc, mouse_track_left, mouse_track_top, mouse_track_width, 1); mouse_track_width = 0; if ((mouse_track_left == f->phys_cursor_x || mouse_track_left - 1 == f->phys_cursor_x) && mouse_track_top == f->phys_cursor_y) { x_display_cursor (f, 1); } } XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->nontext_cursor); XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; return Qnil; } #endif #if 0 #include "glyphs.h" /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT on the frame F at position X, Y. */ x_draw_pixmap (f, x, y, image_data, width, height) struct frame *f; int x, y, width, height; char *image_data; { Pixmap image; image = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), image_data, width, height); XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f), f->output_data.x->normal_gc, 0, 0, width, height, x, y); } #endif #if 0 /* I'm told these functions are superfluous given the ability to bind function keys. */ #ifdef HAVE_X11 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0, "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\ KEYSYM is a string which conforms to the X keysym definitions found\n\ in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\ list of strings specifying modifier keys such as Control_L, which must\n\ also be depressed for NEWSTRING to appear.") (x_keysym, modifiers, newstring) register Lisp_Object x_keysym; register Lisp_Object modifiers; register Lisp_Object newstring; { char *rawstring; register KeySym keysym; KeySym modifier_list[16]; check_x (); CHECK_STRING (x_keysym, 1); CHECK_STRING (newstring, 3); keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data); if (keysym == NoSymbol) error ("Keysym does not exist"); if (NILP (modifiers)) XRebindKeysym (x_current_display, keysym, modifier_list, 0, XSTRING (newstring)->data, XSTRING (newstring)->size); else { register Lisp_Object rest, mod; register int i = 0; for (rest = modifiers; !NILP (rest); rest = Fcdr (rest)) { if (i == 16) error ("Can't have more than 16 modifiers"); mod = Fcar (rest); CHECK_STRING (mod, 3); modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data); #ifndef HAVE_X11R5 if (modifier_list[i] == NoSymbol || !(IsModifierKey (modifier_list[i]) || ((unsigned)(modifier_list[i]) == XK_Mode_switch) || ((unsigned)(modifier_list[i]) == XK_Num_Lock))) #else if (modifier_list[i] == NoSymbol || !IsModifierKey (modifier_list[i])) #endif error ("Element is not a modifier keysym"); i++; } XRebindKeysym (x_current_display, keysym, modifier_list, i, XSTRING (newstring)->data, XSTRING (newstring)->size); } return Qnil; } DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0, "Rebind KEYCODE to list of strings STRINGS.\n\ STRINGS should be a list of 16 elements, one for each shift combination.\n\ nil as element means don't change.\n\ See the documentation of `x-rebind-key' for more information.") (keycode, strings) register Lisp_Object keycode; register Lisp_Object strings; { register Lisp_Object item; register unsigned char *rawstring; KeySym rawkey, modifier[1]; int strsize; register unsigned i; check_x (); CHECK_NUMBER (keycode, 1); CHECK_CONS (strings, 2); rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255; for (i = 0; i <= 15; strings = Fcdr (strings), i++) { item = Fcar (strings); if (!NILP (item)) { CHECK_STRING (item, 2); strsize = XSTRING (item)->size; rawstring = (unsigned char *) xmalloc (strsize); bcopy (XSTRING (item)->data, rawstring, strsize); modifier[1] = 1 << i; XRebindKeysym (x_current_display, rawkey, modifier, 1, rawstring, strsize); } } return Qnil; } #endif /* HAVE_X11 */ #endif /* 0 */ #ifndef HAVE_XSCREENNUMBEROFSCREEN int XScreenNumberOfScreen (scr) register Screen *scr; { register Display *dpy; register Screen *dpyscr; register int i; dpy = scr->display; dpyscr = dpy->screens; for (i = 0; i < dpy->nscreens; i++, dpyscr++) if (scr == dpyscr) return i; return -1; } #endif /* not HAVE_XSCREENNUMBEROFSCREEN */ Visual * select_visual (dpy, screen, depth) Display *dpy; Screen *screen; unsigned int *depth; { Visual *v; XVisualInfo *vinfo, vinfo_template; int n_visuals; v = DefaultVisualOfScreen (screen); #ifdef HAVE_X11R4 vinfo_template.visualid = XVisualIDFromVisual (v); #else vinfo_template.visualid = v->visualid; #endif vinfo_template.screen = XScreenNumberOfScreen (screen); vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask, &vinfo_template, &n_visuals); if (n_visuals != 1) fatal ("Can't get proper X visual info"); if ((1 << vinfo->depth) == vinfo->colormap_size) *depth = vinfo->depth; else { int i = 0; int n = vinfo->colormap_size - 1; while (n) { n = n >> 1; i++; } *depth = i; } XFree ((char *) vinfo); return v; } /* Return the X display structure for the display named NAME. Open a new connection if necessary. */ struct x_display_info * x_display_info_for_name (name) Lisp_Object name; { Lisp_Object names; struct x_display_info *dpyinfo; CHECK_STRING (name, 0); if (! EQ (Vwindow_system, intern ("x"))) error ("Not using X Windows"); for (dpyinfo = x_display_list, names = x_display_name_list; dpyinfo; dpyinfo = dpyinfo->next, names = XCONS (names)->cdr) { Lisp_Object tem; tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name); if (!NILP (tem)) return dpyinfo; } /* Use this general default value to start with. */ Vx_resource_name = Vinvocation_name; validate_x_resource_name (); dpyinfo = x_term_init (name, (unsigned char *)0, (char *) XSTRING (Vx_resource_name)->data); if (dpyinfo == 0) error ("Cannot connect to X server %s", XSTRING (name)->data); x_in_use = 1; XSETFASTINT (Vwindow_system_version, 11); return dpyinfo; } DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1, 3, 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.\n\ If the optional third arg MUST-SUCCEED is non-nil,\n\ terminate Emacs if we can't open the connection.") (display, xrm_string, must_succeed) Lisp_Object display, xrm_string, must_succeed; { unsigned int n_planes; unsigned char *xrm_option; struct x_display_info *dpyinfo; CHECK_STRING (display, 0); if (! NILP (xrm_string)) CHECK_STRING (xrm_string, 1); if (! EQ (Vwindow_system, intern ("x"))) error ("Not using X Windows"); if (! NILP (xrm_string)) xrm_option = (unsigned char *) XSTRING (xrm_string)->data; else xrm_option = (unsigned char *) 0; /* Use this general default value to start with. */ Vx_resource_name = Vinvocation_name; validate_x_resource_name (); /* This is what opens the connection and sets x_current_display. This also initializes many symbols, such as those used for input. */ dpyinfo = x_term_init (display, xrm_option, (char *) XSTRING (Vx_resource_name)->data); if (dpyinfo == 0) { if (!NILP (must_succeed)) fatal ("Cannot connect to X server %s.\n\ Check the DISPLAY environment variable or use `-d'.\n\ Also use the `xhost' program to verify that it is set to permit\n\ connections from your machine.\n", XSTRING (display)->data); else error ("Cannot connect to X server %s", XSTRING (display)->data); } x_in_use = 1; XSETFASTINT (Vwindow_system_version, 11); return Qnil; } DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection, 1, 1, 0, "Close the connection to DISPLAY's X server.\n\ For DISPLAY, specify either a frame or a display name (a string).\n\ If DISPLAY is nil, that stands for the selected frame's display.") (display) Lisp_Object display; { struct x_display_info *dpyinfo = check_x_display_info (display); struct x_display_info *tail; int i; if (dpyinfo->reference_count > 0) error ("Display still has frames on it"); BLOCK_INPUT; /* Free the fonts in the font table. */ for (i = 0; i < dpyinfo->n_fonts; i++) { if (dpyinfo->font_table[i].name) free (dpyinfo->font_table[i].name); /* Don't free the full_name string; it is always shared with something else. */ XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font); } x_destroy_all_bitmaps (dpyinfo); XSetCloseDownMode (dpyinfo->display, DestroyAll); #ifdef USE_X_TOOLKIT XtCloseDisplay (dpyinfo->display); #else XCloseDisplay (dpyinfo->display); #endif x_delete_display (dpyinfo); UNBLOCK_INPUT; return Qnil; } DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0, "Return the list of display names that Emacs has connections to.") () { Lisp_Object tail, result; result = Qnil; for (tail = x_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr) result = Fcons (XCONS (XCONS (tail)->car)->car, result); return result; } DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\ If ON is nil, allow buffering of requests.\n\ Turning on synchronization prohibits the Xlib routines from buffering\n\ requests and seriously degrades performance, but makes debugging much\n\ easier.\n\ The optional second argument DISPLAY specifies which display to act on.\n\ DISPLAY should be either a frame or a display name (a string).\n\ If DISPLAY is omitted or nil, that stands for the selected frame's display.") (on, display) Lisp_Object display, on; { struct x_display_info *dpyinfo = check_x_display_info (display); XSynchronize (dpyinfo->display, !EQ (on, Qnil)); return Qnil; } /* Wait for responses to all X commands issued so far for frame F. */ void x_sync (f) FRAME_PTR f; { BLOCK_INPUT; XSync (FRAME_X_DISPLAY (f), False); UNBLOCK_INPUT; } syms_of_xfns () { /* This is zero if not using X windows. */ x_in_use = 0; /* The section below is built by the lisp expression at the top of the file, just above where these variables are declared. */ /*&&& init symbols here &&&*/ Qauto_raise = intern ("auto-raise"); staticpro (&Qauto_raise); Qauto_lower = intern ("auto-lower"); staticpro (&Qauto_lower); Qbackground_color = intern ("background-color"); staticpro (&Qbackground_color); Qbar = intern ("bar"); staticpro (&Qbar); Qborder_color = intern ("border-color"); staticpro (&Qborder_color); Qborder_width = intern ("border-width"); staticpro (&Qborder_width); Qbox = intern ("box"); staticpro (&Qbox); Qcursor_color = intern ("cursor-color"); staticpro (&Qcursor_color); Qcursor_type = intern ("cursor-type"); staticpro (&Qcursor_type); Qfont = intern ("font"); staticpro (&Qfont); Qforeground_color = intern ("foreground-color"); staticpro (&Qforeground_color); Qgeometry = intern ("geometry"); staticpro (&Qgeometry); Qicon_left = intern ("icon-left"); staticpro (&Qicon_left); Qicon_top = intern ("icon-top"); staticpro (&Qicon_top); Qicon_type = intern ("icon-type"); staticpro (&Qicon_type); Qicon_name = intern ("icon-name"); staticpro (&Qicon_name); Qinternal_border_width = intern ("internal-border-width"); staticpro (&Qinternal_border_width); Qleft = intern ("left"); staticpro (&Qleft); Qmouse_color = intern ("mouse-color"); staticpro (&Qmouse_color); Qnone = intern ("none"); staticpro (&Qnone); Qparent_id = intern ("parent-id"); staticpro (&Qparent_id); Qscroll_bar_width = intern ("scroll-bar-width"); staticpro (&Qscroll_bar_width); Qsuppress_icon = intern ("suppress-icon"); staticpro (&Qsuppress_icon); Qtop = intern ("top"); staticpro (&Qtop); Qundefined_color = intern ("undefined-color"); staticpro (&Qundefined_color); Qvertical_scroll_bars = intern ("vertical-scroll-bars"); staticpro (&Qvertical_scroll_bars); Qvisibility = intern ("visibility"); staticpro (&Qvisibility); Qwindow_id = intern ("window-id"); staticpro (&Qwindow_id); Qx_frame_parameter = intern ("x-frame-parameter"); staticpro (&Qx_frame_parameter); Qx_resource_name = intern ("x-resource-name"); staticpro (&Qx_resource_name); Quser_position = intern ("user-position"); staticpro (&Quser_position); Quser_size = intern ("user-size"); staticpro (&Quser_size); Qdisplay = intern ("display"); staticpro (&Qdisplay); /* This is the end of symbol initialization. */ Fput (Qundefined_color, Qerror_conditions, Fcons (Qundefined_color, Fcons (Qerror, Qnil))); Fput (Qundefined_color, Qerror_message, build_string ("Undefined color")); init_x_parm_symbols (); DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path, "List of directories to search for bitmap files for X."); Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS); DEFVAR_LISP ("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; #if 0 /* This doesn't really do anything. */ DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape, "The shape of the pointer when not over text.\n\ This variable takes effect when you create a new frame\n\ or when you set the mouse color."); #endif Vx_nontext_pointer_shape = Qnil; #if 0 /* This doesn't really do anything. */ DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape, "The shape of the pointer when over the mode line.\n\ This variable takes effect when you create a new frame\n\ or when you set the mouse color."); #endif Vx_mode_pointer_shape = Qnil; DEFVAR_INT ("x-sensitive-text-pointer-shape", &Vx_sensitive_text_pointer_shape, "The shape of the pointer when over mouse-sensitive text.\n\ This variable takes effect when you create a new frame\n\ or when you set the mouse color."); Vx_sensitive_text_pointer_shape = Qnil; DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel, "A string indicating the foreground color of the cursor box."); Vx_cursor_fore_pixel = Qnil; DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager, "Non-nil if no X window manager is in use.\n\ Emacs doesn't try to figure this out; this is always nil\n\ unless you set it to something else."); /* We don't have any way to find this out, so set it to nil and maybe the user would like to set it to t. */ Vx_no_window_manager = Qnil; #ifdef USE_X_TOOLKIT Fprovide (intern ("x-toolkit")); #endif #ifdef USE_MOTIF Fprovide (intern ("motif")); #endif defsubr (&Sx_get_resource); #if 0 defsubr (&Sx_draw_rectangle); defsubr (&Sx_erase_rectangle); defsubr (&Sx_contour_region); defsubr (&Sx_uncontour_region); #endif defsubr (&Sx_list_fonts); defsubr (&Sx_display_color_p); defsubr (&Sx_display_grayscale_p); defsubr (&Sx_color_defined_p); defsubr (&Sx_color_values); defsubr (&Sx_server_max_request_size); defsubr (&Sx_server_vendor); defsubr (&Sx_server_version); defsubr (&Sx_display_pixel_width); defsubr (&Sx_display_pixel_height); defsubr (&Sx_display_mm_width); defsubr (&Sx_display_mm_height); defsubr (&Sx_display_screens); defsubr (&Sx_display_planes); defsubr (&Sx_display_color_cells); defsubr (&Sx_display_visual_class); defsubr (&Sx_display_backing_store); defsubr (&Sx_display_save_under); #if 0 defsubr (&Sx_rebind_key); defsubr (&Sx_rebind_keys); defsubr (&Sx_track_pointer); defsubr (&Sx_grab_pointer); defsubr (&Sx_ungrab_pointer); #endif defsubr (&Sx_parse_geometry); defsubr (&Sx_create_frame); defsubr (&Sfocus_frame); defsubr (&Sunfocus_frame); #if 0 defsubr (&Sx_horizontal_line); #endif defsubr (&Sx_open_connection); defsubr (&Sx_close_connection); defsubr (&Sx_display_list); defsubr (&Sx_synchronize); } #endif /* HAVE_X_WINDOWS */ emacs-19.30/src/xmenu.c100444 12120 1 216311 6050717656 13247 0ustar rmsdaemon/* X Communication module for terminals which understand the X protocol. Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc. This file is part of GNU Emacs. 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. */ /* X pop-up deck-of-cards menu facility for gnuemacs. * * Written by Jon Arnold and Roman Budzianowski * Mods and rewrite by Robert Krawitz * */ /* Modified by Fred Pierresteguy on December 93 to make the popup menus and menubar use the Xt. */ /* Rewritten for clarity and GC protection by rms in Feb 94. */ /* On 4.3 this loses if it comes after xterm.h. */ #include #include #include #include "lisp.h" #include "termhooks.h" #include "frame.h" #include "window.h" #include "keyboard.h" #include "blockinput.h" #include "puresize.h" #include "buffer.h" #ifdef MSDOS #include "msdos.h" #endif #ifdef HAVE_X_WINDOWS /* This may include sys/types.h, and that somehow loses if this is not done before the other system files. */ #include "xterm.h" #endif /* Load sys/types.h if not already loaded. In some systems loading it twice is suicidal. */ #ifndef makedev #include #endif #include "dispextern.h" #ifdef HAVE_X_WINDOWS #ifdef USE_X_TOOLKIT #include #include #include #include #include #ifdef USE_LUCID #include #endif /* USE_LUCID */ #include "../lwlib/lwlib.h" #else /* not USE_X_TOOLKIT */ #include "../oldXMenu/XMenu.h" #endif /* not USE_X_TOOLKIT */ #endif /* HAVE_X_WINDOWS */ #define min(x,y) (((x) < (y)) ? (x) : (y)) #define max(x,y) (((x) > (y)) ? (x) : (y)) #ifndef TRUE #define TRUE 1 #define FALSE 0 #endif /* no TRUE */ Lisp_Object Qdebug_on_next_call; extern Lisp_Object Qmenu_enable; extern Lisp_Object Qmenu_bar; extern Lisp_Object Qmouse_click, Qevent_kind; extern Lisp_Object Vdefine_key_rebound_commands; extern Lisp_Object Voverriding_local_map; extern Lisp_Object Voverriding_local_map_menu_flag; extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map; extern Lisp_Object Qmenu_bar_update_hook; #ifdef USE_X_TOOLKIT extern void set_frame_menubar (); extern void process_expose_from_menu (); extern XtAppContext Xt_app_con; static Lisp_Object xdialog_show (); void popup_get_selection (); #endif static Lisp_Object xmenu_show (); static void keymap_panes (); static void single_keymap_panes (); static void list_of_panes (); static void list_of_items (); /* This holds a Lisp vector that holds the results of decoding the keymaps or alist-of-alists that specify a menu. It describes the panes and items within the panes. Each pane is described by 3 elements in the vector: t, the pane name, the pane's prefix key. Then follow the pane's items, with 5 elements per item: the item string, the enable flag, the item's value, the definition, and the equivalent keyboard key's description string. In some cases, multiple levels of menus may be described. A single vector slot containing nil indicates the start of a submenu. A single vector slot containing lambda indicates the end of a submenu. The submenu follows a menu item which is the way to reach the submenu. A single vector slot containing quote indicates that the following items should appear on the right of a dialog box. Using a Lisp vector to hold this information while we decode it takes care of protecting all the data from GC. */ #define MENU_ITEMS_PANE_NAME 1 #define MENU_ITEMS_PANE_PREFIX 2 #define MENU_ITEMS_PANE_LENGTH 3 #define MENU_ITEMS_ITEM_NAME 0 #define MENU_ITEMS_ITEM_ENABLE 1 #define MENU_ITEMS_ITEM_VALUE 2 #define MENU_ITEMS_ITEM_EQUIV_KEY 3 #define MENU_ITEMS_ITEM_DEFINITION 4 #define MENU_ITEMS_ITEM_LENGTH 5 static Lisp_Object menu_items; /* Number of slots currently allocated in menu_items. */ static int menu_items_allocated; /* This is the index in menu_items of the first empty slot. */ static int menu_items_used; /* The number of panes currently recorded in menu_items, excluding those within submenus. */ static int menu_items_n_panes; /* Current depth within submenus. */ static int menu_items_submenu_depth; /* Flag which when set indicates a dialog or menu has been posted by Xt on behalf of one of the widget sets. */ static int popup_activated_flag; static int next_menubar_widget_id; #ifdef USE_X_TOOLKIT /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */ static struct frame * menubar_id_to_frame (id) LWLIB_ID id; { Lisp_Object tail, frame; FRAME_PTR f; for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr) { frame = XCONS (tail)->car; if (!GC_FRAMEP (frame)) continue; f = XFRAME (frame); if (f->output_data.nothing == 1) continue; if (f->output_data.x->id == id) return f; } return 0; } #endif /* Initialize the menu_items structure if we haven't already done so. Also mark it as currently empty. */ static void init_menu_items () { if (NILP (menu_items)) { menu_items_allocated = 60; menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); } menu_items_used = 0; menu_items_n_panes = 0; menu_items_submenu_depth = 0; } /* Call at the end of generating the data in menu_items. This fills in the number of items in the last pane. */ static void finish_menu_items () { } /* Call when finished using the data for the current menu in menu_items. */ static void discard_menu_items () { /* Free the structure if it is especially large. Otherwise, hold on to it, to save time. */ if (menu_items_allocated > 200) { menu_items = Qnil; menu_items_allocated = 0; } } /* Make the menu_items vector twice as large. */ static void grow_menu_items () { Lisp_Object old; int old_size = menu_items_allocated; old = menu_items; menu_items_allocated *= 2; menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents, old_size * sizeof (Lisp_Object)); } /* Begin a submenu. */ static void push_submenu_start () { if (menu_items_used + 1 > menu_items_allocated) grow_menu_items (); XVECTOR (menu_items)->contents[menu_items_used++] = Qnil; menu_items_submenu_depth++; } /* End a submenu. */ static void push_submenu_end () { if (menu_items_used + 1 > menu_items_allocated) grow_menu_items (); XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda; menu_items_submenu_depth--; } /* Indicate boundary between left and right. */ static void push_left_right_boundary () { if (menu_items_used + 1 > menu_items_allocated) grow_menu_items (); XVECTOR (menu_items)->contents[menu_items_used++] = Qquote; } /* Start a new menu pane in menu_items.. NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */ static void push_menu_pane (name, prefix_vec) Lisp_Object name, prefix_vec; { if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated) grow_menu_items (); if (menu_items_submenu_depth == 0) menu_items_n_panes++; XVECTOR (menu_items)->contents[menu_items_used++] = Qt; XVECTOR (menu_items)->contents[menu_items_used++] = name; XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec; } /* Push one menu item into the current pane. NAME is the string to display. ENABLE if non-nil means this item can be selected. KEY is the key generated by choosing this item, or nil if this item doesn't really have a definition. DEF is the definition of this item. EQUIV is the textual description of the keyboard equivalent for this item (or nil if none). */ static void push_menu_item (name, enable, key, def, equiv) Lisp_Object name, enable, key, def, equiv; { if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated) grow_menu_items (); XVECTOR (menu_items)->contents[menu_items_used++] = name; XVECTOR (menu_items)->contents[menu_items_used++] = enable; XVECTOR (menu_items)->contents[menu_items_used++] = key; XVECTOR (menu_items)->contents[menu_items_used++] = equiv; XVECTOR (menu_items)->contents[menu_items_used++] = def; } /* Figure out the current keyboard equivalent of a menu item ITEM1. The item string for menu display should be ITEM_STRING. Store the equivalent keyboard key sequence's textual description into *DESCRIP_PTR. Also cache them in the item itself. Return the real definition to execute. */ static Lisp_Object menu_item_equiv_key (item_string, item1, descrip_ptr) Lisp_Object item_string; Lisp_Object item1; Lisp_Object *descrip_ptr; { /* This is the real definition--the function to run. */ Lisp_Object def; /* This is the sublist that records cached equiv key data so we can save time. */ Lisp_Object cachelist; /* These are the saved equivalent keyboard key sequence and its key-description. */ Lisp_Object savedkey, descrip; Lisp_Object def1; int changed = 0; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; /* If a help string follows the item string, skip it. */ if (CONSP (XCONS (item1)->cdr) && STRINGP (XCONS (XCONS (item1)->cdr)->car)) item1 = XCONS (item1)->cdr; def = Fcdr (item1); /* Get out the saved equivalent-keyboard-key info. */ cachelist = savedkey = descrip = Qnil; if (CONSP (def) && CONSP (XCONS (def)->car) && (NILP (XCONS (XCONS (def)->car)->car) || VECTORP (XCONS (XCONS (def)->car)->car))) { cachelist = XCONS (def)->car; def = XCONS (def)->cdr; savedkey = XCONS (cachelist)->car; descrip = XCONS (cachelist)->cdr; } GCPRO4 (def, def1, savedkey, descrip); /* Is it still valid? */ def1 = Qnil; if (!NILP (savedkey)) def1 = Fkey_binding (savedkey, Qnil); /* If not, update it. */ if (! EQ (def1, def) /* If the command is an alias for another (such as easymenu.el and lmenu.el set it up), check if the original command matches the cached command. */ && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function) && EQ (def1, XSYMBOL (def)->function)) /* If something had no key binding before, don't recheck it because that is too slow--except if we have a list of rebound commands in Vdefine_key_rebound_commands, do recheck any command that appears in that list. */ && (NILP (cachelist) || !NILP (savedkey) || (! EQ (Qt, Vdefine_key_rebound_commands) && !NILP (Fmemq (def, Vdefine_key_rebound_commands))))) { changed = 1; descrip = Qnil; /* If the command is an alias for another (such as easymenu.el and lmenu.el set it up), see if the original command name has equivalent keys. */ if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)) savedkey = Fwhere_is_internal (XSYMBOL (def)->function, Qnil, Qt, Qnil); else /* Otherwise look up the specified command itself. We don't try both, because that makes easymenu menus slow. */ savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil); if (!NILP (savedkey)) { descrip = Fkey_description (savedkey); descrip = concat2 (make_string (" (", 3), descrip); descrip = concat2 (descrip, make_string (")", 1)); } } /* Cache the data we just got in a sublist of the menu binding. */ if (NILP (cachelist)) { CHECK_IMPURE (item1); XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def); } else if (changed) { XCONS (cachelist)->car = savedkey; XCONS (cachelist)->cdr = descrip; } UNGCPRO; *descrip_ptr = descrip; return def; } /* This is used as the handler when calling internal_condition_case_1. */ static Lisp_Object menu_item_enabled_p_1 (arg) Lisp_Object arg; { /* If we got a quit from within the menu computation, quit all the way out of it. This takes care of C-] in the debugger. */ if (CONSP (arg) && EQ (XCONS (arg)->car, Qquit)) Fsignal (Qquit, Qnil); return Qnil; } /* Return non-nil if the command DEF is enabled when used as a menu item. This is based on looking for a menu-enable property. If NOTREAL is set, don't bother really computing this. */ static Lisp_Object menu_item_enabled_p (def, notreal) Lisp_Object def; int notreal; { Lisp_Object enabled, tem; enabled = Qt; if (notreal) return enabled; if (SYMBOLP (def)) { /* No property, or nil, means enable. Otherwise, enable if value is not nil. */ tem = Fget (def, Qmenu_enable); if (!NILP (tem)) /* (condition-case nil (eval tem) (error nil)) */ enabled = internal_condition_case_1 (Feval, tem, Qerror, menu_item_enabled_p_1); } return enabled; } /* Look through KEYMAPS, a vector of keymaps that is NMAPS long, and generate menu panes for them in menu_items. If NOTREAL is nonzero, don't bother really computing whether an item is enabled. */ static void keymap_panes (keymaps, nmaps, notreal) Lisp_Object *keymaps; int nmaps; int notreal; { int mapno; init_menu_items (); /* Loop over the given keymaps, making a pane for each map. But don't make a pane that is empty--ignore that map instead. P is the number of panes we have made so far. */ for (mapno = 0; mapno < nmaps; mapno++) single_keymap_panes (keymaps[mapno], Qnil, Qnil, notreal); finish_menu_items (); } /* This is a recursive subroutine of keymap_panes. It handles one keymap, KEYMAP. The other arguments are passed along or point to local variables of the previous function. If NOTREAL is nonzero, don't bother really computing whether an item is enabled. */ static void single_keymap_panes (keymap, pane_name, prefix, notreal) Lisp_Object keymap; Lisp_Object pane_name; Lisp_Object prefix; int notreal; { Lisp_Object pending_maps; Lisp_Object tail, item, item1, item_string, table; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; pending_maps = Qnil; push_menu_pane (pane_name, prefix); for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr) { /* Look at each key binding, and if it has a menu string, make a menu item from it. */ item = XCONS (tail)->car; if (CONSP (item)) { item1 = XCONS (item)->cdr; if (CONSP (item1)) { item_string = XCONS (item1)->car; if (STRINGP (item_string)) { /* This is the real definition--the function to run. */ Lisp_Object def; /* These are the saved equivalent keyboard key sequence and its key-description. */ Lisp_Object descrip; Lisp_Object tem, enabled; /* GCPRO because ...enabled_p will call eval and ..._equiv_key may autoload something. Protecting KEYMAP preserves everything we use; aside from that, must protect whatever might be a string. Since there's no GCPRO5, we refetch item_string instead of protecting it. */ descrip = def = Qnil; GCPRO4 (keymap, pending_maps, def, descrip); def = menu_item_equiv_key (item_string, item1, &descrip); enabled = menu_item_enabled_p (def, notreal); UNGCPRO; item_string = XCONS (item1)->car; tem = Fkeymapp (def); if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) pending_maps = Fcons (Fcons (def, Fcons (item_string, XCONS (item)->car)), pending_maps); else { Lisp_Object submap; GCPRO4 (keymap, pending_maps, descrip, item_string); submap = get_keymap_1 (def, 0, 1); UNGCPRO; #ifndef USE_X_TOOLKIT /* Indicate visually that this is a submenu. */ if (!NILP (submap)) item_string = concat2 (item_string, build_string (" >")); #endif /* If definition is nil, pass nil as the key. */ push_menu_item (item_string, enabled, XCONS (item)->car, def, descrip); #ifdef USE_X_TOOLKIT /* Display a submenu using the toolkit. */ if (! NILP (submap)) { push_submenu_start (); single_keymap_panes (submap, Qnil, XCONS (item)->car, notreal); push_submenu_end (); } #endif } } } } else if (VECTORP (item)) { /* Loop over the char values represented in the vector. */ int len = XVECTOR (item)->size; int c; for (c = 0; c < len; c++) { Lisp_Object character; XSETFASTINT (character, c); item1 = XVECTOR (item)->contents[c]; if (CONSP (item1)) { item_string = XCONS (item1)->car; if (STRINGP (item_string)) { Lisp_Object def; /* These are the saved equivalent keyboard key sequence and its key-description. */ Lisp_Object descrip; Lisp_Object tem, enabled; /* GCPRO because ...enabled_p will call eval and ..._equiv_key may autoload something. Protecting KEYMAP preserves everything we use; aside from that, must protect whatever might be a string. Since there's no GCPRO5, we refetch item_string instead of protecting it. */ GCPRO4 (keymap, pending_maps, def, descrip); descrip = def = Qnil; def = menu_item_equiv_key (item_string, item1, &descrip); enabled = menu_item_enabled_p (def, notreal); UNGCPRO; item_string = XCONS (item1)->car; tem = Fkeymapp (def); if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) pending_maps = Fcons (Fcons (def, Fcons (item_string, character)), pending_maps); else { Lisp_Object submap; GCPRO4 (keymap, pending_maps, descrip, item_string); submap = get_keymap_1 (def, 0, 1); UNGCPRO; #ifndef USE_X_TOOLKIT if (!NILP (submap)) item_string = concat2 (item_string, build_string (" >")); #endif /* If definition is nil, pass nil as the key. */ push_menu_item (item_string, enabled, character, def, descrip); #ifdef USE_X_TOOLKIT if (! NILP (submap)) { push_submenu_start (); single_keymap_panes (submap, Qnil, character, notreal); push_submenu_end (); } #endif } } } } } } /* Process now any submenus which want to be panes at this level. */ while (!NILP (pending_maps)) { Lisp_Object elt, eltcdr, string; elt = Fcar (pending_maps); eltcdr = XCONS (elt)->cdr; string = XCONS (eltcdr)->car; /* We no longer discard the @ from the beginning of the string here. Instead, we do this in xmenu_show. */ single_keymap_panes (Fcar (elt), string, XCONS (eltcdr)->cdr, notreal); pending_maps = Fcdr (pending_maps); } } /* Push all the panes and items of a menu decsribed by the alist-of-alists MENU. This handles old-fashioned calls to x-popup-menu. */ static void list_of_panes (menu) Lisp_Object menu; { Lisp_Object tail; init_menu_items (); for (tail = menu; !NILP (tail); tail = Fcdr (tail)) { Lisp_Object elt, pane_name, pane_data; elt = Fcar (tail); pane_name = Fcar (elt); CHECK_STRING (pane_name, 0); push_menu_pane (pane_name, Qnil); pane_data = Fcdr (elt); CHECK_CONS (pane_data, 0); list_of_items (pane_data); } finish_menu_items (); } /* Push the items in a single pane defined by the alist PANE. */ static void list_of_items (pane) Lisp_Object pane; { Lisp_Object tail, item, item1; for (tail = pane; !NILP (tail); tail = Fcdr (tail)) { item = Fcar (tail); if (STRINGP (item)) push_menu_item (item, Qnil, Qnil, Qt, Qnil); else if (NILP (item)) push_left_right_boundary (); else { CHECK_CONS (item, 0); item1 = Fcar (item); CHECK_STRING (item1, 1); push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil); } } } DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0, "Pop up a deck-of-cards menu and return user's selection.\n\ POSITION is a position specification. This is either a mouse button event\n\ or a list ((XOFFSET YOFFSET) WINDOW)\n\ where XOFFSET and YOFFSET are positions in pixels from the top left\n\ corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\ This controls the position of the center of the first line\n\ in the first pane of the menu, not the top left of the menu as a whole.\n\ If POSITION is t, it means to use the current mouse position.\n\ \n\ MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\ The menu items come from key bindings that have a menu string as well as\n\ a definition; actually, the \"definition\" in such a key binding looks like\n\ \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\ the keymap as a top-level element.\n\n\ You can also use a list of keymaps as MENU.\n\ Then each keymap makes a separate pane.\n\ When MENU is a keymap or a list of keymaps, the return value\n\ is a list of events.\n\n\ Alternatively, you can specify a menu of multiple panes\n\ with a list of the form (TITLE PANE1 PANE2...),\n\ where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\ Each ITEM is normally a cons cell (STRING . VALUE);\n\ but a string can appear as an item--that makes a nonselectable line\n\ in the menu.\n\ With this form of menu, the return value is VALUE from the chosen item.\n\ \n\ If POSITION is nil, don't display the menu at all, just precalculate the\n\ cached information about equivalent key sequences.") (position, menu) Lisp_Object position, menu; { int number_of_panes, panes; Lisp_Object keymap, tem; int xpos, ypos; Lisp_Object title; char *error_name; Lisp_Object selection; int i, j; FRAME_PTR f; Lisp_Object x, y, window; int keymaps = 0; int for_click = 0; struct gcpro gcpro1; if (! NILP (position)) { check_x (); /* Decode the first argument: find the window and the coordinates. */ if (EQ (position, Qt) || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar))) { /* Use the mouse's current position. */ FRAME_PTR new_f = selected_frame; Lisp_Object bar_window; int part; unsigned long time; if (mouse_position_hook) (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time); if (new_f != 0) XSETFRAME (window, new_f); else { window = selected_window; XSETFASTINT (x, 0); XSETFASTINT (y, 0); } } else { tem = Fcar (position); if (CONSP (tem)) { window = Fcar (Fcdr (position)); x = Fcar (tem); y = Fcar (Fcdr (tem)); } else { for_click = 1; tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ window = Fcar (tem); /* POSN_WINDOW (tem) */ tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */ x = Fcar (tem); y = Fcdr (tem); } } CHECK_NUMBER (x, 0); CHECK_NUMBER (y, 0); /* Decode where to put the menu. */ if (FRAMEP (window)) { f = XFRAME (window); xpos = 0; ypos = 0; } else if (WINDOWP (window)) { CHECK_LIVE_WINDOW (window, 0); f = XFRAME (WINDOW_FRAME (XWINDOW (window))); xpos = (FONT_WIDTH (f->output_data.x->font) * XWINDOW (window)->left); ypos = (f->output_data.x->line_height * XWINDOW (window)->top); } else /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, but I don't want to make one now. */ CHECK_WINDOW (window, 0); xpos += XINT (x); ypos += XINT (y); } title = Qnil; GCPRO1 (title); /* Decode the menu items from what was specified. */ keymap = Fkeymapp (menu); tem = Qnil; if (CONSP (menu)) tem = Fkeymapp (Fcar (menu)); if (!NILP (keymap)) { /* We were given a keymap. Extract menu info from the keymap. */ Lisp_Object prompt; keymap = get_keymap (menu); /* Extract the detailed info to make one pane. */ keymap_panes (&menu, 1, NILP (position)); /* Search for a string appearing directly as an element of the keymap. That string is the title of the menu. */ prompt = map_prompt (keymap); /* Make that be the pane title of the first pane. */ if (!NILP (prompt) && menu_items_n_panes >= 0) XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt; keymaps = 1; } else if (!NILP (tem)) { /* We were given a list of keymaps. */ int nmaps = XFASTINT (Flength (menu)); Lisp_Object *maps = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); int i; title = Qnil; /* The first keymap that has a prompt string supplies the menu title. */ for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem)) { Lisp_Object prompt; maps[i++] = keymap = get_keymap (Fcar (tem)); prompt = map_prompt (keymap); if (NILP (title) && !NILP (prompt)) title = prompt; } /* Extract the detailed info to make one pane. */ keymap_panes (maps, nmaps, NILP (position)); /* Make the title be the pane title of the first pane. */ if (!NILP (title) && menu_items_n_panes >= 0) XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title; keymaps = 1; } else { /* We were given an old-fashioned menu. */ title = Fcar (menu); CHECK_STRING (title, 1); list_of_panes (Fcdr (menu)); keymaps = 0; } if (NILP (position)) { discard_menu_items (); UNGCPRO; return Qnil; } /* Display them in a menu. */ BLOCK_INPUT; selection = xmenu_show (f, xpos, ypos, for_click, keymaps, title, &error_name); UNBLOCK_INPUT; discard_menu_items (); UNGCPRO; if (error_name) error (error_name); return selection; } DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0, "Pop up a dialog box and return user's selection.\n\ POSITION specifies which frame to use.\n\ This is normally a mouse button event or a window or frame.\n\ If POSITION is t, it means to use the frame the mouse is on.\n\ The dialog box appears in the middle of the specified frame.\n\ \n\ CONTENTS specifies the alternatives to display in the dialog box.\n\ It is a list of the form (TITLE ITEM1 ITEM2...).\n\ Each ITEM is a cons cell (STRING . VALUE).\n\ The return value is VALUE from the chosen item.\n\n\ An ITEM may also be just a string--that makes a nonselectable item.\n\ An ITEM may also be nil--that means to put all preceding items\n\ on the left of the dialog box and all following items on the right.\n\ \(By default, approximately half appear on each side.)") (position, contents) Lisp_Object position, contents; { FRAME_PTR f; Lisp_Object window; check_x (); /* Decode the first argument: find the window or frame to use. */ if (EQ (position, Qt) || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar))) { #if 0 /* Using the frame the mouse is on may not be right. */ /* Use the mouse's current position. */ FRAME_PTR new_f = selected_frame; Lisp_Object bar_window; int part; unsigned long time; Lisp_Object x, y; (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time); if (new_f != 0) XSETFRAME (window, new_f); else window = selected_window; #endif window = selected_window; } else if (CONSP (position)) { Lisp_Object tem; tem = Fcar (position); if (CONSP (tem)) window = Fcar (Fcdr (position)); else { tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ window = Fcar (tem); /* POSN_WINDOW (tem) */ } } else if (WINDOWP (position) || FRAMEP (position)) window = position; /* Decode where to put the menu. */ if (FRAMEP (window)) f = XFRAME (window); else if (WINDOWP (window)) { CHECK_LIVE_WINDOW (window, 0); f = XFRAME (WINDOW_FRAME (XWINDOW (window))); } else /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, but I don't want to make one now. */ CHECK_WINDOW (window, 0); #ifndef USE_X_TOOLKIT /* Display a menu with these alternatives in the middle of frame F. */ { Lisp_Object x, y, frame, newpos; XSETFRAME (frame, f); XSETINT (x, x_pixel_width (f) / 2); XSETINT (y, x_pixel_height (f) / 2); newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil)); return Fx_popup_menu (newpos, Fcons (Fcar (contents), Fcons (contents, Qnil))); } #else { Lisp_Object title; char *error_name; Lisp_Object selection; /* Decode the dialog items from what was specified. */ title = Fcar (contents); CHECK_STRING (title, 1); list_of_panes (Fcons (contents, Qnil)); /* Display them in a dialog box. */ BLOCK_INPUT; selection = xdialog_show (f, 0, title, &error_name); UNBLOCK_INPUT; discard_menu_items (); if (error_name) error (error_name); return selection; } #endif } #ifdef USE_X_TOOLKIT /* Loop in Xt until the menu pulldown or dialog popup has been popped down (deactivated). NOTE: All calls to popup_get_selection should be protected with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */ void popup_get_selection (initial_event, dpyinfo, id) XEvent *initial_event; struct x_display_info *dpyinfo; LWLIB_ID id; { XEvent event; /* Define a queue to save up for later unreading all X events that don't pertain to the menu. */ struct event_queue { XEvent event; struct event_queue *next; }; struct event_queue *queue = NULL; struct event_queue *queue_tmp; if (initial_event) event = *initial_event; else XtAppNextEvent (Xt_app_con, &event); while (1) { /* Handle expose events for editor frames right away. */ if (event.type == Expose) process_expose_from_menu (event); /* Make sure we don't consider buttons grabbed after menu goes. */ else if (event.type == ButtonRelease && dpyinfo->display == event.xbutton.display) dpyinfo->grabbed &= ~(1 << event.xbutton.button); /* If the user presses a key, deactivate the menu. The user is likely to do that if we get wedged. */ else if (event.type == KeyPress && dpyinfo->display == event.xbutton.display) { popup_activated_flag = 0; break; } /* Button presses outside the menu also pop it down. */ else if (event.type == ButtonPress && event.xany.display == dpyinfo->display && x_any_window_to_frame (dpyinfo, event.xany.window)) { popup_activated_flag = 0; break; } /* Queue all events not for this popup, except for Expose, which we've already handled. Note that the X window is associated with the frame if this is a menu bar popup, but not if it's a dialog box. So we use x_non_menubar_window_to_frame, not x_any_window_to_frame. */ if (event.type != Expose && (event.xany.display != dpyinfo->display || x_non_menubar_window_to_frame (dpyinfo, event.xany.window))) { queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue)); if (queue_tmp != NULL) { queue_tmp->event = event; queue_tmp->next = queue; queue = queue_tmp; } } else XtDispatchEvent (&event); if (!popup_activated ()) break; XtAppNextEvent (Xt_app_con, &event); } /* Unread any events that we got but did not handle. */ while (queue != NULL) { queue_tmp = queue; XPutBackEvent (queue_tmp->event.xany.display, &queue_tmp->event); queue = queue_tmp->next; free ((char *)queue_tmp); /* Cause these events to get read as soon as we UNBLOCK_INPUT. */ interrupt_input_pending = 1; } } /* Activate the menu bar of frame F. This is called from keyboard.c when it gets the menu_bar_activate_event out of the Emacs event queue. To activate the menu bar, we use the X button-press event that was saved in saved_button_event. That makes the toolkit do its thing. But first we recompute the menu bar contents (the whole tree). The reason for saving the button event until here, instead of passing it to the toolkit right away, is that we can safely execute Lisp code. */ x_activate_menubar (f) FRAME_PTR f; { if (f->output_data.x->saved_button_event->type != ButtonPress) return; set_frame_menubar (f, 0, 1); BLOCK_INPUT; XtDispatchEvent ((XEvent *) f->output_data.x->saved_button_event); UNBLOCK_INPUT; /* Ignore this if we get it a second time. */ f->output_data.x->saved_button_event->type = 0; } /* Detect if a dialog or menu has been posted. */ int popup_activated () { return popup_activated_flag; } /* This callback is invoked when the user selects a menubar cascade pushbutton, but before the pulldown menu is posted. */ static void popup_activate_callback (widget, id, client_data) Widget widget; LWLIB_ID id; XtPointer client_data; { popup_activated_flag = 1; } /* This callback is called from the menu bar pulldown menu when the user makes a selection. Figure out what the user chose and put the appropriate events into the keyboard buffer. */ static void menubar_selection_callback (widget, id, client_data) Widget widget; LWLIB_ID id; XtPointer client_data; { Lisp_Object prefix, entry; FRAME_PTR f = menubar_id_to_frame (id); Lisp_Object vector; Lisp_Object *subprefix_stack; int submenu_depth = 0; int i; if (!f) return; subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object)); vector = f->menu_bar_vector; prefix = Qnil; i = 0; while (i < f->menu_bar_items_used) { if (EQ (XVECTOR (vector)->contents[i], Qnil)) { subprefix_stack[submenu_depth++] = prefix; prefix = entry; i++; } else if (EQ (XVECTOR (vector)->contents[i], Qlambda)) { prefix = subprefix_stack[--submenu_depth]; i++; } else if (EQ (XVECTOR (vector)->contents[i], Qt)) { prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX]; i += MENU_ITEMS_PANE_LENGTH; } else { entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE]; /* The EMACS_INT cast avoids a warning. There's no problem as long as pointers have enough bits to hold small integers. */ if ((int) (EMACS_INT) client_data == i) { int j; struct input_event buf; Lisp_Object frame; XSETFRAME (frame, f); buf.kind = menu_bar_event; buf.frame_or_window = Fcons (frame, Fcons (Qmenu_bar, Qnil)); kbd_buffer_store_event (&buf); for (j = 0; j < submenu_depth; j++) if (!NILP (subprefix_stack[j])) { buf.kind = menu_bar_event; buf.frame_or_window = Fcons (frame, subprefix_stack[j]); kbd_buffer_store_event (&buf); } if (!NILP (prefix)) { buf.kind = menu_bar_event; buf.frame_or_window = Fcons (frame, prefix); kbd_buffer_store_event (&buf); } buf.kind = menu_bar_event; buf.frame_or_window = Fcons (frame, entry); kbd_buffer_store_event (&buf); return; } i += MENU_ITEMS_ITEM_LENGTH; } } } /* This callback is invoked when a dialog or menu is finished being used and has been unposted. */ static void popup_deactivate_callback (widget, id, client_data) Widget widget; LWLIB_ID id; XtPointer client_data; { popup_activated_flag = 0; } /* This recursively calls free_widget_value on the tree of widgets. It must free all data that was malloc'ed for these widget_values. In Emacs, many slots are pointers into the data of Lisp_Strings, and must be left alone. */ void free_menubar_widget_value_tree (wv) widget_value *wv; { if (! wv) return; wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; if (wv->contents && (wv->contents != (widget_value*)1)) { free_menubar_widget_value_tree (wv->contents); wv->contents = (widget_value *) 0xDEADBEEF; } if (wv->next) { free_menubar_widget_value_tree (wv->next); wv->next = (widget_value *) 0xDEADBEEF; } BLOCK_INPUT; free_widget_value (wv); UNBLOCK_INPUT; } /* Return a tree of widget_value structures for a menu bar item whose event type is ITEM_KEY (with string ITEM_NAME) and whose contents come from the list of keymaps MAPS. */ static widget_value * single_submenu (item_key, item_name, maps) Lisp_Object item_key, item_name, maps; { widget_value *wv, *prev_wv, *save_wv, *first_wv; int i; int submenu_depth = 0; Lisp_Object length; int len; Lisp_Object *mapvec; widget_value **submenu_stack; int mapno; int previous_items = menu_items_used; int top_level_items = 0; length = Flength (maps); len = XINT (length); /* Convert the list MAPS into a vector MAPVEC. */ mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); for (i = 0; i < len; i++) { mapvec[i] = Fcar (maps); maps = Fcdr (maps); } menu_items_n_panes = 0; /* Loop over the given keymaps, making a pane for each map. But don't make a pane that is empty--ignore that map instead. */ for (i = 0; i < len; i++) { if (SYMBOLP (mapvec[i])) { top_level_items = 1; push_menu_pane (Qnil, Qnil); push_menu_item (item_name, Qt, item_key, mapvec[i], Qnil); } else single_keymap_panes (mapvec[i], item_name, item_key, 0); } /* Create a tree of widget_value objects representing the panes and their items. */ submenu_stack = (widget_value **) alloca (menu_items_used * sizeof (widget_value *)); wv = malloc_widget_value (); wv->name = "menu"; wv->value = 0; wv->enabled = 1; first_wv = wv; save_wv = 0; prev_wv = 0; /* Loop over all panes and items made during this call and construct a tree of widget_value objects. Ignore the panes and items made by previous calls to single_submenu, even though those are also in menu_items. */ i = previous_items; while (i < menu_items_used) { if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) { submenu_stack[submenu_depth++] = save_wv; save_wv = prev_wv; prev_wv = 0; i++; } else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) { prev_wv = save_wv; save_wv = submenu_stack[--submenu_depth]; i++; } else if (EQ (XVECTOR (menu_items)->contents[i], Qt) && submenu_depth != 0) i += MENU_ITEMS_PANE_LENGTH; /* Ignore a nil in the item list. It's meaningful only for dialog boxes. */ else if (EQ (XVECTOR (menu_items)->contents[i], Qquote)) i += 1; else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) { /* Create a new pane. */ Lisp_Object pane_name, prefix; char *pane_string; pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME]; prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data); /* If there is just one top-level pane, put all its items directly under the top-level menu. */ if (menu_items_n_panes == 1) pane_string = ""; /* If the pane has a meaningful name, make the pane a top-level menu item with its items as a submenu beneath it. */ if (strcmp (pane_string, "")) { wv = malloc_widget_value (); if (save_wv) save_wv->next = wv; else first_wv->contents = wv; wv->name = pane_string; /* Ignore the @ that means "separate pane". This is a kludge, but this isn't worth more time. */ if (!NILP (prefix) && wv->name[0] == '@') wv->name++; wv->value = 0; wv->enabled = 1; } save_wv = wv; prev_wv = 0; i += MENU_ITEMS_PANE_LENGTH; } else { /* Create a new item within current pane. */ Lisp_Object item_name, enable, descrip, def; item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION]; wv = malloc_widget_value (); if (prev_wv) prev_wv->next = wv; else save_wv->contents = wv; wv->name = (char *) XSTRING (item_name)->data; if (!NILP (descrip)) wv->key = (char *) XSTRING (descrip)->data; wv->value = 0; /* The EMACS_INT cast avoids a warning. There's no problem as long as pointers have enough bits to hold small integers. */ wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0); wv->enabled = !NILP (enable); prev_wv = wv; i += MENU_ITEMS_ITEM_LENGTH; } } /* If we have just one "menu item" that was originally a button, return it by itself. */ if (top_level_items && first_wv->contents && first_wv->contents->next == 0) { wv = first_wv->contents; free_widget_value (first_wv); return wv; } return first_wv; } extern void EmacsFrameSetCharSize (); /* Recompute all the widgets of frame F, when the menu bar has been changed. */ static void update_frame_menubar (f) FRAME_PTR f; { struct x_output *x = f->output_data.x; int columns, rows; int menubar_changed; Dimension shell_height; /* We assume the menubar contents has changed if the global flag is set, or if the current buffer has changed, or if the menubar has never been updated before. */ menubar_changed = (x->menubar_widget && !XtIsManaged (x->menubar_widget)); if (! (menubar_changed)) return; BLOCK_INPUT; /* Save the size of the frame because the pane widget doesn't accept to resize itself. So force it. */ columns = f->width; rows = f->height; /* Do the voodoo which means "I'm changing lots of things, don't try to refigure sizes until I'm done." */ lw_refigure_widget (x->column_widget, False); /* the order in which children are managed is the top to bottom order in which they are displayed in the paned window. First, remove the text-area widget. */ XtUnmanageChild (x->edit_widget); /* remove the menubar that is there now, and put up the menubar that should be there. */ if (menubar_changed) { XtManageChild (x->menubar_widget); XtMapWidget (x->menubar_widget); XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, 0); } /* Re-manage the text-area widget, and then thrash the sizes. */ XtManageChild (x->edit_widget); lw_refigure_widget (x->column_widget, True); /* Force the pane widget to resize itself with the right values. */ EmacsFrameSetCharSize (x->edit_widget, columns, rows); UNBLOCK_INPUT; } /* Set the contents of the menubar widgets of frame F. The argument FIRST_TIME is currently ignored; it is set the first time this is called, from initialize_frame_menubar. */ void set_frame_menubar (f, first_time, deep_p) FRAME_PTR f; int first_time; int deep_p; { Widget menubar_widget = f->output_data.x->menubar_widget; Lisp_Object tail, items, frame; widget_value *wv, *first_wv, *prev_wv = 0; int i; LWLIB_ID id; if (f->output_data.x->id == 0) f->output_data.x->id = next_menubar_widget_id++; id = f->output_data.x->id; if (! menubar_widget) deep_p = 1; wv = malloc_widget_value (); wv->name = "menubar"; wv->value = 0; wv->enabled = 1; first_wv = wv; if (deep_p) { /* Make a widget-value tree representing the entire menu trees. */ struct buffer *prev = current_buffer; Lisp_Object buffer; int specpdl_count = specpdl_ptr - specpdl; int previous_menu_items_used = f->menu_bar_items_used; Lisp_Object *previous_items = (Lisp_Object *) alloca (previous_menu_items_used * sizeof (Lisp_Object)); buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer; specbind (Qinhibit_quit, Qt); /* Don't let the debugger step into this code because it is not reentrant. */ specbind (Qdebug_on_next_call, Qnil); record_unwind_protect (Fstore_match_data, Fmatch_data ()); if (NILP (Voverriding_local_map_menu_flag)) { specbind (Qoverriding_terminal_local_map, Qnil); specbind (Qoverriding_local_map, Qnil); } set_buffer_internal_1 (XBUFFER (buffer)); /* Run the Lucid hook. */ call1 (Vrun_hooks, Qactivate_menubar_hook); /* If it has changed current-menubar from previous value, really recompute the menubar from the value. */ if (! NILP (Vlucid_menu_bar_dirty_flag)) call0 (Qrecompute_lucid_menubar); call1 (Vrun_hooks, Qmenu_bar_update_hook); FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); items = FRAME_MENU_BAR_ITEMS (f); inhibit_garbage_collection (); /* Save the frame's previous menu bar contents data. */ bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items, previous_menu_items_used * sizeof (Lisp_Object)); /* Fill in the current menu bar contents. */ menu_items = f->menu_bar_vector; menu_items_allocated = XVECTOR (menu_items)->size; init_menu_items (); for (i = 0; i < XVECTOR (items)->size; i += 3) { Lisp_Object key, string, maps; key = XVECTOR (items)->contents[i]; string = XVECTOR (items)->contents[i + 1]; maps = XVECTOR (items)->contents[i + 2]; if (NILP (string)) break; wv = single_submenu (key, string, maps); if (prev_wv) prev_wv->next = wv; else first_wv->contents = wv; /* Don't set wv->name here; GC during the loop might relocate it. */ wv->enabled = 1; prev_wv = wv; } finish_menu_items (); set_buffer_internal_1 (prev); unbind_to (specpdl_count, Qnil); /* If there has been no change in the Lisp-level contents of the menu bar, skip redisplaying it. Just exit. */ for (i = 0; i < previous_menu_items_used; i++) if (menu_items_used == i || (previous_items[i] != XVECTOR (menu_items)->contents[i])) break; if (i == menu_items_used && i == previous_menu_items_used) { free_menubar_widget_value_tree (first_wv); menu_items = Qnil; return; } /* Now GC cannot happen during the lifetime of the widget_value, so it's safe to store data from a Lisp_String. */ wv = first_wv->contents; for (i = 0; i < XVECTOR (items)->size; i += 3) { Lisp_Object string; string = XVECTOR (items)->contents[i + 1]; if (NILP (string)) break; wv->name = (char *) XSTRING (string)->data; wv = wv->next; } f->menu_bar_vector = menu_items; f->menu_bar_items_used = menu_items_used; menu_items = Qnil; } else { /* Make a widget-value tree containing just the top level menu bar strings. */ items = FRAME_MENU_BAR_ITEMS (f); for (i = 0; i < XVECTOR (items)->size; i += 3) { Lisp_Object string; string = XVECTOR (items)->contents[i + 1]; if (NILP (string)) break; wv = malloc_widget_value (); wv->name = (char *) XSTRING (string)->data; wv->value = 0; wv->enabled = 1; if (prev_wv) prev_wv->next = wv; else first_wv->contents = wv; prev_wv = wv; } } /* Create or update the menu bar widget. */ BLOCK_INPUT; if (menubar_widget) { /* Disable resizing (done for Motif!) */ lw_allow_resizing (f->output_data.x->widget, False); /* The third arg is DEEP_P, which says to consider the entire menu trees we supply, rather than just the menu bar item names. */ lw_modify_all_widgets (id, first_wv, deep_p); /* Re-enable the edit widget to resize. */ lw_allow_resizing (f->output_data.x->widget, True); } else { menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv, f->output_data.x->column_widget, 0, popup_activate_callback, menubar_selection_callback, popup_deactivate_callback); f->output_data.x->menubar_widget = menubar_widget; } { int menubar_size = (f->output_data.x->menubar_widget ? (f->output_data.x->menubar_widget->core.height + f->output_data.x->menubar_widget->core.border_width) : 0); #ifdef USE_LUCID if (FRAME_EXTERNAL_MENU_BAR (f)) { Dimension ibw = 0; XtVaGetValues (f->output_data.x->column_widget, XtNinternalBorderWidth, &ibw, NULL); menubar_size += ibw; } #endif /* USE_LUCID */ f->output_data.x->menubar_height = menubar_size; } free_menubar_widget_value_tree (first_wv); update_frame_menubar (f); UNBLOCK_INPUT; } /* Called from Fx_create_frame to create the inital menubar of a frame before it is mapped, so that the window is mapped with the menubar already there instead of us tacking it on later and thrashing the window after it is visible. */ void initialize_frame_menubar (f) FRAME_PTR f; { /* This function is called before the first chance to redisplay the frame. It has to be, so the frame will have the right size. */ FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); set_frame_menubar (f, 1, 1); } /* Get rid of the menu bar of frame F, and free its storage. This is used when deleting a frame, and when turning off the menu bar. */ void free_frame_menubar (f) FRAME_PTR f; { Widget menubar_widget; int id; menubar_widget = f->output_data.x->menubar_widget; if (menubar_widget) { BLOCK_INPUT; lw_destroy_all_widgets ((LWLIB_ID) f->output_data.x->id); UNBLOCK_INPUT; } } #endif /* USE_X_TOOLKIT */ /* xmenu_show actually displays a menu using the panes and items in menu_items and returns the value selected from it. There are two versions of xmenu_show, one for Xt and one for Xlib. Both assume input is blocked by the caller. */ /* F is the frame the menu is for. X and Y are the frame-relative specified position, relative to the inside upper left corner of the frame F. FOR_CLICK if this menu was invoked for a mouse click. KEYMAPS is 1 if this menu was specified with keymaps; in that case, we return a list containing the chosen item's value and perhaps also the pane's prefix. TITLE is the specified menu title. ERROR is a place to store an error message string in case of failure. (We return nil on failure, but the value doesn't actually matter.) */ #ifdef USE_X_TOOLKIT /* We need a unique id for each widget handled by the Lucid Widget library. For the main windows, and popup menus, we use this counter, which we increment each time after use. This starts from 1<<16. For menu bars, we use numbers starting at 0, counted in next_menubar_widget_id. */ LWLIB_ID widget_id_tick; #ifdef __STDC__ static Lisp_Object *volatile menu_item_selection; #else static Lisp_Object *menu_item_selection; #endif static void popup_selection_callback (widget, id, client_data) Widget widget; LWLIB_ID id; XtPointer client_data; { menu_item_selection = (Lisp_Object *) client_data; } static Lisp_Object xmenu_show (f, x, y, for_click, keymaps, title, error) FRAME_PTR f; int x; int y; int for_click; int keymaps; Lisp_Object title; char **error; { int i; LWLIB_ID menu_id; Widget menu; Arg av[2]; int ac = 0; widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; widget_value **submenu_stack = (widget_value **) alloca (menu_items_used * sizeof (widget_value *)); Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object)); int submenu_depth = 0; XButtonPressedEvent dummy; int first_pane; int next_release_must_exit = 0; *error = NULL; if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) { *error = "Empty menu"; return Qnil; } /* Create a tree of widget_value objects representing the panes and their items. */ wv = malloc_widget_value (); wv->name = "menu"; wv->value = 0; wv->enabled = 1; first_wv = wv; first_pane = 1; /* Loop over all panes and items, filling in the tree. */ i = 0; while (i < menu_items_used) { if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) { submenu_stack[submenu_depth++] = save_wv; save_wv = prev_wv; prev_wv = 0; first_pane = 1; i++; } else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) { prev_wv = save_wv; save_wv = submenu_stack[--submenu_depth]; first_pane = 0; i++; } else if (EQ (XVECTOR (menu_items)->contents[i], Qt) && submenu_depth != 0) i += MENU_ITEMS_PANE_LENGTH; /* Ignore a nil in the item list. It's meaningful only for dialog boxes. */ else if (EQ (XVECTOR (menu_items)->contents[i], Qquote)) i += 1; else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) { /* Create a new pane. */ Lisp_Object pane_name, prefix; char *pane_string; pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME]; prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data); /* If there is just one top-level pane, put all its items directly under the top-level menu. */ if (menu_items_n_panes == 1) pane_string = ""; /* If the pane has a meaningful name, make the pane a top-level menu item with its items as a submenu beneath it. */ if (!keymaps && strcmp (pane_string, "")) { wv = malloc_widget_value (); if (save_wv) save_wv->next = wv; else first_wv->contents = wv; wv->name = pane_string; if (keymaps && !NILP (prefix)) wv->name++; wv->value = 0; wv->enabled = 1; save_wv = wv; prev_wv = 0; } else if (first_pane) { save_wv = wv; prev_wv = 0; } first_pane = 0; i += MENU_ITEMS_PANE_LENGTH; } else { /* Create a new item within current pane. */ Lisp_Object item_name, enable, descrip, def; item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION]; wv = malloc_widget_value (); if (prev_wv) prev_wv->next = wv; else save_wv->contents = wv; wv->name = (char *) XSTRING (item_name)->data; if (!NILP (descrip)) wv->key = (char *) XSTRING (descrip)->data; wv->value = 0; /* If this item has a null value, make the call_data null so that it won't display a box when the mouse is on it. */ wv->call_data = (!NILP (def) ? (void *) &XVECTOR (menu_items)->contents[i] : 0); wv->enabled = !NILP (enable); prev_wv = wv; i += MENU_ITEMS_ITEM_LENGTH; } } /* Deal with the title, if it is non-nil. */ if (!NILP (title)) { widget_value *wv_title = malloc_widget_value (); widget_value *wv_sep1 = malloc_widget_value (); widget_value *wv_sep2 = malloc_widget_value (); wv_sep2->name = "--"; wv_sep2->next = first_wv->contents; wv_sep1->name = "--"; wv_sep1->next = wv_sep2; wv_title->name = (char *) XSTRING (title)->data; wv_title->enabled = True; wv_title->next = wv_sep1; first_wv->contents = wv_title; } /* Actually create the menu. */ menu_id = widget_id_tick++; menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv, f->output_data.x->widget, 1, 0, popup_selection_callback, popup_deactivate_callback); /* Adjust coordinates to relative to the outer (window manager) window. */ { Window child; int win_x = 0, win_y = 0; /* Find the position of the outside upper-left corner of the inner window, with respect to the outer window. */ if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window) { BLOCK_INPUT; XTranslateCoordinates (FRAME_X_DISPLAY (f), /* From-window, to-window. */ f->output_data.x->window_desc, f->output_data.x->parent_desc, /* From-position, to-position. */ 0, 0, &win_x, &win_y, /* Child of window. */ &child); UNBLOCK_INPUT; x += win_x; y += win_y; } } /* Adjust coordinates to be root-window-relative. */ x += f->output_data.x->left_pos; y += f->output_data.x->top_pos; dummy.type = ButtonPress; dummy.serial = 0; dummy.send_event = 0; dummy.display = FRAME_X_DISPLAY (f); dummy.time = CurrentTime; dummy.button = 0; dummy.root = FRAME_X_DISPLAY_INFO (f)->root_window; dummy.window = dummy.root; dummy.subwindow = dummy.root; dummy.x_root = x; dummy.y_root = y; dummy.x = x; dummy.y = y; /* Don't allow any geometry request from the user. */ XtSetArg (av[ac], XtNgeometry, 0); ac++; XtSetValues (menu, av, ac); /* Free the widget_value objects we used to specify the contents. */ free_menubar_widget_value_tree (first_wv); /* No selection has been chosen yet. */ menu_item_selection = 0; /* Display the menu. */ lw_popup_menu (menu, &dummy); popup_activated_flag = 1; /* Process events that apply to the menu. */ popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id); /* fp turned off the following statement and wrote a comment that it is unnecessary--that the menu has already disappeared. Nowadays the menu disappears ok, all right, but we need to delete the widgets or multiple ones will pile up. */ lw_destroy_all_widgets (menu_id); /* Find the selected item, and its pane, to return the proper value. */ if (menu_item_selection != 0) { Lisp_Object prefix, entry; prefix = Qnil; i = 0; while (i < menu_items_used) { if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) { subprefix_stack[submenu_depth++] = prefix; prefix = entry; i++; } else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) { prefix = subprefix_stack[--submenu_depth]; i++; } else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) { prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; i += MENU_ITEMS_PANE_LENGTH; } /* Ignore a nil in the item list. It's meaningful only for dialog boxes. */ else if (EQ (XVECTOR (menu_items)->contents[i], Qquote)) i += 1; else { entry = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; if (menu_item_selection == &XVECTOR (menu_items)->contents[i]) { if (keymaps != 0) { int j; entry = Fcons (entry, Qnil); if (!NILP (prefix)) entry = Fcons (prefix, entry); for (j = submenu_depth - 1; j >= 0; j--) if (!NILP (subprefix_stack[j])) entry = Fcons (subprefix_stack[j], entry); } return entry; } i += MENU_ITEMS_ITEM_LENGTH; } } } return Qnil; } static void dialog_selection_callback (widget, id, client_data) Widget widget; LWLIB_ID id; XtPointer client_data; { /* The EMACS_INT cast avoids a warning. There's no problem as long as pointers have enough bits to hold small integers. */ if ((int) (EMACS_INT) client_data != -1) menu_item_selection = (Lisp_Object *) client_data; BLOCK_INPUT; lw_destroy_all_widgets (id); UNBLOCK_INPUT; popup_activated_flag = 0; } static char * button_names [] = { "button1", "button2", "button3", "button4", "button5", "button6", "button7", "button8", "button9", "button10" }; static Lisp_Object xdialog_show (f, keymaps, title, error) FRAME_PTR f; int keymaps; Lisp_Object title; char **error; { int i, nb_buttons=0; LWLIB_ID dialog_id; Widget menu; char dialog_name[6]; widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; /* Number of elements seen so far, before boundary. */ int left_count = 0; /* 1 means we've seen the boundary between left-hand elts and right-hand. */ int boundary_seen = 0; *error = NULL; if (menu_items_n_panes > 1) { *error = "Multiple panes in dialog box"; return Qnil; } /* Create a tree of widget_value objects representing the text label and buttons. */ { Lisp_Object pane_name, prefix; char *pane_string; pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME]; prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX]; pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data); prev_wv = malloc_widget_value (); prev_wv->value = pane_string; if (keymaps && !NILP (prefix)) prev_wv->name++; prev_wv->enabled = 1; prev_wv->name = "message"; first_wv = prev_wv; /* Loop over all panes and items, filling in the tree. */ i = MENU_ITEMS_PANE_LENGTH; while (i < menu_items_used) { /* Create a new item within current pane. */ Lisp_Object item_name, enable, descrip; item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; if (NILP (item_name)) { free_menubar_widget_value_tree (first_wv); *error = "Submenu in dialog items"; return Qnil; } if (EQ (item_name, Qquote)) { /* This is the boundary between left-side elts and right-side elts. Stop incrementing right_count. */ boundary_seen = 1; i++; continue; } if (nb_buttons >= 10) { free_menubar_widget_value_tree (first_wv); *error = "Too many dialog items"; return Qnil; } wv = malloc_widget_value (); prev_wv->next = wv; wv->name = (char *) button_names[nb_buttons]; if (!NILP (descrip)) wv->key = (char *) XSTRING (descrip)->data; wv->value = (char *) XSTRING (item_name)->data; wv->call_data = (void *) &XVECTOR (menu_items)->contents[i]; wv->enabled = !NILP (enable); prev_wv = wv; if (! boundary_seen) left_count++; nb_buttons++; i += MENU_ITEMS_ITEM_LENGTH; } /* If the boundary was not specified, by default put half on the left and half on the right. */ if (! boundary_seen) left_count = nb_buttons - nb_buttons / 2; wv = malloc_widget_value (); wv->name = dialog_name; /* Dialog boxes use a really stupid name encoding which specifies how many buttons to use and how many buttons are on the right. The Q means something also. */ dialog_name[0] = 'Q'; dialog_name[1] = '0' + nb_buttons; dialog_name[2] = 'B'; dialog_name[3] = 'R'; /* Number of buttons to put on the right. */ dialog_name[4] = '0' + nb_buttons - left_count; dialog_name[5] = 0; wv->contents = first_wv; first_wv = wv; } /* Actually create the dialog. */ dialog_id = widget_id_tick++; menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv, f->output_data.x->widget, 1, 0, dialog_selection_callback, 0); lw_modify_all_widgets (dialog_id, first_wv->contents, True); /* Free the widget_value objects we used to specify the contents. */ free_menubar_widget_value_tree (first_wv); /* No selection has been chosen yet. */ menu_item_selection = 0; /* Display the menu. */ lw_pop_up_all_widgets (dialog_id); popup_activated_flag = 1; /* Process events that apply to the menu. */ popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id); lw_destroy_all_widgets (dialog_id); /* Find the selected item, and its pane, to return the proper value. */ if (menu_item_selection != 0) { Lisp_Object prefix; prefix = Qnil; i = 0; while (i < menu_items_used) { Lisp_Object entry; if (EQ (XVECTOR (menu_items)->contents[i], Qt)) { prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; i += MENU_ITEMS_PANE_LENGTH; } else { entry = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; if (menu_item_selection == &XVECTOR (menu_items)->contents[i]) { if (keymaps != 0) { entry = Fcons (entry, Qnil); if (!NILP (prefix)) entry = Fcons (prefix, entry); } return entry; } i += MENU_ITEMS_ITEM_LENGTH; } } } return Qnil; } #else /* not USE_X_TOOLKIT */ static Lisp_Object xmenu_show (f, x, y, for_click, keymaps, title, error) FRAME_PTR f; int x, y; int for_click; int keymaps; Lisp_Object title; char **error; { Window root; XMenu *menu; int pane, selidx, lpane, status; Lisp_Object entry, pane_prefix; char *datap; int ulx, uly, width, height; int dispwidth, dispheight; int i, j; int maxwidth; int dummy_int; unsigned int dummy_uint; *error = 0; if (menu_items_n_panes == 0) return Qnil; if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) { *error = "Empty menu"; return Qnil; } /* Figure out which root window F is on. */ XGetGeometry (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &root, &dummy_int, &dummy_int, &dummy_uint, &dummy_uint, &dummy_uint, &dummy_uint); /* Make the menu on that window. */ menu = XMenuCreate (FRAME_X_DISPLAY (f), root, "emacs"); if (menu == NULL) { *error = "Can't create menu"; return Qnil; } #ifdef HAVE_X_WINDOWS /* Adjust coordinates to relative to the outer (window manager) window. */ { Window child; int win_x = 0, win_y = 0; /* Find the position of the outside upper-left corner of the inner window, with respect to the outer window. */ if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window) { BLOCK_INPUT; XTranslateCoordinates (FRAME_X_DISPLAY (f), /* From-window, to-window. */ f->output_data.x->window_desc, f->output_data.x->parent_desc, /* From-position, to-position. */ 0, 0, &win_x, &win_y, /* Child of window. */ &child); UNBLOCK_INPUT; x += win_x; y += win_y; } } #endif /* HAVE_X_WINDOWS */ /* Adjust coordinates to be root-window-relative. */ x += f->output_data.x->left_pos; y += f->output_data.x->top_pos; /* Create all the necessary panes and their items. */ i = 0; while (i < menu_items_used) { if (EQ (XVECTOR (menu_items)->contents[i], Qt)) { /* Create a new pane. */ Lisp_Object pane_name, prefix; char *pane_string; pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME]; prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data); if (keymaps && !NILP (prefix)) pane_string++; lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, TRUE); if (lpane == XM_FAILURE) { XMenuDestroy (FRAME_X_DISPLAY (f), menu); *error = "Can't create pane"; return Qnil; } i += MENU_ITEMS_PANE_LENGTH; /* Find the width of the widest item in this pane. */ maxwidth = 0; j = i; while (j < menu_items_used) { Lisp_Object item; item = XVECTOR (menu_items)->contents[j]; if (EQ (item, Qt)) break; if (NILP (item)) { j++; continue; } width = XSTRING (item)->size; if (width > maxwidth) maxwidth = width; j += MENU_ITEMS_ITEM_LENGTH; } } /* Ignore a nil in the item list. It's meaningful only for dialog boxes. */ else if (EQ (XVECTOR (menu_items)->contents[i], Qquote)) i += 1; else { /* Create a new item within current pane. */ Lisp_Object item_name, enable, descrip; unsigned char *item_data; item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; if (!NILP (descrip)) { int gap = maxwidth - XSTRING (item_name)->size; #ifdef C_ALLOCA Lisp_Object spacer; spacer = Fmake_string (make_number (gap), make_number (' ')); item_name = concat2 (item_name, spacer); item_name = concat2 (item_name, descrip); item_data = XSTRING (item_name)->data; #else /* if alloca is fast, use that to make the space, to reduce gc needs. */ item_data = (unsigned char *) alloca (maxwidth + XSTRING (descrip)->size + 1); bcopy (XSTRING (item_name)->data, item_data, XSTRING (item_name)->size); for (j = XSTRING (item_name)->size; j < maxwidth; j++) item_data[j] = ' '; bcopy (XSTRING (descrip)->data, item_data + j, XSTRING (descrip)->size); item_data[j + XSTRING (descrip)->size] = 0; #endif } else item_data = XSTRING (item_name)->data; if (XMenuAddSelection (FRAME_X_DISPLAY (f), menu, lpane, 0, item_data, !NILP (enable)) == XM_FAILURE) { XMenuDestroy (FRAME_X_DISPLAY (f), menu); *error = "Can't add selection to menu"; return Qnil; } i += MENU_ITEMS_ITEM_LENGTH; } } /* All set and ready to fly. */ XMenuRecompute (FRAME_X_DISPLAY (f), menu); dispwidth = DisplayWidth (FRAME_X_DISPLAY (f), XScreenNumberOfScreen (FRAME_X_SCREEN (f))); dispheight = DisplayHeight (FRAME_X_DISPLAY (f), XScreenNumberOfScreen (FRAME_X_SCREEN (f))); x = min (x, dispwidth); y = min (y, dispheight); x = max (x, 1); y = max (y, 1); XMenuLocate (FRAME_X_DISPLAY (f), menu, 0, 0, x, y, &ulx, &uly, &width, &height); if (ulx+width > dispwidth) { x -= (ulx + width) - dispwidth; ulx = dispwidth - width; } if (uly+height > dispheight) { y -= (uly + height) - dispheight; uly = dispheight - height; } if (ulx < 0) x -= ulx; if (uly < 0) y -= uly; XMenuSetAEQ (menu, TRUE); XMenuSetFreeze (menu, TRUE); pane = selidx = 0; status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx, x, y, ButtonReleaseMask, &datap); #ifdef HAVE_X_WINDOWS /* Assume the mouse has moved out of the X window. If it has actually moved in, we will get an EnterNotify. */ x_mouse_leave (FRAME_X_DISPLAY_INFO (f)); #endif switch (status) { case XM_SUCCESS: #ifdef XDEBUG fprintf (stderr, "pane= %d line = %d\n", panes, selidx); #endif /* Find the item number SELIDX in pane number PANE. */ i = 0; while (i < menu_items_used) { if (EQ (XVECTOR (menu_items)->contents[i], Qt)) { if (pane == 0) pane_prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; pane--; i += MENU_ITEMS_PANE_LENGTH; } else { if (pane == -1) { if (selidx == 0) { entry = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; if (keymaps != 0) { entry = Fcons (entry, Qnil); if (!NILP (pane_prefix)) entry = Fcons (pane_prefix, entry); } break; } selidx--; } i += MENU_ITEMS_ITEM_LENGTH; } } break; case XM_FAILURE: *error = "Can't activate menu"; case XM_IA_SELECT: case XM_NO_SELECT: entry = Qnil; break; } XMenuDestroy (FRAME_X_DISPLAY (f), menu); #ifdef HAVE_X_WINDOWS /* State that no mouse buttons are now held. (The oldXMenu code doesn't track this info for us.) That is not necessarily true, but the fiction leads to reasonable results, and it is a pain to ask which are actually held now. */ FRAME_X_DISPLAY_INFO (f)->grabbed = 0; #endif return entry; } #endif /* not USE_X_TOOLKIT */ syms_of_xmenu () { staticpro (&menu_items); menu_items = Qnil; Qdebug_on_next_call = intern ("debug-on-next-call"); staticpro (&Qdebug_on_next_call); #ifdef USE_X_TOOLKIT widget_id_tick = (1<<16); next_menubar_widget_id = 1; #endif defsubr (&Sx_popup_menu); defsubr (&Sx_popup_dialog); } emacs-19.30/src/xrdb.c100444 12120 1 40033 5741664160 13023 0ustar rmsdaemon/* Deal with the X Resource Manager. Copyright (C) 1990, 1993, 1994 Free Software Foundation. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* Written by jla, 4/90 */ #ifdef emacs #include #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 */ #ifdef USG5 #ifndef SYSV #define SYSV #endif #include #endif /* USG5 */ #endif /* 1 */ #include #include #if 0 #include #endif #include #include #include #ifdef VMS #include "vms-pwd.h" #else #include #endif #include #if !defined(S_ISDIR) && defined(S_IFDIR) #define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR) #endif extern char *getenv (); /* This does cause trouble on AIX. I'm going to take the comment at face value. */ #if 0 extern short getuid (); /* If this causes portability problems, I think we should just delete it; it'll default to `int' anyway. */ #endif #ifdef DECLARE_GETPWUID_WITH_UID_T extern struct passwd *getpwuid (uid_t); extern struct passwd *getpwnam (const char *); #else extern struct passwd *getpwuid (); extern struct passwd *getpwnam (); #endif extern char *get_system_name (); /* 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) { char *copy = (char *) malloc (strlen (result) + 1); strcpy (copy, result); return copy; } 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 () { struct passwd *pw; char *ptr; char *copy; if ((ptr = getenv ("HOME")) == NULL) { if ((ptr = getenv ("LOGNAME")) != NULL || (ptr = getenv ("USER")) != NULL) pw = getpwnam (ptr); else pw = getpwuid (getuid ()); 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) char *path; { struct stat status; return (access (path, 4) == 0 /* exists and is readable */ && stat (path, &status) == 0 /* get the status */ && (S_ISDIR (status.st_mode)) == 0); /* not a directory */ } /* 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 > s) { char *path = magic_file_p (s, p - s, class, escaped_suffix, suffix); if (path) return path; } else if (*p == ':') { char *path; s = "%N%S"; path = magic_file_p (s, strlen (s), class, escaped_suffix, suffix); if (path) return path; } if (*p == ':') p++; } return 0; } /* 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) Display *display; { XrmDatabase db; return NULL; } 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) Display *display; { XrmDatabase db; char *xdefs; #ifdef PBaseSize /* Cheap way to test for X11R4 or later. */ xdefs = XResourceManagerString (display); #else xdefs = display->xdefaults; #endif if (xdefs != NULL) db = XrmGetStringDatabase (xdefs); 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); } #ifdef HAVE_XSCREENRESOURCESTRING /* Get the screen-specific resources too. */ xdefs = XScreenResourceString (DefaultScreenOfDisplay (display)); if (xdefs != NULL) { XrmMergeDatabases (XrmGetStringDatabase (xdefs), &db); XFree (xdefs); } #endif return db; } static XrmDatabase get_environ_db () { XrmDatabase db; char *p; char *path = 0, *home = 0, *host; if ((p = getenv ("XENVIRONMENT")) == NULL) { home = gethomedir (); host = get_system_name (); 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); return db; } /* External interface. */ /* Types of values that we can find in a database */ #define XrmStringType "String" /* String representation */ XrmRepresentation x_rm_string; /* Quark representation */ /* Load X resources based on the display and a possible -xrm option. */ 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; x_rm_string = XrmStringToQuark (XrmStringType); #ifndef USE_X_TOOLKIT /* pmr@osf.org says this shouldn't be done if USE_X_TOOLKIT. I suspect it's because the toolkit version does this elsewhere. */ XrmInitialize (); #endif 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); if (db != NULL) XrmMergeDatabases (db, &rdb); /* Get Fallback resources */ db = get_fallback (display); if (db != NULL) XrmMergeDatabases (db, &rdb); /* Get application user defaults */ db = get_user_app (myclass); if (db != NULL) XrmMergeDatabases (db, &rdb); /* get User defaults */ if (user_database != NULL) XrmMergeDatabases (user_database, &rdb); /* Get Environment defaults. */ db = get_environ_db (); if (db != NULL) XrmMergeDatabases (db, &rdb); /* Last, merge in any specification from the command line. */ if (xrm_string != NULL) { db = XrmGetStringDatabase (xrm_string); if (db != NULL) XrmMergeDatabases (db, &rdb); } return rdb; } /* 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. */ int x_get_resource (rdb, name, class, expected_type, ret_value) XrmDatabase rdb; char *name, *class; XrmRepresentation expected_type; XrmValue *ret_value; { XrmValue value; XrmName namelist[100]; XrmClass classlist[100]; XrmRepresentation type; XrmStringToNameList(name, namelist); XrmStringToClassList(class, classlist); if (XrmQGetResource (rdb, namelist, classlist, &type, &value) == True && (type == expected_type)) { if (type == x_rm_string) ret_value->addr = (char *) value.addr; else bcopy (value.addr, ret_value->addr, ret_value->size); return value.size; } return 0; } /* Retrieve the string resource specified by NAME with CLASS from database RDB. */ char * x_get_string_resource (rdb, name, class) XrmDatabase rdb; char *name, *class; { XrmValue value; if (x_get_resource (rdb, name, class, x_rm_string, &value)) return (char *) value.addr; return (char *) 0; } /* 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) char *msg, *prog; int x1, x2, x3, x4, x5; { extern int errno; if (errno) perror (prog); (void) fprintf (stderr, msg, prog, x1, x2, x3, x4, x5); exit (1); } main (argc, argv) int argc; char **argv; { Display *display; char *displayname, *resource_string, *class, *name; XrmDatabase xdb; List arg_list, lp; arg_list = arg_listify (argc, argv); lp = member ("-d", arg_list); if (!NIL (lp)) displayname = car (cdr (lp)); else displayname = "localhost:0.0"; lp = member ("-xrm", arg_list); if (! NIL (lp)) resource_string = car (cdr (lp)); else resource_string = (char *) 0; lp = member ("-c", arg_list); if (! NIL (lp)) class = car (cdr (lp)); else 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"); } else break; } printf ("\tExit.\n\n"); XCloseDisplay (display); } #endif /* TESTRM */ emacs-19.30/src/xselect.c100444 12120 1 203112 6052431152 13537 0ustar rmsdaemon/* X Selection processing for Emacs. Copyright (C) 1993, 1994, 1995 Free Software Foundation. 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. */ /* Rewritten by jwz */ #include #include "lisp.h" #include "xterm.h" /* for all of the X includes */ #include "dispextern.h" /* frame.h seems to want this */ #include "frame.h" /* Need this to get the X window of selected_frame */ #include "blockinput.h" #define xfree free #define CUT_BUFFER_SUPPORT Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP, QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL, QATOM_PAIR; #ifdef CUT_BUFFER_SUPPORT Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3, QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7; #endif static Lisp_Object Vx_lost_selection_hooks; static Lisp_Object Vx_sent_selection_hooks; /* If this is a smaller number than the max-request-size of the display, emacs will use INCR selection transfer when the selection is larger than this. The max-request-size is usually around 64k, so if you want emacs to use incremental selection transfers when the selection is smaller than that, set this. I added this mostly for debugging the incremental transfer stuff, but it might improve server performance. */ #define MAX_SELECTION_QUANTUM 0xFFFFFF #ifdef HAVE_X11R4 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100) #else #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100) #endif /* The timestamp of the last input event Emacs received from the X server. */ unsigned long last_event_timestamp; /* This is an association list whose elements are of the form ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME) SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom. SELECTION-VALUE is the value that emacs owns for that selection. It may be any kind of Lisp object. SELECTION-TIMESTAMP is the time at which emacs began owning this selection, as a cons of two 16-bit numbers (making a 32 bit time.) FRAME is the frame for which we made the selection. If there is an entry in this alist, then it can be assumed that Emacs owns that selection. The only (eq) parts of this list that are visible from Lisp are the selection-values. */ static Lisp_Object Vselection_alist; /* This is an alist whose CARs are selection-types (whose names are the same as the names of X Atoms) and whose CDRs are the names of Lisp functions to call to convert the given Emacs selection value to a string representing the given selection type. This is for Lisp-level extension of the emacs selection handling. */ static Lisp_Object Vselection_converter_alist; /* If the selection owner takes too long to reply to a selection request, we give up on it. This is in milliseconds (0 = no timeout.) */ static int x_selection_timeout; /* Utility functions */ static void lisp_data_to_selection_data (); static Lisp_Object selection_data_to_lisp_data (); static Lisp_Object x_get_window_property_as_lisp_data (); /* This converts a Lisp symbol to a server Atom, avoiding a server roundtrip whenever possible. */ static Atom symbol_to_x_atom (dpyinfo, display, sym) struct x_display_info *dpyinfo; Display *display; Lisp_Object sym; { Atom val; if (NILP (sym)) return 0; if (EQ (sym, QPRIMARY)) return XA_PRIMARY; if (EQ (sym, QSECONDARY)) return XA_SECONDARY; if (EQ (sym, QSTRING)) return XA_STRING; if (EQ (sym, QINTEGER)) return XA_INTEGER; if (EQ (sym, QATOM)) return XA_ATOM; if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD; if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP; if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT; if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE; if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE; if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR; if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP; if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS; if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL; #ifdef CUT_BUFFER_SUPPORT if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0; if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1; if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2; if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3; if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4; if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5; if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6; if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7; #endif if (!SYMBOLP (sym)) abort (); #if 0 fprintf (stderr, " XInternAtom %s\n", (char *) XSYMBOL (sym)->name->data); #endif BLOCK_INPUT; val = XInternAtom (display, (char *) XSYMBOL (sym)->name->data, False); UNBLOCK_INPUT; return val; } /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips and calls to intern whenever possible. */ static Lisp_Object x_atom_to_symbol (dpyinfo, display, atom) struct x_display_info *dpyinfo; Display *display; Atom atom; { char *str; Lisp_Object val; if (! atom) return Qnil; switch (atom) { case XA_PRIMARY: return QPRIMARY; case XA_SECONDARY: return QSECONDARY; case XA_STRING: return QSTRING; case XA_INTEGER: return QINTEGER; case XA_ATOM: return QATOM; #ifdef CUT_BUFFER_SUPPORT case XA_CUT_BUFFER0: return QCUT_BUFFER0; case XA_CUT_BUFFER1: return QCUT_BUFFER1; case XA_CUT_BUFFER2: return QCUT_BUFFER2; case XA_CUT_BUFFER3: return QCUT_BUFFER3; case XA_CUT_BUFFER4: return QCUT_BUFFER4; case XA_CUT_BUFFER5: return QCUT_BUFFER5; case XA_CUT_BUFFER6: return QCUT_BUFFER6; case XA_CUT_BUFFER7: return QCUT_BUFFER7; #endif } if (atom == dpyinfo->Xatom_CLIPBOARD) return QCLIPBOARD; if (atom == dpyinfo->Xatom_TIMESTAMP) return QTIMESTAMP; if (atom == dpyinfo->Xatom_TEXT) return QTEXT; if (atom == dpyinfo->Xatom_DELETE) return QDELETE; if (atom == dpyinfo->Xatom_MULTIPLE) return QMULTIPLE; if (atom == dpyinfo->Xatom_INCR) return QINCR; if (atom == dpyinfo->Xatom_EMACS_TMP) return QEMACS_TMP; if (atom == dpyinfo->Xatom_TARGETS) return QTARGETS; if (atom == dpyinfo->Xatom_NULL) return QNULL; BLOCK_INPUT; str = XGetAtomName (display, atom); UNBLOCK_INPUT; #if 0 fprintf (stderr, " XGetAtomName --> %s\n", str); #endif if (! str) return Qnil; val = intern (str); BLOCK_INPUT; XFree (str); UNBLOCK_INPUT; return val; } /* Do protocol to assert ourself as a selection owner. Update the Vselection_alist so that we can reply to later requests for our selection. */ static void x_own_selection (selection_name, selection_value) Lisp_Object selection_name, selection_value; { Window selecting_window = FRAME_X_WINDOW (selected_frame); Display *display = FRAME_X_DISPLAY (selected_frame); Time time = last_event_timestamp; Atom selection_atom; struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame); CHECK_SYMBOL (selection_name, 0); selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name); BLOCK_INPUT; x_catch_errors (display); XSetSelectionOwner (display, selection_atom, selecting_window, time); x_check_errors (display, "Can't set selection: %s"); x_uncatch_errors (display); UNBLOCK_INPUT; /* Now update the local cache */ { Lisp_Object selection_time; Lisp_Object selection_data; Lisp_Object prev_value; selection_time = long_to_cons ((unsigned long) time); selection_data = Fcons (selection_name, Fcons (selection_value, Fcons (selection_time, Fcons (Fselected_frame (), Qnil)))); prev_value = assq_no_quit (selection_name, Vselection_alist); Vselection_alist = Fcons (selection_data, Vselection_alist); /* If we already owned the selection, remove the old selection data. Perhaps we should destructively modify it instead. Don't use Fdelq as that may QUIT. */ if (!NILP (prev_value)) { Lisp_Object rest; /* we know it's not the CAR, so it's easy. */ for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) if (EQ (prev_value, Fcar (XCONS (rest)->cdr))) { XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr); break; } } } } /* Given a selection-name and desired type, look up our local copy of the selection value and convert it to the type. The value is nil or a string. This function is used both for remote requests and for local x-get-selection-internal. This calls random Lisp code, and may signal or gc. */ static Lisp_Object x_get_local_selection (selection_symbol, target_type) Lisp_Object selection_symbol, target_type; { Lisp_Object local_value; Lisp_Object handler_fn, value, type, check; int count; local_value = assq_no_quit (selection_symbol, Vselection_alist); if (NILP (local_value)) return Qnil; /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */ if (EQ (target_type, QTIMESTAMP)) { handler_fn = Qnil; value = XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car; } #if 0 else if (EQ (target_type, QDELETE)) { handler_fn = Qnil; Fx_disown_selection_internal (selection_symbol, XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car); value = QNULL; } #endif #if 0 /* #### MULTIPLE doesn't work yet */ else if (CONSP (target_type) && XCONS (target_type)->car == QMULTIPLE) { Lisp_Object pairs; int size; int i; pairs = XCONS (target_type)->cdr; size = XVECTOR (pairs)->size; /* If the target is MULTIPLE, then target_type looks like (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ]) We modify the second element of each pair in the vector and return it as [[SELECTION1 ] [SELECTION2 ] ... ] */ for (i = 0; i < size; i++) { Lisp_Object pair; pair = XVECTOR (pairs)->contents [i]; XVECTOR (pair)->contents [1] = x_get_local_selection (XVECTOR (pair)->contents [0], XVECTOR (pair)->contents [1]); } return pairs; } #endif else { /* Don't allow a quit within the converter. When the user types C-g, he would be surprised if by luck it came during a converter. */ count = specpdl_ptr - specpdl; specbind (Qinhibit_quit, Qt); CHECK_SYMBOL (target_type, 0); handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist)); if (!NILP (handler_fn)) value = call3 (handler_fn, selection_symbol, target_type, XCONS (XCONS (local_value)->cdr)->car); else value = Qnil; unbind_to (count, Qnil); } /* Make sure this value is of a type that we could transmit to another X client. */ check = value; if (CONSP (value) && SYMBOLP (XCONS (value)->car)) type = XCONS (value)->car, check = XCONS (value)->cdr; if (STRINGP (check) || VECTORP (check) || SYMBOLP (check) || INTEGERP (check) || NILP (value)) return value; /* Check for a value that cons_to_long could handle. */ else if (CONSP (check) && INTEGERP (XCONS (check)->car) && (INTEGERP (XCONS (check)->cdr) || (CONSP (XCONS (check)->cdr) && INTEGERP (XCONS (XCONS (check)->cdr)->car) && NILP (XCONS (XCONS (check)->cdr)->cdr)))) return value; else return Fsignal (Qerror, Fcons (build_string ("invalid data returned by selection-conversion function"), Fcons (handler_fn, Fcons (value, Qnil)))); } /* Subroutines of x_reply_selection_request. */ /* Send a SelectionNotify event to the requestor with property=None, meaning we were unable to do what they wanted. */ static void x_decline_selection_request (event) struct input_event *event; { XSelectionEvent reply; reply.type = SelectionNotify; reply.display = SELECTION_EVENT_DISPLAY (event); reply.requestor = SELECTION_EVENT_REQUESTOR (event); reply.selection = SELECTION_EVENT_SELECTION (event); reply.time = SELECTION_EVENT_TIME (event); reply.target = SELECTION_EVENT_TARGET (event); reply.property = None; BLOCK_INPUT; XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply); XFlush (reply.display); UNBLOCK_INPUT; } /* This is the selection request currently being processed. It is set to zero when the request is fully processed. */ static struct input_event *x_selection_current_request; /* Used as an unwind-protect clause so that, if a selection-converter signals an error, we tell the requestor that we were unable to do what they wanted before we throw to top-level or go into the debugger or whatever. */ static Lisp_Object x_selection_request_lisp_error (ignore) Lisp_Object ignore; { if (x_selection_current_request != 0) x_decline_selection_request (x_selection_current_request); return Qnil; } /* This stuff is so that INCR selections are reentrant (that is, so we can be servicing multiple INCR selection requests simultaneously.) I haven't actually tested that yet. */ /* Keep a list of the property changes that are awaited. */ struct prop_location { int identifier; Display *display; Window window; Atom property; int desired_state; int arrived; struct prop_location *next; }; static struct prop_location *expect_property_change (); static void wait_for_property_change (); static void unexpect_property_change (); static int waiting_for_other_props_on_window (); static int prop_location_identifier; static Lisp_Object property_change_reply; static struct prop_location *property_change_reply_object; static struct prop_location *property_change_wait_list; static Lisp_Object queue_selection_requests_unwind (frame) Lisp_Object frame; { FRAME_PTR f = XFRAME (frame); if (! NILP (frame)) x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f)); return Qnil; } /* Return some frame whose display info is DPYINFO. Return nil if there is none. */ static Lisp_Object some_frame_on_display (dpyinfo) struct x_display_info *dpyinfo; { Lisp_Object list, frame; FOR_EACH_FRAME (list, frame) { if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo) return frame; } return Qnil; } /* Send the reply to a selection request event EVENT. TYPE is the type of selection data requested. DATA and SIZE describe the data to send, already converted. FORMAT is the unit-size (in bits) of the data to be transmitted. */ static void x_reply_selection_request (event, format, data, size, type) struct input_event *event; int format, size; unsigned char *data; Atom type; { XSelectionEvent reply; Display *display = SELECTION_EVENT_DISPLAY (event); Window window = SELECTION_EVENT_REQUESTOR (event); int bytes_remaining; int format_bytes = format/8; int max_bytes = SELECTION_QUANTUM (display); struct x_display_info *dpyinfo = x_display_info_for_display (display); if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM; reply.type = SelectionNotify; reply.display = display; reply.requestor = window; reply.selection = SELECTION_EVENT_SELECTION (event); reply.time = SELECTION_EVENT_TIME (event); reply.target = SELECTION_EVENT_TARGET (event); reply.property = SELECTION_EVENT_PROPERTY (event); if (reply.property == None) reply.property = reply.target; /* #### XChangeProperty can generate BadAlloc, and we must handle it! */ BLOCK_INPUT; x_catch_errors (display); /* Store the data on the requested property. If the selection is large, only store the first N bytes of it. */ bytes_remaining = size * format_bytes; if (bytes_remaining <= max_bytes) { /* Send all the data at once, with minimal handshaking. */ #if 0 fprintf (stderr,"\nStoring all %d\n", bytes_remaining); #endif XChangeProperty (display, window, reply.property, type, format, PropModeReplace, data, size); /* At this point, the selection was successfully stored; ack it. */ XSendEvent (display, window, False, 0L, (XEvent *) &reply); } else { /* Send an INCR selection. */ struct prop_location *wait_object; int had_errors; int count = specpdl_ptr - specpdl; Lisp_Object frame; frame = some_frame_on_display (dpyinfo); /* If the display no longer has frames, we can't expect to get many more selection requests from it, so don't bother trying to queue them. */ if (!NILP (frame)) { x_start_queuing_selection_requests (display); record_unwind_protect (queue_selection_requests_unwind, frame); } if (x_window_to_frame (dpyinfo, window)) /* #### debug */ error ("attempt to transfer an INCR to ourself!"); #if 0 fprintf (stderr, "\nINCR %d\n", bytes_remaining); #endif wait_object = expect_property_change (display, window, reply.property, PropertyDelete); XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR, 32, PropModeReplace, (unsigned char *) &bytes_remaining, 1); XSelectInput (display, window, PropertyChangeMask); /* Tell 'em the INCR data is there... */ XSendEvent (display, window, False, 0L, (XEvent *) &reply); XFlush (display); had_errors = x_had_errors_p (display); UNBLOCK_INPUT; /* First, wait for the requestor to ack by deleting the property. This can run random lisp code (process handlers) or signal. */ if (! had_errors) wait_for_property_change (wait_object); while (bytes_remaining) { int i = ((bytes_remaining < max_bytes) ? bytes_remaining : max_bytes); BLOCK_INPUT; wait_object = expect_property_change (display, window, reply.property, PropertyDelete); #if 0 fprintf (stderr," INCR adding %d\n", i); #endif /* Append the next chunk of data to the property. */ XChangeProperty (display, window, reply.property, type, format, PropModeAppend, data, i / format_bytes); bytes_remaining -= i; data += i; XFlush (display); had_errors = x_had_errors_p (display); UNBLOCK_INPUT; if (had_errors) break; /* Now wait for the requestor to ack this chunk by deleting the property. This can run random lisp code or signal. */ wait_for_property_change (wait_object); } /* Now write a zero-length chunk to the property to tell the requestor that we're done. */ #if 0 fprintf (stderr," INCR done\n"); #endif BLOCK_INPUT; if (! waiting_for_other_props_on_window (display, window)) XSelectInput (display, window, 0L); XChangeProperty (display, window, reply.property, type, format, PropModeReplace, data, 0); unbind_to (count, Qnil); } XFlush (display); x_uncatch_errors (display); UNBLOCK_INPUT; } /* Handle a SelectionRequest event EVENT. This is called from keyboard.c when such an event is found in the queue. */ void x_handle_selection_request (event) struct input_event *event; { struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object local_selection_data; Lisp_Object selection_symbol; Lisp_Object target_symbol; Lisp_Object converted_selection; Time local_selection_time; Lisp_Object successful_p; int count; struct x_display_info *dpyinfo = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event)); local_selection_data = Qnil; target_symbol = Qnil; converted_selection = Qnil; successful_p = Qnil; GCPRO3 (local_selection_data, converted_selection, target_symbol); selection_symbol = x_atom_to_symbol (dpyinfo, SELECTION_EVENT_DISPLAY (event), SELECTION_EVENT_SELECTION (event)); local_selection_data = assq_no_quit (selection_symbol, Vselection_alist); if (NILP (local_selection_data)) { /* Someone asked for the selection, but we don't have it any more. */ x_decline_selection_request (event); goto DONE; } local_selection_time = (Time) cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car); if (SELECTION_EVENT_TIME (event) != CurrentTime && local_selection_time > SELECTION_EVENT_TIME (event)) { /* Someone asked for the selection, and we have one, but not the one they're looking for. */ x_decline_selection_request (event); goto DONE; } count = specpdl_ptr - specpdl; x_selection_current_request = event; record_unwind_protect (x_selection_request_lisp_error, Qnil); target_symbol = x_atom_to_symbol (dpyinfo, SELECTION_EVENT_DISPLAY (event), SELECTION_EVENT_TARGET (event)); #if 0 /* #### MULTIPLE doesn't work yet */ if (EQ (target_symbol, QMULTIPLE)) target_symbol = fetch_multiple_target (event); #endif /* Convert lisp objects back into binary data */ converted_selection = x_get_local_selection (selection_symbol, target_symbol); if (! NILP (converted_selection)) { unsigned char *data; unsigned int size; int format; Atom type; int nofree; lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event), converted_selection, &data, &type, &size, &format, &nofree); x_reply_selection_request (event, format, data, size, type); successful_p = Qt; /* Indicate we have successfully processed this event. */ x_selection_current_request = 0; if (!nofree) xfree (data); } unbind_to (count, Qnil); DONE: UNGCPRO; /* Let random lisp code notice that the selection has been asked for. */ { Lisp_Object rest; rest = Vx_sent_selection_hooks; if (!EQ (rest, Qunbound)) for (; CONSP (rest); rest = Fcdr (rest)) call3 (Fcar (rest), selection_symbol, target_symbol, successful_p); } } /* Handle a SelectionClear event EVENT, which indicates that some other client cleared out our previously asserted selection. This is called from keyboard.c when such an event is found in the queue. */ void x_handle_selection_clear (event) struct input_event *event; { Display *display = SELECTION_EVENT_DISPLAY (event); Atom selection = SELECTION_EVENT_SELECTION (event); Time changed_owner_time = SELECTION_EVENT_TIME (event); Lisp_Object selection_symbol, local_selection_data; Time local_selection_time; struct x_display_info *dpyinfo = x_display_info_for_display (display); selection_symbol = x_atom_to_symbol (dpyinfo, display, selection); local_selection_data = assq_no_quit (selection_symbol, Vselection_alist); /* Well, we already believe that we don't own it, so that's just fine. */ if (NILP (local_selection_data)) return; local_selection_time = (Time) cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car); /* This SelectionClear is for a selection that we no longer own, so we can disregard it. (That is, we have reasserted the selection since this request was generated.) */ if (changed_owner_time != CurrentTime && local_selection_time > changed_owner_time) return; /* Otherwise, we're really honest and truly being told to drop it. Don't use Fdelq as that may QUIT;. */ if (EQ (local_selection_data, Fcar (Vselection_alist))) Vselection_alist = Fcdr (Vselection_alist); else { Lisp_Object rest; for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) if (EQ (local_selection_data, Fcar (XCONS (rest)->cdr))) { XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr); break; } } /* Let random lisp code notice that the selection has been stolen. */ { Lisp_Object rest; rest = Vx_lost_selection_hooks; if (!EQ (rest, Qunbound)) { for (; CONSP (rest); rest = Fcdr (rest)) call1 (Fcar (rest), selection_symbol); prepare_menu_bars (); redisplay_preserve_echo_area (); } } } /* Clear all selections that were made from frame F. We do this when about to delete a frame. */ void x_clear_frame_selections (f) FRAME_PTR f; { Lisp_Object frame; Lisp_Object rest; XSETFRAME (frame, f); /* Otherwise, we're really honest and truly being told to drop it. Don't use Fdelq as that may QUIT;. */ /* Delete elements from the beginning of Vselection_alist. */ while (!NILP (Vselection_alist) && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist))))))) { /* Let random Lisp code notice that the selection has been stolen. */ Lisp_Object hooks, selection_symbol; hooks = Vx_lost_selection_hooks; selection_symbol = Fcar (Fcar (Vselection_alist)); if (!EQ (hooks, Qunbound)) { for (; CONSP (hooks); hooks = Fcdr (hooks)) call1 (Fcar (hooks), selection_symbol); redisplay_preserve_echo_area (); } Vselection_alist = Fcdr (Vselection_alist); } /* Delete elements after the beginning of Vselection_alist. */ for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest)->cdr))))))) { /* Let random Lisp code notice that the selection has been stolen. */ Lisp_Object hooks, selection_symbol; hooks = Vx_lost_selection_hooks; selection_symbol = Fcar (Fcar (XCONS (rest)->cdr)); if (!EQ (hooks, Qunbound)) { for (; CONSP (hooks); hooks = Fcdr (hooks)) call1 (Fcar (hooks), selection_symbol); redisplay_preserve_echo_area (); } XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr); break; } } /* Nonzero if any properties for DISPLAY and WINDOW are on the list of what we are waiting for. */ static int waiting_for_other_props_on_window (display, window) Display *display; Window window; { struct prop_location *rest = property_change_wait_list; while (rest) if (rest->display == display && rest->window == window) return 1; else rest = rest->next; return 0; } /* Add an entry to the list of property changes we are waiting for. DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for. The return value is a number that uniquely identifies this awaited property change. */ static struct prop_location * expect_property_change (display, window, property, state) Display *display; Window window; Lisp_Object property; int state; { struct prop_location *pl = (struct prop_location *) xmalloc (sizeof (struct prop_location)); pl->identifier = ++prop_location_identifier; pl->display = display; pl->window = window; pl->property = property; pl->desired_state = state; pl->next = property_change_wait_list; pl->arrived = 0; property_change_wait_list = pl; return pl; } /* Delete an entry from the list of property changes we are waiting for. IDENTIFIER is the number that uniquely identifies the entry. */ static void unexpect_property_change (location) struct prop_location *location; { struct prop_location *prev = 0, *rest = property_change_wait_list; while (rest) { if (rest == location) { if (prev) prev->next = rest->next; else property_change_wait_list = rest->next; xfree (rest); return; } prev = rest; rest = rest->next; } } /* Remove the property change expectation element for IDENTIFIER. */ static Lisp_Object wait_for_property_change_unwind (identifierval) Lisp_Object identifierval; { unexpect_property_change ((struct prop_location *) (XFASTINT (XCONS (identifierval)->car) << 16 | XFASTINT (XCONS (identifierval)->cdr))); return Qnil; } /* Actually wait for a property change. IDENTIFIER should be the value that expect_property_change returned. */ static void wait_for_property_change (location) struct prop_location *location; { int secs, usecs; int count = specpdl_ptr - specpdl; Lisp_Object tem; tem = Fcons (Qnil, Qnil); XSETFASTINT (XCONS (tem)->car, (EMACS_UINT)location >> 16); XSETFASTINT (XCONS (tem)->cdr, (EMACS_UINT)location & 0xffff); /* Make sure to do unexpect_property_change if we quit or err. */ record_unwind_protect (wait_for_property_change_unwind, tem); XCONS (property_change_reply)->car = Qnil; property_change_reply_object = location; /* If the event we are waiting for arrives beyond here, it will set property_change_reply, because property_change_reply_object says so. */ if (! location->arrived) { secs = x_selection_timeout / 1000; usecs = (x_selection_timeout % 1000) * 1000; wait_reading_process_input (secs, usecs, property_change_reply, 0); if (NILP (XCONS (property_change_reply)->car)) error ("timed out waiting for property-notify event"); } unbind_to (count, Qnil); } /* Called from XTread_socket in response to a PropertyNotify event. */ void x_handle_property_notify (event) XPropertyEvent *event; { struct prop_location *prev = 0, *rest = property_change_wait_list; while (rest) { if (rest->property == event->atom && rest->window == event->window && rest->display == event->display && rest->desired_state == event->state) { #if 0 fprintf (stderr, "Saw expected prop-%s on %s\n", (event->state == PropertyDelete ? "delete" : "change"), (char *) XSYMBOL (x_atom_to_symbol (dpyinfo, event->display, event->atom)) ->name->data); #endif rest->arrived = 1; /* If this is the one wait_for_property_change is waiting for, tell it to wake up. */ if (rest == property_change_reply_object) XCONS (property_change_reply)->car = Qt; if (prev) prev->next = rest->next; else property_change_wait_list = rest->next; xfree (rest); return; } prev = rest; rest = rest->next; } #if 0 fprintf (stderr, "Saw UNexpected prop-%s on %s\n", (event->state == PropertyDelete ? "delete" : "change"), (char *) XSYMBOL (x_atom_to_symbol (dpyinfo, event->display, event->atom)) ->name->data); #endif } #if 0 /* #### MULTIPLE doesn't work yet */ static Lisp_Object fetch_multiple_target (event) XSelectionRequestEvent *event; { Display *display = event->display; Window window = event->requestor; Atom target = event->target; Atom selection_atom = event->selection; int result; return Fcons (QMULTIPLE, x_get_window_property_as_lisp_data (display, window, target, QMULTIPLE, selection_atom)); } static Lisp_Object copy_multiple_data (obj) Lisp_Object obj; { Lisp_Object vec; int i; int size; if (CONSP (obj)) return Fcons (XCONS (obj)->car, copy_multiple_data (XCONS (obj)->cdr)); CHECK_VECTOR (obj, 0); vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil); for (i = 0; i < size; i++) { Lisp_Object vec2 = XVECTOR (obj)->contents [i]; CHECK_VECTOR (vec2, 0); if (XVECTOR (vec2)->size != 2) /* ??? Confusing error message */ Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"), Fcons (vec2, Qnil))); XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil); XVECTOR (XVECTOR (vec)->contents [i])->contents [0] = XVECTOR (vec2)->contents [0]; XVECTOR (XVECTOR (vec)->contents [i])->contents [1] = XVECTOR (vec2)->contents [1]; } return vec; } #endif /* Variables for communication with x_handle_selection_notify. */ static Atom reading_which_selection; static Lisp_Object reading_selection_reply; static Window reading_selection_window; /* Do protocol to read selection-data from the server. Converts this to Lisp data and returns it. */ static Lisp_Object x_get_foreign_selection (selection_symbol, target_type) Lisp_Object selection_symbol, target_type; { Window requestor_window = FRAME_X_WINDOW (selected_frame); Display *display = FRAME_X_DISPLAY (selected_frame); struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame); Time requestor_time = last_event_timestamp; Atom target_property = dpyinfo->Xatom_EMACS_TMP; Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol); Atom type_atom; int secs, usecs; int count = specpdl_ptr - specpdl; Lisp_Object frame; if (CONSP (target_type)) type_atom = symbol_to_x_atom (dpyinfo, display, XCONS (target_type)->car); else type_atom = symbol_to_x_atom (dpyinfo, display, target_type); BLOCK_INPUT; x_catch_errors (display); XConvertSelection (display, selection_atom, type_atom, target_property, requestor_window, requestor_time); XFlush (display); /* Prepare to block until the reply has been read. */ reading_selection_window = requestor_window; reading_which_selection = selection_atom; XCONS (reading_selection_reply)->car = Qnil; frame = some_frame_on_display (dpyinfo); /* If the display no longer has frames, we can't expect to get many more selection requests from it, so don't bother trying to queue them. */ if (!NILP (frame)) { x_start_queuing_selection_requests (display); record_unwind_protect (queue_selection_requests_unwind, frame); } UNBLOCK_INPUT; /* This allows quits. Also, don't wait forever. */ secs = x_selection_timeout / 1000; usecs = (x_selection_timeout % 1000) * 1000; wait_reading_process_input (secs, usecs, reading_selection_reply, 0); BLOCK_INPUT; x_check_errors (display, "Cannot get selection: %s"); x_uncatch_errors (display); unbind_to (count, Qnil); UNBLOCK_INPUT; if (NILP (XCONS (reading_selection_reply)->car)) error ("timed out waiting for reply from selection owner"); /* Otherwise, the selection is waiting for us on the requested property. */ return x_get_window_property_as_lisp_data (display, requestor_window, target_property, target_type, selection_atom); } /* Subroutines of x_get_window_property_as_lisp_data */ static void x_get_window_property (display, window, property, data_ret, bytes_ret, actual_type_ret, actual_format_ret, actual_size_ret, delete_p) Display *display; Window window; Atom property; unsigned char **data_ret; int *bytes_ret; Atom *actual_type_ret; int *actual_format_ret; unsigned long *actual_size_ret; int delete_p; { int total_size; unsigned long bytes_remaining; int offset = 0; unsigned char *tmp_data = 0; int result; int buffer_size = SELECTION_QUANTUM (display); if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM; BLOCK_INPUT; /* First probe the thing to find out how big it is. */ result = XGetWindowProperty (display, window, property, 0L, 0L, False, AnyPropertyType, actual_type_ret, actual_format_ret, actual_size_ret, &bytes_remaining, &tmp_data); if (result != Success) { UNBLOCK_INPUT; *data_ret = 0; *bytes_ret = 0; return; } xfree ((char *) tmp_data); if (*actual_type_ret == None || *actual_format_ret == 0) { UNBLOCK_INPUT; return; } total_size = bytes_remaining + 1; *data_ret = (unsigned char *) xmalloc (total_size); /* Now read, until weve gotten it all. */ while (bytes_remaining) { #if 0 int last = bytes_remaining; #endif result = XGetWindowProperty (display, window, property, (long)offset/4, (long)buffer_size/4, False, AnyPropertyType, actual_type_ret, actual_format_ret, actual_size_ret, &bytes_remaining, &tmp_data); #if 0 fprintf (stderr, "<< read %d\n", last-bytes_remaining); #endif /* If this doesn't return Success at this point, it means that some clod deleted the selection while we were in the midst of reading it. Deal with that, I guess.... */ if (result != Success) break; *actual_size_ret *= *actual_format_ret / 8; bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret); offset += *actual_size_ret; xfree ((char *) tmp_data); } XFlush (display); UNBLOCK_INPUT; *bytes_ret = offset; } static void receive_incremental_selection (display, window, property, target_type, min_size_bytes, data_ret, size_bytes_ret, type_ret, format_ret, size_ret) Display *display; Window window; Atom property; Lisp_Object target_type; /* for error messages only */ unsigned int min_size_bytes; unsigned char **data_ret; int *size_bytes_ret; Atom *type_ret; unsigned long *size_ret; int *format_ret; { int offset = 0; struct prop_location *wait_object; *size_bytes_ret = min_size_bytes; *data_ret = (unsigned char *) xmalloc (*size_bytes_ret); #if 0 fprintf (stderr, "\nread INCR %d\n", min_size_bytes); #endif /* At this point, we have read an INCR property. Delete the property to ack it. (But first, prepare to receive the next event in this handshake.) Now, we must loop, waiting for the sending window to put a value on that property, then reading the property, then deleting it to ack. We are done when the sender places a property of length 0. */ BLOCK_INPUT; XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask); XDeleteProperty (display, window, property); wait_object = expect_property_change (display, window, property, PropertyNewValue); XFlush (display); UNBLOCK_INPUT; while (1) { unsigned char *tmp_data; int tmp_size_bytes; wait_for_property_change (wait_object); /* expect it again immediately, because x_get_window_property may .. no it wont, I dont get it. .. Ok, I get it now, the Xt code that implements INCR is broken. */ x_get_window_property (display, window, property, &tmp_data, &tmp_size_bytes, type_ret, format_ret, size_ret, 1); if (tmp_size_bytes == 0) /* we're done */ { #if 0 fprintf (stderr, " read INCR done\n"); #endif if (! waiting_for_other_props_on_window (display, window)) XSelectInput (display, window, STANDARD_EVENT_SET); unexpect_property_change (wait_object); if (tmp_data) xfree (tmp_data); break; } BLOCK_INPUT; XDeleteProperty (display, window, property); wait_object = expect_property_change (display, window, property, PropertyNewValue); XFlush (display); UNBLOCK_INPUT; #if 0 fprintf (stderr, " read INCR %d\n", tmp_size_bytes); #endif if (*size_bytes_ret < offset + tmp_size_bytes) { #if 0 fprintf (stderr, " read INCR realloc %d -> %d\n", *size_bytes_ret, offset + tmp_size_bytes); #endif *size_bytes_ret = offset + tmp_size_bytes; *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret); } bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes); offset += tmp_size_bytes; xfree (tmp_data); } } /* Once a requested selection is "ready" (we got a SelectionNotify event), fetch value from property PROPERTY of X window WINDOW on display DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */ static Lisp_Object x_get_window_property_as_lisp_data (display, window, property, target_type, selection_atom) Display *display; Window window; Atom property; Lisp_Object target_type; /* for error messages only */ Atom selection_atom; /* for error messages only */ { Atom actual_type; int actual_format; unsigned long actual_size; unsigned char *data = 0; int bytes = 0; Lisp_Object val; struct x_display_info *dpyinfo = x_display_info_for_display (display); x_get_window_property (display, window, property, &data, &bytes, &actual_type, &actual_format, &actual_size, 1); if (! data) { int there_is_a_selection_owner; BLOCK_INPUT; there_is_a_selection_owner = XGetSelectionOwner (display, selection_atom); UNBLOCK_INPUT; while (1) /* Note debugger can no longer return, so this is obsolete */ Fsignal (Qerror, there_is_a_selection_owner ? Fcons (build_string ("selection owner couldn't convert"), actual_type ? Fcons (target_type, Fcons (x_atom_to_symbol (dpyinfo, display, actual_type), Qnil)) : Fcons (target_type, Qnil)) : Fcons (build_string ("no selection"), Fcons (x_atom_to_symbol (dpyinfo, display, selection_atom), Qnil))); } if (actual_type == dpyinfo->Xatom_INCR) { /* That wasn't really the data, just the beginning. */ unsigned int min_size_bytes = * ((unsigned int *) data); BLOCK_INPUT; XFree ((char *) data); UNBLOCK_INPUT; receive_incremental_selection (display, window, property, target_type, min_size_bytes, &data, &bytes, &actual_type, &actual_format, &actual_size); } BLOCK_INPUT; XDeleteProperty (display, window, property); XFlush (display); UNBLOCK_INPUT; /* It's been read. Now convert it to a lisp object in some semi-rational manner. */ val = selection_data_to_lisp_data (display, data, bytes, actual_type, actual_format); xfree ((char *) data); return val; } /* These functions convert from the selection data read from the server into something that we can use from Lisp, and vice versa. Type: Format: Size: Lisp Type: ----- ------- ----- ----------- * 8 * String ATOM 32 1 Symbol ATOM 32 > 1 Vector of Symbols * 16 1 Integer * 16 > 1 Vector of Integers * 32 1 if <=16 bits: Integer if > 16 bits: Cons of top16, bot16 * 32 > 1 Vector of the above When converting a Lisp number to C, it is assumed to be of format 16 if it is an integer, and of format 32 if it is a cons of two integers. When converting a vector of numbers from Lisp to C, it is assumed to be of format 16 if every element in the vector is an integer, and is assumed to be of format 32 if any element is a cons of two integers. When converting an object to C, it may be of the form (SYMBOL . ) where SYMBOL is what we should claim that the type is. Format and representation are as above. */ static Lisp_Object selection_data_to_lisp_data (display, data, size, type, format) Display *display; unsigned char *data; Atom type; int size, format; { struct x_display_info *dpyinfo = x_display_info_for_display (display); if (type == dpyinfo->Xatom_NULL) return QNULL; /* Convert any 8-bit data to a string, for compactness. */ else if (format == 8) return make_string ((char *) data, size); /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to a vector of symbols. */ else if (type == XA_ATOM) { int i; if (size == sizeof (Atom)) return x_atom_to_symbol (dpyinfo, display, *((Atom *) data)); else { Lisp_Object v = Fmake_vector (size / sizeof (Atom), 0); for (i = 0; i < size / sizeof (Atom); i++) Faset (v, i, x_atom_to_symbol (dpyinfo, display, ((Atom *) data) [i])); return v; } } /* Convert a single 16 or small 32 bit number to a Lisp_Int. If the number is > 16 bits, convert it to a cons of integers, 16 bits in each half. */ else if (format == 32 && size == sizeof (long)) return long_to_cons (((unsigned long *) data) [0]); else if (format == 16 && size == sizeof (short)) return make_number ((int) (((unsigned short *) data) [0])); /* Convert any other kind of data to a vector of numbers, represented as above (as an integer, or a cons of two 16 bit integers.) */ else if (format == 16) { int i; Lisp_Object v = Fmake_vector (size / 4, 0); for (i = 0; i < size / 4; i++) { int j = (int) ((unsigned short *) data) [i]; Faset (v, i, make_number (j)); } return v; } else { int i; Lisp_Object v = Fmake_vector (size / 4, 0); for (i = 0; i < size / 4; i++) { unsigned long j = ((unsigned long *) data) [i]; Faset (v, i, long_to_cons (j)); } return v; } } static void lisp_data_to_selection_data (display, obj, data_ret, type_ret, size_ret, format_ret, nofree_ret) Display *display; Lisp_Object obj; unsigned char **data_ret; Atom *type_ret; unsigned int *size_ret; int *format_ret; int *nofree_ret; { Lisp_Object type = Qnil; struct x_display_info *dpyinfo = x_display_info_for_display (display); *nofree_ret = 0; if (CONSP (obj) && SYMBOLP (XCONS (obj)->car)) { type = XCONS (obj)->car; obj = XCONS (obj)->cdr; if (CONSP (obj) && NILP (XCONS (obj)->cdr)) obj = XCONS (obj)->car; } if (EQ (obj, QNULL) || (EQ (type, QNULL))) { /* This is not the same as declining */ *format_ret = 32; *size_ret = 0; *data_ret = 0; type = QNULL; } else if (STRINGP (obj)) { *format_ret = 8; *size_ret = XSTRING (obj)->size; *data_ret = XSTRING (obj)->data; *nofree_ret = 1; if (NILP (type)) type = QSTRING; } else if (SYMBOLP (obj)) { *format_ret = 32; *size_ret = 1; *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1); (*data_ret) [sizeof (Atom)] = 0; (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj); if (NILP (type)) type = QATOM; } else if (INTEGERP (obj) && XINT (obj) < 0xFFFF && XINT (obj) > -0xFFFF) { *format_ret = 16; *size_ret = 1; *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1); (*data_ret) [sizeof (short)] = 0; (*(short **) data_ret) [0] = (short) XINT (obj); if (NILP (type)) type = QINTEGER; } else if (INTEGERP (obj) || (CONSP (obj) && INTEGERP (XCONS (obj)->car) && (INTEGERP (XCONS (obj)->cdr) || (CONSP (XCONS (obj)->cdr) && INTEGERP (XCONS (XCONS (obj)->cdr)->car))))) { *format_ret = 32; *size_ret = 1; *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1); (*data_ret) [sizeof (long)] = 0; (*(unsigned long **) data_ret) [0] = cons_to_long (obj); if (NILP (type)) type = QINTEGER; } else if (VECTORP (obj)) { /* Lisp_Vectors may represent a set of ATOMs; a set of 16 or 32 bit INTEGERs; or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...] */ int i; if (SYMBOLP (XVECTOR (obj)->contents [0])) /* This vector is an ATOM set */ { if (NILP (type)) type = QATOM; *size_ret = XVECTOR (obj)->size; *format_ret = 32; *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom)); for (i = 0; i < *size_ret; i++) if (SYMBOLP (XVECTOR (obj)->contents [i])) (*(Atom **) data_ret) [i] = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]); else Fsignal (Qerror, /* Qselection_error */ Fcons (build_string ("all elements of selection vector must have same type"), Fcons (obj, Qnil))); } #if 0 /* #### MULTIPLE doesn't work yet */ else if (VECTORP (XVECTOR (obj)->contents [0])) /* This vector is an ATOM_PAIR set */ { if (NILP (type)) type = QATOM_PAIR; *size_ret = XVECTOR (obj)->size; *format_ret = 32; *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom) * 2); for (i = 0; i < *size_ret; i++) if (VECTORP (XVECTOR (obj)->contents [i])) { Lisp_Object pair = XVECTOR (obj)->contents [i]; if (XVECTOR (pair)->size != 2) Fsignal (Qerror, Fcons (build_string ("elements of the vector must be vectors of exactly two elements"), Fcons (pair, Qnil))); (*(Atom **) data_ret) [i * 2] = symbol_to_x_atom (dpyinfo, display, XVECTOR (pair)->contents [0]); (*(Atom **) data_ret) [(i * 2) + 1] = symbol_to_x_atom (dpyinfo, display, XVECTOR (pair)->contents [1]); } else Fsignal (Qerror, Fcons (build_string ("all elements of the vector must be of the same type"), Fcons (obj, Qnil))); } #endif else /* This vector is an INTEGER set, or something like it */ { *size_ret = XVECTOR (obj)->size; if (NILP (type)) type = QINTEGER; *format_ret = 16; for (i = 0; i < *size_ret; i++) if (CONSP (XVECTOR (obj)->contents [i])) *format_ret = 32; else if (!INTEGERP (XVECTOR (obj)->contents [i])) Fsignal (Qerror, /* Qselection_error */ Fcons (build_string ("elements of selection vector must be integers or conses of integers"), Fcons (obj, Qnil))); *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8)); for (i = 0; i < *size_ret; i++) if (*format_ret == 32) (*((unsigned long **) data_ret)) [i] = cons_to_long (XVECTOR (obj)->contents [i]); else (*((unsigned short **) data_ret)) [i] = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]); } } else Fsignal (Qerror, /* Qselection_error */ Fcons (build_string ("unrecognised selection data"), Fcons (obj, Qnil))); *type_ret = symbol_to_x_atom (dpyinfo, display, type); } static Lisp_Object clean_local_selection_data (obj) Lisp_Object obj; { if (CONSP (obj) && INTEGERP (XCONS (obj)->car) && CONSP (XCONS (obj)->cdr) && INTEGERP (XCONS (XCONS (obj)->cdr)->car) && NILP (XCONS (XCONS (obj)->cdr)->cdr)) obj = Fcons (XCONS (obj)->car, XCONS (obj)->cdr); if (CONSP (obj) && INTEGERP (XCONS (obj)->car) && INTEGERP (XCONS (obj)->cdr)) { if (XINT (XCONS (obj)->car) == 0) return XCONS (obj)->cdr; if (XINT (XCONS (obj)->car) == -1) return make_number (- XINT (XCONS (obj)->cdr)); } if (VECTORP (obj)) { int i; int size = XVECTOR (obj)->size; Lisp_Object copy; if (size == 1) return clean_local_selection_data (XVECTOR (obj)->contents [0]); copy = Fmake_vector (size, Qnil); for (i = 0; i < size; i++) XVECTOR (copy)->contents [i] = clean_local_selection_data (XVECTOR (obj)->contents [i]); return copy; } return obj; } /* Called from XTread_socket to handle SelectionNotify events. If it's the selection we are waiting for, stop waiting. */ void x_handle_selection_notify (event) XSelectionEvent *event; { if (event->requestor != reading_selection_window) return; if (event->selection != reading_which_selection) return; XCONS (reading_selection_reply)->car = Qt; } DEFUN ("x-own-selection-internal", Fx_own_selection_internal, Sx_own_selection_internal, 2, 2, 0, "Assert an X selection of the given TYPE with the given VALUE.\n\ TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\ \(Those are literal upper-case symbol names, since that's what X expects.)\n\ VALUE is typically a string, or a cons of two markers, but may be\n\ anything that the functions on `selection-converter-alist' know about.") (selection_name, selection_value) Lisp_Object selection_name, selection_value; { check_x (); CHECK_SYMBOL (selection_name, 0); if (NILP (selection_value)) error ("selection-value may not be nil."); x_own_selection (selection_name, selection_value); return selection_value; } /* Request the selection value from the owner. If we are the owner, simply return our selection value. If we are not the owner, this will block until all of the data has arrived. */ DEFUN ("x-get-selection-internal", Fx_get_selection_internal, Sx_get_selection_internal, 2, 2, 0, "Return text selected from some X window.\n\ SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\ \(Those are literal upper-case symbol names, since that's what X expects.)\n\ TYPE is the type of data desired, typically `STRING'.") (selection_symbol, target_type) Lisp_Object selection_symbol, target_type; { Lisp_Object val = Qnil; struct gcpro gcpro1, gcpro2; GCPRO2 (target_type, val); /* we store newly consed data into these */ check_x (); CHECK_SYMBOL (selection_symbol, 0); #if 0 /* #### MULTIPLE doesn't work yet */ if (CONSP (target_type) && XCONS (target_type)->car == QMULTIPLE) { CHECK_VECTOR (XCONS (target_type)->cdr, 0); /* So we don't destructively modify this... */ target_type = copy_multiple_data (target_type); } else #endif CHECK_SYMBOL (target_type, 0); val = x_get_local_selection (selection_symbol, target_type); if (NILP (val)) { val = x_get_foreign_selection (selection_symbol, target_type); goto DONE; } if (CONSP (val) && SYMBOLP (XCONS (val)->car)) { val = XCONS (val)->cdr; if (CONSP (val) && NILP (XCONS (val)->cdr)) val = XCONS (val)->car; } val = clean_local_selection_data (val); DONE: UNGCPRO; return val; } DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0, "If we own the selection SELECTION, disown it.\n\ Disowning it means there is no such selection.") (selection, time) Lisp_Object selection; Lisp_Object time; { Time timestamp; Atom selection_atom; XSelectionClearEvent event; Display *display; struct x_display_info *dpyinfo; check_x (); display = FRAME_X_DISPLAY (selected_frame); dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame); CHECK_SYMBOL (selection, 0); if (NILP (time)) timestamp = last_event_timestamp; else timestamp = cons_to_long (time); if (NILP (assq_no_quit (selection, Vselection_alist))) return Qnil; /* Don't disown the selection when we're not the owner. */ selection_atom = symbol_to_x_atom (dpyinfo, display, selection); BLOCK_INPUT; XSetSelectionOwner (display, selection_atom, None, timestamp); UNBLOCK_INPUT; /* It doesn't seem to be guaranteed that a SelectionClear event will be generated for a window which owns the selection when that window sets the selection owner to None. The NCD server does, the MIT Sun4 server doesn't. So we synthesize one; this means we might get two, but that's ok, because the second one won't have any effect. */ SELECTION_EVENT_DISPLAY (&event) = display; SELECTION_EVENT_SELECTION (&event) = selection_atom; SELECTION_EVENT_TIME (&event) = timestamp; x_handle_selection_clear (&event); return Qt; } /* Get rid of all the selections in buffer BUFFER. This is used when we kill a buffer. */ void x_disown_buffer_selections (buffer) Lisp_Object buffer; { Lisp_Object tail; struct buffer *buf = XBUFFER (buffer); for (tail = Vselection_alist; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object elt, value; elt = XCONS (tail)->car; value = XCONS (elt)->cdr; if (CONSP (value) && MARKERP (XCONS (value)->car) && XMARKER (XCONS (value)->car)->buffer == buf) Fx_disown_selection_internal (XCONS (elt)->car, Qnil); } } DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p, 0, 1, 0, "Whether the current Emacs process owns the given X Selection.\n\ The arg should be the name of the selection in question, typically one of\n\ the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\ \(Those are literal upper-case symbol names, since that's what X expects.)\n\ For convenience, the symbol nil is the same as `PRIMARY',\n\ and t is the same as `SECONDARY'.)") (selection) Lisp_Object selection; { check_x (); CHECK_SYMBOL (selection, 0); if (EQ (selection, Qnil)) selection = QPRIMARY; if (EQ (selection, Qt)) selection = QSECONDARY; if (NILP (Fassq (selection, Vselection_alist))) return Qnil; return Qt; } DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p, 0, 1, 0, "Whether there is an owner for the given X Selection.\n\ The arg should be the name of the selection in question, typically one of\n\ the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\ \(Those are literal upper-case symbol names, since that's what X expects.)\n\ For convenience, the symbol nil is the same as `PRIMARY',\n\ and t is the same as `SECONDARY'.)") (selection) Lisp_Object selection; { Window owner; Atom atom; Display *dpy; /* It should be safe to call this before we have an X frame. */ if (! FRAME_X_P (selected_frame)) return Qnil; dpy = FRAME_X_DISPLAY (selected_frame); CHECK_SYMBOL (selection, 0); if (!NILP (Fx_selection_owner_p (selection))) return Qt; if (EQ (selection, Qnil)) selection = QPRIMARY; if (EQ (selection, Qt)) selection = QSECONDARY; atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame), dpy, selection); if (atom == 0) return Qnil; BLOCK_INPUT; owner = XGetSelectionOwner (dpy, atom); UNBLOCK_INPUT; return (owner ? Qt : Qnil); } #ifdef CUT_BUFFER_SUPPORT /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */ static void initialize_cut_buffers (display, window) Display *display; Window window; { unsigned char *data = (unsigned char *) ""; BLOCK_INPUT; #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \ PropModeAppend, data, 0) FROB (XA_CUT_BUFFER0); FROB (XA_CUT_BUFFER1); FROB (XA_CUT_BUFFER2); FROB (XA_CUT_BUFFER3); FROB (XA_CUT_BUFFER4); FROB (XA_CUT_BUFFER5); FROB (XA_CUT_BUFFER6); FROB (XA_CUT_BUFFER7); #undef FROB UNBLOCK_INPUT; } #define CHECK_CUT_BUFFER(symbol,n) \ { CHECK_SYMBOL ((symbol), (n)); \ if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \ && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \ && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \ && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \ Fsignal (Qerror, \ Fcons (build_string ("doesn't name a cut buffer"), \ Fcons ((symbol), Qnil))); \ } DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal, Sx_get_cut_buffer_internal, 1, 1, 0, "Returns the value of the named cut buffer (typically CUT_BUFFER0).") (buffer) Lisp_Object buffer; { Window window; Atom buffer_atom; unsigned char *data; int bytes; Atom type; int format; unsigned long size; Lisp_Object ret; Display *display; struct x_display_info *dpyinfo; check_x (); display = FRAME_X_DISPLAY (selected_frame); dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame); window = RootWindow (display, 0); /* Cut buffers are on screen 0 */ CHECK_CUT_BUFFER (buffer, 0); buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer); x_get_window_property (display, window, buffer_atom, &data, &bytes, &type, &format, &size, 0); if (!data) return Qnil; if (format != 8 || type != XA_STRING) Fsignal (Qerror, Fcons (build_string ("cut buffer doesn't contain 8-bit data"), Fcons (x_atom_to_symbol (dpyinfo, display, type), Fcons (make_number (format), Qnil)))); ret = (bytes ? make_string ((char *) data, bytes) : Qnil); xfree (data); return ret; } DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal, Sx_store_cut_buffer_internal, 2, 2, 0, "Sets the value of the named cut buffer (typically CUT_BUFFER0).") (buffer, string) Lisp_Object buffer, string; { Window window; Atom buffer_atom; unsigned char *data; int bytes; int bytes_remaining; int max_bytes; Display *display; check_x (); display = FRAME_X_DISPLAY (selected_frame); window = RootWindow (display, 0); /* Cut buffers are on screen 0 */ max_bytes = SELECTION_QUANTUM (display); if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM; CHECK_CUT_BUFFER (buffer, 0); CHECK_STRING (string, 0); buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame), display, buffer); data = (unsigned char *) XSTRING (string)->data; bytes = XSTRING (string)->size; bytes_remaining = bytes; if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized) { initialize_cut_buffers (display, window); FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1; } BLOCK_INPUT; /* Don't mess up with an empty value. */ if (!bytes_remaining) XChangeProperty (display, window, buffer_atom, XA_STRING, 8, PropModeReplace, data, 0); while (bytes_remaining) { int chunk = (bytes_remaining < max_bytes ? bytes_remaining : max_bytes); XChangeProperty (display, window, buffer_atom, XA_STRING, 8, (bytes_remaining == bytes ? PropModeReplace : PropModeAppend), data, chunk); data += chunk; bytes_remaining -= chunk; } UNBLOCK_INPUT; return string; } DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal, Sx_rotate_cut_buffers_internal, 1, 1, 0, "Rotate the values of the cut buffers by the given number of steps;\n\ positive means move values forward, negative means backward.") (n) Lisp_Object n; { Window window; Atom props[8]; Display *display; check_x (); display = FRAME_X_DISPLAY (selected_frame); window = RootWindow (display, 0); /* Cut buffers are on screen 0 */ CHECK_NUMBER (n, 0); if (XINT (n) == 0) return n; if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized) { initialize_cut_buffers (display, window); FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1; } props[0] = XA_CUT_BUFFER0; props[1] = XA_CUT_BUFFER1; props[2] = XA_CUT_BUFFER2; props[3] = XA_CUT_BUFFER3; props[4] = XA_CUT_BUFFER4; props[5] = XA_CUT_BUFFER5; props[6] = XA_CUT_BUFFER6; props[7] = XA_CUT_BUFFER7; BLOCK_INPUT; XRotateWindowProperties (display, window, props, 8, XINT (n)); UNBLOCK_INPUT; return n; } #endif void syms_of_xselect () { defsubr (&Sx_get_selection_internal); defsubr (&Sx_own_selection_internal); defsubr (&Sx_disown_selection_internal); defsubr (&Sx_selection_owner_p); defsubr (&Sx_selection_exists_p); #ifdef CUT_BUFFER_SUPPORT defsubr (&Sx_get_cut_buffer_internal); defsubr (&Sx_store_cut_buffer_internal); defsubr (&Sx_rotate_cut_buffers_internal); #endif reading_selection_reply = Fcons (Qnil, Qnil); staticpro (&reading_selection_reply); reading_selection_window = 0; reading_which_selection = 0; property_change_wait_list = 0; prop_location_identifier = 0; property_change_reply = Fcons (Qnil, Qnil); staticpro (&property_change_reply); Vselection_alist = Qnil; staticpro (&Vselection_alist); DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist, "An alist associating X Windows selection-types with functions.\n\ These functions are called to convert the selection, with three args:\n\ the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\ a desired type to which the selection should be converted;\n\ and the local selection value (whatever was given to `x-own-selection').\n\ \n\ The function should return the value to send to the X server\n\ \(typically a string). A return value of nil\n\ means that the conversion could not be done.\n\ A return value which is the symbol `NULL'\n\ means that a side-effect was executed,\n\ and there is no meaningful selection value."); Vselection_converter_alist = Qnil; DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks, "A list of functions to be called when Emacs loses an X selection.\n\ \(This happens when some other X client makes its own selection\n\ or when a Lisp program explicitly clears the selection.)\n\ The functions are called with one argument, the selection type\n\ \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD')."); Vx_lost_selection_hooks = Qnil; DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks, "A list of functions to be called when Emacs answers a selection request.\n\ The functions are called with four arguments:\n\ - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\ - the selection-type which Emacs was asked to convert the\n\ selection into before sending (for example, `STRING' or `LENGTH');\n\ - a flag indicating success or failure for responding to the request.\n\ We might have failed (and declined the request) for any number of reasons,\n\ including being asked for a selection that we no longer own, or being asked\n\ to convert into a type that we don't know about or that is inappropriate.\n\ This hook doesn't let you change the behavior of Emacs's selection replies,\n\ it merely informs you that they have happened."); Vx_sent_selection_hooks = Qnil; DEFVAR_INT ("x-selection-timeout", &x_selection_timeout, "Number of milliseconds to wait for a selection reply.\n\ If the selection owner doens't reply in this time, we give up.\n\ A value of 0 means wait as long as necessary. This is initialized from the\n\ \"*selectionTimeout\" resource."); x_selection_timeout = 0; QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY); QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY); QSTRING = intern ("STRING"); staticpro (&QSTRING); QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER); QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD); QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP); QTEXT = intern ("TEXT"); staticpro (&QTEXT); QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP); QDELETE = intern ("DELETE"); staticpro (&QDELETE); QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE); QINCR = intern ("INCR"); staticpro (&QINCR); QEMACS_TMP = intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP); QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS); QATOM = intern ("ATOM"); staticpro (&QATOM); QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR); QNULL = intern ("NULL"); staticpro (&QNULL); #ifdef CUT_BUFFER_SUPPORT QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0); QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1); QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2); QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3); QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4); QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5); QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6); QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7); #endif } emacs-19.30/src/xterm.c100444 12120 1 533307 6054721361 13251 0ustar rmsdaemon/* X Communication module for terminals which understand the X protocol. Copyright (C) 1989, 1993, 1994, 1995 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. */ /* Xt features made by Fred Pierresteguy. */ /* On 4.3 these lose if they come after xterm.h. */ /* On HP-UX 8.0 signal.h loses if it comes after config.h. */ /* Putting these at the beginning seems to be standard for other .c files. */ #include #include #include /* Need syssignal.h for various externs and definitions that may be required by some configurations for calls to signal later in this source file. */ #include "syssignal.h" #ifdef HAVE_X_WINDOWS #include "lisp.h" #include "blockinput.h" /* This may include sys/types.h, and that somehow loses if this is not done before the other system files. */ #include "xterm.h" #include #ifndef USG /* Load sys/types.h if not already loaded. In some systems loading it twice is suicidal. */ #ifndef makedev #include #endif /* makedev */ #endif /* USG */ #ifdef BSD #include #endif /* ! defined (BSD) */ #include "systty.h" #include "systime.h" #ifndef INCLUDED_FCNTL #include #endif #include #include #include #include /* Caused redefinition of DBL_DIG on Netbsd; seems not to be needed. */ /* #include */ #include "frame.h" #include "dispextern.h" #include "termhooks.h" #include "termopts.h" #include "termchar.h" #if 0 #include "sink.h" #include "sinkmask.h" #endif /* ! 0 */ #include "gnu.h" #include "disptab.h" #include "buffer.h" #include "window.h" #include "keyboard.h" #include "intervals.h" #ifdef USE_X_TOOLKIT extern void free_frame_menubar (); extern FRAME_PTR x_menubar_window_to_frame (); #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES) #define HACK_EDITRES extern void _XEditResCheckMessages (); #endif /* not NO_EDITRES */ #endif /* USE_X_TOOLKIT */ #ifndef USE_X_TOOLKIT #define x_any_window_to_frame x_window_to_frame #define x_top_window_to_frame x_window_to_frame #endif #ifdef USE_X_TOOLKIT #include "widget.h" #ifndef XtNinitialState #define XtNinitialState "initialState" #endif #endif #ifdef HAVE_X11XTR6 /* So we can do setlocale. */ #include #endif #define min(a,b) ((a)<(b) ? (a) : (b)) #define max(a,b) ((a)>(b) ? (a) : (b)) /* This is a chain of structures for all the X displays currently in use. */ struct x_display_info *x_display_list; /* This is a list of cons cells, each of the form (NAME . FONT-LIST-CACHE), one for each element of x_display_list and in the same order. NAME is the name of the frame. FONT-LIST-CACHE records previous values returned by x-list-fonts. */ Lisp_Object x_display_name_list; /* Frame being updated by update_frame. This is declared in term.c. This is set by update_begin and looked at by all the XT functions. It is zero while not inside an update. In that case, the XT functions assume that `selected_frame' is the frame to apply to. */ extern struct frame *updating_frame; /* This is a frame waiting to be autoraised, within XTread_socket. */ struct frame *pending_autoraise_frame; #ifdef USE_X_TOOLKIT /* The application context for Xt use. */ XtAppContext Xt_app_con; static String Xt_default_resources[] = { 0 }; #endif /* During an update, maximum vpos for ins/del line operations to affect. */ static int flexlines; /* During an update, nonzero if chars output now should be highlighted. */ static int highlight; /* Nominal cursor position -- where to draw output. During an update, these are different from the cursor-box position. */ static int curs_x; static int curs_y; /* Mouse movement. In order to avoid asking for motion events and then throwing most of them away or busy-polling the server for mouse positions, we ask the server for pointer motion hints. This means that we get only one event per group of mouse movements. "Groups" are delimited by other kinds of events (focus changes and button clicks, for example), or by XQueryPointer calls; when one of these happens, we get another MotionNotify event the next time the mouse moves. This is at least as efficient as getting motion events when mouse tracking is on, and I suspect only negligibly worse when tracking is off. The silly O'Reilly & Associates Nutshell guides barely document pointer motion hints at all (I think you have to infer how they work from an example), and the description of XQueryPointer doesn't mention that calling it causes you to get another motion hint from the server, which is very important. */ /* Where the mouse was last time we reported a mouse event. */ static FRAME_PTR last_mouse_frame; static XRectangle last_mouse_glyph; /* The scroll bar in which the last X motion event occurred. If the last X motion event occurred in a scroll bar, we set this so XTmouse_position can know whether to report a scroll bar motion or an ordinary motion. If the last X motion event didn't occur in a scroll bar, we set this to Qnil, to tell XTmouse_position to return an ordinary motion event. */ static Lisp_Object last_mouse_scroll_bar; /* This is a hack. We would really prefer that XTmouse_position would return the time associated with the position it returns, but there doesn't seem to be any way to wrest the timestamp from the server along with the position query. So, we just keep track of the time of the last movement we received, and return that in hopes that it's somewhat accurate. */ static Time last_mouse_movement_time; /* Incremented by XTread_socket whenever it really tries to read events. */ #ifdef __STDC__ static int volatile input_signal_count; #else static int input_signal_count; #endif /* Used locally within XTread_socket. */ static int x_noop_count; /* Initial values of argv and argc. */ extern char **initial_argv; extern int initial_argc; extern Lisp_Object Vcommand_line_args, Vsystem_name; /* Tells if a window manager is present or not. */ extern Lisp_Object Vx_no_window_manager; /* Nonzero enables some debugging for the X interface code. */ extern int _Xdebug; extern Lisp_Object Qface, Qmouse_face; extern int errno; /* A mask of extra modifier bits to put into every keyboard char. */ extern int extra_keyboard_modifiers; static Lisp_Object Qvendor_specific_keysyms; extern XrmDatabase x_load_resources (); extern Lisp_Object x_icon_type (); void x_delete_display (); static void redraw_previous_char (); static void redraw_following_char (); static unsigned int x_x_to_emacs_modifiers (); static int fast_find_position (); static void note_mouse_highlight (); static void clear_mouse_face (); static void show_mouse_face (); static void do_line_dance (); static int XTcursor_to (); static int XTclear_end_of_line (); static int x_io_error_quitter (); void x_catch_errors (); void x_uncatch_errors (); #if 0 /* This is a function useful for recording debugging information about the sequence of occurrences in this file. */ struct record { char *locus; int type; }; struct record event_record[100]; int event_record_index; record_event (locus, type) char *locus; int type; { if (event_record_index == sizeof (event_record) / sizeof (struct record)) event_record_index = 0; event_record[event_record_index].locus = locus; event_record[event_record_index].type = type; event_record_index++; } #endif /* 0 */ /* Return the struct x_display_info corresponding to DPY. */ struct x_display_info * x_display_info_for_display (dpy) Display *dpy; { struct x_display_info *dpyinfo; for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) if (dpyinfo->display == dpy) return dpyinfo; return 0; } /* Starting and ending updates. These hooks are called by update_frame at the beginning and end of a frame update. We record in `updating_frame' the identity of the frame being updated, so that the XT... functions do not need to take a frame as argument. Most of the XT... functions should never be called except during an update, the only exceptions being XTcursor_to, XTwrite_glyphs and XTreassert_line_highlight. */ static XTupdate_begin (f) struct frame *f; { int mask; if (f == 0) abort (); flexlines = f->height; highlight = 0; BLOCK_INPUT; if (f == FRAME_X_DISPLAY_INFO (f)->mouse_face_mouse_frame) { /* Don't do highlighting for mouse motion during the update. */ FRAME_X_DISPLAY_INFO (f)->mouse_face_defer = 1; /* If the frame needs to be redrawn, simply forget about any prior mouse highlighting. */ if (FRAME_GARBAGED_P (f)) FRAME_X_DISPLAY_INFO (f)->mouse_face_window = Qnil; if (!NILP (FRAME_X_DISPLAY_INFO (f)->mouse_face_window)) { int firstline, lastline, i; struct window *w = XWINDOW (FRAME_X_DISPLAY_INFO (f)->mouse_face_window); /* Find the first, and the last+1, lines affected by redisplay. */ for (firstline = 0; firstline < f->height; firstline++) if (FRAME_DESIRED_GLYPHS (f)->enable[firstline]) break; lastline = f->height; for (i = f->height - 1; i >= 0; i--) { if (FRAME_DESIRED_GLYPHS (f)->enable[i]) break; else lastline = i; } /* Can we tell that this update does not affect the window where the mouse highlight is? If so, no need to turn off. Likewise, don't do anything if the frame is garbaged; in that case, the FRAME_CURRENT_GLYPHS that we would use are all wrong, and we will redisplay that line anyway. */ if (! (firstline > (XFASTINT (w->top) + window_internal_height (w)) || lastline < XFASTINT (w->top))) clear_mouse_face (FRAME_X_DISPLAY_INFO (f)); } } UNBLOCK_INPUT; } static XTupdate_end (f) struct frame *f; { int mask; BLOCK_INPUT; do_line_dance (); x_display_cursor (f, 1); if (f == FRAME_X_DISPLAY_INFO (f)->mouse_face_mouse_frame) FRAME_X_DISPLAY_INFO (f)->mouse_face_defer = 0; #if 0 /* This fails in the case of having updated only the echo area if we have switched buffers. In that case, FRAME_CURRENT_GLYPHS has no relation to the current contents, and its charstarts have no relation to the contents of the window-buffer. I don't know a clean way to check for that case. window_end_valid isn't set up yet. */ if (f == FRAME_X_DISPLAY_INFO (f)->mouse_face_mouse_frame) note_mouse_highlight (f, FRAME_X_DISPLAY_INFO (f)->mouse_face_mouse_x, FRAME_X_DISPLAY_INFO (f)->mouse_face_mouse_y); #endif XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; } /* This is called after a redisplay on frame F. */ static XTframe_up_to_date (f) FRAME_PTR f; { BLOCK_INPUT; if (FRAME_X_DISPLAY_INFO (f)->mouse_face_deferred_gc || f == FRAME_X_DISPLAY_INFO (f)->mouse_face_mouse_frame) { note_mouse_highlight (FRAME_X_DISPLAY_INFO (f)->mouse_face_mouse_frame, FRAME_X_DISPLAY_INFO (f)->mouse_face_mouse_x, FRAME_X_DISPLAY_INFO (f)->mouse_face_mouse_y); FRAME_X_DISPLAY_INFO (f)->mouse_face_deferred_gc = 0; } UNBLOCK_INPUT; } /* External interface to control of standout mode. Call this when about to modify line at position VPOS and not change whether it is highlighted. */ XTreassert_line_highlight (new, vpos) int new, vpos; { highlight = new; } /* Call this when about to modify line at position VPOS and change whether it is highlighted. */ static XTchange_line_highlight (new_highlight, vpos, first_unused_hpos) int new_highlight, vpos, first_unused_hpos; { highlight = new_highlight; XTcursor_to (vpos, 0); XTclear_end_of_line (updating_frame->width); } /* This is used when starting Emacs and when restarting after suspend. When starting Emacs, no X window is mapped. And nothing must be done to Emacs's own window if it is suspended (though that rarely happens). */ static XTset_terminal_modes () { } /* This is called when exiting or suspending Emacs. Exiting will make the X-windows go away, and suspending requires no action. */ static XTreset_terminal_modes () { /* XTclear_frame (); */ } /* Set the nominal cursor position of the frame. This is where display update commands will take effect. This does not affect the place where the cursor-box is displayed. */ static int XTcursor_to (row, col) register int row, col; { int mask; int orow = row; curs_x = col; curs_y = row; if (updating_frame == 0) { BLOCK_INPUT; x_display_cursor (selected_frame, 1); XFlush (FRAME_X_DISPLAY (selected_frame)); UNBLOCK_INPUT; } } /* Display a sequence of N glyphs found at GP. WINDOW is the x-window to output to. LEFT and TOP are starting coords. HL is 1 if this text is highlighted, 2 if the cursor is on it, 3 if should appear in its mouse-face. JUST_FOREGROUND if 1 means draw only the foreground; don't alter the background. FONT is the default font to use (for glyphs whose font-code is 0). Since the display generation code is responsible for calling compute_char_face and compute_glyph_face on everything it puts in the display structure, we can assume that the face code on each glyph is a valid index into FRAME_COMPUTED_FACES (f), and the one to which we can actually apply intern_face. Call this function with input blocked. */ #if 1 /* This is the multi-face code. */ static void dumpglyphs (f, left, top, gp, n, hl, just_foreground) struct frame *f; int left, top; register GLYPH *gp; /* Points to first GLYPH. */ register int n; /* Number of glyphs to display. */ int hl; int just_foreground; { /* Holds characters to be displayed. */ char *buf = (char *) alloca (f->width * sizeof (*buf)); register char *cp; /* Steps through buf[]. */ register int tlen = GLYPH_TABLE_LENGTH; register Lisp_Object *tbase = GLYPH_TABLE_BASE; Window window = FRAME_X_WINDOW (f); int orig_left = left; while (n > 0) { /* Get the face-code of the next GLYPH. */ int cf, len; int g = *gp; GLYPH_FOLLOW_ALIASES (tbase, tlen, g); cf = FAST_GLYPH_FACE (g); /* Find the run of consecutive glyphs with the same face-code. Extract their character codes into BUF. */ cp = buf; while (n > 0) { g = *gp; GLYPH_FOLLOW_ALIASES (tbase, tlen, g); if (FAST_GLYPH_FACE (g) != cf) break; *cp++ = FAST_GLYPH_CHAR (g); --n; ++gp; } /* LEN gets the length of the run. */ len = cp - buf; /* Now output this run of chars, with the font and pixel values determined by the face code CF. */ { struct face *face = FRAME_DEFAULT_FACE (f); XFontStruct *font = FACE_FONT (face); GC gc = FACE_GC (face); int stippled = 0; /* HL = 3 means use a mouse face previously chosen. */ if (hl == 3) cf = FRAME_X_DISPLAY_INFO (f)->mouse_face_face_id; /* First look at the face of the text itself. */ if (cf != 0) { /* It's possible for the display table to specify a face code that is out of range. Use 0 in that case. */ if (cf < 0 || cf >= FRAME_N_COMPUTED_FACES (f) || FRAME_COMPUTED_FACES (f) [cf] == 0) cf = 0; if (cf == 1) face = FRAME_MODE_LINE_FACE (f); else face = intern_face (f, FRAME_COMPUTED_FACES (f) [cf]); font = FACE_FONT (face); gc = FACE_GC (face); if (FACE_STIPPLE (face)) stippled = 1; } /* Then comes the distinction between modeline and normal text. */ else if (hl == 0) ; else if (hl == 1) { face = FRAME_MODE_LINE_FACE (f); font = FACE_FONT (face); gc = FACE_GC (face); if (FACE_STIPPLE (face)) stippled = 1; } #define FACE_DEFAULT (~0) /* Now override that if the cursor's on this character. */ if (hl == 2) { /* The cursor overrides stippling. */ stippled = 0; if ((!face->font || face->font == (XFontStruct *) FACE_DEFAULT || face->font == f->output_data.x->font) && face->background == f->output_data.x->background_pixel && face->foreground == f->output_data.x->foreground_pixel) { gc = f->output_data.x->cursor_gc; } /* Cursor on non-default face: must merge. */ else { XGCValues xgcv; unsigned long mask; xgcv.background = f->output_data.x->cursor_pixel; xgcv.foreground = face->background; /* If the glyph would be invisible, try a different foreground. */ if (xgcv.foreground == xgcv.background) xgcv.foreground = face->foreground; if (xgcv.foreground == xgcv.background) xgcv.foreground = f->output_data.x->cursor_foreground_pixel; if (xgcv.foreground == xgcv.background) xgcv.foreground = face->foreground; /* Make sure the cursor is distinct from text in this face. */ if (xgcv.background == face->background && xgcv.foreground == face->foreground) { xgcv.background = face->foreground; xgcv.foreground = face->background; } xgcv.font = face->font->fid; xgcv.graphics_exposures = 0; mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures; if (FRAME_X_DISPLAY_INFO (f)->scratch_cursor_gc) XChangeGC (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->scratch_cursor_gc, mask, &xgcv); else FRAME_X_DISPLAY_INFO (f)->scratch_cursor_gc = XCreateGC (FRAME_X_DISPLAY (f), window, mask, &xgcv); gc = FRAME_X_DISPLAY_INFO (f)->scratch_cursor_gc; #if 0 /* If this code is restored, it must also reset to the default stipple if necessary. */ if (face->stipple && face->stipple != FACE_DEFAULT) XSetStipple (FRAME_X_DISPLAY (f), gc, face->stipple); #endif } } if (font == (XFontStruct *) FACE_DEFAULT) font = f->output_data.x->font; if (just_foreground) XDrawString (FRAME_X_DISPLAY (f), window, gc, left, top + FONT_BASE (font), buf, len); else { if (stippled) { /* Turn stipple on. */ XSetFillStyle (FRAME_X_DISPLAY (f), gc, FillOpaqueStippled); /* Draw stipple on background. */ XFillRectangle (FRAME_X_DISPLAY (f), window, gc, left, top, FONT_WIDTH (font) * len, FONT_HEIGHT (font)); /* Turn stipple off. */ XSetFillStyle (FRAME_X_DISPLAY (f), gc, FillSolid); /* Draw the text, solidly, onto the stipple pattern. */ XDrawString (FRAME_X_DISPLAY (f), window, gc, left, top + FONT_BASE (font), buf, len); } else XDrawImageString (FRAME_X_DISPLAY (f), window, gc, left, top + FONT_BASE (font), buf, len); /* Clear the rest of the line's height. */ if (f->output_data.x->line_height != FONT_HEIGHT (font)) XClearArea (FRAME_X_DISPLAY (f), window, left, top + FONT_HEIGHT (font), FONT_WIDTH (font) * len, /* This is how many pixels of height we have to clear. */ f->output_data.x->line_height - FONT_HEIGHT (font), False); } #if 0 /* Doesn't work, because it uses FRAME_CURRENT_GLYPHS, which often is not up to date yet. */ if (!just_foreground) { if (left == orig_left) redraw_previous_char (f, PIXEL_TO_CHAR_COL (f, left), PIXEL_TO_CHAR_ROW (f, top), hl == 1); if (n == 0) redraw_following_char (f, PIXEL_TO_CHAR_COL (f, left + len * FONT_WIDTH (font)), PIXEL_TO_CHAR_ROW (f, top), hl == 1); } #endif /* We should probably check for XA_UNDERLINE_POSITION and XA_UNDERLINE_THICKNESS properties on the font, but let's just get the thing working, and come back to that. */ { int underline_position = 1; if (font->descent <= underline_position) underline_position = font->descent - 1; if (face->underline) XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), FACE_GC (face), left, (top + FONT_BASE (font) + underline_position), len * FONT_WIDTH (font), 1); } left += len * FONT_WIDTH (font); } } } #endif /* 1 */ #if 0 /* This is the old single-face code. */ static void dumpglyphs (f, left, top, gp, n, hl, font) struct frame *f; int left, top; register GLYPH *gp; /* Points to first GLYPH. */ register int n; /* Number of glyphs to display. */ int hl; XFontStruct *font; { register int len; Window window = FRAME_X_WINDOW (f); GC drawing_gc = (hl == 2 ? f->output_data.x->cursor_gc : (hl ? f->output_data.x->reverse_gc : f->output_data.x->normal_gc)); if (sizeof (GLYPH) == sizeof (XChar2b)) XDrawImageString16 (FRAME_X_DISPLAY (f), window, drawing_gc, left, top + FONT_BASE (font), (XChar2b *) gp, n); else if (sizeof (GLYPH) == sizeof (unsigned char)) XDrawImageString (FRAME_X_DISPLAY (f), window, drawing_gc, left, top + FONT_BASE (font), (char *) gp, n); else /* What size of glyph ARE you using? And does X have a function to draw them? */ abort (); } #endif /* Output some text at the nominal frame cursor position. Advance the cursor over the text. Output LEN glyphs at START. `highlight', set up by XTreassert_line_highlight or XTchange_line_highlight, controls the pixel values used for foreground and background. */ static XTwrite_glyphs (start, len) register GLYPH *start; int len; { register int temp_length; int mask; struct frame *f; BLOCK_INPUT; do_line_dance (); f = updating_frame; if (f == 0) { f = selected_frame; /* If not within an update, output at the frame's visible cursor. */ curs_x = f->cursor_x; curs_y = f->cursor_y; } dumpglyphs (f, CHAR_TO_PIXEL_COL (f, curs_x), CHAR_TO_PIXEL_ROW (f, curs_y), start, len, highlight, 0); /* If we drew on top of the cursor, note that it is turned off. */ if (curs_y == f->phys_cursor_y && curs_x <= f->phys_cursor_x && curs_x + len > f->phys_cursor_x) f->phys_cursor_x = -1; if (updating_frame == 0) { f->cursor_x += len; x_display_cursor (f, 1); f->cursor_x -= len; } else curs_x += len; UNBLOCK_INPUT; } /* Clear to the end of the line. Erase the current text line from the nominal cursor position (inclusive) to column FIRST_UNUSED (exclusive). The idea is that everything from FIRST_UNUSED onward is already erased. */ static XTclear_end_of_line (first_unused) register int first_unused; { struct frame *f = updating_frame; int mask; if (f == 0) abort (); if (curs_y < 0 || curs_y >= f->height) return; if (first_unused <= 0) return; if (first_unused >= f->width) first_unused = f->width; BLOCK_INPUT; do_line_dance (); /* Notice if the cursor will be cleared by this operation. */ if (curs_y == f->phys_cursor_y && curs_x <= f->phys_cursor_x && f->phys_cursor_x < first_unused) f->phys_cursor_x = -1; XClearArea (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), CHAR_TO_PIXEL_COL (f, curs_x), CHAR_TO_PIXEL_ROW (f, curs_y), FONT_WIDTH (f->output_data.x->font) * (first_unused - curs_x), f->output_data.x->line_height, False); #if 0 redraw_previous_char (f, curs_x, curs_y, highlight); #endif UNBLOCK_INPUT; } static XTclear_frame () { int mask; struct frame *f = updating_frame; if (f == 0) f = selected_frame; f->phys_cursor_x = -1; /* Cursor not visible. */ curs_x = 0; /* Nominal cursor position is top left. */ curs_y = 0; BLOCK_INPUT; XClearWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); /* We have to clear the scroll bars, too. If we have changed colors or something like that, then they should be notified. */ x_scroll_bar_clear (f); XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; } #if 0 /* This currently does not work because FRAME_CURRENT_GLYPHS doesn't always contain the right glyphs to use. It also needs to be changed to look at the details of the font and see whether there is really overlap, and do nothing when there is not. This can use font_char_overlap_left and font_char_overlap_right, but just how to use them is not clear. */ /* Erase the character (if any) at the position just before X, Y in frame F, then redraw it and the character before it. This is necessary when we erase starting at X, in case the character after X overlaps into the one before X. Call this function with input blocked. */ static void redraw_previous_char (f, x, y, highlight_flag) FRAME_PTR f; int x, y; int highlight_flag; { /* Erase the character before the new ones, in case what was here before overlaps it. Reoutput that character, and the previous character (in case the previous character overlaps it). */ if (x > 0) { int start_x = x - 2; if (start_x < 0) start_x = 0; XClearArea (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), CHAR_TO_PIXEL_COL (f, x - 1), CHAR_TO_PIXEL_ROW (f, y), FONT_WIDTH (f->output_data.x->font), f->output_data.x->line_height, False); dumpglyphs (f, CHAR_TO_PIXEL_COL (f, start_x), CHAR_TO_PIXEL_ROW (f, y), &FRAME_CURRENT_GLYPHS (f)->glyphs[y][start_x], x - start_x, highlight_flag, 1); } } /* Erase the character (if any) at the position X, Y in frame F, then redraw it and the character after it. This is necessary when we erase endng at X, in case the character after X overlaps into the one before X. Call this function with input blocked. */ static void redraw_following_char (f, x, y, highlight_flag) FRAME_PTR f; int x, y; int highlight_flag; { int limit = FRAME_CURRENT_GLYPHS (f)->used[y]; /* Erase the character after the new ones, in case what was here before overlaps it. Reoutput that character, and the following character (in case the following character overlaps it). */ if (x < limit && FRAME_CURRENT_GLYPHS (f)->glyphs[y][x] != SPACEGLYPH) { int end_x = x + 2; if (end_x > limit) end_x = limit; XClearArea (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), CHAR_TO_PIXEL_COL (f, x), CHAR_TO_PIXEL_ROW (f, y), FONT_WIDTH (f->output_data.x->font), f->output_data.x->line_height, False); dumpglyphs (f, CHAR_TO_PIXEL_COL (f, x), CHAR_TO_PIXEL_ROW (f, y), &FRAME_CURRENT_GLYPHS (f)->glyphs[y][x], end_x - x, highlight_flag, 1); } } #endif /* 0 */ #if 0 /* Not in use yet */ /* Return 1 if character C in font F extends past its left edge. */ static int font_char_overlap_left (font, c) XFontStruct *font; int c; { XCharStruct *s; /* Find the bounding-box info for C. */ if (font->per_char == 0) s = &font->max_bounds; else { int rowlen = font->max_char_or_byte2 - font->min_char_or_byte2 + 1; int row, within; /* Decode char into row number (byte 1) and code within row (byte 2). */ row = c >> 8; within = c & 0177; if (!(within >= font->min_char_or_byte2 && within <= font->max_char_or_byte2 && row >= font->min_byte1 && row <= font->max_byte1)) { /* If char is out of range, try the font's default char instead. */ c = font->default_char; row = c >> (BITS_PER_INT - 8); within = c & 0177; } if (!(within >= font->min_char_or_byte2 && within <= font->max_char_or_byte2 && row >= font->min_byte1 && row <= font->max_byte1)) /* Still out of range means this char does not overlap. */ return 0; else /* We found the info for this char. */ s = (font->per_char + (within - font->min_char_or_byte2) + row * rowlen); } return (s && s->lbearing < 0); } /* Return 1 if character C in font F extends past its right edge. */ static int font_char_overlap_right (font, c) XFontStruct *font; int c; { XCharStruct *s; /* Find the bounding-box info for C. */ if (font->per_char == 0) s = &font->max_bounds; else { int rowlen = font->max_char_or_byte2 - font->min_char_or_byte2 + 1; int row, within; /* Decode char into row number (byte 1) and code within row (byte 2). */ row = c >> 8; within = c & 0177; if (!(within >= font->min_char_or_byte2 && within <= font->max_char_or_byte2 && row >= font->min_byte1 && row <= font->max_byte1)) { /* If char is out of range, try the font's default char instead. */ c = font->default_char; row = c >> (BITS_PER_INT - 8); within = c & 0177; } if (!(within >= font->min_char_or_byte2 && within <= font->max_char_or_byte2 && row >= font->min_byte1 && row <= font->max_byte1)) /* Still out of range means this char does not overlap. */ return 0; else /* We found the info for this char. */ s = (font->per_char + (within - font->min_char_or_byte2) + row * rowlen); } return (s && s->rbearing >= s->width); } #endif /* 0 */ /* Invert the middle quarter of the frame for .15 sec. */ /* We use the select system call to do the waiting, so we have to make sure it's available. If it isn't, we just won't do visual bells. */ #if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT) /* Subtract the `struct timeval' values X and Y, storing the result in RESULT. Return 1 if the difference is negative, otherwise 0. */ static int timeval_subtract (result, x, y) struct timeval *result, x, y; { /* Perform the carry for the later subtraction by updating y. This is safer because on some systems the tv_sec member is unsigned. */ if (x.tv_usec < y.tv_usec) { int nsec = (y.tv_usec - x.tv_usec) / 1000000 + 1; y.tv_usec -= 1000000 * nsec; y.tv_sec += nsec; } if (x.tv_usec - y.tv_usec > 1000000) { int nsec = (y.tv_usec - x.tv_usec) / 1000000; y.tv_usec += 1000000 * nsec; y.tv_sec -= nsec; } /* Compute the time remaining to wait. tv_usec is certainly positive. */ result->tv_sec = x.tv_sec - y.tv_sec; result->tv_usec = x.tv_usec - y.tv_usec; /* Return indication of whether the result should be considered negative. */ return x.tv_sec < y.tv_sec; } XTflash (f) struct frame *f; { BLOCK_INPUT; { GC gc; /* Create a GC that will use the GXxor function to flip foreground pixels into background pixels. */ { XGCValues values; values.function = GXxor; values.foreground = (f->output_data.x->foreground_pixel ^ f->output_data.x->background_pixel); gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), GCFunction | GCForeground, &values); } { int width = PIXEL_WIDTH (f); int height = PIXEL_HEIGHT (f); XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, width/4, height/4, width/2, height/2); XFlush (FRAME_X_DISPLAY (f)); { struct timeval wakeup, now; EMACS_GET_TIME (wakeup); /* Compute time to wait until, propagating carry from usecs. */ wakeup.tv_usec += 150000; wakeup.tv_sec += (wakeup.tv_usec / 1000000); wakeup.tv_usec %= 1000000; /* Keep waiting until past the time wakeup. */ while (1) { struct timeval timeout; EMACS_GET_TIME (timeout); /* In effect, timeout = wakeup - timeout. Break if result would be negative. */ if (timeval_subtract (&timeout, wakeup, timeout)) break; /* Try to wait that long--but we might wake up sooner. */ select (0, NULL, NULL, NULL, &timeout); } } XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, width/4, height/4, width/2, height/2); XFreeGC (FRAME_X_DISPLAY (f), gc); XFlush (FRAME_X_DISPLAY (f)); } } UNBLOCK_INPUT; } #endif /* Make audible bell. */ #define XRINGBELL XBell (FRAME_X_DISPLAY (selected_frame), 0) XTring_bell () { if (FRAME_X_DISPLAY (selected_frame) == 0) return; #if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT) if (visible_bell) XTflash (selected_frame); else #endif { BLOCK_INPUT; XRINGBELL; XFlush (FRAME_X_DISPLAY (selected_frame)); UNBLOCK_INPUT; } } /* Insert and delete character. These are not supposed to be used because we are supposed to turn off the feature of using them. */ static XTinsert_glyphs (start, len) register char *start; register int len; { abort (); } static XTdelete_glyphs (n) register int n; { abort (); } /* Specify how many text lines, from the top of the window, should be affected by insert-lines and delete-lines operations. This, and those operations, are used only within an update that is bounded by calls to XTupdate_begin and XTupdate_end. */ static XTset_terminal_window (n) register int n; { if (updating_frame == 0) abort (); if ((n <= 0) || (n > updating_frame->height)) flexlines = updating_frame->height; else flexlines = n; } /* These variables need not be per frame because redisplay is done on a frame-by-frame basis and the line dance for one frame is finished before anything is done for anoter frame. */ /* Array of line numbers from cached insert/delete operations. line_dance[i] is the old position of the line that we want to move to line i, or -1 if we want a blank line there. */ static int *line_dance; /* Allocated length of that array. */ static int line_dance_len; /* Flag indicating whether we've done any work. */ static int line_dance_in_progress; /* Perform an insert-lines or delete-lines operation, inserting N lines or deleting -N lines at vertical position VPOS. */ XTins_del_lines (vpos, n) int vpos, n; { register int fence, i; if (vpos >= flexlines) return; if (!line_dance_in_progress) { int ht = updating_frame->height; if (ht > line_dance_len) { line_dance = (int *)xrealloc (line_dance, ht * sizeof (int)); line_dance_len = ht; } for (i = 0; i < ht; ++i) line_dance[i] = i; line_dance_in_progress = 1; } if (n >= 0) { if (n > flexlines - vpos) n = flexlines - vpos; fence = vpos + n; for (i = flexlines; --i >= fence;) line_dance[i] = line_dance[i-n]; for (i = fence; --i >= vpos;) line_dance[i] = -1; } else { n = -n; if (n > flexlines - vpos) n = flexlines - vpos; fence = flexlines - n; for (i = vpos; i < fence; ++i) line_dance[i] = line_dance[i + n]; for (i = fence; i < flexlines; ++i) line_dance[i] = -1; } } /* Here's where we actually move the pixels around. Must be called with input blocked. */ static void do_line_dance () { register int i, j, distance; register struct frame *f; int ht; int intborder; /* Must check this flag first. If it's not set, then not only is the array uninitialized, but we might not even have a frame. */ if (!line_dance_in_progress) return; f = updating_frame; if (f == 0) abort (); ht = f->height; intborder = f->output_data.x->internal_border_width; x_display_cursor (updating_frame, 0); for (i = 0; i < ht; ++i) if (line_dance[i] != -1 && (distance = line_dance[i]-i) > 0) { for (j = i; (j < ht && line_dance[j] != -1 && line_dance[j]-j == distance); ++j); /* Copy [i,j) upward from [i+distance,j+distance) */ XCopyArea (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), FRAME_X_WINDOW (f), f->output_data.x->normal_gc, intborder, CHAR_TO_PIXEL_ROW (f, i+distance), f->width * FONT_WIDTH (f->output_data.x->font), (j-i) * f->output_data.x->line_height, intborder, CHAR_TO_PIXEL_ROW (f, i)); i = j-1; } for (i = ht; --i >=0; ) if (line_dance[i] != -1 && (distance = line_dance[i]-i) < 0) { for (j = i; (--j >= 0 && line_dance[j] != -1 && line_dance[j]-j == distance);); /* Copy (j,i] downward from (j+distance, i+distance] */ XCopyArea (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), FRAME_X_WINDOW (f), f->output_data.x->normal_gc, intborder, CHAR_TO_PIXEL_ROW (f, j+1+distance), f->width * FONT_WIDTH (f->output_data.x->font), (i-j) * f->output_data.x->line_height, intborder, CHAR_TO_PIXEL_ROW (f, j+1)); i = j+1; } for (i = 0; i < ht; ++i) if (line_dance[i] == -1) { for (j = i; j < ht && line_dance[j] == -1; ++j); /* Clear [i,j) */ XClearArea (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), intborder, CHAR_TO_PIXEL_ROW (f, i), f->width * FONT_WIDTH (f->output_data.x->font), (j-i) * f->output_data.x->line_height, False); i = j-1; } line_dance_in_progress = 0; } /* Support routines for exposure events. */ static void clear_cursor (); /* Output into a rectangle of an X-window (for frame F) the characters in f->phys_lines that overlap that rectangle. TOP and LEFT are the position of the upper left corner of the rectangle. ROWS and COLS are the size of the rectangle. Call this function with input blocked. */ static void dumprectangle (f, left, top, cols, rows) struct frame *f; register int left, top, cols, rows; { register struct frame_glyphs *active_frame = FRAME_CURRENT_GLYPHS (f); int cursor_cleared = 0; int bottom, right; register int y; if (FRAME_GARBAGED_P (f)) return; /* Express rectangle as four edges, instead of position-and-size. */ bottom = top + rows; right = left + cols; /* Convert rectangle edges in pixels to edges in chars. Round down for left and top, up for right and bottom. */ top = PIXEL_TO_CHAR_ROW (f, top); left = PIXEL_TO_CHAR_COL (f, left); bottom += (f->output_data.x->line_height - 1); right += (FONT_WIDTH (f->output_data.x->font) - 1); bottom = PIXEL_TO_CHAR_ROW (f, bottom); right = PIXEL_TO_CHAR_COL (f, right); /* Clip the rectangle to what can be visible. */ if (left < 0) left = 0; if (top < 0) top = 0; if (right > f->width) right = f->width; if (bottom > f->height) bottom = f->height; /* Get size in chars of the rectangle. */ cols = right - left; rows = bottom - top; /* If rectangle has zero area, return. */ if (rows <= 0) return; if (cols <= 0) return; /* Turn off the cursor if it is in the rectangle. We will turn it back on afterward. */ if ((f->phys_cursor_x >= left) && (f->phys_cursor_x < right) && (f->phys_cursor_y >= top) && (f->phys_cursor_y < bottom)) { clear_cursor (f); cursor_cleared = 1; } /* Display the text in the rectangle, one text line at a time. */ for (y = top; y < bottom; y++) { GLYPH *line = &active_frame->glyphs[y][left]; if (! active_frame->enable[y] || left > active_frame->used[y]) continue; dumpglyphs (f, CHAR_TO_PIXEL_COL (f, left), CHAR_TO_PIXEL_ROW (f, y), line, min (cols, active_frame->used[y] - left), active_frame->highlight[y], 0); } /* Turn the cursor on if we turned it off. */ if (cursor_cleared) x_display_cursor (f, 1); } static void frame_highlight (f) struct frame *f; { /* We used to only do this if Vx_no_window_manager was non-nil, but the ICCCM (section 4.1.6) says that the window's border pixmap and border pixel are window attributes which are "private to the client", so we can always change it to whatever we want. */ BLOCK_INPUT; XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->border_pixel); UNBLOCK_INPUT; x_update_cursor (f, 1); } static void frame_unhighlight (f) struct frame *f; { /* We used to only do this if Vx_no_window_manager was non-nil, but the ICCCM (section 4.1.6) says that the window's border pixmap and border pixel are window attributes which are "private to the client", so we can always change it to whatever we want. */ BLOCK_INPUT; XSetWindowBorderPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->border_tile); UNBLOCK_INPUT; x_update_cursor (f, 1); } static void XTframe_rehighlight (); static void x_frame_rehighlight (); /* The focus has changed. Update the frames as necessary to reflect the new situation. Note that we can't change the selected frame here, because the Lisp code we are interrupting might become confused. Each event gets marked with the frame in which it occurred, so the Lisp code can tell when the switch took place by examining the events. */ static void x_new_focus_frame (dpyinfo, frame) struct x_display_info *dpyinfo; struct frame *frame; { struct frame *old_focus = dpyinfo->x_focus_frame; int events_enqueued = 0; if (frame != dpyinfo->x_focus_frame) { /* Set this before calling other routines, so that they see the correct value of x_focus_frame. */ dpyinfo->x_focus_frame = frame; if (old_focus && old_focus->auto_lower) x_lower_frame (old_focus); #if 0 selected_frame = frame; XSETFRAME (XWINDOW (selected_frame->selected_window)->frame, selected_frame); Fselect_window (selected_frame->selected_window); choose_minibuf_frame (); #endif /* ! 0 */ if (dpyinfo->x_focus_frame && dpyinfo->x_focus_frame->auto_raise) pending_autoraise_frame = dpyinfo->x_focus_frame; else pending_autoraise_frame = 0; } x_frame_rehighlight (dpyinfo); } /* Handle an event saying the mouse has moved out of an Emacs frame. */ void x_mouse_leave (dpyinfo) struct x_display_info *dpyinfo; { x_new_focus_frame (dpyinfo, dpyinfo->x_focus_event_frame); } /* The focus has changed, or we have redirected a frame's focus to another frame (this happens when a frame uses a surrogate minibuffer frame). Shift the highlight as appropriate. The FRAME argument doesn't necessarily have anything to do with which frame is being highlighted or unhighlighted; we only use it to find the appropriate X display info. */ static void XTframe_rehighlight (frame) struct frame *frame; { x_frame_rehighlight (FRAME_X_DISPLAY_INFO (frame)); } static void x_frame_rehighlight (dpyinfo) struct x_display_info *dpyinfo; { struct frame *old_highlight = dpyinfo->x_highlight_frame; if (dpyinfo->x_focus_frame) { dpyinfo->x_highlight_frame = ((GC_FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame))) ? XFRAME (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame)) : dpyinfo->x_focus_frame); if (! FRAME_LIVE_P (dpyinfo->x_highlight_frame)) { FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame) = Qnil; dpyinfo->x_highlight_frame = dpyinfo->x_focus_frame; } } else dpyinfo->x_highlight_frame = 0; if (dpyinfo->x_highlight_frame != old_highlight) { if (old_highlight) frame_unhighlight (old_highlight); if (dpyinfo->x_highlight_frame) frame_highlight (dpyinfo->x_highlight_frame); } } /* Keyboard processing - modifier keys, vendor-specific keysyms, etc. */ /* Initialize mode_switch_bit and modifier_meaning. */ static void x_find_modifier_meanings (dpyinfo) struct x_display_info *dpyinfo; { int min_code, max_code; KeySym *syms; int syms_per_code; XModifierKeymap *mods; dpyinfo->meta_mod_mask = 0; dpyinfo->shift_lock_mask = 0; dpyinfo->alt_mod_mask = 0; dpyinfo->super_mod_mask = 0; dpyinfo->hyper_mod_mask = 0; #ifdef HAVE_X11R4 XDisplayKeycodes (dpyinfo->display, &min_code, &max_code); #else min_code = display->min_keycode; max_code = display->max_keycode; #endif syms = XGetKeyboardMapping (dpyinfo->display, min_code, max_code - min_code + 1, &syms_per_code); mods = XGetModifierMapping (dpyinfo->display); /* Scan the modifier table to see which modifier bits the Meta and Alt keysyms are on. */ { int row, col; /* The row and column in the modifier table. */ for (row = 3; row < 8; row++) for (col = 0; col < mods->max_keypermod; col++) { KeyCode code = mods->modifiermap[(row * mods->max_keypermod) + col]; /* Zeroes are used for filler. Skip them. */ if (code == 0) continue; /* Are any of this keycode's keysyms a meta key? */ { int code_col; for (code_col = 0; code_col < syms_per_code; code_col++) { int sym = syms[((code - min_code) * syms_per_code) + code_col]; switch (sym) { case XK_Meta_L: case XK_Meta_R: dpyinfo->meta_mod_mask |= (1 << row); break; case XK_Alt_L: case XK_Alt_R: dpyinfo->alt_mod_mask |= (1 << row); break; case XK_Hyper_L: case XK_Hyper_R: dpyinfo->hyper_mod_mask |= (1 << row); break; case XK_Super_L: case XK_Super_R: dpyinfo->super_mod_mask |= (1 << row); break; case XK_Shift_Lock: /* Ignore this if it's not on the lock modifier. */ if ((1 << row) == LockMask) dpyinfo->shift_lock_mask = LockMask; break; } } } } } /* If we couldn't find any meta keys, accept any alt keys as meta keys. */ if (! dpyinfo->meta_mod_mask) { dpyinfo->meta_mod_mask = dpyinfo->alt_mod_mask; dpyinfo->alt_mod_mask = 0; } /* If some keys are both alt and meta, make them just meta, not alt. */ if (dpyinfo->alt_mod_mask & dpyinfo->meta_mod_mask) { dpyinfo->alt_mod_mask &= ~dpyinfo->meta_mod_mask; } XFree ((char *) syms); XFreeModifiermap (mods); } /* Convert between the modifier bits X uses and the modifier bits Emacs uses. */ static unsigned int x_x_to_emacs_modifiers (dpyinfo, state) struct x_display_info *dpyinfo; unsigned int state; { return ( ((state & (ShiftMask | dpyinfo->shift_lock_mask)) ? shift_modifier : 0) | ((state & ControlMask) ? ctrl_modifier : 0) | ((state & dpyinfo->meta_mod_mask) ? meta_modifier : 0) | ((state & dpyinfo->alt_mod_mask) ? alt_modifier : 0) | ((state & dpyinfo->super_mod_mask) ? super_modifier : 0) | ((state & dpyinfo->hyper_mod_mask) ? hyper_modifier : 0)); } static unsigned int x_emacs_to_x_modifiers (dpyinfo, state) struct x_display_info *dpyinfo; unsigned int state; { return ( ((state & alt_modifier) ? dpyinfo->alt_mod_mask : 0) | ((state & super_modifier) ? dpyinfo->super_mod_mask : 0) | ((state & hyper_modifier) ? dpyinfo->hyper_mod_mask : 0) | ((state & shift_modifier) ? ShiftMask : 0) | ((state & ctrl_modifier) ? ControlMask : 0) | ((state & meta_modifier) ? dpyinfo->meta_mod_mask : 0)); } /* Convert a keysym to its name. */ char * x_get_keysym_name (keysym) KeySym keysym; { char *value; BLOCK_INPUT; value = XKeysymToString (keysym); UNBLOCK_INPUT; return value; } /* Mouse clicks and mouse movement. Rah. */ /* Given a pixel position (PIX_X, PIX_Y) on the frame F, return glyph co-ordinates in (*X, *Y). Set *BOUNDS to the rectangle that the glyph at X, Y occupies, if BOUNDS != 0. If NOCLIP is nonzero, do not force the value into range. */ void pixel_to_glyph_coords (f, pix_x, pix_y, x, y, bounds, noclip) FRAME_PTR f; register int pix_x, pix_y; register int *x, *y; XRectangle *bounds; int noclip; { /* Arrange for the division in PIXEL_TO_CHAR_COL etc. to round down even for negative values. */ if (pix_x < 0) pix_x -= FONT_WIDTH ((f)->output_data.x->font) - 1; if (pix_y < 0) pix_y -= (f)->output_data.x->line_height - 1; pix_x = PIXEL_TO_CHAR_COL (f, pix_x); pix_y = PIXEL_TO_CHAR_ROW (f, pix_y); if (bounds) { bounds->width = FONT_WIDTH (f->output_data.x->font); bounds->height = f->output_data.x->line_height; bounds->x = CHAR_TO_PIXEL_COL (f, pix_x); bounds->y = CHAR_TO_PIXEL_ROW (f, pix_y); } if (!noclip) { if (pix_x < 0) pix_x = 0; else if (pix_x > f->width) pix_x = f->width; if (pix_y < 0) pix_y = 0; else if (pix_y > f->height) pix_y = f->height; } *x = pix_x; *y = pix_y; } void glyph_to_pixel_coords (f, x, y, pix_x, pix_y) FRAME_PTR f; register int x, y; register int *pix_x, *pix_y; { *pix_x = CHAR_TO_PIXEL_COL (f, x); *pix_y = CHAR_TO_PIXEL_ROW (f, y); } /* Prepare a mouse-event in *RESULT for placement in the input queue. If the event is a button press, then note that we have grabbed the mouse. */ static Lisp_Object construct_mouse_click (result, event, f) struct input_event *result; XButtonEvent *event; struct frame *f; { /* Make the event type no_event; we'll change that when we decide otherwise. */ result->kind = mouse_click; result->code = event->button - Button1; result->timestamp = event->time; result->modifiers = (x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f), event->state) | (event->type == ButtonRelease ? up_modifier : down_modifier)); { int row, column; #if 0 pixel_to_glyph_coords (f, event->x, event->y, &column, &row, NULL, 0); XSETFASTINT (result->x, column); XSETFASTINT (result->y, row); #endif XSETINT (result->x, event->x); XSETINT (result->y, event->y); XSETFRAME (result->frame_or_window, f); } } /* Prepare a menu-event in *RESULT for placement in the input queue. */ static Lisp_Object construct_menu_click (result, event, f) struct input_event *result; XButtonEvent *event; struct frame *f; { /* Make the event type no_event; we'll change that when we decide otherwise. */ result->kind = mouse_click; XSETINT (result->code, event->button - Button1); result->timestamp = event->time; result->modifiers = (x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f), event->state) | (event->type == ButtonRelease ? up_modifier : down_modifier)); XSETINT (result->x, event->x); XSETINT (result->y, -1); XSETFRAME (result->frame_or_window, f); } /* Function to report a mouse movement to the mainstream Emacs code. The input handler calls this. We have received a mouse movement event, which is given in *event. If the mouse is over a different glyph than it was last time, tell the mainstream emacs code by setting mouse_moved. If not, ask for another motion event, so we can check again the next time it moves. */ static void note_mouse_movement (frame, event) FRAME_PTR frame; XMotionEvent *event; { last_mouse_movement_time = event->time; if (event->window != FRAME_X_WINDOW (frame)) { frame->mouse_moved = 1; last_mouse_scroll_bar = Qnil; note_mouse_highlight (frame, -1, -1); /* Ask for another mouse motion event. */ { int dummy; Window dummy_window; XQueryPointer (event->display, FRAME_X_WINDOW (frame), &dummy_window, &dummy_window, &dummy, &dummy, &dummy, &dummy, (unsigned int *) &dummy); } } /* Has the mouse moved off the glyph it was on at the last sighting? */ else if (event->x < last_mouse_glyph.x || event->x >= last_mouse_glyph.x + last_mouse_glyph.width || event->y < last_mouse_glyph.y || event->y >= last_mouse_glyph.y + last_mouse_glyph.height) { frame->mouse_moved = 1; last_mouse_scroll_bar = Qnil; note_mouse_highlight (frame, event->x, event->y); /* Ask for another mouse motion event. */ { int dummy; Window dummy_window; XQueryPointer (event->display, FRAME_X_WINDOW (frame), &dummy_window, &dummy_window, &dummy, &dummy, &dummy, &dummy, (unsigned int *) &dummy); } } else { /* It's on the same glyph. Call XQueryPointer so we'll get an event the next time the mouse moves and we can see if it's *still* on the same glyph. */ int dummy; Window dummy_window; XQueryPointer (event->display, FRAME_X_WINDOW (frame), &dummy_window, &dummy_window, &dummy, &dummy, &dummy, &dummy, (unsigned int *) &dummy); } } /* This is used for debugging, to turn off note_mouse_highlight. */ static int disable_mouse_highlight; /* Take proper action when the mouse has moved to position X, Y on frame F as regards highlighting characters that have mouse-face properties. Also dehighlighting chars where the mouse was before. X and Y can be negative or out of range. */ static void note_mouse_highlight (f, x, y) FRAME_PTR f; int x, y; { int row, column, portion; XRectangle new_glyph; Lisp_Object window; struct window *w; if (disable_mouse_highlight) return; FRAME_X_DISPLAY_INFO (f)->mouse_face_mouse_x = x; FRAME_X_DISPLAY_INFO (f)->mouse_face_mouse_y = y; FRAME_X_DISPLAY_INFO (f)->mouse_face_mouse_frame = f; if (FRAME_X_DISPLAY_INFO (f)->mouse_face_defer) return; if (gc_in_progress) { FRAME_X_DISPLAY_INFO (f)->mouse_face_deferred_gc = 1; return; } /* Find out which glyph the mouse is on. */ pixel_to_glyph_coords (f, x, y, &column, &row, &new_glyph, FRAME_X_DISPLAY_INFO (f)->grabbed); /* Which window is that in? */ window = window_from_coordinates (f, column, row, &portion); w = XWINDOW (window); /* If we were displaying active text in another window, clear that. */ if (! EQ (window, FRAME_X_DISPLAY_INFO (f)->mouse_face_window)) clear_mouse_face (FRAME_X_DISPLAY_INFO (f)); /* Are we in a window whose display is up to date? And verify the buffer's text has not changed. */ if (WINDOWP (window) && portion == 0 && row >= 0 && column >= 0 && row < FRAME_HEIGHT (f) && column < FRAME_WIDTH (f) && EQ (w->window_end_valid, w->buffer) && w->last_modified == BUF_MODIFF (XBUFFER (w->buffer))) { int *ptr = FRAME_CURRENT_GLYPHS (f)->charstarts[row]; int i, pos; /* Find which buffer position the mouse corresponds to. */ for (i = column; i >= 0; i--) if (ptr[i] > 0) break; pos = ptr[i]; /* Is it outside the displayed active region (if any)? */ if (pos <= 0) clear_mouse_face (FRAME_X_DISPLAY_INFO (f)); else if (! (EQ (window, FRAME_X_DISPLAY_INFO (f)->mouse_face_window) && row >= FRAME_X_DISPLAY_INFO (f)->mouse_face_beg_row && row <= FRAME_X_DISPLAY_INFO (f)->mouse_face_end_row && (row > FRAME_X_DISPLAY_INFO (f)->mouse_face_beg_row || column >= FRAME_X_DISPLAY_INFO (f)->mouse_face_beg_col) && (row < FRAME_X_DISPLAY_INFO (f)->mouse_face_end_row || column < FRAME_X_DISPLAY_INFO (f)->mouse_face_end_col || FRAME_X_DISPLAY_INFO (f)->mouse_face_past_end))) { Lisp_Object mouse_face, overlay, position; Lisp_Object *overlay_vec; int len, noverlays, ignor1; struct buffer *obuf; int obegv, ozv; /* If we get an out-of-range value, return now; avoid an error. */ if (pos > BUF_Z (XBUFFER (w->buffer))) return; /* Make the window's buffer temporarily current for overlays_at and compute_char_face. */ obuf = current_buffer; current_buffer = XBUFFER (w->buffer); obegv = BEGV; ozv = ZV; BEGV = BEG; ZV = Z; /* Yes. Clear the display of the old active region, if any. */ clear_mouse_face (FRAME_X_DISPLAY_INFO (f)); /* Is this char mouse-active? */ XSETINT (position, pos); len = 10; overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object)); /* Put all the overlays we want in a vector in overlay_vec. Store the length in len. */ noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, NULL, NULL); noverlays = sort_overlays (overlay_vec, noverlays, w); /* Find the highest priority overlay that has a mouse-face prop. */ overlay = Qnil; for (i = 0; i < noverlays; i++) { mouse_face = Foverlay_get (overlay_vec[i], Qmouse_face); if (!NILP (mouse_face)) { overlay = overlay_vec[i]; break; } } free (overlay_vec); /* If no overlay applies, get a text property. */ if (NILP (overlay)) mouse_face = Fget_text_property (position, Qmouse_face, w->buffer); /* Handle the overlay case. */ if (! NILP (overlay)) { /* Find the range of text around this char that should be active. */ Lisp_Object before, after; int ignore; before = Foverlay_start (overlay); after = Foverlay_end (overlay); /* Record this as the current active region. */ fast_find_position (window, before, &FRAME_X_DISPLAY_INFO (f)->mouse_face_beg_col, &FRAME_X_DISPLAY_INFO (f)->mouse_face_beg_row); FRAME_X_DISPLAY_INFO (f)->mouse_face_past_end = !fast_find_position (window, after, &FRAME_X_DISPLAY_INFO (f)->mouse_face_end_col, &FRAME_X_DISPLAY_INFO (f)->mouse_face_end_row); FRAME_X_DISPLAY_INFO (f)->mouse_face_window = window; FRAME_X_DISPLAY_INFO (f)->mouse_face_face_id = compute_char_face (f, w, pos, 0, 0, &ignore, pos + 1, 1); /* Display it as active. */ show_mouse_face (FRAME_X_DISPLAY_INFO (f), 1); } /* Handle the text property case. */ else if (! NILP (mouse_face)) { /* Find the range of text around this char that should be active. */ Lisp_Object before, after, beginning, end; int ignore; beginning = Fmarker_position (w->start); XSETINT (end, (BUF_Z (XBUFFER (w->buffer)) - XFASTINT (w->window_end_pos))); before = Fprevious_single_property_change (make_number (pos + 1), Qmouse_face, w->buffer, beginning); after = Fnext_single_property_change (position, Qmouse_face, w->buffer, end); /* Record this as the current active region. */ fast_find_position (window, before, &FRAME_X_DISPLAY_INFO (f)->mouse_face_beg_col, &FRAME_X_DISPLAY_INFO (f)->mouse_face_beg_row); FRAME_X_DISPLAY_INFO (f)->mouse_face_past_end = !fast_find_position (window, after, &FRAME_X_DISPLAY_INFO (f)->mouse_face_end_col, &FRAME_X_DISPLAY_INFO (f)->mouse_face_end_row); FRAME_X_DISPLAY_INFO (f)->mouse_face_window = window; FRAME_X_DISPLAY_INFO (f)->mouse_face_face_id = compute_char_face (f, w, pos, 0, 0, &ignore, pos + 1, 1); /* Display it as active. */ show_mouse_face (FRAME_X_DISPLAY_INFO (f), 1); } BEGV = obegv; ZV = ozv; current_buffer = obuf; } } } /* Find the row and column of position POS in window WINDOW. Store them in *COLUMNP and *ROWP. This assumes display in WINDOW is up to date. If POS is above start of WINDOW, return coords of start of first screen line. If POS is after end of WINDOW, return coords of end of last screen line. Value is 1 if POS is in range, 0 if it was off screen. */ static int fast_find_position (window, pos, columnp, rowp) Lisp_Object window; int pos; int *columnp, *rowp; { struct window *w = XWINDOW (window); FRAME_PTR f = XFRAME (WINDOW_FRAME (w)); int i; int row = 0; int left = w->left; int top = w->top; int height = XFASTINT (w->height) - ! MINI_WINDOW_P (w); int width = window_internal_width (w); int *charstarts; int lastcol; int maybe_next_line = 0; /* Find the right row. */ for (i = 0; i < height; i++) { int linestart = FRAME_CURRENT_GLYPHS (f)->charstarts[top + i][left]; if (linestart > pos) break; /* If the position sought is the end of the buffer, don't include the blank lines at the bottom of the window. */ if (linestart == pos && pos == BUF_ZV (XBUFFER (w->buffer))) { maybe_next_line = 1; break; } if (linestart > 0) row = i; } /* Find the right column with in it. */ charstarts = FRAME_CURRENT_GLYPHS (f)->charstarts[top + row]; lastcol = left; for (i = 0; i < width; i++) { if (charstarts[left + i] == pos) { *rowp = row + top; *columnp = i + left; return 1; } else if (charstarts[left + i] > pos) break; else if (charstarts[left + i] > 0) lastcol = left + i; } /* If we're looking for the end of the buffer, and we didn't find it in the line we scanned, use the start of the following line. */ if (maybe_next_line) { row++; i = 0; } *rowp = row + top; *columnp = lastcol; return 0; } /* Display the active region described by mouse_face_* in its mouse-face if HL > 0, in its normal face if HL = 0. */ static void show_mouse_face (dpyinfo, hl) struct x_display_info *dpyinfo; int hl; { struct window *w = XWINDOW (dpyinfo->mouse_face_window); int width = window_internal_width (w); FRAME_PTR f = XFRAME (WINDOW_FRAME (w)); int i; int cursor_off = 0; int old_curs_x = curs_x; int old_curs_y = curs_y; /* Set these variables temporarily so that if we have to turn the cursor off and on again we will put it back at the same place. */ curs_x = f->phys_cursor_x; curs_y = f->phys_cursor_y; for (i = FRAME_X_DISPLAY_INFO (f)->mouse_face_beg_row; i <= FRAME_X_DISPLAY_INFO (f)->mouse_face_end_row; i++) { int column = (i == FRAME_X_DISPLAY_INFO (f)->mouse_face_beg_row ? FRAME_X_DISPLAY_INFO (f)->mouse_face_beg_col : w->left); int endcolumn = (i == FRAME_X_DISPLAY_INFO (f)->mouse_face_end_row ? FRAME_X_DISPLAY_INFO (f)->mouse_face_end_col : w->left + width); endcolumn = min (endcolumn, FRAME_CURRENT_GLYPHS (f)->used[i]); /* If the cursor's in the text we are about to rewrite, turn the cursor off. */ if (i == curs_y && curs_x >= column - 1 && curs_x <= endcolumn) { x_display_cursor (f, 0); cursor_off = 1; } dumpglyphs (f, CHAR_TO_PIXEL_COL (f, column), CHAR_TO_PIXEL_ROW (f, i), FRAME_CURRENT_GLYPHS (f)->glyphs[i] + column, endcolumn - column, /* Highlight with mouse face if hl > 0. */ hl > 0 ? 3 : 0, 0); } /* If we turned the cursor off, turn it back on. */ if (cursor_off) x_display_cursor (f, 1); curs_x = old_curs_x; curs_y = old_curs_y; /* Change the mouse cursor according to the value of HL. */ if (hl > 0) XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->cross_cursor); else XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->text_cursor); } /* Clear out the mouse-highlighted active region. Redraw it unhighlighted first. */ static void clear_mouse_face (dpyinfo) struct x_display_info *dpyinfo; { if (! NILP (dpyinfo->mouse_face_window)) show_mouse_face (dpyinfo, 0); dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; dpyinfo->mouse_face_window = Qnil; } static struct scroll_bar *x_window_to_scroll_bar (); static void x_scroll_bar_report_motion (); /* Return the current position of the mouse. *fp should be a frame which indicates which display to ask about. If the mouse movement started in a scroll bar, set *fp, *bar_window, and *part to the frame, window, and scroll bar part that the mouse is over. Set *x and *y to the portion and whole of the mouse's position on the scroll bar. If the mouse movement started elsewhere, set *fp to the frame the mouse is on, *bar_window to nil, and *x and *y to the character cell the mouse is over. Set *time to the server timestamp for the time at which the mouse was at this position. Don't store anything if we don't have a valid set of values to report. This clears the mouse_moved flag, so we can wait for the next mouse movement. This also calls XQueryPointer, which will cause the server to give us another MotionNotify when the mouse moves again. */ static void XTmouse_position (fp, insist, bar_window, part, x, y, time) FRAME_PTR *fp; int insist; Lisp_Object *bar_window; enum scroll_bar_part *part; Lisp_Object *x, *y; unsigned long *time; { FRAME_PTR f1; BLOCK_INPUT; if (! NILP (last_mouse_scroll_bar)) x_scroll_bar_report_motion (fp, bar_window, part, x, y, time); else { Window root; int root_x, root_y; Window dummy_window; int dummy; Lisp_Object frame, tail; /* Clear the mouse-moved flag for every frame on this display. */ FOR_EACH_FRAME (tail, frame) if (FRAME_X_DISPLAY (XFRAME (frame)) == FRAME_X_DISPLAY (*fp)) XFRAME (frame)->mouse_moved = 0; last_mouse_scroll_bar = Qnil; /* Figure out which root window we're on. */ XQueryPointer (FRAME_X_DISPLAY (*fp), DefaultRootWindow (FRAME_X_DISPLAY (*fp)), /* The root window which contains the pointer. */ &root, /* Trash which we can't trust if the pointer is on a different screen. */ &dummy_window, /* The position on that root window. */ &root_x, &root_y, /* More trash we can't trust. */ &dummy, &dummy, /* Modifier keys and pointer buttons, about which we don't care. */ (unsigned int *) &dummy); /* Now we have a position on the root; find the innermost window containing the pointer. */ { Window win, child; int win_x, win_y; int parent_x, parent_y; win = root; /* XTranslateCoordinates can get errors if the window structure is changing at the same time this function is running. So at least we must not crash from them. */ x_catch_errors (FRAME_X_DISPLAY (*fp)); if (FRAME_X_DISPLAY_INFO (*fp)->grabbed && last_mouse_frame && FRAME_LIVE_P (last_mouse_frame)) { /* If mouse was grabbed on a frame, give coords for that frame even if the mouse is now outside it. */ XTranslateCoordinates (FRAME_X_DISPLAY (*fp), /* From-window, to-window. */ root, FRAME_X_WINDOW (last_mouse_frame), /* From-position, to-position. */ root_x, root_y, &win_x, &win_y, /* Child of win. */ &child); f1 = last_mouse_frame; } else { while (1) { XTranslateCoordinates (FRAME_X_DISPLAY (*fp), /* From-window, to-window. */ root, win, /* From-position, to-position. */ root_x, root_y, &win_x, &win_y, /* Child of win. */ &child); if (child == None || child == win) break; win = child; parent_x = win_x; parent_y = win_y; } /* Now we know that: win is the innermost window containing the pointer (XTC says it has no child containing the pointer), win_x and win_y are the pointer's position in it (XTC did this the last time through), and parent_x and parent_y are the pointer's position in win's parent. (They are what win_x and win_y were when win was child. If win is the root window, it has no parent, and parent_{x,y} are invalid, but that's okay, because we'll never use them in that case.) */ /* Is win one of our frames? */ f1 = x_any_window_to_frame (FRAME_X_DISPLAY_INFO (*fp), win); } if (x_had_errors_p (FRAME_X_DISPLAY (*fp))) f1 = 0; x_uncatch_errors (FRAME_X_DISPLAY (*fp)); /* If not, is it one of our scroll bars? */ if (! f1) { struct scroll_bar *bar = x_window_to_scroll_bar (win); if (bar) { f1 = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); win_x = parent_x; win_y = parent_y; } } if (f1 == 0 && insist) f1 = selected_frame; if (f1) { int ignore1, ignore2; /* Ok, we found a frame. Store all the values. */ pixel_to_glyph_coords (f1, win_x, win_y, &ignore1, &ignore2, &last_mouse_glyph, FRAME_X_DISPLAY_INFO (f1)->grabbed || insist); *bar_window = Qnil; *part = 0; *fp = f1; XSETINT (*x, win_x); XSETINT (*y, win_y); *time = last_mouse_movement_time; } } } UNBLOCK_INPUT; } /* Scroll bar support. */ /* Given an X window ID, find the struct scroll_bar which manages it. This can be called in GC, so we have to make sure to strip off mark bits. */ static struct scroll_bar * x_window_to_scroll_bar (window_id) Window window_id; { Lisp_Object tail, frame; for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) { Lisp_Object frame, bar, condemned; frame = XCONS (tail)->car; /* All elements of Vframe_list should be frames. */ if (! GC_FRAMEP (frame)) abort (); /* Scan this frame's scroll bar list for a scroll bar with the right window ID. */ condemned = FRAME_CONDEMNED_SCROLL_BARS (XFRAME (frame)); for (bar = FRAME_SCROLL_BARS (XFRAME (frame)); /* This trick allows us to search both the ordinary and condemned scroll bar lists with one loop. */ ! GC_NILP (bar) || (bar = condemned, condemned = Qnil, ! GC_NILP (bar)); bar = XSCROLL_BAR (bar)->next) if (SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)) == window_id) return XSCROLL_BAR (bar); } return 0; } /* Open a new X window to serve as a scroll bar, and return the scroll bar vector for it. */ static struct scroll_bar * x_scroll_bar_create (window, top, left, width, height) struct window *window; int top, left, width, height; { FRAME_PTR f = XFRAME (WINDOW_FRAME (window)); struct scroll_bar *bar = XSCROLL_BAR (Fmake_vector (make_number (SCROLL_BAR_VEC_SIZE), Qnil)); BLOCK_INPUT; { XSetWindowAttributes a; unsigned long mask; a.background_pixel = f->output_data.x->background_pixel; a.event_mask = (ButtonPressMask | ButtonReleaseMask | ButtonMotionMask | PointerMotionHintMask | ExposureMask); a.cursor = FRAME_X_DISPLAY_INFO (f)->vertical_scroll_bar_cursor; mask = (CWBackPixel | CWEventMask | CWCursor); #if 0 ac = 0; XtSetArg (al[ac], XtNx, left); ac++; XtSetArg (al[ac], XtNy, top); ac++; XtSetArg (al[ac], XtNwidth, width); ac++; XtSetArg (al[ac], XtNheight, height); ac++; XtSetArg (al[ac], XtNborderWidth, 0); ac++; sb_widget = XtCreateManagedWidget ("box", boxWidgetClass, f->output_data.x->edit_widget, al, ac); SET_SCROLL_BAR_X_WINDOW (bar, sb_widget->core.window); #endif SET_SCROLL_BAR_X_WINDOW (bar, XCreateWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), /* Position and size of scroll bar. */ left, top, width, height, /* Border width, depth, class, and visual. */ 0, CopyFromParent, CopyFromParent, CopyFromParent, /* Attributes. */ mask, &a)); } XSETWINDOW (bar->window, window); XSETINT (bar->top, top); XSETINT (bar->left, left); XSETINT (bar->width, width); XSETINT (bar->height, height); XSETINT (bar->start, 0); XSETINT (bar->end, 0); bar->dragging = Qnil; /* Add bar to its frame's list of scroll bars. */ bar->next = FRAME_SCROLL_BARS (f); bar->prev = Qnil; XSETVECTOR (FRAME_SCROLL_BARS (f), bar); if (! NILP (bar->next)) XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); XMapRaised (FRAME_X_DISPLAY (f), SCROLL_BAR_X_WINDOW (bar)); UNBLOCK_INPUT; return bar; } /* Draw BAR's handle in the proper position. If the handle is already drawn from START to END, don't bother redrawing it, unless REBUILD is non-zero; in that case, always redraw it. (REBUILD is handy for drawing the handle after expose events.) Normally, we want to constrain the start and end of the handle to fit inside its rectangle, but if the user is dragging the scroll bar handle, we want to let them drag it down all the way, so that the bar's top is as far down as it goes; otherwise, there's no way to move to the very end of the buffer. */ static void x_scroll_bar_set_handle (bar, start, end, rebuild) struct scroll_bar *bar; int start, end; int rebuild; { int dragging = ! NILP (bar->dragging); Window w = SCROLL_BAR_X_WINDOW (bar); FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); GC gc = f->output_data.x->normal_gc; /* If the display is already accurate, do nothing. */ if (! rebuild && start == XINT (bar->start) && end == XINT (bar->end)) return; BLOCK_INPUT; { int inside_width = VERTICAL_SCROLL_BAR_INSIDE_WIDTH (XINT (bar->width)); int inside_height = VERTICAL_SCROLL_BAR_INSIDE_HEIGHT (XINT (bar->height)); int top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (XINT (bar->height)); /* Make sure the values are reasonable, and try to preserve the distance between start and end. */ { int length = end - start; if (start < 0) start = 0; else if (start > top_range) start = top_range; end = start + length; if (end < start) end = start; else if (end > top_range && ! dragging) end = top_range; } /* Store the adjusted setting in the scroll bar. */ XSETINT (bar->start, start); XSETINT (bar->end, end); /* Clip the end position, just for display. */ if (end > top_range) end = top_range; /* Draw bottom positions VERTICAL_SCROLL_BAR_MIN_HANDLE pixels below top positions, to make sure the handle is always at least that many pixels tall. */ end += VERTICAL_SCROLL_BAR_MIN_HANDLE; /* Draw the empty space above the handle. Note that we can't clear zero-height areas; that means "clear to end of window." */ if (0 < start) XClearArea (FRAME_X_DISPLAY (f), w, /* x, y, width, height, and exposures. */ VERTICAL_SCROLL_BAR_LEFT_BORDER, VERTICAL_SCROLL_BAR_TOP_BORDER, inside_width, start, False); /* Draw the handle itself. */ XFillRectangle (FRAME_X_DISPLAY (f), w, gc, /* x, y, width, height */ VERTICAL_SCROLL_BAR_LEFT_BORDER, VERTICAL_SCROLL_BAR_TOP_BORDER + start, inside_width, end - start); /* Draw the empty space below the handle. Note that we can't clear zero-height areas; that means "clear to end of window." */ if (end < inside_height) XClearArea (FRAME_X_DISPLAY (f), w, /* x, y, width, height, and exposures. */ VERTICAL_SCROLL_BAR_LEFT_BORDER, VERTICAL_SCROLL_BAR_TOP_BORDER + end, inside_width, inside_height - end, False); } UNBLOCK_INPUT; } /* Move a scroll bar around on the screen, to accommodate changing window configurations. */ static void x_scroll_bar_move (bar, top, left, width, height) struct scroll_bar *bar; int top, left, width, height; { Window w = SCROLL_BAR_X_WINDOW (bar); FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); BLOCK_INPUT; { XWindowChanges wc; unsigned int mask = 0; wc.x = left; wc.y = top; wc.width = width; wc.height = height; if (left != XINT (bar->left)) mask |= CWX; if (top != XINT (bar->top)) mask |= CWY; if (width != XINT (bar->width)) mask |= CWWidth; if (height != XINT (bar->height)) mask |= CWHeight; if (mask) XConfigureWindow (FRAME_X_DISPLAY (f), SCROLL_BAR_X_WINDOW (bar), mask, &wc); } XSETINT (bar->left, left); XSETINT (bar->top, top); XSETINT (bar->width, width); XSETINT (bar->height, height); UNBLOCK_INPUT; } /* Destroy the X window for BAR, and set its Emacs window's scroll bar to nil. */ static void x_scroll_bar_remove (bar) struct scroll_bar *bar; { FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); BLOCK_INPUT; /* Destroy the window. */ XDestroyWindow (FRAME_X_DISPLAY (f), SCROLL_BAR_X_WINDOW (bar)); /* Disassociate this scroll bar from its window. */ XWINDOW (bar->window)->vertical_scroll_bar = Qnil; UNBLOCK_INPUT; } /* Set the handle of the vertical scroll bar for WINDOW to indicate that we are displaying PORTION characters out of a total of WHOLE characters, starting at POSITION. If WINDOW has no scroll bar, create one. */ static void XTset_vertical_scroll_bar (window, portion, whole, position) struct window *window; int portion, whole, position; { FRAME_PTR f = XFRAME (WINDOW_FRAME (window)); int top = XINT (window->top); int left = WINDOW_VERTICAL_SCROLL_BAR_COLUMN (window); int height = WINDOW_VERTICAL_SCROLL_BAR_HEIGHT (window); /* Where should this scroll bar be, pixelwise? */ int pixel_top = CHAR_TO_PIXEL_ROW (f, top); int pixel_left = CHAR_TO_PIXEL_COL (f, left); int pixel_width = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f) : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font))); int pixel_height = VERTICAL_SCROLL_BAR_PIXEL_HEIGHT (f, height); struct scroll_bar *bar; /* Does the scroll bar exist yet? */ if (NILP (window->vertical_scroll_bar)) bar = x_scroll_bar_create (window, pixel_top, pixel_left, pixel_width, pixel_height); else { /* It may just need to be moved and resized. */ bar = XSCROLL_BAR (window->vertical_scroll_bar); x_scroll_bar_move (bar, pixel_top, pixel_left, pixel_width, pixel_height); } /* Set the scroll bar's current state, unless we're currently being dragged. */ if (NILP (bar->dragging)) { int top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (pixel_height); if (whole == 0) x_scroll_bar_set_handle (bar, 0, top_range, 0); else { int start = ((double) position * top_range) / whole; int end = ((double) (position + portion) * top_range) / whole; x_scroll_bar_set_handle (bar, start, end, 0); } } XSETVECTOR (window->vertical_scroll_bar, bar); } /* The following three hooks are used when we're doing a thorough redisplay of the frame. We don't explicitly know which scroll bars are going to be deleted, because keeping track of when windows go away is a real pain - "Can you say set-window-configuration, boys and girls?" Instead, we just assert at the beginning of redisplay that *all* scroll bars are to be removed, and then save a scroll bar from the fiery pit when we actually redisplay its window. */ /* Arrange for all scroll bars on FRAME to be removed at the next call to `*judge_scroll_bars_hook'. A scroll bar may be spared if `*redeem_scroll_bar_hook' is applied to its window before the judgement. */ static void XTcondemn_scroll_bars (frame) FRAME_PTR frame; { /* Transfer all the scroll bars to FRAME_CONDEMNED_SCROLL_BARS. */ while (! NILP (FRAME_SCROLL_BARS (frame))) { Lisp_Object bar; bar = FRAME_SCROLL_BARS (frame); FRAME_SCROLL_BARS (frame) = XSCROLL_BAR (bar)->next; XSCROLL_BAR (bar)->next = FRAME_CONDEMNED_SCROLL_BARS (frame); XSCROLL_BAR (bar)->prev = Qnil; if (! NILP (FRAME_CONDEMNED_SCROLL_BARS (frame))) XSCROLL_BAR (FRAME_CONDEMNED_SCROLL_BARS (frame))->prev = bar; FRAME_CONDEMNED_SCROLL_BARS (frame) = bar; } } /* Unmark WINDOW's scroll bar for deletion in this judgement cycle. Note that WINDOW isn't necessarily condemned at all. */ static void XTredeem_scroll_bar (window) struct window *window; { struct scroll_bar *bar; /* We can't redeem this window's scroll bar if it doesn't have one. */ if (NILP (window->vertical_scroll_bar)) abort (); bar = XSCROLL_BAR (window->vertical_scroll_bar); /* Unlink it from the condemned list. */ { FRAME_PTR f = XFRAME (WINDOW_FRAME (window)); if (NILP (bar->prev)) { /* If the prev pointer is nil, it must be the first in one of the lists. */ if (EQ (FRAME_SCROLL_BARS (f), window->vertical_scroll_bar)) /* It's not condemned. Everything's fine. */ return; else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f), window->vertical_scroll_bar)) FRAME_CONDEMNED_SCROLL_BARS (f) = bar->next; else /* If its prev pointer is nil, it must be at the front of one or the other! */ abort (); } else XSCROLL_BAR (bar->prev)->next = bar->next; if (! NILP (bar->next)) XSCROLL_BAR (bar->next)->prev = bar->prev; bar->next = FRAME_SCROLL_BARS (f); bar->prev = Qnil; XSETVECTOR (FRAME_SCROLL_BARS (f), bar); if (! NILP (bar->next)) XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); } } /* Remove all scroll bars on FRAME that haven't been saved since the last call to `*condemn_scroll_bars_hook'. */ static void XTjudge_scroll_bars (f) FRAME_PTR f; { Lisp_Object bar, next; bar = FRAME_CONDEMNED_SCROLL_BARS (f); /* Clear out the condemned list now so we won't try to process any more events on the hapless scroll bars. */ FRAME_CONDEMNED_SCROLL_BARS (f) = Qnil; for (; ! NILP (bar); bar = next) { struct scroll_bar *b = XSCROLL_BAR (bar); x_scroll_bar_remove (b); next = b->next; b->next = b->prev = Qnil; } /* Now there should be no references to the condemned scroll bars, and they should get garbage-collected. */ } /* Handle an Expose or GraphicsExpose event on a scroll bar. This may be called from a signal handler, so we have to ignore GC mark bits. */ static void x_scroll_bar_expose (bar, event) struct scroll_bar *bar; XEvent *event; { Window w = SCROLL_BAR_X_WINDOW (bar); FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); GC gc = f->output_data.x->normal_gc; BLOCK_INPUT; x_scroll_bar_set_handle (bar, XINT (bar->start), XINT (bar->end), 1); /* Draw a one-pixel border just inside the edges of the scroll bar. */ XDrawRectangle (FRAME_X_DISPLAY (f), w, gc, /* x, y, width, height */ 0, 0, XINT (bar->width) - 1, XINT (bar->height) - 1); UNBLOCK_INPUT; } /* Handle a mouse click on the scroll bar BAR. If *EMACS_EVENT's kind is set to something other than no_event, it is enqueued. This may be called from a signal handler, so we have to ignore GC mark bits. */ static void x_scroll_bar_handle_click (bar, event, emacs_event) struct scroll_bar *bar; XEvent *event; struct input_event *emacs_event; { if (! GC_WINDOWP (bar->window)) abort (); emacs_event->kind = scroll_bar_click; emacs_event->code = event->xbutton.button - Button1; emacs_event->modifiers = (x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (XFRAME (WINDOW_FRAME (XWINDOW (bar->window)))), event->xbutton.state) | (event->type == ButtonRelease ? up_modifier : down_modifier)); emacs_event->frame_or_window = bar->window; emacs_event->timestamp = event->xbutton.time; { int internal_height = VERTICAL_SCROLL_BAR_INSIDE_HEIGHT (XINT (bar->height)); int top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (XINT (bar->height)); int y = event->xbutton.y - VERTICAL_SCROLL_BAR_TOP_BORDER; if (y < 0) y = 0; if (y > top_range) y = top_range; if (y < XINT (bar->start)) emacs_event->part = scroll_bar_above_handle; else if (y < XINT (bar->end) + VERTICAL_SCROLL_BAR_MIN_HANDLE) emacs_event->part = scroll_bar_handle; else emacs_event->part = scroll_bar_below_handle; /* Just because the user has clicked on the handle doesn't mean they want to drag it. Lisp code needs to be able to decide whether or not we're dragging. */ #if 0 /* If the user has just clicked on the handle, record where they're holding it. */ if (event->type == ButtonPress && emacs_event->part == scroll_bar_handle) XSETINT (bar->dragging, y - XINT (bar->start)); #endif /* If the user has released the handle, set it to its final position. */ if (event->type == ButtonRelease && ! NILP (bar->dragging)) { int new_start = y - XINT (bar->dragging); int new_end = new_start + (XINT (bar->end) - XINT (bar->start)); x_scroll_bar_set_handle (bar, new_start, new_end, 0); bar->dragging = Qnil; } /* Same deal here as the other #if 0. */ #if 0 /* Clicks on the handle are always reported as occurring at the top of the handle. */ if (emacs_event->part == scroll_bar_handle) emacs_event->x = bar->start; else XSETINT (emacs_event->x, y); #else XSETINT (emacs_event->x, y); #endif XSETINT (emacs_event->y, top_range); } } /* Handle some mouse motion while someone is dragging the scroll bar. This may be called from a signal handler, so we have to ignore GC mark bits. */ static void x_scroll_bar_note_movement (bar, event) struct scroll_bar *bar; XEvent *event; { FRAME_PTR f = XFRAME (XWINDOW (bar->window)->frame); last_mouse_movement_time = event->xmotion.time; f->mouse_moved = 1; XSETVECTOR (last_mouse_scroll_bar, bar); /* If we're dragging the bar, display it. */ if (! GC_NILP (bar->dragging)) { /* Where should the handle be now? */ int new_start = event->xmotion.y - XINT (bar->dragging); if (new_start != XINT (bar->start)) { int new_end = new_start + (XINT (bar->end) - XINT (bar->start)); x_scroll_bar_set_handle (bar, new_start, new_end, 0); } } /* Call XQueryPointer so we'll get an event the next time the mouse moves and we can see *still* on the same position. */ { int dummy; Window dummy_window; XQueryPointer (event->xmotion.display, event->xmotion.window, &dummy_window, &dummy_window, &dummy, &dummy, &dummy, &dummy, (unsigned int *) &dummy); } } /* Return information to the user about the current position of the mouse on the scroll bar. */ static void x_scroll_bar_report_motion (fp, bar_window, part, x, y, time) FRAME_PTR *fp; Lisp_Object *bar_window; enum scroll_bar_part *part; Lisp_Object *x, *y; unsigned long *time; { struct scroll_bar *bar = XSCROLL_BAR (last_mouse_scroll_bar); Window w = SCROLL_BAR_X_WINDOW (bar); FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); int win_x, win_y; Window dummy_window; int dummy_coord; unsigned int dummy_mask; BLOCK_INPUT; /* Get the mouse's position relative to the scroll bar window, and report that. */ if (! XQueryPointer (FRAME_X_DISPLAY (f), w, /* Root, child, root x and root y. */ &dummy_window, &dummy_window, &dummy_coord, &dummy_coord, /* Position relative to scroll bar. */ &win_x, &win_y, /* Mouse buttons and modifier keys. */ &dummy_mask)) ; else { int inside_height = VERTICAL_SCROLL_BAR_INSIDE_HEIGHT (XINT (bar->height)); int top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (XINT (bar->height)); win_y -= VERTICAL_SCROLL_BAR_TOP_BORDER; if (! NILP (bar->dragging)) win_y -= XINT (bar->dragging); if (win_y < 0) win_y = 0; if (win_y > top_range) win_y = top_range; *fp = f; *bar_window = bar->window; if (! NILP (bar->dragging)) *part = scroll_bar_handle; else if (win_y < XINT (bar->start)) *part = scroll_bar_above_handle; else if (win_y < XINT (bar->end) + VERTICAL_SCROLL_BAR_MIN_HANDLE) *part = scroll_bar_handle; else *part = scroll_bar_below_handle; XSETINT (*x, win_y); XSETINT (*y, top_range); f->mouse_moved = 0; last_mouse_scroll_bar = Qnil; } *time = last_mouse_movement_time; UNBLOCK_INPUT; } /* The screen has been cleared so we may have changed foreground or background colors, and the scroll bars may need to be redrawn. Clear out the scroll bars, and ask for expose events, so we can redraw them. */ x_scroll_bar_clear (f) FRAME_PTR f; { Lisp_Object bar; for (bar = FRAME_SCROLL_BARS (f); VECTORP (bar); bar = XSCROLL_BAR (bar)->next) XClearArea (FRAME_X_DISPLAY (f), SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)), 0, 0, 0, 0, True); } /* This processes Expose events from the menubar specific X event loop in xmenu.c. This allows to redisplay the frame if necessary when handling menubar or popup items. */ void process_expose_from_menu (event) XEvent event; { FRAME_PTR f; struct x_display_info *dpyinfo; BLOCK_INPUT; dpyinfo = x_display_info_for_display (event.xexpose.display); f = x_window_to_frame (dpyinfo, event.xexpose.window); if (f) { if (f->async_visible == 0) { f->async_visible = 1; f->async_iconified = 0; SET_FRAME_GARBAGED (f); } else { dumprectangle (x_window_to_frame (dpyinfo, event.xexpose.window), event.xexpose.x, event.xexpose.y, event.xexpose.width, event.xexpose.height); } } else { struct scroll_bar *bar = x_window_to_scroll_bar (event.xexpose.window); if (bar) x_scroll_bar_expose (bar, &event); } UNBLOCK_INPUT; } /* Define a queue to save up SelectionRequest events for later handling. */ struct selection_event_queue { XEvent event; struct selection_event_queue *next; }; static struct selection_event_queue *queue; /* Nonzero means queue up certain events--don't process them yet. */ static int x_queue_selection_requests; /* Queue up an X event *EVENT, to be processed later. */ static void x_queue_event (f, event) FRAME_PTR f; XEvent *event; { struct selection_event_queue *queue_tmp = (struct selection_event_queue *) malloc (sizeof (struct selection_event_queue)); if (queue_tmp != NULL) { queue_tmp->event = *event; queue_tmp->next = queue; queue = queue_tmp; } } /* Take all the queued events and put them back so that they get processed afresh. */ static void x_unqueue_events (display) Display *display; { while (queue != NULL) { struct selection_event_queue *queue_tmp = queue; XPutBackEvent (display, &queue_tmp->event); queue = queue_tmp->next; free ((char *)queue_tmp); } } /* Start queuing SelectionRequest events. */ void x_start_queuing_selection_requests (display) Display *display; { x_queue_selection_requests++; } /* Stop queuing SelectionRequest events. */ void x_stop_queuing_selection_requests (display) Display *display; { x_queue_selection_requests--; x_unqueue_events (display); } /* The main X event-reading loop - XTread_socket. */ /* Timestamp of enter window event. This is only used by XTread_socket, but we have to put it out here, since static variables within functions sometimes don't work. */ static Time enter_timestamp; /* This holds the state XLookupString needs to implement dead keys and other tricks known as "compose processing". _X Window System_ says that a portable program can't use this, but Stephen Gildea assures me that letting the compiler initialize it to zeros will work okay. This must be defined outside of XTread_socket, for the same reasons given for enter_timestamp, above. */ static XComposeStatus compose_status; /* Record the last 100 characters stored to help debug the loss-of-chars-during-GC problem. */ static int temp_index; static short temp_buffer[100]; /* Set this to nonzero to fake an "X I/O error" on a particular display. */ struct x_display_info *XTread_socket_fake_io_error; /* When we find no input here, we occasionally do a no-op command to verify that the X server is still running and we can still talk with it. We try all the open displays, one by one. This variable is used for cycling thru the displays. */ static struct x_display_info *next_noop_dpyinfo; /* Read events coming from the X server. This routine is called by the SIGIO handler. We return as soon as there are no more events to be read. Events representing keys are stored in buffer BUFP, which can hold up to NUMCHARS characters. We return the number of characters stored into the buffer, thus pretending to be `read'. WAITP is nonzero if we should block until input arrives. EXPECTED is nonzero if the caller knows input is available. */ int XTread_socket (sd, bufp, numchars, waitp, expected) register int sd; register struct input_event *bufp; register int numchars; int waitp; int expected; { int count = 0; int nbytes = 0; int mask; int items_pending; /* How many items are in the X queue. */ XEvent event; struct frame *f; int event_found = 0; int prefix; Lisp_Object part; struct x_display_info *dpyinfo; #ifdef HAVE_X_I18N Status status_return; #endif if (interrupt_input_blocked) { interrupt_input_pending = 1; return -1; } interrupt_input_pending = 0; BLOCK_INPUT; /* So people can tell when we have read the available input. */ input_signal_count++; if (numchars <= 0) abort (); /* Don't think this happens. */ /* Find the display we are supposed to read input for. It's the one communicating on descriptor SD. */ for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) { #if 0 /* This ought to be unnecessary; let's verify it. */ #ifdef FIOSNBIO /* If available, Xlib uses FIOSNBIO to make the socket non-blocking, and then looks for EWOULDBLOCK. If O_NDELAY is set, FIOSNBIO is ignored, and instead of signalling EWOULDBLOCK, a read returns 0, which Xlib interprets as equivalent to EPIPE. */ fcntl (dpyinfo->connection, F_SETFL, 0); #endif /* ! defined (FIOSNBIO) */ #endif #if 0 /* This code can't be made to work, with multiple displays, and appears not to be used on any system any more. Also keyboard.c doesn't turn O_NDELAY on and off for X connections. */ #ifndef SIGIO #ifndef HAVE_SELECT if (! (fcntl (dpyinfo->connection, F_GETFL, 0) & O_NDELAY)) { extern int read_alarm_should_throw; read_alarm_should_throw = 1; XPeekEvent (dpyinfo->display, &event); read_alarm_should_throw = 0; } #endif /* HAVE_SELECT */ #endif /* SIGIO */ #endif /* For debugging, this gives a way to fake an I/O error. */ if (dpyinfo == XTread_socket_fake_io_error) { XTread_socket_fake_io_error = 0; x_io_error_quitter (dpyinfo->display); } while (XPending (dpyinfo->display) != 0) { XNextEvent (dpyinfo->display, &event); event_found = 1; switch (event.type) { case ClientMessage: { if (event.xclient.message_type == dpyinfo->Xatom_wm_protocols && event.xclient.format == 32) { if (event.xclient.data.l[0] == dpyinfo->Xatom_wm_take_focus) { f = x_window_to_frame (dpyinfo, event.xclient.window); /* Since we set WM_TAKE_FOCUS, we must call XSetInputFocus explicitly. But not if f is null, since that might be an event for a deleted frame. */ #ifdef HAVE_X_I18N /* Not quite sure this is needed -pd */ if (f) XSetICFocus (FRAME_XIC (f)); #endif if (f) XSetInputFocus (event.xclient.display, event.xclient.window, RevertToPointerRoot, event.xclient.data.l[1]); /* Not certain about handling scroll bars here */ } else if (event.xclient.data.l[0] == dpyinfo->Xatom_wm_save_yourself) { /* Save state modify the WM_COMMAND property to something which can reinstate us. This notifies the session manager, who's looking for such a PropertyNotify. Can restart processing when a keyboard or mouse event arrives. */ if (numchars > 0) { f = x_top_window_to_frame (dpyinfo, event.xclient.window); /* This is just so we only give real data once for a single Emacs process. */ if (f == selected_frame) XSetCommand (FRAME_X_DISPLAY (f), event.xclient.window, initial_argv, initial_argc); else XSetCommand (FRAME_X_DISPLAY (f), event.xclient.window, 0, 0); } } else if (event.xclient.data.l[0] == dpyinfo->Xatom_wm_delete_window) { struct frame *f = x_any_window_to_frame (dpyinfo, event.xclient.window); if (f) { if (numchars == 0) abort (); bufp->kind = delete_window_event; XSETFRAME (bufp->frame_or_window, f); bufp++; count += 1; numchars -= 1; } } } else if (event.xclient.message_type == dpyinfo->Xatom_wm_configure_denied) { } else if (event.xclient.message_type == dpyinfo->Xatom_wm_window_moved) { int new_x, new_y; struct frame *f = x_window_to_frame (dpyinfo, event.xclient.window); new_x = event.xclient.data.s[0]; new_y = event.xclient.data.s[1]; if (f) { f->output_data.x->left_pos = new_x; f->output_data.x->top_pos = new_y; } } #ifdef HACK_EDITRES else if (event.xclient.message_type == dpyinfo->Xatom_editres) { struct frame *f = x_any_window_to_frame (dpyinfo, event.xclient.window); _XEditResCheckMessages (f->output_data.x->widget, NULL, &event, NULL); } #endif /* HACK_EDITRES */ } break; case SelectionNotify: #ifdef USE_X_TOOLKIT if (! x_window_to_frame (dpyinfo, event.xselection.requestor)) goto OTHER; #endif /* not USE_X_TOOLKIT */ x_handle_selection_notify (&event); break; case SelectionClear: /* Someone has grabbed ownership. */ #ifdef USE_X_TOOLKIT if (! x_window_to_frame (dpyinfo, event.xselectionclear.window)) goto OTHER; #endif /* USE_X_TOOLKIT */ { XSelectionClearEvent *eventp = (XSelectionClearEvent *) &event; if (numchars == 0) abort (); bufp->kind = selection_clear_event; SELECTION_EVENT_DISPLAY (bufp) = eventp->display; SELECTION_EVENT_SELECTION (bufp) = eventp->selection; SELECTION_EVENT_TIME (bufp) = eventp->time; bufp++; count += 1; numchars -= 1; } break; case SelectionRequest: /* Someone wants our selection. */ #ifdef USE_X_TOOLKIT if (!x_window_to_frame (dpyinfo, event.xselectionrequest.owner)) goto OTHER; #endif /* USE_X_TOOLKIT */ if (x_queue_selection_requests) x_queue_event (x_window_to_frame (dpyinfo, event.xselectionrequest.owner), &event); else { XSelectionRequestEvent *eventp = (XSelectionRequestEvent *) &event; if (numchars == 0) abort (); bufp->kind = selection_request_event; SELECTION_EVENT_DISPLAY (bufp) = eventp->display; SELECTION_EVENT_REQUESTOR (bufp) = eventp->requestor; SELECTION_EVENT_SELECTION (bufp) = eventp->selection; SELECTION_EVENT_TARGET (bufp) = eventp->target; SELECTION_EVENT_PROPERTY (bufp) = eventp->property; SELECTION_EVENT_TIME (bufp) = eventp->time; bufp++; count += 1; numchars -= 1; } break; case PropertyNotify: #ifdef USE_X_TOOLKIT if (!x_any_window_to_frame (dpyinfo, event.xproperty.window)) goto OTHER; #endif /* not USE_X_TOOLKIT */ x_handle_property_notify (&event); break; case ReparentNotify: f = x_top_window_to_frame (dpyinfo, event.xreparent.window); if (f) { int x, y; f->output_data.x->parent_desc = event.xreparent.parent; x_real_positions (f, &x, &y); f->output_data.x->left_pos = x; f->output_data.x->top_pos = y; } break; case Expose: f = x_window_to_frame (dpyinfo, event.xexpose.window); if (f) { if (f->async_visible == 0) { f->async_visible = 1; f->async_iconified = 0; SET_FRAME_GARBAGED (f); } else dumprectangle (x_window_to_frame (dpyinfo, event.xexpose.window), event.xexpose.x, event.xexpose.y, event.xexpose.width, event.xexpose.height); } else { struct scroll_bar *bar = x_window_to_scroll_bar (event.xexpose.window); if (bar) x_scroll_bar_expose (bar, &event); #ifdef USE_X_TOOLKIT else goto OTHER; #endif /* USE_X_TOOLKIT */ } break; case GraphicsExpose: /* This occurs when an XCopyArea's source area was obscured or not available.*/ f = x_window_to_frame (dpyinfo, event.xgraphicsexpose.drawable); if (f) { dumprectangle (f, event.xgraphicsexpose.x, event.xgraphicsexpose.y, event.xgraphicsexpose.width, event.xgraphicsexpose.height); } #ifdef USE_X_TOOLKIT else goto OTHER; #endif /* USE_X_TOOLKIT */ break; case NoExpose: /* This occurs when an XCopyArea's source area was completely available */ break; case UnmapNotify: f = x_top_window_to_frame (dpyinfo, event.xunmap.window); if (f) /* F may no longer exist if the frame was deleted. */ { /* While a frame is unmapped, display generation is disabled; you don't want to spend time updating a display that won't ever be seen. */ f->async_visible = 0; /* We can't distinguish, from the event, whether the window has become iconified or invisible. So assume, if it was previously visible, than now it is iconified. We depend on x_make_frame_invisible to mark it iconified. */ if (FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f)) f->async_iconified = 1; bufp->kind = iconify_event; XSETFRAME (bufp->frame_or_window, f); bufp++; count++; numchars--; } #ifdef USE_X_TOOLKIT goto OTHER; #endif /* USE_X_TOOLKIT */ break; case MapNotify: /* We use x_top_window_to_frame because map events can come for subwindows and they don't mean that the frame is visible. */ f = x_top_window_to_frame (dpyinfo, event.xmap.window); if (f) { f->async_visible = 1; f->async_iconified = 0; /* wait_reading_process_input will notice this and update the frame's display structures. */ SET_FRAME_GARBAGED (f); if (f->iconified) { bufp->kind = deiconify_event; XSETFRAME (bufp->frame_or_window, f); bufp++; count++; numchars--; } else /* Force a redisplay sooner or later to update the frame titles in case this is the second frame. */ record_asynch_buffer_change (); } #ifdef USE_X_TOOLKIT goto OTHER; #endif /* USE_X_TOOLKIT */ break; /* Turn off processing if we become fully obscured. */ case VisibilityNotify: break; case KeyPress: f = x_any_window_to_frame (dpyinfo, event.xkey.window); if (f != 0) { KeySym keysym, orig_keysym; /* al%imercury@uunet.uu.net says that making this 81 instead of 80 fixed a bug whereby meta chars made his Emacs hang. */ unsigned char copy_buffer[81]; int modifiers; event.xkey.state |= x_emacs_to_x_modifiers (FRAME_X_DISPLAY_INFO (f), extra_keyboard_modifiers); modifiers = event.xkey.state; /* This will have to go some day... */ /* make_lispy_event turns chars into control chars. Don't do it here because XLookupString is too eager. */ event.xkey.state &= ~ControlMask; event.xkey.state &= ~(dpyinfo->meta_mod_mask | dpyinfo->super_mod_mask | dpyinfo->hyper_mod_mask | dpyinfo->alt_mod_mask); #ifdef HAVE_X_I18N if (FRAME_XIC (f)) { /* The necessity of the following line took me a full work-day to decipher from the docs!! */ if (XFilterEvent (&event, None)) break; nbytes = XmbLookupString (FRAME_XIC (f), &event.xkey, copy_buffer, 80, &keysym, &status_return); } else nbytes = XLookupString (&event.xkey, copy_buffer, 80, &keysym, &compose_status); #else nbytes = XLookupString (&event.xkey, copy_buffer, 80, &keysym, &compose_status); #endif orig_keysym = keysym; if (numchars > 1) { if (((keysym >= XK_BackSpace && keysym <= XK_Escape) || keysym == XK_Delete || IsCursorKey (keysym) /* 0xff50 <= x < 0xff60 */ || IsMiscFunctionKey (keysym) /* 0xff60 <= x < VARIES */ #ifdef HPUX /* This recognizes the "extended function keys". It seems there's no cleaner way. Test IsModifierKey to avoid handling mode_switch incorrectly. */ || ((unsigned) (keysym) >= XK_Select && (unsigned)(keysym) < XK_KP_Space) #endif #ifdef XK_dead_circumflex || orig_keysym == XK_dead_circumflex #endif #ifdef XK_dead_grave || orig_keysym == XK_dead_grave #endif #ifdef XK_dead_tilde || orig_keysym == XK_dead_tilde #endif #ifdef XK_dead_diaeresis || orig_keysym == XK_dead_diaeresis #endif #ifdef XK_dead_macron || orig_keysym == XK_dead_macron #endif #ifdef XK_dead_degree || orig_keysym == XK_dead_degree #endif #ifdef XK_dead_acute || orig_keysym == XK_dead_acute #endif #ifdef XK_dead_cedilla || orig_keysym == XK_dead_cedilla #endif #ifdef XK_dead_breve || orig_keysym == XK_dead_breve #endif #ifdef XK_dead_ogonek || orig_keysym == XK_dead_ogonek #endif #ifdef XK_dead_caron || orig_keysym == XK_dead_caron #endif #ifdef XK_dead_doubleacute || orig_keysym == XK_dead_doubleacute #endif #ifdef XK_dead_abovedot || orig_keysym == XK_dead_abovedot #endif || IsKeypadKey (keysym) /* 0xff80 <= x < 0xffbe */ || IsFunctionKey (keysym) /* 0xffbe <= x < 0xffe1 */ /* Any "vendor-specific" key is ok. */ || (orig_keysym & (1 << 28))) && ! (IsModifierKey (orig_keysym) #ifndef HAVE_X11R5 #ifdef XK_Mode_switch || ((unsigned)(orig_keysym) == XK_Mode_switch) #endif #ifdef XK_Num_Lock || ((unsigned)(orig_keysym) == XK_Num_Lock) #endif #endif /* not HAVE_X11R5 */ )) { if (temp_index == sizeof temp_buffer / sizeof (short)) temp_index = 0; temp_buffer[temp_index++] = keysym; bufp->kind = non_ascii_keystroke; bufp->code = keysym; XSETFRAME (bufp->frame_or_window, f); bufp->modifiers = x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f), modifiers); bufp->timestamp = event.xkey.time; bufp++; count++; numchars--; } else if (numchars > nbytes) { register int i; for (i = 0; i < nbytes; i++) { if (temp_index == sizeof temp_buffer / sizeof (short)) temp_index = 0; temp_buffer[temp_index++] = copy_buffer[i]; bufp->kind = ascii_keystroke; bufp->code = copy_buffer[i]; XSETFRAME (bufp->frame_or_window, f); bufp->modifiers = x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f), modifiers); bufp->timestamp = event.xkey.time; bufp++; } count += nbytes; numchars -= nbytes; } else abort (); } else abort (); } break; /* Here's a possible interpretation of the whole FocusIn-EnterNotify FocusOut-LeaveNotify mess. If you get a FocusIn event, you have to get a FocusOut event before you relinquish the focus. If you haven't received a FocusIn event, then a mere LeaveNotify is enough to free you. */ case EnterNotify: f = x_any_window_to_frame (dpyinfo, event.xcrossing.window); if (event.xcrossing.focus) /* Entered Window */ { /* Avoid nasty pop/raise loops. */ if (f && (!(f->auto_raise) || !(f->auto_lower) || (event.xcrossing.time - enter_timestamp) > 500)) { x_new_focus_frame (dpyinfo, f); enter_timestamp = event.xcrossing.time; } } else if (f == dpyinfo->x_focus_frame) x_new_focus_frame (dpyinfo, 0); /* EnterNotify counts as mouse movement, so update things that depend on mouse position. */ if (f) note_mouse_movement (f, &event.xmotion); #ifdef USE_X_TOOLKIT goto OTHER; #endif /* USE_X_TOOLKIT */ break; case FocusIn: f = x_any_window_to_frame (dpyinfo, event.xfocus.window); if (event.xfocus.detail != NotifyPointer) dpyinfo->x_focus_event_frame = f; if (f) x_new_focus_frame (dpyinfo, f); #ifdef HAVE_X_I18N if (f && FRAME_XIC (f)) XSetICFocus (FRAME_XIC (f)); #endif #ifdef USE_X_TOOLKIT goto OTHER; #endif /* USE_X_TOOLKIT */ break; case LeaveNotify: f = x_top_window_to_frame (dpyinfo, event.xcrossing.window); if (f) { if (f == dpyinfo->mouse_face_mouse_frame) /* If we move outside the frame, then we're certainly no longer on any text in the frame. */ clear_mouse_face (dpyinfo); if (event.xcrossing.focus) x_mouse_leave (dpyinfo); else { if (f == dpyinfo->x_focus_event_frame) dpyinfo->x_focus_event_frame = 0; if (f == dpyinfo->x_focus_frame) x_new_focus_frame (dpyinfo, 0); } } #ifdef USE_X_TOOLKIT goto OTHER; #endif /* USE_X_TOOLKIT */ break; case FocusOut: f = x_any_window_to_frame (dpyinfo, event.xfocus.window); if (event.xfocus.detail != NotifyPointer && f == dpyinfo->x_focus_event_frame) dpyinfo->x_focus_event_frame = 0; if (f && f == dpyinfo->x_focus_frame) x_new_focus_frame (dpyinfo, 0); #ifdef HAVE_X_I18N if (f && FRAME_XIC (f)) XUnsetICFocus (FRAME_XIC (f)); #endif #ifdef USE_X_TOOLKIT goto OTHER; #endif /* USE_X_TOOLKIT */ break; case MotionNotify: { if (dpyinfo->grabbed && last_mouse_frame && FRAME_LIVE_P (last_mouse_frame)) f = last_mouse_frame; else f = x_window_to_frame (dpyinfo, event.xmotion.window); if (f) note_mouse_movement (f, &event.xmotion); else { struct scroll_bar *bar = x_window_to_scroll_bar (event.xmotion.window); if (bar) x_scroll_bar_note_movement (bar, &event); /* If we move outside the frame, then we're certainly no longer on any text in the frame. */ clear_mouse_face (dpyinfo); } } #ifdef USE_X_TOOLKIT goto OTHER; #endif /* USE_X_TOOLKIT */ break; case ConfigureNotify: f = x_any_window_to_frame (dpyinfo, event.xconfigure.window); if (f #ifdef USE_X_TOOLKIT && (event.xconfigure.window == XtWindow (f->output_data.x->widget)) #endif ) { #ifndef USE_X_TOOLKIT /* In the toolkit version, change_frame_size is called by the code that handles resizing of the EmacsFrame widget. */ int rows = PIXEL_TO_CHAR_HEIGHT (f, event.xconfigure.height); int columns = PIXEL_TO_CHAR_WIDTH (f, event.xconfigure.width); /* Even if the number of character rows and columns has not changed, the font size may have changed, so we need to check the pixel dimensions as well. */ if (columns != f->width || rows != f->height || event.xconfigure.width != f->output_data.x->pixel_width || event.xconfigure.height != f->output_data.x->pixel_height) { change_frame_size (f, rows, columns, 0, 1); SET_FRAME_GARBAGED (f); } #endif /* Formerly, in the USE_X_TOOLKIT version, we did not test send_event here. */ if (1 #ifndef USE_X_TOOLKIT && ! event.xconfigure.send_event #endif ) { Window win, child; int win_x, win_y; /* Find the position of the outside upper-left corner of the window, in the root coordinate system. Don't refer to the parent window here; we may be processing this event after the window manager has changed our parent, but before we have reached the ReparentNotify. */ XTranslateCoordinates (FRAME_X_DISPLAY (f), /* From-window, to-window. */ event.xconfigure.window, FRAME_X_DISPLAY_INFO (f)->root_window, /* From-position, to-position. */ -event.xconfigure.border_width, -event.xconfigure.border_width, &win_x, &win_y, /* Child of win. */ &child); event.xconfigure.x = win_x; event.xconfigure.y = win_y; } f->output_data.x->pixel_width = event.xconfigure.width; f->output_data.x->pixel_height = event.xconfigure.height; f->output_data.x->left_pos = event.xconfigure.x; f->output_data.x->top_pos = event.xconfigure.y; /* What we have now is the position of Emacs's own window. Convert that to the position of the window manager window. */ { int x, y; x_real_positions (f, &x, &y); f->output_data.x->left_pos = x; f->output_data.x->top_pos = y; /* Formerly we did not do this in the USE_X_TOOLKIT version. Let's try making them the same. */ /* #ifndef USE_X_TOOLKIT */ if (y != event.xconfigure.y) { /* Since the WM decorations come below top_pos now, we must put them below top_pos in the future. */ f->output_data.x->win_gravity = NorthWestGravity; x_wm_set_size_hint (f, (long) 0, 0); } /* #endif */ } } #ifdef USE_X_TOOLKIT goto OTHER; #else break; #endif case ButtonPress: case ButtonRelease: { /* If we decide we want to generate an event to be seen by the rest of Emacs, we put it here. */ struct input_event emacs_event; emacs_event.kind = no_event; bzero (&compose_status, sizeof (compose_status)); if (dpyinfo->grabbed && last_mouse_frame && FRAME_LIVE_P (last_mouse_frame)) f = last_mouse_frame; else f = x_window_to_frame (dpyinfo, event.xbutton.window); if (f) { if (!dpyinfo->x_focus_frame || f == dpyinfo->x_focus_frame) construct_mouse_click (&emacs_event, &event, f); } else { struct scroll_bar *bar = x_window_to_scroll_bar (event.xbutton.window); if (bar) x_scroll_bar_handle_click (bar, &event, &emacs_event); } if (event.type == ButtonPress) { dpyinfo->grabbed |= (1 << event.xbutton.button); last_mouse_frame = f; } else { dpyinfo->grabbed &= ~(1 << event.xbutton.button); } if (numchars >= 1 && emacs_event.kind != no_event) { bcopy (&emacs_event, bufp, sizeof (struct input_event)); bufp++; count++; numchars--; } #ifdef USE_X_TOOLKIT f = x_menubar_window_to_frame (dpyinfo, event.xbutton.window); /* For a down-event in the menu bar, don't pass it to Xt right now. Instead, save it away and we will pass it to Xt from kbd_buffer_get_event. That way, we can run some Lisp code first. */ if (f && event.type == ButtonPress /* Verify the event is really within the menu bar and not just sent to it due to grabbing. */ && event.xbutton.x >= 0 && event.xbutton.x < f->output_data.x->pixel_width && event.xbutton.y >= 0 && event.xbutton.y < f->output_data.x->menubar_height && event.xbutton.same_screen) { if (f->output_data.x->saved_button_event == 0) f->output_data.x->saved_button_event = (XButtonEvent *) xmalloc (sizeof (XButtonEvent)); bcopy (&event, f->output_data.x->saved_button_event, sizeof (XButtonEvent)); if (numchars >= 1) { bufp->kind = menu_bar_activate_event; XSETFRAME (bufp->frame_or_window, f); bufp++; count++; numchars--; } } else goto OTHER; #endif /* USE_X_TOOLKIT */ } break; case CirculateNotify: break; case CirculateRequest: break; case MappingNotify: /* Someone has changed the keyboard mapping - update the local cache. */ switch (event.xmapping.request) { case MappingModifier: x_find_modifier_meanings (dpyinfo); /* This is meant to fall through. */ case MappingKeyboard: XRefreshKeyboardMapping (&event.xmapping); } #ifdef USE_X_TOOLKIT goto OTHER; #endif /* USE_X_TOOLKIT */ break; default: #ifdef USE_X_TOOLKIT OTHER: BLOCK_INPUT; XtDispatchEvent (&event); UNBLOCK_INPUT; #endif /* USE_X_TOOLKIT */ break; } } } /* On some systems, an X bug causes Emacs to get no more events when the window is destroyed. Detect that. (1994.) */ if (! event_found) { /* Emacs and the X Server eats up CPU time if XNoOp is done every time. One XNOOP in 100 loops will make Emacs terminate. B. Bretthauer, 1994 */ x_noop_count++; if (x_noop_count >= 100) { x_noop_count=0; if (next_noop_dpyinfo == 0) next_noop_dpyinfo = x_display_list; XNoOp (next_noop_dpyinfo->display); /* Each time we get here, cycle through the displays now open. */ next_noop_dpyinfo = next_noop_dpyinfo->next; } } /* If the focus was just given to an autoraising frame, raise it now. */ /* ??? This ought to be able to handle more than one such frame. */ if (pending_autoraise_frame) { x_raise_frame (pending_autoraise_frame); pending_autoraise_frame = 0; } UNBLOCK_INPUT; return count; } /* Drawing the cursor. */ /* Draw a hollow box cursor on frame F at X, Y. Don't change the inside of the box. */ static void x_draw_box (f, x, y) struct frame *f; int x, y; { int left = CHAR_TO_PIXEL_COL (f, x); int top = CHAR_TO_PIXEL_ROW (f, y); int width = FONT_WIDTH (f->output_data.x->font); int height = f->output_data.x->line_height; XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->cursor_gc, left, top, width - 1, height - 1); } /* Clear the cursor of frame F to background color, and mark the cursor as not shown. This is used when the text where the cursor is is about to be rewritten. */ static void clear_cursor (f) struct frame *f; { int mask; if (! FRAME_VISIBLE_P (f) || f->phys_cursor_x < 0) return; x_display_cursor (f, 0); f->phys_cursor_x = -1; } /* Redraw the glyph at ROW, COLUMN on frame F, in the style HIGHLIGHT. HIGHLIGHT is as defined for dumpglyphs. Return the glyph drawn. */ static void x_draw_single_glyph (f, row, column, glyph, highlight) struct frame *f; int row, column; GLYPH glyph; int highlight; { dumpglyphs (f, CHAR_TO_PIXEL_COL (f, column), CHAR_TO_PIXEL_ROW (f, row), &glyph, 1, highlight, 0); } static void x_display_bar_cursor (f, on, x, y) struct frame *f; int on; int x, y; { struct frame_glyphs *current_glyphs = FRAME_CURRENT_GLYPHS (f); /* This is pointless on invisible frames, and dangerous on garbaged frames; in the latter case, the frame may be in the midst of changing its size, and x and y may be off the frame. */ if (! FRAME_VISIBLE_P (f) || FRAME_GARBAGED_P (f)) return; if (! on && f->phys_cursor_x < 0) return; /* If there is anything wrong with the current cursor state, remove it. */ if (f->phys_cursor_x >= 0 && (!on || f->phys_cursor_x != x || f->phys_cursor_y != y || f->output_data.x->current_cursor != bar_cursor)) { /* Erase the cursor by redrawing the character underneath it. */ x_draw_single_glyph (f, f->phys_cursor_y, f->phys_cursor_x, f->phys_cursor_glyph, current_glyphs->highlight[f->phys_cursor_y]); f->phys_cursor_x = -1; } /* If we now need a cursor in the new place or in the new form, do it so. */ if (on && (f->phys_cursor_x < 0 || (f->output_data.x->current_cursor != bar_cursor))) { f->phys_cursor_glyph = ((current_glyphs->enable[y] && x < current_glyphs->used[y]) ? current_glyphs->glyphs[y][x] : SPACEGLYPH); XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->cursor_gc, CHAR_TO_PIXEL_COL (f, x), CHAR_TO_PIXEL_ROW (f, y), max (f->output_data.x->cursor_width, 1), f->output_data.x->line_height); f->phys_cursor_x = x; f->phys_cursor_y = y; f->output_data.x->current_cursor = bar_cursor; } if (updating_frame != f) XFlush (FRAME_X_DISPLAY (f)); } /* Turn the displayed cursor of frame F on or off according to ON. If ON is nonzero, where to put the cursor is specified by X and Y. */ static void x_display_box_cursor (f, on, x, y) struct frame *f; int on; int x, y; { struct frame_glyphs *current_glyphs = FRAME_CURRENT_GLYPHS (f); /* This is pointless on invisible frames, and dangerous on garbaged frames; in the latter case, the frame may be in the midst of changing its size, and x and y may be off the frame. */ if (! FRAME_VISIBLE_P (f) || FRAME_GARBAGED_P (f)) return; /* If cursor is off and we want it off, return quickly. */ if (!on && f->phys_cursor_x < 0) return; /* If cursor is currently being shown and we don't want it to be or it is in the wrong place, or we want a hollow box and it's not so, (pout!) erase it. */ if (f->phys_cursor_x >= 0 && (!on || f->phys_cursor_x != x || f->phys_cursor_y != y || (f->output_data.x->current_cursor != hollow_box_cursor && (f != FRAME_X_DISPLAY_INFO (f)->x_highlight_frame)))) { int mouse_face_here = 0; struct frame_glyphs *active_glyphs = FRAME_CURRENT_GLYPHS (f); /* If the cursor is in the mouse face area, redisplay that when we clear the cursor. */ if (f == FRAME_X_DISPLAY_INFO (f)->mouse_face_mouse_frame && (f->phys_cursor_y > FRAME_X_DISPLAY_INFO (f)->mouse_face_beg_row || (f->phys_cursor_y == FRAME_X_DISPLAY_INFO (f)->mouse_face_beg_row && f->phys_cursor_x >= FRAME_X_DISPLAY_INFO (f)->mouse_face_beg_col)) && (f->phys_cursor_y < FRAME_X_DISPLAY_INFO (f)->mouse_face_end_row || (f->phys_cursor_y == FRAME_X_DISPLAY_INFO (f)->mouse_face_end_row && f->phys_cursor_x < FRAME_X_DISPLAY_INFO (f)->mouse_face_end_col)) /* Don't redraw the cursor's spot in mouse face if it is at the end of a line (on a newline). The cursor appears there, but mouse highlighting does not. */ && active_glyphs->used[f->phys_cursor_y] > f->phys_cursor_x) mouse_face_here = 1; /* If the font is not as tall as a whole line, we must explicitly clear the line's whole height. */ if (FONT_HEIGHT (f->output_data.x->font) != f->output_data.x->line_height) XClearArea (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), CHAR_TO_PIXEL_COL (f, f->phys_cursor_x), CHAR_TO_PIXEL_ROW (f, f->phys_cursor_y), FONT_WIDTH (f->output_data.x->font), f->output_data.x->line_height, False); /* Erase the cursor by redrawing the character underneath it. */ x_draw_single_glyph (f, f->phys_cursor_y, f->phys_cursor_x, f->phys_cursor_glyph, (mouse_face_here ? 3 : current_glyphs->highlight[f->phys_cursor_y])); f->phys_cursor_x = -1; } /* If we want to show a cursor, or we want a box cursor and it's not so, write it in the right place. */ if (on && (f->phys_cursor_x < 0 || (f->output_data.x->current_cursor != filled_box_cursor && f == FRAME_X_DISPLAY_INFO (f)->x_highlight_frame))) { f->phys_cursor_glyph = ((current_glyphs->enable[y] && x < current_glyphs->used[y]) ? current_glyphs->glyphs[y][x] : SPACEGLYPH); if (f != FRAME_X_DISPLAY_INFO (f)->x_highlight_frame) { x_draw_box (f, x, y); f->output_data.x->current_cursor = hollow_box_cursor; } else { x_draw_single_glyph (f, y, x, f->phys_cursor_glyph, 2); f->output_data.x->current_cursor = filled_box_cursor; } f->phys_cursor_x = x; f->phys_cursor_y = y; } if (updating_frame != f) XFlush (FRAME_X_DISPLAY (f)); } /* Display the cursor on frame F, or clear it, according to ON. Use the position specified by curs_x and curs_y if we are doing an update of frame F now. Otherwise use the position in the FRAME_CURSOR_X and FRAME_CURSOR_Y fields of F. */ x_display_cursor (f, on) struct frame *f; int on; { BLOCK_INPUT; /* If we're not updating, then don't change the physical cursor position. Just change (if appropriate) the style of display. */ if (f != updating_frame) { curs_x = FRAME_CURSOR_X (f); curs_y = FRAME_CURSOR_Y (f); } if (FRAME_DESIRED_CURSOR (f) == filled_box_cursor) x_display_box_cursor (f, on, curs_x, curs_y); else if (FRAME_DESIRED_CURSOR (f) == bar_cursor) x_display_bar_cursor (f, on, curs_x, curs_y); else /* Those are the only two we have implemented! */ abort (); UNBLOCK_INPUT; } /* Display the cursor on frame F, or clear it, according to ON. Don't change the cursor's position. */ x_update_cursor (f, on) struct frame *f; int on; { BLOCK_INPUT; if (FRAME_DESIRED_CURSOR (f) == filled_box_cursor) x_display_box_cursor (f, on, f->phys_cursor_x, f->phys_cursor_y); else if (FRAME_DESIRED_CURSOR (f) == bar_cursor) x_display_bar_cursor (f, on, f->phys_cursor_x, f->phys_cursor_y); else /* Those are the only two we have implemented! */ abort (); UNBLOCK_INPUT; } /* Icons. */ /* Refresh bitmap kitchen sink icon for frame F when we get an expose event for it. */ refreshicon (f) struct frame *f; { /* Normally, the window manager handles this function. */ } /* Make the x-window of frame F use the gnu icon bitmap. */ int x_bitmap_icon (f, file) struct frame *f; Lisp_Object file; { int mask, bitmap_id; Window icon_window; if (FRAME_X_WINDOW (f) == 0) return 1; /* Free up our existing icon bitmap if any. */ if (f->output_data.x->icon_bitmap > 0) x_destroy_bitmap (f, f->output_data.x->icon_bitmap); f->output_data.x->icon_bitmap = 0; if (STRINGP (file)) bitmap_id = x_create_bitmap_from_file (f, file); else { /* Create the GNU bitmap if necessary. */ if (FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id < 0) FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id = x_create_bitmap_from_data (f, gnu_bits, gnu_width, gnu_height); /* The first time we create the GNU bitmap, this increments the refcount one extra time. As a result, the GNU bitmap is never freed. That way, we don't have to worry about allocating it again. */ x_reference_bitmap (f, FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id); bitmap_id = FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id; } x_wm_set_icon_pixmap (f, bitmap_id); f->output_data.x->icon_bitmap = bitmap_id; return 0; } /* Make the x-window of frame F use a rectangle with text. Use ICON_NAME as the text. */ int x_text_icon (f, icon_name) struct frame *f; char *icon_name; { if (FRAME_X_WINDOW (f) == 0) return 1; #ifdef HAVE_X11R4 { XTextProperty text; text.value = (unsigned char *) icon_name; text.encoding = XA_STRING; text.format = 8; text.nitems = strlen (icon_name); #ifdef USE_X_TOOLKIT XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget), &text); #else /* not USE_X_TOOLKIT */ XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text); #endif /* not USE_X_TOOLKIT */ } #else /* not HAVE_X11R4 */ XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), icon_name); #endif /* not HAVE_X11R4 */ if (f->output_data.x->icon_bitmap > 0) x_destroy_bitmap (f, f->output_data.x->icon_bitmap); f->output_data.x->icon_bitmap = 0; x_wm_set_icon_pixmap (f, 0); return 0; } /* Handling X errors. */ /* Handle the loss of connection to display DISPLAY. */ static SIGTYPE x_connection_closed (display, error_message) Display *display; char *error_message; { struct x_display_info *dpyinfo = x_display_info_for_display (display); Lisp_Object frame, tail; /* Whatever we were in the middle of, we are going to throw out of it, so reassure various things that have error checks about being called with input blocked. */ TOTALLY_UNBLOCK_INPUT; if (_Xdebug) abort (); /* First delete frames whose minibuffers are on frames that are on the dead display. */ FOR_EACH_FRAME (tail, frame) { Lisp_Object minibuf_frame; minibuf_frame = WINDOW_FRAME (XWINDOW (FRAME_MINIBUF_WINDOW (XFRAME (frame)))); if (FRAME_X_P (XFRAME (frame)) && FRAME_X_P (XFRAME (minibuf_frame)) && ! EQ (frame, minibuf_frame) && FRAME_X_DISPLAY_INFO (XFRAME (minibuf_frame)) == dpyinfo) Fdelete_frame (frame, Qt); } /* Now delete all remaining frames on the dead display. We are now sure none of these is used as the minibuffer for another frame that we need to delete. */ FOR_EACH_FRAME (tail, frame) if (FRAME_X_P (XFRAME (frame)) && FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo) { /* Set this to t so that Fdelete_frame won't get confused trying to find a replacement. */ FRAME_KBOARD (XFRAME (frame))->Vdefault_minibuffer_frame = Qt; Fdelete_frame (frame, Qt); } x_delete_display (dpyinfo); if (x_display_list == 0) { fprintf (stderr, "%s", error_message); shut_down_emacs (0, 0, Qnil); exit (70); } /* Ordinary stack unwind doesn't deal with these. */ #ifdef SIGIO sigunblock (sigmask (SIGIO)); #endif sigunblock (sigmask (SIGALRM)); TOTALLY_UNBLOCK_INPUT; error ("%s", error_message); } /* This is the usual handler for X protocol errors. It kills all frames on the display that we got the error for. If that was the only one, it prints an error message and kills Emacs. */ static int x_error_quitter (display, error) Display *display; XErrorEvent *error; { char buf[256], buf1[356]; /* Note that there is no real way portable across R3/R4 to get the original error handler. */ XGetErrorText (display, error->error_code, buf, sizeof (buf)); sprintf (buf1, "X protocol error: %s on protocol request %d", buf, error->request_code); x_connection_closed (display, buf1); } /* This is the handler for X IO errors, always. It kills all frames on the display that we lost touch with. If that was the only one, it prints an error message and kills Emacs. */ static int x_io_error_quitter (display) Display *display; { char buf[256]; sprintf (buf, "Connection lost to X server `%s'", DisplayString (display)); x_connection_closed (display, buf); } /* Handle SIGPIPE, which can happen when the connection to a server simply goes away. SIGPIPE is handled by x_connection_signal. It works by sending a no-op command to each X server connection. When we try a connection that has closed, we get SIGPIPE again. But this time, it is handled by x_connection_signal_1. That function knows which connection we were testing, so it closes that one. x_connection_closed never returns, so if more than one connection was lost at once, we only find one. But XTread_socket keeps trying them all, so it will notice the other closed one sooner or later. */ static struct x_display_info *x_connection_signal_dpyinfo; static SIGTYPE x_connection_signal (); static SIGTYPE x_connection_signal_1 (signalnum) /* If we don't have an argument, */ int signalnum; /* some compilers complain in signal calls. */ { signal (SIGPIPE, x_connection_signal); x_connection_closed (x_connection_signal_dpyinfo, "connection was lost"); } static SIGTYPE x_connection_signal (signalnum) /* If we don't have an argument, */ int signalnum; /* some compilers complain in signal calls. */ { x_connection_signal_dpyinfo = x_display_list; sigunblock (SIGPIPE); while (x_connection_signal_dpyinfo) { signal (SIGPIPE, x_connection_signal_1); XNoOp (x_connection_signal_dpyinfo->display); XSync (x_connection_signal_dpyinfo->display, False); /* Each time we get here, cycle through the displays now open. */ x_connection_signal_dpyinfo = x_connection_signal_dpyinfo->next; } /* We should have found some closed connection. */ abort (); } /* A buffer for storing X error messages. */ static char *x_caught_error_message; #define X_CAUGHT_ERROR_MESSAGE_SIZE 200 /* An X error handler which stores the error message in x_caught_error_message. This is what's installed when x_catch_errors is in effect. */ static int x_error_catcher (display, error) Display *display; XErrorEvent *error; { XGetErrorText (display, error->error_code, x_caught_error_message, X_CAUGHT_ERROR_MESSAGE_SIZE); } /* Begin trapping X errors for display DPY. Actually we trap X errors for all displays, but DPY should be the display you are actually operating on. After calling this function, X protocol errors no longer cause Emacs to exit; instead, they are recorded in x_cfc_error_message. Calling x_check_errors signals an Emacs error if an X error has occurred since the last call to x_catch_errors or x_check_errors. Calling x_uncatch_errors resumes the normal error handling. */ void x_catch_errors (), x_check_errors (), x_uncatch_errors (); void x_catch_errors (dpy) Display *dpy; { /* Make sure any errors from previous requests have been dealt with. */ XSync (dpy, False); /* Set up the error buffer. */ x_caught_error_message = (char*) xmalloc (X_CAUGHT_ERROR_MESSAGE_SIZE); x_caught_error_message[0] = '\0'; /* Install our little error handler. */ XSetErrorHandler (x_error_catcher); } /* If any X protocol errors have arrived since the last call to x_catch_errors or x_check_errors, signal an Emacs error using sprintf (a buffer, FORMAT, the x error message text) as the text. */ void x_check_errors (dpy, format) Display *dpy; char *format; { /* Make sure to catch any errors incurred so far. */ XSync (dpy, False); if (x_caught_error_message[0]) { char buf[X_CAUGHT_ERROR_MESSAGE_SIZE + 56]; sprintf (buf, format, x_caught_error_message); x_uncatch_errors (dpy); error (buf); } } /* Nonzero if we had any X protocol errors since we did x_catch_errors. */ int x_had_errors_p (dpy) Display *dpy; { /* Make sure to catch any errors incurred so far. */ XSync (dpy, False); return x_caught_error_message[0] != 0; } /* Stop catching X protocol errors and let them make Emacs die. */ void x_uncatch_errors (dpy) Display *dpy; { xfree (x_caught_error_message); x_caught_error_message = 0; XSetErrorHandler (x_error_quitter); } #if 0 static unsigned int x_wire_count; x_trace_wire () { fprintf (stderr, "Lib call: %d\n", ++x_wire_count); } #endif /* ! 0 */ /* Changing the font of the frame. */ /* Give frame F the font named FONTNAME as its default font, and return the full name of that font. FONTNAME may be a wildcard pattern; in that case, we choose some font that fits the pattern. The return value shows which font we chose. */ Lisp_Object x_new_font (f, fontname) struct frame *f; register char *fontname; { int already_loaded; int n_matching_fonts; XFontStruct *font_info; char **font_names; /* Get a list of all the fonts that match this name. Once we have a list of matching fonts, we compare them against the fonts we already have by comparing font ids. */ font_names = (char **) XListFonts (FRAME_X_DISPLAY (f), fontname, 1024, &n_matching_fonts); /* Apparently it doesn't set n_matching_fonts to zero when it can't find any matches; font_names == 0 is the only clue. */ if (! font_names) n_matching_fonts = 0; /* Don't just give up if n_matching_fonts is 0. Apparently there's a bug on Suns: XListFontsWithInfo can fail to find a font, but XLoadQueryFont may still find it. */ /* See if we've already loaded a matching font. */ already_loaded = -1; if (n_matching_fonts != 0) { int i, j; for (i = 0; i < FRAME_X_DISPLAY_INFO (f)->n_fonts; i++) for (j = 0; j < n_matching_fonts; j++) if (!strcmp (FRAME_X_DISPLAY_INFO (f)->font_table[i].name, font_names[j]) || !strcmp (FRAME_X_DISPLAY_INFO (f)->font_table[i].full_name, font_names[j])) { already_loaded = i; fontname = FRAME_X_DISPLAY_INFO (f)->font_table[i].full_name; goto found_font; } } found_font: /* If we have, just return it from the table. */ if (already_loaded >= 0) f->output_data.x->font = FRAME_X_DISPLAY_INFO (f)->font_table[already_loaded].font; /* Otherwise, load the font and add it to the table. */ else { int i; char *full_name; XFontStruct *font; int n_fonts; /* Try to find a character-cell font in the list. */ #if 0 /* A laudable goal, but this isn't how to do it. */ for (i = 0; i < n_matching_fonts; i++) if (! font_info[i].per_char) break; #else i = 0; #endif /* See comment above. */ if (n_matching_fonts != 0) fontname = font_names[i]; font = (XFontStruct *) XLoadQueryFont (FRAME_X_DISPLAY (f), fontname); if (! font) { /* Free the information from XListFonts. */ if (n_matching_fonts) XFreeFontNames (font_names); return Qnil; } /* Do we need to create the table? */ if (FRAME_X_DISPLAY_INFO (f)->font_table_size == 0) { FRAME_X_DISPLAY_INFO (f)->font_table_size = 16; FRAME_X_DISPLAY_INFO (f)->font_table = (struct font_info *) xmalloc (FRAME_X_DISPLAY_INFO (f)->font_table_size * sizeof (struct font_info)); } /* Do we need to grow the table? */ else if (FRAME_X_DISPLAY_INFO (f)->n_fonts >= FRAME_X_DISPLAY_INFO (f)->font_table_size) { FRAME_X_DISPLAY_INFO (f)->font_table_size *= 2; FRAME_X_DISPLAY_INFO (f)->font_table = (struct font_info *) xrealloc (FRAME_X_DISPLAY_INFO (f)->font_table, (FRAME_X_DISPLAY_INFO (f)->font_table_size * sizeof (struct font_info))); } /* Try to get the full name of FONT. Put it in full_name. */ full_name = 0; for (i = 0; i < font->n_properties; i++) { char *atom = XGetAtomName (FRAME_X_DISPLAY (f), font->properties[i].name); if (!strcmp (atom, "FONT")) { char *name = XGetAtomName (FRAME_X_DISPLAY (f), (Atom) (font->properties[i].card32)); char *p = name; int dashes = 0; /* Count the number of dashes in the "full name". If it is too few, this isn't really the font's full name, so don't use it. In X11R4, the fonts did not come with their canonical names stored in them. */ while (*p) { if (*p == '-') dashes++; p++; } if (dashes >= 13) full_name = name; break; } XFree (atom); } n_fonts = FRAME_X_DISPLAY_INFO (f)->n_fonts; FRAME_X_DISPLAY_INFO (f)->font_table[n_fonts].name = (char *) xmalloc (strlen (fontname) + 1); bcopy (fontname, FRAME_X_DISPLAY_INFO (f)->font_table[n_fonts].name, strlen (fontname) + 1); if (full_name != 0) FRAME_X_DISPLAY_INFO (f)->font_table[n_fonts].full_name = full_name; else FRAME_X_DISPLAY_INFO (f)->font_table[n_fonts].full_name = FRAME_X_DISPLAY_INFO (f)->font_table[n_fonts].name; f->output_data.x->font = FRAME_X_DISPLAY_INFO (f)->font_table[n_fonts].font = font; FRAME_X_DISPLAY_INFO (f)->n_fonts++; if (full_name) fontname = full_name; } /* Compute the scroll bar width in character columns. */ if (f->scroll_bar_pixel_width > 0) { int wid = FONT_WIDTH (f->output_data.x->font); f->scroll_bar_cols = (f->scroll_bar_pixel_width + wid-1) / wid; } else f->scroll_bar_cols = 2; /* Now make the frame display the given font. */ if (FRAME_X_WINDOW (f) != 0) { XSetFont (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc, f->output_data.x->font->fid); XSetFont (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc, f->output_data.x->font->fid); XSetFont (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc, f->output_data.x->font->fid); frame_update_line_height (f); x_set_window_size (f, 0, f->width, f->height); } else /* If we are setting a new frame's font for the first time, there are no faces yet, so this font's height is the line height. */ f->output_data.x->line_height = FONT_HEIGHT (f->output_data.x->font); { Lisp_Object lispy_name; lispy_name = build_string (fontname); /* Free the information from XListFonts. The data we actually retain comes from XLoadQueryFont. */ XFreeFontNames (font_names); return lispy_name; } } x_calc_absolute_position (f) struct frame *f; { Window win, child; int win_x = 0, win_y = 0; int flags = f->output_data.x->size_hint_flags; int this_window; #ifdef USE_X_TOOLKIT this_window = XtWindow (f->output_data.x->widget); #else this_window = FRAME_X_WINDOW (f); #endif /* Find the position of the outside upper-left corner of the inner window, with respect to the outer window. */ if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window) { BLOCK_INPUT; XTranslateCoordinates (FRAME_X_DISPLAY (f), /* From-window, to-window. */ this_window, f->output_data.x->parent_desc, /* From-position, to-position. */ 0, 0, &win_x, &win_y, /* Child of win. */ &child); UNBLOCK_INPUT; } /* Treat negative positions as relative to the leftmost bottommost position that fits on the screen. */ if (flags & XNegative) f->output_data.x->left_pos = (FRAME_X_DISPLAY_INFO (f)->width - 2 * f->output_data.x->border_width - win_x - PIXEL_WIDTH (f) + f->output_data.x->left_pos); if (flags & YNegative) f->output_data.x->top_pos = (FRAME_X_DISPLAY_INFO (f)->height - 2 * f->output_data.x->border_width - win_y - PIXEL_HEIGHT (f) - (FRAME_EXTERNAL_MENU_BAR (f) ? f->output_data.x->menubar_height : 0) + f->output_data.x->top_pos); /* The left_pos and top_pos are now relative to the top and left screen edges, so the flags should correspond. */ f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative); } /* CHANGE_GRAVITY is 1 when calling from Fset_frame_position, to really change the position, and 0 when calling from x_make_frame_visible (in that case, XOFF and YOFF are the current position values). It is -1 when calling from x_set_frame_parameters, which means, do adjust for borders but don't change the gravity. */ x_set_offset (f, xoff, yoff, change_gravity) struct frame *f; register int xoff, yoff; int change_gravity; { int modified_top, modified_left; if (change_gravity > 0) { f->output_data.x->top_pos = yoff; f->output_data.x->left_pos = xoff; f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative); if (xoff < 0) f->output_data.x->size_hint_flags |= XNegative; if (yoff < 0) f->output_data.x->size_hint_flags |= YNegative; f->output_data.x->win_gravity = NorthWestGravity; } x_calc_absolute_position (f); BLOCK_INPUT; x_wm_set_size_hint (f, (long) 0, 0); /* It is a mystery why we need to add the border_width here when the frame is already visible, but experiment says we do. */ modified_left = f->output_data.x->left_pos; modified_top = f->output_data.x->top_pos; if (change_gravity != 0) { modified_left += f->output_data.x->border_width; modified_top += f->output_data.x->border_width; } #ifdef USE_X_TOOLKIT XMoveWindow (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget), modified_left, modified_top); #else /* not USE_X_TOOLKIT */ XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), modified_left, modified_top); #endif /* not USE_X_TOOLKIT */ UNBLOCK_INPUT; } /* Call this to change the size of frame F's x-window. If CHANGE_GRAVITY is 1, we change to top-left-corner window gravity for this size change and subsequent size changes. Otherwise we leave the window gravity unchanged. */ x_set_window_size (f, change_gravity, cols, rows) struct frame *f; int change_gravity; int cols, rows; { int pixelwidth, pixelheight; int mask; #ifdef USE_X_TOOLKIT BLOCK_INPUT; { /* The x and y position of the widget is clobbered by the call to XtSetValues within EmacsFrameSetCharSize. This is a real kludge, but I don't understand Xt so I can't figure out a correct fix. Can anyone else tell me? -- rms. */ int xpos = f->output_data.x->widget->core.x; int ypos = f->output_data.x->widget->core.y; EmacsFrameSetCharSize (f->output_data.x->edit_widget, cols, rows); f->output_data.x->widget->core.x = xpos; f->output_data.x->widget->core.y = ypos; } UNBLOCK_INPUT; #else /* not USE_X_TOOLKIT */ BLOCK_INPUT; check_frame_size (f, &rows, &cols); f->output_data.x->vertical_scroll_bar_extra = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f) ? 0 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f) : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font))); pixelwidth = CHAR_TO_PIXEL_WIDTH (f, cols); pixelheight = CHAR_TO_PIXEL_HEIGHT (f, rows); f->output_data.x->win_gravity = NorthWestGravity; x_wm_set_size_hint (f, (long) 0, 0); XSync (FRAME_X_DISPLAY (f), False); XResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), pixelwidth, pixelheight); /* Now, strictly speaking, we can't be sure that this is accurate, but the window manager will get around to dealing with the size change request eventually, and we'll hear how it went when the ConfigureNotify event gets here. We could just not bother storing any of this information here, and let the ConfigureNotify event set everything up, but that might be kind of confusing to the lisp code, since size changes wouldn't be reported in the frame parameters until some random point in the future when the ConfigureNotify event arrives. */ change_frame_size (f, rows, cols, 0, 0); PIXEL_WIDTH (f) = pixelwidth; PIXEL_HEIGHT (f) = pixelheight; /* If cursor was outside the new size, mark it as off. */ if (f->phys_cursor_y >= rows || f->phys_cursor_x >= cols) { f->phys_cursor_x = -1; f->phys_cursor_y = -1; } /* We've set {FRAME,PIXEL}_{WIDTH,HEIGHT} to the values we hope to receive in the ConfigureNotify event; if we get what we asked for, then the event won't cause the screen to become garbaged, so we have to make sure to do it here. */ SET_FRAME_GARBAGED (f); XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; #endif /* not USE_X_TOOLKIT */ } /* Mouse warping. */ void x_set_mouse_position (f, x, y) struct frame *f; int x, y; { int pix_x, pix_y; pix_x = CHAR_TO_PIXEL_COL (f, x) + FONT_WIDTH (f->output_data.x->font) / 2; pix_y = CHAR_TO_PIXEL_ROW (f, y) + f->output_data.x->line_height / 2; if (pix_x < 0) pix_x = 0; if (pix_x > PIXEL_WIDTH (f)) pix_x = PIXEL_WIDTH (f); if (pix_y < 0) pix_y = 0; if (pix_y > PIXEL_HEIGHT (f)) pix_y = PIXEL_HEIGHT (f); BLOCK_INPUT; XWarpPointer (FRAME_X_DISPLAY (f), None, FRAME_X_WINDOW (f), 0, 0, 0, 0, pix_x, pix_y); UNBLOCK_INPUT; } /* Move the mouse to position pixel PIX_X, PIX_Y relative to frame F. */ void x_set_mouse_pixel_position (f, pix_x, pix_y) struct frame *f; int pix_x, pix_y; { BLOCK_INPUT; XWarpPointer (FRAME_X_DISPLAY (f), None, FRAME_X_WINDOW (f), 0, 0, 0, 0, pix_x, pix_y); UNBLOCK_INPUT; } /* focus shifting, raising and lowering. */ x_focus_on_frame (f) struct frame *f; { #if 0 /* This proves to be unpleasant. */ x_raise_frame (f); #endif #if 0 /* I don't think that the ICCCM allows programs to do things like this without the interaction of the window manager. Whatever you end up doing with this code, do it to x_unfocus_frame too. */ XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), RevertToPointerRoot, CurrentTime); #endif /* ! 0 */ } x_unfocus_frame (f) struct frame *f; { #if 0 /* Look at the remarks in x_focus_on_frame. */ if (FRAME_X_DISPLAY_INFO (f)->x_focus_frame == f) XSetInputFocus (FRAME_X_DISPLAY (f), PointerRoot, RevertToPointerRoot, CurrentTime); #endif /* ! 0 */ } /* Raise frame F. */ x_raise_frame (f) struct frame *f; { if (f->async_visible) { BLOCK_INPUT; #ifdef USE_X_TOOLKIT XRaiseWindow (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget)); #else /* not USE_X_TOOLKIT */ XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); #endif /* not USE_X_TOOLKIT */ XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; } } /* Lower frame F. */ x_lower_frame (f) struct frame *f; { if (f->async_visible) { BLOCK_INPUT; #ifdef USE_X_TOOLKIT XLowerWindow (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget)); #else /* not USE_X_TOOLKIT */ XLowerWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); #endif /* not USE_X_TOOLKIT */ XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; } } static void XTframe_raise_lower (f, raise) FRAME_PTR f; int raise; { if (raise) x_raise_frame (f); else x_lower_frame (f); } /* Change of visibility. */ /* This tries to wait until the frame is really visible. However, if the window manager asks the user where to position the frame, this will return before the user finishes doing that. The frame will not actually be visible at that time, but it will become visible later when the window manager finishes with it. */ x_make_frame_visible (f) struct frame *f; { int mask; Lisp_Object type; BLOCK_INPUT; type = x_icon_type (f); if (!NILP (type)) x_bitmap_icon (f, type); if (! FRAME_VISIBLE_P (f)) { /* We test FRAME_GARBAGED_P here to make sure we don't call x_set_offset a second time if we get to x_make_frame_visible a second time before the window gets really visible. */ if (! FRAME_ICONIFIED_P (f) && ! f->output_data.x->asked_for_visible) x_set_offset (f, f->output_data.x->left_pos, f->output_data.x->top_pos, 0); f->output_data.x->asked_for_visible = 1; if (! EQ (Vx_no_window_manager, Qt)) x_wm_set_window_state (f, NormalState); #ifdef USE_X_TOOLKIT /* This was XtPopup, but that did nothing for an iconified frame. */ XtMapWidget (f->output_data.x->widget); #else /* not USE_X_TOOLKIT */ XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); #endif /* not USE_X_TOOLKIT */ #if 0 /* This seems to bring back scroll bars in the wrong places if the window configuration has changed. They seem to come back ok without this. */ if (FRAME_HAS_VERTICAL_SCROLL_BARS (f)) XMapSubwindows (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); #endif } XFlush (FRAME_X_DISPLAY (f)); /* Synchronize to ensure Emacs knows the frame is visible before we do anything else. We do this loop with input not blocked so that incoming events are handled. */ { Lisp_Object frame; int count = input_signal_count; /* This must come after we set COUNT. */ UNBLOCK_INPUT; XSETFRAME (frame, f); while (1) { x_sync (f); /* Once we have handled input events, we should have received the MapNotify if one is coming. So if we have not got it yet, stop looping. Some window managers make their own decisions about visibility. */ if (input_signal_count != count) break; /* Machines that do polling rather than SIGIO have been observed to go into a busy-wait here. So we'll fake an alarm signal to let the handler know that there's something to be read. We used to raise a real alarm, but it seems that the handler isn't always enabled here. This is probably a bug. */ if (input_polling_used ()) { /* It could be confusing if a real alarm arrives while processing the fake one. Turn it off and let the handler reset it. */ alarm (0); input_poll_signal (); } /* Once we have handled input events, we should have received the MapNotify if one is coming. So if we have not got it yet, stop looping. Some window managers make their own decisions about visibility. */ if (input_signal_count != count) break; } FRAME_SAMPLE_VISIBILITY (f); } } /* Change from mapped state to withdrawn state. */ /* Make the frame visible (mapped and not iconified). */ x_make_frame_invisible (f) struct frame *f; { int mask; Window window; #ifdef USE_X_TOOLKIT /* Use the frame's outermost window, not the one we normally draw on. */ window = XtWindow (f->output_data.x->widget); #else /* not USE_X_TOOLKIT */ window = FRAME_X_WINDOW (f); #endif /* not USE_X_TOOLKIT */ /* Don't keep the highlight on an invisible frame. */ if (FRAME_X_DISPLAY_INFO (f)->x_highlight_frame == f) FRAME_X_DISPLAY_INFO (f)->x_highlight_frame = 0; #if 0/* This might add unreliability; I don't trust it -- rms. */ if (! f->async_visible && ! f->async_iconified) return; #endif BLOCK_INPUT; /* Before unmapping the window, update the WM_SIZE_HINTS property to claim that the current position of the window is user-specified, rather than program-specified, so that when the window is mapped again, it will be placed at the same location, without forcing the user to position it by hand again (they have already done that once for this window.) */ x_wm_set_size_hint (f, (long) 0, 1); #ifdef HAVE_X11R4 if (! XWithdrawWindow (FRAME_X_DISPLAY (f), window, DefaultScreen (FRAME_X_DISPLAY (f)))) { UNBLOCK_INPUT_RESIGNAL; error ("Can't notify window manager of window withdrawal"); } #else /* ! defined (HAVE_X11R4) */ /* Tell the window manager what we're going to do. */ if (! EQ (Vx_no_window_manager, Qt)) { XEvent unmap; unmap.xunmap.type = UnmapNotify; unmap.xunmap.window = window; unmap.xunmap.event = DefaultRootWindow (FRAME_X_DISPLAY (f)); unmap.xunmap.from_configure = False; if (! XSendEvent (FRAME_X_DISPLAY (f), DefaultRootWindow (FRAME_X_DISPLAY (f)), False, SubstructureRedirectMask|SubstructureNotifyMask, &unmap)) { UNBLOCK_INPUT_RESIGNAL; error ("Can't notify window manager of withdrawal"); } } /* Unmap the window ourselves. Cheeky! */ XUnmapWindow (FRAME_X_DISPLAY (f), window); #endif /* ! defined (HAVE_X11R4) */ /* We can't distinguish this from iconification just by the event that we get from the server. So we can't win using the usual strategy of letting FRAME_SAMPLE_VISIBILITY set this. So do it by hand, and synchronize with the server to make sure we agree. */ f->visible = 0; FRAME_ICONIFIED_P (f) = 0; f->async_visible = 0; f->async_iconified = 0; x_sync (f); UNBLOCK_INPUT; } /* Change window state from mapped to iconified. */ x_iconify_frame (f) struct frame *f; { int mask; int result; Lisp_Object type; /* Don't keep the highlight on an invisible frame. */ if (FRAME_X_DISPLAY_INFO (f)->x_highlight_frame == f) FRAME_X_DISPLAY_INFO (f)->x_highlight_frame = 0; if (f->async_iconified) return; BLOCK_INPUT; FRAME_SAMPLE_VISIBILITY (f); type = x_icon_type (f); if (!NILP (type)) x_bitmap_icon (f, type); #ifdef USE_X_TOOLKIT if (! FRAME_VISIBLE_P (f)) { if (! EQ (Vx_no_window_manager, Qt)) x_wm_set_window_state (f, IconicState); /* This was XtPopup, but that did nothing for an iconified frame. */ XtMapWidget (f->output_data.x->widget); UNBLOCK_INPUT; return; } result = XIconifyWindow (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget), DefaultScreen (FRAME_X_DISPLAY (f))); UNBLOCK_INPUT; if (!result) error ("Can't notify window manager of iconification"); f->async_iconified = 1; BLOCK_INPUT; XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; #else /* not USE_X_TOOLKIT */ /* Make sure the X server knows where the window should be positioned, in case the user deiconifies with the window manager. */ if (! FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f)) x_set_offset (f, f->output_data.x->left_pos, f->output_data.x->top_pos, 0); /* Since we don't know which revision of X we're running, we'll use both the X11R3 and X11R4 techniques. I don't know if this is a good idea. */ /* X11R4: send a ClientMessage to the window manager using the WM_CHANGE_STATE type. */ { XEvent message; message.xclient.window = FRAME_X_WINDOW (f); message.xclient.type = ClientMessage; message.xclient.message_type = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_change_state; message.xclient.format = 32; message.xclient.data.l[0] = IconicState; if (! XSendEvent (FRAME_X_DISPLAY (f), DefaultRootWindow (FRAME_X_DISPLAY (f)), False, SubstructureRedirectMask | SubstructureNotifyMask, &message)) { UNBLOCK_INPUT_RESIGNAL; error ("Can't notify window manager of iconification"); } } /* X11R3: set the initial_state field of the window manager hints to IconicState. */ x_wm_set_window_state (f, IconicState); if (!FRAME_VISIBLE_P (f)) { /* If the frame was withdrawn, before, we must map it. */ XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); } f->async_iconified = 1; XFlush (FRAME_X_DISPLAY (f)); UNBLOCK_INPUT; #endif /* not USE_X_TOOLKIT */ } /* Destroy the X window of frame F. */ x_destroy_window (f) struct frame *f; { struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); BLOCK_INPUT; if (f->output_data.x->icon_desc != 0) XDestroyWindow (FRAME_X_DISPLAY (f), f->output_data.x->icon_desc); XDestroyWindow (FRAME_X_DISPLAY (f), f->output_data.x->window_desc); #ifdef USE_X_TOOLKIT XtDestroyWidget (f->output_data.x->widget); free_frame_menubar (f); #endif /* USE_X_TOOLKIT */ free_frame_faces (f); XFlush (FRAME_X_DISPLAY (f)); xfree (f->output_data.x); f->output_data.x = 0; if (f == dpyinfo->x_focus_frame) dpyinfo->x_focus_frame = 0; if (f == dpyinfo->x_focus_event_frame) dpyinfo->x_focus_event_frame = 0; if (f == dpyinfo->x_highlight_frame) dpyinfo->x_highlight_frame = 0; dpyinfo->reference_count--; if (f == dpyinfo->mouse_face_mouse_frame) { dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; dpyinfo->mouse_face_window = Qnil; } UNBLOCK_INPUT; } /* Setting window manager hints. */ /* Set the normal size hints for the window manager, for frame F. FLAGS is the flags word to use--or 0 meaning preserve the flags that the window now has. If USER_POSITION is nonzero, we set the USPosition flag (this is useful when FLAGS is 0). */ x_wm_set_size_hint (f, flags, user_position) struct frame *f; long flags; int user_position; { XSizeHints size_hints; #ifdef USE_X_TOOLKIT Arg al[2]; int ac = 0; Dimension widget_width, widget_height; Window window = XtWindow (f->output_data.x->widget); #else /* not USE_X_TOOLKIT */ Window window = FRAME_X_WINDOW (f); #endif /* not USE_X_TOOLKIT */ /* Setting PMaxSize caused various problems. */ size_hints.flags = PResizeInc | PMinSize /* | PMaxSize */; flexlines = f->height; size_hints.x = f->output_data.x->left_pos; size_hints.y = f->output_data.x->top_pos; #ifdef USE_X_TOOLKIT XtSetArg (al[ac], XtNwidth, &widget_width); ac++; XtSetArg (al[ac], XtNheight, &widget_height); ac++; XtGetValues (f->output_data.x->widget, al, ac); size_hints.height = widget_height; size_hints.width = widget_width; #else /* not USE_X_TOOLKIT */ size_hints.height = PIXEL_HEIGHT (f); size_hints.width = PIXEL_WIDTH (f); #endif /* not USE_X_TOOLKIT */ size_hints.width_inc = FONT_WIDTH (f->output_data.x->font); size_hints.height_inc = f->output_data.x->line_height; size_hints.max_width = FRAME_X_DISPLAY_INFO (f)->width - CHAR_TO_PIXEL_WIDTH (f, 0); size_hints.max_height = FRAME_X_DISPLAY_INFO (f)->height - CHAR_TO_PIXEL_HEIGHT (f, 0); /* Calculate the base and minimum sizes. (When we use the X toolkit, we don't do it here. Instead we copy the values that the widgets are using, below.) */ #ifndef USE_X_TOOLKIT { int base_width, base_height; int min_rows = 0, min_cols = 0; base_width = CHAR_TO_PIXEL_WIDTH (f, 0); base_height = CHAR_TO_PIXEL_HEIGHT (f, 0); check_frame_size (f, &min_rows, &min_cols); /* The window manager uses the base width hints to calculate the current number of rows and columns in the frame while resizing; min_width and min_height aren't useful for this purpose, since they might not give the dimensions for a zero-row, zero-column frame. We use the base_width and base_height members if we have them; otherwise, we set the min_width and min_height members to the size for a zero x zero frame. */ #ifdef HAVE_X11R4 size_hints.flags |= PBaseSize; size_hints.base_width = base_width; size_hints.base_height = base_height; size_hints.min_width = base_width + min_cols * size_hints.width_inc; size_hints.min_height = base_height + min_rows * size_hints.height_inc; #else size_hints.min_width = base_width; size_hints.min_height = base_height; #endif } /* If we don't need the old flags, we don't need the old hint at all. */ if (flags) { size_hints.flags |= flags; goto no_read; } #endif /* not USE_X_TOOLKIT */ { XSizeHints hints; /* Sometimes I hate X Windows... */ long supplied_return; int value; #ifdef HAVE_X11R4 value = XGetWMNormalHints (FRAME_X_DISPLAY (f), window, &hints, &supplied_return); #else value = XGetNormalHints (FRAME_X_DISPLAY (f), window, &hints); #endif #ifdef USE_X_TOOLKIT size_hints.base_height = hints.base_height; size_hints.base_width = hints.base_width; size_hints.min_height = hints.min_height; size_hints.min_width = hints.min_width; #endif if (flags) size_hints.flags |= flags; else { if (value == 0) hints.flags = 0; if (hints.flags & PSize) size_hints.flags |= PSize; if (hints.flags & PPosition) size_hints.flags |= PPosition; if (hints.flags & USPosition) size_hints.flags |= USPosition; if (hints.flags & USSize) size_hints.flags |= USSize; } } no_read: #ifdef PWinGravity size_hints.win_gravity = f->output_data.x->win_gravity; size_hints.flags |= PWinGravity; if (user_position) { size_hints.flags &= ~ PPosition; size_hints.flags |= USPosition; } #endif /* PWinGravity */ #ifdef HAVE_X11R4 XSetWMNormalHints (FRAME_X_DISPLAY (f), window, &size_hints); #else XSetNormalHints (FRAME_X_DISPLAY (f), window, &size_hints); #endif } /* Used for IconicState or NormalState */ x_wm_set_window_state (f, state) struct frame *f; int state; { #ifdef USE_X_TOOLKIT Arg al[1]; XtSetArg (al[0], XtNinitialState, state); XtSetValues (f->output_data.x->widget, al, 1); #else /* not USE_X_TOOLKIT */ Window window = FRAME_X_WINDOW (f); f->output_data.x->wm_hints.flags |= StateHint; f->output_data.x->wm_hints.initial_state = state; XSetWMHints (FRAME_X_DISPLAY (f), window, &f->output_data.x->wm_hints); #endif /* not USE_X_TOOLKIT */ } x_wm_set_icon_pixmap (f, pixmap_id) struct frame *f; int pixmap_id; { #ifdef USE_X_TOOLKIT Window window = XtWindow (f->output_data.x->widget); #else Window window = FRAME_X_WINDOW (f); #endif if (pixmap_id > 0) { Pixmap icon_pixmap = x_bitmap_pixmap (f, pixmap_id); f->output_data.x->wm_hints.icon_pixmap = icon_pixmap; } else { /* It seems there is no way to turn off use of an icon pixmap. The following line does it, only if no icon has yet been created, for some window managers. But with mwm it crashes. Some people say it should clear the IconPixmapHint bit in this case, but that doesn't work, and the X consortium said it isn't the right thing at all. Since there is no way to win, best to explicitly give up. */ #if 0 f->output_data.x->wm_hints.icon_pixmap = None; #else return; #endif } f->output_data.x->wm_hints.flags |= IconPixmapHint; XSetWMHints (FRAME_X_DISPLAY (f), window, &f->output_data.x->wm_hints); } x_wm_set_icon_position (f, icon_x, icon_y) struct frame *f; int icon_x, icon_y; { #ifdef USE_X_TOOLKIT Window window = XtWindow (f->output_data.x->widget); #else Window window = FRAME_X_WINDOW (f); #endif f->output_data.x->wm_hints.flags |= IconPositionHint; f->output_data.x->wm_hints.icon_x = icon_x; f->output_data.x->wm_hints.icon_y = icon_y; XSetWMHints (FRAME_X_DISPLAY (f), window, &f->output_data.x->wm_hints); } /* Initialization. */ #ifdef USE_X_TOOLKIT static XrmOptionDescRec emacs_options[] = { {"-geometry", ".geometry", XrmoptionSepArg, NULL}, {"-iconic", ".iconic", XrmoptionNoArg, (XtPointer) "yes"}, {"-internal-border-width", "*EmacsScreen.internalBorderWidth", XrmoptionSepArg, NULL}, {"-ib", "*EmacsScreen.internalBorderWidth", XrmoptionSepArg, NULL}, {"-T", "*EmacsShell.title", XrmoptionSepArg, (XtPointer) NULL}, {"-wn", "*EmacsShell.title", XrmoptionSepArg, (XtPointer) NULL}, {"-title", "*EmacsShell.title", XrmoptionSepArg, (XtPointer) NULL}, {"-iconname", "*EmacsShell.iconName", XrmoptionSepArg, (XtPointer) NULL}, {"-in", "*EmacsShell.iconName", XrmoptionSepArg, (XtPointer) NULL}, {"-mc", "*pointerColor", XrmoptionSepArg, (XtPointer) NULL}, {"-cr", "*cursorColor", XrmoptionSepArg, (XtPointer) NULL} }; #endif /* USE_X_TOOLKIT */ static int x_initialized; #ifdef MULTI_KBOARD /* Test whether two display-name strings agree up to the dot that separates the screen number from the server number. */ static int same_x_server (name1, name2) char *name1, *name2; { int seen_colon = 0; for (; *name1 != '\0' && *name1 == *name2; name1++, name2++) { if (*name1 == ':') seen_colon++; if (seen_colon && *name1 == '.') return 1; } return (seen_colon && (*name1 == '.' || *name1 == '\0') && (*name2 == '.' || *name2 == '\0')); } #endif struct x_display_info * x_term_init (display_name, xrm_option, resource_name) Lisp_Object display_name; char *xrm_option; char *resource_name; { Lisp_Object frame; char *defaultvalue; int connection; Display *dpy; struct x_display_info *dpyinfo; XrmDatabase xrdb; BLOCK_INPUT; if (!x_initialized) { x_initialize (); x_initialized = 1; } #ifdef HAVE_X_I18N setlocale (LC_ALL, NULL); #endif #ifdef USE_X_TOOLKIT /* weiner@footloose.sps.mot.com reports that this causes errors with X11R5: X protocol error: BadAtom (invalid Atom parameter) on protocol request 18skiloaf. So let's not use it until R6. */ #ifdef HAVE_X11XTR6 XtSetLanguageProc (NULL, NULL, NULL); #endif { int argc = 0; char *argv[3]; argv[0] = ""; argc = 1; if (xrm_option) { argv[argc++] = "-xrm"; argv[argc++] = xrm_option; } dpy = XtOpenDisplay (Xt_app_con, XSTRING (display_name)->data, resource_name, EMACS_CLASS, emacs_options, XtNumber (emacs_options), &argc, argv); #ifdef HAVE_X11XTR6 setlocale (LC_NUMERIC, "C"); setlocale (LC_TIME, "C"); #endif } #else /* not USE_X_TOOLKIT */ #ifdef HAVE_X11R5 XSetLocaleModifiers (""); #endif dpy = XOpenDisplay (XSTRING (display_name)->data); #endif /* not USE_X_TOOLKIT */ /* Detect failure. */ if (dpy == 0) { UNBLOCK_INPUT; return 0; } /* We have definitely succeeded. Record the new connection. */ dpyinfo = (struct x_display_info *) xmalloc (sizeof (struct x_display_info)); #ifdef MULTI_KBOARD { struct x_display_info *share; Lisp_Object tail; for (share = x_display_list, tail = x_display_name_list; share; share = share->next, tail = XCONS (tail)->cdr) if (same_x_server (XSTRING (XCONS (XCONS (tail)->car)->car)->data, XSTRING (display_name)->data)) break; if (share) dpyinfo->kboard = share->kboard; else { dpyinfo->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); init_kboard (dpyinfo->kboard); if (!EQ (XSYMBOL (Qvendor_specific_keysyms)->function, Qunbound)) { char *vendor = ServerVendor (dpy); dpyinfo->kboard->Vsystem_key_alist = call1 (Qvendor_specific_keysyms, build_string (vendor ? vendor : "")); } dpyinfo->kboard->next_kboard = all_kboards; all_kboards = dpyinfo->kboard; /* Don't let the initial kboard remain current longer than necessary. That would cause problems if a file loaded on startup tries to prompt in the minibuffer. */ if (current_kboard == initial_kboard) current_kboard = dpyinfo->kboard; } dpyinfo->kboard->reference_count++; } #endif /* Put this display on the chain. */ dpyinfo->next = x_display_list; x_display_list = dpyinfo; /* Put it on x_display_name_list as well, to keep them parallel. */ x_display_name_list = Fcons (Fcons (display_name, Qnil), x_display_name_list); dpyinfo->name_list_element = XCONS (x_display_name_list)->car; dpyinfo->display = dpy; #if 0 XSetAfterFunction (x_current_display, x_trace_wire); #endif /* ! 0 */ dpyinfo->x_id_name = (char *) xmalloc (XSTRING (Vinvocation_name)->size + XSTRING (Vsystem_name)->size + 2); sprintf (dpyinfo->x_id_name, "%s@%s", XSTRING (Vinvocation_name)->data, XSTRING (Vsystem_name)->data); /* Figure out which modifier bits mean what. */ x_find_modifier_meanings (dpyinfo); /* Get the scroll bar cursor. */ dpyinfo->vertical_scroll_bar_cursor = XCreateFontCursor (dpyinfo->display, XC_sb_v_double_arrow); xrdb = x_load_resources (dpyinfo->display, xrm_option, resource_name, EMACS_CLASS); #ifdef HAVE_XRMSETDATABASE XrmSetDatabase (dpyinfo->display, xrdb); #else dpyinfo->display->db = xrdb; #endif /* Put the rdb where we can find it in a way that works on all versions. */ dpyinfo->xrdb = xrdb; dpyinfo->screen = ScreenOfDisplay (dpyinfo->display, DefaultScreen (dpyinfo->display)); dpyinfo->visual = select_visual (dpyinfo->display, dpyinfo->screen, &dpyinfo->n_planes); dpyinfo->height = HeightOfScreen (dpyinfo->screen); dpyinfo->width = WidthOfScreen (dpyinfo->screen); dpyinfo->root_window = RootWindowOfScreen (dpyinfo->screen); dpyinfo->grabbed = 0; dpyinfo->reference_count = 0; dpyinfo->icon_bitmap_id = -1; dpyinfo->n_fonts = 0; dpyinfo->font_table_size = 0; dpyinfo->bitmaps = 0; dpyinfo->bitmaps_size = 0; dpyinfo->bitmaps_last = 0; dpyinfo->scratch_cursor_gc = 0; dpyinfo->mouse_face_mouse_frame = 0; dpyinfo->mouse_face_deferred_gc = 0; dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; dpyinfo->mouse_face_face_id = 0; dpyinfo->mouse_face_window = Qnil; dpyinfo->mouse_face_mouse_x = dpyinfo->mouse_face_mouse_y = 0; dpyinfo->mouse_face_defer = 0; dpyinfo->x_focus_frame = 0; dpyinfo->x_focus_event_frame = 0; dpyinfo->x_highlight_frame = 0; dpyinfo->Xatom_wm_protocols = XInternAtom (dpyinfo->display, "WM_PROTOCOLS", False); dpyinfo->Xatom_wm_take_focus = XInternAtom (dpyinfo->display, "WM_TAKE_FOCUS", False); dpyinfo->Xatom_wm_save_yourself = XInternAtom (dpyinfo->display, "WM_SAVE_YOURSELF", False); dpyinfo->Xatom_wm_delete_window = XInternAtom (dpyinfo->display, "WM_DELETE_WINDOW", False); dpyinfo->Xatom_wm_change_state = XInternAtom (dpyinfo->display, "WM_CHANGE_STATE", False); dpyinfo->Xatom_wm_configure_denied = XInternAtom (dpyinfo->display, "WM_CONFIGURE_DENIED", False); dpyinfo->Xatom_wm_window_moved = XInternAtom (dpyinfo->display, "WM_MOVED", False); dpyinfo->Xatom_editres = XInternAtom (dpyinfo->display, "Editres", False); dpyinfo->Xatom_CLIPBOARD = XInternAtom (dpyinfo->display, "CLIPBOARD", False); dpyinfo->Xatom_TIMESTAMP = XInternAtom (dpyinfo->display, "TIMESTAMP", False); dpyinfo->Xatom_TEXT = XInternAtom (dpyinfo->display, "TEXT", False); dpyinfo->Xatom_DELETE = XInternAtom (dpyinfo->display, "DELETE", False); dpyinfo->Xatom_MULTIPLE = XInternAtom (dpyinfo->display, "MULTIPLE", False); dpyinfo->Xatom_INCR = XInternAtom (dpyinfo->display, "INCR", False); dpyinfo->Xatom_EMACS_TMP = XInternAtom (dpyinfo->display, "_EMACS_TMP_", False); dpyinfo->Xatom_TARGETS = XInternAtom (dpyinfo->display, "TARGETS", False); dpyinfo->Xatom_NULL = XInternAtom (dpyinfo->display, "NULL", False); dpyinfo->Xatom_ATOM_PAIR = XInternAtom (dpyinfo->display, "ATOM_PAIR", False); dpyinfo->cut_buffers_initialized = 0; connection = ConnectionNumber (dpyinfo->display); dpyinfo->connection = connection; #ifdef subprocesses /* This is only needed for distinguishing keyboard and process input. */ if (connection != 0) add_keyboard_wait_descriptor (connection); #endif #ifndef F_SETOWN_BUG #ifdef F_SETOWN #ifdef F_SETOWN_SOCK_NEG /* stdin is a socket here */ fcntl (connection, F_SETOWN, -getpid ()); #else /* ! defined (F_SETOWN_SOCK_NEG) */ fcntl (connection, F_SETOWN, getpid ()); #endif /* ! defined (F_SETOWN_SOCK_NEG) */ #endif /* ! defined (F_SETOWN) */ #endif /* F_SETOWN_BUG */ #ifdef SIGIO if (interrupt_input) init_sigio (connection); #endif /* ! defined (SIGIO) */ UNBLOCK_INPUT; return dpyinfo; } /* Get rid of display DPYINFO, assuming all frames are already gone, and without sending any more commands to the X server. */ void x_delete_display (dpyinfo) struct x_display_info *dpyinfo; { delete_keyboard_wait_descriptor (dpyinfo->connection); /* Discard this display from x_display_name_list and x_display_list. We can't use Fdelq because that can quit. */ if (! NILP (x_display_name_list) && EQ (XCONS (x_display_name_list)->car, dpyinfo->name_list_element)) x_display_name_list = XCONS (x_display_name_list)->cdr; else { Lisp_Object tail; tail = x_display_name_list; while (CONSP (tail) && CONSP (XCONS (tail)->cdr)) { if (EQ (XCONS (XCONS (tail)->cdr)->car, dpyinfo->name_list_element)) { XCONS (tail)->cdr = XCONS (XCONS (tail)->cdr)->cdr; break; } tail = XCONS (tail)->cdr; } } if (x_display_list == dpyinfo) x_display_list = dpyinfo->next; else { struct x_display_info *tail; for (tail = x_display_list; tail; tail = tail->next) if (tail->next == dpyinfo) tail->next = tail->next->next; } #ifndef USE_X_TOOLKIT /* I'm told Xt does this itself. */ #ifndef AIX /* On AIX, XCloseDisplay calls this. */ XrmDestroyDatabase (dpyinfo->xrdb); #endif #endif #ifdef MULTI_KBOARD if (--dpyinfo->kboard->reference_count == 0) delete_kboard (dpyinfo->kboard); #endif xfree (dpyinfo->font_table); xfree (dpyinfo->x_id_name); xfree (dpyinfo); } /* Set up use of X before we make the first connection. */ x_initialize () { clear_frame_hook = XTclear_frame; clear_end_of_line_hook = XTclear_end_of_line; ins_del_lines_hook = XTins_del_lines; change_line_highlight_hook = XTchange_line_highlight; insert_glyphs_hook = XTinsert_glyphs; write_glyphs_hook = XTwrite_glyphs; delete_glyphs_hook = XTdelete_glyphs; ring_bell_hook = XTring_bell; reset_terminal_modes_hook = XTreset_terminal_modes; set_terminal_modes_hook = XTset_terminal_modes; update_begin_hook = XTupdate_begin; update_end_hook = XTupdate_end; set_terminal_window_hook = XTset_terminal_window; read_socket_hook = XTread_socket; frame_up_to_date_hook = XTframe_up_to_date; cursor_to_hook = XTcursor_to; reassert_line_highlight_hook = XTreassert_line_highlight; mouse_position_hook = XTmouse_position; frame_rehighlight_hook = XTframe_rehighlight; frame_raise_lower_hook = XTframe_raise_lower; set_vertical_scroll_bar_hook = XTset_vertical_scroll_bar; condemn_scroll_bars_hook = XTcondemn_scroll_bars; redeem_scroll_bar_hook = XTredeem_scroll_bar; judge_scroll_bars_hook = XTjudge_scroll_bars; scroll_region_ok = 1; /* we'll scroll partial frames */ char_ins_del_ok = 0; /* just as fast to write the line */ line_ins_del_ok = 1; /* we'll just blt 'em */ fast_clear_end_of_line = 1; /* X does this well */ memory_below_frame = 0; /* we don't remember what scrolls off the bottom */ baud_rate = 19200; x_noop_count = 0; /* Try to use interrupt input; if we can't, then start polling. */ Fset_input_mode (Qt, Qnil, Qt, Qnil); #ifdef USE_X_TOOLKIT XtToolkitInitialize (); Xt_app_con = XtCreateApplicationContext (); XtAppSetFallbackResources (Xt_app_con, Xt_default_resources); #endif /* Note that there is no real way portable across R3/R4 to get the original error handler. */ XSetErrorHandler (x_error_quitter); XSetIOErrorHandler (x_io_error_quitter); /* Disable Window Change signals; they are handled by X events. */ #ifdef SIGWINCH signal (SIGWINCH, SIG_DFL); #endif /* ! defined (SIGWINCH) */ signal (SIGPIPE, x_connection_signal); } void syms_of_xterm () { staticpro (&x_display_name_list); x_display_name_list = Qnil; staticpro (&last_mouse_scroll_bar); last_mouse_scroll_bar = Qnil; staticpro (&Qvendor_specific_keysyms); Qvendor_specific_keysyms = intern ("vendor-specific-keysyms"); } #endif /* ! defined (HAVE_X_WINDOWS) */ emacs-19.30/src/gmalloc.c100444 12120 1 135776 6055530637 13545 0ustar rmsdaemon/* DO NOT EDIT THIS FILE -- it is automagically generated. -*- C -*- */ #define _MALLOC_INTERNAL /* The malloc headers and source files from the C library follow here. */ /* Declarations for `malloc' and friends. Copyright 1990, 1991, 1992, 1993, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_H #define _MALLOC_H 1 #ifdef _MALLOC_INTERNAL #ifdef HAVE_CONFIG_H #include #endif #if defined(_LIBC) || defined(STDC_HEADERS) || defined(USG) #include #else #ifndef memset #define memset(s, zero, n) bzero ((s), (n)) #endif #ifndef memcpy #define memcpy(d, s, n) bcopy ((s), (d), (n)) #endif #endif #if defined (__GNU_LIBRARY__) || (defined (__STDC__) && __STDC__) #include #else #ifndef CHAR_BIT #define CHAR_BIT 8 #endif #endif #ifdef HAVE_UNISTD_H #include #endif #endif /* _MALLOC_INTERNAL. */ #ifdef __cplusplus extern "C" { #endif #if defined (__cplusplus) || (defined (__STDC__) && __STDC__) #undef __P #define __P(args) args #undef __ptr_t #define __ptr_t void * #else /* Not C++ or ANSI C. */ #undef __P #define __P(args) () #undef const #define const #undef __ptr_t #define __ptr_t char * #endif /* C++ or ANSI C. */ #if defined (__STDC__) && __STDC__ #include #define __malloc_size_t size_t #define __malloc_ptrdiff_t ptrdiff_t #else #define __malloc_size_t unsigned int #define __malloc_ptrdiff_t int #endif #ifndef NULL #define NULL 0 #endif /* Allocate SIZE bytes of memory. */ extern __ptr_t malloc __P ((__malloc_size_t __size)); /* Re-allocate the previously allocated block in __ptr_t, making the new block SIZE bytes long. */ extern __ptr_t realloc __P ((__ptr_t __ptr, __malloc_size_t __size)); /* Allocate NMEMB elements of SIZE bytes each, all initialized to 0. */ extern __ptr_t calloc __P ((__malloc_size_t __nmemb, __malloc_size_t __size)); /* Free a block allocated by `malloc', `realloc' or `calloc'. */ extern void free __P ((__ptr_t __ptr)); /* Allocate SIZE bytes allocated to ALIGNMENT bytes. */ extern __ptr_t memalign __P ((__malloc_size_t __alignment, __malloc_size_t __size)); /* Allocate SIZE bytes on a page boundary. */ #if ! (defined (_MALLOC_INTERNAL) && defined (emacs)) /* Avoid conflict. */ extern __ptr_t valloc __P ((__malloc_size_t __size)); #endif #ifdef _MALLOC_INTERNAL /* The allocator divides the heap into blocks of fixed size; large requests receive one or more whole blocks, and small requests receive a fragment of a block. Fragment sizes are powers of two, and all fragments of a block are the same size. When all the fragments in a block have been freed, the block itself is freed. */ #define INT_BIT (CHAR_BIT * sizeof(int)) #define BLOCKLOG (INT_BIT > 16 ? 12 : 9) #define BLOCKSIZE (1 << BLOCKLOG) #define BLOCKIFY(SIZE) (((SIZE) + BLOCKSIZE - 1) / BLOCKSIZE) /* Determine the amount of memory spanned by the initial heap table (not an absolute limit). */ #define HEAP (INT_BIT > 16 ? 4194304 : 65536) /* Number of contiguous free blocks allowed to build up at the end of memory before they will be returned to the system. */ #define FINAL_FREE_BLOCKS 8 /* Data structure giving per-block information. */ typedef union { /* Heap information for a busy block. */ struct { /* Zero for a large (multiblock) object, or positive giving the logarithm to the base two of the fragment size. */ int type; union { struct { __malloc_size_t nfree; /* Free frags in a fragmented block. */ __malloc_size_t first; /* First free fragment of the block. */ } frag; /* For a large object, in its first block, this has the number of blocks in the object. In the other blocks, this has a negative number which says how far back the first block is. */ __malloc_ptrdiff_t size; } info; } busy; /* Heap information for a free block (that may be the first of a free cluster). */ struct { __malloc_size_t size; /* Size (in blocks) of a free cluster. */ __malloc_size_t next; /* Index of next free cluster. */ __malloc_size_t prev; /* Index of previous free cluster. */ } free; } malloc_info; /* Pointer to first block of the heap. */ extern char *_heapbase; /* Table indexed by block number giving per-block information. */ extern malloc_info *_heapinfo; /* Address to block number and vice versa. */ #define BLOCK(A) (((char *) (A) - _heapbase) / BLOCKSIZE + 1) #define ADDRESS(B) ((__ptr_t) (((B) - 1) * BLOCKSIZE + _heapbase)) /* Current search index for the heap table. */ extern __malloc_size_t _heapindex; /* Limit of valid info table indices. */ extern __malloc_size_t _heaplimit; /* Doubly linked lists of free fragments. */ struct list { struct list *next; struct list *prev; }; /* Free list headers for each fragment size. */ extern struct list _fraghead[]; /* List of blocks allocated with `memalign' (or `valloc'). */ struct alignlist { struct alignlist *next; __ptr_t aligned; /* The address that memaligned returned. */ __ptr_t exact; /* The address that malloc returned. */ }; extern struct alignlist *_aligned_blocks; /* Instrumentation. */ extern __malloc_size_t _chunks_used; extern __malloc_size_t _bytes_used; extern __malloc_size_t _chunks_free; extern __malloc_size_t _bytes_free; /* Internal versions of `malloc', `realloc', and `free' used when these functions need to call each other. They are the same but don't call the hooks. */ extern __ptr_t _malloc_internal __P ((__malloc_size_t __size)); extern __ptr_t _realloc_internal __P ((__ptr_t __ptr, __malloc_size_t __size)); extern void _free_internal __P ((__ptr_t __ptr)); #endif /* _MALLOC_INTERNAL. */ /* Given an address in the middle of a malloc'd object, return the address of the beginning of the object. */ extern __ptr_t malloc_find_object_address __P ((__ptr_t __ptr)); /* Underlying allocation function; successive calls should return contiguous pieces of memory. */ extern __ptr_t (*__morecore) __P ((__malloc_ptrdiff_t __size)); /* Default value of `__morecore'. */ extern __ptr_t __default_morecore __P ((__malloc_ptrdiff_t __size)); /* If not NULL, this function is called after each time `__morecore' is called to increase the data size. */ extern void (*__after_morecore_hook) __P ((void)); /* Number of extra blocks to get each time we ask for more core. This reduces the frequency of calling `(*__morecore)'. */ extern __malloc_size_t __malloc_extra_blocks; /* Nonzero if `malloc' has been called and done its initialization. */ extern int __malloc_initialized; /* Hooks for debugging versions. */ extern void (*__malloc_initialize_hook) __P ((void)); extern void (*__free_hook) __P ((__ptr_t __ptr)); extern __ptr_t (*__malloc_hook) __P ((__malloc_size_t __size)); extern __ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, __malloc_size_t __size)); extern __ptr_t (*__memalign_hook) __P ((__malloc_size_t __size, __malloc_size_t __alignment)); /* Return values for `mprobe': these are the kinds of inconsistencies that `mcheck' enables detection of. */ enum mcheck_status { MCHECK_DISABLED = -1, /* Consistency checking is not turned on. */ MCHECK_OK, /* Block is fine. */ MCHECK_FREE, /* Block freed twice. */ MCHECK_HEAD, /* Memory before the block was clobbered. */ MCHECK_TAIL /* Memory after the block was clobbered. */ }; /* Activate a standard collection of debugging hooks. This must be called before `malloc' is ever called. ABORTFUNC is called with an error code (see enum above) when an inconsistency is detected. If ABORTFUNC is null, the standard function prints on stderr and then calls `abort'. */ extern int mcheck __P ((void (*__abortfunc) __P ((enum mcheck_status)))); /* Check for aberrations in a particular malloc'd block. You must have called `mcheck' already. These are the same checks that `mcheck' does when you free or reallocate a block. */ extern enum mcheck_status mprobe __P ((__ptr_t __ptr)); /* Activate a standard collection of tracing hooks. */ extern void mtrace __P ((void)); extern void muntrace __P ((void)); /* Statistics available to the user. */ struct mstats { __malloc_size_t bytes_total; /* Total size of the heap. */ __malloc_size_t chunks_used; /* Chunks allocated by the user. */ __malloc_size_t bytes_used; /* Byte total of user-allocated chunks. */ __malloc_size_t chunks_free; /* Chunks in the free list. */ __malloc_size_t bytes_free; /* Byte total of chunks in the free list. */ }; /* Pick up the current statistics. */ extern struct mstats mstats __P ((void)); /* Call WARNFUN with a warning message when memory usage is high. */ extern void memory_warnings __P ((__ptr_t __start, void (*__warnfun) __P ((const char *)))); /* Relocating allocator. */ /* Allocate SIZE bytes, and store the address in *HANDLEPTR. */ extern __ptr_t r_alloc __P ((__ptr_t *__handleptr, __malloc_size_t __size)); /* Free the storage allocated in HANDLEPTR. */ extern void r_alloc_free __P ((__ptr_t *__handleptr)); /* Adjust the block at HANDLEPTR to be SIZE bytes long. */ extern __ptr_t r_re_alloc __P ((__ptr_t *__handleptr, __malloc_size_t __size)); #ifdef __cplusplus } #endif #endif /* malloc.h */ /* Memory allocator `malloc'. Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif #include /* How to really get more memory. */ __ptr_t (*__morecore) __P ((ptrdiff_t __size)) = __default_morecore; /* Debugging hook for `malloc'. */ __ptr_t (*__malloc_hook) __P ((__malloc_size_t __size)); /* Pointer to the base of the first block. */ char *_heapbase; /* Block information table. Allocated with align/__free (not malloc/free). */ malloc_info *_heapinfo; /* Number of info entries. */ static __malloc_size_t heapsize; /* Search index in the info table. */ __malloc_size_t _heapindex; /* Limit of valid info table indices. */ __malloc_size_t _heaplimit; /* Free lists for each fragment size. */ struct list _fraghead[BLOCKLOG]; /* Instrumentation. */ __malloc_size_t _chunks_used; __malloc_size_t _bytes_used; __malloc_size_t _chunks_free; __malloc_size_t _bytes_free; /* Are you experienced? */ int __malloc_initialized; __malloc_size_t __malloc_extra_blocks; void (*__malloc_initialize_hook) __P ((void)); void (*__after_morecore_hook) __P ((void)); /* Aligned allocation. */ static __ptr_t align __P ((__malloc_size_t)); static __ptr_t align (size) __malloc_size_t size; { __ptr_t result; unsigned long int adj; result = (*__morecore) (size); adj = (unsigned long int) ((unsigned long int) ((char *) result - (char *) NULL)) % BLOCKSIZE; if (adj != 0) { __ptr_t new; adj = BLOCKSIZE - adj; new = (*__morecore) (adj); result = (char *) result + adj; } if (__after_morecore_hook) (*__after_morecore_hook) (); return result; } /* Get SIZE bytes, if we can get them starting at END. Return the address of the space we got. If we cannot get space at END, fail and return -1. */ static __ptr_t get_contiguous_space __P ((__malloc_ptrdiff_t, __ptr_t)); static __ptr_t get_contiguous_space (size, position) __malloc_ptrdiff_t size; __ptr_t position; { __ptr_t before; __ptr_t after; before = (*__morecore) (0); /* If we can tell in advance that the break is at the wrong place, fail now. */ if (before != position) return 0; /* Allocate SIZE bytes and get the address of them. */ after = (*__morecore) (size); if (!after) return 0; /* It was not contiguous--reject it. */ if (after != position) { (*__morecore) (- size); return 0; } return after; } /* This is called when `_heapinfo' and `heapsize' have just been set to describe a new info table. Set up the table to describe itself and account for it in the statistics. */ static void register_heapinfo __P ((void)); #ifdef __GNUC__ __inline__ #endif static void register_heapinfo () { __malloc_size_t block, blocks; block = BLOCK (_heapinfo); blocks = BLOCKIFY (heapsize * sizeof (malloc_info)); /* Account for the _heapinfo block itself in the statistics. */ _bytes_used += blocks * BLOCKSIZE; ++_chunks_used; /* Describe the heapinfo block itself in the heapinfo. */ _heapinfo[block].busy.type = 0; _heapinfo[block].busy.info.size = blocks; /* Leave back-pointers for malloc_find_address. */ while (--blocks > 0) _heapinfo[block + blocks].busy.info.size = -blocks; } /* Set everything up and remember that we have. */ static int initialize __P ((void)); static int initialize () { if (__malloc_initialize_hook) (*__malloc_initialize_hook) (); heapsize = HEAP / BLOCKSIZE; _heapinfo = (malloc_info *) align (heapsize * sizeof (malloc_info)); if (_heapinfo == NULL) return 0; memset (_heapinfo, 0, heapsize * sizeof (malloc_info)); _heapinfo[0].free.size = 0; _heapinfo[0].free.next = _heapinfo[0].free.prev = 0; _heapindex = 0; _heapbase = (char *) _heapinfo; _heaplimit = BLOCK (_heapbase + heapsize * sizeof (malloc_info)); register_heapinfo (); __malloc_initialized = 1; return 1; } static int morecore_recursing; /* Get neatly aligned memory, initializing or growing the heap info table as necessary. */ static __ptr_t morecore __P ((__malloc_size_t)); static __ptr_t morecore (size) __malloc_size_t size; { __ptr_t result; malloc_info *newinfo, *oldinfo; __malloc_size_t newsize; if (morecore_recursing) /* Avoid recursion. The caller will know how to handle a null return. */ return NULL; result = align (size); if (result == NULL) return NULL; /* Check if we need to grow the info table. */ if ((__malloc_size_t) BLOCK ((char *) result + size) > heapsize) { /* Calculate the new _heapinfo table size. We do not account for the added blocks in the table itself, as we hope to place them in existing free space, which is already covered by part of the existing table. */ newsize = heapsize; do newsize *= 2; while ((__malloc_size_t) BLOCK ((char *) result + size) > newsize); /* First try to allocate the new info table in core we already have, in the usual way using realloc. If realloc cannot extend it in place or relocate it to existing sufficient core, we will get called again, and the code above will notice the `morecore_recursing' flag and return null. */ { int save = errno; /* Don't want to clobber errno with ENOMEM. */ morecore_recursing = 1; newinfo = (malloc_info *) _realloc_internal (_heapinfo, newsize * sizeof (malloc_info)); morecore_recursing = 0; if (newinfo == NULL) errno = save; else { /* We found some space in core, and realloc has put the old table's blocks on the free list. Now zero the new part of the table and install the new table location. */ memset (&newinfo[heapsize], 0, (newsize - heapsize) * sizeof (malloc_info)); _heapinfo = newinfo; heapsize = newsize; goto got_heap; } } /* Allocate new space for the malloc info table. */ while (1) { newinfo = (malloc_info *) align (newsize * sizeof (malloc_info)); /* Did it fail? */ if (newinfo == NULL) { (*__morecore) (-size); return NULL; } /* Is it big enough to record status for its own space? If so, we win. */ if ((__malloc_size_t) BLOCK ((char *) newinfo + newsize * sizeof (malloc_info)) < newsize) break; /* Must try again. First give back most of what we just got. */ (*__morecore) (- newsize * sizeof (malloc_info)); newsize *= 2; } /* Copy the old table to the beginning of the new, and zero the rest of the new table. */ memcpy (newinfo, _heapinfo, heapsize * sizeof (malloc_info)); memset (&newinfo[heapsize], 0, (newsize - heapsize) * sizeof (malloc_info)); oldinfo = _heapinfo; _heapinfo = newinfo; heapsize = newsize; register_heapinfo (); /* Reset _heaplimit so _free_internal never decides it can relocate or resize the info table. */ _heaplimit = 0; _free_internal (oldinfo); /* The new heap limit includes the new table just allocated. */ _heaplimit = BLOCK ((char *) newinfo + heapsize * sizeof (malloc_info)); return result; } got_heap: _heaplimit = BLOCK ((char *) result + size); return result; } /* Allocate memory from the heap. */ __ptr_t _malloc_internal (size) __malloc_size_t size; { __ptr_t result; __malloc_size_t block, blocks, lastblocks, start; register __malloc_size_t i; struct list *next; /* ANSI C allows `malloc (0)' to either return NULL, or to return a valid address you can realloc and free (though not dereference). It turns out that some extant code (sunrpc, at least Ultrix's version) expects `malloc (0)' to return non-NULL and breaks otherwise. Be compatible. */ #if 0 if (size == 0) return NULL; #endif if (!__malloc_initialized) if (!initialize ()) return NULL; if (size < sizeof (struct list)) size = sizeof (struct list); #ifdef SUNOS_LOCALTIME_BUG if (size < 16) size = 16; #endif /* Determine the allocation policy based on the request size. */ if (size <= BLOCKSIZE / 2) { /* Small allocation to receive a fragment of a block. Determine the logarithm to base two of the fragment size. */ register __malloc_size_t log = 1; --size; while ((size /= 2) != 0) ++log; /* Look in the fragment lists for a free fragment of the desired size. */ next = _fraghead[log].next; if (next != NULL) { /* There are free fragments of this size. Pop a fragment out of the fragment list and return it. Update the block's nfree and first counters. */ result = (__ptr_t) next; next->prev->next = next->next; if (next->next != NULL) next->next->prev = next->prev; block = BLOCK (result); if (--_heapinfo[block].busy.info.frag.nfree != 0) _heapinfo[block].busy.info.frag.first = (unsigned long int) ((unsigned long int) ((char *) next->next - (char *) NULL) % BLOCKSIZE) >> log; /* Update the statistics. */ ++_chunks_used; _bytes_used += 1 << log; --_chunks_free; _bytes_free -= 1 << log; } else { /* No free fragments of the desired size, so get a new block and break it into fragments, returning the first. */ result = malloc (BLOCKSIZE); if (result == NULL) return NULL; /* Link all fragments but the first into the free list. */ next = (struct list *) ((char *) result + (1 << log)); next->next = NULL; next->prev = &_fraghead[log]; _fraghead[log].next = next; for (i = 2; i < (__malloc_size_t) (BLOCKSIZE >> log); ++i) { next = (struct list *) ((char *) result + (i << log)); next->next = _fraghead[log].next; next->prev = &_fraghead[log]; next->prev->next = next; next->next->prev = next; } /* Initialize the nfree and first counters for this block. */ block = BLOCK (result); _heapinfo[block].busy.type = log; _heapinfo[block].busy.info.frag.nfree = i - 1; _heapinfo[block].busy.info.frag.first = i - 1; _chunks_free += (BLOCKSIZE >> log) - 1; _bytes_free += BLOCKSIZE - (1 << log); _bytes_used -= BLOCKSIZE - (1 << log); } } else { /* Large allocation to receive one or more blocks. Search the free list in a circle starting at the last place visited. If we loop completely around without finding a large enough space we will have to get more memory from the system. */ blocks = BLOCKIFY (size); start = block = _heapindex; while (_heapinfo[block].free.size < blocks) { block = _heapinfo[block].free.next; if (block == start) { /* Need to get more from the system. Get a little extra. */ __malloc_size_t wantblocks = blocks + __malloc_extra_blocks; block = _heapinfo[0].free.prev; lastblocks = _heapinfo[block].free.size; /* Check to see if the new core will be contiguous with the final free block; if so we don't need to get as much. */ if (_heaplimit != 0 && block + lastblocks == _heaplimit && /* We can't do this if we will have to make the heap info table bigger to accomodate the new space. */ block + wantblocks <= heapsize && get_contiguous_space ((wantblocks - lastblocks) * BLOCKSIZE, ADDRESS (block + lastblocks))) { /* We got it contiguously. Which block we are extending (the `final free block' referred to above) might have changed, if it got combined with a freed info table. */ block = _heapinfo[0].free.prev; _heapinfo[block].free.size += (wantblocks - lastblocks); _bytes_free += (wantblocks - lastblocks) * BLOCKSIZE; _heaplimit += wantblocks - lastblocks; continue; } result = morecore (wantblocks * BLOCKSIZE); if (result == NULL) return NULL; block = BLOCK (result); /* Put the new block at the end of the free list. */ _heapinfo[block].free.size = wantblocks; _heapinfo[block].free.prev = _heapinfo[0].free.prev; _heapinfo[block].free.next = 0; _heapinfo[0].free.prev = block; _heapinfo[_heapinfo[block].free.prev].free.next = block; ++_chunks_free; /* Now loop to use some of that block for this allocation. */ } } /* At this point we have found a suitable free list entry. Figure out how to remove what we need from the list. */ result = ADDRESS (block); if (_heapinfo[block].free.size > blocks) { /* The block we found has a bit left over, so relink the tail end back into the free list. */ _heapinfo[block + blocks].free.size = _heapinfo[block].free.size - blocks; _heapinfo[block + blocks].free.next = _heapinfo[block].free.next; _heapinfo[block + blocks].free.prev = _heapinfo[block].free.prev; _heapinfo[_heapinfo[block].free.prev].free.next = _heapinfo[_heapinfo[block].free.next].free.prev = _heapindex = block + blocks; } else { /* The block exactly matches our requirements, so just remove it from the list. */ _heapinfo[_heapinfo[block].free.next].free.prev = _heapinfo[block].free.prev; _heapinfo[_heapinfo[block].free.prev].free.next = _heapindex = _heapinfo[block].free.next; --_chunks_free; } _heapinfo[block].busy.type = 0; _heapinfo[block].busy.info.size = blocks; ++_chunks_used; _bytes_used += blocks * BLOCKSIZE; _bytes_free -= blocks * BLOCKSIZE; /* Mark all the blocks of the object just allocated except for the first with a negative number so you can find the first block by adding that adjustment. */ while (--blocks > 0) _heapinfo[block + blocks].busy.info.size = -blocks; } return result; } __ptr_t malloc (size) __malloc_size_t size; { return (__malloc_hook != NULL ? *__malloc_hook : _malloc_internal) (size); } #ifndef _LIBC /* On some ANSI C systems, some libc functions call _malloc, _free and _realloc. Make them use the GNU functions. */ __ptr_t _malloc (size) __malloc_size_t size; { return malloc (size); } void _free (ptr) __ptr_t ptr; { free (ptr); } __ptr_t _realloc (ptr, size) __ptr_t ptr; __malloc_size_t size; { return realloc (ptr, size); } #endif /* Free a block of memory allocated by `malloc'. Copyright 1990, 1991, 1992, 1994, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif /* Cope with systems lacking `memmove'. */ #ifndef memmove #if (defined (MEMMOVE_MISSING) || \ !defined(_LIBC) && !defined(STDC_HEADERS) && !defined(USG)) #ifdef emacs #undef __malloc_safe_bcopy #define __malloc_safe_bcopy safe_bcopy #endif /* This function is defined in realloc.c. */ extern void __malloc_safe_bcopy __P ((__ptr_t, __ptr_t, __malloc_size_t)); #define memmove(to, from, size) __malloc_safe_bcopy ((from), (to), (size)) #endif #endif /* Debugging hook for free. */ void (*__free_hook) __P ((__ptr_t __ptr)); /* List of blocks allocated by memalign. */ struct alignlist *_aligned_blocks = NULL; /* Return memory to the heap. Like `free' but don't call a __free_hook if there is one. */ void _free_internal (ptr) __ptr_t ptr; { int type; __malloc_size_t block, blocks; register __malloc_size_t i; struct list *prev, *next; __ptr_t curbrk; const __malloc_size_t lesscore_threshold /* Threshold of free space at which we will return some to the system. */ = FINAL_FREE_BLOCKS + 2 * __malloc_extra_blocks; register struct alignlist *l; if (ptr == NULL) return; for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == ptr) { l->aligned = NULL; /* Mark the slot in the list as free. */ ptr = l->exact; break; } block = BLOCK (ptr); type = _heapinfo[block].busy.type; switch (type) { case 0: /* Get as many statistics as early as we can. */ --_chunks_used; _bytes_used -= _heapinfo[block].busy.info.size * BLOCKSIZE; _bytes_free += _heapinfo[block].busy.info.size * BLOCKSIZE; /* Find the free cluster previous to this one in the free list. Start searching at the last block referenced; this may benefit programs with locality of allocation. */ i = _heapindex; if (i > block) while (i > block) i = _heapinfo[i].free.prev; else { do i = _heapinfo[i].free.next; while (i > 0 && i < block); i = _heapinfo[i].free.prev; } /* Determine how to link this block into the free list. */ if (block == i + _heapinfo[i].free.size) { /* Coalesce this block with its predecessor. */ _heapinfo[i].free.size += _heapinfo[block].busy.info.size; block = i; } else { /* Really link this block back into the free list. */ _heapinfo[block].free.size = _heapinfo[block].busy.info.size; _heapinfo[block].free.next = _heapinfo[i].free.next; _heapinfo[block].free.prev = i; _heapinfo[i].free.next = block; _heapinfo[_heapinfo[block].free.next].free.prev = block; ++_chunks_free; } /* Now that the block is linked in, see if we can coalesce it with its successor (by deleting its successor from the list and adding in its size). */ if (block + _heapinfo[block].free.size == _heapinfo[block].free.next) { _heapinfo[block].free.size += _heapinfo[_heapinfo[block].free.next].free.size; _heapinfo[block].free.next = _heapinfo[_heapinfo[block].free.next].free.next; _heapinfo[_heapinfo[block].free.next].free.prev = block; --_chunks_free; } /* How many trailing free blocks are there now? */ blocks = _heapinfo[block].free.size; /* Where is the current end of accessible core? */ curbrk = (*__morecore) (0); if (_heaplimit != 0 && curbrk == ADDRESS (_heaplimit)) { /* The end of the malloc heap is at the end of accessible core. It's possible that moving _heapinfo will allow us to return some space to the system. */ __malloc_size_t info_block = BLOCK (_heapinfo); __malloc_size_t info_blocks = _heapinfo[info_block].busy.info.size; __malloc_size_t prev_block = _heapinfo[block].free.prev; __malloc_size_t prev_blocks = _heapinfo[prev_block].free.size; __malloc_size_t next_block = _heapinfo[block].free.next; __malloc_size_t next_blocks = _heapinfo[next_block].free.size; if (/* Win if this block being freed is last in core, the info table is just before it, the previous free block is just before the info table, and the two free blocks together form a useful amount to return to the system. */ (block + blocks == _heaplimit && info_block + info_blocks == block && prev_block != 0 && prev_block + prev_blocks == info_block && blocks + prev_blocks >= lesscore_threshold) || /* Nope, not the case. We can also win if this block being freed is just before the info table, and the table extends to the end of core or is followed only by a free block, and the total free space is worth returning to the system. */ (block + blocks == info_block && ((info_block + info_blocks == _heaplimit && blocks >= lesscore_threshold) || (info_block + info_blocks == next_block && next_block + next_blocks == _heaplimit && blocks + next_blocks >= lesscore_threshold))) ) { malloc_info *newinfo; __malloc_size_t oldlimit = _heaplimit; /* Free the old info table, clearing _heaplimit to avoid recursion into this code. We don't want to return the table's blocks to the system before we have copied them to the new location. */ _heaplimit = 0; _free_internal (_heapinfo); _heaplimit = oldlimit; /* Tell malloc to search from the beginning of the heap for free blocks, so it doesn't reuse the ones just freed. */ _heapindex = 0; /* Allocate new space for the info table and move its data. */ newinfo = (malloc_info *) _malloc_internal (info_blocks * BLOCKSIZE); memmove (newinfo, _heapinfo, info_blocks * BLOCKSIZE); _heapinfo = newinfo; /* We should now have coalesced the free block with the blocks freed from the old info table. Examine the entire trailing free block to decide below whether to return some to the system. */ block = _heapinfo[0].free.prev; blocks = _heapinfo[block].free.size; } /* Now see if we can return stuff to the system. */ if (block + blocks == _heaplimit && blocks >= lesscore_threshold) { register __malloc_size_t bytes = blocks * BLOCKSIZE; _heaplimit -= blocks; (*__morecore) (-bytes); _heapinfo[_heapinfo[block].free.prev].free.next = _heapinfo[block].free.next; _heapinfo[_heapinfo[block].free.next].free.prev = _heapinfo[block].free.prev; block = _heapinfo[block].free.prev; --_chunks_free; _bytes_free -= bytes; } } /* Set the next search to begin at this block. */ _heapindex = block; break; default: /* Do some of the statistics. */ --_chunks_used; _bytes_used -= 1 << type; ++_chunks_free; _bytes_free += 1 << type; /* Get the address of the first free fragment in this block. */ prev = (struct list *) ((char *) ADDRESS (block) + (_heapinfo[block].busy.info.frag.first << type)); if (_heapinfo[block].busy.info.frag.nfree == (BLOCKSIZE >> type) - 1) { /* If all fragments of this block are free, remove them from the fragment list and free the whole block. */ next = prev; for (i = 1; i < (__malloc_size_t) (BLOCKSIZE >> type); ++i) next = next->next; prev->prev->next = next; if (next != NULL) next->prev = prev->prev; _heapinfo[block].busy.type = 0; _heapinfo[block].busy.info.size = 1; /* Keep the statistics accurate. */ ++_chunks_used; _bytes_used += BLOCKSIZE; _chunks_free -= BLOCKSIZE >> type; _bytes_free -= BLOCKSIZE; free (ADDRESS (block)); } else if (_heapinfo[block].busy.info.frag.nfree != 0) { /* If some fragments of this block are free, link this fragment into the fragment list after the first free fragment of this block. */ next = (struct list *) ptr; next->next = prev->next; next->prev = prev; prev->next = next; if (next->next != NULL) next->next->prev = next; ++_heapinfo[block].busy.info.frag.nfree; } else { /* No fragments of this block are free, so link this fragment into the fragment list and announce that it is the first free fragment of this block. */ prev = (struct list *) ptr; _heapinfo[block].busy.info.frag.nfree = 1; _heapinfo[block].busy.info.frag.first = (unsigned long int) ((unsigned long int) ((char *) ptr - (char *) NULL) % BLOCKSIZE >> type); prev->next = _fraghead[type].next; prev->prev = &_fraghead[type]; prev->prev->next = prev; if (prev->next != NULL) prev->next->prev = prev; } break; } } /* Return memory to the heap. */ void free (ptr) __ptr_t ptr; { if (__free_hook != NULL) (*__free_hook) (ptr); else _free_internal (ptr); } /* Define the `cfree' alias for `free'. */ #ifdef weak_alias weak_alias (free, cfree) #else void cfree (ptr) __ptr_t ptr; { free (ptr); } #endif /* Change the size of a block allocated by `malloc'. Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif /* Cope with systems lacking `memmove'. */ #if (defined (MEMMOVE_MISSING) || \ !defined(_LIBC) && !defined(STDC_HEADERS) && !defined(USG)) #ifdef emacs #undef __malloc_safe_bcopy #define __malloc_safe_bcopy safe_bcopy #else /* Snarfed directly from Emacs src/dispnew.c: XXX Should use system bcopy if it handles overlap. */ /* Like bcopy except never gets confused by overlap. */ void __malloc_safe_bcopy (afrom, ato, size) __ptr_t afrom; __ptr_t ato; __malloc_size_t size; { char *from = afrom, *to = ato; if (size <= 0 || from == to) return; /* If the source and destination don't overlap, then bcopy can handle it. If they do overlap, but the destination is lower in memory than the source, we'll assume bcopy can handle that. */ if (to < from || from + size <= to) bcopy (from, to, size); /* Otherwise, we'll copy from the end. */ else { register char *endf = from + size; register char *endt = to + size; /* If TO - FROM is large, then we should break the copy into nonoverlapping chunks of TO - FROM bytes each. However, if TO - FROM is small, then the bcopy function call overhead makes this not worth it. The crossover point could be about anywhere. Since I don't think the obvious copy loop is too bad, I'm trying to err in its favor. */ if (to - from < 64) { do *--endt = *--endf; while (endf != from); } else { for (;;) { endt -= (to - from); endf -= (to - from); if (endt < to) break; bcopy (endf, endt, to - from); } /* If SIZE wasn't a multiple of TO - FROM, there will be a little left over. The amount left over is (endt + (to - from)) - to, which is endt - from. */ bcopy (from, to, endt - from); } } } #endif /* emacs */ #ifndef memmove extern void __malloc_safe_bcopy __P ((__ptr_t, __ptr_t, __malloc_size_t)); #define memmove(to, from, size) __malloc_safe_bcopy ((from), (to), (size)) #endif #endif #define min(A, B) ((A) < (B) ? (A) : (B)) /* Debugging hook for realloc. */ __ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, __malloc_size_t __size)); /* Resize the given region to the new size, returning a pointer to the (possibly moved) region. This is optimized for speed; some benchmarks seem to indicate that greater compactness is achieved by unconditionally allocating and copying to a new region. This module has incestuous knowledge of the internals of both free and malloc. */ __ptr_t _realloc_internal (ptr, size) __ptr_t ptr; __malloc_size_t size; { __ptr_t result; int type; __malloc_size_t block, blocks, oldlimit; if (size == 0) { _free_internal (ptr); return _malloc_internal (0); } else if (ptr == NULL) return _malloc_internal (size); block = BLOCK (ptr); type = _heapinfo[block].busy.type; switch (type) { case 0: /* Maybe reallocate a large block to a small fragment. */ if (size <= BLOCKSIZE / 2) { result = _malloc_internal (size); if (result != NULL) { memcpy (result, ptr, size); _free_internal (ptr); return result; } } /* The new size is a large allocation as well; see if we can hold it in place. */ blocks = BLOCKIFY (size); if (blocks < _heapinfo[block].busy.info.size) { /* The new size is smaller; return excess memory to the free list. */ _heapinfo[block + blocks].busy.type = 0; _heapinfo[block + blocks].busy.info.size = _heapinfo[block].busy.info.size - blocks; _heapinfo[block].busy.info.size = blocks; /* We have just created a new chunk by splitting a chunk in two. Now we will free this chunk; increment the statistics counter so it doesn't become wrong when _free_internal decrements it. */ ++_chunks_used; _free_internal (ADDRESS (block + blocks)); result = ptr; } else if (blocks == _heapinfo[block].busy.info.size) /* No size change necessary. */ result = ptr; else { /* Won't fit, so allocate a new region that will. Free the old region first in case there is sufficient adjacent free space to grow without moving. */ blocks = _heapinfo[block].busy.info.size; /* Prevent free from actually returning memory to the system. */ oldlimit = _heaplimit; _heaplimit = 0; _free_internal (ptr); _heaplimit = oldlimit; result = _malloc_internal (size); if (result == NULL) { /* Now we're really in trouble. We have to unfree the thing we just freed. Unfortunately it might have been coalesced with its neighbors. */ if (_heapindex == block) (void) _malloc_internal (blocks * BLOCKSIZE); else { __ptr_t previous = _malloc_internal ((block - _heapindex) * BLOCKSIZE); (void) _malloc_internal (blocks * BLOCKSIZE); _free_internal (previous); } return NULL; } if (ptr != result) memmove (result, ptr, blocks * BLOCKSIZE); } break; default: /* Old size is a fragment; type is logarithm to base two of the fragment size. */ if (size > (__malloc_size_t) (1 << (type - 1)) && size <= (__malloc_size_t) (1 << type)) /* The new size is the same kind of fragment. */ result = ptr; else { /* The new size is different; allocate a new space, and copy the lesser of the new size and the old. */ result = _malloc_internal (size); if (result == NULL) return NULL; memcpy (result, ptr, min (size, (__malloc_size_t) 1 << type)); _free_internal (ptr); } break; } return result; } __ptr_t realloc (ptr, size) __ptr_t ptr; __malloc_size_t size; { return (__realloc_hook != NULL ? *__realloc_hook : _realloc_internal) (ptr, size); } /* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif /* Allocate an array of NMEMB elements each SIZE bytes long. The entire array is initialized to zeros. */ __ptr_t calloc (nmemb, size) register __malloc_size_t nmemb; register __malloc_size_t size; { register __ptr_t result = malloc (nmemb * size); if (result != NULL) (void) memset (result, 0, nmemb * size); return result; } /* Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. This file is part of the GNU C Library. The GNU C Library 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. The GNU C Library 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 the GNU C Library; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif #ifndef __GNU_LIBRARY__ #define __sbrk sbrk #endif #ifdef __GNU_LIBRARY__ /* It is best not to declare this and cast its result on foreign operating systems with potentially hostile include files. */ #include extern __ptr_t __sbrk __P ((ptrdiff_t increment)); #endif #ifndef NULL #define NULL 0 #endif /* Allocate INCREMENT more bytes of data space, and return the start of data space, or NULL on errors. If INCREMENT is negative, shrink data space. */ __ptr_t __default_morecore (increment) __malloc_ptrdiff_t increment; { __ptr_t result = (__ptr_t) __sbrk (increment); if (result == (__ptr_t) -1) return NULL; return result; } /* Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif __ptr_t (*__memalign_hook) __P ((size_t __size, size_t __alignment)); __ptr_t memalign (alignment, size) __malloc_size_t alignment; __malloc_size_t size; { __ptr_t result; unsigned long int adj, lastadj; if (__memalign_hook) return (*__memalign_hook) (alignment, size); /* Allocate a block with enough extra space to pad the block with up to (ALIGNMENT - 1) bytes if necessary. */ result = malloc (size + alignment - 1); if (result == NULL) return NULL; /* Figure out how much we will need to pad this particular block to achieve the required alignment. */ adj = (unsigned long int) ((char *) result - (char *) NULL) % alignment; do { /* Reallocate the block with only as much excess as it needs. */ free (result); result = malloc (adj + size); if (result == NULL) /* Impossible unless interrupted. */ return NULL; lastadj = adj; adj = (unsigned long int) ((char *) result - (char *) NULL) % alignment; /* It's conceivable we might have been so unlucky as to get a different block with weaker alignment. If so, this block is too short to contain SIZE after alignment correction. So we must try again and get another block, slightly larger. */ } while (adj > lastadj); if (adj != 0) { /* Record this block in the list of aligned blocks, so that `free' can identify the pointer it is passed, which will be in the middle of an allocated block. */ struct alignlist *l; for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == NULL) /* This slot is free. Use it. */ break; if (l == NULL) { l = (struct alignlist *) malloc (sizeof (struct alignlist)); if (l == NULL) { free (result); return NULL; } l->next = _aligned_blocks; _aligned_blocks = l; } l->exact = result; result = l->aligned = (char *) result + alignment - adj; } return result; } emacs-19.30/src/acldef.h100444 12241 12 2043 5444474534 13636 0ustar rolandstaff#define ACL$K_LENGTH 12 #define ACL$C_LENGTH 12 #define ACL$C_FILE 1 #define ACL$C_DEVICE 2 #define ACL$C_JOBCTL_QUEUE 3 #define ACL$C_COMMON_EF_CLUSTER 4 #define ACL$C_LOGICAL_NAME_TABLE 5 #define ACL$C_PROCESS 6 #define ACL$C_GROUP_GLOBAL_SECTION 7 #define ACL$C_SYSTEM_GLOBAL_SECTION 8 #define ACL$C_ADDACLENT 1 #define ACL$C_DELACLENT 2 #define ACL$C_MODACLENT 3 #define ACL$C_FNDACLENT 4 #define ACL$C_FNDACETYP 5 #define ACL$C_DELETEACL 6 #define ACL$C_READACL 7 #define ACL$C_ACLLENGTH 8 #define ACL$C_READACE 9 #define ACL$C_RLOCK_ACL 10 #define ACL$C_WLOCK_ACL 11 #define ACL$C_UNLOCK_ACL 12 #define ACL$S_ADDACLENT 255 #define ACL$S_DELACLENT 255 #define ACL$S_MODACLENT 255 #define ACL$S_FNDACLENT 255 #define ACL$S_FNDACETYP 255 #define ACL$S_DELETEACL 255 #define ACL$S_READACL 512 #define ACL$S_ACLLENGTH 4 #define ACL$S_READACE 255 #define ACL$S_RLOCK_ACL 4 #define ACL$S_WLOCK_ACL 4 #define ACL$S_UNLOCK_ACL 4 #define ACL$S_ACLDEF 16 #define ACL$L_FLINK 0 #define ACL$L_BLINK 4 #define ACL$W_SIZE 8 #define ACL$B_TYPE 10 #define ACL$L_LIST 12 emacs-19.30/src/blockinput.h100444 12241 12 6302 5444474535 14575 0ustar rolandstaff/* blockinput.h - interface to blocking complicated interrupt-driven input. Copyright (C) 1989, 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. */ /* When Emacs is using signal-driven input, the processing of those input signals can get pretty hairy. For example, when Emacs is running under X windows, handling an input signal can entail retrieving events from the X event queue, or making other X calls. If an input signal occurs while Emacs is in the midst of some non-reentrant code, and the signal processing invokes that same code, we lose. For example, malloc and the Xlib functions aren't usually re-entrant, and both are used by the X input signal handler - if we try to process an input signal in the midst of executing any of these functions, we'll lose. To avoid this, we make the following requirements: * Everyone must evaluate BLOCK_INPUT before entering these functions, and then call UNBLOCK_INPUT after performing them. Calls BLOCK_INPUT and UNBLOCK_INPUT may be nested. * Any complicated interrupt handling code should test interrupt_input_blocked, and put off its work until later. * If the interrupt handling code wishes, it may set interrupt_input_pending to a non-zero value. If that flag is set when input becomes unblocked, UNBLOCK_INPUT will send a new SIGIO. */ extern int interrupt_input_blocked; /* Nonzero means an input interrupt has arrived during the current critical section. */ extern int interrupt_input_pending; /* Begin critical section. */ #define BLOCK_INPUT (interrupt_input_blocked++) /* End critical section. If doing signal-driven input, and a signal came in when input was blocked, reinvoke the signal handler now to deal with it. We used to have two possible definitions of this macro - one for when SIGIO was #defined, and one for when it wasn't; when SIGIO wasn't #defined, we wouldn't bother to check if we should re-invoke the signal handler. But that doesn't work very well; some of the files which use this macro don't #include the right files to get SIGIO. So, we always test interrupt_input_pending now; that's not too expensive, and it'll never get set if we don't need to resignal. */ #define UNBLOCK_INPUT \ (interrupt_input_blocked--, \ (interrupt_input_blocked < 0 ? (abort (), 0) : 0), \ ((interrupt_input_blocked == 0 && interrupt_input_pending != 0) \ ? (reinvoke_input_signal (), 0) \ : 0)) #define TOTALLY_UNBLOCK_INPUT (interrupt_input_blocked = 0) #define UNBLOCK_INPUT_RESIGNAL UNBLOCK_INPUT emacs-19.30/src/buffer.h100444 12120 1 47157 6042027306 13346 0ustar rmsdaemon/* Header file for the buffer manipulation primitives. Copyright (C) 1985, 1986, 1993, 1994, 1995 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. */ #ifdef USE_TEXT_PROPERTIES #define SET_PT(position) (set_point ((position), current_buffer)) #define TEMP_SET_PT(position) (temp_set_point ((position), current_buffer)) #define BUF_SET_PT(buffer, position) (set_point ((position), (buffer))) #define BUF_TEMP_SET_PT(buffer, position) (temp_set_point ((position), (buffer))) #else /* don't support text properties */ #define SET_PT(position) (current_buffer->pt = (position)) #define TEMP_SET_PT(position) (current_buffer->pt = (position)) #define BUF_SET_PT(buffer, position) (buffer->pt = (position)) #define BUF_TEMP_SET_PT(buffer, position) (buffer->pt = (position)) #endif /* don't support text properties */ /* Character position of beginning of buffer. */ #define BEG (1) /* Character position of beginning of accessible range of buffer. */ #define BEGV (current_buffer->begv) /* Character position of point in buffer. The "+ 0" makes this not an l-value, so you can't assign to it. Use SET_PT instead. */ #define PT (current_buffer->pt + 0) /* Character position of gap in buffer. */ #define GPT (current_buffer->text->gpt) /* Character position of end of accessible range of buffer. */ #define ZV (current_buffer->zv) /* Character position of end of buffer. */ #define Z (current_buffer->text->z) /* Is the current buffer narrowed? */ #define NARROWED ((BEGV != BEG) || (ZV != Z)) /* Modification count. */ #define MODIFF (current_buffer->text->modiff) /* Modification count as of last visit or save. */ #define SAVE_MODIFF (current_buffer->text->save_modiff) /* Address of beginning of buffer. */ #define BEG_ADDR (current_buffer->text->beg) /* Address of beginning of accessible range of buffer. */ #define BEGV_ADDR (&FETCH_CHAR (current_buffer->begv)) /* Address of point in buffer. */ #define PT_ADDR (&FETCH_CHAR (current_buffer->pt)) /* Address of beginning of gap in buffer. */ #define GPT_ADDR (current_buffer->text->beg + current_buffer->text->gpt - 1) /* Address of end of gap in buffer. */ #define GAP_END_ADDR (current_buffer->text->beg + current_buffer->text->gpt + current_buffer->text->gap_size - 1) /* Address of end of accessible range of buffer. */ #define ZV_ADDR (&FETCH_CHAR (current_buffer->zv)) /* Size of gap. */ #define GAP_SIZE (current_buffer->text->gap_size) /* Now similar macros for a specified buffer. Note that many of these evaluate the buffer argument more than once. */ /* Character position of beginning of buffer. */ #define BUF_BEG(buf) (1) /* Character position of beginning of accessible range of buffer. */ #define BUF_BEGV(buf) ((buf)->begv) /* Character position of point in buffer. */ #define BUF_PT(buf) ((buf)->pt) /* Character position of gap in buffer. */ #define BUF_GPT(buf) ((buf)->text->gpt) /* Character position of end of accessible range of buffer. */ #define BUF_ZV(buf) ((buf)->zv) /* Character position of end of buffer. */ #define BUF_Z(buf) ((buf)->text->z) /* Is this buffer narrowed? */ #define BUF_NARROWED(buf) ((BUF_BEGV (buf) != BUF_BEG (buf)) \ || (BUF_ZV (buf) != BUF_Z (buf))) /* Modification count. */ #define BUF_MODIFF(buf) ((buf)->text->modiff) /* Modification count as of last visit or save. */ #define BUF_SAVE_MODIFF(buf) ((buf)->text->save_modiff) /* Interval tree of buffer. */ #define BUF_INTERVALS(buf) ((buf)->text->intervals) /* Marker chain of buffer. */ #define BUF_MARKERS(buf) ((buf)->text->markers) /* Address of beginning of buffer. */ #define BUF_BEG_ADDR(buf) ((buf)->text->beg) /* Macro for setting the value of BUF_ZV (BUF) to VALUE, by varying the end of the accessible region. */ #define SET_BUF_ZV(buf, value) ((buf)->zv = (value)) #define SET_BUF_PT(buf, value) ((buf)->pt = (value)) /* Size of gap. */ #define BUF_GAP_SIZE(buf) ((buf)->text->gap_size) /* Return the address of character at position POS in buffer BUF. Note that both arguments can be computed more than once. */ #define BUF_CHAR_ADDRESS(buf, pos) \ ((buf)->text->beg + (pos) - 1 \ + ((pos) >= (buf)->text->gpt ? (buf)->text->gap_size : 0)) /* Convert the address of a char in the buffer into a character position. */ #define PTR_CHAR_POS(ptr) \ ((ptr) - (current_buffer)->text->beg \ - (ptr - (current_buffer)->text->beg < (unsigned) GPT ? 0 : GAP_SIZE) \ + 1) /* Convert the address of a char in the buffer into a character position. */ #define BUF_PTR_CHAR_POS(buf, ptr) \ ((ptr) - (buf)->text->beg \ - (ptr - (buf)->text->beg < (unsigned) BUF_GPT ((buf)) \ ? 0 : BUF_GAP_SIZE ((buf))) \ + 1) struct buffer_text { unsigned char *beg; /* Actual address of buffer contents. */ int gpt; /* Index of gap in buffer. */ int z; /* Index of end of buffer. */ int gap_size; /* Size of buffer's gap. */ int modiff; /* This counts buffer-modification events for this buffer. It is incremented for each such event, and never otherwise changed. */ int save_modiff; /* Previous value of modiff, as of last time buffer visited or saved a file. */ /* Properties of this buffer's text -- conditionally compiled. */ DECLARE_INTERVALS /* The markers that refer to this buffer. This is actually a single marker --- successive elements in its marker `chain' are the other markers referring to this buffer. */ Lisp_Object markers; }; struct buffer { /* Everything before the `name' slot must be of a non-Lisp_Object type, and every slot after `name' must be a Lisp_Object. Check out mark_buffer (alloc.c) to see why. */ EMACS_INT size; /* Next buffer, in chain of all buffers including killed buffers. This chain is used only for garbage collection, in order to collect killed buffers properly. Note that vectors and most pseudovectors are all on one chain, but buffers are on a separate chain of their own. */ struct buffer *next; /* This structure holds the coordinates of the buffer contents in ordinary buffers. In indirect buffers, this is not used. */ struct buffer_text own_text; /* This points to the `struct buffer_text' that used for this buffer. In an ordinary buffer, this is the own_text field above. In an indirect buffer, this is the own_text field of another buffer. */ struct buffer_text *text; /* Position of point in buffer. */ int pt; /* Index of beginning of accessible range. */ int begv; /* Index of end of accessible range. */ int zv; /* In an indirect buffer, this points to the base buffer. In an ordinary buffer, it is 0. */ struct buffer *base_buffer; /* Flags saying which DEFVAR_PER_BUFFER variables are local to this buffer. */ int local_var_flags; /* Set to the modtime of the visited file when read or written. -1 means visited file was nonexistent. 0 means visited file modtime unknown; in no case complain about any mismatch on next save attempt. */ int modtime; /* the value of text->modiff at the last auto-save. */ int auto_save_modified; /* The time at which we detected a failure to auto-save, Or -1 if we didn't have a failure. */ int auto_save_failure_time; /* Position in buffer at which display started the last time this buffer was displayed. */ int last_window_start; /* Set nonzero whenever the narrowing is changed in this buffer. */ int clip_changed; /* If the long line scan cache is enabled (i.e. the buffer-local variable cache-long-line-scans is non-nil), newline_cache points to the newline cache, and width_run_cache points to the width run cache. The newline cache records which stretches of the buffer are known *not* to contain newlines, so that they can be skipped quickly when we search for newlines. The width run cache records which stretches of the buffer are known to contain characters whose widths are all the same. If the width run cache maps a character to a value > 0, that value is the character's width; if it maps a character to zero, we don't know what its width is. This allows compute_motion to process such regions very quickly, using algebra instead of inspecting each character. See also width_table, below. */ struct region_cache *newline_cache; struct region_cache *width_run_cache; /* Everything from here down must be a Lisp_Object */ /* The name of this buffer. */ Lisp_Object name; /* The name of the file visited in this buffer, or nil. */ Lisp_Object filename; /* Dir for expanding relative file names. */ Lisp_Object directory; /* True iff this buffer has been backed up (if you write to the visited file and it hasn't been backed up, then a backup will be made). */ /* This isn't really used by the C code, so could be deleted. */ Lisp_Object backed_up; /* Length of file when last read or saved. This is not in the struct buffer_text because it's not used in indirect buffers at all. */ Lisp_Object save_length; /* File name used for auto-saving this buffer. This is not in the struct buffer_text because it's not used in indirect buffers at all. */ Lisp_Object auto_save_file_name; /* Non-nil if buffer read-only. */ Lisp_Object read_only; /* "The mark". This is a marker which may point into this buffer or may point nowhere. */ Lisp_Object mark; /* Alist of elements (SYMBOL . VALUE-IN-THIS-BUFFER) for all per-buffer variables of this buffer. */ Lisp_Object local_var_alist; /* Symbol naming major mode (eg, lisp-mode). */ Lisp_Object major_mode; /* Pretty name of major mode (eg, "Lisp"). */ Lisp_Object mode_name; /* Mode line element that controls format of mode line. */ Lisp_Object mode_line_format; /* Keys that are bound local to this buffer. */ Lisp_Object keymap; /* This buffer's local abbrev table. */ Lisp_Object abbrev_table; /* This buffer's syntax table. */ Lisp_Object syntax_table; /* Values of several buffer-local variables */ /* tab-width is buffer-local so that redisplay can find it in buffers that are not current */ Lisp_Object case_fold_search; Lisp_Object tab_width; Lisp_Object fill_column; Lisp_Object left_margin; /* Function to call when insert space past fill column. */ Lisp_Object auto_fill_function; /* nil: text, t: binary. This value is meaningful only on certain operating systems. */ Lisp_Object buffer_file_type; /* Case table for case-conversion in this buffer. This char-table maps each char into its lower-case version. */ Lisp_Object downcase_table; /* Char-table mapping each char to its upper-case version. */ Lisp_Object upcase_table; /* Char-table for conversion for case-folding search. */ Lisp_Object case_canon_table; /* Char-table of equivalences for case-folding search. */ Lisp_Object case_eqv_table; /* Non-nil means do not display continuation lines. */ Lisp_Object truncate_lines; /* Non-nil means display ctl chars with uparrow. */ Lisp_Object ctl_arrow; /* Non-nil means do selective display; see doc string in syms_of_buffer (buffer.c) for details. */ Lisp_Object selective_display; #ifndef old /* Non-nil means show ... at end of line followed by invisible lines. */ Lisp_Object selective_display_ellipses; #endif /* Alist of (FUNCTION . STRING) for each minor mode enabled in buffer. */ Lisp_Object minor_modes; /* t if "self-insertion" should overwrite; `binary' if it should also overwrite newlines and tabs - for editing executables and the like. */ Lisp_Object overwrite_mode; /* non-nil means abbrev mode is on. Expand abbrevs automatically. */ Lisp_Object abbrev_mode; /* Display table to use for text in this buffer. */ Lisp_Object display_table; /* t means the mark and region are currently active. */ Lisp_Object mark_active; /* Changes in the buffer are recorded here for undo. t means don't record anything. This information belongs to the base buffer of an indirect buffer, But we can't store it in the struct buffer_text because local variables have to be right in the struct buffer. So we copy it around in set_buffer_internal. */ Lisp_Object undo_list; /* List of overlays that end at or before the current center, in order of end-position. */ Lisp_Object overlays_before; /* List of overlays that end after the current center, in order of start-position. */ Lisp_Object overlays_after; /* Position where the overlay lists are centered. */ Lisp_Object overlay_center; /* Lisp of symbols naming the file format used for visited file. */ Lisp_Object file_format; /* True if the newline position cache and width run cache are enabled. See search.c and indent.c. */ Lisp_Object cache_long_line_scans; /* If the width run cache is enabled, this table contains the character widths width_run_cache (see above) assumes. When we do a thorough redisplay, we compare this against the buffer's current display table to see whether the display table has affected the widths of any characters. If it has, we invalidate the width run cache, and re-initialize width_table. */ Lisp_Object width_table; /* In an indirect buffer, or a buffer that is the base of an indirect buffer, this holds a marker that records PT for this buffer when the buffer is not current. */ Lisp_Object pt_marker; /* In an indirect buffer, or a buffer that is the base of an indirect buffer, this holds a marker that records BEGV for this buffer when the buffer is not current. */ Lisp_Object begv_marker; /* In an indirect buffer, or a buffer that is the base of an indirect buffer, this holds a marker that records ZV for this buffer when the buffer is not current. */ Lisp_Object zv_marker; /* This holds the point value before the last scroll operation. Explicitly setting point sets this to nil. */ Lisp_Object point_before_scroll; /* Truename of the visited file, or nil. */ Lisp_Object file_truename; /* Invisibility spec of this buffer. t => any non-nil `invisible' property means invisible. A list => `invisible' property means invisible if it is memq in that list. */ Lisp_Object invisibility_spec; /* If redisplay goes beyond this point in the buffer, run redisplay-end-trigger-hook. */ Lisp_Object redisplay_end_trigger; /* These are so we don't have to recompile everything the next few times we add a new slot. */ Lisp_Object extra1, extra2, extra3; }; /* This points to the current buffer. */ extern struct buffer *current_buffer; /* This structure holds the default values of the buffer-local variables that have special slots in each buffer. The default value occupies the same slot in this structure as an individual buffer's value occupies in that buffer. Setting the default value also goes through the alist of buffers and stores into each buffer that does not say it has a local value. */ extern struct buffer buffer_defaults; /* This structure marks which slots in a buffer have corresponding default values in buffer_defaults. Each such slot has a nonzero value in this structure. The value has only one nonzero bit. When a buffer has its own local value for a slot, the bit for that slot (found in the same slot in this structure) is turned on in the buffer's local_var_flags slot. If a slot in this structure is zero, then even though there may be a Lisp-level local variable for the slot, it has no default value, and the corresponding slot in buffer_defaults is not used. */ extern struct buffer buffer_local_flags; /* For each buffer slot, this points to the Lisp symbol name for that slot in the current buffer. It is 0 for slots that don't have such names. */ extern struct buffer buffer_local_symbols; /* This structure holds the required types for the values in the buffer-local slots. If a slot contains Qnil, then the corresponding buffer slot may contain a value of any type. If a slot contains an integer, then prospective values' tags must be equal to that integer. When a tag does not match, the function buffer_slot_type_mismatch will signal an error. The value Qnil may always be safely stored in any slot. */ extern struct buffer buffer_local_types; /* Point in the current buffer. This is an obsolete alias and should be eliminated. */ #define point (current_buffer->pt + 0) /* Return character at position n. No range checking. */ #define FETCH_CHAR(n) *(((n)>= GPT ? GAP_SIZE : 0) + (n) + BEG_ADDR - 1) /* BUFFER_CEILING_OF (resp. BUFFER_FLOOR_OF), when applied to n, return the max (resp. min) p such that &FETCH_CHAR (p) - &FETCH_CHAR (n) == p - n */ #define BUFFER_CEILING_OF(n) (((n) < GPT && GPT < ZV ? GPT : ZV) - 1) #define BUFFER_FLOOR_OF(n) (BEGV <= GPT && GPT <= (n) ? GPT : BEGV) extern void reset_buffer (); extern void evaporate_overlays (); extern Lisp_Object Fbuffer_name (); extern Lisp_Object Fget_file_buffer (); extern Lisp_Object Fnext_overlay_change (); extern Lisp_Object Fdelete_overlay (); /* Functions to call before and after each text change. */ extern Lisp_Object Vbefore_change_function; extern Lisp_Object Vafter_change_function; extern Lisp_Object Vbefore_change_functions; extern Lisp_Object Vafter_change_functions; extern Lisp_Object Vfirst_change_hook; extern Lisp_Object Qbefore_change_functions; extern Lisp_Object Qafter_change_functions; extern Lisp_Object Qfirst_change_hook; extern Lisp_Object Vdeactivate_mark; extern Lisp_Object Vtransient_mark_mode; /* Overlays */ /* 1 if the OV is an overlay object. */ #define OVERLAY_VALID(OV) (OVERLAYP (OV)) /* Return the marker that stands for where OV starts in the buffer. */ #define OVERLAY_START(OV) (XOVERLAY (OV)->start) /* Return the marker that stands for where OV ends in the buffer. */ #define OVERLAY_END(OV) (XOVERLAY (OV)->end) /* Return the actual buffer position for the marker P. We assume you know which buffer it's pointing into. */ #define OVERLAY_POSITION(P) \ (GC_MARKERP (P) ? marker_position (P) : (abort (), 0)) /* Allocation of buffer text. */ #ifdef REL_ALLOC #define BUFFER_ALLOC(data,size) ((unsigned char *) r_alloc (&data, (size))) #define BUFFER_REALLOC(data,size) ((unsigned char *) r_re_alloc (&data, (size))) #define BUFFER_FREE(data) (r_alloc_free (&data)) #define R_ALLOC_DECLARE(var,data) (r_alloc_declare (&var, (data))) #else #define BUFFER_ALLOC(data,size) (data = (unsigned char *) malloc ((size))) #define BUFFER_REALLOC(data,size) ((unsigned char *) realloc ((data), (size))) #define BUFFER_FREE(data) (free ((data))) #define R_ALLOC_DECLARE(var,data) #endif emacs-19.30/src/chpdef.h100444 12241 12 1565 5444474543 13661 0ustar rolandstaff#define CHP$_END 0 #define CHP$_ACCESS 1 #define CHP$_FLAGS 2 #define CHP$_PRIV 3 #define CHP$_ACMODE 4 #define CHP$_ACCLASS 5 #define CHP$_RIGHTS 6 #define CHP$_ADDRIGHTS 7 #define CHP$_MODE 8 #define CHP$_MODES 9 #define CHP$_MINCLASS 10 #define CHP$_MAXCLASS 11 #define CHP$_OWNER 12 #define CHP$_PROT 13 #define CHP$_ACL 14 #define CHP$_AUDITNAME 15 #define CHP$_ALARMNAME 16 #define CHP$_MATCHEDACE 17 #define CHP$_PRIVUSED 18 #define CHP$_MAX_CODE 19 #define CHP$M_SYSPRV 1 #define CHP$M_BYPASS 2 #define CHP$M_UPGRADE 4 #define CHP$M_DOWNGRADE 8 #define CHP$M_GRPPRV 16 #define CHP$M_READALL 32 #define CHP$V_SYSPRV 0 #define CHP$V_BYPASS 1 #define CHP$V_UPGRADE 2 #define CHP$V_DOWNGRADE 3 #define CHP$V_GRPPRV 4 #define CHP$V_READALL 5 #define CHP$M_READ 1 #define CHP$M_WRITE 2 #define CHP$M_USEREADALL 4 #define CHP$V_READ 0 #define CHP$V_WRITE 1 #define CHP$V_USEREADALL 2 emacs-19.30/src/cm.h100444 75424 1 12654 5770115145 12676 0ustar kwzhdaemon/* Cursor motion calculation definitions for GNU Emacs Copyright (C) 1985, 1989 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. */ /* Holds the minimum and maximum costs for the parametrized capabilities. */ struct parmcap { int mincost, maxcost; }; /* This structure holds everything needed to do cursor motion except the pad character (PC) and the output speed of the terminal (ospeed), which termcap wants in global variables. */ struct cm { /* Cursor position. -1 in *both* variables means the cursor position is unknown, in order to force absolute cursor motion. */ int cm_curY; /* Current row */ int cm_curX; /* Current column */ /* Capabilities from termcap */ char *cm_up; /* up (up) */ char *cm_down; /* down (do) */ char *cm_left; /* left (le) */ char *cm_right; /* right (nd) */ char *cm_home; /* home (ho) */ char *cm_cr; /* carriage return (cr) */ char *cm_ll; /* last line (ll) */ char *cm_tab; /* tab (ta) */ char *cm_backtab; /* backtab (bt) */ char *cm_abs; /* absolute (cm) */ char *cm_habs; /* horizontal absolute (ch) */ char *cm_vabs; /* vertical absolute (cv) */ #if 0 char *cm_ds; /* "don't send" string (ds) */ #endif char *cm_multiup; /* multiple up (UP) */ char *cm_multidown; /* multiple down (DO) */ char *cm_multileft; /* multiple left (LE) */ char *cm_multiright; /* multiple right (RI) */ int cm_cols; /* number of cols on screen (co) */ int cm_rows; /* number of rows on screen (li) */ int cm_tabwidth; /* tab width (it) */ unsigned int cm_autowrap:1; /* autowrap flag (am) */ unsigned int cm_magicwrap:1; /* VT-100: cursor stays in last col but will cm_wrap if next char is printing (xn) */ unsigned int cm_usetabs:1; /* if set, use tabs */ unsigned int cm_losewrap:1; /* if reach right margin, forget cursor location */ unsigned int cm_autolf:1; /* \r performs a \r\n (rn) */ /* Parametrized capabilities. This needs to be a struct since the costs are accessed through pointers. */ #if 0 struct parmcap cc_abs; /* absolute (cm) */ struct parmcap cc_habs; /* horizontal absolute (ch) */ struct parmcap cc_vabs; /* vertical absolute (cv) */ struct parmcap cc_multiup; /* multiple up (UP) */ struct parmcap cc_multidown; /* multiple down (DO) */ struct parmcap cc_multileft; /* multiple left (LE) */ struct parmcap cc_multiright; /* multiple right (RI) */ #endif /* Costs for the non-parametrized capabilities */ int cc_up; /* cost for up */ int cc_down; /* etc. */ int cc_left; int cc_right; int cc_home; int cc_cr; int cc_ll; int cc_tab; int cc_backtab; /* These are temporary, until the code is installed to use the struct parmcap fields above. */ int cc_abs; int cc_habs; int cc_vabs; }; extern struct cm Wcm; /* Terminal capabilities */ extern char PC; /* Pad character */ extern short ospeed; /* Output speed (from sg_ospeed) */ /* Shorthand */ #ifndef NoCMShortHand #define curY Wcm.cm_curY #define curX Wcm.cm_curX #define Up Wcm.cm_up #define Down Wcm.cm_down #define Left Wcm.cm_left #define Right Wcm.cm_right #define Tab Wcm.cm_tab #define BackTab Wcm.cm_backtab #define TabWidth Wcm.cm_tabwidth #define CR Wcm.cm_cr #define Home Wcm.cm_home #define LastLine Wcm.cm_ll #define AbsPosition Wcm.cm_abs #define ColPosition Wcm.cm_habs #define RowPosition Wcm.cm_vabs #define MultiUp Wcm.cm_multiup #define MultiDown Wcm.cm_multidown #define MultiLeft Wcm.cm_multileft #define MultiRight Wcm.cm_multiright #define AutoWrap Wcm.cm_autowrap #define MagicWrap Wcm.cm_magicwrap #define UseTabs Wcm.cm_usetabs #define FrameRows Wcm.cm_rows #define FrameCols Wcm.cm_cols #define UpCost Wcm.cc_up #define DownCost Wcm.cc_down #define LeftCost Wcm.cc_left #define RightCost Wcm.cc_right #define HomeCost Wcm.cc_home #define CRCost Wcm.cc_cr #define LastLineCost Wcm.cc_ll #define TabCost Wcm.cc_tab #define BackTabCost Wcm.cc_backtab #define AbsPositionCost Wcm.cc_abs #define ColPositionCost Wcm.cc_habs #define RowPositionCost Wcm.cc_vabs #define MultiUpCost Wcm.cc_multiup #define MultiDownCost Wcm.cc_multidown #define MultiLeftCost Wcm.cc_multileft #define MultiRightCost Wcm.cc_multiright #endif #define cmat(row,col) (curY = (row), curX = (col)) #define cmplus(n) \ { \ if ((curX += (n)) >= FrameCols && !MagicWrap) \ { \ if (Wcm.cm_losewrap) losecursor (); \ else if (AutoWrap) curX = 0, curY++; \ else curX--; \ } \ } #define losecursor() (curX = -1, curY = -1) extern int cost; extern int evalcost (); extern void cmcheckmagic (); extern int cmputc (); extern int cmcostinit (); extern int cmgoto (); extern int Wcm_clear (); extern int Wcm_init (); emacs-19.30/src/commands.h100444 75424 1 6327 5770115145 14060 0ustar kwzhdaemon/* Definitions needed by most editing commands. Copyright (C) 1985, 1994 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. */ #define Ctl(c) ((c)&037) /* Define the names of keymaps, just so people can refer to them in calls to initial_define_key. These should *not* be used after initialization; use-global-map doesn't affect these; it sets current_global_map instead. */ extern Lisp_Object global_map; extern Lisp_Object meta_map; extern Lisp_Object control_x_map; extern Lisp_Object Vminibuffer_local_map; extern Lisp_Object Vminibuffer_local_ns_map; /* keymap used for minibuffers when doing completion */ extern Lisp_Object Vminibuffer_local_completion_map; /* keymap used for minibuffers when doing completion and require a match */ extern Lisp_Object Vminibuffer_local_must_match_map; /* Last character of last key sequence. */ extern Lisp_Object last_command_char; /* Last input character read as a command, not counting menus reached by the mouse. */ extern Lisp_Object last_nonmenu_event; /* List of command events to be re-read, or Qnil. */ extern Lisp_Object Vunread_command_events; /* Command char event to be re-read, or -1 if none. Setting this is obsolete, but some things should still check it. */ extern int unread_command_char; /* The command being executed by the command loop. Commands may set this, and the value set will be copied into current_kboard->Vlast_command instead of the actual command. */ extern Lisp_Object this_command; /* If not Qnil, this is a switch-frame event which we decided to put off until the end of a key sequence. This should be read as the next command input, after any Vunread_command_events. read_key_sequence uses this to delay switch-frame events until the end of the key sequence; Fread_char uses it to put off switch-frame events until a non-ASCII event is acceptable as input. */ extern Lisp_Object unread_switch_frame; /* The value of point when the last command was executed. */ extern int last_point_position; /* The buffer that was current when the last command was started. */ extern Lisp_Object last_point_position_buffer; /* Nonzero means ^G can quit instantly */ extern int immediate_quit; extern Lisp_Object Vexecuting_macro; /* Nonzero if input is coming from the keyboard */ #define INTERACTIVE (NILP (Vexecuting_macro) && !noninteractive) /* Set this nonzero to force reconsideration of mode line. */ extern int update_mode_lines; /* Nonzero means reading single-character input with prompt so put cursor on minibuffer after the prompt. */ extern int cursor_in_echo_area; emacs-19.30/src/dispextern.h100444 23073 1 12542 6047602102 15125 0ustar voelkerdaemon/* Interface definitions for display code. Copyright (C) 1985, 1993, 1994 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. */ #ifndef _DISPEXTERN_H_ #define _DISPEXTERN_H_ /* Nonzero means last display completed and cursor is really at cursX, cursY. Zero means it was preempted. */ extern int display_completed; #ifdef HAVE_X_WINDOWS #include #endif #ifdef MSDOS #include "msdos.h" #endif #ifdef HAVE_NTGUI #include "win32.h" #endif #ifdef HAVE_FACES struct face { /* If this is non-zero, it is a GC we can use without modification to represent this face. */ GC gc; /* Pixel value for foreground color. */ EMACS_UINT foreground; /* Pixel value for background color. */ EMACS_UINT background; /* Font used for this face. */ XFontStruct *font; /* Background stipple or bitmap used for this face. */ Pixmap stipple; /* Pixmap_depth. */ unsigned int pixmap_w, pixmap_h; /* Whether or not to underline text in this face. */ char underline; }; /* Let's stop using this and get rid of it. */ typedef struct face *FACE; #define NORMAL_FACE ((struct face *) 0) #define FACE_HAS_GC(f) ((f)->gc) #define FACE_GC(f) ((f)->gc) #define FACE_FOREGROUND(f) ((f)->foreground) #define FACE_BACKGROUND(f) ((f)->background) #define FACE_FONT(f) ((f)->font) #define FACE_STIPPLE(f) ((f)->stipple) #define FACE_UNDERLINE_P(f) ((f)->underline) #else /* not HAVE_FACES */ typedef int FACE; #define NORMAL_FACE 0x0 #define HIGHLIGHT_FACE 0x1 #define UNDERLINE_FACE 0x2 #define HIGHLIGHT_UNDERLINE_FACE 0x3 #define FACE_HIGHLIGHT(f) ((f) & 0x1) #define FACE_UNDERLINE(f) ((f) & 0x2) #endif /* not HAVE_FACES */ /* This structure is used for the actual display of text on a frame. There are two instantiations of it: the glyphs currently displayed, and the glyphs we desire to display. The latter object is generated from buffers being displayed. */ struct frame_glyphs { #ifdef MULTI_FRAME struct frame *frame; /* Frame these glyphs belong to. */ #endif /* MULTI_FRAME */ int height; int width; /* Contents of the frame. glyphs[V][H] is the glyph at position V, H. Note that glyphs[V][-1], glyphs[V][used[V]], and glyphs[V][frame_width] are always '\0'. */ GLYPH **glyphs; /* long vector from which the strings in `glyphs' are taken. */ GLYPH *total_contents; /* When representing a desired frame, enable[n] == 0 means that line n is same as current frame. Between updates, all lines should be disabled. When representing current frame contents, enable[n] == 0 means that line n is blank. */ char *enable; /* Everything on line n after column used[n] is considered blank. */ int *used; /* highlight[n] != 0 iff line n is highlighted. */ char *highlight; /* Buffer offset of this line's first char. This is not really implemented, and cannot be, and should be deleted. */ int *bufp; #ifdef HAVE_WINDOW_SYSTEM /* Pixel position of top left corner of line. */ short *top_left_x; short *top_left_y; /* Pixel width of line. */ short *pix_width; /* Pixel height of line. */ short *pix_height; /* Largest font ascent on this line. */ short *max_ascent; #endif /* HAVE_WINDOW_SYSTEM */ /* Mapping of coordinate pairs to buffer positions. This field holds a vector indexed by row number. Its elements are vectors indexed by column number. Each element of these vectors is a buffer position, 0, or -1. For a column where the image of a text character starts, the element value is the buffer position of that character. When a window's screen line starts in mid character, the element for the line's first column (at the window's left margin) is that character's position. For successive columns within a multicolumn character, the element is -1. For the column just beyond the last glyph on a line, the element is the buffer position of the end of the line. For following columns within the same window, the element is 0. For rows past the end of the accessible buffer text, the window's first column has ZV and other columns have 0. Mode lines and vertical separator lines have 0. The column of a window's left margin always has a positive value (a buffer position), not 0 or -1, for each line in that window's interior. */ int **charstarts; /* This holds all the space in the subvectors of the charstarts field. */ int *total_charstarts; }; extern void get_display_line (); extern Lisp_Object sit_for (); #endif /* not _DISPEXTERN_H_ */ emacs-19.30/src/disptab.h100444 12120 1 7221 6036522605 13474 0ustar rmsdaemon/* Things for GLYPHS and glyph tables. Copyright (C) 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. */ /* Access the slots of a display-table, according to their purpose. */ #define DISP_TABLE_P(obj) \ (CHAR_TABLE_P (obj) \ && XCHAR_TABLE (obj)->purpose == Qdisplay_table \ && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (obj)) == DISP_TABLE_EXTRA_SLOTS) #define DISP_TABLE_EXTRA_SLOTS 6 #define DISP_TRUNC_GLYPH(dp) ((dp)->extras[0]) #define DISP_CONTINUE_GLYPH(dp) ((dp)->extras[1]) #define DISP_ESCAPE_GLYPH(dp) ((dp)->extras[2]) #define DISP_CTRL_GLYPH(dp) ((dp)->extras[3]) #define DISP_INVIS_VECTOR(dp) ((dp)->extras[4]) #define DISP_BORDER_GLYPH(dp) ((dp)->extras[5]) #define DISP_CHAR_VECTOR(dp, c) ((dp)->contents[c]) /* Defined in window.c. */ extern struct Lisp_Char_Table *window_display_table (); /* Defined in indent.c. */ extern struct Lisp_Char_Table *buffer_display_table (); /* Display table to use for vectors that don't specify their own. */ extern Lisp_Object Vstandard_display_table; /* This is the `purpose' slot of a display table. */ extern Lisp_Object Qdisplay_table; /* Vector of GLYPH definitions. Indexed by GLYPH number, the contents are a string which is how to output the GLYPH. */ extern Lisp_Object Vglyph_table; /* Return the current length of the GLYPH table, or 0 if the table isn't currently valid. */ #define GLYPH_TABLE_LENGTH \ ((VECTORP (Vglyph_table)) ? XVECTOR (Vglyph_table)->size : 0) /* Return the current base (for indexing) of the GLYPH table, or 0 if the table isn't currently valid. */ #define GLYPH_TABLE_BASE \ ((VECTORP (Vglyph_table)) ? XVECTOR (Vglyph_table)->contents : 0) /* Given BASE and LEN returned by the two previous macros, return nonzero if the GLYPH code G should be output as a single character with code G. Return zero if G has a string in the table. */ #define GLYPH_SIMPLE_P(base,len,g) ((g) >= (len) || !STRINGP (base[g])) /* Given BASE and LEN returned by the two previous macros, return nonzero if GLYPH code G is aliased to a different code. */ #define GLYPH_ALIAS_P(base,len,g) ((g) < (len) && INTEGERP (base[g])) /* Assuming that GLYPH_SIMPLE_P (BASE, LEN, G) is 1, return the alias for G. */ #define GLYPH_ALIAS(base, g) XINT (base[g]) /* Follow all aliases for G in the glyph table given by (BASE, LENGTH), and set G to the final glyph. */ #define GLYPH_FOLLOW_ALIASES(base, length, g) \ while (GLYPH_ALIAS_P ((base), (length), (g))) \ (g) = GLYPH_ALIAS ((base), (g)); /* Assuming that GLYPH_SIMPLE_P (BASE, LEN, G) is 0, return the length and the address of the character-sequence used for outputting GLYPH G. */ #define GLYPH_LENGTH(base,g) XSTRING (base[g])->size #define GLYPH_STRING(base,g) XSTRING (base[g])->data /* GLYPH for a space character. */ #define SPACEGLYPH 040 #define NULL_GLYPH 00 #define GLYPH_FROM_CHAR(c) (c) extern int glyphlen (); extern void str_to_glyph_cpy (); extern void str_to_glyph_ncpy (); extern void glyph_to_str_cpy (); emacs-19.30/src/dosfns.h100444 23160 1 2601 6036716765 14245 0ustar kfstormdaemon/* MS-DOS specific Lisp utilities interface. Coded by Manabu Higashida, 1991. Copyright (C) 1991 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. */ extern int dos_hyper_key; extern int dos_super_key; extern int dos_decimal_point; extern int dos_keypad_mode; extern int dos_keyboard_layout; extern int dos_country_code; extern int dos_codepage; extern int dos_timezone_offset; #define DOS_COUNTRY_INFO 34 /* no of bytes returned by dos int 38h */ extern unsigned char dos_country_info[DOS_COUNTRY_INFO]; extern Lisp_Object Vdos_version; #ifndef HAVE_X_WINDOWS extern Lisp_Object Vdos_display_scancodes; extern Lisp_Object Vdos_menubar_clock; extern Lisp_Object Vdos_timer_hooks; extern Lisp_Object Qmsdos_color_translate; #endif emacs-19.30/src/frame.h100444 12120 1 52045 6052001075 13153 0ustar rmsdaemon/* Define frame-object for GNU Emacs. Copyright (C) 1993, 1994 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. */ /* Miscellanea. */ /* Nonzero means don't assume anything about current contents of actual terminal frame */ extern int frame_garbaged; /* Nonzero means FRAME_MESSAGE_BUF (selected_frame) is being used by print. */ extern int message_buf_print; /* The structure representing a frame. We declare this even if MULTI_FRAME is not defined, because when we lack multi-frame support, we use one instance of this structure to represent the one frame we support. This is cleaner than having miscellaneous random variables scattered about. */ enum output_method { output_termcap, output_x_window, output_msdos_raw, output_win32 }; struct frame { EMACS_INT size; struct Lisp_Vector *next; /* All Lisp_Object components must come first. Only EMACS_INT values can be intermixed with them. That ensures they are all aligned normally. */ /* Name of this frame: a Lisp string. See also `explicit_name' and `namebuf'. */ Lisp_Object name; /* The name to use for the icon, the last time it was refreshed. nil means not explicitly specified. */ Lisp_Object icon_name; /* The frame which should receive keystrokes that occur in this frame, or nil if they should go to the frame itself. This is usually nil, but if the frame is minibufferless, we can use this to redirect keystrokes to a surrogate minibuffer frame when needed. Note that a value of nil is different than having the field point to the frame itself. Whenever the Fselect_frame function is used to shift from one frame to the other, any redirections to the original frame are shifted to the newly selected frame; if focus_frame is nil, Fselect_frame will leave it alone. */ Lisp_Object focus_frame; /* This frame's root window. Every frame has one. If the frame has only a minibuffer window, this is it. Otherwise, if the frame has a minibuffer window, this is its sibling. */ Lisp_Object root_window; /* This frame's selected window. Each frame has its own window hierarchy and one of the windows in it is selected within the frame. The selected window of the selected frame is Emacs's selected window. */ Lisp_Object selected_window; /* This frame's minibuffer window. Most frames have their own minibuffer windows, but only the selected frame's minibuffer window can actually appear to exist. */ Lisp_Object minibuffer_window; /* Parameter alist of this frame. These are the parameters specified when creating the frame or modified with modify-frame-parameters. */ Lisp_Object param_alist; /* List of scroll bars on this frame. Actually, we don't specify exactly what is stored here at all; the scroll bar implementation code can use it to store anything it likes. This field is marked by the garbage collector. It is here instead of in the `display' structure so that the garbage collector doesn't need to look inside the window-system-dependent structure. */ Lisp_Object scroll_bars; Lisp_Object condemned_scroll_bars; /* List of elements to display in the menu bar. The elements have the form (KEY STRING . nil) to start; when they are displayed, the hpos of the left edge goes in the cddr. */ Lisp_Object menu_bar_items; /* Alist of elements (FACE-NAME . FACE-VECTOR-DATA). */ Lisp_Object face_alist; /* A vector that records the entire structure of this frame's menu bar. For the format of the data, see extensive comments in xmenu.c. Only the X toolkit version uses this. */ Lisp_Object menu_bar_vector; /* Number of elements in the vector that have meaningful data. */ EMACS_INT menu_bar_items_used; /* Predicate for selecting buffers for other-buffer. */ Lisp_Object buffer_predicate; /* Beyond here, there should be no more Lisp_Object components. */ /* A buffer to hold the frame's name. We can't use the Lisp string's pointer (`name', above) because it might get relocated. */ char *namebuf; /* glyphs as they appear on the frame */ struct frame_glyphs *current_glyphs; /* glyphs we'd like to appear on the frame */ struct frame_glyphs *desired_glyphs; /* See do_line_insertion_deletion_costs for info on these arrays. */ /* Cost of inserting 1 line on this frame */ int *insert_line_cost; /* Cost of deleting 1 line on this frame */ int *delete_line_cost; /* Cost of inserting n lines on this frame */ int *insert_n_lines_cost; /* Cost of deleting n lines on this frame */ int *delete_n_lines_cost; /* glyphs for the mode line */ struct frame_glyphs *temp_glyphs; /* Intended cursor position of this frame. Measured in characters, counting from upper left corner within the frame. */ int cursor_x; int cursor_y; /* Actual cursor position of this frame, and the character under it. (Not used for terminal frames.) */ int phys_cursor_x; int phys_cursor_y; /* This is handy for undrawing the cursor, because current_glyphs is not always accurate when in do_scrolling. */ GLYPH phys_cursor_glyph; /* Size of this frame, in units of characters. */ EMACS_INT height; EMACS_INT width; /* New height and width for pending size change. 0 if no change pending. */ int new_height, new_width; /* The output method says how the contents of this frame are displayed. It could be using termcap, or using an X window. */ enum output_method output_method; /* A structure of auxiliary data used for displaying the contents. struct x_output is used for X window frames; it is defined in xterm.h. struct win32_output is used for Win32 window frames; it is defined in w32term.h. */ union output_data { struct x_output *x; struct win32_output *win32; int nothing; } output_data; #ifdef MULTI_KBOARD /* A pointer to the kboard structure associated with this frame. For termcap frames, this points to initial_kboard. For X frames, it will be the same as display.x->display_info->kboard. */ struct kboard *kboard; #endif /* Number of lines of menu bar. */ int menu_bar_lines; #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) /* Nonzero means using a menu bar that comes from the X toolkit. */ int external_menu_bar; #endif /* Nonzero if last attempt at redisplay on this frame was preempted. */ char display_preempted; /* visible is nonzero if the frame is currently displayed; we check it to see if we should bother updating the frame's contents. DON'T SET IT DIRECTLY; instead, use FRAME_SET_VISIBLE. Note that, since invisible frames aren't updated, whenever a frame becomes visible again, it must be marked as garbaged. The FRAME_SAMPLE_VISIBILITY macro takes care of this. iconified is nonzero if the frame is currently iconified. Asynchronous input handlers should NOT change these directly; instead, they should change async_visible or async_iconified, and let the FRAME_SAMPLE_VISIBILITY macro set visible and iconified at the next redisplay. These should probably be considered read-only by everyone except FRAME_SAMPLE_VISIBILITY. These two are mutually exclusive. They might both be zero, if the frame has been made invisible without an icon. */ char visible, iconified; /* Asynchronous input handlers change these, and FRAME_SAMPLE_VISIBILITY copies them into visible and iconified. See FRAME_SAMPLE_VISIBILITY, below. */ #ifdef __STDC__ volatile #endif char async_visible, async_iconified; /* Nonzero if this frame should be redrawn. */ #ifdef __STDC__ volatile #endif char garbaged; /* True if frame actually has a minibuffer window on it. 0 if using a minibuffer window that isn't on this frame. */ char has_minibuffer; /* 0 means, if this frame has just one window, show no modeline for that window. */ char wants_modeline; /* Non-zero if the hardware device this frame is displaying on can support scroll bars. */ char can_have_scroll_bars; /* If can_have_scroll_bars is non-zero, this is non-zero if we should actually display them on this frame. */ char has_vertical_scroll_bars; /* Non-0 means raise this frame to the top of the heap when selected. */ char auto_raise; /* Non-0 means lower this frame to the bottom of the stack when left. */ char auto_lower; /* True if frame's root window can't be split. */ char no_split; /* If this is set, then Emacs won't change the frame name to indicate the current buffer, etcetera. If the user explicitly sets the frame name, this gets set. If the user sets the name to Qnil, this is cleared. */ char explicit_name; /* Nonzero if size of some window on this frame has changed. */ char window_sizes_changed; /* Storage for messages to this frame. */ char *message_buf; /* Nonnegative if current redisplay should not do scroll computation for lines beyond a certain vpos. This is the vpos. */ int scroll_bottom_vpos; /* Width of the scroll bar, in pixels and in characters. scroll_bar_cols tracks scroll_bar_pixel_width if the latter is positive; a zero value in scroll_bar_pixel_width means to compute the actual width on the fly, using scroll_bar_cols and the current font width. */ int scroll_bar_pixel_width; int scroll_bar_cols; /* The baud rate that was used to calculate costs for this frame. */ int cost_calculation_baud_rate; /* Nonzero if the mouse has moved on this display since the last time we checked. */ char mouse_moved; }; #ifdef MULTI_KBOARD /* Note that MULTI_KBOARD implies MULTI_FRAME */ #define FRAME_KBOARD(f) ((f)->kboard) #else #define FRAME_KBOARD(f) (&the_only_kboard) #endif #ifdef MULTI_FRAME typedef struct frame *FRAME_PTR; #define XFRAME(p) ((struct frame *) XPNTR (p)) #define XSETFRAME(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FRAME)) #define WINDOW_FRAME(w) (w)->frame #define FRAME_X_P(f) ((f)->output_method == output_x_window) #define FRAME_WIN32_P(f) ((f)->output_method == output_win32) /* FRAME_WINDOW_P tests whether the frame is a window, and is defined to be the predicate for the window system being used. */ #ifdef HAVE_X_WINDOWS #define FRAME_WINDOW_P(f) FRAME_X_P (f) #endif #ifdef HAVE_NTGUI #define FRAME_WINDOW_P(f) FRAME_WIN32_P (f) #endif #ifndef FRAME_WINDOW_P #define FRAME_WINDOW_P(f) (0) #endif #define FRAME_LIVE_P(f) ((f)->output_data.nothing != 0) #define FRAME_TERMCAP_P(f) ((f)->output_method == output_termcap) #define FRAME_MINIBUF_ONLY_P(f) \ EQ (FRAME_ROOT_WINDOW (f), FRAME_MINIBUF_WINDOW (f)) #define FRAME_HAS_MINIBUF_P(f) ((f)->has_minibuffer) #define FRAME_CURRENT_GLYPHS(f) (f)->current_glyphs #define FRAME_DESIRED_GLYPHS(f) (f)->desired_glyphs #define FRAME_TEMP_GLYPHS(f) (f)->temp_glyphs #define FRAME_HEIGHT(f) (f)->height #define FRAME_WIDTH(f) (f)->width #define FRAME_NEW_HEIGHT(f) (f)->new_height #define FRAME_NEW_WIDTH(f) (f)->new_width #define FRAME_MENU_BAR_LINES(f) (f)->menu_bar_lines #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) #define FRAME_EXTERNAL_MENU_BAR(f) (f)->external_menu_bar #else #define FRAME_EXTERNAL_MENU_BAR(f) 0 #endif #define FRAME_CURSOR_X(f) (f)->cursor_x #define FRAME_CURSOR_Y(f) (f)->cursor_y #define FRAME_VISIBLE_P(f) ((f)->visible != 0) #define FRAME_SET_VISIBLE(f,p) \ ((f)->async_visible = (p), FRAME_SAMPLE_VISIBILITY (f)) #define SET_FRAME_GARBAGED(f) (frame_garbaged = 1, f->garbaged = 1) #define FRAME_GARBAGED_P(f) (f)->garbaged #define FRAME_NO_SPLIT_P(f) (f)->no_split #define FRAME_WANTS_MODELINE_P(f) (f)->wants_modeline #define FRAME_ICONIFIED_P(f) (f)->iconified #define FRAME_WINDOW_SIZES_CHANGED(f) (f)->window_sizes_changed #define FRAME_MINIBUF_WINDOW(f) (f)->minibuffer_window #define FRAME_ROOT_WINDOW(f) (f)->root_window #define FRAME_SELECTED_WINDOW(f) (f)->selected_window #define SET_GLYPHS_FRAME(glyphs,frame) ((glyphs)->frame = (frame)) #define FRAME_INSERT_COST(f) (f)->insert_line_cost #define FRAME_DELETE_COST(f) (f)->delete_line_cost #define FRAME_INSERTN_COST(f) (f)->insert_n_lines_cost #define FRAME_DELETEN_COST(f) (f)->delete_n_lines_cost #define FRAME_MESSAGE_BUF(f) (f)->message_buf #define FRAME_SCROLL_BOTTOM_VPOS(f) (f)->scroll_bottom_vpos #define FRAME_FOCUS_FRAME(f) (f)->focus_frame #define FRAME_CAN_HAVE_SCROLL_BARS(f) ((f)->can_have_scroll_bars) #define FRAME_HAS_VERTICAL_SCROLL_BARS(f) ((f)->has_vertical_scroll_bars) #define FRAME_SCROLL_BAR_PIXEL_WIDTH(f) ((f)->scroll_bar_pixel_width) #define FRAME_SCROLL_BAR_COLS(f) ((f)->scroll_bar_cols) #define FRAME_SCROLL_BARS(f) ((f)->scroll_bars) #define FRAME_CONDEMNED_SCROLL_BARS(f) ((f)->condemned_scroll_bars) #define FRAME_MENU_BAR_ITEMS(f) ((f)->menu_bar_items) #define FRAME_COST_BAUD_RATE(f) ((f)->cost_calculation_baud_rate) /* Emacs's redisplay code could become confused if a frame's visibility changes at arbitrary times. For example, if a frame is visible while the desired glyphs are being built, but becomes invisible before they are updated, then some rows of the desired_glyphs will be left marked as enabled after redisplay is complete, which should never happen. The next time the frame becomes visible, redisplay will probably barf. Currently, there are no similar situations involving iconified, but the principle is the same. So instead of having asynchronous input handlers directly set and clear the frame's visibility and iconification flags, they just set the async_visible and async_iconified flags; the redisplay code calls the FRAME_SAMPLE_VISIBILITY macro before doing any redisplay, which sets visible and iconified from their asynchronous counterparts. Synchronous code must use the FRAME_SET_VISIBLE macro. Also, if a frame used to be invisible, but has just become visible, it must be marked as garbaged, since redisplay hasn't been keeping up its contents. */ #define FRAME_SAMPLE_VISIBILITY(f) \ (((f)->async_visible && ! (f)->visible) ? SET_FRAME_GARBAGED (f) : 0, \ (f)->visible = (f)->async_visible, \ (f)->iconified = (f)->async_iconified) #define CHECK_FRAME(x, i) \ { \ if (! FRAMEP (x)) \ x = wrong_type_argument (Qframep, (x)); \ } #define CHECK_LIVE_FRAME(x, i) \ { \ if (! FRAMEP (x) \ || ! FRAME_LIVE_P (XFRAME (x))) \ x = wrong_type_argument (Qframe_live_p, (x)); \ } /* FOR_EACH_FRAME (LIST_VAR, FRAME_VAR) followed by a statement is a `for' loop which iterates over the elements of Vframe_list. The loop will set FRAME_VAR, a Lisp_Object, to each frame in Vframe_list in succession and execute the statement. LIST_VAR should be a Lisp_Object too; it is used to iterate through the Vframe_list. If MULTI_FRAME isn't defined, then this loop expands to something which executes the statement once. */ #define FOR_EACH_FRAME(list_var, frame_var) \ for ((list_var) = Vframe_list; \ (CONSP (list_var) \ && (frame_var = XCONS (list_var)->car, 1)); \ list_var = XCONS (list_var)->cdr) extern Lisp_Object Qframep, Qframe_live_p, Qicon; extern struct frame *selected_frame; extern struct frame *last_nonminibuf_frame; extern struct frame *make_terminal_frame (); extern struct frame *make_frame (); extern struct frame *make_minibuffer_frame (); extern struct frame *make_frame_without_minibuffer (); extern Lisp_Object Vframe_list; extern Lisp_Object Vdefault_frame_alist; extern Lisp_Object Vterminal_frame; #else /* not MULTI_FRAME */ /* These definitions are used in a single-frame version of Emacs. */ /* A frame we use to store all the data concerning the screen when we don't have multiple frames. Remember, if you store any data in it which needs to be protected from GC, you should staticpro that element explicitly. */ extern struct frame the_only_frame; typedef struct frame *FRAME_PTR; #ifdef __GNUC__ /* A function call for always getting 0 is overkill, so... */ #define WINDOW_FRAME(w) ({ Lisp_Object tem; XSETFASTINT (tem, 0); tem; }) #else #define WINDOW_FRAME(w) (Fselected_frame ()) #endif #define XSETFRAME(p, v) (p = WINDOW_FRAME (***bogus***)) #define XFRAME(frame) (&the_only_frame) extern FRAME_PTR selected_frame; extern FRAME_PTR last_nonminibuf_frame; #define FRAME_LIVE_P(f) 1 #ifdef MSDOS /* The following definitions could also be used in the non-MSDOS case, but the constants below lead to better code. */ #define FRAME_TERMCAP_P(f) (the_only_frame.output_method == output_termcap) #define FRAME_X_P(f) (the_only_frame.output_method != output_termcap) #else #define FRAME_TERMCAP_P(f) 1 #define FRAME_X_P(f) 0 #endif #define FRAME_WINDOW_P(f) FRAME_X_P (f) #define FRAME_MINIBUF_ONLY_P(f) 0 #define FRAME_HAS_MINIBUF_P(f) 1 #define FRAME_CURRENT_GLYPHS(f) (the_only_frame.current_glyphs) #define FRAME_DESIRED_GLYPHS(f) (the_only_frame.desired_glyphs) #define FRAME_TEMP_GLYPHS(f) (the_only_frame.temp_glyphs) #define FRAME_HEIGHT(f) (the_only_frame.height) #define FRAME_WIDTH(f) (the_only_frame.width) #define FRAME_NEW_HEIGHT(f) (the_only_frame.new_height) #define FRAME_NEW_WIDTH(f) (the_only_frame.new_width) #define FRAME_MENU_BAR_LINES(f) (the_only_frame.menu_bar_lines) #define FRAME_CURSOR_X(f) (the_only_frame.cursor_x) #define FRAME_CURSOR_Y(f) (the_only_frame.cursor_y) #define FRAME_SET_VISIBLE(f,p) (p) #define FRAME_VISIBLE_P(f) 1 #define SET_FRAME_GARBAGED(f) (frame_garbaged = 1) #define FRAME_GARBAGED_P(f) (frame_garbaged) #define FRAME_NO_SPLIT_P(f) 0 #define FRAME_WANTS_MODELINE_P(f) 1 #define FRAME_ICONIFIED_P(f) 0 #define FRAME_WINDOW_SIZES_CHANGED(f) the_only_frame.window_sizes_changed #define FRAME_MINIBUF_WINDOW(f) (minibuf_window) #define FRAME_ROOT_WINDOW(f) (the_only_frame.root_window) #define FRAME_SELECTED_WINDOW(f) (selected_window) #define SET_GLYPHS_FRAME(glyphs,frame) do ; while (0) #define FRAME_INSERT_COST(frame) (the_only_frame.insert_line_cost) #define FRAME_DELETE_COST(frame) (the_only_frame.delete_line_cost) #define FRAME_INSERTN_COST(frame) (the_only_frame.insert_n_lines_cost) #define FRAME_DELETEN_COST(frame) (the_only_frame.delete_n_lines_cost) #define FRAME_MESSAGE_BUF(f) (the_only_frame.message_buf) #define FRAME_SCROLL_BOTTOM_VPOS(f) (the_only_frame.scroll_bottom_vpos) #define FRAME_FOCUS_FRAME(f) (Qnil) #define FRAME_CAN_HAVE_SCROLL_BARS(f) (the_only_frame.can_have_scroll_bars) #define FRAME_HAS_VERTICAL_SCROLL_BARS(f) \ (the_only_frame.has_vertical_scroll_bars) #define FRAME_SCROLL_BAR_PIXEL_WIDTH(f) (the_only_frame.scroll_bar_pixel_width) #define FRAME_SCROLL_BAR_COLS(f) (the_only_frame.scroll_bar_cols) #define FRAME_SCROLL_BARS(f) (the_only_frame.scroll_bars) #define FRAME_CONDEMNED_SCROLL_BARS(f) (the_only_frame.condemned_scroll_bars) #define FRAME_MENU_BAR_ITEMS(f) (the_only_frame.menu_bar_items) #define FRAME_COST_BAUD_RATE(f) (the_only_frame.cost_calculation_baud_rate) /* See comments in definition above. */ #define FRAME_SAMPLE_VISIBILITY(f) (0) #define CHECK_FRAME(x, i) do; while (0) #define CHECK_LIVE_FRAME(x, y) do; while (0) /* FOR_EACH_FRAME (LIST_VAR, FRAME_VAR) followed by a statement is a `for' loop which iterates over the elements of Vframe_list. The loop will set FRAME_VAR, a Lisp_Object, to each frame in Vframe_list in succession and execute the statement. LIST_VAR should be a Lisp_Object too; it is used to iterate through the Vframe_list. If MULTI_FRAME _is_ defined, then this loop expands to a real `for' loop which traverses Vframe_list using LIST_VAR and FRAME_VAR. */ #define FOR_EACH_FRAME(list_var, frame_var) \ for (list_var = Qt; frame_var = WINDOW_FRAME (***bogus***), ! NILP (list_var); list_var = Qnil) #endif /* not MULTI_FRAME */ /* Device- and MULTI_FRAME-independent scroll bar stuff. */ /* Return the starting column (zero-based) of the vertical scroll bar for window W. The column before this one is the last column we can use for text. If the window touches the right edge of the frame, we have extra space allocated for it. Otherwise, the scroll bar takes over the window's rightmost columns. */ #define WINDOW_VERTICAL_SCROLL_BAR_COLUMN(w) \ (((XINT ((w)->left) + XINT ((w)->width)) \ < FRAME_WIDTH (XFRAME (WINDOW_FRAME (w)))) \ ? (XINT ((w)->left) + XINT ((w)->width) \ - FRAME_SCROLL_BAR_COLS (XFRAME (WINDOW_FRAME (w)))) \ : FRAME_WIDTH (XFRAME (WINDOW_FRAME (w)))) /* Return the height in lines of the vertical scroll bar in w. If the window has a mode line, don't make the scroll bar extend that far. */ #define WINDOW_VERTICAL_SCROLL_BAR_HEIGHT(w) (window_internal_height (w)) emacs-19.30/src/getpagesize.h100555 21570 1 1274 5656460607 14356 0ustar djmdaemon/* Emulate getpagesize on systems that lack it. */ #ifndef HAVE_GETPAGESIZE #ifdef VMS #define getpagesize() 512 #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef _SC_PAGESIZE #define getpagesize() sysconf(_SC_PAGESIZE) #else #include #ifdef EXEC_PAGESIZE #define getpagesize() EXEC_PAGESIZE #else #ifdef NBPG #define getpagesize() NBPG * CLSIZE #ifndef CLSIZE #define CLSIZE 1 #endif /* no CLSIZE */ #else /* no NBPG */ #ifdef NBPC #define getpagesize() NBPC #else /* no NBPC */ #ifdef PAGESIZE #define getpagesize() PAGESIZE #endif #endif /* NBPC */ #endif /* no NBPG */ #endif /* no EXEC_PAGESIZE */ #endif /* no _SC_PAGESIZE */ #endif /* not HAVE_GETPAGESIZE */ emacs-19.30/src/gnu.h100444 12120 1 4336 5531057770 12650 0ustar rmsdaemon#define gnu_width 50 #define gnu_height 50 static unsigned char gnu_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x0e, 0x00, 0x00, 0x0c, 0x00, 0x70, 0x00, 0x1e, 0x00, 0x00, 0x06, 0xc0, 0xdd, 0x01, 0x34, 0x00, 0x00, 0x07, 0x3c, 0x07, 0x03, 0x34, 0x00, 0x80, 0x03, 0x1f, 0x06, 0x06, 0x24, 0x00, 0x80, 0x03, 0x0f, 0x04, 0x0c, 0x26, 0x00, 0xc0, 0x81, 0x07, 0x00, 0x08, 0x33, 0x00, 0x60, 0xc1, 0xe3, 0x80, 0xbb, 0x31, 0x00, 0x30, 0xe1, 0x33, 0xfe, 0xff, 0x18, 0x00, 0x10, 0xf1, 0x31, 0xc7, 0xe3, 0x1f, 0x00, 0x10, 0xf1, 0xd8, 0x01, 0x05, 0x3c, 0x00, 0x10, 0x83, 0x6c, 0x00, 0x1a, 0x40, 0x00, 0x10, 0x66, 0x36, 0x54, 0xd5, 0xff, 0x00, 0x30, 0x3c, 0xdb, 0xab, 0x3a, 0x2a, 0x00, 0x60, 0x80, 0xe9, 0x54, 0x35, 0x00, 0x00, 0xe0, 0xe0, 0x6c, 0xb9, 0x6a, 0x00, 0x00, 0x80, 0x37, 0xb6, 0x66, 0x75, 0x00, 0x00, 0x00, 0x0f, 0xb6, 0xb4, 0x6a, 0x00, 0x00, 0x00, 0x06, 0xb3, 0x77, 0x75, 0x00, 0x00, 0x00, 0xe1, 0x19, 0xa7, 0x6a, 0x00, 0x00, 0xc0, 0xff, 0x19, 0x48, 0xf5, 0x00, 0x00, 0x40, 0x75, 0x15, 0xaf, 0xea, 0x00, 0x00, 0x00, 0x70, 0x35, 0x66, 0xd5, 0x00, 0x00, 0x00, 0x58, 0x6a, 0x80, 0xea, 0x00, 0x00, 0x00, 0xdc, 0xaa, 0x80, 0xd5, 0x01, 0x00, 0x00, 0x9c, 0x27, 0x03, 0xeb, 0x01, 0x00, 0x00, 0xbc, 0x65, 0x04, 0xd4, 0x01, 0x00, 0x00, 0x3c, 0x55, 0xed, 0x6b, 0x03, 0x00, 0x00, 0x3e, 0xcd, 0x2a, 0x3e, 0x02, 0x00, 0x00, 0x7e, 0xb9, 0x2a, 0xb8, 0x03, 0x00, 0x00, 0x7c, 0x93, 0x3d, 0x91, 0x03, 0x00, 0x00, 0x7c, 0x76, 0x77, 0x96, 0x01, 0x00, 0x00, 0xf8, 0x6d, 0xf6, 0xc4, 0x01, 0x00, 0x00, 0xf8, 0xdd, 0xfe, 0xc3, 0x01, 0x00, 0x00, 0xf0, 0xb1, 0xfd, 0xfc, 0x01, 0x00, 0x00, 0xd0, 0x2f, 0xe7, 0xc1, 0x00, 0x00, 0x00, 0xc0, 0x4f, 0xe6, 0x61, 0x00, 0x00, 0x00, 0x80, 0xff, 0xf6, 0x7f, 0x00, 0x00, 0x00, 0x80, 0xfe, 0x1c, 0x3e, 0x00, 0x00, 0x00, 0x00, 0xfa, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0xa0, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; emacs-19.30/src/indent.h100444 75424 1 3137 5770115146 13535 0ustar kwzhdaemon/* Definitions for interface to indent.c 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 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. */ struct position { int bufpos; int hpos; int vpos; int prevhpos; int contin; }; struct position *compute_motion (); struct position *vmotion (); /* Value of point when current_column was called */ extern int last_known_column_point; /* Functions for dealing with the column cache. */ /* Return true iff the display table DISPTAB specifies the same widths for characters as WIDTHTAB. We use this to decide when to invalidate the buffer's column_cache. */ extern int disptab_matches_widthtab ( /* struct Lisp_Vector *disptab, struct Lisp_Vector *widthtab */ ); /* Recompute BUF's width table, using the display table DISPTAB. */ extern void recompute_width_table ( /* struct buffer *buf, struct Lisp_Vector *disptab */ ); emacs-19.30/src/intervals.h100444 75424 1 22270 5770115147 14303 0ustar kwzhdaemon/* Definitions and global variables for intervals. Copyright (C) 1993, 1994 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. */ #ifdef USE_TEXT_PROPERTIES #ifndef NORMAL_FACE #include "dispextern.h" #endif #define NULL_INTERVAL 0 #define INTERVAL_DEFAULT NULL_INTERVAL /* These are macros for dealing with the interval tree. */ /* Size of the structure used to represent an interval */ #define INTERVAL_SIZE (sizeof (struct interval)) /* Size of a pointer to an interval structure */ #define INTERVAL_PTR_SIZE (sizeof (struct interval *)) /* True if an interval pointer is null, or is a Lisp_Buffer or Lisp_String pointer (meaning it points to the owner of this interval tree). */ #define NULL_INTERVAL_P(i) ((i) == NULL_INTERVAL \ || BUFFERP ((Lisp_Object)(i)) \ || STRINGP ((Lisp_Object)(i))) /* True if this interval has no right child. */ #define NULL_RIGHT_CHILD(i) ((i)->right == NULL_INTERVAL) /* True if this interval has no left child. */ #define NULL_LEFT_CHILD(i) ((i)->left == NULL_INTERVAL) /* True if this interval has no parent. */ #define NULL_PARENT(i) (NULL_INTERVAL_P ((i)->parent)) /* True if this interval is the left child of some other interval. */ #define AM_LEFT_CHILD(i) (! NULL_INTERVAL_P ((i)->parent) \ && (i)->parent->left == (i)) /* True if this interval is the right child of some other interval. */ #define AM_RIGHT_CHILD(i) (! NULL_INTERVAL_P ((i)->parent) \ && (i)->parent->right == (i)) /* True if this interval has no children. */ #define LEAF_INTERVAL_P(i) ((i)->left == NULL_INTERVAL \ && (i)->right == NULL_INTERVAL) /* True if this interval has no parent and is therefore the root. */ #define ROOT_INTERVAL_P(i) (NULL_PARENT (i)) /* True if this interval is the only interval in the interval tree. */ #define ONLY_INTERVAL_P(i) (ROOT_INTERVAL_P ((i)) && LEAF_INTERVAL_P ((i))) /* True if this interval has both left and right children. */ #define BOTH_KIDS_P(i) ((i)->left != NULL_INTERVAL \ && (i)->right != NULL_INTERVAL) /* The total size of all text represented by this interval and all its children in the tree. This is zero if the interval is null. */ #define TOTAL_LENGTH(i) ((i) == NULL_INTERVAL ? 0 : (i)->total_length) /* The size of text represented by this interval alone. */ #define LENGTH(i) ((i) == NULL_INTERVAL ? 0 : (TOTAL_LENGTH ((i)) \ - TOTAL_LENGTH ((i)->right) \ - TOTAL_LENGTH ((i)->left))) /* The position of the character just past the end of I. Note that the position cache i->position must be valid for this to work. */ #define INTERVAL_LAST_POS(i) ((i)->position + LENGTH ((i))) /* The total size of the left subtree of this interval. */ #define LEFT_TOTAL_LENGTH(i) ((i)->left ? (i)->left->total_length : 0) /* The total size of the right subtree of this interval. */ #define RIGHT_TOTAL_LENGTH(i) ((i)->right ? (i)->right->total_length : 0) /* These macros are for dealing with the interval properties. */ /* True if this is a default interval, which is the same as being null or having no properties. */ #define DEFAULT_INTERVAL_P(i) (NULL_INTERVAL_P (i) || EQ ((i)->plist, Qnil)) /* Reset this interval to its vanilla, or no-property state. */ #define RESET_INTERVAL(i) \ { \ (i)->total_length = (i)->position = 0; \ (i)->left = (i)->right = NULL_INTERVAL; \ (i)->parent = NULL_INTERVAL; \ (i)->write_protect = 0; \ (i)->visible = 0; \ (i)->front_sticky = (i)->rear_sticky = 0; \ (i)->plist = Qnil; \ } /* Copy the cached property values of interval FROM to interval TO. */ #define COPY_INTERVAL_CACHE(from,to) \ { \ (to)->write_protect = (from)->write_protect; \ (to)->visible = (from)->visible; \ (to)->front_sticky = (from)->front_sticky; \ (to)->rear_sticky = (from)->rear_sticky; \ } /* Copy only the set bits of FROM's cache. */ #define MERGE_INTERVAL_CACHE(from,to) \ { \ if ((from)->write_protect) (to)->write_protect = 1; \ if ((from)->visible) (to)->visible = 1; \ if ((from)->front_sticky) (to)->front_sticky = 1; \ if ((from)->rear_sticky) (to)->rear_sticky = 1; \ } /* Macro determining whether the properties of an interval being inserted should be merged with the properties of the text where they are being inserted. */ #define MERGE_INSERTIONS(i) 1 /* Macro determining if an invisible interval should be displayed as a special glyph, or not at all. */ #define DISPLAY_INVISIBLE_GLYPH(i) 0 /* Is this interval visible? Replace later with cache access */ #define INTERVAL_VISIBLE_P(i) \ (! NULL_INTERVAL_P (i) && NILP (textget ((i)->plist, Qinvisible))) /* Is this interval writable? Replace later with cache access */ #define INTERVAL_WRITABLE_P(i) \ (! NULL_INTERVAL_P (i) \ && (NILP (textget ((i)->plist, Qread_only)) \ || ((CONSP (Vinhibit_read_only) \ ? !NILP (Fmemq (textget ((i)->plist, Qread_only), \ Vinhibit_read_only)) \ : !NILP (Vinhibit_read_only))))) \ /* Macros to tell whether insertions before or after this interval should stick to it. */ /* Replace later with cache access */ /*#define FRONT_STICKY_P(i) ((i)->front_sticky != 0) #define END_STICKY_P(i) ((i)->rear_sticky != 0)*/ #define FRONT_STICKY_P(i) \ (! NULL_INTERVAL_P (i) && ! NILP (textget ((i)->plist, Qfront_sticky))) #define END_NONSTICKY_P(i) \ (! NULL_INTERVAL_P (i) && ! NILP (textget ((i)->plist, Qrear_nonsticky))) /* If PROP is the `invisible' property of a character, this is 1 if the character should be treated as invisible. */ #define TEXT_PROP_MEANS_INVISIBLE(prop) \ (EQ (current_buffer->invisibility_spec, Qt) \ ? ! NILP (prop) \ : invisible_p (prop, current_buffer->invisibility_spec)) /* If PROP is the `invisible' property of a character, this is 1 if the character should be treated as invisible and should have an ellipsis. */ #define TEXT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(prop) \ (EQ (current_buffer->invisibility_spec, Qt) \ ? 0 \ : invisible_ellipsis_p (prop, current_buffer->invisibility_spec)) /* Declared in alloc.c */ extern INTERVAL make_interval (); /* Declared in intervals.c */ extern INTERVAL create_root_interval (); extern void copy_properties (); extern int intervals_equal (); extern void traverse_intervals (); extern INTERVAL split_interval_right (), split_interval_left (); extern INLINE INTERVAL find_interval (); extern INTERVAL next_interval (), previous_interval (); extern INTERVAL merge_interval_left (), merge_interval_right (); extern void delete_interval (); extern INLINE void offset_intervals (); extern void graft_intervals_into_buffer (); extern void set_point (); extern INLINE void temp_set_point (); extern void verify_interval_modification (); extern INTERVAL balance_intervals (); extern INLINE void copy_intervals_to_string (); extern INTERVAL copy_intervals (); extern Lisp_Object textget (); extern Lisp_Object get_local_map (); /* Declared in textprop.c */ /* Types of hooks. */ extern Lisp_Object Qmouse_left; extern Lisp_Object Qmouse_entered; extern Lisp_Object Qpoint_left; extern Lisp_Object Qpoint_entered; extern Lisp_Object Qmodification_hooks; extern Lisp_Object Qcategory; extern Lisp_Object Qlocal_map; /* Visual properties text (including strings) may have. */ extern Lisp_Object Qforeground, Qbackground, Qfont, Qunderline, Qstipple; extern Lisp_Object Qinvisible, Qintangible, Qread_only; extern Lisp_Object Vinhibit_point_motion_hooks; extern Lisp_Object Vdefault_text_properties; /* Sticky properties */ extern Lisp_Object Qfront_sticky, Qrear_nonsticky; extern Lisp_Object Fget_char_property (), Fget_text_property (); extern Lisp_Object Ftext_properties_at (); extern Lisp_Object Fnext_property_change (), Fprevious_property_change (); 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_not_all (); extern Lisp_Object copy_text_properties (); extern void syms_of_textprop (); #else /* don't support text properties */ #define NULL_INTERVAL_P(i) 1 #define INTERVAL_SIZE 0 #define INTERVAL_PTR_SIZE 0 #define copy_intervals_to_string(string,buffer,position,length) #define verify_interval_modification(buffer,start,end) #define insert_interval_copy(source,position,end,sink,at) #define graft_intervals_into_buffer(tree,position,bufferptr) #define offset_intervals(buffer,position,length) #define copy_intervals(tree,start,length) #define syms_of_textprop() #endif /* don't support text properties */ emacs-19.30/src/ioctl.h100444 12241 12 44 5444474567 13477 0ustar rolandstaff/* Emacs ioctl emulation for VMS */ emacs-19.30/src/line.h100444 12241 12 506 5444474574 13335 0ustar rolandstaff#define line_width 30 #define line_height 10 static char line_bits[] = { 0xf0, 0xff, 0xff, 0x03, 0x08, 0x00, 0x00, 0x04, 0x44, 0x48, 0xf4, 0x08, 0x42, 0xc8, 0x14, 0x10, 0x41, 0x48, 0x75, 0x20, 0x41, 0x48, 0x15, 0x20, 0x42, 0x48, 0x16, 0x10, 0xc4, 0x4b, 0xf4, 0x08, 0x08, 0x00, 0x00, 0x04, 0xf0, 0xff, 0xff, 0x03}; emacs-19.30/src/keyboard.h100444 75424 1 23760 5770206776 14112 0ustar kwzhdaemon/* Declarations useful when processing input. Copyright (C) 1985, 1986, 1987, 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. */ /* Length of echobuf field in each KBOARD. */ #define ECHOBUFSIZE 300 /* Each KBOARD represents one logical input stream from which Emacs gets input. If we are using an ordinary terminal, it has one KBOARD object. Usually each X display screen has its own KBOARD, but when two of them are on the same X server, we assume they share a keyboard and give them one KBOARD in common. Some Lisp variables are per-kboard; they are stored in the KBOARD structure and accessed indirectly via a Lisp_Misc_Kboard_Objfwd object. So that definition of keyboard macros, and reading of prefix arguments, can happen in parallel on various KBOARDs at once, the state information for those activities is stored in the KBOARD. Emacs has two states for reading input: ** Any kboard. Emacs can accept input from any KBOARD, and as soon as any of them provides a complete command, Emacs can run it. ** Single kboard. Then Emacs is running a command for one KBOARD and can only read input from that KBOARD. All input, from all KBOARDs, goes together in a single event queue at interrupt level. read_char sees the events sequentially, but deals with them in accord with the current input state. In the any-kboard state, read_key_sequence processes input from any KBOARD immediately. When a new event comes in from a particular KBOARD, read_key_sequence switches to that KBOARD. As a result, as soon as a complete key arrives from some KBOARD or other, Emacs starts executing that key's binding. It switches to the single-kboard state for the execution of that command, so that that command can get input only from its own KBOARD. While in the single-kboard state, read_char can consider input only from the current KBOARD. If events come from other KBOARDs, they are put aside for later in the KBOARDs' kbd_queue lists. The flag kbd_queue_has_data in a KBOARD is 1 if this has happened. When Emacs goes back to the any-kboard state, it looks at all the KBOARDS to find those; and it tries processing their input right away. */ typedef struct kboard KBOARD; struct kboard { KBOARD *next_kboard; /* If non-nil, a keymap that overrides all others but applies only to this KBOARD. Lisp code that uses this instead of calling read-char can effectively wait for input in the any-kboard state, and hence avoid blocking out the other KBOARDs. See universal-argument in lisp/simple.el for an example. */ Lisp_Object Voverriding_terminal_local_map; /* Last command executed by the editor command loop, not counting commands that set the prefix argument. */ Lisp_Object Vlast_command; /* The prefix argument for the next command, in raw form. */ Lisp_Object Vprefix_arg; /* Unread events specific to this kboard. */ Lisp_Object kbd_queue; /* Non-nil while a kbd macro is being defined. */ Lisp_Object defining_kbd_macro; /* The start of storage for the current keyboard macro. */ Lisp_Object *kbd_macro_buffer; /* Where to store the next keystroke of the macro. */ Lisp_Object *kbd_macro_ptr; /* The finalized section of the macro starts at kbd_macro_buffer and ends before this. This is not the same as kbd_macro_ptr, because we advance this to kbd_macro_ptr when a key's command is complete. This way, the keystrokes for "end-kbd-macro" are not included in the macro. */ Lisp_Object *kbd_macro_end; /* Allocated size of kbd_macro_buffer. */ int kbd_macro_bufsize; /* Last anonymous kbd macro defined. */ Lisp_Object Vlast_kbd_macro; /* Alist of system-specific X windows key symbols. */ Lisp_Object Vsystem_key_alist; /* Cache for modify_event_symbol. */ Lisp_Object system_key_syms; /* Minibufferless frames on this display use this frame's minibuffer. */ Lisp_Object Vdefault_minibuffer_frame; /* Number of displays using this KBOARD. Normally 1, but can be larger when you have multiple screens on a single X display. */ int reference_count; /* Where to append more text to echobuf if we want to. */ char *echoptr; /* The text we're echoing in the modeline - partial key sequences, usually. '\0'-terminated. This really shouldn't have a fixed size. */ char echobuf[ECHOBUFSIZE]; /* This flag indicates that events were put into kbd_queue while Emacs was running for some other KBOARD. The flag means that, when Emacs goes into the any-kboard state again, it should check this KBOARD to see if there is a complete command waiting. Note that the kbd_queue field can be non-nil even when kbd_queue_has_data is 0. When we push back an incomplete command, then this flag is 0, meaning we don't want to try reading from this KBOARD again until more input arrives. */ char kbd_queue_has_data; /* Nonzero means echo each character as typed. */ char immediate_echo; /* If we have echoed a prompt string specified by the user, this is its length. Otherwise this is -1. */ char echo_after_prompt; }; #ifdef MULTI_KBOARD /* Temporarily used before a frame has been opened, and for termcap frames */ extern KBOARD *initial_kboard; /* In the single-kboard state, this is the kboard from which input is accepted. In the any-kboard state, this is the kboard from which we are right now considering input. We can consider input from another kboard, but doing so requires throwing to wrong_kboard_jmpbuf. */ extern KBOARD *current_kboard; /* A list of all kboard objects, linked through next_kboard. */ extern KBOARD *all_kboards; /* Nonzero in the single-kboard state, 0 in the any-kboard state. */ extern int single_kboard; #else extern KBOARD the_only_kboard; #define current_kboard (&the_only_kboard) #define all_kboards (&the_only_kboard) #define single_kboard 1 #endif extern Lisp_Object Vlucid_menu_bar_dirty_flag; extern Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook; /* Total number of times read_char has returned. */ extern int num_input_chars; /* Total number of times read_char has returned, outside of macros. */ extern int num_nonmacro_input_chars; /* Nonzero means polling for input is temporarily suppressed. */ extern int poll_suppress_count; /* Nonzero if polling_for_input is actually being used. */ extern int polling_for_input; /* Keymap mapping ASCII function key sequences onto their preferred forms. Initialized by the terminal-specific lisp files. */ extern Lisp_Object Vfunction_key_map; /* Vector holding the key sequence that invoked the current command. It is reused for each command, and it may be longer than the current sequence; this_command_key_count indicates how many elements actually mean something. */ extern Lisp_Object this_command_keys; extern int this_command_key_count; #ifdef MULTI_FRAME /* The frame in which the last input event occurred, or Qmacro if the last event came from a macro. We use this to determine when to generate switch-frame events. This may be cleared by functions like Fselect_frame, to make sure that a switch-frame event is generated by the next character. */ extern Lisp_Object internal_last_event_frame; #endif /* Macros for dealing with lispy events. */ /* True iff EVENT has data fields describing it (i.e. a mouse click). */ #define EVENT_HAS_PARAMETERS(event) (CONSP (event)) /* Extract the head from an event. This works on composite and simple events. */ #define EVENT_HEAD(event) \ (EVENT_HAS_PARAMETERS (event) ? XCONS (event)->car : (event)) /* Extract the starting and ending positions from a composite event. */ #define EVENT_START(event) (XCONS (XCONS (event)->cdr)->car) #define EVENT_END(event) (XCONS (XCONS (XCONS (event)->cdr)->cdr)->car) /* Extract the click count from a multi-click event. */ #define EVENT_CLICK_COUNT(event) (Fnth ((event), make_number (2))) /* Extract the fields of a position. */ #define POSN_WINDOW(posn) (XCONS (posn)->car) #define POSN_BUFFER_POSN(posn) (XCONS (XCONS (posn)->cdr)->car) #define POSN_WINDOW_POSN(posn) (XCONS (XCONS (XCONS (posn)->cdr)->cdr)->car) #define POSN_TIMESTAMP(posn) \ (XCONS (XCONS (XCONS (XCONS (posn)->cdr)->cdr)->cdr)->car) #define POSN_SCROLLBAR_PART(posn) (Fnth ((posn), make_number (4))) /* Some of the event heads. */ extern Lisp_Object Qswitch_frame; /* Properties on event heads. */ extern Lisp_Object Qevent_kind, Qevent_symbol_elements; /* Getting an unmodified version of an event head. */ #define EVENT_HEAD_UNMODIFIED(event_head) \ (Fcar (Fget ((event_head), Qevent_symbol_elements))) /* The values of Qevent_kind properties. */ extern Lisp_Object Qfunction_key, Qmouse_click, Qmouse_movement; extern Lisp_Object Qscroll_bar_movement; /* Getting the kind of an event head. */ #define EVENT_HEAD_KIND(event_head) \ (Fget ((event_head), Qevent_kind)) /* Symbols to use for non-text mouse positions. */ extern Lisp_Object Qmode_line, Qvertical_line; extern Lisp_Object get_keymap_1 (); extern Lisp_Object Fkeymapp (); extern Lisp_Object reorder_modifiers (); extern Lisp_Object read_char (); /* User-supplied string to translate input characters through. */ extern Lisp_Object Vkeyboard_translate_table; extern Lisp_Object map_prompt (); emacs-19.30/src/lisp.h100444 75424 1 175006 6045304372 13265 0ustar kwzhdaemon/* Fundamental definitions for GNU Emacs Lisp interpreter. Copyright (C) 1985,86,87,93,94,95 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. */ /* These are default choices for the types to use. */ #ifndef EMACS_INT #define EMACS_INT int #endif #ifndef EMACS_UINT #define EMACS_UINT unsigned int #endif /* Define the fundamental Lisp data structures. */ /* This is the set of Lisp data types. */ enum Lisp_Type { /* Integer. XINT (obj) is the integer value. */ Lisp_Int, /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ Lisp_Symbol, /* Miscellaneous. XMISC (object) points to a union Lisp_Misc, whose first member indicates the subtype. */ Lisp_Misc, /* String. XSTRING (object) points to a struct Lisp_String. The length of the string, and its contents, are stored therein. */ Lisp_String, /* Vector of Lisp objects, or something resembling it. XVECTOR (object) points to a struct Lisp_Vector, which contains the size and contents. The size field also contains the type information, if it's not a real vector object. */ Lisp_Vectorlike, /* Cons. XCONS (object) points to a struct Lisp_Cons. */ Lisp_Cons, #ifdef LISP_FLOAT_TYPE Lisp_Float, #endif /* LISP_FLOAT_TYPE */ /* This is not a type code. It is for range checking. */ Lisp_Type_Limit }; /* This is the set of datatypes that share a common structure. The first member of the structure is a type code from this set. The enum values are arbitrary, but we'll use large numbers to make it more likely that we'll spot the error if a random word in memory is mistakenly interpreted as a Lisp_Misc. */ enum Lisp_Misc_Type { Lisp_Misc_Free = 0x5eab, Lisp_Misc_Marker, Lisp_Misc_Intfwd, Lisp_Misc_Boolfwd, Lisp_Misc_Objfwd, Lisp_Misc_Buffer_Objfwd, Lisp_Misc_Buffer_Local_Value, Lisp_Misc_Some_Buffer_Local_Value, Lisp_Misc_Overlay, Lisp_Misc_Kboard_Objfwd, /* Currently floats are not a misc type, but let's define this in case we want to change that. */ Lisp_Misc_Float, /* This is not a type code. It is for range checking. */ Lisp_Misc_Limit }; /* These values are overridden by the m- file on some machines. */ #ifndef VALBITS #define VALBITS 28 #endif #ifndef GCTYPEBITS #define GCTYPEBITS 3 #endif /* Make these values available in GDB, which sees enums but not macros. */ enum gdb_lisp_params { gdb_valbits = VALBITS, gdb_gctypebits = GCTYPEBITS, gdb_emacs_intbits = sizeof (EMACS_INT) * BITS_PER_CHAR, #ifdef DATA_SEG_BITS gdb_data_seg_bits = DATA_SEG_BITS #else gdb_data_seg_bits = 0 #endif }; #ifndef NO_UNION_TYPE #ifndef WORDS_BIG_ENDIAN /* Definition of Lisp_Object for little-endian machines. */ typedef union Lisp_Object { /* Used for comparing two Lisp_Objects; also, positive integers can be accessed fast this way. */ int i; struct { int val: VALBITS; int type: GCTYPEBITS+1; } s; struct { unsigned int val: VALBITS; int type: GCTYPEBITS+1; } u; struct { unsigned int val: VALBITS; enum Lisp_Type type: GCTYPEBITS; /* The markbit is not really part of the value of a Lisp_Object, and is always zero except during garbage collection. */ unsigned int markbit: 1; } gu; } Lisp_Object; #else /* If WORDS_BIG_ENDIAN */ typedef union Lisp_Object { /* Used for comparing two Lisp_Objects; also, positive integers can be accessed fast this way. */ int i; struct { int type: GCTYPEBITS+1; int val: VALBITS; } s; struct { int type: GCTYPEBITS+1; unsigned int val: VALBITS; } u; struct { /* The markbit is not really part of the value of a Lisp_Object, and is always zero except during garbage collection. */ unsigned int markbit: 1; enum Lisp_Type type: GCTYPEBITS; unsigned int val: VALBITS; } gu; } Lisp_Object; #endif /* WORDS_BIG_ENDIAN */ #endif /* NO_UNION_TYPE */ /* If union type is not wanted, define Lisp_Object as just a number and define the macros below to extract fields by shifting */ #ifdef NO_UNION_TYPE #define Lisp_Object EMACS_INT #ifndef VALMASK #define VALMASK ((((EMACS_INT) 1)<> 1) & ~MARKBIT) #endif /* no ARRAY_MARK_FLAG */ /* In the size word of a struct Lisp_Vector, this bit means it's really some other vector-like object. */ #ifndef PSEUDOVECTOR_FLAG #define PSEUDOVECTOR_FLAG ((ARRAY_MARK_FLAG >> 1) & ~ARRAY_MARK_FLAG) #endif /* In a pseudovector, the size field actually contains a word with one PSEUDOVECTOR_FLAG bit set, and exactly one of the following bits to indicate the actual type. */ enum pvec_type { PVEC_NORMAL_VECTOR = 0, PVEC_PROCESS = 0x200, PVEC_FRAME = 0x400, PVEC_COMPILED = 0x800, PVEC_WINDOW = 0x1000, PVEC_WINDOW_CONFIGURATION = 0x2000, PVEC_SUBR = 0x4000, PVEC_CHAR_TABLE = 0x8000, PVEC_BOOL_VECTOR = 0x10000, PVEC_BUFFER = 0x20000, PVEC_TYPE_MASK = 0x3fe00, PVEC_FLAG = PSEUDOVECTOR_FLAG }; /* For convenience, we also store the number of elements in these bits. */ #define PSEUDOVECTOR_SIZE_MASK 0x1ff #endif /* NO_UNION_TYPE */ /* These macros extract various sorts of values from a Lisp_Object. For example, if tem is a Lisp_Object whose type is Lisp_Cons, XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ #ifdef NO_UNION_TYPE /* One need to override this if there must be high bits set in data space (doing the result of the below & ((1 << (GCTYPE + 1)) - 1) would work on all machines, but would penalise machines which don't need it) */ #ifndef XTYPE #define XTYPE(a) ((enum Lisp_Type) ((a) >> VALBITS)) #endif #ifndef XSETTYPE #define XSETTYPE(a, b) ((a) = XUINT (a) | ((EMACS_INT)(b) << VALBITS)) #endif /* For integers known to be positive, XFASTINT provides fast retrieval and XSETFASTINT provides fast storage. This takes advantage of the fact that Lisp_Int is 0. */ #define XFASTINT(a) ((a) + 0) #define XSETFASTINT(a, b) ((a) = (b)) /* Extract the value of a Lisp_Object as a signed integer. */ #ifndef XINT /* Some machines need to do this differently. */ #define XINT(a) (((a) << (BITS_PER_INT-VALBITS)) >> (BITS_PER_INT-VALBITS)) #endif /* Extract the value as an unsigned integer. This is a basis for extracting it as a pointer to a structure in storage. */ #ifndef XUINT #define XUINT(a) ((a) & VALMASK) #endif #ifndef XPNTR #ifdef HAVE_SHM /* In this representation, data is found in two widely separated segments. */ extern int pure_size; #define XPNTR(a) \ (XUINT (a) | (XUINT (a) > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS)) #else /* not HAVE_SHM */ #ifdef DATA_SEG_BITS /* This case is used for the rt-pc. In the diffs I was given, it checked for ptr = 0 and did not adjust it in that case. But I don't think that zero should ever be found in a Lisp object whose data type says it points to something. */ #define XPNTR(a) (XUINT (a) | DATA_SEG_BITS) #else #define XPNTR(a) XUINT (a) #endif #endif /* not HAVE_SHM */ #endif /* no XPNTR */ #ifndef XSET #define XSET(var, type, ptr) \ ((var) = ((EMACS_INT)(type) << VALBITS) + ((EMACS_INT) (ptr) & VALMASK)) #endif /* During garbage collection, XGCTYPE must be used for extracting types so that the mark bit is ignored. XMARKBIT accesses the markbit. Markbits are used only in particular slots of particular structure types. Other markbits are always zero. Outside of garbage collection, all mark bits are always zero. */ #ifndef XGCTYPE #define XGCTYPE(a) ((enum Lisp_Type) (((a) >> VALBITS) & GCTYPEMASK)) #endif #if VALBITS + GCTYPEBITS == BITS_PER_INT - 1 /* Make XMARKBIT faster if mark bit is sign bit. */ #ifndef XMARKBIT #define XMARKBIT(a) ((a) < 0) #endif #endif /* markbit is sign bit */ #ifndef XMARKBIT #define XMARKBIT(a) ((a) & MARKBIT) #endif #ifndef XSETMARKBIT #define XSETMARKBIT(a,b) ((a) = ((a) & ~MARKBIT) | ((b) ? MARKBIT : 0)) #endif #ifndef XMARK #define XMARK(a) ((a) |= MARKBIT) #endif #ifndef XUNMARK #define XUNMARK(a) ((a) &= ~MARKBIT) #endif #endif /* NO_UNION_TYPE */ #ifndef NO_UNION_TYPE #define XTYPE(a) ((enum Lisp_Type) (a).u.type) #define XSETTYPE(a, b) ((a).u.type = (char) (b)) /* For integers known to be positive, XFASTINT provides fast retrieval and XSETFASTINT provides fast storage. This takes advantage of the fact that Lisp_Int is 0. */ #define XFASTINT(a) ((a).i + 0) #define XSETFASTINT(a, b) ((a).i = (b)) #ifdef EXPLICIT_SIGN_EXTEND /* Make sure we sign-extend; compilers have been known to fail to do so. */ #define XINT(a) (((a).i << (BITS_PER_INT-VALBITS)) >> (BITS_PER_INT-VALBITS)) #else #define XINT(a) ((a).s.val) #endif /* EXPLICIT_SIGN_EXTEND */ #define XUINT(a) ((a).u.val) #define XPNTR(a) ((a).u.val) #define XSET(var, vartype, ptr) \ (((var).s.type = ((char) (vartype))), ((var).s.val = ((int) (ptr)))) /* During garbage collection, XGCTYPE must be used for extracting types so that the mark bit is ignored. XMARKBIT access the markbit. Markbits are used only in particular slots of particular structure types. Other markbits are always zero. Outside of garbage collection, all mark bits are always zero. */ #define XGCTYPE(a) ((a).gu.type) #define XMARKBIT(a) ((a).gu.markbit) #define XSETMARKBIT(a,b) (XMARKBIT(a) = (b)) #define XMARK(a) (XMARKBIT(a) = 1) #define XUNMARK(a) (XMARKBIT(a) = 0) #endif /* NO_UNION_TYPE */ /* Extract a value or address from a Lisp_Object. */ #define XCONS(a) ((struct Lisp_Cons *) XPNTR(a)) #define XVECTOR(a) ((struct Lisp_Vector *) XPNTR(a)) #define XSTRING(a) ((struct Lisp_String *) XPNTR(a)) #define XSYMBOL(a) ((struct Lisp_Symbol *) XPNTR(a)) #define XFLOAT(a) ((struct Lisp_Float *) XPNTR(a)) /* Misc types. */ #define XMISC(a) ((union Lisp_Misc *) XPNTR(a)) #define XMISCTYPE(a) (XMARKER (a)->type) #define XMARKER(a) (&(XMISC(a)->u_marker)) #define XINTFWD(a) (&(XMISC(a)->u_intfwd)) #define XBOOLFWD(a) (&(XMISC(a)->u_boolfwd)) #define XOBJFWD(a) (&(XMISC(a)->u_objfwd)) #define XBUFFER_OBJFWD(a) (&(XMISC(a)->u_buffer_objfwd)) #define XBUFFER_LOCAL_VALUE(a) (&(XMISC(a)->u_buffer_local_value)) #define XOVERLAY(a) (&(XMISC(a)->u_overlay)) #define XKBOARD_OBJFWD(a) (&(XMISC(a)->u_kboard_objfwd)) /* Pseudovector types. */ #define XPROCESS(a) ((struct Lisp_Process *) XPNTR(a)) #define XWINDOW(a) ((struct window *) XPNTR(a)) #define XSUBR(a) ((struct Lisp_Subr *) XPNTR(a)) #define XBUFFER(a) ((struct buffer *) XPNTR(a)) #define XCHAR_TABLE(a) ((struct Lisp_Char_Table *) XPNTR(a)) #define XBOOL_VECTOR(a) ((struct Lisp_Bool_Vector *) XPNTR(a)) /* Construct a Lisp_Object from a value or address. */ #define XSETINT(a, b) XSET (a, Lisp_Int, b) #define XSETCONS(a, b) XSET (a, Lisp_Cons, b) #define XSETVECTOR(a, b) XSET (a, Lisp_Vectorlike, b) #define XSETSTRING(a, b) XSET (a, Lisp_String, b) #define XSETSYMBOL(a, b) XSET (a, Lisp_Symbol, b) #define XSETFLOAT(a, b) XSET (a, Lisp_Float, b) /* Misc types. */ #define XSETMISC(a, b) XSET (a, Lisp_Misc, b) #define XSETMARKER(a, b) (XSETMISC (a, b), XMISCTYPE (a) = Lisp_Misc_Marker) /* Pseudovector types. */ #define XSETPSEUDOVECTOR(a, b, code) \ (XSETVECTOR (a, b), XVECTOR (a)->size |= PSEUDOVECTOR_FLAG | (code)) #define XSETWINDOW_CONFIGURATION(a, b) \ (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION)) #define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS)) #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW)) #define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR)) #define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED)) #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER)) #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE)) #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) #ifdef USE_TEXT_PROPERTIES /* Basic data type for use of intervals. See the macros in intervals.h. */ struct interval { /* The first group of entries deal with the tree structure. */ unsigned int total_length; /* Length of myself and both children. */ unsigned int position; /* Cache of interval's character position. */ 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, for purposes of speed. */ unsigned char write_protect; /* Non-zero means can't modify. */ unsigned char visible; /* Zero means don't display. */ unsigned char front_sticky; /* Non-zero means text inserted just before this interval goes into it. */ 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; }; typedef struct interval *INTERVAL; /* Complain if object is not string or buffer type */ #define CHECK_STRING_OR_BUFFER(x, i) \ { if (!STRINGP ((x)) && !BUFFERP ((x))) \ x = wrong_type_argument (Qbuffer_or_string_p, (x)); } /* Macro used to conditionally compile intervals into certain data structures. See, e.g., struct Lisp_String below. */ #define DECLARE_INTERVALS INTERVAL intervals; /* Macro used to conditionally compile interval initialization into certain code. See, e.g., alloc.c. */ #define INITIALIZE_INTERVAL(ptr,val) ptr->intervals = val #else /* No text properties */ /* If no intervals are used, make the above definitions go away. */ #define CHECK_STRING_OR_BUFFER(x, i) #define INTERVAL #define DECLARE_INTERVALS #define INITIALIZE_INTERVAL(ptr,val) #endif /* USE_TEXT_PROPERTIES */ /* In a cons, the markbit of the car is the gc mark bit */ struct Lisp_Cons { Lisp_Object car, cdr; }; /* Like a cons, but records info on where the text lives that it was read from */ /* This is not really in use now */ struct Lisp_Buffer_Cons { Lisp_Object car, cdr; struct buffer *buffer; int bufpos; }; /* In a string or vector, the sign bit of the `size' is the gc mark bit */ struct Lisp_String { EMACS_INT size; DECLARE_INTERVALS /* `data' field must be last. */ unsigned char data[1]; }; /* If a struct is made to look like a vector, this macro returns the length of that vector. */ #define VECSIZE(type) ((sizeof (type) - (sizeof (struct Lisp_Vector) \ - sizeof (Lisp_Object))) \ / sizeof (Lisp_Object)) struct Lisp_Vector { EMACS_INT size; struct Lisp_Vector *next; Lisp_Object contents[1]; }; /* A char table is a kind of vectorlike, with contents are like a vector but with a few other slots. For some purposes, it makes sense to handle a chartable with type struct Lisp_Vector. */ /* This is the number of slots that apply to characters or character sets. */ #define CHAR_TABLE_ORDINARY_SLOTS 256 /* This is the number of slots that every char table must have. This counts the ordinary slots and the parent and defalt slots. */ #define CHAR_TABLE_STANDARD_SLOTS (256+3) /* Return the number of "extra" slots in the char table CT. */ #define CHAR_TABLE_EXTRA_SLOTS(CT) \ (((CT)->size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS) struct Lisp_Char_Table { /* This is the vector's size field, which also holds the pseudovector type information. It holds the size, too. The size counts the defalt and parent slots. */ EMACS_INT size; struct Lisp_Vector *next; Lisp_Object contents[CHAR_TABLE_ORDINARY_SLOTS]; /* This holds a default value, which is used whenever the value for a specific character is nil. */ Lisp_Object defalt; /* This points to another char table, which we inherit from when the value for a specific character is nil. The `defalt' slot takes precedence over this. */ Lisp_Object parent; /* This should be a symbol which says what kind of use this char-table is meant for. Typically now the values can be `syntax-table' and `display-table'. */ Lisp_Object purpose; /* These hold additional data. */ Lisp_Object extras[1]; }; /* A boolvector is a kind of vectorlike, with contents are like a string. */ struct Lisp_Bool_Vector { /* This is the vector's size field. It doesn't have the real size, just the subtype information. */ EMACS_INT vector_size; struct Lisp_Vector *next; /* This is the size in bits. */ EMACS_INT size; /* This contains the actual bits, packed into bytes. */ unsigned char data[1]; }; /* In a symbol, the markbit of the plist is used as the gc mark bit */ struct Lisp_Symbol { struct Lisp_String *name; Lisp_Object value; Lisp_Object function; Lisp_Object plist; struct Lisp_Symbol *next; /* -> next symbol in this obarray bucket */ }; /* This structure describes a built-in function. It is generated by the DEFUN macro only. defsubr makes it into a Lisp object. This type is treated in most respects as a pseudovector, but since we never dynamically allocate or free them, we don't need a next-vector field. */ struct Lisp_Subr { EMACS_INT size; Lisp_Object (*function) (); short min_args, max_args; char *symbol_name; char *prompt; char *doc; }; /* These structures are used for various misc types. */ /* A miscellaneous object, when it's on the free list. */ struct Lisp_Free { int type : 16; /* = Lisp_Misc_Free */ int spacer : 16; union Lisp_Misc *chain; }; /* In a marker, the markbit of the chain field is used as the gc mark bit */ struct Lisp_Marker { int type : 16; /* = Lisp_Misc_Marker */ int spacer : 15; /* 1 means normal insertion at the marker's position leaves the marker after the inserted text. */ unsigned int insertion_type : 1; struct buffer *buffer; Lisp_Object chain; int bufpos; }; /* Forwarding pointer to an int variable. This is allowed only in the value cell of a symbol, and it means that the symbol's value really lives in the specified int variable. */ struct Lisp_Intfwd { int type : 16; /* = Lisp_Misc_Intfwd */ int spacer : 16; int *intvar; }; /* Boolean forwarding pointer to an int variable. This is like Lisp_Intfwd except that the ostensible "value" of the symbol is t if the int variable is nonzero, nil if it is zero. */ struct Lisp_Boolfwd { int type : 16; /* = Lisp_Misc_Boolfwd */ int spacer : 16; int *boolvar; }; /* Forwarding pointer to a Lisp_Object variable. This is allowed only in the value cell of a symbol, and it means that the symbol's value really lives in the specified variable. */ struct Lisp_Objfwd { int type : 16; /* = Lisp_Misc_Objfwd */ int spacer : 16; Lisp_Object *objvar; }; /* Like Lisp_Objfwd except that value lives in a slot in the current buffer. Value is byte index of slot within buffer. */ struct Lisp_Buffer_Objfwd { int type : 16; /* = Lisp_Misc_Buffer_Objfwd */ int spacer : 16; int offset; }; /* Used in a symbol value cell when the symbol's value is per-buffer. The actual contents resemble a cons cell which starts a list like this: (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE). The cons-like structure is for historical reasons; it might be better to just put these elements into the struct, now. BUFFER is the last buffer for which this symbol's value was made up to date. CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's local_var_alist, that being the element whose car is this variable. Or it can be a pointer to the (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have an element in its alist for this variable (that is, if BUFFER sees the default value of this variable). If we want to examine or set the value and BUFFER is current, we just examine or set REALVALUE. If BUFFER is not current, we store the current REALVALUE value into CURRENT-ALIST-ELEMENT, then find the appropriate alist element for the buffer now current and set up CURRENT-ALIST-ELEMENT. Then we set REALVALUE out of that element, and store into BUFFER. If we are setting the variable and the current buffer does not have an alist entry for this variable, an alist entry is created. Note that REALVALUE can be a forwarding pointer. Each time it is examined or set, forwarding must be done. Each time we switch buffers, buffer-local variables which forward into C variables are swapped immediately, so the C code can assume that they are always up to date. Lisp_Misc_Buffer_Local_Value and Lisp_Misc_Some_Buffer_Local_Value use the same substructure. The difference is that with the latter, merely setting the variable while some buffer is current does not cause that buffer to have its own local value of this variable. Only make-local-variable does that. */ struct Lisp_Buffer_Local_Value { int type : 16; /* = Lisp_Misc_Buffer_Local_Value or Lisp_Misc_Some_Buffer_Local_Value */ int spacer : 16; Lisp_Object car, cdr; }; /* In an overlay object, the mark bit of the plist is used as the GC mark. START and END are markers in the overlay's buffer, and PLIST is the overlay's property list. */ struct Lisp_Overlay { int type : 16; /* = Lisp_Misc_Overlay */ int spacer : 16; Lisp_Object start, end, plist; }; /* Like Lisp_Objfwd except that value lives in a slot in the current kboard. */ struct Lisp_Kboard_Objfwd { int type : 16; /* = Lisp_Misc_Kboard_Objfwd */ int spacer : 16; int offset; }; /* To get the type field of a union Lisp_Misc, use XMISCTYPE. It uses one of these struct subtypes to get the type field. */ union Lisp_Misc { struct Lisp_Free u_free; struct Lisp_Marker u_marker; struct Lisp_Intfwd u_intfwd; struct Lisp_Boolfwd u_boolfwd; struct Lisp_Objfwd u_objfwd; struct Lisp_Buffer_Objfwd u_buffer_objfwd; struct Lisp_Buffer_Local_Value u_buffer_local_value; struct Lisp_Overlay u_overlay; struct Lisp_Kboard_Objfwd u_kboard_objfwd; }; #ifdef LISP_FLOAT_TYPE /* Optional Lisp floating point type */ struct Lisp_Float { Lisp_Object type; /* essentially used for mark-bit and chaining when on free-list */ double data; }; #endif /* LISP_FLOAT_TYPE */ /* A character, declared with the following typedef, is a member of some character set associated with the current buffer. */ #ifndef _UCHAR_T /* Protect against something in ctab.h on AIX. */ #define _UCHAR_T typedef unsigned char UCHAR; #endif /* Meanings of slots in a Lisp_Compiled: */ #define COMPILED_ARGLIST 0 #define COMPILED_BYTECODE 1 #define COMPILED_CONSTANTS 2 #define COMPILED_STACK_DEPTH 3 #define COMPILED_DOC_STRING 4 #define COMPILED_INTERACTIVE 5 /* Flag bits in a character. These also get used in termhooks.h. Richard Stallman thinks that MULE (MUlti-Lingual Emacs) might need 22 bits for the character value itself, so we probably shouldn't use any bits lower than 0x0400000. */ #define CHAR_ALT (0x0400000) #define CHAR_SUPER (0x0800000) #define CHAR_HYPER (0x1000000) #define CHAR_SHIFT (0x2000000) #define CHAR_CTL (0x4000000) #define CHAR_META (0x8000000) #ifdef USE_X_TOOLKIT #ifdef NO_UNION_TYPE /* Use this for turning a (void *) into a Lisp_Object, as when the Lisp_Object is passed into a toolkit callback function. */ #define VOID_TO_LISP(larg,varg) \ do { ((larg) = ((Lisp_Object) (varg))); } while (0) #define CVOID_TO_LISP VOID_TO_LISP /* Use this for turning a Lisp_Object into a (void *), as when the Lisp_Object is passed into a toolkit callback function. */ #define LISP_TO_VOID(larg) ((void *) (larg)) #define LISP_TO_CVOID(varg) ((const void *) (larg)) #else /* not NO_UNION_TYPE */ /* Use this for turning a (void *) into a Lisp_Object, as when the Lisp_Object is passed into a toolkit callback function. */ #define VOID_TO_LISP(larg,varg) \ do { ((larg).v = (void *) (varg)); } while (0) #define CVOID_TO_LISP(larg,varg) \ do { ((larg).cv = (const void *) (varg)); } while (0) /* Use this for turning a Lisp_Object into a (void *), as when the Lisp_Object is passed into a toolkit callback function. */ #define LISP_TO_VOID(larg) ((larg).v) #define LISP_TO_CVOID(larg) ((larg).cv) #endif /* not NO_UNION_TYPE */ #endif /* USE_X_TOOLKIT */ /* The glyph datatype, used to represent characters on the display. */ /* The low eight bits are the character code, and the bits above them are the numeric face ID. If FID is the face ID of a glyph on a frame F, then F->display.x->faces[FID] contains the description of that face. This is an int instead of a short, so we can support a good bunch of face ID's; given that we have no mechanism for tossing unused frame face ID's yet, we'll probably run out of 255 pretty quickly. */ #define GLYPH unsigned int #ifdef HAVE_FACES /* The FAST macros assume that we already know we're in an X window. */ /* Given a character code and a face ID, return the appropriate glyph. */ #define FAST_MAKE_GLYPH(char, face) ((char) | ((face) << 8)) /* Return a glyph's character code. */ #define FAST_GLYPH_CHAR(glyph) ((glyph) & 0xff) /* Return a glyph's face ID. */ #define FAST_GLYPH_FACE(glyph) (((glyph) >> 8) & ((1 << 24) - 1)) /* Slower versions that test the frame type first. */ #define MAKE_GLYPH(f, char, face) (FRAME_TERMCAP_P (f) ? (char) \ : FAST_MAKE_GLYPH (char, face)) #define GLYPH_CHAR(f, g) (FRAME_TERMCAP_P (f) ? (g) : FAST_GLYPH_CHAR (g)) #define GLYPH_FACE(f, g) (FRAME_TERMCAP_P (f) ? (0) : FAST_GLYPH_FACE (g)) #else /* not HAVE_FACES */ #define MAKE_GLYPH(f, char, face) (char) #define GLYPH_CHAR(f, g) (g) #define GLYPH_FACE(f, g) (g) #endif /* not HAVE_FACES */ /* The ID of the mode line highlighting face. */ #define GLYPH_MODE_LINE_FACE 1 /* Data type checking */ #define NILP(x) (XFASTINT (x) == XFASTINT (Qnil)) #define GC_NILP(x) GC_EQ (x, Qnil) #ifdef LISP_FLOAT_TYPE #define NUMBERP(x) (INTEGERP (x) || FLOATP (x)) #define GC_NUMBERP(x) (GC_INTEGERP (x) || GC_FLOATP (x)) #else #define NUMBERP(x) (INTEGERP (x)) #define GC_NUMBERP(x) (GC_INTEGERP (x)) #endif #define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0) #define GC_NATNUMP(x) (GC_INTEGERP (x) && XINT (x) >= 0) #define INTEGERP(x) (XTYPE ((x)) == Lisp_Int) #define GC_INTEGERP(x) (XGCTYPE ((x)) == Lisp_Int) #define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol) #define GC_SYMBOLP(x) (XGCTYPE ((x)) == Lisp_Symbol) #define MISCP(x) (XTYPE ((x)) == Lisp_Misc) #define GC_MISCP(x) (XGCTYPE ((x)) == Lisp_Misc) #define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike) #define GC_VECTORLIKEP(x) (XGCTYPE ((x)) == Lisp_Vectorlike) #define STRINGP(x) (XTYPE ((x)) == Lisp_String) #define GC_STRINGP(x) (XGCTYPE ((x)) == Lisp_String) #define CONSP(x) (XTYPE ((x)) == Lisp_Cons) #define GC_CONSP(x) (XGCTYPE ((x)) == Lisp_Cons) #ifdef LISP_FLOAT_TYPE #define FLOATP(x) (XTYPE ((x)) == Lisp_Float) #define GC_FLOATP(x) (XGCTYPE ((x)) == Lisp_Float) #else #define FLOATP(x) (0) #define GC_FLOATP(x) (0) #endif #define VECTORP(x) (VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG)) #define GC_VECTORP(x) (GC_VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG)) #define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) #define GC_OVERLAYP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) #define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) #define GC_MARKERP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) #define INTFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Intfwd) #define GC_INTFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Intfwd) #define BOOLFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Boolfwd) #define GC_BOOLFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Boolfwd) #define OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Objfwd) #define GC_OBJFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Objfwd) #define BUFFER_OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Objfwd) #define GC_BUFFER_OBJFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Objfwd) #define BUFFER_LOCAL_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Local_Value) #define GC_BUFFER_LOCAL_VALUEP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Local_Value) #define SOME_BUFFER_LOCAL_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Some_Buffer_Local_Value) #define GC_SOME_BUFFER_LOCAL_VALUEP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Some_Buffer_Local_Value) #define KBOARD_OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Kboard_Objfwd) #define GC_KBOARD_OBJFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Kboard_Objfwd) /* True if object X is a pseudovector whose code is CODE. */ #define PSEUDOVECTORP(x, code) \ (VECTORLIKEP (x) \ && (((XVECTOR (x)->size & (PSEUDOVECTOR_FLAG | (code)))) \ == (PSEUDOVECTOR_FLAG | (code)))) /* True if object X is a pseudovector whose code is CODE. This one works during GC. */ #define GC_PSEUDOVECTORP(x, code) \ (GC_VECTORLIKEP (x) \ && (((XVECTOR (x)->size & (PSEUDOVECTOR_FLAG | (code)))) \ == (PSEUDOVECTOR_FLAG | (code)))) /* Test for specific pseudovector types. */ #define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION) #define GC_WINDOW_CONFIGURATIONP(x) GC_PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION) #define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS) #define GC_PROCESSP(x) GC_PSEUDOVECTORP (x, PVEC_PROCESS) #define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW) #define GC_WINDOWP(x) GC_PSEUDOVECTORP (x, PVEC_WINDOW) #define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR) #define GC_SUBRP(x) GC_PSEUDOVECTORP (x, PVEC_SUBR) #define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) #define GC_COMPILEDP(x) GC_PSEUDOVECTORP (x, PVEC_COMPILED) #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER) #define GC_BUFFERP(x) GC_PSEUDOVECTORP (x, PVEC_BUFFER) #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE) #define GC_CHAR_TABLE_P(x) GC_PSEUDOVECTORP (x, PVEC_CHAR_TABLE) #define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) #define GC_BOOL_VECTOR_P(x) GC_PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) #ifdef MULTI_FRAME #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) #define GC_FRAMEP(x) GC_PSEUDOVECTORP (x, PVEC_FRAME) #else #ifdef HAVE_MOUSE /* We could use this in the !HAVE_MOUSE case also, but we prefer a compile-time error message in case FRAMEP is used. */ #define FRAMEP(x) (EQ (x, Fselected_frame ())) #define GC_FRAMEP(x) (GC_EQ (x, Fselected_frame ())) #endif #endif #define EQ(x, y) (XFASTINT (x) == XFASTINT (y)) #define GC_EQ(x, y) (XGCTYPE (x) == XGCTYPE (y) && XPNTR (x) == XPNTR (y)) #define CHECK_LIST(x, i) \ do { if (!CONSP ((x)) && !NILP (x)) x = wrong_type_argument (Qlistp, (x)); } while (0) #define CHECK_STRING(x, i) \ do { if (!STRINGP ((x))) x = wrong_type_argument (Qstringp, (x)); } while (0) #define CHECK_CONS(x, i) \ do { if (!CONSP ((x))) x = wrong_type_argument (Qconsp, (x)); } while (0) #define CHECK_SYMBOL(x, i) \ do { if (!SYMBOLP ((x))) x = wrong_type_argument (Qsymbolp, (x)); } while (0) #define CHECK_CHAR_TABLE(x, i) \ do { if (!CHAR_TABLE_P ((x))) \ x = wrong_type_argument (Qchar_table_p, (x)); } while (0) #define CHECK_VECTOR(x, i) \ do { if (!VECTORP ((x))) x = wrong_type_argument (Qvectorp, (x)); } while (0) #define CHECK_VECTOR_OR_CHAR_TABLE(x, i) \ do { if (!VECTORP ((x)) && !CHAR_TABLE_P ((x))) \ x = wrong_type_argument (Qvector_or_char_table_p, (x)); \ } while (0) #define CHECK_BUFFER(x, i) \ do { if (!BUFFERP ((x))) x = wrong_type_argument (Qbufferp, (x)); } while (0) #define CHECK_WINDOW(x, i) \ do { if (!WINDOWP ((x))) x = wrong_type_argument (Qwindowp, (x)); } while (0) /* This macro rejects windows on the interior of the window tree as "dead", which is what we want; this is an argument-checking macro, and the user should never get access to interior windows. A window of any sort, leaf or interior, is dead iff the buffer, vchild, and hchild members are all nil. */ #define CHECK_LIVE_WINDOW(x, i) \ do { \ if (!WINDOWP ((x)) \ || NILP (XWINDOW ((x))->buffer)) \ x = wrong_type_argument (Qwindow_live_p, (x)); \ } while (0) #define CHECK_PROCESS(x, i) \ do { if (!PROCESSP ((x))) x = wrong_type_argument (Qprocessp, (x)); } while (0) #define CHECK_NUMBER(x, i) \ do { if (!INTEGERP ((x))) x = wrong_type_argument (Qintegerp, (x)); } while (0) #define CHECK_NATNUM(x, i) \ do { if (!NATNUMP (x)) x = wrong_type_argument (Qwholenump, (x)); } while (0) #define CHECK_MARKER(x, i) \ do { if (!MARKERP ((x))) x = wrong_type_argument (Qmarkerp, (x)); } while (0) #define CHECK_NUMBER_COERCE_MARKER(x, i) \ do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \ else if (!INTEGERP ((x))) x = wrong_type_argument (Qinteger_or_marker_p, (x)); } while (0) #ifdef LISP_FLOAT_TYPE #ifndef DBL_DIG #define DBL_DIG 20 #endif #define XFLOATINT(n) extract_float((n)) #define CHECK_FLOAT(x, i) \ do { if (!FLOATP (x)) \ x = wrong_type_argument (Qfloatp, (x)); } while (0) #define CHECK_NUMBER_OR_FLOAT(x, i) \ do { if (!FLOATP (x) && !INTEGERP (x)) \ x = wrong_type_argument (Qnumberp, (x)); } while (0) #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x, i) \ do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \ else if (!INTEGERP (x) && !FLOATP (x)) \ x = wrong_type_argument (Qnumber_or_marker_p, (x)); } while (0) #else /* Not LISP_FLOAT_TYPE */ #define CHECK_NUMBER_OR_FLOAT CHECK_NUMBER #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER CHECK_NUMBER_COERCE_MARKER #define XFLOATINT(n) XINT((n)) #endif /* LISP_FLOAT_TYPE */ #define CHECK_OVERLAY(x, i) \ do { if (!OVERLAYP ((x))) x = wrong_type_argument (Qoverlayp, (x));} while (0) /* Cast pointers to this type to compare them. Some machines want int. */ #ifndef PNTR_COMPARISON_TYPE #define PNTR_COMPARISON_TYPE unsigned int #endif /* Define a built-in function for calling from Lisp. `lname' should be the name to give the function in Lisp, as a null-terminated C string. `fnname' should be the name of the function in C. By convention, it starts with F. `sname' should be the name for the C constant structure that records information on this function for internal use. By convention, it should be the same as `fnname' but with S instead of F. It's too bad that C macros can't compute this from `fnname'. `minargs' should be a number, the minimum number of arguments allowed. `maxargs' should be a number, the maximum number of arguments allowed, or else MANY or UNEVALLED. MANY means pass a vector of evaluated arguments, in the form of an integer number-of-arguments followed by the address of a vector of Lisp_Objects which contains the argument values. UNEVALLED means pass the list of unevaluated arguments `prompt' says how to read arguments for an interactive call. See the doc string for `interactive'. A null string means call interactively with no arguments. `doc' is documentation for the user. */ #if !defined (__STDC__) || defined (USE_NONANSI_DEFUN) #define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \ Lisp_Object fnname (); \ struct Lisp_Subr sname = \ { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \ fnname, minargs, maxargs, lname, prompt, 0}; \ Lisp_Object fnname #else /* This version of DEFUN declares a function prototype with the right arguments, so we can catch errors with maxargs at compile-time. */ #define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \ Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ struct Lisp_Subr sname = \ { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \ fnname, minargs, maxargs, lname, prompt, 0}; \ Lisp_Object fnname /* Note that the weird token-substitution semantics of ANSI C makes this work for MANY and UNEVALLED. */ #define DEFUN_ARGS_MANY (int, Lisp_Object *) #define DEFUN_ARGS_UNEVALLED (Lisp_Object) #define DEFUN_ARGS_0 (void) #define DEFUN_ARGS_1 (Lisp_Object) #define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object) #define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object) #define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) #define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ Lisp_Object) #define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ Lisp_Object, Lisp_Object) #define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ Lisp_Object, Lisp_Object, Lisp_Object) #endif /* defsubr (Sname); is how we define the symbol for function `name' at start-up time. */ extern void defsubr (); #define MANY -2 #define UNEVALLED -1 extern void defvar_lisp (); extern void defvar_bool (); extern void defvar_int (); extern void defvar_kboard (); /* Macros we use to define forwarded Lisp variables. These are used in the syms_of_FILENAME functions. */ #define DEFVAR_LISP(lname, vname, doc) defvar_lisp (lname, vname) #define DEFVAR_LISP_NOPRO(lname, vname, doc) defvar_lisp_nopro (lname, vname) #define DEFVAR_BOOL(lname, vname, doc) defvar_bool (lname, vname) #define DEFVAR_INT(lname, vname, doc) defvar_int (lname, vname) #define DEFVAR_PER_BUFFER(lname, vname, type, doc) \ defvar_per_buffer (lname, vname, type, 0) #define DEFVAR_KBOARD(lname, vname, doc) \ defvar_kboard (lname, \ (int)((char *)(¤t_kboard->vname) \ - (char *)current_kboard)) /* Structure for recording Lisp call stack for backtrace purposes. */ /* The special binding stack holds the outer values of variables while they are bound by a function application or a let form, stores the code to be executed for Lisp unwind-protect forms, and stores the C functions to be called for record_unwind_protect. If func is non-zero, undoing this binding applies func to old_value; This implements record_unwind_protect. If func is zero and symbol is nil, undoing this binding evaluates the list of forms in old_value; this implements Lisp's unwind-protect form. Otherwise, undoing this binding stores old_value as symbol's value; this undoes the bindings made by a let form or function call. */ struct specbinding { Lisp_Object symbol, old_value; Lisp_Object (*func) (); Lisp_Object unused; /* Dividing by 16 is faster than by 12 */ }; extern struct specbinding *specpdl; extern struct specbinding *specpdl_ptr; extern int specpdl_size; /* Everything needed to describe an active condition case. */ struct handler { /* The handler clauses and variable from the condition-case form. */ Lisp_Object handler; Lisp_Object var; /* Fsignal stores here the condition-case clause that applies, and Fcondition_case thus knows which clause to run. */ Lisp_Object chosen_clause; /* Used to effect the longjump out to the handler. */ struct catchtag *tag; /* The next enclosing handler. */ struct handler *next; }; extern struct handler *handlerlist; extern struct catchtag *catchlist; extern struct backtrace *backtrace_list; extern Lisp_Object memory_signal_data; /* An address near the bottom of the stack. Tells GC how to save a copy of the stack. */ extern char *stack_bottom; /* Check quit-flag and quit if it is non-nil. */ #define QUIT \ if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \ { Vquit_flag = Qnil; Fsignal (Qquit, Qnil); } /* Nonzero if ought to quit now. */ #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) /* 1 if CH is upper case. */ #define UPPERCASEP(CH) \ (XCHAR_TABLE (current_buffer->downcase_table)->contents[CH] != (CH)) /* 1 if CH is lower case. */ #define LOWERCASEP(CH) \ (!UPPERCASEP (CH) \ && XCHAR_TABLE (current_buffer->upcase_table)->contents[CH] != (CH)) /* 1 if CH is neither upper nor lower case. */ #define NOCASEP(CH) \ (XCHAR_TABLE (current_buffer->upcase_table)->contents[CH] == (CH)) /* Upcase a character, or make no change if that cannot be done. */ #define UPCASE(CH) \ (XCHAR_TABLE (current_buffer->downcase_table)->contents[CH] == (CH) \ ? UPCASE1 (CH) : (CH)) /* Upcase a character known to be not upper case. */ #define UPCASE1(CH) (XCHAR_TABLE (current_buffer->upcase_table)->contents[CH]) /* Downcase a character, or make no change if that cannot be done. */ #define DOWNCASE(CH) \ (XCHAR_TABLE (current_buffer->downcase_table)->contents[CH]) /* Current buffer's map from characters to lower-case characters. */ #define DOWNCASE_TABLE XCHAR_TABLE (current_buffer->downcase_table)->contents extern Lisp_Object Vascii_downcase_table; /* Number of bytes of structure consed since last GC. */ extern int consing_since_gc; /* Threshold for doing another gc. */ extern int gc_cons_threshold; /* Structure for recording stack slots that need marking. */ /* This is a chain of structures, each of which points at a Lisp_Object variable whose value should be marked in garbage collection. Normally every link of the chain is an automatic variable of a function, and its `val' points to some argument or local variable of the function. On exit to the function, the chain is set back to the value it had on entry. This way, no link remains in the chain when the stack frame containing the link disappears. Every function that can call Feval must protect in this fashion all Lisp_Object variables whose contents will be used again. */ extern struct gcpro *gcprolist; struct gcpro { struct gcpro *next; Lisp_Object *var; /* Address of first protected variable */ int nvars; /* Number of consecutive protected variables */ }; #define GCPRO1(varname) \ {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \ gcprolist = &gcpro1; } #define GCPRO2(varname1, varname2) \ {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ gcprolist = &gcpro2; } #define GCPRO3(varname1, varname2, varname3) \ {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ gcprolist = &gcpro3; } #define GCPRO4(varname1, varname2, varname3, varname4) \ {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ gcprolist = &gcpro4; } #define GCPRO5(varname1, varname2, varname3, varname4, varname5) \ {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \ gcprolist = &gcpro5; } /* Call staticpro (&var) to protect static variable `var'. */ void staticpro(); #define UNGCPRO (gcprolist = gcpro1.next) /* Evaluate expr, UNGCPRO, and then return the value of expr. */ #define RETURN_UNGCPRO(expr) \ if (1) \ { \ Lisp_Object ret_ungc_val; \ ret_ungc_val = (expr); \ UNGCPRO; \ return ret_ungc_val; \ } \ else /* Defined in data.c */ extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound; extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; extern Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range; extern Lisp_Object Qvoid_variable, Qvoid_function; extern Lisp_Object Qsetting_constant, Qinvalid_read_syntax; extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; 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; extern Lisp_Object Qoverflow_error, Qunderflow_error; extern Lisp_Object Qintegerp, Qnumberp, Qnatnump, Qwholenump; extern Lisp_Object Qsymbolp, Qlistp, Qconsp; extern Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp; extern Lisp_Object Qchar_or_string_p, Qmarkerp, Qvectorp; extern Lisp_Object Qinteger_or_marker_p, Qnumber_or_marker_p; extern Lisp_Object Qchar_table_p, Qvector_or_char_table_p; extern Lisp_Object Qboundp, Qfboundp; extern Lisp_Object Qbuffer_or_string_p; extern Lisp_Object Qcdr; #ifdef LISP_FLOAT_TYPE extern Lisp_Object Qfloatp, Qinteger_or_floatp, Qinteger_or_float_or_marker_p; #endif /* LISP_FLOAT_TYPE */ extern Lisp_Object Qframep; extern Lisp_Object Feq (), Fnull (), Flistp (), Fconsp (), Fatom (), Fnlistp (); extern Lisp_Object Fintegerp (), Fnatnump (), Fsymbolp (); extern Lisp_Object Fvectorp (), Fstringp (), Farrayp (), Fsequencep (); extern Lisp_Object Fbufferp (), Fmarkerp (), Fsubrp (), Fchar_or_string_p (); extern Lisp_Object Finteger_or_marker_p (); #ifdef LISP_FLOAT_TYPE extern Lisp_Object Ffloatp(), Finteger_or_floatp(); extern Lisp_Object Finteger_or_float_or_marker_p(), Ftruncate(); #endif /* LISP_FLOAT_TYPE */ extern Lisp_Object Fcar (), Fcar_safe(), Fcdr (), Fcdr_safe(); extern Lisp_Object Fsetcar (), Fsetcdr (); extern Lisp_Object Fboundp (), Ffboundp (), Fmakunbound (), Ffmakunbound (); extern Lisp_Object Fsymbol_function (), Fsymbol_plist (), Fsymbol_name (); extern Lisp_Object indirect_function (), Findirect_function (); extern Lisp_Object Ffset (), Fsetplist (); extern Lisp_Object Fsymbol_value (), find_symbol_value (), Fset (); extern Lisp_Object Fdefault_value (), Fset_default (), Fdefault_boundp (); extern Lisp_Object Faref (), Faset (); extern Lisp_Object Fstring_to_number (), Fnumber_to_string (); extern Lisp_Object Feqlsign (), Fgtr (), Flss (), Fgeq (), Fleq (); extern Lisp_Object Fneq (), Fzerop (); extern Lisp_Object Fplus (), Fminus (), Ftimes (), Fquo (), Frem (); extern Lisp_Object Fmax (), Fmin (); extern Lisp_Object Flogand (), Flogior (), Flogxor (), Flognot (); extern Lisp_Object Flsh (), Fash (); extern Lisp_Object Fadd1 (), Fsub1 (); extern Lisp_Object make_number (); extern Lisp_Object long_to_cons (); extern unsigned long cons_to_long (); extern void args_out_of_range (); extern void args_out_of_range_3 (); extern Lisp_Object wrong_type_argument (); extern void store_symval_forwarding (); extern Lisp_Object do_symval_forwarding (); #ifdef LISP_FLOAT_TYPE extern Lisp_Object Ffloat_to_int(), Fint_to_float(); extern double extract_float(); extern Lisp_Object make_float (); extern Lisp_Object Ffloat (); #endif /* LISP_FLOAT_TYPE */ /* Defined in cmds.c */ extern Lisp_Object Fend_of_line (), Fforward_char (), Fforward_line (); /* Defined in syntax.c */ extern Lisp_Object Fforward_word (); /* Defined in fns.c */ extern Lisp_Object Qstring_lessp; extern Lisp_Object Vfeatures; extern Lisp_Object Fidentity (), Frandom (); extern Lisp_Object Flength (), Fsafe_length (); extern Lisp_Object Fappend (), Fconcat (), Fvconcat (), Fcopy_sequence (); extern Lisp_Object Fsubstring (); extern Lisp_Object Fnth (), Fnthcdr (), Fmemq (), Fassq (), Fassoc (); extern Lisp_Object Felt (), Fmember (), Frassq (), Fdelq (), Fsort (); extern Lisp_Object Freverse (), Fnreverse (), Fget (), Fput (), Fequal (); extern Lisp_Object Ffillarray (), Fnconc (), Fmapcar (), Fmapconcat (); extern Lisp_Object Fy_or_n_p (), do_yes_or_no_p (); extern Lisp_Object Ffeaturep (), Frequire () , Fprovide (); extern Lisp_Object concat2 (), nconc2 (); extern Lisp_Object assq_no_quit (); extern Lisp_Object Fcopy_alist (); extern Lisp_Object Fplist_get (); /* Defined in insdel.c */ extern void move_gap (); extern void make_gap (); extern void insert (); extern void insert_and_inherit (); extern void insert_1 (); extern void insert_from_string (); extern void insert_from_buffer (); extern void insert_char (); extern void insert_string (); extern void insert_before_markers (); extern void insert_before_markers_and_inherit (); extern void insert_from_string_before_markers (); extern void del_range (); extern void del_range_1 (); extern void modify_region (); extern void prepare_to_modify_buffer (); extern void signal_before_change (); extern void signal_after_change (); /* Defined in xdisp.c */ extern Lisp_Object Vmessage_log_max; extern void message (); extern void message_nolog (); extern void message1 (); extern void message1_nolog (); extern void message2 (); extern void message2_nolog (); extern void message_dolog (); extern void message_log_maybe_newline (); /* Defined in alloc.c */ extern Lisp_Object Vpurify_flag; extern Lisp_Object Fcons (), Flist(), Fmake_list (), allocate_misc (); extern Lisp_Object Fmake_vector (), Fvector (), Fmake_symbol (), Fmake_marker (); extern Lisp_Object Fmake_string (), build_string (), make_string (); extern Lisp_Object make_event_array (), make_uninit_string (); extern Lisp_Object Fpurecopy (), make_pure_string (); extern Lisp_Object pure_cons (), make_pure_vector (); extern Lisp_Object Fgarbage_collect (); extern Lisp_Object Fmake_byte_code (); extern Lisp_Object Qchar_table_extra_slots; extern struct Lisp_Vector *allocate_vectorlike (); extern int gc_in_progress; /* Defined in print.c */ extern Lisp_Object Vprin1_to_string_buffer; extern Lisp_Object Fprin1 (), Fprin1_to_string (), Fprinc (); extern Lisp_Object Fterpri (), Fprint (); extern Lisp_Object Vstandard_output, Qstandard_output; extern Lisp_Object Qexternal_debugging_output; extern void temp_output_buffer_setup (), temp_output_buffer_show (); extern int print_level, print_escape_newlines; extern Lisp_Object Qprint_escape_newlines; /* Defined in lread.c */ extern Lisp_Object Qvariable_documentation, Qstandard_input; extern Lisp_Object Vobarray, Vstandard_input; extern Lisp_Object Fread (), Fread_from_string (); extern Lisp_Object Fintern (), Fintern_soft (), Fload (); extern Lisp_Object Fget_file_char (), Fread_char (); extern Lisp_Object read_filtered_event (); extern Lisp_Object Feval_current_buffer (), Feval_region (); extern Lisp_Object intern (), oblookup (); #define LOADHIST_ATTACH(x) \ if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list) extern Lisp_Object Vcurrent_load_list; extern Lisp_Object Vload_history; /* Defined in eval.c */ extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro; extern Lisp_Object Vinhibit_quit, Qinhibit_quit, Vquit_flag; extern Lisp_Object Vmocklisp_arguments, Qmocklisp, Qmocklisp_arguments; extern Lisp_Object Vautoload_queue; extern Lisp_Object Vdebug_on_error; /* To run a normal hook, use the appropriate function from the list below. The calling convention: if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, Qmy_funny_hook); should no longer be used. */ extern Lisp_Object Vrun_hooks; extern Lisp_Object Frun_hooks (), Frun_hook_with_args (); extern Lisp_Object Frun_hook_with_args_until_success (); extern Lisp_Object Frun_hook_with_args_until_failure (); extern Lisp_Object Fand (), For (), Fif (), Fprogn (), Fprog1 (), Fprog2 (); extern Lisp_Object Fsetq (), Fquote (); extern Lisp_Object Fuser_variable_p (), Finteractive_p (); extern Lisp_Object Fdefun (), Flet (), FletX (), Fwhile (); extern Lisp_Object Fcatch (), Fthrow (), Funwind_protect (); extern Lisp_Object Fcondition_case (), Fsignal (); extern Lisp_Object Ffunction_type (), Fautoload (), Fcommandp (); extern Lisp_Object Feval (), Fapply (), Ffuncall (); extern Lisp_Object Fglobal_set (), Fglobal_value (), Fbacktrace (); extern Lisp_Object apply1 (), call0 (), call1 (), call2 (), call3 (); extern Lisp_Object call4 (), call5 (), call6 (); extern Lisp_Object Fkill_emacs (), Fkey_binding (), Fsit_for (); extern Lisp_Object Fdo_auto_save (), Fset_marker (); extern Lisp_Object apply_lambda (); extern Lisp_Object internal_catch (); extern Lisp_Object internal_condition_case (); extern Lisp_Object internal_condition_case_1 (); extern Lisp_Object unbind_to (); extern void error (); extern Lisp_Object un_autoload (); extern Lisp_Object Ffetch_bytecode (); /* Defined in editfns.c */ extern Lisp_Object Fgoto_char (); extern Lisp_Object Fpoint_min_marker (), Fpoint_max_marker (); extern Lisp_Object Fpoint_min (), Fpoint_max (); extern Lisp_Object Fpoint (), Fpoint_marker (), Fmark_marker (); extern Lisp_Object Ffollowing_char (), Fprevious_char (), Fchar_after (); extern Lisp_Object Finsert (); extern Lisp_Object Feolp (), Feobp (), Fbolp (), Fbobp (); extern Lisp_Object Fformat (), format1 (); extern Lisp_Object make_buffer_string (), Fbuffer_substring (); extern Lisp_Object Fbuffer_string (); extern Lisp_Object Fstring_equal (), Fstring_lessp (), Fbuffer_substring_lessp (); extern Lisp_Object save_excursion_save (), save_restriction_save (); extern Lisp_Object save_excursion_restore (), save_restriction_restore (); extern Lisp_Object Fchar_to_string (); extern Lisp_Object Fdelete_region (), Fnarrow_to_region (), Fwiden (); /* defined in buffer.c */ extern Lisp_Object Foverlay_start (), Foverlay_end (); extern void adjust_overlays_for_insert (); extern void adjust_overlays_for_delete (); extern void fix_overlays_in_range (); extern int overlay_touches_p (); extern Lisp_Object Vbuffer_alist, Vinhibit_read_only; extern Lisp_Object Fget_buffer (), Fget_buffer_create (), Fset_buffer (); extern Lisp_Object Fbarf_if_buffer_read_only (); extern Lisp_Object Fcurrent_buffer (), Fswitch_to_buffer (), Fpop_to_buffer (); extern Lisp_Object Fother_buffer (); extern Lisp_Object Foverlay_get (); extern Lisp_Object Qoverlayp; extern struct buffer *all_buffers; /* defined in marker.c */ extern Lisp_Object Fmarker_position (), Fmarker_buffer (); extern Lisp_Object Fcopy_marker (); /* Defined in fileio.c */ extern Lisp_Object Qfile_error; extern Lisp_Object Ffind_file_name_handler (); extern Lisp_Object Ffile_name_as_directory (); extern Lisp_Object Fexpand_file_name (), Ffile_name_nondirectory (); extern Lisp_Object Fsubstitute_in_file_name (); extern Lisp_Object Ffile_symlink_p (); extern Lisp_Object Fverify_visited_file_modtime (); extern Lisp_Object Ffile_exists_p (); extern Lisp_Object Ffile_name_absolute_p (); extern Lisp_Object Fdirectory_file_name (); extern Lisp_Object Ffile_name_directory (); extern Lisp_Object expand_and_dir_to_file (); extern Lisp_Object Ffile_accessible_directory_p (); extern Lisp_Object Funhandled_file_name_directory (); /* Defined in abbrev.c */ extern Lisp_Object Vfundamental_mode_abbrev_table; /* defined in search.c */ extern Lisp_Object Fstring_match (); extern Lisp_Object Fscan_buffer (); extern void restore_match_data (); extern Lisp_Object Fmatch_data (), Fstore_match_data (); extern Lisp_Object Fmatch_beginning (), Fmatch_end (); extern Lisp_Object Fskip_chars_forward (), Fskip_chars_backward (); /* defined in minibuf.c */ extern Lisp_Object last_minibuf_string; extern Lisp_Object read_minibuf (), Fcompleting_read (); extern Lisp_Object Fread_from_minibuffer (); extern Lisp_Object Fread_variable (), Fread_buffer (), Fread_key_sequence (); extern Lisp_Object Fread_minibuffer (), Feval_minibuffer (); extern Lisp_Object Fread_string (), Fread_file_name (); extern Lisp_Object Fread_no_blanks_input (); /* Defined in callint.c */ extern Lisp_Object Qminus, Qplus, Vcurrent_prefix_arg; extern Lisp_Object Vcommand_history; extern Lisp_Object Qcall_interactively; extern Lisp_Object Fcall_interactively (); extern Lisp_Object Fprefix_numeric_value (); /* defined in casefiddle.c */ extern Lisp_Object Fdowncase (), Fupcase (), Fcapitalize (); extern Lisp_Object Fupcase_initials (), Fupcase_initials_region (); /* defined in keyboard.c */ extern Lisp_Object Qdisabled; extern Lisp_Object Vhelp_form, Vtop_level; extern Lisp_Object Fdiscard_input (), Frecursive_edit (); extern Lisp_Object Fcommand_execute (), Finput_pending_p (); extern Lisp_Object menu_bar_items (); extern Lisp_Object Qvertical_scroll_bar; #ifdef MULTI_KBOARD extern void delete_kboard (); #endif /* defined in keymap.c */ extern Lisp_Object Qkeymap, Qmenu_bar; extern Lisp_Object current_global_map; extern Lisp_Object Fkey_description (), Fsingle_key_description (); extern Lisp_Object Fwhere_is_internal (); extern Lisp_Object access_keymap (), store_in_keymap (); extern Lisp_Object get_keyelt (), get_keymap (), get_keymap_1 (); extern void describe_map_tree (); /* defined in indent.c */ extern Lisp_Object Fvertical_motion (), Findent_to (), Fcurrent_column (); /* defined in window.c */ extern Lisp_Object Qwindowp, Qwindow_live_p; extern Lisp_Object Fget_buffer_window (); extern Lisp_Object Fsave_window_excursion (); extern Lisp_Object Fset_window_configuration (), Fcurrent_window_configuration (); extern Lisp_Object Fcoordinates_in_window_p (); extern Lisp_Object Fwindow_at (); extern int window_internal_height (), window_internal_width (); /* defined in frame.c */ extern Lisp_Object Qvisible; extern void store_frame_param (), store_in_alist (); extern Lisp_Object do_switch_frame (); extern Lisp_Object get_frame_param(); extern Lisp_Object frame_buffer_predicate (); extern Lisp_Object Fframep (); extern Lisp_Object Fselect_frame (); extern Lisp_Object Ffocus_frame (); extern Lisp_Object Funfocus_frame (); extern Lisp_Object Fselected_frame (); extern Lisp_Object Fwindow_frame (); extern Lisp_Object Fframe_root_window (); extern Lisp_Object Fframe_first_window (); extern Lisp_Object Fframe_selected_window (); extern Lisp_Object Fframe_list (); extern Lisp_Object Fnext_frame (); extern Lisp_Object Fdelete_frame (); extern Lisp_Object Fread_mouse_position (); extern Lisp_Object Fset_mouse_position (); extern Lisp_Object Fmake_frame_visible (); extern Lisp_Object Fmake_frame_invisible (); extern Lisp_Object Ficonify_frame (); extern Lisp_Object Fdeiconify_frame (); extern Lisp_Object Fframe_visible_p (); extern Lisp_Object Fvisible_frame_list (); extern Lisp_Object Fframe_parameters (); extern Lisp_Object Fmodify_frame_parameters (); extern Lisp_Object Fframe_pixel_size (); extern Lisp_Object Fframe_height (); extern Lisp_Object Fframe_width (); extern Lisp_Object Fset_frame_height (); extern Lisp_Object Fset_frame_width (); extern Lisp_Object Fset_frame_size (); extern Lisp_Object Fset_frame_position (); /* defined in emacs.c */ extern Lisp_Object decode_env_path (); extern Lisp_Object Vinvocation_name, Vinvocation_directory; extern Lisp_Object Vinstallation_directory; void shut_down_emacs ( /* int signal, int no_x, Lisp_Object stuff */ ); /* Nonzero means don't do interactive redisplay and don't change tty modes */ extern int noninteractive; /* Nonzero means don't do use window-system-specific display code */ extern int inhibit_window_system; /* Nonzero means that a filter or a sentinel is running. */ extern int running_asynch_code; /* defined in process.c */ extern Lisp_Object Fget_process (), Fget_buffer_process (), Fprocessp (); extern Lisp_Object Fprocess_status (), Fkill_process (); extern Lisp_Object Fprocess_send_eof (); extern Lisp_Object Fwaiting_for_user_input_p (); extern Lisp_Object Qprocessp; /* defined in callproc.c */ extern Lisp_Object Vexec_path, Vexec_directory, Vdata_directory; extern Lisp_Object Vdoc_directory; /* defined in doc.c */ extern Lisp_Object Vdoc_file_name; extern Lisp_Object Fsubstitute_command_keys (); extern Lisp_Object Fdocumentation (), Fdocumentation_property (); extern Lisp_Object read_doc_string (); /* defined in bytecode.c */ extern Lisp_Object Qbytecode; extern Lisp_Object Fbyte_code (); /* defined in macros.c */ extern Lisp_Object Qexecute_kbd_macro; extern Lisp_Object Fexecute_kbd_macro (); /* defined in undo.c */ extern Lisp_Object Fundo_boundary (); extern Lisp_Object truncate_undo_list (); /* defined in textprop.c */ extern Lisp_Object Qmodification_hooks; extern Lisp_Object Qrear_nonsticky; extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks; extern Lisp_Object Fnext_property_change (); extern Lisp_Object Fnext_single_property_change (); extern Lisp_Object Fprevious_single_property_change (); /* defined in intervals.c */ extern Lisp_Object get_local_map (); /* defined in xmenu.c */ extern Lisp_Object Fx_popup_menu (), Fx_popup_dialog (); /* Nonzero means Emacs has already been initialized. Used during startup to detect startup of dumped Emacs. */ extern int initialized; extern int immediate_quit; /* Nonzero means ^G can quit instantly */ extern void debugger (); extern char *getenv (), *ctime (), *getwd (); extern long *xmalloc (), *xrealloc (); extern void xfree (); extern char *egetenv (); /* Set up the name of the machine we're running on. */ extern void init_system_name (); /* Some systems (e.g., NT) use a different path separator than Unix, in addition to a device separator. Default the path separator to '/', and don't test for a device separator in IS_ANY_SEP. */ #ifndef DIRECTORY_SEP #define DIRECTORY_SEP '/' #endif #ifndef IS_DIRECTORY_SEP #define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP) #endif #ifndef IS_DEVICE_SEP #ifndef DEVICE_SEP #define IS_DEVICE_SEP(_c_) 0 #else #define IS_DEVICE_SEP(_c_) ((_c_) == DEVICE_SEP) #endif #endif #ifndef IS_ANY_SEP #define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_)) #endif #ifdef SWITCH_ENUM_BUG #define SWITCH_ENUM_CAST(x) ((int)(x)) #else #define SWITCH_ENUM_CAST(x) (x) #endif emacs-19.30/src/macros.h100444 75424 1 1736 5770115147 13544 0ustar kwzhdaemon/* Definitions for keyboard macro interpretation in GNU Emacs. Copyright (C) 1985 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. */ /* Kbd macro currently being executed (a string) */ extern Lisp_Object Vexecuting_macro; /* Index of next character to fetch from that macro */ extern int executing_macro_index; emacs-19.30/src/mem-limits.h100444 12241 1 7564 6052514127 14615 0ustar rolanddaemon/* Includes for memory limit warnings. Copyright (C) 1990, 1993, 1994, 1995 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. */ #ifdef MSDOS #include #endif /* Some systems need this before . */ #include #ifdef _LIBC #include #define BSD4_2 /* Tell code below to use getrlimit. */ /* Old Linux startup code won't define __data_start. */ extern int etext, __data_start; weak_symbol (__data_start) #define start_of_data() (&__data_start ?: &etext) #else /* not _LIBC */ #if defined (__osf__) && (defined (__mips) || defined (mips) || defined(__alpha)) #include #include #endif #ifdef __bsdi__ #define BSD4_2 #endif #ifndef BSD4_2 #ifndef USG #ifndef MSDOS #ifndef WINDOWSNT #include #endif /* not WINDOWSNT */ #endif /* not MSDOS */ #endif /* not USG */ #else /* if BSD4_2 */ #include #include #endif /* BSD4_2 */ #ifdef emacs /* The important properties of this type are that 1) it's a pointer, and 2) arithmetic on it should work as if the size of the object pointed to has a size of 1. */ #ifdef __STDC__ typedef void *POINTER; #else typedef char *POINTER; #endif typedef unsigned long SIZE; #ifdef NULL #undef NULL #endif #define NULL ((POINTER) 0) extern POINTER start_of_data (); #ifdef DATA_SEG_BITS #define EXCEEDS_LISP_PTR(ptr) \ (((EMACS_UINT) (ptr) & ~DATA_SEG_BITS) >> VALBITS) #else #define EXCEEDS_LISP_PTR(ptr) ((EMACS_UINT) (ptr) >> VALBITS) #endif #ifdef BSD #ifndef DATA_SEG_BITS extern char etext; #define start_of_data() &etext #endif #endif #else /* not emacs */ extern char etext; #define start_of_data() &etext #endif /* not emacs */ #endif /* not _LIBC */ /* start of data space; can be changed by calling malloc_init */ static POINTER data_space_start; /* Number of bytes of writable memory we can expect to be able to get */ static unsigned int lim_data; #ifdef NO_LIM_DATA static void get_lim_data () { lim_data = -1; } #else /* not NO_LIM_DATA */ #ifdef USG static void get_lim_data () { extern long ulimit (); lim_data = -1; /* Use the ulimit call, if we seem to have it. */ #if !defined (ULIMIT_BREAK_VALUE) || defined (LINUX) lim_data = ulimit (3, 0); #endif /* If that didn't work, just use the macro's value. */ #ifdef ULIMIT_BREAK_VALUE if (lim_data == -1) lim_data = ULIMIT_BREAK_VALUE; #endif lim_data -= (long) data_space_start; } #else /* not USG */ #ifdef WINDOWSNT static void get_lim_data () { extern unsigned long data_region_size; lim_data = data_region_size; } #else #if !defined (BSD4_2) && !defined (__osf__) #ifdef MSDOS void get_lim_data () { _go32_dpmi_meminfo info; _go32_dpmi_get_free_memory_information (&info); lim_data = info.available_memory; } #else /* not MSDOS */ static void get_lim_data () { lim_data = vlimit (LIM_DATA, -1); } #endif /* not MSDOS */ #else /* BSD4_2 */ static void get_lim_data () { struct rlimit XXrlimit; getrlimit (RLIMIT_DATA, &XXrlimit); #ifdef RLIM_INFINITY lim_data = XXrlimit.rlim_cur & RLIM_INFINITY; /* soft limit */ #else lim_data = XXrlimit.rlim_cur; /* soft limit */ #endif } #endif /* BSD4_2 */ #endif /* not WINDOWSNT */ #endif /* not USG */ #endif /* not NO_LIM_DATA */ emacs-19.30/src/mocklisp.h100444 75424 1 2365 5770115147 14100 0ustar kwzhdaemon/* Fundamental definitions for emulating mocklisp. Copyright (C) 1985, 1986, 1987 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. */ /* This is the main entry point to mocklisp execution. When eval sees a mocklisp function being called, it calls here with the unevaluated argument list */ extern Lisp_Object ml_apply (); extern Lisp_Object Fml_if (); extern Lisp_Object Fml_nargs (); extern Lisp_Object Fml_arg (); extern Lisp_Object Fml_interactive (); extern Lisp_Object Fml_provide_prefix_argument (); extern Lisp_Object Fml_prefix_argument_loop (); extern Lisp_Object Finsert_string (); emacs-19.30/src/msdos.h100444 75424 13 10204 6046522531 13145 0ustar kwzhuser/* MS-DOS specific C utilities, interface. Copyright (C) 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. */ #ifndef _MSDOS_H_ #define _MSDOS_H_ #include int dos_ttraw (); int dos_ttcooked (); int dos_get_saved_screen (char **, int *, int *); int dos_set_keyboard (int, int); int getdefdir (int, char*); void unixtodos_filename (char *); void dostounix_filename (char *); char *rootrelativepath (char *); void init_environment (); void internal_terminal_init (); void ctrl_break_func (_go32_dpmi_registers *); void install_ctrl_break_check (); extern int have_mouse; void mouse_init (); void mouse_on (); void mouse_off (); void mouse_moveto (int, int); #ifndef HAVE_X_WINDOWS /* Dummy types. */ typedef int XFontStruct; typedef int GC; typedef int Pixmap; typedef int Display; typedef int Window; #define PIX_TYPE int #define XDISPLAY /* This is a cut-down version of the one in xterm.h, which see. */ struct x_output { int left_pos; int top_pos; int line_height; PIX_TYPE background_pixel; PIX_TYPE foreground_pixel; XFontStruct *font; struct face **param_faces; int n_param_faces; struct face **computed_faces; int n_computed_faces; int size_computed_faces; }; extern struct x_output the_only_x_display; extern Display *x_current_display; #define FRAME_PARAM_FACES(f) (the_only_x_display.param_faces) #define FRAME_N_PARAM_FACES(f) (the_only_x_display.n_param_faces) #define FRAME_DEFAULT_PARAM_FACE(f) (FRAME_PARAM_FACES (f)[0]) #define FRAME_MODE_LINE_PARAM_FACE(f) (FRAME_PARAM_FACES (f)[1]) #define FRAME_COMPUTED_FACES(f) (the_only_x_display.computed_faces) #define FRAME_N_COMPUTED_FACES(f) (the_only_x_display.n_computed_faces) #define FRAME_SIZE_COMPUTED_FACES(f) (the_only_x_display.size_computed_faces) #define FRAME_DEFAULT_FACE(f) (the_only_x_display.computed_faces[0]) #define FRAME_MODE_LINE_FACE(f) (the_only_x_display.computed_faces[1]) #define FRAME_X_DISPLAY(f) ((Display *) 0) #define FRAME_FOREGROUND_PIXEL(f) (the_only_x_display.foreground_pixel) #define FRAME_BACKGROUND_PIXEL(f) (the_only_x_display.background_pixel) #define FRAME_FONT(f) (the_only_x_display.font) #define XFreeGC (void) #define same_size_fonts(foo,bar) (1) #define unload_font(p1,p2) #define unload_color(p1,p2) #define x_destroy_bitmap(p1,p2) #define load_pixmap(p1,p2,p3,p4) (0) #define XGetGeometry(p1,p2,p3,p4,p5,p6,p7,p8,p9) #define DisplayWidth(p1,p2) (the_only_frame.width) #define DisplayHeight(p1,p2) (the_only_frame.height) #define XMenuSetAEQ (void) #define XMenuSetFreeze (void) #define XMenuRecompute (void) #define FONT_WIDTH(foo) 1 /* Function `getcbrk' is the most harmless I can think of right now... */ #define check_x if (FRAME_TERMCAP_P (bar)) error ("Not running under a windows system."); else getcbrk #define x_mouse_leave getcbrk #define XM_FAILURE -1 #define XM_SUCCESS 1 #define XM_NO_SELECT 2 #define XM_IA_SELECT 3 #define ButtonReleaseMask 0 typedef struct x_menu_struct { int count; char **text; struct x_menu_struct **submenu; int *panenumber; /* Also used as enable. */ int allocated; int panecount; int width; } XMenu; XMenu *XMenuCreate (Display *, Window, char *); int XMenuAddPane (Display *, XMenu *, char *, int); int XMenuAddSelection (Display *, XMenu *, int, int, char *, int); void XMenuLocate (Display *, XMenu *, int, int, int, int, int *, int *, int *, int *); int XMenuActivate (Display *, XMenu *, int *, int *, int, int, unsigned, char **); void XMenuDestroy (Display *, XMenu *); #endif /* not HAVE_X_WINDOWS */ #endif /* not _MSDOS_H_ */ emacs-19.30/src/ndir.h100444 12120 1 2516 5655344472 13016 0ustar rmsdaemon/* -- definitions for 4.2BSD-compatible directory access last edit: 09-Jul-1983 D A Gwyn */ #ifdef VMS #ifndef FAB$C_BID #include #endif #ifndef NAM$C_BID #include #endif #ifndef RMS$_SUC #include #endif #include "vmsdir.h" #endif /* VMS */ #define DIRBLKSIZ 512 /* size of directory block */ #ifdef VMS #define MAXNAMLEN (DIR$S_NAME + 7) /* 80 plus room for version #. */ #define MAXFULLSPEC NAM$C_MAXRSS /* Maximum full spec */ #else #ifdef WINDOWSNT #define MAXNAMLEN 255 #else /* not WINDOWSNT */ #define MAXNAMLEN 15 /* maximum filename length */ #endif /* not WINDOWSNT */ #endif /* VMS */ /* NOTE: MAXNAMLEN must be one less than a multiple of 4 */ struct direct /* data from readdir() */ { long d_ino; /* inode number of entry */ unsigned short d_reclen; /* length of this record */ unsigned short d_namlen; /* length of string in d_name */ char d_name[MAXNAMLEN+1]; /* name of file */ }; typedef struct { int dd_fd; /* file descriptor */ int dd_loc; /* offset in block */ int dd_size; /* amount of valid data */ char dd_buf[DIRBLKSIZ]; /* directory block */ } DIR; /* stream data from opendir() */ extern DIR *opendir(); extern struct direct *readdir(); extern long telldir(); extern void seekdir(); extern void closedir(); #define rewinddir( dirp ) seekdir( dirp, 0L ) emacs-19.30/src/nt.h100444 23073 1 3536 6047603070 13351 0ustar voelkerdaemon/* Support routines for the NT version of Emacs. Copyright (C) 1994 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. */ /* File descriptor set emulation. */ #ifdef FD_SET /* We could get this from param.h, but better not to depend on finding that. And better not to risk that it might define other symbols used in this file. */ #ifdef FD_SETSIZE #define MAXDESC FD_SETSIZE #else #define MAXDESC 64 #endif #define SELECT_TYPE fd_set #else /* no FD_SET */ #define MAXDESC 32 #define SELECT_TYPE int /* Define the macros to access a single-int bitmap of descriptors. */ #define FD_SET(n, p) (*(p) |= (1 << (n))) #define FD_CLR(n, p) (*(p) &= ~(1 << (n))) #define FD_ISSET(n, p) (*(p) & (1 << (n))) #define FD_ZERO(p) (*(p) = 0) #endif /* no FD_SET */ /* Prepare our standard handles for proper inheritance by child processes. */ extern void prepare_standard_handles (int in, int out, int err, HANDLE handles[4]); /* Reset our standard handles to their original state. */ extern void reset_standard_handles (int in, int out, int err, HANDLE handles[4]); /* Return the string resource associated with KEY of type TYPE. */ extern LPBYTE nt_get_resource (char *key, LPDWORD type); emacs-19.30/src/ntheap.h100444 23073 1 4656 5761262573 14226 0ustar voelkerdaemon/* Heap management routines (including unexec) for GNU Emacs on Windows NT. Copyright (C) 1994 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. Geoff Voelker (voelker@cs.washington.edu) 7-29-94 */ #ifndef NTHEAP_H_ #define NTHEAP_H_ #include /* * Heap related stuff. */ #define get_reserved_heap_size() reserved_heap_size #define get_committed_heap_size() (get_data_end () - get_data_start ()) #define get_heap_start() get_data_start () #define get_heap_end() get_data_end () #define get_page_size() sysinfo_cache.dwPageSize #define get_allocation_unit() sysinfo_cache.dwAllocationGranularity #define get_processor_type() sysinfo_cache.dwProcessorType #define get_nt_major_version() nt_major_version #define get_nt_minor_version() nt_minor_version extern unsigned char *get_data_start(); extern unsigned char *get_data_end(); extern unsigned long data_region_size; extern unsigned long reserved_heap_size; extern SYSTEM_INFO sysinfo_cache; extern BOOL need_to_recreate_heap; extern int nt_major_version; extern int nt_minor_version; /* Emulation of Unix sbrk(). */ extern void *sbrk (unsigned long size); /* Recreate the heap created during dumping. */ extern void recreate_heap (char *executable_path); /* Round the heap to this size. */ extern void round_heap (unsigned long size); /* Load in the dumped .bss section. */ extern void read_in_bss (char *name); /* Map in the dumped heap. */ extern void map_in_heap (char *name); /* Cache system info, e.g., the NT page size. */ extern void cache_system_info (void); /* Round ADDRESS up to be aligned with ALIGN. */ extern unsigned char *round_to_next (unsigned char *address, unsigned long align); #endif /* NTHEAP_H_ */ emacs-19.30/src/ntinevt.h100444 75424 1 2216 5742634707 13750 0ustar kwzhdaemon/* Win32 input routines. Copyright (C) 1995 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. */ #ifndef __NTINEVT_H__ #define __NTINEVT_H__ int win32_read_socket (/* int sd, struct input_event *bufp, int numchars, int waitp, int expected */); void win32_mouse_position (/* FRAME_PTR *f, Lisp_Object *bar_window, enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y, unsigned long *time */); #endif emacs-19.30/src/param.h100444 12241 12 110 5444474603 13466 0ustar rolandstaff/* This is so that Emacs can run on VMS... */ #define EXEC_PAGESIZE 512 emacs-19.30/src/point.h100444 12241 12 304 5444474605 13526 0ustar rolandstaff#define point_width 5 #define point_height 19 static char point_bits[] = { 0x1f, 0x0e, 0x0e, 0x04, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x04, 0x0e, 0x0e, 0x1f}; emacs-19.30/src/process.h100444 75424 1 10030 5770115150 13733 0ustar kwzhdaemon/* Definitions for asynchronous process control in GNU Emacs. Copyright (C) 1985, 1994 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. */ /* * Structure records pertinent information about open channels. * There is one channel associated with each process. */ struct Lisp_Process { EMACS_INT size; struct Lisp_Vector *v_next; /* Descriptor by which we read from this process */ Lisp_Object infd; /* Descriptor by which we write to this process */ Lisp_Object outfd; /* Descriptor for the tty which this process is using. nil if we didn't record it (on some systems, there's no need). */ Lisp_Object subtty; /* Name of subprocess terminal. */ Lisp_Object tty_name; /* Name of this process */ Lisp_Object name; /* List of command arguments that this process was run with */ Lisp_Object command; /* (funcall FILTER PROC STRING) (if FILTER is non-nil) to dispose of a bunch of chars from the process all at once */ Lisp_Object filter; /* (funcall SENTINEL PROCESS) when process state changes */ Lisp_Object sentinel; /* Buffer that output is going to */ Lisp_Object buffer; /* Number of this process */ Lisp_Object pid; /* Non-nil if this is really a command channel */ Lisp_Object command_channel_p; /* Non-nil if this is really a child process */ Lisp_Object childp; /* Marker set to end of last buffer-inserted output from this process */ Lisp_Object mark; /* Non-nil means kill silently if Emacs is exited. */ Lisp_Object kill_without_query; /* Record the process status in the raw form in which it comes from `wait'. This is to avoid consing in a signal handler. */ Lisp_Object raw_status_low; Lisp_Object raw_status_high; /* Symbol indicating status of process. This may be a symbol: run, open, or closed. Or it may be a list, whose car is stop, exit or signal and whose cdr is a pair (EXIT_CODE . COREDUMP_FLAG) or (SIGNAL_NUMBER . COREDUMP_FLAG). */ Lisp_Object status; /* Non-nil if communicating through a pty. */ Lisp_Object pty_flag; /* Event-count of last event in which this process changed status. */ Lisp_Object tick; /* Event-count of last such event reported. */ Lisp_Object update_tick; }; #define ChannelMask(n) (1<<(n)) /* Indexed by descriptor, gives the process (if any) for that descriptor. */ extern Lisp_Object chan_process[]; /* Alist of elements (NAME . PROCESS). */ extern Lisp_Object Vprocess_alist; /* True iff we are about to fork off a synchronous process or if we are waiting for it. */ extern int synch_process_alive; /* Communicate exit status of synch process to from sigchld_handler to Fcall_process. */ extern int synch_process_retcode; extern char *synch_process_death; /* Nonzero => this is a string explaining death of synchronous subprocess. */ extern char *synch_process_death; /* If synch_process_death is zero, this is exit code of synchronous subprocess. */ extern int synch_process_retcode; /* The name of the file open to get a null file, or a data sink. VMS, MS-DOS, and OS/2 redefine this. */ #ifndef NULL_DEVICE #define NULL_DEVICE "/dev/null" #endif /* A string listing the possible suffixes used for executable files, separated by colons. VMS, MS-DOS, and OS/2 redefine this. */ #ifndef EXEC_SUFFIXES #define EXEC_SUFFIXES "" #endif emacs-19.30/src/puresize.h100444 12120 1 6156 6020676043 13721 0ustar rmsdaemon/* How much read-only Lisp storage a dumped Emacs needs. Copyright (C) 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. */ /* Define PURESIZE, the number of bytes of pure Lisp code to leave space for. At one point, this was defined in config.h, meaning that changing PURESIZE would make Make recompile all of Emacs. But only a few files actually use PURESIZE, so we split it out to its own .h file. Make sure to include this file after config.h, since that tells us whether we are running X windows, which tells us how much pure storage to allocate. */ /* First define a measure of the amount of data we have. */ /* A system configuration file may set this to request a certain extra amount of storage. This is a lot more update-robust that defining BASE_PURESIZE or even PURESIZE directly. */ #ifndef SYSTEM_PURESIZE_EXTRA #define SYSTEM_PURESIZE_EXTRA 0 #endif #ifndef SITELOAD_PURESIZE_EXTRA #define SITELOAD_PURESIZE_EXTRA 0 #endif #ifndef BASE_PURESIZE #ifdef MULTI_FRAME #define BASE_PURESIZE (325000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) #else #define BASE_PURESIZE (240000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) #endif #endif /* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ #ifndef PURESIZE_RATIO #if VALBITS + GCTYPEBITS + 1 > 32 #define PURESIZE_RATIO 8/5 /* Don't surround with `()'. */ #else #define PURESIZE_RATIO 1 #endif #endif /* This is the actual size in bytes to allocate. */ #ifndef PURESIZE #define PURESIZE (BASE_PURESIZE * PURESIZE_RATIO) #endif #ifdef VIRT_ADDR_VARIES /* For machines like APOLLO where text and data can go anywhere in virtual memory. */ #define CHECK_IMPURE(obj) \ { extern EMACS_INT pure[]; \ if ((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE) \ && (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure) \ pure_write_error (); } #else /* not VIRT_ADDR_VARIES */ #ifdef PNTR_COMPARISON_TYPE /* when PNTR_COMPARISON_TYPE is not the default (unsigned int) */ #define CHECK_IMPURE(obj) \ { extern char my_edata[]; \ if ((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) my_edata) \ pure_write_error (); } #else /* not VIRT_ADDRESS_VARIES, not PNTR_COMPARISON_TYPE */ #define CHECK_IMPURE(obj) \ { extern char my_edata[]; \ if (XPNTR (obj) < (unsigned int) my_edata) \ pure_write_error (); } #endif /* PNTR_COMPARISON_TYPE */ #endif /* VIRT_ADDRESS_VARIES */ emacs-19.30/src/regex.h100444 12120 1 44727 6041260622 13206 0ustar rmsdaemon/* Definitions for data structures and routines for the regular expression library, version 0.12. Copyright (C) 1985, 89, 90, 91, 92, 93, 95 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef __REGEXP_LIBRARY_H__ #define __REGEXP_LIBRARY_H__ /* POSIX says that must be included (by the caller) before . */ #if !defined (_POSIX_C_SOURCE) && !defined (_POSIX_SOURCE) && defined (VMS) /* VMS doesn't have `size_t' in , even though POSIX says it should be there. */ #include #endif /* The following bits are used to determine the regexp syntax we recognize. The set/not-set meanings are chosen so that Emacs syntax remains the value 0. The bits are given in alphabetical order, and the definitions shifted by one from the previous bit; thus, when we add or remove a bit, only one other definition need change. */ typedef unsigned reg_syntax_t; /* If this bit is not set, then \ inside a bracket expression is literal. If set, then such a \ quotes the following character. */ #define RE_BACKSLASH_ESCAPE_IN_LISTS (1) /* If this bit is not set, then + and ? are operators, and \+ and \? are literals. If set, then \+ and \? are operators and + and ? are literals. */ #define RE_BK_PLUS_QM (RE_BACKSLASH_ESCAPE_IN_LISTS << 1) /* If this bit is set, then character classes are supported. They are: [:alpha:], [:upper:], [:lower:], [:digit:], [:alnum:], [:xdigit:], [:space:], [:print:], [:punct:], [:graph:], and [:cntrl:]. If not set, then character classes are not supported. */ #define RE_CHAR_CLASSES (RE_BK_PLUS_QM << 1) /* If this bit is set, then ^ and $ are always anchors (outside bracket expressions, of course). If this bit is not set, then it depends: ^ is an anchor if it is at the beginning of a regular expression or after an open-group or an alternation operator; $ is an anchor if it is at the end of a regular expression, or before a close-group or an alternation operator. This bit could be (re)combined with RE_CONTEXT_INDEP_OPS, because POSIX draft 11.2 says that * etc. in leading positions is undefined. We already implemented a previous draft which made those constructs invalid, though, so we haven't changed the code back. */ #define RE_CONTEXT_INDEP_ANCHORS (RE_CHAR_CLASSES << 1) /* If this bit is set, then special characters are always special regardless of where they are in the pattern. If this bit is not set, then special characters are special only in some contexts; otherwise they are ordinary. Specifically, * + ? and intervals are only special when not after the beginning, open-group, or alternation operator. */ #define RE_CONTEXT_INDEP_OPS (RE_CONTEXT_INDEP_ANCHORS << 1) /* If this bit is set, then *, +, ?, and { cannot be first in an re or immediately after an alternation or begin-group operator. */ #define RE_CONTEXT_INVALID_OPS (RE_CONTEXT_INDEP_OPS << 1) /* If this bit is set, then . matches newline. If not set, then it doesn't. */ #define RE_DOT_NEWLINE (RE_CONTEXT_INVALID_OPS << 1) /* If this bit is set, then . doesn't match NUL. If not set, then it does. */ #define RE_DOT_NOT_NULL (RE_DOT_NEWLINE << 1) /* If this bit is set, nonmatching lists [^...] do not match newline. If not set, they do. */ #define RE_HAT_LISTS_NOT_NEWLINE (RE_DOT_NOT_NULL << 1) /* If this bit is set, either \{...\} or {...} defines an interval, depending on RE_NO_BK_BRACES. If not set, \{, \}, {, and } are literals. */ #define RE_INTERVALS (RE_HAT_LISTS_NOT_NEWLINE << 1) /* If this bit is set, +, ? and | aren't recognized as operators. If not set, they are. */ #define RE_LIMITED_OPS (RE_INTERVALS << 1) /* If this bit is set, newline is an alternation operator. If not set, newline is literal. */ #define RE_NEWLINE_ALT (RE_LIMITED_OPS << 1) /* If this bit is set, then `{...}' defines an interval, and \{ and \} are literals. If not set, then `\{...\}' defines an interval. */ #define RE_NO_BK_BRACES (RE_NEWLINE_ALT << 1) /* If this bit is set, (...) defines a group, and \( and \) are literals. If not set, \(...\) defines a group, and ( and ) are literals. */ #define RE_NO_BK_PARENS (RE_NO_BK_BRACES << 1) /* If this bit is set, then \ matches . If not set, then \ is a back-reference. */ #define RE_NO_BK_REFS (RE_NO_BK_PARENS << 1) /* If this bit is set, then | is an alternation operator, and \| is literal. If not set, then \| is an alternation operator, and | is literal. */ #define RE_NO_BK_VBAR (RE_NO_BK_REFS << 1) /* If this bit is set, then an ending range point collating higher than the starting range point, as in [z-a], is invalid. If not set, then when ending range point collates higher than the starting range point, the range is ignored. */ #define RE_NO_EMPTY_RANGES (RE_NO_BK_VBAR << 1) /* If this bit is set, then an unmatched ) is ordinary. If not set, then an unmatched ) is invalid. */ #define RE_UNMATCHED_RIGHT_PAREN_ORD (RE_NO_EMPTY_RANGES << 1) /* If this bit is set, succeed as soon as we match the whole pattern, without further backtracking. */ #define RE_NO_POSIX_BACKTRACKING (RE_UNMATCHED_RIGHT_PAREN_ORD << 1) /* This global variable defines the particular regexp syntax to use (for some interfaces). When a regexp is compiled, the syntax used is stored in the pattern buffer, so changing this does not affect already-compiled regexps. */ extern reg_syntax_t re_syntax_options; /* Define combinations of the above bits for the standard possibilities. (The [[[ comments delimit what gets put into the Texinfo file, so don't delete them!) */ /* [[[begin syntaxes]]] */ #define RE_SYNTAX_EMACS 0 #define RE_SYNTAX_AWK \ (RE_BACKSLASH_ESCAPE_IN_LISTS | RE_DOT_NOT_NULL \ | RE_NO_BK_PARENS | RE_NO_BK_REFS \ | RE_NO_BK_VBAR | RE_NO_EMPTY_RANGES \ | RE_UNMATCHED_RIGHT_PAREN_ORD) #define RE_SYNTAX_POSIX_AWK \ (RE_SYNTAX_POSIX_EXTENDED | RE_BACKSLASH_ESCAPE_IN_LISTS) #define RE_SYNTAX_GREP \ (RE_BK_PLUS_QM | RE_CHAR_CLASSES \ | RE_HAT_LISTS_NOT_NEWLINE | RE_INTERVALS \ | RE_NEWLINE_ALT) #define RE_SYNTAX_EGREP \ (RE_CHAR_CLASSES | RE_CONTEXT_INDEP_ANCHORS \ | RE_CONTEXT_INDEP_OPS | RE_HAT_LISTS_NOT_NEWLINE \ | RE_NEWLINE_ALT | RE_NO_BK_PARENS \ | RE_NO_BK_VBAR) #define RE_SYNTAX_POSIX_EGREP \ (RE_SYNTAX_EGREP | RE_INTERVALS | RE_NO_BK_BRACES) /* P1003.2/D11.2, section 4.20.7.1, lines 5078ff. */ #define RE_SYNTAX_ED RE_SYNTAX_POSIX_BASIC #define RE_SYNTAX_SED RE_SYNTAX_POSIX_BASIC /* Syntax bits common to both basic and extended POSIX regex syntax. */ #define _RE_SYNTAX_POSIX_COMMON \ (RE_CHAR_CLASSES | RE_DOT_NEWLINE | RE_DOT_NOT_NULL \ | RE_INTERVALS | RE_NO_EMPTY_RANGES) #define RE_SYNTAX_POSIX_BASIC \ (_RE_SYNTAX_POSIX_COMMON | RE_BK_PLUS_QM) /* Differs from ..._POSIX_BASIC only in that RE_BK_PLUS_QM becomes RE_LIMITED_OPS, i.e., \? \+ \| are not recognized. Actually, this isn't minimal, since other operators, such as \`, aren't disabled. */ #define RE_SYNTAX_POSIX_MINIMAL_BASIC \ (_RE_SYNTAX_POSIX_COMMON | RE_LIMITED_OPS) #define RE_SYNTAX_POSIX_EXTENDED \ (_RE_SYNTAX_POSIX_COMMON | RE_CONTEXT_INDEP_ANCHORS \ | RE_CONTEXT_INDEP_OPS | RE_NO_BK_BRACES \ | RE_NO_BK_PARENS | RE_NO_BK_VBAR \ | RE_UNMATCHED_RIGHT_PAREN_ORD) /* Differs from ..._POSIX_EXTENDED in that RE_CONTEXT_INVALID_OPS replaces RE_CONTEXT_INDEP_OPS and RE_NO_BK_REFS is added. */ #define RE_SYNTAX_POSIX_MINIMAL_EXTENDED \ (_RE_SYNTAX_POSIX_COMMON | RE_CONTEXT_INDEP_ANCHORS \ | RE_CONTEXT_INVALID_OPS | RE_NO_BK_BRACES \ | RE_NO_BK_PARENS | RE_NO_BK_REFS \ | RE_NO_BK_VBAR | RE_UNMATCHED_RIGHT_PAREN_ORD) /* [[[end syntaxes]]] */ /* Maximum number of duplicates an interval can allow. Some systems (erroneously) define this in other header files, but we want our value, so remove any previous define. */ #ifdef RE_DUP_MAX #undef RE_DUP_MAX #endif #define RE_DUP_MAX ((1 << 15) - 1) /* POSIX `cflags' bits (i.e., information for `regcomp'). */ /* If this bit is set, then use extended regular expression syntax. If not set, then use basic regular expression syntax. */ #define REG_EXTENDED 1 /* If this bit is set, then ignore case when matching. If not set, then case is significant. */ #define REG_ICASE (REG_EXTENDED << 1) /* If this bit is set, then anchors do not match at newline characters in the string. If not set, then anchors do match at newlines. */ #define REG_NEWLINE (REG_ICASE << 1) /* If this bit is set, then report only success or fail in regexec. If not set, then returns differ between not matching and errors. */ #define REG_NOSUB (REG_NEWLINE << 1) /* POSIX `eflags' bits (i.e., information for regexec). */ /* If this bit is set, then the beginning-of-line operator doesn't match the beginning of the string (presumably because it's not the beginning of a line). If not set, then the beginning-of-line operator does match the beginning of the string. */ #define REG_NOTBOL 1 /* Like REG_NOTBOL, except for the end-of-line. */ #define REG_NOTEOL (1 << 1) /* If any error codes are removed, changed, or added, update the `re_error_msg' table in regex.c. */ typedef enum { REG_NOERROR = 0, /* Success. */ REG_NOMATCH, /* Didn't find a match (for regexec). */ /* POSIX regcomp return error codes. (In the order listed in the standard.) */ REG_BADPAT, /* Invalid pattern. */ REG_ECOLLATE, /* Not implemented. */ REG_ECTYPE, /* Invalid character class name. */ REG_EESCAPE, /* Trailing backslash. */ REG_ESUBREG, /* Invalid back reference. */ REG_EBRACK, /* Unmatched left bracket. */ REG_EPAREN, /* Parenthesis imbalance. */ REG_EBRACE, /* Unmatched \{. */ REG_BADBR, /* Invalid contents of \{\}. */ REG_ERANGE, /* Invalid range end. */ REG_ESPACE, /* Ran out of memory. */ REG_BADRPT, /* No preceding re for repetition op. */ /* Error codes we've added. */ REG_EEND, /* Premature end. */ REG_ESIZE, /* Compiled pattern bigger than 2^16 bytes. */ REG_ERPAREN /* Unmatched ) or \); not returned from regcomp. */ } reg_errcode_t; /* This data structure represents a compiled pattern. Before calling the pattern compiler, the fields `buffer', `allocated', `fastmap', `translate', and `no_sub' can be set. After the pattern has been compiled, the `re_nsub' field is available. All other fields are private to the regex routines. */ #ifndef RE_TRANSLATE_TYPE #define RE_TRANSLATE_TYPE char * #endif struct re_pattern_buffer { /* [[[begin pattern_buffer]]] */ /* Space that holds the compiled pattern. It is declared as `unsigned char *' because its elements are sometimes used as array indexes. */ unsigned char *buffer; /* Number of bytes to which `buffer' points. */ unsigned long allocated; /* Number of bytes actually used in `buffer'. */ unsigned long used; /* Syntax setting with which the pattern was compiled. */ reg_syntax_t syntax; /* Pointer to a fastmap, if any, otherwise zero. re_search uses the fastmap, if there is one, to skip over impossible starting points for matches. */ char *fastmap; /* Either a translate table to apply to all characters before comparing them, or zero for no translation. The translation is applied to a pattern when it is compiled and to a string when it is matched. */ RE_TRANSLATE_TYPE translate; /* Number of subexpressions found by the compiler. */ size_t re_nsub; /* Zero if this pattern cannot match the empty string, one else. Well, in truth it's used only in `re_search_2', to see whether or not we should use the fastmap, so we don't set this absolutely perfectly; see `re_compile_fastmap' (the `duplicate' case). */ unsigned can_be_null : 1; /* If REGS_UNALLOCATED, allocate space in the `regs' structure for `max (RE_NREGS, re_nsub + 1)' groups. If REGS_REALLOCATE, reallocate space if necessary. If REGS_FIXED, use what's there. */ #define REGS_UNALLOCATED 0 #define REGS_REALLOCATE 1 #define REGS_FIXED 2 unsigned regs_allocated : 2; /* Set to zero when `regex_compile' compiles a pattern; set to one by `re_compile_fastmap' if it updates the fastmap. */ unsigned fastmap_accurate : 1; /* If set, `re_match_2' does not return information about subexpressions. */ unsigned no_sub : 1; /* If set, a beginning-of-line anchor doesn't match at the beginning of the string. */ unsigned not_bol : 1; /* Similarly for an end-of-line anchor. */ unsigned not_eol : 1; /* If true, an anchor at a newline matches. */ unsigned newline_anchor : 1; /* [[[end pattern_buffer]]] */ }; typedef struct re_pattern_buffer regex_t; /* Type for byte offsets within the string. POSIX mandates this. */ typedef int regoff_t; /* This is the structure we store register match data in. See regex.texinfo for a full description of what registers match. */ struct re_registers { unsigned num_regs; regoff_t *start; regoff_t *end; }; /* If `regs_allocated' is REGS_UNALLOCATED in the pattern buffer, `re_match_2' returns information about at least this many registers the first time a `regs' structure is passed. */ #ifndef RE_NREGS #define RE_NREGS 30 #endif /* POSIX specification for registers. Aside from the different names than `re_registers', POSIX uses an array of structures, instead of a structure of arrays. */ typedef struct { regoff_t rm_so; /* Byte offset from string's start to substring's start. */ regoff_t rm_eo; /* Byte offset from string's start to substring's end. */ } regmatch_t; /* Declarations for routines. */ /* To avoid duplicating every routine declaration -- once with a prototype (if we are ANSI), and once without (if we aren't) -- we use the following macro to declare argument types. This unfortunately clutters up the declarations a bit, but I think it's worth it. */ #if __STDC__ #define _RE_ARGS(args) args #else /* not __STDC__ */ #define _RE_ARGS(args) () #endif /* not __STDC__ */ /* Sets the current default syntax to SYNTAX, and return the old syntax. You can also simply assign to the `re_syntax_options' variable. */ extern reg_syntax_t re_set_syntax _RE_ARGS ((reg_syntax_t syntax)); /* Compile the regular expression PATTERN, with length LENGTH and syntax given by the global `re_syntax_options', into the buffer BUFFER. Return NULL if successful, and an error string if not. */ extern const char *re_compile_pattern _RE_ARGS ((const char *pattern, int length, struct re_pattern_buffer *buffer)); /* Compile a fastmap for the compiled pattern in BUFFER; used to accelerate searches. Return 0 if successful and -2 if was an internal error. */ extern int re_compile_fastmap _RE_ARGS ((struct re_pattern_buffer *buffer)); /* Search in the string STRING (with length LENGTH) for the pattern compiled into BUFFER. Start searching at position START, for RANGE characters. Return the starting position of the match, -1 for no match, or -2 for an internal error. Also return register information in REGS (if REGS and BUFFER->no_sub are nonzero). */ extern int re_search _RE_ARGS ((struct re_pattern_buffer *buffer, const char *string, int length, int start, int range, struct re_registers *regs)); /* Like `re_search', but search in the concatenation of STRING1 and STRING2. Also, stop searching at index START + STOP. */ extern int re_search_2 _RE_ARGS ((struct re_pattern_buffer *buffer, const char *string1, int length1, const char *string2, int length2, int start, int range, struct re_registers *regs, int stop)); /* Like `re_search', but return how many characters in STRING the regexp in BUFFER matched, starting at position START. */ extern int re_match _RE_ARGS ((struct re_pattern_buffer *buffer, const char *string, int length, int start, struct re_registers *regs)); /* Relates to `re_match' as `re_search_2' relates to `re_search'. */ extern int re_match_2 _RE_ARGS ((struct re_pattern_buffer *buffer, const char *string1, int length1, const char *string2, int length2, int start, struct re_registers *regs, int stop)); /* Set REGS to hold NUM_REGS registers, storing them in STARTS and ENDS. Subsequent matches using BUFFER and REGS will use this memory for recording register information. STARTS and ENDS must be allocated with malloc, and must each be at least `NUM_REGS * sizeof (regoff_t)' bytes long. If NUM_REGS == 0, then subsequent matches should allocate their own register data. Unless this function is called, the first search or match using PATTERN_BUFFER will allocate its own register data, without freeing the old data. */ extern void re_set_registers _RE_ARGS ((struct re_pattern_buffer *buffer, struct re_registers *regs, unsigned num_regs, regoff_t *starts, regoff_t *ends)); #ifdef _REGEX_RE_COMP /* 4.2 bsd compatibility. */ extern char *re_comp _RE_ARGS ((const char *)); extern int re_exec _RE_ARGS ((const char *)); #endif /* POSIX compatibility. */ extern int regcomp _RE_ARGS ((regex_t *preg, const char *pattern, int cflags)); extern int regexec _RE_ARGS ((const regex_t *preg, const char *string, size_t nmatch, regmatch_t pmatch[], int eflags)); extern size_t regerror _RE_ARGS ((int errcode, const regex_t *preg, char *errbuf, size_t errbuf_size)); extern void regfree _RE_ARGS ((regex_t *preg)); #endif /* not __REGEXP_LIBRARY_H__ */ /* Local variables: make-backup-files: t version-control: t trim-versions-without-asking: nil End: */ emacs-19.30/src/region-cache.h100444 75424 12 12633 5741116466 14507 0ustar kwzhstaff/* Header file: Caching facts about regions of the buffer, for optimization. Copyright (C) 1985, 1986, 1993, 1995 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. */ /* This code was written by Jim Blandy to help GNU Emacs better support the gene editor written for the University of Illinois at Urbana-Champagne's Ribosome Database Project (RDP). Emacs implements line operations (finding the beginning/end of the line, vertical motion, all the redisplay stuff) by searching for newlines in the buffer. Usually, this is a good design; it's very clean to just represent the buffer as an unstructured string of characters, and the lines in most files are very short (less than eighty characters), meaning that scanning usually costs about the same as the overhead of maintaining some more complicated data structure. However, some applications, like gene editing, make use of very long lines --- on the order of tens of kilobytes. In such cases, it may well be worthwhile to try to avoid scanning, because the scans have become two orders of magnitude more expensive. It would be nice if this speedup could preserve the simplicity of the existing data structure, and disturb as little of the existing code as possible. So here's the tack. We add some caching to the scan_buffer function, so that when it searches for a newline, it notes that the region between the start and end of the search contained no newlines; then, the next time around, it consults this cache to see if there are regions of text it can skip over completely. The buffer modification primitives invalidate this cache. (Note: Since the redisplay code needs similar information on modified regions of the buffer, we can use the code that helps out redisplay as a guide to where we need to add our own code to invalidate our cache. prepare_to_modify_buffer seems to be the central spot.) Note that the cache code itself never mentions newlines specifically, so if you wanted to cache other properties of regions of the buffer, you could use this code pretty much unchanged. So this cache really holds "known/unknown" information --- "I know this region has property P" vs. "I don't know if this region has property P or not." */ /* Allocate, initialize and return a new, empty region cache. */ struct region_cache *new_region_cache ( /* void */ ); /* Free a region cache. */ void free_region_cache ( /* struct region_cache * */ ); /* Assert that the region of BUF between START and END (absolute buffer positions) is "known," for the purposes of CACHE (e.g. "has no newlines", in the case of the line cache). */ extern void know_region_cache ( /* struct buffer *BUF, struct region_cache *CACHE, int START, END */ ); /* Indicate that a section of BUF has changed, to invalidate CACHE. HEAD is the number of chars unchanged at the beginning of the buffer. TAIL is the number of chars unchanged at the end of the buffer. NOTE: this is *not* the same as the ending position of modified region. (This way of specifying regions makes more sense than absolute buffer positions in the presence of insertions and deletions; the args to pass are the same before and after such an operation.) */ extern void invalidate_region_cache ( /* struct buffer *BUF, struct region_cache *CACHE, int HEAD, TAIL */ ); /* The scanning functions. Basically, if you're scanning forward/backward from position POS, and region_cache_forward/backward returns true, you can skip all the text between POS and *NEXT. And if the function returns false, you should examine all the text from POS to *NEXT, and call know_region_cache depending on what you find there; this way, you might be able to avoid scanning it again. */ /* Return true if the text immediately after POS in BUF is known, for the purposes of CACHE. If NEXT is non-zero, set *NEXT to the nearest position after POS where the knownness changes. */ extern int region_cache_forward ( /* struct buffer *BUF, struct region_cache *CACHE, int POS, int *NEXT */ ); /* Return true if the text immediately before POS in BUF is known, for the purposes of CACHE. If NEXT is non-zero, set *NEXT to the nearest position before POS where the knownness changes. */ extern int region_cache_backward ( /* struct buffer *BUF, struct region_cache *CACHE, int POS, int *NEXT */ ); emacs-19.30/src/sink.h100444 12241 12 6370 5444474614 13372 0ustar rolandstaff#define sink_width 48 #define sink_height 48 #ifdef HAVE_X11 static char sink_bits[] = { 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x80, 0x9f, 0xff, 0xff, 0xff, 0xff, 0x9f, 0x9f, 0xff, 0xff, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0xff, 0x7f, 0xfe, 0xbf, 0xff, 0xff, 0xff, 0x7f, 0x03, 0xa0, 0xff, 0xff, 0xff, 0x7f, 0xfd, 0xaf, 0xff, 0xff, 0xff, 0x3f, 0xf9, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xff, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xfc, 0xaf, 0xff, 0xff, 0xff, 0x7f, 0xf8, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xfc, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xff, 0xaf, 0xff, 0xff, 0xff, 0xbf, 0xf7, 0xaf, 0xff, 0xff, 0xff, 0x3f, 0xf3, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xfc, 0xaf, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x20, 0x7f, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xdf, 0xf8, 0xff, 0xff, 0xff, 0x07, 0xcf, 0xf9, 0x0f, 0xff, 0xff, 0xe7, 0xcf, 0xf9, 0xf7, 0xff, 0xff, 0xe7, 0xff, 0xf9, 0xf7, 0x63, 0xfb, 0xe7, 0xff, 0xf9, 0x37, 0x5a, 0xfb, 0xe7, 0xcf, 0xf9, 0xf7, 0x5a, 0xfb, 0xe7, 0xcf, 0xf9, 0xf7, 0x5a, 0xf9, 0xe7, 0xef, 0xf9, 0x0f, 0xdb, 0xfa, 0xe7, 0xff, 0xf9, 0xff, 0xff, 0xff, 0xe7, 0xdf, 0xf9, 0xff, 0xff, 0xff, 0xe7, 0xcf, 0x19, 0xfc, 0xff, 0xff, 0xe7, 0xcf, 0xd9, 0xff, 0xff, 0xff, 0xe7, 0xff, 0xd9, 0x47, 0xce, 0x73, 0xe6, 0xff, 0x19, 0xb6, 0xb5, 0xad, 0xe7, 0xcf, 0xd9, 0xb7, 0xb5, 0x7d, 0xe6, 0xc7, 0xd9, 0xb7, 0xb5, 0xed, 0xe5, 0xef, 0x19, 0xb4, 0x4d, 0x73, 0xe6, 0xff, 0xf1, 0xff, 0xff, 0xff, 0xe3, 0xff, 0x03, 0x80, 0x03, 0x00, 0xf0, 0xef, 0x07, 0x00, 0x01, 0x00, 0xf8, 0xc7, 0xff, 0x3f, 0xf9, 0xff, 0xff, 0xe7, 0xff, 0x7f, 0xfd, 0xe0, 0xff, 0xff, 0xff, 0x7f, 0x7d, 0xdf, 0xff, 0xff, 0xff, 0x7f, 0xbd, 0xb1, 0xff, 0xff, 0xff, 0x7f, 0xbb, 0xae, 0xff, 0xef, 0xff, 0xff, 0xda, 0xae, 0xff, 0xc7, 0xff, 0xff, 0x66, 0xaf, 0xff, 0xe7, 0xff, 0xff, 0xbd, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xc3, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xff, 0xaf, 0xff}; #else short sink_bits[] = { 0xffff, 0xffff, 0xffff, 0xffff, 0xffff, 0x9f80, 0xffff, 0xffff, 0x9f9f, 0xffff, 0xffff, 0x8000, 0xffff, 0x7fff, 0xbffe, 0xffff, 0x7fff, 0xa003, 0xffff, 0x7fff, 0xaffd, 0xffff, 0x3fff, 0xaff9, 0xffff, 0xffff, 0xafff, 0xffff, 0xffff, 0xaffc, 0xffff, 0x7fff, 0xaff8, 0xffff, 0xffff, 0xaffc, 0xffff, 0xffff, 0xafff, 0xffff, 0xbfff, 0xaff7, 0xffff, 0x3fff, 0xaff3, 0xffff, 0xffff, 0xaffc, 0x003f, 0x0000, 0x2000, 0x007f, 0x0000, 0xe000, 0xf8df, 0xffff, 0x07ff, 0xf9cf, 0xff0f, 0xe7ff, 0xf9cf, 0xfff7, 0xe7ff, 0xf9ff, 0x63f7, 0xe7fb, 0xf9ff, 0x5a37, 0xe7fb, 0xf9cf, 0x5af7, 0xe7fb, 0xf9cf, 0x5af7, 0xe7f9, 0xf9ef, 0xdb0f, 0xe7fa, 0xf9ff, 0xffff, 0xe7ff, 0xf9df, 0xffff, 0xe7ff, 0x19cf, 0xfffc, 0xe7ff, 0xd9cf, 0xffff, 0xe7ff, 0xd9ff, 0xce47, 0xe673, 0x19ff, 0xb5b6, 0xe7ad, 0xd9cf, 0xb5b7, 0xe67d, 0xd9c7, 0xb5b7, 0xe5ed, 0x19ef, 0x4db4, 0xe673, 0xf1ff, 0xffff, 0xe3ff, 0x03ff, 0x0380, 0xf000, 0x07ef, 0x0100, 0xf800, 0xffc7, 0xf93f, 0xffff, 0xffe7, 0xfd7f, 0xffe0, 0xffff, 0x7d7f, 0xffdf, 0xffff, 0xbd7f, 0xffb1, 0xffff, 0xbb7f, 0xffae, 0xffef, 0xdaff, 0xffae, 0xffc7, 0x66ff, 0xffaf, 0xffe7, 0xbdff, 0xffaf, 0xffff, 0xc3ff, 0xffaf, 0xffff, 0xffff, 0xffaf}; #endif /* HAVE_X11 */ emacs-19.30/src/sink11.h100444 12241 12 3711 5444474614 13530 0ustar rolandstaff#define sink_width 48 #define sink_height 48 static char sink_bits[] = { 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x80, 0x9f, 0xff, 0xff, 0xff, 0xff, 0x9f, 0x9f, 0xff, 0xff, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0xff, 0x7f, 0xfe, 0xbf, 0xff, 0xff, 0xff, 0x7f, 0x03, 0xa0, 0xff, 0xff, 0xff, 0x7f, 0xfd, 0xaf, 0xff, 0xff, 0xff, 0x3f, 0xf9, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xff, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xfc, 0xaf, 0xff, 0xff, 0xff, 0x7f, 0xf8, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xfc, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xff, 0xaf, 0xff, 0xff, 0xff, 0xbf, 0xf7, 0xaf, 0xff, 0xff, 0xff, 0x3f, 0xf3, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xfc, 0xaf, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x20, 0x7f, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xdf, 0xf8, 0xff, 0xff, 0xff, 0x07, 0xcf, 0xf9, 0x0f, 0xff, 0xff, 0xe7, 0xcf, 0xf9, 0xf7, 0xff, 0xff, 0xe7, 0xff, 0xf9, 0xf7, 0x63, 0xfb, 0xe7, 0xff, 0xf9, 0x37, 0x5a, 0xfb, 0xe7, 0xcf, 0xf9, 0xf7, 0x5a, 0xfb, 0xe7, 0xcf, 0xf9, 0xf7, 0x5a, 0xf9, 0xe7, 0xef, 0xf9, 0x0f, 0xdb, 0xfa, 0xe7, 0xff, 0xf9, 0xff, 0xff, 0xff, 0xe7, 0xdf, 0xf9, 0xff, 0xff, 0xff, 0xe7, 0xcf, 0x19, 0xfc, 0xff, 0xff, 0xe7, 0xcf, 0xd9, 0xff, 0xff, 0xff, 0xe7, 0xff, 0xd9, 0x47, 0xce, 0x73, 0xe6, 0xff, 0x19, 0xb6, 0xb5, 0xad, 0xe7, 0xcf, 0xd9, 0xb7, 0xb5, 0x7d, 0xe6, 0xc7, 0xd9, 0xb7, 0xb5, 0xed, 0xe5, 0xef, 0x19, 0xb4, 0x4d, 0x73, 0xe6, 0xff, 0xf1, 0xff, 0xff, 0xff, 0xe3, 0xff, 0x03, 0x80, 0x03, 0x00, 0xf0, 0xef, 0x07, 0x00, 0x01, 0x00, 0xf8, 0xc7, 0xff, 0x3f, 0xf9, 0xff, 0xff, 0xe7, 0xff, 0x7f, 0xfd, 0xe0, 0xff, 0xff, 0xff, 0x7f, 0x7d, 0xdf, 0xff, 0xff, 0xff, 0x7f, 0xbd, 0xb1, 0xff, 0xff, 0xff, 0x7f, 0xbb, 0xae, 0xff, 0xef, 0xff, 0xff, 0xda, 0xae, 0xff, 0xc7, 0xff, 0xff, 0x66, 0xaf, 0xff, 0xe7, 0xff, 0xff, 0xbd, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xc3, 0xaf, 0xff, 0xff, 0xff, 0xff, 0xff, 0xaf, 0xff}; emacs-19.30/src/sink11mask.h100444 12241 12 3652 5444474615 14411 0ustar rolandstaff#define sink_mask_width 48 #define sink_mask_height 48 static char sink_mask_bits[] = { 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff}; emacs-19.30/src/sinkmask.h100444 12241 12 3536 5444474615 14250 0ustar rolandstaff#define sinkmask_width 48 #define sinkmask_height 48 static char sinkmask_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7f, 0x60, 0x00, 0x00, 0x00, 0x00, 0x60, 0x60, 0x00, 0x00, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x80, 0x01, 0x40, 0x00, 0x00, 0x00, 0x80, 0xfc, 0x5f, 0x00, 0x00, 0x00, 0x80, 0x02, 0x50, 0x00, 0x00, 0x00, 0xc0, 0x06, 0x50, 0x00, 0x00, 0x00, 0x00, 0x00, 0x50, 0x00, 0x00, 0x00, 0x00, 0x03, 0x50, 0x00, 0x00, 0x00, 0x80, 0x07, 0x50, 0x00, 0x00, 0x00, 0x00, 0x03, 0x50, 0x00, 0x00, 0x00, 0x00, 0x00, 0x50, 0x00, 0x00, 0x00, 0x40, 0x08, 0x50, 0x00, 0x00, 0x00, 0xc0, 0x0c, 0x50, 0x00, 0x00, 0x00, 0x00, 0x03, 0x50, 0xc0, 0xff, 0xff, 0xff, 0xff, 0xdf, 0x80, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x20, 0x07, 0x00, 0x00, 0x00, 0xf8, 0x30, 0x06, 0xf0, 0x00, 0x00, 0x18, 0x30, 0x06, 0x08, 0x00, 0x00, 0x18, 0x00, 0x06, 0x08, 0x9c, 0x04, 0x18, 0x00, 0x06, 0xc8, 0xa5, 0x04, 0x18, 0x30, 0x06, 0x08, 0xa5, 0x04, 0x18, 0x30, 0x06, 0x08, 0xa5, 0x06, 0x18, 0x10, 0x06, 0xf0, 0x24, 0x05, 0x18, 0x00, 0x06, 0x00, 0x00, 0x00, 0x18, 0x20, 0x06, 0x00, 0x00, 0x00, 0x18, 0x30, 0xe6, 0x03, 0x00, 0x00, 0x18, 0x30, 0x26, 0x00, 0x00, 0x00, 0x18, 0x00, 0x26, 0xb8, 0x31, 0x8c, 0x19, 0x00, 0xe6, 0x49, 0x4a, 0x52, 0x18, 0x30, 0x26, 0x48, 0x4a, 0x82, 0x19, 0x38, 0x26, 0x48, 0x4a, 0x12, 0x1a, 0x10, 0xe6, 0x4b, 0xb2, 0x8c, 0x19, 0x00, 0x0e, 0x00, 0x00, 0x00, 0x1c, 0x00, 0xfc, 0x7f, 0xfc, 0xff, 0x0f, 0x10, 0xf8, 0xff, 0xfe, 0xff, 0x07, 0x38, 0x00, 0xc0, 0x06, 0x00, 0x00, 0x18, 0x00, 0x80, 0x02, 0x1f, 0x00, 0x00, 0x00, 0x80, 0x82, 0x20, 0x00, 0x00, 0x00, 0x80, 0x42, 0x4e, 0x00, 0x00, 0x00, 0x80, 0x44, 0x51, 0x00, 0x10, 0x00, 0x00, 0x25, 0x51, 0x00, 0x38, 0x00, 0x00, 0x99, 0x50, 0x00, 0x18, 0x00, 0x00, 0x42, 0x50, 0x00, 0x00, 0x00, 0x00, 0x3c, 0x50, 0x00, 0x00, 0x00, 0x00, 0x00, 0x50, 0x00}; emacs-19.30/src/syntax.h100444 12120 1 15174 6044253230 13414 0ustar rmsdaemon/* Declarations having to do with GNU Emacs syntax tables. Copyright (C) 1985, 1993, 1994 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. */ extern Lisp_Object Qsyntax_table_p; extern Lisp_Object Fsyntax_table_p (), Fsyntax_table (), Fset_syntax_table (); /* The standard syntax table is stored where it will automatically be used in all new buffers. */ #define Vstandard_syntax_table buffer_defaults.syntax_table /* A syntax table is a chartable whose elements are cons cells (CODE+FLAGS . MATCHING-CHAR). MATCHING-CHAR can be nil if the char is not a kind of parenthesis. The low 8 bits of CODE+FLAGS is a code, as follows: */ enum syntaxcode { Swhitespace, /* for a whitespace character */ Spunct, /* for random punctuation characters */ Sword, /* for a word constituent */ Ssymbol, /* symbol constituent but not word constituent */ Sopen, /* for a beginning delimiter */ Sclose, /* for an ending delimiter */ Squote, /* for a prefix character like Lisp ' */ Sstring, /* for a string-grouping character like Lisp " */ Smath, /* for delimiters like $ in Tex. */ Sescape, /* for a character that begins a C-style escape */ Scharquote, /* for a character that quotes the following character */ Scomment, /* for a comment-starting character */ Sendcomment, /* for a comment-ending character */ Sinherit, /* use the standard syntax table for this character */ Smax /* Upper bound on codes that are meaningful */ }; /* Fetch the syntax entry for char C from table TABLE. This returns the whole entry (normally a cons cell) and does not do any kind of inheritance. */ #if 1 #define RAW_SYNTAX_ENTRY(table, c) \ (XCHAR_TABLE (table)->contents[(unsigned char) (c)]) #define SET_RAW_SYNTAX_ENTRY(table, c, val) \ (XCHAR_TABLE (table)->contents[(unsigned char) (c)] = (val)) #else #define RAW_SYNTAX_ENTRY(table, c) \ ((c) >= 128 \ ? raw_syntax_table_lookup (table, c) \ : XCHAR_TABLE (table)->contents[(unsigned char) (c)]) #define SET_RAW_SYNTAX_ENTRY(table, c, val) \ ((c) >= 128 \ ? set_raw_syntax_table_lookup (table, c, (val)) \ : XCHAR_TABLE (table)->contents[(unsigned char) (c)] = (val)) #endif /* Extract the information from the entry for character C in syntax table TABLE. Do inheritance. */ #ifdef __GNUC__ #define SYNTAX_ENTRY(c) \ ({ Lisp_Object temp, table; \ unsigned char cc = (c); \ table = current_buffer->syntax_table; \ while (!NILP (table)) \ { \ temp = RAW_SYNTAX_ENTRY (table, cc); \ if (!NILP (temp)) \ break; \ table = XCHAR_TABLE (table)->parent; \ } \ temp; }) #define SYNTAX(c) \ ({ Lisp_Object temp; \ temp = SYNTAX_ENTRY (c); \ (CONSP (temp) \ ? (enum syntaxcode) (XINT (XCONS (temp)->car) & 0xff) \ : wrong_type_argument (Qconsp, temp)); }) #define SYNTAX_WITH_FLAGS(c) \ ({ Lisp_Object temp; \ temp = SYNTAX_ENTRY (c); \ (CONSP (temp) \ ? XINT (XCONS (temp)->car) \ : wrong_type_argument (Qconsp, temp)); }) #define SYNTAX_MATCH(c) \ ({ Lisp_Object temp; \ temp = SYNTAX_ENTRY (c); \ (CONSP (temp) \ ? XINT (XCONS (temp)->cdr) \ : wrong_type_argument (Qconsp, temp)); }) #else extern Lisp_Object syntax_temp; extern Lisp_Object syntax_parent_lookup (); #define SYNTAX_ENTRY(c) \ (syntax_temp \ = RAW_SYNTAX_ENTRY (current_buffer->syntax_table, (c)), \ (NILP (syntax_temp) \ ? (syntax_temp \ = syntax_parent_lookup (current_buffer->syntax_table, (c))) \ : syntax_temp)) #define SYNTAX(c) \ (syntax_temp = SYNTAX_ENTRY ((c)), \ (CONSP (syntax_temp) \ ? (enum syntaxcode) (XINT (XCONS (syntax_temp)->car) & 0xff) \ : wrong_type_argument (Qconsp, syntax_temp))) #define SYNTAX_WITH_FLAGS(c) \ (syntax_temp = SYNTAX_ENTRY ((c)), \ (CONSP (syntax_temp) \ ? XINT (XCONS (syntax_temp)->car) \ : wrong_type_argument (Qconsp, syntax_temp))) #define SYNTAX_MATCH(c) \ (syntax_temp = SYNTAX_ENTRY ((c)), \ (CONSP (syntax_temp) \ ? XINT (XCONS (syntax_temp)->cdr) \ : wrong_type_argument (Qconsp, syntax_temp))) #endif /* Then there are six single-bit flags that have the following meanings: 1. This character is the first of a two-character comment-start sequence. 2. This character is the second of a two-character comment-start sequence. 3. This character is the first of a two-character comment-end sequence. 4. This character is the second of a two-character comment-end sequence. 5. This character is a prefix, for backward-prefix-chars. Note that any two-character sequence whose first character has flag 1 and whose second character has flag 2 will be interpreted as a comment start. bit 6 is used to discriminate between two different comment styles. Languages such as C++ allow two orthogonal syntax start/end pairs and bit 6 is used to determine whether a comment-end or Scommentend ends style a or b. Comment start sequences can start style a or b. Style a is always the default. */ #define SYNTAX_COMSTART_FIRST(c) ((SYNTAX_WITH_FLAGS (c) >> 16) & 1) #define SYNTAX_COMSTART_SECOND(c) ((SYNTAX_WITH_FLAGS (c) >> 17) & 1) #define SYNTAX_COMEND_FIRST(c) ((SYNTAX_WITH_FLAGS (c) >> 18) & 1) #define SYNTAX_COMEND_SECOND(c) ((SYNTAX_WITH_FLAGS (c) >> 19) & 1) #define SYNTAX_PREFIX(c) ((SYNTAX_WITH_FLAGS (c) >> 20) & 1) /* extract the comment style bit from the syntax table entry */ #define SYNTAX_COMMENT_STYLE(c) ((SYNTAX_WITH_FLAGS (c) >> 21) & 1) /* This array, indexed by a character, contains the syntax code which that character signifies (as a char). For example, (enum syntaxcode) syntax_spec_code['w'] is Sword. */ extern unsigned char syntax_spec_code[0400]; /* Indexed by syntax code, give the letter that describes it. */ extern char syntax_code_spec[14]; emacs-19.30/src/sysselect.h100444 75424 12 2571 5711032546 14152 0ustar kwzhstaff/* sysselect.h - System-dependent definitions for the select function. Copyright (C) 1995 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. */ #ifdef HAVE_SYS_SELECT #include #endif #ifdef FD_SET #ifdef FD_SETSIZE #define MAXDESC FD_SETSIZE #else #define MAXDESC 64 #endif #define SELECT_TYPE fd_set #else /* no FD_SET */ #define MAXDESC 32 #define SELECT_TYPE int /* Define the macros to access a single-int bitmap of descriptors. */ #define FD_SET(n, p) (*(p) |= (1 << (n))) #define FD_CLR(n, p) (*(p) &= ~(1 << (n))) #define FD_ISSET(n, p) (*(p) & (1 << (n))) #define FD_ZERO(p) (*(p) = 0) #endif /* no FD_SET */ #if !defined (HAVE_SELECT) || defined (BROKEN_SELECT_NON_X) #define select sys_select #endif emacs-19.30/src/syssignal.h100444 12120 1 10707 6045035117 14102 0ustar rmsdaemon/* syssignal.h - System-dependent definitions for signals. Copyright (C) 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. */ #ifdef POSIX_SIGNALS /* Don't #include . That header should always be #included before "config.h", because some configuration files (like s/hpux.h) indicate that SIGIO doesn't work by #undef-ing SIGIO. If this file #includes , then that will re-#define SIGIO and confuse things. */ #define SIGMASKTYPE sigset_t #define SIGEMPTYMASK (empty_mask) #define SIGFULLMASK (full_mask) extern sigset_t empty_mask, full_mask, temp_mask; /* POSIX pretty much destroys any possibility of writing sigmask as a macro in standard C. */ #ifndef sigmask #ifdef __GNUC__ #define sigmask(SIG) \ ({ \ sigset_t _mask; \ sigemptyset (&_mask); \ sigaddset (&_mask, SIG); \ _mask; \ }) #else /* ! defined (__GNUC__) */ extern sigset_t sys_sigmask (); #define sigmask(SIG) (sys_sigmask (SIG)) #endif /* ! defined (__GNUC__) */ #endif #define sigpause(SIG) sys_sigpause (SIG) #define sigblock(SIG) sys_sigblock (SIG) #define sigunblock(SIG) sys_sigunblock (SIG) #define sigsetmask(SIG) sys_sigsetmask (SIG) #define sighold(SIG) ONLY_USED_IN_BSD_4_1 #define sigrelse(SIG) ONLY_USED_IN_BSD_4_1 #undef signal #define signal(SIG,ACT) sys_signal(SIG,ACT) /* Whether this is what all systems want or not, this is what appears to be assumed in the source, for example data.c:arith_error. */ typedef RETSIGTYPE (*signal_handler_t) (/*int*/); signal_handler_t sys_signal (/*int signal_number, signal_handler_t action*/); int sys_sigpause (/*sigset_t new_mask*/); sigset_t sys_sigblock (/*sigset_t new_mask*/); sigset_t sys_sigunblock (/*sigset_t new_mask*/); sigset_t sys_sigsetmask (/*sigset_t new_mask*/); #define sys_sigdel(MASK,SIG) sigdelset (&MASK,SIG) #else /* ! defined (POSIX_SIGNALS) */ #ifdef USG5_4 #ifndef sigblock #define sigblock(sig) (sigprocmask (SIG_BLOCK, SIGEMPTYMASK | sig, NULL)) #endif #define sigunblock(sig) (sigprocmask (SIG_SETMASK, SIGFULLMASK & ~(sig), NULL)) #else #ifdef USG #define sigunblock(sig) #else #define sigunblock(SIG) \ { SIGMASKTYPE omask = sigblock (SIGEMPTYMASK); sigsetmask (omask & ~SIG); } #endif /* ! defined (USG) */ #endif /* ! defined (USG5_4) */ #endif /* ! defined (POSIX_SIGNALS) */ #ifndef SIGMASKTYPE #define SIGMASKTYPE int #endif #ifndef SIGEMPTYMASK #define SIGEMPTYMASK (0) #endif #ifndef SIGFULLMASK #define SIGFULLMASK (0xffffffff) #endif #ifndef sigmask #define sigmask(no) (1L << ((no) - 1)) #endif #ifndef sigunblock #define sigunblock(SIG) \ { SIGMASKTYPE omask = sigblock (SIGFULLMASK); sigsetmask (omask & ~SIG); } #endif /* It would be very nice if we could somehow clean up all this trash. */ #ifndef BSD4_1 #define sigfree() sigsetmask (SIGEMPTYMASK) #define sigholdx(sig) sigsetmask (sigmask (sig)) #define sigblockx(sig) sigblock (sigmask (sig)) #define sigunblockx(sig) sigblock (SIGEMPTYMASK) #define sigpausex(sig) sigpause (0) #endif /* BSD4_1 */ #ifdef BSD4_1 #define SIGIO SIGTINT /* sigfree and sigholdx are in sysdep.c */ #define sigblockx(sig) sighold (sig) #define sigunblockx(sig) sigrelse (sig) #define sigpausex(sig) sigpause (sig) #endif /* ! defined (BSD4_1) */ /* On bsd, [man says] kill does not accept a negative number to kill a pgrp. Must do that using the killpg call. */ #ifdef BSD #define EMACS_KILLPG(gid, signo) (killpg ( (gid), (signo))) #else #ifdef WINDOWSNT #define EMACS_KILLPG(gid, signo) (win32_kill_process (gid, signo)) #else #define EMACS_KILLPG(gid, signo) (kill (-(gid), (signo))) #endif #endif /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals testing SIGCHLD. */ #ifndef VMS #ifdef SIGCLD #ifndef SIGCHLD #define SIGCHLD SIGCLD #endif /* SIGCHLD */ #endif /* ! defined (SIGCLD) */ #endif /* VMS */ emacs-19.30/src/systime.h100444 75424 1 11250 5770115151 13760 0ustar kwzhdaemon/* systime.h - System-dependent definitions for time manipulations. Copyright (C) 1993, 1994 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. */ #ifdef TIME_WITH_SYS_TIME #include #include #else #ifdef HAVE_SYS_TIME_H #include #else #include #endif #endif #ifdef HAVE_TZNAME #ifndef tzname /* For SGI. */ extern char *tzname[]; /* RS6000 and others want it this way. */ #endif #endif /* SVr4 doesn't actually declare this in its #include files. */ #ifdef USG5_4 extern long timezone; #endif #ifdef VMS #ifdef VAXC #include "vmstime.h" #endif #endif /* On some configurations (hpux8.0, X11R4), sys/time.h and X11/Xos.h disagree about the name of the guard symbol. */ #ifdef HPUX #ifdef _STRUCT_TIMEVAL #ifndef __TIMEVAL__ #define __TIMEVAL__ #endif #endif #endif /* EMACS_TIME is the type to use to represent temporal intervals - struct timeval on some systems, int on others. It can be passed as the timeout argument to the select system call. EMACS_SECS (TIME) is an rvalue for the seconds component of TIME. EMACS_SET_SECS (TIME, SECONDS) sets that to SECONDS. EMACS_HAS_USECS is defined iff EMACS_TIME has a usecs component. EMACS_USECS (TIME) is an rvalue for the microseconds component of TIME. This returns zero if EMACS_TIME doesn't have a microseconds component. EMACS_SET_USECS (TIME, MICROSECONDS) sets that to MICROSECONDS. This does nothing if EMACS_TIME doesn't have a microseconds component. EMACS_SET_SECS_USECS (TIME, SECS, USECS) sets both components of TIME. EMACS_GET_TIME (TIME) stores the current system time in TIME, which should be an lvalue. EMACS_ADD_TIME (DEST, SRC1, SRC2) adds SRC1 to SRC2 and stores the result in DEST. SRC should not be negative. EMACS_SUB_TIME (DEST, SRC1, SRC2) subtracts SRC2 from SRC1 and stores the result in DEST. SRC should not be negative. EMACS_TIME_NEG_P (TIME) is true iff TIME is negative. */ #ifdef HAVE_TIMEVAL #define EMACS_HAS_USECS #define EMACS_TIME struct timeval #define EMACS_SECS(time) ((time).tv_sec + 0) #define EMACS_USECS(time) ((time).tv_usec + 0) #define EMACS_SET_SECS(time, seconds) ((time).tv_sec = (seconds)) #define EMACS_SET_USECS(time, microseconds) ((time).tv_usec = (microseconds)) /* On SVR4, the compiler may complain if given this extra BSD arg. */ #ifdef GETTIMEOFDAY_ONE_ARGUMENT #define EMACS_GET_TIME(time) \ { \ gettimeofday (&(time)); \ } #else /* not GETTIMEOFDAY_ONE_ARGUMENT */ #define EMACS_GET_TIME(time) \ { \ struct timezone dummy; \ gettimeofday (&(time), &dummy); \ } #endif /* not GETTIMEOFDAY_ONE_ARGUMENT */ #define EMACS_ADD_TIME(dest, src1, src2) \ { \ (dest).tv_sec = (src1).tv_sec + (src2).tv_sec; \ (dest).tv_usec = (src1).tv_usec + (src2).tv_usec; \ if ((dest).tv_usec > 1000000) \ (dest).tv_usec -= 1000000, (dest).tv_sec++; \ } #define EMACS_SUB_TIME(dest, src1, src2) \ { \ (dest).tv_sec = (src1).tv_sec - (src2).tv_sec; \ (dest).tv_usec = (src1).tv_usec - (src2).tv_usec; \ if ((dest).tv_usec < 0) \ (dest).tv_usec += 1000000, (dest).tv_sec--; \ } #define EMACS_TIME_NEG_P(time) \ ((long)(time).tv_sec < 0 \ || ((time).tv_sec == 0 \ && (long)(time).tv_usec < 0)) #else /* ! defined (HAVE_TIMEVAL) */ #define EMACS_TIME int #define EMACS_SECS(time) (time) #define EMACS_USECS(time) 0 #define EMACS_SET_SECS(time, seconds) ((time) = (seconds)) #define EMACS_SET_USECS(time, usecs) 0 #define EMACS_GET_TIME(t) ((t) = time ((long *) 0)) #define EMACS_ADD_TIME(dest, src1, src2) ((dest) = (src1) + (src2)) #define EMACS_SUB_TIME(dest, src1, src2) ((dest) = (src1) - (src2)) #define EMACS_TIME_NEG_P(t) ((t) < 0) #endif /* ! defined (HAVE_TIMEVAL) */ #define EMACS_SET_SECS_USECS(time, secs, usecs) \ (EMACS_SET_SECS (time, secs), EMACS_SET_USECS (time, usecs)) extern int set_file_times (); emacs-19.30/src/systty.h100444 12120 1 23573 5767667121 13472 0ustar rmsdaemon/* systty.h - System-dependent definitions for terminals. Copyright (C) 1993, 1994 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. */ #ifdef HAVE_TERMIOS #define HAVE_TCATTR #endif /* If we defined these before and we are about to redefine them, prevent alarming warnings. */ #ifdef BSD_TERMIOS #undef NL0 #undef NL1 #undef CR0 #undef CR1 #undef CR2 #undef CR3 #undef TAB0 #undef TAB1 #undef TAB2 #undef XTABS #undef BS0 #undef BS1 #undef FF0 #undef FF1 #undef ECHO #undef NOFLSH #undef TOSTOP #undef FLUSHO #undef PENDIN #endif /* Include the proper files. */ #ifdef HAVE_TERMIO #ifdef __DGUX #include #endif #ifndef NO_TERMIO #include #endif /* not NO_TERMIO */ #ifndef INCLUDED_FCNTL #define INCLUDED_FCNTL #include #endif #else /* not HAVE_TERMIO */ #ifdef HAVE_TERMIOS #if defined(_AIX) && defined(_I386) #include /* termios.h needs to be before termio.h */ #include #else /* not HAVE_TERMIOS */ #ifndef NO_TERMIO #include #endif #include #endif /* _AIX && _I386 */ #define INCLUDED_FCNTL #include #else /* neither HAVE_TERMIO nor HAVE_TERMIOS */ #ifndef VMS #ifndef DOS_NT #include #endif /* not DOS_NT */ #else /* VMS */ #include static struct iosb { short status; short offset; short termlen; short term; } input_iosb; extern int waiting_for_ast; extern int stop_input; extern int input_ef; extern int timer_ef; extern int process_ef; extern int input_eflist; extern int timer_eflist; static $DESCRIPTOR (input_dsc, "TT"); static int terminator_mask[2] = { 0, 0 }; static struct sensemode { short status; unsigned char xmit_baud; unsigned char rcv_baud; unsigned char crfill; unsigned char lffill; unsigned char parity; unsigned char unused; char class; char type; short scr_wid; unsigned long tt_char : 24, scr_len : 8; unsigned long tt2_char; } sensemode_iosb; #endif /* VMS */ #endif /* not HAVE_TERMIOS */ #endif /* not HAVE_TERMIO */ #ifdef __GNU_LIBRARY__ #include #endif #ifdef AIXHFT /* Get files for keyboard remapping */ #define HFNKEYS 2 #include #include #endif /* Get rid of LLITOUT in 4.1, since it is said to stimulate kernel bugs. */ #ifdef BSD4_1 #undef LLITOUT #define LLITOUT 0 #endif /* 4.1 */ #ifdef NEED_BSDTTY #include #endif #if defined (HPUX) && defined (HAVE_PTYS) #include #endif #ifdef AIX #include #endif /* AIX */ #if (defined (POSIX) || defined (NEED_UNISTD_H)) && defined (HAVE_UNISTD_H) #include #endif #ifdef SYSV_PTYS #include #include #ifdef titan #include #include #endif #ifndef NO_PTY_H #include #endif #endif /* saka@pfu.fujitsu.co.JP writes: FASYNC defined in this file. But, FASYNC don't working. so no problem, because unrequest_sigio only need. */ #if defined (pfa) #include #endif /* Special cases - inhibiting the use of certain features. */ #ifdef APOLLO #undef TIOCSTART #endif #ifdef XENIX #undef TIOCGETC /* Avoid confusing some conditionals that test this. */ #endif #ifdef BROKEN_TIOCGETC #undef TIOCGETC /* Avoid confusing some conditionals that test this. */ #endif /* UNIPLUS systems may have FIONREAD. */ #ifdef UNIPLUS #include #endif /* Allow m- file to inhibit use of FIONREAD. */ #ifdef BROKEN_FIONREAD #undef FIONREAD #undef ASYNC #endif /* Interrupt input is not used if there is no FIONREAD. */ #ifndef FIONREAD #undef SIGIO #endif /* On TERMIOS systems, the tcmumbleattr calls take care of these parameters, and it's a bad idea to use them (on AIX, it makes the tty hang for a long time). */ #if defined (TIOCGLTC) && !defined (HAVE_TERMIOS) #define HAVE_LTCHARS #endif #if defined (TIOCGETC) && !defined (HAVE_TERMIOS) #define HAVE_TCHARS #endif /* Try to establish the correct character to disable terminal functions in a system-independent manner. Note that USG (at least) define _POSIX_VDISABLE as 0! */ #ifdef _POSIX_VDISABLE #define CDISABLE _POSIX_VDISABLE #else /* not _POSIX_VDISABLE */ #ifdef CDEL #undef CDISABLE #define CDISABLE CDEL #else /* not CDEL */ #define CDISABLE 255 #endif /* not CDEL */ #endif /* not _POSIX_VDISABLE */ /* Get the number of characters queued for output. */ /* EMACS_OUTQSIZE(FD, int *SIZE) stores the number of characters queued for output to the terminal FD in *SIZE, if FD is a tty. Returns -1 if there was an error (i.e. FD is not a tty), 0 otherwise. */ #ifdef TIOCOUTQ #define EMACS_OUTQSIZE(fd, size) (ioctl ((fd), TIOCOUTQ, (size))) #endif #ifdef HAVE_TERMIO #ifdef TCOUTQ #undef EMACS_OUTQSIZE #define EMACS_OUTQSIZE(fd, size) (ioctl ((fd), TCOUTQ, (size))) #endif #endif /* Manipulate a terminal's current process group. */ /* EMACS_HAVE_TTY_PGRP is true if we can get and set the tty's current controlling process group. EMACS_GET_TTY_PGRP(int FD, int *PGID) sets *PGID the terminal FD's current process group. Return -1 if there is an error. EMACS_SET_TTY_PGRP(int FD, int *PGID) sets the terminal FD's current process group to *PGID. Return -1 if there is an error. */ #ifdef HPUX /* HPUX tty process group stuff doesn't work, says the anonymous voice from the past. */ #else #ifdef TIOCGPGRP #define EMACS_HAVE_TTY_PGRP #else #ifdef HAVE_TERMIOS #define EMACS_HAVE_TTY_PGRP #endif #endif #endif #ifdef EMACS_HAVE_TTY_PGRP #if defined (HAVE_TERMIOS) && ! defined (BSD_TERMIOS) #define EMACS_GET_TTY_PGRP(fd, pgid) (*(pgid) = tcgetpgrp ((fd))) #define EMACS_SET_TTY_PGRP(fd, pgid) (tcsetpgrp ((fd), *(pgid))) #else #ifdef TIOCSPGRP #define EMACS_GET_TTY_PGRP(fd, pgid) (ioctl ((fd), TIOCGPGRP, (pgid))) #define EMACS_SET_TTY_PGRP(fd, pgid) (ioctl ((fd), TIOCSPGRP, (pgid))) #endif #endif #else /* Just ignore this for now and hope for the best */ #define EMACS_GET_TTY_PGRP(fd, pgid) 0 #define EMACS_SET_TTY_PGRP(fd, pgif) 0 #endif /* EMACS_GETPGRP (arg) returns the process group of the terminal. */ #if defined (USG) && !defined (GETPGRP_NEEDS_ARG) # if !defined (GETPGRP_NO_ARG) # define GETPGRP_NO_ARG # endif #endif #if defined (GETPGRP_NO_ARG) # define EMACS_GETPGRP(x) getpgrp() #else # define EMACS_GETPGRP(x) getpgrp(x) #endif /* !GETPGRP_NO_ARG */ /* Manipulate a TTY's input/output processing parameters. */ /* struct emacs_tty is a structure used to hold the current tty parameters. If the terminal has several structures describing its state, for example a struct tchars, a struct sgttyb, a struct tchars, a struct ltchars, and a struct pagechars, struct emacs_tty should contain an element for each parameter struct that Emacs may change. EMACS_GET_TTY (int FD, struct emacs_tty *P) stores the parameters of the tty on FD in *P. Return zero if all's well, or -1 if we ran into an error we couldn't deal with. EMACS_SET_TTY (int FD, struct emacs_tty *P, int flushp) sets the parameters of the tty on FD according to the contents of *P. If flushp is non-zero, we discard queued input to be written before making the change. Return 0 if all went well, and -1 if anything failed. EMACS_TTY_TABS_OK (struct emacs_tty *P) is false iff the kernel expands tabs to spaces upon output; in that case, there is no advantage to using tabs over spaces. */ /* For each tty parameter structure that Emacs might want to save and restore, - include an element for it in this structure, and - extend the emacs_{get,set}_tty functions in sysdep.c to deal with the new members. */ struct emacs_tty { /* There is always one of the following elements, so there is no need for dummy get and set definitions. */ #ifdef HAVE_TCATTR struct termios main; #else #ifdef HAVE_TERMIO struct termio main; #else #ifdef VMS struct sensemode main; #else #ifdef DOS_NT int main; #else /* not DOS_NT */ struct sgttyb main; #endif /* not DOS_NT */ #endif #endif #endif /* If we have TERMIOS, we don't need to do this - they're taken care of by the tc*attr calls. */ #ifndef HAVE_TERMIOS #ifdef HAVE_LTCHARS struct ltchars ltchars; #endif #ifdef HAVE_TCHARS struct tchars tchars; int lmode; #endif #endif }; /* Define EMACS_GET_TTY and EMACS_SET_TTY, the macros for reading and setting parts of `struct emacs_tty'. These got pretty unmanageable (huge macros are hard to debug), and finally needed some code which couldn't be done as part of an expression, so we moved them out to their own functions in sysdep.c. */ #define EMACS_GET_TTY(fd, p) (emacs_get_tty ((fd), (p))) #define EMACS_SET_TTY(fd, p, waitp) (emacs_set_tty ((fd), (p), (waitp))) /* Define EMACS_TTY_TABS_OK. */ #ifdef HAVE_TERMIOS #ifdef TABDLY #define EMACS_TTY_TABS_OK(p) (((p)->main.c_oflag & TABDLY) != TAB3) #else #define EMACS_TTY_TABS_OK(p) 1 #endif #else /* not def HAVE_TERMIOS */ #ifdef HAVE_TERMIO #define EMACS_TTY_TABS_OK(p) (((p)->main.c_oflag & TABDLY) != TAB3) #else /* neither HAVE_TERMIO nor HAVE_TERMIOS */ #ifdef VMS #define EMACS_TTY_TABS_OK(p) (((p)->main.tt_char & TT$M_MECHTAB) != 0) #else #ifdef DOS_NT #define EMACS_TTY_TABS_OK(p) 0 #else /* not DOS_NT */ #define EMACS_TTY_TABS_OK(p) (((p)->main.sg_flags & XTABS) != XTABS) #endif /* not DOS_NT */ #endif /* not def VMS */ #endif /* not def HAVE_TERMIO */ #endif /* not def HAVE_TERMIOS */ emacs-19.30/src/uaf.h100444 75424 1 21464 5770115153 13050 0ustar kwzhdaemon/* GNU Emacs VMS UAF definition file. Copyright (C) 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 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. */ /* * User Authorization File record formats */ #ifndef UAF$K_LENGTH struct UAF { #define UAF$C_USER_ID 1 #define UAF$C_VERSION1 1 #define UAF$C_KEYED_PART 52 #define UAF$C_AD_II 0 #define UAF$C_PURDY 1 #define UAF$C_PURDY_V 2 #define UAF$K_FIXED 644 #define UAF$C_FIXED 644 #define UAF$K_LENGTH 1412 #define UAF$C_LENGTH 1412 #define UAF$S_UAFDEF 1412 #define UAF$B_RTYPE 0 char uaf$b_rtype; #define UAF$B_VERSION 1 char uaf$b_version; #define UAF$W_USRDATOFF 2 short uaf$w_usrdatoff; #define UAF$S_USERNAME 32 #define UAF$T_USERNAME 4 #define UAF$T_USERNAME_TAG 35 char uaf$t_username[UAF$S_USERNAME]; #define UAF$L_UIC 36 #define UAF$W_MEM 36 #define UAF$W_GRP 38 union { long uaf_l_uic; #define uaf$l_uic uaf_u_uic.uaf_l_uic struct { short uaf_w_mem; short uaf_w_grp; #define uaf$w_mem uaf_u_uic.uaf_u_mem_grp.uaf_w_mem #define uaf$w_grp uaf_u_uic.uaf_u_mem_grp.uaf_w_grp } uaf_u_mem_grp; } uaf_u_uic; #define UAF$L_SUB_ID 40 long uaf$l_sub_id; #define UAF$S_PARENT_ID 8 #define UAF$Q_PARENT_ID 44 char uaf$q_parent_id[UAF$S_PARENT_ID]; #define UAF$S_ACCOUNT 32 #define UAF$T_ACCOUNT 52 char uaf$t_account[UAF$S_ACCOUNT]; #define UAF$S_OWNER 32 #define UAF$T_OWNER 84 char uaf$t_owner[UAF$S_OWNER]; #define UAF$S_DEFDEV 32 #define UAF$T_DEFDEV 116 char uaf$t_defdev[UAF$S_DEFDEV]; #define UAF$S_DEFDIR 64 #define UAF$T_DEFDIR 148 char uaf$t_defdir[UAF$S_DEFDIR]; #define UAF$S_LGICMD 64 #define UAF$T_LGICMD 212 char uaf$t_lgicmd[UAF$S_LGICMD]; #define UAF$S_DEFCLI 32 #define UAF$T_DEFCLI 276 char uaf$t_defcli[UAF$S_DEFCLI]; #define UAF$S_CLITABLES 32 #define UAF$T_CLITABLES 308 char uaf$t_clitables[UAF$S_CLITABLES]; #define UAF$S_PWD 8 #define UAF$Q_PWD 340 #define UAF$L_PWD 340 char uaf$q_pwd[UAF$S_PWD]; #define uaf$l_pwd uaf$q_pwd[0] #define UAF$S_PWD2 8 #define UAF$Q_PWD2 348 char uaf$q_pwd2[UAF$S_PWD2]; #define UAF$W_LOGFAILS 356 short uaf$w_logfails; #define UAF$W_SALT 358 short uaf$w_salt; #define UAF$B_ENCRYPT 360 char uaf$b_encrypt; #define UAF$B_ENCRYPT2 361 char uaf$b_encrypt2; #define UAF$B_PWD_LENGTH 362 char uaf$b_pwd_length; #define UAF$S_EXPIRATION 8 #define UAF$Q_EXPIRATION 364 char uaf$q_expiration[UAF$S_EXPIRATION]; #define UAF$S_PWD_LIFETIME 8 #define UAF$Q_PWD_LIFETIME 372 char uaf$q_pwd_lifetime[UAF$S_PWD_LIFETIME]; #define UAF$S_PWD_DATE 8 #define UAF$Q_PWD_DATE 380 char uaf$q_pwd_date[UAF$S_PWD_DATE]; #define UAF$S_PWD2_DATE 8 #define UAF$Q_PWD2_DATE 388 char uaf$q_pwd2_date[UAF$S_PWD2_DATE]; #define UAF$S_LASTLOGIN_I 8 #define UAF$Q_LASTLOGIN_I 396 char uaf$q_lastlogin_i[UAF$S_LASTLOGIN_I]; #define UAF$S_LASTLOGIN_N 8 #define UAF$Q_LASTLOGIN_N 404 char uaf$q_lastlogin_n[UAF$S_LASTLOGIN_N]; #define UAF$S_PRIV 8 #define UAF$Q_PRIV 412 char uaf$q_priv[UAF$S_PRIV]; #define UAF$S_DEF_PRIV 8 #define UAF$Q_DEF_PRIV 420 char uaf$q_def_priv[UAF$S_DEF_PRIV]; #define UAF$S_MIN_CLASS 20 #define UAF$R_MIN_CLASS 428 char uaf$r_min_class[UAF$S_MIN_CLASS]; #define UAF$S_MAX_CLASS 20 #define UAF$R_MAX_CLASS 448 char uaf$r_max_class[UAF$S_MAX_CLASS]; #define UAF$L_FLAGS 468 #define UAF$V_DISCTLY 0 #define UAF$V_DEFCLI 1 #define UAF$V_LOCKPWD 2 #define UAF$V_CAPTIVE 3 #define UAF$V_DISACNT 4 #define UAF$V_DISWELCOM 5 #define UAF$V_DISMAIL 6 #define UAF$V_NOMAIL 7 #define UAF$V_GENPWD 8 #define UAF$V_PWD_EXPIRED 9 #define UAF$V_PWD2_EXPIRED 10 #define UAF$V_AUDIT 11 #define UAF$V_DISREPORT 12 #define UAF$V_DISRECONNECT 13 union { unsigned long uaf_l_flags; #define uaf$l_flags uaf_u_flags.uaf_l_flags struct { unsigned long uaf_v_disctly : 1, #define uaf$v_disctly uaf_u_flags.uaf_v_flags.uaf_v_disctly uaf_v_defcli : 1, #define uaf$v_defcli uaf_u_flags.uaf_v_flags.uaf_v_discli uaf_v_lockpwd : 1, #define uaf$v_lockpwd uaf_u_flags.uaf_v_flags.uaf_v_lockpwd uaf_v_captive : 1, #define uaf$v_captive uaf_u_flags.uaf_v_flags.uaf_v_captive uaf_v_disacnt : 1, #define uaf$v_disacnt uaf_u_flags.uaf_v_flags.uaf_v_disacnt uaf_v_diswelcom : 1, #define uaf$v_diswelcom uaf_u_flags.uaf_v_flags.uaf_v_diswelcom uaf_v_dismail : 1, #define uaf$v_dismail uaf_u_flags.uaf_v_flags.uaf_v_dismail uaf_v_nomail : 1, #define uaf$v_nomail uaf_u_flags.uaf_v_flags.uaf_v_nomail uaf_v_genpwd : 1, #define uaf$v_genpwd uaf_u_flags.uaf_v_flags.uaf_v_genpwd uaf_v_pwd_expired : 1, #define uaf$v_pwd_expired uaf_u_flags.uaf_v_flags.uaf_v_pwd_expired uaf_v_pwd2_expired : 1, #define uaf$v_pwd2_expired uaf_u_flags.uaf_v_flags.uaf_v_pwd2_expired uaf_v_audit : 1, #define uaf$v_audit uaf_u_flags.uaf_v_flags.uaf_v_audit uaf_v_disreport : 1, #define uaf$v_disreport uaf_u_flags.uaf_v_flags.uaf_v_disreport uaf_v_disreconnect : 1; #define uaf$v_disreconnect uaf_u_flags.uaf_v_flags.uaf_v_disreconnect } uaf_v_flags; } uaf_u_flags; #define UAF$S_NETWORK_ACCESS_P 3 #define UAF$B_NETWORK_ACCESS_P 472 char uaf$b_network_access_p[UAF$S_NETWORK_ACCESS_P]; #define UAF$S_NETWORK_ACCESS_S 3 #define UAF$B_NETWORK_ACCESS_S 475 char uaf$b_network_access_s[UAF$S_NETWORK_ACCESS_S]; #define UAF$S_BATCH_ACCESS_P 3 #define UAF$B_BATCH_ACCESS_P 478 char uaf$b_batch_access_p[UAF$S_BATCH_ACCESS_P]; #define UAF$S_BATCH_ACCESS_S 3 #define UAF$B_BATCH_ACCESS_S 481 char uaf$b_batch_access_s[UAF$S_BATCH_ACCESS_S]; #define UAF$S_LOCAL_ACCESS_P 3 #define UAF$B_LOCAL_ACCESS_P 484 char uaf$b_local_access_p[UAF$S_LOCAL_ACCESS_P]; #define UAF$S_LOCAL_ACCESS_S 3 #define UAF$B_LOCAL_ACCESS_S 487 char uaf$b_local_access_s[UAF$S_LOCAL_ACCESS_S]; #define UAF$S_DIALUP_ACCESS_P 3 #define UAF$B_DIALUP_ACCESS_P 490 char uaf$b_dialup_access_p[UAF$S_DIALUP_ACCESS_P]; #define UAF$S_DIALUP_ACCESS_S 3 #define UAF$B_DIALUP_ACCESS_S 493 char uaf$b_dialup_access_s[UAF$S_DIALUP_ACCESS_S]; #define UAF$S_REMOTE_ACCESS_P 3 #define UAF$B_REMOTE_ACCESS_P 496 char uaf$b_remote_access_p[UAF$S_REMOTE_ACCESS_P]; #define UAF$S_REMOTE_ACCESS_S 3 #define UAF$B_REMOTE_ACCESS_S 499 char uaf$b_remote_access_s[UAF$S_REMOTE_ACCESS_S]; #define UAF$B_PRIMEDAYS 514 #define UAF$V_MONDAY 0 #define UAF$V_TUESDAY 1 #define UAF$V_WEDNESDAY 2 #define UAF$V_THURSDAY 3 #define UAF$V_FRIDAY 4 #define UAF$V_SATURDAY 5 #define UAF$V_SUNDAY 6 union { unsigned char uaf_b_primedays; #define uaf$b_primedays uaf_u_primedays.uaf_b_primedays unsigned char uaf_v_monday : 1, #define uaf$v_monday uaf_u_primedays.uaf_v_monday uaf_v_tuesday : 1, #define uaf$v_tuesday uaf_u_primedays.uaf_v_tuesday uaf_v_wednesday : 1, #define uaf$v_wednesday uaf_u_primedays.uaf_v_wednesday uaf_v_thursday : 1, #define uaf$v_thursday uaf_u_primedays.uaf_v_thursday uaf_v_friday : 1, #define uaf$v_friday uaf_u_primedays.uaf_v_friday uaf_v_saturday : 1, #define uaf$v_saturday uaf_u_primedays.uaf_v_saturday uav_v_sunday : 1; #define uaf$v_sunday uaf_u_primedays.uaf_v_sunday } uaf_u_primedays; #define UAF$B_PRI 516 char uaf$b_pri; #define UAF$B_QUEPRI 517 char uaf$b_quepri; #define UAF$W_MAXJOBS 518 short uaf$w_maxjobs; #define UAF$W_MAXACCTJOBS 520 short uaf$w_maxacctjobs; #define UAF$W_MAXDETACH 522 short uaf$w_maxdetach; #define UAF$W_PRCCNT 524 short uaf$w_prccnt; #define UAF$W_BIOLM 526 short uaf$w_biolm; #define UAF$W_DIOLM 528 short uaf$w_diolm; #define UAF$W_TQCNT 530 short uaf$w_twcnt; #define UAF$W_ASTLM 532 short uaf$w_astlm; #define UAF$W_ENQLM 534 short uaf$w_enqlm; #define UAF$W_FILLM 536 short uaf$w_fillm; #define UAF$W_SHRFILLM 538 short uaf$w_shrfillm; #define UAF$L_WSQUOTA 540 long uaf$l_wsquota; #define UAF$L_DFWSCNT 544 long uaf$l_dfwscnt; #define UAF$L_WSEXTENT 548 long uaf$l_wsextent; #define UAF$L_PGFLQUOTA 552 long uaf$l_pgflquota; #define UAF$L_CPUTIM 556 long uaf$l_cputim; #define UAF$L_BYTLM 560 long uaf$l_bytlm; #define UAF$L_PBYTLM 564 long uaf$l_pbytlm; #define UAF$L_JTQUOTA 568 long uaf$l_jtquota; #define UAF$W_PROXY_LIM 572 short uaf$w_proxy_lim; #define UAF$W_PROXIES 574 short uaf$w_proxies; #define UAF$W_ACCOUNT_LIM 576 short uaf$w_account_lim; #define UAF$W_ACCOUNTS 578 short uaf$w_accounts; char uaf$b_fixed[UAF$C_FIXED - UAF$W_ACCOUNTS + 2]; char uaf$b_usrdata[UAF$C_LENGTH - UAF$C_FIXED]; }; #endif /* not UAF$K_LENGTH */ emacs-19.30/src/syswait.h100444 75424 12 5637 5741116536 13652 0ustar kwzhstaff/* Define wait system call interface for Emacs. Copyright (C) 1993, 1994, 1995 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. */ /* Define the structure that the wait system call stores. On many systems, there is a structure defined for this. But on vanilla-ish USG systems there is not. */ #ifndef VMS #ifndef WAITTYPE #ifdef WAIT_USE_INT /* Some systems have union wait in their header, but we should use int regardless of that. */ #include #define WAITTYPE int #define WRETCODE(w) WEXITSTATUS (w) #else /* not WAIT_USE_INT */ #if (!defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE) && !(defined (HPUX) && !defined (NOMULTIPLEJOBS)) && !defined (HAVE_WAIT_HEADER)) || defined (LINUX) #define WAITTYPE int #define WIFSTOPPED(w) ((w&0377) == 0177) #define WIFSIGNALED(w) ((w&0377) != 0177 && (w&~0377) == 0) #define WIFEXITED(w) ((w&0377) == 0) #define WRETCODE(w) (w >> 8) #define WSTOPSIG(w) (w >> 8) #define WTERMSIG(w) (w & 0377) #ifndef WCOREDUMP #define WCOREDUMP(w) ((w&0200) != 0) #endif #else #ifdef BSD4_1 #include #else #include #endif /* not BSD 4.1 */ #define WAITTYPE union wait #define WRETCODE(w) w.w_retcode #undef WCOREDUMP /* Later BSDs define this name differently. */ #define WCOREDUMP(w) w.w_coredump #if defined (HPUX) || defined (convex) /* HPUX version 7 has broken definitions of these. */ /* pvogel@convex.com says the convex does too. */ #undef WTERMSIG #undef WSTOPSIG #undef WIFSTOPPED #undef WIFSIGNALED #undef WIFEXITED #endif /* HPUX | convex */ #ifndef WTERMSIG #define WTERMSIG(w) w.w_termsig #endif #ifndef WSTOPSIG #define WSTOPSIG(w) w.w_stopsig #endif #ifndef WIFSTOPPED #define WIFSTOPPED(w) (WTERMSIG (w) == 0177) #endif #ifndef WIFSIGNALED #define WIFSIGNALED(w) (WTERMSIG (w) != 0177 && (WSTOPSIG (w)) == 0) #endif #ifndef WIFEXITED #define WIFEXITED(w) (WTERMSIG (w) == 0) #endif #endif /* BSD or UNIPLUS or STRIDE */ #endif /* not WAIT_USE_INT */ #endif /* no WAITTYPE */ #else /* VMS */ #define WAITTYPE int #define WIFSTOPPED(w) 0 #define WIFSIGNALED(w) 0 #define WIFEXITED(w) ((w) != -1) #define WRETCODE(w) (w) #define WSTOPSIG(w) (w) #define WCOREDUMP(w) 0 #define WTERMSIG(w) (w) #include #include #include #include "vmsproc.h" #endif /* VMS */ emacs-19.30/src/termchar.h100444 75424 1 3777 5770115152 14070 0ustar kwzhdaemon/* Flags and parameters describing terminal's characteristics. 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 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. */ extern int baud_rate; /* Output speed in baud */ extern int must_write_spaces; /* Nonzero means spaces in the text must actually be output; can't just skip over some columns to leave them blank. */ extern int min_padding_speed; /* Speed below which no padding necessary */ extern int fast_clear_end_of_line; /* Nonzero means terminal has command for this */ extern int line_ins_del_ok; /* Terminal can insert and delete lines */ extern int char_ins_del_ok; /* Terminal can insert and delete chars */ extern int scroll_region_ok; /* Terminal supports setting the scroll window */ extern int scroll_region_cost; /* Cost of setting the scroll window, measured in characters */ extern int memory_below_frame; /* Terminal remembers lines scrolled off bottom */ extern int fast_clear_end_of_line; /* Terminal has a `ce' string */ extern int dont_calculate_costs; /* Nonzero means don't bother computing various cost tables; we won't use them. */ /* Nonzero means no need to redraw the entire frame on resuming a suspended Emacs. This is useful on terminals with multiple pages, where one page is used for Emacs and another for all else. */ extern int no_redraw_on_reenter; emacs-19.30/src/termhooks.h100444 12120 1 33074 6004376233 14105 0ustar rmsdaemon/* Hooks by which low level terminal operations can be made to call other routines. Copyright (C) 1985, 1986, 1993, 1994 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. */ /* Miscellanea. */ /* If nonzero, send all terminal output characters to this stream also. */ extern FILE *termscript; /* Text display hooks. */ extern int (*cursor_to_hook) (); extern int (*raw_cursor_to_hook) (); extern int (*clear_to_end_hook) (); extern int (*clear_frame_hook) (); extern int (*clear_end_of_line_hook) (); extern int (*ins_del_lines_hook) (); extern int (*change_line_highlight_hook) (); extern int (*reassert_line_highlight_hook) (); extern int (*insert_glyphs_hook) (); extern int (*write_glyphs_hook) (); extern int (*delete_glyphs_hook) (); extern int (*ring_bell_hook) (); extern int (*reset_terminal_modes_hook) (); extern int (*set_terminal_modes_hook) (); extern int (*update_begin_hook) (); extern int (*update_end_hook) (); extern int (*set_terminal_window_hook) (); /* Multi-frame and mouse support hooks. */ enum scroll_bar_part { scroll_bar_above_handle, scroll_bar_handle, scroll_bar_below_handle }; /* Return the current position of the mouse. Set *f to the frame the mouse is in, or zero if the mouse is in no Emacs frame. If it is set to zero, all the other arguments are garbage. If the motion started in a scroll bar, set *bar_window to the scroll bar's window, *part to the part the mouse is currently over, *x to the position of the mouse along the scroll bar, and *y to the overall length of the scroll bar. Otherwise, set *bar_window to Qnil, and *x and *y to the column and row of the character cell the mouse is over. Set *time to the time the mouse was at the returned position. This should clear mouse_moved until the next motion event arrives. */ extern void (*mouse_position_hook) ( /* FRAME_PTR *f, Lisp_Object *bar_window, enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y, unsigned long *time */ ); /* The window system handling code should set this if the mouse has moved since the last call to the mouse_position_hook. Calling that hook should clear this. */ extern int mouse_moved; /* When a frame's focus redirection is changed, this hook tells the window system code to re-decide where to put the highlight. Under X, this means that Emacs lies about where the focus is. */ extern void (*frame_rehighlight_hook) ( /* void */ ); /* If we're displaying frames using a window system that can stack frames on top of each other, this hook allows you to bring a frame to the front, or bury it behind all the other windows. If this hook is zero, that means the device we're displaying on doesn't support overlapping frames, so there's no need to raise or lower anything. If RAISE is non-zero, F is brought to the front, before all other windows. If RAISE is zero, F is sent to the back, behind all other windows. */ extern void (*frame_raise_lower_hook) ( /* FRAME_PTR f, int raise */ ); /* Scroll bar hooks. */ /* The representation of scroll bars is determined by the code which implements them, except for one thing: they must be represented by lisp objects. This allows us to place references to them in Lisp_Windows without worrying about those references becoming dangling references when the scroll bar is destroyed. The window-system-independent portion of Emacs just refers to scroll bars via their windows, and never looks inside the scroll bar representation; it always uses hook functions to do all the scroll bar manipulation it needs. The `vertical_scroll_bar' field of a Lisp_Window refers to that window's scroll bar, or is nil if the window doesn't have a scroll bar. The `scroll_bars' and `condemned_scroll_bars' fields of a Lisp_Frame are free for use by the scroll bar implementation in any way it sees fit. They are marked by the garbage collector. */ /* Set the vertical scroll bar for WINDOW to have its upper left corner at (TOP, LEFT), and be LENGTH rows high. Set its handle to indicate that we are displaying PORTION characters out of a total of WHOLE characters, starting at POSITION. If WINDOW doesn't yet have a scroll bar, create one for it. */ extern void (*set_vertical_scroll_bar_hook) ( /* struct window *window, int portion, int whole, int position */ ); /* The following three hooks are used when we're doing a thorough redisplay of the frame. We don't explicitly know which scroll bars are going to be deleted, because keeping track of when windows go away is a real pain - can you say set-window-configuration? Instead, we just assert at the beginning of redisplay that *all* scroll bars are to be removed, and then save scroll bars from the firey pit when we actually redisplay their window. */ /* Arrange for all scroll bars on FRAME to be removed at the next call to `*judge_scroll_bars_hook'. A scroll bar may be spared if `*redeem_scroll_bar_hook' is applied to its window before the judgement. This should be applied to each frame each time its window tree is redisplayed, even if it is not displaying scroll bars at the moment; if the HAS_SCROLL_BARS flag has just been turned off, only calling this and the judge_scroll_bars_hook will get rid of them. If non-zero, this hook should be safe to apply to any frame, whether or not it can support scroll bars, and whether or not it is currently displaying them. */ extern void (*condemn_scroll_bars_hook)( /* FRAME_PTR *frame */ ); /* Unmark WINDOW's scroll bar for deletion in this judgement cycle. Note that it's okay to redeem a scroll bar that is not condemned. */ extern void (*redeem_scroll_bar_hook)( /* struct window *window */ ); /* Remove all scroll bars on FRAME that haven't been saved since the last call to `*condemn_scroll_bars_hook'. This should be applied to each frame after each time its window tree is redisplayed, even if it is not displaying scroll bars at the moment; if the HAS_SCROLL_BARS flag has just been turned off, only calling this and condemn_scroll_bars_hook will get rid of them. If non-zero, this hook should be safe to apply to any frame, whether or not it can support scroll bars, and whether or not it is currently displaying them. */ extern void (*judge_scroll_bars_hook)( /* FRAME_PTR *FRAME */ ); /* Input queue declarations and hooks. */ /* Called to read input events. */ extern int (*read_socket_hook) (); /* Called when a frame's display becomes entirely up to date. */ extern int (*frame_up_to_date_hook) (); /* Expedient hack: only provide the below definitions to files that are prepared to handle lispy things. CONSP is defined iff lisp.h has been included before this file. */ #ifdef CONSP enum event_kind { no_event, /* nothing happened. This should never actually appear in the event queue. */ ascii_keystroke, /* The ASCII code is in .code, perhaps with modifiers applied. .modifiers holds the state of the modifier keys. .frame_or_window is the frame in which the key was typed. .timestamp gives a timestamp (in milliseconds) for the keystroke. */ non_ascii_keystroke, /* .code is a number identifying the function key. A code N represents a key whose name is function_key_names[N]; function_key_names is a table in keyboard.c to which you should feel free to add missing keys. .modifiers holds the state of the modifier keys. .frame_or_window is the frame in which the key was typed. .timestamp gives a timestamp (in milliseconds) for the keystroke. */ mouse_click, /* The button number is in .code; it must be >= 0 and < NUM_MOUSE_BUTTONS, defined below. .modifiers holds the state of the modifier keys. .x and .y give the mouse position, in characters, within the window. .frame_or_window gives the frame the mouse click occurred in. .timestamp gives a timestamp (in milliseconds) for the click. */ scroll_bar_click, /* .code gives the number of the mouse button that was clicked. .modifiers holds the state of the modifier keys. .part is a lisp symbol indicating which part of the scroll bar got clicked. .x gives the distance from the start of the scroll bar of the click; .y gives the total length of the scroll bar. .frame_or_window gives the window whose scroll bar was clicked in. .timestamp gives a timestamp (in milliseconds) for the click. */ selection_request_event, /* Another X client wants a selection from us. See `struct selection_event'. */ selection_clear_event, /* Another X client cleared our selection. */ buffer_switch_event, /* A process filter has switched buffers. */ delete_window_event, /* An X client said "delete this window". */ menu_bar_event, /* An event generated by the menu bar. The frame_or_window field's cdr holds the Lisp-level event value. (Only the toolkit version uses these.) */ iconify_event, /* An X client iconified this window. */ deiconify_event, /* An X client deiconified this window. */ menu_bar_activate_event /* A button press in the menu bar (toolkit version only). */ }; /* If a struct input_event has a kind which is selection_request_event or selection_clear_event, then its contents are really described by `struct selection_event'; see xterm.h. */ /* The keyboard input buffer is an array of these structures. Each one represents some sort of input event - a keystroke, a mouse click, or a window system event. These get turned into their lispy forms when they are removed from the event queue. */ struct input_event { /* What kind of event was this? */ enum event_kind kind; /* For an ascii_keystroke, this is the character. For a non_ascii_keystroke, this is the keysym code. For a mouse event, this is the button number. */ int code; enum scroll_bar_part part; /* This field is copied into a vector while the event is in the queue, so that garbage collections won't kill it. */ /* In a menu_bar_event, this is a cons cell whose car is the frame and whose cdr is the Lisp object that is the event's value. */ Lisp_Object frame_or_window; int modifiers; /* See enum below for interpretation. */ Lisp_Object x, y; unsigned long timestamp; }; /* This is used in keyboard.c, to tell how many buttons we will need to track the positions of. */ #define NUM_MOUSE_BUTTONS (5) /* Bits in the modifiers member of the input_event structure. Note that reorder_modifiers assumes that the bits are in canonical order. The modifiers applied to mouse clicks are rather ornate. The window-system-specific code should store mouse clicks with up_modifier or down_modifier set. Having an explicit down modifier simplifies some of window-system-independent code; without it, the code would have to recognize down events by checking if the event is a mouse click lacking the click and drag modifiers. The window-system independent code turns all up_modifier events bits into drag_modifier, click_modifier, double_modifier, or triple_modifier events. The click_modifier has no written representation in the names of the symbols used as event heads, but it does appear in the Qevent_symbol_components property of the event heads. */ enum { up_modifier = 1, /* Only used on mouse buttons - always turned into a click or a drag modifier before lisp code sees the event. */ down_modifier = 2, /* Only used on mouse buttons. */ drag_modifier = 4, /* This is never used in the event queue; it's only used internally by the window-system-independent code. */ click_modifier= 8, /* See drag_modifier. */ double_modifier= 16, /* See drag_modifier. */ triple_modifier= 32, /* See drag_modifier. */ /* The next four modifier bits are used also in keyboard events at the Lisp level. It's probably not the greatest idea to use the 2^23 bit for any modifier. It may or may not be the sign bit, depending on VALBITS, so using it to represent a modifier key means that characters thus modified have different integer equivalents depending on the architecture they're running on. Oh, and applying XINT to a character whose 2^23 bit is set sign-extends it, so you get a bunch of bits in the mask you didn't want. The CHAR_ macros are defined in lisp.h. */ alt_modifier = CHAR_ALT, /* Under X, the XK_Alt_[LR] keysyms. */ super_modifier= CHAR_SUPER, /* Under X, the XK_Super_[LR] keysyms. */ hyper_modifier= CHAR_HYPER, /* Under X, the XK_Hyper_[LR] keysyms. */ shift_modifier= CHAR_SHIFT, ctrl_modifier = CHAR_CTL, meta_modifier = CHAR_META /* Under X, the XK_Meta_[LR] keysyms. */ }; #endif emacs-19.30/src/termopts.h100444 75424 1 2662 5770115152 14130 0ustar kwzhdaemon/* Flags and parameters describing user options for handling the terminal. Copyright (C) 1985, 1986, 1990 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. */ /* Nonzero means flash the screen instead of ringing the bell. */ extern int visible_bell; /* Nonzero means invert white and black for the entire screen. */ extern int inverse_video; /* Nonzero means use ^S/^Q as cretinous flow control. */ extern int flow_control; /* Nonzero means use interrupt-driven input. */ extern int interrupt_input; /* Nonzero while interrupts are temporarily deferred during redisplay. */ extern int interrupts_deferred; /* Terminal has meta key */ extern int meta_key; /* Nonzero means truncate lines in all windows less wide than the frame */ extern int truncate_partial_width_windows; emacs-19.30/src/vlimit.h100444 12241 12 106 5444474637 13706 0ustar rolandstaff/* Dummy for Emacs so that we can run on VMS... */ #define LIM_DATA 0 emacs-19.30/src/vms-pwd.h100444 75424 1 2162 5770115153 13644 0ustar kwzhdaemon/* GNU Emacs password definition file. Copyright (C) 1986 Free Software Foundation. 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. */ #ifdef VMS /* On VMS, we read the UAF file and emulate some of the necessary fields for Emacs. */ #include "uaf.h" struct passwd { char pw_name[UAF$S_USERNAME+1]; char pw_passwd[UAF$S_PWD]; short pw_uid; short pw_gid; char pw_gecos[UAF$S_OWNER+1]; char pw_dir[UAF$S_DEFDEV+UAF$S_DEFDIR+1]; char pw_shell[UAF$S_DEFCLI+1]; }; #endif /* VMS */ emacs-19.30/src/vmsdir.h100444 75424 1 5402 5770115154 13554 0ustar kwzhdaemon/* GNU Emacs VMS directory definition file. Copyright (C) 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 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. */ /* * Files-11 Ver. 2 directory structure (VMS V4.x - long names) */ #ifndef DIR$K_LENGTH #define DIR$C_FID 0 #define DIR$C_LINKNAME 1 #define DIR$K_LENGTH 6 #define DIR$C_LENGTH 6 #define DIR$S_DIRDEF 6 #define DIR$W_SIZE 0 #define DIR$W_VERLIMIT 2 #define DIR$B_FLAGS 4 #define DIR$S_TYPE 3 #define DIR$V_TYPE 0 #define DIR$V_NEXTREC 6 #define DIR$V_PREVREC 7 #define DIR$B_NAMECOUNT 5 #define DIR$S_NAME 80 #define DIR$T_NAME 6 #define DIR$K_VERSION 8 #define DIR$C_VERSION 8 #define DIR$S_DIRDEF1 8 #define DIR$W_VERSION 0 #define DIR$S_FID 6 #define DIR$W_FID 2 #define DIR$W_FID_NUM 2 #define DIR$W_FID_SEQ 4 #define DIR$W_FID_RVN 6 #define DIR$B_FID_RVN 6 #define DIR$B_FID_NMX 7 #define DIR$S_DIRDEF2 1 #define DIR$T_LINKNAME 0 typedef struct dir$_name { /* short dir$w_size; /* if you read with RMS, it eats this... */ short dir$w_verlimit; /* maximum number of versions */ union { unsigned char dir_b_flags; #define dir$b_flags dir__b_flags.dir_b_flags struct { unsigned char dir_v_type: DIR$S_TYPE; #define dir$v_type dir__b_flags.dir___b_flags.dir_v_type unsigned char: 3; unsigned char dir_v_nextrec: 1; #define dir$v_nextrec dir__b_flags.dir___b_flags.dir_v_nextrec unsigned char dir_v_prevrec: 1; #define dir$v_prevrec dir__b_flags.dir___b_flags.dir_v_prevrec } dir___b_flags; } dir__b_flags; unsigned char dir$b_namecount; char dir$t_name[]; } dir$_dirdef; /* only the fixed first part */ typedef struct dir$_version { short dir$w_version; short dir$w_fid_num; short dir$w_fid_seq; union { short dir_w_fid_rvn; #define dir$w_fid_rvn dir__w_fid_rvn.dir_w_fid_rvn struct { char dir_b_fid_rvn; #define dir$b_fid_rvn dir__w_fid_rvn.dir___w_fid_rvn.dir_b_fid_rvn char dir_b_fid_nmx; #define dir$b_fid_nmx dir__w_fid_rvn.dir___w_fid_rvn.dir_b_fid_nmx } dir___w_fid_rvn; } dir__w_fid_rvn; } dir$_dirdef1; /* one for each version of the file */ typedef struct dir$_linkname { char dir$t_linkname[]; } dir$_dirdef2; #endif emacs-19.30/src/vmspaths.h100444 12241 12 2626 5444474644 14276 0ustar rolandstaff/* Hey Emacs, this is -*- C -*- code! */ /* The default search path for Lisp function "load". This sets load-path. */ #define PATH_LOADSEARCH "EMACS_LIBRARY:[LOCAL-LISP],EMACS_LIBRARY:[LISP]" /* Like PATH_LOADSEARCH, but used only when Emacs is dumping. This path is usually identical to PATH_LOADSEARCH except that the entry for the directory containing the installed lisp files has been replaced with ../lisp. */ #define PATH_DUMPLOADSEARCH "[-.LISP]" /* The extra search path for programs to invoke. This is appended to whatever the PATH environment variable says to set the Lisp variable exec-path and the first file name in it sets the Lisp variable exec-directory. exec-directory is used for finding executables and other architecture-dependent files. */ #define PATH_EXEC "EMACS_LIBRARY:[LIB-SRC]" /* Where Emacs should look for its architecture-independent data files, like the docstring file. The lisp variable data-directory is set to this value. */ #define PATH_DATA "EMACS_LIBRARY:[ETC]" /* the name of the directory that contains lock files with which we record what files are being modified in Emacs. This directory should be writable by everyone. */ #define PATH_LOCK "EMACS_LIBRARY:[LOCK]" /* the name of the file !!!SuperLock!!! in the directory specified by PATH_LOCK. Yes, this is redundant. */ #define PATH_SUPERLOCK "EMACS_LIBRARY:[LOCK]$$$SUPERLOCK$$$." emacs-19.30/src/vmsproc.h100444 12241 12 647 5444474645 14104 0ustar rolandstaff/* Structure for storing VMS specific information for an EMACS process We use the event flags 1-23 for processes, keyboard input and timer */ /* Same as MAXDESC in process.c */ #define MAX_EVENT_FLAGS 23 typedef struct { char inputBuffer[1024]; short inputChan; short outputChan; short busy; int pid; int eventFlag; int exitStatus; short iosb[4]; } VMS_PROC_STUFF; emacs-19.30/src/vmstime.h100444 12241 12 2025 5444474646 14110 0ustar rolandstaff/* Interface to time support for VMS. Copyright (C) 1993 Free Software Foundation. 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. */ #ifndef vmstime_h #define vmstime_h #include #include extern long timezone; extern int daylight; extern char *tzname[2]; void sys_tzset(); struct tm *sys_localtime(time_t *clock); struct tm *sys_gmtime(time_t *clock); #endif /* vmstime_h */ emacs-19.30/src/w32term.h100444 23073 1 52066 6052165201 14250 0ustar voelkerdaemon/* Definitions and headers for communication with Win32 GUI. Copyright (C) 1995 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. */ /* Added by Kevin Gallo */ #include /* The class of this X application. */ #define EMACS_CLASS "Emacs" #define BLACK_PIX_DEFAULT(f) RGB(0,0,0) #define WHITE_PIX_DEFAULT(f) RGB(255,255,255) #define FONT_WIDTH(f) ((f)->tm.tmMaxCharWidth) #define FONT_HEIGHT(f) ((f)->tm.tmHeight) #define FONT_BASE(f) ((f)->tm.tmAscent) #define CHECK_WIN32_FRAME(f, frame) \ if (NILP (frame)) \ f = selected_frame; \ else \ { \ CHECK_LIVE_FRAME (frame, 0); \ f = XFRAME (frame); \ } \ if (! FRAME_WIN32_P (f)) /* Indicates whether we are in the readsocket call and the message we are processing in the current loop */ extern MSG CurMsg; extern BOOL bUseDflt; extern struct frame *x_window_to_frame (); enum text_cursor_kinds { filled_box_cursor, hollow_box_cursor, bar_cursor }; /* This data type is used for the font_table field of struct win32_display_info. */ struct font_info { XFontStruct *font; char *name; }; /* Structure recording bitmaps and reference count. If REFCOUNT is 0 then this record is free to be reused. */ struct win32_bitmap_record { Pixmap pixmap; char *file; HINSTANCE hinst; /* Used to load the file */ int refcount; /* Record some info about this pixmap. */ int height, width, depth; }; /* For each display (currently only one on win32), we have a structure that records information about it. */ struct win32_display_info { /* Chain of all win32_display_info structures. */ struct win32_display_info *next; /* This is a cons cell of the form (NAME . FONT-LIST-CACHE). The same cons cell also appears in x_display_name_list. */ Lisp_Object name_list_element; /* Number of frames that are on this display. */ int reference_count; /* Number of planes on this screen. */ int n_planes; /* Number of bits per pixel on this screen. */ int n_cbits; /* Dimensions of this screen. */ int height, width; int height_in,width_in; /* Mask of things that cause the mouse to be grabbed. */ int grabbed; /* The root window of this screen. */ Window root_window; /* The cursor to use for vertical scroll bars. */ Cursor vertical_scroll_bar_cursor; /* A table of all the fonts we have already loaded. */ struct font_info *font_table; /* The current capacity of x_font_table. */ int font_table_size; /* These variables describe the range of text currently shown in its mouse-face, together with the window they apply to. As long as the mouse stays within this range, we need not redraw anything on its account. */ int mouse_face_beg_row, mouse_face_beg_col; int mouse_face_end_row, mouse_face_end_col; int mouse_face_past_end; Lisp_Object mouse_face_window; int mouse_face_face_id; /* 1 if a mouse motion event came and we didn't handle it right away because gc was in progress. */ int mouse_face_deferred_gc; /* FRAME and X, Y position of mouse when last checked for highlighting. X and Y can be negative or out of range for the frame. */ struct frame *mouse_face_mouse_frame; int mouse_face_mouse_x, mouse_face_mouse_y; /* Nonzero means defer mouse-motion highlighting. */ int mouse_face_defer; char *win32_id_name; /* The number of fonts actually stored in win32_font_table. font_table[n] is used and valid iff 0 <= n < n_fonts. 0 <= n_fonts <= font_table_size. */ int n_fonts; /* Pointer to bitmap records. */ struct win32_bitmap_record *bitmaps; /* Allocated size of bitmaps field. */ int bitmaps_size; /* Last used bitmap index. */ int bitmaps_last; /* The frame (if any) which has the window that has keyboard focus. Zero if none. This is examined by Ffocus_frame in w32fns.c. Note that a mere EnterNotify event can set this; if you need to know the last frame specified in a FocusIn or FocusOut event, use win32_focus_event_frame. */ struct frame *win32_focus_frame; /* The last frame mentioned in a FocusIn or FocusOut event. This is separate from win32_focus_frame, because whether or not LeaveNotify events cause us to lose focus depends on whether or not we have received a FocusIn event for it. */ struct frame *win32_focus_event_frame; /* The frame which currently has the visual highlight, and should get keyboard input (other sorts of input have the frame encoded in the event). It points to the focus frame's selected window's frame. It differs from win32_focus_frame when we're using a global minibuffer. */ struct frame *win32_highlight_frame; }; /* This is a chain of structures for all the displays currently in use. */ extern struct win32_display_info one_win32_display_info; /* This is a list of cons cells, each of the form (NAME . FONT-LIST-CACHE), one for each element of win32_display_list and in the same order. NAME is the name of the frame. FONT-LIST-CACHE records previous values returned by x-list-fonts. */ extern Lisp_Object win32_display_name_list; extern struct win32_display_info *x_display_info_for_display (); extern struct win32_display_info *x_display_info_for_name (); extern struct win32_display_info *win32_term_init (); /* Each Win32 frame object points to its own struct win32_display object in the output_data.win32 field. The win32_display structure contains all the information that is specific to Win32 windows. */ struct win32_output { /* Position of the Win32 window (x and y offsets in root window). */ int left_pos; int top_pos; /* Border width of the Win32 window as known by the window system. */ int border_width; /* Size of the Win32 window in pixels. */ int pixel_height, pixel_width; /* Height of a line, in pixels. */ int line_height; /* Width of the internal border. This is a line of background color just inside the window's border. When the frame is selected, a highlighting is displayed inside the internal border. */ int internal_border_width; /* The window used for this frame. May be zero while the frame object is being created and the window has not yet been created. */ Window window_desc; /* The window that is the parent of this window. Usually this is a window that was made by the window manager, but it can be the root window, and it can be explicitly specified (see the explicit_parent field, below). */ Window parent_desc; XFontStruct *font; /* Pixel values used for various purposes. border_pixel may be -1 meaning use a gray tile. */ unsigned long background_pixel; unsigned long foreground_pixel; unsigned long cursor_pixel; unsigned long border_pixel; unsigned long mouse_pixel; unsigned long cursor_foreground_pixel; /* Descriptor for the cursor in use for this window. */ Cursor text_cursor; Cursor nontext_cursor; Cursor modeline_cursor; Cursor cross_cursor; /* Flag to set when the window needs to be completely repainted. */ int needs_exposure; /* What kind of text cursor is drawn in this window right now? (If there is no cursor (phys_cursor_x < 0), then this means nothing.) */ enum text_cursor_kinds current_cursor; /* What kind of text cursor should we draw in the future? This should always be filled_box_cursor or bar_cursor. */ enum text_cursor_kinds desired_cursor; /* Width of bar cursor (if we are using that). */ int cursor_width; DWORD dwStyle; /* The size of the extra width currently allotted for vertical scroll bars, in pixels. */ int vertical_scroll_bar_extra; /* Table of parameter faces for this frame. Any resources (pixel values, fonts) referred to here have been allocated explicitly for this face, and should be freed if we change the face. */ struct face **param_faces; int n_param_faces; /* Table of computed faces for this frame. These are the faces whose indexes go into the upper bits of a glyph, computed by combining the parameter faces specified by overlays, text properties, and what have you. The resources mentioned here are all shared with parameter faces. */ struct face **computed_faces; int n_computed_faces; /* How many are valid */ int size_computed_faces; /* How many are allocated */ /* This is the gravity value for the specified window position. */ int win_gravity; /* The geometry flags for this window. */ int size_hint_flags; /* This is the Emacs structure for the display this frame is on. */ /* struct win32_display_info *display_info; */ /* Nonzero means our parent is another application's window and was explicitly specified. */ char explicit_parent; /* Nonzero means tried already to make this frame visible. */ char asked_for_visible; }; /* Get at the computed faces of an X window frame. */ #define FRAME_PARAM_FACES(f) ((f)->output_data.win32->param_faces) #define FRAME_N_PARAM_FACES(f) ((f)->output_data.win32->n_param_faces) #define FRAME_DEFAULT_PARAM_FACE(f) (FRAME_PARAM_FACES (f)[0]) #define FRAME_MODE_LINE_PARAM_FACE(f) (FRAME_PARAM_FACES (f)[1]) #define FRAME_COMPUTED_FACES(f) ((f)->output_data.win32->computed_faces) #define FRAME_N_COMPUTED_FACES(f) ((f)->output_data.win32->n_computed_faces) #define FRAME_SIZE_COMPUTED_FACES(f) ((f)->output_data.win32->size_computed_faces) #define FRAME_DEFAULT_FACE(f) ((f)->output_data.win32->computed_faces[0]) #define FRAME_MODE_LINE_FACE(f) ((f)->output_data.win32->computed_faces[1]) /* Return the window associated with the frame F. */ #define FRAME_WIN32_WINDOW(f) ((f)->output_data.win32->window_desc) #define FRAME_FOREGROUND_PIXEL(f) ((f)->output_data.win32->foreground_pixel) #define FRAME_BACKGROUND_PIXEL(f) ((f)->output_data.win32->background_pixel) #define FRAME_FONT(f) ((f)->output_data.win32->font) #define FRAME_INTERNAL_BORDER_WIDTH(f) ((f)->output_data.win32->internal_border_width) /* This gives the win32_display_info structure for the display F is on. */ #define FRAME_WIN32_DISPLAY_INFO(f) (&one_win32_display_info) /* These two really ought to be called FRAME_PIXEL_{WIDTH,HEIGHT}. */ #define PIXEL_WIDTH(f) ((f)->output_data.win32->pixel_width) #define PIXEL_HEIGHT(f) ((f)->output_data.win32->pixel_height) #define FRAME_LINE_HEIGHT(f) ((f)->output_data.win32->line_height) #define FRAME_DESIRED_CURSOR(f) ((f)->output_data.win32->desired_cursor) /* Win32-specific scroll bar stuff. */ /* We represent scroll bars as lisp vectors. This allows us to place references to them in windows without worrying about whether we'll end up with windows referring to dead scroll bars; the garbage collector will free it when its time comes. We use struct scroll_bar as a template for accessing fields of the vector. */ struct scroll_bar { /* These fields are shared by all vectors. */ EMACS_INT size_from_Lisp_Vector_struct; struct Lisp_Vector *next_from_Lisp_Vector_struct; /* The window we're a scroll bar for. */ Lisp_Object window; /* The next and previous in the chain of scroll bars in this frame. */ Lisp_Object next, prev; /* The window representing this scroll bar. Since this is a full 32-bit quantity, we store it split into two 32-bit values. */ Lisp_Object win32_window_low, win32_window_high; /* The position and size of the scroll bar in pixels, relative to the frame. */ Lisp_Object top, left, width, height; /* The starting and ending positions of the handle, relative to the handle area (i.e. zero is the top position, not SCROLL_BAR_TOP_BORDER). If they're equal, that means the handle hasn't been drawn yet. These are not actually the locations where the beginning and end are drawn; in order to keep handles from becoming invisible when editing large files, we establish a minimum height by always drawing handle bottoms VERTICAL_SCROLL_BAR_MIN_HANDLE pixels below where they would be normally; the bottom and top are in a different co-ordinate system. */ Lisp_Object start, end; /* If the scroll bar handle is currently being dragged by the user, this is the number of pixels from the top of the handle to the place where the user grabbed it. If the handle isn't currently being dragged, this is Qnil. */ Lisp_Object dragging; }; /* The number of elements a vector holding a struct scroll_bar needs. */ #define SCROLL_BAR_VEC_SIZE \ ((sizeof (struct scroll_bar) \ - sizeof (EMACS_INT) - sizeof (struct Lisp_Vector *)) \ / sizeof (Lisp_Object)) /* Turning a lisp vector value into a pointer to a struct scroll_bar. */ #define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec)) /* Building a 32-bit C integer from two 16-bit lisp integers. */ #define SCROLL_BAR_PACK(low, high) (XINT (high) << 16 | XINT (low)) /* Setting two lisp integers to the low and high words of a 32-bit C int. */ #define SCROLL_BAR_UNPACK(low, high, int32) \ (XSETINT ((low), (int32) & 0xffff), \ XSETINT ((high), ((int32) >> 16) & 0xffff)) /* Extract the window id of the scroll bar from a struct scroll_bar. */ #define SCROLL_BAR_WIN32_WINDOW(ptr) \ ((Window) SCROLL_BAR_PACK ((ptr)->win32_window_low, (ptr)->win32_window_high)) /* Store a window id in a struct scroll_bar. */ #define SET_SCROLL_BAR_WIN32_WINDOW(ptr, id) \ (SCROLL_BAR_UNPACK ((ptr)->win32_window_low, (ptr)->win32_window_high, (int) id)) /* Return the outside pixel height for a vertical scroll bar HEIGHT rows high on frame F. */ #define VERTICAL_SCROLL_BAR_PIXEL_HEIGHT(f, height) \ ((height) * (f)->output_data.win32->line_height) /* Return the inside width of a vertical scroll bar, given the outside width. */ #define VERTICAL_SCROLL_BAR_INSIDE_WIDTH(width) \ ((width) - VERTICAL_SCROLL_BAR_LEFT_BORDER - VERTICAL_SCROLL_BAR_RIGHT_BORDER) /* Return the length of the rectangle within which the top of the handle must stay. This isn't equivalent to the inside height, because the scroll bar handle has a minimum height. This is the real range of motion for the scroll bar, so when we're scaling buffer positions to scroll bar positions, we use this, not VERTICAL_SCROLL_BAR_INSIDE_HEIGHT. */ #define VERTICAL_SCROLL_BAR_TOP_RANGE(height) \ (VERTICAL_SCROLL_BAR_INSIDE_HEIGHT (height) - VERTICAL_SCROLL_BAR_MIN_HANDLE) /* Return the inside height of vertical scroll bar, given the outside height. See VERTICAL_SCROLL_BAR_TOP_RANGE too. */ #define VERTICAL_SCROLL_BAR_INSIDE_HEIGHT(height) \ ((height) - VERTICAL_SCROLL_BAR_TOP_BORDER - VERTICAL_SCROLL_BAR_BOTTOM_BORDER) /* Border widths for scroll bars. Scroll bar windows don't have any borders; their border width is set to zero, and we redraw borders ourselves. This makes the code a bit cleaner, since we don't have to convert between outside width (used when relating to the rest of the screen) and inside width (used when sizing and drawing the scroll bar window itself). The handle moves up and down/back and forth in a rectangle inset from the edges of the scroll bar. These are widths by which we inset the handle boundaries from the scroll bar edges. */ #define VERTICAL_SCROLL_BAR_LEFT_BORDER (0) #define VERTICAL_SCROLL_BAR_RIGHT_BORDER (0) #define VERTICAL_SCROLL_BAR_TOP_BORDER (0) #define VERTICAL_SCROLL_BAR_BOTTOM_BORDER (0) /* Minimum lengths for scroll bar handles, in pixels. */ #define VERTICAL_SCROLL_BAR_MIN_HANDLE (0) /* Manipulating pixel sizes and character sizes. Knowledge of which factors affect the overall size of the window should be hidden in these macros, if that's possible. Return the upper/left pixel position of the character cell on frame F at ROW/COL. */ #define CHAR_TO_PIXEL_ROW(f, row) \ ((f)->output_data.win32->internal_border_width \ + (row) * (f)->output_data.win32->line_height) #define CHAR_TO_PIXEL_COL(f, col) \ ((f)->output_data.win32->internal_border_width \ + (col) * FONT_WIDTH ((f)->output_data.win32->font)) /* Return the pixel width/height of frame F if it has WIDTH columns/HEIGHT rows. */ #define CHAR_TO_PIXEL_WIDTH(f, width) \ (CHAR_TO_PIXEL_COL (f, width) \ + (f)->output_data.win32->vertical_scroll_bar_extra \ + (f)->output_data.win32->internal_border_width) #define CHAR_TO_PIXEL_HEIGHT(f, height) \ (CHAR_TO_PIXEL_ROW (f, height) \ + (f)->output_data.win32->internal_border_width) /* Return the row/column (zero-based) of the character cell containing the pixel on FRAME at ROW/COL. */ #define PIXEL_TO_CHAR_ROW(f, row) \ (((row) - (f)->output_data.win32->internal_border_width) \ / (f)->output_data.win32->line_height) #define PIXEL_TO_CHAR_COL(f, col) \ (((col) - (f)->output_data.win32->internal_border_width) \ / FONT_WIDTH ((f)->output_data.win32->font)) /* How many columns/rows of text can we fit in WIDTH/HEIGHT pixels on frame F? */ #define PIXEL_TO_CHAR_WIDTH(f, width) \ (PIXEL_TO_CHAR_COL (f, ((width) \ - (f)->output_data.win32->internal_border_width \ - (f)->output_data.win32->vertical_scroll_bar_extra))) #define PIXEL_TO_CHAR_HEIGHT(f, height) \ (PIXEL_TO_CHAR_ROW (f, ((height) \ - (f)->output_data.win32->internal_border_width))) /* Interface to the face code functions. */ /* Create the first two computed faces for a frame -- the ones that have GC's. */ extern void init_frame_faces (/* FRAME_PTR */); /* Free the resources for the faces associated with a frame. */ extern void free_frame_faces (/* FRAME_PTR */); /* Given a computed face, find or make an equivalent display face in face_vector, and return a pointer to it. */ extern struct face *intern_face (/* FRAME_PTR, struct face * */); /* Given a frame and a face name, return the face's ID number, or zero if it isn't a recognized face name. */ extern int face_name_id_number (/* FRAME_PTR, Lisp_Object */); /* Return non-zero if FONT1 and FONT2 have the same size bounding box. We assume that they're both character-cell fonts. */ extern int same_size_fonts (/* XFontStruct *, XFontStruct * */); /* Recompute the GC's for the default and modeline faces. We call this after changing frame parameters on which those GC's depend. */ extern void recompute_basic_faces (/* FRAME_PTR */); /* Return the face ID associated with a buffer position POS. Store into *ENDPTR the next position at which a different face is needed. This does not take account of glyphs that specify their own face codes. F is the frame in use for display, and W is a window displaying the current buffer. REGION_BEG, REGION_END delimit the region, so it can be highlighted. */ extern int compute_char_face (/* FRAME_PTR frame, struct window *w, int pos, int region_beg, int region_end, int *endptr */); /* Return the face ID to use to display a special glyph which selects FACE_CODE as the face ID, assuming that ordinarily the face would be BASIC_FACE. F is the frame. */ extern int compute_glyph_face (/* FRAME_PTR, int */); extern void win32_fill_rect (); extern void win32_clear_window (); #define win32_fill_area(f,hdc,pix,x,y,nx,ny) \ { \ RECT rect; \ rect.left = x; \ rect.top = y; \ rect.right = x + nx; \ rect.bottom = y + ny; \ win32_fill_rect (f,hdc,pix,&rect); \ } #define win32_clear_rect(f,hdc,lprect) \ win32_fill_rect (f,hdc,f->output_data.win32->background_pixel,lprect) #define win32_clear_area(f,hdc,x,y,nx,ny) \ win32_fill_area (f,hdc,f->output_data.win32->background_pixel,x,y,nx,ny) extern XFontStruct *win32_load_font (); extern void win32_unload_font (); extern HDC map_mode(); #define my_get_dc(hwnd) (map_mode (GetDC (hwnd))) #define WM_EMACS_START (WM_USER + 1) #define WM_EMACS_KILL (WM_EMACS_START + 0x00) #define WM_EMACS_CREATEWINDOW (WM_EMACS_START + 0x01) #define WM_EMACS_DONE (WM_EMACS_START + 0x02) #define WM_EMACS_CREATESCROLLBAR (WM_EMACS_START + 0x03) #define WM_EMACS_DESTROYWINDOW (WM_EMACS_START + 0x04) #define WM_EMACS_END (WM_EMACS_START + 0x10) #define WND_X_UNITS_INDEX (0) #define WND_Y_UNITS_INDEX (4) #define WND_BACKGROUND_INDEX (8) #define WND_LAST_INDEX (16) #define WND_EXTRA_BYTES (WND_LAST_INDEX) extern DWORD dwWinThreadId; extern HANDLE hWinThread; extern DWORD dwMainThreadId; extern HANDLE hMainThread; typedef struct Win32Msg { MSG msg; DWORD dwModifiers; RECT rect; } Win32Msg; extern void init_crit (); extern void enter_crit (); extern void leave_crit (); extern void delete_crit (); extern BOOL get_next_msg (); extern BOOL post_msg (); extern void wait_for_sync (); extern BOOL parse_button (); emacs-19.30/src/widget.h100444 22417 1 5253 5643524226 13347 0ustar pmrdaemon/* The emacs frame widget public header file. Copyright (C) 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. */ /* Emacs 19 face widget ported by Fred Pierresteguy */ #ifndef _EmacsFrame_h #define _EmacsFrame_h #define XtNminibuffer "minibuffer" #define XtCMinibuffer "Minibuffer" #define XtNunsplittable "unsplittable" #define XtCUnsplittable "Unsplittable" #define XtNinternalBorderWidth "internalBorderWidth" #define XtCInternalBorderWidth "InternalBorderWidth" #define XtNinterline "interline" #define XtCInterline "Interline" #ifndef XtNfont #define XtNfont "font" #endif #ifndef XtCFont #define XtCFont "Font" #endif #ifndef XtNforeground #define XtNforeground "foreground" #endif #ifndef XtCForeground #define XtCForeground "Foreground" #endif #define XtNcursorColor "cursorColor" #define XtCCursorColor "CursorColor" #define XtNbarCursor "barCursor" #define XtCBarCursor "BarCursor" #define XtNvisualBell "visualBell" #define XtCVisualBell "VisualBell" #define XtCBellVolume "BellVolume" #define XtNbellVolume "bellVolume" #define XtNpointerBackground "pointerBackground" #define XtNpointerColor "pointerColor" #define XtNtextPointer "textPointer" #define XtNspacePointer "spacePointer" #define XtNmodeLinePointer "modePointer" #define XtNgcPointer "gcPointer" #define XtNemacsFrame "emacsFrame" #define XtCEmacsFrame "EmacsFrame" #ifndef XtNgeometry #define XtNgeometry "geometry" #endif #ifndef XtCGeometry #define XtCGeometry "Geometry" #endif #ifndef XtNshowGrip #define XtNshowGrip "showGrip" #endif #ifndef XtNallowResize #define XtNallowResize "allowResize" #endif #ifndef XtNresizeToPreferred #define XtNresizeToPreferred "resizeToPreferred" #endif #define XtNinitialGeometry "initialGeometry" #define XtCInitialGeometry "InitialGeometry" /* structures */ typedef struct _EmacsFrameRec *EmacsFrame; typedef struct _EmacsFrameClassRec *EmacsFrameClass; extern WidgetClass emacsFrameClass; extern struct _DisplayContext* display_context; /* Special entrypoints */ void EmacsFrameSetCharSize (); #endif /* _EmacsFrame_h */ emacs-19.30/src/widgetprv.h100444 12120 1 4464 5632225076 14072 0ustar rmsdaemon/* The emacs frame widget private header file. Copyright (C) 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. */ /* Emacs 19 face widget ported by Fred Pierresteguy */ #ifndef _EmacsFrameP_h #define _EmacsFrameP_h #include #include #include "widget.h" typedef struct { struct frame* frame; /* the *emacs* frame object */ /* Resources that can't be done from lisp. */ char* geometry; /* geometry spec of this frame */ Boolean iconic; /* whether this frame is iconic */ /* The rest of this is crap and should be deleted. */ int minibuffer; /* 0: normal frames with minibuffers. * 1: frames without minibuffers * 2: minibuffer only. */ Boolean unsplittable; /* frame can only have one window */ int internal_border_width; /* internal borders */ int interline; /* skips between lines */ XFontStruct* font; /* font */ Pixel foreground_pixel; /* foreground */ Pixel cursor_color; /* text cursor color */ Boolean bar_cursor; /* 1 if bar, 0 if block */ Boolean visual_bell; /* flash instead of beep */ int bell_volume; /* how loud is beep */ /* private state */ } EmacsFramePart; typedef struct _EmacsFrameRec { /* full instance record */ CorePart core; EmacsFramePart emacs_frame; } EmacsFrameRec; typedef struct { /* new fields for EmacsFrame class */ int dummy; } EmacsFrameClassPart; typedef struct _EmacsFrameClassRec { /* full class record declaration */ CoreClassPart core_class; EmacsFrameClassPart emacs_frame_class; } EmacsFrameClassRec; extern EmacsFrameClassRec emacsFrameClassRec; /* class pointer */ #endif /* _EmacsFrameP_h */ emacs-19.30/src/win32.h100444 23073 1 4642 6047606407 13700 0ustar voelkerdaemon/* Definitions and headers for communication with Win32 GUI. Copyright (C) 1995 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. */ #ifndef __WIN32_H__ #define __WIN32_H__ #include typedef struct W32FontStruct { TEXTMETRIC tm; HFONT hfont; } W32FontStruct; typedef HBITMAP Pixmap; typedef HBITMAP Bitmap; typedef struct W32FontStruct XFontStruct; typedef HDC GC; typedef COLORREF Color; typedef DWORD Time; typedef HWND Window; typedef HCURSOR Cursor; #define FACE_DEFAULT (~0) extern HINSTANCE hinst; extern HINSTANCE hprevinst; extern LPSTR lpCmdLine; extern int nCmdShow; /* Bit Gravity */ #define ForgetGravity 0 #define NorthWestGravity 1 #define NorthGravity 2 #define NorthEastGravity 3 #define WestGravity 4 #define CenterGravity 5 #define EastGravity 6 #define SouthWestGravity 7 #define SouthGravity 8 #define SouthEastGravity 9 #define StaticGravity 10 #define NoValue 0x0000 #define XValue 0x0001 #define YValue 0x0002 #define WidthValue 0x0004 #define HeightValue 0x0008 #define AllValues 0x000F #define XNegative 0x0010 #define YNegative 0x0020 #define USPosition (1L << 0) /* user specified x, y */ #define USSize (1L << 1) /* user specified width, height */ #define PPosition (1L << 2) /* program specified position */ #define PSize (1L << 3) /* program specified size */ #define PMinSize (1L << 4) /* program specified minimum size */ #define PMaxSize (1L << 5) /* program specified maximum size */ #define PResizeInc (1L << 6) /* program specified resize increments */ #define PAspect (1L << 7) /* program specified min and max aspect ratios */ #define PBaseSize (1L << 8) /* program specified base for incrementing */ #define PWinGravity (1L << 9) /* program specified window gravity */ extern int XParseGeometry (); #endif emacs-19.30/src/window.h100444 12120 1 27415 6050674060 13403 0ustar rmsdaemon/* Window definitions for GNU Emacs. Copyright (C) 1985, 1986, 1993, 1995 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. */ /* Windows are allocated as if they were vectors, but then the Lisp data type is changed to Lisp_Window. They are garbage collected along with the vectors. All windows in use are arranged into a tree, with pointers up and down. Windows that are leaves of the tree are actually displayed and show the contents of buffers. Windows that are not leaves are used for representing the way groups of leaf windows are arranged on the frame. Leaf windows never become non-leaves. They are deleted only by calling delete-window on them (but this can be done implicitly). Combination windows can be created and deleted at any time. A leaf window has a non-nil buffer field, and also has markers in its start and pointm fields. Non-leaf windows have nil in these fields. Non-leaf windows are either vertical or horizontal combinations. A vertical combination window has children that are arranged on the frame one above the next. Its vchild field points to the uppermost child. The parent field of each of the children points to the vertical combination window. The next field of each child points to the child below it, or is nil for the lowest child. The prev field of each child points to the child above it, or is nil for the highest child. A horizontal combination window has children that are side by side. Its hchild field points to the leftmost child. In each child the next field points to the child to the right and the prev field points to the child to the left. The children of a vertical combination window may be leaf windows or horizontal combination windows. The children of a horizontal combination window may be leaf windows or vertical combination windows. At the top of the tree are two windows which have nil as parent. The second of these is minibuf_window. The first one manages all the frame area that is not minibuffer, and is called the root window. Different windows can be the root at different times; initially the root window is a leaf window, but if more windows are created then that leaf window ceases to be root and a newly made combination window becomes root instead. In any case, on screens which have an ordinary window and a minibuffer, prev of the minibuf window is the root window and next of the root window is the minibuf window. On minibufferless screens or minibuffer-only screens, the root window and the minibuffer window are one and the same, so its prev and next members are nil. A dead window has its buffer, hchild, and vchild windows all nil. */ struct window { /* The first two fields are really the header of a vector */ /* The window code does not refer to them. */ EMACS_INT size; struct Lisp_Vector *vec_next; /* The frame this window is on. */ Lisp_Object frame; /* t if this window is a minibuffer window. */ Lisp_Object mini_p; /* Following child (to right or down) at same level of tree */ Lisp_Object next; /* Preceding child (to left or up) at same level of tree */ Lisp_Object prev; /* First child of this window. */ /* vchild is used if this is a vertical combination, hchild if this is a horizontal combination. */ Lisp_Object hchild, vchild; /* The window this one is a child of. */ Lisp_Object parent; /* The upper left corner coordinates of this window, as integers relative to upper left corner of frame = 0, 0 */ Lisp_Object left; Lisp_Object top; /* The size of the window */ Lisp_Object height; Lisp_Object width; /* The buffer displayed in this window */ /* Of the fields vchild, hchild and buffer, only one is non-nil. */ Lisp_Object buffer; /* A marker pointing to where in the text to start displaying */ Lisp_Object start; /* A marker pointing to where in the text point is in this window, used only when the window is not selected. This exists so that when multiple windows show one buffer each one can have its own value of point. */ Lisp_Object pointm; /* Non-nil means next redisplay must use the value of start set up for it in advance. Set by scrolling commands. */ Lisp_Object force_start; /* Number of columns display within the window is scrolled to the left. */ Lisp_Object hscroll; /* Number saying how recently window was selected */ Lisp_Object use_time; /* Unique number of window assigned when it was created */ Lisp_Object sequence_number; /* No permanent meaning; used by save-window-excursion's bookkeeping */ Lisp_Object temslot; /* text.modified of displayed buffer as of last time display completed */ Lisp_Object last_modified; /* Value of point at that time */ Lisp_Object last_point; /* This window's vertical scroll bar. This field is only for use by the window-system-dependent code which implements the scroll bars; it can store anything it likes here. If this window is newly created and we haven't displayed a scroll bar in it yet, or if the frame doesn't have any scroll bars, this is nil. */ Lisp_Object vertical_scroll_bar; /* The rest are currently not used or only half used */ /* Frame coords of point at that time */ Lisp_Object last_point_x; Lisp_Object last_point_y; /* Frame coords of mark as of last time display completed */ /* May be nil if mark does not exist or was not on frame */ Lisp_Object last_mark_x; Lisp_Object last_mark_y; /* Number of characters in buffer past bottom of window, as of last redisplay that finished. */ Lisp_Object window_end_pos; /* t if window_end_pos is truly valid. This is nil if nontrivial redisplay is preempted since in that case the frame image that window_end_pos did not get onto the frame. */ Lisp_Object window_end_valid; /* Vertical position (relative to window top) of that buffer position of the first of those characters */ Lisp_Object window_end_vpos; /* Non-nil means must regenerate mode line of this window */ Lisp_Object update_mode_line; /* Non-nil means current value of `start' was the beginning of a line when it was chosen. */ Lisp_Object start_at_line_beg; /* Display-table to use for displaying chars in this window. Nil means use the buffer's own display-table. */ Lisp_Object display_table; /* Non-nil means window is marked as dedicated. */ Lisp_Object dedicated; /* Line number and position of a line somewhere above the top of the screen. */ /* If this field is nil, it means we don't have a base line. */ Lisp_Object base_line_number; /* If this field is nil, it means we don't have a base line. If it is a buffer, it means don't display the line number as long as the window shows that buffer. */ Lisp_Object base_line_pos; /* If we have highlighted the region (or any part of it), this is the mark position that we used, as an integer. */ Lisp_Object region_showing; /* The column number currently displayed in this window's mode line, or nil if column numbers are not being displayed. */ Lisp_Object column_number_displayed; /* If redisplay in this window goes beyond this buffer position, must run the redisplay-end-trigger-hook. */ Lisp_Object redisplay_end_trigger; }; /* 1 if W is a minibuffer window. */ #define MINI_WINDOW_P(W) (!EQ ((W)->mini_p, Qnil)) /* This is the window in which the terminal's cursor should be left when nothing is being done with it. This must always be a leaf window, and its buffer is selected by the top level editing loop at the end of each command. This value is always the same as FRAME_SELECTED_WINDOW (selected_frame). */ extern Lisp_Object selected_window; /* This is a time stamp for window selection, so we can find the least recently used window. Its only users are Fselect_window, init_window_once, and make_frame. */ extern int window_select_count; /* The minibuffer window of the selected frame. Note that you cannot test for minibufferness of an arbitrary window by comparing against this; use the MINI_WINDOW_P macro instead. */ extern Lisp_Object minibuf_window; /* Non-nil => window to for C-M-v to scroll when the minibuffer is selected. */ extern Lisp_Object Vminibuf_scroll_window; /* nil or a symbol naming the window system under which emacs is running ('x is the only current possibility) */ extern Lisp_Object Vwindow_system; /* Version number of X windows: 10, 11 or nil. */ extern Lisp_Object Vwindow_system_version; /* Window that the mouse is over (nil if no mouse support). */ extern Lisp_Object Vmouse_window; /* Last mouse-click event (nil if no mouse support). */ extern Lisp_Object Vmouse_event; extern Lisp_Object Fnext_window (); extern Lisp_Object Fselect_window (); extern Lisp_Object Fdisplay_buffer (); extern Lisp_Object Fset_window_buffer (); extern Lisp_Object make_window (); extern Lisp_Object window_from_coordinates (); extern Lisp_Object Fwindow_dedicated_p (); /* Prompt to display in front of the minibuffer contents. */ extern Lisp_Object minibuf_prompt; /* The visual width of the above. */ extern int minibuf_prompt_width; /* Message to display instead of minibuffer contents. This is what the functions error and message make, and command echoing uses it as well. It overrides the minibuf_prompt as well as the buffer. */ extern char *echo_area_glyphs; /* This is the length of the message in echo_area_glyphs. */ extern int echo_area_glyphs_length; /* Value of echo_area_glyphs when it was last acted on. If this is nonzero, there is a message on the frame in the minibuffer and it should be erased as soon as it is no longer requested to appear. */ extern char *previous_echo_glyphs; /* This is the window where the echo area message was displayed. It is always a minibuffer window, but it may not be the same window currently active as a minibuffer. */ extern Lisp_Object echo_area_window; /* Depth in recursive edits. */ extern int command_loop_level; /* Depth in minibuffer invocations. */ extern int minibuf_level; /* true iff we should redraw the mode lines on the next redisplay. */ extern int update_mode_lines; /* Minimum value of GPT - BEG since last redisplay that finished. */ extern int beg_unchanged; /* Minimum value of Z - GPT since last redisplay that finished. */ extern int end_unchanged; /* MODIFF as of last redisplay that finished; if it matches MODIFF, beg_unchanged and end_unchanged contain no useful information. */ extern int unchanged_modified; /* Nonzero if BEGV - BEG or Z - ZV of current buffer has changed since last redisplay that finished. */ extern int clip_changed; /* Nonzero if window sizes or contents have changed since last redisplay that finished */ extern int windows_or_buffers_changed; /* Number of windows displaying the selected buffer. Normally this is 1, but it can be more. */ extern int buffer_shared; /* If *ROWS or *COLS are too small a size for FRAME, set them to the minimum allowable size. */ extern void check_frame_size ( /* FRAME_PTR frame, int *rows, int *cols */ ); emacs-19.30/src/xterm.h100444 23073 1 67223 6047603213 14111 0ustar voelkerdaemon/* Definitions and headers for communication with X protocol. Copyright (C) 1989, 1993, 1994 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. */ #include #include #include #include #include #include #ifdef USE_X_TOOLKIT #include #include /* CoreP.h needs this */ #include /* foul, but we need this to use our own window inside a widget instead of one that Xt creates... */ #include #endif /* The class of this X application. */ #define EMACS_CLASS "Emacs" /* Bookkeeping to distinguish X versions. */ /* HAVE_X11R4 is defined if we have the features of X11R4. It should be defined when we're using X11R5, since X11R5 has the features of X11R4. If, in the future, we find we need more of these flags (HAVE_X11R5, for example), code should always be written to test the most recent flag first: #ifdef HAVE_X11R5 ... #elif HAVE_X11R4 ... #elif HAVE_X11 ... #endif If you ever find yourself writing a "#ifdef HAVE_FOO" clause that looks a lot like another one, consider moving the text into a macro whose definition is configuration-dependent, but whose usage is universal - like the stuff in systime.h. It turns out that we can auto-detect whether we're being compiled with X11R3 or X11R4 by looking for the flag macros for R4 structure members that R3 doesn't have. */ #ifdef PBaseSize /* AIX 3.1's X is somewhere between X11R3 and X11R4. It has PBaseSize, but not XWithdrawWindow, XSetWMName, XSetWMNormalHints, XSetWMIconName. AIX 3.2 is at least X11R4. */ #if (!defined AIX) || (defined AIX3_2) #define HAVE_X11R4 #endif #endif #ifdef XlibSpecificationRelease #if XlibSpecificationRelease >= 5 #define HAVE_X11R5 /* In case someone has X11R5 on AIX 3.1, make sure HAVE_X11R4 is defined as well as HAVE_X11R5. */ #define HAVE_X11R4 #endif #endif #ifdef HAVE_X11R5 #define HAVE_X_I18N #include #endif #define BLACK_PIX_DEFAULT(f) BlackPixel (FRAME_X_DISPLAY (f), \ XScreenNumberOfScreen (FRAME_X_SCREEN (f))) #define WHITE_PIX_DEFAULT(f) WhitePixel (FRAME_X_DISPLAY (f), \ XScreenNumberOfScreen (FRAME_X_SCREEN (f))) #define FONT_WIDTH(f) ((f)->max_bounds.width) #define FONT_HEIGHT(f) ((f)->ascent + (f)->descent) #define FONT_BASE(f) ((f)->ascent) #define CHECK_X_FRAME(f, frame) \ if (NILP (frame)) \ f = selected_frame; \ else \ { \ CHECK_LIVE_FRAME (frame, 0); \ f = XFRAME (frame); \ } \ if (! FRAME_X_P (f)) /* The mask of events that text windows always want to receive. This does not include mouse movement events. It is used when the window is created (in x_window) and and in selection processing. We do include ButtonReleases in this set because Emacs isn't always fast enough to catch them when it wants them, and they're rare enough that they don't use much processor time. */ #define STANDARD_EVENT_SET \ (KeyPressMask \ | ExposureMask \ | ButtonPressMask \ | ButtonReleaseMask \ | PointerMotionMask \ | PointerMotionHintMask \ | StructureNotifyMask \ | FocusChangeMask \ | LeaveWindowMask \ | EnterWindowMask \ | VisibilityChangeMask) /* This checks to make sure we have a display. */ extern void check_x (); extern struct frame *x_window_to_frame (); #ifdef USE_X_TOOLKIT extern struct frame *x_any_window_to_frame (); extern struct frame *x_non_menubar_window_to_frame (); extern struct frame *x_top_window_to_frame (); #endif extern Visual *select_visual (); enum text_cursor_kinds { filled_box_cursor, hollow_box_cursor, bar_cursor }; /* This data type is used for the font_table field of struct x_display_info. */ struct font_info { XFontStruct *font; char *name; char *full_name; }; /* Structure recording X pixmap and reference count. If REFCOUNT is 0 then this record is free to be reused. */ struct x_bitmap_record { Pixmap pixmap; char *file; int refcount; /* Record some info about this pixmap. */ int height, width, depth; }; /* For each X display, we have a structure that records information about it. */ struct x_display_info { /* Chain of all x_display_info structures. */ struct x_display_info *next; /* Connection number (normally a file descriptor number). */ int connection; /* This says how to access this display in Xlib. */ Display *display; /* This is a cons cell of the form (NAME . FONT-LIST-CACHE). The same cons cell also appears in x_display_name_list. */ Lisp_Object name_list_element; /* Number of frames that are on this display. */ int reference_count; /* The Screen this connection is connected to. */ Screen *screen; /* The Visual being used for this display. */ Visual *visual; /* Number of panes on this screen. */ int n_planes; /* Dimensions of this screen. */ int height, width; /* Mask of things that cause the mouse to be grabbed. */ int grabbed; /* Emacs bitmap-id of the default icon bitmap for this frame. Or -1 if none has been allocated yet. */ int icon_bitmap_id; /* The root window of this screen. */ Window root_window; /* The cursor to use for vertical scroll bars. */ Cursor vertical_scroll_bar_cursor; /* X Resource data base */ XrmDatabase xrdb; /* A table of all the fonts we have already loaded. */ struct font_info *font_table; /* The current capacity of x_font_table. */ int font_table_size; /* Reusable Graphics Context for drawing a cursor in a non-default face. */ GC scratch_cursor_gc; /* These variables describe the range of text currently shown in its mouse-face, together with the window they apply to. As long as the mouse stays within this range, we need not redraw anything on its account. */ int mouse_face_beg_row, mouse_face_beg_col; int mouse_face_end_row, mouse_face_end_col; int mouse_face_past_end; Lisp_Object mouse_face_window; int mouse_face_face_id; /* 1 if a mouse motion event came and we didn't handle it right away because gc was in progress. */ int mouse_face_deferred_gc; /* FRAME and X, Y position of mouse when last checked for highlighting. X and Y can be negative or out of range for the frame. */ struct frame *mouse_face_mouse_frame; int mouse_face_mouse_x, mouse_face_mouse_y; /* Nonzero means defer mouse-motion highlighting. */ int mouse_face_defer; char *x_id_name; /* The number of fonts actually stored in x_font_table. font_table[n] is used and valid iff 0 <= n < n_fonts. 0 <= n_fonts <= font_table_size. */ int n_fonts; /* Pointer to bitmap records. */ struct x_bitmap_record *bitmaps; /* Allocated size of bitmaps field. */ int bitmaps_size; /* Last used bitmap index. */ int bitmaps_last; /* Which modifier keys are on which modifier bits? With each keystroke, X returns eight bits indicating which modifier keys were held down when the key was pressed. The interpretation of the top five modifier bits depends on what keys are attached to them. If the Meta_L and Meta_R keysyms are on mod5, then mod5 is the meta bit. meta_mod_mask is a mask containing the bits used for the meta key. It may have more than one bit set, if more than one modifier bit has meta keys on it. Basically, if EVENT is a KeyPress event, the meta key is pressed if (EVENT.state & meta_mod_mask) != 0. shift_lock_mask is LockMask if the XK_Shift_Lock keysym is on the lock modifier bit, or zero otherwise. Non-alphabetic keys should only be affected by the lock modifier bit if XK_Shift_Lock is in use; XK_Caps_Lock should only affect alphabetic keys. With this arrangement, the lock modifier should shift the character if (EVENT.state & shift_lock_mask) != 0. */ int meta_mod_mask, shift_lock_mask; /* These are like meta_mod_mask, but for different modifiers. */ int alt_mod_mask, super_mod_mask, hyper_mod_mask; /* Communication with window managers. */ Atom Xatom_wm_protocols; /* Kinds of protocol things we may receive. */ Atom Xatom_wm_take_focus; Atom Xatom_wm_save_yourself; Atom Xatom_wm_delete_window; /* Atom for indicating window state to the window manager. */ Atom Xatom_wm_change_state; /* Other WM communication */ Atom Xatom_wm_configure_denied; /* When our config request is denied */ Atom Xatom_wm_window_moved; /* When the WM moves us. */ /* EditRes protocol */ Atom Xatom_editres; /* More atoms, which are selection types. */ Atom Xatom_CLIPBOARD, Xatom_TIMESTAMP, Xatom_TEXT, Xatom_DELETE, Xatom_MULTIPLE, Xatom_INCR, Xatom_EMACS_TMP, Xatom_TARGETS, Xatom_NULL, Xatom_ATOM_PAIR; #ifdef MULTI_KBOARD struct kboard *kboard; #endif int cut_buffers_initialized; /* Whether we're sure they all exist */ /* The frame (if any) which has the X window that has keyboard focus. Zero if none. This is examined by Ffocus_frame in xfns.c. Note that a mere EnterNotify event can set this; if you need to know the last frame specified in a FocusIn or FocusOut event, use x_focus_event_frame. */ struct frame *x_focus_frame; /* The last frame mentioned in a FocusIn or FocusOut event. This is separate from x_focus_frame, because whether or not LeaveNotify events cause us to lose focus depends on whether or not we have received a FocusIn event for it. */ struct frame *x_focus_event_frame; /* The frame which currently has the visual highlight, and should get keyboard input (other sorts of input have the frame encoded in the event). It points to the X focus frame's selected window's frame. It differs from x_focus_frame when we're using a global minibuffer. */ struct frame *x_highlight_frame; }; /* This is a chain of structures for all the X displays currently in use. */ extern struct x_display_info *x_display_list; /* This is a list of cons cells, each of the form (NAME . FONT-LIST-CACHE), one for each element of x_display_list and in the same order. NAME is the name of the frame. FONT-LIST-CACHE records previous values returned by x-list-fonts. */ extern Lisp_Object x_display_name_list; extern struct x_display_info *x_display_info_for_display (); extern struct x_display_info *x_display_info_for_name (); extern struct x_display_info *x_term_init (); /* Each X frame object points to its own struct x_output object in the output_data.x field. The x_output structure contains the information that is specific to X windows. */ struct x_output { /* Position of the X window (x and y offsets in root window). */ int left_pos; int top_pos; /* Border width of the X window as known by the X window system. */ int border_width; /* Size of the X window in pixels. */ int pixel_height, pixel_width; /* Height of menu bar widget, in pixels. Zero if not using the X toolkit. When using the toolkit, this value is not meaningful if the menubar is turned off. */ int menubar_height; /* Height of a line, in pixels. */ int line_height; /* The tiled border used when the mouse is out of the frame. */ Pixmap border_tile; /* Here are the Graphics Contexts for the default font. */ GC normal_gc; /* Normal video */ GC reverse_gc; /* Reverse video */ GC cursor_gc; /* cursor drawing */ /* Width of the internal border. This is a line of background color just inside the window's border. When the frame is selected, a highlighting is displayed inside the internal border. */ int internal_border_width; /* The X window used for this frame. May be zero while the frame object is being created and the X window has not yet been created. */ Window window_desc; /* The X window used for the bitmap icon; or 0 if we don't have a bitmap icon. */ Window icon_desc; /* The X window that is the parent of this X window. Usually this is a window that was made by the window manager, but it can be the root window, and it can be explicitly specified (see the explicit_parent field, below). */ Window parent_desc; #ifdef USE_X_TOOLKIT /* The widget of this screen. This is the window of a "shell" widget. */ Widget widget; /* The XmPanedWindows... */ Widget column_widget; /* The widget of the edit portion of this screen; the window in "window_desc" is inside of this. */ Widget edit_widget; Widget menubar_widget; #endif /* If >=0, a bitmap index. The indicated bitmap is used for the icon. */ int icon_bitmap; XFontStruct *font; /* Pixel values used for various purposes. border_pixel may be -1 meaning use a gray tile. */ unsigned long background_pixel; unsigned long foreground_pixel; unsigned long cursor_pixel; unsigned long border_pixel; unsigned long mouse_pixel; unsigned long cursor_foreground_pixel; /* Descriptor for the cursor in use for this window. */ Cursor text_cursor; Cursor nontext_cursor; Cursor modeline_cursor; Cursor cross_cursor; /* Flag to set when the X window needs to be completely repainted. */ int needs_exposure; /* What kind of text cursor is drawn in this window right now? (If there is no cursor (phys_cursor_x < 0), then this means nothing.) */ enum text_cursor_kinds current_cursor; /* What kind of text cursor should we draw in the future? This should always be filled_box_cursor or bar_cursor. */ enum text_cursor_kinds desired_cursor; /* Width of bar cursor (if we are using that). */ int cursor_width; /* These are the current window manager hints. It seems that XSetWMHints, when presented with an unset bit in the `flags' member of the hints structure, does not leave the corresponding attribute unchanged; rather, it resets that attribute to its default value. For example, unless you set the `icon_pixmap' field and the `IconPixmapHint' bit, XSetWMHints will forget what your icon pixmap was. This is rather troublesome, since some of the members (for example, `input' and `icon_pixmap') want to stay the same throughout the execution of Emacs. So, we keep this structure around, just leaving values in it and adding new bits to the mask as we go. */ XWMHints wm_hints; /* The size of the extra width currently allotted for vertical scroll bars, in pixels. */ int vertical_scroll_bar_extra; /* Table of parameter faces for this frame. Any X resources (pixel values, fonts) referred to here have been allocated explicitly for this face, and should be freed if we change the face. */ struct face **param_faces; int n_param_faces; /* Table of computed faces for this frame. These are the faces whose indexes go into the upper bits of a glyph, computed by combining the parameter faces specified by overlays, text properties, and what have you. The X resources mentioned here are all shared with parameter faces. */ struct face **computed_faces; int n_computed_faces; /* How many are valid */ int size_computed_faces; /* How many are allocated */ /* This is the gravity value for the specified window position. */ int win_gravity; /* The geometry flags for this window. */ int size_hint_flags; /* This is the Emacs structure for the X display this frame is on. */ struct x_display_info *display_info; /* This is a button event that wants to activate the menubar. We save it here until the command loop gets to think about it. */ XButtonEvent *saved_button_event; /* This is the widget id used for this frame's menubar in lwlib. */ #ifdef USE_X_TOOLKIT int id; #endif /* Nonzero means our parent is another application's window and was explicitly specified. */ char explicit_parent; /* Nonzero means tried already to make this frame visible. */ char asked_for_visible; #ifdef HAVE_X_I18N /* Input context (currently, this means Compose key handler setup). */ XIC xic; #endif }; /* Get at the computed faces of an X window frame. */ #define FRAME_PARAM_FACES(f) ((f)->output_data.x->param_faces) #define FRAME_N_PARAM_FACES(f) ((f)->output_data.x->n_param_faces) #define FRAME_DEFAULT_PARAM_FACE(f) (FRAME_PARAM_FACES (f)[0]) #define FRAME_MODE_LINE_PARAM_FACE(f) (FRAME_PARAM_FACES (f)[1]) #define FRAME_COMPUTED_FACES(f) ((f)->output_data.x->computed_faces) #define FRAME_N_COMPUTED_FACES(f) ((f)->output_data.x->n_computed_faces) #define FRAME_SIZE_COMPUTED_FACES(f) ((f)->output_data.x->size_computed_faces) #define FRAME_DEFAULT_FACE(f) ((f)->output_data.x->computed_faces[0]) #define FRAME_MODE_LINE_FACE(f) ((f)->output_data.x->computed_faces[1]) /* Return the window associated with the frame F. */ #define FRAME_X_WINDOW(f) ((f)->output_data.x->window_desc) #define FRAME_FOREGROUND_PIXEL(f) ((f)->output_data.x->foreground_pixel) #define FRAME_BACKGROUND_PIXEL(f) ((f)->output_data.x->background_pixel) #define FRAME_FONT(f) ((f)->output_data.x->font) #define FRAME_INTERNAL_BORDER_WIDTH(f) ((f)->output_data.x->internal_border_width) #define FRAME_LINE_HEIGHT(f) ((f)->output_data.x->line_height) /* This gives the x_display_info structure for the display F is on. */ #define FRAME_X_DISPLAY_INFO(f) ((f)->output_data.x->display_info) /* This is the `Display *' which frame F is on. */ #define FRAME_X_DISPLAY(f) (FRAME_X_DISPLAY_INFO (f)->display) /* This is the `Screen *' which frame F is on. */ #define FRAME_X_SCREEN(f) (FRAME_X_DISPLAY_INFO (f)->screen) /* These two really ought to be called FRAME_PIXEL_{WIDTH,HEIGHT}. */ #define PIXEL_WIDTH(f) ((f)->output_data.x->pixel_width) #define PIXEL_HEIGHT(f) ((f)->output_data.x->pixel_height) #define FRAME_DESIRED_CURSOR(f) ((f)->output_data.x->desired_cursor) #define FRAME_XIC(f) ((f)->output_data.x->xic) /* X-specific scroll bar stuff. */ /* We represent scroll bars as lisp vectors. This allows us to place references to them in windows without worrying about whether we'll end up with windows referring to dead scroll bars; the garbage collector will free it when its time comes. We use struct scroll_bar as a template for accessing fields of the vector. */ struct scroll_bar { /* These fields are shared by all vectors. */ EMACS_INT size_from_Lisp_Vector_struct; struct Lisp_Vector *next_from_Lisp_Vector_struct; /* The window we're a scroll bar for. */ Lisp_Object window; /* The next and previous in the chain of scroll bars in this frame. */ Lisp_Object next, prev; /* The X window representing this scroll bar. Since this is a full 32-bit quantity, we store it split into two 32-bit values. */ Lisp_Object x_window_low, x_window_high; /* The position and size of the scroll bar in pixels, relative to the frame. */ Lisp_Object top, left, width, height; /* The starting and ending positions of the handle, relative to the handle area (i.e. zero is the top position, not SCROLL_BAR_TOP_BORDER). If they're equal, that means the handle hasn't been drawn yet. These are not actually the locations where the beginning and end are drawn; in order to keep handles from becoming invisible when editing large files, we establish a minimum height by always drawing handle bottoms VERTICAL_SCROLL_BAR_MIN_HANDLE pixels below where they would be normally; the bottom and top are in a different co-ordinate system. */ Lisp_Object start, end; /* If the scroll bar handle is currently being dragged by the user, this is the number of pixels from the top of the handle to the place where the user grabbed it. If the handle isn't currently being dragged, this is Qnil. */ Lisp_Object dragging; }; /* The number of elements a vector holding a struct scroll_bar needs. */ #define SCROLL_BAR_VEC_SIZE \ ((sizeof (struct scroll_bar) \ - sizeof (EMACS_INT) - sizeof (struct Lisp_Vector *)) \ / sizeof (Lisp_Object)) /* Turning a lisp vector value into a pointer to a struct scroll_bar. */ #define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec)) /* Building a 32-bit C integer from two 16-bit lisp integers. */ #define SCROLL_BAR_PACK(low, high) (XINT (high) << 16 | XINT (low)) /* Setting two lisp integers to the low and high words of a 32-bit C int. */ #define SCROLL_BAR_UNPACK(low, high, int32) \ (XSETINT ((low), (int32) & 0xffff), \ XSETINT ((high), ((int32) >> 16) & 0xffff)) /* Extract the X window id of the scroll bar from a struct scroll_bar. */ #define SCROLL_BAR_X_WINDOW(ptr) \ ((Window) SCROLL_BAR_PACK ((ptr)->x_window_low, (ptr)->x_window_high)) /* Store a window id in a struct scroll_bar. */ #define SET_SCROLL_BAR_X_WINDOW(ptr, id) \ (SCROLL_BAR_UNPACK ((ptr)->x_window_low, (ptr)->x_window_high, (int) id)) /* Return the outside pixel height for a vertical scroll bar HEIGHT rows high on frame F. */ #define VERTICAL_SCROLL_BAR_PIXEL_HEIGHT(f, height) \ ((height) * (f)->output_data.x->line_height) /* Return the inside width of a vertical scroll bar, given the outside width. */ #define VERTICAL_SCROLL_BAR_INSIDE_WIDTH(width) \ ((width) - VERTICAL_SCROLL_BAR_LEFT_BORDER - VERTICAL_SCROLL_BAR_RIGHT_BORDER) /* Return the length of the rectangle within which the top of the handle must stay. This isn't equivalent to the inside height, because the scroll bar handle has a minimum height. This is the real range of motion for the scroll bar, so when we're scaling buffer positions to scroll bar positions, we use this, not VERTICAL_SCROLL_BAR_INSIDE_HEIGHT. */ #define VERTICAL_SCROLL_BAR_TOP_RANGE(height) \ (VERTICAL_SCROLL_BAR_INSIDE_HEIGHT (height) - VERTICAL_SCROLL_BAR_MIN_HANDLE) /* Return the inside height of vertical scroll bar, given the outside height. See VERTICAL_SCROLL_BAR_TOP_RANGE too. */ #define VERTICAL_SCROLL_BAR_INSIDE_HEIGHT(height) \ ((height) - VERTICAL_SCROLL_BAR_TOP_BORDER - VERTICAL_SCROLL_BAR_BOTTOM_BORDER) /* Border widths for scroll bars. Scroll bar windows don't have any X borders; their border width is set to zero, and we redraw borders ourselves. This makes the code a bit cleaner, since we don't have to convert between outside width (used when relating to the rest of the screen) and inside width (used when sizing and drawing the scroll bar window itself). The handle moves up and down/back and forth in a rectangle inset from the edges of the scroll bar. These are widths by which we inset the handle boundaries from the scroll bar edges. */ #define VERTICAL_SCROLL_BAR_LEFT_BORDER (2) #define VERTICAL_SCROLL_BAR_RIGHT_BORDER (2) #define VERTICAL_SCROLL_BAR_TOP_BORDER (2) #define VERTICAL_SCROLL_BAR_BOTTOM_BORDER (2) /* Minimum lengths for scroll bar handles, in pixels. */ #define VERTICAL_SCROLL_BAR_MIN_HANDLE (5) /* Manipulating pixel sizes and character sizes. Knowledge of which factors affect the overall size of the window should be hidden in these macros, if that's possible. Return the upper/left pixel position of the character cell on frame F at ROW/COL. */ #define CHAR_TO_PIXEL_ROW(f, row) \ ((f)->output_data.x->internal_border_width \ + (row) * (f)->output_data.x->line_height) #define CHAR_TO_PIXEL_COL(f, col) \ ((f)->output_data.x->internal_border_width \ + (col) * FONT_WIDTH ((f)->output_data.x->font)) /* Return the pixel width/height of frame F if it has WIDTH columns/HEIGHT rows. */ #define CHAR_TO_PIXEL_WIDTH(f, width) \ (CHAR_TO_PIXEL_COL (f, width) \ + (f)->output_data.x->vertical_scroll_bar_extra \ + (f)->output_data.x->internal_border_width) #define CHAR_TO_PIXEL_HEIGHT(f, height) \ (CHAR_TO_PIXEL_ROW (f, height) \ + (f)->output_data.x->internal_border_width) /* Return the row/column (zero-based) of the character cell containing the pixel on FRAME at ROW/COL. */ #define PIXEL_TO_CHAR_ROW(f, row) \ (((row) - (f)->output_data.x->internal_border_width) \ / (f)->output_data.x->line_height) #define PIXEL_TO_CHAR_COL(f, col) \ (((col) - (f)->output_data.x->internal_border_width) \ / FONT_WIDTH ((f)->output_data.x->font)) /* How many columns/rows of text can we fit in WIDTH/HEIGHT pixels on frame F? */ #define PIXEL_TO_CHAR_WIDTH(f, width) \ (PIXEL_TO_CHAR_COL (f, ((width) \ - (f)->output_data.x->internal_border_width \ - (f)->output_data.x->vertical_scroll_bar_extra))) #define PIXEL_TO_CHAR_HEIGHT(f, height) \ (PIXEL_TO_CHAR_ROW (f, ((height) \ - (f)->output_data.x->internal_border_width))) /* If a struct input_event has a kind which is selection_request_event or selection_clear_event, then its contents are really described by this structure. */ /* For an event of kind selection_request_event, this structure really describes the contents. */ struct selection_input_event { int kind; Display *display; Window requestor; Atom selection, target, property; Time time; }; #define SELECTION_EVENT_DISPLAY(eventp) \ (((struct selection_input_event *) (eventp))->display) #define SELECTION_EVENT_REQUESTOR(eventp) \ (((struct selection_input_event *) (eventp))->requestor) #define SELECTION_EVENT_SELECTION(eventp) \ (((struct selection_input_event *) (eventp))->selection) #define SELECTION_EVENT_TARGET(eventp) \ (((struct selection_input_event *) (eventp))->target) #define SELECTION_EVENT_PROPERTY(eventp) \ (((struct selection_input_event *) (eventp))->property) #define SELECTION_EVENT_TIME(eventp) \ (((struct selection_input_event *) (eventp))->time) /* Interface to the face code functions. */ /* Create the first two computed faces for a frame -- the ones that have GC's. */ extern void init_frame_faces (/* FRAME_PTR */); /* Free the resources for the faces associated with a frame. */ extern void free_frame_faces (/* FRAME_PTR */); /* Given a computed face, find or make an equivalent display face in face_vector, and return a pointer to it. */ extern struct face *intern_face (/* FRAME_PTR, struct face * */); /* Given a frame and a face name, return the face's ID number, or zero if it isn't a recognized face name. */ extern int face_name_id_number (/* FRAME_PTR, Lisp_Object */); /* Return non-zero if FONT1 and FONT2 have the same size bounding box. We assume that they're both character-cell fonts. */ extern int same_size_fonts (/* XFontStruct *, XFontStruct * */); /* Recompute the GC's for the default and modeline faces. We call this after changing frame parameters on which those GC's depend. */ extern void recompute_basic_faces (/* FRAME_PTR */); /* Return the face ID associated with a buffer position POS. Store into *ENDPTR the next position at which a different face is needed. This does not take account of glyphs that specify their own face codes. F is the frame in use for display, and W is a window displaying the current buffer. REGION_BEG, REGION_END delimit the region, so it can be highlighted. */ extern int compute_char_face (/* FRAME_PTR frame, struct window *w, int pos, int region_beg, int region_end, int *endptr */); /* Return the face ID to use to display a special glyph which selects FACE_CODE as the face ID, assuming that ordinarily the face would be BASIC_FACE. F is the frame. */ extern int compute_glyph_face (/* FRAME_PTR, int */); emacs-19.30/src/alloca.s100444 21570 1 23472 5563566265 13342 0ustar djmdaemon/* `alloca' standard 4.2 subroutine for 68000's and 16000's and others. Also has _setjmp and _longjmp for pyramids. Copyright (C) 1985, 1986, 1988 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* Both 68000 systems I have run this on have had broken versions of alloca. Also, I am told that non-berkeley systems do not have it at all. So replace whatever system-provided alloca there may be on all 68000 systems. */ #define NOT_C_CODE #ifdef emacs #include #else #include "config.h" #endif #ifndef HAVE_ALLOCA /* define this to use system's alloca */ #ifndef hp9000s300 #ifndef m68k #ifndef m68000 #ifndef WICAT #ifndef ns32000 #ifndef ns16000 #ifndef sequent #ifndef pyramid #ifndef ATT3B5 #ifndef XENIX you lose!! #endif /* XENIX */ #endif /* ATT3B5 */ #endif /* pyramid */ #endif /* sequent */ #endif /* ns16000 */ #endif /* ns32000 */ #endif /* WICAT */ #endif /* m68000 */ #endif /* m68k */ #endif /* hp9000s300 */ #ifdef hp9000s300 #ifdef OLD_HP_ASSEMBLER data text globl _alloca _alloca move.l (sp)+,a0 ; pop return addr from top of stack move.l (sp)+,d0 ; pop size in bytes from top of stack add.l #ROUND,d0 ; round size up to long word and.l #MASK,d0 ; mask out lower two bits of size sub.l d0,sp ; allocate by moving stack pointer tst.b PROBE(sp) ; stack probe to allocate pages move.l sp,d0 ; return pointer add.l #-4,sp ; new top of stack jmp (a0) ; not a normal return MASK equ -4 ; Longword alignment ROUND equ 3 ; ditto PROBE equ -128 ; safety buffer for C compiler scratch data #else /* new hp assembler syntax */ /* The new compiler does "move.m (%sp)" to save registers, so we must copy the saved registers when we mung the sp. The old compiler did "move.m (%a6)", which gave us no trouble */ text set PROBE,-128 # safety for C frame temporaries set MAXREG,22 # d2-d7, a2-a5, fp2-fp7 may have been saved global _alloca _alloca: mov.l (%sp)+,%a0 # return address mov.l (%sp)+,%d0 # number of bytes to allocate mov.l %sp,%a1 # save old sp for register copy mov.l %sp,%d1 # compute new sp sub.l %d0,%d1 # space requested and.l &-4,%d1 # round down to longword sub.l &MAXREG*4,%d1 # space for saving registers mov.l %d1,%sp # save new value of sp tst.b PROBE(%sp) # create pages (sigh) mov.l %a2,%d1 # save reg a2 mov.l %sp,%a2 move.w &MAXREG-1,%d0 copy_regs_loop: /* save caller's saved registers */ mov.l (%a1)+,(%a2)+ dbra %d0,copy_regs_loop mov.l %a2,%d0 # return value mov.l %d1,%a2 # restore a2 add.l &-4,%sp # adjust tos jmp (%a0) # rts #endif /* new hp assembler */ #else #ifdef m68k /* SGS assembler totally different */ file "alloca.s" global alloca alloca: #ifdef MOTOROLA_DELTA /* slightly modified version of alloca to motorola sysV/68 pcc - based compiler. this compiler saves used registers relative to %sp instead of %fp. alright, just make new copy of saved register set whenever we allocate new space from stack.. this is true at last until SVR3V7 . bug has reported to Motorola. */ set MAXREG,10 # max no of registers to save (d2-d7, a2-a5) mov.l (%sp)+,%a1 # pop return addr from top of stack mov.l (%sp)+,%d0 # pop size in bytes from top of stack mov.l %sp,%a0 # save stack pointer for register copy addq.l &3,%d0 # round size up to long word andi.l &-4,%d0 # mask out lower two bits of size mov.l %sp,%d1 # compute new value of sp to d1 sub.l %d0,%d1 # pseudo-allocate by moving stack pointer sub.l &MAXREG*4,%d1 # allocate more space for saved regs. mov.l %d1,%sp # actual allocation. move.w &MAXREG-1,%d0 # d0 counts saved regs. mov.l %a2,%d1 # preserve a2. mov.l %sp,%a2 # make pointer to new reg save area. copy_regs_loop: # copy stuff from old save area. mov.l (%a0)+,(%a2)+ # save saved register dbra %d0,copy_regs_loop mov.l %a2,%a0 # now a2 is start of allocated space. mov.l %a2,%d0 # return it in both a0 and d0 to play safe. mov.l %d1,%a2 # restore a2. subq.l &4,%sp # new top of stack jmp (%a1) # far below normal return #else /* not MOTOROLA_DELTA */ mov.l (%sp)+,%a1 # pop return addr from top of stack mov.l (%sp)+,%d0 # pop size in bytes from top of stack add.l &R%1,%d0 # round size up to long word and.l &-4,%d0 # mask out lower two bits of size sub.l %d0,%sp # allocate by moving stack pointer tst.b P%1(%sp) # stack probe to allocate pages mov.l %sp,%a0 # return pointer as pointer mov.l %sp,%d0 # return pointer as int to avoid disaster add.l &-4,%sp # new top of stack jmp (%a1) # not a normal return set S%1,64 # safety factor for C compiler scratch set R%1,3+S%1 # add to size for rounding set P%1,-132 # probe this far below current top of stack #endif /* not MOTOROLA_DELTA */ #else /* not m68k */ #ifdef m68000 #ifdef WICAT /* * Registers are saved after the corresponding link so we have to explicitly * move them to the top of the stack where they are expected to be. * Since we do not know how many registers were saved in the calling function * we must assume the maximum possible (d2-d7,a2-a5). Hence, we end up * wasting some space on the stack. * * The large probe (tst.b) attempts to make up for the fact that we have * potentially used up the space that the caller probed for its own needs. */ .procss m0 .config "68000 1" .module _alloca MAXREG: .const 10 .sect text .global _alloca _alloca: move.l (sp)+,a1 ; pop return address move.l (sp)+,d0 ; pop allocation size move.l sp,d1 ; get current SP value sub.l d0,d1 ; adjust to reflect required size... sub.l #MAXREG*4,d1 ; ...and space needed for registers and.l #-4,d1 ; backup to longword boundry move.l sp,a0 ; save old SP value for register copy move.l d1,sp ; set the new SP value tst.b -4096(sp) ; grab an extra page (to cover caller) move.l a2,d1 ; save callers register move.l sp,a2 move.w #MAXREG-1,d0 ; # of longwords to copy loop: move.l (a0)+,(a2)+ ; copy registers... dbra d0,loop ; ...til there are no more move.l a2,d0 ; end of register area is addr for new space move.l d1,a2 ; restore saved a2. addq.l #4,sp ; caller will increment sp by 4 after return. move.l d0,a0 ; return value in both a0 and d0. jmp (a1) .end _alloca #else /* Some systems want the _, some do not. Win with both kinds. */ .globl _alloca _alloca: .globl alloca alloca: movl sp@+,a0 movl a7,d0 subl sp@,d0 andl #~3,d0 movl d0,sp tstb sp@(0) /* Make stack pages exist */ /* Needed on certain systems that lack true demand paging */ addql #4,d0 jmp a0@ #endif /* not WICAT */ #endif /* m68000 */ #endif /* not m68k */ #endif /* not hp9000s300 */ #if defined (ns16000) || defined (ns32000) .text .align 2 /* Some systems want the _, some do not. Win with both kinds. */ .globl _alloca _alloca: .globl alloca alloca: /* Two different assembler syntaxes are used for the same code on different systems. */ #ifdef sequent #define IM #define REGISTER(x) x #else #ifdef NS5 /* ns SysV assembler */ #define IM $ #define REGISTER(x) x #else #define IM $ #define REGISTER(x) 0(x) #endif #endif /* * The ns16000 is a little more difficult, need to copy regs. * Also the code assumes direct linkage call sequence (no mod table crap). * We have to copy registers, and therefore waste 32 bytes. * * Stack layout: * new sp -> junk * registers (copy) * r0 -> new data * | (orig retval) * | (orig arg) * old sp -> regs (orig) * local data * fp -> old fp */ movd tos,r1 /* pop return addr */ negd tos,r0 /* pop amount to allocate */ sprd sp,r2 addd r2,r0 bicb IM/**/3,r0 /* 4-byte align */ lprd sp,r0 adjspb IM/**/36 /* space for regs, +4 for caller to pop */ movmd 0(r2),4(sp),IM/**/4 /* copy regs */ movmd 0x10(r2),0x14(sp),IM/**/4 jump REGISTER(r1) /* funky return */ #endif /* ns16000 or ns32000 */ #ifdef pyramid .globl _alloca _alloca: addw $3,pr0 # add 3 (dec) to first argument bicw $3,pr0 # then clear its last 2 bits subw pr0,sp # subtract from SP the val in PR0 andw $-32,sp # keep sp aligned on multiple of 32. movw sp,pr0 # ret. current SP ret #ifdef PYRAMID_OLD /* This isn't needed in system version 4. */ .globl __longjmp .globl _longjmp .globl __setjmp .globl _setjmp __longjmp: jump _longjmp __setjmp: jump _setjmp #endif #endif /* pyramid */ #ifdef ATT3B5 .align 4 .globl alloca alloca: movw %ap, %r8 subw2 $9*4, %r8 movw 0(%r8), %r1 /* pc */ movw 4(%r8), %fp movw 8(%r8), %sp addw2 %r0, %sp /* make room */ movw %sp, %r0 /* return value */ jmp (%r1) /* continue... */ #endif /* ATT3B5 */ #ifdef XENIX .386 _TEXT segment dword use32 public 'CODE' assume cs:_TEXT ;------------------------------------------------------------------------- public _alloca _alloca proc near pop ecx ; return address pop eax ; amount to alloc add eax,3 ; round it to 32-bit boundary and al,11111100B ; mov edx,esp ; current sp in edx sub edx,eax ; lower the stack xchg esp,edx ; start of allocation in esp, old sp in edx mov eax,esp ; return ptr to base in eax push [edx+8] ; save poss. stored reg. values (esi,edi,ebx) push [edx+4] ; on lowered stack push [edx] ; sub esp,4 ; allow for 'add esp, 4' jmp ecx ; jump to return address _alloca endp _TEXT ends end #endif /* XENIX */ #endif /* not HAVE_ALLOCA */ emacs-19.30/src/cxux-crt0.s100666 12120 1 3030 5515151316 13714 0ustar rmsdaemon/* * External symbol setup file for GNU Emacs on CX/UX * Copyright (C) 1990 Free Software Foundation, Inc. * * This file is part of GNU Emacs. * * GNU Emacs is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY. No author or distributor * accepts responsibility to anyone for the consequences of using it * or for whether it serves any particular purpose or works at all, * unless he says so in writing. Refer to the GNU Emacs General Public * License for full details. * * Everyone is granted permission to copy, modify and redistribute * GNU Emacs, but only under the conditions described in the * GNU Emacs General Public License. A copy of this license is * supposed to have been given to you along with GNU Emacs so you * can know your rights and responsibilities. It should be in a * file named COPYING. Among other things, the copyright notice * and this notice must be preserved on all copies. */ /* * This file makes the start of the text and data regions of the program * clearly visible to the GNU Emacs C source code, without any dependencies * on any changes made to the standard C runtime startup module, crt0.o. * It depends, however, on this file being passed down to the linker (ld) * before any others, and the linker's behavior of assigning increasing * addresses as it finds symbols. */ /* C symbol _start marks beginning of text region. */ .text .globl __start __start: /* C symbol data_start marks beginning of data region. */ .data .globl _data_start _data_start: .space 4 emacs-19.30/src/README100666 12120 1 2770 6037253775 12601 0ustar rmsdaemonThis directory contains the source files for the C component of GNU Emacs. Nothing in this directory is needed for using Emacs once it is built and installed, if the dumped Emacs (on Unix systems) or the Emacs executable and map files (on VMS systems) are copied elsewhere. See the files ../README and then ../INSTALL for installation instructions. Under GNU and Unix systems, the file `Makefile.in' is used as a template by the script `../configure' to produce `Makefile.c'. The same script then uses `cpp' to produce the machine-dependent `Makefile' from `Makefile.c'; `Makefile' is the file which actually controls the compilation of Emacs. Most of this should work transparently to the user; you should only need to run `../configure', and then type `make'. See the file VMSBUILD in this directory for instructions on compiling, linking and building Emacs on VMS. The files `*.com' and `temacs.opt' are used on VMS only. The files `vlimit.h', `ioclt.h' and `param.h' are stubs to allow compilation on VMS with the minimum amount of #ifdefs. `uaf.h' contains VMS uaf structure definitions. This is only needed if you define READ_SYSUAF. This should only be done for single-user systems where you are not overly concerned with security, since it either requires that you install Emacs with SYSPRV or make SYSUAF.DAT world readable. Otherwise, Emacs can determine information about the current user, but no one else. `pwd.h' contains definitions for VMS to be able to correctly simulate `getpwdnam' and `getpwduid'. emacs-19.30/src/Makefile.in100444 12120 1 75031 6050676371 13774 0ustar rmsdaemon# Makefile for GNU Emacs. # Copyright (C) 1985, 87, 88, 93, 94, 95 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. */ # Here are the things that we expect ../configure to edit. srcdir=@srcdir@ VPATH=@srcdir@ CC=@CC@ CPP=@CPP@ CFLAGS=@CFLAGS@ LN_S=@LN_S@ # Substitute an assignment for the MAKE variable, because # BSD doesn't have it as a default. @SET_MAKE@ # On Xenix and the IBM RS6000, double-dot gets screwed up. dot = . lispsource = ${srcdir}/$(dot)$(dot)/lisp/ libsrc = $(dot)$(dot)/lib-src/ etc = $(dot)$(dot)/etc/ shortnamesdir = $(dot)$(dot)/shortnames/ cppdir = $(dot)$(dot)/cpp/ oldXMenudir = $(dot)$(dot)/oldXMenu/ lwlibdir = $(dot)$(dot)/lwlib/ # Configuration files for .o files to depend on. M_FILE = ${srcdir}/@machfile@ S_FILE = ${srcdir}/@opsysfile@ config_h = config.h $(M_FILE) $(S_FILE) # ========================== start of cpp stuff ======================= */ /* From here on, comments must be done in C syntax. */ CPPFLAGS= LDFLAGS= C_SWITCH_SYSTEM= /* just to be sure the sh is used */ SHELL=/bin/sh #define NO_SHORTNAMES #define NOT_C_CODE #include "config.h" /* We won't really call alloca; don't let the file name alloca.c get messed up. */ #ifdef alloca #undef alloca #endif /* Use HAVE_X11 as an alias for X11 in this file to avoid problems with X11 as a subdirectory name in -I and other such options which pass through this file. */ #ifdef X11 #define HAVE_X11 #undef X11 #endif /* On some machines #define register is done in config; don't let it interfere with this file. */ #undef register /* On some systems we may not be able to use the system make command. */ #ifdef MAKE_COMMAND MAKE = MAKE_COMMAND #endif #ifdef C_COMPILER CC = C_COMPILER #endif /* GNU libc requires ORDINARY_LINK so that its own crt0 is used. Linux is an exception because it uses a funny variant of GNU libc. */ #ifdef __GNU_LIBRARY__ #ifndef LINUX #define ORDINARY_LINK #endif #endif /* Some machines don't find the standard C libraries in the usual place. */ #ifndef ORDINARY_LINK #ifndef LIB_STANDARD #define LIB_STANDARD -lc #endif #else #ifndef LIB_STANDARD #define LIB_STANDARD #endif #endif /* Unless inhibited or changed, use -lg to link for debugging. */ #ifndef LIBS_DEBUG #define LIBS_DEBUG -lg #endif /* Some s/*.h files define this to request special libraries. */ #ifndef LIBS_SYSTEM #define LIBS_SYSTEM #endif /* Some m/*.h files define this to request special libraries. */ #ifndef LIBS_MACHINE #define LIBS_MACHINE #endif #ifndef LIB_MATH # ifdef LISP_FLOAT_TYPE # define LIB_MATH -lm # else /* ! defined (LISP_FLOAT_TYPE) */ # define LIB_MATH # endif /* ! defined (LISP_FLOAT_TYPE) */ #endif /* LIB_MATH */ /* Some s/*.h files define this to request special switches in ld. */ #ifndef LD_SWITCH_SYSTEM #if !defined (__GNUC__) && (defined(COFF_ENCAPSULATE) || (defined (BSD) && !defined (COFF))) #define LD_SWITCH_SYSTEM -X #else /* ! defined(COFF_ENCAPSULATE) || (defined (BSD) && !defined (COFF)) */ #define LD_SWITCH_SYSTEM #endif /* ! defined(COFF_ENCAPSULATE) || (defined (BSD) && !defined (COFF)) */ #endif /* LD_SWITCH_SYSTEM */ /* Some m/*.h files define this to request special switches in ld. */ #ifndef LD_SWITCH_MACHINE #define LD_SWITCH_MACHINE #endif /* Some m/*.h files define this to request special switches in cc. */ #ifndef C_SWITCH_MACHINE #define C_SWITCH_MACHINE #endif /* Some s/*.h files define this to request special switches in cc. */ #ifndef C_SWITCH_SYSTEM #define C_SWITCH_SYSTEM #endif /* These macros are for switches specifically related to X Windows. */ #ifndef C_SWITCH_X_MACHINE #define C_SWITCH_X_MACHINE #endif #ifndef C_SWITCH_X_SYSTEM #define C_SWITCH_X_SYSTEM #endif #ifndef C_SWITCH_X_SITE #define C_SWITCH_X_SITE #endif #ifndef LD_SWITCH_X_SITE #define LD_SWITCH_X_SITE #endif #ifndef LD_SWITCH_X_DEFAULT #define LD_SWITCH_X_DEFAULT #endif /* These can be passed in from config.h to define special load and compile switches needed by individual sites */ #ifndef LD_SWITCH_SITE #define LD_SWITCH_SITE #endif #ifndef C_SWITCH_SITE #define C_SWITCH_SITE #endif #ifndef ORDINARY_LINK #ifndef CRT0_COMPILE #define CRT0_COMPILE $(CC) -c $(ALL_CFLAGS) C_SWITCH_ASM #endif #ifndef START_FILES #ifdef NO_REMAP #ifdef COFF_ENCAPSULATE #define START_FILES pre-crt0.o /usr/local/lib/gcc-crt0.o #else /* ! defined (COFF_ENCAPSULATE) */ #define START_FILES pre-crt0.o /lib/crt0.o #endif /* ! defined (COFF_ENCAPSULATE) */ #else /* ! defined (NO_REMAP) */ #define START_FILES ecrt0.o #endif /* ! defined (NO_REMAP) */ #endif /* START_FILES */ STARTFILES = START_FILES #else /* ORDINARY_LINK */ /* config.h might want to force START_FILES anyway */ #ifdef START_FILES STARTFILES = START_FILES #endif /* START_FILES */ #endif /* not ORDINARY_LINK */ /* cc switches needed to make `asm' keyword work. Nothing special needed on most machines. */ #ifndef C_SWITCH_ASM #define C_SWITCH_ASM #endif /* Figure out whether the system cpp can handle long names. Do it by testing it right now. If it loses, arrange to use the GNU cpp. */ #define LONGNAMEBBBFOOX #ifdef LONGNAMEBBBARFOOX /* Installed cpp fails to distinguish those names! */ /* Arrange to compile the GNU cpp later on */ #define NEED_CPP /* Cause cc to invoke the cpp that comes with Emacs, which will be in a file named localcpp. */ MYCPPFLAG= -Blocal /* LOCALCPP is the local one or nothing. CPP is the local one or the standardone. */ LOCALCPP= localcpp #endif /* ! defined (LONGNAMEBBBARFOOX) */ #ifdef SHORTNAMES SHORT= shortnames #endif #ifdef USE_X_TOOLKIT #define USE_@X_TOOLKIT_TYPE@ TOOLKIT_DEFINES = -DUSE_@X_TOOLKIT_TYPE@ #else TOOLKIT_DEFINES = #endif /* DO NOT use -R. There is a special hack described in lastfile.c which is used instead. Some initialized data areas are modified at initial startup, then labeled as part of the text area when Emacs is dumped for the first time, and never changed again. */ /* -Demacs is needed to make some files produce the correct version for use in Emacs. -DHAVE_CONFIG_H is needed for some other files to take advantage of the information in `config.h'. */ /* C_SWITCH_X_SITE must come before C_SWITCH_X_MACHINE and C_SWITCH_X_SYSTEM since it may have -I options that should override those two. */ ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(TOOLKIT_DEFINES) $(MYCPPFLAG) -I. -I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_SITE C_SWITCH_X_SITE C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM ${CFLAGS} .c.o: $(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $< #ifndef LIBX10_MACHINE #define LIBX10_MACHINE #endif #ifndef LIBX11_MACHINE #define LIBX11_MACHINE #endif #ifndef LIBX10_SYSTEM #define LIBX10_SYSTEM #endif #ifndef LIBX11_SYSTEM #define LIBX11_SYSTEM #endif #ifndef LIB_X11_LIB #define LIB_X11_LIB -lX11 #endif #ifdef HAVE_X_WINDOWS #ifdef HAVE_X_MENU /* Include xmenu.o in the list of X object files. */ XOBJ= xterm.o xfns.o xfaces.o xmenu.o xselect.o xrdb.o /* The X Menu stuff is present in the X10 distribution, but missing from X11. If we have X10, just use the installed library; otherwise, use our own copy. */ #ifdef HAVE_X11 #ifdef USE_X_TOOLKIT OLDXMENU=${lwlibdir}liblw.a LIBXMENU= $(OLDXMENU) #else /* not USE_X_TOOLKIT */ OLDXMENU= ${oldXMenudir}libXMenu11.a LIBXMENU= $(OLDXMENU) #endif /* not USE_X_TOOLKIT */ #else /* not HAVE_X11 */ LIBXMENU= -lXMenu #endif /* not HAVE_X11 */ #else /* not HAVE_X_MENU */ /* Otherwise, omit xmenu.o from the list of X object files, and don't worry about the menu library at all. */ XOBJ= xterm.o xfns.o xfaces.o xselect.o xrdb.o LIBXMENU= #endif /* not HAVE_X_MENU */ #ifdef USE_X_TOOLKIT #define @X_TOOLKIT_TYPE@ #if defined (LUCID) || defined (ATHENA) LIBW= -lXaw #endif #ifdef MOTIF #ifdef LIB_MOTIF LIBW= LIB_MOTIF #else LIBW= -lXm #endif #endif #ifdef OPEN_LOOK LIBW= -lXol #endif #ifdef HAVE_X11XTR6 #ifdef NEED_LIBW LIBXTR6 = -lSM -lICE -lw #else LIBXTR6 = -lSM -lICE #endif #endif #ifndef LIBXMU #define LIBXMU -lXmu #endif LIBXT= $(LIBW) LIBXMU -lXt $(LIBXTR6) -lXext #else LIBXT= #endif #ifdef HAVE_X11 /* LD_SWITCH_X_DEFAULT comes after everything else that specifies options for where to find X libraries, but before those libraries. */ X11_LDFLAGS = LD_SWITCH_X_SITE LD_SWITCH_X_DEFAULT LIBX= $(LIBXMENU) $(X11_LDFLAGS) $(LIBXT) LIB_X11_LIB LIBX11_MACHINE LIBX11_SYSTEM #else /* not HAVE_X11 */ LIBX= $(LIBXMENU) LD_SWITCH_X_SITE -lX10 LIBX10_MACHINE LIBX10_SYSTEM #endif /* not HAVE_X11 */ #endif /* not HAVE_X_WINDOWS */ #ifndef ORDINARY_LINK /* Fix linking if compiled with GCC. */ #ifdef __GNUC__ #if __GNUC__ > 1 #ifdef LINKER #define LINKER_WAS_SPECIFIED #endif /* Versions of GCC >= 2.0 put their library, libgcc.a, in obscure places that are difficult to figure out at make time. Fortunately, these same versions allow you to pass arbitrary flags on to the linker, so there's no reason not to use it as a linker. Well, it's not quite perfect. The `-nostdlib' keeps GCC from searching for libraries in its internal directories, so we have to ask GCC explicitly where to find libgcc.a. */ #ifndef LINKER #define LINKER $(CC) -nostdlib #endif #ifndef LIB_GCC /* Ask GCC where to find libgcc.a. */ #define LIB_GCC `$(CC) -print-libgcc-file-name` #endif /* not LIB_GCC */ GNULIB_VAR = LIB_GCC #ifndef LINKER_WAS_SPECIFIED /* GCC passes any argument prefixed with -Xlinker directly to the linker. See prefix-args.c for an explanation of why we don't do this with the shell's `for' construct. Note that some people don't have '.' in their paths, so we must use ./prefix-args. */ #define YMF_PASS_LDFLAGS(flags) `./prefix-args -Xlinker flags` #else #define YMF_PASS_LDFLAGS(flags) flags #endif #else /* __GNUC__ < 2 */ #ifndef LIB_GCC #define LIB_GCC /usr/local/lib/gcc-gnulib #endif /* not LIB_GCC */ GNULIB_VAR = `if [ -f LIB_GCC ] ; then echo LIB_GCC; else echo; fi` #endif /* __GNUC__ < 2 */ #else /* not __GNUC__ */ GNULIB_VAR = #endif /* not __GNUC__ */ #endif /* not ORDINARY_LINK */ /* Specify address for ld to start loading at, if requested by configuration. */ #ifdef LD_TEXT_START_ADDR STARTFLAGS = -T LD_TEXT_START_ADDR -e __start #endif #ifdef ORDINARY_LINK LD = $(CC) #else #ifdef COFF_ENCAPSULATE LD=$(CC) -nostdlib #else /* not ORDINARY_LINK */ #ifdef LINKER LD=LINKER #else /* not LINKER */ LD=ld #endif /* not LINKER */ #endif /* not COFF_ENCAPSULATE */ #endif /* not ORDINARY_LINK */ ALL_LDFLAGS = LD_SWITCH_SYSTEM LD_SWITCH_MACHINE LD_SWITCH_SITE $(LDFLAGS) /* A macro which other sections of Makefile can redefine to munge the flags before they're passed to LD. This is helpful if you have redefined LD to something odd, like "gcc". (The YMF prefix is a holdover from the old name "ymakefile".) */ #ifndef YMF_PASS_LDFLAGS #define YMF_PASS_LDFLAGS(flags) flags #endif /* Allow config.h to specify a replacement file for unexec.c. */ #ifndef UNEXEC #define UNEXEC unexec.o #endif #ifndef UNEXEC_SRC #define UNEXEC_SRC unexec.c #endif #ifdef USE_TEXT_PROPERTIES #define INTERVAL_SRC intervals.h #define INTERVAL_OBJ intervals.o textprop.o #else #define INTERVAL_SRC #define INTERVAL_OBJ #endif #ifdef HAVE_GETLOADAVG #define GETLOADAVG_OBJ #else #define GETLOADAVG_OBJ getloadavg.o #endif #ifdef HAVE_MKTIME #define MKTIME_OBJ #else #define MKTIME_OBJ mktime.o #endif #ifdef MSDOS #ifdef HAVE_X_WINDOWS #define MSDOS_OBJ dosfns.o msdos.o #else #define MSDOS_OBJ dosfns.o msdos.o xfaces.o xmenu.o #endif #else #define MSDOS_OBJ #endif /* lastfile must follow all files whose initialized data areas should be dumped as pure by dump-emacs. */ obj= dispnew.o frame.o scroll.o xdisp.o window.o \ cm.o term.o $(XOBJ) \ emacs.o keyboard.o macros.o keymap.o sysdep.o \ buffer.o filelock.o insdel.o marker.o INTERVAL_OBJ \ minibuf.o fileio.o dired.o filemode.o \ cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \ alloc.o data.o doc.o editfns.o callint.o \ eval.o floatfns.o fns.o print.o lread.o \ abbrev.o syntax.o UNEXEC mocklisp.o bytecode.o \ process.o callproc.o \ region-cache.o \ doprnt.o strftime.o MKTIME_OBJ GETLOADAVG_OBJ MSDOS_OBJ /* Object files used on some machine or other. These go in the DOC file on all machines in case they are needed there. */ SOME_MACHINE_OBJECTS = sunfns.o dosfns.o msdos.o intervals.o textprop.o \ xterm.o xfns.o xfaces.o xmenu.o xselect.o xrdb.o #ifdef TERMINFO /* Used to be -ltermcap here. If your machine needs that, define LIBS_TERMCAP in the m/*.h file. */ #ifndef LIBS_TERMCAP #define LIBS_TERMCAP -lcurses #endif /* LIBS_TERMCAP */ termcapobj = terminfo.o #else /* ! defined (TERMINFO) */ #ifndef LIBS_TERMCAP #define LIBS_TERMCAP termcapobj = termcap.o tparam.o #else /* LIBS_TERMCAP */ termcapobj = tparam.o #endif /* LIBS_TERMCAP */ #endif /* ! defined (TERMINFO) */ #ifndef SYSTEM_MALLOC #ifdef GNU_MALLOC /* New GNU malloc */ #ifdef REL_ALLOC mallocobj = gmalloc.o ralloc.o vm-limit.o #else /* ! defined (REL_ALLOC) */ mallocobj = gmalloc.o vm-limit.o #endif /* ! defined (REL_ALLOC) */ #else /* Old GNU malloc */ mallocobj = malloc.o #endif /* Old GNU malloc */ #endif /* SYSTEM_MALLOC */ #ifndef HAVE_ALLOCA allocaobj = alloca.o #else allocaobj = #endif #ifdef USE_X_TOOLKIT widgetobj= widget.o #else /* not USE_X_TOOLKIT */ widgetobj= #endif /* not USE_X_TOOLKIT */ /* define otherobj as list of object files that make-docfile should not be told about. */ otherobj= $(termcapobj) lastfile.o $(mallocobj) $(allocaobj) $(widgetobj) #ifdef HAVE_FACES #define FACE_SUPPORT ${lispsource}faces.elc ${lispsource}facemenu.elc #else #define FACE_SUPPORT #endif #ifdef LISP_FLOAT_TYPE #define FLOAT_SUPPORT ${lispsource}float-sup.elc #else #define FLOAT_SUPPORT #endif #ifdef MULTI_FRAME #define FRAME_SUPPORT ${lispsource}frame.elc #else #define FRAME_SUPPORT #endif #ifdef HAVE_MOUSE #define MOUSE_SUPPORT ${lispsource}menu-bar.elc ${lispsource}mouse.elc \ ${lispsource}select.elc ${lispsource}scroll-bar.elc #else #define MOUSE_SUPPORT #endif #ifdef HAVE_X_WINDOWS #define X_WINDOWS_SUPPORT #else #define X_WINDOWS_SUPPORT #endif #ifdef VMS #define VMS_SUPPORT ${lispsource}vmsproc.elc ${lispsource}vms-patch.elc #else #define VMS_SUPPORT #endif #ifdef MSDOS #define MSDOS_SUPPORT ${lispsource}ls-lisp.elc ${lispsource}disp-tab.elc ${lispsource}dos-fns.elc #else #define MSDOS_SUPPORT #endif #ifdef WINDOWSNT #define WINNT_SUPPORT ${lispsource}ls-lisp.elc ${lispsource}winnt.elc #else #define WINNT_SUPPORT #endif /* List of Lisp files loaded into the dumped Emacs. It's arranged like this because it's easier to generate it semi-mechanically from loadup.el this way. Note that this list should not include lisp files which might not be present, like site-load.el and site-init.el; this makefile expects them all to be either present or buildable. */ lisp= \ ${lispsource}abbrev.elc \ ${lispsource}buff-menu.elc \ ${lispsource}byte-run.elc \ ${lispsource}c-mode.elc \ ${lispsource}files.elc \ ${lispsource}fill.elc \ ${lispsource}format.elc \ FACE_SUPPORT \ MOUSE_SUPPORT \ FLOAT_SUPPORT \ FRAME_SUPPORT \ X_WINDOWS_SUPPORT \ ${lispsource}help.elc \ ${lispsource}indent.elc \ ${lispsource}isearch.elc \ ${lispsource}lisp-mode.elc \ ${lispsource}lisp.elc \ ${lispsource}loadup.el \ ${lispsource}loaddefs.el \ ${lispsource}map-ynp.elc \ ${lispsource}page.elc \ ${lispsource}paragraphs.elc \ ${lispsource}paths.el \ ${lispsource}register.elc \ ${lispsource}replace.elc \ ${lispsource}simple.elc \ ${lispsource}startup.elc \ ${lispsource}subr.elc \ ${lispsource}text-mode.elc \ ${lispsource}vc-hooks.elc \ ${lispsource}ediff-hook.elc \ VMS_SUPPORT \ MSDOS_SUPPORT \ WINNT_SUPPORT \ ${lispsource}window.elc \ ${lispsource}version.el /* Lisp files that may or may not be used. We must unconditionally put them in the DOC file. */ SOME_MACHINE_LISP = ${lispsource}faces.elc ${lispsource}facemenu.elc \ ${lispsource}float-sup.elc ${lispsource}frame.elc \ ${lispsource}menu-bar.elc ${lispsource}mouse.elc \ ${lispsource}select.elc ${lispsource}scroll-bar.elc \ ${lispsource}vmsproc.elc ${lispsource}vms-patch.elc \ ${lispsource}ls-lisp.elc ${lispsource}dos-fns.elc \ ${lispsource}winnt.elc /* Construct full set of libraries to be linked. Note that SunOS needs -lm to come before -lc; otherwise, you get duplicated symbols. If the standard libraries were compiled with GCC, we might need gnulib again after them. */ LIBES = $(LIBX) LIBS_SYSTEM LIBS_MACHINE LIBS_TERMCAP \ LIBS_DEBUG $(GNULIB_VAR) LIB_MATH LIB_STANDARD $(GNULIB_VAR) /* Enable recompilation of certain other files depending on system type. */ #ifndef OTHER_FILES #define OTHER_FILES #endif /* Enable inclusion of object files in temacs depending on system type. */ #ifndef OBJECTS_SYSTEM #define OBJECTS_SYSTEM #endif #ifndef OBJECTS_MACHINE #define OBJECTS_MACHINE #endif all: emacs OTHER_FILES emacs: temacs ${etc}DOC ${lisp} #ifdef CANNOT_DUMP rm -f emacs ln temacs emacs #else #ifdef HAVE_SHM ./temacs -nl -batch -l loadup dump #else /* ! defined (HAVE_SHM) */ ./temacs -batch -l loadup dump #endif /* ! defined (HAVE_SHM) */ #endif /* ! defined (CANNOT_DUMP) */ /* We run make-docfile twice because the command line may get too long on some systems. */ /* ${SOME_MACHINE_OBJECTS} comes before ${obj} because some files may or may not be included in ${obj}, but they are always included in ${SOME_MACHINE_OBJECTS}. Since a file is processed when it is mentioned for the first time, this prevents any variation between configurations in the contents of the DOC file. Likewise for ${SOME_MACHINE_LISP}. */ ${etc}DOC: ${libsrc}make-docfile ${obj} ${lisp} -rm -f ${etc}DOC ${libsrc}make-docfile -d ${srcdir} ${SOME_MACHINE_OBJECTS} ${obj} > ${etc}DOC ${libsrc}make-docfile -a ${etc}DOC -d ${srcdir} ${SOME_MACHINE_LISP} ${lisp} ${libsrc}make-docfile: cd ${libsrc}; ${MAKE} ${MFLAGS} make-docfile /* Some systems define this to cause parallel Make-ing. */ #ifndef MAKE_PARALLEL #define MAKE_PARALLEL #endif temacs: MAKE_PARALLEL $(LOCALCPP) $(SHORT) $(STARTFILES) $(OLDXMENU) ${obj} ${otherobj} OBJECTS_SYSTEM OBJECTS_MACHINE prefix-args $(LD) YMF_PASS_LDFLAGS (${STARTFLAGS} ${ALL_LDFLAGS}) \ -o temacs ${STARTFILES} ${obj} ${otherobj} \ OBJECTS_SYSTEM OBJECTS_MACHINE ${LIBES} /* We don't use ALL_LDFLAGS because LD_SWITCH_SYSTEM and LD_SWITCH_MACHINE often contain options that have to do with using Emacs's crt0, which are only good with temacs. */ prefix-args: prefix-args.c $(config_h) $(CC) $(ALL_CFLAGS) $(LDFLAGS) ${srcdir}/prefix-args.c -o prefix-args /* These are needed for C compilation, on the systems that need them */ #ifdef NEED_CPP CPP = ./localcpp localcpp: cd ${cppdir}; ${MAKE} ${MFLAGS} EMACS=-DEMACS ln ${cppdir}cpp localcpp /* Name where ALL_CFLAGS will refer to it */ /* cc appears to be cretinous and require all of these to exist if -B is specified -- we can't use one local pass and let the others be the standard ones. What a loser. We can't even use ln, since they are probably on different disks. */ cp /lib/ccom localccom -cp /lib/optim localoptim -cp /lib/c2 localc2 cp /bin/as localas #else /* ! defined (NEED_CPP) */ CPP = $(CC) -E #endif /* ! defined (NEED_CPP) */ #ifdef SHORTNAMES shortnames: cd ${shortnamesdir}; ${MAKE} ${MFLAGS} #endif /* Don't lose if this was not defined. */ #ifndef OLDXMENU_OPTIONS #define OLDXMENU_OPTIONS #endif /* Don't lose if this was not defined. */ #ifndef LWLIB_OPTIONS #define LWLIB_OPTIONS #endif #ifdef HAVE_X_WINDOWS #ifdef HAVE_X11 #ifdef USE_X_TOOLKIT $(OLDXMENU): really-lwlib /* Encode the values of these two macros in Make variables, so we can use $(...) to substitute their values within "...". */ C_SWITCH_MACHINE_1 = C_SWITCH_MACHINE C_SWITCH_SYSTEM_1 = C_SWITCH_SYSTEM C_SWITCH_SITE_1 = C_SWITCH_SITE C_SWITCH_X_SITE_1 = C_SWITCH_X_SITE C_SWITCH_X_MACHINE_1 = C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM_1 = C_SWITCH_X_SYSTEM really-lwlib: cd ${lwlibdir}; ${MAKE} ${MFLAGS} LWLIB_OPTIONS \ CC='${CC}' CFLAGS='${CFLAGS}' MAKE='${MAKE}' \ "C_SWITCH_X_SITE=$(C_SWITCH_X_SITE_1)" \ "C_SWITCH_X_MACHINE=$(C_SWITCH_X_MACHINE_1)" \ "C_SWITCH_X_SYSTEM=$(C_SWITCH_X_SYSTEM_1)" \ "C_SWITCH_SITE=$(C_SWITCH_SITE_1)" \ "C_SWITCH_MACHINE=$(C_SWITCH_MACHINE_1)" \ "C_SWITCH_SYSTEM=$(C_SWITCH_SYSTEM_1)" @true /* make -t should not create really-lwlib. */ .PHONY: really-lwlib #else /* not USE_X_TOOLKIT */ #ifdef HAVE_X_MENU $(OLDXMENU): really-oldXMenu /* Encode the values of these two macros in Make variables, so we can use $(...) to substitute their values within "...". */ C_SWITCH_MACHINE_1 = C_SWITCH_MACHINE C_SWITCH_SYSTEM_1 = C_SWITCH_SYSTEM C_SWITCH_SITE_1 = C_SWITCH_SITE C_SWITCH_X_SITE_1 = C_SWITCH_X_SITE C_SWITCH_X_MACHINE_1 = C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM_1 = C_SWITCH_X_SYSTEM really-oldXMenu: cd ${oldXMenudir}; ${MAKE} ${MFLAGS} OLDXMENU_OPTIONS \ CC='${CC}' CFLAGS='${CFLAGS}' MAKE='${MAKE}' \ "C_SWITCH_X_SITE=$(C_SWITCH_X_SITE_1)" \ "C_SWITCH_X_MACHINE=$(C_SWITCH_X_MACHINE_1)" \ "C_SWITCH_X_SYSTEM=$(C_SWITCH_X_SYSTEM_1)" \ "C_SWITCH_SITE=$(C_SWITCH_SITE_1)" \ "C_SWITCH_MACHINE=$(C_SWITCH_MACHINE_1)" \ "C_SWITCH_SYSTEM=$(C_SWITCH_SYSTEM_1)" @true /* make -t should not create really-oldXMenu. */ .PHONY: really-oldXMenu #endif /* HAVE_X_MENU */ #endif /* not USE_X_TOOLKIT */ #endif /* HAVE_X11 */ #endif /* HAVE_X_WINDOWS */ paths.h: paths.in @echo "The file paths.h needs to be set up from paths.in." @echo "Consult the file \`INSTALL' for instructions for building Emacs." exit 1 config.h: config.in @echo "The file config.h needs to be set up from config.in." @echo "Consult the file \`INSTALL' for instructions for building Emacs." exit 1 /* Some machines have alloca built-in. They should define HAVE_ALLOCA, or may just let alloca.s be used but generate no code. Some have it written in assembler in alloca.s. Some use the C version in alloca.c (these define C_ALLOCA in config.h). */ #ifdef C_ALLOCA /* We could put something in alloca.c to #define free and malloc whenever emacs was #defined, but that's not appropriate for all users of alloca in Emacs. Check out ../lib-src/getopt.c. */ alloca.o : alloca.c $(CC) -c $(CPPFLAGS) -Dfree=xfree -Dmalloc=xmalloc \ $(ALL_CFLAGS) ${srcdir}/alloca.c #else #ifndef HAVE_ALLOCA alloca.o : alloca.s $(config_h) /* $(CPP) is cc -E, which may get confused by filenames that do not end in .c. So copy file to a safe name. */ -rm -f allocatem.c cp ${srcdir}/alloca.s allocatem.c /* Remove any ^L, blank lines, and preprocessor comments, since some assemblers barf on them. Use a different basename for the output file, since some stupid compilers (Green Hill's) use that name for the intermediate assembler file. */ $(CPP) $(CPPFLAGS) $(ALL_CFLAGS) allocatem.c | \ sed -e 's/ //' -e 's/^#.*//' | \ sed -n -e '/^..*$$/p' > allocax.s -rm -f alloca.o /* Xenix, in particular, needs to run assembler via cc. */ $(CC) -c allocax.s mv allocax.o alloca.o -rm -f allocax.s allocatem.c #endif /* HAVE_ALLOCA */ #endif /* ! defined (C_ALLOCA) */ /* Nearly all the following files depend on lisp.h, but it is not included as a dependency because it is so often changed in ways that do not require any recompilation and so rarely changed in ways that do require any. */ abbrev.o: abbrev.c buffer.h commands.h $(config_h) buffer.o: buffer.c buffer.h region-cache.h commands.h window.h \ INTERVAL_SRC blockinput.h $(config_h) callint.o: callint.c window.h commands.h buffer.h mocklisp.h \ keyboard.h $(config_h) callproc.o: callproc.c paths.h buffer.h commands.h $(config_h) \ process.h systty.h syssignal.h casefiddle.o: casefiddle.c syntax.h commands.h buffer.h $(config_h) casetab.o: casetab.c buffer.h $(config_h) cm.o: cm.c cm.h termhooks.h $(config_h) cmds.o: cmds.c syntax.h buffer.h commands.h window.h $(config_h) pre-crt0.o: pre-crt0.c ecrt0.o: ecrt0.c $(config_h) CRT0_COMPILE ${srcdir}/ecrt0.c dired.o: dired.c commands.h buffer.h $(config_h) regex.h dispnew.o: dispnew.c commands.h frame.h window.h buffer.h dispextern.h \ termchar.h termopts.h termhooks.h cm.h disptab.h systty.h systime.h \ xterm.h $(config_h) doc.o: doc.c $(config_h) paths.h buffer.h keyboard.h doprnt.o: doprnt.c $(config_h) dosfns.o: buffer.h termchar.h termhooks.h frame.h msdos.h dosfns.h $(config_h) editfns.o: editfns.c window.h buffer.h systime.h INTERVAL_SRC $(config_h) emacs.o: emacs.c commands.h systty.h syssignal.h process.h INTERVAL_SRC $(config_h) fileio.o: fileio.c window.h buffer.h systime.h INTERVAL_SRC $(config_h) filelock.o: filelock.c buffer.h paths.h $(config_h) filemode.o: filemode.c $(config_h) getloadavg.o: getloadavg.c $(config_h) indent.o: indent.c frame.h window.h indent.h buffer.h $(config_h) termchar.h \ termopts.h disptab.h region-cache.h insdel.o: insdel.c window.h buffer.h INTERVAL_SRC blockinput.h $(config_h) keyboard.o: keyboard.c termchar.h termhooks.h termopts.h buffer.h \ commands.h frame.h window.h macros.h disptab.h keyboard.h syssignal.h \ systty.h systime.h dispextern.h intervals.h blockinput.h xterm.h $(config_h) keymap.o: keymap.c buffer.h commands.h keyboard.h termhooks.h blockinput.h \ $(config_h) lastfile.o: lastfile.c $(config_h) macros.o: macros.c window.h buffer.h commands.h macros.h keyboard.h $(config_h) malloc.o: malloc.c $(config_h) msdos.o: msdos.c msdos.h dosfns.h systime.h termhooks.h dispextern.h \ termopts.h frame.h window.h $(config_h) mktime.o: mktime.c $(config_h) gmalloc.o: gmalloc.c $(config_h) ralloc.o: ralloc.c $(config_h) vm-limit.o: vm-limit.c mem-limits.h $(config_h) marker.o: marker.c buffer.h $(config_h) minibuf.o: minibuf.c syntax.h dispextern.h frame.h window.h \ buffer.h commands.h $(config_h) mocklisp.o: mocklisp.c buffer.h $(config_h) process.o: process.c process.h buffer.h window.h termhooks.h termopts.h \ commands.h syssignal.h systime.h systty.h syswait.h frame.h $(config_h) regex.o: regex.c syntax.h buffer.h $(config_h) regex.h region-cache.o: region-cache.c buffer.h region-cache.h frame.o: frame.c xterm.h window.h frame.h termhooks.h commands.h keyboard.h \ buffer.h $(config_h) scroll.o: scroll.c termchar.h dispextern.h frame.h $(config_h) search.o: search.c regex.h commands.h buffer.h region-cache.h syntax.h \ blockinput.h $(config_h) strftime.o: strftime.c $(config_h) $(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) -Dstrftime=emacs_strftime $< syntax.o: syntax.c syntax.h buffer.h commands.h $(config_h) sysdep.o: sysdep.c $(config_h) dispextern.h termhooks.h termchar.h termopts.h \ frame.h syssignal.h systty.h systime.h syswait.h blockinput.h window.h term.o: term.c termchar.h termhooks.h termopts.h $(config_h) cm.h frame.h \ disptab.h keyboard.h termcap.o: termcap.c $(config_h) terminfo.o: terminfo.c $(config_h) tparam.o: tparam.c $(config_h) undo.o: undo.c buffer.h commands.h $(config_h) /* This hack is to discard any space that cpp might put at the beginning of UNEXEC when substituting it in. */ UNEXEC_ALIAS=UNEXEC $(UNEXEC_ALIAS): UNEXEC_SRC $(config_h) widget.o: widget.c xterm.h frame.h dispextern.h widgetprv.h $(config_h) window.o: window.c indent.h commands.h frame.h window.h buffer.h termchar.h \ termhooks.h disptab.h keyboard.h $(config_h) xdisp.o: xdisp.c macros.h commands.h indent.h buffer.h dispextern.h \ termchar.h frame.h window.h disptab.h termhooks.h $(config_h) xfaces.o: xfaces.c dispextern.h frame.h xterm.h buffer.h blockinput.h \ window.h $(config_h) xfns.o: xfns.c buffer.h frame.h window.h keyboard.h xterm.h \ blockinput.h paths.h $(config_h) xmenu.o: xmenu.c xterm.h window.h dispextern.h frame.h keyboard.h \ blockinput.h puresize.h msdos.h $(config_h) xterm.o: xterm.c xterm.h termhooks.h termopts.h termchar.h window.h \ dispextern.h frame.h disptab.h blockinput.h systime.h syssignal.h \ keyboard.h gnu.h sink.h sinkmask.h $(config_h) xselect.o: xselect.c dispextern.h frame.h xterm.h blockinput.h $(config_h) xrdb.o: xrdb.c $(config_h) hftctl.o: hftctl.c $(config_h) /* The files of Lisp proper */ alloc.o: alloc.c frame.h window.h buffer.h puresize.h syssignal.h keyboard.h \ blockinput.h $(config_h) INTERVAL_SRC bytecode.o: bytecode.c buffer.h syntax.h $(config_h) data.o: data.c buffer.h puresize.h syssignal.h keyboard.h $(config_h) eval.o: eval.c commands.h keyboard.h blockinput.h $(config_h) floatfns.o: floatfns.c $(config_h) fns.o: fns.c commands.h $(config_h) frame.h buffer.h keyboard.h INTERVAL_SRC print.o: print.c process.h frame.h window.h buffer.h keyboard.h $(config_h) lread.o: lread.c commands.h keyboard.h buffer.h paths.h $(config_h) \ termhooks.h /* Text properties support */ textprop.o: textprop.c buffer.h intervals.h $(config_h) intervals.o: intervals.c buffer.h intervals.h keyboard.h puresize.h $(config_h) /* System-specific programs to be made. OTHER_FILES, OBJECTS_SYSTEM and OBJECTS_MACHINE select which of these should be compiled. */ sunfns.o: sunfns.c buffer.h $(config_h) ${libsrc}emacstool: ${libsrc}emacstool.c cd ${libsrc}; ${MAKE} ${MFLAGS} emacstool mostlyclean: rm -f temacs prefix-args core \#* *.o libXMenu11.a liblw.a rm -f ../etc/DOC clean: mostlyclean rm -f emacs-* emacs /**/# This is used in making a distribution. /**/# Do not use it on development directories! distclean: clean rm -f paths.h config.h Makefile Makefile.c ../etc/DOC-* maintainer-clean: distclean @echo "This command is intended for maintainers to use;" @echo "it deletes files that may require special tools to rebuild." rm -f TAGS versionclean: -rm -f emacs emacs-* ../etc/DOC* extraclean: distclean -rm -f *~ \#* m/?*~ s/?*~ /* The rule for the [sm] files has to be written a little funny to avoid looking like a C comment to CPP. */ SOURCES = *.[ch] [sm]/?* COPYING Makefile.in \ config.in paths.in README COPYING ChangeLog vms.pp-trans unlock: chmod u+w $(SOURCES) relock: chmod -w $(SOURCES) chmod +w paths.h /* Arrange to make a tags table in ../lisp, and another in this dir which includes ../lisp/TAGS by reference. */ ctagsfiles = [a-zA-Z]*.[hc] lisptagsfiles = ../lisp/[a-zA-Z]*.el TAGS: $(ctagsfiles) export DIR; DIR=`pwd`; cd ${srcdir}; \ $$DIR/../lib-src/etags --include=../lisp/TAGS \ --regex='/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/' $(ctagsfiles) ${lispsource}TAGS: ${lispsource}$(lisptagsfiles) cd ${lispsource}; $(MAKE) TAGS tags: TAGS ${lispsource}TAGS .PHONY: tags emacs-19.30/src/ChangeLog100666 12120 1 1214411 6055517054 13542 0ustar rmsdaemonFri Nov 24 22:01:33 1995 Richard Stallman * Version 19.30 released. * msdos.c (IT_set_menu_bar_lines): Clear last_modified field. Thu Nov 23 15:07:13 1995 Andreas Schwab * keyboard.c (read_char): Handle unread events from popup menus. Wed Nov 22 13:58:36 1995 Geoff Voelker * makefile.nt (DOC, clean): Don't use switches to del not supported by Win95. Wed Nov 22 07:35:25 1995 Richard Stallman * xterm.c (XTmouse_position): Exit the loop if child == win. (x_iconify_frame): Call FRAME_SAMPLE_VISIBILITY. (XTframe_up_to_date): Block and unblock input. Wed Nov 22 05:46:28 1995 Eli Zaretskii * msdos.c (internal_terminal_init): Initialize the_only_x_display.font. * xfaces.c (Fset_face_attribute_internal) [MSDOS]: Set font field to 1. Wed Nov 22 05:46:28 1995 Richard Stallman * msdos.c (dos_set_keyboard): If CODE is not recognized, initialize to the US keyboard table. Tue Nov 21 01:48:52 1995 Richard Stallman * s/linux.h (LIB_MOTIF): New definition. * editfns.c (Fcurrent_time): Doc fix. * s/hpux10.h (FORCE_ALLOCA_H): Defined (for getdate.y). (HPUX10): Defined. * window.c (Fdisplay_buffer): Always deiconify the window's frame. (display_buffer_1): New subroutine. * m/alpha.h [LINUX] (LINUX_SBRK_BUG): Defined. * emacs.c (main): Add LINUX_SBRK_BUG conditional call to __sbrk. * s/msdos.h (SYSTEM_PURESIZE_EXTRA): Increased. * dosfns.c (syms_of_dosfns): Use 0x75 for dos_keypad_mode. Mon Nov 20 13:37:56 1995 Richard Stallman * alloc.c (Flist): Avoid using -- in while condition. * xfaces.c (unload_color, unload_font): Never invalidate computed faces 0 and 1. * minibuf.c (choose_minibuf_frame): On MSDOS, just use minibuf_window. Sun Nov 19 15:29:11 1995 Richard Stallman * xterm.c (show_mouse_face): When clearing cursor, use proper column range. * lread.c (Vsource_directory): New variable. (init_lread): Initialize it. (syms_of_lread): Set up Lisp var. Sat Nov 18 09:24:58 1995 Fred Fish * s/linux.h: #undef SIGPOLL and SIGURG as well as SIGIO. Sat Nov 18 14:03:38 1995 Richard Stallman * data.c (Fmake_local_variable): Call find_symbol_value before making a new local binding. Wed Nov 15 20:47:36 1995 Roland McGrath * mem-limits.h [_LIBC] (start_of_data): Use weak ref to __data_start; use &etext if not present. Wed Nov 15 11:56:58 1995 Richard Stallman * xterm.c (XTread_socket): Verify a ButtonPress was actually in the menu bar before generating a menu_bar_activate_event event. * s/hpux10.h: New file. * textprop.c (Fset_text_properties): Call set_properties even if we also merge an interval. * xselect.c (x_clear_frame_selections): Get selection_symbol properly. (syms_of_xselect): Doc fix. * doprnt.c (doprnt1): Add a cast. * alloc.c (mark_object): Don't overwrite original argument value. * .gdbinit (xsymbol): Cast name explicitly to (char *). Tue Nov 14 14:15:23 1995 Geoff Voelker * w32term.h: New file. Tue Nov 14 12:36:49 1995 Richard Stallman * keyboard.c (Fexecute_extended_command): Call Fwhere_is_internal just once to handle all the maps. * xdisp.c (Qredisplay_end_trigger_functions): Renamed from ..._hook. (syms_of_xdisp): Set up new name. (display_text_line): Call them with arguments. * window.c (Fset_window_redisplay_end_trigger): Doc fix. * fileio.c (check_executable) [DOS_NT]: Treat all dirs as executable. Mon Nov 13 00:06:01 1995 Richard Stallman * frame.h (FRAME_WINDOW_P): Always define it one way or another. * m/alpha.h: Declare calloc like malloc. Sun Nov 12 00:19:44 1995 Richard Stallman * xselect.c (x_clear_frame_selections): Undo previous change. * fileio.c (Fcopy_file): Don't chmod output file on MSDOS unless we have DJGPP version 2. * s/usg5-4.h (LIBS_STANDARD): Definition deleted. * s/isc2-2.h (LIBS_SYSTEM): Fix typo in prev change. * dispnew.c: Always include dispextern.h before cm.h. Sat Nov 11 01:16:45 1995 Richard Stallman * xdisp.c (display_text_line): Handle redisplay_end_trigger before getting the face of the next character. Reset next_face_change. * frame.c (syms_of_frame_1): Set up Vdefault_frame_alist here. (syms_of_frame): Not here. (Vdefault_frame_alist): Definition now unconditional. * msdos.c (dos_menubar_clock_displayed): New variable. (check_timer): Erase the clock if it has been turned off. * doc.c (Fdocumentation): Reject a file reference at the end of a lambda body. * xdisp.c (display_menu_bar): Fix backwards conditional. (update_menu_bar, redisplay_window): Don't use FRAME_EXTERNAL_MENU_BAR in #ifdef, since it is always defined. Fri Nov 10 18:44:42 1995 Simon Leinen * s/hpux9.h (NO_EDITRES): Defined. (LIBXMU): Define once again. * xfns.c (HACK_EDITRES): Don't define if NO_EDITRES is defined. * xterm.c (HACK_EDITRES): Define here as in xfns.c. (XTread_socket): Test HACK_EDITRES. Fri Nov 10 10:53:51 1995 Richard Stallman * s/isc2-2.h (LIB_STANDARD_1): New macro. (LIB_STANDARD): Use LIB_STANDARD_1. (LIBS_SYSTEM): Use it here too. * print.c (debug_print): Explicitly print a CR. * keyboard.c (interrupt_signal): Do special things in GC. Fri Nov 10 00:02:48 1995 Andreas Schwab * frame.c (set_menu_bar_lines): Record the fact that the window configuration changes. (set_menu_bar_lines_1): Mark the window as modified. Thu Nov 9 23:28:43 1995 Richard Stallman * floatfns.c (Fexpt): Doc fix. * window.h (struct window): New field redisplay_end_trigger. * window.c (Fwindow_redisplay_end_trigger): New function. (Fset_window_redisplay_end_trigger): Likewise. (syms_of_window): defsubr them. * xdisp.c (display_text_line): Get redisplay_end_trigger from window. Thu Nov 9 19:29:39 1995 Richard Stallman * buffer.c (syms_of_buffer): Delete the buffer-redisplay-end-trigger local variable. Thu Nov 9 19:15:56 1995 Simon Leinen * xmenu.c: Don't include Xaw/Paned.h unless USE_LUCID is defined. (set_frame_menubar): Conditionalized some code on USE_LUCID that depends on the fact that the parent widget of the menu bar is an Xaw "Paned" widget. Thu Nov 9 02:43:32 1995 Erik Naggum * eval.c (run-hook-with-args, run-hook-list-with-args): Safeguard against a t in the global value of hook variables. Wed Nov 8 16:36:20 1995 Richard Stallman * s/msdos.h (SYMS_SYSTEM): Add syms_of_msdos. * Makefile.in (lisp): Add loadup.el. * indent.c (compute_motion): Update next_boundary when we skip to next newline. Tue Nov 7 14:46:06 1995 Richard Stallman * lread.c (oblookup): Clear ARRAY_MARK_FLAG in obsize. * callint.c (syms_of_callint): Set up Qlet, Qletx, Qsave_excursion. (Fcall_interactively): Look past those special forms when checking for a call to `list'. Tue Nov 7 02:12:16 1995 Geoff Voelker * config.in [HAVE_X_WINDOWS] (HAVE_WINDOW_SYSTEM): New macro. * s/windowsnt.h [HAVE_NTGUI] (HAVE_WINDOW_SYSTEM): New macro. * dispextern.h dispnew.c, emacs.c, frame.c, keyboard.c, process.c, scroll.c, sysdep.c, window.c, xdisp.c: Use HAVE_WINDOW_SYSTEM instead of testing for specific window systems. * frame.h [HAVE_X_WINDOWS] (FRAME_WINDOW_P): Macro defined. [HAVE_NTGUI] (FRAME_WINDOW_P): Macro defined. * dispnew.c, frame.c, scroll.c, xdisp.c: Use FRAME_WINDOW_P instead of testing for specific window system frames. * xdisp.c (update_menu_bar, redisplay_window): Test for definition of FRAME_EXTERNAL_MENU_BAR before using it. Mon Nov 6 15:52:37 1995 Kevin Gallo * xterm.h (FRAME_INTERNAL_BORDER_WIDTH, FRAME_LINE_HEIGHT): New macros. * dispnew.c (update_frame): Use FRAME_INTERNAL_BORDER_WIDTH. (update_line): Use FRAME_LINE_HEIGHT and FRAME_FONT. * xdisp.c [HAVE_NTGUI] (set_menu_framebar): Declare external. [HAVE_NTGUI] (frame_title_buf, frame_title_ptr): Include variables for Win32 window system. [HAVE_NTGUI] (store_frame_title, x_consider_frame_title): Include procedures for Win32 window system. [HAVE_NTGUI] (x_consider_frame_title): Test for Win32 frame. [HAVE_NTGUI] (display_text_line): Test for Win32 frame on face change. [HAVE_NTGUI] (display_menu_bar): Perform no-op for NT window system. * window.c [HAVE_NTGUI] (Fset_window_configuration): Set menu bar lines. * term.c [HAVE_NTGUI] (FRAME_TERMCAP_P): Don't redefine. * sysdep.c [HAVE_NTGUI] (init_sys_modes, reset_sys_modes): Don't initialize terminal mode when using window system. [HAVE_NTGUI] (BUFFER_SIZE_FACTOR): Increase for use with window system. * scroll.c [HAVE_NTGUI] (do_scrolling, do_direct_scrolling): Update frame geometry. * process.c [HAVE_NTGUI] (POLL_FOR_INPUT): Define macro. * keyboard.c [HAVE_NTGUI]: Include w32term.h. [HAVE_NTGUI] (KBD_BUFFER_SIZE): Increase for NT window system. [HAVE_NTGUI] (POLL_FOR_INPUT): Define. [HAVE_NTGUI] (kbd_buffer_get_event): Enable windowing and menu events. [HAVE_NTGUI] (lispy_function_keys): Define array for NT. [HAVE_NTGUI] (make_lispy_event): Enable menu bar events. [HAVE_NTGUI] (modify_event_symbol): Map symbol to keysym. [HAVE_NTGUI] (read_char_x_menu_prompt): Display menus. (FUNCTION_KEY_OFFSET): New macro. (make_lispy_event): Use FUNCTION_KEY_OFFSET to modify event codes before applying modifiers. * frame.c [HAVE_NTGUI]: Test for a Win32 frame in procedures that test for an X frame. * frame.h (output_method): New method: output_win32. (output_data): New data: win32. (FRAME_WIN32_P): New macro. [HAVE_NTGUI] (external_menu_bar): Define variable. [HAVE_NTGUI] (FRAME_EXTERNAL_MENU_BAR): Defined macro. * fns.c [HAVE_NTGUI] (Fy_or_n_p, Fyes_or_no_p): Allow popup. * emacs.c [HAVE_NTGUI]: Declare Vwindow_system. [HAVE_NTGUI] (main): Enable inhibit_window_system. Initialize environment from registry. Declare syms of Win32 windowing modules. * dispnew.c [HAVE_NTGUI]: Include w32term.h. Include dispextern.h before cm.h since dispextern.h includes windows.h. [HAVE_NTGUI] (make_frame_glyphs, free_frame_glyphs, scroll_frame_lines, update_frame, update_line): Test for WIN32 frame. [HAVE_NTGUI] (init_display): Initialize WIN32 window system. * dispextern.h [HAVE_NTGUI]: Include win32.h. [HAVE_NTGUI] (struct frame_glyphs): Include pixel fields. * w32term.c, w32xfns.c, w32fns.c, w32faces.c, w32select.c, w32menu.c, w32reg.c, win32.h: New files. * s/windowsnt.h [HAVE_NTGUI] (abort): New macro. [HAVE_NTGUI] (HAVE_FACES): Defined. * unexnt.c [HAVE_NTGUI] (WinMain): New procedure. [HAVE_NTGUI] (hinst, hprevinst, lpCmdLine, nCmdShow): New variables. [HAVE_NTGUI] (_start): Invoke WinMainCRTStartup. * ntterm.c (nt_ring_bell): Renamed from ring_bell, now global. (initialize_win_nt_display): Use nt_ring_bell. [HAVE_NTGUI] (pixel_to_glyph_coords, glyph_to_pixel_coords): Don't define. * ntproc.c [HAVE_NTGUI] (create_child): Pass handles to children. [HAVE_NTGUI1] (sys_select): Support alternate keyboard handling. * nt.h (nt_get_resource): Prototype defined. * nt.c (nt_get_resource, init_environment): Defined. (prepare_standard_handles, restore_standard_handles) [HAVE_NTGUI]: Don't duplicate or restore standard handles. * makefile.nt (SUBSYSTEM, TLIBW32, TLASTLIB, WIN32OBJ): Defined. (w32term.obj, w32xfns.obj, w32fns.obj w32faces.obj, w32select.obj, w32menu.obj, w32reg.obj): Defined. (LINK_FLAGS): Use SUBSYSTEM. (OBJ1): Remove lastfile.obj. (LIBS, TEMACS): Use TLASTLIB. (LIBS) [NTGUI]: Use TLIBW32 and GUI libs. (EMACS): Remove Win95 conditional. (clean): Remove paths.h. Mon Nov 6 15:06:38 1995 Richard Stallman * xdisp.c (display_string): Detect truncation more carefully. * dispnew.c (update_line): Avoid indexing into obody by -1. * s/hpux9.h (LIBXMU): Never define this. Mon Nov 6 13:31:18 1995 Erik Naggum * print.c (debug_print): Print newline to stderr, too. Sun Nov 5 16:28:43 1995 Richard Stallman * xfaces.c (unload_font): Invalidate computed faces. (unload_color): Likewise. (new_computed_face): Reuse invalidated computed faces. Sat Nov 4 10:40:11 1995 Richard Stallman * indent.c (Fmove_to_column): Doc fix. * buffer.c (Fmake_overlay): New args front-advance and rear-advance. * fileio.c (Fwrite_region): Move the code that writes annotations for empty files. Fri Nov 3 19:04:15 1995 Karl Heuer * msdos.h (struct x_output): Rename from struct x_display. * msdos.c (the_only_x_display): Type is now struct x_output. (internal_terminal_init): frame member is now named output_data. (init_environment): Fix timezone rules. * emacs.c (main): [MSDOS] Call init_gettimeofday. * frame.c [!MULTI_FRAME] (Fmodify_frame_parameters): Add missing declaration and initialization. [MULTI_FRAME] (choose_minibuf_frame): Moved to minibuf.c; now unconditional. * minibuf.c (choose_minibuf_frame): Moved here from frame.c. Wed Nov 1 16:49:13 1995 Richard Stallman * Makefile.in (USE_@X_TOOLKIT_TYPE@): Define here, if appropriate. (THIS_IS_YMAKEFILE): Definition deleted. Tue Oct 31 19:03:18 1995 Richard Stallman * doprnt.c: Include lisp.h. (doprnt1): Renamed from doprnt. New arg LISPSTRINGS. This is now a static subroutine. (doprnt): New definition calls doprnt1. (doprnt_lisp): New function. * editfns.c (Fformat): Use doprnt_lisp. * s/dgux.h: Test NOT_C_CODE instead of THIS_IS_YMAKEFILE. Get fatal error if not using GCC. * xdisp.c (redisplay_window): On non-X frame, always use FRAME_MENU_BAR_LINES as criterion for whether to display menu bar. (update_menu_bar): Likewise. (display_menu_bar): Do the work here for non-X frames regardless of USE_X_TOOLKIT. * m/alpha.h: Don't test THIS_IS_YMAKEFILE. * s/usg5-4.h: Always include sys/wait.h unless NOT_C_CODE; don't test #ifdef emacs for that. Tue Oct 31 12:11:36 1995 Karl Heuer * m/7300.h, m/acorn.h, m/alliant-2800.h, m/alliant.h, m/altos.h: * m/amdahl.h, m/apollo.h, m/att3b.h, m/aviion.h, m/celerity.h: * m/clipper.h, m/cnvrgnt.h, m/cydra5.h, m/delta.h, m/delta88k.h: * m/dpx2.h, m/dual.h, m/elxsi.h, m/gec63.h, m/gould.h, m/hp9000s300.h: * m/i860.h, m/ibmps2-aix.h, m/ibmrs6000.h, m/ibmrt-aix.h, m/ibmrt.h: * m/irist.h, m/isi-ov.h, m/masscomp.h, m/mega68.h, m/mg1.h, m/news.h: * m/next.h, m/nh3000.h, m/nh4000.h, m/ns16000.h, m/ns32000.h, m/nu.h: * m/orion.h, m/orion105.h, m/pfa50.h, m/plexus.h, m/pyramid.h: * m/sequent.h, m/sparc.h, m/sps7.h, m/stride.h, m/sun1.h, m/sun2.h: * m/tad68k.h, m/tahoe.h, m/targon31.h, m/tek4300.h, m/tekxd88.h: * m/template.h, m/tower32.h, m/tower32v3.h, m/ustation.h, m/vax.h: * m/wicat.h, m/windowsnt.h, m/xps100.h: (SHORTBITS, INTBITS, LONGBITS): Deleted; now in config.h. Mon Oct 30 21:28:51 1995 Karl Heuer * alloc.c, data.c, doprnt.c, floatfns.c, fns.c, indent.c * insdel.c, lisp.h, lread.c, print.c, xdisp.c, xfaces.c, xterm.c (BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG): Rename from SHORTBITS, INTBITS, LONGBITS. * m/alpha.h, m/convex.h, m/hp800.h, m/intel386.h, m/iris4d.h * m/iris5d.h, m/mips-siemens.h, m/mips.h: (SHORTBITS, INTBITS, LONGBITS): Deleted; now in config.h Used new names for those macros in all references. Mon Oct 30 12:52:49 1995 Richard Stallman * config.in (BITS_PER_CHAR, BITS_PER_INT, BITS_PER_SHORT) (BITS_PER_LONG): Define if not already defined. * print.c (debug_print): Print a newline here. * .gdbinit (pr): Don't print newline here. * syntax.c (check_syntax_table): Check the purpose slot. Use Qsyntax_table_p for the error message. * lisp.h (CHECK_CHAR_TABLE): Don't accept nil. * Makefile.in (prefix-args): Use LDFLAGS, not ALL_LDFLAGS. * unexalpha.c (fatal_unexec): Don't use varargs. * editfns.c (Fencode_time): Add cast. (Fset_time_zone_rule): Add cast. * xterm.h: Move the include of Xlocale.h after setting HAVE_X11R5. * keyboard.c (command_loop_1): Test pre- and post-command hooks for non-nil-ness by looking at the V... variable. Sun Oct 29 17:02:58 1995 Andreas Schwab * m/m68k.h [linux]: Define NO_REMAP and TEXT_START, and also DATA_SEG_BITS if compiling for ELF. (HAVE_ALLOCA, alloca): Define if compiling with GCC. * keymap.c (describe_translation): Insert newline after key description. * fns.c (Fsafe_length): Add missing parentheses around & within comparison. * minibuf.c (temp_echo_area_glyphs): Only delete the temporary message. Sun Oct 29 14:00:09 1995 Richard Stallman * syssignal.h [POSIX_SIGNALS] (signal): Undef before defining. * unexelfsgi.c (find_section): New arg old_section_h. Rename file_h to old_file_h and fix type. Calls changed. * syntax.c (Fmodify_syntax_entry): Don't fail to init MATCH. * lisp.h (PVEC_TYPE_MASK): Remove the 0x100 bit. * keyboard.c (command_loop_1): No direct display if Column Number mode. (Vcolumn_number_mode): New variable. (syms_of_keyboard): Set up Lisp variable. * marker.c (Fset_marker_insertion_type): Doc fix. * alloc.c (Fmake_char_table): Doc fix. * casetab.c (Fset_case_table): Doc fix. * alloc.c: Cast first arg to bzero. Sat Oct 28 11:15:20 1995 Richard Stallman * xterm.h (FRAME_XIC): Fix wrong field name. * alloc.c (Fmemory_use_counts): Cast 1 to EMACS_INT before shift. * eval.c (run_hook_with_args): Add forward declaration. Fri Oct 27 16:23:30 1995 Richard Stallman * Makefile.in (TAGS): Separate export DIR=`pwd` into two commands. * syntax.h (SYNTAX, SYNTAX_WITH_FLAGS, SYNTAX_MATCH): Fix the non-GCC definitions. * callint.c (Fcall_interactively): New arg KEYS. * keyboard.c (Fcommand_execute): New arg KEYS. Callers changed. (read_char): Specify KEYS when handling Vspecial_event_map. Thu Oct 26 15:03:54 1995 Richard Stallman * msdos.c (IT_ring_bell): Use intdos, not write. Wed Oct 25 15:19:08 1995 Karl Heuer * data.c [!HAVE_FMOD] (fmod): Make consistent with ANSI definition. Don't use drem; it's not the same function. Tue Oct 24 12:29:33 1995 Richard Stallman * s/linux.h (REGEXP_IN_LIBC): Definition turned off. * minibuf.c (syms_of_minibuf): Doc fix. Mon Oct 23 00:32:39 1995 Erik Naggum * fns.c (map_char_table): Map over only CHAR_TABLE_ORDINARY_SLOTS slots, not vector size. * casetab.c (Fcase_table_p, Fcurrent_case_table): Delete unused local variables. (set_case_table): Delete obsolete local variable `down', use `table' where referenced. Fix assignment to `canon' when nil. Store eqv in extras[2], not extras[0]. (init_casetab_once): Case-tables have 3 extra slots, not 4. Sun Oct 22 12:39:41 1995 Richard Stallman * msdos.c (recent_doskeys_index, total_doskeys, recent_doskeys): New variables. (Frecent_doskeys): New function. (syms_of_msdos): New function. * search.c (string_match_1): Pass the POSIX arg to compile_pattern. * keyboard.c (ok_to_echo_at_next_pause): Make it a char *. (read_char): Copy and compare with echo_area_glyphs. * buffer.c (reset_buffer_local_variables): Call Fset_standard_case_table if std case table seems to have been changed. Sat Oct 21 13:04:57 1995 Richard Stallman * buffer.c (reset_buffer): Initialize redisplay_end_trigger slot. Initialize extra1, extra2 and extra3 slots. * textprop.c (Fnext_single_property_change): Rearrange handling of limit = t; don't return t. * xdisp.c (try_window_id): Stop the compute_motion at ZV, not Z, when checking if all changes are below the window. * keyboard.c (read_char): If we reread a char, the next pause can start echoing despite a remaining echo area message. (ok_to_echo_at_next_pause): New variable. (cancel_echoing): Clear ok_to_echo_at_next_pause. Fri Oct 20 19:20:42 1995 Richard Stallman * xdisp.c (Qredisplay_end_trigger_hook): New variable. (syms_of_xdisp): Set up Lisp variable. (display_text_line): Run the hook when appropriate. * buffer.c (init_buffer_once): Mark redisplay_end_trigger always local. Also fix previous change. (syms_of_buffer): Set up Lisp var buffer-redisplay-end-trigger. * buffer.h (struct buffer): New slot redisplay_end_trigger. Also extra1, extra2, extra3. Thu Oct 19 09:36:12 1995 Erik Naggum * fns.c (Fmap_char_table): Call map_char_table with correct args. Wed Oct 18 16:44:29 1995 Richard Stallman * config.in (RE_TRANSLATE_TYPE): New definition. * casetab.c: Case tables are now char-tables, and the case table is stored in the downcase_table slot only. (Fcurrent_case_table, Fstandard_case_table, set_case_table) (compute_trt_inverse, init_casetab_once): Use new data format. * buffer.c (reset_buffer_local_variables): Get the up, eqv and canon tables from within the down case table. * editfns.c (Fchar_equal): Handle char-table as case table. * fns.c (Fchar_table_subtype): New function. (syms_of_fns): defsube it. * fns.c (map_char_table): When possible, use a number to describe the range. * doc.c (Fsubstitute_command_keys): Pass new arg to describe_map_tree. * keymap.c (describe_map_tree): New arg always_title. Callers changed. * search.c (compile_pattern_1, compile_pattern, search_buffer): Case tables are char-tables now. Mon Oct 16 17:35:25 1995 Richard Stallman * lisp.h (UPCASE_TABLE): Definition deleted. (UPPERCASEP, LOWERCASEP, NOCASEP, UPCASE, UPCASE1, DOWNCASE) (DOWNCASE_TABLE): Case tables are now char-tables. (Vascii_upcase_table, Vascii_canon_table, Vascii_eqv_table): Declarations deleted. * keyboard.c (read_char): Let Vkeyboard_translate_table be char-table. (syms_of_keyboard): Doc fix. Sun Oct 15 12:05:50 1995 Richard Stallman * lread.c (read1): Handle #' as prefix. (Qfunction): New variable. (syms_of_lread): Set up Qfunction. * fns.c (Fchar_table_range): New function. (syms_of_fns): defsubr it. Sat Oct 14 20:57:54 1995 Richard Stallman * unexelfsgi.c (find_section): New function. (unexec): Use it. Also simplify previous changes. Fri Oct 13 21:31:43 1995 Richard Stallman * unexelfsgi.c (unexec): Find the old data section. New variable new_offsets_shift used instead of new_data2_size since they are not always the same. Simplify logic for copying the headers and inserting new ones. * xterm.c (x_term_init, XTread_socket): Add HAVE_X_I18N support. * xfns.c (x_window, both versions): Add HAVE_X_I18N support. Thu Oct 12 11:44:24 1995 Richard Stallman * xterm.h (HAVE_X_I18N): New macro. Maybe include Xlocale.h. (struct x_output): New field xic. (FRAME_XIC): New macro. * window.c (Fdelete_other_windows): Set w->force_start. * xdisp.c (syms_of_xdisp): Doc fix. Wed Oct 11 13:01:50 1995 Richard Stallman * fileio.c (Finsert_file_contents): If replacing, set selected_window->start_at_line_beg. Wed Oct 11 15:12:35 1995 Kim Storm * keyboard.c (make_lispy_event) [!USE_X_TOOLKIT]: Dragging the mouse into the menu-bar and releasing it there did not create a drag-mouse event. (set-input-mode) [MSDOS]: Do not call reset_sys_modes and init_sys_modes. * dosfns.c (insert-startup-screen): New function. (msdos-memget, msdos-memput): New functions. (msdos-set-keyboard, insert-startup-screen): New functions. (dos-timezone-offset, dos-display-scancodes, dos-menubar-clock, dos-hyper-key, dos-super-key, dos-keypad-mode, dos-keyboard-layout, dos-decimal-point): New variables. * dosfns.h (dos_timezone_offset, dos_display_scancodes, dos_menubar_clock, dos_hyper_key, dos_super_key, dos_keypad_mode, dos_keyboard_layout, dos_decimal_point): New variables. * msdos.c: [!HAVE_X_WINDOWS]: Reworked display code to perform immediate screen output. Added menu-bar clock. Reworked keyboard code to support international keyboards. Improved keypad handling (see dos-keypad-mode). Properly distinguish between C-end and C-kp-1 etc. Corrected M-return & M-kp-enter. Added support for hyper and super keys. Reworked mouse code to avoid mouse flicker. Saves and restores DOS-screen prior to emacs startup. (sys_select): Would abort if rfds = NULL. (dos_direct_output): New function. (dos_dump_scancodes): New variable. * msdos.h (internal_flush): Removed (mouse_init1, mouse_check_moved, mouse_pressed, mouse_released): Removed. (dos_get_saved_screen, dos_set_keyboard): New functions. * s/msdos.h: Check that DJGPP v. 1 is used. Define __DJGPP__ to 1. Simplified INTERNAL_TERMINAL termcap definition. Removed #define fflush internal_flush. * sysdep.c: (init_sys_modes) [!HAVE_X_WINDOWS (MSDOS)]: Always call set_terminal_modes. (reset_sys_modes) [MSDOS]: Do not look at EMACSCOLORS. Wed Oct 11 02:24:27 1995 Richard Stallman * buffer.c (Fkill_buffer): Don't kill auto save file if not recent. * keymap.c (describe_vector): Support nested char-tables. Tue Oct 10 12:26:49 1995 Richard Stallman * Give char-tables a new slot `purpose'. * lisp.h (struct Lisp_Char_Table): New slot `purpose'. (CHAR_TABLE_STANDARD_SLOTS): Add one. * alloc.c (Qchar_table_extra_slots): New variable. (syms_of_alloc): Initialize it. (Fmake_char_table): Take new arg PURPOSE and get N from a property. * fns.c (Fcopy_sequence): Call Fmake_char_table the new way. (map_char_table): No longer static. New arg C_FUNCTION. (Fmap_char_table): Call to map_char_table changed. (Fset_char_table_parent): Allow nil s new parent. Fix the code that checks for a loop in parents. * syntax.c (Qsyntax_table): New variable. (init_syntax_once): Call Fmake_char_table the new way. Set up Qsyntax_table. (Fsyntax_table_p): Check the `purpose' field. * disptab.h (DISP_TABLE_P): Check the `purpose' slot. (Qdisplay_table): Declared. * dispnew.c (Qdisplay_table): New variable. (syms_of_display): Initialize it. Mon Oct 9 17:05:16 1995 Richard Stallman * data.c (Qvector_or_char_table_p): New variable. (Fvector_or_char_table_p): New function. (syms_of_data): Set up Lisp var and function. * lisp.h (CHECK_VECTOR_OR_CHAR_TABLE): New macro. Mon Oct 9 16:51:42 1995 Erik Naggum * buffer.c (buffer-display-table): Document new implementation. Mon Oct 9 12:26:25 1995 Richard Stallman * minibuf.c (temp_echo_area_glyphs): Restore the old point value. Sun Oct 8 15:25:18 1995 Richard Stallman * process.c (exec_sentinel, read_process_output): Call record_asynch_buffer_change only if caller is reading kbd input. * buffer.c (init_buffer_once): Make file_format always local, not just local when set. Sat Oct 7 22:55:46 1995 Erik Naggum * alloc.c (Fmake_char_table): Initialize parent to nil. Sat Oct 7 12:06:49 1995 Richard Stallman * keyboard.c (command_loop_1): Access display tables as char-tables. * indent.c (buffer_display_table): Use DISP_TABLE_P. Return type struct Lisp_Char_Table * since display tables are now char-tables. (character_width, disptab_matches_widthtab, recompute_width_table) (current_column, Fmove_to_column, compute_motion): Corresponding changes. * window.c (window_display_table): Use DISP_TABLE_P. Return type struct Lisp_Char_Table * since display tables are now char-tables. * xdisp.c (redisplay_window, redisplay_window, display_text_line): Fix up calls to window_display_table. Access display tables as char-tables. * disptab.h (DISP_TABLE_EXTRA_SLOTS, DISP_TABLE_P): New macros. (DISP_TRUNC_GLYPH, DISP_CONTINUE_GLYPH, DISP_ESCAPE_GLYPH) (DISP_CTRL_GLYPH, DISP_INVIS_VECTOR, DISP_BORDER_GLYPH): Use the `extras' field. (window_display_table, buffer_display_table): Change return type. * keymap.c (describe_vector): Use Flength to get length of vector. * Makefile.in (bytecode.o): Depend on syntax.h. Fri Oct 6 15:33:24 1995 Richard Stallman * syntax.c (describe_syntax): Handle new syntax-table data format. (Fmodify_syntax_entry, init_syntax_once): Use SET_RAW_SYNTAX_ENTRY. Handle new syntax-table data format. (check_syntax_table): Use CHECK_CHAR_TABLE. Now static. Don't return anything; callers changed. (Fcopy_syntax_table): Use Fcopy_sequence. (Fchar_syntax, Fmatching_paren, Fforward_comment): Copy complex args to SYNTAX into variables before using them. (Fsyntax_table_p): Accept any char-table. (syntax_parent_lookup): New function. (syntax_temp): New variable. * syntax.h: Use char tables as syntax tables. (RAW_SYNTAX, RAW_SYNTAX_MATCH): Macros deleted. (RAW_SYNTAX_ENTRY, SET_RAW_SYNTAX_ENTRY): New macros. (SYNTAX, SYNTAX_MATCH): Rewritten. (SYNTAX_ENTRY, SYNTAX_WITH_FLAGS): New macros. (SYNTAX_COMSTART_SECOND, SYNTAX_COMEND_FIRST, SYNTAX_COMEND_SECOND) (SYNTAX_PREFIX, SYNTAX_COMMENT_STYLE): Use SYNTAX_WITH_FLAGS. * callint.c (callint_message, callint_message_size): New vars. (syms_of_callint): Set up new vars. (Fcall_interactively): Keep the prompt in the heap. Thu Oct 5 19:14:59 1995 Richard Stallman * window.c (Fset_window_hscroll): Don't reject args > SHORTBITS. * indent.c (Fmove_to_column): Make it interactive. Wed Oct 4 11:45:53 1995 Richard Stallman * lisp.h (struct Lisp_Char_Table): New structure. (CHAR_TABLE_STANDARD_SLOTS, CHAR_TABLE_ORDINARY_SLOTS): New macros. (CHAR_TABLE_EXTRA_SLOTS): New macro. * buffer.c (Fmake_indirect_buffer): Was taking marker positions from current buffer, which is irrelevant. (init_buffer_once): Make buffer-file-format always local. Tue Oct 3 05:08:53 1995 Richard Stallman * unexec.c (write_segment): Write valid data in units of 1<<13, but write zeros only a page at a time. * window.c (window_scroll): Always set force_start. Mon Oct 2 11:52:24 1995 Richard Stallman * eval.c (run_hook_with_args_2): New function. * unexec.c (write_segment): Use pagesize as unit of writing instead of 128. * lisp.h (CHECK_CHAR_TABLE): New macro. * frame.c (Qmouse_leave_buffer_hook): New variable. (syms_of_frame_1): Initialize it. (Fhandle_switch_frame): Run the hooks. * keyboard.c (Vsuggest_key_bindings): New variable. (syms_of_keyboard): Set up Lisp variable. (Fexecute_extended_command): When enabled, show an equivalent key binding. Sun Oct 1 00:11:20 1995 Richard Stallman * xterm.c (x_connection_signal_1): New function. (x_connection_signal): Try all the server connections to see which one was lost. Fri Sep 29 00:12:53 1995 Richard Stallman * xdisp.c (Qwindow_scroll_functions, Vwindow_scroll_functions): New variables. (syms_of_xdisp): Initialize them. (redisplay_window): Call the functions when appropriate. * xterm.c (XTcondemn_scroll_bars): No error if FRAME_CONDEMNED_SCROLL_BARS is non-nil already. Just move all the scroll bars into there. * dispnew.c (get_display_line): Don't abort if there's text in the line to the right beyond HPOS. (quit_error_check): Make this a no-op. * fileio.c (barf_or_query_if_file_exists): New arg STATPTR. Callers changed. (Fcopy_file): Error if input and output are the same file. Thu Sep 28 19:02:17 1995 Carsten Bormann * m/ibmrs6000.h: Add early support for Solaris 2.5 on PowerPCs. [USG5_4] (CANNOT_DUMP): Define this if USG5_4. (UNEXEC): Don't define if already defined. [USG5_4] (DATA_SEG_BITS, LIBS_MACHINE): Alternate definitions. (C_SWITCH_MACHINE, LD_SWITCH_MACHINE, NLIST_STRUCT, WORDS_BIG_ENDIAN) (TEXT_START, DATA_START, TEXT_END, DATA_END): Don't define, if USG5_4. Wed Sep 27 16:16:38 1995 Richard Stallman * lisp.h (pvec_type): Add PVEC_CHARTABLE and PVEC_BOOLVECTOR. Move PVEC_BUFFER to a higher bit. (CHARTABLEP, GC_CHARTABLEP, XSETCHARTABLE, XCHARTABLE): New macros. (XBOOLVECTOR, XSETBOOLVECTOR, BOOLVECTORP, GC_BOOLVECTORP): New macros. (struct Lisp_Boolvector): New data type. * lread.c (read1): Handle chartables and boolvectors. * print.c (print): Handle chartables and boolvectors. (print_boolvector): New function. * data.c (Fchartablep, Fboolvectorp): New functions. (syms_of_data): defsubr them. (Faref, Faset, Fsequencep): Handle chartables and boolvectors. * fns.c (Fset_char_table_range): New function. (make_char_table, Fmap_char_table): New function. (Fchar_table_extra_slot, Fset_char_table_extra_slot): New functions. * fns.c (Fcopy_sequence, Felt, internal_equal, Ffillarray): Handle chartables and boolvectors. (Flength, concat): Handle boolvectors as args. (Flength): Handle chartables as args. * alloc.c (Fmake_chartable, Fmake_boolvector): New functions. (syms_of_alloc): defsubr them. * buffer.c (Fmake_overlay): Set end-marker's insertion_type to 1. Fri Sep 22 14:34:22 1995 Richard Stallman * xfns.c (Fx_create_frame): Set up buffer-predicate slot. * gmalloc.c (current_core_address): New function. (_malloc_internal): Use current_core_address. (morecore): Avoid using __morecore (0). * ralloc.c (r_alloc_sbrk): Round up amount being returned. Wed Sep 20 03:27:58 1995 Paul Eggert * msdos.c (gettimeofday, init_gettimeofday, daylight, gmtoffset): Undo previous change to msdos.c. (init_environment): No need to call tzset and init_gettimeofday, since `main' now does that for us. (gettimeofday): Ignore tzp; it's obsolescent. (init_gettimeofday): Invoke tzset first. * s/msdos.h (LOCALTIME_CACHE, tzset): New macros. Sun Sep 17 10:28:39 1995 Richard Stallman * xfns.c (x_decode_color): Get error if color not defined. * xmenu.c (popup_get_selection): Pop menu down if button is pressed outside the menu. * minibuf.c (read_minibuf_unwind): Use safe_run_hooks. * keyboard.c (safe_run_hooks): No longer static. * keyboard.c (read_char_x_menu_prompt): When unreading events generated by a menu, turn symbols and integers into lists, for the sake of last_nonmenu_event and thus y-or-n-p. Fri Sep 15 12:45:31 1995 Richard Stallman * lread.c (Fload): Rename arg STR to FILE. Thu Sep 14 03:11:15 1995 Richard Stallman * ralloc.c (r_alloc_sbrk): Get the right heap data address in multi-heap case. Tue Sep 12 13:33:31 1995 Karl Heuer * s/isc2-2.h (BROKEN_SELECT_NON_X): Define this instead of turning off HAVE_SELECT. * s/isc3-0.h (BROKEN_SELECT_NON_X): Moved to s/isc2-2.h. (HAVE_SELECT): Deleted; s/isc2-2.h no longer undefs this. Tue Sep 12 01:39:15 1995 Richard Stallman * insdel.c (signal_after_change): Call report_interval_modification. * textprop.c (call_mod_hooks): Moved from intevals.c (verify_interval_modification): Moved from intervals.c. (interval_insert_behind_hooks, interval_insert_in_front_hooks): New variables. (report_interval_modification): New function. * intervals.c (call_mod_hooks, verify_interval_modification): Functions moved to textprop.c. Sun Sep 10 20:12:36 1995 Richard Stallman * xmenu.c (xmenu_show): Ignore `quote' when looking up the result. Sun Sep 10 04:06:23 1995 Paul Eggert * editfns.c (Fencode_time): Use mktime to do the real work; this fixes bugs involving out-of-range dates and leap seconds, and allows date arithmetic via out-of-range values for arguments. Allow the ZONE parameter to be a TZ-style string. Doc string fix: `1900' -> `this century'. (set_time_zone_rule): New function. (Fset_time_zone_rule): Use it. (environ, make_time): Add extern declarations. (days_per_month): Remove. Sat Sep 9 15:31:15 1995 Richard Stallman * keyboard.c (command_loop_1): Set this_command to nil before reading a command. * editfns.c (Fdecode_time): Doc fix. Fri Sep 8 12:24:20 1995 Richard Stallman * m/apollo.h (HAVE_UNISTD_H): Add #undef. Thu Sep 7 06:12:50 1995 Paul Eggert * editfns.c (Fset_time_zone_rule): New function. (syms_of_editfns): defsubr it. * msdos.c (gettimeofday): Don't bother setting time zone, since nobody uses it, and our hacks to get it get in the way of the above fix. Use simpler method for getting time stamp. (init_gettimeofday, daylight, gmtoffset): Remove. * msdos.h (init_gettimeofday): Remove declaration. Wed Sep 6 04:25:50 1995 Paul Eggert * configure.in (LOCALTIME_CACHE): Define if tzset exists and if localtime caches TZ. Check for tzset. * emacs.c (main): Call tzset only if LOCALTIME_CACHE is defined; not all Suns have this bug. * m/pmax.h, s/386bsd.h, s/bsd386.h, s/freebsd.h, s/gnu.h, s/netbsd.h (LOCALTIME_CACHE): Remove; now configured automatically. Wed Sep 6 03:41:34 1995 Erik Naggum * alloc.c (Fmake_marker): Initialize insertion_type to 0. Sun Sep 3 13:28:58 1995 Richard Stallman * insdel.c (adjust_markers_for_insert): New function. (insert_from_buffer_1, insert_from_string_1, insert_1): Call it. Fri Sep 1 21:19:14 1995 Richard Stallman * fileio.c (Fmake_symbolic_link, Fadd_name_to_file): Look for handler for the new name as well as for the target. * dired.c (Ffile_name_all_completions, Ffile_name_completion): Look for handler for FILE as well as for DIRNAME. Thu Aug 31 22:00:41 1995 Richard Stallman * marker.c (Fcopy_marker): New arg TYPE. (Fmarker_insertion_type, Fset_marker_insertion_type): New functions. (syms_of_marker): defsubr them. * buffer.c (Fmake_indirect_buffer): Set the insertion_type of the zv_marker markers to 1. * window.c (save_window_save): Pass the new arg to Fcopy_marker. * editfns.c (save_excursion_save): Pass the new arg to Fcopy_marker. Thu Aug 31 20:58:21 1995 Erik Naggum * keyboard.c (Fcommand_execute): Ignore `disabled' property on commands if `disable-command-hook' is nil. Wed Aug 30 11:56:09 1995 Richard Stallman * keyboard.c (read_key_sequence): Validate the event position before calling get_local_map. Tue Aug 29 14:56:45 1995 Jack Repenning * unexelfsgi.c: Compute new data offset based on memory address; also, copy .got from memory not temacs. Tue Aug 29 17:50:16 1995 Kim Storm * dosfns.c (Fmsdos_mouse_enable, Fmsdos_mouse_disable) (Fmsdos_mouse_init): New functions. (syms_of_dosfns): defsubr them. (Fmode25, Fmode4350): Call mouse_off unconditionally. (Fset_mouse_position): Return nil. * msdos.h (sleep_or_kbd_init): Delete declaration. * frame.c [!MULTI_FRAME] (Factive_minibuffer_window): New function. [!MULTI_FRAME] (syms_of_frame): defsubr it. * sysdep.c (sys_subshell) [MSDOS]: Handle SUSPEND env var. Disable error report from subshell if system returns non-zero. Don't call vfork before calling system. Don't call wait_for_termination. (sys_select): Turn it off if MSDOS. (reset_sys_modes): Support EMACSCOLORS env var. * puresize.h (SITELOAD_PURESIZE_EXTRA): New macro. (BASE_PURESIZE): Use SITELOAD_PURESIZE_EXTRA. * msdos.c (putchar): Call internal_flush instead of _flsbuf. (DO_TERMSCRIPT): New macro to support open-termscript. (internal_flush): Corrected handling of flush in middle of escape sequences. Handle screen width > 127. (flush_escape): New function for use by internal_flush. (sys_select): New MS-DOS specific version with us timing. (EMACSCOLORS): New environment variable. (IT_clear_end_of_line): Set default face. (run_msdos_command): Restore mouse position after command. Close "backup fd"s. Corrected switch to cooked mode while running command. (mouse_on, mouse_off): Now checks have_mouse > 0. Note: "have_mouse < 0" means that a mouse is present, but it has been disabled via msdos-mouse-disable. (IT_write_glyphs): Allow esc-character itself to be printed. (event_timestamp): New function to make reliable times stamps. (sys_chdir): Skip drive letter before calling chdir. (sleep_or_kbd_hit): Handle 60 seconds time wrap. (mouse_get_pos): Return event_timestamp. Tue Aug 29 00:34:55 1995 Richard Stallman * msdos.c (struct IT_menu_state): Refer to it as struct, not typedef. * editfns.c (Fdecode_time): Doc fix. * minibuf.c (Fdisplay_completion_list): Clear all text properties for the whitespace between completion items. * xterm.c (x_wm_set_icon_pixmap): If trying to turn off icon pixmap, do nothing. Mon Aug 28 16:38:40 1995 Roland McGrath * s/gnu.h (GETPGRP_NO_ARG, WAIT_USE_INT, UNEXEC): New macros. (HAVE_SOCKETS, A_TEXT_SEEK, NO_REMAP): Macros removed. Sun Aug 27 19:52:53 1995 Richard Stallman * doprnt.c (doprnt): Fix typo in error message. Sat Aug 26 13:09:28 1995 Richard Stallman * emacs.c (decode_env_path): Use ".", not nil, for current dir. Tue Aug 22 17:00:39 1995 Richard Stallman * keyboard.c (modifier_names): Add 4 bits to modifier bit positions. Mon Aug 21 20:27:37 1995 Karl Heuer * xdisp.c (display_text_line): Write blanks under the entire scroll bar, not just the first column. Mon Aug 21 15:20:39 1995 Richard Stallman * s/irix5-2.h (SA_RESTART): Add #undef. * keyboard.c: (Qpost_command_idle_hook, Vpost_command_idle_hook): New vars. (syms_of_keyboard): Set up new vars. (command_loop_1): Run Qpost_command_idle_hook. Sun Aug 20 11:45:10 1995 Richard Stallman * s/aix3-1.h (SYSTEM_TYPE): Change to just "aix". * s/aix4.h: Include aix3-2-5.h, not aix3-2.h. * s/aix4-1.h (sigsetmask, _setjmp, _longjmp): Delete undefs. [__GNUC__] (_NO_PROTO): Add undef. * s/aix3-2-5.h (POSIX_SIGNALS, CLASH_DETECTION): Defined. (SIGNALS_VIA_CHARACTERS, MAIL_USE_LOCKF): Defined. (sigmask, sigsetmask, _setjmp, _longjmp): Add undefs. Sat Aug 19 01:38:16 1995 Richard Stallman * dispnew.c: Include syssignal.h. * lisp.h (struct Lisp_Marker): Make insertion_type an unsigned int. Wed Aug 16 15:27:26 1995 Richard Stallman * syntax.c (scan_sexps_forward): Fix previous change. Tue Aug 15 14:46:52 1995 Karl Heuer * emacs.c (sort_args): Initialize best_priority smaller than any actual priority. Mon Aug 14 13:12:24 1995 Richard Stallman * fileio.c (Fwrite_region): New arg lockname. (auto_save_1): Pass new arg. * callproc.c (Fcall_process_region): Pass new arg to Fwrite_region. * emacs.c (standard_args): Fix previous change. Mon Aug 14 12:01:33 1995 Erik Naggum * emacs.c (standard_args): Add option --eval to evalute an expression on the command line and print the result. Mon Aug 14 04:09:24 1995 Richard Stallman * cmds.c (Fself_insert_command): Optimize the case with arg > 2 to avoid running change hooks lots of times. Sun Aug 13 00:56:51 1995 Richard Stallman * s/isc4-1.h (NO_SOCKETS_IN_FILE_SYSTEM): Defined. (START_FILES): Defined. (LIB_STANDARD): New definition, details depending on __GNUC__. * syntax.c (scan_sexps_forward): Use the initial depth in the starting state for tracking when we reach TARGETDEPTH. Fri Aug 11 18:35:14 1995 Richard Stallman * m/alpha.h: Test OSF1, not __osf1__. (ORDINARY_LINK): Define only if OSF1. (PTY_ITERATION, PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF, PTY_OPEN): Define only if OSF1. (TEXT_END, DATA_END): Fix the definitions. Thu Aug 10 00:48:40 1995 Richard Stallman * s/linux.h (ULIMIT_BREAK_VALUE, SEGMENT_MASK): Moved to intel386.h (LIBS_SYSTEM): Define this instead of LIBS_MACHINE. * m/intel386.h [linux] (ULIMIT_BREAK_VALUE, SEGMENT_MASK): Moved from linux.h. * m/alpha.h [linux] (COFF, NO_TERMIO): Defined. [linux] (TEXT_END, DATA_END): New definitions. * unexalpha.c (fatal_unexec): Use vfprintf, not _doprnt. * m/alpha.h (LIBS_DEBUG, START_FILES, LIBS_MACHINE): Define only if __osf1__. * macros.c (Fcancel_kbd_macro_events): New function. (syms_of_macros): defsubr it. * frame.c (store_frame_param): Don't call set_menu_bar_lines if X. Mon Aug 7 18:51:11 1995 Richard Stallman * keyboard.c (read_key_sequence): Undo previous change. Instead, put back the orig_uppercase event if key is not defined. When downcasing, back up one step in key-translation processing. * doprnt.c (doprnt): Error if %-width is too big. * editfns.c (Fformat): Limit minlen to avoid stack overflow. Mon Aug 7 13:48:47 1995 Karl Heuer * insdel.c (signal_before_change, signal_after_change): Fix spelling of Vbefore_change_functions and Vafter_change_functions. Mon Aug 7 13:51:48 1995 Richard Stallman * doprnt.c (doprnt): Don't let size_bound be gigantic. Fix error message. Sun Aug 6 01:02:06 1995 Richard Stallman * buffer.c (get_truename_buffer): New function. * filelock.c (lock_file): Use get_truename_buffer. * emacs.c (main) [USG5]: Call setpgrp without testing INTERRUPT_INPUT. * xdisp.c (redisplay): Compute mini_frame the same way echo_area_display does. * keyboard.c (kbd_buffer_store_event): Don't insert two buffer_switch_event's in a row. * xfns.c (x_set_menu_bar_lines) [USE_X_TOOLKIT]: When turning menu bar on, make sure next redisplay creates it. * eval.c (run_hook_with_args): Move the GCPRO2; add UNGCPRO. * process.c (read_process_output, exec_sentinel): Call record_asynch_buffer_change after any eval. Don't call prepare_menu_bars. (wait_reading_process_input): Don't call prepare_menu_bars. Sat Aug 5 01:04:16 1995 Richard Stallman * search.c (Freplace_match): New arg SUBEXP. * eval.c (run_hook_with_args): Add gcpros. * print.c (print_string): Use insert_from_string for output to buffer. * minibuf.c (Fdisplay_completion_list): gcpro elt. * insdel.c (signal_before_change, signal_after_change): Major rewrite. (before_change_function_restore, after_change_function_restore) (before_change_functions_restore, after_change_functions_restore): Functions deleted. * eval.c (run_hook_list_with_args): New function. * buffer.c (Qbefore_change_functions, Qafter_change_functions): New variables. (syms_of_buffer): Initialize them. * buffer.h (Qbefore_change_functions, Qafter_change_functions): Declared. * frame.c (Fset_mouse_position, Fset_mouse_pixel_position): Doc fixes. [not MULTI_FRAME] (Fframe_visible_p): New function. [not MULTI_FRAME] (syms_of_frame): defsubr it. * xfns.c (Ffocus_frame, Funfocus_frame): Make them no-ops. Fri Aug 4 15:38:18 1995 Richard Stallman * xterm.c (x_delete_display) [AIX]: Don't call XRmDestroyDatabase. * msdos.c (IT_write_glyphs): Call ScreenSetCursor. * lread.c (saved_doc_string*): New variables. (load_force_doc_strings): New variable. (syms_of_lread): Set up Lisp var load-force-doc-strings. (read_list): Handle load_force_doc_strings. Use the saved_doc_string, if it's right; otherwise, reread from file. (read1): Save last doc string in saved_doc_string. Thu Aug 3 04:28:29 1995 Richard Stallman * frame.c (set_menu_bar_lines, set_menu_bar_lines_1): New functions. (store_frame_parameter): Call set_menu_bar_lines. [!MULTI_FRAME] (Fmodify_frame_parameters): Call set_menu_bar_lines. * frame.c: Move various Q... vars to top of file, unconditional. (Vterminal_frame): Just one definition, at top of file, unconditional. (syms_of_frame_1): New function. (syms_of_frame. both definitions): Call syms_of_frame_1. Wed Aug 2 00:14:16 1995 Richard Stallman * keyboard.c (read_key_sequence): Don't downshift an event if that fails to make it bound. (follow_key): Don't alter contents of NEXT until the end. * xmenu.c [USE_X_TOOLKIT] (xmenu_show): Compute root-based coordinates. Make a dummy event to pass them to lw_popup_menu. * lread.c (Funintern): Fix deleting the last symbol in a chain. Tue Aug 1 03:19:17 1995 Richard Stallman * xdisp.c (redisplay): When displaying a terminal frame, if it isn't the same one as last time, clear it and redraw. Don't redisplay mini_frame as well, if it is a termcap frame. * frame.c (do_switch_frame): Do nothing special when switching between terminal frames. Mon Jul 31 14:17:30 1995 Karl Heuer * s/usg5-4.h, s/sol2-5.h (GETTIMEOFDAY_ONE_ARGUMENT): Deleted; configure handles this now. Mon Jul 31 06:04:12 1995 Simon Marshall * eval.c (run_hook_with_args): Renamed from Frun_hook_with_args. Take extra arg CONDITION, and return appropriately based on hook function value if CONDITION is until_success or until_failure. (Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure): New functions, use it. (syms_of_eval): defsubr them. * lisp.h (Frun_hook_with_args, Frun_hook_with_args_until_success, Frun_hook_with_args_until_failure): Declare them. Mon Jul 31 01:34:30 1995 Richard Stallman * xterm.c (XTread_socket): For UnmapNotify, use x_top_window_to_frame. * keyboard.c (kbd_buffer_get_event, swallow_events): Fix prev change. Sun Jul 30 02:23:55 1995 Richard Stallman * xmenu.c (single_submenu): Only ignore 1st char of pane name if that is an @. * frame.c (Fmake_terminal_frame): Copy face_alist from selected frame. * s/linux.h (HAVE_XRMSETDATABASE): Define if not defined. Fri Jul 28 20:07:35 1995 Richard Stallman * s/isc3-0.h (HAVE_SELECT): Defined. * s/isc4-1.h (HAVE_SOCKETS, NEED_NET_ERRNO_H): Defined. (HAVE_TERMIOS): Defined. (HAVE_TERMIO): Add undef. * s/isc4-0.h (sigblock, SIG_BLOCK): Don't define them if POSIX_SIGNALS. * process.c: Maybe include net/errno.h. * alloc.c (cons_cells_consed, floats_consed, vector_cells_consed) (symbols_consed, string_chars_consed, misc_objects_consed) (intervals_consed): New vars. (make_float, Fcons, make_interval, allocate_vectorlike, Fmake_symbol) (allocate_misc, make_uninit_string): Increment them. (Fmemory_use_counts): New function. (syms_of_alloc): defsubr it. Fri Jul 28 14:49:20 1995 Gvran Uddeborg * s/isc4-1.h: ISC 4.1 has termios. Thu Jul 27 22:54:05 1995 Richard Stallman * config.in (GETTIMEOFDAY_ONE_ARGUMENT): Add #undef. Thu Jul 27 17:22:19 1995 Karl Heuer * eval.c (syms_of_eval): Add missing defsubr. * buffer.c: (struct sortstrlist): New type. (overlay_heads, overlay_tails): Change to struct sortstrlist. (overlay_heads_len, overlay_tails_len): Deleted; now part of struct. (record_overlay_string): New function. (overlay_strings): Simplify. Use record_overlay_string. Check for window match in overlays_after loop, not just in overlays_before. Handle zero-sized overlays better. Thu Jul 27 03:17:48 1995 Richard Stallman * keymap.c (describe_buffer_bindings): Print bindings from Vfunction_key_map and from Vkey_translation_map. (describe_translation): New function. (describe_command): Handle vector like string. (describe_map_tree): New arg TRANSL. Callers changed. * keymap.c (Vkey_translation_map): Defined. (syms_of_keymap): Set up Lisp var. * keyboard.c (Vkey_translation_map): Just declare, don't define. (syms_of_keyboard): Don't set up Lisp var. Wed Jul 26 04:21:28 1995 Richard Stallman * Makefile.in (prefix-args): Pass ALL_LDFLAGS. * xdisp.c (syms_of_xdisp): Doc fix. * keyboard.c (kbd_buffer_get_event): Update input_pending after discarding one event from the queue, if we process the event here. (swallow_events): Likewise. Tue Jul 25 16:18:18 1995 Richard Stallman * m/iris4d.h (LIBS_MACHINE): Delete -lsun. * s/irix3-3.h (LIBS_SYSTEM): Defined. * frame.h (struct frame): Rename `display' member to `output_data'. Use new data type name for output_data.x. * xterm.h (struct x_output): Renamed from struct x_display. * xterm.c, xfns.c, xmenu.c, dispnew.c, frame.c, xfaces.c: Do renamings: frame->display => frame->output, struct x_display -> struct x_output. Tue Jul 25 15:25:56 1995 Karl Heuer * lisp.h (Frun_hook_with_args): Declare this function. * eval.c (Frun_hook_with_args): New C function, formerly in subr.el. * insdel.c (signal_before_change): Use Frun_hook_with_args. (signal_after_change): Likewise. Mon Jul 24 22:28:24 1995 Richard Stallman * xterm.c (next_noop_dpyinfo): New variable. (XTread_socket): Use that to cycle through all displays for XNoOp. Mon Jul 24 22:06:44 1995 Andreas Schwab * undo.c (Fprimitive_undo): Don't end inner loop just because a previous-modtime doesn't match any more. Mon Jul 24 21:41:23 1995 Richard Stallman * process.c (Fstart_process): Don't expand the file name before trying openp. Sun Jul 23 03:09:39 1995 Richard Stallman * xterm.h (struct x_display): New fields saved_button_event, id. * termhooks.h (enum event_kind): Added menu_bar_activate_event. * xterm.c (XTread_socket) [USE_X_TOOLKIT]: For ButtonPress in menu bar, save the event--don't pass to Xt yet. Make a menu_bar_activate_event. (temp_index, temp_buffer): Now static. * keyboard.c (kbd_buffer_get_event) [USE_X_TOOLKIT]: Handle menu_bar_activate_event by calling x_activate_menubar. * xmenu.c: Include buffer.h. (x_activate_menubar): New function. (set_frame_menubar): New arg deep_p. Callers changed. Run various hooks here when deep_p is true. (frame_vector): Variable deleted. (syms_of_xmenu): Don't staticpro it. (frame_vector_add_frame): Function deleted. (menubar_id_to_frame): New function. (menubar_selection_callback): Use menubar_id_to_frame. (next_menubar_widget_id): New variable. (set_frame_menubar): Use next_menubar_widget_id. (free_frame_menubar): Get id from f->display.x->id. * xdisp.c (update_menu_bar): Pass new arg to set_frame_menubar. * xfns.c (x_menubar_window_to_frame): New function. * window.c (Fprevious_window, Fnext_window): When minibuf = nil, accept only the minibuffer window that is currently active. Fri Jul 21 01:11:06 1995 Richard Stallman * lread.c (read_list): When a file loaded from site-init.el uses #$, turn it into a relative file name starting with ../lisp. * dispnew.c (update_frame): Check that the echo area is in the frame being displayed. * keyboard.c (command_loop_1): Clear echo area after 2 sec only if the minibuffer is in the same place as the echo area. * window.h (echo_area_window): Declared. * xdisp.c (echo_area_display): Use selected frame's minibuf window but don't set the minibuf_window (don't call choose_minibuffer_frame). (message2_nolog, message): Likewise. (echo_area_window): New variable. (echo_area_display): Set echo_area_window. (redisplay_window): Distinguish minibuf_window and echo_area_window. * fileio.c (do_auto_save_unwind): Set auto_saving to 0. (Fdo_auto_save): Don't clear auto_saving here. Set it to 1 only when we make the unwind-protect. * xdisp.c (redisplay): Skip shortcuts if buffer's clip_changed is set. (redisplay_window): If buffer's clip_changed is set, update mode line. * frame.c (do_switch_frame): Don't call choose_minibuffer_frame. (choose_minibuf_frame): Choose frame regardless of minibuffer level. * minibuf.c (read_minibuf): Call choose_minibuffer_frame. First save the previous minibuf_window. (read_minibuf_unwind): Restore old minibuf_window. Thu Jul 20 17:07:19 1995 Richard Stallman * s/aix4.h (AIX4): New definition. * m/ibmrs6000.h (LD_SWITCH_MACHINE) [AIX4]: New alternate definition. * xmenu.c (set_frame_menubar): If the Lisp-level menu bar menus are unchanged, don't recompute the widgets. * xmenu.c (syms_of_xmenu): Set up Qdebug_on_next_call. (set_frame_menubar): Bind it to nil. * fileio.c (Ffile_modes) [DOS_NT]: Use check_executable. (check_executable): DOS_NT code moved here from Ffile_modes. (check_writable): New code for MSDOS. * editfns.c (Fformat): Doc fix. Thu Jul 20 16:23:21 1995 Karl Heuer * fns.c (Fsafe_length): Return a conservative upper bound. Thu Jul 20 13:43:28 1995 Richard Stallman * editfns.c (Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true. * insdel.c (prepare_to_modify_buffer): Don't lock the file if current_buffer->filename is nil. * msdos.c (init_environment): Move alloca call out of function arg. * puresize.h [!MULTI_FRAME] (BASE_PURESIZE): Increased to 325000. Wed Jul 19 11:51:23 1995 Richard Stallman * textprop.c (Fget_char_property): If OBJECT is non-current buffer, use it properly for overlays_at. Tue Jul 18 00:35:09 1995 Richard Stallman * alloc.c (init_alloc_once): Set gc_cons_threshold from Lisp obj size. * editfns.c (Fmessage): Doc fix. (Fformat): Increment total for size of control string. * window.c (Fwindow_start): Doc fix. * xfaces.c (unload_color): Don't free colors if immutable colormap. * eval.c (Ffuncall, Fapply): Doc fix. * callint.c (Fcall_interactively): Doc fix. * fileio.c (Fexpand_file_name): Initial ~ means name is absolute. * config.in: Renamed from config.h.in. * paths.in: Renamed from paths.h.in. * Makefile.in: Renamed from Makefile.in.in. (paths.h): Depend on paths.in. (config.h): Depend on config.in. (distclean): Delete Makefile.c, not Makefile.in. (SOURCES): Corresponding changes. * callproc.c (init_callproc): Set Vdoc_directory based on Vinstallation_directory when that's non-nil, regardless of whether we had to set Vexec_directory. * unexsunos4.c (unexec): If not SUNOS4_SHARED_LIBRARIES or if apparently not dynamically linked, just clear rel and erel. * s/sunos4shr.h (SUNOS4_SHARED_LIBRARIES): Defined. Tue Jul 18 00:35:09 1995 Mikael Djurfeldt * xdisp.c (decode_mode_spec): New arg spec_width. Use pint2str for %l and %c. New code to output ??. (display_mode_element): New var minendcol. Pass new arg to decode_mode_spec. (pint2str): New function. Mon Jul 17 20:29:54 1995 Karl Heuer * bytecode.c (Fbyte_code): Fix variable names in previous change. Mon Jul 17 20:12:34 1995 Richard Stallman * xfns.c [USE_MOTIF]: Don't include X11/Xaw/Paned.h, X11/Xaw/Label.h. Sun Jul 16 12:51:08 1995 Richard Stallman * keyboard.c (kbd_buffer_get_event): Discard a selection_clear_event before processing it. * bytecode.c (Fbyte_code): For Beqlsign, if both args are ints, compare as ints. * xterm.c [HAVE_X11XTR6]: Include locale.h (x_term_init) [HAVE_X11XTR6]: Set LC_NUMERIC and LC_TIME back to C. * data.c (Fnumber_to_string): Make `buffer' long enough. Sat Jul 15 10:41:35 1995 Richard Stallman * xselect.c (x_clear_frame_selections): Delete duplicate code. * alloc.c (Flist): Rewritten. Thu Jul 13 07:17:08 1995 Richard Stallman * dispnew.c (Fsit_for): Don't call prepare_menu_bars here. * emacs.c (main): Add to usage message. * s/netbsd.h (AMPERSAND_FULL_NAME): Defined. Wed Jul 12 23:13:15 1995 Richard Stallman * s/sco4.h (SCO_R4): Defined. Mon Jul 10 02:14:37 1995 Richard Stallman * floatfns.c (Fexpt): Use EMACS_INT for integer calculation. (Ffloor): Likewise. Sun Jul 9 03:10:06 1995 Richard Stallman * buffer.c (last_overlay_modification_hooks): New variable. (last_overlay_modification_hooks_used): Likewise. (syms_of_buffer): Init last_overlay_modification_hooks. (add_overlay_mod_hooklist): New function. (call_overlay_mod_hooks): Call add_overlay_mod_hooklist. (report_overlay_modification): When AFTER is non-nil, call the functions recorded in last_overlay_modification_hooks. * s/aix4-1.h (_setjmp, _longjmp): Add #undef's. * alloc.c (allocating_for_lisp): New variable. (init_intervals, make_interval, init_symbol, Fmake_symbol) (init_float, make_float, init_cons, Fcons) (allocate_vectorlike, init_marker, allocate_misc) (init_strings, make_uninit_string): Set allocate_misc temporarily. * Makefile.in.in (TAGS): Use etags from build dir, but make TAGS file in source dir. (${lispsource}TAGS): Renamed from ../lisp/TAGS. Deps changed too. (tags): Corresponding changes. (lisptagsfiles): Delete the term/*.el files. * fileio.c (Fwrite_region): If fsync fails with EINTR, don't report a Lisp error. Sat Jul 8 11:59:50 1995 Richard Stallman * process.c (keyboard_bit_set): Fix one-off in loop end. Fri Jul 7 01:00:29 1995 Richard Stallman * keymap.c (current_minor_maps): Catch errors in Findirect_function. (current_minor_maps_error): New function. Thu Jul 6 06:40:37 1995 Richard Stallman * frame.h (struct frame): New field `mouse_moved'. * keyboard.c (mouse_moved): Variable deleted. (kbd_buffer_get_event, readable_events): Check mouse_moved in all frames. Check do_mouse_tracking for non-nil ness. (Ftrack_mouse): Set do_mouse_tracking to t. * xterm.c (note_mouse_movement): Set mouse_moved in the x_display_info. (XTmouse_position, x_scroll_bar_note_movement): Likewise. (x_scroll_bar_report_motion): Likewise. * xterm.c (x_draw_box, x_display_box_cursor, x_display_bar_cursor): New args x, y. Don't use curs_x or curs_y here. Callers changed. * ntinevt.c (win32_mouse_position, mouse_moved_to): Access mouse_moved in selected_frame. * msdos.c (mouse_get_pos, mouse_check_moved, XMenuActivate): Access mouse_moved in selected_frame. * lread.c (Fread): Rename arg READCHARFUN to STREAM. * xfns.c (Fx_list_fonts): Don't free thisinfo if it is 0. * sysdep.c (sys_close): Handle Sunos 4.1 bug in close errno value. Wed Jul 5 07:17:02 1995 Richard Stallman * Makefile.in.in (lispsource): Renamed from lispdir. * sysdep.c (init_system_name): Add cast in init for fqdn. Mon Jul 3 09:51:41 1995 Michael Shields * m/intel386.h [linux]: Include values.h and #undef certain macros, to avoid conflict later. Thu Jul 6 14:29:14 1995 Karl Heuer * s/irix6-0.h [!__GNUC__] (LD_SWITCH_SYSTEM): Define this. * s/usg5-4-2.h (LIB_MOTIF, VFORK_RETURN_TYPE): Define these. * xterm.c (x_initialize) [USE_X_TOOLKIT]: Set fallback resources. * window.c (Fset_window_hscroll): Set clip_changed in the buffer. (temp_output_buffer_show): Likewise. * lisp.h (get_keymap_1): Declared. * editfns.c (Fwiden): Set clip_changed in current buffer. (Fnarrow_to_region, save_restriction_restore): Likewise. * buffer.c (overlays_in): Don't count empty overlays at END. (Foverlays_in): Likewise. Sun Jul 2 02:02:44 1995 Richard Stallman * keyboard.c (read_char): Temporarily clear Vquit_flag while checking Vspecial_event_map. * xdisp.c (redisplay_window): Fix typos in clip_changed change. * buffer.h (struct buffer): New field clip_changed. * xdisp.c (clip_changed): Variable deleted. (prepare_menu_bars): Don't look at clip_changed. (redisplay): Don't set clip_changed. Do set b's clip_changed. (redisplay_window): Check clip_changed in current_buffer. (mark_window_display_accurate): Clear clip_changed in the window's buffer. Sat Jul 1 01:01:17 1995 Richard Stallman * keyboard.c (Vspecial_event_map): New variable. (syms_of_keyboard): Define Lisp var; init the map. (read_char): Look up each event in Vspecial_event_map; if bound, execute the binding here and read another event. (keys_of_keyboard): Make bindings for iconify-frame, make-frame-visible and delete-frame. * fns.c (Fsafe_length): New function. (syms_of_fns): defsubr it. * lisp.h (Fsafe_length): Declared. * xfaces.c (compute_char_face): Use Fsafe_length. * s/aix4-1.h (sigsetmask): Add #undef. * s/riscos5.h: New file. * xfns.c (x_set_icon_type, x_set_icon_name): Don't ever remap the frame window; changing the icon doesn't make it disappear. * process.c (Fstart_process): Expand PROGRAM. Error if it is a directory. * s/sunos4shr.h (LIBXMU): New definitions (two alternative ones). * s/sunos4-1-3.h: Don't use sunos4shr.h; go back to 19.28 definition. Fri Jun 30 16:58:15 1995 Geoff Voelker (voelker@cs.washington.edu) * nt.c (PASSWD_FIELD_SIZE): Defined. (the_passwd_name, the_passwd_passwd, the_passwd_gecos, the_passwd_dir, the_passwd_shell, getpwuid): Use PASSWD_FIELD_SIZE. (get_emacs_configuration): Check if processor macros are defined. * ntheap.c: Include config.h. (syspage_mask, real_data_region_end): Defined. (allocate_heap) [WINDOWS95]: Reverse conditional, end search at 0xD00000. (sbrk): Commit and uncommit memory in machine dependent page size chunks. * s/windows95.h (CANNOT_DUMP): Undefined. * makefile.nt (EMACS) [win95]: Removed. * makefile.nt (TLASTLIB): Defined. (TEMACS): Use TLASTLIB. * unexnt.c (get_section_info): Set the end of the data region to be just before the start of the shared library data. (read_in_bss): Read directly into memory. (map_in_heap): Read directly into memory if unable to map. Fri Jun 30 03:58:33 1995 Richard Stallman * s/hpux9.h (LIBX11_SYSTEM): Add undef. * m/intel386.h [SOLARIS] (LIBS_MACHINE): Move this out of the SOLARIS2_4 conditional. * xdisp.c (redisplay_window): Update individual window's mode line if %c calls for an update. (redisplay): Set update_mode_line for selected window only, if it needs this because of %c. Thu Jun 29 11:54:39 1995 Richard Stallman * s/aix3-2-5.h (C_OPTIMIZE_SWITCH, C_DEBUG_SWITCH): Use these names instead of C_SWITCH_OPTIMIZE, C_SWITCH_DEBUG. * s/aix4.h: Include aix3-2.h, not aix3-2-5.h. * callproc.c (child_setup): Don't get confused if in == err. * xterm.c (XTread_socket): Turn off meta, super, hyper and alt bits in the arg for XLookupKey. Wed Jun 28 18:50:19 1995 Morten Welinder * unexmips.c [MACH]: Include a.out.h. [MACH] (STYP_INIT, _RDATA, STYP_RDATA, _SDATA, STYP_SDATA): Defined. [MACH] (_SBSS, STYP_SBSS, HDRR, pHDRR): New definitions. (unexec): Add MACH conditionals. * m/pmax.h [MACH]: Use built-in alloca, set START_FILES. * s/mach-bsd4-3.h: New file. Wed Jun 28 02:07:24 1995 Richard Stallman * term.c (term_init): Alternative error messages for TERMCAP/TERMINFO. * m/alpha.h (PTY_ITERATION, PTY_NAME_SPRINTF, PTY_OPEN) (PTY_TTY_NAME_SPRINTF): New definitions. * dispnew.c (update_frame): Pretend cursor is in echo area rather than put it in a minuffer hidden by the echo area. Tue Jun 27 04:28:21 1995 Richard Stallman * s/hpux9.h (LIBXMU): New definition. * s/hpux9-x11r4.h, s/hpux9shxr4.h: New files. * xmenu.c (single_submenu): Handle commands appearing directly in the menu bar. Mon Jun 26 02:40:10 1995 Richard Stallman * xterm.c (x_display_bar_cursor, x_display_box_cursor): Don't alter curs_x or curs_y here. (x_display_cursor): Copy them from the frame cursor here. (x_update_cursor): New function. (frame_highlight, frame_unhighlight): Use x_update_cursor. * xdisp.c (echo_area_display): Don't set FRAME_CURSOR_... here. (redisplay): In the "point hasn't moved" shortcut, make sure that the cursor is in the right window already. * msdos.c (IT_cursor_to, IT_clear_end_of_line, IT_write_glyphs): (IT_set_face): Call internal_flush if short of room. Sun Jun 25 16:38:41 1995 Morten Welinder * emacs.c (init_cmdargs): Make Vinvocation_directory absolute if it isn't already. Sun Jun 25 01:15:31 1995 Richard Stallman * frame.c (Fdelete_frame): It's ok to have no minibuffer left on a kboard if there are no frames on it either. * buffer.c (overlays_in): New function. (Foverlays_in): New function. (syms_of_buffer): defsubr it. * xfns.c (Fx_open_connection, x_display_info_for_name): Error if window-system is not x. * process.c (Fopen_network_stream): Sleep 1 sec before connect retry. * frame.c (next_frame, prev_frame): Consider only frames on same kbd. (Fdelete_frame): If next_frame finds nothing, try an alternative. * buffer.c (overlay_strings): Fix calls to xrealloc. Sat Jun 24 00:06:46 1995 Richard Stallman * s/aix4-1.h (LIB_MOTIF): Defined. * emacs.c (main): Fix --help message. * window.c (Fsplit_window): Nicer error if split size is too small. * Makefile.in.in (LIBXMU): New macro. (LIBXT): Use LIBXMU. Fri Jun 23 19:29:53 1995 Richard Stallman * fileio.c (directory_file_name): Don't get confused by // at end on Unix-like systems. Thu Jun 22 10:47:43 1995 Richard Stallman * xmenu.c (menu_item_enabled_p_1): Special handling for quit. (set_frame_menubar): Inhibit quitting. Wed Jun 21 19:06:36 1995 Richard Stallman * buffer.c (syms_of_buffer): Doc fix. * Makefile.in.in (SOME_MACHINE_OBJECTS): Add dosfns.o, intervals.o, textprop.o. Wed Jun 21 14:08:45 1995 Richard Stallman * Version 19.29 released. * xfns.c (Fx_display_grayscale_p): Return t or nil. Return t for color displays. * s/msdos.h (SYSTEM_PURESIZE_EXTRA): Increased to 68000. * xdisp.c (decode_mode_spec) [!MULTI_FRAME]: Handle %F properly. Tue Jun 20 10:58:14 1995 Richard Stallman * keyboard.c (read_key_sequence): Don't use Vprefix_help_command for the first character in a key seq. * ntinevt.c (map_virt_key): Mark some additional chars as valid ASCII. * ntterm.c (ctrl_c_handler): Ignore CTRL_BREAK_EVENT signals. Mon Jun 19 12:13:38 1995 Richard Stallman * sysdep.c (rmdir): Fix up Aug 19 1993 change that wasn't done right. * ntproc.c (win32_wait): Massage retval into what is expected in Unix. * process.c (sigchld_handler): Change XSETFASTINT to XSETINT. * keyboard.c (Freset_this_command_lengths): New function. (before_command_key_count, before_command_echo_length) (before_command_restore_flag): New variables. (add_command_key): If requested, reset the lengths. (command_loop_1): Record current lengths before reading cmd. (read_char): Update the recorded length before echoing. * xfns.c (Fx_create_frame): Fix last arg to x_get_arg for Qdisplay. * s/linux.h (LIB_GCC): Fix previous change. If we redefine it later, #undef it first. Sun Jun 18 14:24:37 1995 Richard Stallman * keyboard.c (quit_throw_to_read_char): Turn off the error check testing poll_suppress_count. * s/linux.h (LIB_GCC): Define here, overriding Makefile.in.in, so as to use C_SWITCH_X_MACHINE. Sat Jun 17 10:05:04 1995 Richard Stallman * m/alpha.h (SYSTEM_MALLOC): Definition deleted. * keymap.c (Vdefine_key_rebound_commands): New variable. (syms_of_keymap): Set up Lisp var. (Fdefine_key): Put new definition onto Vdefine_key_rebound_commands. * xmenu.c (menu_item_equiv_key): Do reconsider a command that had no equivalent before, if it is in Vdefine_key_rebound_commands. * data.c (Flocal_variable_if_set_p): New function. (syms_of_data): Call defsubr. * xdisp.c (display_text_line): Fill in charstart for end of buffer. Fri Jun 16 18:26:08 1995 Richard Stallman * puresize.h [MULTI_FRAME] (BASE_PURESIZE): Increase to 315000. * frame.c (Fdelete_frame): Use do_switch_frame directly. (do_switch_frame): No longer static. * window.c (Fset_window_configuration): Use do_switch_frame directly. * keyboard.c (quit_throw_to_read_char): Use do_switch_frame directly. * lisp.h (do_switch_frame): Declared. Fri Jun 16 18:17:59 1995 Karl Heuer * frame.c [MULTI_FRAME] (Fignore_event): New function. [MULTI_FRAME] (keys_of_frame): Bind iconify-frame and make-frame-visible to it. Fri Jun 16 00:30:17 1995 Richard Stallman * .gdbinit: Use long, not EMACS_INT. Do `set main' to make gdb_valbits etc. available. * frame.h (struct frame): New field icon_name. * xterm.h (struct x_display): icon_name deleted. * xfns.c (x_report_frame_params, x_set_icon_type, x_set_icon_name) (x_set_name, x_icon, Fx_create_frame): Use moved icon_name field. * alloc.c (mark_object): Mark icon_name field. Thu Jun 15 16:48:21 1995 Karl Heuer * keyboard.h (struct kboard): Add Voverriding_terminal_local_map. * keyboard.c (init_kboard): Initialize it. (syms_of_keyboard): Defvar it. (read_key_sequence, menu_bar_items): Check Voverriding_terminal_local_map before Voverriding_local_map. * doc.c (Fsubstitute_command_keys): Likewise. * keymap.c (Fkey_binding, describe_buffer_bindings): Likewise. * xdisp.c (Qoverriding_terminal_local_map): New variable. (syms_of_xdisp): staticpro it. (update_menu_bar): If we bind overriding-local-map, also bind overriding-terminal-local-map. * frame.c (Fhandle_switch_frame): Preserve prefix arg. * keyboard.c (command_loop_1): In special handling for commands that create a prefix arg, don't handle commands that merely preserve one that was previously created. * .gdbinit ($valmask): Use EMACS_INT, not int. * lisp.h (enum pvec_type): Don't use trailing comma. Thu Jun 15 09:58:49 1995 Richard Stallman * m/alpha.h (malloc, realloc): If not _MALLOC_INTERNAL, always use void *. Thu Jun 15 22:12:04 1995 Geoff Voelker * callproc.c (call-process-region) [DOS_NT]: Use IS_DIRECTORY_SEP. (call-process-region) [WINDOWSNT]: Use proper temp file template. * ntproc.c (win32_spawnve): Accept program names without executable suffixes. * makefile.nt (TRES) [MSVCNT11]: Use emacs.res, and don't compile it. Thu Jun 15 01:30:14 1995 Richard Stallman * m/alpha.h (LD_SWITCH_MACHINE): Don't define it. (malloc, realloc): If non-ANSI C, declare value as char *. Wed Jun 14 19:10:35 1995 Richard Stallman * sysdep.c (emacs_set_tty): Swap TCSETAF and TCSETAW. Rename arg waitp to flushp. Wed Jun 14 18:07:40 1995 Karl Heuer * callint.c (Fprefix_numeric_value): Fix type check. * keyboard.c (command_loop_1): Clear prefix arg (undo Feb 1 change). Wed Jun 14 15:52:55 1995 Richard Stallman * data.c (Flocal_variable_p): Fix backwards logical operator. Wed Jun 14 14:47:53 1995 Karl Heuer * m/intel386.h: If NOT_C_CODE, don't include alloca.h. [!__GNUC__] (C_SWITCH_MACHINE): Disable this; it seems to confuse cpp. Wed Jun 14 08:21:18 1995 Richard Stallman * frame.c (Fdelete_frame): If the minibuf window was selected, make that remain so. * process.c (status_notify): Undo May 18 change. Set update_tick at the beginning not at end. * buffer.c (Fprevious_overlay_change): Check for overlays that end at POS. Tue Jun 13 20:40:48 1995 Richard Stallman * xfns.c (syms_of_xfns): Initialize Vx_no_window_manager. Doc fix. Tue Jun 13 17:43:12 1995 Karl Heuer * m/ibmrs6000.h (LIBS_MACHINE): Use -lpthreads, not -lpthread. * config.h.in (HAVE_LIBPTHREADS): Add #undef. Mon Jun 12 13:21:15 1995 Roland McGrath * mem-limits.h [_LIBC] (start_of_data): Define to &__data_start for GNU libc. Sun Jun 11 16:46:37 1995 Richard Stallman * xmenu.c (frame_vector_add_frame): Don't forget to store the longer vector. * xterm.h (struct x_display): New field asked_for_visible. * xterm.c (x_make_frame_visible): Test and set asked_for_visible. * widget.c (EmacsFrameSetCharSize): Manually alter the height and width of the outer widget (and the width of the column widget) carefully using deltas. Set update_hints_inhibit nonzero while updating. Then call update_wm_hints explicitly. (update_wm_hints): Use 0 for min_rows, min_cols. Do nothing if update_hints_inhibit is nonzero. * xterm.c: Include widget.h. (x_wm_set_size_hint) [USE_X_TOOLKIT]: Get the size from the outer widget. Copy the base and minimum sizes from the old hint. * xfns.c [USE_X_TOOLKIT] (x_window): If using Motif, add some extra to sizes, for consistent behavior. Sat Jun 10 00:57:13 1995 Richard Stallman * dispnew.c (Fframe_or_buffer_changed_p): Calculate vector size right. Add hysteresis when making it larger. Fill it up reliably and check at the end for overflowing it. (syms_of_display): Make frame_and_buffer_state initially with 20 elts. * keyboard.c (read_char_minibuf_menu_prompt): If the char to type doesn't match the prompt string, show the char explicitly. Sat Jun 10 17:44:38 1995 Geoff Voelker * ntterm.c,ntproc.c,nt.c: Include config.h before stdio.h. Fri Jun 9 22:11:59 1995 Geoff Voelker * makefile.nt (TEMACS): Depend upon $(BLD). (temacs): Remove $(BLD) dependency. Fri Jun 9 17:05:27 1995 Richard Stallman * xterm.c (x_get_keysym_name): New function. * keyboard.c (modify_event_symbol): Mask out high bits here, and only for certain purposes. table_size now unsigned. (modify_event_symbol) [HAVE_X_WINDOWS]: Use x_get_keysym_name. (make_lispy_event): Don't mask high bits here. Supply -1 as table_size for system-specific keys. * xdisp.c (update_menu_bar): Use set_buffer_internal_1 to switch bufs. Run the hooks in the proper buffer. Normally bind overriding-local-map to nil. (Qoverriding_local_map): New variable. (syms_of_xdisp): staticpro it. Fri Jun 9 11:44:06 1995 Karl Heuer * keyboard.h (struct kboard): New member system_key_syms. * alloc.c (mark_kboards): Mark it. * keyboard.c (system_key_syms): Deleted; now part of struct kboard. (make_lispy_event): Use the struct member. (init_kboard): Initialize it. (syms_of_keyboard): Delete initialization and staticpro. * Makefile.in.in (SOURCES): Makefile isn't source; Makefile.in.in is. Thu Jun 8 15:00:47 1995 Richard Stallman * keyboard.c (Fevent_convert_list): Renamed from convert_event_type_list. (syms_of_keyboard): defsubr it. * keymap.c (Flookup_key, Fdefine_key): Use Fevent_convert_list. * xmenu.c (xmenu_show): Do call lw_destroy_all_widgets. (xdialog_show): Likewise. (popup_get_selection): Don't call it here. * search.c (Freplace_match): Fix check for valid reg in string replace. Do the right thing with backslash. * keyboard.c (Vhelp_event_list): New var. (syms_of_keyboard): Set up Lisp var. (help_char_p): New function. (read_char, echo_char, read_key_sequence): Use help_char_p. * keyboard.h (Vlucid_menu_bar_dirty_flag): Declare this variable. (Qrecompute_lucid_menubar, Qactivate_menubar_hook): Likewise. * keyboard.c (read_key_sequence): Don't run activate-menubar-hook or call recompute-lucid-menubar. * xdisp.c (update_menu_bar): Run activate-menubar-hook and call recompute-lucid-menubar. Thu Jun 8 15:13:39 1995 Karl Heuer * commands.h (last_command): Declaration deleted. * keyboard.h (struct kboard): New member Vlast_command. * keyboard.c (last_command): Var deleted; now part of struct kboard. (init_kboard): Initialize it. (syms_of_keyboard): Defvar it. (command_loop_1): Make last_command be kboard-local. * cmds.c (internal_self_insert): Likewise. * minibuf.c (Fminibuffer_complete): Likewise. * m/ibmrs6000.h (LIBS_MACHINE): Use -lpthread if it exists. * m/alpha.h (LIBS_MACHINE): Define to -ldnet or -ldnet_stub. * s/msdos.h (SYSTEM_PURESIZE_EXTRA) [!HAVE_X_WINDOWS]: Increase to 62000. * process.c [!subprocesses]: Include sysselect.h. * xmenu.c (xmenu_show): If !HAVE_X_WINDOWS, don't reference X display. Wed Jun 7 14:37:31 1995 Karl Heuer * keyboard.h (struct kboard): member Vprefix_arg restored, replacing prefix_factor, prefix_value, prefix_sign, and prefix_partial. * callint.c (current_prefix_partial): Deleted. (Vprefix_arg): Deleted; not part of struct kboard again. (Funiversal_argument, Fnegative_argument, Fdigit_argument) (clear_prefix_arg, finalize_prefix_arg, describe_prefix_arg): Deleted. (syms_of_callint): Use DEFVAR_KBOARD for Vprefix_arg. Remove defsubrs for deleted functions. * lisp.h: Remove declarations for deleted vars and functions. * alloc.c (mark_kboards): Mark Vprefix_arg instead of prefix_factor and prefix_value. * macros.c (Fexecute_kbd_macro): Vprefix_arg is now part of kboard. * keyboard.c (cmd_error, command_loop_1, Fcommand_execute) (Fexecute_extended_command, init_kboard, syms_of_keyboard): Undo Feb 28 change; prefix arg handling is now in Lisp code again. * buffer.c: (syms_of_buffer): Doc fix. * buffer.c: (Fbuffer_disable_undo): Make this function interactive. Wed Jun 7 11:08:58 1995 Richard Stallman * data.c (Flocal_variable_p): New optional arg BUFFER. Really check whether var is local in *that* buffer. * xfns.c (x_real_positions): Uncatch and recatch X errors in the loop. * filelock.c (unlock_file, lock_file): Call Fexpand_file_name. Mon Jun 5 13:30:54 1995 Karl Heuer * Makefile.in.in (TOOLKIT_DEFINES): Define. (ALL_CFLAGS): Insert $(TOOLKIT_DEFINES) here. * xfns.c (syms_of_xfns): Provide motif in Motif version. * lisp.h: (Fwaiting_for_user_input_p): Function declared. (Fupcase_initials, Fupcase_initials_region): Likewise. (Fplist_get, get_local_map, Fx_popup_menu, Fx_popup_dialog): Likewise. (Fframe_first_window): Likewise. * keyboard.c (cmd_error): Use NULL, not 0, as arg to cmd_error_internal. (menu_bar_items): Likewise, for arg of current_minor_maps. (record_char): Add cast. * indent.c (Fvertical_motion): Add cast. * undo.c (record_insert): Change args to be ints, not Lisp_Objects. * casefiddle.c (casify_region): Use explicit local vars for start and end, so that the type will be correct. (operate_on_word): Likewise for iarg in this function. (upcase_initials, upcase_initials_region): Deleted; these were redundant copies of Fupcase_initials and Fupcase_initials_region. * abbrev.c (Fexpand_abbrev): Call to upcase_initials_region changed to Fupcase_initials_region for consistency. * search.c (Freplace_match): Likewise. * alloc.c: Declare sbrk. * xdisp.c: Include keyboard.h. * s/irix5-0.h (POSIX_SIGNALS): Defined. Sat Jun 3 19:02:35 1995 Richard Stallman * xterm.c (x_wm_set_icon_pixmap): Set IconPixmapHint in both cases. * buffer.c (Fkill_buffer): When killing indirect buffer, unchain that buffer's markers (only) from the common chain. Don't rekill this buffer's indirect buffers that are dead. Do nothing if this buffer is already dead. Sat Jun 3 12:57:01 1995 Karl Heuer * editfns.c (Fencode_time): Doc fix. * fns.c (NULL): Define if not defined. Fri Jun 2 17:05:37 1995 Richard Stallman * xfns.c (Fx_create_frame): Make sure icon_name is a string or nil. * xterm.h (struct x_display): Rename icon_label to icon_name and make it a Lisp_Object. * xfns.c (Qicon_name): New variable. (Fx_create_frame): Look for icon-name parm and set icon_label field. (x_set_icon_type): Compute arg to x_text_icon based on frame name and icon_name fields. (x_set_icon_name): New function. (x_icon): Call x_text_icon. (x_set_name): Look at icon_name field when setting the icon name, (x_frame_parms): Add icon-name. (syms_of_xfns): Set up Qicon_name. * xterm.c (x_text_icon): Do call XSetIconName or XSetWMIconName. Don't save ICON_NAME anywhere. * sysdep.c (old_tty_valid): New variable. (init_sys_modes): Set old_tty_valid if we set old_tty. (reset_sys_modes): Restore tty settings only if old_tty_valid. * term.c (cursor_to, clear_to_end_of_line_raw): If chars_wasted is 0, do nothing. (clear_end_of_line): Don't die if chars_wasted is 0. * search.c (trivial_regexp_p): = is special after \. * s/ptx.h (HAVE_SELECT, HAVE_TIMEVAL): Definitions deleted. Thu Jun 1 18:47:56 1995 Karl Heuer * xfns.c (x_destroy_bitmap): Block and unblock input. (Fx_horizontal_line): Add one UNBLOCK_INPUT to fix a misbalance, and move another one to include the call to XFreeGC, in case we someday remove the "#if 0" conditions. * widget.c (EmacsFrameDestroy): Block and unblock input. Wed May 31 23:08:12 1995 Richard Stallman * xfns.c (x_display_info_for_name): Fix error message. (Fx_open_connection): Fix error messages. Tue May 30 17:49:03 1995 Karl Heuer * s/sol2-4.h (LD_SWITCH_SYSTEM): Copied back from s/sol2-3.h; added references to /usr/dt/lib. * xfns.c (syms_of_xfns): Allow PATH_BITMAPS to be a colon-separated list. * editfns.c (syms_of_editfns): user-login-name renamed from user-name. user-real-login-name renamed from user-real-name. C names changed to Vuser_real_login_name, Vuser_login_name as well. * nt.c: Change Vuser_real_name to Vuser_real_login_name. Tue May 30 12:13:28 1995 Richard Stallman * xfns.c (x_top_window_to_frame): Don't match menu-bar widget. * xdisp.c (update_menu_bar): Reverse test of save_match_data. * xmenu.c (set_frame_menubar): Always call update_frame_menubar. * xfns.c (x_window): Use applicationShellWidgetClass, not topLevelShellWidgetClass. Call lw_set_main_areas after creating the menubar widget. Mon May 29 16:53:49 1995 Karl Heuer * xdisp.c (update_menu_bar): Do update if region display has changed. * frame.c (make_frame_without_minibuffer): New arg DISPLAY. If there's no minibuffer frame to use, create one. * xfns.c (Fx_create_frame): Pass new arg to make_frame_without_minibuffer. * fns.c (Frandom): Use EMACS_INT, not int. Use NULL, not 0, as arg of `time'. * frame.c: Declare x_get_focus_frame. (Fmouse_position): Use NULL, not 0, as arg of pixel_to_glyph_coords. * keyboard.c (make_lispy_event, make_lispy_movement): Likewise. Mon May 29 20:10:20 1995 Richard Stallman * xterm.c (XTread_socket) [USE_X_TOOLKIT]: Do pass MotionNotify events to the toolkit. * keyboard.c (Fset_input_mode): When read_socket_hook, ignore what the user specified, and set interrupt_input in the preferred way for this system. * xterm.c (x_term_init): Call init_sigio only if interrupt_input. Sun May 28 23:58:00 1995 Morten Welinder * s/osf1.h (COFF): Define. * m/alpha.h (LD_SWITCH_MACHINE) [!__GNUC__]: Don't define. (r_alloc, r_re_alloc, r_alloc_free) [REL_ALLOC, !_MALLOC_INTERNAL, !NOT_C_CODE]: Prototype. Sun May 28 17:11:38 1995 Richard Stallman * xterm.c (x_set_offset): Distinguish CHANGE_GRAVITY < 0 case. * xfns.c (x_set_frame_parameters): Pass -1 to x_set_offset. * xfns.c (x_report_frame_params): Report top and left in a way that represents negative offsets correctly. * syntax.c (describe_syntax_1): Pass new arg to describe_vector. * keymap.c (describe_vector): New arg entire_map. Don't show bindings shadowed earlier on in the same map. (Fdescribe_vector, describe_map): Pass new arg. * xdisp.c (redisplay_window): Don't use try_window_id if newline has a display table entry. * xdisp.c (update_menu_bar): Call set_frame_menubar with proper buffer current. Fri May 26 20:17:46 1995 Geoff Voelker * lread.c (init_lread) [CANNOT_DUMP]: Set Vload_path to EMACSLOADPATH. Fri May 26 18:46:15 1995 Richard Stallman * xfns.c (x_window): Call initialize_frame_menubar near the end, after UNBLOCK_INPUT. * xmenu.c (popup_get_selection): Force deactivation if key pressed. New arg `id'. (xdialog_show, xmenu_show): Pass new arg to popup_get_selection. * xterm.c (XTread_socket): Don't call popup_get_selection here. Fri May 26 17:53:58 1995 Karl Heuer * sysdep.c (VFORK_RETURN_TYPE): Use int if not already defined. (vfork): Declare the return type. * s/sol2-3.h (HAVE_VFORK): Moved here from s/sol2-4.h. (VFORK_RETURN_TYPE): Defined. * s/sol2-4.h (HAVE_VFORK): Moved to s/sol2-3.h. (pid_t): Deleted; s/sol2-3.h now defines a symbol for this. * xdisp.c (x_consider_frame_title): Use FRAME_KBOARD. Fri May 26 01:23:03 1995 Geoff Voelker * s/windows95.h: New file. * ntheap.h (get_data_region_base): Undefined. (get_reserved_heap_size): Use reserved_heap_size. (reserved_heap_size): Declared. * ntheap.c (reserved_heap_size,allocate_heap): Defined. (sbrk): Use allocate_heap. * ntterm.c (set_terminal_modes): Set cursor size appropriate for Win95. (write_glyphs): Don't memset attrs, which is a word array. * nt.c (configuration_buffer): Increase size. (get_emacs_configuration) [WINDOWS95]: Use appropriate string. (prepare_standard_handles) [WINDOWS95]: Disable subprocesses. (reset_standard_handles): Check error number on failure. * makefile.nt (LIBS): Use BASE_LIBS and ADVAPI32. (config.h,paths.h): Use $(CP) instead of cp. (config.h): Use $(CONFIG_H). (EMACS) [WINDOWS95]: Don't dump temacs.exe. (clean): Cleanup MSVC files and config.h. (cleandump): Separate commands onto multiple lines. Cleanup comments. Fri May 26 00:16:42 1995 Michael Ernst * emacs.c (standard_args): -i, -itype, --icon-type take 0, not 1, args Thu May 25 10:26:10 1995 Karl Heuer * process.c (create_process, send_process): Add volatile qualifiers. (wait_reading_process_input) [both versions]: Cast args of select. * syntax.c (scan_lists): Make stringterm an unsigned char. * dispnew.c (change_frame_size_1): Declare arg DELAY. * insdel.c (adjust_point): Declare arg AMOUNT. * lisp.h (do_symval_forwarding): Declare this function. (frame_buffer_predicate, Foverlay_start, Foverlay_end): Ditto. (Fprevious_single_property_change, Fend_of_line, Felt): Ditto. (Fforward_line, Fforward_word, Fdelete_region, Fforward_char): Ditto. (Fnarrow_to_region, Fwiden, Fmatch_beginning, Fmatch_end): Ditto. (Fskip_chars_forward, Fskip_chars_backward): Ditto. (Ffile_name_absolute_p, read_doc_string): Ditto. (get_frame_param, store_frame_param, store_in_alist): Ditto. (describe_map_tree): Declaration moved here from keymap.c. * keymap.c (describe_map_tree): Move declaration to lisp.h. * doc.c (Fsubstitute_command_keys): Cast arg of describe_map_tree. * frame.c [MULTI_FRAME] (Fmouse_position): Cast arg of pixel_to_glyph_coords. * callint.c (Fcall_interactively): Cast arg of doprnt. * editfns.c (format1): Likewise. * xdisp.c (message): Likewise. (scroll_bottom_vpos, fmodetrunc): Declarations deleted. Thu May 25 10:16:58 1995 Richard Stallman * dispnew.c (Fframe_or_buffer_changed_p): Record frame names as well as the frame objects. * xterm.c (XTread_socket): For MapNotify, call record_asynch_buffer_change. * xdisp.c (prepare_menu_bars): Update frame titles before menu bars. * xfns.c (Fx_get_resource): Major rewrite to make it clearer. (validate_x_resource_name): Use build_string, not make_string. (Fx_create_frame): Initially use Vinvocation_name as resource name. Switch to frame name if frame name is explicit. (x_display_info_for_name, Fx_open_connection): Add casts. Initially use Vinvocation_name as resource name. [USE_X_TOOLKIT] (x_window): Use Vx_resource_name for widget names. * xmenu.c (xmenu_show, xdialog_show): Increment widget_id_tick in the same way as in xfns.c. Use LWLIB_ID type where appropriate. (set_frame_menubar, free_frame_menubar): Add casts to LWLIB_ID. * xterm.c (XTflash): Use pointers as args to select. (XTread_socket, x_set_offset, x_set_window_size) (x_make_frame_invisible): Cast 2nd arg to x_wm_set_size_hint. (XTclear_end_of_line): Don't specify return type. (note_mouse_highlight): Declare args x and y. (x_icon_type): New declaration. (flashback): Declaration deleted. Wed May 24 18:45:51 1995 Karl Heuer * lisp.h (menu_bar_items): Declare this function. Wed May 24 16:33:26 1995 Richard Stallman * xmenu.c (Fx_popup_dialog): Treat (menu-bar) like t, for POSITION. * frame.c (Fdelete_frame): When updating Vdefault_minibuffer_frame, insist on a frame on the proper keyboard. * xterm.c (x_connection_closed): Unblock input, first thing. Set Vdefault_minibuffer_frame to t before deleting a frame that might have its own minibuffer. Tue May 23 23:48:54 1995 Karl Heuer * xfns.c (hack_wm_protocols): Use cast instead of suffix. Tue May 23 20:40:43 1995 Richard Stallman * xfns.c (x_set_frame_parameters): Pass 1 as change_gravity when calling x_set_offset. (x_real_positions): Don't add border_width into win_x, win_y. * xterm.c (x_set_offset): Add border_width when calling XMoveWindow. * xterm.h (struct x_display): New field menubar_height. * xmenu.c (set_frame_menubar): Set menubar_height field. * xfns.c (x_window) [both versions]: Set menubar_height. * xfns.c [USE_X_TOOLKIT] (x_window): Don't call XMoveWindow or x_calc_absolute_position. Do use the border_width. * xterm.c (x_calc_absolute_position): Use menubar_height field. In toolkit case, use outermost Emacs widget and its parent. [USE_X_TOOLKIT] (x_make_frame_visible): Do call x_set_offset. * xfns.c [USE_X_TOOLKIT] (x_window): Pass position to toolkit only if user-specified. But always use XMoveWindow to move the window to that position. * alloc.c (Fgarbage_collect): Clear consing_since_gc first thing. * xdisp.c (redisplay_window): Use set_buffer_internal_1. * buffer.c (set_buffer_internal_1): New subroutine. (Fmove_overlay): Don't set windows_or_buffers_changed. Mon May 22 18:09:46 1995 Karl Heuer * xselect.c (x_get_window_property): Cast args of XGetWindowProperty. * xfaces.c (unload_color): Cast args of XFreeColors. * xfns.c (hack_wm_protocols): Cast args of XGetWindowProperty. (x_set_border_pixel): Cast args of XSetWindowBorder. * widget.c (create_frame_gcs): Cast args of XCreateGC. (setup_frame_gcs): Cast args of XCreatePixmapFromBitmapData. * data.c (long_to_cons): Don't assume 32-bit longs. * fileio.c (Fvisited_file_modtime): Cast arg of long_to_cons. * editfns.c (Fformat): Split double into two pointers, not two ints. * s/hpux9.h: Delete HAVE_FMOD; configure handles that correctly now. Mon May 22 16:14:07 1995 Richard Stallman * xdisp.c (display_text_line): Enter a char in charstarts at the very end of the character loop. Enter newline or ^M (if selective display) separately. * lisp.h (gdb_lisp_params): New enum type. * .gdbinit: Use gdb_lisp_params to get storage layout info. Set and use $valmask and $nonvalbits. * lread.c (oblookup): Delete argument hashp. Fri May 19 23:35:57 1995 Karl Heuer * floatfns.c (Flogb): frexp needs a pointer to int, not EMACS_INT. Fri May 19 17:52:46 1995 Richard Stallman * dispnew.c (buffer_posn_from_coords): Don't let startp be before BEGV. Thu May 18 18:42:37 1995 Karl Heuer * indent.c (compute_motion): Handle overlay strings. New arg DID_MOTION. All callers changed. * dispnew.c, window.c: Add new argument to calls of compute_motion. * xdisp.c: Add new argument to calls of compute_motion. (zv_strings_seen): New variable. (redisplay, try_window, try_window_id): Clear zv_strings_seen. (display_text_line): Handle overlay strings. Thu May 18 12:54:22 1995 Richard Stallman * s/sol2-4.h: Undo previous change. * emacs.c (Fkill_emacs): Delete the auto-save-list file after shut_down_emacs. * process.c (status_notify): If Vprocess_alist changes within the loop, do the whole loop again. Wed May 17 03:26:09 1995 Karl Heuer * emacs.c (Fdump_emacs): Don't take address of array. * buffer.c (Fmake_indirect_buffer): Fix interactive spec. * Makefile.in.in (SOURCES): Fix reference to ymakefile. * keyboard.c (syms_of_keyboard): Always define track-mouse. (do_mouse_tracking): Always declare this var. Mon May 15 21:28:52 1995 Marcus Daniels * s/linux.h: Test _STDIO_USES_IOSTREAM as well as _IO_STDIO_H. [__ELF__] (START_FILES, LIB_STANDARD, LIB_GCC, UNEXEC): Define these. [__ELF__] (UNEXEC_USE_MAP_PRIVATE): Define this. * unexelf.c (unexec) [UNEXEC_USE_MAP_PRIVATE]: New logic for systems that don't support MAP_SHARED with PROT_WRITE. Mon May 15 19:26:40 1995 Richard Stallman * s/sol2-4.h (LD_SWITCH_SYSTEM): Define. Mon May 15 17:46:47 1995 Simon Leinen * indent.c (vmotion): handle the case where `minibuf_prompt' is nil. Fri May 12 18:23:15 1995 Karl Heuer * indent.c (vmotion): Simplify. Replace last three args with a single struct window *. All callers changed. * xdisp.c (minmax): New macro. (redisplay, redisplay_window, try_window_id): Clip cursor hpos at both low and high extremes, in anticipation of a change to compute_motion. * xterm.c (Qvendor_specific_keysyms): New var. (syms_of_xterm): Initialize and staticpro it. (x_term_init): Initialize Vsystem_key_alist according to vendor. * emacs.c (main) [NeXT]: Add missing braces. Thu May 11 18:16:36 1995 Karl Heuer * sysdep.c (init_system_name): Clean up signedness mismatch. * unexelf.c (unexec): Fix type mismatch. * print.c (float_to_string): Fix type mismatch and simplify. * dispnew.c [!MULTI_FRAME] (Fredraw_frame): Delete extra docstring. * frame.c [!MULTI_FRAME] (Fframe_height, Frame_width): Likewise. Tue May 9 00:45:23 1995 enami tsugutomo * window.c [MULTI_FRAME] (init_window_once): Set Vterminal_frame to selected_frame. * frame.c [MULTI_FRAME] (make_terminal_frame): Don't set Vterminal_frame. (do_switch_frame): Set Vterminal_frame to selected_frame. Mon May 8 14:30:19 1995 Andreas Schwab * Makefile.in.in (VMS_SUPPORT): Add missing `.elc'. (SOME_MACHINE_LISP): New variable. (${etc}DOC): Use it. * buffer.c (syms_of_buffer): Doc fix. * frame.c (frame-height, frame-width, set-screen-height, set-screen-width, termal-frame) [!MULTI_FRAME]: Delete doc strings. Mon May 8 21:28:34 1995 Karl Heuer * keyboard.c (init_kboard): Initialize Vdefault_minibuffer_frame. * keyboard.h (struct kboard): New member Vdefault_minibuffer_frame. * frame.c: Vdefault_minibuffer_frame is now part of KBOARD instead of a variable. All references changed. (make_frame_without_minibuffer): New arg KB. Require the new frame's minibuffer to be on the same display. * xfns.c (Fx_create_frame): Pass kb to make_frame_without_minibuffer. * xdisp.c (x_consider_frame_title): When setting multiple_frames, ignore invisible frames and frames on other displays. * keyboard.c [MULTI_KBOARD] (read_char): If the character was for the wrong kboard, don't let it get processed twice. Mon May 8 12:24:38 1995 Richard Stallman * callproc.c (Fcall_process): Keep reading till buffer is nearly full. * emacs.c (Fdump_emacs): Don't use & before my_edata. Mon May 8 16:45:51 1995 Francesco Potorti` (pot@cnuce.cnr.it) * m/delta.h (C_SWITCH_MACHINE): Let configure decide if this is a 68040 or 68030. Don't condition on __STDC__. Mon May 8 18:40:21 1995 enami tsugutomo * frame.c (Fraise_frame, Flower_frame): Make arg FRAME optional. * keyboard.c (Fread_key_sequence): Doc fix. Mon May 8 00:52:42 1995 Richard Stallman * window.c (Fdisplay_buffer): Initialize other, upper, lower. Sun May 7 18:26:25 1995 Richard Stallman * lisp.h (Fmatch_data, Fstore_match_data): Declared. * xdisp.c (prepare_menu_bars): Save and restore the match data. (update_menu_bar): New arg save_match_data. Maybe save and restore match data here. Sun May 7 17:03:55 1995 Geoff Voelker * makefile.nt (region-cache.obj,vm-limit.obj): Dependencies defined. (OBJ1): Don't compile xfaces.c. (buffer.obj,indent.obj,search.obj): Add region-cache.h dependency. Sun May 7 06:34:20 1995 Paul Eggert * data.c (Fmod): Fix the final adjustment, when f2 < 0 and f1 == 0. * lread.c (isfloat_string): Reject strings like "0.5+". Sun May 7 02:22:11 1995 Richard Stallman * process.c (wait_reading_process_input): Pass arg in new call to set_waiting_for_input. * xfns.c (Funfocus_frame): Check for live X frame. * lread.c (init_lread): Don't warn about missing installation dirs when using dirs derived from the executable. Sat May 6 22:37:07 1995 Geoff Voelker * makefile.nt (TRES): Defined. (TLIB1,TLIB2): Created out of TLIB. (TLIB): Split to reduce time to do library updates. (DOC): Use DOC-X. (strftime.obj): Compile with -Dstrftime=emacs_strftime. Sat May 6 03:09:24 1995 Richard Stallman * window.c (syms_of_window): Doc fix. (temp_output_buffer_show): If we use Vtemp_buffer_show_function, do nothing else. * s/bsd386.h (GETPGRP_NO_ARG): New definition. (BSD): Include sys/param.h instead of redefining BSD. But do this only if emacs is defined. * lisp.h (gc_cons_threshold): Change back to int. * alloc.c (gc_cons_threshold): Change back to int. (min): New macro. (inhibit_garbage_collection): Don't exceed value an int can hold. * xdisp.c (prepare_menu_bars): Clear size-change flag before running size-change functions. (scroll_step, debug_end_pos, line_number_display_limit): Now static. Fri May 5 00:35:42 1995 Richard Stallman * emacs.c (Fdump_emacs_data): Don't use & before my_edata. * editfns.c (Fencode_time): Rename arg from min to minute. (days_per_month): Move variable to top level. * process.c (wait_reading_process_input): Don't call prepare_menu_bars. Clear waiting_for_input around calling redisplay_preserve_echo_area. * xfns.c [USE_X_TOOLKIT] (x_window): Always pass position in geometry. Set XtNmappedWhenManaged to 0 for shell_widget. (Fx_create_frame): Always call x_wm_set_size_hints. * s/sol2-4.h (HAVE_VFORK): Add #undef. * s/netbsd.h (GETPGRP_NO_ARG): Defined. Thu May 4 21:45:27 1995 Richard Stallman * s/freebsd.h: (GETPGRP_NO_ARG): Defined (HAVE_GETPAGESIZE): Definition deleted. * data.c (store_symval_forwarding): Error if value out of range for an integer variable. (Fstring_to_number): Avoid using make_number to return value. Maybe use atol. Thu May 4 20:26:46 1995 Karl Heuer * buffer.c (Qbefore_string, Qafter_string): New vars. (syms_of_buffer): Initialize and staticpro them. (cmp_for_strings, overlay_strings): New functions. Thu May 4 01:13:53 1995 Richard Stallman * indent.c (string_display_width): Renamed from string_width. (vmotion): Use new name. * s/sco4.h [!__GNUC__] (LINKER): Defined. * insdel.c (make_gap): Don't allow buffer size that won't fit in int. Make this new error check also check exceeding VALBITS. (insert_1): Delete old error test. (min): New macro. * Makefile.in.in (${etc}DOC): Put SOME_MACHINE_OBJECTS before obj. * xfaces.c (region_face, next_face_id): Make static. * xselect.c (Vselection_converter_alist, x_selection_timeout) (Vx_sent_selection_hooks, Vx_lost_selection_hooks, Vselection_alist): Make static. * alloc.c (inhibit_garbage_collection): Use XSETINT, and do arithmetic in type EMACS_INT. * s/hpux9.h (HAVE_FMOD): Defined. * sysdep.c (bcmp, bcopy): Fix backward BSTRING conditionals. * emacs.c (Fkill_emacs): Delete the Vauto_save_list_file_name file. Thu May 4 13:23:55 1995 Morten Welinder * data.c (arith_driver): Make accum and next EMACS_INTs. (Fmod): i1 and i2 are EMACS_INT. * editfns.c (Fformat): Allow 30 characters in the printed version of integers and floats. * print.c (print): Handle long EMACS_INT in sprintf. * keyboard.c (Fexecute_extended_command): Handle long EMACS_INT in sprintf. * lread.c (read1): Handle long EMACS_INT in atol. * doprnt.c (doprnt): Handle long EMACS_INT in sprintf. * data.c (Fnumber_to_string, Fstring_to_number): Handle long EMACS_INT in sprintf and atol. * process.c (list_processes_1): Cast XFASTINT for passing to sprintf. * m/alpha.h (bcopy, bzero, bcmp): Don't let string.h prototype these. Wed May 3 20:12:25 1995 Morten Welinder * keyboard.c (parse_modifiers, apply_modifiers): Don't assume 32-bit EMACS_INT. (parse_modifiers): modifiers is an int, not an EMACS_INT. (read_key_sequence): Pass modifiers as int, not EMACS_INT. * buffer.h (Fdelete_overlay): Was mistakenly called Fdelete_overlays. * lisp.h (gc_cons_threshold): Make this an EMACS_INT. * alloc.c (gc_cons_threshold): Make this an EMACS_INT. (gc_sweep): Make already_free an EMACS_INT. * search.c (search_buffer): Cast p_limit to EMACS_INT not int. * s/osf1.h (GETPGRP_NO_ARG): Define. Wed May 3 16:23:53 1995 Richard Stallman * keyboard.c (reorder_modifiers): Use XINT. Cast apply_modifiers arg to int. * unexapollo.c: New file. * m/apollo.h (CANNOT_DUMP, VIRT_ADDR_VARIES, LIBS_TERMCAP) (NO_X_DESTROY_DATABASE): Macros deleted. (BSTRING): #undef deleted. (SYSTEM_TYPES): Redefinition deleted. (UNEXEC): New definition. (LD_SWITCH_SYSTEM): Define as empty. (C_SWITCH_MACHINE, LD_SWITCH_MACHINE): New definitions. (OLDXMENU_OPTIONS): New definition. * fileio.c (directory_file_name): Add APOLLO conditional. (Fcopy_file, Fset_file_modes): Delete APOLLO conditionals. * emacs.c: Delete all APOLLO conditionals. Tue May 2 19:03:13 1995 Karl Heuer * intervals.c (get_local_map): Use Fget_char_property, so that overlay properties will be considered as well as text properties. Tue May 2 02:15:23 1995 Richard Stallman * insdel.c (prepare_to_modify_buffer): Use file_truename for locking. * fileio.c (Finsert_file_contents): Use file_truename for unlocking. * buffer.c (Fset_buffer_modified_p): Use the truename for locking. * lread.c (read1): New arg FIRST_IN_LIST; all callers changed. Special handling for backquote and comma. (Qbackquote, Qcomma, Qcomma_at, Qcomma_dot): New variables. (syms_of_lread): Initialize and staticpro them. (Fread, Fread_from_string): Initialize new_backquote_flag. Mon May 1 19:11:28 1995 Karl Heuer * xmenu.c (xmenu_show, menubar_selection_callback): Move declaration of entry to an outer block, to guarantee its value is preserved. * keyboard.c (kbd_buffer_get_event): New arg USED_MOUSE_MENU. [USE_X_TOOLKIT]: Set *USED_MOUSE_MENU if returning menu-bar symbols. (read_char): Pass used_mouse_menu to kbd_buffer_get_event. This variable is now meaningful for toolkit menus as well as non-toolkit menus. * dispnew.c (update_frame): Don't put cursor in echo area unless the echo area is on this frame. * xdisp.c (redisplay): Don't move the cursor if it's supposed to be in the echo area. (display_text_line): Likewise. (echo_area_display): Put cursor in echo area if appropriate. Sun Apr 30 11:51:41 1995 Richard Stallman * emacs.c (standard_args): Add #ifdef VMS for -map. (main): Delete duplicate code for -version. (standard_args): Add -help and -version. * fileio.c (Fdo_auto_save): Record visited file name as well as auto-save file name in the auto-save-list-file-name file. Call Fexpand_file_name for auto-save-list-file-name. Sat Apr 29 01:30:51 1995 Richard Stallman * sysdep.c [HAVE_UNISTD_H]: Include unistd.h. * emacs.c (standard_args): Add -L/--directory/-directory. * s/sunos4shr.h (ORDINARY_LINK): Defined. (LINKER): Definition deleted. Sat Apr 28 23:59:49 1995 Karl Heuer * xfns.c (x_non_menubar_window_to_frame): New function. * xterm.h: Declare x_non_menubar_window_to_frame. * xmenu.c (popup_get_selection): Use x_non_menubar_window_to_frame. Either queue or dispatch the event, but not both. (dialog_selection_callback): Clear popup_activated_flag. * xmenu.c (Fx_popup_menu): If POSITION is just (menu-bar), use the current mouse position. (menubar_selection_callback): Use (menu-bar) instead of 'menu-bar. * keyboard.c (read_char, read_char_x_menu_prompt): Exclude menu-bar clicks when processing mouse clicks. * xterm.c (x_term_init): Add stub to initialize Vsystem_key_alist. Thu Apr 27 21:38:08 1995 Karl Heuer * process.c (create_process): Don't reference pty_name if !HAVE_PTYS. Wed Apr 26 05:08:25 1995 Richard Stallman * fileio.c (Ffile_regular_p): Use Qfile_regular_p. (syms_of_fileio): Set up Qfile_regular_p. * emacs.c (standard_args): Move -iconic and --icon-type to the end of the initial args. Tue Apr 25 19:46:40 1995 Karl Heuer * alloc.c (mark_kboards): Mark the kbd macro and Vsystem_key_alist. Mon Apr 24 14:43:07 1995 Richard Stallman * s/linux.h (REGEXP_IN_LIBC): Defined. * callproc.c (Fcall_process): Use bigger buffer, and grow it as we get more and more data. Mon Apr 24 11:44:02 1995 Karl Heuer * xterm.c (x_term_init): If the previous kboard was the dummy one, switch to the new one immediately. * keyboard.h (struct kboard): New member Vsystem_key_alist. * keyboard.c (Vsystem_key_alist): Delete global variable. (init_kboard): Initialize Vsystem_key_alist member. (syms_of_keyboard): Change DEFVAR_LISP to DEFVAR_KBOARD. (make_lispy_event): Use the kboard's alist instead of the global. * fns.c (Fplist_put): Don't signal an error if plist isn't a cons. * xterm.c (x_focus_frame, x_focus_event_frame, x_highlight_frame): Delete these vars; now part of struct x_display_info. (x_new_focus_frame): New arg DPYINFO. Callers changed. Use the struct members instead of the globals. Call x_frame_rehighlight instead of XTframe_rehighlight, so we can pass on the dpyinfo pointer. (x_mouse_leave): New arg DPYINFO. Callers changed. (XTframe_rehighlight): New arg FRAME. Callers changed. Now does all the work in x_frame_rehighlight. (x_frame_rehighlight): New function, code from XTframe_rehighlight. (XTread_socket): Use the struct members instead of the globals. (x_unfocus_frame, x_iconify_frame, x_destroy_window): Likewise. (x_display_box_cursor, x_make_frame_invisible): Likewise. (x_term_init): Initialize the struct members. (x_initialize): Delete initialization of deleted globals. * xfns.c (x_get_focus_frame): New arg FRAME. Callers changed. (Funfocus_frame): Unfocus on selected_frame's display. * xterm.h (struct x_display_info): New members x_focus_frame, x_focus_event_frame, x_highlight_frame, replacing global vars. * frame.c (do_switch_frame): Don't try to refocus termcap frames. * Makefile.in.in: Make dispnew.o and keyboard.o depend on xterm.h. Make intervals.o and term.o depend on keyboard.h. * xfns.c (x_window): Fix type mismatch. * xdisp.c (message_dolog): The message log doesn't need an undo list. * term.c (term_init): MagicWrap implies AutoWrap. Mon Apr 24 01:44:16 1995 Richard Stallman * keyboard.c (safe_run_hooks_1, safe_run_hooks_error): New subroutines. (safe_run_hooks): Handle errors to clear the hook, instead of always clearing it temporarily. * callproc.c (child_setup): Reword "can't exec" message. Add newline after message. * process.c (create_process): Don't abort if can't reopen pty_name in the child. Exit the child instead. Thu Apr 20 14:36:54 1995 Karl Heuer * abbrev.c (Fexpand_abbrev): Add some error checking. * xmenu.c (Fx_popup_dialog): Don't pass menubarp arg to xdialog_show. Wed Apr 19 16:49:52 1995 Karl Heuer * frame.h (struct frame): New member namebuf. * frame.c (make_frame): Initialize it. (Fdelete_frame): Free it. * xfns.c (x_window): Use (or reuse) frame's namebuf instead of a temp var. This avoids a storage leak. Wed Apr 19 02:08:43 1995 Richard Stallman * xmenu.c (xmenu_show, xdialog_show): Delete menubarp arg. (Fx_popup_menu): Don't compute menubarp. Tue Apr 18 14:37:21 1995 Richard Stallman * callproc.c (Fcall_process): Call Fexpand_file_name for error_file. * keyboard.c (map_event_to_object): Declaration deleted. Tue Apr 18 12:43:44 1995 Andreas Schwab * eval.c (Ffetch_bytecode): Check the type of the object being read from the file. Mon Apr 17 23:21:24 1995 Richard Stallman * editfns.c (Fencode_time): Don't treat years < 100 as special. Mon Apr 17 19:12:11 1995 Karl Heuer * lisp.h: Declare some functions. * buffer.c (adjust_overlays_for_insert): New function. (adjust_overlays_for_delete): New function. * insdel.c (insert_1): Adjust overlay center after inserting. (insert_from_string_1, insert_from_buffer_1): Likewise. (del_range_1): Adjust overlay center after deleting. Mon Apr 17 02:09:36 1995 Richard Stallman * editfns.c (Fencode_time): Rewrite by Naggum. Sat Apr 15 14:32:31 1995 Richard Stallman * xfns.c (x_report_frame_params): Report value of `display' parm. * Makefile.in.in (really-lwlib, really-oldXMenu): Mark as .PHONY. Fri Apr 14 17:04:56 1995 Karl Heuer * editfns.c (Fencode_time): Fix missing \n\'s. Fri Apr 14 14:20:50 1995 Richard Stallman * editfns.c (init_editfns): Add casts. * doc.c (get_doc_string): Add cast. * keyboard.c (kbd_buffer_get_event): Don't use prototype. * xdisp.c (message_log_check_duplicate): Make p1 and p2 unsigned char *. Thu Apr 13 23:56:21 1995 Richard Stallman * xterm.c (x_term_init): Call XtSetLanguageProc only if HAVE_X11XTR6. Thu Apr 13 13:38:56 1995 Karl Heuer * editfns.c (Fbuffer_string): Doc clarification. * alloc.c: Delete the #if that compares MARKBIT. * window.c (Fdisplay_buffer): Search the proper frame when the current frame is minibuffer-only. * fileio.c (Fexpand_file_name): Use IS_DIRECTORY_SEP instead of special code for WINDOWSNT. Thu Apr 13 12:18:03 1995 Richard Stallman * xfaces.c (compute_char_face): Don't use NULL. * buffer.c (Foverlays_at, Fnext_overlay_change): Don't use NULL. (Fprevious_overlay_change): Don't use NULL. * xfns.c (Fx_color_defined_p): Doc fix. * xfaces.c [! HAVE_X_WINDOWS] (build_face): Deleted. Wed Apr 12 19:30:30 1995 Andreas Schwab * callint.c (Fcall_interactively): Fix paren nesting. * buffer.c (evaporate_overlays): Fix type error. Thu Apr 13 01:09:02 1995 Richard Stallman * xterm.c (XTmouse_position): Handle X errors in XTranslateCoordinates. * lisp.h (MARKBIT): Do the shifting as unsigned int. Delete the #if that compares MARKBIT. Wed Apr 12 01:52:55 1995 Richard Stallman * xterm.c (XTread_socket): For ConfigureNotify, combine the USE_X_TOOLKIT and non-toolkit cases, which provides some things that were missing in the former. * alloc.c (gc_sweep): If a misc has type Lisp_Misc_Free, keep it on the free list. Sum pseudovector sizes properly. * dispnew.c (Fframe_or_buffer_changed_p): Ignore buffers whose names start with space. * editfns.c (Fencode_time): Use XINT to examine `zone'. Tue Apr 11 21:53:28 1995 Geoff Voelker * ntinevt.c (nt_kdb_patch_event): Created. * callproc.c (child_setup) [WINDOWSNT]: Removed syntax errors. * dired.c (Ffile_attributes) [WINDOWSNT]: Removed syntax errors. * fileio.c (Fexpand_file_name) [DOS_NT]: Preserve drive letter case. Fix syntax errors. Check drive letter when expanding ~\. * sysdep.c (sys_subshell) [WINDOWSNT]: Don't invoke restore_console. * ntproc.c (win32_wait): Reap synchronous subprocesses, and place return code in synch_process_retcode. * s/windowsnt.h (ctime): Defined to be nt_ctime. (NULL): Defined when missing from included system files. (EMACS_CONFIG_OPTIONS): Defined. (LISP_FLOAT_TYPE): Defined. (HAVE_TZNAME): Defined. (HAVE_TIMEVAL): Defined. (struct timeval): Defined. (struct timezone): Defined. * nt.c (nt_ctime): Defined. (gettimeofday): Defined. * ntinevt.c (do_mouse_event): Use XSETFASTINT. (SET_FRAME): Undefined. (select): Renamed to sys_select to correspond to routine in sysdep.c (sys_select): Support struct timeval. (key_event): Support German keyboard. Replace SET_FRAME with XSETFRAME. (nt_kbd_mods_to_emacs): Renamed to win32_kbd_mods_to_emacs. (win32_kbd_mods_to_emacs): Support AltGr on German keyboards. (win32_number_shift_map): Defined. (WIN32_KEY_SHIFTED): Defined. (win32_patch_key): Defined. (map_virt_key): Support VK_OEM_102 for German keyboards. (win32_mouse_position): Add arg insist. (do_mouse_event): Replace SET_FRAME with XSETFRAME. Use win32_kbd_mods_to_emacs. * fileio.c (directory_file_name) [WINDOWSNT]: Handle UNC format. * nt.c (nt_stat): Defined. * s/windowsnt.h (struct nt_stat): Defined. * ntinevt.h: Fixed function prototypes. * makefile.nt (TEMACS): Add dependence on $(BLD). * ntterm.c (Fset_message_beep): Defined. (ring_bell): Support audio cards. * makefile.nt (DOC): Defined. * s/windowsnt.h (HAVE_RANDOM): Defined. (random): Macro undefined. (srandom): Macro undefined. (HAVE_UTIME): Defined. (utime): Defined. (EMACS_CONFIGURATION): Defined. * nt.c (random): Defined. (srandom): Defined. * nt.c (readdir): Include "." and "..". (get_inode_and_device_vals): Handle directories. * fileio.c (Fexpand_file_name) [DOS_NT]: Don't strip slash from default dirs like "C:\\" * makefile.nt (all): Use COMPAT_LIB in library list. Use DEL_TREE instead of delnode. * ntheap.c (sbrk): Shrink heap by arbitrary amounts. * m/intel386.h (NO_ARG_ARRAY) [WINDOWSNT]: Defined. * s/windowsnt.h (_VARARGS_): Defined. (_CALLBACK_): Defined. Tue Apr 11 18:46:27 1995 Roland McGrath * process.c (create_process): Set PROCESS's tty_name to Qnil when !PTY_FLAG, so Fprocess_tty_name returns nil for pipes as its docstring says. Tue Apr 11 04:23:05 1995 Richard Stallman * keyboard.c (read_char): Rearrange code so that getcjmp is set only around sit_for and kbd_buffer_get_event, and and polling is stopped only around the kbd_buffer_get_event call. (Ftrack_mouse, tracking_off, read_char): Don't call prepare_menu_bars. * dispnew.c (init_desired_glyphs): New function. * xdisp.c (redisplay): Call init_desired_glyphs for each frame. Call prepare_menu_bars. (prepare_menu_bars): Delete code at beginning that duplicates things done at the beginning of redisplay. * alloc.c (inhibit_garbage_collection): New function. * xterm.c (XTread_socket): Pass dpyinfo to popup_get_selection. * xmenu.c (popup_get_selection): Queue up events that aren't for the menu, and process them afterward. New arg dpyinfo. (set_frame_menubar): Use inhibit_garbage_collection. [USE_X_TOOLKIT] (xmenu_show): Delete the queue code here. Pass dpyinfo to popup_get_selection. Don't call lw_destroy_all_widgets. [USE_X_TOOLKIT] (xdialog_show): Simplify using popup_get_selection. Mon Apr 10 19:00:14 1995 Richard Stallman * callint.c (Fcall_interactively): Fix handling of @ when it tests whether the event has a window in it. * s/sco4.h (NO_SOCKETS_IN_FILE_SYSTEM): Defined. * eval.c (internal_condition_case): Abort if interrupt_input_blocked>0. * xmenu.c (set_frame_menubar): Don't block input until after the menubar maps have been decoded. Mon Apr 10 18:35:22 1995 Karl Heuer * keyboard.c (push_frame_kboard, pop_frame_kboard): Do nothing if !MULTI_KBOARD. * keyboard.c (init_keyboard): Don't malloc a new structure; initial_kboard should already exist for that. * frame.c (make_terminal_frame): Put initial_kboard on the list of all kboard objects. Mon Apr 10 00:38:16 1995 Richard Stallman * xmenu.c (popup_get_selection): For ButtonRelease event, clear dpyinfo->grabbed. * window.c (temp_output_buffer_show): Select the chosen window temporarily for running temp-buffer-show-hook. (syms_of_window): Fix typo. * s/osf1.h: Don't include alloca.h, string.h here. (malloc. realloc, xmalloc, xrealloc): Declarations moved to m/alpha.h. * m/alpha.h: Include alloca.h, string.h here. (malloc. realloc, xmalloc, xrealloc): Declarations moved from s/osf1.h. * xdisp.c (display_mode_line): Use push_frame_kboard, pop_frame_kboard. * xfns.c (x_window): Copy the frame name to non-Lisp string. * keyboard.c (any_kboard_state): Renamed from unlock_kboard. Define it unconditionally, but it's a no-op unless MULTI_KBOARD. (single_kboard_state): New function. (push_frame_kboard, pop_frame_kboard): New functions. (single_kboard): Renamed from kboard_locked. * keyboard.h (single_kboard): Renamed from kboard_locked. All refs renamed. (struct kboard): Move flag fields to the end, and make them chars. Delete the `unused' field. * callint.c (Fcall_interactively): Call single_kboard_state to switch to the single-kboard state. * minibuf.c (read_minibuf): Call single_kboard_state to switch to the single-kboard state. * alloc.c, data.c, macros.c, print.c: Include keyboard.h. * Makefile.in.in (alloc.o, data.o, macros.o, print.o): Depend on keyboard.h. * xterm.h (x_display_info): Use `struct kboard', not KBOARD. * frame.h (struct frame): Use `struct kboard', not KBOARD. * keyboard.h (KBOARD, etc): Moved from lisp.h. (struct kboard): Renamed from struct KBOARD. * lisp.h (KBOARD, etc): Moved to keyboard.h. Sun Apr 9 00:51:09 1995 Richard Stallman * keyboard.c (unlock_kboard): Do nothing with Vunread_command_events. (read_char): Clean up logic for reading from KBOARD queues. * xfns.c (defined_color): Fix typo (duplicate +). * keyboard.c (kbd_buffer_get_event): Set copy by assignment, not init. * xterm.c (XTread_socket): Make deiconify event only if frame was iconified. * xrdb.c (xmalloc, xrealloc): Declare them here. Sat Apr 8 20:42:00 1995 Erik Naggum * editfns.c (Fencode_time): New function, to match `decode-time'. Sat Apr 8 00:19:38 1995 Richard Stallman * intervals.c (set_point): When skipping intangible text, stop where property value changes. * indent.c (Fmove_to_column): Fix minor bug in prev change. * lread.c (read_escape): Undo Nov 15 change. * xdisp.c (display_mode_line): Test mode_line_inverse_video before highlighting partial-width mode line. * xmenu.c (popup_activate_callback): Increment popup_activated_flag. (popup_deactivate_callback): Decrement it. * s/linux.h (HAVE_SELECT, HAVE_TIMEVAL): Definitions deleted. config.h should handle them. * xdisp.c (redisplay): Don't call update_frame for non-selected termcap frame. Sat Apr 8 04:37:32 1995 Noah Friedman * window.c (Fnext_window, Fprevious_window): If all_frames is a frame and window is not on that frame, return the first window on that frame. Fri Apr 7 19:59:01 1995 Richard Stallman * lread.c (init_lread): Add site-lisp under the installation dir to Vload_path if that exists. * s/osf1.h (xmalloc, xrealloc): Declare them. * frame.c (make_terminal_frame): Use Emacs, Emacs-2, ... as name. * xdisp.c (decode_mode_spec): Add %F code. Order alternatives alphabetically. * s/aix4.h: Use "..." in #include. Fri Apr 7 10:16:44 1995 Morten Welinder * s/osf1.h: Include alloca.h, string.h. Test NOT_C_CODE. * m/alpha.h (SPECIAL_EMACS_INT): Defined. Fri Apr 7 19:09:53 1995 Karl Heuer * keyboard.c (kbd_buffer_get_event): Check for frame buried in a cons. Delete menu_bar_event handling code. (make_lispy_event): Move it here, so it gets a switch-frame if needed. * callint.c (Fcall_interactively): Fix previous change. Fri Apr 7 00:02:45 1995 Richard Stallman * doprnt.c (xmalloc, xrealloc): Declare them here. * callint.c (Fcall_interactively): `+' is reserved for user changes. * process.c (read_process_output_error_handler) (exec_sentinel_error_handler): Fsleep_for wants two args. * xfns.c (validate_x_resource_name): Change invalid chars to `_'. * doprnt.c (doprnt): Cast pointer to int by way of EMACS_INT. * xmenu.c (menubar_selection_callback, dialog_selection_callback) (single_submenu): Cast pointer to int by way of EMACS_INT. * floatfns.c (Flogb): Use EMACS_INT for `value'. * editfns.c (Fformat): Cast int to pointer by way of EMACS_INT. * search.c (search_buffer): Avoid casting trt to int. Use EMACS_INT for comparing pointers. * buffer.h (Fdelete_overlays): Add declaration. * keyboard.c (parse_modifiers): Use type EMACS_INT for `modifiers'. * xterm.c (dumpglyphs): Cast FACE_DEFAULT to (XFontStruct *) for comparison with face->font. * sysdep.c (bcopy): If NEED_BCOPY, do compile this. * m/ncr386.h: New file. * s/hpux9.h (LD_SWITCH_X_DEFAULT): New definition. (C_SWITCH_X_DEFAULT): New definition. * doc.c (get_doc_string): In (STRING . INTEGER), if INTEGER is negative, negate it. * eval.c (Fuser_variable_p): For (STRING . INTEGER), test sign. * s/sol2.h (C_SWITCH_X_SYSTEM): Defined. * s/usg5-4-2.h (LIBS_SYSTEM): New override definition. * lisp.h (XMISCTYPE): New macro. (union Lisp_Misc): Delete the `type' field. Use XMISCTYPE instead of that. * alloc.c (Fmake_marker, mark_object): Use XMISCTYPE. (clear_marks, gc_sweep): Use u_marker union elt to extrat misc type. * lread.c (defvar_int, defvar_bool, defvar_lisp_nopro, defvar_kboard) (defvar_per_buffer): Use XMISCTYPE. * print.c (print): Use XMISCTYPE. * fns.c (internal_equal): Use XMISCTYPE. * buffer.c (Fmake_overlay): Use XMISCTYPE. * data.c (Ftype_of, do_symval_forwarding, store_symval_forwarding) (find_symbol_value, Fmake_variable_buffer_local, Fmake_local_variable): Use XMISCTYPE. * xdisp.c (prepare_menu_bars): Do the frame titles last. Thu Apr 6 17:54:20 1995 Richard Stallman * xfaces.c (intern_face): Cast FACE_DEFAULT to (XFontStruct *) for comparison with face->font. * puresize.h (CHECK_IMPURE): Remove & from before my_edata. * editfns.c (Fformat_time_string): Use emacs_strftime. Doc fix. * Makefile.in.in (strftime.o): Define strftime as emacs_strftime. * xmenu.c (frame_vector): New static variable. (syms_of_xmenu): staticpro it. (frame_vector_add_frame): New function. (set_frame_menubar): Use frame_vector; use index as the widget id. (free_frame_menubar): Likewise. Remove the frame from frame_vector. (menubar_selection_callback): Use frame_vector to turn id into frame. * emacs.c (main): Cast arg to `brk'. * sysdep.c (init_sys_modes): Use TCOON only if defined. * s/netbsd.h (NO_MATHERR): Defined. (LIBS_SYSTEM): Definition deleted. * unexsunos4.c: Treat __NetBSD__ like __FreeBSD__. Thu Apr 6 14:49:30 1995 Karl Heuer * fns.c (Fplist_put): Fix missing \n\. * xfns.c (x_window_to_frame): Skip non-X frames before testing dpyinfo. [USE_X_TOOLKIT] (x_any_window_to_frame, x_top_window_to_frame): Ditto. Thu Apr 6 08:00:06 1995 Simon Marshall * data.c (Fcar, Fcdr, Fsetcar, Fsetcdr): Arg name doc fixes. Thu Apr 6 01:18:11 1995 Richard Stallman * puresize.h (BASE_PURESIZE): Increment to 310000. * indent.c (string_width): New function. (vmotion): Compute the width of minibuf_prompt if it isn't already known. * buffer.c (Fkill_buffer): Call reset_buffer_local_variables and swap_out_buffer_local_variables. (swap_out_buffer_local_variables): New subroutine. (Fkill_all_local_variables): Use that subroutine. * search.c (Flooking_at, Fposix_looking_at): Change arg name. Wed Apr 5 22:52:55 1995 Richard Stallman * frame.c (Fraise_frame, Flower_frame): Now interactive. Tue Apr 4 22:53:24 1995 Karl Heuer * lisp.h: Declare Ffetch_bytecode. * eval.c (Ffetch_bytecode): New function. (funcall_lambda): Call it. (syms_of_eval): defsubr it. Mon Apr 3 17:48:22 1995 Karl Heuer * xfns.c (x_window_to_frame): New arg DPYINFO. All callers changed. (x_any_window_to_frame, x_top_window_to_frame): Likewise. * lisp.h (Vmessage_log_max): Declare this variable. (message_nolog): Declare this function. * emacs.c (main): Start with an empty message log. * xdisp.c (message_nolog): New function. * fns.c (Fy_or_n_p): Don't log prompt. (Fyes_or_no_p): Fix typo in doc string. Sat Apr 1 01:13:50 1995 Richard Stallman * lread.c (oblookup): Save bucket num in oblookup_last_bucket_number. (Funintern): New function. (syms_of_lread): defsubr it. Fri Mar 31 23:31:22 1995 Richard Stallman * dired.c (Fdirectory_files): Fix bug in IS_ANY_SEP usage introduced in Oct 30 change. Fri Mar 31 14:25:43 1995 Karl Heuer * keyboard.c (command_loop_1): If we ignore force_start, then also ignore beg_unchanged and end_unchanged. Fri Mar 31 09:55:41 1995 Michael Ernst * lread.c (isfloat_string): Permit trailing space. Thu Mar 30 19:07:04 1995 Karl Heuer * keyboard.c (event_to_kboard): Ignore dead frames. (kbd_buffer_get_event): In batch mode, use current_kboard. * xterm.c (x_delete_display): Extract kboard deletion, for modularity. * keyboard.c (wipe_kboard): Make this function static. (delete_kboard): New function, extracted from x_delete_display. * lisp.h: Declare function delete_kboard. * xterm.h (struct x_display_info): New member cut_buffers_initialized. * xterm.c (x_term_init): Initialize it. * xselect.c (Fx_store_cut_buffer_internal): Use the flag in the frame's x_display_info, not a global flag. (Fx_rotate_cut_buffers_internal): Likewise. * emacs.c (sort_args): Skip strncmp if longname is a null pointer. Thu Mar 30 04:22:00 1995 Richard Stallman * data.c (Fmod): Fix the final adjustment, when i2 < 0 and i1 == 0. Wed Mar 29 01:07:28 1995 Richard Stallman * frame.c [MULTI_FRAME] (Factive_minibuffer_window): New function. [MULTI_FRAME] (syms_of_frame): Defsubr it. Tue Mar 28 18:32:08 1995 Karl Heuer * process.c (Fsignal_process): SIGCODE is a symbol, not a string. Tue Mar 28 02:38:16 1995 Richard Stallman * fns.c (Fconcat): Undo previous change. Mon Mar 27 16:10:46 1995 Richard Stallman * fns.c (Fget, Fput): Fetch and store symbol's plist directly. Mon Mar 27 10:26:49 1995 Boris Goldowsky * fns.c (Fplist_put, Fplist_get): New fns. (Fget): Use Fplist_get to do the work. (Fput): Use Fplist_put to do the work. * textprop.c (Vdefault_text_properties): name changed from Vdefault_properties. * intervals.h: As above. * intervals.c (textget): As above. * intervals.c (textget_direct): Fn deleted. (textget, verify_interval_modification): Use Fplist_get instead. * intervals.h: Remove declaration. Sun Mar 26 03:45:13 1995 Richard Stallman * xterm.c (XTmouse_position): New arg `insist'. * ntinevt.c (win32_mouse_position): New arg `insist'. * msdos.c (mouse_get_pos): New arg `insist'. * xmenu.c (Fx_popup_menu): Pass 1 for `insist' arg. (Fx_popup_dialog): Likewise. * frame.c (Fmouse_position--both definitions): Pass 0 for `insist'. (Fmouse_pixel_position): Pass 0 for `insist'. Add HAVE_MOUSE conditional. * keyboard.c (kbd_buffer_get_event): Pass 0 for `insist' arg. * m/intel386.h (C_SWITCH_SYSTEM): Don't #undef or define it. [SOLARIS2, SOLARIS2_4, !__GNUC__] (C_SWITCH_MACHINE): Define instead. Sun Mar 26 03:02:28 1995 Germano Caronni * ralloc.c (r_re_alloc): Correct realloc behavior--allow shrinking of blocks while reallocating, if shrinking by more than one page. (relocate_blocs, resize_blocs): Added failsafe to protect future calling of these routines when in frozen state. (r_alloc_thaw): Added call to r_alloc_init. (relocate_blocks, resize_bloc, r_alloc_sbrk, r_alloc_thaw): Extended functionality to let ralloc package work in frozen state, allowing for the existence of unused blocks. Sat Mar 25 21:02:37 1995 Richard Stallman * process.c (Fsignal_process): Allow signal names as well as numbers. Fri Mar 24 23:47:47 1995 Richard Stallman * editfns.c (init_editfns): Use NAME envvar to init user-full-name. Fri Mar 24 17:38:35 1995 Karl Heuer * textprop.c (Fnext_property_change): Fix previous change. Thu Mar 23 19:40:04 Kevin Rodgers * print.c (temp_output_buffer_setup): (Re)set the default directory of the temp buffer to that of the current buffer. Thu Mar 23 16:30:17 1995 Karl Heuer * buffer.c (syms_of_buffer): Doc fix. * xdisp.c (redisplay): Make sure pause is set before used. Delete unused vars. (redisplay_window): Make sure update_mode_line is set before used. If startp might not have been set, use w->start directly. (try_window_id): In the easy case, find cursor pos before returning. (try_window_id): Stop scan at bottom of window, not one line later. Don't fail on account of continuation line below window. (redisplay_window): Stop scan at bottom of window. Fix reversed condition. * Makefile.in.in (FRAME_SUPPORT, MSDOS_SUPPORT): Don't list face and mouse related files here. (FACE_SUPPORT, MOUSE_SUPPORT): New lists. (FACE_SUPPORT): Add facemenu.elc. (WINNT_SUPPORT): New list. (lisp): Add format.elc, FACE_SUPPORT, MOUSE_SUPPORT, WINNT_SUPPORT. Thu Mar 23 12:01:22 1995 Richard Stallman * m/sparc.h: Don't include alloca.h if NOT_C_CODE. * m/mips-siemens.h (UNEXEC): Override the definition. (LIBS_DEBUG, ORDINARY_LINK): Add #undefs. Wed Mar 22 12:43:34 1995 Karl Heuer * dispnew.c (direct_output_forward_char): Don't use direct output at an overlay boundary. * buffer.c (overlay_touches_p): New function. * lisp.h: Declare overlay_touches_p. * fns.c (concat): Treat integers as characters, not strings. This makes `concat' more like `insert'. * window.c (syms_of_window): Fix missing \n\. * keymap.c (Fwhere_is_internal): Fix missing \n\. * fileio.c (syms_of_fileio): Fix missing \n\. Tue Mar 21 01:15:00 1995 Marco Walther * unexelfsni.c: New file. * m/mips-siemens.h: Total rewrite. Mon Mar 20 18:32:13 1995 Richard Stallman * xdisp.c (redisplay_window): Skip the only-point-has-changed optimization if updating the window's mode line. Sun Mar 19 13:47:20 1995 Richard Stallman * xdisp.c (invisible_p, invisible_ellipsis_p): Handle list as invisible property value. Sat Mar 18 18:07:21 1995 Richard Stallman * xdisp.c (display_menu_bar): Just one space between menu items. Sat Mar 18 06:15:50 1995 Ted Lemon * emacs.c (dump-emacs-data, dump-emacs): Declare my_edata as char array. * lastfile.c (my_edata): Declare as char array, not int. * puresize.h (CHECK_IMPURE): Declare my_edata as char array. Fri Mar 17 20:30:51 1995 Richard Stallman * lread.c (Vload_read_function): New variable. (readevalloop): Use that variable. (syms_of_lread): Set up Lisp variable. Fri Mar 17 13:16:53 1995 Boris Goldowsky * buffer.h (struct buffer): Add file_format member. * buffer.c (reset_buffer): Reset file_format element too. (init_buffer_once): Define file_format flag; reset file_format. (syms_of_buffer): New vbl buffer-file-format. * fileio.c (Finsert_file_contents): Call format-decode. (build_annotations): Call format-annotate-function for each element of buffer-file-format. (Vauto_save_file_format): New vbl. (build_annotations): Use it. Fri Mar 17 02:40:46 1995 Richard Stallman * alloc.c (init_alloc_once): Increase gc_cons_threshold to 300000. Wed Mar 15 16:37:33 1995 Richard Stallman * xfns.c (x_decode_color): Don't use cdef if defined_color failed. Wed Mar 15 15:10:47 1995 Karl Heuer * config.h.in [HAVE_X_WINDOWS] (MULTI_KBOARD): Define this symbol. Tue Mar 14 19:03:03 1995 Karl Heuer * lisp.h (struct KBOARD, MULTI_KBOARD, current_kboard, all_kboards): (Lisp_Misc_Kboard_Objfwd, Lisp_Kboard_Objfwd, XKBOARD_OBJFWD): (KBOARD_OBJFWDP, GC_KBOARD_OBJFWDP, kboard_locked, the_only_kboard): (DEFVAR_KBOARD): Renamed from PERDISPLAY, MULTI_PERDISPLAY, current_perdisplay, all_perdisplays, Lisp_Misc_Display_Objfwd, Lisp_Display_Objfwd, XDISPLAY_OBJFWD, DISPLAY_OBJFWDP, GC_DISPLAY_OBJFWDP, display_locked, the_only_perdisplay, DEFVAR_DISPLAY. All uses changed. (struct KBOARD): New member reference_count. (initial_kboard): Declare this var. * .gdbinit (xkbobjfwd): Renamed from xdispobjfwd. * frame.h (struct frame): New member kboard. (FRAME_KBOARD): Accessor macro for that member, replacing get_perdisplay. * xterm.h (struct x_display_info): member kboard (formerly perdisplay) is now a pointer, not an actual struct. (get_perdisplay, get_perdisplay_macro): Deleted. * xfns.c (Fx_create_frame): set the frame's kboard member. * xterm.c (get_perdisplay): Deleted. (same_x_server): New function. (x_term_init): If this display shares a keyboard with one we've already opened, then share the structure. (x_delete_display): Don't delete the kboard until the reference count becomes zero. * lread.c (defvar_kboard): Renamed from defvar_display. * alloc.c (mark_kboards): Renamed from mark_perdisplays. * frame.c (make_frame): Initialize kboard member. (make_terminal_frame): Create initial_kboard if not already set. * keyboard.c (unlock_kboard): Renamed from unlock_display. (wrong_kboard_jmpbuf): Renamed from wrong_display_jmpbuf. (event_to_kboard): Renamed from event_to_perdisplay. (kbd_buffer_get_event): If no associated kboard, store current_kboard rather than the first kboard in the global list. (init_kboard): Renamed from init_perdisplay. Initialize reference count. (wipe_kboard): Renamed from wipe_perdisplay. * data.c (find_symbol_value): current_perdisplay now is never null. (store_symval_forwarding, do_symval_forwarding): Likewise. Tue Mar 14 00:45:13 1995 Richard Stallman * data.c (Fash): Fix previous change. * buffer.c (Fmake_indirect_buffer): Invert the arguments. * marker.c (unchain_marker): Allow differing buffers as long as they have the same text. Mon Mar 13 16:47:12 1995 Karl Heuer * keyboard.c (event_to_perdisplay): New function. (kbd_buffer_get_event): Use event_to_perdisplay. (kbd_buffer_store_event): If C-g arrives while we're in the run state on behalf of another display, just clear the queue and deposit the C-g to be read later. (read_key_sequence): After a throw, unwind delayed_switch_frame as well as keybuf. Don't insert an extra switch-frame if empty. * print.c (print): current_perdisplay now is never null. * callint.c (clear_prefix_arg): Likewise. * macros.c (Fexecute_kbd_macro): Likewise. Mon Mar 13 02:19:09 1995 Richard Stallman * minibuf.c (read_minibuf): Save Voverriding_local_map. (read_minibuf_unwind): Restore Voverriding_local_map. Mon Mar 13 01:33:40 1995 Andreas Schwab * unexelf.c (unexec): Adjust the file offset of sections located after the section header table. Sun Mar 12 21:49:33 1995 Karl Heuer * keyboard.c (unlock_display): current_perdisplay now is never null. (cmd_error, command_loop_1, read_char): Likewise. (kbd_buffer_get_event, read_key_sequence): Likewise. (read_char): Handle synchronous quit_char on a different display. (read_char): Rewrite queue-searching code. (read_key_sequence): Save selected_frame. (init_keyboard): Initialize current_perdisplay. Sun Mar 12 00:01:03 1995 Richard Stallman * keyboard.c (parse_modifiers_uncached): Delete the code for multi-character modifiers and for recognizing a modifier alone. (parse_solitary_modifier): New function. (convert_event_type_list): Use parse_solitary_modifier. Also convert symbol A to character A. Handle shift modifier with lower-case letters. * window.c (Fdisplay_buffer): Fix prev change--return sel window. * indent.c (compute_motion, Fmove_to_column, current_column) (character_width): Let display table handle \n, \r, \t. (compute_motion): Fix logic in previous change wrt skipping invisible. Sat Mar 11 01:01:42 1995 Richard Stallman * xdisp.c (display_text_line): When setting selective_rlen, ignore whether selective display is on or off. * textprop.c (Fnext_property_change): Handle LIMIT = t. * indent.c (compute_motion): Call recenter_overlay_lists sooner. Use Fnext_property_change to get a quick lower bound for where `invisible' changes. Fri Mar 10 19:50:03 1995 Richard Stallman * data.c (Fash, Flsh): Change arg names. Thu Mar 9 18:45:06 1995 Richard Stallman * intervals.h (TEXT_PROP_MEANS_INVISIBLE): New macro. (TEXT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS): New macro. * xdisp.c (display_text_line, try_window): Check `invisible' prop using TEXT_PROP_MEANS_INVISIBLE. (display_text_line): Check TEXT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS; if it says so, use ellipses after invisible text. (invisible_p, invisible_ellipsis_p): New functions. * indent.c (compute_motion, vmotion): Check `invisible' prop using TEXT_PROP_MEANS_INVISIBLE. * buffer.h (struct buffer): New field `invisibility_spec'. * buffer.c (reset_buffer_local_variables): Init invisibility. (init_buffer_once): Set up buffer_local_flags for it. (syms_of_buffer): New variable `buffer-invisibility-spec'. Wed Mar 8 21:57:52 1995 Richard Stallman * syntax.c (Fforward_comment): Always clear immediate_quit for return. Wed Mar 8 17:47:37 1995 Karl Heuer * sysdep.c (read_input_waiting): Fix Lisp_Object vs. int problem. Tue Mar 7 19:41:09 1995 Karl Heuer * lisp.h (struct PERDISPLAY): New member kbd_queue_has_data. * keyboard.c (unlock_display): If adding to kbd_queue, set kbd_queue_has_data. (read_char): Set and clear kbd_queue_has_data appropriately, but leave it unset when we push back an incomplete sequence. (read_char): Take the longjmp even if current_perdisplay was null. (readable_events): Check kbd_queue_has_data instead of kbd_queue. (init_perdisplay): Initialize kbd_queue_has_data. * keyboard.c (command_loop_1): Removed inline code for prefix args. * callint.c (current_prefix_partial): New var. (Funiversal_argument): New function, formerly inlined in keyboard.c. (Fnegative_argument, Fdigit_argument): Likewise. (clear_prefix_arg): Moved here from keyboard.c. Don't clear the internal state if we're still building a prefix arg. (finalize_prefix_arg, describe_prefix_arg): Moved from keyboard.c. (syms_of_callint): defsubr the new functions. * lisp.h: Declare new var and functions. * lisp.h (struct PERDISPLAY): New member Vlast_kbd_macro. * alloc.c (mark_perdisplays): Mark it here. * keyboard.c (init_perdisplay): Initialize it here. * macros.c (Fstart_kbd_macro): Access Vlast_kbd_macro via perdisplay. (Fend_kbd_macro, Fcall_last_kbd_macro): Likewise. (init_macros): Delete initialization. (syms_of_macros): Use DEFVAR_DISPLAY for Vlast_kbd_macro. Doc fix for executing-macro, executing-kbd-macro, last-kbd-macro. * keyboard.c (cmd_error): Bind Vprint_level and Vprint_length. Mon Mar 6 23:55:38 1995 Karl Heuer * keyboard.c (command_loop_1): Fix test for prefix arg. Mon Mar 6 10:17:14 1995 Boris Goldowsky * textprop.c (Vdefault_properties): New variable. * intervals.h: Declare it. * intervals.c (textget): Check it. Fri Mar 3 02:01:52 1995 Richard Stallman * callint.c (Fcall_interactively): Fix Feb 22 change. * keyboard.c (read_key_sequence): Update orig_local_map for some additional gotos to replay_sequence. * process.c (exec_sentinel, read_process_output): If running filter or sentinel changes the local map, call record_asynch_buffer_change. Thu Mar 2 20:45:08 1995 Karl Heuer * xdisp.c (display_mode_line): Temporarily set current_perdisplay to reference the frame we're updating. * lisp.h (struct PERDISPLAY): New members defining_kbd_macro, kbd_macro_buffer, kbd_macro_ptr, kbd_macro_end, kbd_macro_bufsize. * macros.h (defining_kbd_macro): Delete declaration. * macros.c (defining_kbd_macro): Delete; now part of perdisplay. All uses changed. (kbd_macro_buffer, kbd_macro_ptr, kbd_macro_end): Likewise. (kbd_macro_bufsize): Likewise. (Fstart_kbd_macro): Initialize kbd_macro_buffer if not already done. (init_macros): Delete initialization of defining_kbd_macro. (syms_of_macros): Delete initialization of kbd_macro_buffer. * keyboard.c (read_char_minibuf_menu_prompt): orig_defn_macro is now a Lisp_Object, not an int. (init_perdisplay): Initialize some of the new members. (wipe_perdisplay): Free kbd_macro_buffer. * keyboard.c (cmd_error): Allow current_perdisplay to be null. * keyboard.c (read_key_sequence): New arg can_return_switch_frame. All callers changed. (Fread_key_sequence): Likewise. * callint.c (Fcall_interactively): Defer switch-frame events when reading `k' or `K' specification. Thu Mar 2 14:37:26 1995 Richard Stallman * emacs.c (syms_of_emacs): Doc fix. Thu Mar 2 02:28:04 1995 John Grabowski * xfns.c (defined_color): If colormap is full, find closest match. * xfaces.c (load_color): Call defined_color to allocate the color. Wed Mar 1 01:58:34 1995 Richard Stallman * xterm.c (x_connection_closed): Ignore non-X frames. Fix the logic for deleting frames that use separate minibuffers that are on the dead connection. * buffer.c (Fpop_to_buffer): Call Fset_buffer_major_mode if we create a buffer. Tue Feb 28 18:33:11 1995 Karl Heuer * keyboard.c (cmd_error): Use clear_prefix_arg. (internal_last_event_frame, Vlast_event_frame): Normal vars again. All uses changed. (Quniversal_argument, Qdigit_argument, Qnegative_argument): Declare. (clear_prefix_arg, finalize_prefix_arg, describe_prefix_arg): New fns. (command_loop_1): Handle digits and minus specially, when they're part of a prefix arg. Handle universal-argument and digit-argument and negative-argument bindings here, rather than doing I/O in the Lisp code. (read_char): When reading switch-frame events from the side queue, set internal_last_event_frame. (readable_events): Return non-zero if a side queue has data. (kbd_buffer_get_event): Don't abort if event has no associated frame. (read_key_sequence): Improve behavior when there's no current display. (init_perdisplay): Initialize the new members. * callint.c (Fcall_interactively, syms_of_callint): Undo Jan 31 change. (Vprefix_arg, Vcurrent_prefix_arg): Undo Jan 31 change. * mocklisp.c (Fml_provide_prefix_argument, Fml_prefix_argument_loop): Undo Jan 31 change. * minibuf.c (read_minibuf, read_minibuf_unwind): Undo Jan 31 change. * frame.c (do_switch_frame): Undo Feb 6 change. * macros.c (Fexecute_kbd_macro): Use clear_prefix_arg. * lisp.h (struct PERDISPLAY): Add prefix_factor, prefix_value, prefix_sign, prefix_partial. Delete Vcurrent_prefix_arg and Vprefix_arg; those are now plain vars again. * alloc.c (mark_perdisplays): Update to reflect current Lisp_Objects. (NSTATICS): Increase to 768. Tue Feb 28 12:56:36 1995 Richard Stallman * frame.c (Fframep): Doc fix. Tue Feb 28 00:20:50 1995 Karl Heuer * callint.c (Fcall_interactively): Lock the display before executing the command, no matter how we execute it. Sun Feb 26 02:44:35 1995 Richard Stallman * keyboard.c (convert_event_type_list): New function. (lucid_event_type_list_p): New function. (parse_modifiers_uncached): If MODIFIERS_END is -1, look for just a modifier. Guts rewritten. * keymap.c (Fdefine_key): Handle Lucid-style (crtl backspace) etc. (Flookup_key): Likewise. * callproc.c (Fcall_process): Extend BUFFER arg so it can specify a separate output file for stderr output. (Fcall_process_region): Doc fix. Sat Feb 25 03:31:33 1995 Richard Stallman * xmenu.c (Fx_popup_menu): Init f from selected_frame before calling mouse_position_hook. * window.c (Vsame_window_buffer_names, Vsame_window_regexps): New vars. (syms_of_window): Set up Lisp vars. (Fdisplay_buffer): Use those vars--if requested, use current window. Fri Feb 24 23:03:10 1995 Karl Heuer * keyboard.c (unlock_display): New function. (cmd_error, command_loop_1): Call it when appropriate. (read_char): If no current display, don't try to echo. * term.c (term_init) [TERMINFO]: Make error message more accurate. Thu Feb 23 22:35:58 1995 Richard Stallman * keymap.c (Fglobal_set_key, Flocal_set_key, Fglobal_unset_key) (Flocal_unset_key): Functions deleted (moved to simple.el). (syms_of_keymap): Don't defsubr them. Thu Feb 23 21:25:41 1995 Karl Heuer * keyboard.c (display_locked): New var to indicate when we're in the run state. current_perdisplay is now meaningful in the wait state as well. (cmd_error): Clear display_locked in addition to current_perdisplay. (command_loop_1): outer_perdisplay renamed from global_perdisplay. Restore display_locked as well as current_perdisplay. (read_char): read_char_perdisplay merged with current_perdisplay. (read_key_sequence): Likewise. * minibuf.c (read_minibuf): Make sure the display is locked. * callint.c (Fcall_interactively): If the display hasn't already been locked by reading from the minibuffer, lock it before executing the command. * lisp.h (display_locked): Declare this var. Thu Feb 23 01:00:04 1995 Richard Stallman * window.c (syms_of_window): Doc fixes. * keymap.c (Fwhere_is_internal): If FIRSTONLY is not nil or non-ascii, completely ignore menu bindings. * xmenu.c (menu_item_equiv_key): Delete the code that rejected menu bindings returned by Fwhere_is_internal. * window.c (window_loop): Handle special display buffer frames for DELETE_BUFFER_WINDOWS as for UNSHOW_BUFFER. Wed Feb 22 23:54:22 1995 Richard Stallman * callint.c (Fcall_interactively): Use markers temporarily in args vector to stand for point and mark values; replace them with integers just before calling the command. Tue Feb 21 22:01:17 1995 Karl Heuer * lisp.h (struct PERDISPLAY): New member kbd_queue. Delete obsolete members kbd_buffer_frame_or_window, kbd_buffer, kbd_fetch_ptr, kbd_store_ptr; these are regular vars again. * alloc.c (mark_perdisplays): Mark kbd_queue. Remove reference to obsolete kbd_buffer_frame_or_window. * xmenu.c (menubar_selection_callback): frame_or_window field of a menu-bar event now includes both the frame and the magic cookie. * keyboard.c (kbd_buffer_frame_or_window): Restored old var. (kbd_buffer, kbd_fetch_ptr, kbd_store_ptr): Likewise. (read_char_perdisplay): New var. (read_char): Search all appropriate perdisplay objects, and do the right thing if the next event comes from a different source. (read_key_sequence): If there's a change of display in mid-stream, retreat and try reading the new display. (find_active_event_queue): Function deleted. All callers changed to just test the main kbd_buffer instead. (kbd_buffer_store_event): Write to the main kbd_buffer again. (kbd_buffer_get_event): Read from the main kbd_buffer again. Now returns a perdisplay pointer in addition to a lispy event. (Fdiscard_input, swallow_events): Use the main kbd_buffer again. (stuff_buffered_input): Likewise. (init_perdisplay): Initialize member kbd_queue. Remove references to obsolete members. (wipe_perdisplay): Remove obsolete reference. (init_keyboard, syms_of_keyboard): Restore initialization of vars. Tue Feb 21 20:19:45 1995 Richard Stallman * xdisp.c (display_string, display_text_line): Display table overrides ordinary display even for \t, \n, etc. Sun Feb 19 14:06:47 1995 Richard Stallman * frame.c (Fmake_terminal_frame): Doc fix. Sat Feb 18 04:05:41 1995 Richard Stallman * s/hpux9.h (LIB_X11_LIB, C_SWITCH_X_SYSTEM, LD_SWITCH_X_DEFAULT): Add #undef's to cancel hpux8.h's definitions. Fri Feb 17 03:44:55 1995 Richard Stallman * config.h.in (MULTI_FRAME): Define unconditionally. Thu Feb 16 01:36:39 1995 Richard Stallman * dispnew.c (change_frame_size_1): New subroutine. (change_frame_size): If f is termcap frame, change size of all of them. (remake_frame_glyphs): No longer static. Don't mark nonselected termcap frame as garbaged. * term.c (calculate_costs): Update max_frame_height, max_frame_width. They determine length of chars_wasted, copybuf and char_ins_del_vector. * xdisp.c (redisplay): Don't display nonselected terminal frames. * frame.c (Fmake_terminal_frame): New function. (syms_of_frame): defsubr it. (make_terminal_frame): Init Vframe_list only the first time. Set visible and async_visible directly. Give each terminal frame a unique name. * ralloc.c (r_alloc_check): Return void. (r_alloc_freeze): Initialize if it hasn't been done. (r_re_alloc, r_alloc_free, r_alloc_sbrk): Likewise. (r_alloc_init): Set __malloc_extra_blocks. Wed Feb 15 07:10:41 1995 Paul Reilly * s/dgux.h (LIB_MOTIF): Add -lgen to provide provide the symbols `regcmp' and `regex'. Wed Feb 15 03:05:34 1995 Richard Stallman * xmenu.c (xmenu_show, both versions): New arg for_click. (Fx_popup_menu): Compute it and pass it. Tue Feb 14 19:02:33 1995 Richard Stallman * callint.c: Doc fix. Tue Feb 14 21:48:14 1995 Paul Reilly * xterm.c (x_bitmap_icon): Fix test for unallocated icon bitmap. Tue Feb 14 16:33:49 1995 Richard Stallman * filelock.c: (unlock_buffer, unlock_all_files, Flock_buffer) (Funlock_buffer): Use buffer's file_truename, not filename. * buffer.c (syms_of_buffer): Set up Lisp var buffer-file-truename. (init_buffer_once): Set up flag and default value for file_truename. (reset_buffer): Init file_truename slot. * buffer.h (struct buffer): New field file_truename. * ralloc.c (r_alloc_free): Call refill_memory_reserve only if emacs. Include getpagesize.h unconditionally. (free_bloc): Don't die if bloc->next or bloc->prev is null. [!emacs] (bzero): New macro definition. * keyboard.c (input_poll_signal): Add ignored argument. (interrupt_signal): Likewise. * dispnew.c (window_change_signal): Add ignored argument. * process.c (Fstart_process): Make process marker point into proc buf. * xterm.c (x_display_bar_cursor): Use frame's cursor_width. (x_connection_signal): New function. (x_initialize): Use it as signal handler. * xfns.c (x_set_cursor_type): Set cursor_width field. Handle args of form (bar . WIDTH). * xterm.h (struct x_display): New element cursor_width. Tue Feb 14 04:15:32 1995 Richard Stallman * filelock.c (unlock_buffer, unlock_all_files, Flock_buffer) (Funlock_buffer): Use buffer's file_truename, not filename. * buffer.h (struct buffer): New field file_truename. * buffer.c (syms_of_buffer): Set up Lisp var buffer-file-truename. (init_buffer_once): Set up flag and default value for file_truename. (reset_buffer): Init file_truename slot. * xterm.h (struct x_display): New element cursor_width. * xfns.c (x_set_cursor_type): Set cursor_width field. Handle args of form (bar . WIDTH). * xterm.c (x_display_bar_cursor): Use frame's cursor_width. Mon Feb 13 01:32:38 1995 Richard Stallman * m/iris4d.h (STACK_DIRECTION): Undef before defining. [__GNUC__] (C_SWITCH_MACHINE): Remove -cckr. Add -32, only if IRIX_FORCE_32_BITS. * s/irix5-0.h [__GNUC__] (C_SWITCH_SYSTEM): Defined. * s/irix4-0.h [__GNUC__] (C_SWITCH_SYSTEM): Define this. (C_SWITCH_MACHINE): Instead of this. * ralloc.c (r_alloc_free): Call refill_memory_reserve only if emacs. * s/irix6-0.h: New file. * fileio.c (Fexpand_file_name): Copy default-directory before looking for a handler on the directory arg. * cmds.c (Vself_insert_face, Vself_insert_face_command): New variables. (syms_of_cmds): Set up Lisp variables. Doc syntax fix. (internal_self_insert): Handle Vself_insert_face. * lisp.h (Qprocessp): Declared. * xdisp.c (redisplay_window): If we update the mode line, switch to the buffer for real, and switch back for real. Sun Feb 12 00:22:18 1995 Richard Stallman * xterm.c (x_connection_signal): New function. (x_initialize): Use it as signal handler. * keyboard.c (input_poll_signal): Add ignored argument. (interrupt_signal): Likewise. * dispnew.c (window_change_signal): Add ignored argument. Sat Feb 11 16:56:31 1995 Richard Stallman * fileio.c (Fexpand_file_name): Look for a handler for defalt. (syms_of_fileio): Minor rearrangement. * ralloc.c: Include getpagesize.h unconditionally. (free_bloc): Don't die if bloc->next or bloc->prev is null. [!emacs] (bzero): New macro definition. * xmenu.c (menu_item_equiv_key): If command is an alias, check only the underlying command for a keyboard equivalent. * s/netbsd.h (WAIT_USE_INT): Defined. * syswait.h: New alternative specified by WAIT_USE_INT. * process.c (Fstart_process): Make process marker point into proc buf. Fri Feb 10 01:37:34 1995 Richard Stallman * data.c: Rename arg OBJ to OBJECT in all type predicates. (Ftype_of): New function. Thu Feb 9 04:30:09 1995 Richard Stallman * xfaces.c (load_color): Ignore failure from XAllocColor. * xfns.c (x_decode_color): Ignore failure from defined_color. * m/intel386.h [SOLARIS2_4, !__GNUC__] (C_SWITCH_SYSTEM): Defined.. [SOLARIS2_4, !__GNUC__]: Include alloca.h. Tue Feb 7 18:50:09 1995 Richard Stallman * Makefile.in.in (maintainer-clean): Renamed from realclean. Print warning message. Tue Feb 7 18:18:54 1995 Karl Heuer * keyboard.c (command_loop_1): Put back cancel_echoing call, if there's a perdisplay for it to apply to. (init_perdisplay): Initialize echo vars. * xdisp.c (message_log_check_duplicate): New function. (message_dolog): Delete previous line if the new one is a duplicate. Include a counter if appropriate. Don't bother truncating the buffer until after adding newline. Mon Feb 6 20:00:22 1995 Karl Heuer * lisp.h (struct PERDISPLAY): Add Vlast_event_frame. Define internal_last_event_frame only #if MULTI_FRAME. Add some placeholders so we don't need to rebuild every time this struct changes. * keyboard.c (internal_last_event_frame, Vlast_event_frame): Deleted; now part of perdisplay. All uses changed. (MOUSE_ACTIVITY_AVAILABLE) Deleted. (find_active_event_queue): New arg check_mouse. All callers changed. (Vlast_event_frame): Change from DEFVAR_LISP to DEFVAR_DISPLAY. * frame.c (do_switch_frame): internal_last_event_frame is now in perdisplay. Sun Feb 5 01:57:28 1995 Richard Stallman * ralloc.c (r_alloc_size_in_use): New function. * alloc.c (emacs_blocked_malloc): Set __malloc_extra_blocks here. (malloc_hysteresis): New variable. (init_alloc_once): Initialize malloc_hysteresis. (buffer_memory_full): New function. * emacs.c (main): Undo previous change. * buffer.c (Fget_buffer_create): Call buffer_memory_full. * alloc.c (refill_memory_reserve): New function. * ralloc.c (r_alloc_free): Call refill_memory_reserve. Sat Feb 4 00:24:07 1995 Richard Stallman * alloc.c (SPARE_MEMORY): New macro. (emacs_blocked_free): If no spare_memory now, and enough free space is available, get a new spare. (__malloc_size_t, _bytes_used): Declared. (bytes_used_when_full): New variable. * frame.h (struct frame): New field window_sizes_changed. (FRAME_WINDOW_SIZES_CHANGED): New macro (two definitions). * window.c (Fdelete_window, set_window_height, set_window_width) (Fsplit_window, Fset_window_configuration): Set FRAME_WINDOW_SIZES_CHANGED to 1 in the frame being changed. * xdisp.c (Vwindow_size_change_functions): New variable. (prepare_menu_bars): Call those functions. Add gcproing. (syms_of_xdisp): Set up Lisp variable. * alloc.c (syms_of_alloc): Improve memory exhausted error message. (init_alloc_once): Allocate spare_memory. (memory_full): Free spare_memory. Fri Feb 3 22:15:54 1995 Richard Stallman * xselect.c (x_get_foreign_selection, x_reply_selection_request): Use an unwind-protect to call x_stop_queuing_selection_requests. (some_frame_on_display): New function. (queue_selection_requests_unwind): New function. Fri Feb 3 16:00:41 1995 Karl Heuer * callint.c (syms_of_callint): Move DEFVAR_DISPLAY's ... * keyboard.c (syms_of_keyboard): ... to here. [MULTI_PERDISPLAY] (current_perdisplay, all_perdisplays): New vars. (find_active_event_queue): Search all perdisplays. (init_perdisplay, wipe_perdisplay): New functions. (init_keyboard): Move perdisplay initialization to init_perdisplay. (syms_of_keyboard): Likewise. (cmd_error): Cancel echoing here. (command_loop_1): Not here. * lisp.h (all_perdisplays): New var. (struct PERDISPLAY): New member next_perdisplay. * alloc.c (mark_perdisplays): New function. (Fgarbage_collect): Call it. * lread.c (defvar_display): Don't staticpro; these objects are now protected through mark_perdisplays. * xterm.c [MULTI_PERDISPLAY] (x_term_init): Initialize perdisplay. [MULTI_PERDISPLAY] (x_delete_display): Destroy perdisplay. (x_delete_display): Use xfree, not free. * lisp.h (defvar_display): Declare this function. (DEFVAR_DISPLAY): Use current_perdisplay, not get_perdisplay. * data.c (do_symval_forwarding): Likewise. (store_symval_forwarding, find_symbol_value): Likewise. * print.c (print): Likewise. * keyboard.c (echo_prompt, echo_char, echo_dash, echo): Likewise. (cancel_echoing, echo_length, read_char, Fdiscard_input): Likewise. (stuff_buffered_input): Likewise. Fri Feb 3 04:27:31 1995 Richard Stallman * xdisp.c (display_text_line): Deduct minibuf prompt from taboffset. (try_window): Deduct minibuf prompt from tab_offset, after 1st line. Thu Feb 2 05:45:20 1995 Richard Stallman * xselect.c (wait_for_property_change): Avoid unlikely timing error. * keyboard.c (kbd_buffer_get_event, swallow_events): Remove selection_request event from input queue before processing it. Wed Feb 1 16:37:16 1995 Karl Heuer * macros.c (Fexecute_kbd_macro): Clear prefix arg here. * keyboard.c (cmd_error): And here. (command_loop_1): Not here. (command_loop_1): Save original perdisplay in case we're already locked to a particular display. Move display-specific cleanup to end of main loop. Use perdisplay to access prefix arg. (Fcommand_execute, Fexecute_extended_command): Use perdisplay. Wed Feb 1 14:35:15 1995 Richard Stallman * xterm.c (x_unqueue_events): Arg is now a Display *. (x_start_queuing_selection_requests): Likewise. (x_stop_queuing_selection_requests): Likewise. * xselect.c (x_get_foreign_selection): Pass display to x_start_queueing_selection_events and x_stop_queueing_selection_events. * xselect.c (x_reply_selection_request): Call x_start_queueing_selection_events and x_stop_queueing_selection_events. Handle X protocol errors. Tue Jan 31 17:30:45 1995 Karl Heuer * callint.c (Fcall_interactively): Use perdisplay. (Vprefix_arg, Vcurrent_prefix_arg): Delete vars; now in perdisplay. (syms_of_callint): Use DEFVAR_DISPLAY for prefix-arg and current-prefix-arg. * minibuf.c (read_minibuf, read_minibuf_unwind): Use perdisplay. * mocklisp.c (Fml_provide_prefix_argument): Use perdisplay. (Fml_prefix_argument_loop): Likewise. * lisp.h (current_perdisplay): New var. (DEFVAR_DISPLAY): Add missing ampersand. (Vprefix_arg, Vcurrent_prefix_arg): Delete; now in perdisplay. * lread.c [!MULTI_PERDISPLAY] (defvar_display): Use staticpro. Tue Jan 31 15:09:36 1995 Richard Stallman * emacs.c (main) [REL_ALLOC]: Set __malloc_extra_blocks. Mon Jan 30 23:54:38 1995 Richard Stallman * buffer.c (syms_of_buffer): overwrite-mode doc fix. Mon Jan 30 19:01:56 1995 Karl Heuer * lisp.h [MULTI_PERDISPLAY]: Declare get_perdisplay as a function. * xterm.c [MULTI_PERDISPLAY] (get_perdisplay): Define this as an exported function. * xterm.h [MULTI_PERDISPLAY] (get_perdisplay): Define this as a macro, for sources that include this header. [MULTI_PERDISPLAY] (get_perdisplay_macro): Internal macro version. * lisp.h (DEFVAR_DISPLAY): New macro. * lread.c (defvar_display): New function. * lisp.h: Declare store_symval_forwarding here. * eval.c (specbind): Not here. (specbind): Handle display-local vars. * data.c (do_symval_forwarding): Handle display-local vars. (store_symval_forwarding, find_symbol_value): Likewise. (Fmake_variable_buffer_local): Disallow display-local vars here. (Fmake_local_variable): Likewise. * keyboard.c (syms_of_keyboard): Fix missing backslashes. Sun Jan 29 17:01:33 1995 Richard Stallman * fns.c (Frassoc): New function. (syms_of_fns): defsubr it. Sat Jan 28 03:36:05 1995 Richard Stallman * ecrt0.c: Renamed from crt0.c. * Makefile.in.in (ecrt0.o): Target renamed from crt0.o. (START_FILES): Use ecrt0.o. Fri Jan 27 13:48:20 1995 Karl Heuer * lisp.h (PERDISPLAY, the_only_perdisplay, get_perdisplay): Renamed from PERD, etc. All uses changed. (ECHOBUFSIZE): New constant, replaces sizeof (echobuf). (enum Lisp_Misc_Type): New enumeration Lisp_Misc_Display_Local. (struct Lisp_Display_Objfwd): New structure. (XDISPLAY_OBJFWD, DISPLAY_OBJFWDP): Access the new structure. (union Lisp_Misc): Add new member. * keyboard.c (kbd_buffer_frame_or_window): Delete; now in perdisplay. (immediate_echo, echobuf, echoptr, echo_after_prompt): Likewise. (echo_prompt, echo_char, echo_dash): use perdisplay and ECHOBUFSIZE. (echo, cancel_echoing, echo_length, echo_truncate): Likewise. (read_char, kbd_buffer_store_event, kbd_buffer_get_event): Likewise. (Fdiscard_input, stuff_buffered_input): Likewise. (init_keyboard, syms_of_keyboard): Likewise. * alloc.c (mark_object): Ignore Lisp_Misc_Display_Objfwd objects. * print.c (print): Handle internal display-local object. * .gdbinit (xdispobjfwd): New macro. * xdisp.c (message_log_need_newline): This var is now static. (message_dolog): Set message_log_need_newline appropriately. Don't change it at all if message logging is currently disabled. (message_log_maybe_newline): New function. (message2): Use message_log_maybe_newline. * print.c (printchar, strout): Use message_log_maybe_newline. Leave all of the newline bookkeeping to message_dolog. * lisp.h (message_log_maybe_newline): Function declared. * xdisp.c (message_dolog): Rename " *Messages*" buffer to "*Messages*" Fri Jan 27 04:44:35 1995 Richard Stallman * minibuf.c (Fread_string): Add third arg HISTORY. * callint.c (Fcall_interactively): Pass new arg to Fread_string. Fri Jan 27 02:20:24 1995 Richard Stallman * insdel.c (modify_region): Clear point_before_scroll field. Wed Jan 25 23:46:56 1995 Richard Stallman * buffer.h (struct buffer): New field point_before_scroll. * buffer.c (init_buffer_once, syms_of_buffer): Set up buffer-local var point_before_scroll. (reset_buffer): Init point_before_scroll. * intervals.c (set_point): Set point_before_scroll to nil. Tue Jan 24 21:01:58 1995 Karl Heuer * lisp.h (PERD): New struct containing per-display data. (the_only_perd): Declare an instance of it. (get_perd): Macro to retrieve it. * keyboard.c (the_only_perd): Define this var here. (kbd_buffer, kbd_fetch_ptr, kbd_store_ptr): Delete; now part of perd. (find_active_event_queue): New function. (readable_events, kbd_buffer_get_event, swallow_events): Use it. (kbd_buffer_store_event): Store in EVENT's frame's queue. (Fdiscard_input, stuff_buffered_input): Use perd. (init_keyboard): Initialize the new vars. kbd_buffer is now a pointer, not an array. * xterm.h (struct x_display_info): New member display_perd. * process.c (process_tick, update_tick): Make non-static. Tue Jan 24 02:55:05 1995 Richard Stallman * keyboard.c (read_key_sequence): New arg dont_downcase_last inhibits downcasing the last event, when it's uppercase and undefined. (Fread_key_sequence): Likewise new arg. * callint.c (Fcall_interactively): Define K mostly like k. Pass new arg to Fread_key_sequence. * keymap.c (Flocal_set_key, Fglobal_set_key): Use K, not k, to read key seq arg. Mon Jan 23 17:16:38 1995 Karl Heuer * indent.c (compute_motion): Don't get hung in selective-display loop. * syssignal.h: Don't use function prototypes. * keyboard.c (read_key_sequence): Don't wait for a possible key translation sequence if we already have a binding. Add missing break statement. * sysselect.h: New file, mostly extracted from process.c and xterm.c. * process.c: #include sysselect.h instead of defining things by hand. * sysdep.c (sys_select): Renamed from select. Use SELECT_TYPE instead of int. Defer to native select if that function is usable. * config.h (HAVE_SYS_SELECT_H): Add #undef for configure. * s/isc3-0.h (BROKEN_SELECT_NON_X): #define this. * s/isc3-0.h [__GNUC__] (POSIX_SIGNALS): #define this. [__GNUC__] (sigsetmask, HAVE_SYSV_SIGPAUSE): #undef these. (LIBX11_SYSTEM): Don't use -lc; loading this before -lcposix gives us the wrong signal functions. (C_SWITCH_SYSTEM): Add _XOPEN_SOURCE. (EXTRA_INITIALIZE): Make conditional on __GNUC__. Sun Jan 22 02:14:04 1995 Richard Stallman * minibuf.c (read_minibuf): Don't print the prompt in batch mode. * emacs.c (sort_args): Ordinary args get priority 0. So do -f, -l, -insert, etc. --kill gets negative priority. Everything else gets positive priority. Sat Jan 21 20:44:42 1995 Richard Stallman * xterm.c (x_destroy_window): Don't let frame being destroyed remain in x_focus_event_frame. Sat Jan 21 17:23:02 1995 Richard Stallman * config.h.in [NO_REMAP]: #undef static. Fri Jan 20 15:10:06 1995 Karl Heuer * lisp.h (union Lisp_Misc): Make the `type' field just 16 bits, to match the substructures. Fri Jan 20 00:04:44 1995 Morten Welinder * fileio.c (file_name_as_directory, Ffile_name_directory) (Ffile_name_nondirectory): Delete special MSDOG code now covered by macros. * s/msdos.h (DEVICE_SEP, IS_DIRECTORY_SEP, IS_ANY_SEP): Defined. * msdos.c (XMenuCreate, XMenuAddPane, XMenuAddSelection, XMenuLocate) (XMenuActivate, XMenuDestroy): Add dummy `display *' argument. * xmenu.c [MSDOS]: #include msdos.h. * msdos.h (x_mouse_leave): Add neutralizing define. (XMenuCreate, XMenuAddPane, XMenuAddSelection, XMenuLocate) (XMenuActivate, XMenuDestroy): Add prototype. * Makefile.in.in (xmenu.o): Add msdos.h as dependency. * buffer.c (syms_of_buffer) [DOS_NT]: Add missing ';'. Thu Jan 19 16:02:32 1995 Karl Heuer * textprop.c (Ftext_property_any): Handle the trivial case specially. * sysdep.c (seed_random): Renamed from srandom. (get_random): Renamed from random. Return VALBITS random bits. * fns.c (Frandom): Call seed_random and get_random. * print.c (print): Print internal types too, for debugging. Print appropriate message for invalid pseudovector or misc type. * .gdbinit (xboolfwd, xbuflocal, xbufobjfwd, xcompiled): New macros. (xintfwd, xmiscfree, xobjfwd, xoverlay, xwinconfig): New macros. Thu Jan 19 15:01:19 1995 Abramo Bagnara * term.c (term_get_fkeys_1): Bug fix for function key above f19. Wed Jan 18 18:23:12 1995 Richard Stallman * editfns.c (subst_char_in_region_unwind): New function. (Fsubst_char_in_region): Use it to make undo_list t temporarily. * buffer.c (Fbuffer_local_variables): Unconditionally call find_symbol_value, but conditionally use its value. * xrdb.c: Don't include sys/param.h. (MAXPATHLEN): Definition deleted. Wed Jan 18 15:56:39 1995 Boris Goldowsky * cmds.c (internal_self_insert): Don't test current_column when deciding to call auto_fill_function. Wed Jan 18 15:12:38 1995 Karl Heuer * lisp.h (SWITCH_ENUM_CAST): New macro. * alloc.c, data.c, keyboard.c, syntax.c, xdisp.c: Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead. Wed Jan 18 03:58:07 1995 Richard Stallman * window.c (Qtemp_buffer_show_hook): New hook. (syms_of_window): Init and staticpro it. (temp_output_buffer_show): Run the hook. Mon Jan 16 19:08:16 1995 Karl Heuer * xdisp.c (message_dolog): Ignore narrowing. Use low-level functions, to bypass modification and motion hooks. * window.h (struct window): New member column_number_displayed. * xdisp.c (redisplay): Use that field instead of a global flag. (redisplay_window, display_mode_line, decode_mode_spec): Likewise. * cm.c (cmcheckmagic): New function. * cm.h: Declare it. * term.c (write_glyphs, insert_glyphs): Call it. Mon Jan 16 01:38:08 1995 Richard Stallman * keyboard.c (kbd_buffer_store_event): Cast arg of bcopy. Sun Jan 15 08:05:06 1995 Roland McGrath * ralloc.c (r_alloc_init): Remove unused variable END. Fri Jan 13 21:17:20 1995 Karl Heuer * alloc.c (Fpurecopy): Mask size field when copying pseudovector. Thu Jan 12 15:27:50 1994 Boris Goldowsky * lisp.h: Declare Qrear_nonsticky. * cmds.c (Vuse_hard_newlines): New variable. (Fnewline): If use_hard_newlines is on, mark inserted newline(s) with `hard' property, marked rear-nonsticky. Thu Jan 12 10:35:51 1994 Tom Tromey * buffer.c (list_buffers_1, Flist_buffers): Functions deleted. Thu Jan 12 18:12:22 1995 Karl Heuer * xdisp.c (message_log_need_newline): New var. (message_dolog): New function, extracted from message2. * print.c (printchar, strout): Call message_dolog. * lisp.h: Declare message_dolog. * alloc.c (DONT_COPY_FLAG): Default this to 1. Check to make sure it's not the same as MARKBIT. (mark_object): Use the same XOR expression as elsewhere. (gc_sweep): Don't touch DONT_COPY_FLAG here; this one is a real size field, not a mangled pointer. * fns.c (internal_equal): Delete redundant tests. Mask size field when comparing pseudovectors. * fns.c (Frandom): Use VALBITS instead of hardcoded constants. Tue Jan 10 20:38:37 1995 Karl Heuer * alloc.c (DONT_COPY_FLAG): Fix typo. * lisp.h: Use large constants for Lisp_Misc_Type. * lisp.h: Add some function declarations. * insdel.c: Declare all non-returning functions `void'. (insert_1): Make non-static. New arg PREPARE. All callers changed. * xdisp.c (Vmessage_log_max): New var. (syms_of_xdisp): defvar and initialize it. (message2_nolog): Renamed from message2. (message2): Log messages, then call message2_nolog. (message1_nolog): New function. * keyboard.c (echo): Don't log the key echoes. * alloc.c (Fgarbage_collect): Don't log the GC message. Tue Jan 10 18:20:12 1995 Richard Stallman * emacs.c (main): Handle SIGABRT, SIGHWE, SIGPRE, SIGORE, SIGDLK, SIGCPULIM, if they are defined. * alloc.c (DONT_COPY_FLAG): New bit flag. (mark_object, gc_sweep, compact_strings): Use it. Tue Jan 10 15:36:34 1995 Karl Heuer * editfns.c (Finsert_char): Check inherit flag for long strings too. * editfns.c (Fnarrow_to_region): Swap using temp Lisp_Object, not int. Tue Jan 10 01:45:56 1995 Richard Stallman * keyboard.c (syms_of_keyboard): Doc fix. * unexsunos4.c (unexec): Cast value of sbrk. (run_time_remap): Cast arg to brk. (brk_value): Renamed from Brk. (is_it): Cast 1st arg of mmap. Mon Jan 9 20:33:14 1995 Richard Stallman * keyboard.c (read_key_sequence): If first event is mouse click, use the text property keymap from where the click was. New local var orig_local_map. Mon Jan 9 19:05:02 1995 Karl Heuer * window.c (Fscroll_other_window): On small windows, scroll by 1 line. Mon Jan 9 04:59:26 1995 Richard Stallman * fns.c (internal_equal): Once again use a switch. * lisp.h (struct Lisp_Free, struct Lisp_Marker, etc.): Make the `type' field just 16 bits, and declare as int. Add explicit spacer field after it. (struct Lisp_Marker): New field insertion_type. Sun Jan 8 14:21:13 1995 Richard Stallman * keymap.c (store_in_keymap): Copy a cons only if car is a string. * xterm.c: Don't include param.h. * buffer.c (syms_of_buffer): Doc fix. Fri Jan 6 18:52:20 1995 Karl Heuer * m/alliant-2800.h (VALBITS, GCTYPEBITS): Deleted; default is better. * m/apollo.h, m/aviion.h, m/delta.h, m/hp800.h, m/ibmrt.h: Likewise. * m/intel386.h, m/nh4000.h, m/tower32v3.h: Likewise. * m/att3b.h (VALBITS, XTYPE): Adjust for new bit layout. * m/alpha.h, m/gec63.h, m/pfa50.h: Likewise. Thu Jan 5 17:18:26 1995 Richard Stallman * frame.c [!MULTI_FRAME] (window_frame): New function. [!MULTI_FRAME] (syms_of_frame): defsubr it. Thu Jan 5 02:05:24 1995 Roland McGrath * doc.c (store_function_docstring, Fdocumentation): Use & PSEUDOVECTOR_SIZE_MASK on `size' field of compiled byte-code object. * callint.c (Fcall_interactively): Likewise. * eval.c (Fcommandp): Likewise. Wed Jan 4 13:10:21 1995 Karl Heuer * alloc.c (mark_object, mark_buffer): Don't mark buffer twice. * .gdbinit (xint, xcar, xcdr): Use correct shift and mask values. * lisp.h [EXPLICIT_SIGN_EXTEND] (XINT): Use symbolic constants. Wed Jan 4 02:19:35 1995 Richard Stallman * doc.c (store_function_docstring): Arg is now EMACS_INT. Mon Jan 2 20:19:13 1995 Karl Heuer * lisp.h (enum Lisp_Type): Don't use trailing comma. (VALBITS, GCTYPEBITS): Define these regardless of NO_UNION_TYPE. [!NO_UNION_TYPE] (union Lisp_Object): Use symbolic constants. * alloc.c (mark_object): Make `else' visible outside MULTI_FRAME. Mon Jan 2 00:07:44 1995 Richard Stallman * keymap.c (store_in_keymap): While dumping, copy DEF if it's a cons. * buffer.c (reset_buffer): Don't alter intervals here. (Fget_buffer_create): Use BUF_MARKERS. Init BUF_INTERVALS here. (Fkill_buffer): Use BUF_MARKERS; but don't touch it in indir buf. Likewise BUF_INTERVALS. Don't free the text in indirect buffer. When killing a base buffer, kill its indirect buffers first. (init_buffer_once): Set up .text and BUF_INTERVALS in buffer_local_symbols and buffer_defaults. * alloc.c (mark_buffer, gc_sweep): Use BUF_INTERVALS. * editfns.c (Ftranspose_regions): Use BUF_INTERVALS. (transpose_markers): Use BUF_MARKERS. * insdel.c (insert_1, prepare_to_modify_buffer, insert_from_buffer_1): Use BUF_INTERVALS. (adjust_markers): Use BUF_MARKERS. * buffer.h (struct buffer): Fields markers and intervals moved out. (struct buffer_text): Fields markers and intervals moved here. (BUF_MARKERS, BUF_INTERVALS): New macros. * textprop.c (validate_interval_range): Use BUF_INTERVALS. * intervals.c: Use BUF_INTERVALS throughout. * marker.c: Use BUF_MARKERS throughout. * undo.c (Fprimitive_undo): Use base buffer's modtime field. Sun Jan 1 17:04:27 1995 Richard Stallman * .gdbinit: Adapt to new Lisp_Object format. (xvectype, xmisctype): New commands. (xtype): Print the misc or vectorlike subtype too. * xdisp.c (redisplay_window): Call set_buffer_temp. * buffer.c (set_buffer_temp): New function. * buffer.h (struct buffer): Make buffer_file_type field unconditional. * buffer.c (reset_buffer_local_variables): Initialize buffer_file_type field. * lisp.h (PVEC_BUFFER, PVEC_PROCESS, PVEC_FRAME, PVEC_COMPILED) (PVEC_WINDOW, PVEC_WINDOW_CONFIGURATION, PVEC_SUBR): Now enumeration constants, not macros. (PVEC_FLAG): Enumeration alias for PSEUDOVECTOR_FLAG. * buffer.h (struct buffer): save_modiff field deleted. (struct buffer_text): save_modiff field moved here. (SAVE_MODIFF, BUF_SAVE_MODIFF): New macros. Use them instead of direct access to save_modiff field. * buffer.c, editfns.c, fileio.c, filelock.c, insdel.c, keyboard.c: * undo.c, xdisp.c: Use SAVE_MODIFF and BUF_SAVE_MODIFF instead of direct access to the save_modiff field. * window.c (temp_output_buffer_show): Use BUF_SAVE_MODIFF. * buffer.h (struct buffer): New field pt_marker. New fields begv_marker, zv_marker. * buffer.c (Fget_buffer_create): Initialize pt_marker, begv/zv_marker. (set_buffer_internal): Use and update this markers. Copy undo_list in and out of the base buffer. (Fget_buffer_create): Init save_modiff field here. (reset_buffer): Not here. (Fbuffer_modified_p): Use BUF_SAVE_MODIFF. (Fset_buffer_modified_p): Use SAVE_MODIFF. (Fkill_buffer, list_buffers_1): Use BUF_SAVE_MODIFF. * term.c (term_init): Fatal error if screen is too small. Sat Dec 31 00:58:51 1994 Richard Stallman * xdisp.c (redisplay_window): For buffer_shared count, treat an indirect buffer as equivalent to its base. * print.c (print): Don't drop thru to error for markers and overlays. Fri Dec 30 21:03:19 1994 Richard Stallman * insdel.c (adjust_point): Use BUF_PT. * intervals.c (temp_set_point, set_point): Use BUF_PT. (get_local_map): Get keymap from specified buffer, not current one. * fileio.c (Finsert_file_contents, Fwrite_region): Error if buffer is indirect. (Fdo_auto_save): Do nothing for an indirect buffer. * alloc.c (mark_buffer): In indirect buffer, mark the base buffer. * buffer.c (Fmake_indirect_buffer): New function. (Fbuffer_base_buffer): New function. (syms_of_buffer): defsubr them. (Fget_buffer_create): Initialize the size field. * print.c (print): Make buffer case a branch of the Lisp_Vectorlike case. * alloc.c (mark_object): Make buffer case a branch of the Lisp_Vectorlike case. * buffer.h (struct buffer): Make text field be a pointer. The struct buffer_text field renamed to own_text. Add fields indirect_to_buffer and size. Move pt, begv and zv fields here. (struct buffer_text): Moved from here. (BEGV, PT, ZV, BEGV_ADDR, PT_ADDR, ZV_ADDR): Corresponding changes. (BUF_BEGV, BUF_PT, BUF_ZV): Corresponding changes. (SET_BUF_ZV, SET_BUF_PT, point): * lisp.h (XSETBUFFER, BUFFERP, GC_BUFFERP): Rewrite: use pseudovectors. (enum Lisp_Type): Delete Lisp_Buffer. (enum Lisp_Misc_Type): Add Lisp_Misc_Float (not yet used). Thu Dec 29 14:55:56 1994 Richard Stallman * lisp.h (VALBITS): Default now 28. (GCTYPEBITS): Default now 3. * lisp.h (enum Lisp_Type): Lisp_Process, Lisp_Window, Lisp_Frame, Lisp_Subr deleted. (PSEUDOVECTORP, GC_PSEUDOVECTORP): Add paren for proper nesting. (PROCESSP, GC_PROCESSP, XSETPROCESS): Rewrite to use pseudovectors. (WINDOWP, GC_WINDOWP, XSETWINDOW): Likewise. (FRAMEP, GC_FRAMEP): Likewise. (SUBRP, GC_SUBRP, XSETSUBR): Likewise. (PVEC_SUBR): New macro. (struct Lisp_Subr): Add a size field. (DEFUN (both definitions)): Store that size field. * frame.h (XSETFRAME): Use pseudovector. * alloc.c (mark_object): Don't use Lisp_Process, Lisp_Window. Handle frames, compileds and subrs as branch of Lisp_Vectorlike case. (Fmake_byte_code): Use XSETCOMPILED. * data.c (Faref): Handle compiled function as pseudovector. * fns.c (Flength): Handle compiled function as pseudovector. * xterm.c (x_scroll_bar_handle_click): Use GC_WINDOWP. (XTframe_rehighlight, x_window_to_scroll_bar): Use GC_FRAMEP. * print.c (print): Get size of compiled function as pseudovector. Use a switch statement again. * process.h: Make size field an EMACS_INT. Wed Dec 28 13:00:24 1994 Richard Stallman * unexsunos4.c [! sparc] (REL_INFO_TYPE): Use `struct relocation_info'. Tue Dec 27 12:54:19 1994 Richard Stallman * keyboard.c (make_lispy_event) [USE_X_TOOLKIT]: Turn off special handling of menu bar mouse events. (make_lispy_event): Tell pixel_to_glyph_coords not to clip. * xterm.c (XTupdate_begin): Fix backward test in previous change. (x_display_box_cursor): Don't redraw old cursor spot in mouse face if cursor was on a newline. * s/isc4-1.h: New file. Mon Dec 26 10:57:15 1994 Richard Stallman * xterm.c (XTread_socket): Handle button events from outside the frame, received due to grabbing the mouse with a button. Sun Dec 25 12:28:28 1994 Richard Stallman * callint.c (Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook): New variables. (syms_of_callint): Set them up. (Fcall_interactively): Run the hook, for `@'. * buffer.c (syms_of_buffer): Doc fix for buffer-file-type. * search.c (set_search_regs): Really set search_regs.start and .end. (save_search_regs): Set them to 0 here. * minibuf.c (read_minibuf): GCPRO things. * lisp.h (enum Lisp_Type): Add Lisp_Type_Limit. * data.c (wrong_type_argument): Abort if VALUE is invalid Lisp object. Use Lisp_Type_Limit. Sat Dec 24 11:42:13 1994 Richard Stallman * puresize.h (BASE_PURESIZE): Incremented by 20k. Fri Dec 23 23:48:53 1994 Richard Stallman * xfns.c (x_figure_window_size): Treat missing user-position parm as nil. Fri Dec 23 12:13:57 1994 Steven Suhr * scroll.c (scrolling_1): When scroll_region_ok is set, use a new scrolling method which scrolls groups of lines directly to their final vertical positions. (struct matrix_elt): New field writecount. (calculate_direct_scrolling): New function. (do_direct_scrolling): New function. * term.c (scroll_region_cost): New variable. (calculate_costs): Put scroll region overhead in scroll_region_cost. * termchar.h (scroll_region_cost): Declared. * dispnew.c (scrolling): Fewer restrictions if scroll_region_ok is set. New vector old_draw_cost for direct scrolling method. Fri Dec 23 22:00:00 1994 Michal Jankowski (Michal.Jankowski@fuw.edu.pl) * keyboard.c (read_char): Don't echo keys when echo_keystrokes is 0. Thu Dec 22 18:07:34 1994 Richard Stallman * xfns.c (x_set_frame_parameters): Handle icon-left, icon-top parms. Wed Dec 21 00:10:24 1994 Richard Stallman * buffer.c (Fget_buffer_create): Copy the name, and clear text props. Tue Dec 20 18:14:44 1994 Richard Stallman * eval.c (Fdefvar): Fix minor error in previous change. (funcall_lambda): Fetch bytecode and constants vector from file if nec. * lread.c (Qload_file_name, Vload_file_name): New variables. (syms_of_lread): Initialize and staticpro it. (Fload): Bind it. (read_list): Before dumping, ignore (#$ . WHATEVER)--return 0. * lread.c (read1): Implement #@ and #$ constructs. * frame.c (make_frame): Init buffer_predicate field. * doc.c (get_doc_string): Now static. Arg now Lisp_Object. Allow (FILE . POS) as position argument. (Fdocumentation, Fdocumentation_property): Fix calls to get_doc_string. (Fdocumentation_property): Handle cons as value via get_doc_string. (read_doc_string): New function. * buffer.c (assoc_ignore_text_properties): New function. (Fget_buffer): Use assoc_ignore_text_properties. Mon Dec 19 18:22:24 1994 Richard Stallman * s/dgux.h (C_DEBUG_SWITCH): Define this only if __GNUC__. Sun Dec 18 14:38:25 1994 Richard Stallman * buffer.c (Fother_buffer): Take account of frame's buffer predicate. * frame.h (struct frame): New field buffer_predicate. Move all the Lisp_Object fields to the top. * frame.c (Fmodify_frame_parameters): For non-X frames, call store_frame_param for each parameter set. (store_frame_param): Handle buffer_predicate field. (frame_buffer_predicate): New function. (Qbuffer_predicate): New variable. (syms_of_frame): Set it up. * alloc.c (mark_object): In a frame, mark the buffer_predicate. Don't mark the height and width fields. Thu Dec 15 08:12:37 1994 Richard Stallman * minibuf.c (Fall_completions): New arg hide_spaces. (Fminibuffer_completion_help): Pass new arg. Wed Dec 14 08:59:56 1994 Richard Stallman * emacs.c (main): Fix conversion of --display to -d. * xmenu.c (push_menu_item): New arg DEF. (single_keymap_panes, list_of_items): Pass new arg. (MENU_ITEMS_ITEM_DEFINITION): New macro. (MENU_ITEMS_ITEM_LENGTH): Now 5. [USE_X_TOOLKIT] (xmenu_show): Store 0 in call_data if item def is 0. (single_submenu): Likewise. * emacs.c (main): Implement --version. * xterm.c (XTupdate_begin): Discard records of prior mouse highlight when frame must be redrawn. * textprop.c (add_properties): Add gcpro's. (Fadd_text_properties, copy_text_properties): Likewise. Tue Dec 13 16:23:55 1994 Richard Stallman * s/sunos4-1-3.h: Just include sunos4shr--do nothing else. * eval.c (Fdefconst, Fdefvar): Error if too many arguments. Tue Dec 13 09:30:54 1994 Richard Stallman * emacs.c (sort_args): Make `options' a vector of ints. Sun Dec 11 17:13:22 1994 Richard Stallman * buffer.c (report_overlay_modification): Renamed from verify_overlay_modification. * insdel.c: Calls changed. * insdel.c (signal_before_change, signal_after_change): Call verify_overlay_modification here. (prepare_to_modify_buffer): Don't call verify_overlay_modification. * buffer.c (call_overlay_mod_hooks): New args AFTER, ARG1, ARG2, ARG3. Args START, END deleted. Pass each function AFTER, ARG1 and ARG2, and ARG3 if ARG3 is not nil. (verify_overlay_modification): New args AFTER, ARG1, ARG2, ARG3. Pass them to call_overlay_mod_hooks. * search.c (compile_pattern): Call re_set_registers here. And no need to BLOCK_INPUT for that. (compile_pattern_1): Instead of here. Sat Dec 10 16:45:12 1994 Richard Stallman * s/aix4-1.h: New file. * unexaix.c (unrelocate_symbols): Add AIX4_1 conditionals and code. * sysdep.c (sys_siglist) [AIX]: Add AIXHFT conditional. * systty.h: Change AIX conditional around HFNKEYS to AIXHFT. Fri Dec 9 23:14:19 1994 Richard Stallman * bytecode.c (Fbyte_code): Call Ffollowing_char and Fprevious_char as functions. Don't mask char-syntax arg to just 8 bits. Thu Dec 8 00:18:05 1994 Richard Stallman * keyboard.c (read_char): After auto-saving, redisplay. Tue Dec 6 17:11:20 1994 Richard Stallman * xfns.c (Fx_color_values): Doc fix. * buffer.c (list_buffers_1): Right-align the size values. * frame.h (struct frame): New field cost_calculation_baud_rate. (FRAME_COST_BAUD_RATE): New macro. * term.c (calculate_costs): Set FRAME_COST_BAUD_RATE. Don't test dont_calculate_costs. (dont_calculate_costs): Variable deleted. (term_init): Don't set dont_calculate_costs. * dispnew.c (update_frame): Call calculate_costs if baud_rate changed. Mon Dec 5 23:21:50 1994 Karl Heuer * emacs.c (sort_args): Don't overwrite the terminating null pointer. Mon Dec 5 20:00:05 1994 Richard Stallman * keyboard.c (read_key_sequence): Downcase undefined shifted fn keys. Sun Dec 4 17:01:31 1994 Richard Stallman * emacs.c (argmatch): Take argc as arg; don't go past end of argv. (main): Change calls to argmatch. * intervals.h (INTERVAL_LAST_POS): Don't subtract 1 here. * intervals.c (compare_string_intervals): New function. * fns.c (internal_equal): Call compare_string_intervals. (Fstring_equal): Doc fix. * scroll.c (scroll_cost): FRAME_DELETE_COST and FRAME_DELETEN_COSTS were confused. Fixed. * xterm.c (x_make_frame_visible, x_make_frame_invisible) (x_iconify_frame): Give error if frame has explicit_parent. (x_new_font): Don't set window height if frame has explicit_parent. * xfns.c (Fx_create_frame): Check for parent-id parameter. Set explicit_parent and parent fields. Don't set visibility if explicit_parent. [! USE_X_TOOLKIT] (x_window): Specify parent window. * xterm.h (struct x_display): New field explicit_parent. * s/ultrix4-3.h (SET_LINE_DISCIPLINE): Defined. * sysdep.c (child_setup_tty): Use CDISABLE for setting VERASE, VKILL. (init_sys_modes) [SET_LINE_DISCIPLINE]: Set specified line discipline. (reset_sys_modes) [SET_LINE_DISCIPLINE]: Restore old line discipline. Sat Dec 3 14:49:28 1994 Richard Stallman * lread.c (readevalloop): Ignore ^M here. * emacs.c (argmatch): Handle lstr == 0. Mon Nov 28 17:13:27 1994 Richard Stallman * regex.c (re_match_2_internal): Rename label `succeed' to `succed_label'. * xfns.c (Fx_synchronize): Fix doc string syntax. * xmenu.c: Don't include ../oldXMenu/XMenu.h if USE_X_TOOLKIT. * Makefile.in.in: Fix erroneous comment syntax. * s/ultrix4-3.h: New file. * systty.h: Have just one conditional to include unistd.h. Test NEED_UNISTD_H, not AIX and IRIX4. (UNISTD_H_INCLUDED): Don't define or test this. * m/ibm370aix.h (NEED_UNISTD_H): Defined. * s/aix3-1.h (NEED_UNISTD_H): Defined. * s/irix4-0.h (NEED_UNISTD_H): Defined. * fileio.c (internal_delete_file, internal_delete_file_1): New functions. * buffer.c (Fkill_buffer): Use internal_delete_file. * callproc.c (delete_temp_file): Use internal_delete_file. Fri Nov 25 19:15:07 1994 Roland McGrath * search.c (search_regs_saved): Don't initialize; it dumps as pure. Thu Nov 24 09:47:31 1994 Francesco Potorti` * m/delta.h (C_SWITCH_MACHINE): -inline-functions removed, because the compiler shipped with R3V7 is not stable. Thu Nov 24 03:33:11 1994 Richard Stallman * keyboard.c (command_loop_1): Use safe_run_hooks to run deferred-action-function. (Qdeferred_action_function): New variable. (syms_of_keyboard): Initialize and staticpro Qdeferred_action_function. Wed Nov 23 03:59:27 1994 Richard Stallman * keyboard.c (syms_of_keyboard): Doc fix. * fns.c (Fy_or_n_p): Handle exit-prefix in query-replace-map. Tue Nov 22 14:22:37 1994 Richard Stallman * search.c (save_search_regs): Add declaration. * minibuf.c (Fminibuffer_complete_and_exit): Catch errors in do_completion. (complete_and_exit_1, complete_and_exit_2): New subroutines. * s/aix4.h: New file. * s/aix3-1.h (AIXHFT): Defined. * m/ibmrs6000.h (OBJECTS_MACHINE): Define only if AIXHFT. * sysdep.c (init_sys_modes): Tes AIXHFT, not AIX. (reset_sys_modes): Test AIXHFT. (hft_init, hft_reset): Test AIXHFT, not AIX. Mon Nov 21 23:49:31 1994 Richard Stallman * window.c (Fdisplay_buffer): Use `b' to read existing buffer name. Mon Nov 21 22:25:15 1994 David J. MacKenzie (djm@mole.gnu.ai.mit.edu) * config.h.in: Add #undefs for --with-pop, --with-kerberos, and --with-hesiod. Sat Nov 19 15:02:31 1994 Francesco Potorti` * lisp.h: (running_asynch_code): New global flag. * emacs.c (running_asynch_code): New global flag. (main): Initialise it. * process.c (read_process_output, exec_sentinel): Set and reset the running_asynch_code global flag and restore match data. * search.c (Flooking_at, Fstring_match, search_buffer, Fstore_match_data): Save the match data if a filter or a sentinel is running. (search_regs_saved, saved_search_regs): New variables. (save_search_regs, restore_match_data): New functions. Sat Nov 19 10:47:43 1994 Richard Stallman * emacs.c (sort_args): New function. (main): Call sort_args. Check for -d/-display after -nw, -batch, -help. Accept --display, with arg attached or separate. Fri Nov 18 15:25:48 1994 Richard Stallman * filelock.c (init_filelock): Add missing semicolon. Fri Nov 18 02:02:45 1994 Karl Heuer * indent.c (recompute_width_table): Do the right thing if no previous table existed. Fix Lisp_Object vs. integer problem. (width_run_cache_on_off): Let recompute_width_table create the vector. Thu Nov 17 21:01:28 1994 Karl Heuer * lisp.h: (enum Lisp_Misc_Type): Rename Lisp_Vector to Lisp_Vectorlike. Mark Lisp_Window_Configuration as obsolete. (PSEUDOVECTOR_FLAG, PSEUDOVECTOR_SIZE_MASK, PVEC_BUFFER, PVEC_PROCESS, PVEC_FRAME, PVEC_COMPILED, PVEC_WINDOW, PVEC_WINDOW_CONFIGURATION): New constants. (XSETPSEUDOVECTOR, PSEUDOVECTORP, VECTORLIKEP): New macros. (XSETVECTOR, XSETWINDOW_CONFIGURATION, VECTORP, WINDOW_CONFIGURATIONP): Use the new convention. (XSETCOMPILED): New macro. * print.c (print): Use type test macros. * keymap.c (Fsingle_key_description): Likewise. * doc.c (Fdocumentation): Likewise. * alloc.c (Fpurecopy): Likewise. (mark_object): Use the new pseudovector convention. * fns.c (Fvconcat, concat): Use Lisp_Vectorlike. * ntinevt.c (SET_FRAME): Use accessor macros. (key_event, do_mouse_event): Likewise. Thu Nov 17 11:10:17 1994 Richard Stallman * filelock.c (init_filelock): Always copy lock_path. (lock_dir, superlock_file, MAKE_LOCK_NAME): Renamed from lock_path, superlock_path, MAKE_LOCK_PATH. Wed Nov 16 19:13:12 1994 Richard Stallman * s/domain.h: New file. Wed Nov 16 15:32:55 1994 Roland McGrath * s/gnu.h [NOT_C_CODE]: Include fcntl.h. Wed Nov 16 12:35:01 1994 Richard Stallman * xdisp.c (try_window, display_text_line): Undo previous change. * dired.c (Fdirectory_files): Pass new arg to `compile_pattern'. * search.c (struct regexp_cache): New field `posix'. (compile_pattern_1): New arg `posix'. Controls the syntax spec for parsing; also record it in the cache. (compile_pattern): New arg `posix'. (looking_at_1, string_match_1, fast_string_match): Pass 0 for new arg. (search_buffer): New arg `posix'. Now static. (search_command): New arg `posix'. All callers changed. (Fposix_search_forward, Fposix_search_backward): New functions. (string_match_1, looking_at_1): New subroutines broken out. (Fstring_match, Flooking_at): Use them. (Fposix_string_match, Fposix_looking_at): New functions. (syms_of_search): defsubr new functions. Wed Nov 16 11:57:48 1994 Roland McGrath * xdisp.c (try_window): Don't pass window to Fget_char_property; pass its buffer. (display_text_line): Likewise. Wed Nov 16 15:26:06 1994 Francesco Potorti` (pot@cnuce.cnr.it) * Makefile.in.in (TAGS): The new etags allows tagging DEFVARs. Tue Nov 15 19:26:52 1994 Richard Stallman * lread.c (Fload): Call Fsubstitute_in_file_name after trying handler. * fileio.c (Fread_file_name_internal): Protect orig_string. Tue Nov 15 15:00:56 1994 enami tsugutomo * keyboard.c (Fopen_dribble_file): Call fclose only when dribble is non zero. Tue Nov 15 16:32:31 1994 Karl Heuer * keymap.c (access_keymap): Use type test macros. * alloc.c (Fmake_vector): Call allocate_vectorlike. (allocate_vectorlike): New function, extracted from Fmake_vector. * lisp.h: Declare allocate_vectorlike. (VECSIZE): New macro. * process.c (make_process): Use allocate_vectorlike and VECSIZE. * frame.c (make_frame): Likewise. * window.c (make_dummy_parent, make_window): Likewise. (Fcurrent_window_configuration): Likewise. (SAVE_WINDOW_DATA_SIZE): Macro deleted. * lisp.h: Delete declaration of Farray_length. * data.c (Farray_length): Delete this obsolete function. (Faref, Faset): If object is a string, use XSTRING, not XVECTOR. * fns.c (Flength): Don't call Farray_length, just use size field. * xterm.h (XSCROLL_BAR): Extract from Lisp_Vector, not generic pointer. * xselect.c (wait_for_property_change): Encode location as a cons of two integers instead of lying about the type. (wait_for_property_change_unwind): Decode it likewise. * eval.c (Finteractive_p): Use XSUBR instead of its expansion. * lisp.h (GC_INTEGERP, etc): New type-test macros for use during GC. * buffer.h (OVERLAY_POSITION): Use the new type-test macros. * process.c (NETCONN_P, kill_buffer_processes): Likewise. * buffer.c (overlays_at): Likewise. * filelock.c (unlock_all_files): Likewise. * xfns.c (x_window_to_frame): Likewise. (x_any_window_to_frame, x_top_window_to_frame): Likewise. * fileio.c (Fdo_auto_save): Likewise. * xfaces.c (Fpixmap_spec_p): Avoid function calls and assignments as arguments to a type-test macro. * textprop.c (PLIST_ELT_P): Likewise. * keymap.c (current_minor_maps): Likewise. * lisp.h (NATNUMP): New macro. (CHECK_NATNUM): Use that macro instead of its expansion. * data.c (Fnatnump): Likewise. * xfns.c (x_set_frame_parameters): Likewise. * keymap.c (access_keymap, store_in_keymap): Likewise. * doc.c (Fdocumentation): Likewise. * alloc.c (Fmake_list): Use CHECK_NATNUM instead of its expansion. Now signals using `wholenump' instead of `natnump'. (Fmake_vector, Fmake_string): Likewise. * data.c (syms_of_data): Set Qwholenump as function, not variable. * alloc.c (free_float): Don't assume XFASTINT accesses the raw bits. (make_float, free_cons, Fcons, Fmake_symbol, gc_sweep): Likewise. Tue Nov 15 09:00:43 1994 Richard Stallman * xterm.c (x_mouse_leave): New function broken out of XTread_socket. When x_focus_event_frame is nonzero, assume that frame gets focus. (XTread_socket): Use x_mouse_leave for LeaveNotify. * xmenu.c (xmenu_show): Call x_mouse_leave. * fileio.c (Fsubstitute_in_file_name): Run a handler. (Qsubstitute_in_file_name): New variable. (syms_of_fileio): Set it up. * lread.c (read_escape): For \S-a, return A. * buffer.c (Frename_buffer): Rename arg NAME to NEWNAME. Mon Nov 14 21:54:45 1994 Richard Stallman * s/freebsd.h (LD_SWITCH_SYSTEM): Add -dc and -dp. (HAVE_GETPAGESIZE): Defined. * sysdep.c (init_sys_modes): Maybe call tcflow. Mon Nov 14 20:39:03 1994 Karl Heuer * lisp.h: (enum Lisp_Misc_Type): Add new enumeration Lisp_Misc_Overlay. (enum Lisp_Type): Delete the corresponding enumeration from here. (struct Lisp_Overlay): New structure. (XOVERLAY, OVERLAYP): Access the new structure. (union Lisp_Misc): Add new member. * buffer.h (OVERLAY_START, OVERLAY_END): Use the new substructure. * alloc.c (mark_object, gc_sweep): Likewise. * print.c (print): Likewise. * buffer.c (Fmake_overlay): Likewise. (Foverlay_properties, Foverlay_get, Foverlay_put): Likewise. * fns.c (internal_equal): Likewise. Simplify by returning int. (Fequal): Use new interface to internal_equal. * buffer.c (list_buffers_1): Use PT, not point. Mon Nov 14 19:30:28 1994 Richard Stallman * fileio.c (Finsert_file_contents): Init not_regular at the beginning. Mon Nov 14 19:03:39 1994 Karl Heuer * buffer.c (Fkill_all_local_variables): Use XBUFFER_LOCAL_VALUE, not XCONS. Mon Nov 14 18:28:51 1994 Roland McGrath * s/gnu.h (A_TEXT_OFFSET): Macro removed. (A_TEXT_SEEK): Define to just sizeof (struct exec). Mon Nov 14 17:15:08 1994 Karl Heuer * lread.c (defvar_int): Use accessor macro. (defvar_bool, defvar_lisp_nopro, defvar_per_buffer): Likewise. Sun Nov 13 11:53:42 1994 Richard Stallman * xfaces.c (load_pixmap): Handle bitmap_id < 0. F is a FRAME_PTR. * frame.c (syms_of_frame): Fix typo. * minibuf.c (Fdisplay_completion_list): Update COLUMN unconditionally. If a name is long, put it on its own line. Sun Nov 13 14:00:52 1994 Brendan Kehoe (brendan@lisa.cygnus.com) * s/hpux9.h (C_SWITCH_SYSTEM) [__GNUC__]: Set -D_BSD to get the correct definitions from sys/wait.h. Sat Nov 12 15:04:53 1994 Richard Stallman * frame.c (syms_of_frame): Doc fix for default-frame-alist. Fri Nov 11 09:52:11 1994 Richard Stallman * fileio.c (Finsert_file_contents): If VISIT, set the buffer components such as the filename even before signaling error for non-regular file. * s/iris3-5.h, s/iris3-6.h (MAIL_USE_FLOCK): Defined. * s/irix3-3.h, s/irix5-0.h (MAIL_USE_FLOCK): Defined. * s/irix5-2.h: New file. * m/paragon.h: New file. Fri Nov 11 02:31:19 1994 Karl Heuer * lisp.h: (enum Lisp_Misc_Type): Add new enumerations Lisp_Misc_Buffer_Local_Value and Lisp_Misc_Some_Buffer_Local_Value. (enum Lisp_Type): Delete the corresponding enumerations from here. (struct Lisp_Buffer_Local_Value): New structure. (XBUFFER_LOCAL_VALUE): Access the new structure. (BUFFER_LOCAL_VALUEP, BUFFER_SOME_LOCAL_VALUEP): Likewise. (union Lisp_Misc): Add new member. * alloc.c (mark_object): New code to handle buffer-local substructure. (gc_sweep): Generalize marker code to handle other substructures. * bytecode.c (Fbyte_code): Special case for buffer-local objects is now handled by the more general test. Simplify. * buffer.c (set_buffer_internal): Use XBUFFER_LOCAL_VALUE, not XCONS. * data.c (store_symval_forwarding): Likewise. (swap_in_symval_forwarding, Fset, default_value, Fset_default, Fkill_local_variable): Likewise. (Fmake_variable_buffer_local): Use the new substructure. (Fmake_local_variable): Likewise. Thu Nov 10 02:56:12 1994 Richard Stallman * process.c (create_process) [OSF1]: Use setpgid, not setpgrp. Wed Nov 9 15:44:17 1994 Boris Goldowsky * cmds.c (Fnewline): Always use insert_and_inherit. Wed Nov 9 22:41:04 1994 Richard Stallman * lisp.h (FRAMEP): Use the second definition whenever HAVE_MOUSE. * keyboard.c (tracking_off): Test old value with NILP. Restore the old value whatever it may be. (syms_of_keyboard): Use DEFVAR_LISP for track-mouse. Wed Nov 9 00:54:09 1994 Karl Heuer * data.c (Fboundp, find_symbol_value): Use type test macros instead of checking XTYPE directly. * keyboard.c (print_help): Set help-mode in *Help* buffer. * keymap.c (describe_buffer_bindings): Likewise. * syntax.c (describe_syntax_1): Likewise. Tue Nov 8 22:43:40 1994 Roland McGrath * keyboard.c (EVENT_QUEUES_EMPTY): Only test do_mouse_tracking and mouse_moved #ifdef HAVE_MOUSE. (Ftrack_mouse): Protect with #ifdef HAVE_MOUSE. (syms_of_keyboard): Protect initialization of do_mouse_tracking, defsubr of Strack_mouse, and DEFVAR of track-mouse with #ifdef HAVE_MOUSE. Mon Nov 7 21:43:01 1994 Karl Heuer * frame.c (Fset_frame_height): Compare against height, not width. Mon Nov 7 21:37:36 1994 Roland McGrath * keyboard.c: Move decl of input_fd outside of #ifdef HAVE_X_WINDOWS. Thu Nov 3 22:48:14 1994 Karl Heuer * xterm.c (XTread_socket): Generate iconify and deiconify events. Thu Nov 3 15:45:02 1994 Geoff Voelker * m/intel386.h (VIRT_ADDR_VARIES) [WINDOWSNT]: Defined. (DATA_END) [WINDOWSNT]: Defined. (DATA_START) [WINDOWSNT]: Defined. (HAVE_ALLOCA) [WINDOWSNT]: Defined. * s/windowsnt.h: Include malloc.h. (MODE_LINE_BINARY_TEXT): Defined. (HAVE_MOUSE): Defined. * ntheap.c (sbrk): Allow request sizes to be different than the page size. * makefile.nt: Changed references of m\m-windowsnt.h to m\intel386.h and of s\s-windowsnt.h to s\windowsnt.h. Tue Nov 1 23:19:30 1994 Karl Heuer * xfns.c (Fx_list_fonts): Don't bother to retrieve font info when there's no size_ref to compare it against. * editfns.c: (Fdecode_time): Fix Lisp_Object vs. integer problems. Don't use tm_gmtoff; it's not portable. * lisp.h: Leave DEVICE_SEP undefined by default. Tue Nov 1 05:31:17 1994 Richard Stallman * buffer.c (init_buffer): Fix error message syntax. * fileio.c (Fsubstitute_in_file_name): Add missing #endif. * lread.c: Don't include ctype.h. (isfloat_string, read1): Don't use isdigit. * editfns.c (Fdecode_time): Change one XFASTINT to XINT. * s/windowsnt.h (SYSTEM_PURESIZE_EXTRA): Defined. Mon Oct 31 20:48:15 1994 Richard Stallman * xfns.c (x_window): Make ibw 0 by default. Mon Oct 31 16:47:47 1994 Karl Heuer * xterm.c (XTclear_end_of_line): Finish the line dance here too, just as was done in XTwrite_glyphs. * xdisp.c (column_number_displayed): New variable. (redisplay, redisplay_window): If that var is set, do mode line. (display_mode_line): Unset the var. (decode_mode_spec): Set the var if %c was seen. Sun Oct 30 13:47:05 1994 voelker * makefile.nt: New file. * nt.c, nt.h: New files. * ntheap.c, ntheap.h: New files. * ntinevt.c, ntinevt.h: New files. * ntproc.c, ntterm.c: New files. * m/windowsnt.h, s/windowsnt.h: New files. * nt.c: New file. * makefile.nt:New file. * lisp.h (DEVICE_SEP, DIRECTORY_SEP, IS_DEVICE_SEP) (IS_DIRECTORY_SEP, IS_ANY_SEP): New macros, defined if not already def. * s/msdos.h (DOS_NT): Defined. * term.c (term_init) [WINDOWSNT]: Do some Windows-specific initialization, then skip the rest of the code. (FRAME_TERMCAP_P) [WINDOWSNT]: Always return 0. * systty.h: Test DOS_NT, not MSDOS. * syssignal.h [WINDOWSNT] (EMACS_KILLPG): Use win32_kill_process. * sysdep.c [WINDOWSNT]: Add includes for NT. Define _P_WAIT. Declare _spawnlp, _getpid. [WINDOWSNT] (select, strerror, vfork): Don't use these definitions. * sysdep.c (init_sys_modes): Test DOS_NT, not MSDOS. (emacs_get_tty, emacs_set_tty,(child_setup_tty, init_baud_rate): Ditto. * sysdep.c (sys_subshell) [WINDOWSNT]: Use _spawnlp. not vfork. (wait_for_termination) [WINDOWSNT]: Use wait. (discard_tty_input) [WINDOWSNT]: Do nothing at all. * process.c: Use macros IS_ANY_SEP, IS_DIRECTORY_SEP, IS_DEVICE_SEP, DIRECTORY_SEP, and DEVICE_SEP. [WINDOWSNT]: Add includes. Don't define sys_siglist. * process.c (sigchld_handler): Work around bug in MS C compiler. (sigchld_handler) [WINDOWSNT]: Do not call signal. (signal_process) [WINDOWSNT]: Use win32_kill_process instead of kill. (read_process_output) [WINDOWSNT]: Use read_child_output instead of read. * process.c (create_process) [WINDOWSNT]: Use pipe_with_inherited_out and pipe_with_inherited_in. Use the pid returned by child_setup. Deal with not having vfork, Call register_child. (close_process_descs): Do nothing if WINDOWSNT. * process.c (proc_buffer_char): No longer static. * ndir.h (MAXNAMLEN) [WINDOWSNT]: Define as 255. * mem-limits.h [WINDOWSNT]: Don't include vlimit.h. (get_lim_data): Alternate definition for WINDOWSNT. * lread.c: Change explicit uses of the Unix directory separator '/' to uses of the macros IS_ANY_SEP, IS_DIRECTORY_SEP, IS_DEVICE_SEP, DIRECTORY_SEP, and DEVICE_SEP. * lread.c (init_lread) [WINDOWSNT]: Disable warnings about directories in the load path not existing. * lread.c (load): Test DOS_NT instead of MSDOS. * keyboard.c (read_key_sequence): Use flags instead of gotos to enable the Microsoft C compiler to compile the routine. * keyboard.c (read_avail_input) [WINDOWSNT]: Just return 0. * fileio.c: Change explicit uses of the Unix directory separator '/' to uses of the macros IS_ANY_SEP, IS_DIRECTORY_SEP, IS_DEVICE_SEP, DIRECTORY_SEP, and DEVICE_SEP. * fileio.c [WINDOWSNT]: Don't define HAVE_FSYNC; add includes for NT. * fileio.c (Ffile_name_absolute_p): Test DOS_NT instead of MSDOS. (Fwrite_region, Fdo_auto_save, Ffile_modes): Likewise. * fileio.c (Qfind_buffer_file_type): Test DOS_NT instead of MSDOS. (syms_of_files): Likewise. (Finsert_file_types): Test DOS_NT instead of MSDOS. Rename local var try to trytry. * fileio.c (Fadd_name_to_file): Wlways fail. (Frename_file) [WINDOWSNT]: Use MoveFile, not link and unlink, and check for both ERROR_FILE_EXISTS and ERROR_ALREADY_EXISTS. (Fmake_directory_internal) [WINDOWSNT]: Invoke mkdir without the mask. * fileio.c (Fexpand_file_name): Test DOS_NT, not MSDOS. (Fexpand_file_name) [WINDOWSNT]: Accept // or \\ at start. Call dostonunix_filename for HOME envvar, for ~USER. Quote directory separators found in environment variables. (Fsubstitute_in_file_name): Test DOS_NT instead of MSDOS. (Fsubstitute_in_file_name) [WINDOWSNT]: Accept // or \\ at start. Work around alloca bug in MS compiler. (Ffile_name_directory): Test DOS_NT instead of MSDOS sometimes. But don't insert a drive letter on windows. * emacs.c (Fdump_emacs): Don't reset the data start address by invoking memory_warnings just before unexec-ing. * editfns.c (init_editfns): Get the username from the environment variable USERNAME instead of USER. * dired.c: Use macros IS_ANY_SEP, IS_DIRECTORY_SEP, and DIRECTORY_SEP. (file-attributes) [WINDOWSNT]: Set st_gid and st_uid to Qnil; use get_inode_and_device_vals to fake up inode number and device number. * callproc.c (getenv_internal) [WINDOWSNT]: Use strnicmp, not bcmp. * callproc.c (child_setup): Use IS_DIRECTORY_SEP. [WINDOWSNT]: Call prepare_standard_handles. Use spawnve. Use reset_standard_handles. * callproc.c (Fcall_process_region): Test DOS_NT, not MSDOS. (Fcall_process) [WINDOWSNT]: Call pipe_with_inherited_out. Use the return value of child_setup to get the child's pid; don't call vfork etc. explicitly. * callproc.c [WINDOWSNT]: Add includes. Defone NOMINMAX, _P_NOWAIT. (Vbinary_process_input, Vbinary_process_output) (Qbuffer_file_type): Test DOS_NT, not MSDOS. (syms_of_callproc): Test DOS_NT, not MSDOS. * callproc.c (init_callproc): Test DOS_NT, not MSDOS. * buffer.h (struct buffer): Test DOS_NT, not MSDOS. * buffer.c (init_buffer): Use DIRECTORY_SEP, IS_DIRECTORY_SEP macros, not character constants. (init_buffer_once, syms_of_buffer): Test DOS_NT, not MSDOS. Sun Oct 30 04:21:48 1994 Erik Naggum * editfns.c (Fdecode_time): New function. (syms_of_editfns): defsubr it. Sun Oct 30 03:20:24 1994 Richard Stallman * keyboard.c (make_lispy_event): Record double and triple for drags. Put in click_modifier for multi-clicks. (read_key_sequence): Convert double-drag first to plan drag, and only later try a click. * unexsunos4.c (unexec): Don't print number of pure bytes used. Sat Oct 29 19:28:05 1994 Richard Stallman * xfns.c (Fx_create_frame): Don't set xlwmenu_default_font if not USE_X_TOOLKIT. * puresize.h (BASE_PURESIZE): Increment MULTI_FRAME value. Sat Oct 29 14:23:39 1994 Karl Heuer * keyboard.c (read_avail_input): Fix Lisp_Object vs. int problem. Sat Oct 29 05:40:20 1994 Richard Stallman * xterm.c (fast_find_position): Special case if POS is end of buffer. * xterm.c (x_delete_display): Call XrmDestroyDatabase. Fri Oct 28 14:54:18 1994 Richard Stallman * s/osf1.h (LD_SWITCH_SYSTEM): Definitions deleted. * m/alpha.h (LD_SWITCH_MACHINE): New definition. Fri Oct 28 10:06:02 1994 Rainer Schoepf * s/osf1.h (INTERRUPTIBLE_IO, INTERRUPTIBLE_OPEN, INTERRUPTIBLE_CLOSE) (read, write, open, close): New definitions. Thu Oct 27 13:43:54 1994 Karl Heuer * buffer.c (Fset_buffer_major_mode): New function. Set the default major mode here. (Fget_buffer_create): Not here. (Fswitch_to_buffer): Call Fset_buffer_major_mode. (syms_of_buffer): defsubr the new function. * termhooks.h (iconify_event, deiconify_event): New enum event_kind's. * keyboard.c (kbd_buffer_get_event): Translate them to lispy events. (head_table): Initialize those new symbols appropriately. * frame.c (keys_of_frame): Bind those events to 'ignore, since the window manager has already done the work. * xmenu.c (set_frame_menubar): Don't copy string during GC risk. Wed Oct 26 04:07:28 1994 Richard Stallman * config.h.in (HAVE_GETPAGESIZE): Add #undef. * m/sequent-ptx.h (HAVE_GETPAGESIZE): Explicitly #undef. * s/linux.h, s/msdos.h (HAVE_GETPAGESIZE): Definition deleted. * m/symmetry.h (HAVE_GETPAGESIZE): Definition deleted. * xterm.c (x_destroy_window): Rewrite to fetch dpyinfo just once. * xfns.c (Fx_create_frame): Set xlwmenu_default_font. * widget.c (set_frame_size): Set app_shell and wmshell the same. * xterm.c [USE_X_TOOLKIT]: Make application context explicitly and support multiple top-level shells. (x_initialize): Call XtToolkitInitialize, XtCreateApplicationContext; don't open display or make a shell. (x_term_init): Call XtOpenDisplay. * xfns.c [USE_X_TOOLKIT] (x_window): Use XtAppCreateShell. (Xt_app_shell, Xt_app_con): Variables deleted. (Fx_close_connection) [USE_X_TOOLKIT]: Call XtCloseDisplay. * xterm.c (x_scroll_bar_create): Use XMapRaised directly. (x_make_frame_visible, x_iconify_frame): Likewise. (XMapWindow): Macro definition deleted. (METABIT): Macro deleted. (MAXDESC, FD_SETSIZE, FD_SET, FD_CLEAR, FD_ZERO, FD_ISSET): Likewise. (x_id_name): Variable deleted. * process.c (status_message): Add a cast. (sigchld_handler): Add a cast. * xfns.c (x_window): Pass new arg f to hack_wm_protocols. * xdisp.c (display_text_line): Truncate the minibuf_prompt if nec. Wed Oct 26 02:17:20 1994 Karl Heuer * window.c (syms_of_window): Fix missing \n\'s. Wed Oct 26 00:52:17 1994 Richard Stallman * xselect.c (x_own_selection, x_get_foreign_selection): Change calls to x_catch_errors and friends. * xfns.c (x_set_mouse_color, x_real_positions): Change calls to x_catch_errors and friends. * xterm.c (x_catch_errors, x_check_errors, x_had_errors_p) (x_uncatch_errors): Make the argument a display, not a frame. * xterm.c (XTread_socket_fake_io_error): New variable. (XTread_socket): Obey XTread_socket_fake_io_error. Tue Oct 25 20:20:20 1994 Karl Heuer * process.c (list_processes_1): Print tty name. Tue Oct 25 09:39:37 1994 Karl Fogel (kfogel@phylo.life.uiuc.edu) * window.c (Vtemp_buffer_show_function): Doc fix. Tue Oct 25 03:55:52 1994 Richard Stallman * xterm.h: Delete X10 code. * xfns.c (Fx_create_frame): Don't increment refernce_count until the frame is put on the frame list. * xterm.c (x_initialize): Init x_noop_count, x_focus_frame and x_highlight_frame here. (x_term_init): Not here. * xterm.c (x_term_init): Open the connection first thing; if that fails, don't allocate dpyinfo. Mon Oct 24 20:43:57 1994 Karl Heuer * xdisp.c (decode_mode_spec): New spec %c, for current column. Mon Oct 24 02:03:34 1994 Richard Stallman * xselect.c (Fx_selection_exists_p): Fix backwards if. * xterm.c (x_delete_display): New function. (x_connection_closed): New args dpyinfo and error_message. Delete all frames on the dead display and all frames using them for minibuffers. Call x_delete_display. Maybe signal a Lisp error. * xfns.c (Fx_close_connection): Call x_delete_display. * xselect.c (Fx_selection_exists_p): If selected_frame isn't an x frame, return nil. * keyboard.c (record_char): New subroutine. (read_char): Use record_char. Split up menu-bar mouse click events here. Call record_char for both halves; likewise echo_char and add_command_key. Sun Oct 23 01:39:05 1994 Richard Stallman * xfns.c (x_display_info_for_name, Fx_open_connection): Signal error if x_term_init fails. (Fx_open_connection): New arg must_succeed. * xfns.c (x_real_positions): Catch errors and retry if error happens. No need to block input here. * xterm.c (x_term_init): Don't report error here--just return 0. * xfns.c (Fx_create_frame): Don't store the frame name till after FRAME_X_DISPLAY_INFO is set up. (Fx_close_connection): Renamed from Fx_close_current_connection * xfns.c: Many doc fixes and Lisp function arg renamings. * xterm.c (x_scroll_bar_report_motion): Store proper value in *bar_window (the Emacs window, not the X window number). Sat Oct 22 00:54:08 1994 Richard Stallman * keyboard.c (kbd_buffer_get_event): Cope if mouse_position_hook does not store anything. * xterm.c (x_scroll_bar_report_motion): Don't clear *fp. * xterm.h (struct x_display_info): New fields bitmaps, bitmaps_size, bitmaps_last. (struct x_bitmap_record): Structure moved here. * xfns.c (x_bitmaps, x_bitmap_size, x_bitmap_last): Variables deleted. Use fields in x_display_info instead. (x_bitmaps_free): Variable deleted. (x_destroy_bitmap, x_allocate_bitmap_record): Don't use or set it. (x_allocate_bitmap_record): New arg f. Callers changed. (x_lookup_pixmap): Function deleted. (x_destroy_all_bitmaps): New function. (Fx_close_current_connection): Call x_destroy_all_bitmaps. Free the fonts in the font table. Free various other data that dpyinfo points to. Avoid using Fdelq. * xterm.c (x_wm_set_icon_pixmap): Use x_bitmap_pixmap. * xterm.c: (show_mouse_face): New arg dpyinfo. All callers changed. (clear_mouse_face): New arg dpyinfo. All callers changed. * xterm.h (struct font_info): New type. (struct x_display_info): New fields font_table, font_table_size and n_fonts. * xterm.h (struct x_display_info): New field scratch_cursor_gc. * xterm.c (scratch_cursor_gc): Variable deleted. (dumpglyphs): Use scratch_cursor_gc in x_display_info. * xterm.h (mouse_face_*): New fields. * xterm.c (mouse_face_*): Variables deleted. Use fields in x_display_info instead. * xterm.c (syms_of_xterm): Don't staticpro mouse_face_window. * xterm.c (expose_all_windows, expose_all_icons): Variables deleted. (BLOCK_INPUT_mask): Variable deleted. * xterm.h (struct x_display_info): New field x_id_name. * xfns.c (x_set_name, Fx_create_frame): Use x_id_name field. * xterm.c (x_term_init): Set up x_id_name field. (x_id_name): Variable deleted. * xterm.c (x_font_table, x_font_table_size, x_n_fonts): Vars deleted. (x_new_font): Use new fields. (warp_mouse_on_deiconify): Unused variable deleted. * xterm.c (x_term_init): Set up dpyinfo->xrdb. Set up dpyinfo->vertical_scroll_bar_cursor. (x_scroll_bar_create): Use vertical_scroll_bar_cursor slot. (x_vertical_scroll_bar_cursor): Variable deleted. * xterm.c (x_term_init): Really return dpyinfo. * insdel.c (insert_from_buffer_1): Don't use min. * xterm.c (x_term_init): Call add_keyboard_wait_descriptor, not change_keyboard_wait_descriptor. * xfns.c (Fx_close_current_connection): Call delete_keyboard_wait_descriptor. * process.c: Handle multiple keyboard input descriptors. (non_keyboard_wait_mask): New variable. (Fset_process_filter): Update non_keyboard_wait_mask (create_process, Fopen_network_stream, deactivate_process): (init_process, sigchld_handler): Likewise. (wait_reading_process_input): Maybe use non_keyboard_wait_mask. (add_keyboard_wait_descriptor): Renamed from change_keyboard_wait_descriptor. Clear the old descriptor's bit only the first call. (delete_keyboard_wait_descriptor): New function. (keyboard_bit_set): New function. (wait_reading_process_input): Use keyboard_bit_set. Start the loop over process descs from 0, and explicitly ignore non-process input descs. (init_process): Don't init keyboard_descriptor. (keyboard_descriptor): Variable deleted. (add_keyboard_wait_descriptor): Don't set keyboard_descriptor. (delete_keyboard_wait_descriptor): New function. * xterm.c (x_term_init): Pass new arg to init_sigio. Don't set old_fcntl_owner. Don't call change_input_fd. (XTread_socket): Loop over displays and process input from each. * sysdep.c: Never use input_fd if using X. (stuff_char): Do nothing if read_socket_hook. (setpgrp_of_tty): Function deleted. (init_sigio): Take fd as argument. Callers changed. Don't call request_sigio; do the work here. (request_sigio, unrequest_sigio): Do nothing if read_socket_hook. (init_sys_modes): Don't call EMACS_GET_TTY unless we are going to change the settings. * xfns.c (Fx_close_current_connection): Call check_x_display_info. Delete the display from x_display_list and x_display_name_list. (Fx_display_list): New function. (syms_of_xfns): defsubr it. * xterm.c (x_display_name_list): New variable. (syms_of_xterm): staticpro it. Don't staticpro slots in the_x_screen. (x_term_init): Update x_display_name_list along with x_display_list. Actually malloc the x_display_info. (the_x_screen): Variable deleted. * xfns.c (Fx_list_fonts): Use `name_list_element' field. (x_display_info_for_name): Scan x_display_name_list along with x_display_list. * xterm.h (struct x_display_info): Replace elements `name' and `face_list_cache' with one cons cell `name_list_element'. (x_display_name_list): Variable declared. Sat Oct 22 00:44:29 1994 Karl Heuer * insdel.c (insert_from_buffer, insert_from_buffer_1): New functions. * editfns.c (Finsert_buffer_substring): Use insert_from_buffer instead of insert. Fri Oct 21 23:17:22 1994 Richard Stallman * xmenu.c (xmenu_show): Get the screen number for DisplayHeight and DisplayWidth. Use root_window slot in the x_display_info. * xfns.c (x_sync): Take frame ptr as arg. * frame.c (other_visible_frames): Pass a frame ptr to x_sync. * xterm.c (x_make_frame_visible, x_make_frame_invisible): Pass a frame ptr to x_sync. Fri Oct 21 22:52:16 1994 Karl Heuer * insdel.c (insert_before_markers): Don't inherit; insert_before_markers_and_inherit does that. Fri Oct 21 03:06:38 1994 Richard Stallman * dispnew.c (Fframe_or_buffer_changed_p): Detect deletion of a buffer at the end of the buffer list. * xterm.c (x_term_init): Init all the components of dpyinfo. * sysdep.c (input_fd): No longer static. * keyboard.c (read_avail_input): Use input_fd. Thu Oct 20 20:45:32 1994 Richard Stallman * xfns.c (check_x_display_info): New function. (Fx_create_frame): Use it. (Fx_display_*, Fx_server_*): Use fields in the x_display_info, not static variables. Call check_x_display_info. Thu Oct 20 15:06:33 1994 Karl Heuer * window.c (Fdisplay_buffer): Make old_selected_window a Lisp_Object. Thu Oct 20 11:49:26 1994 Tom Tromey * buffer.c (list_buffers_1): Always mark current_buffer read-only. Thu Oct 20 10:56:01 1994 Fred Pierresteguy * m/dpx2.h (LD_SWITCH_MACHINE): Defined. Thu Oct 20 00:36:46 1994 Richard Stallman * term.c (calculate_costs): Call x_screen_planes. * xfns.c (x_screen_planes): New function. * xterm.h (EMACS_CLASS): Macro moved here. * xfns.c (EMACS_CLASS): Macro moved to xterm.h. * xfns.c (Qdisplay): New variable. (syms_of_xfns): Set it up. (Fx_create_frame): Handle display parameter which says where to get the FRAME_X_DISPLAY_INFO. (x_display_info_for_name): New function. * xterm.c (x_display_info_for_display): New function. * xselect.c (Xatom_*): Variables deleted. Use slots in x_display_info structure instead. (symbol_to_x_atom, x_atom_to_symbol): New arg dpyinfo. All callers changed. (xatoms_of_xselect): Function deleted. * xfns.c (select_visual): New arg dpy. * xterm.h (struct x_display_info): New fields *_mod_mask. * xterm.c (x_*_mod_mask): Variables deleted. (x_x_to_emacs_modifiers, x_emacs_to_x_modifiers): New arg dpyinfo; all callers changed. Store the masks in that structure. * xterm.h (struct x_display_info): New field icon_bitmap_id. * xterm.c (icon_bitmap): Variable deleted. (x_bitmap_icon): Use icon_bitmap_id in x_display_info. * xterm.c (icon_font_info): Variable deleted. * xterm.h (struct x_display_info): New field `connection'. * xterm.c (x_term_init): Set up `connection' field. * xterm.h (x_display_list): New variable. * xterm.c (x_find_modifier_meanings): Arg is now struct x_display_info *. (x_term_init): Return an x_display_info *. Store all the data in it, including X atoms and xrdb. Put the x_display_info structure on x_display_list. Pass name as Lisp_Object. (the_x_screen): Variable moved here. (syms_of_xterm): Staticpro parts of the_x_screen. * xfns.c (Fx_open_connection): Get dpyinfo from x_term_init. Don't set up atoms, xrdb here. Pass name as Lisp_Object. (the_x_screen): Variable moved to xterm.c. (syms_of_xfns): Don't staticpro it here. * xterm.h (struct x_display_info): New field xrdb. * xfns.c (xrdb): Variable deleted. (Fx_get_resource): Use selected_frame's xrdb. (x_get_resource_string): Likewise. * xterm.h (XExposeRegionEvent): Unused macro deleted. (XGetWindowInfo, XGetFont, XLoseFont): Unused macros deleted. (MINWIDTH, MINHEIGHT, MAXWIDTH, MAXHEIGHT): Unused macros deleted. (MAX_FACES_AND_GLYPHS, Bitmap): Unused macros deleted. (struct event_queue): Structure deleted (was unused). (EVENT_BUFFER_SIZE): Macro deleted. * xterm.h (XClear): Macro deleted. Callers use XClearWindow. (XWarpMousePointer): Macro deleted. Callers use XWarpPointer. (XStuffPending): Macro deleted. Callers use XPending. (XHandleError, XHandleIOError): Macros deleted. Callers use XSet...ErrorHandler. (XChangeWindowSize): Macro deleted. Callers use XResizeWindow. (Color): Macro deleted; replaced with XColor. (FONT_TYPE): Macro deleted; replaced with XFontStruct. (PIX_TYPE): Macro deleted; replaced with unsigned long. * xterm.h (FRAME_X_SCREEN): New macro. (WHITE_PIX_DEFAULT, BLACK_PIX_DEFAULT): Take arg f. * xfaces.c (unload_color): Pass arg f to WHITE_PIX_DEFAULT and BLACK_PIX_DEFAULT. * xterm.c (windowinfo): Variable deleted. * xterm.h (ROOT_WINDOW): Macro deleted. (struct x_display_info): New field root_window. All uses changed. * xterm.h (XDISPLAY): Macro deleted. (XFlushQueue): Macro deleted. All callers changed. (DISPLAY_SCREEN_ARG): Maco deleted. (DISPLAY_CELLS): Macro deleted. (WINDOWINFO_TYPE): Macro deleted. * xterm.h (struct x_display_info): New fields Xatom... * xterm.c (Xatom_*): Variables deleted. (x_iconify_frame, XTread_socket): Get atoms from the x_display_info, * xfns.c (Fx_open_connection): Store the atoms in x_display_info. (hack_wm_protocols): New arg f. Get atoms from x_display_info. (x_window): Get atoms from x_display_info. * xfns.c (Vmouse_depressed, mouse_buffer_offset): Variables deleted. (syms_of_xfns): Delete Lisp variables too. (Fx_synchronize): Take frame as arg. (Fx_close_current_connection): Take frame as arg. Error is not fatal. * xterm.c (XTread_socket): Don't update Vmouse_depressed. * xterm.h (struct x_display_info): New field grabbed. * xterm.c (x_mouse_grabbed): Variable deleted. (note_mouse_highlight): Use grabbed field instead. (XTmouse_position, XTread_socket): Likewise. * xmenu.c (xdialog_show, xmenu_show): Use grabbed field instead of x_mouse_grabbed. * xfns.c (mouse_timestamp): Variable deleted. * xterm.h (struct x_display_info): Struct renamed from x_screen. (x_display): x_screen field renamed to display_info. (FRAME_X_DISPLAY): Use new name. (FRAME_X_DISPLAY_INFO): Likewise; also renamed from FRAME_X_SCREEN. * xterm.h (struct x_display_info): New fields height, width, screen, visual, n_planes. * xfns.c (screen_visual, x_screen_planes): Variables deleted. (x_screen, x_screen_height, x_screen_width): Variables deleted. (Fx_open_connection): Don't set them here. Put that info in the x_display_info structure. (x_window): Get the visual from x_display_info structure. (x_decode_color): Use n_planes from x_display_info structure. * xterm.c (x_calc_absolute_position, x_wm_set_size_hint): Get screen height, width from the x_display_info structure. * xmenu.c (xmenu_show): Use the screen in FRAME_X_DISPLAY_INFO, not the default screen. * xterm.c: Use FRAME_X_DISPLAY instead of x_current_display and XDISPLAY. * xfns.c: Use FRAME_X_DISPLAY instead of x_current_display and XDISPLAY. (x_in_use): New variable, (check_x, using_x_p): Test x_in_use. (Fx_open_connection): Set x_in_use. (check_x_frame): New function. (defined_color): New arg f specifies frame. Callers changed. (x_decode_color): New arg f. All callers changed. (Fx_color_values, Fx_color_defined_p): New arg FRAME. Use check_x_frame. (Fx_list_fonts): Use check_x_frame. * keyboard.c (do_mouse_tracking): Now a FRAME_PTR. (EVENT_QUEUES_EMPTY, Ftrack_mouse, tracking_off): Changed accordingly. (kbd_buffer_get_event): Let do_mouse_tracking specify the display for mouse tracking. * minibuf.c (read_minibuf): Undo previous change. Wed Oct 19 04:53:18 1994 Richard Stallman * window.c (Fdisplay_buffer): If the other window is smaller than its peer, even out their heights. * xterm.c (x_catch_errors, x_check_errors, d_errors_p) (x_uncatch_errors): Take frame as arg. (x_stop_queuing_selection_requests, x_unqueue_events, x_queue_event) (x_start_queuing_selection_requests): Take frame as arg. (x_find_modifier_meanings): New arg `display'. All callers changed. (x_scroll_bar_create, x_scroll_bar_set_handle) (x_scroll_bar_move): New local var f. (x_scroll_bar_report_motion): Rename arg f to fp. New local var f. (XTmouse_position): Lossage. (frame_highlight, frame_unhighlight): Arg frame renamed to f. * callproc.c (child_setup): Always use _exit. * xselect.c (x_own_selection, x_get_foreign_selection): Pass frame to x_catch_errors, x_check_errors, x_uncatch_errors. * xfns.c (x_set_mouse_color): Pass frame to x_catch_errors, x_check_errors, x_uncatch_errors. * xselect.c (x_get_foreign_selection): Get display from selected_frame. Pass frame to x_stop_queuing_selection_requests and x_start_queuing_selection_requests. (x_own_selection, Fx_disown_selection_internal, Fx_selection_exists_p) (Fx_store_cut_buffer_internal, Fx_get_cut_buffer_internal) (Fx_rotate_cut_buffers_internal): Get display from selected_frame. * xmenu.c: Use FRAME_X_DISPLAY, not XDISPLAY or x_current_display. (menu_item_equiv_key): Reject equiv sequences that start with mouse clicks. Wed Oct 19 00:26:03 1994 Karl Heuer * search.c: (searchbufs): New variable, replaces searchbuf and last_regexp and search_fastmap. (syms_of_search): Initialize it. (searchbuf_head): New variable. (compile_pattern_1): Renamed from compile_pattern and made static. Copy the regexp string in case the caller modifies it in place later. (compile_pattern): New code, uses a cached entry if one is available. The pattern buffer is now a return value instead of an arg. (set_search_regs): Set num_regs directly, since there's no active pattern buffer to pass to re_set_registers. (Fstore_match_data): Likewise. (Flooking_at): Use the new calling convention for compile_pattern. (Fstring_match, fast_string_match, search_buffer): Likewise. * dired.c (Fdirectory_files): Likewise. Tue Oct 18 16:34:10 1994 Richard Stallman * keyboard.c (Voverriding_local_map_menu_flag): New variable. (syms_of_keyboard): Set up Lisp var. (menu_bar_items): Obey Voverriding_local_map_menu_flag. * ralloc.c (struct heap): New fields first_bloc, last_bloc. (struct bp): New field heap. (get_bloc, free_bloc, obtain, r_alloc_sbrk): Update new fields. (reorder_bloc): New function. (update_heap_bloc_correspondence): Renamed from update_heap_free_pointers. Update new fields. (relinquish): Add error check for new fields. * Makefile.in.in (SOME_MACHINE_OBJECTS): Add msdos.o and x*.o files. Mon Oct 17 21:28:13 1994 Karl Heuer * minibuf.c (read_minibuf): Store the object, not the string, into the history variable. * xfns.c (x_set_unsplittable): New function. (x_frame_parms): Add that function to the table. * xterm.c (do_line_dance): Decrement index only once per loop. * scroll.c (do_line_insertion_deletion_costs): Fix argument order. Mon Oct 17 04:43:21 1994 Morten Welinder * fileio.c (Fexpand_file_name) [MSDOS]: Correct the for absolute default directory. * config.h.in [HAVE_X_WINDOWS]: #define HAVE_FACES and HAVE_MOUSE. * dispextern.h: Guard entire file from being include more than once. [MSDOS]: Include msdos.h. * dispnew.c (direct_output_for_insert): Check HAVE_FACES, not HAVE_X_WINDOWS. (selected_frame, last_minibuffer_frame): Doc fix. * dosfns.c (Fset_mouse_position, Fmsdos_mouse_p) [!HAVE_X_WINDOWS]: New functions. (syms_of_dosfns) [!HAVE_X_WINDOWS]: Defsubr them. Also define Qmsdos_color_translate. (init_dosfns) [SYSTEM_MALLOC]: Don't call non-existing get_lim_data. * dosfns.h (Qmsdos_color_translate) [!HAVE_X_WINDOWS]: New variable. * editfns.c (init_editfns) [MSDOS]: Let the user name default to "root". * emacs.c (main) [MSDOS && !HAVE_X_WINDOWS]: Call syms_of_xfaces and syms_of_xmenu. * frame.c [MSDOS]: Include msdos.h. (Fframep #1) [MSDOS]: Doc change for the following. (Fframep #2) [MSDOS]: Return 'pc for when termcap is not used. (Fmouse_position #2) [HAVE_MOUSE]: Return useful information. (Fframe_parameters #2): Show "font" as "default". (Fframe_parameters #2) [MSDOS]: Show fore- and background colours. (Fmodify_frame_parameters #2) [MSDOS]: Call IT_set_frame_parameters. (Fframe_list #2): New stub function. (syms_of_frame #2): defsubr frame_list. (syms_of_frame #2) [MSDOS]: Initialize the_only_frame. (Fselected_frame #2): Doc fix. * frame.h [!MULTI_FRAME]: We give up having selected_frame be an always-zero integer variable. From now on it will be a pointer to a `struct frame' just like in the MULTI_FRAME case. (selected_frame, last_nonminibuf_frame): use FRAME_PTR, not EMACS_INT. (XFRAME): Redefine to use the_only_frame. (XSETFRAME): Define to set Lisp value. (WINDOW_FRAME): Redefine to return Lisp value. (FOR_EACH_FRAME): Set the frame variable to Lisp value. (output_method): New method: output_msdos_raw. (FRAME_TERMCAP_P, FRAME_X_P) [MSDOS]: Define non-stub versions. * keyboard.c (read_char_x_menu_prompt): Include menu code also in case MSDOS. (gobble_input): Complete Sep 15 change. * lisp.h: #define glyph-stuff when HAVE_FACES, not only when HAVE_X_WINDOWS. (FRAMEP): Define different versions for MULTI_FRAME and MSDOS. Otherwise, don't define at all. * makefile.in.in (MSDOS_SUPPORT): Add faces.elc. (msdos.o, dosfns.o): Add dependencies. (MSDOS_OBJ): New set of object files. (obj): Include MSDOS_OBJ. * msdos.c: #include dispextern.h, termopt.h, and window.h needed for the following. (highlight): New variable. (rien_du_tout, IT_ring_bell, IT_set_face, IT_write_glyphs, IT_clear_end_of_line, IT_cursor_to, IT_reassert_line_highlight, IT_change_line_highlight, IT_update_begin, IT_set_menu_bar_lines, IT_set_frame_parameters): New functions like their XT_* counterparts. (internal_terminal_init): Initialize Vwindow_system, Vwindow_system_version, the_only_x_display, and terminal hooks. (mouse_get_xy): New function. (mouse_get_pos, mouse_check_moved): Use mouse_get_xy. (IT_menu_create, IT_menu_make_room, IT_menu_search_pane, IT_menu_calc_size, IT_menu_display, XMenuCreate, XMenuAddPane, XMenuAddSelection, XMenuLocate, XMenuActivate, XMenuDestroy, x_pixel_width, x_pixel_height): New functions. (init_environment) [HAVE_X_WINDOWS]: Let DISPLAY default to "unix:0.0". (init_environment): Handle the case of a relative argv[0]. (dos_rawgetc): Use XSETFRAME. (the_only_x_display, x_current_display) [!HAVE_X_WINDOWS]: New variables. * msdos.h: (XFontStruct, GC, Pixmap, Display, Window) [MSDOS_NO_X]: Dummy types. (struct face, FACE_HAS_GC, FACE_GC, FACE_FOREGROUND, FACE_BACKGROUND, FACE_FONT, FACE_STIPPLE, FACE_UNDERLINE_P) [MSDOS_NO_X]: Define like corresponding X-versions. (struct x_display) [MSDOS_NO_X]: Define cut-down version. (FRAME_PARAM_FACES, FRAME_N_PARAM_FACES, FRAME_DEFAULT_PARAM_FACE, FRAME_MODE_LINE_PARAM_FACE, FRAME_COMPUTED_FACES, FRAME_N_COMPUTED_FACES, FRAME_SIZE_COMPUTED_FACES, FRAME_DEFAULT_FACE, FRAME_MODE_LINE_FACE, x_current_display, XFreeGC, same_size_fonts, unload_font, unload_color, XGetGeometry, DisplayWidth, DisplayHeight, XMenuSetAEQ, XMenuSetFreeze, XMenuRecompute, FONT_WIDTH, check_x, ButtonReleased) [MSDOS_NO_X]: Define suitable stubs. (XM_FAILURE, XM_SUCCESS, XM_NO_SELECT, XM_IA_SELECT) [MSDOS_NO_X]: Define like old-x-menu versions. Guard the entire file from being included more than once. (internal_flush): Correct guarding conditional. Don't include . * puresize.h (SYSTEM_PURESIZE_EXTRA): Default to 0. (BASE_PRESIZE): Increase by SYSTEM_PURESIZE_EXTRA. * s/msdos.h: #define HAVE_FACES. (LIBX11_SYSTEM, HAVE_X11R5) [HAVE_X_WINDOWS]: Define. (PURESIZE): Don't define. (SYSTEM_PURESIZE_EXTRA): Define. * sysdep.c (init_sys_modes): Make sure that internal_terminal_init is only called once. (init_sys_modes, reset_sys_modes) [HAVE_X_WINDOWS]: Add conditional. (reset_sys_modes) [MSDOS]: Change to MSDOG's default colours. (kbd_input_ast): Use just XSETFRAME. * window.c (init_window_once) [!MULTI_FRAME]: Set selected_frame and last_nonminibuf_frame once and for all. * xdisp.c (redisplay, copy_part_of_rope, fix_glyph, display_text_line, display_mode_line): Check HAVE_FACES, not HAVE_X_WINDOWS. * xfaces.c: Guard the file by HAVE_FACES, not HAVE_X_WINDOWS. [MSDOS]: Include dosfns.h needed for the following. [!HAVE_X_WINDOWS]: Don't #include xterm.h or Xos.h. [!HAVE_X_WINDOWS] (intern_face, clear_face_cache, load_font, load_color, unload_color, Fpixmap_spec_p, load_pixmap, same_size_fonts, frame_update_line_height): Don't define. [!HAVE_X_WINDOWS] (intern_face, clear_face_cache, build_face): Define stubs. (load_color) [MSDOS && !HAVE_X_WINDOWS]: Special version. (Fset_face_attribute_internal) [MSDOS && !HAVE_X_WINDOWS]: Stubify font setting, mask away 0x08 (the blink bit) from background colour. (syms_of_xfaces) [!HAVE_X_WINDOWS]: Don't defsubr Spixmap_spec_p. (Fmake_face_internal): Use FOR_EACH_FRAME. (init_frame_faces): Guard multi-frame stuff with MULTI_FRAME. * xmenu.c [!HAVE_X_WINDOWS]: Don't #include xterm.h. [!HAVE_X_MENU]: Don't #include XMenu.h. (xmenu_show, xdialog_show) [!HAVE_X_WINDOWS]: We don't need the button hack for msdos. (xmenu_show) [!HAVE_X_WINDOWS]: Don't adjust coordinates with respect to the (non-existing) outer window manager. * xterm.c (x_term_init) [!subprocesses]: Don't set input descriptor. Mon Oct 17 02:44:30 1994 Richard Stallman * xfaces.c (intern_face): Update mask properly to set stipple and fill_style. Set everything all at once in XCreateGC. * window.c (Fdisplay_buffer): In desperation case of looking for something to split, verify that a window's frame is splittable. Sun Oct 16 21:16:38 1994 Richard Stallman * Makefile.in.in (xfns.o): Depend on paths.h. * xfns.c: Include paths.h. Sun Oct 16 07:06:52 1994 Morten Welinder * editfns.c (Fuser_login_name): Optional argument uid decides which user's login name to return. Sun Oct 16 01:57:47 1994 Richard Stallman * xterm.c (dumpglyphs): Explicitly draw background stipple. * xfaces.c (intern_face): Set the fill_style. * paths.h.in (PATH_BITMAPS): New macro. * xterm.c (x_bitmap_icon): Arg FILE is now a Lisp_Object. (x_iconify_frame, x_make_frame_visible): Supply FILE arg to it. * xfns.c (x_set_icon_type): Pass x_bitmap_icon 2nd arg as Lisp_Object. (x_icon_type): Return a Lisp_Object. * xfns.c (x_destroy_bitmap, x_reference_bitmap): Take frame as arg. Callers changed. (struct x_bitmap_record): New fields height, width, depth. (x_create_bitmap_from_data): Fill in those fields. (x_bitmap_height, x_bitmap_width, x_bitmap_pixmap): New functions. (x_create_bitmap_from_file): Arg FILE is now a Lisp_Object. Search Vbitmap_file_path for it. Fill in new fields. (syms_of_xfns): Set up Vbitmap_file_path. * xterm.c (x_bitmap_icon): Properly discard the previous bitmap. (x_text_icon): Discard bitmap only if we have one. * xfaces.c (copy_face, merge_faces): Copy the pixmap_h and pixmap_w. (intern_face): Store the stipple in the GC. (unload_color): Really do free the color. (free_frame_faces): Call unload_pixmap. (Fset_face_attribute_internal): Handle background pixmap. Destroy old pixmap when necessary. (free_frame_faces): Destroy pixmaps. (load_pixmap): New function. (Fpixmap_spec_p): New function. (syms_of_xfaces): Set up Lisp function pixmap-spec-p. Set up Qpixmap_spec_p. * dispextern.h (struct face): Delete cached_index field. * xfaces.c (compute_base_face): Don't set cached_index field. * ralloc.c (heap_base): Move static var to top level. (struct heap): New slot `free'. (obtain): Set `free' for new heap. (get_bloc): Update `free'. (find_heap): New function. (update_heap_free_pointers): New function. (resize_bloc, r_alloc_sbrk): Call update_heap_free_pointers. Sat Oct 15 19:46:29 1994 Richard Stallman * lread.c (load_unwind): Cast argument of fclose. * xmenu.c: Delete HAVE_X11 conditionals. * xfaces.c (compute_base_face): Use FRAME_FOREGROUND_PIXEL, FRAME_BACKGROUND_PIXEL, FRAME_FONT. * xterm.h (FRAME_FOREGROUND_PIXEL, FRAME_BACKGROUND_PIXEL) (FRAME_FONT): New macros. Sat Oct 15 20:44:50 1994 Tom Tromey * xterm.c (x_bitmap_icon): Allow bitmap to come from file. (x_wm_set_icon_pixmap): Second arg is now pixmap_id; call x_lookup_pixmap. (x_text_icon): Call x_destroy_bitmap. * xfns.c (x_set_icon_type): If icon-type is a string, then use bitmap from that file. (Fx_create_frame): Set icon_bitmap field to -1. (struct x_bitmap_record): New structure type. (x_bitmaps, x_bitmaps_size, x_bitmaps_last, x_bitmaps_free): New variables. (x_allocate_bitmap_record): New function. (x_reference_bitmap, x_create_bitmap, x_create_bitmap_from_file) (x_destroy_bitmap, x_lookup_pixmap): New functions. * xterm.h (x_display): Changed icon_bitmap_flag to icon_bitmap. Changed all users. Sat Oct 15 15:55:25 1994 Richard Stallman * textprop.c (Fset_text_properties): Special case for getting rid of all properties of a string. Sat Oct 15 00:00:27 1994 Karl Heuer * xterm.c (stuffline, scraplines): Functions deleted. (line_dance, line_dance_len, line_dance_in_progress): New vars. (XTins_del_lines): Don't do any X calls; just update the array. (do_line_dance): New function. Do the X calls here. (XTupdate_end, XTwrite_glyphs): Call do_line_dance. Fri Oct 14 00:44:48 1994 Richard Stallman * s/isc4-0.h (LIBS_SYSTEM): Add -lcposix. (sigblock, SIG_BLOCK): Define if not defined. * sysdep.c (read_input_waiting): Set e.frame_or_window w/ XSETFRAME. * xterm.c (x_new_font): Don't keep looping after the FONT property. Thu Oct 13 22:41:07 1994 Karl Heuer * term.c (term_get_fkeys_1): Workaround for IBM's dialect of terminfo. Thu Oct 13 02:21:03 1994 Richard Stallman * xfns.c (Fx_create_frame): Init the FRAME_X_SCREEN as soon as can be done. * xdisp.c (redisplay): Call clear_face_cache instead of clear_face_vector. Do it at most once per 1000 redisplays. * xfaces.c: Eliminate the "display faces"; store GCs in the "computed faces". (face_vector, nfaces, nfaces_allocated): Vars deleted. (free_frame_faces): Free GCs in the computed faces. Free the computed faces themselves. (clear_face_cache): Renamed from clear_face_vector and completely rewritten to free GCs in the computed faces. (get_cached_face): Function deleted. (build_face): Function deleted; code moved into intern_face. (intern_face): Don't treat default and modeline faces specially. (recompute_basic_faces): Call intern_face, not build_face. * xfaces.c (intern_face, clear_face_vector, load_font, unload_font) (load_color, free_frame_faces, recompute_basic_faces): Use FRAME_X_DISPLAY. * m/mips-siemens.h (C_ALLOCA): Defined. (HAVE_ALLOCA): Definition deleted. * editfns.c (Fuser_login_name, Fuser_real_login_name): Call init_editfns now if it was not done before. * puresize.h (BASE_PURESIZE): Incremented. * lisp.h (Funhandled_file_name_directory): Declared. Mon Oct 10 11:58:00 1994 Rainer Schoepf (Schoepf@Uni-Mainz.de) * unexalpha.c (Brk): Declare as unsigned long. (unexec): Do CHECH_SCNHDR on _RCONST if that's defined. Ignore rdata_section if there is none. (update_dynamic_symbols): New arg new_name. Call changed. Fix some calls to WRITE. (fatal_unexec): Declare all arguments. Wed Oct 12 19:27:27 1994 Richard Stallman * unexelf.c: Include config.h. * s/freebsd.h (LD_SWITCH_SYSTEM): New definition. Tue Oct 11 20:41:25 1994 Karl Heuer * lisp.h (enum Lisp_Misc_Type): Add new enumerations Lisp_Misc_Intfwd, Lisp_Misc_Boolfwd, Lisp_Misc_Objfwd, Lisp_Misc_Buffer_Objfwd. (enum Lisp_Type): Delete the corresponding enumerations from here. (struct Lisp_Buffer_Objfwd): New structure. (struct Lisp_Intfwd, struct Lisp_Boolfwd, struct Lisp_Objfwd): Ditto. (XINTFWD, XBOOLFWD, XOBJFWD, XBUFFER_OBJFWD): Access the new structure. (INTFWDP, BOOLFWDP, OBJFWDP, BUFFER_OBJFWDP): Ditto. (XSETINTFWD, XSETBOOLFWD, XSETOBJFWD, XSETBUFFER_OBJFWD): Deleted. (union Lisp_Misc): Add new members. (allocate_misc): Declare this function. (XINTPTR): Deleted. * alloc.c (mark_object): Use the new substructure. * buffer.c (buffer_slot_type_mismatch): Take just the offset as argument. Only check against types that are actually used. * bytecode.c (Fbyte_code): Skip optimization for all Lisp_Misc types. * data.c (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset, default_value, Fset_default, Fkill_local_variable): Use the new substructure. (store_symval_forwarding): Change args to buffer_slot_type_mismatch. * lread.c (defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer): Use the new substructure. * minibuf.c (test_completion): Fix reversed condition. * ralloc.c: Install Hiroshi Nakano's rewrite to allow multiple heaps, for implementations where the C library makes calls to sbrk directly. Tue Oct 11 15:38:19 1994 Jim Blandy * search.c (scan_buffer): After temporarily turning immediate_quit off, turn it back on by setting it to allow_quit, never 1. * search.c (find_before_next_newline): Declare the arguments' types explicitly; don't let them default to int. * xdisp.c (display_scan_buffer): Pass the correct number of arguments to scan_buffer. Tue Oct 11 03:05:17 1994 Richard Stallman * keyboard.c (read_key_sequence): The output of function-key-map goes to key-translation-map, but not vice versa. Don't exit if either of them is a possibility. Tue Oct 11 02:10:44 1994 Karl Heuer * lisp.h (Lisp_Misc): new type code, replacing Lisp_Marker (and soon to replace other type codes as well). (XMARKER, SETMARKER, MARKERP): Check/set the new type field. (XMISC, SETMISC, MISCP): New accessor macros for the superset type. (struct Lisp_Free): New structure. (Lisp_Misc_Free): Type code for that structure. * buffer.h (OVERLAY_POSITION): Marker assert now tests substructure. * alloc.c: (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the superset type, not just markers. (allocate_misc): New function, extracted from Fmake_marker. (Fpurecopy): Check the substructure. (clear_marks, mark_object, gc_sweep): Likewise. * buffer.c (buffer_slot_type_mismatch): Test against Lisp_Misc. * fns.c (internal_equal): Check the substructure. * print.c (print): Check the substructure. Mon Oct 10 21:44:18 1994 Karl Heuer * sysdep.c (sys_subshell): Use NILP macro directly, not its expansion. Previous code was leftover from when NULL was a bad word. Mon Oct 10 17:29:59 1994 Richard Stallman * fileio.c (Finsert_file_contents): Use original unexpanded FILENAME arg to set buffer-file-name. * buffer.c (list_buffers_1): Fix indentation in header lines. * xdisp.c (redisplay_window): Fix Oct 1 change: don't call cancel_my_columns unless we will call try_window. Mon Oct 10 12:02:15 1994 Jim Blandy * buffer.c (syms_of_buffer): Doc fix for cache-long-line-scans. Mon Oct 10 01:07:44 1994 Richard Stallman * syntax.c (scan_sexps_forward): At startincomment, do notice a 2-char comment ender that straddles FROM. Sun Oct 9 17:47:37 1994 Jim Blandy Cache the results of some scans, to improve performance in buffers containing very long lines. * region-cache.c, region-cache.h: New files. * Makefile.in.in (obj) Add region-cache.o to the list of files. (region-cache.o): New target. (buffer.o, indent.o, search.o): Depend on region-cache.h. * buffer.h (struct buffer): New members: newline_cache, width_run_cache, width_table, and cache_long_line_scans. * buffer.c: #include region-cache.h. (Fget_buffer_create): Initialize new members of struct buffer. (Fkill_buffer): Free memory occupied by caches. (init_buffer_once): Set default value for cache_long_line_scans in buffer_defaults, and give it a bit in buffer_local_flags. (syms_of_buffer): Add DEFVAR_PER_BUFFER for cache_long_line_scans. * insdel.c (prepare_to_modify_buffer): Invalidate width run and newline caches, if they exist. * search.c: #include "region-cache.h". (max, min): Make these functions, not macros; we'd like to pass them arguments that would be bad to evaluate more than once. (newline_cache_on_off): New function. (scan_buffer): New argument END. Call newline_cache_on_off. If this buffer's newline cache is enabled, consult it to see if we need to scan a region for newlines, and store information in the cache after doing so. (find_next_newline): Pass new arg to scan_buffer. (find_before_next_newline): New function. * cmds.c (Fforward_line): Call scan_buffer with new args. (Fend_of_line): Replace call to Fforward_line and search loop with call to find_before_next_newline. * syntax.c (find_defun_start): Call scan_buffer with new args. * indent.c: #include "region-cache.h". (character_width, disptab_matches_widthtab, recompute_width_table, width_run_cache_on_off): New functions. (compute_motion): Call width_run_cache_on_off. If this buffer's width run cache is enabled, consult it to see if we need to traverse a region character-by-character; store information in the cache after doing so. Call find_before_next_newline instead of writing out an equivalent loop explicitly, to take advantage of the newline cache. Doc fixes. * xdisp.c (redisplay_window): Invalidate width_run_cache, if the buffer's display table doesn't match the width table the cache was built for. (display_text_line): Use compute_motion to skip forward to the left edge of the window when the window is hscrolled; this is faster than rendering all the characters into the bit bucket when the hscroll is large. Doc fixes. (display_count_lines): Call scan_buffer with new args. * disptab.h (window_display_table): Doc fix. (buffer_display_table): New declaration. * indent.h (disptab_matches_widthtab, recompute_width_table): New declarations. Sat Oct 8 00:28:16 1994 Richard Stallman * keyboard.c (inhibit_local_menu_bar_menus): New variable. (read_char_x_menu_prompt): Optionally don't use local maps. (syms_of_keyboard): Set up Lisp variable. Fri Oct 7 17:42:10 1994 Karl Heuer * lisp.h (enum Lisp_Misc_Type): New type. (struct Lisp_Marker): Add a member of that type. Delete unused member `modified'. Fri Oct 7 09:51:47 1994 Morten Welinder * minibuf.c (test_completion): New function, extracted from do_completion. (do_completion): Use test_completion. (Fminibuffer_complete_and_exit): If completion is already exact, don't try to complete it. * dired.c (file_name_completion): Ignore files "." and ".." in first pass. (Ffile_name_completion): Perform the completion even if the name part is empty. Fri Oct 7 04:35:31 1994 Richard Stallman * insdel.c (make_gap): Keep input blocked till after we set BEG_ADDR. * fileio.c (check_writable, check_executable): Test HAVE_EACCESS. * config.h.in (HAVE_EACCESS): Add #undef. Thu Oct 6 17:21:29 1994 Karl Heuer * alloc.c (mark_object): Don't check for Lisp_Void; nothing ever creates that type. * bytecode.c (Fbyte_code): Likewise. * data.c (Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value): Likewise. * lisp.h (Lisp_Void, VOIDP): Deleted. * floatfns.c (Fabs): Don't use XFASTINT when negative. * data.c (Flsh, Fadd1, Fsub1, Flognot): Likewise. * buffer.c (init_buffer_once): Don't use XSETFASTINT when negative. (reset_buffer_local_variables, Fbuffer_local_variables): Access buffer_local_flags as Lisp_Object, not int. * data.c (Fset, default_value, Fset_default, Fkill_local_variable): Likewise. * lread.c (defvar_per_buffer): Likewise. Give XSETBUFFER_OBJFWD an integer offset, not a pointer. * lread.c (read1): New argument for returning out-of-band data, obviating the need for Lisp_Internal datatype. (read0, read1, read_list): Use that new calling sequence. * lisp.h (Lisp_Internal, XSETINTERNAL, INTERNALP): Deleted. * lread.c (Fload, load_unwind): Store stream pointer as a cons of two integers, obviating the need for Lisp_Internal_Stream datatype. * lisp.h (Lisp_Internal_Stream, XSETINTERNAL_STREAM, INTERNAL_STREAMP): Deleted. * alloc.c (mark_object): Delete case Lisp_Internal_Stream. Wed Oct 5 01:49:26 1994 Richard Stallman * unexec.c (make_hdr): Undo June 16 change. * fileio.c (Ffile_regular_p): New function. (syms_of_fileio): defsubr it. * xterm.c (x_term_init): Call XtSetLanguageProc or XSetLocaleModifiers. Tue Oct 4 18:55:23 1994 Richard Stallman * xfns.c (x_set_icon_type): Remove period from error message. * xterm.c (x_make_frame_visible, x_iconify_frame): Call x_bitmap_icon if frame wants a bitmap icon. * xfns.c (x_icon_type): New function. * callint.c (Finteractive): Doc fix. Tue Oct 4 06:06:48 1994 Karl Heuer * buffer.c (validate_region): Swap using temp Lisp_Object, not int. * lisp.h (XSETINT): Set object type as well as value. (XSETCONS, XSETBUFFER, XSETVECTOR, XSETSUBR, XSETSTRING, XSETSYMBOL, XSETMARKER, XSETOBJFWD, XSETWINDOW, XSETPROCESS, XSETFLOAT): Likewise. (XSETBOOLFWD, XSETBUFFER_OBJFWD, XSETWINDOW_CONFIGURATION, XSETINTERNAL_STREAM, XSETINTFWD, XSETINTERNAL): New macros. (XSETUINT, XSETPNTR, XFUNCTION, XSETFUNCTION, XSETINTPTR): Deleted. * frame.h (XSETFRAME): Set object type as well as value. * m/alpha.h, m/gec63.h, m/hp800.h, m/iris4d.h, m/iris5d.h, m/mips.h: Don't override the (new) definition of XSETINT from lisp.h. Delete XSETUINT and XSETPNTR, which are no longer used. * *.c: Use new accessor macros instead of calling XSET directly. * xterm.h (SCROLL_BAR_UNPACK): Likewise. * fns.c (Fstring_equal): No longer necessary to set type separately. (Fstring_lessp): Likewise. * callint.c (Fprefix_numeric_value): Likewise. * fileio.c (Finsert_file_contents): Likewise. * lisp.h (XSETFASTINT): New macro. (XFASTINT): Changed to non-lvalue syntax, to ensure that callers will use XSETFASTINT instead. (CHECK_NUMBER_COERCE_MARKER): Don't use XFASTINT as an lvalue. (CHECK_NUMBER_OR_FLOAT_COERCE_MARKER): Likewise. * *.c: Likewise. * frame.h (FOR_EACH_FRAME): Likewise. Tue Oct 4 00:47:57 1994 Richard Stallman * Makefile.in.in (MKTIME_OBJ): New variable. (obj): Use MKTIME_OBJ. * config.h.in (HAVE_MKTIME): Add #undef. * xmenu.c (widget_id_tick): Move definition into conditional. (syms_of_xmenu): Conditionalize initialization of widget_id_tick. * xmenu.c (last_menu_bar_item_end): Var deleted. (this_menu_bar_item_beg, this_menu_bar_item_end): Vars deleted. (other_menu_bar_item_p, unread_menu_bar_button) (check_mouse_other_menu_bar): Functions deleted. (last_event_timestamp, Vdouble_click_time, Vmouse_depressed): Decls deleted. (xmenu_show): XMENU_FOO conditional and its contents deleted. * xterm.c (input_signal_count): New variable. (XTread_socket): Increment it. (x_make_frame_visible): Exit final loop when XTread_sockets has run. Sun Oct 2 17:28:26 1994 Karl Heuer * window.c (Frecenter): Don't trigger point-motion hooks. * fileio.c (Finsert_file_contents): set type of `end', not just the value. * xfns.c (x_figure_window_size): Use new formula for scroll bar width. * config.h.in (HAVE_UTIME_H): Add #undef. * systime.h: Don't include here. * sysdep.c: Include it here instead. (set_file_times): Move struct declaration to top of file. Sun Oct 2 17:24:08 1994 Paul Reilly * xmenu.c (popup_get_selection): Remove BLOCK_INPUT, UNBLOCK_INPUT since the calls to popup_get_selection provide the protection. Sun Oct 2 08:27:06 1994 Paul Reilly * xfns.c: (HACK_EDITRES): Declare if using X11R5. (widget_id_tick): New variable. (x_any_window_to_frame): Use lw_window_is_in_menubar for widget set independence. (x_window): Renamed screen_widget to frame_widget. Use lw_create_widget and lw_set_main_areas for widget set independence. Enable using editres for X11R5. * widget.c (EmacsFrameSetCharSize): Use lw_refigure_widget for widget set independence. * widget.h: Declare resources showGrip, allowResize, and resizeToPreferred. * keyboard.c (make_lispy_event): Do not set item. Now handled in xmenu.c by popup_get_selection. Sat Oct 1 00:42:02 1994 Richard Stallman * frame.c (keys_of_frame): Make binding for delete-frame. * xdisp.c (redisplay_window): If we set PT, and that alters a region being highlighted, call try_window again. * Makefile.in.in (LIBXTR6): If NEED_LIBW, add -lw. * s/usg5-4-2.h (NEED_LIBW): Defined. * Makefile.in.in (LDFLAGS): New variable. (LIBX): Use LDFLAGS. Fri Sep 30 16:31:45 1994 Richard Stallman * data.c (Fmake_local_variable): Doc fix. Thu Sep 29 18:59:13 1994 Richard Stallman * fileio.c (check_writable, check_executable) [__HURD__]: Use eaccess. * xfaces.c (compute_char_face): Handle list as overlay face property. Thu Sep 29 15:21:56 1994 Karl Heuer * minibuf.c (scmp): Use unsigned chars, to avoid confusing DOWNCASE. * unexaix.c (CHECK_SCNHDR, write_segment): Fix format/arg mismatch. * xfns.c (x_report_frame_params): Likewise. Thu Sep 29 09:57:38 1994 Boris Goldowsky * xfaces.c (compute_char_face): If face text-property is a list, merge the attributes of the faces in the list. Thu Sep 29 00:39:15 1994 Richard Stallman * buffer.c (Foverlay_get): Handle `category' property on overlay. * xfaces.c (Fset_face_attribute_internal): Mark frame garbaged whenever any face's font or color is changed. * keyboard.c (head_table): Set up Qdelete_frame. (kbd_buffer_get_event): Handle delete_window_event by making a delete-frame event. Wed Sep 28 18:54:46 1994 Richard Stallman * data.c (Flocal_variable_p): New function. (syms_of_data): defsubr it. Wed Sep 28 16:41:39 1994 Karl Heuer * fileio.c (Fdelete_file): Undo Sep 16 change. * dired.c (syms_of_dired): Likewise. Tue Sep 27 00:01:45 1994 Karl Heuer * frame.h (scroll_bar_pixel_width, scroll_bar_cols): Update comment. * xfns.c (x_set_scroll_bar_width): Nil now means 2 columns' worth. (Fx_create_frame): Default scroll bar width is now nil. * xterm.c (x_new_font): New rule for computing column width. Factored out common code. (XTset_vertical_scroll_bar): Use new width formula. [!USE_X_TOOLKIT] (x_set_window_size): Likewise. * widget.c (set_frame_size, EmacsFrameSetCharSize): Likewise. * lisp.h (BOOLFWDP, INTERNALP, INTFWDP, OBJFWDP, INTERNAL_STREAMP, BUFFER_LOCAL_VALUEP, SOME_BUFFER_LOCAL_VALUEP, BUFFER_OBJFWDP, VOIDP): New type test macros. * *.h, *.c: Use type test macros instead of checking XTYPE directly. Mon Sep 26 21:36:54 1994 Richard Stallman * window.c (syms_of_window): Doc fix. Mon Sep 26 18:56:01 1994 Fred Pierresteguy * m/dpx2.h (POSIX_SIGNALS): Define it. (sigsetmask): Add #undef. Mon Sep 26 14:12:21 1994 Karl Heuer * m/*.h, s/*.h (WORDS_BIG_ENDIAN): Renamed from BIG_ENDIAN, and restored where mistakenly deleted by earlier change. * emacs.c (argmatch): New function. (main): Recognize --longopt synonyms for all options handled here. Add --help and --version. Sun Sep 25 14:00:18 1994 Richard Stallman * unexsunos4.c: Delete __FreeBSD__ conditional macro definitions. (unexec): Major changes in UNDO_RELOCATION code. * unexsunos4.c (is_it): Rename argument and local variable. Sun Sep 25 02:40:01 1994 Richard Stallman * Makefile.in.in (${etc}DOC): Run make-docfile twice--two batches. Sat Sep 24 19:34:26 1994 Richard Stallman * sysdep.c (set_file_times): Don't test HAVE_UTIME. Assume utime exists if utimes does not. * config.h.in (HAVE_UTIMES): Add #undef. * editfns.c (Fformat_time_string): Mostly rewritten, to handle unlimited size, and report errors properly. * Makefile.in.in (strftime.o, mktime.o): New target. (obj): Add strftime.o and mktime.o. * strftime.c, mktime.c: New files (shared from libc). Sat Sep 24 03:54:02 1994 Erik Naggum (erik@naggum.no) * editfns.c (Fformat_time_string): New function. (syms_of_editfns): Defsubr it. Sat Sep 24 01:09:16 1994 Richard Stallman * sysdep.c [USE_DL_STUBS] (dlopen, dlsym, dlclose): New functions. * s/sunos4-1.h (USE_DL_STUBS): Defined. * s/sunos4shr.h (USE_DL_STUBS): Add #undef. * fileio.c (Ffile_writable_p): Use stat to test for existence. (check_executable, check_writable): New functions. (Ffile_executable_p, Ffile_writable_p): Use the new functions. * intervals.c (set_point): If Vinhibit_point_motion_hooks, ignore intangible properties. If move backwards into intangible text, move back over it. * textprop.c (syms_of_textprop): Doc fix. * config.h.in (STACK_DIRECTION): Don't redefine if defined already. Move definition down past #include's. Fri Sep 23 20:15:02 1994 Richard Stallman * s/linux.h: Don't include signal.h, values.h. (signal): Definition deleted. * abbrev.c (Fexpand_abbrev): Instead of Fcapitalize_region, just upcase the first initial. * casefiddle.c (Fupcase_initials_region): New function. (Fupcase_initials): New function. (syms_of_casefiddle): defsubr them. * minibuf.c (read_minibuf_unwind): Preserve Vdeactivate_mark. * s/isc2-2.h (DONT_DEFINE_SIGNAL): Macro deleted. * m/next.h (DK_HEADER_FILE): Macro deleted. * m/tahoe.h (DKSTAT_HEADER_FILE): Macro deleted. * m/hp800.h (CPTIME_SYMBOL, DKXFER_SYMBOL): Macros deleted. * sysdep.c (start_of_text): Don't test CANNOT_UNEXEC. * unexec.c: Don't test CANNOT_UNEXEC. * unexaix.c: Don't test CANNOT_DUMP or CANNOT_UNEXEC. * sysdep.c: Delete BROKEN_FASYNC conditional. * data.c (Fset_default, Fset): Delete RTPC_REGISTER_BUG conditionals. * process.c (Fprocess_send_eof): Delete DID_REMOTE conditional. * buffer.c (get-file-buffer): Doc fix. Fri Sep 23 00:54:08 1994 Richard Stallman * frame.c (prev_frame): Fix typo. * unexec.c (copy_text_and_data): Delete some printf's. * m/acorn.h (PURESIZE): Definition deleted. * xfns.c (x_figure_window_size): Decode (- N), (+ N) for position. (x_set_frame_parameters): Handle (+ N) and (- N). Preserve negative positions properly too. [USE_X_TOOLKIT] (x_window): Let xneg, yneg specify whether to negate left and top. (Fx_parse_geometry): Handle [XY]Negative with positive number or negative number without [XY]Negative. * callint.c (Qplus): New variable. (syms_of_callint): Set it up. * lisp.h (Qplus): Declared. * xfns.c (Fx_create_frame): Rename menuBarLines resource to menuBar. * s/sunos4-1-3.h, s/sunos4shr.h (X_IO_BUG): Definition deleted. * textprop.c (Fset_text_properties): Don't let validate_interval_range increment START and END twice. * xterm.h (FRAME_X_DISPLAY): New macro. * s/freebsd.h (BSD): Have two definitions according to version number. Thu Sep 22 16:50:11 1994 Richard Stallman * xterm.c (x_destroy_window): Decrement ref count of x_screen struct. * xfns.c (the_x_screen): New variable. (syms_of_xfns): Staticpro parts of it. (Fx_open_connection): Initialize it. (Fx_create_frame): Make frame point to it. (Fx_list_fonts): Use a cache stored in FRAME_X_SCREEN. * xterm.h (struct x_screen): New structure. (struct x_display): New field x_screen. (FRAME_X_SCREEN): New macro. * process.c (exec_sentinel_error_handler): Call update_echo_area. (read_process_output_error_handler): Likewise. * xdisp.c (update_echo_area): New function. Thu Sep 22 15:20:12 1994 Karl Heuer * buffer.c (evaporate_overlays): Overlay is in car, not cdr. Wed Sep 21 21:46:06 1994 Tom Tromey * doc.c (get_doc_string): Look in ../etc while dumping. (munge_doc_file_name): New subroutine. Thu Sep 22 02:25:07 1994 Richard Stallman * minibuf.c (Fcompleting_read): Doc fix. * puresize.h (BASE_PURESIZE): Increment both values. * window.c (Fdelete_other_windows): Nice error if WINDOW is minibuf. * lisp.h (Vdebug_on_error): Declared. * process.c (exec_sentinel_error_handler): New function. (exec_sentinel): Catch all errors in the sentinel. * keyboard.c (read_char): Don't return right away when read_char_minibuf_menu_prompt returns non-nil. Instead, set key_already_recorded, which inhibits most but not all of the work at non_reread. Wed Sep 21 17:22:44 1994 Simon Leinen * cm.h (cmputc): Return int rather than void. * cm.c (evalcost, cmputc): They now return their arguments. Wed Sep 21 10:09:42 1994 Per Abrahamsen * window.c (display-buffer, special-display-buffer-names) (special-display-regexps, special-display-function): Accept cons cells in `special-display-buffer-names' and `special-display-regexps'. If the buffer name matches the car, call `special-display-function' with the cdr as a second argument. Wed Sep 21 14:52:44 1994 Richard Stallman * s/bsd386.h (HAVE_TERMIOS, NO_TERMIO): Defined. * editfns.c (Fmessage_or_box): Use Fmessage_box with new name. * process.c (read_process_output_error_handler): New function. (read_process_output_call): New function. (read_process_output): Catch and report errors in filters. * keyboard.c (cmd_error_internal): New function, broken out of cmd_error. * fileio.c (Fread_file_name): If DEFAULT is nil and INITIAL is not, use INITIAL to set DEFAULT. * editfns.c (Fmessage_box): Renamed from Fbox_message. Fri Sep 17 08:40:48 1994 Michael Ben-Gershon (mybg@cs.huji.ac.il) * unexec.c (copy_text_and_data): Add RISCiX changes. * m/acorn.h, s/riscix1-1.h, s/riscix1-2.h: New files added. Wed Sep 21 15:39:33 1994 Bill Burton (billb@progress.com) * s/ptx.h: New file for Sequent DYNIX/ptx 1.x/2.x * m/sequent-ptx.h: New file for Sequent DYNIX/ptx 1.x/2.x Wed Sep 21 11:10:40 1994 Frederic Pierresteguy * editfns.c (Fbox_message): New function to print a message in a dialog box. (Fmessage_or_box): New function that choose whether to print a message in a dialog or in the echo area. Wed Sep 21 01:13:51 1994 Richard Stallman * search.c (Freplace_match): New 4th arg OBJECT can specify string to replace in. * casefiddle.c (upcase_initials): New function. (casify_object): Handle CASE_CAPITALIZE_UP. * fns.c (concat3): New function. * xfns.c (Fx_get_resource): Doc fix. * buffer.c (overlays_at): New arg PREV_PTR. Return previous overlay end. (Foverlays_at): Pass NULL for last 2 args of overlays_at. (Fnext_overlay_change): Pass new arg to overlays_at. (Fprevious_overlay_change): New function. * xterm.c (note_mouse_highlight): Pass new arg to overlays_at. * xfaces.c (compute_char_face): Pass new arg to overlays_at. * textprop.c (Fget_char_property): Pass new arg to overlays_at. (NULL): Define if not defined. * minibuf.c (get_minibuffer): Make BUF current to kill its local vars. Tue Sep 20 01:49:37 1994 Karl Heuer * ralloc.c (r_alloc_freeze_level): New variable. (r_alloc_freeze, r_alloc_thaw): New functions. (r_alloc_sbrk): Refuse to move blocs, if frozen. * unexaix.c (report_error): Include reason in error message. Tue Sep 20 01:05:50 1994 Richard Stallman * eval.c (init_eval_once): Init Vrun_hooks here. (syms_of_eval): Not here. Tue Sep 20 00:06:50 1994 Karl Heuer * search.c (trivial_regexp_p): New function. (search_buffer): Don't depend on internal format of re_pattern_buffer. * frame.h (FRAME_SCROLL_BAR_PIXEL_WIDTH): New macro, supersedes VERTICAL_SCROLL_BAR_PIXEL_WIDTH; no longer device-dependent. All callers changed. (FRAME_SCROLL_BAR_COLS): New macro, supersedes VERTICAL_SCROLL_BAR_WIDTH; no longer constant. All callers changed. (scroll_bar_pixel_width, scroll_bar_cols): New members of struct frame. * xterm.h (VERTICAL_SCROLL_BAR_PIXEL_WIDTH): Deleted. * xfns.c (x_set_scroll_bar_width): New function. (x_frame_parms): Add that function to this table. (Qscroll_bar_width): New symbol. (syms_of_xfns): Initialize and staticpro it. (Fx_create_frame): Set default scroll bar width. * xterm.c (x_new_font): Compute number of scrollbar columns. * keyboard.c (kbd_store_ptr): Declare storage class before qualifier. (make_lispy_event): Fix Lisp_Object vs. int problems. (read_avail_input, menu_bar_items_index, read_key_sequence): Likewise. * window.c (Fset_window_buffer): Likewise. * alloc.c (make_float, make_pure_float): Likewise. * sysdep.c (set_file_times): Move this out of the USG conditional. Mon Sep 19 22:29:09 1994 Richard Stallman * s/sco4.h (POSIX_SIGNALS): Defined. Mon Sep 19 13:46:04 1994 Karl Heuer * buffer.c (syms_of_buffer): Doc fix. * keymap.c (Fkey_description): Reverse condition. Mon Sep 19 13:23:44 1994 Jim Blandy Add a new element to display tables controlling side-by-side window borders. * buffer.c (syms_of_buffer): Update doc string for `buffer-display-table'. * disptab.h (DISP_TABLE_SIZE): Bump to 262. (DISP_BORDER_GLYPH): New accessor macro. * xdisp.c (display_text_line): Consult the display table when building side-by-side window borders. Mon Sep 19 01:05:21 1994 Richard Stallman * s/netbsd.h (SYSTEM_TYPE): Delete definition. * lisp.h (RETURN_UNGCPRO): Use if (1) .. else, not do ... while (0). Sun Sep 18 19:56:33 1994 Karl Heuer * lisp.h (Fmember): Declare this function. * intervals.c: #include "keyboard.h" * term.c: Declare Fmake_sparse_keymap. * minibuf.c (read_minibuf): Fix Lisp_Object vs. int problems. * frame.h [!MULTI_FRAME] (FOR_EACH_FRAME): Likewise. * fns.c (Frandom): Likewise. * eval.c (Fsignal): Likewise. * frame.c (Fframe_parameters): Likewise. * indent.c (vmotion, Fvertical_motion): Likewise. * lread.c (openp): Likewise. * dispnew.c (direct_output_for_insert, direct_output_forward_char): Likewise. * textprop.c (validate_interval_range, property_value, Fget_char_property, Fnext_property_change, Fnext_single_property_change, Fprevious_property_change, Fprevious_single_property_change): Likewise. Sun Sep 18 16:00:13 1994 Richard Stallman * process.c (pty_name): Move it up; make it static. (create_process): Set the tty_name field. (Fprocess_tty_name): New function. (syms_of_process): defsubr it. * process.h (struct process): New field tty_name. * s/sol2.h (HAVE_VFORK): Defined. (C_SWITCH_SYSTEM): Deleted. (const): Definition deleted. * fileio.c (Ffile_writable_p): Don't use ro_fsys. (ro_fsys): Deleted. Sun Sep 18 14:57:23 1994 Karl Heuer * config.h.in (_ALL_SOURCE): Don't redefine if already defined. * xdisp.c [!HAVE_X_WINDOWS] (store_frame_title): Dummy macro. * sysdep.c (set_file_times): New function, replaces EMACS_SET_UTIMES. * fileio.c (Fcopy_file): Use it, and check for the error return. * systime.h: Declare it. [HAVE_UTIME_H]: #include . * config.h.in (_ALL_SOURCE, HAVE_STRUCT_UTIMBUF, HAVE_SELECT, HAVE_TIMEVAL): Add #undefs. * s/*.h, m/*.h: Delete obsolete symbols USE_UTIME, MISSING_UTIMES, IRIS_UTIME, USG_SYS_TIME, HAVE_SELECT, HAVE_TIMEVAL, BIG_ENDIAN. Sun Sep 18 00:00:16 1994 Richard Stallman * dispnew.c (preserve_other_columns): Fix arg to sizeof in bcopy call. * minibuf.c (get_minibuffer): Call Fkill_all_local_variables. * buffer.c (reset_buffer): Don't call reset_buffer_local_variables. (Fget_buffer_create): Call it here. (init_buffer_once): And here. * window.c (struct saved_window_data): New slots min_width, min_height. (Fcurrent_window_configuration): Set slots from window_min_... (Fset_window_configuration): Restore them. Set window_min_height and window_min_width to 1 while restoring windows. * unexsunos4.c (SUNOS4 or __FreeBSD__): Define UNDO_RELOCATION. (unexec): Test UNDO_RELOCATION. Distinguish the relocation formats of __FreeBSD__ and SUNOS4. * s/sol2.h (REL_ALLOC): #undef deleted. * keymap.c (Fkey_description): Give error if KEYS not an array. (get_keyelt, access_keymap, get_keymap_1): Use type test macros. Sat Sep 17 01:21:19 1994 Richard Stallman * unexsunos4.c (unexec): Fix logic for rounding section boundaries. * config.h.in (EMACS_CONFIG_OPTIONS): Add #undef. * textprop.c (property_value): Declare args plist, prop. * s/osf1.h (malloc, realloc): Declared. * print.c (print): sprintf arg for frame depends on VALBITS. * callproc.c (Fcall_process) [__osf__ && __alpha]: Don't stop reading if read returns negative. * puresize.h (PURESIZE_RATIO, BASE_PURESIZE): Defined. (PURESIZE): Define it based on those. * m/alpha.h (PURESIZE): Definitions deleted. Fri Sep 16 23:09:34 1994 Karl Heuer * buffer.h: Declare some functions. * intervals.h: Declare some functions. * lisp.h: Declare some functions. * xterm.c, xfaces.c: Add #include "intervals.h" * fileio.c (barf_or_query_if_file_exists): Fix declaration. * xmenu.c (menu_item_enabled_p): Fix declaration. Fri Sep 16 22:15:28 1994 Richard Stallman * xfns.c (hack_wm_protocols): Arrange to handle WM_SAVE_YOURSELF. * s/hpux9.h (HAVE_TERMIO, HAVE_TERMIOS, NO_TERMIO): Undo Jul 28 change. Fri Sep 16 21:49:50 1994 Karl Heuer * emacs.c (Vsystem_configuration_options): New variable. (syms_of_emacs): Initialize it. * buffer.h: Declare evaporate_overlays. * buffer.c: Declare new symbol Qevaporate. (syms_of_buffer): Initialize it. (Fmove_overlay): Check if overlay is empty. (Foverlay_put): Check if setting evaporate property on empty overlay. (evaporate_overlays): New function. * insdel.c (del_range_1): Call evaporate_overlays after deleting text. Fri Sep 16 20:13:01 1994 Richard Stallman * m/intel386.h (HAVE_VFORK): Defined. [__GNUC__] (C_SWITCH_SYSTEM): Add #undef. * emacs.c (shut_down_emacs): Don't call Fx_close_current_connection. * lisp.h (EMACS_INT, EMACS_UINT): Define, if not already defined. * alpha.h (EMACS_INT, EMACS_UINT): Defined. Fri Sep 16 19:56:09 1994 Rainer Schoepf * s/osf1.h [__alpha] (LD_SWITCH_SYSTEM): Alternate definition. * unexalpha.c, m/alpha.h: New files. * alloc.c (pure, pure_size): Use EMACS_INT. (free_float, free_cons, PAD, STRING_FULLSIZE, struct string_block) (make_pure_string, make_pure_vector, Fgarbage_collect, mark_object) (gc_sweep, compact_strings, Fmemory_limit): Use EMACS_INT. * buffer.c (reset_buffer_local_variables, Fbuffer_local_variables) (init_buffer_once): Use EMACS_INT. * callint.c (Fcall_interactively): Use EMACS_INT. * data.c (sign_extend_lisp_int): Use EMACS_INT. * dispextern.h (struct face): Use EMACS_UINT. * doc.c (Fdocumentation): Use EMACS_INT. * editfns.c (Fnarrow_to_region, format1): Use EMACS_INT. * floatfns.c (FLOAT_TO_INT, FLOAT_TO_INT2): Use EMACS_INT. * frame.h (struct frame, selected_frame, last_nonminibuf_frame): Use EMACS_INT. * lisp.h (Lisp_Object): Use EMACS_INT. (MARKBIT): Don't define if already defined. (VALMASK, GCTYPEMASK, XSETTYPE, XSET) (XSETCONS, XSETBUFFER, XSETVECTOR, XSETSUBR, XSETSTRING) (XSETSYMBOL, XSETFUNCTION, XSETMARKER, XSETOBJFWD) (XSETINTPTR, XSETWINDOW, XSETPROCESS, XSETFLOAT) (struct Lisp_String, struct Lisp_Vector): Use EMACS_INT. * lread.c (Fload): Use EMACS_INT. * marker.c (unchain_marker): Use EMACS_INT. * mem-limits.h: Check for __alpha, in __osf__ conditional. (EXCEEDS_LISP_PTR): Use EMACS_UINT. * print.c (print): Use EMACS_UINT. * puresize.h (CHECK_IMPURE, all versions): Use EMACS_INT. * window.h (struct window): Use EMACS_INT. * xdisp.c (message): Use EMACS_INT. * xterm.h (struct scroll_bar, SCROLL_BAR_VEC_SIZE): Use EMACS_INT. Fri Sep 16 19:39:30 1994 Morten Welinder * fileio.c (Finsert_file_contents) [MSDOS]: Don't re-gc-protect filename; delete unused variables. Fri Sep 16 19:35:04 1994 Karl Heuer * term.c (clear_to_end): Fix reversed condition. Fri Sep 16 18:16:48 1994 K. Berry * dired.c (Qcompletion_ignored_extensions): New symbol. (syms_of_dired): Initialize it. * fileio.c (Fdelete_file): Bind completion-ignored-extensions to nil. Fri Sep 16 17:56:25 1994 Morten Welinder (terra@diku.dk) * s/msdos.h (MODE_LINE_BINARY_TEXT): Define this symbol. * xdisp.c (decode_mode_spec): Use it when defined. Fri Sep 16 17:29:48 1994 Andreas Schwab * minibuf.c (read_minibuf): Don't add to the history list if the minibuffer string is empty, since it is not very useful. Fri Sep 16 16:07:35 1994 Richard Stallman * m/hp9000s300.h [not BSD4_3] [__GNUC__] (HAVE_ALLOCA): Defined. Fri Sep 16 07:15:51 1994 Karl Heuer * xdisp.c [!HAVE_X_WINDOWS] (frame_title_ptr): define as always null. Fri Sep 16 03:42:39 1994 Richard Stallman * xterm.c: Delete X11 conditionals. (XTupdate_end, XTupdate_begin, XTclear_end_of_line) (XTclear_frame, XRINGBELL, stufflines, scraplines, dumprectangle) (XTread_socket, x_draw_box, clear_cursor, refreshicon, x_iconify_frame) (x_bitmap_icon, x_text_icon, x_new_font, x_term_init) (x_calc_absolute_position, x_set_window_size) (x_make_frame_visible, x_make_frame_invisible): Delete X10 code. (dumpqueue, x_do_pending_expose, dumpborder, XEvent, x_read_exposes) (enqueue_event, dequeue_event, queue_event_count) (mouse_event_pending_p, x_set_resize_hint): Delete X10 versions. * xfns.c: Delete X11 conditionals. (defined_color, x_decode_color, x_set_foreground_color) (x_set_background_color, x_set_mouse_color, x_set_cursor_color) (x_set_border_color, x_set_border_pixel, Fx_create_frame) (Fx_open_connection, Fx_close_current_connection, syms_of_xfns): Delete X10 code. (Fx_get_default, Fx_get_resource, Fx_rubber_band) (Fx_store_cut_buffer, Fx_get_cut_buffer): Delete X10 definitions. * xfns.c (Fx_display_grayscale_p): New function. (syms_of_xfns): defsubr it. * s/bsd386.h (__bsdi__): Define, unless already defined. (DECLARE_GETPWUID_WITH_UID_T): Define. * filelock.c (getpwuid): Test just DECLARE_GETPWUID_WITH_UID_T, not __bsdi__. * xrdb.c (getpwuid, getpwnam): Test just DECLARE_GETPWUID_WITH_UID_T, not __bsdi__. Thu Sep 15 20:40:47 1994 Karl Heuer * editfns.c (syms_of_editfns): Make Vsystem_name and Vuser...name lisp variables again. * xdisp.c (multiple_frames, Vframe_title_format, Vicon_title_format): New variables. (store_frame_title): New function. (x_consider_frame_title): Format title according to template. (display_mode_element): Handle frame title as well as mode line. (decode_mode_spec): Use w->buffer, not current_buffer. Thu Sep 15 01:50:12 1994 Richard Stallman * s/freebsd.h (DECLARE_GETPWUID_WITH_UID_T): Defined. [NO_SHARED_LIBS and __FreeBSD__]: (LD_SWITCH_SYSTEM, A_TEXT_OFFSET, A_TEXT_SEEK): Alternate definitions. * textprop.c (syms_of_textprop): Delete Lisp var interval-balance-threshold. * intervals.c, intervals.h (interval_balance_threshold): Var deleted. * xfns.c (Fx_create_frame): Make 1 the default for menu-bar-lines. * keyboard.c (gobble_input): Use sigblockx only if it is defined. * unexsunos4.c [SUNOS4]: Include link.h. (unexec) [SUNOS4]: Cancel relocations that ld.so did. * s/sunos4-0.h (SUNOS4): Defined. Wed Sep 14 04:24:09 1994 Richard Stallman * Makefile.in.in (xmenu.o): Depend on puresize.h. (cmds.o): Depend on window.h. * cmds.c: Include window.h. (Fnewline): Inhibit the insert-at-end-of-line hack when at the top of the window. * minibuf.c (Fcompleting_read): Doc fix. * xmenu.c: Include puresize.h. (menu_item_equiv_key): Use CHECK_IMPURE. * syntax.c (Fforward_comment): Do increment from, when reaching single-char comment end going forward. * callproc.c (delete_temp_file): Use Fdelete_file. * fileio.c (Fset_default_file_modes): Doc fix. * Makefile.in.in (OLDXMENU variable): Refer to the library in the dir where it is compiled. (OLDXMENU rule): Delete the commands; keep just a dep. Sun Sep 11 14:56:01 1994 Richard Stallman * Version 19.27 released. Sat Sep 10 01:10:04 1994 Richard Stallman * keymap.c (syms_of_keymap): Doc fix. * keyboard.c (gobble_input): Block SIGALRM if we are using it. * gmalloc.c: Bug fix affecting __ptrdiff_t in non-ANSI case. Wed Sep 7 03:54:08 1994 Richard Stallman * Version 19.26 released. Thu Sep 8 15:13:32 1994 Richard Stallman * keyboard.c (record_asynch_buffer_change): Don't test Fwaiting_for_user_input_p if no subprocesses. Mon Sep 5 21:33:48 1994 Richard Stallman * s/sol2.h [USE_X_TOOLKIT && HAVE_X11XTR6] (REL_ALLOC): Undefine it. Sun Sep 4 23:20:51 1994 Richard Stallman * emacs.c (init_cmdargs): After chasing link, use only the expanded name. Sun Sep 4 20:12:07 1994 Karl Heuer * fileio.c (Ffile_accessible_directory_p): Put back the gcpro. * sysdep.c (srandom): Pass arg to srand48; no return value. Sun Sep 4 00:35:24 1994 Richard Stallman * emacs.c (init_cmdargs): When setting dir, expand the dir name. * sysdep.c (random, srandom): Check HAVE_LRAND48, not HAVE_RAND48. Call lrand48, nor rand48. * config.h.in (HAVE_LRAND48): Replaces HAVE_RAND48. Sat Sep 3 14:44:42 1994 Kaveh R. Ghazi (ghazi@noc.rutgers.edu) * m/delta88k.h [__GNUC__] (HAVE_ALLOCA): Defined. [__GNUC__] (C_ALLOCA): Add #undef (LIB_X11_LIB): Add #undef. (HAVE_TERMIOS): Defined. (HAVE_TERMIO): Add #undef. (NO_TERMIO): Defined. (sigsetmask): Add #undef. (USE_GETOBAUD): Defined. Sat Sep 3 00:33:58 1994 Richard Stallman * sysdep.c (init_baud_rate): Test that getobaud is actually defined. * sysdep.c (init_baud_rate) [USE_GETOBAUD]: Use getobaud. Fri Sep 2 17:57:36 1994 Richard Stallman * insdel.c (prepare_to_modify_buffer): Don't call verify_overlay_modification if no overlays or verify_interval_modification no intervals. * textprop.c (Fset_text_properties): Return early if buffer has no intervals and PROPS is nil. Fri Sep 2 03:01:48 1994 Lennart Staflin (lenst@rudolf) * xdisp.c (display_text_line): Don't overrun the charstart area. Fri Sep 2 01:31:58 1994 Richard Stallman * insdel.c (insert_1): Don't call interval fns if buffer has none. * textprop.c (Fset_text_properties): Don't create or split an interval if we trivially do not need to change anything. Wed Aug 31 16:39:57 1994 Richard Stallman * xfns.c (defined_color): New arg ALLOC--optionally don't allocate the color. (x_decode_color, Fx_color_defined_p): Pass new arg. (Fx_color_values): New function. Tue Aug 30 04:24:59 1994 Richard Stallman * frame.c (Fdelete_frame): Fix previous change. Tue Aug 30 11:11:59 1994 enami tsugutomo * fileio.c (Fwrite_region): unbind_to should take two args. Tue Aug 30 00:21:51 1994 Richard Stallman * fileio.c (Ffile_accessible_directory_p): No need for gcpro. * keyboard.c (input_polling_used): New function. * xterm.c (x_make_frame_visible): Call input_polling_used. Sun Aug 28 01:53:01 1994 Richard Stallman * frame.c (Fdelete_frame): Free the frame's glyphs arrays. Free the line insert/delete cost vectors. * dispnew.c (free_frame_glyphs): No longer static. * m/next.h (HAVE_MACH_MACH_H): Defined. * editfns.c (Finsert_and_inherit_before_markers): Use insert_before_markers_and_inherit for character args. (Finsert_and_inherit): Use insert_and_inherit for character args. * insdel.c (insert_before_markers_and_inherit): New function. * cmds.c (internal_self_insert): Use insert_and_inherit. Sat Aug 27 18:45:24 1994 Richard Stallman * indent.c (Findent_to): Pass new arg to Finsert_char. * editfns.c (Finsert_char): New arg INHERIT. Use insert_and_inherit if requested. * insdel.c (insert_1): New arg INHERIT. (insert_and_inherit): New function. Fri Aug 26 17:19:52 1994 Richard Stallman * keyboard.c (polling_for_input): Define var unconditionally. * keyboard.h (polling_for_input): Declared. * xterm.c: Include keyboard.h. (x_make_frame_visible): Fix previous change: test polling_for_input instead of whether SIGIO is defined. * Makefile.in.in (xterm.o): Depend on keyboard.h. Fri Aug 26 16:35:06 1994 Kevin Rodgers * xfns.c (Fx_color_defined_p): Return list of RGB values, not just t. Fri Aug 26 01:17:17 1994 Karl Heuer * xterm.c (x_make_frame_visible): Call signal handler directly. Thu Aug 25 18:18:50 1994 Richard Stallman * s/linux.h: Add LINUX_QMAGIC conditional. * m/alliant-2800.h (USE_NONANSI_DEFUN): Defined. * lisp.h (DEFUN): Check USE_NONANSI_DEFUN. * Makefile.in.in (obj): Put cm.o before term.o. (Avoids mysterious lossage on Irix.) * xmenu.c (xmenu_show): Don't queue events that are in the menu bar. Wed Aug 24 15:40:04 1994 Richard Stallman * xmenu.c (xmenu_show): Do nothing special for ButtonPress in the menu. Call XtDispatchEvent for all ButtonRelease events. xlwmenu.c now deals with posting the menu. Check for events in subwidgets of the menu when deciding whether to queue them for later handling. * unexelfsgi.c (unexec): Copy previous change in unexelf.c. * s/irix5-0.h [__GNUC__] (LD_SWITCH_SYSTEM): Defined. Wed Aug 24 17:40:38 1994 Simon Leinen * term.c (term_init): Added missing argument to tgetstr. (tgetstr): Move declarations to top level. Wed Aug 24 02:26:54 1994 Karl Heuer * xterm.c (x_make_frame_visible): Raise a signal to cause the pending X I/O to be read. Wed Aug 24 01:16:45 1994 Richard Stallman * xdisp.c (display_scan_buffer): New function. (display_count_lines): Use that. * intervals.c (textget): Ignore category prop if not a symbol. Tue Aug 23 22:04:05 1994 Roland McGrath * s/gnu.h: New file. Tue Aug 23 18:56:19 1994 Karl Heuer * indent.c (pos_tab_offset): Don't trigger point-motion hooks. * buffer.c (Frename_buffer): Fix gcpro problems. * fileio.c (Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents, auto_save_error, Fwrite_region): Likewise. (Fcopy_file, build_annotations, Fdo_auto_save): Delete unused variables. Tue Aug 23 03:04:51 1994 Richard Stallman * fileio.c (O_RDONLY): Defined. (Finsert_file_contents, Fcopy_file): use it. (barf_or_query_if_file_exists, Ffile_exists_p): Use stat, not access. (Ffile_readable_p): Use open, not access. * lread.c (O_RDONLY): Defined. (openp): Use it. * unexelf.c (unexec): Don't alter the info field of SHT_SYMTAB and SHT_DYNSYM sections. * xdisp.c (redisplay_window): Don't access text before BEGV. * keyboard.c (read_char): After read_char_minibuf_menu_prompt, don't just return; jump to non_reread. * fileio.c (Fmake_directory_internal): Pass just 2 args to handler. Tue Aug 23 00:46:27 1994 Karl Heuer * frame.c (Fmake_frame_invisible, Ficonify_frame): Don't switch frames. Mon Aug 22 19:17:08 1994 Karl Heuer * search.c (Fstring_match): Fix sign error. * m/ibmrs6000.h (LD_SWITCH_MACHINE): Use full path to ibmrs6000.inp. Sun Aug 21 14:03:32 1994 Richard Stallman * m/ibmrs6000.h (LD_SWITCH_MACHINE): Supply m/ibmrs6000.inp as input. * m/ibmrs6000.inp: New file. Fri Aug 19 20:47:38 1994 Hiroshi NAKANO * unexelf.c: Eliminate local var bss_end. Update the symbol values of _edata and _end. Fri Aug 19 01:37:54 1994 Richard Stallman * process.c (wait_reading_process_input): Clear waiting_for_user_input_p before returning. * xterm.c (x_make_frame_visible): Quit if requested, in loop at end. Wed Aug 17 22:07:20 1994 Richard Stallman * keyboard.c (read_char): Don't show buffer-events to the user. Handle chars over 255 in dribble files. Wed Aug 17 17:43:22 1994 Karl Heuer * callproc.c (Fcall_process_region): gcpro filename_string. Wed Aug 17 16:05:56 1994 Richard Stallman * doc.c (store_function_docstring): Do nothing for bytecode object which has no slot for doc string. Tue Aug 16 19:51:36 1994 Richard Stallman * buffer.c (list_buffers_1): Update header line layout. Sat Aug 13 19:11:21 1994 Richard Stallman * s/sol2-4.h (pid_t): New definition. (vfork): Definition deleted. * xmenu.c (xmenu_show): Unconditionally update x_mouse_grabbed and Vmouse_depressed. * window.c (window_loop, case UNSHOW_BUFFER): When we delete a frame, skip all the windows on that frame. Fri Aug 12 19:11:43 1994 Karl Heuer * s/isc4-0.h (NEED_SIOCTL): moved to isc-3.0.h. * s/isc3-0.h (NEED_SIOCTL): moved from isc-4.0.h, and disabled BROKEN_TIOCGWINSZ since it works fine when you use . (C_SWITCH_SYSTEM): Add -D_SYSV3 to ensure availability of traditional non-standard functions. (memmove): Delete this macro; it screws up if you use the native cc. (Emacs already does the right thing anyway.) Fri Aug 12 01:22:45 1994 Richard Stallman * indent.c (compute_motion): Use WIN's frame, not selected one. * xterm.c (x_new_font): Don't set filename = full_name if that's null. Thu Aug 11 15:45:00 1994 Richard Stallman * Makefile.in.in (FRAME_SUPPORT): Add faces.elc. * search.c (Freplace_match): Treat caseless initial like a lowercase initial. * keymap.c (Fdefine_key): Fix error message. (Fsingle_key_description): Likewise. Wed Aug 10 16:28:47 1994 Richard Stallman * s/sol2-3.h (POSIX_SIGNALS): Define it. (PTY_TTY_NAME_SPRINTF): New overriding definition. (sigsetmask): Add #undefs. * s/sol2-4.h (POSIX_SIGNALS, PTY_TTY_NAME_SPRINTF, sigsetmask): Delete those things (moved to sol2-3.h). * s/sol2-4.h (HAVE_VFORK): Deleted. (vfork): Define as emacs_vfork. * window.c (Fwindow_end): Undo previous change. Tue Aug 9 13:39:31 1994 Richard Stallman * keyboard.c (record_asynch_buffer_change): Do nothing except when waiting_for_user_input_p. * m/i860.h [USG5_4] (SVR4): Defined. * xdisp.c (display_text_line): Make previous change #ifdef HAVE_X_WINDOWS. Mon Aug 8 05:03:18 1994 Richard Stallman * puresize.h [MULTI_FRAME] (PURESIZE): Increased. * window.c (Fwindow_end): If window_end_valid is nil, return nil. * window.c (Fpos_visible_in_window_p): Do something reasonable if w->start is outside the buffer bounds. Sun Aug 7 02:40:34 1994 Richard Stallman * s/sol2-4.h (PTY_TTY_NAME_SPRINTF): New definition. (sigsetmask): Add #undef. * keymap.c (Faccessible_keymaps): Fix previous change. Sat Aug 6 20:58:03 1994 Richard Stallman * xdisp.c (display_text_line): Use the face properties of the overlay arrow, if any. * xfaces.c (compute_glyph_face_1): New function. * m/intel386.h (LIBS_MACHINE): If SOLARIS2_4, don't define this. * s/sol2-4.h (SOLARIS2_4): Defined. Fri Aug 5 23:06:16 1994 Richard Stallman * keymap.c (Fuse_global_map, Fuse_local_map): Call record_asynch_buffer_change. * xterm.c (XTread_socket): Don't test X_IO_BUG; make that code unconditional. (x_noop_count, x_term_init): Likewise. Thu Aug 4 17:00:11 1994 Richard Stallman * data.c (Fdefine_function, Fdefalias): Handle advice as in Ffset. (Qad_advice_info): Lisp and C names renamed from Qadvice_info. (Qad_activate): C name renamed from Qactivate_advice. * fileio.c (Fread_file_name_internal): Call double_dollars when `changed' is set. Wed Aug 3 21:53:58 PDT 1994 Caveh Jalali (caveh@eng.sun.com) * m/intel386.h [SOLARIS2] (VALBITS, GCTYPEBITS): New definitions. * s/sol2-4.h: New file. Wed Aug 3 00:38:43 1994 Richard Stallman * buffer.c (list_buffers_1): Add one column to size column. * xterm.c (x_make_frame_visible): Start one_in_four at 1. * window.c (Fwindow_end): Doc fix. * xterm.c (construct_mouse_click, construct_menu_click): Don't update x_mouse_grabbed, Vmouse_depressed, last_mouse_frame here. (XTread_socket): Update them here, so we do it without fail. (XTmouse_position, XTread_socket case MotionNotify): Check last_mouse_frame is nonzero before using it. * Makefile.in.in (alloca.o): Use -f in all rm's. Tue Aug 2 18:08:18 1994 Richard Stallman * keymap.c (Faccessible_keymaps): Use PREFIX to set loop starting point; don't even consider maps except those reached via prefix. * keyboard.c (make_lispy_event): If the position is not in a window, at least pass along the frame it is in. Mon Aug 1 18:28:32 1994 Roland McGrath * data.c (Ffset): Don't call Fget unless SYM's plist is consp. Mon Aug 1 14:58:58 1994 Richard Stallman * eval.c (Fprog2): Doc fix. * window.c (Fmove_to_window_line): Doc fix. Mon Aug 1 11:10:40 1994 Frederic Pierresteguy (F.Pierresteguy@frcl.bull.fr) * xmenu.c (xmenu_show): Ignore any geometry resource from the user. Sun Jul 31 02:37:25 1994 Richard Stallman * xfns.c (Fx_get_resource): Doc fix. * data.c (syms_of_data): Set up Qadvice_info, Qactivate_advice. (Ffset): Activate advice if symbol has advice-info property. * xdisp.c (redisplay_window): Avoid using SET_PT to change point temporarily. * dispnew.c (sit_for): Undo previous change. Sat Jul 30 14:26:59 1994 enami tsugutomo * dispnew.c (direct_output_for_insert): Pass missing 8th argument to compute_char_face. Sat Jul 30 16:36:38 1994 Richard Stallman * keyboard.c (follow_key): Don't downcase letters here. Delete arg `case_converted'. (read_key_sequence): Do it here; but not if in middle of fcn key. * fns.c (Frandom): Handle LIMIT >= 40000000. * xdisp.c (decode_mode_spec): Handle %&. Fri Jul 29 21:21:09 1994 Richard Stallman * process.c (create_process): Set default handling for SIGINT, etc. Thu Jul 28 08:46:00 1994 Richard Stallman * process.c (wait_reading_process_input): Fix previous change. * s/hpux9.h (HAVE_TERMIOS, NO_TERMIO): Defined. (HAVE_TERMIO): Add #undef. * sysdep.c (random): Use rand differently, and distinguish BSD/USG. * fns.c (Frandom): Fix previous change. Wed Jul 27 13:29:53 1994 Richard Stallman * syssignal.h [POSIX_SIGNALS] (signal): New definition. * config.h.in (HAVE_RAND48): Add #undef. Tue Jul 26 11:25:58 1994 Richard Stallman * xterm.c (x_queue_event, x_unqueue_events): New functions. (x_start_queuing_selection_requests): New function. (x_stop_queuing_selection_requests): New function. (XTread_socket): Queue up SelectionRequest events sometimes. * xselect.c (x_get_foreign_selection): Use the new feature to queue up SelectionRequest events. * process.c (wait_reading_process_input): If wait_for_cell, do check for keyboard input and handle it. * fns.c (Frandom): Use just the low 30 bits of random's value. * sysdep.c (random, srandom): Obey HAVE_RAND48 flag. Test that random is not a macro. Don't test USG or BSD4_1. * m/tek4300.h (tek4300): Don't define if already defined. Mon Jul 25 14:39:34 1994 Richard Stallman * m/tek4300.h (BSD_PGRPS): Defined. * puresize.h (PURESIZE): Increase non-MULTI_FRAME value. * editfns.c (get_system_name): Add a cast. * config.h.in: Add #undef HAVE_H_ERRNO. * process.c, sysdep.c [!HAVE_H_ERRNO]: Declare h_errno. * sysdep.c (init_system_name): Set h_errno to 0 initially. * process.c (Fopen_network_stream): Set h_errno to 0 initially. * window.c (Fdisplay_buffer): Add MULTI_FRAME cond in last change. * Makefile.in.in: Add #undef alloca. Sat Jul 23 21:20:05 1994 Richard Stallman * minibuf.c (Fdisplay_completion_list): gcpro `completions'. * print.c (internal_with_output_to_temp_buffer): gcpro things. * puresize.h (PURESIZE): Incremented to 252000. Sat Jul 23 12:26:36 1994 Jim Blandy (jimb@totoro.bio.indiana.edu) * .gdbinit: Set the breakpoint in x_error_quitter instead of _XPrintDefaultError. Wed Jul 20 00:56:24 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (Fnext_window, Fprevious_window): Don't get stuck in a loop in the minibuffer frame. * dispnew.c (direct_output_for_insert): Dpn't call compute_char_face for a non-X frame. * s/usg5-4.h: Move #undef static before the includes. * xrdb.c [USG5] (SYSV): Don't define if already defined. * fileio.c (Fwrite_region): Do unwind the new unwind protect. Tue Jul 19 12:05:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (struct font_info): New field full_name. (x_new_font): Record, and return, the full name of the font. * widget.c (EmacsFrameSetCharSize): Delete the code to make rows at least 3. * fileio.c (Vwrite_region_annotations_so_far): New variable. (syms_of_fileio): Set up Lisp var. (build_annotations): Handle annotate functions that switch buffers. Set Vwrite_region_annotations_so_far. (Fwrite_region): Handle change of buffer in build_annotations. Add an unwind protect to restore original buffer and kill the temp. * sysdep.c (init_system_name): Retry gethostbyname after TRY_AGAIN failure. * process.c (Fopen_network_stream): Retry gethostbyname after TRY_AGAIN failure. * s/isc4-0.h [__GNUC__] (LIBX11_SYSTEM): Add -lcposix. * s/usg5-4.h (PTY_TTY_NAME_SPRINTF): Fail smoothly if cannot get pty. * sysdep.c (sys_subshell): Expand ~ in dir. Do the processing of dir before calling fork. Use vfork. Mon Jul 18 02:09:30 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (note_mouse_movement): Use proper data type for window args to XQueryPointer. (x_scroll_bar_note_movement): Likewise. * keyboard.c (Vdeferred_action_list, Vdeferred_action_function): New variables. (command_loop_1): Handle them. (syms_of_keyboard): Set up Lisp variables. * s/linux.h [emacs]: Include stdio.h. * commands.h (unread_command_char): Declared. * dispnew.c (sit_for): Return immediately if unread events exist. Sun Jul 17 19:52:42 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * textprop.c (Fget_text_property): Simplify using Ftext_properties_at. Sun Jul 17 02:41:19 1994 Richard Stallman * xfns.c (Fx_create_frame): Use 140 as default font size. * xmenu.c [USE_X_TOOLKIT] (xmenu_show): Handle UnmapNotify events. Sat Jul 16 14:31:34 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (Fdisplay_buffer): Cope with unsplittable frames and dedicated windows. * frame.c [!MULTI_FRAME] (Fframe_first_window): Defined. (syms_of_frame): Defvar it. Thu Jul 14 19:56:33 1994 Morten Welinder (terra@diku.dk) * s/msdos.h (HAVE_VOLATILE): Define. Thu Jul 14 00:59:50 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (safe_run_hooks): Use local var to restore hook's value. Wed Jul 13 20:55:47 1994 Morten Welinder (terra@diku.dk) * keyboard.c (kbd_buffer_get_event) [HAVE_MOUSE]: Include code to check for mouse dragging. (make_lispy_movement) [HAVE_MOUSE]: Define also in this case, but only include the non-multiframe stuff. * msdos.c (mouse_init1): Use alternate mouse detection for old mouse drivers. (mouse_get_pos): Downscale coordinates by 8. Wed Jul 13 00:11:17 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (Fselect_window): Fix bug checking new_point is in range. * fileio.c (syms_of_fileio): Finish previous change. * keyboard.c (command_loop_1): Do direct output for cursor motion over text chars when disp tab exists but says nothing for them. * frame.h (FRAME_EXTERNAL_MENU_BAR) [!USE_X_TOOLKIT]: Give zero. * xdisp.c [!HAVE_X_WINDOWS] (compute_char_face, compute_glyph_face): Add simple alternate definitions for non-X case. Tue Jul 12 15:09:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (Qlast_nonmenu_event): New variable. (syms_of_process): Set it up. (read_process_output, exec_sentinel): Bind it to t around filter. * fileio.c (Fmake_directory_internal): Use Qmake_directory_internal. (syms_of_fileio): Set up Qmake_directory_internal, not Qmake_directory. * frame.c [MULTI_FRAME] (Fframe_parameters): For non-X frames, fill in menu-bar-lines value. Mon Jul 11 20:46:53 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (xmenu_show): Don't call XtUngrabPointer here. * Makefile.in.in (ctagsfiles): Rewrite to avoid compiler bug. Sun Jul 10 20:37:09 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (Fdisplay_buffer): Add MULTI_FRAME conditional in previous change. Sun Jul 10 19:11:24 1994 Morten Welinder (terra@diku.dk) * m/intel386.h [MSDOS] (NO_REMAP): Defined. * s/msdos.h (HAVE_MOUSE, PURESIZE): Definitions moved here. * m/dos386.h: File obsolete and deleted. * msdos.c (dos_rawgetc): Use bios, not kbhit. Sat Jul 9 14:20:11 1994 Morten Welinder (terra@diku.dk) * fileio.c (Ffile_name_directory, Ffile_name_nondirectory, file_name_as_directory, directory_file_name, Fexpand_file_name, Ffile_name_absolute_p, Fsubstitute_in_file_name) [MSDOS]: Allow backslashed file names. Sat Jul 9 00:43:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * puresize.h (PURESIZE) [MULTI_FRAME]: Increased to 250000. * lread.c (readevalloop): Correctly unbind the unwind protect. Fri Jul 8 16:24:59 1994 Morten Welinder (terra@diku.dk) * msdos.c (do_visible_bell): Clean-up using GNU assembly extension. Thu Jul 7 00:52:10 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * m/sparc.h (BIG_ENDIAN): Don't redefine if defined. * Makefile.in.in (alloca.o): Delete allocatem.c first thing. * xmenu.c (xmenu_show) {USE_X_TOOLKIT}: ButtonPress no longer pops down; instead it forces the next ButtonRelease to exit. Don't dispatch on ButtonPress events. * xfns.c (syms_of_xfns): Provide x-toolkit in toolkit version. Undo previous change. (x_toolkit): Variable deleted. * xfns.c (x_toolkit): New variable. (syms_of_xfns): Set up Lisp var x-toolkit. * window.c (Fnext_window, Fprevious_window): ALL_FRAMES = 0 means try both visible frames and iconified frames. (window_loop): Likewise, for FRAMES = 0. (Fget_buffer_window): Likewise, for FRAME = 0. (Fdisplay_buffer): Pass 0 to Fget_buffer_window; if the frame is iconified, make it visible. * frame.c (next_frame, prev_frame): MINIBUF = 0 means try visible frames and iconified frames. Wed Jul 6 15:30:48 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (xmenu_show) [USE_X_TOOLKIT]: Keyboard input exits the menu. ButtonRelease does so if within Vdouble_click_time. Ignore mouse motion if button was already released. (menu_item_selection): Declare volatile, if __STDC__. * keyboard.c (make_lispy_event): Ignore menu bar up events. Tue Jul 5 02:18:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * doprnt.c (doprnt): Handle padding on %c. * frame.c (next_frame, prev_frame): Change which frames to use when MINIBUF is a window. (Fnext_frame, Fprevious_frame): Doc fixes. * window.c: Doc fixes. Mon Jul 4 23:54:05 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (XTread_socket, construct_menu_click) [USE_X_TOOLKIT]: Update x_mouse_grabbed and Vmouse_depressed. Sat Jul 2 00:23:23 1994 Richard Stallman (rms@gnu.ai.mit.edu) * xdisp.c (decode_mode_spec): %+ makes % for unmodified RO buffer. * buffer.c (syms_of_buffer): Doc fix. * xfaces.c (get_cached_face): Set the cached_index field. Fri Jul 1 11:34:08 1994 Richard Stallman (rms@gnu.ai.mit.edu) * sysdep.c (init_sys_modes): Turn off VSTART and VSTOP chars. On DGUX, turn off INPCK. Fri Jul 1 03:13:06 1994 Paul Reilly (pmr@churchy.gnu.ai.mit.edu) * xfns.c (Fx_create_frame): Add GC protection for frame being made. Thu Jun 30 00:27:11 1994 Richard Stallman (rms@gnu.ai.mit.edu) * xterm.c (x_make_frame_visible): In x_sync loop at the end, every fourth time, sleep for 1/4 second. * xselect.c (x_own_selection, x_get_foreign_selection): Get rid of spurious X_TOOLKIT conditional. * frame.c (Fdelete_frame): Call x_clear_frame_selections. * xselect.c (x_own_selection): Put the frame in Vselection_alist. (x_clear_frame_selections): New function. * xterm.c (x_draw_box): Use curs_x and curs_y, not f->cursor_[xy]. * xfns.c (XLIB_ILLEGAL_ACCESS): Defined. Wed Jun 29 14:57:27 1994 Richard Stallman (rms@gnu.ai.mit.edu) * s/hpux.h (random, srandom): Defined. * cmds.c (internal_self_insert): Now can return 2. * keyboard.c (command_loop_1): Don't clear nonundocount when internal_self_insert returns 1. Tue Jun 28 18:21:08 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (x_set_frame_parameters): Call x_set_offset directly. Handle `-' for position parameters. Tue Jun 28 17:50:22 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * lread.c (readchar): Restart interrupted I/O. Tue Jun 28 15:00:45 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * fileio.c (a_write): Loop while *ANNOT is listp, not consp. Previous code omitted all data from output files when *ANNOT was nil. Tue Jun 28 05:25:06 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (x_set_name): If no change needed, avoid consing. * xdisp.c (prepare_menu_bars): Call x_consider_frame_title only if windows_or_buffers_changed. * keyboard.c (safe_run_hooks): Take symbol as arg. Use Fsymbol_value and Fset. (command_loop_1): Pass symbol to safe_run_hooks. Look in the value cell to check for trivial case (no hooks). * xdisp.c (redisplay_region): For special treatment, BUF most be both current and displayed in selected window. * buffer.c (Foverlay_put): Pass redisplay_region a struct buffer *. Mon Jun 27 16:43:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (a_write): Verify that *annot is a cons. Sun Jun 26 12:28:23 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (echo_dash): Fix backwards conditional. (read_key_sequence): Don't echo if echo_keystrokes is 0. * m/news-risc.h (C_DEBUG_SWITCH) [not NEWSOS5]: Don't define if __GNUC__. (KERNEL_FILE) [not NEWSOS5]: New override definition. Sat Jun 25 12:28:24 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (send_process): Major rewrite. Don't put in a C-d unless a single line is too long. Read process input whenever output gets stuck. Relocate BUF if we read input. New arg OBJECT. (Fprocess_send_region, Fprocess_send_string, process_send_signal) (Fprocess_send_eof): Pass new arg OBJECT. * buffer.h (BUF_PTR_CHAR_POS): New macro. * window.c (Fsave_window_excursion): Doc fix. * s/hpux9.h (C_SWITCH_SYSTEM): Add -D_BSD. * frame.c (Fframe_parameters): Don't handle menu-bar-lines explicitly. * window.c (Fother_window_for_scrolling): New function. (Fscroll_other_window): Use that. (syms_of_window): defsubr it. Fri Jun 24 20:13:01 1994 Karl Heuer (kwzh@nutrimat.gnu.ai.mit.edu) * fileio.c (Finsert_file_contents): Fix check for non-regular files. Fri Jun 24 10:09:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * syntax.c (scan_lists, Fforward_comment): When moving backward over a comment, ignore a comment-starter that overlaps the comment-ender. * minibuf.c (Fcompleting_read): Doc fix. Thu Jun 23 20:33:17 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * keyboard.c (syms_of_keyboard): Don't staticpro the same var twice. Thu Jun 23 15:15:09 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/convexos.h: File deleted. * xterm.c: Don't include string.h or strings.h. * term.c (term_get_fkeys): Don't redeclare term_get_fkeys_1 here. * m/convex.h (LIBS_MACHINE, GETPGRP_NO_ARG): Defined. (NLIST_NAME_UNION, DECLARE_GETPWUID_WITH_UID_T): Defined. (CRT0_DUMMIES): Conditionalize according to __GNUC__. (convex): Define if necessary. (C_SWITCH_MACHINE): Definition deleted. Wed Jun 22 00:15:49 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c (Fmove_overlay): Fix typo in previous change. * s/sunos4shr.h (X_IO_BUG): Defined. Tue Jun 21 13:51:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * minibuf.c (read_minibuf_unwind): Run Qminibuffer_exit_hook here. (read_minibuf): Not here. * buffer.c (Fkill_buffer): Don't delete auto save file if it didn't come from this Emacs session. (Fmove_overlay): Add missing XINT calls in previous change. Mon Jun 20 20:40:37 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xfns.c (x_window): Delete duplicate computation. Change type of reference argument from int to Dimension. Mon Jun 20 10:50:29 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * config.h.in: Move #undef HAVE_STRERROR before the #includes. * m/mips4.h (HAVE_STRERROR, HAVE_XRMSETDATABASE) (HAVE_XSCREENRESOURCESTRING, HAVE_SETSID): Add #undefs. * buffer.c (Fmove_overlay): Call redisplay_region even when changing to a different buffer. * syntax.c (Fmatching_paren): Fix typo. * xterm.c (show_mouse_face): Set endcolumn ok in side-by-side windows. Sun Jun 19 01:01:42 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/linux.h (SEGMENT_MASK): Defined. * xfns.c (x_window): Take account of pane widget internal border width. * s/linux.h (C_OPTIMIZE_SWITCH): Definition deleted. * lisp.h (RETURN_UNGCPRO): Swallow semicolon. (GCPRO5): New macro. * xmenu.c (single_keymap_panes): Put menu_item_equiv_key in the gcpro. (menu_item_equiv_key): GCPRO things. * keymap.c (Flookup_key): Add gcpro. (Fkey_binding, Fminor_mode_key_binding): Likewise. (Fwhere_is_internal): Likewise. * keyboard.c (apply_modifiers): Use assq_no_quit. Sun Jun 19 03:54:02 1994 Erik Naggum (erik@naggum.no) * syntax.h (SYNTAX_MATCH): Fix typo (syntax -> matcher). * syntax.c (Fmatching_paren): New function. (Fchar_syntax): Pass arg directly to SYNTAX, no masking. Sat Jun 18 15:20:10 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * .gdbinit: Doc fixes. (xsymbol): Cast $ to int. (xvector, xstring): Don't use a string constant. Reduce size limit for printing contents. * s/sol2.h (GETTIMEOFDAY_ONE_ARGUMENT): Undo previous change. Sat Jun 18 19:52:15 1994 Francesco Potorti` (pot@fly.cnuce.cnr.it) * m/delta.h (memmove): switch the first two args. Sat Jun 18 09:00:50 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_make_frame_visible): At end, wait till Emacs sees frame is visible. * keyboard.c (echo_after_prompt): New variable. (echo_prompt, cancel_echoing): Set it. (echo_dash): Test it. * s/linux.h (C_DEBUG_SWITCH): Define, if THIS_IS_CONFIGURE. (HAVE_GETTIMEOFDAY, HAVE_MKDIR, HAVE_RMDIR): (HAVE_XSCREENNUMBEROFSCREEN, HAVE_XRMSETDATABASE): Comment out these definitions. * Makefile.in.in (doprnt.o): Depend on config_h. Fri Jun 17 19:30:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * systime.h (EMACS_GET_TIME): Test GETTIMEOFDAY_ONE_ARGUMENT, not USG5_4. * s/usg5-4.h (GETTIMEOFDAY_ONE_ARGUMENT): Define it. * s/sol2.h (GETTIMEOFDAY_ONE_ARGUMENT): Undef it. * xfns.c (x_real_positions): Make sure we know the parent window. Fri Jun 17 16:01:55 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * window.h (minibuf_prompt): Now a Lisp_Object. All uses changed. * minibuf.c (minibuf_save_list): New variable, replaces minibuf_save_vector. (read_minibuf): Cons it up. (read_minibuf_unwind): Pop back the saved values. (syms_of_minibuf): staticpro it. * indent.c (compute_motion): Recenter overlays, for speed. Fri Jun 17 09:33:21 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (scratch_cursor_gc): New variable. (dumpglyphs): Rework handling of GCs for cursor display to use scratch_cursor_gc, and reuse the GC more. Thu Jun 16 14:50:43 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * unexec.c (make_hdr): Handle case of no "additional header". * xdisp.c (redisplay_region): Treat selected window's buffer specially, not current buffer. * syssignal.h [USG5_4] (sigblock): Use |, not &. Thu Jun 16 11:36:35 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xdisp.c (redisplay_window): Don't use shortcut if window_end_vpos is out of date. Thu Jun 16 11:01:33 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (Fprocess_status): Return nil for process name that has no process. * dispnew.c (syms_of_display): Make baud-rate a user var. * syntax.c (scan_lists): Get error if eob within comment with depth!=0. Thu Jun 16 02:55:51 1994 Roland McGrath (roland@geech.gnu.ai.mit.edu) * unexec.c: Include and [USG5] to define O_* macros. (O_RDONLY, O_RDWR): Define if undefined. [emacs] (report_error): Use report_file_error so the user can tell what the errno code was. (unexec): Use O_RDONLY instead of explicit 0. (make_hdr): Don't undo A_TEXT_OFFSET adjustment #ifndef NO_REMAP, since it was never adjusted earlier #ifndef NO_REMAP. (adjust_lnnoptrs): Use O_RDWR instead of explicit 2. Wed Jun 15 16:11:16 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_noop_count): New variable. (x_term_init) [X_IO_BUG]: Init it. (XTread_socket) [X_IO_BUG]: Don't do XNoOp every time, just 1 in 100. Wed Jun 15 00:03:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * syssignal.h (sigblock) [USG5_4]: Define if not defined. Tue Jun 14 23:40:29 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lread.c: Put config.h first. * hftctl.c: Put sys/signal.h and errno.h first, then config.h. * dired.c: Put stdio.h, sys/types.h and sys/stat.h after config.h. * callproc.c, dispnew.c, frame.c, term.h: Put stdio.h after config.h. * widget.c, xmenu.c, xterm.c: Put stdio.h after config.h. Tue Jun 14 20:17:16 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * sysdep.c (init_system_name): New function, replaces get_system_name. * lisp.h: declare it. * editfns.c (init_editfns): Call it. (get_system_name): New function, now just uses Vsystem_name. * xterm.c (x_term_init): Use Vsystem_name instead of calling get_system_name. * keymap.c (Fsingle_key_description): Allow strings as keys. * process.c (create_process): Set input_wait_mask before forking. Tue Jun 14 15:45:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * indent.c (vmotion): Use find_next_newline_no_quit. (indented_beyond_p): Likewise. * search.c (find_next_newline_no_quit): New function. * sysdep.c (init_sys_modes): Don't set up sigio here if window system. * keyboard.c (read_key_sequence): Verify event has a POSN_BUFFER_POSN before trying to extract it. * eval.c (init_eval_once): Call xmalloc, not malloc. * process.c (Fprocess_send_eof): Doc fix. Mon Jun 13 17:07:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (interrupt_signal, init_keyboard): Don't handle SIGINT and SIGQUIT if using window system directly. * sysdep.c (init_sys_modes): Don't call set_terminal_modes if using a window system. * xterm.c (XTread_socket): Use x_top_window_to_frame in prev change. * s/sol2.h (SOLARIS2): Defined. * m/intel386.h: Add conditional for SOLARIS2. Mon Jun 13 16:55:30 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xmenu.c (single_keymap_panes): gcpro some things. Mon Jun 13 15:44:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (XTread_socket): Handle Xatom_wm_save_yourself by calling XSetCommand. * emacs.c (init_cmdargs): Set up initial_argv, initial_argc. * keyboard.c (syms_of_keyboard): Properly init Vsystem_key_alist. * unexaix.c (adjust_lnnoptrs): Handle multiple aux symbols. Sun Jun 12 15:57:02 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * editfns.c (transpose_markers): Allow for gap at start of region. (Ftranspose_regions): Don't precompute pointers into buffer text. Sun Jun 12 08:42:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (x_window): Request "save yourself" commands. * callint.c (Fcall_interactively): Ignore `-' in string. (Fcall_interactively): Don't call minibuffer-window-active-p; determine directly whether a minibuf window is active. * keyboard.c (read_char): When we loop and call redisplay, do prepare_menu_bars first. Sat Jun 11 08:12:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * search.c (Freplace_match): Be sure not to treat non-digit like digit. * xmenu.c (xmenu_show): Don't call XMenuDestroy twice in XM_FAILURE case. * Makefile.in.in (xterm.o): Depend on dispextern.h. * s/sunos4-1-3.h (X_IO_BUG): Defined. Fri Jun 10 16:31:19 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/linux.h (CLASH_DETECTION): Defined. * minibuf.c (Fdisplay_completion_list): Require at least two spaces between items. Tue Jun 7 13:33:23 1994 Richard Stallman (rms@geech.gnu.ai.mit.edu) * keyboard.c (command_loop_1): Treat nil in display tab like no display tab. Tue Jun 7 11:50:49 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mips-siemens.h: Include pyramid.h, not mips.h. (LOAD_AVE_TYPE, LOAD_AVE_CVT): Definitions deleted. (NO_ARG_ARRAY, HAVE_ALLOCA): Defined. (BROKEN_FIONREAD): Add #undef. Tue Jun 7 19:19:04 1994 Morten Welinder (terra@diku.dk) * msdos.c (init_environment): Clean up code and make the default EMACSPATH equal to the directory from which Emacs was started. (emacsroot): New variable. (rootrelativepath): New function. * msdos.h: Add template for rootrelativepath. * lread.c [MSDOS]: #include "msdos.h". * callproc.c (init_callproc) [MSDOS]: Exclude less code, so ../etc is still tested for doc file. Mon Jun 6 21:11:13 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * fns.c (Fy_or_n_p, Fyes_or_no_p) [HAVE_X_MENU]: Redisplay before popping up a menu. * dispnew.c (Fframe_or_buffer_changed_p): Reuse the state vector. Mon Jun 6 08:37:39 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.c (Ficonify_frame, Fmake_frame_invisible, Fmake_frame_visible): Increment windows_or_buffers_changed. * xdisp.c (redisplay): Don't call x_consider_frame_title. (display_mode_line): Likewise. (prepare_menu_bars): Call it here. Mon Jun 6 01:02:32 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * dispnew.c (Fframe_or_buffer_changed_p): New function. Sun Jun 5 07:13:01 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_wm_set_icon_position, x_wm_set_icon_pixmap): [USE_X_TOOLKIT]: Use top-level widget's window. * s/bsd386.h (BSD): Redefine. (WAITTYPE, WRETCODE, WCOREDUMP): New definitions. Include wait.h. * m/sun386.h (LIBS_MACHINE) [USG]: New #define. * xterm.c (x_term_init): New args xrm_option and resource_string. Pass an -xrm option to XtAppInitialize if appropriate. * xfns.c (Fx_open_connection): Set up Vx_resource_name and xrm_option before calling x_term_init. Pass new args. * keyboard.c (modify_event_symbol): Return nil if out of range. * keymap.c (Fkey_description): Avoid using Fmapconcat--do it directly. * keyboard.c, dispnew.c: Include systime.h after xterm.h. * xfns.c (x_window): Take account of internal border of paned widget. * m/dos386.h (PURESIZE): Increased to 240000. * xfns.c (using_x_p): New function. * fns.c (Fy_or_n_p): Don't use dialog box if not an X frame. (Fyes_or_no_p): Likewise. Sat Jun 4 14:35:09 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/hpux9shr.h (C_DEBUG_SWITCH): Define as empty. Fri Jun 3 20:14:30 1994 Morten Welinder (terra@diku.dk) * callproc.c [MSDOS]: #include "msdos.h" for rootrelativepath template. * msdos.c (run_msdos_command): Make local copy of argv[2] on stack, not on heap. (run_msdos_command): When changing argv[2] from using slashes to using backslashes, only do so on the first white-space delimited part. Thu Jun 2 19:41:08 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * textprop.c (Fprevious_single_property_change): Check for null interval after correcting for edge effects. * xdisp.c (display_text_line): Make sure pointer is in range. * xmenu.c (xdialog_show): Fix problem with message in dialog box. Thu Jun 2 15:11:57 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacs.c (main): Do the setpgrp after checking for -batch. * keyboard.c (command_loop_1): Properly handle nil in display table. * s/hpux9.h (C_SWITCH_SYSTEM): Put inside __GNUC__ conditional. Wed Jun 1 14:55:45 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (kill_buffer_processes): For net conn, use Fdelete_process. See ChangeLog.4 for earlier changes. emacs-19.30/src/ChangeLog.1100666 13437 1 324054 3671157264 14025 0ustar jimbdaemon Sun May 18 23:01:41 1986 Richard M. Stallman (rms at prep) * alloc.c (malloc_warning_1): Add some advice on the significance of the warning. Fri May 9 01:12:31 1986 Richard M. Stallman (rms at prep) * sysdep.c (get_screen_size): Reject values of TIOCGSIZE if they are ridiculous. Mon May 5 14:57:05 1986 Richard M. Stallman (rms at prep) * process.c (send_process_1): If pipe buffer is full, wait a second and try again. Fri May 2 19:39:06 1986 Richard M. Stallman (rms at prep) * termcap.c (tputs): round rather than truncating when dividing padcount. Thu Apr 24 09:15:47 1986 Richard M. Stallman (rms at prep) * insdel.c (del_range): args passed to adjust_markers are now properly adjusted for the gap. Sun Apr 20 18:37:08 1986 Richard M. Stallman (rms at prep) * alloca.c: Declare xmalloc. Thu Apr 17 23:44:13 1986 Richard M. Stallman (rms at prep) * filelock.c (unlock_buffer): New function to unlock a specified buffer. Use in Fdelete_buffer_internal to avoid lossage if buffer being killed is not current. Mon Apr 14 19:00:38 1986 Richard M. Stallman (rms at prep) * alloc.c (malloc_warning, Fgarbage_collect): If malloc_warning is called during GC, just save warning in malloc_warn_string. Try again to warn when GC ends. Sat Apr 12 19:41:43 1986 Richard M. Stallman (rms at prep) * m-celerity.h: Remove spurious effectless #define BSTRINGS Thu Apr 10 05:43:53 1986 Richard M. Stallman (rms at prep) * xfns.c (Fx_get_default): Avoid doing strlen(value) if value is 0. Tue Apr 8 16:51:11 1986 Richard M. Stallman (rms at prep) * indent.c (compute_motion): Change unsigned short back to short. unsigned short is plain wrong and causes infinite loops when horizontal scrolling is used. Introduced macros HPOS and VPOS for extracting components of cpos. Alternate HPOS definition for Celerity since casting to (short) loses there. Mon Apr 7 23:49:40 1986 Richard M. Stallman (rms at prep) * dispnew.c (update_screen): Don't zero OPhysScreen and DesiredScreen until after final error check. Omit the error check unless debug_end_pos. Sun Apr 6 18:43:09 1986 Richard M. Stallman (rms at prep) * cm.c (calccost): Was returning garbage if arrived at fail: by goto fail;. Thu Mar 27 10:11:25 1986 Richard Mlynarik (mly at prep) * dispnew.c: Typo: `#ifdef defined...' => `#if defined...' Wed Mar 26 23:49:34 1986 Richard M. Stallman (rms at prep) * doc.c (FSnarf_documentation): Appending the arg to the file name must be done whether or not CANNOT_DUMP. Tue Mar 25 14:01:44 1986 Richard M. Stallman (rms at prep) * fileio.c (Fsubstitute_in_file_name): // at beginning of filename is meaningful on Apollo. * keyboard.c (command_loop_1): If C_ALLOCA, cause it to garbage collect each time around this loop. * crt0.c: If NEED_ERRNO defined, declare errno. * m-7300.h: New file. Tue Mar 25 11:31:06 1986 Richard Mlynarik (mly at prep) * alloc.c (Fmake_symbol): CHECK_STRING the argument. Mon Mar 24 11:41:59 1986 Richard M. Stallman (rms at prep) * xfns.c (Fx_proc_mouse_event): Use shifts rather than byte addressing to extract from .detail. Mon Mar 24 07:03:39 1986 Richard Mlynarik (mly at prep) * minibuf.c (do_completion): Only funcall predicate if it is non-nil Make completion of "nil" in obarrays work. Fri Mar 21 10:04:08 1986 Richard M. Stallman (rms at prep) * fileio.c (Fsubstitute_in_file_name): #if 0 last change (LOGNAME); it makes vax running 5.0 crash. Thu Mar 20 13:37:30 1986 Richard M. Stallman (rms at prep) * unexec.c (make_hdr): avoid comparing a_bss field with 0. It is unsigned on some machines. Save sbrk (0) in tem. Wed Mar 19 00:04:39 1986 Richard M. Stallman (rms at prep) * minibuf.c (do_completion): Don't say string is exact match if it fails the predicate. * process.c (create_process): For STRIDE: use FIONBIO to make pipe/pty non-blocking. The fcntl alone failed to do it. * fileio.c (Ffile_directory_p, Ffile_modes): Don't remove trailing slash for stat if path is "/". * process.c (kill_buffer_processes): Pass nil, not 0, to sig_process for current_group arg. Tue Mar 18 01:25:22 1986 Richard M. Stallman (rms at prep) * process.c (handle_process_output): Avoid error if process's buffer is dead. * eval.c (un_autoload,do_autoload): The Vautoload_queue mechanism was all broken. * fileio.c (Fsubstitute_in_file_name): On USG, if looking for env var USER and not found, use LOGNAME. Sun Mar 16 21:18:33 1986 Richard M. Stallman (rms at prep) * s-usg*.h, s-unipl*.h: Replace default ADDR_CORRECT with a no-op. Default triggers compiler bug on some systems. Remove same thing from m-stride.h since now redundant there. * keyboard.c (init_keyboard, interrupt_signal): For USG, handle SIGQUIT just like SIGINT. * sysdep.c (init_sys_modes): For HPUX, use C-g for the SIGQUIT char as well as the SIGINT char as using CDEL causes Meta-DEL to send a SIGQUIT! * process.c: On Uniplus, time.h is under sys/, as in bsd. * sysdep.c (reset_sys_modes): Don't use FASYNC if it is not defined. Sat Mar 15 02:41:40 1986 Richard M. Stallman (rms at prep) * window.c (save_window_restore): Fix logic for handling dead buffers. Don't try to store nil for the mark into the buffer if the buffer is nil. * alloca.s: put #ifndef HAVE_ALLOCA AFTER including config. * ymakefile: always assemble alloca.s if C_ALLOCA isn't set. Fri Mar 14 21:42:13 1986 Richard M. Stallman (rms at prep) * s-usg5.0.h: Remove LOADER_N_SWITCH. Fri Mar 14 15:14:23 1986 Richard Mlynarik (mly at prep) * editfns.c Improve doc for bolp, bobp, eolp Fri Mar 14 00:17:03 1986 Richard M. Stallman (rms at prep) * cm.c (calccost): Refuse to use incremental cursor motion after wrapping on terminals with MagicWrap (xn flag). Thu Mar 13 14:53:46 1986 Richard M. Stallman (rms at prep) * emacs.c (main): For APOLLO: reserve 4meg with set_sbrk_size. * alloc.c (Fpurecopy): fix typo unsignedint. Wed Mar 12 11:35:16 1986 Richard M. Stallman (rms at prep) * dired.c (file_name_completion): Allow exact match against an ignored extension. Can thus delete foo.o even if foo.out exists. * s-hpux.h: Turn off HAVE_PTYS since their csh has "sanity checking" and other programs seem to lose with ptys. Tue Mar 11 00:14:27 1986 Richard M. Stallman (rms at prep) * sysdep.c ({un,}request_sigio and callers): Make alternate names init_sigio and reset_sigio; callers in sysdep.c use those names. In 4.1, change {un,}request_sigio to do sighold/sigrelse; don't change init_sigio and reset_sigio. * m-vax.h: If USG5_2, use -lPW and HAVE_ALLOCA. * alloc.c (Fpurecopy, mark_object): In tests for pureness, always use XUINT and unsigned comparison. * lisp.h (CHECK_IMPURE): Likewise. * doc.c (FSnarf_documentation): If CANNOT_DUMP, find DOC in directory PATH_EXEC. * ymakefile (APOLLO only): set LTERMCAP. * m-apollo.h: Alter VALBITS and GCTYPEBITS. * term.c (delete_chars): Pass num chars to the hook. * term.c (raw_topos), termhooks.h: Add raw_topos_hook. * unexec.c (make_hdr): New compiler switch NO_REMAP means don't change text/data boundary. Mon Mar 10 02:14:18 1986 Richard M. Stallman (rms at prep) * indent.c, window.c, xdisp.c: Make compute_motion, vmotion and display_text_line all return a pointer to a global structure, not a struct itself. Add * to all calls. * syntax.c (scan_sexps_forward): Make it return a pointer to a global structure, not a struct itself. Change caller (Fparse_partial_sexp). * s-usg*: #define static as nothing. * m-hp200.h: No longer needs to #define static. * unexec.c (adjust_lnnoptrs): Replace dummy defn with one that does the job. Also involves including syms.h and making global vars bias and lnnoptr that are set in make_hdr. Sat Mar 8 01:24:13 1986 Richard M. Stallman (rms at prep) * editfns.c (init_editfns): Make AMPERSAND_FULL_NAME case start with USER_FULL_NAME. * crt0.c (BOGUS case): Move "start:" from non-tower32 case to unconditional. * unexec.c for COFF: Put the rounding-to-page-boundaries of section positions within the file into a UMAX conditional. (See Feb 19). Thu Mar 6 19:56:08 1986 Richard M. Stallman (rms at prep) * ymakefile: Add -k100000 switch to ld, for celerity. * eval.c (funcall_lambda): Change a comma-sequence to a compound statement. Mon Mar 3 13:30:54 1986 Richard M. Stallman (rms at prep) * xfns.c, xterm.c: Install much-changed versions already tested at Athena. * ymakefile: Replace -lc with $(LIBSTD) and define LIBSTD according to a config macro LIB_STANDARD. m-tower32.h must define LIB_STANDARD. * process.c (read_process_output): New subroutine that does the reading and handling of process output. Do so until none is left. (wait_reading_process_input): call new subroutine. (sig_process): If we get a pgrp number, make it negative. Always send signal to pggrp; use killpg if BSD, kill otherwise. (child_signal): Don't deactivate dead processes here. (change_msgs): Deactivate them here, when notification is done. But first, call read_process_output to get any output that's left. * keyboard.c (read_avail_input): (for sysV) Use fcntl, not ioctl, to make read not wait. * alloca.s: put entire file inside #ifndef HAVE_ALLOCA. * sysdep.c (child_setup_tty, init_sys_modes): (for sysV) Set VTIME to zero; with VMIN=1 this means no time limit. Sun Mar 2 23:58:34 1986 Richard M. Stallman (rms at prep) * keyboard.c (quit_throw_to_get_char): Before really throwing, clear waiting_for_input so another interrupt won't also try to throw. (get_char): Add error check for getcjmp being zero where it should not be. Put this under DEBUG switch. Sat Mar 1 00:12:13 1986 Richard M. Stallman (rms at prep) * crt0.c: Defining BOGUS forces use of the vax-tahoe-sequent case. Add a small conditional within it for tower32. Don't allow use of the m68000/m68k code if BOGUS is defined. * sysdep.c (init_sys_modes): For sysV: If want flow control, actively set IXON, and also clear IXANY if that is defined. * sysdep.c (rename): It was doing completely wrong things to various files. * tparam.c (tgoto): Move buf outside the function and rename as tgoto_buf. In case #define static as nothing. * unexec.c (make_hdr): If macro EXEC_MAGIC is defined, let it specify the magic number for the output file. * xdisp.c (message): Change name `buf' to `message_buf' to avoid name clash when #define static as nothing. * ymakefile: Change DOCSTR to DOC. Fri Feb 28 01:43:27 1986 Richard M. Stallman (rms at prep) * buffer.c (Fdelete_buffer_internal): Unchain all markers from a buffer being killed. Thu Feb 27 10:42:20 1986 Richard M. Stallman (rms at prep) * unexec.c, malloc.c: If NBPG is used for getpagesize, multiply it by CLSIZE and define that as 1 if not otherwise defined. Wed Feb 26 02:01:19 1986 Richard M. Stallman (rms at prep) * lread.c (Fload): Detect when fdopen returns 0 given a valid descriptor. * sysdep.c (stuff_char): Declare arg as char, so TIOCSTI does not give wrong address. Tue Feb 25 02:27:51 1986 Richard M. Stallman (rms at prep) * dispnew.c (update_screen): * xdisp.c (DoDsp, Fredraw_display): Insert checks to abort if screen_height is zero, to detect the memory clobbering bug. * process.c: For 4.1, include wait.h, not sys/wait.h Use O_NDELAY only if it is defined. * s-bsd4.1.h: Don't HAVE_TIMEVAL. Define open as sys_open and lstat as stat. Define the O_ symbols for open args. Turn off CLASH_DETECTION, for now. Turn off HAVE_TIMEVAL. * sysdep.c (bcopy, bzero, bcmp): Make them really do the work, not try to use memset, memcopy, etc. * sysdep.c (get_system_name): 4.1 needs its own definition of this. * sysdep.c (for BSD 4.1): Define sys_open, since 4.1 open takes only two args. Redefine LLITOUT as 0; it loses in 4.1. Define LNOFLSH. Include wait.h, not sys/wait.h. Mon Feb 24 01:21:46 1986 Richard M. Stallman (rms at prep) * malloc.c: Define getpagesize as macro when not avail as syscall. Sun Feb 23 18:06:06 1986 Richard M. Stallman (rms at prep) * terminfo.c: Provide a definition of ospeed. Sat Feb 22 03:07:41 1986 Richard M. Stallman (rms at prep) * alloca.s (hack_sky): Move label hack3; bug was making some floating ops dump core. * dispnew.c (update_screen): Don't free a line twice if it is in both DesiredScreen and OPhysScreen. Can happen if line is copied into DesiredScreen by `scrolling', then lost from PhysScreen by the scrolling that is done. Also remove a debugging check that did not go off when this bug hit. Tue Feb 18 14:56:28 1986 Richard M. Stallman (rms at prep) * indent.c (compute_motion): Change all short to unsigned short. Needed for celerity. * keyboard.c (init_keyboard): Initialize kbd_ptr. Needed for celerity. * unexec.c (make_hdr for celerity): Copy their own header field a_scovfrl from ohdr. * unexec.c for COFF: Round positions of text and and data sections in output file to page boundaries. * crt0.c: Install version for Encore machines. Also for celerity (same as pyramid and orion). * ymakefile: Don't use -X for BSD systems that use COFF. On UMAX, give ld the file align.umax (a new file) via the make-macro ALIGNMENT. * align.umax, s-umax.h: Two new files for Encore computers. * lread.c (Vload_path): Make it not static. In sysV, static vars go in a place in memory below my_edata * dispnew.c (make_display_lines): Store all the lines in an array for debugging, to help debug the problem where lines get lost. Fri Feb 14 13:46:23 1986 Richard M. Stallman (rms at prep) * alloca.s (ns16000): Change non-sequent defn of REGISTER: add a displacement of zero. Thu Feb 13 11:42:13 1986 Richard M. Stallman (rms at prep) * alloc.c (purecopy, mark_object), lisp.h: Use XUINT, not XINT, in VIRT_ADDR_VARIES checks for pure object. Tue Feb 11 17:56:15 1986 Richard M. Stallman (rms at prep) * fns.c (Fload_average): Don't use struct nlist if no LOAD_AVE_TYPE. * crt0.c: Add missing semicolon in vax/tahoe/sequent code. Mon Feb 10 22:13:58 1986 Richard M. Stallman (rms at prep) * crt0.c: Remove duplicate _start for pyramid. Fri Feb 7 01:12:35 1986 Richard M. Stallman (rms at prep) * sysdep.c (gettimeofday): Define this only if HAVE_TIMEVAL. * m-vax.h: If USG, don't define LOAD_AVE_... and do define C_ALLOCA. * filelock.c: On USG, include fcntl.h. (lock_file): declare getpwuid external. * window.c (Fmove_to_window_line): If window start is out of restriction, choose a new start here. * alloca.s: Modify ns16000 assembler syntax for the sequent machine. * crt0.c: Sequent uses same code as vax except start1 takes one extra first arg that it ignores. A new macro BOGUS is defined to allow machines to use the same code and control how many args to ignore. * unexec.c: For sequent machine, handle its incompatible meaning of N_TXTOFF, and use N_ADDRADJ where necessary. Thu Feb 6 19:48:58 1986 Richard M. Stallman (rms at prep) * sysdep.c (init_sys_modes): Set tty flags ISTRIP, CS8 and PARENB right for Meta key. * ymakefile: Define CPP macro as name of cpp to use. Use it for alloca.s. Make LOADER_N_SWITCH control solely the -N. Thu Feb 6 19:34:57 1986 Richard Mlynarik (mly at prep) * fns.c (Frequire): Fix documentation Thu Feb 6 00:26:45 1986 Richard M. Stallman (rms at prep) * indent.c (compute_motion): For tabs, make sure to take remainder of positive # since % can round upward with negative numbers. * bytecode.c (syms_of_bytecode): Fix typo in symbol name "byte-code". * xdisp.c (try_window_id): Use adjusted hpos of bp in computation of ep. Adjustde hpos can be negative after a continuation. * fileio.c (Finsert_file_contents): Was failing to update n as chars were read. Rearrange order of actions to make it more like InsCStr. Call prepare_to_modify_buffer even if no CLASH_DETECTION. Don't make gap if gap is big enough. Wed Feb 5 00:33:17 1986 Richard M. Stallman (rms at prep) * termcap.c (tgetent): Only use TERMCAP var as termcap entry value if it has a name that matches the specified one. New function name_match to match an entry against a name. Do allow matching the first name in an entry. * indent.c (pos_tab_offset): Take remainder by window-width - 1 (# of effective columns) to fix bug where alternating TAB 1 TAB 1... causes a 1 to shift sideways in incremental redisplay in DoDsp. Tue Feb 4 01:56:25 1986 Richard M. Stallman (rms at prep) * keyboard.c (command_loop_1): Don't do direct output if input is pending. * xterm.h: Find the file Xlib.h in /usr/include/X. Mon Feb 3 01:48:06 1986 Richard M. Stallman (rms at prep) * process.c (pty): HPUX has different dir for pty-tty devices. * termcap.c: Don't include types.h or file.h. Sun Feb 2 15:41:39 1986 Richard M. Stallman (rms at prep) * print.c (print): Print a marker's corrected position, not its bufpos. * window.c (Fselect_window): If old and new windows show same buffer, make sure new point is inside the clipping region. Fri Jan 31 13:46:45 1986 Richard M. Stallman (rms at prep) * fns.c (Fload_average): In NLIST_STRUCT case, set nl[1] to 0, not "". Fix KERNEL_FILE and LDAV_SYMBOL for HPUX. Thu Jan 30 14:24:31 1986 Richard M. Stallman (rms at prep) * m-pyramid.h: Turn on NO_UNION_TYPE. * fns.c: For BSD, include sys/param.h Wed Jan 29 17:10:29 1986 Richard M. Stallman (rms at prep) * fns.c (Fload_average): Define a few symbols LDAV_SYMBOL and KERNEL_FILE_NAME and NLIST_STRUCT to use later to simplify the code. * s-usg5.2.h: Turn on `subprocesses'. * sysdep.c: #undef open, read and write at the start. Make sys_read, etc. always available for uses that need a nonaborting read. (select): several bug fixes for system V. (init_sys_modes, child_setup_tty): Init VTIME to a large #, not 0. Use TCSETA, not TCSETAW (why wait?). * process.c: (wait_reading_process_output): if don't HAVE_TIMEVAL and no timeout desired, use 100000 seconds, which the select emulator recognizes. When reading data, if a char is buffered in proc_buffered_char, put it at the front of the data read. (kill_buffer_process): ignore processes really already dead. (init_process): initialize proc_buffered_char to -1 (empty). * keyboard.c (fake_suspend): Don't mess with the SIGCLD handler. Use wait_for_termination to detect subshell termination. (read_avail_input, for USG): Use TCSETA, not TCSETAW; no waiting. * term.c (set_terminal_modes): Don't clear screen here. * xdisp.c (Fredraw_display): Clear screen here instead. Tue Jan 28 01:08:13 1986 Richard M. Stallman (rms at prep) * s-hpux.h: Do #undef SIGIO. * callproc.c, data.c, dispnew.c, emacs.c, keyboard.c, process.c, sysdep.c: Include signal.h before config so can #undef SIGIO in config. * lread.c (read_escape): Make ?\^? produce 0177. * sysdep.c: Define SIGCHLD as SIGCLD only if SIGCHLD not already defined. (select): Don't give select_alarmed an initialization. * unexec.c: For HPUX, copy the peculiar header fields for debugger info. * keyboard.c (kbd_buffer_get_char): Don't call read_avail_input if kbd_count is nonzero. (Don't know how it can be, but it is observed to happen.) * process.c: Define SIGCHLD as SIGCLD only if SIGCHLD not already defined. (wait_handling_process_output):Fill in one non-HAVE_TIMEVAL case. Mon Jan 27 23:20:00 1986 Richard M. Stallman (rms at prep) * sysdep.c (reset_sys_modes): Call unrequest_sigio twice. Make sure FASYNC is clear in old_fcntl_flags. Sun Jan 26 13:25:39 1986 Richard M. Stallman (rms at prep) * fns.c (Frandom): Removed case for number as arg, since it has problems in union-type case and it is not documented or used. * lisp.h (XSET): Fix bugs in the union-type definition. Fri Jan 24 17:42:55 1986 Richard M. Stallman (rms at prep) * process.c: Define macros for accessing the `union wait' structure. * keyboard.c (fake_suspend): Set subshell current dir to current buffer's default dir. Thu Jan 23 00:16:42 1986 Richard M. Stallman (rms at prep) * dispnew.c (Fsit_for): Call gobble_input only if SIGIO exists. * keyboard.c (fake_suspend): Save and restore the SIGCLD handler, if that exists. * process.c (create_process): SKTPAIR-or-not now controls only what to do if cannot use a pty. For USG other than UNIPLUS, instead of sigsetmask (nonexistent), save away and temporarily turn off the SIGCHLD handler. (child_sig): Various USG changes. * sysdep.c (wait_for_termination): Provide case for sysV not UNIPLUS (right for STRIDE at least). * sysdep.c (child_setup_tty): Set the VMIN and VTIME fields. * callint.c (Fcall_interactively): Globalize the variable argfuns, for HPUX's sake. * keyboard.c (fake_suspend): Use execlp, not execl. * sysdep.c (random, srqndom): Add dummy for srandom => srand. Enable both for 4.1 and USG. * fns.c (Frandom): Remove conditional; let those dummies serve. * Makefile: Use sed to remove blank lines and from xmakefile. * ymakefile: Pass alloca.s thru more seds to remove #... lines, etc. Move tparam.o into otherobjs; for HPUX, use terminfo.o instead. No need to conditionalize recipes for xfns.o and xterm.o. No longer need to duplicate the xemacs: line. For HPUX, define LIBBSD. Use that in LIBES. * editfns.c (init_editfns): Handle case of pw == 0 (USER is not a known user). * cm.c: Include config. Make cost and evalcost global. (cmcostinit): Don't pass 0 as string to tgoto (new macro CMCOST). * terminfo.c (new file): Defines a version of tparam for use with terminfo. Wed Jan 22 17:45:40 1986 Richard M. Stallman (rms at prep) * dispnew.c: If HPUX, insert time.h instead of sys/time.h. * sysdep.c: If HPUX, insert time.h instead of sys/time.h. In get_system_name, globalize a static variable `name'. In readdir, globalize `dir' as `dir_static'. Make some system-call imitations "not HPUX". * process.c: If HPUX, insert time.h instead of sys/time.h. Do them only if HAVE_TIMEVAL. If HAVE_PTYS and HPUX, insert sys/ptyio.h. In function `pty', globalize static var `name' as `ptyname'. * term.c: (term_init): If TERMINFO, where tbuf is not used, allocate combuf with size 2044. (evalcost): Flush it. Make it extern and use the one in cm.c. * dired.c: Include stat.h before config.h so config can override S_IFLNK on HPUX (where that symbol exists but there are no symbolic links). Do not include time.h; not needed. * xdisp.c (fmodetrunc, decode_mode_spec): Rename local static buffers buf, tbuf and make them global. Static variables go into initialized data space in HPUX. * fns.c (Fload_average): Similar hack for internal static vars initialized, channel, nl. * lread.c: Change condition for defining X_OK to be that X_OK is not defined. * alloc.c (init_alloc_once): Fix erroneous names data_bytes_{un,}used inside the VIRT_ADDR_VARIES conditions. * emacs.c: Don't include time.h or resource.h; just #define PRIO_PROCESS. * xdisp.c (redisplay_window): Don't shift window-start to avoid end of buffer unless window contents have changed too. * xdisp.c (DoDsp): If nothing has changed except minibuffer message, no need to call redisplay_window. * Problem: standard sysV has no file ioctl.h. * process.c, keyboard.c, dispnew.c, sysdep.c: Include ioctl.h in BSD, termio.h and/or fcntl.h in sysV. * callproc.c: No longer needs ioctl.h; don't include. * xdisp.c: No longer needs ioctl.h or signal.h; don't include. * emacs.c: Include sys/ioctl.h only for BSD. ioctl used only in BSD. Tue Jan 21 22:31:59 1986 Richard Mlynarik (mly at prep) * keyboard.c (EchoThem): Always display an explicit prompt, even if echo_keystrokes == 0 Tue Jan 21 02:34:37 1986 Richard M. Stallman (rms at prep) * keyboard.c (kbd_buffer_store_char, fake_suspend): Take the STRIDE code for subshell out of kbd_buffer_store_char and call it fake_suspend. Call it from previous place and also from Fsuspend_buffer, on all systems that lack SIGTSTP. Clean the code up a little bit. * process.c: Don't include sgtty.h; no longer needed. Make use of wait3 depend on existence of WNOHANG. * unexec.c: Allow the m- file to override defn of ADDR_CORRECT (m-stride.h does). Have and use pagemask to round data_start in COFF case too. Always define getpagesize as macro, for 4.1 and USG where it is not provided as a system call. This takes care of the STRIDE changes for unexec. * ymakefile: Give ld the arg $(STARTFLAGS), and define that based on cpp macro TEXT_START_ADDR when that is defined. This is for systems where the -T switch is necessary. * unexec.c (make_hdr): Make one sun3 fix machine-independent. (Prevent a_bss from being negative). * casefiddle (casify_region): New flag value CAPITALIZE_UP which is like CAPITALIZE but changes only the initials. Function upcase_initials_region is an interface to this mode. * abbrev.c (Fexpand_abbrev): Use upcase_initials_region. * process.c (create_process): Install Fish's other new UNIPLUS conditionalization on the hackery for xforkin, etc. Mon Jan 20 11:50:13 1986 Richard M. Stallman (rms at prep) * fns.c (Frandom): Optional arg of t means randomize the seed. This change was really made at some previously time; just changed the doc string now. * eval.c (do_autoload): Bind autoload-queue to avoid loss on recursive autoloads. * xdisp.c (try_window_id): If everything on screen below change is whitespace, don't scroll, and return -2. * dispnew.c (update_screen): Rewrite to avoid dependence on distance between the two arrays PhysScreen and DesiredScreen. Sun Jan 19 19:09:02 1986 Richard M. Stallman (rms at prep) * fns.c (mapcar1): Preinitialize contents of vals, so it won't contain junk to be seen by a GC inside this function. * eval.c (various): Use error, not Fsignal, to report eval-depth-overflow. Previous calls to Fsignal were buggy. Fri Jan 17 18:35:48 1986 Richard Mlynarik (mly at prep) * lread.c (init_obarray): Kludge around losing pyramid compiler. Tue Jan 14 00:30:14 1986 Richard Mlynarik (mly at prep) * window.c (Fdelete_window): When deleting a dummy parent window, don't try to GC buffer stuff. * process.c (list_processes_1): Don't blow out if buffer associated with process is, through some bug I don't understand, killed. * keymap.c (get_keyelt), keyboard.c (Fcommand_execute): Allow (lambda ...) to appear as a key's definition. * m-sun3.h, unexec.c: Sun3 changes from Barry Shein. Fri Jan 10 12:03:46 1986 Richard Mlynarik (mly at prep) * m-stride.h, s-stride.h, crt0.c, fns.c, keyboard.c, process.c, sysdep.c. Changes for STRIDE micro Changes still pending for etc/loadst.c Fsuspend_emacs in keyboard.c is defined to run a subshell under emacs -- perhaps this is a reasonable thing in all wimpy unix versions. Fri Jan 10 08:46:56 1986 Richard M. Stallman (rms at prep) * dispnew.c (update_line): Don't consider spaces at beginning as special if line is highlighted. Avoids losing the inverse-video on leading spaces in mode lines on terminals where erasing does not turn on highlightig (vt100?). * process.c (pty): On UNIPLUS, don't try opening other side. * filelock.l (lock_file_1): If lock file is invalid, delete it and continue. If delete fails, ignore the lock. Thu Jan 9 11:21:36 1986 Richard Mlynarik (mly at prep) * syntax.c: New function check_syntax_table Make Fmodify_syntax_entry take third arg SYNTAX-TABLE, which defaults to current buffer's syntax table. -- doc change in auxdoc.c Rename Fmake_syntax_table FCopy_syntax_table after making it take an arg (default Vstandard_syntax_table) -- retain alias in subr.el Wed Jan 8 08:38:38 1986 Richard M. Stallman (rms at prep) * sysdep.c, term.c (get_screen_size): New function to get screen size from kernel when possible. In sysdep; called from term_init in term.c. Must test this on Sun and on 4.3. * dispnew.c (Fding): Make doc say it terminates kbd macros. Tue Jan 7 13:58:28 1986 Richard Mlynarik (mly at prep) * doc.c (Fsubstitute_command_keys): Insert an explanatory message for "\\{unbound-variable}" Mon Jan 6 16:38:37 1986 Richard Mlynarik (mly at prep) * termcap.c (tputs): Punt if passed (char) 0. Tue Dec 31 07:12:03 1985 Richard M. Stallman (rms at prep) * dispnew.c (Ding): Expand error message for keyboard macro case. * dired.c (Ffile_attributes): Fix documentation error about meaning of ctime. Sat Dec 28 06:39:09 1985 Richard M. Stallman (rms at prep) * callproc.c (Fcall_process): Fix typo in name synch_process_pid. Fri Dec 27 11:45:50 1985 Richard M. Stallman (rms at prep) * s-unipl5.2.h: Define HAVE_SELECT. * ymakefile (xemacs): If the commands are conditional, the target/dependencies line must be conditional also. Fri Dec 20 01:15:53 1985 Richard M. Stallman (rms at prep) * print.c (printchar, strout): If output stream is Qt and noninteractive, don't do the usual interactive output stuff. In strout, avoid changing i so do not truncate the output. Thu Dec 19 04:43:10 1985 Richard M. Stallman (rms at prep) * fns.c (merge): Don't assume args are consecutive; GCPRO each one separately. * insdel.c (make_gap): Was adding k bytes of gap; k is supposed to be new desired amount of gap. Wasted a lot of memory! * alloc.c (malloc_warning): Passing Fprinc to internal_with_output_to_temp_buffer loses since Fprinc needs 2 args. Use intermediate function malloc_warning_1. Wed Dec 18 00:27:50 1985 Richard M. Stallman (rms at prep) * filelock.c (lock_if_free): kill failing means lock is free only if errno is ESRCH. * fns.c (Fy_or_n_p, Fyes_or_no_p): Call Fdiscard_input if user gives invalid answer. Tue Dec 17 00:20:03 1985 Richard M. Stallman (rms at prep) * eval.c (apply_lambda): Do debug-on-exit here, because if we return to Feval the stack vector of evaluated args will be deallocated by then. * sysdep.c (wait_for_termination): Add new variable wait_debugging. Set it nonzero to make this function work in a way that works under dbx. * process.c (send_process_1): If not all the data is written, try again to write the rest. Eliminate the alarm stuff, including send_process_alarm. Call report_file_error if write returns negative. Sun Dec 15 20:20:10 1985 Richard M. Stallman (rms at prep) * alloc.c (init_alloc_once): Stop looping if shift produces 1, as well as if produces 0. Sat Dec 14 22:24:33 1985 Richard M. Stallman (rms at prep) * editfns.c (Fregion_{beginning,end}): New Lisp primitives, needed for the things that are put on the command history for "r" arguments. * callint.c (Fcall_interactively): If an argument was point or mark, represent it with a suitable expression (point) or (mark) in the command history element. Also adjust for changed calling conventions of quotify_args. * callint.c (quotify_arg): Take one arg; return it if constant, else return a quote-expression for it. * callint.c (quotify_args): Don't exempt the first arg. Use quotify_arg to do the work. Fri Dec 13 01:23:23 1985 Richard M. Stallman (rms at prep) * fileio.c (Fdo_auto_save): Use message1 to output "Auto-saving..." so do not clobber the old message to be restored at end. Thu Dec 12 18:43:31 1985 Richard M. Stallman (rms at prep) * syntax.c: After turning on immediate_quit, must do QUIT; * callproc.c (Fcall_process): Quitting out of running subproc did not happen immediately. Added QUIT;s after setting immediate_quit on, removed those after turning it off (not needed there). * lread.c (init_read): Don't put ../lisp on Vload_path if CANNOT_DUMP. * emacs.c (main): If CANNOT_DUMP, load "loadup.el" as soon as enter editor loop unless -nl switch is given. * lread.c (read_list): Don't use Fsetcdr, since might be changing a cell in pure space during initial loadup. Do explicit assign instead. * lisp.h: Define CHECK_IMPURE, to get error if object is pure. * data.c (Fsetcar, Fsetcdr, Faset): Use CHECK_IMPURE instead of old error checking code. * data.c (pure_write_error): New subroutine, called by CHECK_IMPURE. * m-apollo.h: Define VIRT_ADDR_VARIES. * alloc.c: We now load things into pure space even if cannot dump, to speed garbage collection. Turn on Vpurify_flag unconditionally. Give pure its full size unconditionally. Change remaining CANNOT_DUMP and APOLLO conditionals into VIRT_ADDR_VARIES conditionals. Tue Dec 10 00:24:19 1985 Richard M. Stallman (rms at prep) * fns.c: Don't include files for load-average if load-average not supported. * alloc.c: If CANNOT_DUMP, allocate `pure' very small. [This has been undone.] * buffer.c (list_buffers_1): Use 2 spaces minimum only after buffer name; go back to 1 space minimum after size and major mode. * termcap.c: Avoid use of O_RDONLY and index, so no need for explicit dependence on system type. * sysdep.c: Delete definition of `index'. Now it's a macro when nec. * s-usg5.2.h, s-unipl5.2.h: Define index and rindex as macros. * dispnew.c (Fsit_for): Assume select is always available for use. * buffer.c (Fpop_to_buffer): Take second arg and pass as second arg to Fdisplay_buffer. * insdel.c (GapTo): Dump core if bf_p1, bf_p2 don't differ by gap size. * keyboard.c (Fsuspend_emacs): * emacs.c (Fkill_emacs): Both call new subroutine stuff_buffered_input (in keyboard.c) which stuffs a string's contents plus any unused input Emacs has already read. Mon Dec 9 16:33:40 1985 Richard M. Stallman (rms at prep) * fileio.c (Fdo_auto_save): Don't auto save a buffer that is not modified since last real save. * minibuf.c (minibuffer_completion_help_1): Use make_number for args to Findent_to. Omitting make_number always loses on Pyramid, it seems. Sun Dec 8 02:15:35 1985 Richard M. Stallman (rms at prep) * minibuf.c (Fminibuffer_complete_word): If next char not unique, try adding an actual space. If do achieve some completion, replace old buffer text with the completion (in case of different case). Also a little cleanup. * minibuf.c (Ftry_completion): Fix lossage when second completion found is an initial segment of the first one. Sat Dec 7 01:55:18 1985 Richard M. Stallman (rms at prep) * xdisp.c (redisplay_window): Don't use the clause for only-point-has-changed for the minibuffer; loses when redisplaying to bring back minibuffer after an echo area message. * crt0.c: Vax code is now used for tahoe machine also. * alloc.c (init_alloc_once): For APOLLO, set data_bytes_{free,used} to plausible constant values. * eval.c (unautoload): Declare return type Lisp_Object. * filelock.c (lock_file): Check attack with !NULL, not ==. * keymap.c (describe_command): Don't apply NULL directly to result of Fkeymapp. * lisp.h (XSET): Fix type field assignment in union-type case. * process.c (Faccept_process_output): Use XFASTINT around infd field of process. * search.c (signal_failure): Returns type Lisp_Object. * dired.c (Ffile_name_completion): If arg is null string, return null string immediately. Idea is don't want to complete "/foo/" into "/foo/bar" if "bar" is the only file in "/foo/". * minibuf.c (Ftry_completion): Handle correctly scmp returning -1. * alloc.c: Make malloc_sbrk_used and malloc_sbrk_unused not be external if APOLLO. Fri Dec 6 05:09:11 1985 Richard M. Stallman (rms at prep) * emacs.c, keyboard.c, sysdep.c: Rename InitDsp -> init_sys_modes and RstDsp -> reset_sys_modes. * emacs.c (main): Call init_keyboard before init_sys_modes so correct value of interrupt_input is set up. Fixes the mysterious first C-z bug. * minibuf.c: New Lisp variable completion-ignore-case. Affects Ftry_completion and Fall_completions. * emacs.c (main): Don't change C variable `noninteractive' if user sets the Lisp variable `noninteractive'. Thu Dec 5 00:58:54 1985 Richard M. Stallman (rms at prep) * callproc.c (Fcall_process): Close filefd if about to get error. * fileio.c (Finsert_file_contents, Fwrite_region): Set up unwind protect to close file if error happens. * fileio.c (Fcopy_file): Close input file if fail to open output file. * dispnew.c (change_screen_size): Change name from ChangeScreenSize. Do set_terminal_window (0); after changing height. * indent.c (vmotion & callers): Take window as fifth arg. All callers pass window being displayed or selected window. If window is minibuffer, knows that first line starts at hps = minibuf_prompt_width. * minibuf.c (read_minibuf{,_string_unwind}): Save and restore minibuf_prompt_width. * xdisp.c: (display_text_line): set minibuf_prompt_width if display the prompt. (various): Pass window being displayed as arg to vmotion. (various): Compute starting-hpos arg to compute_motion using minibuf_prompt_width if in minibuf starting at top. * window.c (Fdisplay_buffer & callers): Take second arg, non-nil means do not use selected window even if that already contains specified buffer. * buffer.c (Fpop_to_buffer): Pass t as second arg to Fdisplay_buffer. * buffer.c (list_buffers_1): Make at least two spaces between all fields on a line. Wed Dec 4 18:34:16 1985 Richard M. Stallman (rms at prep) * xfns.c: Define Fx_pop_up_window. Use make_string, not Fmake_string, in x-get-cut-buffer. Mysterious change from Martillo in Fx_change_display. Rename variable mouse-pos to x-mouse-pos. * xterm.c: Changes from Martillo. Change mouse command to C-c C-m. * term.c (calculate_costs): Return immediately if dont_calculate_costs is set. * lread.c (Fintern, Fintern_soft): Don't allow a symbol as argument to intern or intern-soft. Wed Dec 4 15:05:58 1985 Richard Mlynarik (mly at prep) * editfns.c (Fsubst_char_in_region): Typo. Tue Dec 3 22:48:19 1985 Richard M. Stallman (rms at prep) * fileio.c (Fdo_auto_save): Always restore old minibuf message if any. * alloc.c (Fgarbage_collect): Always restore old minibuf message if any. Truncate command-history to 30 elements. Add some register decls. Tue Dec 3 13:59:34 1985 Richard Mlynarik (mly at prep) * lread.c (Fload): Suppress "Loading %s... done" if noninteractive * alloc.c (Fgarbage_collect): Suppress "garbage collecing..." message if noninteractive. * regex.c (re_compile_pattern): Fix error message (double "\"'s for c compiler) Tue Dec 3 05:10:18 1985 Richard M. Stallman (rms at prep) * editfns.c (Fsubst_char_in_region): If 5th arg is non-nil, don't record for undo. Mon Dec 2 22:02:32 1985 Richard M. Stallman (rms at prep) * unexec.c (copy_sym, make_hdr): Pass file names to these functions. Use PERROR properly, with filename as arg. * window.c (Fdelete_window): Don't let stretching the siblings delete them. * window.c (set_window_{height,width}): Make `nodelete' apply to children as well. Thu Nov 28 20:00:23 1985 Richard M. Stallman (rms at prep) * indent.c (compute_motion): Omit one register decl if TAHOE_REGISTER_BUG. * m-tahoe.h: New file. Wed Nov 27 18:54:08 1985 Richard M. Stallman (rms at prep) * sysdep.c (RstDsp): Do TIOCSETC before doing fcntl F_SETOWN. Note: bizarre bug exists: Fsuspend_emacs in impure temacs under vax 4.2 gets stopped in that TIOCSETC; but in dumped Emacs, that does not happen. No idea why. This change did not fix it. * keymap.c (describe_buffer_bindings): Avoid passing a null pointer to InsStr. * xterm.c: Many random bug fixes from Martillo. * xfns.c: Bug fixes in Fx_change_display. New function Fx_set_icon. Fx_set_bell must take 1 arg, not 0. Fx_set_window_edges: don't set window size if new size same as old. * term.c, termchar.h: Define variable `dont_calculate_cost's: If set nonzero, `calculate_costs' is not called. Mon Nov 25 02:24:17 1985 Richard M. Stallman (rms at prep) * sysdep.c, keyboard.c: Clean up USG simulation of FIONREAD. In keyboard.c, new function read_avail_input reads all input now in system buffer into kbd_buffer. get_pending_input is moved to keyboard.c, and works using read_avail_input when FIONREAD is not defined. select emulator in sysdep also uses read_avail_input. * unexec.c: Make PERROR do a return, in non-emacs version. Remove explicit returns following PERRORs. Replace ERROR with ERROR0, ERROR1 and ERROR2 which pass along message and args to report_error_1. Make those macros do a return, in non-emacs version. * process.c (wait_reading_process_output): If read_kbd is 10 + I, don't read kbd, but don't return until input has arrived from channel I. * process.c (Faccept_process_input): New Lisp function. Sun Nov 24 01:55:42 1985 Richard M. Stallman (rms at prep) * unexec.c: Close output descriptor if get an error. Sat Nov 23 00:19:17 1985 Richard M. Stallman (rms at prep) * termcap.c (tgetstr): Supply second arg in call to tgetstr1. Fri Nov 22 16:28:30 1985 Richard M. Stallman (rms at prep) * s-bsd4.3.h: Undefine INTERUPT_INPUT. Noninterrupt input should work properly given LPASS8 and LNOFLUSH. * dispnew.c, keyboard.c (Fset_input_mode): Move it from dispnew.c to keyboard.c. * sysdep.c (InitDsp): Use LNOFLUSH in BSD. * term.c (topos): Call hook before checking curY and curX. Fri Nov 22 12:40:41 1985 Richard Mlynarik (mly at prep) * fileio.c (Frename_file): Supply third arg to Fcopy_file Fri Nov 22 00:55:56 1985 Richard M. Stallman (rms at prep) * keymap.c (push_text_char_description): Represent ESC by ^[, not $. Wed Nov 20 20:27:55 1985 Richard M. Stallman (rms at prep) * minibuf.c (read_minibuf): Make Vminibuffer_help_form do its intended job. Use alloca to get the space for the prompt. Wed Nov 20 08:00:18 1985 Richard Mlynarik (mly at prep) * callproc.c (Fcall_process_region): Documentation fix (why isn't this function written in lisp?) * minibuf.c (read_minibuf) Use MScreenWidth Wed Nov 20 00:09:13 1985 Richard M. Stallman (rms at prep) * tparam.c (tparam): Don't pass `left' or `up' to strcat if it is null. * cmds.c (SelfInsert): Split register arg c into arg c1 and register local c. Using & on a register argument happens to work on vax. Tue Nov 19 19:10:48 1985 Richard M. Stallman (rms at prep) * xdisp.c (try_window_id): If change is on top line and display is not starting at a real line-beginning, give up so real scrolling is done. Return -1, which now tells redisplay_window not to try slow redisplay with the same window start. Mon Nov 18 17:45:32 1985 Richard M. Stallman (rms at prep) * m-apollo.h: New file. Use with s-bsd4.2.h? * data.c (Fsetcar, Fsetcdr, Faset): Conditionalize checks for existing objects being pure on CANNOT_DUMP. * alloc.c (mark_object, Fpurecopy): Conditionalize checks for existing objects being pure on not CANNOT_DUMP. Don't turn on Vpurify_flag if CANNOT_DUMP. * emacs.c (Fdump_emacs): Conditionalize existence of function on not CANNOT_DUMP. * lread.c (read_list, intern): Avoid using a conditional expression to compute function to call. Conditionalize the entire call (pure_cons vs Fcons or make_pure_string vs make_string). * syntax.c (scan_sexps_forward (case Sopen)): Changed around curlevel++->last since Apollo C compiler loses. * lisp.h: Define VALBITS and GCTYPEBITS inside #ifndefs so config.h can override them. * fileio.c (Fexpand_file_name, Fsubstitute_in_file_name): APOLLO conditionals to consider // at start of file name legitimate. * ymakefile: Make mention of alloca.o be conditional on not APOLLO. Make -lg conditional likewise. Fri Nov 15 18:17:10 1985 Richard M. Stallman (rms at prep) * ymakefile, read.c: Rename read.* to lread.* to avoid trouble with #define read sys_read. Thu Nov 14 15:55:53 1985 Richard M. Stallman (rms at prep) * New files xfns.c, xterm.c for X window system. xfns contains Lisp subrs for interacting with X. TrmTERM.c is eliminated. * ymakefile: Make compilation and loading of xterm.o and xfns.o conditional on HAVE_X_WINDOWS. * term.c, termhooks.h: Define fix_screen_hook. * process.c (wait_handing_process_output): Call the terminal's fix_screen_hook, if one is set up. * keymap.c: Define and initialize MouseMap, a keymap for mouse commands. * emacs.c (main): Call syms_of_xfns. * dispnew.c (init_display): For X window system terminals, call x_term_init. * buffer.c: Flush Lisp variable buffer-number. Wed Nov 13 00:33:57 1985 Richard M. Stallman (rms at prep) * term.c (term_init): For c100, do not set TS_set_window if termcap entry gives one or if the :ti string fails to fix the screen at the top of the display memory. * nearly every file changed. * New macro XSET to set both fields of a Lisp_Object. Most places where XSETTYPE was used, followed by setting the pointer field, now use XSET. * Many uses of wrong_type_argument replaced with use of CHECK_*, including new CHECK_MARKER. * Other uses of wrong_type_argument fixed so value returned gets used in place of the invalid object. Also, the third argument was deleted. * New functions xmalloc and xrealloc signal an error if memory is not available. Many calls to malloc and realloc are replaced with them. * Some unused variables' declarations have been flushed. * Some register declarations have been added. * alloc.c: New functions xmalloc and xrealloc. * process.c: (pty): Flush unused variable. Return 0 at end. (list_processes):New buffer tembuf for sprintf to use. (send_process_trap): Flush unused arg. (sig_process): Rename arg `signal' to `signo'. * read.c: Avoid `file' as variable name for lint's sake. * sysdep.c: Compile stuff_char only if SIGTSTP exists. Changed conditionals within stuff_char. Compile wait_without_blocking only if no subprocesses. Pass one arg (zero) to `wait'. Include old_fcntl_flags in #ifdef FASYNC condition. Put old_fcntl_owner inside #ifdef F_SETOWN condition. Don't compile end_of_text and end_of_data. Delete definitions of readlink and symlink; their callers should not exist when system doesn't have symlinks. * term.c: Don't give the impression that hooks' values are supposed to be returned. * userid.c: Entire file commented out; supposedly not used. * dispnew.c: Comment out preserve_my_columns, not used. Clean up conditionals in Fsleep_for and Fsit_for. * doc.c: Fix incorrect args to describe_map_tree. * eval.c: Flush Ffunction_type. Make Fautoload override an existing autoload definition. wrong_type_argument: check the user's new value and get error again unless it fits the predicate. * minibuf.c: Comment out Fread_function, not used. Tue Nov 12 17:50:26 1985 Richard M. Stallman (rms at prep) * keymap.c: Comment out synkey, which nobody calls. * lisp.h: Define XSET (var, type, ptr) to set both fields of a var. Use it in DEFSIMPLE. Remove extern decls of non-ex functions; fix dot -> point. Remove incorrect decl of staticprolist. * fns.c (Flength): (concat2, nconc2): Add /* ARGSUSED */ for lint. * fileio.c: A few declarations for lint's sake. Make alias file-readable-p for file-exists-p. Mon Nov 11 00:22:49 1985 Richard M. Stallman (rms at prep) * emacs.c (Fkill_emacs): Return arg as exit code if arg is numeric even if interactive. Rearrange code to make it smaller. * callint.c (Fcall_interactively, case 'v'): Use Fread_variable. * tparam.c (tparam): Rename %s as %f. Sun Nov 10 20:31:12 1985 Richard M. Stallman (rms at prep) * read.c (Fload): Rename closefile to load_unwind. New boolvar load-in-progress, set to t while loading, nil otherwise. * term.c (clear_end_of_line): Correct first_unused_hpos by chars_wasted, since curX is corrected. Set chars_wasted to zero if about to erase a standout marker. * term.c (write_standout_marker): Do write the end-standout marker even when sg#0. Sat Nov 9 17:56:49 1985 Richard M. Stallman (rms at prep) * term.c (set_scroll_region): Change parameters given to the `cs' string to adjust for changed effect of %i. * tparam.c (tparam): %i now increments two args, not just one. Redefine %a somewhat, as will be described in termcap.texinfo. Fri Nov 8 17:09:22 1985 Richard Mlynarik (mly at prep) * emacs.c (Fkill_emacs): arg default is 0 if noninteractive, nil if interactive * minibuf.c (Fread_variable): Only recognize symbols that are user-variable-p. Fri Nov 8 15:03:26 1985 Richard M. Stallman (rms at prep) * sysdep.c (init_display): Turn on LPASS8 if it is defined. Gives 8-bit input in CBREAK mode. Wed Nov 6 16:57:57 1985 Richard M. Stallman (rms at prep) * sysdep.c (get_input_pending, select): Provide alternate code for USG without FIONREAD. I suspect it does not really work, though. * fns.c (Fload_average): If LOAD_AVE_TYPE is not defined, just get an error, and allow LOAD_AVE_CVT to be undefined as well. * m-dual.h: Don't define LOAD_AVE_TYPE or LOAD_AVE_CVT. Tue Nov 5 16:23:34 1985 Richard Mlynarik (mly at prep) * print.c (print): Hack deleted buffers. Mon Nov 4 19:55:17 1985 Richard M. Stallman (rms at prep) * syntax.c (describe_syntax_1): Return type Lisp_Object and value Qnil. Mon Nov 4 01:20:12 1985 Richard Mlynarik (mly at prep) * minibuf.c (Fread_variable): Choose amongst user-variable-p frobs rather than boundp ones Sat Nov 2 18:34:53 1985 Richard M. Stallman (rms at prep) * window.c (window_scroll): Get error if try to scroll back when at top. * window.c (Fscroll_down, Fscroll_up): Share new subroutine scroll_command to compute amount to scroll by. Fri Nov 1 18:29:45 1985 Richard M. Stallman (rms at prep) * dispnew.c (Fset_input_mode): Always set interrupt_input to 0 when SIGIO is undefined. * keyboard.c (gobble_input, input_available_signal, kbd_buffer_store_char): Make these functions exist only if SIGIO is defined. Wed Oct 30 16:27:57 1985 Richard M. Stallman (rms at prep) * sysdep.c (select): Use signal, not sigset, since we simulate signal on all system versions when nec. * buffer.c (syms_of_buffer, init_buffer_once, reset_buffer_local_variables): Define default-abbrev-mode, and init new buffers' abbrev-mode from it. Move definition of abbrev-mode here from abbrev.c. * print.c (Fmessage): Simplify it by using `message' to do the output. * alloca.s: Provide alloca for 3b5. Wed Oct 30 12:33:38 1985 Richard Mlynarik (mly at prep) * editfns.c, print.c (Fmessage): Move Fmessage from editfns to print If noninteractive, do not truncate message at all. If interactive truncate at MScreenWidth (not at 100) * alloc.c (mark_buffer): Catch a few places which should have been marked but weren't * buffer.h, abbrev.c, cmds.c, xdisp.c abbrev_mode is buffer-local (like all other minor modes) Tue Oct 29 19:09:51 1985 Richard M. Stallman (rms at prep) * sysdep.c (wait_for_termination): Install case for 4.1 with subprocesses. Realize that what was thought to be that was really for no subprocesses; fix it up to avoid using synch_process_pid since child_sig won't maintain that. * read.c (Fload): If arg is empty string, just get error; don't try to open any file. * eval.c (internal_condition_case): Before unwinding after throw, remove any backtrace frames, catches or handlers that are in stack frames that have been exited, * window.c (save_window_restore): If saved state uses a dead buffer, don't use Fother_buffer to find a buffer to use instead, since that can call Fnext_window and the window hierarchy might be malformed at that time. * fns.c (Fequal): Markers are equal if they point at the same place. Tue Oct 29 10:01:32 1985 Richard Mlynarik (mly at prep) * fns.c (Frequire): Don't print message whilst loading required file. Tue Oct 29 02:34:59 1985 Richard M. Stallman (rms at prep) * syntax.c (scan_lists): Initialize mathexit. Mon Oct 28 18:00:46 1985 Richard M. Stallman (rms at prep) * process.c (child_sig): Rename `dead_pid' to `synch_process_pid'. Remove conditionals around calls to deactivate_process. * callproc.c (Fcall_process): In 4.1, store the pid in synch_process_pid. * sysdep.c (wait_for_termination): Add case for 4.1 (only with subprocesses) waiting for synch_process_pid to be zeroed by child_sig. * crt0.c: Add version for the orion machine. * data.c (arith_error): In 4.1, do sigrelse to reallow arith error signals. * read.c (read_escape): After C-, don't clear meta bit of what follows. Sun Oct 27 15:58:30 1985 Richard M. Stallman (rms at prep) * m-*.h: Define SIGN_EXTEND_CHAR for all machines. Sat Oct 26 01:42:09 1985 Richard M. Stallman (rms at prep) * xdisp.c (display_mode_line): If window is not full width but its parent is, display the mode line in inverse video. * cmds.c (SelfInsert): Call the blink paren hook for syntax class $ also. * eval.c (Fautoload): Accept fifth arg, non-nil meaning function will be a macro once it is loaded. * eval.c (Fmacroexpand): Autoload anything that will be a macro once loaded. If a symbol's definition is a symbol that is a macro, expand either one seen. Wed Oct 23 00:42:43 1985 Richard M. Stallman (rms at prep) * eval.c (Fthrow): If TAG is nil, always say it is not found, to avoid interference with condition-case, which uses nil as catch tag. * print.c (PRINTPREPARE & uses): Don't change print_depth in PRINTPREPARE; those callers for which it matters now do it themselves. *print.c (print): Do QUIT; at the beginning. Also in string and symbol loops. * window.c (set_window_{height,width}): In args to recursive calls, use XINT, not XFASTINT. Perhaps a "too small" window could have negative size. * window.c (change_window_height): Fix calls to sizefun and setsizefun to dereference first. * window.c (save_window_restore): Make it return a Lisp_Object. * fns.c (concat & callers): New arg last_special which if non-0 says don't copy last arg. Only Fappend supplies it as nonzero. * keyboard.c (Fsuspend_emacs): Take already-read input and stuff it. * fileio.c (Ffile_directory_p, Ffile_modes): Remove final slash from file name before doing stat. In 4.2, final slash can cause wrong result if file is read-protected. Tue Oct 22 12:08:57 1985 Richard Mlynarik (mly at prep) * eval.c (Fcondition_case): Add some error-checks to condition-case; prevent core-dump when handler list is illegal. * keyboard.c (cmd_error): Do the file-error hack for conditions including file-error, not just file-error itself. * callint.c (Fcall_interactively): Quotify car of command-history in (interactive ) case New function quotify_args to do the work. * fns.c (Fnconc): typo: wrong_type_arg called with Flistp, not Qlistp Tue Oct 22 03:21:59 1985 Richard M. Stallman (rms at mit-prep) * process.c (Fset_process_buffer, Fstart_process): Allow a process's buffer to be nil. Mon Oct 21 01:49:43 1985 Richard M. Stallman (rms at mit-prep) * window.c (Fscroll_{left,right}): Default arg is now window width minus 2. * search.c (Freplace_match): If not literal, make \ always an escape. Thus two \'s are needed for one literal one. * data.c (wrong_type_argument): Eliminate third arg from function and its explicit callers. * window.c (Fpos_visible_in_window_p): Provide missing tab_offset arg to compute_motion. * xdisp.c (init_xdisp): Provide missing 3rd arg to set_window_height. * fileio.c (e_write): Make it really return -1 if write doesn't write everything. * data.c (Fsymbol_{function,value}): Replace Qvoid_symbol condition with two conditions Qvoid_{variable,function}. No longer pass boundp or fboundp as part of the extra info, since would be redundant. Fri Oct 18 18:58:01 1985 Richard M. Stallman (rms at mit-prep) * editfns.c (Fformat): Remove limit on length of output. * doprnt.c (doprnt): Rearrange so can handle %2s, etc. Thu Oct 17 00:10:53 1985 Richard M. Stallman (rms at mit-prep) * process.c: Define sys_siglist for 4.1, which doesn't provide one. Use new flag HAVE_PTYS to enable compilation of `pty' and of some code in `create_process'. Flist_processes: omit unused third arg to Findent_to. create_process: Omit some code for ptys unless HAVE_PTYS. Provide 4.1 alternatives for sigsetmask. wait_reading_process_input: If not HAVE_TIMEVAL, provide alternative code using ints. Handle failure of FIONREAD. send_process_trap: In 4.1, release SIGPIPE and SIGALRM. sig_process: check current_group for nil or not, rather than 0 or not. count_active_processes: get rid of arg `buffer' which was unused. child_sig: strange hacks with dead_pid for 4.1. Hold and release SIGCHLD in 4.1. Do not call deactivate_process in 4.1 (puzzles me). * sysdep.c: Omit fcntl.h under 4.1. get_input_pending: return 0 if input not a tty. discard_terminal_input: do nothing if batch mode. stuff_char: err instead of aborting on system V. init_baud_rate: always set ospeed = 0 if batch mode. InitDsp: turn ANYP on rather than off. Make lmode global. In 4.1, turn on LINTRUP if interrupt_input. child_setup_tty: in 4.1, clear LINTRUP in the child. tabs_safe_p: always say tabs are safe if batch mode. RstDsp: In 4.1, turn off LINTRUP if interrupt_input. setpriority: define as noop for 4.1. request_sigio: for 4.1, turn on LINTRUP. unrequest_sigio: for 4.1, turn off LINTRUP. * read.c (readevalloop, read_list, read_vector, intern): Dereference expressions of type pointer-to-function before calling. * read.c (hash_string): Use unsigned char, not char, for strings. * read.c (map_obarray): Expect function to be mapped to return int, not Lisp_Object. * undo.c: Include lisp.h before undo.h. * unexec.c: Introduce ADDR_CORRECT. Apply it to supplied values for bss_start and data_start, and to values returned by sbrk. Use NBPG instead of getpagesize () in BSD4.1. Use char *'s for ptr and end in copy_text_and_data. * print.c (print): Remove unused fourth arg from recursive calls. * minibuf.c (Fminibuffer_complete{,_and_exit}): Copy function value into variable before switching on it. (Direct way loses on orion). * s-*.h: Define HAVE_SELECT and NONSYSTEM_DIR_LIBRARY where appropriate. Reorder the flags, and make all the s- files look parallel. * keyboard.c: Define new constructs sigfree, sigholdx, sigblockx, sigunblockx, sigpausex which do one thing in 4.1 and another in 4.2. In 4.1, use SIGTINT as if it were SIGIO. * keyboard.c (getchar, interrupt_signal): Don't omit the arg DoDsp or Fdo_auto_save wants. * keyboard.c: (echo_them, input_available_signal): Put in hair for 4.1 for interfacing with select emulation. * keyboard.c (top_level_1): * macro.c (pop_kbd_macro): Must have type Lisp_Object, and return a valid one. * keymap.c (describe_{vector,alist}): Expect elt_describer to return int, not Lisp_Object. Dereference that variable before calling it. * keymap.c (apropos1): Must have type Lisp_Object, and return a valid one. * syntax.c (describe_syntax): Make it return type int, and don't bother about what int. * search.c (search_buffer): If fwd, require match to end not beyond search limit. Wed Oct 16 00:44:24 1985 Richard M. Stallman (rms at mit-prep) * alloc.c: New vars data-bytes-{used,free} that ref malloc_sbrk{,un}used. * editfns.c (save_{excursion,restriction}_restore): Must have type Lisp_Object, and return a valid one. * editfns.c (format1): Handle NO_ARG_ARRAY case. * eval.c (internal_catch, internal_condition_case, unbind_to): Dereference variables of type pointer-to-function before calling. * eval.c (Fautoload, call1, call2, call3): If NO_ARG_ARRAY, don't assume that consecutive args can be treated as an array. Copy them into another array. * fileio.c (barf_or_query_if_file_exists): Fix paren error. * fileio.c (Fcopy_file): Use chmod instead of fchmod on 4.1bsd as well as usg. * fileio.c (Frename_file, Fmake_symbolic_link, Fadd_name_to_file): If NO_ARG_ARRAY, don't assume that consecutive args can be treated as an array. Copy them into another array. * fileio.c (Frename_file): In 4.1bsd, use link and unlink, since don't have rename. * fileio.c (Fmake_symbolic_link): Eliminate this if S_IFLNK not defined. * fileio.c (Ffile_symlink_p): Always return nil if S_IFLNK not defined. * fileio.c (auto_save_error, auto_save_1): Must have type Lisp_Object, must really return something. * fns.c (concat2, nconc2): If NO_ARG_ARRAY, don't assume that consecutive args can be treated as an array. Copy them into another array. * fns.c (Frequire): Was calling Fload with only 1 arg. Pass 2 extra nil's. * fns.c (Fload_average): If FIXUP_KERNEL_SYMBOL_ADDR is defined, must detect if address of _avenrun is not abs, and fix it up if so. * indent.c (position_indentation): Add parens in nested ?...: for clarity. * sysdep.c: Add opendir, closedir and readdir, if NONSYSTEM_DIR_LIBRARY. * unexec.c: Add some definitions for case of USG and not COFF. These define the BSD names for hdr components in terms of pre-BSD names. * sysdep.c, editfns.c, s-*.c: Use (new) get_system_name (defined in sysdep) to get system name in init_editfns. No more need for SYSTEM_NAME and SYSTEM_NAME_DECL. * sysdep.c (select): Use not HAVE_SELECT as condition to define this. * keyboard.c: Get error instead of croaking if want to send SIGTSTP. Get compile time error in gobble_input if SIGIO is not defined. * emacs.c: Always include types.h. Omit time.h and resource.h in 4.1. * dispnew.c (Fsit_for, Fsleep_for): Rearrange conditionals to use only HAVE_TIMEVAL and (new) HAVE_SELECT. * dired.c: Flush NO_DIR_LIBRARY case. If NONSYSTEM_DIR_LIBRARY, use "ndir.h" which will come with Emacs. * alloca.s, crt0.c: Check m68000 flag only if m68k flag is not defined. * fileio.c (Finsert_file_contents): Set up for this to be undone. Tue Oct 15 17:10:26 1985 Richard M. Stallman (rms at mit-prep) * syntax.c (Fmodify_syntax_entry): Use %s rather than %c in interactive string. * callint.c (Fcall_interactively): For arg read with code `c', convert as char to a string for use in prompting for future args. * keymap.c (describe_{map,map_tree,vector,alist}): All take additional arg PARTIAL which, if nonzero, means check each definition for a `suppress-keymap' property and ignore it if property non-nil. * keymap.c (describe_bindings): * doc.c (Fsubstitute_command_keys): * syntax.c (describe_syntax): Pass zero or 1 as PARTIAL arg to those functions. * filelock.c: Use PATH_SUPERLOCK as name of superlock file, and PATH_LOCK as name of lock directory. * paths.h, paths.h.dist: Define those two. * callproc.c (Fcall_process): Always try opening program before forking. Mon Oct 14 19:09:51 1985 Richard M. Stallman (rms at mit-prep) * Makefile: Now it takes ymakefile, passes it thru cpp to get xmakefile, then runs `make' on that. ymakefile is the old Makefile. All comments now are within /*...*/, and #ifdef's are used to select the flags and libraries to be used. * s-*.h: Define new macro SYSTEM_NAME_DECL which does any global declarations needed to prepare for using SYSTEM_NAME. The flag ASSEMBLY is no longer needed to prevent s-*.h from doing anything besides defining macros. * editfns.c: Use SYSTEM_NAME_DECL. * alloca.s: No longer need to define ASSEMBLY. * eval.c (apply_lambda, funcall_lambda): Flush "e support. Fri Oct 11 02:20:20 1985 Richard M. Stallman (rms at mit-prep) * fileio.c (Frename_file): If fails due to moving across devices, copy and delete old file. * keymap.c (insert_first_line): If the first line contains `\[', pass the string thru substitute-command-keys and try again. Thu Oct 10 18:36:30 1985 Richard M. Stallman (rms at mit-prep) * Makefile: Define new parameter LDFLAGS, and make more use of LIBES. Have new code to define their values for various systems. * sysdep.c, s-unipl5.2.h: Define MAXPATHLEN here if not def by system. Do not define it in s- files. * keyboard.c (interrupt_signal): In system V, cannot actually stop, but do offer to auto-save or abort. * dired.c: Do not include dir.h if including ndir.h. Wed Oct 9 23:04:59 1985 Richard M. Stallman (rms at mit-prep) * fileio.c (Fsubstitute_in_command_name): Simplify /~ and // if produced as result of variable substitution. Tue Oct 8 01:37:22 1985 Richard M. Stallman (rms at mit-prep) * fns.c (concat): Failed to initialize data type of `len'. * editfns.c (Fregion_to_string): Delete it. Put it in mlsupport.el. * search.c (Fregion_around_match): Delete it. Put it in mlsupport.el. * syntax.c (scan_lists): Fix bug of ignoring the character before a comment-start pair when parsing backward. Also don't consider /*/ a complete comment. * dispnew.c (Fsit_for): Use simulator for select, if not HAVE_TIMEVAL. * dispnew.c (ChangeScreenSize): Pass zero as third arg to set_window_{height,width}. * dispnew.c (update_screen): Detect failure of ioctl TIOCOUTQ. * dispnew.c: Don't use fcntl.h; appears not to be needed. * dired.c: Handle fact that 4.1 has no symbolic links, just like sysV: Make conditionals check S_IFLNK rather than USG. Also, check new flag NONSYSTEM_DIR_LIBRARY which 4.1 will set. * cm.c (cmcostinit, cmgoto, cmputc): Make these the names of the functions that do the work instead of macros going through variables that might fail to be set up. Mon Oct 7 16:18:06 1985 Richard Mlynarik (mly at mit-prep) * print.c (print) No need to escape symbols + and - if not followed by digits Mon Oct 7 01:30:33 1985 Richard M. Stallman (rms at mit-prep) * filelock.c: New file containing stuff to handle locking files while they are being edited. * buffer.c (Fset_buffer_modified_p): Lock or unlock the visited file accordingly. * buffer.c (Fdelete_buffer_internal) Unlock the visited file. * fileio.c (Fread_file_contents): Mark buffer as modified using modify_buffer. If visiting, unlock old and new visited files. * fileio.c (Fwrite_region): Lock file to begin with; unlock on error or when done. * undo.c (Fundo_more): Unlock file if undoing makes buffer unmodified. Sun Oct 6 00:02:31 1985 Richard M. Stallman (rms at mit-prep) * dired.c (file_name_completions): If looking for list of all completions, don't ignore any. Do this by starting with passcount = 1. Sat Oct 5 23:53:21 1985 Richard M. Stallman (rms at mit-prep) * xdisp.c (message): Use doprnt instead of sprintf: prevent overflowing buf. * xdisp.c (decode_mode_spec): Protect against overflowing tbuf even if strings are clobbered and have negative length. Wed Oct 2 01:39:36 1985 Richard M. Stallman (rms at mit-prep) * insdel.c (delete_range): Must immediately relocate markers into deleted text. Otherwise if an insertion follows they may end up pointing into the middle of it. Tue Oct 1 23:39:57 1985 Richard M. Stallman (rms at mit-prep) * dispnew.c, xdisp.c, minibuf.c: cursX and cursY are now origin zero. last_point_x and last_point_y of a window, likewise. * term.c (set_scroll_region, term_init, calculate_costs): New "cS" string, in TS_set_scroll_region_1, accepts four params suitable for handling aaa's \E[...p cmd. Mon Sep 30 16:20:12 1985 Richard M. Stallman (rms at mit-prep) * xdisp.c (redisplay_window): Don't clobber the point value of the buffer being redisplayed. Make sure the displayed point value is inside the buffer bounds; correct it if not. * term.c (reassert_line_highlight): Define reassert_line_highlight_hook, and call it. * dispnew.c (direct_output_for_self_insert): Call reassert_line_highlight. Sun Sep 29 12:51:50 1985 Richard M. Stallman (rms at mit-prep) * print.c (print): Fix one-off bug in Vprint_length; one element too few used to be printed. * fileio.c (Fread_file_name_internal): Avoid error when spec'd name has no slashes. Sat Sep 28 13:34:16 1985 Richard M. Stallman (rms at mit-prep) * term.c (clear_to_end, clear_screen): Set cleared lines to the background highlighting state. * read.c (read1): Don't ignore pure doc strings once DOCSTR already parsed. * read.c (readevalloop & callers): Eliminate delayflag feature. * eval.c (do_autoload): Set up unwind-protect un_autoload and bind Vautoload_queue non-nil. This will undo all defuns and provides if the file does not finish loading. * data.c (Fset): If Vautoload_queue non-nil, record function and old definition by consing onto Vautoload_qeueue. * fns.c (Fprovide): If Vautoload_queue is non-nil, record old value of Vfeatures. Fri Sep 27 23:03:08 1985 Richard M. Stallman (rms at mit-prep) * abbrev.c (Fdefine_global_abbrev, Fdefine_mode_abbrev): Convert name to lower case before defining. (Since expansion always does that too.) * buffer.c (init_buffer): Don't add / to end of wd if it ends in / already. * buffer.c (init_buffer_once): Add variable `tem'. Don't call Fcurrent_buffer. Thu Sep 26 15:34:12 1985 Richard M. Stallman (rms at mit-prep) * fileio.c (Fexpand_file_name): Discard through any slash that precedes a tilde. Fri Sep 20 20:24:31 1985 Richard M. Stallman (rms at mit-prep) * fns.c (concat): In the case of append, don't copy or test the last arg. Thu Sep 19 01:37:45 1985 Richard M. Stallman (rms at mit-prep) * keyboard.c (command_loop_1): If minibuffer and echo area both in use, wait 2 sec and redraw minibuffer. * keyboard.c (cmd_error): Remove similar feature for errors only. * read.c (readevalloop and callers): Don't eval any forms until all forms read. * dispnew.c (scrolling): Postpone fixup of free_at_end_vpos until unchanged_at_bottom is set up. * everywhere: Remove many variables not really used. * process.c (count_active_processes): Fix garbage code to ignore, correctly, stopped or dead processes. Tue Sep 17 16:58:21 1985 Richard M. Stallman (rms at mit-prep) * Don't use strings.h (not all Unix versions have it). Declare index explicitly where needed. * sysdep.c: Define select, for 4.1. * s-*.h, sysdep.c: New flag BSTRING says system has bcopy, etc., functions. If not, define them in sysdep.c. * buffer.c: Define MAXPATHLEN if system does not. Pass two args to Fnext_window, as it expects. * abbrev.c (Fdefine_global_abbrev, Fdefine_local_abbrev): Always pass Fdefine_abbrev five args. * term.c (write_chars): Clear error flag of stdout to recover from 4.2 kernel bug. * unexec.c (make_hdr): Remove sun data_start rounding change: round down again. Fri Sep 13 14:31:16 1985 Richard M. Stallman (rms at mit-prep) * minibuf.c (minibuf_completion_help_1): Always indent at least one space between the two function names on a line. Thu Sep 12 23:37:29 1985 Richard M. Stallman (rms at mit-prep) * syntax.h, syntax.c: Define new syntax class Spunct, for punctuation. Acts like whitespace in word and list parsing. Define all non-whitespace that used to be Swhitespace as being punctuation. Wed Sep 11 00:23:10 1985 Richard M. Stallman (rms at mit-prep) * dired.c (file_name_completions): Fix bug matching implicit slash after name of dir against an implicit slash in bestmatch. Tue Sep 10 16:08:40 1985 Richard M. Stallman (rms at mit-prep) * cmds.c (Fnewline): Barf immediately if buffer read only. * doc.c (Fsubstitute_command_keys): If string contains \{VAR}, get value of VAR and describe as keymap. * keymap.c (describe_map_tree): New function to describe a map and all maps reachable from it. * keymap.c (describe_bindings): Describe local bindings first. * abbrev.c (describe_abbrev): Direct final newline to same stream as everything else. Sun Sep 8 17:25:07 1985 Richard M. Stallman (rms at mit-prep) * editfns.c, dispnew.c: Definition of baud-rate moved to dispnew.c. * editfns.c: Functions point{-marker}, point-max{-marker} and point-min{-marker} defined. Old dot- names still exist as aliases. * Pervasive: "dot" changed to "point" in just about everything, including names that contain it, such as SetDot. * callint.c (Fcall_interactively): Make elements of command-history be expressions by quoting each arg that is not self-evaluating. * eval.c (Fsignal, find_handler_clause): If debugger returns, return its value from Fsignal. * All calls to Fsignal: Do something reasonable if Fsignal returns. Often, just return what it returned. `error' still never returns to its caller. * Signalling Qargs_out_of_range: Use new functions args_out_of_range and args_out_of_range_3 (in data.c) to do this. Sat Sep 7 19:26:43 1985 Richard M. Stallman (rms at mit-prep) * search.c (compile_pattern & callers): Must recompile even the same string if translate table is different. Pass translate table as arg to compile_pattern. * buffer.c (switch-to-buffer-other-window): Eliminate this name; it's now defined in files.el. * window.c (Fget_lru_window): Give preference to full-width windows. * window.c (display_buffer): only split full-width windows. * search.c (Fstring_match): Set the search_regs, like buffer searching commands. Fri Sep 6 15:26:45 1985 Richard M. Stallman (rms at mit-prep) * editfns.c (Finsert_before_markers): User interface to insert_before_markers. * insdel.c (insert_before_markers): New function that inserts and moves all markers pointing at insertion point to point after the inserted text. * sysdep.c (wait_for_termination): Cause a SIGCHLD just in case, when termination is detected. * unexec.c: Round data-end-address on Sun up, not down, to segment bdry. * crt0.c, alloca.s, m-sun2.h: For sun 2, call hack_sky from _start. hack_sky is new, in alloca.s. m-sun2.h is a new file, which defines the symbol sun2. * buffer.c (Fswitch_to_buffer): Second arg non-nil means don't record buffer on selection history. * syntax.c (scan_sexps_forward): Stop properly if end of range comes after a char quote within a string. Thu Sep 5 12:33:22 1985 Richard M. Stallman (rms at mit-prep) * fileio.c (Fread_file_name): Abbreviate the default dir using ~ if possible. * search.c (search_buffer): Notice when re_search_2 returns "failure", in backward search. * term.c (write_chars): When using TS_repeat, the count was wrong, and len was not updated. Thu Sep 5 09:36:34 1985 Richard M. Stallman (rms at mit-prep) * process.c (handle_process_output): Preserve logical ordering of input and output when there is type ahead. Thu Sep 5 01:34:54 1985 Richard M. Stallman (rms at mit-prep) * macros.c: Define executing-kbd-macro as alias for executing-macro. Eventually old name will be flushed. Wed Sep 4 00:08:48 1985 Richard M. Stallman (rms at mit-prep) * keyboard.c (Fsuspend_emacs): Put back `kill', accidentally deleted. * buffer.c: define switch-to-buffer-other-window = pop-to-buffer. * dispnew.c (update_line): Simplify handling of nlen == screen_width case to avoid calling write_chars on -1 chars. Mon Sep 2 16:40:56 1985 Richard M. Stallman (rms at mit-prep) * term.c ((re)set_terminal_modes): Use the correct hook in each case. (topos): define topos_hook. * search.c (search_buffer): In backwards regexp search, use new `mstop' to re_search_2 to avoid matches that extend forward past starting point. * editfns.c (init_editfns): Change #endif to #else; make AMPERSAND_FULL_NAME conditionals right. * print.c (print): Define variable print-length, and refer to it as nec. Sat Aug 31 05:19:26 1985 Richard Mlynarik (mly at mit-prep) * editfns.c (init_editfns) Try to improve AMPERSAND_FULL_NAME frobbing a little. * eval.c, callint.c Define function user-variable-p, which returns t if first char of var doc string is "*". Make (interactive "v") use it. Sat Aug 31 00:14:11 1985 Richard M. Stallman (rms at mit-prep) * syntax.c (scan_words): Always clear immediate_quit on exit. Fri Aug 30 22:39:53 1985 Richard M. Stallman (rms at mit-prep) * process.c (handle_process_output): Don't use the name `howmany' to avoid possible conflict with system header files. * xdisp.c (decode_mode_spec): Never try to output 100% -- output 99% instead. Sun Aug 11 00:17:47 1985 Richard Mlynarik (mly at mit-prep) * m-sun.h Don't define SUN -- "sun" already exists. Define COMPILER_REGISTER_BUG and use it in a few places in the source which used to be conditionalized on SUN * config.h, config.h.dist Increase pure size (sigh) * search.c (compile_pattern): Signal an invalid-regexp error if lose. Fri Aug 9 16:33:31 1985 Richard Mlynarik (mly at mit-prep) * term.c (clear_end_of_line) Calling cmplus before chars output when terminals lacks clreol (crl@newton.purdue.edu) Tue Aug 6 04:06:12 1985 Richard Mlynarik (mly at mit-prep) * macros.c (end-kdb-macro): Barf if not defining a macro. * doc.c, keymap.c Interactive for Fdocumentation declaration was wrong, and has been deleted. (describe-function is what people should be using) Make where_is_in_buffer take a firstonly arg to speed up substitute-command-keys. Make it really use its buf argument. (crl@newton.purdue.edu) * emacs.c (kill-emacs): If noninteractive and arg is fixnum, return arg as program return code by exit(arg) * search.c (Fsearch_string): Wasn't initializing translate table based on case-fold-search * process.c (deactivate_process): Fix timing screw if SIGCHLD received in middle of deactivation (by silogic!eggert@ucla-cs.arpa) Mon Aug 5 11:03:57 1985 Richard Mlynarik (mly at mit-prep) * callint.c Improve doc of {current-}prefix-arg * minibuf.c (Fread_from_minibuffer): Thought it accepted maximum of 3 args, not 4. * sysdep.c (InitDsp): When you are (sigh) using CBREAK and flow control, C-@ is botched. Some tables are being initialized to zero (i.e. C-@) when they should be initialized to -1. More debatably, LDECCTQ is needed for real, bad flow control. -- silogic!eggert@ucla-cs.arpa Sun Jul 21 22:35:11 1985 Richard Mlynarik (mly at mit-prep) * sysdep.c (tabs_safe_p): gtty call was missing fd arg. Mon Jul 15 13:20:18 1985 Richard M. Stallman (rms at mit-prep) * xdisp.c, minibuf.c, fileio.c: Add * to some variables' doc, remove from others. * term.c (ins_del_lines): Always go to real hpos 0 before insert or delete. * buffer.c (init_buffer_once): Pass correct data type to Fbuffer_flush_undo. * term.c (write_standout_marker): Don't output `se' if it's the same as `so'. * window.c (set_window_height): Pass correct data type (int) when call self at end. Similar in set_window_width. Sun Jul 14 02:37:03 1985 Richard M. Stallman (rms at mit-prep) * editfns.c (subst-char-in-region): * casefiddle.c (operate_on_region): Don't call modify_region before recording the changes. * editfns.c (Fgoto_char): interactively read arg using n, not p. * undo.c (RecordChange1): A local and an arg were both named p. Change arg to bufp. Fixed bug in undoing the undoing of RecordChange (such as Meta-l). * minibuf.c (read_minibuf): Postpone incrementing MinibufDepth until point where can no longer quit before setting up to decrement it on quits. * fns.c (Fyes_or_no_p): Use Fsleep_for rather than sleep, to allow immediate quit. * abbrev.c (expand_abbrev): Handle case of scan_words returning 0. * casefiddle.c (operate_on_word): Handle case of scan_words returning 0. Fri Jul 12 15:00:24 1985 Richard M. Stallman (rms at mit-prep) * xdisp.c (display_string): Regard display chars as unsigned chars. Fri Jul 12 09:16:14 1985 Richard Mlynarik (mly at mit-prep) * callint.c Stuff was being added to command-history even if aborted out Thu Jul 11 10:54:27 1985 Richard M. Stallman (rms at mit-prep) * process.c: delete-exited-processes is boolean. * term.c: chars_wasted is 0 if no `so' or `se' string; 0100 | nchars if there is a `so' or `se' string. Should fix lossage with :sg#0: Wed Jul 10 19:52:41 1985 Richard M. Stallman (rms at mit-prep) * keyboard.c: Rename waiting to waiting_for_input, no longer static. In get_char, be sure to clear alarm and zero input_available_clear_word when thrown to from quit_throw_to_get_char. * eval.c (Fsignal): Crash if waiting_for_input. * process.c (create_process): Set up alarm signal handler before requesting alarm. Tue Jul 9 01:31:46 1985 Richard M. Stallman (rms at mit-prep) * process.c (create_process): Don't let child change Emacs's values of forkin and forkout. Use a timer interrupt to unhang `close (forkin)' since it gets wedged if the child exited already. Mon Jul 8 01:13:40 1985 Richard M. Stallman (rms at mit-prep) * xdisp.c (redisplay_window): It was returning garbage. * keyboard.c, sysdep.c: Make stuff_char work correctly assuming its arg is the character to stuff, and always pass it the character. Sun Jul 7 03:27:17 1985 Richard M. Stallman (rms at mit-prep) * dispnew.c, cm.h, sysdep.c: ospeed must be short, not int. * dispnew.c (update_line): Protect against old being null in call to change_line_highlight. * dispnew.c (make_display_lines): Take account of fact that `free' clobbers the area freed. * buffer.c (SefBfp): Don't check c->major_mode if c is zero. * lisp.h, m-*.h: EXPLICIT_SIGN_EXTEND controls whether to define XINT using shifts. Fri Jul 5 00:09:15 1985 Richard M. Stallman (rms at mit-prep) * cmds.c (newline): Make it REALLY do auto-filling. * term.c (term_init): Turn on must_write_spaces for Concepts. Append \E^G! (i/d char within line) to `ti' string for Concepts. * dispnew.c (update_line): If need to do clear-eol but text reaches to right margin, clear before outputting the last character of text. * cm.h, term.c: Define Wcm.cm_losewrap, which says that reaching right margin has undefined results. Turn this on for supdup terminals. Thu Jul 4 22:29:36 1985 Richard M. Stallman (rms at mit-prep) * dispnew.c (update_line): If want to insert chars early in line and delete chars late in line, do the deletion first. * dispnew.c (update_screen): Round outq down, not to nearest second, to get sleep time. Wed Jul 3 02:07:27 1985 Richard M. Stallman (rms at mit-prep) * term.c (term_init): Was storing "dc" string in wrong place. * term.c (ins_del_lines): On telerays, indicate that cursor is left in column 0. * dispnew.c (line_hash_code): Make line be null-terminated. * dispnew.c (direct_output_for_insert): Make line remain null-terminated. Tue Jul 2 01:24:56 1985 Richard M. Stallman,,, (rms at mit-prep) * window.c (window_loop, case 5): Change < to > so get-largest-window gets largest, not smallest. * term.c (ins_del_line): Don't pass negative length arg to bzero, for chars_wasted. * editfns.c (init_editfns): In user full name, discard stuff starting with first comma if any. Change names of static structure: now user_real_name and user_full_name. Clean up AMPERSAND_FULL_NAME code a little. Mon Jul 1 23:40:52 1985 Richard M. Stallman (rms at mit-prep) * minibuf.c: (minibuffer-complete-word): Fix case of Space in filename, where front of minibuffer gets deleted by completion. * Gross rewrite of display code. No Gosling code left. Files fixedpoint.* and display.* and Trm*.* flushed. New files term.c, scroll.c, termhooks.h, termopts.h, and termchar.h. Many changes in dispnew.c. * keyboard.c: make stop_character not static. Wed Jun 26 19:29:32 1985 Richard M. Stallman (rms at mit-prep) * xdisp.c (try_window_id): If C-k is done at end of next-to-last line, this fn updates window_end_vpos and cannot leave window_end_pos nonnegative (it is zero, in fact). If display is preempted before lines are output, this is inconsistent. Fix by setting blank_end_of_window to nonzero. Tue Jun 25 05:25:33 1985 Richard M. Stallman (rms at mit-prep) * cmds.c (Fnewline): Call the auto fill hook if appropriate. * xdisp.c (try_window_id): If dot is found by compute_motion after xp, record that permanently. If display_text_line sets dot position wrong (case where like is killed, dot is at eob and that line is not displayed), detect and set it again in final compute_motion. * display.c, dispnew.c, sysdep.c, xdisp.c: Rewrite UpdateScreen (now update_screen), PrintM (now print_scrolling) and init_display; all vestiges of Gosling code gone. They are now in dispnew.c. Some changes in how screen_garbaged is handled; work now done in Fredraw_display. Minor changes in InitDsp and in minibuf. * TrmAmb.c flushed. * Trm*.c: tt.t_init routine now passed no arguments. Sun Jun 23 18:25:51 1985 Richard M. Stallman (rms at mit-prep) * display.c: include sys/ioctl.h so conditionals work right. Sat Jun 22 15:32:16 1985 Richard M. Stallman (rms at mit-prep) * doprnt.c: Flush extra increment of fmt for %%. * search.c (replace-match): Test of prevc was backwards in determining value for case_action. * TrmTERM.h (wipeline): Update curY and curX when ESC S is sent to Teleray. * TrmTERM.h (TrmTERM): Turn off use of LF on Teleray. * process.c (pty): Don't turn on FIONBIO. Tue Jun 18 00:25:21 1985 Richard M. Stallman (rms at mit-prep) * process.c (create_process): Make pty terminal the controlling terminal of the child. * fileio.c: Replace %1 with %s in various interactive strings. I wonder why they said "%1", and whether that ever worked. * process.c (change_msgs): Advance dot if at dot is at end; otherwise don't change dot. * search.c (replace-match): Fix bug in case preservation by initializing `last' for final loop. Mon Jun 17 18:20:06 1985 Richard M. Stallman (rms at mit-prep) * sysdep.c: New file containing interfaces to system-dependent kernel entries and libraries. * aux.c, dsp.c: Files eliminated. * m-dual68.h: m- file for Duals running unisoft port. * s-uniplus5.0.h: s- file for unisoft port of sys V rel 0. * s-uniplus5.2.h: s- file for unisoft port of sys V rel 2. * syntax.c: Eliminate find-line-comment and find-line-comment-body. Lisp code should use comment-start-skip to find comments. Sat Jun 15 00:56:21 1985 Richard M. Stallman (rms at mit-prep) * TrmTERM.c: Suppress use of ^M on telerays. Know that ins line leaves cursor in column 0 on telerays. Don't decrement width for :am: terminals; this is an experiment. Fri Jun 14 01:49:52 1985 Richard M. Stallman (rms at mit-prep) * TrmTERM.c (TrmTERM): Override termcap's so and sg for telerays (xt is set). * display.c (hashline): Don't ignore trailing spaces if tt.t_needspaces is set. May fix C100 lossage. * Various files: minor changes for system V. * disp_extern.h: rename as dispextern.h. * commands.h (INTERACTIVE): Be false in batch mode. * aux.c: New file, containing system-dependent subroutines. * keyboard.c: Use new subroutines get_input_pending, stuff_char, discard_tty_input, in aux.c for now. * display.c (term_init): Use new subroutine init_baud_rate; avoid direct use of gtty. * callproc.c: Use new subroutines wait_without_blocking, setpgrp_of_tty, child_setup_tty, set_exclusive_use. * keyboard.c (EchoThem): Process quits only if `waiting' is set. Wed Jun 12 14:54:37 1985 Richard Mlynarik (mly at mit-prep) * minibuf.c, callint.c, read.c, mocklisp.c New function read-from-minibuffer does all you could ever want. read-minibuffer, eval-minibuffer, read-string take second optional initial-contents arg. read-input now a synonym for read-string. * keymap.c, callint.c, minibuf.c, fns.c, commands.h Rename MinbufLocalMap to Vminibuffer_local_map, etc Rename minibuf-local-{,-ns,-completion,must-match}map, and DefLispVar them (document even!) => New lisp variables minibuffer-local-map, minibuffer-local-ns-map, minibuffer-local-completion-map, minibuffer-local-must-match-map. Wed Jun 12 00:17:57 1985 Richard M. Stallman (rms at mit-prep) * keymap.c: Supply missing defsubr of keymapp. Tue Jun 11 00:27:22 1985 Richard M. Stallman (rms at mit-prep) * callint.c, editfns.c, doprnt.c: Use new function doprnt instead of _doprnt. Mon Jun 10 21:12:09 1985 Richard M. Stallman (rms at mit-prep) * TrmC100.c: Do termscript output. Mon Jun 10 21:09:14 1985 Richard Mlynarik (mly at mit-prep) * print.c, lisp.h, buffer.c New function prin1-to-string. (Needs an initialization done in buffer.c) Mon Jun 10 17:13:41 1985 Richard M. Stallman (rms at mit-prep) * TrmTERM.c: Fix interaction of XTflag with SGnum (telerays): Don't put SEstr on most lines; special hair to erase SOstr when necessary. * keyboard.c: Clear Vquit_flag in read_key_sequence, not in get_char. This makes it possible to quit out of y-or-n-p again. Mon Jun 10 16:57:27 1985 Richard Mlynarik (mly at mit-prep) * dired.c (file_name_completion) Check Vquit_flag each time around and quit if requested. Mon Jun 10 15:42:30 1985 Richard M. Stallman (rms at mit-prep) * minibuf.c: Use Tab for completion, not ESC. * unexec.c: round bss_start up to page bndry. Sun Jun 9 19:59:43 1985 Richard M. Stallman (rms at mit-prep) * keyboard.c (kbd_buffer_store_char): Call interrupt_signal for every C-g, even while waiting. * keyboard.c (input_available_signal): If C-g seen, ignore rest of chars already available. * keyboard.c (quit_throw_to_get_char): Don't clear Vquit_flag. Let Lisp program see quit-flag set. Sat Jun 8 04:41:04 1985 Richard M. Stallman (rms at mit-prep) * various files: Make functions called by internal_with_output_to_temp_window all return Lisp_Object. * bytecode.c (case Bdup): PUSH (TOP) loses due to invalid assumption about where autoincrement gets done. * read.c (read_vector): Pass make_pure_vector an int, as it expects, not a Lisp_Object. Fri Jun 7 07:02:32 1985 Richard Mlynarik (mly at mit-prep) * buffer.c documentation fixes Fri Jun 7 04:33:32 1985 Richard M. Stallman (rms at mit-prep) * TrmTERM.c: HLflags is now a three-way flag: 1 => line has SOstr, 2 => line has SEstr, 0 => line has neither. State 0 results from clearing screen, ins/del line. * dispnew.c (preserve_other_columns): If copying beginning of line from other window, don't increase length of line beyond last column copied. * keyboard.c: Eliminate `executing' flag. Quit now always sets Vquit_flag; input code tests it. Thu Jun 6 12:42:51 1985 Richard Mlynarik (mly at mit-prep) * doc.c (Fdocumentation): Handle sparse keymaps (lists whose car is `keymap') by way of canned string. Thu Jun 6 01:55:48 1985 Richard M. Stallman (rms at mit-prep) * keyboard.c (kbd_buffer_get_char): Keep doing gobble_input and waiting, until kbd_count becomes nonzero. Wed Jun 5 23:23:30 1985 Richard M. Stallman (rms at mit-prep) * dired.c (file-name-completion, file-name-all-completions): Make these functions share most of their code. Use two passes: first try all filenames that don't end in an "ignored extension" and, if that yields nothing, try all filenames. * doc.c (Fdocumentation): Handle keyboard macros (symbols with strings as definitions) with a canned string. Wed Jun 5 23:05:57 1985 Richard Mlynarik (mly at mit-prep) * dired.c (file-name-completion) Spazz comparing against completion-ignored-extensions (boole!eggert) That was no spazz, that was a feature - rms. Wed Jun 5 02:19:31 1985 K. Shane Hartman (shane at mit-prep) * cmds.c (end-of-line): Fix documentation. Claimed it moved to beginning of line. * buffer.c (fill-column): Fix typo in documentation. Tue Jun 4 22:19:45 1985 Richard M. Stallman (rms at mit-prep) * bytecode.c: Make Bread_char check for quit before finishing. A quit is likely to requested during the read_char. Tue Jun 4 20:11:37 1985 Richard Mlynarik (mly at mit-prep) * dired.c (file-name-completion, file-name-all-completions) Append "/" to names of directories. Tue Jun 4 04:24:13 1985 K. Shane Hartman (shane at mit-prep) * minibuf.c (Vminibuffer_help_form): Change the lisp name to be minibuffer-help-form rather than Vminibuffer-help-form. Sun Jun 2 18:29:48 1985 Richard M. Stallman (rms at mit-prep) * config.h, s-*.h: Eliminate CBREAK_INPUT and FRONT_END_PROCESS; INTERRUPT_INPUT just controls default for interrupt_input. * dsp.c, keyboard.c, xdisp.c: Use variable interrupt_input rather than switch INTERRUPT_INPUT. Don't change stopc/startc if flow_control is nonzero. * dsp.c, display.c: Change OldTchars => old_tchars, etc. Initialize new tchars from old tchars. Move setting window to 0 from InitDsp to term_init. * dispnew.c (set-input-mode): New function to set interrupt_input and flow_control. * read.c (read_escape): \ followed by one or two digits unreads following char. * TrmTERM.c (flash): If no bell defined, output C-g. * minibuf.c (read_minibuf, read_minibuf_unwind): Define Vminibuffer_help_form. Bind help_form to that inside minibuf. * callproc.c, doc.c: Make Vexec_directory end in a slash. * process.c (wait_reading_process_input): Remove debugging trap. It showed that the select had returned, there was input available, it had not been read by interrupt level but FASYNC was set. (Kernel bug). * keyboard.c (kbd_buffer_get_char): If wait_reading_process_input returns and kbd_count stil 0, gobble the buffered input. Sat Jun 1 00:04:29 1985 Richard M. Stallman (rms at mit-prep) * dispnew.c (sit-for): Gobble any pending input before calling wait_reading_process_input. * process.c (wait_reading_process_input): Dump core if `select' says input available and did not already get a SIGIO interrupt for it. * emacs.c (main): Detect -batch even when it's the only arg. * minibuf.c (read_minibuf): Don't call UpdateScreen if in batch mode. * keyboard.c: Use sigsetmask to prevent recursive SIGIO handling rather than kill, as previous change caused kbd_buffer_get_char to return -1 mysteriously. Change kbd_buffer_get_char never to return -1; kill emacs on eof in batch mode, abort on eof non-batch. * keyboard.c: Eliminate dribble_count. fflush (dribble) after each char. * undo.c, undo.h: Define Uunmod; record when buffer becomes "modified" and clear out "modified" if undo past there. * undo.c (RecordDelete): Correct the condition for combining with previous delete. * keyboard.c (kbd_buffer_get_char): Actually cause SIGIO if have unread input. * display.c, TrmTERM.c: Do fflush(termscript) in UpdateScreen, not in TrmTERM. Fri May 31 01:47:49 1985 Richard M. Stallman (rms at mit-prep) * TrmVT100.c: Generate termscript output. * dsp.c: define request_sigio, unrequest_sigio. * xdisp.c (DoDsp): Unrequest sigio on entry, rerequest on exit. Thus, no interrupts during redisplay. * keyboard.c (detect_input_pending): Check FIONREAD even if INTERRUPT_INPUT. * m-*.h: Add macros LOAD_AVE_TYPE and LOAD_AVE_CVT * fns.c (load-average): Use those two. Makes it work on suns. * keyboard.c (kbd_buffer_get_char): #ifndef INTERRUPT_INPUT, always read at least 1 character. Thu May 30 03:30:29 1985 Richard M. Stallman (rms at mit-prep) * display.c (UpdateScreen): Allow preemption at beginning if already input avail. * keyboard.c (EchoKeys): If 1st char is help-char, echo it specially verbosely. * keymap.c (access_keymap): If nothing in keymap under specified character code, try converting to lower case and look again. * data.c (listp, nlistp, eq, null): Use EQ or NULL rather than old slow comparisons. * data.c (symbol-function, symbol-value): Pass Qboundp or Qfboundp as extra info when signal void-symbol. Wed May 29 00:56:41 1985 Richard M. Stallman (rms at mit-prep) * fileio.c (add-name-to-file): If no query or error about new name existing, delete it to avoid system error later. * buffer.c (generate-new-buffer): Remove duplicate declaration of local var `name'. * Makefile: Assume distribution contains paths.h.dist and config.h.dist. Copy them into paths.h and config.h if those don't exist; warn user if those exist but are older. * dispnew.c (Ding): If -batch mode, just output ^G. * cm.c (mytgoto): Eliminate "magic" treatment of \0 and \004. Flush cmevalcost, cmput; use evalcost, put. * TrmTERM.c: Always set DontSend to zero. * alloca.s: Add pyramid version of alloca, and _longjmp and _setjmp. * data.c, eval.c, fns.c, read.c, window.c: To get around Pyramid C compiler bugs: Eliminate many constructs return FOO = BAR; Eliminate some cases of calling function computed by conditional expression. * dired.c (directory-files): Avoid making double slash if spec'd directory ends in slash. * callint.c (case 'b'): Don't allow a minibuffer to be the default buffer. Tue May 28 10:53:51 1985 Richard Mlynarik (mly at mit-prep) * minibuffer.c (read_minibuf) Added variable enable-recursive-minibuffers (enable_recursive_minibuffers) so that Real Men may confuse themselves. (Some commands such as c-h f can also use it) (This is not quite the right thing for commands to bind to read their arguments since it enables arbitrary recursiveness, not just one level to read args) * buffer.c Wrote generate-new-buffer --- like gentemp for buffer names. Rewrote create-file-buffer into lisp code in lisp/files.el Mon May 27 00:41:24 1985 Richard M. Stallman (rms at mit-prep) * crt0.c: Make each machine type use completely separate code. Put in code for pyramid. * display.h, Trm.h, disp_extern.h: Move InverseVideo to Trm.h, rename to inverse_video. Rename VisibleBell to visible_bell. Move ScreenLength and ScreenWidth to Trm.h. Rename ScreenGarbaged to screen_garbaged. * TrmVT100.c: Eliminate VT100_INVERSE. People can do this with setq. * fixedpoint.c: Use new variable FPdebug instead of RDdebug. Include only Trm.h and fixedpoint.h, not display.h. * display.c: IDdebug and RDdebug are mentioned in this file only. * xdisp.c (decode_mode_spec): Display "Narrow" after minor modes if buffer has any clipping. * keyboard.c (command_loop_1): Kill Emacs on end of file only if not executing a macro. Sun May 26 23:46:27 1985 Richard M. Stallman (rms at mit-prep) * display.h, Trm.h: Move VisibleBell and baud_rate to Trm.h. Define tt.t_padspeed, minimum speed at which padding needed (pb#). * Trm*.c, dispnew.c (Ding): tt.t_flash is always set; it flashes the screen or beeps using `bl='. * TrmTERM.c: Use `IC', `DC', `rp' and `bl' termcap strings when appropriate. No longer look for nonstandard `nn' or `rn' flags or `ds' string. Do not assume ^M and ^J can be used unless `cr' or 'do' or `nl' says so. ?? Make second arg to tputs always number of LINES below cursor because the termcap documentation says so. Is this right ?? Fri May 24 00:10:57 1985 Richard M. Stallman (rms at mit-prep) * keymap.c (push_key_description): Use DEL for 0177, RET for 015, LFD for 012, TAB for 011, SPC for 040. * search.c (search_buffer): For n < 0 re-search, test search_regs.end[0] vs startpos, not pos. * callint.c (call-interactively): If interactive spec is a list, use num_input_chars to tell whether it read args from the command input. * keyboard.c (get_char): Increment new variable num_input_chars on each call. * All .h files: make all variable definitions `extern'. * buffer.c, window.c, xdisp.c, display.c, dispnew.c, syntax.c, fixedpoint.c: Put in one non-extern definition for each variable that used to have them only in the .h files. * keyboard.c: Refs to Cant1WinOpt should say windows_or_buffers_changed. * buffer.c (kill-all-local-variables): Don't clobber a variable currently set up for some other buffer. Was losing the other buffer's recent setq's if the other buffer had the same variable local. Thu May 23 02:12:22 1985 Richard M. Stallman (rms at mit-prep) * buffer.c (list_buffers_1): Put back the lost column in the entries rather than removing it from the header. Thu May 23 01:01:11 1985 Richard M. Stallman (rms at mit-prep) * xdisp.c (decode_mode_spec): Display "Abbrev" if abbrev_mode is set. Don't clobber past end of tbuf. * keyboard.c: kbd_buffer_get_char: If noninteractive, read from stdin. open-dribble-file: take filename as argument. command_loop_1: on end of file, call kill-emacs. Wed May 22 23:05:57 1985 Richard M. Stallman (rms at mit-prep) * window.c (save_window_restore): Set windows_or_buffers_changed. * buffer.c (list_buffers_1): Print % not R for read-only buffers. * cmds.c (SelfInsert): !NULL => NULL testing buffer read onliness for abbrev expansion. * eval.c (interactive-p): Return nil if called within expression being evalled by a built-in C function such as eval-region. Wed May 22 21:57:49 1985 K. Shane Hartman (shane at mit-prep) * config.h, TrmXTERM.c, display.c Change define for XWINDOW to XVSWINDOW because XWINDOW is defined as a macro in lisp.h. Wed May 22 17:33:05 1985 Richard M. Stallman (rms at mit-prep) * print.c (printchar, strout): Output minibuffer chars to stdout if noninteractive. * xdisp.c (message, message1): Noninteractively, output newline if previous output was from print. * keyboard.c (cmd_error): If noninteractive, force out error message at end. * keyboard.c (get_char): Fix bugs in handling help_char: do a redisplay after restoring window configuration; clear NextK after reading a space. * buffer.c (other-buffer): Init notsogood to nil so don't return garbage value. * buffer.c (list_buffers_1): Put back missing space before each buffer name. * buffer.c (SetBfp): New code to dump core when paragraph-start gets its global value in a buffer in Lisp mode. * TrmXTERM.c: new file. Used for interface to MIT's `X' window system. Wed May 22 07:29:49 1985 Richard Mlynarik (mly at mit-prep) * buffer.c (list_buffers_1): made list-buffers print "R" if buffer read-only. (No change is needed to lisp/buff-menu.el) Wed May 22 02:04:39 1985 Richard M. Stallman (rms at mit-prep) * keyboard.c (get_char): Use (in effect) save-window-excursion to flush the window made by or for the help-form. * minibuf.c: Flush remove_help_window and its DefBoolVar. * lisp.h: Flush obsolete externs for remove_help_window and flushhelp. * config.h: increase maximum screen dimensions to 300x300. Define XWINDOW flag (off by default). * Trm.h: add tt.t_socketinput slot, and t_ReadSocket slot. * dsp.c, keyboard.c: code for using those slots. * display.c: install code for XVSWINDOW. * dispnew.c (sleep-for): flush spurious reference to nonexistent variable time_limit. Tue May 21 08:48:40 1985 Richard Mlynarik (mly at mit-prep) * The documentation for substitute-command-keys was fazed out by its own hairy heuristics! Moby quoting (past the c compiler, and then past substitute-command-keys) added. People should be careful of this. Also, hacks which make printed documentation out of doc strings need to know about this cruft. Tue May 21 01:03:56 1985 Richard M. Stallman (rms at mit-prep) * TrmTERM.c, dispnew.c, cm.c: open-termscript opens a termscript file, into which are written a copy of all characters (except padding) sent to the terminal. * Makefile: Recompute DOCSTR file only if other things have changed. Mon May 20 00:33:00 1985 Richard M. Stallman (rms at mit-prep) * keyboard.c (command-execute): Use do_autoload. * data.c (car, cdr, car-safe, cdr-safe): Open code them. Flush carcdr and car_1. * eval.c: Define do_autoload to autoload a function and barf if that did not define it. Use this in eval, apply, funcall. Make Fautoload do nothing if function is already defined. Open code the loops that trace function definitions of symbols. Sun May 19 14:15:42 1985 Richard M. Stallman (rms at mit-prep) * buffer.c, window.c: Change algorithm for reordering Vbuffer_alist: select-window now calls record_buffer. other-buffer now prefers buffers not visible in any window. bury-buffer, which puts a buffer at the end of the list, is now defined. * keyboard.c (get_char): Make first char of a command go into keybuf even if it is being reread. Make all chars go into keybuf if coming from a macro. * process.c (make_process): Fix bug where incremented-for-uniqueness name wasn't really used. Fri May 17 01:26:52 1985 Richard M. Stallman (rms at mit-prep) * undo.c: Fix bug of reinserting/replacing undone chars wrapping around wrong at end of undo buffer. Use tembuf to handle properly a Uchange of length > half the undo buffer. Thu May 16 17:44:51 1985 Richard M. Stallman (rms at mit-prep) * window.c (set-window-start): accept third arg NOFORCE meaning don't set w->force_start. * indent.c (compute_motion): Clear tab_offset when scanning past a newline. * lisp.h, bytecode.c: define Qbytecode. * eval.c: fix interactive-p to look past a call to `bytecode'. Makes interactive-p work in compiled code. * xdisp.c: Supply missing taboffset arg to display_text_line from DoDsp. Fixes bug that inserting a character could shift line sideways. * display.c: Remove spurious * in setting terminal_driver. * lisp.h: Remove some obsolete externs for symbols that no longer exist. * dispnew.c: Define send-string-to-terminal. * TrmTERM.c, TrmVT100.c: Turn on alternate keypad on entry, turn off on exit. Thu May 16 13:33:12 1985 Richard Mlynarik (mly at mit-prep) * fileio.c: added optional third arg ok-if-exists to rename-file, make-symbolic-link, add-name-to-file and copy-file. If the destrination filename exists, then if ok-if-exists is non-nil it is silently bashed; else if the function was called interactively the user is queried as to whether s/he wants to bash the file; otherwise (ok-if-exists nil, non-interactive) a file-already-exists error is signalled. * window.c: made get-window-buffer return nil if get-buffer of its arg returns nil, rather than erring. Tue May 14 22:54:48 1985 Richard M. Stallman (rms at mit-prep) * dispnew.c, display.c: Function scroll_max_lines_saved returns # lines in common between PhysScreen and DesiredScreen. UpdateScreen skips i/d calc on big window, fast screen when there are too few lines in common. Mon May 13 19:00:49 1985 Richard M. Stallman (rms at mit-prep) * indent.c: Fix cursor position calculation for continued tabs. New tab_offset argument to compute_motion. * xdisp.c: Make display of continued tabs work. * Makefile: Do inc-version in a separate invocation of temacs to make the dumped xemacs smaller. * eval.c: Put star in front of XSUBR (fun)->function where it is being called. * alloc.c: Mark buffers when pointers to them are found, like all other Lisp object types. * buffer.h, buffer.c: Created chain `all_buffers' containing all existing buffers not yet reclaimed by gc, including dead buffers. * read.c: Fix up register declarations. * emacs.c, dsp.c, xdisp.c: Define -batch switch: do no redisplay, don't change terminal modes. Lisp variable `noninteractive' is non-nil in this mode. * syntax.c: Made most scanning loops turn on immediate_quit. * eval.c: Fsignal clears immediate_quit. Sun May 12 04:02:12 1985 Richard M. Stallman (rms at mit-prep) cmds.c: modified `newline' to insert before an existing newline before dot. This produces better redisplay. xdisp.c: fixed bug that modifying buffer displayed in two windows failed to redisplay both mode lines with stars. xdisp.c: try_window_id: if scrolling upward and changed text is empty scroll up all the lines that fit below bp. xdisp.c: introduce num_contin, to display tabs right in contin. lines doc.c: define substitute-command-keys, using crl@purdue's code. Make `documentation' call it. eval.c, fns.c, bytecode.c: put in register decls for Lisp_Objects. saved 2500 bytes of object code. Sat May 11 16:44:27 1985 Richard M. Stallman (rms at mit-prep) editfns.c: Put in code for & in fullname, under AMPERSAND_FULL_NAME flag. lisp.h: Install NO_UNION_TYPE flag in lisp.h. This means XMARKBIT can no longer be on left side of =. New macros XMARK and XUNMARK and XSETMARKBIT are used instead. alloc.c, marker.c: use XMARK, XUNMARK, XSETMARKBIT where needed. TrmTERM.c: Ignore `xs' termcap flag. Always use the SEstr on sg >= 0 terminals. minibuf.c: Don't allow entry to minibuffer while minibuffer is selected. Local Variables: mode: indented-text eval: (auto-fill-mode 1) left-margin: 8 fill-column: 74 version-control: never End: emacs-19.30/src/ChangeLog.2100666 12241 1 474725 5523315657 14367 0ustar rolanddaemonWed Aug 31 02:45:27 1988 Richard Stallman (rms at corn-chex.ai.mit.edu) * Version 18.52 released. * x11term.c (XT_GetDefaults): Replaced entire function. * unexhp9k800.c: #endif was missing. * crt0.c [hp9000s300]: New variable flag_68010. Tue Aug 30 15:23:40 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-isi-ov.h (LOAD_AVE_{CVT,TYPE}): On 4.3, different definitions. * m-iris4d.h: Define XSETMARKBIT. Mon Aug 29 16:00:03 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-ibmrt.h (CANNOT_DUMP): Was defined by mistake in last change. * m-amdahl.h (NSIG): If it's 19, make it 20. Overrides Amdahl's mistake. Sat Aug 27 14:47:42 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * x11fns.c, x11term.c (XXscreen): New variable, default screen number. All calls to BlackPixel, WhitePixel, DisplayCells, DefaultColormap pass this. Fri Aug 26 12:25:02 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * data.c (init_data) [uts]: Handle SIGEMT. * m-apollo.h (APOLLO_SR10): Define this if BSD4_3. (BSTRING): If APOLLO_SR10, don't alter this. * emacs.c [APOLLO]: If APOLLO_SR10, omit the acl code. * filemode.c (ftypelet): If S_IFIFO==S_IFSOCK, avoid duplicate cases. * m-alliant4.h: Add missing `*/'. Thu Aug 25 15:35:46 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * x11term.c (writechars): Don't call updateline; output just the chars that are specified; don't clear to end. * m-ibmrt-aix.h: Define getwd. Define bcopy, etc. as macros. Define LIBX10_MACHINE and change LIBS_MACHINE. Wed Aug 24 11:55:33 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * xterm.c (XTread_socket): If HAVE_SELECT, call xfixscreen before waiting. * dispnew.c (update_line): comments added. * xterm.c (writechars): Output only the chars specified even if in update; don't clear to end. (XTread_socket): Check O_NDELAY only if it and F_GETFL are defined. (x_term_init) [IBMRTAIX]: do call gethostname. () [IBMRTAIX]: Include sys/time, not time. Tue Aug 23 20:24:48 1988 Chris Hanson (cph at kleph) * xterm.c (XTread_socket): Do not call `xfixscreen' if O_NDELAY is set. On hpux, this causes an I/O error. Tue Aug 23 06:33:18 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-news800.h: define HAVE_ALLOCA. Mon Aug 22 20:11:15 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * keyboard.c (read_avail_input) [no FIONREAD]: Always set O_NDELAY. Sun Aug 21 16:02:47 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * xterm.c, x11term.c (XTclear_end_of_line): Arg was misinterpreted as place to *start* clearing. (x_clear_end_of_line): New fn does what XTclear_end_of_line did. All callers in this file changed. * sysdep.c [USG] (getwd): Free the entire string retd by getcwd. Sat Aug 20 12:11:05 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-ibmrt.h: Delete the USG conditionals. * m-ibmrt-aix.h: New file. * process.c (wait_reading_process_input) [IBMRTAIX]: Do `select' as on HPUX. * process.c [IBMRTAIX]: Use sys/time.h. * dispnew.c (update_line): Handle case of !char_ins_del_ok. * xterm.c (x_term_init): Use X keymap spec'd in user's xdefaults. Also use macro X_DEFAULT_FONT to determine ultimate default font. * sysdep.c (child_setup_tty) [IBMRTAIX]: Turn off extra tty features. (init_sys_modes) [IBMRTAIX]: Turn off enhanced line editor. Also, call hft_init. (init_sys_modes) [TCXONC]: Make sure output isn't stopped. (reset_sys_modes) [IBMRTAIX]: Call hft_reset. (hft_init, hft_reset): New function. (sys_siglist) [IBMRTAIX]: Alternate signal defs. * unexec.c: Treat IBMRTAIX like IRIS. * fileio.c (Fcopy_file): If USE_UTIME, use `utime' instead of `utimes'. * emacs.c (main) [IBMRTAIX]: Handle additional fatal signals. Fri Aug 19 11:30:52 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * search.c (Fstore_match_data): Failed to skip the 2nd nil in a pair. * search.c (search_buffer) [C_ALLOCA]: Use auto space for BM_tab. Thu Aug 18 22:10:09 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * keyboard.c: Declare errno. Mon Aug 15 17:16:30 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-news800.h: Define COMPILER_REGISTER_BUG and LIBS_TERMCAP. Fri Aug 12 13:37:02 1988 Mike Haertel (mike at spiff.ai.mit.edu) * m-7300.h: Made it understand how do undump a demand-paged executable. Thu Aug 11 19:31:56 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * unexec.c (adjust_lnnoptrs): auxent is a union, not a struct. Wed Aug 10 00:13:33 1988 Chris Hanson (cph at kleph) * keyboard.c (read_avail_input): Do not set O_NDELAY if `read_socket_hook' is in use. This causes Xlib to get an IO error under X10, and could potentially do the same for X11. * s-hpux.h (ADJUST_EXEC_HEADER): Undefine this. Demand loaded exec format doesn't work correctly in hpux. (HAVE_SOCKETS): hpux has BSD-style sockets. * xfns.c, xterm.c, x11term.c, x11fns.c: Conditionalize "time.h" inclusion on USG instead of HPUX. * xterm.c, x11term.c (XTread_socket): Conditionalize call to `XPeekEvent' on `HAVE_SELECT'. * xterm.c: Supply missing definition of `handler'. Tue Aug 9 19:08:53 1988 Chris Hanson (cph at kleph) * indent.c (current-column): fix typo. * keyboard.c, undo.c: add explicit storage class to several variable declarations so that GCC does not generate warning message. Mon Aug 8 07:50:50 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * eval.c: doc fix. Thu Aug 4 15:23:18 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fileio.c: Doc fix. * keymap.c (Fwhere_is_internal): Call get_keyelt. Wed Aug 3 19:11:50 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * unexec.c [sun386]: control header files, like STRIDE, etc. * s-sunos4.h: Define LD_SWITCH_SYSTEM, not LD_SWITCH_MACHINE. * m-sun386.h: Vice versa. (O_NDELAY): Delete definition; duplicates s-sunos4.h. (LD_SWITCH_SYSTEM): Undefine this, since the s-sunos4.h defn is wrong for the 386. Sun Jul 31 09:38:14 1988 Richard Stallman (rms at juicy-juice.lcs.mit.edu) * sysdep.c (select_alarm): If read_alarm_should_throw, throw back to read_input_waiting. (read_input_waiting): Call setjmp, so that can be done. * xterm.c (XTread_socket) [no SIGIO]: If O_NDELAY not set, wait for an event. Set read_alarm_should_throw while waiting. * x11term.c (internal_socket_read): Similar change. * x11fns.c (Fx_set_mouse_color): Don't free save_color; can be literal. * x11term.c (x_term_init): Clear reversevideo if fg or bg color specd. Thu Jul 28 11:12:47 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * print.c (Fwith_output_to_temp_buffer): Detect error for non-strings. Fri Jul 22 06:05:00 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * s-usg5-3.h: Define LIBX{10,11}_SYSTEM. * ymakefile: New variables LIBX{10,11}_SYSTEM to be set in s- file. * xterm.c (XExitGracefully): Declare the args, for debugging. (x_io_error): New function now used as handler for X I/O errors. * xfns.c [not HAVE_TIMEVAL]: Don't include any time.h. * sysdep.c (sys_suspend) [VMS]: Ignore SIGINT while suspended. * undo.c (Fundo_more): Better err msg. Mon Jul 18 01:06:55 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * indent.c (current_column, Fmove_to_column): ignore invisible lines. * keyboard.c (command_loop_1): No direct output if selective display. Sun Jul 17 13:56:29 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * ymakefile (LD_TEXT_START_FLAGS): -e should be __start, not address. * m-orion105.h: New file. Fri Jul 15 03:16:06 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * alloca.s (pyramid): Define _setjmp, _longjmp only if PYRAMID_OLD. Tue Jul 12 21:56:32 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * s-rtu.h (fsync): Define this as no-op. * process.c, sysdep.c: Rename MASSCOMP flag to RTU. Sun Jul 10 14:30:37 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * term.c (write_chars): Compensate for wasted_chars when comparing curX Tue Jul 5 14:43:42 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * lread.c (openp): Don't call strncat if lsuffix is 0. Tue Jun 28 19:57:22 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * callint.c (Fcall_interactively): On VMS, treat 'f' like 'F'. Mon Jun 27 18:01:54 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacs.c (Fkill_emacs): Run kill-emacs-hook. Thu Jun 23 08:16:02 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * ymakefile: Add missing dependencies. * cmds.c (Fself_insert_command): Pass correct 2nd arg to SelfInsert. * ymakefile: Avoid newline after cpp in commands for alloca.s. Wed Jun 22 09:26:41 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * ymakefile: #undef register, in case m- or s- defines it. Tue Jun 21 04:57:54 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * unexhp9k800.c: Complete replacement. * x11fns.c (x_set_cursor_colors): Send current colors to X server. (Fx_set_mouse_color): Use that function. * x11term.c (XFlipColor, XInitWindow): Use that function. Variable `mous' deleted; handle reverse video for `mous_color' by checking it with `strcmp'. * x11term.c (x_term_init): `sizeof' was used for strings, in mallocing. Delete unused vars `cursor_fore' and `cursor_back'. * x11term.c (CursorToggle): Make solid cursor proper color when no text char is there. * x11term.c (XT_Set_Size_Hints): New arg PR. At startup, it's the value from XGeometry, else 0. Use it when setting the flags (which dims are user-specified). * x11term.c (XT_Set_Size_Hints): Conditional for XICCC. * x11term.c (internal_socket_read): Don't call change_window_size with arguments too small for it to handle. * dispnew.c (window_change_signal, {un,}hold_window_change): If a signal happens during update_screen, just set flag; resignal when update_screen finishes. * xdisp.c (DoDsp, message, message1): Call {un,}hold_window_change. * dispnew.c (Vwindow_system_version): New variable. (syms_of_dispnew, init_display): Set this variable. * callint.c (Fcall_interactively): For `N', convert prefix to number. Sat Jun 18 06:21:13 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * termcap.c (tgetst1): Tolerate missing colon at end of entry. Wed Jun 15 01:08:52 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * data.c (Fkill_local_variable): Used to clobber other buffer's value. Tue Jun 14 03:08:38 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * x11fns.c, x11term.c: "Mouse queue" was a stack; make it a queue. New vars XXm_queue_in, XXm_queue_out. (Fx_{proc,get}_mouse_event): Use XXm_queue_out as fetch index. (internal_socket_read): Use XXm_queue_in as store index. (x_term_init): Init the new vars. Fri Jun 10 08:09:01 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * window.c (Fset_window_configuration): Handle change in screen size. * s-hpux.h: Delete -lBSD from LIBS_SYSTEM. * m-hp9000s300.h: Define string fns as macros even in version 6. Wed Jun 8 22:17:15 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * buffer.c (SetBfp): Initialize `swb'. This matters when SetBfp is called during initialization, on Masscomp. Fri Jun 3 07:28:20 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * sysdep.c (kbd_input_ast, end_kbd_input): Eliminate `ast_active'. (end_kbd_input): Use LIB$AST_IN_PROG. * lread.c (init_read): Don't be confused by Qnil in normal_path. * data.c (Fsymbol_value): Check nullness of per-buffer sym's buffer. * callint.c (Fcall_interactively): Don't put non-strings into visargs. Thu Jun 2 04:28:42 1988 Richard Stallman (rms at rice-krispies.ai.mit.edu) * keyboard.c (read_avail_input, input_available_signal): Make `buf' as long as kbd_buffer. Wed Jun 1 04:29:18 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * xdisp.c (decode_mode_spec): Output `%%' as a `%'. * sysdep.c (kbd_input_ast): Save and restore errno. * keyboard.c (input_available_signal, interrupt_signal): Likewise. * dispnew.c (window_change_signal): Likewise. * process.c (child_sig): Likewise. Tue May 31 03:22:14 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * x11fns.c (Fx_proc_mouse_event): When looking up a meta-click, look for the meta-prefix-char first. * xmenu.c (Fx_popup_menu): Typo calling BLOCK_INPUT_DECLARE. Sat May 28 02:28:59 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * s-iris3-{5,6}.h: Undo Jan 11 change. Mon May 23 15:04:34 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * minibuf.c (read_minibuf): If PROMPT's not a string, make it one. Sun May 22 16:09:07 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * m-alliant.h: Typo made m-alliant1.h lose. * m-alliant4.h: New file. * fns.c (Freverse): Rename `vector' to `vec'. On alliant, `vector' is a typedef in param.h. Fri May 20 00:32:07 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * process.c (kill_buffer_processes): Send SIGHUP, not SIGKILL. Thu May 19 16:38:15 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * m-mips.h, m-iris4d.h (XUNMARK): Cast unsigned before shifting. * m-sequent.h: No need for DKSTAT_HEADER_FILE. Mon May 16 21:03:11 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * x11term.c: First include system headers, then config.h, then maybe undef FIONREAD and SIGIO, then read x11term.h which depends on them. Sun May 15 12:16:56 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * keyboard.c (get_input_pending): Hold SIGIO around read_avail_input. Sat May 14 01:23:49 1988 Richard Stallman (rms at lucky-charms.ai.mit.edu) * keyboard.c (init_keyboard): Call keyboard_init_hook if nonzero. * x11term.c (x_init_1): Move all keyboard-related inits here. (x_term_init): Don't call x_init_1; put it in keyboard_init_hook. * m-sun3.h, s-sunos4.h, s-bsd4-3.h: Delete DK_HEADER_FILE. * m-sequent.h: Change it to DKSTAT_HEADER_FILE. Fri May 13 22:38:12 1988 Richard Stallman (rms at lucky-charms.ai.mit.edu) * xdisp.c (DoDsp): if pause, and window is partial-width, next redisplay must do all windows since preserve_other_columns may lack the data to work right if we just did scrolling. Fri May 13 13:56:45 1988 Chris Hanson (cph at kleph) * m-hp9000s300.h: Conditionalize a couple of things on `__GNUC__'. Thu May 12 16:51:24 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * xdisp.c (mark_window_display_accurate): Don't use XBUFFER on nil. * keyboard.c (keys_of_keyboard): Change ndefkey to defkey. * keymap.c (keys_of_keymap): Change ndefkey to defkey. Tue May 10 22:49:36 1988 Richard Stallman (rms at corn-chex.ai.mit.edu) * sysdep.c: Define sigmask. Fri May 6 10:41:46 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * Version 18.51 released. * process.c (Fdelete_process): Change status of proc to `signaled'. Then call change_msgs to run the sentinel. * m-sequent.h, m-sun3.h, s-sunos4.h, s-bsd4-3.h: Define DK_HEADER_FILE. * m-7300.h: Take out the Feb 11 change; umix!sendai!rich@rutgers.edu says it doesn't work. Fri Apr 29 10:05:02 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * xdisp.c (DoDsp): Set clip_changed if Voverlay_... has changed. Thu Apr 28 17:55:45 1988 Chris Hanson (cph at kleph) * s-hpux.h: Define HAVE_PTYS. HP-UX has them and they work fine almost all of the time. The one case where they would fail regularly (inferior Scheme) has been bypassed by using pipes. Thu Apr 28 09:27:41 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * keyboard.c (Fsuspend_emacs): Do init_sys_modes via unwind protect. * fileio.c [VMS] (Fdefine_logical_name): Empty string value means delete the name. Wed Apr 27 01:29:04 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * sysdep.c [VMS]: RAB's never a macro; let RAB$C_BID control rab.h. * sysdep.c [VMS] (sys_getenv): only if value of lib$sys_trnlog is exactly 1 does it mean it found something. * sysdep.c (creat_copy_attrs): Downcase remaining SYS$OPEN, SSY$CLOSE. Mon Apr 25 16:06:49 1988 Richard Stallman (rms at lucky-charms.ai.mit.edu) * fileio.c (Fdo_auto_save): Ignore shrinkage if not visiting file. Wait only 1 second after shrinkage message. (Fset_buffer_auto_saved): Update the buffer's save_length. (auto_save_error): Mention buffer name in message. * buffer.c (Fswitch_buffer): Error if in minibuffer window. Sun Apr 24 18:56:54 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * sysdep.c (sys_close): Define this only if INTERRUPTABLE_CLOSE. * s-usg5-3.h: Define INTERRUPTABLE_CLOSE. Fri Apr 22 17:43:03 1988 Richard Stallman (rms at rice-krispies.ai.mit.edu) * sysdep.c (init_sys_modes) [VMS]: Undef _IOFBF so don't use setvbuf. Wed Apr 20 05:44:19 1988 Richard Stallman (rms at rice-krispies.ai.mit.edu) * m-sun386.h: New file, for Roadrunner. Tue Apr 19 13:54:37 1988 Chris Hanson (cph at kleph) * x11term.h, x11term.c, x11fns.c: Again (for the third time) abstract input blocking so these files compile on systems without SIGIO. * x11term.c (x_term_init): Comment out fatal error which prevents X11 interface from being used if interrupt_input is false. This is unnecessary and untrue -- the interface works, but suboptimally. Tue Apr 19 04:18:42 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * sysdep.c (sys_access) [VMS]: If arg is dirname, cvt to name as file. (sys_getenv): If arg is TERM, also look for TERM as logical name. * unexconvex.c: New file. Mon Apr 18 15:23:37 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * emacs.c (main) [APOLLO]: Eliminate call to set_sbrk_size. * search.c (match_limit): Return nil for a paren-pair with no match. Sun Apr 17 02:43:15 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * vmsfns.c (Fvms_system_info, Fshrink_to_icon): New functions. Former comes with many subroutines. Sat Apr 16 00:39:12 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * x11term.c (updateline, write_chars): Restore sigmask at every return. (stufflines): Restore signal mask only once, at the end. * sysdep.c ({un,}request_sigio): SIGWINCH mask actions were backwards. Never change any other mask bit. * x11term.c (internal_socket_read): Initialize COUNT. * ymakefile (LIBX): /usr/X11/lib/oldX/liboldX.a becomes -loldX. Thu Apr 14 22:29:28 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * fileio.c (auto_save_error): Print msg that there was an error. (Fdo_auto_save): If don't save a bfr because it has shrunk, print msg. Wed Apr 13 23:58:10 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * s-umax.h: Define MAIL_USE_FLOCK (LaLiberte says so). Sun Apr 10 07:23:58 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * fileio.c (Fdefine_dcl_symbol): Deleted. (Fdefine_logical_name): New function created. * sysdep.c (define_dcl_symbol): Deleted. (define_logical_name, delete_logical_name): New fns to make job-wide logical names. "This is more useful for communicating with other processes, since when Emacs is run in a subprocess (as it usually is), the others see job-wide logical names, not DCL symbols)." Sat Apr 9 00:32:25 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * ymakefile: If UNEXEC is defined, it specifies object file for unexec. * unexmips.c: New file contains MIPS unexec code, moved from unexec.c. * m-mips.h, m-iris4d.h: Define UNEXEC as unexmips.o. No longer need to define COFF. * unexenix.c, s-xenix.h: Likewise. * unexhp9ks800.h: New file; m-hp9000s800.h says to use. * unexec.c: Delete MIPS and Xenix code. * dired.c (file_name_completion) [VMS]: specbind completion-ignore-case to non-nil. * m-sequent.h: Define PTY_ITERATION, etc., for Dynix 3.0 pty names. Fri Apr 8 05:37:20 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * unexec.c (EXEC_HDR_TYPE): New macro overrides `struct exec' if def. * unexec.c (DEFAULT_ENTRY_ADDRESS): Allow config to define this. * m-iris4d.h: Define it here, instead of IRIS4D conditional in unexec. * m-tek4300.h: New file. * fileio.c: doc fix. Tue Mar 29 17:25:58 1988 Richard M. Stallman (rms at wilson) * ymakefile: Default LIBX10_MACHINE and LIBX11_MACHINE to null. Use them when defining LIBX. * xterm.c: On all USG, include sys/time.h. * xterm.c (XtFlash, flashback): Bodies conditional on ITIMER_REAL. * xterm.c (x_term_init): Call gethostname only if BSD or HPUX. * xterm.c (x_init_1): Don't mess with SIGIO if USG. * sysdep.c: Fix typo, USG_SYSTEM_DIR => SYSV_SYSTEM_DIR. Externally define sys_errlist, except on VMS. Don't include rab.h if RAB is already defined. * sysdep.c ({request,unrequest}_sigio) BSD4.2 version: Also block and unblock SIGWINCH if that's defined. * m-mips.h (XSETMARKBIT): New, test 2nd arg for only zero or nonzero. * s-usg5-3.h: #define close sys_close (like open, read, write). * sysdep.c: Undef `close', like `open'. * sysdep.c (sys_close): New function. All refs to close in sysdep.c renamed to sys_close. * sysdep.c (read_input_waiting): Call `read_socket_hook'. Define BUFFER_SIZE_FACTOR as in keyboard.c. * sysdep.c (dup2): Alternate defn #ifdef F_DUPFD. Sun Mar 27 14:49:09 1988 Richard M. Stallman (rms at wilson) * process.c [CYDRIX]: Include sys/tiuser.h; don't include pty.h. * process.c (pty): Don't do ioctl FIONBIO if not defined. New macros PTY_ITERATION, PTY_NAME_SPRINTF and PTY_TTY_NAME_SPRINTF customize how to test all pty names. * unexec.c (make_hdr): DATA_SECTION_ALIGNMENT, new, acts like SECTION_ALIGMENT, but for data section only. * callproc.c (init_callproc): Cvt dirname to filename for `access'. * lread.c (init_read): Likewise. These used to lose on VMS. * dired.c (file_name_completion) [VMS]: READFUNC is a ptr, not a fcn. Thu Mar 24 00:26:26 1988 Richard M. Stallman (rms at wilson) * sink.h, sinkmask.h: Don't declare the array static. * xfns.c: Make sink_bits and sink_mask_bits extern; don't include sink.h and sinkmask.h here. Define macros sign_width, etc. * xterm.c (writechars, dumprectangle): Flush `if (PhysScreen)', etc., since an array is always nonzero as a pointer. * filelock.c: Include config.h after sys/stat.h so can undef S_IFLNK. * sysdep.c (sys_suspend): Use BSD, not SIGTSTP, as cond. for killpg. * dispnew.c (init_display): Set Vwindow_system to `x' for X11. * xterm.c, x11term.c (x_term_init): Set `window-system-version' to 10 or 11. * dispnew.c (update_screen): If cursor_in_echo_area is negative, put cursor at left margin in echo area. * fns.c (Fy_or_n_p): Make cursor_in_echo_area -1 when echoing response. Don't alter cursX. Wed Mar 23 16:34:27 1988 Richard M. Stallman (rms at wilson) * x11term.h: Use X11/ not X/ for dir of include files. * xmenu.c: Likewise, in the X11 case. * m-7300.h: Fix unterminated comment near end. * s-xenix.h: Define n_zeroes so usage of struct nlist in fns.c works. * term.c (fatal): Do fflush(stderr). * sink11.h, sink11msk.h: New files. * x11term.h: Define CLASS here. Don't define X11 since this is included only if X11. * x11term.c: Use sink11.h and sink11msk.h, not sink.h and sinkmask.h. Don't define CLASS. Delete everything about BIGDEBUG. Delete everything pertaining to read_events_block. (XXidentity): now global. (CursorOutline): New var; nonzero means cursor is hollow. (XXicon_usebitmap): New var; nonzero means use bitmap icon. (XTset_terminal_modes, ClearCursor): Set CursorOutline. (XTflash, flashback): Combine into one function; use `select' to wait. (CursorToggle): Handle CursorOutline. (internal_socket_read): Delete 3rd arg, and code that handles it. Handle MappingNotify events. Handle EnterNotify and LeaveNotify (change solid to outline cursor). (XT_GetDefaults): If asked for .BodyFont, look for .Font also. (x_term_init): Init XXicon_usebitmap; strip dirs from `progname'. Handle -i switch. Handle -geometry like -w. (XT_Set_WM_Hints): Obey XXicon_usebitmap. (XInitWindow): Use `fatal' for fatal error messages. Init CursorOutline. Ask for EnterNotify and LeaveNotify events. * x11fns.c (Fx_get_default): Use XXidentity. Clean up docstring. * sysdep.c [VMS] (input_wait_timeout, wait_for_kbd_input): Use detect_input_pending, not get_input_pending. * process.c (wait_reading_process_input): Use only detect_input_pending to check for pending kbd input. (That `select' saw something on channel 0 doesn't mean it is kbd input; it could be an expose event.) * keyboard.c (read_avail_input) [FIONREAD]: Now static. New arg specifies value of NREAD; if it is nonzero, don't call get_input_pending to get it. Use kbd_buffer_store_char to put chars into kbd_buffer. Always abort if kbd_count is nonzero at start. Don't call {set,clear}_waiting_for_input. (get_input_pending): Now static. Return immediately if kbd_count > 0 or if Vquit_flag is non-nil. If FIONREAD and not interrupt_input and read_socket_hook, call read_avail_input to see how much pending input is really kbd characters; don't say we have some if an expose event is pending. * dispnew.c (init_display): Check result of egetenv for emptiness as well as nullness. Mon Mar 21 00:24:51 1988 Richard M. Stallman (rms at wilson) * alloca.s [WICAT]: Don't clobber a2. Return value in a0 and in d0. Sun Mar 20 13:33:54 1988 Richard M. Stallman (rms at wilson) * crt0.c (errno): Don't initialize it -- put it in bss space. [M68K]: Define splevel% with `comm' -- put it in bss space. * sysdep.c [MISSING_UTIMES]: Define `utimes' as a no-op. * s-hpux.h: Define MISSING_UTIMES. * buffer.c (Fbuffer_local_variables): The buffer's alist can be out of date for a non-current buffer, so call Fsymbol_value to make the alist up to date. * sysdep.c [VMS] (end_kbd_input): If ast_active, don't clobber any global variables. * ymakefile (alloca.o): Copy sed output to a .s file and use cc to run the assembler. I hear Xenix can't run it directly. * sysdep.c [XENIX]: Undefine TIOCGETC. * s-xenix.h: Undefine NLIST_STRUCT. Put `_' in defn of LDAV_SYMBOL. Define HAVE_SYSVIPC. * m-intel386.h [XENIX] (LIB_STANDARD): Add /lib/386/Slibcfp.a. [XENIX] (FSCALE): Define it. [XENIX] (C_ALLOCA): Undefine it. * alloca.s: Define alloca for Xenix. Sat Mar 19 00:20:10 1988 Richard M. Stallman (rms at wilson) * keyboard.c (read_avail_input): If `read' gives EAGAIN, kbd_count should be 0. Can happen on V.3. * x11fns.c (Vxterm1): Delete this variable, and lisp var `xterm'. (syms_of_xfns): If CANNOT_DUMP and not `noninteractive', init_display has already set up Vxterm, so don't init it here. * display.c (syms_of_display): Likewise for Vwindow_system. (init_display): Always set Vwindow_system. Fri Mar 18 13:37:35 1988 Chris Hanson (cph at kleph) * m-hp9000s300.h: Add a definition for C_SWITCH_MACHINE which is needed to compile the X11 interface files. * s-hpux.h, m-hp9000s300.h, m-hp9000s800.h: Version 6.01 of HP-UX (on 300 machines only) implements symbolic links and supplies BSD procedures like `bcopy' and `index' as part of the BSD library. Move definitions which depend on these features from the s- file to the m- files, and conditionalize the features based on a flag. Fri Mar 18 16:03:27 1988 Richard M. Stallman (rms at wilson) * scroll.c (calculate_scrolling): Abort if ->insertcount is out of range. * sysdep.c (getwd for USG): Don't define it if HAVE_GETWD. * m-stride.h: Define HAVE_GETWD. * buffer.c (init_buffer): If `getwd' fails, it's a fatal error. * ymakefile (MAKE_PARALLEL): New name for PARALLEL, and now a cpp macro, not a Make variable. Defaults to empty. * m-sequent.h: Define MAKE_PARALLEL. * xdisp.c (display_text_line): Handle the overlay arrow last of all, and update line->length for the space it uses. * xmenu.c: Conditionals for X11, using new macro X11ONLY. Currently named x11menu.c until someone tests it. * ymakefile: Handle HAVE_X_MENU and use xmenu.o, even if X11. * x11term.h: Define BLOCK_INPUT, UNBLOCK_INPUT, BLOCK_INPUT_DECLARE. * Makefile: Set $(MAKE), since some Make versions don't have it. (xmakefile): Delete lines that are just one OR MORE whitespace chars. Use \t to represent the tab in the `sed' command. * fileio.c (Finsert_file_contents) [APOLLO]: Do another `stat' after closing the file. Gets around kernel bug (in `fstat'?). * fileio.c (Fwrite_region) [ALLIANT]: Don't do `fsync'; kernel bug. * sysdep.c (sys_suspend): If forking shell, call close_process_descs. Sat Feb 13 03:43:55 1988 Richard Stallman (rms at sugar-smacks.ai.mit.edu) * Version 18.50 released. * sysdep.c [VMS]: Remove VMS4_6 conditional on execvp & rename since s-vms.h is set to make us use our own definitions of these. Make execvp call `error' instead of `croak'. * s-vms.h: PURESIZE 132000. * m-sun2.h: Likewise (for HAVE_SUN_WINDOWS). Thu Feb 11 01:01:27 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * callproc.c (child_setup): Call close_process_descs if can have subprocesses. Close the argument-descriptors after copying them to 0, 1 and 2. * callproc.c (Fcall_process): After fork, in subprocess, explicitly close Emacs's end of the pipe. Don't bother calling set_exclusive_use. * process.c (close_process_descs): Close all descriptors that are talking to subprocesses. Called from a new subprocess. * process.c (create_process): Don't bother calling set_exclusive_use since close_process_descs now closes Emacs's side of a pipe or pty. * x11term.c, x11fns.c, x11term.h: New files from rfrench@athena.mit.edu In x11term.c, the function `read_events_block' has been `if 0'd and so have all calls to it. A call in wait_reading_process_output was not added, and a call to internal_read_socket in get_input_pending was not added. * emacs.c (main) [HAVE_X_WINDOWS]: Set xargv, xargc for xterm.c. * dispnew.c (init_display) [X11]: Set Vwindow_system to `x11'. * s-hupx.h: Define HAVE_SYSVIPC. Should s-usg*.h define this too? * dir.h: Some union types were missing levels of struct inside them. * alloc.c (Fpurecopy): If not purifying, do nothing. * editfns.c (init_editfns): Record system name even if dumping. * eval.c (Fcondition_case): Inverted endtest in handler validate loop. * m-7300.h: Define SEGMENT_MASK, SECTION_ALIGNMENT and pass the -z switch to ld. kenobi!ford@bass.nosc.mil says so. Tue Feb 9 14:12:59 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * unexec.c: Merge gb's code for Xenix. * m-intel386.h: Add conditionals for Xenix. * s-xenix.h: New file. * cm.h: Make the bit-fields unsigned. Mon Feb 8 22:43:18 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * sysdep.c (init_sys_modes) [USG]: Set C-g for VQUIT as well as VINTR. This was formerly done only on HPUX, and worked there. It appears that all sysV is like HPUX in that CDEL does not really turn off the signal--it makes Meta-DEL cause the signal! * process.c (wait_reading_process_output): Change the test on read_kbd to avoid losing on 80386 Xenix. Sat Feb 6 16:56:50 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * xdisp.c (Voverlay_arrow_string, Voverlay_arrow_position): New variables specifying a string to overlay on the buffer text and a place to put it. * xdisp.c (display_text_line, redisplay_window, DoDsp): Handle these variables. Thu Feb 4 12:00:23 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * insdel.c (prepare_to_modify_buffer): If CLASH_DETECTION is disabled, verify the modtime here since it won't be done via lock_file. Sun Jan 31 14:34:24 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * fileio.c (Fcopy_file): Report error in `write'. Fri Jan 29 08:49:32 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * eval.c (unbind_to): Recompute loop end-test from `count' each time since an unwind-protect function can use realloc to grow the specpdl. Tue Jan 26 08:35:55 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * sysdep.c (vms_truncate) [VMS]: New fn to truncate a file. * fileio.c (Fwrite_region) [VMS]: If writing auto-save file, truncate any existing file. * s-vms.h: Rename `rename', `execvp' and `system' so we don't use the VMS-library versions of it. Fri Jan 22 04:27:48 1988 Richard Stallman (rms at frosted-flakes) * m-ibmrt.h: Add some AIX conditionals; output on BSD should be unchnged. Perhaps will now run on AIX. Thu Jan 21 07:46:20 1988 Richard Stallman (rms at frosted-flakes) * keyboard.c (command_loop): Exit here for noninteractive eof. * keyboard.c (kbd_buffer_get_char): Don't exit here. Wed Jan 20 08:16:27 1988 Richard Stallman (rms at frosted-flakes) * lread.c (openp): Reject directories even if !exec_only. * window.c (Fset_window_configuration): When keeping window's old buffer, make sure its start and pointm are valid. Tue Jan 19 00:15:37 1988 Richard Stallman (rms at frosted-flakes) * sysdep.c (sys_suspend) [SIGTSTP]: Use killpg and getpgrp to stop all processes in same pgrp with Emacs. * syntax.c (Fparse_partial_sexp): Add 7th elt to STATE arg and value, describing minimum depth encountered during the scan. Mon Jan 18 00:24:13 1988 Richard Stallman (rms at frosted-flakes) * alloca.s: Change some as-style comments to C-style comments so cccp won't be confused by stray singlequotes. * s-iris3-{5,6}.h: Move the #defines of long-named functions into m-irist.h. * lread.c (init_read): Warn if dirs in PATH_LOADSEARCH don't exist. * callproc.c (init_callproc): Warn if Vexec_directory doesn't exist. * emacs.c (main): Call init_callproc before changing terminal modes. * xdisp.c (try_window_id): When computing ep, watch out for invisible lines that follow the newline after the last change. * window.c (Fset_window_point): Now works ok on selected window. Sun Jan 17 06:41:54 1988 Richard Stallman (rms at frosted-flakes) * eval.c (Fdefconst, Fdefvar) doc fix. * keymap.c (Fcopy_keymap): Several stupid errors. * dired.c (file_name_completion): Wasn't calling readdir for Unix; was doing so (instead of readfunc) on VMS. * dired.c (Fdirectory_files): Don't call NAMLEN if dp is 0. Sat Jan 16 02:54:48 1988 Richard Stallman (rms at frosted-flakes) * alloc.c (syms_of_alloc): Eliminate vars data-bytes-{free,used}. They lose because values are over 24 bits. * lread.c (read_list): delete `register' for val and tail. * buffer.c (Fkill_buffer): delete `register' for buf and bufname. * fns.c (Fy_or_n_p): delete `register' for xprompt. * keymap.c (Fcopy_keymap): missing paren. Fri Jan 15 17:46:24 1988 Richard Stallman (rms at frosted-flakes) * m-iris4d.h: Changes to support dumping. * m-*.h: Doc fix for VIRT_ADDR_VARIES. * unexec.c: Minor changes to mips code for IRIS_4D. Mon Jan 11 20:17:21 1988 Richard Stallman (rms at frosted-flakes) * s-iris3-{5,6}.h: Don't #undef SIGIO. BROKEN_FIONREAD makes it unnec. * process.c [IRIS]: Find sysmacros.h in sys/. Sat Jan 9 18:15:49 1988 Richard Stallman (rms at frosted-flakes) * doprnt.c: New arg NARGS says how many args there are in ARGS. Give an error if the string tries to use more than that many. * callint.c (Fcall_interactively): Pass new arg to `doprnt' * editfns.c (Fformat, format1): * xdisp.c (message): Thu Jan 7 00:57:24 1988 Richard Stallman (rms at frosted-flakes) * lreadc (init_obarray): Split the stmt `hash =' to avoid a VACX bug. * alloca.s [pyramid]: Keep sp a multiple of 32. This preserves cache-block alignment. Wed Jan 6 17:26:28 1988 Richard Stallman (rms at frosted-flakes) * s-hpux.h: Don't define nomultiplejobs, LDAV_SYMBOL, LIBS_DEBUG or BROKEN_FIONREAD. * m-hp9000s300.h: Define those four. * s-hpux.h: Define BSTRING, and define bcopy, etc., as macros. * sysdep.c [NEED_BSDTTY]: Include bsdtty.h. (Flag is defined in m-hp9000s800.h) * m-hp9000s800.h: New file. * m-hp9000s300.h: New name for m-hp9000.h. * sysdep.c: Split TIOCGLTC conditional into two, one on TIOCGETC. * search.c (search_buffer): Avoid & of array static_BM_tab. * alloca.s, crt0.c: Change hp9000 conditionals to hp9000s300. Tue Dec 22 21:27:44 1987 Richard Stallman (rms at frosted-flakes) * alloca.s [WICAT]: Keep sp pointing at lowest word in use. Thu Dec 17 07:25:05 1987 Richard Stallman (rms at lucky-charms) * unexec.c (make_hdr): Don't add A_TEXT_OFFSET to a_text in the NO_REMAP case (when a_text comes from the old header). * filelock.c: If no symlinks, use `stat' instead of `lstat'. Mon Dec 14 15:22:04 1987 Richard Stallman (rms at frosted-flakes) * fileio.c (Fsubstitute_in_file_name): Allow underscore in an env var name. Wed Dec 9 18:12:58 1987 Richard Stallman (rms at frosted-flakes) * indent.c (Findent-to): Interactive code `N' instead of `n'. * sysdep.c (execvp, rename): Omit these fns if VMS4_6. * lread.c (oblookup): Split a statement to avoid VMS compiler bug. Fri Dec 4 04:41:09 1987 Richard Stallman (rms at frosted-flakes) * data.c (sign_extend_temp): Moved from sysdep.c. * data.c (sign_extend_lisp_int): Function to do sign-extend; needed on some machines. * keymap.c (Fcopy_keymap): Copy subkeymaps recursively. * fileio.c (Fread_file_name): Don't crash if no env var HOME. Thu Dec 3 11:39:46 1987 Richard Stallman (rms at frosted-flakes) * m-convex.h: New file. Wed Dec 2 01:05:38 1987 Richard Stallman (rms at frosted-flakes) * process.c (wait_reading_process_input): Don't set time_limit to -2; leave it as -1. * s-usg5-3.h, m-intel386.h: New files. Tue Dec 1 00:41:30 1987 Richard Stallman (rms at frosted-flakes) * process.c: Support for SYSV_PTYS. * dired.c: New macros DIRENTRY and NAMLEN; support for sysV.3. * sysdep.c: `closedir' function for sysV.3. * crt0.c: Add code for Sun 4. * m-sparc.h: New file. * lread.c (read_list): Fix error message for ] in a list. * fileio.c (Ffile_symlink_p): Call Fexpand_file_name. Sat Nov 21 15:20:39 1987 Richard Stallman (rms at frosted-flakes) * print.c: Clean up doc string syntax and fix doc error for `print'. Sat Oct 31 23:23:38 1987 Richard Stallman (rms at sugar-smacks) * editfns.c (Fformat): Realize doprint %-specs can contain - and space. Fri Oct 30 19:50:38 1987 Richard Stallman (rms at sugar-smacks) * fns.c (Fy_or_n_p): Don't try to DOWNCASE -1. Thu Oct 29 20:11:29 1987 Richard Stallman (rms at frosted-flakes) * fns.c (Fy_or_n_p): Protect `prompt' and `xprompt' from gc. * fns.c (Fyes_or_no_p): Protect `prompt' from gc. * lread.c (read_list): Protect `val' and `tail' from gc. * buffer.c (Fkill_buffer): Protect `buf' and `bufname' from gc. * fileio.c (barf_or_query_if_file_exists): Protect `absname'. Thu Sep 17 01:13:55 1987 Richard M. Stallman (rms at prep) * Version 18.49 released. * window.c (set_window_width): Set windows_or_buffers_changed. * scroll.c (calculate_scrolling): Initialize insertcount of top edge cells to zero. * dired.c (file_name_completion): Rearrange VMS conditionals so that `readfunc' exists only on VMS. Apollo compiler couldn't deal with it. Wed Sep 16 14:38:35 1987 Richard M. Stallman (rms at prep) * m-sun[23].h: Doc fix. * sysdep.c (reset_sys_modes): Don't output anything if have a read_socket_hook (i.e. under X). Thu Sep 10 18:33:50 1987 Richard M. Stallman (rms at prep) * buffer.c (Fget_buffer_create): Test of mode-class property of buffer's major mode was backwards. Mon Sep 7 20:03:02 1987 Richard Mlynarik (mly at prep) * dired.c (file_name_completion): Only filter `leaves' of filesystem structure with completion_ignored_extensions -- don't eliminate directories. If Vcompletion_ignored_extensions isn't a proper list, don't eliminate all filenames. * xterm.h (UNBLOCK_INPUT_RESIGNAL): RESIGNAL_INPUT, not INPUT_RESIGNAL Sun Aug 30 02:03:10 1987 Richard M. Stallman (rms at prep) * Version 18.48 released. * xmenu.c (XEmacsMenu): Rename `sel' to `selidx'. * unexec.c: Remove the CANNOT_UNEXEC code. * m-apollo.h: Switch back to CANNOT_DUMP. * emacs.c (Fdump_emacs): Don't call malloc_init if SYSTEM_MALLOC. * emacs.c (main): ditto. Thu Aug 20 20:25:42 1987 Richard M. Stallman (rms at prep) * fileio.c (Fwrite_region) [VMS]: Move gap to the closest place (first newline after old gap). Sat Aug 15 20:33:21 1987 Richard M. Stallman (rms at prep) * editfns.c (init_editfns): Handle getpwuid returning 0. Fri Aug 14 19:03:58 1987 Richard M. Stallman (rms at prep) * casefiddle.c (casify_region): Use prepare_to_modify_buffer. Don't call modify_region until the end. * sysdep.c (reset_sys_modes): Output a bare CR so kernel can track the cursor hpos. Thu Jul 30 15:56:12 1987 Richard M. Stallman (rms at prep) * vmsfns.c (Fsetprv): Correct spelling SS$NORMAL => SS$_NORMAL. Include . Wed Jul 29 22:43:13 1987 Richard Mlynarik (mly at prep) * lread.c (init_read): Initialise load_in_progress. Tue Jul 28 17:40:22 1987 Richard M. Stallman (rms at prep) * vmsfns.c (Fsetprv): Detect error from sys$setprv properly. Add some privileges missing from the table. Mon Jul 27 15:56:35 1987 Richard M. Stallman (rms at prep) * sysdep.c (creat_copy_attrs): Flush duplicate `else'. Sat Jul 25 15:30:30 1987 Richard M. Stallman (rms at prep) * dispnew.c (update_screen): Use PENDING_OUTPUT_COUNT in all appropriate places. Fix a comment delimiter typo. Fri Jul 24 20:19:42 1987 Richard M. Stallman (rms at prep) * keyboard.c (command_loop_1): Don't do direct output if DoDsp is needed to erase a minibuffer message. * keymap.c (describe_alist, describe_vector): 1. Output only one blank line in a row if multiple empty keymaps. 2. Chase through indirect keymap elements. * keymap.c (describe_map_tree): Handle Flookup_key returning int so C-x 4 bindings appear in the output. * sysdep.c (sys_creat for VMS): Get all args via varargs, no named args, to avoid incompatible change in VMS C. Sat Jul 18 19:10:52 1987 Richard M. Stallman (rms at prep) * unexec.c (make-hdr): Split the stmts that use ADDR_CORRECT into two stmts. Some compilers mysteriously barf on them. * m-7300.h: Remove ADD_CORRECT (s-usg5-2.h does it). Add LD_SWITCH_MACHINE and SWITCH_ENUM_BUG. * m-amdahl.h: define STACK_DIRECTION. * sysdep.c (random for VMS): subtract 1<<30, not 1<<14. * fns.c (Fvconcat): Doc fix. * window.c (Fcurrent_window_configuration): Doc fix. * sysdep.c [VMS]: include file.h. * sysdep.c (creat_copy_attrs) [VMS]: Minor fixes to prevent invalid acL if there was no old version. * dispnew.c (PENDING_OUTPUT_COUNT): New macro to get # chars buffered in a stdio output stream. * dispnew.c (update_screen): Use that macro. Remove #ifndef VMS around the sleep when buffer is full. * s-vms.h: Define nonstandard PENDING_OUTPUT_COUNT for VMS use. * fileio.c (file_name_as_directory) [VMS]: Fix 3rd arg to strncmp. Fri Jul 17 19:28:46 1987 Paul Rubin (phr at prep) * m-sun2.h: Add comment explaining that filename refers to the OS version, not the CPU model number. People running SunOS 3.2 on Sun 2 computers have been erroneously trying to use this file, and losing. Fri Jul 10 15:51:18 1987 Chris Hanson (cph at prep) * xterm.h: Define macros to abstract control of input signals. Alternate set of macros for hp-ux does no signalling. * xterm.c: * xfns.c: * xmenu.c: Rewrite to use new input signal macros. Add conditionalizations for hp-ux, mostly to eliminate references to `ButtonReleased' (I don't know why, this is from wizards at HP Labs). Change "xmenu.c" to eliminate unused include files, and reorder the include files so that it compiles under hp-ux. Mon Jun 29 00:59:41 1987 Richard M. Stallman (rms at prep) * fileio.c (Fwrite_region) [VMS]: Use creat_copy_attrs. * sysdep.c (creat_copy_attrs) [VMS]: New function: open a file for writing, copying attributes from another file. * fileio.c (Ffile_writable_p): Exchange with Ffile_symlink_p. Avoids mysterious cpp lossage on RT/PC. * syntax.c: Disguise doc string of non-existent Lisp variable `standard-syntax-table'. Thu Jun 25 22:12:56 1987 Richard M. Stallman (rms at prep) * callproc.c (Fcall_process): On VMS, use NLA0: instead of /dev/null. * term.c (term-init): Don't use "nl" cap on VMS if it's a linefeed. Tue Jun 23 01:44:38 1987 Richard M. Stallman (rms at prep) * sysdep.c (sys_creat) [VMS]: Use va_start, not va_start_1. * sysdep.c (rename) [VMS]: Use SYS$RENAME not LIB$RENAME_FILE. Thu Jun 18 00:20:53 1987 Richard M. Stallman (rms at prep) * sysdep.c (readdirver) [VMS]: Don't return bogus version number. Don't lose stepping off end of directory entry. Eliminate superfluous loop. * fileio.c (file-name-as-directory) [VMS]: Never append a slash. Fix erroneous return-with-no-value. * dired.c (file_name_completion): For VMS, upcase the input. * fns.c (Frandom): Doc fix. * sysdep.c (random) [USG]: Subtract 1<<14 from value of rand() so value range is centered on zero. * sysdep.c (random) [VMS]: Likewise, and remove the code to initialize the seed. Higher levels call srandom if seed should be set. Mon Jun 15 04:02:51 1987 Richard M. Stallman (rms at prep) * fileio.c (Fwrite_region) [VMS]: Use `creat' to create an auto-save file. * Version 18.47 released. * fileio.c (Fwrite_region): Check result from fsync. Fri Jun 12 21:41:36 1987 Chris Hanson (cph at prep) * terminfo.c (tparam): Handle the outstring == 0 case by allocating a result of the correct size. Fri Jun 12 11:50:21 1987 Richard M. Stallman (rms at prep) * terminfo.c (tparam): Kludge the outstring == 0 case. Accept (and ignore) the buffer-length argument. * s-iris3-5.h: Remove defines of IRIS35 and PURESIZE. * fileio.c (Fwrite_region) [VMS]: Write under temp name and rename, to avoid auto-deletion if writing fails. When moving gap to avoid extra newline, move it only to the next newline. Wed Jun 10 02:33:27 1987 Richard M. Stallman (rms at prep) * minibuf.c (Ftry_completion, Fall_completions): GCPRO some strings when calling predicate. * fileio.c (file_name_as_directory) [VMS]: Recognize .dir in uc or lc and followed by either .1 or ;1. * fileio.c (directory_file_name) [VMS]: Append .DIR.1 in upper case. * fileio.c: Delete calls to lower_case. * fileio.c: #ifndef VMS around decls or errno, sys_errlist, etc. * sysdep.c (getwd for VMS): Upcase the filename. * sysdep.c (lower_case): Delete this function and all calls. * dired.c (file_name_completion): Obey completion-ignore-case by using scmp instead of bcmp. Tue Jun 9 13:27:06 1987 Richard M. Stallman (rms at prep) * syntax.c: (scan_lists): Clear mathexit on 2nd math-char in a pair. Mon Jun 8 17:11:26 1987 Richard M. Stallman (rms at prep) * Version 18.46 released. * m-apollo.h: Define CANNOT_UNEXEC instead of CANNOT_DUMP. * keyboard.c (get_char): Delete DEBUG-conditional code. * process.c: Delete the IRIS ignore-SIGIOT kludge. * sysdep.c: Declare sign_extend_temp regardless of machine type. * sysdep.c (sys_access) [VMS pre 4.4]: Don't zero uic. * sysdep.c (sys_access_reinit): New fn, called from init_sys_modes, to clear uic. * eval.c (grow_specpdl): Don't subtract old specpdl address from new one; they are in different arrays. Use correct args to Fsignal when reporting overflow. * process.c (Fopen_network_stream): Don't create process object until opens, etc. have succeeded. Mon Jun 8 11:38:38 1987 Chris Hanson (cph at prep) * keyboard.c (read_avail_input): use `read_socket_hook' if it has a value. This is required in hp-ux if `HAVE_X_WINDOWS' is defined. * process.c (wait_reading_process_input): conditionalize `select' call for hp-ux. Mon Jun 8 04:31:28 1987 Richard M. Stallman (rms at prep) * m-isi-ov.h: Cut SEGMENT_MAST in half. crl@purdue says so. Sat Jun 6 02:25:47 1987 Richard M. Stallman (rms at prep) * tparam.c: Ifdef emacs, include config.h. Fri Jun 5 13:05:23 1987 Richard M. Stallman (rms at prep) * m-apollo.h: Add #undef BSTRING. * dispnew.c, keyboard.c: On VMS, don't include sys/ioctl.h. * process.c (create_process): On IRIS, set forkin, forkout to -1 instead of opening them. Then don't use them later if they are -1. * process.c (Fopen_network_stream): Allow integer as 4th arg to specify foreign port number. Wed Jun 3 20:35:01 1987 Richard M. Stallman (rms at prep) * m-amdahl.h: Add definitions of LD_SWITCH_MACHINE, EXEC_MAGIC, SEGSIZ and SEGMENT_MASK. Turn on C_ALLOCA. From Jishnu Mukeji. * eval.c (Fapply): Add missing parens in args to alloca; args were too small. From Jishnu Mukeji. Mon Jun 1 18:26:46 1987 Richard M. Stallman (rms at prep) * version 18.45. * fileio.c (Finsert_file_contents): Always initialize fd. Sun May 31 17:47:43 1987 Richard M. Stallman (rms at prep) * fileio.c: Move declarations of errno and friends to top of file. * filelock.c: Likewise. Fri May 29 02:55:27 1987 Richard M. Stallman (rms at prep) * process.c: #end => #endif. Wed May 27 03:21:19 1987 Richard M. Stallman (rms at prep) * fileio.c (Fexpand_file_name) [VMS]: Upcase all file names, not just absolute ones. Use Fupcase. Tue May 26 16:50:05 1987 Richard M. Stallman (rms at prep) * fileio.c (Fdirectory_file_name) [VMS]: Fix to expansion of VMS logical names. * crt0.c [ISI68K]: Define asm sym isi68020. * xdisp.c (display_string): Use current buffer's tab_width. (display_text_line): Simplify XBUFFER (w->buffer) to bf_cur. Sat May 23 18:41:19 1987 Richard M. Stallman (rms at prep) * alloc.c (init_alloc-once): Don't set Vpurify_flag. * lread.c (init_obarray): Do it here, now that Qt is valid. Fri May 22 00:02:56 1987 Richard M. Stallman (rms at prep) * m-targon31.h: Undefine VIRT_ADDR_VARIES. * vmspaths.h: Convert to VMS syntax and upper case. * lread.c (absolute_filename_p) [VMS]: '[' and '<' don't make a pathname absolute. Thu May 21 15:19:48 1987 Richard M. Stallman (rms at prep) * xterm.c (x_term_init): Don't set Vxterm and Vxterm1. * xfns.c (syms_of_xfns): Don't set Vxterm and Vxterm1. Delete Lisp variable `xterm'. * dispnew.c (init_display): Initialize Vxterm to t or nil. * keyboard.c (interrupt_signal): Check Vwindow_system instead of Vxterm. * sysdep.c (sys_access for VMS pre 4.4): Turn on call to vmserrstr. * sysdep.c (vmserrstr) [VMS]: Define this function. * process.c (create_process) [IRIS]: Don't open the pty's tty in the parent process. Open only once, in the child. * xdisp.c (redisplay_window): If window-start points nowhere, recenter the window to avoid a crash. * fileio.c (Fwrite_region): Check for error from the close. NFS reportedly can report out-of-space there. Mon May 18 02:31:15 1987 Richard M. Stallman (rms at prep) * fileio.c (Fwrite_region): Always stat after the close. * term.c (term_init): Spurious ' in error msg. * cmds.c (SelfInsert): For newline, must auto-fill before inserting it. * keyboard.c (BROKEN_FIONREAD): config.h can #define this to cause FIONREAD to be #undef'd. * s-iris3-5.h, s-hpux.h: Define BROKEN_FIONREAD. * indent.c (compute_motion): Typo in defn of HPOS. Sun May 17 11:05:59 1987 Richard M. Stallman (rms at prep) * term.c: Pass 0 for buffer and length to tparam, record the value returned as buffer to use, and free it later. Each caller was changed. * tparam.c (tparam): Take buffer length additional arg. Malloc a buffer if that buffer is too small. Return address of buffer actually used. Add * and / as arithmetic operators. * xdisp.c (message): Handle NO_ARG_ARRAY for call to doprnt. Sat May 16 02:03:02 1987 Richard M. Stallman (rms at prep) * m-isi-ov.h: Define LIB_STANDARD to avoid bad interaction with crt0 in ISI system 3.07. * fileio.c (Ffile_name_as_directory) [VMS]: Special handling for foo:[000000] where foo is a logical name. Wed May 13 02:06:49 1987 Richard M. Stallman (rms at prep) * fileio.c (Fread_file_name) [VMS]: Bind completion-ignore-case to t. * fileio.c (Fexpand_file_name) [VMS]: Upcase letters in filenames. * sysdep.c (sys_access for VMS < 4.4): Always get `uic' from the system. * sysdep.c: New macro SETOSPEED to set the ospeed value in a terminal-info structure. Definitions for USG and BSD. Used in init_baud_rate. Tue May 12 16:40:36 1987 Richard M. Stallman (rms at prep) * search.c (skip_chars, Fstring_match, scan_buffer): Set immediate_quit over the scanning loops. * vmspaths.h: Remove the comma from the load path. Search only the standard directory. * sysdep.c (sys_suspend): Delete spurious `*' from declaration of `sigio'. Tue May 12 16:35:44 1987 Chris Hanson (cph at prep) * regex.c (re_compile_fastmap): Fix typo where `notsyntaxspec' neglected to look at its argument byte, comparing with randomness. Tue May 12 14:35:09 1987 Richard M. Stallman (rms at prep) * sysdep.c (sys_access for VMS pre 4.4): Fix typo of `file' where `filename' was meant. Avoid using `vmserrstr' since it's not defined. * fileio.c (Finsert_file_contents): On VMS, st.st_size > num_chars_read. Use num_chars_read for the return value. * cmds.c (SelfInsert): New 2nd arg, nonzero says don't do auto fill. * cmds.c (Fself_insert_command, Fnewline): Pass nonzero to SelfInsert if have prefix arg. * minibuf.c (Fself_insert_and_exit): 0 as 2nd arg to SelfInsert. * keyboard.c (command_loop_1): likewise. Mon May 11 18:32:21 1987 Richard M. Stallman (rms at prep) * keyboard.c, s-hpux.h, s-iris3-5.h: Eliminate the hpux/iris conditional from keyboard.c. Now the s- files do #undef FIONREAD. * buffer.c (Fkill_buffer): Do nothing rather than kill the sole remaining buffer. Prevent quits during actual killing. Tue May 5 10:11:45 1987 Richard Mlynarik (mly at prep) * m-irist.h: New version from raible@orville.arpa * s-iris3-5.h: New file. (s-usg5-2 with additions) * keyboard.c: IRIS, like HPUX, #defines but does not implement FIONREAD. * window.c, keyboard.c, sysdep.c: Remove some unused local variables. Mon May 4 17:45:31 1987 Richard M. Stallman (rms at prep) * dired.c (Ffile_attributes): Doc fix. * term.c (term_init): Mention `unsetenv TERMCAP' in error message for invalid TERM variable. Mon Apr 27 09:30:55 1987 Richard Mlynarik (mly at prep) * fileio.c (APOLLO from lnz): Fcopy_file, Fset_file_modes: Don't use un*x modes if env var USE_DOMAIN_ACLS is set. Fset_file_modes: utimes fix. Finsert_file_contents: Must do fstat after open for Apollo. * emacs.c (main): (APOLLO from lnz): Don't use un*x modes if env var USE_DOMAIN_ACLS set. Sat Apr 25 11:54:45 1987 Richard Mlynarik (mly at prep) * unexec.c: CANNOT_UNEXEC Code from lnz (from rps@apollo). Similar to vmsmap.c. * sysdep.c: (APOLLO from lnz) init_baud_rate: Make sure ospeed is initialized even if ioctl fails. wait_for_termination: can sigpause. init_sys_modes: moved static structures out. Thu Apr 23 11:32:21 1987 Richard Mlynarik (mly at prep) * malloc.c, vmsmap.c: (VMS) Define and use our own `sbrk' since malloc and the RTL sbrk don't interact very well. (sasaki@harvard.harvard.edu <8704220244.AA02324@prep>) Sun Apr 15 12:43:55 1987 Richard Mlynarik (mly at prep) * dispnew.c: (VMS) Flush TIOCOUTQ stuff (meaningless on VMS) * fileio.c, sysdep.c: (VMS) Rename "define-logical-name" => "define-dcl-symbol" * m-irist.h: New file from raible@orville.arpa for iris machine (`3.5 turbo'). (<8704150216.AA21012@orville.arpa>) * unexec.c: iris code (is USG, but has struct exec) * sysdep.c: iris utimes emulatation. (HAVE_TIMEVAL) * process.c: (IRIS) #include pty: Unusual iris pty-finding code. IRIS_ignore_SIGIOT_kludge, init_process: Iris pty's have some unknown bug which seems to cause spurious SIGIOTs. Can somebody please delve into the reasons behind this lossage? Wed Apr 15 01:29:16 1987 Paul Rubin (phr at prep) * version 18.44 released. Tue Apr 14 18:05:24 1987 Paul Rubin (phr at prep) * config.h: Increase PURESIZE to 115800 from 115600. Tue Apr 14 10:14:13 1987 Richard Mlynarik (mly at prep) * termcap.c (tgetent) (VMS): File is in emacs_library:[etc]termcap.dat (TUNG@WAIF.MIT.EDU <8704130324.AA10879@prep.ai.mit.edu>) Fri Apr 10 14:30:54 1987 Richard Mlynarik (mly at prep) * window.c (Fset_window_configuration): Don't unchain markers -- this window configuation may be used again. Let normal GC unchain them. Wed Apr 8 13:48:45 1987 Richard Mlynarik (mly at prep) * m-vax.h: (USG 5.2) define NO_REMAP to kludgily bypass unexec bug. (We don't have such a machine here, so -we- can't find the bug!) (Karl.Kleinpaste <205@cbstr1.att.com>) Tue Apr 7 09:32:08 1987 Richard Mlynarik (mly at prep) * indent.c (compute_motion): Use special code for HPOS if SHORT_CAST_BUG. * m-celerity.h, m-att3b.h, m-ibmrt.h, m-sequent.h: Define SHORT_CAST_BUG. Mon Apr 6 12:48:54 1987 Richard Mlynarik (mly at prep) * malloc.c (morecore): Don't assume sbrk clears memory to 0's. * indent.c (compute_motion): Special-case HPOS for sequent. (iglesias@ICS.UCI.EDU <8704061703.AA26816@prep.ai.mit.edu>) * regex.c: Fix bug in which "t\(.*\) .*\1" didn't match "tom hates tomatoes" from Tom May @ Washington. (<8703241000.AA21146@beaver.cs.washington.edu>) * sysdep.c (getwd): (USG) Change first arg (0) to getcwd to (char *) 0 Also, call `free' on value returned (after we save it) Sun Mar 22 09:23:24 1987 Richard M. Stallman (rms at prep) * Version 18.41 released. * emacs.c (main): Call syms_of_xmenu only if HAVE_X_MENU. * ymakefile: Use new switch HAVE_X_MENU to decide whether to includ xmenu.c * config.h-dist: Tell people about this flag. Fri Mar 20 12:12:02 1987 Richard Mlynarik (mly at prep) * filemode.c: Hacks for set-uid/gid but not executable. Fri Mar 20 10:06:13 1987 Richard M. Stallman (rms at prep) * sysdep.c [VMS]: include window.h. * sysdep.c (wait_for_kbd_input) [VMS]: Also detect and handle input from subprocesses. * fileio.c (Fread_file_name_internal) [VMS]: At end, check length of NAME, not STRING. * emacs.c (main) [VMS]: If SHAREABLE_LIB_BUG, declare `environ' noshare and initialize it from `envp'. Fri Mar 20 06:55:01 1987 Chris Hanson (cph at prep) * process.c (pty): On hp-ux, do not enable TIOCREMOTE. See the code for a comment explaining why. Thu Mar 19 14:09:15 1987 Richard M. Stallman (rms at prep) * sysdep.c: Omit start_of_{data,text} if CANNOT_DUMP and SYSTEM_MALLOC. * m-apollo.h: Define START_FILES. * sunfns.c (syms_of_sunfns): Syntax error in comment. * sysdep.c (getwd) [USG]: Copy the value of getcwd into pathname. Supposedly needed on Altos 3068. Wed Mar 18 11:23:33 1987 Richard M. Stallman (rms at prep) * Version 18.40 released. * fileio.c (Finsert_file_contents): On VMS, # bytes read may be less than st.st_size. Use actual # read for recording undo. * fileio.c, termcap.c: Change funny VMS-format #includes to standard Unix format. Tue Mar 17 09:57:26 1987 Richard M. Stallman (rms at prep) * unexec.c (copy_text_and_data): A_TEXT_SEEK if defined controls where in the file to start writing the text segment. * m-isi-ov.h: Define A_TEXT_SEEK and A_TEXT_OFFSET. * s-umax.h: Define C_SWITCH_ASM so as to make `asm' work. * ymakefile: Provide C_SWITCH_ASM when compiling crt0.c. * unexec.c [UMAX]: Don't include filehdr.h, etc. * bytecode.c (Fbytecode): Another SWITCH_ENUM_BUG problem. * sysdep.c: If not HAVE_TERMIO, override any definition of TCSETAW. Ultrix 2.0 has a TCSETAW but it requires a struct termio. Since HAVE_TERMIO is not set, sysdep uses struct sgttyb, and the real TCSETAW does not work with this. * sysdep.c (getwd): Discard everything before first slash. * termcap.c (tgetent): Delete VMS code to delete / from filename. * termcap.c (legal_filename_p): Use symbolic constant. * sysdep.c (sys_abort) [VMS]: New function; calls debugger. * sysdep.c (sys_access) [VMS]: Completely rewritten. Now two versions, one for VMS 4.4 and one for older VMS. * sysdep.c (sys_errlist) [VMS]: Insert missing elt for error code 0. * sysdep.c (get_system_name) [VMS]: Remove :: from end of node name. * sysdep.c (end_kbd_input) [VMS]: Don't wait if within ast rtn. * sysdep.c (kbd_input_ast) [VMS]: Set ast_active to 1 while in this fn. * sysdep.c: Add missing ; after use of BAUD_CONVERT. * term.c (term_init): Don't use Down on VMS if it's a ^J. Fix C syntax errors in fatal error message. Distinguish failure to open termcap fle from undefined term type. * s-vms.h: Increase DATA_START by 512. #define abort sys_abort. Flush LIBS_DEBUG defn since ymakefile not used. Delete mention of GET_RIGHTS. * m-vax.h [VMS]: Define LOAD_AVE_TYPE and C_ALLOCA. * keyboard.c: Undefine SIGIO only if it's defined. * keyboard.c (interrupt_signal) [VMS]: Try suspending in case it works. * fns.c (Fload_average): Make eunice code work on native VMS also. Put the no-load-average case first for simplicity. * fileio.c (directory_file_name [VMS]: Use SYS$PARSE for [--] and other such constructs. * fileio.c (Fexpand_file_name) [VMS]: Handle negative version #s. * doc.c: Don't include paths.h * callproc.c (init_callproc): Make Vexec_directory using Ffile_name_as_directory. * alloc.c: Remove defns of `sdata' and `edata'. Mon Mar 16 09:48:40 1987 Richard M. Stallman (rms at prep) * fns.c (Fy_or_n_p): Restore cursor_in_echo_area to previous value. * m-ibmrt.h: Define SKTPAIR only if BSD. * Makefile: Default is now `all', which tells xmakefile to make `all'. * ymakefile: Make emacstool by way of etc/Makefile. * emacs.c (main): Don't mention SIGEMT if it's not defined. Sat Mar 14 06:56:53 1987 Richard M. Stallman (rms at prep) * Version 18.39 released. * s-umax.h: Add definition of SEGMENT_MASK. * Delete definition of LIBS_SYSTEM. * align.umax: File deleted. * emacs.c (main): Don't mention syms_of_vmsfns explicitly. * s-vms.h: Use SYMS_SYSTEM to call syms_of_vmsfns. * config.h-dist: Remove VMS conditional for PURESIZE. * s-vms.h: Define PURESIZE. * m-sun2.h: Define PURESIZE, if HAVE_SUN_WINDOWS. Fri Mar 13 18:35:09 1987 Richard M. Stallman (rms at prep) * sysdep.c: Don't redefine TCSETAW if already defined. (Cancelled by change on March 17). * sunfns.c: New file containing interface to Sun windows. This is enabled by the switch HAVE_SUN_WINDOWS. * m-sun2.h: If HAVE_SUN_WINDOWS, include sunfns.c via OBJECTS_MACHINE and SYMS_MACHINE. * emacs.c (main): Allow SYMS_SYSTEM and SYMS_MACHINE to control calling of extra syms_of_... functions. * ymakefile (OBJECTS_MACHINE, OBJECTS_SYSTEM): Provide for m- and s- files to specify additional object files to link into temacs. Thu Mar 12 12:59:38 1987 Richard M. Stallman (rms at prep) * fileio.c (Fsysnetunam): Make this function conditional on HPUX_NET, not on HPUX. * s-hpux.h: Make use of -ln switch depend on HPUX_NET. Define HPUX_NET in config.h if you have that version of HPUX. * unexec.c (adjust_lnnoptrs) [amdahl_uts]: Alternative names for struct symentry and struct auxentry. * sysdep.c [amdahl_uts]: Define sign_extend_temp as on ATT3B. * m-amdahl.h: New file. Thu Mar 12 10:37:56 1987 Richard Mlynarik (mly at prep) * sysdep.c (child_setup_tty): HPUX: Set baud-rate to 9600 (not 38400) For some reason the former is reported to work faster(!?) Tue Mar 10 14:29:19 1987 Richard M. Stallman (rms at prep) * dispnew.c (init_display): Declare alternate_display only if X. Mon Mar 9 12:43:06 1987 Richard M. Stallman (rms at prep) * m-alliant.h, crt0.c for alliant: Must save _curbrk when dumping (from ADJUST_EXEC_HEADER) and restore it in crt0, because _curbrk itself isn't dumped. * unexec.c: Add a separate unexec routine for mips machines. No code is shared with normal unexec. Sun Mar 8 08:15:50 1987 Richard M. Stallman (rms at prep) * sysdep.c (baud_convert): Use new macro BAUD_CONVERT to override the standard conversion table. Use standard table if macro's not defined. * s-vms.h, s-hpux.h: Definitions of BAUD_CONVERT. * editfns.c (Fsubst_char_in_region): Call modify_buffer before changing it, and pass entire region. If NOUNDO is set, un-increment bf_modified after that. Sat Mar 7 14:50:26 1987 Richard M. Stallman (rms at prep) * lisp.h: #ifndef the definitions of XUINT, XSET, XMARKBIT, etc. Make them all use XUINT when they want to extract the unsigned value. Thu Mar 5 15:10:38 1987 Richard M. Stallman (rms at prep) * term.c (write_standout_marker): If "xs" present and sg#0, don't write standout-off markers. * xmenu.c: Include signal.h before xterm.h. * sysdep.c (reset_sys_modes): Do fsync (on bsd4.2 or 4.3) before changing the terminal modes. * ymakefile (emacstool): Remove spurious `/' after `${etcdir}'. * m-sun2.h: Likewise. * process.c: Replace BSD conditionals with HAVE_SOCKETS for tcp stuff. Give NETCONN_P a default definition if not HAVE_SOCKETS. Don't defsubr open_network_stream if not HAVE_SOCKETS. * s-*.h: Define HAVE_SOCKETS, or add place holder. * m-stride.h: Define HAVE_SOCKETS. Wed Mar 4 03:28:58 1987 Richard M. Stallman (rms at prep) * ymakefile (LIBX): add -lXMenu. Tue Mar 3 21:34:40 1987 Richard M. Stallman (rms at prep) * fileio.c (Fwrite_region): Really put the `fstat' after the `fsync', trying to solve spurious "file has changed" warnings. This reverses a change made on Jan 28 which was described then as putting the `fstat' after the `fsync' but which in fact was exactly the opposite. The truth is that anciently the `fstat' was after, and on Jan 28 it was moved before. The change on Jan 28 was to fix some sort of RFS problem. I don't know whether the change itself or just its description was incorrect. * Version 18.38 released. Sat Feb 28 21:36:31 1987 Chris Hanson (cph at prep) * fileio.c: Added `sysnetunam' function for controlling remote file access connections under hp-ux. * s-hpux (LIBS_SYSTEM): Added `-ln' which is used by `sysnetunam'. Sat Feb 28 14:12:07 1987 Richard M. Stallman (rms at prep) * xdisp.c (display_text_line): Typo in line that fixes tab_width. Fri Feb 27 14:02:41 1987 Richard M. Stallman (rms at prep) * dispnew.c (Fopen_termscript): `report_file_error' requires list as 2nd arg. Thu Feb 26 01:53:16 1987 Richard M. Stallman (rms at prep) * xmenu.c: New file defining Fx_popup_menu. * emacs.c (main): Call syms_of_xmenu. * buffer.c (Fother_buffer): Condition for assigning to `notsogood' was backwards (should be if null). Mon Feb 23 02:59:45 1987 Richard M. Stallman (rms at prep) * keymap.c (access_keymap): No longer check lower case equivalent of an upper case letter that is undefined. * keyboard.c (read_key_sequence): If an upper case letter is undefined, and corresponding lower case letter is defined, use the lower case letter instead. * emacs.c: Delete all ALLIANT conditionals that used to save and restore _curbrk. Special code in crt0.c now handles this. * crt0.c [ISI68K]: Assembler code to put a .word 0 after _start. Include the dummy arg `ignore' in start1. * crt0.c [orion/pyramid/celerity]: ALLIANT now uses this case, but with some special code to hack _curbrk on first startup. * m-alliant2.h: File deleted. Use m-alliant.h for version 2. * m-alliant1.h: Don't look for ALLIANT2 to be defined. Now ALLIANT1 is defined for version 1 and not for version 2. Define NO_ARG_ARRAY only for version 1. Define START_FILES so GNU crt0.c gets used. Remove definition of TEXT_START (safe since GNU crt0.c is used). Add to ADJUST_EXEC_HEADER something to set unexec_text_start. Sun Feb 22 22:18:00 1987 Richard M. Stallman (rms at prep) * dispnew.c (Fopen_termscript): Close existing termscript file before trying to open a new one. Report open failure with report_file_error. Sat Feb 21 05:13:46 1987 Paul Rubin (phr at prep) * window.c (set-window-buffer): typo "set-widow-buffer". Thu Feb 19 15:28:01 1987 Richard Mlynarik (mly at prep) * lisp.h: Add type Lisp_Window_Configuration, delete Lisp_Temp_Vector. A window configuration is a Lisp_Vector-like object. Add decls for F{set,current}_window_configuration. * window.c (F{set,current}_window_configuration): New lisp-callable functions which do the guts of Fsave_window_excursion. Also fixed a bug in which point was not being restored in buffer currrent at end of save-window-excursion and that buffer was not current when the config was recorded (It is supposed to not be restored if it was current at the start) * alloc.c (mark_object): Add case for Lisp_Window_Configuration; remove code for Lisp_Temp_vector. * window.c, window.h: Rename Fshow_buffer Fset_window_buffer (which was previously the synonym in subr.el) * keyboard.c, minibuf.c: Window configuration caller changes. * print.c (print): Understand Lisp_Window_Configuration's. Print a disturbing message if encounter an illegal dtp -- perhaps this should core-dump? Tue Feb 17 13:13:13 1987 Richard Mlynarik (mly at prep) * dired.c (Ffile_attributes): Use make_number. (XINT doesn't work on LHS of assignment) Tue Feb 17 04:02:04 1987 Richard M. Stallman (rms at prep) * doc.c (get_doc_string, Fsnarf_documentation): In vms4.4, avoid system bug by using sys_translate_unix to translate filename to VMS format before opening. Mon Feb 16 05:20:41 1987 Richard M. Stallman (rms at prep) * crt0.c: Don't define `environ' if DONT_NEED_ENVIRON is defined. * m-elxsi.h: Define DONT_NEED_ENVIRON Define C_DEBUG_SWITCH as -O since there is no debugger. Don't define VIRT_ADDR_VARIES. * xdisp.c (display_mode_element): Handle SWITCH_ENUM_BUG. * sysdep.c (reset_sys_modes): Loop on TCSETAW until it does not get EINTR. Sun Feb 15 18:01:37 1987 Richard M. Stallman (rms at prep) * s-bsd4-2.h: Make defns of BSD and BSD4_2 conditional. Fri Feb 13 12:27:05 1987 Richard M. Stallman (rms at prep) * process.c: TCP connection feature from markl@jhereg.lcs.mit.edu. Uses a process-object to represent a connection. childp field is now Qt for a real subprocess, or a hostname string for a tcp connection. NETCONN_P checks this. Status strings "open" and "closed" replace "run" and "exit" for tcp connections only. New function Fopen_network_stream. * dired.c (Ffile_attributes): Use XINT to store the inode #. It can be out of range for integers. Thu Feb 12 11:55:11 1987 Richard M. Stallman (rms at prep) * xdisp.c (try_window): Fix paren errer in checking hpos against hscroll. This caused window_end_pos to be wrong when there was hscroll. * xdisp.c (display_text_line): Move code that inserts `$' at bol for hscroll, so that its alteration of p1 does not interfere with setting point_hpos. Use lastpos instead of pos in that code. Make lastpos be accurate in all cases including when there is truncation. * xdisp.c (display_string): mincol==-1 means no minimum. * xdisp.c (display_text_line): Use -1 for mincol of minibuf promp. Wed Feb 11 19:30:54 1987 Richard M. Stallman (rms at prep) * Version 18.37 released. * data.c (Fmake_local_variable, Fmake_variable_buffer_local): Get error if arg is t or nil. Doc improvements. Tue Feb 10 09:56:01 1987 Richard Mlynarik (mly at prep) * xfns.c (Fx_get_default): Add (unsigned char *) cast. * window.c: typo. Mon Feb 9 00:06:29 1987 Richard M. Stallman (rms at prep) * process.c (change_msgs): Save/restore selected buffer only over simple insertions, and over one such at a time. Don't save it across sentinel invocations. Sun Feb 8 09:37:06 1987 Richard M. Stallman (rms at prep) * tparam.c (tparam): Supply code for NO_ARG_ARRAY case. * window.c, minibuf.c, window.h: Rename minibuf_scroll_window to Vminibuf_scroll_window. Make it a Lisp variable. * window.c (Fscroll_other_window): Validate Vminibuf_scroll_window since user could store a non-window there. * window.c (temp_output_buffer_show): Call Vtemp_output_buffer_show_hook to do the work, if not nil. * window.c (Fminibuffer_window): New function. * print.c (print, syms_of_print): If print_escape_newlines is nonzero, print newlines in strings as \n. * minibuf.c (read_minibuf): Reduce arg to get_minibuf by 1. Thus, use *Minibuf-0* for outer-level minibuffers. * keyboard.c (command_loop_1): Pass 2nd arg to Fsit_for. * minibuf.c (temp_minibuf_message): Likewise. * dispnew.c (Fsit_for): 2nd arg non-nil means don't redisplay. * s-vms.h: Don't define VMS4_0, VMS4_2 or VMS4_4. * s-vms4-[024].h: New files that include s-vms.h and also define VMS4_0 or VMS4_2 or VMS4_4. * vmspaths.h: Remove `/emacs' from all paths, to go with a change in emacs.com that includes that path segment in emacs_library. * term.c (term_init): Different message on VMS for invalid termtype. * alloc.c (Fgarbage_collect): After GC, clear marks in the dummy buffers buffer_defaults and buffer_local_symbols. Sat Feb 7 20:12:23 1987 Richard M. Stallman (rms at prep) * window.c (Fnext_window): Restore old meaning of t as 2nd arg: count minibuffer window even if not active. Non-t-non-nil as 2nd arg means never count minibuffer window. * window.c (window_loop): Rewrite to work the old way. The new way did not work when deleting windows. Thu Feb 5 01:56:33 1987 Richard M. Stallman (rms at prep) * m-sequent.h: Undef old definition of KERNEL_FILE so no warning. * process.c (read_process_output): Don't restore selected buffer after filter; sometimes setting buffer is useful in filter functions. Mon Feb 2 23:26:46 1987 Richard M. Stallman (rms at prep) * keyboard.c (kbd-buffer_store_char): Fix paren error. Sat Jan 31 11:06:24 1987 Richard M. Stallman (rms at prep) * window.c (window_loop): Rewrite not to pass t as 2nd arg to Fnext_window by starting loop from the window after the minibuffer. This was sole use of the feature. * window.c (Fnext_window): Change meaning of t as 2nd arg. It now means to ignore the minibuffer even if it's active. Thu Jan 29 19:15:26 1987 Richard M. Stallman (rms at prep) * cmds.c (Fforward_line): Correct the returned value. Wed Jan 28 03:15:48 1987 Richard M. Stallman (rms at prep) * keyboard.c (kbd_buffer_store_char): Ignore meta bit while checking for C-g, if meta-flag is clear. * unexec.c (make_hdr): typo `bas_start'. * sysdep.c: Declare errno explicitly since errno.h may fail to. * fileio.c (Fwrite_region): Move the fstat after the fsync. [Note: the above sentence was incorrect; actually the fstat had been after and was moved *before* the fsync. -- RMS, Mar 3.] Avoids RFS lossage with fsync (maybe). * s-rtu.h: Define NLIST_STRUCT and LDAV_SYMBOL. * m-masscomp.h: Check machine type to choose between C_ALLOCA and HAVE_ALLOCA. Tue Jan 27 11:09:47 1987 Richard Mlynarik (mly at prep) * window.c (change_window_height): Validate window_min_height. Mon Jan 26 13:27:23 1987 Richard M. Stallman (rms at prep) * m-ibmrt.h: LOAD_AVE_TYPE now double. Now both operating systems for RT now supported. * fileio.c (Fsubstitute_in_file_name): Delete everything thru last /~ or // in file name. * sysdep.c (select): If no subprocesses, make `child_changed' local and initialized to 0. * xdisp.c (display_string): If TRUNCATE is 0, display all the way to window edge; don't stop one column short. Sat Jan 24 14:36:26 1987 Richard M. Stallman (rms at prep) * unexec.c (make_hdr): New var `bss_end' holds end-of-bss address. This simplifies computation of bss size while keeping it from being negative. Fri Jan 23 08:56:56 1987 Richard Mlynarik (mly at prep) * fileio.c (Fexpand_file_name): Have to do checks for "//" "/~" etc even if filename is non-absolute, otherwise things like "~user1/~user2" aren't expanded correctly (was getting "/u/user1/~user2" instead of "/u/user2") * doc.c (Fsubstitute_command_keys): Doc fix. * m-stride.h: Fixes from bruce@stride.com Thu Jan 22 00:01:01 1987 Richard M. Stallman (rms at prep) * eval.c (Feval, apply_lambda): When protecting a vector of evaluated arguments, across the loop that evals them, always set gcproN.nvars to the number of args evalled so far, since the rest of the vector elements are still garbage. Wed Jan 21 00:36:04 1987 Richard M. Stallman (rms at prep) * Version 18.36 released. Wed Jan 21 00:36:04 1987 Richard M. Stallman (rms at prep) * term.c (write_chars): If we find N identical chars and that is too few for a Repeat operation, don't consider the last N-1, last N-2, ... of those chars. * dispnew.c (update_line): Fill old line with spaces to screen_width - 1 if it is highlighted (just like new line). * bytecode.c (Fbytecode): Include bytecode pc value in stack over/underflow errors Tue Jan 20 20:46:34 1987 Richard M. Stallman (rms at prep) * lread.c (defvar_lisp_nopro): New fn like defvar_lisp but doesn't call staticpro. * lisp.h (DEFVAR_LISP_NOPRO): New macro to call that function. * buffer.c (syms_of_buffer): Use DEFVAR_LISP_NOPRO to define variables that live in buffer_defaults. * buffer.c (init_buffer_once): tab_width was being assigned two different flag bits. * keyboard.c: #undef SIGIO if there's no FIONREAD. Mon Jan 19 22:01:35 1987 Richard M. Stallman (rms at prep) * indent.c (compute_motion): IBMRT needs HPOS defined like celerity. Fri Jan 16 15:33:58 1987 Richard Mlynarik (mly at prep) * xfns.c (Fx_set_{background,cursor,mouse}_color): Initialise save_color. * fileio.c, search.c, sysdep.c, filelock.c, editfns.c, process.c: Delete/replace unused/conditionalised variables Thu Jan 15 22:23:01 1987 Richard M. Stallman (rms at prep) * fns.c (Fcopy_alist): Pass missing arg to concat. * termcap.c (tgetent): Remove extra arg given to find_capability. * alloc.c (make_uninit_string, init_alloc_once): * indent.c (compute_motion): Delete unused vars. * fileio.c (Frename_file): Add missing arg to Fcopy_file. * alloc.c (mark_object): Add cast for cleanliness. Remove unnecessary break stmt. * keyboard.c (kbd_buffer_get_char): Flush unused local var. Thu Jan 15 15:28:49 1987 Richard Mlynarik (mly at prep) * dispnew.c (init_display): Hack X if "-d display-name" specified, even if env var DISPLAY not set. Thu Jan 15 13:01:05 1987 Richard M. Stallman (rms at prep) * fns.c (Fconcat): doc fix. Thu Jan 15 09:13:20 1987 Richard Mlynarik (mly at prep) * keyboard.c (last_command): doc fix Tue Jan 13 16:27:43 1987 Richard M. Stallman (rms at prep) * process.c (create_process): Cast value of `signal' to insulate from * sysdep.c (sys_suspend, select): changed value type in sysV.3. Mon Jan 12 12:33:42 1987 Richard M. Stallman (rms at prep) * sysdep.c (reset_sys_modes): Use TCSETAW to restore tty state. On BSD, define TCSETAW to be TIOCSETN (so no change here on BSD). * callproc.c (init_callproc): Don't get environment as strings when dumping Emacs. Mon Jan 12 00:19:26 1987 Richard Mlynarik (mly at prep) * lread.c (Fload, load_unwind): load_in_progress must be a counter, not a flag since `load' may be called recursively. * lread.c (openp): If PATH contains non-absolute element (such as ".") expand against bf_cur->directory. * filemode.c (ftypelet): Understand (and return) more different file-types (stat->st_mode's) This makes Ffile_attributes more winning. * filelock.c (current_lock_file_owner_1): Always close the fd even if get an error reading!!! Sun Jan 11 20:34:43 1987 Richard Mlynarik (mly at prep) * fileio.c (Fsubstitute_in_file_name, Fread_file_name_internal): `Quote' "$" as "$$" This doesn't break any existing code, since "$$" used to get an error, and wins by providing the user a way to specify filenames containing the character "$" * fileio.c (Fsubstitute_in_file_name): Allow substituting zero-length env vars. Sat Jan 10 10:52:46 1987 Richard M. Stallman (rms at prep) * termcap.c (tgetent): Fix syntax errors in VMS-only code. Fri Jan 9 15:00:41 1987 Richard Mlynarik (mly at prep) * xterm.c (x_term_init): Give correct error message when DISPLAY not set. Thu Jan 8 11:45:51 1987 Richard Mlynarik (mly at prep) * xfns.c (Fx_get_default): Return nil, not "" on non-existent option, as documented. Don't randomly and unnecessarily malloc (and then not free) * process.c (init_process): Look at extern var initialized rather than having arg passed. * emacs.c (main): Dike out the code which hacked the "-nx" option as synonymous with "-nw" if HAVE_X_WINDOWS -- this code was never distributed earlier, so there was no need to retain a compatibility kludge. Thu Jan 8 00:43:04 1987 Richard M. Stallman (rms at prep) * search.c (Freplace_match): Change declaration `char' to `int'. Declaring a scalar variable `char' is nearly always wrong and breaks most compilers. Wed Jan 7 13:52:12 1987 Richard M. Stallman (rms at prep) * xterm.c (flashback): Change || to | in signal mask calculation. Tue Jan 6 20:29:59 1987 Richard M. Stallman (rms at prep) * print.c (print): RTPC_REGISTER_BUG conditional. * data.c (Fset): likewise. * m-ibmrt.h (SIGN_EXTEND_CHAR): Flush the definition that used a subroutine and really install the one that uses arithmetic. Tue Jan 6 14:29:55 1987 Richard Mlynarik (mly at prep) * keyboard.c (kbd_buffer_{read,store}_char): Look at MetaFlag when reading char out of buffer rather than storing into it so that buffer-local meta-flag works correctly. Tue Jan 6 13:53:52 1987 Richard M. Stallman (rms at prep) * syntax.c (Fchar_syntax, Fmodify_syntax_entry): Mask specified char to 8 bits before indexing syntax table. Mon Jan 5 17:21:59 1987 Richard Mlynarik (mly at prep) * callproc.c (init_callproc): Make maintain_environment stuff work yet again. Mon Jan 5 01:15:17 1987 Richard M. Stallman (rms at prep) * fileio.c (report_file_error): Check for errno < 0. * Version 18.35 released. Sat Jan 3 14:28:38 1987 Richard M. Stallman (rms at prep) * callproc.c: Rename Vprocess_extra_environment => Vprocess_environment. * callproc.c (init_callproc): Copy Unix environment into Vprocess_environment as list of strings. * callproc.c (child_setup): Set `env' from Vprocess_environment alone; don't keep `env' passed by caller. * ymakefile: New cpp-macro OTHER_FILES specifies how to make the file `other'. * m-sun2.h: Define OTHER_FILES to compile etc/emacstool. * xfns.c (Fx_mouse_events, Fx_proc_mouse_event): Set 4 bit in button character for a button-up event. * xfns.c (most calls to XSelectInput): * xterm.c (XPopUpWindow): Calls that specify ButtonPressed now also say ButtonReleased. * xterm.c (XTread_socket): Handle ButtonReleased like ButtonPressed. * indent.c (Fmove_to_column): Declare `c' int; type char caused lossage for chars >= 0200. * search.c (search_buffer): Don't accept a match starting right at the end of the buffer. * xfns.c: Move extern declarations to top level. Some functions were depending on the fact that all extern declarations are effectively at top level in pcc. * buffer.c (Fbuffer_start_undo): Get error right if non-ex buf spec'd. * indent.c (several): Fix range checks on tab_width: replace && with ||. Thu Jan 1 17:08:59 1987 Richard Mlynarik (mly at prep) * indent.c (Fcurrent_column, Fmove_to_column): Doc. * window.c (Fwindow_edges): Doc. * process.c, callproc.c: Make MAINTAIN_ENVIRONMENT stuff work yet again. Clean up calling sequence of child_setup. Wed Dec 31 04:07:42 1986 Richard M. Stallman (rms at prep) * search.c (search_command): abort before setting point if new point value is out of range. * buffer.c (Fbuffer_enable_undo): New function. Fri Dec 26 17:47:49 1986 Richard M. Stallman (rms at prep) * casefiddle.c (casify_region): Don't upcase within word for CASE_CAPITALIZE_UP. Wed Dec 24 18:13:18 1986 Richard M. Stallman (rms at prep) * window.c (save_window_save_1): Don't make windows for start, pointm and mark fields of windows without buffers; just store nil there. Also store nil in start_at_line_beg field (was uninitialized and that caused crash in GC). * window.c (all functions): Add register declarations. * window.c (Fsave_window_excursion): Don't gcpro the saved window status. The specpdl does it. Tue Dec 23 16:50:06 1986 Richard M. Stallman (rms at prep) * search.c: static_BM_tab should not be initialized. Mon Dec 22 02:03:51 1986 Richard M. Stallman (rms at prep) * term.c (term_init): Default Wcm.cm_tab to 0 if no `ta' string. * fns.c: MASSCOMP_REGISTER_BUG => MASSC_REGISTER_BUG * fns.c (Fnth): Moved from subr.el. * keymap.c (Fcopy_keymap): Moved from subr.el. * xdisp.c: Delete this_line_hpos; last dispnew change ends need for it, and it was causing incorrect positioning after direct_output_for_self_insert. * fns.c: Avoid warning if param.h defines BSD4_3. * dispnew.c (update_screen): Don't actually alter cursX and cursY when putting cursor in echo area. Sun Dec 21 00:48:00 1986 Richard M. Stallman (rms at prep) * window.h: New window field window_end_valid. window_end_pos is now always positive; validity info is in window_end_valid, which is t for valid and nil for not. * xdisp.c: Changed all uses of window_end_pos to use window_end_valid appropriately as well. * process.c (wait_reading_process_input): read_kbd is now a process pointer to wait for input from one process. Return immediately if that process is not running. * process.c (Faccept_process_output): Pass process pointer to wait_reading_process_input. Sat Dec 20 23:55:55 1986 Richard Mlynarik (mly at prep) * keyboard.c (Fsuspend_emacs): If `suspend-emacs-hook' returns t don't suspend -- assume the hook did the equivalent of `suspending' for us (including calling suspend-resume-hook if necessary.) Otherwise, call sys_suspend and so forth normally. Sat Dec 20 22:42:52 1986 Richard M. Stallman (rms at prep) * buffer.c (Frename_buffer): If have auto save file but no visited file, call rename-auto-save-file (a Lisp function). * buffer.c: add lots of register declarations. (list_buffers_1): combine local `mode' with `tail'. Sat Dec 20 15:47:01 1986 Richard Mlynarik (mly at prep) * xdisp.c (DoDsp and this_line_*): Rename this_line_hpos -> this_line_start_hpos. New variable this_line_hpos is cached horizontal position on screen of point. Make this_line_* static variables. In DoDsp, rearrange the tests to see whether to use cached line info to be a little faster. Fix some bugs in which cursX and cursY might not be updated correctly when using cached info (needed to add this_line_hpos variable to do this correctly) (Added unnecessary gotos and label `cancel' for added readability) * fns.c (Fy_or_n_p): Move cursor to start of line after reading answer so user knows emacs is proceeding. (Like after minibuffer exits) * dispnew.c (Fopen_termscript): Arg of nil means to close current termscript file (if any) * keymap.c (Fwhere_is_internal): Doc fix. * indent.c, search.c, xdisp.c: All callers of ScanBf were searching for '\n' Rename this function find_next_newline and drop first arg. * indent.c (Fvertical_motion): Doc string addition. * keyboard.c (EchoThem): Test for echo_keystrokes > 0, rather than echo_keystrokes != 0 * keyboard.c (get_char, read_key_sequence): Echo immediately if cursor_in_echo_area, otherwise can have the confusing situation of the cursor appearing at the start of the echo area, but not have any echo appear until one second later. Wed Dec 17 12:27:01 1986 Richard M. Stallman (rms at prep) * editfns.c: Add register declarations and a few vars for cses. * editfns.c (Fchar_equal): Avoid indexing downcase_table with numbers larger than 0xff. Tue Dec 16 01:05:16 1986 Richard M. Stallman (rms at prep) * alloc.c: New garbage collection technique for strings. Strings that have string blocks individually allocated are called "large strings". Other strings are called "small". The string blocks for small strings are now chained both ways and there is a pointer to the oldest one of them in `first_string_block'. The string blocks for large strings are chained only from the latest to the oldest, and the latest is in `large_string_blocks'. Garbage collection starts by setting MARKBIT in the `size' of each large string. This allows mark_object to distinguish them. MARKBIT in string sizes is cleared by gc_sweep. Large strings are freed individually by GC, like vectors. Those in use are marked with ARRAY_MARK_FLAG in the `size' field. Small strings are relocated, compressing them within their string blocks. mark_object puts all slots that point at a string onto a chain which runs from the string's `size' field, through all the slots that used to point at the string. The end of the chain is shown by a number that is small enough to be a small string's length. This new technique avoids calling malloc during GC. Thus, there is no danger of fatal error on exhausting memory. Also, space needed for strings is cut in half. The new technique introduces a potential for bugs, however. If any slot is marked twice--for example, if it is GCPRO'd twice by different functions--and it contains a string, the ref chain of the string may become garbled. Sometimes it will still work! This is because a slot that's part of a string's ref chain will look like a Lisp_Int if the next thing in the chain is malloc'd memory. But this will not win if the next thing in the chain is a stack slot, or if malloc'd data lives high up in memory. To avoid this problem, MARKBIT is used in stack slots to prevent double marking. * bytecode.c (Fbytecode): Adjustment of gcpro1.nvars before call to Ffuncall was off by one. * alloc.c (make_uninit_string): make_zero_string renamed as this and no longer zeros the contents. * alloc.c (Fmake_string): initialize string contents. * alloc.c (struct string_block): Now chained both ways thru `next' and `prev' fields. `first_string_block' exists. Strings with individual string blocks are now called "large" and these string blocks go in a separate chain which starts from `large_string_blocks' and runs via `prev' fields only. * alloc.c: Stop using clear_marks. Make gc_sweep clear the marks on all live objects. * alloc.c (malloc_warning, Fgarbage_collect): Eliminate mechanism that defers malloc warnings during GC, since GC no longer calls malloc. * fns.c: Fding requires an arg; pass Qnil. * m-alliant.h: define TEXT_START as 0x1000. Don't define LIBS_STANDARD; the default (sharable) library is said to work now. * alloc.c (mark_object): Now pass address of slot being marked. mark_object itself can alter the slot when necessary. It now returns no value. All callers changed to pass the address. mark_object can now ignore the mark bit if it's set in the slot. Callers need no longer make a copy in which mark bit is clear. mark_object can clear the mark bit so these callers must still set the mark bit again after calling mark_object on such slots. Mon Dec 15 21:25:18 1986 Richard M. Stallman (rms at prep) * process.c (create_process): TIOCNOTTY needs no 3rd arg after all. * sysdep.c (set_exclusive_use): ditto for FIOCLEX. * emacs.c (Fdump_emacs): [ALLIANT] Copy _curbrk into save_curbrk, not vice versa. Sat Dec 13 02:32:47 1986 Richard M. Stallman (rms at prep) * sysdep.c (flush_pending_output): 3rd arg to TIOCFLUSH now is address of word containing zero. It matters. * editfns.c (Fformat): Fix another error in previous bug. Fri Dec 12 10:34:02 1986 Richard M. Stallman (rms at prep) * Version 18.33 released. * data.c: Add many register declarations. * editfns.c (Fformat): Last change left `n' one too small. Thu Dec 11 17:43:44 1986 Richard M. Stallman (rms at prep) * keyboard.c (Fsuspend_emacs): Pass no args to the suspend-resume-hook. Also call a new hook, `suspend-hook', before suspending. * search.c (search_buffer): In inner loop of BM search, decide dynamically whether signed or unsigned comparison of p_limit vs cursor will give the right results and use the kind that will work. Thu Dec 11 12:17:31 1986 Richard Mlynarik (mly at prep) * emacs.c, dispnew.c: Rename inhibit_x_windows inhibit_window_system. Understand "-nw" command-line option. Reorganise init_display a little to make other window-system code easier to accommodate. * editfns.c (Fformat): Move the increment of the number of args the format string wants. Share code for various kinds of arguments converted to strings. Wed Dec 10 17:42:20 1986 Richard M. Stallman (rms at prep) * commands.h: Declare cursor_in_echo_area. * dispnew.c (init_display): initialize it. * dispnew.c (syms_of_display): make Lisp variable for it. * dispnew.c (update_screen): If cursor_in_echo_area not 0, set cursor position after last char on last screen line. * fns.c (Fy_or_n_p): Set cursor_in_echo_area while read answer. * data.c (Fset_default): if RTPC_REGISTER_BUG defined, don't declare `b' register. * m-ibmrt.h: Define RTPC_REGISTER_BUG. * print.c (print, case Lisp_Window): Add temp var `p' to help RT/PC compiler. Declare printcharfun register. Tue Dec 9 10:46:18 1986 Richard Mlynarik (mly at prep) * editfns.c (Fformat): `%%' doesn't take an `arg' * doc.c (Fsubstitute_command_keys): Fix stupid mistakes and errors. Rename many local variables and rearrange some code. Sun Dec 7 16:42:44 1986 Richard Mlynarik (mly at prep) * xfns.c (Fx_flip_color): Missing paren in DEFUN arglist. Sat Dec 6 13:17:57 1986 Richard M. Stallman (rms at prep) * Version 18.32 released. * process.c ({read,handle}_process_output): Combine handle_process_output into read_process_output. Check for case where read returns -1. Fri Dec 5 02:30:37 1986 Richard M. Stallman (rms at prep) * process.c (read_process_output): Read only one buffer worth and return without trying to read more. It used to loop until all output was gobbled. Now some callers do this loop but not all of them. * process.c (change_msgs): Call read_process_output repeatedly until it returns 0 (no chars were read). * term.c (write_chars): loop counting repeated chars leaves p at second nonrepeated char. Decrement p after the loop. * process.c (create_process): Use set_exclusive_use; don't use FIOCLEX directly. * sysdep.c (flush_pending_output): Pass a valid address as third arg to TIOCFLUSH, just in case. * sysdep.c (set_exclusive_use): Likewise, with FIOCLEX. * process.c (create_process): Likewise, with TIOCNOTTY. * xfns.c (XCleanUp): Pass Qt to Fdo_auto_save. * xfns.c (Fx_rubber_band): Set screen_garbaged. * doc.c (Fsubstitute_command_keys): Use Fwhere_is_internal instead of where_is_in_buffer. New construct = means use value of MAPVAR as local map when calling Fwhere_is_internal. * keymap.c (Fwhere_is_internal, where_is_in_buffer): Combine the two functions. This adds two arguments to Fwhere_is_internal: KEYMAP and FIRSTONLY. To get the old behavior, KEYMAP must be (current-local-map). Therefore, KEYMAP is a mandatory operand for Lisp callers. * keymap.c (Fwhere_is): Pass new args to Fwhere_is_internal. * keymap.c (apropos1): Call Fwhere_is_internal instead of where_is_in_buffer. * search.c (Freplace_match): Check type of first arg. * abbrev.c (Fexpand_abbrev): For abbrev with hook, run the hook in addition to (and following) insertion of the expansion in the usual way. * editfns.c (Fformat): [MLY] Compute number of args needed by format string; then convert args from Lisp_Object to int or char *, defaulting any not specified. Don't GCPRO; should not be needed since eval is not called. * editfns.c (format1): Args are ints or char *'s, not Lisp_Objects. Call them ints. Thu Dec 4 17:54:21 1986 Richard Mlynarik (mly at prep) * xfns.c (Fx_debug): Return Lisp_Object Mon Dec 1 16:10:38 1986 Richard Mlynarik (mly at prep) * xfns.c (Fx_set_font): Don't die if font is "" (I believe this to be an X bug) Also, add interactive specs for Fx_set_(internal_)border_width. * lread.c (oblookup): Don't core-dump if data in obarray is invalid Mon Dec 1 08:32:13 1986 Richard M. Stallman (rms at prep) * m-att3b.h: on 3b2, 3b5 and 3b15, #define C_OPTIMIZE_SWITCH null since -O triggers compiler bug affecting push_key_description. Fri Nov 28 14:02:07 1986 Richard Mlynarik (mly at prep) * keyboard.c (read_key_sequence): Delay setting up the local vars pointing to keymaps until a character has been read. This is in order that a change of keymap `behind our back' (eg due to a subprocesses action) will be seen. * xterm.c: Typo. Wed Nov 26 04:18:46 1986 Richard M. Stallman (rms at prep) * sysdep.c (get_system_name): Eliminate internal static var in USG case. * lisp.h: New case testing and conversion macros UPPERCASEP, LOWERCASEP, NOCASEP, UPCASE, DOWNCASE. They all work from downcase_table. * casefiddle.c (casify_object, casify_region): Use those macros. Create an enum type for the flags and change the flag names to avoid conflict with the macros. * abbrev.c (Fexpand_abbrev): Use those macros. * editfns.c (init_editfns): * fns.c (y-or-n-p): * keymap.c (access_keymap): * fileio.c (report_file_error): * process.c (change_msgs): * search.c (Freplace_match): Use upcase_initials_region insead of duplicating it. * keyboard.c (Frecursive_edit): If not the top-level edit, specbind standard-output and standard-input to t. * keyboard.c (command_loop_1): Don't set those two vars. This avoids clobbering them permanently when minibuffer is used. Tue Nov 25 02:52:36 1986 Richard M. Stallman (rms at prep) * callproc.c (child_setup): New arg `envlen' is length of the list Vprocess_extra_environment. This list's elements (strings) are put at the front of the environment for the other program. * callproc.c (Fcall_process): Some rearrangement of local variables for more register decls. Compute and pass `envlen' arg to child_setup. * process.c (create_process): Compute and pass `envlen' arg to child_setup. * xterm.c (x_term_init): Don't call XPopUpWindow at all. Leave it for the term-setup-hook (see lisp/term/x-win.el). * keyboard.c (syms_of_keyboard): Delete defsubr for usg-suspend-emacs. * fns.c, m-masscomp.h: Rename MASSCOMP_REGISTER_BUG to MASSC_REGISTER_BUG to avoid shortnames confusion on V.0. * dispnew.c (direct_output_for_{self_insert,forward_char}): These functions now return 0 if did nothing or 1 if did display. * keyboard.c (command_loop_1): Notice the returned values. * window.c (change_window_height): Add new variable delta1 so no need to use delta for two different things. Making window bigger to equal its parent's size used to crash. Fix it by different way of computing delta1 in that case. Move some variable decls to inner blocks and add "register". Mon Nov 24 14:09:52 1986 Richard M. Stallman (rms at prep) * buffer.h: `modtime' field = 0 now means no info on visited file. Nonexistent visited file now represented by -1. * fileio.c (Fverify_visited_file_modtime): Adjust for changed meaning of `modtime'. * fileio.c (Finsert_file_contents): If visiting and file doesn't exist, finish visiting (updating various buffer slots) before getting error, and set modtime to -1. * bytecode.c (Fbytecode): Rarrange all the Bvarref cases to share most of the code. Likewise for Bvarset, Bvarbind and Bunbind cases. Makes it smaller and makes all Bvarrefs use the fast inline code. * keymap.c (Fdefine_key, Flookup_key): Regard chars 0200 and up as equivalent to 2 char sequences starting with meta_prefix_char. * search.c (search_buffer and callers): Complete rewrite from king@kestrel using simplified Boyer-Moore algorithm. Meaning of returned value changed. * search.c (bcmp_buffer_translated): No longer used; deleted. * search.c (ScanBf, scan_buffer): complete rewrite of ScanBf and nearly all is now in scan_buffer, a new function. * cmds.c (Fforward_line): Complete rewrite; now calls scan_buffer. * search.c (Fscan_buffer): Delete this. * bytecode.c (Fbytecode): Just get error if Bscan_buffer is used. * ymakefile: Rename TEXT_START_ADDR to LD_TEXT_START_ADDR to avoid shortname trouble (ymakefile is processed thru the system's cpp). * sysdep.c (init_sys_modes): Change #ifdef USG to #ifdef _IOFBF around the call to setvbuf. * sysdep.c (bcopy): declare it to return int so that a forward declaration is not needed so there is no problem defining it as a macro. * fileio.c (Fwrite_region): Don't try fsync on 4.1bsd. Sun Nov 23 00:04:19 1986 Richard M. Stallman (rms at prep) * eval.c (record_unwind_protect, specbind, unbind_to, Funbind_protect): struct specbind now has a new slot `func'. An internal unwind-protect stores the C function address there; else it's 0. Lisp_Internal_Function data type no longer used. Result is no more dependency on where in the address space function addresses are found. * xterm.c (x_term_init): Better message if server does not respond. * version 18.31 released. * xterm.c, xfns.c (Vxterm1): Lisp var `xterm' now points at Vxterm1, which is initialized like Vxterm but never examined. * xterm.c (XTread_socket): Use C-x C-@ to indicate mouse click. Sat Nov 22 02:21:56 1986 Richard M. Stallman (rms at prep) * bytecode.c (Fbytecode): Turn on immediate_quit for Bnth loop. * keymap.c (Fcurrent_global_map): New function that returns the current global map. Fri Nov 21 15:42:05 1986 Richard M. Stallman (rms at prep) * emacs.c (main, Fdump_emacs): [ALLIANT] save _curbrk before dumping and restore when starting dumped Emacs. * process.c (wait_reading_process_input): [ALLIANT] if select returns with EFAULT, just set Available = 0. [always] copy errno right after the select and check the copy in case another system call could alter it in between. * m-alliant.h, m-mg1.h: New machines supported. * ymakefile: Make START_FILES a preprocesser variable and don't change it if already defined. * m-gould.h: Move special gould value of START_FILES here. * fileio.c (syms_of_fileio): Define variable vms-stmlf-recfm. * sysdep.c (sys_creat): If vms_stmlf_recfm is nonzero, create new files with rfm=stmlf. Thu Nov 20 17:07:14 1986 Richard M. Stallman (rms at prep) * eval.c (unbind_catch): Don't ref thru handlerlist if null. * keyboard.c (Fusg_suspend_emacs): Delete this. * sysdep.c (sys_suspend): Put in USG_JOBCTRL method of suspending with ptrace. Wed Nov 19 06:45:23 1986 Richard M. Stallman (rms at prep) * xterm.c (x_term_init): Delete attempt to set up a handler for SIGIO. This was normally overridden in init_keyboard so it didn't matter; but this handler is invalid, so it crashed if it ever did get called. * indent.c (compute_motion): Fix screwy #if celerity || ATT3B which is invalid. Tue Nov 18 17:59:57 1986 Richard M. Stallman (rms at prep) * keyboard.c (command_loop_1): Must check to reselect buffer and flush minibuf message before trying fast_read_single_key. Else have lossage typing printing chars when minibuf message is displayed. * keyboard.c (Fsuspend_emacs): Execute suspend-resume-hook value on resumption. * lisp.h: Make initialized global. * data.c (init_data): Undo last change; not needed now. Tue Nov 18 15:19:06 1986 Richard Mlynarik (mly at prep) * emacs.c (main): Giving `inhibit_x_windows' an initialisation loses; do it explicitly. * xfns.c (Fx_rubber_band): Make interactive. Tue Nov 18 14:40:04 1986 Richard M. Stallman (rms at prep) * dispnew.c (window_change_signal): New function to handle SIGWINCH, defined only if SIGWINCH is. Turned on in init_display if CANNOT_DUMP or if initialized. * data.c (init_data), editfns.c (init_editfns): Test initialized, not Vpurify_flag. Use explicit conditionals to avoid the test when CANNOT_DUMP. Mon Nov 17 00:19:06 1986 Richard M. Stallman (rms at prep) * buffer.c (Ferase_buffer): Zero the buffer's save_length. Future text after erase is unrelated to past text so should not suspend auto saving if future text is smaller. * buffer.c (init_buffer_once): Was passing entire structure to bzero; now pass address. * fns.c: Prevent warning in 4.3 where param.h does #define BSD Sun Nov 16 12:56:21 1986 Richard M. Stallman (rms at prep) * dispnew.c (init_display): Set window-system to symbol x, not "X". * dispnew.c (syms_of_dispnew): Initialize window-system to nil. * xfns.c (grey_p): Insert missing commas. * emacs.c (main): Fix typo "ihhibit_x_windows". * xterm.c (x_term_init): Delay calling XPopUpWindow till after Vxterm is set. Also must include lisp.h. Also always set Vxterm if CANNOT_DUMP. * xfns.c, xterm.c: Include signal.h before xterm.h because on 4.3 both of them define sigmask and only xterm.h considers the case that it is already defined. * buffer.h: Add BufferSafeCeiling and BufferSafeFloor. * process.c (Fprocess_send_eof): Now has conditional on DID_REMOTE, which is defined if TIOCREMOTE is actually used. Sat Nov 15 00:53:26 1986 Richard M. Stallman (rms at prep) * Emacs version 18.30 * * xdisp.c (display_string): Change minwidth and maxwidth args to mincol and maxcol: minimum and maximum absolute hpos to end at. Change all callers (all in xdisp). * xdisp.c (display_mode_element) Similar change of minwidth and maxwidth args. This permits considerable internal simplification and deletion of the function display_mode_element_1. * xdisp.c (decode_mode_spec): Flush unused arg minwidth. Change call (in display_mode_element). Fri Nov 14 12:52:51 1986 Richard M. Stallman (rms at prep) * process.c (create_process): Don't get a pty if the new variable Vprocess_connection_type is not t. This is the Lisp variable process-connection-type. Thu Nov 13 18:46:32 1986 Richard M. Stallman (rms at prep) * crt0.c: Rename GLOBAL_START_{DOT,NO_DOT} to {DOT,NODOT}_GLOBAL_START to avoid shortnames trouble. * m-vax.h, m-tahoe.h, m-sequent.h: same change. * m-att3b.h: Turn off #define VIRT_ADDR_VARIES (kk says no need for it). * keyboard.c (Fcommand_execute): Zero debug_on_next_call before running the command. Wed Nov 12 10:19:31 1986 Richard Mlynarik (mly at prep) * data.c (Fsequencep): (sequencep nil) => t * xdisp.c (display_string): Put a "|" at end of mode-lines of partial-width windows. * xdisp.c (various): mode-line-format %259 means to pad field to 259, but not to truncate it. (259 . ) also means to pad. (-259 . ) means to truncate to 259, but not to pad. [So (-259 . (259 . x)) means to format x -exactly- 259 chars wide.] * dispnew.c (Fding): Do not terminate macro-definition if given an argument (This is so things like asynchronous process notifications can beep but not screw) Mon Nov 10 16:32:08 1986 Richard M. Stallman (rms at prep) * fileio.c (Fset_file_modes): [APOLLO] must reset modtime after changing the modes. Mon Nov 10 10:57:54 1986 Richard Mlynarik (mly at prep) * buffer.c (init_buffer_once): There is no lisp variable corresponding to buffer-name Mon Nov 10 00:06:31 1986 Richard M. Stallman (rms at prep) * xdisp.c (display_string): Measure new line length from start of line body. Sun Nov 9 00:22:04 1986 Richard M. Stallman (rms at prep) * lread.c (oblookup, map_obarray): Do not use XFASTINT on `next' fields of symbols. Fix incorrect sense of test for end of bucket. * filelock.c (current_file_owner): Fix incorrect sense of test with `kill' for death of previous locker. * keyboard.c (get_char): Arg of -1 now means don't do redisplay. Rearrange conditionals so detect_input_pending is not called in certain cases. * keyboard.c (read_key_sequence): New arg nodisplay, nonzero means pass -1 to 1st call to get_char. * keyboard.c (command_loop_1): After a command that does direct screen updating, if buffer_shared is not more than 1, pass 1 for nodisplay to read_key_sequence. * minibuf.c (Fminibuffer_depth): New function returns value of MinibufDepth as a Lisp Int. * dired.c (Ffile_attributes): Return inode # as element 10. * dispnew.c (update_line): Fix bug that noop'd the attempt to let new explicit spaces match the implicit space past end of old line. Also do not ignore trailing spaces in a highlighted line; instead, give it more trailing spaces so it reaches the margin. Sat Nov 8 20:55:04 1986 Richard M. Stallman (rms at prep) * data.c (init_data): Don't call signal if purifying. * ymakefile: Stop using gould-sigvec.s. No longer needed now that signal really isn't called. * unexec.c: Eliminate gould-specific code to reinitialize gould-sigvec.s. Fri Nov 7 01:30:31 1986 Richard M. Stallman (rms at prep) * m-vax.h: Turn off NO_REMAP. * sysdep.c (end_of_{data,text}): Omit them if CANNOT_DUMP. * fileio.c (Fwrite_region): APOLLO is now like VMS in doing the stat after the close. * emacs.c (main): If APOLLO, don't call malloc_init. We use the system's malloc on the Apollo. * editfns.c (init_editfns): If CANNOT_DUMP, do all the work, regardless of Vpurify_flag. * alloc.c (mark_object): If not SWITCH_ENUM_BUG don't cast the switch quantity to int. * process.c (pty): [HPUX] Do TIOCREMOTE. * unexec.c (makehdr): Code to adjust, default and validate data_start and bss_start now common to COFF and non-COFF cases. * unexec.c (makehdr): Param SEGMENT_MASK controls rounding of memory-address of text-data boundary (default is pagemask). [COFF only] SECTION_ALIGNMENT controls rounding of file addresses of section beginnings; default is no rounding. [non-COFF] ADJUST_EXEC_HEADER is hook to be executed before filling in a_text, etc. of the header. With these parameters, all known machines can be handled with no special conditionals. * m-sun1.h, m-sun2.h, m-isi-ov.h: Define SEGMENT_MASK. * m-stride.h, m-nu.h, s-umax.h: Define SECTION_ALIGNMENT. * m-masscomp.h, m-gould.h, s-hpux.h: Define ADJUST_EXEC_HEADER. * m-gould.h: Define A_TEXT_OFFSET = sizeof (hdr) * unexec.c (makehdr): Remove ibmrt conditionals that adjusted a_text or equivalent, by just copying from the old file when NO_REMAP. * unexec.c (makehdr): Zero supplied as entry_address means copy it from the old file. * emacs.c (Fdump_emacs): Pass 0 as entry_address to unexec. * unexec.c (copy_text_and_data): Two fixes for A_TEXT_OFFSET case: Don't decrement `end', and remove (unconditionally) the lseek before writing the data segment. Thu Nov 6 10:01:52 1986 Richard M. Stallman (rms at prep) * keymap.c (apropos1): Use Fdocumentation_property, not Fget, for doc strings of variables. Wed Nov 5 18:47:41 1986 Richard Mlynarik (mly at prep) * m-att3b.h: #define TEXT_START 0 Wed Nov 5 12:42:38 1986 Richard M. Stallman (rms at prep) * alloc.c (Fcons, Fmake_symbol, Fmake_marker, gc_sweep): The free-list pointers in symbols, conses and markers are now C pointers cast as ints and stored in the XFASTINT. This may make faster code and in any case avoids problems with machines where access with XPNTR relocates the pointer. * lread.c (oblookup, map_obarray): Use XFASTINT when comparing a Lisp_Object against zero. * minibuf.c (read_minibuf): If noninteractive, print the prompt, since it won't be displayed in the normal way. In any case, pass Fread the string rather than a buffer when reading an s-expression. * auxdoc.c, callint.c, syntax.c, ymakefile: Copy fake-DEFUNs from auxdoc.c into comments preceding the real DEFUNs for the same functions. auxdoc.c is no longer in use. * fileio.c (Fread_file_name_internal): [VMS only] Return t if file name is null string. Tue Nov 4 14:00:34 1986 Richard M. Stallman (rms at prep) * buffer.c (Fget_buffer_create): For default-major-mode = nil case, use fundamental-mode if old buffer's mode name has a non-nil mode-class property. Requires creating Qmode_class to hold the symbol mode-class. * s-hpux.h: #undef HAVE_PTYS because of problems with scheme running as an inferior on a pty. jinx@prep requested this. * lread.c (check_obarray & its callers): eliminate 2nd arg. Also, don't confuse types int and Lisp_Object. If invalid value matches Vobarray, store a valid Vobarray. * editfns.c (Fformat): Don't use an initialization for tem since it is a Lisp_Object and that can be a struct. * minibuf.c (Ftry_completion, Fall_completions): Use XFASTINT when testing `bucket' for nonzero or setting it to zero. * callint.c (Fcall_interactively): If visargs[i] is nil, don't try to reference it as a string. * doc.c (FSnarf_dcumentation): Was assuming exec-path was a string. Fixed to use exec-directory instead, and to validate its data type first. Tue Nov 4 10:06:24 1986 Richard Mlynarik (mly at prep) * m-isi.h => m-isi-ov.h Tue Nov 4 09:08:52 1986 Richard M. Stallman (rms at prep) * buffer.c (init_buffer_once): Avoid casts from int to Lisp_Object (which would lose if NO_UNION_TYPE is not defined); use XFASTINT. Mon Nov 3 16:36:03 1986 Richard Mlynarik (mly at prep) * xterm.c (stufflines): Initialise signal mask. * xterm.h: Add definition of sigmask Sat Nov 1 00:02:40 1986 Richard Mlynarik (mly at prep) * m-sun3.h: #undef sun2 ? #define sun3 * termcap.c: Include Dave Genzel @ Unilogic's VMS termcap stuff. * termcap.c: #ifdef emacs ? #include config.h * fileio.c, fns.c, m-vax.h: Fixes for VMS cpp. (#undef foo -> #ifdef foo ? #undef foo) Fri Oct 31 23:35:29 1986 Richard Mlynarik (mly at prep) * vmsmakefile (new file) * crt0.c, unexec.c, m-isi.h (new file): Integrated Solutions 68k port. Thu Oct 30 01:08:45 1986 Richard Mlynarik (mly at prep) * m-vax.h (USG-only changes): #define NO_REMAP (I don't understand exactly why one needs to do this -- is there an unexec bug?) #define TEXT_START = 0, since C code can't access `start' symbol. * lisp.h, sysdep.c, indent.c, m-att3b.h: USG and att3bxxx changes from karl@ohio-state.arpa Define NO_REMAP, undefine LD_SWITCH_MACHINE * buffer.c (Fbuffer_local_variables): Return correct values when buffer is selected-buffer * keyboard.c (cmd_error): non-zero exit status on error. * filelock.c: Don't get MPV if buffer-file-name isn't a string or nil. Wed Oct 29 10:18:39 1986 Richard Mlynarik (mly at prep) * keymap.c (Flookup_key, Fdefine_key): Don't bomb on zero-length strings. * filelock.c (Ffile_locked_p): New function. * window.c (Fset_window_hscroll): Don't inhibit redisplay optimisations if hscroll is same. * ymakefile: rm ../etc/DOC to avoid make-docfile overwriting any files which were linked to it (unix sucks) Tue Oct 28 00:12:50 1986 Richard Mlynarik (mly at prep) * vmsmap.c, termcap.c, sysdep.c, config.h-dist: VMS changes from Sasaki * termcap.c (tgetent): Make sure `indirect' initialised. * xfns.c (grey_p and callers): New function to compensate for ugly chauvinistic American spelling. * keymap.c (describe_*): Don't mention keys in global map which are shadowed by local bindings * dispnew.c, sysdep.c, dired.c: Eschew ^#if.*defined (for VMS' sake) * keymap.c (Fkeymapp, Flookup_key): Add QUIT test. Mon Oct 27 18:46:08 1986 Richard Mlynarik (mly at prep) * callproc.c, fileio.c: VMS changes (make environ noshare, don't call fsync) Sun Oct 26 00:28:02 1986 Richard Mlynarik (mly at prep) * sysdep.c, unexec.c, ymakefile: Gould changes. (marick%cthulhu@gswd-vms.ARPA) * gould-sigvec.s: New file. * m-gould.h: New file (for utx/32 2.0 and above) Old file renamed m-ogould.h. See etc/MACHINES for more information. * unexec.c (make_hdr): Typo "#ifdef A_TXT_OFFSET" should be "A_TEXT_OFFSET" Wed Oct 22 19:06:41 1986 Richard Mlynarik (mly at prep) * keyboard.c, keymap.c: Move Fexecute_extended_command from keymap.c to keyboard.c rather than make kludgy static vars global. In Fexecute_extended_command record `(this-command-keys)' and `last-command' accurately. * emacs.c (main), dispnew.c (init_display): Add -nx flag, meaning to inhibit X windows and just run in the current virtual terminal. (Perhaps there should be a generic flag to disable any special window-system code) Add Vwindow_system variable. * search.c (Fstring_match): Do range-checking on `start' argument. Tue Oct 21 11:33:40 1986 Richard Mlynarik (mly at prep) * xterm.c, xfns.c (x_term_init, x_change_display): Share command code, and make that code use {request,unrequest,init}_sigio * term.c (init_display): Determine whether we are under X by whether DISPLAY env var is set, not by whether TERM is "xterm" * xterm.c (x_term_init): Remove (if (!initialized) ...) test. Set Vxterm directly, rather than calling setxterm (flush latter) * lread.c (various): Changes for when can't take XSYMBOL of 0 and to make check_obarray code work correctly. Mon Oct 20 18:05:16 1986 Richard Mlynarik (mly at prep) * m-stride.h, process.c, sysdep.c, unexec.c: Stride changes. Sat Oct 18 16:35:26 1986 Richard Mlynarik (mly at prep) * buffer.c: Made default-major-mode same as (default-value 'major-mode) to avoid user confusion. Fri Oct 17 01:51:40 1986 Richard Mlynarik (mly at prep) * cmd.c, process.c: Doc fixes from sjk * buffer.c (init_buffer_once): Do x = (Lisp_Object) 1 instead of (int) x = 1 for benefit of vms and pyramid compilers. * minibuf.c (Ftry_completion): Test (bucket), not (XSYMBOL (bucket)) since Lisp_Objects may not be able to be 0 on some implementations. * editfns.c (Fformat): Have to duplicate doprnt's work of decoding the format-string top ensure that don't die on (format "%s" 0) Also, use prin1-to-string to get PR for random objects * m-celerity.h: HAVE_ALLOCA Thu Oct 16 20:01:55 1986 Richard Mlynarik (mly at prep) * m-att3b.h: New file -- replaces m-3b20.h * alloca.c, fileio.c, indent.c, unexec.c, ymakefile: Bugs and fixes for att3b (and usg) Use a global static var rather than a local one to record the last block allocated by alloca. * fileio.c (Fverify_visited_file_modtime): If a formerly-nonexistent file has been created since we ``found'' it, say there is a discrepancy. Tue Oct 14 19:08:18 1986 Richard Mlynarik (mly at prep) * callint.c (Fprefix_numeric_value): Doc typo. * malloc.c, regex.c: Nuke "#if defined..." for VMS Sun Oct 12 00:02:50 1986 Richard Mlynarik (mly at prep) * xdisp.c (many functions): Rearrange the way in which the mode-line stuff is hacked: in particular, display_string doesn't have a special-case for %-escapes -- this is now all done in display_mode_element. This was necessary to make %M work correctly. Also, fix a few bugs (buffer-name truncation could cause core-dump) Dike out global-minor-modes. This wasn't actually being used by anything (due to a bug) and wasn't even being initialised! minor-mode-alist does what this thought it was doing. Sat Oct 11 15:45:35 1986 Richard Mlynarik (mly at prep) * doc.c (FSnarf_documentation): In CANNOT_DUMP case wasn't treating PATH_EXEC as a path -- now uses exec-path instead. * lisp.h: Get rid of #if defined... for benefit of vms Thu Oct 9 20:52:25 1986 Richard Mlynarik (mly at prep) * abbrev.c (Funexpand_abbrev): Preserve position of point. Tue Oct 7 00:08:00 1986 Richard Mlynarik (mly at prep) * s-hpux.h: #define HAVE_PTYS * alloca.c: Make some attempt to work in the USG case where "#define static" is done. * keyboard.c: #undef FIONREAD in HPUX (seems to be unimplemented or broken) The only reason this ever seemed to work was because of a bug in v17. * sysdep.c (child_setup_tty): HPUX was defaulting terminal speed to 300 baud. * alloca.s: New hp9000 C function calling sequence. * fileio.c (Fexpand_file_name): Fix bug in (expand-file-name ".." "/foo/") * callint.c (Fcall_interactively): Remove extreme weirdness of storing (int) "" where a Lisp_Object was expected (in visargs) Slighly more informative error message for bad interactive code letter. * abbrev.c (Funexpand_abbrev): Was deleting length of original text rather than length of expanded abbrev. * abbrev.c (Fexpand_abbrev): Add an Fundo_boundary so that undo works to unexpand abbrevs. Fri Oct 3 16:07:32 1986 Richard M. Stallman (rms at prep) * ymakefile: Make LIBS_STANDARD the last libs loaded. * xterm.c: Load sys/types.h explicitly if xterm.h doesn't do it. * keyboard.c (interrupt_signal): Delete suprious `)' in HAVE_X_WINDOWS case. Fri Oct 3 14:08:00 1986 Richard Mlynarik (mly at prep) * sysdep.c (sys_suspend -- fake suspend case) Missing comment */ terminator Thu Oct 2 21:43:35 1986 Richard Mlynarik (mly at prep) * search.c: There may be `holes' in regexp registers after a match: consider matching "z" against "\\(\\(xyzzy\\)\\|\\)\\(z\\)" -- then register 2 is unmatched, whilst registers 0, 1 and 3 have matches. Fix register-hacking code in Flooking_at, search_buffer, Fmatch_data, Fstore_match_data. * crt0.c: HP200 floating-point (sigh -- needed for load-average) * sysdep.c (HPUX perror): Should be "perror" not "_perror" -- communication foulup, sorry. Wed Oct 1 00:00:52 1986 Richard M. Stallman (rms at prep) * marker.c (Fcopy_marker): Was stupidly failing to put the new marker on the buffer's chain. Fix to go thru Fset_marker. This really does fix the crashes in GC. * sysdep.c (for HPUX): Define utimes and _perror as no-ops. * marker.c (Fset_marker): If attempt to set marker to point to a dead buffer, set it to point nowhere. * buffer.c (Fkill_buffer): Clear out the buffer's markers chain. * keyboard.c (interrupt_signal): Turn off the double-C-g feature when running under X windows. Mon Sep 29 03:44:28 1986 Richard M. Stallman (rms at prep) * search.c: search_regs elements are now the correct character numbers or string indices. 1 is not added when they are used; instead the values are corrected just after regex library returns. The loops to do this exit at the first -1 (unused register). * alloca.s: Convert HP9000 code to new assembler syntax. Rename flag hp9000s200 to hp9000. [mly] * crt0.c: Convert HP9000 code to new assembler syntax. [mly] * buffer.c (Fdelete_buffer_internal): Unused; deleted. * marker.c (unchain_marker): Dump core if first marker on buffers marker list does not have that buffer as its buffer. May help find bug where after GC a buffer's first marker was on the free list. * keyboard.c (cmd_error): In -batch, die after error message. * bytecode.c (Fbytecode): Open-code Bvarref with one-byte arg. * callproc.c (init_callproc): Use only first element of Vexec_path to make Vexec_directory. [mly] Sun Sep 28 19:21:37 1986 Richard M. Stallman (rms at prep) * data.c (Fsymbol_value): use assq_no_quit instead of Fassq. * fns.c (assq_no_quit): Like Fassq but never quits or gets errors. * keyboard.c (quit_throw_to_get_char): * eval.c (Fsignal): Call quit_error_check. * dispnew.c (quit_error_check): Dump core if DesiredScreen is not full of zeros. This is to catch the bug wherein DoDsp called from get_char died because DesiredScreen was full of lines already. Fri Sep 26 17:01:09 1986 Richard Mlynarik (mly at prep) * regex.c (re_match_2), search.c (various): The registers modified by re_{search,match}{,_2} now have start and end of -1 if that register was not used in the match found. Fmatch_data now returns a list of twice the number of registers -actually- used (including register 0, for the whole match) * process.c (Fwaiting_for_user_input_p): New function for use by process-filters and sentinels so they can determine if it might be an appropriate time to try to make some sort of asynchronous notification. Fri Sep 26 04:08:54 1986 Richard M. Stallman (rms at prep) * keymap.c (syms_of_keymap): Add missing defsubr for Fdefine_prefix_command, * abbrev.c (Fexpand_abbrev): Save original text of the abbrev in Vlast_abbrev_text. * abbrev.c (Funexpand_abbrev): Restore the original text. Thus expand and unexpand preserves case. Also, if there is no abbrev to unexpand, do nothing. * abbrev.c (syms_of_abbrev): Turn Lisp variables last-abbrev and last-abbrev-text back on. * abbrev.c (Flast_abbrev_expansion): Delete this function. Thu Sep 25 18:30:35 1986 Richard M. Stallman (rms at prep) * window.c (Fwindow_width): return a value one smaller for partial-width windows that contain a | border. * macros.c: Remove Fname_last_kbd_macro (moved to macros.el). Thu Sep 25 07:54:12 1986 Richard Mlynarik (mly at prep) * unexec.c: Include a.out.h before getpagesize.h, since EXEC_PAGESIZE may be defined in a.out.h * dispnew.c: Only define TIOCOUTQ as TCOUTQ if the latter as defined, so that ifdef conditionals on the former work as expected. * sysdep.c (sys_suspend): Needed to include buffer.h for getting cwd when doing a fake suspend. (for system v and other complete losers) Rather than doing that include (which tickled some cretin-compiler bugs) look up bf_cur->default_directory by Fsymbol_value (Qintern ("...")) Wed Sep 24 21:28:47 1986 Richard Mlynarik (mly at prep) * editfns.c (Fregion_beginning, Fregion_end): Share common code (this doesn't have to be so fast that the extra function-call could hurt) * editfns.c, window.c, callint.c, buffer.c: Don't allow bf_cur->mark to be nil. Instead, to indicate that the mark is not set, make the marker not point at anything. This simplifies life quite a lot. Add sanity checking in case user sets mark to point to different buffer (he could do this by side-effecting (marker-mark) stupidly) Change definition of marker-mark so that it returns a marker object which doesn't point anywhere when there is no mark, rather than nil. This is more useful. * editfns.c, bytecode.c. Move set-mark, mark to lisp code. * editfns.c (Fset_mark) Not interactive. Tue Sep 23 14:26:18 1986 Richard M. Stallman (rms at prep) * crt0.c, m-hp9000.h: rename hp9000s200 to hp9000. * m-hp9000.h: New name for m-hp200.h. * unexec.c (for hpux): define MY_ID from HP9000S200_ID if that exists; else use model.h. Sun Sep 21 18:48:48 1986 Richard M. Stallman (rms at prep) * search.c (search_buffer): Fix backwards condition in whether the translate table can be ignored. * process.c (Fprocess_send_string): Name of function for Lisp had a typo. * eval.c: When looping getting the function definitions of symbols, check for quit. * lisp.h: Restore old declaration of `getenv' since removing it causes warnings in many places. * minibuf.c (scmp): Return correct value. Sun Sep 21 18:12:45 1986 Richard Mlynarik (mly at prep) * editfns.c (Finsert_char): New function. There are a lot of places in lisp code which want to insert multiple copies of a constant char. This is a faster way of doing it, and doesn't cons (unlike (insert (make-string n c))) Sun Sep 21 15:33:20 1986 Richard M. Stallman (rms at prep) * process.c (make_process): Code to compute # elts in vector to make a Lisp_Process had several errors: Took size of pointer rather than of struct Lisp_Vector and had wrong sign compensating for first element. * fileio.c (directory_file_name): If arg is "/", return "/". Sat Sep 20 21:08:35 1986 Richard M. Stallman (rms at prep) * minibuf.c (Fdisplay_completion_list): New Lisp-callable function replaces minibuffer_completion_help_1, with a little new feature: elements of the completion list may be lists of two strings, and if so the two strings are printed in immediate succession. Fri Sep 19 13:06:39 1986 Richard Mlynarik (mly at prep) * minibuf.c (scmp and callers) Don't be fazed by '\0' in strings. * lisp.h, search.c, minibuf.c Use downcase_table Thu Sep 18 18:32:57 1986 Richard Mlynarik (mly at prep) * ymakefile, emacs.c, callproc.c, process.c, fns.c Install MAINTAIN_ENVIRONMENT conditional to call environ.c. Tue Sep 16 02:01:17 1986 Richard M. Stallman (rms at prep) * keymap.c (where_is_in_buffer): Fix bug in checking for shadowed keys: do Flookup_key only on local map, and ignore value if it is a number (that means key is locally undefined). Mon Sep 15 12:33:10 1986 Richard Mlynarik (mly at prep) * buffer.c (Fbury_buffer) Make this function interactive (bury current buffer) Do error-checking on arg. Mon Sep 15 00:47:34 1986 Richard M. Stallman (rms at prep) * emacs.c (main): Eliminate VMS -nl switch. Instead, `-map FILE' says to map data file FILE; no switch means don't map any file. Can call mapin_data directly since exact file name is given. * emacs.c (undump_emacs): Delete this. * emacs.c (main): Make it work to use more than one of the special switches (-batch, -t, -map). Sun Sep 14 17:15:37 1986 Richard M. Stallman (rms at prep) * Renamings for VMS. config.h.dist => config.h-dist paths.h.dist => paths.h-dist [ms]-*.*.h => [ms]-*-*.h s-usg5.2.2.h => s-usg5-2-2.h * Some new files for VMS. compile.com, link.com, precomp.com, ccom.com, testemacs.com, build.com are command files. temacs.opt is a linker control file. VMSBUILD gives info on how to use them. README describes what this directory is for. Sat Sep 13 20:13:11 1986 Richard M. Stallman (rms at prep) * sysdep.c (reset_sys_modes): Delete never-used VMS & SIGIO conditional. Call reset_sigio just once. No need to clear FASYNC here now that init_sigio makes sure it is clear in old_fcntl_modes. * eval.c (top_level_value, top_level_set): These are new names for Fglobal_value and Fglobal_set, which are no longer callable from Lisp. They are also commented out. Fri Sep 12 00:19:37 1986 Richard Mlynarik (mly at prep) * xfns.c (Fx_rebind_key) Fix typo. * mocklisp.c: Delete ml-substr. Move to mlsupport.el * buffer.c The real work of setting up mode_line_default is done in loaddefs.el. * lread.c, data.c, marker.c, window.c Flush the last callers of defalias. Flush defalias. (Use fsets in subr.el instead) Thu Sep 11 10:15:14 1986 Richard Mlynarik (mly at prep) * emacs.c (main) Under X, accept "-display" switch as synonym for "-d" * eval.c (spedcbind) Don't make Lisp_Buffer_Objfwd's buffer-local when just binding. (so now (let ((case-fold-search t))) doesn't force buffer-localness) However, setting a binding will still make it buffer-local. (ie (let ((case-fold-search t)) (setq case-fold-search t)) will cause case-fold-search be buffer-local even outside the let) * xfns.c Preserve studlycaps: "Gnuemacs" => "GNU Emacs" * Various Flush last users of LISTP => CONSP * buffer.h Make backed_up a Lisp_Object, since it is one! Make abbrev_table a magic-local-variable. * alloc.c (mark_buffer) Simplify, simplify. * buffer.h: Reorder elements of struct buffer so that Lisp_Object slots are contiguous from buffer.name through to the end of the buffer. All slots before buffer.name are not Lisp_Objects (except buffer.markers, which is gc-magic) Eliminate useless buffer.number slot. * buffer.c (Fbuffer_number): delete. Wed Sep 10 17:32:47 1986 Richard M. Stallman (rms at prep) * process.c (Fsend_{string,region}): rename as Fprocess_send... and change names of Lisp function. Old names now aliases in subr.el. Wed Sep 10 15:57:01 1986 Richard Mlynarik (mly at prep) * buffer.c New struct buffer_local_symbols. staticpro buffer_defaults, buffer_local_symbols. * lread.c (defvar_per_buffer) Hack buffer_local_symbols * buffer.c (Fbuffer_local_variables) (a) Fcopy_alist so don't return any shared list structure (b) Include names and values of Lisp_Buffer_Objfwd locals. * alloc.c (FGarbage_collect): Don't mark buffer_defaults specially, as it is now in staticvec * dired.c (Fdirectory_files): Optional third argument match is a regexp specifying to only return files whose names contain a match for that regexp. [eg ``(directory-files "/u2/emacs/" nil "\\`[^#]")''] Wed Sep 10 02:11:56 1986 Richard M. Stallman (rms at prep) * alloc.c (Fgarbage_collect): Use open code instead of Fnthcdr to avoid possibility of error. * lread.c (Fload, load_unwind): The Lisp_Internal_Stream now points to a word got with xmalloc and that points to the FILE. On Elxsi, the FILE address is not in the part of the address space that Lisp_Object pointers can reach. New way can't lose. Tue Sep 9 23:21:11 1986 Richard M. Stallman (rms at prep) * crt0.c: Add _start for elxsi. Sun Sep 7 12:07:46 1986 Richard Mlynarik (mly at prep) * minibuf.c (read_minibuf) gc-protect the saved data! I'm don't know why this doesn't just bind help-form (and current-prefix-arg) esp since there is already an unbind_to which would help us do this. Since I don't know why the `bindings' are done this way, I'm leaving the unwind-protect hair, and adding GCPRO hair. * minibuf.c (read_minibuf, read_minibuf_unwind) preserve the value of current-prefix-arg. * minibuf.c: Eliminate read_minibuf_string. Move defalias for read-input to subr.el * callint.c, fns.c, lisp.h Call read_minibuf instead of read_minibuf_string. Thu Sep 4 14:02:50 1986 Richard Mlynarik (mly at prep) * fns.c (Fy_or_n_p, Fyes_or_n_p) Beep if the user types an invalid response. Wed Sep 3 02:40:40 1986 Richard M. Stallman (rms at prep) * dispnew.c (update_screen): Take out previous change. * xdisp.c (DoDsp): Move call to request_sigio after update: so it cannot be bypassed. * sysdep.c (init_sigio): set old_fcntl_flags here only once; don't change it in request_sigio. * sysdep.c ({un,}request_sigio): Set interrupts_deferred while SIGIO is unrequested. Abort if FASYNC is already set when request_sigio is called. * keyboard.c (get_input_pending): Always do FIONREAD if interrupts_deferred. Mon Sep 1 11:03:49 1986 Richard M. Stallman (rms at prep) * xterm.c/xfns.c: Many changes from rlk, including using sigblock/sigsetmask to block signals instead of turning handler off and on. * dispnew.c (update_screen): If interrupt input, wait while output gets written before returning. If observed loss of output really is a kernel bug, this may make it stop. Sun Aug 31 04:14:58 1986 Richard M. Stallman (rms at prep) * keymap.c (where_is_in_buffer): Use Fequal rather than EQ to test for a match if the object being searched for is a cons cell. Sat Aug 30 05:19:38 1986 Richard M. Stallman (rms at prep) * data.c (Fsetq_default): new function. Thu Aug 28 03:58:51 1986 Richard M. Stallman (rms at prep) * xdisp.c (display_mode_element): Cons cell whose car is a symbol now means (SYMBOL IF_TRUE_DISPLAY IF_FALSE_DISPLAY) and is equivalent to IF_TRUE_DISPLAY if SYMBOL's value is non-nil or to IF_FALSE_DISPLAY if SYMBOL is unbound or has value nil. * buffer.c (syms_of_buffer): update documentation for that. Mon Aug 25 01:27:31 1986 Richard M. Stallman (rms at prep) * fns.c (merge): Swap the arguments to the sort predicate so as to use it to compute <= rather than <. Sort had been anti-stable; now it is stable. * editfns.c (Fuser_uid, Fuser_real_uid): New functions that return values of geteuid and getuid system calls. * dired.c (Ffile_attributes): Value has additional element t iff file gid would change if Emacs deletes it and recreates it. * xdisp.c (display_mode_element): If element is a list and its car is a list, process all list elements recursively and concatenate them. Makes alists work. * xdisp.c (display_mode_string): New element type %n prints ` Narrow' and ` Def' if appropriate. * buffer.c (syms_of_buffer): Fix documentation of mode-line-format. * undo.c (Fundo_more): Fix bugs in checking len and pos for being in bounds. * eval.c (Fuser_variable_p): If documentation property is a number, negative means it's a user variable. * doc.c (Fdocumentation_property): Use abs value of property as the file position. * doc.c (FSnarf_documentation): For variables, store negative property if string starts with `*'. * editfns.c (Finsert_buffer_substring): Implement inserting part of a buffer into itself. Sun Aug 24 04:03:26 1986 Richard M. Stallman (rms at prep) * xterm.c, xfns.c, sink.h: Installed latest changes from Athena, and fixed up formatting conventions. Sat Aug 23 17:02:41 1986 Richard M. Stallman (rms at prep) * eval.c (unbind_catch): Restore gcprolist from the catchtag. Thu Aug 21 22:43:45 1986 Richard M. Stallman (rms at prep) * fileio.c (barf_or_query_if_file_exists): New second arg non-0 says query; do not call Finteractive_p. * fileio.c (Frename_file, Fcopy_to_file, Fadd_name_to_file, Fmake_symbolic_link): Interactive spec now says `p' for the third arg. If third arg is number, do call barf_or_query_if_file_exists but pass nonzero second arg in that case. * eval.c (Finteractive_p): Skip the innermost frame when examining the stack. This makes the right thing happen if called from Fbyte_code. Thu Aug 21 10:47:36 1986 Richard Mlynarik (mly at prep) * process.c (handle_process_output): do a set-buffer back to original buffer after calling a process' filter function so that all filter functions needn't save-excursion. * keymap.c (where_is_in_buffer): Don't blow out if buffer has no local map. Thu Aug 21 01:16:05 1986 Richard M. Stallman (rms at prep) * emacs.c (main): Eliminate references to environ.c. * callproc.c (Fcall_process): Pass child_setup the standard Unix environment. * process.c (create_process): likewise. * bytecode.c (Fbyte_code): At end, abort if specpdl is not back to same level it had on entry. * eval.c (unbind_catch): New way to unbind for throw. Pops catches, handlers and bindings, in one synchronized pass. Thus, when an unwind-protect is executed, all catches and handlers outside of it are still in effect. Also restore various static variables from the catchtag being unbound. struct catchtag has two new fields, gcpro and pdlcount. * eval.c (Fthrow, Fsignal): Use unbind_catch before longjmp. * eval.c (internal_catch): No need to restore anything from the catchtag after throw, because unbind_catch does it all. Must set up pdlcount and gcpro fields. * eval.c (internal_condition_case, Fcondition_case): Changed like internal_catch. * eval.c (Fcatch): use internal_catch to do the work. * eval.c (Fsignal): If no handler applies, try calling the Lisp debugger; if that fails, throw to top-level. Don't call `debugger'. * keyboard.c (debugger): Delete this function. Wed Aug 20 12:49:38 1986 Richard M. Stallman (rms at prep) * Gap motion can now quit! * insdel.c (move_gap): new name for GapTo. Callers changed. * insdel.c (InsCStr): * fileio.c (Finsert_file_contents): Call move_gap before calling record_insert. * insdel.c (del_range): Don't adjust point until after all possible errors detected, which means after gap is moved. * insdel.c (gap_right, gap_left): Check every 32000 chars for pending quit. Also speed up char-copy inner loop. * lisp.h (QUITP): New macro, nonzero if ought to quit now if poss. Wed Aug 20 00:12:25 1986 Richard M. Stallman (rms at prep) * undo.c (Fundo_more): Fix bug that was setting point to `len' field, not `pos' field. Share the error-checking code between all three types of undo record that actually make changes. * xdisp.c (display_mode_element): Fix a couple of silly bugs. * lread.c: New variable-defining functions defvar_int, defvar_lisp, defvar_bool and defvar_per_buffer are called by the new DEFVAR... macros. They ignore the doc-string argument. * lisp.h: Define macros DEFVAR_LISP, DEFVAR_INT, DEFVAR_BOOL and DEFVAR_PER_BUFFER. They expand into calls to defvar_lisp, etc. * all .c files: All Def...Var renamed to DEFVAR... in syms_of_.... * doc.c (FSnarf_documentation): Understand new DOC format where doc for function foo is named Ffoo and doc for variable foo is named Vfoo. When doc for a variable is found, store the file-position in DOC on the variable-documentation property. * doc.c (Fdocumentation_property): New Lisp function, like `get' except that if the value is a positive integer it is taken as a position in the DOC file and a string is read from that file. * filelock.c: correct spelling "supercession" -> "supersession". * undo.c: Rename RecordInsert as record_insert, and likewise RecordDelete, RecordChange and RecordChange1. * casefiddle.c, editfns.c, fileio.c, insdel.c: change callers. Tue Aug 19 03:00:43 1986 Richard M. Stallman (rms at prep) * xdisp.c (display_mode_element): Change the interpretation of symbols and lists in elements: if a symbol's value is a string, output that string literally; a list is a concatenation of all elements if the car is a string or a conditional of the cdr if the car is a symbol. * undo.c (Record...): Remember buffer->modtime as the "length" of the Uunmod. If point is at the end of a range deleted or changed, record that as the "position" of the range and make the length negative. * undo.c (Fundo_more): Undoing Uunmod does not mark as unmodified unless its remembered modtime matches the buffer's current modtime. Also handle case where length is negative in Uinsert, Uchange. Mon Aug 18 09:02:36 1986 Richard Mlynarik (mly at prep) * xdisp.c (display_mode_line): XSTRING->data, not XSTRING Fix another typo. Sun Aug 17 22:06:41 1986 Richard M. Stallman (rms at prep) * buffer.c (syms_of_buffer): Change doc for mode-line-format. * xdisp.c (display_mode_line, display_mode_element): Allow buf->mode_line_format to contain lists and symbols allowing computation and concatenation to produce the mode line. (Note that evaluation is not allowed; it would be unsafe.) display_mode_element is the recursion point for this. Sun Aug 17 19:40:05 1986 Richard Mlynarik (mly at prep) * emacs.c (main) Move init_environ up. * window.c (Fwindow_point) typo. * environ.c New function getenv replaces un*x getenv Sun Aug 17 19:04:41 1986 Richard M. Stallman (rms at prep) * window.c (Fwindow_point): When WINDOW is the selected window and its buffer is selected too, return current value of point. The pointm field of the window is not meaningful in such cases. * unexec.c (write_segment): If hit nonexistent page, must write zeros, not return. Sun Aug 17 14:28:48 1986 Richard Mlynarik (mly at prep) * callproc.c, process.c (Fcall_process, create_process) Use `alloca' versions of environment-hacking functions (ie current_environ_size and get_current_environ rather than current_environ and free_environ) * emacs.c (main): Call syms_of_environ, init_environ. * config.h., config.h.dist Increase PURESIZE again (sigh) * unexec.c (write_segment): Kludgey coercions ("(int)") to get this line to compile: nwrite = (((int) ptr + 128) & ~127) - (int) ptr; Also changed incorrect ~128 to ~127. * process.c: New function Fprocess_list. Sun Aug 17 05:56:29 1986 Richard M. Stallman (rms at prep) * crt0.c, alloca.s: Remove hack_sky (special for sun2) and the call to it. No longer needed since floating point is no longer used. * unexec.c: New compiler flag A_TEXT_OFFSET is defined for machines in which the a.out file header counts as the first few bytes of the text segment. The definition of A_TEXT_OFFSET would normally be sizeof (HDR). It has other terms added in on some machines (sequent). Sat Aug 16 18:42:35 1986 Richard Mlynarik (mly at prep) * eval.c (Fmacroexpand) Use car of nthcdr, not nth. * fns.c Define Fcopy_alist (used to be in subr.el) Move Fnth to subr.el * ymakefile Include environ.c * callproc.c, process.c (child_setup, Fcall_process, create_process): Take/pass environment arg. * environ.c: New file * sysdep.c: Move VMS sys_getenv to environ.c * editfns.c: Move getenv to environ.c Sat Aug 16 17:25:41 1986 Richard M. Stallman (rms at prep) * xdisp.c (display_text_line): * indent.c (current_column, ToCol, position_indentation): * indent.c (Fmove_to_column, compute_motion): Bring tab_width in range if it is very large. Fri Aug 15 03:05:00 1986 Richard M. Stallman (rms at prep) * fileio.c (Fwrite_region): Do the fsync before the fstat; that may prevent what appear to be spurious "file has changed on disk" warnings. Update bf_cur->modtime before signaling "IO error writing" to avoid more such warnings. * Make ctl-arrow, case-fold-search, etc. behave exactly as if they had been made local with make-variable-buffer-local. The default values live in struct buffer buffer_defaults. They also live in buffers that do not have local values. Each buffer has a local_var_flags slot with a bit for each variable, saying which variables are local in that buffer. * buffer.h: New buffer slot local_var_flags. * buffer.c: New structures buffer_defaults and buffer_local_flags. (init_buffers_once): store default values for local slots into buffer_defaults. (reset_buffer_variables): Copy default values from buffer_defaults into the buffer being reset. (syms_of_buffer): Variables default-ctl-arrow, etc., now forward to slots in buffer_defaults. * data.c (Fset, Fset_default, Fdefault_value, Fkill_local_variable): Know that a Lisp_Buffer_Objfwd has default value if the buffer_local_flags slot is nonzero, and a buffer uses that default unless its local_var_flags contains the bit of the buffer_local_flags for the slot. * alloc.c (Fgarbage_collect): Call mark_buffer on buffer_defaults. Thu Aug 14 18:40:13 1986 Richard M. Stallman (rms at prep) * unexec.c (copy_text_and_data): Write text and data separately if COFF (just as if not COFF). (make-hdr): if COFF and NO_REMAP, don't alter some f_ohdr fields. Thu Aug 14 16:35:21 1986 Richard Mlynarik (mly at prep) * editfns.c (getenv) Make getenv useful interactively. Move defaliases to fsets in subr.el Thu Aug 14 04:45:39 1986 Richard M. Stallman (rms at prep) * unexec.c: unexec_data_start records the ultimate corrected data_start from make_hdr; copy_text_and_data starts writing data segment from that address. Wed Aug 13 04:45:18 1986 Richard M. Stallman (rms at prep) * buffer.c (Fkill_buffer): Combine Fdelete_buffer_internal into this function. Simplify. Just return immediately if attempted to kill the minibuffer. * lisp.h: Define XSETPNTR and make XSETCONS (etc) use it. By default XSETPNTR is the same as XSETUINT. * lread.c (oblookup, map_obarray): Use XUINT, not XSYMBOL, to check for zero to detect end of bucket. On machines where all pointers have high bits set, XSYMBOL would never return zero. * alloc.c: change vars most_negative_fixnum and dont_copy_flag to constant macros ARRAY_MARK_FLAG and DONT_COPY_FLAG, defined normally based on INTBITS but overridable by m-*.h. * process.c (handle_process_output): Write in buffer even if buffer is read-only. * fileio.c (barf_or_query_if_file_exists): Rearrange: don't use comma around calls to NULL, so can compile using union type. Tue Aug 12 10:45:44 1986 Richard Mlynarik (mly at prep) * buffer.c (SetBfp, syms_of_buffer) Dike out debug-check-symbol code. I believe that this bug has evaporated. * fileio.c (barf_or_query_if_file_exists) ! => !NULL. Also use local variable for Lisp_object for bd compilers. Mon Aug 11 12:22:05 1986 Richard Mlynarik (mly at prep) * buffer.c (Fbarf_if_buffer_read_only) Include buffer in call to Fsignal. * print.c (Fwrite_char) Really default stream to standard-output. Sun Aug 10 00:18:48 1986 Richard Mlynarik (mly at prep) * eval.c (and abbrev.c, buffer.c, callint.c, cmds.c, keyboard.c, lread.c, lisp.h) Allow Fapply to take an &rest arg, the last of which is spread. (So (apply '+ 1 '(2 3)) => 6) Make Ffuncall do the work for Fapply, rather than duplicating all that code. Define apply1 for c code which needs it. Define call0 for c code which thought it needed Fapply. Fri Aug 8 11:56:10 1986 Richard Mlynarik (mly at prep) * ymakefile Don't assemble alloca.s if HAVE_ALLOCA. Even though the whole of this file is contained in a `#ifndef HAVE_ALLOCA ... #endif' a disgusting bug in cc (at least here, vax 4.2bsd) meant that this file was being assembled even though cc was passed the -E flag! Gag me with a unix-pinhead. * m-vax.h Define HAVE_ALLOCA if BSD * unexec.c (write_segment) Rename variable `fd' to `new' for macro PERROR. Wed Jul 30 21:23:27 1986 Richard M. Stallman (rms at prep) * fileio.c (Fwrite_region): add call to fsync before close. * xdisp.c (redisplay_window): Don't look at ->start in windows that have subwindows, since it is nil there. * window.c (save_window_restore): Avoid doing Fset_buffer on a dead buffer. Use the selected window's new current buffer in that case. Mon Jul 28 21:01:35 1986 Richard M. Stallman (rms at prep) * fileio.c (Finsert_file_contents): Don't mark buffer modified if inserted a null file. * fileio.c (Fcopy_file, e_write): Use 16k buffer size. Thu Jul 17 05:05:50 1986 Richard M. Stallman (rms at prep) * unexec.c (copy_sym): Put in missing #endif. * alloc.c (Fpurecopy, mark_object): Flush VIRT_ADDR_VARIES conditional; always use range from pure to pure + PURESIZE. Use type PNTR_COMPARISON_TYPE as the type to compare in. This is normally unsigned int but m- file may override this. * lisp.h (CHECK_IMPURE): Use PNTR_COMPARISON_TYPE, and always use the range from pure to pure + PURESIZE unless PNTR_COMPARISON_TYPE is defaulted. * eval.c (unbind_to): New temporary var `tmp' to avoid a Gould compiler bug. * term.c (calculate_ins_del_char_costs): * window.c (change_window_height): Changed floating point arithmetic to fixed point. * sysdep.c: Replace ad-hoc conditionals with new flags HAVE_VFORK, HAVE_DUP2 and HAVE_GETTIMEOFDAY. Change s-hpux.h and m-stride.h. * sysdep.c (init_sys_modes for VMS): Set TT2$M_XON. * process.c (create_process): On USG systems that have TIOCNOTTY, do the setpgrp here before reopening the pty rather than waiting for child_setup. * window.c (make_window): size given to make_vector was one too small. Thu Jul 10 12:19:07 1986 Richard M. Stallman (rms at prep) * keymap.c (Fdescribe_bindings): change XSETTYPE/XSETBUFFER to XSET. (describe_command): change XSETSTRING to XSET. * window.c (Fmove_to_window_line): delete unused start =. * xdisp.c (DoDsp) delete unused all_windows initializer. * dispnew.c (update_line): delete unused osp =. * minibuf.c (do_completion): delete unused completedp initializer. * search.c (Freplace_match): delete unused some_multiletter_word init. * alloc.c (gc_sweep): delete unused next initializers. * fns.c (concat): after error on non-int elt for string, do store the new value from the error handler. * lread.c (read1): comment out unused end =. * lread.c (read_list): delete unused tail =. * data.c (Fmake_variable_buffer_local): if value type is Lisp_Some_Buffer_Local_Value, change it to Lisp_Buffer_Local_Value permanently. * undo.c (record_block): delete unused cp =. Don't bother reallocing if n = 0 after first batch. * fileio.c (Fverify_visited_file_modtime): If CHECK_BUFFER changes buf, use the changed value. Mon Jul 7 13:59:16 1986 Richard M. Stallman (rms at prep) * alloc.c (mark_buffer): mark the selective_display_ellipses slot. Wed Jun 25 08:39:56 1986 Richard M. Stallman (rms at prep) * window.c (Frecenter): Fix bug in last change: change applied to M-- arg ratherthan C-u by mistake. Thu Jun 19 12:32:53 1986 Richard M. Stallman (rms at prep) * ymakefile (CPP): Now defined by default as `cc -E'. * Makefile: likewise. * More 3b changes: * ymakefile: Allow config to specify LIBS_TERMCAP even if TERMINFO. * sysdep.c: Delete the sign-extension functions; just define a variable sign_extend_temp. * m-3b.h renamed to m-3b20.h. Now defines ATT3B20 as well as ATT3B. New definitions for XINT and SIGN_EXTEND_CHAR. * sysdep.c (readdirver): New VMS-only function: like readdir but return each version as separate filename. * dired.c (file_name_completions): New arg ver_flag. All callers changed. * dired.c (Ffile_name_all_versions): New function, VMS only. * unexec.c (copy_sym): Remove spurious #else on sun3 conditional. The old #else code is now unconditional. * window.c (Fdisplay_window): Split largest window only if full screen width. The conditional was backwards. Tue Jun 17 05:49:16 1986 Richard M. Stallman (rms at prep) * process.c (Fsend_region): Previous change forgot to assign anything to start1. Fri Jun 13 02:09:29 1986 Richard M. Stallman (rms at prep) * emacs.c (Fdump_emacs): Use start_of_text, not &_start, as entry address for unexec. * alloc.c: Use XPNTR, not XUINT, when checking for pureness. * data.c: When indirecting through Lisp_Buffer_Objfwd, use XUINT to get the offset, not XOBJFWD. * lisp.h: New macro XPNTR is used as subroutine by all of XCONS, XSTRING, etc. Define it like XUINT normally. If DATA_SEG_BITS is defined, XPNTR or's that into the result. Use XPNTR in CHECK_IMPURE. * sysdep.c (end_of_{text,data}): Do compile these. rt-pc unexec needs them. * sysdep.c (start_of_bss): New function. * unexec.c (copy_text_and_data, write_segment): Write text and data segments separately. Use new subroutine write_segment to do each one. * process.c (Fprocess_exit_status): New name for Fprocess_reason. Wed Jun 11 17:01:32 1986 Richard M. Stallman (rms at prep) * abbrev.c (Fexpand_abbrev): Delete the - inserted by abbrev-prefix-mark, if any. * filelock.c (lock_file): Check for modifying a buffer whose file has changed and call ask-user-about-supercession-threat, which can ask for confirmation and get an error. Tue Jun 10 00:45:11 1986 Richard M. Stallman (rms at prep) * crt0.c: Merge changes for Nu. * unexec.c (make_hdr): Fix handling of blockcopy_start; for the sake of Nu machine. * fileio.c (Fcopy_file): optional 4th arg non-nil means preserve the last-modified time. * Make C-M-v in minibuffer scroll the minibuffer's help window if any. * window.c (save_window_{save,restore}): Save and restore minibuf_scroll_window. * window.c (Fscroll_other_window): If minibuffer is selected, scroll minibuf_scroll_window. * minibuf.c (read_minibuf): set minibuf_scroll_window to nil. * window.c (Frecenter): With just C-u as arg, recenter point but don't erase the screen. Mon Jun 9 09:27:09 1986 Richard M. Stallman (rms at prep) * process.c (Fsend_region): * fileio.c (Fwrite_region): * editfns.c (Fchar_after, save_restriction_restore): Avoid using XINT in args to other macros. * sysdep.c: New function char_sign_xtnd for ATT3B. * lisp.h: Don't redefine XINT if it's already defined. So m-3b.h can override it. * ymakefile: If NO_REMAP, use the standard crt0.o but precede it with pre_crt0.o whose job is to define data_start. * buffer.h. buffer.c: New per-buffer variable selective-display-ellipses. * xdisp.c (display_text_line), indent.c (compute_motion): Let bf_cur->selective_display_ellipses control display of ... before invisible lines. * lread.c (openp, Fload): openp now takes a sequence of suffixes with colons between. It loops over suffixes faster than over directories. load takes new fourth arg NOSUFFIXES. Sun Jun 8 16:01:48 1986 Richard M. Stallman (rms at prep) * paths.h: Remove . from load-path. * lread.c: Make "load" no longer interactive. * keyboard.c: Introduce BUFFER_SIZE_FACTOR to make some keyboard buffers 16 times as big when X windows exist. Sat Jun 7 17:08:19 1986 Richard M. Stallman (rms at prep) * eval.c (call_debugger): Don't do a debug-on-call for calling the debugger. * keyboard.c (gobble_input): Must really use FIONREAD. * keyboard.c (command_loop{,_1,_2}, top_level_{1,2}): Now Frecursive_edit calls command_loop, which does the catches and calls command_loop_2, which does the error handling, which calls command_loop to do the real work. Also, top_level_1 does a condition-case around top_level_2, which does the work. Previously, the error handling was outside the catch for top-level. Then if handling an error ran an unwind protect form, the catch was not in effect; so ^G, or the debugger Q command, would not work inside of them. Fri Jun 6 00:28:18 1986 Richard M. Stallman (rms at prep) * keymap.c (get_keymap{,_1}): Create get_keymap_1 that takes arg saying whether to get error. get_keymap calls that, saying do get an error. * keyboard.c (get_char): If rereading a char, do put it in the echo buffer if the echo buffer is empty. Fixes problem that C-s C-h would never echo the C-h. * window.h: New window slot start_at_line_beg, holds t if window's start was the beginning of a line. * window.c: update this wherever ->start is updated. (But not always correctly). * xdisp.c (redisplay_window): update start_at_line_beg, and also find a new start if the old start used to be a line beginning but no longer is (which implies text changes just before it). * keyboard.c (get_input_pending): Don't bother with FIONREAD if interrupt_input; just use kbd_count. * fns.c: Assume KERNEL_FILE, LDAV_SYMBOL and NLIST_STRUCT are fully set up by the s- and m- files. * emacs.c (main): Don't call `signal' if in batch mode and not initialized and dumping is possible. * keyboard.c (init_keyboard): likewise for SIGIO. * unexec.c (make_hdr): Copy entire header of old file as base for header of new file. Eliminates most machine-specific conditionals. * terminfo.c: make tparam work by calling tparm. * term.c, cm.h: Eliminate `Tab' macro. * s-usg5.2.h, s-usg5.2.2.h: set the TERMINFO flag. * fileio.c (Ffile_newer_than_file_p): New Lisp primitive. * fileio.c (Ffile_exists_p): this is now distinct from Ffile_readable_p; it checks only for existence, not for readability. * editfns.c (Fgoto_char): Use new interactive code N. * callint.c (Fcall_interactively): New code N means use prefix argif have one, else read number from minibuffer. * buffer.c (record_buffer): Don't use Frassq, Fmemq or Fdelq since their loops allow quitting. Write a spacial loop by hand. Thu Jun 5 00:13:27 1986 Richard M. Stallman (rms at prep) * process.c: Add MASSCOMP conditionals for pty and tty names. New way to check pty accessibility with `access'. * unexec.c (make_hdr): MASSCOMP has its own special field. * sysdep.c: Use HAVE_TERMIO conditionals instead of USG conditionals in many places. Use INTERRUPTABLE_OPEN and INTERRUPTABLE_IO conditionals to decide whether to include the functions sys_read, sys_write, sys_open. child_setup_tty must do FIOASYNC on masscomp. * fns.c (concat): Add MASSCOMP_REGISTER_BUG conditional. * editfns.c (init_editfns): Always check LOGNAME if no USER var. * dispnew.c: Now depends on HAVE_TERMIO. * crt0.c: BOGUS flag renamed CRT0_DUMMIES. Also now this is never assumes; each m- file must set it to use that code. * crt0.c: Two new flags: GLOBAL_START_DOT and GLOBAL_START_NO_DOT, control .globl start, etc. m- files must define these as needed. To have no effect, must define one or the other whenever CRT0_DUMMIES is set except for masscomp. GLOBAL_START_NO_DOT for tower32, GLOBAL_START_DOT for all others. * term.c, termchar.h: Define new flag var no_redraw_on_reenter; nonzero means no need to set screen_garbaged on resuming after a suspension. * sysdep.c (init_sys_modes): don't set screen_garbaged after resumption if that flag is set. * dispnew.c (syms_of_dispnew): make Lisp var no-redraw-on-reenter, * process.c (Fprocess_reason): New function. * dispnew.c (change_screen_size): New arg PRETEND. If it's zero, set ScreenRows or ScreenCols. Fset_screen_{width,height} take new arg as well to control value of PRETEND. * sysdep.c (child_setup_tty for USG): Turn ICANON on, and set VKILL and VERASE to 0377. Don't frob VMIN and VTIME (said to be unnecessary here). * keyboard.c (command_loop, Frecursive_edit): Call top_level_1 only from command_loop. Do it before command_loop_1. Put catch for top-level around it. * xdisp.c (try_window_1): use scroll_cost to decide whether scrolling, as determined from ins/del records, is better than simple reprinting. * scroll.c (scroll_cost): New function computes what cost would be to do scroll_screen_lines. * xdisp.c (display_text_string): Display minibuf_prompt only if vpos is the top of the minibuffer. Attempts to fix the bug where the prompt appears on all the lines of an empty minibuffer. Wed Jun 4 20:35:49 1986 Richard M. Stallman (rms at prep) * fileio.c (Fdefine_logical_name): For VMS: create a logical name translation. * emacs.c (main): (HAVE_X_WINDOWS) New variable alternate_display, set with a -d switch. * keyboard.c, sysdep.c: Create new system-independent function sys_suspend. All places that want to suspend now use sys_suspend. Delete fake_suspend and make its definition one of the cases for sys_suspend; but require the caller to change the terminal modes, on all system versions. * Merged in VMS conditionals in numerous files. Sun Jun 1 04:33:34 1986 Richard M. Stallman (rms at prep) * emacs.c (main, Fdump_emacs): Use new arg to malloc_init to say what function to call for warnings. * unexec.c, malloc.c, getpagesize.h: The code to define getpagesize () is now in getpagesize.h. * process.c (reate_process), callproc.c (child_setup): Move call to child_setup_tty from child_setup to create_process, so it's not done for synchronous subprocesses. * sysdep.c (child_setup_tty): omit it if not subprocesses. * alloc.c (mark_object), lread.c (DefLispVar): Protect the C variable with staticpro. Therefore no more need to mark thru a Lisp_Objfwd. See ChangeLog.1 for earlier changes. Local Variables: mode: indented-text eval: (auto-fill-mode 1) left-margin: 8 fill-column: 74 version-control: never End: emacs-19.30/src/ChangeLog.3100666 12120 1 2337646 5523315652 13723 0ustar rmsdaemonSun May 30 00:15:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.10 released. Sat May 29 20:50:06 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): If we changed buffers during read_char, go to replay_sequence. * frame.c (Ficonify_frame, Fmake_frame_invisible): Select some other frame. Move minibuffer off this frame. * frame.c (Fhandle_switch_frame): Don't call Ffocus_frame. (Fredirect_frame_focus): Call Ffocus_frame here. * xterm.c (x_bitmap_icon): Don't free icon_bitmap; create it if it hasn't been created before. * xterm.c (XTread_socket): For UnmapNotify, if frame was visible, mark it now as iconified. (x_make_frame_invisible): If async_iconic, work does need to be done. Don't let this frame stay highlighted. (x_iconify_frame): Don't let this frame stay highlighted. * s/usg5-4-2.h (sigsetmask): #undef this. * sysdep.c (sys_signal): Use 0, not NULL, to set sa_flags. Sat May 29 16:47:12 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * linux.h (C_OPTIMIZE_SWITCH): Set this to the empty string; configure guesses just fine. * tekXD88.h: New file, from Kaveh Ghazi. * systty.h (CDISABLE): #undef it before re-#defining it. * sysdep.c (sys_siglist): Comment out #endif trailer. * xmenu.c (TRUE, FALSE): Same. * xterm.c (dumprectangle): Same. * emacs.c: Don't include termios.h directly--let systty.h do it. Sat May 29 00:26:39 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfaces.c [HPUX]: Include time.h and define __TIMEVAL__. * emacs.c (shut_down_emacs): Maybe close X connection. New arg NO_X. (Fkill_emacs): Don't close it here. Pass new arg. (fatal_error_signal): Pass new arg. * xterm.c (x_connection_closed): Pass new arg. * xdisp.c (syms_of_xdisp): Make highlight-nonselected-windows Lisp var. (display_text_line): Obey it. (display_text_line): Really check for just the selected window. * s/usg5-4-2.h: New file. * keyboard.c (menu_bar_items): Save Vinhibit_quit by hand instead of using specbind. (menu_bar_items): Call Fnreverse before restoring Vinhibit_quit. * s/hpux8.h (OLDXMENU_OPTIONS): Add quotations. * m/ibmrt.h (C_SWITCH_MACHINE): Define only if not __GNUC__. (HAVE_FTIME): Defined. (EMACS_BITMAP_FILES): Defined. * xfns.c (Fx_close_current_connection): Clear x_current_display. * xterm.c (XTring_bell): Do nothing if x_current_connection is 0. * buffer.c (reset_buffer): Clear mark_active field here. (reset_buffer_local_variables): Not here. (Fswitch_to_buffer, Fpop_to_buffer): Return the buffer. (Fmove_overlay): Fix data types in last change. * sysdep.c (gettimeofday): Don't store in *tzp if tzp is 0. * process.c (MAXDESC): Get it from FD_SETSIZE if that exists. * s/sco4.h (PTY_ITERATION, PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF): Redefined. (SIGNALS_VIA_CHARACTERS): Defined. [HAVE_SOCKETS] (HAVE_GETTIMEOFDAY): Defined. (MAIL_PROGRAM_NAME): Defined (two alternate definitions). * xfns.c (Fx_list_fonts): Use CHECK_LIVE_FRAME on the frame arg. Fri May 28 16:07:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/hpux8.h (LIBX11_SYSTEM): Defined. * ymakefile: Replace config.h as dep with $(config_h). (really-oldXMenu): Use two make vars to pass values of C_SWITCH_... within doublequotes. * xfns.c (x_figure_window_size): Never set PPosition or PSize. * keymap.c (syms_of_keymap): Create global_map 256 slots long. * cmds.c (keys_of_cmds): Predefined 0240-0376 as self-insert. * xterm.c (XTread_socket, case KeyPress) [HPUX]: Recognize the extended function keys. * buffer.c (Fgenerate_new_buffer_name): New arg IGNORE. (Frename_buffer): Pass new arg. Fri May 28 00:33:32 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * keyboard.c (menu_bar_items): Bind Qinhibit_quit to Qt while we call the keymap accessors; this gets called during redisplay. * ymakefile (alloca.o): Call $(CC), not cc. * s/linux.h (SIGNALS_VIA_CHARACTERS): Try this out for a bit. * buffer.c (Fmove_overlay): If the overlay is changing buffers, do a thorough redisplay. * xfns.c (x_set_frame_parameters): Use the first position/size parameter we find, not the last. * s/hpux8.h: Don't define HAVE_RANDOM. * config.h.in (UNEXEC_SRC): New macro, set by the configure script. * ymakefile (UNEXEC_SRC): Give it a default value here, and make UNEXEC depend on it. * ymakefile (lispdir): Set this in terms of ${srcdir}. Thu May 27 19:47:45 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dispnew.c (Fsleep_for): Don't return without waiting when SEC is 0. * emacs.c (syms_of_emacs) [CANNOT_DUMP]: Don't defsubr Sdump_emacs*. * alloc.c (mark_object): Add debugging code to check for ptr clobbered. Thu May 27 02:35:32 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.9 released. Thu May 27 02:02:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_char): Correct previous change. Thu May 27 01:04:33 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * systty.h: Always terminate comments, to avoid confusion. * xfns.c: Make resource manager work correctly even when Vinvocation_name has periods and asterisks in it. (Vxrdb_name): New variable. (Fx_get_resource): Use it instead of Vinvocation_name. (Fx_open_connection): Initialize it to a copy of Vinvocation_name, with the dots and stars replaced by hyphens. (syms_of_xfns): staticpro it here. * xfns.c (Fx_get_resource): Use the proper format string when the attribute has been specified. Thu May 27 01:09:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (x_get_resource_string): New function. * ymakefile (ALL_CFLAGS): Put CFLAGS last. Wed May 26 19:53:16 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * s/sol2.h: (SOLARIS_BROKEN_ACCESS): Don't define this. * s/aix3-2.h (C_SWITCH_SYSTEM): Don't define this to be "-ma" if we're using GCC - that's an XLC switch. * s/aix3-2.h (LIBS_SYSTEM): Put -LIM -Liconv here. * systty.h (HAVE_LTCHARS, HAVE_TCHARS): New macros; define them if we have those structures, but *don't* define them if we have TERMIOS, whose functions take care of those parameters; that screws up AIX. (struct emacs_tty): Test those symbols, instead of the ioctl commands. * sysdep.c (emacs_get_tty, emacs_set_tty, new_ltchars, new_tchars, init_sys_modes): Same. * config.h.in (HAVE_RENAME): Include an #undef for this, so configure will have something to edit. Wed May 26 19:12:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (window_loop, case GET_LRU_WINDOW): Get frame's width properly. * xselect.c (x_get_local_selection): If no conversion function exists for the requested type, just return nil. * s/linux.h (HAVE_TCATTR): Defined. * sysdep.c [HAVE_SOCKETS]: Include socket.h, netdb.h. (get_system_name) [HAVE_SOCKETS]: Use gethostbyname. Wed May 26 19:00:00 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * s/hpux8.h (LIB_X11_LIB, C_SWITCH_SYSTEM, LD_SWITCH_SYSTEM, LD_SWITCH_SYSTEM, OLDXMENU_OPTIONS): Add X11R5 directories to the search paths in these lists; they shouldn't do any harm if they don't have X11R5. * s/aix3-2.h (C_SWITCH_SYSTEM): Don't #define this if we're using GCC. Wed May 26 01:09:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xrdb.c (magic_searchpath_decoder): Fix typos. * xdisp.c (display_text_line): Don't call compute_char_face for a non-X frame. * xfns.c (Fx_rebind_key, Fx_rebind_keys): X10 definitions deleted. (syms_of_xfns): Install them only if X11. * ralloc.c (r_alloc_sbrk): Declare already_available as long, not SIZE. * xfns.c (x_set_cursor_type): If arg not recognized, use box cursor. * s/hpux8.h (LD_SWITCH_SYSTEM) [__GNUC__]: Pass -a archive to ld. (HAVE_RANDOM): Defined. * s/hpux.h (rand, srand): Definitions deleted. * keyboard.c (Fcurrent_input_mode): Fix the call to Flist. (make_lispy_event): Fix off-by-1 error with hpos in menu bar. * s/sunos4-1-3.h: New file. * ymakefile (XOBJ) [!HAVE_X_MENU]: Add xfaces.o. * s/irix4-0.h (SIGNALS_VIA_CHARACTERS): Defined. * xterm.c (x_wm_set_size_hint): Don't set hints for max size. Tue May 25 11:19:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * m/ibmrs6000.h (LIBS_MACHINE): Add -lIM and -liconv. (HAVE_GETTIMEOFDAY): Deleted. * sysdep.c (wait_for_termination): Don't use the BSD alternative for LINUX. Use the UNIPLUS alternative. * keyboard.c (read_char): If kbd_buffer_get_event returns nil, redisplay and retry. (kbd_buffer_get_event): If event is handled here, return nil. (swallow_events): New function. * process.c (wait_reading_process_input): Call that. * ralloc.c (POINTER): Always use char *. * s/sol2.h (C_SWITCH_X_SYSTEM): Deleted. (LD_SWITCH_SYSTEM): Delete the -L option, leave just -R. * m/symmetry.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF): Use pty_name, not ptyname. * syntax.c (Fforward_comment): Arg is a Lisp_Object. Convert it to an int. * ymakefile (alloca.o): Get alloca.c and alloca.s from ${srcdir}. * floatfns.c (logb): Don't declare if hpux. * syntax.c (Fforward_comment): Always set point. * s/dgux.h, s/hpux.h, s/esix.h (HAVE_GETTIMEOFDAY): Deleted. * s/irix4-0.h (C_ALLOCA, alloca): Definitions deleted. [!NOT_C_CODE]: Include alloca.h. (NEED_SIOCTL): #undef this. * xterm.h (PIXEL_TO_CHAR_COL, PIXEL_TO_CHAR_ROW): Fix mismatch in arg names. * xfns.c (Fx_open_connection): Set xrm_option correctly. Tue May 25 18:09:03 1993 David J. MacKenzie (djm@wiki.eng.umd.edu) * xfns.c (x_figure_window_size): Make the default frame coords (0,0). Tue May 25 05:15:14 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.8 released. Tue May 25 00:52:36 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xfns.c: Clear out the old face stuff. (x_face_table, n_faces, x_set_face, x_set_glyph, Fx_set_face_font, Fx_set_face, Fx_get_face): Removed. (syms_of_xfns): Remove defsubr for Fx_set_face. Arrange for font names to get fully resolved - no wildcards. * xfns.c (x_set_frame_parameters): Store the value in the frame parameter alist before we call the setter function, so the setter function can touch up the value if it chooses. (x_set_foreground_color, x_set_background_color): Call recompute_basic_faces, so their GC's will reflect the changes. (x_new_font): Add extern declaration - this returns a Lisp_Object now, the fully resolved font name. (x_set_font): Accept the fully resolved name from x_new_font, and put it in the frame's parameter alist. Call recompute_basic_faces. * xterm.c (x_new_font): Return the fully resolved font name, Qnil (if no match), or Qt (match, but unacceptable metrics). * xterm.c (x_new_font): Don't call init_frame_faces. * xterm.h: New section for declarations for xfaces.c. (init_frame_faces, free_frame_faces, intern_face, face_name_id_number, same_size_fonts, recompute_basic_faces, compute_char_face, compute_glyph_face): Declare these here. * xfaces.c (same_size_fonts): We can now remove this extern declaration. * xfns.c (face_name_id_number): Likewise. * xterm.c (intern_face): Likewise. * xterm.c (dumpglyphs): Remember that the default faces can have null fonts, too. * xfns.c (Fx_list_fonts): Remember that FACE may not have a font specified. Don't specify 30000 as the maximum limit on the number of fontns returned - 2000 is more reasonable. * xfaces.c (build_face, unload_font, free_frame_faces): Don't forget to block input while making X calls. Treat faces as structures specifying modifications to the frame's parameters, rather than things which need to specify a complete set of parameters by themselves. * xfaces.c (init_frame_faces): Don't set up the two frame display faces by querying the GC - just leave all their fields blank, and call recompute_basic_faces, letting build_face do the work of consulting the frame when necessary. (recompute_basic_faces): New function. (compute_base_faces): New function for obtaining the "identity" for compute_char_face and compute_glyph_face. (compute_char_face, compute_glyph_face): Call it, instead of copying FRAME_DEFAULT_FACE. * xfns.c (x_make_gc): No need to call init_frame_faces here. * xfaces.c (intern_frame_face): This can be static. * dispextern.h (struct face): New field - `copy', to help us with resource allocation. * xfaces.c (free_frame_faces): Do free the first two faces; don't free anything from a face that's a copy. (intern_frame_face): Mark every face we intern as a copy; its resources are actually a combination of the real faces. (Fset_face_attribute_internal): No need to check if we're trying to free one of the frame's GC's; they never enter into the picture. * casetab.c: Fix formatting, so as not to confuse etags. * xfns.c (Fx_list_fonts): New function. (face_name_id_number): Add extern declaration for this. * xfaces.c (face_name_id_number): Make this externally visible, and make the FRAME argument a FRAME_PTR, not a Lisp_Object. (compute_char_face): Call face_name_id_number properly. * xfaces.c (unload_color): Don't free the pixel for now. * xfaces.c (merge_faces): You can't tell if a font is a character-cell font or not by testing whether or not it has a per_char table. They all do. * xterm.c (x_new_font): Same deal. * xfns.c (Fx_list_fonts): Same deal. * m/iris4d.h: Dyke out the section which specifies how to get the load average. * paths.h (PATH_INFO): New path, to edited by the configuration process. * callproc.c (Vconfigure_info_directory): New variable, used internally by build process. (syms_of_callproc): DEFVAR it and initialize it. * keyboard.c (Fcurrent_input_mode): Use XFASTINT to build the last element of the return value, not XSETINT. Mon May 24 12:14:41 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) Changes for OSF/1: * mem-limits.h [__osf__ && (__mips || mips)]: #include and . (get_lim_data): OSF wants a definition like BSD4_2's. * s/osf1.h: #include "bsd4-3.h", not "s-bsd4-3.h". * ymakefile (LIBX): Put LD_SWITCH_X_SITE before the libraries, so it actually has an effect. Some makes can't handle form feed characters in their makefiles. * s/usg5-3.h: Remove form feed. * s/template.h, m/template.h: Remove form feeds. * xfns.c (select_visual): Include the screen number in the template of things XGetVisualInfo must match. Mon May 24 17:41:19 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/dgux.h (NO_GET_LOAD_AVG): Test _M88KBCS_TARGET, not __GNUC__. * xterm.c (XTread_socket, ConfigureNotify case): Convert from parent window, not Emacs window. (XTread_socket): Handle ReparentNotify events. * m/i860.h: New file. * keyboard.c (lispy_function_keys): Add kp-numlock. Fix kp-backspace. Mon May 24 15:15:41 1993 Thorsten Ohl (ohl@chico.harvard.edu) * m/next.h (C_SWITCH_MACHINE): Definition deleted. * lread.c: Don't #undef NULL. Mon May 24 16:50:42 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * buffer.c (Fmake_overlay): Put beg and end in the right order. (Fmove_overlay): If beg and end are markers, make sure they're in the right buffer. Mon May 24 15:21:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (modify_event_symbol): If a name_table elt is null, generate a name to use. Don't crash. * fileio.c (Fread_file_name): If input is empty, do return the default even if !insert_default_directory. * xterm.c (XTread_socket): For ConfigureNotify event, translate coordinates if send_event field is false provided the x-coord value is not large. Mon May 24 13:42:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/irix4-0.h (NO_MATHERR): Defined. * floatfns.c [NO_MATHERR]: Undef HAVE_MATHERR. Mon May 24 04:05:22 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * fileio.c (Ffile_writable_p): Pass XSTRING (foo)->data to ro_fsys, not XSTRING (foo). * xterm.c (x_new_font): Reject fonts with varying spacing. We don't support them yet. * xfns.c (x_set_font): Report the error message properly. * xfns.c (Fx_parse_geometry): No need to call check_x here; it doesn't interact with the server at all, and we need it in order to create our first frame. Mon May 24 02:14:58 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/linux.h (HAVE_SETSID): Defined. (HAVE_SOCKETS): Defined. * process.c (create_process): Ignore retval from TIOCSTTY. (sys_siglist) [LINUX]: Don't even declare it. Mon May 24 01:11:23 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * syssignal.h (sys_signal): Declare the second argument to have type signal_handler_t. We're told this is necessary for Linux. Mon May 24 01:01:43 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/dgux.h (NO_GET_LOAD_AVG): Define, if __GNUC__. Sun May 23 23:39:35 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * s/hpux8.h (NO_SIOCTL_H): Defined. Sun May 23 23:29:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/linux.h (HAVE_DUP2, HAVE_ALLOCA_H): Deleted. Sun May 23 22:27:33 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * syssignal.h: Don't #include * alloc.c: #include , but before "config.h". Sun May 23 18:38:26 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfaces.c (Fset_face_attribute_internal): Don't call unload_font for the frame's own font. * xfns.c (check_x): New function. Call it in almost every Lisp function in this file. (x_set_menu_bar_lines_1): Pass both args in recursive call. Sun May 23 21:44:35 1993 Paul Eggert (eggert@twinsun.com) * editfns.c (Fcurrent_time_zone): Make `am' an int, not long. Sun May 23 15:23:05 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) Changes for SGI from Matthew J Brown . * m/iris4d.h, m/iris5d.h: Don't use the --cckr CC switch if we're using GCC. * m/iris4d.h (NEED_SIOCTL): Move this to... * s/irix3-3.h (NEED_SIOCTL): ... here; apparently it's not necessary in irix4-0.h. * s/irix4-0.h: Remove declaration of getpty; apparently Irix 4.0 already declares this elsewhere. (PTY_TTY_NAME_SPRINTF): #undef this before re-#defining it. * m/ibmps2-aix.h, m/pfa50.h, s/hpux.h, s/isc2-2.h, s/linux.h, s/sco4.h, s/usg5-4.h: Remove HAVE_RENAME; configure guesses that now. * config.h.in (LD_SWITCH_X_SITE, C_SWITCH_X_SITE): Change the #defines to #undef's, so ../configure knows it should tweak them. * xterm.c (x_scroll_bar_report_motion): Set *TIME whether or not the mouse is over a scroll bar. * xfaces.c (Fset_face_attribute_internal): Don't free the frame's normal_gc or reverse_gc. * keyboard.c (make_lispy_movement): Deal properly with mouse motion outside of all windows. * lisp.h (GLYPH_FACE): Remember that the face portion of a glyph can be 24 bits, not just eight. Sun May 23 14:03:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c: Move signal.h and stdio.h before config.h. * editfns.c (Fcurrent_time_zone): Assign gmt, instead of init. Sat May 22 17:44:54 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.7 released. * Makefile.in (SUBMAKEFLAGS): Add CFLAGS to the list. * puresize.h [not HAVE_X_WINDOWS] (PURESIZE): Make this 185k, not 196k. We're actually using ~180k. * editfns.c: #include , to get time_t for Eggert's changes. Sat May 22 13:59:32 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ymakefile (FRAME_SUPPORT): Add mouse.elc, select.elc, scroll-bar.elc. * xdisp.c (display_text_line): Highlight in any frame's sel window. * keyboard.c (modifier_names): Update to match *_modifier in termhooks. Sat May 22 03:48:28 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * xterm.c (x_scroll_bar_handle_click): Never grab the scroll bar; that feature requires more support to work correctly. * keyboard.c (make_ctrl_char): New function. (read_char): Call it. (kbd_buffer_store_event): Call it to see if the new character is the quit or stop character. (make_lispy_event): Call it. Fri May 21 23:15:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (x_window_to_frame): Use XGCTYPE. Fri May 21 19:45:18 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * process.c (Fopen_network_stream): Deal with older systems, which only have the h_addr field in their struct hostent. * systty.h [SYSV_PTYS]: #include . Francesco Potorti` says it's necessary on his machine, and it should be harmless. Fri May 21 19:41:14 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sysdep.c (wait_for_termination): Copy code from 18.59 (but sans BSD4_1 alternatives). Fri May 21 18:33:21 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * ymakefile (alloca.o): #define malloc and free to be xmalloc and xfree on the command line of this compilation. * s/sco4.h: (TIME_WITH_SYS_TIME): This is no longer needed. * s/linux.h: Remove copyright notices by Michael K. Johnson and Rik Faith. They have both sent in papers now which make their changes public domain. * sysdep.c (sys_suspend): Set synch_process_alive, so that wait_for_termination has something to wait for. Fri May 21 16:20:18 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xdisp.c (display_text_line): Highlight only in selected window. * xfns.c (syms_of_xfns): Don't make Lisp vars x-mode-pointer-shape and x-nontext-pointer-shape. Thu May 20 23:15:44 1993 Ian Lance Taylor (ian@cygnus.com) * s/sco4.h (SCO): Don't define (no longer needed). (HAVE_SYS_TIME_H): Don't define (set by configure). (TIME_WITH_SYS_TIME): Define. Thu May 20 19:29:55 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * dispnew.c (preserve_other_columns): Remember to multiply the size argument to bcopy by the size of a glyph. Thu May 20 09:43:18 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): Reexamine this_command after pre-command-hook runs. * xterm.c (x_find_modifier_meanings): If some keys are meta and alt, make them just meta, not alt. Wed May 19 15:12:42 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) Some time-handling patches from Paul Eggert: * editfns.c (Fcurrent_time_zone): Take an optional argument specifying what (absolute) time should be used to determine the current time zone. Yield just offset and name of time zone, including DST correction. Yield time zone offset in seconds, not minutes. (lisp_time_argument, difftm): New functions. (Fcurrent_time_string): Use lisp_time_argument. * systime.h (EMACS_CURRENT_TIME_ZONE, EMACS_GET_TZ_OFFSET, EMACS_GET_TZ_NAMES): Remove. * config.h.in: Add HAVE_TM_ZONE. Some more changes from Michael K. Johnson for Linux. * s/template.h: Mention that you should #define HAVE_TERMIO or HAVE_TERMIOS, but not both, and that HAVE_TERMIOS is preferred. * systty.h (EMACS_SET_TTY_PGRP): Don't assign the return value of tcsetpgrp to *pgid; it's just a status value. * config.h.in (HAVE_RANDOM): This shouldn't be defined on Linux systems using XFree386, and perhaps is inappropriate in general. * m/intel386.h: #undefine the integer size macros, since the Linux file #defines them itself. * mem-limits.h (get_lim_data): Linux has the ulimit call; if it fails, fall back on ULIMIT_BREAK_VALUE. * process.c: Linux needs the WAITTYPE, etc. definitions. * unexec.c (hdr, ohdr): Linux has the ordinary `struct exec' type; no need to use SYSV names. * s/linux.h: New file. Some changes from Michael K. Johnson for Linux. * sysdep.c (sys_siglist): Don't define this if HAVE_SYS_SIGLIST is #defined. That lets the system provide it, if it has it. * syssignal.h (sigmask): Only define this if hasn't given us a definition already. * syssignal.h (sys_sigpause): Fix argument in prototype. * sysdep.c (init_signals): The masks are called empty_mask and full_mask, not signal_empty_mask and signal_full_mask. (signal_handler_t): Moved .... * syssignal.h: ... to here. * systty.h (EMACS_SET_TTY_PGRP): Call tcsetpgrp with the correct arguments. * emacs.c (main): Don't try to establish signal handlers for SIGBUS and SIGSYS unless they're actually #defined. * systty.h [HAVE_TERMIO, __DGUX]: #include . * xdisp.c (redisplay_window): Compute the scrollbar start and end properly. Wed May 19 10:25:56 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (Fcurrent_input_mode): Return META as 3-way flag. Wed May 19 00:35:25 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * fileio.c (Ffind_file_name_handler): Check that FILENAME is a string. * process.c (wait_reading_process_input): Undo change of April 29th, since that re-introduces the race condition the comments are warning about. Call clear_waiting_for_input before calling status_notify, though. * process.c (wait_reading_process_input): Don't forget to call clear_waiting_for_input when we exit the loop because process input has arrived. Changes for Silicon Graphics Iris 5D. * unexelfsgi.c: New file; like unexelf.c, but tolerates program segments above BSS. * m/iris5d.h: New file. * s/irix5-0.h: New file. * process.c [__sgi] (allocate_pty): Give up immediately if pty is inaccessible. Wed May 19 00:16:55 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (follow_key): Check char in range before UPPERCASEP. Tue May 18 23:27:38 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (x_set_menu_bar_lines): Fix typo in last change. * keyboard.c (make_lispy_event): Controlify lower case letters too. Tue May 18 18:06:44 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xdisp.c (display_text_line): If the newline (or C-m, in selective-display) has a non-default face, apply that face to the remainder of the line, so that the fill occupies the entire line. * xterm.c (x_new_font): Tell the frame display faces about the newly chosen font. Make sure that all the display faces use fonts of the same dimensions as the default face, so as not to confuse the rest of the redisplay code. * xfaces.c (same_size_fonts): New function. (merge_faces): Only merge in a new font from the FROM face if it is the same size as the font in the TO face. * xfns.c (x_set_menu_bar_lines): Minibuffer-only frames can't have menu bars. * keyboard.c (read_key_sequence): Don't lay down an unwind_protect to restore the original buffer until we actually get a mouse click. * window.c (window-dedicated-p): Doc fix. Tue May 18 16:05:54 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (XTread_socket): Turn off ControlMask for XLookupString. * keyboard.c (make_lispy_event): Controlify here. Mon May 17 19:29:17 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * xdisp.c (redisplay_window): Make the scrollbar reflect the extent of the visible region, not the whole buffer. * xfaces.c (free_frame_faces): Don't free the resources from the first two faces. * lisp.h (malloc, realloc): Declare these to return void *, to avoid conflicts with ANSI header files. * sysdep.c (reset_sys_modes): Test the return value of EMACS_SET_TTY properly. * systty.h (EMACS_GET_TTY, EMACS_SET_TTY): Document the return values. Sun May 16 18:36:32 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * config.h.in (STDC_HEADERS, TIME_WITH_SYS_TIME, CRAY_STACKSEG_END, STACK_DIRECTION): Add #undef clauses for these, since otherwise the autoconf tests in configure.in won't do us much good. Sun May 16 09:41:12 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c (overlays_at): New arg EXTEND. (Foverlays_at, Fnext_overlay_change): Pass 1. * xfaces.c (compute_char_face): Pass 0. Try first with small overlay_vec, then use a big enough one. * lread.c (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var. Set up Qcurrent_load_list. (readevalloop): Specbind Qcurrent_load_list instead of ad-hoc saving. (build_load_history): Do nothing when loading pure files. * xterm.c (dumpglyphs): Create a temporary merged gc when cursor falls on char with non-default face. * xterm.h (x_display): New field cursor_foreground_pixel. * xfns.c (x_set_cursor_color): Set cursor_foreground_pixel. * casefiddle.c (casify_region): Remove mistaken arg to record_change. Sat May 15 16:46:05 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * xfaces.c (Fset_face_attribute_internal): Jolt redisplay, so it knows something has changed. * xfaces.c (unload_color): Don't try to unload the standard black or white pixel. More changes from David Mackenzie. * ymakefile (emacs): No need to edit srcdir into a lisp file and then load it; we can just take advantage of the PATH_DUMPLOADSEARCH. (crt0.o): Remember that crt0.c is in ${srcdir}. Install David Mackenzie's patches to make ${srcdir} work. * Makefile.in (srcdir, VPATH): Get this value from the top-level Makefile. (xmakefile): Use ${srcdir} to find the files from which we produce xmakefile. Edit the values for srcdir and VPATH into xmakefile. * ymakefile (srcdir, VPATH): New definitions for the Makefile to edit. (ALL_CFLAGS): Remove `-Is' and `-Im'; add `-I${srcdir}', and `-I.'. (emacs): Adjust dumping commands to deal with a separate source directory. (${etc}DOC): Pass `-d ${srcdir}' to make-docfile, to tell it where to find the source files. (prefix-args): Find the source code in ${srcdir}. * process.c (wait_reading_process_input): If we're running Solaris, it's not necessary to check if we should redeliver SIGIO, according to David Mackenzie. * s/sol2.h: #include "usg5-4.h", and #define const. * systime.h: Borrow CPP sequence from getdate.y to include the proper combination of and . Sat May 15 13:12:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.h (struct window): New slot region_showing. * xdisp.c (mark_window_display_accurate): Set region_showing fields. (redisplay_window): Update region_showing field. (display_text_line): Set region_showing to t if will show one. * xselect.c (Fx_selection_exists_p): Handle nil, t as SELECTION arg. Don't die if SELECTION is not recognized. * dispnew.c (direct_output_forward_char): Just give up if region is being highlighted. * xdisp.c (redisplay, redisplay_window): Don't use the cursor-motion special-case code if the region is or was highlighted. * xfaces.c (compute_char_face): New args REGION_BEG, REGION_END. Don't sort if noverlays is 0 or 1. * dispnew.c (direct_output_for_insert): Pass those args. * xdisp.c (display_text_line): Pass those args, describing the region if the mark is transient and active. Fri May 14 18:54:54 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * buffer.c (Fmove_overlay): If the overlay is in no buffer and the BUFFER argument has been omitted, put it in the current buffer, for symmetry with move-marker. * buffer.c (Fdelete_overlay): Make the overlay's markers point nowhere, not at 1. Do this after calling redisplay_region, so that code knows what section has changed. Fri May 14 11:49:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xdisp.c (display_menu_bar): Update FRAME_MENU_BAR_ITEMS here. * keyboard.c (command_loop_1): Don't do it here. * keymap.c (access_keymap): Handle any length vector. (store_in_keymap): Likewise. (Fcopy_keymap): Likewise. Fri May 14 11:30:40 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * buffer.c (Foverlay_start, Foverlay_end, Foverlay_buffer, Foverlay_properties): Functions moved here from subr.el. Thu May 13 15:30:59 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * xfaces.c (compute_char_face): When merging the overlays, traverse sortvec, not overlay_vec; the latter isn't the one we sorted. * xterm.c (dumpglyphs): Give the cursor higher priority than the face specified by the glyph under it. * xterm.c (dumpglyphs): Move the underline up a row. I dislike the way X addresses pixels. Quickdraw is much nicer. * xfaces.c (intern_face): If the face has a GC, but it's not the default or modeline face, abort. Nothing but those two faces should have a GC *and* be passed to intern_face. (compute_char_face, compute_glyph_face): After copying the frame's default face into face, to use as a base case for calculation, set the `gc' member to zero; that way we don't have things lying around that look like display faces but aren't. * xfaces.c (intern_frame_face): When copying the new face into the frame's face array, remember that the number of bytes to copy is sizeof (*new_face), not sizeof (new_face). * xfaces.c (compute_char_face): Assume that W is displaying the current buffer. Abort if it isn't. * lisp.h (Lisp_Overlay): New tag. (OVERLAYP): New predicate. (CHECK_OVERLAY): New type-checker. (Qoverlayp): New extern declaration. * buffer.c (Foverlayp): New function. (Qoverlayp): New atom. (overlays_at, recenter_overlay_lists): Abort if we encounter an invalid overlay. (syms_of_buffer): defsubr Soverlayp; initialize Qoverlayp. (Fdelete_overlay): Set the overlay's markers to point nowhere. Use CHECK_OVERLAY instead of signalling a special error. (Fmove_overlay, Foverlay_put): Use CHECK_OVERLAY instead of signalling a special error. (Foverlay_get): Use CHECK_OVERLAY. * fns.c (internal_equal): Define this for overlays. * buffer.h (OVERLAY_VALID): Define in terms of OVERLAYP. * print.c (print): Give overlays their own print syntax. * alloc.c (mark_object): Treat overlays like conses. * lisp.h (FLOATP): Define this appropriately when LISP_FLOAT_TYPE is not defined. * buffer.c (Foverlay_get): Return Qnil if the requested property is missing from the property list. The text property routines can now modify buffers other than the current one. * insdel.c (modify_region): New argument BUFFER. Select that buffer while we prepare for the modification, and switch back when we're done. * textprop.c (add_properties, remove_properties): Pass the buffer being modified as the first argument to modify_region. * editfns.c (Fsubst_char_in_region, Ftranslate_region): Pass the current_buffer as the first argument to modify_region. * casefiddle.c (casify_region): Same. * dispnew.c (direct_output_for_insert): Compute the face of the character we're inserting properly. * xterm.c (dumpglyphs): Pass the proper arguments to intern_face. * xterm.c (dumpglyphs): Don't increment left twice. * intervals.c (set_point): Check for point out of bounds before checking for an empty interval tree. * cmds.c (Fforward_char): Check proposed new position, and then set point, instead of setting point to a potentially invalid position. * lread.c, data.c: If STDC_HEADERS is #defined, include to get the extern declarations for atof. That's where it is in POSIX. Wed May 12 20:58:46 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * ymakefile (xfaces.o): Add window.h to the dependencies. * xfaces.c (intern_frame_face): Exchange order of arguments, to make callers correct. * xfaces.c (compute_char_face): Notice the next property change location correctly. * xfaces.c (face_name_id_number): Return 0 (the default face) if the name is undefined. * xfaces.c (Fset_face_attribute_internal): Do nothing unless FRAME is an X frame. * xdisp.c (copy_rope, copy_part_of_rope): Add face argument. (display_text_line): Initialize current_face to zero. Apply it to characters as we write them to the display matrix. (display_string): Pass the new argument to copy_rope. * xdisp.c (display_text_line): Handle the locations of face changes properly. * textprop.c (Fnext_single_property_change, Fprevious_single_property_change): Pass arguments to textget in the right order. * ymakefile (xfns.o): Remove duplication of buffer.h in dependencies. * ymakefile ($(OLDXMENU)): Remove extraneous call to `rm'. Wed May 12 10:44:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keymap.c (Faccessible_keymaps): Use whatever size the vector has. (Fwhere_is_internal): Likewise. (describe_vector): Likewise. (current_minor_maps): Call Findirect_function, so symbols can be used in place of actual maps. * xdisp.c (display_text_line): Use break; to exit loop at eol. Duplicate the short MAKE_GLYPH loop after the main loop. If no display table, do obey selective_display_ellipses. (copy_part_of_rope): Arg FROM is now Lisp_Object *. * xfaces.c: Do include window.h. (compute_char_face): Supply third arg of Fget_text_property. * keyboard.c (make_lispy_event): Don't set shift modifier for C-^. * callproc.c (child_setup): Omit duplicates from new env array. Mon May 10 16:50:29 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the filesystem being ro, since Solaris 2.1 doesn't. (file-writable-p): Call ro_fsys. * s/sol2.h (SOLARIS_BROKEN_ACCESS): Define this. * systime.h: Use the strategy from getdate.y to include the proper combination of and . * xfns.c (Fx_create_frame): Use an XLFD name for the default font, instead of "9x15" or whatever it was. * xdisp.c (display_text_line): Make face-handling code conditional on HAVE_X_WINDOWS macro. Perhaps this isn't the best approach, but it'll do for now. * xdisp.c (display_text_line): We can't use the FRAME_DEFAULT_FACE macro here; that's x-specific. Just don't pass the second argument. * xfaces.c (compute_glyph_face): Remove the BASIC_FACE argument; use F's default face. Sun May 9 16:10:08 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * xfaces.c (Fmake_face_internal): Do nothing for non-X frames. * dispextern.h (struct face): Add cached_index member. * xfaces.c (get_cached_face): Use it to avoid unnecessary searches of face_vector. * xfaces.c (intern_face): Renamed from get_display_face. * xfns.c (x_make_gc): After building the GC's for the frame, call init_frame_faces to set up the first two faces. * xfaces.c (init_frame_faces): Don't just try to copy the default and mode line faces from some other random frame; instead, consult the normal_gc and reverse_gc members of the frame, and build the faces based on their parameters. Adjust the face computation functions to return frame face ID's, not pointers to display faces; since we call these functions during display construction, we don't want the display faces yet. * xfaces.c (intern_frame_face): New function. (compute_char_face, compute_glyph_face): Apply intern_frame_face to the computed face, and return the frame face's ID, instead of calling intern_face and returning a pointer to a display frame. * xfaces.c: Describe the facial data structures. It took me a while to figure them out; perhaps this will save someone else the trouble. Arrange to tell redisplay about changes in overlays. * xdisp.c (redisplay_region): New function. * buffer.c (Fmove_overlay): Call redisplay_region on the areas the overlay has enclosed or left. (Fdelete_overlay): Call redisplay_region on the area the overlay used to occupy. (Foverlay_put): Call redisplay_region on the area the overlay now occupies; we may have put a face property on it. * buffer.c (Fmove_overlay): Doc fix. * xdisp.c (redisplay): If we're doing a thorough redisplay (all windows on all frames involved), go ahead and flush the GC cache - call clear_face_vector. * xdisp.c (display_text_line): Apply faces to characters according to overlays and text properties; use compute_char_face and compute_glyph_face to figure out what face to use, and where a new face starts. * xterm.c (dumpglyphs): Use the upper bits of the glyphs to decide which frame face to use. Call GLYPH_FOLLOW_ALIASES to make sure we're implementing the glyph table properly. If we're not using the default or mode line face, call intern_face to find a display face for the frame face selected by the glyph code. Implement underlining. Remove the `font' argument; we have to derive this from the frame and face anyway. Change all callers. * disptab.h (GLYPH_FOLLOW_ALIASES): New macro. * xterm.c (x_destroy_window): Call free_frame_faces. The GNU coding standards specify that CFLAGS should be left for users to set. * ymakefile (ALL_CFLAGS): Set this to the long string of compilation switches, not CFLAGS. Changed all uses. (CFLAGS): Make this default to just -g. (.c.o): Define new default rule, to make sure that the right flags get to the compilations. Sun May 9 13:47:33 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_char): Exit kbd macro if Vexecuting_macro is t. * pwd.h: File deleted. Sat May 8 23:18:50 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * s/sunos4shr.h: Apply changes from David J. Mackenzie; this isn't used by any configuration right now, but he's trying to make it work. #include "sunos4-1.h" instead of "bsd4-2.h". (O_NDELAY): Don't define this. (SYSTEM_MALLOC): Don't define this, either. (LD_SWITCH_SYSTEM): Remove the definition for this. * Makefile.in (DEFS): Remove this; we have configure build a config.h file directly, instead of having lots of -D flags. * Makefile.in (CFLAGS): Don't make this carry DEFS from the configure script; the coding standards say that CFLAGS should be left for the user to tweak. Sat May 8 10:54:18 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (do_mouse_tracking): Now static. * xmenu.c (Fx_popup_menu): Add a vector of prefix keys for the panes. (keymap_panes): Allocate that vector. (single_keymap_panes): Fill in that vector. (xmenu_show): Return a list of events, not just one event. * keyboard.c (read_char_menu_prompt): Expect Fx_popup_menu to return a list of events. Don't lose any of them. * xfns.c (Fx_get_mouse_event, Fx_mouse_events): Code deleted. * window.c (Vmouse_event): Var deleted. (syms_of_window): Don't make it a Lisp var. * keyboard.c (read_avail_input, Fset_input_mode): Make meta_key a three-value variable to support 8-bit input. Fri May 7 00:06:50 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * ymakefile [__GNUC__ && __GNUC__ > 1] (LIB_GCC): Set this even if LINKER is #defined. * ymakefile ($(OLDXMENU)): Remove the link before we re-create it; not all versions of ln have the `-f' flag. Use the LN_S variable, inherited from src/Makefile. * Makefile.in (LN_S): New variable, edited by top Makefile. (SUBMAKEFILE): New variable, containing all flags to pass to recursive makes. * config.h.in: Adjust this for use by autoconf's AC_CONFIG_HEADER, instead of AC_OUTPUT. * xfaces.c (get_display_face): Use face_eql instead of writing it out. Thu May 6 15:04:21 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * keymap.c (Fwhere_is_internal): If FIRSTONLY is non-nil, avoid returning a non-ascii key sequence unless FIRSTONLY is the symbol `non-ascii'. * config.h.in: Remove mention of GLYPH datatype; that shouldn't be a user option. * lisp.h (GLYPH, MAKE_GLYPH, GLYPH_CHAR, GLYPH_FACE): New macros. Thu May 6 13:04:32 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (x_get_arg): Call Fintern, not intern. * systime.h [SCO]: Include time.h. * s/sco4.h: New file. * ymakefile (LIBXMENU): Delete -loldX. * emacs.c (main): Handle -display like -d. Wed May 5 19:56:25 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * s/template.h: Explain the relative significance of the SIGIO and INTERRUPT_INPUT macros. * ymakefile (buffer.o, insdel.o): Note that these files also depend on blockinput.h. * blockinput.h (UNBLOCK_INPUT): We cannot assume that SIGIO is defined everywhere this file is #included; merge the two definitions for defined (SIGIO) and ! defined (SIGIO) into one, which calls reinvoke_input_signal if interrupt_input_pending is set. * keyboard.c (reinvoke_input_signal): New function. Tue May 4 18:13:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (Fdisplay_buffer): Add space to prompt. Tue May 4 08:58:06 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * keyboard.c (syms_of_keyboard): Doc fix for extra-keyboard-modifiers. * lisp.h (CHAR_ALT, CHAR_SUPER, CHAR_HYPER, CHAR_SHIFT, CHAR_CTL, CHAR_META): Shift these all up one bit, back to where they were. Sun May 2 21:07:12 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * keymap.c (Fdefine_prefix_command): Doc fix. * ymakefile (C_DEBUG_SWITCH): Undo April 10 change. Sat May 1 09:20:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (Fsuspend_emacs): Doc fix. Fri Apr 30 13:28:13 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * data.c (Ffset): Refuse to set the function value of t or nil. Thu Apr 29 12:00:35 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) Implement extra_keyboard_modifiers properly. * keyboard.c (syms_of_keyboard): Doc fix for extra-keyboard-modifiers; use the same modifier bits as we do for characters. (read_char): Apply all the modifiers in extra_keyboard_modifiers to the input characters, so you can get hyper, super, and the rest of the gang. * xterm.c (x_emacs_to_x_modifiers): New function. (x_convert_modifiers): Renamed to x_x_to_emacs_modifiers, for consistency. Callers changed. (XTread_socket): Apply x_emacs_to_x_modifiers to extra_keyboard_modifiers before setting the state member of the event; this will get all the modifiers on ASCII characters. * xterm.c (x_text_icon): Don't call XSetIconName; it should be unnecessary, and perhaps it's killing the icon pixmap. * lisp.h (CHAR_ALT, CHAR_SUPER, CHAR_HYPER): New constants, in case we need them. * termhooks.h (alt_modifier, super_modifier, hyper_modifier, shift_modifier, ctrl_modifier, meta_modifier): Define these in terms of the CHAR_mumble macros, to avoid having the same thing defined in two places. * keyboard.c (kbd_buffer_get_event): Don't generate switch-frame events if they'd only switch to the frame already selected. This avoids lots of extra switch-frame events when using a separate minibuffer. Thu Apr 29 09:11:42 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (Fthis_command_keys): Doc fix. * process.c (wait_reading_process_input): Move the status_notify call before the set_waiting_for_input call. * fileio.c (Fexpand_file_name): Undo last change--too risky for now. * data.c (Fdefine_function): New function (same code as Fdefalias). Wed Apr 28 17:08:18 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * eval.c (do_autoload): Fixed the bug in the autoload-saving code. Wed Apr 28 16:36:54 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * keyboard.c (Fcurrent_input_mode): New function. Tue Apr 27 21:59:59 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * eval.c (un_autoload): Don't try to save old autoload forms when we load something in. Something about the code now conditioned out by UNLOAD was screwing up ordinary autoloads, notably of picture.el. When I figure out what, I'll fix and re-enable this code. Tue Apr 27 12:03:34 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * buffer.c (syms_of_buffer): Doc fix for buffer-display-table. * systime.h: Doc fix. (EMACS_SET_USECS): Remember that a `usec' is a microsecond, not a millisecond. What's three orders of magnitude between friends? * dispnew.c (Fsit_for, Fsleep_for): Remember to multiply the `milliseconds' argument by 1000 to get microseconds. Mon Apr 26 21:54:00 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * fileio.c (Fexpand_file_name): Don't remove trailing / from NEWDIR if just "/". Mon Apr 26 13:29:53 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * m/ibmps2-aix.h, m/ibmrs6000.h, m/ibmrt-aix.h, m/mips.h, m/sps7.h, s/hpux.h, s/usg5-4.h (HAVE_DUP2): Removed; derived by configure script. * s/hpux.h, s/irix3-3.h, s/aix3-1.h (HAVE_GETHOSTNAME): Removed; derived by configure script. Arrange for Fy_or_n_p to put off switch-frame events. * lread.c (read_filtered_char): New function, which contains the code which used to be in Fread_char, Fread_event, and Fread_char_exclusive; there was a lot of common code. (Fread_char, Fread_event, Fread_char_exclusive): Rewrite in terms of read_filtered_char. * lisp.h (read_filtered_char): Declare this extern here. * fns.c (Fy_or_n_p): Call read_filtered_char, arranging to delay switch-frame events. * keyboard.c (read_key_sequence): Let the `modifiers' variable in the code which deals with KEY being unbound be an int, not a Lisp_Object. * config.h.in (getenv): Don't test THIS_IS_YMAKEFILE to see if we should exclude the getenv declaration; instead, test NOT_C_CODE. Per suggestion from Francesco Potorti`. * ymakefile (NOT_C_CODE): Define this; it's true, and useful. * dispnew.c (Fsleep_for, Fsit_for): Allow SECONDS to be a floating point value. Mon Apr 26 05:15:13 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * sysdep.c (read_pending_input): Fix the garbaged-modifiers bug under System Vs previous to r4. Sun Apr 25 19:00:03 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * systty.h (EMACS_GET_TTY, EMACS_SET_TTY): Move these into functions in sysdep.c. * sysdep.c (emacs_get_tty, emacs_set_tty): Here they are. * sysdep.c (emacs_set_tty): Call tcsetattr over and over again until it does all of what we ask it to, or returns an error. * search.c (Freplace_match): Arrange for markers sitting at the beginning or end of the original text to float to the corresponding position in the replacement text. Sun Apr 25 06:15:18 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * window.c (Fset-window-buffer): Set horizontal-scrolling on a window to zero when we connect it to a new buffer. * buffer.c: Doc fix. Sat Apr 24 18:19:50 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) Make the modifier manipulation functions more robust. The old way caused a bug once, and probably would again. * termhooks.h (alt_modifier, super_modifier, hyper_modifier, shift_modifier, ctrl_modifier, meta_modifier): Shift these all down one bit in value, to avoid sign extension problems. * lisp.h (CHAR_META, CHAR_CTL, CHAR_SHIFT): Fix these definitions too. * keyboard.c (lispy_modifier_list): Ignore modifier bits beyond what our table of modifier names can handle. (apply_modifiers): Don't abort if you see extra modifier bits, just remove them. Fri Apr 23 03:40:03 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * data.c (Fdefine_function): Changed name back to Fdefalias, so we get things in a known-good state. * buffer.h (BUF_NARROWED, NARROWED): New macros to test whether a region restriction has narrowed the buffer. Sat Apr 17 06:45:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * systime.h: Comment fixes. * data.c (Fdefine_function): New function. * lisp.h (LOADHIST_ATTACH): New macro. (Vcurrent_load_list, Vload_history): Vars declared. * eval.c: (defun, defmacro, defvar, defconst): Attach symbol argument to the list of globals for the input source. (do_autoload): Save the old autoloads, in case we ever unload. * fns.c (provide, require): Put appropriately-marked conses in the current-globals list. * lread.c (readevalloop): New argument is the source file name (or nil if none). All calls changed. Do the two-step necessary to call build_load_history with the correct current-globals list for the current recursion. (build_load_history): New function. (eval_region, eval_buffer): Call readevalloop with new arg. (load_history): New variable. Fri Apr 16 19:36:29 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * lread.c (readevalloop): New argument is the source file name (or nil if none). All calls changed. Do the two-step necessary to call build_load_history with the correct current-globals list for the current recursion. (build_load_history): New function. (Feval_region, Feval_buffer): Call readevalloop with new arg. (Vload_history): New variable. * fns.c (Fprovide, Frequire): Put appropriately-marked conses in the current-globals list. * eval.c (Fdefun, Fdefmacro, Fdefvar, Fdefconst): Attach symbol argument to the list of globals for the input source. (do_autoload): Save the old autoloads, in case we ever unload. * data.c (Fdefine_function): New function. Fri Apr 16 17:05:30 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * fileio.c (Fmake_symbolic_link): If a file already exists under the link's filename, delete the file which the link would replace, not the file the link would point at. * config.h.in (volatile): Don't define this to be the empty string if some file has #defined HAVE_VOLATILE. * emacs.c (SEPCHAR): Instead of defining this to be ',' on VMS and ':' elsewhere, just have it default to ':' if not #defined, and #define it to be ',' in s/vms.h; OS/2 will need it to be ';'. * s/vms.h (SEPCHAR): #define this to be ','. * s/template.h (SEPCHAR): Mention this. Tue Apr 13 00:36:38 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * s/vms.h (xfree): #define this to emacs_xfree, to avoid case conflict with XFree; on VMS, external symbols are case-insensitive. * s/usg5-4.h (HAVE_GETTIMEOFDAY): Deleted; ../configure figures that out now. Changes for Emacs 19 from Thorsten Ohl : * s/mach2.h: copied from the Emacs 18.59 distribution. Don't define NO_REMAP, define START_FILES as `pre-crt0.o' instead. Define LIB_MATH as `-lm', to override the default `-lm -lc' (there is no libc on the NeXT). * ymakefile (STARTFILES): Allow config.h to set this value even if ORDINARY_LINK is defined. * unexnext.c: Fix subdirectories for the machine dependent include files for NeXTStep 3.0; #include and instead of and . (getsectbyname): Remove prototype for this; the system #include files take care of that. (malloc_cookie): New variable. (unexec_doit): Set malloc_cookie to the result returned by malloc_freezedry. * emacs.c (main): Declare malloc_cookie to be extern, so that we can get the value set when we dumped and pass it to malloc_jumpstart. * systime.h: The NeXT has a timezone function. Mon Apr 12 21:13:58 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * ymakefile ($(OLDXMENU)): Remove $(OLDXMENU) before trying to link in a new version. * lisp.h (Qrange_error, Qdomain_error, Qsingularity_error, Qoverflow_error, Qunderflow_error): Add extern to these declarations. Mon Apr 12 20:38:39 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfaces.c: Don't include Xmu/Drawing.h. Sat Apr 10 04:27:26 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Makefile.in (xmakefile): Recognize the -O option with a numeric optimization level. * ymakefile (C_DEBUG_SWITCH): If we're using version 2 of GCC or higher, use -O99 instead of plain -O. Fri Apr 9 02:18:49 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * keyboard.c (command_loop_1): Rebuild menu bar if update_mode_lines is set. long_to_cons and cons_to_long are generally useful things; they're needed whether or not X is defined. * xselect.c (long_to_cons, cons_to_long): Moved from here... * data.c (long_to_cons, cons_to_long): ... to here. * lisp.h (long_to_cons, cons_to_long): Add extern declaration. * xmenu.c (Qmenu_enable): Definition moved... (syms_of_xmenu): ... along with initialization ... * keyboard.c (Qmenu_enable): ... to here ... (syms_of_keyboard): ... and here. * keyboard.c (kbd_buffer_get_event): If we get a selection clear or selection request event, but we were compiled without the window-system-specific code to handle it, abort. Don't try to call a function which doesn't exist. * keyboard.c (make_lispy_event): In the code which processes mouse clicks, declare f to be a FRAME_PTR, not a struct frame *; this works when MULTI_FRAME is not #defined. * xfaces.c (sort_overlays): Define this to be static, as declared. * callproc.c (relocate_fd): Make messages string literals, not initialized arrays. * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare these extern, not static. (!) * alloc.c (__malloc_hook, old_malloc_hook, __realloc_hook, old_realloc_hook): Declare that the functions these point to return void *, not void. Adjust for autoconf merger. * config.h.in: Add extra line to top, in case autoconf gets fixed and decides not to add Makefile-style comments to the top of the files it generates which we are forced to lop off. Indicate that the boolean macros here get their definitions via the DEFS Makefile variable. Adjust the operating system and machine #includes to use autoload's @cookies@. (RETSIGTYPE): Give this a default value. (SIGTYPE): Set this from RETSIGTYPE. (LD_SWITCH_X_SITE, C_SWITCH_X_SITE): Get values via @cookies@. * Makefile.in (DEFS): Renamed from CONFIG_CFLAGS. (xmakefile): Pass CFLAGS to ${CPP}. * buffer.c (Fmake_overlay, Fmove_overlay): New optional BUFFER arguments. (recenter_overlay_lists): New argument BUF, to use instead of the current buffer. (Foverlay_recenter): Pass the appropriate arguments to recenter_overlay_lists. * buffer.c (Fdelete_overlay): Don't assume that overlay is in the current buffer. Don't forget to declare the argument a Lisp_Object. * dispnew.c (getenv): Extern declaration deleted; this is done in config.h. * Makefile.in (tagsfiles): Remove external-lisp from this list of files; we're not distributing it, so the normal build process shouldn't depend on it. * dispnew.c (init_display): Compare the return value of getenv to zero before setting display_arg, instead of just using the pointer as a truth value. Thu Apr 8 02:53:42 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xdisp.c (message, message1): If noninteractive and cursor_in_echo_area, don't print a newline at end of message. * fns.c (Fy_or_n_p): Echo the answer just once, at exit. * keyboard.c (echo_dash): Do nothing if echoptr is 0. * buffer.c (Fkill_all_local_variables): Store each var's current value in the buffer's alist entry, before reverting to the default value. Wed Apr 7 19:53:29 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * keyboard.c (apply_modifiers): Fix typo in sanity check. * keyboard.c (interrupt_input_blocked, interrupt_input_pending): Remove `extern' keywords - these are the definitions. Wed Apr 7 16:04:23 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * blockinput.h (UNBLOCK_INPUT): Fix typo. (interrupt_input_blocked): Make this signed int. * search.c (search_buffer): Fix typo in previous change. * insdel.c, buffer.c: Include blockinput.h. * xterm.c: Fix typo in comment delimiter. Wed Apr 7 10:42:40 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * m/imbrs6000.h: If we're using GCC, define ORDINARY_LINK instead of defining LINKER to use cc. * s/aix3-1.h (LINKER): Don't use cc for linking command if we're using GCC. * s/aix3-2.h (SYSTEM_MALLOC): Undefine this. * xterm.c (updating_frame): Declare this extern instead of static, so it's the same variable as the updating_frame in term.c. (XTupdate_begin, XTupdate_end): Don't bother to set updating_frame; the term.c functions take care of that for us. Mon Apr 5 17:00:32 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * s/vms.h (EXEC_SUFFIXES): Add definition for this. Wed Mar 31 02:13:22 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * xfaces.c: Doc fixes. Put interrupt input blocking in a separate file from xterm.h. This isn't specific to X, and it allows us to avoid #including xterm.h in files that don't really have anything to do with X. * blockinput.h: New file. * xterm.h (BLOCK_INPUT, UNBLOCK_INPUT, TOTALLY_UNBLOCK_INPUT, UNBLOCK_INPUT_RESIGNAL): These are now in blockinput.h. (x_input_blocked, x_pending_input): Deleted; there are analogs in blockinput.h called interrupt_input_blocked and interrupt_input_pending. * keyboard.c (interrupt_input_blocked, interrupt_input_pending): New variables, used by the macros in blockinput.h. * xterm.c: #include blockinput.h. (x_input_blocked, x_pending_input): Deleted. (XTread_socket): Test and set interrupt_input_blocked and interrupt_input_pending instead of the old variables. * alloc.c, xfaces.c, xfns.c, xmenu.c, xselect.c, keymap.c: #include blockinput.h. * eval.c: #include blockinput.h instead of xterm.h. * keyboard.c: #include blockinput.h. (input_poll_signal): Just test interrupt_input_blocked, instead of testing HAVE_X_WINDOWS and x_input_blocked. Block the processing of interrupt input while we're manipulating the malloc heap. * alloc.c: (xfree): New function, to make it easy to free things safely. (xmalloc, xrealloc): Block X input while doing the deed. (VALIDATE_LISP_STORAGE, gc_sweep, compact_strings): Use xfree instead of free. (uninterrupt_malloc): New function, to install input-blocking hooks into the GNU malloc routines. * emacs.c [not SYSTEM_MALLOC] (main): Call uninterrupt_malloc on startup. * alloc.c: (make_interval, make_float, Fcons, Fmake_vector, Fmake_symbol, Fmake_marker, make_uninit_string, Fgarbage_collect): Use xmalloc instead of malloc; don't bother to check if out of memory here. (Fgarbage_collect): Call xrealloc instead of realloc. * buffer.c: Use xmalloc and xfree instead of malloc and free; don't bother to check if out of memory here. (Fget_buffer_create): Put BLOCK_INPUT/UNBLOCK_INPUT pair around calls to ralloc routines. * insdel.c: Same. * lisp.h (xfree): New extern declaration. * xfaces.c (xfree): Don't #define this to be free; use the definition in alloc.c. * dispnew.c, doc.c, doprnt.c, fileio.c, lread.c, term.c, xfns.c, xmenu.c, xterm.c: Use xfree instead of free. * hftctl.c: Use xfree and xmalloc instead of free and malloc. * keymap.c (current_minor_maps): BLOCK_INPUT while calling realloc and malloc. * search.c: Since the regexp routines can malloc, BLOCK_INPUT while runing them. #include blockinput.h. * sysdep.c: #include blockinput.h. Call xfree and xmalloc instead of free and malloc. BLOCK_INPUT around routines which we know will call malloc. ymakefile (keyboard.o, keymap.o, search.o, sysdep.o, xfaces.o, xfns.o, xmenu.o, xterm.o, xselect.o, alloc.o, eval.o): Note that these depend on blockinput.h. * keyboard.c (parse_modifiers, apply_modifiers): Make sure we're not trying to create modifier masks using integers which are unrepresentable as lisp values. Tue Mar 30 16:13:09 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) New macros NULL_DEVICE and EXEC_SUFFIXES, to give the name of the equivalent of /dev/null, and the suffixes used by executable files. This is simple, and helps people porting Emacs to other operating systems. * process.h (NULL_DEVICE): Give this a default value. * process.c (Fstart_process): Pass EXEC_SUFFIXES to openp. (Fprocess_send_eof): Use NULL_DEVICE instead of "/dev/null". * callproc.c (Fcall_process): Pass EXEC_SUFFIXES to openp. Use NULL_DEVICE instead of "/dev/null". * s/vms.h (NULL_DEVICE): #define this. Rename int-to-string to number-to-string, since it can handle floating-point as well as integer arguments. subr.el defines the former as an alias for the latter. * data.c (Fnumber_to_string): Renamed from Fint_to_string. (wrong_type_argument): Adjust caller. (syms_of_data): Adjust defsubr. * fns.c (concat): Adjust caller. * lisp.h (Fnumber_to_string): Adjust extern declaration. * mocklisp.c (Finsert_string): Adjust caller. * process.c (status_message): Adjust caller. Sun Mar 28 02:01:22 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * systty.h [NO_PTY_H]: Don't include pty.h. * m/delta88k.h [USG5_4]: Alternate defining of LIBS_SYSTEM, LIBX11_SYSTEM, HAVE_RANDOM, BSTRING. (NO_PTY_H): Defined. * fileio.c (Fwrite_region): Don't fail to set visit_file. * keyboard.c (command_loop_1): Clear force_start of selected_window after reading each key sequence. (read_char): Clear Vquit_flag when we return C-g for it. * fileio.c (Fexpand_file_name): Default DEFALT at beginning, before expanding it. But avoid unneeded or infinite recursive expand. Fri Mar 26 03:12:09 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * editfns.c (Fchar_equal): Don't ignore high bits of character. * fileio.c (Fwrite_region): Set visit_file after expanding file arg. Also expand VISIT arg if specified. * frame.c (make_frame): Init face_alist field. Thu Mar 25 18:26:57 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * xselect.c (SELECTION_QUANTUM): Don't use XMaxRequestSize on R3; access the display structure directly. Thu Mar 25 01:16:12 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * ymakefile (xfns.o): Depend on buffer.h. * buffer.h (struct buffer): Field `fieldlist' deleted. * search.c (Freplace_match): Clean up criterion about converting case. If old text has any capitalized words, capitalize new text. * xfaces.c: New file. * ymakefile (XOBJ): Add xfaces.o. (xfaces.o): New target. * emacs.c (main): Call syms_of_xfaces. * buffer.h (OVERLAY_START, OVERLAY_END, OVERLAY_VALID): New macros. (OVERLAY_POSITION): Likewise. (searchbuf): Decl deleted--doesn't belong here. Delete include of regex.h for VMS. * dired.c (searchbuf): Declare here. * frame.h (struct frame): New field face_alist. * alloc.c (mark_object): Mark face_alist of a frame. * ymakefile (xselect.o): Depend on dispextern.h. * xterm.h (FRAME_FACES, FRAME_N_FACES, FRAME_DEFAULT_FACE) (FRAME_MODE_LINE_FACE): New macros. (struct x_display): New fields faces, n_faces. * dispextern.h (struct face): New fields pixmap_h, pixmap_w. Field `font' is now a pointer. * fns.c (Fy_or_n_p): Ensure cursor_in_echo_area = 0 when quit. Wed Mar 24 21:10:31 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * dispnew.c (getenv): Add extern declaration. * ymakefile (really-oldXMenu): Pass C_SWITCH_SITE and C_SWITCH_SYSTEM to the inferior make as separate flags, instead of passing just C_SWITCH_SITE as CFLAGS. * keymap.c (Fkeymapp): Doc fix. * xterm.h (x_focus_frame): Add extern keyword to declaration. * xterm.c [VMS]: Don't #include and . * xfns.c [VMS]: Get the gray_bits from [.bitmaps]gray.xbm. * process.c [VMS] (DCL_PROMPT): Remove hack. (WIFSTOPPED, WIFSIGNALED, WIFEXITED, XRETCODE, WSTOPSIG, WCOREDUMP, WTERMSIG): New dummy definitions. (deactivate_process): Add missing semicolon. * dispnew.c (init_display): Get display name from environment properly on VMS as well as Unix. Wed Mar 24 02:56:56 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * buffer.c (init_buffer_once, reset_buffer): Delete last vestige of fieldlist slot. (Fregion_fields): Finally deleted. * keymap.c (push_key_description): Ignore bits above meta_modifier. Tue Mar 23 15:58:18 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * buffer.c (overlays_at, recenter_overlay_lists): New functions. (Fmake_overlay, Fdelete_overlay, Foverlay_get, Foverlay_put): Likewise. (Fmove_overlay, Foverlays_at, Fnext_overlay_change): Likewise. (Foverlay_lists, Foverlay_recenter): Likewise. * buffer.h (struct buffer): New fields overlay_center, overlays_before, overlays_after. Tue Mar 23 00:54:06 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * config.h.in (HAVE_XFREE386): New flag, set by configure script. If it's set, #define LIBX11_SYSTEM and HAVE_RANDOM as appropriate for XFree386. * sysdep.c (random, srandom): Don't define these if HAVE_RANDOM is #defined. * config.h.in (C_SWITCH_X_SITE, LD_SWITCH_X_SITE): New flags. * ymakefile (C_SWITCH_X_SITE, LD_SWITCH_X_SITE): Provide default values. Include C_SWITCH_X_SITE in CFLAGS, include LD_SWITCH_X_SITE in LIBX, and pass C_SWITCH_X_SITE to the make which builds the X Menu library. Mon Mar 22 23:56:55 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * xfns.c (Fx_parse_geometry): Renamed from Fx_geometry. (Fx_color_defined_p): Renamed from Fx_defined_color. (syms_of_xfns): Adjusted. Mon Mar 22 14:50:00 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * indent.c (current_column, Findent_to, position_indentation): (Fmove_to_column, compute_motion): Allow tab_width up to 1000. * xdisp.c (display_string, display_text_line): Allow tab_width up to 1000. * keyboard.c (Fsuspend_emacs): Change suspend-hooks back to suspend-hook and make it a normal hook. * s/dgux.h: Decide automatically whether to use COFF or ELF. Sun Mar 21 15:08:54 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fns.c (Fy_or_n_p): Handle `recenter' response type. * s/dgux.h (HAVE_TERMIO, SIGNALS_VIA_CHARACTERS): Defined. Sun Mar 21 01:50:01 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * frame.c (Fhandle_switch_frame): Renamed from Fselect_frame. Doc changed in anticipation of new purpose. (Fselect_frame): Just call Fhandle_switch_frame for now. Sun Mar 21 01:36:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xdisp.c (decode_mode_spec): Handle `%l'. (display_count_lines): New function. (redisplay_window): Update base_line_number and base_line_pos fields. Always update mode line if it's an integer. * window.h (struct window): New fields base_line_number and base_line_pos. * window.c (Fselect_window): Use Fhandle_switch_frame. (Fset_window_configuration): Likewise. Sat Mar 20 23:53:29 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) Use the `visiblity' parameter to determine the initial state of the frame, instead of the `iconic-startup' and `suppress-initial-map' parameters. * xfns.c (x_icon): Test the Qvisibility parameter against Qicon, instead of the Qiconic_startup against Qt. (x_create_frame): Test Qvisibility against Qnil and Qicon, instead of testing Qsuppress_initial_map and Qvisibility. (Qicon): New symbol. (Qiconic_startup, Qsuppress_initial_map): Removed. (syms_of_xfns): Adjusted appropriately. * xfns.c (x_set_visibility): Instead of interpreting only Qt as `make the frame visible' and everything else as `iconify the frame', interpret Qicon as `iconify the frame' and everything else as `make the frame visible.' * xfns.c (x_get_arg): When the type of the resource is `symbol', return `true' and `on' as Qt, and `false' and `off' as Qnil. Sat Mar 20 23:25:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacs.c (init_cmdargs): Fix simple bug in previous change. Sat Mar 20 13:56:25 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * dispnew.c (Fsleep_for): Make this take two arguments SECONDS and MILLISECONDS, which add, rather than a second argument which says "treat the first argument as milliseconds." (Fsit_for): Same thing. (Fsleep_for_milliseconds): Deleted; this can be done with Fsleep_for. * process.c (wait_reading_process_input): Doc fix. * systime.h (EMACS_HAS_USECS): #define this if HAVE_TIMEVAL is #defined. * dispnew.c (sit_for): Doc fix. * sysdep.c (reset_sys_modes): Fix usage of EMACS_SET_TTY. * callproc.c (child_setup): Make sure that in, out, and err are not less than three. (relocate_fd): New function. * xterm.c (x_term_init): If the X connection is already in file descriptor zero, don't dup it and close the old one. * s/hpux8.h, s/sunos4-1.h (OLDXMENU_OPTIONS): Define this, as in Emacs 18. * xfns.c (Fx_open_connection): If we have X11R5, use XrmSetDatabase to set the display's database. In older versions, just store the value into x_current_display->db. * xterm.h (HAVE_X11R5): Define this where appropriate. * frame.c (Fraise_frame, Flower_frame): Renamed from Fframe_to_front and Fframe_to_back. (syms_of_frame): Adjusted appropriately. * fileio.c (HAVE_FSYNC): Define, if appropriate. (Fwrite_region): Use HAVE_FSYNC. * s-aix3-2.h (HAVE_FSYNC): Define. * emacs.c (Finvocation_name): New function. (Vinvocation_name): New variable. (init_cmdargs): Set it. (syms_of_emacs): defsubr Finvocation_name, staticpro and initialize Vinvocation_name. * lisp.h (Vinvocation_name): New extern declaration. * xterm.c (invocation_name): Variable deleted; use Vinvocation_name now. (x_text_icon, x_term_init): Use Vinvocation_name now instead of invocation_name. (x_term_init): Don't initialize invocation_name. (syms_of_xterm): Don't initialize or staticpro invocation_name. * xfns.c (invocation_name): Remove extern declaration for this. [HAVE_X11] (Fx_get_resource): Use Vinvocation_name now instead of invocation_name. [not HAVE_X11] (Fx_get_default): Same. Sat Mar 20 04:20:21 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * xfns.c (Fx_display_color_p): Renamed from Fx_color_display_p. (syms_of_xfns): Use new name in defsubr. Fri Mar 19 00:27:27 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * Makefile.in (unlock, relock): New productions to assist with version control. Fri Mar 19 00:12:27 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * fileio.c (Fvisited_file_modtime): New function. (Fset_visited_file_modtime): Accept an argument specifying time value. If arg is nil, really use the filename handler. * xselect.c (cons_to_long, long_to_cons): No longer static. Thu Mar 18 17:39:35 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * frame.h (FOR_EACH_FRAME): Change the definition so that FRAME_VAR is a lisp object. * dispnew.c (WINDOW_CHANGE_SIGNAL, do_pending_window_change): Adjusted appropriately. * xdisp.c (redisplay): Adjusted appropriately. * dispnew.c (Fredraw_frame): Give this appropriate definitions for MULTI_FRAME and non-MULTI_FRAME configurations. (Fredraw_display): Give this a non-MULTI_FRAME-dependent definition. Thu Mar 18 04:22:47 1993 Richard Stallman (rms@geech.gnu.ai.mit.edu) * lisp.h (CHECK_LIVE_WINDOW): Use Qlive_window_p. * xfns.c (x_screen): Make this var file scope. (Fx_server_version): Use Fcons, not list3. Wed Mar 17 17:32:17 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * xterm.c (term_get_fkeys): Less klugey version of the last fix. * Makefile.in (versionclean): New production nukes binaries and DOC files, forcing a re-load, re-dump and re-makedoc. Wed Mar 17 16:39:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c: Doc fix. Wed Mar 17 15:06:43 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xterm.c (x_display_box_cursor, x_display_bar_cursor): Don't display the cursor on garbaged frames. Wed Mar 17 08:12:49 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * term.c (term_get_fkeys) Supply second args for all tgetstr calls. Wed Mar 17 02:58:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (Fprocess_send_eof): Make sure proc is running. * s/irix4-0.h (_getpty): Declare this, not _get_pty. Tue Mar 16 15:25:43 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (Fx_server_vendor, Fx_server_version, Fx_display_pixel_width) (Fx_display_pixel_height, Fx_display_mm_width, Fx_display_mm_height) (Fx_display_screens, Fx_display_planes, Fx_display_color_cells) (Fx_display_visual_class, Fx_display_backing_store) (Fx_display_save_under): New functions. (x_screen_count, Vx_vendor, x_release, x_screen_height_mm) (x_screen_width_mm, Vx_backing_store, x_save_under, Vx_screen_visual) (x_visual_strings): Vars deleted. (Fx_open_connection): Don't init those vars. (syms_of_xfns): Set up new functions. Don't set up those vars as Lisp vars. Nor x-screen-width and x-screen-height. Tue Mar 16 00:52:02 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * cmds.c (overwrite_binary_mode): Deleted; this implements the wrong feature. (Qoverwrite_mode_binary): New variable. (internal_self_insert): If current_buffer->overwrite_mode is `overwrite-mode-binary', do as overwrite_binary_mode used to. (syms_of_cmds): Remove defvar of overwrite_binary_mode; initialize Qoverwrite_mode_binary. * buffer.c (syms_of_buffer): Doc fix for overwrite_mode. * buffer.h (struct buffer): Doc fix. Rename `live-window-p' to `window-live-p', for consistency with `frame-live-p'. * window.c (Fwindow_live_p): Renamed from Flive_window_p. * lisp.h (CHECK_LIVE_WINDOW): Change to use Qwindow_live_p. (Qwindow_live_p): Extern declaration renamed fom Qlive_window_p. Tue Mar 16 00:21:38 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (xmenu_show): Do BLOCK_INPUT; unblock just before returning. * xterm.h [SIGIO] (UNBLOCK_INPUT): Resignal if x_pending_input. Mon Mar 15 15:15:42 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * frame.c (Fframe_height, Fframe_width): Fix doc strings to match those of the multi-frame versions in frame.el. Accept an optional argument FRAME, also for consistency. * floatfns.c (logb): Add extern declaration for this. * floatfns.c (Flogb): Under SYSV, implement this using frexp. Mon Mar 15 00:58:21 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ymakefile (dispnew.o): Depend on termhooks.h. * xmenu.c (list_of_items): Allow strings among the alist items; they make nonselectable lines. Sun Mar 14 15:55:32 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * dired.c (Fdirectory_files): Recompile MATCH (if specified) after expanding the file name and all; those might compile regexp of their own, and change searchbuf. * keyboard.h (internal_last_event_frame): This should be extern, dummy. * fns.c (Fy_or_n_p): Display the answer. Some VMS changes from Richard Levitte : * [VMS] systime.h: Include vmstime.h. VMS has the timezone variable and the tzname array. * s/vms.h: VMS does have select. mth$dmod is the same as Unix's drem. Use the time functions in vmstime.c. No need to rename the malloc routines if we're using GNU malloc. PURESIZE needs to be 330000. * vmstime.c, vmstime.h: New files. * systty.h: Don't try to initialize extern declarations under VAX C. * vmspaths.h (PATH_LOADSEARCH): Include EMACS_LIBRARY:[LOCAL-LISP] in PATH_LOADSEARCH. (PATH_EXEC): Use EMACS_LIBRARY:[LIB-SRC] instead of [ETC]. * sysdep.c [VMS] (init_sys_modes): Don't allocate process_ef. [VMS] (queue_kbd_input): Build events structure correctly. [VMS] (gethostname): New function. [VMS] (getwd): Don't get the PATH environment variable; that's dumb. Call getcwd. Sun Mar 14 13:36:57 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xdisp.c (display_menu_bar): Assume FRAME_MENU_BAR_ITEMS already set. Fill out line with spaces. Put explicit spaces between items. * keyboard.c (command_loop_1): Set FRAME_MENU_BAR_ITEMS here. * window.c (Fdelete_other_windows): Handle FRAME_MENU_BAR_LINES. * keyboard.c (menu_bar_items): Reverse the list when done. * xmenu.c (single_keymap_panes): When storing in ENABLES, check def before enabled. * ymakefile (really-oldXMenu): Renamed from ${oldXMenudir}$(OLDXMENU). Add @true. ($(OLDXMENU)): Depend on really-oldXMenu. The idea is to make sure libXMenu11.a is always updated if nec. * keyboard.c (command_loop_1): Typo calling Qrecompute_lucid_menubar. (read_key_sequence): Likewise. Also fix call to Vrun_hooks. Sat Mar 13 21:12:00 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * ymakefile (YMF_PASS_LDFLAGS): Doc fix. Sat Mar 13 19:16:45 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * print.c (PRINTPREPARE): Handle marker that points nowhere. * apollo.h (NO_X_DESTROY_DATABASE): Defined. * undo.c (record_property_change, record_delete, record_insert): Don't make boundary or touch last_undo_buffer if cur buf has no undo. * ymakefile [__GNUC__ > 1]: Delete the conditional for GCC 2.4. [__GNUC__ > 1] (LIB_GCC): Use -print-libgcc-file-name to find libgcc.a. (YMF_FIND_LIBGCC_A): Definitions and uses deleted. Sat Mar 13 18:31:05 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * s/usg5-4.h: Remove extraneous text after #undef LIB_X11_LIB. Sat Mar 13 13:18:37 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (Xatom_wm_change_state): Define here. * xfns.c (Xatom_wm_change_state): Just declare. (Xatom_emacs_selection, Xatom_clipboard, Xatom_clipboard_selection): (Xatom_wm_change_state, Xatom_incremental, Xatom_multiple): (Xatom_targets, Xatom_timestamp, Xatom_delete, Xatom_insert_selection): (Xatom_pair, Xatom_insert_property, Xatom_text): Decls deleted. (x_begin_selection_own): Decls deleted. (Fx_open_connection): Set up only the wm atoms here. Call Xatoms_of_xselect. * dispnew.c: Include termhooks.h. * frame.h (FRAMEP): Macro deleted. * xselect.c: Total rewrite, derived from Lucid's version. * keyboard.c (kbd_buffer_get_event): Handle selection_clear_event and selection_request_event events. * xterm.c (XTread_socket): Handle NEW_SELECTIONS alternative: queue events for SelectionRequest and SelectionClear; call functions for SelectionNotify and PropertyNotify. * termhooks.h (selection_request_event, selection_clear_event): New event kinds. * xterm.h (SELECTION_EVENT_DISPLAY): New macro. (SELECTION_EVENT_REQUESTOR, SELECTION_EVENT_SELECTION) (SELECTION_EVENT_TARGET, SELECTION_EVENT_PROPERTY) (SELECTION_EVENT_TIME): New macros. (struct selection_input_event): New structure. * process.c (wait_reading_process_input): New option to wait till a given cons cell has a non-nil car. Delete vipc conditionals. Fri Mar 12 22:59:08 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * ymakefile (YMF_FIND_LIBGCC_A): New macro, to help GCC find libgcc.a even when -nostdlib is in effect. Define it to be the empty string if nobody else establishes a value for it. (temacs): Include it in the list of flags passed to the linker. * ymakefile (LINKER): If we have GCC 2.4 or later, use the -nostartfiles option instead of -nostdlib. (LIBGCC): Under GCC 2.4 or later, define this to be the empty string. Fri Mar 12 15:55:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (xmenu_show): New arg enable_list. (keymap_panes): New arg enables (single_keymap_panes): New arg enables. Fill in its contents. (list_of_panes, list_of_items): New arg enables. Fill in contents. (Fx_popup_menu): Pass enable and enable_list args. (single_keymap_panes): Set enable flag to -1 if cmd definition is nil. * lisp.h (INTEGERP, SYMBOLP, MARKERP, STRINGP, VECTORP): New macros. (COMPILEDP, BUFFERP, SUBRP, PROCESSP, FRAMEP, WINDOWP): New macros. (WINDOW_CONFIGURATIONP, FLOATP): New macros. Fri Mar 12 10:09:07 1993 Paul Eggert (eggert@twinsun.com) * cmd.c (internal_self_insert): Check that tab_width does not exceed 20, to be consistent with indent.c and xdisp.c. Fri Mar 12 15:15:39 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * term.c (CONDITIONAL_REASSIGN): fixed reference to tigetstr. This should have been tgetstr, but I typoed and tigetstr happens to link and even do the right thing if you're on a System V box. Fri Mar 12 01:20:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): Support Vcurrent_menubar and Qactivate_menubar_hook. Call Qrecompute_lucid_menubar. (syms_of_keyboard): Set up Vcurrent_menubar, Vprevious_lucid_menubar, Qactivate_menubar_hook, and Qrecompute_lucid_menubar. * xmenu.c (Fx_popup_menu): Allow a frame instead of a window, in arg. Use Fcar, Fcdr when extracting from event, to check data types. Thu Mar 11 15:20:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.h (FRAME_MENU_BAR_ITEMS): New macro (two versions). (struct frame): New field menu_bar_items. * alloc.c (mark_object): Mark the menu_bar_items field. * xdisp.c (display_menu_bar): New function. (redisplay_window): Call display_menu_bar. * term.c (tigetstr): Add dummy definition to make Emacs link again. * keyboard.c (syms_of_keyboard): Set up Qmenu_bar. (menu_bar_items): New function. (menu_bar_one_keymap, menu_bar_item): New functions. (make_lispy_event): Handle menu bar events. (read_key_sequence): Make dummy prefix `menu-bar' for menu bar events. Thu Mar 11 03:13:56 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * term.c (fkey_table): Added many more keycap cookies to the fkey_table; it now supports the full intersection of the set of X keysyms and terminfo capabilities. See my lisp directory ChangeLog entry for this date, and lisp/term/README, for details. Thu Mar 11 02:22:33 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * floatfns.c (Flogb): Fix use of IN_FLOAT. Fix arg names. Don't confuse Lisp_Object with integer. Thu Mar 11 00:50:47 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * process.c (process_send_signal): In the TERMIOS code for sending control characters to processes, don't try to return Qnil; just return. Thu Mar 11 00:32:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dispnew.c (change_frame_size): Handle FRAME_MENU_BAR_LINES. * frame.c (Fframe_parameters): Report menu-bar-lines parm. (syms_of_frame): Set up Qmenu_bar_lines. * frame.h (FRAME_MENU_BAR_LINES): New macro. (struct frame): New field menu_bar_lines. * xfns.c (x_frame_parms): Add elts for visibility and menu-bar-lines. (enum x_frame_parm): Likewise. (x_set_menu_bar_lines, x_set_menu_bar_lines_1): New functions. (x_set_visibility): New function. (Fx_create_frame): Handle menu-bar-lines parm. (x_report_frame_params): Report Qvisibility. (syms_of_xfns): Set up Qvisibility. * keyboard.c (command_loop_1): Typo in last change. * xmenu.c (syms_of_xmenu): Set up Qmenu_enable. (single_keymap_panes): Test menu-enable property of symbol to decide whether to include it in the menu. Wed Mar 10 22:47:58 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * keyboard.c (command_loop_1): Adjust to the fact that display tables are now vectors of vectors, not vectors of strings. Wed Mar 10 09:17:39 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * floatfns.c (Flogb): Undo the change of Feb 22. * ymakefile (OLDXMENU): Don't assume that we have symbolic links available; use `ln -f' instead of `ln -s'. * xterm.c (x_find_modifier_meanings): XDisplayKeycodes only appeared in X11R4; for earlier versions, just access the members of the Display directly. * xrdb.c (get_user_db): Since xrdb.c doesn't #include xterm.h, we can't test HAVE_X11R4 to see how we should get the resource manager string; cheat. * unexec.c (copy_text_and_data): Error message tweaked. * systime.h (timezone): Add an explicit declaration for this variable under USG 5-4. * sysdep.c (read_input_waiting): Set e.frame_or_window, not e.frame; the latter doesn't exist anymore. * sysdep.c (start_of_data): If ORDINARY_LINK is #defined, we don't have the data_start symbol defined, so we'll just use the address of environ. * s/usg5-4.h: Changes from Eric Raymond: If we're doing ordinary linking, define LIB_STANDARD appropriately. Give LIBS_DEBUG a null definition; usg5-4 has no -lg. #define LIBS_STANDARD as "-lc"; usg5-4 has no -lPW. #define NSIG, if it's not already defined. #define HAVE_TERMIOS instead of HAVE_TCATTR. Provide our own definition of LIB_X11_LIB. * s/usg5-3.h (LIBX11_SYSTEM): Eric Raymond says the libraries here were slightly wrong. * m/intel386.h (LIB_STANDARD): If USG5_4 is #defined, there's no need to include `-lPW'; that has been merged with `-lc'. * emacs.c (__do_global_ctors, __do_global_ctors_aux, __do_global_dtors, __CTOR_LIST__, __DTOR_LIST__, __main): Don't define these if ORDINARY_LINK is #defined; in that case, the standard linking procedure will find definitions for these. * syssignal.h (sigunblock): Add definition which works under SYSVr4. * emacs.c (fatal_error_signal): Unblock the signal which we're handling using sigunblock. Tue Mar 9 11:06:26 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * xfns.c (x_make_gc): Don't forget to block X input around the X calls in this function. * xfns.c [not HAVE_X11R4] (select_visual): It's v->visualid, not x->visualid. x isn't defined. * m/template.h, s/template.h: Mention that `etc/MACHINES' and `configure' should be updated whenever support for a configuration is added or improved. * process.c [! subprocesses] (wait_reading_process_input): Remember to re-enable polling for input. * keyboard.c [POLL_FOR_INPUT] (quit_throw_to_read_char): If we're polling for input, abort; input polling should always be suppressed while we're waiting for input. * keyboard.c (interrupt_signal): Remove extern declaration of Vwindow_system; this is no longer used. Tue Mar 9 03:35:20 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * editfns.c (Fcurrent_time_string): Optional arg specifies time. * keymap.c (Fdefine_key): Use proper meta-bit to clear. * intervals.c (set_point): Check invisibility of following character, not previous character. * floatfns.c (FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO. * floatfns.c: Changes from Lucid. (HAVE_MATHERR, FLOAT_CHECK_ERRNO, FLOAT_CATCH_SIGILL): New parm macros. (FLOAT_CHECK_DOMAIN, HAVE_RINT): New parm macros. (HAVE_INVERSE_HYPERBOLIC, HAVE_CBRT): New parm macros. [!HAVE_RINT]: Define rint as macro. (IN_FLOAT): Major rewrite; several alternate versions. (IN_FLOAT2): New macro. (arith_error, range_error, domain_error, domain_error2): New macros. (Facos, Fasin, Fatan, Fcos, Fsin, Ftan, Fexp, Fexpt, Flog): Changed. (Flog10, Fsqrt, Fabs, Ffloat, Flogb): Changed. (Ffloor, Fceiling, Fround, Ftruncate): Changed. (Fcube_root): Renamed from Fcbrt. (matherr): New function. (float_error): Only if FLOAT_CATCH_SIGILL. * fns.c (Fy_or_n_p): Use query-replace-map. * keymap.c (access_keymap): Handle ints beyond the ASCII range. (store_in_keymap): Likewise. (Faccessible_keymaps): Use meta_modifier. Use vectors for the key sequences. (Fwhere_is_internal): Use meta_modifier. (append_key): Always return a vector. * lisp.h (Qrange_error, Qdomain_error, Qsingularity_error): (Qoverflow_error, Qunderflow_error): New vars. * data.c (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions: Qarith_error, Qrange_error, Qdomain_error, Qsingularity_error, Qoverflow_error, Qunderflow_error. Mon Mar 8 00:36:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * systty.h: Define HAVE_TCATTR based on HAVE_TERMIOS earlier. (struct emacs_tty): Separate the struct decl from the EMACS_..._TTY... macro definitions. Use HAVE_TCATTR to decide whether to use `struct termios'. * xfns.c (Fx_pixel_width, Fx_pixel_height): Fns deleted. (syms_of_xfns): Don't install them. (x_user_set_name): Function deleted. (x_char_height, x_char_width): New functions. * frame.c (Fframe_char_height, Fframe_char_width): (Fframe_pixel_height, Fframe_pixel_width): New functions, two versions of each. [MULTI_FRAME] (syms_of_frame): Make them Lisp functions. [!MULTI_FRAME] (syms_of_frame): Likewise. Also Fselected_frame. * xterm.c (XTread_socket): Don't reverse the chars that XLookupString returns. Use all of them. Save last 100 chars and keysyms in temp_buffer. Sun Mar 7 18:41:34 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * buffer.c (syms_of_buffer): Make erase-buffer a disabled command. Sun Mar 7 00:30:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ymakefile (keyboard.o): Depend on intervals.h. (keymap.o): Depend on termhooks.h. * keyboard.c: Include intervals.h. (read_key_sequence): Use get_local_map. * textprop.c (Fget_text_property): Use textget. (Fnext_single_property_change): Likewise. (Fprevious_single_property_change): Likewise. * intervals.c (textget): Handle categories. (get_local_map): New function. (verify_interval_modification): Call textget correctly. * textprop.c (syms_of_textprop): Set up Qcategory, Qlocal_map. * intervals.h: Declare those vars. Declare textget, get_local_map. * keymap.c: Include termhooks.h. (push_key_description): Handle all modifiers. Handle large character codes. (Fkey_description): Move the meta bit, if arg is string. (Fsingle_key_description): Don't alter integer value. Make tem long enough. * keyboard.c (read_key_sequence): Use meta_modifier for meta keys when handling function_key_map. * lread.c (syms_of_lread): Set up Qascii_character. (Fread_char, Fread_char_exclusive): Use that property to convert symbols like tab, return, M-return,... to ASCII. * keyboard.c (follow_key): Downcase shift_modifier as well as ASCII. (command_loop_1): Run pre-command-hook and post-command-hook. Set this_command before running pre-command-hook. (syms_of_keyboard): Set up vars for those hooks. * buffer.c (reset_buffer_local_variables): Reset mark_active. (syms_of_buffer): New buffer-local var `mark-active'. (init_buffer_once): Initialize mechanism for it. Sat Mar 6 14:54:40 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * dispnew.c (init_display): Initialize Vwindow_system. * ymakefile (SHELL): No need to set this twice; remove one. * emacs.c (main): SIGIOT isn't defined on all systems; don't set its signal handler unless it is. * sysdep.c (init_baud_rate): Use input_fd, instead of fd; the latter is undefined. * dired.c (NAMLEN): Never use d_nameln to get the length of the directory entry's name; it is used inconsistently. Always call strlen instead. Sat Mar 6 01:18:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (syms_of_keyboard): Handle gaps in modifier_names. (modifier_names): Reorder to match termhooks.h. * keyboard.c (parse_modifiers_uncached): Detect `s-', not `super-'. (apply_modifiers_uncached): Make `s-', not `super-'. * lread.c: Include termhooks.h. (read_escape): Handle \H, \A, \s. Use ..._modifier. * ymakefile (lread.o): Depend on termhooks.h. * termhooks.h (alt_modifier, super_modifier, hyper_modifier): (shift_modifier, ctrl_modifier, meta_modifier): Renumber the bits. * keyboard.c (make_lispy_event): For ASCII event, the ..._modifier bits are the right bits to return. * keyboard.c (lispy_function_keys): Add codes starting at 0xff00 and running through 0xffff. * xterm.c (x_alt_mod_mask, x_super_mod_mask, x_hyper_mod_mask): New variables. (x_find_modifier_meanings): Set them. (x_convert_modifiers): Check for them. (XTread_socket): Handle BackSpace, etc, function keys. * keyboard.c (read_char): Move metabit when fetching from string macro. * callint.c (check_mark): Error if mark is not active. * editfns.c (save_excursion_save): Save mark_active of buffer. (save_excursion_restore): Restore mark_active of buffer. Run activate-mark-hook if it's on, or deactivate-mark-hook if it turns off. (region_limit): Error if mark inactive, if transient-mark-mode. * insdel.c (prepare_to_modify_buffer): Set Vdeactivate_mark. * keyboard.c (command_loop_1): Clear Vdeactivate_mark before cmd. Clear mark_active if command set Vdeactivate_mark. Run deactivate-mark-hook at that time, or activate-mark-hook. (syms_of_keyboard): Define variable deactivate-mark. * buffer.c (syms_of_buffer): New buffer-local var `mark-active'. (init_buffer_once): Initialize mechanism for it. * buffer.h (struct buffer): New field mark_active. * intervals.c (verify_interval_modification): Handle insertions specially. For non-insertions, check only the chars being changed. `modification-hooks' property is now a list of functions. (set_point): Ignore chars outside current restriction. * textprop.c (Qmodification_hooks): Renamed from Qmodification. (syms_of_textprop): Changed accordingly. * keyboard.c (syms_of_keyboard): New lisp var unread-command-char. (Finput_pending_p): Test unread_command_char. (Fdiscard_input, quit_throw_to_read_char, init_keyboard): Set it. (read_char): Fetch from it. Fri Mar 5 02:17:23 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * textprop.c (Fadd_text_properties): Initialize the modified flag. Use a "for (;;)" loop at the end of the function, to indicate that all exiting is taken care of inside the loop. (Fremove_text_properties): Same. Fri Mar 5 01:48:38 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ymakefile (LIB_MATH): Delete -lc, since duplicates LIB_STANDARD. * buffer.c (check_protected_fields): Variable deleted. (syms_of_buffer): Delete vars buffer-field-list and check-protected-fields. * insdel.c (check_protected_fields): Delete decl. * disptab.h (DISP_INVIS_VECTOR): Renamed from DISP_INVIS_ROPE. (DISP_CHAR_VECTOR): Renamed from DISP_CHAR_ROPE. All callers changed. * xdisp.c (copy_rope): Expect FROM to be a vector. (copy_part_of_rope): New function. (display_string): Expect display table elts to be vectors. * indent.c (current_column, Fmove_to_column, compute_motion): Expect display table elts to be vectors. * alloc.c: (Fmake_rope, Frope_elt): Fns deleted. * lisp.h (CHAR_META, CHAR_SHIFT, CHAR_CTL): New macros. * lread.c (read_escape): Handle M-, C- and S- for new convention. (read1): Move the meta bit to the right place for a string. * keyboard.c (Fthis_command_keys, Fread_key_sequence): Fix calls to make_event_array. * macros.c (Fend_kbd_macro): Fix call to make_event_array. * alloc.c (make_event_array): Renamed from make_array. Chars that fit in a string are 0...127 and their meta variants. * keyboard.c (make_lispy_event): Put meta and shift modifiers into an integer. (read_avail_input): Set the modifiers field in the events read. (kbd_buffer_get_event): Pass thru integer event untruncated. (read_char): Likewise. (read_key_sequence, read_char): Only -1 means EOF. (kbd_buffer_store_event): Don't ignore 0200 bit in quit char. (follow_key): Use new meta bit flag. * xterm.c (XTread_socket): Set bufp->modifiers for all kinds of keys. * keymap.c (Flookup_key): Use 0x800000 as meta-bit if from vector. (Fdefine_key): Likewise. Thu Mar 4 14:48:55 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dgux.h (ELF): Handle this parameter. [! COFF] (UNEXEC, USG_SHARED_LIBRARIES): New definitions. (_BSD_TTY_FLAVOR): Don't define if already defined. (C_COMPILER, LINKER, MAKE_COMMAND): New definitions. Thu Mar 4 13:01:24 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * keyboard.c (Fsuspend_emacs): Remember that `suspend-hooks' isn't necessarily bound. Thu Mar 4 10:15:47 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Makefile.in (xmakefile): Add missing quote. Wed Mar 3 10:11:08 1992 Wilson H. Tien (wtien at urbana.mcd.mot.com) * unexelf.c (unexec): Move data2 section header up so all section headers will be in ascending order. This will prevent the unexeced emacs that being processed by other applications (such as strip) to fail. Tue Mar 2 17:18:20 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/isc2-2.h (S_IFLNK): Add #undef. (C_SWITCH_SYSTEM): Add conditional definition. (NO_ASM, USE_UTIME, NO_X_DESTROY_DATABASE): Defined. (LIB_STANDARD): Alternate definition if __GNUC__. (SIGTSTP): #undef deleted. (LIBS_SYSTEM): Define only if HAVE_X_WINDOWS. * s/isc3-0.h: New file. * unexelf.c: Handle rounding of section boundaries. (round_up): New function. Tue Mar 2 13:39:40 1993 Karl Berry (karl@cs.umb.edu) * s/isc2-2.h (USG_SHARED_LIBRARIES, CLASH_DETECTION, NO_FCHMOD): Define. (HAVE_TIMEVAL): Do not define. (NO_ASM): Only define once. Tue Mar 2 00:59:29 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * print.c (float_to_string): Define buf to be an unsigned char, to match the data field of strings. * keyboard.c (kbd_buffer_get_event): Protect assignment to Vlast_event_frame in a "#ifdef MULTI_FRAME" clause. * syntax.c (describe_syntax_1): Delete excess arg to describe_vector. (check_syntax_table): Delete excess arg to wrong_type_argument. Mon Mar 1 22:10:54 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * buffer.c (buffer-undo-list): Doc fix. * xdisp.c (redisplay): Protect calls to request_sigio and unrequest_sigio in "#ifdef SIGIO" clauses; these are not defined * cmds.c (Fnewline): Doc fix. Mon Mar 1 00:46:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * insdel.c (del_range): Update point before offset_intervals. * intervals.h: Don't include dispextern.h more than once. (INTERVAL_VISIBLE_P): NILP test was backwards. * intervals.c (intervals_equal): Handle one arg null and other not. (set_point): Considerable rewrite. Handle intervals both before and after the old and new point values. Redo handling of invisible intervals, and of motion hooks. (textget): New function. * textprop.c (Fadd_text_properties, Fremove_text_properties): Add len>0 as condition for main loop. Abort if reach a null interval. (Fset_text_properties): Abort if reach a null interval. (Ftext_properties_at, Fget_text_property): Return nil if POS is end of OBJECT. (add_properties): Use NILP to test result of Fequal. No longer inline. (remove_properties): No longer inline. (set_properties): Total rewrite as function. (validate_interval_range): Don't alter *begin at end of buffer. But do search for a position just before the end. Return null for an empty string. Sun Feb 28 13:59:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (emacs, temacs): Add @true to prevent Make confusion. * lread.c (read1--strings with properties case): Detect end of list, and invalid syntax, using recursive read1 calls. * intervals.c (graft_intervals_into_buffer): create_root_interval needs Lisp object arg. Set tree to new root interval. Don't test TREE_LENGTH if buffer has no intervals. Rearrange code to copy properties so that it really does merge the inserted ones into the inherited ones. (traverse_intervals): Pass `arg' on recursive calls. (split_interval_left): Use new_length as basis for length of new. * print.c (print--string case): Any non-null interval means print intervals. Get rid of var obj1; just use obj. * textprop.c (validate_interval_range): Allow 0 as position in string. Add 1 to specified string positions. (Fprevious_single_property_change): Subtract 1 if object is string. (Fnext_single_property_change): Likewise. (Fprevious_property_change, Fnext_property_change): Likewise. * xterm.c (x_do_pending_expose, XTframe_rehighlight): (x_window_to_scrollbar): Use XGCTYPE. Sun Feb 28 00:41:56 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) Use the term `scroll bar', instead of `scrollbar'. * alloc.c, frame.c, frame.h, indent.c, keyboard.c, keyboard.h, lisp.h, term.c, termhooks.h, window.c, window.h, xdisp.c, xfns.c, xterm.c, xterm.h: Terminology changed. Don't generate switch-frame events by checking Vlast_event_frame; use a separate variable for that bookkeeping. In order to generate them properly, we may need to fiddle with it. * keyboard.c (internal_last_event_frame): New variable. (command_loop_1): Check internal_last_event_frame, not Vlast_event_frame. (read_char, kbd_buffer_store_event): Set both Vlast_event_frame and internal_last_event_frame. (kbd_buffer_get_event): Check internal_last_event_frame to decide whether to generate a switch-frame event. Set Vlast_event_frame after each event. (init_keyboard): Initialize both Vlast_event_frame and internal_last_event_frame. * keyboard.h (internal_last_event_frame): Add extern declaration for this. * frame.c (Vlast_event_frame): Remove external declaration for this. (Fselect_frame): Set internal_last_event_frame to Qnil to force a switch-frame event, not Vlast_event_frame; the latter is supposed to convey information to the user. * keyboard.c (syms_of_keyboard): Doc fix for unread_command_events. Fri Feb 26 16:09:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (syms_of_keyboard): Doc fix. Fri Feb 26 05:06:59 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * ymakefile (LIBES): Exchange the order of LIB_MATH and LIB_STANDARD, to avoid duplicated symbols under SunOS. * buffer.c (syms_of_buffer): Add the extra argument to the commented-out DEFVAR_PER_BUFFER for `mode-line-format', so make-docfile will find the docstring properly. Thu Feb 25 15:03:28 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ymakefile (intervals.o): Dep on intervals.c, not textprop.c. * textprop.c (remove_properties): Call modify_buffer. (add_properties): Likewise. * undo.c (record_property_change): Typo in last change. * cmds.c (syms_of_cmds): Typo in last change. * print.c (print): Never declare OBJ arg as `register'. Special handling for strings with intervals. (print_intervals): New function. * lread.c (read1): Handle reading strings with properties. * intervals.c (traverse_intervals): New arg ARG. * alloc.c (mark_interval): Add ignored arg. (mark_interval_tree): Pass new arg to traverse_intervals. Wed Feb 24 23:26:45 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * xterm.c (x_window_to_scrollbar, x_scrollbar_expose, x_scrollbar_handle_click, x_scrollbar_note_movement): Remember that these can be called during GC; we have to ignore mark bits. * lisp.h (GC_NILP, GC_EQ): New macros to help with that. * print.c (float_to_string): Define buf to be an unsigned char, to match the data field of strings. * lisp.h (RETURN_UNGCPRO): Remove "do ... while (0)" wrapper around macro. * data.c (Fstring_to_number): Declare p to be an unsigned char, to match the data field of strings. * data.c (Fstring_to_number): Just skip tabs and spaces; don't use the macros. The stuff apparently varies from locale to locale more than we'd like. Don't include . Wed Feb 24 18:38:45 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * buffer.c (Ferase_buffer): Added interactive spec. Wed Feb 24 03:54:21 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * undo.c (Fprimitive_undo): Handle property-change undo entry. (record_property_change): New function. * textprop.c (Fadd_text_properties): Pass new arg to add_properties. (Fremove_text_properties): Likewise. (add_properties, remove_properties): New arg OBJECT. Record undo info. (Fput_text_property): New function. * buffer.c (syms_of_buffer): Doc fix. * cmds.c (syms_of_cmds): New var `overwrite-binary-mode'. (internal_self_insert): Handle that var. Tue Feb 23 13:49:15 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_avail_input): Args to `kill' were backwards. Tue Feb 23 03:35:25 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * alloc.c (make_pure_float): Assure that PUREBEG + pureptr is aligned, not pureptr itself. * emacs.c (fatal_error_signal): Unblock the signal before we try to deliver it to ourselves. #include "syssignal.h" to get the right definitions. * abbrev.c (Fexpand_abbrev): Only copy the text we're going to expand - from wordstart to wordend, not from wordstart to point - into the buffer. There might be non-word text between wordend and point. Tue Feb 23 00:46:43 1993 Richard Stallman (rms@geech.gnu.ai.mit.edu) * unexec.c (adjust_lnnoptrs): Handle symentry.n_type == 0x2400. (make_hdr) [USG_SHARED_LIBRARIES]: Set bias using bss_start. Mon Feb 22 01:51:49 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * process.c: Make sure we don't miss processes exiting, by having the sigchld handler clear *input_available_clear_time. (wait_reading_process_input): Check for process activity after setting the timeout and calling set_waiting_for_input. (sigchld_handler): If the process which has exited is one we care about, clear *input_available_clear_time. * frame.c (Fselect_frame): Set Vlast_event_frame to Qnil after switching frames, to make sure we'll get a switch-frame event. (Vlast_event_frame): Add external declaration for this here. * alloc.c (make_pure_float): Align pureptr according to __alignof, if it's available, or sizeof (struct Lisp_Float) if it's not. * .gdbinit (xprocess): New command. * floatfns.c (Flogb): Always implement this by calling Flog, even on non-USG systems, which supposedly have a logb function. (Fround): Always implement this by calling floor, even on systems that have rint. * process.c (process_send_signal): Use TERMIOS functions in preference to BSD ioctls. Some systems attempt to provide the BSD functions for backward compatibility, and get it wrong. * data.c (Fstring_to_number): Skip initial spaces, to make Emacs lisp parse consistently on different operating systems. #include to help with this. * data.c (Fstring_to_int): Rename this to Fstring_to_number, since it parses floats as well as integers. Fix docstring. (syms_of_data): Fix defsubr. (wrong_type_argument): Change use. (Fint_to_string): Doc fix. * lisp.h (Fstring_to_int): Change extern declaration. Mon Feb 22 01:37:03 1993 Charles Hannum (mycroft@hal.gnu.ai.mit.edu) * ibmrs6000.h (C_ALLOCA, STACK_DIRECTION): Only define if HAVE_ALLOCA is not defined. (X_DEFAULT_FONT): Change to `fixed', as `Rom14.500' only works on the console. * aix3-1.h: Changes from 18.58. (HAVE_TERMIOS): Changed from HAVE_TERMIO. (unix): Define. * sysdep.c (child_setup_tty): Recognize HAVE_TERMIOS as well as HAVE_TERMIO. * xrdb.c (getuid): Remove declaration. * systty.h [HAVE_TERMIOS]: Include fcntl.h. * systime.h [_AIX]: Move test outside of previous #if. (EMACS_GET_TZ_OFFSET) [USG]: Don't declare twice. Prefer tzset. * keyboard.c (init_keyboard): Recognize HAVE_TERMIOS as well as HAVE_TERMIO. * aix3-2.h: New file. Specifies difference between AIX 3.1 and 3.2. Sat Feb 20 12:35:48 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) * keyboard.c (Fsuspend_emacs): Make tem not register. * syntax.c (Fforward_comment): New function. * search.c (Fskip_syntax_backward): New function. (Fskip_syntax_forward): Likewise. (skip_chars): New argument syntaxp. * alloc.c (Fmemory_limit): Doc fix. Fri Feb 19 00:43:36 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (Fsuspend_emacs): Rename suspend-hook to suspend-hooks and run it manually. * keymap.c (describe_map): Call Fkey_description before build_string. Thu Feb 18 01:26:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (Fopen_dribble_file): Doc fix. * lread.c (syms_of_lread): Doc fix. Thu Feb 18 00:20:49 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * textprop.c (Fget_text_property): Fix typo in function's declaration. * floatfns.c (IN_FLOAT): Make this work properly when SIGTYPE is void. * alloc.c: Add description lines to the top of each page. * alloc.c (mark_interval_tree): Remove spurious & in front of function name. * alloc.c (UNMARK_BALANCE_INTERVALS): Fix to accomodate compilers other than GCC, which do not allow casts on the LHS of an assignment. * config.h.in: #define USE_TEXT_PROPERTIES by default. * alloc.c (mark_object, mark_buffer): Remove some unused variables. * buffer.c (Fswitch_to_buffer): Pass the correct number of arguments to Fnext_window. * buffer.c (Fbury_buffer): Pass the correct number of arguments to Fother_buffer. * bytecode.c (Fbyte_code): Pass the correct number of arguments to temp_output_buffer_show. * callint.c (Fcall_interactively): Pass the correct number of arguments to wrong_type_argument. * casefiddle.c (caseify_object): Same. * casetab.c (check_case_table): Same. * search.c (Fstore_match_data): Same. * syntax.c (check_syntax_table): Same. * callproc.c (delete_temp_file): Declare this to return Lisp_Object, to smooth type-checking. * data.c (wrong_type_argument): Pass the correct number of arguments to Fstring_to_int. * data.c (arithcompare): Add a default case which aborts, just to make me happy. * dispnew.c (sit_for): Pass the correct number of arguments to gobble_input. * editfns.c (Fmessage): Don't forget to return a value when args[0] == Qnil. * fns.c (Fequal): Call internal_equal to recurse on elements of lists and vectors, not Fequal. * frame.c (Fdelete_frame): If FRAME is a dead frame, return Qnil, not nothing. * keyboard.c (echo_char): Apply XINT to c before passing it to push_key_description. * keyboard.c (recursive_edit_1, command_loop_1): Pass the proper number of arguments to unbind_to. * lread.c (Feval_buffer): Same. * window.c (Fscroll_other_window): Same. * keyboard.c (command_loop_1): Apply XINT to c before passing it to internal_self_insert and direct_output_for_insert. * keyboard.c (make_lispy_movement): Rename the variable `part' declared in the block handling scrollbar movement to `part_sym', to avoid potential conflicts with the argument named `part'. Apparently the semantics of expressions like this are unclear. * keyboard.c (Fread_key_sequence): Backslash the newlines in this docstring. * textprop.c (Fget_text_property): Same. * keymap.c (Fdescribe_vector): Pass the proper number of arguments to describe_vector. * syntax.c (describe_syntax_1): Same. * minibuf.c (Fdisplay_completion_list): Pass the proper number of arguments to Flength. * xmenu.c (list_of_items): Same. * window.c (Fset_window_configuration): Pass the proper number of arguments to Fselect_frame. * xfns.c (x_set_icon_type): Pass the proper number of arguments to x_bitmap_icon. * xterm.c (XTread_socket): Pass the proper number of arguments to construct_mouse_click. * config.h.in (HAVE_CONST): New macro. If it's not #defined, #define const to be the empty string. * config.h.in: If we're not __STDC__, define volatile to be the empty string. * buffer.h: Remove code which #includes "undo.h" if lint is defined. undo.h no longer exists. * buffer.c (buffer_slot_type_mismatch): Make symbol_name an unsigned char *, to match the type of a string's data. Wed Feb 17 22:39:49 1993 Michael I Bushnell (mib@geech.gnu.ai.mit.edu) * process.c (Fstart_process): Jimb's change of December 11 had a misplaced paren. This only became apparent because of jimb's change on February 8 to Fexpand_file_name. * callproc.c (Fcall_process): Ditto. Wed Feb 17 16:27:39 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * callproc.c (init_callproc): Move the initialization of Vprocess_environment to its own function. (set_process_environment): This is that. * emacs.c (main): Call set_process_environment earlier than init_callproc. Sun Feb 14 18:07:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c (Frename_buffer): Make prefix arg set UNIQUE. Sun Feb 14 08:33:24 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * xterm.c (x_set_window_size): Call change_frame_size instead of just setting the `rows' and `cols' members of the frame, and leaving the window tree in complete disarray. * dispnew.c (remake_frame_glyphs): When re-allocating the frame's message buffer when echo_area_glyphs is pointing at it, relocate echo_area_glyphs too. Same for previous_echo_glyphs. * window.h (previous_echo_glyphs): Add extern declaration for this. * frame.c (Fframe_parameters): Report the `minibuffer' parameter of minibufferless frames as nil, not `none'. (Qnone): Remove declaration and initialization for this. It's not needed anymore. * xfns.c (Qnone): Add them here; we still accept "none" as a valid value for the `minibuffer' parameter. * xfns.c (x_frame_params): Remember that the parameters are called "auto-raise" and "auto-lower", not "autoraise" and "autolower". * xdisp.c (message): Set echo_frame to the frame whose message buf we want to use, not to the message buf itself. Sat Feb 13 06:34:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * textprop.c (Fadd_text_properties): Put OBJECT arg last. Make it optional. (Fset_text_properties, Fremove_text_properties): Likewise. (Fnext_single_property_change, Fprevious_single_property_change): (Fnext_property_change, Fprevious_property_change): Likewise. (Ferase_text_properties): #if 0. (Fget_text_property): New function. * s/irix4-0.h (C_SWITCH_MACHINE): Don't define if GCC. Sat Feb 13 03:21:57 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * s/usg5-4.h: #include "usg5-3.h", not "s-usg5-3.h". Thu Feb 11 21:04:37 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * xterm.c (x_io_error_quitter): New function. (x_error_quitter): Note that this is only used for protocol errors now, not I/O errors. (x_term_init): Set the I/O error handler to x_io_error_quitter. Thu Feb 11 18:20:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * editfns.c (Finsert_buffer_substring): Proper error for non-ex buffer. (Fcompare_buffer_substrings): Likewise. Wed Feb 10 01:38:55 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell users that buffers have shrunk a lot. This is called when Emacs is crashing, so we don't want to run any code that isn't absolutely necessary. Also, autosave buffers which don't have specially handled autosave file names first. Wed Feb 10 01:33:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * editfns.c (Fcompare_buffer_substrings): Ignore case if case-fold-search is non-nil. Mon Feb 8 10:28:52 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * keymap.c (Flookup_key, Fkey_binding, Flocal_key_binding, Fglobal_key_binding, Fminor_mode_key_binding): Add a new optional argument ACCEPT_DEFAULT, to control whether this function sees bindings for t. (Fwhere_is_internal, describe_map_tree, describe_map_2, describe_vector): Pass the proper arguments to Flookup_key. * fileio.c (Fexpand_file_name): Pass DEFALT through Fexpand_file_name before using it. * fileio.c (Fexpand_file_name): Doc fix. Sun Feb 7 20:26:44 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * xdisp.c (message): Use the message buffer of the frame we're going to display the message on to format the message, not that of the selected frame. Sun Feb 7 00:31:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile (emacs, temacs): Add no-op commands to these rules. * dispnew.c (char_ins_del_cost): Use FRAME_WIDTH, not FRAME_HEIGHT. * editfns.c (Fcompare_buffer_substrings): New function. Sat Feb 6 19:23:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (extra_keyboard_modifiers): New Lisp var. (read_char): Support ctl and meta bits in extra_keyboard_modifiers. * xterm.c (XTread_socket): Support extra_keyboard_modifiers. Fri Jan 29 16:30:56 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * window.c (Fscroll_left, Fscroll_right): Don't forget to apply XWINDOW to selected_window before passing it to window_internal_width. * xmenu.c (Fx_popup_menu): Don't forget to turn the frame-relative coordinates for the menu position into root-window-relative coordinates. * lread.c (read1): Although digits followed by a '.' are an integer, a single . by itself (like, say, \.) should be a symbol. Mon Jan 25 22:04:43 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * fns.c (internal_equal): Protect the clause for comparing numbers of different types with a "#ifdef LISP_FLOAT_TYPE". Mon Jan 25 15:05:47 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/hpux8.h [__GNUC__] (LD_SWITCH_SYSTEM): Remove -a. [__GNUC__] (ORDINARY_LINK): Defined. * m/sparc.h [TERMINFO]: Don't define LIBS_TERMCAP. Mon Jan 25 11:37:34 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) `live-frame-p' has become `frame-live-p'. * frame.c (Qlive_frame_p): Renamed to Qframe_live_p. (Flive_frame_p): Renamed to Fframe_live_p. (syms_of_frame): Defsubrs and initializations adjusted. * frame.h (CHECK_LIVE_FRAME): Use Qframe_live_p, not Qlive_frame_p. (Qlive_frame_p): Changed extern declaration to Qframe_live_p. * lread.c (read1): Treat a string of digits ending in a period as an integer. Turn `first-change-function' into `first-change-hook'. * buffer.c (Vfirst_change_function): Renamed to Vfirst_change_hook. (Qfirst_change_hook): New symbol, for passing to Vrun_hooks. (syms_of_buffer): Change DEFVAR; initialize Qfirst_change_hook. * buffer.h (Vfirst_change_function): Renamed to Vfirst_change_hook. (Qfirst_change_hook): Added declaration. * insdel.c (signal_before_change): Change references to Vfirst_change_function, and apply Vrun_hooks to Qfirst_change_hook, instead of just calling Vfirst_change_function directly. x-selection-value has been renamed to x-selection. x-own-selection has been renamed to x-set-selection, and the order of its arguments has been reversed, for consistency with other lisp functions like put and aset. * xselect.c (Fx_own_selection): Rename to Fx_set_selection, reverse the order of the args, and therefore make the type non-optional. Doc fix. (Fx_selection_value): Rename to Fx_selection; make the type argument non-optional, for symmetry with Fx_set_selection. Doc fix. (syms_of_xselect): Adjusted. * xselect.c (Fx_own_selection, Fx_selection_value): Remove "#if 0"'ed code which made cut buffers look like a special selection type. * xfns.c (Vx_selection_value): Removed extern declaration for this; it's never used. * data.c (Fcompiled_function_p): Renamed to Fbyte_code_function_p. (syms_of_data): Adjusted. * data.c (Fnumberp, Fnumber_or_marker_p): Use the NUMBERP macro, instead of writing it out. * fns.c (internal_equal): If the operands are both numbers, compare them numerically, so that (equal 1.0 1) => t. Compare Lisp_Compiled objects like vectors. Add lisp functions to raise and lower frames. * termhooks.h (frame_raise_lower_hook): New hook. * term.c (frame_raise_lower_hook): Define it. * frame.c (Fframe_to_front, Fframe_to_back): New functions. (syms_of_frame): defsubr them. * xterm.c (XTframe_raise_lower): New function. (x_term_init): Set frame_raise_lower_hook to XTframe_raise_lower. * frame.c: Doc fixes. Sun Jan 24 16:28:34 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) Make the cursor style a frame parameter. * xterm.h (struct x_display): Rename the `text_cursor_kind' member to `current_cursor'; add new member `desired_cursor'. (FRAME_DESIRED_CURSOR): New accessor for new member. * xterm.c (x_display_bar_cursor): Rewritten so as not to damage the characters the cursor is displayed over, and to handle transitions between box and bar styles. (x_display_bar_cursor, x_display_box_cursor): Use current_cursor instead of text_cursor_kind. (Vbar_cursor): Delete external declaration. (x_display_cursor): Use the FRAME_DESIRED_CURSOR accessor instead of Vbar_cursor to decide how to draw the cursor. * xfns.c (Vbar_cursor): Remove definition. (Qbar, Qbox, Qcursor_type): New symbols. (syms_of_xfns): Init and staticpro them; remove DEFVAR for Vbar_cursor. (x_set_cursor_type): New setter. (x_frame_parms): Add it to the list. (Fx_create_frame): Get default values for the cursor type. * frame.c (Fmouse_position): Pass the appropriate arguments to *mouse_position_hook; the protocol was changed, but this caller wasn't fixed. * xterm.c (XTclear_frame): Call x_scrollbar_clear. (x_scrollbar_clear): New function. * xterm.c (XTflash): Totally rewritten. Only defined if HAVE_TIMEVAL and HAVE_SELECT are defined, since we use select for our timing. (timeval_subtract): New function, to help XTflash. (x_invert_frame): Removed. This didn't work anyway. (XTring_bell): Remove "#if 0" around call to XTflash, and remove calls to x_invert_frame. If both HAVE_TIMEVAL and HAVE_SELECT aren't defined, then just do the ordinary beep. * window.c (Fscroll_other_window): Prefer windows on the selected frame, then look for windows on other visible frames. * keyboard.c (Fmouse_click_p): Removed; with the 'e' spec, this isn't necessary anymore. (syms_of_keyboard): Remove defsubr for it. * keyboard.h (Fmouse_click_p): Remove extern declaration for it. * xfns.c (gray_bits): Remove this declaration; the same data is in . #include that instead. [not HAVE_X11] (x_set_border_pixel): Use gray_width and gray_height, instead of assuming that the bitmap is 16x16. (x_make_gc): Instead of creating a pixmap and then calling XPutImage to make it into a grey stipple, just call XCreatePixmapFromBitmapData to do it all at once. * xterm.c (x_text_icon): Move the request for font information into the "not HAVE_X11" part of the function; the X11 code doesn't need this. * xterm.c (x_wm_set_icon_pixmap): Instead of setting the icon_pixmap to None, just remove IconPixmapHint from the flags of the XWMHints structure. * window.c (Fprevious_frame): Use prev_frame when we get to the end of the current frame, not next_frame. Doc fix. * frame.c (prev_frame): Remove "#if 0" from this function. It turns out we do need it, to make prev_frame work right. * frame.c (next_frame): Check that FRAME is a live frame. * frame.c (Fselect_frame): Remove "#ifdef MULTI_FRAME" clause around the code which calls Ffocus_frame; this code is already inside an "#ifdef MULTI_FRAME" clause. (next_frame, prev_frame, Fnext_frame): For the same reasons, remove the "#ifdef MULTI_FRAME" clause around these functions. unread-command-event has been replaced by unread-command-events. * commands.h (unread_command_event): Change extern declaration. * keyboard.c (unread_command_event): Change the definition. (syms_of_keyboard): Change DEFVAR, and adjust the docstring. (command_loop_1, read_char, Finput_pending, Fdiscard_input, quit_throw_to_read_char, init_keyboard): Change to use unread_command_events, with the new semantics. * lread.c (read_char): Same. * minibuf.c (temp_echo_area_glyphs): Same. * xterm.c (unread_command_event): Remove external declaration for this; it is only used by obsolete code. * Makefile.in: Some makes can't handle comments in the middle of commands; move them to before the whole rule. Thu Jan 21 22:51:37 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * keyboard.c (make_lispy_event): When handling a mouse click event on a window, change x and y from screen coordinates to window coordinates even when the click isn't in the text area. * xterm.c (x_scrollbar_create): Remove code which asks for EastGravity for windows; Emacs can't correctly deal with them moving around unexpectedly. * xterm.c (XTread_socket): Minor reformatting. * xterm.c (x_set_window_size): Always mark the frame garbaged. * window.c (Vmouse_window): Variable removed; it can't be handled properly without race conditions, and the events give you all the information you need anyway. (syms_of_window): Remove DEFVAR. * callint.c (Fcall_interactively): Change the `@' spec to select the window of the first parameterized event in the key sequence which invoked the command, instead of using Vmouse_window, which isn't even updated anymore. Adjust the documentation accordingly. Wed Jan 20 13:06:43 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * xterm.c (x_scrollbar_create): Set the scrollbars to use EastGravity. * keyboard.c (make_lispy_event): Deal with button releases with no stored down-going position. Make sure we always store a Qnil in the right button_down_location element after using it. Tue Jan 19 10:33:04 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * frame.c (Fdelete_frame): Clear the frame's display after calling the window-system-dependent frame destruction routine. We no longer need to pass the display as a separate argument to x_destroy_window. * xterm.c (x_destroy_window): Put the code which clears out f's display here, right after we free the storage it points to. Put everything, including the code which clears x_focus_frame and x_highlight_frame, inside the BLOCK/UNBLOCK_INPUT pair. * dispnew.c (Fredraw_display): Undo change of Jan 12; redraw only frames whose garbaged flag is set. The change to FRAME_SAMPLE_VISIBILITY on Jan 14 should address the problem better. keyboard.c (read_char_menu_prompt): Test HAVE_X_WINDOWS, not HAVE_X_WINDOW. The CPP symbol indicating whether or not we have mouse menu support under X Windows is HAVE_X_MENU, not not NO_X_MENU. * emacs.c (main): Test HAVE_X_MENU, instead of NO_X_MENU. * keyboard.c (read_char_menu_prompt): Same. * ymakefile: Same. * keyboard.c (read_char, read_char_menu_prompt): Use the EVENT_HAS_PARAMETERS macro from keyboard.h, instead of writing it out. * keyboard.c (read_char_menu_prompt): Doc fix. * keyboard.c (read_char_menu_prompt): Fix test for no menus; comparing name to Qnil doesn't work if we are called with no maps. * keymap.c (Fdefine_key): Call Fkey_description to make the string to use in the error message. Mon Jan 18 19:56:45 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * window.c (Fdisplay_buffer): Doc fix. Sat Jan 16 00:55:19 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xterm.c (x_window_to_scrollbar): Search frames' condemned_scrollbars list as well; input might arrive during redisplay. (x_scrollbar_report_motion): Don't forget to BLOCK_INPUT. (XTjudge_scrollbars): Clear the condemned scrollbar list before traversing it, so we don't try to process an event on a scrollbar we've killed. Fri Jan 15 16:57:33 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (Frecent_keys): Doc fix. Thu Jan 14 16:17:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (Fwindow_at): Doc fix. Thu Jan 14 04:34:13 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * xterm.c (x_scrollbar_create): Include PointerMotionHintMask in the event mask for scrollbars. * dispnew.c (Fredraw_display): DEFUN was missing a closing paren. * term.c (set_vertical_scrollbar_hook, condemn_scrollbars_hook, redeem_scrollbar_hook, judge_scrollbars_hook): Removed dumbo "externs" from these. They're supposed to be real definitions. * .gdbinit: Add "-geometry +0+0" to default args. (xscrollbar): New command. Make scrollbar structures into lisp objects, so that they can be GC'd; this allows windows and scrollbars can refer to each other without worrying about dangling pointers. * xterm.h (struct x_display): vertical_scrollbars and judge_timestamp members deleted. (struct scrollbar): Redesigned to be a template for a Lisp_Vector. (SCROLLBAR_VEC_SIZE, XSCROLLBAR, SCROLLBAR_PACK, SCROLLBAR_UNPACK, SCROLLBAR_X_WINDOW, SET_SCROLLBAR_X_WINDOW, VERTICAL_SCROLLBAR_INSIDE_WIDTH, VERTICAL_SCROLLBAR_TOP_RANGE, VERTICAL_SCROLLBAR_INSIDE_HEIGHT, VERTICAL_SCROLLBAR_MIN_HANDLE): New macros, to help deal with the lispy structures, and deal with the graphics. * frame.h (WINDOW_VERTICAL_SCROLLBAR): Macro deleted. (struct frame): New fields `scrollbars' and `condemned_scrollbars', for use by the scrollbar implementation. [MULTI_FRAME and not MULTI_FRAME] (FRAME_SCROLLBARS, FRAME_CONDEMNED_SCROLLBARS): Accessors for the new field. * window.h (struct window): Doc fix for vertical_scrollbar field. * frame.c (make_frame): Initialize the `scrollbars' and `condemned_scrollbars' fields of the new frame. * alloc.c (mark_object): Mark the `scrollbars' and `condemned_scrollbars' slots of frames. * xterm.c (x_window_to_scrollbar): Scrollbars are chained on frames' scrollbar field, not their x.display->vertical_scrollbars field. (x_scrollbar_create, x_scrollbar_set_handle, x_scrollbar_move, x_scrollbar_remove, XTset_vertical_scrollbar, XTcondemn_scrollbars, XTredeem_scrollbar, XTjudge_scrollbars, x_scrollbar_expose, x_scrollbar_handle_click, x_scrollbar_handle_motion): Substantially rewritten to correct typos and brainos, and to accomodate the lispy structures. * xterm.c (x_scrollbar_background_expose): Function deleted; we don't want anything in the background there after all. (XTread_socket): Don't call x_scrollbar_background_expose. We don't care. * frame.h (FRAME_SAMPLE_VISIBILITY): Make sure frame is marked as garbaged whenever it goes from invisible to visible. * dispextern.h (frame_garbaged): Move extern declaration from here... * frame.h (frame_garbaged): ... to here. The FRAME_SAMPLE_VISIBILITY macro uses it now, and this seems to be just as modular. Make a new page, just for this and message_buf_print. (struct frame): Doc fix for the `visible' field. * process.c: #include "frame.h" instead of "dispextern.h"; the only thing we care about from it is the frame_garbaged declaration. * ymakefile: Note dependency change. * xfns.c (Fx_create_frame): After mapping the frame, call SET_FRAME_GARBAGED, not just plain FRAME_GARBAGED. * window.c (window_internal_width): New function, which accounts for scrollbars if present. * lisp.h (window_internal_height, window_internal_width): Add extern declarations for these. * dispnew.c (direct_output_for_insert, direct_output_forward_char, buffer_posn_from_coords): Use window_internal_width instead of writing out its definition. * indent.c (compute_motion): Doc fix; mention scrollbars and window_internal_width. (pos_tab_offset, Fvertical_motion): Use window_internal_width instead of writing it out. * window.c (Fpos_visible_in_window_p, Fwindow_width, Fscroll_left, Fscroll_right): Same. * xdisp.c (redisplay, try_window, try_window_id, display_text_line): Same. * xdisp.c (display_string): Add new variable `f', to be W's frame. Use it to set desired_glyphs, and to get the frame's width to decide whether or not to draw vertical bars. * xdisp.c (display_text_line): If we're using vertical scrollbars, don't draw the vertical bars separating side-by-side windows. (display_string): Same thing. Draw spaces to fill in the part of the mode line that is under the scrollbar in partial-width windows. * xfns.c (Qvertical_scrollbars): New symbol. Use it as the name of the parameter which decides whether or not the frame has scrollbars, instead of Qvertical_scrollbar. (Fx_create_frame): Adjusted accordingly. (syms_of_xfns): Initialize and staticpro Qvertical_scrollbars. (x_set_vertical_scrollbar): Renamed to x_set_vertical_scrollbars. (x_frame_parms): Adjusted accordingly. * xterm.h (CHAR_TO_PIXEL_WIDTH, CHAR_TO_PIXEL_HEIGHT, PIXEL_TO_CHAR_WIDTH, PIXEL_TO_CHAR_HEIGHT): Rewritten, using: (CHAR_TO_PIXEL_ROW, CHAR_TO_PIXEL_COL, PIXEL_TO_CHAR_ROW, PIXEL_TO_CHAR_COL): New macros. * xfns.c [not HAVE_X11] (Fx_create_frame): Use the PIXEL_TO_CHAR_{HEIGHT,WIDTH} macros to figure the frame's character size, and the CHAR_TO_PIXEL* macros for vice versa. * xterm.c (XTwrite_glyphs, XTclear_end_of_line, stufflines, scraplines, dumprectangle, pixel_to_glyph_coords, x_draw_box, clear_cursor, x_display_bar_cursor, x_draw_single_glyph, x_set_mouse_position): Use the CHAR_TO_PIXEL_* macros. * xterm.c (x_wm_set_size_hint): The max_width and max_height members of the size_hints are expressed in pixels, not columns. * xterm.c (x_set_window_size): Remove ibw var; it's not used. Set FRAME_WIDTH (f) to cols instead of rows. Duh. * xterm.c (pixel_to_glyph_coords): Properly set *bounds to the character cell bounding the position, even when the position is off the frame. * xfns.c (x_set_name): To request that the modelines be redrawn, execute the statement "update_mode_lines = 1;" instead of the silly statement "update_mode_lines;". * xfns.c (x_set_vertical_scrollbars): Don't try to set the X window's size if the frame's X window hasn't been created yet. * xfns.c (x_figure_window_size): Set the frame's vertical_scrollbar_extra field before trying to calculate its pixel dimensions. * xfns.c (x_window): When calling x_implicitly_set_name for the sake of drawing the name for the first time, remember to clear and set the frame's explicit_name member as well as its name member. (Fx_create_frame): Set the frame's explicit_name member if the user specified the name explicitly. * xdisp.c (display_text_line): Use the usable internal width of the window, as calculated above, as the limit on the length of the overlay arrow's image, rather than using the window's width field, less one. * xdisp.c (redisplay): Call condemn_scrollbars_hook and judge_scrollbars_hook whenever they are set, not just when the frame has vertical scrollbars. * termhooks.h (mouse_position_hook): Doc fix. (set_vertical_scrollbar_hook): This doesn't return anything any more, and doesn't take a struct scrollbar * argument any more. (condemn_scrollbars_hook, redeem_scrollbar_hook, judge_scrollbars_hook): Doc fixes. * term.c (mouse_position_hook): Doc fix. (set_vertical_scrollbar_hook): This doesn't return anything any more. Doc fixes. * keyboard.c (kbd_buffer_get_event): Receive the scrollbar's window from *mouse_position_hook and pass it to make_lispy_movement, instead of working with a pointer to a struct scrollbar. (make_lispy_event): We don't need a window_from_scrollbar function anymore; we are given the window directly in *EVENT. Unify the code which generates text-area mouse clicks and scrollbar clicks; use the same code to distinguish clicks from drags on the scrollbar as in the text area. Distinguish clicks from drags by storing a copy of the lispy position list returned as part of the event. (button_down_location): Make this a lisp vector, rather than an array of random structures. (struct mouse_position): Remove this; it's been replaced by a lisp list. (make_lispy_movement): Accept the scrollbar's window as a parameter, rather than the scrollbar itself. If FRAME is zero, assume that the other arguments are garbage. (syms_of_keyboard): No need to staticpro each window of button_down_location now; just initialize and staticpro it. * window.c (window_from_scrollbar): Function deleted; no longer needed. * xdisp.c (redisplay_window): Just pass the window to set_vertical_scrollbar hook; don't pass the scrollbar object too. * xterm.c (XTmouse_position): Don't return a pointer to the scrollbar for scrollbar motion; instead, return the scrollbar's window. * xterm.c (XTmouse_position): Entirely rewritten, using XTranslateCoordinates. Call x_scrollbar_report_motion to handle scrollbar movement events. (x_scrollbar_report_motion): New function, to help out XTmouse_position. * keyboard.c (apply_modifiers): Don't assume that the Qevent_kind property of BASE is set when we first create the new modified symbol. Check that the Qevent_kind property is properly set each time we return any symbol. * termhooks.h (struct input_event): Replace the frame member with a Lisp_Object member by the name of frame_or_window. Doc fixes. Remove the scrollbar member; instead, use frame_or_window to hold the window whose scrollbar was clicked. * keyboard.c (kbd_buffer_store_event, kbd_buffer_get_event, make_lispy_event): Adjust references to frame member of struct input_event to use frame_or_window now. * xterm.c (construct_mouse_click, XTread_socket): Same. * xterm.c (last_mouse_bar, last_mouse_bar_frame, last_mouse_part, last_mouse_scroll_range_start, last_mouse_scroll_range_end): Replaced with... (last_mouse_scrollbar): New variable. (note_mouse_movement): Clear last_mouse_scrollbar when we have receieved a new motion. (syms_of_xterm): Staticpro last_mouse_scrollbar. * xterm.c (note_mouse_position): Renamed to note_mouse_movement, because that's what it really does. (x_scrollbar_handle_motion): Renamed to x_scrollbar_note_movement, for consistency. (XTread_socket): Adjusted. * xterm.c (XTset_scrollbar): Renamed to XTset_vertical_scrollbar. (x_term_init): Adjusted. * keyboard.c (kbd_buffer_frames): Renamed to kbd_buffer_frame_or_window, and made to exist even when MULTI_FRAME isn't defined; single-frame systems might have scrollbars. Use it to GCPRO the frame_or_window field in the event queue. (kbd_buffer_store_event, kbd_buffer_get_event, stuff_buffered_input): Set and clear the appropriate element of kbd_buffer_frame_or_window, whether or not MULTI_FRAME is #defined. (read_avail_input): When reading characters directly from stdin, set the frame_or_window field of the event appropriately, depending on whether or not MULTI_FRAME is #defined. (Fdiscard_input, init_keyboard): Zap kbd_buffer_frame_or_window, not kbd_buffer_frames. (syms_of_keyboard): Initialize and staticpro kbd_buffer_frame_or_window, whether or not MULTI_FRAME is #defined. * keyboard.c (head_table): Make Qscrollbar_movement have a Qevent_kind property of Qmouse_movement, not Qscrollbar_movement. * keyboard.c (read_key_sequence): If we decide to throw away a mouse event which has prefix symbols (`mode-line', `vertical-scrollbar', etcetera), remember that we may have to unwind two characters, not just one. * keyboard.c (read_key_sequence): Doc fixes. * keyboard.c (kbd_buffer_store_event): Fix reversed sense of test for focus redirection. * keyboard.c (read_char): Don't echo mouse movements. * emacs.c (shut_down_emacs): New function. (fatal_error_signal, Fkill_emacs): Call it, instead of writing it out. * xterm.c (x_connection_closed): Call shut_down_emacs instead of Fkill_emacs; the latter will try to perform operations on the X server and die a horrible death. * lisp.h (shut_down_emacs): Add extern declaration for it. * xterm.c (x_error_quitter): Move the abort call to after we print the error message. No harm in that. * xdisp.c (echo_area_display): Move the assignment of f and the check for visibility out of the "#ifdef MULTI_FRAME" clause; they should work under any circumstances. * xdisp.c (redisplay_window): If we're not going to redisplay this window because it's a minibuffer whose contents have already been updated, go ahead and jump to the scrollbar refreshing code anyway; they still need to be updated. Initialize opoint, so it's known to be valid when we jump. Calculate the scrollbar settings properly for minibuffers, no matter what they are displaying at the time. * xdisp.c (redisplay_windows): Don't restore the current buffer and its point before refreshing the scrollbars; we need the buffer accurate. Tue Jan 12 19:23:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * print.c (float_to_string): Add final 0 if text ends with decimal pt. * dispnew.c (Fredraw_display): Redraw all visible frames. Make the non-multi-frame version interactive. Mon Jan 11 18:15:18 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Fset_default_file_modes, Fdefault_file_modes): Renamed from Fset_umask and Fumask; sense of arg is reversed. (Fwrite_region): Doc fix. Sun Jan 10 11:42:28 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * print.c (float_to_string): Add `.0' at end if needed. * lread.c (Fload): If warn that .elc file is older, inhibit the ordinary message that would follow. Sat Jan 9 12:12:31 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as described in doc string. Fri Jan 8 04:07:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fns.c (Frandom): Change arg name. * editfns.c: Doc fixes. Thu Jan 7 05:21:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * unexhp9k800.c (unexec): Don't call exit, just return. Thu Jan 7 03:43:09 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * config.h.in: protect against multiple #inclusions. * config.h.in: Add a declaration for getenv. * xfns.c (Fx_get_resource): Add CLASS argument, to give class of ATTRIBUTE. [not HAVE_X11]: Change definition of Fx_get_resource macro accordingly. (x_get_arg): Add CLASS argument, to give the class of ATTRIBUTE. Pass it along to Fx_get_resource. (x_figure_window_size, x_icon): Pass new argument to x_get_arg. (x_default_parameter): Add XCLASS argument, to give the class of XPROP. Pass it along to x_get_arg. (Fx_create_frame): Pass new args to x_get_arg and x_default_parameter. * xfns.c (Fx_create_frame): Use the same resource names and classes as xterm and Emacs 18. Sun Jan 3 18:40:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (Fx_get_resource): Use EMACS_CLASS to make class_key even if SUBCLASS is specified. I don't know whether that is right, but that's what the doc says. Cosmetic changes in arg names and doc string. Tue Dec 29 21:58:10 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * ralloc.c: [! emacs] [HAVE_CONFIG_H]: #include "config.h" Mon Dec 21 13:26:29 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * Makefile.in (tagsfiles): New variable. (TAGS): Depend on $(tagsfiles); use that in cmds. (tags): Separate phony rule; depends on TAGS. Mon Dec 21 00:02:02 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * keyboard.c: Protect all references to kbd_buffer_frames with #ifdef MULTI_FRAME. * frame.h (struct frame): New fields `can_have_scrollbars' and `has_vertical_scrollbars'. (FRAME_CAN_HAVE_SCROLLBARS, FRAME_HAS_VERTICAL_SCROLLBARS): New accessors, for both the MULTI_FRAME and non-MULTI_FRAME. (VERTICAL_SCROLLBAR_WIDTH, WINDOW_VERTICAL_SCROLLBAR, WINDOW_VERTICAL_SCROLLBAR_COLUMN, WINDOW_VERTICAL_SCROLLBAR_HEIGHT): New macros. * window.h (struct window): New field `vertical_scrollbar'. * xterm.h (struct x_display): vertical_scrollbars, judge_timestamp, vertical_scrollbar_extra: New fields. (struct scrollbar): New struct. (VERTICAL_SCROLLBAR_PIXEL_WIDTH, VERTICAL_SCROLLBAR_PIXEL_HEIGHT, VERTICAL_SCROLLBAR_LEFT_BORDER, VERTICAL_SCROLLBAR_RIGHT_BORDER, VERTICAL_SCROLLBAR_TOP_BORDER, VERTICAL_SCROLLBAR_BOTTOM_BORDER, CHAR_TO_PIXEL_WIDTH, CHAR_TO_PIXEL_HEIGHT, PIXEL_TO_CHAR_WIDTH, PIXEL_TO_CHAR_HEIGHT): New accessors and macros. * frame.c (make_frame): Initialize the `can_have_scrollbars' and `has_vertical_scrollbars' fields of the frame. * term.c (term_init): Note that TERMCAP terminals don't support scrollbars. (mouse_position_hook): Document new args. (set_vertical_scrollbar_hook, condemn_scrollbars_hook, redeem_scrollbar_hook, judge_scrollbars_hook): New hooks. * termhooks.h: Declare and document them. (enum scrollbar_part): New type. (struct input_event): Describe the new form of the scrollbar_click event type. Change `part' from a Lisp_Object to an enum scrollbar_part. Add a new field `scrollbar'. * keyboard.c (kbd_buffer_get_event): Pass appropriate new parameters to *mouse_position_hook, and make_lispy_movement. * xfns.c (x_set_vertical_scrollbar): New function. (x_figure_window_size): Use new macros to calculate frame size. (Fx_create_frame): Note that X Windows frames do support scroll bars. Default to "yes". * xterm.c: #include and "window.h". (x_vertical_scrollbar_cursor): New variable. (x_term_init): Initialize it. (last_mouse_bar, last_mouse_bar_frame, last_mouse_part, last_mouse_scroll_range_start, last_mouse_scroll_range_end): New variables. (XTmouse_position): Use them to return scrollbar movement events. Take new arguments, for that purpose. (x_window_to_scrollbar, x_scrollbar_create, x_scrollbar_set_handle, x_scrollbar_remove, x_scrollbar_move, XTset_scrollbar, XTcondemn_scrollbars, XTredeem_scrollbar, XTjudge_scrollbars, x_scrollbar_expose, x_scrollbar_background_expose, x_scrollbar_handle_click, x_scrollbar_handle_motion): New functions to implement scrollbars. (x_term_init): Set the termhooks.h hooks to point to them. (x_set_window_size): Use new macros to calculate frame size. Set vertical_scrollbar_extra field. (x_make_frame_visible): Use the frame accessor FRAME_HAS_VERTICAL_SCROLLBARS to decide if we need to map the frame's subwindows as well. (XTread_socket): Use new size-calculation macros from xterm.h when processing ConfigureNotify events. (x_wm_set_size_hint): Use PIXEL_TO_CHAR_WIDTH and PIXEL_TO_CHAR_HEIGHT macros. * ymakefile (xdisp.o): This now depends on termhooks.h. (xterm.o): This now depends on window.h. * xdisp.c: #include "termhooks.h". (redisplay, redisplay_window): Use set_vertical_scrollbar_hook, condemn_scrollbars_hook, redeem_scrollbar_hook, and judge_scrollbars_hook to make scrollbars redisplay properly. * keyboard.c (Qscrollbar_movement, Qvertical_scrollbar, Qabove_handle, Qhandle, Qbelow_handle): New symbols. (make_lispy_event): New code to build scrollbar clicks. (make_lispy_movement): New code to handle scrollbar movement. (head_table): Include Qscrollbar_movement in the event heads. (syms_of_keyboard): Init and staticpro Qvertical_scrollbar, Qabove_handle, Qhandle, and Qbelow_handle. * keyboard.h (Qscrollbar_movement): Declare this along with the other event types. * lisp.h (Qvertical_scrollbar): Declare this. * window.c (window_from_scrollbar): New function. * xterm.h (struct x_display): Delete v_scrollbar, v_thumbup, v_thumbdown, v_slider, h_scrollbar, h_thumbup, h_thumbdown, h_slider, v_scrollbar_width, h_scrollbar_height fields. * keyboard.c (Qvscrollbar_part, Qvslider_part, Qvthumbup_part, Qvthumbdown_part, Qhscrollbar_part, Qhslider_part, Qhthumbup_part, Qhthumbdown_part, Qscrollbar_click): Deleted; part of an obsolete interface. (head_table): Removed from here as well. (syms_of_keyboard): And here. * keyboard.h: And here. (POSN_SCROLLBAR_BUTTON): Removed. * xscrollbar.h: File removed - no longer necessary. * xfns.c: Don't #include it any more. (Qhorizontal_scroll_bar, Qvertical_scroll_bar): Deleted. (syms_of_xfns): Don't initialize or staticpro them. (gray_bits): Salvaged from xscrollbar.h. (x_window_to_scrollbar): Deleted. (x_set_horizontal_scrollbar): Deleted. (enum x_frame_parm, x_frame_parms): Remove references to x_set_horizontal_scrollbar. (x_set_foreground_color, x_set_background_color, x_set_border_pixel): Remove special code to support scrollbars. (Fx_create_frame): Remove old scrollbar setup code. (install_vertical_scrollbar, install_horizontal_scrollbar, adjust_scrollbars, x_resize_scrollbars): Deleted. * xterm.c (construct_mouse_click): This doesn't need to take care of scrollbar clicks anymore. (XTread_socket): Remove old code to support scrollbars. Call new functions instead for events which occur in scrollbar windows. (XTupdate_end): Remove call to adjust_scrollbars; the main redisplay code takes care of that now. (enum window_type): Deleted. * ymakefile: Note that xfns.o no longer depends on xscrollbar.h. * xterm.c (x_set_mouse_position): Clip mouse position to be within frame. * xterm.c: Adjust the first line of each page to have a reasonable description. This makes pages-directory more useful. * xterm.c (x_do_pending_expose): Declare this routine only if HAVE_X11 is not #defined; X11 doesn't need it. (XTread_socket): Protect call to x_do_pending_expose with `#ifdef HAVE_X11'. * xfns.c (syms_of_xfns): Delete defvars for x_mouse_x and x_mouse_y. That interface hasn't been live for years. (x_mouse_x, x_mouse_y): Delete these variables. * xterm.c (notice_mouse_movement): Deleted; obsolete and unused. * keyboard.c (Fread_key_sequence): Doc fix. * keyboard.c (make_lispy_event): Buttons are numbered starting with zero now. * keyboard.c (make_lispy_event): Use the proper accessors when manipulating the `x' and `y' fields of struct input_event. * keyboard.c (parse_modifiers_uncached): Remember that strncmp returns zero if the two substrings are equal. * keyboard.c (do_mouse_tracking, Ftrack_mouse): Doc fix. * keyboard.c (read_char): Don't put mouse movements in this_command_keys. * xfns.c (Fx_create_frame): Don't initialize the wm_hints field here. (x_window): Do it here, along with all the similar stuff. Mon Dec 21 00:37:34 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * callint.c (Fcall_interactively): For `s', use Fread_string. Sun Dec 20 21:41:31 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) Properly handle focus shift events, so the cursor is filled and hollow at the appropriate times, even in titleless windows. * xterm.c (x_focus_event_frame): New variable. (XTread_socket): When we receive a FocusIn event that's not NotifyPointer, record the frame in x_focus_event_frame. When we receive a FocusOut event that's not NotifyPointer, clear it. When we get a LeaveNotify event, don't take it seriously if we still have focus. * xterm.c (XTread_socket): Remove special code in EnterNotify case to handle scrollbars and fake mouse motion events. Sat Dec 19 06:50:39 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * floatfns.c (Flog): Fix unescaped newline in string. * frame.c (Fnext_frame): Same. * textprop.c (Fprevious_single_property_change): Same. (syms_of_textprop): Same, for DEFVAR for `interval_balance_threshold'. Change the meaning of focus redirection to make switching windows work properly. Fredirect_frame_focus has the details. * frame.h (focus_frame): Doc fix. [not MULTI_FRAME] (FRAME_FOCUS_FRAME): Make this Qnil, which indicates no focus redirection, instead of zero, which is selected_frame. * frame.c (make_frame): Initialize f->focus_frame to Qnil, rather than making it point to frame itself. (Fselect_frame): If changing the selected frame from FOO to BAR, make all redirections to FOO shift to BAR as well. Doc fix. (Fredirect_frame_focus): Doc fix. Accept nil as a valid redirection, not just as a default for FRAME. (Fframe_focus): Doc fix. * keyboard.c (kbd_buffer_store_event, kbd_buffer_get_event): Deal with focus redirections being nil. * xterm.c (XTframe_rehighlight): Doc fix. Deal with focus redirections being nil. * window.c (Fset_window_configuration): Don't restore the frame's focus redirection if the target frame is now dead. * ymakefile (ralloc.o): This no longer depends on xterm.h. * ymakefile (all, xemacs): We build an executable called `emacs' now, not `xemacs'. * Makefile.in (distclean, xemacs, doxemacs): Same. * xterm.h (PIXEL_WIDTH, PIXEL_HEIGHT): Change name of parameter from `s' to `f'; it's a frame pointer. Fri Dec 18 08:28:14 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * keyboard.c (kbd_buffer_frames): New vector, to GCPRO frames in kbd_buffer. (kbd_buffer_store_event): When we add an event to kbd_buffer, make sure to store its frame in kbd_buffer_frames. (kbd_buffer_get_event): When we remove an event from kbd_buffer, make sure to set the corresponding element of kbd_buffer_frames to Qnil, to allow the frame to get GC'd. (Fdiscard_input, init_keyboard): Clear all elements of kbd_buffer_frames to nil. (syms_of_keyboard): Create and staticpro kbd_buffer_frames. * xterm.c (x_error_quitter): Just abort, so we can look at the core to see what happened. Thu Dec 17 06:23:11 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * buffer.c (Frename_buffer): Set update_mode_lines. Mon Dec 14 03:29:39 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * scroll.c (do_scrolling): When bcopying the max_ascent field from current_frame to temp_frame, remember that max_ascent is an array of shorts, not ints. It's a pain to remember that you can't assign to FRAME->visible. Let's change all references to the `visible' member of struct frame to use the accessor macros, and then write a setter for the `visible' field that does the right thing. * frame.h (FRAME_VISIBLE_P): Make this not an l-value. (FRAME_SET_VISIBLE): New macro. * frame.c (make_terminal_frame, Fdelete_frame): Use FRAME_SET_VISIBLE. (Fframe_visible_p, Fvisible_frame_list): Use FRAME_VISIBLE_P and FRAME_ICONIFIED_P. * dispnew.c (Fredraw_display): Use the FRAME_VISIBLE_P and FRAME_GARBAGED_P accessors. * xdisp.c (redisplay): Use the FRAME_VISIBLE_P accessor. * xfns.c (x_set_foreground_color, x_set_background_color, x_set_cursor_color, x_set_border_pixel, x_set_icon_type): Use the FRAME_VISIBLE_P accessor. (Fx_create_frame): Use FRAME_SET_VISIBILITY. * xterm.c (clear_cursor, x_display_bar_cursor, x_display_box_cursor): Use FRAME_SET_VISIBILITY. Sat Dec 12 01:04:03 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * ymakefile (CFLAGS): #define HAVE_CONFIG_H too. * Makefile.in (distclean): Don't delete machine.h or system.h; they don't exist anymore. * Makefile.in (distclean): Don't delete autosave or backup files. (extraclean): New target; like distclean, but delete autosave and backup files too. Fri Dec 11 01:03:48 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * search.c (Fskip_chars_forward, Fskip_chars_backward): Return the distance traveled. (skip_chars): Return the distance traveled, as a Lisp_Object. * macros.c (Fend_kbd_macro): Don't use XFASTINT to check if arg is negative; XFASTINT only works on values known to be positive. (Fexecute_kbd_macro): Check QUIT in the repetition loop. If the macro is null, no characters are actually being read, so this matters. * Makefile.in (srcdir): New variable, not fully implemented. (xmakefile): Turn -g and -O in CFLAGS into C_DEBUG_SWITCH and C_OPTIMIZE_SWITCH in C_SWITCH_SITE's definition. Delete junk.cpp when done. * ymakefile (archlib): Variable definition deleted. Run programs from ../lib-src directly, or use ${archlibdir}. (${etc}DOC): Run make-docfile from ${libsrc}, not ${archlib}. (${archlib}make-docfile, ${archlib}emacstool): Use ${libsrc}, not ${archlib}. * ymakefile (lisp): Don't include version.el in this list. Give subprocess creation a way to find a valid current directory for subprocesses when the buffer's default-directory is a handled name. * fileio.c (Funhandled_file_name_directory): New function. (Qunhandled_file_name_directory): New file-name-handler operation. (syms_of_fileio): Defsubr Sunhandled_file_name_directory, and initialize and staticpro Qunhandled_file_name_directory. * callproc.c (Fcall_process): Call Funhandled_file_name_directory on the buffer's default directory. Do it earlier in the function so there's less to GCPRO. * process.c (create_process): Don't check the validity of the buffer's default directory here... (Fstart_process): Instead, do it here; if we call Funhandled_file_name_directory here, there's less GCPROing to do. * callproc.c (Fcall_process_region): Return the value returned by Fcall_process. * fileio.c (find_file_handler): Rename this to Ffind_file_name_handler, and make it visible to lisp. Add a QUIT to the loop which scans file-name-handler-alist. All uses changed. (syms_of_fileio): Mention this new function in the docstring for Vfile_name_handler_alist. defsubr Sfind_file_name_handler. * lisp.h (Ffind_file_name_handler): Added extern declaration. * dired.c: All uses of find_file_handler changed here too. * fileio.c (syms_of_fileio): Add staticpros for Qexpand_file_name, Qdirectory_file_name, Qfile_name_directory, Qfile_name_nondirectory, Qfile_name_as_directory. Mon Dec 7 00:49:00 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * window.c (Fset_window_configuration): If we're restoring the configuration of a dead frame, don't bother rebuilding its window tree, restoring its focus redirection, or temporarily resizing it to fit the saved window configuration. If the frame which was selected when the configuration was captured is now dead, don't try to select it. * frame.c (Fdelete_frame): Delete all the windows in the frame's window tree, using delete_all_subwindows. * window.c (delete_all_subwindows): Don't make this static anymore. Thu Dec 3 20:24:08 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) Make sure that frames' visible flag only changes at acceptable times. See FRAME_SAMPLE_VISIBILITY's comments for details. * frame.h (struct frame): New fields called async_visible and async_iconified. (FRAME_SAMPLE_VISIBILITY): New macro, with MULTI_FRAME and non-MULTI_FRAME definitions. * xdisp.c (redisplay): Call FRAME_SAMPLE_VISIBILITY to set the visible and iconified flags appropriately for each frame. (message1): Call FRAME_SAMPLE_VISIBILITY to set the visible and iconified flags for the minibuffer frame. * frame.c (make_frame): Initialize async_visible and async_iconified properly. * xfns.c (Fx_create_frame): Initialize f->async_visible too. * xterm.c (XTread_socket): When we get MapNotify, UnmapNotify, Expose, ExposeWindow, or UnmapWindow, set f->async_visible, not f->visible. (x_do_pending_expose, x_raise_frame, x_lower_frame, x_make_frame_invisible, x_make_frame_visible, x_iconify_frame): Test and set f->async_visible and f->async_iconified, not f->visible or f->async_iconified. * keyboard.c (kbd_store_ptr): Declare this to be volatile, if __STDC__ is #defined. (Fdiscard_input): Use cast to keep GCC from complaining about the assignment of kbd_store_ptr to kbd_fetch_ptr. * xdisp.c (redisplay): Use FOR_EACH_FRAME to apply redisplay_windows to the root window of each frame. This makes a #ifdef MULTI_FRAME unneeded, but it also means we recompute buffer_shared from scratch even on non-MULTI_FRAME configurations. Don't skip elements of Vframe_list that aren't frames; go ahead and crash here. * xdisp.c (redisplay): Remove #ifdef MULTI_FRAME around the code which updates separate minibuffer frames specially; there's nothing there that won't work on a single-frame configuration. * dispextern.h (struct frame_glyphs): Doc fix. Wed Dec 2 20:08:08 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * dispnew.c: Remove dyked-out copy of safe_bcopy. * environ.c: File removed; Changes on 1/13/1992 made it unnecessary. Tue Dec 1 23:42:25 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * process.c (wait_reading_process_input): Doc fix. Thu Nov 26 13:17:11 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * next.h: Copy changes from 18.59: (NeXT): Defined. (BIG_ENDIAN): Define only if __BIG_ENDIAN__. (m68000, COMPILER_REGISTER_BUG): Defs deleted. (SIGN_EXTEND_CHAR, LIB_X11_LIB, NO_T_CHARS_DEFINES, UNEXEC): Defined. (LIBS_DEBUG, LIB_GCC, C_SWITCH_MACHINE, ORDINARY_LINK): Defined. (TEXT_START, TEXT_END, DATA_END, LD_SWITCH_MACHINE): Defined. (KERNEL_FILE): #undef it. (environ): Define as _environ. Wed Nov 25 10:17:28 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * doc.c (store_function_docstring): New function, made from part of Fsnarf_documentation, which handles docstrings for macros properly. (Fsnarf_documentation): Call store_function_docstring. * data.c (indirect_function): Delete unused argument ERROR. Mon Nov 23 20:26:17 1992 Jim Blandy (jimb@apple-gunkies.gnu.ai.mit.edu) * Makefile.in (clean): Remove prefix-args. Sat Nov 21 17:12:19 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sol2.h (LD_SWITCH_SYSTEM): Make alternate version for GCC. Thu Nov 19 16:54:22 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * m/sparc.h: Don't include here; that screws up the xmakefile. Instead, include it in getloadavg.c, which is the only place that uses LOAD_AVE_CVT, which is the only reason was here in the first place. Sun Nov 15 00:46:41 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * dispnew.c [not MULTI_FRAME] (Fredraw_display): Pass the correct number of arguments to mark_window_display_accurate. * undo.c (Fprimitive_undo): Remove whitespace in front of #ifdef and #endif. * systty.h: Doc fix. * systty.h, process.c, buffer.h, callproc.c, sysdep.c, dired.c: Added VMS changes from Roland Roberts. * vmspaths.h: New version from Roland Roberts. * xdisp.c (display_string): Use w's buffer's value of tab-width to display the string, instead of the current buffer's, which could be anything. * s/sol2.h (LD_SWITCH_SYSTEM): Add -R option. * process.c (read_process_output): Save, widen, insert the process output, and then restore the restriction if inserting text outside the visible region. Sat Nov 14 21:18:02 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * buffer.c (Ferase_buffer): Doc fix. * dispnew.c (safe_bcopy): Use the right terminating condition in the loop which uses multiple bcopy calls to transfer a block to an overlapping higher block. Fri Nov 13 03:44:48 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * process.c (Fstart_process): Establish an unwind-protect to remove PROC from the process list if an error occurs while starting it. (start_process_unwind): New function to help with that. (create_process): There's no need to explicitly call remove_process if the fork fails; the record_unwind_protect in Fstart_process will take care of it. * commands.h (unread_command_event): Doc fix. Don't ever throw away switch-frame events. * lread.c: #include "keyboard.h". (Fread_char, Fread_char_exclusive): Don't signal an error for or throw away switch-frame events; instead, put them off until after we've found a character we can respond to. * commands.h (unread_switch_frame): Declare this extern. * keyboard.c (unread_switch_frame): Don't declare this static. * ymakefile (lread.o): Note that this depends on keyboard.h. * keyboard.c (Vlast_event_frame): Doc fix. * process.c (wait_reading_process_input): Test the C preprocessor symbol "ultrix", not "__ultrix__" to see if we should ignore ENOMEM errors from select. * fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the entire string. * buffer.c (Fbury_buffer): Make this behave as in 18.59, although that behavior is very odd - only remove the buffer from the selected window if BUFFER was nil or omitted. * keyboard.c (read_char): Write composite events to the dribble file properly. * keyboard.c (init_keyboard): Initialize Vlast_event_frame to Qnil, rather than the selected frame. * mem-limits.h [DATA_SEG_BITS] (EXCEEDS_LISP_PTR): Remember to remove DATA_SEG_BITS from the pointer before testing if the pointer fits in VALBITS. * Makefile.in (doxemacs, dotemacs): Explicitly pass along the CC variable in these rules, just as in the `doall' rule. * ralloc.c (relocate_some_blocs): Handle BLOC == NIL_BLOC. (free_bloc): This can now be simplified. * ralloc.c (r_alloc_sbrk): When we allocate new space for the malloc heap, zero it out even if we don't have any blocs in the free list. Thu Nov 12 02:01:12 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * process.c (process_send_signal): On systems which have both the TIOCGETC and TCGETA ioctls, just use the former. * xselect.c (Fx_get_cut_buffer): Correct check for buf_num in range. * xselect.c (Fx_get_cut_buffer, Fx_set_cut_buffer): Fix error message format; use NUM_CUT_BUFFERS instead of literal 7. * keyboard.c (lispy_modifier_list): Added sanity check before indexing into modifier_symbols. * keyboard.c (add_command_key): When copying the contents of the old this_command_keys to new_keys, remember to multiply size by sizeof (Lisp_Object) to get the amount we really need to copy. Rename unread_command_char to unread_command_event; it has subtly different semantics now, and we should use `make-obsolete-variable' to warn people. * command.h (unread_command_char): Change name in extern declaration. * keyboard.c (unread_command_char): Rename. (command_loop_1, read_char, Finput_pending, Fdiscard_input, quit_throw_to_read_char, init_keyboard, syms_of_keyboard): Change references. * lread.c (Fread_char): Change reference. * minibuf.c (temp_echo_area_glyphs): Change reference to unread_command_char to unread_command_event. * xfns.c (unread_command_char): Change name in extern declaration to unread_command_event. Wed Nov 11 00:43:40 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * m/pmax.h: Don't define SYSTEM_MALLOC; this was only necessary for Ultrix version 4.1, and the current version is 4.3. * s/bsd4-2.h, s/bsd4-3.h: #define SIGNALS_VIA_CHARACTERS. * process.c (process_send_signal): Put all the code for sending signals via characters in a #ifdef SIGNALS_VIA_CHARACTERS. Decide whether to use the Berkeley-style or SYSV-style ioctls by seeing which ioctl commands are #defined. * minibuf.c (read_minibuf): If get_minibuffer gives the new minibuffer a nil default directory, find another buffer with a better default directory and use that one's instead. Tue Nov 10 23:06:08 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * process.c (process_send_signal): Doc fix. * keyboard.c (read_key_sequence): Don't use save_excursion_{save,restore} to protect the caller against buffer switches; use Fset_buffer and Fcurrent_buffer; redisplay might change point, and we don't want to undo that. * keyboard.c (kbd_buffer_get_event): When checking a mouse movement for a frame switch, don't assume Vlast_event_frame contains a Lisp_Frame object. Fri Nov 6 17:48:59 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/dgux.h (SYSTEM_TYPE): Use berkeley-unix. Wed Nov 4 00:54:59 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * alloc.c: #include "frame.h" unconditionally. frame.h does the right thing when MULTI_FRAME isn't defined. * Makefile.in: Rearrange dependencies to make sure that xmakefile is built before we try to use it, even using a parallel make. Changes for SYSV from Eric Raymond: * process.c [SYSV]: Don't include , , or . (process_send_signal): Don't try to send SIGTSTP unless SIGTSTP is defined. * sysdep.c (init_baud_rate) [HAVE_TERMIO, not HAVE_TCATTR]: Use TCGETA, not TIOCGETP. * systime.h [USG] (EMACS_GET_TZ_OFFSET): Assign to *(offset), not (offset). Don't forget the while corresponding to the do. Include USG in the list of systems that have a tzname array. * keyboard.c (read_key_sequence): Removed the replay_sequence_new_buffer label; replay_sequence should be here instead. Arrange to get compile-time errors for uses of Lisp_Frame in a non-MULTI_FRAME configuration. * lisp.h [not MULTI_FRAME]: Don't declare the Lisp_Frame tag. * minibuf.c (read_minibuf): Protect call to Fredirect_frame_focus with a #ifdef MULTI_FRAME. * window.c (Fset_window_configuration): Protect call to Fselect_frame with a #ifdef MULTI_FRAME. [not MULTI_FRAME] (Fcurrent_window_configuration): Don't bother setting the window configuration's selected_frame member. * keyboard.c (Vlast_event_frame): Arrange for this to exist iff MULTI_FRAME is defined. [not MULTI_FRAME] (syms_of_keyboard): Don't DEFVAR Vlast_event_frame. [not MULTI_FRAME] (read_char): Don't try to set Vlast_event_frame. [not MULTI_FRAME] (kbd_buffer_store_event): Don't try to set Vlast_event_frame for quit characters. [not MULTI_FRAME] (kbd_buffer_get_event): Don't try to generate switch-frame events. * buffer.c (init_buffer): If PWD is accurate, use it instead of calling getwd. #include and , for the call to stat. Indicate whether an autoload form stands for a keymap or not. * eval.c (Fautoload): Renamed fifth argument TYPE. Document the fact that (eq TYPE 'keymap) means FUNCTION will become a keymap when loaded. (Fmacroexpand): Instead of assuming that every autoload form with a fifth element is a macro, actually check the fifth element against t and `macro', which are the only values which denote macroness. * keymap.c (get_keymap_1): Don't try to autoload OBJECT's function unless the autoload form indicates that it's a keymap. Tue Nov 3 20:09:26 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * .gdbinit (mips): New command. Sat Oct 31 18:26:18 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Fmake_directory_internal): Renamed from Fmake_directory. Pass nil as third arg to handler. Lisp function `make-directory' is now in files.el. Fri Oct 30 17:27:22 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) Clean up errors due to treating Lisp_Objects like integers. * abbrev.c (Funexpand_abbrev): Just assign the last abbrev's value to val; don't use XSET. Make sure that the value of the abbrev-symbol is a string. * alloc.c (Frope_elt): Declare arguments to be Lisp_Objects. * buffer.c (reset_buffer): Don't assign to b->save_length as if it were an int; use XFASTINT. * buffer.h (Fbuffer_name, Fget_file_buffer): Added external declarations. * bytecode.c (Fbyte_code): Use EQ to compare string_saved with bytestr. * casefiddle.c (operate_on_word): Declare end to be an int, not a Lisp_Object. * casetab.c (set_case_table): Declare this to be static, and return a Lisp_Object. Add static declaration for this before Fset_case_table and Fset_standard_case_table. (Fset_case_table, Fset_standard_case_table): Return the return value of set_case_table, instead of returning garbage. * commands.h (unread_command_char): Declare this to be a Lisp_Object, not an int. * data.c (Fset): See if current_alist_element points to itself using EQ, not ==. (float_arith_driver): Declare this extern above arith_driver. * dired.c (find_file_handler): Declare this extern. (Ffile_attributes): Use NILP, not == Qnil. * dispextern.h (sit_for): Declare this extern. * doc.c: #include keyboard.h. * floatfns.c (Flog): Don't forget to declare the BASE argument a Lisp_Object. * fns.c: #include keyboard.h. (Fdelete): Check if Fequal returns Qnil, not zero. * frame.c: #include buffer.h. * keyboard.c: #include dispextern.h. (recursive_edit_unwind, command_loop, Fthis_command_keys): Declare these to return Lisp_Objects at the very top of the file, to avoid having them implicitly declared as ints. (echo_char): Use EQ to compare C to help_char. (read_char): Remember to apply XFASTINT to the return value of Flength before using it. Apply XINT to c when clearing its high bits and meta bits, and when writing it to the dribble file. (read_char_menu_prompt): Use EQ to compare obj with menu_prompt_more_char and its control-character analog. (read_key_sequence): Declare PROMPT to be char *, not a Lisp_Object. Use the appropriate accessors on keybuf when looking for ASCII function key sequences. * keyboard.h (get_keymap_1, Fkeymapp, reorder_modifiers, Fmouse_click_p, read_char): Add external declarations for these. * keymap.c (Fdefine_key, Flookup_key, describe_map): Don't assume that Flength returns an integer. * lisp.h (Fdefault_boundp, make_float, Ffloat, Fnth, Fcopy_alist, Fmake_byte_code, Fverify_visited_file_modtime, Ffile_exists_p, Fdirectory_file_name, Ffile_name_directory, expand_and_dir_to_file, Ffile_accessible_directory_p, Fbyte_code, Fundo_boundary, truncate_undo_list): Add extern declarations for these. * lread.c (read_char): Add an extern declaration for this, indicating that it returns a Lisp_Object. * minibuf.c (read_minibuf): Use EQ to compare, not ==. (temp_echo_area_glyphs): Use XFASTINT to assign to unread_command_char. * print.c (print): Cast the frame's address to an integer before passing it to sprintf to form the frame's printed form. * process.c: (status_convert): Declare this to return a Lisp_Object at the top of the file. (decode_status): Don't untag XCONS (tem)->cdr before storing it in tem; tem is a Lisp_Object, too. (process_send_signal): Declare this to be static void. Don't return Qnil; nobody cares. (sigchld_handler): Use XFASTINT to manipulate p->infd. * search.c (Fstore_match_data): Don't assume Flength returns a C integer. * undo.c (record_insert): Use accessors on BEG and LENGTH. (truncate_undo_list): Use NILP, not == Qnil. * window.c (Fwindow_width, Fset_window_hscroll): Use accessors on w->width, w->left, w->hscroll, and arguments. (replace_window): Use EQ, not ==. (Fdelete_window): p->top and p->left are not C integers. (Fnext_window, Fprevious_window): Use EQ, not ==. * window.h (make_window, window_from_coordinates, Fwindow_dedicated_p): Add extern declarations for these. * xdisp.c (redisplay): Use ! EQ to compare the old and new arrow positions, not !=. (mark_window_display_accurate): Barf if WINDOW isn't a window. (display_string): Test buffer_defaults.ctl_arrow using NILP, instead of comparing it with zero. * xfns.c (x_decode_color, Fx_color_display_p): x_screen_planes is an int, not a Lisp_Object. (x_set_mouse_color): Give separate error messages for the different cursors we try to set. (Fx_geometry): Declare STRING to be a Lisp_Object. (Fx_create_frame): No need to use XSET to assign NAME to f->name; they're both Lisp_Objects. (adjust_scrollbars): Use XINT to access w->hscroll. (Fx_open_connection): x_screen_count, x_release, x_screen_height, x_screen_height_mm, x_screen_width, x_screen_width_mm, x_save_under, and x_screen_planes are integers, not Lisp_Objects. (syms_of_xfns): x_mouse_x, x_mouse_y, and mouse_buffer_offset are integers, not Lisp_Objects. * xselect.c (own_selection): selection_type is an X Atom value, not a Lisp_Object. (x_selection_arrival): Declare this static, and add a forward declaration at the top of the page. * xterm.c (x_convert_modifiers): Declare this to return an unsigned int, not a Lisp_Object. Remember that the quiescent value for part is Qnil, not zero, that x_mouse_x and x_mouse_y are ints, not Lisp_Objects, and that RESULT->x and RESULT->y are Lisp_Objects, not ints. (XTread_socket): Declare this to return int, not Lisp_Object. When calling construct_mouse_click on a non-scrollbar click, pass PART as Qnil, not zero. (x_calc_absolute_position): Remember that x_screen_width and x_screen_height are ints, not Lisp_Objects. * xterm.h (x_screen_count, x_release, x_screen_height, x_screen_height_mm, x_screen_width, x_screen_width_mm, x_save_under, x_screen_planes): Declare this as ints, to match their definitions in xterm.c. * ymakefile: Note the new dependencies caused by the new #inclusions above. * xdisp.c (last_arrow_position, last_arrow_string): Make these static. * process.c (pty_process): Variable deleted; it's no longer used. (syms_of_process): Don't initialize it. * buffer.h (struct buffer_local_types): This declaration needed an extern qualifier. * floatfns.c (Fexpt): Don't return the value of the XSET function call; that's not guaranteed to be the value assigned. * dired.c (Ffile_attributes): Doc fix. * lisp.h (DEFVARLISP, DEFVARBOOL, DEFVARINT, DEFVARPERBUFFER): Removed these definitions; we should be using the versions whose names use underscores. * keyboard.c (echobuf): Make this 300 characters, not 100. This isn't a real fix, but it's quick. Fri Oct 30 00:49:57 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * callint.c (preserved_fns): New var. (Fcall_interactively): Preserve all fns listed in preserved_fns. (syms_of_callint): Set preserved_fns and staticpro it. Don't set up Qregion_beginning or Qregion_end. Thu Oct 29 01:28:54 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dispnew.c (count_blanks): Leave argument r constant, and increment p. Wed Oct 28 16:30:55 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * xdisp.c (message): Re-write this in terms of message1. (message1): Move code to clear out echo_area_glyphs and previous_echo_glyphs from message to here. * keyboard.c (read_char): When returning an unread switch-frame event, jump to reread_first to return it, rather than reread; this makes sure the event gets echoed (if appropriate) and goes into this_command_keys. * keyboard.c (read_key_sequence): If the key sequence starts with a mouse click, read the key sequence using the keymaps of the buffer clicked on, not the current buffer. * keyboard.c (unread_switch_frame): Make this static, to indicate that nobody outside of this file uses it. * keymap.c: Deal with autoloaded keymaps properly. (get_keymap_1): Renamed to inner_get_keymap; made static. New argument AUTOLOAD says to pursue autoloads if non-zero. (Fkeymapp, get_keymap, get_keyelt, Flookup_key): Ask get_keymap_1 not to perform autoloads. (Fdefine_key): Ask get_keymap_1 to perform autoloads. Since autoloading may GC, remember that we have to GCPRO our local variables now. (Fminor_mode_key_binding): Call get_keymap instead of calling get_keymap_1 with equivalent arguments. * keyboard.c (follow_key): Ask get_keymap_1 to perform autoloads. (read_key_sequence): When pursuing potential bindings in the function key map, ask get_keymap_1 to perform autoloading. This is hardly important, but it's consistent. * doc.c (Fsubstitute_command_keys): Ask get_keymap_1 to perform autoloads. Autoloading might GC; we need to GCPRO our local variables now. (Fdocumentation, Fdocumentation_property): Autoloading in Fsubstitute_command_keys might GC; we need to GCPRO our local variables now. Wed Oct 28 04:03:11 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/irix3-3.h (HAVE_SETSID, IRIX): Defined. * s/irix4-0.h: New file. Tue Oct 27 23:26:14 1992 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu) * sysdep.c (get_system_name): Use gethostname for USG systems if HAVE_GETHOSTNAME is defined. * s/hpux7.h, s/irix3-3.h (HAVE_GETHOSTNAME): Define it. Tue Oct 27 20:34:26 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * callproc.c: Arrange for synchronous processes to get SIGINT the first time the user quits, or SIGKILL if the user quits again. #include "syssignal.h". (call_process_kill): New function. (call_process_cleanup): Send SIGINT to the subprocess, and then arrange to call call_process_kill if the user quits while we wait for it to terminate. (Fcall_process, Fcall_process_region): Doc fix. Tue Oct 27 01:56:14 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * unexmips.c [sony, IRIS_4D]: Include getpagesize.h and fcntl.h. (unexec): #if 0 the error check of hdr.fhdr.f_nscns. Clear text_section->s_scnptr. * callint.c (Fcall_interactively): Preserve (region-beginning) and (region-end) into the command history when they appear in an interactive spec which is a call to `list'. * batcomp.com: New file. Waiting for papers from richard@ttt.kth.se. Fri Oct 23 16:38:47 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * emacs.c (main): Correct spelling of HAVE_X_WINDOW to HAVE_X_WINDOWS in conditionals around the call to syms_of_xmenu. Fri Oct 23 07:58:36 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ralloc.c (relinquish): Adjust page_break_value by amount of memory actually given back. (r_alloc_sbrk): Provide hysteresis in relocating the blocs. Thu Oct 22 07:53:42 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ralloc.c (relinquish): Sign of arg to *real_morecore was backwards. Wed Oct 21 04:54:52 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ralloc.c (relinquish): Never free less than extra_bytes; keep extra_bytes of empty space. (obtain): Always get extra_bytes additional space. (r_alloc_init): Set extra_bytes and page_size. (ALIGNED, ROUNDUP, ROUND_TO_PAGE): Use page_size. Tue Oct 20 00:17:03 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (syms_of_keyboard): Properly staticpro this_command_keys. * mem-limits.h (get_lim_data): Make it static. * ymakefile (mallocobj): Use vm-limit.o along with ralloc.o. * ralloc.c [emacs]: Define POINTER and SIZE. [!emacs]: Delete definition of EXCEEDS_LISP_PTR. * eval.c (grow_specpdl): Increase max_specpdl_size before Fsignal. Mon Oct 19 14:27:05 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xfns.c (x_set_face): Dyked out this function; it has no callers, and refers to an obsolete version of struct face. * xterm.c (compose_status): New variable. (XTread_socket): Pass it by reference to XLookupString. Sun Oct 18 04:07:15 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/esix5r4.h (BROKEN_FIONREAD): Defined. Fri Oct 16 04:27:32 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/vms5-5.h: New file. Fri Oct 16 00:19:23 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * xdisp.c (message): If M is zero, clear echo_area_glyphs and previous_echo_glyphs, so that the minibuffer shows through. * * editfns.c (Fmessage): With no arguments, clear any active message; let the minibuffer contents show through. * minibuf.c (temp_echo_area_glyphs): Don't clear echo_area_glyphs and previous_echo_glyphs; let message do that work. * keyboard.c (this_command_keys): Make this a vector, instead of an array of Lisp_Objects. (this_command_keys_size): Deleted. (echo, add_command_key, Fthis_command_keys): Adjusted appropriately. (init_keyboard): Don't allocate it here. (syms_of_keyboard): Allocate it here, and staticpro it. * keyboard.h (this_command_keys): Extern declaration changed. Doc fix. * callint.c (Fcall_interactively): Change handling of 'e' spec; this_command_keys is now a vector. * keyboard.c (read_char): Call ourselves with the appropriate number of arguments. (read_char_menu_prompt): If USED_MOUSE_MENU is zero, don't try to store things in it. * window.c: Try to deal coherently with deleted windows: * (Flive_window_p): New function. (Qlive_window_p): New variable, to name it in type errors. (syms_of_window): Defsubr Slive_window_p, init and staticpro Qlive_window_p. * lisp.h (CHECK_LIVE_WINDOW): New predicate. (Qlive_window_p): Extern declaration for this. * window.c (decode_window): Use CHECK_LIVE_WINDOW instead of CHECK_WINDOW; the only thing a user should be able to do to a dead window is check its type. (Fcoordinates_in_window_p, Fnext_window, Fprevious_window, Fdelete_other_windows, Fselect_window, Fsplit_window, Fscroll_other_window): Use CHECK_LIVE_WINDOW instead of CHECK_WINDOW. * frame.c (make_frame_without_minibuffer, Fwindow_frame): Same. * sunfns.c (Fsun_menu_internal): Same. * xmenu.c (Fx_popup_menu): Same. * window.c (Fdelete_window): If WINDOW is a deleted window, do nothing; there's no harm in allowing people to delete deleted windows. Delete all of WINDOW's subwindows, too. (delete_all_subwindows): Set the buffer, vchild, and hchild of the windows we delete all to nil. * window.h (struct window): Doc fix. * window.c (Fwindow_minibuffer_p): Make the WINDOW argument optional, like all the other window-querying functions. * window.c (Fpos_visible_in_window_p): Use decode_window to handle the WINDOW argument, instead of writing out that function's code. * window.c (check_frame_size): Don't define this extern; that doesn't mean anything. * xterm.c: Clean up some of the caps lock handling: (x_shift_lock_mask): New variable. (x_find_modifier_mappings): Set it, based on the modifier mappings. (x_convert_modifiers): Use x_shift_lock_mask, instead of assuming that the lock bit always means to shift the character. (XTread_socket): When handling KeyPress events, don't pass an XComposeStatus structure along to XLookupString. When handling MappingNotify events, call XRefreshKeyboardMapping for both MappingModifier and MappingKeyboard events, not just the latter. Thu Oct 15 22:20:52 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * window.c (Fdelete_window): Choose an alternative when we delete any frame's selected window, not just when we delete the selected frame's selected window. Thu Oct 15 19:44:00 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * vm-limit.c (check_memory_limits): Declare __morecore. Remove unused variable `result'. Thu Oct 15 19:29:28 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * vm-limit.c (morecore_with_warning): Removed. (check_memory_limits): New fn; most code from morecore_with_warning, but only checks limits, doesn't do any work. (memory_warnings): Set __after_morecore_hook to check_memory_limits; don't set __morecore. Wed Oct 14 15:35:52 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * intervals.c (traverse_intervals): New parameter `depth'. Increment this when passing recursively. * alloc.c (mark_interval_tree): Pass 0 as initial depth argument to traverse_intervals. * xterm.h: Declaration of struct face removed. * dispextern.h: New element of frame structure `max_ascent'. Removed elements `nruns' and `face_list'. LINE_HEIGHT and LINE_WIDTH macros removed. New struct face with associated typedef FACE declared, along with accessing macros. * scroll.c (do_scrolling): Don't bcopy non-existant `nruns' or `face_list' elements. Do copy new `max_ascent' frame element. * dispnew.c (scroll_frame_lines): All references to frame elements `nruns' and 'face_list' removed. Handle new element `max_ascent'. (free_frame_glyphs): Don't free nonexistent elements `nruns' and `face_list'; do free `max_ascent' element. (make_frame_glyphs): Don't allocate nonexistent elements `nruns' and `face_list'; do allocate `max_ascent' element. (update_frame): Replaced use of macro LINE_HEIGHT with element frame element `pix_height'. Wed Oct 14 00:07:19 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * keyboard.c (modify_event_symbol): Arrange to set the click_modifier bit on otherwise unmodified mouse clicks. * keymap.c (store_in_keymap): Don't forget to QUIT in the keymap-scanning loop. Don't treat vectors as binding tables if they're the wrong length. Mon Oct 12 18:11:03 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * keyboard.c (kbd_buffer_get_event): Remember that *mouse_position_hook may set *FRAME to 0; don't generate switch-frame events in this case. Fix fencepost bug in fetching events from keyboard buffer. Mon Oct 12 18:05:23 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ymakefile (ralloc.o): Delete dep mem_limits.h (vm-limit.o): Rename dep to mem-limits.h. Mon Oct 12 17:40:50 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * ralloc.c: Removed #include "mem-limits.h". [emacs]: Moved #undef NULL and #include "getpagesize.h" here. [! emacs]: #include , , . (r_alloc_init): Use NIL, not NULL. Mon Oct 12 17:07:25 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * ralloc.c (sbrk): Removed decl. (real_morecore): New static variable. (warnlevel, warn_function, check_memory_limits): Removed. (obtain): Don't call check_memory_limits. (obtain, relinquish, r_alloc_sbrk): Use (*real_morecore) in place of sbrk; it returns 0 for errors, not -1. (r_alloc_init): Set real_morecore to old value of __morecore. Don't initialize lim_data or warnlevel, and don't call get_lim_data. (memory_warnings): Function removed. Mon Oct 12 16:59:52 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * vm-limit.c (warnfunction): Renamed to warn_function (was used inconsistently). (morecore_with_warning, memory_warnings): Change callers (were inconsistent). Mon Oct 12 16:10:02 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * mem-limits.h (start_of_data): Removed extra defn. (get_lim_data): Define to return void. Mon Oct 12 14:43:13 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * mem_limits.h: File renamed to mem-limits.h. * vm-limit.c, ralloc.c: Changed #includes. Sun Oct 11 02:51:22 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * syntax.c (find_defun_start): scan_buffer returns start of line; no need to advance over newline. * vm-limit.c (morecore_with_warning): Reduce warnlevel when usage drops far enough. * ralloc.c (check_memory_limits): Likewise. * vm-limit.c (memory_warnings): Renamed from malloc_init. Don't set lim_data or warnlevel. Use start_of_data if start is 0. * ralloc.c (memory_warnings): New function; just set warning data. Use start_of_data if start is 0. * emacs.c (Fdump_emacs, main): Use memory_warnings. * mem_limits.h [!emacs]: Don't define POINTER, SIZE or NULL. (start_of_data): Define as macro, if !emacs. * ralloc.c [!emacs]: Don't include config.h or lisp.h; instead, use stddef.h. Define POINTER, SIZE, EXCEEDS_LISP_PTR. * vm-limit.c [!emacs]: Don't include config.h or lisp.h; instead, use stddef.h. Define POINTER, SIZE, EXCEEDS_LISP_PTR. * ralloc.c [!emacs] (safe_bcopy): Define as macro using memmove. (r_alloc_free): Clear *ptr. (r_alloc_init): Renamed from malloc_init. Take no args. Make it static; declare at top of file. (r_alloc): Call r_alloc_init, if not initialized yet. (r_alloc_initialized): Renamed from malloc_initialized; moved to top. (ROUNDUP): Subtract 1, in case arg is already aligned. * mem_limits.h (EXCEEDS_LISP_PTR): Renamed from EXCEEDS_ELISP_PTR. * vm-limit.c (morecore_with_warning): Use EXCEEDS_LISP_PTR. * ralloc.c (check_memory_limits): Use EXCEEDS_LISP_PTR. Sat Oct 10 14:53:28 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * keyboard.c (Vlast_event_frame): Make this variable exist even when MULTI_FRAME isn't #defined. People might find it necessary for writing correct programs, even when the programs don't explicitly use multiple frames. (read_char, kbd_buffer_store_event, kbd_buffer_get_event): No need to test MULTI_FRAME before setting Vlast_event_frame. (syms_of_keyboard): DEFVAR Vlast_event_frame whether or not MULTI_FRAME is defined. * keyboard.c: Add switch-frame events. (Qswitch_frame): New event header symbol. (head_table): Include Qswitch_frame in the table of event heads. (kbd_buffer_get_event): Detect when a frame switch has occurred, and return a frame switch event before the enqueued event. (make_lispy_switch_frame): New function. (unread_switch_frame): New variable. (read_key_sequence): Don't throw away the key sequence if the user switches frames in the middle of the sequence. Instead, when we receive a switch-frame event in the middle of a key sequence, save it, and stuff it into unread_switch_frame when the sequence is complete. (read_char): If unread_switch_frame is set, return that value. (command_loop_1): No need to check Vlast_event_frame and select new frames here; that's taken care of by switch-frame events now. (syms_of_keyboard): Initialize and staticpro unread_switch_frame. * keyboard.h (Qswitch_frame): Declare this extern. * frame.c: #include "commands.h" and "keyboard.h". (Fselect_frame): Make this interactive, and accept switch-frame events as arguments, so we can bind this function to switch-frame events. (keys_of_frame): New function; bind switch-frame to Fselect_frame. * emacs.c (main): Call keys_of_frame. * keymap.c (initial_define_lispy_key): New function, for defining non-ascii keys. * ymakefile: Note that frame.o depends on commands.h and keyboard.h. * callint.c (Fcall_interactively): Allow multiple 'e' specs. (Finteractive): Doc fix. * keyboard.h (this_command_keys, this_command_key_count): Added external declarations. * keymap.c (access_keymap): Treat bindings for Qt as default bindings, when new argument T_OK is non-zero. (get_keyelt, Fdefine_key, Flookup_key): Call access_keymap with T_OK false. * keyboard.c (follow_key, read_key_sequence): Call access_keymap with T_OK true. * keyboard.c (apply_modifiers): Copy the value of BASE's Qevent_kind property to the new symbol. * keyboard.c (syms_of_keyboard): Qevent_kind should be initialized to intern ("event-kind"), not intern ("event-type"). Sat Oct 10 02:54:17 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Fwrite_region): If VISIT is a file name, use that as file name to visit, and print it in the message. Use it for file locking too. * m-ibmps2-aix.h [__GNUC__ >= 2] (LIB_STANDARD): Don't define. Fri Oct 9 12:49:03 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * ymakefile (FLOATSUP): Renamed to FLOAT_SUPPORT. (FRAME_SUPPORT, VMS_SUPPORT): New macros. (lisp): Rebuild this from loadup.el, using the _SUPPORT macros. * ymakefile [HAVE_X_WINDOWS, not NO_X_MENU, HAVE_X11] (LIBXMENU): Link against -loldX, to get the association table functions. * xterm.c, xrdb.c: #include before "xterm.h", to avoid warnings about redefining NULL under GCC 2.2.2. Fri Oct 9 01:08:36 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * m/pyrmips.h: New file. * s/aix3-1.h (PTY_ITERATION, etc.): Defined. (FIRST_PTY_LETTER): Deleted. Wed Oct 7 15:23:31 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * m/sparc.h: Include , to define the FSCALE constant. * ymakefile (YMF_PASS_LDFLAGS): Refer to the prefix-args program using "./prefix-args", not just "prefix-args"; some people don't have . in their paths. Tue Oct 6 00:54:20 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * link.com: Use gcclib if compiling with GCC. * fileio.c (directory_file_name): Don't clobber the envvar when handling top-level rooted dir. * ymakefile (LIB_STANDARD): If ORDINARY_LINK, default this to empty. * m/ibmps2-aix.h [USG_SHARED_LIBRARIES]: Define ORDINARY_LINK. Undef LIB_STANDARD. Modify LD_SWITCH_MACHINE. * unexnext.c: New file. * emacs.c (main) [NeXT]: Call malloc_jumpstart. Mon Oct 5 19:59:01 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (window_loop): Pass 2nd arg to Fother_buffer. * frame.c (make_frame): Likewise. * callint.c (Fcall_interactively): Likewise. * buffer.c (Fkill_buffer): Likewise. (Fswitch_to_buffer, Fpop_to_buffer, Fbury_buffer): Likewise. Sat Oct 3 01:34:07 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): Treat mouse clicks on non-text areas as if they were prefixed with the symbol denoting the area clicked on - `mode-line', etcetera. When we throw away an unbound `down-' event, reset mock_input as well. * keyboard.c (Qevent_symbol_element_mask, Qmodifier_cache): Two new symbols, used to implement caches on event heads. These take the place of some of the caching that modify_event_symbol used to do. (parse_modifiers_uncached, apply_modifiers_uncached, lispy_modifier_list, parse_modifiers, apply_modifiers): New functions, which replace format_modifiers and reorder_modifiers; they can be useful elsewhere too. (reorder_modifiers, modify_event_symbol): Re-implement these in terms of parse_modifiers and apply_modifiers. modify_event_symbol now uses a much simpler cache, and takes advantage of the caches maintained by parse_ and apply_modifiers. (follow_key): Don't modify NEXT if KEY has no bindings. (read_key_sequence): Drop unbound `down-' events, and turn unbound `drag-' events into clicks if that would make them bound. This benefits from the rewriting of the modifier key handling code. (syms_of_keyboard): Initialize and intern Qevent_symbol_element_mask and Qmodifier_cache. * keyboard.c (echo_prompt): Terminate the echo buffer properly even when the string is too long to display in the minibuffer. (echo_truncate): Just return echoptr - echobuf, rather than calling strlen on echobuf. * alloc.c (Fmemory_limit): New function. (syms_of_alloc): Defsubr it. * window.c (SAVE_WINDOW_DATA_SIZE): Define this using sizeof, instead of just saying it's 7; that way, we won't get screwed if we add members to struct save_window_data. * window.c (struct save_window_data): Save the currently selected frame, too. (Fset_window_configuration): Restore the frame's selected window using Fselect_window, and then restore the selected frame using Fselect_frame. (Fcurrent_window_configuration): Record the currently selected frame. Update docstring to describe the information now recorded. Fri Oct 2 22:43:49 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * process.c (wait_reading_process_input): Ultrix select seems to return ENOMEM when interrupted. So, under Ultrix, treat ENOMEM like EINTR. * keyboard.c (modifier_names): The modifier is named "control", not "ctrl". * keyboard.c (modify_event_symbol): Make sure that the unmodified event header gets the proper properties set on it, by recursing and letting the same code build the properties for all event symbols. * keyboard.c (Qmouse_click): Fix typo which assigned `mouse-click' symbol to Qmouse_movement. Fri Oct 2 22:11:38 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * undo.c (Fprimitive_undo): When undoing an insert, move point and then delete. Fri Oct 2 18:31:07 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * intervals.c: `copy_intervals' no longer static. * intervals.h: Declare `copy_intervals'. * buffer.c: #include intervals.h. * ymakefile: New macro "INTERVALS", controlled by "USE_INTERVALS", which defines the interval include file "intervals.h". New entries for "intervals.c" and "textprop.c". * lisp.h: Declare Qbuffer_or_string_p. Fri Oct 2 18:16:12 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xterm.c (x_find_modifier_meanings): If there are no modifiers containing a Meta_ keysym, use the Alt keysyms to denote meta. (construct_mouse_click): Set the down_modifier bit on mouse button press events. (XTread_socket): When processing keypress events, use x_meta_mod_mask when processing ordinary ASCII characters, not just when processing function keys and other non-ASCII events. (XTread_socket): If we receive a MappingNotify event with the `request' member set to `MappingModifier', then call x_find_modifier_meanings to refresh x_meta_mod_mask. * window.c (Fset_window_configuration): Clean up the way we save and restore the frame's size. * termhooks.h (struct input_event): Doc fix. (NUM_MOUSE_BUTTONS): New constant. (click_modifier): New modifier. (NUM_MODIFIER_COMBOS): Removed. * keyboard.h (EVENT_HAS_PARAMETERS): Definition changed - all events are not 5 elements long. (EVENT_HEAD): Work correctly on all sorts of events, not just events with parameters. (EVENT_WINDOW, EVENT_BUFFER_POSN, EVENT_SCROLLBAR_BUTTON, EVENT_WINDOW_POSN, EVENT_TIMESTAMP): These aren't useful anymore; this information may appear twice in an event. These are replaced by the POSN_ accessors, which are meant to be composed with the EVENT_START and EVENT_END accessors. (EVENT_START, EVENT_END): Two new accessors, to get at the starting and ending position of an event. (POSN_WINDOW, POSN_BUFFER_POSN, PONS_SCROLLBAR_BUTTON, POSN_WINDOW_POSN, POSN_TIMESTAMP): New macros, to futher diasassemble the values returned by EVENT_START and EVENT_END. * keyboard.c (echo_char, read_char): Apply EVENT_HEAD without first testing for EVENT_HAS_PARAMETERS; EVENT_HEAD works properly on all sorts of events now. (read_key_sequence): Use the new accessors to decide in which window an event occurred. * keymap.c (access_keymap, store_in_keymap, Fsingle_key_description): No need to check for EVENT_HAS_PARAMETERS before using EVENT_HEAD; the latter now works properly on all sorts of events. * keyboard.c (Qevent_unmodified): Replaced by... (Qevent_symbol_elements): New property. (syms_of_keyboard): initialize and staticpro the latter, not the former. * keyboard.h (Qevent_unmodified): Extern declaration replaced by... (Qevent_symbol_elements): This. (EVENT_HEAD_UNMODIFIED): Use the Qevent_symbol_elements property, rather than the Qevent_unmodified property. * keyboard.c (readable_events): This doesn't need to scan and discard mouse release events anymore; it just uses EVENT_QUEUES_EMPTY. (kbd_buffer_get_event): No need to skip past mouse release events. * keyboard.c (button_down_location): New variable, which stores the location at which each button was pressed, so we can build a complete drag event when the button is released. (make_lispy_event): When a button is pressed, record its location in button_down_location, and turn it into a `down' event. When a button is released, compare its release location with its press location, and decide whether to call it a `click' or `drag' event. Change mouse movement events to be arranged like click events. (format_modifiers): Note that the click modifier has no written representation. (modifier_names, modifer_symbols): New variables, used to create the Qevent_symbol_elements property. (modify_event_symbol): Change the format of the modified symbol cache; there are too many modifier bits now to use a vector indexed by a modifier mask. Use an assoc-list instead. Document the format of the cache. Put the Qevent_symbol_elements property on each new symbol, instead of a Qevent_unmodified property. (symbols_of_keyboard): Put Qevent_symbol_elements properties on the symbols specified in head_table, not Qevent_unmodifed properties. Initialize and staticpro modifier_symbols, and staticpro the window elements of button_down_location. * xmenu.c: #include "keyboard.h". (Fx_popup_menu): Use the event accessors defined in keyboard.h, instead of writing out cars and cdrs. * ymakefile: Note that xmenu.o depends on keyboard.h. Fri Oct 2 14:55:28 1992 Joseph Arceneaux (jla@wookumz.gnu.ai.mit.edu) * textprop.c: Conditionalize all functions on "USE_TEXT_PROPERTIES". * intervals.c: Conditionalize all functions on "USE_TEXT_PROPERTIES". Removed #include of "screen.h". * alloc.c: #include "intervals.h". (init_intervals, make_interval, mark_interval, mark_interval_tree): New functions conditionally defined. (make_uninit_string): Call INITIALIZE_INTERVAL. (INIT_INTERVALS, UNMARK_BALANCE_INTERVALS, MARK_INTERVAL_TREE): New macros, conditionally defined. (mark_object): Call MARK_INTERVAL_TREE in case Lisp_String. (gc_sweep): If text properties are in use, place all unmarked intervals on the free list. Call UNMARK_BALANCE_INTERVALS on `buffer->intervals' when unmarking `buffer'. (compact_strings): Include INTERVAL_PTR_SIZE in calculation for target of bcopy when relocating strings. (init_alloc_once): Call INIT_INTERVALS. (make_pure_string): Include INTERVAL_PTR_SIZE in calculation of `size'. Moved static declaration of `mark_object' and other functions up in the file. * fileio.c (Finsert_file_contents): Call offset_intervals if text was actually inserted. #include "intervals.h". Wed Sep 30 18:29:00 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * data.c: Qbuffer_or_string_p added. * syntax.c (describe_syntax): Use insert_char to insert `match'. * buffer.c (reset_buffer): Do INITIALIZE_INTERVAL on the buffer's interval component. (Fkill_buffer): Likewise. * editfns.c (make_buffer_string): Call copy_intervals_to_string. (Finsert_buffer_substring): Call graft_intervals_into_buffer. #include "intervals.h". * insdel.c: #include "intervals.h" (prepare_to_modify_buffer): Call verify_interval_modification. (insert_from_string): Call offset_intervals and graft_intervals_into_buffer. (del_range): Call offset_intervals. (insert): Call offset_intervals. * emacs.c: #include "intervals.h". (main): Call syms_of_textprop. This is only really present if Emacs is compiled with USE_TEXT_PROPERTIES defined. * buffer.h: New macro TEMP_SET_PT. If intervals are used, SET_PT and TEMP_SET_PT are function calls. Similarly for BUF_SET_PT and BUF_TEMP_SET_PT. Added DECLARE_INTERVALS to buffer structure to conditionally compile an interval tree into it. * intervals.h: Declare temp_set_point. Wed Sep 30 17:08:53 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * ymakefile (config.h): Doc fix. Wed Sep 30 16:35:23 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * config.h.in: Added a slot for definition of USE_TEXT_PROPERTIES, controlling compilation of interval code. If using GNUC, support inline functions. * lisp.h: Conditionally define interval structure and macros. Add DECLARE_INTERVALS to struct Lisp_String. Wed Sep 30 06:59:07 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * buffer.c (Fother_buffer): Add back the VISIBLE_OK argument. It got removed with no comment or ChangeLog entry, and append-to-buffer uses it. * window.c (struct save_window_data): Add a member called focus_frame, to save and restore the screen's focus frame. (Fset_window_configuration): Redirect the frame's focus as indicated in the window configuration. (Fcurrent_window_configuration): Record the frame's current focus. * minibuf.c (read_minibuf): Don't bother to save the current frame's focus, and have read_minibuf_unwind restore it; saving and restoring the window configurations will take care of that. (read_minibuf_unwind): Don't worry about restoring the frame's focus. * window.c (Fset_window_configuration): Don't select the frame just because we restored its configuration. * window.c (Fset_window_configuration): Don't forget to set the frame's selected window when we can't call Fselect_window. * xterm.c (x_meta_mod_mask): New variable, indicating which X modifier bits denote meta keys. (x_find_modifier_meanings): New function, to set x_meta_mod_mask. (x_convert_modifiers): Use that. (x_term_init): Call x_find_modifier_meanings. * data.c (Fmake_local_variable): If SYM forwards to a C variable, swap in the value for the current buffer immediately. * lisp.h: Doc elaboration for Lisp_Buffer_Local_Value. Tue Sep 29 21:05:30 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * textprop.c (Ferase_text_properties): Merge intervals when possible. Tue Sep 29 00:04:05 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xselect.c (Qcut_buffer0): Symbol removed; we're using a new interface to the cut buffer now. (NUM_CUT_BUFFERS, cut_buffer_atom, cut_buffer_value, cut_buffer_cached, cut_buffer_just_set): New variables. (Fx_own_selection, Fx_selection_value): Dike out the code to handle CUT_BUFFER0 requests. (Fx_get_cut_buffer, Fx_set_cut_buffer, x_watch_cut_buffer_cache, x_invalidate_cut_buffer_cache): New functions. (syms_of_xselect): Don't bother to initialize Qcut_buffer0. Initialize and staticpro cut_buffer_value, and defsubr Sx_get_cut_buffer and Sx_set_cut_buffer. * xterm.c (XTread_socket): Pass PropertyNotify events from the root window to x_invalidate_cut_buffer_cache. (x_term_init): Call x_watch_cut_buffer_cache here. * keymap.c (access_keymap): Don't forget to QUIT while scanning the keymap. * keyboard.c (recent_keys): This needs to be staticpro'ed. Change it from a C array, which is a pain in the neck to staticpro, into a lisp vector, which is easier. (read_char, Frecent_keys): Access recent_keys as a lisp vector, not a C array. (syms_of_keyboard): Set recent_keys to be a vector, and staticpro it. * ymakefile (xfns.o): This doesn't depend on xselect.c. * xterm.h (ROOT_WINDOW): Use the DefaultScreen macro, not the XDefaultScreen function. * frame.c (Fdelete_frame): Call Fselect_frame with the appropriate number of arguments. * data.c (Frem): Use the `fmod' function under SunOS, Ultrix, and HP/UX, not just under USG systems. * buffer.c (Fbury_buffer): This used to undisplay the buffer being buried only if the BUFFER argument was nil. Instead, undisplay the buffer whenever it's displayed in the selected window, no matter how it was specified by BUFFER. This is how it behaves in 18.58, and I can't find any ChangeLog entry in 18.58 or 19.0 saying why they differ. Fix the doc string accordingly. Mon Sep 28 20:59:27 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * frame.c (Fselect_frame, Fframe_root_window, Fframe_selected_window, Fnext_frame, Fmake_frame_visible, Fmake_frame_invisible, Ficonify_frame): Doc fixes. * ralloc.c: Since the users of the relocating allocation code handle memory exhaustion, it's better to return an error code to them than to call abort. (obtain): If we cannot allocate more memory, don't call abort. Instead, return non-zero iff the allocation is successful. (get_more_space): If obtain fails, return zero. (get_bloc): Return zero if we can't allocate the new bloc. (r_alloc_sbrk): Return zero if we can't allocate more memory. (r_alloc): If we can't allocate more memory, set *PTR to zero and return zero. (r_re_alloc): If we can't allocate more memory, leave *PTR unchanged, and return zero. * ralloc.c (warnfunction): Renamed to warn_function; users changed. Mon Sep 28 03:20:09 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * insdel.c (del_range): Call record_delete before updating point. * fileio.c (Finsert_file_contents): Do record_insert, then inc MODIFF. * undo.c (record_delete): Record pos before the deletion. (Fprimitive_undo): Go back to recorded position. Mon Sep 28 01:08:59 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * window.c (delete_all_subwindows): Save the window's buffer in its `height' field; we may need to know the window's old buffer once we have restored it from a window configuration. (Fset_window_configuration): When we restore a window, if its `height' field is a buffer, restore its `buffer' field from that. This allows us to leave the window's buffer unchanged if the buffer recorded in the configuration is dead. * window.c (delete_all_subwindows): Removed unused variable named "count". Sun Sep 27 22:18:37 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * keyboard.c (read_char): If we're returning an event from a macro, set Vlast_event_frame to Qmacro, instead of leaving it set to the frame of the previous real event. (read_key_sequence): If Vlast_event_frame isn't a frame, don't bother switching buffers. (syms_of_keyboard): Doc fix for Vlast_event_frame. (Vlast_event_frame): Doc fix. * termhooks.h (alt_modifier, hyper_modifier, super_modifier, down_modifier, drag_modifier): New modifiers, to support the new input system. Re-arranged modifiers so that their bits are in canonical order; this makes reorder_modifiers slightly simpler. * keyboard.c (format_modifiers, reorder_modifiers): Handle the new modifier bits. * keymap.c (access_keymap): Remove code to notice bindings for Qt. Fri Sep 25 19:22:52 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (single_keymap_panes): Handle vectors properly. Fri Sep 25 10:58:40 1992 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * keymap.c (Fwhere_is_internal): Don't forget to advance map to the next element when we find something that is neither a vector nor a cons. Don't forget to QUIT in the appropriate places, either. Wed Sep 23 21:04:49 1992 Joseph Arceneaux (jla@geech.gnu.ai.mit.edu) * textprop.c (Fset_text_properties): Merge adjacent intervals with the same properties. (Fnext_single_property_change, Fprevious_single_property_change): New subrs. * intervals.c (merge_interval_left, merge_interval_right): Abort if caller tries to merge first (or last, respectively) interval. Delete the interval node after merging. (copy_intervals): Use `split_interval_right' rather than creating new intervals with make_new_interval and attaching them explicitly. (verify_interval_modification): Changed error message. GCPRO hooks before calling Fnreverse, and correctly Fcdr down the list. Also, don't cons multiple copies of the same consecutive modification hook. (temp_set_point): New function. (set_point): Call point-left and point-entered hooks if moving between text with different properties. Use the old and new positions as arguments to these calls. * intervals.c, intervals.h: (map_intervals, make_buffer_interval, make_string_interval,run_hooks): Deleted. Wed Sep 23 06:38:52 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * keymap.c (DENSE_TABLE_SIZE): Doc fix. (keymap_table): Function removed; this function exists only to support an incorrect understanding of the format of keymaps. (access_keymap, store_in_keymap, Fcopy_keymap, Faccessible_keymaps): Correctly handle vectors at any point in the keymap; don't assume it must be at the front. (describe_map): Instead of calling describe_vector on the vector in the cadr of the keymap (if present) and then calling describe_alist to do the rest, just call describe_map_2. (describe_alist): Renamed to describe_map_2; call describe_vector when we encounter a vector in the list. * xmenu.c (single_keymap_panes): Comment out the code which tries to handle a dense keymap's table; it uses keymap_table, and the rest of the code never uses the table contents anyway. * keymap.c (access_keymap, store_in_keymap): Clarify error message for non-ASCII characters. * process.c [SIGCHLD && !BSD && !UNIPLUS && !HPUX] (create_process): #if 0 out the code which sets the child's handler for SIGCHLD to sigchld; the code which gives sigchld its value has been diked out under these CPP symbols, so this should be diked out too. * indent.c (Fmove_to_column): Pass the right number of arguments to Findent_to. Tue Sep 22 01:56:01 1992 Jim Blandy (jimb@kropotkin.gnu.ai.mit.edu) * emacs.c (emacs_priority): Doc fix. (main): Use nice, not setpriority; we just need a simple, portable call to nice here. * callproc.c (child_setup): Use nice, not setpriority. * sysdep.c (sys_suspend): Don't try to use "nice (- nice (0))" to set the subshell's priority to normal; nice doesn't return a defined value on all systems. Instead, since emacs_priority gives the priority that Emacs was nastied to, we can use it to reset the priority in a straightforward way. [BSD4_1], [USG], [VMS] (setpriority): Remove dummy and compatibility definitions of setpriority. * keymap.c (access_keymap): Return the binding of Qt as the binding for all unbound characters. * fileio.c (syms_of_fileio): Don't try to defsubr Sunix_sync unless it's actually been defined - that is, if unix is #defined. * xrdb.c (x_get_resource): Cast the value being assigned to ret_value->addr, rather than ret_value->addr itself; only GCC allows you to cast lvalues. * eval.c (unbind_catch): Do the long-jump here. Take a VALUE argument, which specifies the value to return to the catch, or the data to give to the condition handler. Renamed to unwind_to_catch, to reflect new role. (Fsignal, Fthrow): Removed code to set catch tag value and do the long-jump; this is taken care of by unwind_to_catch. Mon Sep 21 02:36:50 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * alloc.c (mark_object): Avoid car recursion on cons with nil in cdr. Avoid recursion on constants-vector of a compiled function. * oldXMenu: Symlink deleted; anything that uses it needs fixing in any case to work properly on systems without symlinks. Sun Sep 20 16:05:09 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sol2.h: New file. * fileio.c: Don't include sys/dir.h. * s/usg5-4.h (LIBS_SYSTEM): Move non-default libraries here. (LIB_STANDARD, START_FILES): Deleted. (ORDINARY_LINK): Defined. * ymakefile [ORDINARY_LINK]: Default LD to $(CC) and make START_FILES and LIB_STANDARD empty. (C_SWITCH_X_MACHINE, C_SWITCH_X_SYSTEM): New macros, default empty. (CFLAGS): Use them. Sat Sep 19 03:05:11 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ymakefile (${etc}DOC): Use OBJECTS_SYSTEM and OBJECTS_MACHINE. * dired.c [VMS]: Include string.h, rms.h, rmsdef.h. [VMS] (Ffile_version_limit): New function. * sysdep.c (sys_suspend): Read EMACS_PARENT_PID envvar for parent. * syntax.c (scan_lists): When searching back for comment: if comment-end is 2 chars, assume it does end a comment. Otherwise, scan back to previous comment-end to see if there's a comment starter between. Also record whether the string quotes between the start and the end are paired and uniform. If so, skip to comment starter. If not, scan from start of defun to find comment starter if any. (find_defun_start): New function. * alloc.c (mark_object): Save last 500 values of objptr. Check for clobberage of ptr, when marking a vector. Fri Sep 18 03:28:55 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keymap.c (get_keyelt): Skip menu help string after menu item name. Fri Sep 18 00:50:03 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * buffer.c (Fget_buffer_create): Doc fix. * lisp.h (struct handler): Remove the poll_suppress_count member of this structure; it is always equal to the poll_suppress_count of its catchtag structure. The non-local exit code in eval.c is difficult enough to understand as it is; needless duplication doesn't help. * eval.c (Fcondition_case): Rearranged for clarity. Don't worry about setting h.poll_suppress_count; it's guaranteed to be the same as c.poll_suppress_count. (internal_condition_case): Don't worry about h.poll_suppress_count. (Fsignal): Use h->tag->poll_suppress_count instead of h->poll_suppress_count. * eval.c (Fsignal): It's okay for the debugger to return to the caller if the caller was signalling a quit. * eval.c (unbind_catch): Restore the polling suppression count here, instead of in Fsignal and Fthrow. (Fthrow, Fsignal): Don't restore the polling suppression count here. * lisp.h (struct specbinding, struct handler): More documentation. * eval.c (struct catchtag): More documentation. Thu Sep 17 18:49:39 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ymakefile (LIBX): Don't use -loldX. Thu Sep 17 15:51:18 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * minibuf.c (get_minibuffer): Enable undo in minibuffers. Mon Sep 14 17:35:32 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ymakefile (LIBXMENU): Check NO_X_MENU, not HAVE_X_MENU * emacs.c (main): Use X menu code if HAVE_X_WINDOWS and not NO_X_MENU. * keyboard.c (read_char_menu_prompt): Likewise. * config.h.in: Delete everything about config.h. * emacs.c: Eliminate HIGHPRI as compilation option. (emacs_priority): New C variable, also Lisp variable. (main): Set the priority iff emacs_priority is nonzero. Mon Sep 14 15:38:56 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * eval.c (entering_debugger): Variable renamed when_entered_debugger, and is now a timestamp based on num_nonmacro_input_chars. (init_eval): Initialize when_entered_debugger, not entering_debugger. (call_debugger): Set when_entered_debugger to the current value of num_nonmacro_input_chars. (find_handler_clause): Don't call debugger unless num_nonmacro_input_chars is greater than when_entered_debugger; that way, we won't call the debugger unless the user has had a chance to take control. (Fbacktrace): Don't clear entering_debugger here. * keyboard.h (num_nonmacro_input_chars): Added extern declaration for this. * fns.c (Fy_or_n_p): After testing for a QUIT, clear Vquit_flag. Otherwise, if Fy_or_n_p is called while Vinhibit_quit is true and the user presses C-g, this function goes into an infinite loop. * dispnew.c (get_display_line): Don't abort if the frame is invisible; since unmap events are handled at the interrupt level, a screen may become invisible at any time. Sun Sep 13 18:23:40 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Fverify_visited_file_modtime): Pass buffer itself to handler, if have handler. (Fwrite_region): GCPRO around Fexpand_file_name, Ffile_name_directory. (Fread_file_name_internal): GCPRO around file name manip. (Ffile_writable_p, Ffile_readable_p): Use abspath, not filename, (Ffile_executable_p, Ffile_exists_p): to run the handler. (Fset_file_modes, Ffile_directory_p, Ffile_modes): Likewise. (Ffile_newer_than_file_p): GCPRO around expand_and_dir_to_file. Sun Sep 13 08:30:46 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * s/bsd4-3.h: Give the BSD4_3 and BSD symbols the same numeric definitions they'll get in , to avoid warnings. * m/hp9000s300.h: Don't include . This really shouldn't be necessary. (BIG_ENDIAN): Define this as "4321", to agree with , and avoid warnings. * systime.h: Re-arrange inclusion of and so that they don't both get included under BSD, and do both get included under AIX. * xdisp.c (display_mode_line): If the only other frames are minibuffer frames, don't name the frame after the in the selected window. We can use Fnext_frame to do this test easily. Sat Sep 12 03:55:16 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (Faccept_process_output): Initialize useconds. * keyboard.c (num_nonmacro_input_chars): New variable. (read_char): Use num_nonmacro_input_chars to decide on auto-save & gc. Increment it when appropriate. (record_auto_save): Use num_nonmacro_input_chars. * fileio.c (Ffile_name_directory, Ffile_name_nondirectory): (Ffile_name_as_directory, Fdirectory_file_name, Fexpand_file_name): Call find_file_handler. (syms_of_fileio): Set up Qfile_name_directory, etc. (Fcopy_file): Call find_file_handler for newname as well as for filename. (syms_of_fileio): Initialize Vfile_name_handler_alist. Fri Sep 11 14:03:56 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * callint.c (Fcall_interactively): Remove the 'K' interactive code, in favor of 'e'; that's a better name. Fri Sep 11 00:28:39 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/esix5r4.h: New file. * sysdep.c (init_sys_modes): Handle VDSUSP like V_DSUSP. Use CDISABLE, not CDEL. Turn off IEXTEN if it exists. * systty.h (CDISABLE): New macro; may be defined from CDEL. * keyboard.c (command_loop_1): Bind inhibit-quit to t when in Fsit_for. Thu Sep 10 16:19:45 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Makefile.in: Add comments starting with "# DIST: " explaining that this gets munged by the configure script. Thu Sep 10 03:48:18 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s-aix3-1.h (HAVE_GETHOSTNAME): Defined. Wed Sep 9 20:34:43 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * frame.c (choose_minibuf_frame): abort if the selected frame has nil in its minibuffer_window slot; this shouldn't happen any more. * window.c (minibuffer_window): Accept an optional FRAME argument; if specified, return the minibuffer used by that frame. * keymap.c (describe_buffer_bindings): Adjust key_heading to match the format used by describe_map_tree. Also, don't reprint the "key binding" header above the global bindings if we've already printed it for the local bindings; it's clear enough that the columns mean the same thing as above. Tue Sep 8 13:25:37 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * ralloc.c (r_re_alloc): Instead of allocating a new bloc at the end of the heap, copying the data to it, and then freeing the original bloc, just expand the original block. This saves a copy and a call to sbrk, and also removes the large spike in memory allocation that would occur when resizing large buffers. And it's less code. * keyboard.h (Vkeyboard_translate_table): Declare this extern here, so describe_buffer_bindings can use it. * keymap.c (describe_buffer_bindings): Declare buf and bufend... Sat Sep 5 03:47:34 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * systime.h: Always #include , not just when NEED_TIME_H is defined. It gets us struct tm. #include whenever HAVE_TIMEVAL is defined and NEED_TIME_H isn't. * systime.h: Note that the tz_dsttime field of the struct timezone returned by gettimeofday doesn't say whether daylight savings is _currently- active; rather it specifies whether it is *ever* active. (EMACS_GET_TZ_OFFSET_AND_SAVINGS): Removed `savings_flag' argument, and renamed to EMACS_GET_TZ_OFFSET. Don't try to extract savings information. EMACS_CURRENT_TIME_ZONE should call localtime to figure out whether DST is active. * m/hp9000s300.h: #include before doing anything else, to avoid conflicts between the system's and Emacs's definitions of BIG_ENDIAN. * keymap.c (describe_buffer_bindings): Set the current buffer to descbuf before calling current_minor_maps; that function's value depends on the values of buffer-local variables. Don't set the current buffer to Vstandard_output until afterwards. * keymap.c (describe_buffer_bindings): If Vkeyboard_translate_table is in effect, describe its effects. * frame.c (Fnext_frame): Doc fix. * frame.c (prev_frame): #if 0'd out; nobody uses this. * frame.c (next_frame): The logic which determines whether a frame is acceptable to return was misarranged; rewrote it. (prev_frame): Same thing. Sat Sep 5 01:17:59 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * syntax.c (scan_lists): Improve smarts for backwards scan of comments. Don't modify comstyle inside that loop. If string quotes don't match up, don't take value from OFROM; instead, parse forward using scan_sexps_forward. (scan_sexps_forward): Return value via a pointer passed in. New element in state contains char addr of last comment-starter seen. (Fparse_partial_sexp): Change call to scan_sexps_forward. Fri Sep 4 17:47:12 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (xmenu_show): If no panes, just return. * keyboard.c (last_nonmenu_event): New var. (syms_of_keyboard): New Lisp var. (read_key_sequence): Use that instead of prev_event. * commands.h (last_nonmenu_event): Declared. * callint.c (Fcall_interactively): For `K', use last_nonmenu_event. Make `e' alias for `K'. Thu Sep 3 00:40:08 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * editfns.c (Fcurrent_time_string): Change docstring to indicate that we will probably add the timezone to the end, now that we have it available on many systems. * xrdb.c: Don't include . Under R4, it stupidly insists on defining SIGCHLD, even if it already has a definition. (file_p): Use the constant 4 instead of R_OK; empirically, the number is more portable than the symbol if you count the #include hair you have to go through to get R_OK defined. Ffile_readable_p does this too. * xterm.c (x_wm_set_size_hint): Set the base_width and base_height members of size_hints, if they're available (X11R4 and after); otherwise, approximate the right thing, by using min_width and min_height as the base size. Wed Sep 2 19:46:56 1992 Barry A. Warsaw (warsaw@anthem.nlm.nih.gov) * Extended syntax.c in the following ways to support up to 2 orthogonal comment styles per mode. This is needed for C++. Bit 6 of syntax table entry for a character indicates it is part of the `b' comment style. Otherwise it is part of the `a' style. * syntax.h (SYNTAX_COMMENT_STYLE): New macro. * syntax.c (Fmodify_syntax_entry): Set that flag for `b'. (describe_syntax): Print the `b' flag. (scan_lists, scan_sexps_forward): Handle the new flag. (Fparse_partial_sexp): Return new element in value. Wed Sep 2 17:41:31 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * fileio.c (syms_of_fileio): Doc fix for Vfile_name_handler_alist. Wed Sep 2 00:46:36 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * keyboard.c (kbd_buffer_get_event): When performing the FRAME_FOCUS_FRAME redirection, don't modify the frame field of the event; that fatally corrupts mouse click events. Instead, just perform the redirection on the value assigned to Vlast_event_frame. * callint.c (Fcall_interactively): Don't try to get the `enable-recursive-minibuffers' property from FUNCTION unless FUNCTION is actually a symbol; there are some cases where a key sequence is bound directly to a lambda form, and there's no reason to break these. * window.c (Fset_window_configuration): Don't signal an error if the frame size saved in the window configuration doesn't match the frame's current size; instead, temporarily resize the frame while installing the window configuration. This is important because using the minibuffer saves and restores the current window configuration, and you don't want to signal an error just because the user resized the frame while using the minibuffer. * doc.c (Fsnarf_documentation): Signal an error if this is called in a dumped Emacs. * alloc.c (mark_object): mark a symbol's name after marking its value, function, and property list rather than before; this way, symbols' names are readable, giving us a chance to detect some kinds of heap corruption. Wed Sep 2 00:04:50 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacs.c (__main, __do_global_dtors): New dummy functions. (__do_global_ctors_aux, __do_global_ctors): Fix typo in fn names. Tue Sep 1 12:07:18 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * prefix-args.c: New file. See comment at top of file. * ymakefile (YMF_PASS_LDFLAGS): Use the prefix-args program to affix the -Xlinker prefix to the linker arguments. (prefix-args): New target. (temacs): Depend on prefix-args. * xterm.c (x_catch_errors): Don't forget to initialize x_caught_error_message to the null string, so x_check_errors can tell when an error has occurred. * unexmips.c (mark_x): Declare this as static void at the top of the file and at the function definition. * keyboard.c (input_available_signal): Declare this to return SIGTYPE. * xrdb.c (getuid): Declare this to return short. * s/bsd4-3.h: Remove definition of SIGTYPE macro; Mt. Xinu says it's int, but Ultrix says it's void. Since the SIGTYPE guessing code in the `configure' script gives the correct answer for both of these cases, there's no point in listing it here. * systime.h (EMACS_CURRENT_TIMEZONE): Change documentation to indicate that *OFFSET should be set to the number of minutes EAST of Greenwich, which is what Ed Reingold says real time gurus want. Changed the definition of the EMACS_GET_TZ_OFFSET_AND_SAVINGS macro to reflect this. Buggily, the Fcurrent_time_zone function was already expecting minutes east of GMT. * Makefile.in (distclean): Remove backups from the `m' and `s' directories, too. * m/mips.h: Merge changes from Emacs 18.58: [NEWSOS5]: Changes so this file can be used with s/newsos5.h. (SIGN_EXTEND_CHAR): Define this using a cast to signed char. I guess the MIPS compiler and its derivatives all have this type. (HAVE_ALLOCA, C_ALLOCA): Define the former if we're compiling with GCC, and the latter otherwise. (C_SWITCH_MACHINE): Defined, instead of C_SWITCH_SYSTEM. (LINKER): Defined, if BSD. (XUINT, XSET, XUNMARK): Add parentheses to eliminate warnings from GCC. Reindent to fit in 80 columns. INHIBIT_BSD_TIME prevents including bsd/sys/time.h. * s/newsos5.h: New file for Sony NEWS-OS release 5, courtesy of Chris Hanson . * m/mips.h: Don't undefine LOAD_AVE_TYPE; the comment says that Emacs 19 has the crocks to handle it properly. * m/pmax.h: Merge changes from Emacs 18.58: (LIB_STANDARD, COFF, TERMINFO): Cancel out definitions from m/mips.h which are only appropriate for USG. (MAIL_USE_FLOCK, HAVE_UNION_WAIT): Do define these. (BROKEN_O_NONBLOCK): Defined. (LINKER): Don't define this. [OSF1]: Undef C_ALLOCA, define HAVE_ALLOCA. * s/osf1.h: New file. * s/bsd4-3.h: Merge changes from Emacs 18.58: (BSD, BSD4_3): Just define these, don't fret about numerical values or version numbers. * m/hp9000s300.h: Merge changes from Emacs 18.58, and hp300bsd.h: Change configuration note to say it's okay to use this file for BSD. Add comment saying that NOMULTIPLEJOBS must be defined for versions of HP/UX before 6.5. Don't define BIG_ENDIAN if it seems that has already done so. [BSD4_3] Define m68000, instead of hp9000s300; crt0.c uses these to decide what sort of startup code to use. [not BSD4_3] Under HP/UX, always define the BSD memory functions (bcopy, bzero, and bcmp) in terms of the SYSV string functions (memcpy, memset, and memcmp), not just under HP/UX 5; version 6's BSD compatibility library has reported bugs in `signal'. (NEED_BSDTTY): Move this symbol's definition inside the "not BSD4_3" conditional, since it's only relevant to HP/UX. * m/hp300bsd.h: File deleted, since m/hp9000s300.h now works with both HP/UX and BSD; it includes m/hp300bsd.h's specifications. * m/hp9000s300.h: Remove definition for SIGN_EXTEND_CHAR; this is only used by the regexp code, which has its own portable definition these days. Mon Aug 31 01:39:43 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keymap.c (Fmake_sparse_keymap): New optional arg. Callers changed. (Fmake_keymap): Likewise. * emacs.c (__do_global_ctors, __do_global_ctors_aux): New dummy fns. (__CTOR_LIST__, __DTOR_LIST__): New dummy variables. * fileio.c (Fdo_auto_save): Always call record_auto_save. * keyboard.c (read_char): Call read_char_menu_prompt here. Accept 4 new args to pass to it. Include them in recursive call. Don't delay before starting echo if prev_event was a mouse event. Test for eof in batch mode now understands C is a Lisp_Object. (read_key_sequence): Don't call it here; always call read_char. Don't change last_event_buffer after a mouse menu input. (read_char_menu_prompt): Arg PROMPT deleted. Return nil if nothing to do. * xmenu.c (Fx_popup_menu): Treat coords relative to spec'd window. (single_keymap_panes): New function; contains guts of keymap_panes. If a command binding for submenu has a prompt string starting with @, make a separate pane for it at this level. * xfns.c (Fx_track_pointer): Pass new args to read_char. (Fx_select_region, Fx_horizontal_line): Likewise. * lread.c (Fread_char): Pass new args to read_char. (Fread_event, Fread_char_exclusive): Likewise. * fns.c (Fy_or_n_p): Pass new args to read_char. Sun Aug 30 15:05:00 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): Keep track of prev_event. Pass new proper args to read_char_menu_prompt. (read_char_menu_prompt): New arg prev_event. Use Fx_popup_menu. Handle any number of keymaps, not just LOCAL and GLOBAL. Invert meaning of arg PROMPT. Test of menu_prompting was backwards. * keymap.c (keymap_table): No longer static. * xmenu.c (keymap_panes): New function. (Fx_popup_menu): Accept keymap or list of keymaps as MENU argument. Accept mouse button event as POSITION argument. Sat Aug 29 19:59:41 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cmds.c (internal_self_insert): Assume Fexpand_abbrev expanded something if it incremented MODIFF. Fri Aug 28 22:30:25 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * unexmips.c (unexec): Allow sections in any order. Adjust addresses of rdata section as well as data section. * buffer.c (syms_of_buffer): Made buffer-display-table, buffer-field-list and buffer-undo-list allow any type of value. Thu Aug 27 00:14:54 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fns.c (Fappend): Doc fix. Mon Aug 24 17:47:40 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * s/usg5-4.h: Incorporate changes from 18.58: (LIBX10_SYSTEM): Undefine this. (GNULIB): Definition deleted -- done in ymakefile. (LIB_STANDARD): Don't use GNULIB. (HAVE_TCATTR): Defined. * xfns.c (x_icon): Don't call x_wm_set_icon_positions if the user hasn't specified the icon position. Let the window manager put the icon where it likes. * xterm.c (x_make_frame_invisible): Don't forget to check the return value of XWithdrawWindow; it could indicate that the window wasn't successfully redrawn. * sysdep.c (init_baud_rate): Re-arranged order of conditionals - test TERMIOS before TERMIO; when two options might both be defined, test the most recent first, so that the most recent functions get used. * sysdep.c [HAVE_TERMIO] (init_baud_rate): Don't use tcgetattr unless HAVE_TCATTR is defined. Only very rarely do termio systems have the tc{get,set}attr macros. * window.c (coordinates_in_window): Do not assume that all one-line windows are the minibuffer, or that all minibuffers are one line high. Use MINI_WINDOW_P. * systerm.h: Renamed to systty.h, to be more consistent with everything else in Unix. * dispnew.c, emacs.c, keyboard.c, process.c, sysdep.c: #include directive changed. * ymakefile: References to systerm.h changed. * s/usg5-3.h: Merged changes from 18.58: (HAVE_SYSV_SIGPAUSE): Defined. (BROKEN_TIOCGETC): Defined. Fri Aug 21 22:50:34 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (WCOREDUMP): Define only if not defined. (create_process) [HAVE_SETSID]: Use TIOCSCTTY if exists. Thu Aug 20 16:45:07 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * fileio.c (Fdo_auto_save): Call Fsleep_for with the appropriate number of arguments. * fns.c (Fyes_or_no_p): Same. * dispnew.c (update_frame): Change the way we handle cursor_in_echo_area. Firstly, ignore this if the frame we're updating doesn't have a minibuffer. Secondly, don't handle the selected frame specially. Thirdly, don't assume that the minibuffer is only one line high. If cursor_in_echo_area < 0, put the cursor in the upper-left corner; if cursor_in_echo_area > 0, put it on the lowest non-empty line in the minibuffer window, or on the top line. * dispnew.c (direct_output_for_insert): Fail if cursor_in_echo_area is set; we don't want to do the typing there. (direct_output_for_insert): Same. Wed Aug 19 14:10:01 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * xterm.c (x_make_frame_invisible): Use XWithdrawWindow when available [HAVE_X11R4]; send the UnmapNotify event when appropriate [HAVE_X11]; just unmap the window if that's all that's needed [not HAVE_X11]. * xterm.c (x_set_text_property): Removed; it's only called from one place. Who wants *another* layer of indirection? * xfns.c (x_set_name): Use XSetWM{Name,IconName} when available [HAVE_X11R4], or XSetIconName and XStoreName otherwise. * xterm.h (FRAME_X_WINDOW): New macro, for readability. * xterm.c, xfns.c, xselect.c: Use it. * emacs.c (Fkill_emacs): Doc fix. (syms_of_emacs): Doc fix for Vkill_emacs_hook. * xterm.c (x_death_handler): Renamed to x_connection_closed. (x_term_init): Use x_connection_closed as the SIGPIPE handler. * xterm.c (acceptable_x_error_p, x_handler_error_gracefully, x_error_handler): Removed; you can't catch X errors this way, since you can't perform X operations from within an X error handler, and even though we call error, we're still within an X error handler. (x_error_quitter, x_error_catcher): New functions, for panicking on and catching X protocol errors. (x_caught_error_message): Buffer for caught X errors. (x_catch_errors, x_check_errors, x_uncatch_errors): New functions for catching errors. (x_term_init): Set the error handler to x_error_quitter, rather than x_error_handler. * xfns.c (x_set_mouse_color): Use x_catch_errors, x_check_errors, and x_uncatch errors to avoid crashing if the user selects an odd cursor. * xterm.c (x_proto_requests): Removed; it's not important. * xterm.c (events): Array removed; it's not used. * xfns.c (select_visual): Use XVisualIDFromVisual when available [HAVE_X11R4]. * xrdb.c (get_user_db): Use XResourceManagerString when available [HAVE_X11R4]. * window.c (change_window_height): If the size of the window will shrink below the minimum, this code would only try to delete it if it had a parent. Well, even if the window doesn't have a parent, you want Fdelete_window to signal an error, since you're trying to resize one of the undeleteable windows into nothingness. So call Fdelete_window even if the window doesn't have a parent. * window.c (MINSIZE): Add kludge so that the minibuffer is always allowed to shrink to one line in height. (MINSIZE, CURBEG, CURSIZE): Change these so that their argument are always Lisp_Objects, not struct window *'s. (change_window_height): Changed accordingly. Tue Aug 18 16:09:11 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * frame.h (struct frame): New member - explicit_name. * frame.c (make_frame): Clear it. * xfns.c (x_set_name): Take new argument EXPLICIT, instead of OLDVAL. (x_explicitly_set_name, x_implicitly_set_name): New functions. (x_frame_parms): Use x_explicitly_set_name here. (x_window): Use x_implicitly_set_name here. * xdisp.c (display_mode_line): Use x_implicitly_set_name here. * xterm.c (x_wm_hints): Variable deleted. This has to be per-screen. Duh. * xterm.h (struct x_display): New member: wm_hints. * xterm.c (x_wm_set_window_state, x_wm_set_icon_pixmap, x_wm_set_icon_position): Use F->wm_hints, rather than x_wm_hints. (x_term_init): Don't initialize x_wm_hints here. * xfns.c (Fx_create_frame): Instead, initialize f->x_wm_hints here. * xterm.c (x_set_text_property): Properly balance the BLOCK_INPUTs and UNBLOCK_INPUTs. And remember that VALUE is the string we want to set the name to, not PROPERTY. Mon Aug 17 15:39:28 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * frame.c (make_minibuffer_frame): Don't set this to auto-raise by default. It's annoying. * frame.c (make_minibuffer_frame): Set the prev field of the minibuffer window on a minibuffer-only frame to Qnil, rather than having it point to itself. This confuses code (Fprevious_window and change_window_height, for example), and is only an attempt to support a convention that can't really be used in Emacs 19 anymore. * window.h: Document the fact that we can no longer assume that the minibuffer's previous window is the root window, since a minibuffer window in a minibuffer-only frame has a prev field of nil. * frame.h [not MULTI_FRAME] (FRAME_ROOT_WINDOW): Define this by reference to the_only_frame.root_window, rather than by assuming that minibuf_window->prev is the root window. While this is true in the non-multi-frame case, we want to discourage this assumption in code. * dispnew.c [not MULTI_FRAME] (Fredraw_display): Use FRAME_ROOT_WINDOW instead of minibuf_window->prev. * xdisp.c (redisplay, init_xdisp): Same. * window.c (Fset_window_configuration): Removed #if 0'd code which assumes that minibuf_window is on the same frame as the window configuration. Removed special case for windows whose prevs point to themselves. * window.c (Fset_window_configuration): Rename the argument from ARG to CONFIGURATION, so it matches the docstring. The make-docfile program cares. * window.c [MULTI_FRAME] (syms_of_window): Don't staticpro minibuf_window; the frame list will take care of it. * xterm.h (HAVE_X11R4): Since we can autodetect this, and can write code more likely to be future-compatible, define this when appropriate. * xterm.c (x_set_text_property): Define this appropriately for X11R3 and X11R4. * xterm.c (x_set_text_property): Make this take a Lisp_Object string as an argument, rather than a pointer and a length. * xfns.c (x_set_name): Caller changed. * xfns.c (x_get_arg): Accept a new type - symbol. If we've retrieved a string from the xrdb database and the user wants a symbol, intern it. (Fx_create_frame): Use the symbol type here. * xfns.c (x_figure_window_size, x_icon, Fx_create_frame): Use values from enum resource_types for the last arg to x_get_arg, instead of passing numbers. * xfns.c (Fx_create_frame): When setting up the scroll bars, use the type parameter to x_default_parameter, rather than prefixing the resource name with a question mark. * xfns.c [not HAVE_X11] (Fx_create_frame): The resource which determines whether or not to use a bitmapped icon is called "IconType", not "BitmapIcon". Update this. Sat Aug 15 12:12:53 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * xterm.c: Doc fixes. More SYSV portability changes from Eric Raymond: * xterm.c [USG5]: Don't include . * xterm.c (x_make_frame_invisible): Instead of calling XWithdraw window, which isn't widely available, write out what it does, since that's not much. (x_iconify_frame): Explicitly perform both the X11R3 and X11R4 methods for iconification; don't use XIconifyWindow, since that's not present in R3. * xterm.c (x_wm_set_size_hint): Don't bother setting the base_width and base_height members; their function is performed just as well by the min_width and min_height members, and if we use XSetNormalHints instead of XSetWMNormalHints, we can be compatible with R3. * xterm.c (x_error_handler): There is no way to invoke the default error handler which works on all versions of X11, so don't bother; call XGetErrorText and print the message ourselves. * xterm.c (x_term_init): Don't use MAXHOSTNAMELEN; this isn't defined on all systems. Since we only use that as an initial guess anyway, it's not very important. Fri Aug 14 20:51:14 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * abbrev.c (Fexpand_abbrev): If pre-expand hook changes the buffer, assume that means we "did an expansion". * cmds.c (internal_self_insert): Ignore value of Fexpand_abbrev; instead, check whether buf is modified when it returns. Fri Aug 14 12:29:56 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) Applied SYSV portability changes from Eric Raymond: * xrdb.c [USG5]: Define SYSV, and then include . Apparently, Xlib.h include string.h if SYSV is defined, and strings.h if not. Don't include ; just declare getuid to return an int. Big deal. (MAXPATHLEN): If this is not defined by the system's include files, give it a value of 256. (get_user_db): Fetch the defaults directly from the display structure, rather than using XResourceManagerString; that function doesn't exist in the older versions of X. * xterm.c (x_set_text_property): New function. * xfns.c (x_set_name): Use it instead of XSetWMName and XSetWMIconName. * xfns.c (select_visual): Fetch the visual id directly from v; don't call XVisualIDFromVisual, since that function is not available in earlier versions of X. * term.c (term_get_fkeys): Some systems define `static' to be the empty string, which means that you can't have constant initialized arrays inside a function. So move the `keys' array outside of the function. * xdisp.c (decode_mode_spec): Same deal, with lots_of_dashes. * xfns.c (x_make_gc): Same deal, regarding cursor_bits. * term.c (keys): Include definitions for "K2" (the center key on an IBM keypad), "F1" (F11), and "F2" (F12). Handle "k0" and "k;" specially; see the code for details. * term.c (clear_end_of_line): Remember that on some systems, "static" gets defined to be the null string, so we can't declare an array to be static and then initialize it. Since the array in question (buf) is only one element long, just make it a scalar rather than an array; it can then be initialized, even if it's not static. * systime.h [not HAVE_TIMEVAL] (EMACS_USECS, EMACS_SET_USECS): Don't forget to define dummy versions of these. * systime.h [USE_UTIME]: time_t is a typedef, not a struct. Don't prefix it with `struct'. * systerm.h (EMACS_SET_TTY_PGRP): When there doesn't seem to be any way to do this, don't forget to give it a dummy definition. * sysdep.c (select): There's no need to cast the return value of signal anymore, since we have the SIGTYPE macro defined. * sysdep.c (read_input_waiting): When scanning for quit characters, use the value of quit_char, rather than assuming that C-g is the quit character. And don't forget to declare i. * sysdep.c [USG5]: Don't include fcntl.h. * s/usg5-3.h: Eric Raymond writes: Define HAVE_SELECT and BSTRINGS only if HAVE_X_WINDOWS is on, because that means we'll be linking in the shared libraries containing the BSD emulations. Teach the file about the shared libraries necessary to link X programs, because AT&T doesn't supply static libraries for X. Also, fix the incorrect assertion that -lg cannot be used with SVr3. Finally, force USE_UTIMES and BROKEN_TIOCGWINSZ. (Note for the future; there may be a utimes(2)) emulation lurking in the X shared libraries.) * s/usg5-4.h (USE_UTIME): Remove this definition; the C library still doesn't have utimes. * ralloc.c (get_bloc): When initializing new_bloc->variable, cast NIL to (POINTER *). (malloc_init): Give warning if sbrk returns zero. Wonder what that's supposed to mean. * process.c (process_send_signal): Don't send SIGTSTP if the system doesn't have that facility. * process.c: [USG5] Don't include . [USG] Don't bother including , , or ; systerm.h takes care of all that. Remove the "mis;tak-+;;" line from the code; apparently this section of code does get used. * minibuf.c (Fread_from_minibuffer): Put this function's doc string into a comment; it's too long for the PCC preprocessor. Rah. (Fcompleting_read): Same deal. * keyboard.c (init_keyboard): Changed "#endif SIGIO" to "#endif /* SIGIO */" * mocklisp.c (Fml_substr): Same sort of thing. * process.c (wait_reading_process_input): Same. * floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely available, and hardly vital. (syms_of_floatfns): Adjusted appropriately. * floatfns.c (Flog): Accept optional second arg, being the base for the logarithm. [USG] (Flogb): Define this in terms of Flog. * data.c [USG] (Frem): Call fmod, rather than drem. Rah. * emacs.c [USG5]: Don't #include for these systems. * alloc.c (Fmake_marker): Removed the test for being called from a signal handler. The original bug is probably gone, the test wasn't written portably, and it should probably go somewhere else anyway - say, funcall or eval. End of changes from Eric Raymond. * xfns.c (Fx_create_frame): Make the default for the icon-type parameter nil, not t. It seems to cause problems with some X servers. * lisp.h (DEFVAR_PER_BUFFER): Add new argument, TYPE, to help check the types of buffer-local variable slots. * buffer.c (syms_of_buffer): Call DEFVAR_PER_BUFFER with the new TYPE argument. * abbrev.c (syms_of_abbrev): Same. * buffer.c (buffer_local_types): New variable. (buffer_slot_type_mismatch): New function. * buffer.h (buffer_local_types): New extern declaration. * data.c (store_symval_forwarding): When storing through a Lisp_Buffer_Objfwd, check if the slot requires a particular type, and report an error if the types clash. * lread.c (defvar_per_buffer): Support new TYPE argument, by setting the appropriate slot in buffer_local_types. Thu Aug 13 14:52:14 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * window.c (window_loop): This used to keep track of the first window processed and wait until we came back around to it. Sadly, this doesn't work if that window gets deleted. So instead, use Fprevious_window to find the last window to process, and loop until we've done that one. * window.c [not MULTI_FRAME] (init_window_once): Don't forget to set the `mini_p' flag on the new minibuffer window to t. * window.c (Fwindow_at): Don't check the type of the frame argument. * window.c [not MULTI_FRAME] (window_loop): Set frame to zero, instead of trying to decode it. * frame.h [not MULTI_FRAME] (the_only_frame): Put a comment above this indicating that it's not GCPRO'd. Put parens around some of the FRAME_* macros' definitions. [not MULTI_SCREEN] (Fselected_frame): New function. * frame.h [not MULTI_FRAME] (FRAME_ROOT_WINDOW): Define this in terms of minibuf_window, rather than by reference to the_only_frame. * window.c (init_window_once): Initialize minibuf_window before FRAME_ROOT_WINDOW, so the latter actually points to something. * keyboard.c (Fexecute_mouse_event): dyked-out function deleted. We're not going to use this mouse interface. (Vmouse_window, Vmouse_event, Vmouse_event_function, Vmouse_left_hook, Vmap_frame_hook, Vunmap_frame_hook, Vmouse_motion_handler): Variables deleted; they were to be used by Fexecute_mouse_event. (syms_of_keyboard): Same. (command_loop_1): Remove dyked-out code to support Fexecute_mouse_event. (read_char): Same. * keyboard.c (Vlast_event_frame): Don't define this window if MULTI_FRAME is not #defined. (syms_of_keyboard): Same. (kbd_buffer_store_event): Don't try to work with Vlast_event_frame if MULTI_FRAME is not #defined. (kbd_buffer_get_event): Same. * keyboard.c (Fdiscard_input): Removed dyked-out code from when unread_command_char's quiescent value was -1, not nil. * frame.c (make_frame): Stop passing zero to make_window; it's not expecting any arguments. Wed Aug 12 10:22:49 1992 Jim Blandy (jimb@albert.gnu.ai.mit.edu) * unexsunos4.c: Deleted "$Log" header in comments at top of file; this was beginning to grow RCS hair, which we don't want. * xmenu.c: Same deal. Tue Aug 11 10:15:30 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * fileio.c (Fread_filename): Don't add one here. * minibuf.c (Fcompleting_read): Instead, stop subtracting one here, so this function lives up to its doc string, which I think specifies an okay way to work. * doc.c (Vdata_directory): Removed; this is declared in callproc.c. (syms_of_doc): Initialization removed. * xfns.c (x_get_arg): Return Qunbound for an unspecified resource, not nil. That way, we can tell the difference between a false resource and an unspecified resource. (x_default_error): Use DEFLT if x_get_arg returns Qunbound, not Qnil. (x_figure_window_size, x_icon, Fx_create_frame): Deal with Qunbound and Qnil properly. * xfns.c (Fx_create_frame): Pass the correct number of arguments to x_set_font. * xfns.c [not HAVE_X11] (Fx_create_frame): Delete section that's only included if we *do* have X11. Blind patching. * xfns.c (x_icon): Rewritten to call x_wm_set_icon_position and x_wm_set_window_state instead of calling XSetWMHints directly. * xterm.c (x_wm_hints): New variable. (x_wm_set_window_state, x_wm_set_icon_pixmap, x_wm_set_icon_position): Use x_wm_hints. (x_term_init): Set the `input' field of x_wm_hints, and its flag. * xterm.c (x_text_icon): Call x_wm_set_icon_pixmap with a pixmap of zero, to clear the pixmap. (x_wm_set_icon_pixmap): Accept this protocol; if pixmap is zero, specify no pixmap for the icon. * xfns.c (x_default_parameter): Don't call store_frame_param here; it's already taken care of by x_set_frame_parameters. * xfns.c (Fx_create_frame): Check for the `icon-type', `auto-raise', and `auto-lower' parameters. Have `icon-type' default to t, indicating that we want the nifty gnu in our icons. (Qauto_lower): New symbol. * xfns.c (x_set_icon_type): UNBLOCK_INPUT before reporting the error, not after. error doesn't return, sklitch-brain. * xterm.c (x_set_window_size): Call check_frame_size to make sure that the requested dimensions are within acceptable limits. Store the new size information in the frame structure. * xfns.c (x_set_frame_parameters): Properly recognize changes to the height of the frame. Recognize changes of the frame's position. * xfns.c (x_set_frame_parameters): Iterate over ALIST while the current element is cons, not while it's non-nil. (syms_of_xfns): Call init_x_parm_symbols after interning all the other atoms; init_x_parm_symbols expects Qx_frame_parameter to be initialized. Mon Aug 10 07:56:47 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * xfns.c (Qbackground_color, Qborder_color, Qborder_width, Qcursor_color, Qfont, Qforeground_color, Qgeometry, Qhorizontal_scroll_bar, Qicon_left, Qicon_top, Qiconic_startup, Qinternal_border_width, Qleft, Qmouse_color, Qparent_id, Qsuppress_icon, Qsuppress_initial_map, Qtop, Qundefined_color, Qvertical_scroll_bar, Qwindow_id, Qx_frame_parameter): New symbols, with lisp code to rebuild syms_of_xfns. (syms_of_xfns): Initialize and staticpro them. (Qheight, Qminibuffer, Qname, Qnone, Qonly, Qwidth, Qunsplittable): Add extern declaration for these. (x_init_parm_symbols): Don't initialize Qx_frame_parameter here; it's done in syms_of_xfns. (x_default_parameter): Change the argument char *PROPNAME into a Lisp_Object PROP; let the caller take care of interning the atom. (Fx_geometry, x_figure_window_size, x_icon, Fx_create_frame): Use the new Q... variables, instead of interning things. * frame.c (Qheight, Qicon, Qmodeline, Qname, Qnone, Qonly, Qunsplittable, Qwidth, Qx): New symbol, with lisp code to rebuild syms_of_frame. (syms_of_xfns): Initialize and staticpro them. (Fframep, Fframe_visible_p, Fframe_parameters): Use the new Q... variables, instead of interning things. (store_in_alist): Change the argument char *PROPNAME into a Lisp_Object PROP; let the caller take care of interning the atom. * frame.c (Fframe_visible_p): Doc fix. * frame.c (Fframe_parameters): When figuring the `minibuffer' parameter, if FRAME doesn't have a minibuffer, return `none', not nil. If it does have a minibuffer with other windows, return the window. * frame.c (Fmodify_frame_parameters): Don't write out the loop for processing X frame parameters here; do it in the x specific code. Call the function which deals with this stuff x_set_frame_parameters, not x_set_frame_parameter. * xfns.c (x_set_frame_param): Replaced by x_set_frame_parameters. (x_set_frame_parameters): Process the alist of parameters here. Notice `width', `height', `top', and `left' parameters. Hold off changing the frame size and position until the end, so we can do both parameters at once when they are both specified. (x_default_parameter): Call x_set_frame_parameters, not x_set_frame_param. * frame.c (Fmake_frame_visible, Fmake_frame_invisible, Ficonify_frame, Fframe_parameters, Fmodify_frame_parameters, Fset_frame_height, Fset_frame_width, Fset_frame_size, Fset_frame_position): Place clauses controlled by FRAME_X_P inside `#ifdef HAVE_X_WINDOWS ... #endif' clauses. * frame.c (Fset_frame_position): Doc fix. * dispnew.c (Fredraw_frame): Call clear_frame_records before calling update_end, so that x_display_box_cursor can rely on the contents of f->current_glyphs. * xfns.c (x_figure_window_size): Indicate that this function returns an int, rather than just leaving it unstated. * xterm.c (x_wm_set_size_hint): Don't try to set the base_height and base_width elements of size_hints if PBaseSize is not #defined. Set the minimum frame size according to the information returned by check_frame_size. * window.h (MIN_SAFE_WINDOW_HEIGHT, MIN_SAFE_WINDOW_WIDTH): Macros removed. (check_frame_size): New extern declaration. * window.c (MIN_SAFE_WINDOW_HEIGHT, MIN_SAFE_WINDOW_WIDTH): Macros defined here now. (check_frame_size): New function. * dispnew.c (change_frame_size): Call check_frame_size here, rather than writing out its code. Don't declare newheight and newwidth to be register variables, since we take their address. * bytecode.c (Fbyte_code): When metering the Bcall opcodes, make sure the count on the symbol's `byte-code-meter' property does not overflow. * bytecode.c (syms_of_bytecode): Add a docstring for byte-metering-on. Sat Aug 8 13:27:51 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * dispnew.c (in_display): Variable deleted; it's only ever used as an unofficial parameter to change_frame_size. (change_frame_size): New argument, DELAY, which when non-zero indicates to delay the size change until later. This should be passed as one from signal handlers. (window_change_signal): Call change_frame_size with a DELAY of 1. (do_pending_window_change): Call change_frame_size with DELAY of 0. * frame.c [MULTI_SCREEN] (Fset_frame_height, Fset_frame_width, Fset_frame_size): Same. [not MULTI_SCREEN] (Fset_frame_height, Fset_frame_width, Fset_frame_size, Fset_screen_height, Fset_screen_width): Same. * keyboard.c (Fsuspend_emacs): Call change_frame_size with the proper arguments - the height and width are the second and third arguments, not the first and second. Pass 0 for DELAY. * xfns.c (Fx_create_frame): Call change_frame_size with a DELAY of 0. * xterm.c (XTread_socket, x_do_pending_expose): Call change_frame_size with a DELAY of 1. * xterm.c (in_display): Deleted this; it's never used in xterm.c, and there is another variable by the same name in dispnew.c. * frame.c [not MULTI_SCREEN] (Fset_frame_height, Fset_frame_width, Fset_frame_size, Fframe_height, Fframe_width): New functions, for use when Emacs is not compiled with multiple screens. [not MULTI_SCREEN] (Fset_screen_height, Fset_screen_width): Functions added for backward compatibility with Emacs 18. These would be just aliases, except that the version 18 functions don't take a FRAME argument. [not MULTI_SCREEN] (syms_of_frame): New function, to defsubr the above and add screen-height and screen-width as aliases for Fframe_height and Fframe_width. * emacs.c (main): Call syms_of_frame unconditionally. When MULTI_FRAME is not defined, it still provides the Fframe_width, Fframe_height, Fset_frame_width, and Fset_frame_height functions. * frame.c (Fset_frame_width): Change the size of FRAME, not of selected_frame. * frame.c (Fset_frame_width, Fset_frame_height): Declare the `frame' argument to be a Lisp_Object. It used to be undeclared. Fri Aug 7 07:27:37 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * dispnew.c, frame.c, frame.h, keyboard.c, scroll.c, term.c, window.c, xdisp.c, xfns.c xterm.c (FRAME_IS_TERMCAP, FRAME_IS_X, FRAME_HAS_MINIBUF): Renamed these to FRAME_TERMCAP_P, FRAME_X_P, and FRAME_HAS_MINIBUF_P, for consistency with the rest of the frame macros. * window.h (MIN_SAFE_WINDOW_WIDTH, MIN_SAFE_WINDOW_HEIGHT): New macros. * window.c (check_min_window_sizes): New function. (set_window_height): Call it. (Fsplit_window, change_window_height): Call it, instead of writing out its code. * dispnew.c (change_frame_size): If newlength or newwidth are too small (according to the value of MIN_SAFE_WINDOW_{WIDTH,HEIGHT}), force them larger. This isn't really right, but it's better than crashing. * editfns.c (Fcurrent_time_zone): Doc fix. Thu Aug 6 04:13:11 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * editfns.c (Fcurrent_time_zone): Don't forget to include code to signal an error when EMACS_CURRENT_TIME_ZONE is not defined. Thu Aug 6 03:25:23 1992 Joseph Arceneaux (jla@gnu.ai.mit.edu) * doc.c (Vdata_directory): Declared. (syms_of_doc): Initialized. * fileio.c (Fread_filename): Add 1 to the offset position for the cursor when reading file names. Wed Aug 5 01:34:21 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * systime.h (EMACS_CURRENT_TIME_ZONE): New macro. * editfns.c (Fcurrent_time_zone): New function. (syms_of_editfns): defsubr it. * keyboard.c (read_key_sequence): Clear the eighth bit of the character from the key sequence, NOT the index of the character IN the key sequence. How many tries will it take to get it right? Tue Aug 4 17:22:18 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * eval.c (syms_of_eval): Doc fix for debug-on-quit. Mon Aug 3 01:35:40 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * callproc.c (Fcall_process): Doc fix. Used to claim that Fcall_process doesn't wait when BUFFER was nil. It does. Thu Jul 30 16:20:48 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * keyboard.c (read_key_sequence): Scan for function keys when t >= mock_input, not when t > mock_input. We do want to scan for function keys when t == mock_input. * keyboard.c (read_key_sequence): Don't increment fkey_end when testing to see if keybuf[fkey_end] is a meta-character. Mon Jul 27 17:23:14 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Makefile.in (TAGS): Generate tags for files in ../external-lisp too. Sun Jul 26 15:34:16 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * eval.c (find_handler_clause): For quit, don't check Vdebug_on_error. (wants_debugger): Rewrite so it cannot get an error. * callint.c (Fcall_interactively): Handle enable-recursive-minibuffers property on the command, by enabling recursive minibuffers. (syms_of_callint): Set Qenable_recursive_minibuffers. Fri Jul 24 20:34:39 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * frame.c (Fmake_frame_visible, Fmake_frame_invisible, Ficonify_frame): Make the first argument optional, defaulting to selected_frame. (Ficonify_frame, Fmake_frame_invisible): Add interactive specs, so we can bind these directly to C-z. Fri Jul 24 02:44:09 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Fread_file_name): Use new calling convention for Fcompleting_read, with history as Qfile_name_history. (syms_of_fileio): Set Qfile_name_history; set the var to nil. Do staticpro for the recently created Q* vars. * minibuf.c (read_minibuf): Two additional args histvar and histpos. All calls changed. (Fcompleting_read): Last arg is now HIST--(HISTVAR . HISTPOS). Arg INIT can now be (INITIAL-STRING . INITIAL-POSITION). Pass BACKUP_N arg to read_minibuf properly as Lisp object. (Fread_from_minibuffer): Likewise. (syms_of_minibuf): Set Qminibuffer_history and staticpro it. * eval.c (Ffuncall, Feval): Support subrs with 7 args. * fns.c (Fyes_or_no_p): Use Fread_string, not read_minibuf. * callint.c (Fcall_interactively): For 'S', use Fread_no_blanks_input rather than read_minibuf. Thu Jul 23 22:45:46 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * minibuf.c (Vminibuffer_history_variable): New variable. (syms_of_minibuf): Define variable minibuffer-history-variable. (read_minibuf): Push the string on specified history list. Thu Jul 23 22:35:37 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * Makefile.in (doall, doxemacs, dotemacs): Put quotes around CC=${CC}. Don't include $(MAKEOVERRIDES); that is always implicit. Wed Jul 22 11:17:08 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): If we have read a meta-character, prefix it with meta_prefix_char before looking it up in the function key keymap. * lread.c (Fread_char_exclusive): Code this with a do-while loop, not a while loop with its body repeated. * lread.c (Fread_event): Don't make this function's definition conditional on X-windows. It ought to be there no matter how Emacs was built. (syms_of_lread): Don't make its defsubr conditional either. * lread.c (Fread_char): Doc fix. * fileio.c (find_file_handler): It's called Vfile_name_handler_alist, not Vfile_handler_alist. (Fwrite_region): Declare the variable named `handler'. (Fverify_visited_file_modtime): Use `b->filename', not `filename'. (Fset_visited_file_modtime): Declare the variable named `handler'. * dired.c (Fdirectory_files, Ffile_name_completion): Use `dirname', not `filename'. (Qfile_attributes): New variable. (syms_of_dired): Initialize it. * xselect.c (Fx_own_selection): If we're trying to set cut-buffer0, and the value is too large for the X server (as indicated by the max_request_size member of the X Display), just set the buffer to the empty string, and return nil. Tue Jul 21 23:10:36 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * search.c (fast_string_match): New function. * fileio.c (find_file_handler): New function. (Fcopy_file, Fmake_directory, Fdelete_directory, Fdelete_file): (Frename_file, Fadd_name_to_file, Fmake_symbolic_link): (Ffile_exists_p, Ffile_executable_p, Ffile_readable_p, Ffile_symlink_p) (Ffile_writable_p, Ffile_directory_p, Ffile_accessible_directory_p): (Ffile_modes, Fset_file_modes, Ffile_newer_than_file_p): (Fwrite_region, Fverify_visited_file_modtime): Use find_file_handler; call the handler and return. (Finsert_file_contents): Use find_file_handler; cannot just return after the handler, but must handle VISIT. (syms_of_fileio): Set up Qcopy_file, etc. * dired.c (Fdirectory_files, Ffile_name_completion): (Ffile_name_all_completions, Ffile_attributes): Use find_file_handler; call the handler. (syms_of_dired): Set Qfile_attributes, etc. Tue Jul 21 16:26:44 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xselect.c (Fx_own_selection): Initialize val to nil, so that if we don't get the selection, we don't return garbage. When setting cut-buffer0, set val to the string pasted. * xfns.c (x_set_name): If ARG is nil, set the frame's name to the current x_id_name. * xdisp.c (display_mode_line): If we should set the frame's name, but there is only one frame currently active, call x_set_name with nil as the name; this will display samething generically appropriate. Mon Jul 20 15:06:24 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * lread.c (isfloat_string): Recognize floats without a leading integer part, noting that "e5" is a symbol, not a floating point number. * xdisp.c (message, message1): When displaying a message, don't make the minibuf frame visible unless the selected frame is also visible. This means that frames won't pop up unless the user is actually interacting with Emacs. * xdisp.c (display_mode_line): If Emacs is currently supporting only one screen, don't change the title of the screen to the name of the current buffer; this is only annoying in this case. We should probably think more carefully about how screens should be named. Sun Jul 19 13:43:26 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (allocate_pty): Handle PTY_OPEN. Delete system-specific alternatives to PTY_NAME_SPRINTF and PTY_TTY_NAME_SPRINTF. Sat Jul 18 21:07:10 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * callint.c (Fprefix_numeric_value): Fix typo: test raw, not val. Fri Jul 17 16:35:54 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xfns.c (x_window): x_set_name normally ignores requests to set the name if the requested name is the same as the current name. This is the one place where that assumption isn't correct; f->name is set, but the X server hasn't been told. So fake it out. * emacs.c [sun] (main): On suns, localtime caches the value of the time zone rather than looking it up every time. This means that the dumped Emacs doesn't check the value of the TZ environment variable. Call tzset before entering the editing loop to check the new TZ value. Thu Jul 16 11:39:38 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * dired.c (Fdirectory_files): Don't forget to pass the REGP argument to compile_pattern. * search.c (compile_pattern): If REGP is zero, don't call re_set_registers; nobody cares. * fileio.c (auto_save_error): Pass the correct number of arguments to Fsleep_for. * lread.c: Include at the top of the file, instead of just before isfloat_string; read0 wants to use it too. * process.c (Fdelete_process, Fprocess_status, Fprocess_send_region, Fprocess_send_string, Fprocess_send_eof, Finterrupt_process): Doc fixes. * process.c (Fprocess_status): Use get_process to find the process denoted by the PROC argument, not Fget_process. Wed Jul 15 13:51:43 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xdisp.c: Doc fix. Tue Jul 14 10:42:58 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * window.c (syms_of_window): Doc fix for pop-up-frames. * frame.c (Fframe_parameters): Note that if FRAME is omitted, it defaults to the selected frame. * frame.c (Fframe_height, Fframe_width): Blocked out these functions; they have no C callers, and can be written nicely in lisp. * frame.c (Fframe_pixel_size): Function removed; there aren't enough other functions available to make this useful. We need functions describing the size of the characters of a font. * xterm.h, xterm.c, xselect.c, xmenu.c, xfns.c, xdisp.c, window.h, window.c, termopts.h, termhooks.h, termchar.h, term.c sysdep.c, scroll.c, screen.c, screen.h, process.c, print.c, minibuf.c, lisp.h keyboard.c, indent.c, fns.c, emacs.c, dispnew.c, dispextern.h, cm.h, alloc.c, config.h.in: Screens are now called frames, to avoid even more confusion with X terminology than Emacs's "windows" already cause. All macros, functions, and variables renamed; all uses changed. * screen.c, screen.h: Renamed to frame.c and frame.h. All #includers changed. * ymakefile: Adjusted appropriately. * buffer.c: Doc fixes. * xfns.c (Fx_store_cut_buffer): Reversed sense of test for non-X screen. * window.c (Frecenter): Doc fix; this function places point in the middle of the current window, not the current screen. * window.c (temp_output_buffer_show): Use WINDOW_SCREEN macro instead of accessing the member directly. Mon Jul 13 14:21:34 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * print.c (print): Changed code which prints screen objects to use the SCREEN_LIVE_P macro instead of testing the screen structure directly. * alloc.c (undo_threshold, undo_high_threshold): Variables renamed to undo_limit and undo_strong_limit. (Fgarbage_collect): Uses changed. (syms_of_alloc): DEFVARs and docstrings changed. * undo.c (truncate_undo_list): Comment adjusted. * lread.c (read0): Allow floating-point numbers to begin with a period. `(0 .5)' denotes a list of two numbers, not a dotted pair. Sat Jul 11 14:15:43 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fns.c, callproc.c: Doc fix. Fri Jul 10 17:16:09 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * bytecode.c (Bsymbol_function, Bfset): Removed comments saying that these are no longer generated. Jamie Zawinski's byte compiler does generate them, and he's actually collected statistics on how often these functions are called. Thu Jul 9 21:47:45 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * screen.c (store_screen_param): Clarify error message. * xterm.c (x_make_screen_visible): Undo the change made on June 30; that is not the right solution. Apparently there are three states a window may be in: normal, iconified, and invisible. Wed Jul 8 15:14:36 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * eval.c (Fmacroexpand): Code cleaned up; there's no need to handle forms like ((macro lambda ...) ...) specially. * fileio.c (Finsert_file_contents): Signal an error if we're asked to read from a named pipe. Tue Jul 7 15:55:40 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * m/*.h (SIGN_EXTEND_CHAR): Removed these definitions. The only place they were used is in regex.c, and nowadays that has its own definition, which works for any machine. The definitions in the machine description files usually didn't work if given an unsigned character as an argument, anyway. Sat Jul 4 12:11:09 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c: Doc fix. Thu Jul 2 18:27:26 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * minibuf.c (Fdisplay_completion_list): Declared new variables used in rms' previous change. Thu Jul 2 18:11:43 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * minibuf.c (Fdisplay_completion_list): Handle non-buffer stream. Wed Jul 1 22:30:31 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * window.c (Fdisplay_buffer): Add interactive spec. Tue Jun 30 18:22:00 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * mem_limits.h: EXCEEDS_ELISP_PTR declared here. * ralloc.c: No longer declared here. * vm-limit.c: Nor here. Also, include "lisp.h" before "mem_limits.h" and additionally include "config.h". Tue Jun 30 06:01:04 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * xterm.c (x_make_screen_visible): Don't de-iconify the window; iconification is orthogonal to visibility. * emacs.c (syms_of_emacs): Change docstring for `kill-emacs-hook' to describe it as a hook, not as a single function. Mon Jun 29 03:53:58 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * minibuf.c (Fread_no_blanks_input): Corrected maximum number of arguments from one to two. * emacs.c (Vkill_emacs_hook): Declare this here; it should have a docstring, so we might as well DEFVAR it. (syms_of_emacs): initialize it, and DEFVAR_LISP it with an appropriate docstring. Sun Jun 28 03:58:20 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * lread.c (Feval_buffer): Make the DEFUN match the C argument list; this takes two optional arguments, not just one. * lisp.h (Lisp_Buffer_Local_Value): Comments neatened. * data.c (Fset): Fixed conditional which tests whether the cache is invalid. It used to be pretty munged, and would always declare the cache invalid for Lisp_Buffer_Local_Value variables. Now it declares the cache invalid if the buffer is wrong (obviously), of Sat Jun 27 04:12:49 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * data.c (Fset): Comments reformatted for readability. * xterm.c (last_mouse_movement_time): New variable. (note_mouse_position): Set it. (XTmouse_position): Return its current value as the position's timestamp. * keyboard.c (Qvertical_split): Renamed to `vertical-line', since the window arrangement is actually referred to as a `horizontal split.' (make_lispy_event, make_lispy_movement, syms_of_keyboard): Uses renamed here. keyboard.h (Qvertical_split): Extern declaration changed here. window.c (Fcoordinates_in_window_p): Changed this to return `vertical-line' at the appropriate times, rather than `vertical-split'. * window.c (Fcoordinates_in_window_p): Put symbol names in opposing single quotes - `vertical-split', for example. * fileio.c (Fexpand_file_name): Don't signal an error if USERNAME in a "~USERNAME/..." filename isn't a real user; just leave the "~USERNAME" unchanged. * fileio.c (Fmake_symbolic_link): Rename argument `NEWNAME' to `LINKNAME', to conform with the docstring. * Makefile.in (CPP): Pass `-Is -Im' to CPP, to make sure that machine- and system-dependend files can include each other properly. * ymakefile (CFLAGS): Add those directories to the #include path here too. * Makefile.in (xmakefile): Build this via a temporary file, so that if preprocessing fails we don't nuke the xmakefile. * fileio.c: There are two versions of Fexpand_file_name defined here; the latter is inside a `#if 0' clause. Change its DEFUN to a DEAFUN, so that its docstring doesn't make it into the DOC file and supercede the real docstring. * callint.c (Fcall_interactively): For the 'K' interactive spec, set varies[i] to -1, indicating that the mouse click should be quoted if the function makes it into the command history, and that this argument by itself does not qualify the command to be recorded in the history. Fri Jun 26 05:57:01 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * data.c (Frem): The drem function will sometimes return a negative number. If it does, add the divisor to it, to make it positive. * screen.c: Put '#ifdef MULTI_SCREEN' after the inclusion of config.h. * window.c (Fpos_visible_in_window_p): Remember to apply XSCREEN to w->screen before applying SCREEN_WIDTH. * screen.h [not MULTI_SCREEN] (last_nonminibuf_screen): Removed #definition of this; it's confusing when debugging. * screen.c (last_nonminibuf_screen): Variable moved from here... * dispnew.c (last_nonminibuf_screen): to here, beside selected_screen. They should both exist, even if the multi-screen support is not present. * dispnew.c [not MULTI_SCREEN] (the_only_screen): New variable. Instead of having the non-multi-screen version of Emacs refer to lots of different variables scattered hither and yon, we'll just declare this new variable, of type `struct screen', and define the single-screen versions of the `SCREEN_foo' macros to reference its elements. This avoids conflicts between names of local variables and names of global variables describing the screen, and simplifies some of the differences between the multi-screen and single-screen cases. * screen.h (enum output_method, struct screen): Removed these from the `#ifdef MULTI_SCREEN' conditional. * screen.h [not MULTI_SCREEN] (the_only_screen): extern declaration for it here. [not MULTI_SCREEN] (SCREEN_CURRENT_GLYPHS, SCREEN_DESIRED_GLYPHS, SCREEN_TEMP_GLYPHS, SCREEN_HEIGHT, SCREEN_WIDTH, SCREEN_NEW_HEIGHT, SCREEN_NEW_WIDTH, SCREEN_CURSOR_X, SCREEN_CURSOR_Y, SCREEN_ROOT_WINDOW, SCREEN_INSERT_COST, SCREEN_DELETE_COST, SCREEN_INSERTN_COST, SCREEN_DELETEN_COST, SCREEN_MESSAGE_BUF, SCREEN_SCROLL_BOTTOM_VPOS): Macros changed to refer to the_only_screen. * dispnew.c [not MULTI_SCREEN] (one_screen_cursX, one_screen_cursY, one_screen_current_glyphs, one_screen_desired_glyphs, one_screen_temp_glyphs, delayed_screen_width, delayed_screen_height): Variables deleted; they're all now kept in the_only_screen. * xdisp.c [not MULTI_SCREEN] (message_buf): Variable deleted; same fate. * term.c [not MULTI_SCREEN] (one_screen_width, one_screen_height): Variables deleted; same fate. * screen.h [not MULTI_SCREEN]: extern declarations for the above variables removed. * window.c [not MULTI_SCREEN] (root_window): Variable deleted. [not MULTI_SCREEN] (init_window_once): Use SCREEN_ROOT_WINDOW to refer to the root window, instead of referring to it directly. * window.h [not MULTI_SCREEN] (root_window): extern declaration removed. * scroll.c [not MULTI_SCREEN] (insert_line_cost, delete_line_cost, insert_n_lines_cost, delete_n_lines_cost): Variables deleted; same fate. * dispnew.c [not MULTI_SCREEN] (cursX, cursY): Renamed to `one_screen_cursX' and `one_screen_cursY'. * screen.h [not MULTI_SCREEN] (cursX, cursY, SCREEN_CURSOR_X, SCREEN_CURSOR_Y): extern declarations and macros changed accordingly. * term.c [not MULTI_SCREEN] (screen_width, screen_height): Renamed to `one_screen_width' and `one_screen_height', so as not to conflict with local variables when referenced by the `SCREEN_foo' macros. * screen.h [not MULTI_SCREEN] (screen_width, screen_height): extern declarations changed accordingly. * termchar.h (screen_width, screen_height): extern declarations deleted. Everyone should go through the `SCREEN_foo' macros. (SCREEN_WIDTH, SCREEN_HEIGHT): Changed accordingly. Thu Jun 25 21:37:27 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * callint.c (Fcall_interactively): When making a copy of the spec string, cast the return value of `alloca' to `unsigned char *', not `char *', to match the type of `string'. * xselect.c (Fx_own_selection): Cast XSTRING (string)->data to a char *, so it can be comfortably passed to XStoreBytes. * filelock.c (strcpy): Declare this to return char *. Wed Jun 24 01:36:44 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * dispnew.c (current_glyphs, desired_glyphs, temp_glyphs): Renamed to have the prefix `one_screen_', so that the screen macros can refer to them without conflicting with local variables. * screen.h [not MULTI_SCREEN] (SCREEN_CURRENT_GLYPHS, SCREEN_DESIRED_GLYPHS, SCREEN_TEMP_GLYPHS): Changed accordingly. * keyboard.c (read_key_sequence): Put the code which restarts the key sequence in a `#ifdef MULTI_SCREEN' conditional. * screen.h [not MULTI_SCREEN]: Added definitions for CHECK_LIVE_SCREEN and SCREEN_FOCUS_SCREEN for the non-multi-screen case. * screen.h [not MULTI_SCREEN]: The name is `SCREEN_MINIBUF_ONLY_P', not `SCREEN_IS_MINIBUF_ONLY'. * xdisp [not MULTI_SCREEN] (Fredraw_display): Removed definition here; the non-multi-screen version is already defined in dispnew.c, alongside the multi-screen version. (syms_of_xdisp): Don't try to defsubr Sredraw_display; it doesn't exist. * lread.c (Fread_char_exclusive): Remove this from the `#ifdef HAVE_X_WINDOWS' conditional; it is appropriate in any context. * eval.c (Fsignal): Put call to TOTALLY_UNBLOCK_INPUT under the protection of a `#ifdef HAVE_X_WINDOWS' conditional. * keyboard.c (kbd_buffer_get_event): Expect *mouse_position_hook to return the timestamp as an unsigned long, not a lisp_Object. This matches the change made to `struct input_event'. (make_lispy_movement): Change argument TIME to an unsigned long. * xterm.c (XTmouse_position): Change TIME argument to a pointer to an unsigned long. * termhooks.h (mouse_position_hook): Doc fix. * term.c (mouse_position_hook): Doc fix. * termhooks.h (struct input_event): If MULTI_SCREEN is defined, declare the .screen element to be `struct screen *'; otherwise, declare it to be `int'. See the comment in the file for why I've done this obviously wrong thing. * print.c (printbufidx): Doc fix. * xdisp.c (message_buf_print): Doc fix. * dispextern.h (message_buf_size): Variable deleted; it's no longer used, since the message buffer is always the width of the screen. * screen.h [not MULTI_SCREEN] (message_buf): Add extern declaration for it here. (message_buf_print): Added extern declarations here for both the MULTI_SCREEN and non-MULTI_SCREEN cases. * dispextern.h (message_buf, message_buf_print): Deleted extern declaration for these here. It should never be used directly; it should always be used through the SCREEN_MESSAGE_BUF macro. * dispnew.c (temp_glyphs): Added back this variable declaration; screen.h and various other places referred to this; where did it go? * screen.h [not MULTI_SCREEN] (temp_glyphs, desired_glyphs, current_glyphs): Add extern declarations for these. * dispnew.c (cancel_my_columns): Use SCREEN_DESIRED_GLYPHS macro, instead of assuming that a SCREEN_PTR is actually a pointer to something; it isn't if we're not using any of the screen support. Remove the variable `screen', and find the value for `desired_glyphs' directly. * xdisp.c (echo_area_display): Use the SCREEN_DESIRED_GLYPHS macro to find screen's desired cursor position, instead of assuming that a SCREEN_PTR is a pointer to something. (display_mode_line): Same. * window.c (Fpos_visible_in_window_p): Use the SCREEN_WIDTH macro. (replace_window): Use the SCREEN_ROOT_WINDOW macro. (window_loop): Use the SCREEN_WIDTH macro. * dispnew.c (update_screen): Enclose the statement which increments `downto' in a `#ifdef HAVE_X_WINDOWS' conditional. * screen.h [MULTI_SCREEN and not MULTI_SCREEN] (FOR_EACH_SCREEN): New macro. * dispnew.c (window_change_signal, do_pending_window_change): Use FOR_EACH_SCREEN instead of assuming that Vscreen_list exists. * window.h (root_window): Added extern declaration for this. * screen.c: Enclose the entire file in a #ifdef MULTI_SCREEN conditional. Tue Jun 23 17:47:28 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (Fset_window_dedicated_p): Replaces Fset_window_buffer_dedicated. Second arg just t or nil. Mon Jun 22 21:38:39 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * syntax.h (SYNTAX, SYNTAX_MATCH, SYNTAX_COMSTART_FIRST, etc.) Cast character to unsigned char before indexing. Fri Jun 19 02:04:51 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * xterm.c (x_wm_set_size_hint): Set size_hints.flags to indicate that we are providing the base_width and base_height data. * xfns.c (Fx_create_screen): Default the internal border width to 2; this matches XTerm. * syntax.c (Fparse_partial_sexp): Doc fix. * syntax.c (Fparse_partial_sexp): Added phony argument list to comment containing the docstring for this function, so that make-docfile.c will get the right arguments. * xfns.c (x_set_name): Don't go through the X11 brouhaha to set the name unless we're actually setting it to something different from the current name. Thu Jun 18 16:10:07 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * eval.c (syms_of_eval): Don't forget to escape the ends of the lines in the docstring for `debug-on-quit'. * keyboard.c (Fread_key_sequence): Reversed sense of CONTINUE_ECHO argument - set this_command_key_count to zero iff CONTINUE_ECHO is Qnil, not iff it's non-Qnil. Wed Jun 17 03:01:55 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * search.c: Changed to remember the object in which the last search was done, so that markers from match data are placed in that buffer, instead of the current buffer. (search_regs_from_string): Replaced with... (last_thing_searched): This is either Qnil, meaning no searching has been done, Qt, meaning that the last search was done in a string, or a buffer object, meaning that the last search was done in that buffer. (syms_of_search): Initialize and staticpro last_thing_searched. (Flooking_at, search_buffer): Set last_thing_searched to the current buffer. (Fstring_match): Set last_thing_searched to Qt. (Fmatch_data): Test last_thing_searched to see if any searching has been done, and construct integers or markers in the right buffer. Abort if it's not Qt, Qnil, or a buffer. (Fstore_match_data): Set last_thing_searched according to the things we find in LIST. Tue Jun 16 11:20:54 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * fns.c (Fload_average): Document the fact that this sometimes returns a list of fewer than three elements, on systems which don't provide 5- and 15-minute load averages. Mon Jun 15 00:33:06 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * xterm.c (XTread_socket): If an event arrives to a screen S, don't attribute them to SCREEN_FOCUS_SCREEN (S) here. Do that synchronously, when the events are dequeued. This keeps events from being accidentally routed to the wrong screen, if we temporarily redirect a screen's focus. * keyboard.c (kbd_buffer_store_event): If the character being stuffed is a quit character, do the SCREEN_FOCUS_SCREEN redirection to it here. (kbd_buffer_get_event): And do it here, before returning the event. * eval.c (Finteractive_p): This assumed that if the function in the top frame of the lisp backtrace was not a Lisp_Compiled object, then Finteractive_p must have an explicit frame on the top of the stack, which we could skip. It didn't bother to follow the symbol function chaining, and it would break if any C code called from a non-compiled function tried to call Finteractive_p anyway. Changed this to actually check if the top frame's effective function is the Lisp_Subr for Finteractive_p. This also used to skip any number of frames for special forms and/or Fbytecode calls. Changed this to skip an Fbytecode frame (if present), followed by any number of special form frames. Sun Jun 14 18:01:42 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * eval.c (struct backtrace): Doc fix. Fri Jun 12 05:57:23 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * m/hp300bsd.h (LOAD_AVE_TYPE): This is long, not double. (LOAD_AVE_CVT): Adjusted as appropriate. * fns.c: Moved lots of system-dependent preprocessor cruft dealing with getting the load average to `getloadavg.c'. (Fload_average): Guts moved to `getloadavg.c'. * getloadavg.c: New file, containing the necessary mess to get the load average on many different systems. This file is supposed to be Emacs-independent. * ymakefile (obj): Add getloadavg.o to the list. (getloadavg.o): Note that this depends on its source, and config.h. * screen.c (Fdelete_screen): Typo in loop looking for new last_nonminibuf_screen - change `screen = XCONS (screens)->cdr` to `screens = XCONS (screens)->cdr` * xdisp.c (echo_area_display): Don't neglect to draw all the lines of the minibuffer window (or echo area) when a message is being displayed. If the minibuffer is more than one line high, they should all be blanked. Wed Jun 10 15:41:36 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * sysdep.c [POSIX_SIGNALS] (sys_signal): Fix typo - rather than calling new_action as if it were a function, call sigaction. Tue Jun 9 22:22:32 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lisp.h (Qnumberp, Qnumber_or_marker_p): Declared. * eval.c (wants_debugger): Changed NULL to NILP. Who installed these calls to NULL? Tue Jun 9 14:06:48 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * dispnew.c (Fsit_for): Don't forget to actually set sec from ARG. * termhooks.h (struct input_event): Doc fix - for mouse clicks, .x and .y give the position in characters, not in pixels. * keyboard.c (format_modifiers): Order the modifier letters alphabetically - control, meta, shift, and up. Mon Jun 8 21:57:38 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c: Move some extern decls out of #if 0, to top of file. Mon Jun 8 18:24:54 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * window.c (Fcoordinates_in_window_p): Docstring fix. * buffer.c (Fother_buffer): Put a comma between arguments BUFFER and VISIBLE_OK in the argument list. Duh. * screen.c (Fdelete_screen): Remember that s is a SCREEN_PTR *, not a Lisp_Object. * search.c (search_regs): Doc fix. (compile_pattern): Take a new argument - the search register structure - so we can reassure the regex routines that the registers have been allocated. (Flooking_at, Fstring_match, search_buffer): Changed to pass &search_regs to compile_pattern. (search_buffer): When we've searched for a literal string and found it, make sure that the search registers are allocated before stuffing the location of the search into them. (Fstore_match_data): If we need to allocate more registers, allocate them using re_set_registers, instead of just storing the new registers and hoping that regex doesn't free them. * search.c (Freplace_match): Doc fix. Sun Jun 7 21:55:17 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * screen.c (Fdeiconify_screen): Function deleted. It was the same as make-screen-visible. Sat Jun 6 21:42:12 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c: Doc fix. * floatfns.c (Fcbrt): Renamed from Fcube_root, and #if 0'd. * lisp.h (CHECK_NUMBER_OR_FLOAT*): Use Qnumberp or Qnumber_or_marker_p. * data.c (syms_of_data): Staticpro those. (Qinteger_or_float_p, Qinteger_or_float_or_marker_p): Deleted. (Fnumberp, Fnumber_or_marker_p): Define these always, but make them work even if not LISP_FLOAT_TYPE. Fri Jun 5 14:33:22 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * config.h.in: Undefine REL_ALLOC if a system specific file defines SYSTEM_MALLOC. * sysdep.c (save_signal_handlers): Cast result of signal to avoid compiler warning. * process.c (send_process): Likewise. Fri Jun 5 01:57:48 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (Fread_key_sequence): New 2nd arg CONTINUE_ECHO added for the sake of universal-argument. Thu Jun 4 01:32:38 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * editfns.c (Fset_default_file_mode): Function deleted. (Funix_sync): Moved. * fileio.c (Funix_sync): Moved to here. * xfns.c (Fx_erase_rectangle, Fx_draw_rectangle, Fx_contour_region): (Fx_uncontour_region): #if 0 these. (x_rectangle, outline_region): Likewise. (syms_of_xfns): #if 0 the defsubrs. * dispnew.c (Fsleep_for, Fsit_for): Clean up error messages. * eval.c, print.c, keyboard.c: Doc fix. * xfns.c (Fx_horizontal_line): Disabled, since not documented. * fileio.c (Fdelete_directory): Renamed from Fremove_directory. * unexencap.c: Deinstalled (renamed to =unexencap.c) since awaited papers never arrived. * xfns.c: Doc fix. Thu Jun 4 00:30:26 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * eval.c (stack_trace_on_error, debug_on_error): Made Lisp_Objects V*. (syms_of_eval): Changed DEFVAR_BOOLs to DEFVAR_LISPs. (wants_debugger): New fn. (find_handler_clause): Use it to look in debug-on-error and stack-trace-on-error lists. Thu Jun 4 00:17:28 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * floatfns.c (Fbessel_*, Ferf, Ferfc, Flog_gamma): Turned off; not clearly worth including. (Fasinh, Facosh, Fatanh, Fsinh, Fcosh, Ftanh): Likewise. Wed Jun 3 18:43:14 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * minibuf.c, keyboard.c: Doc fix. * window.c (Fwindow_at): Fix number of args--minimum 2, max 3. * screen.c: Doc fix. Tue Jun 2 22:53:16 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lread.c (Feval_buffer): Don't read any arguments, if interactive. Tue Jun 2 00:32:10 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * screen.c (make_screen_without_minibuffer): Apply XSCREEN to Vdefault_minibuffer_screen before calling SCREEN_LIVE_P. The argument to SCREEN_LIVE_P must be a SCREEN_PTR, not a Lisp_Object. * dispnew.c (Fsit_for): This used to compare arg with 0 and return Qt immediately. It should actually call sit_for anyway, because sit_for needs to test for input and do the redisplay. (sit_for): Compare sec and usec with zero here, after we've looked for input and done a redisplay. * lread.c (Feval_buffer): Use NILP, not NIL_P. Mon Jun 1 23:56:11 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * buffer.h: New macro, BUF_SET_PT. * lread.c: New subr `eval-buffer', replaces `eval-current-buffer', which is now defined in simple.el. Sat May 30 00:05:12 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * screen.c (Fdelete_screen): If we're deleting the default minibuffer screen, try to find another minibuffer screen. Fri May 29 18:58:17 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * buffer.c (Fother_buffer): New optional argument VISIBLE_OK, indicating that buffers currently visible in windows should not be discriminated against. Thu May 28 13:10:38 1992 Ken Raeburn (raeburn@cygnus.com) * screen.c (Fdelete_screen): Fix bugs in walking screen list. (make_screen_without_minibuffer): Signal an error if the default minibuffer screen is dead. * xfns.c (x_set_name): Use ICCCM-conforming scheme for changing window name in X11. (Fx_create_screen): Likewise. Wed May 27 17:33:21 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * xselect.c: Support getting and setting the obsolete X cut buffers. (Qcut_buffer0): New atom, denoting the X cut buffer 0. (syms_of_xselect): Initialize and staticpro it. (Fx_own_selection): If TYPE is Qcut_buffer0, interpret this to mean that we should set cut buffer 0 to STRING. (Fx_selection_value): If TYPE is Qcut_buffer0, interpret this to mean that we should retrieve the value of cut buffer 0. Thu May 21 00:19:37 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * xterm.c (construct_mouse_click): Removed extra assignment of result->timestamp. * keyboard.c (last_event_timestamp): Doc fix. * xselect.c (last_event_timestamp): Declare it extern here. (mouse_timestamp): Variable deleted. last_event_timestamp is a more accurate thing to use here. (own_selection, get_selection_value): Use last_event_timestamp instead of mouse_timestamp. * keyboard.c (make_lispy_event): Pass the event's timestamp through the make_number function, to assure that it is properly tagged before incorporating it into the lispy event. * xterm.c (construct_mouse_click): The timestamp element of a struct input_event is no longer a Lisp_Object; it is now an unsigned long. So don't use XSET to assign to it. (XTread_socket): Same here, in processing KeyPress events. * keyboard.c (Fexecute_extended_command): Properly initialize this_command_keys to the concatenation of the sequence that invoked Fexecute_extended_command, the characters making up the name of the command we're running, and a return character. Previously, this code would set it to the last key typed while reading the function name from the minibuffer, followed by the name of the function being run. Wed May 20 00:11:36 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * xterm.c (x_display_box_cursor): Draw the cursor at curs_{x,y}, rather than at s->cursor_{x,y}. If cursor_in_echo_area is set, then s->cursor_{x,y} does not accurately describe the position of the cursor. However, if we're not updating, then curs_{x,y} are garbage; set them from s->cursor_{x,y}. * dispnew.c (update_screen): Check current_screen->enable and current_screen_used to see if there is any text on the last line, not desired_screen->{enable,used}. When the line isn't enabled, move to line SCREEN_HEIGHT (s) - 1, not SCREEN_HEIGHT (s). Rearranged conditionals. * dispnew.c (cursor_in_echo_area): Document the interpretations of positive and negative values of this variable. Mon May 18 22:04:35 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dispnew.c (Fding): If have arg, don't end a keyboard macro. Mon May 18 02:37:09 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * dispnew.c (sit_for): New function, which is a slight generalization of Fsit_for; you can tell it that it's waiting for input, so C-g gets handled properly. (Fsit_for): Call it, instead of replicating all its guts. * keyboard.c (read_char): Call sit_for instead of Fsit_for, and indicate that we're awaiting keyboard input. * dispnew.c (Fsit_for): Rename arguments to match docstring. Use NILP instead of EQ (foo, Qnil). If nodisp is non-nil, call wait_reading_process_input with do_display 0, instead of 1; this will inhibit spurious redisplays when process input arrives during a sit-for. * process.c (Faccept_process_output): Pass zero as read_kbd argument to wait_reading_process_input when PROC is nil, not when PROC is non-nil. * process.c (wait_reading_process_input): Declare read_kbd to be a Lisp_Object, and use the tagging to tell the difference between a process object and an integer. * dispnew.c (Fsleep_for, Fsit_for, Fsleep_for_millisecs): Pass read_kbd argument to wait_reading_process_input as a Lisp_Object. * keyboard.c (kbd_buffer_get_event): Same. * process.c (Faccept_process_output, send_process): Same. * keyboard.c (read_char): Use save_getcjmp and restore_getcjmp instead of doing the bcopy explicitly. * xterm.c (XTread_socket): When handling an EnterWindow event, don't bother to check waiting_for_input. It's not necessary. * keyboard.c (read_char): Don't clear waiting_for_input and input_available_clear_time here. (quit_throw_to_read_char): It's already done here. * keyboard.c (quit_throw_to_read_char): Use clear_waiting_for_input instead of clearing waiting_for_input explicitly. Mon May 18 02:37:09 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * keyboard.c (read_char): Call clear_waiting_for_input instead of clearing waiting_for_input and input_available_clear_time explicitly. Fri May 15 17:53:33 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * ymakefile [defined (__GNUC__) and __GNUC__ > 1]: define YMF_PASS_LDFLAGS so that it can deal with an empty flags argument. * callproc.c (Fcall_process): Under VMS, a nil INFILE argument means to read from "NLA0:", not "/dev/null". * callproc.c (Fcall_process): Use nil as the value for display (the fourth argument) when nargs >= 4, not when nargs >= 3. Thu May 14 10:12:42 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * termhooks.h: Change timestamp from a Lisp_Object to an unsigned long. * keyboard.c (kbd_buffer_store_event): We don't have to apply the XINT macro to the timestamp member of the event anymore. * process.c (wait_reading_process_output): Don't turn off polling. * sysdep.c (setpgrp_of_tty): Pass the address of pid, not pid itself. * process.c: Deleted cpp tangle for dealing with system-dependent tty handling; #included "systerm.h". * systerm.h: Add some of the things that were done in process.c: If titan is #defined, then we should include and along with the other SYSV pty stuff. If HPUX is #defined, then EMACS_HAVE_TTY_PGRP isn't true. If XENIX is #defined, then we shouldn't try to use TIOCGETC. * ymakefile: Note that process.o depends on systerm.h now. Wed May 13 19:02:05 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * callint.c (Fprefix_numeric_value): Value 1 for symbol other than `-'. Wed May 13 15:12:22 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * cmds.c (Fforward_line): If the buffer is empty, don't try to see if it contains a newline, and moving nowhere at eob after non-newline should return 1, not 0. * search.c (scan_buffer): Doc fix. * buffer.c (Fbuffer_disable_undo): Accept a buffer name as an argument. Tue May 12 23:54:33 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c: Include config.h first thing. * keyboard.c (clear_input_pending): New subroutine. * process.c (wait_reading_process_input): Make C-g really quit in sit-for case. * ymakefile (LD_SWITCH_SYSTEM): Don't use -X with GCC. Tue May 12 11:21:24 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * eval.c (Fapply): Use indirect_function, instead of doing a dumb loop. * keymap.c (get_keymap_1): Same. * macros.c (Fexecute_kbd_macro): Same. * buffer.c (init_buffer_once): Don't disable undos for *scratch* here. Do it in loadup.el. * buffer.c (init_buffer_once): Doc fix. * doc.c (Fdocumentation): After extracting the doc string from a lambda or autoload expression, don't fall through to the default case and signal an invalid function error; instead, do a `break'. * doc.c (Fdocumentation): Use EQ (x, y) instead of XSYMBOL (x) == XSYMBOL (y). * doc.c (Fdocumentation): When decyphering a function made from conses, use 'else if' for the chain of alternatives instead of just 'if'. It used to be that each alternative returned, but that's not true anymore. * alloc.c (Fgarbage_collect): Don't call truncate_undo_list on buffers whose undo list is 't. * doc.c (Fdocumentation): Renamed argument `fun1' to `function', so make-docstring will list argument consistently with the docstring. Mon May 11 22:38:45 1992 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) * xterm.h: Removed definition of `RES_CLASS'. * xfns.c (x_get_arg): Eliminated `screen_name' parameter. No longer uses screen name as X resource search component. All calls to x_get_arg changed accordingly. Global variable `screen_class' and #define `SCREEN_CLASS' removed. * xterm.c (XTread_socket): Added basic structure for handling various ClientMessage events, using new global variables `Xatom_wm_take_focus', `Xatom_wm_save_yourself', `Xatom_wm_delete_window', `Xatom_wm_configure_denied', `Xatom_wm_moved'. * xfns.c: Declare these variables extern. (syms_of_xfns): Initialize these variables. * xselect.c (Fx_own_selection, Fx_selection_value): New optional parameter `type', to specify the selection type. (syms_of_xselect): New symbols Qprimary, Qsecondary, Qclipboard initialized. Mon May 11 15:31:55 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * data.c (Qcyclic_function_indirection): New error condition. (indirect_function, Findirect_function): New functions. (syms_of_data): Initialize Qcyclic_function_indirection, put the error properties on it, and staticpro it. Defsubr Findirect_function. * lisp.h (indirect_function, Findirect_function): Declare them here. * callint.c (Fcall_interactively): Get symbol's function by calling indirect_function, instead of just looping. * doc.c (Fdocumentation): Same. * eval.c (Finteractive_p, Fcommandp, do_autoload, Feval, Ffuncall): Same. * keyboard.c (Fcommand_execute): Same. * data.c (Fsymbol_function): Name the argument `symbol' instead of `sym', so make-docstring will list argument consistently with the docstring. * process.c (wait_reading_process_input): Make sure the screen isn't garbaged (and therefore not displayed) before we enter the select and start waiting for input. * keyboard.c: #include . * ymakefile (keyboard.o): This depends on systime.h. * keyboard.c (input_available_clear_word): Replaced with input_available_clear_time, which is a pointer to an EMACSTIME; sometimes the time information is larger than a single word. (read_char): Changed ..._word to ..._time. (input_available_signal): Use the EMACS_SET_SECS_USECS macro to clear *input_available_clear_time, instead of zapping a zero into *input_available_clear_word. (set_waiting_for_input, clear_waiting_for_input): Adjusted appropriately. Sun May 10 17:24:29 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * editfns.c (make_buffer_string): New function. * lisp.h (make_buffer_string): Declare it here. * editfns.c (Fbuffer_substring): Call make_buffer_string instead of writing it out. (Fbuffer_string): Call make_buffer_string instead of make_string, so we can deal with buffer relocations. * minibuf.c (read_minibuf): Same here. Sat May 9 14:23:50 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * syssignal.h (sigunblock): New macro, taken from 18.58's emacssignal.h file. * sysdep.c (request_sigio): Use the sigunblock macro to enable reciept of SIGWINCH, instead of the dysfunctional sigblockx. Fri May 8 02:55:42 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * search.c: Doc fix. Wed May 6 19:50:58 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * emacs.c (decode_env_path): If EVARNAME is zero, don't try to call getenv on it. * lread.c (init_lread): When we don't have an environment variable to check, pass 0 instead of the empty string. * alloc.c (Fmake_marker): Use `SIGMASKTYPE' instead of `int'. Instead of calling sigsetmask twice - once to get the mask, and again to restore it - call sigblock, specifying no additional signals. Tue May 5 20:56:21 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * alloc.c: #include , for the sake of the bug-catching code in Fmake_marker. ymakefile: Add dependency. * syssignal.h [not POSIX_SIGNALS] (SIGFULLMASK): New definition, for symmetry with the "defined (POSIX_SIGNALS)" case. * callproc.c (child_setup): Since we always get the environment from Vprocess_environment, don't bother to take the environment the subprocess should inherit as an argument anymore. * process.c (create_process): Don't pass environment as a variable. Just preserve it across call to fork. Mon May 4 17:02:30 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * floatfns.c: #include . (float_error): Use SIGEMPTYMASK instead of zero. * syssignal.h [POSIX_SIGNALS] (sigmask): Defined to expand to a statement expression under GCC, or a function call otherwise. (sigpause, sigblock, sigunblock, sigsetmask): These are now K&R-compatible macros. * systerm.h [POSIX_SIGNALS] (sys_sigmask): Here is the function the POSIX version of sigmask calls when we're not compiling with GCC. * alloc.c (Fmake_marker): Undo changes of Apr 29. * callproc.c (Fcall_process): Same. * data.c (arith_error): Same. * floatfns.c (float_error): Same. * keyboard.c (gobble_input): Same. * sysdep.c (request_sigio, unrequest_sigio) Wed Apr 29 11:05:42 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * x11term.h (CLASS): Change this from "emacs" to "Emacs"; class names should always start with an upper-case letter. * syssignal.h: Arranged cpp conditionals so that the specific cases come first, generic cases last. * syssignal.h (sigpause, sigblock, sigunblock, sigsetmask): Macros removed; they require GCC, and Emacs 19 should compile without GCC. (EMACS_SIGPAUSE, EMACS_SIGBLOCK, EMACS_SIGUNBLOCK, EMACS_SIGSETMASK, EMACS_SIGFREE, EMACS_SIGHOLDX, EMACS_SIGBLOCKX, EMACS_SIGUNBLOCKX, EMACS_SIGPAUSEX): These are new macros that don't require GCC, but expand to statements. * callproc.c (Fcall_process): Use new EMACS_SIG* macros from syssignal.h. * keyboard.c (gobble_input): Same. * sysdep.c (request_sigio, unrequest_sigio): Same. * x11term.h (BLOCK_INPUT, UNBLOCK_INPUT): Same. * alloc.c (Fmake_marker): Same. * data.c (arith_error): Same. * floatfns.c (float_error): Same. Tue Apr 28 15:04:26 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * ymakefile: If we're using GCC version 2.0 or later, use "$(CC) -nostdlib" as the linker. This will allow us to find libgcc.a even when GCC puts it in a really weird place. (YMF_PASS_LDFLAGS): New macro. (temacs): Use it. * s/hpux.h: Doc fix. * filelock.c (egetenv): Declare this. (lock_path, SUPERLOCK_NAME, superlock_path): New variables and macros. (MAKE_LOCK_PATH, lock_file, unlock_file, lock_superlock): Use the variables lock_path and superlock_path instead of the PATH_LOCK and PATH_SUPERLOCK macros. (init_filelock): New function. * emacs.c (main): Call the init_filelock function. * paths.h.in (PATH_SUPERLOCK): Removed. This is now calculated from PATH_LOCK or from the EMACSLOCKDIR environment variable. * filelock.c (MAKE_LOCK_PATH): New macro. (lock_file, unlock_file, Ffile_locked_p): Use it. * syntax.c (Fmodify_syntax_entry): Note that '-' is a synonym for ' ' (both denote whitespace), that '\\' denotes the escape class, and that '/' denotes the character-quote class. The description used to claim that '\\' denoted the character-quote class, and neglected to mention '-' and '/'. * filelock.c (lock_file): Doc fix. Mon Apr 27 13:28:57 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * callproc.c (init_callproc): Get the default Vexec_path from the environment variable "EMACSPATH"; get Vdata_directory from "EMACSDATA". * ymakefile: Fix #endif and #else comments. Mon Apr 27 13:28:57 1992 Richard Stallman (rms at mole.gnu.ai.mit.edu) * ymakefile (xemacs): Link xemacs to temacs if HAVE_SHM. * ymakefile (paths.h, config.h): Never copy, always fail. * process.c (wait_reading_process_input): Redisplay if screen_garbaged. Call do_pending_window_change first. Include dispextern.h. * ymakefile (process.o): Added dependency. * ymakefile (OLDXMENU_OPTIONS): New macro, used compiling oldxmenu. Sat Apr 25 16:10:00 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * ymakefile: Changed all references to LD_CMD to LINKER, for compatibility with the 18.58 configuration files. * s/aix3-1.h, s/sunos4shr.h: Same here. * ymakefile: Doc fixes. * ymakefile (CC, MAKE): Set these variables from optional macros. Change all uses of `make' to ${MAKE}. * ymakefile: use HAVE_X11 as alias for X11. * ymakefile (LIB_GCC, GNULIB_VAR): Handle GCC 2. * process.c (allocate_pty): Re-arranged conditionals to put the system-specific-case first, and the generic case in the #else section, for consistency with the rest of Emacs. * process.c (allocate_pty): Wait until we fail to open three ptys in a row before concluding that we've reached the end of the ptys. Wed Apr 22 13:40:03 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * ralloc.c: #include "getpagesize.h". * search.c (Flooking_at): Use search_regs.num_regs instead of RE_NREGS. As of regex version 0.4, the compiler allocates the registers, and may allocate more than RE_NREGS. (search_buffer): Same. (Freplace_match): Use search_regs.num_regs to tell how many registers are valid. Also note that if none are valid, no search has been performed. (match_limit): Same. (Fmatch_data): Same. (Fstore_match_data): If we're trying to store more registers than search_regs has allocated, re-allocate them to make room. Tue Apr 21 18:05:52 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * callproc.c (egetenv): Declare the type of VAR. * lisp.h: Don't undefine NULL. There is no longer any conflict. * lisp.h (NUMBERP): New macro. * editfns.c (Fformat): Protect the sections that deal with Lisp_Float objects with a "#ifdef LISP_FLOAT_TYPE". * bytecode.c (Fbyte_code): Use the NUMBERP macro instead of explicitly checking for the Lisp_Float tag. * callint.c (Fcall_interactively): Same here. * xrdb.c (magic_searchpath_decoder): Re-allocate string as needed, rather than making it a fixed-size array. * xfns.c (Fx_rebind_key): Don't declare modifier_list to be a register variable. It's too big, and we need the address of its first element when we pass it to XRebindKeysym anyway. * fileio.c (Fdo_auto_save): Doc fix. Mon Apr 20 11:24:22 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * search.c (search_buffer): Cast RE_EXACTN_VALUE to char, because the regex-0.4 distribution says so. * ymakefile (dired.o): This depends on regex.h. * process.c (wait_reading_process_input): There is code here which sends SIGIO to Emacs if we thought we had input available but didn't get SIGIO. If the system doesn't have SIGIO, then #ifdef it out. * print.c (Fexternal_debugging_output): Arguments were declared ANSI-style - rewritten in K&R 1 fashion. * floatfns.c (IN_FLOAT): Cast the zero in the `else' clause of the conditional expression to SIGTYPE, to match the type of the float_error call in the `then' clause. * s/hpux8: #define HPUX8; this is supposed to be customary procedure, and fileio.c was expecting it, but somehow it didn't get defined. * sysdep.h: Move inclusions of [AIX] , , , [NEED_BSDTTY] , [HPUX and HAVE_PTYS] , [SYSV_PTYS] , , and [pfa] to systerm.h; also move undefinition of LLITOUT under BSD4_1 to systerm.h. * systerm.h: They're here. * xterm.c (XTcursor_to, XTclear_end_of_line): Declare to return int in the function definitions as well as their declarations. Sun Apr 19 00:46:41 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * fileio.c (directory_file_name): When checking if the string ends with '/', check that slen is a valid length *before* examining dst[slen-1], not after. Sat Apr 18 16:23:17 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * xterm.c (x_death_handler): New function. (x_error_handler): Call x_death_handler to shut down Emacs. (x_term_init): Use x_death_handler to handle SIGPIPE, instead of x_error_handler, which expects to be passed a display and an event. * process.c (send_process): This used to set a handler to catch SIGPIPEs when writing to a subprocess, and then set the handler to SIGDFL after writing, but this would stomp on the SIGPIPE handler for for the X connection. So restore the prevous handler instead of changing to SIGDFL. Sat Apr 18 11:59:13 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * indent.c (compute_motion): Fix skipping invis lines and truncation at right margin. Fri Apr 17 02:22:28 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * s/hpux.h (PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF): Use pty_name, not ptyname. * s/rtu.h: Same. * process.c (pty_process): Add 'int' to the declaration 'static pty_processes;'. This makes it a happy declaration even when static has been #defined as the empty string. * xterm.c (XTcursor_to, XTclear_end_of_line): Same. * unexec.c (sbrk): Declare this to return void * if __STDC__ is defined, or char * otherwise. * lread.c init_lread): Re-cleaned logic. To determine whether the load path was changed before dumping, cons up a dump path and compare it. This method is more localized and accurate. (initial_path): Variable removed. (syms_of_lread): Don't staticpro. * floatfns.c (float_error): Declare and define this to return SIGTYPE. * systime.h [HAVE_TIMEVAL] (EMACS_GET_TIME): Declare dummy to be a real struct timezone, instead of an EMACS_TIME. Since HAVE_TIMEVAL is defined, struct timezone ought to be declared, so there's no harm in passing the genuine article. * sysdep.c [USG] (rename): Place under the protection of a new preprocessor symbol, HAVE_RENAME. * s/hpux.h (HAVE_RENAME): Defined. * sysdep.c [USG] (setpriority): Declare to return int, not void. * s/template.h: Add template section for HAVE_TERMIOS. * term.c (cursor_to, raw_cursor_to, fatal): Do declare the types of the arguments. Wed Apr 15 01:33:08 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * callint.c (Fcall_interactively): When the interactive spec is a string, it may be relocated while reading the arguments. To avoid this, make a copy of the spec to refer to, instead of using a pointer to the data of the spec string. * callint.c (Fcall_interactively): When following the function chain of a symbol, check for quits. Mon Apr 13 14:48:13 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * lread.c (init_lread): Make the load path default to PATH_LOADSEARCH when we're not dumping (null purify-flag), and PATH_DUMPLOADSEARCH when we are (not (null (purify-flag))). Change from April 7th incorrectly always used PATH_DUMPLOADSEARCH. * lread.c (init_lread): Cleaned up logic; to determine whether the load path was changed before dumping, remember the initial value and compare against it. (initial_path): New variable to support this. (syms_of_lread): staticpro initial_path. * ymakefile: Renamed filenames like "*-dist" to "*.in". * config.h.in: Doc fixes. Sat Apr 11 15:54:21 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * config.h-dist: Renamed to config.h.in, for consistency with the installation conventions of other GNU programs. * paths.h-dist: Renamed to paths.h.in. Sat Apr 11 00:01:36 1992 David J. MacKenzie (djm@wookumz.gnu.ai.mit.edu) * termcap.c: Declare getenv. Wed Apr 8 00:57:47 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Makefile: Renamed to Makefile.in; the configure script will edit this to produce Makefile. Tue Apr 7 23:22:59 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * paths.h-dist (PATH_DUMPLOADSEARCH): New macro. * lread.c (init_lread): If we're building an Emacs to be dumped, use PATH_DUMPLOADSEARCH as the default load path, so we can correctly find our lisp files. * config.h-dist, paths.h-dist: Added "-*- C -*-" to top lines, so Emacs will know that these are really C source. Fri Apr 3 22:33:21 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * search.c (syms_of_search): When allocating memory searchbuf.buffer, cast the return value of malloc to unsigned char *, not char *; this changed in the most recent version of the regex code. Tue Mar 31 10:33:58 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * doc.c (Fdocumentation): Don't forget to end each line of the docstring with "\n\". * process.c (Fprocess_connection): Change "#ifdef 0" around this function to "#if 0". * eval.c (Flet, FletX): Signal an error if one of the let's binding clauses has more than one value form, as in (let ((a 1 2)) a). * eval.c (Ffuncall): Re-install change of March 10; I don't know why it went away. * search.c (compile_pattern): Declare the variable which holds the return value of re_compile_pattern to be const, if this is ANSI C. * alloc.c (xrealloc): Change "ese" to "else". * crt0.c (start1) [sun_soft]: Change 'jst' to 'jsr'. The Sun assembly language manual doesn't list any 'jst' instruction, I don't know of one personally, and all the analogous code around it uses 'jsr'. * crt0.c [m68k]: Merged with GNU C Library's version: added conditionals for sun_68881, sun_fpa, sun_soft. * config.h-dist: Adjusted for renaming of share-lib to etc. * lread.c (read1): Same. * doc.c (Fdocumentation_property, Fsnarf_documentation): Same. * ymakefile: Same. Mon Mar 30 23:03:49 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * crt0.c: Merged changes from 18.58: [hp9000s300]: Set flag_fpa. Define float_loc. [new hp assembler]: Double flag_fpa and flag_68881 if %d2!=0. (start1): Declare to be static at the top of the file. (_start): Removed static declaration in this function; since everyone wants it, we'll just put it here. Fri Mar 20 15:42:38 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Finsert_file_contents): Allow quitting from I/O. (Fcopy_file): Likewise. Fri Mar 20 00:59:06 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * m-intel386.h (HAVE_ALLOCA): Inhibit if C_ALLOCA. (LIB_STANDARD): Alternate USG value if __GNUC__ or C_ALLOCA * alloc.c (xrealloc): If handed a NULL pointer for the block to resize, malloc a new block and return that. Not all reallocs do this. * m/elxsi.h: Doc fix. Wed Mar 18 13:59:51 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * dispnew.c (Fsleep_for): Call wait_reading_process_input, whether or not we have process support; let the emulator do the work. * emacs.c (fatal_error_signal, Fkill_emacs): Call kill_buffer_processes even when subprocesses is not #defined; we have a stub. * process.c [not defined (subprocesses)] (Fget_buffer_process, init_process, syms_of_process): New stub versions of these functions. * emacs.c (main): Call init_process and syms_of_process whether or not subprocesses is #defined. * xdisp.c (decode_mode_spec): Call Fget_buffer_process whether or not subprocesses is #defined. Tue Mar 17 16:31:12 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * keyboard.c (kbd_buffer_get_event): Call wait_reading_process_input, even when subprocesses is not #defined, instead of doing a whole lot of hairy SIGIO-pausing stuff. * dispnew.c (Fsit_for): Call wait_reading_process_input, whether or not subprocesses is #defined. * process.c (wait_reading_process_input): Since we're no longer checking for exceptional conditions in the call to select, all of the different ways to call select for different systems have become the same; remove the #if conditionals around this. * keyboard.c (read_char): When returning quit_char because we got an interrupt signal, claim that the character came from the currently selected screen. Mon Mar 16 18:03:54 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * callproc.c (Fcall_process): Doc fix. * process.c [not defined (subprocesses)] (kill_buffer_processes): New dummy version of this function. * buffer.c (Fkill_buffer): Removed '#ifdef subprocesses' protection from the call to kill_buffer_processes; this is safe whether or not we actually have subprocesses. Sat Mar 14 15:39:07 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * m/pfa50.h: New file. * process.c (create_process, process_send_signal): Added changes for m/pfa50.h. * sysdep.c: same. * unexec.c: same. Sat Mar 14 14:25:03 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * callproc.c (child_setup): Always put the child in its own process group. Fri Mar 13 11:17:33 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * mem_limits.h (POINTER): Doc fix. * ralloc.c: Don't #include lisp.h and xterm.h; we no longer need to block input in critical sections. (r_alloc, r_alloc_free, r_re_alloc): Don't use BLOCK_INPUT and UNBLOCK_INPUT; these are no longer needed. (struct bp): Doc fix. Wed Mar 11 03:07:16 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * ralloc.c (obtain): When deciding how many pages to request, take into account the amount of spare bytes at the end of the current page; let get be ROUNDUP (size - already_available), instead of ROUNDUP (size). (relinquish): Re-organized for clarity. * editfns.c (Fcurrent_time): Updated to return the current time's seconds split into two 16-bit integers (similar to the system used by file-attributes), and the milliseconds. Tue Mar 10 18:12:18 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * process.c (Faccept_process_output): Add new optional argument TIMEOUT-MSECS, and return non-nil iff we actually got some input from the process(es). (wait_reading_process_input): Make return value indicate whether we got some input from the specified process, when read_kbd is a process, or from any process when read_kbd isn't particular. * indent.c (Fmove_to_column): Pass the correct number of arguments to Findent_to. * eval.c (Ffuncall): If a subr is asking for too many arguments, abort instead of printing an error message; this is an internal flaw in Emacs, and the subr cannot be called. Fri Mar 6 19:46:24 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * doc.c (Fdocumentation, Fdocumentation_property): Take optional new arg to not pass results thru substitute-command-keys. Thu Mar 5 12:01:57 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * unexmips.c (unexec): When setting up the data_section header, calculate the size of the section as "brk - data_start," not "brk - DATA_START". Sun Feb 23 00:34:42 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * fileio.c: #include "systime.h". (Fcopy_file): Use the systime.h macros to copy the time to the new file. * ymakefile: Note that fileio.o depends on systime.h. * ymakefile (dispnew.o): Note that this depends on systerm.h and systime.h. (editfns.o, xterm.o, sysdep.o): Note that this depends on systime.h. (emacs.o, keyboard.o, process.o, sysdep.o): Note that these depend on systerm.h. * systerm.h: Expanded to handle getting and setting terminal parameters: (struct emacs_tty): New structure, which consolidates all of the old tty parameter structures. (EMACS_GET_TTY, EMACS_SET_TTY, EMACS_TTY_TABS_OK): New macros. * sysdep.c (TABS_OK): Definitions of this macro removed; EMACS_TTY_TABS_OK replaces it. (TERMINAL): Definitions removed; now we use struct emacs_tty. [VMS] (input_chan): Renamed to... (input_fd): and defined even when VMS isn't; in that case, we leave it initialized to zero, which is the input tty. This allows us to use the EMACS_GET_TTY and EMACS_SET_TTY for both VMS and Unix. (discard_tty_input): Use struct emacs_tty and its macros instead of TERMINAL. Replace some of conditional with a call to EMACS_GET_TTY. (child_setup_tty): Use struct emacs_tty and its macros instead of TERMINAL and conditionals. (old_gtty, old_ltchars, old_tchars, old_lmode): Replaced by... (old_tty): New variable. (lmode): Made conditional on BSD4_1, since it's only used by the BSD4_1 support code now. (init_sys_modes): Define tty to be a struct emacs_tty, not a TERMINAL. Use macros to get and set parameters for VMS and Unices. Set lmode, tchars, and ltchars along with the rest of the tty state. (tabs_safe_p): Use EMACS_GET_TTY and EMACS_TTY_TABS_OK instead of conditionals. (reset_sys_modes): Use EMACS_SET_TTY to restore the settings from old_tty, instead of using hairy conditionals. * sysdep.c (get_screen_size): Neatened; now each system of reporting the screen size is separated from the rest. * systerm.h (EMACS_HAVE_TTY_PGRP, EMACS_GET_TTY_PGRP, EMACS_GET_TTY_PGRP): New macros to handle setting a tty's current process group. * sysdep.c (setpgrp_of_tty): Use the above, instead of conditionals. * sysdep.c: #include "systerm.h". #ifs that choose #include files moved from here... * systerm.h: to here. * sysdep.c [APOLLO]: We now undefine TIOCSTART not here but... * systerm.h: here. * sysdep.c [BROKEN_TIOCGETC]: We now undefine TIOCGETC not here but... * systerm.h: here. * sysdep.c [BROKEN_FIONREAD]: We now undefine FIONREAD and FASYNC not here but... * systerm.h: here. * process.c (process_send_signal): Steal 18.58's version of this, but incorporate the support for VMS signals. * syssignal.h (EMACS_KILLPG): New macro. * process.c (process_send_signal): Use it. * sysdep.c (sys_suspend): Use it. * syssignal.h (SIGCHLD): If we have SIGCLD and not SIGCHLD, define SIGCHLD as an alias for SIGCLD. * sysdep.c: Remove code for above. * sysdep.c (init_baud_rate): Rather than trying to maintain the illusion of an abstraction with the OSPEED and SETOSPEED macros, just use conditionalized code for each terminal kind. This is the only place we ever need this functionality. (OSPEED, SETOSPEED): Definitions removed. Sat Feb 22 15:40:12 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * sysdep.c: Moved definition of sigunblock macro to ... * syssignal.h: Here. * hftctl.c: #include before #including . (hfqry, hfskbd): Declare these functions as static before all uses. * unexaix.c (make_hdr, mark_x, copy_text_and_data, copy_sym): Declare as static before all uses. Remove extraneous semicolons from #ifdefs of COFF and XCOFF (unrelocate_symbols): cast the initializers of t_start and d_start to ulong. * s/template.h: Include a clause for the HAVE_TERMIO flag. Fri Feb 21 00:23:28 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * keyboard.c (read_char): Don't clear Vquit_flag when we catch an interrupt and return a quit_char; this change (Mar 21 1991) is too large a change in functionality for the cleanliness it gains. * pwd.h: Renamed to vms-pwd.h, so that we don't get it by accident when we #include with the `-I.' flag given to the compiler. * editfns.c [VMS]: Changed to include vms-pwd.h instead of pwd.h. * fileio.c [VMS]: Same. * filelock.c [VMS]: Same. * sysdep.c [VMS]: Same. * xrdb.c: Changed to #include "vms-pwd.h" if VMS is defined, instead of including unconditionally. * window.c (Fset_window_display_table): Rearranged to make etags happy. * xterm.c (XTread_socket): Clear the meta flag from the keypress event before handing it to XLookupString. Thu Feb 20 23:05:03 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * sysdep.c: No need to test #ifdef TIOCGETP before #undefing it. Wed Feb 19 10:05:37 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * systime.h: New file. * dispnew.c: #include "systime.h" to get or , whichever is appropriate, instead of using a conditional. (Fsleep_for, Fsit_for, Fsleep_for_millisecs): Use the systime.h macros instead of HAVE_TIMEVAL conditionals. * editfns.c: #include "systime.h" to get or , whichever is appropriate, instead of using a conditional. * fileio.c: Same. * process.c: Same. * xterm.c: Same. (wait_reading_process_input): Use the systime.h macros. * sysdep.c: #include "systime.h" to get or , whichever is appropriate, instead of using a conditional. * m/template.h: Add description of NO_SOCK_SIGIO. * sysdep.c (reset_sys_modes): Doc fix. * keyboard.c (sigfree, sigholdx, sigblockx, sigunblockx, sigpausex): Definitions moved to syssignal.h. * dispnew.c: Doc fix. * systerm.h: New file, to consolidate the system-dependent terminal-handling trash. * emacs.c: #include systerm.h. (main): Use systerm.h macros instead of conditionals. * dispnew.c: #include systerm.h. (update_screen): Use EMACS_OUTQSIZE instead of the direct ioctl. * keyboard.c: #include systerm.h to get the proper FIONREAD header files, instead of using conditional. * syssignal.h: Added copyright notice. * emacssignal.h: Renamed to syssignal.h, to be like sysdep.c. * data.c, keyboard.c, process.c, sysdep.c, ymakefile: Changed #include directives. Sat Feb 15 16:44:53 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * m/intel386.h: Don't bother casting the argument to the signal function; the SIGTYPE code in config.emacs ought to take care of this. * buffer.c (record_buffer): Doc fix. Thu Feb 13 20:57:43 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * s/iris3-6.h: #define HAVE_GETWD. Tue Feb 11 14:59:57 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * window.c (Fwindow_at): Accept position as two arguments, not a cons of numbers. * window.c (scroll_command): Undo the Jan 31 change; do set the current buffer to the selected window's buffer. A simple set-buffer will make these two different. Mon Feb 10 01:55:45 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * callproc.c (Fcall_process): Clear synch_process_death and synch_process_retcode to zero before forking the process. * process.c (synch_process_death, synch_process_retcode): Don't declare them extern here. * process.h (synch_process_death, synch_process_retcode): Declare them extern here, along with synch_process_alive. * s/hpux.h: Define CLASH_DETECTION. * window.c (init_window_once): Don't pass any arguments to make_window. * keyboard.c (command_loop_1): Move the label directly_done out of the else block to just after the else block. This shouldn't change the semantics of the code, but appears to avoid a compiler bug on SCO Unix V.3.2v2. * fileio.c (Fset_umask, Fumask): New functions. (syms_of_fileio): defsubr them. * undo.c (Fprimitive_undo): When undoing a deletion with the point before the deleted text, use Finsert_before_markers so that the mark will end up on the other side of the text, if it's in the area at all. * xdisp.c (redisplay): Properly compute TAB_OFFSET for compute_motion. * keyboard.c (command_loop_1): Don't check whether cursor is at edge of screen here. * dispnew.c (direct_output_forward_char): Check here, and return zero if it can't be done. And compare the cursor position to the window boundaries, not the screen boundaries. Wed Feb 5 15:34:14 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * screen.c (Fscreen_parameters): If the screen has a minibuffer window on another screen, return the window, instead of nil. (store_screen_param): If the value of the minibuffer parameter is a window, try to make it the surrogate minibuffer window. (Qminibuffer): New variable, to support above change. (syms_of_screen): initialize and staticpro it. * m/tad68k.h: New file. * fileio.c (Ffile_accessible_directory_p): New function. (syms_of_fileio): defsubr it. * callproc.c: #include . (child_setup): Accept yet another argument, current_dir. Don't try to report an error here if current_dir is inaccessible; this function is called in a vforking process. Just have the process exit with an error code. (Fcall_process): Make sure that the current directory is okay here, before we fork. Pass the current_dir argument. * process.c (create_process): Same here. * callproc.c (Fcall_process): Don't assign into args[1] when nargs < 2. Instead, use a new variable called infile. Re-arranged logic which processes the BUFFER argument. Mon Feb 3 20:09:39 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * fileio.c (Fexpand_file_name): Doc fix. * scroll.c (line_ins_del): Since we're calculating the array from end to beginning, make the indices go that way, and thus clearly get the right boundary. This used to ignore the [0] element, and write in the [screen_height] element, which doesn't exist. Mon Feb 3 16:41:45 1992 Richard Stallman (rms at mole.ai.mit.edu) * xdisp.c (redisplay, try_window_id): Special case for change at beginning of line, if using selective display. Fri Jan 31 14:36:47 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * m/delta88k.h: Added USUAL-OPSYS information, for the config.emacs script to use. * window.c (scroll_command): Don't bother setting the current buffer to the selected window's buffer; this should always already be the case. Add check just in case. * indent.c (compute_motion): Don't pack vpos and hpos into one int; use separate variables hpos/vpos and prev_hpos/prev_vpos. (vmotion): Use largest int as tovpos arg to compute_motion. Thu Jan 30 11:45:20 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * window.c: #include "keyboard.h" to get the Qmode_line and Qvertical_split declarations. * ymakefile (window.o): Note that this depends on keyboard.h. * callproc.c (getenv_internal): Cast the pointer to the variable's value to a char *; elisp strings are unsigned char *'s. And valuelen is an int *, not an int **. * scroll.c (do_scrolling): Document meaning of enable flag in temp_screen. Thu Jan 30 01:44:47 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * m-orion105.h (C_DEBUG_SWITCH, LIBS_DEBUG): Defs deleted. Wed Jan 29 14:37:42 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * m-iris4d.h (C_SWITCH_MACHINE): New definition. Tue Jan 28 11:03:05 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * term.c: #include "keyboard.h", for Vfunction_key_map. * keyboard.h: Declare Vfunction_key_map. * keyboard.h: New file, for external declarations used in processing keyboard input and events. * lisp.h (Qmode_line, Qvertical_split, num_input_chars, poll_suppress_count): Extern declarations moved to keyboard.h. * keyboard.c: #include "keyboard.h". (Qvscrollbar_par, Qvslider_part, Qvthumbup_part, Qvthumbdown_part, Qhscrollbar_part, Qhslider_part, Qhthumbleft_part, Qhthumbright_part): Moved declarations here from xfns.c, so they're with the other event heading symbols. * eval.c: #include "keyboard.h". * ymakefile (callint.o, keyboard.o, keymap.o, xfns.o, eval.o): Note that these depend on keyboard.h. * xfns.c: The above symbols aren't here any more. #include "keyboard.h" to get them. (syms_of_xfns): Don't initialize or staticpro them. * keyboard.h: Added extern declarations for the above. * callint.c: #include "keyboard.h". * xfns.c (Vmouse_screen_part): Variable removed, no longer used. (syms_of_xfns): Changed accordingly. * xterm.c (Qmouse_moved): Variable removed, no longer used. (Qmouse_click, Qscrollbar_click): Removed. These are now event types, in keyboard.c and keyboard.h; they're no longer used in this way. (Vmouse_window, Vmouse_screen_part): Extern declarations removed. (XTread_socket): Don't assign to Vmouse_window or Vmouse_screen_part. (syms_of_xterm): Changed accordingly. * keyboard.h (EVENT_HAS_PARAMETERS, EVENT_HEAD, EVENT_WINDOW, EVENT_BUFFER_POSN, EVENT_SCROLLBAR_BUTTON, EVENT_WINDOW_POSN, EVENT_TIMESTAMP, EVENT_HEAD_UNMODIFIED, EVENT_HEAD_KIND): New macros to recognize and access events that have parameters, like mouse events. * keyboard.c (read_char, echo_char, Fmouse_click_p, read_key_sequence): Use them. * keymap.c: #include "keyboard.h". (access_keymap, store_in_keymap, Fsingle_key_description): Use the macros from keyboard.h. * keyboard.c (Qevent_kind): New symbol, naming the property of an event header where we put the event's type. (Qfunction_key, Qmouse_click, Qscrollbar_click): New symbols, used to tag different kinds of events. (Qevent_unmodified): New symbol, naming the property of an event header where we put an unmodified version of the event header. (modify_event_symbol): Take a new argument, SYMBOL_KIND, whose value should be put on the Qevent_kind property of each symbol we make. Set the Qevent_unmodified property of each symbol we make. (make_lispy_event): Pass the appropriate SYMBOL_KIND argument to modify_event_symbol. (struct event_head, head_table): New tables, to simplify the initialization of some of the event heads. (syms_of_keyboard): Initialize and staticpro the symbols given in head_table, and put the Qevent_kind and Qevent_unmodified properties on them. Initialize all of the new symbols listed above. * keyboard.c (lispy_function_keys, lispy_mouse_names): Renamed these from function_key_names and mouse_names, and moved them outside of make_lispy_event, since static doesn't work on all systems, and these can't be automatic. Tue Jan 28 00:46:18 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Fwrite_region): Remove Alliant conditional. * crt0.c: Conditionals for ALLIANT_2800. * m/alliant-2800.h: New file. * unexfx2800.c: New file. * m-mips4.h (C_DEBUG_SWITCH): Alternate defn for GCC. * sysdep.c [VMS] (sys_write): Special case for fixed-length with carriage-control characters. * s/isc2-2.h (NOMULTIPLEJOBS): Undef this. (LIB_STANDARD): Add -lPW. (LIBS_SYSTEM): Defined. * m/intel386.h (signal): Optionally don't define it. Mon Jan 27 17:53:37 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * s/template.h: Document the SIGTYPE macro. * s/bsd4-3.h: Define the SIGTYPE macro. * data.c (Fsymbol_value): Extract all the innards of this function into find_symbol_value, except the code which signals an error. (find_symbol_value): New function. * lisp.h (find_symbol_value): Declare it. * keymap.c (current_minor_maps): Use it, instead of a call to Fboundp and Fsymbol_value per every minor map, for every key sequence read. * xterm.c (x_make_screen_visible): Don't raise the window. This causes the window to pop to the front every time a message appears, which isn't desirable. * screen.c (Fselect_screen, Fdelete_screen, Fset_mouse_position, Fmake_screen_visible, Fmake_screen_invisible, Ficonify_screen, Fdeiconify_screen, Fscreen_parameters, Fmodify_screen_parameters, Fset_screen_height, Fset_screen_width, Fset_screen_size, Fset_screen_position): Use SCREEN_IS_X macro instead of testing for output_x_window. * xfns.c (adjust_scrollbars, Fx_store_cut_buffer): Same. Sat Jan 25 16:37:19 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * term.c (term_get_fkeys): New function. (term_init): Call term_get_fkeys. Tue Jan 21 10:41:53 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * editfns.c (Ffollchar, Fprevchar): Renamed to Ffollowing_char and Fprevious_char, for consistency. Renamed Sfollchar and Sprevchar too. (syms_of_editfns): Fixed defsubrs. * lisp.h (Ffollchar, Fprevchar): Renamed extern declarations as above. * editfns.c (Ffollowing_char): Return 0 at the end of the buffer, as advertised. Doc fix. (Fprevious_char): Doc fix. * config.h-dist: Rearranged to define user parameters before including the machine and opsystem files, so the files can have conditionals on the parameters. Wed Jan 15 15:03:55 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * keyboard.c (read_key_sequence): When expanding a function key recognized with Vfunction_key_map, don't scan the expansion for further function key sequences. * keyboard.c (Vfunction_key_map): Real declaration moved to keymap.c; this declaration made extern. (syms_of_keyboard): DEFVAR and initialization of Vfunction_key_map moved to keymap.c, since it should be initialized to a keymap, but we don't want to rely on Qkeymap being initialized now. * keymap.c (Vfunction_key_map): Variable moved here. (syms_of_keymap): DEFVAR and init here. * keymap.c (Fglobal_key_binding): Doc fix. Thu Jan 16 01:47:48 1992 Richard Stallman (rms at mole.gnu.ai.mit.edu) * m-delta88.h: New file. * window.c (window_scroll): New arg `noerror'. (scroll_command, Fscroll_other_window): Pass that arg. Wed Jan 15 17:14:54 1992 Richard Stallman (rms at mole.gnu.ai.mit.edu) * process.c (sigchld_handler): Set synch_process_death and synch_process_retcode. Tue Jan 14 00:51:08 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * config.h-dist (SIGTYPE): New macro to help give signal handlers the correct type. * s/usg5-3.h (SIGTYPE): Define this to be void. * dispnew.c (window_change_signal): Declare this to return SIGTYPE. * emacs.c (fatal_error_signal): Same. * data.c (arith_error): Same. * process.c (create_process_1, send_process_trap, create_process_sigchld, sigchld_handler): Same. (create_process): Declare sigchld according to SIGTYPE. This means we don't have to cast the return value of signal. * keyboard.c (input_poll_signal, interrupt_signal): Declare these to return SIGTYPE. (kbd_buffer_store_event): Include a forward declaration for interrupt_signal here. * sysdep.c (struct save_signal): Say the handler returns SIGTYPE instead of int. (save_signal_handlers): So we don't have to cast the return value from signal here. (sys_suspend): Declare oldsig according to SIGTYPE. (select): Declare old_trap using SIGTYPE. (select_alarm, wait_for_termination_signal): Declare these to return SIGTYPE. * emacs.c: #include , if we have it. (fatal_error_signal): If we have termios, use tcgetpgrp to get the terminal's process group. * process.c: If we have termios, #include instead of . (process_send_signal): If we have termios, use tcgetpgrp to get the terminal's process group. Have gid default to the child's pid, to simplify the logic below. * sysdep.c (flush_pending_output): If we are using termios, make this function a no-op; since we're not in the tty's pgroup, we would get a SIGTTIN. Mon Jan 13 00:50:14 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * config.h-dist: Removed MAINTAIN_ENVIRONMENT clause. * callproc.c: Removed support for MAINTAIN_ENVIRONMENT. (init_callproc): Use getenv instead of egetenv to initialize Vshell_file_name. * emacs.c (decode_env_path): Use getenv instead of egetenv * lisp.h: Removed support for MAINTAIN_ENVIRONMENT. * process.c: Same. * ymakefile: Same. * dispnew.c (init_display): Call getenv instead of egetenv. * editfns.c (Fgetenv): Function moved... * callproc.c (Fgetenv): To here, and made to scan Vprocess_environment instead of using the usual C getenv function. (getenv_internal): New function. (egetenv): New function. * lisp.h: Added extern declaration for egetenv. * editfns.c (syms_of_editfns): Adjusted. * callproc.c (syms_of_callproc): Adjusted. * window.h (minibuf_prompt_width): Declare this extern here, after minibuf_prompt. minibuf.c: Don't extern declare it here. indent.c: As above. * dispnew.c (buffer_posn_from_coords): If there is a prompt in the minibuffer, account for its width when computing the buffer position. * Makefile (doall): Explicitly export CC to the xmakefile. * ymakefile: Use /* */ around comments; # confuses cpp. * ymakefile: Note that ralloc.o depends on mem_limits.h, xterm.h, and config.h. Note that vm-limit.o depends on mem_limits.h. * lread.c (read_escape): Return \a as '\007', not '\a'; the latter isn't portable, and this routine would have to be revised anyway to deal with anything other than ASCII. * keymap.c (current_minor_maps): Rewritten not to use function-local static variables, to accomodate DGUX. * xterm.h (UNBLOCK_INPUT): Replace "abort ()" with "(abort (), 0)", to avoid type conflicts on odd systems like Ultrix. * xrdb.c: Include , and declare getuid to return uid_t. * xdisp.c (redisplay_window): Use SET_PT macro instead of assigning to point. insdel.c (insert_from_string): Same. * xterm.c (XTcursor_to): Declare it static at the function definition, as well as at the top of the file. (dumpglyphs): Removed declarations for buf and cp; these variables are never used. * lisp.h (NULL): Renamed to NILP, so as not to conflict with , and . All callers changed; all #undefinitions of NULL removed. Sun Jan 12 23:01:02 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * xdisp.c (message): #ifdef NO_ARG_ARRAY, make a local block to declare the explicit argument array. * config.h-dist: Instead of reaching the machine- and system-dependent files through symlinks, replace the strings Thu Jan 9 22:50:20 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * keyboard.c (stuff_buffered_input): Don't forget to increment kbd_fetch_ptr while looping through kbd_buffer. Wed Jan 8 15:13:56 1992 Jim Blandy (jimb at occs.cs.oberlin.edu) * keyboard.c (read_avail_input): Don't forget to fill in the screen field in events read from the terminal. * sysdep.c (kbd_input_ast, read_input_waiting): Call kbd_buffer_store_event with a `struct input_event *', not a character or a Lisp_Object. Sat Dec 21 02:03:38 1991 Jim Blandy (jimb at occs.cs.oberlin.edu) * bytecode.c (docall): Don't remove protection from the arguments to Ffuncall. Fri Dec 20 01:28:41 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keyboard.c (Vfunction_key_map): New variable. (read_key_sequence): Changed to recognize and substitute bindings in Vfunction_key_map at any point in the sequence, unless they conflict with ordinary bindings. (syms_of_keyboard): DEFVAR, document, and initialize Vfunction_key_map. Thu Dec 19 00:29:07 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keymap.c (Vminor_mode_map_alist): New variable, to support keymaps for minor modes. (current_minor_maps, Fminor_mode_key_binding, Fcurrent_minor_mode_maps): New functions. (Fkey_binding): Rewritten to scan for minor mode bindings too. (syms_of_keymap): DEFVAR, document, and initialize Vminor_mode_map_alist, and defsubr the new Ffunctions. (describe_buffer_bindings): Describe the bindings established by minor modes too. * keyboard.c (follow_key): New function, to support... (read_key_sequence): Completely rewritten to handle scanning an arbitrary number of keymaps at a time. * keyboard.c (Fread_key_sequence): GCPRO keybuf, since it can hold lisp expressions while waiting for input. Don't pass too many arguments to read_key_sequence. (command_loop_1): Don't pass too many arguments to read_key_sequence. * keyboard.c (add_command_key): New function; there are several places that add keys to this_command_keys, so we make one function to do the work. (read_char, Fexecute_extended_command): Call add_command_key instead of writing out its code again. (init_keyboard): Allocate this_command_keys according to this_command_keys_size. * lread.c (read1): Change comment to use `share-lib' instead of `etc'. * doc.c (Fdocumentation_property, Fsnarf_documentation): Update docstring similarly. (Fsnarf_documentation): Use "../share-lib/" instead of "../etc/" to find doc file while dumping. * unexaix.c: Similar doc fix. * ymakefile (etcdir): Variable removed. (libsrc, archlib, sharelib): New variables, to take the place of etcdir. Wed Dec 18 17:55:46 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * ymakefile (CFLAGS): Don't automatically include C_DEBUG_SWITCH in the value for CFLAGS; the configuration script will take care of choosing the debugging and optimization switches. * config.h-dist: Copy the GLYPH definitions from config.h to here. Mon Dec 16 22:36:11 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * abbrev.c (Fexpand_abbrev): Run pre-abbrev-expand-hook. (syms_of_abbrev): Define that variable. Fri Dec 13 13:37:20 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * m/m-*.h: Since the m- is now redundant, renamed all files to remove it, and changed references within files. * s/s-*.h: Same business. Wed Dec 11 14:22:06 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * config.h-dist (MULTI_SCREEN): Define this automatically when we're using a window system. Mon Dec 9 17:24:45 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * m/m-*.h (i.e. all machine config files): Added USUAL-OPSYS comments to tell the configuration script what sort of operating system this machine typically runs. * config.h-dist (MScreenWidth, MScreenLength): Deleted; no longer used. Sun Dec 8 02:04:27 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * editfns.c (Fcurrent_time): New function, to return the current time as a number, like the Unix time(3) function. This might be fun to port. (syms_of_editfns): defsubr it. Thu Dec 5 13:59:35 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keymap.c (Vminor_mode_map_alist): New variable. (current_minor_maps): New function. (Fcurrent_minor_mode_maps): New function. (syms_of_keymap): DEFVAR, document, and initialize Vminor_mode_map_alist, and defsubr Fcurrent_minor_mode_maps. * callproc.c (Vdata_directory): New lisp variable, for the directory containing architecture-independent data files. (init_callproc): Initialize Vdata_directory from PATH_DATA, and make sure it exists. Renamed execdir to tempdir, because we use it for both Vexec_directory and Vdata_directory. (syms_of_callproc): Doc fix for Vexec_directory, new DEFVAR_LISP for Vdata_directory. * paths.h-dist (PATH_DATA): New path macro, to initialize Vdata_directory. * doc.c (get_doc_string): Use Vdata_directory to find the docstrings, not Vexec_directory. * lisp.h (Vdata_directory): New extern declaration, for above users. * config.h-dist: Changed references to ../etc to ../share-lib. * callint.c (Fcall_interactively): For the 'k' interactive code, cast the type of the symbol name before passing it to error. Mon Dec 2 19:06:31 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keyboard.c (make_lispy_movement): Move call to mouse_position_hook from here... (kbd_buffer_get_event): To here, for symmetry with non-movement events. * keyboard.c (kbd_buffer_get_event): Set Vlast_event_screen for mouse movements, too. Wed Nov 27 13:33:31 1991 Jim Wilson (wilson at wookumz.gnu.ai.mit.edu) * alloca.c (alloca): Add parens to make precedence clearer. Tue Nov 26 00:13:29 1991 Michael I Bushnell (mib at geech.gnu.ai.mit.edu) * search.c: need to include sys/types.h because of recent mod to regex.h. Mon Nov 25 23:51:22 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * bytecode.c: BYTE_CODE_METER and BYTE_CODE_SAFE undefined by default. (METER_CODE): Define same name whether metering or not. (BinsertN): New byte code. (Fbyte_code): Improve overflow/underflow error messages. (docall): Put back previously lost code to remove protection from funcall args. Mon Nov 25 20:08:49 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * lisp.h (make_array): New extern declaration. * alloc.c (make_sequence): Renamed to make_array; more accurate. * keyboard.c (Fread_key_sequence, Fthis_command_keys): Callers fixed. * macros.c (Fend_kbd_macro): Callers fixed. Fri Nov 15 15:39:19 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keyboard.c (cmd_error): If an error occurs before somebody has provided a screen to print it on, print it to stderr and exit Emacs. Handle batch-mode errors with the same code. * lisp.h (Qexternal_debugging_ouput): New extern declaration, for use in cmd_error. * screen.c (Fscreen_pixel_size, Fset_screen_position): Doc fix. * window.c (Fwindow_at): Typecheck COORDINATES more thoroughly. * screen.c (read_mouse_position): Function deleted. (Fread_mouse_position): Renamed to Fmouse_position, and changed to use mouse_position_hook. (syms_of_screen): Adjusted accordingly. * xfns.c (x_read_mouse_position): Function deleted. * screen.h (SCREENP): The non-MULTI_SCREEN case used to say this was false for all objects, but it should be true for the terminal screen, so make its definition the same as in the MULTI_SCREEN case. * screen.h (SCREEN_LIVE_P): New predicate. (CHECK_LIVE_SCREEN): New type-checking macro. (Qlive_screen_p): New error-reporting symbol. * screen.c (Qlive_screen_p): Declare the new symbol. (Flive_screen_p): New lisp predicate. (syms_of_screen): Initialize, staticpro, and defsubr the lot. * dispnew.c (Fredraw_screen): Use CHECK_LIVE_SCREEN. * screen.c (Fscreen_root_window, Fscreen_selected_window, Fnext_screen, Fset_mouse_position, Frestore_screen_configuration, Fmake_screen_visible, Fmake_screen_invisible, Ficonify_screen, Fdeiconify_screen, Fscreen_visible_p, Fredirect_screen_focus, Fscreen_focus, Fmodify_screen_parameters, Fset_screen_height, Fset_screen_width, Fset_screen_size, Fset_screen_position, Fselect_screen): Use CHECK_LIVE_SCREEN. * window.c (Fwindow_at, Fcurrent_window_configuration): Use CHECK_LIVE_SCREEN. * xfns.c (Ffocus_screen, Fx_pixel_width, Fx_pixel_height): Use CHECK_LIVE_SCREEN. * screen.c (Fdelete_screen): Do nothing if SCREEN is already deleted. * screen.c (Qscreenp): Staticpro this symbol. * xfns.c (Fx_create_screen): Doc fix. * xfns.c (Fx_create_screen): Give the screen a minibuffer if the 'minibuffer parameter is t or nil; nil is the default value for omitted parameters, and t is intuitive. Thu Nov 14 16:18:58 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * eval.c (specbind): Check that the thing being bound is a symbol. (funcall_lambda): Signal an invalid-function error if the arguments are not all symbols. Fri Nov 8 14:45:30 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * screen.c (Fselect_screen): Don't select dead screens. * print.c (print): Print dead screen objects starting with "#cursor_y, which is meaningless; it should have compared it with s->phys_cursor_y. Changed to just mark the cursor as cleared if it's in the area we're clearing. Sun Oct 13 05:20:50 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * m-intel386.h: Fix typo in #endif. Sat Oct 12 00:47:36 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * callint.c (Fcall_interactively): Added new interactive spec 'K', for mouse clicks. Added explanation to doc string. Removed 'e' spec, which didn't work with the new input model anyway. * keyboard.c (Fmouse_click_p): New function. (syms_of_keyboard): defsubr it. * keyboard.c (EVENT_QUEUES_EMPTY): Clarified comment. (tracking_off): Change "if (!readable_events)" to "if (!readable_events ())". (Ftrack_mouse): Doc fix. (kbd_buffer_read_char): Fix brainos in tossing of unwanted events. Don't use EVENT_QUEUES_EMPTY to set input_pending; call readable_events. Fri Oct 11 22:17:56 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keyboard.c (Qmode_line): New quoted symbol. (syms_of_keyboard): Initialize and staticpro it. (make_lispy_event): Use it to indicate when a mouse position is in a window's mode line. * xterm.c (XTread_socket): Consider the window to be resized if either the character or pixel dimensions have changed; this will catch font size changes. Tue Oct 8 10:37:41 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * process.c (wait_reading_process_input): Removed all the exceptional condition stuff. Emacs lacks any way to respond to such a state, and selecting for it without responding to it can make Emacs loop indefinitely. * xterm.c (XTread_socket, construct_mouse_click): Make sure that all enqueued events have their timestamp field set. * termhooks.h (struct input_event): Doc fix. * keyboard.c (last_event_timestamp): New variable. (get_mouse_position, kbd_buffer_store_event, kbd_buffer_read_char): Make sure to fill in Vlast_event_screen and last_event_timestamp. * xselect.c (mouse_timestamp): Don't use this anymore. (last_event_timestamp): Use this instead. (Fx_own_selection, Fx_own_clipboard, Fx_get_selection, Fx_get_clipboard): Use last_event_timestamp instead of mouse_timestamp. * xdisp.c (redisplay): Don't pass extra arguments to update_screen. * keyboard.c (echo_truncate): Don't call echo here; this results in extraneous echoing of characters. (read_key_sequence): After calling echo_truncate, call echo_char to put the character we just read into the minibuffer, if appropriate. * keyboard.c (read_key_sequence): Removed unused argument no_redisplay. Tue Oct 1 00:11:01 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * xfns.c (x_create_screen): Initialize phys_cursor_x to -1, to indicate that the screen has no displayed cursor. * xfns.c (x_create_screen): Let InternalBorderWidth default to 1. * xterm.c (x_display_bar_cursor): Declare this to be static void. * xterm.c (XTupdate_begin): Don't turn off the cursor. This makes ugly flickering. Instead, make it okay for XTins_del_lines to do so: * screen.h (struct screen): New field phys_cursor_glyph, keeping track of the glyph under the currently displayed cursor. Since current_glyphs is sometimes inaccurate when we want to undraw the cursor (as when XTins_del_lines is called from do_scrolling), we can't always get the GLYPH from there. * xterm.c (x_draw_single_glyph): Take the glyph to draw as an argument, instead of taking it from the screen matrix. (x_display_box_cursor): Set and use s->phys_cursor_glyph. * ymakefile: Note that scroll.o and xmenu.o depend on screen.h. Sun Sep 29 07:24:42 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keyboard.c (make_lispy_event): When building mouse movement event, use `m', not `event', dummy. Thu Sep 26 02:28:16 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * screen.c (Fscreen_parameters): Return the proper value for the 'minibuffer parameter for minibuffer-only screens. * xdisp.c (redisplay_window): When the start position is forced, constrain it to be within the visible region anyway. * xterm.c (XTwrite_glyphs): Instead of turning off the cursor before we write, just notice if we wrote over it. * xfns.c (x_decode_color): If a screen has two planes, then it is considered a color screen, and we should look up the color value. * ymakefile: Include xselect.o and xrdb.o in XOBJ even when HAVE_X_MENU is not defined. * fns.c (Fdelete): This used to be named Fdelq; Roland forgot to change the function name in his August 17 change. (syms_of_fns): defsubr Fdelete. Tue Sep 24 03:20:07 1991 Richard Stallman (rms@mole.gnu.ai.mit.edu) * alloca.c: Do nothing if alloca is defined as a macro. Sun Sep 8 23:21:25 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * m-pfa50.h: New file. Fri Sep 6 02:53:44 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * unexec.c: Add conditionals for COFF_ENCAPSULATE. Sat Aug 17 20:46:04 1991 Roland McGrath (roland@geech.gnu.ai.mit.edu) * fns.c (Fdelete): New fn. We have member now; we should have delete too. Fri Aug 16 00:04:49 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * xfns.c (x_get_arg): Clean bad characters out of the screen name before using it as a resource key. * abbrev.c (Fexpand_abbrev): Don't let capitalization go past point. * sysdep.c (sys_suspend): Don't use & before array name. * sysdep.c [BROKEN_FIONREAD]: Undefine FASYNC. * m-tandem-s2.h (START_FILES, LIB_STANDARD): Added. * s/s-aix3-1.h: Define HAVE_TCATTR. * xfns.c (Fx_grab_cursor, Fx_ungrab_cursor): Functions removed. Thu Aug 15 23:57:15 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * bytecode.c (Qbyte_code_meter): New. (Bend_of_line, Bset_marker, Bmatch_beginning, Bmatch_end, Bupcase, Bdowncase, BRgoto, BRgotoifnil, BRgotoifnonnil, BRgotoifnilelsepop, BRgotoifnonnilelsepop, BlistN, BconcatN): New byte codes. (Fbyte_code): Implemented new codes listed above. Added code to count how many times a function is called. (syms_of_bytecode): Initialize and staticpro Qbyte_code_meter. * xfns.c (x_window): When setting the class hints, use the screen's name as the res_name. * xfns.c (x_make_screen_name): New function. (Fx_create_screen): Use x_get_arg to find screen name; if none has been specified, use x_make_screen_name; don't set the name again at the bottom. (x_get_arg): If SCREEN_NAME is nil, don't pass any class to Fx_get_resource. * xfns.c (x_get_arg, x_default_parameter): Take an extra argument TYPE, instead of encoding the type in the first letter of the property name. Thu Aug 15 14:29:30 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * buffer.c (Fkill_all_local_variables): Don't pass Fmake_local_variable too many args. Use Fset instead. Wed Aug 14 23:09:05 1991 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * xfns.c (emacs_class): Variable removed. (EMACS_CLASS): New macro, specifying Emacs class for xrdb use. Use a class of "Emacs", to be compatible with previous versions. (Fx_get_resource, x_window, Fx_open_connection): Use macro here. * buffer.c (Fgenerate_new_buffer): Function moved to lisp/files.el. (Fgenerate_new_buffer_name): New function which does only the name-choosing work Fgenerate_new_buffer used to do. (Frename_buffer): Added second optional argument DISTINGUISH, which lets rename_buffer use generate-new-buffer-name if non-nil. Return the name the buffer was given. Do nothing if new name is already buffer's name. * xfns.c (Fx_get_resource): Take third argument CLASS, and require it to be specified whenever NAME is. All callers changed. [not HAVE_X11] (Fx_get_default): Only take the one arg. [not HAVE_X11] (Fx_get_resource): Toss the second two args. Tue Aug 13 03:07:03 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * xfns.c (Fx_close_current_connection): Add \n to error message. * keyboard.c (make_lispy_event): Added HP keys into the function_key_names array. * xterm.c (XTread_socket): For KeyPressed events, strip the keysym's vendor-specific bit, and take a shot at fitting it into the Emacs key numbering. * screen.c (Vdefault_screen_alist): Definition moved from screen.el to here. (syms_of_screen): DEFVAR_LISP and initialize it here. * screen.h: Declare it here. * xfns.c (x_get_arg): Use it here. * screen.c (make_screen): When choosing a buffer for the screen's root window, shy away from buffers whose names start with a space. Sun Aug 11 00:32:22 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * process.c (exec_sentinel, exec_sentinel_unwind): Move these above status_notify. * eval.c (Qinhibit_quit): New variable, to support Aug 5 changes to process.c. (syms_of_eval): Initialize and staticpro above. * lisp.h: added extern declaration for above. Sat Aug 10 23:23:51 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * regex.c (re_search_2): When searching with the fastmap, test for a translate table outside of the loop, not inside the loop. Sat Aug 10 16:14:07 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * fns.c (Fequal): Don't crash on circular structure. (internal_equal): New subroutine does the recursion. * print.c (print): Recognize circular car pointers. Sat Aug 10 01:48:38 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * process.c (wait_reading_process_input): Ignore exceptional conditions on the keyboard input. Tue Aug 6 21:56:30 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * lisp.h: Fiddled with formatting. * process.c (exec_sentinel_unwind): New function. (exec_sentinel): Restore the process's sentinel, using an unwind_protect. Mon Aug 5 23:55:24 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * keyboard.c: Doc fix. Mon Aug 5 19:57:33 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * dired.h: Don't include search.h; it doesn't exist. * process.c (read_process_output, exec_sentinel): Bind Qinhibit_quit to true and call the filter directly instead of through a condition-case. (run_filter): Removed. (this_filter, filter_process, filter_string): Variables now unnecessary. * xfns.c (Fx_get_resource): Take the screen name as an optional argument and look up resources using the name of the screen as part of the key. [not HAVE_X11] (Fx_get_default): Take optional 2nd arg NAME and ignore it. (x_get_arg): Take the screen name as an arg, and call Fx_get_resource with that argument. (x_default_parameter, x_figure_window_size, x_icon): Pass the screen's name to x_get_arg. (Fx_create_screen): Make sure the screen name is either nil or a string, and pass it to x_get_arg. * xfns.c (Vx_screen_defaults): Variable removed; such settings belong in the .Xdefaults file. (syms_of_xfns): Don't defvar it here. (Fx_create_screen): Don't use it here. * keyboard.c (classify_object): #if 0'd function finally removed. * xterm.c (Qmapped_screen, Qunmapped_screen, Qexited_scrollbar, Qexited_window, Qredraw_screen): Unused, so removed. (syms_of_xterm): Don't bother to initialize above. * xterm.c (init_input_symbols): Renamed to syms_of_xterm, for consistency. (x_term_init): Don't call it here. * xfns.c (syms_of_xfns): Don't call syms_of_xselect here. * emacs.c (main): Call them here. * xterm.c (invocation_name): Made this a Lisp_Object, so that its string value could be relocated properly. (x_term_init, x_text_icon): Adjusted code appropriately. (syms_of_xterm): staticpro invocation_name. * xfns.c (invocation_name): Changed extern declaration, deleted extra declaration. (Fx_get_resource): Adjusted code appropriately. Sun Aug 4 17:38:25 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * lread.c (read1): Accept #[...] for bytecode object. * print.c (print): Print them that way. Thu Aug 1 21:02:01 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * fileio.c (Fexpand_file_name): Avoid doing strlen (0). * editfns.c, filelock.c [VMS]: Use pwd.h from Emacs, not from system. * fileio.c [VMS]: Likewise. Also include stddef.h, string.h. Include perror.h only once. [VMS] (file_name_as_directory, directory_file_name): Remove assignments from if conditions. (Fexpand_file_name): Remove excess slash from end of user's home dir. Thu Aug 1 12:31:38 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * emacs.c (main): Add SIGIO conditional within AIX conditional. * xdisp.c (try_window_id): Compute proper position for screen bottom when all changes are below the screen. When first computing bp, don't go more than HEIGHT + 1 lines. Wed Jul 31 13:14:45 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * xterm.c (x_destroy_window): If we're destroying the currently highlighted screen, clear x_highlight_screen. * xdisp.c (display_text_line, display_string): Don't go past endp for multi-column chars. Sun Jul 28 08:09:19 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * lread.c (init_lread): If Vload_path was set specially before dumping, preserve it by default. * process.c (process_send_signal): Notice and deal if the TIOCGPGRP ioctl says that the subprocess has no pgrp. * xdisp.c (try_window_id): Always update window_end_* if successful. * process.h (subtty): New slot. * process.c (create_process): Set it. (process_send_signal): Use it. * alloc.c (Fmake_rope): Doc fix. * screen.c (Fselect_screen): Doc fix. * vms-pp.c: Fix comment. * keymap.c (Fkeymapp, Fdefine_prefix_command): Doc fixes. * window.c (window_select_count): No longer static. (init_window_once): Increment window_select_count, to give each window a unique use_time. * window.h (window_select_count): extern this here. * screen.c (make_screen): Stamp a new screen's selected window with the proper selection time. * ymakefile: xselect.o depends on screen.h, xterm.h, and config.h. xrdb.o depends on config.h. xterm.o depends on gnu.h. * xfns.h: File removed - it only declared Vx_send_movement_events. All includers changed. Sat Jul 27 13:43:29 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * keymap.c (Fcopy_keymap): Don't recursively copy maps inside symbols. Sat Jul 27 04:24:31 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * xdisp.c (redisplay): If echo_area_display puts text in a surrogate minibuffer screen, don't neglect to update it. * keyboard.c (kbd_buffer_store_event): Make sure Vlast_event_screen is set properly for quit characters. Fri Jul 26 17:30:09 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keyboard.c (command_loop_1): pass both arguments to Fselect_screen. * screen.c (make_screen): Divide the size by sizeof (Lisp_Object) before passing it to Fmake_vector. * screen.h [not MULTI_SCREEN] (SCREEN_SCROLL_BOTTOM_VPOS): fixed definition. * screen.c: #include termhooks.h and therefore stdio.h. (make_screen): Initialize focus_screen member. (Fdelete_screen): Refuse to delete SCREEN if it is a surrogate minibuffer for some other screen, not just if it's the global minibuffer screen. (Fredirect_screen_focus, Fscreen_focus): New function. (syms_of_screen): defsubr Sredirect_screen_focus. * window.c: Don't include termhooks.h or stdio.h. (Fselect_window): Removed grunge to support minibuffer hack. * screen.h (struct screen): Added focus_screen member, and accessor for it. * alloc.c (mark_object): mark focus_screen member of Lisp_Screens. * xterm.c (XTscreen_rehighlight): Use the focus_screen member to decide which screen to highlight. (XTread_socket): Use focus_screen when enqueuing keystrokes. * minibuf.c (read_minibuf, read_minibuf_unwind): Shift the selected screen's focus around appropriately. * termhooks.h (screen_rehighlight_hook): Doc fix. * lisp.h (CHECK_IMPURE): Moved definition... * puresize.h (CHECK_IMPURE): To here. Thu Jul 25 08:06:22 1991 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * dispnew.c (buffer_posn_from_coords): Bufp is broken; don't use it. * xterm.c (XTscreen_rehighlight): Neatened sloppy logic. * keyboard.c (read_key_sequence): When truncating a key sequence, don't forget to put the new keystroke back in this_command_keys. Do this before calling echo_truncate, and don't call echo_char. Wed Jul 24 00:17:54 1991 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * xterm.c (x_term_init): Initialize x_focus_screen and x_highlight_screen. * xterm.c (XTscreen_rehighlight): Handle things correctly when x_focus_screen is 0. (XTread_socket): Process EnterNotify and LeaveNotify events with .focus == 0 properly. For FocusOut events, pass the right arguments to x_new_focus_screen. * fileio.c (Finsert_file_contents): Use RETURN_UNGCPRO macro. * buffer.c (Fbuffer_name): Fix typo in doc string. (syms_of_buffer): Fix typo in before_change_function name. Tue Jul 23 10:41:43 1991 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * screen.h (CHECK_SCREEN): Define a dummy version of this when MULTI_SCREEN is not defined. * sysdep.c (init_signals, sys_signal, sys_sigpause): New functions. (sys_sigblock, sys_sigunblock, sys_sigsetmask): New functions. * sysdep.c (_sobuf): Unsigned chars if DGUX. * sysdep.c [DGUX]: Include file.h. [DGUX] (sys_siglist): New variable. * x11term.c (x_init_1) [SYSV_STREAMS]: Don't close the old descriptor. * keyboard.c (read_key_sequence): Treat function keys like ascii characters. * lread.c (init_lread, syms_of_lread): New names for init_read and syms_of_read, for consistency. * emacssignal.h: New file. * data.c, keyboard.c, process.c, sysdep.c: Include it. * data.c (arith_error): Use SIGEMPTYMASK. * keyboard.c (sigfree, sigunblockx): Use SIGEMPTYMASK. (sigholdx, sigblockx): Use sigmask. (gobble_input): Use sigblockx instead of sigholdx, so that any other blocked signals stay blocked during and after the call to read_avail_input. * process.c (create_process): Use sigmask. [FASYNC] (request_sigio): Use sigunblock. * xterm.c (sigmask): Removed #definition here. * ymakefile (keyboard.o, process.o, sysdep.o, data.o): Make these depend on emacssignal.h. * window.c (Fselect_window): Modify surrogate minibuffer hack to make the minibuffer the selected window of the selected screen, AND select the minibuffer window's screen. * minibuf.c (read_minibuf): If the minibuffer window is on a different screen, save that screen's configuration too. * window.c (Fset_window_configuration): Use SCREEN_ accessor to get at a screen's root window. Removed unused variable screen_to_select. (Fcurrent_window_configuration): Take an optional argument SCREEN. All callers changed. * window.c (auto_new_screen, Vauto_new_screen_function): Renamed to pop_up_screens and pop_up_screen_function, to be parallel with pop_up_windows. (display_buffer, syms_of_window): Changed appropriately. * fns.c (Fload_average) [DGUX]: Add code to support DGUX. * s-dgux.h, m-aviion.h: New files. * emacs.c (main) [POSIX_SIGNALS]: Call init_signals. * screen.c (Fdelete_screen): Update last_nonminibuf_screen if the screen it's currently pointing to gets deleted. Mon Jul 22 21:05:18 1991 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * screen.c (last_nonminibuf_screen): New variable. (Fselect_screen): Set last_nonminibuf_screen if appropriate. Sun Jul 21 07:37:09 1991 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * screen.h (last_nonminibuf_screen): Added declarations for new variable. * minibuf.c (active_screen): Variable removed. (read_minibuf): Removed code to set and clear active_screen. * window.c (Fdisplay_buffer): Rewritten to use last_nonminibuf_screen. * screen.c (next_screen): Use SCREEN_ accessors instead of ->. * window.c (Fdisplay_buffer): Removed reference to Fx_create_screen; we should rely on the auto-new-screen-function being set to something appropriate. Sun Jul 21 00:58:10 1991 Jim Blandy (jimb at wookumz.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): Restore the state of this_command_key_count along with the echoing state. Sat Jul 20 18:42:59 1991 Jim Blandy (jimb at wookumz.gnu.ai.mit.edu) * xfns.c (Fx_synchronize): New function. (syms_of_xfns): defsubr it. * xdisp.c (redisplay): Don't turn on all_windows whenever we're using a separate minibuffer screen. Even if there is some tweak necessary, this wasn't it. * process.c (status_notify): Do not forget to UNGCPRO. * screen.c (next_screen): Re-work logic to skip minibuffer-only screens so that it doesn't loop indefinitely, even when the only screen is a minibuffer-only screen. Skip all screens that are only minibuffers, not just when they are the global minibuffer screen. * xdisp.c (message, message1): If the screen's message buffer is 0, toss the message; don't check the window system against the screen output_method. Fri Jul 19 07:42:41 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): When we truncate the echo buffer because the user has switched screens, re-echo the character that caused the truncation. * lread.c (Fload): Change "source newer than ..." message not to refer to "libraries." What is a "library," anyway? * window.c: #include "termhooks.h", and therefore too. [MULTI_SCREEN] (Fselect_window): If the window being selected is the selected screen's minibuffer, but it lives on another screen, don't select that other screen - call the screen_rehighlight_hook instead. * termhooks.h (screen_rehighlight_hook): New hook, so that Emacs can shift the screen highlighting when needed. * term.c (screen_rehighlight_hook): Define it. * xterm.c (x_highlight_screen): New variable. (x_new_focus_screen): Move the rehighlighting code to... (XTscreen_rehighlight): New function. (x_display_bar_cursor, x_display_box_cursor): Use x_highlighted_screen instead of x_focus_screen. (x_term_init): Initialize screen_rehighlight_hook. * ymakefile: Make window.o depend on termhooks.h. * xfns.c (Fx_create_screen): Add mention of global-minibuffer-screen to docstring. * screen.c (make_screen_without_minibuffer): Improve error message displayed when Vglobal_minibuffer_screen is not a proper screen. Thu Jul 18 01:56:23 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * config.h (PURESIZE): Definition moved to... * puresize.h: New file. (PURESIZE): Define this here. This will allow people to change their pure storage allocation without having to recompile most of Emacs. * data.c: #include puresize.h, since CHECK_IMPURE needs PURESIZE. * alloc.c: #include puresize.h. [HAVE_SHM] (pure_size): New variable, so that XPNTR doesn't depend on PURESIZE. [HAVE_SHM] (init_alloc_once): Initialize pure_size here. * lisp.h [HAVE_SHM] (XPNTR): Defined in terms of pure_size, instead of PURESIZE. (pure_size): extern declaration added here. * ymakefile: Added puresize.h to dependencies for alloc.c and data.c's .o files. * emacs.c (main): Doc fix for kludge to scan for -d. Wed Jul 17 01:21:20 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * termhooks.h (struct input_event): #if 0'd out the definition for the screen_selected event type, and added the stipulation that the {non_,}ascii_keystroke events specify the screen they happen in. * xterm.c (x_new_focus_screen): Don't enqueue a screen_selected event. (XTread_socket): Calls to x_new_focus_screen in the EnterNotify, FocusIn, LeaveNotify, and FocusOut event code don't worry about enqueued events any more. * keyboard.c (new_selected_screen): Removed - see below. (Vlast_event_screen): New variable, visible to lisp code. (echo_length, echo_truncate): New functions. (readable_events): Removed screen_selected events from the set of things to skip. (kbd_buffer_store_event): Don't bother collapsing consecutive screen_selected events. (kbd_buffer_read_char): Don't process screen_selected events. (make_lispy_event): Re-arrange scrollbar events to put the window whose scrollbar was diddled right after the identifying symbol, for consistency. (read_key_sequence): Let the selected screen and the location of the event affect the keymap used to find its binding. (Fread_key_sequence): Update docstring. (syms_of_keyboard): Added DEFVAR_LISP for Vlast_event_screen. Mon Jul 15 21:17:11 1991 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * screen.c (next_screen): If !mini_screen, only exclude the global minibuffer screen when the minibuffer is its only window. (Fnext_screen): Make the docstring clearer about what MINISCREEN means. * window.c (Fother_window): Indicate that it takes both a required and optional argument, instead of just one required. Mon Jul 15 17:10:19 1991 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * buffer.c (Fkill_buffer): Rehacked kill-buffer-hooks to use standard name kill-buffer-hook, and to use set_buffer_internal instead of Fset_buffer. Use static variable containing symbol instead of intern. (syms_of_buffer, init_buffer_once): Qkill_buffer_hook = 'kill-buffer-hook. Mon Jul 15 05:35:12 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keymap.c (Fsingle_key_description): When describing a listy object, take the car to find the symbol that heads it, not the cdr. * dispnew.c (buffer_posn_from_coords): Pass col and line to compute_motion in the correct order. * keyboard.c (make_lispy_event): When calculating rows and columns for mouse clicks and movement events, don't forget to subtract the position of the window's top left corner before passing them to buffer_posn_from_coords. * screen.c (coordinates_in_window): Removed useless test for *y == screen_height, and screen_height variable; this would be out of range of all the windows anyway. * xdisp.c (message1): Removed code to ignore messages before X has started up; this issue has hopefully been addressed by the condition-case in startup.el. * editfns.c (init_editfns): Make user_name char * instead of unsigned char *, since that's what most of the usages seem to want. And when expanding ampersands in AMPERSAND_FULL_NAME mode, don't try to use user_name as a string; use Vuser_name. * minibuf.c (assoc_for_completion): New function. (do_completion): Use that to check for exact match. * minibuf.c (Ftry_completion): Fix handling of matches aside from case. If ignoring case, and all else equal, try to preserve the case of the characters in the input. * process.c (status_notify): GCPRO tail. * sysdep.c (creat_copy_attrs, rename_sans_version): Always set protection to O:REWD when creating file. Added new function rename_sans_version, which strips the version number from the target filename, renames the temporary file to this filename, and then sets the file protection of this new file to be the same as the file being edited. * sysdep.c [VMS]: Include pwd.h from Emacs. Use sys/file.h if GCC. (F_SETFL) [VMS]: Undefine this, to control conditionals. (getpwnam): Make `full' unsigned. (creat_copy_attrs): Add some casts. (sys_access): Change prvmask and CHECKPRIV to use bitfields. Add some casts, and make dummy an unsigned short int. Don't use & on constants. (vmserrstr): Add a cast. (sys_creat): Define va_count before this function. Sun Jul 14 18:13:36 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * sysdep.c (sys_sleep, input_wait_timeout): Don't use & on constant. [VMS]: Include pwd.h from Emacs. Use sys/file.h if GCC. (bzero, bcopy) [VMS]: Don't take address of `length'. * sysdep.c (sys_suspend): Cast value of `signal' to insulate from changed value type in sysV.3. * sysdep.c (child_setup_tty): Turn off erase & kill chars for BSD. * sysdep.c (discard_tty_input): Use TIOCFLUSH on Apollo. (init_sys_modes): Avoid TIOCSTART on Apollo. * sysdep.c: If HAVE_TERMIOS is not defined, define tcgetattr in terms of the TIOCGETP ioctl. (init_sys_modes): Handle VSUSP, V_DSUSP if HAVE_TCATTR. (discard_tty_input, init_baud_rate, child_setup_tty, init_sys_modes, tabs_safe_p, reset_sys_modes): Use tcgetattr, and if HAVE_TCATTR, use tcsetattr. Sat Jul 13 01:02:53 1991 Jim Blandy (jimb at churchy.gnu.ai.mit.edu) * s-hpux8.h: New file. * fileio.c [HPUX8]: Don't include errnet.h. * unexhp9k800.c (unexec): Local variable i to avoid compiler bug? * sysdep.c (insque) [WRONG_NAME_INSQUE]: New function. * s-386ix.h (WRONG_NAME_INSQUE): Define it. * xdisp.c (message_buf_print): New variable. (message): Clear it here. * dispextern.h: Declare it here. * print.c (printchar, strout): Set it and test it here. * keyboard.c (command_loop_1): Don't clear last_command when start macro. * keyboard.c (read_command_char): Exit at eof if noninteractive. * indent.c (invalidate_current_column): New function. * editfns.c (Fwiden, Fnarrow_to_region): Call it. * process.c (create_process): Use O_NOCTTY whenever defined, unless USG. * process.c (Fprocess_send_eof): If using a pipe, close it. (close_process_descs): Check IN and OUT for nonzeroness. * process.c (process_send_signal): Use interrupt chars to send certain signals to the process group. (TIOCGETC): Undefine this if it is not really usable. * sysdep.c (discard_tty_input): Do nothing if read_socket_hook. * xfns.c (x_set_mouse_color): Change the default pointer shapes to be closer to xterm and emacs 18. * xterm.c (x_focus_on_screen, x_unfocus_screen): These no longer call XSetInputFocus, because I think that the X-windows ICCCM says that only the window manager can do this sort of thing. * keyboard.c (read_char): When there is an unread command character, goto reread_first when this_command_key_count is zero, not when it is >= 0. (command_loop_1): Reset this_command_key_count only if there is no prefix argument. This makes echoing of keystrokes work correctly. Thu Jul 11 23:55:01 1991 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * eval.c (Finteractive_p): Changed "! XTYPE (foo) == Lisp_Bar" to "XTYPE (foo) != bar". Thu Jul 11 17:03:10 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * eval.c (apply1): Don't forget to UNGCPRO before returning. * xterm.c (XTupdate_begin): Undisplay the cursor here; do_scrolling will call XTins_del_lines when the screen matrix is inaccurate, so we cannot undisplay the cursor then, but do_scrolling is always called within an update. Wed Jul 10 19:58:18 1991 David J. MacKenzie (djm at nutrimat) * termcap.c, tparam.c [!emacs, USG || STDC_HEADERS]: Define bcopy in terms of memcpy. Tue Jul 9 18:36:25 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * scroll.c (do_scrolling): Use correct termination condition for loop that uses the glyph pointers for the deleted lines to fill in the inserted lines. Mon Jul 8 21:28:23 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * editfns.c: Doc fix. Wed Jul 3 05:47:56 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * dispnew.c (line_hash_code): Test m->highlight[vpos], not m->highlight. All lines were getting hash codes of -1, because the highlight vector was never NULL. Golly. * process.c (list_processes_1): Handle status of network streams. Tue Jul 2 22:10:26 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * doc.c (Fdocumentation_property): Pass only strings to Fsubstitute_command_keys. Tue Jul 2 17:01:02 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * editfns.c (init_editfns): If neither of the environment variables are set, DON'T set Vuser_name to Vuser_real_name; it's supposed to reflect the EFFECTIVE uid. Get the full name according to Vuser_name if it differs from Vuser_real_name, not if they are equal. And pass Vuser_name to getpwnam in that case instead of user_name, which might be 0. * lisp.h (RETURN_UNGCPRO): New macro. * bytecode.c (Fbyte_code): Do not remove GC protection from the stack when making a function call, because the caller is responsible for protecting the arguments to a MANY-arg'ed function. * eval.c (Fapply): If we use funcall_args, GCPRO it. And when we call Ffuncall with funcall_args, tell it the correct length of funcall_args, no matter which branch allocated it. (Ffuncall): Don't gcpro the arguments before calling Fgarbage_collect. (Feval): If we're calling a subr that takes MANY args, don't UNGCPRO until after we call the subr. (apply1, call0, call1, call2, call3): GCPRO the arg arrays passed to Ffuncall and Fapply. * callproc.c (Fcall_process, Fcall_process_region): Don't GCPRO the argument array. * editfns.c (Finsert, Finsert_before_markers): Don't GCPRO the argument array. Added comment about when GCPROing is not needed. * mocklisp.c (Finsert_string): Don't GCPRO the argument array. * keyboard.c (init_keyboard): Handle SIGQUIT with interrupt_signal on any system that has HAVE_TERMIO, not just on USG systems. Mon Jul 1 12:20:34 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * editfns.c (init_editfns): Test that user_name isn't 0. Sat Jun 29 12:25:43 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * search.c: Doc fixes. Fri Jun 28 11:22:05 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * keyboard.c (make_lispy_event): Let the posns of mouse clicks and mouse movements be nil when window_from_coordinates returns a NON-window, not when it returns a window. Since posn is a lisp object, don't call make_number when consing up the event. Don't call make_number on the code member of the event. * keyboard.c (struct movement): Make the x, y, and time members Lisp_Objects, since it's easier to convert from a Lisp_Object than to. (note_mouse_position): Adjusted for the above. (make_lispy_event): Removed code to make Lisp_Objects for those members. * xterm.c (XTread_socket): When handling LeaveNotify events, remember that the focus member of the event is true when the receiving window now has the focus, not when it is losing it. * xfns.c (Ffocus_screen): Don't signal an error if SCREEN is already the focus screen. Wed Jun 26 10:35:34 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * alloc.c (Fmake_rope): Use sizeof (GLYPH) instead of 2 to determine how large the string should be, and changed doc string to describe ropes as strings of glyphs, not just as strings of character pairs. (Frope_elt): Use sizeof (GLYPH) as the element size, instead of assuming that the elements are two bytes. * lisp.h (typedef GLYPH): Moved the definition from here... * config.h (typedef GLYPH): to here, so people can elect to get better performance if they don't want to use huge fonts. * xterm.c (dumpglyphs): Use XDrawImageString or XDrawImageString16, Depending on sizeof (GLYPH). * data.c (Fsetq_default): Call Fset_default to do the assignments, not plain Fset. The following changes were contributed by Jamie Zawinski : * bytecode.c (Fbyte_code): BYTE_CODE_SAFE and BYTE_CODE_METER options added. Added Bmark, Bscan_buffer, Bset_mark to support error-checking for these obsolete bytecodes. Added Bunbind_all to support tail-call optimization (not yet implemented). Did NOT add the relative branch opcodes that were in the version of bytecode.c that Jamie sent. The branching bytecodes now only QUIT if they take the branch. Btemp_output_buffer_show, Bforward_char, Bforward_word, Bskip_chars_forward, Bskip_chars_backward, and Bforward_line passed the wrong number of arguments to their subrs. Brem, Bbuffer_substring, Bdelete_region, Bnarrow_to_region, Bstringeqlsign, Bstringlss, Bequal, Bnthcdr, Bmember, Bassq, Bsetcar, and Bsetcdr passed arguments to the subr in the wrong order. Tue Jun 25 16:49:50 1991 Jim Blandy (jimb at churchy.gnu.ai.mit.edu) * doc.c (Fdocumentation): Added a QUIT test to the loop that finds the symbol's function value. Mon Jun 24 18:48:03 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * xterm.c (dumprectangle): Removed call to XFlushQueue here. * keyboard.c (command_loop_1): Call Fselect_screen to establish the new selected screen after the key sequence has been read, not at the top of the loop. This way, a key sequence will happen in the screen it was typed at, or (to be more precise) the screen its last character was typed at. * keyboard.c (fast_read_one_key): Function deleted, since it had been #if 0'd out a long time ago. (command_loop_1): Support for fast_read_one_key removed. * eval.c (Ffuncall): Do GCPRO the arguments, contrary to the May 16 change. The convention appears to be that the MANY-arged callee must protect its own arguments. (Fapply): Don't protect funcall_args; they are the caller's responsibility. * bytecode.c (Fbyte_code): GCPRO the section of the stack *above* the args to Ffuncall, since it will be protected again once Ffuncall returns and therefore should stay valid. If it is not protected, string relocation may make it invalid. * mocklisp.c (Finsert_string): GCPRO the arguments, since insert may cause a garbage collection. * editfns.c (Finsert, Finsert_before_markers): GCPRO the arguments, since insert may cause a garbage collection. * callproc.c (Fcall_process, Fcall_process_region): GCPRO the arguments, since insert may cause a garbage collection. Thu Jun 20 06:24:19 1991 Jim Blandy (jimb at wookumz.gnu.ai.mit.edu) * buffer.h (struct buffer_text, struct buffer): small change to comments. * search.c (Fmatch_beginning, Fmatch_end): Fixed doc strings to indicate that non-regexp searches set these too. * window.c (Fset_window_start): If window is not the selected window, set windows_or_buffers_changed, so that redisplay will know that it should redisplay the window. * callint.c (Finteractive): Changed doc string to indicate that the interactive prompts are passed through format. Thu Jun 20 00:21:31 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * buffer.c (syms_of_buffer): buffer-undo-list doc fix. Tue Jun 11 18:18:27 1991 Roland McGrath (roland@albert.gnu.ai.mit.edu) * data.c (Fsetq_default): Take multiple SYM, VAL args; syntax now parallel to setq. Sat May 25 00:38:22 1991 Jim Blandy (jimb at wookumz.gnu.ai.mit.edu) * keyboard.c (kbd_buffer_read_char): Fix wait-for-input loop so that we always process/toss events we don't want to return. * screen.c (Fselect_screen): Call Ffocus_screen instead of x_new_selected_screen, which doesn't exist anymore. * xfns.c (Ffocus_screen): Declare the type of the SCREEN argument. * xfns.c (Fx_track_pointer): Function #if 0'd out - I don't think that this is a feature that we want. (syms_of_xfns): Elide the defsubr for the above. * xterm.c (x_mouse_screen, x_input_screen): Variable deleted, since all we really need is x_focus_screen; all other issues are the realm and responsibility of the window manager. (x_new_selected_screen): Renamed to x_new_focus_screen, and modified not to do thiogs inappropriate for signal handlers. (XTread_socket): Change the handling of EnterNotify, LeaveNotify, FocusOut and FocusIn events to use x_new_selected_screen, and ditched code that deals with x_mouse_screen and x_input_screen, since they don't exist anymore. (x_display_bar_cursor, x_display_box_cursor): Compare s with x_focus_screen to see what form the cursor should take. (x_destroy_window): Don't bother with x_input_screen. * xfns.c (x_mouse_screen): Removed extern declaration for this. (Fx_grab_pointer): Confine the pointer to x_focus_screen, not x_mouse_screen. This is wrong, but will make emacs compile until this gets fixed. Thu May 23 18:52:13 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keyboard.c (get_input_pending): Don't use trim_events; use readable_events instead. * keyboard.c (make_lispy_event): Remove case for window_sys_event, since that type of event doesn't exist anymore. * minibuf.c (Fcompleting_read): Document the backup-n argument. * dispnew.c (init_display): Don't declare alternate_display extern here. I can't figure out what this feature is, and it's broken. * emacs.c (main): Don't test alternate_display and put its value in the environment. Wed May 22 18:47:28 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keyboard.c (struct movement): Made .used an int instead of a char, since that's more likely to be stored atomically on SPARCS and similar machines. * termhooks.h (struct input_event): Removed the window_sys_event, since it's not used anywhere. Added screen_selected event type. The event handling code used to change the current buffer, selected window, and selected screen out from under running lisp code. Now we wait for a more convenient time by enqueuing an event. * xterm.c (XTread_socket): When handling FocusIn events and EnterNotify events with the focus member set, enqueue a selected_screen event instead of calling x_new_selected_screen. * keyboard.c (trim_events): Function deleted; it is a bad idea to delete events based on the current tracking state, since tracking might be re-enabled later. (readable_events): New function which searches the input queue for readable events. (tracking_off): Call readable_events to see if we should redisplay. (kbd_buffer_read_char): Toss events that we are not interested in. This is a better place to do it than trim_events, since we know that do_mouse_tracking will not change. Also, handle screen_selected events. (new_selected_screen): New variable, holding the screen which should become selected the next time through command_loop_1. (syms_of_keyboard): Initialize and staticpro new_selected_screen. (command_loop_1): If there is a new screen to be selected, do so. Tue May 21 20:30:04 1991 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xdisp.c (message): Removed the if at the top that did not display messages if the current screen was a termcap screen and a window system will be used. The change to startup.el on May 18, 1991 replaces this. * ralloc.c (check_memory_limits): If the address returned by the allocator is not representable in a Lisp_Object, call memory_full instead of printing a very silly "warning" message. Sun May 19 18:04:39 1991 Jim Blandy (jimb at wookumz.gnu.ai.mit.edu) * xterm.c (XTread_socket): Don't overwrite the end of the buffer with function keys. * keyboard.c (tracking_off): Update input_pending after reading all the input. * process.c: #include "screen.h". (wait_reading_process_input): Check if any screens have been newly mapped and need updating. * xterm.c (XTread_socket): Don't SET_SCREEN_GARBAGED when the screen is unmapped; do this when is mapped. (dumprectangle): Don't dump any data for garbaged screens. Sat May 18 14:18:52 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * sysdep.c (init_sys_modes): Moved the clauses that set up interrupt-driven input out of the "if running on a terminal" clause, since these may need to be set up even when running on a window system. Fri May 17 15:05:33 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * process.c (Fprocess_status): For network connections, return Qopen and Qclosed instead of Qrun and Qexit, as documented. * lread.c (read1): Removed code that treated numbers starting with a zero as octal. Thu May 16 09:58:09 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * eval.c (Ffuncall): Don't gcpro the arguments; the caller protects them. (Fapply): Gcpro funcall_args, if we use them. * xterm.c (notice_mouse_movement): #if 0'd this function out. (XTread_socket): #if 0 the code that fakes motion events for moving in and out of windows. Also, rearrange the MotionNotify case to give character rows and columns to note_mouse_position, not pixel x and y positions. Don't deal with scrollbars here. * termhooks.h (struct input_event): Removed the mouse_movement event kind. * keyboard.c (movement_buf): A new buffer for mouse-movement events. This is hairier than you might think; see the comments for this and the comments for note_mouse_position and get_mouse_position for an explanation of why this is hairy. (movement_ptr): Where the event handler should store new mouse locations. (EVENT_QUEUES_EMPTY): New macro, to be used in the places that used to compare kbd_fetch_ptr to kbd_store_ptr to see if there were any events available; this macro tests the mouse movement buffer too. (Qmouse_movement): New symbol to head mouse movement events with. (trim_events): Mouse movement events are no longer in kbd_buffer, so don't try to trim them. (tracking_off, kbd_buffer_read_char, get_input_pending): Use EVENT_QUEUES_EMPTY. (get_mouse_position): New function to retrieve a mouse position from the buffer properly, no matter when the event-handling signal occurs. (kbd_buffer_read_char): If there is something in kbd_buffer, make an event for that; if there is a mouse movement, make an event for that; otherwise, the while loop lied. (make_lispy_event): Added code to produce mouse movement events. (init_keyboard): Clear the mouse movement buffer. (Qmouse_moved, Qredraw_screen, Qmapped_screen, Qunmapped_screen, Qexited_window, Qexited_scrollbar): Removed extern declarations for these, since they're no longer generated. (syms_of_keyboard): Initialize and staticpro Qmouse_movement, remove DEFVAR_LISP for Vignore_mouse_events. Tue May 14 12:45:20 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * lread.c (read1): Correctly parenthesize the shift when parsing octal numbers, and signal an error if we see a non-octal digit. Mon May 13 11:28:07 1991 Jim Blandy (jimb at wookumz.gnu.ai.mit.edu) * keyboard.c (trim_events): New function, to remove uninteresting events from the input queue. (get_input_pending): Call trim_events before checking the queue, so as not to advertise input we don't care about. (Ftrack_mouse): A new function to enable mouse tracking for a block of code. (tracking_off): A function for unwind_protection; restore the mouse tracking state to what it was outside of the track-mouse (syms_of_keyboard): defsubr track-mouse. (make_lispy_event): Find the window io which the click occurred when processing mouse_click events, instead of trusting the window tree in the signal-handling code. Include the buffer position in the click event. * xterm.c (construct_mouse_click): Return the click's screen, not its window, and don't bother updating Vmouse_window. Calculate the row and column of text-area clicks using pixel_to_glyph_translation, since we know that those data structures are alive in signal handlers. * screen.c (window_from_coordinates, Flocate_window_from_coordinates): Moved these to window.c, since I need to be able to call them even if we don't have multi-screen support. (syms_of_screen): Removed defsubr for Flocate_window_from_coordinates. * window.c (window_from_coordinates, Flocate_window_from_coordinates): Here they are. (syms_of_window): Here is the defsubr. * keyboard.c (note_mouse_position): New function to enqueue mouse movement events properly. (current_movement_event): New variable, to support the above. See its comment for more explanation. * termhooks.h (struct input_event): Change the .window member to .screen, make it a struct screen *, and indicate that those events which used to return windows now return screens. It is unsafe for the event reader to traverse the window structure, because it can be called by a signal handler. Fri May 10 12:29:21 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * keyboard.c (Vignore_mouse_events): Variable deleted. (make_lispy_event): For mouse and scrollbar clicks, return the position as a pair of numbers, not a list of two numbers. Thu May 9 02:27:10 1991 Jim Blandy (jimb at wookumz.gnu.ai.mit.edu) * keyboard.c (do_mouse_tracking): Define this variable, which controls whether kbd_buffer_read_char will ignore button up and mouse movement events. * termhooks.h: Declare do_mouse_tracking here. * xterm.h (STANDARD_EVENT_SET): New constant, giving the event mask all the windows use. * xfns.c (Vx_send_mouse_movement_events): Removed this variable; XTmouse_tracking_enable and do_mouse_tracking do its job better. (syms_of_xfns): Remove the DEFVAR_LISP for the above. (x_window): Don't ask for any pointer motion events or button release events by default; use the unmodified STANDARD_EVENT_MASK. The user will ask for them explicitly if he or she wants them. And don't ask for backing store. * xterm.c (XTmouse_tracking_enable): New function to request/unrequest detailed mouse tracking information of the server, and set the flag used by XTread_socket. (x_term_init): Set mouse_tracking_enable_hook to XTmouse_tracking_enable here. (XTread_socket): Handle mouse movement events by calling note_mouse_position. * xterm.c (XTread_socket): For MapNotify events, go ahead and set the screen's visible flag, so Expose events will work. Clear the iconified flag. * editfns.c (Finsert_char): Return immediately if n <= 0, not just if n < 0, so that the `while' below does not become an infinite loop. * term.c (mouse_tracking_enable_hook): Added this variable to allow emacs to request that the window system start or stop detailed mouse tracking. * termhooks.h (mouse_tracking_enable_hook): Declare it here. * xfns.c: Declare the functions before initializing x_screen_parm_table to point to them. * xterm.c (XTread_socket): Don't send Qmapped_screen, Qunmapped_screen, Qexited_scrollbar, Qexited_window, Qredraw_screen - these are not features that we want to support. Tue May 7 00:42:58 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * editfns.c (Finsert_char): Let strlen be the minimum of n and 256, not the maximum, so we use an n-byte buffer when n < 256, and a 256-byte buffer many times when n > 256. Sun May 5 21:58:01 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * keymap.c (Fkeymapp): Fixed docstring to give the right definition of a keymap. Fri May 3 15:02:12 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * data.c (Fcompiled_function_p): New function. Fri May 3 00:57:52 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * xfns.c (struct x_screen_parm_table): New type for recording information about screen parameters. (x_screen_parms): New table describing the existing parameters. (init_x_parm_symbols, x_set_screen_param): Use x_screen_parms instead of a large switch statement. (x_figure_window_size): Make the default case of the switch call abort instead of signalling an error, since window_prompting's value is internally generated. Wed May 1 18:21:36 1991 Jim Blandy (jimb at churchy.gnu.ai.mit.edu) * keymap.c (describe_map_tree): GCPRO the maps variable; Fkey_description calls Fmapconcat, which eventually calls Ffuncall, which can garbage-collect. Sun Apr 28 01:04:15 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * dispnew.c (buffer_posn_from_coords): Use the information in bufp to reduce the distance compute_motion must scan, when possible. Sat Apr 27 21:56:59 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keyboard.c (syms_of_keyboard): Qtop_level is initialized and staticpro'd in syms_of_data too. Don't staticpro (or initialize) it again here. * macros.c (syms_of_macros): Since executing-macro and executing-kbd-macro are actually the same variable, use DEFVAR_LISP_NOPRO for the second one so it doesn't get staticpro'd twice. * process.c (syms_of_process): Don't staticpro or initialize Qexit here, since syms_of_eval already does this and it's bad to staticpro something twice. (Qexit): Remove declaration here, so there will be a compilation error if someone rearranges eval.c without fixing the Qexit stuff. * eval.c (syms_of_eval): Add comment here to say that syms_of_process cares about Qexit too. * lread.c (init_obarray): Don't staticpro Vobarray, since the DEFVAR_LISP in syms_of_read takes care of that. Mon Apr 22 00:34:21 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * window.c (save_window_save): Always get the selected window's value of point from its buffer, not just when it's also the current buffer. * lisp.h (Qdisabled): Declare this here so that the keys_of_* files can disable the commands they define. * casefiddle.c (keys_of_casefiddle): Make upcase-region and downcase-region disabled, by default. Tue Apr 16 09:39:52 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * bytecode.c (PUSH): Alliant can't be bothered to implement the preincrement operator right, so use a comma. * print.c (syms_of_print): staticpro Qexternal_debugging_output. * editfns.c (clip_to_bounds): No longer static - used in window.c. * window.c (unshow_buffer): Use clip_to_bounds to make sure we change point to something legal. Sun Apr 14 22:43:51 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * sysdep.c: Changes in formatting and comments. Fri Apr 12 11:45:34 1991 Jim Blandy (jimb at wookumz.gnu.ai.mit.edu) * editfns.c (Fbuffer_substring): Don't call make_string, because it may cause a compaction and move the buffer, and then copy the wrong data. * keyboard.c (read_char): Only GC if we've actually done enough consing since the last gc to make it worthwhile. Thu Apr 11 09:48:53 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * keymap.c (access_keymap): Canonicalize the order of the modifiers when you look up a symbol in a keymap, too. (where-is-internal): If the keymap in which we found the definition was reached by meta-prefix-char, replace it with the metized character. * eval.c (Fcondition_case): Initialize the `handler_list' member of the catchtag. * keyboard.c (read_char): reset recent_keys_index when it is greater than OR EQUAL to the number of elements in recent_keys, stupid. * keymap.c (access_keymap): When fetching the car of listy events, no need to call Fcar_safe - extract the car directly. * keyboard.c (read_key_sequence): Don't extract the car from listy events here since 1) it strips information that we need from the events, and 2) access_keymap will take care of that for us. * macros.c (Qexecute_kbd_macro): New variable, used by Fexecute_command. (syms_of_macros): Initialize and staticpro Qexecute_kbd_macro. * lisp.h: Add extern declaration for Qexecute_kbd_macro. * keyboard.c (Fcommand_execute): Add an entry to the command history for keyboard macros too. * xterm.c (XTread_socket): If we get a MappingNotify event whose request == MappingKeyboard, someone has changed the keyboard mapping, and we should get the new mapping with XRefreshKeyboardMapping. Wed Apr 10 11:43:37 1991 Jim Blandy (jimb at wookumz.gnu.ai.mit.edu) * commands.h: Declare last_command_char to be a Lisp_Object, not an integer (ack). * cmds.c (Fself_insert_command): If last_command_char is not an integer, beep. * minibuf.c (Fself_insert_and_exit): Same thing. * keyboard.c (format_modifiers): New function, factoring out code from modify_event_symbol and reorder_modifiers. (modify_event_symbol): Call format_modifiers instead of doing the work inline. (reorder_modifiers): New function to put the modifiers on a modified symbol in the canonical order. * keymap.c (modify_event_symbol): Prepend the modifiers so they appear in the canonical order: `M-C-S-U-'. (store_in_keymap): If IDX is a symbol, put the modifiers in the canonical order before storing. Tue Apr 9 15:05:54 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keymap.c (Flocal_set_key, Fglobal_set_key): When checking types of arguments, allow KEYS to be a vector or string, not just a string. (keymap_table): New static function to replace duplicated code in access_keymap and store_in_keymap. (access_keymap): Use keymap_table. (store_in_keymap): Use keymap_table, and put non-character definitions in dense keymaps *after* the vector. * fileio.c (directory_file_name): Remove trailing slashes from single-letter names like "a/" too. Let slen be the string length, not one less than the string length. * keyboard.c (Fset_input_mode): Don't complain that QUIT isn't an ASCII character if it is nil - it is an optional parameter. * keymap.c (Faccessible_keymaps): Use meta-characters in the key sequences returned, carefully making sure that the sequences still appear in order of increasing length. Thu Apr 4 14:56:33 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * vmsfns.c (vms_trnlog): Increased size of str to 256 elements. (vms_symbol): Increased size of str to 1025 elements. Sun Mar 24 01:50:12 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * dispnew.c (pixel_to_glyph_translation): Moved this function to xterm.c, since it is specific to X and only called by the X code. * xterm.c (pixel_to_glyph_translation): Here it is. Fri Mar 22 18:19:21 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * s-usg5-4.h (DATA_SEG_BITS): Definition deleted. * m-intel386.h (DATA_SEG_BITS): Define here if USG5_4. Fri Mar 22 17:48:01 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keymap.c (Faccessible_keymaps): Produce meta-characters in the key sequences instead of [meta-prefix-char CHAR] sequences. Thu Mar 21 20:24:53 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keymap.c (Flookup_key): If KEY is a zero-length array, then return KEYMAP; this is more algebraically satisfying. * dispnew.c (Fsit_for): If the time to sit is zero and there is no input available, then return Qt, not Qnil. * keyboard.c (read_char): If a quit occurs and we return quit_char, clear Vquit_flag, so we don't end up returning it again and again... All lisp code does this manually if they call read-char with quits inhibited, so it's the right thing to do. Wed Mar 20 06:01:58 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keyboard.c (read_char): If there is still no input available after an auto-save, do a garbage-collection. * undo.c (truncate_undo_list): Always leave at least one undo record in the undo list. And use sizeof (struct Lisp_Cons), etc. instead of 8, etc. * keyboard.c (read_char): When deciding whether to wrap recent_keys_index back to 0, compare it against sizeof (recent_keys)/sizeof(recent_keys[0]), not sizeof (recent_keys). (quit_char): This can't be anything but an ASCII character, so it shouldn't be a Lisp_Object. The declaration's comment says why. (read_char, init_keyboard): Treat quit_char as an int now. (Fset_input_mode): As above, and signal an error if QUIT is not an ASCII character. * callint.c (Fprefix_numeric_value): Use XFASTINT to initialize val, not raw. * fileio.c (Fmake_symbolic_link): Don't expand FILENAME; this would make it impossible to make a link to a relative name. Tue Mar 19 18:45:06 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * keyboard.c (syms_of_keyboard): Removed the DEFVAR_BOOL for meta-flag. This cannot be a lisp variable because we need to change the terminal settings whenever this flag changes. Change this through set-input-mode instead. Tue Mar 19 17:30:09 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * keyboard.c (read_avail_input): Raise SIGHUP if no input on AIX. Tue Mar 19 02:52:36 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * keyboard.c (kbd_buffer_store_event, kbd_buffer_read_char, read_key_sequence, Fexecute_extended_command, Fset_input_mode, init_keyboard, syms_of_keyboard): Use XSET (var, Lisp_Int, exp) instead of XSETINT (var, exp) in those cases where var is not known to already be a Lisp_Int. * search.c (skip_chars): Same. * xterm.c (construct_mouse_click, XTread_socket): Same. * callint.c (Fprefix_numeric_value): Make sure to return a Lisp_Int even when RAW is a cons whose car is not a Lisp_Int. * process.c (sigchld_handler): When searching for a process whose pid is -1, make sure that the pid is an int first, since network streams are in Vprocess_alist too. * keyboard.c (syms_of_keyboard): Added DEFVAR_BOOL for meta-flag. Emacs 18 had this, and I see no entry in the ChangeLog saying that it was purposefully removed. Sun Mar 17 14:07:44 1991 Jim Blandy (jimb at geech.ai.mit.edu) * keymap.c (Fcopy_keymap, Faccessible_keymaps, describe_map, append_key): Minor typos and brainos corrected. * keyboard.c (read_char): Removed code to find the vector in a (kbd-macro . VECTOR) - style macro, since the macro is represented by the vector itself. (read_char_menu_prompt): Changed to correctly recognize the new dense keymap structures. (read_key_sequence): Changed code that checks for keymapness to use get_keymap_1 instead of doing the indirection and keymapness testing itself. (Fcommand_execute): A keyboard macro is now a string or a vector. (Fexecute_extended_command): When expanding this_command_keys, remember that it is now an array of Lisp_Objects, not chars. * doc.c (Fdocumentation): Rearranged into a switch statement, and made vectors macros, not keymaps. * eval.c (Fcommandp): Removed code to recognize (kbd-macro . VECTOR) as a command, and added code to recognize vectors as commands. * macros.c (Qkbd_macro): Variable deleted. (syms_of_macros): Initialization of Qkbd_macro removed. Thu Mar 14 18:36:34 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * minibuf.c (keys_of_minibuf): Changed all calls to initial_define_lisp_key to calls to initial_define_key. * keymap.c (describe_map): Adjusted to handle the new style of keymap. Thu Mar 14 17:06:14 1991 Richard Stallman (rms at mole.ai.mit.edu) * fileio.c (Fwrite_region): On VMS, don't try rewriting old version. Thu Mar 14 09:31:59 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * keymap.c (Faccessible_keymaps): Adjusted to handle the new style of keymap. (Fwhere_is_internal): Handle the new-style of keymaps. Additionally, only check to see if a match is shadowed by a binding in the local keymap when LOCAL_KEYMAP is non-nil, instead of comparing elt against DEFINITION yet again. (describe_map_tree): Handle key sequences that are vectors, as well as those that are strings. Wed Mar 13 18:07:27 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * commands.h, keymap.c (meta_map, control_x_map): Make these Lisp_Objects, not Lisp_Vectors. keymap.c (syms_of_keymap): Same. * keymap.c (Fuse_global_map): There is no longer any reason to insist that KEYMAP must be a dense keymap; delete the code that does so. Tue Mar 12 22:31:21 1991 Jim Blandy (jimb at wookumz.ai.mit.edu) * commands.h, lisp.h: Changed global_map and current_global_map to be Lisp_Objects, not Lisp_Vectors. keyboard.c (read_key_sequence): Same. keymap.c (Fkey_binding, Fglobal_key_binding, Fglobal_set_key, Fuse_global_map, Fwhere_is_internal, describe_buffer_bindings, syms_of_keymap): Same. * keymap.c (Fdefine_key): Braino: increment idx and clear metized flag even when the element of the key sequence isn't a character. (Flookup_key): Fix same braino. Sun Mar 10 16:54:18 1991 Jim Blandy (jimb at wookumz.ai.mit.edu) * keymap.c (get_keyelt): Use access_keymap to resolve indirect entries, instead of duplicating its code. (Fcopy_keymap): Handle the new keymap structure. Sat Mar 9 23:35:18 1991 Richard Stallman (rms at mole.ai.mit.edu) * eval.c (struct catchtag): New field handlerlist. (internal_catch, internal_condition_case): Set that field. (unbind_catch): Use it. Fri Mar 8 02:53:41 1991 Richard Stallman (rms at mole.ai.mit.edu) * m-intel386.h (signal): Maybe define if USG. * keyboard.c (echo_char): Don't have space at end of echobuf. Thu Mar 7 16:13:32 1991 Jim Blandy (jimb at albert.ai.mit.edu) * keyboard.c (syms_of_keyboard): Initialize mouse_syms, instead of doing func_key_syms twice. Don't deal with scrollbar_syms, since it doesn't exist. Wed Mar 6 14:43:59 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * keymap.c (access_keymap, store_in_keymap): Changed to handle the new style of keymaps. * fns.c (Fassq, Fcopy_alist): Changed docstring to promise to ignore elements of LIST that are not conses. See access_keymap and copy_keymap for a cheap excuse. Wed Mar 6 14:32:14 1991 Richard Stallman (rms at mole.ai.mit.edu) * s-vms.h (DATA_START): Remove `+ 512'. Tue Mar 5 20:37:22 1991 Jim Blandy (jimb at spiff.ai.mit.edu) * keymap.c (Fmake_keymap): Rewritten to construct the new dense keymap structure: (keymap VECTOR . ALIST). Docstring adjusted accordingly. This means that the keyboard macro stupidity (see Feb 27, keyboard.c) is no longer needed. Sun Mar 3 17:15:44 1991 Richard Stallman (rms at mole.ai.mit.edu) * sysdep.c (MEMORY_IN_STRING_H): New compilation flag. * s-isc2-2.h: New file. Wed Feb 27 14:28:29 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * macros.c (Qkbd_macro): New variable, to hold the symbol `kbd-macro', which we use to tag vector-style keyboard macros. (syms_of_macros): Initialize and staticpro Qkbd_macro. * eval.c (Fcommandp): Recognize the new keyboard macros. * keyboard.c (Fcommand_execute): A keyboard macro is now a string, or a cons whose car is the symbol `kbd-macro' and whose cdr is a vector of events; previously, macros were strings or vectors, but that makes it difficult to tell the difference between macros and dense keymaps. (read_char): Handle the new macros correctly, and re-allocate this_command_keys correctly. Tue Feb 26 23:45:00 1991 Richard Stallman (rms at mole.ai.mit.edu) * s-vms.h (calloc): Define like malloc, etc. Tue Feb 26 12:50:45 1991 Jim Blandy (jimb at spiff.ai.mit.edu) * xterm.c (XTread_socket): Move enter_timestamp outside of the function; static variables inside functions don't always work in Emacs. * editfns.c (in_accessible_range): Deleted - insufficently general. (clip_to_bounds): New function, much like in_accessible_range, except that the upper and lower bounds are arguments. (goto_char, save_restriction_restore): Rewritten to use clip_to_bounds instead of in_accessible_range. Mon Feb 25 08:44:45 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * keymap.c (initial_define_lisp_key): Turn KEY into a Lisp_Int before passing it to store_in_keymap. * buffer.c (reset_buffer_local_variables): Don't try to initialize the buffer's mouse_map and function_key_map fields, since they don't exist anymore. * macro.c (kbd_macro_buffer, kbd_macro_ptr, kbd_macro_end): These are now all pointers to Lisp_Objects instead of chars. (Fend_kbd_macro): Use make_sequence. (store_kbd_macro_char): Argument c is now a Lisp_Object. Change call to xrealloc to ask for Lisp_Objects instead of chars. Set kbd_macro_end to the same place in the new buffer as it was in the old one, not to the end of the buffer. (Fexecute_kbd_macro): Allow MACRO to be a string or a vector. (syms_of_macros): Allocate Lisp_Objects instead of chars for kbd_macro_buffer. * alloc.c (make_sequence): New function, useful to keyboard.c and macro.c. * keyboard.c (Fread_key_sequence): Use make_sequence. (Fthis_command_keys): Use make_sequence. Sun Feb 24 16:40:10 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * keymap.c (Fwhere_is): If the command can't be found, the message is now "foobie is not on any key.", instead of "... any keys.". * keyboard.c (input_poll_signal): Pass 0 to read_avail_input, instead of `&junk'. Removed variable `junk'. (command_loop_1): Updated to handle the unified function key/mouse event/keystroke arrangement. (Finput_pending_p): Removed vestiges of code to handle unread_input_char value of -1, since this doesn't happen anymore. (read_char): Adapted to handle lispy events. (read_char_menu_prompt): Allocate `menu' buffer using alloca, instead of a variable-sized array, which is gcc-specific. (Frecent_keys): Return the most recent "keystrokes" as a vector, to accomodate lispy events. (Fset_input_mode): Accomodate non-characters as quit keys. If this is a bad thing, init_sys_modes will tell us. (init_keyboard): this_command_keys is now an array of Lisp_Objects; adjust the amount of storage we request to hold it. Remember that quit_char can be any keystroke. (syms_of_keyboard): last_command_char, last_input_char, help_char, menu_prompt_more_char and meta_prefix_char are now DEFVAR_LISPs instead of DEFVAR_INTs. Sun Feb 24 15:58:23 1991 Richard Stallman (rms at mole.ai.mit.edu) * process.c (wait_reading_process_input): Use NETCONN_P. Sat Feb 23 22:18:47 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * keyboard.c: (recent_keys, this_command_keys, menu_prompt_more_char, help_char, last_command_char, quit_char, last_input_char): Changed to Lisp_Objects, so we can use function keys for them. (Vglobal_function_map): Variable deleted. (echo_char): Echo function keys too. The argument C is now a Lisp_Object instead of a char. (Fread_key_sequence): Removed sludge to handle window events specially, and added sludge to handle sequences with non-characters in them. (classify_object): Elided, since this should go away soon. (read_key_sequence): Adapted to look up symbols in keymaps, just like characters. Sat Feb 23 15:22:57 1991 Richard Stallman (rms at mole.ai.mit.edu) * process.c (send_process): Handle EAGAIN like EWOULDBLOCK. Fri Feb 22 11:13:25 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * doc.c (substitute_command_keys): Call describe_map_tree with only three arguments, since the CHARTAB arg has been disposed of. * keymap.c (Fcurrent_global_map, Fuse_local_mouse_map): Functions deleted, since the mouse maps are no longer separate from the key maps. (append_key): New function, which handles tacking a single keystroke on the end of a key sequence, promoting strings to vectors when needed. (Faccessible_keymaps): Adjusted to return vectors for key sequences, when necessary. (Fkey_description): Removed stuff to handle mouse buttons and other things specially, since this work will go into Fsingle_key_description. (Fsingle_key_description): SIMPLIFIED to handle everything correctly! Jeepers! (Fwhere_is_internal): Scan the assoc-list at the end of dense keymaps, and construct strings or vectors. (where_is_string, describe_buffer_bindings): Simplified by deleting code to handle mouse button bindings specially. (describe_map_tree): Removed CHARTAB argument; this was a kludge to print out mouse events nicely, and is no longer necessary. Nobody was using it anyway. (describe_map): Removed ugly hack to handle mouse buttons specially, added code to describe alists on dense keymaps, and removed CHARTAB argument. (describe_alist): Made to handle bindings of symbols as well as characters. Removed CHARTAB argument. (describe_vector): Removed CHARTAB argument, allocated KLUDGE outside of loop and GCPRO'd it. (syms_of_keymap): Remove last vestiges of Vglobal_mouse_map, Vmouse_button_names, Suse_local_mouse_map, Scurrent_local_mouse_map. * buffer.h (struct buffer): Removed mouse_map and function_key_map members, since they are now handled by the keymap element. * keyboard.c (syms_of_keyboard): Change initialization of meta_prefix_char, since it's now a Lisp_Object. * keymap.c (Fkeymapp): Rewrote this to use get_keymap_1; now it's a one-liner instead of a 13-liner. (DENSE_TABLE_SIZE): Created new constant for the # of lookup-style entries in a dense keymap, and the index of the map's assoc list. Used it where appropriate. (Fcopy_keymap): Notice that 129'th element in dense keymaps. (Fdefine_key, Flookup_key): Reworked to deal with vectors of symbols and characters as well as strings for key sequences. (meta_prefix_char): Changed from an int to a Lisp_Object. Thu Feb 21 22:41:38 1991 Richard Stallman (rms at mole.ai.mit.edu) * fileio.c (report_file_error): Don't downcase "I/O". Wed Feb 20 05:25:56 1991 Jim Blandy (jimb at geech.ai.mit.edu) * keymap.c (access_keymap): Allow IDX to be any sort of bindable event, and deal with the extended keymaps. IDX is now a Lisp_Object instead of an int, obviously. (store_in_keymap): Allow IDX to be any sort of bindable event, and deal with the extended keymaps. IDX is now a Lisp_Object. * xterm.c (construct_mouse_click): Add code to set the up_modifier bit for ButtonRelease events. * keyboard.c (kbd_buffer_store_event): Use XFASTINT and XSETINT to access event->code, since it's a Lisp_Object. (kbd_buffer_read_char): Golly, perhaps we should increment kbd_fetch_ptr to remove the event we just read from the queue. (modify_event_symbol): Stupid fixes: correctly look up unmodified symbols when cache entry has a modified symbol vector. And, when first adding the modified symbol vector, copy the old slot value into it correctly. Tue Feb 19 00:03:16 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * keyboard.c (command_loop_1): #if 0 the block of code which handles mouse events and other lispy events specially, since I hope it will go away soon. * dispnew.c (Fsleep_for_millisecs): Pass all four arguments to wait_reading_process_input, instead of just the first two. * process.c (wait_reading_process_input): Remove support for only waiting for mouse input, since that has been superceded. This removes X dependencies from process.c, and eliminates some references to code that should only exist when using X10. * keyboard.c (mouse_moved_symbol, redraw_screen_symbol, mapped_screen_symbol, unmapped_screen_symbol, exited_window_symbol, exited_scrollbar_symbol): Renamed to Qmouse_moved, Qredraw_screen, Qmapped_screen, Qunmapped_screen, Qexited_window, Qexited_scrollbar, just as done in xterm.c. (classify_object): Removed code to look up a function key in the global and local function key keymaps, since this will be done more generally. (Fexecute_mouse_event): Elided this function with a #if 0; I think it will go away once the more general keymap stuff is implemented, but I'm not sure. (syms_of_keyboard): Removed defsubr for Sexecute_mouse_event. (where_is_string, describe_buffer_bindings, syms_of_keymap): Elided code to handle mouse button bindings specially; I hope this will go away. * lread.c (syms_of_lread): Change defsubr for eval-buffer to defsubr for eval-current-buffer. * keymap.c (syms_of_keymap): defvar for Vglobal_function_map removed, since that variable has disappeared. * xterm.c (x_func_key_to_sym): Removed entirely, since we no longer convert X keycodes to symbols in this section of code. (x_convert_modifiers): New function to turn the X modifier bits into struct input_event modifier bits. (encode_mouse_button): removed, since this work isn't done here anymore. (Vx_send_mouse_movement_events): Add an extern declaration for this. * termhooks.h: Only define struct input_event if the module has previously #included lisp.h; this avoids forcing simple modules like cm.c to #include lisp.h. * term.c: #include "lisp.h" before #including "termhooks.h", since the latter uses Lisp_Objects now. * xfns.c (syms_of_xfns): Delete the defsubr for Sx_window_id, since Fx_window_id is gone. * xterm.c (construct_mouse_event): Construct a struct input_event instead of a lispy event. * screen.c (coordinates_in_window): Added explanatory comment. (window_from_coordinates): Change PART, whose returned values are dependent on X-windows, to be called MODELINE_P, with appropriate new return values. * xterm.c (notice_mouse_movement): Handle the X-windows dependent stuff that used to be in window_from_coordinates here instead. (XTread_socket): Modified to produce struct input_events instead of lispy events. Mon Feb 18 18:12:57 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * termhooks.h: Added up_modifier to the enum for modifier bits; this bit will be applied to mouse events. (struct input_event): Changed specification of non_ascii_keystroke events to send the function key number instead of a symbol. * keyboard.c (modify_event_symbol): Re-arranged to work well with function key/mouse button numbers instead of symbols. And if (MODIFIERS & up_modifer), prepend "U-" to the name of the symbol being constructed. (make_lispy_event): Use the new modify_event_symbol. * xterm.c (notice_mouse_movement): Adjusted this function to work with a struct input_event instead of producing an s-expression. * xterm.c, xfns.c: Made all references to x_mouse_queue, x_expose_queue, and the functions which manipulate them conditional on having X10, since only X10 code ever places anything in these queues. Fri Feb 15 05:20:16 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * termhooks.h: Define struct input_event, to represent input events while they sit in the keyboard input buffer. Using lisp objects to represent input events is a bad idea because the routines which enqueue them can be called from signal handlers, and therefore should not cons. * keyboard.c: (kbd_buffer, kbd_fetch_ptr, kbd_store_ptr): Change these to be of type `struct input_event *'. (kbd_buffer_store_event): Manipulate struct input_events instead of lisp objects. (make_lispy_event): New function, to construct a lisp-style event corresponding to a particular struct input_event. (modify_event_symbol): New function, to add modifier prefixes to a symbol, and look the new symbols up quickly if they've already been created. (kbd_buffer_read_char): Call make_lispy_event to turn the thing in the keyboard buffer into the form that read_char is expecting. (Qwith_modifier_keys): Define this new symbol variable. (syms_of_keyboard): Initialize and protect Qwith_modifier_keys. * xterm.c (init_input_symbols): Rearranged the code that produces the func_key_syms array. (x_func_key_to_sym): Simplified, since more will be handled in make_lispy_event. (XTread_socket): When handling KeyPress events, don't pass the state of the modifier keys to x_func_key_to_sym, since it doesn't care any more. * sysdep.c (kbd_input_ast, end_kbd_input, read_input_waiting): Rename kbd_buffer_store_char to kbd_buffer_store_event. * keyboard.c (stuff_buffered_input): Since the keyboard buffer holds lisp objects, only stuff entries that are Lisp_Ints, and XINT them before passing them to stuff_char. (kbd_buffer_store_char): Make this not a static function, since sysdep.c calls it. And rename it kbd_buffer_store_event. * keyboard.c (kbd_buffer, kbd_fetch_ptr, kbd_store_ptr): Made these variables static, to document the fact that they're only used within keyboard.c. Wed Feb 13 00:43:13 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * xterm.c (init_input_symbols): remove the `xk-' prefix from all the function key symbols, since they're going to be used for function keys from all sorts of terminals, not just when running under X. * lread.c (read_escape): Removed support for mouse button escapes (\S-, \U-, \C- applied to digits), because they're being replaced by something more rational. Sat Feb 9 13:23:05 1991 Richard Stallman (rms at mole.ai.mit.edu) * buffer.c: Doc fix. * sysdep.c (dup2): Rewrite of non-F_DUPFD case. Fri Feb 8 00:03:24 1991 Richard Stallman (rms at mole.ai.mit.edu) * m-intel386.h (LOAD_AVE_CVT): Add extra parens. * s-usg5-4.h (LIBX11_SYSTEM): #undef it. Thu Feb 7 13:39:24 1991 Richard Stallman (rms at mole.ai.mit.edu) * s-esix.h: New version from kayvan. Adds HAVE_X11 conditional, NEED_PTEM_H, USG_SYS_TIME, USE_UTIME, LIBS_DEBUG; removes #undef sigsetmask, LIBS_SYSTEM, ESIX, MISSING_UTIMES. Wed Feb 6 14:18:42 1991 Richard Stallman (rms at mole.ai.mit.edu) * process.c (Faccept_process_output): Second arg gives timeout. Wed Feb 6 00:01:26 1991 Jim Blandy (jimb at geech.ai.mit.edu) * lread.c (read_escape): Added support for \S- and \U- escapes (for binding mouse buttons), and noted that \C- must work on digits. * xterm.c (init_input_symbols): Was mistakenly renamed init_inputs; named back. * xterm.c (construct_mouse_click, encode_mouse_button): Rewritten to build new-style mouse events. * dispnew.c (update_line): Write a zero into obody[olen] to make sure the lines in current_screen->glyphs remain terminated. * xdisp.c (display_string, display_text_line): Don't write off the end of the line and destroy the zero terminator when expanding a tab. * fns.c (Fy_or_n_p): Accept C-] (usually abort-recursive-edit) as well as C-g to quit. Tue Feb 5 18:28:57 1991 Jim Blandy (jimb at geech.ai.mit.edu) * sysdep.c, s-aix3-1.h, s-hpux.h, s-iris3-5.h, s-iris3-6.h, s-irix3-3.h, s-rtu.h, s-sunos4-1.h, s-unipl5-0.h, s-unipl5-2.h, s-usg5-0.h, s-usg5-2-2.h, s-usg5-2.h, s-usg5-3.h, s-xenix.h: Globally replaced INTERRUPTABLE with INTERRUPTIBLE. * xterm.c (construct_mouse_event): Renamed to construct_mouse_click, since there are kinds of mouse events besides clicks (movement, for example). (XTread_socket): rename calls here. * xterm.c (mapped_screen_symbol, unmapped_screen_symbol, exited_scrollbar_symbol, exited_window_symbol, redraw_screen_symbol, mouse_moved_symbol): Renamed to Qmapped_screen, Qunmapped_screen, Qexited_scrollbar, Qexited_window, Qredraw_screen, Qmouse_moved, to agree with naming conventions elsewhere in Emacs. * xfns.c (text_part_sym, modeline_part_sym, vertical_scrollbar_sym, vertical_slider_sym, vertical_thumbup_sym, vertical_thumbdown_sym, horizontal_scrollbar_sym, horizontal_slider_sym, horizontal_thumbleft_sym, horizontal_thumbright_sym): Renamed to Qtext_part, Qmodeline_part, Qvscrollbar_part, Qvslider_part, Qvthumbup_part, Qvthumbdown_part, Qhscrollbar_part, Qhslider_part, Qhthumbleft_part, Qhthumbright_part, to agree with the naming conventions elsewhere in Emacs. * xterm.c (XTread_socket): While handling EnterNotify events, clear Vmouse_event here. (notice_mouse_movement): Don't clear it here. Mon Feb 4 17:50:45 1991 Richard Stallman (rms at mole.ai.mit.edu) * s-sunos4-0.h: Renamed from s-sunos4.h. (read, write, open, close): Macro defs moved to s-sunos4-1.h. (INTERRUPTABLE_*): Likewise. * s-sunos4-1.h: New file. Mon Feb 4 02:17:08 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * keymap.c (Vglobal_mouse_map, Vglobal_function_map): Variables removed in preparation for conversion to unified keymap format. (Fmake_keymap): Make vector keymaps with 129 entries; the last will be an assoc-list for looking up symbols. Update docstring to describe 129'th element. (Fmake_sparse_keymap): Update docstring to say that you can bind symbols in these maps too. (Fkeymapp): Recognize 129-element vectors as keymaps, not 128-element vectors. (get_keymap_1): wrong_type_argument can no longer return a new value supplied by the debugger; remove loop to support this. * xterm.c (XTread_socket): When handling EnterNotify events, enqueue fake mouse events iff Vx_send_mouse_movement_events != Qnil. * xfns.c (Fx_window_id): Function removed; Fscreen_parameters already provides this information. * xterm.c (x_term_init): Cleaned up the code to get the host name, and removed fixed limit on host name length. * window.c (Fscroll_other_window): Don't explicitly save current_buffer and point; the save_excursion will take care of that anyway. * dispnew.c (safe_bcopy): Rewritten to handle overlapping regions with multiple calls to bcopy instead of a stupid copy loop. * xterm.c, xfns.c (Vscreen_part, Vx_send_movement_events): These variables renamed to Vmouse_screen_part, Vx_send_mouse_movement_events. * lread.c (Feval_buffer): function deleted. (Feval_current_buffer): Removed "#if 0 ... #endif" around this function. Sun Feb 3 21:50:00 1991 Richard Stallman (rms at mole.ai.mit.edu) * Makefile, ymakefile (SHELL): Force use of sh. * s-usg5-4.h (USG5_4): Define it. (LOAD_AVE_*): Don't define them. * m-intel386.h (LOAD_AVE_*): Define, if USG5_4. * buffer.c (Fbuffer_local_variables): Omit slots with no names. Sun Feb 3 19:12:31 1991 Jim Blandy (jimb at geech.ai.mit.edu) * xterm.c (x_term_init, init_input_symbols): Moved these to the bottom of the file, 1) to be consistent with the other files, and 2) so it can initialize some variables I want. Sat Feb 2 05:26:29 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * xterm.h: Added external declaration for x_focus_screen. * search.h: File deleted. * buffer.h: declare searchbuf here instead. * screen.c (Ffocus_screen, Funfocus_screen): Moved these functions to xfns.c, since they're x-specific. (syms_of_screen): Removed defsubr calls for above. * xfns.c (Ffocus_screen, Funfocus_screen): Here they are. (syms_of_xfns): The defsubrs are here now. * buffer.h (PT): Make this expand to an expression which is not an l-value, to prevent people from assigning to it. If everyplace uses SET_PT, it will be easier to merge in the interval code. (point): Similar changes here. (SET_PT): This can no longer be written in terms of PT, so write out current_buffer->text.pt. * xterm.c (x_new_font): Rewritten to remove arbitrary limit on size of x_font_table. (x_font_table_size): Created new variable. (n_available_fonts, font_names, font_info, MAX_FONTS): Deleted these variables/macros. * dispnew.c (scroll_screen_lines): Instead of disabling the lines vacated by the scroll (i.e. zeroing enable), mark them as enabled but empty. * callint.c (Fcall_interactively): Move UNGCPRO down, so that stuff is protected while we build the command history entry and do the function call. * xterm.c (XTupdate_end): Turn cursor on, even if we don't currently have the focus. * minibuf.c (temp_echo_area_glyphs): Clear echo_area_glyphs and previous_echo_glyphs, so the message we're displaying will supercede any existing message. * keyboard.c: Removed external declaration of echo_area_glyphs, since it's declared in window.h. Thu Jan 31 18:16:41 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * xterm.c (XRINGBELL): Pass 0 as the second argument to XBell; respect the user's preferences. Wed Jan 30 05:22:47 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * xterm.c (x_draw_single_glyph): New function, created to simplify cursor drawing/undrawing. (x_display_box_cursor): Rewritten to properly handle the box cursor in its filled and hollow forms. * xterm.h (enum text_cursor_kinds): Added enum for the different kinds of cursors which might be displayed in a window. (struct x_display): added member `text_cursor_kind' which says which kind of cursor is currently being displayed in the window, so we can arrange to redraw it effectively. * keyboard.c (command_loop_1): When handling the forward_char command, don't let point move to the location after the end of the buffer. * keyboard.c (poll_suppress_count): Define this even if POLL_FOR_INPUT is not defined, because this makes lots of #ifdef clauses unnecessary, and doesn't hurt, because {start,stop}_polling become nops. * config.h, config.h-dist: Make these #include "system.h" and "machine.h", and let the config script link these appropriately, instead of using the machine-specific names and expecting the user to edit this file. Tue Jan 29 21:08:41 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * window.c (Fdelete_window): sib is a Lisp_Object; treat it as such. * xterm.c (screen_unhighlight): When the focus leaves a screen, draw the cursor as a box instead of making it disappear entirely. Tue Jan 29 14:59:44 1991 Richard Stallman (rms at mole.ai.mit.edu) * unexec.c (make_hdr) [TPIX]: Set f_hdr.f_nscns and f_thdr.f_scnptr. * sysdep.c [BROKEN_TIOCGWINSZ]: Undef TIOCGWINSZ. * process.c (wait_reading_process_input): Don't ignore a zero-length read on a network connection. Do close it. * sysdep.c (hft_init, hft_reset): Pass &junk as arg to HFQERROR. Do nothing if not HFT. Tue Jan 29 00:02:34 1991 Jim Blandy (jimb at albert.ai.mit.edu) * xfns.h: Created, to declare things defined in xfns.c. Declare Vx_send_movement_events. * xfns.c: #include "xfns.h". (Vx_send_movement_events): Define this variable. (syms_of_xfns): DEFVAR_LISP it. * xterm.c: #include "xfns.h". (XTread_socket): Place a mouse-moved event in the buffer iff Vx_send_movement_events says to. Mon Jan 28 17:47:54 1991 Jim Blandy (jimb at geech.ai.mit.edu) * ymakefile: noted that callint.o depends on mocklisp.h, and dired.o on search.h. * environ.h: Deleted - its creation in the first place was misguided. callproc.h: Removed #include "environ.h", and added declarations for environ.h * buffer.c (syms_of_buffer): Add more detailed documentation to buffer-undo-list. * lisp.h (poll_suppress_count): Add external declaration for this here. Mon Jan 28 00:34:59 1991 Richard Stallman (rms at mole.ai.mit.edu) * m-sun3-68881.h, m-sun3-fpa.h, m-sun3-soft.h: New files. Sun Jan 27 22:19:31 1991 Jim Blandy (jimb at geech.ai.mit.edu) * lisp.h (struct handler): add poll_suppress_count member, so we can restore poll_suppress_count when we handle an error. * eval.c (struct catchtag): Add it here too, for throws. (internal_catch, Fcondition_case, internal_condition_case): Record the value of poll_suppress_count here in the handler and catch tag. (Fthrow, Fsignal): Restore it here. Fri Jan 25 21:41:27 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * xterm.c (x_display_box_cursor): If we're undrawing the cursor by redrawing the character underneath it, draw according to that line's highlight, instead of assuming it's in the normal GC. Fri Jan 25 16:52:12 1991 Richard Stallmao (rms at mole.ai.mit.edu) * buffer.h (PTR_CHAR_POS): Value was too small by 1. Wed Jan 16 17:45:05 1991 Richard Stallman (rms at mole.ai.mit.edu) * doprnt.c (doprnt): Check for overflow in fmtcpy. Wed Jan 16 16:35:33 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * window.c (Fdelete_window): If the deletee gives its space to its next sibling, that sibling needs to have its top/left side pulled back to where the deletee's is. Tue Jan 15 16:17:53 1991 Jim Blandy (jimb at geech.ai.mit.edu) * doc.c (Fsnarf_documentation): handle attaching docstrings to bytecode objects too. * syntax.h (syntax_spec_code): make external declaration for this unsigned char to match the definition in syntax.c. * indent.c (compute_motion): added comments describing how it can be used. Tue Jan 15 13:13:36 1991 Richard Stallman (rms at mole.ai.mit.edu) * process.c (create_process): Use SETUP_SLAVE_PTY if defined. * s-usg5-4.h (HAVE_PTYS, HAVE_SETSID): Defined. (HAVE_WAIT_HEADER, WAITTYPE, wait3, WRETCODE): New macros. (TIOCSIGSEND): Alias for TIOCSIGNAL. (FIRST_PTY_LETTER): Overridden. (PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF, SETUP_SLAVE_PTY): New macros. * m-ibmrs6000.h (CANNOT_DUMP): Undefine it. (UNEXEC): Define it. (PURE_SEG_BITS, SHMKEY): Define only if CANNOT_DUMP. (LINKER): Override it. Then add -bnodelcsect. * xfns.c (Fx_get_default): Try reversing XGetDefault args if it fails. Sun Jan 13 20:26:50 1991 Richard Stallman (rms at mole.ai.mit.edu) * s-usg5-4.h (LOAD_AVE_CVT): Cast value to int. * keyboard.c (read_avail_input): Signal SIGHUP if FIONREAD fails. * ymakefile: Put tokens after #endif into comment. * filelock.c (lock_file_owner_name): Declare argument type. * syntax.c (syntax_spec_code): Type now unsigned char. * process.c (wait_reading_process_input): Call status_notify even when not doing redisplay. * emacs.c (Fkill_emacs): Turn off SIGIO before exiting. * s-usg5-3.h (USG5_3): Define it. * m-ibmps2-aix.h [USG5_3]: Define TEXT_START as 0. Don't define DATA_START or DATA_END or TEXT_END or DATA_SEG_BITS. Override various other symbols at end of file. Sat Jan 12 15:10:24 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * window.c (window-configuration-p): Closing paren needed. Added. * keyboard.c (command_loop_1): When displaying a message over an active minibuffer, call Fsit_for with three arguments, not two. Sat Jan 12 14:50:45 1991 Richard Stallman (rms at mole.ai.mit.edu) * s-irix3-3.h (HAVE_SYSVIPC): Defined. Sat Jan 12 13:56:32 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * dispnew.c (buffer_posn_from_coords): compute_motion starting from bufp[y] instead of counting from the top of the window. Fri Jan 11 16:38:54 1991 Richard Mlynarik (mly at pizza.ai.mit.edu) * window.c (window-configuration-p): Needed. Added. Fri Jan 11 15:52:10 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * dispnew.c (buffer_posn_from_coords): Remember to deduce space for the line continuation markers and the window separators from the window width. Fri Jan 11 11:45:19 1991 Richard Stallman (rms at mole.ai.mit.edu) * m-tower32v3.h (VALBITS, GCTYPEBITS): Use 26 bits for pointer. Thu Jan 10 12:33:20 1991 Richard Stallman (rms at mole.ai.mit.edu) * fileio.c (Fcopy_file): Always close descriptors. * s-sunos4.h: read, write, open and close are interruptable. Wed Jan 9 12:32:21 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * xterm.c, dispnew.c (pixel_to_char_translation): Renamed to pixel_to_glyph_translation, and rewritten. Just get coordinates, don't return anything. (buffer_posn_from_coords): New function - given a window and co-ordinates on the screen, find the buffer position at those co-ordinates. Tue Jan 8 06:14:51 1991 Jim Blandy (jimb at geech.ai.mit.edu) * alloc.c (Fmake_byte_code): Flesh out docstring. * window.c (window_loop): pick the first window correctly, even when screen == 0. * dispnew.c (scroll_screen_lines): Don't forget to call update_begin at the top of the down-scrolling section. And rotate by amount, not -amount, in the up-scrolling section. * xterm.h (MAX_FONTS, x_font_table, n_fonts): Removed external declarations for these variables, since they're declared static in xterm.c and not used elsewhere. * xterm.c (MAX_FONTS): Moved definition of this to here from xterm.h. * xterm.c (x_new_font): If you can't find the requested font, return a code which indicates this, instead of calling abort. Mon Jan 7 10:08:47 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * xdisp.c (redisplay, display_mode_line): To test Vglobal_minibuffer_screen for validity, you must check that its type is Lisp_Screen; comparing it to Qnil isn't good enough. * screen.c (syms_of_screen): Initialize Vglobal_minibuffer_screen to Qnil; otherwise, it inhibits decent redisplay (is that another bug?) * dispnew.c (init_display): Make sure that the standard input is a terminal here. * emacs.c (main): Not here, since we don't know yet if we want to use a window system of some sort. * xfns.c (x_make_gc): Delete code to support default_face and highlight_face, since they're part of the interval code, and shouldn't be installed yet. * dispnew.c (init_display): calculate_costs expects a screen parameter; pass selected_screen, instead of nothing. * search.c (Freplace_match): Protect STRING. * process.c (run_filter): New function. (read_process_output, exec_sentinel): Use run_filter to call the process's filter function. (status_notify): GCPro MSG. * process.c (Fopen_network_stream): Protect various args. * print.c (Fprin1_to_string, Fprint): Protect OBJ. * lread.c (Feval_region): Check type of B. * keymap.c (describe_alist): Protect ELT_PREFIX and TEM2. (describe_vector): Likewise for ELT_PREFIX and TEM1. Sun Jan 6 23:25:24 1991 Richard Stallman (rms at mole.ai.mit.edu) * sysdep.c (init_sys_modes): Turn off VSUSP and V_DSUSP if they exist. Only on a MIPS. Sat Jan 5 09:13:07 1991 Jim Blandy (jimb at spiff.ai.mit.edu) * xselect.c (x_answer_selection_request): For incremental, set format to 32 and send only 1 element. Pass the address of size, not size itself. (x_selection_arrival): For incremental, delete the property containing the size of the transfer. This generates a PropertyNotify to the owner, starting the exchange. * xrdb.c (get_user_app): Pass correct number of parameters to sprintf. * xfns.c (x_window): Don't use backing store or saveunders; they seem to slow down suns. (x_icon): Set the InputHint to the window manager to False. (x_make_gc): Initialize gc_values.line_width to zero before creating the normal video GC, since it uses it. And set the default_face and hilite_face gcs here. (install_vertical_scrollbar): Add 2 to thumbdown y position, and don't add ibw. * insdel.c (insert, del_range): Use SET_PT rather than assigning point directly. * window.c (Fselect_window): Here too. * xdisp.c (redisplay_all_windows): removed static declaration for this nonexistent function. Fri Jan 4 01:05:07 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * window.c (window_loop): neatened up. MINI being non-zero now makes it recognize active minibuffer windows. Iterates properly over multiple screens when asked nicely. (Fget_lru_window, Fget_largest_window): SCREENS arguments are now declared as a Lisp_Object, and documented. (Fget_buffer_window): SCREENS argument is now documented. (Fdelete_other_windows): Delete other windows on the argument window's screen, not the current screen. * screen.c (window_from_coordinates): Changed other reference to Fnext_window to use next_screen_window; see below. * window.c (Fnext_window, Fprevious_window): Accept non-nil, non-t values for mini, and don't turn off all-screens when mini is t but there is no global minibuffer screen. Remove screen_{root,mini} variables. (Fother_window): Added second argument all_screens. * undo.c (record_delete): Removed dead variable llength. * data.c (Qkeyp, Fkeyp): Removed these and supporting code. * keymap.c (Fsingle_key_description): Report an error instead of calling wrong_type_argument. * lisp.h (Qkeyp): Removed external declaration for this. Thu Jan 3 17:30:46 1991 Richard Stallman (rms at mole.ai.mit.edu) * search.c (search_buffer): Return starting position if count == 0. Wed Jan 2 01:57:57 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * scroll.c (do_scrolling): Use correct limits on loop to clear lines just inserted--old version lost a line. * screen.c: #ifdef HAVE_X_WINDOWS, #include xterm.h (Ffocus_screen, Funfocus_screen): use Joe's new definitions, and only define these functions ifdef HAVE_X_WINDOWS. (window_from_coordinates): use next_screen_window instead of Fnext_window, so that global minibuffers work. * lread.c (syms_of_read): Don't forget to defsubr read-char-exclusive. * lisp.h (Fscreenp, Fselect_screen, Ffocus_screen, Funfocus_screen, Fselected_screen, Fwindow_screen, Fscreen_root_window, Fscreen_selected_window, Fscreen_list, Fnext_screen, Fdelete_screen, Fread_mouse_position, Fset_mouse_position, Fmake_screen_visible, Fmake_screen_invisible, Ficonify_screen, Fdeiconify_screen, Fscreen_visible_p, Fvisible_screen_list, Fscreen_parameters, Fmodify_screen_parameters, Fscreen_pixel_size, Fscreen_height, Fscreen_width, Fset_screen_height, Fset_screen_width, Fset_screen_size, Fset_screen_position, Fcoordinates_in_window_p, Flocate_window_from_coordinates, Frubber_band_rectangle): added extern declarations for all these. * lisp.h (Qscreenp): added an extern declaration for this. * lisp.h (DBL_DIG): Added constant for the maximum number of decimal digits a float could print to. Used in print.c. * keymap.c (Fkey_description): Produce pretty descriptions of mouse and window system events too. (Fsingle_key_description): signal an error if obj is not a key. * data.c (Fkeyp, Qkeyp): Added predicate to recognize things which can be bound - this includes keys, symbols (for function keys and window system events), and conses (for mouse events). * lisp.h (Qkeyp): Added external declaration for this. * keyboard.c (Frecursive_edit): Don't specbind the standard IO here. (recursive_edit_1): Do it here, and don't forgot to unbind_to. (command_loop_1): Reset no_redisplay after mouse commands. (classify_object): Place the object in read_key_sequence_cmd. (Fread_key_sequence): recognize that when read_key_sequence returns -1 or -2, it's a mouse event or window system event. Tue Jan 1 09:21:56 1991 Jim Blandy (jimb at pogo.ai.mit.edu) * fileio.c (Fwrite_region): We should dereference GPT_ADDR[-1] before comparing it to '\n' for VMS cruft. (Fdo_auto_save): Don't call run-hooks before it's defined. This only happens before emacs is dumped, when loading inc-vers.el. * eval.c (Fsignal): TOTALLY_UNBLOCK_INPUT here. (error): Not here. (Feval): We use argvals[0..5], so declare it to have six elements instead of just five. Sun Dec 30 23:24:10 1990 Richard Stallman (rms at mole.ai.mit.edu) * eval.c (Fsignal): Don't ever return. Call error instead if user tries to use debugger to return. * eval.c (unbind_to): New second arg is value to return. gcpro it. All callers changed to pass the arg; if a caller uses unbind_to just before returning, it passes as this arg the value it wants to return, then it returns whatever comes back. Fri Dec 28 18:39:45 1990 Jim Blandy (jimb at geech.ai.mit.edu) * print.c (print): put obj in a non-register variable so we could gcpro it. Also fixed some syntax errors. * editfns.c (Fformat): declare nstrings, and declare nstrings and strings in a local block. (Fformat): XFLOAT(args[n]) isn't a float; ->data is. Thu Dec 27 13:56:13 1990 Richard Stallman (rms at mole.ai.mit.edu) * m-tower32.h: Add comments for how to optimize. * m-tower32v3.h: New file. * fileio.c (Fwrite_region): Save errno around unlock_file. Wed Dec 26 17:48:01 1990 Richard Stallman (rms at mole.ai.mit.edu) * editfns.c (Fformat): Handle floats. Convert between int and float. Don't truncate value at null char coming from doprnt. * doprnt.c (doprnt): Replace tembuf with malloced buff if too small. Handle %e, %f and %g. Tue Dec 25 18:05:00 1990 Richard Stallman (rms at mole.ai.mit.edu) * abbrev.c (Fexpand_abbrev): Use insert_from_string, not insert. (Funexpand_abbrev): Likewise. * doc.c (Fsubstitute_command_keys): Likewise. * editfns.c (Finsert, Finsert_before_markers): Likewise. * minibuf.c (Fminibuffer_complete_word): Likewise. * mocklisp.c (Finsert_string): Use insert1. * vmsfns.c (Fdefault_subproc_input_handler): Likewise. * print.c: Don't use strout for the text of a Lisp string. (print_string): New function to use instead. (print): Use print_string when no escapes needed. When printing with escapes, protect the string and check addr often. Mon Dec 24 18:42:43 1990 Richard Stallman (rms at mole.ai.mit.edu) * insdel.c (insert_from_string): New function. Thu Dec 20 18:09:19 1990 Richard Stallman (rms at mole.ai.mit.edu) * term.c (ins_del_lines): Handle scroll region wrt chars_wasted. Sun Dec 16 17:22:41 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * Globally renamed InsStr to insert_string. Sat Dec 15 15:37:56 1990 Richard Stallman (rms at mole.ai.mit.edu) * s-usg5-3.h (USG_SHARED_LIBRARIES): Define it. * m-intel386.h (C_SWITCH_MACHINE): New macro. Sat Dec 15 13:36:28 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * alloc.c (STRING_FULLSIZE): Use sizeof(struct Lisp_String) instead of sizeof(int). Fri Dec 14 03:31:28 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * keyboard.c (Fread_key_sequence): Clear this_command_key_count here; who unfixed this? Wed Dec 12 16:17:56 1990 Richard Stallman (rms at mole.ai.mit.edu) * abbrev.c (Fdefine_abbrevs): Don't crash when EXPANSION is nil. Tue Dec 11 21:45:27 1990 Richard Stallman (rms at mole.ai.mit.edu) * eval.c (Fmacroexpand): Change handling of (foo . bar) in ENV. Mon Dec 10 00:11:29 1990 Richard Stallman (rms at mole.ai.mit.edu) * m-pmax.h (SYSTEM_MALLOC): Define it. * process.c (wait_reading_process_input): Ignore failure with EIO. Sun Dec 9 23:38:51 1990 Richard Stallman (rms at mole.ai.mit.edu) * m-iris4d.h (LOAD_AVE_CVT): Divide by 1024. (LIB_STANDARD): Use -lbsd first. (LIBS_MACHINE): Don't use -lbsd here. * s-irix3-3.h (ADDR_CORRECT): Macro deleted. (LIBS_MACHINE): Macro deleted. (LDAV_SYMBOL): Delete the `_' from start of symbol. * process.c (create_process): Delete duplicate sigsetmask. * m-ibmrt.h (RTPC_REGISTER_BUG, SHORT_CAST_BUG): Macros deleted. (C_SWITCH_MACHINE): Use -D to define alloca. (SIGN_EXTEND_CHAR): Use a cast. Wed Dec 5 20:05:58 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * keyboard.c (Fsuspend_emacs): Protect STUFFSTRING. (cmd_error): Protect TAIL while printing. (input_poll_signal, start_polling): Use polling_period. (syms_of_keyboard): Initialize it and make it a Lisp var. * fns.c (Fyes_or_no_p): Protect PROMPT for entire loop. * fileio.c (Frename_file): Protect args. * fileio.c (Fadd_name_to_file): Protect the args. (Fcopy_file, Fmake_symbolic_link): Likewise. (Finsert_file_contents): Protect FILENAME. Tue Dec 4 16:00:45 1990 Jim Blandy (jimb at geech.ai.mit.edu) * eval.c (Fbacktrace): gcpro TAIL. * emacs.c (Fkill_emacs): gcpro ARG. * editfns.c (Fformat): remove remains of gcpro'd args. * dispnew.c (syms_of_dispnew): Don't clobber Vwindow_system_version if CANNOT_DUMP. * dired.c (file_name_completion): Check that FILE is a string. * buffer.c (Fbury_buffer): Don't init BUF1. * doc.c (Fsubstitute_command_keys): Protect STR and don't keep a pointer to the middle of it. * m-hp9000s300.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Override for BSD. * process.c (sigchld_handler): Clear synch_process_alive if the dying process isn't in the table at all. * callproc.c (call_process_cleanup): Clear synch_process_alive. Mon Dec 3 13:48:08 1990 Jim Blandy (jimb at geech.ai.mit.edu) * callproc.c (Fcall_process): change synch_process_pid to synch_process_alive, as a general flag that we are waiting for a synchronous process to die. This obviates the need to block SIGCHLDs until we know the pid. * sysdep.c (wait_for_termination): wait for synch_process_alive to be false. * process.c (sigchld_handler): If pid not recognized, look for a process recorded with pid -1. (create_process): Set pid to -1 before the fork. Store correct pid right after the fork. Don't change sigchld handler on system V. * process.c (Fstart_process): Set BUFFER before other string vars so a gc in Fget_buffer_create won't clobber them. Fri Nov 30 18:07:13 1990 Richard Stallman (rms at mole.ai.mit.edu) * keyboard.c (read_command_char): Save and restore getcjmp. Thu Nov 29 16:57:02 1990 Richard Stallman (rms at mole.ai.mit.edu) * process.c (status_convert): Use WRETCODE for exited process. Mon Nov 26 14:34:12 1990 Richard Stallman (rms at mole.ai.mit.edu) * s-usg5-4.h (LIB_STANDARD): Add libucb.a. (NEED_PTEM_H): Define this instead of NEED_SIOCTL. * m-ibm370aix.h, m-ibmps2-aix.h, m-ibmrs6000.h (NEED_SIOCTL): Undefine this. (NEED_PTEM_H): Likewise. * s-sunos4.h (O_NDELAY): Don't define this. * print.c (Fwith_output_to_temp_buffer): Don't eval first arg twice. Thu Nov 22 17:29:26 1990 Richard Stallman (rms at mole.ai.mit.edu) * m-hp9000s300.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Alternate defs for BSD. Wed Nov 21 15:59:58 1990 Jim Blandy (jimb at churchy.ai.mit.edu) * dispnew.c (init_display): Check if we're using a window system before trying to initialize the terminal. If someone has indicated that they want to use a window system, we shouldn't bother initializing the terminal. This is especially important when the terminal is so dumb that emacs gives up and doesn't bother using the window system. Tue Nov 20 19:02:02 1990 Jim Blandy (jimb at churchy.ai.mit.edu) * print.c (Fexternal_debugging_output): added new function which writes a character to stderr, for use when debugging emacs with gdb. Wed Nov 14 19:10:53 1990 Jim Blandy (jimb at churchy.ai.mit.edu) * dispnew.c (window_change_signal): used to assume that SIGWINCHes always applied to the currently selected screen. Now it scans the list of screens for a screen controlled by termcap, and changes that screen's size. Tue Nov 13 12:04:10 1990 Richard Stallman (rms at mole.ai.mit.edu) * fileio.c (err_str): New macro. (Finsert_file_contents, Fwrite_region): Use it in error messages. Mon Nov 12 17:18:00 1990 Richard Stallman (rms at mole.ai.mit.edu) * insdel.c (del_range): Supply missing arg to gap_left. Sun Nov 11 15:45:03 1990 Jim Blandy (jimb at churchy.ai.mit.edu) * regex.c: Disabled definition of NULL from lisp.h * crt0.c (_start): added static declaration of start1. * xfns.c: added definition for Vbar_cursor. (syms_of_xfns): Added DEFVAR_LISP clause for Vbar_cursor. * xterm.c (XTread_socket): passed &event.xkey instead of &event to XLookupString, so things will typecheck nicely. * Globally rewrote all references to Vmouse_buffer to use the buffer viewed by Vmouse_window instead. * alloc.c (xmalloc, xrealloc): removed calls to {un,}hold_window_change. The new SIGWINCH-handling code and do_pending_window_change make them unnecessary. Sun Nov 11 14:12:22 1990 Richard Stallman (rms at mole.ai.mit.edu) * process.c (wait_reading_process_input): Make Available static; don't clear when a nonzero bit is found. * fns.c (Fnthcdr): Stop loop if reach end. * dispnew.c: Include fcntl.h if HAVE_TERMIO. Sat Nov 10 16:32:59 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * alloc.c (make_uninit_string): No longer declared static, and extern declaration added to lisp.h. It's used in dired.c. Thu Nov 8 22:34:30 1990 Jim Blandy (jimb at geech.ai.mit.edu) * dispnew.c (do_pending_window_change): Changed incorrect call to change_window_size_1 into a loop which scans list of screens and resizes those that need resizing. Tue Nov 6 22:00:52 1990 Richard Stallman (rms at mole.ai.mit.edu) * m-ibmrs6000.h (CANNOT_DUMP): Define it. * process.c (create_process): Unblock SIGCHLD in the child. * process.c (wait_reading_process_input): Don't read input from more than one process between calls to `select'. Fri Nov 2 15:13:17 1990 Richard Stallman (rms at mole.ai.mit.edu) * callint.c (syms_of_callint): Initialize Vprefix_arg and Vcurrent_prefix_arg. Thu Nov 1 17:00:06 1990 Richard Stallman (rms at mole.ai.mit.edu) * dired.c (Fdirectory_files): Avoid using MAXNAMLEN. Wed Oct 31 10:36:08 1990 Jim Blandy (jimb at churchy.ai.mit.edu) * process.c (MAXDESC): Enclosed definition in `#ifndef ... #endif' clause. * bytecode.c: Included syntax.h to declare syntax_code_spec. * syntax.h (syntax_spec_code): Added extern declaration for this. * floatfns.c (float_error): Added static declaration for this at the top of the file. Mon Oct 29 19:53:19 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * indent.c (position_indentation): renamed stray `bf_cur' to `current_buffer', and old `CharAt' usages to `FETCH_CHAR'. * buffer.c (Fbuffer_disable_undo): the symbol object for this subroutine was still named Sbuffer_flush_undo, and the symbol's lisp name was similarly out of date. Renamed both, and added an alias in lisp/subr.el . * keyboard.c (Fset_input_mode): a `meta_flag' had escaped being renamed to `meta_key'. Mon Oct 29 16:56:40 1990 Richard Stallman (rms at mole.ai.mit.edu) * process.c (Fprocess_send_region, Fprocess_send_string): Break data into bunches less than 500 bytes. Accept process output between bunches. ??? Must update manual. Mon Oct 29 16:25:40 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * window.c (Fset_window_start, window_scroll): renamed stray references to `redo_mode_line' to `update_mode_line'. * xdisp.c (decode_mode_spec): renamed stray references to `bf_cur' and `bf_modified' to `current_buffer' and `MODIFF'. Thu Oct 25 16:55:07 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * environ.h: file created - contains declarations for users of the environment variable list. * callproc.c (environ): removed extern declaration of environ, and included environ.h. Wed Oct 24 22:00:45 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * callproc.c (init_callproc): removed extern declaration of environ - it's already taken care of at the top of the file. * mocklisp.h: file created - externally declares certain functions defined in mocklisp.c. * lisp.h (Fread_buffer, Fread_key_sequence): added extern declarations for these functions. * callint.c (ml_apply, Fread_buffer, Fread_key_sequence): removed extern declarations for these functions, included mocklisp.h. Moved external declaration of index to top of file. Wed Oct 24 15:18:14 1990 Richard Stallman (rms at mole.ai.mit.edu) * ymakefile (GNULIB_VAR): New make variable. (LIBES): Use that, not GNULIB directly. (GNULIB): Don't define if already defined. Tue Oct 23 15:29:26 1990 Jim Blandy (jimb at geech.ai.mit.edu) * indent.h (last_known_column_point): added extern declaration for this variable. buffer.c (last_known_column_point): removed extern declaration for this variable, included indent.h. (Vprin1_to_string_buffer): removed extern declaration - it's already in lisp.h. * lisp.h (catchlist, backtrace_list, stack_bottom, current_global_map): added extern declarations for these variables. * alloc.c: removed external declarations for catchlist, backtrace_list, and stack_bottom, since this file includes lisp.h. * callint.c: (current_global_map): removed extern declaration. * search.h: new file - declares searchbuf. * dired.c (Fdirectory_files): removed extern declaration of searchbuf, included search.h. * Globally renamed `CHAR_AT_POSITION' to `FETCH_CHAR'. Mon Oct 22 14:07:45 1990 Richard Stallman (rms at mole.ai.mit.edu) * keyboard.c (quit_char): New variable. (init_keyboard): Initialize it. (Fset_input_mode): New optional arg to set quit_char. (command_loop_1, read_char, kbd_buffer_store_char): (read_avail_input): Use quit_char, not C-g. * sysdep.c (init_sys_modes): Use quit_char to set special chars. * xterm.c (x_term_init): Pass new arg to Fset_input_mode. Mon Oct 22 00:48:27 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * xdisp.c: added `extern' declaration for command_loop_level. * term.c (term_init): Internal cleanups. (write_glyphs): renamed argument `start' to `string'. Sun Oct 21 15:21:39 1990 Richard Stallman (rms at mole.ai.mit.edu) * xterm.c (FIONREAD): Undefine if BROKEN_FIONREAD. (SIGIO): Undefine if no FIONREAD. (ioctl.h, termio.h, strings.h, string.h): Include them before those. * alloc.c (make_vector_from_string, Fvector_from_string): Functions deleted. * sysdep.c (select): Handle timeout == 0. Add var local_timeout. * alloc.c (make_uninit_string, make_float): Use VALIDATE_LISP_STORAGE. (Fcons, Fmake_vector, Fmake_symbol, Fmake_marker): Likewise. (Fmake_vector_from_list): Likewise. (VALIDATE_LISP_STORAGE): New macro. Sat Oct 20 00:59:31 1990 Richard Stallman (rms at mole.ai.mit.edu) * dispnew.c (scrolling): Give up if some new lines not enabled. (update_screen): Rework outq logic. * xdisp.c (message, message1): Clear noninteractive_need_newline. Fri Oct 19 18:14:10 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * scroll.c (do_scrolling): allocate queue using alloca instead of variable-sized arrays. Fri Oct 19 17:25:34 1990 Richard Stallman (rms at mole.ai.mit.edu) * buffer.c: Doc fix. Thu Oct 18 14:40:04 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * print.c (internal_with_output_to_temp_buffer): install an unwind_protect to make sure the current buffer is restored. * minibuf.c (read_minibuf): call recursive_edit_1 instead of Frecursive_edit, to support the new command_loop_level arrangement. * malloc.c (calloc): Added this function, in case something linked with emacs calls it. * lread.c (openp): Since access returns 0 on success, change that into a 1 before returning it. * lisp.h: deleted DEFSIMPLE and DEFPRED, since they're no longer used. Thu Oct 18 13:43:50 1990 Richard Stallman (rms at mole.ai.mit.edu) * m-intel386.h (alloca): Define as builtin, if using GCC. * m-att3b.h (NEED_PTEM_H): Define this for 3b2. * s-aix3-1.h (SYSV_SYSTEM_DIR): Define it. * print.c (print): Improve error message for bad data type. Thu Oct 18 13:02:54 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * keymap.c (Flookup_key): rearranged to use an index into the key sequence instead of a pointer and a level counter. Thu Oct 18 12:53:12 1990 Richard Stallman (rms at mole.ai.mit.edu) * floatfns.c (sinh, cosh): On VMS, define to use exp. (IN_FLOAT): Detect errors reported using errno. (float_error): Define function unconditionally. Reestablish handler when called, if not BSD. Wed Oct 17 12:04:18 1990 Richard Stallman (rms at mole.ai.mit.edu) * m-delta.h (C_DEBUG_SWITCH): Don't define this. Wed Oct 17 00:05:44 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * keyboard.c (command_loop): made call to command_loop_2 conditional on minibuf_level too (it used to be only conditional on command_loop_level), since this is what 18.56 and all the other functions in Emacs 19 keyboard.c do. Tue Oct 16 23:55:24 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * keyboard.c (read_char): Don't echo dash if there is already something else being displayed in the echo area. Tue Oct 16 13:23:37 1990 Richard Stallman (rms at mole.ai.mit.edu) * process.c (status_convert): If killed by signal, use WTERMSIG. * data.c (arith_error): Reestablish handler on VMS. * keyboard.c (start_polling, stop_polling): New functions. (input_poll_signal): New function, handles periodic alarms. (read_command_char): Turn off polling temporarily. * xdisp.c (redisplay): Likewise. * process.c (wait_reading_process_input, create_process): Likewise. Tue Oct 16 01:22:09 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * indent.c (position_indentation): instead of using CharAt, use a pointer to scan the buffer - this is faster. * emacs.c (Fdump_emacs): The conditional expression which passes symname to unexec was missing a `: 0'. * dispnew.c (rotate_vector): Was rotating backwards. Mon Oct 15 23:37:57 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * dired.c (file_name_completion): Use scmp to compare names. Mon Oct 15 00:27:43 1990 Richard Stallman (rms at mole.ai.mit.edu) * process.c (create_process): Don't turn off handling of SIGCHLD. Just set a flag if a signal comes in when not wanted. (create_process_sigchld): New signal handler. Sun Oct 14 18:22:11 1990 Richard Stallman (rms at mole.ai.mit.edu) * bytecode.c: De-implement Bmark, Bset_mark, Bscan_buffer. Mark Bsymbol_function, Bfset, Bread_char as obsolete. Implement codes Bmult, Bforward_char...Bwiden, and Bstringeqlsign...Bintegerp. Fri Oct 12 00:28:00 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * buffer.c (list_buffers_1): Select the buffer given in Vstandard_output using Fset_buffer instead of set_buffer_internal. * buffer.c (set_buffer_internal): deleted variable swb - it's never used. * buffer.c (count_modified_buffers): function deleted - it's not used anymore. Thu Oct 11 23:30:01 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * buffer.c (reset_buffer_local_variables, buffer_local_variables): added support for default values for buffer local variables which do not have a DEFVAR_PER_BUFFER, as described in the comments above buffer_local_flags. * buffer.c (Fget_buffer_create): move initialization of b->save_length and b->last_window_start to reset_buffer. Thu Oct 11 11:58:40 1990 Richard Stallman (rms at mole.ai.mit.edu) * m-ibmps2-aix.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Define them. (C_DEBUG_SWITCH): Delete -fstrength-reduce. * unexmips.c (unexec): Add conditional for MIPS2. Wed Oct 10 16:36:23 1990 Richard Stallman (rms at mole.ai.mit.edu) * m-iris4d.h (LIBS_MACHINE): Use -lsun, don't use -lPW. * unexelf.c: New file. * s-usg5-4.h: New file. * unexec.c [USG_SHARED_LIBARARIES]: Numerous changes under this cond. (copy_text_and_data): New second argument. Wed Oct 10 12:00:00 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * alloc.c (gc_sweep): only unchain markers that are in a buffer. Wed Oct 10 11:16:40 1990 Mike Rowan (mtr at apple-gunkies) * process.c: Merged in more changes from 18.56: update_status, FD_SET changes (define all the FD_ macros). Other small changes. Tue Oct 9 17:30:26 1990 Jim Blandy (jimb at churchy.ai.mit.edu) * xdist.c: (decode_mode_spec): reworked code to handle %* - it now goes like `if return else if return else ... return' instead of using a conditional operator. * xdist.c: (fmodetrunc): function deleted - no longer used. Tue Oct 9 16:29:11 1990 Richard Stallman (rms at mole.ai.mit.edu) * xdisp.c (decode_mode_spec): Handle dashes in wide windows. Mon Oct 8 18:55:20 1990 Richard Stallman (rms at mole.ai.mit.edu) * sysdep.c (sys_open, sys_close, sys_read, sys_write): Don't handle EAGAIN. * process.c (wait_reading_process_input): Handle nread==-1 for O_NDELAY like O_NONBLOCK. * s-vms.h (LINK_CTRL_SHARE): Turn on again. tranle@intellicorp.com found it needed in VMS 5.3. * emacs.c (main): Move VMS declaration of environ outside function. * vmsfns.c (Fdefault_subproc_input_handler): InsCstr -> insert. Sun Oct 7 22:48:33 1990 Richard Stallman (rms at mole.ai.mit.edu) * m-pmax.h (START_FILES): Handle crt0.o in different dir in Ultrix 4.0. * s-sunos4.h (O_NDELAY): Define only if not defined. Sat Oct 6 17:06:42 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * sysdep.c (tabs_safe_p, get_screen_size): renamed `sg' to `tty'. * sysdep.c (init_baud_rate): rearranged code for calculating baud_rate. Fri Oct 5 14:44:40 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * search.c (Freplace_match): used Finsert_buffer_substring instead of place and deleted place. * search.c (place): function removed * process.c (count_active_processes): Deleted; not used. * minibuf.c (read_minibuf): renamed `prefix' argument to `initial'. Mon Oct 1 15:52:35 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * lread.c (Fload): renamed `MISSING-OK' to `NOERROR'. * keyboard.c (describe_map): renamed `keys' to `string'. * keyboard.c `Vauto_save_interval' unrenamed back to `auto-save-interval'. * keymap.c (Fdefine_key, Flookup_key): renamed arguments called `keys' to `key'. Mon Oct 1 13:51:03 1990 Richard Stallman (rms at mole.ai.mit.edu) * sysdep.c (sys_open, sys_close, sys_read, sys_write): Handle EAGAIN like EINTR. Sun Sep 30 16:37:26 1990 Richard Stallman (rms at mole.ai.mit.edu) * insdel.c (gap_left, gap_right): Use bcopy if requested. New config parameters GAP_USE_BCOPY, BCOPY_SAFE_UPWARD, and BCOPY_SAFE_DOWNWARD. * eval.c (find_handler_clause): Bind debug-on-error to nil. (Qdebug_on_error): New variable. (syms_of_eval): Initialize that. * sysdep.c: Include various headers for ptys, for hpux, aix, and sysv. * dispnew.c (preserve_other_columns): Fix args to second bcopy. Sun Sep 30 16:08:16 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * keyboard.c: `auto_save_interval' renamed to `Vauto_save_interval', since it *is* a lisp-accessible variable. * fileio.c (Fdo_auto_save): call record_auto_save so that read_char knows when we've auto-saved. * keyboard.c (record_auto_save): added function to support the new auto-save conditions. * keyboard.c (read_char): use num_input_chars and last_auto_save instead of keystrokes to decide when to autosave. * keyboard.c (keystrokes): variable deleted. Sun Sep 30 10:22:40 1990 Mike Rowan (mtr at spike.ai.mit.edu) * keyboard.c and alloc.c: added malloc warning code from 18.56. * dispnew.c, xdisp.c: (un)hold_window_change no longer exists; added do_pending_window_change from 18.56. * process.[ch]: added the raw_status_low and raw_status_high code from 18.56. Sat Sep 29 00:04:31 1990 Richard Stallman (rms at mole.ai.mit.edu) * alloca.s: Handle ns32000 like ns16000. * m-ns32000.h: New file. * lread.c (Fload): Warn if elc file older than source file. * ymakefile (LIB_X11_LIB): New parameter,default -lX11. (LIBX): Use that. * Makefile (xmakefile): Delete junk.c at the beginning. * hftctl.c: Include termios.h before termio.h. Define TCGETS and TCSETS if nec. Give some forward declarations for the static functions. Reformat in usual GNU style. * m-orion105.h (LOAD_AVE_TYPE, FSCALE): Changed from double and 1.0. * m-delta.h: New file. Fri Sep 28 17:57:46 1990 Richard Stallman (rms at mole.ai.mit.edu) * fns.c (Frequire): Undo certain things on failure, like autoload. Fri Sep 28 12:39:11 1990 Jim Blandy (jimb at pogo.ai.mit.edu) * fileio.c (Fwrite_region): renamed variable `fd' to `desc' and changed argument to open from `1' to `O_WRONLY'. * fileio.c (O_WRONLY): added clause to define this if not already defined. * emacs.c (Fdump_emacs): removed a_name variable. * emacs.c (Fkill_emacs): removed code which asked about modified buffers and running subprocesses. * editfns.c (Fcurrent_time_string): renamed variable `now' to `current_time'. * dispnew.c (update_line): renamed variables `m1' and `m2' to `begmatch' and `endmatch'. * dispnew.c (update_screen): use preempt_count as a limit instead of a counter; count with i instead. * dispnew.c (visible_bell, inverse_video, baud_rate, Vwindow_system): rearranged comments. Thu Sep 27 20:59:54 1990 Richard Stallman (rms at mole.ai.mit.edu) * emacs.c (main) : Set the DISPLAY environment value when both of MAINTAIN_ENVIRONMENT and HAVE_X_WINDOW are defined. * m-convex.h (LIB_STANDARD, LIBS_MACHINE): remove these, they cause an unnecessary C1/C2 dependency. * m-convex.h (LD_SWITCH_MACHINE): use -e__start to specify where crt0.c begins. * m-convex.h (HAVE_SETSID): define; must call setsid when creating an inferior with a different controlling tty. * process.c (create_process): rearrange so that HAVE_SETSID will be seen when not under USG. * m-convex.h (S_IFMT etc): define in case of posix compilation. * m-convex.h (FIRST_PTY_LETTER): do it at runtime. * unexconvex.c (first_pty_letter): routine to locate lowest pty. * unexconvex.c: Rewrite so it can cope with thread-local sections. * sysdep.c (select): Use process_tick and update_tick, not child_changed. Sun Sep 23 14:25:45 1990 Richard Stallman (rms at mole.ai.mit.edu) * keyboard.c (Fsuspend_emacs): Check screen size after resume. Wed Sep 19 18:21:10 1990 Richard Stallman (rms at mole.ai.mit.edu) * editfns.c: Doc fix. Tue Sep 18 09:21:44 1990 Richard Stallman (rms at mole.ai.mit.edu) * window.c (Fsplit_window): Minor cleanup. Mon Sep 17 11:22:45 1990 Richard Stallman (rms at mole.ai.mit.edu) * emacs.c (main) [USG_SHARED_LIBRARIES]: Call brk. Thu Sep 13 15:40:12 1990 Richard Stallman (rms at mole.ai.mit.edu) * floatfns.c (float_error_arg): New variable. (IN_FLOAT): New arg; sets float_error_arg. All uses changed. (float_error): Use that value when signaling error. Tue Sep 11 16:25:53 1990 Richard Stallman (rms at mole.ai.mit.edu) * unexaix.c, m-ibmr2.h, s-aix3-1.h: New files. * ymakefile (allocaobj): New variable. Used in otherobjs. Eliminates assignment of mallocobj using itself. (mallocobj): Handle SYSTEM_MALLOC without HAVE_ALLOCA. (xemacs): Use -nl option if HAVE_SHM. * sysdep.c: Change IBMRTAIX conditionals to AIX. Move hft.h to the top. [IBMR2AIX]: Use termios.h and change macros accordingly. (child_setup_tty): Change IBMRTAIX to AIX. (setpgrp_of_tty): Handle IBMR2AIX. (init_sys_modes): Handle IBMR2AIX. Output special things for AIX. (reset_sys_modes): Output special things for AIX. (hft_init, hft_reset): Conditionals for IBMR2AIX. * process.c: Change IBMRTAIX to AIX controlling time.h. [AIX]: Include sys/pty.h and unistd.h. (wait_reading_process_input): If AIX, handle EBADF differently. (create_process): Handle HAVE_SETSID. Change conditional to AIX. * lisp.h (XPNTR): New definition if HAVE_SHM. (NULL): Undef before defining. * emacs.c (main): If HAVE_SHM, call map_in_data. Use AIX, not IBMRTAIX, for signal conditional. (Fdump_emacs_data): New function if HAVE_SHM. (Fdump_emacs): Don't define if HAVE_SHM. * alloc.c (pure, PUREBEG): If HAVE_SHM, define place for a segment. Mon Sep 3 19:13:05 1990 Mike Rowan (mtr at apple-gunkies) * sysdep.c: added setup_pty from 18.56 * process.c: merged in 18.55->6 changes. Same for process.h * globally replaced: redisplay_preserving_echo_area -> redisplay_preserve_echo_area SetBfp -> set_buffer_internal buffer_flush_undo -> buffer_disable_undo redo_mode_line -> update_mode_line (window.h) Fri Aug 31 14:17:12 1990 Richard Stallman (rms at mole.ai.mit.edu) * data.c (Fmake_local_variable): If var is local when set, make it local now in this buffer. * data.c (Fstring_to_int): Finish eliminating second arg. * data.c (Faset): Require integer as third arg for string. Tue Aug 28 15:10:28 1990 Richard Stallman (rms at mole.ai.mit.edu) * search.c: Doc fix. * screen.h (SCREEN_SCROLL_BOTTOM_VPOS): New macro. * xdisp.c (screen_bottom_vpos): Variable used if just one screen. (redisplay, try_window_id): Set that field in screen. * dispnew.c (scrolling, update_screen): New arg scroll_bottom_vpos. * dispnew.c (scroll_screen_lines): Mark newly empty lines as empty. (scrolling): Give up if any line in current_screen not enabled. Mon Aug 27 21:40:31 1990 Roland McGrath (roland at churchy.ai.mit.edu) * dired.c (Ffile_attributes): Return the device number too (elt 11 of the returned list). Mon Aug 27 12:42:22 1990 Richard Stallman (rms at mole.ai.mit.edu) * sysdep.c (wait_for_kbd_input): Frob waiting_for_input here. * keyboard.c (kbd_buffer_read_command_char): Not here. * sysdep.c (wait_for_kbd_input): Clear process_ef before snarfing process input. * fileio.c (Fdirectory_file_name): On VMS, leave space for log name. * sysdep.c (init_sys_modes): Clear process_ef only the first time. * vmsfns.c (process_exit): Logic of deletion was wrong. (Fspawn_subprocess): Correctly reuse existing struct process_list. Wed Aug 22 12:40:29 1990 Richard Stallman (rms at mole.ai.mit.edu) * m-plexus.h (LD_SWITCH_MACHINE): New macro. Wed Aug 22 11:23:39 1990 Joseph Arceneaux (jla at geech) * xterm.c (XTread_socket): Cleaned up #ifdefs prior to event reading loop. Also handle FIOSNBIO. Sun Aug 19 14:04:15 1990 Joseph Arceneaux (jla at geech) * xterm.c (dumplyphs): Last vestige of MScreenWidth removed. * config.h: MScreenWidth, MScreenHeight definitions removed. Sat Aug 18 21:23:49 1990 Joseph Arceneaux (jla at geech) * scroll.c (do_scrolling): Pass the correct sizes to bcopy. * dispnew.c (make_screen_glyphs): Likewise. Thu Aug 16 11:35:44 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * dispnew.c (scroll_screen_lines, free_screen_glyphs): Only deal with the X components of screen_glyphs if SCREEN_IS_X. free_screen_glyphs now takes screen argument. * window.c (Fnext_window, Fprevious_window): Fixed typo. New behaviour: mini non-nil implies all_screens if global mini screen exists, implies current screen only if not. (Fdisplay_buffer): Simplification of multi-screen code. Wed Aug 15 17:24:51 1990 Richard Stallman (rms at mole.ai.mit.edu) * buffer.c: Doc fix. Wed Aug 15 16:59:46 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * dispnew.c (update_line): Simplification of pixel size code, only done if screen is X. (update_screen): Only set pixel stuff if screen is X. Tue Aug 14 23:35:19 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-targon31.h (NO_REMAP): Definition removed. (SEGMENT_MASK): New macro. Tue Aug 14 12:13:51 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * lread.c (eval-region): Don't set opoint to point, etc. Fnarrow_to_region from BEGV, not b. (eval-buffer): New subr, generalization of eval-current-buffer. (eval-current-buffer): Moved to elisp, in simple.el. * xfns.c (x_y_pos): Nuked. Replaced by pixel_to_char_translation and notice_mouse_movment (dispnew.c, xterm.c). (Fx_point_coordinates): Also nuked. mouse_buffer_offset: New lisp variable. * xterm.c (notice_mouse_movement): Use it in call to pixel_to_char_translation. * screen.h: For non-multiscreen, XSCREEN returns selected_screen, as does WINDOW_SCREEN. * xdisp.c (display_mode_line): Set desired_glyphs->bufp to 0 for mode line. All occurences of struct screen * replaced with SCREEN_PTR. Mon Aug 13 19:09:00 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xmenu.c (list_of_items, list_of_panes): Fixed wrong params to wrong_type_argument. Sun Aug 12 12:32:27 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * dispnew.c (pixel_to_char_translation): New algorithm for finding y. * xfns.c (install_*_scrollbar): No more height, width parameters. Don't block input here. (x_set_*_scrollbar): Block input here. * xterm.c (notice_mouse_motion): Check if the mouse is still in the window. (encode_mouse_button): Don't bother about motion types. Sat Aug 11 19:00:49 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-convex.h (C_SWITCH_MACHINE, LIB_STANDARD, LIBS_MACHINE): (LD_SWITCH_MACHINE): Add definitions for Convex V 4.0. Sat Aug 11 13:09:53 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (Fx_grab_pointer): Call XCreateFontCursor on shape, setting new variable grabbed_cursor. Return Qt if successful, Qnil otherwise. (Fx_ungrab_pointer): free grabbed_cursor if non zero. Return Qnil. Fri Aug 10 09:27:58 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (x_figure_window_size): Don't set pixel sizes until height and width are determined. Wed Aug 8 12:48:41 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (Fx_grab_pointer): New parameter to explicitly ignore keyboard events. * xterm.c (notice_mouse_movement): Use pixel_to_char_translation to get char position and buffer offset. Tue Aug 7 21:35:22 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * sysdep.c [NEED_PTEM_H]: New flag macro says include ptem.h. Tue Aug 7 11:22:38 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * dispextern.h: element bufp of screen_glyphs no longer dependent on X windows. * xdisp.c (display_text_line): Likewise. * xfns.c (Fx_grab_pointer, Fx_ungrab_pointer): New subrs. (x_figure_window_size): Set pixel_width and pixel_height of screen, using font height and width. * xfns.c: Vmouse_grabbed renamed Vmouse_depressed. * xterm.c: Likewise. (construct_mouse_event): Don't check mouse coordinates; this is done by the notice_mouse_motion. Don't grab the mouse here. * dispnew.c (update_line): Set the pix_width and pix_height of the line. This fashion of doing so is temporary. Mon Aug 6 13:57:02 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * dispextern.h: screen_glyphs struct elements bottom_right_x, bottom_right_y changed to pix_width and pix_height. * scroll.c: Likewise. * dispnew.c: Likewise. (update_screen): Set top_left_x, top_left_y for X windows. * xterm.h: Macros PIXEL_{WIDTH,HEIGHT} now use the display structure elements. Sun Aug 5 12:07:16 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (x_window_to_scrollbar): Return Lisp symbol in parameter PART_PTR, rather than string. Declare these symbols. New variable Vscreen_part, indicates which part of the screen the mouse is in. * xterm.c (notice_mouse_motion): Do XQueryPointer first thing. Set Vmouse_event to Qnil. (construct_mouse_event): Don't check if mouse has moved or not. When returning cons, part is now already lisp symbol. (XTread_socket): Set Vmouse_window = Vscreen_part = Qnil when leaving screen, as well as setting x_mouse_x = x_mouse_y = -1. * keyboard.c: Vmouse_window, Vmouse_event declared extern and no longer DEFVARed: they are already delclared in window.c * screen.c (window_from_coordinates): Use Fnext_window, even if MULTI_SCREEN, to obtain the next window. This is an test. Also, new paramater part returns text or modeline symbol. (Flocate_window_from_coordinates): Pass &part to window_from_coordinates. (coordinates_in_window): Don't say modeline if window_height is 1, as this is likely to be the minibuffer. Sat Aug 4 13:43:44 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * screen.c (Fcoordinates_in_window_p): Doc fix. Simplified. (window_from_coordinates): New function. (Flocate_window_from_coordinates): Use it. * keyboard.c (classify_object): New function for dealing with the input object. New symbol, mouse-motion, called here. Call to mouse-motion-handler now takes no parameters. (read_key_sequence): Use the new function. Don't set keybuf[0] to 0. * xterm.c (init_input_symbols): Create all the Lisp symbols returned in the input stream. func_key_syms: New array to hold all symbols for function keys. (x_func_key_to_sym): Use this array. (notice_mouse_movement): New function for dealing with motion events. (XTread_socket): Use it here. Thu Aug 2 22:26:45 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * callproc.c (child_setup): Report error in chdir. Wed Aug 1 12:01:24 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * lisp.h: New macro XFLOATINT. extract_float declared. * floatfns.c (Ffloor): Call floor, not ceil. (extract_float): No longer static. * bytecode.c (Fbyte_code): Correctly handle floats in case Beqlsign. Tue Jul 31 23:25:40 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * keyboard.c (read_key_sequence): When downcasing letters, don't change the value returned in keybuf. (This is an experiment; it might be unpleasant in things such as C-h c, but it is an improvement for M-x global-set-key.) Mon Jul 30 13:46:01 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * eval.c: Doc fix. Sat Jul 28 22:19:32 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * s-iris*.h (SYSTEM_TYPE): Change silicon-graphics-unix to irix. Thu Jul 26 21:49:47 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * indent.c (Fmove_to_column): End-test was off by 1. * abbrev.c (Fexpand_abbrev): Return nil if alloca arg would be neg. Thu Jul 26 14:26:53 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xdisp.c (display_text_line): String to rope copy for inserting arrow text. Wed Jul 25 15:21:04 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xdisp.c (display_mode_line): Check that the name has actually changed before calling x_set_name. * ralloc.c (check_memory_limits): New function. Also check if new memory will be larger than elisp pointer. (r_alloc_sbrk): Call this function. (relocate_blocs_upward, relocate_blocs_downward): Eliminated. (r_alloc_sbrk): Use relocate_some_blocs instead of the eliminated functions. * vm-limit.c (morecore_with_warning): Check if new memory larger than elisp pointer size. Tue Jul 24 21:14:26 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * keyboard.c (save_getcjmp, restore_getcjmp): New functions. (read_char): Use them around Fdo_auto_save. * process.c (read_process_output, exec_sentinel): Use them. * fileio.c (Fdo_auto_save): Run auto-save-hook. Tue Jul 24 11:35:38 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * dispnew.c (safe_bcopy): No longer static. * ralloc.c (relocate_blocs_upward, relocate_blocs_downward): Use safe_bcopy. * mem_limits.c: typedef SIZE. Thu Jul 19 10:18:32 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * fileio.c (Finsert_file_contents): Initialize how_much when exiting main loop. * m/m-mips.h: Added stuff from the 18.56 version. Wed Jul 18 15:00:47 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * indent.c (Fmove_to_column): Set end to ZV. Tue Jul 17 21:31:30 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * editfns.c (init_editfns): Let envvar NAME override full name. * buffer.c (list_buffers_1): Avoid error with list-buffers-directory. Tue Jul 17 14:32:03 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * buffer.c (list_buffers_1): Don't check list-buffers-directory. Mon Jul 16 10:03:10 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xdisp.c (display_text_line): Don't print ellipsis if they're off the left edge. Tue Jul 10 16:01:04 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * s-386-ix.h: Define BROKEN_TIOCGETC. Mon Jul 9 14:33:07 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-pmax.h: Undef LD_SWITCH_MACHINE, change DATA_START and DATA_SEG_BITS. Thu Jul 5 13:38:24 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * s-iris3-6.h (HAVE_GETWD): Define this. (KERNEL_FILE): Change to /unix. (sigsetmask, sigblock, NEED_ERRNO, C_SWITCH_MACHINE): Turn off. (SIGIO): Don't undefine it. (LIBS_MACHINE): Remove -lbsd. * minibuf.c (Fall_completions, do_completion): Treat nil as alist. (Ftry_completion): Likewise. Sun Jul 1 17:21:40 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * sysdep.c: Undefine TIOCGETC if BROKEN_TIOCGETC defined. * s-usg5-3.h, s-xenix.h: Define BROKEN_TIOCGETC. Tue Jun 26 17:15:42 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c (Fopen_network_connection): Minor cleanup. Wed Jun 20 12:45:36 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-sun3.h: Add comments for dealing with 68881. Tue Jun 19 16:58:22 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-ibmps2-aix.h [__GNUC__]: Define LIB_STANDARD and C_DEBUG_SWITCH, and don't define LIBS_MACHINE. (HAVE_WAIT_HEADER): Define this. Also reordered definitions so recently added ones are together. Sun Jun 17 17:56:27 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * insdel.c (insert): Error if buffer would get too long. * fileio.c (Finsert_file_contents): Likewise. Sat Jun 16 23:33:20 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * syntax.c (scan_sexps_forward): Allow Squote inside symbols. Sat Jun 16 17:03:45 1990 Joseph Arceneaux (jla at geech) * window.c (Fscroll_other_window): Don't unbind_to. Keep track of current_buffer and point explicitly. Fri Jun 15 11:32:42 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * term.c: (cursor_to): Only add chars_wasted if not calling hook. (clear_end_of_line_raw): Likewise. (clear_end_of_line): Check that screen is termcap before using chars_wasted. (ins_del_lines): Eliminated local copybuf[]. (calculate_ins_del_char_costs): Now has screen parameter. DCICcost: Change to char_ins_del_costs and defined with SCREEN_WIDTH (screen). DC_ICcost: Changed to char_ins_del_vector. * term.h: DCICcost no longer defined here. DC_ICcost no longer declared here. * dispnew.c: char_ins_del_cost defined here. char_ins_del_vector declared extern here. Thu Jun 14 19:11:11 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * Globally replaced screen_width with macro SCREEN_WIDTH (selected_screen). * dispnew.c (init_display): Don't set SCREEN_WIDTH, etc. from screen_width. (change_window_size): No longer check output_type and set ScreenRows. Mon Jun 11 22:55:37 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * indent.c (Findent_to): Don't fail to return value. (Fmove_to_column, Fcurrent_column): Doc fixes. Wed Jun 6 12:13:30 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * keyboard.c (echo_prompt): Now uses glyphs. echobuf, echobuf_ptr: These variables now glyphs. Tue Jun 5 20:02:44 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * fileio.c (Fdo_auto_save): Use glyphs_to_str_copy to set omessage. * alloc.c (Fgarbage_collect): Ditto. * xdisp.c (message): message_buf set here, realloced if smaller than screen width. message_buf now type GLYF *. New variable message_buf_size holds its size. Use temp_buf for call to doprnt, then use str_to_glyph_cpy to set echo_area_glyphs. * print.c (printchar, strout): Use message_buf_size. Convert to glyfs before assigning chars. (str_to_glyph_cpy, str_to_glyph_ncpy, glyph_to_str_cpy, glyph_to_str_ncpy): New functions. Sun Jun 3 14:00:29 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * keyboard.c (command_loop_1): Clear this_command_key_count here. (Fread_key_sequence): And here. (read_key_sequence): Not here. * dispnew.c (update_screen): Add missing else in handling cursor_in_echo_area. * xdisp.c (redisplay_window): Eliminate lpoint. Alter opoint if point should be changed permanently in the selected window. * window.c (unshow_buffer): Don't set pt in selected window's buffer. * xdisp.c (decode_mode_spec): Don't truncate buffer or file name. * editfns.c (Finsert_buffer_substring): Don't fail to set beg, end. * keyboard.c (command_loop_level): New variable. Used in place of RecurseDepth, but different meaning. (recursive_edit_1): New function. (Frecursive_edit): Call it. * minibuf.c (read_minibuf): Call recursive_edit_1. * xdisp.c (RecurseDepth): Variable deleted. display_minibuffer_message renamed echo_area_display. * print.c: Include dispextern.h. (printchar, strout): Use message_buf. * scroll.c (CalcIDCosts): Dynamically allocate ILcost, etc. (ILcost, DLcost, ILncost, DLncost): Now pointers. (do_scrolling): Use alloca for queue. * term.c (term_init): selected_screen as arg to calculate_costs. (calculate_costs): Dynamically allocate chars_wasted, copybuf, DC_ICcost. Set RPov based on actual width. (chars_wasted, copybuf, DC_ICcost): Now pointers. * xterm.c (x_term_init): Don't set dont_calculate_costs anymore. Sat Jun 2 21:28:24 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * term.c (calculate_ins_del_char_costs, string_cost_one_line): Made static. * dispnew.c: Declare scrolling_1; * scroll.c (CalcIDCosts, CalcIDCosts1, CalcLID): Renamed calculate_ins_del_char_costs, ins_del_costs, and line_ins_del. CalcIDCosts1 and CalcLID also renamed. (calculate_scrolling): Now void. * Global renaming: bf_modified -> MODIFF. CharAt -> CHAR_AT_POSITION. BufferSafe{Floor,Ceiling} -> BUFFER_{FLOOR,CEILING}_OF. SetPoint -> SET_PT. * xterm.c (x_term_init): Don't CalcIDCosts here anymore. Fri Jun 1 16:11:02 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * print.c: Include dispextern.h. (printchar, strout): Use message_buf. * sysdep.c (get_screen_size): Don't use MscreenWidth, MscreenLenght. * term.c: Likewise. * scroll.c (CalcIDCosts, CalcIDCosts1, CalcLID): These now take a screen argument. (CalcIDCosts): Dynamically allocate ILcost, etc. (ILcost, DLcost, ILncost, DLncost): Now pointers. (do_scrolling): Use alloca for queue. * dispnew.c (remake_screen_structures): Allocate message_buf. Don't use MscreenWidth, MscreenLenght. * xdisp.c: bf_cur replaced with current_buffer. Calls to SetBfx deleted. message_buf is now char *. (message): Use SCREEN_WIDTH macro as limit for doprnt. * indent.c (current_column): Detect special case when point == BEGV. * buffer.h (struct buffer_text): Component modified renamed to modiff. All refs changed to macros below. (MODIFF, BUF_MODIFF): New macros. Macro SetBfx removed. Macro SetPoint renamed SET_PT. * fileio.c (Fexpand_file_name): Simplified. Fri Jun 1 14:00:42 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * dired.c: Doc fix. Thu May 31 19:48:25 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * search.c (Fsearch_forward): Docstring fix. Thu May 31 16:43:33 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * dired.c: Comment added. Thu May 31 14:42:02 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * process.c (Fprocess_connection): Return the type of a process object. (syms_of_process): Initialize pty_process and stream_process. Declare Fprocess_type. * process.h New element type to struct Lisp_Process. * syntax.c (scan_sexps_forward): Initialize curlevel->last to -1. Mon May 28 20:06:52 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * fileio.c (Finsert_file_contents): Use new variable how_much to hold read result. Thu May 24 18:47:21 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * lread.c (read_char_exclusive): New subr. Thu May 24 15:56:40 1990 David Lawrence (tale at pogo.ai.mit.edu) * fileio.c (file_executable_p): New function. Wed May 23 01:49:49 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * insdel.c (make_gap): Only set BEG_ADDR if BUFFER_REALLOC was successful. * editfns.c (syms_of_editfns): DEFVAR the new variables. * eval.c (Finteractive_p): Don't skip the first frame if the function was compiled. * print.c (print): Use ... only for conses, and instead of normal print. Tue May 22 17:18:29 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * Renamed meta_flag meta_key. * termopts.h: Comment changes. Sun May 20 01:16:07 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * buffer.h: upcase_table and downcase_table are now Lisp_Objects. * alloc.c (mark_object, gc_sweep): Related changes. * casetab.c: Ditto. Thu May 17 15:02:41 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * minibuf.c (Fall_completions): Protect STRING from gc. Copy ALIST to TAIL to protect it. * paths.h-dist: Doc fix. Thu May 17 12:30:18 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * search.c (Flooking_at, search_buffer): Use new accessors. * indent.c (Fcurrent_column): Likewise. * minibuf.c (read_minibuf): Likewise. * regex.c (re_match_2): Use PTR_CHAR_POS. * editfns.c (Fbuffer_size, Fnarrow_to_region, Fbuffer_substring): (Fbuffer_string, Finsert_buffer_substring): Likewise. (save_restriction_restore): Likewise. * dispnew.c (direct_output_for_insert): Likewise. * fileio.c (Fwrite_region, Finsert_file_contents): Likewise. (Fdo_auto_save): Likewise. * insdel.c (move_gap, gap_left, gap_right, make_gap): Likewise. (InsCStr, del_range, modify_region): Likewise. * process.c (Fprocess_send_region): Likewise. * xdisp.c (try_window, try_window_id, display_text_line): Likewise. (redisplay): Likewise. * buffer.c (list_buffers_1): Likewise. * marker.c (marker_position, Fset_marker, set_marker_restricted): (Fmarker_position): Likewise. * window.c (unshow_buffer, Fset_window_configuration): Likewise. (Fset_window_buffer): Likewise. * editfns.c (save_restriction_restore): Use a macro to alter point. * lread.c (readchar): Use new accessors, and avoid knowing about the text field of a buffer. * window.c (Fpos_visible_in_window_p): Likewise. * buffer.h (struct buffer): Make the syntax table a Lisp object. * alloc.c (mark_buffer): No need to treat it specially. * syntax.c (Fsyntax_table, Fset_syntax_table, Fdescribe_syntax): (Fmodify_syntax_entry): Adjust for this change. * buffer.c (reset_buffer_local_variables): Need not be special. (init_buffer_once): Make this slot a defaulted local variable. * syntax.h: Adjust macros for this change. (Vstandard_syntax_table): Define as macro, in buffer_defaults. * syntax.c (syms_of_syntax): Don't staticpro it here. (Fset_syntax_table): Set the flag in local_var_flags. * buffer.h (struct text): Represent the buffer dimensions with new slots, memory, begv, pt, gpt, zv, z and gap_size. (BEGV, etc.): Use new slots. (CharAt): Likewise. (BufferSafeCeiling, BufferSafeFloor): Use new slots; fix old bugs. (bf_p1, bf_s1, etc.): Old macros deleted. * buffer.c (Fget_buffer_create): Set up memory and new slots. (Fkill_buffer): Likewise. * insdel.c (move_gap, gap_left, gap_right, make_gap): Update new slots. (del_range, InsCStr): Likewise. * fileio.c (Finsert_file_contents): Likewise. * window.c (temp_output_buffer_show): Likewise. * xdisp.c (decode_mode_spec, try_window_id): Likewise. * insdel.c (make_gap): Complete rewrite. Arg is amount of new gap to create. All calls changed. (gap_left): New argument NEWGAP. * buffer.c (Fset_buffer): Check for deleted buffer. (SetBfp): Don't check. (SetBfp, Frename_buffer): Local cleanups. * print.c (PRINTPREPARE): Use Fset_buffer. * buffer.c (SetBfp): Don't bother with selected window or its point. * window.c (Fselect_window): Always set pointm of old window. * editfns.c: Eliminate all use of DEFSIMPLE and DEFPRED. * indent.c, keyboard.c: Ditto. * search.c (skip_chars): Eliminate PointLeft and PointRight. * cmds.c (SelfInsert): Likewise. Wed May 16 20:07:23 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xdisp.c (try_window): No return value. Fix calls to try_window. * Global variable RedoModes is now redraw_mode_line. Sun May 13 19:28:23 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * keymap.c (Fdefine_key, Flookup_key): Local cleanups. * sysdep.c (sys_suspend): Use save_signal_handlers and restore_signal_handlers to save and restore signal state. * indent.c (Findent_to): Merge guts of indentation into here. (position_indentation): Scan with a pointer, for speed. * casefiddle.c (operate_on_word): Just return the other end. (Fupcase_word, Fdowncase_word, Fcapitalize_word): Pass that value to casify_region. * editfns.c (init_editfns): Store system and user names as strings to avoid arbitrary limits. * keymap.c (describe_vector, describe_alist): Make elt_prefix and elt_describer responsible for indentation and newlines. Local cleanups. (describe_command): Do indentation and newline. (describe_map): Add space to end of prefix. * syntax.c (describe_syntax): Do indentation and newline. Sat May 12 18:09:30 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c (create_process) [not USG]: Put subproc in pgrp 0. Thu May 10 19:39:08 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * dispextern.h: new struct screen_glyfs replaces struct display_line. * screen.c: new screen elements current_glyfs, desired_glyfs, and temp_glyfs. * dispnew.c: (make_screen_glyfs, free_screen_glyfs, remake_screen_glyfs): New functions. (make_display_lines, new_display_line, return_display_line): Functions deleted. (change_screen_size, init_display): Use the new functions. (cancel_line, clear_screen_records, get_display_line): Rewritten for new data structures. get_display_line no longer returns anything. (preserve_other_columns, preserve_my_columns): Likewise. (cancel_my_columns, direct_output*): Likewise. (update_screen, update_line, quit_error_check, scrolling): Likewise. (scroll_screen_lines): Likewise. (rotate_vector, safe_bcopy): New subroutines. (line_hash_code, line_draw_cost): Cleaned up. Args are different, and hash computation too. (update_screen): Rearrange buffer-emptying code. * xdisp.c: (display_minibuf_message, redisplay): Rewritten for new structures. (display_text_line, display_mode_line): Likewise. (display_mode_element, display_string): Likewise. (decode_mode_spec): Local cleanups. * scroll.c (do_scrolling): Rewritten for new data structures. * xterm.c (XTflash): Use this new structure. * editfns.c (in_accessible_range): New function. (Fgoto_char, save_restriction_restore): Use it. (save_excursion_save, Fcurrent_time_string): Local cleanups. * process.c (Fprocess_kill_without_query): New arg; new return value. (count_active_processes): Function deleted. * fileio.c (Finsert_file, Fwrite_region): Local cleanups. * fns.c (Fsubstring): Local cleanup. * keyboard.c (echo_prompt, echo_char, echo_dash, echo): New functions. (cancel_echoing): Likewise. (immediate_echo, echoptr): New variables. (command_loop_1, request_echo, get_char, read_key_sequence): (set_waiting_for_input, interrupt_signal): Related changes. (get_char): No more declaration of request_echo. Local cleanups. (this_command_key...): New variables. (Fexecute_extended_command, Fthis_command_keys): Related changes. (init_keyboard, get_char): Likewise. * macros.c (Fstart_kbd_macro): Local cleanup. * minibuf.c (read_minibuf): No more delcaration of Frestore_screen_configuration. * search.c (Fregexp_quote): Simplified. Tue May 8 17:11:00 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * process.c (Fopen_network_stream): Also handle numeric inet addresses. Sun May 6 22:46:36 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * alloca.c: #ifdef __STDC__ rather than X3J11/ Thu May 3 17:07:12 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fileio.c (Fmake_symbolic_link): Delete old file if permitted. Wed May 2 19:07:40 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * data.c (Fstring_to_int): Delete disabled feature of accepting `yes' and `no'. * xdisp.c (redisplay, redisplay_preserving_echo_area): Two functions replace DoDsp. All callers changed. (redisplay, redisplay_window): Eliminate `inhibit_hairy_id'. (redisplay_window): No return value. Local cleanups. * alloc.c (Fmake_marker): Delete `modified' field. * insdel.c (adjust_markers): Likewise. * abbrev.c (Fdefine_mode_abbrev): Clean up error message. Tue May 1 12:13:51 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (Fx_draw_rectangle, Fx_erase_rectangle): Simplified. * xterm.c (x_display_cursor): Don't check s->phys_x when drawing cursor. * undo.c: New version. * undo.h: No longer exists. * alloc.c (Fgarbage_collect): Call truncate_undo_list. (syms_of_alloc): Define vars undo-threshold and undo-high-threshold. * buffer.c (Fget_buffer_create): Set undo_list to t or nil. (Fbuffer_disable_undo, Fbuffer_enable_undo): Likewise. (Fkill_buffer): Likewise. (init_buffer_once): Set up local variable buffer-undo-list. (syms_of_buffer): Likewise. * buffer.h: New element undo_list in struct buffer. * fileio.c (Finsert_file_contents): Store nil in undo_list. * buffer.c: Variable bf_text deleted. (Fkill_buffer, SetBfp): Delete code that worked with it. (SetBfx): Now a macro in buffer.h * editfns.c (Fwiden, Fnarrow_to_region): Related changes. (save_restriction_save, save_restriction_restore): Likewise. (Finsert_buffer_substring): Likewise. * fileio.c (Fdo_auto_save): Likewise. * insdel.c (make_gap): Likewise. * lread.c (readchar): Likewise. * marker.c (Fmarker_position, marker_position): Likewise. (Fset_marker): Likewise. * xdisp.c (DoDsp): Likewise. Mon Apr 30 16:37:19 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * buffer.h: New macro R_ALLOC_SET_BUFFER for declaring all the text pointers of a buffer to the relocating allocator. * buffer.c (Fbury_buffer, SetBfx, SetBfp): Use the macro. * editfns.c (Finsert_buffer_substring): ditto. * fileio.c (Fdo_auto_save): ditto. * insdel.c (make_gap): ditto. * xfns.c (adjust_scrollbars): Don't set bf_cur->text. Thu Apr 26 15:23:23 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * minibuf.c: Declare active_screen struct screen *, not Lisp_Screen *. Thu Apr 19 19:14:31 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xterm.c (XTupdate_end): Only x_display_cursor if s is x_input_screen. Thu Apr 19 13:07:41 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fns.c (Fy_or_n_p): If a C-g comes in and does not quit, quit by hand. * buffer.c (Frename_buffer): Allow renaming to same name it has. Thu Apr 19 02:38:13 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (Fx_open_connection): Attach xrdb to x_current_display. Tue Apr 17 22:40:25 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xterm.c (dumpborder): Now only used for X10. (highlight, unhighlight): New functions for X11. Tue Apr 17 14:55:22 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * cm.c (Wcm_init): Return -2 if screen size not specified. * term.c (term_init): Special error message for that case. Mon Apr 16 13:14:17 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * s-sunos4.h, s-sunos4shr.h (SYSTEM_MALLOC): Define it. Sun Apr 15 03:14:58 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (Fx_get_resource): Concatenate invocation_name before the resource tag. (Fx_create_screen): Use the latest resource id's. Fri Apr 13 14:22:17 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (Fx_get_resource): New subr. (Fx_open_connection): Call x_load_resources. New parameter xrm_string. * xrdb.c: New file for doing resource manager stuff. * xscrollbar.h: New file for scrollbar bitmaps. * xselect.h: New file for the X selection stuff. * ymakefile: Take note of these new files. Tue Apr 10 15:17:41 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xterm.c (x_term_init): Use MAXPATHLEN. Mon Apr 9 18:42:41 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * buffer.c (list_buffers_1): Get filename from list-buffers-directory. Fri Apr 6 21:10:10 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * screen.c (coordinates_in_window): Return -1 if in modeline of window. (Fcoordinates_in_window_p): Return Qt if in modeline of window. (Flocate_window_from_coordinates): Use next_screen_window if MULTI_WINDOW is defined. Thu Apr 5 16:49:02 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xterm.c (construct_mouse_event): Deal with the motion events first. Only grab the mouse when in the scrollbar. Wed Apr 4 16:51:07 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * screen.c (coordinates_in_window): Include mode line as part of window. * xterm.c (XTread_socket): Initialize nbytes to 0. (x_display_cursor): Don't draw if screen not selected. * xdisp.c (DoDsp): Additional checks for screen being visible. Tue Apr 3 19:43:00 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * editfns.c (Fmessage): If there is a global minbuffer screen, raise it before displaying the message. * window.c (window_loop): Parameter SCREENS now affects which screen is scanned for windows. All subrs calling window_loop must pass a Lisp_Object here now. Sun Apr 1 19:55:04 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * window.c (window_loop): Additional parameter mini to control minibuffer selection or not. (Fget_lru_window): (Fget_largest_window): (Fget_buffer_window): (Fdelete_other_windows): (Fdelete_windows_on): (Freplace_buffer_in_windows): Use that parameter. Thu Mar 29 18:58:10 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * screen.c (Fselect_screen): Raise the selected screen. * window.c (Fget_buffer_window): (Fget_largest_window): (Fget_lru_window): New parameter all_screens. (Fdisplay_buffer): Use the new param in Fget_lru_window, Fget_buffer_window, and Fget_largest_window. (Fscroll_other_window): Use new param in Fget_buffer_window. * buffer.c (Fother_buffer): ditto. * xterm.c (x_display_cursor): Always draw the cursor if ON is true. Don't check if the screen S is selected or equal to mouse-screen. * xfns.c (Fx_track_pointer): Don't turn off cursor, just call x_display_cursor. Wed Mar 28 10:55:04 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * data.c (Fmake_local_variable): Give the variable value nil if unbound. * window.c (Fnext_window, Fprevious_window): For MULTI_SCREEN, check if Vglobal_minibuffer_screen is non-nil and maybe call next_screen. * screen.c (Fscreen_selected_window): (Fscreen_root_window): If screen is nil, use selected-screen. Tue Mar 27 15:43:40 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xterm.c (XTread_socket): SET_SCREEN_GARBAGED which returning symbol which causes DoDsp to be invoked. * keyboard.c (read_key_sequence): Don't SET_SCREEN_GARBAGED here. * screen.h: New macro SET_SCREEN_GARBAGED. * xfns.c: * window.c: * sysdep.c: * keyboard.c: * dispnew.c: Use the new macro. Sun Mar 25 17:04:47 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (Fx_own_selection): Only take one argument, string. Sat Mar 24 14:42:31 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (select_visual): Catch bullshit machines whose hardware doesn't support the X server pixel depth by looking at colormap_size. (x_decode_color): Use x_screen_planes to check for color. Fri Mar 23 13:28:33 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xterm.c (x_display_cursor): Try using vertical bar cursor. (clear_cursor): Call x_display_cursor for X11. * xfns.c: Zotzed Vx_pointer_mask. (Fx_track_pointer): Call x_display_cursor if we just wasted the cursor. Break out of loop if no display line. Use mode line cursor if we're there. (x_y_pos): New function. (x_set_font): Dont' set x_font_{width,height}, they are gone. Thu Mar 22 18:42:17 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (Fx_track_pointer): Check that s == selected_screen each time through loop. If event is nil, read mouse position. * keyboard.c (get_char): DoDsp only if selected_screen visible. * xterm.c (XTread_socket): Mark screen as visible only on expose event. * emacs.c (main): Check here for "-d" option and set display_arg. * dispnew.c (init_display): Set Vwindow_system, etc. if display_arg. Wed Mar 21 10:50:47 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * keyboard.c (read_key_sequence): Don't DoDsp if the screen was just unmapped. (command_loop_1): Call the mouse motion handler before calling read_key_sequence. (interrupt_signal): Fixed typo checking screen type. * xfns.c (Fx_track_mouse): Don't crash because of null display line. Don't set obj til call to get_char. * xterm.c (x_term_init): Disable SIGWINCH here. * fns.c (Fmember): New subr. * dispnew.c (init_display): Don't check env variable DISPLAY to set Vwindow_system. Now done in startup.el. * emacs.c: Removed variables xargc, xargv. Tue Mar 20 15:48:17 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (Fx_track_pointer): Go faster. * screen.h: New macro SCREENP. * window.c: (Fminibuffer_window): Rewritten. Mon Mar 19 20:27:04 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * sysdep.c (perror): Control with HAVE_PERROR as well as HPUX. * s-hpux.h (HAVE_PERROR): Define it. Mon Mar 19 12:31:55 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * keyboard.c (command_loop_1): Restructured handling of X event things. (read_key_sequence): Handle new `unmapped-screen' symbol with new Vunmap_screen_hook. * xterm.c (XTread_socket): Return unmapped-screen symbol if the window for UnmapNotify events. * lread.c (Feval_region): GCPRO opoint. Fri Mar 16 14:28:44 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * keyboard.c (command_loop_1): Call mouse-motion handler with argument. Also, don't call undo-boundary. * process.c (create_process): Set the process group for BSD at the same time as for USG. Wed Mar 14 15:40:58 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xterm.c (x_new_selected_screen): Set x_input_screen here. Sun Mar 11 15:48:24 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xterm.c: Vx_mouse_grabbed now Vmouse_grabbed. (XTread_socket): Generate exited-window symbols on LeaveNotify even if screen is focused. * xfns.c: Vx_mouse_grabbed now Vmouse_grabbed. (outline_region): Now static. (Fx_track_pointer): Check x_mouse_screen == s in loop. Sat Mar 10 17:19:38 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xterm.c (encode_mouse_button): Correctly get the button from Motion events. * xfns.c (x11_encode_mouse_button): Nuked. (encode_mouse_button, Fx_mouse_events, Fx_get_mouse_event): #if 0'd. * keyboard.c (get_char): Re-set obj if we've keyboard-translated c. Thu Mar 8 11:47:20 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xterm.c x_focus_screen no longer static. (x_error_handler): Use XDefaultIOError. * screen.c (Ffocus_screen): New subr, removed Fscreen_has_focus. (Fselect_screen): New, optional parameter no_enter. (Frestore_screen_configuration): (Fdelete_screen): Pass second parm Qnil to Fselect_screen. * window.c (Fdisplay_buffer, Fset_window_configuration): Pass second parm Qnil to Fselect_screen. Wed Mar 7 15:45:21 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * screen.c (Fscreen_has_focus): New subr. (Fselect_screen): Use x_focus_on_screen to physically select the screen. Tue Mar 6 11:37:41 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (x_set_mouse_position): Moved to xterm.c. * fileio.c (Fremove_directory): New subr. * screen.c (Frelease_focused_screen): Just call x_unfocus_screen. * xterm.c (XTread_socket): On FocusOut, if s isn't mouse screen, return exited-window. On LeaveNotify, simplify if expression for dumpborder. Reworked FocusIn/FocusOut events. (x_unfocus_screen): Check that screen is x_focus_screen. (x_set_mouse_position): Moved from xfns.c. Use new macro XWarpPointer. * xterm.h: New macro XWarpPointer. * buffer.c: Replaced Fbuffer_flush_undo with Fbuffer_disable_undo. * process.c: Ditto. Mon Mar 5 11:40:33 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xterm.c (XTupdate_end): Use parameter s rather than updating_screen. (XTread_socket): On EnterNotify, don't check s != focus_screen before selecting. On Focus In/Out don't set/reset mouse_screen. Sun Mar 4 12:08:00 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * eval.c If using X windows, include xterm.h. (error): TOTALLY_UNBLOCK_INPUT if using X. * xterm.h: BLOCK_INPUT, UNBLOCK_INPUT: No signal stuff, just inc and decrement x_input_blocked. * xfns.c (adjust_scrollbars): Don't BLOCK_INPUT. (x_set_font): Check result of x_new_font. Call error if nonzero. (x_set_icon_type): Check result of x_*_icon, maybe call error. * screen.c (Fdeiconify_screen): Use x_make_screen_visible rather than x_deiconify_screen. Return screen. (Fmake_screen_visible): Don't raise it here. Return screen. * xterm.c (XTwrite_glyfs): Don't show cursor if screen is global-minibuffer-screen. (x_new_selected_screen): Do dumpborder and check auto-raise here, rather than XEvent switch. (x_deiconify_screen): No longer exists. (x_do_pending_expose, x_clear_cursor): (x_invert_screen, scraplines, stufflines, x_bitmap_icon): (x_text_icon, x_new_font): Don't BLOCK_INPUT. (XTins_del_lines): BLOCK_INPUT here. (XTupdate_end): Don't turn on cursor if minibuffer-screen. (XTread_socket): On MotionNotify, just that screen is selected before processing. (XTtopos): If updating_screen, just set x and y, don't flush. (x_bitmap_icon): (x_text_icon): (x_new_font): Return 1 if failed, don't call error. (x_make_screen_visible): Raise the screen as well. Fri Mar 2 16:03:51 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * screen.c (Frelease_focused_screen): Just check that screen is selected. Wed Feb 28 18:27:29 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * screen.c (Fselect_screen_focused, Frelease_focused_screen): New subrs. * xterm.c (x_focus_on_screen, x_unfocus_screen): New procedures to implement focusing. Wed Feb 28 12:31:30 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * casefiddle.c: Doc fix. Wed Feb 28 11:39:38 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xterm.h: Redefined BLOCK_INPUT and UNBLOCK_INPUT to use sigblock and sigsetmask if available. * xterm.c: Declare BLOCK_INPUT_mask if have SIGIO and FIONREAD. Tue Feb 27 16:59:57 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * minibuf.c (Fread_from_minibuffer): Initialize pos to 0. Sun Feb 25 00:04:44 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * keyboard.c (read_key_sequence): Handle mapped-screen event symbol by calling new hook Vmap_screen_hook. * xterm.c (x_make_screen_invisible): Use the new Xlib function XWidthdrawWindow. (x_iconify_screen): Use the new Xlib function XIconifyWindow. (XTread_socket): Return mapped-screen symbol to signal mapped-screen events. Fri Feb 23 15:10:16 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * keyboard.c (command_loop_1): Check the character for width 1 before doing direct_output_forward, as well as the cursor position on the screen. * xdisp.c (DoDsp): Use redisplay_windows rather than redisplay_all_windows, which was removed. Thu Feb 22 16:33:14 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * unexencap.c: New file, waiting for papers. Thu Feb 22 11:40:06 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * keyboard.c: Removed much debugging stuff. * xterm.c: Removed much debugging stuff. (x_error_handler): For X11, if caught BadAlloc error while converting selection (note new variable x_converting_selection), just set new variable x_selection_alloc_error. * xfns.c: Massive changes for crufty selection processing details. New X atoms: Xatom_clipboard, Xatom_delete, Xatom_insert_selection, Xatom_insert_property, Xatom_pair. Wed Feb 21 15:04:51 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * keyboard.c (kbd_buffer_store_char): Check NULL objects. * xterm.c (XTread_socket): Correctly advance bufp for all KeyPress events. Tue Feb 20 15:04:54 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * keyboard.c (kbd_buffer_get_char): Use KBD_BUFFER_SIZE rather than sizeof kbd_buffer. (read_key_sequence): Upon redraw-display symbol, set screen_garbaged. * xterm.c (XTread_socket): On EnterNotify events, make sure to return mouse event for both scrollbars and windows. Mon Feb 19 18:34:03 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * casefiddle.c (casify_region): Move the new statement. Mon Feb 19 14:42:58 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * casefiddle.c (casify_region): Return if beginning and end same. Sun Feb 18 15:04:53 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * keyboard.c (kbd_buffer_store_char): Use KBD_BUFFER_SIZE rather than sizeof kbd_buffer. * fns.c (Fy_or_n_p): Only accept ints from get_char. Sun Feb 18 12:48:26 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * minibuf.c (Fread_from_minibuffer): New arg POSITION. * unexsunos4.c: New file. Waiting for papers. * s-sunos4shr.h: New file. * emacs.c (main) [RUN_TIME_REMAP]: Call run_time_remap. * ymakefile (LD): Let config file override with LD_CMD. Wed Feb 14 14:57:50 1990 Joseph Arceneaux (jla at albert.ai.mit.edu) * keyboard.c (read_avail_input): pass read_socket_hook KBD_BUFFER_SIZE rather than doing sizeof (buf). * xterm.c (XTread_socket): Set event.type = MotionNotify when entering screen or scrollbar to fake motion event. Tue Feb 13 13:13:29 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * window.c (next_screen, prev_screen): moved to screen.c (Fnext_window): If mini non-nil, count the separate minibuffer screen. * screen.c (Fnext_screen): new subr. Mon Feb 12 21:58:06 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * xdisp.c (display_text_line, try_window, try_window_id, DoDsp): Don't display overlay arrow on more than one line in a window. Mon Feb 12 11:19:48 1990 Joseph Arceneaux (jla at albert.ai.mit.edu) * doprnt.c (doprnt): Expand size of tembuf to 512. Sat Feb 10 19:26:25 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * minibuf.c (Fread_no_blanks_input): Make second arg optional. Fri Feb 9 13:00:56 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * keyboard.c (get_char): Remember to set obj when executing macro. (read_key_sequence): Handle the exited-scrollbar symbol. Compare obj, not read_key_sequence_cmd. * xterm.c (x_make_screen_visible, x_deiconify_screen): Check window-manager variable. (x_make_screen_invisible, x_iconify_screen): Don't use new R4 calls (they crash), do it ourselves. (XTread_socket): Return exited-scrollbar symbol when doing so. Thu Feb 8 17:56:12 1990 Joseph Arceneaux (jla at albert.ai.mit.edu) * xterm.c (construct_mouse_event): Rewritten to do mouse-motion compression. All mouse processing now done here. Also, just use nil and t for x-mouse-grabbed. Record buttons pressed in new variable x_mouse_grabbed. XGrabPointer on button depression. * xfns.c (Fx_horizontal_line): use x_mouse_grabbed. Wed Feb 7 15:42:20 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xdisp.c (DoDsp): If only updating selected screen, but there is a minibuffer screen, update it as well. Tue Feb 6 12:35:12 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (Fx_pixel_width, Fx_pixel_height): New subrs. * xterm.h New components pixel_width, pixel_height, to x_display. * xterm.c (XTread_socket): On configure notify, set these components. * window.c (Fset_window_configuration): Select the screen of the root window if it's not the selected_screen. * minibuf.c (read_minibuf): Remove all the screen selection stuff, now that this is integrated in Fset_window_configuration. Mon Feb 5 10:18:03 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * screen.h: Declare Vglobal_minibuffer_screen. * xdisp.c (DoDsp): Set all_windows if using global-minibuffer-screen. Sat Feb 3 13:00:42 1990 Joseph Arceneaux (jla at geech) * window.c (Fset_window_configuration): Make sure to set window->next to nil for a minibuffer-only screen. * screen.c (make_minibuffer_screen): Set mini_window->next nil. Thu Feb 1 19:00:38 1990 Joseph Arceneaux (jla at albert.ai.mit.edu) * screen.c (make_screen): Set wants_modeline elt to 1. * window.c (Fset_window_configuration): Use screen->root_window as arg to delete_all_subwindows rather than minibuf_window->prev. * minibuf.c (read_minibuf): Don't unwind with Frestore_screen_configuration. Save selected_screen if different than minibuf screen, and re-select it after reading minibuf. * screen.c: #if 0 Fscreen_configuration, Frestore_screen_configuration. Thu Feb 1 02:11:41 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-ibmps2-aix.h: Undef NEED_SIOCTL. (SIGN_EXTEND_CHAR): Cast to `signed char'. Sun Jan 28 15:15:20 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xfns.c (Fx_track_pointer): rewrote this to loop while there are mouse events. * xterm.c (XTread_socket): Return left-window-event symbol upon LeaveNotify. * keyboard.c (read_key_sequence): Handle this symbol. Sat Jan 27 09:57:10 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * xterm.c (x_display_cursor): Use dumpglyfs with SPACEGLYF for cursor, as `XFillRectaogle's kill HP-BSD server. * xterm.h: Added nontext_cursor, modeline_cursor to x_display structure. * xfns.c (x_set_mouse_color, Fx_track_pointer): Changes to use nontext_cursor. Thu Jan 25 13:09:27 1990 Joseph Arceneaux (jla at albert.ai.mit.edu) * xterm.h: Changed the face structure for X11 to handle GCs and pixmaps. * xterm.c (XTread_socket): Return a motion event when mouse enters scrollbar or window. (x_make_screen_invisible): Use the new X11R4 function XWithdrawWindow. (x_iconify_screen): Use the X11R4 function XIconfifyWindow. (dumpglyfs): Use the new face structure. * xfns.c (install_vertical_scrollbar, install_horizontal_scrollbar): Accept EnterNotify events. Use XMapSubwindows rather than mapping each one. (Fx_set_face_font): New subr for X11 to set face GC. Thu Jan 25 00:58:19 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * dispnew.c (direct_output_for_insert): Give up if buf in 2 windows. * keyboard.c (command_loop_1): Dumb bugs disabled special fast display for character motion. * xdisp.c (DoDsp): For cursor motion within line, hpos result from compute_motion is relative to window. Wed Jan 24 20:08:08 1990 Richard Stallman (rms at albert.ai.mit.edu) * eval.c (Fmacroexpand): Handle explicit macros ((macro ...) ...). Thu Jan 18 10:27:09 1990 Joseph Arceneaux (jla at spiff) * undo.c (Fundo_more): Fixed typo. Tue Jan 16 20:20:48 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * xdisp.c (display_text_line): When checking HPOS for continuation line, compensate for w->left. Mon Jan 15 19:46:59 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * dispnew.c [no FIONREAD]: Undefine SIGIO. * buffer.c (SetBfp): Use XTYPE to test for no selected window yet. * editfns.c, dispnew.c, fileio.c, process.c, sysdep.c, xterm.c: Uniformly let NEED_TIME_H control use of time.h instead of sys/time.h. * xterm.h (TOTALLY_UNBLOCK_INPUT, UNBLOCK_INPUT): Don't use SIGIO if no FIONREAD. Mon Jan 15 18:08:16 1990 Joseph Arceneaux (jla at spiff) * xfns.c (x_set_mouse_color): Set non-text pointer shape with new variable Vx_nontext_pointer_shape. * keyboard.c: More checks for evil bug which trashes kbd_*_ptr. * m/hp300bsd.h: Try using BSD load average stuff. Thu Jan 11 15:52:11 1990 Joseph Arceneaux (jla at spiff) * xfns.c (x_draw_pixmap): New routine. Wed Jan 10 21:55:25 1990 Jim Kingdon (kingdon at pogo) * m/hp300bsd.h: New file Mon Jan 8 13:12:37 1990 Joseph Arceneaux (jla at spiff) * xfns.c (Fx_window_id): New subr. * screen.c (make_screen): Set wants_modeline elt to mini_p. If mini_p 0, then set root_window->next to nil. Mon Jan 8 10:56:42 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * editfns.c (Fchar_after): Set N after coercing marker. Sat Jan 6 16:18:50 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * buffer.c (Fkill_all_local_variables): Force mode line update. Fri Jan 5 16:50:35 1990 Joseph Arceneaux (jla at spiff) * insdel.c: Declare Vfirst_change_function. * keyboard.c (read_key_sequence): Function keys are now lisp symbols. (kbd_buffer_store_char): Abort if store pointer past buffer. Temproarry; This shouldn't be able to happen. (read_key_sequence): #ifdef HAVE_X_WINDOWS code which handles complex objects. (command_loop_1): Check not termcap screen before processing non-char input. (kbd_{store,fetch}_char): More debugging checks. * screen.c (make_screen): Set root_window height to 9 if mini_p. (make_minibuffer_screen): Set the mini window's next, prev, and screen elements. * xterm.c (x_func_key_to_sym): New function, uses new variable func_key_syms. (XTread_socket): Use this in KeyPress event for function keys. (XTflash): Draw solid rectangle in middle of screen. (x_set_offset): Set the size hints as well when doing this. (XTflash): Just dumpglyfs instead of redrawing the screen after flashing the rectangle. * lread.c: (syms_of_lread): defsubr Fread_event. Thu Jan 4 18:42:08 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * buffer.h, buffer.c (Vfirst_change_function): New Lisp variable. * insdel.c (signal_before_change): Call that function. * keyboard.c (cmd_error): Don't crash if TAIL is nil. Sun Dec 31 17:17:13 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * minibuf.c: Doc fixes. Thu Dec 28 18:12:08 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c (create_process): Unhold SIGCHLD in the child. Wed Dec 27 19:12:50 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c (create_process): Treat HPUX like BSD for sigsetmask. Mon Dec 25 00:10:57 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fns.c (Fmapconcat): Gcpro SEP around mapcar1. Sat Dec 23 13:45:19 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * dispnew.c (get_display_line): Don't touch X data if not using X. * syntax.c (Fscan_sexps): Fix fatal documentation typo. * lread.c: Include commands.h. * xterm.c (construct_mouse_event): Delete unreached return at end. (x_wm_set_size_hint): #if 0 some broken code. * cmds.c (SelfInsert): Set HAIRY if have before or after change hooks. * editfns.c (Fsubst_char_in_region, Ftranslate_region): Call signal_after_change for chars changed. * undo.c (Fundo_more): When undoing Uchange, do signal_after_change. * casefiddle.c (casify_region): Do modify_region before the change, signal_after_change afterward. * insdel.c (prepare_to_modify_buffer): Call signal_before_change. (del_range, InsCStr): Call signal_after_change. (signal_after_change, signal_before_change): New functions. Wed Dec 20 06:50:13 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * dispnew.c (init_display) [VMS]: Downcase terminal type. Sun Dec 17 19:31:52 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * sysdep.c: Use NEED_SIOCTL to control use of sioctl.h. * m/m-mips.h, m/m-iris4d.h: Define that. * m/m-ibmps2-aix.h (NEED_SIOCTL, HAVE_UNION_WAIT, HAVE_PTYS): Define. (HAVE_SYSVIPC, HAVE_SOCKETS, X_DEFAULT_FONT): Define. (sigsetmask): #undef this. Fri Dec 15 13:13:36 1989 Joseph Arceoeaux (jla at spiff) * lread.c (Fread_char): Catch error if read non-char. (Fread_event): New subr. Return any input object. Thu Dec 14 12:53:30 1989 Joseph Arceneaux (jla at spiff) * xfns.c: New variable Vx_no_window_manager. (Fx_track_pointer): If bufp < 0, abort. * xterm.c (XTread_socket): When leaving window, set x_mouse_x and x_mouse_y to -1. Wed Dec 13 10:48:36 1989 Joseph Arceneaux (jla at spiff) * xterm.c (XTread_socket): On ConfigureNotify events, return "redraw-screen" symbol. (dumpborder): Only do border stuff if x-no-window-manager non nil. Also check if there is a tracking rectangle. (XTupdate_begin): If there is a mouse tracking rectangle, erase it. * keyboard.c (read_key_sequence): Return -2 for symbols. (command_loop_1): DoDsp when 'redraw-screen arrives as input. For mouse events, call Fexecute_mouse_event with read_key_sequence_cmd instead of Vmouse_event. Fri Dec 8 08:34:22 1989 Joseph Arceneaux (jla at spiff) * process.c (create_process): For not USG, properly set the process group. Thu Dec 7 15:02:44 1989 Joseph Arceneaux (jla at spiff) * term.c (topos): Under X Windows, abort if topos_hook not correct. Temporary. * xfns.c (Fx_horizontal_line): New subr. Tue Dec 5 11:35:21 1989 Joseph Arceneaux (jla at spiff) * keyboard.c (Fexecute_mouse_event): Don't set Vmouse_window here for X11. * xterm.c (construct_mouse_event): Vx_mouse_grabbed now indicates which keys are depressed. (construct_mouse_event): Set Vmouse_window here. Mon Dec 4 13:43:12 1989 Joseph Arceneaux (jla at spiff) * screen.c (coordinates_in_window): New function. (Fcoordinates_in_window_p): Rewritten to use above. * dispextern.h: New element bufp for display_line structure when using X windows. * xdisp.c (redisplay_window): Set this to the position in the buffer of the first char in this display line. * dispnew.c (get_display_line): Set this to -1 here. Sun Dec 3 14:05:47 1989 Joseph Arceneaux (jla at spiff) * alloc: Upped NSTATICS from 200 to 256. * xterm.c (XTread_socket): Report MotionNotify events only if mouse has changed character position. Call x_read_mouse_position. Set Vmouse_event here. * xfns.c (x_read_mouse_position): Set new global variables x_mouse_x and x_mouse_y. * keyboard.c: Vignore_mouse_events: New variable. * syntax.c (Fscan_sexps): Doc change. * lread.c (Fread_char): Return only chars. If new variable Vignore_mouse_events non nil, execute any mouse events which appear. Fri Dec 1 09:28:23 1989 Joseph Arceneaux (jla at spiff) * xfns.c (Fx_track_pointer): Draw half-sized rectangles for '\n'. (x_rectangle): Draw half-size if negative argument. * xterm.c (XTread_socket): abort if garbage collecting when doing mouse events. * ymakefile: #define FLOATSUP if LISP_FLOAT_TYPE defined. * emacs.c (main): If BSD, set pgrp to pid. Thu Nov 30 10:02:54 1989 Joseph Arceneaux (jla at spiff) * callint.c (Fcall_interactively): For case 'e', set varies[i] to avoid entering in the command history. * xterm.c: Removed the function x_indicate_pointer_char. (XTread_socket): When leaving window, erase mouse tracking box if it exists. * xfns.c (Fx_track_pointer): New function, does what x_indicate_pointer_char used to. (x_read_mouse_position): Subtract internal_border_width. * screen.c: No rubber-banding function for X11. * window.c (Fmove_to_window_line): Document string fix. Wed Nov 29 17:17:04 1989 Joseph Arceneaux (jla at spiff) * lread.c (Fread_char): Return a Lisp_Object (directly from get_char). * keyboard.c: * xterm.c: Function keys now arrive as cons cells. Mon Nov 27 13:21:39 1989 Joseph Arceneaux (jla at spiff) * keyboard.c (read_key_sequence): Handle Lisp_Symbols on input (function keys). Also, handle these and mouse events with prefixes (by ignoring the prefixes for now). * xfns.c New variable Vx_mouse_grabbed. * xterm.c (construct_mouse_event): Use it. (XTread_socket): Return Lisp_Symbol for function key. * buffer.c (reset_buffer_local_variables): Set function_key_map to Qnil. Fri Nov 24 17:45:38 1989 Joseph Arceneaux (jla at spiff) * buffer.h: Per-buffer function key maps. * keyboard.c (read_avail_input): Convert chars to Lisp_Objects in case of stdin. Wed Nov 22 13:39:14 1989 Joseph Arceneaux (jla at spiff) * keyboard.c (read_key_sequence): Check type of object returned from get_char. Handle mouse events (set Vmouse_event) and function keys. (get_char_menu_prompt): Return a Lisp_Object. (Fexecute_mouse_event): No longer set Vmouse_event. Vmouse_window set here. * xterm.c (XTread_socket): KeyPress events now return Lisp_Objects, as do ButtonPress events. (construct_mouse_event): New function. (encode_mouse_button): New function. Tue Nov 21 14:49:14 1989 Joseph Arceneaux (jla at spiff) * keyboard.c (kbd_buffer_store_char, kbd_buffer_get_char): Store and get Lisp_Objects. (get_char): Use those Lisp_Objects. * fileio.c (Fread_filename_internal): If exactly complete, but string was modified, return string. * minibuf.c (temp_minibuf_message): Pass correct arguments to Fsit_for. Sat Nov 18 23:07:32 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * s-386-ix.h: New file. Fri Nov 17 12:11:11 1989 Joseph Arceneaux (jla at spiff) * xterm.c (dump_rectangle): Flush the X queue. Thu Nov 16 16:35:47 1989 Joseph Arceneaux (jla at spiff) * xmenu.c (xmenu_show): Use ButtonReleaseMask instead of ButtonRelease. * fileio.c (Fmake_directory): New subr. Thu Nov 16 00:53:40 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * config.h-dist (C_SWITCH_SITE, LD_SWITCH_SITE): Mention these. (HAVE_X11): Renamed from X11 and defined by default. It shoukld have no effect when not using X. Tue Nov 14 09:44:29 1989 Joseph Arceneaux (jla at spiff) * xfns.c (Fx_get_selection, x_selection_arrival): use &event instead of event. (x_selection_arrival): For incremental selections, loop on XGetWindowProperty if one is not enough. Mon Nov 13 12:07:16 1989 Joseph Arceneaux (jla at spiff) * ymakefile: Just link if ../oldXMenu/libXMenu11.a already exists. Thu Nov 9 11:10:32 1989 Joseph Arceneaux (jla at spiff) * m/m-sparc.h: If __GNUC__ use "-O", else "-O2" Wed Nov 8 15:49:28 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * search.c (Fstore_match_data): A marker pointing nowhere, treat as 0. Wed Nov 8 14:50:43 1989 Joseph Arceneaux (jla at spiff) * search.c (Fmatch_data): fixed typo. * insdel.c (make_gap): Use BUFFER_REALLOC instead of realloc. * buffer.c (Fget_buffer_create): Use new define BUFFER_ALLOC in place of malloc, and set b->data. (Fkill_buffer): Use BUFFER_FREE on b->data, rather than malloc on b->p1 + 1. * buffer.h: New element data in buffer_text structure. New define for it, bf_data. Wed Nov 8 14:28:31 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * marker.c (Fset_marker): Don't force POS into visible range. * window.c (set_marker_restricted): New function does what Fset_marker did. All calls in this file now use the new function. Tue Nov 7 09:08:26 1989 Joseph Arceneaux (jla at spiff) * buffer.h: Defines for allocating buffer variables. * ralloc.c: Completely rewritten. * alloc.c (xmalloc, xrealloc): Return 0 immediately for requests of 0 size. Mon Nov 6 02:00:40 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * search.c (Flooking_at, Fstring_match, search_buffer): Record in search_regs_from_string whether matching against a string. (Fmatch_data): Save data as integers if from a string. * s-umips.h: Now include either s-usg5-2-2.h or s-bsd4-3.h and then override as needed. * m-mips.h: System dependence deleted. LD_SWITCH_MACHINE remains w/ options needed on all systems. * m-pmax.h: A little of that (LIBS_DEBUG) moved here. No need to undef LIBS_MACHINE. * fns.c (Fload_average): FIXUP_KERNEL_SYMBOL_ADDR is now general hook. * s-umips.h: Define it. * sysdep.c: Handle BROKEN_FIONREAD. Fri Nov 3 10:52:16 1989 Joseph Arceneaux (jla at spiff) * config.h-dist: Mention LISP_FLOAT_TYPE, GNU_MALLOC, and REL_ALLOC. * s/s-umips.h: New file. Fri Nov 3 02:17:54 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c (Fopen_network_stream): Handle EINTR in connect. Describe errno in err msg if connect fails. Thu Nov 2 15:35:44 1989 Joseph Arceneaux (jla at spiff) * vm-limit.c: New file. * ralloc.c: New file. * ymakefile: Take vm-limit.o into account. Thu Nov 2 12:27:41 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * alloc.c (staticvec): Make this a simple vector of pointers rather than an alias for a vector of chars. Wed Nov 1 11:44:30 1989 Joseph Arceneaux (jla at spiff) * window.c: Moved some functions (save_window_save, replace_window, unshow_buffer) around. * search.c: Moved function place. * lread.c: Moved function read_escape. * unexec.c: Declarations for make_hdr, copy_text_and_data, copy_sym. Declare mark_x as static void. * dispextern.h: removed declaration of new_display_line. * emacs.c: Do malloc_init if GNU_MALLOC. * gmalloc.c: (malloc_init): New function. * xfns.c (x_rectangle, Fx_draw_rectangle, Fx_erase_rectangle, outline_region, Fx_countour_region, Fx_uncontour_region): New subroutines for drawing rectangles and things. (Fx_point_coordinates): New subr. Tue Oct 31 11:43:36 1989 Joseph Arceneaux (jla at spiff) * All .c and .h files: New copyright header. Mon Oct 30 17:55:32 1989 Joseph Arceneaux (jla at spiff) * gmalloc.c: New GNU malloc. * emacs.c (main, Fdump_emacs): No malloc init if GNU_MALLOC. * ymakefile: Check if GNU_MALLOC defined. Fri Oct 27 10:25:22 1989 Joseph Arceneaux (jla at spiff) * xfns.c (Fx_pointer_char): New subr. * xterm.c (x_indicate_pointer): New procedure. * alloc.c (Fmake_vector_from_list, make_vector_from_list): New subrs. Thu Oct 26 20:24:55 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * xterm.c (x_term_init): Negate arg to fcntl F_SETOWN if F_SETOWN_SOCK_NEG. * keyboard.c (Fset_input_mode) [NO_SOCK_SIGIO]: No interrupt input if using a socket. * m-sequent.h: Define NO_SOCK_SIGIO, F_SETOWN_SOCK_NEG, MAIL_USE_FLOCK. Thu Oct 26 11:00:01 1989 Joseph Arceneaux (jla at spiff) * xterm.c (x_handle_error_gracefully): Make sure to completely release input before returning, using: * xterm.h New macro TOTALLY_UNBLOCK_INPUT. * xmenu.c (xmenu_quit): No longer use this error_handler; use default one. Wed Oct 25 10:17:05 1989 Joseph Arceneaux (jla at spiff) * config.h-dist: Comment fix. Tue Oct 24 10:25:42 1989 Joseph Arceneaux (jla at spiff) * xfns.c (Fx_draw_lines, translate_vectors): New functions. Sat Oct 21 02:31:58 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * search.c (search_buffer): Always find null string. * window.c (window_loop): For UNSHOW_BUFFER, don't Fset_buffer unless window is the selected one. Fri Oct 20 19:00:42 1989 Joseph Arceneaux (jla at spiff) * xdisp.c (display_minibuf_message): Choose minibuf screen first of all. Return if not visible. Thu Oct 19 16:27:55 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xterm.c (x_handle_error_gracefully): New procedure to handle non-fatal X errors. (x_error_handler): Use it. (acceptable_x_error_p): New macro. * xfns.c (Fx_own_selection): Use second parameter SCREEN. * xdisp.c: (message, message1): No longer displays messages when using X but not yet mapped. Wed Oct 18 17:55:37 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-pyramid.h (NO_ARG_ARRAY): Define if using GCC. Tue Oct 17 03:08:08 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * vmsfns.c (process_command_input): Call clear_waiting_for_input. Sat Oct 14 00:09:08 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * syntax.c (scan_words): If words_include_escapes not 0, treat Sescape and Scharquote like Sword. (syms_of_syntax): Define Lisp variable. * process.c (wait_reading_process_input): Get rid of kbd_count. Use detect_input_pending. * sysdep.c (select, read_input_waiting): Likewise. (read_input_waiting): Don't read directly into kbd_buffer; use kbd_buffer_store_char. * keyboard.c: Don't define kbd_count. * keyboard.c (read_key_sequence): Reject the prefix char generated for a Meta char, if it finds a non-prefix definition. Fri Oct 13 20:05:12 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c (wait_reading_process_input): READ_KBD==2 means wait until have mouse input. * xfns.c (Fx_get_mouse_event): Use that. * xterm.c (mouse_event_pending_p): New subroutine. Fri Oct 13 19:23:51 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xfns.c (x_selection_arrival): (x_send_incremental): (x_answer_selection_request): New procedures for incremental selection transfer. Thu Oct 12 20:06:54 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * lread.c (complete_filename_p): New function which replaces absolute_filename_p. This one doesn't consider "~" valid. Thu Oct 12 02:41:15 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * buffer.c: Comment fix. Wed Oct 11 15:37:04 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xfns.c: (Fx_open_connection) New X atoms Xatom_incremental and Xatom_multiple. * xterm.h: New macros MAX_SELECTION and SELECTION_LENGTH. * process.c (child_sig): Check pid <= 0 in case WNOHANG not defined. Wed Oct 11 14:55:23 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * termcap.c (tgetent, gobble_line): Always store null at end of bfr. Allocate one extra byte at end to ensure space. Clean up order of arithmetic when updating ptrs into buffer after xrealloc. Tue Oct 10 15:10:03 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xfns.c (Fx_open_connection): Make all X Atoms here. * xterm.c: (x_iconify_screen): (x_iconify_screen): Cleaned up this code. (x_term_init): Removed warpmouseondeiconify stuff. Mon Oct 9 09:52:06 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xdisp.c (DoDsp): Make sure to call unhold_window_change after before all returns. * minibuf.c (read_minibuf): Changed set_mouse_position to Fset_mouse_position. * xterm.c (XTread_socket): dumprectangle (whole screen) instead of DoDsp in ConfigureNotify event. (x_wm_set_size_hint): New calculations for size_hints. * screen.c (Fset_mouse_position): No more function set_mouse_position; use x_set_mouse_position directly. * xfns.c (x_set_cursor_color): Really decode Vx_cusor_fore_pixel if set. Define new cursor before freeing old. This may eliminate a server bug on the Sony. Also check for invisible cursors. (x_set_mouse_color): Check for invisible pointers. (x_resize_scrollbars): BLOCK_INPUT whilst doing operations. (adjust_scrollbars): Likewise. Tue Oct 3 12:30:31 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m/m-hp9000s800.h (XUNMARK): Delete definition. (S_IFLNK): Do not undef it. Tue Oct 3 10:38:42 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * dispnew.c (get_display_line): If screen not visible, abort. Mon Oct 2 23:48:12 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xterm.c (x_make_screen_visible): Set s->visible, unset s->iconified for HAVE_X11. Fri Sep 29 15:53:39 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xterm.c (XTread_socket): Check screen s before proceeding for MapNotify event. * xterm.c: No longer sets the variable mouse_down_timestamp. * xfns.c: (Fx_get_mouse_event) mouse_timestamp (formerly mouse_down_timestamp) set here. Also, mask out upper 9 bits before doing XSET. Thu Sep 28 10:59:29 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xfns.c (Fx_geometry): Kludge for the case of position `-0'. (Fx_get_mouse_event): Also return the time stamp as last list elt. (Fx_color_display_p): (Fx_defined_color): (x_decode_color): (defined_color): Eliminate screen argument. (Fx_create_screen): No more ColorMap component to display.x. * xterm.h: Likewise. Wed Sep 27 17:51:40 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xfns.c (Fx_own_selection): (Fx_get_selection): (x_disown_selection): new funcs, which use new variables Vx_selection_value, x_begin_selection_own, mouse_down_timestamp, requestor_time, requestor_window, property_name, and x_begin_selection_own. * xterm.c (XTread_socket): Only do stuff if s for FocusOut under X11. SelectionClear: SelectionRequest: SelectionNotify: New events to handle the selection inter-client communication mechanism. ButtonPress: Set mouse_down_timestamp. Tue Sep 26 17:21:12 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xfns.c: New variable Vx_cursor_fore_pixel. Sat Sep 23 03:59:31 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * lread.c (openp): Don't ! the result of `access'. Fri Sep 22 00:29:05 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fileio.c (Fread_file_name_internal): Try to work properly if dirs are specified using environment vars. Preserve use of vars. Thu Sep 21 02:55:50 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fileio.c: Comment fix. Mon Sep 18 11:26:55 1989 Joseph Arceneaux (jla at spiff) * xfns.c (Fx_get_cut_buffer): XFree the data returned by XFetchBytes. Sat Sep 16 01:49:45 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fileio.c (Fwrite_region): Reinstall #if 0 around fstat. Tue Sep 12 14:28:43 1989 Joseph Arceneaux (jla at spiff) * xfns.c (defined_color): New function to test if a color is currently defined. (x_decode_color): Use defined_color. (Fx_defined_color): New subr. (select_visual): Select the appropriate X11 Visual. (Fx_open_connection): Use select_visual. screen_visual now global and used when making emacs windows. (Fx_color_display_p): New subr. Mon Sep 11 16:03:04 1989 Joseph Arceneaux (jla at spiff) * fileio.c (Fwrite_region): fixed typo. * keyboard.c (Fdiscard_input): fixed typo. * window.c (Fnext_window): fixed typos. * alloc.c (xmalloc, xrealloc): hold_window_changes whilst doing the associated operations. * dispnew.c (init_display): (Fsleep_for, Fsit_for): * process.c (Faccept_process_output): * keyboard.c ({clear,set}_waiting_for_input): (quit_throw_to_get_char, get_char): * xdisp.c (DoDsp, message, message1): Undid changes of Aug. 23 (see below); accept window changes most of the time. Thu Sep 7 02:52:33 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * keyboard.c: Eliminate kbd_count, and use two pointers, kbd_fetch_ptr and kbd_store_ptr. Assume buffer is empty when they are equal. This should eliminate timing error. (kbd_buffer_store_char): Update kbd_store_ptr when storing. Don't ever fill the entire buffer. (kbd_buffer_get_char): Update kbd_fetch_ptr when fetching. (stuff_buffered_input): Likewise. (get_input_pending): Compare the two pointers. * fileio.c (Fwrite_region): Reenable using fstat rather than stat to get the modtime of the file just written, except on VMS and APOLLO. Tue Sep 5 19:01:49 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacs.c, doc.c, filelock.c: Move Emacs header includes after system header includes, and #undef NULL in between. Wed Aug 30 17:12:20 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c [SYSV_PTYS]: If `titan', include some other files. Tue Aug 29 15:48:22 1989 Joseph Arceneaux (jla at spiff) * fileio.c: read-file-name replaced with new version, formerly called new-read-file-name. Sat Aug 26 01:03:03 1989 Richard Stallman (rms at apple-gunkies.ai.mit.edu) * window.c (Fscroll_other_window): Use save-excursion (in effect) to save and restore current buffer and point. (window_scroll): If selected window's buffer isn't current, make it current, using save-excursion to go back. Thu Aug 24 20:20:55 1989 Richard Stallman (rms at apple-gunkies.ai.mit.edu) * Use two variables to convey reason for synch process death, to avoid consing in signal handler. They are synch_process_death and synch_process_retcode. * callproc.c (Fcall_process): Use both variables. * process.c (child_sig): Set both variables. Thu Aug 24 17:27:53 1989 Joseph Arceneaux (jla at spiff) * xterm.c (x_wm_set_size_hint): Use new ICCCM values for size_hints. Thu Aug 24 16:49:11 1989 Richard Stallman (rms at apple-gunkies.ai.mit.edu) * buffer.c: Doc fix. Thu Aug 24 12:12:09 1989 Joseph Arceneaux (jla at spiff) * xfns.c (Fx_create_screen): X11 part. Set height and width to 0 before calling change_screen_size. * buffer.c (kill-all-local-variables): Changed doc string. Wed Aug 23 17:35:48 1989 Richard Stallman (rms at apple-gunkies.ai.mit.edu) * dispnew.c (init_display): Call hold_window_change. (Fsleep_for, Fsit_for): Temporarily unhold, while waiting. * process.c (Faccept_process_output): Likewise. * keyboard.c ({clear,set}_waiting_for_input): Temporarily unhold. (quit_throw_to_get_char, get_char): Rehold. * xdisp.c (DoDsp, message, message1): Unhold and rehold momentarily before any real work. * Makefile (CPP): Use $(CC). Tue Aug 22 12:05:09 1989 Joseph Arceneaux (jla at spiff) * xfns.c (x_set_mouse_color): Use new variables Vx_pointer_mask, Vx_pointer_shape. Mon Aug 21 23:47:00 1989 Richard Stallman (rms at apple-gunkies.ai.mit.edu) * alloc.c (malloc_warning): Do nothing if ignore_warnings. (init_alloc_once): Set ignore_warnings while initializing allocation. * buffer.c: Doc fix. Mon Aug 21 17:47:56 1989 Joseph Arceneaux (jla at spiff) * xterm.c (x_calc_absolute_position): New function to calculate positive screen position. (x_set_position): Use it. (x_reset_cursor): No longer exists. * xfns.c (x_set_mouse_color): Reset the cursor even if there's no X window. (x_figure_window_size): Use x_calc_absolute_position. (x_set_mouse_color): Rewrote this function. Always set cursor and its color. If the window exists, then attach the cursor to it. No longer uses x_reset_cursor. (x_create_window): (x_set_background): (x_set_foreground): Use x_set_mouse_color instead of x_reset_cursor. Fri Aug 18 17:00:47 1989 Richard Stallman (rms at hobbes.ai.mit.edu) * vmsfns.c: Define PRV$V_... syms if prvdef.h does not. Fri Aug 18 15:32:13 1989 Joseph Arceneaux (jla at spiff) * xfns.c (Fx_geometry): New subr. (x_figure_window_size): Don't worry about "geometry" here anymore; now done in x-win.el. (x_icon): Look in parms for iconic-startup rather than in variable. Wed Aug 16 16:27:40 1989 Joseph Arceneaux (jla at spiff) * xfns.c (x_set_*_scrollbar): Don't destroy a scrollbar if it doesn't exist. Also set scrollbar size only if actually creating one. (x_set_name): Don't do anything if the X window doesn't exist. Set the icon name as well. (x_window): Set the class hints for the window. Wed Aug 16 14:47:10 1989 Richard Stallman (rms at hobbes.ai.mit.edu) * lread.c (Fload): Fix unterminated comment. * scroll.c (scrolling_max_lines_saved): Replace fixed threshold of 20 with 1/4 of average length of lines. Sun Aug 13 18:27:40 1989 Joseph Arceneaux (jla at spiff) * ymakefile: Do ${make} for oldXMenu. Sun Aug 13 17:24:12 1989 Richard Stallman (rms at hobbes.ai.mit.edu) * eval.c: Doc fix. Sat Aug 12 13:18:00 1989 Richard Stallman (rms at hobbes.ai.mit.edu) * emacs.c (main): Check for failure opening -t device. Fatal error if terminal isn't a real terminal. * window.c (Fscroll_other_window): Let Vother_window_scroll_buffer specify a buffer to scroll. Fri Aug 11 21:24:19 1989 Richard Stallman (rms at hobbes.ai.mit.edu) * dispnew.c: Handle BROKEN_FIONREAD as in other files. Wed Aug 9 12:55:15 1989 Joseph Arceneaux (jla at spiff) * ../oldXMenu/Makefile: Removed all the unneccessary X stuff. Mon Aug 7 22:08:30 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fileio.c (barf_or_query_if_file_exists): When signalling, provide the expected args for a file-error. Sun Aug 6 18:04:15 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c: Let NEED_BSDTTY control include of bsdtty.h. * process.c [BSD or STRIDE]: If ioctl.h fails to define O_NDELAY, and we need it, try fcntl.h. * s-bsd*.h, s-rtu.h, s-umax.h, s-unipl*.h: Define HAVE_UNION_WAIT. * m-stride.h: Likewise. * process.c: Decide which type to use with `wait' according to HAVE_UNION_WAIT. If WAITTYPE already defined, assume everything all set up for this. * m-hp9000s300.h: Unless NOT_C_CODE or NO_SHORTNAMES, define WAITTYPE and WRETCODE, and include sys/wait.h. Sat Aug 5 17:20:09 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * callproc.c (child_setup): Get rid of junk in #if 0. Thu Aug 3 02:20:01 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * abbrev.c (Fdefine_abbrev): Allow nil spec'd as expansion. (Fexpand_abbrev): Eliminate abbrev length limit; use alloca. Eliminate redundant tests, always true. Record positions of both start and end of abbrev. Handle whitespace following the abbrev, before point. * callproc.c (Fcall_process_region): Use unwind-protect to delete temp file. * lread.c (load_unwind): Free the pointer-word malloc'd in Fload. Wed Aug 2 23:24:21 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacs.c (Fdump_emacs): Doc fix. Wed Aug 2 11:24:08 1989 Joseph Arceneaux (jla at spiff) * xfns.c: Reorganized several functions to be in same order as the enum list. (x_set_border_color): For X11, don't set pix to -1 for gray values. (Fx_create_screen): Simplified this function even more. Mon Jul 31 15:01:50 1989 Joseph Arceneaux (jla at spiff) * keymap.c: New subrs Fuse_local_mouse_map, Fcurrent_local_mouse_map. * xfns.c (x_set_mouse_color): (x_set_cur): No need to redraw display after doing these. (Fx_get_mouse_event): Accept motion events. (x11_encode_mouse_button): Encoding a la X11, except for one kludge. This is used only for motion events. * xterm.c (XTread_socket): Handle motion eveots. Wed Jul 26 09:12:23 1989 Joseph Arceneaux (jla at spiff) * xfns.c (Fx_create_screen): I couldn't take it any more, the ugliness of this routine offended me too deeply. It is now completely rewritten for X11 and uses subroutines: (x_figure_window_size) (x_create_window) (x_icon) (x_make_gc) (Fx_draw_rectangle): (Fx_erase_rectangle): New subrs. * m/m-intel386.h: Changes in LOAD_AVE_TYPE, LOAD_AVE_CVT, and FSCALE to make loadst work correctly. Mon Jul 24 10:53:13 1989 Joseph Arceneaux (jla at spiff) * xfns.c (Fmodify_screen_parameters): Check s->output_method before looping through alist. (Fx_create_screen): Call x_default_parameter for font. Don't add the scrollbar widths when making the main window: this is done when the scrollbar is actually made. (x_set_vertical_scrollbar): Set v_scrollbar_width here instead of in install_vertical_scrollbar. Also, pass that function macros PIXEL_WIDTH, PIXEL_HEIGHT as args. (x_set_horizontal_scrollbar): Likewise. * xterm.c: (x_set_window_size): Don't call the things called anyway upon the ConfigureNotify event. (x_set_offset): Use the screen-size lisp variables for these calculations. * xterm.h: Added the screen parameter declarations from xfns.c for X11. Fri Jul 21 12:43:46 1989 Joseph Arceneaux (jla at spiff) * sysdep.c: Don't include sioctl.h on mips. * buffer.c (Flist_buffers): Pass prefix as arg. * editfns.c (Finsert_char): Insert at most 256 chars at a whack. * xterm.c (x_draw_box): Moved cursor box right by one pixel. Thu Jul 20 10:17:12 1989 Joseph Arceneaux (jla at spiff) * xfns.c: New variable x_screen_visuals, set if Fx_open_display, to be used in screen-color-p. * process.c (create_process): Don't call setpgrp_of_tty here. Also, do setpgrp for USG regardless of HAVE_PTYS. * callproc.c (child_setup): Ignore argument set_pgrp and always do setpgrp_of_tty. (Fcall_process): Don't call setpgrp_of_tty here. * keyboard.c (command_loop_1): Make sure Vprefix_arg is NULL before finalizing_kbd_macro_chars; Wed Jul 19 11:45:34 1989 Joseph Arceneaux (jla at spiff) * xfns.c (Fx_rebind_key): Completely rewrote this function for X11. Thu Jul 13 10:56:24 1989 Joseph Arceneaux (jla at spiff) * emacs.c: * process.c: * unexec.c: * m/m-ibmrt-aix.h: Changed IBMRTAIX to IBMAIX. * sysdep.c: Likewise. Also, don't define our closedir if IBMAIX. * m/m-ibmps2-aix.h: New file. Wed Jul 12 17:16:43 1989 Joseph Arceneaux (jla at spiff) * xdisp.c (message, message1): If using x, but haven't mapped the window yet, use noninteractive output. * dispnew.c (Fredraw_display): Don't redraw a screen which is not visible. * xterm.c (x_set_window_size): Don't DoDsp if screen isn't visible. * xfns.c (x_set_mouse_color) (x_set_border_color) (x_set_cursor_color) (x_set_background_color) (x_set_foreground_color): Don't redraw when screen isn't visible. Tue Jul 11 09:47:59 1989 Joseph Arceneaux (jla at gluteus) * xterm.c (x_term_init, XTread_socket): Use ConnectionNumber for both X10 and X11. This is #defined for X10. * screen.c (Fset_screen_width, Fset_screen_height): These now take a SCREEN argument. Mon Jul 10 20:36:58 1989 Joseph Arceneaux (jla at gluteus) * xterm.c (x_set_window_size): Call x_wm_set_size_hint. (x_new_font): Don't call x_wm_set_size_hint. * xfns.c (x_set_internal_border_width): Don't call x_set_resize_hint, and call x_set_window_size after BLOCK_INPUT. * screen.c, dispnew.c (Fset_screen_width, Fset_screen_height): These functions have moved to screen.c. Fri Jul 7 12:05:26 1989 Joseph Arceneaux (jla at sugar-bombs.ai.mit.edu) * eval.c (Ffuncall): Handle 6 arguments. Also, print a nice error message if there are more than 6 args. * fns.c: (Fyes-or-no-p): * minibuf.c: (read_minibuf_unwind): (Fread_minibuffer): (Fread_no_blanks_input): (Fcompleting_read): Extra arg to read_minibuf. * callint.c (Fcall_interactively): * keyboard.c (Fexecute_extended_command): * minibuf.c: (Fread_command): (Fread_function): (Fread_variable): (Fread_buffer): Extra arg to Fcompleting_read. Wed Jul 5 10:22:12 1989 Joseph Arceneaux (jla at spiff) * minibuf.c (read_minibuf): New argument back_n is number of characters to back-up point by. (Fcompleting_read): Same. * fileio.c: (Fnew_read_file_name): New version of Fread_file_name using the above features. (Finsert_file_contents): Check for negative file length. Mon Jul 3 14:57:22 1989 Joseph Arceneaux (jla at spiff) * xfns.c: (x_pixel_width, x_pixel_height) New functions. * screen.c: (Fscreen_pixel_size): New subr. Fri Jun 30 16:05:43 1989 Joseph Arceneaux (jla at spiff) * xterm.c: Use invocation_name as argument to XGetDefaults. Thu Jun 29 10:29:23 1989 Joseph Arceneaux (jla at spiff) * xterm.c (x_error_handler) #ifdef sony_news use XDefaultError instead of XPrintDefaultError due to weirdness in Sony library. * xterm.c: Avoid infinite raise/lower, enter/leave cycle when both auto_raise and auto_lower are set by checking times between consecutive Enter events. Tue Jun 27 17:15:16 1989 Joseph Arceneaux (jla at sugar-bombs.ai.mit.edu) * screen.c: (Fselect_screen) * window.c: (Fselect_window) The previous strategy was bugging the lisp stuff, so these are now rewritten. Mon Jun 26 15:36:00 1989 Joseph Arceneaux (jla at galapas.ai.mit.edu) * cm.c (Wcm_init): Don't check for Wcm.cm_ds, since this has been removed. (losecursor): This function now a #define in cm.h. * xterm.c (x_iconify_screen): Send message to root window to do this, as per latest Inter-Client Communications Conventions. This is commented out until it's implemented by X. For now, do it with the iconic_state hint. (x_deiconify_screen): For X11, just Map the window, as per the new ICCC. (x_make_screen_visible): Only handle visible and iconified screen elements for X10; these variables are handled in event processing for X11. (x_make_screen_invisible): Send an UnmapNotify event to the root window to aprise the window manager of the change. (XTread_socket): Catch VisibilityNotify events. Sun Jun 25 12:30:39 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * window.c (Fsplit_window): If horizontal, round left window size up. Sat Jun 24 13:31:27 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * cm.h (cmplus): Improve formatting. Use losecursor when reach end of line, if losewrap. * cm.h: New fields to handle multi-line and multi-char motion, and both max and min cost for certain operations. * term.c (term_init): Init those fields. * term.c (clear_end_of_line_raw): Don't clear last char of last line if autowrap. * abbrev.c (Finsert_abbrev_table_description): Make 2nd arg optional. Fri Jun 23 14:56:01 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xfns.c, lisp/term/x-win.el: C routine Fscreen_color_p now lisp function x-color-screen-p in x-win.el. (x_set_cursor_color): New method: first disallow same cursor as background, then if cursor not foreground, use it as cursor foreground. Thu Jun 22 23:23:08 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * lisp.h (XPNTR): Don't define if already defined. Thu Jun 22 18:08:11 1989 Joseph Arceneaux (jla at cream-of-wheat.ai.mit.edu) * screen.c: New subrs Ficonify_screen, Fdeiconify_screen, Fread_mouse_position, Fset_mouse_position. * xterm.c: New functions x_deiconify_screen, x_iconify_screen. Thu Jun 22 17:41:11 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * window.c (Fsplit_window, change_window_height): Enforce minimum of 2 for window_min_width and window_min_height. Thu Jun 22 15:45:03 1989 Joseph Arceneaux (jla at galapas.ai.mit.edu) * dispnew.c (unhold_window_change): Don't set and unset in_display before and after calling change_screen_size. Wed Jun 21 00:35:30 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * buffer.c (Fkill_buffer): Ignore errors deleting auto-save file. Delete only if delete-auto-save-files. * data.c (Fmake_local_variable): Don't change value if unbound. Tue Jun 20 15:29:03 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * screen.c (Fselect_screen): Use x_set_mouse_position instead of x_enter_screen. * xterm.c (x_enter_screen): Deleted, now merged with * xfns.c (x_set_mouse_position): If the position is negative, use the center screen position. * data.c (swap_in_symval_forwarding): Declared tem1. (Fset): Changed variable name void to voide. Also, set it to a C true/false, rather than Qt or Qnil. Sat Jun 17 15:45:52 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * eval.c (Fdefvar): Operate on default value if sym is buffer-local. (Fdefconst): Likewise. * Allow buffer-local variables to be void in one buffer or in the default value. * data.c (swap_in_symval_forwarding): New function. (Fboundp, Fsymbol_value): Use that. (default_value): New function. (Fdefault_value): Use that. (Fdefault_boundp): New function, uses that. Fri Jun 16 22:21:12 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * ymakefile: New variable OLDXMENU has filename of libXMenu.a as a target. Make temacs depend on it. Thu Jun 15 18:47:33 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * ymakefile [HAVE_X11, HAVE_X_MENU]: Build oldXMenu. * xmenu.c: Get XMenu.h from sibling dir. * buffer.c (Fkill_buffer): Return t if buffer is killed. Delete auto-save file if any. Fri Jun 9 15:42:44 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * window.c: initialize auto_new_screen to 0 (nil). * screen.c (make_screen): added auto_lower to the list of screen elements initialized. (make_minibuffer_screen): likewise. Thu Jun 8 16:53:24 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * window.c (Fset_window_point): Don't lose if window's buffer is not current. Thu Jun 8 15:18:30 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xfns.c (Fx_open_connection): Added 9 Lisp variables defined by the screen and server. Thu Jun 8 12:51:47 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-pmax.h: New file. Thu Jun 8 12:39:51 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xfns.c: removed superfluous definition of gray_bits. Wed Jun 7 21:57:53 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-hp9000s300.h: Define NEED_BSDTTY unless NOMULTIPLEJOBS. Wed Jun 7 16:14:41 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * emacs.c (Fkill_emacs): If under X, call Fx_close_current_connection. This has fixed the "bad file" bug. * xfns.c (Fx_close_current_connection): Added this subr which for the moment serves only to close the X-connection when killing emacs. Wed Jun 7 13:56:03 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-hp9000s800.h: Define NEED_BSDTTY here. * s-hpux.h: Not here. Tue Jun 6 19:25:46 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * s/s-hpux.h: Define NEED_BSDTTY. Tue Jun 6 13:11:58 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xterm.c (x_new_selected_screen): Make the new selected_screen and it's selected_window's screen be the same. (x_enter_screen): Calculate the middle of the screen, and warp the mouse there. Also, raise the screen before doing so. Mon Jun 5 14:54:28 1989 Joseph Arceneaux (jla at cream-of-wheat.ai.mit.edu) * xterm.c (x_set_window_size): If not already in DoDsp (checked with variable in_display) then DoDsp here. Handles redisplay after screen configuration. (x_error_handler): Print out stuff about the error if we're in debug mode. * dispnew.c (change_screen_size): No longer call DoDsp here. Mon Jun 5 11:22:58 1989 Chris Hanson (cph at kleph) * syntax.c (Fmodify_syntax_entry): Change documentation string to reflect earlier change to action of `p' syntax bit. Sun Jun 4 17:30:49 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * lread.c (read1): Don't accept "" in middle of string. Tue May 30 14:24:41 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * search.c (Freplace_match): If \N has nothing to insert, insert nothing. Mon May 29 21:41:38 1989 Joseph Arceneaux (jla at gracilis.ai.mit.edu) * xfns.c: (Fx_create_screen): If parms is nil and Vx_screen_defaults isn't, then use them. (Fdisplay_buffer): Call Fx_create_screen with Qnil. Thu May 25 16:32:10 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * syntax.c (scan_lists): Once within a word, treat Squote like Sword. Wed May 24 16:06:27 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * dispnew.c (change_screen_size): DoDsp if not pretend. Tue May 23 22:18:05 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * search.c (skip_chars): Dumb error checking for \. Mon May 22 16:30:08 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * screen.c (Fselect_screen): Under X, basically just warp the cursor into the desired screen. The event handler will then do the right thing. (Frestore_screen_configuration): Don't set the mouse position. * window.c (Fselect_window): If window's screen is not selected, call Fselecte_screen. (Fdisplay_buffer): Call Fx_create_screen with x-screen-parameters as argument instead of nil. * keyboard.c (clear_waiting_for_input): Don't call x_new_selected_screen here. * xterm.c (XTread_socket): Add case slots for CirculateNotify and CirculateRequest events. Sun May 21 15:51:46 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * doc.c (Fsubstitute_command_keys): Evaluate \\<...> keymap in proper buffer. * keymap.c (Fapropos_internal): New Lisp function, old apropos but only returns a list. Sat May 20 22:05:01 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c (Fopen_network_stream): Don't set kill-without-query. Fri May 19 16:54:04 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xterm.c (x_new_selected_screen): This now takes a struct screen pointer as paramter. * (XTread_socket): call x_new_selected_screen *before* dumpborder. Tue May 16 17:01:02 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xfns.c: (x_window_to_scrollbar): If the caller's not interested in the names--passing 0 for last two parameters--just return the screen pointer. * xterm.c (x_enter_screen): Added this function for warping the pointer into a screen. Tue May 16 16:23:22 1989 Chris Hanson (cph at kleph) * syntax.c (scan_lists, scan_sexps_forward): Treat characters whose "prefix" bit is on as whitespace when they are encountered between expressions. When they occur within expressions they are treated according to their syntax code. Tue May 16 15:20:03 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xterm.c: (x_new_selected_screen): Don't call Fselect_screen. Just do everything here. * window.c (Fselect_window): If the screen associated with the window is not selected, warp the mouse, cause an EnterNotify event which then causes the proper screen to become selected. This does *not* call Fselect_screen. * screen.c (Fselect_screen): Now this is *only* a lisp subr. It just calls Fselect_window on the selected window of the screen. Mon May 15 21:42:23 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * editfns.c (Fsubst_char_in_region): If NOUNDO, do increment tick, but maybe also increment save-tick. Mon May 15 14:59:31 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xterm.c (x_set_window_size): Only one #ifdef HAVE_X11 due to new macro in: * xterm.h: New macro XChangeWindowSize for both X10 and X11. * xfns.c (Fx_create_screen): Use XCreateWindow instead of XCreateSimpleWindow to directly set some extra attributes. Sun May 14 18:31:18 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * syntax.h (SYNTAX_PREFIX): New macro. * syntax.c (Fmodify_syntax_table): Handle `p'; set new flag. (describe_syntax): Describe new flag. (Fbackward_prefix_chars): Move back over such chars. * lread.c (read1): Dumb errors in last change. Sat May 13 14:19:31 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * lread.c (read1): Error if EOF after `?' or in string. * sysdep.c (init_sys_modes) [IBMRTAIX]: Typo; had s for sg. Fri May 12 17:56:48 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * s/s-usg5-3.h: Define HAVE_SYSVIPC? * alloc.c (Fmake_byte_code): If purifying, purecopy all elements. * ymakefile (LIBXMENU): Use -loldX. Find libXMenu11.a in special place. Fri May 12 11:43:16 1989 Joseph Arceneaux (jla at apple-gunkies.ai.mit.edu) * xfns.c (Fx_create_screen): If user has specified `x-iconic-startup' then start emacs in iconic form. Look for icon position in `icon-left' and `icon-top', or use window postion. * xterm.c (x_term_init): If server doesn't respond, use fatal instead of error. Also tell user about -d option. Wed May 10 16:37:45 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * sysdep.c (init_sys_modes, reset_sys_modes): Handle TIOCGLTC even if HAVE_TERMIO. * print.c (Qprint_escape_newlines): New variable. * minibuf.c (read_minibuf): Make it t locally in minibuffers. * fileio.c (Fcopy_file): Check for error on close. Wed May 10 14:33:53 1989 Joseph Arceneaux (jla at corn-chex.ai.mit.edu) * xfns.c (adjust_scrollbars): Don't subtract 2 from h_scrollbar_height when calculating `length'. Mon May 8 17:48:21 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * eval.c (call_debugger): Set entering_debugger. (find_handler_cause): Don't enter debugger if that's set. (Fbacktrace): Clear it; we are presumably in the debugger. * m/m-sps7.h: New file. Mon May 8 17:37:55 1989 Joseph Arceneaux (jla at rice-chex.ai.mit.edu) * xterm.c (XTread_socket_hook): For X11, on map and unmap events check the window manager hints for iconification status. * xterm.c (x_make_widow_icon): For X11, just request iconification of the window manager. Mon May 8 16:09:54 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m/m-clipper.h: New file. Sun May 7 16:35:33 1989 Joseph Arceneaux (jla at corn-chex.ai.mit.edu) * xfns.c (adjust_scrollbars): Don't subtract 2 from v_scrollbar_width when calculating `height'. * xfns.c (x_set_foreground, x_set_border_pixel): Finished color coordination. Scrollbar border, thump-arrows, and slider pixmap linked with foreground color; slider border with window border. Sun May 7 14:41:02 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * lread.c (read1): Handle octal integers. * macros.c: Doc fix. * search.c (Fstore_match_data): Allow ints instead of markers. * keyboard.c (get_char_menu_prompt): New function; does menu prompting based on current keymaps. Fri May 5 23:50:39 1989 Joseph Arceneaux (jla at gracilis.ai.mit.edu) * xfns.c (Fx_set_face): Rewrote the doc-string and renamed the parameters. Fri May 5 17:13:20 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * unexec.c: New control parameters COFF_BSD_SYMBOLS, KEEP_OLD_PADDR, KEEP_OLD_TEXT_SCNPTR, ADJUST_TEXT_SCNHDR_SIZE, ADJUST_TEXTBASE, HEADER_INCL_IN_TEXT. * unexec.c: Define IN_UNEXEC as flag for config.h. * keymap.c: Fapropos, etc., deleted. (Now in Lisp code.) * eval.c (Fcommandp): Byte code object is command if interactive slot exists at all. Fri May 5 15:46:50 1989 Chris Hanson (cph at kleph) * process.c [HPUX && !NOMULTIPLEJOBS]: Include , which defines TIOCGPGRP. Fri May 5 00:36:33 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * data.c (Faref, Farray_length): Handle byte-code objects. * fns.c (Flength, concat): Likewise. * data.c (Faref, Faset, Farray_length): Rename arg VECTOR to ARRAY. * m/m-hp9000s300.h: Undefine NOMULTIPLEJOBS. * keyboard.c (Fcommand_execute): Treat bytecode object as function. * callint.c (Fcall_interactively): Separate decoding of fcn from handling of it. * alloc.c (Fmake_byte_code): Renamed from Fmake_compiled_code. Make it pure if Vpurify_flag is non-nil. (Fpurecopy): Handle byte-code objects. * keyboard.c (get_char): Use Fsit_for for echoing timeout, not alarm. Do this before timeout for auto-save since the latter is longer. (request_echo): Function deleted. ({set,clear}_waiting_for_input): No need for echo_now, echo_flag. Thu May 4 10:44:12 1989 Joseph Arceneaux (jla at gracilis.ai.mit.edu) * xterm.c (x_lower_window, x_raise_window): Don't do anything if the window isn't visible. * xfns.c (x_set_foreground_color): Recolor the scrollbar windows appropriately, compatible with xterm. * xterm.c (x_reset_cursor): Do cursor recoloring. Thu May 4 02:07:55 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fns.c (Frandom): With number as arg, return value < that number. * sysdep.c [USG, BSD4_1] (random): Call `rand' twice, to get 30 bits of significance. Wed May 3 19:51:46 1989 Joe Arceneaux (jla at gracilis.ai.mit.edu) * xterm.c (x_draw_box): Use the cursor_gc. * xfns.c: (x_set_cursor_color, x_create_screen): Do a better job with cursor colors, and use 0 line width for the cursor_gc. Tue May 2 16:34:31 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * Begin changing representation of compiled functions. * lisp.h (enum Lisp_Type): New type code Lisp_Compiled, like a vector. (COMPILED_*): Names for slots in those vectors. * alloc.c (Fmake_compiled_code): New function. * eval.c (Fcommandp, Feval, Ffuncall, funcall_lambda): Handle fcns of type Lisp_Compiled. (Fcommandp, Fapply): Avoid directly nested ifs. * print.c (print): Handle Lisp_Compiled objects. * callint.c (Fcall_interactively): likewise. * doc.c (Fdocumentation): likewise. * keyboard.c (Fopen_dribble_file): nil as arg means close it. * abbrev.c, alloc.c, buffer.c, bytecode.c, callint.c, callproc.c: * casefiddle.c, cmds.c, data.c, dired.c, dispnew.c, doc.c, editfns.c: * eval.c, fileio.c, filelock.c, floatfns.c, fns.c, keyboard.c: * keymap.c, lread.c, minibuf.c, mocklisp.c, print.c, process.c: * screen.c, search.c, syntax.c, undo.c, vmsfns.c: Many doc fixes. Sun Apr 30 14:07:11 1989 Joseph Arceneaux (jla at hobbes) * xterm.c (XTring_bell): Wasn't passing selected_screen to XTflash. Fixed this. * xterm.c (XTread_socket): Don't check if server died under X11. Temporary. Sun Apr 30 14:22:01 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * window.c (Fdelete_other_windows): Bug getting top edge. Sat Apr 29 17:18:44 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * keyboard.c (get_char): Auto save if enough time elapses. (auto_save_timeout): New Lisp variable. * xdisp.c (try_window, try_window_id): Set w->redo_mode_line if should show percentage instead of `Bot'. Sat Apr 29 16:32:03 1989 Joe Arceneaux (jla at apple-gunkies.ai.mit.edu) * xterm.c (x_term_init): Don't set visible bell, as it pre-empts .emacs control. Wed Apr 26 22:50:22 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * doc.c (syms_of_doc): Make Vdoc_file_name a Lisp variable named internal-doc-file-name. Tue Apr 25 22:04:02 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-news.h: m-news800.h renamed. Removed EXPLICIT_SIGN_EXTEND and COMPILER_REGISTER_BUG. Removed SEGMENT_MASK and sigmask. LOAD_AVE_TYPE is now `double'; LOAD_AVE_CVT changed too. Define m68000 if not defined. Mon Apr 24 01:48:07 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * ymakefile: If COFF_ENCAPSULATE, define LD as gcc -nostdlib. * sysdep.c: Unconditionally include sys/ioctl.h. * m/m-mips.h [USG]: Define LIBS_TERMCAP. If HAVE_X11, define HAVE_VFORK. Sun Apr 23 00:47:14 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m/m-altos.h: Use termcap, not terminfo. Define COFF_ENCAPSULATE if using gcc. Use built-in alloca if using gcc. Define PURESIZE. * lread.c (absolute_filename_p): On ALTOS, @ means absolute. * process.c: Missing #endif. * fileio.c (Finsert_file_contents): Define `p' for last change. * buffer.c, floatfns.c: Typos in DEFUN doc strings. * keyboard.c: Typo in DEFVAR_LISP doc string. * window.c (Fdelete_other_windows): Fix confusion about type of W. Sat Apr 22 19:35:46 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * ymakefile (LDFLAGS): Forgot to use LD_SWITCH_SITE. * xterm.c (XTflash): Draw the bars here. (x_invert_screen): Change to invert entire window. (stufflines): Changed args to XClearArea. (XTread_socket): Clean up handling of KeyPress events. For LeaveWindow, ignore uninteresting ones and handle autolower. For FocusIn, ignore if unknown window, and handle autoraise. For MotionNotify, add real handling for X11. For ConfigureNotify, count width of scroll bars. Don't call change_screen_size redundantly; ignore linked expose events. Update left and top pos if nec. For button events, ignore if not in known window or scrollbar. (x_new_selected_screen): Takes screen as arg. (x_error_handler): Arg type different for X11. (x_set_window_size) [HAVE_X11]: Call change_screen_size before x_wm_set_size_hint. (x_make_window_visible): Make scroll bars visible too, if any. (x_lower_window): New fn. (x_wm_set_size_hint): Take account of width of scroll bars. Ior specified hint flags with those already set. * xterm.h (HSCROLL_HEIGHT): HSCROLL_WIDTH is renamed. (MAXWIDTH): Increased to 300. (MAXHEIGHT): Increased to 100. (DISPLAY_SCREEN_ARG): Remove parentheses. (ButtonReleased, WhichMouseButton): Delete definitions. * xmenu.c: Adapted to new X interface. X11ONLY replaced with xDISPLAY. Many X11 conditionals removed. * xfns.c (x_set_cursor_color): Special case if matches foreground. (Fx_create_screen): Typo for HSCROLL_HEIGHT. Use BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT. Set PRETEND arg to change_screen_size. Delete gray_bits; this value made global. Don't call install_*_scrollbar here. (x_set_horizontal_scrollbar): Define this for real. (x_set_vertical_scrollbar): Corrent args to install_vertical_scrollbar. (install_vertical_scrollbar): New local slider_pixmap, and set it. Delete locals GC_values, temp_gc. Change arrow_width, arrow_height (appears to be undefined) to 16. Un-if-0 this code. Use border_pixel, not foreground_pixel, for scrollbar. (install_horizontal_scrollbar): Define this for real. (adjust_scrollbars): Handle horizontal scrollbar. Define XMoveResizeWindow as XConfigureWindow if X10 to simplify. (x_resize_scrollbars): Remove #if 0 from quick-exit case. Really handle horizontal scrollbar. Simplify using new macro. (Fx_get_mouse_event): Mostly ignore events other than buttons. Use many new macros to handle X10 and X11. (encode_mouse_button): New fn: encoding of which button, broken out. * xfns.c (left_arror_cursor, etc.): New vars. (x_screen_parm, init_x_parm_symbols, x_set_screen_param): Define X_PARM_AUTOLOWER. * xdisp.c (display_string, redisplay-window, DoDsp): Use SCREEN_WIDTH, SCREEN_HEIGHT. Fri Apr 21 00:50:28 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * indent.c (compute_motion): Use SCREEN_WIDTH. * dispnew.c (update_line): Use SCREEN_WIDTH. (update_screen): Use SCREEN_HEIGHT. Thu Apr 20 15:48:07 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * window.c: rename Vauto_new_screen_hook, Vdisplay_buffer_hook, and Vtemp_buffer_show_hook to ..._function. * keyboard.c: rename mouse_hook to mouse_event_function. * buffer.c, buffer.h, cmds.c: blink-paren-hook and auto-fill-hook renamed to -function. * fileio.c (Finsert_file_contents): Allow quit in read. (Fwrite_region): Allow quit in write. Wed Apr 19 13:07:25 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * doprnt.c (doprnt): Comment out %b since sprintf can't do it. * Change X11 to HAVE_X11 everywhere. * m-sun3.h: Define C_SWITCH_MACHINE as -fsoft. Tue Apr 18 00:18:30 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c: Don't define wstopsig, wtersig if already defined. * sysdep.c [VMS] (sys_getenv): Copy the string before returning it. * m-alliant.h: Define `vector'. Thu Apr 13 12:55:14 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c (wait_reading_process_input) [sun]: If SIGIO failed to be sent, send it by hand. Wed Apr 12 01:42:23 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * window.c (Fdelete_other_windows): recenter window to avoid scrolling. Tue Apr 11 00:18:10 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * indent.c: Include screen.h. * indent.c (pos_tab_offset, Fvertical_motion): Compute internal width correctly and uniformly. * xdisp.c (try_window, try_window_id): Use exact internal width to update tab_offset. (try_window_id): pos_tab_offset value needs adjustment only if starting a line in middle of a character. Sat Apr 8 16:38:40 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * sysdep.c [USG]: If TIOCGWINSZ defined, include sioctl.h. Thu Apr 6 11:52:43 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * eval.c (Fbacktrace): Set Vprint_level to 3 throughout. * fns.c (Fload_average): nlist data structure is funny on convex. * window.c (scroll_command): scroll at least 1 line in specd direction. * cm.c (calccost): NTABS was off by 1 sometimes; take account of the starting position modulo 8. * fileio.c (Fexpand_file_name): Don't simplify /../ at start of name. * callint.c: doc fixes. * process.c (create_process): On all USG systems, not just IRIS and AIX, don't pre-open pty's tty. Move the setpgrp done for USG (no real change). Tell child_setup to do a setpgrp. * callproc.c (child_setup): New arg says whether to setpgrp. Never setpgrp on USG. (Fcall_process): Tell child_setup not to setpgrp. * sysdep.c (init_sys_modes, reset_sys_modes): Don't try to hack TIOCGLTC, TIOCGETC, etc. if HAVE_TERMIO. Don't bother to undef these for XENIX. Mon Apr 3 17:43:28 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * ymakefile (LIBES): Put LIBX first; it may depend on LIBS_MACHINE. * m-sequent.h: Define HAVE_ALLOCA. Sun Apr 2 12:03:53 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * term.c (term_init): Can't use scroll region if no abs positioning. Sat Apr 1 00:51:52 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c (Fopen_network_stream): close desc. if connect fails. Fri Mar 31 17:49:53 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * minibuf.c (Fall_completions): gcprotect ALLMATCHES and TAIL, not STRING. * keyboard.c (read_avail_input): Handle EBADSLT like EAGAIN. Wed Mar 29 09:13:39 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * term.c (term_init): Either ic or ip or im or IC => can insert chars. * minibuf.c (read_minibuf_unwind): Ensure minibuf writable for erasure. Thu Feb 23 07:03:47 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-convex.h: Undefine NO_ARG_ARRAY. Changed defns of DATA_SEG_BITS and XINT. Define alloca for GCC compilation. Fri Feb 17 01:47:30 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m-ibmrt-aix.h: Define BROKEN_FIONREAD. Thu Feb 16 03:23:31 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * keymap.c (Fdefine_prefix_command): Set both value and fn defn, with separate syms specified for each purpose. Wed Feb 15 22:34:58 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * callproc.c (Fcall_process): Open /dev/null with O_WRONLY. Tue Feb 14 11:48:44 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * window.c (window_scroll): Allow scrolling to very end (empty screen) if that's exactly where we wanted to scroll to. Sat Feb 11 01:14:39 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * data.c (Fkill_local_variable): New local to simplify big stmt. Thu Feb 9 06:37:24 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * xdisp.c (display_text_line): cvt chars to glyfs for overlay arrow. * sysdep.c (init_sys_modes, child_setup_tty) [IBMRTAIX]: Don't ignore BRK, and don't signal it. * process.c (pty): An IBMRTAIX conditional. (create_process): Another here. Wed Feb 8 13:24:39 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * keymap.c (Fdefine_prefix_command): Use Ffset, not Fset. Mon Feb 6 12:58:58 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fileio.c (Fset_visited_file_modtime): New fn. * xfns.c (Fx_create_screen) [X10]: XCreateWindow wants pixmaps as args. Fri Feb 3 01:16:49 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * dispnew.c (Fsit_for): It accepts 3 args. Thu Feb 2 23:07:43 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * xterm.c (XTread_socket): For X10, make EVENT an XKeyPressedEvent. (x_set_resize_hint): Call XSetResizeHint. * process.c: Declare interrupt_input. * sysdep.c (init_sys_modes): TIOCSTART, not TCSTART. Sat Jan 28 15:39:03 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * xterm.h (struct x_display): `GC' renamed `gc' in all field names. Field `ColorMap' renamed to `color_map'. (face_gc_values): face_GC_values renamed. Sat Jan 28 15:39:03 1989 Joe Arceneaux (rms at sugar-bombs.ai.mit.edu) * xterm.h (face_GC): Var deleted. (struct x_display): New field face_GC. (VSCROLL_WIDTH, HSCROLL_WIDTH): Moved here. (MINWIDTH, MINHEIGHT, MAXWIDTH, MAXHEIGHT): New vars. Eliminate them! (BLACK_PIX_DEFAULT): Typo in definition. (WHITE_PIX_DEFAULT): Typos in definitions; was the black default. * xterm.c: Include ioctl.h only if BSD. Include termio.h otherwise. (XMapWindow) [X11]: Typo in definition. (METABIT): New definition; maybe not needed. (hostname, id_name, invocation_name, Vcommand_line_args): New vars declared for main icon title. (x_debug): Init to 1 if XDEBUG defined. (dumpglyfs) [X11]: Changed args to XDrawImageString. If debugging, do XFlushQueue. Use screen's face_gc rather than old global one. (XTflash) [not BSD]: avoid `struct itimerval'; use `alarm'. (events): New table of event type names. (XTread_socket): EVENT is now an XEvent even on x10. Translate modifier key 1 into meta-bit. For EnterNotify event, don't dumpborder or x_new_selected_screen if there is an x_focus_screen. For LeaveNotify event, don't ignore due to nonzero subwindow. For ConfigureNotify, change screen size. Do `select' check for SIGHUP only if HAVE_SELECT. (x_new_selected_screen): An arg, SCREEN. (x_display_cursor): dumpglyfs args changed. (x_draw_box): Add GC arg to XDrawRectangle; change other args. (clear_cursor): Change args to XClearArea. (dumpborder): check x_input_screen, not selected_screen. (x_text_icon): For X11, new arg to XGetDefault. Cast values stored in icon_label. (x_term_init): Hair to calculate name for icon. Don't init_sigio unless SIGIO defined. Call Fset_input_mode. For X11, new arg to XGetDefault. Set _Xdebug if debugging. (x_new_font) Use XGetFont. Get GC values from the screen structure. (x_reset_cursor): Don't call XRecolorCursor. (x_set_window_size): Call x_wm_set_size_hint, not x_set_size_hint. (x_set_resize_hint): For X11, call x_wm_set_size_hint. (x_wm_set_size_hint, x_wm_set_window_state, x_wm_set_icon_pixmap): (x_wm_set_icon_position): New fns for X11. * xfns.c: For X11, include Xutil.h (VSCROLL_WIDTH): Moved to xterm.h. (face_GC): Don't declare it. (id_name): Declare this. (x_decode_color): Check `white' and `black' first of all. (x_set_foreground_color) [X11]: Reset foreground and background. (x_set_background_color) [X11]: Missing arg to XSetWindowBackground. (x_set_cursor_color) [X11]: Reset foreground and background. (x_read_mouse_position) [X11]: Changed call to XQueryPointer. (x_set_mouse_position) [X11]: Add args to XWarpPointer. (Fx_create_screen): Set some temporary geometry parms at the beginning. For X11, changed setup of iconidentity, and implement rubber-banding. For X11, implement merging individual geometry parms. For X11, changed args to XCreateSimpleWindow. For X11, call x_wm_set_size_hint. Specify name when creating icon. Don't call XSetForeground, XSetBackground before making border tile. New var `cursor_bits'. Init the screen's GC's. * screen.c (Frubber_band_rectangle): For X11, just return nil. Tue Jan 24 01:59:31 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * buffer.c (Fbuffer_modified_tick): New fn. * window.c (Fnext_window): Accept 3 args from Lisp. Mon Jan 23 16:39:36 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * sysdep.c (sys_suspend): Handle case of SIGTSTP but not BSD. Fri Jan 20 14:26:12 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * sysdep.c (init_sys_modes): Do TIOCSTART if def, like TCXONC. Thu Jan 19 03:04:58 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c (wait_reading_process_input): New 2nd arg is extra usecs. All callers changed. * dispnew.c (Fsit_for, Fsleep_for): New 2nd arg says 1st arg counts in milliseconds. * buffer.c (Fkill_all_local_variables): Implement permanent locals. Wed Jan 18 14:08:35 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * keymap.c (get_keyelt): Allow indirection within (STRING . DEFN). Mon Jan 16 17:26:08 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c (wait_reading_process_input): If select returns there is kbd input, but detect_input_pending can't find it, signal SIGIO. This may avoid the X loop-on-logout bug. * process.c (wait_reading_process_input): Flush fix_screen_hook. * termhooks.h, term.c: likewise. * xdisp.c (Fredraw_display): Don't do set_terminal_modes. * dispnew.c (Fredraw_screen): likewise. * eval.c (Fcond): If no args, return nil. Sun Jan 15 15:41:13 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * eval.c (Fbacktrace_frame): Require one arg. Return nil if too high. Sat Jan 14 17:50:56 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * minibuf.c (read_minibuf): Set Vminibuf_scroll_window before switching windows. * xterm.c (XTread_socket): If no HAVE_SELECT, wait for input if new arg WAITP is non0. Do this by not bothering to test for presence of input before reading some. Check for dead connection only if new arg EXPECTED is nonzero. All callers changed (keyboard and sysdep). * Simplify keyboard input. * keyboard.c (read_avail_input): Don't assume buffer is empty. Don't call get_input_pending; do FIONREAD here. Don't do FIONREAD if read_socket_hook, just tell it don't wait. Arg EXPECTED is passed to read_socket_hook. (input_available_signal): Use read_avail_input. (gobble_input): Use read_avail_input; arg EXPECTED passed along. (get_input_pending): let gobble_input do the work. * VMS keyboard input should have interrupt_input nonzero. * keyboard.c (Fset_input_mode, init_keyboard): [VMS] Always set interrupt_input to 1. (get_input_pending): Special case deleted. Fri Jan 13 01:21:00 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fileio.c (auto_save_1): Always make auto-save file owner-writable. * eval.c (Fbacktrace_frame): New fn. * buffer.h: Define `fieldlist' field in a buffer. * buffer.c (Fregion_fields): Return list of fields overlapping specified region. (syms_of_buffer): New variable buffer-field-list. (reset_buffer): Clear the fieldlist. (init_buffer_once): Set up default and flag for buffer-field-list. * insdel.c (prepare_to_modify_buffer): If check_protected_fields, call Fregion_fields to detect error. Delete buffer_modify_hook. * callint.c (Fcall_interactively): Bind `command-debug-status' for each interactive command. * keyboard.c (command_loop_1): Count # commands read. (num_input_keys): New Lisp variable. * m/m-gould.h, m/m-ibmrt-aix.h, m/m-sequent.h, m/m-sparc.h, m/m-sun3.h, m/m-symmetry.h: Define A_TEXT_SEEK. * unexec.c (copy_text_and_data): Don't check A_TEXT_OFFSET, just A_TEXT_SEEK. * unexconvex.c: Likewise. * unexconvex.c: machine/*.h unconditionally. * process.c (pty): Delete RTU, HPUX, IRIS alternatives to PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF. * s/s-hpux.h: Define PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF. * s/s-rtu.h: Likewise. * s/s-iris*.h: Define PTY_TTY_NAME_SPRINTF. * sunfns.c (Fsun_change_cursor_icon): Avoid ambiguity in eval order. Thu Jan 12 18:28:29 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * data.c (Fdefault_value): If var set up with default value as current, take the current value slot, more up to date than the default slot. Wed Jan 11 15:22:14 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * dispnew.c (init_display): don't handle SIGWINCH if using X. * fileio.c (Fdo_auto_save): If file has shrunk, turn off auto-save. This avoids duplicate messages and allows M-x auto-save to turn it on. * lread.c (Fload): Look in Vafter_load_alist. (syms_of_load): Define after-load-alist. Sat Jan 7 01:43:47 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * dired.c (Fdirectory_files): 4th arg NOSORT non-nil means don't sort. * syntax.c (scan_lists): Change Sendcomment case so that ignoring comments works even for newline-terminated comments. * minibuf.c (read_minibuf): Default Vminibuf_scroll_window to the window that was selected. Fri Jan 6 02:51:46 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fns.c (do_yes_or_no_p): Typo, call2 => call1. * eval.c (Fbacktrace): Each frame item should have a newline. * emacs.c (Fkill_emacs): Don't run hook if noninteractive. * eval.c: Define Vrun_hooks. (syms_of_eval): Initialize Vrun_hooks. * indent.c (Fmove_to_column): Use del_range; Fdelete_backward non ex. * ymakefile (objs, floatfns.o): Re-add this file. (LIBX): Install X11 case. * ymakefile (LIB_GCC): Now a cpp macro, like all other LIB_... Define null if not using GCC. * lread.c (unreadchar): New function to unread a char by stuffing it back into its stream. Now unread chars work properly between multiple reads. (UNREAD): Now calls that function. (readchar): Don't us `unrch'; variable deleted. (various): Don't initialize `unrch'. (readevalloop): No need to save and restore `unrch'. (read1): Don't unread a -1. * keymap.c (get_keyelt): If keymap defn is (STRING . FOO), remove just FOO. Will help HierarKey. Thu Jan 5 14:49:14 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * unexmips.c [IRIS_4D]: Don't include fcntl.h. (unexec): Look for LIT8, LIT4 sections iff they are defined. * buffer.c (Fkill_all_local_variables): Force redisplay of mode lines. Mon Jan 2 13:52:58 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacs.c (main): Do the setpgrp before handling -t. * keyboard.c (Fsuspend_emacs): Use run-hooks to run suspend-hook and suspend-resume-hook. * buffer.c (Fkill_buffer): Execute kill-buffer-hooks with buffer to be killed as current buffer. * buffer.c (count_modified_buffers): ModExist renamed. * emacs.c (Fkill-emacs): Execute kill-emacs-hook. * fileio.c (auto_save_1): Set auto_save_mode_bits from visited file. (Fwrite_region) [not VMS]: If auto-saving, write file with that mode. * fileio.c (Fwrite_region): If START is a string, write that string. Sun Jan 1 14:00:50 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * lisp.h (XMARKBIT, XSETMARKBIT): If mark bit is sign bit, use sign-test for XMARKBIT; value is then 1 or 0. Make XSETMARKBIT test 2nd arg for nonzeroness only. * m/m-mips.h: Last batch of changes are only for USG. (XMARKBIT, XSETMARKBIT): Deleted; the new default ones are good. * editfns.c (Fformat): Use princ for %s. New format %S converts everything (even strings) with prin1. * doprnt.c (doprnt): Treat %s like %S. * print.c (Fprin1_to_string): Opt 3nd arg non-nil does princ. Sat Dec 31 14:18:31 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * data.c (Fstring_to_int): Correct max # args. Fri Dec 30 02:14:11 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * ymakefile (LIBES, LIB_GCC): If using GCC, link with gnulib. Thu Dec 29 18:50:10 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * editfns.c: Many doc improvements. Wed Dec 28 02:34:04 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * lisp.h (CHECK_NATNUM): New macro. * indent.c (Fmove_to_column): 2nd arg t means indent till spec'd column or change tab to spaces if necessary. * m/m-iris4d.h: (conditionally) delete DEFAULT_ENTRY_ADDRESS and change START_FILES and LIB_STANDARD. * s/s-iris3-6.h: Define sigblock as no-op. * m/m-mips.h: Cancel defn of VIRT_ADDR_VARIES, `static'. Undef SIGIO. Define BROKEN_FIONREAD. Define various HAVE_... flags a la BSD. Add options, libraries for linking and compilation. * unexmips.c (unexec): Handle additional optional sections now likely. New scheme for recording what sections there are. Make handling of the LIT8,LIT4 sections conditional (not on IRIS). * fns.c (do_yes_or_no_p): New interface to Lisp function yes-or-no-p. Allows the user to redefine that function. All callers of Fyes_or_no_p changed. * data.c (Fmakunbound): Don't allow nil or t as arg. * m/m-orion105.h (LOAD_AVE_TYPE): Now `long'. Tue Dec 27 23:44:41 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * dispnew.c (unhold_window_change): Don't signal SIGWINCH. Instead, do pending size-changes here, while holding any new size-changes that arrive, so they become pending. Loop around to get the new pending ones. (change_screen_size): Clear any previous pending size-change. * search.c (place): Was clipping to (1- (point-max)) by mistake. Sat Dec 24 17:45:38 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * window.c (Fdelete_window): Give all this window's space to one adjacent sibling. Fri Dec 23 01:16:18 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * keymap.c (describe_alist): Don't lose on non-cons-cell alist elts. (Fwhere_is_internal): Don't fail to step down the alist. (Faccessible_keymaps): Considerable confusion in alist case. * lread.c (Feval_current_buffer, Feval_region): Save and restore point as a marker, not a number. Don't restore it at all if printflag is t. * print.c (float_to_string): Mostly rewritten; output format is now a printf %-spec. (Qfloat_output_format): Doc changed to match. Thu Dec 22 12:22:24 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * ymakefile (obj): Include floatfns.o. * data.c (syms_of_data): Fix typo Snumberp_or_marker_p. * Allow keymaps to have other keymaps as tails. Thus, one keymap can inherit from another. * keymap.c (Fwhere_is_internal): Ignore non-cons elements of alist. (Faccessible_keymaps): Support symbols as alist indices. Ignore alist elements that aren't conses. * m/m-sun386.h (LDAV_SYMBOL): Define as "avenrun" with no underscore. * lread.c (read_escape): Support ANSI C `\x...' hex escapes. * bytecode.c (Fbyte_code): fix jump operators for change in `pc'. Wed Dec 21 19:39:27 1988 Joe Arceneaux (jla at gracilis.ai.mit.edu) * ymakefile: Commented #endif LISP_FLOAT_TYPE. Also changed the code pertaining to X11 to use the same files as X10. * bytecode.c (Fbyte_code): Declared unsigned char *pc. Mon Dec 19 17:27:14 1988 Joe Arceneaux (jla at apple-gunkies.ai.mit.edu) * xterm.c: Finished a first cut of the X11 version. Sun Dec 18 13:08:17 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * sysdep.c (select): `buf' is now unsigned char. Fri Dec 16 18:00:36 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m/m-elxsi.h: Don't define WORD_MACHINE or CANNOT_DUMP. Do define symbols for load average. Define COFF and ADJUST_EXEC_HEADER. Fri Dec 16 13:56:51 1988 Joe Arceneaux (jla at apple-gunkies.ai.mit.edu) * sink.h,sinkmask.h: Same file now works for both X10 and X11. * xterm.c,xfns.c (x_text_icon) Can now take new name as parameter. Fri Dec 16 11:07:20 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m/m-is386.h: No need to undef HAVE_PTYS, HAVE_SOCKETS, SYSV_PTYS since s-usg5-3.h no longer defines them. Wed Dec 14 17:52:51 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * bytecode.el (Fbyte_code): Cache the pointer in the string to avoid recalculating it at each fetch. Also turn off the error check for stack overflow/underflow. Wed Dec 14 14:51:24 1988 Joe Arceneaux (jla at apple-gunkies.ai.mit.edu) * xfns.c: Made the first cut for X11 version. * xterm.c: (x_reset_cursor) Did the X11 version. Wed Dec 14 13:02:30 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * keyboard.c (Fexecute_mouse_event): Set Vmouse_event. Doc fix. Run Vmouse_hook at the end. (syms_of_keyboard): Define var `mouse-hook'. Tue Dec 13 10:55:27 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * term.c (insert_glyfs): Typo, was fetching G twice. Sat Dec 10 17:37:28 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * keymap.c (describe_buffer_bindings): Print mouse bindings too. (describe_map): If have a chartab, use mouse-describe-key for prefixes. * keymap.c (describe_{map,map_tree,alist}, describe_vector): Extra arg mapping chars to their names. Calls changed. * syntax.c (describe_syntax_1): Call changed. * keymap.c (Vglobal_mouse_map): Make it exist unconditionally. * keymap.c (apropos1): Clean up. Do where-is-internal only if there is a function definition. Use mouse-describe-key to turn mouse key sequences into strings. (Fwhere_is): Check the mouse map too; (Fwhere_is_internal): New arg is global map to use. All callers changed in keypad.c and doc.c. (where_is_string): New fn cvts result of Fwhere_is_internal to string. Fri Dec 9 23:40:16 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacs.c (stack_bottom): New variable, set in main. * alloc.c (Fgarbage_collect): Save a copy of the entire stack contents. Wed Dec 7 17:07:47 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * editfns.c (Funix_umask, Funix_sync): New functions. * process.c (Fsignal_process): New function. Tue Dec 6 21:03:22 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * editfns.c (Fsubst_char_in_region): Fix typo in when to un-modify buf. Mon Dec 5 14:42:23 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c (create_process): Take the usg's setpgrp and the close-and -open of the tty outside the TIOCNOTTY conditional, since TIOCNOTTY is always missing outside BSD. Now the TIOCNOTTY conditional controls only the TIOCNOTTY. Sun Dec 4 11:15:15 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * lread.c (Feval_current_buffer, Feval_region): If there is an error, don't restore original point. * s-hpux.h (SHORT_CAST_BUG): Define this, for HPUX version 6.2. * ymakefile (THIS_IS_YMAKEFILE): Define macro to tell m- files to do special things. * m/m-ns16000.h: (LOAD_AVE_TYPE, etc.): Don't define them if USG. * m/m-ns16000.h [USG]: Define various macros differently. (munnari!sibyl.eleceng.ua.oz.au!ian@uunet.uu.net). * sysdep.c (reset_sys_modes): Don't output a CR here. * term.c (reset_terminal_modes): Do it here, but first do a newline if it's a magic cookie terminal. * sysdep.c (sys_suspend) [USG]: Use `nice' to set subshell pri. to 0. * sysdep.c (TIOCSETN) [USG]: Use TCSETAW, not TCSETA. * sysdep.c (setpriority) [USG]: No longer a no-op; use `nice'. * keymap.c (Fwhere_is_internal): New 4th arg inhibits looking thru indirect definitions--so you can search for one. * alloc.c, fns.c, search.c: Doc fix. Thu Dec 1 16:46:51 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * process.c (read_process_output): Insert with insert_before_markers. * filelock.c (lock_file_1, lock_superlock): If USG, use chmod instead of fchmod. * environ.c (Fsetenv): Doc fix. Fri Nov 25 13:41:15 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * eval.c (do_autoload): Verify FUNNAME is a symbol. Thu Nov 17 23:26:03 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fileio.c (Fread_file_name): New arg specifies initial minibuf cntnts. * callint.c (Fcall_interactively): Calls changed. Sat Oct 8 03:20:07 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * insdel.c (make_gap): Error if buffer size exceeds range of Lisp int. Thu Oct 6 05:34:48 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * window.c (Fsplit_window): Prevent error in Fset_window_buffer. * sysdep.c (gettimeofday): Store -1 thru tzp so caller knows invalid. * xdisp.c (message): Pass 0 as new arg to doprnt. * callint.c (Fcall_interactively): Likewise. * editfns.c (format1): * doprnt.c (doprnt): Allow 0 as FORMAT_END arg meaning null-terminated. Wed Oct 5 18:43:53 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * keyboard.c: If UNIPLUS, include ioctl.h. * sysdep.c (utime): Use new flag IRIS_UTIME, not IRIS. * s-iris*.h: Define that flag. Tue Oct 4 21:04:42 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * term.c (term_init): If have `im' capability, permit ins/del char even without `ic'. Mon Oct 3 00:32:34 1988 Richard Stallman (rms at corn-chex.ai.mit.edu) * m/m-hp9000s300.h: Conditionals for BSD vs HPUX. * ymakefile: Look for C_SWITCH_SITE, LD_SWITCH_SITE. Fri Sep 30 15:48:51 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * editfns.c (Fformat): Allow nulls in the format. * doprnt.c (doprnt): likewise. End of format string is new arg. Wed Sep 28 15:25:37 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * m/m-7300.h: Undefine SHORTNAMES. Supposedly newer Unix now. * print.c (print): Support new var print_length. (syms_of_print): Define Lisp var print-length. * eval.c (Fbacktrace): Print unevalled form with print_length = 3. * Makefile (tags): Add TAGS as alternate target. Process the files in ../lisp/term. Tue Sep 27 00:55:47 1988 Richard Stallman (rms at corn-chex.ai.mit.edu) * doprnt.c (doprnt): Handle %-20s. * editfns.c (Fformat): Likewise (make enough space for it). * minibuf.c (do_completion): If get "Complete but not unique" twice in a row, display all completions. New var last_exact_completion. Mon Sep 26 19:19:23 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * * dispnew.c (baud_rate): Now a Lisp variable, not a function. * termcap.c (tputs) [emacs]: Use baud_rate as the speed. Mon Sep 19 00:06:16 1988 Richard Stallman (rms at gluteus.ai.mit.edu) * window.c (Fset_window_configuration): Set deleted windows' buffer to nil, via new function delete_all_subwindows. * window.c (Fset_window_buffer): Reject deleted windows. * window.c (init_window_once): Init the ->buffer fields to satisfy error check in Fset_window_buffer. * * xmenu.c (Fx_popup_menu): 1st arg is now ((X Y) WINDOW). * process.c (child_sig): If synch process terminates, clear synch_process_pid and record synch_process_death. * * callproc.c (Fcall_process): return synch_process_death. Always set synch_process_pid and do it with SIGCHLD masked off. * sysdep.c (wait_for_termination) [subprocesses and not VMS]: Use alarms to check every second whether synch_process_pid is 0. Sat Sep 17 17:14:32 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * xdisp.c (redisplay_window): If window-point is outside restriction then correct it in the window. * window.c (Fdelete_buffer): Don't change buffer's point to a value outside its restriction. * sysdep.c (init_sys_modes) [MULTI_SCREEN]: Set Vterminal_screen's garbaged bit. Fri Sep 16 01:13:09 1988 Richard Stallman (rms at corn-chex.ai.mit.edu) * keyboard.c (kbd_buffer_get_char): VMS now uses same code as Unix. * vmsproc.c: New file for VMS only. * callproc.c [VMS]: Omit Fcall_process and child_setup_tty. * emacs.c (main) [VMS]: Call init_vmsproc and syms_of_vmsproc. * lread.c (OBARRAY_SIZE): Change slightly to 509 (prime). * * keyboard.c, dispnew.c, term.c, xterm.c (meta_flag): MetaFlag renamed. * keyboard.c (Fset_input_mode): 3rd arg sets meta_flag. (syms_of_keyboard): Variable meta-flag deleted. * sysdep.c (init_sys_modes): Don't override parity settings if meta_flag is 0. Thu Sep 15 23:29:12 1988 Richard Stallman (rms at corn-chex.ai.mit.edu) * * search.c (Fsearch_forward, etc.): All buffer-search functions return new the value of point if they succeed. Tue Sep 13 12:00:22 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * cmds.c (Fnewline): Correct test of ARG1 to inhibit auto-fill. Mon Sep 12 16:39:32 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * window.c (Fdelete_window): Put nil as buffer of the deleted window. This makes select-window get an error earlier. Tue Sep 6 20:43:10 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * search.c (search_buffer, string_match, looking_at): Report matcher stack overflow as error, not just failure to match. * data.c (Fmake_local_variable): Add local variable to simplify too-complex expression. * fileio.c (Fdo_auto_save): No "file has shrunk" msg if < 5000 chars. See ChangeLog.2 for earlier changes. emacs-19.30/src/ChangeLog.4100666 12120 1 745774 5743543525 13715 0ustar rmsdaemonMon May 30 06:16:48 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.25 released. * xdisp.c (redisplay): Limit prev change to pause != 0. * keyboard.c (command_loop_1): Allow direct output for insert if have display table but it says nothing for this char code. Don't allow it if char code has a glyph with a face code. * process.c (create_process): Get a pty for any non-nil Vprocess_connection_type value. Sat May 28 00:33:16 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/bsd386.h (TABDLY, TAB3): Defined. (SYSV_SYSTEM_DIR): Defined. * unexhp9k800.c (roundup): Undef before defining. * xdisp.c (redisplay): If have window change at end, redisplay again. * lread.c (defvar_bool, defvar_int, defvar_lisp, defvar_lisp_nopro): Delete third arg DOC. * s/hpux8.h (LD_SWITCH_SYSTEM): Delete the -L options. (LD_SWITCH_X_DEFAULT): Put them here instead. * Makefile.in.in (LD_SWITCH_X_DEFAULT): Define if not defined. (LIBX): Use LD_SWITCH_X_DEFAULT. * xterm.c (x_iconify_frame): Call x_set_offset, if x_make_frame_visible would do so. (x_make_frame_visible): Don't call x_set_offset if frame is iconic. (XTread_socket): For ConfigureNotify, if wm decorations exist, set NorthWestGravity. * Makefile.in.in (mostlyclean): Don't mention xmakefile*. * emacs.c (main): In batch mode, don't set the pgrp. Fri May 27 06:32:24 1994 Paul Eggert (eggert@twinsun.com) * callproc.c (child_setup): If PWD is set, set it in the child so that it points at the child's working directory. Fri May 27 03:59:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * m/mips4.h (C_DEBUG_SWITCH) [not __GNUC__]: Add -Wf option. * s/hpux9.h (C_SWITCH_SYSTEM): Defined. * keyboard.c [HAVE_X_WINDOWS]: Include xterm.h. * xterm.c (x_is_vendor_fkey): Function deleted. (XTread_socket, case KeyPressed): Don't clear the vendor-specific bit. Pass thru almost any vendor-specific keysym. * s/linux.h (HAVE_XRMSETDATABASE): Define if not defined. Fri May 27 06:52:13 1994 Paul Eggert (eggert@twinsun.com) * editfns.c (difftm): Don't store a long value into an int variable. Thu May 26 18:29:17 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * fileio.c (Finsert_file_contents): Check for beginning of file. Thu May 26 18:13:31 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * systime.h: Make previous change limited to HPUX. Thu May 26 14:46:35 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * systime.h: If _STRUCT_TIMEVAL is defined, also define __TIMEVAL__. Wed May 25 20:20:53 1994 Morten Welinder (terra@diku.dk) * msdos.c (output_string): New function. (internal_flush): Use output_string for faster screen update. (internal_flush): Clear to end of line by writing a string of spaces. Wed May 25 00:36:35 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (Vx_sensitive_text_pointer_shape): Renamed from Vx_cross_pointer_shape. (syms_of_xfns): Provide Lisp var x-sensitive-text-pointer-shape. * xmenu.c (menu_item_equiv_key): Look for equiv keys both before and after one stage of symbol function indirection. * xterm.c (note_mouse_movement): Use frame's window in XQueryPointer. Special case if mouse isn't on that window. (note_mouse_highlight): Handle negative args and too-large args. * lread.c (openp): Don't use O_RDONLY. Tue May 24 22:20:01 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * search.c (Freplace_match): Improve capitalization heuristics. * minibuf.c (Fminibuffer_complete_word): GCPRO completion and tem. * undo.c (Fprimitive_undo): GCPRO next and list. Check argument type before calling XINT. Tue May 24 17:14:49 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c (verify_overlay_modification): GCPRO tail and overlay. Avoid copying tail twice. Tue May 24 17:11:38 1994 Andreas Schwab (schwab@informatik.uni-dortmund.de) * keymap.c (describe_map): Fix the call to Fequal. Tue May 24 16:50:42 1994 Morten Welinder (terra@diku.dk) * msdos.c (do_visible_bell): Renamed from visible_bell to avoid potential conflict with variable of the same name. Caller changed. (internal_flush): Code for audio bell inserted. * s/msdos.h (INTERNAL_TERMINAL): Allow audio bell. * msdos.c (dos_rawgetc): Doc fix. Make C-, S-, and M- modifiers independent. Make modifiers work with mouse. Improve C-S- handling by using look-up tables. Fix kp-decimal problem. Mon May 23 00:38:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.24 released. * s/hpux8.h (LD_SWITCH_SYSTEM): Put back -Xlinker for GCC. * Makefile.in.in (LIBXT): Move -lXmu before -lXt. * term.c (update_end): Undo previous change. * frame.c (other_visible_frames): No longer static. * window.c (window_loop): Fix test of dedicated flag in prev change. * window.c (window_loop, UNSHOW_BUFFER case): Put prev change in #ifdef MULTI_FRAME. * keyboard.c (menu_bar_one_keymap): When there's no item string, use Qnil. Don't ever put `undefined' into the list of definitions. Sun May 22 16:16:32 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (window_loop, UNSHOW_BUFFER case): Kill a special frame. * xterm.c (x_set_window_size): If cursor outside new size, mark it off. * dispnew.c (change_frame_size): Keep cursor coords in range. * s/linux.h (HAVE_GETTIMEOFDAY, HAVE_MKDIR, HAVE_RMDIR) (HAVE_XSCREENNUMBEROFSCREEN): Define these if not already defined. Sun May 22 16:36:34 1994 Morten Welinder (terra@diku.dk) * unexec.c [MSDOS]: Don't include files from the dos extender and debugger. Use the that was put in the right place a couple of djgpp versions ago. Consequently, use `unsigned short' for `word16' and `unsigned long' for `word32'. Sun May 22 04:22:16 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (note_mouse_highlight): Handle case of highlight extending past end of window. (fast_find_position): Fix bugs when no text on screen and when the mouse is on an empty line. * s/hpux9shr.h: New file. * s/hpux8.h (LD_SWITCH_SYSTEM): Add conditionals for HPUX_USE_SHLIBS. Delete explicit -Xlinker in GCC case. * unexhp9k800.c: Include config.h. [HPUX_USE_SHLIBS]: Include dl.h. (brk_on_dump): New variable. (unexec): Set brk_on_dump. (copy_file): Change buffer size to 8192. * window.c (change_window_height): Test for DELTA too small only after making it smaller based on maxdelta. Sat May 21 19:16:03 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Fdelete_directory): Allow dir names as well as file names. * Makefile.in.in (${etc}DOC): Ignore error from rm. (MSDOS_SUPPORT): New variable. (lisp): Use MSDOS_SUPPORT. * s/freebsd.h (A_TEXT_OFFSET, A_TEXT_SEEK): Commented out. Fri May 20 21:10:58 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xfns.c (x_set_background_color): Set scroll bar backgrounds. Fri May 20 18:57:09 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_wm_set_window_state) [USE_X_TOOLKIT]: Use XtSetValues. (x_iconify_frame) [USE_X_TOOLKIT]: New code for invisible window case. (XtNinitialState) [USE_X_TOOLKIT]: New #define. (x_make_frame_invisible): Mostly combine toolkit/non-toolkit cases, in the process fixing a dumb bug. Fri May 20 12:16:00 1994 Michael I Bushnell (mib@geech.gnu.ai.mit.edu) * lread.c (openp): Only lusers assume that O_RDONLY == 0. Fri May 20 01:28:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (UNEXEC_ALIAS): New variable, used to make the unex...o target. * xfaces.c (Fset_face_attribute_internal): Always return valid data. * textprop.c (syms_of_textprop): Set up Lisp fn get-char-property. Thu May 19 16:57:10 1994 Andreas Schwab (schwab@issan.informatik.uni-dortmund.de) * fileio.c (Finsert_file_contents): Declare buffer as unsigned char. When comparing with file size convert same_at_start to distance to buffer start. If the file matches the buffer contents truncate the buffer to the size of the file. Thu May 19 18:03:26 1994 Jim Blandy (jimb@totoro.bio.indiana.edu) * keyboard.c (read_char_minibuf_menu_prompt): Don't forget to initialize nobindings. Thu May 19 00:11:34 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (ORDINARY_LINK): Define by default if __GNU_LIBRARY__ and not LINUX. * s/isc4-0.h (EXTRA_INITIALIZE): Definition deleted. * s/isc3-0.h (EXTRA_INITIALIZE): Define here. * keyboard.c (lispy_function_keys): Add `backtab'. * frame.c (syms_of_frame): Set up frame-first-window as Lisp fn. * indent.c: Add "args" to dummy definition of compute-motion. * sysdep.c [BROKEN_TIOCGWINSZ]: Undef TIOCSWINSZ too. * Makefile.in.in (FRAME_SUPPORT): Add menu-bar.el. * dispnew.c: Include errno.h. * widget.c (EmacsFrameSetCharSize): Once again preserve x and y pos, but not the same way as before. * xmenu.c (other_menu_bar_item_p): Return 0 if no menu bar. * fileio.c (Fwrite_region): Set update_mode_lines. * xmenu.c (xmenu_show): Don't look in menubar for core.height if no menu bar. * xterm.c (x_iconify_frame): Fix error messages. Wed May 18 01:36:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dispnew.c (PENDING_OUTPUT_COUNT): If __GNU_LIBRARY__, use GNU_LIBRARY_PENDING_OUTPUT_COUNT if defined. * keyboard.c (lispy_function_keys): Add various kp- keys for X11R6. * fileio.c (syms_of_fileio): Doc fix. * s/linux.h (GNU_LIBRARY_PENDING_OUTPUT_COUNT): Both definitions renamed from PENDING_OUTPUT_COUNT. * process.c (create_process): Don't complain about error from TIOCSETD. * window.c (Fset_window_buffer): Fix dedicated window error call. (window_loop, case UNSHOW_BUFFER): Clear dedicated flag. * fileio.c (Finsert_file_contents): Declare `buffer' as unsigned char. * dispnew.c: Include systime.h after xterm.h. * m/tek4300.h (WORDS_BIG_ENDIAN): Define this, not BIG_ENDIAN. * emacs.c (syms_of_emacs), config.h.in: EMACS_CONFIGURATION renamed from CONFIGURATION. Tue May 17 18:57:20 1994 Andreas Schwab (schwab@issan.informatik.uni-dortmund.de) * eval.c (Fbacktrace): Properly nest parentheses. (Fbacktrace_frame): Don't bomb on invalid frame number. Tue May 17 05:41:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (command_loop_1): Fix test for valid display table entry, for backwards motion. * Makefile.in.in (ALL_LDFLAGS): Add LDFLAGS. (MAKE): Don't override a previous value of MAKE set by configure. * dispnew.c (update_frame): Fix test of outq and baud_rate. * emacs.c (shut_down_emacs): Don't call intern. Tue May 17 03:23:39 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.23 released. Tue May 17 00:04:25 1994 Morten Welinder (terra@diku.dk) * msdos.c (gettimeofday): New function substituting the library function of the same name. (init_gettimeofday): New function. (init_environment): Call init_gettimeofday after possibly setting TZ environment variable. * msdos.h: Add template for init_gettimeofday. Mon May 16 23:25:12 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * buffer.c (fix_overlays_in_range): New function. * editfns.c (Ftranspose_regions): Call it. Also update point as if it were a marker. Mon May 16 03:25:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (xmenu_show): Completely ignore nameless panes except for the first pane. Ignore named panes too if KEYMAPS. * widget.c (setup_frame_gcs): Move cursor_bits variable out of setup_frame_gcs and rename to setup_frame_cursor_bits. * eval.c (syms_of_eval): Doc fixes. Sun May 15 00:14:04 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_display_box_cursor): Preserve mouse highlight if the old cursor was in it. * editfns.c (Fcurrent_time_zone): Add cast. * s/bsd386.h (LOCALTIME_CACHE): Defined. * m/pmax.h (LOCALTIME_CACHE): Define, if not OSF1. * xfns.c (validate_x_resource_name): Don't let Vx_resource_name have invalid characters. Sat May 14 20:07:44 1994 Morten Welinder (terra@diku.dk) * msdos.c (crlf_to_lf): Fix off-by-one condition. Sat May 14 02:33:12 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (bind_polling_period): Never decrease polling_period. * fileio.c (Fdo_auto_save): Save listdesc as an integer, only if open. (do_auto_save_unwind): Corresponding changes. * keyboard.c (echo): Don't echo motion events. * fileio.c (Fcopy_file): Close output before setting its times. Close both before discarding the unwind protects. Fri May 13 18:12:44 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * buffer.c (Foverlay_lists): Doc fix. (Fnext_overlay_change): Doc fix. Fri May 13 03:16:47 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (XTread_socket): For button events, clear compose_status. * Makefile.in.in (LIBXTR6): New variable. Test HAVE_X11XTR6. (LIBXT): Use it. * config.h.in (HAVE_X11XTR6): Add #undef. * editfns.c (save_excursion_restore): Don't run activate-mark-hook if mark position is unchanged. * emacs.c (main): PRIO_PROCESS renamed to SET_EMACS_PRIORITY. * callproc.c (child_setup): PRIO_PROCESS renamed to SET_EMACS_PRIORITY. Don't call nice if emacs_priority is positive. * sysdep.c (sys_subshell): PRIO_PROCESS renamed to SET_EMACS_PRIORITY. Don't call nice if emacs_priority is positive. Thu May 12 13:51:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in: Handle Motif and Open-look. (LIBW): New variable. (LIBXT): Use it. * process.c (POLL_FOR_INPUT): Define, if appropriate. Thu May 12 12:17:16 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xdisp.c (display_text_line): Fix check for end of buffer. Thu May 12 02:17:20 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (dumpglyphs): For cursor foreground, try the face's background before the face's foreground. (XTread_socket): Call note_mouse_movement for EnterNotify. * process.c (Fopen_network_stream): Call bind_polling_period; later unbind the binding. * keyboard.c (syms_of_keyboard): Set up Qpolling_period. (bind_polling_period): New function. * callproc.c (init_callproc): Never set Vdata_directory based on the executable's location. But maybe set it from source dir. Wed May 11 18:15:27 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * systty.h [__GNU_LIBRARY__]: Include . Wed May 11 05:17:56 1994 Frederic Pierresteguy (F.Pierresteguy@frcl.bull.fr) * xmenu.c (xmenu_show): New var mb_item. Use it to determine the menubar item that led to the menu. (Fx_popup_menu): Suppress duplicate test case in the way to determine whether the menu is handling a menu bar click. Wed May 11 00:15:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c (Frename_buffer): Reject empty string as new name. Tue May 10 23:54:11 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * process.c (exec_sentinel): Don't deactivate the mark. Check for asynch buffer switch. Tue May 10 20:15:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/bsd4-2.h (BSD): Define as 42. (BSD4_2): Define as 1. This makes it like bsd4-3.h. * floatfns.c: Don't declare logb if it is a macro. Tue May 10 19:36:17 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * keyboard.c (read_char): Preserve echo area on asynch buffer switch. Tue May 10 18:39:40 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * dispnew.c [__GNU_LIBRARY__]: Redefine PENDING_OUTPUT_COUNT even if already defined. Tue May 10 03:24:16 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Finsert_file_contents) [MSDOS]: Ignore the replace feature. * buffer.c (syms_of_buffer): Doc fix. * keyboard.c (syms_of_keyboard): Doc fix. Tue May 10 01:36:31 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * keyboard.c (safe_run_hooks): New function, extracted from command_loop_1. Bind inhibit_quit. Mon May 9 00:51:27 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (string_width): Deleted. * xterm.c (x_set_window_size) [USE_X_TOOLKIT]: Preserve the main widget's x and y position. Sun May 8 17:52:48 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (process_send_signal): If PREFER_VSUSP, use VSUSP instead of VSWTCH. * s/sco4.h (PREFER_VSUSP): Defined. * s/irix5-0.h (PREFER_VSUSP): Defined. * fileio.c (Fdo_auto_save): Write a list of all auto save file names. (Vauto_save_list_file_name): Specify file name to put them in. (syms_of_fileio): Set up Lisp var. Sat May 7 02:29:37 1994 Morten Welinder (terra@diku.dk) * callproc.c [MSDOS]: Rename Vbinary_process to Vbinary_process_output. (syms_of_callproc) [MSDOS]: Rename lisp variable binary-process to binary-process-output. (Fcall_process, syms_of_callproc) [MSDOS]: Use new names. (Vbinary_process_input) [MSDOS]: New variable. (syms_of_callproc) [MSDOS]: Declare binary-process-input. (Fcall_process_region) [MSDOS]: Bind binary-process-input temporarily to buffer-file-type. (init_callproc) [MSDOS]: Don't add lib-src as the wrapped binaries are in bin. Sat May 7 04:37:41 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c (Qbuffer_file_type): Var deleted. * callproc.c (Qbuffer_file_type): Var added. * keyboard.c (read_char): Don't test do_mouse_tracking; instead, do prepare_menu_bars only if commandflag > 1. (read_char): Do call add_command_key for mouse-movement events. Test detect_input_pending, not EVENT_QUEUES_EMPTY, for kbd menus. But don't test either one for mouse menus. * undo.c (record_delete): Record the old point value only right after a boundary. Fri May 6 22:22:24 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/dgux5-4r3.h: Use dgux5-4r2.h under new name. * puresize.h (PURESIZE): Increase to 235000 and 205000. Fri May 6 00:22:18 1994 Morten Welinder (terra@diku.dk) * s/msdos.h: Define NO_MATHERR. * floatfns.c: Don't guard DOMAIN && SING && OVERFLOW check by an #ifndef MSDOS. Fri May 6 19:46:03 1994 Francesco Potorti` (pot@cnuce.cnr.it) * m/delta.h: (SYSTEM_MALLOC): deleted. The problem isn't there. Fri May 6 00:25:30 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_set_offset): Set gravity and size hint before moving the window. * keyboard.c (make_lispy_event): Ignore mouse events for deleted frame. * xterm.c (XTread_socket): For ReparentNotify, use x_top_window_to_frame. Also recompute frame position using x_real_positions. For ConfigureNotify, don't ignore send_events. Also recompute frame position using x_real_positions. Thu May 5 20:59:39 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * window.c: Use PT, not point. (Fdelete_other_windows): Do nothing if w->start is outside region. Don't temporarily move point when recomputing window position. Thu May 5 15:18:27 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (x_real_positions): New function. * keyboard.c (make_lispy_movement): Don't call pixel_to_glyph_coords if FRAME is 0. * xterm.c (x_set_offset): Update XNegative and YNegative for new pos. (x_calc_absolute_position): Clear XNegative and YNegative. * xrdb.c (x_load_resources) [USE_X_TOOLKIT]: Don't call XrmInitialize. * keymap.c (describe_map): Ignore bindings for all except symbols and integers. * unexelfsgi.c (unexec): Handle debugging info properly. * s/freebsd.h: Don't use netbsd.h. Do all those things right here. Thu May 5 01:33:46 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xmenu.c (Fx_popup_menu): Restore accidentally-deleted call to mouse_position_hook. (xmenu_show): Disallow empty menus. Thu May 5 00:03:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (last_point_position_buffer): New variable. (command_loop_1): Set it. * undo.c (record_delete): Test it. * commands.h (last_point_position_buffer): Declared. * Makefile.in.in: Put in a separator for where to start cpp procssing. Above that, use Make-style comments. This goes with changes in ../configure.in. Wed May 4 01:20:45 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/isc4-0.h (NEED_SIOCTL, ISC4_0): Declared. * sysdep.c: Test ISC4_0 along with TIOCGWINSZ. * process.c (wait_reading_process_input): Don't call prepare_menu_bars unless we are going to redisplay for a garbaged frame. (read_process_output): Call prepare_menu_bars if waiting for input. (exec_sentinel): Call prepare_menu_bars if waiting for input. * s/dgux5-4r3.h, s/dgux5-4r2.h: Renamed from ..4R.. * eval.c (error): Fix logic in call to xmalloc/xrealloc. * xterm.c (x_make_frame_invisible): Use XWithdrawWindow again. * s/sol2.h, s/sol2-3.h (LD_SWITCH_SYSTEM): Use ./prefix-args, not -Xlinker directly. Tue May 3 00:21:01 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (x_set_cursor_color): Fix typo. * xselect.c (x_own_selection): Catch errors around XSetSelectionOwner. * buffer.c (syms_of_buffer): Doc fix. * xdisp.c (display_text_line): Since HPOS is negative, avoid writing before the beginning of the charstarts line. * minibuf.c (read_minibuf): Clear previous_echo_glyphs. Mon May 2 19:36:24 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired.c (file_name_completion_stat): Use both lstat and stat. Mon May 2 17:07:56 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xterm.c (show_mouse_face): Fix test for cursor in highlighted area. (note_mouse_highlight): Reorder test for simplicity. (note_mouse_highlight, show_mouse_face, clear_mouse_face, x_destroy_window): Use row/col instead of buffer position to keep track of highlighted area. Mon May 2 19:46:03 1994 Francesco Potorti` (pot@cnuce.cnr.it) * m/delta.h: (SYSTEM_MALLOC): Defined, since GNU malloc does not work. (BCOPY_UPWARD_SAFE): Defined to 0 for the Green Hills compiler. Mon May 2 00:06:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (create_process): Undo April 19 setsid change. Sun May 1 03:32:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.h (struct x_display): New field size_hint_flags. * xfns.c (Fx_create_frame): Set the size_hint_flags field. Don't call x_calc_absolute_position. * xterm.c (x_calc_absolute_position): Use size_hint_flags. New FLAGS arg deleted. Callers changed. * xfns.c (x_figure_window_size): Handle `-' for top or left. (Fx_parse_geometry): Handle one element at a time. Give `-' when appropriate. (x_figure_window_size): Allow just height or just width. * xterm.c (x_wm_set_size_hint): Don't try to handle negative positions. (x_calc_absolute_position): New arg FLAGS. Use XNegative and YNegative. (x_set_offset): Pass new arg. * xfns.c (x_figure_window_size): Set USPosition only if user-position is non-nil; otherwise, if pos is specified, set PPosition. Likewise for USSize and PSize. (Fx_create_frame): Use XNegative and YNegative to set win_gravity. [USE_X_TOOLKIT] (x_window): Use XNegative and YNegative to set win_gravity. Pass new arg to x_calc_absolute_position. * editfns.c (Ftranspose_regions): Take addresses only after move gap. Cast result of alloca. Use xmalloc instead, for large objects. Always copy the middle portion directly; never put it in temp. Always move the gap to START1 or END2, whichever is nearer. * keyboard.c (Ftrack_mouse): Call prepare_menu_bars at the start. (read_char): Don't call prepare_menu_bars if doing mouse tracking. Sat Apr 30 22:08:09 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * puresize.h (PURESIZE) [MULTI_FRAME]: Increase to 232000. Sat Apr 30 19:09:08 1994 Paul Reilly (pmr@churchy.gnu.ai.mit.edu) * s/dgux5-4R3.h: new file. * s/dgux5-4R2.h: new file. * s/dgux.h (SVR4): Make conditional on ELF environment. (INTERRUPT_INPUT, ORDINARY_LINK): Set by default. (C_COMPILER, LINKER and MAKE_COMMAND): Remove. * process.c (IN_ADDR, NUMERIC_ADDR_ERROR): Made conditional on HAVE_BROKEN_INET_ADDR. Sat Apr 30 01:58:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (record_asynch_buffer_change): Block SIGIO. (force_auto_save_soon): Call record_asynch_buffer_change. * emacs.c (memory_warning_signal): Call force_auto_save_soon. * keyboard.c (force_auto_save_soon): New function. * process.c (Fopen_network_stream): Retry the connect if EADDRINUSE. Ignore EISCONN. Fri Apr 29 22:15:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * eval.c (init_eval): Initialize when_entered_debugger to -1. Fri Apr 29 19:21:02 1994 Jim Blandy (jimb@totoro.bio.indiana.edu) * data.c (Ffset, Ffmakunbound): Signal an error if SYM is nil or t. Fri Apr 29 19:12:35 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * data.c, floatfns.c, lread.c [MSDOS]: Re-enable some #undef's. Fri Apr 29 20:07:33 1994 Karl Fogel (kfogel@phylo) * editfns.c (Ftranspose_regions): New function. (transpose_markers): Helper func for above. (syms_of_frame): Call defsubr for Stranspose_regions. Fri Apr 29 05:35:49 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.h (x_mouse_grabbed): Declared. * xmenu.c (xdialog_show): Clear x_mouse_grabbed. * frame.c (Fframe_live_p): Alternative defn for not MULTI_FRAME. (syms_of_frame): Call defsubr for it. * process.c: Doc fixes. * xterm.c (x_wm_set_size_hint): Always set PWinGravity. Rename the args. Compute x and y fields from negative positions. Use XGetWMNormalHints if X11R4 or newer. (x_make_frame_visible): Call x_set_offset only if not USE_X_TOOLKIT. (x_make_frame_invisible): Call x_wm_set_size_hint. (x_set_offset): Pass 0 as 3rd arg to x_wm_set_size_hint. (x_set_window_size): Likewise. Set win_gravity field here if nec. * xfns.c (Fx_create_frame): Pass 0 as 3rd arg to x_wm_set_size_hint. (x_figure_window_size): Fix typo setting XNegative. * minibuf.c (Fminibuffer_complete): Add third arg to Fset_window_start. * buffer.c (init_buffer_once): Initialize buffer_file_type field right. * m/dos386.h (HAVE_MOUSE): Defined. (PURESIZE): Increase value. * xdisp.c (decode_mode_spec): Fix handling of `%t'. * msdos.c, dosfns.c: Finish downcasing mouse_init1, mouse_off, mouse_check_moved, mouse_pressed, mouse_released, mouse_on, mouse_init. * dispnew.c (update_frame): Fix previous change: Unconditionally bzero at the end. Fri Apr 29 00:38:09 1994 Morten Welinder (terra@diku.dk) * msdos.c (visible_bell): Now static. Make the asm volatile. Don't expect register %gs to survive calls to other functions (just to be safe, %gs will survive at present). * keyboard.c (make_lispy_movement): if HAVE_MOUSE then include the mouse handling code. * msdos.c (glyph_to_pixel_coords, pixel_to_glyph_coords) new functions imitating those in xterm.c. * s/msdos.h (getppid): Definition deleted. * msdos.c (dos_rawgetc): Key numbers are biased by 0xff00. * dosfns.c (Fmode25, Fmode4350): Clean up the coding and return a well-defined value. (syms_of_dosfns): Doc fix. Fri Apr 29 01:16:04 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * keymap.c (Fsingle_key_description): Undo previous change. (describe_map): Skip string entries. * minibuf.c (do_completion): Initialize vars before gcpro. Fri Apr 29 00:03:50 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dispnew.c (update_frame): Move those assignments even farther down. * xterm.c (x_wm_set_size_hint): Don't set PMaxSize. Don't touch win_gravity field if no PWinGravity. Thu Apr 28 22:51:04 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * print.c: Doc fixes. * keymap.c (describe_map_tree, describe_buffer_bindings): gcpro stuff. (describe_buffer_bindings): Delete unused code. Thu Apr 28 21:05:23 1994 Per Abrahamsen (abraham@research.att.com) * keymap.c (Fsingle_key_description): Accept strings as keys since the buffer menu uses them. Thu Apr 28 14:12:32 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dispnew.c (update_frame): Move assignments to current_frame and desired_frame. * floatfns.c (logb): Test HPUX, not hpux. * s/sunos4-1.h (LIBS_SYSTEM): #if 0'd. * xmenu.c (Fx_popup_menu): Doc fix. * xfns.c (x_window) [USE_X_TOOLKIT]: Call XSetWMHints. Thu Apr 28 09:05:09 1994 Michael D. Ernst (mernst@monozygote.research.microsoft.com) * fileio.c (inhibit-file-name-handers): Correct documentation. Thu Apr 28 02:13:28 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xterm.c (XTread_socket): Only top window cares about LeaveNotify. * frame.c (Fframe_parameters) [!MULTI_FRAME]: Unstub it again. Thu Apr 28 00:35:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacs.c (syms_of_emacs): Doc fix. * callproc.c (child_setup): Test PRIO_PROCESS, as in sys_subshell. * m/hp800.h: Renamed from hp9000s800.h. (hp9000s800): Undo previous change. * process.c (create_process): If vfork fails, close forkin and forkout. Wed Apr 27 22:33:41 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_make_frame_visible): Use XtMapWidget, not XtPopup. * m/hp9000s800.h (hp800): Define this instead of hp9000s800. * Makefile.in.in (mostlyclean): Remove liblw.a. * lread.c (read1): Allow `\C- ' and `\C-?'. Wed Apr 27 15:15:51 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * unexmips.c (unexec): Cast pointers. Fix error message. * Makefile.in.in: Use C-style comments. * frame.c (Fframe_parameters) [!MULTI_FRAME]: Replace with stub. (Fframe_parameters, Fmodify_frame_parameters) [!MULTI_FRAME]: Remove extra docstring. Wed Apr 27 00:46:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sunos4-0.h (LD_SWITCH_SYSTEM): Undo previous change. * xterm.c (XTread_socket, case ClientMessage): Don't call XSetInputFocus if event is not for an existing frame. * xmenu.c (xmenu_show, xdialog_show): If we unread some events, set interrupt_input_pending. * xterm.c (XTread_socket) [USE_X_TOOLKIT]: Never pass motion events to the toolkit. * CONFIGURATION now comes via config.h. * Makefile.in.in (emacs.o): Use the default .c.o command. (configuration): Make variable deleted. * config.h.in (CONFIGURATION): Add #undef. * xterm.c (XTread_socket) [USE_X_TOOLKIT]: Undo previous change. (x_wm_set_size_hint): Do set max_height, max_width, and PMaxSize flag. Tue Apr 26 17:15:45 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * process.c (create_process) [HAVE_TERMIOS && LDISC1]: Use tcsetattr. Tue Apr 26 05:28:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * alloc.c (mark_object, case frame): Mark menu_bar_vector field. Mon Apr 25 18:04:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (Vunread_command_events): Renamed from unread_command_events. All uses changed. * command.h (Vunread_command_events): Renamed. * lread.c (read_filtered_event): Use Vunread_command_events. * minibuf.c (temp_echo_area_glyphs): Use Vunread_command_events. * keyboard.c (read_char): Don't use menus if we have events waiting. * xterm.c (XTread_socket) [USE_X_TOOLKIT]: Let toolkit handle menu bar click. Mon Apr 25 16:29:45 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * insdel.c: Use PT, not point. (gap_left, gap_right, adjust_markers): Make these functions static. (adjust_point): New function. (insert_1, insert_from_string_1, del_range_1): Use it. * xterm.c (x_term_init): Add explicit cast. (XTmouse_position): Don't use last_mouse_frame if it's dead. (XTread_socket): Ditto. * textprop.c (F*_property_change): Typecheck limit argument. Mon Apr 25 00:11:16 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xdisp.c (syms_of_xdisp): Set up Qmenu_bar_update_hook. (update_menu_bar): Run that hook. Fix failure to update menu bar when w->update_mode_line was nil. * frame.h (struct frame): New fields menu_bar_vector and menu_bar_items_used. * frame.c (make_frame): Initialize fields menu_bar_vector and menu_bar_items_used. * keyboard.c (menu_bar_item): Put a list of keymaps into the third slot of an item in menu_bar_items_vector. Sun Apr 24 01:13:32 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Finsert_file_contents): Fix accessing buffer_file_type since it is t or nil. Change to handle t or nil as value of find-buffer-file-type. * buffer.c (Fkill_all_local_variables): Doc fix. Sat Apr 23 12:32:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (create_process): Use SETUP_SLAVE_PTY only if pty_flag. Likewise for child_setup_tty. * window.c (Fselect_window): Use Fselect_frame. * frame.c (Fset_frame_selected_window): New function. (syms_of_frame): Set up Lisp function. * lisp.h (Vascii_canon_table, Vascii_eqv_table): Declared. * buffer.c (reset_buffer_local_variables): Use Vascii_eqv_table and Vascii_canon_table. * window.c: Implement special frames for specified buffers. (Vspecial_display_buffer_names, Vspecial_display_regexps) (Vspecial_display_function): New variables. (syms_of_window): Set up Lisp variables. (Fdisplay_buffer): Handle them. Fri Apr 22 20:04:41 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (alloca.o): Use config_h. (config_h): Use M_FILE and S_FILE. (S_FILE, M_FILE): New variables hold names of config files. * fileio.c (syms_of_fileio): New Lisp var inhibit-file-name-operation. (Ffind_file_name_handler): Obey that variable. Use new meaning for inhibit-file-name-handlers. * config.h.in (HAVE_LIBRESOLV): Add #undef. * s/sunos4-1.h (LIBS_SYSTEM): Test HAVE_LIBRESOLV, not HAVE_RES_INIT. Do not test HAVE_GETHOSTNAME. * s/sunos4-1.h (LIBS_SYSTEM): Invert the HAVE_RES_INIT condition. Fri Apr 22 19:55:22 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * fileio.c (Ffind_file_name_handler): New argument OPERATION. All callers changed. Fri Apr 22 16:00:24 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (max_process_desc): New variable. (wait_reading_process_output): Don't look for process output beyond that many bits. (create_process, Fopen_network_stream, deactivate_process): Update it. (init_process): Initialize it. * frame.c (Fmouse_pixel_position, Fset_mouse_pixel_position): New functions. (syms_of_frame): Set up Lisp functions. * xterm.c (x_set_mouse_pixel_position): New function. Thu Apr 21 18:56:10 1994 Simon Leinen (simon@lia.di.epfl.ch) * process.c (send_process): If fpathconf fails, use 250. Thu Apr 21 00:34:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacs.c (init_cmdargs): Check only for etc and lib-src subdirs when setting Vinstallation_directory. (syms_of_emacs): Make Lisp vars invocation-name, invocation-directory and installation-directory. * lread.c (init_lread): Maybe put build-time Lisp dirs on load-path. * callproc.c (init_callproc): Set Vdoc_directory like Vdata_directory. * lread.c (init_lread): Improve warning message. * xterm.c (x_make_frame_visible): Args to x_set_offset were swapped. Wed Apr 20 16:38:41 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xterm.h (x_top_window_to_frame): Declare this function. Wed Apr 20 10:20:10 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fns.c: Doc fixes. * Makefile.in.in (TAGS): Split off included tags file lisp/TAGS. (../lisp/TAGS): New target uses recursive make. (ctagsfiles, lisptagsfiles): New variables. * xfns.c (x_window): Test FRAME_EXTERNAL_MENU_BAR to decide on calling initialize_frame_menubar. Wed Apr 20 12:52:15 1994 Francesco Potorti` (pot@fly.cnuce.cnr.it) * m/delta.h (HAVE_SOCKETS): defined if HAVE_INET_SOCKETS is defined. Wed Apr 20 04:32:47 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.c (Fmodify_frame_parameters, Fframe_parameters): Define even if not MULTI_FRAME. * config.h.in (HAVE_INET_SOCKETS): Add #undef. * xterm.c (XTread_socket): Delete the non-NEW_SELECTIONS code and simplify the toolkit conditional for those cases. * xterm.c (XTread_socket, case ClientMessage): Always use x_window_to_frame. * xfns.c (x_top_window_to_frame): New function. Tue Apr 19 23:23:07 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (create_process): Call setsid only if pty_flag. * xterm.c (x_make_frame_invisible): Explicitly clear visible and iconified flags, as well as the async flags. Tue Apr 19 20:23:52 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * keymap.c (describe_map): Merge with describe_map_2. (describe_map_tree, describe_map): Skip keymaps we've seen before. * keyboard.c (read_avail_input): Don't retry read. Tue Apr 19 17:45:16 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (Vlast_event_frame): Define unconditionally. (syms_of_keyboard): Always make the Lisp var. * Makefile.in.in (${etc}DOC): Delete redundant version.el from cmd. Tue Apr 19 00:16:34 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * keyboard.c (read_avail_input): Test EINTR, not EAGAIN. Write loop as a do-while. * puresize.h (PURESIZE) [!MULTI_FRAME]: Increase to 200000. Mon Apr 18 19:27:05 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (XTread_socket): Call XSetInputFocus. Mon Apr 18 18:38:51 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * config.h.in: (EMACS_INT, EMACS_UINT): Omit if NOT_C_CODE. Mon Apr 18 13:40:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * mem-limits.h (get_lim_data): Handle NO_LIM_DATA. * xterm.c (x_make_frame_invisible) [USE_X_TOOLKIT]: Use XtPopdown. (XTread_socket): Call _XEditResCheckMessages only if HAVE_X11R5. * m/convex.h (CRT0_DUMMIES): Ignore one arg. (LIBS_TERMCAP): Use the system's termcap. * process.c (create_process): Fix previous change. Sun Apr 17 03:33:18 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (Xatom_editres_name): Declared. (Fx_open_connection): Initialize it. * xterm.c (Xatom_editres_name): Variable defined. (XTread_socket): Handle that kind of message. (x_term_init): Specify -name option in XtAppInitialize. * xterm.c (Qface, Qmouse_face): Supply missing Lisp_Object. * config.h.in (EMACS_INT, EMACS_UINT): New typedefs. * casetab.c (set_case_table): Handle nil for EQV with non-nil CANON. (Fcase_table_p): Accept nil for EQV with non-nil CANON. * keyboard.c (read_avail_input): Test both aix386 and _BSD. * window.c (set_window_width): Don't delete root window for being too narrow. * xterm.c (dumpglyphs): When HL=2, check explicitly for using the frame's default font or not. * keyboard.c (read_char_x_menu_prompt): Don't check for value = nil if value was originally a cons. * xmenu.c (xmenu_show): Fix typo in last change. Sat Apr 16 02:50:27 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * frame.c (Fmouse_position): Don't clip. * keyboard.c (make_lispy_movement): Don't clip. Sat Apr 16 00:50:41 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/netbsd.h: Add NO_SHARED_LIBS conditional. * s/freebsd.h: Rewrite to use netbsd.h and define NO_SHARED_LIBS. * keyboard.c (read_avail_input): Fix previous change--test _BSD. * data.c (Fsetq_default): Doc fix. * eval.c (Fsetq): Doc fix. * Makefile.in.in (configuration): Use SET_MAKE to get the value of $(MAKE). Fri Apr 15 17:38:30 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.h (map_prompt): Declared. * xmenu.c (xmenu_show): Don't cons on subprefix_stack[j] if nil. * keyboard.c (read_avail_input): Don't generate SIGHUP of aix386; only on other AIX systems. * xterm.c (XTread_socket): For UnmapNotify, use x_any_window_to_frame. * process.c (create_process): Test TIOCSETD along with NTTYDISC. * frame.c (Fset_frame_position): Pass new arg to x_set_offset. * xterm.c (x_set_offset): New arg CHANGE_GRAVITY. (x_make_frame_visible): Pass new arg. * xfns.c (Fx_create_frame): Delete excess args to x_wm_set_size_hint. * xterm.c (x_wm_set_size_hint): Args spec_x and spec_y deleted. (x_set_offset, x_set_window_size): Don't pass those args. * fileio.c (Finsert_file_contents): Fix test for unchanged file. * xterm.c (x_destroy_window): Just clear out mouse_face... vars. * keyboard.c (syms_of_keyboard): Init and staticpro system_key_syms. (modify_event_symbol): Use the cdr of the alist entry. Whenever value is nil, intern a new symbol. * Makefile.in.in (LIBX): Put LIBXT after LD_SWITCH_X_SITE. Fri Apr 15 15:11:10 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xdisp.c (fix_glyph) [HAVE_X_WINDOWS]: When glyph face is 0, use the computed face as given. * keyboard.c (read_avail_input): Fix comment delimiter. * m/pmax.h (C_SWITCH_X_MACHINE): add -DNeedVarargsPrototypes=0. Thu Apr 14 21:03:23 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * scroll.c (calculate_scrolling): Add explicit casts. Thu Apr 14 00:45:53 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_wm_set_size_hint): Use win_gravity from frame. * xterm.h (x_display): New field win_gravity. * xfns.c (Fx_create_frame): Set win_gravity field. * xfns.c (x_window, both versions): Don't call x_calc_absolute_position. * xterm.c (x_make_frame_visible): Call x_set_offset. * xterm.c (x_make_frame_visible): Don't call XMapSubwindows. (x_iconify_frame): Likewise. * s/isc4-0.h (LIBS_SYSTEM): Defined. * keyboard.c (make_lispy_event): Put mouse event code into MULTI_FRAME conditional. * xfns.c (Fx_list_fonts): Error if non-X frame used. * xdisp.c (update_menu_bar): Take frame as arg. (update_menu_bars): Function deleted. (prepare_menu_bars): Call update_menu_bar; do it for all frames. Simplify computation of all_windows; ignore irrelevant criteria. * xterm.h (HAVE_X11R4): If we define HAVE_X11R5, define this too. * xterm.c (pending_autoraise_frame): New variable. (x_new_focus_frame): Don't autoraise here; just set that var. (XTread_socket): Raise that frame here. Wed Apr 13 17:19:30 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacs.c (inherited_pgroup): Conditionalize on BSD_PGRPS. * s/netbsd.h (TABDLY): Defined. * doc.c, fileio.c, unexsunos4.c [HAVE_UNISTD_H]: Include unistd.h. * dired.c (Ffile_attributes): Cast st_size to int. * xmenu.c (last_menu_bar_item_end): New variable. (xmenu_show): Set that var. (other_menu_bar_item_p): Return 0 if mouse is not in any menu bar item. * keymap.c (describe_map_tree): Fix call to Flookup_key. * xfns.c (x_window): Don't call initialize_frame_menubar if no menu bar. (Fx_create_frame): Default menu-bar-lines parm before calling x_window. Wed Apr 13 13:59:32 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * dispnew.c (Vglyph_table): Doc fix. * frame.c (Fmouse_position) [MULTI_FRAME]: Use pixel_to_glyph, not glyph_to_pixel. Skip the conversion if args are nil. [!MULTI_FRAME]: All results are nil. Remove extra docstring. * window.c (Fnext_window, Fprevious_window, Fdisplay_buffer): Test MULTI_FRAME when frame-walking. (Fset_window_configuration): Only call X fns if HAVE_X_WINDOWS. * fns.c (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU in popup code. Wed Apr 13 02:20:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * indent.c (compute_motion): Do not abort if window shows some other buffer. (Fcompute_motion): Use whatever buffer is current. Tue Apr 12 12:02:07 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/bsd4-2.h (BSD): Give it a number as definition. * s/sol2-3.h: Fix #include file name. * xterm.c (x_destroy_window): Call clear_mouse_face if necessary. * xmenu.c (xmenu_show, xdialog_show): Add casts in assignments to widget_value fields from string contents. (dispatch_dummy_expose): Cast arg to XtDispatchEvent. [!USE_X_TOOLKIT] (xmenu_show): Right-justify char equivalents. Use alloca for concatenated strings, if alloca is fast. * lisp.h (Fprocess_send_eof, Foverlay_get): Declared. * keymap.c (Fkey_binding): Declare accept_default. * sysdep.c (sys_siglist) [sun]: Check SIGFREEZE and SIGTHAW defined. Tue Apr 12 00:53:28 1994 Per Bothner (bothner@cygnus.com) Provide a hook for elisp to signal a changed window size to a process inferior. * sysdep.c (set_window_size): New function. * process.c (Fset_process_window_size): New function. Tue Apr 12 00:39:12 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * eval.c (specbind): Use find_symbol_value. * xfaces.c (frame_update_line_height): Don't call x_set_window_size. Return 1 if line_height changed. (Fset_face_attribute_internal): Call x_set_window_size here if nec. * xterm.c (x_new_font): Always call x_set_window_size. * xmenu.c (xmenu_show) [USE_X_TOOLKIT]: Use XtTranslateCoords. * process.c (send_process): Test pty_flag field for nil, not 0. Mon Apr 11 18:40:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sunos4-0.h (LD_SWITCH_SYSTEM): Alternate definition if __GNUC__. * callproc.c: If we include fcntl.h, define INCLUDED_FCNTL. * systty.h: Check for INCLUDED_FCNTL already defined. * xterm.c (x_wm_set_size_hint): If PROMPTING is 0, copy the old win_gravity field. If USPosition is set, don't set PWinGravity. * keyboard.c (read_avail_input): Separate local var n_to_read so that reading doesn't clobber that info when it sets nread. * s/isc4-0.h (LIBS_SYSTEM): Defined. * emacs.c (main): Fix typo in prev. change. * Makefile.in.in (temacs): Include ${ALL_LDFLAGS} within the call to YMF_PASS_LDFLAGS. Mon Apr 11 17:41:56 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * keyboard.c (make_lispy_event): Initialize item. * indent.c (vmotion): Use minibuf_prompt_width despite window-start. * print.c (printchar, strout): Use FRAME_PTR, not struct frame *. * frame.c (Fmouse_position) [!MULTI_FRAME]: Declare col and row. Mon Apr 11 17:09:46 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (make_lispy_movement): Conditionalize on MULTI_FRAME. (kbd_buffer_get_event): Call make_lispy_movement only if MULTI_FRAME. * xselect.c (x_decline_selection_request): Call XFlushQueue. * eval.c (Fsetq): Doc syntax fix. * print.c (syms_of_print): Doc syntax fix. * editfns.c (Fuser_real_login_name): Doc syntax fix. * data.c (Fsetq_default, Fmake_local_variable): Doc syntax fix. Sun Apr 10 15:15:08 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_wm_set_size_hint): If change_gravity is 0, just don't set the gravity. Sat Apr 9 01:02:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (dumpglyphs): Clear any extra pixel rows below the text. * xfns.c (x_figure_window_size): Don't call x_calc_absolute_position. (x_window): Separate into two alternative definitions. Call x_calc_absolute_position here. * widget.c (EmacsFrameSetCharSize): Do not attempt to preserve the window position. * xfns.c (Fx_list_fonts): Doc fix. * buffer.c (Vafter_change_functions, Vbefore_change_functions): New variables. (syms_of_buffer): Set up Lisp vars. * buffer.h (Vafter_change_functions, Vbefore_change_functions): Declared. * insdel.c (before_change_functions_restore): (after_change_functions_restore): New functions. (signal_before_change): Handle Vbefore_change_functions. (signal_after_change): Handle Vafter_change_functions. * cmds.c (internal_self_insert): Test Vafter_change_functions, Vbefore_change_functions. * xfaces.c (frame_update_line_height): Check param_faces[i] not null. * emacs.c (main): Handle EXTRA_INITIALIZE. * s/isc4-0.h: New file. * keymap.c (get_keymap): Pass 1 as ERROR to get_keymap_1. (get_keyelt): New arg AUTOLOAD means load keymaps indirected thru. All callers changed; most pass 0. (Fdefine_key, Flookup_key): Load all the keymaps we look in. * editfns.c (make_buffer_string): Copy properties whenever we have some, even if they don't change. * xterm.c (x_display_box_cursor): Explicitly clear full height of line. (dumpglyphs): New arg just_foreground. Callers changed. (x_set_window_size): Call XSync. * xterm.c (note_mouse_highlight): Do nothing if buffer has changed. * xterm.c (x_new_font): Fix setting line_height. * Support fonts of different heights, using tallest as line height: * xfaces.c (frame_update_line_height): New function. (Fset_face_attribute_internal): Call that. * xterm.c (x_new_font): If frame is new, set line_height field. Otherwise call frame_update_line_height. * xterm.h (struct x_display): New field line_height. (VERTICAL_SCROLL_BAR_PIXEL_HEIGHT, PIXEL_TO_CHAR_ROW) (CHAR_TO_PIXEL_ROW): Use line_height field. * xterm.c (stufflines, scraplines, dumprectangle, x_do_pending_expose) (pixel_to_glyph_coords, x_draw_box, clear_cursor, x_display_bar_cursor) (x_set_resize_hint, x_set_mouse_position, x_wm_set_size_hint) (XTclear_end_of_line, redraw_previous_char): Use line_height field. * xfns.c (x_char_height): Use line_height field. * widget.c (get_default_char_pixel_size): Use line_height field. * dispnew.c (update_line): Use line_height field. * xmenu.c (Fx_popup_menu): Use line_height field. Sat Apr 9 00:14:18 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * indent.c (Fvertical_motion): Use window arg, not selected_window. Fri Apr 8 11:47:03 1994 Frederic Pierresteguy (fp@hal.gnu.ai.mit.edu) * xterm.c (show_mouse_face): Change the mouse cursor accordingly. * xterm.h (cross_cursor): New field for struct x_display. * xfns.c (syms_of_xfns): Define Vx_cross_pointer_shape. (Vx_cross_pointer_shape): New variable. (Vx_cross_pointer_shape): Create a mouse face cursor for the mouse-face properties. Fri Apr 8 00:37:05 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (Fx_popup_dialog): Doc fix. (list_of_items): Handle nil in item list as left/right boundary. (push_left_right_boundary): Record the boundary. (xmenu_show): Disregard a boundary if any. (xdialog_show): Really obey a boundary. Thu Apr 7 20:40:41 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * intervals.h (Qintangible): New symbol, replacing Qhidden. * textprop.c (syms_of_textprop): Initialize it. * intervals.c (set_point): Skip past intangible regions. * term.c (system_uses_terminfo): New variable. (syms_of_term): New function, to initialize it. * emacs.c (main): Call syms_of_term. * termhooks.h (enum event_kind): Add buffer_switch_event. * keyboard.c (kbd_buffer_get_event): Make it lispy. (record_asynch_buffer_change): New. Store it in the event queue. * process.c (read_process_output): If buffer changes, record that fact. * minibuf.c (Vminibuffer_exit_hook): New variable. (read_minibuf): Run hook when exiting minibuffer. * xdisp.c (copy_part_of_rope): Replace non-glyph with 0. * insdel.c (insert_1): New function, extracted from insert. (insert_from_string_1): Likewise, taken from insert_from_string. (insert, insert_from_string): Call the new functions. (insert_before_markers, insert_from_string_before_markers): Adjust the markers before calling the after-change function. Thu Apr 7 02:25:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * scroll.c (struct matrix_elt): Use int, not short. Use unsigned char for insertcount and deletecount. (INFINITY): Increase to 1000000. Wed Apr 6 22:01:50 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * minibuf.c (Fminibuffer_prompt_width): Undo previous change. * xdisp.c (display_text_line): minibuffer_prompt_width is a distance, not an absolute position. * editfns.c (Fformat): Reword confusing error message. * doprnt.c (doprnt): Likewise. * eval.c (Fsetq): Doc fix. Tue Apr 5 18:52:30 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xdisp.c (display_string): Allow for hpos < 0 when clearing array. * indent.c (vmotion): Don't use minibuf_prompt_width if window-start has suppressed the prompt. * minibuf.c (Fminibuffer_prompt_width): Allow for negative value. * buffer.c (Fget_buffer_create): Disallow empty string. * keymap.c (describe_buffer_bindings): Move XSYMBOL to after SYMBOLP. Exclude trailing null in string copies. * indent.c (compute_motion): Add window argument. All callers changed. * minibuf.c (do_completion): gcpro some things. * minibuf.c, xdisp.c: Use PT, not point. Mon Apr 4 22:45:58 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * textprop.c (Fget_char_property): Doc fix. * dired.c (file_name_completion): Honor completion-regexp-list. * search.c (Freplace_match): Don't capitalize unless all matched words are capitalized. * buffer.c (verify_overlay_modification): Run modification-hooks for any deletion that intersects the overlay. Mon Apr 4 01:28:18 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Fdo_auto_save): Don't turn off auto save mode. Instead, store -1 in b->save_length. And don't auto save if there is -1 there. * xterm.c (note_mouse_highlight): Temporarily widen the buffer. * xdisp.c (display_text_line): Rename startp to leftmargin. Use that, not p1start, when checking for char off left edge. * dispnew.c (verify_charstarts): Handle truncation of lines. * xdisp.c (mark_window_display_accurate, redisplay): Set window_end_valid to the buffer displayed, not Qt. * xterm.c (note_mouse_highlight): Check window still shows that buffer. Sun Apr 3 15:02:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (show_mouse_face): Turn off cursor only if it's in the area being manipulated. (XTupdate_begin): Don't turn off highlight if we aren't updating the window that it is in. * buffer.c (overlays_at): Fix previous change. * lisp.h (gc_in_progress): Declared. * xterm.c (note_mouse_highlight): Do nothing if gc_in_progress. Set mouse_face_deferred_gc when that case arise. (XTframe_up_to_date): If mouse_face_deferred_gc, redo highlighting. * xdisp.c (display_text_line): Properly handle charstarts for hscroll, and for continuation in mid character. (message2): Call frame_up_to_date_hook. * xterm.c (undefer_mouse_highlight, defer_mouse_highlight): New fns. * alloc.c (Fgarbage_collect): Call ..._mouse_highlight. * buffer.c (overlays_at): Use XGCTYPE. * buffer.h (OVERLAY_POSITION): Use XGCTYPE. * xmenu.c (Fx_popup_dialog): If POSITION is t, use selected frame. Sat Apr 2 03:40:12 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xdisp.c (redisplay): do_verify_charstarts controls whether to call verify_charstarts. Fix one-off when checking for the last line. * xterm.c (note_mouse_highlight): Reject out-of-range pos value before it causes an error. * dispnew.c (verify_charstarts): Count right for continued lines. (direct_output_for_insert): Add charstarts entry after the new char. Use the right point value for the inserted character. * xdisp.c (display_text_line): Always store in charstart even if at endp. When clearing charstart, do the whole width. * dispnew.c (scroll_frame_lines): When updating charstarts, treat all columns alike--don't zero out any. Fix end tests of loops over i. (adjust_window_charstarts): Fix typo. * xterm.c (fast_find_position): Always return coords within the window. * xdisp.c (redisplay): Call verify_charstarts. * dispnew.c (verify_charstarts): New function. * xdisp.c (redisplay): Don't call adjust_window_charstarts if on last text line of window. * xterm.c (note_mouse_highlight): Handle disable_mouse_highlight. Fri Apr 1 22:54:01 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * buffer.c (list_buffers_1): Set buffer contents, then mode. Fri Apr 1 14:15:57 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dispnew.c (scroll_frame_lines): Fix previous changes. Fri Apr 1 08:06:29 1994 Frederic Pierresteguy (fp@hal.gnu.ai.mit.edu) * xterm.c (x_wm_set_size_hint): Add USE_X_TOOLKIT conditional and call XtGetValues to get the width and the height of the Emacs frame. * xdisp.c (update_menu_bar): Pass 0 to set_frame_menubar. * widget.c (EmacsFrameSetCharSize): Clean up code. Replace XtVaSetValues by XtSetValues. Fri Apr 1 03:08:23 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (construct_menu_click, construct_mouse_click): Use XSET when setting result->x and result->y. * xmenu.c (xmenu_show): Undo part of March 11 change: Do call lw_destroy_all_widgets at the end. * dispnew.c (scroll_frame_lines): Typo in previous change. Arg POS_ADJUST replaced with arg NEWPOS. * xdisp.c (try_window_id): Pass new arg to scroll_frame_lines. * xdisp.c (redisplay): In previous change, handle case where no newline follows. * xterm.c (note_mouse_highlight): Use the value from sort_overlays. Make the window's buffer current temporarily. window_end_pos is relative to Z, not ZV. Thu Mar 31 19:07:52 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dispnew.c (adjust_window_charstarts): New function. (direct_output_for_insert): Call it. (make_frame_glyphs): If EMPTY, don't leave junk in ->total_charstarts. * xdisp.c (redisplay): Call adjust_window_charstarts to update the charstarts of following lines. Thu Mar 31 17:18:42 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * callproc.c (child_setup): Check out==err when relocating fds. Thu Mar 31 11:45:48 1994 Frederic Pierresteguy (fp@hal.gnu.ai.mit.edu) * xfns.c (x_window) [USE_X_TOOLKIT]: When doing geometry management, don't compute the size of the menubar if there is no menubar. Thu Mar 31 11:33:04 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (XTread_socket, MotionNotify and LeaveNotify cases): If not in any frame, call clear_mouse_face. Thu Mar 31 08:08:56 1994 Frederic Pierresteguy (fp@geech.gnu.ai.mit.edu) * xterm.h: Define HAVE_X11R4 if AIX3_2 is defined. * xfns.c (x_window) [USE_X_TOOLKIT]: New args window_prompting and minibuffer_only. Don't pass top_pos and left_pos to XtCreatePopupShell. Call initialize_frame_menubar before creating the Emacs frame if it is not the minibuffer. Call XtManageChild for the menubar widget if any. Compute some geometry management. (Fx_create_frame): Pass window_prompting and minibuffer_only to x_window. Don't call x_wm_set_size_hint. Don't call initialize_frame_menubar. * xmenu.c (set_frame_menubar): New arg, first_time. Don't update the menubar the first time it is created via x_window. (initialize_frame_menubar): Pass 1 to set_frame_menubar. * widget.c (set_frame_size): Dont compute any geometry management. Thu Mar 31 03:33:18 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_term_init): Set frame_up_to_date_hook. (XTframe_up_to_date): New function. * termhooks.h (frame_up_to_date_hook): Declared. * term.c (frame_up_to_date_hook): Defined. * xdisp.c (redisplay): Call frame_up_to_date_hook. Wed Mar 30 13:51:05 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * scroll.c (do_scrolling): Handle charstarts like glyphs. * dispnew.c (scroll_frame_lines): Handle charstarts like glyphs. (direct_output_for_insert): Likewise. (preserve_other_columns): Likewise. * systty.h (INCLUDED_FCNTL): Define, if include fcntl.h. * xterm.c [INCLUDED_FCNTL]: Don't include fcntl.h again. Wed Mar 30 00:21:30 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * minibuf.c (Fminibuffer_prompt, Fminibuffer_prompt_width): New funcs. Tue Mar 29 21:29:07 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * indent.c (Fcompute_motion): Doc fix. (Fcompute_motion): Don't use XFASTINT on possibly-negative coords. Tue Mar 29 21:08:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dispnew.c (update_line): Update charstarts like glyphs. Tue Mar 29 19:48:57 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * systime.h (EMACS_TIME_NEG_P): Cast to signed. Tue Mar 29 03:16:38 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (XTupdate_begin): Turn off mouse face display, and defer it. (XTupdate_end): Undefer. (mouse_face_defer): New variable. (mouse_face_mouse_frame, mouse_face_mouse_x, mouse_face_mouse_y): New variables. * xfaces.c (compute_char_face): New arg MOUSE. (Qmouse_face): New variable. (syms_of_xfaces): Initialize Qmouse_face. * xterm.c (dumpglyphs): Handle HL = 3 by using mouse_face_face_id. (note_mouse_movement): Check for mouse face. (show_mouse_face, fast_find_position): New functions. (clear_mouse_face): New functions. (mouse_face_beg, mouse_face_end, mouse_face_face_id): New variables. (mouse_face_window): New variable. (syms_of_xterm): Init and staticpro it. * xdisp.c (display_text_line): Pass new arg to compute_char_face. Fill in charstarts array. (display_string): Clear part of charstarts array. Tue Mar 29 00:57:49 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * window.c (Fwindow_width): Delete unnecessary variable declarations. * indent.c (Fcompute_motion): Typecheck all arguments. Tue Mar 29 00:19:24 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xdisp.c (display_text_line): Fill in charstart values. * dispextern.h (struct frame_glyphs): New fields charstarts and total_charstarts. * dispnew.c (make_frame_glyphs): Initialize charstarts, total_charstarts. (free_frame_glyphs): Free those fields. Mon Mar 28 18:01:48 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xdisp.c (display_text_line): Handle selective display at window edge. * dired.c (file_name_completion): Don't step on dirname. * xterm.c (x_find_modifier_meanings): Skip zero entries. Mon Mar 28 02:12:55 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * dired.c (file_name_completion): Protect things from GC. * buffer.c (verify_overlay_modification): Copy TAIL before a hook, in case the hook recenters the overlay lists. * s/dgux.h (LIBS_SYSTEM): Commented out. Sun Mar 27 02:51:32 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Vinhibit_file_name_handlers): New var. (syms_of_fileio): Set up Lisp var. (Ffind_file_name_handler): Obey the variable. * minibuf.c (Vcompletion_regexp_list): New var. (syms_of_minibuf): Set up Lisp var. (Ftry_completion, Fall_completions): Limit possible completions to strings matching those regexps. * search.c (Freplace_match): Doc fix. Sat Mar 26 02:20:06 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * minibuf.c (read_minibuf): Return val via unbind_to. Fri Mar 25 14:17:19 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * commands.h (this_command, last_command): Declared. * minibuf.c (Fminibuffer_complete): Scroll the completion window in some cases. * print.c (debug_print): New function. * .gdbinit (pr): Use debug_print. Fri Mar 25 01:06:02 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * frame.c (Fframe_first_window): New function. Thu Mar 24 19:29:49 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * editfns.c (Fformat): Validate number and type of arguments. * xmenu.c (xmenu_show): Enable asynchronous events. * keymap.c (Fwhere_is_internal): Skip duplicate keybindings. * xfns.c (x_report_frame_params): Sample visibility. (x_get_arg): Use downcased string in compare. * process.c (status_notify): Use assignment, not initialization. * textprop.c (add_properties, remove_properties): Ditto. * window.c (unshow_buffer, window_loop, Fdisplay_buffer): Ditto. * xdisp.c (x_consider_frame_title, decode_mode_spec): Ditto. * xfns.c (x_set_frame_parameters, x_get_arg, x_window, Fx_create_frame, Fx_create_frame): Ditto. * xselect.c (x_get_local_selection, x_handle_selection_request): Ditto. * xterm.c (x_window_to_scroll_bar, x_new_font): Ditto. Thu Mar 24 02:34:37 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xfns.c (Fx_create_frame): Add USE_X_TOOLKIT conditional around the call to initialize_frame_menubar. Wed Mar 23 23:09:15 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * intervals.c (verify_interval_modification): For insertion in middle of an interval, use the same criterion as between intervals for whether read-only forbids it. Wed Mar 23 15:08:42 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * alloc.c (make_event_array): Use assignment, not initialization. * buffer.c (sort_overlays, Fmake_overlay): Ditto. * callint.c (check_mark, Fcall_interactively): Ditto. * callproc.c (call_process_cleanup, getenv_internal): Ditto. * cmds.c (internal_self_insert): Ditto. * data.c (store_symval_forwarding, Fsymbol_value): Ditto. * fileio.c (Finsert_file_contents): Ditto. * filelock.c (lock_file): Ditto. * frame.c (next_frame, prev_frame, other_visible_frames, Fdelete_frame): Ditto. * intervals.c (adjust_intervals_for_insertion, merge_properties_sticky, delete_interval): Ditto. * keymap.c (access_keymap, store_in_keymap, Fcopy_keymap, Fdefine_key, Faccessible_keymaps, Fwhere_is_internal): Ditto. * lread.c (read_filtered_event, intern): Ditto. * minibuf.c (read_minibuf): Ditto. * msdos.c (run_msdos_command): Ditto. * sysdep.c (reset_sys_modes): Turn off O_NDELAY. * window.c (Fscroll_up, Fscroll_down, Fscroll_other_window): Doc fix. * frame.c (do_switch_frame): Common code for Fselect_frame and handle_switch_frame. * xfns.c (x_get_focus_frame): New function. Wed Mar 23 13:06:24 1994 Frederic Pierresteguy (fp@geech.gnu.ai.mit.edu) * xmenu.c (update_frame_menubar): Function renamed from update_one_frame_psheets. (initialize_frame_menubar): New function. (set_frame_menubar): Call menu_bar_items when items is NIL. * xfns.c (Fx_create_frame): Call initialize_frame_menubar. Wed Mar 23 00:06:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c (reset_buffer): Init auto_save_failure_time slot. Tue Mar 22 23:51:23 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keymap.c: (where_is_string, Fwhere_is): Deleted. (syms_of_keymap): Corresponding changes. Tue Mar 22 16:58:12 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * keymap.c (Fdefine_key): Check for non-events in keyvector. * minibuf.c (read_minibuf): Don't redirect focus unless minibuf is on another frame. * lread.c (read1): Check for invalid modifier bits in a string. (unreadchar): Don't back up the pointer when unreading EOF. Tue Mar 22 13:30:49 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * callproc.c (Fcall_process): Make sure to close descriptors. (call_process_cleanup): Always close descriptor. Tue Mar 22 09:35:36 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * widget.c (set_frame_size): Put #if 0 around a lot of useless code. Compute explicitely the geometry of the toplevel widget. Call XtSetValues not XtVaSetValues. Tue Mar 22 00:18:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacs.c (__do_global_ctors, __do_global_ctors_aux) (__do_global_dtors): Don't define if GCC_CTORS_IN_LIBC. (__CTOR_LIST__, __DTOR_LIST__): Likewise. Mon Mar 21 23:23:09 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (init_keyboard): Don't handle SIGINT if using X. Mon Mar 21 20:20:21 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * keyboard.c (add_command_key): Use assignment, not initialization. (command_loop_1, read_char, kbd_buffer_store_event, kbd_buffer_get_event, make_lispy_event, make_lispy_movement, apply_modifiers_uncached, parse_modifiers, apply_modifiers, reorder_modifiers, read_key_sequence): Ditto. Mon Mar 21 19:11:33 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * data.c (Qwholenump): New variable. (syms_of_data): Set and gcpro Qwholenump. * lisp.h (Qwholenump): Declared. (CHECK_NATNUM): Use Qwholenump. Mon Mar 21 17:43:49 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * keymap.c (Fcopy_keymap): Account for menus and equiv-key cache. (Fkeymapp): Doc fix. Mon Mar 21 01:56:39 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * data.c (Fstring_to_number): Doc fix. Sun Mar 20 20:38:15 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * data.c (Fmake_local_variable): Void variables stay void. Sun Mar 20 00:27:55 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * alloca.c, alloca.s, gmalloc.c: Make them symlinks again. * fns.c (Fy_or_n_p, Fyes_or_no_p): Call Fx_popup_dialog the new way. (Fyes_or_no_p): Always display just one dialog box whether or not USE_X_TOOLKIT. Sat Mar 19 00:34:21 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (xdialog_show): Delete args x, y. (Fx_popup_dialog): Don't pass those args; don't compute them. Second arg is now just one pane. Lots of simplification. Always start by decoding POSITION arg to get a frame. [! USE_X_TOOLKIT]: Put the menu in middle of that frame. * s/freebsd.h (HAVE_TERMIOS, NO_TERMIO): Defined. * Makefile.in.in (emacs): rm emacs before the ln. (tagsfiles): Accept capital letters. * process.c (wait_reading_process_input, both versions): Don't call redisplay_preserve_echo_area unless do_display. * emacs.c (syms_of_emacs): Don't initialize Vinstallation_name and Vinstallation_directory. * fns.c (Fyes_or_no_p) [USE_X_TOOLKIT]: Display just one menu. * xmenu.c (Fx_popup_dialog, Fx_popup_menu): Require 2 args. (Fx_popup_dialog): Don't fail to set X, Y from POSITION. (xdialog_show): Call lw_modify_all_widgets properly. Generate dialog's name at run time to specify number of buttons. Report error if too many buttons to handle or if multiple panes. Fri Mar 18 21:35:32 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * lisp.h (MAKE_GLYPH, GLYPH_CHAR, GLYPH_FACE): Handle termcap frames as well as X. (FAST_MAKE_GLYPH, FAST_GLYPH_CHAR, FAST_GLYPH_FACE): New macros. * xdisp.c (fix_glyph): Handle termcap frames as well as X. (display_text_line, copy_part_of_rope, display_mode_line): Ditto. * dispnew.c (direct_output_for_insert): Ditto. * xterm.c (dumpglyphs): Use the fast macros. Fri Mar 18 01:57:20 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (list_of_items): Arg to push_menu_item was missing. Fri Mar 18 01:27:10 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * Makefile.in.in (LIBXT): Add -lXext. Fri Mar 18 00:19:14 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * s/netbsd.h (LD_SWITCH_SYSTEM): Undo previous change. Thu Mar 17 23:18:01 1994 Jim Blandy (jimb@totoro.bio.indiana.edu) * indent.c (compute_motion): Doc fixes. Thu Mar 17 22:21:51 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * Makefile.in.in (X_WINDOWS_SUPPORT): New macro. (lisp): Include X_WINDOWS_SUPPORT. Also add version.el; it is no longer changed by building. Thu Mar 17 17:37:52 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * process.c (create_process): Skip the ioctl if fd is -1. * lread.c (openp, Fload): GCPRO some things. * callproc.c (Fcall_process): Ditto. * process.c (Fstart_process): Ditto. * s/netbsd.h (LD_SWITCH_SYSTEM, HAVE_WAIT_HEADER): Define these. Wed Mar 16 17:42:50 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * data.c (Fchar_or_string_p, Fintegerp, Fnatnump): Doc fix. * minibuf.c (read_minibuf): Disallow trailing junk. Wed Mar 16 17:13:08 1994 Morten Welinder (terra@diku.dk) * fileio.c (Ffile_modes) [MSDOS]: set exec-bit based on file suffix. * s/msdos.h: use bcopy when moving gap. Wed Mar 16 01:11:48 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * fns.c (Frandom): Eliminate bias in random number generator. * floatfns.c (FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros. (ceiling, floor, round, truncate): Use them. Tue Mar 15 18:00:26 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xdisp.c (redisplay): Don't consider minibuffer name for frame title. (update_menu_bar): Delete unused second argument. Callers changed. * fileio.c (Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo in previous change. * s/netbsd.h (LOCALTIME_CACHE): Define this symbol. Tue Mar 15 13:45:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Frename_file): Use RETURN_UNGCPRO when run handler. (Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Likewise. Tue Mar 15 01:34:08 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xdisp.c (message1): Call message2 instead of duplicating code. Mon Mar 14 16:34:24 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * floatfns.c (Flogb): Check for 0.0. Emulate logb if needed. * xterm.c (x_scroll_bar_expose): Don't make the right border thicker. * xterm.h (VERTICAL_SCROLL_BAR_RIGHT_BORDER): Change from 3 to 2. * frame.c (terminal-frame) [! MULTI_FRAME]: Create this variable. * minibuf.c (read_minibuf): Make minibuffer frame visible when minibuffer activated. * frame.c (Fhandle_switch_frame): Ignore switch to dead frame. * fileio.c (Fread_file_name): Delete docstring of second version. * frame.c (framep, selected-frame, frame-char-height, frame-char-width, frame-pixel-height, frame-pixel-width, set-frame-height, set-frame-width, set-frame-size): Ditto. * buffer.c (buffer-display-table, buffer-undo-list): Ditto. * xdisp.c (redisplay_window): Avoid dividing negative numbers. * window.c (window_scroll, Fmove_to_window_line): Ditto. * search.c (search_buffer): Avoid boolean/integer confusion. * dispnew.c (Fredraw_frame) [! MULTI_FRAME]: Make noninteractive. Mon Mar 14 15:00:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (Fx_popup_dialog, Fx_popup_menu): Handle case where mouse_position_hook doesn't store anything. Mon Mar 14 11:39:49 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * widget.c (EmacsFrameSetCharSize): Set the values of left_pos and top_pos to the values of the toplevel widget coordinates. Sun Mar 13 17:58:04 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (Fx_popup_dialog) [! USE_X_TOOLKIT]: Call Fx_popup_menu. * indent.c (Fvertical_motion): New optional arg WINDOW. * window.c (Fdelete_other_windows): Pass new arg to Fvertical_motion. (window_scroll, Frecenter, Fmove_to_window_line): Likewise. * fileio.c (Finsert_file_contents): Don't let same_at_end be less than same_at_start. Sat Mar 12 19:35:08 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * puresize.h (PURESIZE): Reduce to 230000. Fri Mar 11 18:13:13 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * floatfns.c (Fexpt): Delete extraneous `for' statement. * process.c (get_process): Allow arg to be a buffer object. * xdisp.c (x_consider_frame_title): New function, extracted from display_mode_line. (redisplay): Update frame title on iconified frames. Fri Mar 11 05:13:25 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xmenu.c (xdialog_show): New function to handle the display of dialog boxes. (Fx_popup_dialog): New function. (dialog_selection_callback): New function. (xmenu_show) [USE_X_TOOLKIT]: Don't call lw_destroy_all_widgets at the end. Do the work of construct_mouse_click in the ButtonRelease case. * Makefile.in (LIBXT): Add -lXext to the list. * widget.c (EmacsFrameSetCharSize): Call XawPanedSetRefigureMode. Call XtSetValues not XtVaSetValues. * fns.c (Fyes_or_no_p): Call Fx_popup_dialog instead of Fx_popup_menu. (Fy_or_n_p): Likewise. Thu Mar 10 17:54:00 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * filelock.c (lock_superlock): Synchronize NFS cache. * search.c (Fre_search_forward, Fre_search_backward): Doc fix. Thu Mar 10 00:00:02 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * indent.c (compute_motion): Initialize prev_hpos. * keyboard.c (command_loop_1): On entry, set this_command after running Vpost_command_hook. * puresize.h (PURESIZE): Increment to 240000. * xmenu.c (Fx_popup_menu): If POSITION is nil, don't require an open X connection. (single_keymap_panes, keymap_panes, menu_item_enabled_p): New arg NOTREAL. (Fx_popup_menu): Pass new arg (1 if POSITION is nil). (menu_item_enabled_p): If NOTREAL, always return t. * xmenu.c (single_keymap_panes) [!USE_X_TOOLKIT]: Append > to item_string if submenu. Wed Mar 9 17:05:04 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c [USE_X_TOOLKIT]: Display submenus in Xt style. (menu_items): Record where submenus start and end. (menu_items_submenu_depth): New variable. (init_menu_items): Init it. (push_submenu_start, push_submenu_end): New functions. (grow_menu_items): New function. (push_menu_pane, push_menu_item): Use it. (push_menu_pane): Increment menu_items_n_panes only if depth is 0. (single_keymap_panes) [USE_X_TOOLKIT]: Record submenus in menu_items. (xmenu_show) [USE_X_TOOLKIT]: Give submenus to toolkit. * xdisp.c (display_mode_line): Highlight partial-width mode lines for a non-termcal frame. * lisp.h (GLYPH_MODE_LINE_FACE): New macro. * callproc.c: Don't kill remaining processes if child exits. (call_process_exited): New variable. (Fcall_process): Set it. (call_process_cleanup): Test it. Wed Mar 9 01:02:07 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * window.c (Fselect_window): Undo previous minibuffer patch. * callint.c (Fcall_interactively): Don't select an active minibuffer. Wed Mar 9 00:56:31 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (window_loop): Delete MULTI_FRAME conditional within the loop, spuriously added in prev change. Don't ignore invisible or iconified frames for GET_BUFFER_WINDOW; instead, let Fnext_window skip them if appropriate. Tue Mar 8 23:16:53 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * window.c (Fselect_window): Don't select an inactive minibuffer. Tue Mar 8 11:32:28 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (Fdisplay_buffer): If pop_up_frames != 0, consider just visible frames when looking for existing window. * undo.c (syms_of_undo): staticpro pending_boundary. Tue Mar 8 01:20:31 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * process.c (send_process) [_PC_MAX_CANON]: Also test #ifdef HAVE_FPATHCONF before trying to use fpathconf. * config.h.in: Add #undef HAVE_FPATHCONF. * term.c (term_get_fkeys_data): Variable removed. (term_get_fkeys_define_1, term_get_fkeys_define): Functions removed. (term_get_fkeys_address): New variable, to pass arg through condition-case. (term_get_fkeys): Set that to ADDRESS; just do condition-case around call to term_get_fkeys_1, ignoring all errors. (term_get_fkeys_1): New function, containing body of term_get_fkeys. Don't use term_get_fkeys_define_1; call Fdefine_key directly. Tue Mar 8 00:02:18 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (Fprevious_window, Fnext_window): ALL_FRAMES = visible means consider only visible frames. (window_loop): Likewise for FRAMES. (Fget_buffer_window, Fget_largest_window, Fget_lru_window): Doc fix. (Fdelete_windows_on): Doc fix. * frame.c (next_frame, prev_frame): If MINIBUF is `visible', consider only visible frames. (Fnext_frame, Fprevious_frame): Doc fix. (syms_of_frame): Staticpro Qvisible. * lisp.h (Qvisible): Declared. Mon Mar 7 19:03:50 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * indent.c (Fcompute_motion): New function. * window.c (Fwindow_width): Doc fix. Mon Mar 7 13:38:51 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * doprnt.c (doprnt): Do the right thing for negative size spec. * minibuf.c (temp_echo_area_glyphs): Use quit_char, not C-g. (Fminibuffer_complete, Fminibuffer_complete_word): Doc fix. (get_minibuffer): Make name buffer large enough. * window.c (Fscroll_other_window): Doc fix. Sun Mar 6 00:59:52 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * alloc.c (mark_object): Add no-op cast. * eval.c (error): Use doprnt. Make buffer larger as necessary. * casefiddle.c (operate_on_word): Don't move point; store in *NEWPOINT. (Fupcase_word, Fdowncase_word, Fcapitalize_word): Set point after changing case. Rename opoint to beg. * undo.c (pending_boundary): New variable. (syms_of_undo): Initialize it. (Fundo_boundary): Use pending_boundary. (record_insert, record_delete, record_property_change): Set pending_boundary. Sat Mar 5 15:17:47 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vmsproc.c: Include config.h, lisp.h, buffer.h, process.h, commands.h, errno.h and file.h. (write_to_vms_process): Change =- to -=. (create_process): Set status field instead of obsolete flags field. (child_sig): Likewise. * emacs.c (shut_down_emacs): Set Vrun_hooks to nil. * minibuf.c (read_minibuf): Don't call Vrun_hooks if it is nil. * keyboard.c (command_loop_1, read_key_sequence, Fcommand_execute): Don't call Vrun_hooks if it is nil. * editfns.c (save_excursion_restore): Don't call Vrun_hooks if nil. * buffer.c (Fkill_buffer, Fkill_all_local_variables): Don't call Vrun_hooks if it is nil. * fileio.c (Fdo_auto_save): Doc fix. * lisp.h (ARRAY_MARK_FLAG): Define here. * alloc.c (ARRAY_MARK_FLAG): Not here. Fri Mar 4 22:56:25 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * keyboard.c (command_loop_1): Fix misplaced assignment of last_point_position. Fri Mar 4 16:20:16 1994 Paul Eggert (eggert@twinsun.com) * data.c (isnan): New macro. (float_arith_driver): min and max yield NaN if any argument is a NaN. Fri Mar 4 04:07:43 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xmenu.c (update_one_frame_psheets): Call EmacsFrameSetCharSize to force the paned widget to resize to the right value. (xmenu_show): No need to check a second time whether the mouse has moved to another menu bar item. This slows down execution. * widget.c (EmacsFrameSetCharSize): Don't call XtMakeResizeRequest. Use XtVaSetValues for geometry management. Fri Mar 4 02:52:41 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * xmenu.c [USE_X_TOOLKIT] (xmenu_show): Pass display to XtWindowToWidget. Thu Mar 3 23:18:35 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * search.c (skip_chars): Treat `-' as alias for space, if syntaxp. * fileio.c (Finsert_file_contents): Pass del_range_1 two ends, not a length. Thu Mar 3 20:07:16 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * process.h (chan_process): Don't specify size. Thu Mar 3 12:35:19 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * fileio.c (Fread_file_name): Do the right thing when insert-default-directory is nil. Allow for doubled dollar signs in dir when computing pos. * commands.h: New variable last_point_position. * keyboard.c (command_loop_1): Set it to the value of point. * undo.c (record_delete): Save this value in the undo record, rather than the current value of point.) * buffer.c (Fget_file_buffer): Doc fix. * s/aix3-2.h (C_SWITCH_SYSTEM): Increase maxmem when using IBM's compiler. Wed Mar 2 11:49:28 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (chan_process, Vprocess_alist): No longer static. * process.h (chan_process, Vprocess_alist): Declared. * puresize.h (PURESIZE) [MULTI_FRAME]: Incremented to 230000. * minibuf.c (Fdisplay_completion_list): Restore original buffer before running completion-setup-hook. * frame.c (Fdelete_frame): Don't initialize a Lisp_Object. Clean up line breaks. * process.c: Include unistd.h. (pty_max_bytes): New variable. (send_process): Send an eof after each pty_max_bytes bytes. * keyboard.c (menu_bar_items): When moving an item to the end, shift all the following ones forward one slot. Wed Mar 2 00:00:24 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xfns.c (Fx_list_fonts): Avoid confused increment of info. * syntax.c (Fforward_comment): Do the right thing at eob. Tue Mar 1 22:22:39 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (menu_bar_items): Accept old vector as arg. Return a vector. (menu_bar_one_keymap, menu_bar_item): Associated changes. (make_lispy_event): Use FRAME_MENU_BAR_LINES as vector. * frame.c (make_frame): Init menu_bar_items field to 0. * xdisp.c (update_menu_bar): Change call to menu_bar_items. (display_menu_bar): Use FRAME_MENU_BAR_LINES as vector. * xmenu.c (map_event_to_object, set_frame_menubar): Use FRAME_MENU_BAR_LINES as vector. Tue Mar 1 22:17:37 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * s/aix3-2.h: Use -g with the native compiler. * s/aix3-2-5.h: New file. Use -O with the native compiler. Tue Mar 1 19:14:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lisp.h (struct handler): New field chosen_clause. * eval.c (Fsignal): Record the clause in chosen_clause. (Fcondition_case, internal_condition_case): Look there. (internal_condition_case_1): Look there. * fileio.c (Finsert_file_contents): If undo_list was t, leave it t. * alloc.c (memory_signal_data): No longer static. (syms_of_alloc): Stick Qerror onto memory_signal_data. * lisp.h (memory_signal_data): Declare it. * eval.c (Fsignal): If DATA is memory_signal_data, don't add to it. Mon Feb 28 15:16:57 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * alloc.c (memory_full): Use new variable memory_signal_data with precomputed value instead of trying to build it after memory is already exhausted. Mon Feb 28 07:53:35 1994 Frederic Pierresteguy (F.Pierresteguy@frcl.bull.fr) * xmenu.c (xmenu_show): Test XtWindowToWidget before inserting into the event_queue. * xterm.c (XTread_socket): For case ClientMessage and Xatom_wm_delete_window, use x_any_window_to_frame. Sat Feb 26 04:26:38 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sol2-3.h (LD_SWITCH_SYSTEM): New definitions, with #undef. * insdel.c (del_range_1): New function. (del_range): Use it. * fileio.c (Finsert_file_contents): Use del_range_1. Sat Feb 26 00:51:41 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * keyboard.c (Fsuspend_emacs): New variable cannot-suspend forces a subshell even if the system seems to support job control. * sysdep.c (sys_subshell): New function, split from sys_suspend. Fri Feb 25 22:50:34 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * window.c (Fset_window_configuration): Allow for menu-bar-lines to have changed since the configuration was created. Fri Feb 25 22:41:47 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (Vsystem_key_alist): Renamed from Vvendor_key_alist. (syms_of_keyboard): Rename Lisp var to system-key-alist. Fri Feb 25 16:20:33 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * buffer.h (OVERLAY_POSITION): Don't check which buffer it points to. * lisp.h: Delete extra backslash on last line of macro. * xdisp.c (display_text_line): Allow for invisible overlays in next_invisible lookahead. * indent.c (compute_motion): Likewise. Fri Feb 25 04:07:27 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * widget.c (EmacsFrameSetCharSize): Set coordinates values to the toplevel widget. * xterm.c (XTread_socket): For case ConfigureNotify, call x_any_window_to_frame. [USE_X_TOOLKIT]: Call XTranslateCoordinates for case ConfigureNotify when send_event is 0 and when the event is relative to toplevel widget. * widget.c (EmacsFrameSetCharSize): Call check_frame_size and update vertical_scroll_bar_extra. Call SET_FRAME_GARBAGED. Thu Feb 24 16:49:42 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lread.c (Fload): Cast the args to stat. Thu Feb 24 14:06:33 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * xdisp.c (try_window): Add #ifdef USE_TEXT_PROPERTIES around call to Fget_text_property. * textprop.c (Fget_char_property): New function. * buffer.c (sort_overlays): Allow for null window. * xdisp.c (try_window, display_text_line): Use Fget_char_property to test for invisibility. * indent.c (compute_motion, vmotion): Likewise. * dispnew.c (direct_output_forward_char): Likewise. Thu Feb 24 07:51:48 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xfns.c (x_window): Call XChangeWindowAttributes with the standard event set to make all these events reach the Emacs frame. Thu Feb 24 00:40:01 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (Fx_popup_menu): Allow t as position, meaning use mouse pos. * fns.c (Fy_or_n_p): Use a popup menu if reached via mouse command. (Fyes_or_no_p): Likewise. * unexelf.c (ELF_BSS_SECTION_NAME): New macro (config.h may override). (unexec): Use it. Wed Feb 23 22:46:50 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c (Fkill_buffer): Call the Vkill_buffer_query_functions. (syms_of_buffer): Make Lisp var for kill-buffer-query-functions. Tue Feb 22 19:02:48 1994 Karl Heuer (kwzh@geech.gnu.ai.mit.edu) * lisp.h: New variable Vdoc_directory. * doc.c (get_doc_string, Snarf_documentation): Use it. * callproc.c (syms_of_callproc, init_callproc_1): Initialize it. * paths.h.in: Define PATH_DOC for default doc-directory. Tue Feb 22 17:25:30 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (make_lispy_movement, make_lispy_event): In non-scrollbar mouse case, return coords in pixel units. * frame.c (Fmouse_position): Convert to glyph units. * xterm.c (construct_mouse_click): Don't convert to glyph units. (XTmouse_position): Don't convert to glyph units. * msdos.c (mouse_get_pos): Don't convert to glyph units. * fileio.c (Finsert_file_contents): If REPLACE, always do lseek. Exit main loop if INSERTED reaches TOTAL. Tue Feb 22 16:50:43 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (XTmouse_position): Use x_any_window_to_frame. Tue Feb 22 14:41:31 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * emacs.c: Move extern declarations to top of file. Mon Feb 21 03:33:08 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (make_lispy_event): For menu bar event in USE_X_TOOLKIT case, convert x position to glyphs after map_event_to_object. Call window_from_coordinates later on. * xmenu.c (menu_item_equiv_key): Cached equiv-key data is a sublist. * keymap.c (get_keyelt): Cached equiv-key data is now a sublist. * xterm.c (x_had_errors_p): New function. (construct_menu_click): Move function after pixel_to_glyph_coords. * xmenu.c: Most of file rewritten. (menu_items, menu_items_*): New variables. (MENU_ITEMS_*): New macros. (init_menu_items, discard_menu_items, push_menu_pane, push_menu_item) (finish_menu_items): New functions. (menu_item_enabled_p): New function. (keymap_panes, single_keymap_panes): Major rewrite; most args changed. (list_of_panes, list_of_items): Major rewrite; most args changed. (Fx_popup_menu): Major rewrite. Now independent of display mechanism. No more conditionals here. (set_menu_items, free_menu_items): Functions deleted. (xmenu_show): Both versions rewritten to work from menu_items and to do all the conditionalized things that were in Fx_popup_menu. (unread_menu_bar_button, other_menu_bar_item_p): New functions. (check_mouse_other_menu_bar): New function. * xterm.c [!USE_X_TOOLKIT] (x_any_window_to_frame): Define as x_window_to_frame. Sun Feb 20 14:34:19 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * unexsunos4.c: Move config.h after system includes. * syswait.h [BSD]: #undef WCOREDUMP before defining it. Sat Feb 19 00:43:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.c (Fframe_visible_p): Do FRAME_SAMPLE_VISIBILITY first. * xterm.c (XTread_socket--cases KeyPress, EnterNotify, LeaveNotify) (cases FocusIn, FocusOut): Use x_any_window_to_frame. * xfns.c (x_window_to_frame): Add parens for clarity. * xmenu.c: Find and display keyboard equivalents of menu items. (menu_item_equiv_key): New function. (single_keymap_panes): Call it. Properly skip help-string if any. Rename item2 to item_string. GCPRO some things. (menu_item_equiv_key): Use either VECTORP or STRINGP, not both. * keymap.c (get_keyelt): Discard keyboard equivalents stored in a menu keymap element. Fri Feb 18 05:58:51 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * widget.c (get_default_char_pixel_size): Clean up code. Remove code inside #if 0 directive. * xmenu.c (popup_selection_callback): Clean up code. Remove code inside #if 0 directive. (popup_down_callback): Likewise. Fri Feb 18 01:09:26 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (restore_point_unwind): New function. (Finsert_file_contents): In REPLACE case, set point and restore it. * gnu.h (gnu_bits): Use unsigned char. * bitmaps/*.xbm: Use unsigned char, not char. * window.c (unshow_buffer): Unconditionally set last_window_start. Thu Feb 17 00:29:23 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (Fdelete_other_windows): Don't call Frecenter; do it by hand and avoid setting w->force_start. * xterm.c (dumpglyphs): Try various alternatives for foreground color of a glyph with the cursor on it. * dosfns.c, msdos.c, widget.c: Use <...> for config.h. * fileio.c (Finsert_file_contents): New arg REPLACE. New feature to replace buffer contents with file contents. Wed Feb 16 18:43:33 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * systty.h (EMACS_TTY_TABS_OK): Alternate definition if no TABDLY. * s/bsd4-2.h, s/dgux.h, s/rtu.h, s/umax.h (BSD_PGRPS): Defined. * s/netbsd.h, s/bsd386.h (BSD_PGRPS): Add #undef. * sysdep.c (init_sys_modes, reset_sys_modes): Test BSD_PGRPS. (narrow_foreground_group, widen_foreground_group): Define if BSD_PGRPS. * sysdep.c (child_setup_tty): Use IUCLC, OLCUC, NLDLY only if defined. * emacs.c (main): Test BSD_PGRPS, not BSD. * s/netbsd.h (TAB3): Defined. (NEED_ERRNO, NO_TERMIO, HAVE_TERMIOS, HAVE_UNION_WAIT): Defined. * sysdep.c (init_sys_modes): IEXTEN is in c_lflag, not c_iflag. * unexmips.c (unexec): Add cast to result of `sbrk'. Tue Feb 15 16:18:55 1994 Chris Hanson (cph@klia.ai.mit.edu) * s/newsos5.h: Include usg5-4.h. (LIBS_SYSTEM, LINKER, START_FILES, LIB_STANDARD): Definitions moved here. * m/news-risc.h [NEWSOS5] (C_DEBUG_SWITCH, C_OPTIMIZE_SWITCH) (LD_SWITCH_MACHINE): Definitions moved here. * m/mips.h: NEWSOS5 conditional deleted. [NEWSOS5] (START_FILES, LIB_STANDARD, C_DEBUG_SWITCH) (C_OPTIMIZE_SWITCH, LD_SWITCH_MACHINE): Definitions moved away. Tue Feb 15 11:16:37 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (Fx_parse_geometry): Don't call check_x. * sysdep.c (sys_write): If any bytes were written, return how many. * xterm.c (XTread_socket): Do not assume that select returning immediately with no events implies a hangup. Mon Feb 14 14:41:27 1994 Karl Heuer (kwzh@geech.gnu.ai.mit.edu) * xterm.h (check_x): Declare it. * xfns.c (check_x): Make it global. (Fx_parse_geometry, Fx_list_fonts, Fx_close_current_connection): call check_x. * xmenu.c (Fx_popup_menu): Likewise. * xselect.c (Fx_own_selection_internal, Fx_get_selection_internal, Fx_disown_selection_internal, Fx_rotate_cut_buffers_internal, Fx_selection_exists_p, Fx_get_cut_buffer_internal, Fx_store_cut_buffer_internal, Fx_selection_owner_p): Likewise. * indent.c (indented_beyond_p): New function. (compute_motion, vmotion): Use it to treat blank lines specially in selective display. * xdisp.c (try_window_id, display_text_line): Likewise. Sun Feb 13 17:19:44 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * s/netbsd.h (BROKEN_START, TEXT_START): Don't define. (HAVE_TEXT_START): Define this instead. * sysdep.c (start_of_text): Don't define #ifdef HAVE_TEXT_START. Sat Feb 12 17:32:02 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xdisp.c (decode_mode_spec): Support %+. * keyboard.c (command_loop_1): On entry, set last_command to this_command. * term.c (term_init): If no `se', use `me'; if no `me' either, don't use standout mode at all. Fri Feb 11 20:56:24 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (${libsrc}make-docfile): Don't pass ../arch-lib as target to submake. Fri Feb 11 17:32:15 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * sysdep.c [USG]: Fix conditional includes. * m/convex.h, m/ibmps2-aix.h, m/ibmrs6000.h, m/tekxd88.h, s/386bsd.h, s/bsd386.h, s/dgux.h, s/irix3-3.h, s/linux.h, s/netbsd.h, s/usg5-4.h: Delete HAVE_SETSID; configure checks for that. * xrdb.c (gethomedir): Look at LOGNAME before USER. * editfns.c (Fuser_real_login_name): Doc fix. Fri Feb 11 17:06:30 1994 Paul Eggert (eggert@twinsun.com) * editfns.c (init_editfns): Look at LOGNAME before USER. * fileio.c (Fsubstitute_in_file_name): Remove long-dead code that looked at USER before LOGNAME. Fri Feb 11 13:54:19 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c (syms_of_buffer): Doc fix. * xdisp.c (decode_mode_spec): Implement `P'. Fri Feb 11 12:52:15 1994 Charles Hannum (mycroft@duality.gnu.ai.mit.edu) * s/netbsd.h (KERNEL_FILE, LDAV_SYMBOL): Undefine and leave them that way. (LIBS_TERMCAP): Define. Native libtermcap is better than the Emacs version, and knows the correct path. (N_PAGSIZ, N_BSSADDR, N_TRELOFF): Don't redefine if they already exist (i.e. under NetBSD >0.9). Fri Feb 11 12:33:02 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * s/netbsd.h (SYSV_SYSTEM_DIR): Define. (BROKEN_START, TEXT_START, START_FILES, UNEXEC, RUN_TIME_REMAP): Define to use unexsunos4. (N_PAGSIZ, N_BSSSADDR, N_TRELOFF): Define so unexsunos4.c compiles. Fri Feb 11 03:53:05 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xfns.c (x_set_menu_bar_lines) [USE_X_TOOLKIT]: Dont Call XtDestroyWidget but free_frame_menubar. Undo previous changes. * xterm.c (x_destroy_window) [USE_X_TOOLKIT]: Call free_frame_menubar. * xmenu.c (free_frame_menubar) [USE_X_TOOLKIT]: New function to destroy the X Widget instance of the menubar. * widget.c (EmacsFrameResize): Don't call XTranslateCoordinates. Code removed. * xmenu.c (xmenu_show) [USE_X_TOOLKIT]: Return Qnil when val is null. Fri Feb 11 03:03:43 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * keyboard.c (Fexecute_extended_command): Copy this_command_keys as a vector, not a string. Thu Feb 10 23:42:45 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * keyboard.c (syms_of_keyboard): Add a DEFVAR for command-hook-internal. (command_loop_1): Use it for post-command-hook. Thu Feb 10 21:50:09 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * process.c (sys_siglist): Protect decl with #ifndef SYS_SIGLIST_DECLARED. * config.h.in: Add #undef SYS_SIGLIST_DECLARED. Thu Feb 10 15:27:41 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * lread.c (read_filtered_event): Retry read_char after a buffer change. * keyboard.c (read_char, read_char_minibuf_menu_prompt, read_key_sequence): Likewise. * dispnew.c (buffer_posn_from_coords): Take hscroll into account. * window.c (Fpos_visible_in_window_p): Likewise. * editfns.c (Fmessage): Copy the text to be displayed into a malloc'd buffer. Thu Feb 10 04:34:49 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xmenu.c (xmenu_show): Test again event.xmotion.x_root in the MotionNotify case. Wed Feb 9 23:37:07 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * vmsdir.h: File renamed from dir.h. * ndir.h, fileio.c: Use new name vmsdir.h. Wed Feb 9 17:05:02 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * alloc.c (Fgarbage_collect): Save and restore echo_area_glyphs_length. * fileio.c (Fdo_auto_save): Likewise. * buffer.c (Fkill_all_local_variables): Run change-major-mode-hook. * xterm.c (x_display_cursor, process_expose_from_menu): Block input. * editfns.c (difftm): Simplify return expression. * m/news.h (CRT0_DUMMIES): Definition deleted. * alloc.c (mark_object): Fetch obj from *objptr at loop, not at the gotos. Wed Feb 9 08:51:51 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * Implement a Motif behavior for the menubar. Now, if you move the pointer on another menubar item while displaying the contents of a selected menubar item, the current pulldown menu is closed and the new one corresponding to the new pointed item is displayed. * xmenu.c (xmenu_show) [USE_X_TOOLKIT]: Clean up code. Handle the MotionNotify events in the XEvent loop. Tue Feb 8 22:23:56 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * xfaces.c (compute_char_face): Extract overlay-sorting code as a separate function, which is now in buffer.c. * buffer.c (sort_overlays): New function, extracted from xfaces.c. Tue Feb 8 17:42:42 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * print.c (print): If print_escapes_newlines, print '\f' as "\\f". (syms_of_print): Update docstring. Tue Feb 8 02:26:20 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (Fprocess_kill_without_query): Doc fix. Mon Feb 7 13:26:04 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xterm.c (x_make_frame_invisible): Add USE_X_TOOLKIT conditional. Sun Feb 6 01:15:05 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_set_window_size): New arg CHANGE_GRAVITY. (x_new_font): Pass CHANGE_GRAVITY arg to x_set_window_size. (x_wm_set_size_hint): New arg CHANGE_GRAVITY. (x_set_offset, x_set_window_size): Pass CHANGE_GRAVITY arg to x_set_window_size. * xfns.c (x_set_internal_border_width, x_set_vertical_scroll_bars): Pass CHANGE_GRAVITY arg to x_set_window_size. (Fx_create_frame): Pass CHANGE_GRAVITY arg to x_wm_set_size_hint. * frame.c (Fset_frame_height, Fset_frame_width, Fset_frame_size): Pass CHANGE_GRAVITY arg to x_set_window_size. * frame.c (other_visible_frames): New function; code taken from Fdelete_frame. (Fdelete_frame): Use it. (Fmake_frame_invisible): Use it. New arg FORCE. * xfns.c (x_set_visibility): Pass new arg to Fmake_frame_invisible. * xdisp.c (fix_glyph): New function. (display_text_line, display_string): Use fix_glyph. * xfaces.c (init_frame_faces): Clear FRAME_N_COMPUTED_FACES and FRAME_SIZE_COMPUTED_FACES. Sat Feb 5 02:15:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xdisp.c (copy_rope): Function deleted. (copy_part_of_rope): Merge the glyph's face using compute_glyph_face. Take frame as additional arg. (display_text_line): Use copy_part_of_rope always, not copy_rope. Pass the frame as arg. (display_string): Likewise. * xfaces.c (compute_glyph_face): New arg CURRENT_FACE specifies face to merge with. * emacs.c (main) [AIX]: Don't handle signal 20, 21 or 22. Call signal 24 by name (SIGXCPU). * eval.c (internal_condition_case_1): New function. * lisp.h (internal_condition_case_1): Declared. * keyboard.c (menu_bar_item): Use internal_condition_case_1. (menu_bar_item_1): New function. * xmenu.c (single_keymap_panes): Use internal_condition_case_1. (single_keymap_panes_1): New function. Fri Feb 4 15:19:07 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * intervals.c (verify_interval_modification): When checking read-only, allow for the case that stickiness might be t instead of a list. * data.c (fmod): Implement it on systems where it's missing, using drem if available. Fri Feb 4 12:17:07 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xmenu.c (xmenu_show) [USE_X_TOOLKIT]: Remove the #if 0 directives and reverse one to avoid the flickering of the menubar. Fri Feb 4 01:22:20 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keymap.c (Fwhere_is_internal): Take just one keymap arg. (where_is_string): Pass Voverriding_local_map for that arg. * doc.c (Fsubstitute_command_keys): Pass keymap as that arg to Fwhere_is_internal. Init keymap from Voverriding_local_map. Thu Feb 3 13:54:11 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * intervals.c (merge_properties_sticky): Preserve original order of properties. Thu Feb 3 00:02:03 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/hpux8.h (X_IO_BUG): Defined. * fileio.c (Fwrite_region): If FILENAME has no handler, see if VISIT has one. * search.c (scan_buffer): New arg ALLOW_QUIT. (find_next_newline): Pass new arg. * xdisp.c (display_count_lines): Pass new arg to scan_buffer. * syntax.c (find_defun_start): Pass new arg to scan_buffer. * cmds.c (Fforward_line): Pass new arg to scan_buffer. Wed Feb 2 12:13:01 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (XTread_socket): Add X_IO_BUG conditional. * xdisp.c (display_menu_bar): Pass explicit max arg to display_string. (display_string): New arg OBEY_WINDOW_WIDTH. All callers changed. Wed Feb 2 01:21:07 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * xterm.c (x_iconify_frame): Fix misbalanced BLOCK_INPUT/UNBLOCK_INPUT. * xdisp.c (try_window_id): Don't pass value beyond ZV to compute_motion. * window.c (Fpos_visible_in_window_p): Return nil if POS > ZV. * sysdep.c (get_system_name): Remove restriction on hostname size. * lisp.h (get_system_name): Declared. * xterm.c (x_term_init): Use get_system_name instead of gethostname. * xrdb.c (x_get_customization_string): Use get_system_name instead of gethostname. Wed Feb 2 00:04:35 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (kbd_buffer_get_event): Pass 1 to read_avail_input. Tue Feb 1 18:18:39 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * config.h.in (HAVE_FMOD): Add another #undef. * data.c (Fmod): Use HAVE_FMOD. Tue Feb 1 17:33:14 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xfns.c (x_set_menu_bar_lines): Test also menubar_widget before calling XtDestroyWidget. Tue Feb 1 01:48:32 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (dumpglyphs): Don't crash for invalid face code. Mon Jan 31 23:13:17 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * undo.c (record_first_change): Check for buffer-undo-list = t. Make an undo boundary if appropriate. Set last_undo_buffer. (record_property_change): Use BUFFER, not current_buffer, when testing undo_list. Sat Jan 29 19:50:10 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * widget.c: Don't declare arg types in decls or fn definitions. * syntax.h (SYNTAX_MATCH, SYNTAX): Fix non-GNUC definitions. * widget.h (EmacsFrameSetCharSize): Don't declare arg types. * Makefile.in.in (configuration): Change # comment to C comment. Sat Jan 29 02:09:41 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * keymap.c (currrent_minor_maps): Scale by sizeof when allocating objects. * buffer.c (Fkill_all_local_variables): Follow symbol forwarding. Sat Jan 29 01:16:17 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * callproc.c: Include stdio.h. (init_callproc): Put non-ex-dir warnings on stderr. * lread.c (init_lread): Put non-ex-dir warnings on stderr. Fri Jan 28 20:14:07 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lread.c (init_lread): Put non-ex-dir warnings on stderr. * callproc.c: Include stdio.h. (init_callproc): Put non-ex-dir warnings on stderr. Fri Jan 28 17:34:46 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xterm.c (x_set_window_size): Add USE_X_TOOLKIT conditional. Call EmacsFrameSetCharSize and return. * xterm.c (x_term_init): Cast to (char **) before assignment to argv. Thu Jan 27 05:50:49 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * keyboard.c (make_lispy_event): Add USE_X_TOOLKIT conditional and test FRAME_EXTERNAL_MENU_BAR. (map_event_to_object) [USE_X_TOOLKIT]: Declare and use it. Wed Jan 26 15:51:33 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_set_mouse_position): Don't raise the frame. * s/sunos4-0.h [__GNUC__] (MKDIR_PROTOTYPE): Defined. * sysdep.c (mkdir): Use MKDIR_PROTOTYPE if defined. Wed Jan 26 12:23:12 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xterm.h [USE_X_TOOLKIT]: Don't include Xaw/Box.h. * xdisp.c (update_menu_bar): Add USE_X_TOOLKIT conditional and test FRAME_EXTERNAL_MENU_BAR. Wed Jan 26 00:09:18 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (widgetobj): New variable. (otherobj): Use widgetobj. (XOBJ): Undo previous change. Tue Jan 25 16:01:12 1994 Francesco Potorti` (pot@cnuce.cnr.it) * m/delta.h (HAVE_BCOPY): undef'd for efficiency. (bcopy, bzero, bcmp): define'd for efficiency. (GAP_USE_BCOPY, BCOPY_DOWNWARD_SAFE): define'd for GHc compiler. Mon Jan 24 13:17:12 1994 Francesco Potorti` (pot@cnuce.cnr.it) * m/delta.h (HAVE_RANDOM, BROKEN_FIONREAD): Defined if X is used. (HAVE_XSCREENNUMBEROFSCREEN): Defined if X is used. (LIB_X11_LIB, LIBX11_SYSTEM): Override only if X is used. (USG_SHARED_LIBRARIES): Undefine only if X is used. Sun Jan 23 18:23:35 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fns.c (Fconcat): Doc fix. Sat Jan 22 11:13:08 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): Properly gcpro fkey_map while using keytran_map. * fns.c (Fassq, Fassoc): Doc fixes. * data.c (Faset): Doc fix. Fri Jan 21 01:33:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xdisp.c (display_menu_bar): Add USE_X_TOOLKIT conditional. (redisplay_window) [USE_X_TOOLKIT]: Test FRAME_EXTERNAL_MENU_BAR. (update_menu_bar) [USE_X_TOOLKIT]: Call set_frame_menubar. * widget.c: Include X11/ObjectP.h. * keyboard.c (syms_of_keyboard): New Lisp var command-hook-internal. (command_loop_1): Use it when running the command hooks. * Makefile.in.in (LWLIB_OPTIONS): Define if not defined. (LIBXT): New variable. (LIBX): Use LIBXT. (widget.o): New target. (XOBJ) [USE_X_TOOLKIT]: Add widget.o. * xmenu.c: Find lwlib.h and xlwmenuP.h in ../lwlib. * xfns.c: Find lwlib.h in ../lwlib. * widgetprv.h: Renamed from widgetP.h. * Makefile.in.in (lwlibdir): New variable. ($(OLDXMENU)) [USE_X_TOOLKIT]: Alternate rule. (OLDXMENU) [USE_X_TOOLKIT]: Alternate value. (really-lwlib): New rule. * xterm.h [USE_X_TOOLKIT]: Include StringDefs.h, IntrinsicP.h, CoreP.h, StringDefs.h, Xaw/Box.h. * xterm.c: Don't include them. * xrdb.c (search_magic_path): Fix logic testing for empty path element. Thu Jan 20 08:11:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_wm_set_size_hint): Swap southeast and northwest. * xrdb.c (S_ISDIR): Define if not defined. (file_p): Use S_ISDIR. * xterm.c (XTupdate_end): No need to test updating_frame. * term.c (update_end): Clear updating_frame before calling hook. * fileio.c (double_dollars): New function. (Fread_file_name_internal): Use double_dollars. (Fread_file_name): Likewise. * textprop.c (Fprevious_property_change): Move back at least 1 char. (Fprevious_single_property_change): Likewise. * textprop.c: Doc fixes. * xfns.c (store_class_hints): Function deleted. * intervals.c (graft_intervals_into_buffer): Fix one-off comparing lengths of over and under. * keyboard.c (read_key_sequence): Don't call echo_truncate the first time through. Wed Jan 19 09:57:57 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sunos4-1-3.h: Add #undef SYSTEM_MALLOC. * xfns.c (Fx_create_frame): Bind x-resource-name to explicit title. (Qx_resource_name): Declared. (syms_of_xfns): Set up Qx_resource_name. * xmenu.c: Reshuffle functions; put new ones in #ifdef USE_X_TOOLKIT. (Fx_popup_menu): Add USE_X_TOOLKIT conditional around new decls. * xterm.c: Put new functions in #ifdef USE_X_TOOLKIT. * xdisp.c (truncate_echo_area): New function. * keyboard.c (echo_truncate): Call truncate_echo_area. Tue Jan 18 17:56:02 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * config.h.in: Add #undef for USE_X_TOOLKIT. * xfns.c (x_window): Fix error message. Tue Jan 18 14:36:35 1993 Frederic Pierresteguy (F.Pierresteguy@frcl.bull.fr) * Support use of X toolkit. (USE_X_TOOLKIT): New macro to conditionalize the use of Xt. * widget.c, widgetP.h, widget.h: New files. * frame.h (struct frame): New field external_menu_bar. (FRAME_EXTERNAL_MENU_BAR): New macro. * xterm.h (struct x_display): New fields widget, column_widget, edit_widget, menubar_widget. (x_any_window_to_frame): Declared. * lisp.h (VOID_TO_LISP, CVOID_TO_LISP, LISP_TO_VOID, LISP_TO_CVOID): New macros. * xfns.c (x_any_window_to_frame): New function. (x_window_to_frame, x_window): Handle USE_X_TOOLKIT. (x_set_icon_type, x_set_menu_bar_lines, x_set_name): Likewise. (store_class_hints, hack_wm_protocols): New function. * xmenu.c (string_width): New function. (event_is_in_menu_item, map_event_to_object): Likewise. (set_menu_items, free_menu_items, popup_selection_callback): Likewise. (popup_down_callback, free_menubar_widget_value_tree): Likewise. (update_one_frame_psheets, set_frame_menubar): Likewise. (Fx_popup_menu, xmenu_show): Handle USE_X_TOOLKIT. * xterm.c (construct_mouse_click): New function. (process_expose_from_menu): Likewise. (XTread_socket, x_set_offset, x_set_window_size): Handle USE_X_TOOLKIT. (x_raise_frame, x_lower_frame, x_make_frame_visible): Likewise. (x_iconify_frame, x_destroy_window, x_wm_set_window_state): Likewise. (x_term_init): Likewise. * xmenu.c (dispatch_dummy_expose): New function. (XMenu_xpos, XMenu_ypos): Change the values of the constant assignment. (xmenu_show): Change the way to make the menubar to redraw itself by generating a dummy expose event. * xterm.c (x_term_init): Pass argv, argc to XtAppInitialize with the display_name value. Sun Jan 16 17:42:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/linux.h: Don't include stdio.h. * dispnew.c: Include stdio.h before config.h. * emacs.c (init_cmdargs): Set Vinstallation_directory. (syms_of_emacs): staticpro it. * lisp.h (Vinstallation_directory): Declared. * lread.c (init_lread): Use Vinstallation_directory. * callproc.c (init_callproc): Use Vinstallation_directory. * fileio.c (Ffile_symlink_p): Doc fix. * keyboard.c (Voverriding_local_map): New variable. (syms_of_keyboard): Set up Lisp variable. (read_key_sequence, menu_bar_items): Handle Voverriding_local_map. * keymap.c (Fkey_binding): Handle Voverriding_local_map. (describe_buffer_bindings): Likewise. Sat Jan 15 08:27:01 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * config.h.in (LD_SWITCH_X_SITE_AUX): Add #undef. * s/sol2.h (LD_SWITCH_SYSTEM): Use LD_SWITCH_X_SITE_AUX. * floatfns.c (Fffloor, Ffceil, Ffround, Fftruncate): New functions. (syms_of_floatfns): Turn them on. Fri Jan 14 13:46:47 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (command_loop_1): If there's an error in the post-command-hook or pre-command-hook, leave that hook nil. * s/sco4.h (BSTRING): Don't define it here. Thu Jan 13 00:01:12 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (xterm.o): Depends on syssignal.h. Wed Jan 12 11:17:37 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sysdep.c (sys_siglist) [sun]: Additional Sun-specific signal names. Wed Jan 12 08:45:35 1993 Thomas Horsley (tahorsley@csd.harris.com) * cxux-crt0.s: New file. * emacs.c (main) [USG5 and INTERRUPT_INPUT]: Call setpgrp. * m/nh3000.h: New file for the Night Hawk 3000 series hardware defs. * m/nh4000.h: New file for the Night Hawk 4000 & 5000 series hardware. * s/cxux.h: New file for the CX/UX operating system used by Night Hawks. * s/cxux7.h: New file. * sysdep.c (request_sigio, unrequest_sigio): Add new versions of these routines for the CX/UX operating system. (sys_signal) [SA_RESTART]: Set this flag. * xterm.c: Include syssignal.h. Tue Jan 11 20:59:19 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (sigchld_handler, status_message): Handle a NULL in sys_siglist. Tue Jan 11 19:49:46 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * buffer.c (syms_of_buffer): Don't do (put 'erase-buffer 'disabled t). (keys_of_buffer): Do it here instead. Tue Jan 11 00:49:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lread.c (Fload): Record descriptor numbers on load_descriptor_list. (load_descriptor_unwind, close_load_descs): New function. (syms_of_lread): Init and staticpro load_descriptor_list. (init_lread): Clear load_descriptor_list. * callproc.c (child_setup): Call close_load_descs. * eval.c (Fcondition_case): Allow a list of condition names in a handler. (find_handler_clause): Likewise. (Fsignal): Rename 1st arg to error_symbol. (Fcondition_case): Doc fix. * process.c (read_process_output): Supply second arg to unbind_to. (exec_sentinel): Likewise. Tue Jan 11 16:45:47 GMT 1994 (afs@hplb.hpl.hp.com) * keyboard.c (read_char_x_menu_prompt, read_char_minibuf_menu_prompt): New functions made by dividing up read_char_menu_prompt. (read_char): Call read_char_minibuffer_menu_prompt before the sit_for if X menus are not going to be used. (read_char_minibuf_menu_prompt): Correct access to keymaps for menus when not using X menus. Only store character read in a keyboard macro if it is not the menu help character. Mon Jan 10 12:08:18 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (create_process): Set line discipline only if pty_flag. * search.c (set_search_regs): New subroutine. (search_buffer): Use set_search_regs. Record beginning and end after matching null string. Sun Jan 9 18:07:25 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * mem-limits.h: Include before . * process.c: Don't declare sys_nerr. Don't declare sys_errlist unless #ifdef VMS. Declare strerror instead. (wait_reading_process_input): Call strerror instead of using sys_errlist. Sun Jan 9 10:20:07 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (x_sync): Block input. * buffer.h (struct buffer): New field auto_save_failure_time. * fileio.c (Fdo_auto_save): If auto save times out, don't try again for 20 minutes. (Fclear_buffer_auto_save_failure): New function. (Fset_buffer_auto_saved): Clear auto_save_failure_time. * xfns.c (x_sync): New function. * frame.c (Fdelete_frame): Call x_sync. Sun Jan 9 01:16:24 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * sysdep.c: Restore big block of #ifdef and #include lines for fcntl.h and friends, apparently accidentally removed in revision 1.70 (Jan 5 changes). Sat Jan 8 16:24:41 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * callproc.c (child_setup): Don't declare PID `register'; we later take its address. * config.h.in: Add #undef HAVE_STRERROR. * sysdep.c [! VMS]: Don't declare sys_errlist here. [! HAVE_STRERROR] (strerror): New function. (dup2): Use strerror instead of sys_errlist. * fileio.c: Don't declare sys_errlist; declare strerror instead. (err_str): Macro removed. (Finsert_file_contents, Fwrite_region): Call strerror instead of err_str. (report_file_error): Call strerror instead of using sys_errlist. * emacs.c (main): Call strerror instead of using sys_errlist. * callproc.c: Don't declare sys_errlist; declare strerror instead. (relocate_fd): Call strerror instead of using sys_errlist. * unexenix.c: Don't declare sys_errlist; declare strerror instead. (fatal_unexec): Call strerror instead of using sys_errlist. * unexmips.c: Likewise. Sat Jan 8 06:59:15 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.c (Fdelete_frame): Do FRAME_SAMPLE_VISIBILITY before testing visibility of a frame. * emacs.c (main): Don't call setpgrp if !initialized. * Makefile.in.in (${etc}DOC): Put back ${lisp} accidentally deleted. * keymap.c (describe_map_tree): New arg NOMENU. (describe_buffer_bindings): Pass new arg. * doc.c (Fsubstitute_command_keys): Pass new arg to describe_map_tree. Sat Jan 8 00:37:30 1994 Morten Welinder (terra@diku.dk) * keyboard.c (interrupt_signal) [MSDOS]: write explicit CRs since stdout has been made binary. Start at the top of the screen since the internal terminal otherwise will write "below the screen." Fri Jan 7 00:57:49 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (emacs): Don't run inc-vers.el. * config.h.in: Handle HAVE_BCMP. (BSTRING): Don't define unless HAVE_BCMP. Wed Jan 5 16:12:38 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/msdos.h (getppid): Define as macro. * dired.c (DIRENTRY_NONEMPTY): New macro; two definitions. (Fdirectory_files, file_name_completion): Use it. Wed Jan 5 22:20:15 1993 Morten Welinder (terra@diku.dk) * buffer.c, buffer.h [MSDOS]: New buffer-local variable: buffer-file-type to handle DOS newlines. * callproc.c (syms_of_callproc) [MSDOS]: New lisp variable: binary-process. (init_callproc) [MSDOS]: Initialize binary-process. [MSDOS]: Declare binary-process. [MSDOS]: Include , , , and needed for the next changes. (Fcall_process) [MSDOS]: Create temporary file for process output. Run the subprocess using `run_msdos_command' instead of forking. Arrange for cleanup to erase temporary file. (Fcall_process) [not subprocesses]: Barf if zero buffer argument. (call_process_cleanup) [MSDOS]: Close and erase temporary file instead of the pid-stuff. (Fcall_process_region) [MSDOS]: Create temporary file in $TMP or $TEMP. (Fchild_setup) [MSDOS]: #if 0, as it is not used. * cmds.c (keys_of_cmds) [MSDOS]: Chars 0200 to 0237 self-insert. * data.c (Frem) [MSDOS]: use `fmod', not `drem'. Put in config.h? * dired.c [MSDOS]: #include instead of . Avoid some external definitions. (Ffile_attributes) [MSDOS]: Set execute bits from file name. (Ffile_name_all_completions) [FILE_SYSTEM_CASE]: Convert case of file name as as indicated by conditional. * emacs.c (main) [MSDOS]: Call init_environment. Set file types to binary for all files. Call init_dosfns. (fatal_error_signal) [MSDOS]: Uncomment sigblock. * fileio.c [MSDOS]: #include "msdos.h" and needed for the following changes. (Ffile_name_directory, Fexpand_file_name) [FILE_SYSTEM_CASE]: Apply case conversion if defined. (Ffile_name_directory, Ffile_name_nondirectory, file_name_as_directory, directory_file_name, Fexpand_file_name, Fsubstitute_in_file_name, expand_and_dir_to_file) [MSDOS]: Drive letter support. (Fexpand_file_name) [MSDOS]: Support for multiple default directories. (Ffile_writeable_p) [MSDOS]: Don't call access with file name ending in a slash. (Finsert_file_contents) [MSDOS]: Determine file type by name (call find-buffer-file-type) and change CR+LF to LF if it is a text file. (Fwrite_region) [MSDOS]: Use text/binary mode as specified by buffer_file_type. (syms_of_fileio) [MSDOS]: Set Qfind_buffer_file_type. (Fsubstitute_in_file_name) [MSDOS]: Ignore case in environtment variable. * floatfns.c [MSDOS]: Don't define HAVE_MATHERR. * keyboard.c [MSDOS]: #include and , but not . (read_avail_input) [MSDOS]: Work around `ioctl'. Also read through dos_keyread for better keyboard support. (interrupt_signal) [MSDOS]: Don't claim we can core dump. (kbd_buffer_store_event): Cast a pointer to avoid a compiler warning. * lread.c [MSDOS]: Use text mode for all files but ".elc" files. (complete_file_name) [MSDOS]: Drive letter support. * mem-limits.h [MSDOS] (get_lim_data): Use go32 call. * sysdep.c [MSDOS]: #include , "dosfns.h", "msdos.h", and needed for the following changes, but not (discard_tty_input) [MSDOS]: Do it by reading till no more keys available. (init_baud_rate) [MSDOS]: Assume highest possible speed. (sys_suspend) [MSDOS]: Save default directory. Call via system, not via fork. (emacs_get_tty, emacs_set_tty) [MSDOS]: Don't do anything. (init_sys_modes) [MSDOS]: Use raw mode. (get_frame_size) [MSDOS]: Get from bios. (reset_sys_modes) [MSDOS]: Back to cooked mode. (start_of_text) [MSDOS]: Reference _tstart. (select) [MSDOS]: Don't use signals, use sleeping. (init_sys_modes) [MSDOS]: Initialize internal terminal. * systty.h [MSDOS]: don't #include . We haven't got it. Declare dummy main field. Don't ever use TABs. * termcap.c (tgetent) [INTERNAL_TERMINAL]: Fake internal terminal without reading any files. (valid_file_name, tgetent) [MSDOS]: Drive letter support. (tgetent) [MSDOS]: Use text mode for database. * unexec.c [MSDOS]: Don't #include , but use other headers. (make_hdr) [MSDOS]: Cast a pointer for bzero. (write_segment) [EFAULT]: Check for before using. (adjust_lnnoptrs) [MSDOS]: Use provided descriptor. (adjust_lnnoptrs): Return 0 if ok. * xdisp.c (decode_mode_spec) [MSDOS]: Let 't' expand to 'T' for text mode or 'B' for binary mode. (decode_mode_spec) [not subprocesses]: Don't access Fprocess_status. * s/msdos.h, m/dos386.h: New files (for MSDOS). * dosfns.c, dosfns.h: New files (for MSDOS). * msdos.c, msdos.h: New files (for MSDOS). Tue Jan 4 03:41:35 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sunos4-1.h (SUNOS_LOCALTIME_BUG): #if 0'd. * print.c (strout, printchar): Use proper frame for minibuffer. * keyboard.c (read_avail_input): Args to `kill' were backwards. (kbd_buffer_get_event): If deleting last frame, call Fkill_emacs. * fns.c (Fmapconcat): Doc fix. * s/sco4.h (bcopy, bzero, bcmp): Defined. Mon Jan 3 20:22:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (Fx_list_fonts): Don't fail to init `tail'. Sun Jan 2 13:16:53 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c: Don't include syntax.h. * Makefile.in.in (buffer.o): Don't depend on syntax.h. * syntax.h (enum syntaxcode): Add Sinherit. (RAW_SYNTAX, RAW_SYNTAX_MATCH, SYNTAX_CHOOSE_TABLE): New macros. (SYNTAX, SYNTAX_MATCH, SYNTAX_COMSTART_FIRST, SYNTAX_COMSTART_SECOND) (SYNTAX_COMEND_FIRST, SYNTAX_COMEND_SECOND, SYNTAX_PREFIX) (SYNTAX_COMMENT_STYLE): Handle Sinherit. Alternative definitions if __GNUC__. * syntax.c (describe_syntax): Handle Sinherit. (syntax_code_spec, syntax_spec_code): Add entry for @ and Sinherit. * Makefile.in.in (temacs): Delete redundant use of LDFLAGS. Sun Jan 2 19:19:37 1994 Ulrich Mueller (ulm@vsnhd1.cern.ch) * sysdep.c (get_system_name): If the official name of the host is not a fully qualified domain name, then try to find one in the list of alternate names. Sun Jan 2 00:20:24 1994 Rick Sladkey (jrs@world.std.com) * intervals.h (NULL_RIGHT_CHILD, NULL_LEFT_CHILD): Assume children must be intervals, never strings or buffers. * intervals.c (rotate_right, rotate_left): Simplify total_length calculation. Minimize pointer dereferencing. (balance_an_interval): Remove recursive rebalancing. Rebalance precisely when imbalanced. If a rotation is done, rebalance only the node which may have become unbalanced. Iterate until the current node is balanced. (balance_possible_root_interval): New function. (balance_intervals): Move the interation into rebalance_an_interval. (balance_intervals_internal): New subroutine of balance_intervals. (split_interval_right, split_interval_left): Speed up by not checking LEAF_INTERVAL_P. (split_interval_right, split_interval_left, find_interval, adjust_intervals_for_insertion, graft_intervals_into_buffer): Add dynamic rebalancing anywhere a node may become unbalanced. (graft_intervals_into_buffer, copy_intervals): No longer any need to do a full rebalance as the tree stays balanced. Sat Jan 1 02:00:32 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Fwrite_region): Don't change START and END from nil until after checking for a magic handler. * .gdbinit: Delete `show env TERMCAP'. * process.c (read_process_output): Use clip_to_bounds when moving to the process marker. * keyboard.c (modify_event_symbol): New arg NAME_ALIST. Allow SYMBOL_TABLE to be an alist. (Vvendor_key_alist): New variable. (syms_of_keyboard): Initialize it. (make_lispy_event): Handle vendor-specific keysyms. (lispy_function_keys): Delete `remove' and th HP keysyms. * xterm.c (XTread_socket): temp_buffer and temp_index deleted. Put all vendor-specific keys into the buffer. (x_is_vendor_fkey): Function deleted. (XTread_socket): Don't call it. * Makefile.in.in (SOME_MACHINE_OBJECTS): New var. (${etc}DOC): Use SOME_MACHINE_OBJECTS, not OBJECTS_MACHINE or OBJECTS_SYSTEM. Don't depend on SOME_MACHINE_OBJECTS. * dired.c (file_name_completion_stat): If have symlinks, use lstat. Fri Dec 31 05:42:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c (Qget_file_buffer): New variable. (syms_of_buffer): Set up Qget_file_buffer. (Fget_file_buffer): For magic file names, run the handler. * fileio.c (Finsert_file_contents): Don't run after change hook if inserted is 0. Avoid setting modtime or buffer-file-name field if ran a handler. jrs: * s/linux.h (PENDING_OUTPUT_COUNT): Two alternate definitions for different versions of stdio.h. Thu Dec 30 02:09:55 1993 Morten Welinder (terra@diku.dk) * frame.c: Always include termhooks.h. [! MULTI_FRAME] (Fmouse_position): New definition. [! MULTI_FRAME] (syms_of_frame): Add mouse-position. Thu Dec 30 22:05:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * doc.c (Fsubstitute_command_keys): Fix previous change. Thu Dec 30 10:41:39 1993 Lawrence R. Dodd (dodd@roebling.poly.edu) * minibuf.c (read_from_minibuffer): Rename arg initial_input to initial_contents. Thu Dec 30 01:55:54 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * editfns.c (Femacs_pid): New function. (syms_of_editfns): Define it for Lisp. * keyboard.c (read_avail_input): Turn O_NDELAY off on DGUX as on USG. * minibuf.c (Fall_completions): Allow completions that start with space if the input starts with space. * Makefile.in.in (LDFLAGS): Define as empty. (ALL_LDFLAGS): Define as LDFLAGS used to be defined. (temacs): Use ALL_LDFLAGS. * xfns.c (Fx_create_frame): Add to Vframe_list before making visible. Wed Dec 29 02:43:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keymap.c (describe_command): If binding is a kbd macro, say so. Sun Dec 26 00:59:18 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacs.c (main) [AIX]: Call putenv. * s/linux.h (A_TEXT_OFFSET, A_TEXT_SEEK, ADJUST_EXEC_HEADER): Defined. * keyboard.c (lispy_accent_codes): Cope if an XK symbol is undefined. (make_lispy_event): Define i. * termhooks.h (struct input_event): FIx typo in previous change. * xterm.c (XTflash): Use EMACS_GET_TIME. (XTread_socket): Make proper junk values to pass to select. Sat Dec 25 12:20:15 1993 Jerry Frain (jerry.frain@tivoli.com) * s/usg5-4.h (bcopy): Use memmove instead of memcpy. * systime.h (EMACS_GET_TIME) [USG5_4]: Give gettimeofday just one arg. Sat Dec 25 03:11:57 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * alloc.c (Fmemory_limit): No longer interactive. Fri Dec 24 18:11:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (command_loop_1): Test of whether disp tab elt was a vector was backwards. * fileio.c (Fwrite_region): If handler, don't mess with modtime. (Finsert_file_contents): Likewise. * config.h.in: Add #undef HAVE_SETSID. * process.c (create_process) [NTTYDISC]: Set the tty line discipline. * callproc.c: Include systty.h. (child_setup): Use EMACS_SET_TTY_PGRP. * Makefile.in.in (callproc.o): Depend on systty.h and syssignal.h. * xdisp.c (redisplay_window): Before altering lpoint, make sure the buffer it pertains to is the one being displayed. * syntax.c (Fmodify_syntax_entry): Doc fix. Thu Dec 23 22:45:06 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (Fopen_network_stream): Turn off SIGIO while connecting. Wed Dec 22 19:36:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (lispy_accent_codes): New variable. (make_lispy_event): Use that to handle lots of dead accent keys. * xterm.c (XTread_socket): Handle a bunch more dead keys. Wed Dec 22 18:09:45 MET 1993 Francesco Potorti` (pot@cnuce.cnr.it) * m/delta.h (BROKEN_CLOSEDIR): added because closedir is interruptible. (HAVE_UNISTD_H): deleted because configure takes care of it. (C_SWITCH_MACHINE): added optimisation options for gnu cc. Fri Dec 17 00:22:43 1993 Mike Long (mike.long@analog.com) * s/vms.h (TERMCAP_NAME): Defined. * s/netbsd.h (TERMCAP_NAME): Defined. These correspond with changes in termcap.c. Fri Dec 17 13:09:53 1993 Richard Stallman (rms@gnu.ai.mit.edu) * xterm.c (XTread_socket): Don't offset keysym here. Special handling for "dead accent" keysyms. * keyboard.c (make_lispy_event): Offset the event code here. Special handling for "dead accent" keysyms. * keyboard.c (quit_throw_to_read_char): Don't switch frames if internal_last_event_frame is not a frame. * termhooks.h (struct input_event): `code' is now an int. * xterm.c (construct_mouse_click, x_scroll_bar_handle_click) (XTread_socket): `code' of an event is now an int. * keyboard.c (kbd_buffer_store_event, make_lispy_event) (stuff_buffered_input): `code' of an event is now an int. * s/sol2-3.h: New file. * xfns.c (Fx_list_fonts): Handle BROKEN_XLISTFONTSWITHINFO. Thu Dec 16 11:16:22 1993 Richard Stallman (rms@gnu.ai.mit.edu) * xterm.c (pixel_to_glyph_coords): New arg NOCLIP. Callers changed. * keyboard.c (make_lispy_movement): If we have a frame but pos is not in a window, return an event with the frame. * xterm.c (XTread_socket): For MotionNotify, if x_mouse_grabbed, use last_mouse_frame. (construct_mouse_click): Set last_mouse_frame. (XTmouse_position): If x_mouse_grabbed, use last_mouse_frame. * xdisp.c (message): Use message2, not message1. Wed Dec 15 11:20:54 1993 Richard Stallman (rms@gnu.ai.mit.edu) * xfns.c (Fx_create_frame): Add frame to Vframe_list. * frame.c (make_terminal_frame): Add frame to Vframe_list. (make_frame): Don't add to frame list here. * window.c (Fdisplay_buffer): If pop_up_frames, pass t to Fget_buffer_window. * Makefile.in.in (configuration): New variable. (emacs.o): Define macro CONFIGURATION. * emacs.c (syms_of_emacs): Define Lisp var system-configuration. * xdisp.c (display_string): Fix truncation-criterion after main loop for termination due to LENGTH. * window.h (echo_area_glyphs_length): Declared. * print.c (printchar, strout): Set echo_area_glyphs_length. * keyboard.c (read_key_sequence): Don't return if in middle of possible function-key-map sequence, if the bindings were all found by case conversion. * lisp.h: Use WORDS_BIG_ENDIAN, not BIG_ENDIAN. (Qmenu_bar): Declared. * process.c (Fprocess_status): Use get_process, not Fget_process. * s/dgux.h (SYSTEM_TYPE): Make it dgux. * m/sun2.h (OTHER_FILES): Use ${libsrc} as dir. Wed Dec 15 18:30:00 1993 Michal Jankowski (michalj@fuw.edu.pl) * insdel.c (del_range): Second argument in call to offset_intervals is 'from', not 'point'. Tue Dec 14 21:42:46 1993 Richard Stallman (rms@gnu.ai.mit.edu) * emacs.c (memory_warning_signal): New function. (main): Handle SIGDANGER, if defined. * minibuf.c (minibuffer_auto_raise): Really define it. * process.c [BROKEN_O_NONBLOCK]: Undefine O_NONBLOCK. Tue Dec 14 20:59:54 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * dispnew.c (update_frame): Only call sleep (outq / baud_rate) if baud_rate >= OUTQ. Calling sleep (0) causes a gratuitous delay on some systems. Mon Dec 13 00:30:12 1993 Andreas Luik (luik@kepler.isa.de) * xterm.c (x_calc_absolute_position): Borderwidth must be doubled before subtracting from width to get correct value. * xfns.c (Fx_create_frame): Fix order of arguments of x_wm_set_size_hint call. This corrects handling of +x-y and -x+y geometry specifications. Sun Dec 12 19:08:01 1993 Richard Stallman (rms@gnu.ai.mit.edu) * xdisp.c (echo_area_glyphs_length): New variable. (message1): Set it. (message2): New function. (display_string): New arg LENGTH. (echo_area_display): Pass new arg to display_string. (redisplay_window): Likewise. (display_text_line): Likewise. (display_menu_bar): Likewise. (display_mode_element): * editfns.c (Fmessage): Use message2. * keyboard.c (set_waiting_for_input): Code testing echo_flag deleted. (echo_flag, echo_now): Vars deleted. * keyboard.c (read_key_sequence): Bind case_converted at top level. Clear it at replay_sequence. (follow_key): Never clear *CASE_CONVERTED. Sat Dec 11 20:05:35 1993 Richard Stallman (rms@gnu.ai.mit.edu) * xselect.c (x_get_foreign_selection): Use x_catch_errors. * fileio.c (Fmake_symbolic_link): Do expand FILENAME if starts with ~. * keymap.c (Fwhere_is_internal): Doc fix. * buffer.c (Fbuffer_disable_undo): Make arg optional. Sat Dec 11 17:26:28 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * unexsunos4.c [! MAP_FILE] (MAP_FILE): Define to zero. (unexec): Remove unused variable BUF. Use MAP_FILE bit in mmap call. (run_time_remap): Use MAP_FILE bit in mmap call. Thu Dec 9 21:52:16 1993 Richard Stallman (rms@gnu.ai.mit.edu) * insdel.c (modify_region): Call record_first_change if necessary. * emacs.c (main): Don't handle SIGDANGER. * minibuf.c (minibuffer_auto_raise): New variable. (syms_of_minibuf): Set up Lisp var. (read_minibuf): Maybe raise the minibuffer's frame. Wed Dec 8 18:49:40 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * dispnew.c (PENDING_OUTPUT_COUNT) [__GNU_LIBRARY__]: Alternate definition for the GNU C library. I changed this in version 18 in 1991, but the change never got propagated. Tue Dec 7 11:49:34 1993 (pmr@legacy.pajato.com) * s/dgux.h (SYSV4_PTYS): Remove. (SIGNALS_VIA_CHARACTERS): Defined. * process.c (create_process): Delete SYSV4_PTYS code. (deactivate_process): Likewise. Mon Dec 6 21:54:13 1993 Richard Stallman (rms@gnu.ai.mit.edu) * doc.c (Fsubstitute_command_keys): Ignore menu bar bindings. * s/sunos4-1.h (LIBS_SYSTEM): Use -lresolv if HAVE_RES_INIT is not defined and HAVE_GETHOSTNAME is defined. * keyboard.c (syms_of_keyboard): Define Lisp var track-mouse. * keyboard.c (follow_key): New arg case_converted. (read_key_sequence): Pass the new arg. If key has a binding via case-conversion, that does not prevent use of function_key_map. Sun Dec 5 13:33:47 1993 Richard Stallman (rms@gnu.ai.mit.edu) * m/pmax.h (SET_CHILD_PTY_PGRP): Defined. * process.c (create_process) [SET_CHILD_PTY_PGRP]: Do ioctls to set the pgrp of the pty. Sat Dec 4 15:00:10 1993 Richard Stallman (rms@gnu.ai.mit.edu) * xfns.c (XSetWMProtocols): New function, defined conditionally. * config.h.in (HAVE_XSETWMPROTOCOLS): Add #undef. * intervals.c (graft_intervals_into_buffer): If SOURCE is null and TREE is null, no need to call Fset_text_properties. * dispnew.c (Fsit_for): Call prepare_menu_bars. * keyboard.c (read_char): Call prepare_menu_bars. * xselect.c (x_handle_selection_clear): Call prepare_menu_bars. * vmsproc.c (Fcall_process): Call prepare_menu_bars. * sysdep.c [VMS] (wait_for_kbd_input): Call prepare_menu_bars. * process.c (wait_reading_process_input): Call prepare_menu_bars. * callproc.c (Fcall_process): Call prepare_menu_bars. * keyboard.c (tracking_off): Call prepare_menu_bars. * xdisp.c (update_menu_bar, update_menu_bars): New functions. (prepare_menu_bars): New function. (redisplay_window): Don't update menu bar here. (display_menu_bar): Assume item list already updated. Thu Dec 2 23:45:17 1993 Richard Stallman (rms@gnu.ai.mit.edu) * editfns.c (Fsubst_char_in_region): Move the NOUNDO hacking code after the modify_region call. Wed Dec 1 21:01:53 1993 Richard Stallman (rms@gnu.ai.mit.edu) * eval.c (Fmacroexpand): For an autoload definition, check the 4th elt, not the car of the 4th elt. * m/mips4.h (C_DEBUG_SWITCH): Delete -systype bsd43; not needed. * regex.c (regex_compile) [!MATCH_MAY_ALLOCATE]: If fail_stack.stack is nonzero, leave it alone. * fileio.c (Fread_file_name): If defalt is nil and user tries to use it, signal an error. * lisp.h (DEFUN_ARGS_MANY, DEFUN_ARGS_UNEVALLED, DEFUN_ARGS_0,...): New macros. (DEFUN) [__STDC__]: Use those macros. * doc.c (Fdocumentation_property): 3 args is maximum. * callproc.c (Fgetenv): One arg is maximum. Tue Nov 30 17:17:33 1993 Richard Stallman (rms@gnu.ai.mit.edu) * dispnew.c (direct_output_forward_char): Give up if in truncated text at end of line. * process.c (create_process): The test to avoid closing forkin is now conditional on #ifndef SIGNALS_VIA_CHARACTERS. * xdisp.c (redisplay_window): Don't alter lpoint when w is selected window in a non-selected frame. Tue Nov 30 14:46:38 1993 Richard Stallman (rms@gnu.ai.mit.edu) * Makefile.in.in [__GNUC__ > 1]: Maybe define LINKER_WAS_SPECIFIED. [LINKER_WAS_SPECIFIED] (YMF_PASS_LDFLAGS): Define as identity. * m/mips4.h (NO_MODE_T): Defined. Sat Nov 27 04:41:22 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.22 released. * m/tek4300.h (NO_MODE_T): Defined. Fri Nov 26 05:38:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (deactivate_process) [SVR4_PTYS]: If subtty is not nil, close it. * keyboard.c (kbd_buffer_get_event): For delete-window-event, do count iconified frames. * xfns.c (x_window): Call XSetWMProtocols. * keyboard.c (kbd_buffer_get_event): If user destroys the last frame, exit before calling Fdelete_frame. * s/irix5-0.h (SYSTEM_TYPE): Make it "irix". * sysdep.c (closedir): Test BROKEN_CLOSEDIR, not INTERRUPTIBLE_CLOSE. Thu Nov 25 00:39:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_avail_input): Undo Nov 18 change. * lread.c (readevalloop): Get error if buffer being eval'd is killed. * s/irix3-3.h (SETPGRP_RELEASES_CTTY): Defined. * s/irix5-0.h (IRIX5, SETPGRP_RELEASES_CTTY): Defined. * process.c (create_process): Do setpgrp for USG regardless of IRIX. (process_send_signal) [IRIX5]: For SIGTSTP, use VSUSP, not VSWTCH. * callproc.c (child_setup): Test SETPGRP_RELEASES_CTTY, not IRIX. (init_callproc): Fix previous change. * s/sunos4-1-3.h [!SYSTEM_MALLOC] (MEMMOVE_MISSING): Defined. * keyboard.c (quit_throw_to_read_char): Look at internal_last_event_frame only if MULTI_FRAME. * m/ibmrt.h (HAVE_FTIME): Deleted (autoconf does it). * m/hp9000s800.h (bcopy, bzero, bcmp): If HAVE_BCOPY, don't #define. * s/sco4.h (LIBS_SYSTEM): Always define this one way or another. Include -lPW in it. * intervals.c (merge_properties_sticky): Declared. * regex.c (MAX, MIN): Undef before defining. * frame.c (Fhandle_switch_frame, Fredirect_frame_focus): Declared. * m/delta.h (HAVE_RANDOM, HAVE_XSCREENNUMBEROFSCREEN, BROKEN_FIONREAD): Add definitions. (LIB_X11_LIB, LIBX11_SYSTEM): Add override definitions. (USG_SHARED_LIBRARIES): Add #undef. * sysdep.c (init_baud_rate): Avoid referring to sg uninitialized. Wed Nov 24 03:01:23 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacs.c (main) [AIX]: Don't handle signals 23, SIGAIO, SIGPTY. * indent.c (Fmove_to_column): Increments for control characters were too low by 1. * process.c (Fdelete_process): Fix paren error. * sysdep.c (closedir): Pass on the value from sys_closedir. Do use this definition, if INTERRUPTIBLE_CLOSE. Tue Nov 23 00:09:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sco4.h (LIBX11_SYSTEM): Override the definition. * xterm.c (XTread_socket): Really handle Xatom_wm_window_moved events. * s/irix5-0.h (SIGNALS_VIA_CHARACTERS): Defined. * fileio.c (Finsert_file_contents): Don't call signal_after_change if we did not call prepare_to_modify_buffer. * editfns.c (make_buffer_string): Don't copy intervals if we don't really have any properties. * lisp.h: Declare Fnext_single_property_change and Fnext_property_change. * s/sco4.h (HAVE_GETTIMEOFDAY): Define only if HAVE_SOCKETS. Fix up conditionals changed recently. * editfns.c (Finsert_buffer_substring): Pass graft_intervals_into_buffer the current buffer. * intervals.c (graft_intervals_into_buffer): New arg LENGTH. If source has no intervals, set dest properties to nil. * editfns.c (Finsert_buffer_substring): Pass new arg. * insdel.c (insert_from_string): Likewise. * callproc.c (init_callproc): Maybe add ../lib-src to exec-path and maybe store it in exec-directory. Mabe put ../etc into data-directory. (init_callproc_1): Part of init_callproc is split out. * emacs.c (main): Call init_callproc and init_callproc_1. Mon Nov 22 10:01:51 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * editfns.c (Fsubst_char_in_region): Call modify_region only if a change has to be made. Call signal_after_change just once, at end. * lread.c (OBARRAY_SIZE): Increase from 509. * xrdb.c (search_magic_path): Fix colon-colon case. * textprop.c (Ftext_property_not_all): For trivial yes, return start, not Qt. * xselect.c (Fx_disown_selection_internal): When making the fake event for x_handle_selection_clear, use SELECTION_EVENT_... macros. Sun Nov 21 14:06:21 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sunos4-1-3.h (HAVE_TERMIOS, BSD_TERMIOS): Deleted. * systty.h (EMACS_GET_TTY_PGRP, EMACS_SET_TTY_PGRP): If HAVE_TERMIOS and BSD_TERMIOS, don't use tc[sg]etpgrp. * xfns.c (x_set_frame_parameters): Call check_frame_size before Fset_frame_size and Fset_frame_position. * termhooks.h (delete_window_event): New event kind. * xterm.c (XTread_socket): Generate delete_window_event's. * keyboard.c (kbd_buffer_get_event): Handle delete_window_event's. * s/sco4.h [HAVE_SOCKETS] (HAVE_XSCREENNUMBEROFSCREEN): Defined. * keymap.c: Doc fix. * window.c (window_loop, case DELETE_BUFFER_WINDOWS): Select a new buffer only if w is selected window. * hftctl.c: Include config.h. Include sys/signal.h before config.h. (sav_alrm): Use SIGTYPE. (FUNC): Typedef deleted. * Makefile.in.in (hftctl.o): New rule. * process.c (wait_reading_process_input): Use -1 to mean wait_channel is empty. Start process loop with descriptor 0 if keyboard_descriptor is not 0. (make_process): Initialize descriptors to -1. (Fdelete_process): -1 means empty, in infd. (deactivate_process): Likewise. (process_send_signal): Likewise. (kill_buffer_processes): Likewise. (sigchld_handler): Likewise. (status_notify): Likewise. (close_process_descs): Likewise. (create_process): Likewise. (Fopen_network_stream): Likewise. (send_process): Likewise. (Fprocess_send_eof): Likewise. Use XINT when closing outfd. (Fset_process_filter): Use XINT to get infd value. (wait_reading_process_input): Likewise. * process.c (wait_reading_process_input): When bypassing select, clear Available. * sysdep.c (getwd): If getcwd returns 0, we return 0. (getwd for VMS): Likewise. Sat Nov 20 00:52:53 1993 Paul Reilly (pmr@legacy.pajato.com) * s/dgux.h (PTY_ITERATION, PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF): Defined (copied from usg5-4.h). (FIRST_PTY_LETTER): Deleted. Sat Nov 20 00:16:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.c (Fmake_frame_visible): Doc fix. * textprop.c (Ftext_property_not_all): Swap t and nil values in the case where there are no intervals. (Fprevious_single_property_change, Fprevious_property_change) Extra arg LIMIT. Return value was off by 1. (Fnext_single_property_change, Fnext_property_change): Extra arg LIMIT. (Fnext_single_property_change): Require at least 2 args. * indent.c (compute_motion): Pass new arg to Fnext_single_property_change. * xfaces.c (compute_char_face): Accept new arg LIMIT. Pass Fnext_single_property_change its new arg LIMIT. * xdisp.c (display_text_line): Pass new arg to compute_char_face and to Fnext_single_property_change. * dispnew.c (direct_output_for_insert): Pass new arg to compute_char_face. * keyboard.c (follow_key): When downcasing, downcase just the basic part of the character, and preserve the modifier bits. Fri Nov 19 22:49:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): If we get a quit, and current buffer has changed, replay it to get proper keymap. (quit_throw_to_read_char): Switch frames to the frame the quit was in. Fri Nov 19 20:42:06 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * buffer.c (Frename_buffer): When the current buffer is already named NAME, don't short-circuit and just return unless UNIQUE is nil. This makes passing UNIQUE=t equivalent to (rename-buffer (generate-new-buffer-name NAME)). This is useful way to rename the buffer automatically so you can create another with the original name. Fri Nov 19 12:43:47 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (quit_throw_to_read_char): Select the frame which the quit char was typed in. * s/linux.h (HAVE_UNISTD_H): No need to define here. * buffer.c (Flist_buffers): Always return a value. * minibuf.c (read_minibuf): History list always gets strings, not Lisp objects made by read. Thu Nov 18 01:04:39 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_avail_input): Don't set nread to -1 if we loop around in the loop that calls read. * sysdep.c (read_input_waiting): read_socket_hook delivers events, not characters. Make buf smaller in the case where we actually call read itself. * ralloc.c (r_alloc_init): Explicitly use real_morecore to allocate the entire incomplete page. * frame.c (Fmake_frame_visible): Use FRAME_SAMPLE_VISIBILITY. * s/dgux.h (FIRST_PTY_LETTER): Defined. Wed Nov 17 06:01:02 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keymap.c (Fkey_binding): Doc fix. * cmds.c (keys_of_cmds): Make 0377 self-inserting. Tue Nov 16 00:34:22 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.21 released. * doprnt.c (doprnt): Cast the value alloca returns. * gmalloc.c [HPUX8]: Include unistd.h earlier on. * s/sunos4shr.h (GNU_MALLOC, REL_ALLOC): Don't define if already defined. * s/hpux8.h (LD_SWITCH_SYSTEM) [hp9000s700]: Add -L/lib/pa1.1. * Makefile.in.in (extraclean): Prevent wildcard from starting comment. (distclean): Do delete Makefile and Makefile.in. Sun Nov 14 18:00:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * systty.h [BSD_TERMIOS]: Under NL0, NL1..., ECHO, NOFLSH, TOSTOP, FLUSHO and PENDIN. * s/sunos4-1-3.h (BSD_TERMIOS): Defined. * regex.c (re_set_registers): Use `regoff_t *' when casting 0. * Makefile.in.in: Delete spurious CFLAGS=-g. * s/sco4.h (HAVE_GETTIMEOFDAY): Don't define if already defined. * keyboard.c (read_avail_input): Make cbuf 1 char shorter. Sun Nov 14 00:14:37 1993 Paul Reilly (pmr@legacy.pajato.com) * s/dgux.h (INTERRUPT_INPUT): Undefined. (BROKEN_FIONREAD): Defined to work around a problem in DGUX whereby emacs will stop on a background write when invoked from a job control shell for the first time in a session. (FIRST_PTY_LETTER): Undefined. (PTY_ITERATION, PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF): Defined to use all the available PTYs in a COFF environment. (LINKER): Removed "-nostdlib" from to be compatible with a prior mod removing "/lib/crt0.o" from the LIBS_SYSTEM define. (LIBS_SYSTEM): Delete /lib/crt0.o. Sun Nov 14 01:29:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (XTread_socket): Increase length of copy_buffer to 81. * lread.c (read1): If token has a \, don't treat it as a number. Sat Nov 13 01:18:56 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (IN_ADDR, NUMERIC_ADDR_ERROR): New macros (two versions). (Fopen_network_stream): Use them. * doprnt.c: Include config.h. * keyboard.c (read_avail_input) [no FIONREAD]: On DGUX, as on USG, read input with O_NDELAY. * s/dgux.h (SYSTEM_MALLOC): Turned off. (NO_TERMIO): Defined. (BROKEN_FASYNC): Turned off. * buffer.c (Foverlay_put): Don't call redisplay_region if overlay has no buffer. Fri Nov 12 15:38:15 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (get_process): Add `static' to definition. * xterm.c (XTmouse_position): Delete test inserted Nov 10. * fileio.c (syms_of_fileio): Fix missing \n\'s. * keyboard.c (Fread_key_sequence): Split the doc string with "". * textprop.c (Fprevious_single_property_change): Fix missing \n\. (Fnext_single_property_change): Likewise. Wed Nov 10 21:32:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.20 released. * callproc.c (Fcall_process): Clear synch_process_death and synch_process_retcode before the vfork. * xterm.c (XTmouse_position): Undo roland's change. Fix bug in bfox change. Wed Nov 10 17:58:16 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * unexec.c [! HPUX]: Don't declare sbrk at all, so as not to conflict with system headers. * xterm.c (XTmouse_position): First arg is FRAME_PTR, not FRAME_PTR *. Wed Nov 10 15:12:22 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/convexos.h: New file. Wed Nov 10 15:12:22 1993 Brian Fox (bfox@mole.gnu.ai.mit.edu) * Makefile.in.in (intervals.o): Depend on puresize.h. * intervals.c (create_root_interval): Check to see if PARENT is in pure memory. If so, we cannot write it. (includes): Add "puresize.h" so we get the definition of CHECK_IMPURE. * xterm.c (XTmouse_position): If the passed in frame is not an Xwindow frame, don't do anything. * frame.c (Fraise_frame): Do like the documentation says, and make the frame visible first. * systty.h (EMACS_GETPGRP): New macro hides argument passing to system getpgrp. Reinstate some semblance of control over this macros behaviour by paying attention to GETPGRP_NO_ARG. * sysdep.c (sys_suspend): Use EMACS_GETPGRP macro. * emacs.c (main): Use EMACS_GETPGRP macro. (shut_down_emacs): Use EMACS_GETPGRP macro. * alloc.c (make_pure_string): If we USE_TEXT_PROPERTIES, set the interval of the pure string to NULL_INTERVAL. * syswait.h: Treat convex like hpux. * search.c (Fskip_chars_backward, Fskip_chars_forward): Doc fix. Wed Nov 10 01:09:22 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * syntax.c (Fforward_comment): On backward scan, exit inner loop after we reach beginning of a comment. Check the SYNTAX_COMMENT_STYLE of a one-character comment ender. (scan_lists): Check the SYNTAX_COMMENT_STYLE of a one-character comment ender. * sysdep.c (read_input_waiting): Don't mess with meta bit if read_socket_hook is nonzero. * sysdep.c (LPASS8, LNOFLSH): Move definitions earlier. (child_setup_tty): Turn on LPASS8. * search.c (skip_chars): Finish reenabling checks for buffer bounds. Use XINT, not XFASTINT, when testing. * fileio.c (Fwrite_region): Fix minor bugs in POS arg to awrite. * xterm.c (syms_of_xterm): Initialize last_mouse_scroll_bar. Tue Nov 9 16:33:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c, editfns.c: Doc fix. Sat Nov 6 00:13:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sysdep.c (child_setup_tty): Make the pty handle 8-bit characters. Thu Nov 4 17:09:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/linux.h [TERM]: Alternate definitions of LIBS_MACHINE and C_SWITCH_MACHINE. * process.c [TERM]: Include client.h. (Fopen_network_stream): Handle TERM. Wed Nov 3 15:31:21 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_new_font): xmalloc arg was 1 too small. Mon Nov 1 23:59:26 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sunos4-1-3.h (HAVE_TERMIOS): Defined. Mon Oct 25 00:41:31 1993 Brian Fox (bfox@albert.gnu.ai.mit.edu) * process.c (Fopen_network_stream): Cast arg to inet_addr to (char *). * search.c (Freplace_match): Fix argument names to match doc string. (Fmatch_beginning): Fix doc string to match argument name. * floatfns.c: Declare `logb' only if HAVE_LOGB is defined. * fileio.c (Fcopy_file): Don't allow the copying of anything other than regular files or symlink files. Sun Oct 24 17:25:52 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): Arg prompt is now a Lisp object. Pass it to functions found in function-key-map and key-translation-map. (Fread_key_sequence, command_loop_1): Calls changed. Fri Oct 22 07:22:12 1993 Brian Fox (bfox@albert.gnu.ai.mit.edu) * config.h.in: Add #undef HAVE_UNISTD_H so configure can edit it correctly. Thu Oct 21 21:15:37 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * process.c (status_notify): Don't read from process if filter is t. (Fset_process_filter): Set or clear bit in input_wait_mask when nec. Tue Oct 19 22:46:54 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * data.c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions. Tue Oct 12 18:14:58 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): Allow function in key-translation-map just as in function-key-map. Mon Oct 11 00:13:12 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c (Fdelete_overlay, Foverlay_put): Use marker_position, not OVERLAY_POSITION, to get args for redisplay_region. * fileio.c (Fcar_less_than_car): Fix typo in previous change. Sat Oct 9 16:43:23 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * floatfns.c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions. * fileio.c (Vafter_insert_file_functions): New variable. (Vwrite_region_annotate_functions): New variable. (Qcar_less_than_car): New variable. (Fcar_less_than_car): New function. (syms_of_fileio): Make Lisp variables and function available. staticpro Qcar_less_than_car. (a_write, build_annotations): New functions. (Fwrite_region): Call them. (Finsert_file_contents): Run the Vafter_insert_file_functions. Fri Oct 8 11:05:23 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sco4.h (SYSTEM_TYPE): Put into #if 0. (BSTRING): Define only if HAVE_BCOPY. Fri Oct 8 03:36:20 1993 Brian Fox (bfox@albert.gnu.ai.mit.edu) * search.c (skip_chars): Re-instate the check against the end of the buffer, ignoring cryptic comment. Thu Oct 7 21:29:38 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): Allow function-key-map to have a function as the binding; call the function and use its value. Mon Oct 4 03:48:51 1993 Brian J. Fox (bfox@ai.mit.edu) * minibuf.c (Fminibuffer_complete_word): GCPRO1 `completion' during calls to Ftry_completion. * keyboard.c (read_key_sequence): Don't declare first_event; it is no longer used. Change "#if 0" for first_event reading to "#if defined (GOBBLE_FIRST_EVENT)". Sun Oct 3 12:21:23 1993 Brian J. Fox (bfox@ai.mit.edu) * lisp.h: Doc fix. * minibuf.c (read_minibuf): Rewrite change of Sep 14. Save the return value on the history list provided in the form that the value is returned, iff the value is not equal to the front of the history list. Sun Oct 3 19:03:19 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * Makefile.in: File removed. It is now generated by ../configure. * Makefile.in.in (LIBES): Add $(GNULIB_VAR) again at end. This change to ymakefile was mysteriously lost. Were any others lost too? Sat Oct 2 15:07:50 1993 Brian J. Fox (bfox@ai.mit.edu) * minibuf.c (Fread_no_blanks_input): Change DEFUN to allow 2nd arg to be optional. The code was already written correctly. Thu Sep 30 01:22:06 1993 Brian J. Fox (bfox@ai.mit.edu) * systty.h: If POSIX and HAVE_UNISTD_H are defined, and unistd.h hasn't already been included, include it. * s/linux.h (POSIX_SIGNALS): Comment fix. Thu Sep 30 19:37:15 1993 Brian Fox (bfox@albert.gnu.ai.mit.edu) * Makefile.in.in (ALL_CFLAGS): Make sure that `.' is searched before `${srcdir}' when looking for include files. Tue Sep 28 05:56:12 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * termhooks.h (enum event_kind): Doc fix. Mon Sep 27 08:59:44 1993 Brian Fox (bfox@ai.mit.edu) * ymakefile: Merged into Makefile.in.in. * Makefile.in.in: New file. Now ../configure creates Makefile.in from Makefile.in.in, and creates Makefile from Makefile.in. ymakefile no longer exists, and xmakefile is never created. Fri Sep 24 18:22:32 1993 Brian Fox (bfox@ai.mit.edu) * textprop.c (validate_plist): Add declaration for `list' argument. * frame.c (Fhandle_switch_frame): Doc fix. Sat Sep 25 18:46:34 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * puresize.h: [MULTI_FRAME]: Increase PURESIZE to 220000. Thu Sep 16 16:09:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sunos4-1.h (LIBS_SYSTEM): Use -lresolv if it seems appropriate. * config.h.in: Add #undef HAVE_RES_INIT. Tue Sep 14 15:06:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * m/mips4.h (LIB_STANDARD): Add a second -lc after crtn.o. Mon Sep 13 00:07:33 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * pwd.h: File deleted. * intervals.c (graft_intervals_into_buffer): New arg INHERIT. * editfns.c (Finsert_buffer_substring): Pass extra arg to graft_intervals_into_buffer. * insdel.c (insert_from_string): Likewise. New arg INHERIT. (insert_from_string_before_markers): New arg INHERIT. * search.c (Freplace_match): Call Finsert_and_inherit. * editfns.c (Finsert_and_inherit): New function. (Finsert_and_inherit_before_markers): New function. (Finsert, Finsert_before_markers): Pass new arg to insert_from_string*. * minibuf.c (Fminibuffer_complete_word): Pass new arg to insert_from_string*. * doc.c (Fsubstitute_command_keys): Pass new arg. * abbrev.c (Funexpand_abbrev, Fexpand_abbrev): Pass new arg. * s/aix3-2.h (AIX3_2): Defined. * m/ibmrs6000.h (LIBS_MACHINE): Include -lrts, -liconv only if AIX3_2. * xterm.h (HAVE_X11R4): If AIX, do not define HAVE_X11R4. Sun Sep 12 08:36:02 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sysdep.c (bzero, bcopy, bcmp): Don't define as functions if they are defined as macros. Sat Sep 11 21:28:18 1993 Roland McGrath (roland@baalperazim.gnu.ai.mit.edu) * lread.c, callproc.c, filelock.c: Include , not "paths.h". Sat Sep 11 17:34:38 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/linux.h (LIBS_MACHINE): Make definition empty. Fri Sep 10 01:03:00 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * Support configuring in a different directory when ${srcdir} has already been configured. * frame.c, xfns.c, xdisp.c, casetab.c, cm.c, casefiddle.c, xterm.c, xrdb.c, eval.c, doc.c, lread.c, callint.c, cmds.c, term.c, fns.c, data.c, alloc.c, unexconvex.c, fileio.c, indent.c, bytecode.c, sunfns.c, xmenu.c, buffer.c, textprop.c, marker.c, print.c, emacs.c, dispnew.c, syntax.c, undo.c, mocklisp.c, scroll.c, search.c, ralloc.c, unexaix.c, unexec.c, unexenix.c, unexmips.c, unexsunos4.c, vmsfns.c, vmsmap.c, dired.c, xselect.c, floatfns.c, filelock.c, sysdep.c, abbrev.c, minibuf.c, xfaces.c, callproc.c, insdel.c, intervals.c, process.c, vm-limit.c, window.c, vmsgmalloc.c, keymap.c, editfns.c, keyboard.c, macros.c, vmstime.c: Include instead of "config.h". * ymakefile (ALL_CFLAGS): Put -I. before -I${srcdir}. * Makefile.in (xmakefile): Use -I. in cpp run. * Makefile.in (clean): Use rm -f. * s/netbsd.h: New file. * ymakefile (LIBES): Add $(GNULIB_VAR) again at end. Wed Sep 8 12:16:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sysdep.c (stuff_char): Use input_fd. (narrow_foreground_group, widen_foreground_group, init_sys_modes) (init_baud_rate, init_sigio, request_sigio, unrequest_sigio): Likewise. (change_input_fd): New function. * process.c (keyboard_descriptor): New variable. (wait_reading_process_input, init_keyboard): Use it. Also call change_input_fd. (change_keyboard_wait_descriptor): New function. * xterm.c (x_term_init): Call change_keyboard_wait_descriptor, instead of dup2. Use the existing X desc number in fcntl calls. * xterm.c (XTread_socket): Don't forget to clear out `mask'. Wed Sep 8 17:25:40 MET 1993 Francesco Potorti` (pot@cnuce.cnr.it) * filelock.c (fill_in_lock_short_file_name): Fix the crc generation algorithm. Thu Aug 19 16:19:30 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * textprop.c (F{next,previous}_single_property_change): Doc fix. Wed Sep 15 13:09:20 1993 Brian Fox (bfox@ai.mit.edu) * data.c: Add declaration for atof if not predefined. * xfns.c (XScreenNumberOfScreen): Move assignments out of declarations for (dpy, dpyscr). * sysdep.c (sys_write): Keep trying to write out the data until all of the data is written, or until we receive an error which is not an interrupted write. Tue Sep 14 01:53:37 1993 Brian Fox (bfox@ai.mit.edu) * keyboard.c (Qextended_command_history): New variable prevents sharing of M-x command history with other commands that read values in the minibuffer. * doprnt.c (doprnt): Use a fixed buffer to store the format specification, but only if we are sure it will fit. Otherwise, use alloca to get enough space. Don't allow negative size specifications to core dump; instead, treat them as positive ("%-20d" == "%20d"). * minibuf.c (read_minibuf): Don't add history item if it is string-equal to the most recent history item. Fri Jul 9 17:19:35 1993 Karl Berry (karl@cs.umb.edu) * dired.c (file_name_completion): Install case-preserving changes from Emacs 18 for completion_ignore_case. (completion_ignore_case): Declare. Wed Sep 1 09:47:36 1993 Brian Fox (bfox@ai.mit.edu) * window.c (Fdelete_windows_on): Fix DEFUN to allow optional second argument to appear. Mon Aug 30 08:03:49 1993 Brian Fox (bfox@ai.mit.edu) * ymakefile (alloc.o): Remove explicit compilation rule, since it is identical to the default rule, and `$<' doesn't work in explicit rules in all "make"s. Fri Aug 27 00:43:06 1993 Brian Fox (bfox@ai.mit.edu) * gmalloc.c (safe_bcopy): Compile if MEMMOVE_MISSING is defined, but only if we aren't compiling for emacs. * sysdep.c (read_input_waiting): If the user specifies `meta-flag', then notice characters with high-bit set. * Added fixes from Karl Berry for ISC-2.2. * s/isc2-2.h (MEMMOVE_MISSING): Define. (SIGNALS_VIA_CHARACTERS): Define. (LIB_STANDARD): Do not include -lcposix. (C_SWITCH_SYSTEM) [__GNUC__]: Do not use -traditional. Tue Aug 17 12:20:43 1993 Brian Fox (bfox@ai.mit.edu) * alloca.c: Invert sense of conditional for entire file (GNUC >= 2). Added `#else'. * xterm.c (x_wn_set_size_hint): Make recent window gravity addition depend on "PWinGravity" being `#defined'. Sat Aug 14 00:23:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.19 released. * Makefile.in (mostlyclean): Don't delete emacs here. (clean): Delete emacs and emacs-* here. (distclean): Don't delete emacs-* here. * xselect.c (struct property_change): New field `arrived'. (expect_property_change): Return struct property_change *. Clear `arrived'. (unexpect_property_change): Take one as argument. (wait_for_property_change): Take one as argument. If `arrived' is set, don't wait. (wait_for_property_change_unwind): Corresponding changes. (receive_incremental_selection): Corresponding changes. (x_reply_selection_request): Corresponding changes. (property_deleted_p): Function deleted. * xselect.c (x_handle_selection_clear): Redisplay. * search.c (compile_pattern): Cast result of re_compile_pattern. * emacs.c (init_cmdargs): Check openp result for 1, not != 0. * xterm.c (x_wm_set_size_hint): New args spec_x and spec_y. Set the window gravity. All callers changed. * xfns.c (Fx_create_frame): Pass the new args to x_wm_set_size_hint. * xmenu.c (Fx_popup_menu): Adjust coords so they are relative to the inner window. * syswait.h: New file. * sysdep.c, process.c: Include it. * ymakefile (sysdep.o, process.o): Depend on syswait.h. * process.c (wait_reading_process_input): Exit without waiting if wait_for_cell is already non-nil. * sysdep.c (mkdir, rmdir): Use wait_for_termination to wait. Redirect descriptors 0...2 to /dev/null. * emacs.c (__CTOR_LIST__): Don't declare it on Linux. * filelock.c (getpwuid): Declare it as in xrdb.c. (init_filelock): Don't use return value of strcpy. * fns.c (internal_equal): Typo in previous change. * xfns.c (x_set_frame_parameters): Don't die if just one of height and width was set. Likewise left and top. * textprop.c (property_change_between_p): Test NULL_INTERVAL_P in loop, before looking at next->position. * intervals.c (adjust_intervals_for_insertion): If inserting in middle of interval that is sticky in neither direction, don't copy props. (merge_properties_sticky): Handle non-list as front-sticky or rear-nonsticky property. Fri Aug 13 23:49:07 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fns.c (internal_equal): All markers in no buffer are equal. Fri Aug 13 19:35:52 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * config.h.in: Added #undef HAVE_XSCREENNUMBEROFSCREEN. Fri Aug 13 17:38:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (XScreenNumberOfScreen): New function. * m/tek4300.h (C_DEBUG_SWITCH, SYSTEM_MALLOC): Defined. * m/iris4d.h (START_FILES, LIB_STANDARD): Don't define if USG5_4. (DEFAULT_ENTRY_ADDRESS): Likewise. (UNEXEC): Use unexelfsgi.o if USG5_4. * s/irix5-0.h (C_SWITCH_MACHINE): Deleted. Fri Aug 13 07:42:39 1993 Frederic Pierresteguy (F.Pierresteguy@frcl.bull.fr) * m/dpx2.h: Delete conditionals for HAVE_X_WINDOWS and HAVE_SOCKETS. Fri Aug 13 00:33:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * m/iris4d.h (C_ALLOCA): Don't define it. * keyboard.c (kbd_buffer_store_event): Use bcopy to copy a selection request event. * unexnext.c (get_data_region): Add cast to avoid warning. Thu Aug 12 01:38:36 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ymakefile (prefix-args, filemode.o, lastfile.o): Dep on $(config_h). * floatfns.c (Flogb): Error at run time if not supported. * ymakefile (emacs.o): Depend on process.h and syssignal.h. * emacs.c: Include process.h. (init_cmdargs): Use EXEC_SUFFIXES. * s/irix5-0.h: Include alloca.h if appropriate. Fix the #include file name. (ULIMIT_BREAK_VALUE, GETPGRP_NO_ARG, NO_MATHERR): New macros. (LIB_STANDARD): #undef it. * frame.c (Fdelete_frame): Add parens for clarity. * keyboard.c (read_char): Never start echoing if -batch. * minibuf.c (Qread_file_name_internal): New var. (syms_of_minibuf): Set it up and protect it. (Fminibuffer_complete_word): When completing a file name, expand envvar references. * xterm.c (XTread_socket): Make copy_buffer unsigned. * s/usg5-4-2.h (HAVE_GETHOSTNAME): #if 0'd. Wed Aug 11 00:25:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/hpux8.h (LD_SWITCH_SYSTEM): Delete the -L options. * termhooks.h (enum event_kind): Delete final comma. (meta_modifier): Delete final comma. * window.c (enum window_loop): Delete final comma. * xfns.c (enum resource_types): Delete final comma. * m/ibmrs6000.h (BIG_ENDIAN): Don't actually define it. * window.c (Frecenter): Preserve point in the buffer we change it in. * cmds.c (Fnewline): If we don't do the first SET_PT, clear flag, so we don't do the second SET_PT. * keyboard.c (make_lispy_event): Clear all but 0377 in event->code. * xselect.c (receive_incremental_selection): Use bcopy, not memcpy. * m/tek4300.h (BIG_ENDIAN): Provide a value that matches the system. * config.h.in: Add #undef HAVE_FTIME. * ymakefile (ALL_CFLAGS): Use C_SWITCH_X_SITE before C_SWITCH_X_SYSTEM and C_SWITCH_X_MACHINE. * s/hpux8.h (C_SWITCH_X_SYSTEM): Define instead of C_SWITCH_SYSTEM. Wed Aug 11 02:21:15 1993 Shane Hartman (shane@nugget.spr.com) * buffer.c (verify_overlay_modification): Initialize endpos. * keymap.c (describe_buffer_bindings): Declare shadow just once. Tue Aug 10 01:46:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (x_calc_absolute_position): For negative coords, take account of added width from window manager's outer window. * term.c (term_get_fkeys_define_1, term_get_fkeys_define): New functions. (term_get_fkeys): Use them. * m/tekxd88.h: Renamed from tekXD88.h. (LIB_X11_LIB, LIBX11_SYSTEM): Make #undefs unconditional. * systty.h: Handle NO_TERMIO in principal HAVE_TERMIOS case. * xrdb.c (x_get_customization_string): Don't use value of strcpy. * floatfns.c (Fexpt): Use IN_FLOAT2. Tue Aug 10 15:12:13 1993 Frederic Pierresteguy (F.Pierresteguy@frcl.bull.fr) * m/dpx2.h (HAVE_TCATTR): Macro #defined. (HAVE_CLOSEDIR): #undef to allow use of closedir in sysdep.c. (SIGTSTP): Commented #undef to allow use of ^Z in shell-mode. (SIGNALS_VIA_CHARACTERS): #defined. Mon Aug 9 21:40:23 1993 Paul Eggert (eggert@twinsun.com) * data.c (Fmod): New function; result is always same sign as divisor. (syms_of_data): Add Smod. * emacs.c (main): Invoke syms_of_floatfns even if LISP_FLOAT_TYPE isn't defined, since `(floor A B)' is now needed for integers. * floatfns.c (syms_of_floatfns): Likewise. (Ffloor): Optional second operand specifies divisor, as in Common Lisp. Mon Aug 9 21:32:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * unexelf.c (unexec): Add casts for some comparisons. (PATCH_INDEX): Likewise. Sun Aug 8 01:15:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.18 released. * term.c (term_init): Improve error messages (give sh commands). * xterm.c (struct font_info): New structure. (x_font_table): Use struct font_info as elements. (x_new_font): Corresponding changes. Use XListFonts, not XListFontsWithInfo. Use XFreeFontNames, not XFreeFontInfo. Compare fonts by name, not by fid. If already_loaded is 0, that counts as "yes". * minibuf.c (Qminibuffer_setup_hook, Vminibuffer_setup_hook): New vars. (syms_of_minibuf): Set them up. (read_minibuffer): Run the hook, if not empty. * dispnew.c (direct_output_forward_char): Fix previous change: verify position is in range before calling Fget_text_property, and calculate position properly. * s/bsd4-2.h, s/bsd4-3.h, s/umax.h, s/rtu.h, s/dgux.h (HAVE_VFORK): Defined. * ymakefile (alloc.o): Don't use DEBUG_MOLE. (DEBUG_MOLE): Deleted. * gnu-hp300: File deleted. * .gdbinit: Don't put -q in args. Don't unset TERM and TERMCAP--show them instead. * alloc.c (mark_object): Declare ptr volatile, or don't use it after a recursive call. Delete the aborts if ptr is clobbered. * fileio.c (expand_and_dir_to_file): Use Fdirectory_file_name. Sun Aug 8 01:56:15 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * config.h.in (HAVE_LOGB, HAVE_FREXP): Add #undefs for the configuration script to edit. * floatfns.c (Flogb): Use HAVE_LOGB and HAVE_FREXP, instead of assuming that all USG systems have FREXP. Sat Aug 7 14:56:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacs.c (Vinvocation_directory): New var. (init_cmdargs): Set up its value. (Finvocation_directory): New function. (main): Call init_buffer, init_callproc and init_cmdargs before init_lread. (syms_of_emacs): Install the function, and protect the variable. * lisp.h (Vinvocation_directory): Declared. * lread.c (init_lread): Normally put Vinvocation_directory at end of Vload_path, if not present already. Fri Aug 6 13:28:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (set_poll_suppress_count): New function. * eval.c (unwind_to_catch): Call set_poll_suppress_count. * xterm.c (x_term_init): Set the hooks before we call Fset_input_mode. * keyboard.c (Fset_input_mode): Start polling, if appropriate. At the beginning, stop polling. Remove period from error message. (stop_polling, start_polling): Check for interrupt_input. (POLL_FOR_INPUT): Define whether or not target supports SIGIO. * m/ibm370aix.h (HAVE_VFORK, INTEL386, aix386): Add #undef. Thu Aug 5 13:38:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * eval.c (do_autoload): Don't report autoload failure if the autoload definition now is a different one. * m/ibm370aix.h: Total rewrite; includes ibmps2-aix.h. * m/ibmps2-aix.h (SYSTEM_TYPE): Don't redefine it here. * syntax.c: Doc fix. Wed Aug 4 00:14:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fns.c (Fyes_or_no_p): Use Qyes_or_no_p_history. (syms_of_fns): Set up Qyes_or_no_p_history. * fileio.c (expand_and_dir_to_file): Remove final / by copying abspath. * data.c (Frem): Don't accept floats, just ints and markers. * m/vax.h [BSD4_2] (HAVE_FTIME): Defined. Tue Aug 3 14:21:15 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * m/7300.h (CRT0_COMPILE): Add -O and -Demacs. * ymakefile (CRT0_COMPILE): Add missing #endif. Tue Aug 3 02:58:23 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) Changes for 3b1 suggested by Andy Fyfe * 7300.h [__GNUC__]: #define HAVE_ALLOCA. [not __GNUC__]: #define SWITCH_ENUM_BUG, C_ALLOCA, and STACK_DIRECTION. (HAVE_SYSVIPC, USE_UTIME): #define these. (memmove): We don't have this; call safe_bcopy. (CRT0_COMPILE): #define this, so we always use the system's cc. * config.h.in: Add #undefs for HAVE_MKDIR and HAVE_RMDIR, for configure to edit. * sysdep.c [not HAVE_MKDIR] (mkdir): New function, taken from tar, for use on systems lacking the mkdir function. [not HAVE_RMDIR] (rmdir): New function, taken from tar, for use on systems lacking the rmdir function. * ymakefile (crt0.o): Replace the compiler and switches with the symbol CRT0_COMPILE. (CRT0_COMPILE): If the system and machine description files have left this undefined, then define it to do the same as the old crt0.o rule used to. Mon Aug 2 22:40:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sysdep.c (vfork): Move this outside the USG conditional. Mon Aug 2 18:16:39 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * frame.c (Fprevious_frame): New function, for parity with Fnext_frame. (syms_of_frame): Add defsubr for Sprevious_frame. Mon Aug 2 17:18:46 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xdisp.c (display_menu_bar): Redisplay all lines occupied by the menu bar, not just the first. Mon Aug 2 01:54:41 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): Use XFASTINT to convert value of Flength to an int. * buffer.c (Fmove_overlay): Avoid initializer for Lisp_Object vars. (verify_overlay_modification): Declare ostart, oend as Lisp_Object. * frame.c (Fset_frame_position): Doc fix. Sun Aug 1 04:42:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * From daveg@synaptics.com: * keyboard.c (last_mouse_button): Renamed from button_up_button. (last_mouse_x, last_mouse_y): Likewise. (button_down_time): Replaces button_up_time. (make_lispy_event): Set button_down_time. Detect and report double-down and double-drag events. (apply_modifiers_uncached): Put `double' or `triple' first. (read_key_sequence): Convert unbound double-drag/down to drag/down. * fileio.c (Finsert_file_contents): Don't call prepare_to_modify_buffer if inserting zero characters. * syntax.c: Doc fix. Sat Jul 31 01:36:33 1993 Gregor Schmid (schmid@fb3-s7.math.tu-berlin.de) Handle `sticky' text properties. * intervals.c (adjust_intervals_for_insertion): Handle insertion between two unlike intervals via merge_properties_sticky. (merge_properties_sticky): New function. (graft_intervals_into_buffer): Leave handling of `sticky'-ness to adjust_intervals_for_insertion, then merge properties of the inserted text onto the old ones. (textget_direct): New function. (set_point): Fix calculating of fromprev. (verify_interval_modification): Check for `read-only' property and take its `sticky'-ness into account. * intervals.h (MERGE_INSERTIONS): Define as 1. (FRONT_STICKY): Add real definition. (END_NONSTICKY): New macro. (END_STICKY): Deleted. (textget_direct, Qfront_sticky, Qrear_nonsticky): Declared. * textprop.c (Qfront_sticky, Qrear_nonsticky): New variables. (syms_of_textprop): Set them up. Change display code to handle the `invisible' text property. * dispnew.c (direct_output_for_insert): Fail if character just inserted has text properties. (direct_ouput_forward_char): Fail if moving near invisible chars. * indent.c (compute_motion): Compute correctly for invisible text. (vmotion): Take care of invisible newlines. * intervals.c (set_point): Ignore `invisible' property unless property value is `hidden'. * intervals.h (Qhidden): Declared. * textprop.c (Qhidden): New variable. (syms_of_textprop): Set up Qhidden. * xdisp.c (try_window): Handle invisible newline at end of buffer. (display_text_line): Don't display invisible text. Sat Jul 31 01:36:33 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * indent.c (Fmove_to_column): After we split a tab, make sure to set last_known... consistently. * editfns.c (save_excursion_restore): Never make the buffer visible. * s/isc3-0.h: Don't mention dir `s/' in #include. Fri Jul 30 19:11:58 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * config.h.in (HAVE_AIX_SMT_EXP): New #undef for configure to edit. * m/ibmrs6000.h (LD_SWITCH_MACHINE): Don't mention /usr/lpp/X11/bin/smt.exp unless HAVE_AIX_SMT_EXP is #defined. * config.h.in (HAVE_BCOPY): Add an #undef for this. (BSTRING): #define this iff HAVE_BCOPY is #defined here. Ignore what the system-description files say. They don't always make fine enough distinctions between systems, and sometimes the bcopy routines are available only with X windows. * config.h.in (HAVE_XSCREENRESOURCESTRING): New #undef for configure to edit. * xrdb.c (get_user_db): Test it to decide whether or not to try to retrieve the screen-dependent resources. * xfns.c (Fx_open_connection): Test the CPP symbol HAVE_XRMSETDATABASE to decide whether or not to call XrmSetDatabase. * xfns.c (x_set_background_color): Change the foreground color of the cursor, too. Fri Jul 30 03:45:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * editfns.c (syms_of_editfns): Just staticpro Vuser...name and Vsystem_name; don't make them Lisp variables. * xselect.c (prop_location_identifier): Was named prop_location_tick. (property_change_reply_identifier): Renamed from ...-tick. (struct prop_location): Field `identifier' renamed from `tick'. Various functions changed accordingly. (x_handle_selection_request): Delete local struct var `reply'. * xselect.c (wait_for_property_change_unwind): New function. (wait_for_property_change): Add unwind protect. Thu Jul 29 00:56:12 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * xfns.c (syms_of_xfns): Don't staticpro Vx_resource_name; DEFVAR_LISP takes care of that, and it's deadly to staticpro a variable containing a string twice. * window.c (check_frame_size): Include the menu bar height in the minimum frame height. * ymakefile (DEBUG_MOLE): Don't put parens around the command we run to detect the GNU hp300 machines. If the make is still somehow using csh, it complains about the parens. Thu Jul 29 00:07:47 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.c (Fdelete_frame): New arg FORCE allows deletion of last non-invisible frame. * s/usg5-4.h (bzero, bcmp, bcopy): New macros. (LIB_STANDARD): Don't include libucb.a. Wed Jul 28 20:25:49 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * xfns.c (syms_of_xfns): Use DEFVAR_LISP, not DEFVAR_INT, for Vx_pointer_shape. Wed Jul 28 04:57:37 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * cmds.c (Fnewline): Disable the "insert one position before" optimization if it would screw up text property behavior. * textprop.c (property_change_between_p): New function. Tue Jul 27 03:25:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (command_loop_1): Call Qrecompute_lucid_menubar only if defined. * emacs.c (decode_env_path): Strip trailing slashes if there are any. * unexec.c (make_hdr): Use & in call to bzero. * xfns.c (Fx_rebind_key, Fx_rebind_keys): Functions deleted. * syntax.c (scan_sexps_forward): Delete extra Fcdr when analyzing OLDSTATE. * xterm.c (x_iconify_frame): Handle case where frame was invisible. * s/hpux8.h (OLDXMENU_OPTIONS): Definition deleted. * ymakefile (really-oldXMenu): Pass down C_SWITCH_X_SYSTEM. * m/delta88k.h [USG5_4] (LIBX11_SYSTEM): Don't redefine in this case. * search.c (search_buffer): If n is 0, just return POS. Mon Jul 26 14:37:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/usg5-4.h (BROKEN_TIOCGETC, BROKEN_TIOCGWINSZ): Add #undefs. * window.c (Fset_window_buffer): Clear window_end_{pos,valid}. * dispnew.c (Fsleep_for): If arg is 0, return right away. Mon Jul 26 12:26:09 1993 Francesco Potorti` (pot@spiff.gnu.ai.mit.edu) * m/delta.h (SWITCH_ENUM_BUG): Defined only for AT&T's pcc. (BSTRING): Deleted because they are stubs to the memory funcs. (memmove): Defined as safe_bcopy since memcpy is not safe. (HAVE_X_WINDOWS): Does not conditionally define anything any more. Added support fo the GNU C compiler bundled with R3V7. Mon Jul 26 05:12:26 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * puresize.h [MULTI_FRAME] (PURESIZE): Increased to 210000. Sun Jul 25 22:24:46 1993 Sam Dooley (dooley@watson.ibm.com) * keyboard.c (kbd_buffer_store_event): Apply all the modifiers bits before testing for quit_char and stop_character. Don't alter event->code, though. Sun Jul 25 01:38:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xselect.c (wait_for_property_change): Eventually time out with error. (x_reply_selection_request): XFlushQueue and UNBLOCK_INPUT before calling wait_for_property_change. (x_get_window_property): Simplify input blocking/unblocking. Don't delete the property here. (receive_incremental_selection): Delete property here. Call XSelectInput to enable and disable PropertyChangeMask. (x_get_window_property_as_lisp_data): And here. * process.c (wait_reading_process_input): Undo last two changes: when wait_for_cell, do not check the keyboard. * filelock.c: Fix typo in previous change. * xselect.c (lisp_data_to_selection_data): New arg NOFREE_RET. For a string, just return its data's address. (x_handle_selection_request): Pass new arg. If value comes back 1, don't call xfree. * xfns.c (MAXREQUEST): Defined. (Fx_server_max_request_size): New function. (syms_of_xfns): Set it up. * window.c (Fwindow_end): Don't assume WINDOW shows the current buffer. * s/386bsd.h (LOCALTIME_CACHE): Defined. (HAVE_SETSID): Defined. (LIB_STANDARD): Override, adding $(GNULIB_VAR). * emacs.c (main): Test LOCALTIME_CACHE. * filelock.c (getpwuid): Declare at top level, and not if __386bsd__. * keyboard.c (interrupt_signal): Tell Fdo_auto_save not to print msg. Print "Auto-save done" here. * fileio.c (Fdo_auto_save): Temporarily clear Vquit_flag. * xfns.c (Fx_create_frame): Typo in previous change. Sat Jul 24 01:42:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * .gdbinit (xscrollbar): Fix typo specifying doc string. * process.c (Fprocess_status): Use Fget_process, to avoid error if unknown process name. * xfaces.c (face_name_id_number): Use assq_no_quit, not Fassq. Fri Jul 23 17:05:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (command_loop_1): Run post-command-hook first thing. * xterm.c (redraw_previous_char): New function. * xfns.c (Fx_create_frame): Don't look for default font if the caller has specified a valid font. Try several alternative font patterns. Fri Jul 23 16:38:15 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * mem-limits.h: [_LIBC]: Define BSD4_2. Fri Jul 23 03:47:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sco4.h (HAVE_SOCKETS): Define, if HAVE_INET_SOCKETS. * sunfns.c: Fix comment syntax. Put back the comment saying that we don't maintain this file. * xterm.c (XTread_socket) [! HAVE_X11R5]: Check for XK_Mode_switch and XK_Num_Lock, if defined. * m/hp9000s300.h (TEXT_START) [__GNUC__]: Define as 0. * intervals.h (Vinhibit_point_motion_hooks): Declared. * textprop.c (syms_of_textprop): Set up Lisp var. * intervals.c (set_point): Test it. Thu Jul 22 15:38:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/irix5-0.h (PTY_OPEN): Use sigaction, not sigsetmask. * s/386bsd.h (DECLARE_GETPWUID_WITH_UID_T): Declared. * xrdb.c (getpwuid): Test DECLARE_GETPWUID_WITH_UID_T. * process.c (Fget_buffer_process): Delete doc string from second alternative definition. Thu Jul 22 14:59:43 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * ralloc.c (ALIGNED, ROUNDUP): Use `unsigned long int' instead of `unsigned int' for casting addresses and sizes. It matters on the 64-bit Alpha. * mem-limits.h [_LIBC]: Just include , and skip hairy #ifdef mess. Thu Jul 22 04:06:21 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (Fread_key_sequence): Doc fix. (read_key_sequence): Handle Vkey_translation_map. (kbd_buffer_get_event): Discard an event whose kind is no_event. * buffer.c (syms_of_buffer): Lisp var doc fixes. * m/att3b.h (NO_MODE_T): Defined. * intervals.c (graft_intervals_into_buffer): When TREE is null, pass buffer as 2nd arg to reproduce_tree. Wed Jul 21 18:09:12 1993 Paul Eggert (eggert@twinsun.com) * print.c (float_to_string): Don't use uninitialized pointer `cp'. Set width to -1 at lose: and other places. Default to .17g, not .20g. Wed Jul 21 00:37:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * buffer.c (Qmodification_hooks, Qinsert_in_front_hooks) (Qinsert_behind_hooks): Moved here. (syms_of_buffer): Lisp vars set up here. * textprop.c: No longer here. * alloc.c (compact_strings): Add USE_TEXT_PROPERTIES conditional. * intervals.h (Ftext_property_not_all): Fix typo in decl. * s/sunos4-1.h (SUNOS_LOCALTIME_BUG): Defined. * frame.c (Fdelete_frame): Allow deletion if there is some other visible (perhaps iconified) frame. Also allow deleting terminal frame if there are X frames. * s/sunos4shr.h (memmove): Defined. * m/att3b.h (memmove): Defined as macro. Tue Jul 20 01:08:47 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (xmakefile): Use CFLAGS after C_SWITCH_SYSTEM. * xfns.c (validate_x_resource_name): Call make_string properly. * m/next.h (X_NOT_POSIX): Defined. * s/sol2.h (BROKEN_TIOCGETC, BROKEN_TIOCGWINSZ): Add #undefs. * s/isc3-0.h (memmove): Delete extra parens in the safe_bcopy call. * m/ibmrs6000.h (LD_SWITCH_MACHINE): Add -bI:/usr/lpp/X11/bin/smt.exp. Mon Jul 19 17:15:20 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * eval.c (Fwhile): If mocklisp, test for nonzeroness. * s/sunos4shr.h (SYSTEM_MALLOC): Add #undef. (GNU_MALLOC, REL_ALLOC): Defined. Mon Jul 19 17:07:22 1993 David J. MacKenzie (djm@goldman.gnu.ai.mit.edu) * ymakefile: config.h is in current directory, not ${srcdir}. 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: Add size to geometry spec. Specify sevenbit-strings in set print. (xfloat): New command. Tue Jul 6 11:05:14 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.16 released. * ymakefile [not ORDINARY_LINK && __GNUC__ && __GNUC__ > 1 && not LIB_GCC] (LIB_GCC): Use "$(CC)" instead of "gcc". Tue Jul 6 01:58:20 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * textprop.c (copy_text_properties): Pass a copy of POS to validate_interval_range; that function increments its arguments, which isn't what we want. * fns.c (Fsubstring, concat): Pass all six arguments to copy_text_properties. * intervals.c (find_interval): Doc fixes, computation of tree->position rearranged for clarity. * intervals.c (find_interval): Consistently treat POSITION as an actual buffer position, i.e. origin 1. The old code seemed undecided on this point. Treat the end of the buffer as being part of the rightmost interval. (adjust_intervals_for_insertion): Consistently treat POSITION as origin 1. (interval_deletion_adjustment): The exception: FROM should be origin zero here. Consistently treat it as such. Simplify code which shrinks and possibly deletes intervals. (adjust_intervals_for_deletion): Treat start as origin 1; our caller does. (set_point): Use buffer positions throughout, not a mix of buffer posns and origin zero posns. (get_local_map): Remove special case for POSITION at end of buffer; find_interval handles that case correctly. (verify_interval_modification): Remove special case for START at end of buffer. * textprop.c (validate_interval_range): End-of-buffer/string positions no longer need special handling. * intervals.c (make_new_interval): #if 0 this out. Nobody calls it. * textprop.c (copy_text_properties): New function, from David Gillespie. * intervals.h: Declare copy_text_properties. * fns.c: #include "intervals.h". (Fsubstring): Copy text properties to result string. (concat): Copy text properties to result string. * ymakefile (fns.o): Note that this depends on INTERVAL_SRC. * print.c: Get rid of extra space at the end of print syntax for strings with intervals. [USE_TEXT_PROPERTIES] (print): Don't print a space before the interval property lists. [USE_TEXT_PROPERTIES] (print_interval): Print a space before this internal's properties, not after. * m/pmax.h (C_SWITCH_X_MACHINE): Set this to "-DNeedFunctionPrototypes=0", to avoid lossage in DEC X11 header files. * ymakefile (really-oldXMenu): Pass C_SWITCH_X_MACHINE to the oldXMenu make. * doc.c (Fsubstitute_command_keys): Pass all five arguments to describe_map_tree. Mon Jul 5 03:15:17 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) Compare the values of text properties using EQ, not Fequal. * intervals.c (intervals_equal): Call EQ, not Fequal. * textprop.c (interval_has_all_properties, add_properties): Same. * textprop.c (validate_interval_range): Don't increment both *begin and *end if they point to the same thing. (validate_plist): Call QUIT while scanning LIST. * intervals.c (intervals_equal): Test the return value of Fequal against Qnil, not 0. * keyboard.c (Vdouble_click_time): Renamed from double_click_time, and made a Lisp_Object instead of an int. (make_lispy_event): If Vdouble_click_time is t, impose no time limit on double-clicks. (syms_of_keyboard): DEFVAR_LISP (not DEFVAR_INT) Vdouble_click_time (not double_click_time), and adjust doc string to say that `nil' means no double clicks, and `t' means no time limit. Sun Jul 4 16:00:40 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * keyboard.h (EVENT_CLICK_COUNT, POSN_SCROLLBAR_PART): New accessors. * s/sunos4-1.h (LIBS_SYSTEM): Don't link against -lresolv; that's only needed for misconfigured systems. Sun Jul 4 00:51:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keymap.c (describe_map_tree): When inserting TITLE, mention PREFIX. Insert newline at end, if inserted anything else. (describe_buffer_bindings): Corresponding changes. For minor mode maps, build up a title string, then let describe_map_tree insert it. * eval.c (Fsignal): Clarify error message. Sat Jul 3 22:19:19 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_char): After Fgarbage_collect, call redisplay. Sat Jul 3 17:11:19 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * frame.c (Fredirect_frame_focus): Allow redirection of focus of dead frames. * s/sunos4-1.h (LIBS_SYSTEM): Make this be -lresolv, so we get the versions of gethostbyname and such that use the DNS. Sat Jul 3 02:58:05 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * fileio.c (Frename_file): After prompting for ok-if-already-exists, pass only nil or t to copy-file, never an integer. Fri Jul 2 23:57:42 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keymap.c (Faccessible_keymaps): Doc fix. Fri Jul 2 18:48:58 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * textprop.c (set_properties): Don't try to make undo records if OBJECT is a string. Fri Jul 2 01:42:41 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_key_sequence): When inserting `menu-bar' prefix, modify the position field to prevent doing so twice. Do all these forms of event expansion after replayed events also. Set last_real_key_start before each key. Use last_real_key_start in criterion for being the first event. * process.c (wait_reading_process_input): Do include the keyboard in the select, if read_kbd was a cons cell. Thu Jul 1 22:25:05 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * xterm.c (XTread_socket): When handing non-synthetic ConfigureNotify events, don't refer to the parent window descriptor. * textprop.c (set_properties): Add undo records to remove entirely new properties. Only record old property values for those properties whose values have changed. Thu Jul 1 19:56:28 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * callint.c (Vmark_even_if_inactive): New var, with Lisp variable. (check_mark): Use it. Thu Jul 1 00:03:50 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xfaces.c [XOS_NEEDS_TIME_H]: #undef USG while #including , so that file doesn't try to define struct timeval and struct timezone. * xterm.c (frame_highlight, frame_unhighlight): Don't test Vx_no_window_manager. BLOCK_INPUT around the border manipulation calls. Wed Jun 30 16:12:09 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xterm.c (XTread_socket): Initialize event_found to zero, and pass a zeroed timeout to select, not a null pointer; the latter means "wait forever". * s/hpux8.h (random, srandom): No need to define these to be foo_random and foo_srandom; autoconf should autodetect when the real random functions are available. * xdisp.c (redisplay): If we're not already showing the region, then don't disable the single-line optimizations just because the mark isn't where we last displayed it. Wed Jun 30 13:50:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (syms_of_keyboard): Doc fix. (Vhelp_char): Renamed from help_char. (Vprefix_help_command): New Lisp variable. (read_key_sequence): Use that, for help char after prefix key. * keyboard.c (kbd_buffer_get_event): Clear f before calling mouse_position_hook. * emacs.c, callproc.c (PRIO_PROCESS): Definition deleted. * vm-limit.c (check_memory_limits): Make data_size and five_percent unsigned long. Wed Jun 30 00:55:41 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * keyboard.c (kbd_buffer_get_event): Correctly generate switch-frame events when reading mouse motion events. Tue Jun 29 19:05:54 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xterm.c: Add CPP tangle from process.c to get definitions for FD_SET, etcetera. (XTread_socket): Use those macros when testing for dropped connection. Tue Jun 29 01:27:22 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * alloc.c (mark_object): Add aborts in Lisp_Symbol case. * keymap.c (describe_map_tree): Insert key_heading here. New arg TITLE. (describe_buffer_bindings): Corresponding changes. * process.c (wait_reading_process_input): Use SIGIO only if defined. * keymap.c (shadow_lookup): New function. (describe_map_2): Call it. SHADOW is now a list of maps. (describe_vector): Likewise. (describe_map): SHADOW is now a list of maps. (describe_map_tree): Likewise. (describe_buffer_bindings): Build suitable list to pass as SHADOW. (Faccessible_keymaps): New arg PREFIX. Callers changed. (describe_map_tree): New arg PREFIX. (Fdescribe_bindings): New arg PREFIX. Pass to describe_buffer_bindings along with buffer. (describe_buffer_bindings): Extract PREFIX and pass along. Mon Jun 28 15:18:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keymap.c (describe_map_2): Cleanups. Check there's no previous definition in same keymap. Thu Jun 24 00:15:54 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * keyboard.c (read_char): Don't do idle autosaves if we're not interactive. Wed Jun 23 21:32:25 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xfns.c (Fx_create_frame): Check for internalBorder resource, as well as internalBorderWidth. * xterm.c (XTread_socket): Remove #if 0''s around code which tests for dropped connection (i.e. sigio but no events). Tue Jun 22 02:58:40 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * keyboard.c (menu_bar_items, read_key_sequence): Use current_global_map, not global_map; the latter is only meant to be used for initial_define_key. * commands.h: Doc fix. * commands.h (Vglobal_mouse_map): Removed; unused. * xfns.c (Vglobal_mouse_map): Same. * buffer.c (list_buffers_1): Make desired_point a lisp object; set it to nil, unless we find the current buffer. (Flist_buffers): Don't try to set point in the buffer list unless list_buffers_1 actually returns an integer. Don't use a full save_excursion; just save and restore the buffer. Separate parameter faces (those created and modified by the user) from the computed faces (the combinations created by compute_char_face), so that we don't waste global face id's. * xterm.h (struct x_display): Replace the fields faces and n_faces with fields param_faces, n_param_faces, computed_faces, n_computed_faces, and size_computed_faces. (FRAME_FACES, FRAME_N_FACES): Replaced by... (FRAME_COMPUTED_FACES, FRAME_N_COMPUTED_FACES, FRAME_PARAM_FACES, FRAME_N_PARAM_FACES): New macros. * xfaces.c: Doc fixes. (init_frame_faces): Call new_computed_face to create entries for the default and mode line faces. Use the FRAME...PARAM_FACES macros. (free_frame_faces): Use the FRAME...PARAM_FACES and FRAME...COMPUTED_FACES macros. Don't use the copy flag; all parameter faces have real X resources, and all computed faces just have copies. Free both the parameter and computed face arrays. (new_computed_face): New function. (intern_computed_face): Renamed from intern_frame_face; callers changed. Call new_computed_face. (ensure_face_ready, compute_char_face, compute_glyph_face): Use the FRAME...PARAM_FACES macros. (recompute_basic_faces): Use the FRAME...PARAM_FACES and FRAME...COMPUTED_FACES macros. Produce the computed faces by starting with the base faces and merging in the parameter faces. (Fset_face_attribute_internal): Use the FRAME...PARAM_FACES macros. Just call recompute_basic_faces if the default or mode line faces have changed. * xfns.c (Fx_list_fonts): Use the FRAME...PARAM_FACES macros. * xterm.c (dumpglyphs): Use the FRAME...COMPUTED_FACES macros. * dispextern.h (struct face): Remove the copy member. This is no longer necessary; all computed faces are copies, and no parameter faces are. * xfaces.c (face_vector, nfaces, nfaces_allocated): Make these static. * xdisp.c (redisplay_window): Remember to compute end relative to the start of the visible region, too. Mon Jun 21 22:02:48 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xrdb.c (get_user_db): Remember to free the screen-local resource string after we've merged its data into db. * keyboard.c (make_lispy_event): Added detection of double-click and triple-click events. (parse_modifiers_uncached, apply_modifiers_uncached): Same. (read_key_sequence): Coerce double-clicks to clicks, and triple-clicks to double-clicks or clicks, by analogy with drag events. (double_click_time): Added variable. * termhooks.h: Added multi-click event modifier bits. Mon Jun 21 15:37:06 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * textprop.c (Fremove_text_properties, Fadd_text_properties): Really do next_interval when skipping the first interval. Sun Jun 20 16:01:51 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xfns.c (Fx_open_connection): Remember to block input while calling x_load_resources. * xrdb.c: Undo change of June 19th; it was a BLOCK_INPUT problem, not a server-specific bug. * alloc.c (Fgarbage_collect): If the minibuffer is active, don't display the "...done" message; allow the minibuffer to show again. * config.h.in (HAVE_LONG_FILE_NAMES): Add an #undef, for autoconf to chew on. Re-arrange macros to reflect the ordering of the corresponding macros in configure.in, to facilitate this kind of checking. Sat Jun 19 17:14:27 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * version 19.15 released. Sat Jun 19 16:24:58 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * puresize.h (PURESIZE): Up this to 205000 for MULTI_FRAME Emaces, and 190000 for non-MULTI_FRAME Emaces. * xfaces.c (recompute_basic_faces): This shouldn't be declared static. * xrdb.c (get_user_db): Some NCD xterms seem to hang in XScreenResourceString. Consult the ServerVendor and VendorRelease variables to see if we're talking to such a server. * xterm.c (XTread_socket): Never treat a modifier key as a non_ascii_keystroke. * emacs.c (Fkill_emacs): Pass third argument to shut_down_emacs. * lisp.h (shut_down_emacs): Doc fix. Fri Jun 18 11:05:46 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * frame.c (Fmake_frame_visible): Make this interactively callable; frames can accept input while iconified, so it makes sense to put this on a key. * xfaces.c: Add forward declaration for recompute_basic_faces. * fileio.c (Fset_visited_file_modtime): We're only passing two arguments to the file name handler; use call2, not call3. Changes for Irix 4.0, tested this time: * s/irix4-0.h: Get rid of our fake definitions for setpgrp and getpgrp. * callproc.c (Fcall_process): Go ahead and use the USG calling convention for setpgrp. * ymakefile (pre-crt0.o): Add rule for this. Perhaps it will help separate-source-directory compilation. * emacs.c (shut_down_emacs): Some USG systems #define EMACS_HAVE_TTY_PGRP; call getpgrp as appropriate for such systems. * sysdep.c (sys_suspend): Call getpgrp as appropriate for USG and non-USG. * sysdep.c (rename): Make arguments const. autoconf #defines const away on systems which don't have it; any system with prototypes will declare the arguments const (the ones to which I have access do); and systems without prototypes won't notice. * process.c [IRIX] (create_process): Don't put child in process group zero before opening the tty; Irix is like USG in this regard. * s/isc2-2.h, s/linux.h, s/usg5-4.h, m/alliant-2800.h, m/convex.h, m/pfa50.h: Remove #definition of HAVE_CLOSEDIR; autoconf figures this out. * xfns.c: Always #include "bitmaps/gray.xbm"; the bitmaps seem to be missing on some systems, and there's no point in having configure check; it should work fine to always use our copy. * minibuf.c (Fread_minibuffer): Add missing semicolon after CHECK_STRING macro. Thu Jun 17 19:29:56 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.14 released. Thu Jun 17 15:05:29 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * m/iris4d.h (LIB_STANDARD): Do *not* include -lbsd. We are now calling the BSD[sg]etpgrp functions directly, so this library is not needed; it just provides the BSD[sg]etpgrp functions under the [sg]etpgrp names. * callproc.c [IRIX] (child_setup): Don't call setpgrp this time. It's already been called up in Fcall_process, and create_process. * callproc.c (Fcall_process, child_setup): If IRIX is #defined, call setpgrp with arguments, even if USG is #defined. * process.c [IRIX] (create_process): Don't call setpgrp before opening the pty. Call it after doing the TIOCNOTTY ioctl. * xfaces.c (compute_base_face): Initialize the face's stipple. Although we don't use this feature now, face_eql notices it. * xfaces.c (compute_base_face): Set cached_index to an invalid index, to avoid an unnecessary comparison. * keyboard.c (read_key_sequence): Don't confuse mock input with function-key-map expansion, and continue reading mock events when the current sequence is unbound. * keyboard.c (read_key_sequence): After providing a prefix symbol for a mouse event, modify the mouse event to indicate that that won't need to be done again, by putting the event's position symbol in a list. * keyboard.c (read_key_sequence): When returning mock input which has run off the end of the current maps, make sure the events get echoed, and make it into this-command-keys. * keyboard.c (read_key_sequence): When re-reading a previously read mouse click which requires a prefix symbol, make sure to set last_real_key_start appropriately, so we can properly drop button-down events. Thu Jun 17 00:07:22 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ymakefile (really-oldXMenu): Pass C_SWITCH_MACHINE down. * intervals.c (verify_interval_modification): Don't just test Qread_only prop; use INTERVAL_WRITABLE_P. * syntax.c (scan_lists, Fforward_comment): #if 0 the code to treat two-character comment enders with a special shortcut. Wed Jun 16 22:16:40 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * config.h.in (HAVE_CLOSEDIR): Add an #undef for autoconf to change. * sysdep.c (closedir): Only define this if autoconf can't find HAVE_CLOSEDIR. If we're running under solaris (defined (sun) && defined (USG5_4)), then don't free the buffer separately. * keyboard.c (read_key_sequence): If we add events to a key sequence that didn't come from the input stream (e.g. `mode-line' prefixing a mouse click, or an expansion from function-key-map), and end up with a sequence that runs off the end of the current maps, return the entire key sequence, not just the initial portion which was bound or unbound. * xdisp.c (redisplay_window): Do not subtract one from start before passing it to the set_vertical_scroll_bar_hook. * lisp.h (CHECK_LIST, CHECK_STRING, CHECK_CONS, CHECK_SYMBOL, CHECK_VECTOR, CHECK_BUFFER, CHECK_WINDOW, CHECK_LIVE_WINDOW, CHECK_PROCESS, CHECK_NUMBER, CHECK_NATNUM, CHECK_MARKER, CHECK_NUMBER_COERCE_MARKER, CHECK_FLOAT, CHECK_NUMBER_OR_FLOAT, CHECK_NUMBER_OR_FLOAT_COERCE_MARKER, CHECK_OVERLAY): Wrap a do ... while (0) around these compound statements to make them syntactically equivalent to a single statement. Wed Jun 16 18:37:24 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * editfns.c (Finsert_buffer_substring): Doc fix. Wed Jun 16 10:12:49 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) Don't let the 'B' interactive spec default to buffers viewed in any visible frame. * buffer.c (Fother_buffer): Pass Qt as the second argument to Fget_buffer_window. * window.c (window_loop): In GET_BUFFER_WINDOW case, ignore non-visible frames. (Fget_buffer_window): Change doc string to mention that passing Qt for the FRAME argument returns windows on visible frames only. Changes for correct pgrp behavior; approach suggested by Bob Glickstein : * m/iris4d.h (LIB_STANDARD): Do list -lbsd here. * s/irix4-0.h (getpgrp, setpgrp): #define these to call BSDgetpgrp and BSDsetpgrp. (GETPGRP_NO_ARG): Don't #define this. * emacs.c (main): Don't test GETPGRP_NO_ARG. * sysdep.c (sys_suspend): Don't test GETPGRP_NO_ARG. * Makefile.in (CPP): New variable, set by the top-level Makefile. * m/delta88k.h (HAVE_GETTIMEOFDAY): Don't #define this; autoconf takes care of that. (LIBS_SYSTEM): Don't attempt to #define this if we already have a definition of LIB_SYSTEM from s/usg5-4.h. * unexec.c [HPUX] (sbrk): This returns a void *. * window.c (check_frame_size): Allow minibuffer-only frames to be one line high. * frame.c (store_frame_param): Fix error message punctuation. * callproc.c [IRIX] (child_setup): Don't set the pgroup. * s/isc3-0.h (memmove): #define this to call safe_bcopy. * buffer.c (list_buffers_1): Return the desired point. (Flist_buffers): Put point there in the buffer summary. Bring mumbleclean targets into conformance with GNU coding standards. * Makefile.in (mostlyclean): New target. (clean): Just call mostlyclean. Get rid of ../etc/DOC too. (distclean): Use clean to do most of the work. Get rid of ../etc/DOC-* too. (realclean): New target. * xdisp.c (redisplay_window): Do not subtract BEGV to compute the scroll bar handle's end. Tue Jun 15 03:47:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xmenu.c (xmenu_show): Store 0 in *ERROR at the beginning. * fileio.c (Finsert_file_contents): Two new args, BEG and END. * intervals.c (adjust_intervals_for_insertion): By default, copy properties from before the insertion. Mon Jun 14 13:29:51 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * syntax.c (scan_sexps_forward): Set state.comstart to before the comment starter, not after. * xmenu.c (Fx_popup_menu): Call keymap_panes right in one-keymap case. Mon Jun 14 11:06:35 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * s/linux.h (LIBS_MACHINE, HAVE_SYSVIPC): Set the former to -lipc, and #define the latter. * xdisp.c (display_text_line): Use temporary variable. Mon Jun 14 03:05:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (Fdelete_window): Handle deleting a parent of the selected window. Sun Jun 13 04:10:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (Fset_visited_file_modtime): Don't give the handler the filename as an argument. * syntax.c (scan_lists, Fforward_comment): Pass 0 as commentstop arg to scan_sexps_forward. (scan_sexps_forward, char_quoted): Now static. (describe_syntax, describe_syntax_1): Now static. * undo.c (Fprimitive_undo): Rename arg to N to avoid conflict. * window.c (Fdelete_window): Mostly undo last change. Don't initialize `frame' in the declaration. * Make prefix keys work with keymap inheritance by creating an inheritance structure for each subkeymap that we create in the inheriting keymap. * keymap.c (access_keymap): New arg NOINHERIT. All calls changed. (define_as_prefix): New function. (Fdefine_key): Use them. Sat Jun 12 19:52:07 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacs.c (shut_down_emacs): New arg STUFF. Stuff input here. (Fkill_emacs, fatal_error_signal): Pass new arg. * xterm.c (x_connection_closed): Pass new arg. * dired.c (Ffile_attributes): Give -1 as size if size won't fit. * intervals.c (set_point): When moving over invis chars, don't screw up at end of buffer. * eval.c (call5, call6): New functions. (call1, call2, call3, call4): Renumber the args. * lread.c (Fload): Use call5. * fileio.c (Fcopy_file): Pass all the args to the handler. (Fwrite_region): Use call6. (Frename_file): Look for handler for newname. (Fadd_name_to_file): Pass arg ok_if_already_exists to handler. (Fmake_symbolic_link): Likewise. (Ffile_newer_than_file_p): Check both file names for handler. Sat Jun 12 13:35:37 1993 John Hughes (john@moonlite.CalvaCom.fr) * term.c (term_get_fkeys): Use `prior', not `previous', for %8/kP. Sat Jun 12 13:00:03 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * sysdep.c (child_setup_tty): Remove duplicate settings for VQUIT and VINTR. * sysdep.c [ultrix] (init_sys_modes): Don't set LLITOUT; it disables the meta key. * frame.c (Fmouse_position, Fset_mouse_position): Doc fix. * xfns.c [! HAVE_X11R5] (Fx_rebind_key): Recognize that XK_Mode_switch and XK_Num_Lock are modifier keysyms too. * xterm.c (XTset_vertical_scroll_bar): Use double type for intermediate results in scaling. Sat Jun 12 12:56:36 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * undo.c (syms_of_undo): Set up Qinhibit_read_only. (Fprimitive_undo): Sometimes bind inhibit-read-only to t. * minibuf.c (read_minibuf): Set and use mini_frame only if MULTI_FRAME. * xdisp.c (echo_area_display): Use XFASTINT on ->height. (copy_rope, copy_part_of_rope): Access *f as Lisp_Object. * window.c (Fdelete_window): Make `frame' a FRAME_PTR and use as such. * undo.c (record_delete): Always use XFASTINT on sbeg. (Fprimitive_undo): Add missing `else'. Add USE_TEXT_PROPERTIES conditional for calling Fput_text_property. Use XINT on high, low. * process.c (start_process_unwind): Use XINT. * syntax.c (Fset_syntax_table): Add XFASTINT. Sat Jun 12 05:30:40 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xterm.c (x_error_quitter, x_io_error_quitter): Remove calls to abort. We can always run Emacs with _Xdebug set to 1. * ymakefile (really-oldXMenu): Remember backslash to extend command. * keyboard.c (read_key_sequence): When we generate a prefix symbol for a mouse event, store the actual mouse event in unread_command_events, so we don't lose it if the symbol isn't bound to a prefix. * config.h.in (HAVE_XRMSETDATABASE, HAVE_RANDOM, HAVE_LIBXBSD): Add #undefs for these. Dyke out code requesting -lXbsd and HAVE_RANDOM for XFREE386. * xfns.c (Fx_open_connection): Test HAVE_XRMSETDATABASE instead of NO_XRM_SET_DATABASE; the latter isn't used any more. * m/delta88k, m/tekXD88.h, s/linux.h, s/usg5-4-2.h (HAVE_RANDOM): Dyke out these #definitions; to avoid conflict with autoconf. * ymakefile (really-oldXMenu): Explicitly pass CC, CFLAGS, and MAKE to the oldXMenu make. * window.c (Fprevious_window): Use FRAME_HAS_MINIBUF_P to decide if the frame has a minibuffer; FRAME_MINIBUF_WINDOW points to the surrogate on minibufferless frames, not nil. Sat Jun 12 00:43:07 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keyboard.c (read_char): Set c properly as a Lisp int. (command_loop_1): Delete spurious use of XINT on c, a char. * frame.c: Doc fixes. * data.c (cons_to_long): Declare top, bot as Lisp_Object. * floatfns.c (Fexpt): New local `val' for making integer to return. * keymap.c (Fcopy_keymap): Check Fkeymapp value with NILP. (get_keymap_1): Add missing semicolon. (describe_vector_princ): Align to column 16. * emacs.c (main) [GETPGRP_NO_ARG]: Really pass no arg to getpgrp. Fri Jun 11 16:49:38 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xterm.c (XTmouse_position): Don't set *f at all unless we win. * process.c (read_process_output): Don't deactivate the mark. Do restore Vdeactivate_mark, so that no one else deactivates it. * buffer.c (Fgenerate_new_buffer_name): GENTEMP is the value to compare against IGNORE. Fri Jun 11 12:15:29 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) Interact properly with shells lacking job control (sh, rc, es...) * sysdep.c [BSD] (inherited_pgroup): New variable. (narrow_foreground_group, widen_foreground_group): New functions. (init_sys_modes): Call narrow_foreground_group. (reset_sys_modes): Call widen_foreground_group. * emacs.c [BSD] (inherited_pgroup): Add extern declaration. [BSD] (main): Set inherited_pgroup, and put ourselves in our own pgroup. Fri Jun 11 11:41:04 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (syms_of_xfns): Don't set up Qicon. (Qicon): Declaration deleted. * frame.h (Qicon): Declared. * frame.c (Fmouse_position): Set up defaults before calling the hook. Fri Jun 11 07:17:59 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xdisp.c (redisplay_window): Don't call try_window_id if the window isn't starting at the beginning of the line. * window.c (Fprevious_window): Typo. Fri Jun 11 03:13:54 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ymakefile (alloca.o): Delete allocatem.c, not allocax.c. * textprop.c (Fset_text_properties): No special case for props = nil. * xfns.c (Fx_list_fonts): If names is 0, just return nil. Fri Jun 11 02:43:09 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xterm.c (x_new_font): If font_names is zero, that's all the indication we get that no matches were found. * s/isc3-0.h (LIB_X11_LIB): #undef this, to remove the value inherited from usg5-3.h; ISC doesn't have libX11_s. (LIBX11_SYSTEM): Link against the static -lc, not -lc_s. Thu Jun 10 17:14:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lread.c (Fload): Forward all 4 args to magic-name handler. Thu Jun 10 03:25:20 1993 Shane Hartman (shane@nugget.spr.com) * window.c (Fscroll_left): Make argument optional. (Fscroll_right): Ditto. Thu Jun 10 01:18:09 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * search.c (Flooking_at, Fstring_match, fast_string_match, search_buffer): Don't block input while calling searching and matching functions. These functions may not call malloc under Emacs anyway, and we need to be able to check for C-g. * xrdb.c (get_user_db): Get the screen-specific database too. * syntax.c (scan_lists, Fforward_comment): Call scan_sexps_forward with the proper number of arguments. * sysdep.c: Remove clause for DGUX support of FASYNC; add clause to #undef FASYNC if BROKEN_FASYNC is #defined. * filelock.c: Test HAVE_LONG_FILE_NAMES, not SHORT_FILE_NAMES, to interface nicely with autoconf. * m/delta.h: Don't #define SHORT_FILE_NAMES; autoconf does this for us. * s/dgux.h: Changes from Paul M Reilly : (BSD4_4, SVR4, HAVE_SETSID, HAVE_UNIX_DOMAIN): #define these. (FIRST_PTY_LETTER): This is 'r', not 'p'. (HAVE_TERMIO, SIGNALS_VIA_CHARACTERS): Don't #define these. (HAVE_TERMIOS): #define these instead. (XREBINDKEYSYM): Don't #define. Test THIS_IS_YMAKEFILE instead of MAKING_MAKEFILE. (sigmask, sigpause): #undef these after #including . (LD_SWITCH_SYSTEM, START_FILES, LIBS_SYSTEM, LIB_GCC): #define these to avoid problems with /lib/crt0.o. (C_DEBUG_SWITCH, C_OPTIMIZE_SWITCH): #define these. * s/dgux.h (BROKEN_FASYNC): #define this. * fileio.c (Frename_file): Pass all arguments to the file name handler. * eval.c (call4): New function. Wed Jun 9 00:36:00 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * s/linux.h (SIGNALS_VIA_CHARACTERS): Don't #define this. * process.c (sigchld_handler): Add cast, to avoid warnings on Linux. (Fopen_network_stream): Cast the second argument to connect, to avoid warnings on any system that provides prototypes for connect. * xdisp.c (display_text_line): Handle case where line ends in a continuation character but we never actually displayed any buffer text (due to minibuffer prompt). * xterm.c (x_is_vendor_fkey): New function. (XTread_socket): Call it to recognize vendor-specific function keys. * s/dgux.h: Move #definition of SYSTEM_MALLOC outside of MAKING_MAKEFILE conditional. No harm. * xfaces.c (init_frame_faces): Remove assumption that the selected frame must be an X frame whenever there is already an X frame. Tue Jun 8 23:54:04 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * alloc.c (emacs_blocked_malloc, emacs_blocked_realloc): Cast the return values of malloc and realloc, to placate compilers. Tue Jun 8 12:24:22 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * window.c (Fprevious_window): When changing frames, use the new frame's minibuffer if any. * intervals.h (INTERVAL_WRITABLE_P): Fix backwards tests. * m/tekXD88.h: Rewrite by author. Tue Jun 8 00:38:15 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Version 19.13 released. * ymakefile (C_DEBUG_SWITCH, C_OPTIMIZE_SWITCH): Remove these; people shouldn't edit this file to choose optimization and debugging switches anyway. ../configure will set CFLAGS to an appropriate default, which they will be able to override. * Makefile.in (xmakefile): Don't try to turn -g and -O in CFLAGS into C_DEBUG_SWITCH and C_OPTIMIZE_SWITCH. CFLAGS should be the sole source of such switches, so that setting CFLAGS controls them completely. Mon Jun 7 23:54:46 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * config.h.in (HAVE_LIBDNET): New macro, to be defined by ../configure. * m/pmax.h (LIBS_MACHINE): Only put "-ldnet" here if HAVE_LIBDNET is #defined. Mon Jun 7 00:10:09 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fileio.c (syms_of_fileio): Set up Qset_visited_file_modtime. (Fset_visited_file_modtime): Use the proper operation. * sysdep.c (init_baud_rate) [HAVE_TERMIOS]: Use cfgetospeed. * systty.h: Add NO_TERMIO conditional. * textprop.c (Fadd_text_properties): Don't treat the initial interval specially, aside from splitting off the part starting where we want to start changing things. (Fremove_text_properties): Likewise. For ending interval, split it left as in Fadd_text_properties. (Fset_text_properties): Don't set starting interval if it goes past END. Instead, split it left and set the left part. * keymap.c (Fdescribe_vector): Use current buf, not standard-output. (describe_vector_princ): Add newline at end. * keymap.c (store_in_keymap, access_keymap): Use CHAR_META when clearing excess high bits. * s/dgux.h (INTERRUPTIBLE_*): Fix spelling of macros. * s/hpux9.h (SYSTEM_MALLOC, GNU_MALLOC, REL_ALLOC): Definition and #undefs deleted. * keymap.c: Doc fix. * buffer.c (Fdelete_overlay): Do nothing if overlay already deleted. Bind inhibit-quit to t. (Fmove_overlay): Properly handle changing buffers, or no prev buffer. Bind inhibit-quit to t. * lread.c (syms_of_lread): Set up Qload. (Fload): Handle magic file names. Mon Jun 7 17:07:28 1993 Shane Hartman (shane@nugget.spr.com) * xterm.c (x_caught_error_message): Change type to char* from char*[]. (X_CAUGHT_ERROR_MESSAGE_SIZE): New macro. (x_error_catcher): Corresponding changes. (x_catch_errors): Corresponding changes. (x_check_errors): Do not free x_caught_error_message. (x_uncatch_errors): Set x_caught_error_message to 0 after freeing it. Sun Jun 6 18:38:55 1993 Paul Eggert (eggert@twinsun.com) * uaf.h (uaf$v_thursday): Fix misspelling of "thursday". * floatfns.c (Fceiling): Fix spelling of "ceiling". Sun Jun 6 13:41:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * ymakefile [__GNUC__ >= 2] (LIB_GCC): Delete spurious -L. * m/tekXD88.h (HAVE_RENAME): Deleted. * data.c (Ffset): Delete special check for t and nil. * xfaces.c (same_size_fonts): Compare only the width. * dispnew.c: Include lisp.h earlier (before termhooks.h). * editfns.c (Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE. * systime.h [HAVE_TZNAME]: Declare tzname if not macro. * config.h.in (HAVE_TZNAME): Add #undef. Sun Jun 6 13:42:35 1993 Nobuyuki Hikichi (hikichi@sra.co.jp) * m/news-risc.h (NO_MODE_T): Defined. (LINKER): Add #undef. Sun Jun 6 02:44:47 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keymap.c (access_keymap, store_in_keymap): Discard meaningless high bits of a character event. Sat Jun 5 04:04:33 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lisp.h: Don't declare malloc or realloc. * xfns.c [EMACS_BIT_MAPS]: Include gray.xbm from ./bitmaps. * xterm.c (x_new_font): Don't give up right away if XListFontsWithInfo finds no fonts--try XLoadQueryFont anyway. * xfns.c (Fx_open_connection): Make `data' unsigned char. * window.c (Fset_window_configuration): If a window is supposed to have a buffer, always give it one. * xmenu.c (Fx_popup_menu): Error if we don't get a window or a frame somehow. * puresize.h: Test MULTI_FRAME, not HAVE_X_WINDOWS. * frame.c (Frubber_band_rectangle): Deleted. (syms_of_frame): Don't defsubr it. * xselect.c (x_get_foreign_selection): Handle x_selection_timeout as milliseconds, not as seconds. (syms_of_xselect): Doc fix to match. * m/mips4.h (MIPS2): Comment out define. (LIB_STANDARD): Delete -lisode. Fri Jun 4 03:06:37 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * syssignal.h [POSIX] [!__GNUC__] (sys_sigmask): Add declaration. * alloc.c (make_event_array): Ignore bits above CHAR_META. * frame.c [!MULTI_FRAME] (Fframep): New dummy definition. (syms_of_frame): Defsubr that. * buffer.c (syms_of_buffer): Set up Lisp var inhibit-read-only. * lisp.h (Vinhibit_read_only): Declared. * buffer.c (Fbarf_if_buffer_read_only): Check Vinhibit_read_only. * cmds.c (Fnewline): Use Fbarf_if_buffer_read_only. * intervals.h (INTERVAL_VISIBLE_P): Use textget. (INTERVAL_WRITABLE_P): Use textget. Check Vinhibit_read_only. * window.c (syms_of_window): Always defvar pop-up-frames and pop-up-frame-function. * process.c (read_process_output): Deactivate the mark. Save and restore Vdeactivate_mark. * xfns.c (x_set_menu_bar_lines_1): Adjust just the uppermost child in a vertical split. Adjust the hight counter to the top. (x_set_menu_bar_lines): Don't change overall frame height. Fri Jun 4 12:41:07 1993 Francesco Potorti` (pot@cnuce.cnr.it) * filelock.c (MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates different space and calls fill_in_lock_short_file_name. (fill_in_lock_short_file_name): New function for 14-chars hashed file names. Replaces fill_in_lock_file_name if SHORT_FILE_NAMES. Thu Jun 3 00:07:07 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sysdep.c (wait_for_termination): Fix sigpause in POSIX_SIGNALS case. * xterm.c (x_catch_errors): Fill in missing array size in cast. * Makefile.in (xmakefile): Depend on ../config.status. * buffer.c (init_buffer): Init default-directory of minibuffer. * m/iris4d.h (LIB_STANDARD): Delete -lbsd. * keyboard.c (read_key_sequence): Reset fkey_map when we find something at the end of Vfunction_key_map. * m/ibmrt-aix.h (HAVE_FTIME): Defined. * emacs.c (syms_of_emacs): Doc fix. * keyboard.c (read_char_menu_prompt): Now static. Add declaration. * dispnew.c (Fredraw_display): Redraw all visible frames. (redraw_garbaged_frames): New function. * xdisp.c (redisplay, echo_area_display): Use redraw_garbaged_frames. * dispnew.c (do_pending_window_change): No need to clear FRAME_NEW_HEIGHT/WIDTH. Do test width != 0. * xterm.c (x_wm_set_size_hint): Handle XGetNormalHints returning 0. * xfns.c (x_set_frame_parameters): Process all parms in reverse order. * frame.h (FRAME_MINIBUF_WINDOW): Use minibuffer_window. Wed Jun 2 16:12:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sysdep.c (init_sys_modes): Disable VLNEXT char. Also VWERASE, VREPRINT, VDISCARD. * xfaces.c: Test XOS_NEEDS_TIME_H, not HPUX, for including time.h. * s/sol2.h, s/hpux.h (XOS_NEEDS_TIME_H): Defined. Wed Jun 2 20:11:29 1993 Francesco Potorti` (pot@cnuce.cnr.it) * ymakefile (alloca.o): Use temp names allocax.o, allocax.s * m/delta.h (MOTOROLA_DELTA): Defined. (HAVE_SYSVIPC, BAT68K, BAT_ALLOCA): Deleted--obsolete. (STACK_DIRECTION, HAVE_X_WINDOWS): Deleted--configure knows. (C_SWITCH_MACHINE): Set to -ga if using the Green Hills compiler. (LIB_STANDARD, LIB_MATH): Defined to the 68881 versions. (LIBS_SYSTEM): -lbsd brings sigblock and sigsetmask. (sigsetmask): Undefined--it is in -lbsd. (LDAV_SYMBOL): Undefined--we have no such thing. (KERNEL_FILE): Defined to "/sysV68". (BSTRING, HAVE_SELECT, HAVE_UNISTD_H, HAVE_TIMEVAL): Defined. (SIGNALS_VIA_CHARACTERS): Defined. (memmove): Defined as memcpy--we have no memmove. (SIGIO, INTERRUPT_INPUT): Undefined--not yet tested. (SHORT_FILE_NAMES, CLASH_DETECTION): Defined. Wed Jun 2 02:06:21 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.12 released. * term.c (term_get_fkeys): Use correct names for F10 and up. Use the key sequence, not the termcap cap name, in Fdefine_key. * intervals.c (copy_intervals): Don't adjust total_length at the end. Set lengths of subintervals properly. (balance_intervals): Balance left as well as right. Tue Jun 1 22:07:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * keymap.c (syms_of_keymap): Add missing 2nd arg to Fcons. Tue Jun 1 00:27:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * x/esix5-4.h: Redone by Joe Kelsey. * xterm.c (x_new_font): Take out last change. * s/386bsd.h (BSD4_2): Defined. * fileio.c (Fwrite_region): Don't fsync if autosaving. * s/irix4-0.h (GETPGRP_NO_ARG): Defined. * emacs.c (shut_down_emacs): Handle GETPGRP_NO_ARG. * sysdep.c (sys_suspend): Handle GETPGRP_NO_ARG. * fileio.c [HPUX9]: Don't include errnet.h. * hftctl.c (hft_alrm): Don't return a value. Always declare to return void. * floatfns.c [!FLOAT_CHECK_ERRNO] (IN_FLOAT): New definition. (Flog): Fix argument of `log'. * m/pmax.h (KERNEL_FILE): New override definition. * keyboard.c (read_key_sequence) [!USE_TEXT_PROPERTIES]: Fix typo. (menu_bar_items) [!USE_TEXT_PROPERTIES]: Likewise. * s/isc3-0.h: #undef C_SWITCH_SYSTEM. * xselect.c (Fx_store_cut_buffer_internal): Handle empty string right. * xfaces.c (init_frame_faces): Don't look at selected_frame unless it is an X frame. * xfns.c (x_window): Use Vxrdb_name for res_name field. Delete the shortname stuff. * m/pmax.h (LIBS_MACHINE): Defined. * Version 19.11 released. Tue Jun 1 00:07:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xfns.c (x_set_menu_bar_lines): Use FRAME_NEW_HEIGHT and ..._WIDTH. * m/sparc.h [__GNUC__ >= 2]: Don't include alloca.h. * xterm.c (x_new_font): If XListFontsWithInfo finds nothing, try to load the font anyway. * ymakefile (emacs): Don't run inc-vers if ../lisp is read-only. (C_SWITCH_SITE_1): New make variable. (really-oldXMenu): Pass C_SWITCH_X_SITE_1 as C_SWITCH_X_SITE. Use C_SWITCH_SITE_1 to pass C_SWITCH_SITE. * s/386bsd.h: New file. Mon May 31 14:04:22 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fns.c (internal_equal): Don't let ints be equal to floats. * print.c (float_to_string): Skip `-' like digits when ensuring result looks like a float. * data.c (Frem): Fix result sign properly. * xrdb.c [__bsdi__]: ALternate decls of getpwuid and getpwnam. * emacs.c (main) [BSD]: Delete the setpgrp (both times). * m/ibmrs6000.h (NLIST_STRUCT): Defined. * ymakefile (GETLOADAVG_OBJ): New macro. (obj): Use that. * s/bsd386.h: New file. * term.c (term_get_fkeys): If not initialized, init Vfunction_key_map. * m/ibmrs6000.h: Delete ! __GNUC__ conditional. (LD_SWITCH_MACHINE): Defined. (ORDINARY_LINK): Defined unconditionally. * dispnew.c (update_frame): Make preempt_count positive. Defend against negative baud_rate. * scroll.c (calculate_scrolling): Defend against negative baud_rate. * mem-limits.h [__bsdi__]: Define BSD4_2. * xfns.c (x_window): In XSetClassHint, use a shortened version of the frame name. * s/hpux8.h (C_SWITCH_SYSTEM): Fix typo in X11R5 dirname. * xterm.c (XTread_socket, case KeyPress) [HPUX]: Test IsModifiedKey. * keyboard.c (kbd_buffer_get_event): Shorten the first MULTI_FRAME conditional. * s/usg5-4-2.h (HAVE_VFORK): Deleted. Mon May 31 10:07:48 1993 James Clark (jjc@jclark.com) * xselect.c (x_reply_selection_request): Call XFlushQueue. * window.c (Fset_window_buffer): Set window's force_start to Qnil. Mon May 31 01:33:06 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * syntax.c (Fforward_comment): Set point to where scan stops, thus moving acros whitespace. When moving fwd, treat Sendcomment as whitespace; likewise for Scomment when moving back. (scan_sexps_forward): New arg COMMENTSTOP. (Fparse_partial_sexp): Likewise. * xfns.c (Fx_create_frame): Use bitmapIcon, not iconType. Sun May 30 20:04:19 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * data.c (float_arith_driver): Detect division by zero in advance. (arith_driver, Frem): Likewise. * xfns.c (Fx_list_fonts): Handle 0 for FRAME_FACES (f) [face_id]->font. * print.c (Fwith_output_to_temp_buffer): Doc fix. * sysdep.c (wait_for_termination): Delete LINUX conditionals. * s/linux.h (HAVE_TCATTR): Deleted. (BSD): Don't define. (read, write, open, close): Defined. (INTERRUPTIBLE_OPEN, INTERRUPTIBLE_CLOSE, INTERRUPTIBLE_IO): Defined. (C_SWITCH_SYSTEM): Defined. * xterm.c: Include systty.h; don't mess with FIONREAD. Don't include termio.h dorectly. * intervals.c (interval_deletion_adjustment): Delete unreachable abort. * fns.c (Fyes_or_no_p): Delete unreachable UNGCPRO. * keyboard.c (lispy_function_keys): Add `remove' key. Sun May 30 19:24:09 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * buffer.c (Fgenerate_new_buffer_name): Doc fix. Sun May 30 19:10:09 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (clean): Delete libXMenu11.a. Sun May 30 17:48:11 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * m/mips.h (KERNEL_FILE): Set this to "/unix". * m/mips4.h (MIPS2): Go ahead and define this. (C_DEBUG_SWITCH): Add -DMips and -g3, and up Olimit to 2000. Sun May 30 16:51:56 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacs.c (main) [AIX _I386]: Don't handle SIGIOINT. * lisp.h (UCHAR): Don't define if _UCHAR_T. * m/ibmps2-aix.h (HAVE_GETTIMEOFDAY): Deleted. (HAVE_SETSID, HAVE_TERMIOS): Defined. (HAVE_TERMIO): Add #undef. (SIGNALS_VIA_CHARACTERS): Defined. (C_DEBUG_SWITCH): Make definition empty. (LIBS_DEBUG): Defined. (BROKEN_TIOCGWINSZ, LIB_X11_LIB): Add #undef. * sysdep.c (child_setup_tty) [AIX SIGNALS_VIA_CHARACTERS]: Install something usefull in the VQUIT and VINTR. (emacs_set_tty): Try only 10 times to call tcsetattr. Don't use memcmp to test what it did. * systty.h [HAVE_TERMIOS _AIX _I386]: Include termios before termio. * dispnew.c (buffer_posn_from_coords): Since COL is already window-relative, don't subtract window_left. Sun May 30 15:49:17 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xfaces.c (unload_color): Don't #include , , or . Just write out "unsigned long" instead of using the "Pixel" typedef; it's in the protocol, so it's not likely to change. * hftctl.c (hft_alrm): Declare and define this to return void, not int; the AIX #include files have prototypes for it. * s/aix3-2.h (LIBS_SYSTEM): Remove -lIM and -liconv from here... * m/ibmrs6000.h (LIBS_MACHINE): They're already here. Doc fix. * Makefile.in (SUBMAKEFLAGS): Remember to propagate MAKE. Sun May 30 14:18:26 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * s/sunos4-1-3.h: Delete the #undef of SYSTEM_MALLOC. * systty.h [IRIX4]: Include unistd.h. * s/irix4-0.h (IRIX4): Defined. (IRIS_UTIME): #undef this. * xfns.c (Fx_open_connection) [NO_XRM_SET_DATABASE]: Don't call XrmsSetDatabase. * xfaces.c: Fix HPUX conditional syntax. * s/hpux8.h (random, srandom): Defined. * s/usg5-4-2.h: Don't specify s/ dir in #include. * s/usg5-4-2.h (PTY_TTY_NAME_SPRINTF): Defined. (HAVE_SYSV_SIGPAUSE): #undef this. * sysdep.c (wait_for_termination): Add POSIX_SIGNALS alternative. Sun May 30 13:01:54 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * xfaces.c (init_frame_faces): We have to make sure that face ID's are valid on all frames or no frames; make sure F has allocated faces for any face valid on the selected frame. * s/hpux9.h: New file; don't use the GNU allocator. Hope we fix this soon. See ChangeLog.3 for earlier changes. emacs-19.30/src/config.in100444 23073 1 23442 6047602076 14377 0ustar voelkerdaemon/* GNU Emacs site configuration template file. -*- C -*- Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY. No author or distributor accepts responsibility to anyone for the consequences of using it or for whether it serves any particular purpose or works at all, unless he says so in writing. Refer to the GNU Emacs General Public License for full details. Everyone is granted permission to copy, modify and redistribute GNU Emacs, but only under the conditions described in the GNU Emacs General Public License. A copy of this license is supposed to have been given to you along with GNU Emacs so you can know your rights and responsibilities. It should be in a file named COPYING. Among other things, the copyright notice and this notice must be preserved on all copies. */ /* No code in Emacs #includes config.h twice, but some of the code intended to work with other packages as well (like gmalloc.c) think they can include it as many times as they like. */ #ifndef EMACS_CONFIG_H #define EMACS_CONFIG_H /* These are all defined in the top-level Makefile by configure. They're here only for reference. */ /* Define LISP_FLOAT_TYPE if you want emacs to support floating-point numbers. */ #undef LISP_FLOAT_TYPE /* Define GNU_MALLOC if you want to use the *new* GNU memory allocator. */ #undef GNU_MALLOC /* Define REL_ALLOC if you want to use the relocating allocator for buffer space. */ #undef REL_ALLOC /* Define HAVE_X_WINDOWS if you want to use the X window system. */ #undef HAVE_X_WINDOWS /* Define HAVE_X11 if you want to use version 11 of X windows. Otherwise, Emacs expects to use version 10. */ #undef HAVE_X11 /* Define if using an X toolkit. */ #undef USE_X_TOOLKIT /* Define this if you're using XFree386. */ #undef HAVE_XFREE386 /* Define HAVE_X_MENU if you want to use the X window menu system. This appears to work on some machines that support X and not on others. */ #undef HAVE_X_MENU /* Define if we have the X11R6 or newer version of Xt. */ #undef HAVE_X11XTR6 /* Define if netdb.h declares h_errno. */ #undef HAVE_H_ERRNO /* Nowadays we have frame objects even if we support only ASCII terminals. */ #define MULTI_FRAME /* If we're using any sort of window system, define some consequences. */ #ifdef HAVE_X_WINDOWS #define HAVE_WINDOW_SYSTEM #define MULTI_KBOARD #define HAVE_FACES #define HAVE_MOUSE #endif /* Define USE_TEXT_PROPERTIES to support visual and other properties on text. */ #define USE_TEXT_PROPERTIES /* Define USER_FULL_NAME to return a string that is the user's full name. It can assume that the variable `pw' points to the password file entry for this user. At some sites, the pw_gecos field contains the user's full name. If neither this nor any other field contains the right thing, use pw_name, giving the user's login name, since that is better than nothing. */ #define USER_FULL_NAME pw->pw_gecos /* Define AMPERSAND_FULL_NAME if you use the convention that & in the full name stands for the login id. */ #undef AMPERSAND_FULL_NAME /* Things set by --with options in the configure script. */ /* Define to support POP mail retrieval. */ #undef MAIL_USE_POP /* Define to support Kerberos-authenticated POP mail retrieval. */ #undef KERBEROS /* Define to support using a Hesiod database to find the POP server. */ #undef HESIOD /* Some things figured out by the configure script, grouped as they are in configure.in. */ #ifndef _ALL_SOURCE /* suppress warning if this is pre-defined */ #undef _ALL_SOURCE #endif #undef HAVE_SYS_SELECT_H #undef HAVE_SYS_TIMEB_H #undef HAVE_SYS_TIME_H #undef HAVE_UNISTD_H #undef HAVE_UTIME_H #undef STDC_HEADERS #undef TIME_WITH_SYS_TIME #undef HAVE_LIBDNET #undef HAVE_LIBPTHREADS #undef HAVE_LIBRESOLV #undef HAVE_ALLOCA_H #undef HAVE_GETTIMEOFDAY #undef GETTIMEOFDAY_ONE_ARGUMENT #undef HAVE_GETHOSTNAME #undef HAVE_DUP2 #undef HAVE_RENAME #undef HAVE_CLOSEDIR #undef TM_IN_SYS_TIME #undef HAVE_TM_ZONE #undef HAVE_TZNAME #undef const #undef HAVE_LONG_FILE_NAMES #undef CRAY_STACKSEG_END #undef UNEXEC_SRC #undef HAVE_LIBXBSD #undef HAVE_XRMSETDATABASE #undef HAVE_XSCREENRESOURCESTRING #undef HAVE_XSCREENNUMBEROFSCREEN #undef HAVE_XSETWMPROTOCOLS #undef HAVE_MKDIR #undef HAVE_RMDIR #undef HAVE_RANDOM #undef HAVE_LRAND48 #undef HAVE_BCOPY #undef HAVE_BCMP #undef HAVE_LOGB #undef HAVE_FREXP #undef HAVE_FMOD #undef HAVE_FTIME #undef HAVE_RES_INIT /* For -lresolv on Suns. */ #undef HAVE_SETSID #undef HAVE_FPATHCONF #undef HAVE_SELECT #undef HAVE_MKTIME #undef HAVE_EACCESS #undef HAVE_GETPAGESIZE #undef HAVE_INET_SOCKETS #undef HAVE_AIX_SMT_EXP /* Define if you have the ANSI `strerror' function. Otherwise you must have the variable `char *sys_errlist[]'. */ #undef HAVE_STRERROR #undef HAVE_UTIMES /* Define if `sys_siglist' is declared by . */ #undef SYS_SIGLIST_DECLARED /* Define if `struct utimbuf' is declared by . */ #undef HAVE_STRUCT_UTIMBUF /* Define if `struct timeval' is declared by . */ #undef HAVE_TIMEVAL /* If using GNU, then support inline function declarations. */ #ifdef __GNUC__ #define INLINE __inline__ #else #define INLINE #endif #undef EMACS_CONFIGURATION #undef EMACS_CONFIG_OPTIONS /* The configuration script defines opsysfile to be the name of the s/SYSTEM.h file that describes the system type you are using. The file is chosen based on the configuration name you give. See the file ../etc/MACHINES for a list of systems and the configuration names to use for them. See s/template.h for documentation on writing s/SYSTEM.h files. */ #undef config_opsysfile #include config_opsysfile /* The configuration script defines machfile to be the name of the m/MACHINE.h file that describes the machine you are using. The file is chosen based on the configuration name you give. See the file ../etc/MACHINES for a list of machines and the configuration names to use for them. See m/template.h for documentation on writing m/MACHINE.h files. */ #undef config_machfile #include config_machfile /* These typedefs shouldn't appear when alloca.s or Makefile.in includes config.h. */ #ifndef NOT_C_CODE #ifndef SPECIAL_EMACS_INT typedef long EMACS_INT; typedef unsigned long EMACS_UINT; #endif #endif /* Load in the conversion definitions if this system needs them and the source file being compiled has not said to inhibit this. There should be no need for you to alter these lines. */ #ifdef SHORTNAMES #ifndef NO_SHORTNAMES #include "../shortnames/remap.h" #endif /* not NO_SHORTNAMES */ #endif /* SHORTNAMES */ /* If no remapping takes place, static variables cannot be dumped as pure, so don't worry about the `static' keyword. */ #ifdef NO_REMAP #undef static #endif /* Define `subprocesses' should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). These do not work for some USG systems yet; for the ones where they work, the s/SYSTEM.h file defines this flag. */ #ifndef VMS #ifndef USG /* #define subprocesses */ #endif #endif /* Define LD_SWITCH_SITE to contain any special flags your loader may need. */ #undef LD_SWITCH_SITE /* Define C_SWITCH_SITE to contain any special flags your compiler needs. */ #undef C_SWITCH_SITE /* Define LD_SWITCH_X_SITE to contain any special flags your loader may need to deal with X Windows. For instance, if you've defined HAVE_X_WINDOWS above and your X libraries aren't in a place that your loader can find on its own, you might want to add "-L/..." or something similar. */ #undef LD_SWITCH_X_SITE /* Define LD_SWITCH_X_SITE_AUX with an -R option in case it's needed (for Solaris, for example). */ #undef LD_SWITCH_X_SITE_AUX /* Define C_SWITCH_X_SITE to contain any special flags your compiler may need to deal with X Windows. For instance, if you've defined HAVE_X_WINDOWS above and your X include files aren't in a place that your compiler can find on its own, you might want to add "-I/..." or something similar. */ #undef C_SWITCH_X_SITE /* Define STACK_DIRECTION here, but not if m/foo.h did. */ #ifndef STACK_DIRECTION #undef STACK_DIRECTION #endif /* Define the return type of signal handlers if the s-xxx file did not already do so. */ #define RETSIGTYPE void /* SIGTYPE is the macro we actually use. */ #ifndef SIGTYPE #define SIGTYPE RETSIGTYPE #endif #ifdef emacs /* Don't do this for lib-src. */ /* Tell regex.c to use a type compatible with Emacs. */ #define RE_TRANSLATE_TYPE Lisp_Object * #endif /* The rest of the code currently tests the CPP symbol BSTRING. Override any claims made by the system-description files. Note that on some SCO version it is possible to have bcopy and not bcmp. */ #undef BSTRING #if defined (HAVE_BCOPY) && defined (HAVE_BCMP) #define BSTRING #endif /* Non-ANSI C compilers usually don't have volatile. */ #ifndef HAVE_VOLATILE #ifndef __STDC__ #define volatile #endif #endif /* Some of the files of Emacs which are intended for use with other programs assume that if you have a config.h file, you must declare the type of getenv. This declaration shouldn't appear when alloca.s or Makefile.in includes config.h. */ #ifndef NOT_C_CODE extern char *getenv (); #endif #endif /* EMACS_CONFIG_H */ /* These default definitions are good for almost all machines. The exceptions override them in m/*.h. */ #ifndef BITS_PER_CHAR #define BITS_PER_CHAR 8 #endif #ifndef BITS_PER_SHORT #define BITS_PER_SHORT 16 #endif /* Note that lisp.h uses this in a preprocessor conditional, so it would not work to use sizeof. That being so, we do all of them without sizeof, for uniformity's sake. */ #ifndef BITS_PER_INT #define BITS_PER_INT 32 #endif #ifndef BITS_PER_LONG #define BITS_PER_LONG 32 #endif emacs-19.30/src/paths.in100444 12120 1 3477 5650173236 13360 0ustar rmsdaemon/* Hey Emacs, this is -*- C -*- code! */ /* The default search path for Lisp function "load". This sets load-path. */ #define PATH_LOADSEARCH "/usr/local/lib/emacs/lisp" /* Like PATH_LOADSEARCH, but used only when Emacs is dumping. This path is usually identical to PATH_LOADSEARCH except that the entry for the directory containing the installed lisp files has been replaced with ../lisp. */ #define PATH_DUMPLOADSEARCH "../lisp" /* The extra search path for programs to invoke. This is appended to whatever the PATH environment variable says to set the Lisp variable exec-path and the first file name in it sets the Lisp variable exec-directory. exec-directory is used for finding executables and other architecture-dependent files. */ #define PATH_EXEC "/usr/local/lib/emacs/etc" /* Where Emacs should look for its architecture-independent data files, like the NEWS file. The lisp variable data-directory is set to this value. */ #define PATH_DATA "/usr/local/lib/emacs/data" /* Where Emacs should look for X bitmap files. The lisp variable x-bitmap-file-path is set based on this value. */ #define PATH_BITMAPS "/usr/include/X11/bitmaps" /* Where Emacs should look for its docstring file. The lisp variable doc-directory is set to this value. */ #define PATH_DOC "/usr/local/lib/emacs/data" /* The name of the directory that contains lock files with which we record what files are being modified in Emacs. This directory should be writable by everyone. THE STRING MUST END WITH A SLASH!!! */ #define PATH_LOCK "/usr/local/lib/emacs/lock/" /* Where the configuration process believes the info tree lives. The lisp variable configure-info-directory gets its value from this macro, and is then used to set the Info-default-directory-list. */ #define PATH_INFO "/usr/local/info" emacs-19.30/src/makefile.nt100444 23073 1 60502 6054670563 14724 0ustar voelkerdaemon# Makefile for GNU Emacs on Windows NT # Copyright (c) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. # Tim Fleehart (apollo@online.com) 17-Apr-92 # Geoff Voelker (voelker@cs.washington.edu) 11-20-93 # # 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. */ # # # Sets up the system dependent macros. # !include ..\nt\makefile.def !IFDEF NTGUI SUBSYSTEM=windows !ELSE SUBSYSTEM=console !ENDIF # # HAVE_CONFIG_H is required by some generic gnu sources stuck into # the emacs source tree. # LOCAL_FLAGS = -Demacs=1 -DWINDOWSNT -DDOS_NT -DHAVE_CONFIG_H -I..\nt\inc EMACS = $(BLD)\emacs.exe TEMACS = $(BLD)\temacs.exe TLIB1 = $(BLD)\temacs1.lib TLIB2 = $(BLD)\temacs2.lib !IFDEF NTGUI TLIBW32 = $(BLD)\temacw32.lib !ELSE TLIBW32 = !ENDIF TOBJ = $(BLD)\emacs.obj !if $(MSVCNT11) TRES = $(BLD)\emacs.res !else TRES = $(BLD)\emacs.rbj !endif TLASTLIB = $(BLD)\lastfile.lib LINK_FLAGS = $(ARCH_LDFLAGS) -stack:0x1000000 -base:0xD00000 -debug:full -debugtype:cv -machine:$(ARCH) -subsystem:$(SUBSYSTEM) -entry:_start -map:$(BLD)\temacs.map # # Split up the objects into two sets so that we don't run out of # command line space when we link them into a library. # OBJ1 = $(BLD)\abbrev.obj \ $(BLD)\alloc.obj \ $(BLD)\alloca.obj \ $(BLD)\buffer.obj \ $(BLD)\bytecode.obj \ $(BLD)\callint.obj \ $(BLD)\callproc.obj \ $(BLD)\casefiddle.obj \ $(BLD)\cm.obj \ $(BLD)\cmds.obj \ $(BLD)\data.obj \ $(BLD)\dired.obj \ $(BLD)\dispnew.obj \ $(BLD)\doc.obj \ $(BLD)\doprnt.obj \ $(BLD)\editfns.obj \ $(BLD)\eval.obj \ $(BLD)\fileio.obj \ $(BLD)\filelock.obj \ $(BLD)\filemode.obj \ $(BLD)\fns.obj \ $(BLD)\indent.obj \ $(BLD)\insdel.obj \ $(BLD)\keyboard.obj \ $(BLD)\keymap.obj \ $(BLD)\lread.obj \ $(BLD)\macros.obj \ $(BLD)\marker.obj \ $(BLD)\minibuf.obj \ $(BLD)\mocklisp.obj OBJ2 = $(BLD)\nt.obj \ $(BLD)\ntheap.obj \ $(BLD)\ntinevt.obj \ $(BLD)\ntproc.obj \ $(BLD)\ntterm.obj \ $(BLD)\print.obj \ $(BLD)\process.obj \ $(BLD)\regex.obj \ $(BLD)\scroll.obj \ $(BLD)\search.obj \ $(BLD)\syntax.obj \ $(BLD)\sysdep.obj \ $(BLD)\term.obj \ $(BLD)\termcap.obj \ $(BLD)\tparam.obj \ $(BLD)\undo.obj \ $(BLD)\unexnt.obj \ $(BLD)\window.obj \ $(BLD)\xdisp.obj \ $(BLD)\casetab.obj \ $(BLD)\floatfns.obj \ $(BLD)\frame.obj \ $(BLD)\gmalloc.obj \ $(BLD)\intervals.obj \ $(BLD)\ralloc.obj \ $(BLD)\textprop.obj \ $(BLD)\vm-limit.obj \ $(BLD)\region-cache.obj \ $(BLD)\strftime.obj WIN32OBJ = $(BLD)\w32term.obj \ $(BLD)\w32xfns.obj \ $(BLD)\w32fns.obj \ $(BLD)\w32faces.obj \ $(BLD)\w32select.obj \ $(BLD)\w32menu.obj \ $(BLD)\w32reg.obj LIBS = $(TLIB1) \ $(TLIB2) \ !IFDEF NTGUI $(TLIBW32) \ !ENDIF $(TLASTLIB) \ !IFDEF NTGUI gdi32.lib \ comdlg32.lib \ !ENDIF $(BASE_LIBS) \ $(ADVAPI32) \ user32.lib # # Build the executable and dump it. # all: $(BLD) $(EMACS) # # Headers we would preprocess if we could. # PREPARED_HEADERS = config.h paths.h config.h: ..\nt\$(CONFIG_H) $(CP) $** $@ paths.h: ..\nt\paths.h $(CP) $** $@ # # Make sure we have the DOC file in the right place. # DOC = obj\etc\DOC-X $(DOC):; cd ..\lib-src - del DOC-X $(MAKE) -f makefile.nt all cd ..\src # # The dumped executable # emacs: $(EMACS) $(EMACS): $(PREPARED_HEADERS) $(DOC) $(TEMACS) cd $(BLD) temacs.exe -batch -l loadup dump cd ..\.. # # The undumped executable # temacs: $(BLD) $(TEMACS) $(TEMACS): $(TLIB1) $(TLIB2) $(TLIBW32) $(TLASTLIB) $(TOBJ) $(TRES) $(LINK) -out:$(TEMACS) $(LINK_FLAGS) $(TOBJ) $(TRES) $(LIBS) # # The resource file. NT 3.10 requires the use of cvtres; even though # it is not necessary on later versions, it is still ok to use it. # $(TRES): ..\nt\emacs.rc $(RC) -i..\nt -Fo$(BLD)\emacs.res $** !if !$(MSVCNT11) $(CVTRES) -r -$(ARCH) -o $@ $(BLD)\emacs.res !endif # # Build the library. Split up the build into two phases...otherwise we # run out of command line space. # $(TLIB1): $(OBJ1) @- $(AR) -out:$@ $** $(TLIB2): $(OBJ2) @- $(AR) -out:$@ $** !IFDEF NTGUI $(TLIBW32): $(WIN32OBJ) @- $(AR) -out:$@ $** !ENDIF # # Place lastfile.obj in its own library so that it can be loaded after # the source libraries but before any system libraries. Doing so defines # the end of Emacs' data section portably across compilers and systems. # $(TLASTLIB): $(BLD)\lastfile.obj @- $(AR) -out:$@ $** # # Object files. # .c{$(BLD)}.obj: $(CC) $(CFLAGS) -Fo$@ $< # # Assuming INSTALL_DIR is defined, build and install emacs in it. # install: all - mkdir $(INSTALL_DIR)\bin $(CP) $(EMACS) $(INSTALL_DIR)\bin # # Maintenance # clean:; - del *~ *.pdb config.h paths.h - $(DEL_TREE) deleted - $(DEL_TREE) obj # # These files are the ones that compile conditionally on CANNOT_DUMP... # this target is mostly used for debugging. # cleandump:; cd $(BLD) - del callproc.obj data.obj dispnew.obj doc.obj editfns.obj emacs.obj lread.obj process.obj sysdep.obj term.obj ntheap.obj unexnt.obj cd ..\.. ### DEPENDENCIES ### EMACS_ROOT = .. SRC = . $(BLD)\abbrev.obj : \ $(SRC)\abbrev.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\commands.h \ $(SRC)\buffer.h \ $(SRC)\window.h $(BLD)\alloc.obj : \ $(SRC)\alloc.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h \ $(SRC)\puresize.h \ $(SRC)\buffer.h \ $(SRC)\window.h \ $(SRC)\frame.h \ $(SRC)\blockinput.h \ $(SRC)\syssignal.h $(BLD)\alloca.obj : \ $(SRC)\alloca.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\s\windowsnt.h \ $(SRC)\m\intel386.h \ $(SRC)\config.h \ $(SRC)\blockinput.h $(BLD)\buffer.obj : \ $(SRC)\buffer.c \ $(EMACS_ROOT)\nt\inc\sys\param.h \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h \ $(SRC)\window.h \ $(SRC)\commands.h \ $(SRC)\buffer.h \ $(SRC)\indent.h \ $(SRC)\blockinput.h \ $(SRC)\region-cache.h $(BLD)\bytecode.obj : \ $(SRC)\bytecode.c \ $(SRC)\lisp.h \ $(SRC)\buffer.h \ $(SRC)\syntax.h $(BLD)\callint.obj : \ $(SRC)\callint.c \ $(SRC)\lisp.h \ $(SRC)\buffer.h \ $(SRC)\commands.h \ $(SRC)\keyboard.h \ $(SRC)\window.h \ $(SRC)\mocklisp.h $(BLD)\callproc.obj : \ $(SRC)\callproc.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\msdos.h \ $(EMACS_ROOT)\nt\inc\sys\param.h \ $(SRC)\lisp.h \ $(SRC)\commands.h \ $(SRC)\buffer.h \ $(SRC)\process.h \ $(SRC)\syssignal.h \ $(EMACS_ROOT)\nt\inc\sys\ioctl.h \ $(EMACS_ROOT)\nt\inc\sys\file.h \ $(SRC)\systty.h $(BLD)\casefiddle.obj : \ $(SRC)\casefiddle.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h \ $(SRC)\commands.h \ $(SRC)\syntax.h $(CC) $(CFLAGS) -Fo$@ casefiddle.c $(BLD)\casetab.obj : \ $(SRC)\casetab.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h $(BLD)\cm.obj : \ $(SRC)\cm.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\cm.h \ $(SRC)\termhooks.h $(BLD)\cmds.obj : \ $(SRC)\cmds.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\commands.h \ $(SRC)\buffer.h \ $(SRC)\syntax.h $(BLD)\data.obj : \ $(SRC)\data.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\puresize.h \ $(SRC)\buffer.h \ $(SRC)\syssignal.h $(BLD)\dired.obj : \ $(SRC)\dired.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\vmsdir.h \ $(SRC)\ndir.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h \ $(SRC)\commands.h \ $(SRC)\regex.h $(BLD)\dispnew.obj : \ $(SRC)\dispnew.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\termchar.h \ $(SRC)\termopts.h \ $(SRC)\termhooks.h \ $(SRC)\cm.h \ $(SRC)\buffer.h \ $(SRC)\frame.h \ $(SRC)\window.h \ $(SRC)\commands.h \ $(SRC)\disptab.h \ $(SRC)\indent.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h \ $(EMACS_ROOT)\nt\inc\sys\ioctl.h \ $(EMACS_ROOT)\nt\inc\sys\file.h \ $(SRC)\systty.h \ $(SRC)\xterm.h \ $(SRC)\vmstime.h \ $(SRC)\systime.h $(BLD)\doc.obj : \ $(SRC)\doc.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(EMACS_ROOT)\nt\inc\sys\file.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h \ $(SRC)\keyboard.h $(BLD)\doprnt.obj : \ $(SRC)\doprnt.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h $(BLD)\dosfns.obj : \ $(SRC)\dosfns.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h \ $(SRC)\termchar.h \ $(SRC)\termhooks.h \ $(SRC)\frame.h \ $(SRC)\dosfns.h \ $(SRC)\msdos.h $(BLD)\editfns.obj : \ $(SRC)\editfns.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\uaf.h \ $(SRC)\vms-pwd.h \ $(EMACS_ROOT)\nt\inc\pwd.h \ $(SRC)\lisp.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h \ $(SRC)\buffer.h \ $(SRC)\window.h \ $(SRC)\vmstime.h \ $(SRC)\systime.h $(BLD)\emacs.obj : \ $(SRC)\emacs.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\commands.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h \ $(EMACS_ROOT)\nt\inc\sys\ioctl.h \ $(EMACS_ROOT)\nt\inc\sys\file.h \ $(SRC)\systty.h \ $(SRC)\syssignal.h \ $(SRC)\process.h $(BLD)\eval.obj : \ $(SRC)\eval.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\blockinput.h \ $(SRC)\commands.h \ $(SRC)\keyboard.h $(BLD)\fileio.obj : \ $(SRC)\fileio.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\uaf.h \ $(SRC)\vms-pwd.h \ $(EMACS_ROOT)\nt\inc\pwd.h \ $(SRC)\msdos.h \ $(EMACS_ROOT)\nt\inc\sys\param.h \ $(SRC)\vmsdir.h \ $(SRC)\lisp.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h \ $(SRC)\buffer.h \ $(SRC)\window.h \ $(EMACS_ROOT)\nt\inc\sys\file.h \ $(SRC)\vmstime.h \ $(SRC)\systime.h $(BLD)\filelock.obj : \ $(SRC)\filelock.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\uaf.h \ $(SRC)\vms-pwd.h \ $(EMACS_ROOT)\nt\inc\pwd.h \ $(EMACS_ROOT)\nt\inc\sys\file.h \ $(SRC)\lisp.h \ $(EMACS_ROOT)\src\paths.h \ $(SRC)\buffer.h \ $(SRC)\vmsdir.h \ $(SRC)\ndir.h $(BLD)\filemode.obj : \ $(SRC)\filemode.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\s\windowsnt.h \ $(SRC)\m\intel386.h \ $(SRC)\config.h $(BLD)\floatfns.obj : \ $(SRC)\floatfns.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\syssignal.h $(BLD)\fns.obj : \ $(SRC)\fns.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\commands.h \ $(SRC)\buffer.h \ $(SRC)\keyboard.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h $(BLD)\frame.obj : \ $(SRC)\frame.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\frame.h \ $(SRC)\termhooks.h \ $(SRC)\window.h \ $(SRC)\buffer.h \ $(SRC)\commands.h \ $(SRC)\keyboard.h $(BLD)\getloadavg.obj : \ $(SRC)\getloadavg.c \ $(EMACS_ROOT)\nt\inc\sys\param.h \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\s\windowsnt.h \ $(SRC)\m\intel386.h \ $(SRC)\config.h \ $(EMACS_ROOT)\nt\inc\sys\file.h $(BLD)\gmalloc.obj : \ $(SRC)\gmalloc.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(EMACS_ROOT)\nt\inc\sys\param.h \ $(SRC)\getpagesize.h $(CC) $(CFLAGS) -D__STDC__ -Fo$@ gmalloc.c $(BLD)\hftctl.obj : \ $(SRC)\hftctl.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(EMACS_ROOT)\nt\inc\sys\ioctl.h $(BLD)\indent.obj : \ $(SRC)\indent.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h \ $(SRC)\indent.h \ $(SRC)\frame.h \ $(SRC)\window.h \ $(SRC)\termchar.h \ $(SRC)\termopts.h \ $(SRC)\disptab.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h \ $(SRC)\region-cache.h $(BLD)\insdel.obj : \ $(SRC)\insdel.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h \ $(SRC)\buffer.h \ $(SRC)\window.h \ $(SRC)\blockinput.h $(BLD)\intervals.obj : \ $(SRC)\intervals.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h \ $(SRC)\buffer.h \ $(SRC)\puresize.h $(CC) $(CFLAGS) -Fo$@ intervals.c $(BLD)\keyboard.obj : \ $(SRC)\keyboard.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\termchar.h \ $(SRC)\termopts.h \ $(SRC)\lisp.h \ $(SRC)\termhooks.h \ $(SRC)\macros.h \ $(SRC)\frame.h \ $(SRC)\window.h \ $(SRC)\commands.h \ $(SRC)\buffer.h \ $(SRC)\disptab.h \ $(SRC)\keyboard.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h \ $(SRC)\blockinput.h \ $(SRC)\msdos.h \ $(SRC)\syssignal.h \ $(EMACS_ROOT)\nt\inc\sys\ioctl.h \ $(EMACS_ROOT)\nt\inc\sys\file.h \ $(SRC)\systty.h \ $(SRC)\xterm.h \ $(SRC)\vmstime.h \ $(SRC)\systime.h $(BLD)\keymap.obj : \ $(SRC)\keymap.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\commands.h \ $(SRC)\buffer.h \ $(SRC)\keyboard.h \ $(SRC)\termhooks.h \ $(SRC)\blockinput.h $(BLD)\lastfile.obj : \ $(SRC)\lastfile.c $(BLD)\lread.obj : \ $(SRC)\lread.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(EMACS_ROOT)\nt\inc\sys\file.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h \ $(EMACS_ROOT)\src\paths.h \ $(SRC)\commands.h \ $(SRC)\keyboard.h \ $(SRC)\termhooks.h \ $(SRC)\msdos.h $(BLD)\macros.obj : \ $(SRC)\macros.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\macros.h \ $(SRC)\commands.h \ $(SRC)\buffer.h \ $(SRC)\window.h $(BLD)\marker.obj : \ $(SRC)\marker.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h $(BLD)\minibuf.obj : \ $(SRC)\minibuf.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\commands.h \ $(SRC)\buffer.h \ $(SRC)\dispextern.h \ $(SRC)\frame.h \ $(SRC)\window.h \ $(SRC)\syntax.h $(BLD)\mocklisp.obj : \ $(SRC)\mocklisp.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h $(BLD)\nt.obj : \ $(SRC)\nt.c \ $(SRC)\s\windowsnt.h \ $(SRC)\m\intel386.h \ $(SRC)\config.h \ $(SRC)\lisp.h \ $(EMACS_ROOT)\nt\inc\pwd.h \ $(SRC)\ntheap.h $(BLD)\ntheap.obj : \ $(SRC)\ntheap.c \ $(SRC)\ntheap.h $(BLD)\ntinevt.obj : \ $(SRC)\ntinevt.c \ $(SRC)\s\windowsnt.h \ $(SRC)\m\intel386.h \ $(SRC)\config.h \ $(SRC)\lisp.h \ $(SRC)\frame.h \ $(SRC)\blockinput.h \ $(SRC)\termhooks.h $(BLD)\ntproc.obj : \ $(SRC)\ntproc.c \ $(SRC)\s\windowsnt.h \ $(SRC)\m\intel386.h \ $(SRC)\config.h \ $(SRC)\lisp.h \ $(SRC)\nt.h \ $(SRC)\vmstime.h \ $(SRC)\systime.h $(BLD)\ntterm.obj : \ $(SRC)\ntterm.c \ $(SRC)\s\windowsnt.h \ $(SRC)\m\intel386.h \ $(SRC)\config.h \ $(SRC)\lisp.h \ $(SRC)\frame.h \ $(SRC)\disptab.h \ $(SRC)\termhooks.h \ $(SRC)\ntinevt.h $(BLD)\prefix-args.obj : \ $(SRC)\prefix-args.c $(BLD)\print.obj : \ $(SRC)\print.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h \ $(SRC)\frame.h \ $(SRC)\window.h \ $(SRC)\process.h \ $(SRC)\termchar.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h $(BLD)\process.obj : \ $(SRC)\process.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(EMACS_ROOT)\nt\inc\sys\ioctl.h \ $(EMACS_ROOT)\nt\inc\sys\file.h \ $(SRC)\systty.h \ $(SRC)\window.h \ $(SRC)\buffer.h \ $(SRC)\process.h \ $(SRC)\termhooks.h \ $(SRC)\commands.h \ $(SRC)\frame.h \ $(SRC)\syssignal.h \ $(SRC)\vmsproc.h \ $(SRC)\syswait.h \ $(SRC)\lisp.h \ $(SRC)\vmstime.h \ $(SRC)\systime.h \ $(SRC)\termopts.h $(BLD)\ralloc.obj : \ $(SRC)\ralloc.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\s\windowsnt.h \ $(SRC)\m\intel386.h \ $(SRC)\config.h \ $(EMACS_ROOT)\nt\inc\sys\param.h \ $(SRC)\getpagesize.h $(BLD)\regex.obj : \ $(SRC)\regex.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\s\windowsnt.h \ $(SRC)\m\intel386.h \ $(SRC)\config.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h \ $(SRC)\syntax.h \ $(SRC)\regex.h $(BLD)\region-cache.obj : \ $(SRC)\region-cache.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h \ $(SRC)\region-cache.h $(BLD)\scroll.obj : \ $(SRC)\scroll.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\termchar.h \ $(SRC)\lisp.h \ $(SRC)\dispextern.h \ $(SRC)\frame.h $(BLD)\search.obj : \ $(SRC)\search.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\syntax.h \ $(SRC)\buffer.h \ $(SRC)\commands.h \ $(SRC)\blockinput.h \ $(SRC)\regex.h \ $(SRC)\region-cache.h $(BLD)\strftime.obj : \ $(SRC)\strftime.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h $(CC) $(CFLAGS) -Dstrftime=emacs_strftime -Fo$@ strftime.c $(BLD)\sunfns.obj : \ $(SRC)\sunfns.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\window.h \ $(SRC)\buffer.h \ $(SRC)\termhooks.h $(BLD)\syntax.obj : \ $(SRC)\syntax.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\commands.h \ $(SRC)\buffer.h \ $(SRC)\syntax.h $(BLD)\sysdep.obj : \ $(SRC)\sysdep.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\blockinput.h \ $(SRC)\dosfns.h \ $(SRC)\msdos.h \ $(EMACS_ROOT)\nt\inc\sys\param.h \ $(EMACS_ROOT)\nt\inc\sys\file.h \ $(EMACS_ROOT)\nt\inc\sys\ioctl.h \ $(EMACS_ROOT)\nt\inc\sys\file.h \ $(SRC)\systty.h \ $(SRC)\vmsproc.h \ $(SRC)\syswait.h \ $(SRC)\frame.h \ $(SRC)\window.h \ $(SRC)\termhooks.h \ $(SRC)\termchar.h \ $(SRC)\termopts.h \ $(SRC)\dispextern.h \ $(SRC)\process.h \ $(SRC)\vmsdir.h \ $(SRC)\ndir.h \ $(SRC)\syssignal.h \ $(SRC)\vmstime.h \ $(SRC)\systime.h \ $(SRC)\uaf.h \ $(SRC)\vms-pwd.h \ $(EMACS_ROOT)\src\acldef.h \ $(EMACS_ROOT)\src\chpdef.h $(BLD)\term.obj : \ $(SRC)\term.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\termchar.h \ $(SRC)\termopts.h \ $(SRC)\cm.h \ $(SRC)\lisp.h \ $(SRC)\frame.h \ $(SRC)\disptab.h \ $(SRC)\termhooks.h \ $(SRC)\keyboard.h $(BLD)\termcap.obj : \ $(SRC)\termcap.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(EMACS_ROOT)\nt\inc\sys\file.h $(BLD)\terminfo.obj : \ $(SRC)\terminfo.c $(BLD)\textprop.obj : \ $(SRC)\textprop.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h \ $(SRC)\buffer.h \ $(SRC)\window.h $(BLD)\tparam.obj : \ $(SRC)\tparam.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h $(BLD)\undo.obj : \ $(SRC)\undo.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h \ $(SRC)\commands.h $(BLD)\unexnt.obj : \ $(SRC)\unexnt.c \ $(SRC)\ntheap.h $(BLD)\vm-limit.obj : \ $(SRC)\vm-limit.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\mem-limits.h $(BLD)\widget.obj : \ $(SRC)\widget.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\xterm.h \ $(SRC)\frame.h \ $(SRC)\dispextern.h \ $(SRC)\widget.h \ $(SRC)\widgetprv.h $(BLD)\window.obj : \ $(SRC)\window.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\buffer.h \ $(SRC)\frame.h \ $(SRC)\window.h \ $(SRC)\commands.h \ $(SRC)\indent.h \ $(SRC)\termchar.h \ $(SRC)\disptab.h \ $(SRC)\keyboard.h $(BLD)\xdisp.obj : \ $(SRC)\xdisp.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\lisp.h \ $(SRC)\frame.h \ $(SRC)\window.h \ $(SRC)\termchar.h \ $(SRC)\buffer.h \ $(SRC)\indent.h \ $(SRC)\commands.h \ $(SRC)\macros.h \ $(SRC)\disptab.h \ $(SRC)\termhooks.h \ $(SRC)\dispextern.h \ $(SRC)\intervals.h $(BLD)\w32faces.obj: \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\w32faces.c \ $(SRC)\dispextern.h \ $(SRC)\frame.h \ $(SRC)\w32term.h \ $(SRC)\win32.h \ $(SRC)\buffer.h \ $(SRC)\blockinput.h \ $(SRC)\window.h $(BLD)\w32fns.obj: \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\w32fns.c \ $(SRC)\dispextern.h \ $(SRC)\frame.h \ $(SRC)\w32term.h \ $(SRC)\win32.h \ $(SRC)\buffer.h \ $(SRC)\blockinput.h \ $(SRC)\window.h $(BLD)\w32menu.obj: \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\w32menu.c \ $(SRC)\dispextern.h \ $(SRC)\frame.h \ $(SRC)\w32term.h \ $(SRC)\win32.h \ $(SRC)\buffer.h \ $(SRC)\blockinput.h \ $(SRC)\window.h $(BLD)\w32term.obj: \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\w32term.c \ $(SRC)\dispextern.h \ $(SRC)\frame.h \ $(SRC)\w32term.h \ $(SRC)\win32.h \ $(SRC)\buffer.h \ $(SRC)\blockinput.h \ $(SRC)\window.h $(BLD)\w32select.obj: \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\w32select.c \ $(SRC)\dispextern.h \ $(SRC)\frame.h \ $(SRC)\w32term.h \ $(SRC)\win32.h \ $(SRC)\blockinput.h $(BLD)\w32reg.obj: \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\w32reg.c \ $(SRC)\dispextern.h \ $(SRC)\frame.h \ $(SRC)\w32term.h \ $(SRC)\win32.h \ $(SRC)\blockinput.h emacs-19.30/src/.gdbinit100444 12120 1 16444 6052415714 13345 0ustar rmsdaemon# Set up a mask to use. # Force loading of symbols, enough to give us gdb_valbits etc. set main # This should be EMACS_INT, but in some cases that is a macro. # long ought to work in all cases right now. set $valmask = ((long)1 << gdb_valbits) - 1 set $nonvalbits = gdb_emacs_intbits - gdb_valbits # Set up something to print out s-expressions. define pr set debug_print ($) end document pr Print the emacs s-expression which is $. Works only when an inferior emacs is executing. end define xtype output (enum Lisp_Type) (($ >> gdb_valbits) & 0x7) echo \n output ((($ >> gdb_valbits) & 0x7) == Lisp_Misc ? (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($ & $valmask) | gdb_data_seg_bits))->type) : (($ >> gdb_valbits) & 0x7) == Lisp_Vectorlike ? ($size = ((struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits))->size, (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0)) : 0) echo \n end document xtype Print the type of $, assuming it is an Emacs Lisp value. If the first type printed is Lisp_Vector or Lisp_Misc, the second line gives the more precise type. Otherwise the second line doesn't mean anything. end define xvectype set $size = ((struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits))->size output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0) echo \n end document xvectype Print the vector subtype of $, assuming it is a vector or pseudovector. end define xmisctype output (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($ & $valmask) | gdb_data_seg_bits))->type) echo \n end document xmisctype Print the specific type of $, assuming it is some misc type. end define xint print (($ & $valmask) << $nonvalbits) >> $nonvalbits end document xint Print $, assuming it is an Emacs Lisp integer. This gets the sign right. end define xptr print (void *) (($ & $valmask) | gdb_data_seg_bits) end document xptr Print the pointer portion of $, assuming it is an Emacs Lisp value. end define xwindow print (struct window *) (($ & $valmask) | gdb_data_seg_bits) printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top end document xwindow Print $ as a window pointer, assuming it is an Emacs Lisp window value. Print the window's position as "WIDTHxHEIGHT+LEFT+TOP". end define xmarker print (struct Lisp_Marker *) (($ & $valmask) | gdb_data_seg_bits) end document xmarker Print $ as a marker pointer, assuming it is an Emacs Lisp marker value. end define xoverlay print (struct Lisp_Overlay *) (($ & $valmask) | gdb_data_seg_bits) end document xoverlay Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value. end define xmiscfree print (struct Lisp_Free *) (($ & $valmask) | gdb_data_seg_bits) end document xmiscfree Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value. end define xintfwd print (struct Lisp_Intfwd *) (($ & $valmask) | gdb_data_seg_bits) end document xintfwd Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value. end define xboolfwd print (struct Lisp_Boolfwd *) (($ & $valmask) | gdb_data_seg_bits) end document xboolfwd Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value. end define xobjfwd print (struct Lisp_Objfwd *) (($ & $valmask) | gdb_data_seg_bits) end document xobjfwd Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value. end define xbufobjfwd print (struct Lisp_Buffer_Objfwd *) (($ & $valmask) | gdb_data_seg_bits) end document xbufobjfwd Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. end define xkbobjfwd print (struct Lisp_Kboard_Objfwd *) (($ & $valmask) | gdb_data_seg_bits) end document xkbobjfwd Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. end define xbuflocal print (struct Lisp_Buffer_Local_Value *) (($ & $valmask) | gdb_data_seg_bits) end document xbuflocal Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value. end define xbuffer print (struct buffer *) (($ & $valmask) | gdb_data_seg_bits) output &((struct Lisp_String *) ((($->name) & $valmask) | gdb_data_seg_bits))->data echo \n end document xbuffer Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value. Print the name of the buffer. end define xsymbol print (struct Lisp_Symbol *) ((((int) $) & $valmask) | gdb_data_seg_bits) output (char*)&$->name->data echo \n end document xsymbol Print the name and address of the symbol $. This command assumes that $ is an Emacs Lisp symbol value. end define xstring print (struct Lisp_String *) (($ & $valmask) | gdb_data_seg_bits) output ($->size > 1000) ? 0 : ($->data[0])@($->size) echo \n end document xstring Print the contents and address of the string $. This command assumes that $ is an Emacs Lisp string value. end define xvector print (struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits) output ($->size > 50) ? 0 : ($->contents[0])@($->size) echo \n end document xvector Print the contents and address of the vector $. This command assumes that $ is an Emacs Lisp vector value. end define xframe print (struct frame *) (($ & $valmask) | gdb_data_seg_bits) end document xframe Print $ as a frame pointer, assuming it is an Emacs Lisp frame value. end define xwinconfig print (struct save_window_data *) (($ & $valmask) | gdb_data_seg_bits) end document xwinconfig Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value. end define xcompiled print (struct Lisp_Vector *) (($ & $valmask) | gdb_data_seg_bits) output ($->contents[0])@($->size & 0xff) end document xcompiled Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value. end define xcons print (struct Lisp_Cons *) (($ & $valmask) | gdb_data_seg_bits) output *$ echo \n end document xcons Print the contents of $, assuming it is an Emacs Lisp cons. end define xcar print ((($ >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($ & $valmask) | gdb_data_seg_bits))->car : 0) end document xcar Print the car of $, assuming it is an Emacs Lisp pair. end define xcdr print ((($ >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($ & $valmask) | gdb_data_seg_bits))->cdr : 0) end document xcdr Print the cdr of $, assuming it is an Emacs Lisp pair. end define xsubr print (struct Lisp_Subr *) (($ & $valmask) | gdb_data_seg_bits) output *$ echo \n end document xsubr Print the address of the subr which the Lisp_Object $ points to. end define xprocess print (struct Lisp_Process *) (($ & $valmask) | gdb_data_seg_bits) output *$ echo \n end document xprocess Print the address of the struct Lisp_process which the Lisp_Object $ points to. end define xfloat print ((struct Lisp_Float *) (($ & $valmask) | gdb_data_seg_bits))->data end document xfloat Print $ assuming it is a lisp floating-point number. end define xscrollbar print (struct scrollbar *) (($ & $valmask) | gdb_data_seg_bits) output *$ echo \n end document xscrollbar Print $ as a scrollbar pointer. end set print pretty on set print sevenbit-strings show environment DISPLAY show environment TERM set args -geometry 80x40+0+0 # Don't let abort actually run, as it will make # stdio stop working and therefore the `pr' command above as well. break abort # If we are running in synchronous mode, we want a chance to look around # before Emacs exits. Perhaps we should put the break somewhere else # instead... break x_error_quitter emacs-19.30/src/.dbxinit100644 13437 1 274 5173427546 13467 0ustar jimbdaemonignore 14 catch 18 ignore 20 ignore 23 alias s step alias n next alias c cont alias st status alias r run alias l list alias f file alias q quit alias w where alias d delete alias p print emacs-19.30/src/temacs.opt100666 13437 1 1420 4314660346 14034 0ustar jimbdaemoncluster=emacs,,,- DISPNEW.OBJ,- SCROLL.OBJ,- XDISP.OBJ,- WINDOW.OBJ,- TERM.OBJ,- CM.OBJ,- EMACS.OBJ,- KEYBOARD.OBJ,- MACROS.OBJ,- KEYMAP.OBJ,- SYSDEP.OBJ,- BUFFER.OBJ,- FILELOCK.OBJ,- INSDEL.OBJ,- MARKER.OBJ,- MINIBUF.OBJ,- FILEIO.OBJ,- DIRED.OBJ,- FILEMODE.OBJ,- CMDS.OBJ,- CASEFIDDLE.OBJ,- INDENT.OBJ,- SEARCH.OBJ,- REGEX.OBJ,- UNDO.OBJ,- ALLOC.OBJ,- DATA.OBJ,- DOC.OBJ,- EDITFNS.OBJ,- CALLINT.OBJ,- EVAL.OBJ,- FNS.OBJ,- PRINT.OBJ,- LREAD.OBJ,- ABBREV.OBJ,- SYNTAX.OBJ,- MOCKLISP.OBJ,- BYTECODE.OBJ,- PROCESS.OBJ,- CALLPROC.OBJ,- VMSFNS.OBJ,- VMSPROC.OBJ,- DOPRNT.OBJ,- vmsmap.obj,- termcap.obj,- tparam.obj,- lastfile.obj,- alloca.obj,- malloc.obj collect=non_saved_data,- stdin,- stdout,- stderr,- errno,- vaxc$errno,- sys_errlist,- sys_nerr,- environ sys$library:vaxcrtl/library emacs-19.30/src/vms-pp.trans100666 13437 1 1045 3753756752 14347 0ustar jimbdaemon! translations for extra long variable names !234567890123456789012345678901 1234567890123456789012345678901 Vminibuffer_local_completion_map Vminibuf_local_completion_map Vminibuffer_local_must_match_map Vminibuf_local_must_match Finsert_abbrev_table_description Finsert_abbrev_table_descrip Sinsert_abbrev_table_description Sinsert_abbrev_table_descrip internal_with_output_to_temp_buffer internal_with_out_to_temp_buf Vminibuffer_completion_predicate Vminibuf_completion_predicate Qminibuffer_completion_predicate Qminibuf_completion_predicate emacs-19.30/lib-src/ 40777 12120 1 0 6055530750 12351 5ustar rmsdaemonemacs-19.30/lib-src/COPYING100666 12120 1 43070 6055530747 13533 0ustar rmsdaemon GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. 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. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. emacs-19.30/lib-src/alloca.c100444 12120 1 33405 6055530750 14064 0ustar rmsdaemon/* alloca.c -- allocate automatically reclaimed memory (Mostly) portable public-domain implementation -- D A Gwyn This implementation of the PWB library alloca function, which is used to allocate space off the run-time stack so that it is automatically reclaimed upon procedure exit, was inspired by discussions with J. Q. Johnson of Cornell. J.Otto Tennant contributed the Cray support. There are some preprocessor constants that can be defined when compiling for your specific system, for improved efficiency; however, the defaults should be okay. The general concept of this implementation is to keep track of all alloca-allocated blocks, and reclaim any that are found to be deeper in the stack than the current invocation. This heuristic does not reclaim storage as soon as it becomes invalid, but it will do so eventually. As a special case, alloca(0) reclaims storage without allocating any. It is a good idea to use alloca(0) in your main control loop, etc. to force garbage collection. */ #ifdef HAVE_CONFIG_H #include #endif #ifdef emacs #include "blockinput.h" #endif /* If compiling with GCC 2, this file's not needed. */ #if !defined (__GNUC__) || __GNUC__ < 2 /* If someone has defined alloca as a macro, there must be some other way alloca is supposed to work. */ #ifndef alloca #ifdef emacs #ifdef static /* actually, only want this if static is defined as "" -- this is for usg, in which emacs must undefine static in order to make unexec workable */ #ifndef STACK_DIRECTION you lose -- must know STACK_DIRECTION at compile-time #endif /* STACK_DIRECTION undefined */ #endif /* static */ #endif /* emacs */ /* If your stack is a linked list of frames, you have to provide an "address metric" ADDRESS_FUNCTION macro. */ #if defined (CRAY) && defined (CRAY_STACKSEG_END) long i00afunc (); #define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg)) #else #define ADDRESS_FUNCTION(arg) &(arg) #endif #if __STDC__ typedef void *pointer; #else typedef char *pointer; #endif #define NULL 0 /* Different portions of Emacs need to call different versions of malloc. The Emacs executable needs alloca to call xmalloc, because ordinary malloc isn't protected from input signals. On the other hand, the utilities in lib-src need alloca to call malloc; some of them are very simple, and don't have an xmalloc routine. Non-Emacs programs expect this to call use xmalloc. Callers below should use malloc. */ #ifndef emacs #define malloc xmalloc #endif extern pointer malloc (); /* Define STACK_DIRECTION if you know the direction of stack growth for your system; otherwise it will be automatically deduced at run-time. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ #ifndef STACK_DIRECTION #define STACK_DIRECTION 0 /* Direction unknown. */ #endif #if STACK_DIRECTION != 0 #define STACK_DIR STACK_DIRECTION /* Known at compile-time. */ #else /* STACK_DIRECTION == 0; need run-time code. */ static int stack_dir; /* 1 or -1 once known. */ #define STACK_DIR stack_dir static void find_stack_direction () { static char *addr = NULL; /* Address of first `dummy', once known. */ auto char dummy; /* To get stack address. */ if (addr == NULL) { /* Initial entry. */ addr = ADDRESS_FUNCTION (dummy); find_stack_direction (); /* Recurse once. */ } else { /* Second entry. */ if (ADDRESS_FUNCTION (dummy) > addr) stack_dir = 1; /* Stack grew upward. */ else stack_dir = -1; /* Stack grew downward. */ } } #endif /* STACK_DIRECTION == 0 */ /* An "alloca header" is used to: (a) chain together all alloca'ed blocks; (b) keep track of stack depth. It is very important that sizeof(header) agree with malloc alignment chunk size. The following default should work okay. */ #ifndef ALIGN_SIZE #define ALIGN_SIZE sizeof(double) #endif typedef union hdr { char align[ALIGN_SIZE]; /* To force sizeof(header). */ struct { union hdr *next; /* For chaining headers. */ char *deep; /* For stack depth measure. */ } h; } header; static header *last_alloca_header = NULL; /* -> last alloca header. */ /* Return a pointer to at least SIZE bytes of storage, which will be automatically reclaimed upon exit from the procedure that called alloca. Originally, this space was supposed to be taken from the current stack frame of the caller, but that method cannot be made to work for some implementations of C, for example under Gould's UTX/32. */ pointer alloca (size) unsigned size; { auto char probe; /* Probes stack depth: */ register char *depth = ADDRESS_FUNCTION (probe); #if STACK_DIRECTION == 0 if (STACK_DIR == 0) /* Unknown growth direction. */ find_stack_direction (); #endif /* Reclaim garbage, defined as all alloca'd storage that was allocated from deeper in the stack than currently. */ { register header *hp; /* Traverses linked list. */ #ifdef emacs BLOCK_INPUT; #endif for (hp = last_alloca_header; hp != NULL;) if ((STACK_DIR > 0 && hp->h.deep > depth) || (STACK_DIR < 0 && hp->h.deep < depth)) { register header *np = hp->h.next; free ((pointer) hp); /* Collect garbage. */ hp = np; /* -> next header. */ } else break; /* Rest are not deeper. */ last_alloca_header = hp; /* -> last valid storage. */ #ifdef emacs UNBLOCK_INPUT; #endif } if (size == 0) return NULL; /* No allocation required. */ /* Allocate combined header + user data storage. */ { register pointer new = malloc (sizeof (header) + size); /* Address of header. */ ((header *) new)->h.next = last_alloca_header; ((header *) new)->h.deep = depth; last_alloca_header = (header *) new; /* User storage begins just after header. */ return (pointer) ((char *) new + sizeof (header)); } } #if defined (CRAY) && defined (CRAY_STACKSEG_END) #ifdef DEBUG_I00AFUNC #include #endif #ifndef CRAY_STACK #define CRAY_STACK #ifndef CRAY2 /* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */ struct stack_control_header { long shgrow:32; /* Number of times stack has grown. */ long shaseg:32; /* Size of increments to stack. */ long shhwm:32; /* High water mark of stack. */ long shsize:32; /* Current size of stack (all segments). */ }; /* The stack segment linkage control information occurs at the high-address end of a stack segment. (The stack grows from low addresses to high addresses.) The initial part of the stack segment linkage control information is 0200 (octal) words. This provides for register storage for the routine which overflows the stack. */ struct stack_segment_linkage { long ss[0200]; /* 0200 overflow words. */ long sssize:32; /* Number of words in this segment. */ long ssbase:32; /* Offset to stack base. */ long:32; long sspseg:32; /* Offset to linkage control of previous segment of stack. */ long:32; long sstcpt:32; /* Pointer to task common address block. */ long sscsnm; /* Private control structure number for microtasking. */ long ssusr1; /* Reserved for user. */ long ssusr2; /* Reserved for user. */ long sstpid; /* Process ID for pid based multi-tasking. */ long ssgvup; /* Pointer to multitasking thread giveup. */ long sscray[7]; /* Reserved for Cray Research. */ long ssa0; long ssa1; long ssa2; long ssa3; long ssa4; long ssa5; long ssa6; long ssa7; long sss0; long sss1; long sss2; long sss3; long sss4; long sss5; long sss6; long sss7; }; #else /* CRAY2 */ /* The following structure defines the vector of words returned by the STKSTAT library routine. */ struct stk_stat { long now; /* Current total stack size. */ long maxc; /* Amount of contiguous space which would be required to satisfy the maximum stack demand to date. */ long high_water; /* Stack high-water mark. */ long overflows; /* Number of stack overflow ($STKOFEN) calls. */ long hits; /* Number of internal buffer hits. */ long extends; /* Number of block extensions. */ long stko_mallocs; /* Block allocations by $STKOFEN. */ long underflows; /* Number of stack underflow calls ($STKRETN). */ long stko_free; /* Number of deallocations by $STKRETN. */ long stkm_free; /* Number of deallocations by $STKMRET. */ long segments; /* Current number of stack segments. */ long maxs; /* Maximum number of stack segments so far. */ long pad_size; /* Stack pad size. */ long current_address; /* Current stack segment address. */ long current_size; /* Current stack segment size. This number is actually corrupted by STKSTAT to include the fifteen word trailer area. */ long initial_address; /* Address of initial segment. */ long initial_size; /* Size of initial segment. */ }; /* The following structure describes the data structure which trails any stack segment. I think that the description in 'asdef' is out of date. I only describe the parts that I am sure about. */ struct stk_trailer { long this_address; /* Address of this block. */ long this_size; /* Size of this block (does not include this trailer). */ long unknown2; long unknown3; long link; /* Address of trailer block of previous segment. */ long unknown5; long unknown6; long unknown7; long unknown8; long unknown9; long unknown10; long unknown11; long unknown12; long unknown13; long unknown14; }; #endif /* CRAY2 */ #endif /* not CRAY_STACK */ #ifdef CRAY2 /* Determine a "stack measure" for an arbitrary ADDRESS. I doubt that "lint" will like this much. */ static long i00afunc (long *address) { struct stk_stat status; struct stk_trailer *trailer; long *block, size; long result = 0; /* We want to iterate through all of the segments. The first step is to get the stack status structure. We could do this more quickly and more directly, perhaps, by referencing the $LM00 common block, but I know that this works. */ STKSTAT (&status); /* Set up the iteration. */ trailer = (struct stk_trailer *) (status.current_address + status.current_size - 15); /* There must be at least one stack segment. Therefore it is a fatal error if "trailer" is null. */ if (trailer == 0) abort (); /* Discard segments that do not contain our argument address. */ while (trailer != 0) { block = (long *) trailer->this_address; size = trailer->this_size; if (block == 0 || size == 0) abort (); trailer = (struct stk_trailer *) trailer->link; if ((block <= address) && (address < (block + size))) break; } /* Set the result to the offset in this segment and add the sizes of all predecessor segments. */ result = address - block; if (trailer == 0) { return result; } do { if (trailer->this_size <= 0) abort (); result += trailer->this_size; trailer = (struct stk_trailer *) trailer->link; } while (trailer != 0); /* We are done. Note that if you present a bogus address (one not in any segment), you will get a different number back, formed from subtracting the address of the first block. This is probably not what you want. */ return (result); } #else /* not CRAY2 */ /* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP. Determine the number of the cell within the stack, given the address of the cell. The purpose of this routine is to linearize, in some sense, stack addresses for alloca. */ static long i00afunc (long address) { long stkl = 0; long size, pseg, this_segment, stack; long result = 0; struct stack_segment_linkage *ssptr; /* Register B67 contains the address of the end of the current stack segment. If you (as a subprogram) store your registers on the stack and find that you are past the contents of B67, you have overflowed the segment. B67 also points to the stack segment linkage control area, which is what we are really interested in. */ stkl = CRAY_STACKSEG_END (); ssptr = (struct stack_segment_linkage *) stkl; /* If one subtracts 'size' from the end of the segment, one has the address of the first word of the segment. If this is not the first segment, 'pseg' will be nonzero. */ pseg = ssptr->sspseg; size = ssptr->sssize; this_segment = stkl - size; /* It is possible that calling this routine itself caused a stack overflow. Discard stack segments which do not contain the target address. */ while (!(this_segment <= address && address <= stkl)) { #ifdef DEBUG_I00AFUNC fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl); #endif if (pseg == 0) break; stkl = stkl - pseg; ssptr = (struct stack_segment_linkage *) stkl; size = ssptr->sssize; pseg = ssptr->sspseg; this_segment = stkl - size; } result = address - this_segment; /* If you subtract pseg from the current end of the stack, you get the address of the previous stack segment's end. This seems a little convoluted to me, but I'll bet you save a cycle somewhere. */ while (pseg != 0) { #ifdef DEBUG_I00AFUNC fprintf (stderr, "%011o %011o\n", pseg, size); #endif stkl = stkl - pseg; ssptr = (struct stack_segment_linkage *) stkl; size = ssptr->sssize; pseg = ssptr->sspseg; result += size; } return (result); } #endif /* not CRAY2 */ #endif /* CRAY */ #endif /* no alloca */ #endif /* not GCC version 2 */ emacs-19.30/lib-src/b2m.c100444 12120 13 12214 5752073641 13046 0ustar rmsuser/* * b2m - a filter for Babyl -> Unix mail files * * usage: b2m < babyl > mailbox * * I find this useful whenever I have to use a * system which - shock horror! - doesn't run * Gnu emacs. At least now I can read all my * Gnumacs Babyl format mail files! * * it's not much but it's free! * * Ed Wilkinson * E.Wilkinson@massey.ac.nz * Mon Nov 7 15:54:06 PDT 1988 */ /* Made conformant to the GNU coding standards January, 1995 by Francesco Potorti` . */ #include #include #include #ifdef MSDOS #include #endif #ifdef HAVE_CONFIG_H #include /* On some systems, Emacs defines static as nothing for the sake of unexec. We don't want that here since we don't use unexec. */ #undef static #endif #undef TRUE #define TRUE 1 #undef FALSE #define FALSE 0 /* Exit codes for success and failure. */ #ifdef VMS #define GOOD 1 #define BAD 0 #else #define GOOD 0 #define BAD 1 #endif #define streq(s,t) (strcmp (s, t) == 0) #define strneq(s,t,n) (strncmp (s, t, n) == 0) typedef int logical; /* * A `struct linebuffer' is a structure which holds a line of text. * `readline' reads a line from a stream into a linebuffer and works * regardless of the length of the line. */ struct linebuffer { long size; char *buffer; }; extern char *strtok(); long *xmalloc (), *xrealloc (); char *concat (); long readline (); void fatal (); /* * xnew -- allocate storage. SYNOPSIS: Type *xnew (int n, Type); */ #define xnew(n, Type) ((Type *) xmalloc ((n) * sizeof (Type))) char *progname; main (argc, argv) int argc; char **argv; { logical labels_saved, printing, header; time_t ltoday; char *labels, *p, *today; struct linebuffer data; #ifdef MSDOS _fmode = O_BINARY; /* all of files are treated as binary files */ (stdout)->_flag &= ~_IOTEXT; (stdin)->_flag &= ~_IOTEXT; #endif if (argc != 1) { fprintf (stderr, "Usage: %s unixmailbox\n", progname); exit (GOOD); } labels_saved = printing = header = FALSE; progname = argv[0]; ltoday = time (0); today = ctime (<oday); data.size = 200; data.buffer = xnew (200, char); if (readline (&data, stdin) == 0 || !strneq (data.buffer, "BABYL OPTIONS:", 14)) fatal ("standard input is not a Babyl mailfile."); while (readline (&data, stdin) > 0) { if (streq (data.buffer, "*** EOOH ***") && !printing) { printing = header = TRUE; printf ("From Babyl to mail by %s %s", progname, today); continue; } if (data.buffer[0] == '\037') { if (data.buffer[1] == '\0') continue; else if (data.buffer[1] == '\f') { /* Save labels. */ readline (&data, stdin); p = strtok (data.buffer, " ,\r\n\t"); labels = "X-Babyl-Labels: "; while (p = strtok (NULL, " ,\r\n\t")) labels = concat (labels, p, ", "); p = &labels[strlen (labels) - 2]; if (*p == ',') *p = '\0'; printing = header = FALSE; labels_saved = TRUE; continue; } } if ((data.buffer[0] == '\0') && header) { header = FALSE; if (labels_saved) puts (labels); } if (printing) puts (data.buffer); } } /* * Return a newly-allocated string whose contents * concatenate those of s1, s2, s3. */ char * concat (s1, s2, s3) char *s1, *s2, *s3; { int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3); char *result = xnew (len1 + len2 + len3 + 1, char); strcpy (result, s1); strcpy (result + len1, s2); strcpy (result + len1 + len2, s3); result[len1 + len2 + len3] = '\0'; return result; } /* * Read a line of text from `stream' into `linebuffer'. * Return the number of characters read from `stream', * which is the length of the line including the newline, if any. */ long readline (linebuffer, stream) struct linebuffer *linebuffer; register FILE *stream; { char *buffer = linebuffer->buffer; register char *p = linebuffer->buffer; register char *pend; int chars_deleted; pend = p + linebuffer->size; /* Separate to avoid 386/IX compiler bug. */ while (1) { register int c = getc (stream); if (p == pend) { linebuffer->size *= 2; buffer = (char *) xrealloc (buffer, linebuffer->size); p += buffer - linebuffer->buffer; pend = buffer + linebuffer->size; linebuffer->buffer = buffer; } if (c == EOF) { chars_deleted = 0; break; } if (c == '\n') { if (p[-1] == '\r' && p > buffer) { *--p = '\0'; chars_deleted = 2; } else { *p = '\0'; chars_deleted = 1; } break; } *p++ = c; } return (p - buffer + chars_deleted); } /* * Like malloc but get fatal error if memory is exhausted. */ long * xmalloc (size) unsigned int size; { long *result = (long *) malloc (size); if (result == NULL) fatal ("virtual memory exhausted"); return result; } long * xrealloc (ptr, size) char *ptr; unsigned int size; { long *result = (long *) realloc (ptr, size); if (result == NULL) fatal ("virtual memory exhausted"); return result; } void fatal (message) { fprintf (stderr, "%s: %s\n", progname, message); exit (BAD); } emacs-19.30/lib-src/cvtmail.c100444 75424 13 7164 5743256574 14227 0ustar kwzhuser/* Copyright (C) 1985, 1994 Free Software Foundation 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. */ /* cvtmail: * Program to convert oldstyle goslings emacs mail directories into * gnu-rmail format. Program expects a directory called Messages to * exist in your home directory, containing individual mail messages in * separate files in the standard gosling emacs mail reader format. * * Program takes one argument: an output file. This file will contain * all the messages in Messages directory, in berkeley mail format. * If no output file is mentioned, messages are put in ~/OMAIL. * * In order to get rmail to read the messages, the resulting file must * be mv'ed to ~/mbox, and then have rmail invoked on them. * * Author: Larry Kolodney, 1985 */ #include char *malloc (); char *realloc (); char *getenv (); char *xmalloc (); char *xrealloc (); void skip_to_lf (); void sysfail (); int main (argc, argv) int argc; char *argv[]; { char *hd; char *md; char *mdd; char *mfile; char *cf; int cflen; FILE *mddf; FILE *mfilef; FILE *cff; char pre[10]; char name[14]; int c; hd = (char *) getenv ("HOME"); md = (char *) xmalloc (strlen (hd) + 10); strcpy (md, hd); strcat (md, "/Messages"); mdd = (char *) xmalloc (strlen (md) + 11); strcpy (mdd, md); strcat (mdd, "/Directory"); cflen = 100; cf = (char *) xmalloc (cflen); mddf = fopen (mdd, "r"); if (!mddf) sysfail (mdd); if (argc > 1) mfile = argv[1]; else { mfile = (char *) xmalloc (strlen (hd) + 7); strcpy (mfile, hd); strcat (mfile, "/OMAIL"); } mfilef = fopen (mfile, "w"); if (!mfilef) sysfail (mfile); skip_to_lf (mddf); while (fscanf (mddf, "%4c%14[0123456789]", pre, name) != EOF) { if (cflen < strlen (md) + strlen (name) + 2) { cflen = strlen (md) + strlen (name) + 2; cf = (char *) xrealloc (cf, cflen); } strcpy (cf, md); strcat (cf,"/"); strcat (cf, name); cff = fopen (cf, "r"); if (!cff) perror (cf); else { while ((c = getc(cff)) != EOF) putc (c, mfilef); putc ('\n', mfilef); skip_to_lf (mddf); fclose (cff); } } fclose (mddf); fclose (mfilef); return 0; } void skip_to_lf (stream) FILE *stream; { register int c; while ((c = getc(stream)) != EOF && c != '\n') ; } void error (s1, s2) char *s1, *s2; { fprintf (stderr, "cvtmail: "); fprintf (stderr, s1, s2); fprintf (stderr, "\n"); } /* Print error message and exit. */ void fatal (s1, s2) char *s1, *s2; { error (s1, s2); exit (1); } void sysfail (s) char *s; { fprintf (stderr, "cvtmail: "); perror (s); exit (1); } char * xmalloc (size) unsigned size; { char *result = malloc (size); if (!result) fatal ("virtual memory exhausted", 0); return result; } char * xrealloc (ptr, size) char *ptr; unsigned size; { char *result = realloc (ptr, size); if (!result) fatal ("virtual memory exhausted"); return result; } emacs-19.30/lib-src/digest-doc.c100444 21570 13 1647 5647043202 14353 0ustar djmuser/* Give this program DOCSTR.mm.nn as standard input and it outputs to standard output a file of nroff output containing the doc strings. See also sorted-doc.c, which produces similar output but in texinfo format and sorted by function/variable name. */ #include int main () { register int ch; register int notfirst = 0; printf (".TL\n"); printf ("Command Summary for GNU Emacs\n"); printf (".AU\nRichard M. Stallman\n"); while ((ch = getchar ()) != EOF) { if (ch == '\037') { if (notfirst) printf ("\n.DE"); else notfirst = 1; printf ("\n.SH\n"); ch = getchar (); printf (ch == 'F' ? "Function " : "Variable "); while ((ch = getchar ()) != '\n') /* Changed this line */ { if (ch != EOF) putchar (ch); else { ungetc (ch, stdin); break; } } printf ("\n.DS L\n"); } else putchar (ch); } return 0; } emacs-19.30/lib-src/emacsclient.c100444 12120 13 17426 5745022556 14670 0ustar rmsuser/* Client process that communicates with GNU Emacs acting as server. Copyright (C) 1986, 1987, 1994 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. */ #define NO_SHORTNAMES #include <../src/config.h> #undef read #undef write #undef open #undef close #undef signal #if !defined (HAVE_SOCKETS) && !defined (HAVE_SYSVIPC) #include main (argc, argv) int argc; char **argv; { fprintf (stderr, "%s: Sorry, the Emacs server is supported only\n", argv[0]); fprintf (stderr, "on systems with Berkeley sockets or System V IPC.\n"); exit (1); } #else /* HAVE_SOCKETS or HAVE_SYSVIPC */ #if defined (HAVE_SOCKETS) && ! defined (NO_SOCKETS_IN_FILE_SYSTEM) /* BSD code is very different from SYSV IPC code */ #include #include #include #include #include #include extern char *strerror (); extern int errno; int main (argc, argv) int argc; char **argv; { char system_name[32]; int s, i; FILE *out; struct sockaddr_un server; char *homedir, *cwd, *str; char string[BUFSIZ]; char *getenv (), *getwd (); char *getcwd (); int geteuid (); if (argc < 2) { fprintf (stderr, "Usage: %s [+linenumber] filename\n", argv[0]); exit (1); } /* * Open up an AF_UNIX socket in this person's home directory */ if ((s = socket (AF_UNIX, SOCK_STREAM, 0)) < 0) { fprintf (stderr, "%s: ", argv[0]); perror ("socket"); exit (1); } server.sun_family = AF_UNIX; #ifndef SERVER_HOME_DIR { struct stat statbfr; gethostname (system_name, sizeof (system_name)); sprintf (server.sun_path, "/tmp/esrv%d-%s", geteuid (), system_name); if (stat (server.sun_path, &statbfr) == -1) { if (errno == ENOENT) fprintf (stderr, "%s: can't find socket; have you started the server?\n", argv[0]); else fprintf (stderr, "%s: can't stat %s: %s\n", argv[0], server.sun_path, strerror (errno)); exit (1); } if (statbfr.st_uid != geteuid ()) { fprintf (stderr, "%s: Invalid socket owner\n", argv[0]); exit (1); } } #else if ((homedir = getenv ("HOME")) == NULL) { fprintf (stderr, "%s: No home directory\n", argv[0]); exit (1); } strcpy (server.sun_path, homedir); strcat (server.sun_path, "/.emacs-server-"); gethostname (system_name, sizeof (system_name)); strcat (server.sun_path, system_name); #endif if (connect (s, (struct sockaddr *) &server, strlen (server.sun_path) + 2) < 0) { fprintf (stderr, "%s: ", argv[0]); perror ("connect"); exit (1); } if ((out = fdopen (s, "r+")) == NULL) { fprintf (stderr, "%s: ", argv[0]); perror ("fdopen"); exit (1); } #ifdef BSD cwd = getwd (string); #else cwd = getcwd (string, sizeof string); #endif if (cwd == 0) { /* getwd puts message in STRING if it fails. */ fprintf (stderr, "%s: %s (%s)\n", argv[0], string, strerror (errno)); exit (1); } for (i = 1; i < argc; i++) { if (*argv[i] == '+') { char *p = argv[i] + 1; while (*p >= '0' && *p <= '9') p++; if (*p != 0) fprintf (out, "%s/", cwd); } else if (*argv[i] != '/') fprintf (out, "%s/", cwd); fprintf (out, "%s ", argv[i]); } fprintf (out, "\n"); fflush (out); printf ("Waiting for Emacs..."); fflush (stdout); rewind (out); /* re-read the output */ str = fgets (string, BUFSIZ, out); /* Now, wait for an answer and print any messages. */ while (str = fgets (string, BUFSIZ, out)) printf ("%s", str); return 0; } #else /* This is the SYSV IPC section */ #include #include #include #include #include char *getwd (), *getcwd (), *getenv (); struct utsname system_name; main (argc, argv) int argc; char **argv; { int s; key_t key; /* Size of text allocated in MSGP. */ int size_allocated = BUFSIZ; /* Amount of text used in MSGP. */ int used; struct msgbuf *msgp = (struct msgbuf *) malloc (sizeof (struct msgbuf) + size_allocated); struct msqid_ds * msg_st; char *homedir, buf[BUFSIZ]; char gwdirb[BUFSIZ]; char *cwd; char *temp; char *progname = argv[0]; if (argc < 2) { fprintf (stderr, "Usage: %s [+linenumber] filename\n", argv[0]); exit (1); } /* * Create a message queue using ~/.emacs-server as the path for ftok */ if ((homedir = getenv ("HOME")) == NULL) { fprintf (stderr, "%s: No home directory\n", argv[0]); exit (1); } strcpy (buf, homedir); #ifndef HAVE_LONG_FILE_NAMES /* If file names are short, we can't fit the host name. */ strcat (buf, "/.emacs-server"); #else strcat (buf, "/.emacs-server-"); uname (&system_name); strcat (buf, system_name.nodename); #endif creat (buf, 0600); key = ftok (buf, 1); /* unlikely to be anyone else using it */ s = msgget (key, 0600 | IPC_CREAT); if (s == -1) { fprintf (stderr, "%s: ", argv[0]); perror ("msgget"); exit (1); } /* Determine working dir, so we can prefix it to all the arguments. */ #ifdef BSD temp = getwd (gwdirb); #else temp = getcwd (gwdirb, sizeof gwdirb); #endif cwd = gwdirb; if (temp != 0) { /* On some systems, cwd can look like `@machine/...'; ignore everything before the first slash in such a case. */ while (*cwd && *cwd != '/') cwd++; strcat (cwd, "/"); } else { fprintf (stderr, "%s: %s\n", argv[0], cwd); exit (1); } msgp->mtext[0] = 0; used = 0; argc--; argv++; while (argc) { int need_cwd = 0; char *modified_arg = argv[0]; if (*modified_arg == '+') { char *p = modified_arg + 1; while (*p >= '0' && *p <= '9') p++; if (*p != 0) need_cwd = 1; } else if (*modified_arg != '/') need_cwd = 1; if (need_cwd) used += strlen (cwd); used += strlen (modified_arg) + 1; while (used + 2 > size_allocated) { size_allocated *= 2; msgp = (struct msgbuf *) realloc (msgp, (sizeof (struct msgbuf) + size_allocated)); } if (need_cwd) strcat (msgp->mtext, cwd); strcat (msgp->mtext, modified_arg); strcat (msgp->mtext, " "); argv++; argc--; } strcat (msgp->mtext, "\n"); #ifdef HPUX /* HPUX has a bug. */ if (strlen (msgp->mtext) >= 512) { fprintf (stderr, "%s: args too long for msgsnd\n", progname); exit (1); } #endif msgp->mtype = 1; if (msgsnd (s, msgp, strlen (msgp->mtext)+1, 0) < 0) { fprintf (stderr, "%s: ", progname); perror ("msgsnd"); exit (1); } /* * Now, wait for an answer */ printf ("Waiting for Emacs..."); fflush (stdout); msgrcv (s, msgp, BUFSIZ, getpid (), 0); /* wait for anything back */ strcpy (buf, msgp->mtext); printf ("\n%s\n", buf); exit (0); } #endif /* HAVE_SYSVIPC */ #endif /* HAVE_SOCKETS or HAVE_SYSVIPC */ #ifndef HAVE_STRERROR char * strerror (errnum) int errnum; { extern char *sys_errlist[]; extern int sys_nerr; if (errnum >= 0 && errnum < sys_nerr) return sys_errlist[errnum]; return (char *) "Unknown error"; } #endif /* ! HAVE_STRERROR */ emacs-19.30/lib-src/emacsserver.c100444 12120 13 24705 5774333410 14712 0ustar rmsuser/* Communication subprocess for GNU Emacs acting as server. Copyright (C) 1986, 1987, 1992, 1994 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. */ /* The GNU Emacs edit server process is run as a subprocess of Emacs under control of the file lisp/server.el. This program accepts communication from client (program emacsclient.c) and passes their commands (consisting of keyboard characters) up to the Emacs which then executes them. */ #define NO_SHORTNAMES #include <../src/config.h> #undef read #undef write #undef open #undef close #undef signal #if !defined (HAVE_SOCKETS) && !defined (HAVE_SYSVIPC) #include main () { fprintf (stderr, "Sorry, the Emacs server is supported only on systems\n"); fprintf (stderr, "with Berkeley sockets or System V IPC.\n"); exit (1); } #else /* HAVE_SOCKETS or HAVE_SYSVIPC */ #if defined (HAVE_SOCKETS) && ! defined (NO_SOCKETS_IN_FILE_SYSTEM) /* BSD code is very different from SYSV IPC code */ #include #include #include #include #include #include #include extern int errno; /* Copied from src/process.c */ #ifdef FD_SET /* We could get this from param.h, but better not to depend on finding that. And better not to risk that it might define other symbols used in this file. */ #ifdef FD_SETSIZE #define MAXDESC FD_SETSIZE #else #define MAXDESC 64 #endif #define SELECT_TYPE fd_set #else /* no FD_SET */ #define MAXDESC 32 #define SELECT_TYPE int /* Define the macros to access a single-int bitmap of descriptors. */ #define FD_SET(n, p) (*(p) |= (1 << (n))) #define FD_CLR(n, p) (*(p) &= ~(1 << (n))) #define FD_ISSET(n, p) (*(p) & (1 << (n))) #define FD_ZERO(p) (*(p) = 0) #endif /* no FD_SET */ main () { char system_name[32]; int s, infd, fromlen; struct sockaddr_un server, fromunix; char *homedir; char *str, string[BUFSIZ], code[BUFSIZ]; FILE *infile; FILE **openfiles; int openfiles_size; #ifndef convex char *getenv (); #endif openfiles_size = 20; openfiles = (FILE **) malloc (openfiles_size * sizeof (FILE *)); if (openfiles == 0) abort (); /* * Open up an AF_UNIX socket in this person's home directory */ if ((s = socket (AF_UNIX, SOCK_STREAM, 0)) < 0) { perror_1 ("socket"); exit (1); } server.sun_family = AF_UNIX; #ifndef SERVER_HOME_DIR gethostname (system_name, sizeof (system_name)); sprintf (server.sun_path, "/tmp/esrv%d-%s", geteuid (), system_name); if (unlink (server.sun_path) == -1 && errno != ENOENT) { perror_1 ("unlink"); exit (1); } #else if ((homedir = getenv ("HOME")) == NULL) fatal_error ("No home directory\n"); strcpy (server.sun_path, homedir); strcat (server.sun_path, "/.emacs-server-"); gethostname (system_name, sizeof (system_name)); strcat (server.sun_path, system_name); /* Delete anyone else's old server. */ unlink (server.sun_path); #endif if (bind (s, (struct sockaddr *) &server, strlen (server.sun_path) + 2) < 0) { perror_1 ("bind"); exit (1); } /* Only this user can send commands to this Emacs. */ chmod (server.sun_path, 0600); /* * Now, just wait for everything to come in.. */ if (listen (s, 5) < 0) { perror_1 ("listen"); exit (1); } /* Disable sigpipes in case luser kills client... */ signal (SIGPIPE, SIG_IGN); for (;;) { SELECT_TYPE rmask; FD_ZERO (&rmask); FD_SET (0, &rmask); FD_SET (s, &rmask); if (select (s + 1, &rmask, 0, 0, 0) < 0) perror_1 ("select"); if (FD_ISSET (s, &rmask)) /* client sends list of filenames */ { fromlen = sizeof (fromunix); fromunix.sun_family = AF_UNIX; infd = accept (s, (struct sockaddr *) &fromunix, &fromlen); if (infd < 0) { if (errno == EMFILE || errno == ENFILE) fprintf (stderr, "Error: too many clients.\n"); else perror_1 ("accept"); continue; } if (infd >= openfiles_size) { openfiles_size *= 2; openfiles = (FILE **) realloc (openfiles, openfiles_size * sizeof (FILE *)); if (openfiles == 0) abort (); } infile = fdopen (infd, "r+"); /* open stream */ if (infile == NULL) { fprintf (stderr, "Error: too many clients.\n"); write (infd, "Too many clients.\n", 18); close (infd); /* Prevent descriptor leak.. */ continue; } str = fgets (string, BUFSIZ, infile); if (str == NULL) { perror_1 ("fgets"); close (infd); /* Prevent descriptor leak.. */ continue; } openfiles[infd] = infile; printf ("Client: %d %s", infd, string); /* If what we read did not end in a newline, it means there is more. Keep reading from the socket and outputting to Emacs, until we get the newline. */ while (string[strlen (string) - 1] != '\n') { if (fgets (string, BUFSIZ, infile) == 0) break; printf ("%s", string); } fflush (stdout); fflush (infile); continue; } else if (FD_ISSET (0, &rmask)) /* emacs sends codeword, fd, and string message */ { /* Read command codeword and fd */ clearerr (stdin); scanf ("%s %d%*c", code, &infd); if (ferror (stdin) || feof (stdin)) fatal_error ("server: error reading from standard input\n"); /* Transfer text from Emacs to the client, up to a newline. */ infile = openfiles[infd]; while (1) { if (fgets (string, BUFSIZ, stdin) == 0) break; fprintf (infile, "%s", string); if (string[strlen (string) - 1] == '\n') break; } fflush (infile); /* If command is close, close connection to client. */ if (strncmp (code, "Close:", 6) == 0) if (infd > 2) { fclose (infile); close (infd); } continue; } } } #else /* This is the SYSV IPC section */ #include #include #include #include #include #include #include struct utsname system_name; #ifndef errno extern int errno; #endif jmp_buf msgenv; SIGTYPE msgcatch () { longjmp (msgenv, 1); } /* "THIS has to be fixed. Remember, stderr may not exist...-rlk." Incorrect. This program runs as an inferior of Emacs. Its stderr always exists--rms. */ #include main () { int s, infd, fromlen, ioproc; key_t key; struct msgbuf * msgp = (struct msgbuf *) malloc (sizeof *msgp + BUFSIZ); struct msqid_ds msg_st; int p; char *homedir, *getenv (); char string[BUFSIZ]; FILE *infile; /* * Create a message queue using ~/.emacs-server as the path for ftok */ if ((homedir = getenv ("HOME")) == NULL) fatal_error ("No home directory\n"); strcpy (string, homedir); #ifndef HAVE_LONG_FILE_NAMES /* If file names are short, we can't fit the host name. */ strcat (string, "/.emacs-server"); #else strcat (string, "/.emacs-server-"); uname (&system_name); strcat (string, system_name.nodename); #endif creat (string, 0600); key = ftok (string, 1); /* unlikely to be anyone else using it */ s = msgget (key, 0600 | IPC_CREAT); if (s == -1) { perror_1 ("msgget"); exit (1); } /* Fork so we can close connection even if parent dies */ p = fork (); if (setjmp (msgenv)) { msgctl (s, IPC_RMID, 0); if (p > 0) kill (p, SIGKILL); exit (0); } signal (SIGTERM, msgcatch); signal (SIGINT, msgcatch); signal (SIGHUP, msgcatch); if (p > 0) { /* This is executed in the original process that did the fork above. */ /* Get pid of Emacs itself. */ p = getppid (); setpgrp (); /* Gnu kills process group on exit */ while (1) { /* Is Emacs still alive? */ if (kill (p, 0) < 0) { msgctl (s, IPC_RMID, 0); exit (0); } sleep (10); } } /* This is executed in the child made by forking above. Call it c1. Make another process, ioproc. */ ioproc = fork (); if (ioproc == 0) { /* In process ioproc, wait for text from Emacs, and send it to the process c1. This way, c1 only has to wait for one source of input. */ while (fgets (msgp->mtext, BUFSIZ, stdin)) { msgp->mtype = 1; msgsnd (s, msgp, strlen (msgp->mtext) + 1, 0); } exit (1); } /* In the process c1, listen for messages from clients and pass them to Emacs. */ while (1) { if ((fromlen = msgrcv (s, msgp, BUFSIZ - 1, 1, 0)) < 0) { #ifdef EINTR if (errno == EINTR) continue; #endif perror_1 ("msgrcv"); exit (1); } else { msgctl (s, IPC_STAT, &msg_st); /* Distinguish whether the message came from a client, or from ioproc. */ if (msg_st.msg_lspid == ioproc) { char code[BUFSIZ]; int inproc; /* Message from ioproc: tell a client we are done. */ msgp->mtext[strlen (msgp->mtext)-1] = 0; sscanf (msgp->mtext, "%s %d", code, &inproc); msgp->mtype = inproc; msgsnd (s, msgp, strlen (msgp->mtext) + 1, 0); continue; } /* This is a request from a client: copy to stdout so that Emacs will get it. Include msg_lspid so server.el can tell us where to send the reply. */ strncpy (string, msgp->mtext, fromlen); string[fromlen] = 0; /* make sure */ /* Newline is part of string.. */ printf ("Client: %d %s", msg_st.msg_lspid, string); fflush (stdout); } } } #endif /* HAVE_SYSVIPC */ #endif /* HAVE_SOCKETS or HAVE_SYSVIPC */ /* This is like perror but puts `Error: ' at the beginning. */ perror_1 (string) char *string; { char *copy = (char *) malloc (strlen (string) + 8); if (copy == 0) fatal_error ("Virtual memory exhausted"); strcpy (copy, "Error: "); strcat (copy, string); perror (copy); } fatal_error (string) char *string; { fprintf (stderr, "%s", "Error: "); fprintf (stderr, string); exit (1); } emacs-19.30/lib-src/emacstool.c100444 21570 13 36400 5534014234 14330 0ustar djmuser/* Copyright (C) 1986, 1988, 1990, 1991 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ /* * For Emacs in SunView/Sun-Windows: (supported by Sun Unix v3.2 or greater) * Insert a notifier filter-function to convert all useful input * to "key" sequences that emacs can understand. See: Emacstool(1). * * Author: Jeff Peck, Sun Microsystems, Inc. * * Original Idea: Ian Batten * Updated 15-Mar-88, Jeff Peck: set IN_EMACSTOOL, TERM, TERMCAP * Updated 10-Sep-88, Jeff Peck: add XVIEW and JLE support * Updated 8-Oct-90, Jeff Peck: add Meta-bit for Xview * Updated 6-Mar-91, Jeff Peck: Hack to detect -Wt invocation * [note, TTYSW limitation means you must Click-To-Type in Openwin] * [fixed in OW3 or use local/tty.o] * for better results, this should move to using TERMSW. * Updated 10-Mar-91, Jeff Peck, et al: support for TERMSW (TTERM) * allows point-to-type even in OW2 * * [note: xvetool should be started with the "-nw" flag for emacs!] */ #ifdef XVIEW #include #include #include #include #include /* private defines */ #include /* -DTTERM */ #include /* for testing */ #else #include #include #include #endif XVIEW #ifdef JLE # include #endif JLE #include #include #define BUFFER_SIZE 128 /* Size of all the buffers */ /* define WANT_CAPS_LOCK to make f-key T1 (aka F1) behave as CapsLock */ #define WANT_CAPS_LOCK #ifdef WANT_CAPS_LOCK int caps_lock; /* toggle indicator for f-key T1 caps lock */ static char *Caps = "[CAPS] "; /* Caps Lock prefix string */ #define CAPS_LEN 7 /* strlen (Caps) */ #endif static char *mouse_prefix = "\030\000"; /* C-x C-@ */ static int m_prefix_length = 2; /* mouse_prefix length */ static char *key_prefix = "\030*"; /* C-x * */ static int k_prefix_length = 2; /* key_prefix length */ #ifdef JLE static char *emacs_name = "nemacs"; /* default run command */ static char *title = "NEmacstool - "; /* initial title */ #else static char *emacs_name = "emacs"; /* default run command */ static char *title = "Emacstool - "; /* initial title */ #endif JLE static char buffer[BUFFER_SIZE]; /* send to ttysw_input */ static char *bold_name = 0; /* for -bold option */ Frame frame; /* Base frame for system */ #ifndef TTERM #define SWTYPE TTY Tty tty_win; /* Where emacs is reading */ #else #define SWTYPE TERMSW Termsw tty_win; /* Termsw does follow-mouse */ #endif TTERM #ifdef XVIEW Xv_Window tty_view; /* Where the events are in Xview*/ #else Tty tty_view; /* SunView place filler */ #endif XVIEW int font_width, font_height; /* For translating pixels to chars */ int left_margin = 0; /* default window -- frame offset */ int console_fd = 0; /* for debugging: setenv DEBUGEMACSTOOL */ FILE *console; /* for debugging: setenv DEBUGEMACSTOOL */ Icon frame_icon; /* make an icon_image for the default frame_icon */ static short default_image[258] = { #include }; mpr_static(icon_image, 64, 64, 1, default_image); /* * Assign a value to a set of keys */ int button_value (event) Event *event; { int retval = 0; /* * Code up the current situation: * * 1 = MS_LEFT; * 2 = MS_MIDDLE; * 4 = MS_RIGHT; * 8 = SHIFT; * 16 = CONTROL; * 32 = META; * 64 = DOUBLE; * 128 = UP; */ if (MS_LEFT == (event_id (event))) retval = 1; if (MS_MIDDLE == (event_id (event))) retval = 2; if (MS_RIGHT == (event_id (event))) retval = 4; if (event_shift_is_down (event)) retval += 8; if (event_ctrl_is_down (event)) retval += 16; if (event_meta_is_down (event)) retval += 32; if (event_is_up (event)) retval += 128; return retval; } /* * Variables to store the time of the previous mouse event that was * sent to emacs. * * The theory is that to time double clicks while ignoreing UP buttons, * we must keep track of the accumulated time. * * If someone writes a SUN-SET-INPUT-MASK for emacstool, * That could be used to selectively disable UP events, * and then this cruft wouldn't be necessary. */ static long prev_event_sec = 0; static long prev_event_usec = 0; /* * Give the time difference in milliseconds, where one second * is considered infinite. */ int time_delta (now_sec, now_usec, prev_sec, prev_usec) long now_sec, now_usec, prev_sec, prev_usec; { long sec_delta = now_sec - prev_sec; long usec_delta = now_usec - prev_usec; if (usec_delta < 0) { /* "borrow" a second */ usec_delta += 1000000; --sec_delta; } if (sec_delta >= 10) return (9999); /* Infinity */ else return ((sec_delta * 1000) + (usec_delta / 1000)); } /* * Filter function to translate selected input events for emacs * Mouse button events become ^X^@(button x-col y-line time-delta) . * Function keys: ESC-*{c}{lrt} l,r,t for Left, Right, Top; * {c} encodes the keynumber as a character [a-o] */ static Notify_value input_event_filter_function (window, event, arg, type) #ifdef XVIEW Xv_Window window; #else Window window; #endif XVIEW Event *event; Notify_arg arg; Notify_event_type type; { struct timeval time_stamp; if (console_fd) fprintf(console, "Event: %d\n", event_id(event)); /* UP L1 is the STOP key */ if (event_id(event) == WIN_STOP) { ttysw_input(tty_win, "\007\007\007\007\007\007\007", 7); return NOTIFY_IGNORED; } /* UP L5 & L7 is Expose & Open, let them pass to sunview */ if (event_id(event) == KEY_LEFT(5) || event_id(event) == KEY_LEFT(7)) if(event_is_up (event)) return notify_next_event_func (window, event, arg, type); else return NOTIFY_IGNORED; if (event_is_button (event)) { /* do Mouse Button events */ /* Commented out so that we send mouse up events too. if (event_is_up (event)) return notify_next_event_func (window, event, arg, type); */ time_stamp = event_time (event); ttysw_input (tty_win, mouse_prefix, m_prefix_length); sprintf (buffer, "(%d %d %d %d)\015", button_value (event), (event_x (event) - left_margin) / font_width, event_y (event) / font_height, time_delta (time_stamp.tv_sec, time_stamp.tv_usec, prev_event_sec, prev_event_usec) ); ttysw_input (tty_win, buffer, strlen(buffer)); prev_event_sec = time_stamp.tv_sec; prev_event_usec = time_stamp.tv_usec; return NOTIFY_IGNORED; } { /* Do the function key events */ int d; char c = (char) 0; if ((event_is_key_left (event)) ? ((d = event_id(event) - KEY_LEFT(1) + 'a'), c='l') : ((event_is_key_right (event)) ? ((d = event_id(event) - KEY_RIGHT(1) + 'a'), c='r') : ((event_is_key_top (event)) ? ((d = event_id(event) - KEY_TOP(1) + 'a'), c='t') : 0))) { if (event_is_up(event)) return NOTIFY_IGNORED; if (event_shift_is_down (event)) c = c - 32; /* this will give a non-{lrt} for unshifted keys */ if (event_ctrl_is_down (event)) c = c - 64; if (event_meta_is_down (event)) c = c + 128; #ifdef WANT_CAPS_LOCK /* set a toggle and relabel window so T1 can act like caps-lock */ if (event_id(event) == KEY_TOP(1)) { /* make a frame label with and without CAPS */ strcpy (buffer, Caps); title = &buffer[CAPS_LEN]; strncpy (title, (char *)window_get (frame, FRAME_LABEL), BUFFER_SIZE - CAPS_LEN); buffer[BUFFER_SIZE] = (char) 0; if (strncmp (title, Caps, CAPS_LEN) == 0) title += CAPS_LEN; /* already Caps */ caps_lock = (caps_lock ? 0 : CAPS_LEN); window_set(frame, FRAME_LABEL, (title -= caps_lock), 0); return NOTIFY_IGNORED; } #endif ttysw_input (tty_win, key_prefix, k_prefix_length); sprintf (buffer, "%c%c", d, c); ttysw_input(tty_win, buffer, strlen(buffer)); return NOTIFY_IGNORED; } } if ((event_is_ascii(event) || event_is_meta(event)) && event_is_up(event)) return NOTIFY_IGNORED; #ifdef WANT_CAPS_LOCK /* shift alpha chars to upper case if toggle is set */ if ((caps_lock) && event_is_ascii(event) && (event_id(event) >= 'a') && (event_id(event) <= 'z')) event_set_id(event, (event_id(event) - 32)); /* crufty, but it works for now. is there an UPCASE(event)? */ #endif #ifndef NO_META_BIT /* under Openwindows/X, the meta bit is not set in the key event, * emacs expects this so we add it in here: */ if (event_is_ascii(event) && event_meta_is_down(event)) event_set_id(event, 128 | event_id(event)); #endif return notify_next_event_func (window, event, arg, type); } main (argc, argv) int argc; char **argv; { int error_code; /* Error codes */ #ifdef JLE setlocale(LC_ALL, ""); #endif JLE if(getenv("DEBUGEMACSTOOL")) console = fdopen (console_fd = open("/dev/console",O_WRONLY), "w"); putenv("IN_EMACSTOOL=t"); /* notify subprocess that it is in emacstool */ if (putenv("TERM=sun") != 0) /* TTY_WIN will be a TERM=sun window */ {fprintf (stderr, "%s: Could not set TERM=sun, using `%s'\n", argv[0], (char *)getenv("TERM")) ;}; /* * If TERMCAP starts with a slash, it is the pathname of the * termcap file, not an entry extracted from it, so KEEP it! * Otherwise, it may not relate to the new TERM, so Nuke-It. * If there is no TERMCAP environment variable, don't make one. */ { char *termcap ; /* Current TERMCAP value */ termcap = (char *)getenv("TERMCAP") ; if (termcap && (*termcap != '/')) { if (putenv("TERMCAP=") != 0) {fprintf (stderr, "%s: Could not clear TERMCAP\n", argv[0]) ;} ; } ; } ; /* find command to run as subprocess in window */ if (!(argv[0] = (char *)getenv("EMACSTOOL"))) /* Set emacs command name */ argv[0] = emacs_name; /* Emacstool recognizes two special args: -rc and -bold */ for (argc = 1; argv[argc]; argc++) /* Use last one on line */ { if(!(strcmp ("-rc", argv[argc]))) /* Override if -rc given */ {int i = argc; argv[argc--]=0; /* kill the -rc argument */ if (argv[i+1]) { /* move to argv[0] and squeeze the rest */ argv[0]=argv[i+1]; for (; argv[i+2]; (argv[i]=argv[i+2],argv[++i]=0)); } } if (!(strcmp ("-bold", argv[argc]))) {int i = argc; argv[argc--]=0; /* kill the -bold argument */ if (argv[i+1]) { /* move to bold_name and squeeze the rest */ bold_name = argv[i+1]; for (; argv[i+2]; (argv[i]=argv[i+2],argv[++i]=0)); } } }; strcpy (buffer, title); strncat (buffer, argv[0], /* append run command name */ (BUFFER_SIZE - (strlen (buffer)) - (strlen (argv[0]))) - 1); error_code = interpose_on_window(argc,argv); if (error_code != 0) { /* Barf */ fprintf (stderr, "notify_interpose_event_func returns %d.\n", error_code); exit (1); } #ifdef XVIEW xv_main_loop (frame); /* And away we go */ #else window_main_loop (frame); #endif XVIEW } #ifdef XVIEW int interpose_on_window(argc,argv) int argc; char **argv; { #ifndef TTERM int i, font_width_adjust = 1; /* hackery, and hueristics */ /* if -Wt is not supplied, then font comes out as lucida-14 (width=8) * rather than the screen.r.12 (width=7) typically used * this hack attempts to workaround it. * could use a env var EMACSTOOL_DEFAULT_FONT_WIDTH instead */ for (i = 1; argv[i]; i++) { if (!(strcmp ("-Wt", argv[i]))) {font_width_adjust = 0; if (console_fd) fprintf(console, "-Wt = %d\n", font_width_adjust); break;} } #endif TTERM /* initialize Xview, and strip window args */ xv_init(XV_INIT_ARGC_PTR_ARGV, &argc, argv, 0); /* do this first, so arglist can override it */ frame_icon = icon_create (ICON_LABEL, "Emacstool", ICON_IMAGE, &icon_image, 0); /* Build a frame to run in */ frame = xv_create ((Xv_Window)NULL, FRAME, FRAME_LABEL, buffer, FRAME_ICON, frame_icon, 0); /* Create a tty with emacs in it */ tty_win = xv_create (frame, SWTYPE, WIN_IS_CLIENT_PANE, TTY_QUIT_ON_CHILD_DEATH, TRUE, TTY_BOLDSTYLE, TTYSW_BOLD_INVERT, TTY_ARGV, argv, 0); if (bold_name) { (void)xv_set(tty_win, TTY_BOLDSTYLE_NAME, bold_name, 0); } { Xv_font font; /* declare temp font variable */ font = (Xv_font)xv_get (tty_win, XV_FONT); font_height = (int)xv_get (font, FONT_DEFAULT_CHAR_HEIGHT); font_width = (int)xv_get (font, FONT_DEFAULT_CHAR_WIDTH); } if (console_fd) fprintf(console, "Width = %d\n", font_width); #ifndef TTERM font_width -= font_width_adjust; /* A guess! font bug in ttysw*/ #else /* make the termsw act as a tty */ xv_set(tty_win, TERMSW_MODE, TTYSW_MODE_TYPE, 0); /* termsw has variable offset depending on scrollbar size/location */ left_margin = (int)xv_get (tty_win, TEXTSW_LEFT_MARGIN); #endif TTERM tty_view = (Xv_Window) xv_get (tty_win, OPENWIN_NTH_VIEW, 0); xv_set(tty_view, WIN_CONSUME_EVENTS, WIN_MOUSE_BUTTONS, WIN_UP_EVENTS, ACTION_ADJUST, ACTION_MENU, WIN_ASCII_EVENTS, WIN_LEFT_KEYS, WIN_TOP_KEYS, WIN_RIGHT_KEYS, 0, 0); /* Interpose my event function */ return (int) notify_interpose_event_func (tty_view, input_event_filter_function, NOTIFY_SAFE); } #else int interpose_on_window (argc, argv) int argc; char **argv; { /* do this first, so arglist can override it */ frame_icon = icon_create (ICON_LABEL, "Emacstool", ICON_IMAGE, &icon_image, 0); /* Build a frame to run in */ frame = window_create ((Window)NULL, FRAME, FRAME_LABEL, buffer, FRAME_ICON, frame_icon, FRAME_ARGC_PTR_ARGV, &argc, argv, 0); /* Create a tty with emacs in it */ tty_win = window_create (frame, TTY, TTY_QUIT_ON_CHILD_DEATH, TRUE, TTY_BOLDSTYLE, TTYSW_BOLD_INVERT, TTY_ARGV, argv, 0); if (bold_name) { (void)window_set(tty_win, TTY_BOLDSTYLE_NAME, bold_name, 0); } /* ttysw uses pf_default, one must set WIN_FONT explicitly */ window_set (tty_win, WIN_FONT, pf_default(), 0); font_height = (int)window_get (tty_win, WIN_ROW_HEIGHT); font_width = (int)window_get (tty_win, WIN_COLUMN_WIDTH); tty_view = tty_win; window_set(tty_view, WIN_CONSUME_PICK_EVENTS, WIN_STOP, WIN_MOUSE_BUTTONS, WIN_UP_EVENTS, /* LOC_WINENTER, LOC_WINEXIT, LOC_MOVE, */ 0, WIN_CONSUME_KBD_EVENTS, WIN_STOP, WIN_ASCII_EVENTS, WIN_LEFT_KEYS, WIN_TOP_KEYS, WIN_RIGHT_KEYS, /* WIN_UP_ASCII_EVENTS, */ 0, 0); /* Interpose my event function */ return (int) notify_interpose_event_func (tty_view, input_event_filter_function, NOTIFY_SAFE); } #endif XVIEW emacs-19.30/lib-src/etags.c100444 22035 13 261474 6047437534 13541 0ustar potuser/* Tags file maker to go with GNU Emacs Copyright (C) 1984, 87, 88, 89, 93, 94, 95 Free Software Foundation, Inc. and Ken Arnold This file is not considered part of GNU Emacs. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ /* * Authors: * Ctags originally by Ken Arnold. * Fortran added by Jim Kleckner. * Ed Pelegri-Llopart added C typedefs. * Gnu Emacs TAGS format and modifications by RMS? * Sam Kendall added C++. * Francesco Potorti` reorganised C and C++ based on work by Joe Wells. #ifdef ETAGS_REGEXPS * Regexp tags by Tom Tromey. #endif * * Francesco Potorti` (pot@cnuce.cnr.it) is the current maintainer. */ char pot_etags_version[] = "@(#) pot revision number is 11.45"; #define TRUE 1 #define FALSE 0 #ifndef DEBUG # define DEBUG FALSE #endif #ifdef MSDOS #include #include #endif /* MSDOS */ #ifdef WINDOWSNT #include #include #include #define MAXPATHLEN _MAX_PATH #endif #ifdef HAVE_CONFIG_H #include /* On some systems, Emacs defines static as nothing for the sake of unexec. We don't want that here since we don't use unexec. */ #undef static #endif #include #include #include #ifndef errno extern int errno; #endif #include #include #if !defined (S_ISREG) && defined (S_IFREG) # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) #endif #include #ifdef ETAGS_REGEXPS #include #endif /* ETAGS_REGEXPS */ /* Define CTAGS to make the program "ctags" compatible with the usual one. Let it undefined to make the program "etags", which makes emacs-style tag tables and tags typedefs, #defines and struct/union/enum by default. */ #ifdef CTAGS # undef CTAGS # define CTAGS TRUE #else # define CTAGS FALSE #endif /* Exit codes for success and failure. */ #ifdef VMS #define GOOD 1 #define BAD 0 #else #define GOOD 0 #define BAD 1 #endif /* C extensions. */ #define C_PLPL 0x00001 /* C++ */ #define C_STAR 0x00003 /* C* */ #define YACC 0x10000 /* yacc file */ #define streq(s,t) (strcmp (s, t) == 0) #define strneq(s,t,n) (strncmp (s, t, n) == 0) #define lowcase(c) tolower ((unsigned char)c) #define iswhite(arg) (_wht[arg]) /* T if char is white */ #define begtoken(arg) (_btk[arg]) /* T if char can start token */ #define intoken(arg) (_itk[arg]) /* T if char can be in token */ #define endtoken(arg) (_etk[arg]) /* T if char ends tokens */ #ifdef DOS_NT # define absolutefn(fn) (fn[0] == '/' || (isalpha (fn[0]) && fn[1] == ':')) #else # define absolutefn(fn) (fn[0] == '/') #endif /* * xnew -- allocate storage * * SYNOPSIS: Type *xnew (int n, Type); */ #define xnew(n,Type) ((Type *) xmalloc ((n) * sizeof (Type))) typedef int logical; typedef struct nd_st { /* sorting structure */ char *name; /* function or type name */ char *file; /* file name */ logical is_func; /* use pattern or line no */ logical been_warned; /* set if noticed dup */ int lno; /* line number tag is on */ long cno; /* character number line starts on */ char *pat; /* search pattern */ struct nd_st *left, *right; /* left and right sons */ } NODE; extern char *getenv (); char *concat (); char *savenstr (), *savestr (); char *etags_strchr (), *etags_strrchr (); char *etags_getcwd (); char *relative_filename (), *absolute_filename (), *absolute_dirname (); long *xmalloc (), *xrealloc (); typedef void Lang_function (); #if FALSE /* many compilers barf on this */ Lang_function Asm_labels; Lang_function default_C_entries; Lang_function C_entries; Lang_function Cplusplus_entries; Lang_function Cstar_entries; Lang_function Fortran_functions; Lang_function Yacc_entries; Lang_function Lisp_functions; Lang_function Pascal_functions; Lang_function Perl_functions; Lang_function Prolog_functions; Lang_function Scheme_functions; Lang_function TeX_functions; Lang_function just_read_file; #else /* so let's write it this way */ void Asm_labels (); void C_entries (); void default_C_entries (); void plain_C_entries (); void Cplusplus_entries (); void Cstar_entries (); void Fortran_functions (); void Yacc_entries (); void Lisp_functions (); void Pascal_functions (); void Perl_functions (); void Prolog_functions (); void Scheme_functions (); void TeX_functions (); void just_read_file (); #endif Lang_function *get_language_from_name (); Lang_function *get_language_from_interpreter (); Lang_function *get_language_from_suffix (); int total_size_of_entries (); long readline (); long readline_internal (); #ifdef ETAGS_REGEXPS void add_regex (); #endif void add_node (); void error (); void fatal (), pfatal (); void find_entries (); void free_tree (); void getit (); void init (); void initbuffer (); void pfnote (); void process_file (); void put_entries (); void takeprec (); char searchar = '/'; /* use /.../ searches */ int lineno; /* line number of current line */ long charno; /* current character number */ long linecharno; /* charno of start of line; not used by C, but by every other language. */ char *curfile; /* current input file name */ char *tagfile; /* output file */ char *progname; /* name this program was invoked with */ char *cwd; /* current working directory */ char *tagfiledir; /* directory of tagfile */ FILE *tagf; /* ioptr for tags file */ NODE *head; /* the head of the binary tree of tags */ /* * A `struct linebuffer' is a structure which holds a line of text. * `readline' reads a line from a stream into a linebuffer and works * regardless of the length of the line. */ struct linebuffer { long size; char *buffer; }; struct linebuffer lb; /* the current line */ struct linebuffer token_name; /* used by C_entries as temporary area */ struct { long linepos; struct linebuffer lb; /* used by C_entries instead of lb */ } lbs[2]; /* boolean "functions" (see init) */ logical _wht[0177], _etk[0177], _itk[0177], _btk[0177]; char *white = " \f\t\n\013", /* white chars */ *endtk = " \t\n\013\"'#()[]{}=-+%*/&|^~!<>;,.:?", /* token ending chars */ /* token starting chars */ *begtk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz$~", /* valid in-token chars */ *intk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz$0123456789"; logical append_to_tagfile; /* -a: append to tags */ /* The following three default to TRUE for etags, but to FALSE for ctags. */ logical typedefs; /* -t: create tags for typedefs */ logical typedefs_and_cplusplus; /* -T: create tags for typedefs, level */ /* 0 struct/enum/union decls, and C++ */ /* member functions. */ logical constantypedefs; /* -d: create tags for C #define and enum */ /* constants. Enum consts not implemented. */ /* -D: opposite of -d. Default under ctags. */ logical update; /* -u: update tags */ logical vgrind_style; /* -v: create vgrind style index output */ logical no_warnings; /* -w: suppress warnings */ logical cxref_style; /* -x: create cxref style output */ logical cplusplus; /* .[hc] means C++, not C */ logical noindentypedefs; /* -I: ignore indentation in C */ struct option longopts[] = { { "append", no_argument, NULL, 'a' }, { "backward-search", no_argument, NULL, 'B' }, { "c++", no_argument, NULL, 'C' }, { "cxref", no_argument, NULL, 'x' }, { "defines", no_argument, NULL, 'd' }, { "help", no_argument, NULL, 'h' }, { "help", no_argument, NULL, 'H' }, { "ignore-indentation", no_argument, NULL, 'I' }, { "include", required_argument, NULL, 'i' }, { "language", required_argument, NULL, 'l' }, { "no-defines", no_argument, NULL, 'D' }, { "no-regex", no_argument, NULL, 'R' }, { "no-warn", no_argument, NULL, 'w' }, { "output", required_argument, NULL, 'o' }, { "regex", required_argument, NULL, 'r' }, { "typedefs", no_argument, NULL, 't' }, { "typedefs-and-c++", no_argument, NULL, 'T' }, { "update", no_argument, NULL, 'u' }, { "version", no_argument, NULL, 'V' }, { "vgrind", no_argument, NULL, 'v' }, { 0 } }; #ifdef ETAGS_REGEXPS /* Structure defining a regular expression. Elements are the compiled pattern, and the name string. */ struct pattern { struct re_pattern_buffer *pattern; struct re_registers regs; char *name_pattern; logical error_signaled; }; /* Number of regexps found. */ int num_patterns = 0; /* Array of all regexps. */ struct pattern *patterns = NULL; #endif /* ETAGS_REGEXPS */ /* * Language stuff. */ /* Non-NULL if language fixed. */ Lang_function *lang_func = NULL; /* Assembly code */ char *Asm_suffixes [] = { "a", /* Unix assembler */ "asm", /* Microcontroller assembly */ "def", /* BSO/Tasking definition includes */ "inc", /* Microcontroller include files */ "ins", /* Microcontroller include files */ "s", "sa", /* Unix assembler */ "src", /* BSO/Tasking C compiler output */ NULL }; /* Note that .c and .h can be considered C++, if the --c++ flag was given. That is why default_C_entries is called here. */ char *default_C_suffixes [] = { "c", "h", NULL }; /* C++ file */ char *Cplusplus_suffixes [] = { "C", "H", "c++", "cc", "cpp", "cxx", "h++", "hh", "hpp", "hxx", NULL }; /* C* file */ char *Cstar_suffixes [] = { "cs", "hs", NULL }; /* Fortran */ char *Fortran_suffixes [] = { "F", "f", "f90", "for", NULL }; /* Lisp source code */ char *Lisp_suffixes [] = { "cl", "clisp", "el", "l", "lisp", "lsp", "ml", NULL }; /* Pascal file */ char *Pascal_suffixes [] = { "p", "pas", NULL }; /* Perl file */ char *Perl_suffixes [] = { "pl", "pm", NULL }; char *Perl_interpreters [] = { "perl", NULL }; /* Pro*C file. */ char *plain_C_suffixes [] = { "pc", NULL }; /* Prolog source code */ char *Prolog_suffixes [] = { "prolog", NULL }; /* Scheme source code */ /* FIXME Can't do the `SCM' or `scm' prefix with a version number */ char *Scheme_suffixes [] = { "SCM", "SM", "oak", "sch", "scheme", "scm", "sm", "t", NULL }; /* TeX/LaTeX source code */ char *TeX_suffixes [] = { "bib", "clo", "cls", "ltx", "sty", "TeX", "tex", NULL }; /* Yacc file */ char *Yacc_suffixes [] = { "y", NULL }; /* Table of language names and corresponding functions, file suffixes and interpreter names. It is ok for a given function to be listed under more than one name. I just didn't. */ struct lang_entry { char *name; Lang_function *function; char **suffixes; char **interpreters; }; struct lang_entry lang_names [] = { { "asm", Asm_labels, Asm_suffixes }, { "c", default_C_entries, default_C_suffixes }, { "c++", Cplusplus_entries, Cplusplus_suffixes }, { "c*", Cstar_entries, Cstar_suffixes }, { "fortran", Fortran_functions, Fortran_suffixes }, { "lisp", Lisp_functions, Lisp_suffixes }, { "pascal", Pascal_functions, Pascal_suffixes }, { "perl", Perl_functions, Perl_suffixes, Perl_interpreters }, { "proc", plain_C_entries, plain_C_suffixes }, { "prolog", Prolog_functions, Prolog_suffixes }, { "scheme" , Scheme_functions, Scheme_suffixes }, { "tex", TeX_functions, TeX_suffixes }, { "yacc", Yacc_entries, Yacc_suffixes }, { "auto", NULL }, /* default guessing scheme */ { "none", just_read_file }, /* regexp matching only */ { NULL, NULL } /* end of list */ }; void print_language_names () { struct lang_entry *lang; char **ext; puts ("\nThese are the currently supported languages, along with the\n\ default file name suffixes:"); for (lang = lang_names; lang->name != NULL; lang++) { printf ("\t%s\t", lang->name); if (lang->suffixes != NULL) for (ext = lang->suffixes; *ext != NULL; ext++) printf (" .%s", *ext); puts (""); } puts ("Where `auto' means use default language for files based on file\n\ name suffix, and `none' means only do regexp processing on files.\n\ If no language is specified and no matching suffix is found,\n\ the first line of the file is read for a sharp-bang (#!) sequence\n\ followed by the name of an interpreter. If no such sequence is found,\n\ Fortran is tried first; if no tags are found, C is tried next."); } #ifndef VERSION # define VERSION "19" #endif void print_version () { printf ("%s for Emacs version %s\n", (CTAGS) ? "ctags" : "etags", VERSION); exit (GOOD); } void print_help () { printf ("These are the options accepted by %s. You may use unambiguous\n\ abbreviations for the long option names. A - as file name means read\n\ names from stdin.\n\n", progname); puts ("-a, --append\n\ Append tag entries to existing tags file."); if (CTAGS) puts ("-B, --backward-search\n\ Write the search commands for the tag entries using '?', the\n\ backward-search command instead of '/', the forward-search command."); puts ("-C, --c++\n\ Treat files whose name suffix defaults to C language as C++ files."); if (CTAGS) puts ("-d, --defines\n\ Create tag entries for constant C #defines, too."); else puts ("-D, --no-defines\n\ Don't create tag entries for constant C #defines. This makes\n\ the tags file smaller."); if (!CTAGS) { puts ("-i FILE, --include=FILE\n\ Include a note in tag file indicating that, when searching for\n\ a tag, one should also consult the tags file FILE after\n\ checking the current file."); puts ("-l LANG, --language=LANG\n\ Force the following files to be considered as written in the\n\ named language up to the next --language=LANG option."); } #ifdef ETAGS_REGEXPS puts ("-r /REGEXP/, --regex=/REGEXP/\n\ Make a tag for each line matching pattern REGEXP in the\n\ following files. REGEXP is anchored (as if preceded by ^).\n\ The form /REGEXP/NAME/ creates a named tag. For example Tcl\n\ named tags can be created with:\n\ --regex=/proc[ \\t]+\\([^ \\t]+\\)/\\1/."); puts ("-R, --no-regex\n\ Don't create tags from regexps for the following files."); #endif /* ETAGS_REGEXPS */ puts ("-o FILE, --output=FILE\n\ Write the tags to FILE."); puts ("-I, --ignore-indentation\n\ Don't rely on indentation quite as much as normal. Currently,\n\ 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 in C and C++."); if (CTAGS) { puts ("-t, --typedefs\n\ Generate tag entries for C typedefs."); puts ("-T, --typedefs-and-c++\n\ Generate tag entries for C typedefs, C struct/enum/union tags,\n\ and C++ member functions."); 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\ implemented by deleting the existing entries for the given\n\ 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 ("-w, --no-warn\n\ Suppress warning messages about entries defined in multiple\n\ files."); 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 ("-V, --version\n\ Print the version of the program.\n\ -h, --help\n\ Print this help message."); print_language_names (); exit (GOOD); } enum argument_type { at_language, at_regexp, at_filename }; /* This structure helps us allow mixing of --lang and filenames. */ typedef struct { enum argument_type arg_type; char *what; Lang_function *function; } argument; #ifdef VMS /* VMS specific functions */ #define EOS '\0' /* This is a BUG! ANY arbitrary limit is a BUG! Won't someone please fix this? */ #define MAX_FILE_SPEC_LEN 255 typedef struct { short curlen; char body[MAX_FILE_SPEC_LEN + 1]; } vspec; /* v1.05 nmm 26-Jun-86 fn_exp - expand specification of list of file names returning in each successive call the next filename matching the input spec. The function expects that each in_spec passed to it will be processed to completion; in particular, up to and including the call following that in which the last matching name is returned, the function ignores the value of in_spec, and will only start processing a new spec with the following call. If an error occurs, on return out_spec contains the value of in_spec when the error occurred. With each successive filename returned in out_spec, the function's return value is one. When there are no more matching names the function returns zero. If on the first call no file matches in_spec, or there is any other error, -1 is returned. */ #include #include #define OUTSIZE MAX_FILE_SPEC_LEN short fn_exp (out, in) vspec *out; char *in; { static long context = 0; static struct dsc$descriptor_s o; static struct dsc$descriptor_s i; static logical pass1 = TRUE; long status; short retval; if (pass1) { pass1 = FALSE; o.dsc$a_pointer = (char *) out; o.dsc$w_length = (short)OUTSIZE; i.dsc$a_pointer = in; i.dsc$w_length = (short)strlen(in); i.dsc$b_dtype = DSC$K_DTYPE_T; i.dsc$b_class = DSC$K_CLASS_S; o.dsc$b_dtype = DSC$K_DTYPE_VT; o.dsc$b_class = DSC$K_CLASS_VS; } if ((status = lib$find_file(&i, &o, &context, 0, 0)) == RMS$_NORMAL) { out->body[out->curlen] = EOS; return 1; } else if (status == RMS$_NMF) retval = 0; else { strcpy(out->body, in); retval = -1; } lib$find_file_end(&context); pass1 = TRUE; return retval; } /* v1.01 nmm 19-Aug-85 gfnames - return in successive calls the name of each file specified by the provided arg expanding wildcards. */ char * gfnames (arg, p_error) char *arg; logical *p_error; { static vspec filename = {MAX_FILE_SPEC_LEN, "\0"}; switch (fn_exp (&filename, arg)) { case 1: *p_error = FALSE; return filename.body; case 0: *p_error = FALSE; return NULL; default: *p_error = TRUE; return filename.body; } } #ifndef OLD /* Newer versions of VMS do provide `system'. */ system (cmd) char *cmd; { fprintf (stderr, "system() function not implemented under VMS\n"); } #endif #define VERSION_DELIM ';' char *massage_name (s) char *s; { char *start = s; for ( ; *s; s++) if (*s == VERSION_DELIM) { *s = EOS; break; } else *s = lowcase (*s); return start; } #endif /* VMS */ void main (argc, argv) int argc; char *argv[]; { int i; unsigned int nincluded_files = 0; char **included_files = xnew (argc, char *); char *this_file; argument *argbuffer; int current_arg = 0, file_count = 0; struct linebuffer filename_lb; #ifdef VMS logical got_err; #endif #ifdef DOS_NT _fmode = O_BINARY; /* all of files are treated as binary files */ #endif /* DOS_NT */ progname = argv[0]; /* Allocate enough no matter what happens. Overkill, but each one is small. */ argbuffer = xnew (argc, argument); #ifdef ETAGS_REGEXPS /* Set syntax for regular expression routines. */ re_set_syntax (RE_SYNTAX_EMACS); #endif /* ETAGS_REGEXPS */ /* * If etags, always find typedefs and structure tags. Why not? * Also default is to find macro constants. */ if (!CTAGS) typedefs = typedefs_and_cplusplus = constantypedefs = TRUE; while (1) { int opt = getopt_long (argc, argv, "-aCdDf:Il:o:r:RStTi:BuvxwVhH", longopts, 0); if (opt == EOF) break; switch (opt) { case 0: /* If getopt returns 0, then it has already processed a long-named option. We should do nothing. */ break; case 1: /* This means that a filename has been seen. Record it. */ argbuffer[current_arg].arg_type = at_filename; argbuffer[current_arg].what = optarg; ++current_arg; ++file_count; break; /* Common options. */ case 'a': append_to_tagfile = TRUE; break; case 'C': cplusplus = TRUE; break; case 'd': constantypedefs = TRUE; break; case 'D': constantypedefs = FALSE; break; case 'f': /* for compatibility with old makefiles */ case 'o': if (tagfile) { fprintf (stderr, "%s: -%c option may only be given once.\n", progname, opt); goto usage; } tagfile = optarg; break; case 'I': case 'S': /* for backward compatibility */ noindentypedefs = TRUE; break; case 'l': argbuffer[current_arg].function = get_language_from_name (optarg); if (argbuffer[current_arg].function == NULL) { fprintf (stderr, "%s: language \"%s\" not recognized.\n", progname, optarg); goto usage; } argbuffer[current_arg].arg_type = at_language; ++current_arg; break; #ifdef ETAGS_REGEXPS case 'r': argbuffer[current_arg].arg_type = at_regexp; argbuffer[current_arg].what = optarg; ++current_arg; break; case 'R': argbuffer[current_arg].arg_type = at_regexp; argbuffer[current_arg].what = NULL; ++current_arg; break; #endif /* ETAGS_REGEXPS */ case 'V': print_version (); break; case 'h': case 'H': print_help (); break; case 't': typedefs = TRUE; break; case 'T': typedefs = typedefs_and_cplusplus = TRUE; break; #if (!CTAGS) /* Etags options */ case 'i': included_files[nincluded_files++] = optarg; break; #else /* CTAGS */ /* Ctags options. */ case 'B': searchar = '?'; break; case 'u': update = TRUE; break; case 'v': vgrind_style = TRUE; /*FALLTHRU*/ case 'x': cxref_style = TRUE; break; case 'w': no_warnings = TRUE; break; #endif /* CTAGS */ default: goto usage; } } for (; optind < argc; ++optind) { argbuffer[current_arg].arg_type = at_filename; argbuffer[current_arg].what = argv[optind]; ++current_arg; ++file_count; } if (nincluded_files == 0 && file_count == 0) { fprintf (stderr, "%s: No input files specified.\n", progname); usage: fprintf (stderr, "\tTry `%s --help' for a complete list of options.\n", progname); exit (BAD); } if (tagfile == NULL) { tagfile = CTAGS ? "tags" : "TAGS"; } cwd = etags_getcwd (); /* the current working directory */ strcat (cwd, "/"); if (streq (tagfile, "-")) { tagfiledir = cwd; } else { tagfiledir = absolute_dirname (tagfile, cwd); } init (); /* set up boolean "functions" */ initbuffer (&lb); initbuffer (&token_name); initbuffer (&lbs[0].lb); initbuffer (&lbs[1].lb); initbuffer (&filename_lb); if (!CTAGS) { if (streq (tagfile, "-")) tagf = stdout; else tagf = fopen (tagfile, append_to_tagfile ? "a" : "w"); if (tagf == NULL) pfatal (tagfile); } /* * Loop through files finding functions. */ for (i = 0; i < current_arg; ++i) { switch (argbuffer[i].arg_type) { case at_language: lang_func = argbuffer[i].function; break; #ifdef ETAGS_REGEXPS case at_regexp: add_regex (argbuffer[i].what); break; #endif case at_filename: #ifdef VMS while ((this_file = gfnames (argbuffer[i].what, &got_err)) != NULL) { if (got_err) { error ("Can't find file %s\n", this_file); argc--, argv++; } else { this_file = massage_name (this_file); } #else this_file = argbuffer[i].what; #endif /* Input file named "-" means read file names from stdin and use them. */ if (streq (this_file, "-")) while (readline_internal (&filename_lb, stdin) > 0) process_file (filename_lb.buffer); else process_file (this_file); #ifdef VMS } #endif break; } } if (!CTAGS) { while (nincluded_files-- > 0) fprintf (tagf, "\f\n%s,include\n", *included_files++); fclose (tagf); exit (GOOD); } /* If CTAGS, we are here. process_file did not write the tags yet, because we want them ordered. Let's do it now. */ if (cxref_style) { tagf = fopen (tagfile, append_to_tagfile ? "a" : "w"); if (tagf == NULL) pfatal (tagfile); put_entries (head); exit (GOOD); } if (update) { char cmd[BUFSIZ]; for (i = 0; i < current_arg; ++i) { if (argbuffer[i].arg_type != at_filename) continue; sprintf (cmd, "mv %s OTAGS;fgrep -v '\t%s\t' OTAGS >%s;rm OTAGS", tagfile, argbuffer[i].what, tagfile); if (system (cmd) != GOOD) fatal ("failed to execute shell command"); } append_to_tagfile = TRUE; } tagf = fopen (tagfile, append_to_tagfile ? "a" : "w"); if (tagf == NULL) pfatal (tagfile); put_entries (head); fclose (tagf); if (update) { char cmd[BUFSIZ]; sprintf (cmd, "sort %s -o %s", tagfile, tagfile); exit (system (cmd)); } exit (GOOD); } /* * Return a Lang_function given the name. */ Lang_function * get_language_from_name (name) char *name; { struct lang_entry *lang; if (name == NULL) return NULL; for (lang = lang_names; lang->name != NULL; lang++) { if (streq (name, lang->name)) return lang->function; } return NULL; } /* * Return a Lang_function given the interpreter name. */ Lang_function * get_language_from_interpreter (interpreter) char *interpreter; { struct lang_entry *lang; char **iname; if (interpreter == NULL) return NULL; for (lang = lang_names; lang->name != NULL; lang++) if (lang->interpreters != NULL) for (iname = lang->interpreters; *iname != NULL; iname++) if (streq (*iname, interpreter)) return lang->function; return NULL; } /* * Return a Lang_function given the file suffix. */ Lang_function * get_language_from_suffix (suffix) char *suffix; { struct lang_entry *lang; char **ext; if (suffix == NULL) return NULL; for (lang = lang_names; lang->name != NULL; lang++) if (lang->suffixes != NULL) for (ext = lang->suffixes; *ext != NULL; ext++) if (streq (*ext, suffix)) return lang->function; return NULL; } /* * This routine is called on each file argument. */ void process_file (file) char *file; { struct stat stat_buf; FILE *inf; if (stat (file, &stat_buf) == 0 && !S_ISREG (stat_buf.st_mode)) { fprintf (stderr, "Skipping %s: it is not a regular file.\n", file); return; } if (streq (file, tagfile) && !streq (tagfile, "-")) { fprintf (stderr, "Skipping inclusion of %s in self.\n", file); return; } inf = fopen (file, "r"); if (inf == NULL) { perror (file); return; } find_entries (file, inf); if (!CTAGS) { char *filename; if (absolutefn (file)) { /* file is an absolute filename. Canonicalise it. */ filename = absolute_filename (file, cwd); } else { /* file is a filename relative to cwd. Make it relative to the directory of the tags file. */ filename = relative_filename (file, tagfiledir); } fprintf (tagf, "\f\n%s,%d\n", filename, total_size_of_entries (head)); free (filename); put_entries (head); free_tree (head); head = NULL; } } /* * This routine sets up the boolean pseudo-functions which work * by setting boolean flags dependent upon the corresponding character * Every char which is NOT in that string is not a white char. Therefore, * all of the array "_wht" is set to FALSE, and then the elements * subscripted by the chars in "white" are set to TRUE. Thus "_wht" * of a char is TRUE if it is the string "white", else FALSE. */ void init () { register char *sp; register int i; for (i = 0; i < 0177; i++) _wht[i] = _etk[i] = _itk[i] = _btk[i] = FALSE; for (sp = white; *sp; sp++) _wht[*sp] = TRUE; for (sp = endtk; *sp; sp++) _etk[*sp] = TRUE; for (sp = intk; *sp; sp++) _itk[*sp] = TRUE; for (sp = begtk; *sp; sp++) _btk[*sp] = TRUE; _wht[0] = _wht['\n']; _etk[0] = _etk['\n']; _btk[0] = _btk['\n']; _itk[0] = _itk['\n']; } /* * This routine opens the specified file and calls the function * which finds the function and type definitions. */ void find_entries (file, inf) char *file; FILE *inf; { char *cp; Lang_function *function; NODE *old_last_node; extern NODE *last_node; /* Memory leakage here: the memory block pointed by curfile is never released. The amount of memory leaked here is the sum of the lengths of the input file names. */ curfile = savestr (file); /* If user specified a language, use it. */ function = lang_func; if (function != NULL) { function (inf); fclose (inf); return; } cp = etags_strrchr (file, '.'); if (cp != NULL) { cp += 1; function = get_language_from_suffix (cp); if (function != NULL) { function (inf); fclose (inf); return; } } /* Look for sharp-bang as the first two characters. */ if (readline_internal (&lb, inf) > 2 && lb.buffer[0] == '#' && lb.buffer[1] == '!') { char *lp; /* Set lp to point at the first char after the last slash in the line or, if no slashes, at the first nonblank. Then set cp to the first successive blank and terminate the string. */ lp = etags_strrchr (lb.buffer+2, '/'); if (lp != NULL) lp += 1; else for (lp = lb.buffer+2; *lp != '\0' && isspace (*lp); lp++) continue; for (cp = lp; *cp != '\0' && !isspace (*cp); cp++) continue; *cp = '\0'; if (strlen (lp) > 0) { function = get_language_from_interpreter (lp); if (function != NULL) { function (inf); fclose (inf); return; } } } rewind (inf); /* Try Fortran. */ old_last_node = last_node; Fortran_functions (inf); /* No Fortran entries found. Try C. */ if (old_last_node == last_node) { rewind (inf); default_C_entries (inf); } fclose (inf); return; } /* Record a tag. */ void pfnote (name, is_func, linestart, linelen, lno, cno) char *name; /* tag name, if different from definition */ logical is_func; /* tag is a function */ char *linestart; /* start of the line where tag is */ int linelen; /* length of the line where tag is */ int lno; /* line number */ long cno; /* character number */ { register NODE *np = xnew (1, NODE); /* If ctags mode, change name "main" to M. */ if (CTAGS && !cxref_style && streq (name, "main")) { register char *fp = etags_strrchr (curfile, '/'); np->name = concat ("M", fp == 0 ? curfile : fp + 1, ""); fp = etags_strrchr (np->name, '.'); if (fp && fp[1] != '\0' && fp[2] == '\0') fp[0] = 0; } else np->name = name; np->been_warned = FALSE; np->file = curfile; np->is_func = is_func; np->lno = lno; /* Our char numbers are 0-base, because of C language tradition? ctags compatibility? old versions compatibility? I don't know. Anyway, since emacs's are 1-base we espect etags.el to take care of the difference. If we wanted to have 1-based numbers, we would uncomment the +1 below. */ np->cno = cno /* + 1 */ ; np->left = np->right = NULL; np->pat = savenstr (linestart, ((CTAGS && !cxref_style) ? 50 : linelen)); add_node (np, &head); } /* * free_tree () * recurse on left children, iterate on right children. */ void free_tree (node) register NODE *node; { while (node) { register NODE *node_right = node->right; free_tree (node->left); if (node->name != NULL) free (node->name); free (node->pat); free ((char *) node); node = node_right; } } /* * add_node () * Adds a node to the tree of nodes. In etags mode, we don't keep * it sorted; we just keep a linear list. In ctags mode, maintain * an ordered tree, with no attempt at balancing. * * add_node is the only function allowed to add nodes, so it can * maintain state. */ NODE *last_node = NULL; void add_node (node, cur_node_p) NODE *node, **cur_node_p; { register int dif; register NODE *cur_node = *cur_node_p; if (cur_node == NULL) { *cur_node_p = node; last_node = node; return; } if (!CTAGS) { /* Etags Mode */ if (last_node == NULL) fatal ("internal error in add_node", 0); last_node->right = node; last_node = node; } else { /* Ctags Mode */ dif = strcmp (node->name, cur_node->name); /* * If this tag name matches an existing one, then * do not add the node, but maybe print a warning. */ if (!dif) { if (streq (node->file, cur_node->file)) { if (!no_warnings) { fprintf (stderr, "Duplicate entry in file %s, line %d: %s\n", node->file, lineno, node->name); fprintf (stderr, "Second entry ignored\n"); } } else if (!cur_node->been_warned && !no_warnings) { fprintf (stderr, "Duplicate entry in files %s and %s: %s (Warning only)\n", node->file, cur_node->file, node->name); cur_node->been_warned = TRUE; } return; } /* Actually add the node */ add_node (node, dif < 0 ? &cur_node->left : &cur_node->right); } } void put_entries (node) register NODE *node; { register char *sp; if (node == NULL) return; /* Output subentries that precede this one */ put_entries (node->left); /* Output this entry */ if (!CTAGS) { if (node->name != NULL) fprintf (tagf, "%s\177%s\001%d,%d\n", node->pat, node->name, node->lno, node->cno); else fprintf (tagf, "%s\177%d,%d\n", node->pat, node->lno, node->cno); } else if (!cxref_style) { fprintf (tagf, "%s\t%s\t", node->name, node->file); if (node->is_func) { /* a function */ putc (searchar, tagf); putc ('^', tagf); for (sp = node->pat; *sp; sp++) { if (*sp == '\\' || *sp == searchar) putc ('\\', tagf); putc (*sp, tagf); } putc (searchar, tagf); } else { /* a typedef; text pattern inadequate */ fprintf (tagf, "%d", node->lno); } putc ('\n', tagf); } else if (vgrind_style) fprintf (stdout, "%s %s %d\n", node->name, node->file, (node->lno + 63) / 64); else fprintf (stdout, "%-16s %3d %-16s %s\n", node->name, node->lno, node->file, node->pat); /* Output subentries that follow this one */ put_entries (node->right); } /* Length of a number's decimal representation. */ int number_len (num) long num; { int len = 0; if (!num) return 1; for (; num; num /= 10) ++len; return len; } /* * Return total number of characters that put_entries will output for * the nodes in the subtree of the specified node. Works only if * we are not ctags, but called only in that case. This count * is irrelevant with the new tags.el, but is still supplied for * backward compatibility. */ int total_size_of_entries (node) register NODE *node; { register int total; if (node == NULL) return 0; total = 0; for (; node; node = node->right) { /* Count left subentries. */ total += total_size_of_entries (node->left); /* Count this entry */ total += strlen (node->pat) + 1; total += number_len ((long) node->lno) + 1 + number_len (node->cno) + 1; if (node->name != NULL) total += 1 + strlen (node->name); /* \001name */ } return total; } /* * The C symbol tables. */ enum sym_type { st_none, st_C_struct, st_C_enum, st_C_define, st_C_typedef, st_C_typespec }; /* Feed stuff between (but not including) %[ and %] lines to: gperf -c -k1,3 -o -p -r -t %[ struct C_stab_entry { char *name; int c_ext; enum sym_type type; } %% class, C_PLPL, st_C_struct domain, C_STAR, st_C_struct union, 0, st_C_struct struct, 0, st_C_struct enum, 0, st_C_enum typedef, 0, st_C_typedef define, 0, st_C_define long, 0, st_C_typespec short, 0, st_C_typespec int, 0, st_C_typespec char, 0, st_C_typespec float, 0, st_C_typespec double, 0, st_C_typespec signed, 0, st_C_typespec unsigned, 0, st_C_typespec auto, 0, st_C_typespec void, 0, st_C_typespec extern, 0, st_C_typespec static, 0, st_C_typespec const, 0, st_C_typespec volatile, 0, st_C_typespec %] and replace lines between %< and %> with its output. */ /*%<*/ /* C code produced by gperf version 1.8.1 (K&R C version) */ /* Command-line: gperf -c -k1,3 -o -p -r -t */ struct C_stab_entry { char *name; int c_ext; enum sym_type type; }; #define MIN_WORD_LENGTH 3 #define MAX_WORD_LENGTH 8 #define MIN_HASH_VALUE 10 #define MAX_HASH_VALUE 62 /* 21 keywords 53 is the maximum key range */ static int hash (str, len) register char *str; register int len; { static unsigned char hash_table[] = { 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 2, 62, 7, 6, 9, 15, 30, 62, 24, 62, 62, 1, 24, 7, 27, 13, 62, 19, 26, 18, 27, 1, 62, 62, 62, 62, 62, 62, 62, 62, 62, }; return len + hash_table[str[2]] + hash_table[str[0]]; } struct C_stab_entry * in_word_set (str, len) register char *str; register int len; { static struct C_stab_entry wordlist[] = { {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"volatile", 0, st_C_typespec}, {"",}, {"long", 0, st_C_typespec}, {"char", 0, st_C_typespec}, {"class", C_PLPL, st_C_struct}, {"",}, {"",}, {"",}, {"",}, {"const", 0, st_C_typespec}, {"",}, {"",}, {"",}, {"",}, {"auto", 0, st_C_typespec}, {"",}, {"",}, {"define", 0, st_C_define}, {"",}, {"void", 0, st_C_typespec}, {"",}, {"",}, {"",}, {"extern", 0, st_C_typespec}, {"static", 0, st_C_typespec}, {"",}, {"domain", C_STAR, st_C_struct}, {"",}, {"typedef", 0, st_C_typedef}, {"double", 0, st_C_typespec}, {"enum", 0, st_C_enum}, {"",}, {"",}, {"",}, {"",}, {"int", 0, st_C_typespec}, {"",}, {"float", 0, st_C_typespec}, {"",}, {"",}, {"",}, {"struct", 0, st_C_struct}, {"",}, {"",}, {"",}, {"",}, {"union", 0, st_C_struct}, {"",}, {"short", 0, st_C_typespec}, {"",}, {"",}, {"unsigned", 0, st_C_typespec}, {"signed", 0, st_C_typespec}, }; if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH) { register int key = hash (str, len); if (key <= MAX_HASH_VALUE && key >= MIN_HASH_VALUE) { register char *s = wordlist[key].name; if (*s == *str && strneq (str + 1, s + 1, len - 1)) return &wordlist[key]; } } return 0; } /*%>*/ enum sym_type C_symtype(str, len, c_ext) char *str; int len; int c_ext; { register struct C_stab_entry *se = in_word_set(str, len); if (se == NULL || (se->c_ext && !(c_ext & se->c_ext))) return st_none; return se->type; } /* * C functions are recognized using a simple finite automaton. * funcdef is its state variable. */ typedef enum { fnone, /* nothing seen */ ftagseen, /* function-like tag seen */ fstartlist, /* just after open parenthesis */ finlist, /* in parameter list */ flistseen, /* after parameter list */ fignore /* before open brace */ } FUNCST; FUNCST funcdef; /* * typedefs are recognized using a simple finite automaton. * typeddef is its state variable. */ typedef enum { tnone, /* nothing seen */ ttypedseen, /* typedef keyword seen */ tinbody, /* inside typedef body */ tend, /* just before typedef tag */ tignore /* junk after typedef tag */ } TYPEDST; TYPEDST typdef; /* * struct-like structures (enum, struct and union) are recognized * using another simple finite automaton. `structdef' is its state * variable. */ typedef enum { snone, /* nothing seen yet */ skeyseen, /* struct-like keyword seen */ stagseen, /* struct-like tag seen */ scolonseen, /* colon seen after struct-like tag */ sinbody /* in struct body: recognize member func defs*/ } STRUCTST; STRUCTST structdef; /* * When structdef is stagseen, scolonseen, or sinbody, structtag is the * struct tag, and structtype is the type of the preceding struct-like * keyword. */ char *structtag = ""; enum sym_type structtype; /* * Yet another little state machine to deal with preprocessor lines. */ typedef enum { dnone, /* nothing seen */ dsharpseen, /* '#' seen as first char on line */ ddefineseen, /* '#' and 'define' seen */ dignorerest /* ignore rest of line */ } DEFINEST; DEFINEST definedef; /* * Set this to TRUE, and the next token considered is called a function. * Used only for GNU emacs's function-defining macros. */ logical next_token_is_func; /* * TRUE in the rules part of a yacc file, FALSE outside (parse as C). */ logical yacc_rules; /* * consider_token () * checks to see if the current token is at the start of a * function, or corresponds to a typedef, or is a struct/union/enum * tag. * * *IS_FUNC gets TRUE iff the token is a function or macro with args. * C_EXT is which language we are looking at. * * In the future we will need some way to adjust where the end of * the token is; for instance, implementing the C++ keyword * `operator' properly will adjust the end of the token to be after * whatever follows `operator'. * * Globals * funcdef IN OUT * structdef IN OUT * definedef IN OUT * typdef IN OUT * next_token_is_func IN OUT */ logical consider_token (str, len, c, c_ext, cblev, is_func) register char *str; /* IN: token pointer */ register int len; /* IN: token length */ register char c; /* IN: first char after the token */ int c_ext; /* IN: C extensions mask */ int cblev; /* IN: curly brace level */ logical *is_func; /* OUT: function found */ { enum sym_type toktype = C_symtype (str, len, c_ext); /* * Advance the definedef state machine. */ switch (definedef) { case dnone: /* We're not on a preprocessor line. */ break; case dsharpseen: if (toktype == st_C_define) { definedef = ddefineseen; } else { definedef = dignorerest; } return FALSE; case ddefineseen: /* * Make a tag for any macro, unless it is a constant * and constantypedefs is FALSE. */ definedef = dignorerest; *is_func = (c == '('); if (!*is_func && !constantypedefs) return FALSE; else return TRUE; case dignorerest: return FALSE; default: error ("internal error: definedef value.", 0); } /* * Now typedefs */ switch (typdef) { case tnone: if (toktype == st_C_typedef) { if (typedefs) typdef = ttypedseen; funcdef = fnone; return FALSE; } break; case ttypedseen: switch (toktype) { case st_none: case st_C_typespec: typdef = tend; break; case st_C_struct: case st_C_enum: break; } /* Do not return here, so the structdef stuff has a chance. */ break; case tend: switch (toktype) { case st_C_typespec: case st_C_struct: case st_C_enum: return FALSE; } return TRUE; } /* * 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 * file is plain C. This is because a struct tag may have the same * name as another tag, and this loses with ctags. * * This if statement deals with the typdef state machine as * follows: if typdef==ttypedseen and token is struct/union/class/enum, * return FALSE. All the other code here is for the structdef * state machine. */ switch (toktype) { case st_C_struct: case st_C_enum: if (typdef == ttypedseen || (typedefs_and_cplusplus && cblev == 0 && structdef == snone)) { structdef = skeyseen; structtype = toktype; } return FALSE; } if (structdef == skeyseen) { /* Save the tag for struct/union/class, for functions that may be defined inside. */ if (structtype == st_C_struct) structtag = savenstr (str, len); else structtag = ""; structdef = stagseen; return TRUE; } /* Avoid entering funcdef stuff if typdef is going on. */ if (typdef != tnone) { definedef = dnone; return FALSE; } /* Detect GNU macros. */ if (definedef == dnone) if (strneq (str, "DEFUN", len) /* Used in emacs */ #if FALSE These are defined inside C functions, so currently they are not met anyway. || strneq (str, "EXFUN", len) /* Used in glibc */ || strneq (str, "DEFVAR_", 7) /* Used in emacs */ #endif || strneq (str, "SYSCALL", len) /* Used in glibc (mach) */ || strneq (str, "ENTRY", len) /* Used in glibc */ || strneq (str, "PSEUDO", len)) /* Used in glibc */ { next_token_is_func = TRUE; return FALSE; } if (next_token_is_func) { next_token_is_func = FALSE; funcdef = fignore; *is_func = TRUE; return TRUE; } /* A function? */ switch (toktype) { case st_C_typespec: if (funcdef != finlist && funcdef != fignore) funcdef = fnone; /* should be useless */ return FALSE; default: if (funcdef == fnone) { funcdef = ftagseen; *is_func = TRUE; return TRUE; } } return FALSE; } /* * C_entries () * This routine finds functions, typedefs, #define's and * struct/union/enum definitions in C syntax and adds them * to the list. */ typedef struct { logical valid; char *str; logical named; int linelen; int lineno; long linepos; char *buffer; } TOKEN; #define current_lb_is_new (newndx == curndx) #define switch_line_buffers() (curndx = 1 - curndx) #define curlb (lbs[curndx].lb) #define othlb (lbs[1-curndx].lb) #define newlb (lbs[newndx].lb) #define curlinepos (lbs[curndx].linepos) #define othlinepos (lbs[1-curndx].linepos) #define newlinepos (lbs[newndx].linepos) #define CNL_SAVE_DEFINEDEF \ do { \ curlinepos = charno; \ lineno++; \ charno += readline (&curlb, inf); \ lp = curlb.buffer; \ quotednl = FALSE; \ newndx = curndx; \ } while (0) #define CNL \ do { \ CNL_SAVE_DEFINEDEF; \ if (savetok.valid) \ { \ tok = savetok; \ savetok.valid = FALSE; \ } \ definedef = dnone; \ } while (0) #define make_tag(isfun) do \ { \ if (tok.valid) \ { \ char *name = NULL; \ if (tok.named) \ name = savestr (token_name.buffer); \ pfnote (name, isfun, tok.buffer, tok.linelen, tok.lineno, tok.linepos); \ } \ else if (DEBUG) abort (); \ tok.valid = FALSE; \ } while (0) void C_entries (c_ext, inf) int c_ext; /* extension of C */ FILE *inf; /* input file */ { register char c; /* latest char read; '\0' for end of line */ register char *lp; /* pointer one beyond the character `c' */ int curndx, newndx; /* indices for current and new lb */ TOKEN tok; /* latest token read */ register int tokoff; /* offset in line of start of current token */ register int toklen; /* length of current token */ int cblev; /* current curly brace level */ int parlev; /* current parenthesis level */ logical incomm, inquote, inchar, quotednl, midtoken; logical cplpl; TOKEN savetok; /* token saved during preprocessor handling */ curndx = newndx = 0; lineno = 0; charno = 0; lp = curlb.buffer; *lp = 0; definedef = dnone; funcdef = fnone; typdef = tnone; structdef = snone; next_token_is_func = yacc_rules = FALSE; midtoken = inquote = inchar = incomm = quotednl = FALSE; tok.valid = savetok.valid = FALSE; cblev = 0; parlev = 0; cplpl = c_ext & C_PLPL; while (!feof (inf)) { c = *lp++; if (c == '\\') { /* If we're at the end of the line, the next character is a '\0'; don't skip it, because it's the thing that tells us to read the next line. */ if (*lp == '\0') { quotednl = TRUE; continue; } lp++; c = ' '; } else if (incomm) { switch (c) { case '*': if (*lp == '/') { c = *lp++; incomm = FALSE; } break; case '\0': /* Newlines inside comments do not end macro definitions in traditional cpp. */ CNL_SAVE_DEFINEDEF; break; } continue; } else if (inquote) { switch (c) { case '"': inquote = FALSE; break; case '\0': /* Newlines inside strings do not end macro definitions in traditional cpp, even though compilers don't usually accept them. */ CNL_SAVE_DEFINEDEF; break; } continue; } else if (inchar) { switch (c) { case '\0': /* Hmmm, something went wrong. */ CNL; /* FALLTHRU */ case '\'': inchar = FALSE; break; } continue; } else switch (c) { case '"': inquote = TRUE; if (funcdef != finlist && funcdef != fignore) funcdef = fnone; continue; case '\'': inchar = TRUE; if (funcdef != finlist && funcdef != fignore) funcdef = fnone; continue; case '/': if (*lp == '*') { lp++; incomm = TRUE; continue; } else if (cplpl && *lp == '/') { c = 0; break; } else break; case '%': if ((c_ext & YACC) && *lp == '%') { /* entering or exiting rules section in yacc file */ lp++; definedef = dnone; funcdef = fnone; typdef = tnone; structdef = snone; next_token_is_func = FALSE; midtoken = inquote = inchar = incomm = quotednl = FALSE; cblev = 0; yacc_rules = !yacc_rules; continue; } else break; case '#': if (definedef == dnone) { char *cp; logical cpptoken = TRUE; /* Look back on this line. If all blanks, or nonblanks followed by an end of comment, this is a preprocessor token. */ for (cp = newlb.buffer; cp < lp-1; cp++) if (!iswhite (*cp)) { if (*cp == '*' && *(cp+1) == '/') { cp++; cpptoken = TRUE; } else cpptoken = FALSE; } if (cpptoken) definedef = dsharpseen; } /* if (definedef == dnone) */ continue; } /* switch (c) */ /* Consider token only if some complicated conditions are satisfied. */ if ((definedef != dnone || (cblev == 0 && structdef != scolonseen) || (cblev == 1 && cplpl && structdef == sinbody)) && typdef != tignore && definedef != dignorerest && funcdef != finlist) { if (midtoken) { if (endtoken (c)) { if (cplpl && c == ':' && *lp == ':' && begtoken(*(lp + 1))) { /* * This handles :: in the middle, but not at the * beginning of an identifier. */ lp += 2; toklen += 3; } else { logical is_func = FALSE; if (yacc_rules || consider_token (newlb.buffer + tokoff, toklen, c, c_ext, cblev, &is_func)) { if (structdef == sinbody && definedef == dnone && is_func) /* function defined in C++ class body */ { int strsize = strlen(structtag) + 2 + toklen + 1; while (token_name.size < strsize) { token_name.size *= 2; token_name.buffer = (char *) xrealloc (token_name.buffer, token_name.size); } strcpy (token_name.buffer, structtag); strcat (token_name.buffer, "::"); strncat (token_name.buffer, newlb.buffer+tokoff, toklen); tok.named = TRUE; } else { while (token_name.size < toklen + 1) { token_name.size *= 2; token_name.buffer = (char *) xrealloc (token_name.buffer, token_name.size); } strncpy (token_name.buffer, newlb.buffer+tokoff, toklen); token_name.buffer[toklen] = '\0'; if (structdef == stagseen || typdef == tend || (is_func && definedef == dignorerest)) /* macro */ tok.named = TRUE; else tok.named = FALSE; } tok.lineno = lineno; tok.linelen = tokoff + toklen + 1; tok.buffer = newlb.buffer; tok.linepos = newlinepos; tok.valid = TRUE; if (definedef == dnone && (funcdef == ftagseen || structdef == stagseen || typdef == tend)) { if (current_lb_is_new) switch_line_buffers (); } else make_tag (is_func); } midtoken = FALSE; } } /* if (endtoken (c)) */ else if (intoken (c)) { toklen++; continue; } } /* if (midtoken) */ else if (begtoken (c)) { switch (definedef) { case dnone: switch (funcdef) { case fstartlist: funcdef = finlist; continue; case flistseen: make_tag (TRUE); funcdef = fignore; break; case ftagseen: funcdef = fnone; break; } if (structdef == stagseen) structdef = snone; break; case dsharpseen: savetok = tok; } if (!yacc_rules || lp == newlb.buffer + 1) { tokoff = lp - 1 - newlb.buffer; toklen = 1; midtoken = TRUE; } continue; } /* if (begtoken) */ } /* if must look at token */ /* Detect end of line, colon, comma, semicolon and various braces after having handled a token.*/ switch (c) { case ':': if (definedef != dnone) break; if (structdef == stagseen) structdef = scolonseen; else switch (funcdef) { case ftagseen: if (yacc_rules) { make_tag (FALSE); funcdef = fignore; } break; case fstartlist: funcdef = fnone; break; } break; case ';': if (definedef != dnone) break; if (cblev == 0) switch (typdef) { case tend: make_tag (FALSE); /* FALLTHRU */ default: typdef = tnone; } if (funcdef != fignore) { funcdef = fnone; /* The following instruction invalidates the token. Probably the token should be invalidated in all other cases where some state machine is reset. */ tok.valid = FALSE; } if (structdef == stagseen) structdef = snone; break; case ',': if (definedef != dnone) break; if (funcdef != finlist && funcdef != fignore) funcdef = fnone; if (structdef == stagseen) structdef = snone; break; case '[': if (definedef != dnone) break; if (cblev == 0 && typdef == tend) { typdef = tignore; make_tag (FALSE); break; } if (funcdef != finlist && funcdef != fignore) funcdef = fnone; if (structdef == stagseen) structdef = snone; break; case '(': if (definedef != dnone) break; switch (funcdef) { case fnone: switch (typdef) { case ttypedseen: case tend: /* Make sure that the next char is not a '*'. This handles constructs like: typedef void OperatorFun (int fun); */ if (*lp != '*') { typdef = tignore; make_tag (FALSE); } break; } /* switch (typdef) */ break; case ftagseen: funcdef = fstartlist; break; case flistseen: funcdef = finlist; break; } parlev++; break; case ')': if (definedef != dnone) break; if (--parlev == 0) { switch (funcdef) { case fstartlist: case finlist: funcdef = flistseen; break; } if (cblev == 0 && typdef == tend) { typdef = tignore; make_tag (FALSE); } } else if (parlev < 0) /* can happen due to ill-conceived #if's. */ parlev = 0; break; case '{': if (definedef != dnone) break; if (typdef == ttypedseen) typdef = tinbody; switch (structdef) { case skeyseen: /* unnamed struct */ structtag = "_anonymous_"; structdef = sinbody; break; case stagseen: case scolonseen: /* named struct */ structdef = sinbody; make_tag (FALSE); break; } switch (funcdef) { case flistseen: make_tag (TRUE); /* FALLTHRU */ case fignore: funcdef = fnone; break; case fnone: /* Neutralize `extern "C" {' grot and look inside structs. */ if (cblev == 0 && structdef == snone && typdef == tnone) cblev = -1; } cblev++; break; case '*': if (definedef != dnone) break; if (funcdef == fstartlist) funcdef = fnone; /* avoid tagging `foo' in `foo (*bar()) ()' */ break; case '}': if (definedef != dnone) break; if (!noindentypedefs && lp == newlb.buffer + 1) { cblev = 0; /* reset curly brace level if first column */ parlev = 0; /* also reset paren level, just in case... */ } else if (cblev > 0) cblev--; if (cblev == 0) { if (typdef == tinbody) typdef = tend; /* Memory leakage here: the string pointed by structtag is never released, because I fear to miss something and break things while freeing the area. The amount of memory leaked here is the sum of the lenghts of the struct tags. if (structdef == sinbody) free (structtag); */ structdef = snone; structtag = ""; } break; case '=': case '#': case '+': case '-': case '~': case '&': case '%': case '/': case '|': case '^': case '!': case '<': case '>': case '.': case '?': if (definedef != dnone) break; /* These surely cannot follow a function tag. */ if (funcdef != finlist && funcdef != fignore) funcdef = fnone; break; case '\0': /* If a macro spans multiple lines don't reset its state. */ if (quotednl) CNL_SAVE_DEFINEDEF; else CNL; break; } /* switch (c) */ } /* while not eof */ } /* * Process either a C++ file or a C file depending on the setting * of a global flag. */ void default_C_entries (inf) FILE *inf; { C_entries (cplusplus ? C_PLPL : 0, inf); } /* Always do plain ANSI C. */ void plain_C_entries (inf) FILE *inf; { C_entries (0, inf); } /* Always do C++. */ void Cplusplus_entries (inf) FILE *inf; { C_entries (C_PLPL, inf); } /* Always do C*. */ void Cstar_entries (inf) FILE *inf; { C_entries (C_STAR, inf); } /* Always do Yacc. */ void Yacc_entries (inf) FILE *inf; { C_entries (YACC, inf); } /* Fortran parsing */ char *dbp; logical tail (cp) char *cp; { register int len = 0; while (*cp && lowcase(*cp) == lowcase(dbp[len])) cp++, len++; if (*cp == '\0' && !intoken(dbp[len])) { dbp += len; return TRUE; } return FALSE; } void takeprec () { while (isspace (*dbp)) dbp++; if (*dbp != '*') return; dbp++; while (isspace (*dbp)) dbp++; if (strneq (dbp, "(*)", 3)) { dbp += 3; return; } if (!isdigit (*dbp)) { --dbp; /* force failure */ return; } do dbp++; while (isdigit (*dbp)); } void getit (inf) FILE *inf; { register char *cp; while (isspace (*dbp)) dbp++; if (*dbp == '\0') { lineno++; linecharno = charno; charno += readline (&lb, inf); dbp = lb.buffer; if (dbp[5] != '&') return; dbp += 6; while (isspace (*dbp)) dbp++; } if (!isalpha (*dbp) && *dbp != '_' && *dbp != '$') return; for (cp = dbp + 1; (*cp && (isalpha (*cp) || isdigit (*cp) || (*cp == '_') || (*cp == '$'))); cp++) continue; pfnote (NULL, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); } void Fortran_functions (inf) FILE *inf; { lineno = 0; charno = 0; while (!feof (inf)) { lineno++; linecharno = charno; charno += readline (&lb, inf); dbp = lb.buffer; if (*dbp == '%') dbp++; /* Ratfor escape to fortran */ while (isspace (*dbp)) dbp++; if (*dbp == '\0') continue; switch (lowcase (*dbp)) { case 'i': if (tail ("integer")) takeprec (); break; case 'r': if (tail ("real")) takeprec (); break; case 'l': if (tail ("logical")) takeprec (); break; case 'c': if (tail ("complex") || tail ("character")) takeprec (); break; case 'd': if (tail ("double")) { while (isspace (*dbp)) dbp++; if (*dbp == '\0') continue; if (tail ("precision")) break; continue; } break; } while (isspace (*dbp)) dbp++; if (*dbp == '\0') continue; switch (lowcase (*dbp)) { case 'f': if (tail ("function")) getit (inf); continue; case 's': if (tail ("subroutine")) getit (inf); continue; case 'e': if (tail ("entry")) getit (inf); continue; case 'p': if (tail ("program")) { getit (inf); continue; } if (tail ("procedure")) getit (inf); continue; } } } /* * Bob Weiner, Motorola Inc., 4/3/94 * Unix and microcontroller assembly tag handling * look for '^[a-zA-Z_.$][a-zA_Z0-9_.$]*[: ^I^J]' */ void Asm_labels (inf) FILE *inf; { register char *cp; lineno = 0; charno = 0; while (!feof (inf)) { lineno++; linecharno = charno; charno += readline (&lb, inf); cp = lb.buffer; /* If first char is alphabetic or one of [_.$], test for colon following identifier. */ if (isalpha (*cp) || *cp == '_' || *cp == '.' || *cp == '$') { /* Read past label. */ cp++; while (isalnum (*cp) || *cp == '_' || *cp == '.' || *cp == '$') cp++; if (*cp == ':' || isspace (*cp)) { /* Found end of label, so copy it and add it to the table. */ pfnote (NULL, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); } } } } /* * Perl support by Bart Robinson * Perl sub names: look for /^sub[ \t\n]+[^ \t\n{]+/ */ void Perl_functions (inf) FILE *inf; { register char *cp; lineno = 0; charno = 0; while (!feof (inf)) { lineno++; linecharno = charno; charno += readline (&lb, inf); cp = lb.buffer; if (*cp++ == 's' && *cp++ == 'u' && *cp++ == 'b' && isspace(*cp++)) { while (*cp && isspace(*cp)) cp++; while (*cp && ! isspace(*cp) && *cp != '{') cp++; pfnote (NULL, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); } } } /* Added by Mosur Mohan, 4/22/88 */ /* Pascal parsing */ #define GET_NEW_LINE \ { \ linecharno = charno; lineno++; \ charno += 1 + readline (&lb, inf); \ dbp = lb.buffer; \ } /* * Locates tags for procedures & functions. Doesn't do any type- or * var-definitions. It does look for the keyword "extern" or * "forward" immediately following the procedure statement; if found, * the tag is skipped. */ void Pascal_functions (inf) FILE *inf; { struct linebuffer tline; /* mostly copied from C_entries */ long save_lcno; int save_lineno, save_len; char c; logical /* each of these flags is TRUE iff: */ incomment, /* point is inside a comment */ inquote, /* point is inside '..' string */ get_tagname, /* point is after PROCEDURE/FUNCTION keyword, so next item = potential tag */ found_tag, /* point is after a potential tag */ inparms, /* point is within parameter-list */ verify_tag; /* point has passed the parm-list, so the next token will determine whether this is a FORWARD/EXTERN to be ignored, or whether it is a real tag */ lineno = 0; charno = 0; dbp = lb.buffer; *dbp = '\0'; save_len = 0; initbuffer (&tline); incomment = inquote = FALSE; found_tag = FALSE; /* have a proc name; check if extern */ get_tagname = FALSE; /* have found "procedure" keyword */ inparms = FALSE; /* found '(' after "proc" */ verify_tag = FALSE; /* check if "extern" is ahead */ /* long main loop to get next char */ while (!feof (inf)) { c = *dbp++; if (c == '\0') /* if end of line */ { GET_NEW_LINE; if (*dbp == '\0') continue; if (!((found_tag && verify_tag) || get_tagname)) c = *dbp++; /* only if don't need *dbp pointing to the beginning of the name of the procedure or function */ } if (incomment) { if (c == '}') /* within { } comments */ incomment = FALSE; else if (c == '*' && *dbp == ')') /* within (* *) comments */ { dbp++; incomment = FALSE; } continue; } else if (inquote) { if (c == '\'') inquote = FALSE; continue; } else switch (c) { case '\'': inquote = TRUE; /* found first quote */ continue; case '{': /* found open { comment */ incomment = TRUE; continue; case '(': if (*dbp == '*') /* found open (* comment */ { incomment = TRUE; dbp++; } else if (found_tag) /* found '(' after tag, i.e., parm-list */ inparms = TRUE; continue; case ')': /* end of parms list */ if (inparms) inparms = FALSE; continue; case ';': if (found_tag && !inparms) /* end of proc or fn stmt */ { verify_tag = TRUE; break; } continue; } if (found_tag && verify_tag && (*dbp != ' ')) { /* check if this is an "extern" declaration */ if (*dbp == '\0') continue; if (lowcase (*dbp == 'e')) { if (tail ("extern")) /* superfluous, really! */ { found_tag = FALSE; verify_tag = FALSE; } } else if (lowcase (*dbp) == 'f') { if (tail ("forward")) /* check for forward reference */ { found_tag = FALSE; verify_tag = FALSE; } } if (found_tag && verify_tag) /* not external proc, so make tag */ { found_tag = FALSE; verify_tag = FALSE; pfnote (NULL, TRUE, tline.buffer, save_len, save_lineno, save_lcno); continue; } } if (get_tagname) /* grab name of proc or fn */ { int size; if (*dbp == '\0') continue; /* save all values for later tagging */ size = strlen (lb.buffer) + 1; while (size > tline.size) { tline.size *= 2; tline.buffer = (char *) xrealloc (tline.buffer, tline.size); } strcpy (tline.buffer, lb.buffer); save_lineno = lineno; save_lcno = linecharno; /* grab block name */ for (dbp++; *dbp && (!endtoken (*dbp)); dbp++) continue; save_len = dbp - lb.buffer + 1; get_tagname = FALSE; found_tag = TRUE; continue; /* and proceed to check for "extern" */ } else if (!incomment && !inquote && !found_tag) { /* check for proc/fn keywords */ switch (lowcase (c)) { case 'p': if (tail ("rocedure")) /* c = 'p', dbp has advanced */ get_tagname = TRUE; continue; case 'f': if (tail ("unction")) get_tagname = TRUE; continue; } } } /* while not eof */ free (tline.buffer); } /* * lisp tag functions * look for (def or (DEF, quote or QUOTE */ int L_isdef (strp) register char *strp; { return ((strp[1] == 'd' || strp[1] == 'D') && (strp[2] == 'e' || strp[2] == 'E') && (strp[3] == 'f' || strp[3] == 'F')); } int L_isquote (strp) register char *strp; { return ((*(++strp) == 'q' || *strp == 'Q') && (*(++strp) == 'u' || *strp == 'U') && (*(++strp) == 'o' || *strp == 'O') && (*(++strp) == 't' || *strp == 'T') && (*(++strp) == 'e' || *strp == 'E') && isspace(*(++strp))); } void L_getit () { register char *cp; if (*dbp == '\'') /* Skip prefix quote */ dbp++; else if (*dbp == '(' && L_isquote (dbp)) /* Skip "(quote " */ { dbp += 7; while (isspace(*dbp)) dbp++; } for (cp = dbp /*+1*/; *cp && *cp != '(' && *cp != ' ' && *cp != ')'; cp++) continue; if (cp == dbp) return; pfnote (NULL, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); } void Lisp_functions (inf) FILE *inf; { lineno = 0; charno = 0; while (!feof (inf)) { lineno++; linecharno = charno; charno += readline (&lb, inf); dbp = lb.buffer; if (dbp[0] == '(') { if (L_isdef (dbp)) { while (!isspace (*dbp)) dbp++; while (isspace (*dbp)) dbp++; L_getit (); } else { /* Check for (foo::defmumble name-defined ... */ do dbp++; while (*dbp && !isspace (*dbp) && *dbp != ':' && *dbp != '(' && *dbp != ')'); if (*dbp == ':') { do dbp++; while (*dbp == ':'); if (L_isdef (dbp - 1)) { while (!isspace (*dbp)) dbp++; while (isspace (*dbp)) dbp++; L_getit (); } } } } } } /* * Scheme tag functions * look for (def... xyzzy * look for (def... (xyzzy * look for (def ... ((...(xyzzy .... * look for (set! xyzzy */ void get_scheme (); void Scheme_functions (inf) FILE *inf; { lineno = 0; charno = 0; while (!feof (inf)) { lineno++; linecharno = charno; charno += readline (&lb, inf); dbp = lb.buffer; if (dbp[0] == '(' && (dbp[1] == 'D' || dbp[1] == 'd') && (dbp[2] == 'E' || dbp[2] == 'e') && (dbp[3] == 'F' || dbp[3] == 'f')) { while (!isspace (*dbp)) dbp++; /* Skip over open parens and white space */ while (*dbp && (isspace (*dbp) || *dbp == '(')) dbp++; get_scheme (); } if (dbp[0] == '(' && (dbp[1] == 'S' || dbp[1] == 's') && (dbp[2] == 'E' || dbp[2] == 'e') && (dbp[3] == 'T' || dbp[3] == 't') && (dbp[4] == '!' || dbp[4] == '!') && (isspace (dbp[5]))) { while (!isspace (*dbp)) dbp++; /* Skip over white space */ while (isspace (*dbp)) dbp++; get_scheme (); } } } void get_scheme () { register char *cp; if (*dbp == '\0') return; /* Go till you get to white space or a syntactic break */ for (cp = dbp + 1; *cp && *cp != '(' && *cp != ')' && !isspace (*cp); cp++) continue; pfnote (NULL, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); } /* Find tags in TeX and LaTeX input files. */ /* TEX_toktab is a table of TeX control sequences that define tags. Each TEX_tabent records one such control sequence. CONVERT THIS TO USE THE Stab TYPE!! */ struct TEX_tabent { char *name; int len; }; struct TEX_tabent *TEX_toktab = NULL; /* Table with tag tokens */ /* Default set of control sequences to put into TEX_toktab. The value of environment var TEXTAGS is prepended to this. */ char *TEX_defenv = "\ :chapter:section:subsection:subsubsection:eqno:label:ref:cite:bibitem\ :part:appendix:entry:index"; void TEX_mode (); struct TEX_tabent *TEX_decode_env (); int TEX_Token (); #if TeX_named_tokens void TEX_getit (); #endif char TEX_esc = '\\'; char TEX_opgrp = '{'; char TEX_clgrp = '}'; /* * TeX/LaTeX scanning loop. */ void TeX_functions (inf) FILE *inf; { char *lasthit; lineno = 0; charno = 0; /* Select either \ or ! as escape character. */ TEX_mode (inf); /* Initialize token table once from environment. */ if (!TEX_toktab) TEX_toktab = TEX_decode_env ("TEXTAGS", TEX_defenv); while (!feof (inf)) { /* Scan each line in file */ lineno++; linecharno = charno; charno += readline (&lb, inf); dbp = lb.buffer; lasthit = dbp; while (dbp = etags_strchr (dbp, TEX_esc)) /* Look at each esc in line */ { register int i; if (!*(++dbp)) break; linecharno += dbp - lasthit; lasthit = dbp; i = TEX_Token (lasthit); if (0 <= i) { pfnote (NULL, TRUE, lb.buffer, strlen (lb.buffer), lineno, linecharno); #if TeX_named_tokens TEX_getit (lasthit, TEX_toktab[i].len); #endif break; /* We only save a line once */ } } } } #define TEX_LESC '\\' #define TEX_SESC '!' #define TEX_cmt '%' /* Figure out whether TeX's escapechar is '\\' or '!' and set grouping chars accordingly. */ void TEX_mode (inf) FILE *inf; { int c; while ((c = getc (inf)) != EOF) { /* Skip to next line if we hit the TeX comment char. */ if (c == TEX_cmt) while (c != '\n') c = getc (inf); else if (c == TEX_LESC || c == TEX_SESC ) break; } if (c == TEX_LESC) { TEX_esc = TEX_LESC; TEX_opgrp = '{'; TEX_clgrp = '}'; } else { TEX_esc = TEX_SESC; TEX_opgrp = '<'; TEX_clgrp = '>'; } rewind (inf); } /* Read environment and prepend it to the default string. Build token table. */ struct TEX_tabent * TEX_decode_env (evarname, defenv) char *evarname; char *defenv; { register char *env, *p; struct TEX_tabent *tab; int size, i; /* Append default string to environment. */ env = getenv (evarname); if (!env) env = defenv; else env = concat (env, defenv, ""); /* Allocate a token table */ for (size = 1, p = env; p;) if ((p = etags_strchr (p, ':')) && *(++p)) size++; /* Add 1 to leave room for null terminator. */ tab = xnew (size + 1, struct TEX_tabent); /* Unpack environment string into token table. Be careful about */ /* zero-length strings (leading ':', "::" and trailing ':') */ for (i = 0; *env;) { p = etags_strchr (env, ':'); if (!p) /* End of environment string. */ p = env + strlen (env); if (p - env > 0) { /* Only non-zero strings. */ tab[i].name = savenstr (env, p - env); tab[i].len = strlen (tab[i].name); i++; } if (*p) env = p + 1; else { tab[i].name = NULL; /* Mark end of table. */ tab[i].len = 0; break; } } return tab; } #if TeX_named_tokens /* Record a tag defined by a TeX command of length LEN and starting at NAME. The name being defined actually starts at (NAME + LEN + 1). But we seem to include the TeX command in the tag name. */ void TEX_getit (name, len) char *name; int len; { char *p = name + len; if (*name == '\0') return; /* Let tag name extend to next group close (or end of line) */ while (*p && *p != TEX_clgrp) p++; pfnote (savenstr (name, p-name), TRUE, lb.buffer, strlen (lb.buffer), lineno, linecharno); } #endif /* If the text at CP matches one of the tag-defining TeX command names, return the pointer to the first occurrence of that command in TEX_toktab. Otherwise return -1. Keep the capital `T' in `Token' for dumb truncating compilers (this distinguishes it from `TEX_toktab' */ int TEX_Token (cp) char *cp; { int i; for (i = 0; TEX_toktab[i].len > 0; i++) if (strneq (TEX_toktab[i].name, cp, TEX_toktab[i].len)) return i; return -1; } /* Support for Prolog. */ /* Whole head (not only functor, but also arguments) is gotten in compound term. */ void prolog_getit (s) char *s; { char *save_s; int insquote, npar; save_s = s; insquote = FALSE; npar = 0; while (1) { if (s[0] == '\0') /* syntax error. */ return; else if (insquote && s[0] == '\'' && s[1] == '\'') s += 2; else if (s[0] == '\'') { insquote = !insquote; s++; } else if (!insquote && s[0] == '(') { npar++; s++; } else if (!insquote && s[0] == ')') { npar--; s++; if (npar == 0) break; else if (npar < 0) /* syntax error. */ return; } else if (!insquote && s[0] == '.' && (isspace (s[1]) || s[1] == '\0')) { /* fullstop. */ if (npar != 0) /* syntax error. */ return; s++; break; } else s++; } pfnote (NULL, TRUE, save_s, s-save_s, lineno, linecharno); } /* It is assumed that prolog predicate starts from column 0. */ void Prolog_functions (inf) FILE *inf; { void skip_comment (), prolog_getit (); lineno = linecharno = charno = 0; while (!feof (inf)) { lineno++; linecharno += charno; charno = readline (&lb, inf) + 1; /* 1 for newline. */ dbp = lb.buffer; if (isspace (dbp[0])) /* not predicate header. */ continue; else if (dbp[0] == '%') /* comment. */ continue; else if (dbp[0] == '/' && dbp[1] == '*') /* comment. */ skip_comment (&lb, inf, &lineno, &linecharno); else /* found. */ prolog_getit (dbp); } } void skip_comment (plb, inf, plineno, plinecharno) struct linebuffer *plb; FILE *inf; int *plineno; /* result */ long *plinecharno; /* result */ { char *cp; do { for (cp = plb->buffer; *cp != '\0'; cp++) if (cp[0] == '*' && cp[1] == '/') return; (*plineno)++; *plinecharno += readline (plb, inf) + 1; /* 1 for newline. */ } while (!feof(inf)); } #ifdef ETAGS_REGEXPS /* Take a string like "/blah/" and turn it into "blah", making sure that the first and last characters are the same, and handling quoted separator characters. Actually, stops on the occurence of an unquoted separator. Also turns "\t" into a Tab character. Returns pointer to terminating separator. Works in place. Null terminates name string. */ char * scan_separators (name) char *name; { char sep = name[0]; char *copyto = name; logical quoted = FALSE; for (++name; *name != '\0'; ++name) { if (quoted) { if (*name == 't') *copyto++ = '\t'; else if (*name == sep) *copyto++ = sep; else { /* Something else is quoted, so preserve the quote. */ *copyto++ = '\\'; *copyto++ = *name; } quoted = FALSE; } else if (*name == '\\') quoted = TRUE; else if (*name == sep) break; else *copyto++ = *name; } /* Terminate copied string. */ *copyto = '\0'; return name; } /* Turn a name, which is an ed-style (but Emacs syntax) regular expression, into a real regular expression by compiling it. */ void add_regex (regexp_pattern) char *regexp_pattern; { char *name; const char *err; struct re_pattern_buffer *patbuf; if (regexp_pattern == NULL) { /* Remove existing regexps. */ num_patterns = 0; patterns = NULL; return; } if (regexp_pattern[0] == '\0') { error ("missing regexp", 0); return; } if (regexp_pattern[strlen(regexp_pattern)-1] != regexp_pattern[0]) { error ("%s: unterminated regexp", regexp_pattern); return; } name = scan_separators (regexp_pattern); if (regexp_pattern[0] == '\0') { error ("null regexp", 0); return; } (void) scan_separators (name); patbuf = xnew (1, struct re_pattern_buffer); patbuf->translate = NULL; patbuf->fastmap = NULL; patbuf->buffer = NULL; patbuf->allocated = 0; err = re_compile_pattern (regexp_pattern, strlen (regexp_pattern), patbuf); if (err != NULL) { error ("%s while compiling pattern", err); return; } num_patterns += 1; if (num_patterns == 1) patterns = xnew (1, struct pattern); else patterns = ((struct pattern *) xrealloc (patterns, (num_patterns * sizeof (struct pattern)))); patterns[num_patterns - 1].pattern = patbuf; patterns[num_patterns - 1].name_pattern = savestr (name); patterns[num_patterns - 1].error_signaled = FALSE; } /* * Do the substitutions indicated by the regular expression and * arguments. */ char * substitute (in, out, regs) char *in, *out; struct re_registers *regs; { char *result = NULL, *t; int size = 0; /* Pass 1: figure out how much size to allocate. */ for (t = out; *t; ++t) { if (*t == '\\') { ++t; if (!*t) { fprintf (stderr, "%s: pattern subtitution ends prematurely\n", progname); return NULL; } if (isdigit (*t)) { int dig = *t - '0'; size += regs->end[dig] - regs->start[dig]; } } } /* Allocate space and do the substitutions. */ result = xnew (size + 1, char); size = 0; for (; *out; ++out) { if (*out == '\\') { ++out; if (isdigit (*out)) { /* Using "dig2" satisfies my debugger. Bleah. */ int dig2 = *out - '0'; strncpy (result + size, in + regs->start[dig2], regs->end[dig2] - regs->start[dig2]); size += regs->end[dig2] - regs->start[dig2]; } else result[size++] = *out; } else result[size++] = *out; } result[size] = '\0'; return result; } #endif /* ETAGS_REGEXPS */ /* Initialize a linebuffer for use */ void initbuffer (linebuffer) struct linebuffer *linebuffer; { linebuffer->size = 200; linebuffer->buffer = xnew (200, char); } /* * Read a line of text from `stream' into `linebuffer'. * Return the number of characters read from `stream', * which is the length of the line including the newline, if any. */ long readline_internal (linebuffer, stream) struct linebuffer *linebuffer; register FILE *stream; { char *buffer = linebuffer->buffer; register char *p = linebuffer->buffer; register char *pend; int chars_deleted; pend = p + linebuffer->size; /* Separate to avoid 386/IX compiler bug. */ while (1) { register int c = getc (stream); if (p == pend) { linebuffer->size *= 2; buffer = (char *) xrealloc (buffer, linebuffer->size); p += buffer - linebuffer->buffer; pend = buffer + linebuffer->size; linebuffer->buffer = buffer; } if (c == EOF) { chars_deleted = 0; break; } if (c == '\n') { if (p > buffer && p[-1] == '\r') { *--p = '\0'; chars_deleted = 2; } else { *p = '\0'; chars_deleted = 1; } break; } *p++ = c; } return p - buffer + chars_deleted; } /* * Like readline_internal, above, but try to match the input * line against any existing regular expressions. */ long readline (linebuffer, stream) struct linebuffer *linebuffer; FILE *stream; { /* Read new line. */ int i; long result = readline_internal (linebuffer, stream); #ifdef ETAGS_REGEXPS /* Match against all listed patterns. */ for (i = 0; i < num_patterns; ++i) { int match = re_match (patterns[i].pattern, linebuffer->buffer, (int)result, 0, &patterns[i].regs); switch (match) { case -2: /* Some error. */ if (!patterns[i].error_signaled) { error ("error while matching pattern %d", i); patterns[i].error_signaled = TRUE; } break; case -1: /* No match. */ break; default: /* Match occurred. Construct a tag. */ if (patterns[i].name_pattern[0] != '\0') { /* Make a named tag. */ char *name = substitute (linebuffer->buffer, patterns[i].name_pattern, &patterns[i].regs); if (name != NULL) pfnote (name, TRUE, linebuffer->buffer, match, lineno, linecharno); } else { /* Make an unnamed tag. */ pfnote (NULL, TRUE, linebuffer->buffer, match, lineno, linecharno); } break; } } #endif /* ETAGS_REGEXPS */ return result; } /* * Read a file, but do no processing. This is used to do regexp * matching on files that have no language defined. */ void just_read_file (inf) FILE *inf; { while (!feof (inf)) { ++lineno; linecharno = charno; charno += readline (&lb, inf) + 1; } } /* * Return a pointer to a space of size strlen(cp)+1 allocated * with xnew where the string CP has been copied. */ char * savestr (cp) char *cp; { return savenstr (cp, strlen (cp)); } /* * Return a pointer to a space of size LEN+1 allocated with xnew where * the string CP has been copied for at most the first LEN characters. */ char * savenstr (cp, len) char *cp; int len; { register char *dp; dp = xnew (len + 1, char); strncpy (dp, cp, len); dp[len] = '\0'; return dp; } /* * Return the ptr in sp at which the character c last * appears; NULL if not found * * Identical to System V strrchr, included for portability. */ char * etags_strrchr (sp, c) register char *sp, c; { register char *r; r = NULL; do { if (*sp == c) r = sp; } while (*sp++); return r; } /* * Return the ptr in sp at which the character c first * appears; NULL if not found * * Identical to System V strchr, included for portability. */ char * etags_strchr (sp, c) register char *sp, c; { do { if (*sp == c) return sp; } while (*sp++); return NULL; } /* Print error message and exit. */ void fatal (s1, s2) char *s1, *s2; { error (s1, s2); exit (BAD); } void pfatal (s1) char *s1; { perror (s1); exit (BAD); } /* Print error message. `s1' is printf control string, `s2' is arg for it. */ void error (s1, s2) char *s1, *s2; { fprintf (stderr, "%s: ", progname); fprintf (stderr, s1, s2); fprintf (stderr, "\n"); } /* Return a newly-allocated string whose contents concatenate those of s1, s2, s3. */ char * concat (s1, s2, s3) char *s1, *s2, *s3; { int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3); char *result = xnew (len1 + len2 + len3 + 1, char); strcpy (result, s1); strcpy (result + len1, s2); strcpy (result + len1 + len2, s3); result[len1 + len2 + len3] = '\0'; return result; } /* Does the same work as the system V getcwd, but does not need to guess the buffer size in advance. */ char * etags_getcwd () { #ifdef DOS_NT char *p, path[MAXPATHLEN + 1]; /* Fixed size is safe on MSDOS. */ getwd (path); p = path; while (*p) if (*p == '\\') *p++ = '/'; else *p++ = lowcase (*p); return strdup (path); #else /* not DOS_NT */ #if HAVE_GETCWD int bufsize = 200; char *path = xnew (bufsize, char); while (getcwd (path, bufsize) == NULL) { if (errno != ERANGE) pfatal ("getcwd"); bufsize *= 2; path = xnew (bufsize, char); } return path; #else /* not DOS_NT and not HAVE_GETCWD */ struct linebuffer path; FILE *pipe; initbuffer (&path); pipe = (FILE *) popen ("pwd 2>/dev/null", "r"); if (pipe == NULL || readline_internal (&path, pipe) == 0) pfatal ("pwd"); pclose (pipe); return path.buffer; #endif /* not HAVE_GETCWD */ #endif /* not DOS_NT */ } /* Return a newly allocated string containing the filename of FILE relative to the absolute directory DIR (which should end with a slash). */ char * relative_filename (file, dir) char *file, *dir; { char *fp, *dp, *abs, *res; /* Find the common root of file and dir. */ abs = absolute_filename (file, cwd); fp = abs; dp = dir; while (*fp++ == *dp++) continue; do { fp--; dp--; } while (*fp != '/'); /* Build a sequence of "../" strings for the resulting relative filename. */ for (dp = etags_strchr (dp + 1, '/'), res = ""; dp != NULL; dp = etags_strchr (dp + 1, '/')) { res = concat (res, "../", ""); } /* Add the filename relative to the common root of file and dir. */ res = concat (res, fp + 1, ""); free (abs); return res; } /* Return a newly allocated string containing the absolute filename of FILE given CWD (which should end with a slash). */ char * absolute_filename (file, cwd) char *file, *cwd; { char *slashp, *cp, *res; if (absolutefn (file)) res = concat (file, "", ""); else res = concat (cwd, file, ""); /* Delete the "/dirname/.." and "/." substrings. */ slashp = etags_strchr (res, '/'); while (slashp != NULL && slashp[0] != '\0') { if (slashp[1] == '.') { if (slashp[2] == '.' && (slashp[3] == '/' || slashp[3] == '\0')) { cp = slashp; do cp--; while (cp >= res && *cp != '/'); if (*cp == '/') { strcpy (cp, slashp + 3); } else /* else (cp == res) */ { if (slashp[3] != '\0') strcpy (cp, slashp + 4); else return "."; } slashp = cp; continue; } else if (slashp[2] == '/' || slashp[2] == '\0') { strcpy (slashp, slashp + 2); continue; } } slashp = etags_strchr (slashp + 1, '/'); } return res; } /* Return a newly allocated string containing the absolute filename of dir where FILE resides given CWD (which should end with a slash). */ char * absolute_dirname (file, cwd) char *file, *cwd; { char *slashp, *res; char save; slashp = etags_strrchr (file, '/'); if (slashp == NULL) return cwd; save = slashp[1]; slashp[1] = '\0'; res = absolute_filename (file, cwd); slashp[1] = save; return res; } /* Like malloc but get fatal error if memory is exhausted. */ long * xmalloc (size) unsigned int size; { long *result = (long *) malloc (size); if (result == NULL) fatal ("virtual memory exhausted", 0); return result; } long * xrealloc (ptr, size) char *ptr; unsigned int size; { long *result = (long *) realloc (ptr, size); if (result == NULL) fatal ("virtual memory exhausted"); return result; } emacs-19.30/lib-src/fakemail.c100444 75424 13 41260 6013167621 14335 0ustar kwzhuser/* sendmail-like interface to /bin/mail for system V, Copyright (C) 1985, 1994 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. */ #define NO_SHORTNAMES #include <../src/config.h> #if defined (BSD) && !defined (BSD4_1) && !defined (USE_FAKEMAIL) /* This program isnot used in BSD, so just avoid loader complaints. */ void main () { } #else /* not BSD 4.2 (or newer) */ #ifdef MSDOS void main () { } #else /* not MSDOS */ /* This conditional contains all the rest of the file. */ /* These are defined in config in some versions. */ #ifdef static #undef static #endif #ifdef read #undef read #undef write #undef open #undef close #endif #include #include #include #include #include /* Type definitions */ #define boolean int #define true 1 #define false 0 /* Various lists */ struct line_record { char *string; struct line_record *continuation; }; typedef struct line_record *line_list; struct header_record { line_list text; struct header_record *next; struct header_record *previous; }; typedef struct header_record *header; struct stream_record { FILE *handle; int (*action)(); struct stream_record *rest_streams; }; typedef struct stream_record *stream_list; /* A `struct linebuffer' is a structure which holds a line of text. * `readline' reads a line from a stream into a linebuffer * and works regardless of the length of the line. */ struct linebuffer { long size; char *buffer; }; struct linebuffer lb; #define new_list() \ ((line_list) xmalloc (sizeof (struct line_record))) #define new_header() \ ((header) xmalloc (sizeof (struct header_record))) #define new_stream() \ ((stream_list) xmalloc (sizeof (struct stream_record))) #define alloc_string(nchars) \ ((char *) xmalloc ((nchars) + 1)) /* Global declarations */ #define BUFLEN 1024 #define KEYWORD_SIZE 256 #define FROM_PREFIX "From" #define MY_NAME "fakemail" #define NIL ((line_list) NULL) #define INITIAL_LINE_SIZE 200 #ifndef MAIL_PROGRAM_NAME #define MAIL_PROGRAM_NAME "/bin/mail" #endif static char *my_name; static char *the_date; static char *the_user; static line_list file_preface; static stream_list the_streams; static boolean no_problems = true; extern FILE *popen (); extern int fclose (), pclose (); #ifdef CURRENT_USER extern struct passwd *getpwuid (); extern unsigned short geteuid (); static struct passwd *my_entry; #define cuserid(s) \ (my_entry = getpwuid (((int) geteuid ())), \ my_entry->pw_name) #endif /* Utilities */ /* Print error message. `s1' is printf control string, `s2' is arg for it. */ static void error (s1, s2) char *s1, *s2; { printf ("%s: ", my_name); printf (s1, s2); printf ("\n"); no_problems = false; } /* Print error message and exit. */ static void fatal (s1, s2) char *s1, *s2; { error (s1, s2); exit (1); } /* Like malloc but get fatal error if memory is exhausted. */ static long * xmalloc (size) int size; { long *result = (long *) malloc (((unsigned) size)); if (result == ((long *) NULL)) fatal ("virtual memory exhausted", 0); return result; } static long * xrealloc (ptr, size) long *ptr; int size; { long *result = (long *) realloc (ptr, ((unsigned) size)); if (result == ((long *) NULL)) fatal ("virtual memory exhausted"); return result; } /* Initialize a linebuffer for use */ void init_linebuffer (linebuffer) struct linebuffer *linebuffer; { linebuffer->size = INITIAL_LINE_SIZE; linebuffer->buffer = ((char *) xmalloc (INITIAL_LINE_SIZE)); } /* Read a line of text from `stream' into `linebuffer'. * Return the length of the line. */ long readline (linebuffer, stream) struct linebuffer *linebuffer; FILE *stream; { char *buffer = linebuffer->buffer; char *p = linebuffer->buffer; char *end = p + linebuffer->size; while (true) { int c = getc (stream); if (p == end) { linebuffer->size *= 2; buffer = ((char *) xrealloc (buffer, linebuffer->size)); p = buffer + (p - linebuffer->buffer); end = buffer + linebuffer->size; linebuffer->buffer = buffer; } if (c < 0 || c == '\n') { *p = 0; break; } *p++ = c; } return p - buffer; } /* Extract a colon-terminated keyword from the string FIELD. Return that keyword as a string stored in a static buffer. Store the address of the rest of the string into *REST. If there is no keyword, return NULL and don't alter *REST. */ char * get_keyword (field, rest) register char *field; char **rest; { static char keyword[KEYWORD_SIZE]; register char *ptr; register char c; ptr = &keyword[0]; c = *field++; if (isspace (c) || c == ':') return ((char *) NULL); *ptr++ = (islower (c) ? toupper (c) : c); while (((c = *field++) != ':') && ! isspace (c)) *ptr++ = (islower (c) ? toupper (c) : c); *ptr++ = '\0'; while (isspace (c)) c = *field++; if (c != ':') return ((char *) NULL); *rest = field; return &keyword[0]; } /* Nonzero if the string FIELD starts with a colon-terminated keyword. */ boolean has_keyword (field) char *field; { char *ignored; return (get_keyword (field, &ignored) != ((char *) NULL)); } /* Store the string FIELD, followed by any lines in THE_LIST, into the buffer WHERE. Concatenate lines, putting just a space between them. Delete everything contained in parentheses. When a recipient name contains <...>, we discard everything except what is inside the <...>. We don't pay attention to overflowing WHERE; the caller has to make it big enough. */ char * add_field (the_list, field, where) line_list the_list; register char *field, *where; { register char c; while (true) { char *this_recipient_where; int in_quotes = 0; *where++ = ' '; this_recipient_where = where; while ((c = *field++) != '\0') { if (c == '\\') *where++ = c; else if (c == '"') { in_quotes = ! in_quotes; *where++ = c; } else if (in_quotes) *where++ = c; else if (c == '(') { while (*field && *field != ')') ++field; if (! (*field++)) break; /* no close */ continue; } else if (c == ',') { *where++ = ' '; /* When we get to the end of one recipient, don't discard it if the next one has <...>. */ this_recipient_where = where; } else if (c == '<') /* Discard everything we got before the `<'. */ where = this_recipient_where; else if (c == '>') /* Discard the rest of this name that follows the `>'. */ { while (*field && *field != ',') ++field; if (! (*field++)) break; /* no comma */ continue; } else *where++ = c; } if (the_list == NIL) break; field = the_list->string; the_list = the_list->continuation; } return where; } line_list make_file_preface () { char *the_string, *temp; long idiotic_interface; long prefix_length; long user_length; long date_length; line_list result; prefix_length = strlen (FROM_PREFIX); time (&idiotic_interface); the_date = ctime (&idiotic_interface); /* the_date has an unwanted newline at the end */ date_length = strlen (the_date) - 1; the_date[date_length] = '\0'; temp = cuserid ((char *) NULL); user_length = strlen (temp); the_user = alloc_string (user_length + 1); strcpy (the_user, temp); the_string = alloc_string (3 + prefix_length + user_length + date_length); temp = the_string; strcpy (temp, FROM_PREFIX); temp = &temp[prefix_length]; *temp++ = ' '; strcpy (temp, the_user); temp = &temp[user_length]; *temp++ = ' '; strcpy (temp, the_date); result = new_list (); result->string = the_string; result->continuation = ((line_list) NULL); return result; } void write_line_list (the_list, the_stream) register line_list the_list; FILE *the_stream; { for ( ; the_list != ((line_list) NULL) ; the_list = the_list->continuation) { fputs (the_list->string, the_stream); putc ('\n', the_stream); } return; } int close_the_streams () { register stream_list rem; for (rem = the_streams; rem != ((stream_list) NULL); rem = rem->rest_streams) no_problems = (no_problems && ((*rem->action) (rem->handle) == 0)); the_streams = ((stream_list) NULL); return (no_problems ? 0 : 1); } void add_a_stream (the_stream, closing_action) FILE *the_stream; int (*closing_action)(); { stream_list old = the_streams; the_streams = new_stream (); the_streams->handle = the_stream; the_streams->action = closing_action; the_streams->rest_streams = old; return; } int my_fclose (the_file) FILE *the_file; { putc ('\n', the_file); fflush (the_file); return fclose (the_file); } boolean open_a_file (name) char *name; { FILE *the_stream = fopen (name, "a"); if (the_stream != ((FILE *) NULL)) { add_a_stream (the_stream, my_fclose); if (the_user == ((char *) NULL)) file_preface = make_file_preface (); write_line_list (file_preface, the_stream); return true; } return false; } void put_string (s) char *s; { register stream_list rem; for (rem = the_streams; rem != ((stream_list) NULL); rem = rem->rest_streams) fputs (s, rem->handle); return; } void put_line (string) char *string; { register stream_list rem; for (rem = the_streams; rem != ((stream_list) NULL); rem = rem->rest_streams) { char *s = string; int column = 0; /* Divide STRING into lines. */ while (*s != 0) { char *breakpos; /* Find the last char that fits. */ for (breakpos = s; *breakpos && column < 78; ++breakpos) { if (*breakpos == '\t') column += 8; else column++; } /* If we didn't reach end of line, break the line. */ if (*breakpos) { /* Back up to just after the last comma that fits. */ while (breakpos != s && breakpos[-1] != ',') --breakpos; if (breakpos == s) { /* If no comma fits, move past the first address anyway. */ while (*breakpos != 0 && *breakpos != ',') ++breakpos; if (*breakpos != 0) /* Include the comma after it. */ ++breakpos; } } /* Output that much, then break the line. */ fwrite (s, 1, breakpos - s, rem->handle); column = 8; /* Skip whitespace and prepare to print more addresses. */ s = breakpos; while (*s == ' ' || *s == '\t') ++s; if (*s != 0) fputs ("\n\t", rem->handle); } putc ('\n', rem->handle); } return; } #define mail_error error /* Handle an FCC field. FIELD is the text of the first line (after the header name), and THE_LIST holds the continuation lines if any. Call open_a_file for each file. */ void setup_files (the_list, field) register line_list the_list; register char *field; { register char *start; register char c; while (true) { while (((c = *field) != '\0') && (c == ' ' || c == '\t' || c == ',')) field += 1; if (c != '\0') { start = field; while (((c = *field) != '\0') && c != ' ' && c != '\t' && c != ',') field += 1; *field = '\0'; if (!open_a_file (start)) mail_error ("Could not open file %s", start); *field = c; if (c != '\0') continue; } if (the_list == ((line_list) NULL)) return; field = the_list->string; the_list = the_list->continuation; } } /* Compute the total size of all recipient names stored in THE_HEADER. The result says how big to make the buffer to pass to parse_header. */ int args_size (the_header) header the_header; { register header old = the_header; register line_list rem; register int size = 0; do { char *field; register char *keyword = get_keyword (the_header->text->string, &field); if ((strcmp (keyword, "TO") == 0) || (strcmp (keyword, "CC") == 0) || (strcmp (keyword, "BCC") == 0)) { size += 1 + strlen (field); for (rem = the_header->text->continuation; rem != NIL; rem = rem->continuation) size += 1 + strlen (rem->string); } the_header = the_header->next; } while (the_header != old); return size; } /* Scan the header described by the lists THE_HEADER, and put all recipient names into the buffer WHERE. Precede each recipient name with a space. Also, if the header has any FCC fields, call setup_files for each one. */ parse_header (the_header, where) header the_header; register char *where; { register header old = the_header; do { char *field; register char *keyword = get_keyword (the_header->text->string, &field); if (strcmp (keyword, "TO") == 0) where = add_field (the_header->text->continuation, field, where); else if (strcmp (keyword, "CC") == 0) where = add_field (the_header->text->continuation, field, where); else if (strcmp (keyword, "BCC") == 0) { where = add_field (the_header->text->continuation, field, where); the_header->previous->next = the_header->next; the_header->next->previous = the_header->previous; } else if (strcmp (keyword, "FCC") == 0) setup_files (the_header->text->continuation, field); the_header = the_header->next; } while (the_header != old); *where = '\0'; return; } /* Read lines from the input until we get a blank line. Create a list of `header' objects, one for each header field, each of which points to a list of `line_list' objects, one for each line in that field. Continuation lines are grouped in the headers they continue. */ header read_header () { register header the_header = ((header) NULL); register line_list *next_line = ((line_list *) NULL); init_linebuffer (&lb); do { long length; register char *line; readline (&lb, stdin); line = lb.buffer; length = strlen (line); if (length == 0) break; if (has_keyword (line)) { register header old = the_header; the_header = new_header (); if (old == ((header) NULL)) { the_header->next = the_header; the_header->previous = the_header; } else { the_header->previous = old; the_header->next = old->next; old->next = the_header; } next_line = &(the_header->text); } if (next_line == ((line_list *) NULL)) { /* Not a valid header */ exit (1); } *next_line = new_list (); (*next_line)->string = alloc_string (length); strcpy (((*next_line)->string), line); next_line = &((*next_line)->continuation); *next_line = NIL; } while (true); return the_header->next; } void write_header (the_header) header the_header; { register header old = the_header; do { register line_list the_list; for (the_list = the_header->text; the_list != NIL; the_list = the_list->continuation) put_line (the_list->string); the_header = the_header->next; } while (the_header != old); put_line (""); return; } void main (argc, argv) int argc; char **argv; { char *command_line; header the_header; long name_length; char *mail_program_name; char buf[BUFLEN + 1]; register int size; FILE *the_pipe; extern char *getenv (); mail_program_name = getenv ("FAKEMAILER"); if (!(mail_program_name && *mail_program_name)) mail_program_name = MAIL_PROGRAM_NAME; name_length = strlen (mail_program_name); my_name = MY_NAME; the_streams = ((stream_list) NULL); the_date = ((char *) NULL); the_user = ((char *) NULL); the_header = read_header (); command_line = alloc_string (name_length + args_size (the_header)); strcpy (command_line, mail_program_name); parse_header (the_header, &command_line[name_length]); the_pipe = popen (command_line, "w"); if (the_pipe == ((FILE *) NULL)) fatal ("cannot open pipe to real mailer"); add_a_stream (the_pipe, pclose); write_header (the_header); /* Dump the message itself */ while (!feof (stdin)) { size = fread (buf, 1, BUFLEN, stdin); buf[size] = '\0'; put_string (buf); } exit (close_the_streams ()); } #endif /* not MSDOS */ #endif /* not BSD 4.2 (or newer) */ emacs-19.30/lib-src/getdate.c100666 12241 13 137770 6054642100 14516 0ustar rolanduser /* A Bison parser, made from getdate.y with Bison version GNU Bison version 1.22 */ #define YYBISON 1 /* Identify Bison output. */ #define tAGO 258 #define tDAY 259 #define tDAYZONE 260 #define tID 261 #define tMERIDIAN 262 #define tMINUTE_UNIT 263 #define tMONTH 264 #define tMONTH_UNIT 265 #define tSEC_UNIT 266 #define tSNUMBER 267 #define tUNUMBER 268 #define tZONE 269 #define tDST 270 #line 1 "getdate.y" /* ** Originally written by Steven M. Bellovin while ** at the University of North Carolina at Chapel Hill. Later tweaked by ** a couple of people on Usenet. Completely overhauled by Rich $alz ** and Jim Berets in August, 1990; ** send any email to Rich. ** ** This grammar has 10 shift/reduce conflicts. ** ** This code is in the public domain and has no copyright. */ /* SUPPRESS 287 on yaccpar_sccsid *//* Unused static variable */ /* SUPPRESS 288 on yyerrlab *//* Label unused */ #ifdef HAVE_CONFIG_H #include #ifdef FORCE_ALLOCA_H #include #endif #endif /* Since the code of getdate.y is not included in the Emacs executable itself, there is no need to #define static in this file. Even if the code were included in the Emacs executable, it probably wouldn't do any harm to #undef it here; this will only cause problems if we try to write to a static variable, which I don't think this code needs to do. */ #ifdef emacs #undef static #endif #include #include #if defined (vms) #include #include #else #include #ifdef TIME_WITH_SYS_TIME #include #include #else #ifdef HAVE_SYS_TIME_H #include #else #include #endif #endif #ifdef timezone #undef timezone /* needed for sgi */ #endif #if defined (HAVE_SYS_TIMEB_H) #include #else /* get_date uses the obsolete `struct timeb' in its interface! FIXME. Since some systems don't have it, we define it here; callers must do likewise. */ struct timeb { time_t time; /* Seconds since the epoch */ unsigned short millitm; /* Field not used */ short timezone; /* Minutes west of GMT */ short dstflag; /* Field not used */ }; #endif /* defined (HAVE_SYS_TIMEB_H) */ #endif /* defined (vms) */ #if defined (STDC_HEADERS) || defined (USG) #include #endif /* Some old versions of bison generate parsers that use bcopy. That loses on systems that don't provide the function, so we have to redefine it here. */ #if !defined (HAVE_BCOPY) && defined (HAVE_MEMCPY) && !defined (bcopy) #define bcopy(from, to, len) memcpy ((to), (from), (len)) #endif extern struct tm *gmtime (); extern struct tm *localtime (); #define yyparse getdate_yyparse #define yylex getdate_yylex #define yyerror getdate_yyerror static int yylex (); static int yyerror (); #define EPOCH 1970 #define HOUR(x) ((time_t)(x) * 60) #define SECSPERDAY (24L * 60L * 60L) #define MAX_BUFF_LEN 128 /* size of buffer to read the date into */ /* ** An entry in the lexical lookup table. */ typedef struct _TABLE { const char *name; int type; time_t value; } TABLE; /* ** Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; /* ** Meridian: am, pm, or 24-hour style. */ typedef enum _MERIDIAN { MERam, MERpm, MER24 } MERIDIAN; /* ** Global variables. We could get rid of most of these by using a good ** union as the yacc stack. (This routine was originally written before ** yacc had the %union construct.) Maybe someday; right now we only use ** the %union very rarely. */ static char *yyInput; static DSTMODE yyDSTmode; static time_t yyDayOrdinal; static time_t yyDayNumber; static int yyHaveDate; static int yyHaveDay; static int yyHaveRel; static int yyHaveTime; static int yyHaveZone; static time_t yyTimezone; static time_t yyDay; static time_t yyHour; static time_t yyMinutes; static time_t yyMonth; static time_t yySeconds; static time_t yyYear; static MERIDIAN yyMeridian; static time_t yyRelMonth; static time_t yyRelSeconds; #line 155 "getdate.y" typedef union { time_t Number; enum _MERIDIAN Meridian; } YYSTYPE; #ifndef YYLTYPE typedef struct yyltype { int timestamp; int first_line; int first_column; int last_line; int last_column; char *text; } yyltype; #define YYLTYPE yyltype #endif #include #ifndef __cplusplus #ifndef __STDC__ #define const #endif #endif #define YYFINAL 52 #define YYFLAG -32768 #define YYNTBASE 19 #define YYTRANSLATE(x) ((unsigned)(x) <= 270 ? yytranslate[x] : 29) static const char yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 2, 2, 18, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 16, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 }; #if YYDEBUG != 0 static const short yyprhs[] = { 0, 0, 1, 4, 6, 8, 10, 12, 14, 16, 19, 24, 29, 36, 43, 45, 47, 50, 52, 55, 58, 62, 68, 72, 76, 79, 84, 87, 91, 94, 96, 99, 102, 104, 107, 110, 112, 115, 118, 120, 122, 123 }; static const short yyrhs[] = { -1, 19, 20, 0, 21, 0, 22, 0, 24, 0, 23, 0, 25, 0, 27, 0, 13, 7, 0, 13, 16, 13, 28, 0, 13, 16, 13, 12, 0, 13, 16, 13, 16, 13, 28, 0, 13, 16, 13, 16, 13, 12, 0, 14, 0, 5, 0, 14, 15, 0, 4, 0, 4, 17, 0, 13, 4, 0, 13, 18, 13, 0, 13, 18, 13, 18, 13, 0, 13, 12, 12, 0, 13, 9, 12, 0, 9, 13, 0, 9, 13, 17, 13, 0, 13, 9, 0, 13, 9, 13, 0, 26, 3, 0, 26, 0, 13, 8, 0, 12, 8, 0, 8, 0, 12, 11, 0, 13, 11, 0, 11, 0, 12, 10, 0, 13, 10, 0, 10, 0, 13, 0, 0, 7, 0 }; #endif #if YYDEBUG != 0 static const short yyrline[] = { 0, 169, 170, 173, 176, 179, 182, 185, 188, 191, 197, 203, 210, 216, 226, 230, 234, 241, 245, 249, 255, 259, 264, 270, 276, 280, 285, 289, 296, 300, 303, 306, 309, 312, 315, 318, 321, 324, 327, 332, 359, 362 }; static const char * const yytname[] = { "$","error","$illegal.","tAGO","tDAY", "tDAYZONE","tID","tMERIDIAN","tMINUTE_UNIT","tMONTH","tMONTH_UNIT","tSEC_UNIT", "tSNUMBER","tUNUMBER","tZONE","tDST","':'","','","'/'","spec","item","time", "zone","day","date","rel","relunit","number","o_merid","" }; #endif static const short yyr1[] = { 0, 19, 19, 20, 20, 20, 20, 20, 20, 21, 21, 21, 21, 21, 22, 22, 22, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 28, 28 }; static const short yyr2[] = { 0, 0, 2, 1, 1, 1, 1, 1, 1, 2, 4, 4, 6, 6, 1, 1, 2, 1, 2, 2, 3, 5, 3, 3, 2, 4, 2, 3, 2, 1, 2, 2, 1, 2, 2, 1, 2, 2, 1, 1, 0, 1 }; static const short yydefact[] = { 1, 0, 17, 15, 32, 0, 38, 35, 0, 39, 14, 2, 3, 4, 6, 5, 7, 29, 8, 18, 24, 31, 36, 33, 19, 9, 30, 26, 37, 34, 0, 0, 0, 16, 28, 0, 23, 27, 22, 40, 20, 25, 41, 11, 0, 10, 0, 40, 21, 13, 12, 0, 0 }; static const short yydefgoto[] = { 1, 11, 12, 13, 14, 15, 16, 17, 18, 45 }; static const short yypact[] = {-32768, 0, -1,-32768,-32768, 4,-32768,-32768, 25, 11, -8, -32768,-32768,-32768,-32768,-32768,-32768, 21,-32768,-32768, 9, -32768,-32768,-32768,-32768,-32768,-32768, -10,-32768,-32768, 16, 19, 24,-32768,-32768, 26,-32768,-32768,-32768, 18, 13, -32768,-32768,-32768, 27,-32768, 28, -6,-32768,-32768,-32768, 38,-32768 }; static const short yypgoto[] = {-32768, -32768,-32768,-32768,-32768,-32768,-32768,-32768,-32768, -5 }; #define YYLAST 42 static const short yytable[] = { 51, 42, 36, 37, 2, 3, 49, 33, 4, 5, 6, 7, 8, 9, 10, 24, 19, 20, 25, 26, 27, 28, 29, 30, 34, 42, 35, 31, 38, 32, 43, 46, 39, 21, 44, 22, 23, 40, 52, 41, 47, 48, 50 }; static const short yycheck[] = { 0, 7, 12, 13, 4, 5, 12, 15, 8, 9, 10, 11, 12, 13, 14, 4, 17, 13, 7, 8, 9, 10, 11, 12, 3, 7, 17, 16, 12, 18, 12, 18, 13, 8, 16, 10, 11, 13, 0, 13, 13, 13, 47 }; /* -*-C-*- Note some compilers choke on comments on `#line' lines. */ #line 3 "/usr/local/lib/bison.simple" /* Skeleton output parser for bison, Copyright (C) 1984, 1989, 1990 Bob Corbett and Richard Stallman This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef alloca #ifdef __GNUC__ #define alloca __builtin_alloca #else /* not GNU C. */ #if (!defined (__STDC__) && defined (sparc)) || defined (__sparc__) || defined (__sparc) || defined (__sgi) #include #else /* not sparc */ #if defined (MSDOS) && !defined (__TURBOC__) #include #else /* not MSDOS, or __TURBOC__ */ #if defined(_AIX) #include #pragma alloca #else /* not MSDOS, __TURBOC__, or _AIX */ #ifdef __hpux #ifdef __cplusplus extern "C" { void *alloca (unsigned int); }; #else /* not __cplusplus */ void *alloca (); #endif /* not __cplusplus */ #endif /* __hpux */ #endif /* not _AIX */ #endif /* not MSDOS, or __TURBOC__ */ #endif /* not sparc. */ #endif /* not GNU C. */ #endif /* alloca not defined. */ /* This is the parser code that is written into each bison parser when the %semantic_parser declaration is not specified in the grammar. It was written by Richard Stallman by simplifying the hairy parser used when %semantic_parser is specified. */ /* Note: there must be only one dollar sign in this file. It is replaced by the list of actions, each action as one case of the switch. */ #define yyerrok (yyerrstatus = 0) #define yyclearin (yychar = YYEMPTY) #define YYEMPTY -2 #define YYEOF 0 #define YYACCEPT return(0) #define YYABORT return(1) #define YYERROR goto yyerrlab1 /* Like YYERROR except do call yyerror. This remains here temporarily to ease the transition to the new meaning of YYERROR, for GCC. Once GCC version 2 has supplanted version 1, this can go. */ #define YYFAIL goto yyerrlab #define YYRECOVERING() (!!yyerrstatus) #define YYBACKUP(token, value) \ do \ if (yychar == YYEMPTY && yylen == 1) \ { yychar = (token), yylval = (value); \ yychar1 = YYTRANSLATE (yychar); \ YYPOPSTACK; \ goto yybackup; \ } \ else \ { yyerror ("syntax error: cannot back up"); YYERROR; } \ while (0) #define YYTERROR 1 #define YYERRCODE 256 #ifndef YYPURE #define YYLEX yylex() #endif #ifdef YYPURE #ifdef YYLSP_NEEDED #define YYLEX yylex(&yylval, &yylloc) #else #define YYLEX yylex(&yylval) #endif #endif /* If nonreentrant, generate the variables here */ #ifndef YYPURE int yychar; /* the lookahead symbol */ YYSTYPE yylval; /* the semantic value of the */ /* lookahead symbol */ #ifdef YYLSP_NEEDED YYLTYPE yylloc; /* location data for the lookahead */ /* symbol */ #endif int yynerrs; /* number of parse errors so far */ #endif /* not YYPURE */ #if YYDEBUG != 0 int yydebug; /* nonzero means print parse trace */ /* Since this is uninitialized, it does not stop multiple parsers from coexisting. */ #endif /* YYINITDEPTH indicates the initial size of the parser's stacks */ #ifndef YYINITDEPTH #define YYINITDEPTH 200 #endif /* YYMAXDEPTH is the maximum size the stacks can grow to (effective only if the built-in stack extension method is used). */ #if YYMAXDEPTH == 0 #undef YYMAXDEPTH #endif #ifndef YYMAXDEPTH #define YYMAXDEPTH 10000 #endif /* Prevent warning if -Wstrict-prototypes. */ #ifdef __GNUC__ int yyparse (void); #endif #if __GNUC__ > 1 /* GNU C and GNU C++ define this. */ #define __yy_bcopy(FROM,TO,COUNT) __builtin_memcpy(TO,FROM,COUNT) #else /* not GNU C or C++ */ #ifndef __cplusplus /* This is the most reliable way to avoid incompatibilities in available built-in functions on various systems. */ static void __yy_bcopy (from, to, count) char *from; char *to; int count; { register char *f = from; register char *t = to; register int i = count; while (i-- > 0) *t++ = *f++; } #else /* __cplusplus */ /* This is the most reliable way to avoid incompatibilities in available built-in functions on various systems. */ static void __yy_bcopy (char *from, char *to, int count) { register char *f = from; register char *t = to; register int i = count; while (i-- > 0) *t++ = *f++; } #endif #endif #line 184 "/usr/local/lib/bison.simple" /* The user can define YYPARSE_PARAM as the name of an argument to be passed into yyparse. The argument should have type void *. It should actually point to an object. Grammar actions can access the variable by casting it to the proper pointer type. */ #ifdef YYPARSE_PARAM #define YYPARSE_PARAM_DECL void *YYPARSE_PARAM; #else #define YYPARSE_PARAM #define YYPARSE_PARAM_DECL #endif int yyparse(YYPARSE_PARAM) YYPARSE_PARAM_DECL { register int yystate; register int yyn; register short *yyssp; register YYSTYPE *yyvsp; int yyerrstatus; /* number of tokens to shift before error messages enabled */ int yychar1 = 0; /* lookahead token as an internal (translated) token number */ short yyssa[YYINITDEPTH]; /* the state stack */ YYSTYPE yyvsa[YYINITDEPTH]; /* the semantic value stack */ short *yyss = yyssa; /* refer to the stacks thru separate pointers */ YYSTYPE *yyvs = yyvsa; /* to allow yyoverflow to reallocate them elsewhere */ #ifdef YYLSP_NEEDED YYLTYPE yylsa[YYINITDEPTH]; /* the location stack */ YYLTYPE *yyls = yylsa; YYLTYPE *yylsp; #define YYPOPSTACK (yyvsp--, yyssp--, yylsp--) #else #define YYPOPSTACK (yyvsp--, yyssp--) #endif int yystacksize = YYINITDEPTH; #ifdef YYPURE int yychar; YYSTYPE yylval; int yynerrs; #ifdef YYLSP_NEEDED YYLTYPE yylloc; #endif #endif YYSTYPE yyval; /* the variable used to return */ /* semantic values from the action */ /* routines */ int yylen; #if YYDEBUG != 0 if (yydebug) fprintf(stderr, "Starting parse\n"); #endif yystate = 0; yyerrstatus = 0; yynerrs = 0; yychar = YYEMPTY; /* Cause a token to be read. */ /* Initialize stack pointers. Waste one element of value and location stack so that they stay on the same level as the state stack. The wasted elements are never initialized. */ yyssp = yyss - 1; yyvsp = yyvs; #ifdef YYLSP_NEEDED yylsp = yyls; #endif /* Push a new state, which is found in yystate . */ /* In all cases, when you get here, the value and location stacks have just been pushed. so pushing a state here evens the stacks. */ yynewstate: *++yyssp = yystate; if (yyssp >= yyss + yystacksize - 1) { /* Give user a chance to reallocate the stack */ /* Use copies of these so that the &'s don't force the real ones into memory. */ YYSTYPE *yyvs1 = yyvs; short *yyss1 = yyss; #ifdef YYLSP_NEEDED YYLTYPE *yyls1 = yyls; #endif /* Get the current used size of the three stacks, in elements. */ int size = yyssp - yyss + 1; #ifdef yyoverflow /* Each stack pointer address is followed by the size of the data in use in that stack, in bytes. */ #ifdef YYLSP_NEEDED /* This used to be a conditional around just the two extra args, but that might be undefined if yyoverflow is a macro. */ yyoverflow("parser stack overflow", &yyss1, size * sizeof (*yyssp), &yyvs1, size * sizeof (*yyvsp), &yyls1, size * sizeof (*yylsp), &yystacksize); #else yyoverflow("parser stack overflow", &yyss1, size * sizeof (*yyssp), &yyvs1, size * sizeof (*yyvsp), &yystacksize); #endif yyss = yyss1; yyvs = yyvs1; #ifdef YYLSP_NEEDED yyls = yyls1; #endif #else /* no yyoverflow */ /* Extend the stack our own way. */ if (yystacksize >= YYMAXDEPTH) { yyerror("parser stack overflow"); return 2; } yystacksize *= 2; if (yystacksize > YYMAXDEPTH) yystacksize = YYMAXDEPTH; yyss = (short *) alloca (yystacksize * sizeof (*yyssp)); __yy_bcopy ((char *)yyss1, (char *)yyss, size * sizeof (*yyssp)); yyvs = (YYSTYPE *) alloca (yystacksize * sizeof (*yyvsp)); __yy_bcopy ((char *)yyvs1, (char *)yyvs, size * sizeof (*yyvsp)); #ifdef YYLSP_NEEDED yyls = (YYLTYPE *) alloca (yystacksize * sizeof (*yylsp)); __yy_bcopy ((char *)yyls1, (char *)yyls, size * sizeof (*yylsp)); #endif #endif /* no yyoverflow */ yyssp = yyss + size - 1; yyvsp = yyvs + size - 1; #ifdef YYLSP_NEEDED yylsp = yyls + size - 1; #endif #if YYDEBUG != 0 if (yydebug) fprintf(stderr, "Stack size increased to %d\n", yystacksize); #endif if (yyssp >= yyss + yystacksize - 1) YYABORT; } #if YYDEBUG != 0 if (yydebug) fprintf(stderr, "Entering state %d\n", yystate); #endif goto yybackup; yybackup: /* Do appropriate processing given the current state. */ /* Read a lookahead token if we need one and don't already have one. */ /* yyresume: */ /* First try to decide what to do without reference to lookahead token. */ yyn = yypact[yystate]; if (yyn == YYFLAG) goto yydefault; /* Not known => get a lookahead token if don't already have one. */ /* yychar is either YYEMPTY or YYEOF or a valid token in external form. */ if (yychar == YYEMPTY) { #if YYDEBUG != 0 if (yydebug) fprintf(stderr, "Reading a token: "); #endif yychar = YYLEX; } /* Convert token to internal form (in yychar1) for indexing tables with */ if (yychar <= 0) /* This means end of input. */ { yychar1 = 0; yychar = YYEOF; /* Don't call YYLEX any more */ #if YYDEBUG != 0 if (yydebug) fprintf(stderr, "Now at end of input.\n"); #endif } else { yychar1 = YYTRANSLATE(yychar); #if YYDEBUG != 0 if (yydebug) { fprintf (stderr, "Next token is %d (%s", yychar, yytname[yychar1]); /* Give the individual parser a way to print the precise meaning of a token, for further debugging info. */ #ifdef YYPRINT YYPRINT (stderr, yychar, yylval); #endif fprintf (stderr, ")\n"); } #endif } yyn += yychar1; if (yyn < 0 || yyn > YYLAST || yycheck[yyn] != yychar1) goto yydefault; yyn = yytable[yyn]; /* yyn is what to do for this token type in this state. Negative => reduce, -yyn is rule number. Positive => shift, yyn is new state. New state is final state => don't bother to shift, just return success. 0, or most negative number => error. */ if (yyn < 0) { if (yyn == YYFLAG) goto yyerrlab; yyn = -yyn; goto yyreduce; } else if (yyn == 0) goto yyerrlab; if (yyn == YYFINAL) YYACCEPT; /* Shift the lookahead token. */ #if YYDEBUG != 0 if (yydebug) fprintf(stderr, "Shifting token %d (%s), ", yychar, yytname[yychar1]); #endif /* Discard the token being shifted unless it is eof. */ if (yychar != YYEOF) yychar = YYEMPTY; *++yyvsp = yylval; #ifdef YYLSP_NEEDED *++yylsp = yylloc; #endif /* count tokens shifted since error; after three, turn off error status. */ if (yyerrstatus) yyerrstatus--; yystate = yyn; goto yynewstate; /* Do the default action for the current state. */ yydefault: yyn = yydefact[yystate]; if (yyn == 0) goto yyerrlab; /* Do a reduction. yyn is the number of a rule to reduce with. */ yyreduce: yylen = yyr2[yyn]; if (yylen > 0) yyval = yyvsp[1-yylen]; /* implement default value of the action */ #if YYDEBUG != 0 if (yydebug) { int i; fprintf (stderr, "Reducing via rule %d (line %d), ", yyn, yyrline[yyn]); /* Print the symbols being reduced, and their result. */ for (i = yyprhs[yyn]; yyrhs[i] > 0; i++) fprintf (stderr, "%s ", yytname[yyrhs[i]]); fprintf (stderr, " -> %s\n", yytname[yyr1[yyn]]); } #endif switch (yyn) { case 3: #line 173 "getdate.y" { yyHaveTime++; ; break;} case 4: #line 176 "getdate.y" { yyHaveZone++; ; break;} case 5: #line 179 "getdate.y" { yyHaveDate++; ; break;} case 6: #line 182 "getdate.y" { yyHaveDay++; ; break;} case 7: #line 185 "getdate.y" { yyHaveRel++; ; break;} case 9: #line 191 "getdate.y" { yyHour = yyvsp[-1].Number; yyMinutes = 0; yySeconds = 0; yyMeridian = yyvsp[0].Meridian; ; break;} case 10: #line 197 "getdate.y" { yyHour = yyvsp[-3].Number; yyMinutes = yyvsp[-1].Number; yySeconds = 0; yyMeridian = yyvsp[0].Meridian; ; break;} case 11: #line 203 "getdate.y" { yyHour = yyvsp[-3].Number; yyMinutes = yyvsp[-1].Number; yyMeridian = MER24; yyDSTmode = DSToff; yyTimezone = - (yyvsp[0].Number % 100 + (yyvsp[0].Number / 100) * 60); ; break;} case 12: #line 210 "getdate.y" { yyHour = yyvsp[-5].Number; yyMinutes = yyvsp[-3].Number; yySeconds = yyvsp[-1].Number; yyMeridian = yyvsp[0].Meridian; ; break;} case 13: #line 216 "getdate.y" { yyHour = yyvsp[-5].Number; yyMinutes = yyvsp[-3].Number; yySeconds = yyvsp[-1].Number; yyMeridian = MER24; yyDSTmode = DSToff; yyTimezone = - (yyvsp[0].Number % 100 + (yyvsp[0].Number / 100) * 60); ; break;} case 14: #line 226 "getdate.y" { yyTimezone = yyvsp[0].Number; yyDSTmode = DSToff; ; break;} case 15: #line 230 "getdate.y" { yyTimezone = yyvsp[0].Number; yyDSTmode = DSTon; ; break;} case 16: #line 235 "getdate.y" { yyTimezone = yyvsp[-1].Number; yyDSTmode = DSTon; ; break;} case 17: #line 241 "getdate.y" { yyDayOrdinal = 1; yyDayNumber = yyvsp[0].Number; ; break;} case 18: #line 245 "getdate.y" { yyDayOrdinal = 1; yyDayNumber = yyvsp[-1].Number; ; break;} case 19: #line 249 "getdate.y" { yyDayOrdinal = yyvsp[-1].Number; yyDayNumber = yyvsp[0].Number; ; break;} case 20: #line 255 "getdate.y" { yyMonth = yyvsp[-2].Number; yyDay = yyvsp[0].Number; ; break;} case 21: #line 259 "getdate.y" { yyMonth = yyvsp[-4].Number; yyDay = yyvsp[-2].Number; yyYear = yyvsp[0].Number; ; break;} case 22: #line 264 "getdate.y" { /* ISO 8601 format. yyyy-mm-dd. */ yyYear = yyvsp[-2].Number; yyMonth = -yyvsp[-1].Number; yyDay = -yyvsp[0].Number; ; break;} case 23: #line 270 "getdate.y" { /* e.g. 17-JUN-1992. */ yyDay = yyvsp[-2].Number; yyMonth = yyvsp[-1].Number; yyYear = -yyvsp[0].Number; ; break;} case 24: #line 276 "getdate.y" { yyMonth = yyvsp[-1].Number; yyDay = yyvsp[0].Number; ; break;} case 25: #line 280 "getdate.y" { yyMonth = yyvsp[-3].Number; yyDay = yyvsp[-2].Number; yyYear = yyvsp[0].Number; ; break;} case 26: #line 285 "getdate.y" { yyMonth = yyvsp[0].Number; yyDay = yyvsp[-1].Number; ; break;} case 27: #line 289 "getdate.y" { yyMonth = yyvsp[-1].Number; yyDay = yyvsp[-2].Number; yyYear = yyvsp[0].Number; ; break;} case 28: #line 296 "getdate.y" { yyRelSeconds = -yyRelSeconds; yyRelMonth = -yyRelMonth; ; break;} case 30: #line 303 "getdate.y" { yyRelSeconds += yyvsp[-1].Number * yyvsp[0].Number * 60L; ; break;} case 31: #line 306 "getdate.y" { yyRelSeconds += yyvsp[-1].Number * yyvsp[0].Number * 60L; ; break;} case 32: #line 309 "getdate.y" { yyRelSeconds += yyvsp[0].Number * 60L; ; break;} case 33: #line 312 "getdate.y" { yyRelSeconds += yyvsp[-1].Number; ; break;} case 34: #line 315 "getdate.y" { yyRelSeconds += yyvsp[-1].Number; ; break;} case 35: #line 318 "getdate.y" { yyRelSeconds++; ; break;} case 36: #line 321 "getdate.y" { yyRelMonth += yyvsp[-1].Number * yyvsp[0].Number; ; break;} case 37: #line 324 "getdate.y" { yyRelMonth += yyvsp[-1].Number * yyvsp[0].Number; ; break;} case 38: #line 327 "getdate.y" { yyRelMonth += yyvsp[0].Number; ; break;} case 39: #line 332 "getdate.y" { if (yyHaveTime && yyHaveDate && !yyHaveRel) yyYear = yyvsp[0].Number; else { if (yyvsp[0].Number>10000) { yyHaveDate++; yyDay= (yyvsp[0].Number)%100; yyMonth= (yyvsp[0].Number/100)%100; yyYear = yyvsp[0].Number/10000; } else { yyHaveTime++; if (yyvsp[0].Number < 100) { yyHour = yyvsp[0].Number; yyMinutes = 0; } else { yyHour = yyvsp[0].Number / 100; yyMinutes = yyvsp[0].Number % 100; } yySeconds = 0; yyMeridian = MER24; } } ; break;} case 40: #line 359 "getdate.y" { yyval.Meridian = MER24; ; break;} case 41: #line 362 "getdate.y" { yyval.Meridian = yyvsp[0].Meridian; ; break;} } /* the action file gets copied in in place of this dollarsign */ #line 480 "/usr/local/lib/bison.simple" yyvsp -= yylen; yyssp -= yylen; #ifdef YYLSP_NEEDED yylsp -= yylen; #endif #if YYDEBUG != 0 if (yydebug) { short *ssp1 = yyss - 1; fprintf (stderr, "state stack now"); while (ssp1 != yyssp) fprintf (stderr, " %d", *++ssp1); fprintf (stderr, "\n"); } #endif *++yyvsp = yyval; #ifdef YYLSP_NEEDED yylsp++; if (yylen == 0) { yylsp->first_line = yylloc.first_line; yylsp->first_column = yylloc.first_column; yylsp->last_line = (yylsp-1)->last_line; yylsp->last_column = (yylsp-1)->last_column; yylsp->text = 0; } else { yylsp->last_line = (yylsp+yylen-1)->last_line; yylsp->last_column = (yylsp+yylen-1)->last_column; } #endif /* Now "shift" the result of the reduction. Determine what state that goes to, based on the state we popped back to and the rule number reduced by. */ yyn = yyr1[yyn]; yystate = yypgoto[yyn - YYNTBASE] + *yyssp; if (yystate >= 0 && yystate <= YYLAST && yycheck[yystate] == *yyssp) yystate = yytable[yystate]; else yystate = yydefgoto[yyn - YYNTBASE]; goto yynewstate; yyerrlab: /* here on detecting error */ if (! yyerrstatus) /* If not already recovering from an error, report this error. */ { ++yynerrs; #ifdef YYERROR_VERBOSE yyn = yypact[yystate]; if (yyn > YYFLAG && yyn < YYLAST) { int size = 0; char *msg; int x, count; count = 0; /* Start X at -yyn if nec to avoid negative indexes in yycheck. */ for (x = (yyn < 0 ? -yyn : 0); x < (sizeof(yytname) / sizeof(char *)); x++) if (yycheck[x + yyn] == x) size += strlen(yytname[x]) + 15, count++; msg = (char *) malloc(size + 15); if (msg != 0) { strcpy(msg, "parse error"); if (count < 5) { count = 0; for (x = (yyn < 0 ? -yyn : 0); x < (sizeof(yytname) / sizeof(char *)); x++) if (yycheck[x + yyn] == x) { strcat(msg, count == 0 ? ", expecting `" : " or `"); strcat(msg, yytname[x]); strcat(msg, "'"); count++; } } yyerror(msg); free(msg); } else yyerror ("parse error; also virtual memory exceeded"); } else #endif /* YYERROR_VERBOSE */ yyerror("parse error"); } goto yyerrlab1; yyerrlab1: /* here on error raised explicitly by an action */ if (yyerrstatus == 3) { /* if just tried and failed to reuse lookahead token after an error, discard it. */ /* return failure if at end of input */ if (yychar == YYEOF) YYABORT; #if YYDEBUG != 0 if (yydebug) fprintf(stderr, "Discarding token %d (%s).\n", yychar, yytname[yychar1]); #endif yychar = YYEMPTY; } /* Else will try to reuse lookahead token after shifting the error token. */ yyerrstatus = 3; /* Each real token shifted decrements this */ goto yyerrhandle; yyerrdefault: /* current state does not do anything special for the error token. */ #if 0 /* This is wrong; only states that explicitly want error tokens should shift them. */ yyn = yydefact[yystate]; /* If its default is to accept any token, ok. Otherwise pop it.*/ if (yyn) goto yydefault; #endif yyerrpop: /* pop the current state because it cannot handle the error token */ if (yyssp == yyss) YYABORT; yyvsp--; yystate = *--yyssp; #ifdef YYLSP_NEEDED yylsp--; #endif #if YYDEBUG != 0 if (yydebug) { short *ssp1 = yyss - 1; fprintf (stderr, "Error: state stack now"); while (ssp1 != yyssp) fprintf (stderr, " %d", *++ssp1); fprintf (stderr, "\n"); } #endif yyerrhandle: yyn = yypact[yystate]; if (yyn == YYFLAG) goto yyerrdefault; yyn += YYTERROR; if (yyn < 0 || yyn > YYLAST || yycheck[yyn] != YYTERROR) goto yyerrdefault; yyn = yytable[yyn]; if (yyn < 0) { if (yyn == YYFLAG) goto yyerrpop; yyn = -yyn; goto yyreduce; } else if (yyn == 0) goto yyerrpop; if (yyn == YYFINAL) YYACCEPT; #if YYDEBUG != 0 if (yydebug) fprintf(stderr, "Shifting error token, "); #endif *++yyvsp = yylval; #ifdef YYLSP_NEEDED *++yylsp = yylloc; #endif yystate = yyn; goto yynewstate; } #line 367 "getdate.y" /* Month and day table. */ static TABLE const MonthDayTable[] = { { "january", tMONTH, 1 }, { "february", tMONTH, 2 }, { "march", tMONTH, 3 }, { "april", tMONTH, 4 }, { "may", tMONTH, 5 }, { "june", tMONTH, 6 }, { "july", tMONTH, 7 }, { "august", tMONTH, 8 }, { "september", tMONTH, 9 }, { "sept", tMONTH, 9 }, { "october", tMONTH, 10 }, { "november", tMONTH, 11 }, { "december", tMONTH, 12 }, { "sunday", tDAY, 0 }, { "monday", tDAY, 1 }, { "tuesday", tDAY, 2 }, { "tues", tDAY, 2 }, { "wednesday", tDAY, 3 }, { "wednes", tDAY, 3 }, { "thursday", tDAY, 4 }, { "thur", tDAY, 4 }, { "thurs", tDAY, 4 }, { "friday", tDAY, 5 }, { "saturday", tDAY, 6 }, { NULL } }; /* Time units table. */ static TABLE const UnitsTable[] = { { "year", tMONTH_UNIT, 12 }, { "month", tMONTH_UNIT, 1 }, { "fortnight", tMINUTE_UNIT, 14 * 24 * 60 }, { "week", tMINUTE_UNIT, 7 * 24 * 60 }, { "day", tMINUTE_UNIT, 1 * 24 * 60 }, { "hour", tMINUTE_UNIT, 60 }, { "minute", tMINUTE_UNIT, 1 }, { "min", tMINUTE_UNIT, 1 }, { "second", tSEC_UNIT, 1 }, { "sec", tSEC_UNIT, 1 }, { NULL } }; /* Assorted relative-time words. */ static TABLE const OtherTable[] = { { "tomorrow", tMINUTE_UNIT, 1 * 24 * 60 }, { "yesterday", tMINUTE_UNIT, -1 * 24 * 60 }, { "today", tMINUTE_UNIT, 0 }, { "now", tMINUTE_UNIT, 0 }, { "last", tUNUMBER, -1 }, { "this", tMINUTE_UNIT, 0 }, { "next", tUNUMBER, 2 }, { "first", tUNUMBER, 1 }, /* { "second", tUNUMBER, 2 }, */ { "third", tUNUMBER, 3 }, { "fourth", tUNUMBER, 4 }, { "fifth", tUNUMBER, 5 }, { "sixth", tUNUMBER, 6 }, { "seventh", tUNUMBER, 7 }, { "eighth", tUNUMBER, 8 }, { "ninth", tUNUMBER, 9 }, { "tenth", tUNUMBER, 10 }, { "eleventh", tUNUMBER, 11 }, { "twelfth", tUNUMBER, 12 }, { "ago", tAGO, 1 }, { NULL } }; /* The timezone table. */ /* Some of these are commented out because a time_t can't store a float. */ static TABLE const TimezoneTable[] = { { "gmt", tZONE, HOUR ( 0) }, /* Greenwich Mean */ { "ut", tZONE, HOUR ( 0) }, /* Universal (Coordinated) */ { "utc", tZONE, HOUR ( 0) }, { "wet", tZONE, HOUR ( 0) }, /* Western European */ { "bst", tDAYZONE, HOUR ( 0) }, /* British Summer */ { "wat", tZONE, HOUR ( 1) }, /* West Africa */ { "at", tZONE, HOUR ( 2) }, /* Azores */ #if 0 /* For completeness. BST is also British Summer, and GST is * also Guam Standard. */ { "bst", tZONE, HOUR ( 3) }, /* Brazil Standard */ { "gst", tZONE, HOUR ( 3) }, /* Greenland Standard */ #endif #if 0 { "nft", tZONE, HOUR (3.5) }, /* Newfoundland */ { "nst", tZONE, HOUR (3.5) }, /* Newfoundland Standard */ { "ndt", tDAYZONE, HOUR (3.5) }, /* Newfoundland Daylight */ #endif { "ast", tZONE, HOUR ( 4) }, /* Atlantic Standard */ { "adt", tDAYZONE, HOUR ( 4) }, /* Atlantic Daylight */ { "est", tZONE, HOUR ( 5) }, /* Eastern Standard */ { "edt", tDAYZONE, HOUR ( 5) }, /* Eastern Daylight */ { "cst", tZONE, HOUR ( 6) }, /* Central Standard */ { "cdt", tDAYZONE, HOUR ( 6) }, /* Central Daylight */ { "mst", tZONE, HOUR ( 7) }, /* Mountain Standard */ { "mdt", tDAYZONE, HOUR ( 7) }, /* Mountain Daylight */ { "pst", tZONE, HOUR ( 8) }, /* Pacific Standard */ { "pdt", tDAYZONE, HOUR ( 8) }, /* Pacific Daylight */ { "yst", tZONE, HOUR ( 9) }, /* Yukon Standard */ { "ydt", tDAYZONE, HOUR ( 9) }, /* Yukon Daylight */ { "hst", tZONE, HOUR (10) }, /* Hawaii Standard */ { "hdt", tDAYZONE, HOUR (10) }, /* Hawaii Daylight */ { "cat", tZONE, HOUR (10) }, /* Central Alaska */ { "ahst", tZONE, HOUR (10) }, /* Alaska-Hawaii Standard */ { "nt", tZONE, HOUR (11) }, /* Nome */ { "idlw", tZONE, HOUR (12) }, /* International Date Line West */ { "cet", tZONE, -HOUR (1) }, /* Central European */ { "met", tZONE, -HOUR (1) }, /* Middle European */ { "mewt", tZONE, -HOUR (1) }, /* Middle European Winter */ { "mest", tDAYZONE, -HOUR (1) }, /* Middle European Summer */ { "mesz", tDAYZONE, -HOUR (1) }, /* Middle European Summer */ { "swt", tZONE, -HOUR (1) }, /* Swedish Winter */ { "sst", tDAYZONE, -HOUR (1) }, /* Swedish Summer */ { "fwt", tZONE, -HOUR (1) }, /* French Winter */ { "fst", tDAYZONE, -HOUR (1) }, /* French Summer */ { "eet", tZONE, -HOUR (2) }, /* Eastern Europe, USSR Zone 1 */ { "bt", tZONE, -HOUR (3) }, /* Baghdad, USSR Zone 2 */ #if 0 { "it", tZONE, -HOUR (3.5) },/* Iran */ #endif { "zp4", tZONE, -HOUR (4) }, /* USSR Zone 3 */ { "zp5", tZONE, -HOUR (5) }, /* USSR Zone 4 */ #if 0 { "ist", tZONE, -HOUR (5.5) },/* Indian Standard */ #endif { "zp6", tZONE, -HOUR (6) }, /* USSR Zone 5 */ #if 0 /* For completeness. NST is also Newfoundland Standard, and SST is * also Swedish Summer. */ { "nst", tZONE, -HOUR (6.5) },/* North Sumatra */ { "sst", tZONE, -HOUR (7) }, /* South Sumatra, USSR Zone 6 */ #endif /* 0 */ { "wast", tZONE, -HOUR (7) }, /* West Australian Standard */ { "wadt", tDAYZONE, -HOUR (7) }, /* West Australian Daylight */ #if 0 { "jt", tZONE, -HOUR (7.5) },/* Java (3pm in Cronusland!) */ #endif { "cct", tZONE, -HOUR (8) }, /* China Coast, USSR Zone 7 */ { "jst", tZONE, -HOUR (9) }, /* Japan Standard, USSR Zone 8 */ #if 0 { "cast", tZONE, -HOUR (9.5) },/* Central Australian Standard */ { "cadt", tDAYZONE, -HOUR (9.5) },/* Central Australian Daylight */ #endif { "east", tZONE, -HOUR (10) }, /* Eastern Australian Standard */ { "eadt", tDAYZONE, -HOUR (10) }, /* Eastern Australian Daylight */ { "gst", tZONE, -HOUR (10) }, /* Guam Standard, USSR Zone 9 */ { "nzt", tZONE, -HOUR (12) }, /* New Zealand */ { "nzst", tZONE, -HOUR (12) }, /* New Zealand Standard */ { "nzdt", tDAYZONE, -HOUR (12) }, /* New Zealand Daylight */ { "idle", tZONE, -HOUR (12) }, /* International Date Line East */ { NULL } }; /* Military timezone table. */ static TABLE const MilitaryTable[] = { { "a", tZONE, HOUR ( 1) }, { "b", tZONE, HOUR ( 2) }, { "c", tZONE, HOUR ( 3) }, { "d", tZONE, HOUR ( 4) }, { "e", tZONE, HOUR ( 5) }, { "f", tZONE, HOUR ( 6) }, { "g", tZONE, HOUR ( 7) }, { "h", tZONE, HOUR ( 8) }, { "i", tZONE, HOUR ( 9) }, { "k", tZONE, HOUR ( 10) }, { "l", tZONE, HOUR ( 11) }, { "m", tZONE, HOUR ( 12) }, { "n", tZONE, HOUR (- 1) }, { "o", tZONE, HOUR (- 2) }, { "p", tZONE, HOUR (- 3) }, { "q", tZONE, HOUR (- 4) }, { "r", tZONE, HOUR (- 5) }, { "s", tZONE, HOUR (- 6) }, { "t", tZONE, HOUR (- 7) }, { "u", tZONE, HOUR (- 8) }, { "v", tZONE, HOUR (- 9) }, { "w", tZONE, HOUR (-10) }, { "x", tZONE, HOUR (-11) }, { "y", tZONE, HOUR (-12) }, { "z", tZONE, HOUR ( 0) }, { NULL } }; /* ARGSUSED */ static int yyerror (s) char *s; { return 0; } static time_t ToSeconds (Hours, Minutes, Seconds, Meridian) time_t Hours; time_t Minutes; time_t Seconds; MERIDIAN Meridian; { if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) return -1; switch (Meridian) { case MER24: if (Hours < 0 || Hours > 23) return -1; return (Hours * 60L + Minutes) * 60L + Seconds; case MERam: if (Hours < 1 || Hours > 12) return -1; if (Hours == 12) Hours = 0; return (Hours * 60L + Minutes) * 60L + Seconds; case MERpm: if (Hours < 1 || Hours > 12) return -1; if (Hours == 12) Hours = 0; return ((Hours + 12) * 60L + Minutes) * 60L + Seconds; default: abort (); } /* NOTREACHED */ } static time_t Convert (Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode) time_t Month; time_t Day; time_t Year; time_t Hours; time_t Minutes; time_t Seconds; MERIDIAN Meridian; DSTMODE DSTmode; { static int DaysInMonth[12] = { 31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 }; time_t tod; time_t Julian; int i; if (Year < 0) Year = -Year; if (Year < 100) Year += 1900; DaysInMonth[1] = Year % 4 == 0 && (Year % 100 != 0 || Year % 400 == 0) ? 29 : 28; if (Year < EPOCH || Year > 1999 || Month < 1 || Month > 12 /* Lint fluff: "conversion from long may lose accuracy" */ || Day < 1 || Day > DaysInMonth[(int)--Month]) return -1; for (Julian = Day - 1, i = 0; i < Month; i++) Julian += DaysInMonth[i]; for (i = EPOCH; i < Year; i++) Julian += 365 + (i % 4 == 0); Julian *= SECSPERDAY; Julian += yyTimezone * 60L; if ((tod = ToSeconds (Hours, Minutes, Seconds, Meridian)) < 0) return -1; Julian += tod; if (DSTmode == DSTon || (DSTmode == DSTmaybe && localtime (&Julian)->tm_isdst)) Julian -= 60 * 60; return Julian; } static time_t DSTcorrect (Start, Future) time_t Start; time_t Future; { time_t StartDay; time_t FutureDay; StartDay = (localtime (&Start)->tm_hour + 1) % 24; FutureDay = (localtime (&Future)->tm_hour + 1) % 24; return (Future - Start) + (StartDay - FutureDay) * 60L * 60L; } static time_t RelativeDate (Start, DayOrdinal, DayNumber) time_t Start; time_t DayOrdinal; time_t DayNumber; { struct tm *tm; time_t now; now = Start; tm = localtime (&now); now += SECSPERDAY * ((DayNumber - tm->tm_wday + 7) % 7); now += 7 * SECSPERDAY * (DayOrdinal <= 0 ? DayOrdinal : DayOrdinal - 1); return DSTcorrect (Start, now); } static time_t RelativeMonth (Start, RelMonth) time_t Start; time_t RelMonth; { struct tm *tm; time_t Month; time_t Year; if (RelMonth == 0) return 0; tm = localtime (&Start); Month = 12 * tm->tm_year + tm->tm_mon + RelMonth; Year = Month / 12; Month = Month % 12 + 1; return DSTcorrect (Start, Convert (Month, (time_t)tm->tm_mday, Year, (time_t)tm->tm_hour, (time_t)tm->tm_min, (time_t)tm->tm_sec, MER24, DSTmaybe)); } static int LookupWord (buff) char *buff; { register char *p; register char *q; register const TABLE *tp; int i; int abbrev; /* Make it lowercase. */ for (p = buff; *p; p++) if (isupper (*p)) *p = tolower (*p); if (strcmp (buff, "am") == 0 || strcmp (buff, "a.m.") == 0) { yylval.Meridian = MERam; return tMERIDIAN; } if (strcmp (buff, "pm") == 0 || strcmp (buff, "p.m.") == 0) { yylval.Meridian = MERpm; return tMERIDIAN; } /* See if we have an abbreviation for a month. */ if (strlen (buff) == 3) abbrev = 1; else if (strlen (buff) == 4 && buff[3] == '.') { abbrev = 1; buff[3] = '\0'; } else abbrev = 0; for (tp = MonthDayTable; tp->name; tp++) { if (abbrev) { if (strncmp (buff, tp->name, 3) == 0) { yylval.Number = tp->value; return tp->type; } } else if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } } for (tp = TimezoneTable; tp->name; tp++) if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } if (strcmp (buff, "dst") == 0) return tDST; for (tp = UnitsTable; tp->name; tp++) if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } /* Strip off any plural and try the units table again. */ i = strlen (buff) - 1; if (buff[i] == 's') { buff[i] = '\0'; for (tp = UnitsTable; tp->name; tp++) if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } buff[i] = 's'; /* Put back for "this" in OtherTable. */ } for (tp = OtherTable; tp->name; tp++) if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } /* Military timezones. */ if (buff[1] == '\0' && isalpha (*buff)) { for (tp = MilitaryTable; tp->name; tp++) if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } } /* Drop out any periods and try the timezone table again. */ for (i = 0, p = q = buff; *q; q++) if (*q != '.') *p++ = *q; else i++; *p = '\0'; if (i) for (tp = TimezoneTable; tp->name; tp++) if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } return tID; } static int yylex () { register char c; register char *p; char buff[20]; int Count; int sign; for ( ; ; ) { while (isspace (*yyInput)) yyInput++; if (isdigit (c = *yyInput) || c == '-' || c == '+') { if (c == '-' || c == '+') { sign = c == '-' ? -1 : 1; if (!isdigit (*++yyInput)) /* skip the '-' sign */ continue; } else sign = 0; for (yylval.Number = 0; isdigit (c = *yyInput++); ) yylval.Number = 10 * yylval.Number + c - '0'; yyInput--; if (sign < 0) yylval.Number = -yylval.Number; return sign ? tSNUMBER : tUNUMBER; } if (isalpha (c)) { for (p = buff; isalpha (c = *yyInput++) || c == '.'; ) if (p < &buff[sizeof buff - 1]) *p++ = c; *p = '\0'; yyInput--; return LookupWord (buff); } if (c != '(') return *yyInput++; Count = 0; do { c = *yyInput++; if (c == '\0') return c; if (c == '(') Count++; else if (c == ')') Count--; } while (Count > 0); } } #define TM_YEAR_ORIGIN 1900 /* Yield A - B, measured in seconds. */ static long difftm (a, b) struct tm *a, *b; { int ay = a->tm_year + (TM_YEAR_ORIGIN - 1); int by = b->tm_year + (TM_YEAR_ORIGIN - 1); long days = ( /* difference in day of year */ a->tm_yday - b->tm_yday /* + intervening leap days */ + ((ay >> 2) - (by >> 2)) - (ay/100 - by/100) + ((ay/100 >> 2) - (by/100 >> 2)) /* + difference in years * 365 */ + (long)(ay-by) * 365 ); return (60*(60*(24*days + (a->tm_hour - b->tm_hour)) + (a->tm_min - b->tm_min)) + (a->tm_sec - b->tm_sec)); } time_t get_date (p, now) char *p; struct timeb *now; { struct tm *tm, gmt; struct timeb ftz; time_t Start; time_t tod; yyInput = p; if (now == NULL) { now = &ftz; (void)time (&ftz.time); if (! (tm = gmtime (&ftz.time))) return -1; gmt = *tm; /* Make a copy, in case localtime modifies *tm. */ if (! (tm = localtime (&ftz.time))) return -1; ftz.timezone = difftm (&gmt, tm) / 60; if (tm->tm_isdst) ftz.timezone += 60; } tm = localtime (&now->time); yyYear = tm->tm_year; yyMonth = tm->tm_mon + 1; yyDay = tm->tm_mday; yyTimezone = now->timezone; yyDSTmode = DSTmaybe; yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24; yyRelSeconds = 0; yyRelMonth = 0; yyHaveDate = 0; yyHaveDay = 0; yyHaveRel = 0; yyHaveTime = 0; yyHaveZone = 0; if (yyparse () || yyHaveTime > 1 || yyHaveZone > 1 || yyHaveDate > 1 || yyHaveDay > 1) return -1; if (yyHaveDate || yyHaveTime || yyHaveDay) { Start = Convert (yyMonth, yyDay, yyYear, yyHour, yyMinutes, yySeconds, yyMeridian, yyDSTmode); if (Start < 0) return -1; } else { Start = now->time; if (!yyHaveRel) Start -= ((tm->tm_hour * 60L + tm->tm_min) * 60L) + tm->tm_sec; } Start += yyRelSeconds; Start += RelativeMonth (Start, yyRelMonth); if (yyHaveDay && !yyHaveDate) { tod = RelativeDate (Start, yyDayOrdinal, yyDayNumber); Start += tod; } /* Have to do *something* with a legitimate -1 so it's distinguishable * from the error return value. (Alternately could set errno on error.) */ return Start == -1 ? 0 : Start; } #if defined (TEST) /* ARGSUSED */ int main (ac, av) int ac; char *av[]; { char buff[MAX_BUFF_LEN + 1]; time_t d; (void)printf ("Enter date, or blank line to exit.\n\t> "); (void)fflush (stdout); buff[MAX_BUFF_LEN] = 0; while (fgets (buff, MAX_BUFF_LEN, stdin) && buff[0]) { d = get_date (buff, (struct timeb *)NULL); if (d == -1) (void)printf ("Bad format - couldn't convert.\n"); else (void)printf ("%s", ctime (&d)); (void)printf ("\t> "); (void)fflush (stdout); } exit (0); /* NOTREACHED */ } #endif /* defined (TEST) */ emacs-19.30/lib-src/getdate.y100444 12120 1 56433 6054445654 14311 0ustar rmsdaemon%{ /* ** Originally written by Steven M. Bellovin while ** at the University of North Carolina at Chapel Hill. Later tweaked by ** a couple of people on Usenet. Completely overhauled by Rich $alz ** and Jim Berets in August, 1990; ** send any email to Rich. ** ** This grammar has 10 shift/reduce conflicts. ** ** This code is in the public domain and has no copyright. */ /* SUPPRESS 287 on yaccpar_sccsid *//* Unused static variable */ /* SUPPRESS 288 on yyerrlab *//* Label unused */ #ifdef HAVE_CONFIG_H #include #ifdef FORCE_ALLOCA_H #include #endif #endif /* Since the code of getdate.y is not included in the Emacs executable itself, there is no need to #define static in this file. Even if the code were included in the Emacs executable, it probably wouldn't do any harm to #undef it here; this will only cause problems if we try to write to a static variable, which I don't think this code needs to do. */ #ifdef emacs #undef static #endif #include #include #if defined (vms) #include #include #else #include #ifdef TIME_WITH_SYS_TIME #include #include #else #ifdef HAVE_SYS_TIME_H #include #else #include #endif #endif #ifdef timezone #undef timezone /* needed for sgi */ #endif #if defined (HAVE_SYS_TIMEB_H) #include #else /* get_date uses the obsolete `struct timeb' in its interface! FIXME. Since some systems don't have it, we define it here; callers must do likewise. */ struct timeb { time_t time; /* Seconds since the epoch */ unsigned short millitm; /* Field not used */ short timezone; /* Minutes west of GMT */ short dstflag; /* Field not used */ }; #endif /* defined (HAVE_SYS_TIMEB_H) */ #endif /* defined (vms) */ #if defined (STDC_HEADERS) || defined (USG) #include #endif /* Some old versions of bison generate parsers that use bcopy. That loses on systems that don't provide the function, so we have to redefine it here. */ #if !defined (HAVE_BCOPY) && defined (HAVE_MEMCPY) && !defined (bcopy) #define bcopy(from, to, len) memcpy ((to), (from), (len)) #endif extern struct tm *gmtime (); extern struct tm *localtime (); #define yyparse getdate_yyparse #define yylex getdate_yylex #define yyerror getdate_yyerror static int yylex (); static int yyerror (); #define EPOCH 1970 #define HOUR(x) ((time_t)(x) * 60) #define SECSPERDAY (24L * 60L * 60L) #define MAX_BUFF_LEN 128 /* size of buffer to read the date into */ /* ** An entry in the lexical lookup table. */ typedef struct _TABLE { const char *name; int type; time_t value; } TABLE; /* ** Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; /* ** Meridian: am, pm, or 24-hour style. */ typedef enum _MERIDIAN { MERam, MERpm, MER24 } MERIDIAN; /* ** Global variables. We could get rid of most of these by using a good ** union as the yacc stack. (This routine was originally written before ** yacc had the %union construct.) Maybe someday; right now we only use ** the %union very rarely. */ static char *yyInput; static DSTMODE yyDSTmode; static time_t yyDayOrdinal; static time_t yyDayNumber; static int yyHaveDate; static int yyHaveDay; static int yyHaveRel; static int yyHaveTime; static int yyHaveZone; static time_t yyTimezone; static time_t yyDay; static time_t yyHour; static time_t yyMinutes; static time_t yyMonth; static time_t yySeconds; static time_t yyYear; static MERIDIAN yyMeridian; static time_t yyRelMonth; static time_t yyRelSeconds; %} %union { time_t Number; enum _MERIDIAN Meridian; } %token tAGO tDAY tDAYZONE tID tMERIDIAN tMINUTE_UNIT tMONTH tMONTH_UNIT %token tSEC_UNIT tSNUMBER tUNUMBER tZONE tDST %type tDAY tDAYZONE tMINUTE_UNIT tMONTH tMONTH_UNIT %type tSEC_UNIT tSNUMBER tUNUMBER tZONE %type tMERIDIAN o_merid %% spec : /* NULL */ | spec item ; item : time { yyHaveTime++; } | zone { yyHaveZone++; } | date { yyHaveDate++; } | day { yyHaveDay++; } | rel { yyHaveRel++; } | number ; time : tUNUMBER tMERIDIAN { yyHour = $1; yyMinutes = 0; yySeconds = 0; yyMeridian = $2; } | tUNUMBER ':' tUNUMBER o_merid { yyHour = $1; yyMinutes = $3; yySeconds = 0; yyMeridian = $4; } | tUNUMBER ':' tUNUMBER tSNUMBER { yyHour = $1; yyMinutes = $3; yyMeridian = MER24; yyDSTmode = DSToff; yyTimezone = - ($4 % 100 + ($4 / 100) * 60); } | tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid { yyHour = $1; yyMinutes = $3; yySeconds = $5; yyMeridian = $6; } | tUNUMBER ':' tUNUMBER ':' tUNUMBER tSNUMBER { yyHour = $1; yyMinutes = $3; yySeconds = $5; yyMeridian = MER24; yyDSTmode = DSToff; yyTimezone = - ($6 % 100 + ($6 / 100) * 60); } ; zone : tZONE { yyTimezone = $1; yyDSTmode = DSToff; } | tDAYZONE { yyTimezone = $1; yyDSTmode = DSTon; } | tZONE tDST { yyTimezone = $1; yyDSTmode = DSTon; } ; day : tDAY { yyDayOrdinal = 1; yyDayNumber = $1; } | tDAY ',' { yyDayOrdinal = 1; yyDayNumber = $1; } | tUNUMBER tDAY { yyDayOrdinal = $1; yyDayNumber = $2; } ; date : tUNUMBER '/' tUNUMBER { yyMonth = $1; yyDay = $3; } | tUNUMBER '/' tUNUMBER '/' tUNUMBER { yyMonth = $1; yyDay = $3; yyYear = $5; } | tUNUMBER tSNUMBER tSNUMBER { /* ISO 8601 format. yyyy-mm-dd. */ yyYear = $1; yyMonth = -$2; yyDay = -$3; } | tUNUMBER tMONTH tSNUMBER { /* e.g. 17-JUN-1992. */ yyDay = $1; yyMonth = $2; yyYear = -$3; } | tMONTH tUNUMBER { yyMonth = $1; yyDay = $2; } | tMONTH tUNUMBER ',' tUNUMBER { yyMonth = $1; yyDay = $2; yyYear = $4; } | tUNUMBER tMONTH { yyMonth = $2; yyDay = $1; } | tUNUMBER tMONTH tUNUMBER { yyMonth = $2; yyDay = $1; yyYear = $3; } ; rel : relunit tAGO { yyRelSeconds = -yyRelSeconds; yyRelMonth = -yyRelMonth; } | relunit ; relunit : tUNUMBER tMINUTE_UNIT { yyRelSeconds += $1 * $2 * 60L; } | tSNUMBER tMINUTE_UNIT { yyRelSeconds += $1 * $2 * 60L; } | tMINUTE_UNIT { yyRelSeconds += $1 * 60L; } | tSNUMBER tSEC_UNIT { yyRelSeconds += $1; } | tUNUMBER tSEC_UNIT { yyRelSeconds += $1; } | tSEC_UNIT { yyRelSeconds++; } | tSNUMBER tMONTH_UNIT { yyRelMonth += $1 * $2; } | tUNUMBER tMONTH_UNIT { yyRelMonth += $1 * $2; } | tMONTH_UNIT { yyRelMonth += $1; } ; number : tUNUMBER { if (yyHaveTime && yyHaveDate && !yyHaveRel) yyYear = $1; else { if ($1>10000) { yyHaveDate++; yyDay= ($1)%100; yyMonth= ($1/100)%100; yyYear = $1/10000; } else { yyHaveTime++; if ($1 < 100) { yyHour = $1; yyMinutes = 0; } else { yyHour = $1 / 100; yyMinutes = $1 % 100; } yySeconds = 0; yyMeridian = MER24; } } } ; o_merid : /* NULL */ { $$ = MER24; } | tMERIDIAN { $$ = $1; } ; %% /* Month and day table. */ static TABLE const MonthDayTable[] = { { "january", tMONTH, 1 }, { "february", tMONTH, 2 }, { "march", tMONTH, 3 }, { "april", tMONTH, 4 }, { "may", tMONTH, 5 }, { "june", tMONTH, 6 }, { "july", tMONTH, 7 }, { "august", tMONTH, 8 }, { "september", tMONTH, 9 }, { "sept", tMONTH, 9 }, { "october", tMONTH, 10 }, { "november", tMONTH, 11 }, { "december", tMONTH, 12 }, { "sunday", tDAY, 0 }, { "monday", tDAY, 1 }, { "tuesday", tDAY, 2 }, { "tues", tDAY, 2 }, { "wednesday", tDAY, 3 }, { "wednes", tDAY, 3 }, { "thursday", tDAY, 4 }, { "thur", tDAY, 4 }, { "thurs", tDAY, 4 }, { "friday", tDAY, 5 }, { "saturday", tDAY, 6 }, { NULL } }; /* Time units table. */ static TABLE const UnitsTable[] = { { "year", tMONTH_UNIT, 12 }, { "month", tMONTH_UNIT, 1 }, { "fortnight", tMINUTE_UNIT, 14 * 24 * 60 }, { "week", tMINUTE_UNIT, 7 * 24 * 60 }, { "day", tMINUTE_UNIT, 1 * 24 * 60 }, { "hour", tMINUTE_UNIT, 60 }, { "minute", tMINUTE_UNIT, 1 }, { "min", tMINUTE_UNIT, 1 }, { "second", tSEC_UNIT, 1 }, { "sec", tSEC_UNIT, 1 }, { NULL } }; /* Assorted relative-time words. */ static TABLE const OtherTable[] = { { "tomorrow", tMINUTE_UNIT, 1 * 24 * 60 }, { "yesterday", tMINUTE_UNIT, -1 * 24 * 60 }, { "today", tMINUTE_UNIT, 0 }, { "now", tMINUTE_UNIT, 0 }, { "last", tUNUMBER, -1 }, { "this", tMINUTE_UNIT, 0 }, { "next", tUNUMBER, 2 }, { "first", tUNUMBER, 1 }, /* { "second", tUNUMBER, 2 }, */ { "third", tUNUMBER, 3 }, { "fourth", tUNUMBER, 4 }, { "fifth", tUNUMBER, 5 }, { "sixth", tUNUMBER, 6 }, { "seventh", tUNUMBER, 7 }, { "eighth", tUNUMBER, 8 }, { "ninth", tUNUMBER, 9 }, { "tenth", tUNUMBER, 10 }, { "eleventh", tUNUMBER, 11 }, { "twelfth", tUNUMBER, 12 }, { "ago", tAGO, 1 }, { NULL } }; /* The timezone table. */ /* Some of these are commented out because a time_t can't store a float. */ static TABLE const TimezoneTable[] = { { "gmt", tZONE, HOUR ( 0) }, /* Greenwich Mean */ { "ut", tZONE, HOUR ( 0) }, /* Universal (Coordinated) */ { "utc", tZONE, HOUR ( 0) }, { "wet", tZONE, HOUR ( 0) }, /* Western European */ { "bst", tDAYZONE, HOUR ( 0) }, /* British Summer */ { "wat", tZONE, HOUR ( 1) }, /* West Africa */ { "at", tZONE, HOUR ( 2) }, /* Azores */ #if 0 /* For completeness. BST is also British Summer, and GST is * also Guam Standard. */ { "bst", tZONE, HOUR ( 3) }, /* Brazil Standard */ { "gst", tZONE, HOUR ( 3) }, /* Greenland Standard */ #endif #if 0 { "nft", tZONE, HOUR (3.5) }, /* Newfoundland */ { "nst", tZONE, HOUR (3.5) }, /* Newfoundland Standard */ { "ndt", tDAYZONE, HOUR (3.5) }, /* Newfoundland Daylight */ #endif { "ast", tZONE, HOUR ( 4) }, /* Atlantic Standard */ { "adt", tDAYZONE, HOUR ( 4) }, /* Atlantic Daylight */ { "est", tZONE, HOUR ( 5) }, /* Eastern Standard */ { "edt", tDAYZONE, HOUR ( 5) }, /* Eastern Daylight */ { "cst", tZONE, HOUR ( 6) }, /* Central Standard */ { "cdt", tDAYZONE, HOUR ( 6) }, /* Central Daylight */ { "mst", tZONE, HOUR ( 7) }, /* Mountain Standard */ { "mdt", tDAYZONE, HOUR ( 7) }, /* Mountain Daylight */ { "pst", tZONE, HOUR ( 8) }, /* Pacific Standard */ { "pdt", tDAYZONE, HOUR ( 8) }, /* Pacific Daylight */ { "yst", tZONE, HOUR ( 9) }, /* Yukon Standard */ { "ydt", tDAYZONE, HOUR ( 9) }, /* Yukon Daylight */ { "hst", tZONE, HOUR (10) }, /* Hawaii Standard */ { "hdt", tDAYZONE, HOUR (10) }, /* Hawaii Daylight */ { "cat", tZONE, HOUR (10) }, /* Central Alaska */ { "ahst", tZONE, HOUR (10) }, /* Alaska-Hawaii Standard */ { "nt", tZONE, HOUR (11) }, /* Nome */ { "idlw", tZONE, HOUR (12) }, /* International Date Line West */ { "cet", tZONE, -HOUR (1) }, /* Central European */ { "met", tZONE, -HOUR (1) }, /* Middle European */ { "mewt", tZONE, -HOUR (1) }, /* Middle European Winter */ { "mest", tDAYZONE, -HOUR (1) }, /* Middle European Summer */ { "mesz", tDAYZONE, -HOUR (1) }, /* Middle European Summer */ { "swt", tZONE, -HOUR (1) }, /* Swedish Winter */ { "sst", tDAYZONE, -HOUR (1) }, /* Swedish Summer */ { "fwt", tZONE, -HOUR (1) }, /* French Winter */ { "fst", tDAYZONE, -HOUR (1) }, /* French Summer */ { "eet", tZONE, -HOUR (2) }, /* Eastern Europe, USSR Zone 1 */ { "bt", tZONE, -HOUR (3) }, /* Baghdad, USSR Zone 2 */ #if 0 { "it", tZONE, -HOUR (3.5) },/* Iran */ #endif { "zp4", tZONE, -HOUR (4) }, /* USSR Zone 3 */ { "zp5", tZONE, -HOUR (5) }, /* USSR Zone 4 */ #if 0 { "ist", tZONE, -HOUR (5.5) },/* Indian Standard */ #endif { "zp6", tZONE, -HOUR (6) }, /* USSR Zone 5 */ #if 0 /* For completeness. NST is also Newfoundland Standard, and SST is * also Swedish Summer. */ { "nst", tZONE, -HOUR (6.5) },/* North Sumatra */ { "sst", tZONE, -HOUR (7) }, /* South Sumatra, USSR Zone 6 */ #endif /* 0 */ { "wast", tZONE, -HOUR (7) }, /* West Australian Standard */ { "wadt", tDAYZONE, -HOUR (7) }, /* West Australian Daylight */ #if 0 { "jt", tZONE, -HOUR (7.5) },/* Java (3pm in Cronusland!) */ #endif { "cct", tZONE, -HOUR (8) }, /* China Coast, USSR Zone 7 */ { "jst", tZONE, -HOUR (9) }, /* Japan Standard, USSR Zone 8 */ #if 0 { "cast", tZONE, -HOUR (9.5) },/* Central Australian Standard */ { "cadt", tDAYZONE, -HOUR (9.5) },/* Central Australian Daylight */ #endif { "east", tZONE, -HOUR (10) }, /* Eastern Australian Standard */ { "eadt", tDAYZONE, -HOUR (10) }, /* Eastern Australian Daylight */ { "gst", tZONE, -HOUR (10) }, /* Guam Standard, USSR Zone 9 */ { "nzt", tZONE, -HOUR (12) }, /* New Zealand */ { "nzst", tZONE, -HOUR (12) }, /* New Zealand Standard */ { "nzdt", tDAYZONE, -HOUR (12) }, /* New Zealand Daylight */ { "idle", tZONE, -HOUR (12) }, /* International Date Line East */ { NULL } }; /* Military timezone table. */ static TABLE const MilitaryTable[] = { { "a", tZONE, HOUR ( 1) }, { "b", tZONE, HOUR ( 2) }, { "c", tZONE, HOUR ( 3) }, { "d", tZONE, HOUR ( 4) }, { "e", tZONE, HOUR ( 5) }, { "f", tZONE, HOUR ( 6) }, { "g", tZONE, HOUR ( 7) }, { "h", tZONE, HOUR ( 8) }, { "i", tZONE, HOUR ( 9) }, { "k", tZONE, HOUR ( 10) }, { "l", tZONE, HOUR ( 11) }, { "m", tZONE, HOUR ( 12) }, { "n", tZONE, HOUR (- 1) }, { "o", tZONE, HOUR (- 2) }, { "p", tZONE, HOUR (- 3) }, { "q", tZONE, HOUR (- 4) }, { "r", tZONE, HOUR (- 5) }, { "s", tZONE, HOUR (- 6) }, { "t", tZONE, HOUR (- 7) }, { "u", tZONE, HOUR (- 8) }, { "v", tZONE, HOUR (- 9) }, { "w", tZONE, HOUR (-10) }, { "x", tZONE, HOUR (-11) }, { "y", tZONE, HOUR (-12) }, { "z", tZONE, HOUR ( 0) }, { NULL } }; /* ARGSUSED */ static int yyerror (s) char *s; { return 0; } static time_t ToSeconds (Hours, Minutes, Seconds, Meridian) time_t Hours; time_t Minutes; time_t Seconds; MERIDIAN Meridian; { if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) return -1; switch (Meridian) { case MER24: if (Hours < 0 || Hours > 23) return -1; return (Hours * 60L + Minutes) * 60L + Seconds; case MERam: if (Hours < 1 || Hours > 12) return -1; if (Hours == 12) Hours = 0; return (Hours * 60L + Minutes) * 60L + Seconds; case MERpm: if (Hours < 1 || Hours > 12) return -1; if (Hours == 12) Hours = 0; return ((Hours + 12) * 60L + Minutes) * 60L + Seconds; default: abort (); } /* NOTREACHED */ } static time_t Convert (Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode) time_t Month; time_t Day; time_t Year; time_t Hours; time_t Minutes; time_t Seconds; MERIDIAN Meridian; DSTMODE DSTmode; { static int DaysInMonth[12] = { 31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 }; time_t tod; time_t Julian; int i; if (Year < 0) Year = -Year; if (Year < 100) Year += 1900; DaysInMonth[1] = Year % 4 == 0 && (Year % 100 != 0 || Year % 400 == 0) ? 29 : 28; if (Year < EPOCH || Year > 1999 || Month < 1 || Month > 12 /* Lint fluff: "conversion from long may lose accuracy" */ || Day < 1 || Day > DaysInMonth[(int)--Month]) return -1; for (Julian = Day - 1, i = 0; i < Month; i++) Julian += DaysInMonth[i]; for (i = EPOCH; i < Year; i++) Julian += 365 + (i % 4 == 0); Julian *= SECSPERDAY; Julian += yyTimezone * 60L; if ((tod = ToSeconds (Hours, Minutes, Seconds, Meridian)) < 0) return -1; Julian += tod; if (DSTmode == DSTon || (DSTmode == DSTmaybe && localtime (&Julian)->tm_isdst)) Julian -= 60 * 60; return Julian; } static time_t DSTcorrect (Start, Future) time_t Start; time_t Future; { time_t StartDay; time_t FutureDay; StartDay = (localtime (&Start)->tm_hour + 1) % 24; FutureDay = (localtime (&Future)->tm_hour + 1) % 24; return (Future - Start) + (StartDay - FutureDay) * 60L * 60L; } static time_t RelativeDate (Start, DayOrdinal, DayNumber) time_t Start; time_t DayOrdinal; time_t DayNumber; { struct tm *tm; time_t now; now = Start; tm = localtime (&now); now += SECSPERDAY * ((DayNumber - tm->tm_wday + 7) % 7); now += 7 * SECSPERDAY * (DayOrdinal <= 0 ? DayOrdinal : DayOrdinal - 1); return DSTcorrect (Start, now); } static time_t RelativeMonth (Start, RelMonth) time_t Start; time_t RelMonth; { struct tm *tm; time_t Month; time_t Year; if (RelMonth == 0) return 0; tm = localtime (&Start); Month = 12 * tm->tm_year + tm->tm_mon + RelMonth; Year = Month / 12; Month = Month % 12 + 1; return DSTcorrect (Start, Convert (Month, (time_t)tm->tm_mday, Year, (time_t)tm->tm_hour, (time_t)tm->tm_min, (time_t)tm->tm_sec, MER24, DSTmaybe)); } static int LookupWord (buff) char *buff; { register char *p; register char *q; register const TABLE *tp; int i; int abbrev; /* Make it lowercase. */ for (p = buff; *p; p++) if (isupper (*p)) *p = tolower (*p); if (strcmp (buff, "am") == 0 || strcmp (buff, "a.m.") == 0) { yylval.Meridian = MERam; return tMERIDIAN; } if (strcmp (buff, "pm") == 0 || strcmp (buff, "p.m.") == 0) { yylval.Meridian = MERpm; return tMERIDIAN; } /* See if we have an abbreviation for a month. */ if (strlen (buff) == 3) abbrev = 1; else if (strlen (buff) == 4 && buff[3] == '.') { abbrev = 1; buff[3] = '\0'; } else abbrev = 0; for (tp = MonthDayTable; tp->name; tp++) { if (abbrev) { if (strncmp (buff, tp->name, 3) == 0) { yylval.Number = tp->value; return tp->type; } } else if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } } for (tp = TimezoneTable; tp->name; tp++) if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } if (strcmp (buff, "dst") == 0) return tDST; for (tp = UnitsTable; tp->name; tp++) if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } /* Strip off any plural and try the units table again. */ i = strlen (buff) - 1; if (buff[i] == 's') { buff[i] = '\0'; for (tp = UnitsTable; tp->name; tp++) if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } buff[i] = 's'; /* Put back for "this" in OtherTable. */ } for (tp = OtherTable; tp->name; tp++) if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } /* Military timezones. */ if (buff[1] == '\0' && isalpha (*buff)) { for (tp = MilitaryTable; tp->name; tp++) if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } } /* Drop out any periods and try the timezone table again. */ for (i = 0, p = q = buff; *q; q++) if (*q != '.') *p++ = *q; else i++; *p = '\0'; if (i) for (tp = TimezoneTable; tp->name; tp++) if (strcmp (buff, tp->name) == 0) { yylval.Number = tp->value; return tp->type; } return tID; } static int yylex () { register char c; register char *p; char buff[20]; int Count; int sign; for ( ; ; ) { while (isspace (*yyInput)) yyInput++; if (isdigit (c = *yyInput) || c == '-' || c == '+') { if (c == '-' || c == '+') { sign = c == '-' ? -1 : 1; if (!isdigit (*++yyInput)) /* skip the '-' sign */ continue; } else sign = 0; for (yylval.Number = 0; isdigit (c = *yyInput++); ) yylval.Number = 10 * yylval.Number + c - '0'; yyInput--; if (sign < 0) yylval.Number = -yylval.Number; return sign ? tSNUMBER : tUNUMBER; } if (isalpha (c)) { for (p = buff; isalpha (c = *yyInput++) || c == '.'; ) if (p < &buff[sizeof buff - 1]) *p++ = c; *p = '\0'; yyInput--; return LookupWord (buff); } if (c != '(') return *yyInput++; Count = 0; do { c = *yyInput++; if (c == '\0') return c; if (c == '(') Count++; else if (c == ')') Count--; } while (Count > 0); } } #define TM_YEAR_ORIGIN 1900 /* Yield A - B, measured in seconds. */ static long difftm (a, b) struct tm *a, *b; { int ay = a->tm_year + (TM_YEAR_ORIGIN - 1); int by = b->tm_year + (TM_YEAR_ORIGIN - 1); long days = ( /* difference in day of year */ a->tm_yday - b->tm_yday /* + intervening leap days */ + ((ay >> 2) - (by >> 2)) - (ay/100 - by/100) + ((ay/100 >> 2) - (by/100 >> 2)) /* + difference in years * 365 */ + (long)(ay-by) * 365 ); return (60*(60*(24*days + (a->tm_hour - b->tm_hour)) + (a->tm_min - b->tm_min)) + (a->tm_sec - b->tm_sec)); } time_t get_date (p, now) char *p; struct timeb *now; { struct tm *tm, gmt; struct timeb ftz; time_t Start; time_t tod; yyInput = p; if (now == NULL) { now = &ftz; (void)time (&ftz.time); if (! (tm = gmtime (&ftz.time))) return -1; gmt = *tm; /* Make a copy, in case localtime modifies *tm. */ if (! (tm = localtime (&ftz.time))) return -1; ftz.timezone = difftm (&gmt, tm) / 60; if (tm->tm_isdst) ftz.timezone += 60; } tm = localtime (&now->time); yyYear = tm->tm_year; yyMonth = tm->tm_mon + 1; yyDay = tm->tm_mday; yyTimezone = now->timezone; yyDSTmode = DSTmaybe; yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24; yyRelSeconds = 0; yyRelMonth = 0; yyHaveDate = 0; yyHaveDay = 0; yyHaveRel = 0; yyHaveTime = 0; yyHaveZone = 0; if (yyparse () || yyHaveTime > 1 || yyHaveZone > 1 || yyHaveDate > 1 || yyHaveDay > 1) return -1; if (yyHaveDate || yyHaveTime || yyHaveDay) { Start = Convert (yyMonth, yyDay, yyYear, yyHour, yyMinutes, yySeconds, yyMeridian, yyDSTmode); if (Start < 0) return -1; } else { Start = now->time; if (!yyHaveRel) Start -= ((tm->tm_hour * 60L + tm->tm_min) * 60L) + tm->tm_sec; } Start += yyRelSeconds; Start += RelativeMonth (Start, yyRelMonth); if (yyHaveDay && !yyHaveDate) { tod = RelativeDate (Start, yyDayOrdinal, yyDayNumber); Start += tod; } /* Have to do *something* with a legitimate -1 so it's distinguishable * from the error return value. (Alternately could set errno on error.) */ return Start == -1 ? 0 : Start; } #if defined (TEST) /* ARGSUSED */ int main (ac, av) int ac; char *av[]; { char buff[MAX_BUFF_LEN + 1]; time_t d; (void)printf ("Enter date, or blank line to exit.\n\t> "); (void)fflush (stdout); buff[MAX_BUFF_LEN] = 0; while (fgets (buff, MAX_BUFF_LEN, stdin) && buff[0]) { d = get_date (buff, (struct timeb *)NULL); if (d == -1) (void)printf ("Bad format - couldn't convert.\n"); else (void)printf ("%s", ctime (&d)); (void)printf ("\t> "); (void)fflush (stdout); } exit (0); /* NOTREACHED */ } #endif /* defined (TEST) */ emacs-19.30/lib-src/getopt.c100444 12241 1 53211 6033303100 14571 0ustar rolanddaemon/* Getopt for GNU. NOTE: getopt is now part of the C library, so if you don't know what "Keep this file name-space clean" means, talk to roland@gnu.ai.mit.edu before changing it! Copyright (C) 1987, 88, 89, 90, 91, 92, 93, 94, 95 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* This tells Alpha OSF/1 not to define a getopt prototype in . Ditto for AIX 3.2 and . */ #ifndef _NO_PROTO #define _NO_PROTO #endif #ifdef HAVE_CONFIG_H #include #endif #if !defined (__STDC__) || !__STDC__ /* This is a separate conditional since some stdc systems reject `defined (const)'. */ #ifndef const #define const #endif #endif #include /* Comment out all this code if we are using the GNU C Library, and are not actually compiling the library itself. This code is part of the GNU C Library, but also included in many other GNU distributions. Compiling and linking in this code is a waste when using the GNU C library (especially if it is a shared library). Rather than having every GNU program understand `configure --with-gnu-libc' and omit the object files, it is simpler to just do this in the source for each such file. */ #if defined (_LIBC) || !defined (__GNU_LIBRARY__) /* This needs to come after some library #include to get __GNU_LIBRARY__ defined. */ #ifdef __GNU_LIBRARY__ /* Don't include stdlib.h for non-GNU C libraries because some of them contain conflicting prototypes for getopt. */ #include #endif /* GNU C library. */ #ifndef _ /* This is for other GNU distributions with internationalized messages. When compiling libc, the _ macro is predefined. */ #ifdef HAVE_LIBINTL_H # include # define _(msgid) gettext (msgid) #else # define _(msgid) (msgid) #endif #endif /* This version of `getopt' appears to the caller like standard Unix `getopt' but it behaves differently for the user, since it allows the user to intersperse the options with the other arguments. As `getopt' works, it permutes the elements of ARGV so that, when it is done, all the options precede everything else. Thus all application programs are extended to handle flexible argument order. Setting the environment variable POSIXLY_CORRECT disables permutation. Then the behavior is completely standard. GNU application programs can use a third alternative mode in which they can distinguish the relative order of options and other arguments. */ #include "getopt.h" /* For communication from `getopt' to the caller. When `getopt' finds an option that takes an argument, the argument value is returned here. Also, when `ordering' is RETURN_IN_ORDER, each non-option ARGV-element is returned here. */ char *optarg = NULL; /* Index in ARGV of the next element to be scanned. This is used for communication to and from the caller and for communication between successive calls to `getopt'. On entry to `getopt', zero means this is the first call; initialize. When `getopt' returns EOF, this is the index of the first of the non-option elements that the caller should itself scan. Otherwise, `optind' communicates from one call to the next how much of ARGV has been scanned so far. */ /* XXX 1003.2 says this must be 1 before any call. */ int optind = 0; /* The next char to be scanned in the option-element in which the last option character we returned was found. This allows us to pick up the scan where we left off. If this is zero, or a null string, it means resume the scan by advancing to the next ARGV-element. */ static char *nextchar; /* Callers store zero here to inhibit the error message for unrecognized options. */ int opterr = 1; /* Set to an option character which was unrecognized. This must be initialized on some systems to avoid linking in the system's own getopt implementation. */ int optopt = '?'; /* Describe how to deal with options that follow non-option ARGV-elements. If the caller did not specify anything, the default is REQUIRE_ORDER if the environment variable POSIXLY_CORRECT is defined, PERMUTE otherwise. REQUIRE_ORDER means don't recognize them as options; stop option processing when the first non-option is seen. This is what Unix does. This mode of operation is selected by either setting the environment variable POSIXLY_CORRECT, or using `+' as the first character of the list of option characters. PERMUTE is the default. We permute the contents of ARGV as we scan, so that eventually all the non-options are at the end. This allows options to be given in any order, even with programs that were not written to expect this. RETURN_IN_ORDER is an option available to programs that were written to expect options and other ARGV-elements in any order and that care about the ordering of the two. We describe each non-option ARGV-element as if it were the argument of an option with character code 1. Using `-' as the first character of the list of option characters selects this mode of operation. The special argument `--' forces an end of option-scanning regardless of the value of `ordering'. In the case of RETURN_IN_ORDER, only `--' can cause `getopt' to return EOF with `optind' != ARGC. */ static enum { REQUIRE_ORDER, PERMUTE, RETURN_IN_ORDER } ordering; /* Value of POSIXLY_CORRECT environment variable. */ static char *posixly_correct; #ifdef __GNU_LIBRARY__ /* We want to avoid inclusion of string.h with non-GNU libraries because there are many ways it can cause trouble. On some systems, it contains special magic macros that don't work in GCC. */ #include #define my_index strchr #else /* Avoid depending on library functions or files whose names are inconsistent. */ char *getenv (); static char * my_index (str, chr) const char *str; int chr; { while (*str) { if (*str == chr) return (char *) str; str++; } return 0; } /* If using GCC, we can safely declare strlen this way. If not using GCC, it is ok not to declare it. */ #ifdef __GNUC__ /* Note that Motorola Delta 68k R3V7 comes with GCC but not stddef.h. That was relevant to code that was here before. */ #if !defined (__STDC__) || !__STDC__ /* gcc with -traditional declares the built-in strlen to return int, and has done so at least since version 2.4.5. -- rms. */ extern int strlen (const char *); #endif /* not __STDC__ */ #endif /* __GNUC__ */ #endif /* not __GNU_LIBRARY__ */ /* Handle permutation of arguments. */ /* Describe the part of ARGV that contains non-options that have been skipped. `first_nonopt' is the index in ARGV of the first of them; `last_nonopt' is the index after the last of them. */ static int first_nonopt; static int last_nonopt; /* Exchange two adjacent subsequences of ARGV. One subsequence is elements [first_nonopt,last_nonopt) which contains all the non-options that have been skipped so far. The other is elements [last_nonopt,optind), which contains all the options processed since those non-options were skipped. `first_nonopt' and `last_nonopt' are relocated so that they describe the new indices of the non-options in ARGV after they are moved. */ static void exchange (argv) char **argv; { int bottom = first_nonopt; int middle = last_nonopt; int top = optind; char *tem; /* Exchange the shorter segment with the far end of the longer segment. That puts the shorter segment into the right place. It leaves the longer segment in the right place overall, but it consists of two parts that need to be swapped next. */ while (top > middle && middle > bottom) { if (top - middle > middle - bottom) { /* Bottom segment is the short one. */ int len = middle - bottom; register int i; /* Swap it with the top part of the top segment. */ for (i = 0; i < len; i++) { tem = argv[bottom + i]; argv[bottom + i] = argv[top - (middle - bottom) + i]; argv[top - (middle - bottom) + i] = tem; } /* Exclude the moved bottom segment from further swapping. */ top -= len; } else { /* Top segment is the short one. */ int len = top - middle; register int i; /* Swap it with the bottom part of the bottom segment. */ for (i = 0; i < len; i++) { tem = argv[bottom + i]; argv[bottom + i] = argv[middle + i]; argv[middle + i] = tem; } /* Exclude the moved top segment from further swapping. */ bottom += len; } } /* Update records for the slots the non-options now occupy. */ first_nonopt += (optind - last_nonopt); last_nonopt = optind; } /* Initialize the internal data when the first call is made. */ static const char * _getopt_initialize (optstring) const char *optstring; { /* Start processing options with ARGV-element 1 (since ARGV-element 0 is the program name); the sequence of previously skipped non-option ARGV-elements is empty. */ first_nonopt = last_nonopt = optind = 1; nextchar = NULL; posixly_correct = getenv ("POSIXLY_CORRECT"); /* Determine how to handle the ordering of options and nonoptions. */ if (optstring[0] == '-') { ordering = RETURN_IN_ORDER; ++optstring; } else if (optstring[0] == '+') { ordering = REQUIRE_ORDER; ++optstring; } else if (posixly_correct != NULL) ordering = REQUIRE_ORDER; else ordering = PERMUTE; return optstring; } /* Scan elements of ARGV (whose length is ARGC) for option characters given in OPTSTRING. If an element of ARGV starts with '-', and is not exactly "-" or "--", then it is an option element. The characters of this element (aside from the initial '-') are option characters. If `getopt' is called repeatedly, it returns successively each of the option characters from each of the option elements. If `getopt' finds another option character, it returns that character, updating `optind' and `nextchar' so that the next call to `getopt' can resume the scan with the following option character or ARGV-element. If there are no more option characters, `getopt' returns `EOF'. Then `optind' is the index in ARGV of the first ARGV-element that is not an option. (The ARGV-elements have been permuted so that those that are not options now come last.) OPTSTRING is a string containing the legitimate option characters. If an option character is seen that is not listed in OPTSTRING, return '?' after printing an error message. If you set `opterr' to zero, the error message is suppressed but we still return '?'. If a char in OPTSTRING is followed by a colon, that means it wants an arg, so the following text in the same ARGV-element, or the text of the following ARGV-element, is returned in `optarg'. Two colons mean an option that wants an optional arg; if there is text in the current ARGV-element, it is returned in `optarg', otherwise `optarg' is set to zero. If OPTSTRING starts with `-' or `+', it requests different methods of handling the non-option ARGV-elements. See the comments about RETURN_IN_ORDER and REQUIRE_ORDER, above. Long-named options begin with `--' instead of `-'. Their names may be abbreviated as long as the abbreviation is unique or is an exact match for some defined option. If they have an argument, it follows the option name in the same ARGV-element, separated from the option name by a `=', or else the in next ARGV-element. When `getopt' finds a long-named option, it returns 0 if that option's `flag' field is nonzero, the value of the option's `val' field if the `flag' field is zero. The elements of ARGV aren't really const, because we permute them. But we pretend they're const in the prototype to be compatible with other systems. LONGOPTS is a vector of `struct option' terminated by an element containing a name which is zero. LONGIND returns the index in LONGOPT of the long-named option found. It is only valid when a long-named option has been found by the most recent call. If LONG_ONLY is nonzero, '-' as well as '--' can introduce long-named options. */ int _getopt_internal (argc, argv, optstring, longopts, longind, long_only) int argc; char *const *argv; const char *optstring; const struct option *longopts; int *longind; int long_only; { optarg = NULL; if (optind == 0) { optstring = _getopt_initialize (optstring); optind = 1; /* Don't scan ARGV[0], the program name. */ } if (nextchar == NULL || *nextchar == '\0') { /* Advance to the next ARGV-element. */ if (ordering == PERMUTE) { /* If we have just processed some options following some non-options, exchange them so that the options come first. */ if (first_nonopt != last_nonopt && last_nonopt != optind) exchange ((char **) argv); else if (last_nonopt != optind) first_nonopt = optind; /* Skip any additional non-options and extend the range of non-options previously skipped. */ while (optind < argc && (argv[optind][0] != '-' || argv[optind][1] == '\0')) optind++; last_nonopt = optind; } /* The special ARGV-element `--' means premature end of options. Skip it like a null option, then exchange with previous non-options as if it were an option, then skip everything else like a non-option. */ if (optind != argc && !strcmp (argv[optind], "--")) { optind++; if (first_nonopt != last_nonopt && last_nonopt != optind) exchange ((char **) argv); else if (first_nonopt == last_nonopt) first_nonopt = optind; last_nonopt = argc; optind = argc; } /* If we have done all the ARGV-elements, stop the scan and back over any non-options that we skipped and permuted. */ if (optind == argc) { /* Set the next-arg-index to point at the non-options that we previously skipped, so the caller will digest them. */ if (first_nonopt != last_nonopt) optind = first_nonopt; return EOF; } /* If we have come to a non-option and did not permute it, either stop the scan or describe it to the caller and pass it by. */ if ((argv[optind][0] != '-' || argv[optind][1] == '\0')) { if (ordering == REQUIRE_ORDER) return EOF; optarg = argv[optind++]; return 1; } /* We have found another option-ARGV-element. Skip the initial punctuation. */ nextchar = (argv[optind] + 1 + (longopts != NULL && argv[optind][1] == '-')); } /* Decode the current option-ARGV-element. */ /* Check whether the ARGV-element is a long option. If long_only and the ARGV-element has the form "-f", where f is a valid short option, don't consider it an abbreviated form of a long option that starts with f. Otherwise there would be no way to give the -f short option. On the other hand, if there's a long option "fubar" and the ARGV-element is "-fu", do consider that an abbreviation of the long option, just like "--fu", and not "-f" with arg "u". This distinction seems to be the most useful approach. */ if (longopts != NULL && (argv[optind][1] == '-' || (long_only && (argv[optind][2] || !my_index (optstring, argv[optind][1]))))) { char *nameend; const struct option *p; const struct option *pfound = NULL; int exact = 0; int ambig = 0; int indfound; int option_index; for (nameend = nextchar; *nameend && *nameend != '='; nameend++) /* Do nothing. */ ; /* Test all long options for either exact match or abbreviated matches. */ for (p = longopts, option_index = 0; p->name; p++, option_index++) if (!strncmp (p->name, nextchar, nameend - nextchar)) { if (nameend - nextchar == strlen (p->name)) { /* Exact match found. */ pfound = p; indfound = option_index; exact = 1; break; } else if (pfound == NULL) { /* First nonexact match found. */ pfound = p; indfound = option_index; } else /* Second or later nonexact match found. */ ambig = 1; } if (ambig && !exact) { if (opterr) fprintf (stderr, _("%s: option `%s' is ambiguous\n"), argv[0], argv[optind]); nextchar += strlen (nextchar); optind++; return '?'; } if (pfound != NULL) { option_index = indfound; optind++; if (*nameend) { /* Don't test has_arg with >, because some C compilers don't allow it to be used on enums. */ if (pfound->has_arg) optarg = nameend + 1; else { if (opterr) if (argv[optind - 1][1] == '-') /* --option */ fprintf (stderr, _("%s: option `--%s' doesn't allow an argument\n"), argv[0], pfound->name); else /* +option or -option */ fprintf (stderr, _("%s: option `%c%s' doesn't allow an argument\n"), argv[0], argv[optind - 1][0], pfound->name); nextchar += strlen (nextchar); return '?'; } } else if (pfound->has_arg == 1) { if (optind < argc) optarg = argv[optind++]; else { if (opterr) fprintf (stderr, _("%s: option `%s' requires an argument\n"), argv[0], argv[optind - 1]); nextchar += strlen (nextchar); return optstring[0] == ':' ? ':' : '?'; } } nextchar += strlen (nextchar); if (longind != NULL) *longind = option_index; if (pfound->flag) { *(pfound->flag) = pfound->val; return 0; } return pfound->val; } /* Can't find it as a long option. If this is not getopt_long_only, or the option starts with '--' or is not a valid short option, then it's an error. Otherwise interpret it as a short option. */ if (!long_only || argv[optind][1] == '-' || my_index (optstring, *nextchar) == NULL) { if (opterr) { if (argv[optind][1] == '-') /* --option */ fprintf (stderr, _("%s: unrecognized option `--%s'\n"), argv[0], nextchar); else /* +option or -option */ fprintf (stderr, _("%s: unrecognized option `%c%s'\n"), argv[0], argv[optind][0], nextchar); } nextchar = (char *) ""; optind++; return '?'; } } /* Look at and handle the next short option-character. */ { char c = *nextchar++; char *temp = my_index (optstring, c); /* Increment `optind' when we start to process its last character. */ if (*nextchar == '\0') ++optind; if (temp == NULL || c == ':') { if (opterr) { if (posixly_correct) /* 1003.2 specifies the format of this message. */ fprintf (stderr, _("%s: illegal option -- %c\n"), argv[0], c); else fprintf (stderr, _("%s: invalid option -- %c\n"), argv[0], c); } optopt = c; return '?'; } if (temp[1] == ':') { if (temp[2] == ':') { /* This is an option that accepts an argument optionally. */ if (*nextchar != '\0') { optarg = nextchar; optind++; } else optarg = NULL; nextchar = NULL; } else { /* This is an option that requires an argument. */ if (*nextchar != '\0') { optarg = nextchar; /* If we end this ARGV-element by taking the rest as an arg, we must advance to the next element now. */ optind++; } else if (optind == argc) { if (opterr) { /* 1003.2 specifies the format of this message. */ fprintf (stderr, _("%s: option requires an argument -- %c\n"), argv[0], c); } optopt = c; if (optstring[0] == ':') c = ':'; else c = '?'; } else /* We already incremented `optind' once; increment it again when taking next ARGV-elt as argument. */ optarg = argv[optind++]; nextchar = NULL; } } return c; } } int getopt (argc, argv, optstring) int argc; char *const *argv; const char *optstring; { return _getopt_internal (argc, argv, optstring, (const struct option *) 0, (int *) 0, 0); } #endif /* _LIBC or not __GNU_LIBRARY__. */ #ifdef TEST /* Compile with -DTEST to make an executable for use in testing the above definition of `getopt'. */ int main (argc, argv) int argc; char **argv; { int c; int digit_optind = 0; while (1) { int this_option_optind = optind ? optind : 1; c = getopt (argc, argv, "abc:d:0123456789"); if (c == EOF) break; switch (c) { case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': if (digit_optind != 0 && digit_optind != this_option_optind) printf ("digits occur in two different argv-elements.\n"); digit_optind = this_option_optind; printf ("option %c\n", c); break; case 'a': printf ("option a\n"); break; case 'b': printf ("option b\n"); break; case 'c': printf ("option c with value `%s'\n", optarg); break; case '?': break; default: printf ("?? getopt returned character code 0%o ??\n", c); } } if (optind < argc) { printf ("non-option ARGV-elements: "); while (optind < argc) printf ("%s ", argv[optind++]); printf ("\n"); } exit (0); } #endif /* TEST */ emacs-19.30/lib-src/getopt.h100444 12241 1 10526 5655157302 14624 0ustar rolanddaemon/* Declarations for getopt. Copyright (C) 1989, 90, 91, 92, 93, 94 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef _GETOPT_H #define _GETOPT_H 1 #ifdef __cplusplus extern "C" { #endif /* For communication from `getopt' to the caller. When `getopt' finds an option that takes an argument, the argument value is returned here. Also, when `ordering' is RETURN_IN_ORDER, each non-option ARGV-element is returned here. */ extern char *optarg; /* Index in ARGV of the next element to be scanned. This is used for communication to and from the caller and for communication between successive calls to `getopt'. On entry to `getopt', zero means this is the first call; initialize. When `getopt' returns EOF, this is the index of the first of the non-option elements that the caller should itself scan. Otherwise, `optind' communicates from one call to the next how much of ARGV has been scanned so far. */ extern int optind; /* Callers store zero here to inhibit the error message `getopt' prints for unrecognized options. */ extern int opterr; /* Set to an option character which was unrecognized. */ extern int optopt; /* Describe the long-named options requested by the application. The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector of `struct option' terminated by an element containing a name which is zero. The field `has_arg' is: no_argument (or 0) if the option does not take an argument, required_argument (or 1) if the option requires an argument, optional_argument (or 2) if the option takes an optional argument. If the field `flag' is not NULL, it points to a variable that is set to the value given in the field `val' when the option is found, but left unchanged if the option is not found. To have a long-named option do something other than set an `int' to a compiled-in constant, such as set a value from `optarg', set the option's `flag' field to zero and its `val' field to a nonzero value (the equivalent single-letter option character, if there is one). For long options that have a zero `flag' field, `getopt' returns the contents of the `val' field. */ struct option { #if defined (__STDC__) && __STDC__ const char *name; #else char *name; #endif /* has_arg can't be an enum because some compilers complain about type mismatches in all the code that assumes it is an int. */ int has_arg; int *flag; int val; }; /* Names for the values of the `has_arg' field of `struct option'. */ #define no_argument 0 #define required_argument 1 #define optional_argument 2 #if defined (__STDC__) && __STDC__ #ifdef __GNU_LIBRARY__ /* Many other libraries have conflicting prototypes for getopt, with differences in the consts, in stdlib.h. To avoid compilation errors, only prototype getopt for the GNU C library. */ extern int getopt (int argc, char *const *argv, const char *shortopts); #else /* not __GNU_LIBRARY__ */ extern int getopt (); #endif /* __GNU_LIBRARY__ */ extern int getopt_long (int argc, char *const *argv, const char *shortopts, const struct option *longopts, int *longind); extern int getopt_long_only (int argc, char *const *argv, const char *shortopts, const struct option *longopts, int *longind); /* Internal only. Users should not call this directly. */ extern int _getopt_internal (int argc, char *const *argv, const char *shortopts, const struct option *longopts, int *longind, int long_only); #else /* not __STDC__ */ extern int getopt (); extern int getopt_long (); extern int getopt_long_only (); extern int _getopt_internal (); #endif /* __STDC__ */ #ifdef __cplusplus } #endif #endif /* _GETOPT_H */ emacs-19.30/lib-src/getopt1.c100444 12241 1 10236 5655157105 14677 0ustar rolanddaemon/* getopt_long and getopt_long_only entry points for GNU getopt. Copyright (C) 1987, 88, 89, 90, 91, 92, 1993, 1994 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifdef HAVE_CONFIG_H #include #endif #include "getopt.h" #if !defined (__STDC__) || !__STDC__ /* This is a separate conditional since some stdc systems reject `defined (const)'. */ #ifndef const #define const #endif #endif #include /* Comment out all this code if we are using the GNU C Library, and are not actually compiling the library itself. This code is part of the GNU C Library, but also included in many other GNU distributions. Compiling and linking in this code is a waste when using the GNU C library (especially if it is a shared library). Rather than having every GNU program understand `configure --with-gnu-libc' and omit the object files, it is simpler to just do this in the source for each such file. */ #if defined (_LIBC) || !defined (__GNU_LIBRARY__) /* This needs to come after some library #include to get __GNU_LIBRARY__ defined. */ #ifdef __GNU_LIBRARY__ #include #else char *getenv (); #endif #ifndef NULL #define NULL 0 #endif int getopt_long (argc, argv, options, long_options, opt_index) int argc; char *const *argv; const char *options; const struct option *long_options; int *opt_index; { return _getopt_internal (argc, argv, options, long_options, opt_index, 0); } /* Like getopt_long, but '-' as well as '--' can indicate a long option. If an option that starts with '-' (not '--') doesn't match a long option, but does match a short option, it is parsed as a short option instead. */ int getopt_long_only (argc, argv, options, long_options, opt_index) int argc; char *const *argv; const char *options; const struct option *long_options; int *opt_index; { return _getopt_internal (argc, argv, options, long_options, opt_index, 1); } #endif /* _LIBC or not __GNU_LIBRARY__. */ #ifdef TEST #include int main (argc, argv) int argc; char **argv; { int c; int digit_optind = 0; while (1) { int this_option_optind = optind ? optind : 1; int option_index = 0; static struct option long_options[] = { {"add", 1, 0, 0}, {"append", 0, 0, 0}, {"delete", 1, 0, 0}, {"verbose", 0, 0, 0}, {"create", 0, 0, 0}, {"file", 1, 0, 0}, {0, 0, 0, 0} }; c = getopt_long (argc, argv, "abc:d:0123456789", long_options, &option_index); if (c == EOF) break; switch (c) { case 0: printf ("option %s", long_options[option_index].name); if (optarg) printf (" with arg %s", optarg); printf ("\n"); break; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': if (digit_optind != 0 && digit_optind != this_option_optind) printf ("digits occur in two different argv-elements.\n"); digit_optind = this_option_optind; printf ("option %c\n", c); break; case 'a': printf ("option a\n"); break; case 'b': printf ("option b\n"); break; case 'c': printf ("option c with value `%s'\n", optarg); break; case 'd': printf ("option d with value `%s'\n", optarg); break; case '?': break; default: printf ("?? getopt returned character code 0%o ??\n", c); } } if (optind < argc) { printf ("non-option ARGV-elements: "); while (optind < argc) printf ("%s ", argv[optind++]); printf ("\n"); } exit (0); } #endif /* TEST */ emacs-19.30/lib-src/hexl.c100444 21570 13 7722 5647043225 13276 0ustar djmuser#include #include #ifdef MSDOS #include #endif #define DEFAULT_GROUPING 0x01 #define DEFAULT_BASE 16 #undef TRUE #undef FALSE #define TRUE (1) #define FALSE (0) int base = DEFAULT_BASE, un_flag = FALSE, iso_flag = FALSE, endian = 1; int group_by = DEFAULT_GROUPING; char *progname; void usage(); int main (argc, argv) int argc; char *argv[]; { register long address; char string[18]; FILE *fp; progname = *argv++; --argc; /* ** -hex hex dump ** -oct Octal dump ** -group-by-8-bits ** -group-by-16-bits ** -group-by-32-bits ** -group-by-64-bits ** -iso iso character set. ** -big-endian Big Endian ** -little-endian Little Endian ** -un || -de from hexl format to binary. ** -- End switch list. ** dump filename ** - (as filename == stdin) */ while (*argv && *argv[0] == '-' && (*argv)[1]) { /* A switch! */ if (!strcmp (*argv, "--")) { --argc; argv++; break; } else if (!strcmp (*argv, "-un") || !strcmp (*argv, "-de")) { un_flag = TRUE; --argc; argv++; } else if (!strcmp (*argv, "-hex")) { base = 16; --argc; argv++; } else if (!strcmp (*argv, "-iso")) { iso_flag = TRUE; --argc; argv++; } else if (!strcmp (*argv, "-oct")) { base = 8; --argc; argv++; } else if (!strcmp (*argv, "-big-endian")) { endian = 1; --argc; argv++; } else if (!strcmp (*argv, "-little-endian")) { endian = 0; --argc; argv++; } else if (!strcmp (*argv, "-group-by-8-bits")) { group_by = 0x00; --argc; argv++; } else if (!strcmp (*argv, "-group-by-16-bits")) { group_by = 0x01; --argc; argv++; } else if (!strcmp (*argv, "-group-by-32-bits")) { group_by = 0x03; --argc; argv++; } else if (!strcmp (*argv, "-group-by-64-bits")) { group_by = 0x07; endian = 0; --argc; argv++; } else { fprintf (stderr, "%s: invalid switch: \"%s\".\n", progname, *argv); usage (); } } do { if (*argv == NULL) fp = stdin; else { char *filename = *argv++; if (!strcmp (filename, "-")) fp = stdin; else if ((fp = fopen (filename, "r")) == NULL) { perror (filename); continue; } } if (un_flag) { char buf[18]; #ifdef MSDOS (stdout)->_flag &= ~_IOTEXT; /* print binary */ _setmode (fileno (stdout), O_BINARY); #endif for (;;) { register int i, c, d; #define hexchar(x) (isdigit (x) ? x - '0' : x - 'a' + 10) fread (buf, 1, 10, fp); /* skip 10 bytes */ for (i=0; i < 16; ++i) { if ((c = getc (fp)) == ' ' || c == EOF) break; d = getc (fp); c = hexchar (c) * 0x10 + hexchar (d); putchar (c); if ((i&group_by) == group_by) getc (fp); } if (c == ' ') { while ((c = getc (fp)) != '\n' && c != EOF) ; if (c == EOF) break; } else { if (i < 16) break; fread (buf, 1, 18, fp); /* skip 18 bytes */ } } } else { #ifdef MSDOS (fp)->_flag &= ~_IOTEXT; /* read binary */ _setmode (fileno (fp), O_BINARY); #endif address = 0; string[0] = ' '; string[17] = '\0'; for (;;) { register int i, c; for (i=0; i < 16; ++i) { if ((c = getc (fp)) == EOF) { if (!i) break; fputs (" ", stdout); string[i+1] = '\0'; } else { if (!i) printf ("%08x: ", address); if (iso_flag) string[i+1] = (c < 0x20 || (c >= 0x7F && c < 0xa0)) ? '.' :c; else string[i+1] = (c < 0x20 || c >= 0x7F) ? '.' : c; printf ("%02x", c); } if ((i&group_by) == group_by) putchar (' '); } if (i) puts (string); if (c == EOF) break; address += 0x10; } } if (fp != stdin) fclose (fp); } while (*argv != NULL); return 0; } void usage () { fprintf (stderr, "usage: %s [-de] [-iso]\n", progname); exit (1); } emacs-19.30/lib-src/leditcfns.c100444 13437 1 653 3461063135 14673 0ustar jimbdaemon#include #include #define STRLEN 100 static char str[STRLEN+1] = "%?emacs"; /* extra char for the null */ switch_to_proc(){ char *ptr = str; while (*ptr) ioctl(0, TIOCSTI, ptr++); ioctl(0, TIOCSTI, "\n"); kill(getpid(), SIGTSTP); } set_proc_str(ptr) char *ptr; { if (strlen(ptr) <= STRLEN) strcpy(str, ptr); else printf("string too long for set-proc-str: %s\n", ptr); } emacs-19.30/lib-src/make-docfile.c100444 12120 13 47133 5772073421 14714 0ustar rmsuser/* Generate doc-string file for GNU Emacs from source files. Copyright (C) 1985, 1986, 1992, 1993, 1994 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. */ /* The arguments given to this program are all the C and Lisp source files of GNU Emacs. .elc and .el and .c files are allowed. A .o file can also be specified; the .c file it was made from is used. This helps the makefile pass the correct list of files. The results, which go to standard output or to a file specified with -a or -o (-a to append, -o to start from nothing), are entries containing function or variable names and their documentation. Each entry starts with a ^_ character. Then comes F for a function or V for a variable. Then comes the function or variable name, terminated with a newline. Then comes the documentation for that function or variable. */ #define NO_SHORTNAMES /* Tell config not to load remap.h */ #include <../src/config.h> #include #ifdef MSDOS #include #endif /* MSDOS */ #ifdef WINDOWSNT #include #include #include #endif /* WINDOWSNT */ #ifdef DOS_NT #define READ_TEXT "rt" #define READ_BINARY "rb" #else /* not DOS_NT */ #define READ_TEXT "r" #define READ_BINARY "r" #endif /* not DOS_NT */ int scan_file (); int scan_lisp_file (); int scan_c_file (); #ifdef MSDOS /* s/msdos.h defines this as sys_chdir, but we're not linking with the file where that function is defined. */ #undef chdir #endif /* Stdio stream for output to the DOC file. */ FILE *outfile; /* Name this program was invoked with. */ char *progname; /* Print error message. `s1' is printf control string, `s2' is arg for it. */ /* VARARGS1 */ void error (s1, s2) char *s1, *s2; { fprintf (stderr, "%s: ", progname); fprintf (stderr, s1, s2); fprintf (stderr, "\n"); } /* Print error message and exit. */ /* VARARGS1 */ void fatal (s1, s2) char *s1, *s2; { error (s1, s2); exit (1); } /* Like malloc but get fatal error if memory is exhausted. */ long * xmalloc (size) unsigned int size; { long *result = (long *) malloc (size); if (result == NULL) fatal ("virtual memory exhausted", 0); return result; } int main (argc, argv) int argc; char **argv; { int i; int err_count = 0; int first_infile; progname = argv[0]; outfile = stdout; /* Don't put CRs in the DOC file. */ #ifdef MSDOS _fmode = O_BINARY; #if 0 /* Suspicion is that this causes hanging. So instead we require people to use -o on MSDOS. */ (stdout)->_flag &= ~_IOTEXT; _setmode (fileno (stdout), O_BINARY); #endif outfile = 0; #endif /* MSDOS */ #ifdef WINDOWSNT _fmode = O_BINARY; _setmode (fileno (stdout), O_BINARY); #endif /* WINDOWSNT */ /* If first two args are -o FILE, output to FILE. */ i = 1; if (argc > i + 1 && !strcmp (argv[i], "-o")) { outfile = fopen (argv[i + 1], "w"); i += 2; } if (argc > i + 1 && !strcmp (argv[i], "-a")) { outfile = fopen (argv[i + 1], "a"); i += 2; } if (argc > i + 1 && !strcmp (argv[i], "-d")) { chdir (argv[i + 1]); i += 2; } if (outfile == 0) fatal ("No output file specified", ""); first_infile = i; for (; i < argc; i++) { int j; /* Don't process one file twice. */ for (j = first_infile; j < i; j++) if (! strcmp (argv[i], argv[j])) break; if (j == i) err_count += scan_file (argv[i]); } #ifndef VMS exit (err_count > 0); #endif /* VMS */ return err_count > 0; } /* Read file FILENAME and output its doc strings to outfile. */ /* Return 1 if file is not found, 0 if it is found. */ int scan_file (filename) char *filename; { int len = strlen (filename); if (len > 4 && !strcmp (filename + len - 4, ".elc")) return scan_lisp_file (filename, READ_BINARY); else if (len > 3 && !strcmp (filename + len - 3, ".el")) return scan_lisp_file (filename, READ_TEXT); else return scan_c_file (filename, READ_TEXT); } char buf[128]; /* Skip a C string from INFILE, and return the character that follows the closing ". If printflag is positive, output string contents to outfile. If it is negative, store contents in buf. Convert escape sequences \n and \t to newline and tab; discard \ followed by newline. */ int read_c_string (infile, printflag) FILE *infile; int printflag; { register int c; char *p = buf; c = getc (infile); while (c != EOF) { while (c != '"' && c != EOF) { if (c == '\\') { c = getc (infile); if (c == '\n') { c = getc (infile); continue; } if (c == 'n') c = '\n'; if (c == 't') c = '\t'; } if (printflag > 0) putc (c, outfile); else if (printflag < 0) *p++ = c; c = getc (infile); } c = getc (infile); if (c != '"') break; /* If we had a "", concatenate the two strings. */ c = getc (infile); } if (printflag < 0) *p = 0; return c; } /* Write to file OUT the argument names of function FUNC, whose text is in BUF. MINARGS and MAXARGS are the minimum and maximum number of arguments. */ void write_c_args (out, func, buf, minargs, maxargs) FILE *out; char *func, *buf; int minargs, maxargs; { register char *p; int in_ident = 0; int just_spaced = 0; int need_space = 1; fprintf (out, "(%s", func); if (*buf == '(') ++buf; for (p = buf; *p; p++) { char c = *p; int ident_start = 0; /* Notice when we start printing a new identifier. */ if ((('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z') || ('0' <= c && c <= '9') || c == '_') != in_ident) { if (!in_ident) { in_ident = 1; ident_start = 1; if (need_space) putc (' ', out); if (minargs == 0 && maxargs > 0) fprintf (out, "&optional "); just_spaced = 1; minargs--; maxargs--; } else in_ident = 0; } /* Print the C argument list as it would appear in lisp: print underscores as hyphens, and print commas as spaces. Collapse adjacent spaces into one. */ if (c == '_') c = '-'; if (c == ',') c = ' '; /* In C code, `default' is a reserved word, so we spell it `defalt'; unmangle that here. */ if (ident_start && strncmp (p, "defalt", 6) == 0 && ! (('A' <= p[6] && p[6] <= 'Z') || ('a' <= p[6] && p[6] <= 'z') || ('0' <= p[6] && p[6] <= '9') || p[6] == '_')) { fprintf (out, "DEFAULT"); p += 5; in_ident = 0; just_spaced = 0; } else if (c != ' ' || ! just_spaced) { if (c >= 'a' && c <= 'z') /* Upcase the letter. */ c += 'A' - 'a'; putc (c, out); } just_spaced = (c == ' '); need_space = 0; } } /* Read through a c file. If a .o file is named, the corresponding .c file is read instead. Looks for DEFUN constructs such as are defined in ../src/lisp.h. Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED. */ int scan_c_file (filename, mode) char *filename, *mode; { FILE *infile; register int c; register int commas; register int defunflag; register int defvarperbufferflag; register int defvarflag; int minargs, maxargs; int extension = filename[strlen (filename) - 1]; if (extension == 'o') filename[strlen (filename) - 1] = 'c'; infile = fopen (filename, mode); /* No error if non-ex input file */ if (infile == NULL) { perror (filename); return 0; } /* Reset extension to be able to detect duplicate files. */ filename[strlen (filename) - 1] = extension; c = '\n'; while (!feof (infile)) { if (c != '\n') { c = getc (infile); continue; } c = getc (infile); if (c == ' ') { while (c == ' ') c = getc (infile); if (c != 'D') continue; c = getc (infile); if (c != 'E') continue; c = getc (infile); if (c != 'F') continue; c = getc (infile); if (c != 'V') continue; c = getc (infile); if (c != 'A') continue; c = getc (infile); if (c != 'R') continue; c = getc (infile); if (c != '_') continue; defvarflag = 1; defunflag = 0; c = getc (infile); defvarperbufferflag = (c == 'P'); c = getc (infile); } else if (c == 'D') { c = getc (infile); if (c != 'E') continue; c = getc (infile); if (c != 'F') continue; c = getc (infile); defunflag = c == 'U'; defvarflag = 0; } else continue; while (c != '(') { if (c < 0) goto eof; c = getc (infile); } c = getc (infile); if (c != '"') continue; c = read_c_string (infile, -1); if (defunflag) commas = 5; else if (defvarperbufferflag) commas = 2; else if (defvarflag) commas = 1; else /* For DEFSIMPLE and DEFPRED */ commas = 2; while (commas) { if (c == ',') { commas--; if (defunflag && (commas == 1 || commas == 2)) { do c = getc (infile); while (c == ' ' || c == '\n' || c == '\t'); if (c < 0) goto eof; ungetc (c, infile); if (commas == 2) /* pick up minargs */ fscanf (infile, "%d", &minargs); else /* pick up maxargs */ if (c == 'M' || c == 'U') /* MANY || UNEVALLED */ maxargs = -1; else fscanf (infile, "%d", &maxargs); } } if (c < 0) goto eof; c = getc (infile); } while (c == ' ' || c == '\n' || c == '\t') c = getc (infile); if (c == '"') c = read_c_string (infile, 0); while (c != ',') c = getc (infile); c = getc (infile); while (c == ' ' || c == '\n' || c == '\t') c = getc (infile); if (c == '"') { putc (037, outfile); putc (defvarflag ? 'V' : 'F', outfile); fprintf (outfile, "%s\n", buf); c = read_c_string (infile, 1); /* If this is a defun, find the arguments and print them. If this function takes MANY or UNEVALLED args, then the C source won't give the names of the arguments, so we shouldn't bother trying to find them. */ if (defunflag && maxargs != -1) { char argbuf[1024], *p = argbuf; while (c != ')') { if (c < 0) goto eof; c = getc (infile); } /* Skip into arguments. */ while (c != '(') { if (c < 0) goto eof; c = getc (infile); } /* Copy arguments into ARGBUF. */ *p++ = c; do *p++ = c = getc (infile); while (c != ')'); *p = '\0'; /* Output them. */ fprintf (outfile, "\n\n"); write_c_args (outfile, buf, argbuf, minargs, maxargs); } } } eof: fclose (infile); return 0; } /* Read a file of Lisp code, compiled or interpreted. Looks for (defun NAME ARGS DOCSTRING ...) (defmacro NAME ARGS DOCSTRING ...) (autoload (quote NAME) FILE DOCSTRING ...) (defvar NAME VALUE DOCSTRING) (defconst NAME VALUE DOCSTRING) (fset (quote NAME) (make-byte-code ... DOCSTRING ...)) (fset (quote NAME) #[... DOCSTRING ...]) (defalias (quote NAME) #[... DOCSTRING ...]) starting in column zero. (quote NAME) may appear as 'NAME as well. We also look for #@LENGTH CONTENTS^_ at the beginning of the line. When we find that, we save it for the following defining-form, and we use that instead of reading a doc string within that defining-form. For defun, defmacro, and autoload, we know how to skip over the arglist. For defvar, defconst, and fset we skip to the docstring with a kludgy formatting convention: all docstrings must appear on the same line as the initial open-paren (the one in column zero) and must contain a backslash and a double-quote immediately after the initial double-quote. No newlines must appear between the beginning of the form and the first double-quote. The only source file that must follow this convention is loaddefs.el; aside from that, it is always the .elc file that we look at, and they are no problem because byte-compiler output follows this convention. The NAME and DOCSTRING are output. NAME is preceded by `F' for a function or `V' for a variable. An entry is output only if DOCSTRING has \ newline just after the opening " */ void skip_white (infile) FILE *infile; { char c = ' '; while (c == ' ' || c == '\t' || c == '\n') c = getc (infile); ungetc (c, infile); } void read_lisp_symbol (infile, buffer) FILE *infile; char *buffer; { char c; char *fillp = buffer; skip_white (infile); while (1) { c = getc (infile); if (c == '\\') *(++fillp) = getc (infile); else if (c == ' ' || c == '\t' || c == '\n' || c == '(' || c == ')') { ungetc (c, infile); *fillp = 0; break; } else *fillp++ = c; } if (! buffer[0]) fprintf (stderr, "## expected a symbol, got '%c'\n", c); skip_white (infile); } int scan_lisp_file (filename, mode) char *filename, *mode; { FILE *infile; register int c; char *saved_string = 0; infile = fopen (filename, mode); if (infile == NULL) { perror (filename); return 0; /* No error */ } c = '\n'; while (!feof (infile)) { char buffer[BUFSIZ]; char type; if (c != '\n') { c = getc (infile); continue; } c = getc (infile); /* Detect a dynamic doc string and save it for the next expression. */ if (c == '#') { c = getc (infile); if (c == '@') { int length = 0; int i; /* Read the length. */ while ((c = getc (infile), c >= '0' && c <= '9')) { length *= 10; length += c - '0'; } /* The next character is a space that is counted in the length but not part of the doc string. We already read it, so just ignore it. */ length--; /* Read in the contents. */ if (saved_string != 0) free (saved_string); saved_string = (char *) malloc (length); for (i = 0; i < length; i++) saved_string[i] = getc (infile); /* The last character is a ^_. That is needed in the .elc file but it is redundant in DOC. So get rid of it here. */ saved_string[length - 1] = 0; /* Skip the newline. */ c = getc (infile); while (c != '\n') c = getc (infile); } continue; } if (c != '(') continue; read_lisp_symbol (infile, buffer); if (! strcmp (buffer, "defun") || ! strcmp (buffer, "defmacro")) { type = 'F'; read_lisp_symbol (infile, buffer); /* Skip the arguments: either "nil" or a list in parens */ c = getc (infile); if (c == 'n') /* nil */ { if ((c = getc (infile)) != 'i' || (c = getc (infile)) != 'l') { fprintf (stderr, "## unparsable arglist in %s (%s)\n", buffer, filename); continue; } } else if (c != '(') { fprintf (stderr, "## unparsable arglist in %s (%s)\n", buffer, filename); continue; } else while (c != ')') c = getc (infile); skip_white (infile); /* If the next three characters aren't `dquote bslash newline' then we're not reading a docstring. */ if ((c = getc (infile)) != '"' || (c = getc (infile)) != '\\' || (c = getc (infile)) != '\n') { #ifdef DEBUG fprintf (stderr, "## non-docstring in %s (%s)\n", buffer, filename); #endif continue; } } else if (! strcmp (buffer, "defvar") || ! strcmp (buffer, "defconst")) { char c1 = 0, c2 = 0; type = 'V'; read_lisp_symbol (infile, buffer); if (saved_string == 0) { /* Skip until the first newline; remember the two previous chars. */ while (c != '\n' && c >= 0) { c2 = c1; c1 = c; c = getc (infile); } /* If two previous characters were " and \, this is a doc string. Otherwise, there is none. */ if (c2 != '"' || c1 != '\\') { #ifdef DEBUG fprintf (stderr, "## non-docstring in %s (%s)\n", buffer, filename); #endif continue; } } } else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias")) { char c1 = 0, c2 = 0; type = 'F'; c = getc (infile); if (c == '\'') read_lisp_symbol (infile, buffer); else { if (c != '(') { fprintf (stderr, "## unparsable name in fset in %s\n", filename); continue; } read_lisp_symbol (infile, buffer); if (strcmp (buffer, "quote")) { fprintf (stderr, "## unparsable name in fset in %s\n", filename); continue; } read_lisp_symbol (infile, buffer); c = getc (infile); if (c != ')') { fprintf (stderr, "## unparsable quoted name in fset in %s\n", filename); continue; } } if (saved_string == 0) { /* Skip until the first newline; remember the two previous chars. */ while (c != '\n' && c >= 0) { c2 = c1; c1 = c; c = getc (infile); } /* If two previous characters were " and \, this is a doc string. Otherwise, there is none. */ if (c2 != '"' || c1 != '\\') { #ifdef DEBUG fprintf (stderr, "## non-docstring in %s (%s)\n", buffer, filename); #endif continue; } } } else if (! strcmp (buffer, "autoload")) { type = 'F'; c = getc (infile); if (c == '\'') read_lisp_symbol (infile, buffer); else { if (c != '(') { fprintf (stderr, "## unparsable name in autoload in %s\n", filename); continue; } read_lisp_symbol (infile, buffer); if (strcmp (buffer, "quote")) { fprintf (stderr, "## unparsable name in autoload in %s\n", filename); continue; } read_lisp_symbol (infile, buffer); c = getc (infile); if (c != ')') { fprintf (stderr, "## unparsable quoted name in autoload in %s\n", filename); continue; } } skip_white (infile); if ((c = getc (infile)) != '\"') { fprintf (stderr, "## autoload of %s unparsable (%s)\n", buffer, filename); continue; } read_c_string (infile, 0); skip_white (infile); if (saved_string == 0) { /* If the next three characters aren't `dquote bslash newline' then we're not reading a docstring. */ if ((c = getc (infile)) != '"' || (c = getc (infile)) != '\\' || (c = getc (infile)) != '\n') { #ifdef DEBUG fprintf (stderr, "## non-docstring in %s (%s)\n", buffer, filename); #endif continue; } } } #ifdef DEBUG else if (! strcmp (buffer, "if") || ! strcmp (buffer, "byte-code")) ; #endif else { #ifdef DEBUG fprintf (stderr, "## unrecognised top-level form, %s (%s)\n", buffer, filename); #endif continue; } /* At this point, we should either use the previous dynamic doc string in saved_string or gobble a doc string from the input file. In the latter case, the opening quote (and leading backslash-newline) have already been read. */ putc (037, outfile); putc (type, outfile); fprintf (outfile, "%s\n", buffer); if (saved_string) { fputs (saved_string, outfile); /* Don't use one dynamic doc string twice. */ free (saved_string); saved_string = 0; } else read_c_string (infile, 1); } fclose (infile); return 0; } emacs-19.30/lib-src/movemail.c100444 12120 13 37025 6011253345 14174 0ustar rmsuser/* movemail foo bar -- move file foo to file bar, locking file foo the way /bin/mail respects. Copyright (C) 1986, 1992, 1993, 1994 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. */ /* Important notice: defining MAIL_USE_FLOCK or MAIL_USE_LOCKF *will cause loss of mail* if you do it on a system that does not normally use flock as its way of interlocking access to inbox files. The setting of MAIL_USE_FLOCK and MAIL_USE_LOCKF *must agree* with the system's own conventions. It is not a choice that is up to you. So, if your system uses lock files rather than flock, then the only way you can get proper operation is to enable movemail to write lockfiles there. This means you must either give that directory access modes that permit everyone to write lockfiles in it, or you must make movemail a setuid or setgid program. */ /* * Modified January, 1986 by Michael R. Gretzinger (Project Athena) * * Added POP (Post Office Protocol) service. When compiled -DPOP * movemail will accept input filename arguments of the form * "po:username". This will cause movemail to open a connection to * a pop server running on $MAILHOST (environment variable). Movemail * must be setuid to root in order to work with POP. * * New module: popmail.c * Modified routines: * main - added code within #ifdef MAIL_USE_POP; added setuid (getuid ()) * after POP code. * New routines in movemail.c: * get_errmsg - return pointer to system error message * * Modified August, 1993 by Jonathan Kamens (OpenVision Technologies) * * Move all of the POP code into a separate file, "pop.c". * Use strerror instead of get_errmsg. * */ #define NO_SHORTNAMES /* Tell config not to load remap.h */ #include <../src/config.h> #include #include #include #include #include #include <../src/syswait.h> #ifdef MAIL_USE_POP #include "pop.h" #endif #ifdef MSDOS #undef access #endif /* MSDOS */ #ifdef USG #include #include #ifndef F_OK #define F_OK 0 #define X_OK 1 #define W_OK 2 #define R_OK 4 #endif #endif /* USG */ #ifdef HAVE_UNISTD_H #include #endif #ifdef XENIX #include #endif #ifdef MAIL_USE_LOCKF #define MAIL_USE_SYSTEM_LOCK #endif #ifdef MAIL_USE_FLOCK #define MAIL_USE_SYSTEM_LOCK #endif #ifdef MAIL_USE_MMDF extern int lk_open (), lk_close (); #endif /* Cancel substitutions made by config.h for Emacs. */ #undef open #undef read #undef write #undef close #ifndef errno extern int errno; #endif char *strerror (); void fatal (); void error (); void pfatal_with_name (); void pfatal_and_delete (); char *concat (); long *xmalloc (); int popmail (); int pop_retr (); int mbx_write (); int mbx_delimit_begin (); int mbx_delimit_end (); /* Nonzero means this is name of a lock file to delete on fatal error. */ char *delete_lockname; int main (argc, argv) int argc; char **argv; { char *inname, *outname; int indesc, outdesc; int nread; WAITTYPE status; #ifndef MAIL_USE_SYSTEM_LOCK struct stat st; long now; int tem; char *lockname, *p; char *tempname; int desc; #endif /* not MAIL_USE_SYSTEM_LOCK */ delete_lockname = 0; if (argc < 3) { fprintf (stderr, "Usage: movemail inbox destfile\n"); exit(1); } inname = argv[1]; outname = argv[2]; #ifdef MAIL_USE_MMDF mmdf_init (argv[0]); #endif if (*outname == 0) fatal ("Destination file name is empty", 0); /* Check access to output file. */ if (access (outname, F_OK) == 0 && access (outname, W_OK) != 0) pfatal_with_name (outname); /* Also check that outname's directory is writeable to the real uid. */ { char *buf = (char *) xmalloc (strlen (outname) + 1); char *p; strcpy (buf, outname); p = buf + strlen (buf); while (p > buf && p[-1] != '/') *--p = 0; if (p == buf) *p++ = '.'; if (access (buf, W_OK) != 0) pfatal_with_name (buf); free (buf); } #ifdef MAIL_USE_POP if (!strncmp (inname, "po:", 3)) { int status; status = popmail (inname + 3, outname); exit (status); } setuid (getuid ()); #endif /* MAIL_USE_POP */ /* Check access to input file. */ if (access (inname, R_OK | W_OK) != 0) pfatal_with_name (inname); #ifndef MAIL_USE_MMDF #ifndef MAIL_USE_SYSTEM_LOCK /* Use a lock file named after our first argument with .lock appended: If it exists, the mail file is locked. */ /* Note: this locking mechanism is *required* by the mailer (on systems which use it) to prevent loss of mail. On systems that use a lock file, extracting the mail without locking WILL occasionally cause loss of mail due to timing errors! So, if creation of the lock file fails due to access permission on the mail spool directory, you simply MUST change the permission and/or make movemail a setgid program so it can create lock files properly. You might also wish to verify that your system is one which uses lock files for this purpose. Some systems use other methods. If your system uses the `flock' system call for mail locking, define MAIL_USE_SYSTEM_LOCK in config.h or the s-*.h file and recompile movemail. If the s- file for your system should define MAIL_USE_SYSTEM_LOCK but does not, send a bug report to bug-gnu-emacs@prep.ai.mit.edu so we can fix it. */ lockname = concat (inname, ".lock", ""); tempname = (char *) xmalloc (strlen (inname) + strlen ("EXXXXXX") + 1); strcpy (tempname, inname); p = tempname + strlen (tempname); while (p != tempname && p[-1] != '/') p--; *p = 0; strcpy (p, "EXXXXXX"); mktemp (tempname); unlink (tempname); while (1) { /* Create the lock file, but not under the lock file name. */ /* Give up if cannot do that. */ desc = open (tempname, O_WRONLY | O_CREAT | O_EXCL, 0666); if (desc < 0) { char *message = (char *) xmalloc (strlen (tempname) + 50); sprintf (message, "%s--see source file lib-src/movemail.c", tempname); pfatal_with_name (message); } close (desc); tem = link (tempname, lockname); unlink (tempname); if (tem >= 0) break; sleep (1); /* If lock file is five minutes old, unlock it. Five minutes should be good enough to cope with crashes and wedgitude, and long enough to avoid being fooled by time differences between machines. */ if (stat (lockname, &st) >= 0) { now = time (0); if (st.st_ctime < now - 300) unlink (lockname); } } delete_lockname = lockname; #endif /* not MAIL_USE_SYSTEM_LOCK */ #endif /* not MAIL_USE_MMDF */ if (fork () == 0) { setuid (getuid ()); #ifndef MAIL_USE_MMDF #ifdef MAIL_USE_SYSTEM_LOCK indesc = open (inname, O_RDWR); #else /* if not MAIL_USE_SYSTEM_LOCK */ indesc = open (inname, O_RDONLY); #endif /* not MAIL_USE_SYSTEM_LOCK */ #else /* MAIL_USE_MMDF */ indesc = lk_open (inname, O_RDONLY, 0, 0, 10); #endif /* MAIL_USE_MMDF */ if (indesc < 0) pfatal_with_name (inname); #if defined (BSD) || defined (XENIX) /* In case movemail is setuid to root, make sure the user can read the output file. */ /* This is desirable for all systems but I don't want to assume all have the umask system call */ umask (umask (0) & 0333); #endif /* BSD or Xenix */ outdesc = open (outname, O_WRONLY | O_CREAT | O_EXCL, 0666); if (outdesc < 0) pfatal_with_name (outname); #ifdef MAIL_USE_SYSTEM_LOCK #ifdef MAIL_USE_LOCKF if (lockf (indesc, F_LOCK, 0) < 0) pfatal_with_name (inname); #else /* not MAIL_USE_LOCKF */ #ifdef XENIX if (locking (indesc, LK_RLCK, 0L) < 0) pfatal_with_name (inname); #else if (flock (indesc, LOCK_EX) < 0) pfatal_with_name (inname); #endif #endif /* not MAIL_USE_LOCKF */ #endif /* MAIL_USE_SYSTEM_LOCK */ { char buf[1024]; while (1) { nread = read (indesc, buf, sizeof buf); if (nread != write (outdesc, buf, nread)) { int saved_errno = errno; unlink (outname); errno = saved_errno; pfatal_with_name (outname); } if (nread < sizeof buf) break; } } #ifdef BSD if (fsync (outdesc) < 0) pfatal_and_delete (outname); #endif /* Check to make sure no errors before we zap the inbox. */ if (close (outdesc) != 0) pfatal_and_delete (outname); #ifdef MAIL_USE_SYSTEM_LOCK #if defined (STRIDE) || defined (XENIX) /* Stride, xenix have file locking, but no ftruncate. This mess will do. */ close (open (inname, O_CREAT | O_TRUNC | O_RDWR, 0666)); #else ftruncate (indesc, 0L); #endif /* STRIDE or XENIX */ #endif /* MAIL_USE_SYSTEM_LOCK */ #ifdef MAIL_USE_MMDF lk_close (indesc, 0, 0, 0); #else close (indesc); #endif #ifndef MAIL_USE_SYSTEM_LOCK /* Delete the input file; if we can't, at least get rid of its contents. */ #ifdef MAIL_UNLINK_SPOOL /* This is generally bad to do, because it destroys the permissions that were set on the file. Better to just empty the file. */ if (unlink (inname) < 0 && errno != ENOENT) #endif /* MAIL_UNLINK_SPOOL */ creat (inname, 0600); #endif /* not MAIL_USE_SYSTEM_LOCK */ exit (0); } wait (&status); if (!WIFEXITED (status)) exit (1); else if (WRETCODE (status) != 0) exit (WRETCODE (status)); #if !defined (MAIL_USE_MMDF) && !defined (MAIL_USE_SYSTEM_LOCK) unlink (lockname); #endif /* not MAIL_USE_MMDF and not MAIL_USE_SYSTEM_LOCK */ return 0; } /* Print error message and exit. */ void fatal (s1, s2) char *s1, *s2; { if (delete_lockname) unlink (delete_lockname); error (s1, s2); exit (1); } /* Print error message. `s1' is printf control string, `s2' is arg for it. */ void error (s1, s2, s3) char *s1, *s2, *s3; { fprintf (stderr, "movemail: "); fprintf (stderr, s1, s2, s3); fprintf (stderr, "\n"); } void pfatal_with_name (name) char *name; { char *s = concat ("", strerror (errno), " for %s"); fatal (s, name); } void pfatal_and_delete (name) char *name; { char *s = concat ("", strerror (errno), " for %s"); unlink (name); fatal (s, name); } /* Return a newly-allocated string whose contents concatenate those of s1, s2, s3. */ char * concat (s1, s2, s3) char *s1, *s2, *s3; { int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3); char *result = (char *) xmalloc (len1 + len2 + len3 + 1); strcpy (result, s1); strcpy (result + len1, s2); strcpy (result + len1 + len2, s3); *(result + len1 + len2 + len3) = 0; return result; } /* Like malloc but get fatal error if memory is exhausted. */ long * xmalloc (size) unsigned size; { long *result = (long *) malloc (size); if (!result) fatal ("virtual memory exhausted", 0); return result; } /* This is the guts of the interface to the Post Office Protocol. */ #ifdef MAIL_USE_POP #include #include #include #include #include #ifdef USG #include /* Cancel substitutions made by config.h for Emacs. */ #undef open #undef read #undef write #undef close #endif /* USG */ #define NOTOK (-1) #define OK 0 #define DONE 1 char *progname; FILE *sfi; FILE *sfo; char ibuffer[BUFSIZ]; char obuffer[BUFSIZ]; char Errmsg[80]; popmail (user, outfile) char *user; char *outfile; { int nmsgs, nbytes; register int i; int mbfi; FILE *mbf; char *getenv (); int mbx_write (); popserver server; extern char *strerror (); server = pop_open (0, user, 0, POP_NO_GETPASS); if (! server) { error (pop_error); return (1); } if (pop_stat (server, &nmsgs, &nbytes)) { error (pop_error); return (1); } if (!nmsgs) { pop_close (server); return (0); } mbfi = open (outfile, O_WRONLY | O_CREAT | O_EXCL, 0666); if (mbfi < 0) { pop_close (server); error ("Error in open: %s, %s", strerror (errno), outfile); return (1); } fchown (mbfi, getuid (), -1); if ((mbf = fdopen (mbfi, "w")) == NULL) { pop_close (server); error ("Error in fdopen: %s", strerror (errno)); close (mbfi); unlink (outfile); return (1); } for (i = 1; i <= nmsgs; i++) { mbx_delimit_begin (mbf); if (pop_retr (server, i, mbx_write, mbf) != OK) { error (Errmsg); close (mbfi); return (1); } mbx_delimit_end (mbf); fflush (mbf); if (ferror (mbf)) { error ("Error in fflush: %s", strerror (errno)); pop_close (server); close (mbfi); return (1); } } /* On AFS, a call to write only modifies the file in the local * workstation's AFS cache. The changes are not written to the server * until a call to fsync or close is made. Users with AFS home * directories have lost mail when over quota because these checks were * not made in previous versions of movemail. */ #ifdef BSD if (fsync (mbfi) < 0) { error ("Error in fsync: %s", strerror (errno)); return (1); } #endif if (close (mbfi) == -1) { error ("Error in close: %s", strerror (errno)); return (1); } for (i = 1; i <= nmsgs; i++) { if (pop_delete (server, i)) { error (pop_error); pop_close (server); return (1); } } if (pop_quit (server)) { error (pop_error); return (1); } return (0); } pop_retr (server, msgno, action, arg) popserver server; int (*action)(); { extern char *strerror (); char *line; int ret; if (pop_retrieve_first (server, msgno, &line)) { strncpy (Errmsg, pop_error, sizeof (Errmsg)); Errmsg[sizeof (Errmsg)-1] = '\0'; return (NOTOK); } while (! (ret = pop_retrieve_next (server, &line))) { if (! line) break; if ((*action)(line, arg) != OK) { strcpy (Errmsg, strerror (errno)); pop_close (server); return (NOTOK); } } if (ret) { strncpy (Errmsg, pop_error, sizeof (Errmsg)); Errmsg[sizeof (Errmsg)-1] = '\0'; return (NOTOK); } return (OK); } /* Do this as a macro instead of using strcmp to save on execution time. */ #define IS_FROM_LINE(a) ((a[0] == 'F') \ && (a[1] == 'r') \ && (a[2] == 'o') \ && (a[3] == 'm') \ && (a[4] == ' ')) int mbx_write (line, mbf) char *line; FILE *mbf; { if (IS_FROM_LINE (line)) { if (fputc ('>', mbf) == EOF) return (NOTOK); } if (fputs (line, mbf) == EOF) return (NOTOK); if (fputc (0x0a, mbf) == EOF) return (NOTOK); return (OK); } int mbx_delimit_begin (mbf) FILE *mbf; { if (fputs ("\f\n0, unseen,,\n", mbf) == EOF) return (NOTOK); return (OK); } mbx_delimit_end (mbf) FILE *mbf; { if (putc ('\037', mbf) == EOF) return (NOTOK); return (OK); } #endif /* MAIL_USE_POP */ #ifndef HAVE_STRERROR char * strerror (errnum) int errnum; { extern char *sys_errlist[]; extern int sys_nerr; if (errnum >= 0 && errnum < sys_nerr) return sys_errlist[errnum]; return (char *) "Unknown error"; } #endif /* ! HAVE_STRERROR */ emacs-19.30/lib-src/ntlib.c100444 12120 13 4341 5655411510 13451 0ustar rmsuser/* Utility and Unix shadow routines for GNU Emacs support programs on NT. Copyright (C) 1994 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. Geoff Voelker (voelker@cs.washington.edu) 10-8-94 */ #include #include #include #define MAXPATHLEN _MAX_PATH /* Emulate sleep...we could have done this with a define, but that would necessitate including windows.h in the files that used it. This is much easier. */ void nt_sleep(int seconds) { Sleep (seconds * 1000); } /* Get the current working directory. */ int getwd (char *dir) { return GetCurrentDirectory (MAXPATHLEN, dir); } static HANDLE getppid_parent; static int getppid_ppid; int getppid(void) { char *ppid; DWORD result; ppid = getenv ("__PARENT_PROCESS_ID"); if (!ppid) { printf("no pid.\n"); return 0; } else { getppid_ppid = atoi (ppid); } if (!getppid_parent) { getppid_parent = OpenProcess (SYNCHRONIZE, FALSE, atoi(ppid)); if (!getppid_parent) { printf ("Failed to open handle to parent process: %d\n", GetLastError()); exit (1); } } result = WaitForSingleObject (getppid_parent, 0); switch (result) { case WAIT_TIMEOUT: /* The parent is still alive. */ return getppid_ppid; case WAIT_OBJECT_0: /* The parent is gone. Return the pid of Unix init (1). */ return 1; case WAIT_FAILED: default: printf ("Checking parent status failed: %d\n", GetLastError()); exit (1); } } emacs-19.30/lib-src/pop.c100444 12120 13 100323 5652635224 13203 0ustar rmsuser/* pop.c: client routines for talking to a POP3-protocol post-office server Copyright (c) 1991,1993 Free Software Foundation, Inc. Written by Jonathan Kamens, jik@security.ov.com. 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. */ #ifdef HAVE_CONFIG_H #define NO_SHORTNAMES /* Tell config not to load remap.h */ #include <../src/config.h> #else #define MAIL_USE_POP #endif #ifdef MAIL_USE_POP #ifdef HAVE_CONFIG_H /* Cancel these substitutions made in config.h */ #undef open #undef read #undef write #undef close #endif #include #include #include #include #ifdef sun #include #endif /* sun */ #ifdef HESIOD #include /* * It really shouldn't be necessary to put this declaration here, but * the version of hesiod.h that Athena has installed in release 7.2 * doesn't declare this function; I don't know if the 7.3 version of * hesiod.h does. */ extern struct servent *hes_getservbyname (/* char *, char * */); #endif #include #include #include #include #ifdef KERBEROS #ifndef KRB5 #include #include #else /* KRB5 */ #include #include #include #endif /* KRB5 */ #endif /* KERBEROS */ extern char *getenv (/* char * */); extern char *getlogin (/* void */); extern char *getpass (/* char * */); extern char *strerror (/* int */); #ifdef KERBEROS #ifndef KRB5 extern int krb_sendauth (/* long, int, KTEXT, char *, char *, char *, u_long, MSG_DAT *, CREDENTIALS *, Key_schedule, struct sockaddr_in *, struct sockaddr_in *, char * */); extern char *krb_realmofhost (/* char * */); #endif /* ! KRB5 */ #endif /* KERBEROS */ #if !defined(HAVE_H_ERRNO) || !defined(HAVE_CONFIG_H) extern int h_errno; #endif static int socket_connection (/* char *, int */); static char *getline (/* popserver */); static int sendline (/* popserver, char * */); static int fullwrite (/* int, char *, int */); static int getok (/* popserver */); #if 0 static int gettermination (/* popserver */); #endif static void pop_trash (/* popserver */); static char *find_crlf (/* char * */); #define ERROR_MAX 80 /* a pretty arbitrary size */ #define POP_PORT 110 #define KPOP_PORT 1109 #define POP_SERVICE "pop" #ifdef KERBEROS #ifdef KRB5 #define KPOP_SERVICE "k5pop"; #else #define KPOP_SERVICE "kpop" #endif #endif char pop_error[ERROR_MAX]; int pop_debug = 0; #ifndef min #define min(a,b) (((a) < (b)) ? (a) : (b)) #endif /* * Function: pop_open (char *host, char *username, char *password, * int flags) * * Purpose: Establishes a connection with a post-office server, and * completes the authorization portion of the session. * * Arguments: * host The server host with which the connection should be * established. Optional. If omitted, internal * heuristics will be used to determine the server host, * if possible. * username * The username of the mail-drop to access. Optional. * If omitted, internal heuristics will be used to * determine the username, if possible. * password * The password to use for authorization. If omitted, * internal heuristics will be used to determine the * password, if possible. * flags A bit mask containing flags controlling certain * functions of the routine. Valid flags are defined in * the file pop.h * * Return value: Upon successful establishment of a connection, a * non-null popserver will be returned. Otherwise, null will be * returned, and the string variable pop_error will contain an * explanation of the error. */ popserver pop_open (host, username, password, flags) char *host; char *username; char *password; int flags; { int sock; popserver server; /* Determine the user name */ if (! username) { username = getenv ("USER"); if (! (username && *username)) { username = getlogin (); if (! (username && *username)) { struct passwd *passwd; passwd = getpwuid (getuid ()); if (passwd && passwd->pw_name && *passwd->pw_name) { username = passwd->pw_name; } else { strcpy (pop_error, "Could not determine username"); return (0); } } } } /* * Determine the mail host. */ if (! host) { host = getenv ("MAILHOST"); } #ifdef HESIOD if ((! host) && (! (flags & POP_NO_HESIOD))) { struct hes_postoffice *office; office = hes_getmailhost (username); if (office && office->po_type && (! strcmp (office->po_type, "POP")) && office->po_name && *office->po_name && office->po_host && *office->po_host) { host = office->po_host; username = office->po_name; } } #endif #ifdef MAILHOST if (! host) { host = MAILHOST; } #endif if (! host) { strcpy (pop_error, "Could not determine POP server"); return (0); } /* Determine the password */ #ifdef KERBEROS #define DONT_NEED_PASSWORD (! (flags & POP_NO_KERBEROS)) #else #define DONT_NEED_PASSWORD 0 #endif if ((! password) && (! DONT_NEED_PASSWORD)) { if (! (flags & POP_NO_GETPASS)) { password = getpass ("Enter POP password:"); } if (! password) { strcpy (pop_error, "Could not determine POP password"); return (0); } } if (password) flags |= POP_NO_KERBEROS; else password = username; sock = socket_connection (host, flags); if (sock == -1) return (0); server = (popserver) malloc (sizeof (struct _popserver)); if (! server) { strcpy (pop_error, "Out of memory in pop_open"); return (0); } server->buffer = (char *) malloc (GETLINE_MIN); if (! server->buffer) { strcpy (pop_error, "Out of memory in pop_open"); free ((char *) server); return (0); } server->file = sock; server->data = 0; server->buffer_index = 0; server->buffer_size = GETLINE_MIN; server->in_multi = 0; if (getok (server)) return (0); /* * I really shouldn't use the pop_error variable like this, but.... */ if (strlen (username) > ERROR_MAX - 6) { pop_close (server); strcpy (pop_error, "Username too long; recompile pop.c with larger ERROR_MAX"); return (0); } sprintf (pop_error, "USER %s", username); if (sendline (server, pop_error) || getok (server)) { return (0); } if (strlen (password) > ERROR_MAX - 6) { pop_close (server); strcpy (pop_error, "Password too long; recompile pop.c with larger ERROR_MAX"); return (0); } sprintf (pop_error, "PASS %s", password); if (sendline (server, pop_error) || getok (server)) { return (0); } return (server); } /* * Function: pop_stat * * Purpose: Issue the STAT command to the server and return (in the * value parameters) the number of messages in the maildrop and * the total size of the maildrop. * * Return value: 0 on success, or non-zero with an error in pop_error * in failure. * * Side effects: On failure, may make further operations on the * connection impossible. */ int pop_stat (server, count, size) popserver server; int *count; int *size; { char *fromserver; if (server->in_multi) { strcpy (pop_error, "In multi-line query in pop_stat"); return (-1); } if (sendline (server, "STAT") || (! (fromserver = getline (server)))) return (-1); if (strncmp (fromserver, "+OK ", 4)) { if (0 == strncmp (fromserver, "-ERR", 4)) { strncpy (pop_error, fromserver, ERROR_MAX); } else { strcpy (pop_error, "Unexpected response from POP server in pop_stat"); pop_trash (server); } return (-1); } *count = atoi (&fromserver[4]); fromserver = index (&fromserver[4], ' '); if (! fromserver) { strcpy (pop_error, "Badly formatted response from server in pop_stat"); pop_trash (server); return (-1); } *size = atoi (fromserver + 1); return (0); } /* * Function: pop_list * * Purpose: Performs the POP "list" command and returns (in value * parameters) two malloc'd zero-terminated arrays -- one of * message IDs, and a parallel one of sizes. * * Arguments: * server The pop connection to talk to. * message The number of the one message about which to get * information, or 0 to get information about all * messages. * * Return value: 0 on success, non-zero with error in pop_error on * failure. * * Side effects: On failure, may make further operations on the * connection impossible. */ int pop_list (server, message, IDs, sizes) popserver server; int message; int **IDs; int **sizes; { int how_many, i; char *fromserver; if (server->in_multi) { strcpy (pop_error, "In multi-line query in pop_list"); return (-1); } if (message) how_many = 1; else { int count, size; if (pop_stat (server, &count, &size)) return (-1); how_many = count; } *IDs = (int *) malloc ((how_many + 1) * sizeof (int)); *sizes = (int *) malloc ((how_many + 1) * sizeof (int)); if (! (*IDs && *sizes)) { strcpy (pop_error, "Out of memory in pop_list"); return (-1); } if (message) { sprintf (pop_error, "LIST %d", message); if (sendline (server, pop_error)) { free ((char *) *IDs); free ((char *) *sizes); return (-1); } if (! (fromserver = getline (server))) { free ((char *) *IDs); free ((char *) *sizes); return (-1); } if (strncmp (fromserver, "+OK ", 4)) { if (! strncmp (fromserver, "-ERR", 4)) strncpy (pop_error, fromserver, ERROR_MAX); else { strcpy (pop_error, "Unexpected response from server in pop_list"); pop_trash (server); } free ((char *) *IDs); free ((char *) *sizes); return (-1); } (*IDs)[0] = atoi (&fromserver[4]); fromserver = index (&fromserver[4], ' '); if (! fromserver) { strcpy (pop_error, "Badly formatted response from server in pop_list"); pop_trash (server); free ((char *) *IDs); free ((char *) *sizes); return (-1); } (*sizes)[0] = atoi (fromserver); (*IDs)[1] = (*sizes)[1] = 0; return (0); } else { if (pop_multi_first (server, "LIST", &fromserver)) { free ((char *) *IDs); free ((char *) *sizes); return (-1); } for (i = 0; i < how_many; i++) { if (pop_multi_next (server, &fromserver)) { free ((char *) *IDs); free ((char *) *sizes); return (-1); } (*IDs)[i] = atoi (fromserver); fromserver = index (fromserver, ' '); if (! fromserver) { strcpy (pop_error, "Badly formatted response from server in pop_list"); free ((char *) *IDs); free ((char *) *sizes); pop_trash (server); return (-1); } (*sizes)[i] = atoi (fromserver); } if (pop_multi_next (server, &fromserver)) { free ((char *) *IDs); free ((char *) *sizes); return (-1); } else if (fromserver) { strcpy (pop_error, "Too many response lines from server in pop_list"); free ((char *) *IDs); free ((char *) *sizes); return (-1); } (*IDs)[i] = (*sizes)[i] = 0; return (0); } } /* * Function: pop_retrieve * * Purpose: Retrieve a specified message from the maildrop. * * Arguments: * server The server to retrieve from. * message The message number to retrieve. * markfrom * If true, then mark the string "From " at the beginning * of lines with '>'. * * Return value: A string pointing to the message, if successful, or * null with pop_error set if not. * * Side effects: May kill connection on error. */ char * pop_retrieve (server, message, markfrom) popserver server; int message; int markfrom; { int *IDs, *sizes, bufsize, fromcount = 0, cp = 0; char *ptr, *fromserver; int ret; if (server->in_multi) { strcpy (pop_error, "In multi-line query in pop_retrieve"); return (0); } if (pop_list (server, message, &IDs, &sizes)) return (0); if (pop_retrieve_first (server, message, &fromserver)) { return (0); } /* * The "5" below is an arbitrary constant -- I assume that if * there are "From" lines in the text to be marked, there * probably won't be more than 5 of them. If there are, I * allocate more space for them below. */ bufsize = sizes[0] + (markfrom ? 5 : 0); ptr = malloc (bufsize); free ((char *) IDs); free ((char *) sizes); if (! ptr) { strcpy (pop_error, "Out of memory in pop_retrieve"); pop_retrieve_flush (server); return (0); } while (! (ret = pop_retrieve_next (server, &fromserver))) { int linesize; if (! fromserver) { ptr[cp] = '\0'; return (ptr); } if (markfrom && fromserver[0] == 'F' && fromserver[1] == 'r' && fromserver[2] == 'o' && fromserver[3] == 'm' && fromserver[4] == ' ') { if (++fromcount == 5) { bufsize += 5; ptr = realloc (ptr, bufsize); if (! ptr) { strcpy (pop_error, "Out of memory in pop_retrieve"); pop_retrieve_flush (server); return (0); } fromcount = 0; } ptr[cp++] = '>'; } linesize = strlen (fromserver); bcopy (fromserver, &ptr[cp], linesize); cp += linesize; ptr[cp++] = '\n'; } if (ret) { free (ptr); return (0); } } int pop_retrieve_first (server, message, response) popserver server; int message; char **response; { sprintf (pop_error, "RETR %d", message); return (pop_multi_first (server, pop_error, response)); } int pop_retrieve_next (server, line) popserver server; char **line; { return (pop_multi_next (server, line)); } int pop_retrieve_flush (server) popserver server; { return (pop_multi_flush (server)); } int pop_top_first (server, message, lines, response) popserver server; int message, lines; char **response; { sprintf (pop_error, "TOP %d %d", message, lines); return (pop_multi_first (server, pop_error, response)); } int pop_top_next (server, line) popserver server; char **line; { return (pop_multi_next (server, line)); } int pop_top_flush (server) popserver server; { return (pop_multi_flush (server)); } int pop_multi_first (server, command, response) popserver server; char *command; char **response; { if (server->in_multi) { strcpy (pop_error, "Already in multi-line query in pop_multi_first"); return (-1); } if (sendline (server, command) || (! (*response = getline (server)))) { return (-1); } if (0 == strncmp (*response, "-ERR", 4)) { strncpy (pop_error, *response, ERROR_MAX); return (-1); } else if (0 == strncmp (*response, "+OK", 3)) { for (*response += 3; **response == ' '; (*response)++) /* empty */; server->in_multi = 1; return (0); } else { strcpy (pop_error, "Unexpected response from server in pop_multi_first"); return (-1); } } int pop_multi_next (server, line) popserver server; char **line; { char *fromserver; if (! server->in_multi) { strcpy (pop_error, "Not in multi-line query in pop_multi_next"); return (-1); } fromserver = getline (server); if (! fromserver) { return (-1); } if (fromserver[0] == '.') { if (! fromserver[1]) { *line = 0; server->in_multi = 0; return (0); } else { *line = fromserver + 1; return (0); } } else { *line = fromserver; return (0); } } int pop_multi_flush (server) popserver server; { char *line; if (! server->in_multi) { return (0); } while (! pop_multi_next (server, &line)) { if (! line) { return (0); } } return (-1); } /* Function: pop_delete * * Purpose: Delete a specified message. * * Arguments: * server Server from which to delete the message. * message Message to delete. * * Return value: 0 on success, non-zero with error in pop_error * otherwise. */ int pop_delete (server, message) popserver server; int message; { if (server->in_multi) { strcpy (pop_error, "In multi-line query in pop_delete"); return (-1); } sprintf (pop_error, "DELE %d", message); if (sendline (server, pop_error) || getok (server)) return (-1); return (0); } /* * Function: pop_noop * * Purpose: Send a noop command to the server. * * Argument: * server The server to send to. * * Return value: 0 on success, non-zero with error in pop_error * otherwise. * * Side effects: Closes connection on error. */ int pop_noop (server) popserver server; { if (server->in_multi) { strcpy (pop_error, "In multi-line query in pop_noop"); return (-1); } if (sendline (server, "NOOP") || getok (server)) return (-1); return (0); } /* * Function: pop_last * * Purpose: Find out the highest seen message from the server. * * Arguments: * server The server. * * Return value: If successful, the highest seen message, which is * greater than or equal to 0. Otherwise, a negative number with * the error explained in pop_error. * * Side effects: Closes the connection on error. */ int pop_last (server) popserver server; { char *fromserver; if (server->in_multi) { strcpy (pop_error, "In multi-line query in pop_last"); return (-1); } if (sendline (server, "LAST")) return (-1); if (! (fromserver = getline (server))) return (-1); if (! strncmp (fromserver, "-ERR", 4)) { strncpy (pop_error, fromserver, ERROR_MAX); return (-1); } else if (strncmp (fromserver, "+OK ", 4)) { strcpy (pop_error, "Unexpected response from server in pop_last"); pop_trash (server); return (-1); } else { return (atoi (&fromserver[4])); } } /* * Function: pop_reset * * Purpose: Reset the server to its initial connect state * * Arguments: * server The server. * * Return value: 0 for success, non-0 with error in pop_error * otherwise. * * Side effects: Closes the connection on error. */ int pop_reset (server) popserver server; { if (pop_retrieve_flush (server)) { return (-1); } if (sendline (server, "RSET") || getok (server)) return (-1); return (0); } /* * Function: pop_quit * * Purpose: Quit the connection to the server, * * Arguments: * server The server to quit. * * Return value: 0 for success, non-zero otherwise with error in * pop_error. * * Side Effects: The popserver passed in is unuseable after this * function is called, even if an error occurs. */ int pop_quit (server) popserver server; { int ret = 0; if (server->file >= 0) { if (pop_retrieve_flush (server)) { ret = -1; } if (sendline (server, "QUIT") || getok (server)) { ret = -1; } close (server->file); } if (server->buffer) free (server->buffer); free ((char *) server); return (ret); } /* * Function: socket_connection * * Purpose: Opens the network connection with the mail host, without * doing any sort of I/O with it or anything. * * Arguments: * host The host to which to connect. * flags Option flags. * * Return value: A file descriptor indicating the connection, or -1 * indicating failure, in which case an error has been copied * into pop_error. */ static int socket_connection (host, flags) char *host; int flags; { struct hostent *hostent; struct servent *servent; struct sockaddr_in addr; char found_port = 0; char *service; int sock; #ifdef KERBEROS #ifdef KRB5 krb5_error_code rem; krb5_ccache ccdef; krb5_principal client, server; krb5_error *err_ret; register char *cp; #else KTEXT ticket; MSG_DAT msg_data; CREDENTIALS cred; Key_schedule schedule; int rem; #endif /* KRB5 */ #endif /* KERBEROS */ int try_count = 0; do { hostent = gethostbyname (host); try_count++; if ((! hostent) && ((h_errno != TRY_AGAIN) || (try_count == 5))) { strcpy (pop_error, "Could not determine POP server's address"); return (-1); } } while (! hostent); bzero ((char *) &addr, sizeof (addr)); addr.sin_family = AF_INET; #ifdef KERBEROS service = (flags & POP_NO_KERBEROS) ? POP_SERVICE : KPOP_SERVICE; #else service = POP_SERVICE; #endif #ifdef HESIOD if (! (flags & POP_NO_HESIOD)) { servent = hes_getservbyname (service, "tcp"); if (servent) { addr.sin_port = servent->s_port; found_port = 1; } } #endif if (! found_port) { servent = getservbyname (service, "tcp"); if (servent) { addr.sin_port = servent->s_port; } else { #ifdef KERBEROS addr.sin_port = htons ((flags & POP_NO_KERBEROS) ? POP_PORT : KPOP_PORT); #else addr.sin_port = htons (POP_PORT); #endif } } #define SOCKET_ERROR "Could not create socket for POP connection: " sock = socket (PF_INET, SOCK_STREAM, 0); if (sock < 0) { strcpy (pop_error, SOCKET_ERROR); strncat (pop_error, strerror (errno), ERROR_MAX - sizeof (SOCKET_ERROR)); return (-1); } while (*hostent->h_addr_list) { bcopy (*hostent->h_addr_list, (char *) &addr.sin_addr, hostent->h_length); if (! connect (sock, (struct sockaddr *) &addr, sizeof (addr))) break; hostent->h_addr_list++; } #define CONNECT_ERROR "Could not connect to POP server: " if (! *hostent->h_addr_list) { (void) close (sock); strcpy (pop_error, CONNECT_ERROR); strncat (pop_error, strerror (errno), ERROR_MAX - sizeof (CONNECT_ERROR)); return (-1); } #ifdef KERBEROS #define KRB_ERROR "Kerberos error connecting to POP server: " if (! (flags & POP_NO_KERBEROS)) { #ifdef KRB5 krb5_init_ets (); if (rem = krb5_cc_default (&ccdef)) { krb5error: strcpy (pop_error, KRB_ERROR); strncat (pop_error, error_message (rem), ERROR_MAX - sizeof(KRB_ERROR)); (void) close (sock); return (-1); } if (rem = krb5_cc_get_principal (ccdef, &client)) { goto krb5error; } for (cp = hostent->h_name; *cp; cp++) { if (isupper (*cp)) { *cp = tolower (*cp); } } if (rem = krb5_sname_to_principal (hostent->h_name, POP_SERVICE, FALSE, &server)) { goto krb5error; } rem = krb5_sendauth ((krb5_pointer) &sock, "KPOPV1.0", client, server, AP_OPTS_MUTUAL_REQUIRED, 0, /* no checksum */ 0, /* no creds, use ccache instead */ ccdef, 0, /* don't need seq # */ 0, /* don't need subsession key */ &err_ret, 0); /* don't need reply */ krb5_free_principal (server); if (rem) { if (err_ret && err_ret->text.length) { strcpy (pop_error, KRB_ERROR); strncat (pop_error, error_message (rem), ERROR_MAX - sizeof (KRB_ERROR)); strncat (pop_error, " [server says '", ERROR_MAX - strlen (pop_error) - 1); strncat (pop_error, err_ret->text.data, min (ERROR_MAX - strlen (pop_error) - 1, err_ret->text.length)); strncat (pop_error, "']", ERROR_MAX - strlen (pop_error) - 1); } else { strcpy (pop_error, KRB_ERROR); strncat (pop_error, error_message (rem), ERROR_MAX - sizeof (KRB_ERROR)); } if (err_ret) krb5_free_error (err_ret); (void) close (sock); return (-1); } #else /* ! KRB5 */ ticket = (KTEXT) malloc (sizeof (KTEXT_ST)); rem = krb_sendauth (0L, sock, ticket, "pop", hostent->h_name, (char *) krb_realmofhost (hostent->h_name), (unsigned long) 0, &msg_data, &cred, schedule, (struct sockaddr_in *) 0, (struct sockaddr_in *) 0, "KPOPV0.1"); free ((char *) ticket); if (rem != KSUCCESS) { strcpy (pop_error, KRB_ERROR); strncat (pop_error, krb_err_txt[rem], ERROR_MAX - sizeof (KRB_ERROR)); (void) close (sock); return (-1); } #endif /* KRB5 */ } #endif /* KERBEROS */ return (sock); } /* socket_connection */ /* * Function: getline * * Purpose: Get a line of text from the connection and return a * pointer to it. The carriage return and linefeed at the end of * the line are stripped, but periods at the beginnings of lines * are NOT dealt with in any special way. * * Arguments: * server The server from which to get the line of text. * * Returns: A non-null pointer if successful, or a null pointer on any * error, with an error message copied into pop_error. * * Notes: The line returned is overwritten with each call to getline. * * Side effects: Closes the connection on error. */ static char * getline (server) popserver server; { #define GETLINE_ERROR "Error reading from server: " int ret; int search_offset = 0; if (server->data) { char *cp = find_crlf (server->buffer + server->buffer_index); if (cp) { int found; int data_used; found = server->buffer_index; data_used = (cp + 2) - server->buffer - found; *cp = '\0'; /* terminate the string to be returned */ server->data -= data_used; server->buffer_index += data_used; if (pop_debug) fprintf (stderr, "<<< %s\n", server->buffer + found); return (server->buffer + found); } else { bcopy (server->buffer + server->buffer_index, server->buffer, server->data); /* Record the fact that we've searched the data already in the buffer for a CRLF, so that when we search below, we don't have to search the same data twice. There's a "- 1" here to account for the fact that the last character of the data we have may be the CR of a CRLF pair, of which we haven't read the second half yet, so we may have to search it again when we read more data. */ search_offset = server->data - 1; server->buffer_index = 0; } } else { server->buffer_index = 0; } while (1) { /* There's a "- 1" here to leave room for the null that we put at the end of the read data below. We put the null there so that find_crlf knows where to stop when we call it. */ if (server->data == server->buffer_size - 1) { server->buffer_size += GETLINE_INCR; server->buffer = realloc (server->buffer, server->buffer_size); if (! server->buffer) { strcpy (pop_error, "Out of memory in getline"); pop_trash (server); return (0); } } ret = read (server->file, server->buffer + server->data, server->buffer_size - server->data - 1); if (ret < 0) { strcpy (pop_error, GETLINE_ERROR); strncat (pop_error, strerror (errno), ERROR_MAX - sizeof (GETLINE_ERROR)); pop_trash (server); return (0); } else if (ret == 0) { strcpy (pop_error, "Unexpected EOF from server in getline"); pop_trash (server); return (0); } else { char *cp; server->data += ret; server->buffer[server->data] = '\0'; cp = find_crlf (server->buffer + search_offset); if (cp) { int data_used = (cp + 2) - server->buffer; *cp = '\0'; server->data -= data_used; server->buffer_index = data_used; if (pop_debug) fprintf (stderr, "<<< %s\n", server->buffer); return (server->buffer); } search_offset += ret; } } /* NOTREACHED */ } /* * Function: sendline * * Purpose: Sends a line of text to the POP server. The line of text * passed into this function should NOT have the carriage return * and linefeed on the end of it. Periods at beginnings of lines * will NOT be treated specially by this function. * * Arguments: * server The server to which to send the text. * line The line of text to send. * * Return value: Upon successful completion, a value of 0 will be * returned. Otherwise, a non-zero value will be returned, and * an error will be copied into pop_error. * * Side effects: Closes the connection on error. */ static int sendline (server, line) popserver server; char *line; { #define SENDLINE_ERROR "Error writing to POP server: " int ret; ret = fullwrite (server->file, line, strlen (line)); if (ret >= 0) { /* 0 indicates that a blank line was written */ ret = fullwrite (server->file, "\r\n", 2); } if (ret < 0) { pop_trash (server); strcpy (pop_error, SENDLINE_ERROR); strncat (pop_error, strerror (errno), ERROR_MAX - sizeof (SENDLINE_ERROR)); return (ret); } if (pop_debug) fprintf (stderr, ">>> %s\n", line); return (0); } /* * Procedure: fullwrite * * Purpose: Just like write, but keeps trying until the entire string * has been written. * * Return value: Same as write. Pop_error is not set. */ static int fullwrite (fd, buf, nbytes) int fd; char *buf; int nbytes; { char *cp; int ret; cp = buf; while ((ret = write (fd, cp, nbytes)) > 0) { cp += ret; nbytes -= ret; } return (ret); } /* * Procedure getok * * Purpose: Reads a line from the server. If the return indicator is * positive, return with a zero exit status. If not, return with * a negative exit status. * * Arguments: * server The server to read from. * * Returns: 0 for success, else for failure and puts error in pop_error. * * Side effects: On failure, may make the connection unuseable. */ static int getok (server) popserver server; { char *fromline; if (! (fromline = getline (server))) { return (-1); } if (! strncmp (fromline, "+OK", 3)) return (0); else if (! strncmp (fromline, "-ERR", 4)) { strncpy (pop_error, fromline, ERROR_MAX); pop_error[ERROR_MAX-1] = '\0'; return (-1); } else { strcpy (pop_error, "Unexpected response from server; expecting +OK or -ERR"); pop_trash (server); return (-1); } } #if 0 /* * Function: gettermination * * Purpose: Gets the next line and verifies that it is a termination * line (nothing but a dot). * * Return value: 0 on success, non-zero with pop_error set on error. * * Side effects: Closes the connection on error. */ static int gettermination (server) popserver server; { char *fromserver; fromserver = getline (server); if (! fromserver) return (-1); if (strcmp (fromserver, ".")) { strcpy (pop_error, "Unexpected response from server in gettermination"); pop_trash (server); return (-1); } return (0); } #endif /* * Function pop_close * * Purpose: Close a pop connection, sending a "RSET" command to try to * preserve any changes that were made and a "QUIT" command to * try to get the server to quit, but ignoring any responses that * are received. * * Side effects: The server is unuseable after this function returns. * Changes made to the maildrop since the session was started (or * since the last pop_reset) may be lost. */ void pop_close (server) popserver server; { pop_trash (server); free ((char *) server); return; } /* * Function: pop_trash * * Purpose: Like pop_close or pop_quit, but doesn't deallocate the * memory associated with the server. It is legal to call * pop_close or pop_quit after this function has been called. */ static void pop_trash (server) popserver server; { if (server->file >= 0) { sendline (server, "RSET"); sendline (server, "QUIT"); close (server->file); server->file = -1; if (server->buffer) { free (server->buffer); server->buffer = 0; } } } /* Return a pointer to the first CRLF in IN_STRING, or 0 if it does not contain one. */ static char * find_crlf (in_string) char *in_string; { while (1) { if (! *in_string) return (0); else if (*in_string == '\r') { if (*++in_string == '\n') return (in_string - 1); } else in_string++; } /* NOTREACHED */ } #endif /* MAIL_USE_POP */ emacs-19.30/lib-src/pop.h100444 12120 13 5312 5642073473 13153 0ustar rmsuser/* pop.h: Header file for the "pop.c" client POP3 protocol. Copyright (c) 1991,1993 Free Software Foundation, Inc. Written by Jonathan Kamens, jik@security.ov.com. 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. */ #include #define GETLINE_MIN 1024 /* the getline buffer starts out this */ /* size */ #define GETLINE_INCR 1024 /* the getline buffer is grown by this */ /* size when it needs to grow */ extern char pop_error[]; extern int pop_debug; struct _popserver { int file, data; char *buffer; int buffer_size, buffer_index; int in_multi; }; typedef struct _popserver *popserver; /* * Valid flags for the pop_open function. */ #define POP_NO_KERBEROS (1<<0) #define POP_NO_HESIOD (1<<1) #define POP_NO_GETPASS (1<<2) #ifdef __STDC__ #define _ARGS(a) a #else #define _ARGS(a) () #endif extern popserver pop_open _ARGS((char *host, char *username, char *password, int flags)); extern int pop_stat _ARGS((popserver server, int *count, int *size)); extern int pop_list _ARGS((popserver server, int message, int **IDs, int **size)); extern char *pop_retrieve _ARGS((popserver server, int message, int markfrom)); extern int pop_retrieve_first _ARGS((popserver server, int message, char **response)); extern int pop_retrieve_next _ARGS((popserver server, char **line)); extern int pop_retrieve_flush _ARGS((popserver server)); extern int pop_top_first _ARGS((popserver server, int message, int lines, char **response)); extern int pop_top_next _ARGS((popserver server, char **line)); extern int pop_top_flush _ARGS((popserver server)); extern int pop_multi_first _ARGS((popserver server, char *command, char **response)); extern int pop_multi_next _ARGS((popserver server, char **line)); extern int pop_multi_flush _ARGS((popserver server)); extern int pop_delete _ARGS((popserver server, int message)); extern int pop_noop _ARGS((popserver server)); extern int pop_last _ARGS((popserver server)); extern int pop_reset _ARGS((popserver server)); extern int pop_quit _ARGS((popserver server)); extern void pop_close _ARGS((popserver)); #undef _ARGS emacs-19.30/lib-src/profile.c100444 12120 13 4726 6006055103 14001 0ustar rmsuser/* profile.c --- generate periodic events for profiling of Emacs Lisp code. Copyright (C) 1992, 1994 Free Software Foundation, Inc. Author: Boaz Ben-Zvi 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. */ /** ** To be run as an emacs process. Input string that starts with: ** 'z' -- resets the watch (to zero). ** 'p' -- return time (on stdout) as string with format . ** 'q' -- exit. ** ** abstraction : a stopwatch ** operations: reset_watch, get_time */ #include #include <../src/config.h> #include <../src/systime.h> static EMACS_TIME TV1, TV2; static int watch_not_started = 1; /* flag */ static char time_string[30]; /* Reset the stopwatch to zero. */ void reset_watch () { EMACS_GET_TIME (TV1); watch_not_started = 0; } /* This call returns the time since the last reset_watch call. The time is returned as a string with the format . If reset_watch was not called yet, exit. */ char * get_time () { if (watch_not_started) exit (1); /* call reset_watch first ! */ EMACS_GET_TIME (TV2); EMACS_SUB_TIME (TV2, TV2, TV1); sprintf (time_string, "%lu.%06lu", EMACS_SECS (TV2), EMACS_USECS (TV2)); return time_string; } #if ! defined (HAVE_GETTIMEOFDAY) && defined (HAVE_TIMEVAL) /* ARGSUSED */ gettimeofday (tp, tzp) struct timeval *tp; struct timezone *tzp; { extern long time (); tp->tv_sec = time ((long *)0); tp->tv_usec = 0; if (tzp != 0) tzp->tz_minuteswest = -1; } #endif void main () { int c; while ((c = getchar ()) != EOF) { switch (c) { case 'z': reset_watch (); break; case 'p': puts (get_time ()); break; case 'q': exit (0); } /* Anything remaining on the line is ignored. */ while (c != '\n' && c != EOF) c = getchar (); } exit (1); } emacs-19.30/lib-src/qsort.c100444 21570 1 20410 5641436012 13747 0ustar djmdaemon/* Plug-compatible replacement for UNIX qsort. Copyright (C) 1989 Free Software Foundation, Inc. Written by Douglas C. Schmidt (schmidt@ics.uci.edu) This file is part of GNU CC. GNU QSORT 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 QSORT 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 QSORT; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifdef sparc #include #endif /* Invoke the comparison function, returns either 0, < 0, or > 0. */ #define CMP(A,B) ((*cmp)((A),(B))) /* Byte-wise swap two items of size SIZE. */ #define SWAP(A,B,SIZE) do {int sz = (SIZE); char *a = (A); char *b = (B); \ do { char _temp = *a;*a++ = *b;*b++ = _temp;} while (--sz);} while (0) /* Copy SIZE bytes from item B to item A. */ #define COPY(A,B,SIZE) {int sz = (SIZE); do { *(A)++ = *(B)++; } while (--sz); } /* This should be replaced by a standard ANSI macro. */ #define BYTES_PER_WORD 8 /* The next 4 #defines implement a very fast in-line stack abstraction. */ #define STACK_SIZE (BYTES_PER_WORD * sizeof (long)) #define PUSH(LOW,HIGH) do {top->lo = LOW;top++->hi = HIGH;} while (0) #define POP(LOW,HIGH) do {LOW = (--top)->lo;HIGH = top->hi;} while (0) #define STACK_NOT_EMPTY (stack < top) /* Discontinue quicksort algorithm when partition gets below this size. This particular magic number was chosen to work best on a Sun 4/260. */ #define MAX_THRESH 4 /* Stack node declarations used to store unfulfilled partition obligations. */ typedef struct { char *lo; char *hi; } stack_node; /* Order size using quicksort. This implementation incorporates four optimizations discussed in Sedgewick: 1. Non-recursive, using an explicit stack of pointer that store the next array partition to sort. To save time, this maximum amount of space required to store an array of MAX_INT is allocated on the stack. Assuming a 32-bit integer, this needs only 32 * sizeof (stack_node) == 136 bits. Pretty cheap, actually. 2. Chose the pivot element using a median-of-three decision tree. This reduces the probability of selecting a bad pivot value and eliminates certain extraneous comparisons. 3. Only quicksorts TOTAL_ELEMS / MAX_THRESH partitions, leaving insertion sort to order the MAX_THRESH items within each partition. This is a big win, since insertion sort is faster for small, mostly sorted array segments. 4. The larger of the two sub-partitions is always pushed onto the stack first, with the algorithm then concentrating on the smaller partition. This *guarantees* no more than log (n) stack size is needed (actually O(1) in this case)! */ int qsort (base_ptr, total_elems, size, cmp) char *base_ptr; int total_elems; int size; int (*cmp)(); { /* Allocating SIZE bytes for a pivot buffer facilitates a better algorithm below since we can do comparisons directly on the pivot. */ char *pivot_buffer = (char *) alloca (size); int max_thresh = MAX_THRESH * size; if (total_elems > MAX_THRESH) { char *lo = base_ptr; char *hi = lo + size * (total_elems - 1); stack_node stack[STACK_SIZE]; /* Largest size needed for 32-bit int!!! */ stack_node *top = stack + 1; while (STACK_NOT_EMPTY) { char *left_ptr; char *right_ptr; { char *pivot = pivot_buffer; { /* Select median value from among LO, MID, and HI. Rearrange LO and HI so the three values are sorted. This lowers the probability of picking a pathological pivot value and skips a comparison for both the LEFT_PTR and RIGHT_PTR. */ char *mid = lo + size * ((hi - lo) / size >> 1); if (CMP (mid, lo) < 0) SWAP (mid, lo, size); if (CMP (hi, mid) < 0) SWAP (mid, hi, size); else goto jump_over; if (CMP (mid, lo) < 0) SWAP (mid, lo, size); jump_over: COPY (pivot, mid, size); pivot = pivot_buffer; } left_ptr = lo + size; right_ptr = hi - size; /* Here's the famous ``collapse the walls'' section of quicksort. Gotta like those tight inner loops! They are the main reason that this algorithm runs much faster than others. */ do { while (CMP (left_ptr, pivot) < 0) left_ptr += size; while (CMP (pivot, right_ptr) < 0) right_ptr -= size; if (left_ptr < right_ptr) { SWAP (left_ptr, right_ptr, size); left_ptr += size; right_ptr -= size; } else if (left_ptr == right_ptr) { left_ptr += size; right_ptr -= size; break; } } while (left_ptr <= right_ptr); } /* Set up pointers for next iteration. First determine whether left and right partitions are below the threshold size. If so, ignore one or both. Otherwise, push the larger partition's bounds on the stack and continue sorting the smaller one. */ if ((right_ptr - lo) <= max_thresh) { if ((hi - left_ptr) <= max_thresh) /* Ignore both small partitions. */ POP (lo, hi); else /* Ignore small left partition. */ lo = left_ptr; } else if ((hi - left_ptr) <= max_thresh) /* Ignore small right partition. */ hi = right_ptr; else if ((right_ptr - lo) > (hi - left_ptr)) /* Push larger left partition indices. */ { PUSH (lo, right_ptr); lo = left_ptr; } else /* Push larger right partition indices. */ { PUSH (left_ptr, hi); hi = right_ptr; } } } /* Once the BASE_PTR array is partially sorted by quicksort the rest is completely sorted using insertion sort, since this is efficient for partitions below MAX_THRESH size. BASE_PTR points to the beginning of the array to sort, and END_PTR points at the very last element in the array (*not* one beyond it!). */ #define MIN(X,Y) ((X) < (Y) ? (X) : (Y)) { char *end_ptr = base_ptr + size * (total_elems - 1); char *run_ptr; char *tmp_ptr = base_ptr; char *thresh = MIN (end_ptr, base_ptr + max_thresh); /* Find smallest element in first threshold and place it at the array's beginning. This is the smallest array element, and the operation speeds up insertion sort's inner loop. */ for (run_ptr = tmp_ptr + size; run_ptr <= thresh; run_ptr += size) if (CMP (run_ptr, tmp_ptr) < 0) tmp_ptr = run_ptr; if (tmp_ptr != base_ptr) SWAP (tmp_ptr, base_ptr, size); /* Insertion sort, running from left-hand-side up to `right-hand-side.' Pretty much straight out of the original GNU qsort routine. */ for (run_ptr = base_ptr + size; (tmp_ptr = run_ptr += size) <= end_ptr; ) { while (CMP (run_ptr, tmp_ptr -= size) < 0) ; if ((tmp_ptr += size) != run_ptr) { char *trav; for (trav = run_ptr + size; --trav >= run_ptr;) { char c = *trav; char *hi, *lo; for (hi = lo = trav; (lo -= size) >= tmp_ptr; hi = lo) *hi = *lo; *hi = c; } } } } return 1; } emacs-19.30/lib-src/sorted-doc.c100444 21570 13 12574 5647043235 14423 0ustar djmuser/* Give this program DOCSTR.mm.nn as standard input and it outputs to standard output a file of texinfo input containing the doc strings. This version sorts the output by function name. */ #include #include extern char *malloc (); char *xmalloc (); #define NUL '\0' #define MARKER '\037' #define DEBUG 0 typedef struct line LINE; struct line { LINE *next; /* ptr to next or NULL */ char *line; /* text of the line */ }; typedef struct docstr DOCSTR; struct docstr /* Allocated thing for an entry. */ { DOCSTR *next; /* next in the chain */ char *name; /* name of the function or var */ LINE *first; /* first line of doc text. */ char type; /* 'F' for function, 'V' for variable */ }; /* Print error message. `s1' is printf control string, `s2' is arg for it. */ void error (s1, s2) char *s1, *s2; { fprintf (stderr, "sorted-doc: "); fprintf (stderr, s1, s2); fprintf (stderr, "\n"); } /* Print error message and exit. */ void fatal (s1, s2) char *s1, *s2; { error (s1, s2); exit (1); } /* Like malloc but get fatal error if memory is exhausted. */ char * xmalloc (size) int size; { char *result = malloc ((unsigned)size); if (result == NULL) fatal ("%s", "virtual memory exhausted"); return result; } char * xstrdup (str) char * str; { char *buf = xmalloc (strlen (str) + 1); (void) strcpy (buf, str); return (buf); } /* Comparison function for qsort to call. */ int cmpdoc (a, b) DOCSTR **a; DOCSTR **b; { register int val = strcmp ((*a)->name, (*b)->name); if (val) return val; return (*a)->type - (*b)->type; } enum state { WAITING, BEG_NAME, NAME_GET, BEG_DESC, DESC_GET }; char *states[] = { "WAITING", "BEG_NAME", "NAME_GET", "BEG_DESC", "DESC_GET" }; int main () { register DOCSTR *dp = NULL; /* allocated DOCSTR */ register LINE *lp = NULL; /* allocated line */ register char *bp; /* ptr inside line buffer */ register enum state state = WAITING; /* state at start */ int cnt = 0; /* number of DOCSTRs read */ DOCSTR *docs; /* chain of allocated DOCSTRS */ char buf[512]; /* line buffer */ while (1) /* process one char at a time */ { /* this char from the DOCSTR file */ register int ch = getchar (); /* Beginnings */ if (state == WAITING) { if (ch == MARKER) state = BEG_NAME; } else if (state == BEG_NAME) { cnt++; if (dp == NULL) /* first dp allocated */ { docs = dp = (DOCSTR*) xmalloc (sizeof (DOCSTR)); } else /* all the rest */ { dp->next = (DOCSTR*) xmalloc (sizeof (DOCSTR)); dp = dp->next; } lp = NULL; dp->next = NULL; bp = buf; state = NAME_GET; /* Record whether function or variable. */ dp->type = ch; ch = getchar (); } else if (state == BEG_DESC) { if (lp == NULL) /* first line for dp */ { dp->first = lp = (LINE*)xmalloc (sizeof (LINE)); } else /* continuing lines */ { lp->next = (LINE*)xmalloc (sizeof (LINE)); lp = lp->next; } lp->next = NULL; bp = buf; state = DESC_GET; } /* process gets */ if (state == NAME_GET || state == DESC_GET) { if (ch != MARKER && ch != '\n' && ch != EOF) { *bp++ = ch; } else /* saving and changing state */ { *bp = NUL; bp = xstrdup (buf); if (state == NAME_GET) dp->name = bp; else lp->line = bp; bp = buf; state = (ch == MARKER) ? BEG_NAME : BEG_DESC; } } /* NAME_GET || DESC_GET */ if (ch == EOF) break; } { DOCSTR **array; register int i; /* counter */ /* build array of ptrs to DOCSTRs */ array = (DOCSTR**)xmalloc (cnt * sizeof (*array)); for (dp = docs, i = 0; dp != NULL ; dp = dp->next) array[i++] = dp; /* sort the array by name; within each name, by type */ qsort ((char*)array, cnt, sizeof (DOCSTR*), cmpdoc); /* write the output header */ printf ("\\input texinfo @c -*-texinfo-*-\n"); printf ("@setfilename ../info/summary\n"); printf ("@settitle Command Summary for GNU Emacs\n"); printf ("@unnumbered Command Summary for GNU Emacs\n"); printf ("@table @asis\n"); printf ("\n"); printf ("@let@ITEM@item\n"); printf ("@def@item{@filbreak@vskip5pt@ITEM}\n"); printf ("@font@tensy cmsy10 scaled @magstephalf\n"); printf ("@font@teni cmmi10 scaled @magstephalf\n"); printf ("@def\\{{@tensy@char110}}\n"); /* this backslash goes with cmr10 */ printf ("@def|{{@tensy@char106}}\n"); printf ("@def@{{{@tensy@char102}}\n"); printf ("@def@}{{@tensy@char103}}\n"); printf ("@def<{{@teni@char62}}\n"); printf ("@def>{{@teni@char60}}\n"); printf ("@chardef@@64\n"); printf ("@catcode43=12\n"); printf ("@tableindent-0.2in\n"); /* print each function from the array */ for (i = 0; i < cnt; i++) { printf ("\n@item %s @code{%s}\n@display\n", array[i]->type == 'F' ? "Function" : "Variable", array[i]->name); for (lp = array[i]->first; lp != NULL ; lp = lp->next) { for (bp = lp->line; *bp; bp++) { /* the characters "@{}" need special treatment */ if (*bp == '@' || *bp == '{' || *bp == '}') { putchar('@'); } putchar(*bp); } putchar ('\n'); } printf("@end display\n"); } printf ("@end table\n"); printf ("@bye\n"); } return 0; } emacs-19.30/lib-src/tcp.c100444 21570 13 12607 5534013561 13135 0ustar djmuser/* * TCP/IP stream emulation for GNU Emacs. * Copyright (C) 1988, 1989, 1992, 1993 Free Software Foundation, Inc. * Author: Masanobu Umeda * Maintainer: umerin@mse.kyutech.ac.jp 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. * * Yasunari, Itoh at PFU limited contributed for Fujitsu UTS and SX/A. * * Thu Apr 6 13:47:37 JST 1989 * USG fixes by Sakaeda * * For Fujitsu UTS compile with: * cc -O -o tcp tcp.c -DFUJITSU_UTS -lu -lsocket */ #include #include #include #include #ifdef FUJITSU_UTS #define USG #include #include #include #include #else #include #include #include #endif #ifdef USG #include #include #endif #ifdef FUJITSU_UTS #define bcopy(f, t, n) memcpy (t, f, n) #define bcmp(b1, b2, n) (memcmp (b1, b2, n)!=0) #define bzero(b, n) memset (b, 0, n) #endif #ifdef USG int selectable = 1; sigout () { fcntl (fileno (stdin), F_SETFL, 0); exit (-1); } #endif main (argc, argv) int argc; char *argv[]; { struct hostent *host; struct sockaddr_in sockin, sockme; struct servent *serv; char *hostname = NULL; char *service = "nntp"; int port; int readfds; int writefds; int server; /* NNTP Server */ int emacsIn = fileno (stdin); /* Emacs intput */ int emacsOut = fileno (stdout); /* Emacs output */ char buffer[1024]; int nbuffer; /* Number of bytes in buffer */ int wret; char *retry; /* retry bufferp */ int false = 0; /* FALSE flag for setsockopt () */ if (argc < 2) { fprintf (stderr, "Usage: %s HOST [SERVICE]\n", argv[0]); exit (1); } if (argc >= 2) hostname = argv[1]; if (argc >= 3) service = argv[2]; if ((host = gethostbyname (hostname)) == NULL) { perror ("gethostbyname"); exit (1); } if (isdigit (service[0])) port = atoi (service); else { serv = getservbyname (service, "tcp"); if (serv == NULL) { perror ("getservbyname"); exit (1); } port = serv->s_port; } bzero (&sockin, sizeof (sockin)); sockin.sin_family = host->h_addrtype; bcopy (host->h_addr, &sockin.sin_addr, host->h_length); sockin.sin_port = port; if ((server = socket (AF_INET, SOCK_STREAM, 0)) < 0) { perror ("socket"); exit (1); } if (setsockopt (server, SOL_SOCKET, SO_REUSEADDR, &false, sizeof (false))) { perror ("setsockopt"); exit (1); } bzero (&sockme, sizeof (sockme)); sockme.sin_family = sockin.sin_family; sockme.sin_addr.s_addr = INADDR_ANY; if (bind (server, &sockme, sizeof (sockme)) < 0) { perror ("bind"); exit (1); } if (connect (server, &sockin, sizeof (sockin)) < 0) { perror ("connect"); close (server); exit (1); } #ifdef O_NDELAY fcntl (server, F_SETFL, O_NDELAY); #ifdef USG /* USG pipe cannot not select emacsIn */ { struct stat statbuf; fstat (emacsIn, &statbuf); if (statbuf.st_mode & 010000) selectable = 0; if (!selectable) { signal (SIGINT, sigout); fcntl (emacsIn, F_SETFL, O_NDELAY); } } #endif #endif /* Connection established. */ while (1) { readfds = (1 << server) | (1 << emacsIn); if (select (32, &readfds, NULL, NULL, (struct timeval *)NULL) == -1) { perror ("select"); exit (1); } if (readfds & (1 << emacsIn)) { /* From Emacs */ nbuffer = read (emacsIn, buffer, sizeof buffer -1); #ifdef USG if (selectable && nbuffer == 0) { goto finish; } else if (!(readfds & (1 << server)) && nbuffer == 0) { sleep (1); } else #else if (nbuffer == 0) goto finish; #endif for (retry = buffer; nbuffer > 0; nbuffer -= wret, retry += wret) { writefds = 1 << server; if (select (server+1, NULL, &writefds, NULL, (struct timeval*)NULL) == -1) { perror ("select"); exit (1); } wret = write (server, retry, nbuffer); if (wret < 0) goto finish; } } if (readfds & (1 << server)) { /* From NNTP server */ nbuffer = read (server, buffer, sizeof buffer -1); if (nbuffer == 0) goto finish; for (retry = buffer; nbuffer > 0; nbuffer -= wret, retry += wret) { writefds = 1 << emacsOut; #ifdef USG if (selectable) #endif if (select (emacsOut+1, NULL, &writefds, NULL, (struct timeval*)NULL) == -1) { perror ("select"); exit (1); } wret = write (emacsOut, retry, nbuffer); if (wret < 0) goto finish; } } } /* End of communication. */ finish: close (server); #ifdef USG if (!selectable) fcntl (emacsIn, F_SETFL, 0); #endif close (emacsIn); close (emacsOut); exit (0); } emacs-19.30/lib-src/test-distrib.c100444 12120 13 3365 6021220125 14747 0ustar rmsuser#ifdef HAVE_CONFIG_H #include #endif /* Cancel substitutions made by config.h for Emacs. */ #undef open #undef read #undef write #undef close #include #ifndef O_RDONLY #define O_RDONLY 0 #endif /* Break string in two parts to avoid buggy C compilers that ignore characters after nulls in strings. */ char string1[] = "Testing distribution of nonprinting chars:\n\ Should be 0177: \177 Should be 0377: \377 Should be 0212: \212.\n\ Should be 0000: "; char string2[] = ".\n\ This file is read by the `test-distribution' program.\n\ If you change it, you will make that program fail.\n"; char buf[300]; /* Like `read' but keeps trying until it gets SIZE bytes or reaches eof. */ int cool_read (fd, buf, size) int fd; char *buf; int size; { int num, sofar = 0; while (1) { if ((num = read (fd, buf + sofar, size - sofar)) == 0) return sofar; else if (num < 0) return num; sofar += num; } } int main (argc, argv) int argc; char **argv; { int fd; if (argc != 2) { fprintf (stderr, "Usage: %s testfile\n", argv[0]); exit (2); } fd = open (argv[1], O_RDONLY); if (fd < 0) { perror (argv[1]); exit (2); } if (cool_read (fd, buf, sizeof string1) != sizeof string1 || strcmp (buf, string1) || cool_read (fd, buf, sizeof string2) != sizeof string2 - 1 || strncmp (buf, string2, sizeof string2 - 1)) { fprintf (stderr, "Data in file `%s' has been damaged.\n\ Most likely this means that many nonprinting characters\n\ have been corrupted in the files of Emacs, and it will not work.\n", argv[1]); exit (2); } close (fd); #ifdef VMS exit (1); /* On VMS, success is 1. */ #endif return (0); } emacs-19.30/lib-src/timer.c100444 21570 13 20143 5647043242 13465 0ustar djmuser/* timer.c --- daemon to provide a tagged interval timer service This little daemon runs forever waiting for commands to schedule events. SIGALRM causes it to check its queue for events attached to the current second; if one is found, its label is written to stdout. SIGTERM causes it to terminate, printing a list of pending events. This program is intended to be used with the lisp package called timer.el. The first such program was written anonymously in 1990. This version was documented and rewritten for portability by esr@snark.thyrsus.com, Aug 7 1992. */ #include #include #include #include /* time_t */ #include <../src/config.h> #undef read #ifdef LINUX /* Perhaps this is correct unconditionally. */ #undef signal #endif #ifdef _CX_UX /* I agree with the comment above, this probably should be unconditional (it * is already unconditional in a couple of other files in this directory), * but in the spirit of minimizing the effects of my port, I am making it * conditional on _CX_UX. */ #undef signal #endif extern int errno; extern char *strerror (); extern time_t time (); /* * The field separator for input. This character shouldn't occur in dates, * and should be printable so event strings are readable by people. */ #define FS '@' struct event { char *token; time_t reply_at; }; int events_size; /* How many slots have we allocated? */ int num_events; /* How many are actually scheduled? */ struct event *events; /* events[0 .. num_events-1] are the valid events. */ char *pname; /* program name for error messages */ /* This buffer is used for reading commands. We make it longer when necessary, but we never free it. */ char *buf; /* This is the allocated size of buf. */ int buf_size; /* Non-zero means don't handle an alarm now; instead, just set alarm_deferred if an alarm happens. We set this around parts of the program that call malloc and free. */ int defer_alarms; /* Non-zero if an alarm came in during the reading of a command. */ int alarm_deferred; /* Schedule one event, and arrange an alarm for it. STR is a string of two fields separated by FS. First field is string for get_date, saying when to wake-up. Second field is a token to identify the request. */ void schedule (str) char *str; { extern time_t get_date (); extern char *strcpy (); time_t now; register char *p; static struct event *ep; /* check entry format */ for (p = str; *p && *p != FS; p++) continue; if (!*p) { fprintf (stderr, "%s: bad input format: %s\n", pname, str); return; } *p++ = 0; /* allocate an event slot */ ep = events + num_events; /* If the event array is full, stretch it. After stretching, we know that ep will be pointing to an available event spot. */ if (ep == events + events_size) { int old_size = events_size; events_size *= 2; events = ((struct event *) realloc (events, events_size * sizeof (struct event))); if (! events) { fprintf (stderr, "%s: virtual memory exhausted.\n", pname); /* Since there is so much virtual memory, and running out almost surely means something is very very wrong, it is best to exit rather than continue. */ exit (1); } while (old_size < events_size) events[old_size++].token = NULL; } /* Don't allow users to schedule events in past time. */ ep->reply_at = get_date (str, NULL); if (ep->reply_at - time (&now) < 0) { fprintf (stderr, "%s: bad time spec: %s%c%s\n", pname, str, FS, p); return; } /* save the event description */ ep->token = (char *) malloc ((unsigned) strlen (p) + 1); if (! ep->token) { fprintf (stderr, "%s: malloc %s: %s%c%s\n", pname, strerror (errno), str, FS, p); return; } strcpy (ep->token, p); num_events++; } /* Print the notification for the alarmed event just arrived if any, and schedule an alarm for the next event if any. */ void notify () { time_t now, tdiff, waitfor = -1; register struct event *ep; /* Inhibit interference with alarms while changing global vars. */ defer_alarms = 1; alarm_deferred = 0; now = time ((time_t *) NULL); for (ep = events; ep < events + num_events; ep++) /* Are any events ready to fire? */ if (ep->reply_at <= now) { fputs (ep->token, stdout); putc ('\n', stdout); fflush (stdout); free (ep->token); /* We now have a hole in the event array; fill it with the last event. */ ep->token = events[num_events - 1].token; ep->reply_at = events[num_events - 1].reply_at; num_events--; /* We ought to scan this event again. */ ep--; } else { /* next timeout should be the soonest of any remaining */ if ((tdiff = ep->reply_at - now) < waitfor || waitfor < 0) waitfor = (long)tdiff; } /* If there are no more events, we needn't bother setting an alarm. */ if (num_events > 0) alarm (waitfor); /* Now check if there was another alarm while we were handling an explicit request. */ defer_alarms = 0; if (alarm_deferred) notify (); alarm_deferred = 0; } /* Read one command from command from standard input and schedule the event for it. */ void getevent () { int i; /* In principle the itimer should be disabled on entry to this function, but it really doesn't make any important difference if it isn't. */ if (buf == 0) { buf_size = 80; buf = (char *) malloc (buf_size); } /* Read a line from standard input, expanding buf if it is too short to hold the line. */ for (i = 0; ; i++) { char c; int nread; if (i >= buf_size) { buf_size *= 2; alarm_deferred = 0; defer_alarms = 1; buf = (char *) realloc (buf, buf_size); defer_alarms = 0; if (alarm_deferred) notify (); alarm_deferred = 0; } /* Read one character into c. */ while (1) { nread = read (fileno (stdin), &c, 1); /* Retry after transient error. */ if (nread < 0 && (1 #ifdef EINTR || errno == EINTR #endif #ifdef EAGAIN || errno == EAGAIN #endif )) continue; /* Report serious errors. */ if (nread < 0) { perror ("read"); exit (1); } /* On eof, exit. */ if (nread == 0) exit (0); break; } if (c == '\n') { buf[i] = '\0'; break; } buf[i] = c; } /* Register the event. */ alarm_deferred = 0; defer_alarms = 1; schedule (buf); defer_alarms = 0; notify (); alarm_deferred = 0; } /* Handle incoming signal SIG. */ SIGTYPE sigcatch (sig) int sig; { struct event *ep; /* required on older UNIXes; harmless on newer ones */ signal (sig, sigcatch); switch (sig) { case SIGALRM: if (defer_alarms) alarm_deferred = 1; else notify (); break; case SIGTERM: fprintf (stderr, "Events still queued:\n"); for (ep = events; ep < events + num_events; ep++) fprintf (stderr, "%d = %ld @ %s\n", ep - events, ep->reply_at, ep->token); exit (0); break; } } /*ARGSUSED*/ int main (argc, argv) int argc; char **argv; { for (pname = argv[0] + strlen (argv[0]); *pname != '/' && pname != argv[0]; pname--); if (*pname == '/') pname++; events_size = 16; events = ((struct event *) malloc (events_size * sizeof (*events))); num_events = 0; signal (SIGALRM, sigcatch); signal (SIGTERM, sigcatch); /* Loop reading commands from standard input and scheduling alarms accordingly. The alarms are handled asynchronously, while we wait for commands. */ while (1) getevent (); } #ifndef HAVE_STRERROR char * strerror (errnum) int errnum; { extern char *sys_errlist[]; extern int sys_nerr; if (errnum >= 0 && errnum < sys_nerr) return sys_errlist[errnum]; return (char *) "Unknown error"; } #endif /* ! HAVE_STRERROR */ long * xmalloc (size) int size; { register long *val; val = (long *) malloc (size); if (!val && size) { fprintf (stderr, "timer: virtual memory exceeded\n"); exit (1); } return val; } /* timer.c ends here */ emacs-19.30/lib-src/wakeup.c100444 21570 13 1515 5647043245 13626 0ustar djmuser/* Program to produce output at regular intervals. */ #include #include #include #ifdef TIME_WITH_SYS_TIME #include #include #else #ifdef HAVE_SYS_TIME_H #include #else #include #endif #endif struct tm *localtime (); void main (argc, argv) int argc; char **argv; { int period = 60; time_t when; struct tm *tp; if (argc > 1) period = atoi (argv[1]); while (1) { /* Make sure wakeup stops when Emacs goes away. */ if (getppid () == 1) exit (0); printf ("Wake up!\n"); fflush (stdout); /* If using a period of 60, produce the output when the minute changes. */ if (period == 60) { time (&when); tp = localtime (&when); sleep (60 - tp->tm_sec); } else sleep (period); } } emacs-19.30/lib-src/yow.c100444 12120 13 6472 5737451574 13205 0ustar rmsuser/* * yow.c * * Print a quotation from Zippy the Pinhead. * Qux March 6, 1986 * * This file is in the public domain because the author published it * with no copyright notice before the US signed the Bern Convention. * * With dynamic memory allocation. */ #include #include #include <../src/paths.h> /* For PATH_DATA. */ #define BUFSIZE 80 #define SEP '\0' #ifndef YOW_FILE #define YOW_FILE "yow.lines" #endif #ifdef MSDOS #define rootrelativepath(rel) \ ({\ static char res[BUFSIZE], *p;\ strcpy (res, argv[0]);\ p = res + strlen (res);\ while (p != res && *p != '/' && *p != '\\' && *p != ':') p--;\ strcpy (p + 1, "../");\ strcpy (p + 4, rel);\ &res;}) #endif char *malloc(), *realloc(); void yow(); void setup_yow(); int main (argc, argv) int argc; char *argv[]; { FILE *fp; char file[BUFSIZ]; if (argc > 2 && !strcmp (argv[1], "-f")) strcpy (file, argv[2]); else #ifdef vms sprintf (file, "%s%s", PATH_DATA, YOW_FILE); #else sprintf (file, "%s/%s", PATH_DATA, YOW_FILE); #endif if ((fp = fopen(file, "r")) == NULL) { fprintf(stderr, "yow: "); perror(file); exit(1); } /* initialize random seed */ srand((int) (getpid() + time((long *) 0))); setup_yow(fp); yow(fp); fclose(fp); return 0; } static long len = -1; static long header_len; #define AVG_LEN 40 /* average length of a quotation */ /* Sets len and header_len */ void setup_yow(fp) FILE *fp; { int c; /* Get length of file */ /* Because the header (stuff before the first SEP) can be very long, * thus biasing our search in favor of the first quotation in the file, * we explicitly skip that. */ while ((c = getc(fp)) != SEP) { if (c == EOF) { fprintf(stderr, "yow: file contains no separators\n"); exit(2); } } header_len = ftell(fp); if (header_len > AVG_LEN) header_len -= AVG_LEN; /* allow the first quotation to appear */ if (fseek(fp, 0L, 2) == -1) { perror("yow"); exit(1); } len = ftell(fp) - header_len; } /* go to a random place in the file and print the quotation there */ void yow (fp) FILE *fp; { long offset; int c, i = 0; char *buf; unsigned int bufsize; offset = rand() % len + header_len; if (fseek(fp, offset, 0) == -1) { perror("yow"); exit(1); } /* Read until SEP, read next line, print it. (Note that we will never print anything before the first separator.) If we hit EOF looking for the first SEP, just recurse. */ while ((c = getc(fp)) != SEP) if (c == EOF) { yow(fp); return; } /* Skip leading whitespace, then read in a quotation. If we hit EOF before we find a non-whitespace char, recurse. */ while (isspace(c = getc(fp))) ; if (c == EOF) { yow(fp); return; } bufsize = BUFSIZE; buf = malloc(bufsize); if (buf == (char *)0) { fprintf(stderr, "yow: virtual memory exhausted\n"); exit (3); } buf[i++] = c; while ((c = getc(fp)) != SEP && c != EOF) { buf[i++] = c; if (i == bufsize-1) { /* Yow! Is this quotation too long yet? */ bufsize *= 2; buf = realloc(buf, bufsize); if (buf == (char *)0) { fprintf(stderr, "yow: virtual memory exhausted\n"); exit (3); } } } buf[i++] = 0; printf("%s\n", buf); } emacs-19.30/lib-src/ChangeLog100666 12120 13 271770 6055517267 14044 0ustar rmsuserFri Nov 24 23:42:28 1995 Richard Stallman * Version 19.30 released. Wed Nov 22 14:01:11 1995 Geoff Voelker * makefile.nt (DOC, clean): Don't use switches to del not supported by Win95. Mon Nov 13 21:59:08 1995 Richard Stallman * Makefile.in (regex.o): Depend on ../src/config.h. Sun Nov 12 01:31:57 1995 Richard Stallman * Makefile.in (LIB_STANDARD): Extract this as in src/Makefile.in. (LOADLIBES): Use LIB_STANDARD. Tue Nov 7 02:43:26 1995 Kevin Gallo * makefile.nt (DOC): Include strings from w32term.c, w32xfns.c, w32fns.c, w32faces.c, w32select.c, w32menu.c, w32reg.c; remove Win95 conditional. Mon Nov 6 13:03:32 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (get_lang_from_name, get_lang_from_interpreter, get_lang_from_suffix): New functions. (get_language): Function deleted. (lang_entry): Two members added to struct. (lang_names): Reflect the new layout of lang_entry. (print_language_names, main, find_entries): Use the new functions. (find_entries): Look at the first line for #! if no language. (C_entries): Invalidate the token when funcdef is reset. (Perl_functions): New function. (lang_suffixes): .pl and .pm are Perl suffixes. Thu Nov 2 14:31:54 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (lowcase): Use the standard tolower function. (substitute): Remove some wrong and some useless code related with escape `\` character in regexp replacement string. (TEX_defenv): Added part, appendix, entry, index. Removed typeout. (lang_suffixes): New suffixes: .hpp for C++; .f90 for Fortran; .bib, .ltx, .TeX for TeX (.bbl, .dtx removed); .ml for Lisp; .prolog for prolog (.pl removed). (massage_name, etags_getcwd): Use lowcase instead of tolower. (C_entries, find_entries): Added comments about memory leakage. (add_node): Dead code removed. Sun Oct 29 15:36:30 1995 Richard Stallman * Makefile.in (getdate.o, movemail.o): Specify -Demacs. (ALL_CFLAGS, LINK_CFLAGS, CPP_CFLAGS): Delete -Demacs. Wed Aug 30 22:36:40 1995 Richard Stallman * test-distrib.c: Add #undef for open, close, read, write. Wed Aug 23 13:42:24 1995 Roland McGrath * test-distrib.c [HAVE_CONFIG_H]: Include config.h. [! O_RDONLY]: Define it to zero. (main): Use O_RDONLY instead of explicit zero. Thu Aug 17 13:43:17 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (Pascal_functions): Close comment bug corrected. (add_node): Correctly compare node file names. (Pascal_functions): Correctly allocate and free memory for tline. (pfnote): Put the definition of fp in the innermost block. (NODE): `named' member removed. (pfnote, free_tree, put_entries, total_size_of_entries): Do not use the `named' member, check whether `name' is NULL instead. (pfnote): `named' argument removed, all callers changed. (getit, Asm_labels, Pascal_functions, L_getit, get_scheme, TeX_functions, TEX_getit, prolog_getit): Useless string allocation removed from pfnote call, some code cleanup. (relative_filename): Free temporary space allocated by concat. Wed Aug 16 10:16:04 1995 Richard Stallman * Makefile.in (getdate.c): New target. (getdate.o): Just compile getdate.c. Sat Aug 12 14:14:49 1995 Karl Heuer * fakemail.c (xrealloc): Change cast to match return type. Thu Aug 10 21:43:32 1995 Richard Stallman * fakemail.c (xmalloc, xrealloc): Use return-type long *. Sun Aug 6 19:56:48 1995 Richard Stallman * movemail.c (main): Fix previous change. Add error check for empty OUTNAME. Sat Aug 5 16:19:04 1995 Richard Stallman * movemail.c (main): Mention lock file name in error message. Sun Jul 30 03:07:26 1995 Richard Stallman * profile.c (gettimeofday): New function, defined if necessary. Tue Jul 18 02:04:21 1995 Richard Stallman * Makefile.in: Renamed from Makefile.in.in. (distclean): Delete Makefile.c, not Makefile.in. Mon Jul 17 17:55:18 1995 Michael Shields * Makefile.in.in (tags): Synonym for `TAGS'. Sun Jul 16 14:15:20 1995 Karl Heuer * Makefile.in.in (install, maybe-blessmail): Don't cd ..; configure has already set $(INSTALL) to the proper relative path. Tue Jun 27 16:01:40 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (plain_C_entries): new function. (lowcase): new macro. (tail, Fortran_functions, Pascal_functions): use new macro lowcase. (lang_suffixes): new suffix ".pc" for Pro*C files. (consider_token): don't tag all tokens beginning with DEFUN & Co.. (tail): look for the end of the token when comparing. (takeprec): since now tail behaves differently, use strneq. Sat Jul 8 18:44:04 1995 Paul Eggert * rcs2log (datearg): Separate date from time with comma, not space, to work around CVS 1.5 bug. (CVSROOT): Don't abort when unset if repository is absolute. Fri Jul 7 22:47:57 1995 Paul Eggert * rcs-checkin, rcs2log, vcdiff: Replace `#!/bin/sh' with `#! /bin/sh', for benefit of systems that interpret `#! /' as a 4-byte magic number. Thu Jun 29 21:12:05 1995 Jonathan I. Kamens * movemail.c (main) [MAIL_USE_POP]: When a user specifies a mailbox with "po:mailbox", the mailbox is everything after the "po:" prefix. Wed Jun 28 05:54:43 1995 Richard Stallman * emacsserver.c: Make all error messages start with `Error: '. (fatal_error, perror_1): New functions, use throughout. Wed Jun 28 01:47:55 1995 Paul Eggert * rcs2log (CVSROOT, repository): Allow remote repositories a la CVS 1.4. Tue Jun 27 16:01:40 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (plain_C_entries): new function. (lowcase): new macro. (tail, Fortran_functions, Pascal_functions): use new macro lowcase. (lang_suffixes): new suffix ".pc" for Pro*C files. (consider_token): don't tag all tokens beginning with DEFUN & Co.. (tail): look for the end of the token when comparing. (takeprec): since now tail behaves differently, use strneq. Mon Jun 26 16:28:23 1995 Richard Stallman * movemail.c (main): Add newline in usage message. Wed Jun 21 15:46:26 1995 Richard Stallman * make-docfile.c (scan_file): Make sure it never looks at filename[-1]. Wed Jun 21 13:43:16 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (find_entries): Rewind before rereading the input file. Tue Jun 20 10:35:36 1995 Richard Stallman * Version 19.29 released. * make-docfile.c (main) [MSDOS]: Do set _fmode. This undoes part of the previous change. Mon Jun 19 22:51:18 1995 Richard Stallman * make-docfile.c (main): On MSDOS, don't change stdout to binary, and insist on an -o option. Tue Jun 13 22:19:17 1995 Geoff Voelker * etags.c (process_file,absolute_filename): Handle filenames starting with a drive letter. * makefile.nt (install): Copy wakeup.exe properly. Thu Jun 8 16:13:02 1995 Karl Heuer * make-docfile.c [MSDOS]: #undef chdir. Sun Jun 4 01:34:39 1995 Paul Eggert * rcs2log (output_authors): Allow ':' in time zone, as per ISO 8601 and RCS 5.6.8 beta. Mon May 29 14:29:06 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (etags_getcwd): Undo the /bin/pwd change. It may raise compatibility problems. Fri May 26 20:25:47 1995 Richard Stallman * etags.c (etags_getcwd): Don't use #elif. Have just one function body. Thu May 25 17:40:20 1995 Geoff Voelker * makefile.nt (LIBS): Use BASE_LIBS. (make-docfile.exe,hexl.exe,wakeup.exe,etags.exe): Don't depend upon LIBS. (DOC): Use del instead of rm. (DOC) [WINDOWS95]: Use DOC. (clean): Handle MSVC aux files. (config.h,paths.h): Use $(CP) instead of cp. (config.h): Use $(CONFIG_H) (make-docfile.obj): Depend upon config.h. Clean up comments. Tue May 23 15:24:55 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (etags_getcwd): Use /bin/pwd instead of pwd because the former gives the true path even in the presence of simlinks. Sun May 7 18:35:11 1995 Richard Stallman * movemail.c (main): Increase lock timeout to five minutes. Sat May 06 23:11:08 1995 Geoff Voelker * makefile.nt (obj): Use .c files. Thu May 4 02:42:22 1995 Richard Stallman * make-docfile.c: Include config.h. (NO_SHORTNAMES): New definition. (xmalloc): Return long *. * etags.c (C_entries): Cast result of xrealloc. (xmalloc, xrealloc): Declare them to return long *. * b2m.c (xmalloc, xrealloc): Declare them long *. * movemail.c (xmalloc): Declare it to return long *. Sun Apr 30 15:34:52 1995 Paul Eggert * rcs2log (datearg): If rlog options are specified explicitly, omit the implicit '-d>DATE' option. (repository, rlog): Allow absolute paths to CVS repositories. Look only at the first line of CVS/Repository. Wed Apr 26 16:59:55 1995 Karl Heuer * Makefile.in.in (extraclean): Depend on maintainer-clean, not realclean. Mon Apr 24 22:29:25 1995 Richard Stallman * Makefile.in.in [REGEXP_IN_LIBC] (REGEXPOBJ, REGEXPDEPS): Alternative (empty) definitions. Tue Apr 18 16:49:55 1995 Richard Stallman * emacsclient.c (main): Add argv[0] to an error message. Thu Apr 13 13:04:24 1995 Karl Heuer * emacsclient.c (main): Improve error handling. * cvtmail.c (main, skip_to_lf): Improve error handling. (sysfail): New function. * b2m.c (main): Check for trailing ", " before trying to delete it. Wed Apr 12 19:17:21 1995 Andreas Schwab * Makefile.in.in (all): Build test-distrib and make-docfile. * make-docfile.c (scan_c_file): At end, restore file name last char to its original value. Mon Apr 10 21:44:16 1995 Richard Stallman * emacsclient.c, emacsserver.c: Test NO_SOCKETS_IN_FILE_SYSTEM. Sat Apr 8 13:50:47 1995 Richard Stallman * Makefile.in.in (BASE_CFLAGS): Renamed from ALLOCA_CFLAGS. (alloca.o, regex.o): Use BASE_CFLAGS. Thu Apr 6 21:01:01 1995 Richard Stallman * emacsclient.c [Berkeley sockets version] (main): Declare getcwd. Tue Apr 4 17:09:28 1995 Karl Heuer * Makefile.in.in (aixcc, aixcc.c): Targets deleted. (SOURCES, distclean): Removed obsolete references to aixcc. Sun Apr 2 04:34:30 1995 Richard Stallman * aixcc.lex: File deleted--surely obsolete now. Thu Mar 23 01:21:07 1995 Paul Eggert * rcs2log (output_authors): Replace /[/]/ by /[\/]/, for portability to mawk and nawk. Tue Mar 21 23:14:41 1995 Paul Eggert * rcs2log: Treat -u "login:fullname:mailaddr" as if it were -u "loginfullnamemailaddr". Tue Mar 21 05:37:42 1995 Paul Eggert * rcs2log: Add -u "loginfullnamemailaddr" option, which replaces the (now obsolescent) -n login fullname mailaddr option. Add -R option for recursive rlog. (AWK): New environment variable (default `awk') for awk program name. (output_authors, tab, loginFullnameMailaddrs, recursive): New vars. Quote authors and fullnames correctly. Don't omit path from repository root when logging CVS files. Wed Mar 15 18:26:29 1995 Richard Stallman * emacsclient.c, emacsserver.c: Use BSD sockets whenever available, even if HAVE_SYSVIPC. * emacsclient.c (main): Use getcwd if not BSD. Mon Mar 13 11:15:53 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (process_file): free (filename) after using it. (readline_internal): Do not access the char before start of line. Wed Feb 22 15:47:42 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (C_entries): token_saved removed. Initialise tok.valid and savetok.valid. Mark token as valid when it is initialised. (make_tag): Make token only if token is valid and reset validity. (CNL_SAVE_DEFINEDEF): Test for savetok.valid instead of token_saved. (TOKEN): Added a new member: valid. Wed Feb 15 15:37:12 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (C_entries): Bug corrected in xrealloc of token_str. (main): Do not read twice the last filename in the stdin file list. Tue Feb 14 18:11:48 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (C_entries): Initialise the new members of TOKEN. (C_entries): Do not allocate a new space for each token found by consider_token. Let make_tag do that instead. (make_tag): Since now TOKEN has memory of where it is taken from, this new macro substitutes both make_tag_from_new_lb and make_tag_from_oth_lb. All callers changed. (TOKEN): Add linepos and buffer members. (main): Initialise token_str. (lang_extensions): Recognise .c++ and .h++ as C++ file suffixes. (token_str): New global variable used by C_entries. Tue Feb 7 18:50:09 1995 Richard Stallman * Makefile.in.in (maintainer-clean): Renamed from realclean. Wed Feb 1 11:58:45 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (pfnote): Initialise been_warned in the node. (C_entries): Removed a speed hack for the sake of clarity. Wed Jan 18 11:07:24 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (longopts, print_help, main): Use -I as abbreviation for the --ignore-indentation option. (main): Do not print an error message for unknown options. Thu Jan 12 17:30:24 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (FILEPOS, GET_CHARNO, GET_FILEPOS, max, LINENO): Deleted. (append_to_tagfile, typedefs, typedefs_and_cplusplus, constantypedefs, update, vgrind_style, no_warnings, cxref_style, cplusplus, noindentypedefs): Were int, now logical. (permit_duplicates): Was a var, now a #define. (filename_lb): Was global, now local to main. (main): Open the tag file when in cxref mode. Use a BUFSIZ size buffer for making the shell commands. Look at the return value from the system routine. Exit when cannot open the tag file. (process_file): Open the file and pass the FILE* to find_entries. (find_entries): Now void, because does not open the file itself. (pfnote): Recovering from lack of memory does not work. Removed. Use savenstr and simplify the code. (free_tree): Only free the name space if node is named. (structtag): Now a pointer, not a fixed length array of chars. (consider_token): Don't take a token as argument. Use savenstr when saving a tag in structtag. Callers changed. (TOKEN): Structure changed. Now used only in C_entries. (TOKEN_SAVED_P, SAVE_TOKEN, RESTORE_TOKEN): Deleted. (C_entries): nameb and savenameb deleted. Use dinamic allocation. (pfcnt): Deleted. Users updated. (getit, Asm_labels, Pascal_functions, L_getit, get_scheme, TEX_getit, prolog_getit): Use dinamic allocation for storing the tag instead of a fixed size buffer. Tue Jan 10 22:36:07 1995 Richard Stallman * movemail.c (main): Skip past the colon in inname. Tue Jan 10 09:46:14 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (pfatal): New function. (main, etags_getcwd): Use pfatal. (etags_getcwd): Corrected another bug in the HAVE_GETCWD version. Tue Jan 10 09:46:14 1995 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (Lang_function): Use void instead to declare the language functions, because many compilers are buggy. (etags_getcwd): Fix the previous fix on the #else branch. (readline_internal): Discard possible \r before \n here. (C_entries): Do not deal with \r here: undo previous fix. Mon Jan 9 16:06:46 1995 Francesco Potorti` (pot at fly) * b2m.c (concat, xmalloc, xrealloc, readline, xnew): Four new functions and a macro that allow the program to work on input lines of whatever length. Copied from etags.c. (fatal): Print a fatal error message and exit. (main): Use the new functions. Fixed a bug that made a \037 char appear at the end of the output. Fri Jan 6 17:29:55 1995 Richard Stallman * etags.c (C_entries): Ignore carriage return at end of line. Mon Dec 26 18:33:35 1994 Richard Stallman * fakemail.c (xmalloc, xrealloc): Add casts. (add_field): Handle <...> and "..." syntax. (setup_files, get_keyword): Clean up parens and line breaks. (args_size): Likewise. Wed Dec 21 10:58:32 1994 David J. MacKenzie * yow.c: Include program name in error messages. Wed Dec 21 10:13:52 1994 Richard Stallman * make-docfile.c (scan_lisp_file): Handle dynamic doc strings. (xmalloc, fatal, error): New functions. (progname): New variable. (main): Set progname. Mon Dec 5 22:47:39 1994 Richard Stallman * emacsclient.c, emacsserver.c [HAVE_SYSVIPC]: Include sys/utsname.h. (main): If socket/mqueue name is in home dir, add in the host name. Rename .emacs_server to .emacs-server.... Sun Dec 4 18:10:49 1994 Richard Stallman * emacsclient.c [!HAVE_SYSVIPC] (main): Fix error message diction. Tue Nov 22 19:13:10 1994 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (print_help): print --regex usage for ctags also. (main): use -h in addition to -H as abbreviation for --help. Wed Nov 16 11:11:19 1994 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c [ETAGS_REGEXP]: All the new code that deals with regexps is compiled if this is defined. The new functions and variables added #ifdef ETAGS_REGEXP are not listed in this ChangeLog. [VMS]: All VMS specific code previously contained in etags-vmslib.c is now included here, modified for dealing with language and regex options intermixed with filenames. (header_file): Global variable deleted. (Lang_Function): New typedef. All language parser functions changed to this new type. (string_numeric_p, substr, prestr): Functions deleted. (readline_internal): Does the job that readline did previously. (longopts): --language and --regex options added. (lang_names, lang_extensions, lang_func, print_language_names): New structures, variables and functions for choosing languages. (print_help): Help strings updated. Calls print_language_names. (argument_type, ARGUMENT): Typedefs for dealing with language and regex options intermixed with filenames. (main): Changed the way of dealing with arguments on the command line to deal with language and regex options intermixed with filenames. (get_language, default_C_entries, Cplusplus_entries, Cstar_entries, Yacc_entries, just_read_file): New functions. (find_entries): Use the new method for choosing the language. (Pascal_functions): Allow intermixing of comment styles. (prolog_getit, skip_comment): Rewritten for speed. (readline): Rewritten to deal with regexps. Wed Nov 16 11:11:19 1994 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (): #include added. (etags_getcwd): Check return value from getcwd. Thu Nov 10 17:26:21 1994 Richard Stallman * profile.c (TV1, TV2): Use EMACS_TIME as type. (get_time): Use EMACS_SUB_TIME. Sun Oct 30 13:47:05 1994 voelker * ntlib.c: New file. * makefile.nt: New file. * make-docfile.c (main) [WINDOWSNT]: Set _fmode and stdout to O_BINARY. [WINDOWSNT]: Include the NT headers. (READ_TEXT, READ_BINARY): Test DOS_NT, not MSDOS. * etags.c (main, etags_getcwd): Test DOS_NT instead of MSDOS. [WINDOWSNT]: Include some NT headers. Mon Oct 24 03:55:28 1994 Jonathan I. Kamens (jik@cam.ov.com) * pop.c (getline): When a search of already-read input for CRLF fails, store the fact that we've searched it and don't search it again after reading more data. * pop.c (getline): When determining whether or not it's necessary to grow the input buffer, take into account the null that's stored at the end of already-read input in the buffer. Fri Oct 21 13:11:12 1994 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (prestr, substr): return a logical type. (consider_token): Comment out "EXFUN". Use "DEFUN" instead of "DEF". (consider_token): set funcdef to fignore when a DEFUN is met. (C_entries): Now we can use Tom Hageman patch for extern "C". Thu Oct 20 16:35:10 1994 Richard Stallman * movemail.c: PopServer renamed to popserver throughout. Thu Oct 20 12:36:57 1994 David J. MacKenzie * etags.c: Don't declare malloc, since we include config.h. * fakemail.c: Likewise. Wed Oct 19 18:49:25 1994 Richard Stallman * movemail.c: Don't declare malloc. Wed Oct 19 17:28:01 1994 David J. MacKenzie * rcs-checkin: Use test -r instead of < to check readability, to avoid syntax error. Wed Oct 19 02:17:55 1994 Jonathan I. Kamens (jik@cam.ov.com) * pop.c: Only include ../src/config.h if HAVE_CONFIG_H is defined, and if HAVE_CONFIG_H isn't defined, define MAIL_USE_POP always (so that this file can be included in other programs besides emacs). * pop.c: Only declare h_errno if HAVE_H_ERRNO isn't defined or HAVE_CONFIG_H isn't defined. * pop.c (find_crlf, getline): Instead of using strstr, use a custom function for finding CRLF. (my_strstr): Function deleted. Mon Oct 17 18:27:11 1994 Jonathan I. Kamens (jik@cam.ov.com) * pop.c (getline): Fix a segfault because of passing a non-null-terminated string into strstr(). Fix from djm@va.pubnix.com (David J. MacKenzie). * pop.c: Don't include and . * pop.c: Include before , rather than after. They should be interchangeable, and indeed the inclusion is done in both orders in various files in the Kerberos 4 library sources, but djm@va.pubnix.com (David J. MacKenzie) reports that BSDI requires that be included first, and I don't see any harm in changing the order. * pop.c: Include ../src/config.h, to get HAVE_STRING_H and STDC_HEADERS, if they're defined. Undef open, read, write and close after including it. Tue Oct 18 03:28:18 1994 Richard Stallman * pop.c: Fix mismatch in conditionals. * make-docfile.c (main): Don't process one input file twice. Never use exit code > 1. * pop.c (open, close, read, write): Add #undefs. * pop.c: Don't declare malloc, realloc, free. Include ../src/config.h. Don't include string.h or strings.h. Include des.h before krb.h. Do declare my_strstr. (getline): Really use my_strstr. Leave one empty place in server->buffer, and put a null at the end of the data in it. Mon Oct 17 22:10:53 1994 Andreas Schwab * emacsserver.c [SYSV_IPC] (main): Catch SIGHUP as well. Don't call kill with pid 0. Handle EINTR when receiving messages. Mon Oct 17 16:54:17 1994 Karl Heuer * Makefile.in.in (regex.o): Use full path to find regex.c. Mon Oct 17 16:25:45 1994 Francesco Potorti` (pot@fly.cnuce.cnr.it) * Makefile.in.in (etags): add dependency on regex.o, link with it. (REGEXPOBJ, REGEXPDEPS, regex.o): target and macros added. Wed Oct 12 15:21:05 1994 David J. MacKenzie (djm@duality.gnu.ai.mit.edu) * Makefile.in.in (DONT_INSTALL): Remove make-path. (${archlibdir}): Use mkinstalldirs instead. * movemail.c: Make functions that return nothing void, not implicitly int. (main): Improve usage message. (error): Write to stderr, not stdout. * b2m.c cvtmail.c digest-doc.c emacsclient.c emacsserver.c etags.c fakemail.c hexl.c make-docfile.c profile.c sorted-doc.c test-distrib.c timer.c wakeup.c yow.c: Eliminate some -Wall warnings from unused variables and implicitly declared functions. Tue Oct 11 17:21:59 1994 Richard Stallman * Makefile.in.in (clean): rm DOC* and *.tab.[ch]. (distclean): Not here. * Makefile.in.in (libexecdir): Renamed from libdir. Tue Oct 11 13:14:02 1994 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (C_entries): Name the #define's that are macros. Mon Oct 10 00:56:04 1994 Roland McGrath * emacsserver.c [! SYSVIPC] (main): Fix uses of FD_* macros: fd_set arg is a pointer, descriptor arg comes first. Thu Sep 29 18:17:44 1994 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (C_entries): Recognise typedef of ANSI style functions. (C_entries): Recognise #define inside a struct. (C_entries): ANSI tells that preprocessor commands do not have to start on the first column. (print_help): Documentation corrected for -d and -D. (white, endtk): ANSI tells the vertical tab is a separator. Sat Sep 24 00:10:08 1994 Jonathan I. Kamens (jik@gza-client1.aktis.com) * Makefile.in.in (MOVE_FLAGS, MOVE_LIBS): New variables. (pop.o, movemail.o): New targets. (movemail): Link in pop.o and movemail.o. Use MOVE_LIBS, MOVE_FLAGS. * pop.c, pop.h: New files. * movemail.c: Improve POP code, move most of it into a separate file. (mbx_delimit_end, mbx_delimit_begin): Check for errors. (mbx_write): Check for errors and for From line. (pop_retr, popmail): Use subroutines in pop.c to do the real work. (get_errmsg, multiline, getline, putline, pop_stat, pop_command) (pop_init): Functions deleted. Fri Sep 23 21:45:18 1994 Richard Stallman * make-path.c (touchy_mkdir): Make dir ugo+rx even if it isn't new. Rename path to dirname. Fri Sep 23 01:41:43 1994 Richard Stallman * Makefile.in.in (UTILITIES): Remove test-distrib, make-docfile, make-path. (DONT_INSTALL): New variable--list those files here. (clean): Delete the files in DONT_INSTALL. Tue Sep 20 23:21:29 1994 Richard Stallman * b2m.c (from, labels, data): Use MAX_DATA_LEN as length. (main): Use fgets, not gets. Sat Sep 17 01:50:04 1994 Richard Stallman * timer.c: Don't declare malloc. Fri Sep 16 20:00:38 1994 Karl Heuer * emacsserver.c (FD_*) [HAVE_SOCKETS & !HAVE_SYSVIPC]: If not already defined, use simple 32-bit versions of these macros. (main) [HAVE_SOCKETS & !HAVE_SYSVIPC]: Use these macros. Fri Sep 16 17:15:13 1994 Andreas Schwab * etags.c (etags_getcwd): Use getcwd if available. Sun Sep 11 14:56:01 1994 Richard Stallman * Version 19.27 released. Wed Sep 7 03:53:50 1994 Richard Stallman * Version 19.26 released. Mon Aug 15 15:49:19 1994 Paul Eggert * rcs2log: Add support for CVS. Work with `rlog's that output ISO 8601 dates. Tue Aug 9 15:21:01 1994 Lawrence R. Dodd * rcs2log: Use <> to delimit email address. Sat Aug 6 18:12:14 1994 Richard Stallman * emacsserver.c [SYSV_IPC] (main): Make a separate process so we can listen for multiple requests. Thu Aug 4 19:15:25 1994 Richard Stallman * movemail.c: Include config.h first thing. Mon Aug 1 03:43:20 1994 Richard Stallman * emacsserver.c (main): Add casts to avoid warnings. Fri Jul 29 16:32:15 1994 Richard Stallman * Makefile.in.in (${archlibdir}): Compare the proper dir before installing the scripts. Wed Jul 27 13:58:25 1994 Richard Stallman * emacsclient.c (main): New local var progname saves argv[0]. Tue Jul 26 11:34:15 1994 Richard Stallman * emacsclient.c (main): Don't actually modify argv[0]. Modify a copy instead. Mon Jul 25 19:21:02 1994 Richard Stallman * profile.c (reset_watch, get_time): Use EMACS_GET_TIME. (tzp): Var deleted. * Makefile.in.in: Add #undef alloca. Tue Jul 12 18:28:18 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * timer.c (xmalloc): New function. Mon Jul 11 21:15:55 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (ALLOCA_CFLAGS): New variable. (alloca.o): New target. Tue Jul 8 15:57:28 1994 Dave Love (d.love@dl.ac.uk) * etags.c (takeprec): recognise `character*(*) function' Fri Jul 8 12:19:17 1994 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (main): Don't barf on obsolete -t and -T switches. (main): Print an explicative message when a switch is not known. Thu Jun 23 15:25:21 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * hexl.c: Don't declare exit or perror. * emacsserver.c (main): Don't declare geteuid. Don't declare getenv if convex. Tue Jun 7 03:30:14 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (test-distrib): Use ALL_CFLAGS. Fri Jun 3 13:32:04 1994 Francesco Potorti` (pot@fly.cnuce.cnr.it) * etags.c (absolute_filename): Remove infinite loop bug when accessing files in directories whose name begins with a dot. Fri Jun 3 13:32:04 1994 Francesco Potorti` (pot@fly.cnuce.cnr.it) * etags.c (etags_getcwd): Delete the trailing newline from cwd. Wed Jun 1 20:39:18 1994 Morten Welinder (terra@diku.dk) * yow.c (rootrelativepath) [MSDOS]: Define, expanding to dynamic location of data directory. Mon May 30 04:33:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.25 released. Sat May 28 00:54:39 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (distclean): Delete Makefile, Makefile.in, blessmail. Fri May 27 03:16:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (blessmail): Don't depend on ../src/emacs. Mon May 23 00:38:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.24 released. Thu May 19 17:04:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-docfile.c (write_c_args): Put `default' in upper case. Tue May 17 21:15:20 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * etags.c (etags_getcwd): Cast result of popen. (popen): Declaration deleted. Tue May 17 19:42:44 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * etags.c [!MSDOS]: Declare popen. Tue May 17 15:12:17 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * b2m.c (main): Avoid crash if argc is 1. Mon May 16 03:25:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.23 released. * Makefile.in.in (blessmail): Specify directory for blessmail.el. Thu May 12 06:50:19 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (maybe-blessmail): Mention bless-mail is in lib-src. Thu May 5 15:06:52 1994 David J. MacKenzie (djm@nutrimat.gnu.ai.mit.edu) * Makefile.in.in: Fix out of date comment. Thu May 5 00:03:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in: Put in a separator for where to start cpp procssing. Move all autoconf substitutions above that point. Above that point, use Make-style comments. This goes with changes in ../configure.in. Tue May 3 16:33:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (maybe-blessmail): New target to print the blessmail warning message. (${archlibdir}): Don't do it here. Don't depend on blessmail. Mon May 2 16:50:22 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * Makefile.in.in (${archlibdir}): Be lenient about wc output format. Sun May 1 01:51:51 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (${archlibdir}): Don't run blessmail; instead print advice to run it, if it has anything significant to do. And only if MOVEMAIL_NEEDS_BLESSING. (blessmail): Use emacs, not temacs. (configuration): Renamed from configname. Sat Apr 30 23:25:57 1994 Morten Welinder (terra@diku.dk) * etags.c (find_entries): Treat `*.cpp' as C++ files. Sat Apr 30 03:29:39 1994 Morten Welinder (terra@diku.dk) * etags.c [MSDOS]: #include for the following. [MSDOS] (etags_getcwd): Define simple MSDOS version without spawning a shell. Fri Apr 29 00:38:09 1994 Morten Welinder (terra@diku.dk) * hexl.c [MSDOS]: Don't define proto type for exit. Thu Apr 28 00:44:43 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * b2m.c: Don't include string.h or strings.h. Wed Apr 27 16:15:47 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * Makefile.in.in: C_SWITCH_SYSTEM and C_SWITCH_MACHINE are now cpp symbols, not make variables. Sat Apr 23 03:07:52 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in (etags, ctags): Make VERSION a string constant. * etags.c (print_version): Print VERSION as a string. Wed Apr 20 16:02:44 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fakemail.c (readline): Fix updating of p when buffer grows. Wed Apr 20 01:30:58 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * Makefile.in.in (blessmail): New target. ${archlibdir}: Use blessmail when installing movemail. Mon Apr 18 20:17:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fakemail.c (readline): When extending the buffer, calculate end afresh using the new size. Mon Apr 18 12:39:58 1994 Francesco Potorti` (pot@fly.cnuce.cnr.it) * etags.c (main, print_help): eliminate the -F option. Mon Apr 18 12:39:58 1994 Francesco Potorti` (pot@fly.cnuce.cnr.it) * etags.c (absolute_filename): compare against '\0' instead of NULL. Sat Apr 16 00:30:16 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in.in: Renamed from Makefile.in. Makefile.in is now generated from it, and then preprocessed. Change comments to C syntax. Include config.h. (LIBS_SYSTEM, LIBS_MACHINE): Define as empty if not defined. (LOADLIBES): Define from LIBS_SYSTEM and LIBS_MACHINE. Wed Apr 13 18:18:48 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * movemail.c [HAVE_UNISTD_H]: Include unistd.h. Tue Apr 12 12:05:26 1994 Francesco Potorti` (pot@fly.cnuce.cnr.it) * etags.c (etags_getcwd): Initialize bufsize. Mon Apr 11 21:29:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * profile.c (gettimeofday): If system doesn't have this, define it to give a fatal error. Mon Apr 11 21:27:14 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * movemail.c (main): Use setuid, not seteuid. Mon Apr 11 15:01:49 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * etags.c: #undef static. Fri Apr 8 12:26:13 1994 Francesco Potorti` (pot@fly.cnuce.cnr.it) * etags.c (outf, outfiledir): renamed to tagf, tagfiledir. (PF_funcs, Asm_funcs, L_funcs, PAS_funcs, TEX_funcs, Scheme_funcs, prolog_funcs): renamed to Fortran_functions, Asm_labels, Lisp_functions, Pascal_functions, Scheme_functions, TeX_functions, Prolog_functions. (inf): no more a global variable. (C_entries): take 2nd parameter `inf' instead of using the global one. (find_entries): added the cp1 var for optimisation. (find_entries): added more suffixes for assembler files. (Asm_funcs): Now finds labels even without an ending colon. Wed Mar 30 13:53:56 1994 Francesco Potorti` (pot@fly.cnuce.cnr.it) * etags.c (main): use etags_getcwd for compatibility. (etags_getcwd): new function. Fri Mar 25 13:33:38 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (etags, ctags): Pass -D for VERSION. Fri Mar 25 13:00:42 1994 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (emacs_tags_format, ETAGS): removed. Use CTAGS instead. (main): don't allow the use of -t and -T in etags mode. (print_help): don't show options enabled by default. (print_version): show the emacs version number if VERSION is #defined. (find_entries): add "ss" as suffix for Chez Scheme. Wed Mar 23 11:42:17 1994 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (cwd, outfiledir): vars added. (relative_filename, absolute_filename, absolute_dirname): functions added to compute filenames in tags files. (process_file): filenames in tags file are relative to the directory where the tags file is (useful with the -o option). (main): initialise the outfiledir var. (TYPEDST): added the `tignore' value. (C_entries): corrected various small bugs. Sat Mar 19 21:04:52 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (UTILITIES): `env' deleted. (env): Target deleted. * env.c: File deleted. Mon Mar 14 17:08:59 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (install, ${archlibdir}): Switch back to .. before running INSTALL_PROGRAM. Mon Mar 14 17:44:00 1994 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (TYPEDST): added the `tignore' value. (C_entries): corrected various bugs, now correctly parses the `extern "C" {' construction (patch by Tom R.Hageman). Sat Mar 5 16:48:49 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * b2m.c: Use <...> to include config.h. Don't include stdlib.h. Thu Mar 3 13:08:19 1994 Heiko Muenkel (muenkel@tnt.uni-hannover.de) * b2m.c (main): Change delimiter from "^L" to "^_^L". Allow for text following "BABYL OPTIONS:". Add --help option. Use argv[0] in error messages. Tue Mar 1 23:35:50 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacsclient.c (main) [HAVE_SYSVIPC]: Make msgp->mtext longer if necessary. On HPUX, error if it's more than 512 chars. Sat Feb 26 22:34:08 1994 David J. MacKenzie (djm@geech.gnu.ai.mit.edu) * etags-vmslib.c: Use GPL. * emacstool.c: Use GPL. * fakemail.c: Update GPL. * make-path.c (main): Return 1 on error, not -1. Update GPL. * cvtmail.c: Declare malloc, realloc, xmalloc, xrealloc, getenv. (xmalloc, xrealloc): Return char *, not int. (error): Write to stderr, not stdout. Update GPL. Wed Feb 23 12:42:13 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * profile.c (main, get_time): Don't crash on invalid input. Tue Feb 22 14:20:16 1994 Karl Heuer (kwzh@mole.gnu.ai.mit.edu) * profile.c (get_time): Simplify; avoid calling index. (main): exit on EOF. Thu Feb 17 19:00:06 1994 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (--absolute-pathnames): option removed. Wed Feb 16 15:52:49 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fakemail.c (put_line): Don't break the line if it all fits. Mon Feb 14 15:17:25 1994 Francesco Potorti` (pot at fly) * etags.c (absolute_pathnames, cwd): added global vars. (longopts, print_help, main, process_file): put absolute filenames in the tag file if the -A --absolute-pathnames option is used. (print_help): alfabetically order the options. (malloc, realloc, strcpy, strncpy, strcmp): remove extern declar. Wed Feb 9 04:11:32 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (C_SWITCH_MACHINE): Get this from autoconf. (ALL_CFLAGS, LINK_CFLAGS, CPP_CFLAGS): Use C_SWITCH_MACHINE. Mon Feb 7 19:09:59 1994 Christian Lynbech (lynbech@avignon) * emacsserver.c (main) [HAVE_SYSVIPC]: Reverse test of fork value. Fri Feb 4 23:55:58 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (UTILITIES): Mention profile. (profile): New target. * profile.c: New file. Sun Jan 16 03:35:07 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * Make the argument list output look more like the Lisp docstrings do. make-docfile.c (write_c_args): Take new arg FUNC. Make output look like lisp call prototypes: (function ARG1 ARG2), upcasing args. (scan_c_file): Pass BUF to write_c_args for FUNC arg. Fri Jan 14 16:16:22 1994 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (stab_entry, stab_create, stab_find, stab_search, stab_type, add_keyword, C_reate_stab, C_create_stabs): deleted. Use gperf generated hash table instead of linked list. (C_stab_entry, hash, in_word_set, get_C_stab, C_symtype): added. Mostly code generated by gperf. (consider_token): removed unused parameter `lp'. (PF_funcs, getit): allow subroutine and similar declarations to span multiple lines. (C_entries): check for newline if inchar to avoid bus errors. (process_file, find_entries): distinguish among nonexistent and not regular file. Fri Jan 14 09:29:50 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * timer.c: Include errno.h; don't include fasync.h. (schedule): Don't return a value. (sigcatch): Reestablish the handler first. (getevent): Always call notify at the end. (notify): Defer alarms around the whole body of function. Wed Jan 12 13:01:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * timer.c (main): Don't request SIGIO, and don't handle it. Loop calling getevent. (sigcatch): Delete code to handle SIGIO. if defer_alarms is set, don't call notify, just set alarm_deferred. (getevent): Use read, not getchar. Handle EINTR and EAGAIN. Set defer_alarms around realloc and schedule. If alarm_deferred gets set, call notify. Likewise if this event is the only pending event. Make buf and buf_size global variables. Don't malloc buf if it is already non-zero. (schedule): Just exit if run out of memory. Return the number of events. (signal) [_CX_UX]: Add #undef. Tue Jan 11 23:47:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * timer.c [USG] (SIGIO): Define as SIGPOLL. (main) [USG]: Do ioctl to enable SIGPOLL. Sat Jan 8 16:44:02 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * timer.c: Don't declare sys_errlist; declare strerror instead. (schedule, main): Call strerror instead of using sys_errlist. * movemail.c (get_errmsg, pfatal_with_name, pfatal_and_delete): Call strerror instead of using sys_errlist. * env.c (main): Call strerror instead of using sys_errlist. * emacsclient.c: Don't declare sys_errlist; declare strerror instead. (main): Call strerror instead of using sys_errlist. * emacsclient.c [! HAVE_STRERROR] (strerror): Define the function. * env.c [! HAVE_STRERROR] (strerror): Likewise. * timer.c [! HAVE_STRERROR] (strerror): Likewise. * movemail.c [! HAVE_STRERROR] (strerror): Likewise. Wed Jan 5 22:47:07 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * hexl.c: Fix up whitespace. Get rid of spurious casts to void. * movemail.c (malloc): Don't declare it. (xmalloc): Cast result of malloc. (strcpy): Don't declare it. Sun Nov 14 07:45:44 1993 Morten Welinder (terra@diku.dk) * hexl.c [MSDOS]: Use binary file modes for non-text side of pipe. (main): Use fclose to close file opened by fopen. * fakemail.c (main) [MSDOS]: Dummy stub just to make the file compile. * movemail.c [MSDOS]: #undef `access'. * b2m.c (main) [MSDOS]: Open all files as binary. * etags.c (main) [MSDOS]: Open all files as binary. * make-docfile.c [MSDOS]: Use text/binary mode as appropriate. (scan_c_file, scan_lisp_file): Extra parameter for the mode to open with. Sun Jan 2 13:37:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (ALL_CFLAGS): Include LDFLAGS. Use ALL_CFLAGS in all the rules that compile and link with one cmd. (LINK_CFLAGS): New variable. (timer): Use LINK_CFLAGS. Thu Dec 30 06:46:47 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * movemail.c: Include syswait.h. Fork a subprocess and use it to copy the mail file. Tue Dec 7 22:58:21 1993 Richard Stallman (rms@srarc2) * make-docfile.c (scan_lisp_file): Don't add newline at end of string. Sat Dec 4 16:02:10 1993 Richard Stallman (rms@srarc2) * movemail.c (main): When making tempname, cast result of xmalloc. Include room for EXXXXXX in the size. Don't use result of strcpy. Fri Dec 3 09:29:18 1993 Paul Eggert (eggert@twinsun.com) * vcdiff: Add --brief option. Thu Dec 2 23:21:34 1993 Richard Stallman (rms@srarc2) * Makefile.in (${archlibdir}, install): Use $(INSTALL_PROGRAM) for all executables and scripts. Sat Nov 27 04:41:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.22 released. Fri Nov 26 06:08:35 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (mostlyclean): Make it distinct from clean. Wed Nov 24 07:24:06 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (${archlibdir}): Don't do chown or chgrp. Tue Nov 16 03:23:28 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.21 released. * Makefile.in (install): Don't change mode or group when installing. * etags.c (FUNCST, TYPEDST, STRUCTST, DEFINEST): Delete excess commas. Fri Nov 12 01:24:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-docfile.c (read_c_string): For "", concatenate the two strings. * movemail.c (main): Fix error message text. Thu Nov 11 10:08:43 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.20 released. Mon Nov 8 19:56:20 MET 1993 Tom Hageman (tom@basil.icce.rug.nl) * etags.c: (C_entries): Keep track of ()-parenthesis level so that functions returning a pointer to a function, a la `signal', can be parsed. This also required new state `fstartlist' to `FUNCST'. (SAVE_TOKEN, RESTORE_TOKEN, TOKEN_SAVED_P): 1-deep token save stack. (C_entries, CNL): use it to isolate preprocessor directive processing from the other state engines. (begtk): add '~', for C++ class destructors. Tue Nov 2 19:46:52 1993 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (consider_token): removed unused variable firsttok. (prolog_getit): call pfnote with the right number of arguments. Tue Oct 19 02:50:31 1993 Paul Eggert (eggert@twinsun.com) * rcs2log (printlogline): Don't generate lines containing only white space. Mon Oct 4 00:31:33 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * Makefile.in (${archlibdir}): Install ${SCRIPTS} from ${srcdir}, not cwd. Sun Oct 3 15:54:26 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * Makefile.in: Fixed typos or brainos of whoever thought `@' was the comment character. Fri Oct 1 10:44:25 1993 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (process_file): dead code removed. (S_ISREG): #define it using S_IFREG if not defined. (process_file): regular files have nothing to do with symlinks. Tue Sep 28 14:10:32 1993 Brian Fox (bfox@ai.mit.edu) * Makefile.in (${archlibdir}): Install ${SCRIPTS} from ${srcdir}, not from current directory. Only chmod and chgrp files that we installed, which excludes ${INSTALLABLE_SCRIPTS}. They go in ${bindir}. (INSTALLFLAGS): Deleted definition, since it is an unused variable now. Mon Sep 27 09:02:40 1993 Brian Fox (bfox@ai.mit.edu) * Makefile.in (INSTALL, INSTALL_PROGRAM, INSTALL_DATA): Let configure figure out the correct values for these variables. Tue Sep 14 00:55:44 1993 Brian Fox (bfox@ai.mit.edu) * Makefile.in (archlibdir): Only install execuatables internally used by emacs; don't install bindir binaries here. Fri Sep 24 01:03:32 1993 Paul Eggert (eggert@twinsun.com) * rcs2log: Add -h, -n, -r options. By default, look for *,v files as well as RCS/*,v files. Use $TMPDIR (default /tmp) instead of /tmp. Mon Sep 20 18:06:12 1993 Francesco Potorti` (pot at fly) * etags.c (C_entries): is_func is initialised here instead of in consider_token for the sake of the yacc rules section. (C_entries): Now class, struct, enum, union and typedef produce named tags. Sat Sep 11 21:37:09 1993 Roland McGrath (roland@baalperazim.gnu.ai.mit.edu) * yow.c: Include , instead of "src/paths.h". Fri Sep 10 00:47:13 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * Support configuring in a different directory when ${srcdir} has already been configured. * Makefile.in (ALL_CFLAGS, CPP_CFLAGS): Put -I. -I../src before -I${srcdir} -I${srcdir}/../src. (b2m, movemail, fakemail, env, emacsserver, emacsclient, getdate.o, timer.o, timer): Remove `-I${srcdir}/../src', since it is already in CPP_FLAGS. * etags.c, emacsclient.c, wakeup.c, timer.c, b2m.c, fakemail.c, movemail.c, emacsserver.c: Include instead of "config.h". Wed Aug 25 01:19:33 1993 Paul Eggert (eggert@twinsun.com) * rcs2log: Change /{/ to /\{/ for Posix ERE compatibility; otherwise, HP awk complains. * vcdiff: Append /usr/ccs/bin and /usr/sccs to PATH, since these are common hangouts for SCCS commands. Sat Aug 14 00:23:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.19 released. Thu Aug 12 18:23:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (make-path): Dep on config.h. Wed Aug 11 16:54:39 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * b2m.c (TRUE, FALSE): Don't define if already defined. Mon Aug 9 22:06:00 1993 Paul Eggert (eggert@twinsun.com) * rcs2log (awkscript): Some sites put comma-separated junk after the fullname. Remove it, but leave "Bill Gates, Jr" alone. Remove the junk from fullnames like "0000-Admin(0000)". Sun Aug 8 01:15:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.18 released. Wed Aug 4 18:51:10 1993 Francesco Potorti` (pot@spiff.gnu.ai.mit.edu) * etags.c (L_isdef, L_isquote, L_getit): small optimisations. (L_funcs): the (foo::defmumble stuff now should work. (consider_token): function returned random value--corrected. (C_entries): corrected == versus = typo. Sun Aug 1 18:14:02 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * etags.c (put_entries): For NODE->rewritten, put pattern before \177 and name after, not vice versa. Sun Aug 1 03:45:14 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * timer.c (main): Generate a SIGIO as soon as we've initialized. Fri Jul 30 15:54:59 1993 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (FINCST): added the fignore status. Means we are after the parameter list and before the open curly brace. Allows correct parsing of C++ constructors. (C_entries, consider_token): make use of fignore. (consider_token): reset funcdef when next_token_is_func: when in ctags mode makes DEFVAR and others work better. (L_isquote): function that recognises the "(quote" string. (L_getit): ignore quoting via "'" or "(quote". Useful for defalias. Thu Jul 29 12:57:38 1993 Paul Eggert (eggert@twinsun.com) * rcs-checkin: Don't check whether a file is readable until we have decided not to ignore it. Tue Jul 20 01:16:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (etags): Depend on ../src/config.h. * emacsserver.c: Include types.h before file.h. Mon Jul 19 15:10:15 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (install): Use .n, not .new, for temporary filenames. Sun Jul 18 15:10:15 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.17 released. Thu Jul 15 22:03:13 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * etags.c (print_help): Break up the very long strings containing 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) * Version 19.16 released. * b2m.c: #include . (ltoday): Declare this to be time_t. Wed Jun 30 18:54:08 1993 Paul Eggert (eggert@twinsun.com) * vcdiff: Add -q option. Tue Jun 29 18:47:53 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * etags.c: #include "config.h" and the alloca CPP tangle before #including the system headers and getopt.h. AIX requires the #pragma to come before any actual C code. Mon Jun 21 23:57:37 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Makefile.in (ctags): Depend on etags, so that parallel makes don't write etags.o files on top of each other. Sat Jun 19 17:14:27 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * version 19.15 released. Sat Jun 19 16:35:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * etags.c (add_node): Move var last_node to file scope. Thu Jun 17 19:29:56 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.14 released. Wed Jun 16 19:46:56 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) Bring mumbleclean targets into conformance with GNU coding standards. * Makefile.in (distclean): Call clean to do most of the work. Delete aixcc.c and TAGS. (realclean): Just call distclean. * Makefile.in: Remember, spaces are not tabs. Sun Jun 13 14:10:38 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (CPP_CFLAGS): New variable. Use it instead of ALL_CFLAGS when compiling a .c file. (getopt.o, getopt1.o): Add explicit compilation commands. Thu Jun 10 23:03:26 1993 Mark D. Baushke (mdb@cisco.com) * etags.c: Reinstate old -f option as an alias for -o for installed base uses. Wed Jun 9 00:06:03 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * emacsserver.c (main): When we're passing a `struct sockaddr_un' to bind or accept, cast the pointer, to avoid warnings on systems which declare prototypes for this. * emacsclient.c (main): Same. * Makefile.in (YACC): New variable, to be set by top-level Makefile. Tue Jun 8 03:14:38 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.13 released. * wakeup.c: Include sys/types.h, too; I think that's where time_t comes from, not sys/time.h. Wed Jun 2 02:50:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * wakeup.c: Include sys/time.h. * etags.c: #undef static. * Version 19.12 released. * Makefile.in (all): Exclude INSTALLABLE_SCRIPTS and SCRIPTS from deps. Tue Jun 1 04:07:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.11 released. * timer.c [LINUX]: #undef signal. * emacsserver.c: #undef signal. Sun May 30 21:39:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * wakeup.c (main): Make when a time_t. Sun May 30 15:24:31 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Makefile.in: (${archlibdir}): Use `(cd foo && pwd)` instead of `(cd foo ; pwd)` to get the canonical name of a directory; cd might fail, and have pwd print out the current directory. * movemail.c [MAIL_USE_POP] (main): Don't use non-portable string-handling functions. Sun May 30 00:15:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.10 released. Sat May 29 05:17:56 1993 Paul Eggert (eggert@twinsun.com) * rcs2log: When given no file arguments, inspect RCS/.* as well as RCS/*. Don't report an error if RCS is empty or nonexistent. Sat May 29 01:00:37 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (timer): Link with $(LOADLIBES). Fri May 28 17:21:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * fakemail.c (put_line): Don't output \n\t unless more text follows. Fri May 28 03:57:16 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * etags.c: Replace the CPP tangle for alloca with the one from the autoconf documentation, since that's working elsewhere. Thu May 27 23:32:46 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Makefile.in (ALL_CFLAGS): Add "-I.", so the system and machine description files can find their ancestors. Thu May 27 20:54:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (install): Get the scripts from ${srcdir}, unlike the executables. (ALL_CFLAGS): Add -I../src Thu May 27 02:35:32 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.9 released. Wed May 26 22:45:39 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Makefile.in (install): Do install the programs listed in INSTALLABLE_SCRIPTS. Make the renaming loop use INSTALLABLES and INSTALLABLE_SCRIPTS, instead of writing the programs out. * Makefile.in (ALL_CFLAGS): Include -I${srcdir}. (getopt.o, getopt1.c): Use ${srcdir} as appropriate. Tue May 25 16:07:07 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * etags.c: Include ../src/config.h. * Makefile.in (install): Don't handle INSTALLABLE_SCRIPTS in first loop. Delete files from bindir before installing new ones. (ALL_CFLAGS): Use ${srcdir} to find .../src dir. Mon May 24 12:14:41 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.8 released. * make-docfile.c: Doc fix. Mon May 24 19:33:35 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tcp.c: Fix comment syntax at top of file. (main): Don't call htons with the port number. Mon May 24 01:53:42 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Makefile.in (timer.o, sorted-doc.c): Link with alloca.o, if it's appropriate. * Makefile.in (install): Refer to the variables INSTALLABLES and INSTALLABLE_SCRIPTS, instead of writing them out. Sun May 23 14:52:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-path.c (main): Return 0. Sat May 22 19:37:01 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.7 released. Sat May 22 14:07:02 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * make-docfile.c (scan_lisp_file): Recognize defalias like fset. Wed May 19 17:09:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * tcp.c: New file. Tue May 18 16:35:06 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Makefile.in (.c.o): Make the rule start with a tab, not spaces. Sat May 15 18:13:22 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * timer.c (notify): Don't call sighold or sigrelse; they're USG only. We should really fix this later, but let's just make it compile for now. Install patches from David J. Mackenzie to make the srcdir option work. * Makefile.in (srcdir, VPATH): Get this value from the top-level Makefile. (INSTALLABLES): Split this into two lists - INSTALLABLES and INSTALLABLE_SCRIPTS. (INSTALLABLE_SCRIPTS): New list. (EXECUTABLES): Include INSTALLABLE_SCRIPTS. (${archlibdir}): The scripts to be installed live in the source tree, not in the object tree. (test-distrib): Note that the data file lives in the source tree, not the object tree. (GETOPTDEPS): Note that getopt.h lives in the source tree. (all other targets): Change references to source files to use ${srcdir}, except for config.h, which lives in the object dir. (timer.o): Note that this depends on ../src/config.h. * make-docfile.c (main): Add a -d option, to tell it where to find the source files. * test-distrib.c (main): Take the name of the distribution file to test from the command line. * timer.c: Fix mispellings of get_date function's name. Wed May 12 23:00:51 1993 Roland McGrath (roland@geech.gnu.ai.mit.edu) * etags.c (main): Don't require that there be input files if -i switches were given. Sun May 9 17:26:58 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) The GNU coding standards specify that CFLAGS should be left for users to set. * Makefile.in (CFLAGS): Put this in the "things configure might edit" section, and have it default to -g. (ALL_CFLAGS): New variable, set to all the flags which should be passed to compilations. Replace all other uses of CFLAGS with ALL_CFLAGS. (.c.o): New rule, to pass ALL_CFLAGS to compilations. * Makefile.in (DEFS): Remove this; it's always just going to be "-DHAVE_CONFIG_H -Demacs". Mon May 3 17:55:22 1993 Paul Eggert (eggert@twinsun.com) * rcs2log: mawk, SunOS 4.1.3 nawk, and Ultrix/MKS nawk all barf on /[/]/, so change it to /[\/]/. This should work on all Posix-compliant awks. It's slightly wrong with traditional awk, since it matches \ too, but that's a minor problem compared to awk syntax errors. Sat May 1 17:26:16 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Makefile.in (ALLOCA): New variable, whose value we should inherit from the top-level makefile. (etags, ctags): Include ALLOCA in the list of object files that these executables depend on and link. Fri Apr 9 08:13:16 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in (DEFS): Renamed from CONFIG_CFLAGS. Wed Apr 7 22:05:58 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * make-docfile.c (write_c_args): Print an argument named "defalt" as "default". Wed Mar 24 22:45:36 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Makefile.in (C_SWITCH_SYSTEM): New variable. (CFLAGS): Include C_SWITCH_SYSTEM in the flags to pass to the compiler. Mon Mar 22 13:16:20 1993 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (YACC): flag added to c_ext. (c_ext): no more a synonim for c_ext&C_PLPL because of YACC. (find_entries): consistently use streq when reasonable. (find_entries): a .y file is a yacc file. (get_C_stab): c_ext becomes c_ext&C_PLPL. (C_entries): logical cplpl means c_ext&C_PLPL. (C_entries): logical yacc_rules means we are after the first %%. (C_entries): added logic for yacc files. Tue Mar 16 12:13:43 1993 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (C_entries): ':' case moved to the second switch. (C_entries): do not examine token if structdef==scolonseen. (consider_token): structtag set to null string for enum. Fri Mar 12 19:54:24 1993 Francesco Potorti` (pot@cnuce.cnr.it) * etags.c (GET_COOKIE): and related macros removed. (logical): is now int, no more a char. (reg): define deleted. (isgood, _gd, notgd): deleted. (gotone): deleted. (TOKEN): member linestart removed. (linepos, prev_linepos, lb1): deleted. (main): call initbuffer on lbs array instead of lb1. (init): removed the initialisation of the logical _gd array; (find_entries): a .sa suffix means assembler file. (C_create_stab): "auto", "void", "extern", "static" are st_C_typespec. All C state machines rewritten. (C_entries): complete rewrite. (condider_token): complete rewrite. (getline): deleted. Mon Mar 1 19:06:26 1993 Francesco Potorti` (pot@fly.CNUCE.CNR.IT) * etags.c (C_entries): Added the quotednl logical variable. Used for parsing of #define's spanning multiple lines. Tue Feb 23 13:51:16 1993 Francesco Potorti` (pot@fly.CNUCE.CNR.IT) * etags.c (C_entries): Save the definedef status even when a newline is met inside a string. Fri Mar 19 02:49:40 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * Makefile.in (EXECUTABLES): added rcs-checkin. * Makefile.in (unlock, relock): New productions. Tue Mar 16 22:49:00 1993 Paul Eggert (eggert@twinsun.com) * rcs2log: Some awks don't understand "\r". Code around this. Unfortunately this requires putting a carriage return in the source code. Don't assume that rlog will tolerate times like `10:10:60'; RCS 5.7 won't allow this. Wed Mar 10 20:03:09 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * timer.c (main): Set the ownership of the stdin file descriptor to the current process. Print error messages if either of the fcntl's fails. * timer.c (sigcatch): Declare this to return SIGTYPE (defined in ../src/config.h), not void. Sat Mar 6 16:17:47 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * b2m.c (main): Don't exit upon reading a blank line. Mon Mar 1 19:06:26 1993 Francesco Potorti` (pot@fly.CNUCE.CNR.IT) * etags.c (C_entries): New local variable quotednl. Used for parsing of #define's spanning multiple lines. * etags.c (C_entries): Save the definedef status even when a newline is met inside a string. Fri Feb 26 06:10:58 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * timer.c (notify): Initialize waitfor properly. Mon Feb 22 12:48:14 MET 1993 Francesco Potorti` (pot@CNUCE.CNR.IT) * etags.c (C_entries): Don't reset definedef when a newline inside a comment is met. Thu Jan 14 14:57:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * etags.c (find_entries): If filename ends in .f or .for, don't try anything but Fortran. Fri Jan 8 15:27:42 1993 Michael I Bushnell (mib@geech.gnu.ai.mit.edu) * timer.c (notify): Flush stdout after writing message to avoid lossage on terminals. (notify): Also, write a newline after the token. Sat Dec 12 01:00:29 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in (exec_prefix): New variable. (bindir, libdir): Use it instead of `prefix'. * Makefile.in (CFLAGS): #define HAVE_CONFIG_H, too. * Makefile.in (libdir): Default to ${prefix}/lib. (archlibdir): Adjusted to match. * Makefile.in (distclean): Don't delete backup or autosave files. (extraclean): Like realclean, but does delete backup and autosave files. * Makefile.in (realclean): Ignore errors from rm. * Makefile.in (distclean): Don't bother to delete ../arch-lib; that doesn't exist anymore. Fri Dec 11 00:51:13 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in (prefix, bindir, libdir, srcdir): New variables, as described in the top-level Makefile. (UTILITIES): Add make-path to the list of utility programs. (../arch-lib): Replaced by the ${archlibdir} target, which places the executables in their permanent home. (install, install.sysv, install.xenix): Consolidated into one target which should work under all circumstances, modulo a few ignored error messages. * make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes a different number of arguments than other DEFVARs, recognize it specially, and expect the right number of commas. Fri Dec 4 15:05:36 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * make-path.c: New program, to help with the installation process. * Makefile.in (make-path): New target. * make-path.c (touchy_mkdir): Remove debugging output. Thu Nov 5 23:35:53 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in (getdate.o): Added explicit target for this, so we can indicate that it depends on ../src/config.h. Wed Nov 4 15:10:28 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Makefile.in (CONFIG_CFLAGS): Let the configure script edit this instead of CFLAGS. (CFLAGS): Add -Demacs and -I../src to CONFIG_CFLAGS to produce this. Wed Sep 30 17:42:19 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * getdate.y: Correctly recognize Mt. Xinu BSD running on an HP 9000/300 as BSD; don't include both and on that system. * Makefile.in (arch-lib): Give rm the `-f' option. Mon Sep 28 23:40:10 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-docfile.c (write_c_args): Rewritten to correctly print &optionals before the first identifier, but after the first paren. This code used to just wait for commas or spaces; now it notices identifier boundaries. Sat Sep 26 21:56:46 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * rcs2log: When getting date, use %02d instead of %.2d in awk printf. Wed Sep 23 06:33:34 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-docfile.c (write_c_args): Print the argument lists properly when the first argument is optional. Sat Sep 19 20:41:45 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * sorted-doc.c (main): Redefine special chars to use fonts tensy, teni. Redefine @item. Set catcode of +. Sat Aug 22 03:09:48 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emacsclient.c (main): Set IPC_CREAT in msgget call. Thu Aug 20 01:09:32 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * etags.c (TEX_funcs): Keep just 1 of two redundant nested loops. (TEX_decode_env): Make `tab' one element longer. Thu Aug 20 17:24:46 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * etags.c (PF_funcs): Recognize the "entry" keyword. Tue Aug 18 20:30:56 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Makefile.in: Add rcs2log and vcdiff to the list of utilities. Fri Aug 14 13:06:07 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * timer.c (events): Rather than having slots marked as in use or out of use by the `token' field, keep all pending events at the beginning of the array. When we delete an event in the middle of the array, we move the last event into its place. (num_events): New variable. (schedule): It is now cheaper to find a free event slot; events[num_events] is the first free slot. (notify): Scan events[0 .. num_events-1], instead of the whole array. When an event fires, move the last event in the array into its spot. Use num_events to determine whether or not there are any pending events, not wait_for. (getevent): Deleted unused variable `ep'. (sigcatch): It's now easier to find all the active events. (main): Initialize num_events. * etags.c: Rather than fret about which systems have index and which systems have strchr, and how to tell the difference between them, we just write out our own versions. Big deal. (index, rindex): Extern declarations removed. (NEED_INDEX, NEED_RINDEX): Special hacks for hpux removed. (etags_index, etags_rindex): New declarations. (process_file, find_entries, pfnote, TEX_funcs, TEX_decode_env, TEX_getit, substr): Use the etags_*index functions, rather than the native *index functions. (rindex, index): Renamed to etags_rindex and tags_rindex, and made them unconditionally defined, rather than having them depend on NEED_*INDEX. * etags.c (savenstr): Add declaration for this at top of file. (TEX_decode_env): Don't declare it local to this function. * b2m.c: #include "../src/config.h", so we can test for the USG macro, and decide whether to include or . * Makefile.in: Note that b2m.c depends on ../src/config.h. Thu Aug 13 14:17:49 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * timer.c: Reformatted according to the GNU coding standards. Removed arbitrary limits on the number of events queued and the length of the tokens used to identify them. Removed casts to (void). Removed debugging printfs; they clutter the code, and the need can be better filled using a real debugger. Fri Aug 7 19:41:40 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * timer.c: Installed new version from Eric Raymond; this is more portable, since it doesn't try to use SIGIO. Fri Jul 17 17:04:40 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * emacsclient.c (main): If we can't find the socket in this person's home directory, print a message which asks if they've started the server, instead of just printing the message from sys_errmsg; Cygnus finds that people are much less confused by this. Tue Jul 14 16:55:56 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * etags.c: Rather than defining "notdef" when "hpux" is #defined, so that index and rindex get defined, why don't we actually control index and rindex using symbols called "NEED_INDEX" and "NEED_RINDEX", and define them if hpux is defined? Isn't that a little more readable than defining something whose name implies that it's not? Wed Jul 8 17:57:18 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * movemail.c: Merged changes from Jamie Zawinski's byte compiler distribution: Miscellaneous doc fixes. (skip_white, read_lisp_symbol): New functions. (scan_lisp_file): Instead of using long hairy strings of ifs, call read_lisp_symbol and then see what we got. Call skip_white instead of writing out a loop to do its job. Correctly extract docstrings from "defmacro" declarations. Thu Jun 25 21:36:08 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * movemail.c (strcpy): Declare this to return char *. Thu Jun 18 18:52:36 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * etags.c (C_entries): When we find a C++ comment, do actually skip to the end of the line; do a 'break' instead of a 'continue'. Thu Jun 11 16:19:48 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * etags.c (getit): Add missing parenthesis to expression which decides if this token is an identifier. Thu Jun 4 21:14:43 1992 Roland McGrath (roland@geech.gnu.ai.mit.edu) * etags.c (consider_token): Recognize `ENTRY' macro used in libc. Sat May 30 15:30:54 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * etags.c (put_entries): Always put space between name and line num. Thu May 28 09:58:53 1992 Ken Raeburn (Raeburn@Cygnus.COM) * etags.c (getit): Parenthesize &&/|| expression to avoid gcc warning. (LEVEL_OK_FOR_FUNCDEF): Ditto. Tue May 19 01:22:58 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * make-docfile.c (write_c_args): Pass both arguments to putc. Sun May 10 14:14:56 1992 Roland McGrath (roland@albert.gnu.ai.mit.edu) * etags.c (C_entries): Fixed reading of "..." strings. (consider_token): Recognize `SYSCALL' and `PSEUDO' macros, used in the C library source. * etags.c (C_entries): When we see a backslash inside a quoted string, skip to the next character. This allows us to correctly deal with strings containing quotes. Fri May 8 00:34:26 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * make-docfile.c (write_c_args): Print the C argument names as they would be written in Elisp; print '_' as '-'. Thu May 7 16:11:26 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * movemail.c [POP]: Get user name via getpwuid. Mon May 4 20:34:51 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Makefile.in: flags in CC invocations rearranged for no reason. Mon Apr 20 16:33:51 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * etags.c (print_help): Remember not to imbed raw newlines in strings - end the lines with `\n\'. Fri Apr 17 06:04:25 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * timer.c (getevent): Removed declaration of memcpy; since different systems have different return types, and we're not even using the return type anyway, it wasn't doing us any good. Thu Apr 16 23:48:03 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * emacsserver.c (msgcatch): Use the SIGTYPE macro to declare the type of this function. Tue Apr 14 17:59:46 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * ChangeLog: Since the old etc contents have been split into etc and lib-src, the old etc's ChangeLog has been duplicated in the new etc and lib-src. That means that each contains complete and coherent information, although each contains extraneous information. Wed Apr 8 00:54:55 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * lib-src/etags.c: "--no-warning" option renamed to "--no-warn", to be consistent with other GNU programs, like makeinfo. * lib-src/Makefile: Renamed to Makefile.in; the configure script will edit this to produce Makefile. Tue Apr 7 02:39:25 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * etags.c (print_help, print_version): New functions. (main): Options added to support them. * etags.c (longopts): New array of long names for the options. (main): Recognize them. Mon Apr 6 22:29:38 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * etags.c (C_entries): Removed comment saying that \" in a string isn't recognized as magic, because it is correctly handled. * getopt.c, getopt.h: New files, from GNU C library. * etags.c: Rewritten to use getopt. #include "getopt.h". (file_num): Variable deleted; its role is now played by getopt's optind. (main): Argument processing loop rewritten to call getopt to get next option. Options which take parameters (-o and -i) rewritten to get parameter from optarg instead of argv[1]. Filename preprocessing loop and update command changed similarly. * Makefile (etags, ctags): Depend on and link with getopt.h, getopt.o, and getopt1.o. (getopt.o, getopt1.o): New targets for the GNU getopt routines. * etags.c (outfflag): Variable deleted; it is non-zero iff outfile is non-zero. (main): In the argument processing loop, the 'goto next_arg' statements are breaking out of the switch statement in exactly the same way that a simple 'break' statement would; replace the gotos with breaks, and remove the label. Mon Apr 6 17:29:21 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * etags.c (C_entries): Clear tydef and next_token_is_func at start. (consider_token): Move next_token_is_func to global. Thu Apr 2 02:03:48 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Makefile: Conform with GNU coding standards: (mostlyclean): New target, synonymous with clean. (TAGS, check): New targets. (INSTALL, INSTALLFLAGS): New variables. Tue Mar 31 10:30:56 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * lib-src/Makefile, etc/MACHINES, etc/NEWS: Changed references to `config.emacs' to `configure'. * lib-src/Makefile: Adjusted for renaming of share-lib to etc. * etc/MACHINES: Same. Mon Mar 30 21:34:42 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * movemail.c (main): Allow tempname to be as long as necessary, instead of limiting it to 39 characters. * movemail.c (main): Move declaration of buf from top of function to local block surrounding the copy loop. This makes it less likely to be confused with the buf used by the code which checks the permissions on outname's directory. Fri Mar 20 08:58:40 1992 Jim Kingdon (kingdon@albert.gnu.ai.mit.edu) * SERVICE: Remove my entry. Mon Mar 9 12:24:19 1992 David J. MacKenzie (djm@nutrimat.gnu.ai.mit.edu) * Makefile (emacstool, nemacstool, xvetool): Use ${CFLAGS}, not hardcoded -g. * movemail.c (xmalloc): Return char *, not int. (main) [!MAIL_USE_FLOCK]: Add a new conditional, MAIL_UNLINK_SPOOL, that is off by default -- normally don't unlink the mail spool file, just empty it. Pass creat mode 0600, not 0666. Fri Feb 7 16:28:01 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * Makefile (../arch-lib): Depend on ${EXECUTABLES}. (all): Instead of here. (install): Don't use the -s option, since people need symbols to debug code. Sun Jan 19 11:29:00 1992 (Eric Youngdale at youngdale@v6550c.nrl.navy.mil) * etags-vmslib.c (fn_exp): Add type cast. Sat Jan 18 17:46:03 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * movemail.c: Changes in comments. Mon Jan 13 01:41:23 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * Makefile: Make the distclean target erase the DOC files from ../share-lib and the executables from ../arch-lib. Thu Jan 9 01:37:24 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * emacsclient.c: #include (main): Do declare statbfr. Sat Dec 21 01:35:24 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * emacsserver.c, emacsclient.c [BSD]: Use either /tmp or ~ for the socket, depending on SERVER_HOME_DIR. If using /tmp, put host name in the socket name. * movemail.c (pfatal_and_delete): New function. (main, popmail): Use it. (popmail): Close output before deleting messages. Check for error on close and on fsync. Use `fatal' where appropriate. (main): Remove (void). * aixcc.lex: New file. Not officially part of Emacs. * Makefile: Rules for that. Wed Dec 4 15:16:22 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * yow.c (main): Rename all references to PATH_EXEC to PATH_DATA. * etags.c (main): Properly cast call to alloca that initializes included_files. Sat Aug 17 21:33:34 1991 Roland McGrath (roland@geech.gnu.ai.mit.edu) * etags.c (files_are_tag_tables): Remove global var. (process_file): Don't test it. Also remove hack checking for a file named "TAGS". (main): -i now takes an arg which is the name of a file to include. Collect these names and emit include tags for them after processing all the argument files. Tue Jul 30 17:03:41 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * wakeup.c: Terminate if parent goes away. Thu Jul 18 18:09:51 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * etags.c (C_entries): Process token before handling end of line. When inner loops reach end of line, just back up. Let the real end of line processing happen in just one place. (consider_token): Likewise. Thu Apr 11 14:35:34 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * etags.c (TEX_mode): Skip comments while scanning the text to see which escape character this file uses. Fri Mar 29 19:00:10 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * emacsserver.c [USG]: Terminate if msgrcv fails. Sun Mar 3 22:05:52 1991 Richard Stallman (rms at mole.ai.mit.edu) * emacsserver.c [BSD]: Check for errors on stdin after scanf. Fri Jan 25 22:37:29 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * make-docfile: Find the arguments to a C function correctly, by not ignoring the character that read_c_string returns. Don't even try to find argument names for functions that take MANY or UNEVALLED arguments, since they're a figment of the docstring's imagination. Mon Jan 14 18:47:17 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * make-docfile: Read the .elc files generated by the new byte compiler. Mon Dec 31 17:51:53 1990 Richard Stallman (rms at mole.ai.mit.edu) * refcard.tex: Use cm fonts, not am, in multi-column mode. Thu Nov 29 17:34:14 1990 Richard Stallman (rms at mole.ai.mit.edu) * movemail.c (mbx_delimit_begin): Put space before `unseen'. Tue Nov 27 17:50:37 1990 Richard Stallman (rms at mole.ai.mit.edu) * Makefile (install*): No need to install wakeup. Mon Nov 26 20:31:47 1990 Richard Stallman (rms at mole.ai.mit.edu) * Makefile (install*): Install emacsclient like etags. Tue Nov 13 00:01:54 1990 Richard Stallman (rms at mole.ai.mit.edu) * movemail.c (error): Handle 3 args. (main): Don't check input access if using pop. Tue Oct 16 14:04:05 1990 Richard Stallman (rms at mole.ai.mit.edu) * etags.c (find_entries): Check for numbers after Scheme suffix. Sun Oct 14 18:46:21 1990 Richard Stallman (rms at mole.ai.mit.edu) * termcap.dat (vt200-80): Fix ke and ks to frob flag 1. Tue Oct 9 15:22:16 1990 Richard Stallman (rms at mole.ai.mit.edu) * Makefile (nemacstool, xvetool): New targets. Wed Sep 26 18:43:44 1990 Richard Stallman (rms at mole.ai.mit.edu) * emacsclient.c: Include errno.h and define related variables. Sun Sep 23 02:22:44 1990 Richard Stallman (rms at mole.ai.mit.edu) * emacsclient.c: Change usage message. Thu Aug 30 06:17:53 1990 David Lawrence (tale at pogo.ai.mit.edu) * emacs.1: Add break before -nw option. Sun Aug 19 19:07:48 1990 David J. MacKenzie (djm at apple-gunkies) * qsort.c: Replace with GNU version. Tue Aug 14 23:47:28 1990 David J. MacKenzie (djm at apple-gunkies) * wakeup.c: New program replacing loadst.c. Tue Aug 14 21:34:50 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacsclient.c [USG]: Pass msgsnd only 4 args. Thu Aug 9 10:36:18 1990 David J. MacKenzie (djm at pogo.ai.mit.edu) * etags.c: Rename `flag' variables for what they do instead of which option character sets them. Mon May 28 21:54:59 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * loadst.c (main): Conditional to get load average on Apollo. Tue May 22 12:51:56 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * emacsserver.c: Set the permission on the socket to 0600. Tue Mar 27 20:09:49 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacsclient.c [BSD]: Print clean message for failing getwd. Tue Mar 20 19:53:07 1990 David Lawrence (tale at pogo.ai.mit.edu) * getdate.y: Use the getdate.y from GNU tar for timer. Sun Mar 18 12:03:44 1990 Jim Kingdon (kingdon at pogo.ai.mit.edu) * emacsclient.c (main): Don't put brackets around "filename" in usage message. It isn't optional. Wed Mar 14 15:23:26 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * etags.c (getit): Recognize '$' as beginning identifiers. Thu Feb 22 05:36:36 1990 David Lawrence (tale at pogo.ai.mit.edu) * emacsserver.c: Renamed from server.c. * Makefile: Reference emacsserver rather than server. * MACHINES: Doc fix for new emacsserver name. Thu Jan 25 22:14:15 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacsclient.c: Print program name in error messages. Fri Jan 19 22:55:07 1990 David Lawrence (tale at cocoa-puffs) * timer.c, getdate.y (new files) and Makefile: Sub-process support for run-at-time in timer.el. Doesn't yet work correctly for USG. Wed Jan 10 21:58:18 1990 Jim Kingdon (kingdon at pogo) * MACHINES: Add HP 300 running BSD. Tue Jan 2 12:15:41 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * yow.c: Dynamically allocate buffer; skip header before random choice to avoid bias toward first item. Sun Dec 24 23:54:28 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (readline): Separate out init of `pend'. Sun Dec 17 14:28:23 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: Undo changes relating to isgoodhdr. Sat Dec 16 15:31:34 1989 Mosur Mohan (rms at sugar-bombs.ai.mit.edu) * etags.c (isgoodhdr): New macro. (_gdh, notgdh): New variable used by that. (init): Initialize _gdh. (find_entries): Set header_file. (consider_token): Use isgoodhdr if in header file. * etags.c (total_size_of_entries): Was miscalculating by 1 in rewritten case. * etags.c (PAS_funcs): One arg to pfnote was missing. Tue Dec 5 14:10:36 1989 Joseph Arceneaux (jla at spiff) * MACHINES: Change for the ULTRIX entry. Tue Nov 21 10:33:43 1989 Joseph Arceneaux (jla at spiff) * etags.c (process_file): If file is not regular, return. Mon Nov 6 03:05:31 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * loadst.c (main): Handle FIXUP_KERNEL_SYMBOL_ADDR. Mon Oct 30 01:49:21 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * loadst.c (load_average): If HAVE_GETLOADAVG, use getloadavg. (main): If HAVE_GETLOADAVG, don't call `nlist'. Wed Oct 25 01:12:02 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (consider_token): Allow any number of typespec keywords after `typedef', before new type name. (enum sym_type): Add st_C_typespec. (C_create_stab): Put typespec kwds in table. Sun Aug 27 13:39:02 1989 Richard Stallman (rms at apple-gunkies.ai.mit.edu) * etags.c (main): Don't depend on name invoked by. If CTAGS is not defined, assume it is ETAGS. Mon Jul 31 02:08:58 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (L_funcs): Allow package name in define construct, as in (foo::defmumble name-defined ...). Sun Jul 30 20:55:13 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (find_entries): Stupid bug testing for C filename suffixes. * Makefile (yow): Depends on ../src/paths.h. Tue Jul 4 15:24:23 1989 Richard Stallman (rms at apple-gunkies.ai.mit.edu) * etags.c: Fix compilation by moving Pascal after Fortran. Thu Jun 15 12:52:48 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c [USG]: Define F_OK, etc., if not found in header. Sat May 27 00:24:28 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * hexl.c: New file, supports hexl-mode. Sun May 14 18:52:58 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c: New compilation flag MAIL_USE_MMDF. Mon May 8 17:10:28 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacsclient.c: Use BSD code whenever HAVE_SOCKETS. * server.c: Likewise. * make-docfile.c (scan_c_file): Output argument names at end of string. (write_c_args): New subroutine. Thu Apr 27 23:54:04 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c: Report failure of flock. Wed Apr 19 23:57:21 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (find_entries): Allow multi-letter extensions for fortran. Tue Apr 18 21:23:15 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * loadst.c: on bsd4.3, use gettimeofday instead of CPUSTATES. Wed Mar 15 23:23:33 1989 Jeff Peck (rms at sugar-bombs.ai.mit.edu) * emacstool.c: setenv IN_EMACSTOOL=t, TERM=sun, TERMCAP=. * emacsstool.1: update to document environment variables. Tue Feb 21 12:58:08 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (PAS_funcs): New function by Mosur Mohan. * movemail.c: On sysv, include unistd.h. Sat Feb 18 08:26:27 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * b2m.c: New file. Wed Feb 15 10:17:27 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: Prolog support from Sunichirou Sugou Fri Feb 3 18:37:04 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * Makefile (clean): New target. Wed Jan 25 01:54:13 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fakemail.c (put_line): Break header lines at 79 cols. Thu Jan 19 21:38:34 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: Greatly rewritten by Sam Kendall for C++ support and for multiple tags per line. Tue Jan 3 13:29:46 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c: Check access before doing real work. Check that outfile is in a writable directory. On fatal error, delete the lock file. Sat Dec 31 17:46:29 1988 Richard Mlynarik (mly at rice-chex.ai.mit.edu) * env.c: Add decl for my-index * etags.c (file-entries): .oak => scheme Fri Dec 30 16:37:27 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c: Use `access' to check input and output files. Wed Dec 28 02:31:00 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacsclient.c (main): Ignore all of CWD before first slash. Tue Dec 27 23:11:46 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (readline): Double linebuffer->size outside the xrealloc. Thu Dec 22 21:51:55 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * server.c, emacsclient.c: Don't try to use gid_t; it isn't defined. * server.c: chmod the socket to 0700. Fri Dec 9 12:01:25 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fakemail.c (main): Let env var FAKEMAILER override pgm to run. (add_field): Delete comments and turn `<', `>' to spaces in header lines. (USE_FAKEMAIL): New customization macro says to make fakemail not be a no-op even on a BSD system. Thu Dec 1 23:37:16 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (consider_token): Skip comments just like whitespace. Notice `struct', etc. and set strtag for those tokens. Return 1 for the token following `struct' if an open-brace follows it. (C_entries): Special handling of token following `struct' needed because we have probably advanced to the following line to find the `{'. (main): New option `T' sets tflag and strflag. Set both of them by default if eflags. Wed Nov 30 15:21:13 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c: Do fsync before closing output. Tue Nov 29 09:59:54 1988 Richard Mlynarik (mly at pickled-brain.ai.mit.edu) * movemail.c: Better error message when can't create tempname. This file needs a great deal of extra error-checking and lucid reporting... Wed Nov 16 22:03:15 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: Support assembler code for .s and .a files. (getit): Allow underscore in a tag. Tue Nov 15 10:00:21 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c: Close output and check errors before deleting input. Sat Oct 1 17:34:46 1988 Richard Stallman (rms at apple-gunkies.ai.mit.edu) * emacsclient.c [SYSVIPC]: Compute cwd only once; decide properly whether to prefix it. Handle line number args. Sat Sep 24 00:23:49 1988 Richard Stallman (rms at gluteus.ai.mit.edu) * etags.c (main): default setting of eflag was backwards. Fri Sep 23 17:05:34 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: New option -i. -f renamed -o. `-' as input file means read input file names from stdin. -i spec'd or input file named TAGS means the input file is another tag table; output an "include" line for it. Mon Sep 19 17:52:09 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * Makefile: New vars DESTDIR, BINDIR, LIBDIR, MANDIR, MANEXT. New targets install, install.sysv, install.xenix. This makefile is now responsible for installing executables and documentation from this directory into system directories. Fri Sep 16 01:03:55 1988 Richard Stallman (rms at corn-chex.ai.mit.edu) * server.c, emacsclient.c (main): Compute socket name from euid. Thu Aug 4 19:42:45 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacsclient.c: Args like +DIGITS are passed through unchanged. Tue Jul 12 22:08:00 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * server.c: If both BSD and HAVE_SYSVIPC, use the latter. * emacsclient.c: Likewise. In the HAVE_SYSVIPC alternative, if BSD, use getwd instead of getcwd. Thu Jun 23 08:40:53 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: Handle `typedef struct foo {' (price@mcc.com). (istoken) New string-comparison macro. (consider_token): New arg `level'. New state `tag_ok' in `tydef'. Tue Jun 14 04:25:58 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: Changes for VMS. Always define ETAGS on VMS. Define macros GOOD and BAD for success and failure exit codes. (begtk, intk): Allow `$' in identifiers (main): Don't support -B, -F or -u on VMS. Alternate loop for scanning filename arguments. (system): Delete definition of this function. * etags-vmslib.c (system): Undefine this; VMS now provides it. Wed Jun 8 08:18:21 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * loadst.c: Prevent multiple-def errors on BSD and BSD4_3 around include of param.h. (Like fns.c.) Mon May 16 01:06:26 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * loadst.c (load_average): Move load-average code to this new fn. Add conditionals to compute load ave on UMAX. Sat May 14 01:24:53 1988 Richard Stallman (rms at lucky-charms.ai.mit.edu) * loadst.c: Change DK_HEADER_FILE to DKSTAT_HEADER_FILE with opposite sense. Fri May 13 18:09:39 1988 Chris Hanson (cph at kleph) * emacsclient.c: Delete references to unused variable `out'. This caused a bus error when used under hp-ux. Fri May 6 10:42:31 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * loadst.c: Control dk.h conditional with DK_HEADER_FILE. Wed May 4 16:08:43 1988 Richard Stallman (rms at rice-krispies.ai.mit.edu) * etags.c (find_entries): `.t' or `.sch' means scheme code. Fri Apr 29 00:22:26 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * loadst.c: Add BSD4_3 conditional for file dk.h instead of dkstat.h. Thu Apr 28 08:55:46 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * movemail.c: #undef close, since config can #define it on V.3. * emacsclient.c, fakemail.c, loadst.c, server.c: likewise. Tue Apr 26 07:33:01 1988 Richard Stallman (rms at lucky-charms.ai.mit.edu) * etags.c (TEX_mode, etc.): Remove superfluous backslashes from invalid escape sequences such as `\{'. * loadst.c: Add `sequent' conditional for file dk.h. Sun Mar 20 13:17:13 1988 Richard M. Stallman (rms at wilson) * server.c [not BSD and not HAVE_SYSVIPC]: fix error message. * loadst.c (main) [XENIX]: use /usr/spool/mail, not /usr/mail. emacs-19.30/lib-src/Makefile.in100444 12120 13 33061 6052002770 14257 0ustar rmsuser# Makefile for lib-src subdirectory in GNU Emacs. # Copyright (C) 1985, 1987, 1988, 1993, 1994 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. */ # Avoid trouble on systems where the `SHELL' variable might be # inherited from the environment. SHELL = /bin/sh # ==================== Things `configure' will edit ==================== CC=@CC@ CFLAGS=@CFLAGS@ ALLOCA=@ALLOCA@ YACC=@YACC@ version=@version@ configuration=@configuration@ # ==================== Where To Install Things ==================== # The default location for installation. Everything is placed in # subdirectories of this directory. The default values for many of # the variables below are expressed in terms of this one, so you may # not need to change them. This is set with the --prefix option to # `../configure'. prefix=@prefix@ # Like `prefix', but used for architecture-specific files. This is # set with the --exec-prefix option to `../configure'. exec_prefix=@exec_prefix@ # Where to install Emacs and other binaries that people will want to # run directly (like etags). This is set with the --bindir option # to `../configure'. bindir=@bindir@ # Where to install and expect executable files to be run by Emacs # rather than directly by users, and other architecture-dependent # data. ${archlibdir} is usually below this. This is set with the # --libexecdir option to `../configure'. libexecdir=@libexecdir@ # Where to find the source code. This is set by the configure # script's `--srcdir' option. However, the value of ${srcdir} in # this makefile is not identical to what was specified with --srcdir, # since the variable here has `/lib-src' added at the end. srcdir=@srcdir@ VPATH=@srcdir@ # The top-level source directory, also set by configure. top_srcdir=@top_srcdir@ # ==================== Emacs-specific directories ==================== # These variables hold the values Emacs will actually use. They are # based on the values of the standard Make variables above. # Where to put executables to be run by Emacs rather than the user. # This path usually includes the Emacs version and configuration name, # so that multiple configurations for multiple versions of Emacs may # be installed at once. This can be set with the --archlibdir option # to `../configure'. archlibdir=@archlibdir@ # ==================== Utility Programs for the Build ================= # ../configure figures out the correct values for these. INSTALL = @INSTALL@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_DATA = @INSTALL_DATA@ # ========================== Lists of Files =========================== # Things that a user might actually run, # which should be installed in bindir. INSTALLABLES = etags ctags emacsclient b2m INSTALLABLE_SCRIPTS = rcs-checkin # Things that Emacs runs internally, or during the build process, # which should not be installed in bindir. UTILITIES= wakeup profile digest-doc \ sorted-doc movemail cvtmail fakemail yow emacsserver hexl timer DONT_INSTALL= test-distrib make-docfile # Like UTILITIES, but they're not system-dependent, and should not be # deleted by the distclean target. SCRIPTS= rcs2log vcdiff EXECUTABLES= ${UTILITIES} ${INSTALLABLES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS} SOURCES = COPYING ChangeLog Makefile.in README emacs.csh \ makedoc.com *.[chy] rcs2log vcdiff # Additional -D flags for movemail (add to MOVE_FLAGS if desired): # MAIL_USE_POP Support mail retrieval from a POP mailbox. # MAIL_USE_MMDF Support MMDF mailboxes. # MAIL_USE_FLOCK Use flock for file locking (see the comments # about locking in movemail.c) # MAIL_UNLINK_SPOOL Unlink the user's spool mailbox after reading # it (instead of just emptying it). # KERBEROS Support Kerberized POP. # KRB5 Support Kerberos Version 5 pop instead of # Version 4 (define this in addition to # KERBEROS). # HESIOD Support Hesiod lookups of user mailboxes. # MAILHOST A string, the host name of the default POP # mail host for the site. MOVE_FLAGS= # Additional libraries for movemail: # For KERBEROS # MOVE_LIBS= -lkrb -ldes -lcom_err # For KERBEROS + KRB5 # MOVE_LIBS= -lkrb5 -lcrypto -lisode -lcom_err # Add "-lhesiod" if HESIOD is defined. MOVE_LIBS= # ========================== start of cpp stuff ======================= /* From here on, comments must be done in C syntax. */ #define NO_SHORTNAMES #define THIS_IS_YMAKEFILE #define NOT_C_CODE #include "../src/config.h" /* We won't really call alloca; don't let the file name alloca.c get messed up. */ #ifdef alloca #undef alloca #endif /* Some machines don't find the standard C libraries in the usual place. */ #ifndef ORDINARY_LINK #ifndef LIB_STANDARD #define LIB_STANDARD -lc #endif #else #ifndef LIB_STANDARD #define LIB_STANDARD #endif #endif /* Some s/*.h files define this to request special libraries. */ #ifndef LIBS_SYSTEM #define LIBS_SYSTEM #endif /* Some m/*.h files define this to request special libraries. */ #ifndef LIBS_MACHINE #define LIBS_MACHINE #endif #ifndef C_SWITCH_SYSTEM #define C_SWITCH_SYSTEM #endif #ifndef C_SWITCH_MACHINE #define C_SWITCH_MACHINE #endif #undef MOVEMAIL_NEEDS_BLESSING #ifndef MAIL_USE_FLOCK #ifndef MAIL_USE_LOCKF #define MOVEMAIL_NEEDS_BLESSING #endif #endif #ifdef MOVEMAIL_NEEDS_BLESSING #define BLESSMAIL blessmail #else #define BLESSMAIL #endif LOADLIBES=LIBS_SYSTEM LIBS_MACHINE LIB_STANDARD /* We need to #define emacs to get the right versions of some files. Some other files - those shared with other GNU utilities - need HAVE_CONFIG_H #defined before they know they can take advantage of the information in ../src/config.h. */ ALL_CFLAGS = C_SWITCH_SYSTEM C_SWITCH_MACHINE -DHAVE_CONFIG_H \ -I. -I../src -I${srcdir} -I${srcdir}/../src ${LDFLAGS} ${CPPFLAGS} ${CFLAGS} LINK_CFLAGS = C_SWITCH_SYSTEM C_SWITCH_MACHINE -DHAVE_CONFIG_H \ -I. -I../src -I${srcdir} -I${srcdir}/../src ${LDFLAGS} ${CFLAGS} CPP_CFLAGS = C_SWITCH_SYSTEM C_SWITCH_MACHINE -DHAVE_CONFIG_H \ -I. -I../src -I${srcdir} -I${srcdir}/../src ${CPPFLAGS} ${CFLAGS} /* This was all of CPP_CFLAGS except -Demacs. Now that -Demacs has been deleted from CPP_CFLAGS, this is actually the same as CPP_CFLAGS, but let's not delete it yet. */ BASE_CFLAGS = C_SWITCH_SYSTEM C_SWITCH_MACHINE -DHAVE_CONFIG_H \ -I. -I../src -I${srcdir} -I${srcdir}/../src ${CPPFLAGS} ${CFLAGS} /* This is the default compilation command. But we should never rely on it, because some make version failed to find it for getopt.o. Using an explicit command made it work. */ .c.o: ${CC} -c ${CPP_CFLAGS} $< all: ${DONT_INSTALL} ${UTILITIES} ${INSTALLABLES} #ifdef MOVEMAIL_NEEDS_BLESSING blessmail: ../src/emacs -batch -l ../lisp/blessmail.el chmod +x blessmail #endif maybe-blessmail: BLESSMAIL #ifdef MOVEMAIL_NEEDS_BLESSING /* Don't charge ahead and do it! Let the installer decide. ./blessmail ${archlibdir}/movemail */ @if [ `wc -l &2; exit 2 ;; esac sid2=$f ;; esac ;; *) options="$options $f" ;; esac shift ;; *) break ;; esac done case $# in 0) echo "$usage" >&2 exit 2 esac rev1= rev2= status=0 trap 'status=2; exit' 1 2 13 15 trap 'rm -f $rev1 $rev2 || status=2; exit $status' 0 for f do s=2 case $f in s.* | */s.*) if rev1=/tmp/geta$$ get -s -p -k $sid1 "$f" > $rev1 && case $sid2 in '') workfile=`expr " /$f" : '.*/s.\(.*\)'` ;; *) rev2=/tmp/getb$$ get -s -p -k $sid2 "$f" > $rev2 workfile=$rev2 esac then $echo $DIFF $options $sid1 $sid2 $workfile >&2 $DIFF $options $rev1 $workfile s=$? fi ;; *) echo "$0: $f is not an SCCS file" >&2 esac if test $status -lt $s then status=$s fi done emacs-19.30/lib-src/emacs.csh100666 13437 13 2272 5405340705 14127 0ustar jimbuser# This defines a csh command named `edit' which resumes an # existing Emacs or starts a new one if none exists. # One way or another, any arguments are passed to Emacs to specify files # (provided you have loaded `resume.el'). # - Michael DeCorte # These are the possible values of $whichjob # 1 = new ordinary emacs (the -nw is so that it doesn't try to do X) # 2 = resume emacs # 3 = new emacs under X (-i is so that you get a reasonable icon) # 4 = resume emacs under X # 5 = new emacs under suntools # 6 = resume emacs under suntools # 7 = new emacs under X and suntools - doesn't make any sense, so use X # 8 = resume emacs under X and suntools - doesn't make any sense, so use X set EMACS_PATTERN="^\[[0-9]\] . Stopped ............ $EMACS" alias edit 'set emacs_command=("emacs -nw \!*" "fg %emacs" "emacs -i \!* &"\ "emacsclient \!* &" "emacstool \!* &" "emacsclient \!* &" "emacs -i \!* &"\ "emacsclient \!* &") ; \ jobs >! $HOME/.jobs; grep "$EMACS_PATTERN" < $HOME/.jobs >& /dev/null; \ @ isjob = ! $status; \ @ whichjob = 1 + $isjob + $?DISPLAY * 2 + $?WINDOW_PARENT * 4; \ test -S ~/.emacs_server && emacsclient \!* \ || echo `pwd` \!* >! ~/.emacs_args && eval $emacs_command[$whichjob]' emacs-19.30/lib-src/rcs2log100555 74720 13 35673 5777550764 14250 0ustar eggertuser#! /bin/sh # RCS to ChangeLog generator # Generate a change log prefix from RCS files and the ChangeLog (if any). # Output the new prefix to standard output. # You can edit this prefix by hand, and then prepend it to ChangeLog. # Ignore log entries that start with `#'. # Clump together log entries that start with `{topic} ', # where `topic' contains neither white space nor `}'. # Author: Paul Eggert # $Id: rcs2log,v 1.26 1995/07/08 18:44:04 eggert Exp $ # Copyright 1992, 1993, 1994, 1995 Free Software Foundation, Inc. # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; see the file COPYING. If not, write to # the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. tab=' ' nl=' ' # Parse options. # defaults : ${AWK=awk} : ${TMPDIR=/tmp} hostname= # name of local host (if empty, will deduce it later) indent=8 # indent of log line length=79 # suggested max width of log line logins= # login names for people we know fullnames and mailaddrs of loginFullnameMailaddrs= # loginfullnamemailaddr triplets recursive= # t if we want recursive rlog rlog_options= # options to pass to rlog tabwidth=8 # width of horizontal tab while : do case $1 in -i) indent=${2?}; shift;; -h) hostname=${2?}; shift;; -l) length=${2?}; shift;; -[nu]) # -n is obsolescent; it is replaced by -u. case $1 in -n) case ${2?}${3?}${4?} in *"$tab"* | *"$nl"*) echo >&2 "$0: -n '$2' '$3' '$4': tabs, newlines not allowed" exit 1 esac loginFullnameMailaddrs=$loginFullnameMailaddrs$nl$2$tab$3$tab$4 shift; shift; shift;; -u) # If $2 is not tab-separated, use colon for separator. case ${2?} in *"$nl"*) echo >&2 "$0: -u '$2': newlines not allowed" exit 1;; *"$tab"*) t=$tab;; *) t=: esac case $2 in *"$t"*"$t"*"$t"*) echo >&2 "$0: -u '$2': too many fields" exit 1;; *"$t"*"$t"*) ;; *) echo >&2 "$0: -u '$2': not enough fields" exit 1 esac loginFullnameMailaddrs=$loginFullnameMailaddrs$nl$2 shift esac logins=$logins$nl$login ;; -r) rlog_options=$rlog_options$nl${2?}; shift;; -R) recursive=t;; -t) tabwidth=${2?}; shift;; -*) echo >&2 "$0: usage: $0 [options] [file ...] Options: [-h hostname] [-i indent] [-l length] [-R] [-r rlog_option] [-t tabwidth] [-u 'loginfullnamemailaddr']..." exit 1;; *) break esac shift done month_data=' m[0]="Jan"; m[1]="Feb"; m[2]="Mar" m[3]="Apr"; m[4]="May"; m[5]="Jun" m[6]="Jul"; m[7]="Aug"; m[8]="Sep" m[9]="Oct"; m[10]="Nov"; m[11]="Dec" # days in non-leap year thus far, indexed by month (0-12) mo[0]=0; mo[1]=31; mo[2]=59; mo[3]=90 mo[4]=120; mo[5]=151; mo[6]=181; mo[7]=212 mo[8]=243; mo[9]=273; mo[10]=304; mo[11]=334 mo[12]=365 ' # Put rlog output into $rlogout. # If no rlog options are given, # log the revisions checked in since the first ChangeLog entry. case $rlog_options in '') date=1970 if test -s ChangeLog then # Add 1 to seconds to avoid duplicating most recent log. e=' /^... ... [ 0-9][0-9] [ 0-9][0-9]:[0-9][0-9]:[0-9][0-9] [0-9]+ /{ '"$month_data"' year = $5 for (i=0; i<=11; i++) if (m[i] == $2) break dd = $3 hh = substr($0,12,2) mm = substr($0,15,2) ss = substr($0,18,2) ss++ if (ss == 60) { ss = 0 mm++ if (mm == 60) { mm = 0 hh++ if (hh == 24) { hh = 0 dd++ monthdays = mo[i+1] - mo[i] if (i == 1 && year%4 == 0 && (year%100 != 0 || year%400 == 0)) monthdays++ if (dd == monthdays + 1) { dd = 1 i++ if (i == 12) { i = 0 year++ } } } } } # Output comma instead of space to avoid CVS 1.5 bug. printf "%d/%02d/%02d,%02d:%02d:%02d\n", year,i+1,dd,hh,mm,ss exit } ' d=`$AWK "$e" &2 "$0: $repository: bad repository (see CVS/Repository)" exit 1 fi esac fi # With no arguments, examine all files under the RCS directory. case $# in 0) case $repository in '') oldIFS=$IFS IFS=$nl case $recursive in t) RCSdirs=`find . -name RCS -type d -print` filesFromRCSfiles='s|,v$||; s|/RCS/|/|; s|^\./||' files=` { case $RCSdirs in ?*) find $RCSdirs -type f -print esac find . -name '*,v' -print } | sort -u | sed "$filesFromRCSfiles" `;; *) files= for file in RCS/.* RCS/* .*,v *,v do case $file in RCS/. | RCS/..) continue;; RCS/.\* | RCS/\* | .\*,v | \*,v) test -f "$file" || continue esac files=$files$nl$file done case $files in '') exit 0 esac esac set x $files shift IFS=$oldIFS esac esac llogout=$TMPDIR/rcs2log$$l rlogout=$TMPDIR/rcs2log$$r trap exit 1 2 13 15 trap "rm -f $llogout $rlogout; exit 1" 0 case $rlog_options in ?*) $rlog $rlog_options ${1+"$@"} >$rlogout;; '') $rlog "$datearg" ${1+"$@"} >$rlogout esac || exit # Get the full name of each author the logs mention, and set initialize_fullname # to awk code that initializes the `fullname' awk associative array. # Warning: foreign authors (i.e. not known in the passwd file) are mishandled; # you have to fix the resulting output by hand. initialize_fullname= initialize_mailaddr= case $loginFullnameMailaddrs in ?*) case $loginFullnameMailaddrs in *\"* | *\\*) sed 's/["\\]/\\&/g' >$llogout <$llogout </dev/null | $AWK -F: "$awkscript" `$initialize_fullname esac # Function to print a single log line. # We don't use awk functions, to stay compatible with old awk versions. # `Log' is the log message (with \n replaced by \r). # `files' contains the affected files. printlogline='{ # Following the GNU coding standards, rewrite # * file: (function): comment # to # * file (function): comment if (Log ~ /^\([^)]*\): /) { i = index(Log, ")") files = files " " substr(Log, 1, i) Log = substr(Log, i+3) } # If "label: comment" is too long, break the line after the ":". sep = " " if ('"$length"' <= '"$indent"' + 1 + length(files) + index(Log, CR)) sep = "\n" indent_string # Print the label. printf "%s*%s:", indent_string, files # Print each line of the log, transliterating \r to \n. while ((i = index(Log, CR)) != 0) { logline = substr(Log, 1, i-1) if (logline ~ /[^'"$tab"' ]/) { printf "%s%s\n", sep, logline } else { print "" } sep = indent_string Log = substr(Log, i+1) } }' case $hostname in '') hostname=`( hostname || uname -n || uuname -l || cat /etc/whoami ) 2>/dev/null` || { echo >&2 "$0: cannot deduce hostname" exit 1 } esac # Process the rlog output, generating ChangeLog style entries. # First, reformat the rlog output so that each line contains one log entry. # Transliterate \n to \r so that multiline entries fit on a single line. # Discard irrelevant rlog output. $AWK <$rlogout ' BEGIN { repository = "'"$repository"'" } /^RCS file:/ { if (repository != "") { filename = $3 if (substr(filename, 1, length(repository) + 1) == repository "/") { filename = substr(filename, length(repository) + 2) } if (filename ~ /,v$/) { filename = substr(filename, 1, length(filename) - 2) } } } /^Working file:/ { if (repository == "") filename = $3 } /^date: /, /^(-----------*|===========*)$/ { if ($0 ~ /^branches: /) { next } if ($0 ~ /^date: [0-9][- +\/0-9:]*;/) { date = $2 if (date ~ /-/) { # An ISO format date. Replace all "-"s with "/"s. newdate = "" while ((i = index(date, "-")) != 0) { newdate = newdate substr(date, 1, i-1) "/" date = substr(date, i+1) } date = newdate date } # Ignore any time zone; ChangeLog has no room for it. time = substr($3, 1, 8) author = substr($5, 1, length($5)-1) printf "%s %s %s %s %c", filename, date, time, author, 13 next } if ($0 ~ /^(-----------*|===========*)$/) { print ""; next } printf "%s%c", $0, 13 } ' | # Now each line is of the form # FILENAME YYYY/MM/DD HH:MM:SS AUTHOR \rLOG # where \r stands for a carriage return, # and each line of the log is terminated by \r instead of \n. # Sort the log entries, first by date+time (in reverse order), # then by author, then by log entry, and finally by file name (just in case). sort +1 -3r +3 +0 | # Finally, reformat the sorted log entries. $AWK ' BEGIN { # Some awk variants do not understand "\r" or "\013", so we have to # put a carriage return directly in the file. CR=" " # <-- There is a single CR between the " chars here. # Initialize the fullname and mailaddr associative arrays. '"$initialize_fullname"' '"$initialize_mailaddr"' # Initialize indent string. indent_string = "" i = '"$indent"' if (0 < '"$tabwidth"') for (; '"$tabwidth"' <= i; i -= '"$tabwidth"') indent_string = indent_string "\t" while (1 <= i--) indent_string = indent_string " " # Set up date conversion tables. # RCS uses a nice, clean, sortable format, # but ChangeLog wants the traditional, ugly ctime format. # January 1, 0 AD (Gregorian) was Saturday = 6 EPOCH_WEEKDAY = 6 # Of course, there was no 0 AD, but the algorithm works anyway. w[0]="Sun"; w[1]="Mon"; w[2]="Tue"; w[3]="Wed" w[4]="Thu"; w[5]="Fri"; w[6]="Sat" '"$month_data"' } { newlog = substr($0, 1 + index($0, CR)) # Ignore log entries prefixed by "#". if (newlog ~ /^#/) { next } if (Log != newlog || date != $2 || author != $4) { # The previous log and this log differ. # Print the old log. if (date != "") '"$printlogline"' # Logs that begin with "{clumpname} " should be grouped together, # and the clumpname should be removed. # Extract the new clumpname from the log header, # and use it to decide whether to output a blank line. newclumpname = "" sep = "\n" if (date == "") sep = "" if (newlog ~ /^\{[^'"$tab"' }]*}['"$tab"' ]/) { i = index(newlog, "}") newclumpname = substr(newlog, 1, i) while (substr(newlog, i+1) ~ /^['"$tab"' ]/) i++ newlog = substr(newlog, i+1) if (clumpname == newclumpname) sep = "" } printf sep clumpname = newclumpname # Get ready for the next log. Log = newlog if (files != "") for (i in filesknown) filesknown[i] = 0 files = "" } if (date != $2 || author != $4) { # The previous date+author and this date+author differ. # Print the new one. date = $2 author = $4 # Convert nice RCS date like "1992/01/03 00:03:44" # into ugly ctime date like "Fri Jan 3 00:03:44 1992". # Calculate day of week from Gregorian calendar. i = index($2, "/") year = substr($2, 1, i-1) + 0 monthday = substr($2, i+1) i = index(monthday, "/") month = substr(monthday, 1, i-1) + 0 day = substr(monthday, i+1) + 0 leap = 0 if (2 < month && year%4 == 0 && (year%100 != 0 || year%400 == 0)) leap = 1 days_since_Sunday_before_epoch = EPOCH_WEEKDAY + year * 365 + int((year + 3) / 4) - int((year + 99) / 100) + int((year + 399) / 400) + mo[month-1] + leap + day - 1 # Print "date fullname (email address)". # Get fullname and email address from associative arrays; # default to author and author@hostname if not in arrays. if (fullname[author]) auth = fullname[author] else auth = author printf "%s %s %2d %s %d %s ", w[days_since_Sunday_before_epoch%7], m[month-1], day, $3, year, auth if (mailaddr[author]) printf "<%s>\n\n", mailaddr[author] else printf "<%s@%s>\n\n", author, "'"$hostname"'" } if (! filesknown[$1]) { filesknown[$1] = 1 if (files == "") files = " " $1 else files = files ", " $1 } } END { # Print the last log. if (date != "") { '"$printlogline"' printf "\n" } } ' && # Exit successfully. exec rm -f $llogout $rlogout emacs-19.30/lib-src/rcs-checkin100555 74720 13 6111 5777334635 15024 0ustar eggertuser#! /bin/sh # This script accepts any number of file arguments and checks them into RCS. # # Arguments which are detectably either RCS masters (with names ending in ,v) # or Emacs version files (with names of the form foo.~~) are ignored. # For each file foo, the script looks for Emacs version files related to it. # These files are checked in as deltas, oldest first, so that the contents of # the file itself becomes the latest revision in the master. # # The first line of each file is used as its description text. The file itself # is not deleted, as under VC with vc-keep-workfiles at its default of t, but # all the version files are. # # If an argument file is already version-controlled under RCS, any version # files are added to the list of deltas and deleted, and then the workfile # is checked in again as the latest version. This is probably not quite # what was wanted, and is the main reason VC doesn't simply call this to # do checkins. # # This script is intended to be used to convert files with an old-Emacs-style # version history for use with VC (the Emacs 19 version-control interface), # which likes to use RCS as its back end. It was written by Paul Eggert # and revised/documented for use with VC by Eric S. Raymond, Mar 19 1993. case $# in 0) echo "rcs-checkin: usage: rcs-checkin file ..." echo "rcs-checkin: function: checks file.~*~ and file into a new RCS file" echo "rcs-checkin: function: uses the file's first line for the description" esac # expr pattern to extract owner from ls -l output ls_owner_pattern='[^ ][^ ]* *[^ ][^ ]* *\([^ ][^ ]*\)' for file do # Make it easier to say `rcs-checkin *' # by ignoring file names that already contain `~', or end in `,v'. case $file in *~* | *,v) continue esac # Ignore non-files too. test -f "$file" || continue # Check that file is readable. test -r "$file" || exit # If the RCS file does not already exist, # initialize it with a description from $file's first line. rlog -R "$file" >/dev/null 2>&1 || rcs -i -q -t-"`sed 1q $file`" "$file" || exit # Get list of old files. oldfiles=` ls $file.~[0-9]*~ 2>/dev/null | sort -t~ -n +1 ` # Check that they are properly sorted by date. case $oldfiles in ?*) oldfiles_by_date=`ls -rt $file $oldfiles` test " $oldfiles $file" = " $oldfiles_by_date" || { echo >&2 "rcs-checkin: skipping $file, because its mod times are out of order. Sorted by mod time: $oldfiles_by_date Sorted by name: $oldfiles $file" continue } esac echo >&2 rcs-checkin: checking in: $oldfiles $file # Save $file as $file.~-~ temporarily. mv "$file" "$file.~-~" || exit # Rename each old file to $file, and check it in. for oldfile in $oldfiles do mv "$oldfile" "$file" || exit ls_l=`ls -l "$file"` || exit owner=-w`expr " $ls_l" : " $ls_owner_pattern"` || owner= echo "Formerly ${oldfile}" | ci -d -l -q $owner "$file" || exit done # Bring $file back from $file.~-~, and check it in. mv "$file.~-~" "$file" || exit ls_l=`ls -l "$file"` || exit owner=-w`expr " $ls_l" : " $ls_owner_pattern"` || owner= ci -d -q -u $owner -m"entered into RCS" "$file" || exit done emacs-19.30/lib-src/makefile.nt100444 23073 13 21146 6054670573 15230 0ustar voelkeruser# Makefile for GNU Emacs lib-src directory. # Geoff Voelker (voelker@cs.washington.edu) # Copyright (C) 1994 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. */ # # # Sets up the system dependent macros. # !include ..\nt\makefile.def LOCAL_FLAGS = -DWINDOWSNT -DDOS_NT -DSTDC_HEADERS=1 -DNO_LDAV=1 -DNO_ARCHIVES=1 -I..\src OBJDIR = obj BLD = $(OBJDIR)\$(ARCH) LINK_FLAGS = $(ARCH_LDFLAGS) -debug:PARTIAL -machine:$(ARCH) -subsystem:console -entry:mainCRTStartup ALL = $(BLD)\make-docfile.exe \ $(BLD)\hexl.exe \ $(BLD)\wakeup.exe \ $(BLD)\ctags.exe \ $(BLD)\etags.exe # don't know what (if) to do with these yet... # # $(BLD)\sorted-doc.exe \ # $(BLD)\env.exe \ # $(BLD)\server.exe \ # $(BLD)\emacstool.exe \ # $(BLD)\fakemail.exe \ # $(BLD)\leditcfns.exe \ # $(BLD)\movemail.exe \ # $(BLD)\emacsclient.exe \ # $(BLD)\cvtmail.exe \ # $(BLD)\digest-doc.exe \ # $(BLD)\test-distrib.exe \ LIBS = $(BASE_LIBS) $(BLD)\make-docfile.exe: $(BLD)\make-docfile.obj $(BLD)\hexl.exe: $(BLD)\hexl.obj $(BLD)\ctags.exe: $(BLD)\etags.exe copy $(BLD)\etags.exe $(BLD)\ctags.exe $(BLD)\wakeup.exe: $(BLD)\wakeup.obj $(BLD)\ntlib.obj $(LINK) -out:$@ $(LINK_FLAGS) $(BLD)\wakeup.obj $(BLD)\ntlib.obj $(LIBS) make-docfile: $(BLD)\make-docfile.exe wakeup: $(BLD)\wakeup.exe etags: $(BLD)\etags.exe hexl: $(BLD)\hexl.exe ETAGSOBJ = $(BLD)\etags.obj \ $(BLD)\getopt.obj \ $(BLD)\getopt1.obj \ $(BLD)\ntlib.obj $(BLD)\etags.exe: $(ETAGSOBJ) $(LINK) -out:$@ $(LINK_FLAGS) $(ETAGSOBJ) $(LIBS) # # don't know what to do with these yet... # # $(BLD)\sorted-doc.exe: $(LIBS) $(BLD)\sorted-doc.obj # $(BLD)\yow.exe: $(LIBS) $(BLD)\yow.obj # $(BLD)\emacstool.exe: $(LIBS) $(BLD)\emacstool.obj # $(BLD)\env.exe: $(LIBS) $(BLD)\env.obj # $(BLD)\fakemail.exe: $(LIBS) $(BLD)\fakemail.obj # $(BLD)\leditcfns.exe: $(LIBS) $(BLD)\leditcfns.obj # $(BLD)\server.exe: $(LIBS) $(BLD)\server.obj # $(BLD)\wakeup.exe: $(LIBS) $(BLD)\wakeup.obj # $(BLD)\movemail.exe: $(LIBS) $(BLD)\movemail.obj # $(BLD)\cvtmail.exe: $(LIBS) $(BLD)\cvtmail.obj # $(BLD)\digest-doc.exe: $(LIBS) $(BLD)\digest-doc.obj # $(BLD)\emacsclient.exe: $(LIBS) $(BLD)\emacsclient.obj # $(BLD)\qsort.exe: $(LIBS) $(BLD)\qsort.obj # $(BLD)\test-distrib.exe: $(LIBS) $(BLD)\test-distrib.obj # # From ..\src\makefile.nt. # obj = abbrev.c alloc.c alloca.c buffer.c bytecode.c callint.c callproc.c casefiddle.c cm.c cmds.c data.c dired.c dispnew.c doc.c doprnt.c editfns.c eval.c fileio.c filelock.c filemode.c fns.c indent.c insdel.c keyboard.c keymap.c lastfile.c lread.c macros.c marker.c minibuf.c xfaces.c mocklisp.c nt.c ntheap.c ntinevt.c ntproc.c ntterm.c print.c process.c regex.c scroll.c search.c syntax.c sysdep.c term.c termcap.c tparam.c undo.c unexnt.c window.c xdisp.c casetab.c floatfns.c frame.c gmalloc.c intervals.c ralloc.c textprop.c vm-limit.c region-cache.c strftime.c w32term.c w32xfns.c w32fns.c w32faces.c w32select.c w32menu.c w32reg.c lispdir = ..\lisp # # These are the lisp files that are loaded up in loadup.el # lisp= \ $(lispdir)\subr.elc \ $(lispdir)\byte-run.elc \ $(lispdir)\map-ynp.elc \ $(lispdir)\loaddefs.el \ $(lispdir)\simple.elc \ $(lispdir)\help.elc \ $(lispdir)\files.elc \ $(lispdir)\format.elc \ $(lispdir)\indent.elc \ $(lispdir)\window.elc \ $(lispdir)\frame.elc \ $(lispdir)\mouse.elc \ $(lispdir)\menu-bar.elc \ $(lispdir)\scroll-bar.elc \ $(lispdir)\select.elc \ $(lispdir)\paths.el \ $(lispdir)\startup.elc \ $(lispdir)\lisp.elc \ $(lispdir)\page.elc \ $(lispdir)\register.elc \ $(lispdir)\paragraphs.elc \ $(lispdir)\lisp-mode.elc \ $(lispdir)\text-mode.elc \ $(lispdir)\fill.elc \ $(lispdir)\c-mode.elc \ $(lispdir)\isearch.elc \ $(lispdir)\replace.elc \ $(lispdir)\abbrev.elc \ $(lispdir)\buff-menu.elc \ $(lispdir)\ls-lisp.elc \ $(lispdir)\winnt.elc \ $(lispdir)\float-sup.elc \ $(lispdir)\vc-hooks.elc \ $(lispdir)\version.el DOC = DOC $(DOC): $(BLD)\make-docfile.exe - del $(DOC) $(BLD)\make-docfile -d ..\src $(obj) > $(DOC) $(BLD)\make-docfile -d ..\src $(lisp) >> $(DOC) $(CP) $(DOC) ..\etc\DOC-X - mkdir ..\src\$(OBJDIR) - mkdir ..\src\$(OBJDIR)\etc $(CP) $(DOC) ..\src\$(OBJDIR)\etc\DOC-X {$(BLD)}.obj{$(BLD)}.exe: $(LINK) -out:$@ $(LINK_FLAGS) $*.obj $(LIBS) .c{$(BLD)}.obj: $(CC) $(CFLAGS) -Fo$@ $< # # Build the executables # all: $(BLD) $(ALL) $(DOC) # # Assuming INSTALL_DIR is defined, build and install emacs in it. # INSTALL_FILES = $(ALL) install: $(INSTALL_FILES) - mkdir $(INSTALL_DIR)\bin $(CP) $(BLD)\etags.exe $(INSTALL_DIR)\bin $(CP) $(BLD)\ctags.exe $(INSTALL_DIR)\bin $(CP) $(BLD)\hexl.exe $(INSTALL_DIR)\bin $(CP) $(BLD)\wakeup.exe $(INSTALL_DIR)\bin - mkdir $(INSTALL_DIR)\etc $(CP) $(DOC) $(INSTALL_DIR)\etc # # Maintenance # clean:; - del *~ *.pdb - $(DEL_TREE) deleted - $(DEL_TREE) obj - del DOC* # # Headers we would preprocess if we could. # ..\src\config.h: ..\nt\$(CONFIG_H) $(CP) $** $@ ..\src\paths.h: ..\nt\paths.h $(CP) $** $@ ### DEPENDENCIES ### EMACS_ROOT = .. SRC = . $(BLD)\alloca.obj : \ $(SRC)\alloca.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(EMACS_ROOT)\src\blockinput.h $(BLD)\b2m.obj : \ $(SRC)\b2m.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\lib-src\..\src\config.h $(BLD)\cvtmail.obj : \ $(SRC)\cvtmail.c $(BLD)\digest-doc.obj : \ $(SRC)\digest-doc.c $(BLD)\emacsclient.obj : \ $(SRC)\emacsclient.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\lib-src\..\src\config.h $(BLD)\emacsserver.obj : \ $(SRC)\emacsserver.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\lib-src\..\src\config.h \ $(EMACS_ROOT)\nt\inc\sys\file.h $(BLD)\emacstool.obj : \ $(SRC)\emacstool.c \ $(EMACS_ROOT)\nt\inc\sys\file.h $(BLD)\etags.obj : \ $(SRC)\etags.c \ $(EMACS_ROOT)\nt\inc\sys\param.h \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\lib-src\..\src\config.h \ $(SRC)\getopt.h $(BLD)\fakemail.obj : \ $(SRC)\fakemail.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\lib-src\..\src\config.h \ $(EMACS_ROOT)\nt\inc\pwd.h $(BLD)\getdate.obj : \ $(SRC)\getdate.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(MSTOOLS_SYS)\types.h $(BLD)\getopt.obj : \ $(SRC)\getopt.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\getopt.h $(BLD)\getopt1.obj : \ $(SRC)\getopt1.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h \ $(SRC)\getopt.h $(BLD)\hexl.obj : \ $(SRC)\hexl.c $(BLD)\leditcfns.obj : \ $(SRC)\leditcfns.c $(BLD)\make-docfile.obj : \ $(SRC)\make-docfile.c \ $(EMACS_ROOT)\src\config.h $(BLD)\make-path.obj : \ $(SRC)\make-path.c $(BLD)\movemail.obj : \ $(SRC)\movemail.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\lib-src\..\src\config.h \ $(EMACS_ROOT)\nt\inc\sys\file.h \ $(EMACS_ROOT)\src\vmsproc.h \ $(EMACS_ROOT)\lib-src\..\src\syswait.h \ $(EMACS_ROOT)\nt\inc\pwd.h $(BLD)\profile.obj : \ $(SRC)\profile.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\lib-src\..\src\config.h \ $(EMACS_ROOT)\src\vmstime.h \ $(EMACS_ROOT)\lib-src\..\src\systime.h $(BLD)\qsort.obj : \ $(SRC)\qsort.c $(BLD)\sorted-doc.obj : \ $(SRC)\sorted-doc.c $(BLD)\tcp.obj : \ $(SRC)\tcp.c $(BLD)\test-distrib.obj : \ $(SRC)\test-distrib.c $(BLD)\timer.obj : \ $(SRC)\timer.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\lib-src\..\src\config.h $(BLD)\wakeup.obj : \ $(SRC)\wakeup.c \ $(EMACS_ROOT)\src\s\windowsnt.h \ $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\src\config.h $(BLD)\yow.obj : \ $(SRC)\yow.c \ $(EMACS_ROOT)\lib-src\..\src\paths.h emacs-19.30/oldXMenu/ 40777 12120 1 0 6055530701 12545 5ustar rmsdaemonemacs-19.30/oldXMenu/Activate.c100666 12120 1 35747 6051552171 14607 0ustar rmsdaemon/* $Header: /u/src/emacs/19.0/oldXMenu/RCS/Activate.c,v 1.1 1992/04/11 22:10:17 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ #include "copyright.h" /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuActivate - Maps a given menu to the display and activates * the menu for user selection. The user is allowed to * specify which pane and selection will be current, * the X and Y location of the menu (relative to the * parent window) and the mouse button event mask that * will be used to identify a selection request. * * A menu selection is shown to be current by placing * a highlight box around the selection as the mouse * cursor enters its active region. Inactive selections * will not be highlited. As the mouse cursor moved * from one menu pane to another menu pane the pane being * entered is raised and made current and the pane being * left is lowered. * * Anytime XMenuActivate returns, the p_num and * s_num are left at their last known values (i.e., * the last known current pane and selection indices). * The following are the defined return states: * * 1) If at any time an error occurs the data * pointer is left untouched and XM_FAILURE * is returned. * * 2) When a selection request is received (i.e., * when the specified mouse event occurs) the * data pointer will be set to the data * associated with the particular selection * current at the time of the selection request * and XM_SUCCESS is returned. * * 3) If no selection was current at the time a * selection request is made the data pointer * will be left untouched and XM_NO_SELECT will * be returned. * * 4) If the selection that was current at the time * a selection request is made is not an active * selection the data pointer will be left * untouched and XM_IA_SELECT will be returned. * * Since X processes events in an asynchronous manner * it is likely that XMenuActivate will encounter * a "foreign event" while it is executing. Foreign * events are handled in one of three ways: * * 1) The event is discarded. This is the default * mode and requires no action on the part of the * application. * * 2) The application has identified an asynchronous * event handler that will be called and the * foreign event handed off to it. Note: * AEQ mode disables this mode temporarily. * * 3) The application has enabled asynchronous event * queueing mode. In this mode all foreign events * will be queued up untill XMenuActivate * terminates; at which time they will be * returned to the X event queue. As long as * AEQ mode is enabled any asynchronous event * handler as temporarily disabled. * * Any events encountered while taking down the menu * (i.e., exposure events from occluded windows) will * automatically be returned to the X event queue after * XMenuActivate has cleaned the queue of any of its own * events that are no longer needed. * * Author: Tony Della Fera, DEC * March 12, 1986 * */ #include #include "XMenuInt.h" int XMenuActivate(display, menu, p_num, s_num, x_pos, y_pos, event_mask, data) register Display *display; /* Display to put menu on. */ register XMenu *menu; /* Menu to activate. */ int *p_num; /* Pane number selected. */ int *s_num; /* Selection number selected. */ int x_pos; /* X coordinate of menu position. */ int y_pos; /* Y coordinate of menu position. */ unsigned int event_mask; /* Mouse button event mask. */ char **data; /* Pointer to return data value. */ { int status; /* X routine call status. */ int orig_x; /* Upper left menu origin X coord. */ int orig_y; /* Upper left menu origin Y coord. */ int ret_val; /* Return value. */ register XMPane *p_ptr; /* Current XMPane. */ register XMPane *event_xmp; /* Event XMPane pointer. */ register XMPane *cur_p; /* Current pane. */ register XMSelect *cur_s; /* Current selection. */ XMWindow *event_xmw; /* Event XMWindow pointer. */ XEvent event; /* X input event. */ XEvent peek_event; /* X input peek ahead event. */ Bool selection = False; /* Selection has been made. */ Bool forward = True; /* Moving forward in the pane list. */ Window root, child; int root_x, root_y, win_x, win_y; unsigned int mask; /* * Define and allocate a foreign event queue to hold events * that don't belong to XMenu. These events are later restored * to the X event queue. */ typedef struct _xmeventque { XEvent event; struct _xmeventque *next; } XMEventQue; XMEventQue *feq = NULL; /* Foreign event queue. */ XMEventQue *feq_tmp; /* Foreign event queue temporary. */ /* * If there are no panes in the menu then return failure * because the menu is not initialized. */ if (menu->p_count == 0) { _XMErrorCode = XME_NOT_INIT; return(XM_FAILURE); } /* * Find the desired current pane. */ cur_p = _XMGetPanePtr(menu, *p_num); if (cur_p == NULL) { return(XM_FAILURE); } cur_p->activated = cur_p->active; /* * Find the desired current selection. * If the current selection index is out of range a null current selection * will be assumed and the cursor will be placed in the current pane * header. */ cur_s = _XMGetSelectionPtr(cur_p, *s_num); /* * Compute origin of menu so that cursor is in * Correct pane and selection. */ _XMTransToOrigin(display, menu, cur_p, cur_s, x_pos, y_pos, &orig_x, &orig_y); menu->x_pos = orig_x; /* Store X and Y coords of menu. */ menu->y_pos = orig_y; if (XMenuRecompute(display, menu) == XM_FAILURE) { return(XM_FAILURE); } /* * Flush the window creation queue. * This batches all window creates since lazy evaluation * is more efficient than individual evaluation. * This routine also does an XFlush(). */ if (_XMWinQueFlush(display, menu, cur_p, cur_s) == _FAILURE) { return(XM_FAILURE); } /* * Make sure windows are in correct order (in case we were passed * an already created menu in incorrect order.) */ for(p_ptr = menu->p_list->next; p_ptr != cur_p; p_ptr = p_ptr->next) XRaiseWindow(display, p_ptr->window); for(p_ptr = menu->p_list->prev; p_ptr != cur_p->prev; p_ptr = p_ptr->prev) XRaiseWindow(display, p_ptr->window); /* * Make sure all selection windows are mapped. */ for ( p_ptr = menu->p_list->next; p_ptr != menu->p_list; p_ptr = p_ptr->next ){ XMapSubwindows(display, p_ptr->window); } /* * Synchronize the X buffers and the event queue. * From here on, all events in the queue that don't belong to * XMenu are sent back to the application via an application * provided event handler or discarded if the application has * not provided an event handler. */ XSync(display, 0); /* * Grab the mouse for menu input. */ status = XGrabPointer( display, menu->parent, True, event_mask, GrabModeAsync, GrabModeAsync, None, menu->mouse_cursor, CurrentTime ); if (status == _X_FAILURE) { _XMErrorCode = XME_GRAB_MOUSE; return(XM_FAILURE); } /* * Map the menu panes. */ XMapWindow(display, cur_p->window); for (p_ptr = menu->p_list->next; p_ptr != cur_p; p_ptr = p_ptr->next) XMapWindow(display, p_ptr->window); for (p_ptr = cur_p->next; p_ptr != menu->p_list; p_ptr = p_ptr->next) XMapWindow(display, p_ptr->window); XRaiseWindow(display, cur_p->window); /* Make sure current */ /* pane is on top. */ cur_s = NULL; /* Clear current selection. */ /* * Begin event processing loop. */ while (1) { XNextEvent(display, &event); /* Get next event. */ switch (event.type) { /* Dispatch on the event type. */ case Expose: event_xmp = (XMPane *)XLookUpAssoc(display, menu->assoc_tab, event.xexpose.window); if (event_xmp == NULL) { /* * If AEQ mode is enabled then queue the event. */ if (menu->aeq) { feq_tmp = (XMEventQue *)malloc(sizeof(XMEventQue)); if (feq_tmp == NULL) { _XMErrorCode = XME_CALLOC; return(XM_FAILURE); } feq_tmp->event = event; feq_tmp->next = feq; feq = feq_tmp; } else if (_XMEventHandler) (*_XMEventHandler)(&event); break; } if (event_xmp->activated) { XSetWindowBackground(display, event_xmp->window, menu->bkgnd_color); } else { XSetWindowBackgroundPixmap(display, event_xmp->window, menu->inact_pixmap); } _XMRefreshPane(display, menu, event_xmp); break; case EnterNotify: /* * First wait a small period of time, and see * if another EnterNotify event follows hard on the * heels of this one. i.e., the user is simply * "passing through". If so, ignore this one. */ event_xmw = (XMWindow *)XLookUpAssoc(display, menu->assoc_tab, event.xcrossing.window); if (event_xmw == NULL) break; if (event_xmw->type == SELECTION) { /* * We have entered a selection. */ /* if (XPending(display) == 0) usleep(150000); */ if (XPending(display) != 0) { XPeekEvent(display, &peek_event); if(peek_event.type == LeaveNotify) { break; } } cur_s = (XMSelect *)event_xmw; /* * If the pane we are in is active and the * selection entered is active then activate * the selection. */ if (cur_p->active && cur_s->active > 0) { cur_s->activated = 1; _XMRefreshSelection(display, menu, cur_s); } } else { /* * We have entered a pane. */ /* if (XPending(display) == 0) usleep(150000); */ if (XPending(display) != 0) { XPeekEvent(display, &peek_event); if (peek_event.type == EnterNotify) break; } XQueryPointer(display, menu->parent, &root, &child, &root_x, &root_y, &win_x, &win_y, &mask); event_xmp = (XMPane *)XLookUpAssoc(display, menu->assoc_tab, child); if (event_xmp == NULL) break; if (event_xmp == cur_p) break; if (event_xmp->serial > cur_p->serial) forward = True; else forward = False; p_ptr = cur_p; while (p_ptr != event_xmp) { if (forward) p_ptr = p_ptr->next; else p_ptr = p_ptr->prev; XRaiseWindow(display, p_ptr->window); } if (cur_p->activated) { cur_p->activated = False; XSetWindowBackgroundPixmap(display, cur_p->window, menu->inact_pixmap); _XMRefreshPane(display, menu, cur_p); } if (event_xmp->active) event_xmp->activated = True; #if 1 /* * i suspect the we don't get an EXPOSE event when backing * store is enabled; the menu windows content is probably * not drawn in when it should be in that case. * in that case, this is probably an ugly fix! * i hope someone more familiar with this code would * take it from here. -- caveh@eng.sun.com. */ XSetWindowBackground(display, event_xmp->window, menu->bkgnd_color); _XMRefreshPane(display, menu, event_xmp); #endif cur_p = event_xmp; } break; case LeaveNotify: event_xmw = (XMWindow *)XLookUpAssoc( display, menu->assoc_tab, event.xcrossing.window ); if (event_xmw == NULL) break; if(cur_s == NULL) break; /* * If the current selection was activated then * deactivate it. */ if (cur_s->activated) { cur_s->activated = False; _XMRefreshSelection(display, menu, cur_s); } cur_s = NULL; break; case ButtonPress: case ButtonRelease: *p_num = cur_p->serial; /* * Check to see if there is a current selection. */ if (cur_s != NULL) { /* * Set the selection number to the current selection. */ *s_num = cur_s->serial; /* * If the current selection was activated then * we have a valid selection otherwise we have * an inactive selection. */ if (cur_s->activated) { *data = cur_s->data; ret_val = XM_SUCCESS; } else { ret_val = XM_IA_SELECT; } } else { /* * No selection was current. */ ret_val = XM_NO_SELECT; } selection = True; break; default: /* * If AEQ mode is enabled then queue the event. */ if (menu->aeq) { feq_tmp = (XMEventQue *)malloc(sizeof(XMEventQue)); if (feq_tmp == NULL) { _XMErrorCode = XME_CALLOC; return(XM_FAILURE); } feq_tmp->event = event; feq_tmp->next = feq; feq = feq_tmp; } else if (_XMEventHandler) (*_XMEventHandler)(&event); } /* * If a selection has been made, break out of the event loop. */ if (selection == True) break; } /* * Unmap the menu. */ for ( p_ptr = menu->p_list->next; p_ptr != menu->p_list; p_ptr = p_ptr->next) { XUnmapWindow(display, p_ptr->window); } /* * Ungrab the mouse. */ XUngrabPointer(display, CurrentTime); /* * Restore bits under where the menu was if we managed * to save them and free the pixmap. */ /* * If there is a current selection deactivate it. */ if (cur_s != NULL) cur_s->activated = 0; /* * Deactivate the current pane. */ cur_p->activated = 0; XSetWindowBackgroundPixmap(display, cur_p->window, menu->inact_pixmap); /* * Synchronize the X buffers and the X event queue. */ XSync(display, 0); /* * Dispatch any events remaining on the queue. */ while (QLength(display)) { /* * Fetch the next event. */ XNextEvent(display, &event); /* * Discard any events left on the queue that belong to XMenu. * All others are held and then returned to the event queue. */ switch (event.type) { case Expose: case EnterNotify: case LeaveNotify: case ButtonPress: case ButtonRelease: /* * Does this event belong to one of XMenu's windows? * If so, discard it and process the next event. * If not fall through and treat it as a foreign event. */ event_xmp = (XMPane *)XLookUpAssoc( display, menu->assoc_tab, event.xbutton.window ); if (event_xmp != NULL) continue; default: /* * This is a foreign event. * Queue it for later return to the X event queue. */ feq_tmp = (XMEventQue *)malloc(sizeof(XMEventQue)); if (feq_tmp == NULL) { _XMErrorCode = XME_CALLOC; return(XM_FAILURE); } feq_tmp->event = event; feq_tmp->next = feq; feq = feq_tmp; } } /* * Return any foreign events that were queued to the X event queue. */ while (feq != NULL) { feq_tmp = feq; XPutBackEvent(display, &feq_tmp->event); feq = feq_tmp->next; free((char *)feq_tmp); } /* * Return successfully. */ _XMErrorCode = XME_NO_ERROR; return(ret_val); } emacs-19.30/oldXMenu/AddPane.c100666 12120 1 4645 6051552172 14315 0ustar rmsdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/AddPane.c,v 1.1 1992/04/11 22:10:17 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuAddPane - Adds a pane to an XMenu object. * * Author: Tony Della Fera, DEC * August, 1985 * */ #include #include "XMenuInt.h" int XMenuAddPane(display, menu, label, active) Display *display; register XMenu *menu; /* Menu object to be modified. */ register char *label; /* Selection label. */ int active; /* Make selection active? */ { register XMPane *pane; /* Newly created pane. */ register XMSelect *select; /* Initial selection for the new pane. */ int label_length; /* Label length in characters. */ int label_width; /* Label width in pixels. */ /* * Check for NULL pointers! */ if (label == NULL) { _XMErrorCode = XME_ARG_BOUNDS; return(XM_FAILURE); } /* * Calloc the XMPane structure and the initial XMSelect. */ pane = (XMPane *)calloc(1, sizeof(XMPane)); if (pane == NULL) { _XMErrorCode = XME_CALLOC; return(XM_FAILURE); } select = (XMSelect *)calloc(1, sizeof(XMSelect)); if (select == NULL) { _XMErrorCode = XME_CALLOC; return(XM_FAILURE); } /* * Determine label size. */ label_length = strlen(label); label_width = XTextWidth(menu->p_fnt_info, label, label_length); /* * Set up the initial selection. * Values not explicitly set are zeroed by calloc. */ select->next = select; select->prev = select; select->type = SL_HEADER; select->serial = -1; select->parent_p = pane; /* * Fill the XMPane structure. * X and Y position are set to 0 since a recompute will follow. */ pane->type = PANE; pane->active = active; pane->serial = -1; pane->label = label; pane->label_width = label_width; pane->label_length = label_length; pane->s_list = select; /* * Insert the pane at the end of the pane list. */ emacs_insque(pane, menu->p_list->prev); /* * Update the pane count. */ menu->p_count++; /* * Schedule a recompute. */ menu->recompute = 1; /* * Return the pane number just added. */ _XMErrorCode = XME_NO_ERROR; return((menu->p_count - 1)); } emacs-19.30/oldXMenu/AddSel.c100666 12120 1 4353 6051552173 14152 0ustar rmsdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/AddSel.c,v 1.1 1992/04/11 22:10:17 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuAddSelection - Adds a selection to an XMenu object. * * Author: Tony Della Fera, DEC * August, 1985 * */ #include #include "XMenuInt.h" int XMenuAddSelection(display, menu, p_num, data, label, active) Display *display; register XMenu *menu; /* Menu object to be modified. */ register int p_num; /* Pane number to be modified. */ char *data; /* Data value. */ char *label; /* Selection label. */ int active; /* Make selection active? */ { register XMPane *pane; /* Pane containing the new selection. */ register XMSelect *select; /* Newly created selection. */ int label_length; /* Label lenght in characters. */ int label_width; /* Label width in pixels. */ /* * Check for NULL pointers! */ if (label == NULL) { _XMErrorCode = XME_ARG_BOUNDS; return(XM_FAILURE); } /* * Find the right pane. */ pane = _XMGetPanePtr(menu, p_num); if (pane == NULL) return(XM_FAILURE); /* * Calloc the XMSelect structure. */ select = (XMSelect *)calloc(1, sizeof(XMSelect)); if (select == NULL) { _XMErrorCode = XME_CALLOC; return(XM_FAILURE); } /* * Determine label size. */ label_length = strlen(label); label_width = XTextWidth(menu->s_fnt_info, label, label_length); /* * Fill the XMSelect structure. */ select->type = SELECTION; select->active = active; select->serial = -1; select->label = label; select->label_width = label_width; select->label_length = label_length; select->data = data; select->parent_p = pane; /* * Insert the selection at the end of the selection list. */ emacs_insque(select, pane->s_list->prev); /* * Update the selection count. */ pane->s_count++; /* * Schedule a recompute. */ menu->recompute = 1; /* * Return the selection number just added. */ _XMErrorCode = XME_NO_ERROR; return((pane->s_count - 1)); } emacs-19.30/oldXMenu/ChgPane.c100666 13437 1 2726 5730423743 14464 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/ChgPane.c,v 1.1 1992/04/11 22:10:17 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuChangePane - Change the label of a menu pane. * * Author: Tony Della Fera, DEC * December 19, 1985 * */ #include "XMenuInt.h" int XMenuChangePane(menu, p_num, label) register XMenu *menu; /* Menu object to be modified. */ register int p_num; /* Pane number to be modified. */ char *label; /* Selection label. */ { register XMPane *p_ptr; /* XMPane pointer. */ int label_length; /* Label lenght in characters. */ int label_width; /* Label width in pixels. */ /* * Check for NULL pointers! */ if (label == NULL) { _XMErrorCode = XME_ARG_BOUNDS; return(XM_FAILURE); } /* * Find the right pane. */ p_ptr = _XMGetPanePtr(menu, p_num); if (p_ptr == NULL) return(XM_FAILURE); /* * Determine label size. */ label_length = strlen(label); label_width = XTextWidth(menu->p_fnt_info, label, label_length); /* * Change the pane data. */ p_ptr->label = label; p_ptr->label_width = label_width; p_ptr->label_length = label_length; /* * Schedule a recompute. */ menu->recompute = 1; /* * Return the pane number just changed. */ _XMErrorCode = XME_NO_ERROR; return(p_num); } emacs-19.30/oldXMenu/ChgSel.c100666 13437 1 4021 5730423744 14313 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/ChgSel.c,v 1.1 1992/04/11 22:10:17 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuChangeSelection - Change a menu selection. * * Author: Tony Della Fera, DEC * December 19, 1985 * */ #include "XMenuInt.h" int XMenuChangeSelection(display, menu, p_num, s_num, data, data_sw, label, label_sw) Display *display; /* previously opened display. */ register XMenu *menu; /* Menu object to be modified. */ register int p_num; /* Pane number to be modified. */ register int s_num; /* Selection number to modified. */ char *data; /* Data value. */ int data_sw; /* Change to new data value? */ char *label; /* Selection label. */ int label_sw; /* Change to new label? */ { register XMPane *p_ptr; /* XMPane pointer. */ register XMSelect *s_ptr; /* XMSelect pointer. */ int label_length; /* Label lenght in characters. */ int label_width; /* Label width in pixels. */ /* * Check for NULL pointers! */ if (label == NULL) { _XMErrorCode = XME_ARG_BOUNDS; return(XM_FAILURE); } /* * Find the right pane. */ p_ptr = _XMGetPanePtr(menu, p_num); if (p_ptr == NULL) return(XM_FAILURE); /* * Find the right selection. */ s_ptr = _XMGetSelectionPtr(p_ptr, s_num); if (s_ptr == NULL) return(XM_FAILURE); /* * Reset the label? */ if (label_sw) { /* * Determine label size. */ label_length = strlen(label); label_width = XTextWidth(menu->s_fnt_info, label, label_length); /* * Change the selection data. */ s_ptr->label = label; s_ptr->label_width = label_width; s_ptr->label_length = label_length; /* * Schedule a recompute. */ menu->recompute = 1; } /* * Reset the data? */ if (data_sw) s_ptr->data = data; /* * Return successfully. */ _XMErrorCode = XME_NO_ERROR; return(s_num); } emacs-19.30/oldXMenu/Create.c100666 12120 1 51764 6051552174 14252 0ustar rmsdaemon/* $Header: /u/src/emacs/19.0/oldXMenu/RCS/Create.c,v 1.4 1993/03/09 18:18:01 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ #include "copyright.h" /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuCreate - Creates an X window system menu object. * * Author: Tony Della Fera, DEC * January 23, 1986 * */ #include #include "XMenuInt.h" #ifdef EMACS_BITMAP_FILES #include "../src/bitmaps/dimple1.xbm" #include "../src/bitmaps/dimple3.xbm" #include "../src/bitmaps/gray1.xbm" #include "../src/bitmaps/gray3.xbm" #include "../src/bitmaps/crosswv.xbm" #include "../src/bitmaps/leftptr.xbm" #include "../src/bitmaps/leftpmsk.xbm" #include "../src/bitmaps/rtptr.xbm" #include "../src/bitmaps/rtpmsk.xbm" #include "../src/bitmaps/cntrptr.xbm" #include "../src/bitmaps/cntrpmsk.xbm" #include "../src/bitmaps/stipple.xbm" #else #ifndef VMS #include #include #include #include #include #include #include #include #include #include #include #include #else #include "[-.src.bitmaps]dimple1.xbm" #include "[-.src.bitmaps]dimple3.xbm" #include "[-.src.bitmaps]gray1.xbm" #include "[-.src.bitmaps]gray3.xbm" #include "[-.src.bitmaps]crosswv.xbm" #include "[-.src.bitmaps]leftptr.xbm" #include "[-.src.bitmaps]leftpmsk.xbm" #include "[-.src.bitmaps]rtptr.xbm" #include "[-.src.bitmaps]rtpmsk.xbm" #include "[-.src.bitmaps]cntrptr.xbm" #include "[-.src.bitmaps]cntrpmsk.xbm" #include "[-.src.bitmaps]stipple.xbm" #endif /* VMS */ #endif /* not EMACS_BITMAP_FILES */ #define DEF_FREEZE 0 #define DEF_REVERSE 0 #define DEF_MENU_STYLE LEFT #define DEF_MENU_MODE BOX #define DEF_INACT_PNUM 3 #define MAX_INACT_PNUM 4 #define DEF_P_STYLE CENTER #define DEF_P_EVENTS (EnterWindowMask | ExposureMask) #define DEF_P_FNT_NAME "fixed" #define DEF_P_SPREAD 0.5 #define DEF_P_BDR_WIDTH 2 #define DEF_S_STYLE LEFT #define DEF_S_EVENTS (EnterWindowMask | LeaveWindowMask) #define DEF_S_FNT_NAME "fixed" #define DEF_S_SPREAD 0.10 #define DEF_S_BDR_WIDTH 1 #define XASSOC_TABLE_SIZE 64 #define TILE_BUF_SIZE 5 int atoi(); double atof(); char *x_get_resource_string (); static Status XAllocDisplayColor(display, map, colorName, color, junk) Display *display; Colormap map; char *colorName; XColor *color; XColor *junk; { return (colorName!=0 && XParseColor(display, map, colorName, color) && XAllocColor(display, map, color)); } XMenu * XMenuCreate(display, parent, def_env) Display *display; /* ID of previously opened display */ Window parent; /* Window ID of the menu's parent window. */ register char *def_env; /* X Defaults program environment name. */ { register int i; /* Loop counter. */ register int j; /* Loop counter. */ register char *def_val; /* X Default value temp variable. */ register XMenu *menu; /* Pointer to the new menu. */ XMStyle menu_style; /* Menu display style. */ XMMode menu_mode; /* Menu display mode. */ XMPane *pane; /* Pane list header. */ XAssocTable *assoc_tab; /* XAssocTable pointer. */ int freeze; /* Freeze server mode. */ int reverse; /* Reverse video mode. */ XMStyle p_style; /* Pane display style. */ char *p_fnt_name; /* Flag font name. */ XFontStruct *p_fnt_info; /* Flag font structure */ int p_fnt_pad; /* Flag font padding in pixels. */ double p_spread; /* Pane spread in flag height fractions. */ int p_fnt_height; /* Pane character height. */ int p_bdr_width; /* Pane border width. */ int flag_height; /* Flag window height. */ int p_height; /* Pane window height. */ int p_x_off; /* Pane X offset. */ int p_y_off; /* Pane Y offset. */ GC pane_GC; /* Pane graphics context. */ XMStyle s_style; /* Selection display style. */ char *s_fnt_name; /* Selection font name. */ XFontStruct *s_fnt_info; /* Selection font structure. */ int s_fnt_pad; /* Selection font padding in pixels. */ int s_fnt_height; /* Selection font character height */ double s_spread; /* Select spread in line height fractions. */ int s_bdr_width; /* Highlight border width. */ int s_height; /* Selection window height. */ int s_x_off; /* Selection window X offset. */ int s_y_off; /* Selection window Y offset. */ GC normal_select_GC; /* GC used for normal video selection. */ GC inverse_select_GC; /* GC used for inverse video selection. */ GC inact_GC; /* GC for inactive pane header and */ /* selections. */ GC inact_GC_noexpose; XColor color_def; /* Temp color definition holder. */ XColor screen_def; /* Temp screen color definition holder */ XColor p_bdr_color; /* Color of border. */ XColor s_bdr_color; /* Color of highlight. */ XColor p_frg_color; /* Color of pane foreground color. */ XColor s_frg_color; /* Color of selection foreground. */ XColor bkgnd_color; /* Color of background.. */ XColor mouse_color; /* Color of mouse cursor. */ Cursor mouse_cursor; /* Mouse cursor. */ Pixmap inact_bitmap; /* Menu inactive pixmap. */ int inact_pnum; /* Inactive background pattern number. */ Pixel p_bdr_pixel; /* Pane border pixel. */ Pixel s_bdr_pixel; /* Selection border pixel. */ Pixel p_frg_pixel; /* Pane foreground pixel. */ Pixel s_frg_pixel; /* Selection foreground pixel. */ Pixel bkgnd_pixel; /* Menu background pixel. */ int *width, *height; Pixmap *bitmap; int *x_hot, *y_hot; int status; /* Return code from XReadBitmapFile. */ Pixmap cursor; /* Cursor pixmap holder. */ Pixmap cursor_mask; /* Cursor mask pixmap holder. */ Pixmap stipple_pixmap; /* Stippple mask for half-tone text. */ unsigned long valuemask; XGCValues *values; Window root = RootWindow (display, DefaultScreen (display)); /* * Calloc the XMenu structure and the initial pane. */ menu = (XMenu *)calloc(1, sizeof(XMenu)); if (menu == NULL) { _XMErrorCode = XME_CALLOC; return(NULL); } pane = (XMPane *)calloc(1, sizeof(XMPane)); if (pane == NULL) { _XMErrorCode = XME_CALLOC; return(NULL); } /* * Create the XAssocTable */ assoc_tab = (XAssocTable *)XCreateAssocTable(XASSOC_TABLE_SIZE); if(assoc_tab == NULL) { _XMErrorCode= XME_CREATE_ASSOC; return(NULL); } /* * Set up the default environment name. */ if (def_env == NULL || *def_env == '\0') def_env = "XMenu"; /* * Set up internal fail-safe defaults. */ freeze = DEF_FREEZE; reverse = DEF_REVERSE; menu_style = DEF_MENU_STYLE; menu_mode = DEF_MENU_MODE; inact_pnum = DEF_INACT_PNUM; p_style = DEF_P_STYLE; p_spread = DEF_P_SPREAD; p_fnt_name = DEF_P_FNT_NAME; p_bdr_width = DEF_P_BDR_WIDTH; s_style = DEF_S_STYLE; s_spread = DEF_S_SPREAD; s_fnt_name = DEF_S_FNT_NAME; s_bdr_width = DEF_S_BDR_WIDTH; /* * Get default values from X. */ def_val = x_get_resource_string ("menuFreeze", "MenuFreeze"); if (def_val != NULL) { if (strcmp(def_val, "on") == 0) freeze = 1; else if (strcmp(def_val, "off") == 0) freeze = 0; } def_val = x_get_resource_string ("menuReverseVideo", "MenuReverseVideo"); if (def_val != NULL) { if (strcmp(def_val, "on") == 0) reverse = 1; else if (strcmp(def_val, "off") == 0) reverse = 0; } def_val = x_get_resource_string ("menuStyle", "MenuStyle"); if (def_val != NULL) { if (strcmp(def_val, "right_hand") == 0) menu_style = RIGHT; else if (strcmp(def_val, "left_hand") == 0) menu_style = LEFT; else if (strcmp(def_val, "center") == 0) menu_style = CENTER; } def_val = x_get_resource_string ("menuMode", "MenuMode"); if (def_val != NULL) { if (strcmp(def_val, "box") == 0) menu_mode = BOX; else if (strcmp(def_val, "invert") == 0) menu_mode = INVERT; } def_val = x_get_resource_string ("menuMouse", "MenuMouse"); if ( def_val != NULL && DisplayCells(display, DefaultScreen(display)) > 2 && XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), def_val, &mouse_color, &color_def) ); else if (reverse && XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), "white", &mouse_color, &color_def) ); else if (XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), "black", &mouse_color, &color_def) ); else ; def_val = x_get_resource_string ("menuBackground", "MenuBackground"); if ( def_val != NULL && DisplayCells(display, DefaultScreen(display)) > 2 && XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), def_val, &bkgnd_color, &color_def) ); else if (reverse && XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), "black", &bkgnd_color, &color_def) ); else if (XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), "white", &bkgnd_color, &color_def) ); else; def_val = x_get_resource_string ("menuInactivePattern", "MenuInactivePattern"); if (def_val != NULL) { if (strcmp(def_val, "dimple1") == 0) inact_pnum = 0; else if (strcmp(def_val, "dimple3") == 0) inact_pnum = 1; else if (strcmp(def_val, "gray1") == 0) inact_pnum = 2; else if (strcmp(def_val, "gray3") == 0) inact_pnum = 3; else if (strcmp(def_val, "cross_weave") == 0) inact_pnum = 4; } def_val = x_get_resource_string ("paneStyle", "PaneStyle"); if (def_val != NULL) { if (strcmp(def_val, "flush_left") == 0) p_style = LEFT; else if (strcmp(def_val, "flush_right") == 0) p_style = RIGHT; else if (strcmp(def_val, "center") == 0) p_style = CENTER; } def_val = x_get_resource_string ("paneFont", "PaneFont"); if (def_val != NULL) p_fnt_name = def_val; def_val = x_get_resource_string ("paneForeground", "PaneForeground"); if ( def_val != NULL && DisplayCells(display, DefaultScreen(display)) > 2 ) XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), def_val, &p_frg_color, &color_def); else if (reverse) XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), "white", &p_frg_color, &color_def); else XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), "black", &p_frg_color, &color_def); def_val = x_get_resource_string ("paneBorder", "PaneBorder"); if ( def_val != NULL && DisplayCells(display, DefaultScreen(display)) > 2 && XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), def_val, &p_bdr_color, &color_def) ); else if (reverse && XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), "white", &p_bdr_color, &color_def) ); else XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), "black", &p_bdr_color, &color_def); def_val = x_get_resource_string ("paneBorderWidth", "PaneBorderWidth"); if (def_val != NULL) p_bdr_width = atoi(def_val); def_val = x_get_resource_string ("paneSpread", "PaneSpread"); if (def_val != NULL) p_spread = atof(def_val); def_val = x_get_resource_string ("selectionStyle", "SelectionStyle"); if (def_val != NULL) { if (strcmp(def_val, "flush_left") == 0) s_style = LEFT; else if (strcmp(def_val, "flush_right") == 0) s_style = RIGHT; else if (strcmp(def_val, "center") == 0) s_style = CENTER; } def_val = x_get_resource_string ("selectionFont", "SelectionFont"); if (def_val != NULL) s_fnt_name = def_val; def_val = x_get_resource_string ("selectionForeground", "SelectionForeground"); if ( def_val != NULL && DisplayCells(display, DefaultScreen(display)) > 2 && XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), def_val, &s_frg_color, &color_def) ); else if (reverse && XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), "white", &s_frg_color, &color_def) ) ; else if (XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), "black", &s_frg_color, &color_def) ) ; else ; def_val = x_get_resource_string ("selectionBorder", "SelectionBorder"); if ( def_val != NULL && DisplayCells(display, DefaultScreen(display)) > 2 && XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), def_val, &s_bdr_color, &color_def) ) ; else if (reverse && XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), "white", &s_bdr_color, &color_def) ) ; else if (XAllocDisplayColor(display, DefaultColormap(display, DefaultScreen(display)), "black", &s_bdr_color, &color_def) ) ; else ; def_val = x_get_resource_string ("selectionBorderWidth", "SelectionBorderWidth"); if (def_val != NULL) s_bdr_width = atoi(def_val); def_val = x_get_resource_string ("selectionSpread", "SelectionSpread"); if (def_val != NULL) s_spread = atof(def_val); /* * Create and store the inactive pattern pixmap. */ { char *data = NULL; int width, height; switch (inact_pnum) { case 0: data = (char *)dimple1_bits; width = dimple1_width; height = dimple1_height; break; case 1: data = (char *)dimple3_bits; width = dimple3_width; height = dimple3_height; break; case 2: data = (char *)gray1_bits; width = gray1_width; height = gray1_height; break; case 3: data = (char *)gray3_bits; width = gray3_width; height = gray3_height; break; case 4: data = (char *)cross_weave_bits; width = cross_weave_width; height = cross_weave_height; break; } if (! data) { _XMErrorCode = XME_STORE_BITMAP; return(NULL); } inact_bitmap = XCreatePixmapFromBitmapData (display, root, data, width, height, p_frg_color.pixel, bkgnd_color.pixel, DisplayPlanes (display, DefaultScreen (display))); } /* * Load the mouse cursor. */ switch (menu_style) { case LEFT: cursor = XCreateBitmapFromData(display, root, left_ptr_bits, left_ptr_width, left_ptr_height); cursor_mask = XCreateBitmapFromData(display, root, left_ptrmsk_bits, left_ptrmsk_width, left_ptrmsk_height); mouse_cursor = XCreatePixmapCursor( display, cursor, cursor_mask, &mouse_color, &bkgnd_color, left_ptr_x_hot, left_ptr_y_hot ); XFreePixmap(display, cursor); XFreePixmap(display, cursor_mask); break; case RIGHT: cursor = XCreateBitmapFromData(display, root, right_ptr_bits, right_ptr_width, right_ptr_height); cursor_mask = XCreateBitmapFromData(display, root, right_ptrmsk_bits, right_ptrmsk_width, right_ptrmsk_height); mouse_cursor = XCreatePixmapCursor( display, cursor, cursor_mask, &mouse_color, &bkgnd_color, right_ptr_x_hot, right_ptr_y_hot ); XFreePixmap(display, cursor); XFreePixmap(display, cursor_mask); break; case CENTER: cursor = XCreateBitmapFromData(display, root, cntr_ptr_bits, cntr_ptr_width, cntr_ptr_height); cursor_mask = XCreateBitmapFromData(display, root, cntr_ptrmsk_bits, cntr_ptrmsk_width, cntr_ptrmsk_height); mouse_cursor = XCreatePixmapCursor( display, cursor, cursor_mask, &mouse_color, &bkgnd_color, cntr_ptr_x_hot, cntr_ptr_y_hot ); XFreePixmap(display, cursor); XFreePixmap(display, cursor_mask); break; default: /* Error! Invalid style parameter. */ _XMErrorCode = XME_STYLE_PARAM; return(NULL); } if (mouse_cursor == _X_FAILURE) { _XMErrorCode = XME_CREATE_CURSOR; return(NULL); } /* * Open the pane and selection fonts. */ p_fnt_info = XLoadQueryFont(display, p_fnt_name); if (p_fnt_info == NULL) { _XMErrorCode = XME_OPEN_FONT; return(NULL); } s_fnt_info = XLoadQueryFont(display, s_fnt_name); if (s_fnt_info == NULL) { _XMErrorCode = XME_OPEN_FONT; return(NULL); } /* * Calculate the fixed padding value in pixels for each font. */ p_fnt_height = p_fnt_info->max_bounds.ascent + p_fnt_info->max_bounds.descent; s_fnt_height = s_fnt_info->max_bounds.ascent + s_fnt_info->max_bounds.descent; p_fnt_pad = s_spread * p_fnt_height; s_fnt_pad = s_spread * s_fnt_height; /* * Calculate fixed height and offset requirements. */ flag_height = p_fnt_height + (p_fnt_pad << 1); p_height = 0; p_y_off = flag_height + p_bdr_width; p_x_off = p_y_off * p_spread; s_height = s_fnt_height + (s_fnt_pad << 1) + (s_bdr_width << 1); s_y_off = s_height; s_x_off = p_x_off; /* * Set up the pane list header. */ pane->next = pane; pane->prev = pane; pane->type = PL_HEADER; pane->serial = -1; /* * Initialize the internal pane and selection creation queues. */ _XMWinQueInit(); /* * Create pane, active, and inactive GC's. */ values = (XGCValues *)malloc(sizeof(XGCValues)); valuemask = (GCForeground | GCBackground | GCFont | GCLineWidth); /* * First, pane. */ values->foreground = p_frg_color.pixel; values->background = bkgnd_color.pixel; values->font = p_fnt_info->fid; values->line_width = p_bdr_width; pane_GC = XCreateGC( display, root, valuemask, values); /* * Then normal video selection. */ values->foreground = s_frg_color.pixel; values->background = bkgnd_color.pixel; values->font = s_fnt_info->fid; values->line_width = s_bdr_width; normal_select_GC = XCreateGC(display, root, valuemask, values); /* * Inverse video selection. */ values->foreground = bkgnd_color.pixel; values->background = s_frg_color.pixel; values->font = s_fnt_info->fid; values->line_width = s_bdr_width; inverse_select_GC = XCreateGC(display, root, valuemask, values); stipple_pixmap = XCreateBitmapFromData(display, root, stipple_bits, stipple_width, stipple_height); /* * Finally, inactive pane header and selections */ valuemask |= (GCFillStyle | GCStipple); values->foreground = s_frg_color.pixel; values->background = bkgnd_color.pixel; values->font = s_fnt_info->fid; values->line_width = s_bdr_width; values->fill_style = FillStippled; values->stipple = stipple_pixmap; inact_GC = XCreateGC(display, root, valuemask, values); valuemask |= (GCGraphicsExposures); values->graphics_exposures = False; inact_GC_noexpose = XCreateGC (display, root, valuemask, values); /* * Construct the XMenu object. */ /* -------------------- Menu data -------------------- */ menu->menu_style = menu_style; menu->menu_mode = menu_mode; menu->freeze = freeze; menu->aeq = 0; menu->recompute = 1; menu->parent = parent; menu->height = 0; menu->width = 0; menu->mouse_cursor = mouse_cursor; menu->assoc_tab = assoc_tab; menu->p_list = pane; /* -------------------- Pane window data -------------------- */ menu->p_style = p_style; menu->p_events = DEF_P_EVENTS; menu->p_fnt_info = p_fnt_info; menu->p_fnt_pad = p_fnt_pad; menu->p_spread = p_spread; menu->p_bdr_width = p_bdr_width; menu->flag_height = flag_height; menu->p_width = 0; menu->p_height = p_height; menu->p_x_off = p_x_off; menu->p_y_off = p_y_off; menu->p_count = 0; menu->pane_GC = pane_GC; menu->x_pos = 0; menu->y_pos = 0; /* -------------------- Selection window data -------------------- */ menu->s_style = s_style; menu->s_events = DEF_S_EVENTS; menu->s_fnt_info = s_fnt_info; menu->s_fnt_pad = s_fnt_pad; menu->s_spread = s_spread; menu->s_bdr_width = s_bdr_width; /* unnecessary */ menu->s_width = 0; menu->s_height = s_height; menu->s_x_off = s_x_off; menu->s_y_off = s_y_off; menu->s_count = 0; menu->normal_select_GC = normal_select_GC; menu->inverse_select_GC = inverse_select_GC; menu->inact_GC = inact_GC; /* -------------------- Color data -------------------- */ menu->p_bdr_color = p_bdr_color.pixel; menu->s_bdr_color = s_bdr_color.pixel; menu->p_frg_color = p_frg_color.pixel; menu->s_frg_color = s_frg_color.pixel; menu->bkgnd_color = bkgnd_color.pixel; /* -------------------- Pixmap data -------------------- */ menu->p_bdr_pixmap = None; menu->s_bdr_pixmap = None; menu->p_frg_pixmap = None; menu->s_frg_pixmap = None; menu->bkgnd_pixmap = None; menu->inact_pixmap = inact_bitmap; /* * Return the completed XMenu. */ _XMErrorCode = XME_NO_ERROR; return(menu); } emacs-19.30/oldXMenu/DelPane.c100666 13437 1 4001 5730423744 14454 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/DelPane.c,v 1.1 1992/04/11 22:10:18 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuDeletePane - Deletes a pane from an XMenu object. * * Author: Tony Della Fera, DEC * 20-Nov-85 * */ #include "XMenuInt.h" int XMenuDeletePane(display, menu, p_num) register Display *display; /* Previously opened display */ register XMenu *menu; /* Menu object to be modified. */ register int p_num; /* Pane number to be deleted. */ { register XMPane *p_ptr; /* Pointer to pane being deleted. */ register XMSelect *s_ptr; /* Pointer to selections being deleted. */ register XMSelect *s_next; /* Pointer to next selection to be deleted. */ /* * Find the right pane. */ p_ptr = _XMGetPanePtr(menu, p_num); if (p_ptr == NULL) return(XM_FAILURE); /* * Remove the pane from the association table. */ XDeleteAssoc(display, menu->assoc_tab, p_ptr->window); /* * Remove the pane from the pane list and update * the pane count. */ emacs_remque(p_ptr); menu->p_count--; /* * Remove all the selections in the pane from the * association table and free their XMSelect structures. */ for ( s_ptr = p_ptr->s_list->next; s_ptr != p_ptr->s_list; s_ptr = s_next ) { XDeleteAssoc(display, menu->assoc_tab, s_ptr->window); s_next = s_ptr->next; free(s_ptr); } free(p_ptr->s_list); if (p_ptr->window) { /* * Destroy the selection transparencies. */ XDestroySubwindows(display, p_ptr->window); /* * Destroy the pane window. */ XDestroyWindow(display, p_ptr->window); } /* * Free the pane's XMPane structure. */ free(p_ptr); /* * Schedule a recompute. */ menu->recompute = 1; /* * Return the pane number just deleted. */ _XMErrorCode = XME_NO_ERROR; return(p_num); } emacs-19.30/oldXMenu/DelSel.c100666 13437 1 3415 5730423745 14325 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/DelSel.c,v 1.1 1992/04/11 22:10:18 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuDeleteSelection - Deletes a selection from an XMenu object. * * Author: Tony Della Fera, DEC * 20-Nov-85 * */ #include "XMenuInt.h" int XMenuDeleteSelection(display, menu, p_num, s_num) register Display *display; /* Previously opened display. */ register XMenu *menu; /* Menu object to be modified. */ register int p_num; /* Pane number to be deleted. */ register int s_num; /* Selection number to be deleted. */ { register XMPane *p_ptr; /* Pointer to pane being deleted. */ register XMSelect *s_ptr; /* Pointer to selections being deleted. */ /* * Find the right pane. */ p_ptr = _XMGetPanePtr(menu, p_num); if (p_ptr == NULL) return(XM_FAILURE); /* * Find the right selection. */ s_ptr = _XMGetSelectionPtr(p_ptr, s_num); if (s_ptr == NULL) return(XM_FAILURE); /* * Remove the selection from the association table. */ XDeleteAssoc(display, menu->assoc_tab, s_ptr->window); /* * Remove the selection from the parent pane's selection * list and update the selection count. */ emacs_remque(s_ptr); p_ptr->s_count--; /* * Destroy the selection transparency. */ if (s_ptr->window) XDestroyWindow(display, s_ptr->window); /* * Free the selection's XMSelect structure. */ free(s_ptr); /* * Schedule a recompute. */ menu->recompute = 1; /* * Return the selection number just deleted. */ _XMErrorCode = XME_NO_ERROR; return(s_num); } emacs-19.30/oldXMenu/Destroy.c100666 13437 1 6446 5730423745 14615 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/Destroy.c,v 1.1 1992/04/11 22:10:18 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuDestroy - Free all resources associated with and XMenu. * * Author: Tony Della Fera, DEC * August, 1985 * */ #include "XMenuInt.h" XMenuDestroy(display, menu) Display *display; register XMenu *menu; /* Menu object to destroy. */ { register XMPane *p_ptr; /* Pointer to the current pane. */ register XMPane *p_next; /* Pointer to the next pane. */ register XMSelect *s_ptr; /* Pointer to the current selection. */ register XMSelect *s_next; /* Pointer to the next selection. */ /* * Destroy the selection and pane X windows and free * their corresponding XMWindows. */ for ( p_ptr = menu->p_list->next; p_ptr != menu->p_list; p_ptr = p_next ) { for ( s_ptr = p_ptr->s_list->next; s_ptr != p_ptr->s_list; s_ptr = s_next ) { s_next = s_ptr->next; free(s_ptr); } if (p_ptr->window) { XDestroySubwindows(display, p_ptr->window); XDestroyWindow(display, p_ptr->window); } p_next = p_ptr->next; free(p_ptr); } /* * Destroy the association table. */ XDestroyAssocTable(menu->assoc_tab); /* * Free the mouse cursor. */ XFreeCursor(display, menu->mouse_cursor); /* * Free the fonts. */ XFreeFont(display, menu->p_fnt_info); XFreeFont(display, menu->s_fnt_info); /* * Free the pixmaps. */ /* XFreePixmap(display, menu->p_bdr_pixmap); XFreePixmap(display, menu->s_bdr_pixmap); XFreePixmap(display, menu->p_frg_pixmap); XFreePixmap(display, menu->s_frg_pixmap); XFreePixmap(display, menu->bkgnd_pixmap); */ XFreePixmap(display, menu->inact_pixmap); /* * Free the color cells. */ if ((menu->p_bdr_color != BlackPixel(display, DefaultScreen(display))) && (menu->p_bdr_color != WhitePixel(display, DefaultScreen(display)))) XFreeColors( display, DefaultColormap(display, DefaultScreen(display)), &menu->p_bdr_color, 1, 0); if ((menu->s_bdr_color != BlackPixel(display, DefaultScreen(display))) && (menu->s_bdr_color != WhitePixel(display, DefaultScreen(display)))) XFreeColors( display, DefaultColormap(display, DefaultScreen(display)), &menu->s_bdr_color, 1, 0); if ((menu->p_frg_color != BlackPixel(display, DefaultScreen(display))) && (menu->p_frg_color != WhitePixel(display, DefaultScreen(display)))) XFreeColors( display, DefaultColormap(display, DefaultScreen(display)), &menu->p_frg_color, 1, 0); if ((menu->s_frg_color != BlackPixel(display, DefaultScreen(display))) && (menu->s_frg_color != WhitePixel(display, DefaultScreen(display)))) XFreeColors( display, DefaultColormap(display, DefaultScreen(display)), &menu->s_frg_color, 1, 0); if ((menu->bkgnd_color != BlackPixel(display, DefaultScreen(display))) && (menu->bkgnd_color != WhitePixel(display, DefaultScreen(display)))) XFreeColors( display, DefaultColormap(display, DefaultScreen(display)), &menu->bkgnd_color, 1, 0); /* * Free the XMenu. */ free(menu); } emacs-19.30/oldXMenu/Error.c100666 12120 1 1275 5730423746 14115 0ustar rmsdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/Error.c,v 1.1 1992/04/11 22:10:18 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuError - Returns a string description of the current * XMenu error status flag. * * Author: Tony Della Fera, DEC * August, 1985 * */ #include "XMenuInt.h" char * XMenuError() { static char message[128]; /* Error message buffer. */ if ((_XMErrorCode < XME_CODE_COUNT) && (_XMErrorCode >= 0)) { return(_XMErrorList[_XMErrorCode]); } sprintf(message, "Unknown _XMErrorCode: %d", _XMErrorCode); return(message); } emacs-19.30/oldXMenu/EvHand.c100666 13437 1 1045 5730423746 14320 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/EvHand.c,v 1.1 1992/04/11 22:10:19 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuEventHandler - Set the XMenu asynchronous event handler. * * Author: Tony Della Fera, DEC * December 19, 1985 * */ #include "XMenuInt.h" XMenuEventHandler(handler) int (*handler)(); { /* * Set the global event handler variable. */ _XMEventHandler = handler; } emacs-19.30/oldXMenu/FindPane.c100666 13437 1 2356 5730423746 14645 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/FindPane.c,v 1.1 1992/04/11 22:10:19 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuFindPane - Find the first menu pane who's label matches a * particular string. * * Author: Tony Della Fera, DEC * January 22, 1986 * */ #include "XMenuInt.h" int XMenuFindPane(menu, label) register XMenu *menu; register char *label; { register XMPane *p_ptr; register int i = 0; /* * Check for NULL pointers! */ if (label == NULL) { _XMErrorCode = XME_ARG_BOUNDS; return(XM_FAILURE); } /* * Find the pane who's label matches the given label. */ for ( p_ptr = menu->p_list->next; p_ptr != menu->p_list; p_ptr = p_ptr->next ){ if (p_ptr->label_length == 0) { if (*label == '\0') { _XMErrorCode = XME_NO_ERROR; return (i); } } else { if (strncmp (label, p_ptr->label, p_ptr->label_length) == 0) { _XMErrorCode = XME_NO_ERROR; return (i); } } i++; } /* * If we get here then we have not found * a match. */ _XMErrorCode = XME_P_NOT_FOUND; return (XM_FAILURE); } emacs-19.30/oldXMenu/FindSel.c100666 13437 1 2640 5730423747 14502 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/FindSel.c,v 1.1 1992/04/11 22:10:19 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuFindSelection - Find the first selection in a pane who's * label matches a particular string. * * Author: Tony Della Fera, DEC * January 22, 1986 * */ #include "XMenuInt.h" int XMenuFindSelection(menu, p_num, label) register XMenu *menu; int p_num; register char *label; { register XMPane *p_ptr; register XMSelect *s_ptr; register int i = 0; /* * Check for NULL pointers! */ if (label == NULL) { _XMErrorCode = XME_ARG_BOUNDS; return(XM_FAILURE); } /* * Find the right pane. */ p_ptr = _XMGetPanePtr(menu, p_num); if (p_ptr == NULL) return(XM_FAILURE); /* * Find the right selection. */ for ( s_ptr = p_ptr->s_list->next; s_ptr != p_ptr->s_list; s_ptr = s_ptr->next ){ if (s_ptr->label_length == 0) { if (*label == '\0') { _XMErrorCode = XME_NO_ERROR; return (i); } } else { if (strncmp (label, s_ptr->label, s_ptr->label_length) == 0) { _XMErrorCode = XME_NO_ERROR; return (i); } } i++; } /* * If we get here then we have not found * a match. */ _XMErrorCode = XME_S_NOT_FOUND; return (XM_FAILURE); } emacs-19.30/oldXMenu/InsPane.c100666 12120 1 5315 6051552175 14354 0ustar rmsdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/InsPane.c,v 1.1 1992/04/11 22:10:19 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuInsertPane - Inserts a pane into an XMenu object in * a particular position. * * Author: Tony Della Fera, DEC * 20-Nov-85 * */ #include #include "XMenuInt.h" int XMenuInsertPane(menu, p_num, label, active) register XMenu *menu; /* Menu object to be modified. */ register int p_num; /* Pane number of new pane. */ char *label; /* Selection label. */ int active; /* Make selection active? */ { register XMPane *p_ptr; /* XMPane pointer. */ register XMPane *pane; /* Newly created pane. */ register XMSelect *select; /* Initial selection for the new pane. */ int label_length; /* Label lenght in characters. */ int label_width; /* Label width in pixels. */ /* * Check for NULL pointers! */ if (label == NULL) { _XMErrorCode = XME_ARG_BOUNDS; return(XM_FAILURE); } /* * Find the pane number one less than the one specified since that * is the pane after which the insertion will occur. */ p_ptr = _XMGetPanePtr(menu, (p_num - 1)); if (p_ptr == NULL) return(XM_FAILURE); /* * Calloc the XMPane structure and the initial XMSelect. */ pane = (XMPane *)calloc(1, sizeof(XMPane)); if (pane == NULL) { _XMErrorCode = XME_CALLOC; return(XM_FAILURE); } select = (XMSelect *)calloc(1, sizeof(XMSelect)); if (select == NULL) { _XMErrorCode = XME_CALLOC; return(XM_FAILURE); } /* * Determine label size. */ label_length = strlen(label); label_width = XTextWidth(menu->p_fnt_info, label, label_length); /* * Set up the initial selection. * Values not explicitly set are zeroed by calloc. */ select->next = select; select->prev = select; select->type = SL_HEADER; select->serial = -1; select->parent_p = pane; /* * Fill the XMPane structure. */ pane->type = PANE; pane->active = active; pane->serial = -1; pane->label = label; pane->label_width = label_width; pane->label_length = label_length; pane->s_list = select; /* * Insert the pane after the pane with the pane * number one less than the desired number for the * new pane. */ emacs_insque(pane, p_ptr); /* * Update the pane count. */ menu->p_count++; /* * Schedule a recompute. */ menu->recompute = 1; /* * Return the number of the pane just added. */ _XMErrorCode = XME_NO_ERROR; return(p_num); } emacs-19.30/oldXMenu/InsSel.c100666 12120 1 5143 6051552175 14213 0ustar rmsdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/InsSel.c,v 1.1 1992/04/11 22:10:19 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuInsertSelection - Inserts a selection into an XMenu object * * Author: Tony Della Fera, DEC * 20-Nov-85 * */ #include #include "XMenuInt.h" int XMenuInsertSelection(menu, p_num, s_num, data, label, active) register XMenu *menu; /* Menu object to be modified. */ register int p_num; /* Pane number to be modified. */ register int s_num; /* Selection number of new selection. */ char *data; /* Data value. */ char *label; /* Selection label. */ int active; /* Make selection active? */ { register XMPane *p_ptr; /* XMPane pointer. */ register XMSelect *s_ptr; /* XMSelect pointer. */ XMSelect *select; /* Newly created selection. */ int label_length; /* Label lenght in characters. */ int label_width; /* Label width in pixels. */ /* * Check for NULL pointers! */ if (label == NULL) { _XMErrorCode = XME_ARG_BOUNDS; return(XM_FAILURE); } /* * Find the right pane. */ p_ptr = _XMGetPanePtr(menu, p_num); if (p_ptr == NULL) return(XM_FAILURE); /* * Find the selection number one less than the one specified since that * is the selection after which the insertion will occur. */ s_ptr = _XMGetSelectionPtr(p_ptr, (s_num - 1)); if (s_ptr == NULL) return(XM_FAILURE); /* * Calloc the XMSelect structure. */ select = (XMSelect *)calloc(1, sizeof(XMSelect)); if (select == NULL) { _XMErrorCode = XME_CALLOC; return(XM_FAILURE); } /* * Determine label size. */ label_length = strlen(label); label_width = XTextWidth(menu->s_fnt_info, label, label_length); /* * Fill the XMSelect structure. */ select->type = SELECTION; select->active = active; select->serial = -1; select->label = label; select->label_width = label_width; select->label_length = label_length; select->data = data; select->parent_p = p_ptr; /* * Insert the selection after the selection with the selection * number one less than the desired number for the new selection. */ emacs_insque(select, s_ptr); /* * Update the selection count. */ p_ptr->s_count++; /* * Schedule a recompute. */ menu->recompute = 1; /* * Return the selection number just inserted. */ _XMErrorCode = XME_NO_ERROR; return(s_num); } emacs-19.30/oldXMenu/Internal.c100666 12120 1 63722 6051552177 14623 0ustar rmsdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/Internal.c,v 1.1 1992/04/11 22:10:20 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuInternal.c - XMenu internal (not user visable) routines. * * Author: Tony Della Fera, DEC * November, 1985 * */ #include #include "XMenuInt.h" /* * Toggle color macro. */ #define toggle_color(x) \ ((x) == menu->bkgnd_color ? menu->s_frg_color : menu->bkgnd_color) /* * Internal Window creation queue sizes. */ #define S_QUE_SIZE 300 #define P_QUE_SIZE 20 #define BUFFER_SIZE (S_QUE_SIZE >= P_QUE_SIZE ? S_QUE_SIZE : P_QUE_SIZE) /* * XMWinQue - Internal window creation queue datatype. */ typedef struct _xmwinquedef { int sq_size; XMSelect *sq[S_QUE_SIZE]; XMSelect **sq_ptr; int pq_size; XMPane *pq[P_QUE_SIZE]; XMPane **pq_ptr; } XMWinQue; /* * _XMWinQue - Internal static window creation queue. */ static Bool _XMWinQueIsInit = False; static XMWinQue _XMWinQue; /* * _XMErrorCode - Global XMenu error code. */ int _XMErrorCode = XME_NO_ERROR; /* * _XMErrorList - Global XMenu error code description strings. */ char * _XMErrorList[XME_CODE_COUNT] = { "No error", /* XME_NO_ERROR */ "Menu not initialized", /* XME_NOT_INIT */ "Argument out of bounds", /* XME_ARG_BOUNDS */ "Pane not found", /* XME_P_NOT_FOUND */ "Selection not found", /* XME_S_NOT_FOUND */ "Invalid menu style parameter", /* XME_STYLE_PARAM */ "Unable to grab mouse", /* XME_GRAB_MOUSE */ "Unable to interpret locator", /* XME_INTERP_LOC */ "Unable to calloc memory", /* XME_CALLOC */ "Unable to create XAssocTable", /* XME_CREATE_ASSOC */ "Unable to store bitmap", /* XME_STORE_BITMAP */ "Unable to make tile pixmaps", /* XME_MAKE_TILES */ "Unable to make pixmap", /* XME_MAKE_PIXMAP */ "Unable to create cursor", /* XME_CREATE_CURSOR */ "Unable to open font", /* XME_OPEN_FONT */ "Unable to create windows", /* XME_CREATE_WINDOW */ "Unable to create transparencies", /* XME_CREATE_TRANSP */ }; /* * _XMEventHandler - Internal event handler variable. */ int (*_XMEventHandler)() = NULL; /* * _XMWinQueInit - Internal routine to initialize the window * queue. */ _XMWinQueInit() { /* * If the queue is not initialized initialize it. */ if (!_XMWinQueIsInit) { /* * Blank the queue structure. */ register int i; for (i = 0; i < S_QUE_SIZE; i++) _XMWinQue.sq[i] = 0; for (i = 0; i < P_QUE_SIZE; i++) _XMWinQue.pq[i] = 0; _XMWinQue.sq_size = _XMWinQue.pq_size = 0; /* * Initialize the next free location pointers. */ _XMWinQue.sq_ptr = _XMWinQue.sq; _XMWinQue.pq_ptr = _XMWinQue.pq; } } /* * _XMWinQueAddPane - Internal routine to add a pane to the pane * window queue. */ int _XMWinQueAddPane(display, menu, p_ptr) register Display *display; register XMenu *menu; /* Menu being manipulated. */ register XMPane *p_ptr; /* XMPane being queued. */ { /* * If the queue is currently full then flush it. */ if (_XMWinQue.pq_size == P_QUE_SIZE) { if (_XMWinQueFlush(display, menu, 0, 0) == _FAILURE) return(_FAILURE); } /* * Insert the new XMPane pointer and increment the queue pointer * and the queue size. */ *_XMWinQue.pq_ptr = p_ptr; _XMWinQue.pq_ptr++; _XMWinQue.pq_size++; /* * All went well, return successfully. */ _XMErrorCode = XME_NO_ERROR; return(_SUCCESS); } /* * _XMWinQueAddSelection - Internal routine to add a selection to * the selection window queue. */ int _XMWinQueAddSelection(display, menu, s_ptr) register Display *display; register XMenu *menu; /* Menu being manipulated. */ register XMSelect *s_ptr; /* XMSelection being queued. */ { /* * If this entry will overflow the queue then flush it. */ if (_XMWinQue.sq_size == S_QUE_SIZE) { if (_XMWinQueFlush(display, menu, 0, 0) == _FAILURE) return(_FAILURE); } /* * Insert the new XMSelect pointer and increment the queue pointer * and the queue size. */ *_XMWinQue.sq_ptr = s_ptr; _XMWinQue.sq_ptr++; _XMWinQue.sq_size++; /* * All went well, return successfully. */ _XMErrorCode = XME_NO_ERROR; return(_SUCCESS); } /* * _XMWinQueFlush - Internal routine to flush the pane and * selection window queues. */ int _XMWinQueFlush(display, menu, pane, select) register Display *display; register XMenu *menu; /* Menu being manipulated. */ register XMPane *pane; /* Current pane. */ { register int pq_index; /* Pane queue index. */ register int sq_index; /* Selection queue index. */ register XMPane *p_ptr; /* XMPane pointer. */ register XMSelect *s_ptr; /* XMSelect pointer. */ unsigned long valuemask; /* Which attributes to set. */ XSetWindowAttributes *attributes; /* Attributes to be set. */ /* * If the pane window queue is not empty... */ if (_XMWinQue.pq_size > 0) { /* * set up attributes for pane window to be created. */ valuemask = (CWBackPixmap | CWBorderPixel | CWOverrideRedirect); attributes = (XSetWindowAttributes *)malloc(sizeof(XSetWindowAttributes)); attributes->border_pixel = menu->p_bdr_color; attributes->background_pixmap = menu->inact_pixmap; attributes->override_redirect = True; /* * Create all the pending panes in order, so that the * current pane will be on top, with the others * stacked appropriately under it. */ for (pq_index = _XMWinQue.pq_size - 1; pq_index >= 0; pq_index--) { p_ptr = _XMWinQue.pq[pq_index]; /* Retrieve next pane. */ if (p_ptr == pane) break; p_ptr->window = XCreateWindow(display, menu->parent, p_ptr->window_x, p_ptr->window_y, p_ptr->window_w, p_ptr->window_h, menu->p_bdr_width, CopyFromParent, InputOutput, CopyFromParent, valuemask, attributes); XMakeAssoc(display, menu->assoc_tab, p_ptr->window, p_ptr); XSelectInput(display, p_ptr->window, menu->p_events); } for (pq_index = 0; pq_index < _XMWinQue.pq_size; pq_index++) { p_ptr = _XMWinQue.pq[pq_index]; /* Retrieve next pane. */ p_ptr->window = XCreateWindow(display, menu->parent, p_ptr->window_x, p_ptr->window_y, p_ptr->window_w, p_ptr->window_h, menu->p_bdr_width, CopyFromParent, InputOutput, CopyFromParent, valuemask, attributes); XMakeAssoc(display, menu->assoc_tab, p_ptr->window, p_ptr); XSelectInput(display, p_ptr->window, menu->p_events); if (p_ptr == pane) break; } /* * Reset the pane queue pointer and size. */ _XMWinQue.pq_size = 0; _XMWinQue.pq_ptr = _XMWinQue.pq; } /* * If the selection window queue is not empty... */ if (_XMWinQue.sq_size > 0) { for (sq_index = 0; sq_index < _XMWinQue.sq_size; sq_index++) { /* * Retrieve the XMSelect pointer. */ s_ptr = _XMWinQue.sq[sq_index]; s_ptr->window = XCreateWindow(display, s_ptr->parent_p->window, s_ptr->window_x, s_ptr->window_y, s_ptr->window_w, s_ptr->window_h, 0, /* border width*/ CopyFromParent, InputOnly, CopyFromParent, 0, attributes); /* * Insert the new window id and its * associated XMSelect structure into the * association table. */ XMakeAssoc(display, menu->assoc_tab, s_ptr->window, s_ptr); XSelectInput(display, s_ptr->window, menu->s_events); } /* * Reset the selection queue pointer and size. */ _XMWinQue.sq_size = 0; _XMWinQue.sq_ptr = _XMWinQue.sq; } /* * Flush X's internal queues. */ XFlush(display); /* * All went well, return successfully. */ _XMErrorCode = XME_NO_ERROR; return(_SUCCESS); } /* * _XMGetPanePtr - Given a menu pointer and a pane index number, return * a pane pointer that points to the indexed pane. */ XMPane * _XMGetPanePtr(menu, p_num) register XMenu *menu; /* Menu to find the pane in. */ register int p_num; /* Index number of pane to find. */ { register XMPane *p_ptr; /* Pane pointer to be returned. */ register int i; /* Loop counter. */ /* * Is the pane number out of range? */ if ((p_num < 0) || (p_num > (menu->p_count - 1))) { _XMErrorCode = XME_P_NOT_FOUND; return(NULL); } /* * Find the right pane. */ p_ptr = menu->p_list->next; for (i = 0; i < p_num; i++) p_ptr = p_ptr->next; /* * Return successfully. */ _XMErrorCode = XME_NO_ERROR; return(p_ptr); } /* * _XMGetSelectionPtr - Given pane pointer and a selection index number, * return a selection pointer that points to the * indexed selection. */ XMSelect * _XMGetSelectionPtr(p_ptr, s_num) register XMPane *p_ptr; /* Pane to find the selection in. */ register int s_num; /* Index number of the selection to find. */ { register XMSelect *s_ptr; /* Selection pointer to be returned. */ register int i; /* Loop counter. *./ /* * Is the selection number out of range? */ if ((s_num < 0) || (s_num > (p_ptr->s_count - 1))) { _XMErrorCode = XME_S_NOT_FOUND; return(NULL); } /* * Find the right selection. */ s_ptr = p_ptr->s_list->next; for (i = 0; i < s_num; i++) s_ptr = s_ptr->next; /* * Return successfully. */ _XMErrorCode = XME_NO_ERROR; return(s_ptr); } /* * _XMRecomputeGlobals - Internal subroutine to recompute menu wide * global values. */ _XMRecomputeGlobals(display, menu) register Display *display; /*X11 display variable. */ register XMenu *menu; /* Menu object to compute from. */ { register XMPane *p_ptr; /* Pane pointer. */ register XMSelect *s_ptr; /* Selection pointer. */ register int max_p_label = 0; /* Maximum pane label width. */ register int max_s_label = 0; /* Maximum selection label width. */ register int s_count = 0; /* Maximum selection count. */ int p_s_pad; /* Pane <-> selection padding. */ int p_s_diff; /* Pane <-> selection separation. */ int p_height; /* Pane window height. */ int p_width; /* Pane window width. */ int s_width; /* Selection window width. */ int screen; /* DefaultScreen holder. */ /* * For each pane... */ for ( p_ptr = menu->p_list->next; p_ptr != menu->p_list; p_ptr = p_ptr->next ){ /* * Recompute maximum pane label width. */ max_p_label = max(max_p_label, p_ptr->label_width); /* * Recompute maximum selection count. */ s_count = max(s_count, p_ptr->s_count); /* * For each selection in the current pane... */ for ( s_ptr = p_ptr->s_list->next; s_ptr != p_ptr->s_list; s_ptr = s_ptr->next ){ /* * Recompute maximum selection label width. */ max_s_label = max(max_s_label, s_ptr->label_width); } } /* * Recompute pane height. */ p_height = (menu->flag_height << 1) + (menu->s_y_off * s_count); /* * Recompute horizontal padding between the pane window and the * selection windows. */ p_s_pad = menu->p_x_off << 1; /* * Recompute pane and selection window widths. * This is done by first computing the window sizes from the maximum * label widths. If the spacing between the selection window and the * containing pane window is less than the pane selection padding value * (twice the pane X offset) then change the size of the pane to be * the size of the selection window plus the padding. If, however the * spacing between the selection window and the containing pane window * is more than the pane selection padding value increase the size of * the selection to its maximum possible value (the pane width minus * the pane selection padding value). */ p_width = max_p_label + p_s_pad; s_width = max_s_label + (menu->s_fnt_pad << 1) + (menu->s_bdr_width << 1); p_s_diff = p_width - s_width; if (p_s_diff < p_s_pad) { p_width = s_width + p_s_pad; } else if (p_s_diff > p_s_pad) { s_width = p_width - p_s_pad; } /* * Reset menu wide global values. */ menu->s_count = s_count; menu->p_height = p_height; menu->p_width = p_width; menu->s_width = s_width; /* * Ensure that the origin of the menu is placed so that * None of the panes ore selections are off the screen. */ screen = DefaultScreen(display); if (menu->x_pos + menu->width > DisplayWidth(display, screen)) menu->x_pos = DisplayWidth(display, screen) - menu->width; else if (menu->x_pos < 0) menu->x_pos = 0; if(menu->y_pos + menu->height > DisplayHeight(display, screen)) menu->y_pos = DisplayHeight(display, screen) - menu->height; else if (menu->y_pos < 0) menu->y_pos = 0; } /* * _XMRecomputePane - Internal subroutine to recompute pane * window dependencies. */ int _XMRecomputePane(display, menu, p_ptr, p_num) register Display *display; /* Standard X display variable. */ register XMenu *menu; /* Menu object being recomputed. */ register XMPane *p_ptr; /* Pane pointer. */ register int p_num; /* Pane sequence number. */ { register int window_x; /* Recomputed window X coordinate. */ register int window_y; /* Recomputed window Y coordinate. */ unsigned long change_mask; /* Value mask to reconfigure window. */ XWindowChanges *changes; /* Values to use in configure window. */ register Bool config_p = False; /* Reconfigure pane window? */ /* * Update the pane serial number. */ p_ptr->serial = p_num; /* * Recompute window X and Y coordinates. */ switch (menu->menu_style) { case LEFT: window_x = menu->p_x_off * ((menu->p_count - 1) - p_num); window_y = menu->p_y_off * ((menu->p_count - 1) - p_num); break; case RIGHT: window_x = menu->p_x_off * p_num; window_y = menu->p_y_off * ((menu->p_count - 1) - p_num); break; case CENTER: window_x = 0; window_y = menu->p_y_off * ((menu->p_count - 1) - p_num); break; default: /* Error! Invalid style parameter. */ _XMErrorCode = XME_STYLE_PARAM; return(_FAILURE); } window_x += menu->x_pos; window_y += menu->y_pos; /* * If the newly compute pane coordinates differ from the * current coordinates, reset the current coordinates and * reconfigure the pane. */ if ( (window_x != p_ptr->window_x) || (window_y != p_ptr->window_y) ){ /* * Reset the coordinates and schedule * the pane for reconfiguration. */ p_ptr->window_x = window_x; p_ptr->window_y = window_y; config_p = True; } /* * If the local pane width and height differs from the * menu pane width and height, reset the local values. */ if ( (p_ptr->window_w != menu->p_width) || (p_ptr->window_h != menu->p_height) ){ /* * Reset window width and height and schedule * the pane for reconfiguration. */ p_ptr->window_w = menu->p_width; p_ptr->window_h = menu->p_height; config_p = True; } /* * If we need to reconfigure the pane window do it now. */ if (config_p == True) { /* * If the pane window has already been created then * reconfigure the existing window, otherwise queue * it for creation with the new configuration. */ if (p_ptr->window) { change_mask = (CWX | CWY | CWWidth | CWHeight); changes = (XWindowChanges *)malloc(sizeof(XWindowChanges)); changes->x = p_ptr->window_x; changes->y = p_ptr->window_y; changes->width = p_ptr->window_w; changes->height = p_ptr->window_h; XConfigureWindow( display, p_ptr->window, change_mask, changes ); free(changes); } else { if (_XMWinQueAddPane(display, menu, p_ptr) == _FAILURE) { return(_FAILURE); } } } /* * Recompute label X position. */ switch (menu->p_style) { case LEFT: p_ptr->label_x = menu->p_x_off + menu->p_fnt_pad; break; case RIGHT: p_ptr->label_x = menu->p_width - (p_ptr->label_width + menu->p_x_off + menu->p_fnt_pad); break; case CENTER: p_ptr->label_x = (menu->p_width - p_ptr->label_width) >> 1; break; default: /* Error! Invalid style parameter. */ _XMErrorCode = XME_STYLE_PARAM; return(_FAILURE); } /* * Recompute label Y positions. */ p_ptr->label_uy = menu->p_fnt_pad + menu->p_fnt_info->max_bounds.ascent; p_ptr->label_ly = (menu->p_height - menu->p_fnt_pad - menu->p_fnt_info->max_bounds.descent); /* * All went well, return successfully. */ _XMErrorCode = XME_NO_ERROR; return(_SUCCESS); } /* * _XMRecomputeSelection - Internal subroutine to recompute * selection window dependencies. */ int _XMRecomputeSelection(display, menu, s_ptr, s_num) register Display *display; register XMenu *menu; /* Menu object being recomputed. */ register XMSelect *s_ptr; /* Selection pointer. */ register int s_num; /* Selection sequence number. */ { register Bool config_s = False; /* Reconfigure selection window? */ XWindowChanges *changes; /* Values to change in configure. */ unsigned long change_mask; /* Value mask for XConfigureWindow. */ /* * If the selection serial numbers are out of order, begin * resequencing selections. Recompute selection window coordinates * and serial number. * * When selections are created they are given a serial number of * -1, this causes this routine to give a new selection * its initial coordinates and serial number. */ if (s_ptr->serial != s_num) { /* * Fix the sequence number. */ s_ptr->serial = s_num; /* * Recompute window X and Y coordinates. */ s_ptr->window_x = menu->s_x_off; s_ptr->window_y = menu->flag_height + (menu->s_y_off * s_num); /* * We must reconfigure the window. */ config_s = True; } /* * If the local selection width and height differs from the * menu selection width and height, reset the local values. */ if ( (s_ptr->window_w != menu->s_width) || (s_ptr->window_h != menu->s_height) ){ /* * We must reconfigure the window. */ config_s = True; /* * Reset window width and height. */ s_ptr->window_w = menu->s_width; s_ptr->window_h = menu->s_height; } /* * If we need to reconfigure the selection window do it now. */ if (config_s == True) { /* * If the selection window has already been created then * reconfigure the existing window, otherwise queue it * for creation with the new configuration. */ if (s_ptr->window) { changes = (XWindowChanges *)malloc(sizeof(XWindowChanges)); change_mask = (CWX | CWY | CWWidth | CWHeight); changes = (XWindowChanges *)malloc(sizeof(XWindowChanges)); changes->x = s_ptr->window_x; changes->y = s_ptr->window_y; changes->width = s_ptr->window_w; changes->height = s_ptr->window_h; XConfigureWindow( display, s_ptr->window, change_mask, changes ); free(changes); } else { if (_XMWinQueAddSelection(display, menu, s_ptr) == _FAILURE) { return(_FAILURE); } } } /* * Recompute label X position. */ switch (menu->s_style) { case LEFT: s_ptr->label_x = menu->s_bdr_width + menu->s_fnt_pad + s_ptr->window_x; break; case RIGHT: s_ptr->label_x = s_ptr->window_x + menu->s_width - (s_ptr->label_width + menu->s_bdr_width + menu->s_fnt_pad); break; case CENTER: s_ptr->label_x = s_ptr->window_x + ((menu->s_width - s_ptr->label_width) >> 1); break; default: /* Error! Invalid style parameter. */ _XMErrorCode = XME_STYLE_PARAM; return(_FAILURE); } /* * Recompute label Y position. */ s_ptr->label_y = s_ptr->window_y + menu->s_fnt_info->max_bounds.ascent + menu->s_fnt_pad + menu->s_bdr_width; /* * All went well, return successfully. */ _XMErrorCode = XME_NO_ERROR; return(_SUCCESS); } /* * _XMTransToOrigin - Internal subroutine to translate the point at * the center of the current pane and selection to the * the menu origin. * * WARNING! ****** Be certain that all menu dependencies have been * recomputed before calling this routine or * unpredictable results will follow. */ _XMTransToOrigin(display, menu, p_ptr, s_ptr, x_pos, y_pos, orig_x, orig_y) Display *display; /* Not used. Included for consistency. */ register XMenu *menu; /* Menu being computed against. */ register XMPane *p_ptr; /* Current pane pointer. */ register XMSelect *s_ptr; /* Current selection pointer. */ int x_pos; /* X coordinate of point to translate. */ int y_pos; /* Y coordinate of point to translate. */ int *orig_x; /* Return value X coord. of the menu origin. */ int *orig_y; /* Return value Y coord. of the menu origin. */ { register int l_orig_x; /* Local X coordinate of the menu origin. */ register int l_orig_y; /* Local Y coordinate of the menu origin. */ /* * Translate the menu origin such that the cursor hot point will be in the * center of the desired current selection and pane. * If the current selection pointer is NULL then assume that the hot point * will be in the center of the current pane flag. */ if (s_ptr == NULL) { /* * Translate from the center of the pane flag to the upper left * of the current pane window. */ l_orig_x = x_pos - (menu->p_width >> 1) - menu->p_bdr_width; l_orig_y = y_pos - (menu->flag_height >> 1) - menu->p_bdr_width; } else { /* * First translate from the center of the current selection * to the upper left of the current selection window. */ l_orig_x = x_pos - (menu->s_width >> 1); l_orig_y = y_pos - (menu->s_height >> 1); /* * Then translate to the upper left of the current pane window. */ l_orig_x -= (s_ptr->window_x + menu->p_bdr_width); l_orig_y -= (s_ptr->window_y + menu->p_bdr_width); } /* * Finally translate to the upper left of the menu. */ l_orig_x -= (p_ptr->window_x - menu->x_pos); l_orig_y -= (p_ptr->window_y - menu->y_pos); /* * Set the return values. */ *orig_x = l_orig_x; *orig_y = l_orig_y; } /* * _XMRefreshPane - Internal subroutine to completely refresh * the contents of a pane. */ _XMRefreshPane(display, menu, pane) register Display *display; register XMenu *menu; register XMPane *pane; { register XMSelect *s_list = pane->s_list; register XMSelect *s_ptr; /* * First clear the pane. */ XClearWindow(display, pane->window); if (!pane->activated) { XFillRectangle(display, pane->window, menu->inverse_select_GC, pane->label_x - menu->p_fnt_pad, pane->label_uy - menu->p_fnt_info->max_bounds.ascent - menu->p_fnt_pad, pane->label_width + (menu->p_fnt_pad << 1), menu->flag_height); XFillRectangle(display, pane->window, menu->inverse_select_GC, pane->label_x - menu->p_fnt_pad, pane->label_ly - menu->p_fnt_info->max_bounds.ascent - menu->p_fnt_pad, pane->label_width + (menu->p_fnt_pad << 1), menu->flag_height); } if (!pane->active) { XDrawString(display, pane->window, menu->inact_GC, pane->label_x, pane->label_uy, pane->label, pane->label_length); XDrawString(display, pane->window, menu->inact_GC, pane->label_x, pane->label_ly, pane->label, pane->label_length); } else { XDrawString(display, pane->window, menu->pane_GC, pane->label_x, pane->label_uy, pane->label, pane->label_length); XDrawString(display, pane->window, menu->pane_GC, pane->label_x, pane->label_ly, pane->label, pane->label_length); /* * Finally refresh each selection if the pane is activated. */ if (pane->activated) { for (s_ptr = s_list->next; s_ptr != s_list; s_ptr = s_ptr->next) _XMRefreshSelection(display, menu, s_ptr); } } } /* * _XMRefreshSelection - Internal subroutine that refreshes * a single selection window. */ _XMRefreshSelection(display, menu, select) register Display *display; register XMenu *menu; register XMSelect *select; { register int width = select->window_w; register int height = select->window_h; register int bdr_width = menu->s_bdr_width; if (select->activated) { if (menu->menu_mode == INVERT) { XFillRectangle(display, select->parent_p->window, menu->normal_select_GC, select->window_x, select->window_y, width, height); XDrawString(display, select->parent_p->window, menu->inverse_select_GC, select->label_x, select->label_y, select->label, select->label_length); } else { /* * Using BOX mode. * Since most drawing routines with arbitrary width lines * are slow compared to raster-ops lets use a raster-op to * draw the boxes. */ XDrawRectangle(display, select->parent_p->window, menu->normal_select_GC, select->window_x + (bdr_width >> 1), select->window_y + (bdr_width >> 1 ), width - bdr_width, height - bdr_width); XDrawString(display, select->parent_p->window, menu->normal_select_GC, select->label_x, select->label_y, select->label, select->label_length); } } else { XClearArea(display, select->parent_p->window, select->window_x, select->window_y, width, height, False); if (select->active) { XDrawString(display, select->parent_p->window, menu->normal_select_GC, select->label_x, select->label_y, select->label, select->label_length); } else { XDrawString(display, select->parent_p->window, menu->inact_GC, select->label_x, select->label_y, select->label, select->label_length); } } } emacs-19.30/oldXMenu/Locate.c100666 13437 1 4276 5730423750 14366 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/Locate.c,v 1.1 1992/04/11 22:10:20 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuLocate - Return data necessary to position and locate * a menu on the screen. * * Author: Tony Della Fera, DEC * January 11, 1985 * */ #include "XMenuInt.h" int XMenuLocate(display, menu, p_num, s_num, x_pos, y_pos, ul_x, ul_y, width, height) register Display *display; /* Previously opened display. */ register XMenu *menu; /* Menu object being located. */ int p_num; /* Active pane number. */ int s_num; /* Active selection number. */ int x_pos; /* X coordinate of mouse active position. */ int y_pos; /* Y coordinate of mouse active position. */ int *ul_x; /* Returned upper left menu X coordinate. */ int *ul_y; /* Returned upper left menu Y coordinate. */ int *width; /* Returned menu width. */ int *height; /* Returned menu height. */ { register XMPane *p_ptr; /* XMPane pointer. */ register XMSelect *s_ptr; /* XMSelect pointer. */ /* * Are the position arguments positive? */ if ((x_pos <= 0) || (y_pos <= 0)) { _XMErrorCode = XME_ARG_BOUNDS; return(XM_FAILURE); } /* * Find the right pane. */ p_ptr = _XMGetPanePtr(menu, p_num); if (p_ptr == NULL) return(XM_FAILURE); /* * Find the right selection. */ s_ptr = _XMGetSelectionPtr(p_ptr, s_num); /* * Check to see that the menu's dependencies have been * recomputed and are up to date. If not, do it now. */ if (menu->recompute) XMenuRecompute(display, menu); /* * Compute the new menu origin such that the active point lies * in the center of the desired active pane and selection. * This sets the values of ul_x and ul_y. */ _XMTransToOrigin(display, menu, p_ptr, s_ptr, x_pos, y_pos, ul_x, ul_y); /* * Set remaining return argument values. */ *width = menu->width; *height = menu->height; /* * Return successfully. */ _XMErrorCode = XME_NO_ERROR; return(XM_SUCCESS); } emacs-19.30/oldXMenu/Post.c100666 13437 1 5253 5730423750 14100 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/Post.c,v 1.1 1992/04/11 22:10:20 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuPost - Maps a given menu to the display and activates * the menu for user selection. The user is allowed to * specify the mouse button event mask that will be used * to identify a selection request. When a selection * request is received (i.e., when the specified mouse * event occurs) the data returned will be either the * data associated with the particular selection active * at the time of the selection request or NULL if no * selection was active. A menu selection is shown to * be active by placing a highlight box around the * selection as the mouse cursor enters its active * region. Inactive selections will not be highlighted. * As the mouse cursor moved from one menu pane * to another menu pane the pane being entered is raised * and activated and the pane being left is inactivated. * If an error occurs NULL will be returned with the * p_num set to POST_ERROR, s_num set to * NO_SELECTION and _XMErrorCode set to an * appropriate value. * Every time the routine returns successfully the * p_num and s_num indices will be set to indicate * the currently active pane and/or selection. If the * mouse was not in a selection window at the time * s_num will be set to NO_SELECTION. * * Author: Tony Della Fera, DEC * August, 1984 * */ #include "XMenuInt.h" char * XMenuPost(display, menu, p_num, s_num, x_pos, y_pos, event_mask) register Display *display; /* Previously opened display. */ register XMenu *menu; /* Menu to post. */ register int *p_num; /* Pane number selected. */ register int *s_num; /* Selection number selected. */ register int x_pos; /* X coordinate of menu position. */ register int y_pos; /* Y coordinate of menu position. */ int event_mask; /* Mouse button event mask. */ { register int stat; /* Routine call return status. */ char *data; /* Return data. */ /* * Set up initial pane and selection assumptions. */ /* * Make the procedure call. */ stat = XMenuActivate( display, menu, p_num, s_num, x_pos, y_pos, event_mask, &data); /* * Check the return value and return accordingly. */ switch (stat) { case XM_FAILURE: *p_num = POST_ERROR; *s_num = NO_SELECTION; return(NULL); case XM_NO_SELECT: case XM_IA_SELECT: *s_num = NO_SELECTION; return(NULL); case XM_SUCCESS: default: return(data); } } emacs-19.30/oldXMenu/Recomp.c100666 13437 1 4412 5730423751 14375 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/Recomp.c,v 1.1 1992/04/11 22:10:20 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuRecompute - Recompute XMenu object dependencies. * * Author: Tony Della Fera, DEC * September, 1985 * */ #include "XMenuInt.h" int XMenuRecompute(display, menu) Display *display; register XMenu *menu; /* Menu object to be recomputed. */ { register XMPane *p_ptr; /* Pane pointer. */ register XMSelect *s_ptr; /* Selection pointer. */ register int p_num; /* Pane serial number. */ register int s_num; /* Selection serial number. */ /* * If there are no panes in the menu then return failure * because the menu is not initialized. */ if (menu->p_count == 0) { _XMErrorCode = XME_NOT_INIT; return(XM_FAILURE); } /* * Recompute menu wide global values: pane window size, * selection size and maximum selection count. */ _XMRecomputeGlobals(display, menu); /* * For each pane in the menu... */ p_num = 0; for ( p_ptr = menu->p_list->next; p_ptr != menu->p_list; p_ptr = p_ptr->next ){ /* * Recompute pane dependencies. */ if (_XMRecomputePane(display, menu, p_ptr, p_num) == _FAILURE) { return(XM_FAILURE); } p_num++; /* * For each selection in the pane... */ s_num = 0; for ( s_ptr = p_ptr->s_list->next; s_ptr != p_ptr->s_list; s_ptr = s_ptr->next ) { /* * Recompute selection dependencies. */ if (_XMRecomputeSelection(display, menu, s_ptr, s_num) == _FAILURE) { return(XM_FAILURE); } s_num++; } } /* * Recompute menu size. */ if (menu->menu_style == CENTER) { menu->width = menu->p_width + (menu->p_bdr_width << 1); } else { menu->width = menu->p_width + (menu->p_bdr_width << 1) + ((menu->p_count - 1) * menu->p_x_off); } menu->height = menu->p_height + (menu->p_bdr_width << 1) + ((menu->p_count - 1) * menu->p_y_off); /* * Reset the recompute flag. */ menu->recompute = 0; /* * Return successfully. */ _XMErrorCode = XME_NO_ERROR; return(XM_SUCCESS); } emacs-19.30/oldXMenu/SetAEQ.c100666 13437 1 1363 5730423751 14234 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/SetAEQ.c,v 1.1 1992/04/11 22:10:20 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuSetAEQ - Set Asynchronous event queueing mode. * When enabled asynchronous events will be queue while * a menu is being displayed and restored to the X * event queue when the menu is taken down. * * Author: Tony Della Fera, DEC * March 12, 1986 * */ #include "XMenuInt.h" XMenuSetAEQ(menu, aeq) register XMenu *menu; /* Menu object to be modified. */ register int aeq; /* AEQ mode? */ { /* * Set the AEQ mode switch. */ menu->aeq = aeq; } emacs-19.30/oldXMenu/SetFrz.c100666 13437 1 1267 5730423751 14372 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/SetFrz.c,v 1.1 1992/04/11 22:10:21 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuSetFreeze - Forcibly set the menu freeze mode switch * overriding the Xdefaults setting. * This is necessary in some situations. * * Author: Tony Della Fera, DEC * January 29, 1986 * */ #include "XMenuInt.h" XMenuSetFreeze(menu, freeze) register XMenu *menu; /* Menu object to be modified. */ register int freeze; /* Freeze mode? */ { /* * Set the freeze mode switch. */ menu->freeze = freeze; } emacs-19.30/oldXMenu/SetPane.c100666 13437 1 2001 5730423752 14500 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/SetPane.c,v 1.1 1992/04/11 22:10:21 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuSetPane - Set a menu pane to be active or inactive. * * Author: Tony Della Fera, DEC * August, 1985 * */ #include "XMenuInt.h" int XMenuSetPane(menu, p_num, active) register XMenu *menu; /* Menu object to be modified. */ register int p_num; /* Pane number to be modified. */ register int active; /* Make selection active? */ { register XMPane *p_ptr; /* XMPane pointer. */ /* * Find the right pane. */ p_ptr = _XMGetPanePtr(menu, p_num); if (p_ptr == NULL) return(XM_FAILURE); /* * Set its active switch. */ p_ptr->active = active; if (p_ptr->active == False) p_ptr->activated = False; /* * Return the pane number just set. */ _XMErrorCode = XME_NO_ERROR; return(p_num); } emacs-19.30/oldXMenu/SetSel.c100666 13437 1 2333 5730423752 14350 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/SetSel.c,v 1.1 1992/04/11 22:10:21 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuSetSelection - Set a menu selection to be active or inactive. * * Author: Tony Della Fera, DEC * August, 1985 * */ #include "XMenuInt.h" int XMenuSetSelection(menu, p_num, s_num, active) register XMenu *menu; /* Menu object to be modified. */ register int p_num; /* Pane number to be modified. */ register int s_num; /* Selection number to modified. */ int active; /* Make selection active? */ { register XMPane *p_ptr; /* XMPane pointer. */ register XMSelect *s_ptr; /* XMSelect pointer. */ /* * Find the right pane. */ p_ptr = _XMGetPanePtr(menu, p_num); if (p_ptr == NULL) return(XM_FAILURE); /* * Find the right selection. */ s_ptr = _XMGetSelectionPtr(p_ptr, s_num); if (s_ptr == NULL) return(XM_FAILURE); /* * Set its active switch. */ s_ptr->active = active; /* * Return the selection number just set. */ _XMErrorCode = XME_NO_ERROR; return(s_num); } emacs-19.30/oldXMenu/XCrAssoc.c100666 12120 1 4051 6051552200 14465 0ustar rmsdaemon/* $XConsortium: XCrAssoc.c,v 10.17 91/01/06 12:04:57 rws Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* Permission to use, copy, modify, distribute, and sell this software and its documentation for any purpose is hereby granted without fee, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of M.I.T. not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. M.I.T. makes no representations about the suitability of this software for any purpose. It is provided "as is" without express or implied warranty. */ #include #include #include #include "X10.h" #ifndef NULL #define NULL 0 #endif extern int errno; /* * XCreateAssocTable - Create an XAssocTable. The size argument should be * a power of two for efficiency reasons. Some size suggestions: use 32 * buckets per 100 objects; a reasonable maximum number of object per * buckets is 8. If there is an error creating the XAssocTable, a NULL * pointer is returned. */ XAssocTable *XCreateAssocTable(size) register int size; /* Desired size of the table. */ { register XAssocTable *table; /* XAssocTable to be initialized. */ register XAssoc *buckets; /* Pointer to the first bucket in */ /* the bucket array. */ /* Malloc the XAssocTable. */ if ((table = (XAssocTable *)malloc(sizeof(XAssocTable))) == NULL) { /* malloc call failed! */ errno = ENOMEM; return(NULL); } /* calloc the buckets (actually just their headers). */ buckets = (XAssoc *)calloc((unsigned)size, (unsigned)sizeof(XAssoc)); if (buckets == NULL) { /* calloc call failed! */ errno = ENOMEM; return(NULL); } /* Insert table data into the XAssocTable structure. */ table->buckets = buckets; table->size = size; while (--size >= 0) { /* Initialize each bucket. */ buckets->prev = buckets; buckets->next = buckets; buckets++; } return(table); } emacs-19.30/oldXMenu/X10.h100666 13437 1 5406 5730423742 13531 0ustar jimbdaemon/* $Header: /u/src/emacs/19.0/oldXMenu/RCS/X10.h,v 1.1 1992/04/11 22:10:21 jimb Exp $ */ /* * Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology * * Permission to use, copy, modify, and distribute this software and its * documentation for any purpose and without fee is hereby granted, provided * that the above copyright notice appear in all copies and that both that * copyright notice and this permission notice appear in supporting * documentation, and that the name of M.I.T. not be used in advertising * or publicity pertaining to distribution of the software without specific, * written prior permission. M.I.T. makes no representations about the * suitability of this software for any purpose. It is provided "as is" * without express or implied warranty. * * The X Window System is a Trademark of MIT. * */ /* * X10.h - Header definition and support file for the C subroutine * interface library for V10 support routines. */ #ifndef _X10_H_ #define _X10_H_ /* Used in XDraw and XDrawFilled */ typedef struct { short x, y; unsigned short flags; } Vertex; /* The meanings of the flag bits. If the bit is 1 the predicate is true */ #define VertexRelative 0x0001 /* else absolute */ #define VertexDontDraw 0x0002 /* else draw */ #define VertexCurved 0x0004 /* else straight */ #define VertexStartClosed 0x0008 /* else not */ #define VertexEndClosed 0x0010 /* else not */ /*#define VertexDrawLastPoint 0x0020 */ /* else don't */ /* The VertexDrawLastPoint option has not been implemented in XDraw and XDrawFilled so it shouldn't be defined. */ /* * XAssoc - Associations used in the XAssocTable data structure. The * associations are used as circular queue entries in the association table * which is contains an array of circular queues (buckets). */ typedef struct _XAssoc { struct _XAssoc *next; /* Next object in this bucket. */ struct _XAssoc *prev; /* Previous obejct in this bucket. */ Display *display; /* Display which owns the id. */ XID x_id; /* X Window System id. */ char *data; /* Pointer to untyped memory. */ } XAssoc; /* * XAssocTable - X Window System id to data structure pointer association * table. An XAssocTable is a hash table whose buckets are circular * queues of XAssoc's. The XAssocTable is constructed from an array of * XAssoc's which are the circular queue headers (bucket headers). * An XAssocTable consists an XAssoc pointer that points to the first * bucket in the bucket array and an integer that indicates the number * of buckets in the array. */ typedef struct { XAssoc *buckets; /* Pointer to first bucket in bucket array.*/ int size; /* Table size (number of buckets). */ } XAssocTable; XAssocTable *XCreateAssocTable(); char *XLookUpAssoc(); #endif /* _X10_H_ */ emacs-19.30/oldXMenu/XDelAssoc.c100666 13437 1 4213 5730423752 14775 0ustar jimbdaemon/* $XConsortium: XDelAssoc.c,v 10.19 91/01/06 12:06:39 rws Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* Permission to use, copy, modify, distribute, and sell this software and its documentation for any purpose is hereby granted without fee, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of M.I.T. not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. M.I.T. makes no representations about the suitability of this software for any purpose. It is provided "as is" without express or implied warranty. */ #include #include "X10.h" void emacs_remque(); struct qelem { struct qelem *q_forw; struct qelem *q_back; char q_data[1]; }; /* * XDeleteAssoc - Delete an association in an XAssocTable keyed on * an XId. An association may be removed only once. Redundant * deletes are meaningless (but cause no problems). */ XDeleteAssoc(dpy, table, x_id) register Display *dpy; register XAssocTable *table; register XID x_id; { int hash; register XAssoc *bucket; register XAssoc *Entry; /* Hash the XId to get the bucket number. */ hash = x_id & (table->size - 1); /* Look up the bucket to get the entries in that bucket. */ bucket = &table->buckets[hash]; /* Get the first entry in the bucket. */ Entry = bucket->next; /* Scan through the entries in the bucket for the right XId. */ for (; Entry != bucket; Entry = Entry->next) { if (Entry->x_id == x_id) { /* We have the right XId. */ if (Entry->display == dpy) { /* We have the right display. */ /* We have the right entry! */ /* Remove it from the queue and */ /* free the entry. */ emacs_remque((struct qelem *)Entry); free((char *)Entry); return; } /* Oops, identical XId's on different displays! */ continue; } if (Entry->x_id > x_id) { /* We have gone past where it should be. */ /* It is apparently not in the table. */ return; } } /* It is apparently not in the table. */ return; } emacs-19.30/oldXMenu/XDestAssoc.c100666 13437 1 2542 5730423753 15174 0ustar jimbdaemon/* $XConsortium: XDestAssoc.c,v 10.17 91/02/08 13:11:50 rws Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* Permission to use, copy, modify, distribute, and sell this software and its documentation for any purpose is hereby granted without fee, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of M.I.T. not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. M.I.T. makes no representations about the suitability of this software for any purpose. It is provided "as is" without express or implied warranty. */ #include #include "X10.h" /* * XDestroyAssocTable - Destroy (free the memory associated with) * an XAssocTable. */ XDestroyAssocTable(table) register XAssocTable *table; { register int i; register XAssoc *bucket; register XAssoc *Entry, *entry_next; /* Free the buckets. */ for (i = 0; i < table->size; i++) { bucket = &table->buckets[i]; for ( Entry = bucket->next; Entry != bucket; Entry = entry_next ) { entry_next = Entry->next; free((char *)Entry); } } /* Free the bucket array. */ free((char *)table->buckets); /* Free the table. */ free((char *)table); } emacs-19.30/oldXMenu/XLookAssoc.c100666 13437 1 4335 5730423753 15203 0ustar jimbdaemon/* $XConsortium: XLookAssoc.c,v 10.16 91/01/06 12:09:24 rws Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* Permission to use, copy, modify, distribute, and sell this software and its documentation for any purpose is hereby granted without fee, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of M.I.T. not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. M.I.T. makes no representations about the suitability of this software for any purpose. It is provided "as is" without express or implied warranty. */ #include #include #include "X10.h" #ifndef NULL #define NULL 0 #endif /* * XLookUpAssoc - Retrieve the data stored in an XAssocTable by its XId. * If an appropriately matching XId can be found in the table the routine will * return apointer to the data associated with it. If the XId can not be found * in the table the routine will return a NULL pointer. All XId's are relative * to the currently active Display. */ caddr_t XLookUpAssoc(dpy, table, x_id) register Display *dpy; register XAssocTable *table; /* XAssocTable to search in. */ register XID x_id; /* XId to search for. */ { int hash; register XAssoc *bucket; register XAssoc *Entry; /* Hash the XId to get the bucket number. */ hash = x_id & (table->size - 1); /* Look up the bucket to get the entries in that bucket. */ bucket = &table->buckets[hash]; /* Get the first entry in the bucket. */ Entry = bucket->next; /* Scan through the entries in the bucket for the right XId. */ for (; Entry != bucket; Entry = Entry->next) { if (Entry->x_id == x_id) { /* We have the right XId. */ if (Entry->display == dpy) { /* We have the right display. */ /* We have the right entry! */ return(Entry->data); } /* Oops, identical XId's on different displays! */ continue; } if (Entry->x_id > x_id) { /* We have gone past where it should be. */ /* It is apparently not in the table. */ return(NULL); } } /* It is apparently not in the table. */ return(NULL); } emacs-19.30/oldXMenu/XMakeAssoc.c100666 12120 1 6376 6051552200 15012 0ustar rmsdaemon/* $XConsortium: XMakeAssoc.c,v 10.18 91/01/06 12:09:28 rws Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* Permission to use, copy, modify, distribute, and sell this software and its documentation for any purpose is hereby granted without fee, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of M.I.T. not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. M.I.T. makes no representations about the suitability of this software for any purpose. It is provided "as is" without express or implied warranty. */ #include #include #include #include "X10.h" #include #ifndef NULL #define NULL 0 #endif extern int errno; void emacs_insque(); struct qelem { struct qelem *q_forw; struct qelem *q_back; char q_data[1]; }; /* * XMakeAssoc - Insert data into an XAssocTable keyed on an XId. * Data is inserted into the table only once. Redundant inserts are * meaningless (but cause no problems). The queue in each association * bucket is sorted (lowest XId to highest XId). */ XMakeAssoc(dpy, table, x_id, data) register Display *dpy; register XAssocTable *table; register XID x_id; register caddr_t data; { int hash; register XAssoc *bucket; register XAssoc *Entry; register XAssoc *new_entry; /* Hash the XId to get the bucket number. */ hash = x_id & (table->size - 1); /* Look up the bucket to get the entries in that bucket. */ bucket = &table->buckets[hash]; /* Get the first entry in the bucket. */ Entry = bucket->next; /* If (Entry != bucket), the bucket is empty so make */ /* the new entry the first entry in the bucket. */ /* if (Entry == bucket), the we have to search the */ /* bucket. */ if (Entry != bucket) { /* The bucket isn't empty, begin searching. */ /* If we leave the for loop then we have either passed */ /* where the entry should be or hit the end of the bucket. */ /* In either case we should then insert the new entry */ /* before the current value of "Entry". */ for (; Entry != bucket; Entry = Entry->next) { if (Entry->x_id == x_id) { /* Entry has the same XId... */ if (Entry->display == dpy) { /* Entry has the same Display... */ /* Therefore there is already an */ /* entry with this XId and Display, */ /* reset its data value and return. */ Entry->data = data; return; } /* We found an association with the right */ /* id but the wrong display! */ continue; } /* If the current entry's XId is greater than the */ /* XId of the entry to be inserted then we have */ /* passed the location where the new XId should */ /* be inserted. */ if (Entry->x_id > x_id) break; } } /* If we are here then the new entry should be inserted just */ /* before the current value of "Entry". */ /* Create a new XAssoc and load it with new provided data. */ new_entry = (XAssoc *) xmalloc(sizeof(XAssoc)); new_entry->display = dpy; new_entry->x_id = x_id; new_entry->data = data; /* Insert the new entry. */ emacs_insque((struct qelem *)new_entry, (struct qelem *)Entry->prev); } emacs-19.30/oldXMenu/insque.c100666 13437 1 1567 5730423754 14467 0ustar jimbdaemon/* This file implements the emacs_insque and emacs_remque functions, copies of the insque and remque functions of BSD. They and all their callers have been renamed to emacs_mumble to allow us to include this file in the menu library on all systems. */ struct qelem { struct qelem *q_forw; struct qelem *q_back; char q_data[1]; }; /* Insert ELEM into a doubly-linked list, after PREV. */ void emacs_insque (elem, prev) struct qelem *elem, *prev; { struct qelem *next = prev->q_forw; prev->q_forw = elem; if (next) next->q_back = elem; elem->q_forw = next; elem->q_back = prev; } /* Unlink ELEM from the doubly-linked list that it is in. */ emacs_remque (elem) struct qelem *elem; { struct qelem *next = elem->q_forw; struct qelem *prev = elem->q_back; if (next) next->q_back = prev; if (prev) prev->q_forw = next; } emacs-19.30/oldXMenu/XMenu.h100666 13437 1 21736 5730423742 14241 0ustar jimbdaemon#include "copyright.h" /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/XMenu.h,v 1.1 1992/04/11 22:10:21 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenu.h - Include file for the MIT Project Athena * XMenu X window system menu package. * * Author: Tony Della Fera, DEC * August, 1984 */ #ifndef _XMenu_h_ #define _XMenu_h_ #include #include "X10.h" #define FAILURE -1 #define SUCCESS 1 #define POST_ERROR -1 #define NO_SELECTION -1 #define XM_FAILURE -1 #define XM_SUCCESS 1 #define XM_NO_SELECT 2 #define XM_IA_SELECT 3 #define XME_CODE_COUNT 17 #define XME_NO_ERROR 0 #define XME_NOT_INIT 1 #define XME_ARG_BOUNDS 2 #define XME_P_NOT_FOUND 3 #define XME_S_NOT_FOUND 4 #define XME_STYLE_PARAM 5 #define XME_GRAB_MOUSE 6 #define XME_INTERP_LOC 7 #define XME_CALLOC 8 #define XME_CREATE_ASSOC 9 #define XME_STORE_BITMAP 10 #define XME_MAKE_TILES 11 #define XME_MAKE_PIXMAP 12 #define XME_CREATE_CURSOR 13 #define XME_OPEN_FONT 14 #define XME_CREATE_WINDOW 15 #define XME_CREATE_TRANSP 16 /* * XMenu error code and error list definitions. */ extern int _XMErrorCode; extern char *_XMErrorList[]; /* * Define the XMWindow datatypes. * * An XMWindow is either an XMPane or an XMSelect. * * XMWindow is wrapper used to identify the constant window * information that makes up XMPane and XMSelect objects. * * An XMPane is a menu pane made up of one or more XMSelect and a label. * * An XMSelect is a menu selection object with a label and a data pointer. */ typedef enum _xmwintype {PANE, SELECTION, PL_HEADER, SL_HEADER} XMWType; typedef struct _xmwindow { struct _xmwindow *next; /* Next obj pointer (for emacs_insque). */ struct _xmwindow *prev; /* Prev obj pointer (for emacs_insque). */ XMWType type; /* Type of window. */ Window window; /* X Window Id. */ int window_x; /* Window upper left X coordinate. */ int window_y; /* Window upper left y coordinate. */ int window_w; /* Window width. */ int window_h; /* Window height. */ int active; /* Window active? */ int activated; /* Window activated? */ int pad_l1; /* ---- */ char *pad_l2; /* ---- */ int pad_l3; /* ---- */ int pad_l4; /* ---- */ int pad_l5; /* ---- */ int pad_l6; /* ---- */ int pad_l7; /* ---- */ int pad_l8; /* ---- */ struct _xmwindow *pad_l9; /* ---- */ char *pad_l10; /* ---- */ struct _xmwindow *pad_l11; /* ---- */ } XMWindow; typedef struct _xmpane { struct _xmpane *next; /* Next obj pointer (for emacs_insque). */ struct _xmpane *prev; /* Prev obj pointer (for emacs_insque). */ XMWType type; /* Type of window. */ Window window; /* X Window Id. */ int window_x; /* Window upper left X coordinate. */ int window_y; /* Window upper left y coordinate. */ int window_w; /* Window width. */ int window_h; /* Window height. */ int active; /* Window active? */ int activated; /* Window activated? */ int serial; /* -- Pane serial number. */ char *label; /* -- Pane label. */ int label_width; /* -- Pane label width in pixels. */ int label_length; /* -- Pane label length in chars. */ int label_x; /* -- Pane label X offset. */ int label_uy; /* -- Pane label upper Y offset. */ int label_ly; /* -- Pane label lower Y offset. */ int s_count; /* -- Selections in this pane. */ struct _xmselect *s_list; /* -- Selection window list. */ char *pad_l10; /* ---- */ struct _xmwindow *pad_l11; /* ---- */ } XMPane; typedef struct _xmselect { struct _xmselect *next; /* Next obj pointer (for emacs_insque). */ struct _xmselect *prev; /* Prev obj pointer (for emacs_insque). */ XMWType type; /* Type of window. */ Window window; /* X Window Id. */ Window parent; /* X Window id of parent window. */ int window_x; /* Window upper left X coordinate. */ int window_y; /* Window upper left y coordinate. */ int window_w; /* Window width. */ int window_h; /* Window height. */ int active; /* Window active? */ int activated; /* Window activated? */ int serial; /* -- Selection serial number. */ char *label; /* -- Selection label. */ int label_width; /* -- Selection label width in pixels. */ int label_length; /* -- Selection label length in chars. */ int label_x; /* -- Selection label X offset. */ int label_y; /* -- Selection label Y offset. */ int pad_l7; /* ---- */ int pad_l8; /* ---- */ struct _xmwindow *pad_l9; /* ---- */ char *data; /* -- Selection data pointer. */ struct _xmpane *parent_p; /* -- Selection parent pane structure. */ } XMSelect; /* * Define the XMStyle datatype. * * Menu presentation style information. * */ typedef enum _xmstyle { LEFT, /* Left oriented obejct. */ RIGHT, /* Right oriented obejct. */ CENTER /* Center oriented object. */ } XMStyle; /* * Define the XMMode datatype. * * Menu presentation mode information. * */ typedef enum _xmmode { BOX, /* BOXed graphic rendition. */ INVERT /* INVERTed graphic rendition. */ } XMMode; /* * Define the XMenu datatype. * * All dimensions are in pixels unless otherwise noted. */ typedef struct _xmenu { /* -------------------- Menu data -------------------- */ XMStyle menu_style; /* Menu display style. */ XMMode menu_mode; /* Menu display mode. */ int freeze; /* Freeze server mode? */ int aeq; /* Asynchronous Event Queueing mode? */ int recompute; /* Recompute menu dependencies? */ Window parent; /* Menu's parent window. */ int width; /* Overall menu width. */ int height; /* Overall menu height. */ int x_pos; /* Oveall menu origin. */ int y_pos; /* Overall menu origin. */ Cursor mouse_cursor; /* Mouse cursor raster. */ XAssocTable *assoc_tab; /* XMWindow association table. */ XMPane *p_list; /* List of XMPanes. */ /* -------------------- Pane window data -------------------- */ XMStyle p_style; /* Pane display style. */ int p_events; /* Pane window X events. */ XFontStruct *p_fnt_info; /* Flag font info structure. */ GC pane_GC; /* Pane graphics context. */ int p_fnt_pad; /* Fixed flag font padding in pixels. */ double p_spread; /* Pane spread in flag height fractions. */ int p_bdr_width; /* Pane border width. */ int flag_height; /* Flag height. */ int p_width; /* Menu pane width. */ int p_height; /* Menu pane height. */ int p_x_off; /* Pane window X offset. */ int p_y_off; /* Pane window Y offset. */ int p_count; /* Number of panes per menu. */ /* -------------------- Selection window data -------------------- */ XMStyle s_style; /* Selection display style. */ int s_events; /* Selection window X events. */ XFontStruct *s_fnt_info; /* Body font info structure. */ int s_fnt_pad; /* Fixed body font padding in pixels. */ double s_spread; /* Select spread in line height fractions. */ int s_bdr_width; /* Select border width. */ int s_width; /* Selection window width. */ int s_height; /* Selection window height. */ int s_x_off; /* Selection window X offset. */ int s_y_off; /* Selection window Y offset. */ int s_count; /* Maximum number of selections per pane. */ GC normal_select_GC; /* GC used for inactive selections. */ GC inverse_select_GC; /* GC used for active (current) selection. */ GC inact_GC; /* GC used for inactive selections and */ /* panes headers. */ /* -------------------- Color data -------------------- */ unsigned long p_bdr_color; /* Color of pane border pixmap. */ unsigned long s_bdr_color; /* Color of selection border pixmap. */ unsigned long p_frg_color; /* Color of pane foreground pixmap. */ unsigned long s_frg_color; /* Color of selection pixmap. */ unsigned long bkgnd_color; /* Color of menu background pixmap. */ /* -------------------- Pixmap data -------------------- */ Pixmap p_bdr_pixmap; /* Pane border pixmap. */ Pixmap s_bdr_pixmap; /* Selection border pixmap. */ Pixmap p_frg_pixmap; /* Pane foreground pixmap. */ Pixmap s_frg_pixmap; /* Selection foreground pixmap. */ Pixmap bkgnd_pixmap; /* Menu background pixmap. */ Pixmap inact_pixmap; /* Menu inactive pixmap. */ } XMenu; /* * XMenu library routine declarations. */ XMenu *XMenuCreate(); int XMenuAddPane(); int XMenuAddSelection(); int XMenuInsertPane(); int XMenuInsertSelection(); int XMenuFindPane(); int XMenuFindSelection(); int XMenuChangePane(); int XMenuChangeSelection(); int XMenuSetPane(); int XMenuSetSelection(); int XMenuRecompute(); int XMenuEventHandler(); /* No value actually returned. */ int XMenuLocate(); int XMenuSetFreeze(); /* No value actually returned. */ int XMenuActivate(); char *XMenuPost(); int XMenuDeletePane(); int XMenuDeleteSelection(); int XMenuDestroy(); /* No value actually returned. */ char *XMenuError(); #endif /* Don't add after this point. */ emacs-19.30/oldXMenu/XMenuInt.h100666 13437 1 3257 5730423742 14672 0ustar jimbdaemon /* $Header: /u/src/emacs/19.0/oldXMenu/RCS/XMenuInt.h,v 1.3 1992/10/10 16:05:10 jimb Exp $ */ /* Copyright Massachusetts Institute of Technology 1985 */ /* * XMenu: MIT Project Athena, X Window system menu package * * XMenuInternal.h - Internal menu system include file for the * MIT Project Athena XMenu X window system * menu package. * * Author: Tony Della Fera, DEC * October, 1985 */ #ifndef _XMenuInternal_h_ #define _XMenuInternal_h_ /* Avoid warnings about redefining NULL by including first; the other file which wants to define it ( on Ultrix systems) can deal if NULL is already defined, but can't. */ #include #include #include "X10.h" #include "XMenu.h" #define min(x, y) ((x) <= (y) ? (x) : (y)) #define max(x, y) ((x) >= (y) ? (x) : (y)) #define abs(a) ((a) < 0 ? -(a) : (a)) #define _X_FAILURE -1 #define _SUCCESS 1 #define _FAILURE -1 /* * XMenu internal event handler variable. */ extern int (*_XMEventHandler)(); #ifndef Pixel #define Pixel unsigned long #endif /* * Internal routine declarations. */ int _XMWinQueInit(); /* No value actually returned. */ int _XMWinQueAddPane(); int _XMWinQueAddSelection(); int _XMWinQueFlush(); XMPane *_XMGetPanePtr(); XMSelect *_XMGetSelectionPtr(); int _XMRecomputeGlobals(); /* No value actually returned. */ int _XMRecomputePane(); int _XMRecomputeSelection(); int _XMTransToOrigin(); /* No value actually returned. */ int _XMRefreshPane(); /* No value actually returned. */ int _XMRefreshSelections(); /* No value actually returned. */ int _XMHighlightSelection(); /* No value actually returned. */ #endif /* Don't add stuff after this #endif */ emacs-19.30/oldXMenu/copyright.h100666 13437 1 1411 5347150326 15160 0ustar jimbdaemon/* $Header: /u/src/emacs/19.0/oldXMenu/RCS/copyright.h,v 1.1 1992/04/11 22:10:22 jimb Exp $ */ /* Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of M.I.T. not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. M.I.T. makes no representations about the suitability of this software for any purpose. It is provided "as is" without express or implied warranty. */ emacs-19.30/oldXMenu/Makefile.in100666 12120 1 5511 6051552647 14722 0ustar rmsdaemonsrcdir=@srcdir@ VPATH=@srcdir@ C_SWITCH_X_SITE=@C_SWITCH_X_SITE@ EXTRA=insque.o CC=@CC@ CFLAGS=@CFLAGS@ CPP=@CPP@ LN_S=@LN_S@ AS = as LD = ld TAGS = etags RM = rm -f MV = mv RANLIB = ranlib # Solaris 2.1 ar doesn't accept the 'l' option. AR = ar cq LS = ls LINTOPTS = -axz LINTLIBFLAG = -C MAKE = make STD_DEFINES = CDEBUGFLAGS = -O RM_CMD = $(RM) *.CKP *.ln *.BAK *.bak *.o core errs ,* *~ *.a \ tags TAGS make.log OBJS = Activate.o \ AddPane.o \ AddSel.o \ ChgPane.o \ ChgSel.o \ Create.o \ DelPane.o \ DelSel.o \ Destroy.o \ Error.o \ EvHand.o \ FindPane.o \ FindSel.o \ InsPane.o \ InsSel.o \ Internal.o \ Locate.o \ Post.o \ Recomp.o \ SetAEQ.o \ SetFrz.o \ SetPane.o \ SetSel.o \ XDelAssoc.o XLookAssoc.o XCrAssoc.o XDestAssoc.o XMakeAssoc.o all:: libXMenu11.a ALL_CFLAGS=$(C_SWITCH_SITE) $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \ $(C_SWITCH_X_SITE) $(C_SWITCH_X_SYSTEM) $(C_SWITCH_X_MACHINE) \ $(CPPFLAGS) $(CFLAGS) -DEMACS_BITMAP_FILES \ -I../src -I${srcdir} -I${srcdir}/../src .c.o: $(CC) -c ${ALL_CFLAGS} $< libXMenu11.a: $(OBJS) $(EXTRA) $(RM) $@ $(AR) $@ $(OBJS) $(EXTRA) @echo Do not be alarmed if the following ranlib command @echo fails due to the absence of a ranlib program on your system. -$(RANLIB) $@ || true #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: mostlyclean: FRC.mostlyclean rm -f libXMenu11.a ${OBJS} ${EXTRA} clean: mostlyclean distclean: clean maintainer-clean: distclean tags:: $(TAGS) -t *.[ch] emacs-19.30/oldXMenu/README100666 13437 1 373 5174232417 13645 0ustar jimbdaemonThis directory contains the source code for the X11R2 XMenu library. As of Release 2 of the X Window System, Version 11 from MIT, the XMenu library no longer supported. It is not used in any software supplied by MIT and its use is not encouraged. emacs-19.30/oldXMenu/Imakefile100666 13437 1 3026 5347156610 14616 0ustar jimbdaemon HEADERS = XMenu.h LINTLIBS = ../lib/X/llib-lX.ln INSTALLFLAGS = $(INSTINCFLAGS) RANLIB = ranlib -t SRCS = Activate.c \ AddPane.c \ AddSel.c \ ChgPane.c \ ChgSel.c \ Create.c \ DelPane.c \ DelSel.c \ Destroy.c \ Error.c \ EvHand.c \ FindPane.c \ FindSel.c \ InsPane.c \ InsSel.c \ Internal.c \ Locate.c \ Post.c \ Recomp.c \ SetAEQ.c \ SetFrz.c \ SetPane.c \ SetSel.c \ XCrAssoc.c \ XDelAssoc.c \ XDestAssoc.c \ XLookAssoc.c \ XMakeAssoc.c OBJS = Activate.o \ AddPane.o \ AddSel.o \ ChgPane.o \ ChgSel.o \ Create.o \ DelPane.o \ DelSel.o \ Destroy.o \ Error.o \ EvHand.o \ FindPane.o \ FindSel.o \ InsPane.o \ InsSel.o \ Internal.o \ Locate.o \ Post.o \ Recomp.o \ SetAEQ.o \ SetFrz.o \ SetPane.o \ SetSel.o \ XCrAssoc.o \ XDelAssoc.o \ XDestAssoc.o \ XLookAssoc.o \ XMakeAssoc.o #if DebugOldLibXMenu && ProfileOldLibXMenu DebuggedAndProfiledLibraryObjectRule() #else # if DebugOldLibXMenu DebuggedLibraryObjectRule() # else # if ProfileOldLibXMenu ProfiledLibraryObjectRule() # else NormalLibraryObjectRule() # endif # endif #endif NormalLibraryTarget(XMenu11,$(OBJS)) LintLibraryTarget(XMenu11,$(SRCS)) InstallLibrary(XMenu11,$(USRLIBDIR)) #if InstallLintLibs InstallLintLibrary(XMenu11,$(LINTLIBDIR)) #endif InstallMultiple($(HEADERS),$(INCDIR)) #if ProfileOldLibXMenu ProfiledLibraryTarget(XMenu11,$(OBJS)) InstallLibrary(XMenu11_p,$(USRLIBDIR)) #endif #if DebugOldLibXMenu DebuggedLibraryTarget(XMenu11,$(OBJS)) #endif DependTarget() NormalLintTarget($(SRCS)) emacs-19.30/oldXMenu/ChangeLog100666 12120 1 26316 6055517310 14445 0ustar rmsdaemonFri Nov 24 23:42:45 1995 Richard Stallman * Version 19.30 released. Mon Nov 13 00:16:30 1995 Richard Stallman * Makefile.in (ALL_CFLAGS): Add some -I options. * Activate.c, AddPane.c, AddSel.c, Create.c, InsPane.c, InsSel.c: * Internal.c, XCrAssoc.c, XMakeAssoc.c: Include config.h. Mon Jun 19 22:50:41 1995 Richard Stallman * Version 19.29 released. Tue Feb 7 18:50:09 1995 Richard Stallman * Makefile.in (maintainer-clean): Renamed from realclean. Tue Oct 25 18:49:26 1994 Richard Stallman * Makefile.in (ALL_CFLAGS): Reorder the switches more rationally. Mon Oct 24 14:39:54 1994 Jim Wilson (wilson@chestnut.cygnus.com) * Makefile.in (ALL_CFLAGS): Add C_SWITCH_X_MACHINE. Sun Sep 11 14:56:01 1994 Richard Stallman * Version 19.27 released. Wed Sep 7 03:54:08 1994 Richard Stallman * Version 19.26 released. Sat Jul 23 20:52:38 1994 Richard Stallman * Error.c (XMenuError): Make `message' static. Tue Jun 28 14:53:31 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Create.c (XAllocDisplayColor): New function. Use it throughout in place of XAllocNamedColor. Mon May 30 04:33:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.25 released. Mon May 23 03:32:01 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.24 released. Tue May 17 19:30:30 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu) * Create.c (XMenuCreate): Declare `data' as char*. Mon May 16 03:25:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.23 released. Tue Apr 12 11:57:11 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Create.c (XMenuCreate): Declare `data' as unsigned char*. Mon Jan 3 02:17:53 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * XMakeAssoc.c (XMakeAssoc): Use xmalloc. (_XIOErrorFunction): Decl deleted. Sat Nov 27 04:42:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.22 released. Fri Nov 26 02:34:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Activate.c (XMenuActivate): Call XSetWindowBackground and _XMRefreshPane. Tue Nov 16 06:14:38 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.21 released. Sat Nov 13 03:50:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (libXMenu11.a): Tell make not to worry if ranlib fails. Tell user too, in case make doesn't pay attention. Thu Nov 11 10:30:55 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.20 released. Mon Oct 25 02:25:19 1993 Brian Fox (bfox@albert.gnu.ai.mit.edu) * Makefile.in (ALL_CFLAGS): Add C_SWITCH_X_SYSTEM. Mon Sep 27 08:43:43 1993 Brian Fox (bfox@valhalla) * Makefile.in (CPP, LN_S, C_SWITCH_X_SITE, CC, CFLAGS): Allow `configure' to supply the values for these variables. Sun Sep 26 10:07:11 1993 Brian Fox (bfox@ai.mit.edu) * Makefile.in (VPATH, srcdir): Now that `configure' creates the Makefiles, do not append the current directory to the value of `srcdir' or `VPATH'. Sat Aug 14 00:23:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.19 released. Sun Aug 8 01:15:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.18 released. Fri Jul 30 16:12:43 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Internal.c (_XMWinQueInit): Use explicit loop, not bzero. Tue Jul 27 04:27:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile (ALL_CFLAGS): Use all 6 C_SWITCH_... vars. Among them, put the ..._SITE vars last. Sun Jul 18 02:38:03 1993 Jim Blandy (jimb@wookumz.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) * Version 19.16 released. Sat Jun 19 17:14:27 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * version 19.15 released. Fri Jun 18 12:31:02 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Makefile.in (ALL_CFLAGS): Always #define EMACS_BITMAP_FILES. This should make it work under any circumstances. * Makefile.in (mostlyclean): Use rm -f. Thu Jun 17 19:29:56 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.14 released. Thu Jun 17 15:03:22 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (ALL_CFLAGS): Include C_SWITCH_MACHINE, and CPPFLAGS. Put CFLAGS last. Wed Jun 16 11:53:18 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) Bring mumbleclean targets into conformance with GNU coding standards. * Makefile.in (mostlyclean, realclean): New targets. Tue Jun 8 08:29:27 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.13 released. Sun May 30 00:15:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.10 released. Sat May 29 02:18:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Create.c: Handle EMACS_BITMAP_FILES. Use new names of renamed bitmap files. Fri May 28 01:56:50 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * AddPane.c, AddSel.c, DelPane.c, DelSel.c, InsPane.c, InsSel.c, XDelAssoc.c, XMakeAssoc.c, XMenu.h, insque.c: Changed all uses of insque and remque to emacs_insque and emacs_remque, so we can safely include insque.c in the library on all systems. Thu May 27 23:34:44 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Makefile.in (.c.o): Use $< instead of ${srcdir}/$*.c; the latter only works with GNU Make. Thu May 27 09:22:39 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Create.c (XMenuCreate): Use classes PaneFont and SelectionFont. Thu May 27 02:35:32 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.9 released. Thu May 27 01:17:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Create.c (XMenuCreate): Use x_get_resource_string, not XGetDefault. Mon May 24 12:14:41 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.8 released. Sun May 23 17:47:43 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Makefile.in (C_SWITCH_X_SITE): New variable, so that the configuration process can correctly implement the --x-includes option. Sat May 22 23:48:24 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Create.c (XMenuCreate): Initialize the menu's pixmaps to None, not NULL. Sat May 22 19:37:01 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.7 released. Sat May 15 17:26:01 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Makefile.in: Renamed from Makefile, so that the top-level makefile can edit it. Tue Apr 13 02:38:44 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * XLookAssoc.c, XMakeAssoc: VMS needs , not . * XCrAssoc.c: #include , not "errno.h". (XCreateAssocTable): Doc fix. Wed Mar 24 20:49:08 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Makefile (.c.o): Include C_SWITCH_SITE and C_SWITCH_SYSTEM in the options to the C compiler. * compile.com, descrip.mms: New files for VMS from Richard Levitte. * XCrAssoc.c, XLookAssoc.c, XDestAssoc.c, XDelAssoc.c: Use around the names of the X Windows #include files; VMS needs this. * XLookAssoc.c, XMakeAssoc.c: #include . VMS needs this. * Create.c: On VMS, we have to look for the bitmap files in `./src/bitmaps', not . Sun Mar 14 13:47:06 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile (.c.o): Don't rm the .o files. Sat Mar 13 16:11:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Activate.c (XMenuActivate): If `active' field is negative, don't allow selecting a string. Tue Mar 9 12:52:13 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * Create.c (XMenuCreate): New variable `root', holding the display's default root window, so we don't have to write out "RootWindow (display, DefaultScreen (display))" a jillion times. * Create.c (XMenuCreate): Don't assume that all the patterns are 16x16. Instead of building a bitmap and then converting it to a pixmap of the appropriate depth if necessary, build a pixmap of the appropriate depth directly, using XCreatePixmapFromBitmapData. * Imakefile: Include XCrAssoc.c, XDelAssoc.c, XDestAssoc.c, XLookAssoc.c, and XMakeAssoc.c in SRCS. Similarly for OBJS. * XMenuInt.h: #include before , to avoid warnings about redefining NULL. * XMakeAssoc.c, XLookAssoc.c, XDestAssoc.c, XDelAssoc.c, XCrAssoc.c: #include X11/Xlib.h instead of X11/Xlibint.h. * XMakeAssoc.c, XLookAssoc.c, XCrAssoc.c: If NULL isn't defined by any of the `.h' files, define it. * XMakeAssoc.c, XCrAssoc.c: #include . Add an extern declaration for errno. * XMakeAssoc.c: Add an extern declaration for _XIOErrorFunction. (XMakeAssoc): Use malloc instead of Xmalloc to allocate new parts of the assoc table. * XCrAssoc.c (XCreateAssocTable): Same. * XDestAssoc.c (XDestroyAssocTable): Use free instead of Xfree. * XDelAssoc.c (XDeleteAssoc): Same. Sun Oct 18 17:46:43 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * XMakeAssoc.c (XMakeAssoc): Use malloc, not Xmalloc. * XCrAssoc.c (XCreateAssocTable): Use malloc and calloc directly. * XDelAssoc.c (XDeleteAssoc): Use free, not Xfree. * XDestAssoc.c (XDestroyAssocTable): Likewise. Sat Oct 17 17:35:03 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * XDelAssoc.c, XLookAssoc.c, XCrAssoc.c, XDestAssoc.c, XMakeAssoc.c: Use Xlib.h, not Xlibint.h. * XLookAssoc.c, XMakeAssoc.c, XCrAssoc.c (NULL): Defined. * XMakeAssoc.c, XCrAssoc.c: Include errno.h. Declare errno. * XMakeAssoc.c (_XIOErrorFunction): Declared. Sat Sep 19 03:44:41 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * XDelAssoc.c, XLookAssoc.c, XCrAssoc.c, XDestAssoc.c, XMakeAssoc.c: Specify dir X11/ when including Xlibint.h. Thu Sep 17 18:46:54 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * XDelAssoc.c, XLookAssoc.c, XCrAssoc.c, XDestAssoc.c, XMakeAssoc.c: New files. * Makefile (SRCS, OBJS): Compile those files. Fri Jan 31 23:45:10 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile (clean): Delete object files and library. (distclean): New target. Wed Jan 29 14:38:32 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile (libXMenu11.a): Put `-' on ranlib line. Mon Jan 27 15:25:35 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile (EXTRA): New variable. (libXMenu11.a): Use that. * insque.c: New file. Sun Jan 26 00:43:25 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile (CC): Assignment commented out. Sat Nov 16 06:27:39 1991 Noah Friedman (friedman at nutrimat) * copyright.h: New file (copied from X11R4 distribution) * All files: Replaced occurrences of #include with #include "copyright.h" Fri Oct 25 00:03:06 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * XMenu.h (enum _xmmode): Remove spurious comma. * X10.h: New file. * XMenu.h, XMenuInt.h: Include X10.h from this dir. Tue Nov 13 17:17:59 1990 Richard Stallman (rms at mole.ai.mit.edu) * XMenu.h (struct _xmenu): Use unsigned long for colors. Mon Nov 12 18:55:06 1990 Richard Stallman (rms at mole.ai.mit.edu) * Internal.c: Declare argument `display' in some functions. emacs-19.30/oldXMenu/compile.com100644 13437 13 7576 5354207440 14701 0ustar jimbuser$! This file was autogenerated with the command: $! $! mms/noaction/output = compile.com $ if f$search("ACTIVATE.OBJ") then delete ACTIVATE.OBJ.* $ cc /obj=ACTIVATE.OBJ /NOLIST/OBJECT=ACTIVATE.OBJ ACTIVATE.c $ if f$search("ADDPANE.OBJ") then delete ADDPANE.OBJ.* $ cc /obj=ADDPANE.OBJ /NOLIST/OBJECT=ADDPANE.OBJ ADDPANE.c $ if f$search("ADDSEL.OBJ") then delete ADDSEL.OBJ.* $ cc /obj=ADDSEL.OBJ /NOLIST/OBJECT=ADDSEL.OBJ ADDSEL.c $ if f$search("CHGPANE.OBJ") then delete CHGPANE.OBJ.* $ cc /obj=CHGPANE.OBJ /NOLIST/OBJECT=CHGPANE.OBJ CHGPANE.c $ if f$search("CHGSEL.OBJ") then delete CHGSEL.OBJ.* $ cc /obj=CHGSEL.OBJ /NOLIST/OBJECT=CHGSEL.OBJ CHGSEL.c $ if f$search("CREATE.OBJ") then delete CREATE.OBJ.* $ cc /obj=CREATE.OBJ /NOLIST/OBJECT=CREATE.OBJ CREATE.c $ if f$search("DELPANE.OBJ") then delete DELPANE.OBJ.* $ cc /obj=DELPANE.OBJ /NOLIST/OBJECT=DELPANE.OBJ DELPANE.c $ if f$search("DELSEL.OBJ") then delete DELSEL.OBJ.* $ cc /obj=DELSEL.OBJ /NOLIST/OBJECT=DELSEL.OBJ DELSEL.c $ if f$search("DESTROY.OBJ") then delete DESTROY.OBJ.* $ cc /obj=DESTROY.OBJ /NOLIST/OBJECT=DESTROY.OBJ DESTROY.c $ if f$search("ERROR.OBJ") then delete ERROR.OBJ.* $ cc /obj=ERROR.OBJ /NOLIST/OBJECT=ERROR.OBJ ERROR.c $ if f$search("EVHAND.OBJ") then delete EVHAND.OBJ.* $ cc /obj=EVHAND.OBJ /NOLIST/OBJECT=EVHAND.OBJ EVHAND.c $ if f$search("FINDPANE.OBJ") then delete FINDPANE.OBJ.* $ cc /obj=FINDPANE.OBJ /NOLIST/OBJECT=FINDPANE.OBJ FINDPANE.c $ if f$search("FINDSEL.OBJ") then delete FINDSEL.OBJ.* $ cc /obj=FINDSEL.OBJ /NOLIST/OBJECT=FINDSEL.OBJ FINDSEL.c $ if f$search("INSPANE.OBJ") then delete INSPANE.OBJ.* $ cc /obj=INSPANE.OBJ /NOLIST/OBJECT=INSPANE.OBJ INSPANE.c $ if f$search("INSSEL.OBJ") then delete INSSEL.OBJ.* $ cc /obj=INSSEL.OBJ /NOLIST/OBJECT=INSSEL.OBJ INSSEL.c $ if f$search("INTERNAL.OBJ") then delete INTERNAL.OBJ.* $ cc /obj=INTERNAL.OBJ /NOLIST/OBJECT=INTERNAL.OBJ INTERNAL.c $ if f$search("LOCATE.OBJ") then delete LOCATE.OBJ.* $ cc /obj=LOCATE.OBJ /NOLIST/OBJECT=LOCATE.OBJ LOCATE.c $ if f$search("POST.OBJ") then delete POST.OBJ.* $ cc /obj=POST.OBJ /NOLIST/OBJECT=POST.OBJ POST.c $ if f$search("RECOMP.OBJ") then delete RECOMP.OBJ.* $ cc /obj=RECOMP.OBJ /NOLIST/OBJECT=RECOMP.OBJ RECOMP.c $ if f$search("SETAEQ.OBJ") then delete SETAEQ.OBJ.* $ cc /obj=SETAEQ.OBJ /NOLIST/OBJECT=SETAEQ.OBJ SETAEQ.c $ if f$search("SETFRZ.OBJ") then delete SETFRZ.OBJ.* $ cc /obj=SETFRZ.OBJ /NOLIST/OBJECT=SETFRZ.OBJ SETFRZ.c $ if f$search("SETPANE.OBJ") then delete SETPANE.OBJ.* $ cc /obj=SETPANE.OBJ /NOLIST/OBJECT=SETPANE.OBJ SETPANE.c $ if f$search("SETSEL.OBJ") then delete SETSEL.OBJ.* $ cc /obj=SETSEL.OBJ /NOLIST/OBJECT=SETSEL.OBJ SETSEL.c $ if f$search("XDELASSOC.OBJ") then delete XDELASSOC.OBJ.* $ cc /obj=XDELASSOC.OBJ /NOLIST/OBJECT=XDELASSOC.OBJ XDELASSOC.c $ if f$search("XLOOKASSOC.OBJ") then delete XLOOKASSOC.OBJ.* $ cc /obj=XLOOKASSOC.OBJ /NOLIST/OBJECT=XLOOKASSOC.OBJ XLOOKASSOC.c $ if f$search("XCRASSOC.OBJ") then delete XCRASSOC.OBJ.* $ cc /obj=XCRASSOC.OBJ /NOLIST/OBJECT=XCRASSOC.OBJ XCRASSOC.c $ if f$search("XDESTASSOC.OBJ") then delete XDESTASSOC.OBJ.* $ cc /obj=XDESTASSOC.OBJ /NOLIST/OBJECT=XDESTASSOC.OBJ XDESTASSOC.c $ if f$search("XMAKEASSOC.OBJ") then delete XMAKEASSOC.OBJ.* $ cc /obj=XMAKEASSOC.OBJ /NOLIST/OBJECT=XMAKEASSOC.OBJ XMAKEASSOC.c $ if f$search("INSQUE.OBJ") then delete INSQUE.OBJ.* $ cc /obj=INSQUE.OBJ /NOLIST/OBJECT=INSQUE.OBJ INSQUE.c $ if f$search("LIBXMENU11.OLB") then delete LIBXMENU11.OLB.* $ library/insert/create LIBXMENU11.OLB Activate.obj, AddPane.obj, AddSel.obj, ChgPane.obj, ChgSel.obj, Create.obj, DelPane.obj, DelSel.obj, Destroy.obj, Error.obj, EvHand.obj, FindPane.obj, FindSel.obj, InsPane.obj, InsSel.obj, Internal.- obj, Locate.obj, Post.obj, Recomp.obj, SetAEQ.obj, SetFrz.obj, SetPane.obj, SetSel.obj, XDelAssoc.obj, XLookAssoc.obj, XCrAssoc.obj, XDestAssoc.obj, XMakeAssoc.obj $ if ("insque.obj" .nes. "") then library/insert LIBXMENU11.OLB insque.obj $ ! emacs-19.30/oldXMenu/descrip.mms100644 13437 13 3003 5354207441 14676 0ustar jimbuser!# Uncomment following line if linking temacs complains about missing insque. EXTRA=insque.obj AS = as CC = cc LD = link TAGS = etags RM = delete MV = rename AR = library/insert MAKE = mms STD_DEFINES = CDEBUGFLAGS = /debug/noopt RM_CMD = $(RM) *.BAK.*, *.obj.* SRCS = Activate.c, - AddPane.c, - AddSel.c, - ChgPane.c, - ChgSel.c, - Create.c, - DelPane.c, - DelSel.c, - Destroy.c, - Error.c, - EvHand.c, - FindPane.c, - FindSel.c, - InsPane.c, - InsSel.c, - Internal.c, - Locate.c, - Post.c, - Recomp.c, - SetAEQ.c, - SetFrz.c, - SetPane.c, - SetSel.c, - XDelAssoc.c, XLookAssoc.c, XCrAssoc.c, XDestAssoc.c, XMakeAssoc.c OBJS = Activate.obj, - AddPane.obj, - AddSel.obj, - ChgPane.obj, - ChgSel.obj, - Create.obj, - DelPane.obj, - DelSel.obj, - Destroy.obj, - Error.obj, - EvHand.obj, - FindPane.obj, - FindSel.obj, - InsPane.obj, - InsSel.obj, - Internal.obj, - Locate.obj, - Post.obj, - Recomp.obj, - SetAEQ.obj, - SetFrz.obj, - SetPane.obj, - SetSel.obj, - XDelAssoc.obj, XLookAssoc.obj, XCrAssoc.obj, XDestAssoc.obj, - XMakeAssoc.obj .c.obj : if f$search("$@") then $(RM) $@.* $(CC) /obj=$@ $(CFLAGS) $*.c all :: libXMenu11.olb ! libXMenu11.olb : $(OBJS) $(EXTRA) if f$search("$@") then $(RM) $@.* $(AR)/create $@ $(OBJS) if ("$(EXTRA)" .nes. "") then $(AR) $@ $(EXTRA) #If running ranlib fails, probably there is none. #That's ok. So don't stop the build. distclean : clean ! clean :: $(RM_CMD) \#* libXMenu11.a *.obj, tags :: $(TAGS) -t *.[ch] emacs-19.30/lwlib/ 40777 12120 1 0 6055530703 12125 5ustar rmsdaemonemacs-19.30/lwlib/dispatch.c100444 75424 1 17565 5770132717 14425 0ustar kwzhdaemon/* Defines a function to find the Widget that XtDispatchEvent() would use. Copyright (C) 1992 Lucid, Inc. This file is part of the Lucid Widget Library. The Lucid Widget Library 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. The Lucid Widget Library 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 function XtWidgetToDispatchTo(), given an XEvent, returns the * widget that XtDispatchEvent() would send that event to if called now. * This file copies much code from the X11r4 Xt source, and is thus a * portability problem. It also requires data structures defined in * IntrinsicI.h, which is a non-exported Xt header file, so you can't * compile this file unless you have the Xt sources online. */ #include /* Don't change this: see comments in Imakefile. */ #include #include "dispatch.h" #include #include #include #ifdef XlibSpecificationRelease #if XlibSpecificationRelease >= 5 #define HAVE_X11R5 #endif #endif /* ## All of the code on this page was copied from the X11R5 lib/Xt/Event.c, ## but is compatible with X11R4; the code in Event.c is different, but ## functionally equivalent for our purposes. */ #if __STDC__ #define Const const #else #define Const /**/ #endif #define NonMaskableMask ((EventMask)0x80000000L) #define COMP_EXPOSE (widget->core.widget_class->core_class.compress_exposure) #define COMP_EXPOSE_TYPE (COMP_EXPOSE & 0x0f) #define GRAPHICS_EXPOSE ((XtExposeGraphicsExpose & COMP_EXPOSE) || \ (XtExposeGraphicsExposeMerged & COMP_EXPOSE)) #define NO_EXPOSE (XtExposeNoExpose & COMP_EXPOSE) /* -- lots of stuff we don't need to copy, omitted -- */ static EventMask Const masks[] = { 0, /* Error, should never see */ 0, /* Reply, should never see */ KeyPressMask, /* KeyPress */ KeyReleaseMask, /* KeyRelease */ ButtonPressMask, /* ButtonPress */ ButtonReleaseMask, /* ButtonRelease */ PointerMotionMask /* MotionNotify */ | ButtonMotionMask, EnterWindowMask, /* EnterNotify */ LeaveWindowMask, /* LeaveNotify */ FocusChangeMask, /* FocusIn */ FocusChangeMask, /* FocusOut */ KeymapStateMask, /* KeymapNotify */ ExposureMask, /* Expose */ NonMaskableMask, /* GraphicsExpose, in GC */ NonMaskableMask, /* NoExpose, in GC */ VisibilityChangeMask, /* VisibilityNotify */ SubstructureNotifyMask, /* CreateNotify */ StructureNotifyMask /* DestroyNotify */ | SubstructureNotifyMask, StructureNotifyMask /* UnmapNotify */ | SubstructureNotifyMask, StructureNotifyMask /* MapNotify */ | SubstructureNotifyMask, SubstructureRedirectMask, /* MapRequest */ StructureNotifyMask /* ReparentNotify */ | SubstructureNotifyMask, StructureNotifyMask /* ConfigureNotify */ | SubstructureNotifyMask, SubstructureRedirectMask, /* ConfigureRequest */ StructureNotifyMask /* GravityNotify */ | SubstructureNotifyMask, ResizeRedirectMask, /* ResizeRequest */ StructureNotifyMask /* CirculateNotify */ | SubstructureNotifyMask, SubstructureRedirectMask, /* CirculateRequest */ PropertyChangeMask, /* PropertyNotify */ NonMaskableMask, /* SelectionClear */ NonMaskableMask, /* SelectionRequest */ NonMaskableMask, /* SelectionNotify */ ColormapChangeMask, /* ColormapNotify */ NonMaskableMask, /* ClientMessage */ NonMaskableMask /* MappingNotify */ }; #ifndef HAVE_X11R5 static /* in R5, this is not static, so we don't need to define it at all */ EventMask _XtConvertTypeToMask (eventType) int eventType; { eventType &= 0x7f; /* Events sent with XSendEvent have high bit set. */ if (eventType < XtNumber(masks)) return masks[eventType]; else return 0; } #endif /* not HAVE_X11R5 */ /* -- _XtOnGrabList() omitted -- */ static Widget LookupSpringLoaded(grabList) XtGrabList grabList; { XtGrabList gl; for (gl = grabList; gl != NULL; gl = gl->next) { if (gl->spring_loaded) if (XtIsSensitive(gl->widget)) return gl->widget; else return NULL; if (gl->exclusive) break; } return NULL; } /* This function is new. */ static Boolean WouldDispatchEvent(event, widget, mask, pd) register XEvent *event; Widget widget; EventMask mask; XtPerDisplay pd; { XtEventRec *p; Boolean would_dispatched = False; if ((mask == ExposureMask) || ((event->type == NoExpose) && NO_EXPOSE) || ((event->type == GraphicsExpose) && GRAPHICS_EXPOSE) ) if (widget->core.widget_class->core_class.expose != NULL ) return True; if ((mask == VisibilityChangeMask) && XtClass(widget)->core_class.visible_interest) return True; for (p=widget->core.event_table; p != NULL; p = p->next) if ((mask & p->mask) != 0 #ifndef HAVE_X11R5 || (mask == 0 && p->non_filter) #endif ) return True; return False; } /* #### This function is mostly copied from DecideToDispatch(). */ typedef enum _GrabType {pass, ignore, remap} GrabType; Widget XtWidgetToDispatchTo (XEvent* event) { register Widget widget; EventMask mask; GrabType grabType; Widget dspWidget; Time time = 0; XtPerDisplay pd; XtPerDisplayInput pdi; XtGrabList grabList; widget = XtWindowToWidget (event->xany.display, event->xany.window); pd = _XtGetPerDisplay(event->xany.display); pdi = _XtGetPerDisplayInput(event->xany.display); grabList = *_XtGetGrabList(pdi); mask = _XtConvertTypeToMask(event->xany.type); grabType = pass; switch (event->xany.type & 0x7f) { case KeyPress: case KeyRelease: grabType = remap; break; case ButtonPress: case ButtonRelease: grabType = remap; break; case MotionNotify: grabType = ignore; #define XKnownButtons (Button1MotionMask|Button2MotionMask|Button3MotionMask|\ Button4MotionMask|Button5MotionMask) mask |= (event->xmotion.state & XKnownButtons); #undef XKnownButtons break; case EnterNotify: grabType = ignore; break; } if (widget == NULL) { if (grabType != remap) return False; /* event occurred in a non-widget window, but we've promised also to dispatch it to the nearest accessible spring_loaded widget */ else if ((widget = LookupSpringLoaded(grabList)) != NULL) return widget; return False; } switch(grabType) { case pass: return widget; case ignore: if ((grabList == NULL || _XtOnGrabList(widget,grabList)) && XtIsSensitive(widget)) { return widget; } return NULL; case remap: { Widget was_dispatched_to= NULL; extern Widget _XtFindRemapWidget(); extern void _XtUngrabBadGrabs(); dspWidget = _XtFindRemapWidget(event, widget, mask, pdi); if ((grabList == NULL || _XtOnGrabList(dspWidget, grabList)) && XtIsSensitive(dspWidget)) { if (WouldDispatchEvent (event, dspWidget, mask, pd)) was_dispatched_to = dspWidget; } /* Also dispatch to nearest accessible spring_loaded. */ /* Fetch this afterward to reflect modal list changes */ grabList = *_XtGetGrabList(pdi); widget = LookupSpringLoaded(grabList); if (widget != NULL && widget != dspWidget) { if (!was_dispatched_to) was_dispatched_to = widget; } return was_dispatched_to; } } /* should never reach here */ return NULL; } emacs-19.30/lwlib/lwlib-Xaw.c100444 75424 1 41717 5770132737 14472 0ustar kwzhdaemon/* The lwlib interface to Athena widgets. Copyright (C) 1993 Chuck Thompson This file is part of the Lucid Widget Library. The Lucid Widget Library 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. The Lucid Widget Library 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. */ #include #include "lwlib-Xaw.h" #include #include #include #include #include #include #include #include #include #include #include static void xaw_generic_callback (/*Widget, XtPointer, XtPointer*/); Boolean lw_xaw_widget_p (widget) Widget widget; { return (XtIsSubclass (widget, scrollbarWidgetClass) || XtIsSubclass (widget, dialogWidgetClass)); } static void xaw_update_scrollbar (instance, widget, val) widget_instance *instance; Widget widget; widget_value *val; { #if 0 if (val->scrollbar_data) { scrollbar_values *data = val->scrollbar_data; Dimension height, width; Dimension pos_x, pos_y; int widget_shown, widget_topOfThumb; float new_shown, new_topOfThumb; XtVaGetValues (widget, XtNheight, &height, XtNwidth, &width, XtNx, &pos_x, XtNy, &pos_y, XtNtopOfThumb, &widget_topOfThumb, XtNshown, &widget_shown, 0); /* * First size and position the scrollbar widget. * We need to position it to second-guess the Paned widget's notion * of what should happen when the WMShell gets resized. */ if (height != data->scrollbar_height || pos_y != data->scrollbar_pos) { XtConfigureWidget (widget, pos_x, data->scrollbar_pos, width, data->scrollbar_height, 0); XtVaSetValues (widget, XtNlength, data->scrollbar_height, XtNthickness, width, 0); } /* * Now the size the scrollbar's slider. */ new_shown = (float) data->slider_size / (float) (data->maximum - data->minimum); new_topOfThumb = (float) (data->slider_position - data->minimum) / (float) (data->maximum - data->minimum); if (new_shown > 1.0) new_shown = 1.0; if (new_shown < 0) new_shown = 0; if (new_topOfThumb > 1.0) new_topOfThumb = 1.0; if (new_topOfThumb < 0) new_topOfThumb = 0; if (new_shown != widget_shown || new_topOfThumb != widget_topOfThumb) XawScrollbarSetThumb (widget, new_topOfThumb, new_shown); } #endif } void xaw_update_one_widget (instance, widget, val, deep_p) widget_instance *instance; Widget widget; widget_value *val; Boolean deep_p; { #if 0 if (XtIsSubclass (widget, scrollbarWidgetClass)) { xaw_update_scrollbar (instance, widget, val); } #endif if (XtIsSubclass (widget, dialogWidgetClass)) { Arg al[1]; int ac = 0; XtSetArg (al[ac], XtNlabel, val->contents->value); ac++; XtSetValues (widget, al, ac); } else if (XtIsSubclass (widget, commandWidgetClass)) { Dimension bw = 0; Arg al[3]; XtVaGetValues (widget, XtNborderWidth, &bw, 0); if (bw == 0) /* Don't let buttons end up with 0 borderwidth, that's ugly... Yeah, all this should really be done through app-defaults files or fallback resources, but that's a whole different can of worms that I don't feel like opening right now. Making Athena widgets not look like shit is just entirely too much work. */ { XtSetArg (al[0], XtNborderWidth, 1); XtSetValues (widget, al, 1); } XtSetArg (al[0], XtNlabel, val->value); XtSetArg (al[1], XtNsensitive, val->enabled); /* Force centered button text. Se above. */ XtSetArg (al[2], XtNjustify, XtJustifyCenter); XtSetValues (widget, al, 3); XtRemoveAllCallbacks (widget, XtNcallback); XtAddCallback (widget, XtNcallback, xaw_generic_callback, instance); } } void xaw_update_one_value (instance, widget, val) widget_instance *instance; Widget widget; widget_value *val; { /* This function is not used by the scrollbars and those are the only Athena widget implemented at the moment so do nothing. */ return; } void xaw_destroy_instance (instance) widget_instance *instance; { if (XtIsSubclass (instance->widget, dialogWidgetClass)) /* Need to destroy the Shell too. */ XtDestroyWidget (XtParent (instance->widget)); else XtDestroyWidget (instance->widget); } void xaw_popup_menu (widget) Widget widget; { /* An Athena menubar has not been implemented. */ return; } void xaw_pop_instance (instance, up) widget_instance *instance; Boolean up; { Widget widget = instance->widget; if (up) { if (XtIsSubclass (widget, dialogWidgetClass)) { /* For dialogs, we need to call XtPopup on the parent instead of calling XtManageChild on the widget. Also we need to hack the shell's WM_PROTOCOLS to get it to understand what the close box is supposed to do!! */ Display *dpy = XtDisplay (widget); Widget shell = XtParent (widget); Atom props [2]; int i = 0; props [i++] = XInternAtom (dpy, "WM_DELETE_WINDOW", False); XChangeProperty (dpy, XtWindow (shell), XInternAtom (dpy, "WM_PROTOCOLS", False), XA_ATOM, 32, PropModeAppend, (unsigned char *) props, i); /* Center the widget in its parent. Why isn't this kind of crap done automatically? I thought toolkits were supposed to make life easier? */ { unsigned int x, y, w, h; Widget topmost = instance->parent; Arg args[2]; w = shell->core.width; h = shell->core.height; while (topmost->core.parent && XtIsRealized (topmost->core.parent)) topmost = topmost->core.parent; if (topmost->core.width < w) x = topmost->core.x; else x = topmost->core.x + ((topmost->core.width - w) / 2); if (topmost->core.height < h) y = topmost->core.y; else y = topmost->core.y + ((topmost->core.height - h) / 2); /* Using XtMoveWidget caused the widget to come out in the wrong place with vtwm. Question of virtual vs real coords, perhaps. */ XtSetArg (args[0], XtNx, x); XtSetArg (args[1], XtNy, y); XtSetValues (shell, args, 2); } /* Finally, pop it up. */ XtPopup (shell, XtGrabNonexclusive); } else XtManageChild (widget); } else { if (XtIsSubclass (widget, dialogWidgetClass)) XtUnmanageChild (XtParent (widget)); else XtUnmanageChild (widget); } } /* Dialog boxes */ static char overrideTrans[] = "WM_PROTOCOLS: lwlib_delete_dialog()"; static void wm_delete_window(); static XtActionsRec xaw_actions [] = { {"lwlib_delete_dialog", wm_delete_window} }; static Boolean actions_initted = False; static Widget make_dialog (name, parent, pop_up_p, shell_title, icon_name, text_input_slot, radio_box, list, left_buttons, right_buttons) char* name; Widget parent; Boolean pop_up_p; char* shell_title; char* icon_name; Boolean text_input_slot; Boolean radio_box; Boolean list; int left_buttons; int right_buttons; { Arg av [20]; int ac = 0; int i, bc; char button_name [255]; Widget shell; Widget dialog; Widget button; XtTranslations override; if (! pop_up_p) abort (); /* not implemented */ if (text_input_slot) abort (); /* not implemented */ if (radio_box) abort (); /* not implemented */ if (list) abort (); /* not implemented */ if (! actions_initted) { XtAppContext app = XtWidgetToApplicationContext (parent); XtAppAddActions (app, xaw_actions, sizeof (xaw_actions) / sizeof (xaw_actions[0])); actions_initted = True; } override = XtParseTranslationTable (overrideTrans); ac = 0; XtSetArg (av[ac], XtNtitle, shell_title); ac++; XtSetArg (av[ac], XtNallowShellResize, True); ac++; /* Don't allow any geometry request from the user. */ XtSetArg (av[ac], XtNgeometry, 0); ac++; shell = XtCreatePopupShell ("dialog", transientShellWidgetClass, parent, av, ac); XtOverrideTranslations (shell, override); ac = 0; dialog = XtCreateManagedWidget (name, dialogWidgetClass, shell, av, ac); bc = 0; button = 0; for (i = 0; i < left_buttons; i++) { ac = 0; XtSetArg (av [ac], XtNfromHoriz, button); ac++; XtSetArg (av [ac], XtNleft, XtChainLeft); ac++; XtSetArg (av [ac], XtNright, XtChainLeft); ac++; XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; XtSetArg (av [ac], XtNresizable, True); ac++; sprintf (button_name, "button%d", ++bc); button = XtCreateManagedWidget (button_name, commandWidgetClass, dialog, av, ac); } if (right_buttons) { /* Create a separator I want the separator to take up the slack between the buttons on the right and the buttons on the left (that is I want the buttons after the separator to be packed against the right edge of the window) but I can't seem to make it do it. */ ac = 0; XtSetArg (av [ac], XtNfromHoriz, button); ac++; /* XtSetArg (av [ac], XtNfromVert, XtNameToWidget (dialog, "label")); ac++; */ XtSetArg (av [ac], XtNleft, XtChainLeft); ac++; XtSetArg (av [ac], XtNright, XtChainRight); ac++; XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; XtSetArg (av [ac], XtNlabel, ""); ac++; XtSetArg (av [ac], XtNwidth, 30); ac++; /* #### aaack!! */ XtSetArg (av [ac], XtNborderWidth, 0); ac++; XtSetArg (av [ac], XtNshapeStyle, XmuShapeRectangle); ac++; XtSetArg (av [ac], XtNresizable, False); ac++; XtSetArg (av [ac], XtNsensitive, False); ac++; button = XtCreateManagedWidget ("separator", /* labelWidgetClass, */ /* This has to be Command to fake out the Dialog widget... */ commandWidgetClass, dialog, av, ac); } for (i = 0; i < right_buttons; i++) { ac = 0; XtSetArg (av [ac], XtNfromHoriz, button); ac++; XtSetArg (av [ac], XtNleft, XtChainRight); ac++; XtSetArg (av [ac], XtNright, XtChainRight); ac++; XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; XtSetArg (av [ac], XtNresizable, True); ac++; sprintf (button_name, "button%d", ++bc); button = XtCreateManagedWidget (button_name, commandWidgetClass, dialog, av, ac); } return dialog; } Widget xaw_create_dialog (instance) widget_instance* instance; { char *name = instance->info->type; Widget parent = instance->parent; Widget widget; Boolean pop_up_p = instance->pop_up_p; char *shell_name = 0; char *icon_name; Boolean text_input_slot = False; Boolean radio_box = False; Boolean list = False; int total_buttons; int left_buttons = 0; int right_buttons = 1; switch (name [0]) { case 'E': case 'e': icon_name = "dbox-error"; shell_name = "Error"; break; case 'I': case 'i': icon_name = "dbox-info"; shell_name = "Information"; break; case 'L': case 'l': list = True; icon_name = "dbox-question"; shell_name = "Prompt"; break; case 'P': case 'p': text_input_slot = True; icon_name = "dbox-question"; shell_name = "Prompt"; break; case 'Q': case 'q': icon_name = "dbox-question"; shell_name = "Question"; break; } total_buttons = name [1] - '0'; if (name [3] == 'T' || name [3] == 't') { text_input_slot = False; radio_box = True; } else if (name [3]) right_buttons = name [4] - '0'; left_buttons = total_buttons - right_buttons; widget = make_dialog (name, parent, pop_up_p, shell_name, icon_name, text_input_slot, radio_box, list, left_buttons, right_buttons); return widget; } static void xaw_generic_callback (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { widget_instance *instance = (widget_instance *) closure; Widget instance_widget; LWLIB_ID id; XtPointer user_data; lw_internal_update_other_instances (widget, closure, call_data); if (! instance) return; if (widget->core.being_destroyed) return; instance_widget = instance->widget; if (!instance_widget) return; id = instance->info->id; #if 0 user_data = NULL; XtVaGetValues (widget, XtNuserData, &user_data, 0); #else /* Damn! Athena doesn't give us a way to hang our own data on the buttons, so we have to go find it... I guess this assumes that all instances of a button have the same call data. */ { widget_value *val = instance->info->val->contents; char *name = XtName (widget); while (val) { if (val->name && !strcmp (val->name, name)) break; val = val->next; } if (! val) abort (); user_data = val->call_data; } #endif if (instance->info->selection_cb) instance->info->selection_cb (widget, id, user_data); } static void wm_delete_window (shell, closure, call_data) Widget shell; XtPointer closure; XtPointer call_data; { LWLIB_ID id; Widget *kids = 0; Widget widget; if (! XtIsSubclass (shell, shellWidgetClass)) abort (); XtVaGetValues (shell, XtNchildren, &kids, 0); if (!kids || !*kids) abort (); widget = kids [0]; if (! XtIsSubclass (widget, dialogWidgetClass)) abort (); id = lw_get_widget_id (widget); if (! id) abort (); { widget_info *info = lw_get_widget_info (id); if (! info) abort (); if (info->selection_cb) info->selection_cb (widget, id, (XtPointer) -1); } lw_destroy_all_widgets (id); } /* Scrollbars */ static void xaw_scrollbar_scroll (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { #if 0 widget_instance *instance = (widget_instance *) closure; LWLIB_ID id; scroll_event event_data; if (!instance || widget->core.being_destroyed) return; id = instance->info->id; event_data.slider_value = 0; event_data.time = 0; if ((int) call_data > 0) event_data.action = SCROLLBAR_PAGE_DOWN; else event_data.action = SCROLLBAR_PAGE_UP; if (instance->info->pre_activate_cb) instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data); #endif } static void xaw_scrollbar_jump (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { #if 0 widget_instance *instance = (widget_instance *) closure; LWLIB_ID id; scroll_event event_data; scrollbar_values *val = (scrollbar_values *) instance->info->val->scrollbar_data; float percent; if (!instance || widget->core.being_destroyed) return; id = instance->info->id; percent = * (float *) call_data; event_data.slider_value = (int) (percent * (float) (val->maximum - val->minimum)) + val->minimum; event_data.time = 0; event_data.action = SCROLLBAR_DRAG; if (instance->info->pre_activate_cb) instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data); #endif } static Widget xaw_create_scrollbar (instance) widget_instance *instance; { #if 0 Arg av[20]; int ac = 0; Dimension width; Widget scrollbar; XtVaGetValues (instance->parent, XtNwidth, &width, 0); XtSetArg (av[ac], XtNshowGrip, 0); ac++; XtSetArg (av[ac], XtNresizeToPreferred, 1); ac++; XtSetArg (av[ac], XtNallowResize, True); ac++; XtSetArg (av[ac], XtNskipAdjust, True); ac++; XtSetArg (av[ac], XtNwidth, width); ac++; XtSetArg (av[ac], XtNmappedWhenManaged, True); ac++; scrollbar = XtCreateWidget (instance->info->name, scrollbarWidgetClass, instance->parent, av, ac); /* We have to force the border width to be 0 otherwise the geometry manager likes to start looping for awhile... */ XtVaSetValues (scrollbar, XtNborderWidth, 0, 0); XtRemoveAllCallbacks (scrollbar, "jumpProc"); XtRemoveAllCallbacks (scrollbar, "scrollProc"); XtAddCallback (scrollbar, "jumpProc", xaw_scrollbar_jump, (XtPointer) instance); XtAddCallback (scrollbar, "scrollProc", xaw_scrollbar_scroll, (XtPointer) instance); return scrollbar; #endif } static Widget xaw_create_main (instance) widget_instance *instance; { Arg al[1]; int ac; /* Create a vertical Paned to hold menubar */ ac = 0; XtSetArg (al[ac], XtNborderWidth, 0); ac++; return XtCreateWidget (instance->info->name, panedWidgetClass, instance->parent, al, ac); } widget_creation_entry xaw_creation_table [] = { {"scrollbar", xaw_create_scrollbar}, {"main", xaw_create_main}, {NULL, NULL} }; emacs-19.30/lwlib/lwlib-Xlw.c100444 12120 1 13327 6007621464 14271 0ustar rmsdaemon/* The lwlib interface to "xlwmenu" menus. Copyright (C) 1992 Lucid, Inc. This file is part of the Lucid Widget Library. The Lucid Widget Library 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. The Lucid Widget Library 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. */ #include "lwlib-Xlw.h" #include #include #include #include #include #include "xlwmenu.h" /* Menu callbacks */ static void pre_hook (w, client_data, call_data) Widget w; XtPointer client_data; XtPointer call_data; { widget_instance* instance = (widget_instance*)client_data; widget_value* val; if (w->core.being_destroyed) return; val = lw_get_widget_value_for_widget (instance, w); if (instance->info->pre_activate_cb) instance->info->pre_activate_cb (w, instance->info->id, val ? val->call_data : NULL); } static void pick_hook (w, client_data, call_data) Widget w; XtPointer client_data; XtPointer call_data; { widget_instance* instance = (widget_instance*)client_data; widget_value* contents_val = (widget_value*)call_data; widget_value* widget_val; XtPointer widget_arg; if (w->core.being_destroyed) return; if (instance->info->selection_cb && contents_val && contents_val->enabled && !contents_val->contents) instance->info->selection_cb (w, instance->info->id, contents_val->call_data); widget_val = lw_get_widget_value_for_widget (instance, w); widget_arg = widget_val ? widget_val->call_data : NULL; if (instance->info->post_activate_cb) instance->info->post_activate_cb (w, instance->info->id, widget_arg); } /* creation functions */ static Widget xlw_create_menubar (instance) widget_instance* instance; { Widget widget; Arg al[5]; int ac = 0; XtSetArg (al[ac], XtNmenu, instance->info->val); ac++; #ifdef emacs XtSetArg (al[ac], XtNshowGrip, 0); ac++; XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++; XtSetArg (al[ac], XtNallowResize, 1); ac++; #endif /* This used to use XtVaCreateWidget, but an old Xt version has a bug in XtVaCreateWidget that frees instance->info->name. */ widget = XtCreateWidget (instance->info->name, xlwMenuWidgetClass, instance->parent, al, ac); XtAddCallback (widget, XtNopen, pre_hook, (XtPointer)instance); XtAddCallback (widget, XtNselect, pick_hook, (XtPointer)instance); return widget; } static Widget xlw_create_popup_menu (instance) widget_instance* instance; { Widget popup_shell = XtCreatePopupShell (instance->info->name, overrideShellWidgetClass, instance->parent, NULL, 0); Widget widget; Arg al[2]; int ac = 0; XtSetArg (al[ac], XtNmenu, instance->info->val); ac++; XtSetArg (al[ac], XtNhorizontal, False); ac++; /* This used to use XtVaManagedCreateWidget, but an old Xt version has a bug in XtVaManagedCreateWidget that frees instance->info->name. */ widget = XtCreateManagedWidget ("popup", xlwMenuWidgetClass, popup_shell, al, ac); XtAddCallback (widget, XtNselect, pick_hook, (XtPointer)instance); return popup_shell; } widget_creation_entry xlw_creation_table [] = { {"menubar", xlw_create_menubar}, {"popup", xlw_create_popup_menu}, {NULL, NULL} }; Boolean lw_lucid_widget_p (widget) Widget widget; { WidgetClass the_class = XtClass (widget); if (the_class == xlwMenuWidgetClass) return True; if (the_class == overrideShellWidgetClass) return (XtClass (((CompositeWidget)widget)->composite.children [0]) == xlwMenuWidgetClass); return False; } void xlw_update_one_widget (instance, widget, val, deep_p) widget_instance* instance; Widget widget; widget_value* val; Boolean deep_p; { XlwMenuWidget mw; Arg al[1]; if (XtIsShell (widget)) mw = (XlwMenuWidget)((CompositeWidget)widget)->composite.children [0]; else mw = (XlwMenuWidget)widget; /* This used to use XtVaSetValues, but some old Xt versions that have a bug in XtVaCreateWidget might have it here too. */ XtSetArg (al[0], XtNmenu, instance->info->val); XtSetValues (widget, al, 1); } void xlw_update_one_value (instance, widget, val) widget_instance* instance; Widget widget; widget_value* val; { return; } void xlw_pop_instance (instance, up) widget_instance* instance; Boolean up; { } void xlw_popup_menu (widget, event) Widget widget; XEvent *event; { XButtonPressedEvent dummy; XlwMenuWidget mw; if (!XtIsShell (widget)) return; mw = (XlwMenuWidget)((CompositeWidget)widget)->composite.children [0]; if (event) pop_up_menu (mw, event); else { dummy.type = ButtonPress; dummy.serial = 0; dummy.send_event = 0; dummy.display = XtDisplay (widget); dummy.window = XtWindow (XtParent (widget)); dummy.time = CurrentTime; dummy.button = 0; XQueryPointer (dummy.display, dummy.window, &dummy.root, &dummy.subwindow, &dummy.x_root, &dummy.y_root, &dummy.x, &dummy.y, &dummy.state); pop_up_menu (mw, &dummy); } } /* Destruction of instances */ void xlw_destroy_instance (instance) widget_instance* instance; { if (instance->widget) XtDestroyWidget (instance->widget); } emacs-19.30/lwlib/lwlib-Xm.c100444 12120 1 131211 6007622102 14102 0ustar rmsdaemon/* The lwlib interface to Motif widgets. Copyright (C) 1992 Lucid, Inc. This file is part of the Lucid Widget Library. The Lucid Widget Library 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. The Lucid Widget Library 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. */ #include #include #include #include #include #include #include #include #include #include "lwlib-Xm.h" #include "lwlib-utils.h" #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include static void xm_pull_down_callback (/* Widget, XtPointer, XtPointer */); static void xm_internal_update_other_instances (/* Widget, XtPointer, XtPointer */); static void xm_generic_callback (/* Widget, XtPointer, XtPointer */); static void xm_nosel_callback (/* Widget, XtPointer, XtPointer */); static void xm_pop_down_callback (/* Widget, XtPointer, XtPointer */); static void xm_update_menu (/* widget_instance*, Widget, widget_value*, Boolean) */); /* Structures to keep destroyed instances */ typedef struct _destroyed_instance { char* name; char* type; Widget widget; Widget parent; Boolean pop_up_p; struct _destroyed_instance* next; } destroyed_instance; static destroyed_instance* all_destroyed_instances = NULL; static destroyed_instance* make_destroyed_instance (name, type, widget, parent, pop_up_p) char* name; char* type; Widget widget; Widget parent; Boolean pop_up_p; { destroyed_instance* instance = (destroyed_instance*)malloc (sizeof (destroyed_instance)); instance->name = safe_strdup (name); instance->type = safe_strdup (type); instance->widget = widget; instance->parent = parent; instance->pop_up_p = pop_up_p; instance->next = NULL; return instance; } static void free_destroyed_instance (instance) destroyed_instance* instance; { free (instance->name); free (instance->type); free (instance); } /* motif utility functions */ Widget first_child (widget) Widget widget; { return ((CompositeWidget)widget)->composite.children [0]; } Boolean lw_motif_widget_p (widget) Widget widget; { return XtClass (widget) == xmDialogShellWidgetClass || XmIsPrimitive (widget) || XmIsManager (widget) || XmIsGadget (widget); } static XmString resource_motif_string (widget, name) Widget widget; char* name; { XtResource resource; XmString result = 0; resource.resource_name = name; resource.resource_class = XmCXmString; resource.resource_type = XmRXmString; resource.resource_size = sizeof (XmString); resource.resource_offset = 0; resource.default_type = XtRImmediate; resource.default_addr = 0; XtGetSubresources (widget, (XtPointer)&result, "dialogString", "DialogString", &resource, 1, NULL, 0); return result; } static void destroy_all_children (widget) Widget widget; { Widget* children; unsigned int number; int i; children = XtCompositeChildren (widget, &number); if (children) { /* Unmanage all children and destroy them. They will only be * really destroyed when we get out of DispatchEvent. */ for (i = 0; i < number; i++) { Widget child = children [i]; if (!child->core.being_destroyed) { XtUnmanageChild (child); XtDestroyWidget (child); } } XtFree ((char *) children); } } /* update the label of anything subclass of a label */ static void xm_update_label (instance, widget, val) widget_instance* instance; Widget widget; widget_value* val; { XmString res_string = 0; XmString built_string = 0; XmString key_string = 0; Arg al [256]; int ac; ac = 0; if (val->value) { res_string = resource_motif_string (widget, val->value); if (res_string) { XtSetArg (al [ac], XmNlabelString, res_string); ac++; } else { built_string = XmStringCreateLtoR (val->value, XmSTRING_DEFAULT_CHARSET); XtSetArg (al [ac], XmNlabelString, built_string); ac++; } XtSetArg (al [ac], XmNlabelType, XmSTRING); ac++; } if (val->key) { key_string = XmStringCreateLtoR (val->key, XmSTRING_DEFAULT_CHARSET); XtSetArg (al [ac], XmNacceleratorText, key_string); ac++; } if (ac) XtSetValues (widget, al, ac); if (built_string) XmStringFree (built_string); if (key_string) XmStringFree (key_string); } /* update of list */ static void xm_update_list (instance, widget, val) widget_instance* instance; Widget widget; widget_value* val; { widget_value* cur; int i; XtRemoveAllCallbacks (widget, XmNsingleSelectionCallback); XtAddCallback (widget, XmNsingleSelectionCallback, xm_generic_callback, instance); for (cur = val->contents, i = 0; cur; cur = cur->next) if (cur->value) { XmString xmstr = XmStringCreate (cur->value, XmSTRING_DEFAULT_CHARSET); i += 1; XmListAddItem (widget, xmstr, 0); if (cur->selected) XmListSelectPos (widget, i, False); XmStringFree (xmstr); } } /* update of buttons */ static void xm_update_pushbutton (instance, widget, val) widget_instance* instance; Widget widget; widget_value* val; { XtVaSetValues (widget, XmNalignment, XmALIGNMENT_CENTER, 0); XtRemoveAllCallbacks (widget, XmNactivateCallback); XtAddCallback (widget, XmNactivateCallback, xm_generic_callback, instance); } static void xm_update_cascadebutton (instance, widget, val) widget_instance* instance; Widget widget; widget_value* val; { /* Should also rebuild the menu by calling ...update_menu... */ XtRemoveAllCallbacks (widget, XmNcascadingCallback); XtAddCallback (widget, XmNcascadingCallback, xm_pull_down_callback, instance); } /* update toggle and radiobox */ static void xm_update_toggle (instance, widget, val) widget_instance* instance; Widget widget; widget_value* val; { XtRemoveAllCallbacks (widget, XmNvalueChangedCallback); XtAddCallback (widget, XmNvalueChangedCallback, xm_internal_update_other_instances, instance); XtVaSetValues (widget, XmNset, val->selected, XmNalignment, XmALIGNMENT_BEGINNING, 0); } static void xm_update_radiobox (instance, widget, val) widget_instance* instance; Widget widget; widget_value* val; { Widget toggle; widget_value* cur; /* update the callback */ XtRemoveAllCallbacks (widget, XmNentryCallback); XtAddCallback (widget, XmNentryCallback, xm_generic_callback, instance); /* first update all the toggles */ /* Energize kernel interface is currently bad. It sets the selected widget with the selected flag but returns it by its name. So we currently have to support both setting the selection with the selected slot of val contents and setting it with the "value" slot of val. The latter has a higher priority. This to be removed when the kernel is fixed. */ for (cur = val->contents; cur; cur = cur->next) { toggle = XtNameToWidget (widget, cur->value); if (toggle) { XtVaSetValues (toggle, XmNsensitive, cur->enabled, 0); if (!val->value && cur->selected) XtVaSetValues (toggle, XmNset, cur->selected, 0); if (val->value && strcmp (val->value, cur->value)) XtVaSetValues (toggle, XmNset, False, 0); } } /* The selected was specified by the value slot */ if (val->value) { toggle = XtNameToWidget (widget, val->value); if (toggle) XtVaSetValues (toggle, XmNset, True, 0); } } /* update a popup menu, pulldown menu or a menubar */ static Boolean all_dashes_p (s) char* s; { char* t; for (t = s; *t; t++) if (*t != '-') return False; return True; } static void make_menu_in_widget (instance, widget, val) widget_instance* instance; Widget widget; widget_value* val; { Widget* children = 0; int num_children; int child_index; widget_value* cur; Widget button = 0; Widget menu; Arg al [256]; int ac; Boolean menubar_p; /* Allocate the children array */ for (num_children = 0, cur = val; cur; num_children++, cur = cur->next); children = (Widget*)XtMalloc (num_children * sizeof (Widget)); /* tricky way to know if this RowColumn is a menubar or a pulldown... */ menubar_p = False; XtSetArg (al[0], XmNisHomogeneous, &menubar_p); XtGetValues (widget, al, 1); /* add the unmap callback for popups and pulldowns */ /*** this sounds bogus ***/ if (!menubar_p) XtAddCallback (XtParent (widget), XmNpopdownCallback, xm_pop_down_callback, (XtPointer)instance); for (child_index = 0, cur = val; cur; child_index++, cur = cur->next) { ac = 0; XtSetArg (al [ac], XmNsensitive, cur->enabled); ac++; XtSetArg (al [ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; XtSetArg (al [ac], XmNuserData, cur->call_data); ac++; if (instance->pop_up_p && !cur->contents && !cur->call_data && !all_dashes_p (cur->name)) { ac = 0; XtSetArg (al[ac], XmNalignment, XmALIGNMENT_CENTER); ac++; button = XmCreateLabel (widget, cur->name, al, ac); } else if (all_dashes_p (cur->name)) { button = XmCreateSeparator (widget, cur->name, NULL, 0); } else if (!cur->contents) { if (menubar_p) button = XmCreateCascadeButton (widget, cur->name, al, ac); else if (!cur->call_data) button = XmCreateLabel (widget, cur->name, al, ac); else button = XmCreatePushButtonGadget (widget, cur->name, al, ac); xm_update_label (instance, button, cur); /* don't add a callback to a simple label */ if (cur->call_data) XtAddCallback (button, XmNactivateCallback, xm_generic_callback, (XtPointer)instance); } else { menu = XmCreatePulldownMenu (widget, cur->name, NULL, 0); make_menu_in_widget (instance, menu, cur->contents); XtSetArg (al [ac], XmNsubMenuId, menu); ac++; button = XmCreateCascadeButton (widget, cur->name, al, ac); xm_update_label (instance, button, cur); XtAddCallback (button, XmNcascadingCallback, xm_pull_down_callback, (XtPointer)instance); } children [child_index] = button; } XtManageChildren (children, num_children); /* Last entry is the help button. Has to be done after managing * the buttons otherwise the menubar is only 4 pixels high... */ if (button) { ac = 0; XtSetArg (al [ac], XmNmenuHelpWidget, button); ac++; XtSetValues (widget, al, ac); } XtFree ((char *) children); } static void update_one_menu_entry (instance, widget, val, deep_p) widget_instance* instance; Widget widget; widget_value* val; Boolean deep_p; { Arg al [256]; int ac; Widget menu; widget_value* contents; if (val->change == NO_CHANGE) return; /* update the sensitivity and userdata */ /* Common to all widget types */ XtVaSetValues (widget, XmNsensitive, val->enabled, XmNuserData, val->call_data, 0); /* update the menu button as a label. */ if (val->change >= VISIBLE_CHANGE) xm_update_label (instance, widget, val); /* update the pulldown/pullaside as needed */ ac = 0; menu = NULL; XtSetArg (al [ac], XmNsubMenuId, &menu); ac++; XtGetValues (widget, al, ac); contents = val->contents; if (!menu) { if (contents) { menu = XmCreatePulldownMenu (XtParent (widget), XtName (widget), NULL, 0); make_menu_in_widget (instance, menu, contents); ac = 0; XtSetArg (al [ac], XmNsubMenuId, menu); ac++; XtSetValues (widget, al, ac); } } else if (!contents) { ac = 0; XtSetArg (al [ac], XmNsubMenuId, NULL); ac++; XtSetValues (widget, al, ac); XtDestroyWidget (menu); } else if (deep_p && contents->change != NO_CHANGE) xm_update_menu (instance, menu, val, 1); } static void xm_update_menu (instance, widget, val, deep_p) widget_instance* instance; Widget widget; widget_value* val; Boolean deep_p; { /* Widget is a RowColumn widget whose contents have to be updated * to reflect the list of items in val->contents */ if (val->contents->change == STRUCTURAL_CHANGE) { destroy_all_children (widget); make_menu_in_widget (instance, widget, val->contents); } else { /* Update all the buttons of the RowColumn in order. */ Widget* children; unsigned int num_children; int i; widget_value* cur; children = XtCompositeChildren (widget, &num_children); if (children) { for (i = 0, cur = val->contents; i < num_children; i++) { if (!cur) abort (); if (children [i]->core.being_destroyed || strcmp (XtName (children [i]), cur->name)) continue; update_one_menu_entry (instance, children [i], cur, deep_p); cur = cur->next; } XtFree ((char *) children); } if (cur) abort (); } } /* update text widgets */ static void xm_update_text (instance, widget, val) widget_instance* instance; Widget widget; widget_value* val; { XmTextSetString (widget, val->value ? val->value : ""); XtRemoveAllCallbacks (widget, XmNactivateCallback); XtAddCallback (widget, XmNactivateCallback, xm_generic_callback, instance); XtRemoveAllCallbacks (widget, XmNvalueChangedCallback); XtAddCallback (widget, XmNvalueChangedCallback, xm_internal_update_other_instances, instance); } static void xm_update_text_field (instance, widget, val) widget_instance* instance; Widget widget; widget_value* val; { XmTextFieldSetString (widget, val->value ? val->value : ""); XtRemoveAllCallbacks (widget, XmNactivateCallback); XtAddCallback (widget, XmNactivateCallback, xm_generic_callback, instance); XtRemoveAllCallbacks (widget, XmNvalueChangedCallback); XtAddCallback (widget, XmNvalueChangedCallback, xm_internal_update_other_instances, instance); } /* update a motif widget */ void xm_update_one_widget (instance, widget, val, deep_p) widget_instance* instance; Widget widget; widget_value* val; Boolean deep_p; { WidgetClass class; /* Mark as not edited */ val->edited = False; /* Common to all widget types */ XtVaSetValues (widget, XmNsensitive, val->enabled, XmNuserData, val->call_data, 0); /* Common to all label like widgets */ if (XtIsSubclass (widget, xmLabelWidgetClass)) xm_update_label (instance, widget, val); class = XtClass (widget); /* Class specific things */ if (class == xmPushButtonWidgetClass || class == xmArrowButtonWidgetClass) { xm_update_pushbutton (instance, widget, val); } else if (class == xmCascadeButtonWidgetClass) { xm_update_cascadebutton (instance, widget, val); } else if (class == xmToggleButtonWidgetClass || class == xmToggleButtonGadgetClass) { xm_update_toggle (instance, widget, val); } else if (class == xmRowColumnWidgetClass) { Boolean radiobox = 0; int ac = 0; Arg al [1]; XtSetArg (al [ac], XmNradioBehavior, &radiobox); ac++; XtGetValues (widget, al, ac); if (radiobox) xm_update_radiobox (instance, widget, val); else xm_update_menu (instance, widget, val, deep_p); } else if (class == xmTextWidgetClass) { xm_update_text (instance, widget, val); } else if (class == xmTextFieldWidgetClass) { xm_update_text_field (instance, widget, val); } else if (class == xmListWidgetClass) { xm_update_list (instance, widget, val); } } /* getting the value back */ void xm_update_one_value (instance, widget, val) widget_instance* instance; Widget widget; widget_value* val; { WidgetClass class = XtClass (widget); widget_value *old_wv; /* copy the call_data slot into the "return" widget_value */ for (old_wv = instance->info->val->contents; old_wv; old_wv = old_wv->next) if (!strcmp (val->name, old_wv->name)) { val->call_data = old_wv->call_data; break; } if (class == xmToggleButtonWidgetClass || class == xmToggleButtonGadgetClass) { XtVaGetValues (widget, XmNset, &val->selected, 0); val->edited = True; } else if (class == xmTextWidgetClass) { if (val->value) free (val->value); val->value = XmTextGetString (widget); val->edited = True; } else if (class == xmTextFieldWidgetClass) { if (val->value) free (val->value); val->value = XmTextFieldGetString (widget); val->edited = True; } else if (class == xmRowColumnWidgetClass) { Boolean radiobox = 0; int ac = 0; Arg al [1]; XtSetArg (al [ac], XmNradioBehavior, &radiobox); ac++; XtGetValues (widget, al, ac); if (radiobox) { CompositeWidget radio = (CompositeWidget)widget; int i; for (i = 0; i < radio->composite.num_children; i++) { int set = False; Widget toggle = radio->composite.children [i]; XtVaGetValues (toggle, XmNset, &set, 0); if (set) { if (val->value) free (val->value); val->value = safe_strdup (XtName (toggle)); } } val->edited = True; } } else if (class == xmListWidgetClass) { int pos_cnt; int* pos_list; if (XmListGetSelectedPos (widget, &pos_list, &pos_cnt)) { int i; widget_value* cur; for (cur = val->contents, i = 0; cur; cur = cur->next) if (cur->value) { int j; cur->selected = False; i += 1; for (j = 0; j < pos_cnt; j++) if (pos_list [j] == i) { cur->selected = True; val->value = safe_strdup (cur->name); } } val->edited = 1; XtFree ((char *) pos_list); } } } /* This function is for activating a button from a program. It's wrong because we pass a NULL argument in the call_data which is not Motif compatible. This is used from the XmNdefaultAction callback of the List widgets to have a dble-click put down a dialog box like the button woudl do. I could not find a way to do that with accelerators. */ static void activate_button (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { Widget button = (Widget)closure; XtCallCallbacks (button, XmNactivateCallback, NULL); } /* creation functions */ /* dialogs */ static Widget make_dialog (name, parent, pop_up_p, shell_title, icon_name, text_input_slot, radio_box, list, left_buttons, right_buttons) char* name; Widget parent; Boolean pop_up_p; char* shell_title; char* icon_name; Boolean text_input_slot; Boolean radio_box; Boolean list; int left_buttons; int right_buttons; { Widget result; Widget form; Widget row; Widget icon; Widget icon_separator; Widget message; Widget value = 0; Widget separator; Widget button = 0; Widget children [16]; /* for the final XtManageChildren */ int n_children; Arg al[64]; /* Arg List */ int ac; /* Arg Count */ int i; if (pop_up_p) { ac = 0; XtSetArg(al[ac], XmNtitle, shell_title); ac++; XtSetArg(al[ac], XtNallowShellResize, True); ac++; XtSetArg(al[ac], XmNdeleteResponse, XmUNMAP); ac++; result = XmCreateDialogShell (parent, "dialog", al, ac); ac = 0; XtSetArg(al[ac], XmNautoUnmanage, FALSE); ac++; /* XtSetArg(al[ac], XmNautoUnmanage, TRUE); ac++; */ /* ####is this ok? */ XtSetArg(al[ac], XmNnavigationType, XmTAB_GROUP); ac++; form = XmCreateForm (result, shell_title, al, ac); } else { ac = 0; XtSetArg(al[ac], XmNautoUnmanage, FALSE); ac++; XtSetArg(al[ac], XmNnavigationType, XmTAB_GROUP); ac++; form = XmCreateForm (parent, shell_title, al, ac); result = form; } n_children = left_buttons + right_buttons + 1; ac = 0; XtSetArg(al[ac], XmNpacking, n_children == 3? XmPACK_COLUMN: XmPACK_TIGHT); ac++; XtSetArg(al[ac], XmNorientation, n_children == 3? XmVERTICAL: XmHORIZONTAL); ac++; XtSetArg(al[ac], XmNnumColumns, left_buttons + right_buttons + 1); ac++; XtSetArg(al[ac], XmNmarginWidth, 0); ac++; XtSetArg(al[ac], XmNmarginHeight, 0); ac++; XtSetArg(al[ac], XmNspacing, 13); ac++; XtSetArg(al[ac], XmNadjustLast, False); ac++; XtSetArg(al[ac], XmNalignment, XmALIGNMENT_CENTER); ac++; XtSetArg(al[ac], XmNisAligned, True); ac++; XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_FORM); ac++; XtSetArg(al[ac], XmNbottomOffset, 13); ac++; XtSetArg(al[ac], XmNleftAttachment, XmATTACH_FORM); ac++; XtSetArg(al[ac], XmNleftOffset, 13); ac++; XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; XtSetArg(al[ac], XmNrightOffset, 13); ac++; row = XmCreateRowColumn (form, "row", al, ac); n_children = 0; for (i = 0; i < left_buttons; i++) { char button_name [16]; sprintf (button_name, "button%d", i + 1); ac = 0; if (i == 0) { XtSetArg(al[ac], XmNhighlightThickness, 1); ac++; XtSetArg(al[ac], XmNshowAsDefault, TRUE); ac++; } XtSetArg(al[ac], XmNmarginWidth, 10); ac++; XtSetArg(al[ac], XmNnavigationType, XmTAB_GROUP); ac++; children [n_children] = XmCreatePushButton (row, button_name, al, ac); if (i == 0) { button = children [n_children]; ac = 0; XtSetArg(al[ac], XmNdefaultButton, button); ac++; XtSetValues (row, al, ac); } n_children++; } /* invisible seperator button */ ac = 0; XtSetArg (al[ac], XmNmappedWhenManaged, FALSE); ac++; children [n_children] = XmCreateLabel (row, "separator_button", al, ac); n_children++; for (i = 0; i < right_buttons; i++) { char button_name [16]; sprintf (button_name, "button%d", left_buttons + i + 1); ac = 0; XtSetArg(al[ac], XmNmarginWidth, 10); ac++; XtSetArg(al[ac], XmNnavigationType, XmTAB_GROUP); ac++; children [n_children] = XmCreatePushButton (row, button_name, al, ac); if (! button) button = children [n_children]; n_children++; } XtManageChildren (children, n_children); ac = 0; XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; XtSetArg(al[ac], XmNbottomOffset, 13); ac++; XtSetArg(al[ac], XmNbottomWidget, row); ac++; XtSetArg(al[ac], XmNleftAttachment, XmATTACH_FORM); ac++; XtSetArg(al[ac], XmNleftOffset, 0); ac++; XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; XtSetArg(al[ac], XmNrightOffset, 0); ac++; separator = XmCreateSeparator (form, "", al, ac); ac = 0; XtSetArg(al[ac], XmNlabelType, XmPIXMAP); ac++; XtSetArg(al[ac], XmNtopAttachment, XmATTACH_FORM); ac++; XtSetArg(al[ac], XmNtopOffset, 13); ac++; XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_NONE); ac++; XtSetArg(al[ac], XmNleftAttachment, XmATTACH_FORM); ac++; XtSetArg(al[ac], XmNleftOffset, 13); ac++; XtSetArg(al[ac], XmNrightAttachment, XmATTACH_NONE); ac++; icon = XmCreateLabel (form, icon_name, al, ac); ac = 0; XtSetArg(al[ac], XmNmappedWhenManaged, FALSE); ac++; XtSetArg(al[ac], XmNtopAttachment, XmATTACH_WIDGET); ac++; XtSetArg(al[ac], XmNtopOffset, 6); ac++; XtSetArg(al[ac], XmNtopWidget, icon); ac++; XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; XtSetArg(al[ac], XmNbottomOffset, 6); ac++; XtSetArg(al[ac], XmNbottomWidget, separator); ac++; XtSetArg(al[ac], XmNleftAttachment, XmATTACH_NONE); ac++; XtSetArg(al[ac], XmNrightAttachment, XmATTACH_NONE); ac++; icon_separator = XmCreateLabel (form, "", al, ac); if (text_input_slot) { ac = 0; XtSetArg(al[ac], XmNcolumns, 50); ac++; XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; XtSetArg(al[ac], XmNbottomOffset, 13); ac++; XtSetArg(al[ac], XmNbottomWidget, separator); ac++; XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; XtSetArg(al[ac], XmNleftOffset, 13); ac++; XtSetArg(al[ac], XmNleftWidget, icon); ac++; XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; XtSetArg(al[ac], XmNrightOffset, 13); ac++; value = XmCreateTextField (form, "value", al, ac); } else if (radio_box) { Widget radio_butt; ac = 0; XtSetArg(al[ac], XmNmarginWidth, 0); ac++; XtSetArg(al[ac], XmNmarginHeight, 0); ac++; XtSetArg(al[ac], XmNspacing, 13); ac++; XtSetArg(al[ac], XmNalignment, XmALIGNMENT_CENTER); ac++; XtSetArg(al[ac], XmNorientation, XmHORIZONTAL); ac++; XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; XtSetArg(al[ac], XmNbottomOffset, 13); ac++; XtSetArg(al[ac], XmNbottomWidget, separator); ac++; XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; XtSetArg(al[ac], XmNleftOffset, 13); ac++; XtSetArg(al[ac], XmNleftWidget, icon); ac++; XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; XtSetArg(al[ac], XmNrightOffset, 13); ac++; value = XmCreateRadioBox (form, "radiobutton1", al, ac); ac = 0; i = 0; radio_butt = XmCreateToggleButtonGadget (value, "radio1", al, ac); children [i++] = radio_butt; radio_butt = XmCreateToggleButtonGadget (value, "radio2", al, ac); children [i++] = radio_butt; radio_butt = XmCreateToggleButtonGadget (value, "radio3", al, ac); children [i++] = radio_butt; XtManageChildren (children, i); } else if (list) { ac = 0; XtSetArg(al[ac], XmNvisibleItemCount, 5); ac++; XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; XtSetArg(al[ac], XmNbottomOffset, 13); ac++; XtSetArg(al[ac], XmNbottomWidget, separator); ac++; XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; XtSetArg(al[ac], XmNleftOffset, 13); ac++; XtSetArg(al[ac], XmNleftWidget, icon); ac++; XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; XtSetArg(al[ac], XmNrightOffset, 13); ac++; value = XmCreateScrolledList (form, "list", al, ac); /* this is the easiest way I found to have the dble click in the list activate the default button */ XtAddCallback (value, XmNdefaultActionCallback, activate_button, button); } ac = 0; XtSetArg(al[ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; XtSetArg(al[ac], XmNtopAttachment, XmATTACH_FORM); ac++; XtSetArg(al[ac], XmNtopOffset, 13); ac++; XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; XtSetArg(al[ac], XmNbottomOffset, 13); ac++; XtSetArg(al[ac], XmNbottomWidget, text_input_slot || radio_box || list ? value : separator); ac++; XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; XtSetArg(al[ac], XmNleftOffset, 13); ac++; XtSetArg(al[ac], XmNleftWidget, icon); ac++; XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; XtSetArg(al[ac], XmNrightOffset, 13); ac++; message = XmCreateLabel (form, "message", al, ac); if (list) XtManageChild (value); i = 0; children [i] = row; i++; children [i] = separator; i++; if (text_input_slot || radio_box) { children [i] = value; i++; } children [i] = message; i++; children [i] = icon; i++; children [i] = icon_separator; i++; XtManageChildren (children, i); if (text_input_slot || list) { XtInstallAccelerators (value, button); XtSetKeyboardFocus (result, value); } else { XtInstallAccelerators (form, button); XtSetKeyboardFocus (result, button); } return result; } static destroyed_instance* find_matching_instance (instance) widget_instance* instance; { destroyed_instance* cur; destroyed_instance* prev; char* type = instance->info->type; char* name = instance->info->name; for (prev = NULL, cur = all_destroyed_instances; cur; prev = cur, cur = cur->next) { if (!strcmp (cur->name, name) && !strcmp (cur->type, type) && cur->parent == instance->parent && cur->pop_up_p == instance->pop_up_p) { if (prev) prev->next = cur->next; else all_destroyed_instances = cur->next; return cur; } /* do some cleanup */ else if (!cur->widget) { if (prev) prev->next = cur->next; else all_destroyed_instances = cur->next; free_destroyed_instance (cur); cur = prev ? prev : all_destroyed_instances; } } return NULL; } static void mark_dead_instance_destroyed (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { destroyed_instance* instance = (destroyed_instance*)closure; instance->widget = NULL; } static void recenter_widget (widget) Widget widget; { Widget parent = XtParent (widget); Screen* screen = XtScreen (widget); Dimension screen_width = WidthOfScreen (screen); Dimension screen_height = HeightOfScreen (screen); Dimension parent_width = 0; Dimension parent_height = 0; Dimension child_width = 0; Dimension child_height = 0; Position x; Position y; XtVaGetValues (widget, XtNwidth, &child_width, XtNheight, &child_height, 0); XtVaGetValues (parent, XtNwidth, &parent_width, XtNheight, &parent_height, 0); x = (((Position)parent_width) - ((Position)child_width)) / 2; y = (((Position)parent_height) - ((Position)child_height)) / 2; XtTranslateCoords (parent, x, y, &x, &y); if (x + child_width > screen_width) x = screen_width - child_width; if (x < 0) x = 0; if (y + child_height > screen_height) y = screen_height - child_height; if (y < 0) y = 0; XtVaSetValues (widget, XtNx, x, XtNy, y, 0); } static Widget recycle_instance (instance) destroyed_instance* instance; { Widget widget = instance->widget; /* widget is NULL if the parent was destroyed. */ if (widget) { Widget focus; Widget separator; /* Remove the destroy callback as the instance is not in the list anymore */ XtRemoveCallback (instance->parent, XtNdestroyCallback, mark_dead_instance_destroyed, (XtPointer)instance); /* Give the focus to the initial item */ focus = XtNameToWidget (widget, "*value"); if (!focus) focus = XtNameToWidget (widget, "*button1"); if (focus) XtSetKeyboardFocus (widget, focus); /* shrink the separator label back to their original size */ separator = XtNameToWidget (widget, "*separator_button"); if (separator) XtVaSetValues (separator, XtNwidth, 5, XtNheight, 5, 0); /* Center the dialog in its parent */ recenter_widget (widget); } free_destroyed_instance (instance); return widget; } Widget xm_create_dialog (instance) widget_instance* instance; { char* name = instance->info->type; Widget parent = instance->parent; Widget widget; Boolean pop_up_p = instance->pop_up_p; char* shell_name = 0; char* icon_name; Boolean text_input_slot = False; Boolean radio_box = False; Boolean list = False; int total_buttons; int left_buttons = 0; int right_buttons = 1; destroyed_instance* dead_one; /* try to find a widget to recycle */ dead_one = find_matching_instance (instance); if (dead_one) { Widget recycled_widget = recycle_instance (dead_one); if (recycled_widget) return recycled_widget; } switch (name [0]){ case 'E': case 'e': icon_name = "dbox-error"; shell_name = "Error"; break; case 'I': case 'i': icon_name = "dbox-info"; shell_name = "Information"; break; case 'L': case 'l': list = True; icon_name = "dbox-question"; shell_name = "Prompt"; break; case 'P': case 'p': text_input_slot = True; icon_name = "dbox-question"; shell_name = "Prompt"; break; case 'Q': case 'q': icon_name = "dbox-question"; shell_name = "Question"; break; } total_buttons = name [1] - '0'; if (name [3] == 'T' || name [3] == 't') { text_input_slot = False; radio_box = True; } else if (name [3]) right_buttons = name [4] - '0'; left_buttons = total_buttons - right_buttons; widget = make_dialog (name, parent, pop_up_p, shell_name, icon_name, text_input_slot, radio_box, list, left_buttons, right_buttons); XtAddCallback (widget, XmNpopdownCallback, xm_nosel_callback, (XtPointer) instance); return widget; } static Widget make_menubar (instance) widget_instance* instance; { return XmCreateMenuBar (instance->parent, instance->info->name, NULL, 0); } static void remove_grabs (shell, closure, call_data) Widget shell; XtPointer closure; XtPointer call_data; { Widget menu = (Widget) closure; XmRemoveFromPostFromList (menu, XtParent (XtParent (menu))); } static Widget make_popup_menu (instance) widget_instance* instance; { Widget parent = instance->parent; Window parent_window = parent->core.window; Widget result; /* sets the parent window to 0 to fool Motif into not generating a grab */ parent->core.window = 0; result = XmCreatePopupMenu (parent, instance->info->name, NULL, 0); XtAddCallback (XtParent (result), XmNpopdownCallback, remove_grabs, (XtPointer)result); parent->core.window = parent_window; return result; } static Widget make_main (instance) widget_instance* instance; { Widget parent = instance->parent; Widget result; Arg al[2]; int ac; ac = 0; XtSetArg (al[ac], XtNborderWidth, 0); ac++; XtSetArg (al[ac], XmNspacing, 0); ac++; result = XmCreateMainWindow (parent, instance->info->name, al, ac); return result; } /* Table of functions to create widgets */ #ifdef ENERGIZE /* interface with the XDesigner generated functions */ typedef Widget (*widget_maker) (Widget); extern Widget create_project_p_sheet (Widget parent); extern Widget create_debugger_p_sheet (Widget parent); extern Widget create_breaklist_p_sheet (Widget parent); extern Widget create_le_browser_p_sheet (Widget parent); extern Widget create_class_browser_p_sheet (Widget parent); extern Widget create_call_browser_p_sheet (Widget parent); extern Widget create_build_dialog (Widget parent); extern Widget create_editmode_dialog (Widget parent); extern Widget create_search_dialog (Widget parent); extern Widget create_project_display_dialog (Widget parent); static Widget make_one (widget_instance* instance, widget_maker fn) { Widget result; Arg al [64]; int ac = 0; if (instance->pop_up_p) { XtSetArg (al [ac], XmNallowShellResize, TRUE); ac++; result = XmCreateDialogShell (instance->parent, "dialog", NULL, 0); XtAddCallback (result, XmNpopdownCallback, &xm_nosel_callback, (XtPointer) instance); (*fn) (result); } else { result = (*fn) (instance->parent); XtRealizeWidget (result); } return result; } static Widget make_project_p_sheet (widget_instance* instance) { return make_one (instance, create_project_p_sheet); } static Widget make_debugger_p_sheet (widget_instance* instance) { return make_one (instance, create_debugger_p_sheet); } static Widget make_breaklist_p_sheet (widget_instance* instance) { return make_one (instance, create_breaklist_p_sheet); } static Widget make_le_browser_p_sheet (widget_instance* instance) { return make_one (instance, create_le_browser_p_sheet); } static Widget make_class_browser_p_sheet (widget_instance* instance) { return make_one (instance, create_class_browser_p_sheet); } static Widget make_call_browser_p_sheet (widget_instance* instance) { return make_one (instance, create_call_browser_p_sheet); } static Widget make_build_dialog (widget_instance* instance) { return make_one (instance, create_build_dialog); } static Widget make_editmode_dialog (widget_instance* instance) { return make_one (instance, create_editmode_dialog); } static Widget make_search_dialog (widget_instance* instance) { return make_one (instance, create_search_dialog); } static Widget make_project_display_dialog (widget_instance* instance) { return make_one (instance, create_project_display_dialog); } #endif /* ENERGIZE */ widget_creation_entry xm_creation_table [] = { {"menubar", make_menubar}, {"popup", make_popup_menu}, {"main", make_main}, #ifdef ENERGIZE {"project_p_sheet", make_project_p_sheet}, {"debugger_p_sheet", make_debugger_p_sheet}, {"breaklist_psheet", make_breaklist_p_sheet}, {"leb_psheet", make_le_browser_p_sheet}, {"class_browser_psheet", make_class_browser_p_sheet}, {"ctree_browser_psheet", make_call_browser_p_sheet}, {"build", make_build_dialog}, {"editmode", make_editmode_dialog}, {"search", make_search_dialog}, {"project_display", make_project_display_dialog}, #endif /* ENERGIZE */ {NULL, NULL} }; /* Destruction of instances */ void xm_destroy_instance (instance) widget_instance* instance; { Widget widget = instance->widget; /* recycle the dialog boxes */ /* Disable the recycling until we can find a way to have the dialog box get reasonable layout after we modify its contents. */ if (0 && XtClass (widget) == xmDialogShellWidgetClass) { destroyed_instance* dead_instance = make_destroyed_instance (instance->info->name, instance->info->type, instance->widget, instance->parent, instance->pop_up_p); dead_instance->next = all_destroyed_instances; all_destroyed_instances = dead_instance; XtUnmanageChild (first_child (instance->widget)); XFlush (XtDisplay (instance->widget)); XtAddCallback (instance->parent, XtNdestroyCallback, mark_dead_instance_destroyed, (XtPointer)dead_instance); } else { /* This might not be necessary now that the nosel is attached to popdown instead of destroy, but it can't hurt. */ XtRemoveCallback (instance->widget, XtNdestroyCallback, xm_nosel_callback, (XtPointer)instance); XtDestroyWidget (instance->widget); } } /* popup utility */ void xm_popup_menu (widget, event) Widget widget; XEvent *event; { XButtonPressedEvent dummy; if (event == 0) { dummy.type = ButtonPress; dummy.serial = 0; dummy.send_event = 0; dummy.display = XtDisplay (widget); dummy.window = XtWindow (XtParent (widget)); dummy.time = 0; dummy.button = 0; XQueryPointer (dummy.display, dummy.window, &dummy.root, &dummy.subwindow, &dummy.x_root, &dummy.y_root, &dummy.x, &dummy.y, &dummy.state); event = (XEvent *) &dummy; } if (event->type == ButtonPress || event->type == ButtonRelease) { /* This is so totally ridiculous: there's NO WAY to tell Motif that *any* button can select a menu item. Only one button can have that honor. */ char *trans = 0; if (event->xbutton.state & Button5Mask) trans = ""; else if (event->xbutton.state & Button4Mask) trans = ""; else if (event->xbutton.state & Button3Mask) trans = ""; else if (event->xbutton.state & Button2Mask) trans = ""; else if (event->xbutton.state & Button1Mask) trans = ""; if (trans) XtVaSetValues (widget, XmNmenuPost, trans, 0); XmMenuPosition (widget, (XButtonPressedEvent *) event); } XtManageChild (widget); } static void set_min_dialog_size (w) Widget w; { short width; short height; XtVaGetValues (w, XmNwidth, &width, XmNheight, &height, 0); XtVaSetValues (w, XmNminWidth, width, XmNminHeight, height, 0); } void xm_pop_instance (instance, up) widget_instance* instance; Boolean up; { Widget widget = instance->widget; if (XtClass (widget) == xmDialogShellWidgetClass) { Widget widget_to_manage = first_child (widget); if (up) { XtManageChild (widget_to_manage); set_min_dialog_size (widget); XtSetKeyboardFocus (instance->parent, widget); } else XtUnmanageChild (widget_to_manage); } else { if (up) XtManageChild (widget); else XtUnmanageChild (widget); } } /* motif callback */ enum do_call_type { pre_activate, selection, no_selection, post_activate }; static void do_call (widget, closure, type) Widget widget; XtPointer closure; enum do_call_type type; { Arg al [256]; int ac; XtPointer user_data; widget_instance* instance = (widget_instance*)closure; Widget instance_widget; LWLIB_ID id; if (!instance) return; if (widget->core.being_destroyed) return; instance_widget = instance->widget; if (!instance_widget) return; id = instance->info->id; ac = 0; user_data = NULL; XtSetArg (al [ac], XmNuserData, &user_data); ac++; XtGetValues (widget, al, ac); switch (type) { case pre_activate: if (instance->info->pre_activate_cb) instance->info->pre_activate_cb (widget, id, user_data); break; case selection: if (instance->info->selection_cb) instance->info->selection_cb (widget, id, user_data); break; case no_selection: if (instance->info->selection_cb) instance->info->selection_cb (widget, id, (XtPointer) -1); break; case post_activate: if (instance->info->post_activate_cb) instance->info->post_activate_cb (widget, id, user_data); break; default: abort (); } } /* Like lw_internal_update_other_instances except that it does not do anything if its shell parent is not managed. This is to protect lw_internal_update_other_instances to dereference freed memory if the widget was ``destroyed'' by caching it in the all_destroyed_instances list */ static void xm_internal_update_other_instances (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { Widget parent; for (parent = widget; parent; parent = XtParent (parent)) if (XtIsShell (parent)) break; else if (!XtIsManaged (parent)) return; lw_internal_update_other_instances (widget, closure, call_data); } static void xm_generic_callback (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { lw_internal_update_other_instances (widget, closure, call_data); do_call (widget, closure, selection); } static void xm_nosel_callback (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { /* This callback is only called when a dialog box is dismissed with the wm's destroy button (WM_DELETE_WINDOW.) We want the dialog box to be destroyed in that case, not just unmapped, so that it releases its keyboard grabs. But there are problems with running our callbacks while the widget is in the process of being destroyed, so we set XmNdeleteResponse to XmUNMAP instead of XmDESTROY and then destroy it ourself after having run the callback. */ do_call (widget, closure, no_selection); XtDestroyWidget (widget); } static void xm_pull_down_callback (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { do_call (widget, closure, pre_activate); } static void xm_pop_down_callback (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { widget_instance *instance = (widget_instance *) closure; if ((!instance->pop_up_p && (XtParent (widget) == instance->widget)) || (XtParent (widget) == instance->parent)) do_call (widget, closure, post_activate); } /* set the keyboard focus */ void xm_set_keyboard_focus (parent, w) Widget parent; Widget w; { XmProcessTraversal (w, 0); XtSetKeyboardFocus (parent, w); } /* Motif hack to set the main window areas. */ void xm_set_main_areas (parent, menubar, work_area) Widget parent; Widget menubar; Widget work_area; { XmMainWindowSetAreas (parent, menubar, /* menubar (maybe 0) */ 0, /* command area (psheets) */ 0, /* horizontal scroll */ 0, /* vertical scroll */ work_area); /* work area */ } /* Motif hack to control resizing on the menubar. */ void xm_manage_resizing (w, flag) Widget w; Boolean flag; { if (flag) { /* Enable the edit widget for resizing. */ Arg al[1]; XtSetArg (al[0], XtNallowShellResize, 0); XtSetValues (w, al, 1); } else { /* Disable the edit widget from resizing. */ Arg al[1]; XtSetArg (al[0], XtNallowShellResize, 0); XtSetValues (w, al, 1); } } emacs-19.30/lwlib/lwlib-Xol.c100444 22417 1 15527 5641363561 14300 0ustar pmrdaemon#include "lwlib-Xol.h" #include #include #include #include #include #include #include #include #include #include #include /* forward declarations */ static void update_menu_widget (widget_instance* instance, Widget widget, widget_value* val); /* Menu callbacks */ static void pre_hook (Widget w, caddr_t client_data, caddr_t call_data) { OlVirtualEvent ve = (OlVirtualEvent)call_data; widget_instance* instance = (widget_instance*)client_data; if (w->core.being_destroyed) return; if (XtParent (w) == instance->widget) { if (ve->xevent->type == ButtonPress && instance->info->pre_activate_cb) instance->info->pre_activate_cb (instance->widget, instance->info->id, NULL); } } static void post_hook (Widget w, caddr_t client_data, caddr_t call_data) { widget_instance* instance = (widget_instance*)client_data; if (w->core.being_destroyed) return; if (instance->info->post_activate_cb) instance->info->post_activate_cb (w, instance->info->id, NULL); } static void pick_hook (Widget w, caddr_t client_data, caddr_t call_data) { widget_instance* instance = 0; widget_value* val = (widget_value*)client_data; if (w->core.being_destroyed) return; XtVaGetValues (w, XtNuserData, &instance, 0); if (!instance) return; if (instance->info->selection_cb && val && val->enabled && !val->contents) instance->info->selection_cb (w, instance->info->id, val->call_data); } /* creation functions */ static Widget xol_create_menubar (widget_instance* instance) { Widget widget = XtVaCreateWidget (instance->info->name, controlAreaWidgetClass, instance->parent, 0); return widget; } static Widget xol_create_popup_menu (widget_instance* instance) { Widget popup_shell = XtCreatePopupShell (instance->info->name, menuShellWidgetClass, instance->parent, NULL, 0); return popup_shell; } widget_creation_entry xol_creation_table [] = { {"menubar", xol_create_menubar}, {"popup", xol_create_popup_menu}, {NULL, NULL} }; Widget xol_create_dialog (widget_instance* instance) { return NULL; } Boolean lw_olit_widget_p (Widget widget) { return True; } /* update functions */ static void destroy_all_children (Widget widget) { Widget* children; unsigned int number; int i; children = (Widget *) XtCompositeChildren (widget, &number); if (children) { /* Unmanage all children and destroy them. They will only be * really destroyed when we get out of DispatchEvent. */ for (i = 0; i < number; i++) { Widget child = children [i]; if (!child->core.being_destroyed) { XtUnmanageChild (child); XtDestroyWidget (child); } } XtFree (children); } } static Boolean all_dashes_p (char* s) { char* t; for (t = s; *t; t++) if (*t != '-') return False; return True; } static void make_menu_in_widget (widget_instance* instance, Widget widget, widget_value* val) { widget_value* cur; Widget button; Arg al [256]; int ac; String label; for (cur = val; cur; cur = cur->next) { ac = 0; XtSetArg (al [ac], XtNsensitive, cur->enabled); ac++; XtSetArg (al [ac], XtNuserData, instance); ac++; XtSetArg (al [ac], XtNacceleratorText, cur->key); ac++; /* label = (char *) resource_string (widget, cur->name);*/ label = cur->name; if (label) { XtSetArg (al [ac], XtNlabel, label); ac++; } if (all_dashes_p (cur->name)) { /* no separator in OpenLook just make some space. */ XtSetArg (al [ac], XtNheight, 5); ac++; XtSetArg (al [ac], XtNwidth, 5); ac++; button = XtCreateWidget (cur->name, stubWidgetClass, widget, al, ac); } else if (!cur->contents) { if (!cur->call_data) button = XtCreateManagedWidget (cur->name, staticTextWidgetClass, widget, al, ac); else { button = XtCreateManagedWidget (cur->name, oblongButtonWidgetClass, widget, al, ac); XtAddCallback (button, XtNselect, pick_hook, cur); } } else { Widget menu = NULL; button = XtCreateManagedWidget (cur->name, menuButtonWidgetClass, widget, al, ac); XtVaGetValues (button, XtNmenuPane, &menu, 0); if (!menu) abort (); make_menu_in_widget (instance, menu, cur->contents); OlAddCallback (button, XtNconsumeEvent, pre_hook, instance); } } } static void update_one_menu_entry (widget_instance* instance, Widget widget, widget_value* val) { Arg al [256]; int ac; Widget menu; widget_value* contents; if (val->change == NO_CHANGE) return; /* update the sensitivity */ XtVaSetValues (widget, XtNsensitive, val->enabled, 0); /* update the pulldown/pullaside as needed */ ac = 0; menu = NULL; XtVaGetValues (widget, XtNmenuPane, &menu, 0); contents = val->contents; if (!menu) { if (contents) { /* in OLIT this woudl have to be a structural change on the button. */ abort (); } } else if (!contents) { /* in OLIT this woudl have to be a structural change on the button. */ abort (); } else if (contents->change != NO_CHANGE) update_menu_widget (instance, menu, val); } static void update_menu_widget (widget_instance* instance, Widget widget, widget_value* val) { if (val->change == STRUCTURAL_CHANGE || val->contents->change == STRUCTURAL_CHANGE) { destroy_all_children (widget); make_menu_in_widget (instance, widget, val->contents); } else { /* Update all the buttons of the composite widget in order. */ Widget* children; unsigned int num_children; int i; widget_value* cur; children = (Widget *) XtCompositeChildren (widget, &num_children); if (children) { for (i = 0, cur = val->contents; i < num_children; i++) { if (!cur) abort (); if (children [i]->core.being_destroyed || strcmp (XtName (children [i]), cur->name)) continue; update_one_menu_entry (instance, children [i], cur); cur = cur->next; } XtFree (children); } if (cur) abort (); } } void xol_update_one_widget (widget_instance* instance, Widget widget, widget_value* val, Boolean deep_p) { Widget menu = widget; if (XtIsShell (widget)) XtVaGetValues (widget, XtNmenuPane, &menu, 0); update_menu_widget (instance, menu, val); } void xol_update_one_value (widget_instance* instance, Widget widget, widget_value* val) { return; } void xol_pop_instance (widget_instance* instance, Boolean up) { } void xol_popup_menu (Widget widget) { OlMenuPost (widget); } /* Destruction of instances */ void xol_destroy_instance (widget_instance* instance) { XtDestroyWidget (instance->widget); } emacs-19.30/lwlib/lwlib-Xolmb.c100444 21570 1 21316 5642002104 14543 0ustar djmdaemon/* An OLIT menubar widget, by Chuck Thompson Copyright (C) 1993 Lucid, Inc. This file is part of the Lucid Widget Library. The Lucid Widget Library 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. The Lucid Widget Library 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. */ #include #include #include #include #include "lwlib-Xol-mbP.h" #include "lwlib-Xol-mb.h" #define HORIZ_SPACING 4 #define VERT_SPACING 4 static void Initialize(); static void Resize(); static void ChangeManaged(); static Boolean SetValues(); static XtGeometryResult GeometryManager(); static XtGeometryResult PreferredSize(); static void do_layout(); static XtGeometryResult try_layout(); lwMenuBarClassRec lwMenubarClassRec = { { /* core_class members */ (WidgetClass) &compositeClassRec, /* superclass */ "Menubar", /* class_name */ sizeof(lwMenuBarRec), /* widget_size */ NULL, /* class_initialize */ NULL, /* class_part_initialize */ FALSE, /* class_inited */ Initialize, /* initialize */ NULL, /* initialize_hook */ XtInheritRealize, /* realize */ NULL, /* actions */ 0, /* num_actions */ NULL, /* resources */ 0, /* num_resources */ NULLQUARK, /* xrm_class */ TRUE, /* compress_motion */ XtExposeCompressMaximal, /* compress_exposure */ TRUE, /* compress_enterleave */ FALSE, /* visible_interest */ NULL, /* destroy */ Resize, /* resize */ NULL, /* expose */ NULL, /* set_values */ NULL, /* set_values_hook */ XtInheritSetValuesAlmost, /* set_values_almost */ NULL, /* get_values_hook */ NULL, /* accept_focus */ XtVersion, /* version */ NULL, /* callback_private */ NULL, /* tm_table */ PreferredSize, /* query_geometry */ NULL, /* display_accelerator */ NULL, /* extension */ }, { /* composite_class members */ GeometryManager, /* geometry_manager */ ChangeManaged, /* change_managed */ XtInheritInsertChild, /* insert_child */ XtInheritDeleteChild, /* delete_child */ NULL, /* extension */ }, { /* Menubar class members */ 0, /* empty */ } }; WidgetClass lwMenubarWidgetClass = (WidgetClass) &lwMenubarClassRec; static void Initialize (request, new) lwMenuBarWidget request, new; { if (request->core.width <= 0) new->core.width = 1; if (request->core.height <= 0) new->core.height = 23; } static void Resize (w) lwMenuBarWidget w; { do_layout(w); } static void do_layout (parent) lwMenuBarWidget parent; { Widget child; int cnt; int managed_children = 0; int managed_width = 0; int new_pos = 0; /* * Determine number of children which will fit on one line. * For now we ignore the rest, making sure they are unmanaged. */ cnt = 0; while ((cnt < (int) parent->composite.num_children) && (managed_width < (int) parent->core.width)) { child = parent->composite.children[cnt++]; managed_children++; managed_width += child->core.width + child->core.border_width * 2 + HORIZ_SPACING; } if (managed_width > (int) parent->core.width) managed_children--; /* * Correct positioning of children. */ cnt = 0; while (managed_children) { child = parent->composite.children[cnt++]; if (!child->core.managed) XtManageChild (child); if ((child->core.x != new_pos) || (child->core.y != 0)) XtMoveWidget (child, new_pos, 0); new_pos += child->core.width + child->core.border_width * 2 + HORIZ_SPACING; managed_children--; } /* * Make sure all remaining children are unmanaged. */ while (cnt < parent->composite.num_children) { child = parent->composite.children[cnt]; if (child->core.managed) XtUnmanageChild (child); if ((child->core.x != parent->core.width) || (child->core.y != parent->core.height)) XtMoveWidget (child, parent->core.width, parent->core.height); cnt++; } } static XtGeometryResult PreferredSize (w, request, preferred) lwMenuBarWidget w; XtWidgetGeometry *request, *preferred; { Widget child; int cnt; /* * If no changes are being made to the width or height, just agree. */ if (!(request->request_mode & CWWidth) && !(request->request_mode & CWHeight)) return (XtGeometryYes); /* * Right now assume everything goes in one row. Calculate the * minimum required width and height. */ preferred->width = 0; preferred->height = 0; for (cnt = 0; cnt < w->composite.num_children; cnt++) { child = w->composite.children[cnt]; if (child->core.managed) { preferred->width += child->core.width + child->core.border_width*2 + HORIZ_SPACING; if (preferred->height < (Dimension) (child->core.height + child->core.border_width * 2)) preferred->height = child->core.height + child->core.border_width * 2; } } preferred->request_mode = CWWidth | CWHeight; /* * Case: both height and width requested */ if ((request->request_mode & CWWidth) && (request->request_mode & CWHeight)) { /* * Ok if same or bigger. */ if (preferred->width <= request->width && preferred->height <= request->height) { preferred->width = request->width; return (XtGeometryYes); } /* * If both dimensions are too small, say no. */ else if (preferred->width > request->width && preferred->height > request->height) return (XtGeometryNo); /* * Otherwise one must be right, so say almost. */ else return (XtGeometryAlmost); } /* * If only one dimension is requested, either its OK or it isn't. */ else { if (request->request_mode & CWWidth) { if (preferred->width <= request->width) { preferred->width = request->width; return (XtGeometryYes); } else return (XtGeometryNo); } else if (request->request_mode & CWHeight) { if (preferred->height <= request->height) { return (XtGeometryYes); } else return (XtGeometryNo); } return (XtGeometryYes); } } static XtGeometryResult GeometryManager (w, request, reply) Widget w; XtWidgetGeometry *request; XtWidgetGeometry *reply; { lwMenuBarWidget parent = (lwMenuBarWidget) w->core.parent; /* * If the widget wants to move, just say no. */ if ((request->request_mode & CWX && request->x != w->core.x) || (request->request_mode & CWY && request->y != w->core.y)) return (XtGeometryNo); /* * Since everything "fits" for now, grant all requests. */ if (request->request_mode & CWWidth) w->core.width = request->width; if (request->request_mode & CWHeight) w->core.height = request->height; if (request->request_mode & CWBorderWidth) w->core.border_width = request->border_width; do_layout (parent); return (XtGeometryYes); } static XtGeometryResult try_layout (parent) lwMenuBarWidget parent; { Widget child; int cnt; int managed_children = 0; int managed_width = 0; int new_pos = 0; /* * Determine number of children which will fit on one line. * For now we ignore the rest, making sure they are unmanaged. */ cnt = 0; while ((cnt < (int) parent->composite.num_children) && (managed_width < (int) parent->core.width)) { child = parent->composite.children[cnt++]; if (child->core.managed) { managed_children++; managed_width += child->core.width + child->core.border_width * 2 + HORIZ_SPACING; } } if (managed_width > (int) parent->core.width) return (XtGeometryNo); else return (XtGeometryYes); } static void ChangeManaged (w) lwMenuBarWidget w; { XtGeometryResult result; result = try_layout (w); if (result != XtGeometryYes) { XtUnmanageChild (w->composite.children[w->composite.num_children - 1]); XtMoveWidget (w->composite.children[w->composite.num_children-1], w->core.width, w->core.height); } do_layout (w); } emacs-19.30/lwlib/lwlib-utils.c100444 12120 1 10430 5741664402 14652 0ustar rmsdaemon/* Defines some widget utility functions. Copyright (C) 1992 Lucid, Inc. This file is part of the Lucid Widget Library. The Lucid Widget Library 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. The Lucid Widget Library 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. */ #ifdef HAVE_CONFIG_H #include #endif #include #include #include #include "lwlib-utils.h" /* Redisplay the contents of the widget, without first clearing it. */ void XtNoClearRefreshWidget (widget) Widget widget; { XEvent event; event.type = Expose; event.xexpose.serial = 0; event.xexpose.send_event = 0; event.xexpose.display = XtDisplay (widget); event.xexpose.window = XtWindow (widget); event.xexpose.x = 0; event.xexpose.y = 0; event.xexpose.width = widget->core.width; event.xexpose.height = widget->core.height; event.xexpose.count = 0; (*widget->core.widget_class->core_class.expose) (widget, &event, (Region)NULL); } /* * Apply a function to all the subwidgets of a given widget recursively. */ void XtApplyToWidgets (w, proc, arg) Widget w; XtApplyToWidgetsProc proc; XtPointer arg; { if (XtIsComposite (w)) { CompositeWidget cw = (CompositeWidget) w; /* We have to copy the children list before mapping over it, because the procedure might add/delete elements, which would lose badly. */ int nkids = cw->composite.num_children; Widget *kids = (Widget *) malloc (sizeof (Widget) * nkids); int i; lwlib_bcopy (cw->composite.children, kids, sizeof (Widget) * nkids); for (i = 0; i < nkids; i++) /* This prevent us from using gadgets, why is it here? */ /* if (XtIsWidget (kids [i])) */ { /* do the kiddies first in case we're destroying */ XtApplyToWidgets (kids [i], proc, arg); proc (kids [i], arg); } free (kids); } } /* * Apply a function to all the subwidgets of a given widget recursively. * Stop as soon as the function returns non NULL and returns this as a value. */ void * XtApplyUntilToWidgets (w, proc, arg) Widget w; XtApplyUntilToWidgetsProc proc; XtPointer arg; { void* result; if (XtIsComposite (w)) { CompositeWidget cw = (CompositeWidget)w; int i; for (i = 0; i < cw->composite.num_children; i++) if (XtIsWidget (cw->composite.children [i])){ result = proc (cw->composite.children [i], arg); if (result) return result; result = XtApplyUntilToWidgets (cw->composite.children [i], proc, arg); if (result) return result; } } return NULL; } /* * Returns a copy of the list of all children of a composite widget */ Widget * XtCompositeChildren (widget, number) Widget widget; unsigned int* number; { CompositeWidget cw = (CompositeWidget)widget; Widget* result; int n; int i; if (!XtIsComposite (widget)) { *number = 0; return NULL; } n = cw->composite.num_children; result = (Widget*)XtMalloc (n * sizeof (Widget)); *number = n; for (i = 0; i < n; i++) result [i] = cw->composite.children [i]; return result; } Boolean XtWidgetBeingDestroyedP (widget) Widget widget; { return widget->core.being_destroyed; } void XtSafelyDestroyWidget (widget) Widget widget; { #if 0 /* this requires IntrinsicI.h (actually, InitialI.h) */ XtAppContext app = XtWidgetToApplicationContext(widget); if (app->dispatch_level == 0) { app->dispatch_level = 1; XtDestroyWidget (widget); /* generates an event so that the event loop will be called */ XChangeProperty (XtDisplay (widget), XtWindow (widget), XA_STRING, XA_STRING, 32, PropModeAppend, NULL, 0); app->dispatch_level = 0; } else XtDestroyWidget (widget); #else abort (); #endif } emacs-19.30/lwlib/lwlib.c100444 12120 1 75171 6007621470 13523 0ustar rmsdaemon/* A general interface to the widgets of different toolkits. Copyright (C) 1992, 1993 Lucid, Inc. This file is part of the Lucid Widget Library. The Lucid Widget Library 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. The Lucid Widget Library 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. */ #ifdef NeXT #undef __STRICT_BSD__ /* ick */ #endif #include #include #include #include "lwlib-int.h" #include "lwlib-utils.h" #include #ifdef __osf__ #include #include extern long *xmalloc(); #endif #if defined (USE_LUCID) #include "lwlib-Xlw.h" #endif #if defined (USE_MOTIF) #include "lwlib-Xm.h" #else /* not USE_MOTIF */ #if defined (USE_LUCID) #define USE_XAW #endif /* not USE_MOTIF && USE_LUCID */ #endif #if defined (USE_OLIT) #include "lwlib-Xol.h" #endif #if defined (USE_XAW) #include "lwlib-Xaw.h" #endif #if !defined (USE_LUCID) && !defined (USE_MOTIF) && !defined (USE_OLIT) ERROR! At least one of USE_LUCID, USE_MOTIF or USE_OLIT must be defined. #endif #if defined (USE_MOTIF) && defined (USE_OLIT) ERROR! no more than one of USE_MOTIF and USE_OLIT may be defined. #endif #ifndef max #define max(x, y) ((x) > (y) ? (x) : (y)) #endif /* List of all widgets managed by the library. */ static widget_info* all_widget_info = NULL; #ifdef USE_MOTIF char *lwlib_toolkit_type = "motif"; #else char *lwlib_toolkit_type = "lucid"; #endif /* Forward declarations */ static void instanciate_widget_instance (/* widget_instance* instance */); lwlib_memset (address, value, length) char *address; int value; int length; { int i; for (i = 0; i < length; i++) address[i] = value; } lwlib_bcopy (from, to, length) char *from; char *to; int length; { int i; for (i = 0; i < length; i++) to[i] = from[i]; } /* utility functions for widget_instance and widget_info */ char * safe_strdup (s) char *s; { char *result; if (! s) return 0; result = (char *) malloc (strlen (s) + 1); if (! result) return 0; strcpy (result, s); return result; } /* Like strcmp but ignore differences in case. */ static int my_strcasecmp (s1, s2) char *s1, *s2; { while (1) { int c1 = *s1++; int c2 = *s2++; if (isupper (c1)) c1 = tolower (c1); if (isupper (c2)) c2 = tolower (c2); if (c1 != c2) return (c1 > c2 ? 1 : -1); if (c1 == 0) return 0; } } static void safe_free_str (s) char *s; { if (s) free (s); } static widget_value *widget_value_free_list = 0; static int malloc_cpt = 0; widget_value * malloc_widget_value () { widget_value *wv; if (widget_value_free_list) { wv = widget_value_free_list; widget_value_free_list = wv->free_list; wv->free_list = 0; } else { wv = (widget_value *) malloc (sizeof (widget_value)); malloc_cpt++; } lwlib_memset (wv, 0, sizeof (widget_value)); return wv; } /* this is analagous to free(). It frees only what was allocated by malloc_widget_value(), and no substructures. */ void free_widget_value (wv) widget_value *wv; { if (wv->free_list) abort (); if (malloc_cpt > 25) { /* When the number of already allocated cells is too big, We free it. */ free (wv); malloc_cpt--; } else { wv->free_list = widget_value_free_list; widget_value_free_list = wv; } } static void free_widget_value_tree (wv) widget_value *wv; { if (!wv) return; if (wv->name) free (wv->name); if (wv->value) free (wv->value); if (wv->key) free (wv->key); wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; if (wv->toolkit_data && wv->free_toolkit_data) { free (wv->toolkit_data); wv->toolkit_data = (void *) 0xDEADBEEF; } if (wv->contents && (wv->contents != (widget_value*)1)) { free_widget_value_tree (wv->contents); wv->contents = (widget_value *) 0xDEADBEEF; } if (wv->next) { free_widget_value_tree (wv->next); wv->next = (widget_value *) 0xDEADBEEF; } free_widget_value (wv); } static widget_value * copy_widget_value_tree (val, change) widget_value* val; change_type change; { widget_value* copy; if (!val) return NULL; if (val == (widget_value *) 1) return val; copy = malloc_widget_value (); copy->name = safe_strdup (val->name); copy->value = safe_strdup (val->value); copy->key = safe_strdup (val->key); copy->enabled = val->enabled; copy->selected = val->selected; copy->edited = False; copy->change = change; copy->contents = copy_widget_value_tree (val->contents, change); copy->call_data = val->call_data; copy->next = copy_widget_value_tree (val->next, change); copy->toolkit_data = NULL; copy->free_toolkit_data = False; return copy; } static widget_info * allocate_widget_info (type, name, id, val, pre_activate_cb, selection_cb, post_activate_cb) char* type; char* name; LWLIB_ID id; widget_value* val; lw_callback pre_activate_cb; lw_callback selection_cb; lw_callback post_activate_cb; { widget_info* info = (widget_info*)malloc (sizeof (widget_info)); info->type = safe_strdup (type); info->name = safe_strdup (name); info->id = id; info->val = copy_widget_value_tree (val, STRUCTURAL_CHANGE); info->busy = False; info->pre_activate_cb = pre_activate_cb; info->selection_cb = selection_cb; info->post_activate_cb = post_activate_cb; info->instances = NULL; info->next = all_widget_info; all_widget_info = info; return info; } static void free_widget_info (info) widget_info* info; { safe_free_str (info->type); safe_free_str (info->name); free_widget_value_tree (info->val); lwlib_memset ((void*)info, 0xDEADBEEF, sizeof (widget_info)); free (info); } static void mark_widget_destroyed (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { widget_instance* instance = (widget_instance*)closure; /* be very conservative */ if (instance->widget == widget) instance->widget = NULL; } static widget_instance * allocate_widget_instance (info, parent, pop_up_p) widget_info* info; Widget parent; Boolean pop_up_p; { widget_instance* instance = (widget_instance*)malloc (sizeof (widget_instance)); instance->parent = parent; instance->pop_up_p = pop_up_p; instance->info = info; instance->next = info->instances; info->instances = instance; instanciate_widget_instance (instance); XtAddCallback (instance->widget, XtNdestroyCallback, mark_widget_destroyed, (XtPointer)instance); return instance; } static void free_widget_instance (instance) widget_instance* instance; { lwlib_memset ((void*)instance, 0xDEADBEEF, sizeof (widget_instance)); free (instance); } static widget_info * get_widget_info (id, remove_p) LWLIB_ID id; Boolean remove_p; { widget_info* info; widget_info* prev; for (prev = NULL, info = all_widget_info; info; prev = info, info = info->next) if (info->id == id) { if (remove_p) { if (prev) prev->next = info->next; else all_widget_info = info->next; } return info; } return NULL; } /* Internal function used by the library dependent implementation to get the widget_value for a given widget in an instance */ widget_info * lw_get_widget_info (id) LWLIB_ID id; { return get_widget_info (id, 0); } static widget_instance * get_widget_instance (widget, remove_p) Widget widget; Boolean remove_p; { widget_info* info; widget_instance* instance; widget_instance* prev; for (info = all_widget_info; info; info = info->next) for (prev = NULL, instance = info->instances; instance; prev = instance, instance = instance->next) if (instance->widget == widget) { if (remove_p) { if (prev) prev->next = instance->next; else info->instances = instance->next; } return instance; } return (widget_instance *) 0; } static widget_instance* find_instance (id, parent, pop_up_p) LWLIB_ID id; Widget parent; Boolean pop_up_p; { widget_info* info = get_widget_info (id, False); widget_instance* instance; if (info) for (instance = info->instances; instance; instance = instance->next) if (instance->parent == parent && instance->pop_up_p == pop_up_p) return instance; return NULL; } /* utility function for widget_value */ static Boolean safe_strcmp (s1, s2) char* s1; char* s2; { if (!!s1 ^ !!s2) return True; return (s1 && s2) ? strcmp (s1, s2) : s1 ? False : !!s2; } #if 0 # define EXPLAIN(name, oc, nc, desc, a1, a2) \ printf ("Change: \"%s\"\tmax(%s=%d,%s=%d)\t%s %d %d\n", \ name, \ (oc == NO_CHANGE ? "none" : \ (oc == INVISIBLE_CHANGE ? "invisible" : \ (oc == VISIBLE_CHANGE ? "visible" : \ (oc == STRUCTURAL_CHANGE ? "structural" : "???")))), \ oc, \ (nc == NO_CHANGE ? "none" : \ (nc == INVISIBLE_CHANGE ? "invisible" : \ (nc == VISIBLE_CHANGE ? "visible" : \ (nc == STRUCTURAL_CHANGE ? "structural" : "???")))), \ nc, desc, a1, a2) #else # define EXPLAIN(name, oc, nc, desc, a1, a2) #endif static widget_value * merge_widget_value (val1, val2, level) widget_value* val1; widget_value* val2; int level; { change_type change; widget_value* merged_next; widget_value* merged_contents; if (!val1) { if (val2) return copy_widget_value_tree (val2, STRUCTURAL_CHANGE); else return NULL; } if (!val2) { free_widget_value_tree (val1); return NULL; } change = NO_CHANGE; if (safe_strcmp (val1->name, val2->name)) { EXPLAIN (val1->name, change, STRUCTURAL_CHANGE, "name change", val1->name, val2->name); change = max (change, STRUCTURAL_CHANGE); safe_free_str (val1->name); val1->name = safe_strdup (val2->name); } if (safe_strcmp (val1->value, val2->value)) { EXPLAIN (val1->name, change, VISIBLE_CHANGE, "value change", val1->value, val2->value); change = max (change, VISIBLE_CHANGE); safe_free_str (val1->value); val1->value = safe_strdup (val2->value); } if (safe_strcmp (val1->key, val2->key)) { EXPLAIN (val1->name, change, VISIBLE_CHANGE, "key change", val1->key, val2->key); change = max (change, VISIBLE_CHANGE); safe_free_str (val1->key); val1->key = safe_strdup (val2->key); } if (val1->enabled != val2->enabled) { EXPLAIN (val1->name, change, VISIBLE_CHANGE, "enablement change", val1->enabled, val2->enabled); change = max (change, VISIBLE_CHANGE); val1->enabled = val2->enabled; } if (val1->selected != val2->selected) { EXPLAIN (val1->name, change, VISIBLE_CHANGE, "selection change", val1->selected, val2->selected); change = max (change, VISIBLE_CHANGE); val1->selected = val2->selected; } if (val1->call_data != val2->call_data) { EXPLAIN (val1->name, change, INVISIBLE_CHANGE, "call-data change", val1->call_data, val2->call_data); change = max (change, INVISIBLE_CHANGE); val1->call_data = val2->call_data; } if (level > 0) { merged_contents = merge_widget_value (val1->contents, val2->contents, level - 1); if (val1->contents && !merged_contents) { EXPLAIN (val1->name, change, INVISIBLE_CHANGE, "(contents gone)", 0, 0); change = max (change, INVISIBLE_CHANGE); } else if (merged_contents && merged_contents->change != NO_CHANGE) { EXPLAIN (val1->name, change, INVISIBLE_CHANGE, "(contents change)", 0, 0); change = max (change, INVISIBLE_CHANGE); } val1->contents = merged_contents; } merged_next = merge_widget_value (val1->next, val2->next, level); if (val1->next && !merged_next) { EXPLAIN (val1->name, change, STRUCTURAL_CHANGE, "(following gone)", 0, 0); change = max (change, STRUCTURAL_CHANGE); } else if (merged_next) { if (merged_next->change) EXPLAIN (val1->name, change, merged_next->change, "(following change)", 0, 0); change = max (change, merged_next->change); } val1->next = merged_next; val1->change = change; if (change > NO_CHANGE && val1->toolkit_data) { if (val1->free_toolkit_data) free (val1->toolkit_data); val1->toolkit_data = NULL; } return val1; } /* modifying the widgets */ static Widget name_to_widget (instance, name) widget_instance* instance; char* name; { Widget widget = NULL; if (!instance->widget) return NULL; if (!strcmp (XtName (instance->widget), name)) widget = instance->widget; else { int length = strlen (name) + 2; char* real_name = (char *) xmalloc (length); real_name [0] = '*'; strcpy (real_name + 1, name); widget = XtNameToWidget (instance->widget, real_name); free (real_name); } return widget; } static void set_one_value (instance, val, deep_p) widget_instance* instance; widget_value* val; Boolean deep_p; { Widget widget = name_to_widget (instance, val->name); if (widget) { #if defined (USE_LUCID) if (lw_lucid_widget_p (instance->widget)) xlw_update_one_widget (instance, widget, val, deep_p); #endif #if defined (USE_MOTIF) if (lw_motif_widget_p (instance->widget)) xm_update_one_widget (instance, widget, val, deep_p); #endif #if defined (USE_OLIT) if (lw_olit_widget_p (instance->widget)) xol_update_one_widget (instance, widget, val, deep_p); #endif #if defined (USE_XAW) if (lw_xaw_widget_p (instance->widget)) xaw_update_one_widget (instance, widget, val, deep_p); #endif } } static void update_one_widget_instance (instance, deep_p) widget_instance* instance; Boolean deep_p; { widget_value *val; if (!instance->widget) /* the widget was destroyed */ return; for (val = instance->info->val; val; val = val->next) if (val->change != NO_CHANGE) set_one_value (instance, val, deep_p); } static void update_all_widget_values (info, deep_p) widget_info* info; Boolean deep_p; { widget_instance* instance; widget_value* val; for (instance = info->instances; instance; instance = instance->next) update_one_widget_instance (instance, deep_p); for (val = info->val; val; val = val->next) val->change = NO_CHANGE; } void lw_modify_all_widgets (id, val, deep_p) LWLIB_ID id; widget_value* val; Boolean deep_p; { widget_info* info = get_widget_info (id, False); widget_value* new_val; widget_value* next_new_val; widget_value* cur; widget_value* prev; widget_value* next; int found; if (!info) return; for (new_val = val; new_val; new_val = new_val->next) { next_new_val = new_val->next; new_val->next = NULL; found = False; for (prev = NULL, cur = info->val; cur; prev = cur, cur = cur->next) if (!strcmp (cur->name, new_val->name)) { found = True; next = cur->next; cur->next = NULL; cur = merge_widget_value (cur, new_val, deep_p ? 1000 : 1); if (prev) prev->next = cur ? cur : next; else info->val = cur ? cur : next; if (cur) cur->next = next; break; } if (!found) { /* Could not find it, add it */ if (prev) prev->next = copy_widget_value_tree (new_val, STRUCTURAL_CHANGE); else info->val = copy_widget_value_tree (new_val, STRUCTURAL_CHANGE); } new_val->next = next_new_val; } update_all_widget_values (info, deep_p); } /* creating the widgets */ static void initialize_widget_instance (instance) widget_instance* instance; { widget_value* val; for (val = instance->info->val; val; val = val->next) val->change = STRUCTURAL_CHANGE; update_one_widget_instance (instance, True); for (val = instance->info->val; val; val = val->next) val->change = NO_CHANGE; } static widget_creation_function find_in_table (type, table) char* type; widget_creation_entry* table; { widget_creation_entry* cur; for (cur = table; cur->type; cur++) if (!my_strcasecmp (type, cur->type)) return cur->function; return NULL; } static Boolean dialog_spec_p (name) char* name; { /* return True if name matches [EILPQeilpq][1-9][Bb] or [EILPQeilpq][1-9][Bb][Rr][1-9] */ if (!name) return False; switch (name [0]) { case 'E': case 'I': case 'L': case 'P': case 'Q': case 'e': case 'i': case 'l': case 'p': case 'q': if (name [1] >= '0' && name [1] <= '9') { if (name [2] != 'B' && name [2] != 'b') return False; if (!name [3]) return True; if ((name [3] == 'T' || name [3] == 't') && !name [4]) return True; if ((name [3] == 'R' || name [3] == 'r') && name [4] >= '0' && name [4] <= '9' && !name [5]) return True; return False; } else return False; default: return False; } } static void instanciate_widget_instance (instance) widget_instance* instance; { widget_creation_function function = NULL; #if defined (USE_LUCID) if (!function) function = find_in_table (instance->info->type, xlw_creation_table); #endif #if defined(USE_MOTIF) if (!function) function = find_in_table (instance->info->type, xm_creation_table); #endif #if defined (USE_OLIT) if (!function) function = find_in_table (instance->info->type, xol_creation_table); #endif #if defined (USE_XAW) if (!function) function = find_in_table (instance->info->type, xaw_creation_table); #endif if (!function) { if (dialog_spec_p (instance->info->type)) { #if defined (USE_LUCID) /* not yet */ #endif #if defined(USE_MOTIF) if (!function) function = xm_create_dialog; #endif #if defined (USE_XAW) if (!function) function = xaw_create_dialog; #endif #if defined (USE_OLIT) /* not yet */ #endif } } if (!function) { printf ("No creation function for widget type %s\n", instance->info->type); abort (); } instance->widget = (*function) (instance); if (!instance->widget) abort (); /* XtRealizeWidget (instance->widget);*/ } void lw_register_widget (type, name, id, val, pre_activate_cb, selection_cb, post_activate_cb) char* type; char* name; LWLIB_ID id; widget_value* val; lw_callback pre_activate_cb; lw_callback selection_cb; lw_callback post_activate_cb; { if (!get_widget_info (id, False)) allocate_widget_info (type, name, id, val, pre_activate_cb, selection_cb, post_activate_cb); } Widget lw_get_widget (id, parent, pop_up_p) LWLIB_ID id; Widget parent; Boolean pop_up_p; { widget_instance* instance; instance = find_instance (id, parent, pop_up_p); return instance ? instance->widget : NULL; } Widget lw_make_widget (id, parent, pop_up_p) LWLIB_ID id; Widget parent; Boolean pop_up_p; { widget_instance* instance; widget_info* info; instance = find_instance (id, parent, pop_up_p); if (!instance) { info = get_widget_info (id, False); if (!info) return NULL; instance = allocate_widget_instance (info, parent, pop_up_p); initialize_widget_instance (instance); } if (!instance->widget) abort (); return instance->widget; } Widget lw_create_widget (type, name, id, val, parent, pop_up_p, pre_activate_cb, selection_cb, post_activate_cb) char* type; char* name; LWLIB_ID id; widget_value* val; Widget parent; Boolean pop_up_p; lw_callback pre_activate_cb; lw_callback selection_cb; lw_callback post_activate_cb; { lw_register_widget (type, name, id, val, pre_activate_cb, selection_cb, post_activate_cb); return lw_make_widget (id, parent, pop_up_p); } /* destroying the widgets */ static void destroy_one_instance (instance) widget_instance* instance; { /* Remove the destroy callback on the widget; that callback will try to dereference the instance object (to set its widget slot to 0, since the widget is dead.) Since the instance is now dead, we don't have to worry about the fact that its widget is dead too. This happens in the Phase2Destroy of the widget, so this callback would not have been run until arbitrarily long after the instance was freed. */ if (instance->widget) XtRemoveCallback (instance->widget, XtNdestroyCallback, mark_widget_destroyed, (XtPointer)instance); if (instance->widget) { /* The else are pretty tricky here, including the empty statement at the end because it would be very bad to destroy a widget twice. */ #if defined (USE_LUCID) if (lw_lucid_widget_p (instance->widget)) xlw_destroy_instance (instance); else #endif #if defined (USE_MOTIF) if (lw_motif_widget_p (instance->widget)) xm_destroy_instance (instance); else #endif #if defined (USE_OLIT) if (lw_olit_widget_p (instance->widget)) xol_destroy_instance (instance); else #endif #if defined (USE_XAW) if (lw_xaw_widget_p (instance->widget)) xaw_destroy_instance (instance); else #endif /* do not remove the empty statement */ ; } free_widget_instance (instance); } void lw_destroy_widget (w) Widget w; { widget_instance* instance = get_widget_instance (w, True); if (instance) { widget_info *info = instance->info; /* instance has already been removed from the list; free it */ destroy_one_instance (instance); /* if there are no instances left, free the info too */ if (!info->instances) lw_destroy_all_widgets (info->id); } } void lw_destroy_all_widgets (id) LWLIB_ID id; { widget_info* info = get_widget_info (id, True); widget_instance* instance; widget_instance* next; if (info) { for (instance = info->instances; instance; ) { next = instance->next; destroy_one_instance (instance); instance = next; } free_widget_info (info); } } void lw_destroy_everything () { while (all_widget_info) lw_destroy_all_widgets (all_widget_info->id); } void lw_destroy_all_pop_ups () { widget_info* info; widget_info* next; widget_instance* instance; for (info = all_widget_info; info; info = next) { next = info->next; instance = info->instances; if (instance && instance->pop_up_p) lw_destroy_all_widgets (info->id); } } #ifdef USE_MOTIF extern Widget first_child (/* Widget */); /* garbage */ #endif Widget lw_raise_all_pop_up_widgets () { widget_info* info; widget_instance* instance; Widget result = NULL; for (info = all_widget_info; info; info = info->next) for (instance = info->instances; instance; instance = instance->next) if (instance->pop_up_p) { Widget widget = instance->widget; if (widget) { if (XtIsManaged (widget) #ifdef USE_MOTIF /* What a complete load of crap!!!! When a dialogShell is on the screen, it is not managed! */ || (lw_motif_widget_p (instance->widget) && XtIsManaged (first_child (widget))) #endif ) { if (!result) result = widget; XMapRaised (XtDisplay (widget), XtWindow (widget)); } } } return result; } static void lw_pop_all_widgets (id, up) LWLIB_ID id; Boolean up; { widget_info* info = get_widget_info (id, False); widget_instance* instance; if (info) for (instance = info->instances; instance; instance = instance->next) if (instance->pop_up_p && instance->widget) { #if defined (USE_LUCID) if (lw_lucid_widget_p (instance->widget)) { XtRealizeWidget (instance->widget); xlw_pop_instance (instance, up); } #endif #if defined (USE_MOTIF) if (lw_motif_widget_p (instance->widget)) { XtRealizeWidget (instance->widget); xm_pop_instance (instance, up); } #endif #if defined (USE_OLIT) if (lw_olit_widget_p (instance->widget)) { XtRealizeWidget (instance->widget); xol_pop_instance (instance, up); } #endif #if defined (USE_XAW) if (lw_xaw_widget_p (instance->widget)) { XtRealizeWidget (XtParent (instance->widget)); XtRealizeWidget (instance->widget); xaw_pop_instance (instance, up); } #endif } } void lw_pop_up_all_widgets (id) LWLIB_ID id; { lw_pop_all_widgets (id, True); } void lw_pop_down_all_widgets (id) LWLIB_ID id; { lw_pop_all_widgets (id, False); } void lw_popup_menu (widget, event) Widget widget; XEvent *event; { #if defined (USE_LUCID) if (lw_lucid_widget_p (widget)) xlw_popup_menu (widget, event); #endif #if defined (USE_MOTIF) if (lw_motif_widget_p (widget)) xm_popup_menu (widget, event); #endif #if defined (USE_OLIT) if (lw_olit_widget_p (widget)) xol_popup_menu (widget, event); #endif #if defined (USE_XAW) if (lw_xaw_widget_p (widget)) xaw_popup_menu (widget, event); #endif } /* get the values back */ static Boolean get_one_value (instance, val) widget_instance* instance; widget_value* val; { Widget widget = name_to_widget (instance, val->name); if (widget) { #if defined (USE_LUCID) if (lw_lucid_widget_p (instance->widget)) xlw_update_one_value (instance, widget, val); #endif #if defined (USE_MOTIF) if (lw_motif_widget_p (instance->widget)) xm_update_one_value (instance, widget, val); #endif #if defined (USE_OLIT) if (lw_olit_widget_p (instance->widget)) xol_update_one_value (instance, widget, val); #endif #if defined (USE_XAW) if (lw_xaw_widget_p (instance->widget)) xaw_update_one_value (instance, widget, val); #endif return True; } else return False; } Boolean lw_get_some_values (id, val_out) LWLIB_ID id; widget_value* val_out; { widget_info* info = get_widget_info (id, False); widget_instance* instance; widget_value* val; Boolean result = False; if (!info) return False; instance = info->instances; if (!instance) return False; for (val = val_out; val; val = val->next) if (get_one_value (instance, val)) result = True; return result; } widget_value* lw_get_all_values (id) LWLIB_ID id; { widget_info* info = get_widget_info (id, False); widget_value* val = info->val; if (lw_get_some_values (id, val)) return val; else return NULL; } /* internal function used by the library dependent implementation to get the widget_value for a given widget in an instance */ widget_value* lw_get_widget_value_for_widget (instance, w) widget_instance* instance; Widget w; { char* name = XtName (w); widget_value* cur; for (cur = instance->info->val; cur; cur = cur->next) if (!strcmp (cur->name, name)) return cur; return NULL; } /* update other instances value when one thing changed */ /* This function can be used as a an XtCallback for the widgets that get modified to update other instances of the widgets. Closure should be the widget_instance. */ void lw_internal_update_other_instances (widget, closure, call_data) Widget widget; XtPointer closure; XtPointer call_data; { /* To forbid recursive calls */ static Boolean updating; widget_instance* instance = (widget_instance*)closure; char* name = XtName (widget); widget_info* info; widget_instance* cur; widget_value* val; /* never recurse as this could cause infinite recursions. */ if (updating) return; /* protect against the widget being destroyed */ if (XtWidgetBeingDestroyedP (widget)) return; /* Return immediately if there are no other instances */ info = instance->info; if (!info->instances->next) return; updating = True; for (val = info->val; val && strcmp (val->name, name); val = val->next); if (val && get_one_value (instance, val)) for (cur = info->instances; cur; cur = cur->next) if (cur != instance) set_one_value (cur, val, True); updating = False; } /* get the id */ LWLIB_ID lw_get_widget_id (w) Widget w; { widget_instance* instance = get_widget_instance (w, False); return instance ? instance->info->id : 0; } /* set the keyboard focus */ void lw_set_keyboard_focus (parent, w) Widget parent; Widget w; { #if defined (USE_MOTIF) xm_set_keyboard_focus (parent, w); #else XtSetKeyboardFocus (parent, w); #endif } /* Show busy */ static void show_one_widget_busy (w, flag) Widget w; Boolean flag; { Pixel foreground = 0; Pixel background = 1; Widget widget_to_invert = XtNameToWidget (w, "*sheet"); if (!widget_to_invert) widget_to_invert = w; XtVaGetValues (widget_to_invert, XtNforeground, &foreground, XtNbackground, &background, 0); XtVaSetValues (widget_to_invert, XtNforeground, background, XtNbackground, foreground, 0); } void lw_show_busy (w, busy) Widget w; Boolean busy; { widget_instance* instance = get_widget_instance (w, False); widget_info* info; widget_instance* next; if (instance) { info = instance->info; if (info->busy != busy) { for (next = info->instances; next; next = next->next) if (next->widget) show_one_widget_busy (next->widget, busy); info->busy = busy; } } } /* This hack exists because Lucid/Athena need to execute the strange function below to support geometry management. */ void lw_refigure_widget (w, doit) Widget w; Boolean doit; { #if defined (USE_XAW) XawPanedSetRefigureMode (w, doit); #endif #if defined (USE_MOTIF) if (doit) XtManageChild (w); else XtUnmanageChild (w); #endif } /* Toolkit independent way of determining if an event window is in the menubar. */ Boolean lw_window_is_in_menubar (win, menubar_widget) Window win; Widget menubar_widget; { return menubar_widget #if defined (USE_LUCID) && XtWindow (menubar_widget) == win; #endif #if defined (USE_MOTIF) && XtWindowToWidget (XtDisplay (menubar_widget), win) && (XtParent (XtWindowToWidget (XtDisplay (menubar_widget), win)) == menubar_widget); #endif } /* Motif hack to set the main window areas. */ void lw_set_main_areas (parent, menubar, work_area) Widget parent; Widget menubar; Widget work_area; { #if defined (USE_MOTIF) xm_set_main_areas (parent, menubar, work_area); #endif } /* Manage resizing for Motif. This disables resizing when the menubar is about to be modified. */ void lw_allow_resizing (w, flag) Widget w; Boolean flag; { #if defined (USE_MOTIF) xm_manage_resizing (w, flag); #endif } emacs-19.30/lwlib/xlwmenu.c100444 12120 1 121471 6052470404 14123 0ustar rmsdaemon/* Implements a lightweight menubar widget. Copyright (C) 1992 Lucid, Inc. This file is part of the Lucid Widget Library. The Lucid Widget Library 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. The Lucid Widget Library 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 Alongalong with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* Created by devin@lucid.com */ #include #include #include #include #include #include #include #include #include "xlwmenuP.h" static int pointer_grabbed; static XEvent menu_post_event; XFontStruct *xlwmenu_default_font; static char xlwMenuTranslations [] = ": start()\n\ : drag()\n\ : select()\n\ "; #define offset(field) XtOffset(XlwMenuWidget, field) static XtResource xlwMenuResources[] = { {XtNfont, XtCFont, XtRFontStruct, sizeof(XFontStruct *), offset(menu.font),XtRString, "XtDefaultFont"}, {XtNforeground, XtCForeground, XtRPixel, sizeof(Pixel), offset(menu.foreground), XtRString, "XtDefaultForeground"}, {XtNbuttonForeground, XtCButtonForeground, XtRPixel, sizeof(Pixel), offset(menu.button_foreground), XtRString, "XtDefaultForeground"}, {XtNmargin, XtCMargin, XtRDimension, sizeof(Dimension), offset(menu.margin), XtRImmediate, (XtPointer)0}, {XtNhorizontalSpacing, XtCMargin, XtRDimension, sizeof(Dimension), offset(menu.horizontal_spacing), XtRImmediate, (XtPointer)3}, {XtNverticalSpacing, XtCMargin, XtRDimension, sizeof(Dimension), offset(menu.vertical_spacing), XtRImmediate, (XtPointer)1}, {XtNarrowSpacing, XtCMargin, XtRDimension, sizeof(Dimension), offset(menu.arrow_spacing), XtRImmediate, (XtPointer)10}, {XmNshadowThickness, XmCShadowThickness, XtRDimension, sizeof (Dimension), offset (menu.shadow_thickness), XtRImmediate, (XtPointer) 2}, {XmNtopShadowColor, XmCTopShadowColor, XtRPixel, sizeof (Pixel), offset (menu.top_shadow_color), XtRImmediate, (XtPointer)-1}, {XmNbottomShadowColor, XmCBottomShadowColor, XtRPixel, sizeof (Pixel), offset (menu.bottom_shadow_color), XtRImmediate, (XtPointer)-1}, {XmNtopShadowPixmap, XmCTopShadowPixmap, XtRPixmap, sizeof (Pixmap), offset (menu.top_shadow_pixmap), XtRImmediate, (XtPointer)None}, {XmNbottomShadowPixmap, XmCBottomShadowPixmap, XtRPixmap, sizeof (Pixmap), offset (menu.bottom_shadow_pixmap), XtRImmediate, (XtPointer)None}, {XtNopen, XtCCallback, XtRCallback, sizeof(XtPointer), offset(menu.open), XtRCallback, (XtPointer)NULL}, {XtNselect, XtCCallback, XtRCallback, sizeof(XtPointer), offset(menu.select), XtRCallback, (XtPointer)NULL}, {XtNmenu, XtCMenu, XtRPointer, sizeof(XtPointer), offset(menu.contents), XtRImmediate, (XtPointer)NULL}, {XtNcursor, XtCCursor, XtRCursor, sizeof(Cursor), offset(menu.cursor_shape), XtRString, (XtPointer)"right_ptr"}, {XtNhorizontal, XtCHorizontal, XtRInt, sizeof(int), offset(menu.horizontal), XtRImmediate, (XtPointer)True}, }; #undef offset static Boolean XlwMenuSetValues(); static void XlwMenuRealize(); static void XlwMenuRedisplay(); static void XlwMenuResize(); static void XlwMenuInitialize(); static void XlwMenuRedisplay(); static void XlwMenuDestroy(); static void XlwMenuClassInitialize(); static void Start(); static void Drag(); static void Select(); static XtActionsRec xlwMenuActionsList [] = { {"start", Start}, {"drag", Drag}, {"select", Select}, }; #define SuperClass ((CoreWidgetClass)&coreClassRec) XlwMenuClassRec xlwMenuClassRec = { { /* CoreClass fields initialization */ (WidgetClass) SuperClass, /* superclass */ "XlwMenu", /* class_name */ sizeof(XlwMenuRec), /* size */ XlwMenuClassInitialize, /* class_initialize */ NULL, /* class_part_initialize */ FALSE, /* class_inited */ XlwMenuInitialize, /* initialize */ NULL, /* initialize_hook */ XlwMenuRealize, /* realize */ xlwMenuActionsList, /* actions */ XtNumber(xlwMenuActionsList), /* num_actions */ xlwMenuResources, /* resources */ XtNumber(xlwMenuResources), /* resource_count */ NULLQUARK, /* xrm_class */ TRUE, /* compress_motion */ TRUE, /* compress_exposure */ TRUE, /* compress_enterleave */ FALSE, /* visible_interest */ XlwMenuDestroy, /* destroy */ XlwMenuResize, /* resize */ XlwMenuRedisplay, /* expose */ XlwMenuSetValues, /* set_values */ NULL, /* set_values_hook */ XtInheritSetValuesAlmost, /* set_values_almost */ NULL, /* get_values_hook */ NULL, /* accept_focus */ XtVersion, /* version */ NULL, /* callback_private */ xlwMenuTranslations, /* tm_table */ XtInheritQueryGeometry, /* query_geometry */ XtInheritDisplayAccelerator, /* display_accelerator */ NULL /* extension */ }, /* XlwMenuClass fields initialization */ { 0 /* dummy */ }, }; WidgetClass xlwMenuWidgetClass = (WidgetClass) &xlwMenuClassRec; int submenu_destroyed; static int next_release_must_exit; /* Utilities */ static void push_new_stack (mw, val) XlwMenuWidget mw; widget_value* val; { if (!mw->menu.new_stack) { mw->menu.new_stack_length = 10; mw->menu.new_stack = (widget_value**)XtCalloc (mw->menu.new_stack_length, sizeof (widget_value*)); } else if (mw->menu.new_depth == mw->menu.new_stack_length) { mw->menu.new_stack_length *= 2; mw->menu.new_stack = (widget_value**)XtRealloc ((char*)mw->menu.new_stack, mw->menu.new_stack_length * sizeof (widget_value*)); } mw->menu.new_stack [mw->menu.new_depth++] = val; } static void pop_new_stack_if_no_contents (mw) XlwMenuWidget mw; { if (mw->menu.new_depth) { if (!mw->menu.new_stack [mw->menu.new_depth - 1]->contents) mw->menu.new_depth -= 1; } } static void make_old_stack_space (mw, n) XlwMenuWidget mw; int n; { if (!mw->menu.old_stack) { mw->menu.old_stack_length = 10; mw->menu.old_stack = (widget_value**)XtCalloc (mw->menu.old_stack_length, sizeof (widget_value*)); } else if (mw->menu.old_stack_length < n) { mw->menu.old_stack_length *= 2; mw->menu.old_stack = (widget_value**)XtRealloc ((char*)mw->menu.old_stack, mw->menu.old_stack_length * sizeof (widget_value*)); } } /* Size code */ static Boolean all_dashes_p (s) char *s; { char* p; for (p = s; *p == '-'; p++); return !*p; } int string_width (mw, s) XlwMenuWidget mw; char *s; { XCharStruct xcs; int drop; XTextExtents (mw->menu.font, s, strlen (s), &drop, &drop, &drop, &xcs); return xcs.width; } static int arrow_width (mw) XlwMenuWidget mw; { return mw->menu.font->ascent / 2 | 1; } static XtResource nameResource[] = { {"labelString", "LabelString", XtRString, sizeof(String), 0, XtRImmediate, 0}, }; static char* resource_widget_value (mw, val) XlwMenuWidget mw; widget_value *val; { if (!val->toolkit_data) { char* resourced_name = NULL; char* complete_name; XtGetSubresources ((Widget) mw, (XtPointer) &resourced_name, val->name, val->name, nameResource, 1, NULL, 0); if (!resourced_name) resourced_name = val->name; if (!val->value) { complete_name = (char *) XtMalloc (strlen (resourced_name) + 1); strcpy (complete_name, resourced_name); } else { int complete_length = strlen (resourced_name) + strlen (val->value) + 2; complete_name = XtMalloc (complete_length); *complete_name = 0; strcat (complete_name, resourced_name); strcat (complete_name, " "); strcat (complete_name, val->value); } val->toolkit_data = complete_name; val->free_toolkit_data = True; } return (char*)val->toolkit_data; } /* Returns the sizes of an item */ static void size_menu_item (mw, val, horizontal_p, label_width, rest_width, height) XlwMenuWidget mw; widget_value* val; int horizontal_p; int* label_width; int* rest_width; int* height; { if (all_dashes_p (val->name)) { *height = 2; *label_width = 1; *rest_width = 0; } else { *height = mw->menu.font->ascent + mw->menu.font->descent + 2 * mw->menu.vertical_spacing + 2 * mw->menu.shadow_thickness; *label_width = string_width (mw, resource_widget_value (mw, val)) + mw->menu.horizontal_spacing + mw->menu.shadow_thickness; *rest_width = mw->menu.horizontal_spacing + mw->menu.shadow_thickness; if (!horizontal_p) { if (val->contents) *rest_width += arrow_width (mw) + mw->menu.arrow_spacing; else if (val->key) *rest_width += string_width (mw, val->key) + mw->menu.arrow_spacing; } } } static void size_menu (mw, level) XlwMenuWidget mw; int level; { unsigned int label_width = 0; int rest_width = 0; int max_rest_width = 0; unsigned int height = 0; int horizontal_p = mw->menu.horizontal && (level == 0); widget_value* val; window_state* ws; if (level >= mw->menu.old_depth) abort (); ws = &mw->menu.windows [level]; ws->width = 0; ws->height = 0; ws->label_width = 0; for (val = mw->menu.old_stack [level]->contents; val; val = val->next) { size_menu_item (mw, val, horizontal_p, &label_width, &rest_width, &height); if (horizontal_p) { ws->width += label_width + rest_width; if (height > ws->height) ws->height = height; } else { if (label_width > ws->label_width) ws->label_width = label_width; if (rest_width > max_rest_width) max_rest_width = rest_width; ws->height += height; } } if (horizontal_p) ws->label_width = 0; else ws->width = ws->label_width + max_rest_width; ws->width += 2 * mw->menu.shadow_thickness; ws->height += 2 * mw->menu.shadow_thickness; } /* Display code */ static void draw_arrow (mw, window, gc, x, y, width) XlwMenuWidget mw; Window window; GC gc; int x; int y; int width; { XPoint points [3]; points [0].x = x; points [0].y = y + mw->menu.font->ascent; points [1].x = x; points [1].y = y; points [2].x = x + width; points [2].y = y + mw->menu.font->ascent / 2; XFillPolygon (XtDisplay (mw), window, gc, points, 3, Convex, CoordModeOrigin); } static void draw_shadow_rectangle (mw, window, x, y, width, height, erase_p) XlwMenuWidget mw; Window window; int x; int y; int width; int height; int erase_p; { Display *dpy = XtDisplay (mw); GC top_gc = !erase_p ? mw->menu.shadow_top_gc : mw->menu.background_gc; GC bottom_gc = !erase_p ? mw->menu.shadow_bottom_gc : mw->menu.background_gc; int thickness = mw->menu.shadow_thickness; XPoint points [4]; points [0].x = x; points [0].y = y; points [1].x = x + width; points [1].y = y; points [2].x = x + width - thickness; points [2].y = y + thickness; points [3].x = x; points [3].y = y + thickness; XFillPolygon (dpy, window, top_gc, points, 4, Convex, CoordModeOrigin); points [0].x = x; points [0].y = y + thickness; points [1].x = x; points [1].y = y + height; points [2].x = x + thickness; points [2].y = y + height - thickness; points [3].x = x + thickness; points [3].y = y + thickness; XFillPolygon (dpy, window, top_gc, points, 4, Convex, CoordModeOrigin); points [0].x = x + width; points [0].y = y; points [1].x = x + width - thickness; points [1].y = y + thickness; points [2].x = x + width - thickness; points [2].y = y + height - thickness; points [3].x = x + width; points [3].y = y + height - thickness; XFillPolygon (dpy, window, bottom_gc, points, 4, Convex, CoordModeOrigin); points [0].x = x; points [0].y = y + height; points [1].x = x + width; points [1].y = y + height; points [2].x = x + width; points [2].y = y + height - thickness; points [3].x = x + thickness; points [3].y = y + height - thickness; XFillPolygon (dpy, window, bottom_gc, points, 4, Convex, CoordModeOrigin); } /* Display the menu item and increment where.x and where.y to show how large ** the menu item was. */ static void display_menu_item (mw, val, ws, where, highlighted_p, horizontal_p, just_compute_p) XlwMenuWidget mw; widget_value* val; window_state* ws; XPoint* where; Boolean highlighted_p; Boolean horizontal_p; Boolean just_compute_p; { GC deco_gc; GC text_gc; int font_ascent = mw->menu.font->ascent; int font_descent = mw->menu.font->descent; int shadow = mw->menu.shadow_thickness; int separator_p = all_dashes_p (val->name); int h_spacing = mw->menu.horizontal_spacing; int v_spacing = mw->menu.vertical_spacing; int label_width; int rest_width; int height; int width; int button_p; /* compute the sizes of the item */ size_menu_item (mw, val, horizontal_p, &label_width, &rest_width, &height); if (horizontal_p) width = label_width + rest_width; else { label_width = ws->label_width; width = ws->width - 2 * shadow; } #if 0 /* see if it should be a button in the menubar */ button_p = horizontal_p && val->call_data; #endif button_p = 0; /* Only highlight an enabled item that has a callback. */ if (highlighted_p) if (!val->enabled || !(val->call_data || val->contents)) highlighted_p = 0; /* do the drawing. */ if (!just_compute_p) { /* Add the shadow border of the containing menu */ int x = where->x + shadow; int y = where->y + shadow; /* pick the foreground and background GC. */ if (val->enabled) text_gc = button_p ? mw->menu.button_gc : mw->menu.foreground_gc; else text_gc = button_p ? mw->menu.inactive_button_gc : mw->menu.inactive_gc; deco_gc = mw->menu.foreground_gc; if (separator_p) { XDrawLine (XtDisplay (mw), ws->window, mw->menu.shadow_bottom_gc, x, y, x + width, y); XDrawLine (XtDisplay (mw), ws->window, mw->menu.shadow_top_gc, x, y + 1, x + width, y + 1); } else { int x_offset = x + h_spacing + shadow; char* display_string = resource_widget_value (mw, val); draw_shadow_rectangle (mw, ws->window, x, y, width, height, True); /* Deal with centering a menu title. */ if (!horizontal_p && !val->contents && !val->call_data) { int l = string_width (mw, display_string); if (width > l) x_offset = (width - l) >> 1; } XDrawString (XtDisplay (mw), ws->window, text_gc, x_offset, y + v_spacing + shadow + font_ascent, display_string, strlen (display_string)); if (!horizontal_p) { if (val->contents) { int a_w = arrow_width (mw); draw_arrow (mw, ws->window, deco_gc, x + width - arrow_width (mw) - mw->menu.horizontal_spacing - mw->menu.shadow_thickness, y + v_spacing + shadow, a_w); } else if (val->key) { XDrawString (XtDisplay (mw), ws->window, text_gc, x + label_width + mw->menu.arrow_spacing, y + v_spacing + shadow + font_ascent, val->key, strlen (val->key)); } } else if (button_p) { #if 1 XDrawRectangle (XtDisplay (mw), ws->window, deco_gc, x + shadow, y + shadow, label_width + h_spacing - 1, font_ascent + font_descent + 2 * v_spacing - 1); draw_shadow_rectangle (mw, ws->window, x, y, width, height, False); #else highlighted_p = True; #endif } else { XDrawRectangle (XtDisplay (mw), ws->window, mw->menu.background_gc, x + shadow, y + shadow, label_width + h_spacing - 1, font_ascent + font_descent + 2 * v_spacing - 1); draw_shadow_rectangle (mw, ws->window, x, y, width, height, True); } if (highlighted_p) draw_shadow_rectangle (mw, ws->window, x, y, width, height, False); } } where->x += width; where->y += height; } static void display_menu (mw, level, just_compute_p, highlighted_pos, hit, hit_return, this, that) XlwMenuWidget mw; int level; Boolean just_compute_p; XPoint* highlighted_pos; XPoint* hit; widget_value** hit_return; widget_value* this; widget_value* that; { widget_value* val; widget_value* following_item; window_state* ws; XPoint where; int horizontal_p = mw->menu.horizontal && (level == 0); int highlighted_p; int just_compute_this_one_p; if (level >= mw->menu.old_depth) abort (); if (level < mw->menu.old_depth - 1) following_item = mw->menu.old_stack [level + 1]; else following_item = NULL; if (hit) *hit_return = NULL; where.x = 0; where.y = 0; ws = &mw->menu.windows [level]; for (val = mw->menu.old_stack [level]->contents; val; val = val->next) { highlighted_p = val == following_item; if (highlighted_p && highlighted_pos) { if (horizontal_p) highlighted_pos->x = where.x; else highlighted_pos->y = where.y; } just_compute_this_one_p = just_compute_p || ((this || that) && val != this && val != that); display_menu_item (mw, val, ws, &where, highlighted_p, horizontal_p, just_compute_this_one_p); if (highlighted_p && highlighted_pos) { if (horizontal_p) highlighted_pos->y = where.y; else highlighted_pos->x = where.x; } if (hit && !*hit_return && (horizontal_p ? hit->x < where.x : hit->y < where.y) && !all_dashes_p (val->name)) *hit_return = val; if (horizontal_p) where.y = 0; else where.x = 0; } if (!just_compute_p) draw_shadow_rectangle (mw, ws->window, 0, 0, ws->width, ws->height, False); } /* Motion code */ static void set_new_state (mw, val, level) XlwMenuWidget mw; widget_value* val; int level; { int i; mw->menu.new_depth = 0; for (i = 0; i < level; i++) push_new_stack (mw, mw->menu.old_stack [i]); push_new_stack (mw, val); } static void make_windows_if_needed (mw, n) XlwMenuWidget mw; int n; { int i; int start_at; XSetWindowAttributes xswa; int mask; Window root = RootWindowOfScreen (DefaultScreenOfDisplay (XtDisplay (mw))); window_state* windows; if (mw->menu.windows_length >= n) return; xswa.save_under = True; xswa.override_redirect = True; xswa.background_pixel = mw->core.background_pixel; xswa.border_pixel = mw->core.border_pixel; xswa.event_mask = ExposureMask | PointerMotionMask | PointerMotionHintMask | ButtonReleaseMask | ButtonPressMask; xswa.cursor = mw->menu.cursor_shape; mask = CWSaveUnder | CWOverrideRedirect | CWBackPixel | CWBorderPixel | CWEventMask | CWCursor; if (!mw->menu.windows) { mw->menu.windows = (window_state*)XtMalloc (n * sizeof (window_state)); start_at = 0; } else { mw->menu.windows = (window_state*)XtRealloc ((char*)mw->menu.windows, n * sizeof (window_state)); start_at = mw->menu.windows_length; } mw->menu.windows_length = n; windows = mw->menu.windows; for (i = start_at; i < n; i++) { windows [i].x = 0; windows [i].y = 0; windows [i].width = 1; windows [i].height = 1; windows [i].window = XCreateWindow (XtDisplay (mw), root, 0, 0, 1, 1, 0, 0, CopyFromParent, CopyFromParent, mask, &xswa); } } /* Make the window fit in the screen */ static void fit_to_screen (mw, ws, previous_ws, horizontal_p) XlwMenuWidget mw; window_state* ws; window_state* previous_ws; Boolean horizontal_p; { unsigned int screen_width = WidthOfScreen (XtScreen (mw)); unsigned int screen_height = HeightOfScreen (XtScreen (mw)); if (ws->x < 0) ws->x = 0; else if (ws->x + ws->width > screen_width) { if (!horizontal_p) ws->x = previous_ws->x - ws->width; else ws->x = screen_width - ws->width; if (ws->x < 0) ws->x = 0; } if (ws->y < 0) ws->y = 0; else if (ws->y + ws->height > screen_height) { if (horizontal_p) ws->y = previous_ws->y - ws->height; else ws->y = screen_height - ws->height; if (ws->y < 0) ws->y = 0; } } /* Updates old_stack from new_stack and redisplays. */ static void remap_menubar (mw) XlwMenuWidget mw; { int i; int last_same; XPoint selection_position; int old_depth = mw->menu.old_depth; int new_depth = mw->menu.new_depth; widget_value** old_stack; widget_value** new_stack; window_state* windows; widget_value* old_selection; widget_value* new_selection; /* Check that enough windows and old_stack are ready. */ make_windows_if_needed (mw, new_depth); make_old_stack_space (mw, new_depth); windows = mw->menu.windows; old_stack = mw->menu.old_stack; new_stack = mw->menu.new_stack; /* compute the last identical different entry */ for (i = 1; i < old_depth && i < new_depth; i++) if (old_stack [i] != new_stack [i]) break; last_same = i - 1; /* Memorize the previously selected item to be able to refresh it */ old_selection = last_same + 1 < old_depth ? old_stack [last_same + 1] : NULL; if (old_selection && !old_selection->enabled) old_selection = NULL; new_selection = last_same + 1 < new_depth ? new_stack [last_same + 1] : NULL; if (new_selection && !new_selection->enabled) new_selection = NULL; /* updates old_state from new_state. It has to be done now because display_menu (called below) uses the old_stack to know what to display. */ for (i = last_same + 1; i < new_depth; i++) old_stack [i] = new_stack [i]; mw->menu.old_depth = new_depth; /* refresh the last seletion */ selection_position.x = 0; selection_position.y = 0; display_menu (mw, last_same, new_selection == old_selection, &selection_position, NULL, NULL, old_selection, new_selection); /* Now popup the new menus */ for (i = last_same + 1; i < new_depth && new_stack [i]->contents; i++) { window_state* previous_ws = &windows [i - 1]; window_state* ws = &windows [i]; ws->x = previous_ws->x + selection_position.x + mw->menu.shadow_thickness; if (!mw->menu.horizontal || i > 1) ws->x += mw->menu.shadow_thickness; ws->y = previous_ws->y + selection_position.y + mw->menu.shadow_thickness; size_menu (mw, i); fit_to_screen (mw, ws, previous_ws, mw->menu.horizontal && i == 1); XClearWindow (XtDisplay (mw), ws->window); XMoveResizeWindow (XtDisplay (mw), ws->window, ws->x, ws->y, ws->width, ws->height); XMapRaised (XtDisplay (mw), ws->window); display_menu (mw, i, False, &selection_position, NULL, NULL, NULL, NULL); } /* unmap the menus that popped down */ for (i = new_depth - 1; i < old_depth; i++) if (i >= new_depth || !new_stack [i]->contents) XUnmapWindow (XtDisplay (mw), windows [i].window); } static Boolean motion_event_is_in_menu (mw, ev, level, relative_pos) XlwMenuWidget mw; XMotionEvent* ev; int level; XPoint* relative_pos; { window_state* ws = &mw->menu.windows [level]; unsigned int x = level == 0 ? ws->x : ws->x + mw->menu.shadow_thickness; unsigned int y = level == 0 ? ws->y : ws->y + mw->menu.shadow_thickness; relative_pos->x = ev->x_root - x; relative_pos->y = ev->y_root - y; return (x < ev->x_root && ev->x_root < x + ws->width && y < ev->y_root && ev->y_root < y + ws->height); } static Boolean map_event_to_widget_value (mw, ev, val, level) XlwMenuWidget mw; XMotionEvent* ev; widget_value** val; int* level; { int i; XPoint relative_pos; window_state* ws; *val = NULL; /* Find the window */ for (i = mw->menu.old_depth - 1; i >= 0; i--) { ws = &mw->menu.windows [i]; if (ws && motion_event_is_in_menu (mw, ev, i, &relative_pos)) { display_menu (mw, i, True, NULL, &relative_pos, val, NULL, NULL); if (*val) { *level = i + 1; return True; } } } return False; } /* Procedures */ static void make_drawing_gcs (mw) XlwMenuWidget mw; { XGCValues xgcv; xgcv.font = mw->menu.font->fid; xgcv.foreground = mw->menu.foreground; xgcv.background = mw->core.background_pixel; mw->menu.foreground_gc = XtGetGC ((Widget)mw, GCFont | GCForeground | GCBackground, &xgcv); xgcv.font = mw->menu.font->fid; xgcv.foreground = mw->menu.button_foreground; xgcv.background = mw->core.background_pixel; mw->menu.button_gc = XtGetGC ((Widget)mw, GCFont | GCForeground | GCBackground, &xgcv); xgcv.font = mw->menu.font->fid; xgcv.foreground = mw->menu.foreground; xgcv.background = mw->core.background_pixel; xgcv.fill_style = FillStippled; xgcv.stipple = mw->menu.gray_pixmap; mw->menu.inactive_gc = XtGetGC ((Widget)mw, (GCFont | GCForeground | GCBackground | GCFillStyle | GCStipple), &xgcv); xgcv.font = mw->menu.font->fid; xgcv.foreground = mw->menu.button_foreground; xgcv.background = mw->core.background_pixel; xgcv.fill_style = FillStippled; xgcv.stipple = mw->menu.gray_pixmap; mw->menu.inactive_button_gc = XtGetGC ((Widget)mw, (GCFont | GCForeground | GCBackground | GCFillStyle | GCStipple), &xgcv); xgcv.font = mw->menu.font->fid; xgcv.foreground = mw->core.background_pixel; xgcv.background = mw->menu.foreground; mw->menu.background_gc = XtGetGC ((Widget)mw, GCFont | GCForeground | GCBackground, &xgcv); } static void release_drawing_gcs (mw) XlwMenuWidget mw; { XtReleaseGC ((Widget) mw, mw->menu.foreground_gc); XtReleaseGC ((Widget) mw, mw->menu.button_gc); XtReleaseGC ((Widget) mw, mw->menu.inactive_gc); XtReleaseGC ((Widget) mw, mw->menu.inactive_button_gc); XtReleaseGC ((Widget) mw, mw->menu.background_gc); /* let's get some segvs if we try to use these... */ mw->menu.foreground_gc = (GC) -1; mw->menu.button_gc = (GC) -1; mw->menu.inactive_gc = (GC) -1; mw->menu.inactive_button_gc = (GC) -1; mw->menu.background_gc = (GC) -1; } #define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ ? ((unsigned long) (x)) : ((unsigned long) (y))) static void make_shadow_gcs (mw) XlwMenuWidget mw; { XGCValues xgcv; unsigned long pm = 0; Display *dpy = XtDisplay ((Widget) mw); Colormap cmap = DefaultColormapOfScreen (XtScreen ((Widget) mw)); XColor topc, botc; int top_frobbed = 0, bottom_frobbed = 0; if (mw->menu.top_shadow_color == -1) mw->menu.top_shadow_color = mw->core.background_pixel; if (mw->menu.bottom_shadow_color == -1) mw->menu.bottom_shadow_color = mw->menu.foreground; if (mw->menu.top_shadow_color == mw->core.background_pixel || mw->menu.top_shadow_color == mw->menu.foreground) { topc.pixel = mw->core.background_pixel; XQueryColor (dpy, cmap, &topc); /* don't overflow/wrap! */ topc.red = MINL (65535, topc.red * 1.2); topc.green = MINL (65535, topc.green * 1.2); topc.blue = MINL (65535, topc.blue * 1.2); if (XAllocColor (dpy, cmap, &topc)) { mw->menu.top_shadow_color = topc.pixel; top_frobbed = 1; } } if (mw->menu.bottom_shadow_color == mw->menu.foreground || mw->menu.bottom_shadow_color == mw->core.background_pixel) { botc.pixel = mw->core.background_pixel; XQueryColor (dpy, cmap, &botc); botc.red *= 0.6; botc.green *= 0.6; botc.blue *= 0.6; if (XAllocColor (dpy, cmap, &botc)) { mw->menu.bottom_shadow_color = botc.pixel; bottom_frobbed = 1; } } if (top_frobbed && bottom_frobbed) { int top_avg = ((topc.red / 3) + (topc.green / 3) + (topc.blue / 3)); int bot_avg = ((botc.red / 3) + (botc.green / 3) + (botc.blue / 3)); if (bot_avg > top_avg) { Pixel tmp = mw->menu.top_shadow_color; mw->menu.top_shadow_color = mw->menu.bottom_shadow_color; mw->menu.bottom_shadow_color = tmp; } else if (topc.pixel == botc.pixel) { if (botc.pixel == mw->menu.foreground) mw->menu.top_shadow_color = mw->core.background_pixel; else mw->menu.bottom_shadow_color = mw->menu.foreground; } } if (!mw->menu.top_shadow_pixmap && mw->menu.top_shadow_color == mw->core.background_pixel) { mw->menu.top_shadow_pixmap = mw->menu.gray_pixmap; mw->menu.top_shadow_color = mw->menu.foreground; } if (!mw->menu.bottom_shadow_pixmap && mw->menu.bottom_shadow_color == mw->core.background_pixel) { mw->menu.bottom_shadow_pixmap = mw->menu.gray_pixmap; mw->menu.bottom_shadow_color = mw->menu.foreground; } xgcv.fill_style = FillStippled; xgcv.foreground = mw->menu.top_shadow_color; xgcv.stipple = mw->menu.top_shadow_pixmap; pm = (xgcv.stipple ? GCStipple|GCFillStyle : 0); mw->menu.shadow_top_gc = XtGetGC ((Widget)mw, GCForeground | pm, &xgcv); xgcv.foreground = mw->menu.bottom_shadow_color; xgcv.stipple = mw->menu.bottom_shadow_pixmap; pm = (xgcv.stipple ? GCStipple|GCFillStyle : 0); mw->menu.shadow_bottom_gc = XtGetGC ((Widget)mw, GCForeground | pm, &xgcv); } static void release_shadow_gcs (mw) XlwMenuWidget mw; { XtReleaseGC ((Widget) mw, mw->menu.shadow_top_gc); XtReleaseGC ((Widget) mw, mw->menu.shadow_bottom_gc); } static void XlwMenuInitialize (request, mw, args, num_args) Widget request; XlwMenuWidget mw; ArgList args; Cardinal *num_args; { /* Get the GCs and the widget size */ XSetWindowAttributes xswa; int mask; Window window = RootWindowOfScreen (DefaultScreenOfDisplay (XtDisplay (mw))); Display* display = XtDisplay (mw); #if 0 widget_value *tem = (widget_value *) XtMalloc (sizeof (widget_value)); /* _XtCreate is freeing the object that was passed to us, so make a copy that we will actually keep. */ lwlib_bcopy (mw->menu.contents, tem, sizeof (widget_value)); mw->menu.contents = tem; #endif /* mw->menu.cursor = XCreateFontCursor (display, mw->menu.cursor_shape); */ mw->menu.cursor = mw->menu.cursor_shape; mw->menu.gray_pixmap = XCreatePixmapFromBitmapData (display, window, gray_bits, gray_width, gray_height, (unsigned long)1, (unsigned long)0, 1); /* I don't understand why this ends up 0 sometimes, but it does. This kludge works around it. Can anyone find a real fix? -- rms. */ if (mw->menu.font == 0) mw->menu.font = xlwmenu_default_font; make_drawing_gcs (mw); make_shadow_gcs (mw); xswa.background_pixel = mw->core.background_pixel; xswa.border_pixel = mw->core.border_pixel; mask = CWBackPixel | CWBorderPixel; mw->menu.popped_up = False; mw->menu.old_depth = 1; mw->menu.old_stack = (widget_value**)XtMalloc (sizeof (widget_value*)); mw->menu.old_stack_length = 1; mw->menu.old_stack [0] = mw->menu.contents; mw->menu.new_depth = 0; mw->menu.new_stack = 0; mw->menu.new_stack_length = 0; push_new_stack (mw, mw->menu.contents); mw->menu.windows = (window_state*)XtMalloc (sizeof (window_state)); mw->menu.windows_length = 1; mw->menu.windows [0].x = 0; mw->menu.windows [0].y = 0; mw->menu.windows [0].width = 0; mw->menu.windows [0].height = 0; size_menu (mw, 0); mw->core.width = mw->menu.windows [0].width; mw->core.height = mw->menu.windows [0].height; } static void XlwMenuClassInitialize () { } static void XlwMenuRealize (w, valueMask, attributes) Widget w; Mask *valueMask; XSetWindowAttributes *attributes; { XlwMenuWidget mw = (XlwMenuWidget)w; XSetWindowAttributes xswa; int mask; (*xlwMenuWidgetClass->core_class.superclass->core_class.realize) (w, valueMask, attributes); xswa.save_under = True; xswa.cursor = mw->menu.cursor_shape; mask = CWSaveUnder | CWCursor; XChangeWindowAttributes (XtDisplay (w), XtWindow (w), mask, &xswa); mw->menu.windows [0].window = XtWindow (w); mw->menu.windows [0].x = w->core.x; mw->menu.windows [0].y = w->core.y; mw->menu.windows [0].width = w->core.width; mw->menu.windows [0].height = w->core.height; } /* Only the toplevel menubar/popup is a widget so it's the only one that receives expose events through Xt. So we repaint all the other panes when receiving an Expose event. */ static void XlwMenuRedisplay (w, ev, region) Widget w; XEvent* ev; Region region; { XlwMenuWidget mw = (XlwMenuWidget)w; int i; /* If we have a depth beyond 1, it's because a submenu was displayed. If the submenu has been destroyed, set the depth back to 1. */ if (submenu_destroyed) { mw->menu.old_depth = 1; submenu_destroyed = 0; } for (i = 0; i < mw->menu.old_depth; i++) display_menu (mw, i, False, NULL, NULL, NULL, NULL, NULL); } static void XlwMenuDestroy (w) Widget w; { int i; XlwMenuWidget mw = (XlwMenuWidget) w; if (pointer_grabbed) XtUngrabPointer ((Widget)w, CurrentTime); pointer_grabbed = 0; submenu_destroyed = 1; release_drawing_gcs (mw); release_shadow_gcs (mw); /* this doesn't come from the resource db but is created explicitly so we must free it ourselves. */ XFreePixmap (XtDisplay (mw), mw->menu.gray_pixmap); mw->menu.gray_pixmap = (Pixmap) -1; #if 0 /* Do free mw->menu.contents because nowadays we copy it during initialization. */ XtFree (mw->menu.contents); #endif /* Don't free mw->menu.contents because that comes from our creator. The `*_stack' elements are just pointers into `contents' so leave that alone too. But free the stacks themselves. */ if (mw->menu.old_stack) XtFree ((char *) mw->menu.old_stack); if (mw->menu.new_stack) XtFree ((char *) mw->menu.new_stack); /* Remember, you can't free anything that came from the resource database. This includes: mw->menu.cursor mw->menu.top_shadow_pixmap mw->menu.bottom_shadow_pixmap mw->menu.font Also the color cells of top_shadow_color, bottom_shadow_color, foreground, and button_foreground will never be freed until this client exits. Nice, eh? */ /* start from 1 because the one in slot 0 is w->core.window */ for (i = 1; i < mw->menu.windows_length; i++) XDestroyWindow (XtDisplay (mw), mw->menu.windows [i].window); if (mw->menu.windows) XtFree ((char *) mw->menu.windows); } static Boolean XlwMenuSetValues (current, request, new) Widget current; Widget request; Widget new; { XlwMenuWidget oldmw = (XlwMenuWidget)current; XlwMenuWidget newmw = (XlwMenuWidget)new; Boolean redisplay = False; int i; if (newmw->menu.contents && newmw->menu.contents->contents && newmw->menu.contents->contents->change >= VISIBLE_CHANGE) redisplay = True; if (newmw->core.background_pixel != oldmw->core.background_pixel || newmw->menu.foreground != oldmw->menu.foreground || newmw->menu.font != oldmw->menu.font) { release_drawing_gcs (newmw); make_drawing_gcs (newmw); redisplay = True; for (i = 0; i < oldmw->menu.windows_length; i++) { XSetWindowBackground (XtDisplay (oldmw), oldmw->menu.windows [i].window, newmw->core.background_pixel); /* clear windows and generate expose events */ XClearArea (XtDisplay (oldmw), oldmw->menu.windows[i].window, 0, 0, 0, 0, True); } } return redisplay; } static void XlwMenuResize (w) Widget w; { XlwMenuWidget mw = (XlwMenuWidget)w; if (mw->menu.popped_up) { /* Don't allow the popup menu to resize itself. */ mw->core.width = mw->menu.windows [0].width; mw->core.height = mw->menu.windows [0].height; mw->core.parent->core.width = mw->core.width ; mw->core.parent->core.height = mw->core.height ; } else { mw->menu.windows [0].width = mw->core.width; mw->menu.windows [0].height = mw->core.height; } } /* Action procedures */ static void handle_single_motion_event (mw, ev) XlwMenuWidget mw; XMotionEvent* ev; { widget_value* val; int level; if (!map_event_to_widget_value (mw, ev, &val, &level)) pop_new_stack_if_no_contents (mw); else set_new_state (mw, val, level); remap_menubar (mw); /* Sync with the display. Makes it feel better on X terms. */ XSync (XtDisplay (mw), False); } static void handle_motion_event (mw, ev) XlwMenuWidget mw; XMotionEvent* ev; { int x = ev->x_root; int y = ev->y_root; int state = ev->state; handle_single_motion_event (mw, ev); /* allow motion events to be generated again */ if (ev->is_hint && XQueryPointer (XtDisplay (mw), ev->window, &ev->root, &ev->subwindow, &ev->x_root, &ev->y_root, &ev->x, &ev->y, &ev->state) && ev->state == state && (ev->x_root != x || ev->y_root != y)) handle_single_motion_event (mw, ev); } static void Start (w, ev, params, num_params) Widget w; XEvent *ev; String *params; Cardinal *num_params; { XlwMenuWidget mw = (XlwMenuWidget)w; if (!mw->menu.popped_up) { menu_post_event = *ev; pop_up_menu (mw, ev); } else { /* If we push a button while the menu is posted semipermanently, releasing the button should always pop the menu down. */ next_release_must_exit = 1; /* notes the absolute position of the menubar window */ mw->menu.windows [0].x = ev->xmotion.x_root - ev->xmotion.x; mw->menu.windows [0].y = ev->xmotion.y_root - ev->xmotion.y; /* handles the down like a move, slots are compatible */ handle_motion_event (mw, &ev->xmotion); } } static void Drag (w, ev, params, num_params) Widget w; XEvent *ev; String *params; Cardinal *num_params; { XlwMenuWidget mw = (XlwMenuWidget)w; if (mw->menu.popped_up) handle_motion_event (mw, &ev->xmotion); } static void Select (w, ev, params, num_params) Widget w; XEvent *ev; String *params; Cardinal *num_params; { XlwMenuWidget mw = (XlwMenuWidget)w; widget_value* selected_item = mw->menu.old_stack [mw->menu.old_depth - 1]; /* If user releases the button quickly, without selecting anything, after the initial down-click that brought the menu up, do nothing. */ if ((selected_item == 0 || ((widget_value *) selected_item)->call_data == 0) && !next_release_must_exit && (ev->xbutton.time - menu_post_event.xbutton.time < XtGetMultiClickTime (XtDisplay (w)))) return; /* pop down everything. */ mw->menu.new_depth = 1; remap_menubar (mw); if (mw->menu.popped_up) { mw->menu.popped_up = False; XtUngrabPointer ((Widget)mw, ev->xmotion.time); if (XtIsShell (XtParent ((Widget) mw))) XtPopdown (XtParent ((Widget) mw)); else { XtRemoveGrab ((Widget) mw); display_menu (mw, 0, False, NULL, NULL, NULL, NULL, NULL); } } /* callback */ XtCallCallbackList ((Widget)mw, mw->menu.select, (XtPointer)selected_item); } /* Special code to pop-up a menu */ void pop_up_menu (mw, event) XlwMenuWidget mw; XButtonPressedEvent* event; { int x = event->x_root; int y = event->y_root; int w; int h; int borderwidth = mw->menu.shadow_thickness; Screen* screen = XtScreen (mw); Display *display = XtDisplay (mw); next_release_must_exit = 0; XtCallCallbackList ((Widget)mw, mw->menu.open, NULL); if (XtIsShell (XtParent ((Widget)mw))) size_menu (mw, 0); w = mw->menu.windows [0].width; h = mw->menu.windows [0].height; x -= borderwidth; y -= borderwidth; if (x < borderwidth) x = borderwidth; if (x + w + 2 * borderwidth > WidthOfScreen (screen)) x = WidthOfScreen (screen) - w - 2 * borderwidth; if (y < borderwidth) y = borderwidth; if (y + h + 2 * borderwidth> HeightOfScreen (screen)) y = HeightOfScreen (screen) - h - 2 * borderwidth; mw->menu.popped_up = True; if (XtIsShell (XtParent ((Widget)mw))) { XtConfigureWidget (XtParent ((Widget)mw), x, y, w, h, XtParent ((Widget)mw)->core.border_width); XtPopup (XtParent ((Widget)mw), XtGrabExclusive); display_menu (mw, 0, False, NULL, NULL, NULL, NULL, NULL); mw->menu.windows [0].x = x + borderwidth; mw->menu.windows [0].y = y + borderwidth; } else { XEvent *ev = (XEvent *) event; XtAddGrab ((Widget) mw, True, True); /* notes the absolute position of the menubar window */ mw->menu.windows [0].x = ev->xmotion.x_root - ev->xmotion.x; mw->menu.windows [0].y = ev->xmotion.y_root - ev->xmotion.y; } #ifdef emacs x_catch_errors (display); #endif XtGrabPointer ((Widget)mw, False, (PointerMotionMask | PointerMotionHintMask | ButtonReleaseMask | ButtonPressMask), GrabModeAsync, GrabModeAsync, None, mw->menu.cursor_shape, event->time); pointer_grabbed = 1; #ifdef emacs if (x_had_errors_p (display)) { pointer_grabbed = 0; XtUngrabPointer ((Widget)mw, event->time); } x_uncatch_errors (display); #endif handle_motion_event (mw, (XMotionEvent*)event); } emacs-19.30/lwlib/xrdb-cpp.c100666 12120 1 12236 5563536133 14137 0ustar rmsdaemon/* A general interface to the widgets of different toolkits. Copyright (C) 1992, 1993 Lucid, Inc. This file is part of the Lucid Widget Library. The Lucid Widget Library 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. The Lucid Widget Library 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. */ /* This code reads a resource database file and filters it through cpp with the same set of preprocessor defines that `xrdb' uses. Call lwlib_xrdb_initialize(dpy) once, and then call the function lwlib_GetFileDatabase() instead of XrmGetFileDatabase(), and lwlib_CombineFileDatabase() instead of XrmCombineFileDatabase(). */ #ifndef __STDC_EXTENDED__ #define __STDC_EXTENDED__ #endif #include #include #include #include #include #include #include extern char *index (); static int file_p (path) char *path; { struct stat status; return (access (path, R_OK) == 0 /* exists and is readable */ && stat (path, &status) == 0 /* get the status */ && (status.st_mode & S_IFDIR) == 0); /* not a directory */ } #ifndef CPP_PROGRAM #define CPP_PROGRAM "/lib/cpp" #endif static char cpp_string [BUFSIZ]; static char *cpp_file = 0; #define Resolution(pixels, mm) ((((pixels) * 100000 / (mm)) + 50) / 100) void lwlib_xrdb_initialize (display) Display *display; { Screen *screen; Visual *visual; char server [255]; char *colon, *s; #define Push(str) \ (strncpy (s, str, sizeof(str)), s += (sizeof(str)-1)) #define Print(str, thing) \ (sprintf (s, str, thing), s = index (s, 0)) s = cpp_string; Push (CPP_PROGRAM); Push (" -DCLIENTHOST="); XmuGetHostname (s, sizeof (cpp_string) - (s - cpp_string)); s = index (s, 0); Push (" -DSERVERHOST="); strcpy (s, XDisplayName (DisplayString (display))); colon = index (s, ':'); if (colon == s) { XmuGetHostname (s, sizeof (cpp_string) - (s - cpp_string)); s = index (s, 0); } else if (colon) s = colon; else s = index (s, 0); Print (" -DVERSION=%d", ProtocolVersion(display)); Print (" -DREVISION=%d", ProtocolRevision(display)); Print (" -DVENDOR=\"%s\"", ServerVendor(display)); Print (" -DRELEASE=%d", VendorRelease(display)); screen = DefaultScreenOfDisplay(display); visual = DefaultVisualOfScreen(screen); Print (" -DWIDTH=%d", screen->width); Print (" -DHEIGHT=%d", screen->height); Print (" -DX_RESOLUTION=%d", Resolution(screen->width,screen->mwidth)); Print (" -DY_RESOLUTION=%d", Resolution(screen->height,screen->mheight)); Print (" -DPLANES=%d", DisplayPlanes(display, DefaultScreen(display))); Print (" -DBITS_PER_RGB=%d", visual->bits_per_rgb); switch(visual->class) { case StaticGray: Print (" -DCLASS=%s", "StaticGray"); break; case GrayScale: Print (" -DCLASS=%s", "GrayScale"); break; case StaticColor: Print (" -DCLASS=%s", "StaticColor"); Print (" -DCOLOR", 0); break; case PseudoColor: Print (" -DCLASS=%s", "PseudoColor"); Print (" -DCOLOR", 0); break; case TrueColor: Print (" -DCLASS=%s", "TrueColor"); Print (" -DCOLOR", 0); break; case DirectColor: Print (" -DCLASS=%s", "DirectColor"); Print (" -DCOLOR", 0); break; default: fprintf (stderr, "unexpected visual class=%d\n", visual->class); exit (-1); } *s++ = ' '; *s = 0; cpp_file = s; } XrmDatabase lwlib_GetFileDatabase (path) char *path; { XrmDatabase db = 0; char line [BUFSIZ]; char *s; FILE *file; if (! file_p (path)) return 0; strcpy (cpp_file, path); if (! (file = popen (cpp_string, "r"))) { fprintf (stderr, "couldn't execute %s; resource file %s file not munged.\n", CPP_PROGRAM, path); return XrmGetFileDatabase (path); } while (s = fgets (line, sizeof (line), file)) { char ch, *tail; if (*s == '!') continue; for (; ((ch = *s) != '\n') && isspace(ch); s++); if ((ch == '\0') || (ch == '\n') || (ch == '#')) continue; tail = s + strlen (s); if (tail - s < 3) continue; /* this would be syntactically incorrect */ while (*(tail-1) == '\n' && /* handle \ at end of line */ *(tail-2) == '\\') { if (! fgets (tail, sizeof (line) - (tail - line), file)) continue; tail += strlen (tail); } XrmPutLineResource (&db, s); } pclose (file); return db; } #ifdef THIS_IS_X11R5 int lwlib_CombineFileDatabase (path, target_db, override) char *path; XrmDatabase *target_db; Bool override; { XrmDatabase source_db = lwlib_GetFileDatabase (path); if (! source_db) return (! file_p (path)); XrmCombineDatabase (source_db, target_db, override); return 1; } #endif /* r5 */ emacs-19.30/lwlib/xrdb.c100666 12120 1 3740 5553614070 13333 0ustar rmsdaemon/* This file overrides the R4 or R5 mit/lib/Xt/Initialize.c, except that the functions lwlib_GetFileDatabase(), lwlib_CombineFileDatabase(), and lwlib_xrdb_initialize() are called. By doing this silly cpp hack, we avoid version skew problems. */ #include #include #include #ifdef XlibSpecificationRelease #if XlibSpecificationRelease >= 5 #define HAVE_X11R5 #endif #endif extern struct _XrmHashBucketRec *lwlib_GetFileDatabase (); extern void lwlib_xrdb_initialize (); /* Replace all calls to XrmGetFileDatabase() with lwlib_GetFileDatabase(), calls to XrmCombineFileDatabase() with lwlib_CombineFileDatabase(), and rename the defined _XtDisplayInitialize() function. */ #define XrmGetFileDatabase lwlib_GetFileDatabase #define XrmCombineFileDatabase lwlib_CombineFileDatabase #define _XtDisplayInitialize _orig_XtDisplayInitialize /* Suck in the original code. Don't change this: see comments in Imakefile. */ #include "Initialize.c" #undef XrmGetFileDatabase #undef XrmCombineFileDatabase #undef _XtDisplayInitialize /* Now provide a definition of _XtDisplayInitialize() which invokes the original code after calling our initialization hook. Note that the R4 and R5 versions of _XtDisplayInitialize() take different arguments. */ #ifndef HAVE_X11R5 void _XtDisplayInitialize(dpy, pd, name, class, urlist, num_urs, argc, argv) Display *dpy; XtPerDisplay pd; String name, class; XrmOptionDescRec *urlist; Cardinal num_urs; Cardinal *argc; char *argv[]; { lwlib_xrdb_initialize(dpy); _orig_XtDisplayInitialize(dpy, pd, name, class, urlist, num_urs, argc, argv); } #else /* HAVE_X11R5 */ void _XtDisplayInitialize(dpy, pd, name, urlist, num_urs, argc, argv) Display *dpy; XtPerDisplay pd; String name; XrmOptionDescRec *urlist; Cardinal num_urs; int *argc; char **argv; { lwlib_xrdb_initialize(dpy); _orig_XtDisplayInitialize(dpy, pd, name, urlist, num_urs, argc, argv); } #endif /* HAVE_X11R5 */ emacs-19.30/lwlib/dispatch.h100666 12120 1 51 5517072426 14133 0ustar rmsdaemon Widget XtWidgetToDispatchTo (XEvent *); emacs-19.30/lwlib/lwlib-Xaw.h100444 22417 1 535 5641363126 14230 0ustar pmrdaemon#ifndef LWLIB_XAW_H #define LWLIB_XAW_H #include "lwlib-int.h" extern widget_creation_entry xaw_creation_table []; Widget xaw_create_dialog (); Boolean lw_xaw_widget_p (); void xaw_update_one_widget (); void xaw_update_one_value (); void xaw_destroy_instance (); void xaw_popup_menu (); void xaw_pop_instance (); #endif /* LWLIB_XAW_H */ emacs-19.30/lwlib/lwlib-Xlw.h100444 22417 1 1206 5641363221 14253 0ustar pmrdaemon#ifndef LWLIB_XLW_H #define LWLIB_XLW_H #include "lwlib-int.h" extern widget_creation_entry xlw_creation_table []; extern widget_creation_function xlw_create_dialog; Boolean lw_lucid_widget_p (/* Widget widget */); void xlw_update_one_widget (/* widget_instance* instance, Widget widget, widget_value* val, Boolean deep_p */); void xlw_update_one_value (/* widget_instance* instance, Widget widget, widget_value* val */); void xlw_destroy_instance (/* widget_instance* instance */); void xlw_pop_instance (/* widget_instance* instance, Boolean up */); void xlw_popup_menu (/* Widget widget */); #endif /* LWLIB_XLW_H */ emacs-19.30/lwlib/lwlib-Xm.h100444 12120 1 1514 5741151237 14063 0ustar rmsdaemon#ifndef LWLIB_XM_H #define LWLIB_XM_H #include "lwlib-int.h" extern widget_creation_entry xm_creation_table []; Widget xm_create_dialog (/* widget_instance* instance */); Boolean lw_motif_widget_p (/* Widget widget */); void xm_update_one_widget (/* widget_instance* instance, Widget widget, widget_value* val, Boolean deep_p */); void xm_update_one_value (/* widget_instance* instance, Widget widget, widget_value* val */); void xm_destroy_instance (/* widget_instance* instance */); void xm_set_keyboard_focus (/* Widget parent, Widget w */); void xm_popup_menu (/* Widget widget */); void xm_pop_instance (/* widget_instance* instance, Boolean up */); void xm_set_main_areas (/* Widget parent, Widget menubar, Widget work_area */); void xm_manage_resizing (/* Widget w, Boolean flag */); #endif /* LWLIB_XM_H */ emacs-19.30/lwlib/lwlib-Xol.h100444 22417 1 1143 5641363546 14255 0ustar pmrdaemon#ifndef LWLIB_XOL_H #define LWLIB_XOL_H #include "lwlib-int.h" extern widget_creation_entry xol_creation_table []; extern Widget xol_create_dialog (widget_instance *); Boolean lw_olit_widget_p (Widget widget); void xol_update_one_widget (widget_instance* instance, Widget widget, widget_value* val, Boolean deep_p); void xol_update_one_value (widget_instance* instance, Widget widget, widget_value* val); void xol_destroy_instance (widget_instance* instance); void xol_pop_instance (widget_instance* instance, Boolean up); void xol_popup_menu (Widget widget); #endif /* LWLIB_XOL_H */ emacs-19.30/lwlib/lwlib-Xolmb.h100444 21570 1 2034 5642002265 14534 0ustar djmdaemon/* An OLIT menubar widget, by Chuck Thompson Copyright (C) 1993 Lucid, Inc. This file is part of the Lucid Widget Library. The Lucid Widget Library 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. The Lucid Widget Library 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. */ #ifndef LW_MENUBAR_H #define LW_MENUBAR_H extern WidgetClass lwMenubarWidgetClass; typedef struct _lwMenuBarClassRec *lwMenuBarWidgetClass; typedef struct _lwMenuBarRec *lwMenuBarWidget; #endif /* LW_MENUBAR_H */ emacs-19.30/lwlib/lwlib-XolmbP.h100444 21570 1 2517 5642002261 14656 0ustar djmdaemon/* An OLIT menubar widget, by Chuck Thompson Copyright (C) 1993 Lucid, Inc. This file is part of the Lucid Widget Library. The Lucid Widget Library 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. The Lucid Widget Library 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. */ #ifndef LW_MENUBARP_H #define LW_MENUBARP_H typedef struct _lwMenuBarClassPart { int ignore; } lwMenuBarClassPart; typedef struct _lwMenuBarClassRec { CoreClassPart core_class; CompositeClassPart composite_class; lwMenuBarClassPart menubar_class; } lwMenuBarClassRec; extern lwMenuBarClassRec lwMenubarClassRec; typedef struct { int empty; } lwMenuBarPart; typedef struct _lwMenuBarRec { CorePart core; CompositePart composite; lwMenuBarPart menubar; } lwMenuBarRec; #endif /* LW_MENUBARP_H */ emacs-19.30/lwlib/lwlib-int.h100444 12120 1 2221 5666317473 14301 0ustar rmsdaemon#ifndef LWLIB_INTERNAL_H #define LWLIB_INTERNAL_H #include "lwlib.h" /* extern char *strdup (const char *); extern int strcasecmp (const char *, const char *); */ extern char *safe_strdup (); typedef struct _widget_instance { Widget widget; Widget parent; Boolean pop_up_p; struct _widget_info* info; struct _widget_instance* next; } widget_instance; typedef struct _widget_info { char* type; char* name; LWLIB_ID id; widget_value* val; Boolean busy; lw_callback pre_activate_cb; lw_callback selection_cb; lw_callback post_activate_cb; struct _widget_instance* instances; struct _widget_info* next; } widget_info; typedef Widget (*widget_creation_function) (); typedef struct _widget_creation_entry { char* type; widget_creation_function function; } widget_creation_entry; /* update all other instances of a widget. Can be used in a callback when a wiget has been used by the user */ void lw_internal_update_other_instances (); /* get the widget_value for a widget in a given instance */ widget_value* lw_get_widget_value_for_widget (); widget_info *lw_get_widget_info (); #endif /* LWLIB_INTERNAL_H */ emacs-19.30/lwlib/lwlib-utils.h100444 22417 1 1202 5641363671 14646 0ustar pmrdaemon#ifndef _LWLIB_UTILS_H_ #define _LWLIB_UTILS_H_ void XtNoClearRefreshWidget (/* Widget */); typedef void (*XtApplyToWidgetsProc) (/* Widget, XtPointer */); typedef void* (*XtApplyUntilToWidgetsProc) (/* Widget, XtPointer */); void XtApplyToWidgets (/* Widget, XtApplyToWidgetsProc, XtPointer */); void *XtApplyUntilToWidgets (/* Widget, XtApplyUntilToWidgetsProc, XtPointer */); Widget *XtCompositeChildren (/* Widget, unsigned int * */); /* returns True is the widget is being destroyed, False otherwise */ Boolean XtWidgetBeingDestroyedP (/* Widget widget */); void XtSafelyDestroyWidget (/* Widget */); #endif /* _LWLIB_UTILS_H_ */ emacs-19.30/lwlib/lwlib.h100444 22417 1 10005 5720353640 13522 0ustar pmrdaemon#ifndef LWLIB_H #define LWLIB_H #include /* ** Widget values depend on the Widget type: ** ** widget: (name value key enabled data contents/selected) ** ** label: ("name" "string" NULL NULL NULL NULL) ** button: ("name" "string" "key" T/F data ) ** button w/menu: ** ("name" "string" "key" T/F data (label|button|button w/menu...)) ** menubar: ("name" NULL NULL T/F data (button w/menu)) ** selectable thing: ** ("name" "string" "key" T/F data T/F) ** checkbox: selectable thing ** radio: ("name" NULL NULL T/F data (selectable thing...)) ** strings: ("name" NULL NULL T/F data (selectable thing...)) ** text: ("name" "string" T/F data) ** main: ("name") */ typedef unsigned long LWLIB_ID; typedef enum _change_type { NO_CHANGE = 0, INVISIBLE_CHANGE = 1, VISIBLE_CHANGE = 2, STRUCTURAL_CHANGE = 3 } change_type; typedef struct _widget_value { /* name of widget */ char* name; /* value (meaning depend on widget type) */ char* value; /* keyboard equivalent. no implications for XtTranslations */ char* key; /* true if enabled */ Boolean enabled; /* true if selected */ Boolean selected; /* true if was edited (maintained by get_value) */ Boolean edited; /* true if has changed (maintained by lw library) */ change_type change; /* Contents of the sub-widgets, also selected slot for checkbox */ struct _widget_value* contents; /* data passed to callback */ XtPointer call_data; /* next one in the list */ struct _widget_value* next; /* slot for the toolkit dependent part. Always initialize to NULL. */ void* toolkit_data; /* tell us if we should free the toolkit data slot when freeing the widget_value itself. */ Boolean free_toolkit_data; /* we resource the widget_value structures; this points to the next one on the free list if this one has been deallocated. */ struct _widget_value *free_list; } widget_value; typedef void (*lw_callback) (/* Widget w, LWLIB_ID id, void* data */); void lw_register_widget (/* char* type, char* name, LWLIB_ID id, widget_value* val, lw_callback pre_activate_cb, lw_callback selection_cb, lw_callback post_activate_cb */); Widget lw_get_widget (/* LWLIB_ID id, Widget parent, Boolean pop_up_p */); Widget lw_make_widget (/* LWLIB_ID id, Widget parent, Boolean pop_up_p */); Widget lw_create_widget (/* char* type, char* name, LWLIB_ID id, widget_value* val, Widget parent, Boolean pop_up_p, lw_callback pre_activate_cb, lw_callback selection_cb, lw_callback post_activate_cb */); LWLIB_ID lw_get_widget_id (/* Widget w */); void lw_modify_all_widgets (/* LWLIB_ID id, widget_value* val, Boolean deep_p */); void lw_destroy_widget (/* Widget w */); void lw_destroy_all_widgets (/* LWLIB_ID id */); void lw_destroy_everything (/* void */); void lw_destroy_all_pop_ups (/* void */); Widget lw_raise_all_pop_up_widgets (/* void */); widget_value* lw_get_all_values (/* LWLIB_ID id */); Boolean lw_get_some_values (/* LWLIB_ID id, widget_value* val */); void lw_pop_up_all_widgets (/* LWLIB_ID id */); void lw_pop_down_all_widgets (/* LWLIB_ID id */); widget_value *malloc_widget_value (); void free_widget_value (/* widget_value * */); void lw_popup_menu (/* Widget */); /* Toolkit independent way of focusing on a Widget at the Xt level. */ void lw_set_keyboard_focus (/* Widget parent, Widget w */); /* Silly Energize hack to invert the "sheet" button */ void lw_show_busy (/* Widget w, Boolean busy */); /* Silly hack to assist with Lucid/Athena geometry management. */ void lw_refigure_widget (/* Widget w, Boolan doit */); /* Toolkit independent way of determining if an event occurred on a menubar. */ Boolean lw_window_is_in_menubar (/* Window win, Widget menubar_widget */); /* Manage resizing: TRUE permits resizing widget w; FALSE disallows it. */ void lw_allow_resizing (/* Widget w, Boolean flag */); /* Set up the main window. */ void lw_set_main_areas (/* Widget parent, Widget menubar, Widget work_area */); #endif /* LWLIB_H */ emacs-19.30/lwlib/xlwmenu.h100444 22417 1 3356 5636355042 14107 0ustar pmrdaemon#ifndef _XlwMenu_h #define _XlwMenu_h /*********************************************************************** * * XlwMenu Widget * ***********************************************************************/ #include "lwlib.h" /* Resource names used by the XlwMenu widget */ #define XtNbuttonForeground "buttonForeground" #define XtCButtonForeground "ButtonForeground" #define XtNmargin "margin" #define XtNhorizontalSpacing "horizontalSpacing" #define XtNverticalSpacing "verticalSpacing" #define XtNarrowSpacing "arrowSpacing" #define XtNmenu "menu" #define XtCMenu "Menu" #define XtNopen "open" #define XtNselect "select" #define XtNmenuBorderWidth "menuBorderWidth" #define XtNhorizontal "horizontal" #define XtCHorizontal "Horizontal" #define XtNcursor "cursor" #define XtNCursor "Cursor" #define XtNshowGrip "showGrip" #define XtCShowGrip "ShowGrip" #define XtNresizeToPreferred "resizeToPreferred" #define XtCResizeToPreferred "ResizeToPreferred" #define XtNallowResize "allowResize" #define XtCAllowResize "AllowResize" /* Motif-compatible resource names */ #define XmNshadowThickness "shadowThickness" #define XmCShadowThickness "ShadowThickness" #define XmNtopShadowColor "topShadowColor" #define XmCTopShadowColor "TopShadowColor" #define XmNbottomShadowColor "bottomShadowColor" #define XmCBottomShadowColor "BottomShadowColor" #define XmNtopShadowPixmap "topShadowPixmap" #define XmCTopShadowPixmap "TopShadowPixmap" #define XmNbottomShadowPixmap "bottomShadowPixmap" #define XmCBottomShadowPixmap "BottomShadowPixmap" #define XmRHorizontalDimension "HorizontalDimension" typedef struct _XlwMenuRec *XlwMenuWidget; typedef struct _XlwMenuClassRec *XlwMenuWidgetClass; extern WidgetClass xlwMenuWidgetClass; void pop_up_menu (); #endif /* _XlwMenu_h */ emacs-19.30/lwlib/xlwmenuP.h100444 22417 1 3531 5641364021 14213 0ustar pmrdaemon#ifndef _XlwMenuP_h #define _XlwMenuP_h #include "xlwmenu.h" #include /* Elements in the stack arrays. */ typedef struct _window_state { Window window; Position x; Position y; Dimension width; Dimension height; Dimension label_width; } window_state; /* New fields for the XlwMenu widget instance record */ typedef struct _XlwMenu_part { /* slots set by the resources */ XFontStruct* font; Pixel foreground; Pixel button_foreground; Dimension margin; Dimension horizontal_spacing; Dimension vertical_spacing; Dimension arrow_spacing; Dimension shadow_thickness; Pixel top_shadow_color; Pixel bottom_shadow_color; Pixmap top_shadow_pixmap; Pixmap bottom_shadow_pixmap; Cursor cursor_shape; XtCallbackList open; XtCallbackList select; widget_value* contents; int horizontal; /* State of the XlwMenu */ int old_depth; widget_value** old_stack; int old_stack_length; /* New state after the user moved */ int new_depth; widget_value** new_stack; int new_stack_length; /* Window resources */ window_state* windows; int windows_length; /* Internal part, set by the XlwMenu */ GC foreground_gc; GC button_gc; GC background_gc; GC inactive_gc; GC inactive_button_gc; GC shadow_top_gc; GC shadow_bottom_gc; Cursor cursor; Boolean popped_up; Pixmap gray_pixmap; } XlwMenuPart; /* Full instance record declaration */ typedef struct _XlwMenuRec { CorePart core; XlwMenuPart menu; } XlwMenuRec; /* New fields for the XlwMenu widget class record */ typedef struct { int dummy; } XlwMenuClassPart; /* Full class record declaration. */ typedef struct _XlwMenuClassRec { CoreClassPart core_class; XlwMenuClassPart menu_class; } XlwMenuClassRec; /* Class pointer. */ extern XlwMenuClassRec xlwMenuClassRec; #endif /* _XlwMenuP_h */ emacs-19.30/lwlib/Makefile.in100444 12120 1 3742 6013753777 14303 0ustar rmsdaemon# This was taken from the output of Imake # and set up to be configured by ../configure. # Some parts Copyright (c) 1992, 1993 Lucid, Inc. srcdir=@srcdir@ VPATH=@srcdir@ C_SWITCH_X_SITE=@C_SWITCH_X_SITE@ CC=@CC@ CFLAGS=@CFLAGS@ CPP=@CPP@ LN_S=@LN_S@ RANLIB=@RANLIB@ # See below--@X_TOOLKIT_TYPE@ is used below. USE_X_TOOLKIT=@X_TOOLKIT_TYPE@ TOP = . AR = ar cq LN = ln -s RM = rm -f LUCID_OBJS = lwlib-Xlw.o xlwmenu.o lwlib-Xaw.o MOTIF_OBJS = lwlib-Xm.o OLIT_OBJS = lwlib-Xol.o lwlib-Xolmb.o TOOLKIT_DEFINES = -DUSE_$(USE_X_TOOLKIT) TOOLKIT_OBJS = $(@X_TOOLKIT_TYPE@_OBJS) OBJS = lwlib.o $(TOOLKIT_OBJS) lwlib-utils.o # ../src is needed to find config.h. ALL_CFLAGS= $(C_SWITCH_SITE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \ $(C_SWITCH_X_SYSTEM) $(C_SWITCH_MACHINE) $(CPPFLAGS) $(CFLAGS) \ -DEMACS_BITMAP_FILES -DHAVE_CONFIG_H -Demacs \ -I. -I../src -I${srcdir} -I${srcdir}/../src .c.o: $(CC) -c ${ALL_CFLAGS} $< all:: liblw.a liblw.a: $(OBJS) $(RM) $@ $(AR) $@ $(OBJS) @echo Do not be alarmed if the following ranlib command @echo fails due to the absence of a ranlib program on your system. -$(RANLIB) $@ || true #If running ranlib fails, probably there is none. #That's ok. So don't stop the build. # Depend on Makefile so that we recompile if TOOLKIT_DEFINES changes. lwlib.o: $(srcdir)/lwlib.c Makefile $(CC) -c $(TOOLKIT_DEFINES) $(ALL_CFLAGS) $(srcdir)/lwlib.c xrdb-cpp.o: $(srcdir)/xrdb-cpp.c $(CC) -c "-DCPP_PROGRAM=$(CPP)" $(ALL_CFLAGS) $(srcdir)/xrdb-cpp.c lwlib-utils.o: lwlib-utils.h lwlib.o: lwlib.h lwlib-int.h lwlib-Xlw.o: lwlib.h lwlib-int.h lwlib-Xaw.o: lwlib.h lwlib-int.h lwlib-Xm.o: lwlib.h lwlib-int.h lwlib-utils.h lwlib-Xol.o: lwlib.h lwlib-int.h lwlib-Xolmb.o: lwlib-Xolmb.h lwlib-XolmbP.h mostlyclean: $(RM) *.o core errs ,* *~ *.a .emacs_* make.log MakeOut \#* clean: mostlyclean distclean: clean maintainer-clean: distclean tags:: $(TAGS) -t *.[ch] emacs-19.30/lwlib/README100666 12120 1 446 5517073662 13076 0ustar rmsdaemonThis subdirectory contains the lwlib library which provides a uniform interface to a few different X toolkits. The library was written by Lucid. This version has changes in the makefile to fit in with Emacs's configure script, and some source files have been renamed to fit in 14 characters. emacs-19.30/lwlib/Imakefile100666 12120 1 17542 5517072425 14070 0ustar rmsdaemon/**/# Imakefile file for liblw.a, Copyright (c) 1992-1993 Lucid, Inc. /* * If you have Motif and want to provide support for Motif widgets in lwlib, * then define USE_MOTIF. * * If you have OpenLook and want to provide support for OpenLook widgets in * lwlib, then define USE_OLIT. * * Otherwise, define USE_LUCID to use Lucid's own Motif-lookalike widgets, * which are included in this directory. * * You cannot define USE_MOTIF and USE_OLIT at the same time, but USE_LUCID * may be defined along with either of the other two. * * The OLIT menubar is slow, and possibly buggy. We recommend against using * it unless you'd like to try to improve it (which we encourage.) * * The Lucid menubar is much faster than the Motif menubar, but is missing * a few features (most notably stay-up menus and keyboard traversal.) But * since it has the Motif look-and-feel, we recommend using it even if you * have Motif. * * Currently, only the Motif widgets provide support for dialog boxes. If * you don't have Motif, you will not be able to pop up dialog boxes from * emacs. If you define both USE_LUCID and USE_MOTIF, then the menus will * be implemented with Lucid widgets, and the dialog boxes will be * implemented with Motif widgets. * * It shouldn't take much work to add support for non-Motif dialog boxes; * all that one need do is add code that implements Athena versions of the * xm_create_dialog(), xm_update_one_widget(), and xm_update_one_value() * routines in lwlib-Xm.c. If you do this, please send us the code. * * If you have your X11 source tree online, then you should define * INCLUDE_EXTENSIONS to cause this library to contain some useful functions * which Xt should provide but doesn't. You can only do this if you have * the source tree online, because these functions require access to internal * Xt data structures that are not defined in the exported header files. * If you define INCLUDE_EXTENSIONS, then the variable $TOP must point at the * root of the X11 source tree. * * To build a "shared" version of lwlib as well, define BUILD_SHARED_LIB. * If INCLUDE_EXTENSIONS is defined, and you want to link with a dynamic * version of Xt, it may be necessary to build a shared version of lwlib as * well, as the X libraries sometimes put *different code* in the dynamic * and shared versions of their libraries, for some reason I don't understand. * * Remember, if you build and install a shared version of lwlib, you may need * to run ldconfig(8) before anything will realize that it exists. * * To compile with support for Lucid's Energize Programming System, you must * define all of ENERGIZE, USE_LUCID, USE_MOTIF, and INCLUDE_EXTENSIONS. */ #define USE_LUCID /* #define USE_MOTIF */ /* #define USE_OLIT */ /* #define BUILD_SHARED_LIB */ /* #define ENERGIZE */ /* #define INCLUDE_EXTENSIONS */ #ifdef INCLUDE_EXTENSIONS /* this is where it is at our site */ TOP = /$(WHICH_X)/mit #endif /* * * You shouldn't need to edit anything below this point. * */ #ifdef ENERGIZE # if !defined(USE_LUCID) || !defined(USE_MOTIF) || !defined(INCLUDE_EXTENSIONS) ERROR! Energize requires Lucid widgets, Motif, and X Extensions. # endif #endif /* ENERGIZE */ #ifdef BUILD_SHARED_LIB SOLWREV=1.0 #endif #if (ProjectX == 4) STD_DEFINES = LibraryDefines CDEBUGFLAGS = LibraryCDebugFlags EXT_DEFINES = -DTHIS_IS_X11R4 WHICH_X = x11r4 #define SpecialLibObjectRule SpecialObjectRule #else /* !4 */ #if (ProjectX == 5) #ifdef BUILD_SHARED_LIB # define DoSharedLib YES # define DoNormalLib YES #endif #include EXT_DEFINES = -DTHIS_IS_X11R5 -DINCLUDE_ALLOCA_H WHICH_X = x11r5 #else /* !5 */ EXT_DEFINES = "ERROR! Imakefile was unable to determine whether this is X11r4 or X11r5." #endif /* !5 */ #endif /* !4 */ LUCID_SRCS = lwlib-Xlw.c xlwmenu.c LUCID_OBJS = lwlib-Xlw.o xlwmenu.o MOTIF_SRCS = lwlib-Xm.c MOTIF_OBJS = lwlib-Xm.o OLIT_SRCS = lwlib-Xol.c lwlib-Xol-mb.c OLIT_OBJS = lwlib-Xol.o lwlib-Xol-mb.o #ifdef INCLUDE_EXTENSIONS EXT_SRCS = dispatch.c xrdb-cpp.c xrdb.c EXT_OBJS = dispatch.o xrdb-cpp.o xrdb.o #endif #if (defined(USE_MOTIF) && defined(USE_OLIT)) TOOLKIT_DEFINES = "ERROR! You cannot define both USE_MOTIF and USE_OLIT at the same time (in Imakefile)." #else # if (defined(USE_MOTIF) && defined(USE_LUCID)) TOOLKIT_DEFINES = -DUSE_MOTIF -DUSE_LUCID TOOLKIT_SRCS = $(MOTIF_SRC) $(LUCID_SRCS) TOOLKIT_OBJS = $(MOTIF_OBJS) $(LUCID_OBJS) # else # if (defined(USE_OLIT) && defined(USE_LUCID)) DEFINES = -DUSE_OLIT -DUSE_LUCID TOOLKIT_SRCS = $(OLIT_SRC) $(LUCID_SRCS) TOOLKIT_OBJS = $(OLIT_OBJS) $(LUCID_OBJS) # else # if defined(USE_OLIT) TOOLKIT_DEFINES = -DUSE_OLIT TOOLKIT_SRCS = $(OLIT_SRC) TOOLKIT_OBJS = $(OLIT_OBJS) # else # if defined(USE_MOTIF) TOOLKIT_DEFINES = -DUSE_MOTIF TOOLKIT_SRCS = $(MOTIF_SRC) TOOLKIT_OBJS = $(MOTIF_OBJS) # else # if defined(USE_LUCID) TOOLKIT_DEFINES = -DUSE_LUCID TOOLKIT_SRCS = $(LUCID_SRC) TOOLKIT_OBJS = $(LUCID_OBJS) # else TOOLKIT_DEFINES = "ERROR! At least one of USE_MOTIF, USE_LUCID or USE_OLIT must be defined in Imakefile." # endif # endif # endif # endif # endif #endif #ifdef ENERGIZE # ifndef USE_MOTIF EZ_OBJS = "ERROR! ENERGIZE requires USE_MOTIF to be defined in Imakefile." # else EZ_OBJS = energize/blpsheet.o energize/build.o energize/classbr_ps.o \ energize/ctreebr_ps.o energize/debuggerps.o \ energize/editmode.o energize/leb_psheet.o \ energize/projectdisp.o energize/projectps.o \ energize/search.o energize/target.o ENERGIZEP = -DENERGIZE # endif #endif SRCS = lwlib.c $(TOOLKIT_SRCS) lwlib-utils.c $(EXT_SRCS) OBJS = lwlib.o $(TOOLKIT_OBJS) lwlib-utils.o $(EXT_OBJS) $(EZ_OBJS) EXT_FLAGS = -I$(TOOLKITSRC) $(EXT_DEFINES) LIBNAME = liblw.a #if defined(ENERGIZE) && defined(BUILD_SHARED_LIB) all:: @if [ ! -d shared ]; then mkdir shared; else exit 0; fi @if [ ! -d energize/shared ]; then mkdir energize/shared; \ else exit 0; fi @if [ ! -h shared/energize ]; \ then cd shared ; ln -s ../energize/shared energize ; \ else exit 0; fi clean:: $(RM) shared/energize #endif #ifdef BUILD_SHARED_LIB # if (ProjectX == 4) SharedLibraryObjectRule () NormalSharedLibraryTarget(lw,$(SOLWREV),$(OBJS)) # else /* X != 4 */ LibraryObjectRule () SharedLibraryTarget(lw,$(SOLWREV),$(OBJS),shared,..) # endif /* X != 4 */ #else /* !BUILD_SHARED_LIB */ NormalLibraryObjectRule () #endif /* !BUILD_SHARED_LIB */ NormalLibraryTarget (lw,$(OBJS)) MakefileSubdirs (energize) DependTarget () #ifdef ENERGIZE energize/Imakefile: -mkdir energize -(cd energize ; sh -c "ln -s ../$(VPATH)/energize/* .") /* #### we should automatically edit BUILD_SHARED_LIB into/out of the energize Imakefile, since that's the only thing down there that changes */ energize/Makefile: energize/Imakefile Imakefile $(MAKE) $(MFLAGS) Makefiles Makefile:: $(RM) energize/Makefile $(EZ_OBJS): energize/Makefile ${RM} $@ ; cd energize ; $(MAKE) $(MFLAGS) CC="$(CC)" CFLAGS="$(CFLAGS)" clean:: cd energize ; $(MAKE) $(MFLAGS) clean #endif #if defined(BUILD_SHARED_LIB) && (ProjectX == 4) # define LWObjectRule SpecialSharedObjectRule #else # define LWObjectRule SpecialLibObjectRule #endif CPPDEFS=-DCPP_PROGRAM=\"CppCmd\" LWObjectRule (lwlib.o, lwlib.c, $(TOOLKIT_DEFINES)) LWObjectRule (dispatch.o, dispatch.c, $(EXT_FLAGS)) LWObjectRule (xrdb-cpp.o, xrdb-cpp.c, $(EXT_FLAGS) "$(CPPDEFS)") LWObjectRule (xrdb.o, xrdb.c, $(EXT_FLAGS)) LWObjectRule (lwlib-Xm.o, lwlib-Xm.c, $(ENERGIZEP)) lwlib-utils.o: lwlib-utils.h lwlib.o: lwlib.h lwlib-internal.h lwlib-Xlw.o: lwlib.h lwlib-internal.h lwlib-Xm.o: lwlib.h lwlib-internal.h lwlib-utils.h lwlib-Xol.o: lwlib.h lwlib-internal.h lwlib-Xol-mb.o: lwlib-Xol-mb.h lwlib-Xol-mbP.h emacs-19.30/lwlib/ChangeLog100666 12120 1 37372 6055517154 14035 0ustar rmsdaemonFri Nov 24 23:41:12 1995 Richard Stallman * Version 19.30 released. Mon Nov 13 21:45:28 1995 Richard Stallman * xlwmenu.c (display_menu_item): Fix previous change. Sat Nov 4 15:06:40 1995 Richard Stallman * xlwmenu.c (display_menu_item): Don't treat buttons specially. Mon Aug 14 19:10:49 1995 Richard Stallman * Makefile.in (RANLIB): Get this var from configure. Wed Aug 2 03:12:39 1995 Richard Stallman * lwlib.c (lw_popup_menu): New arg `event', passed along. * lwlib-Xlw.c (xlw_popup_menu): New arg `event'. * lwlib-Xm.c (xm_popup_menu): New arg `event'. Mon Jun 19 22:50:57 1995 Richard Stallman * Version 19.29 released. Sun Jun 11 15:39:02 1995 Richard Stallman * lwlib.c (lwlib_toolkit_type): New variable. Fri May 26 23:54:11 1995 Richard Stallman * xlwmenu.c (Drag): Do nothing unless menu.popped_up field is set. Mon May 22 22:53:05 1995 Karl Heuer * xlwmenu.c (XlwMenuInitialize): Cast XCreatePixmapFromBitmapData args. Sat May 20 01:15:00 1995 Karl Heuer * lwlib.c: Don't use prototype. * lwlib-Xm.c (activate_button, xm_update_cascadebutton): Likewise. Fri May 5 21:54:02 1995 Richard Stallman * lwlib.c (lw_refigure_widget) [USE_MOTIF]: Fix backward if. Thu May 4 15:52:16 1995 Richard Stallman * Makefile.in (ALL_CFLAGS): Add -I../src. Wed May 3 19:35:22 1995 Morten Welinder * lwlib.c [__osf__]: Include string.h and stdlib.h. [__osf__] (xmalloc): Declared. Thu Apr 13 01:02:01 1995 Richard Stallman * lwlib-Xm.c (update_one_menu_entry, make_menu_in_widget): Specify more useful names in XmCreatePulldownMenu calls. * lwlib-Xaw.c (xaw_pop_instance): Make x, y, w, h unsigned. * xlwmenu.c (size_menu): Make height and label_width unsigned. (fit_to_screen): Make screen_width and screen_height unsigned. (motion_event_is_in_menu): Make x, y unsigned. Sun Apr 9 00:55:40 1995 Richard Stallman * lwlib-utils.c: If HAVE_CONFIG_H, include config.h. * Makefile.in (ALL_CFLAGS): Define HAVE_CONFIG_H. Add -I${srcdir}/../src. Sat Apr 8 14:01:45 1995 Paul Reilly * lwlib-Xm.c: Remove function prototypes. (xm_pop_down_callback): Call the deactivation callback only when popping down the top level submenu. Fri Apr 7 01:44:18 1995 Richard Stallman * Makefile.in (lwlib.o): Depend on Makefile. * lwlib-Xm.h: Remove function prototypes. * lwlib-Xm.c (remove_grabs): Use type Widget for `menu'. Wed Feb 15 14:09:35 1995 Paul Reilly * Makefile.in (ALL_CFLAGS): Allow include files to be found in `srcdir'. Tue Feb 7 18:50:09 1995 Richard Stallman * Makefile.in (maintainer-clean): Renamed from realclean. Mon Nov 28 18:11:00 1994 Richard Stallman * lwlib-int.h (safe_strdup): Don't use ANSI argument prototype. Tue Nov 15 03:22:52 1994 Paul Reilly * lwlib.c (lw_refigure_widget): Use the macro USE_XAW rather than XAW. Tue Nov 8 13:06:07 1994 Paul Reilly * lwlib-Xm.c (make_menu_in_widget): Differentiate a separator entry ("--") from a title. (xm_pop_down_callback): Filter all but the last pop down callbacks. Mon Nov 7 07:31:19 1994 Paul Reilly * lwlib-Xm.c (update_one_menu_entry): Use the parent of the cascade button as the parent of the pulldown, rather than the cascade button itself. This works around a Motif SIGSEGV in the function `InSharedMenuHierarchy'. Sat Oct 29 23:25:10 1994 Richard Stallman * xlwmenu.c (xlwmenu_default_font): New global variable. (XlwMenuInitialize): Use xlwmenu_default_font to default the font if necessary. Make mw, itself, an argument. Wed Oct 26 04:57:41 1994 Richard Stallman * xlwmenu.c (pop_up_menu): Pass a Display * to x_catch_errors, etc. Wed Oct 26 00:57:28 1994 Richard Stallman * xlwmenu.c (xlwmenu_default_font): New global variable. (XlwMenuInitialize): Use xlwmenu_default_font to default the font if necessary. Make mw, itself, an argument. * xlwmenu.c (pop_up_menu): Pass a Display * to x_catch_errors, etc. Sat Oct 8 00:15:45 1994 Richard Stallman * xlwmenu.c (fit_to_screen): Don't put the menu off the left or top. Sun Oct 2 08:07:15 1994 Paul Reilly * xlwmenu.c (display_menu_item): Add support for displaying the title in pop up menus. * lwlib.c (lw_set_main_areas): Use xm_set_main_areas(). (lw_manage_resizing): Use xm_manage_resizing() for Emacs/Motif. Sun Sep 25 15:57:17 1994 Paul Reilly * lwlib-Xaw.c (xaw_create_main): New function to support the toolkit independent creation of the main Emacs widget. * lwlib-Xlw.c (xlw_create_menubar): When compiling under Emacs, set resizing resources to disable showGrip and to enable both resizeToPreferred and allowShellResize. * lwlib-Xm.h: Declare xm_set_main_areas, xm_manage_resizing. * lwlib-Xm.c: (make_menu_in_widget): Add support for displaying a title in pop up menus. (make_main, xm_set_main_areas, xm_manage_resizing): New functions to create and manage a Motif Main Window widget. * xlwmenu.c: Add #include for X11R4. Sun Sep 18 17:21:52 1994 Fred Pierresteguy * lwlib-Xm.c (make_dialog): When there is more than two pushbuttons, set XmPACK_TIGHT and XmHORIZONTAL to the rowcolumn. Also add a margin of 10 pixels. Fri Sep 16 17:21:52 1994 Paul Reilly * lwlib-Xm.c (make_main): New function to support toolkit independent creation of the main Emacs widget. (make_destroyed_instance): Use safe_strdup() instead of strdup(). * lwlib-int.h: Declare safe_strdup. * lwlib.c (lw_refigure_widget): New function. Handle geometry management inside lwlib instead of in Emacs. (lw_window_is_in_menubar): New function. Determine if the pointer is in a menubar. (lw_set_main_areas): New function. Set the main window widgets for Motif. * lwlib.h: Declare lw_refigure_widget(), lw_window_is_in_menubar(), lw_set_main_areas(). * xlwmenu.h: Define Xt{Ns,CS}howGrip, Xt{Nr,CR}esizeToPreferred, and Xt{Na,CA}llowResize. * xlwmenu.c (Start): Use pop_up_menu() to post the submenus. (Select): Remove the pointer grab when popping down a menubar submenu. (pop_up_menu): Handle popping up submenus from a menubar, i.e. when the menu widget parent is not a shell widget. Thu Aug 25 17:21:52 1994 Richard Stallman * xlwmenu.c (pop_up_menu): Clear next_release_must_exit. (Start): Clear next_release_must_exit when popping up the menu. Wed Aug 24 22:19:46 1994 Richard Stallman * xlwmenu.c (Start): Set menu_post_event or next_release_must_exit. (Select): Do nothing if the menu should be left posted. Thu Jul 28 17:12:31 1994 Richard Stallman * xlwmenu.c (make_windows_if_needed, pop_up_menu): Enable mouse motion events even when no button down. Mon Jul 11 21:38:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xlwmenu.c (pointer_grabbed): New variable. (pop_up_menu): Set the variable. (XlwMenuDestroy): Maybe call XtUngrabPointer. Wed May 25 04:19:01 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lwlib.c (max): Function deleted. Define as macro instead, but only if not already defined. Fri May 20 18:42:58 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xlwmenu.c (xlwMenuResources): Use XtRDimension for shadow thickness. Thu May 19 12:23:39 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lwlib-Xaw.c (xaw_pop_instance): Use XtSetValues, not XtMoveWidget. Mon May 16 03:25:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lwlib.c (lwlib_memset: New function, used instead of memset. All callers changed. * lwlib.c (lwlib_bcopy): New function. * lwlib-utils.c (XtApplyToWidgets): Use lwlib_bcopy. * lwlib.c: Delete definitions for use of alloca. (name_to_widget): Use xmalloc, not alloca. Thu May 12 06:20:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xlwmenu.c (XlwMenuDestroy): Set new var submenu_destroyed. (XlwMenuRedisplay): If it's set, truncate the old_depth to 1. Mon May 9 18:35:53 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xrdb-cpp.c: Don't include string.h, unistd.h, stdlib.h. * lwlib-Xaw.c: Don't include string.h, unistd.h, stdlib.h. * lwlib-utils.c (XtApplyToWidgets): Use bcopy, not memcpy. * lwlib-utils.c: Don't include string.h, unistd.h, stdlib.h, memory.h. * xlwmenu.c: Don't include string.h, unistd.h, stdlib.h. * lwlib.c: Don't include string.h, unistd.h, stdlib.h. (safe_strdup): No longer static. * lwlib-Xm.c: Use safe_strdup, not strdup. * xlwmenu.c (string_width): No longer static. Fri May 6 13:24:17 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xlwmenuP.h (struct _XlwMenu_part): Use Pixel and Cursor for foreground and cursor_shape fields. * xlwmenu.c (XlwMenuSetValues): Check for change of font. Thu Apr 28 16:02:23 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in: Delete all SRCS variables (unused). (lwlib.o, xrdb-cpp.o): Mention srcdir in dep. Fri Apr 15 18:31:25 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (ALL_CFLAGS): Don't define THIS_IS_X11R4. * xrdb.c: Define HAVE_X11R5 as in xterm.h. Include X11/Xlib.h, X11/cursorfont.h and X11/Xutil.h. (_XtDisplayInitialize): Test HAVE_X11R5. * dispatch.c: Define HAVE_X11R5 as in xterm.h. Include X11/Xlib.h, X11/cursorfont.h and X11/Xutil.h. (_XtConvertTypeToMask): Conditionalize on HAVE_X11R5. (WouldDispatchEvent): Likewise. Tue Apr 12 12:32:32 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lwlib-Xaw.c (xaw_generic_callback): Declare without arg names. Fri Apr 1 03:25:31 1994 Frederic Pierresteguy (fp@hal.gnu.ai.mit.edu) * lwlib-Xaw.c (make_dialog): Don't allow any geometry request from the user. Tue Mar 22 13:09:25 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xlwmenu.c (XlwMenuResize): Don't allow the popup menu to resize itself. Therefore reset the size to its initial value. Sat Mar 19 02:13:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lwlib-Xaw.c (xaw_update_one_widget): Finish replacing XtVaSetValues. Don't test for scrollbar widget. Mon Mar 14 11:12:33 1994 Frederic Pierresteguy (fp@gnu.ai.mit.edu) * lwlib-int.h: Declare lw_get_widget_info. * lwlib.c (lw_get_widget_info): Comment out arg in function decl. * lwlib-Xaw.h: Comment out args in function decls. * lwlib-Xaw.c: Convert all function definitions to non-prototype K&R. (xaw_update_one_widget - case dialogWidgetClass): Call XtSetValues, not XtVaSetValues. Fri Mar 11 05:35:04 1994 Frederic Pierresteguy (F.Pierresteguy@frcl.bull.fr) * xlwmenu.c (display_menu_item): Modify parameters to draw_arrow to right justify the arrow in the pane. * lwlib.c: If not defined USE_MOTIF and defined USE_LUCID then define USE_XAW. * Makefile.in (LUCID_SRCS, LUCID_OBJS): Add the target lwlib-Xaw.[oc]. * lwlib.c, lwlib-int.h: Merged from Lucid 19.9 release. * lwlib.c (_AIX): Replace the AIXV3 directive. (USE_XAW): New macro to conditionalize the use of the athena toolkit. (lw_get_widget_info): New function. (set_one_value): Handle USE_XAW. (instanciate_widget_instance): Likewise. (destroy_one_instance): Likewise. (lw_pop_all_widgets): Likewise. (lw_pop_down_all_widgets): Likewise. (get_one_value): Likewise. * lwlib-Xaw.c, lwlib-Xaw.h: New files. Wed Feb 23 02:50:05 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xlwmenu.c (XlwMenuInitialize, XlwMenuDestroy): Undo previous changes. * lwlib-Xlw.c (xlw_create_menubar, xlw_create_popup_menu): Use XtCreate..., not XtVaCreate... No need to copy instance->info->val any more. (xlw_update_one_widget): Use XtSetValues, not XtVaSetValues. Mon Feb 21 16:34:02 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xlwmenu.c (pop_up_menu): Call XtUngrabPointer if XtGrabPointer fails. Sat Feb 19 15:21:40 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (xrdb-cpp.o, lwlib.o): Put ALL_CFLAGS after other flags. * lwlib-Xlw.c (xlw_create_menubar): Don't call free_widget_value. Use malloc for allocation. (xlw_create_popup_menu): Likewise. Fri Feb 18 08:03:02 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * lwlib.c (malloc_cpt): New static variable. (malloc_widget_value): Increment malloc_cpt when allocating a cell. (free_widget_value): Really free the cells when the number of allocated ones is bigger than 25. * lwlib-Xlw.c (xlw_create_menubar): Call malloc_widget_value and free_widget_value instead of XtMalloc and XtFree. (xlw_create_popup_menu): Likewise. Thu Feb 17 18:30:52 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in (ALL_CFLAGS): Specify -Demacs. * xlwmenu.c (pop_up_menu) [emacs]: Catch and ignore X protocol errors in XtGrabPointer. Thu Feb 17 17:09:21 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * lwlib-Xlw.c (xlw_create_popup_menu): Pass tem to XtVaCreateManagedWidget, not instance->info->val. (xlw_create_menubar): Likewise. Tue Feb 15 09:04:54 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * lwlib-Xlw.c (xlw_create_popup_menu): Copy instance->info->val before calling XtVaCreateManagedWidget and then free the copy. (xlw_create_menubar): Likewise. Fri Feb 11 13:06:34 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xlwmenu.c (XlwMenuInitialize): Copy mw->menu.contents. (XlwMenuDestroy): Free mw->menu.contents. Wed Feb 9 09:02:27 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xlwmenu.c (display_menu_item): Call draw_shadow_rectangle to make visible/invisible the selection of the menubar items. Tue Feb 8 17:46:34 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * lwlib.c (strcasecmp): Renamed to my_strcasecmp. (find_in_table): Changed only caller. Fri Feb 4 12:00:46 1994 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu) * xlwmenu.c (display_menu_item): When dealing with the menubar, always call XDrawRectangle to clear the selection after popping down the pulldown menu. Tue Feb 1 13:21:57 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lwlib.c: Include ctype.h. Mon Jan 31 00:47:29 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lwlib.c (strcasecmp): New function. Sun Jan 30 23:30:08 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xlwmenu.c, lwlib.c, lwlib-Xlw.c, lwlib-utils.c: Convert all function definitions to non-prototype K&R. * lwlib-Xlw.h: Comment out args in function decls. * lwlib.h: Comment out args in function decls. * lwlib-utils.h: Comment out args in function decls. Sat Jan 29 21:58:47 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * lwlib.c: Include StringDefs.h after lwlib.h. Sat Jan 22 18:21:59 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * Makefile (xrdb-cpp.o, lwlib.o): Use $(srcdir) and file name instead of $*. (dispatch.o, xrdb.o, lwlib-Xm.o): Rules removed; they were superfluous and didn't work when configured outside srcdir. The implicit .c.o rule works fine. Fri Jan 21 11:51:56 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * xlwmenu.c (resource_widget_value): Avoid using strdup. Tue Jan 18 18:52:43 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile.in: New file. * lwlib-Xolmb.c: Renamed from lwlib-Xol-mb.c. * lwlib-Xolmb.h: Renamed from lwlib-Xol-mb.h. * lwlib-XolmbP.h: Renamed from lwlib-Xol-mbP.h. * lwlib-int.h: Renamed from lwlib-internal.h. emacs-19.30/nt/ 40777 12120 1 0 6055530673 11443 5ustar rmsdaemonemacs-19.30/nt/inc/ 40777 12120 1 0 6055530673 12214 5ustar rmsdaemonemacs-19.30/nt/inc/sys/ 40777 12120 1 0 6055530674 13033 5ustar rmsdaemonemacs-19.30/nt/inc/sys/dir.h100444 23073 1 117 5753547547 14722 0ustar voelkerdaemon/* * map sys\dir.h to ..\..\..\src\ndir.h */ #include "..\..\..\src\ndir.h" emacs-19.30/nt/inc/sys/file.h100444 23073 1 322 5753547571 15056 0ustar voelkerdaemon/* * sys\file.h doesn't exist on NT...rather than including it conditionally * in some of the source files, we just extend the include path so that the * compiler will pick up this empty header instead. */ emacs-19.30/nt/inc/sys/ioctl.h100444 23073 1 323 5753550530 15237 0ustar voelkerdaemon/* * sys\ioctl.h doesn't exist on NT...rather than including it conditionally * in many of the source files, we just extend the include path so that the * compiler will pick this up empty header instead. */ emacs-19.30/nt/inc/sys/param.h100444 23073 1 216 5753550716 15234 0ustar voelkerdaemon#ifndef _PARAM_H_ #define _PARAM_H_ /* * sys\param.h doesn't exist on NT, so we'll make one. */ #define NBPG 4096 #endif /* _PARAM_H_ */ emacs-19.30/nt/inc/pwd.h100444 23073 1 445 5753547456 14123 0ustar voelkerdaemon#ifndef _PWD_H_ #define _PWD_H_ /* * pwd.h doesn't exist on NT, so we put together our own. */ struct passwd { char *pw_name; char *pw_passwd; int pw_uid; int pw_gid; int pw_quota; char *pw_gecos; char *pw_dir; char *pw_shell; }; #endif /* _PWD_H_ */ emacs-19.30/nt/emacs.ico100666 12120 1 1376 5673423742 13336 0ustar rmsdaemon è( @€€€€€€€€€€€€€@@@ÿÿÿÿÿÿÿÿÿÿÿÿÌÌÀ ÀÀÌÌÀÀ ÀÀ À À ÀÀ ÌÀ ÌÌÀ ÌÀÀ ÀÀ À ÀÌÀÀ À ÌÌÀ ÌÌÌÀ ™ ™ ™ ™™ ™ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿíÜñ~íÛn~íÛþ¬ñ~­Ûï~MÛnî<ñÿÿÿÿÿÿÿÿÿÿÿÿþ=Þ?ýÝßýÝßý]ßýü]ßýÜÝßþ=Ýßÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿemacs-19.30/nt/emacs.rc100444 23073 1 30 5753545446 13770 0ustar voelkerdaemonEmacs ICON emacs.ico emacs-19.30/nt/config.nt100444 23073 1 23440 6047610305 14234 0ustar voelkerdaemon/* GNU Emacs site configuration template file. -*- C -*- Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY. No author or distributor accepts responsibility to anyone for the consequences of using it or for whether it serves any particular purpose or works at all, unless he says so in writing. Refer to the GNU Emacs General Public License for full details. Everyone is granted permission to copy, modify and redistribute GNU Emacs, but only under the conditions described in the GNU Emacs General Public License. A copy of this license is supposed to have been given to you along with GNU Emacs so you can know your rights and responsibilities. It should be in a file named COPYING. Among other things, the copyright notice and this notice must be preserved on all copies. */ /* No code in Emacs #includes config.h twice, but some of the code intended to work with other packages as well (like gmalloc.c) think they can include it as many times as they like. */ #ifndef EMACS_CONFIG_H #define EMACS_CONFIG_H /* These are all defined in the top-level Makefile by configure. They're here only for reference. */ /* Define LISP_FLOAT_TYPE if you want emacs to support floating-point numbers. */ #undef LISP_FLOAT_TYPE /* Define GNU_MALLOC if you want to use the *new* GNU memory allocator. */ #undef GNU_MALLOC /* Define REL_ALLOC if you want to use the relocating allocator for buffer space. */ #undef REL_ALLOC /* Define HAVE_X_WINDOWS if you want to use the X window system. */ #undef HAVE_X_WINDOWS /* Define HAVE_X11 if you want to use version 11 of X windows. Otherwise, Emacs expects to use version 10. */ #undef HAVE_X11 /* Define if using an X toolkit. */ #undef USE_X_TOOLKIT /* Define this if you're using XFree386. */ #undef HAVE_XFREE386 /* Define HAVE_X_MENU if you want to use the X window menu system. This appears to work on some machines that support X and not on others. */ #undef HAVE_X_MENU /* Define if we have the X11R6 or newer version of Xt. */ #undef HAVE_X11XTR6 /* Define if netdb.h declares h_errno. */ #undef HAVE_H_ERRNO /* Nowadays we have frame objects even if we support only ASCII terminals. */ #define MULTI_FRAME /* If we're using any sort of window system, define some consequences. */ #ifdef HAVE_X_WINDOWS #define HAVE_WINDOW_SYSTEM #define MULTI_KBOARD #define HAVE_FACES #define HAVE_MOUSE #endif /* Define USE_TEXT_PROPERTIES to support visual and other properties on text. */ #define USE_TEXT_PROPERTIES /* Define USER_FULL_NAME to return a string that is the user's full name. It can assume that the variable `pw' points to the password file entry for this user. At some sites, the pw_gecos field contains the user's full name. If neither this nor any other field contains the right thing, use pw_name, giving the user's login name, since that is better than nothing. */ #define USER_FULL_NAME pw->pw_gecos /* Define AMPERSAND_FULL_NAME if you use the convention that & in the full name stands for the login id. */ #undef AMPERSAND_FULL_NAME /* Things set by --with options in the configure script. */ /* Define to support POP mail retrieval. */ #undef MAIL_USE_POP /* Define to support Kerberos-authenticated POP mail retrieval. */ #undef KERBEROS /* Define to support using a Hesiod database to find the POP server. */ #undef HESIOD /* Some things figured out by the configure script, grouped as they are in configure.in. */ #ifndef _ALL_SOURCE /* suppress warning if this is pre-defined */ #undef _ALL_SOURCE #endif #undef HAVE_SYS_SELECT_H #undef HAVE_SYS_TIMEB_H #undef HAVE_SYS_TIME_H #undef HAVE_UNISTD_H #undef HAVE_UTIME_H #undef STDC_HEADERS #undef TIME_WITH_SYS_TIME #undef HAVE_LIBDNET #undef HAVE_LIBPTHREADS #undef HAVE_LIBRESOLV #undef HAVE_ALLOCA_H #undef HAVE_GETTIMEOFDAY #undef GETTIMEOFDAY_ONE_ARGUMENT #undef HAVE_GETHOSTNAME #undef HAVE_DUP2 #undef HAVE_RENAME #undef HAVE_CLOSEDIR #undef TM_IN_SYS_TIME #undef HAVE_TM_ZONE #undef HAVE_TZNAME #undef const #undef HAVE_LONG_FILE_NAMES #undef CRAY_STACKSEG_END #undef UNEXEC_SRC #undef HAVE_LIBXBSD #undef HAVE_XRMSETDATABASE #undef HAVE_XSCREENRESOURCESTRING #undef HAVE_XSCREENNUMBEROFSCREEN #undef HAVE_XSETWMPROTOCOLS #undef HAVE_MKDIR #undef HAVE_RMDIR #undef HAVE_RANDOM #undef HAVE_LRAND48 #undef HAVE_BCOPY #undef HAVE_BCMP #undef HAVE_LOGB #undef HAVE_FREXP #undef HAVE_FMOD #undef HAVE_FTIME #undef HAVE_RES_INIT /* For -lresolv on Suns. */ #undef HAVE_SETSID #undef HAVE_FPATHCONF #undef HAVE_SELECT #undef HAVE_MKTIME #undef HAVE_EACCESS #undef HAVE_GETPAGESIZE #undef HAVE_INET_SOCKETS #undef HAVE_AIX_SMT_EXP /* Define if you have the ANSI `strerror' function. Otherwise you must have the variable `char *sys_errlist[]'. */ #undef HAVE_STRERROR #undef HAVE_UTIMES /* Define if `sys_siglist' is declared by . */ #undef SYS_SIGLIST_DECLARED /* Define if `struct utimbuf' is declared by . */ #undef HAVE_STRUCT_UTIMBUF /* Define if `struct timeval' is declared by . */ #undef HAVE_TIMEVAL /* If using GNU, then support inline function declarations. */ #ifdef __GNUC__ #define INLINE __inline__ #else #define INLINE #endif #undef EMACS_CONFIGURATION #undef EMACS_CONFIG_OPTIONS /* The configuration script defines opsysfile to be the name of the s/SYSTEM.h file that describes the system type you are using. The file is chosen based on the configuration name you give. See the file ../etc/MACHINES for a list of systems and the configuration names to use for them. See s/template.h for documentation on writing s/SYSTEM.h files. */ #undef config_opsysfile #include "s/windowsnt.h" /* The configuration script defines machfile to be the name of the m/MACHINE.h file that describes the machine you are using. The file is chosen based on the configuration name you give. See the file ../etc/MACHINES for a list of machines and the configuration names to use for them. See m/template.h for documentation on writing m/MACHINE.h files. */ #undef config_machfile #include "m/intel386.h" /* These typedefs shouldn't appear when alloca.s or Makefile.in includes config.h. */ #ifndef NOT_C_CODE #ifndef SPECIAL_EMACS_INT typedef long EMACS_INT; typedef unsigned long EMACS_UINT; #endif #endif /* Load in the conversion definitions if this system needs them and the source file being compiled has not said to inhibit this. There should be no need for you to alter these lines. */ #ifdef SHORTNAMES #ifndef NO_SHORTNAMES #include "../shortnames/remap.h" #endif /* not NO_SHORTNAMES */ #endif /* SHORTNAMES */ /* If no remapping takes place, static variables cannot be dumped as pure, so don't worry about the `static' keyword. */ #ifdef NO_REMAP #undef static #endif /* Define `subprocesses' should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). These do not work for some USG systems yet; for the ones where they work, the s/SYSTEM.h file defines this flag. */ #ifndef VMS #ifndef USG /* #define subprocesses */ #endif #endif /* Define LD_SWITCH_SITE to contain any special flags your loader may need. */ #undef LD_SWITCH_SITE /* Define C_SWITCH_SITE to contain any special flags your compiler needs. */ #undef C_SWITCH_SITE /* Define LD_SWITCH_X_SITE to contain any special flags your loader may need to deal with X Windows. For instance, if you've defined HAVE_X_WINDOWS above and your X libraries aren't in a place that your loader can find on its own, you might want to add "-L/..." or something similar. */ #undef LD_SWITCH_X_SITE /* Define LD_SWITCH_X_SITE_AUX with an -R option in case it's needed (for Solaris, for example). */ #undef LD_SWITCH_X_SITE_AUX /* Define C_SWITCH_X_SITE to contain any special flags your compiler may need to deal with X Windows. For instance, if you've defined HAVE_X_WINDOWS above and your X include files aren't in a place that your compiler can find on its own, you might want to add "-I/..." or something similar. */ #undef C_SWITCH_X_SITE /* Define STACK_DIRECTION here, but not if m/foo.h did. */ #ifndef STACK_DIRECTION #undef STACK_DIRECTION #endif /* Define the return type of signal handlers if the s-xxx file did not already do so. */ #define RETSIGTYPE void /* SIGTYPE is the macro we actually use. */ #ifndef SIGTYPE #define SIGTYPE RETSIGTYPE #endif #ifdef emacs /* Don't do this for lib-src. */ /* Tell regex.c to use a type compatible with Emacs. */ #define RE_TRANSLATE_TYPE Lisp_Object * #endif /* The rest of the code currently tests the CPP symbol BSTRING. Override any claims made by the system-description files. Note that on some SCO version it is possible to have bcopy and not bcmp. */ #undef BSTRING #if defined (HAVE_BCOPY) && defined (HAVE_BCMP) #define BSTRING #endif /* Non-ANSI C compilers usually don't have volatile. */ #ifndef HAVE_VOLATILE #ifndef __STDC__ #define volatile #endif #endif /* Some of the files of Emacs which are intended for use with other programs assume that if you have a config.h file, you must declare the type of getenv. This declaration shouldn't appear when alloca.s or Makefile.in includes config.h. */ #ifndef NOT_C_CODE extern char *getenv (); #endif #endif /* EMACS_CONFIG_H */ /* These default definitions are good for almost all machines. The exceptions override them in m/*.h. */ #ifndef BITS_PER_CHAR #define BITS_PER_CHAR 8 #endif #ifndef BITS_PER_SHORT #define BITS_PER_SHORT 16 #endif /* Note that lisp.h uses this in a preprocessor conditional, so it would not work to use sizeof. That being so, we do all of them without sizeof, for uniformity's sake. */ #ifndef BITS_PER_INT #define BITS_PER_INT 32 #endif #ifndef BITS_PER_LONG #define BITS_PER_LONG 32 #endif emacs-19.30/nt/config.w95100444 23073 1 23440 6047610311 14234 0ustar voelkerdaemon/* GNU Emacs site configuration template file. -*- C -*- Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY. No author or distributor accepts responsibility to anyone for the consequences of using it or for whether it serves any particular purpose or works at all, unless he says so in writing. Refer to the GNU Emacs General Public License for full details. Everyone is granted permission to copy, modify and redistribute GNU Emacs, but only under the conditions described in the GNU Emacs General Public License. A copy of this license is supposed to have been given to you along with GNU Emacs so you can know your rights and responsibilities. It should be in a file named COPYING. Among other things, the copyright notice and this notice must be preserved on all copies. */ /* No code in Emacs #includes config.h twice, but some of the code intended to work with other packages as well (like gmalloc.c) think they can include it as many times as they like. */ #ifndef EMACS_CONFIG_H #define EMACS_CONFIG_H /* These are all defined in the top-level Makefile by configure. They're here only for reference. */ /* Define LISP_FLOAT_TYPE if you want emacs to support floating-point numbers. */ #undef LISP_FLOAT_TYPE /* Define GNU_MALLOC if you want to use the *new* GNU memory allocator. */ #undef GNU_MALLOC /* Define REL_ALLOC if you want to use the relocating allocator for buffer space. */ #undef REL_ALLOC /* Define HAVE_X_WINDOWS if you want to use the X window system. */ #undef HAVE_X_WINDOWS /* Define HAVE_X11 if you want to use version 11 of X windows. Otherwise, Emacs expects to use version 10. */ #undef HAVE_X11 /* Define if using an X toolkit. */ #undef USE_X_TOOLKIT /* Define this if you're using XFree386. */ #undef HAVE_XFREE386 /* Define HAVE_X_MENU if you want to use the X window menu system. This appears to work on some machines that support X and not on others. */ #undef HAVE_X_MENU /* Define if we have the X11R6 or newer version of Xt. */ #undef HAVE_X11XTR6 /* Define if netdb.h declares h_errno. */ #undef HAVE_H_ERRNO /* Nowadays we have frame objects even if we support only ASCII terminals. */ #define MULTI_FRAME /* If we're using any sort of window system, define some consequences. */ #ifdef HAVE_X_WINDOWS #define HAVE_WINDOW_SYSTEM #define MULTI_KBOARD #define HAVE_FACES #define HAVE_MOUSE #endif /* Define USE_TEXT_PROPERTIES to support visual and other properties on text. */ #define USE_TEXT_PROPERTIES /* Define USER_FULL_NAME to return a string that is the user's full name. It can assume that the variable `pw' points to the password file entry for this user. At some sites, the pw_gecos field contains the user's full name. If neither this nor any other field contains the right thing, use pw_name, giving the user's login name, since that is better than nothing. */ #define USER_FULL_NAME pw->pw_gecos /* Define AMPERSAND_FULL_NAME if you use the convention that & in the full name stands for the login id. */ #undef AMPERSAND_FULL_NAME /* Things set by --with options in the configure script. */ /* Define to support POP mail retrieval. */ #undef MAIL_USE_POP /* Define to support Kerberos-authenticated POP mail retrieval. */ #undef KERBEROS /* Define to support using a Hesiod database to find the POP server. */ #undef HESIOD /* Some things figured out by the configure script, grouped as they are in configure.in. */ #ifndef _ALL_SOURCE /* suppress warning if this is pre-defined */ #undef _ALL_SOURCE #endif #undef HAVE_SYS_SELECT_H #undef HAVE_SYS_TIMEB_H #undef HAVE_SYS_TIME_H #undef HAVE_UNISTD_H #undef HAVE_UTIME_H #undef STDC_HEADERS #undef TIME_WITH_SYS_TIME #undef HAVE_LIBDNET #undef HAVE_LIBPTHREADS #undef HAVE_LIBRESOLV #undef HAVE_ALLOCA_H #undef HAVE_GETTIMEOFDAY #undef GETTIMEOFDAY_ONE_ARGUMENT #undef HAVE_GETHOSTNAME #undef HAVE_DUP2 #undef HAVE_RENAME #undef HAVE_CLOSEDIR #undef TM_IN_SYS_TIME #undef HAVE_TM_ZONE #undef HAVE_TZNAME #undef const #undef HAVE_LONG_FILE_NAMES #undef CRAY_STACKSEG_END #undef UNEXEC_SRC #undef HAVE_LIBXBSD #undef HAVE_XRMSETDATABASE #undef HAVE_XSCREENRESOURCESTRING #undef HAVE_XSCREENNUMBEROFSCREEN #undef HAVE_XSETWMPROTOCOLS #undef HAVE_MKDIR #undef HAVE_RMDIR #undef HAVE_RANDOM #undef HAVE_LRAND48 #undef HAVE_BCOPY #undef HAVE_BCMP #undef HAVE_LOGB #undef HAVE_FREXP #undef HAVE_FMOD #undef HAVE_FTIME #undef HAVE_RES_INIT /* For -lresolv on Suns. */ #undef HAVE_SETSID #undef HAVE_FPATHCONF #undef HAVE_SELECT #undef HAVE_MKTIME #undef HAVE_EACCESS #undef HAVE_GETPAGESIZE #undef HAVE_INET_SOCKETS #undef HAVE_AIX_SMT_EXP /* Define if you have the ANSI `strerror' function. Otherwise you must have the variable `char *sys_errlist[]'. */ #undef HAVE_STRERROR #undef HAVE_UTIMES /* Define if `sys_siglist' is declared by . */ #undef SYS_SIGLIST_DECLARED /* Define if `struct utimbuf' is declared by . */ #undef HAVE_STRUCT_UTIMBUF /* Define if `struct timeval' is declared by . */ #undef HAVE_TIMEVAL /* If using GNU, then support inline function declarations. */ #ifdef __GNUC__ #define INLINE __inline__ #else #define INLINE #endif #undef EMACS_CONFIGURATION #undef EMACS_CONFIG_OPTIONS /* The configuration script defines opsysfile to be the name of the s/SYSTEM.h file that describes the system type you are using. The file is chosen based on the configuration name you give. See the file ../etc/MACHINES for a list of systems and the configuration names to use for them. See s/template.h for documentation on writing s/SYSTEM.h files. */ #undef config_opsysfile #include "s/windows95.h" /* The configuration script defines machfile to be the name of the m/MACHINE.h file that describes the machine you are using. The file is chosen based on the configuration name you give. See the file ../etc/MACHINES for a list of machines and the configuration names to use for them. See m/template.h for documentation on writing m/MACHINE.h files. */ #undef config_machfile #include "m/intel386.h" /* These typedefs shouldn't appear when alloca.s or Makefile.in includes config.h. */ #ifndef NOT_C_CODE #ifndef SPECIAL_EMACS_INT typedef long EMACS_INT; typedef unsigned long EMACS_UINT; #endif #endif /* Load in the conversion definitions if this system needs them and the source file being compiled has not said to inhibit this. There should be no need for you to alter these lines. */ #ifdef SHORTNAMES #ifndef NO_SHORTNAMES #include "../shortnames/remap.h" #endif /* not NO_SHORTNAMES */ #endif /* SHORTNAMES */ /* If no remapping takes place, static variables cannot be dumped as pure, so don't worry about the `static' keyword. */ #ifdef NO_REMAP #undef static #endif /* Define `subprocesses' should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). These do not work for some USG systems yet; for the ones where they work, the s/SYSTEM.h file defines this flag. */ #ifndef VMS #ifndef USG /* #define subprocesses */ #endif #endif /* Define LD_SWITCH_SITE to contain any special flags your loader may need. */ #undef LD_SWITCH_SITE /* Define C_SWITCH_SITE to contain any special flags your compiler needs. */ #undef C_SWITCH_SITE /* Define LD_SWITCH_X_SITE to contain any special flags your loader may need to deal with X Windows. For instance, if you've defined HAVE_X_WINDOWS above and your X libraries aren't in a place that your loader can find on its own, you might want to add "-L/..." or something similar. */ #undef LD_SWITCH_X_SITE /* Define LD_SWITCH_X_SITE_AUX with an -R option in case it's needed (for Solaris, for example). */ #undef LD_SWITCH_X_SITE_AUX /* Define C_SWITCH_X_SITE to contain any special flags your compiler may need to deal with X Windows. For instance, if you've defined HAVE_X_WINDOWS above and your X include files aren't in a place that your compiler can find on its own, you might want to add "-I/..." or something similar. */ #undef C_SWITCH_X_SITE /* Define STACK_DIRECTION here, but not if m/foo.h did. */ #ifndef STACK_DIRECTION #undef STACK_DIRECTION #endif /* Define the return type of signal handlers if the s-xxx file did not already do so. */ #define RETSIGTYPE void /* SIGTYPE is the macro we actually use. */ #ifndef SIGTYPE #define SIGTYPE RETSIGTYPE #endif #ifdef emacs /* Don't do this for lib-src. */ /* Tell regex.c to use a type compatible with Emacs. */ #define RE_TRANSLATE_TYPE Lisp_Object * #endif /* The rest of the code currently tests the CPP symbol BSTRING. Override any claims made by the system-description files. Note that on some SCO version it is possible to have bcopy and not bcmp. */ #undef BSTRING #if defined (HAVE_BCOPY) && defined (HAVE_BCMP) #define BSTRING #endif /* Non-ANSI C compilers usually don't have volatile. */ #ifndef HAVE_VOLATILE #ifndef __STDC__ #define volatile #endif #endif /* Some of the files of Emacs which are intended for use with other programs assume that if you have a config.h file, you must declare the type of getenv. This declaration shouldn't appear when alloca.s or Makefile.in includes config.h. */ #ifndef NOT_C_CODE extern char *getenv (); #endif #endif /* EMACS_CONFIG_H */ /* These default definitions are good for almost all machines. The exceptions override them in m/*.h. */ #ifndef BITS_PER_CHAR #define BITS_PER_CHAR 8 #endif #ifndef BITS_PER_SHORT #define BITS_PER_SHORT 16 #endif /* Note that lisp.h uses this in a preprocessor conditional, so it would not work to use sizeof. That being so, we do all of them without sizeof, for uniformity's sake. */ #ifndef BITS_PER_INT #define BITS_PER_INT 32 #endif #ifndef BITS_PER_LONG #define BITS_PER_LONG 32 #endif emacs-19.30/nt/emacs.bat.in100444 23073 1 2107 5775065102 14574 0ustar voelkerdaemon REM Here begins emacs.bat.in REM Set OS specific values. set ARCH_SAVE=%PROCESSOR_ARCHITECTURE% set PROCESSOR_ARCHITECTURE= if "%ARCH_SAVE%" == "%PROCESSOR_ARCHITECTURE%" goto win95 set PROCESSOR_ARCHITECTURE=%ARCH_SAVE% set SHELL=cmd goto next :win95 set SHELL=command :next set EMACSLOADPATH=%emacs_dir%\lisp set EMACSDATA=%emacs_dir%\etc set EMACSPATH=%emacs_dir%\bin set EMACSLOCKDIR=%emacs_dir%\lock set INFOPATH=%emacs_dir%\info set EMACSDOC=%emacs_dir%\etc set TERM=CMD REM The variable HOME is used to find the startup file, ~\_emacs. Ideally, REM this will not be set in this file but should already be set before REM this file is invoked. If HOME is not set, use some generic default. set HOME_SAVE=%HOME% set HOME_EXISTS=yes set HOME_DEFAULT=C:\ set HOME= if "%HOME%" == "%HOME_SAVE%" set HOME_EXISTS=no if "%HOME_EXISTS%" == "yes" set HOME=%HOME_SAVE% if "%HOME_EXISTS%" == "no" set HOME=%HOME_DEFAULT% if "%HOME_EXISTS%" == "no" echo HOME is not set! Using %HOME% as a default... %emacs_dir%\bin\emacs.exe %1 %2 %3 %4 %5 %6 %7 %8 %9 emacs-19.30/nt/addpm.c100444 23073 1 7264 6047610302 13640 0ustar voelkerdaemon/* Add entries to the GNU Emacs Program Manager folder. Copyright (C) 1995 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. */ /**************************************************************************** * * Program: addpm (adds emacs to the Windows program manager) * * Usage: * argv[1] = install path for emacs * argv[2] = full path to icon for emacs (optional) */ #include #include #include #include HDDEDATA CALLBACK DdeCallback (UINT uType, UINT uFmt, HCONV hconv, HSZ hsz1, HSZ hsz2, HDDEDATA hdata, DWORD dwData1, DWORD dwData2) { return ((HDDEDATA) NULL); } #define DdeCommand(str) \ DdeClientTransaction (str, strlen (str)+1, HConversation, (HSZ)NULL, \ CF_TEXT, XTYP_EXECUTE, 30000, NULL) #define REG_ROOT "SOFTWARE\\GNU\\Emacs\\" static struct entry { char *name; char *value; } env_vars[] = { {"emacs_path", NULL}, {"EMACSLOADPATH", "%emacs_path%\\lisp"}, {"SHELL", "cmd"}, {"EMACSDATA", "%emacs_path%\\etc"}, {"EMACSPATH", "%emacs_path%\\bin"}, {"EMACSLOCKDIR", "%emacs_path%\\lock"}, {"INFOPATH", "%emacs_path%\\info"}, {"EMACSDOC", "%emacs_path%\\etc"}, {"TERM", "cmd"} }; BOOL add_registry (path) char *path; { HKEY hrootkey = NULL; DWORD dwDisp; int i; BOOL ok = TRUE; /* Check both the current user and the local machine to see if we have any resources. */ if (RegCreateKeyEx (HKEY_LOCAL_MACHINE, REG_ROOT, 0, "", REG_OPTION_NON_VOLATILE, KEY_WRITE, NULL, &hrootkey, &dwDisp) != ERROR_SUCCESS && RegCreateKeyEx (HKEY_CURRENT_USER, REG_ROOT, 0, "", REG_OPTION_NON_VOLATILE, KEY_WRITE, NULL, &hrootkey, &dwDisp) != ERROR_SUCCESS) { return FALSE; } for (i = 0; i < (sizeof (env_vars) / sizeof (env_vars[0])); i++) { char * value = env_vars[i].value ? env_vars[i].value : path; if (RegSetValueEx (hrootkey, env_vars[i].name, 0, REG_EXPAND_SZ, value, lstrlen (value) + 1) != ERROR_SUCCESS) ok = FALSE; } RegCloseKey (hrootkey); return (ok); } int main (argc, argv) int argc; char *argv[]; { DWORD idDde; HCONV HConversation; HSZ ProgMan; char additem[MAX_PATH*2 + 100]; char *lpext; if (argc < 2 || argc > 3) { fprintf (stderr, "usage: addpm emacs_path [icon_path]\n"); exit (1); } lpext = add_registry (argv[1]) ? "exe" : "bat"; DdeInitialize (&idDde, (PFNCALLBACK)DdeCallback, APPCMD_CLIENTONLY, 0); ProgMan = DdeCreateStringHandle (idDde, "PROGMAN", CP_WINANSI); if (HConversation = DdeConnect (idDde, ProgMan, ProgMan, NULL)) { DdeCommand ("[CreateGroup (Gnu Emacs)]"); DdeCommand ("[ReplaceItem (Emacs)]"); sprintf (additem, "[AddItem (%s\\bin\\emacs.%s, Emacs%c%s)]", argv[1], lpext, (argc>2 ? ',' : ' '), (argc>2 ? argv[2] : "")); DdeCommand (additem); DdeDisconnect (HConversation); } DdeFreeStringHandle (idDde, ProgMan); DdeUninitialize (idDde); return (0); } emacs-19.30/nt/ebuild.bat100555 23073 1 32 5761756204 14306 0ustar voelkerdaemonnmake -f makefile.nt all emacs-19.30/nt/fast-install.bat100555 23073 1 43 5761756214 15446 0ustar voelkerdaemonnmake -f makefile.nt fast_install emacs-19.30/nt/install.bat100555 23073 1 36 5761756210 14511 0ustar voelkerdaemonnmake -f makefile.nt install emacs-19.30/nt/paths.h100444 23073 1 3707 5753546502 13712 0ustar voelkerdaemon/* Hey Emacs, this is -*- C -*- code! */ /* Backslashify the default paths for NT */ /* The default search path for Lisp function "load". This sets load-path. */ /* #define PATH_LOADSEARCH "/usr/local/lib/emacs/lisp" */ #define PATH_LOADSEARCH "C:\\emacs\\lisp" /* Like PATH_LOADSEARCH, but used only when Emacs is dumping. This path is usually identical to PATH_LOADSEARCH except that the entry for the directory containing the installed lisp files has been replaced with ../lisp. */ /* #define PATH_DUMPLOADSEARCH "../lisp" */ #define PATH_DUMPLOADSEARCH "..\\..\\..\\lisp" /* The extra search path for programs to invoke. This is appended to whatever the PATH environment variable says to set the Lisp variable exec-path and the first file name in it sets the Lisp variable exec-directory. exec-directory is used for finding executables and other architecture-dependent files. */ /* #define PATH_EXEC "/usr/local/lib/emacs/etc" */ #define PATH_EXEC "C:\\emacs\\bin" /* Where Emacs should look for its architecture-independent data files, like the NEWS file. The lisp variable data-directory is set to this value. */ /* #define PATH_DATA "/usr/local/lib/emacs/data" */ #define PATH_DATA "C:\\emacs\\data" /* Where Emacs should look for its docstring file. The lisp variable doc-directory is set to this value. */ #define PATH_DOC "C:\\emacs\\etc" /* The name of the directory that contains lock files with which we record what files are being modified in Emacs. This directory should be writable by everyone. THE STRING MUST END WITH A SLASH!!! */ /* #define PATH_LOCK "/usr/local/lib/emacs/lock/" */ #define PATH_LOCK "C:\\emacs\\lock\\" /* Where the configuration process believes the info tree lives. The lisp variable configure-info-directory gets its value from this macro, and is then used to set the Info-default-directory-list. */ /* #define PATH_INFO "/usr/local/info" */ #define PATH_INFO "C:\\emacs\\info" emacs-19.30/nt/makefile.def100444 23073 1 11271 6054670603 14665 0ustar voelkerdaemon# # Makefile definition file for building GNU Emacs on Windows NT # # 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. */ # # Geoff Voelker (voelker@cs.washington.edu) 9-6-94 # # BEGIN CONFIGURATION # # Define the following to build the GUI version # NTGUI=1 # Set INSTALL_DIR to be the directory into which you want emacs installed. # !ifndef INSTALL_DIR INSTALL_DIR = C:\emacs !endif # Define MSVCNT11 to be nonzero if you are using the MSVCNT 1.1 environment. # MSVCNT11 = 1 MSVCNT11 = 0 # # END CONFIGURATION # # Check that the INCLUDE and LIB environment variables are set. # !ifndef INCLUDE !error The INCLUDE environment variable needs to be set. !endif !ifndef LIB !error The LIB environment variable needs to be set. !endif # Determine the architecture we're running on. # Define ARCH for our purposes; # Define CPU for use by ntwin32.mak; # Define CONFIG_H to the appropriate config.h for the system; # !ifdef PROCESSOR_ARCHITECTURE # We're on Windows NT CPU = $(PROCESSOR_ARCHITECTURE) CONFIG_H = config.nt OS_TYPE = winnt ! if "$(PROCESSOR_ARCHITECTURE)" == "x86" ARCH = i386 CPU = i386 ! else ! if "$(PROCESSOR_ARCHITECTURE)" == "MIPS" ARCH = mips ! else ! if "$(PROCESSOR_ARCHITECTURE)" == "ALPHA" ARCH = alpha ! else ! if "$(PROCESSOR_ARCHITECTURE)" == "PPC" ARCH = ppc ! else !error Unknown architecture type "$(PROCESSOR_ARCHITECTURE)" ! endif ! endif ! endif ! endif !else # We're on Windows 95 ARCH = i386 CPU = i386 CONFIG_H = config.w95 OS_TYPE = win95 !endif # Include ntwin32.mak. So far, this file seems to be supported by every # Microsoft compiler on NT and Win95 and properly defines the executable # names and libraries necessary to build Emacs. I do not have access # to any other vendor compilers, so I do not know if they supply this # file, too. For now I'll assume that they do. # !include # Using cvtres is necessary on NT 3.10 and doesn't hurt on later platforms. CVTRES = cvtres.exe AR = $(implib) # The assignment $(CC) = $(cc) fails even though variables are case sensitive. LINK_TMP = $(link) LINK = $(LINK_TMP) CC_TMP = $(cc) CC = $(CC_TMP) # advapi32.lib is left off of $(baselibs) on NT 3.10 !if "$(baselibs)" == "kernel32.lib " ADVAPI32 = advapi32.lib !else ADVAPI32 = !endif # Older ntwin32.mak files do not define libc; do it for them. !ifndef libc libc = libc.lib !endif # The base libraries for compiling Emacs on NT. With MSVC, this should # include oldnames.lib. !if $(MSVCNT11) BASE_LIBS = $(libc) $(baselibs) oldnames.lib !else BASE_LIBS = $(libc) $(baselibs) !endif # We want any debugging info in the executable. !if "$(LINK)" == "link32" SYS_LDFLAGS = !else SYS_LDFLAGS = -pdb:none -release -incremental:no !endif INC = -I. CFLAGS_COMMON = -nologo $(INC) $(ARCH_CFLAGS) $(LOCAL_FLAGS) -DWIN32_LEAN_AND_MEAN -D$(ARCH) !if $(MSVCNT11) CFLAGS = $(CFLAGS_COMMON) -D_CRTAPI1=_cdecl !else CFLAGS = $(CFLAGS_COMMON) !endif !ifdef NTGUI CFLAGS = $(CFLAGS) -DHAVE_NTGUI=1 !endif OBJDIR = obj $(OBJDIR):; -mkdir $(OBJDIR) BLD = $(OBJDIR)\$(ARCH) $(BLD): $(OBJDIR) -mkdir $(BLD) CP = copy CP_DIR = xcopy /f/r/i/e/d # This is completely braindamaged, but it's the only routine known to be there DEL_TREE = echo y | rmdir /s # The location of the icon file EMACS_ICON_PATH = ..\nt\emacs.ico # Lets us add icons to the GNU Emacs folder ADDPM = ..\nt\$(BLD)\addpm.exe !if "$(ARCH)" == "i386" ARCH_CFLAGS = -nologo -D_X86_=1 -c -Zel -W2 -H63 -G3d -Zi -Od ARCH_LDFLAGS = -align:0x1000 $(SYS_LDFLAGS) !else !if "$(ARCH)" == "mips" ARCH_CFLAGS = -D_MIPS_=1 -c -W2 -Zi -Od -Gt0 ARCH_LDFLAGS = -align:0x1000 $(SYS_LDFLAGS) !else !if "$(ARCH)" == "alpha" ARCH_CFLAGS = -D_ALPHA_=1 -c -Ze -Zi -W2 -D__stdcall= -D__cdecl= ARCH_LDFLAGS = -align:0x2000 $(SYS_LDFLAGS) !else !if "$(ARCH)" == "ppc" # These flags are a guess...if they don't work, please send me mail. ARCH_CFLAGS = -D_PPC_=1 -c -Ze -Zi -W2 -Od ARCH_LDFLAGS = -align:0x1000 $(SYS_LDFLAGS) !else !ERROR Unknown architecture type "$(ARCH)". !endif !endif !endif !endif emacs-19.30/nt/makefile.nt100444 23073 1 7235 6054670577 14547 0ustar voelkerdaemon# # Top level makefile for building GNU Emacs on Windows NT # # 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. */ # # Geoff Voelker (voelker@cs.washington.edu) 11-20-93 # 9-6-94 !include makefile.def ALL = $(BLD)\addpm.exe .c{$(BLD)}.obj: $(CC) $(CFLAGS) -Fo$@ $< addpm: $(BLD) $(BLD)\addpm.exe $(BLD)\addpm.obj: addpm.c $(BLD)\addpm.exe: $(BLD)\addpm.obj $(LINK) -out:$@ -subsystem:console -entry:mainCRTStartup \ $(SYS_LDFLAGS) $** $(BASE_LIBS) $(ADVAPI32) user32.lib # Since Windows 95 does not support multiple commands on one command line # (e.g., in for loops), we cannot use for loops any more. # SUBDIRS = lib-src src lisp # # Build emacs # BUILD_CMD = $(MAKE) -f makefile.nt all all: $(BLD) $(ALL) cd ..\lib-src $(BUILD_CMD) cd ..\src $(BUILD_CMD) cd ..\lisp $(BUILD_CMD) cd ..\nt emacs.bat: emacs.bat.in echo @echo off > emacs.bat echo REM !!! Warning: This file automatically generated !!! >> emacs.bat echo set emacs_dir=$(INSTALL_DIR)>> emacs.bat type emacs.bat.in >> emacs.bat # # Build and install emacs in INSTALL_DIR # INSTALL_CMD = $(MAKE) -f makefile.nt install install: all emacs.bat - mkdir $(INSTALL_DIR) cd ..\lib-src $(INSTALL_CMD) cd ..\src $(INSTALL_CMD) cd ..\lisp $(INSTALL_CMD) cd ..\nt - $(CP) emacs.bat $(INSTALL_DIR)\bin - $(ADDPM) $(INSTALL_DIR) - del ..\same-dir.tst - del $(INSTALL_DIR)\same-dir.tst echo SameDirTest > $(INSTALL_DIR)\same-dir.tst if not exist ..\same-dir.tst $(MAKE) -f makefile.nt real_install - del ..\same-dir.tst - del $(INSTALL_DIR)\same-dir.tst # # This installs executables from ..\bin into the installation directory # without building anything. # fast_install: - mkdir $(INSTALL_DIR)\data $(CP) ..\lib-src\DOC $(INSTALL_DIR)\etc - mkdir $(INSTALL_DIR)\bin - $(CP) emacs.bat $(INSTALL_DIR)\bin - del ..\same-dir.tst - del $(INSTALL_DIR)\same-dir.tst echo SameDirTest > $(INSTALL_DIR)\same-dir.tst if not exist ..\same-dir.tst $(CP) ..\bin\emacs.exe $(INSTALL_DIR)\bin if not exist ..\same-dir.tst $(CP) ..\bin\etags.exe $(INSTALL_DIR)\bin if not exist ..\same-dir.tst $(CP) ..\bin\ctags.exe $(INSTALL_DIR)\bin if not exist ..\same-dir.tst nmake -f $(MAKE) real_install - del ..\same-dir.tst - del $(INSTALL_DIR)\same-dir.tst real_install: - del ..\same-dir.tst - del $(INSTALL_DIR)\same-dir.tst echo SameDirTest > $(INSTALL_DIR)\same-dir.tst - mkdir $(INSTALL_DIR)\etc - mkdir $(INSTALL_DIR)\info - mkdir $(INSTALL_DIR)\lock - mkdir $(INSTALL_DIR)\data if not exist ..\same-dir.tst $(CP_DIR) ..\etc $(INSTALL_DIR)\etc if not exist ..\same-dir.tst $(CP_DIR) ..\info $(INSTALL_DIR)\info - del ..\same-dir.tst - del $(INSTALL_DIR)\same-dir.tst # # Maintenance # CLEAN_CMD = $(MAKE) -f makefile.nt clean clean:; - del /s *~ *.pdb - $(DEL_TREE) deleted - $(DEL_TREE) obj - $(DEL_TREE) ..\bin - del ..\etc\DOC - del ..\etc\DOC-X - del emacs.bat cd ..\lib-src $(CLEAN_CMD) cd ..\src $(CLEAN_CMD) cd ..\lisp $(CLEAN_CMD) cd ..\nt emacs-19.30/nt/TODO100666 23073 1 2030 6052170525 13073 0ustar voelkerdaemon This is a list of known problems to date with the Windows NT/95 port of GNU Emacs. * Handle wildcards in ls-lisp (e.g., C-x d *.c). * Interactive subprocess output is buffered in jerky * Presently, C:\foo\bar and C:/foo/bar bring up two buffers on the same file. Solve this by adding a switch that canonicalizes path separators (e.g., make them all / or all \)? * call-process-region: Another tricky situation with binary and text modes. An example by dsrosing@reston.ingr.com: use crypt++ to load compressed data into a buffer, edit the buffer, save the data back out. (Also need to propagate the "/C" switch change sent the shell in crypt++.el back to the author.) * Dired uses ls-lisp, which reports all files as being owned by the current user. Need to dig through the security descriptor to extract the owner of the file (and the group?) using LookupAccountSid. * Integrate the build for NT into the GNU config process once a decent shell becomes freely available * Integrate networking. * Fix Win95 subprocesses. emacs-19.30/nt/ChangeLog100666 12120 1 10432 6055517432 13330 0ustar rmsdaemonFri Nov 24 23:44:08 1995 Richard Stallman * Version 19.30 released. Wed Nov 22 13:53:40 1995 Geoff Voelker * makefile.def (CP_DIR): Use platform independent switches for xcopy. * makefile.nt (install, fast_install, real_install, clean): Don't use switches to del not supported by Win95. Tue Nov 7 02:55:14 1995 Kevin Gallo * makefile.nt (addpm.exe): Link with $(ADVAPI32). (install, fast_install): Change same-dir test to create test file in installation tree and thereby support read-only shares. (clean): Remove .pdb files. * makefile.def (NTGUI): New macro. [NTGUI] (CFLAGS): Define HAVE_NTGUI. * config.nt, config.w95: Update to latest src/config.in. * addpm.c (env_vars): New variable. (add_registry): New procedure. (main): Use values of configuration environment variables from the registry if defined, the process environment otherwise. Mon Jun 19 17:32:51 1995 Richard Stallman * Version 19.29 released. * makefile.nt (addpm.exe): Change WinMainCRTStartup to mainCRTStartup. Tue Jun 13 22:20:29 1995 Geoff Voelker * makefile.nt: Define .c to .obj suffix rule. (addpm.obj): Compile directly, use CFLAGS. (addpm.exe): Link from addpm.obj. * makefile.def (MSVCNT11): Defined. (BASE_LIBS) [MSVCNT11]: Use oldnames.lib. (CFLAGS_COMMON): Defined. (CFLAGS) [MSVCNT11]: Define _CRTAPI1 to _cdecl. Fri Jun 9 22:09:46 1995 Geoff Voelker * emacs.bat.in: Renamed from emacs.bat (emacs_dir): Renamed from emacs_path Definition removed. * addpm.c: New file. * makefile.nt (ALL,addpm,addpm.exe,addpm.obj): Defined. (all): Depend upon $(BLD) and $(ALL). (install): Depend upon emacs.bat. Create program item for Emacs. (clean): Delete obj. (emacs.bat): Defined. * makefile.def (EMACS_ICON_PATH,ADDPM): Defined. Sat May 27 22:15:14 1995 Geoff Voelker * ebuild.bat, emacs.bat, fast-install.bat, install.bat: Add carriage returns; necessary for batch files on Win95. Thu May 25 20:57:08 1995 Geoff Voelker * config.w95: Created. * config.h: Changed to config.nt. * makefile.nt (SUBDIRS): Commented out. (all,install,clean): Expand for-loops. (BUILD_CMD,INSTALL_CMD,CLEAN_CMD): Defined. * makefile.def (SYS_LIB_DIR,SYS_INC_DIR): Undefined. (ARCH): New definition. (CPU,CONFIG_H,OS_TYPE): Defined. (INCLUDE,LIB): Checked if valid. (ntwin32.mak): Included. (AR,CC,LINK): New definition. (ADVAPI32,libc,BASE_LIBS): Defined. (SYS_LDFLAGS): New definition. Update comments and preprocessor conditionals. * emacs.bat (SHELL): Conditionally defined. (HOME): Conditionally defined. (emacs_path,HOME): Update comments. Turn off all echo. Tue May 9 01:51:06 1995 Geoff Voelker * _emacs, config.h, ebuild.bat, emacs.bat, emacs.rc, fast-install.bat, install.bat, makefile.def, makefile.nt, paths.h, inc/pwd.h, inc/sys/dir.h, inc/sys/file.h, inc/sys/ioctl.h, inc/sys/param.h: Removed carriage-returns. Sat May 06 23:12:45 1995 Geoff Voelker * makefile.def (CVTRES): Defined. * emacs.ico, emacs.rc: New files by Kevin Gallo. Mon Apr 10 21:23:24 1995 Geoff Voelker * src: Removed. * src\config.h, src\paths.h: Moved to parent dir, src removed. Sun Apr 09 13:23:30 1995 Geoff Voelker * makefile.def (INSTALL_DIR): Changed to generic directory. * emacs.bat: Added arguments when emacs.exe invoked. * ebuild.cmd, emacs.cmd, install.cmd: Changed extension to .bat. Tue Dec 13 17:55:58 1994 voelker * makefile.def (CC): In configuration section. (COMPAT_LIB): Defined. Tue Nov 01 16:31:29 1994 voelker * src/paths.h: New file. * src/config.h: New file. * inc/pwd.h: New file. * inc/sys/dir.h: New file. * inc/sys/file.h: New file. * inc/sys/ioctl.h: New file. * inc/sys/param.h: New file. * todo: New file. * readme: New file. * makefile.nt: New file. * makefile.def: New file. * install.cmd: New file. * install: New file. * fast-install.cmd: New file. * emacs.cmd: New file. * ebuild.cmd: New file. * _emacs: New file. emacs-19.30/nt/INSTALL100444 23073 1 7604 6052167656 13455 0ustar voelkerdaemon Building and Installing Emacs on Windows NT and Windows 95 You need a compiler package to build and install Emacs on NT or Win95. If you don't have one, precompiled versions are available in ftp://ftp.cs.washington.edu/pub/ntemacs/. Configuring: (1) In previous versions, you needed to edit makefile.def to reflect the compiler package that you are using. You should no longer have to do this if you have defined the INCLUDE and LIB environment variables, as is customary for use with Windows compilers. (Unless you are using MSVCNT 1.1, in which case you will need to set MSVCNT11 to be a non-zero value at the top of makefile.def.) (2) Choose the directory into which Emacs will be installed, and edit makefile.def to define INSTALL_DIR to be this directory. (Alternatively, if you have INSTALL_DIR set as an environment variable, the build process will ignore the value in makefile.def and use the value of the environment variable instead.) Note that if it is not installed in the directory in which it is built, the ~16 MB of lisp files will be copied into the installation directory. Also, makefile.def is sometimes unpacked read-only; use > attrib -r makefile.def to make it writable. (3) You may need to edit nt/paths.h to specify some other device instead of `C:'. Building: (4) The target to compile the sources is "all", and is recursive starting one directory up. The makefiles for the NT port are in files named "makefile.nt". To get things started, type in this directory: > nmake -f makefile.nt all or use the ebuild.bat file. When the files are compiled, you will see some warning messages declaring that some functions don't return a value, or that some data conversions will be lossy, etc. You can safely ignore these messages. The warnings may be fixed in the main FSF source at some point, but until then we will just live with them. NOTE: You should not have to edit src\paths.h to get Emacs to run correctly. All of the variables in src\paths.h are configured during start up using the nt\emacs.bat file (which gets installed as bin\emacs.bat -- see below). Installing: (5) Currently, Emacs requires a number of environment variables to be set for it to run correctly. A batch file, emacs.bat, is provided that sets these variables appropriately and then runs the executable (emacs.bat is generated using the definition of INSTALL_DIR in nt\makefile.def and the contents of nt\emacs.bat.in). (6) The install process will install the files necessary to run Emacs in INSTALL_DIR (which may be the directory in which it was built), and create a program manager/folder icon in a folder called GNU Emacs. From this directory, type: > nmake -f makefile.nt install or use the install.bat file. (7) Create the Emacs startup file. Under Unix, this file is .emacs; under NT and Win95, this files is _emacs. (If you would like to use a .emacs file that, for example, you share with a Unix version of Emacs, you can invoke Emacs with the -l option to specify the .emacs file that you would like to load.) Note that Emacs requires the environment variable HOME to be set in order for it to locate the _emacs file. Ideally, HOME should not be set in the emacs.bat file as it will be different for each user. (HOME could be set, for example, in the System panel of the Control Panel). (8) Either click on the icon, or run the emacs.bat file, and away you go. If you would like to resize the command window that Emacs uses, or change the font or colors, click on the program manager icon to start Emacs. Change the settings using the "-" menu in the upper left hand corner of the window, making sure to select the "Save" options in the dialog boxes as you do so. Exit Emacs and restart. emacs-19.30/nt/README100644 23073 1 13444 6052171024 13305 0ustar voelkerdaemon Emacs for Windows NT and Windows 95 This file describes Emacs on Windows NT and Windows 95. Both ports support the base functionality of Emacs as well as the windowing features (colors, fonts, menus, scrollbars). Currently, due to limitations encountered with the Win95 command.com, only the NT port supports subprocesses. For instructions on building and installing Emacs, or obtaining precompiled versions, see the INSTALL file in this directory. This release should run on your system with relatively few bugs. If you do encounter Windows specific problems, please first check the web page to see if the bug has been encountered already. If not, please email me directly with a description of the problem, and please include the version of Emacs and the version and type of the operating system and compiler you are using. Also, if you are interested in testing out trial versions that are less stable but have potentially more functionality, browse ftp://ftp.cs.washington.edu/pub/voelker/ntemacs/trial. A description of the current state of the port, including bugs encountered and workarounds, can be found in http://www.cs.washington.edu/homes/voelker/ntemacs.html. If you do not have direct WWW access, then you can access the WWW using telnet or email: for telnet access, run "telnet telnet.w3.org"; for email access, send email to "agora@mail.w3.org" with "SEND http://www.w3.org/hypertext/WWW/Agora/Help.txt" in the body of the message. For more recent release notes, see the ChangeLog in this directory. Enjoy. -geoff (voelker@cs.washington.edu) - - - - - - - - - - - - - - - - - - - - Old release notes: - - - - - - - - - - - - - - - - - - - - 12.15.94 Merged in 19.28 patches. Fixed myriad small bugs, including: * dired finds directories * random now really is random * directory-file-name handles UNC names * M-C key sequences (and [home] and [end]) now work * C-, M-, and M-C- punctuation keys now work * can change the bell sound using set-message-beep 10.26.94 Now up to 19.27. See nt\ChangeLog for all the gory details. If you've used a previous version, you should look over these changes that were made to the runtime environment for emacs: * For the .emacs file, switched from the emacs.dot convention to the _emacs convention of the MSDOS version to keep things consistent. Simply rename your emacs.dot or .emacs file to _emacs. * Emacs now uses INFOPATH instead of EMACSINFOPATH to find info files. (This change has been reflected in emacs.cmd). * Emacs now relies upon the environment variable TERM to be set; "set TERM=CMD" does the trick. (This change has also been reflected in emacs.cmd). * The system-type lisp variable "Windows-NT" is now "windows-nt" to conform to the existing lower-case convention for this variable. Many thanks to Sridhar Boovaragh and Matt Rhoten for the help in beta testing the software. -geoff 9.6.94 The Emacs port to NT has been upgraded to 19.25 and improved. It now supports: - dumping - binary files in a reasonable way - larger files (~12MB) - case-insensitive completion (actually, it only needed to be enabled) - proper expand-file-name processing (i.e., "c:\foo\d:\baz" does the right thing...can't believe I let that go so long). - adoption of MSDOS convention of using _emacs instead of emacs.dot - plus myriad other small fixes See the nt\install file for latest directions on installing emacs. -geoff 12.10.93 This is a port of Emacs version 19.17 for Microsoft Windows NT. Once the dust settles on the latest version of the main emacs source (19.22 at this writing) and I get more time, this port will be rolled forward. The port has most of the Unix emacs functionality, in particular subprocesses (and, hence, support for the compile, shell, and grep modes, among others --- for dired, though, you need a 32-bit version of ls for now). However, the port is still rough around the edges (the degree of integration with Windows is small as compared with X, for example). If something is very obviously broken, it shouldn't be; let me know immediately. For those people who feel particularly hackish, you can browse through the TODO.NT file and chip away at the remaining things that need to be done (this also serves as the problems file, so if you encounter a problem first look here to see if it's been noted). The vast world of lisp packages is relatively unexplored, for example. If you do fix broken lisp packages, or trace down bugs in the emacs source, send fixes back so that they can be integrated into the main distribution for everyone to use. It would be great to hear about bugs _and_ their fixes, but send the bugs too. Also, the port has been tested only on mips and i386 boxes. It will be interesting to test it out on other architectures. Read the INSTALL.NT file for directions on installing emacs. Regarding disk space requirements, with the mips version the build tree requires ~27 MBytes of disk space; if you install in the same directory, add ~3 MBytes; if you install in another directory, add ~16 MBytes. Enjoy. -geoff (voelker@cs.washington.edu) ----------------------------------------------------------------------- For a brief history, Tim Fleehart did a lot of the hard work porting emacs 18.58 to NT. I upgraded the port to 19.17, changed the memory allocation, added subprocess support, etc. Drew Bliss then did a thorough job improving child process support, signal handling, and keyboard and mouse events. I am sure that I can't credit Tim and Drew enough for all that they have done, and hope they forgive me for leaving anything out. Darach Foskett and John Sichi graciously tested the distribution and provided very helpful feedback. As with any large piece of software, many others have also made contributions, but if I started to list names I would leave someone out. emacs-19.30/etc/ 40777 12120 1 0 6055530744 11574 5ustar rmsdaemonemacs-19.30/etc/e/ 40777 12120 1 0 6055530723 12015 5ustar rmsdaemonemacs-19.30/etc/e/eterm100666 12120 13 2147 5663735374 12730 0ustar rmsuser%!‚éetermPÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿçOÿÿmytÿÿÿÿ< ÿÿ ÿÿÿÿÿÿÿÿ‚ÿÿÿÿÿÿÿÿÞ¯ÿÿÿÿœÿÿÿÿÙÇÐÿÿÿÿã¸ÿÿ¡ÌÕÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ`ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ“†!¦ÿÿd*3ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿMÿÿÿÿÿÿÿÿÅÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ}ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿeterm  [%p1%dA[%p1%dB[%p1%dD[%p1%dC[%i%p1%d;%p2%dH [%i%p1%d;%p2%dr[%p1%dL\E[J[%p1%dM[%p1%dP[%p1%d@7[?47h[?47l8 emacs-19.30/etc/e/eterm.ti100666 12120 13 761 6002702025 13272 0ustar rmsusereterm, lines#24,cols#80, cuu1=\E[A,cud1=\n,cub1=\b,cuf1=\E[C,home=\E[H,cr=\r, cuu=\E[%p1%dA,cud=\E[%p1%dB,cub=\E[%p1%dD,cuf=\E[%p1%dC, cup=\E[%i%p1%d;%p2%dH, ind=\n,csr=\E[%i%p1%d;%p2%dr, il1=\E[L,il=\E[%p1%dL, clear=\E[H\E[J,ed=\\E[J,el=\E[K,el1=\E[1K, dl1=\E[M,dl=\E[%p1%dM,dch1=\E[P,dch=\E[%p1%dP, smir=\E[4h,rmir=\E[4l,ich=\E[%p1%d@,mir, smcup=\E7\E[?47h,rmcup=\E[2J\E[?47l\E8, ht=\t, smso=\E[7m,rmso=\E[m, smul=\E[4m,rmul=\E[m, rev=\E[7m,bold=\E[1m,sgr0=\E[m, bel=^G,xenl,am, emacs-19.30/etc/3B-MAXMEM100666 13437 1 3571 4220366660 13200 0ustar jimbdaemonDate: Mon, 16 Feb 87 15:04:41 EST From: katinsky@gauss.rutgers.edu (David Katinsky) To: rms@prep.ai.mit.edu Subject: 3b2 procedure to raise MAXMEM Below is the procedure I followed to allow enough memory for GnuEmacs to run on my 3b2/400. The end result of this is that a process can snarf up to 2Mb of memory. This can be a bit dangerous on a 2Mb machine, but I tried it and it worked ok. ------------------------------------------------------------------------------- In the simplest case, these are the procedures to reconfigure a 3bx kernel. 1] cd /etc/master.d `ls` shows the files to be: README ctc* hdelog idisk ipc iuart kernel mau mem msg ports* prf sem shm stubs sxt sys xt 2] Edit the file which contains the parameter[s] you wish to change. In the following excerpt from /etc/master.d/kernel the value MAXMEM was raised from 256 to 1024. In V.3.0 and later releases, the parameter in question is MAXUMEM instead of MAXMEM. * * The following entries form the tunable parameter table. * NCALL = 30 NPROC = 60 NTEXT = 58 NCLIST = 188 * maxmem is number of pages (2K) was 256 --dmk MAXMEM = 1024 MAXUP = 25 * hashbuf must be a power of 2 NHBUF = 128 NPBUF = 8 3] cd /boot 4] mkboot -k KERNEL 5] shutdown -i5 -g0 -y This will take the machine down and bring it back up into firmware mode. When you see that the machine has reached this state, type the firmware password (default=mcp). The machine will ask for the name of a program to execute. At this prompt enter /etc/system . The machine should start to boot and display its configuration data. 8701271222 dmk [katinsky@topaz.rutgers.edu] ------------------------------------------------------------------------------- I do not feel that having the default firmware password is a problem... but if you wish to edit it out, feel free. dmk  emacs-19.30/etc/COPYING100666 12120 1 43070 6055530744 12750 0ustar rmsdaemon GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. 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. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. emacs-19.30/etc/AIX.DUMP100666 12120 13 26140 5423443641 12557 0ustar rmsuserThe following text was written by someone at IBM to describe an older version of the code for dumping on AIX. It does NOT apply to the current version of Emacs. It is included in case someone is curious. I (rms) couldn't understand the code, and I can't fully understand this text either. I rewrote the code to use the same basic principles, as far as I understood them, but more cleanly. This rewritten code does not always work. In fact, the basic method seems to be intrinsically flawed. Since then, someone else implemented a different way of dumping on the RS/6000, which does seem to work. None of the following applies to the way Emacs now dumps on the 6000. However, the current method fails to use shared libraries. Anyone who might be interested in trying to resurrect the previous method might still find the following information useful. It seems that the IBM dumping code was simply set up to detect when the dumped data cannot be used, and in that case to act approximately as if CANNOT_DUMP had been defined all along. (This is buried in paragraph 1.) It seems simpler just to define CANNOT_DUMP, since Emacs is not set up to decide at run time whether there is dumping or not, and doing so correctly would be a lot of work. Note that much of the other information, such as the name and format of the dumped data file, has been changed. --rms A different approach has been taken to implement the "dump/load" feature of GNU Emacs for AIX 3.1. Traditionally the unexec function creates a new a.out executable file which contains preloaded Lisp code. Executing the new a.out file (normally called xemacs) provides rapid startup since the standard suite of Lisp code is preloaded as part of the executable file. AIX 3.1 architecture precludes the use of this technique because the dynamic loader cannot guarantee a fixed starting location for the process data section. The loader loads all shared library data BEFORE process data. When a shared library changes its data space, the process initial data section address (_data) will change and all global process variables are automatically relocated to new addresses. This invalidates the "dumped" Emacs executable which has data addresses which are not relocatable and now corrupt. Emacs would fail to execute until rebuilt with the new libraries. To circumvent the dynamic loader feature of AIX 3.1, the dump process has been modified as follows: 1) A new executable file is NOT created. Instead, both pure and impure data are saved by the dump function and automatically reloaded during process initialization. If any of the saved data is unavailable or invalid, loadup.el will be automatically loaded. 2) Pure data is defined as a shared memory segment and attached automatically as read-only data during initialization. This allows the pure data to be a shared resource among all Emacs processes. The shared memory segment size is PURESIZE bytes. If the shared memory segment is unavailable or invalid, a new shared memory segment is created and the impure data save file is destroyed, forcing loadup.el to be reloaded. 3) The ipc key used to create and access Emacs shared memory is SHMKEY and can be overridden by the environment symbol EMACSSHMKEY. Only one ipc key is allowed per system. The environment symbol is provided in case the default ipc key has already been used. 4) Impure data is written to the ../bin/.emacs.data file by the dump function. This file contains the process' impure data at the moment of load completion. During Emacs initialization, the process' data section is expanded and overwritten with the .emacs.data file contents. The following are software notes concerning the GNU Emacs dump function under AIX 3.1: 1) All of the new dump/load code is activated by the #ifdef SHMKEY conditional. 2) The automatic loading of loadup.el does NOT cause the dump function to be performed. Therefore once the pure/impure data is discarded, someone must remake Emacs to create the saved data files. This should only be necessary when Emacs is first installed or whenever AIX is upgraded. 3) Emacs will exit with an error if executed in a non-X environment and the dump function was performed within a X window. Therefore the dump function should always be performed in a non-X environment unless the X environment will ALWAYS be available. 4) Emacs only maintains the lower 24 bits of any data address. The remaining upper 8 bits are reset by the XPNTR macro whenever any Lisp object is referenced. This poses a serious problem because pure data is stored in segment 3 (shared memory) and impure data is stored in segment 2 (data). To reset the upper 8 address bits correctly, XPNTR must guess as to which type of data is represented by the lower 24 address bits. The technique chosen is based upon the fact that pure data offsets in segment 3 range from 0 -> PURESIZE-1, which are relatively small offsets. Impure data offsets in segment 2 are relatively large (> 0x40000) because they must follow all shared library data. Therefore XPNTR adds segment 3 to each data offset which is small (below PURESIZE) and adds segment 2 to all other offsets. This algorithm will remain valid as long as a) pure data size remains relatively small and b) process data is loaded after shared library data. To eliminate this guessing game, Emacs must preserve the 32-bit address and add additional data object overhead for the object type and garbage collection mark bit. 5) The data section written to .emacs.data is divided into three areas as shown below. The file header contains four character pointers which are used during automatic data loading. The file's contents will only be used if the first three addresses match their counterparts in the current process. The fourth address is the new data segment address required to hold all of the preloaded data. .emacs.data file format +---------------------------------------+ \ | address of _data | \ +---------------------------------------+ \ | address of _end | \ +---------------------------------------+ file header | address of initial sbrk(0) | / +---------------------------------------+ / | address of final sbrk(0) | / +---------------------------------------+ / \ \ \ \ all data to be loaded from _data to _end \ \ \ \ +---------------------------------------+ \ \ \ \ all data to be loaded from initial to final sbrk(0) \ \ +---------------------------------------+ Sections two and three contain the preloaded data which is restored at locations _data and initial sbrk(0) respectively. The reason two separate sections are needed is that process initialization allocates data (via malloc) prior to main() being called. Therefore _end is several kbytes lower than the address returned by an initial sbrk(0). This creates a hole in the process data space and malloc will abort if this region is overwritten during the load function. One further complication with the malloc'd space is that it is partially empty and must be "consumed" so that data space malloc'd in the future is not assigned to this region. The malloc function distributed with Emacs anticipates this problem but the AIX 3.1 version does not. Therefore, repeated malloc calls are needed to exhaust this initial malloc space. How do you know when malloc has exhausted its free memroy? You don't! So the code must repeatedly call malloc for each buffer size and detect when a new memory page has been allocated. Once the new memory page is allocated, you can calculate the number of free buffers in that page and request exactly that many more. Future malloc requests will now be added at the top of a new memory page. One final point - the initial sbrk(0) is the value of sbrk(0) after all of the above malloc hacking has been performed. The following Emacs dump/load issues need to be addressed: 1) Loadup.el exits with an error message because the xemacs and emacs-xxx files are not created during the dump function. Loadup.el should be changed to check for the new .emacs.data file. 2) Dump will only support one .emacs.data file for the entire system. This precludes the ability to allow each user to define his/her own "dumped" Emacs. Add an environment symbol to override the default .emacs.data path. 3) An error message "error in init file" is displayed out of startup.el when the dumped Emacs is invoked by a non-root user. Although all of the preloaded Lisp code is present, the important purify-flag has not been set back to Qnil - precluding the loading of any further Lisp code until the flag is manually reset. The problem appears to be an access violation which will go away if the read-write access modes to all of the files are changed to rw-. 4) In general, all file access modes should be changed from rw-r--r-- to rw-rw-rw-. They are currently setup to match standard AIX access modes. 5) The dump function is not invoked when the automatic load of loadup.el is performed. Perhaps the command arguments array should be expanded with "dump" added to force an automatic dump. 6) The automatic initialization function alloc_shm will delete the shared memory segment and .emacs.data file if the "dump" command argument is found in ANY argument position. The dump function will only take place in loadup.el if "dump" is the third or fourth command argument. Change alloc_shm to live by loadup.el rules. emacs-19.30/etc/BABYL100666 12120 13 12236 5405033156 12220 0ustar rmsuserFormat of Version 5 Babyl Files: Warning: This was written Tuesday, 12 April 1983 (by Eugene Ciccarelli), based on looking at a particular Babyl file and recalling various issues. Therefore it is not guaranteed to be complete, but it is a start, and I will try to point the reader to various Babyl functions that will serve to clarify certain format questions. Also note that this file will not contain control-characters, but instead have two-character sequences starting with Uparrow. Unless otherwise stated, an Uparrow is to be read as Control-, e.g. ^L is a Control-L. Versions: First, note that each Babyl file contains in its BABYL OPTIONS section the version for the Babyl file format. In principle, the format can be changed in any way as long as we increment the format version number; then programs can support both old and new formats. In practice, version 5 is the only format version used, and the previous versions have been obsolete for so long that Emacs does not support them. Overall Babyl File Structure: A Babyl file consists of a BABYL OPTIONS section followed by 0 or more message sections. The BABYL OPTIONS section starts with the line "BABYL OPTIONS:". Message sections start with Control-Underscore Control-L Newline. Each section ends with a Control-Underscore. (That is also the first character of the starter for the next section, if any.) Thus, a three message Babyl file looks like: BABYL OPTIONS: ...the stuff within the Babyl Options section... ^_^L ...the stuff within the 1st message section... ^_^L ...the stuff within the 2nd message section... ^_^L ...the stuff within the last message section... ^_ Babyl is tolerant about some whitespace at the end of the file -- the file may end with the final ^_ or it may have some whitespace, e.g. a newline, after it. The BABYL OPTIONS Section: Each Babyl option is specified on one line (thus restricting string values these options can currently have). Values are either numbers or strings. The format is name, colon, and the value, with whitespace after the colon ignored, e.g.: Mail: ~/special-inbox Unrecognized options are ignored. Here are those options and the kind of values currently expected: MAIL Filename, the input mail file for this Babyl file. You may also use several file names separated by commas. Version Number. This should always be 5. Labels String, list of labels, separated by commas. Message Sections: A message section contains one message and information associated with it. The first line is the "status line", which contains a bit (0 or 1 character) saying whether the message has been reformed yet, and a list of the labels attached to this message. Certain labels, called basic labels, are built into Babyl in a fundamental way, and are separated in the status line for convenience of operation. For example, consider the status line: 1, answered,, zval, bug, The 1 means this message has been reformed. This message is labeled "answered", "zval", and "bug". The first, "answered", is a basic label, and the other two are user labels. The basic labels come before the double-comma in the line. Each label is preceded by ", " and followed by ",". (The last basic label is in fact followed by ",,".) If this message had no labels at all, it would look like: 1,, Or, if it had two basic labels, "answered" and "deleted", it would look like: 1, answered, deleted,, zval, bug, The & Label Babyl Message knows which are the basic labels. Currently they are: deleted, unseen, recent, and answered. After the status line comes the original header if any. Following that is the EOOH line, which contains exactly the characters "*** EOOH ***" (which stands for "end of original header"). Note that the original header, if a network format header, includes the trailing newline. And finally, following the EOOH line is the visible message, header and text. For example, here is a complete message section, starting with the message starter, and ending with the terminator: ^_^L 1,, wordab, eccmacs, Date: 11 May 1982 21:40-EDT From: Eugene C. Ciccarelli Subject: notes To: ECC at MIT-AI *** EOOH *** Date: Tuesday, 11 May 1982 21:40-EDT From: Eugene C. Ciccarelli To: ECC Re: notes Remember to pickup check at cashier's office, and deposit it soon. Pay rent. ^_ ;;; Babyl File BNF: ;;; Overall Babyl file structure: Babyl-File ::= Babyl-Options-Section (Message-Section)* ;;; Babyl Options section: Babyl-Options-Section ::= "BABYL OPTIONS:" newline (Babyl-Option)* Terminator Babyl-Option ::= Option-Name ":" Horiz-Whitespace BOptValue newline BOptValue ::= Number | 1-Line-String ;;; Message section: Message-Section ::= Message-Starter Status-Line Orig-Header EOOH-Line Message Terminator Message-Starter ::= "^L" newline Status-Line ::= Bit-Char "," (Basic-Label)* "," (User-Label)* newline Basic-Label ::= Space BLabel-Name "," User-Label ::= Space ULabel-Name "," EOOH-Line ::= "*** EOOH ***" newline Message ::= Visible-Header Message-Text ;;; Utilities: Terminator ::= "^_" Horiz-Whitespace ::= (Space | Tab)* Bit-Char ::= "0" | "1" emacs-19.30/etc/COOKIES100666 13437 13 11560 5405340621 12614 0ustar jimbuser[Someone sent this in from California, and we decided to extend our campaign against information hoarding to recipes as well as software. (Recipes are the closest thing, not involving computers, to software.) The story appears to be a myth, according to the Chicago Tribune, which says that Mrs Fields Cookies hoards the information completely. Therefore, this recipe can be thought of as a compatible replacement. We have reports that the cookies it makes are pretty good.] Someone at PG&E called the Mrs. Fields Cookie office and requested the recipe for her cookies. They asked her for her charge card number, and she gave it to them thinking the cost would be $15 to $25. It turned out to be $200! Therefore, this person is giving the recipe to anyone and everyone she knows (and doesn't know) so that someone can get use of her $200. Anyway, just keep passing it on. Cream together: 2 cups butter 2 cups sugar 2 cups brown sugar Add: 4 eggs 2 tsp. vanilla Mis together in separate bowl: 4 cups flour 5 cups oatmeal (put small amounts of oatmeal in blender until it turns to powder. Measure out 5 cups of oatmeal and only "powderize" that, NOT 5 cups "powderized" oatmeal) 1 tsp salt 2 tsp baking powder 2 tsp baking soda Mix: All of the above Add: 24 oz. bag of chocolate chips and 1 finely grated 8 oz Hershey bar (plain) Add: 3 cups chopped nuts (any kind) Bake on greased cookie sheet (make golf ball sized balls) and bake about two inches apart. Bake at 350 degrees for 8 - 10 minutes. DO NOT OVERBAKE. Makes 112. From: ucdavis!lll-lcc!hplabs!parcvax!bane@ucbvax.berkeley.edu (John R. Bane) Subject: Re: free cookie foundation? Hi! I "stole" your very expensive cookie recipe off the net. If you want to send me your SnailMail address, I'll be glad to send you a dollar (I would like to suggest this to the net, but I think there is some netiquette rule against asking for money - or is that only money for oneself?) to help defray the cost (it's not much, but if EVERYone who took the recipe sent you a dollar, it would help). Here also is another cookie recipe which I'm very fond of. Makes 6-8 dozen Bake at 375 degrees for ~10 min. Cream together: 1 cup shortening (I use Weight Watcher's Reduced Calorie Margarine!) 1/4 cup peanut butter (I recommend the non-sugared kind) 1/2 cup sugar 1/2 cup brown sugar 2 eggs 1 teaspoon vanilla Add: 1/2 cup flour 1 teaspoon soda 1/2 teaspoon salt 2 cups rolled oats (I use the 5-min variety) 1-2 cups chocolate chips (I use 2 cups semi-sweet - ummmm!) 1 cup nuts (I use pecan pieces - don't get them crushed, or the extra oil will make greasy cookies) 1 cup shredded or flaked coconut (The nuts were listed as optional and I added the coconut myself, but I really love them there! You could also add things like m&m's, or raisins (I don't care for raisins in cookies, but you might). I've always wanted to try banana chips.) Mix well. Drop by teaspoonfuls on greased cookie sheet (I use pam). Bake at 375 degrees for approx. 10 min. My aunt found this recipe in an Amish book called something like "Eating Well When The Whole World Is Starving," and although I thought a cookie recipe was a bit odd for a book like that, they are about the healthiest a cookie is ever likely to get. They are also very easy to make (no blending, sifting, rolling, etc.) and extremely delicious. I get rave reviews and recipe requests whenever I make them. - rene Chocolate Chip Cookies - Glamorous, crunchy, rich with chocolate bits & nuts. Also known as "Toll House" Cookies ... from Kenneth and Ruth Wakefield's charming New England Toll House on the outskirts of Whitman, Massachusetts. These cookies were first introduced to American homemakers in 1939 through our series of radio talks on "Famous Foods From Famous Eating Places." Mix Thoroughly : 2/3 cup soft shortening ( part butter ) 1/2 cup granulated sugar 1/2 cup brown sugar ( packed ) 1 egg 1 tsp vanilla Sift together and stir in : 1-1/2 cups sifted flour (*) 1/2 tsp soda 1/2 tsp salt Stir in : 1/2 cup cut-up nuts 6 oz package of semi-sweet chocolate pieces ( about 1-1/4 cups ) (*) for a softer, more rounded cookie, use 1-3/4 cups sifted flour. Drop rounded teaspoonfuls about 2" apart on ungreased baking sheet. Bake until delicately browned ... cookies should still be soft. Cool slightly before you remove them from the baking sheet. Temperature: 375 F. ( modern oven ) Time: bake 8 - 10 minutes Amount: 4 - 5 dozen 2" cookies ===== Personal comments : I find it tastes better with a mixture of shortening and butter, as they say. You don't need << all >> of that sugar, and it can be whatever color you want. The nuts are optional. Feel free to play with the recipe. I put oatmeal in it, reducing flour accordingly, and sometimes cinnamon. I also find it useful to grease the cookie sheets. I think I'm going to go bake some now ... -- richard emacs-19.30/etc/ChangeLog100666 12120 13 72165 6055517234 13233 0ustar rmsuserFri Nov 24 23:41:58 1995 Richard Stallman * Version 19.30 released. Sat Nov 4 02:04:53 1995 Lars Magne Ingebrigtsen * gnus-tut.txt: New file. Wed Jul 26 16:59:25 1995 David J. MacKenzie * Rename termcap to termcap.src, the historical name for an uninstalled termcap file. Wed Jun 28 17:40:46 1995 Eric S. Raymond * termcap.dat, termcap.ucb: deleted and replaced. * termcap: New termcap file from the ncurses project; bigger, better, brighter, does away with waxy yellow buildup. Email me at terminfo@ccil.org if you have any trouble with this. * README: Changed to track above change. Wed May 24 16:12:15 1995 Karl Heuer * TUTORIAL: Delete reference to ALT. Change to . Wed Apr 26 16:58:34 1995 Karl Heuer * Makefile (maintainer-clean): Renamed from realclean. Sun Apr 9 00:00:22 1995 Richard Stallman * tpu-doc.el: File moved to etc dir and renamed. Fri Apr 7 14:32:56 1995 Boris Goldowsky * enriched.doc: Rewritten and simplified. Sun Nov 20 16:09:31 1994 Richard Stallman * Makefile (eterm): New rule. (TIC): New variable. * e/eterm, e/eterm.ti: New files. Mon Oct 24 09:59:13 1994 Boris Goldowsky * enriched.doc: New file. Wed Sep 7 03:53:50 1994 Richard Stallman * Version 19.26 released. Sun Jul 3 15:30:51 1994 Richard Stallman (rms@gnu.ai.mit.edu) * TUTORIAL: Talk about flow control along with C-x C-s and C-s. Mon May 30 04:33:36 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.25 released. Mon May 23 03:32:01 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.24 released. Mon May 16 03:25:22 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.23 released. Thu Apr 21 00:53:20 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Makefile (clean): Delete DOC*. Sat Nov 27 04:42:36 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.22 released. Tue Nov 16 06:14:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.21 released. Thu Nov 11 12:55:39 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.20 released. Sat Aug 14 00:23:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.19 released. Sun Aug 8 01:15:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.18 released. Tue Jul 6 11:05:14 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.16 released. Sat Jun 19 17:14:27 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * version 19.15 released. Thu Jun 17 19:29:56 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.14 released. Wed Jun 16 11:55:03 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) Bring mumbleclean targets into conformance with GNU coding standards. * Makefile (distclean): Don't remove backup and autosave files. These are easy to get rid of in other ways, and a pain to lose. (mostlyclean, realclean): New targets. Tue Jun 8 08:27:09 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.13 released. Sun May 30 00:15:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.10 released. Thu May 27 02:35:32 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.9 released. Mon May 24 12:14:41 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.8 released. Sat May 22 19:37:01 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) * Version 19.7 released. Wed May 19 20:59:36 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * MACHINES: Mention Linux. Mon Apr 26 19:17:21 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * MACHINES: Add section for NeXT, from Thorsten Ohl. Wed Apr 28 13:29:12 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * NEWS: Documented picture-mode improvements. Sun Apr 25 02:52:40 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * NEWS: Described the new properties of arrow keys and next-line-add-newlines. Fixed up the GUD description, it was out of date. This file referenced LNEWS when it should have said news.texi; fixed. news.texi: invocation-name now exists. Sat Mar 27 00:00:16 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * MORE.STUFF: Added. Mon Mar 22 17:21:11 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * NEWS: Preserved jimb's last change (documenting kill on read-only buffers). Added documentation on new info features. Mon Mar 22 05:51:55 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * spook.lines: Alpha-sorted this, and added some new hot buttons for the 1990s. Fri Mar 19 22:56:22 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * MACHINES: Deleted some VMS caveats. If the src and lisp ChangeLogs are correct, dired and mail and process control are now fully supported. * NEWS: Added finder news. Fri Mar 19 21:12:13 1993 Richard Stallman (rms@geech.gnu.ai.mit.edu) * NEWS: Changed. Fri Mar 19 21:03:48 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * sex.6: Added 900-line support * NEWS: Added news about the package finder. Fri Mar 19 02:16:28 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * MACHINES: `Last updated 10 Feb 1992.' was obviously wrong, so I nuked it. Let the file mod date serve. Merged in APOLLO and SUNBUG files. Changed references to 18.* to past tense. * emacs.names: merged into JOKES. I faked a mail header from the Unknown User to delimit the first (unheaded) bit. * Makefile (relock, unlock): New productions. Thu Mar 18 18:33:42 1993 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) Augean-stable cleaning time. Partly to save space, but mostly to reduce the dizzying amount of *stuff* confronting someone exploring the Emacs distribution, I have the following changes in the etc directory: * CHARACTERS: merged into TO-DO file under the heading "Long Range:" * DIFF, CCADIFF and GOSDIFF: merged into a new outline file titled OTHER.EMACSES. The present names don't really convey anything. Various key bindings and feature descriptions have been updated. * NICKLES.WORTH. Nuked. This is copyrighted material that could land FSF in hot water. * INTERVAL.IDEAS: Nuked. RMS's thinking, and indeed the implementation of intervals, have progressed way beyond this. * RCP: Nuked. It no longer said anything but "Ooops, sorry!" * ED.WORSHIP, GNU.JOKES: merged into a mailbox called JOKES. Future jokes can accumulate there. * DISTRIB: the actual domestic order form is now ORDERS.USA. The DISTRIB text now mentions 19. * ORDERS.USA: created. This is just the order form. DISTRIB has a pointer to it at the beginning. * EUROPE: renamed to ORDERS.EUROPE. DISTRIB now has a pointer to it at the beginning. * OOOONEWS, OOOONEWS: Nuked. It's version 19 --- nobody needs the version 15 and 17 files anymore. All files marked "Nuked" have actually been moved to =-prefixed names as per convention. Originals of all files merged still exist with =-names. Wed Mar 17 18:14:56 1993 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * XENIX: nuked (moved to =XENIX). The hackery it describes is no longer necessary in the presence of 19's function-key-map feature; I've added an explanation to the beginning of the file. Wed Mar 10 23:00:51 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * MACHINES: Update description of SYSVr3 and r4 support, due to Eric Raymond's changes. Tue Mar 9 10:57:57 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * MACHINES: Mention that you have to edit the configure script when you add support for a new machine, to get it to recognize the configuration name. Fri Nov 20 06:25:30 1992 Jim Blandy (jimb@totoro.cs.oberlin.edu) * MACHINES: Converted to use GCC-style configuration names, instead of listing m/*.h and s/*.h files. All knowledge of m/ and s/ files now lives in ../configure. Tue Oct 6 17:27:33 1992 Roland McGrath (roland@churchy.gnu.ai.mit.edu) * NEWS: Document included tags tables. Wed Jul 22 19:29:49 1992 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * Corrected the news about VC to reflect reality. Fri Jul 17 16:04:32 1992 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * etags.1: New file, from Richard K. Pixley at Cygnus. Wed Jun 24 18:00:06 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Makefile: Most of the contents of this file were only relevant to things in `../lib-src'; removed all but the `distclean' and `clean' targets. Tue Apr 14 17:59:46 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * COPYING: Got June 1991 version of the GPL here. * ChangeLog: Since the old etc contents have been split into etc and lib-src, the old etc's ChangeLog has been duplicated in the new etc and lib-src. That means that each contains complete and coherent information, although each contains extraneous information. Wed Apr 8 00:54:55 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * lib-src/etags.c: "--no-warning" option renamed to "--no-warn", to be consistent with other GNU programs, like makeinfo. * lib-src/Makefile: Renamed to Makefile.in; the configure script will edit this to produce Makefile. Tue Apr 7 02:39:25 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * etags.c (print_help, print_version): New functions. (main): Options added to support them. * etags.c (longopts): New array of long names for the options. (main): Recognize them. Mon Apr 6 22:29:38 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * etags.c (C_entries): Removed comment saying that \" in a string isn't recognized as magic, because it is correctly handled. * getopt.c, getopt.h: New files, from GNU C library. * etags.c: Rewritten to use getopt. #include "getopt.h". (file_num): Variable deleted; its role is now played by getopt's optind. (main): Argument processing loop rewritten to call getopt to get next option. Options which take parameters (-o and -i) rewritten to get parameter from optarg instead of argv[1]. Filename preprocessing loop and update command changed similarly. * Makefile (etags, ctags): Depend on and link with getopt.h, getopt.o, and getopt1.o. (getopt.o, getopt1.o): New targets for the GNU getopt routines. * etags.c (outfflag): Variable deleted; it is non-zero iff outfile is non-zero. (main): In the argument processing loop, the 'goto next_arg' statements are breaking out of the switch statement in exactly the same way that a simple 'break' statement would; replace the gotos with breaks, and remove the label. Mon Apr 6 17:29:21 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * etags.c (C_entries): Clear tydef and next_token_is_func at start. (consider_token): Move next_token_is_func to global. Thu Apr 2 02:03:48 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * Makefile: Conform with GNU coding standards: (mostlyclean): New target, synonymous with clean. (TAGS, check): New targets. (INSTALL, INSTALLFLAGS): New variables. Tue Mar 31 10:30:56 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * lib-src/Makefile, etc/MACHINES, etc/NEWS: Changed references to `config.emacs' to `configure'. * lib-src/Makefile: Adjusted for renaming of share-lib to etc. * etc/MACHINES: Same. Mon Mar 30 21:34:42 1992 Jim Blandy (jimb@pogo.cs.oberlin.edu) * movemail.c (main): Allow tempname to be as long as necessary, instead of limiting it to 39 characters. * movemail.c (main): Move declaration of buf from top of function to local block surrounding the copy loop. This makes it less likely to be confused with the buf used by the code which checks the permissions on outname's directory. Fri Mar 20 08:58:40 1992 Jim Kingdon (kingdon@albert.gnu.ai.mit.edu) * SERVICE: Remove my entry. Mon Mar 9 12:24:19 1992 David J. MacKenzie (djm@nutrimat.gnu.ai.mit.edu) * Makefile (emacstool, nemacstool, xvetool): Use ${CFLAGS}, not hardcoded -g. * movemail.c (xmalloc): Return char *, not int. (main) [!MAIL_USE_FLOCK]: Add a new conditional, MAIL_UNLINK_SPOOL, that is off by default -- normally don't unlink the mail spool file, just empty it. Pass creat mode 0600, not 0666. Fri Feb 7 16:28:01 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * Makefile (../arch-lib): Depend on ${EXECUTABLES}. (all): Instead of here. (install): Don't use the -s option, since people need symbols to debug code. Sun Jan 19 11:29:00 1992 (Eric Youngdale at youngdale@v6550c.nrl.navy.mil) * etags-vmslib.c (fn_exp): Add type cast. Sat Jan 18 17:46:03 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) * movemail.c: Changes in comments. Mon Jan 13 01:41:23 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * Makefile: Make the distclean target erase the DOC files from ../share-lib and the executables from ../arch-lib. Thu Jan 9 01:37:24 1992 Jim Blandy (jimb at pogo.cs.oberlin.edu) * emacsclient.c: #include (main): Do declare statbfr. Sat Dec 21 01:35:24 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * emacsserver.c, emacsclient.c [BSD]: Use either /tmp or ~ for the socket, depending on SERVER_HOME_DIR. If using /tmp, put host name in the socket name. * movemail.c (pfatal_and_delete): New function. (main, popmail): Use it. (popmail): Close output before deleting messages. Check for error on close and on fsync. Use `fatal' where appropriate. (main): Remove (void). * aixcc.lex: New file. Not officially part of Emacs. * Makefile: Rules for that. Wed Dec 4 15:16:22 1991 Jim Blandy (jimb at pogo.gnu.ai.mit.edu) * yow.c (main): Rename all references to PATH_EXEC to PATH_DATA. * etags.c (main): Properly cast call to alloca that initializes included_files. Sat Aug 17 21:33:34 1991 Roland McGrath (roland@geech.gnu.ai.mit.edu) * etags.c (files_are_tag_tables): Remove global var. (process_file): Don't test it. Also remove hack checking for a file named "TAGS". (main): -i now takes an arg which is the name of a file to include. Collect these names and emit include tags for them after processing all the argument files. Tue Jul 30 17:03:41 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * wakeup.c: Terminate if parent goes away. Thu Jul 18 18:09:51 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * etags.c (C_entries): Process token before handling end of line. When inner loops reach end of line, just back up. Let the real end of line processing happen in just one place. (consider_token): Likewise. Thu Apr 11 14:35:34 1991 Jim Blandy (jimb at geech.gnu.ai.mit.edu) * etags.c (TEX_mode): Skip comments while scanning the text to see which escape character this file uses. Fri Mar 29 19:00:10 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu) * emacsserver.c [USG]: Terminate if msgrcv fails. Sun Mar 3 22:05:52 1991 Richard Stallman (rms at mole.ai.mit.edu) * emacsserver.c [BSD]: Check for errors on stdin after scanf. Fri Jan 25 22:37:29 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * make-docfile: Find the arguments to a C function correctly, by not ignoring the character that read_c_string returns. Don't even try to find argument names for functions that take MANY or UNEVALLED arguments, since they're a figment of the docstring's imagination. Mon Jan 14 18:47:17 1991 Jim Blandy (jimb at churchy.ai.mit.edu) * make-docfile: Read the .elc files generated by the new byte compiler. Mon Dec 31 17:51:53 1990 Richard Stallman (rms at mole.ai.mit.edu) * refcard.tex: Use cm fonts, not am, in multi-column mode. Thu Nov 29 17:34:14 1990 Richard Stallman (rms at mole.ai.mit.edu) * movemail.c (mbx_delimit_begin): Put space before `unseen'. Tue Nov 27 17:50:37 1990 Richard Stallman (rms at mole.ai.mit.edu) * Makefile (install*): No need to install wakeup. Mon Nov 26 20:31:47 1990 Richard Stallman (rms at mole.ai.mit.edu) * Makefile (install*): Install emacsclient like etags. Tue Nov 13 00:01:54 1990 Richard Stallman (rms at mole.ai.mit.edu) * movemail.c (error): Handle 3 args. (main): Don't check input access if using pop. Tue Oct 16 14:04:05 1990 Richard Stallman (rms at mole.ai.mit.edu) * etags.c (find_entries): Check for numbers after Scheme suffix. Sun Oct 14 18:46:21 1990 Richard Stallman (rms at mole.ai.mit.edu) * termcap.dat (vt200-80): Fix ke and ks to frob flag 1. Tue Oct 9 15:22:16 1990 Richard Stallman (rms at mole.ai.mit.edu) * Makefile (nemacstool, xvetool): New targets. Wed Sep 26 18:43:44 1990 Richard Stallman (rms at mole.ai.mit.edu) * emacsclient.c: Include errno.h and define related variables. Sun Sep 23 02:22:44 1990 Richard Stallman (rms at mole.ai.mit.edu) * emacsclient.c: Change usage message. Thu Aug 30 06:17:53 1990 David Lawrence (tale at pogo.ai.mit.edu) * emacs.1: Add break before -nw option. Sun Aug 19 19:07:48 1990 David J. MacKenzie (djm at apple-gunkies) * qsort.c: Replace with GNU version. Tue Aug 14 23:47:28 1990 David J. MacKenzie (djm at apple-gunkies) * wakeup.c: New program replacing loadst.c. Tue Aug 14 21:34:50 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacsclient.c [USG]: Pass msgsnd only 4 args. Thu Aug 9 10:36:18 1990 David J. MacKenzie (djm at pogo.ai.mit.edu) * etags.c: Rename `flag' variables for what they do instead of which option character sets them. Mon May 28 21:54:59 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * loadst.c (main): Conditional to get load average on Apollo. Tue May 22 12:51:56 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * emacsserver.c: Set the permission on the socket to 0600. Tue Mar 27 20:09:49 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacsclient.c [BSD]: Print clean message for failing getwd. Tue Mar 20 19:53:07 1990 David Lawrence (tale at pogo.ai.mit.edu) * getdate.y: Use the getdate.y from GNU tar for timer. Sun Mar 18 12:03:44 1990 Jim Kingdon (kingdon at pogo.ai.mit.edu) * emacsclient.c (main): Don't put brackets around "filename" in usage message. It isn't optional. Wed Mar 14 15:23:26 1990 Joseph Arceneaux (jla at churchy.ai.mit.edu) * etags.c (getit): Recognize '$' as beginning identifiers. Thu Feb 22 05:36:36 1990 David Lawrence (tale at pogo.ai.mit.edu) * emacsserver.c: Renamed from server.c. * Makefile: Reference emacsserver rather than server. * MACHINES: Doc fix for new emacsserver name. Thu Jan 25 22:14:15 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacsclient.c: Print program name in error messages. Fri Jan 19 22:55:07 1990 David Lawrence (tale at cocoa-puffs) * timer.c, getdate.y (new files) and Makefile: Sub-process support for run-at-time in timer.el. Doesn't yet work correctly for USG. Wed Jan 10 21:58:18 1990 Jim Kingdon (kingdon at pogo) * MACHINES: Add HP 300 running BSD. Tue Jan 2 12:15:41 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * yow.c: Dynamically allocate buffer; skip header before random choice to avoid bias toward first item. Sun Dec 24 23:54:28 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (readline): Separate out init of `pend'. Sun Dec 17 14:28:23 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: Undo changes relating to isgoodhdr. Sat Dec 16 15:31:34 1989 Mosur Mohan (rms at sugar-bombs.ai.mit.edu) * etags.c (isgoodhdr): New macro. (_gdh, notgdh): New variable used by that. (init): Initialize _gdh. (find_entries): Set header_file. (consider_token): Use isgoodhdr if in header file. * etags.c (total_size_of_entries): Was miscalculating by 1 in rewritten case. * etags.c (PAS_funcs): One arg to pfnote was missing. Tue Dec 5 14:10:36 1989 Joseph Arceneaux (jla at spiff) * MACHINES: Change for the ULTRIX entry. Tue Nov 21 10:33:43 1989 Joseph Arceneaux (jla at spiff) * etags.c (process_file): If file is not regular, return. Mon Nov 6 03:05:31 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * loadst.c (main): Handle FIXUP_KERNEL_SYMBOL_ADDR. Mon Oct 30 01:49:21 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * loadst.c (load_average): If HAVE_GETLOADAVG, use getloadavg. (main): If HAVE_GETLOADAVG, don't call `nlist'. Wed Oct 25 01:12:02 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (consider_token): Allow any number of typespec keywords after `typedef', before new type name. (enum sym_type): Add st_C_typespec. (C_create_stab): Put typespec kwds in table. Sun Aug 27 13:39:02 1989 Richard Stallman (rms at apple-gunkies.ai.mit.edu) * etags.c (main): Don't depend on name invoked by. If CTAGS is not defined, assume it is ETAGS. Mon Jul 31 02:08:58 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (L_funcs): Allow package name in define construct, as in (foo::defmumble name-defined ...). Sun Jul 30 20:55:13 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (find_entries): Stupid bug testing for C filename suffixes. * Makefile (yow): Depends on ../src/paths.h. Tue Jul 4 15:24:23 1989 Richard Stallman (rms at apple-gunkies.ai.mit.edu) * etags.c: Fix compilation by moving Pascal after Fortran. Thu Jun 15 12:52:48 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c [USG]: Define F_OK, etc., if not found in header. Sat May 27 00:24:28 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * hexl.c: New file, supports hexl-mode. Sun May 14 18:52:58 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c: New compilation flag MAIL_USE_MMDF. Mon May 8 17:10:28 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacsclient.c: Use BSD code whenever HAVE_SOCKETS. * server.c: Likewise. * make-docfile.c (scan_c_file): Output argument names at end of string. (write_c_args): New subroutine. Thu Apr 27 23:54:04 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c: Report failure of flock. Wed Apr 19 23:57:21 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (find_entries): Allow multi-letter extensions for fortran. Tue Apr 18 21:23:15 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * loadst.c: on bsd4.3, use gettimeofday instead of CPUSTATES. Wed Mar 15 23:23:33 1989 Jeff Peck (rms at sugar-bombs.ai.mit.edu) * emacstool.c: setenv IN_EMACSTOOL=t, TERM=sun, TERMCAP=. * emacsstool.1: update to document environment variables. Tue Feb 21 12:58:08 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (PAS_funcs): New function by Mosur Mohan. * movemail.c: On sysv, include unistd.h. Sat Feb 18 08:26:27 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * b2m.c: New file. Wed Feb 15 10:17:27 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: Prolog support from Sunichirou Sugou Fri Feb 3 18:37:04 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * Makefile (clean): New target. Wed Jan 25 01:54:13 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fakemail.c (put_line): Break header lines at 79 cols. Thu Jan 19 21:38:34 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: Greatly rewritten by Sam Kendall for C++ support and for multiple tags per line. Tue Jan 3 13:29:46 1989 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c: Check access before doing real work. Check that outfile is in a writable directory. On fatal error, delete the lock file. Sat Dec 31 17:46:29 1988 Richard Mlynarik (mly at rice-chex.ai.mit.edu) * env.c: Add decl for my-index * etags.c (file-entries): .oak => scheme Fri Dec 30 16:37:27 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c: Use `access' to check input and output files. Wed Dec 28 02:31:00 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacsclient.c (main): Ignore all of CWD before first slash. Tue Dec 27 23:11:46 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (readline): Double linebuffer->size outside the xrealloc. Thu Dec 22 21:51:55 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * server.c, emacsclient.c: Don't try to use gid_t; it isn't defined. * server.c: chmod the socket to 0700. Fri Dec 9 12:01:25 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * fakemail.c (main): Let env var FAKEMAILER override pgm to run. (add_field): Delete comments and turn `<', `>' to spaces in header lines. (USE_FAKEMAIL): New customization macro says to make fakemail not be a no-op even on a BSD system. Thu Dec 1 23:37:16 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c (consider_token): Skip comments just like whitespace. Notice `struct', etc. and set strtag for those tokens. Return 1 for the token following `struct' if an open-brace follows it. (C_entries): Special handling of token following `struct' needed because we have probably advanced to the following line to find the `{'. (main): New option `T' sets tflag and strflag. Set both of them by default if eflags. Wed Nov 30 15:21:13 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c: Do fsync before closing output. Tue Nov 29 09:59:54 1988 Richard Mlynarik (mly at pickled-brain.ai.mit.edu) * movemail.c: Better error message when can't create tempname. This file needs a great deal of extra error-checking and lucid reporting... Wed Nov 16 22:03:15 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: Support assembler code for .s and .a files. (getit): Allow underscore in a tag. Tue Nov 15 10:00:21 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * movemail.c: Close output and check errors before deleting input. Sat Oct 1 17:34:46 1988 Richard Stallman (rms at apple-gunkies.ai.mit.edu) * emacsclient.c [SYSVIPC]: Compute cwd only once; decide properly whether to prefix it. Handle line number args. Sat Sep 24 00:23:49 1988 Richard Stallman (rms at gluteus.ai.mit.edu) * etags.c (main): default setting of eflag was backwards. Fri Sep 23 17:05:34 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: New option -i. -f renamed -o. `-' as input file means read input file names from stdin. -i spec'd or input file named TAGS means the input file is another tag table; output an "include" line for it. Mon Sep 19 17:52:09 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * Makefile: New vars DESTDIR, BINDIR, LIBDIR, MANDIR, MANEXT. New targets install, install.sysv, install.xenix. This makefile is now responsible for installing executables and documentation from this directory into system directories. Fri Sep 16 01:03:55 1988 Richard Stallman (rms at corn-chex.ai.mit.edu) * server.c, emacsclient.c (main): Compute socket name from euid. Thu Aug 4 19:42:45 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * emacsclient.c: Args like +DIGITS are passed through unchanged. Tue Jul 12 22:08:00 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * server.c: If both BSD and HAVE_SYSVIPC, use the latter. * emacsclient.c: Likewise. In the HAVE_SYSVIPC alternative, if BSD, use getwd instead of getcwd. Thu Jun 23 08:40:53 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: Handle `typedef struct foo {' (price@mcc.com). (istoken) New string-comparison macro. (consider_token): New arg `level'. New state `tag_ok' in `tydef'. Tue Jun 14 04:25:58 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * etags.c: Changes for VMS. Always define ETAGS on VMS. Define macros GOOD and BAD for success and failure exit codes. (begtk, intk): Allow `$' in identifiers (main): Don't support -B, -F or -u on VMS. Alternate loop for scanning filename arguments. (system): Delete definition of this function. * etags-vmslib.c (system): Undefine this; VMS now provides it. Wed Jun 8 08:18:21 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) * loadst.c: Prevent multiple-def errors on BSD and BSD4_3 around include of param.h. (Like fns.c.) Mon May 16 01:06:26 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * loadst.c (load_average): Move load-average code to this new fn. Add conditionals to compute load ave on UMAX. Sat May 14 01:24:53 1988 Richard Stallman (rms at lucky-charms.ai.mit.edu) * loadst.c: Change DK_HEADER_FILE to DKSTAT_HEADER_FILE with opposite sense. Fri May 13 18:09:39 1988 Chris Hanson (cph at kleph) * emacsclient.c: Delete references to unused variable `out'. This caused a bus error when used under hp-ux. Fri May 6 10:42:31 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * loadst.c: Control dk.h conditional with DK_HEADER_FILE. Wed May 4 16:08:43 1988 Richard Stallman (rms at rice-krispies.ai.mit.edu) * etags.c (find_entries): `.t' or `.sch' means scheme code. Fri Apr 29 00:22:26 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * loadst.c: Add BSD4_3 conditional for file dk.h instead of dkstat.h. Thu Apr 28 08:55:46 1988 Richard Stallman (rms at frosted-flakes.ai.mit.edu) * movemail.c: #undef close, since config can #define it on V.3. * emacsclient.c, fakemail.c, loadst.c, server.c: likewise. Tue Apr 26 07:33:01 1988 Richard Stallman (rms at lucky-charms.ai.mit.edu) * etags.c (TEX_mode, etc.): Remove superfluous backslashes from invalid escape sequences such as `\{'. * loadst.c: Add `sequent' conditional for file dk.h. Sun Mar 20 13:17:13 1988 Richard M. Stallman (rms at wilson) * server.c [not BSD and not HAVE_SYSVIPC]: fix error message. * loadst.c (main) [XENIX]: use /usr/spool/mail, not /usr/mail. emacs-19.30/etc/DEBUG100666 12120 13 12733 5771071672 12232 0ustar rmsuserDebugging GNU Emacs Copyright (c) 1985 Richard M. Stallman. Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the copyright notice and permission notice are preserved, and that the distributor grants the recipient permission for further redistribution as permitted by this notice. Permission is granted to distribute modified versions of this document, or of portions of it, under the above conditions, provided also that they carry prominent notices stating who last changed them. On 4.2 you will probably find that dbx does not work for debugging GNU Emacs. For one thing, dbx does not keep the inferior process's terminal modes separate from its own. For another, dbx does not put the inferior in a separate process group, which makes trouble when an inferior uses interrupt input, which GNU Emacs must do on 4.2. dbx has also been observed to have other problems, such as getting incorrect values for register variables in stack frames other than the innermost one. The Emacs distribution now contains GDB, the new source-level debugger for the GNU system. GDB works for debugging Emacs. GDB currently runs on vaxes under 4.2 and on Sun 2 and Sun 3 systems. ** Some useful techniques `Fsignal' is a very useful place to stop in. All Lisp errors go through there. It is useful, when debugging, to have a guaranteed way to return to the debugger at any time. If you are using interrupt-driven input, which is the default, then Emacs is using RAW mode and the only way you can do it is to store the code for some character into the variable stop_character: set stop_character = 29 makes Control-] (decimal code 29) the stop character. Typing Control-] will cause immediate stop. You cannot use the set command until the inferior process has been started. Put a breakpoint early in `main', or suspend the Emacs, to get an opportunity to do the set command. If you are using cbreak input (see the Lisp function set-input-mode), then typing Control-g will cause a SIGINT, which will return control to the debugger immediately unless you have done ignore 3 (in dbx) or handle 3 nostop noprint (in gdb) You will note that most of GNU Emacs is written to avoid declaring a local variable in an inner block, even in cases where using one would be the cleanest thing to do. This is because dbx cannot access any of the variables in a function which has even one variable defined in an inner block. A few functions in GNU Emacs do have variables in inner blocks, only because I wrote them before realizing that dbx had this problem and never rewrote them to avoid it. I believe that GDB does not have such a problem. ** Examining Lisp object values. When you have a live process to debug, and it has not encountered a fatal error, you can use the GDB command `pr'. First print the value in the ordinary way, with the `p' command. Then type `pr' with no arguments. This calls a subroutine which uses the Lisp printer. If you can't use this command, either because the process can't run a subroutine or because the data is invalid, you can fall back on lower-level commands. Use the `xtype' command to print out the data type of the last data value. Once you know the data type, use the command that corresponds to that type. Here are these commands: xint xptr xwindow xmarker xoverlay xmiscfree xintfwd xboolfwd xobjfwd xbufobjfwd xkbobjfwd xbuflocal xbuffer xsymbol xstring xvector xframe xwinconfig xcompiled xcons xcar xcdr xsubr xprocess xfloat xscrollbar Each one of them applies to a certain type or class of types. (Some of these types are not visible in Lisp, because they exist only internally.) Each x... command prints some information about the value, and produces a GDB value (subsequently available in $) through which you can get at the rest of the contents. In general, most of the rest of the contents will be addition Lisp objects which you can examine in turn with the x... commands. ** If GDB does not run and your debuggers can't load Emacs. On some systems, no debugger can load Emacs with a symbol table, perhaps because they all have fixed limits on the number of symbols and Emacs exceeds the limits. Here is a method that can be used in such an extremity. Do nm -n temacs > nmout strip temacs adb temacs 0xd:i 0xe:i 14:i 17:i :r -l loadup (or whatever) It is necessary to refer to the file `nmout' to convert numeric addresses into symbols and vice versa. It is useful to be running under a window system. Then, if Emacs becomes hopelessly wedged, you can create another window to do kill -9 in. kill -ILL is often useful too, since that may make Emacs dump core or return to adb. ** Debugging incorrect screen updating. To debug Emacs problems that update the screen wrong, it is useful to have a record of what input you typed and what Emacs sent to the screen. To make these records, do (open-dribble-file "~/.dribble") (open-termscript "~/.termscript") The dribble file contains all characters read by Emacs from the terminal, and the termscript file contains all characters it sent to the terminal. The use of the directory `~/' prevents interference with any other user. If you have irreproducible display problems, put those two expressions in your ~/.emacs file. When the problem happens, exit the Emacs that you were running, kill it, and rename the two files. Then you can start another Emacs without clobbering those files, and use it to examine them. emacs-19.30/etc/DISTRIB100666 12130 13 13001 5767417123 13031 0ustar toweruser -*- text -*- For an order form for all Emacs and FSF distributions deliverable from the USA, see the file `ORDERS' in this directory (etc/ in the GNU Emacs distribution or /pub/gnu/GNUinfo on prep.ai.mit.edu). For a European order form, see `ORDERS.EUROPE'. For a Japan order form, see `ORDERS.JAPAN'. GNU Emacs availability information, June 1995 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995 Free Software Foundation, Inc. Permission is granted to anyone to make or distribute verbatim copies of this document provided that the copyright notice and this permission notice are preserved. GNU Emacs is legally owned by the Free Software Foundation, but we regard the foundation more as its custodian on behalf of the public. In the GNU project, when we speak of "free software", this refers to liberty, not price. Specifically, it refers to the users' freedom to study, copy, change and improve the software. Sometimes users pay money for copies of GNU software, and sometimes they get copies at no charge. But regardless of how they got the software, or whether it was modified by anyone else along the way, they have the freedom to copy and change it--those freedoms are what "free software" means. The precise conditions for copying and modification are stated in the document "GNU General Public License," a copy of which is required to be distributed with every copy of GNU Emacs. It is usually in a file named `COPYING' in the same directory as this file. These conditions are designed to make sure that everyone who has a copy of GNU Emacs (including modified versions) has the freedom to redistribute and change it. If you do not know anyone to get a copy of GNU Emacs from, you can order a tape, cd-rom, or floppy diskette from the Free Software Foundation. We distribute Emacs version 18 and 19 in different formats for many machines. We also distribute nicely typeset copies of the Emacs user manual, Emacs Lisp Reference Manual, the Emacs reference card, etc. See file `ORDERS'. If you have Internet access, you can copy the latest Emacs distribution from hosts, such as prep.ai.mit.edu. There are several ways to do this; see the file `FTP' for more information. Even better, get the latest version of the file from `/pub/gnu/GNUinfo/FTP' on prep.ai.mit.edu for the most current arrangements. It may also be possible to copy Emacs via uucp; the file `FTP' contains information on that too. Emacs has been run on both Berkeley Unix and System V Unix, on a variety of types of cpu. It also works on VMS and on Apollo computers, though with some deficiencies that reflect problems in these operating systems. See the file `MACHINES' in this directory (see above) for a full list of machines that GNU Emacs has been tested on, with machine-specific installation notes and warnings. There is also Demacs that works on newer MS-DOS machines (see file `ORDERS'). Note that there is significant variation between Unix systems supposedly running the same version of Unix; it is possible that what works in GNU Emacs for me does not work on your system due to such an incompatibility. Since I must avoid reading Unix source code, I cannot even guess what such problems may exist. GNU Emacs is distributed with no warranty (see the General Public License for full details, in the file `COPYING' in this directory (see above)), and neither I nor the Free Software Foundation promises any kind of support or assistance to users. The foundation keeps a list of people who are willing to offer support and assistance for hire. See the file `SERVICE'. You can get the latest version from prep.ai.mit.edu in file `/pub/gnu/GNUinfo/SERVICE'. However, we plan to continue to improve GNU Emacs and keep it reliable, so please send me any complaints and suggestions you have. I will probably fix anything that I consider a malfunction. I may make improvements that are suggested, but I may choose not to. Improving Emacs is not my highest priority now. If you are on the Internet, report bugs to bug-gnu-emacs@prep.ai.mit.edu; on UUCP, use the address ...!uunet!prep.ai.mit.edu!bug-gnu-emacs. Otherwise, phone or write the foundation at: Free Software Foundation 59 Temple Place - Suite 330 Boston, MA 02111-1307 Voice: +1-617-542-5942 Fax: +1-617-542-2652 General questions about the GNU Project can be asked of gnu@prep.ai.mit.edu. If you are a computer manufacturer, I encourage you to ship a copy of GNU Emacs with every computer you deliver. The same copying permission terms apply to computer manufacturers as to everyone else. You should consider making a donation to help support the GNU project; if you estimate what it would cost to distribute some commercial product and divide it by five, that is a good amount. If you like GNU Emacs, please express your satisfaction with a donation: send me or the Foundation what you feel Emacs has been worth to you. If you are glad that I developed GNU Emacs and distribute it as freeware, rather than following the obstructive and antisocial practices typical of software developers, reward me. If you would like the Foundation to develop more free software, contribute. Your donations will help to support the development of more useful software to be distributed on the same basis as GNU Emacs. Eventually we will have a complete imitation of the Unix operating system, called GNU (Gnu's Not Unix), which will run Unix user programs. For more information on GNU, see the file `GNU' in this directory (see above). Richard M Stallman Chief GNUisance, President of the Free Software Foundation emacs-19.30/etc/FAQ100444 12120 13 375054 5771072132 12025 0ustar rmsuser GNU Emacs FAQ: Introduction This is the introduction to a list of frequently asked questions (FAQ) about GNU Emacs with answers. The FAQ is posted to reduce the noise level in the `gnu.emacs.help' newsgroup (which is also the `help-gnu-emacs' mailing list) which results from the repetition of frequently asked questions, wrong answers to these questions, corrections to the wrong answers, corrections to the corrections, debate, name calling, etc. Also, it serves as a repository of the canonical "best" answers to these questions. However, if you know a better answer or even a slight change that improves an answer, please tell us! If you know the answer to a question in the FAQ list, please reply to the question by e-mail instead of posting. Help reduce noise! The FAQ is crossposted to `comp.emacs' because some sites do not receive the `gnu.*' newsgroups. The FAQ is also crossposted to `news.answers'. Full instructions for getting the latest FAQ are in question 22. It has been so long since the FAQ was last edited and released that the maintainers decided to take a two-step approach. This edition corrects many basic inaccuracies in the old FAQ, most of them having to do with ftp sites and version numbers. In addition, we have deleted a number of questions that are no longer relevant with the release of GNU Emacs 19. Many questions specific to recent releases of GNU Emacs 19 remain unanswered in this version of the FAQ; the maintainers will spend time over the next month or two adding new questions (and answers), based in no small part on the questions that have come across help-gnu-emacs in recent months. There is no diff file for this version of the FAQ, as many things have changed since it was last updated. Please suggest new questions, answers, wording changes, deletions, etc. The most helpful form for suggestions is a context diff (i.e., the output of `diff -c'). Include `FAQ' in the subject of messages sent to us about the FAQ list. Please do not send questions to us just because you do not want to disturb a lot of people and you think we would know the answer. We do not have time to answer questions individually. :-( -- Reuven M. Lerner and the FAQ team (a full list is at the bottom of the FAQ). ---------------------------------------------------------------------- Notation Used in FAQ 1: What do these mean: C-h, M-C-a, RET, "ESC a", etc.? 2: What does "M-x command" mean? 3: How do I read topic XXX in the on-line manual? 4: What do these mean: etc/SERVICE, src/config.h, lisp/default.el? 5: What are FSF, LPF, OSF, GNU, RMS, FTP, and GPL? General Questions 6: What is the LPF? 7: What is the real legal meaning of the GNU copyleft? 8: What are appropriate messages for gnu.emacs.help, gnu.emacs.bug, comp.emacs, etc.? 9: Where can I get old postings to gnu.emacs.help and other GNU groups? 10: Where should I report bugs and other problems with GNU Emacs? 11: How do I unsubscribe to this mailing list? 12: What is the current address of the FSF? On-line Help, Printed Manuals, Other Sources of Help 13: I'm just starting GNU Emacs; how do I do basic editing? 14: How do I find out how to do something in GNU Emacs? 15: How do I get a printed copy of the GNU Emacs manual? 16: Where can I get documentation on GNU Emacs Lisp? 17: How do I install a piece of Texinfo documentation? 18: How do I print a Texinfo file? 19: Can I view Info files without using GNU Emacs? 20: What informational files are available for GNU Emacs? 21: Where can I get help in installing GNU Emacs? 22: Where can I get the latest version of this document (the FAQ list)? Status of Emacs 23: Where does the name "Emacs" come from? 24: What is the latest version of GNU Emacs? 25: What is different about GNU Emacs 19? Common Things People Want To Do 26: How do I set up a .emacs file properly? 27: How do I debug a .emacs file? 28: How do I make Emacs display the current line (or column) number? 29: How do I turn on abbrevs by default just in mode XXX? 30: How do I turn on auto-fill mode by default? 31: How do I make Emacs use a certain major mode for certain files? 32: How do I search for, delete, or replace unprintable (8-bit or control) characters? 33: How can I highlight a region of text in Emacs? 34: How do I control Emacs's case-sensitivity when searching/replacing? 35: How do I make Emacs wrap words for me? 36: Where can I get a better spelling checker for Emacs? 37: How can I spell-check TeX or *roff documents? 38: How do I change load-path? 39: How do I use an already running Emacs from another window? 40: How do I make Emacs recognize my compiler's funny error messages? 41: How do I indent switch statements like this? 42: How can I make Emacs automatically scroll horizontally? 43: How do I make Emacs "typeover" or "overwrite" instead of inserting? 44: How do I stop Emacs from beeping on a terminal? 45: How do I turn down the bell volume in Emacs running under X Windows? 46: How do I tell Emacs to automatically indent a new line to the indentation of the previous line? 47: How do I show which parenthesis matches the one I'm looking at? 48: In C mode, can I show just the lines that will be left after #ifdef commands are handled by the compiler? 49: Is there an equivalent to the `.' (dot) command of vi? 50: What are the valid X resource settings (i.e., stuff in .Xdefaults)? 51: How do I execute a piece of Emacs Lisp code? 52: How do I change Emacs's idea of the tab character's length? 53: How do I insert `>' at the beginning of every line? 54: How do I insert `_^H' before each character in a paragraph to get an underlined paragraph? 55: How do I repeat a command as many times as possible? 56: How do I make Emacs behave like this: when I go up or down, the cursor should stay in the same column even if the line is too short? 57: How do I tell Emacs to iconify itself? 58: How do I use regexps (regular expressions) in Emacs? 59: How do I perform a replace operation across more than one file? 60: Where is the documentation for `etags'? Bugs/Problems 61: Does Emacs have problems with files larger than 8 megabytes? 62: How do I get rid of the ^M junk in my shell buffer? 63: Why do I get `Process shell exited abnormally with code 1'? 64: Where is the termcap/terminfo entry for terminal type `emacs'? 65: Why does Emacs spontaneously start displaying `I-search:' and beeping? 66: Why can't Emacs talk to certain hosts (or certain hostnames)? 67: Why does Emacs say `Error in init file'? 68: Why does Emacs ignore my X resources (my .Xdefaults file)? 69: Why does Emacs take 20 seconds to visit a file? 70: How do I edit a file with a `$' in its name? 71: Why does shell mode lose track of the shell's current directory? 72: Are there any security risks in GNU Emacs? Difficulties Building/Installing/Porting Emacs 73: What should I do if I have trouble building Emacs? 74: How do I stop Emacs from failing when the executable is stripped? 75: Why does linking Emacs with -lX11 fail? Finding/Getting Emacs and Related Packages 76: Where can I get GNU Emacs on the net (or by snail mail)? 77: How do I find a GNU Emacs Lisp package that does XXX? 78: Where can I get GNU Emacs Lisp packages that don't come with Emacs? 79: How do I submit code to the Emacs Lisp Archive? 80: Where can I get other up-to-date GNU stuff? 81: What is the difference between GNU Emacs and Epoch? 82: What is the difference between GNU Emacs and XEmacs (formerly "Lucid Emacs")? 83: Where can I get Emacs for my PC running MS-DOS? 84: Where can I get Emacs for my PC running Microsoft Windows? 85: Where can I get Emacs for my PC running OS/2? 86: Where can I get Emacs for my Atari ST? 87: Where can I get Emacs for my Amiga? 88: Where can I get Emacs for my Apple computer? 89: Where do I get Emacs that runs on VMS under DECwindows? 90: Where can I get modes for Lex, Yacc/Bison, Bourne shell, Csh, C++, Objective C, Pascal, and Awk? 91: What is the IP address of XXX.YYY.ZZZ? Major Emacs Lisp Packages, Emacs Extensions, and Related Programs 92: VM (View Mail) -- another mail reader within Emacs 93: Supercite -- mail and news citation package within Emacs 94: Gnus -- news reader within Emacs 95: Calc -- poor man's Mathematica within Emacs 96: Ange-FTP -- transparent FTP access for Emacs's file access routines 97: VIP -- vi emulation for Emacs 98: AUC TeX -- enhanced LaTeX mode with debugging facilities 99: Hyperbole -- extensible hypertext management system within Emacs 100: BBDB -- personal Info Rolodex integrated with mail/news readers 101: Ispell -- spell checker in C with interface for Emacs 102: XEmacs -- alternative Emacs 19 with better X interface; formerly known as Lucid Emacs or lemacs. 103: Patch -- program to apply "diffs" for updating files Changing Key Bindings and Handling Key Binding Problems 104: How do I bind keys (including function keys) to commands? 105: Why does Emacs say `Key sequence XXX uses invalid prefix characters'? 106: Why doesn't this [terminal or window-system setup] code work in my .emacs file, but it works just fine after Emacs starts up? 107: How do I use function keys under X Windows? 108: How do I tell what characters or symbols my function or arrow keys emit? 109: How do I set the X key "translations" for Emacs? 110: How do I handle C-s and C-q being used for flow control? 111: How do I bind `C-s' and `C-q' (or any key) if these keys are filtered out? 112: Why does the `Backspace' key invoke help? 113: Why doesn't Emacs look at the stty settings for Backspace vs. Delete? 114: How do I "swap" two keys? 115: How do I produce C-XXX with my keyboard? 116: What if I don't have a Meta key? 117: What if I don't have an Escape key? 118: Can I make my `Compose Character' key behave like a Meta key? 119: How do I bind a combination of modifier key and function key? 120: Why doesn't my Meta key work in an xterm window? 121: Why doesn't my ExtendChar key work as a Meta key under HP-UX 8.0? 122: Where can I get key bindings to make Emacs emulate WordStar? 123: Where can I get an XEDIT emulator for Emacs? Using Emacs with Alternate Character Sets 124: How do I make Emacs display 8-bit characters? 125: How do I input 8-bit characters? 126: Where can I get an Emacs that can handle kanji characters? 127: Where can I get an Emacs that can handle Chinese? 128: Where is an Emacs that can handle Semitic (right-to-left) alphabets? Mail and News 129: How do I change the included text prefix in mail/news followups? 130: How do I save a copy of outgoing mail? 131: Why doesn't Emacs expand my aliases when sending mail? 132: Why does Rmail think all my saved messages are one big message? 133: How can I sort the messages in my Rmail folder? 134: Why does Rmail need to write to /usr/spool/mail? 135: How do I recover my mail files after Rmail munges their format? 136: How do I make Emacs automatically start my mail/news reader? 137: How do I read news under Emacs? 138: Why doesn't Gnus work via NNTP? 139: How do I view text with embedded underlining (e.g., ClariNews)? 140: How do I save all the items of a multi-part posting in Gnus? 141: Why does Gnus put the subjects in replies beyond the 80th column? 142: How do I make Gnus start up faster? 143: How do I catch up all newsgroups in Gnus? 144: Why can't I kill in Gnus on the Newsgroups/Keywords/Control line? 145: How do I get rid of flashing messages in Gnus for slow connections? 146: Why is catch up slow in Gnus? 147: Why does Gnus hang for a long time when posting? 148: Why don't my news postings in Gnus get past the local machine? 149: Why doesn't Gnus generate the `Lines:' header? 150: How do I kill all articles in Gnus but those matching a pattern? ------------------------------------------------------------ If you are viewing this text in a GNU Emacs Buffer, you can type "M-2 C-x $" to get an overview of just the questions. Then, when you want to look at the text of the answers, just type "C-x $". To search for a question numbered XXX, type "M-C-s ^XXX:", followed by a C-r if that doesn't work, then type ESC to end the search. Full instructions for getting the latest FAQ are in question 22, or use anonymous FTP to the-tech.mit.edu. Notation Used in FAQ Skip this section and then come back if you don't understand some of the later answers. 1: What do these mean: C-h, M-C-a, RET, "ESC a", etc.? C-x means press the `x' key while holding down the Control key. M-x means press the `x' key while holding down the Meta key. M-C-x means press the `x' key while holding down both the Control key and the Meta key. C-M-a is a synonym for M-C-a. RET, LFD, DEL, ESC, and TAB respectively refer to pressing the Return, Linefeed (aka Newline), Delete, Escape, and Tab keys and are equivalent to C-m, C-j, C-?, C-[, and C-i. SPC means press the Space bar. Key sequences longer than one key (and some single-key sequences) are inside double quotes or on lines by themselves. Any real spaces in such a key sequence should be ignored; only SPC really means press the space key. The ASCII code sent by C-x (except for C-?) is the value that would be sent by pressing just `x' minus 96 (or 64 for uppercase `X') and will be from 0 to 31. The ASCII code sent by M-x is the sum of 128 and the ASCII code that would be sent by pressing just the `x' key. Essentially, the Control key turns off bits 5 and 6 and the Meta key turns on bit 7. For further information, see `Characters' and `Keys' in the on-line manual. NOTE: C-? (aka DEL) is ASCII code 127. It is a misnomer to call C-? a "control" key, since 127 has both bits 5 and 6 turned ON. Also, on very few keyboards does Control-? generate ASCII code 127. 2: What does "M-x command" mean? "M-x command" means type M-x, then type the name of the command, then type RET. M-x (by default) invokes the command `execute-extended-command'. This command allows you to run any Emacs command if you can remember the command's name. If you can't remember the command's name, you can type TAB and SPC for completion, "?" for a list of possibilities, and M-p and M-n to see previous commands entered. An Emacs "command" is any "interactive" Emacs function. NOTE: Your system administrator may have bound other key sequences to invoke execute-extended-command. A function key labeled `Do' is a good candidate for this. To run non-interactive Emacs functions, see question 51. 3: How do I read topic XXX in the on-line manual? When we refer you to topic XXX in the on-line manual, you can read this manual node inside Emacs (assuming nothing is broken) by typing this: C-h i m emacs RET m XXX RET This invokes Info, the GNU hypertext documentation browser. If you don't already know how to use Info, type "?" from within Info. If we refer to topic XXX:YYY, type this: C-h i m emacs RET m XXX RET m YYY RET WARNING: Your system administrator may not have installed the Info files, or may have installed them improperly. In this case you should complain. 4: What do these mean: etc/SERVICE, src/config.h, lisp/default.el? These are files that come with GNU Emacs. The GNU Emacs distribution is divided into subdirectories; the important ones are `etc', `lisp', and `src'. If you use GNU Emacs, but don't know where it is kept on your system, start Emacs, then type "C-h v data-directory RET". The directory name displayed by this will be the full pathname of the installed `etc' directory. Some of these files are available individually via FTP or e-mail; see question 20. All are available in the source distribution. WARNING: Your system administrator may have removed the src directory and many files from the etc directory. 5: What are FSF, LPF, OSF, GNU, RMS, FTP, and GPL? FSF == Free Software Foundation LPF == League for Programming Freedom OSF == Open Software Foundation GNU == GNU's Not Unix RMS == Richard Matthew Stallman FTP == File Transfer Protocol GPL == GNU General Public Licence NOTE: Avoid confusing the FSF, the LPF, and the OSF. The LPF opposes look-and-feel copyrights and software patents. The FSF aims to make high quality free software available for everyone. The OSF is a consortium of computer vendors which develops commercial software for Unix systems. NOTE: The word "free" in the title of the Free Software Foundation refers to "freedom," not "zero dollars." Anyone can charge any price for GPL-covered software that they want to. However, in practice, the freedom enforced by the GPL leads to low prices, because you can always get the software for less money from someone else, because everyone has the right to resell or give away GPL-covered software. General Questions 6: What is the LPF? The LPF opposes the expanding danger of software patents and look-and-feel copyrights. To get more information, feel free to contact the LPF via e-mail or otherwise. You may also contact Joe Wells ; he will be happy to talk with you about the LPF. You can find more information about the LPF in the file etc/LPF. More papers describing the LPF's views are available on the Internet and also from the LPF: Anonymous FTP: /prep.ai.mit.edu:pub/lpf/ /archive.cis.ohio-state.edu:pub/lpf/ Anonymous UUCP: osu-cis!~/lpf/* 7: What is the real legal meaning of the GNU copyleft? The real legal meaning of the GNU General Public Licence (copyleft) will only be known if and when a judge rules on its validity and scope. There has never been a copyright infringement case involving the GPL to set any precedents. Please take any discussion regarding this issue to the newsgroup gnu.misc.discuss, which was created to hold the extensive flame wars on the subject. RMS writes: The legal meaning of the GNU copyleft is less important than the spirit, which is that Emacs is a free software project and that work pertaining to Emacs should also be free software. "Free" means that all users have the freedom to study, share, change and improve Emacs. To make sure everyone has this freedom, pass along source code when you distribute any version of Emacs or a related program, and give the recipients the same freedom that you enjoyed. 8: What are appropriate messages for gnu.emacs.help, gnu.emacs.bug, comp.emacs, etc.? The file etc/MAILINGLISTS discusses the purpose of each GNU mailing-list. (See question 20 on how to get a copy.) For those which are gatewayed with newsgroups, it lists both the newsgroup name and the mailing list address. comp.emacs is for discussion of Emacs programs in general. This includes GNU Emacs along with various other implementations like JOVE, MicroEmacs, Freemacs, MG, Unipress, CCA, and Epsilon.. Many people post GNU Emacs questions to comp.emacs because they don't receive any of the gnu.* newsgroups. Arguments have been made both for and against posting GNU-Emacs-specific material to comp.emacs. You have to decide for yourself. Messages advocating "non-free" software are considered unacceptable on any of the gnu.* newsgroups except for gnu.misc.discuss, which was created to hold the extensive flame-wars on the subject. "non-free" software includes any software for which the end user can't freely modify the source code and exchange enhancements. Be careful to remove the gnu.* groups from the `Newsgroups:' line when posting a followup that recommends such software. gnu.emacs.bug is a place where bug reports appear, but avoid posting bug reports to this newsgroup (see question 10). 9: Where can I get old postings to gnu.emacs.help and other GNU groups? The FSF has maintained archives of all of the GNU mailing lists for many years, although there may be some unintentional gaps in coverage. The archive is not particularly well organized or easy to retrieve individual postings from, but pretty much everything is there. The archive is available via anonymous ftp at /prep.ai.mit.edu:pub/gnu/MailingListArchives/ 10: Where should I report bugs and other problems with GNU Emacs? The correct way to report GNU Emacs bugs is by e-mail to bug-gnu-emacs@prep.ai.mit.edu. Anything sent here also appears in the newsgroup gnu.emacs.bug, but please use e-mail instead of news to submit the bug report. This way a reliable return address is available so you can be contacted for further details. RMS explains: Sending bug reports to help-gnu-emacs (which has the effect of posting on gnu.emacs.help) is undesirable because it takes the time of an unnecessarily large group of people, most of whom are just users and have no idea how to fix these problem. bug-gnu-emacs reaches a much smaller group of people who are more likely to know what to do and have expressed a wish to receive more messages about Emacs than the others. However, RMS says there are circumstances when it is okay to post to gnu.emacs.help: If you have reported a bug and you don't hear about a possible fix, then after a suitable delay (such as a week) it is okay to post on gnu.emacs.help asking if anyone can help you. If you are unsure whether you have a bug, RMS describes how to tell: ... if Emacs crashes, that is a bug. If Emacs gets compilation errors while building, that is a bug. If Emacs crashes while building, that is a bug. If Lisp code does not do what the documentation says it does, that is a bug. 11: How do I unsubscribe to this mailing list? If you are receiving a GNU mailing list named `XXX', you might be able to unsubscribe to it by sending a request to the address `XXX-request@prep.ai.mit.edu'. However, this will not work if you are not listed on the main mailing list, but instead receive the mail from a distribution point. In that case, you will have to track down at which distribution point you are listed. Inspecting the `Received:' headers on the mail messages may help, along with liberal use of the `EXPN' or `VRFY' sendmail commands through `telnet smtp'. Ask your postmaster for help. 12: What is the current address of the FSF? E-mail address: gnu@prep.ai.mit.edu Phone number: (617) 876-3296 Postal address: Free Software Foundation, Inc. 675 Massachusetts Avenue Cambridge, MA 02139, USA For details on how to order, see the file etc/ORDERS. On-line Help, Printed Manuals, Other Sources of Help 13: I'm just starting GNU Emacs; how do I do basic editing? Type "C-h t" to invoke the self-paced tutorial. Typing just C-h is how to enter the help system. WARNING: Your system administrator may have changed C-h to act like DEL to deal with local keyboards. You can use M-x help-for-help instead to invoke help. To discover what key (if any) invokes help on your system, type "M-x where-is RET help-for-help RET". This will print a comma-separated list of key sequences in the echo area. Ignore the last character in each key sequence listed. Each of the resulting key sequences invokes help. NOTE: Emacs help works best if it is invoked by a single key whose value should be stored in the variable help-char. Andrew Arensburger wrote a patch that allows the help facility to work properly when invoked by multiple character sequences. 14: How do I find out how to do something in GNU Emacs? There are several methods for finding out how to do things in Emacs. * The complete text of the Emacs manual is available on-line via the Info hypertext reader. Type "C-h i" to invoke Info. * You can order a hardcopy of the manual from the FSF. See question 15. * You can get a printed reference card listing commands and keys to invoke them. You can order one from the FSF for $1 (or 10 for $5), or you can print your own from the etc/refcard.tex or etc/refcard.ps files in the Emacs distribution. * You can list all of the commands whose names contain a certain word (actually which match a regular expression) using "C-h a" (M-x command-apropos). * You can list all of the functions and variables whose names contain a certain word using M-x apropos. * There are many other commands in Emacs for getting help and information. To get a list of these commands, type "C-h C-h C-h". 15: How do I get a printed copy of the GNU Emacs manual? You can order a printed copy of the GNU Emacs manual from the FSF. For details see the file etc/ORDERS. The full TeX source for the manual also comes in the `man' directory of the Emacs distribution, if you're daring enough to try to print out this 420 page manual yourself (see question 18). If you absolutely have to print your own copy, and you don't have TeX, you can get a PostScript version via anonymous FTP: /ftp.cs.ubc.ca:pub/archive/gnu/manuals_ps/emacs-19.21.ps.gz This site requests that you please CONFINE ANY MAJOR FTPING TO LATE EVENINGS OR EARLY MORNINGS OUR TIME (Pacific time zone, GMT-8). A DVI version is also available via FTP: /prep.ai.mit.edu:pub/gnu/emacs-manual-6.0.dvi.gz and all prep mirrors (See question 80 for a list). A WWW version of the Emacs manual is available on the World-Wide Web at URL http://asis01.cern.ch/infohtml/emacs/emacs.html See also question 14 for how to view the manual on-line. 16: Where can I get documentation on GNU Emacs Lisp? Within Emacs, you can type "C-h f" to get the documentation for a function, "C-h v" for a variable. For more information, obtain the GNU Emacs Lisp Reference Manual. Details on ordering it from FSF are in file etc/ORDERS. For on-line use, a set of pregenerated Info files is available with the Texinfo source for the Emacs Lisp manual via anonymous FTP at /prep.ai.mit.edu:pub/gnu/elisp-manual-19-2.3.tar.gz and all prep mirrors (See question 80 for a list). You can also create the Info files from the Texinfo source. See question 17 for details on how to install these files on-line. A WWW version of the Emacs Lisp Reference Manual is available at http://www.cs.indiana.edu/usr/local/www/elisp/lispref/elisp_toc.html An introduction to Emacs Lisp is available at http://www.cs.indiana.edu/usr/local/www/elisp/elisp-intro.html Of course, you can also print this 760-page manual yourself. For instructions on how to do this, see question 18. 17: How do I install a piece of Texinfo documentation? First, you must turn the Texinfo files into Info files. You may do this within Emacs, using "M-x texinfo-format-buffer", or with the standalone `makeinfo' program, available as part of the latest Texinfo package via anonymous ftp from: /prep.ai.mit.edu:pub/gnu/texinfo-3.1.tar.gz and all prep mirrors (See question 80 for a list). For information about the Texinfo format, read the Texinfo manual which comes with Emacs. This manual also comes installed in Info format, so you can read it on-line. Neither texinfo-format-buffer nor makeinfo installs the resulting Info files in Emacs's Info tree. To install Info files: 1. Move the files to the `info' directory in the installed Emacs distribution. See question 4 if you don't know where that is. 2. Edit the file info/dir in the installed Emacs distribution, and add a line for the top level node in the Info package that you are installing. Follow the examples already in this file. The format is: * Topic: (relative-pathname). Short description of topic. If you want to install Info files and you don't have the necessary privileges, you have several options: * Info files don't actually need to be installed before being used. You can feed a file name to the Info-goto-node command (invoked by pressing "g" in Info mode) by typing the name of the file in parentheses. This goes to the node named `Top' in that file. For example, to view a Info file named `XXX' in your home directory, you can type this: C-h i g (~/XXX) RET * You can create your own Info directory. You can tell Emacs where the Info directory is by adding its pathname to the value of the variable Info-default-directory-list. For example, to use a private Info directory which is a subdirectory of your home directory named `Info', you could put this in your .emacs file: (setq Info-default-directory-list (cons "~/Info" Info-default-directory-list)) You will need a top-level Info file named `dir' in this directory which has everything the system dir file has in it, except it should list only entries for Info files in that directory. You might not need it if all files in this directory were referenced by other `dir' files. The node lists from all dir files in Info-default-directory-list are merged by the Info system. 18: How do I print a Texinfo file? NOTE: You can't get nice printed output from Info files; you must still have the original Texinfo source file for the manual you want to print. 1. Make sure the first line of the Texinfo file looks like this: \input texinfo You may need to alter `texinfo' to the full pathname of the texinfo.tex file, which comes with Emacs as man/texinfo.tex (or copy or link it into the current directory). 2. tex XXX.texinfo 3. texindex XXX.?? The `texindex' program comes with Emacs as man/texindex.c. 4. tex XXX.texinfo 5. Print the DVI file XXX.dvi in the normal way for printing DVI files at your site. To get more general instructions, retrieve the latest Texinfo package mentioned in question 17. 19: Can I view Info files without using GNU Emacs? Yes, the `info', `xinfo', `tkinfo', and `ivinfo' programs do this. Info uses curses, xinfo uses standard X11 libraries, tkinfo uses Tk/Tcl and ivinfo uses InterViews. You can get Info as part of the latest Texinfo package (see question 17). xinfo is available separately: /prep.ai.mit.edu:pub/gnu/xinfo-1.01.01.tar.gz and all prep mirrors (See question 80 for a list). ivinfo is available in a comp.sources.misc archive or from Tom Horsley . tkinfo is available by anonymous ftp from: /ptolemy.eecs.berkeley.edu:pub/misc/tkinfo-0.6.tar.Z /ftp.aud.alcatel.com:tcl/code/tkinfo-0.6.tar.gz For ivinfo, you need Stanford's InterViews C++ X library, available via anonymous ftp from interviews.stanford.edu. (A FAQ on InterViews is available at that site in pub/FAQ.) 20: What informational files are available for GNU Emacs? This isn't a frequently asked question, but it should be! A variety of informational files about GNU Emacs and relevant aspects of the GNU project are available for you to read. The following files are available in the `etc' directory of the GNU Emacs distribution, and also the latest versions are available individually via anonymous FTP (prep.ai.mit.edu:pub/gnu/GNUinfo/): APPLE -- Why the FSF doesn't support GNU Emacs on Apple computers DISTRIB -- GNU Emacs Availability Information, including the popular "Free Software Foundation Order Form" FTP -- How to get GNU Software by Internet FTP or by UUCP GNU -- The GNU Manifesto INTERVIEW -- Richard Stallman discusses his public-domain UNIX-compatible software system with BYTE editors MACHINES -- Status of GNU Emacs on Various Machines and Systems MAILINGLISTS -- GNU Project Electronic Mailing Lists SERVICE -- GNU Service Directory SUN-SUPPORT -- including "Using Emacstool with GNU Emacs" These files are available in the `etc' directory of the GNU Emacs distribution: COPYING -- GNU Emacs General Public License NEWS -- GNU Emacs news, a history of user-visible changes LPF -- Why you should join the League for Programming Freedom FAQ -- GNU Emacs Frequently Asked Questions (You're reading it) These files are available via anonymous FTP (prep.ai.mit.edu:pub/gnu/): tasks -- GNU Task List standards.text -- GNU Coding Standards In addition, all of the above files are available directly from the FSF via e-mail. Of course, please try to get them from a local source first (See question 80 for a list). These additional files are available from the FSF via e-mail: * GNU's Bulletin, January 1994 GNU's Who GNU's Bulletin What Is the Free Software Foundation? What Is Copyleft? Donations Translate Into Free Software Cygnus Matches Donations! GNUs Flashes What Is the LPF? News from the LPF Free Software Support Project GNU Wish List Towards a New Strategy of OS Design Part 1: A More Usable Approach to OS Design Part 2: A Look at Some of the Hurd's Beasts Second Annual GNU Seminar in Japan GNU and other Free Software in Japan Freely Available Texts OCEAN Integrated-Circuit Design System Hundred Acre Consulting Expands Project GNU Status Report GNU Documentation GNU Software Available Now Source Code CD-ROM Compiler Tools Binaries CD-ROM Tape & CD-ROM Subscription Service How to Get GNU Software The Deluxe Distribution MS-DOS Distribution Free Software for Microcomputers FSF T-shirt Thank GNUs Free Software Foundation Order Form * Legal issues about contributing code to GNU * GNU Project Status Report A collection of past GNU's Bulletins is available via anonymous FTP from: /ftp.funet.fi:pub/gnu/Bulletins/ The latest bulletin is available on the World-Wide Web at URL: http://info.desy.de/gnu/www/gnu_bulletin_9401/gnu_bulletin_9401_toc.html 21: Where can I get help in installing GNU Emacs? Look in etc/SERVICE for names of companies and individuals who will sell you this type of service. An up-to-date version of the SERVICE file is available on prep.ai.mit.edu (also see question 20). You might also try the help-gnu-emacs mailing list, which is also known as the gnu.emacs.help newsgroup, although many installation questions can easily be answered by looking at the PROBLEMS file (in the top-level directory when you unpack the Emacs source). 22: Where can I get the latest version of this document (the FAQ list)? The GNU Emacs FAQ is available in several ways: * Via USENET. If you can read news, the FAQ should be available in your news spool, in both the gnu.emacs.help and comp.emacs newsgroups. Every news reader should allow you to read any news article that is still in the news spool, even if you have read the article before. You may need to read the instructions for your news reader to discover how to do this. In `rn', this command will do this for you at the article selection level: ?GNU Emacs FAQ?rc:m In Gnus, you should type "C-u c-x c-s" from the *Summary* buffer or "C-u SPC" from the *Newsgroup* buffer to view all articles in a newsgroup. If the FAQ articles have expired and been deleted from your news spool, it might (or might not) do some good to complain to your news administrator, because the most recent FAQ should not expire before for a while. * Via anonymous FTP. You can fetch the FAQ articles via anonymous FTP from the-tech.mit.edu, in ~ftp/pub/GNU-Emacs/. * In the GNU Emacs distribution. Since GNU Emacs 18.56, the latest available version of the FAQ at the time of release has been part of the GNU Emacs distribution as file etc/FAQ. * Via the World-Wide Web. Point your favorite Web browser (Mosaic, Lynx, w3-mode) to one of the following URLs: http://www.cis.ohio-state.edu/hypertext/faq/usenet/GNU-Emacs-FAQ/top.html http://scwww.ucs.indiana.edu/FAQ/Emacs/ * If all goes well, this FAQ should also be available via anonymous ftp and e-mail from rtfm.mit.edu, the main repository for FAQs and other items posted to news.answers. However, we are omitting explicit directions on how to retrieve the FAQ from rtfm.mit.edu, since it's possible that it won't end up there right away. (We're new at this FAQ-posting business.) Instructions on how to retrieve the FAQ from rtfm.mit.edu should be in the next version of the FAQ. * As the very last resort, you can e-mail a request to gnu-emacs-faq-maintainers@bigbird.bu.edu. Don't do this unless you have made a serious effort to obtain the FAQ list via one of the methods listed above. Status of Emacs 23: Where does the name "Emacs" come from? Emacs originally was an acronym for Editor MACroS. RMS says he "picked the name `Emacs' because `E' was not in use as an abbreviation on ITS at the time." The first Emacs was a set of macros written in 1976 at MIT by RMS for the editor TECO (Text Editor and COrrector (originally Tape Editor and COrrector)) under ITS on a PDP-10. RMS had already extended TECO with a "real-time" full screen mode with active keys. Emacs was started by Guy Steele as a project to unify the many divergent TECO command sets and key bindings at MIT. Many people have said that TECO code looks a lot like line noise. See alt.lang.teco if you are interested. Someone has written a TECO implementation in Emacs Lisp; it would be an interesting project to run the original TECO Emacs inside of GNU Emacs. 24: What is the latest version of GNU Emacs? GNU Emacs 19.27 is the current version as of 6 September, 1994. 25: What is different about GNU Emacs 19? To find out what has changed in recent versions, type C-h n (M-x view-emacs-news). The oldest changes are at the bottom of the file, so you might want to read it starting there, rather than at the top. The most obvious changes have to do with the user interface -- GNU Emacs 19 is fully X-aware, and provides pull-down menus and scroll bars. Emacs 19 also supports fonts and colors, including context-specific highlighting of source code and other types of buffers. Other changes include a line number mode, which displays the current line number in the mode line, and default bindings for arrow and paging keys that work. Lower-level changes include a smarter memory allocation scheme (Emacs now returns memory to the operating system when you kill buffers), a better byte-compiler, and a source-level Emacs Lisp debugger. There are also a number of new Lisp packages, ranging from dunnet (an Adventure-like program) to mldrag (allows you to drag the mode line up and down with the mouse buttons) to gud (Grand Unified Debugger mode, for many flavors of debuggers). A number of popular Lisp packages, such as SuperCite and the calendar/diary, are also included. Common Things People Want To Do 26: How do I set up a .emacs file properly? See `Init File' in the on-line manual. WARNING: In general, new Emacs users should not have .emacs files, because it causes confusing non-standard behavior. Then they send questions to help-gnu-emacs asking why Emacs isn't behaving as documented. :-) 27: How do I debug a .emacs file? First start Emacs with the `-debug-init' command-line option. This option enables the Emacs Lisp debugger before evaluating your .emacs file, and places you in the debugger if something goes wrong. The top line in the trace-back buffer will be the error message, and the second or third line of that buffer will display the Lisp code from your .emacs that caused the problem. You can also evaluate an individual function or argument to a function in your .emacs file by moving the cursor to the end of the function or argument and typing "C-x C-e" (M-x eval-last-sexp). Use "C-h v" (M-x describe-variable) to check the value of variables which you are trying to set or use. 28: How do I make Emacs display the current line (or column) number? To find out what line of the buffer you are on right now, do "M-x what-line". Use "M-x goto-line" to go to a specific line. To find the current column number, type "M-ESC (current-column)". If you use these commands often, you might want to bind them to a key. See question 104 for instructions on how to do that. Typing "C-x l" (or M-x count-lines-page) will also tell you what line you are on, provided the buffer isn't separated into "pages" with C-l characters. In that case, it will only tell you what line of the current "page" you are on. To have Emacs automatically display the current line number of the point in the mode line, do "M-x line-number-mode". You can also put the form (setq line-number-mode t) in your .emacs file to achieve this whenever you start Emacs. Note that Emacs will not display the line number if the buffer is larger than the value of the variable line-number-display-limit. None of the vi emulation modes provide the `set number' capability of vi (as far as we know). 29: How do I turn on abbrevs by default just in mode XXX? Put this in your .emacs file: (condition-case () (quietly-read-abbrev-file) (file-error nil)) (add-hook 'XXX-mode-hook (function (lambda () (setq abbrev-mode t)))) 30: How do I turn on auto-fill mode by default? To turn on auto-fill mode just once for one buffer, use "M-x auto-fill-mode". To turn it on for every buffer in, for example, Text mode, do this: (add-hook 'text-mode-hook 'turn-on-auto-fill) If you want auto-fill mode on in all major modes, do this: (setq-default auto-fill-hook 'do-auto-fill) 31: How do I make Emacs use a certain major mode for certain files? If you want to use XXX mode for all files which end with the extension `.YYY', this will do it for you: (setq auto-mode-alist (cons '("\\.YYY\\'" . XXX-mode) auto-mode-alist)) Otherwise put this somewhere in the first line of any file you want to edit in XXX mode: -*-XXX-*- Emacs 19 also includes a new variable, interpreter-mode-alist, that specifies which mode to use when loading a shell script. (Emacs determines which interpreter you're using by examining the first line of the file.) This feature only applies when the file name doesn't indicate which mode to use. Use "C-h v" (or M-x describe-variable) to learn more about this variable. 32: How do I search for, delete, or replace unprintable (8-bit or control) characters? To search for a single character that appears in the buffer as, for example, `\237', you can type "C-s C-q 2 3 7". (This assumes the value of search-quote-char is 17 (i.e., C-q).) Searching for ALL unprintable characters is best done with a "regexp" search. The easiest regexp to use for the unprintable chars is the complement of the regexp for the printable chars. Regexp for the printable chars: [\t\n\r\f -~] Regexp for the unprintable chars: [^\t\n\r\f -~] To type some of these special characters in an interactive argument to isearch-forward-regexp or re-search-forward, you need to use C-q. (`\t', `\n', `\r', and `\f' stand respectively for TAB, LFD, RET, and C-l.) So, to search for unprintable characters using re-search-forward: M-x re-search-forward RET [^ TAB C-q LFD C-q RET C-q C-l SPC -~] RET Using isearch-forward-regexp: M-C-s [^ TAB RET C-q RET C-q C-l SPC -~] To delete all unprintable characters, simply use replace-regexp: M-x replace-regexp RET [^ TAB C-q LFD C-q RET C-q C-l SPC -~] RET RET Replacing is similar to the above. To replace all unprintable characters with a colon, use: M-x replace-regexp RET [^ TAB C-q LFD C-q RET C-q C-l SPC -~] RET : RET NOTE: * You don't need to quote TAB with either isearch or typing something in the minibuffer. 33: How can I highlight a region of text in Emacs? If you are using a windowing system such as X, you can cause the region to be highlighted when the mark is active by including (transient-mark-mode t) in your .emacs. There are also the following packages for content- based highlighting: hilit19.el font-lock.el 34: How do I control Emacs's case-sensitivity when searching/replacing? For searching, the value of the variable case-fold-search determines whether they are case sensitive: (setq case-fold-search nil) ; make searches case sensitive (setq case-fold-search t) ; make searches case insensitive Similarly, for replacing the variable case-replace determines whether replacements preserve case. To change the case sensitivity just for one major mode, use the major mode's hook. For example: (add-hook 'XXX-mode-hook (function (lambda () (setq case-fold-search nil)))) 35: How do I make Emacs wrap words for me? Use auto-fill mode, activated by typing "M-x auto-fill-mode". The default maximum line width is 70, determined by the variable fill-column. To learn how to turn this on automatically, see question 30. 36: Where can I get a better spelling checker for Emacs? Use Ispell. See question 101. 37: How can I spell-check TeX or *roff documents? Use Ispell. See question 101. Ispell can handle TeX and *roff documents. 38: How do I change load-path? In general, you should only *add* to the load-path. You can add directory /XXX/YYY to the load path like this: (setq load-path (cons "/XXX/YYY/" load-path)) To do this relative to your home directory: (setq load-path (cons "~/YYY/" load-path) 39: How do I use an already running Emacs from another window? The `emacsclient' program is for editing a file using an already running Emacs rather than starting up a new Emacs. It does this by sending a request to the already running Emacs, which must be expecting the request. * Setup Emacs must have executed the `server-start' function for emacsclient to work. This can be done either by a command line option: emacs -f server-start or by invoking server-start from the .emacs file: (if (some conditions are met) (server-start)) When this is done, Emacs starts a subprocess running a program called `server'. `server' creates a Unix domain socket in the user's home directory named `.emacs_server'. To get your news reader, mail reader, etc., to invoke emacsclient, try setting the environment variable EDITOR (or sometimes VISUAL) to the value `emacsclient'. You may have to specify the full pathname of the emacsclient program instead. Examples: # csh commands: setenv EDITOR emacsclient setenv EDITOR /usr/local/emacs/etc/emacsclient # using full pathname # sh command: EDITOR=emacsclient ; export EDITOR * Normal use When emacsclient is run, it connects to the `.emacs_server' socket and passes its command line options to `server'. When `server' receives these requests, it sends this information on the the Emacs process, which at the next opportunity will visit the files specified. (Line numbers can be specified just like with Emacs.) The user will have to switch to the Emacs window by hand. When the user is done editing a file, the user can type "C-x #" (or M-x server-edit) to indicate this. If there is another buffer requested by emacsclient, Emacs will switch to it; otherwise emacsclient will exit, signaling the calling program to continue. NOTE: `emacsclient' and `server' must be running on machines which share the same filesystem for this to work. The pathnames that emacsclient specifies should be correct for the filesystem that the Emacs process sees. The Emacs process should not be suspended at the time emacsclient is invoked. emacsclient should either be invoked from another X window or from a shell window inside Emacs itself. There is an enhanced version of emacsclient/server called `gnuserv' by Andy Norman which is available in the Emacs Lisp Archive. gnuserv uses Internet domain sockets, so it can work across most network connections. It also supports the execution of arbitrary Emacs Lisp forms and also does not require the client program to wait for completion. It is available via anonymous FTP (Emacs Lisp Archive: packages/gnuserv.shar). 40: How do I make Emacs recognize my compiler's funny error messages? The variable compilation-error-regexp-alist helps control how Emacs parses your compiler output. It is a list of triples of the form: (REGEXP FILE-IDX LINE-IDX) where REGEXP, FILE-IDX and LINE-IDX are strings. To help determine what the constituent elements should be, load compile.el and then use C-h v compilation-error-regexp-alist RET to see the current value. A good idea is to look at compile.el itself as the comments included for this variable are quite useful -- the regular expressions required for your compiler's output may be very close to one already provided. Once you have determined the proper regexps, use the following to inform Emacs of your changes: (setq compilation-error-regexp-alist (cons '(REGEXP FILE-IDX LINE-IDX) compilation-error-regexp-alist)) 41: How do I indent switch statements like this? Many people want to indent their switch statements like this: f() { switch(x) { case A: x1; break; case B: x2; break; default: x3; } } The solution at first appears to be: set c-indent-level to 4 and c-label-offset to -2. However, this will give you an indentation spacing of four instead of two. The solution is to use cc-mode (available from the Emacs Lisp Archive) and add the following line: (c-set-offset 'case-label '+) There appears to be no way to do this with the old c-mode. 42: How can I make Emacs automatically scroll horizontally? Use hscroll.el by Wayne Mesard . 43: How do I make Emacs "typeover" or "overwrite" instead of inserting? M-x overwrite-mode (a minor mode). On some workstations, the "Insert" key toggles insert and overwrite modes. 44: How do I stop Emacs from beeping on a terminal? Martin R. Frank writes: Tell Emacs to use the `visible bell' instead of the audible bell, and set the visible bell to nothing. Put this in your TERMCAP environment variable: ... :vb=: ... And evaluate this: (setq visible-bell t) 45: How do I turn down the bell volume in Emacs running under X Windows? You can adjust the bell volume and duration for all programs with the shell command xset. Invoking xset without any arguments produces some basic information, including the following: usage: xset [-display host:dpy] option ... To turn bell off: -b b off b 0 To set bell volume, pitch and duration: b [vol [pitch [dur]]] b on 46: How do I tell Emacs to automatically indent a new line to the indentation of the previous line? One solution is Indented Text Mode (M-x indented-text-mode). If you have auto-fill mode on (a minor mode, see question 30), you can tell Emacs to prefix every line with a certain character sequence, the "fill prefix." Type the prefix at the beginning of a line, position point after it, and then type "C-x ." (set-fill-prefix) to set the fill prefix. Thereafter, auto-filling will automatically put the fill prefix at the beginning of new lines, and M-q (fill-paragraph) will maintain any fill prefix when refilling the paragraph. NOTE: If you have paragraphs with different levels of indentation, you will have to set the fill prefix to the correct value each time you move to a new paragraph. To avoid this hassle, try one of the many packages available from the Emacs Lisp Archive. Look up `fill' and `indent' in the Lisp Code Directory for guidance. 47: How do I show which parenthesis matches the one I'm looking at? GNU Emacs 19 comes with paren.el, which (when loaded) will automatically highlight matching parentheses whenever point (i.e., the cursor) is located over one. To load paren automatically, include the line (require 'paren) in your .emacs file. Alternatives to paren include: * If you're looking at a right parenthesis (or brace or bracket) you can delete it and reinsert it. Emacs will blink the cursor on the matching parenthesis. * M-C-f (forward-sexp) and M-C-b (backward-sexp) will skip over one set of balanced parentheses, so you can see which parentheses match. (You can train it to skip over balanced brackets and braces at the same time by modifying the syntax table.) * Here is some Emacs Lisp that will make the % key show the matching parenthesis, like in vi. In addition, if the cursor isn't over a parenthesis, it simply inserts a % like normal. ;; By an unknown contributor (global-set-key "%" 'match-paren) (defun match-paren (arg) "Go to the matching parenthesis if on parenthesis otherwise insert %." (interactive "p") (cond ((looking-at "\\s\(") (forward-list 1) (backward-char 1)) ((looking-at "\\s\)") (forward-char 1) (backward-list 1)) (t (self-insert-command (or arg 1))))) 48: In C mode, can I show just the lines that will be left after #ifdef commands are handled by the compiler? M-x hide-ifdef-mode. (This is a minor mode.) 49: Is there an equivalent to the `.' (dot) command of vi? (`.' is the redo command in vi. It redoes the last insertion/deletion.) No, not really. You can type "C-x ESC ESC" (repeat-complex-command) to reinvoke commands that used the minibuffer to get arguments. In repeat-complex-command you can type M-p and M-n to scan through all the different complex commands you've typed. To repeat something on each line, use keyboard macros. (See `Keyboard Macros' in the on-line manual.) 50: What are the valid X resource settings (i.e., stuff in .Xdefaults)? See Emacs man page, or "Resources X" in the on-line manual. You can also use a resource editor, such as editres (for X11R5 and onwards), to look at the resource names for the menu bar, assuming Emacs was compiled with the X toolkit. 51: How do I execute a piece of Emacs Lisp code? There are a number of ways to execute (called "evaluate") an Emacs Lisp "form": * If you want it evaluated every time you run Emacs, put it in a file named `.emacs' in your home directory. * You can type the form in the *scratch* buffer, and then type LFD (or C-j) after it. The result of evaluating the form will be inserted in the buffer. * In Emacs-Lisp mode, typing M-C-x evaluates a top-level form before or around point. * Typing "C-x C-e" in any buffer evaluates the Lisp form immediately before point and prints its value in the echo area. * Typing M-ESC or M-x eval-expression allows you to type a Lisp form in the minibuffer which will be evaluated. * You can use M-x load-file to have Emacs evaluate all the Lisp forms in a file. (To do this from Lisp use the function `load' instead.) These functions are also used for evaluating Lisp forms: load-library, eval-region, eval-current-buffer, require, autoload 52: How do I change Emacs's idea of the tab character's length? Set the variable default-tab-width. For example, to set tab stops every 10 characters, insert the following in your .emacs file: (setq default-tab-width 10) 53: How do I insert `>' at the beginning of every line? Type "M-x replace-regexp RET ^ RET > RET". To do this only in the region, type "C-x n n M-x replace-regexp RET ^ RET > RET C-x w". WARNING: The command narrow-to-region (C-x n n) is disabled by default because it can be very confusing (i.e., "Oh no! Where did my file go?"). 54: How do I insert `_^H' before each character in a paragraph to get an underlined paragraph? M-x underline-region. 55: How do I repeat a command as many times as possible? Use "C-x (" and "C-x )" to make a keyboard macro that invokes the command and then type "M-0 C-x e". WARNING: any messages your command prints in the echo area will be suppressed. 56: How do I make Emacs behave like this: when I go up or down, the cursor should stay in the same column even if the line is too short? M-x picture-mode. (This is a minor mode, in theory anyway ...) 57: How do I tell Emacs to iconify itself? "C-z" iconifies Emacs when running in X and suspends Emacs otherwise. See `Misc X' in the on-line manual. 58: How do I use regexps (regular expressions) in Emacs? See `Regexps' in the on-line manual. WARNING: The "or" operator is `\|', not `|', and the grouping operators are `\(' and `\)'. Also, the string syntax for a backslash is "\\". Thus, the string syntax for a regular expression like xxx\(foo\|bar\) is "xxx\\(foo\\|bar\\)". Notice the duplicated backslashes! WARNING: Unlike in Unix grep, sed, etc., a complement character set ([^...]) can match a newline character (LFD aka C-j aka \n), unless newline is mentioned as one of the characters not to match. WARNING: The character syntax regexps (e.g., `\sw') are not meaningful inside character set regexps (e.g., `[aeiou]'). (This is actually typical for regexp syntax.) 59: How do I perform a replace operation across more than one file? The "tags" feature of Emacs includes the command tags-query-replace which performs a query-replace across all the files mentioned in the TAGS file. See `Tags:Tags Search' in the on-line manual. In addition, Martin Boyer has written a package named global-replace which will perform a query-replace across all the files mentioned in the *compilation* buffer (usually done after a `grep'), which is available via anonymous FTP: /ireq-robot.hydro.qc.ca:pub/emacs/lisp/compile.el.z /ireq-robot.hydro.qc.ca:pub/emacs/lisp/global-replace.el.z /ireq-robot.hydro.qc.ca:pub/emacs/lisp/query.el.z NOTE: These files are compressed using GNU zip ("gzip"); you can get a copy from gzip from prep and its mirrors (see question 80). 60: Where is the documentation for `etags'? The `etags' man page should be in the same place as the `emacs' man page. Quick command-line switch descriptions are also available. For example, `etags -H'. Bugs/Problems 61: Does Emacs have problems with files larger than 8 megabytes? [This problem has been solved better in Emacs 19.29 because the buffer size limit is now 16 times as large.] Most installed versions of GNU Emacs will use 24-bit signed integers (and 24-bit pointers) internally. This limits the file size that Emacs can handle to 8,388,607 bytes (2^23 - 1). Leonard N. Zubkoff suggests putting the following two lines in src/config.h before compiling Emacs to allow for 26-bit integers and pointers (and thus filesizes of up to 33,554,431 bytes): #define VALBITS 26 #define GCTYPEBITS 5 WARNING: This method may result in `ILLEGAL DATATYPE' and other random errors on some machines. David Gillespie gives an explanation of why Emacs uses 24 bit integers and pointers: Emacs is largely written in a dialect of Lisp; Lisp is a freely-typed language in the sense that you can put any value of any type into any variable, or return it from a function, and so on. So each value must carry a "tag" along with it identifying what kind of thing it is, e.g., integer, pointer to a list, pointer to an editing buffer, and so on. Emacs uses standard 32-bit integers for data objects, taking the top 8 bits for the tag and the bottom 24 bits for the value. So integers (and pointers) are somewhat restricted compared to true C integers and pointers. Emacs uses 8-bit tags because that's a little faster on byte-oriented machines, but there are only really enough tags to require 6 bits. 62: How do I get rid of the ^M junk in my shell buffer? Try typing "M-x shell-strip-ctrl-m RET" while in shell-mode to make them go away. If that doesn't work, you have several options: For tcsh, put this in your `.cshrc' (or `.tcshrc') file: if ($?EMACS) then if ("$EMACS" == t) then if ($?tcsh) unset edit stty nl endif endif Or put this in your .emacs_tcsh file: unset edit stty nl Alternatively, use csh in your shell buffers instead of tcsh. One way is: (setq explicit-shell-file-name "/bin/csh") and another is to do this in your .cshrc (or .tcshrc) file: setenv ESHELL /bin/csh (You must start Emacs over again with the environment variable properly set for this to take effect.) 63: Why do I get `Process shell exited abnormally with code 1'? The most likely reason for this message is that the `env' program is not properly installed. Compile this program for your architecture, and install it with a+x permission in the architecture-dependent Emacs program directory. (You can find what this directory is at your site by inspecting the value of the variable exec-directory by typing "C-h v exec-directory RET".) You should also check for other programs named `env' in your path (e.g., SunOS has a program named /usr/bin/env). We don't understand why this can cause a failure and don't know a general solution for working around the problem in this case. The `make clean' command will remove `env' and other vital programs, so be careful when using it. It has been reported that this sometimes happened when Emacs was started as an X client from an xterm window (i.e., had a controlling tty) but the xterm was later terminated. See also PROBLEMS (in the top-level directory when you unpack the Emacs source) for other possible causes of this message. 64: Where is the termcap/terminfo entry for terminal type `emacs'? The termcap entry for terminal type `emacs' is ordinarily put in the TERMCAP environment variable of subshells. It may help in certain situations (e.g., using rlogin from shell buffer) to add an entry for `emacs' to the system-wide termcap file. Here is a correct termcap entry for `emacs': emacs:tc=unknown: To make a terminfo entry for `emacs', use `tic' or `captoinfo'. You need to generate /usr/lib/terminfo/e/emacs. It may work to simply copy /usr/lib/terminfo/d/dumb to /usr/lib/terminfo/e/emacs. Having a termcap/terminfo entry will not enable the use of full screen programs in shell buffers. Use M-x terminal-emulator for that instead. A workaround to the problem of missing termcap/terminfo entries is to change terminal type `emacs' to type `dumb' or `unknown' in your shell start up file. `csh' users could put this in their .cshrc files: if ("$term" == emacs) set term=dumb 65: Why does Emacs spontaneously start displaying `I-search:' and beeping? Your terminal (or something between your terminal and the computer) is sending C-s and C-q for flow control, and Emacs is receiving these characters and interpreting them as commands. (The C-s character normally invokes the isearch-forward command.) For possible solutions, see question 110. 66: Why can't Emacs talk to certain hosts (or certain hostnames)? The problem may be that Emacs is linked with a wimpier version of gethostbyname than the rest of the programs on the machine. This is often manifested as a message on startup of `X server not responding. Check your DISPLAY environment variable.' or a message of `Unknown host' from open-network-stream. On a Sun, this may be because Emacs had to be linked with the static C library. The version of gethostbyname in the static C library may only look in /etc/hosts and the NIS (YP) maps, while the version in the dynamic C library may be smart enough to check DNS in addition to or instead of NIS. On a Motorola Delta running System V R3.6, the version of gethostbyname in the standard library works, but the one that works with NIS doesn't (the one you get with -linet). Other operating systems have similar problems. Try these options: * Explicitly add the host you want to communicate with to /etc/hosts. * Relink Emacs with this line in src/config.h: #define LIBS_SYSTEM -lresolv * Replace gethostbyname and friends in libc.a with more useful versions such as the ones in libresolv.a. Then relink Emacs. * If you are actually running NIS, make sure that `ypbind' is properly told to do DNS lookups with the correct command line switch. * Use tcp.el and tcp.c from Gnus. This has the additional advantage that you can use numeric IP addresses instead of names. open-network-stream currently can't handle numeric addresses. Brian Thomson has a enhancement to open-network-stream to allow it to handle numeric addresses. 67: Why does Emacs say `Error in init file'? An error occurred while loading either your .emacs file or the system-wide lisp/default.el file. For information on how to debug your .emacs file, see question 27. It may be the case that you may need to load some package first, or use a hook that will be evaluated after the package is loaded. A common case of this is explained in question 106. 68: Why does Emacs ignore my X resources (my .Xdefaults file)? As of version 19, Emacs 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. 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. 69: Why does Emacs take 20 seconds to visit a file? The usual cause is that the master lock file, `!!!SuperLock!!!' has been left in the lock directory somehow. Delete it. Mark Meuer says that NeXT NFS has a bug where an exclusive create succeeds but returns an error status. This can cause the same problem. Since Emacs's file locking doesn't work over NFS anyway, the best solution is to recompile Emacs with CLASH_DETECTION undefined. 70: How do I edit a file with a `$' in its name? When entering a filename in the minibuffer, Emacs will attempt to expand a `$' followed by a word as an environment variable. To suppress this behavior, type "$$" instead. 71: Why does shell mode lose track of the shell's current directory? Emacs has no way of knowing when the shell actually changes its directory. This is an intrinsic limitation of Unix. So it tries to guess by recognizing `cd' commands. If you type `cd' followed by a directory name with a variable reference (`cd $HOME/bin') or with a shell metacharacter (`cd ../lib*'), Emacs will fail to correctly guess the shell's new current directory. A huge variety of fixes and enhancements to shell mode for this problem have been written to handle this problem. Check the Lisp Code Directory (see question 77). You can tell Emacs the shell's current directory with the command "M-x dirs". 72: Are there any security risks in GNU Emacs? * the `movemail' incident (No, this is not a risk.) In his book "The Cuckoo's Egg," Cliff Stoll describes this in chapter 4. The site at LBL had installed the `etc/movemail' program setuid root. (As of version 19, movemail is in your architecture-specific directory; type "C-h v directory RET" to see what it is.) Since `movemail' had not been designed for this situation, a security hole was created and users could get root privileges. `movemail' has since been changed so that even if it is installed setuid root this security hole will not be a result. We have heard unverified reports that the Internet worm took advantage of this configuration problem. * the file-local-variable feature (Yes, a risk, but easy to change.) There is an Emacs feature that allows the setting of local values for variables when editing a file by including specially formatted text near the end of the file. This feature also includes the ability to have arbitrary Emacs Lisp code evaluated when the file is visited. Obviously, there is a potential for Trojan horses to exploit this feature. If you set the variable inhibit-local-variables to a non-nil value, Emacs will display the special local variable settings of a file that you visit and ask you if you really want them. This variable is not mentioned in the manual. It is wise to do this in lisp/site-init.el before building Emacs: (setq inhibit-local-variables t) If Emacs has already been built, the expression can be put in lisp/default.el instead, or an individual can put it in their own .emacs file. The ability to exploit this feature by sending e-mail to an Rmail user was fixed sometime after Emacs 18.52. However, any new package that uses find-file or find-file-noselect has to be careful about this. For more information, see `File Variables' in the on-line manual (which, incidentally, does not describe how to disable the feature). * synthetic X events (Yes, a risk, use MIT-MAGIC-COOKIE-1 or better.) Emacs accepts synthetic X events generated by the SendEvent request as though they were regular events. As a result, if you are using the trivial host-based authentication, other users who can open X connections to your X workstation can make your Emacs process do anything, including run other processes with your privileges. The only fix for this is to prevent other users from being able to open X connections. The standard way to prevent this is to use a real authentication mechanism, such as MIT-MAGIC-COOKIE-1. If using the `xauth' program has any effect, then you are probably using MIT-MAGIC-COOKIE-1. Your site may be using a superior authentication method; ask your system administrator. If real authentication is not a possibility, you may be satisfied by just allowing hosts access for brief intervals while you start your X programs, then removing the access. This reduces the risk somewhat by narrowing the time window when hostile users would have access, but DOES NOT ELIMINATE THE RISK. Difficulties Building/Installing/Porting Emacs 73: What should I do if I have trouble building Emacs? First look in the file PROBLEMS (in the top-level directory when you unpack the Emacs source) to see if there is already a solution for your problem. Next check the FAQ (you're reading it). If you don't find a solution, then report your problem via e-mail to bug-gnu-emacs@prep.ai.mit.edu. Please do not post it to gnu.emacs.help or e-mail it to help-gnu-emacs@prep.ai.mit.edu. For further guidelines, see question 8. 74: How do I stop Emacs from failing when the executable is stripped? Don't do that. This problem has been reported on SGI Indigo machines running Irix 4.0.* and RS/6000 machines. Scott Henry posted a patch that fixes the problem for Irix. 75: Why does linking Emacs with -lX11 fail? Emacs needs to be linked with the static version of the X11 library, libX11.a. This may be missing. Under OpenWindows, you may need to use `add_services' to add the `OpenWindows Programmers' optional software category from the CD-ROM. Under HP-UX 8.0, you may need to run `update' again to load the X11-PRG `fileset'. This may be missing even if you specified `all filesets' the first time. If libcurses.a is missing, you may need to load the `Berkeley Development Option' {???}. If you are building the MIT X11 sources, you may need to modify your `site.cf' file to get static versions of the libraries. (Info from David Zuhn .) Other systems may have similar problems. You can always define CANNOT_DUMP and link with the shared libraries instead. To get the Xmenu stuff to work, you need to find a copy of MIT's liboldX.a. Finding/Getting Emacs and Related Packages 76: Where can I get GNU Emacs on the net (or by snail mail)? Look in the files etc/DISTRIB and etc/FTP for information on nearby archive sites and etc/ORDERS for mail orders. If you don't already have GNU Emacs, see question 20 for how to get these files. The latest version is always available via anonymous FTP at MIT: /prep.ai.mit.edu:pub/gnu/emacs-19.27.tar.gz See question 80 for information on where to get other GNU software. 77: How do I find a GNU Emacs Lisp package that does XXX? A listing of Emacs Lisp packages, called the Lisp Code Directory, is being maintained by Dave Brennan . You can search through this list to learn if someone has written something that fits your needs. This list is file LCD-datafile.Z in the Emacs Lisp Archive (see the next question for retrieval instructions). The files lispdir.el.Z and lispdir.doc in the archive contain Lisp code and information to help you use the list. Once you have installed lispdir.el and LCD-datafile, then you can use the `M-x lisp-dir-apropos' command to search the listing. For example, the command `M-x lisp-dir-apropos RET ange-ftp RET' produces this output: GNU Emacs Lisp Code Directory Apropos -- "ange-ftp" "~/" refers to archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/ ange-ftp (4.18) 15-Jul-1992 Andy Norman, ~/packages/ange-ftp.tar.Z transparent FTP Support for GNU Emacs auto-save (1.19) 01-May-1992 Sebastian Kremer, ~/misc/auto-save.el.Z Safer autosaving with support for ange-ftp and /tmp ftp-quik (1.0) 28-Jul-1993 Terrence Brannon, ~/modes/ftp-quik.el.Z Quik access to dired'ing of ange-ftp and normal paths 78: Where can I get GNU Emacs Lisp packages that don't come with Emacs? First, check the Lisp Code Directory to find the name of the package you are looking for (see question 77). Next, check local archives and the Emacs Lisp Archive to find a copy of the relevant files. If you still haven't found it, you can send e-mail to the author asking for a copy. You can access the Emacs Lisp Archive via anonymous FTP: /archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/ /ftp.cs.umn.edu:pub/elisp-archive/ /calypso-2.oit.unc.edu:pub/gnu/elisp-archive/ /ftp.uu.net:packages/gnu/emacs-lisp/ /gatekeeper.dec.com:pub/GNU/elisp-archive/ /nic.switch.ch:mirror/elisp-archive/ /ftp.diku.dk:pub/elisp-archive/ /quepasa.cs.tu-berlin.de:pub/gnu/elisp/ /faui43.informatik.uni-erlangen.de:pub/gnu/elisp-archive/ /ftp.uni-mainz.de:pub/gnu/elisp-archive/ /nic.funet.fi:pub/gnu/emacs/elisp-archive/ /src.doc.ic.ac.uk:gnu/EmacsBits/elisp-archive/ Retrieve and read the file README first. NOTE: * The archive maintainers do not have time to answer individual requests for packages or the list of packages in the archive. If you cannot use FTP or UUCP to access the archive yourself, try to find a friend who can, but please don't ask the maintainers. * Any files with names ending in `.Z', `.z', or `.gz' are compressed, so you should use `binary' mode in FTP to retrieve them. You should also use binary mode whenever you retrieve any files with names ending in `.elc'. 79: How do I submit code to the Emacs Lisp Archive? Guidelines and procedures for submission to the archive can be found in the file GUIDELINES in the archive directory (see question 78). It covers documentation, copyrights, packaging, submission, and the Lisp Code Directory Record. Anonymous FTP uploads are not permitted. Instead, all submissions are mailed to elisp-archive@cis.ohio-state.edu. The lispdir.el package has a function named submit-lcd-entry which will help you with this. 80: Where can I get other up-to-date GNU stuff? The most up-to-date official GNU stuff is normally kept on prep.ai.mit.edu and is available for anonymous FTP in the pub/gnu directory. Read the files etc/DISTRIB and etc/FTP for more information (see question 20 for retrieval instructions). The following sites are all mirror images of the GNU distribution area: /col.hp.com:mirrors/gnu/ /ftp.uu.net:packages/gnu/ /ftp.win.tue.nl:pub/gnu/ /gatekeeper.dec.com:pub/GNU/ /nic.funet.fi:pub/gnu/ /src.doc.ic.ac.uk:gnu/ (available via FTP, NIFTP, FTAM) /utsun.s.u-tokyo.ac.jp:ftpsync/prep/ /wuarchive.wustl.edu:systems/gnu/ The directory at ftp.uu.net is a mirror of prep.ai.mit.edu:pub/gnu, except that files larger than one megabyte are split into multiple parts. If you have trouble transferring large files, you should try here. A file normally named `XXX' is split into files XXX-split/part[0-9][0-9], and there will be a file named XXX-split/README which contains the list of parts (especially helpful when FTP-ing by e-mail), their checksums, and reassembly instructions. 81: What is the difference between Emacs and Epoch? Epoch was a modified version of GNU Emacs. It was merged into XEmacs (formerly "Lucid Emacs"), and the Epoch redisplay, now being totally rewritten, is slated to be merged into Emacs when the rewrite is done. 82: What is the difference between Emacs and XEmacs (formerly "Lucid Emacs")? XEmacs is a modified version of GNU Emacs. A comparison between the two versions, written by the XEmacs maintainers, had been included here. Richard Stallman removed it from this copy of the FAQ because it was unfair. It was (1) one-sided, listing only advantages of XEmacs and not advantages of the principal version of Emacs, (2) biased, stating the opinions of the XEmacs maintainers, and (3) out of date, listing as advantages of XEmacs features which in fact both versions have. 83: Where can I get Emacs for my PC running MS-DOS? Recent releases of GNU Emacs 19 should compile right out of the box on PCs with a 386 or better, running MS-DOS 3.0 or later. You will need the following: Compiler: djgpp version 1,11 maint 4 or later. You can get the latest version by grabbing everything in the following directory (using anonymous ftp): oak.oakland.edu:pub/msdos/djdpp Tar: One DOS version of tar is available via anonymous ftp from ftp.urc.tue.nl:pub/unixtools/dos However, not all DOS versions of tar work equally well, so you might have to try others if this one gives you trouble. Utilities: chmod, make, mv, sed, rm. All of these utilities are available via anonymous ftp from the site ftp.iro.umontreal.ca:pub/Internet/gnuish You should grab the files futil4ax.zoo (contains chmod.exe, mv.exe, and rm.exe), sed106ax.zoo (contains sed.exe), and gzip07ax.zoo (contains gzip.exe). The file etc/MSDOS contains some information on the differences between the Unix and MS-DOS versions of GNU Emacs. If you would prefer not to compile Emacs by yourself, you can get binaries for Emacs 19.24 via anonymous ftp from the following two sites: ftp.demon.co.uk:pub/ibmpc/editors/emacs19.24 ftp.imada.ou.dk:pub/mirrors/msdos/emacs-19.24 You might also be interested in Demacs, which runs under MS-DOS (*not* Microsoft Windows; see question 84) on 386- and 486-based PCs. Demacs is a port of Nemacs (see question 126), rather than a straight port of GNU Emacs 18 or 19. Demacs was developed using an MS-DOS version of gcc called djgpp by D. J. Delorie which can compile and run large programs under MS-DOS, but not under MS Windows. Demacs was derived from Nemacs rather than straight from GNU Emacs. You can get the most recent version of Demacs via anonymous ftp from ftp.sigmath.osaka-u.ac.jp in pub/Msdos/Demacs/*. For a list of other MS-DOS implementations of Emacs (and Emacs look-alikes), consult the list of "Emacs implementations and literature," available via anonymous ftp from rtfm.mit.edu in pub/usenet/comp.emacs. 84: Where can I get Emacs for my PC running Microsoft Windows? There are currently two ports of Emacs that runs under Microsoft Windows: * Oemacs Current version of Oemacs4.1 is based on Emacs-19.19 and runs in either MS-DOS or Microsoft Windows. There is rumor that the author Darryl Okahata would not update unless there is demonstrated interest. It is nearly a full porting of GNU Emacs except that shell-mode does not work due to the limitation of MS-DOS. Anonymous ftp information: /oak.oakland.edu:pub/msdos/oemacs/ * The other uses a proprietary X Windows emulator and therefore the FSF does not think it deserves publicity. 85: Where can I get Emacs for my PC running OS/2? Emacs 19.27 is ported for emx on OS/2 2.0 or 2.1. Anonymous FTP info: hobbes.nmsu.edu:os2/2_x/unix/emacs27 86: Where can I get Emacs for my Atari ST? (does anyone know?) 87: Where can I get Emacs for my Amiga? Amiga software is available through Aminet, a set of interconnected FTP sites and other file accessing services for Amiga software. The primary sites for Aminet are ftp.wustl.edu (128.252.135.4) and ftp.cdrom.com (192.153.46.2). In the directory pub/aminet/util/gnu, there are a1.26-emacs-bin.lha -- Amiga GNU Emacs V1.26, binaries a1.26-emacs-src.lha -- Amiga GNU Emacs V1.26, sources There are also quite a few Emacs related files/programs. Please search the index of Aminet. We have no access to an Amiga, so please send in your experience and comments on the implementation. 88: Where can I get Emacs for my Apple computer? The FSF is a participant in a boycott of Apple because of Apple's "look and feel" copyright suits. See the file etc/APPLE for more details. Because of this boycott, the FSF doesn't include support in GNU software for Apple computers such as the Macintosh. Please don't help people port or develop software for Apple computers. 89: Where do I get Emacs that runs on VMS under DECwindows? Version 19.27 has a VMS directory containing installation instructions, a makefile, and various .com files. But according to Richard Levitte , it does not run out of the box. Even if it does, the VMSNOTES indicates that the Emacs on VMS is going to have much more limited functionality. Richard Levitte has a patched 19.22 that supposedly has subprocess and networking functionality just as on Unix, with virtually the same lisp interface. The source is available via anonymous ftp at ftp.vms.stacken.kth.se:GNU-VMS/Beta/EMACS-19_22-********.TAR-GZ where ******** is the release date of the kit. You should also read http://www.e.kth.se/elev/levitte/gnu/emacs.html for more information. 90: Where can I get modes for Lex, Yacc/Bison, Bourne shell, Csh, C++, Objective C, Pascal, and Awk? Most of these modes are now available in standard Emacs distribution. To get additional modes, look in the Lisp Code Directory (see question 77). For C++, if you use lisp-dir-apropos, you must specify the pattern like this: M-x lisp-dir-apropos RET c\+\+ RET Note that Barry Warsaw's cc-mode now works for C, C++, and Objective-C code. You can get the latest version (4.85, as of this writing) from the Emacs Lisp Archive. 91: What is the IP address of XXX.YYY.ZZZ? If you are at a site with a deficient nameserver, you may need to know the IP address of a host to FTP files from it. You can get this information in two ways: * By telnet: telnet nic.ddn.mil hostnames (or `telnet 192.112.36.5 101') @ whois Whois: host XXX.YYY.ZZZ * By e-mail: To: service@nic.ddn.mil Subject: host XXX.YYY.ZZZ or: whois XXX.YYY.ZZZ or: help or: To: resolve@cs.widener.edu body: site XXX.YYY.ZZZ Information from Brendan Kehoe . Major Emacs Lisp Packages, Emacs Extensions, and Related Programs This section lists version numbers, FTP sites, mailing lists, newsgroups, and other information for many important packages, extensions, and related programs. There is some overlap with the Lisp Code Directory, but these entries give more detailed information. If you know of any other packages that are so substantial that they deserve to be mentioned here, please let us know. Having its own mailing list or newsgroup or more than half a megabyte of source code are good signs. 92: VM (View Mail) -- another mail reader within Emacs Author: Kyle Jones Latest version: 5.72 (beta) Anonymous FTP: /ftp.uu.net:networking/mail/vm-5.72beta.tar.gz Newsgroups and mailing lists: Info-VM: gnu.emacs.vm.info (newsgroup) info-vm-request@uunet.uu.net (for subscriptions) info-vm@uunet.uu.net (for submissions) Bug-VM: gnu.emacs.vm.bug (newsgroup) bug-vm-request@uunet.uu.net (for subscriptions) bug-vm@uunet.uu.net (for submissions) 93: Supercite -- mail and news citation package within Emacs Author: Barry Warsaw Latest version: 3.54 (comes with GNU Emacs 19) 3.1 (available from the Emacs Lisp Archive) Anonymous FTP: /archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/sc3.1.tar.Z Mailing list: supercite-request@anthem.nlm.nih.gov (for subscriptions) supercite@anthem.nlm.nih.gov (for submissions) NOTE: Superyank is an old version of Supercite. 94: Gnus -- news reader within Emacs Author: Masanobu Umeda Latest version: 4.1 (comes with GNU Emacs 19) Anonymous FTP: /src.doc.ic.ac.uk:gnu/EmacsBits/elisp-archive/packages/gnus-4.1.tar.Z /archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/gnus-4.1.tar.Z Newsgroups and mailing lists: English-only: gnu.emacs.gnus (newsgroup) info-gnus-english-request@cis.ohio-state.edu (for subscriptions) info-gnus-english@cis.ohio-state.edu (for submissions) Japanese (and some English): info-gnus-request@flab.fujitsu.co.jp (for subscriptions) info-gnus@flab.fujitsu.co.jp (for submissions) 95: Calc -- poor man's Mathematica within Emacs Author: Dave Gillespie Latest version: 2.02c Anonymous FTP: /prep.ai.mit.edu:pub/gnu/calc-2.02c.tar.gz NOTE: Unlike Wolfram Research, Dave has never threatened to sue anyone for having a program with a similar command language to Calc. :-) 96: Ange-FTP -- transparent FTP access for Emacs's file access routines Author: Andy Norman Latest version: 1.56 (comes with GNU Emacs 19) Anonymous FTP: /archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/ange-ftp.tar.Z Mailing lists: Ange-FTP Lovers: ange-ftp-lovers-request@anorman.hpl.hp.com (for subscriptions) ange-ftp-lovers@anorman.hpl.hp.com (for submissions) /ftp.reed.edu:pub/mailing-lists/ange-ftp/ (archives) Ange-FTP Announcements: ange-ftp-lovers-announce@anorman.hpl.hp.com NOTE: now supports VMS, CMS, and MTS ftp servers 97: VIP -- vi emulation for Emacs Author: Aamod Sane Latest version: 4.3 Anonymous FTP: /cs.uiuc.edu:pub/vip4.3.tar.Z /archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/modes/vip-mode.tar.Z NOTE: This version much more closely emulates vi than the one distributed with Emacs. 98: AUC TeX -- enhanced LaTeX mode with debugging facilities Author: Kresten Krab Thorup Latest version: 9.1i Anonymous FTP: /iesd.auc.dk:pub/emacs-lisp/auctex-9.1i.tar.gz Mailing list: auc-tex-request@iesd.auc.dk (for subscriptions) auc-tex@iesd.auc.dk (for submissions) auc-tex_mgr@iesd.auc.dk (auc-tex development team) 99: Hyperbole -- extensible hypertext management system within Emacs Author: Bob Weiner Latest version: 3.15 Anonymous FTP: /wilma.cs.brown.edu:pub/hyperbole/h3.15.tar.Z Mailing lists: hyperbole-announce -- Hyperbole release announcements only. Subscriptions: To: hyperbole-request@cs.brown.edu Subject: Add to hyperbole-announce hyperbole -- Hyperbole discussion. Subscriptions: To: hyperbole-request@cs.brown.edu Subject: Add to hyperbole Submissions: hyperbole@cs.brown.edu NOTE: Any member of the hyperbole mailing list is automatically a member of the hyperbole-announce mailing list. NOTE: No .UUCP or ! addresses are allowed on these mailing lists. 100: BBDB -- personal Info Rolodex integrated with mail/news readers Author: Jamie Zawinski Latest released version: 1.50 Anonymous FTP: /archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/bbdb-1.50.tar.Z Mailing lists: info-bbdb-request@cs.uiuc.edu (for subscriptions) info-bbdb@cs.uiuc.edu (for submissions) bbdb-announce-request@cs.uiuc.edu (to be informed of new releases) NOTE: BBDB does not work with VM 4. It does work with VM 5, Rmail, Gnus, and MH-E. 101: Ispell -- spell checker in C with interface for Emacs Author: Geoff Kuenning Latest released version: 3.1.08 Anonymous FTP: Master Sites: /ftp.cs.ucla.edu:pub/ispell/ispell-3.1.08.tar.gz /ftp.math.orst.edu:pub/ispell/ispell-3.1.08.tar.gz Known Mirror Sites: (only directory names shown) /ftp.th-darmstadt.de:pub/dicts/ispell/ /ftp.nl.net:pub/textproc/ispell/ NOTE: * Do not ask Geoff to send you the latest version of Ispell. He does not have free e-mail. * This Ispell program is distinct from GNU Ispell 4.0. GNU Ispell 4.0 is no longer a supported product. 102: XEmacs -- alternative Emacs 19 with better X interface; formerly known as Lucid Emacs or lemacs. Primary Maintainer: Chuck Thompson Other Developers: Ben Wing Richard Mlynarik Jamie Zawinski Latest released version: 19.11 Anonymous FTP: /ftp.cs.uiuc.edu:pub/xemacs/xemacs-19.11.tar.gz Newsgroup and mailing lists: Bugs: alt.lucid-emacs.bug bug-lucid-emacs-request@cs.uiuc.edu (for subscriptions) bug-lucid-emacs@cs.uiuc.edu (for submissions) Help: alt.lucid-emacs.help help-lucid-emacs-request@cs.uiuc.edu (for subscriptions) help-lucid-emacs@cs.uiuc.edu (for submissions) NOTE: The XEmacs FAQ is available via the World-Wide Web at URL http://xemacs.cs.uiuc.edu/. 103: Patch -- program to apply "diffs" for updating files Author: Larry Wall Latest version: 2.1 Anonymous FTP: /prep.ai.mit.edu:pub/gnu/patch-2.1.tar.gz /ftp.funet.fi:pub/gnu/patch-2.1.tar.gz /ftp.uni-stuttgart.de:pub/unix/gnu/patch-2.1.tar.gz NOTE: See question 80 for other GNU distribution sites. Changing Key Bindings and Handling Key Binding Problems 104: How do I bind keys (including function keys) to commands? Keys can be bound to commands either interactively or by predefinition (e.g. in the .emacs file). To interactively bind keys for all modes, type `M-x global-set-key RET KEY CMD RET'; for the current major mode only, type `M-x local-set-key RET KEY CMD RET' (see the Emacs on-line documentation for further details). To bind keys on starting Emacs or on starting any given mode, you can use the following "trick." First bind the key interactively, then immediately afterwards type `C-x ESC ESC C-a C-k C-g'. Now, the command needed to bind the key is in the kill ring and can be yanked into the .emacs file. If the key binding is global, no changes to the command are required. For example, (global-set-key (quote [f1]) (quote help-for-help)) can be place directly into the .emacs file. If the key binding is local, the command is used in conjunction with the `add-hook' command. For example, in tex-mode, a local binding might be (add-hook 'tex-mode-hook (function (lambda () (local-set-key (quote [f1]) (quote help-for-help)))) NOTE: * Control characters in key sequence position of the form yanked from the kill ring are given in their graphic form - i.e. CTRL is shown as `^', TAB as a set of spaces (usually 8), etc. You may want to convert these into their vector or string forms. * If some prefix key of the character sequence to be bound is already bound as a complete key, then you must unbind it before the new binding. For example, if `ESC {' is previously bound: (global-unset-key [?\e ?{]) ;; or (local-unset-key [?\e ?{]) * Aside from commands and "lambda lists," a vector or string also can be bound to a key and thus treated as a macro. For example: (global-set-key [f10] [?\C-x?\e?\e?\C-a?\C-k?\C-g]) ;; or (global-set-key [f10] "\C-x\e\e\C-a\C-k\C-g") See `Key Bindings' in the Emacs on-line documentation for further details. 105: Why does Emacs say `Key sequence XXX uses invalid prefix characters'? Usually one of two things has happened. In one case, the control character in the key sequence has been misspecified (e.g. `C-f' used instead of `\C-f' within a Lisp expression). In the other case, a "prefix key" in the keystroke sequence you were trying to bind was already bound as a "complete key." Historically, the `ESC [' prefix was usually the problem, in which case you should evaluate either of these forms before attempting to bind the key sequence: (global-unset-key [?\e ?[]) ;; or (global-unset-key "\e[") 106: Why doesn't this [terminal or window-system setup] code work in my .emacs file, but it works just fine after Emacs starts up? During startup, Emacs initializes itself according to a given code/file order. If some of the code executed in your .emacs file needs to be postponed until the initial terminal or window-system setup code has been executed but is not, then you will experience this problem (this code/file execution order is not enforced after startup). To postpone the execution of Emacs Lisp code until after terminal or window-system setup, treat the code as a "lambda list" and set the value of either the `term-setup-hook' or `window-setup-hook' variable to this "lambda function." For example, (setq term-setup-hook (function (lambda () (cond ((string-match "\\`vt220" (or (getenv "TERM") "")) ;; Make vt220's "Do" key behave like M-x: (global-set-key [do] 'execute-extended-command)) )))) For information on what Emacs does every time it is started, see the lisp/startup.el file. 107: How do I use function keys under X Windows? With Emacs 19, functions keys under X are bound like any other key. See question 104 for details. 108: How do I tell what characters or symbols my function or arrow keys emit? Put the following in your .emacs file and type `M-x see-chars' to use: (defun see-chars () "Display events received, terminated by a 3-second timeout." (interactive) (let (chars (inhibit-quit t)) (message "Enter characters or other events, terminated by a 3-second timeout.") (while (not (sit-for 3)) (setq chars (nconc chars (list (read-event))) quit-flag nil) ; quit-flag might be set by C-g. (if (not (input-pending-p)) (message "Events received until now: %s..." (key-description chars)))) (message "Events received: %s" (key-description chars)))) Alternatively, type "C-h c" then the function or arrow keys. The command will return either a function key symbol or character sequence (see the Emacs on-line documentation for an explanation). This works for other keys as well. 109: How do I set the X key "translations" for Emacs? Sorry, you can't; there are no "translations" to be set. Emacs is not written using the Xt library. The only way to affect the behavior of keys within Emacs is through `xmodmap' (outside Emacs) or `define-key' (inside Emacs). The `define-key' command should be used in conjunction with the `function-key-map' map. For instance, (define-key function-key-map [M-tab] [?\M-\t]) defines the `META TAB' key sequence. 110: How do I handle C-s and C-q being used for flow control? C-s and C-q are used in the XON/XOFF flow control protocol. This screws up Emacs because it binds these characters to commands. Also, by default Emacs will not honor them as flow control characters and may overwhelm output buffers. Sometimes, intermediate software using XON/XOFF flow control will prevent Emacs from ever seeing C-s and C-q. Possible solutions: * Disable the use of C-s and C-q for flow control. You need to determine the cause of the flow control. * your terminal Your terminal may use XON/XOFF flow control to have time to display all the characters it receives. For example, VT series terminals do this. It may be possible to turn this off from a setup menu. For example, on a VT220 you may select `No XOFF' in the setup menu. This is also true for some terminal emulation programs on PCs. When you turn off flow control at the terminal, you will also need to turn it off at the other end, which might be at the computer you are logged in to or at some terminal server in between. If you turn off flow control, characters may be lost; using a printer connected to the terminal may fail. You may be able to get around this problem by modifying the `termcap' entry for your terminal to include extra NUL padding characters. * a modem If you are using a dialup connection, the modems may be using XON/XOFF flow control. It's not clear how to get around this. * a router or terminal server Some network box between the terminal and your computer may be using XON/XOFF flow control. It may be possible to make it use some other kind of flow control. You will probably have to ask your local network experts for help with this. * tty and/or pty devices If your connection to Emacs goes through multiple tty and/or pty devices, they may be using XON/XOFF flow control even when it is not necessary. Eirik Fuller writes: Some versions of `rlogin' (and possibly telnet) do not pass flow control characters to the remote system to which they connect. On such systems, Emacs on the remote system cannot disable flow control on the local system. Sometimes `rlogin -8' will avoid this problem. One way to cure this is to disable flow control on the local host (the one running rlogin, not the one running rlogind) using the stty command, before starting the rlogin process. On many systems, `stty start u stop u' will do this. Some versions of `tcsh' will prevent even this from working. One way around this is to start another shell before starting rlogin, and issue the stty command to disable flow control from that shell. Use `stty -ixon' instead of `stty start u stop u' on some systems. * Make Emacs speak the XON/XOFF flow control protocol. You can make Emacs treat C-s and C-q as flow control characters by evaluating the form (enable-flow-control) to unconditionally enable flow control or (enable-flow-control-on "vt100" "h19") (using your terminal names instead of "vt100" or "h19") to enable selectively. These commands will automatically swap `C-s' and `C-q' to `C-\' and `C-^'. Variables can be used to change the default swap keys (`flow-control-c-s-replacement' and `flow-control-c-q-replacement'). If you are fixing this for yourself, simply put the form in your .emacs file. If you are fixing this for your entire site, the best place to put it is in the lisp/site-start.el file. Putting this form in lisp/default.el has the problem that if the user's .emacs file has an error, this will prevent lisp/default.el from being loaded and Emacs may be unusable for the user, even for correcting their .emacs file (unless they're smart enough to move it to another name). For further discussion of this issue, read the file PROBLEMS (in the top-level directory when you unpack the Emacs source). 111: How do I bind `C-s' and `C-q' (or any key) if these keys are filtered out? To bind `C-s' and `C-q', use either `enable-flow-control' or `enable-flow-control-on'. See question 110 for usage and implementation details. To bind other keys, use `keyboard-translate'. See question 114 for usage details. To do this for an entire site, you should swap the keys in lisp/site-start.el. See question 110 for an explanation of why lisp/default.el should not be used. NOTE: * If you do this for an entire site, the users will be confused by the disparity between what the documentation says and how Emacs actually behaves. 112: Why does the `Backspace' key invoke help? The `Backspace' key (on most keyboards) generates ASCII code 8. `C-h' sends the same code. In Emacs by default `C-h' invokes help-command. This is intended to be easy to remember since the first letter of "help" is "h." The easiest solution to this problem is to use `C-h' (and Backspace) for help and DEL (the Delete key) for deleting the previous character. For many people this solution may be problematic: * They normally use Backspace outside of Emacs for deleting the previous character typed. This can be solved by making DEL be the command for deleting the previous character outside of Emacs. This command will do this on many Unix systems: stty erase '^?' * The person may prefer using the Backspace key for deleting the previous character because it is more conveniently located on their keyboard or because they don't even have a separate Delete key. In this case, the Backspace key should be made to behave like Delete. There are several methods. * Some terminals (e.g., VT3## terminals) allow the character generated by the Backspace key to be changed from a setup menu. * You may be able to get a keyboard that is completely programmable. * Under X or on a dumb terminal, it is possible to swap the Backspace and Delete keys inside Emacs: (keyboard-translate ?\C-h ?\C-?) See question 114 for further details of `keyboard-translate'. * Another approach is to switch key bindings and put help on "C-x h" instead: (global-set-key [?\C-h] 'delete-backward-char) (global-set-key [?\C-x ?h] 'help-command) ;; overrides mark-whole-buffer Other popular key bindings for help are M-? and "C-x ?". NOTE: * Don't try to bind DEL to help-command, because there are many modes that have local bindings of DEL that will interfere. 113: Why doesn't Emacs look at the stty settings for Backspace vs. Delete? Good question! 114: How do I "swap" two keys? In Emacs 19, you can swap two keys (or key sequences) by using the `keyboard-translate' function. For example, to turn `C-h' into DEL and DEL to `C-h', use (keyboard-translate ?\C-h ?\C-?) ; translate `C-h' to DEL (keyboard-translate ?\C-? ?\C-h) ; translate DEL to `C-h'. The first key sequence of the pair after the function identifies what is produced by the keyboard; the second, what is matched for in the keymaps. Keyboard translations are not the same as key bindings in keymaps. Emacs contains numerous keymaps that apply in different situations, but there is only one set of keyboard translations, and it applies to every character that Emacs reads from the terminal. Keyboard translations take place at the lowest level of input processing; the keys that are looked up in keymaps contain the characters that result from keyboard translation. Also see `Keyboard Translations' in the on-line manual. 115: How do I produce C-XXX with my keyboard? On terminals (but not under X), some common "aliases" are: CTRL-2 or CTRL-SPC for C-@ CTRL-6 for C-^ CTRL-7 or CTRL-SHIFT-- for C-_ CTRL-4 for C-\ CTRL-5 for C-] CTRL-/ for C-? Often other aliases exist; use the `C-h c' command and try `CTRL' with all of the digits on your keyboard to see what gets generated. You can also try the `C-h w' command if you know the name of the command. 116: What if I don't have a Meta key? Instead of typing "M-a", you can type "ESC a". In fact, Emacs converts M-a internally into "ESC a" anyway (depending on the value of meta-prefix-char). Note that you press "Meta" and "a" together, while you press "ESC", release it, and then press "a". 117: What if I don't have an Escape key? Type "C-[" instead. This should send ASCII code 27 just like an Escape key would. "C-3" may also work on some terminal (but not under X). For many terminals (notably DEC terminals) "F11" generates the "ESC" key. If not, the following form can be used bind it: (define-key function-key-map [f11] [?\e]) ; F11 is the documented ESC ; replacement on DEC terminals. 118: Can I make my `Compose Character' key behave like a Meta key? On a dumb terminal such as a VT220, no. It is rumored that certain VT220 clones could have their Compose key configured this way. If you're using X, you might be able to do this with the `xmodmap' program. 119: How do I bind a combination of modifier key and function key? With Emacs 19 you can indicate modified function keys in vector format through multi-prefixing the function key symbol. For example (from the Emacs on-line documentation): (global-set-key [?\C-x right] 'forward-page) where "?\C-x" is the Lisp character constant for the character "C-x". You can use the modifier keys CTRL, META, HYPER, SUPER, ALT and SHIFT with function keys. To represent these modifiers, prepend the strings "C-", "M-", "H-", "s-", "A-" and "S-" to the symbol name. Thus, here is how to make "Hyper-Meta-RIGHT" move forward a word: (global-set-key [H-M-right] 'forward-word) NOTE: * Not all modifiers are permitted in all situations. HYPER, SUPER, and ALT are available only under X (provided there are such keys). Non-ASCII keys and mouse events (e.g. "C-=" and "mouse-1") also fall under this category. See question 104 for general key binding instructions. 120: Why doesn't my Meta key work in an xterm window? Try all of these methods before asking for further help: * You may have big problems using `mwm' as your window manager. {Does anyone know a good generic solution to allow the use of the Meta key in Emacs with mwm?} * For X11: Make sure it really is a Meta key. Use `xev' to find out what keysym your Meta key generates. It should be either Meta_L or Meta_R. If it isn't, use xmodmap to fix the situation. * Make sure the pty the xterm is using is passing 8 bit characters. `stty -a' (or `stty everything') should show `cs8' somewhere. If it shows `cs7' instead, use `stty cs8 -istrip' (or `stty pass8') to fix it. * If there is an rlogin connection between the xterm and the Emacs, the `-8' argument may need to be given to rlogin to make it pass all 8 bits of every character. * If the Emacs is running under Ultrix, it is reported that evaluating (set-input-mode t nil) helps. * If all else fails, you can make xterm generate "ESC W" when you type M-W, which is the same conversion Emacs would make if it got the M-W anyway. In X11R4, the following resource specification will do this: XTerm.VT100.EightBitInput: false (This changes the behavior of the insert-eight-bit action.) With older xterms, you can specify this behavior with a translation: XTerm.VT100.Translations: #override \ Meta: string(0x1b) insert() You might have to replace `Meta' with `Alt'. 121: Why doesn't my ExtendChar key work as a Meta key under HP-UX 8.0? This is a result of an internationalization extension in X11R4 and the fact that HP is now using this extension. Emacs assumes that XLookupString returns the same result regardless of the Meta key state which is no longer necessarily true. Until Emacs is fixed, the temporary kludge is to run this command after each time the X server is started but preferably before any xterm clients are: xmodmap -e 'remove mod1 = Mode_switch' NOTE: This will disable the use of the extra keysyms systemwide, which may be undesirable if you actually intend to use them. 122: Where can I get key bindings to make Emacs emulate WordStar? There is a package `wordstar' by Jim Frost located under the "misc" directory at the Emacs Lisp Archive. 123: Where can I get an XEDIT emulator for Emacs? This question comes up once every couple of months. Searing for "xedit" through most recent Lisp Code Directory fails to match any entries. Using Emacs with Alternate Character Sets 124: How do I make Emacs display 8-bit characters? GNU Emacs 19 has built-in support for 8-bit characters. Here is an excerpt from the `European Display' page of the on-line manual: Some European languages use accented letters and other special symbols. The ISO 8859 Latin-1 character set defines character codes for many European languages in the range 160 to 255. Emacs can display those characters according to Latin-1, provided the terminal or font in use supports them. The `M-x standard-display-european' command toggles European character display mode. With a numeric argument, `M-x standard-display-european' enables European character display if and only if the argument is positive. Some operating systems let you specify the language you are using by setting a locale. Emacs handles one common special case of this: if your locale name for character types contains the string `8859-1' or `88591', Emacs automatically enables European character display mode when it starts up. 125: How do I input 8-bit characters? Again, from the `European Display' page of the on-line manual: If you enter non-ASCII ISO Latin-1 characters often, you might find ISO Accents mode convenient. When this minor mode is enabled, the characters ``', `'', `"', `^', `/' and `~' modify the following letter by adding the corresponding diacritical mark to it, if possible. To enable or disable ISO Accents mode, use the command `M-x iso-accents-mode'. This command affects only the current buffer. To enter one of those six special characters, type the character, followed by a space. Some of those characters have a corresponding "dead key" accent character in the ISO Latin-1 character set; to enter that character, type the corresponding ASCII character twice. For example, `''' enters the Latin-1 character acute-accent (character code 0264). 126: Where can I get an Emacs that can handle kanji characters? Nemacs 3.3.2 (Nihongo GNU Emacs) is a modified version of GNU Emacs 18.55 that handles kanji characters. It is available via anonymous FTP: /crl.nmsu.edu:pub/misc/nemacs-3.3.2.tar.Z /ftp.cs.titech.ac.jp:pub/gnu-rel/nemacs/nemacs-3.3.2.tar.gz You might also need files for "wnn," a kanji input method (wnn-4.0.3{-README,.tar.Z} {on which machine?}). You need a terminal (or terminal emulator) that can display text encoded in JIS, Shift-JIS, or EUC (Extended Unix Code), or the ability to run Nemacs as a direct X Windows client. 127: Where can I get an Emacs that can handle Chinese? Cemacs by Stephen G. Simpson is a patch to Emacs 18.57 (the ctl-arrow patch) and some Emacs Lisp code that combined with Cxterm allows using Chinese characters. It is available via anonymous FTP: /cs.purdue.edu:pub/ygz/cemacs.tar.Z Cxterm, a patch to Emacs 18.57 that allows you to enter Chinese characters, is available from the same place: /cs.purdue.edu:pub/ygz/cxterm-11.5.1.tar.Z 128: Where is an Emacs that can handle Semitic (right-to-left) alphabets? Joel M. Hoffman writes: A couple of years ago a wrote a hebrew.el file that allows right-to-left editing of Hebrew. I relied on the hardware to display the Hebrew letters, given the right codes, but not for any right-to-left support; the hardware also doesn't have to send any specific char. codes. Emacs keeps track of when the user is typing Hebrew vs. English. (The VT-* terminals in Israel contain built-in support for Hebrew.) To get it to work I had to modify only a few lines of GNU Emacs's source code --- just enough to make it 8-bit clean. [and in a separate message:] It doesn't produce time-order ["sefer" format] (I wouldn't recommend trying that with Emacs, because converting time-order to screen-order with arbitrarily long lines is a bit tricky), but I also concocted a quick filter to convert screen-order into time-order. I'll be happy to send you the requisite files if you want them. If you're using it for anything large, however, you'll want something that works better. Joel Hoffman has also written a "bi-directional bi-lingual Emacs-like" editor for MS-DOS named Ibelbe (Itty Bitty Emacs-Like Bidirectional Editor). Ibelbe is written in Turbo Pascal and comes with source code. Here is the description: Ibelbe looks like Emacs (it even has a minibuffer and filename completion), and fully supports both right-to-left and left-to-right editing. Other than an EGA monitor or better, no special hardware is required. You will need an EGA Hebrew font to use Ibelbe with Hebrew. Anonymous FTP: /israel.nysernet.org:israel/computers/software/msdos/ibelbe.zip /israel.nysernet.org:israel/computers/software/msdos/hebfont.zip Joseph Friedman has written patches for Emacs 18.55 and 18.58 that provide Semitic language support under X Windows. Warren Burstein says he has mapped 7-bit keys by modifying self-insert-command "for Hebrew input on 7-bit keyboards." A good suggestion is to query archie for files named with `hebrew'. Mail and News 129: How do I change the included text prefix in mail/news followups? If you read mail with Rmail or news with Gnus, set the variable mail-yank-prefix. For VM, set vm-included-text-prefix. For mh-e, set mh-ins-buf-prefix. For fancier control of citations, use Supercite. See question 93. A related problem is how to prevent Emacs from including various headers of the replied-to message. For this, you should set the value of mail-yank-ignored-headers, which takes a regexp value. 130: How do I save a copy of outgoing mail? You can either mail yourself a copy by including a `BCC:' header in the mail message, or store a copy of the message directly to a file by including an `FCC:' header. If you use standard mail, you can automatically create a `BCC:' to yourself by putting (setq mail-self-blind t) in your .emacs. You can automatically include an `FCC:' field by putting something like the following in your .emacs file: (setq mail-archive-file-name (expand-file-name "~/outgoing")) The output file will be in Unix mail format, which can be read directly by VM, but not always by Rmail. See question 132. If you use mh-e add an FCC: or BCC: field to your components file. It does not work to put `set record filename' in the .mailrc file. 131: Why doesn't Emacs expand my aliases when sending mail? * You must separate multiple addresses in the headers of the mail buffer with commas. This is because Emacs supports RFC822 standard addresses like this one: To: Willy Smith However, you do not need to separate addresses with commas in your .mailrc file. WARNING: Emacs breaks up aliases in the .mailrc file into multiple addresses both on commas and on whitespace, regardless of any use of quotes. This is probably a bug. You can get around this by directly setting the value of mail-aliases. * Emacs normally only reads the `.mailrc' file once per session, when you start to compose your first mail message. If you edit .mailrc, you can type "M-ESC (build-mail-aliases) RET" to make Emacs reread .mailrc. (You have to include the parentheses where they are shown!) * Emacs does not interpret vendor-specific additions to the format of the .mailrc file such as the `source' command. It also ignores any `set' commands. The only commands it looks at are `alias' and `group' commands. * If you like, you can expand mail aliases as abbrevs, as soon as you type them in. To enable this feature, execute the following: (add-hook 'mail-setup-hook 'mail-abbrevs-setup) 132: Why does Rmail think all my saved messages are one big message? A file created through the FCC: field in a message is in Unix Mail format, not the format that Rmail uses (BABYL format). Rmail will try to convert a Unix mail file into BABYL format on input, but sometimes it makes errors. For guaranteed safety, you can make the saved- messages file be an inbox for your Rmail file by using the function set-rmail-inbox-list. 133: How can I sort the messages in my Rmail folder? In Rmail, type C-c C-s C-h to get a list of sorting functions and their key bindings. 134: Why does Rmail need to write to /usr/spool/mail? This is the behavior of the `movemail' program which Rmail uses. This indicates that movemail is configured to use lock files. RMS writes: Certain systems require lock files to interlock access to mail files. On these systems, movemail must write lock files, or you risk losing mail. You simply must arrange to let movemail write them. Other systems use the flock system call to interlock access. On these systems, you should configure movemail to use flock. 135: How do I recover my mail files after Rmail munges their format? If you have just done rmail-input on a file and you don't want to save it in Rmail's format (called BABYL), just kill the buffer (with C-x k). If you typed M-x rmail and it read some messages out of your inbox and you want to put them in a Unix mail file, use C-o on each message. If you want to convert an existing file from BABYL format to Unix mail format, use the command M-x unrmail: it will prompt you for the input and output file names. 136: How do I make Emacs automatically start my mail/news reader? To start Emacs in Gnus: emacs -f gnus in Rmail: emacs -f rmail A more convenient way to start with Gnus: alias gnus 'emacs -f gnus' gnus It is probably unwise to automatically start your mail or news reader from your .emacs file. This would cause problems if you needed to run two copies of Emacs at one time. Also, this would make it difficult for you to start Emacs quickly when you needed to. 137: How do I read news under Emacs? Use M-x gnus. It is documented in Info (see question 14). 138: Why doesn't Gnus work via NNTP? There is a bug in NNTP version 1.5.10, such that when multiple requests are sent to the NNTP server, the server only handles the first one before blocking waiting for more input which never comes. NNTP version 1.5.11 claims to fix this. You can work around the bug inside Emacs like this: (setq nntp-maximum-request 1) You can find out what version of NNTP your news server is running by telnetting to the NNTP port (usually 119) on the news server machine (i.e., `telnet server-machine 119'). The server should give its version number in the welcome message. Type `quit' to get out. 139: How do I view text with embedded underlining (e.g., ClariNews)? Underlining appears like this: _^Hu_^Hn_^Hd_^He_^Hr_^Hl_^Hi_^Hn_^Hi_^Hn_^Hg You can destructively remove underlining with M-x ununderline-region. For ClariNews articles, clari-clean.el by David N. Blank-Edelman will remove both underlining and overstriking automatically. It is available on the Lisp Code Directory (see question 77). 140: How do I save all the items of a multi-part posting in Gnus? Use gnus-uu. Type C-c C-v C-h in the Gnus summary buffer to see a list of available commands. 141: Why does Gnus put the subjects in replies beyond the 80th column? This is a feature. If you set gnus-thread-hide-subject to non-nil, Gnus will only display the subject of the first posting in a thread, even if some of the replies use different subjects. It hides the subjects by putting them past the edge of the window and setting truncate lines to t. If your screen looks messed up, then for some reason truncate-lines in your `*Subject*' buffer has been set to nil. It should be set to t. 142: How do I make Gnus start up faster? Remove all the newsgroups in which you have no interest from your .newsrc file by using Gnus's C-k or C-w commands in the `*Newsgroup*' buffer, perhaps after displaying all newsgroups with the L command. Unsubscribing will not speed up Gnus. 143: How do I catch up all newsgroups in Gnus? In the `*Newsgroup*' buffer, type the following magical incantation: M-< C-x ( c y M-0 C-x ) Leave off the "M-<" if you only want to catch up from point to the end of the `*Newsgroup' buffer. 144: Why can't I kill in Gnus on the Newsgroups/Keywords/Control line? Gnus will complain that the `Newsgroups:', `Keywords:', and `Control:' headers are `Unknown header field's. For the `Newsgroups:' header, there is an easy workaround: kill on the `Xref' header instead, which will be present on any cross-posted article (as long as your site carries the cross-post group). If you really want to kill on one of these headers, you can do it like this: (gnus-kill nil "^Newsgroups: .*\\(bad\\.group\\|worse\\.group\\)") 145: How do I get rid of flashing messages in Gnus for slow connections? Set nntp-debug-read to nil. 146: Why is catch up slow in Gnus? Because Gnus is marking crosspostings read. You can control this with the variable gnus-use-cross-reference. 147: Why does Gnus hang for a long time when posting? David Lawrence explains: The problem is almost always interaction between NNTP and C News. NNTP POST asks C News's inews to not background itself but rather hang around and give its exit status so it knows whether the post was successful. (That wait will on some systems not return the exit status of the waited for job is a different sort of problem.) It ends up taking a long time because inews is calling relaynews, which often waits for another relaynews to free the lock on the news system so it can file the article. My preferred solution is to change inews to not call relaynews, but rather use newsspool. This loses some error-catching functionality, but is for the most part safe as inews will detect a lot of the errors on its own. The C News folks have sped up inews, too, so speed should look better to most folks as that update propagates around. 148: Why don't my news postings in Gnus get past the local machine? It could be that your Distribution: field is "local" or a synonym, or your Path: field may be wrong. This piece of code may fix the latter problem: (setq gnus-use-generic-path t) 149: Why doesn't Gnus generate the `Lines:' header? The posting software down the line from Gnus often generates a "Lines:" header so Gnus doesn't have to. If you want it to, just add Lines to the list in gnus-required-headers: (add-hook 'gnus-startup-hook '(lambda () (setq gnus-required-headers (cons 'Lines gnus-required-headers)))) 150: How do I kill all articles in Gnus but those matching a pattern? Example kill file code: ;; kill everything (gnus-kill "subject" "" nil nil) ;; then restore stuff by our favorite poster (gnus-kill "from" "good-guy" (function (lambda () (if (eq ?X (char-after (save-excursion (beginning-of-line 1) (point)))) (gnus-summary-clear-mark-forward 1)))) t) ------------------------------------------------------------ Slightly modified by Richard Stallman Copyright 1994 Reuven M. Lerner Copyright 1992, 1993 Steven Byrnes Copyright 1990, 1991, 1992 Joseph Brian Wells This list of frequently asked questions about GNU Emacs with answers ("FAQ") may be translated into other languages, transformed into other formats (e.g. Texinfo, Info, WWW, WAIS), and updated with new information. The same conditions apply to any derivative of the FAQ as apply to the FAQ itself. Every copy of the FAQ must include this notice or an approved translation, information on who is currently maintaining the FAQ and how to contact them (including their e-mail address), and information on where the latest version of the FAQ is archived (including FTP information). The FAQ may be copied and redistributed under these conditions, except that the FAQ may not be embedded in a larger literary work unless that work itself allows free copying and redistribution. ------------------------------------------------------------ Special thanks to members of the FAQ team, who worked hard to ensure that answers were up-to-date: Ethan Bradford , Luis Fernandes , Denby Wong <3dw16@qlink.QueensU.CA>, Yair Friedman , Thi , Richard Levitte , "William G. Dubuque" , and Guan-Hsong Hsu . emacs-19.30/etc/FTP100666 13035 13 25453 6045205721 12023 0ustar gnuuser -*- text -*- How to get GNU Software by Internet FTP or by UUCP. Last updated 11 June 95. * Please send improvements to this file to gnu@prep.ai.mit.edu. * No Warranties We distribute software in the hope that it will be useful, but without any warranty. No author or distributor of this software accepts responsibility to anyone for the consequences of using it or for whether it serves any particular purpose or works at all, unless he says so in writing. * Updates If you find this file in the Emacs distribution, there is a chance it is out of date. If you plan to FTP files from a GNU FTP host, you might as well start by FTPing the current version of this file, which is `/pub/gnu/GNUinfo/FTP'. * How to FTP Use the ftp program on your system (ask locally if you can't find it) to connect to the host you are ftping from. Unless indicated otherwise, login in as user "anonymous", with password: "your e-mail address" and set "binary" mode (to transfer all eight bits in each byte). * FTPing GNU Software ** How to FTP GNU Emacs If you are on the Internet (see also "** Alternative Internet FTP Sources" below), you can at present copy the latest distribution version of GNU Emacs from the file /pub/gnu/emacs-M.N.tar on host prep.ai.mit.edu (or the file /pub/gnu/emacs-M.N.tar.gz which has been run through gzip after tar). M and N stand for version numbers; look at a listing of the directory through ftp to see what version is available. These files are about 11 and 4 megabytes long, respectively. After you unpack the distribution, be sure to look at the files README and INSTALL. Because of difficulties in transferring large files, sometimes a split version of the tar file is created. This would be in a directory named /pub/gnu/emacs-M.N.tar-split or perhaps /pub/gnu/emacs-M.N.tar.gz-split, containing files of 100000 characters each. There is generally no trouble in ftping files of this size. They can be combined with cat to make a tar file or compressed tar file. If you can't find such files on prep.ai.mit.edu, have a look at archive.cis.ohio-state.edu. ALWAYS USE BINARY/IMAGE MODE TO TRANSFER THESE FILES! Text mode does not work for tar files or compressed files. Some ftp'ers have found it necessary for successful file transfer: - to explicitly use prep.ai.mit.edu internet address: 18.159.0.42 (as of 18 June 95) Files of differences from previous widely distributed GNU Emacs versions to the present version are also available on prep.ai.mit.edu under names of the form emacs.diff-OO.OO-NN.NN in directory /pub/gnu. These are made with diff -rc2. Sometimes there are versions compressed with gzip of these difference files as well; their names have .gz appended. The Emacs manual in source form is included in the distribution. The dvi file produced by TeX is not included, but a copy may be available for ftp under the name /pub/gnu/emacs.dvi. The Emacs Lisp Reference Manual is in a separate file: /pub/gnu/elisp-manual-NN.tar.gz ** VMS FTP sites with GNU Software You can anonymously ftp a VMS version of GNU emacs from: - ftp.stacken.kth.se:[.GNU-VMS] - GNU Emacs and some other VMS ports (and some VMS binaries) of GNU software - mango.rsmas.miami.edu has a VMS version of the GCC/G++ compiler. Contact angel@flipper.miami.edu (angel li) for details. - addvax.llnl.gov - GNU Emacs - VMSD.OAC.UCI.EDU - GNU Emacs - RIGEL.EFD.LTH.SE [130.235.48.3] - GNU Emacs - ctrsci.cc.utah.edu - GNU Emacs - The 00readme.txt file gives details - cc.utah.edu [128.110.8.24] - misc. GNU software - user anonymous, pass guest. The 00README.txt file gives details. ** Other GNU Software and How To FTP It Other GNU software is available on prep.ai.mit.edu under directory /pub/gnu. diff files to convert between versions (like those used for GNU Emacs), exist for some of these programs. Some programs have misc support files as well. Have a look on prep to see which ones. Compressed versions of the tar or diff files are often available (indicated by a .gz suffix and made with the `gzip' program). Some of this software is in beta test (probably still buggy), and is being made available for use by hackers who like to test software. The file /pub/gnu/DESCRIPTIONS has a list of the packages distributed on prep.ai.mit.edu with a brief description explaining what each one can be used for. More information about these programs can typically be found in the GNU Bulletin. To receive a copy, write to gnu@prep.ai.mit.edu. ** Scheme and How to FTP It The latest distribution version of C Scheme is available via anonymous FTP from altdorf.ai.mit.edu in /archive/scheme-X.XX/ (where X.XX is some version number). Read the files INSTALL and README in the top level C Scheme directory. ** TeX and How to Obtain It We don't distribute TeX now, but it is free software. TeX is a document formatter that is used, among other things, by the FSF for all its documentation. You will need it if you want to make printed manuals. TeX is freely redistributable. You can get it by ftp, tape, or CD/ROM. *** For FTP instructions, retrieve the file ftp.cs.umb.edu:pub/tex/unixtex.ftp. (We don't include it here because it changes relatively frequently. Sorry.) *** For TeX on a single tape (4mm DAT or QIC-24), ordering information is available from unixtex@u.washington.edu. A distribution fee in the area of US$210.00 covers administrative costs. Tapes will be available at least through summer of 1994. *** The FSF hopes soon to distribute tapes of TeX itself, after the University of Washington distribution service goes away. *** A minimal TeX collection (enough to process Texinfo files, anyway) is included on the GNU source CD/ROM. See the file ORDERS in this directory for more information. ** Alternative Internet FTP Sources Please do NOT use a site outside your country, until you have checked all sites inside your country, and then your continent. Trans-ocean TCP/IP links are very expensive and usually very low speed. The administrators of louie.udel.edu maintains copies of GNU Emacs. The files are available via anonymous ftp under directory ~ftp/gnu. Emacs and other GNU programs may be available via anonymous ftp from these US sites: ftp.kpc.com:/pub/mirror/gnu (Silicon Valley, CA) ftp.hawaii.edu:/mirrors/gnu, f.ms.uky.edu:/pub3/gnu, ftp.digex.net:/pub/gnu (Internet address 164.109.10.23, nightly full mirror, ran by mcguire@digex.net), wuarchive.wustl.edu:/systems/gnu, col.hp.com:/mirrors/gnu, ftp.cs.columbia.edu:/archives/gnu/prep, uiarchive.cso.uiuc.edu:/pub/gnu (Internet address 128.174.5.14, nightly full mirror, ran by ftpadmin@uiuc.edu), jaguar.utah.edu:/gnustuff, gatekeeper.dec.com:/pub/GNU, labrea.stanford.edu, archive.cis.ohio-state.edu, and ftp.uu.net:/archive/systems/gnu. And these foreign sites: ftp.cs.ubc.ca:/mirror2/gnu (Western Canada, daily full mirror, ran by ftp-admin@cs.ubc.ca), ftp.inf.utfsm.cl:/pub/gnu (Chile 146.83.198.3 nightly full mirror, ran by ftp@inf.utfsm.cl), ftp.unicamp.br:/pub/gnu (Brazil manual mirror, ran by oliva@dcc.unicamp.br), archie.au:/gnu (Australia (archie.oz or archie.oz.au for ACSnet)), ftp.technion.ac.il:/pub/unsupported/gnu (Israel, daily full mirror, ran by ftp-admin), ftp.sun.ac.za:/pub/gnu (South Africa), ftp.etsimo.uniovi.es:/pub/gnu (Spain), ftp.mcc.ac.uk:/pub/gnu (130.88.203.12 daily full mirror, ran by root@ftp.mcc.ac.uk), unix.hensa.ac.uk:/mirrors/uunet/systems/gnu, ftp.warwick.ac.uk (137.205.192.14 daily full mirror, ran by unixhelp@warwick.ac.uk), ftp.informatik.tu-muenchen.de, ftp.informatik.rwth-aachen.de, or germany.eu.net (mirror ran by archive-admin@germany.eu.net) (Germany), isy.liu.se (Sweden), ftp.stacken.kth.se or ftp.luth.se:/pub/unix/gnu (Sweden), ftp.sunet.se:/pub/gnu (Sweden 130.238.127.3 daily mirror, ran by archive@ftp.sunet.se (also mirrors the Mailing List Archives) ftp.nl.net (Netherlands), ftp.win.tue.nl:/pub/gnu (Netherlands 131.155.70.100 daily mirror, ran by ftp@win.tue.nl), ftp.funet.fi:/pub/gnu (Finland 128.214.6.100, ran by gnu-adm), ftp.denet.dk (Denmark), ugle.unit.no (Norway 129.241.1.97), ftp.eunet.ch or nic.switch.ch:/mirror/gnu (Switzerland), irisa.irisa.fr:/pub/gnu or ftp.univ-lyon1.fr:pub/gnu (ran by ftpmaint@ftp.univ-lyon1.fr) (France), ftp.ieunet.ie:pub/gnu (Ireland 192.111.39.1 weekly mirror, ran by archive@ieunet.ie), archive.eu.net (Europe 192.16.202.1), cair-archive.kaist.ac.kr:/pub/gnu (Korea 143.248.11.171, ran by ftpkeeper@cair-archive.kaist.ac.kr), ftp.nectec.or.th:/pub/mirrors/gnu (Thailand 192.150.251.32 daily mirror, ran by ftp@nwg.nectec.or.th), utsun.s.u-tokyo.ac.jp:/ftpsync/prep or ftp.cs.titech.ac.jp (Japan, nemacs, the japanese port of GNU Emacs, is under ~ftp/JAPAN). * Getting GNU software in Great Britain jpo@cs.nott.ac.uk is willing to distribute those GNU sources he has available. The smaller items are available from the info-server (send to info-server@cs.nott.ac.uk) the larger items by negotiation. Due to communication costs this service is only available within the UK. BattenIG@computer-science.birmingham.ac.uk (aka I.G.Batten@fulcrum.bt.co.uk) is also willing to distribute those GNU sources he has. He can also write tapes in qic-21 and qic-24 formats. lmjm@doc.ic.ac.uk is willing to distribute those GNU sources he has along with comp.sources.unix, comp.sources.x, X windows et al. The archive, on src.doc.ic.ac.uk in directory /gnu, is available via ftp over the Internet (on 146.169.3.7), niftp over janet (000005102000), ftam over IXI and uucp. Due to communication costs this service is only available within the UK. Mail to info-server@doc.ic.ac.uk for details. He can also write sun cartridge or exabyte tapes. UK sites with just anonymous FTP access are in the above list. * Getting GNU software via UUCP OSU is distributing via UUCP: most GNU software, MIT C Scheme, Compress, News, RN, NNTP, Patch, some Appletalk stuff, some of the Internet Requests For Comment (RFC) et al.. See their periodic postings on the Usenet newsgroup comp.sources.d for informational updates. Current details from or <...!osu-cis!staff>. Information on how to uucp some GNU programs is available via electronic mail from: uunet!hutch!barber, hqda-ai!merlin, acornrc!bob, hao!scicom!qetzal!upba!ugn!nepa!denny, ncar!noao!asuvax!hrc!dan, bigtex!james (aka james@bigtex.cactus.org), oli-stl!root, src@contrib.de (Germany), toku@dit.co.jp (Japan) and info@ftp.uu.net. * If You Like The Software If you like the software developed and distributed by the Free Software Foundation, please express your satisfaction with a donation. Your donations will help to support the Foundation and make our future efforts successful, including a complete development and operating system, called GNU (Gnu's Not Un*x), which will run Un*x user programs. For more information on GNU and the Foundation, contact us at the above address. Ordering a distribution tape from the Foundation is often a good way to bring your company or university to make a donation. emacs-19.30/etc/GNU100666 12120 13 63342 5541643051 12026 0ustar rmsuserCopyright (C) 1985, 1993 Free Software Foundation, Inc. Permission is granted to anyone to make or distribute verbatim copies of this document, in any medium, provided that the copyright notice and permission notice are preserved, and that the distributor grants the recipient permission for further redistribution as permitted by this notice. Modified versions may not be made. The GNU Manifesto ***************** The GNU Manifesto which appears below was written by Richard Stallman at the beginning of the GNU project, to ask for participation and support. For the first few years, it was updated in minor ways to account for developments, but now it seems best to leave it unchanged as most people have seen it. Since that time, we have learned about certain common misunderstandings that different wording could help avoid. Footnotes added in 1993 help clarify these points. For up-to-date information about the available GNU software, please see the latest issue of the GNU's Bulletin. The list is much too long to include here. What's GNU? Gnu's Not Unix! ============================ GNU, which stands for Gnu's Not Unix, is the name for the complete Unix-compatible software system which I am writing so that I can give it away free to everyone who can use it.(1) Several other volunteers are helping me. Contributions of time, money, programs and equipment are greatly needed. So far we have an Emacs text editor with Lisp for writing editor commands, a source level debugger, a yacc-compatible parser generator, a linker, and around 35 utilities. A shell (command interpreter) is nearly completed. A new portable optimizing C compiler has compiled itself and may be released this year. An initial kernel exists but many more features are needed to emulate Unix. When the kernel and compiler are finished, it will be possible to distribute a GNU system suitable for program development. We will use TeX as our text formatter, but an nroff is being worked on. We will use the free, portable X window system as well. After this we will add a portable Common Lisp, an Empire game, a spreadsheet, and hundreds of other things, plus on-line documentation. We hope to supply, eventually, everything useful that normally comes with a Unix system, and more. GNU will be able to run Unix programs, but will not be identical to Unix. We will make all improvements that are convenient, based on our experience with other operating systems. In particular, we plan to have longer file names, file version numbers, a crashproof file system, file name completion perhaps, terminal-independent display support, and perhaps eventually a Lisp-based window system through which several Lisp programs and ordinary Unix programs can share a screen. Both C and Lisp will be available as system programming languages. We will try to support UUCP, MIT Chaosnet, and Internet protocols for communication. GNU is aimed initially at machines in the 68000/16000 class with virtual memory, because they are the easiest machines to make it run on. The extra effort to make it run on smaller machines will be left to someone who wants to use it on them. To avoid horrible confusion, please pronounce the `G' in the word `GNU' when it is the name of this project. Why I Must Write GNU ==================== I consider that the golden rule requires that if I like a program I must share it with other people who like it. Software sellers want to divide the users and conquer them, making each user agree not to share with others. I refuse to break solidarity with other users in this way. I cannot in good conscience sign a nondisclosure agreement or a software license agreement. For years I worked within the Artificial Intelligence Lab to resist such tendencies and other inhospitalities, but eventually they had gone too far: I could not remain in an institution where such things are done for me against my will. So that I can continue to use computers without dishonor, I have decided to put together a sufficient body of free software so that I will be able to get along without any software that is not free. I have resigned from the AI lab to deny MIT any legal excuse to prevent me from giving GNU away. Why GNU Will Be Compatible with Unix ==================================== Unix is not my ideal system, but it is not too bad. The essential features of Unix seem to be good ones, and I think I can fill in what Unix lacks without spoiling them. And a system compatible with Unix would be convenient for many other people to adopt. How GNU Will Be Available ========================= GNU is not in the public domain. Everyone will be permitted to modify and redistribute GNU, but no distributor will be allowed to restrict its further redistribution. That is to say, proprietary modifications will not be allowed. I want to make sure that all versions of GNU remain free. Why Many Other Programmers Want to Help ======================================= I have found many other programmers who are excited about GNU and want to help. Many programmers are unhappy about the commercialization of system software. It may enable them to make more money, but it requires them to feel in conflict with other programmers in general rather than feel as comrades. The fundamental act of friendship among programmers is the sharing of programs; marketing arrangements now typically used essentially forbid programmers to treat others as friends. The purchaser of software must choose between friendship and obeying the law. Naturally, many decide that friendship is more important. But those who believe in law often do not feel at ease with either choice. They become cynical and think that programming is just a way of making money. By working on and using GNU rather than proprietary programs, we can be hospitable to everyone and obey the law. In addition, GNU serves as an example to inspire and a banner to rally others to join us in sharing. This can give us a feeling of harmony which is impossible if we use software that is not free. For about half the programmers I talk to, this is an important happiness that money cannot replace. How You Can Contribute ====================== I am asking computer manufacturers for donations of machines and money. I'm asking individuals for donations of programs and work. One consequence you can expect if you donate machines is that GNU will run on them at an early date. The machines should be complete, ready to use systems, approved for use in a residential area, and not in need of sophisticated cooling or power. I have found very many programmers eager to contribute part-time work for GNU. For most projects, such part-time distributed work would be very hard to coordinate; the independently-written parts would not work together. But for the particular task of replacing Unix, this problem is absent. A complete Unix system contains hundreds of utility programs, each of which is documented separately. Most interface specifications are fixed by Unix compatibility. If each contributor can write a compatible replacement for a single Unix utility, and make it work properly in place of the original on a Unix system, then these utilities will work right when put together. Even allowing for Murphy to create a few unexpected problems, assembling these components will be a feasible task. (The kernel will require closer communication and will be worked on by a small, tight group.) If I get donations of money, I may be able to hire a few people full or part time. The salary won't be high by programmers' standards, but I'm looking for people for whom building community spirit is as important as making money. I view this as a way of enabling dedicated people to devote their full energies to working on GNU by sparing them the need to make a living in another way. Why All Computer Users Will Benefit =================================== Once GNU is written, everyone will be able to obtain good system software free, just like air.(2) This means much more than just saving everyone the price of a Unix license. It means that much wasteful duplication of system programming effort will be avoided. This effort can go instead into advancing the state of the art. Complete system sources will be available to everyone. As a result, a user who needs changes in the system will always be free to make them himself, or hire any available programmer or company to make them for him. Users will no longer be at the mercy of one programmer or company which owns the sources and is in sole position to make changes. Schools will be able to provide a much more educational environment by encouraging all students to study and improve the system code. Harvard's computer lab used to have the policy that no program could be installed on the system if its sources were not on public display, and upheld it by actually refusing to install certain programs. I was very much inspired by this. Finally, the overhead of considering who owns the system software and what one is or is not entitled to do with it will be lifted. Arrangements to make people pay for using a program, including licensing of copies, always incur a tremendous cost to society through the cumbersome mechanisms necessary to figure out how much (that is, which programs) a person must pay for. And only a police state can force everyone to obey them. Consider a space station where air must be manufactured at great cost: charging each breather per liter of air may be fair, but wearing the metered gas mask all day and all night is intolerable even if everyone can afford to pay the air bill. And the TV cameras everywhere to see if you ever take the mask off are outrageous. It's better to support the air plant with a head tax and chuck the masks. Copying all or parts of a program is as natural to a programmer as breathing, and as productive. It ought to be as free. Some Easily Rebutted Objections to GNU's Goals ============================================== "Nobody will use it if it is free, because that means they can't rely on any support." "You have to charge for the program to pay for providing the support." If people would rather pay for GNU plus service than get GNU free without service, a company to provide just service to people who have obtained GNU free ought to be profitable.(3) We must distinguish between support in the form of real programming work and mere handholding. The former is something one cannot rely on from a software vendor. If your problem is not shared by enough people, the vendor will tell you to get lost. If your business needs to be able to rely on support, the only way is to have all the necessary sources and tools. Then you can hire any available person to fix your problem; you are not at the mercy of any individual. With Unix, the price of sources puts this out of consideration for most businesses. With GNU this will be easy. It is still possible for there to be no available competent person, but this problem cannot be blamed on distribution arrangements. GNU does not eliminate all the world's problems, only some of them. Meanwhile, the users who know nothing about computers need handholding: doing things for them which they could easily do themselves but don't know how. Such services could be provided by companies that sell just hand-holding and repair service. If it is true that users would rather spend money and get a product with service, they will also be willing to buy the service having got the product free. The service companies will compete in quality and price; users will not be tied to any particular one. Meanwhile, those of us who don't need the service should be able to use the program without paying for the service. "You cannot reach many people without advertising, and you must charge for the program to support that." "It's no use advertising a program people can get free." There are various forms of free or very cheap publicity that can be used to inform numbers of computer users about something like GNU. But it may be true that one can reach more microcomputer users with advertising. If this is really so, a business which advertises the service of copying and mailing GNU for a fee ought to be successful enough to pay for its advertising and more. This way, only the users who benefit from the advertising pay for it. On the other hand, if many people get GNU from their friends, and such companies don't succeed, this will show that advertising was not really necessary to spread GNU. Why is it that free market advocates don't want to let the free market decide this?(4) "My company needs a proprietary operating system to get a competitive edge." GNU will remove operating system software from the realm of competition. You will not be able to get an edge in this area, but neither will your competitors be able to get an edge over you. You and they will compete in other areas, while benefiting mutually in this one. If your business is selling an operating system, you will not like GNU, but that's tough on you. If your business is something else, GNU can save you from being pushed into the expensive business of selling operating systems. I would like to see GNU development supported by gifts from many manufacturers and users, reducing the cost to each.(5) "Don't programmers deserve a reward for their creativity?" If anything deserves a reward, it is social contribution. Creativity can be a social contribution, but only in so far as society is free to use the results. If programmers deserve to be rewarded for creating innovative programs, by the same token they deserve to be punished if they restrict the use of these programs. "Shouldn't a programmer be able to ask for a reward for his creativity?" There is nothing wrong with wanting pay for work, or seeking to maximize one's income, as long as one does not use means that are destructive. But the means customary in the field of software today are based on destruction. Extracting money from users of a program by restricting their use of it is destructive because the restrictions reduce the amount and the ways that the program can be used. This reduces the amount of wealth that humanity derives from the program. When there is a deliberate choice to restrict, the harmful consequences are deliberate destruction. The reason a good citizen does not use such destructive means to become wealthier is that, if everyone did so, we would all become poorer from the mutual destructiveness. This is Kantian ethics; or, the Golden Rule. Since I do not like the consequences that result if everyone hoards information, I am required to consider it wrong for one to do so. Specifically, the desire to be rewarded for one's creativity does not justify depriving the world in general of all or part of that creativity. "Won't programmers starve?" I could answer that nobody is forced to be a programmer. Most of us cannot manage to get any money for standing on the street and making faces. But we are not, as a result, condemned to spend our lives standing on the street making faces, and starving. We do something else. But that is the wrong answer because it accepts the questioner's implicit assumption: that without ownership of software, programmers cannot possibly be paid a cent. Supposedly it is all or nothing. The real reason programmers will not starve is that it will still be possible for them to get paid for programming; just not paid as much as now. Restricting copying is not the only basis for business in software. It is the most common basis because it brings in the most money. If it were prohibited, or rejected by the customer, software business would move to other bases of organization which are now used less often. There are always numerous ways to organize any kind of business. Probably programming will not be as lucrative on the new basis as it is now. But that is not an argument against the change. It is not considered an injustice that sales clerks make the salaries that they now do. If programmers made the same, that would not be an injustice either. (In practice they would still make considerably more than that.) "Don't people have a right to control how their creativity is used?" "Control over the use of one's ideas" really constitutes control over other people's lives; and it is usually used to make their lives more difficult. People who have studied the issue of intellectual property rights carefully (such as lawyers) say that there is no intrinsic right to intellectual property. The kinds of supposed intellectual property rights that the government recognizes were created by specific acts of legislation for specific purposes. For example, the patent system was established to encourage inventors to disclose the details of their inventions. Its purpose was to help society rather than to help inventors. At the time, the life span of 17 years for a patent was short compared with the rate of advance of the state of the art. Since patents are an issue only among manufacturers, for whom the cost and effort of a license agreement are small compared with setting up production, the patents often do not do much harm. They do not obstruct most individuals who use patented products. The idea of copyright did not exist in ancient times, when authors frequently copied other authors at length in works of non-fiction. This practice was useful, and is the only way many authors' works have survived even in part. The copyright system was created expressly for the purpose of encouraging authorship. In the domain for which it was invented--books, which could be copied economically only on a printing press--it did little harm, and did not obstruct most of the individuals who read the books. All intellectual property rights are just licenses granted by society because it was thought, rightly or wrongly, that society as a whole would benefit by granting them. But in any particular situation, we have to ask: are we really better off granting such license? What kind of act are we licensing a person to do? The case of programs today is very different from that of books a hundred years ago. The fact that the easiest way to copy a program is from one neighbor to another, the fact that a program has both source code and object code which are distinct, and the fact that a program is used rather than read and enjoyed, combine to create a situation in which a person who enforces a copyright is harming society as a whole both materially and spiritually; in which a person should not do so regardless of whether the law enables him to. "Competition makes things get done better." The paradigm of competition is a race: by rewarding the winner, we encourage everyone to run faster. When capitalism really works this way, it does a good job; but its defenders are wrong in assuming it always works this way. If the runners forget why the reward is offered and become intent on winning, no matter how, they may find other strategies--such as, attacking other runners. If the runners get into a fist fight, they will all finish late. Proprietary and secret software is the moral equivalent of runners in a fist fight. Sad to say, the only referee we've got does not seem to object to fights; he just regulates them ("For every ten yards you run, you can fire one shot"). He really ought to break them up, and penalize runners for even trying to fight. "Won't everyone stop programming without a monetary incentive?" Actually, many people will program with absolutely no monetary incentive. Programming has an irresistible fascination for some people, usually the people who are best at it. There is no shortage of professional musicians who keep at it even though they have no hope of making a living that way. But really this question, though commonly asked, is not appropriate to the situation. Pay for programmers will not disappear, only become less. So the right question is, will anyone program with a reduced monetary incentive? My experience shows that they will. For more than ten years, many of the world's best programmers worked at the Artificial Intelligence Lab for far less money than they could have had anywhere else. They got many kinds of non-monetary rewards: fame and appreciation, for example. And creativity is also fun, a reward in itself. Then most of them left when offered a chance to do the same interesting work for a lot of money. What the facts show is that people will program for reasons other than riches; but if given a chance to make a lot of money as well, they will come to expect and demand it. Low-paying organizations do poorly in competition with high-paying ones, but they do not have to do badly if the high-paying ones are banned. "We need the programmers desperately. If they demand that we stop helping our neighbors, we have to obey." You're never so desperate that you have to obey this sort of demand. Remember: millions for defense, but not a cent for tribute! "Programmers need to make a living somehow." In the short run, this is true. However, there are plenty of ways that programmers could make a living without selling the right to use a program. This way is customary now because it brings programmers and businessmen the most money, not because it is the only way to make a living. It is easy to find other ways if you want to find them. Here are a number of examples. A manufacturer introducing a new computer will pay for the porting of operating systems onto the new hardware. The sale of teaching, hand-holding and maintenance services could also employ programmers. People with new ideas could distribute programs as freeware, asking for donations from satisfied users, or selling hand-holding services. I have met people who are already working this way successfully. Users with related needs can form users' groups, and pay dues. A group would contract with programming companies to write programs that the group's members would like to use. All sorts of development can be funded with a Software Tax: Suppose everyone who buys a computer has to pay x percent of the price as a software tax. The government gives this to an agency like the NSF to spend on software development. But if the computer buyer makes a donation to software development himself, he can take a credit against the tax. He can donate to the project of his own choosing--often, chosen because he hopes to use the results when it is done. He can take a credit for any amount of donation up to the total tax he had to pay. The total tax rate could be decided by a vote of the payers of the tax, weighted according to the amount they will be taxed on. The consequences: * The computer-using community supports software development. * This community decides what level of support is needed. * Users who care which projects their share is spent on can choose this for themselves. In the long run, making programs free is a step toward the post-scarcity world, where nobody will have to work very hard just to make a living. People will be free to devote themselves to activities that are fun, such as programming, after spending the necessary ten hours a week on required tasks such as legislation, family counseling, robot repair and asteroid prospecting. There will be no need to be able to make a living from programming. We have already greatly reduced the amount of work that the whole society must do for its actual productivity, but only a little of this has translated itself into leisure for workers because much nonproductive activity is required to accompany productive activity. The main causes of this are bureaucracy and isometric struggles against competition. Free software will greatly reduce these drains in the area of software production. We must do this, in order for technical gains in productivity to translate into less work for us. ---------- Footnotes ---------- (1) The wording here was careless. The intention was that nobody would have to pay for *permission* to use the GNU system. But the words don't make this clear, and people often interpret them as saying that copies of GNU should always be distributed at little or no charge. That was never the intent; later on, the manifesto mentions the possibility of companies providing the service of distribution for a profit. Subsequently I have learned to distinguish carefully between "free" in the sense of freedom and "free" in the sense of price. Free software is software that users have the freedom to distribute and change. Some users may obtain copies at no charge, while others pay to obtain copies--and if the funds help support improving the software, so much the better. The important thing is that everyone who has a copy has the freedom to cooperate with others in using it. (2) This is another place I failed to distinguish carefully between the two different meanings of "free". The statement as it stands is not false--you can get copies of GNU software at no charge, from your friends or over the net. But it does suggest the wrong idea. (3) Several such companies now exist. (4) The Free Software Foundation raises most of its funds from a distribution service, although it is a charity rather than a company. If *no one* chooses to obtain copies by ordering the from the FSF, it will be unable to do its work. But this does not mean that proprietary restrictions are justified to force every user to pay. If a small fraction of all the users order copies from the FSF, that is sufficient to keep the FSF afloat. So we ask users to choose to support us in this way. Have you done your part? (5) A group of computer companies recently pooled funds to support maintenance of the GNU C Compiler. emacs-19.30/etc/INTERVIEW100666 12130 13 60254 5767472341 13324 0ustar toweruser GNU'S NOT UNIX Conducted by David Betz and Jon Edwards Richard Stallman discusses his public-domain UNIX-compatible software system with BYTE editors (July 1986) Copyright (C) 1986 Richard Stallman. Permission is granted to make and distribute copies of this article as long as the copyright and this notice appear on all copies. Richard Stallman has undertaken probably the most ambitious free software development project to date, the GNU system. In his GNU Manifesto, published in the March 1985 issue of Dr. Dobb's Journal, Stallman described GNU as a "complete Unix-compatible software system which I am writing so that I can give it away free to everyone who can use it... Once GNU is written, everyone will be able to obtain good system software free, just like air." (GNU is an acronym for GNU's Not UNIX; the "G" is pronounced.) Stallman is widely known as the author of EMACS, a powerful text editor that he developed at the MIT Artificial Intelligence Laboratory. It is no coincidence that the first piece of software produced as part of the GNU project was a new implementation of EMACS. GNU EMACS has already achieved a reputation as one of the best implementations of EMACS currently available at any price. BYTE: We read your GNU Manifesto in the March 1985 issue of Dr. Dobb's. What has happened since? Was that really the beginning, and how have you progressed since then? Stallman: The publication in Dr. Dobb's wasn't the beginning of the project. I wrote the GNU Manifesto when I was getting ready to start the project, as a proposal to ask computer manufacturers for funding. They didn't want to get involved, and I decided that rather than spend my time trying to pursue funds, I ought to spend it writing code. The manifesto was published about a year and a half after I had written it, when I had barely begun distributing the GNU EMACS. Since that time, in addition to making GNU EMACS more complete and making it run on many more computers, I have nearly finished the optimizing C compiler and all the other software that is needed for running C programs. This includes a source-level debugger that has many features that the other source-level debuggers on UNIX don't have. For example, it has convenience variables within the debugger so you can save values, and it also has a history of all the values that you have printed out, making it tremendously easier to chase around list structures. BYTE: You have finished an editor that is now widely distributed and you are about to finish the compiler. Stallman: I expect that it will be finished this October. BYTE: What about the kernel? Stallman: I'm currently planning to start with the kernel that was written at MIT and was released to the public recently with the idea that I would use it. This kernel is called TRIX; it's based on remote procedure call. I still need to add compatibility for a lot of the features of UNIX which it doesn't have currently. I haven't started to work on that yet. I'm finishing the compiler before I go to work on the kernel. I am also going to have to rewrite the file system. I intend to make it failsafe just by having it write blocks in the proper order so that the disk structure is always consistent. Then I want to add version numbers. I have a complicated scheme to reconcile version numbers with the way people usually use UNIX. You have to be able to specify filenames without version numbers, but you also have to be able to specify them with explicit version numbers, and these both need to work with ordinary UNIX programs that have not been modified in any way to deal with the existence of this feature. I think I have a scheme for doing this, and only trying it will show me whether it really does the job. BYTE: Do you have a brief description you can give us as to how GNU as a system will be superior to other systems? We know that one of your goals is to produce something that is compatible with UNIX. But at least in the area of file systems you have already said that you are going to go beyond UNIX and produce something that is better. Stallman: The C compiler will produce better code and run faster. The debugger is better. With each piece I may or may not find a way to improve it. But there is no one answer to this question. To some extent I am getting the benefit of reimplementation, which makes many systems much better. To some extent it's because I have been in the field a long time and worked on many other systems. I therefore have many ideas to bring to bear. One way in which it will be better is that practically everything in the system will work on files of any size, on lines of any size, with any characters appearing in them. The UNIX system is very bad in that regard. It's not anything new as a principle of software engineering that you shouldn't have arbitrary limits. But it just was the standard practice in writing UNIX to put those in all the time, possibly just because they were writing it for a very small computer. The only limit in the GNU system is when your program runs out of memory because it tried to work on too much data and there is no place to keep it all. BYTE: And that isn't likely to be hit if you've got virtual memory. You may just take forever to come up with the solution. Stallman: Actually these limits tend to hit in a time long before you take forever to come up with the solution. BYTE: Can you say something about what types of machines and environments GNU EMACS in particular has been made to run under? It's now running on VAXes; has it migrated in any form to personal computers? Stallman: I'm not sure what you mean by personal computers. For example, is a Sun a personal computer? GNU EMACS requires at least a megabyte of available memory and preferably more. It is normally used on machines that have virtual memory. Except for various technical problems in a few C compilers, almost any machine with virtual memory and running a fairly recent version of UNIX will run GNU EMACS, and most of them currently do. BYTE: Has anyone tried to port it to Ataris or Macintoshes? Stallman: The Atari 1040ST still doesn't have quite enough memory. The next Atari machine, I expect, will run it. I also think that future Ataris will have some forms of memory mapping. Of course, I am not designing the software to run on the kinds of computers that are prevalent today. I knew when I started this project it was going to take a few years. I therefore decided that I didn't want to make a worse system by taking on the additional challenge of making it run in the currently constrained environment. So instead I decided I'm going to write it in the way that seems the most natural and best. I am confident that in a couple of years machines of sufficient size will be prevalent. In fact, increases in memory size are happening so fast it surprises me how slow most of the people are to put in virtual memory; I think it is totally essential. BYTE: I think people don't really view it as being necessary for single-user machines. Stallman: They don't understand that single user doesn't mean single program. Certainly for any UNIX-like system it's important to be able to run lots of different processes at the same time even if there is only one of you. You could run GNU EMACS on a nonvirtual-memory machine with enough memory, but you couldn't run the rest of the GNU system very well or a UNIX system very well. BYTE: How much of LISP is present in GNU EMACS? It occurred to me that it may be useful to use that as a tool for learning LISP. Stallman: You can certainly do that. GNU EMACS contains a complete, although not very powerful, LISP system. It's powerful enough for writing editor commands. It's not comparable with, say, a Common LISP System, something you could really use for system programming, but it has all the things that LISP needs to have. BYTE: Do you have any predictions about when you would be likely to distribute a workable environment in which, if we put it on our machines or workstations, we could actually get reasonable work done without using anything other than code that you distribute? Stallman: It's really hard to say. That could happen in a year, but of course it could take longer. It could also conceivably take less, but that's not too likely anymore. I think I'll have the compiler finished in a month or two. The only other large piece of work I really have to do is in the kernel. I first predicted GNU would take something like two years, but it has now been two and a half years and I'm still not finished. Part of the reason for the delay is that I spent a lot of time working on one compiler that turned out to be a dead end. I had to rewrite it completely. Another reason is that I spent so much time on GNU EMACS. I originally thought I wouldn't have to do that at all. BYTE: Tell us about your distribution scheme. Stallman: I don't put software or manuals in the public domain, and the reason is that I want to make sure that all the users get the freedom to share. I don't want anyone making an improved version of a program I wrote and distributing it as proprietary. I don't want that to ever be able to happen. I want to encourage the free improvements to these programs, and the best way to do that is to take away any temptation for a person to make improvements nonfree. Yes, a few of them will refrain from making improvements, but a lot of others will make the same improvements and they'll make them free. BYTE: And how do you go about guaranteeing that? Stallman: I do this by copyrighting the programs and putting on a notice giving people explicit permission to copy the programs and change them but only on the condition that they distribute under the same terms that I used, if at all. You don't have to distribute the changes you make to any of my programs--you can just do it for yourself, and you don't have to give it to anyone or tell anyone. But if you do give it to someone else, you have to do it under the same terms that I use. BYTE: Do you obtain any rights over the executable code derived from the C compiler? Stallman: The copyright law doesn't give me copyright on output from the compiler, so it doesn't give me a way to say anything about that, and in fact I don't try to. I don't sympathize with people developing proprietary products with any compiler, but it doesn't seem especially useful to try to stop them from developing them with this compiler, so I am not going to. BYTE: Do your restrictions apply if people take pieces of your code to produce other things as well? Stallman: Yes, if they incorporate with changes any sizable piece. If it were two lines of code, that's nothing; copyright doesn't apply to that. Essentially, I have chosen these conditions so that first there is a copyright, which is what all the software hoarders use to stop everybody from doing anything, and then I add a notice giving up part of those rights. So the conditions talk only about the things that copyright applies to. I don't believe that the reason you should obey these conditions is because of the law. The reason you should obey is because an upright person when he distributes software encourages other people to share it further. BYTE: In a sense you are enticing people into this mode of thinking by providing all of these interesting tools that they can use but only if they buy into your philosophy. Stallman: Yes. You could also see it as using the legal system that software hoarders have set up against them. I'm using it to protect the public from them. BYTE: Given that manufacturers haven't wanted to fund the project, who do you think will use the GNU system when it is done? Stallman: I have no idea, but it is not an important question. My purpose is to make it possible for people to reject the chains that come with proprietary software. I know that there are people who want to do that. Now, there may be others who don't care, but they are not my concern. I feel a bit sad for them and for the people that they influence. Right now a person who perceives the unpleasantness of the terms of proprietary software feels that he is stuck and has no alternative except not to use a computer. Well, I am going to give him a comfortable alternative. Other people may use the GNU system simply because it is technically superior. For example, my C compiler is producing about as good a code as I have seen from any C compiler. And GNU EMACS is generally regarded as being far superior to the commercial competition. And GNU EMACS was not funded by anyone either, but everyone is using it. I therefore think that many people will use the rest of the GNU system because of its technical advantages. But I would be doing a GNU system even if I didn't know how to make it technically better because I want it to be socially better. The GNU project is really a social project. It uses technical means to make a change in society. BYTE: Then it is fairly important to you that people adopt GNU. It is not just an academic exercise to produce this software to give it away to people. You hope it will change the way the software industry operates. Stallman: Yes. Some people say no one will ever use it because it doesn't have some attractive corporate logo on it, and other people say that they think it is tremendously important and everyone's going to want to use it. I have no way of knowing what is really going to happen. I don't know any other way to try to change the ugliness of the field that I find myself in, so this is what I have to do. BYTE: Can you address the implications? You obviously feel that this is an important political and social statement. Stallman: It is a change. I'm trying to change the way people approach knowledge and information in general. I think that to try to own knowledge, to try to control whether people are allowed to use it, or to try to stop other people from sharing it, is sabotage. It is an activity that benefits the person that does it at the cost of impoverishing all of society. One person gains one dollar by destroying two dollars' worth of wealth. I think a person with a conscience wouldn't do that sort of thing except perhaps if he would otherwise die. And of course the people who do this are fairly rich; I can only conclude that they are unscrupulous. I would like to see people get rewards for writing free software and for encouraging other people to use it. I don't want to see people get rewards for writing proprietary software because that is not really a contribution to society. The principle of capitalism is the idea that people manage to make money by producing things and thereby are encouraged to do what is useful, automatically, so to speak. But that doesn't work when it comes to owning knowledge. They are encouraged to do not really what's useful, and what really is useful is not encouraged. I think it is important to say that information is different from material objects like cars and loaves of bread because people can copy it and share it on their own and, if nobody attempts to stop them, they can change it and make it better for themselves. That is a useful thing for people to do. This isn't true of loaves of bread. If you have one loaf of bread and you want another, you can't just put your loaf of bread into a bread copier. you can't make another one except by going through all the steps that were used to make the first one. It therefore is irrelevant whether people are permitted to copy it--it's impossible. Books were printed only on printing presses until recently. It was possible to make a copy yourself by hand, but it wasn't practical because it took so much more work than using a printing press. And it produced something so much less attractive that, for all intents and purposes, you could act as if it were impossible to make books except by mass producing them. And therefore copyright didn't really take any freedom away from the reading public. There wasn't anything that a book purchaser could do that was forbidden by copyright. But this isn't true for computer programs. It's also not true for tape cassettes. It's partly false now for books, but it is still true that for most books it is more expensive and certainly a lot more work to Xerox them than to buy a copy, and the result is still less attractive. Right now we are in a period where the situation that made copyright harmless and acceptable is changing to a situation where copyright will become destructive and intolerable. So the people who are slandered as "pirates" are in fact the people who are trying to do something useful that they have been forbidden to do. The copyright laws are entirely designed to help people take complete control over the use of some information for their own good. But they aren't designed to help people who want to make sure that the information is accessible to the public and stop others from depriving the public. I think that the law should recognize a class of works that are owned by the public, which is different from public domain in the same sense that a public park is different from something found in a garbage can. It's not there for anybody to take away, it's there for everyone to use but for no one to impede. Anybody in the public who finds himself being deprived of the derivative work of something owned by the public should be able to sue about it. BYTE: But aren't pirates interested in getting copies of programs because they want to use those programs, not because they want to use that knowledge to produce something better? Stallman: I don't see that that's the important distinction. More people using a program means that the program contributes more to society. You have a loaf of bread that could be eaten either once or a million times. BYTE: Some users buy commercial software to obtain support. How does your distribution scheme provide support? Stallman: I suspect that those users are misled and are not thinking clearly. It is certainly useful to have support, but when they start thinking about how that has something to do with selling software or with the software being proprietary, at that point they are confusing themselves. There is no guarantee that proprietary software will receive good support. Simply because sellers say that they provide support, that doesn't mean it will be any good. And they may go out of business. In fact, people think that GNU EMACS has better support than commercial EMACSes. One of the reasons is that I'm probably a better hacker than the people who wrote the other EMACSes, but the other reason is that everyone has sources and there are so many people interested in figuring out how to do things with it that you don't have to get your support from me. Even just the free support that consists of my fixing bugs people report to me and incorporating that in the next release has given people a good level of support. You can always hire somebody to solve a problem for you, and when the software is free you have a competitive market for the support. You can hire anybody. I distribute a service list with EMACS, a list of people's names and phone numbers and what they charge to provide support. BYTE: Do you collect their bug fixes? Stallman: Well, they send them to me. I asked all the people who wanted to be listed to promise that they would never ask any of their customers to keep secret whatever they were told or any changes they were given to the GNU software as part of that support. BYTE: So you can't have people competing to provide support based on their knowing the solution to some problem that somebody else doesn't know. Stallman: No. They can compete based on their being clever and more likely to find the solution to your problem, or their already understanding more of the common problems, or knowing better how to explain to you what you should do. These are all ways they can compete. They can try to do better, but they cannot actively impede their competitors. BYTE: I suppose it's like buying a car. You're not forced to go back to the original manufacturer for support or continued maintenance. Stallman: Or buying a house--what would it be like if the only person who could ever fix problems with your house was the contractor who built it originally? That is the kind of imposition that's involved in proprietary software. People tell me about a problem that happens in UNIX. Because manufacturers sell improved versions of UNIX, they tend to collect fixes and not give them out except in binaries. The result is that the bugs don't really get fixed. BYTE: They're all duplicating effort trying to solve bugs independently. Stallman: Yes. Here is another point that helps put the problem of proprietary information in a social perspective. Think about the liability insurance crisis. In order to get any compensation from society, an injured person has to hire a lawyer and split the money with that lawyer. This is a stupid and inefficient way of helping out people who are victims of accidents. And consider all the time that people put into hustling to take business away from their competition. Think of the pens that are packaged in large cardboard packages that cost more than the pen--just to make sure that the pen isn't stolen. Wouldn't it be better if we just put free pens on every street corner? And think of all the toll booths that impede the flow of traffic. It's a gigantic social phenomenon. People find ways of getting money by impeding society. Once they can impede society, they can be paid to leave people alone. The waste inherent in owning information will become more and more important and will ultimately make the difference between the utopia in which nobody really has to work for a living because it's all done by robots and a world just like ours where everyone spends much time replicating what the next fellow is doing. BYTE: Like typing in copyright notices on the software. Stallman: More like policing everyone to make sure that they don't have forbidden copies of anything and duplicating all the work people have already done because it is proprietary. BYTE: A cynic might wonder how you earn your living. Stallman: From consulting. When I do consulting, I always reserve the right to give away what I wrote for the consulting job. Also, I could be making my living by mailing copies of the free software that I wrote and some that other people wrote. Lots of people send in $150 for GNU EMACS, but now this money goes to the Free Software Foundation that I started. The foundation doesn't pay me a salary because it would be a conflict of interest. Instead, it hires other people to work on GNU. As long as I can go on making a living by consulting I think that's the best way. BYTE: What is currently included in the official GNU distribution tape? Stallman: Right now the tape contains GNU EMACS (one version fits all computers); Bison, a program that replaces YACC; MIT Scheme, which is Professor Sussman's super-simplified dialect of LISP; and Hack, a dungeon-exploring game similar to Rogue. BYTE: Does the printed manual come with the tape as well? Stallman: No. Printed manuals cost $15 each or copy them yourself. Copy this interview and share it, too. BYTE: How can you get a copy of that? Stallman: Write to the Free Software Foundation, 675 Massachusetts Ave., Cambridge, MA 02139. [In June 1995, this address changed to: Free Software Foundation 59 Temple Place - Suite 330 Boston, MA 02111-1307, USA Voice: +1-617-542-5942 Fax: +1-617-542-2652 -gnu@prep.ai.mit.edu ] BYTE: What are you going to do when you are done with the GNU system? Stallman: I'm not sure. Sometimes I think that what I'll go on to do is the same thing in other areas of software. BYTE: So this is just the first of a whole series of assaults on the software industry? Stallman: I hope so. But perhaps what I'll do is just live a life of ease working a little bit of the time just to live. I don't have to live expensively. The rest of the time I can find interesting people to hang around with or learn to do things that I don't know how to do. Editorial Note: BYTE holds the right to provide this interview on BIX but will not interfere with its distribution. Richard Stallman, 545 Technology Square, Room 703, Cambridge, MA 02139. Copyright (C) 1986 Richard Stallman. Permission is granted to make and distribute copies of this article as long as the copyright and this notice appear on all copies. emacs-19.30/etc/JOKES100644 21641 13 27533 5472543727 13256 0ustar friedmanuserFrom: Don Chiasson Subject: Some gnu jokes To: jokes@DREA-XX.ARPA, gergely@DREA-XX.ARPA, broome@DREA-XX.ARPA cc: G.CHIASSON@DREA-XX.ARPA Message-ID: <12329394624.13.G.CHIASSON@DREA-XX.ARPA> Richard M. Stallman (RMS, widely known for creating EMACS) is writing a UNIX clone called GNU (which means Gnu's Not Unix--a recursive acronym). This seems to open the way to a whole gnu class of jokes. For example: Q: What do you call a person who hacks while wearing no clothes? A: A gnudist. Q: What do you call an eligible young hacker? A: Gnubile. Q: What is a hacker's favorite candy? A: Gnugat. (Though it contains little gnutrition.) Q: What do you call a computer filled with air? A: Gnumatic. Q: What do you call a novice hacker who keeps pestering you with foolish questions? A: A gnuisance. Q: What do you call a subtle, clever hack in the favorite language? A: A gnuanCe. Q: What do you use a supercomputer for? A: Gnumerical analysis. Q: What do you call a hacker who collects coins? A: A gnumismatist. Well, there are more, just too gnumerous to tell all at once. I think I'd better go before someone starts firing gnuclear weapons at me. Don From: patl@athena.mit.edu (Patrick J. LoPresti) Message-ID: <1991Jul11.031731.9260@athena.mit.edu> Sender: news@athena.mit.edu (News system) Subject: The True Path (long) Date: 11 Jul 91 03:17:31 GMT Path: ai-lab!mintaka!olivea!samsung!zaphod.mps.ohio-state.edu!think.com!snorkelwacker.mit.edu!bloom-picayune.mit.edu!athena.mit.edu!patl Newsgroups: alt.religion.emacs,alt.slack Organization: Massachusetts Institute of Technology Lines: 95 Xref: ai-lab alt.religion.emacs:244 alt.slack:1935 When I log into my Xenix system with my 110 baud teletype, both vi *and* Emacs are just too damn slow. They print useless messages like, 'C-h for help' and '"foo" File is read only'. So I use the editor that doesn't waste my VALUABLE time. Ed, man! !man ed ED(1) UNIX Programmer's Manual ED(1) NAME ed - text editor SYNOPSIS ed [ - ] [ -x ] [ name ] DESCRIPTION Ed is the standard text editor. - --- Computer Scientists love ed, not just because it comes first alphabetically, but because it's the standard. Everyone else loves ed because it's ED! "Ed is the standard text editor." And ed doesn't waste space on my Timex Sinclair. Just look: - -rwxr-xr-x 1 root 24 Oct 29 1929 /bin/ed - -rwxr-xr-t 4 root 1310720 Jan 1 1970 /usr/ucb/vi - -rwxr-xr-x 1 root 5.89824e37 Oct 22 1990 /usr/bin/emacs Of course, on the system *I* administrate, vi is symlinked to ed. Emacs has been replaced by a shell script which 1) Generates a syslog message at level LOG_EMERG; 2) reduces the user's disk quota by 100K; and 3) RUNS ED!!!!!! "Ed is the standard text editor." Let's look at a typical novice's session with the mighty ed: golem> ed ? help ? ? ? quit ? exit ? bye ? hello? ? eat flaming death ? ^C ? ^C ? ^D ? - --- Note the consistent user interface and error reportage. Ed is generous enough to flag errors, yet prudent enough not to overwhelm the novice with verbosity. "Ed is the standard text editor." Ed, the greatest WYGIWYG editor of all. ED IS THE TRUE PATH TO NIRVANA! ED HAS BEEN THE CHOICE OF EDUCATED AND IGNORANT ALIKE FOR CENTURIES! ED WILL NOT CORRUPT YOUR PRECIOUS BODILY FLUIDS!! ED IS THE STANDARD TEXT EDITOR! ED MAKES THE SUN SHINE AND THE BIRDS SING AND THE GRASS GREEN!! When I use an editor, I don't want eight extra KILOBYTES of worthless help screens and cursor positioning code! I just want an EDitor!! Not a "viitor". Not a "emacsitor". Those aren't even WORDS!!!! ED! ED! ED IS THE STANDARD!!! TEXT EDITOR. When IBM, in its ever-present omnipotence, needed to base their "edlin" on a UNIX standard, did they mimic vi? No. Emacs? Surely you jest. They chose the most karmic editor of all. The standard. Ed is for those who can *remember* what they are working on. If you are an idiot, you should use Emacs. If you are an Emacs, you should not be vi. If you use ED, you are on THE PATH TO REDEMPTION. THE SO-CALLED "VISUAL" EDITORS HAVE BEEN PLACED HERE BY ED TO TEMPT THE FAITHLESS. DO NOT GIVE IN!!! THE MIGHTY ED HAS SPOKEN!!! ? From: The Unknown User Subject: EMACS -- What does it mean? To: mit-prep!info-gnu-emacs@TOPAZ.RUTGERS.EDU EMACS belongs in : Editor too big! Escape-Meta-Alt-Control-Shift From: harvard!topaz!BLUE!BRAIL@mit-eddie Date: 9 Sep 85 17:25:27 EDT Subject: EMACS -- What does it mean? To: mit-prep!info-gnu-emacs@TOPAZ.RUTGERS.EDU EMACS may stand for "Editing MACroS," but some friends of mine suggested some more creative definitions. Here they are. Anyone have any additions? -------- Eight Megabytes And Constantly Swapping Even a Master of Arts Comes Simpler Emacs Manuals Are Cryptic and Surreal Energetic Merchants Always Cultivate Sales Each Manual's Audience is Completely Stupified Emacs Means A Crappy Screen Eventually Munches All Computer Storage Even My Aunt Crashes the System Eradication of Memory Accomplished with Complete Simplicity Elsewhere Maybe Alternative Civilizations Survive Egregious Managers Actively Court Stallman Esoteric Malleability Always Considered Silly Emacs Manuals Always Cause Senility Easily Maintained with the Assistance of Chemical Solutions EMACS MACRO ACTED CREDO SODOM Edwardian Manifestation of All Colonial Sins Generally Not Used Except by Middle Aged Computer Scientists Extended Macros Are Considered Superfluous Every Mode Accelerates Creation of Software Elsewhere Maybe All Commands are Simple Emacs May Allow Customised Screwups Excellent Manuals Are Clearly Suppressed Emetic Macros Assault Core and Segmentation Embarrassed Manual-Writer Accused of Communist Subversion Extensibility and Modifiability Aggravate Confirmed Simpletons Emacs May Annihilate Command Structures Easily Mangles, Aborts, Crashes and Stupifies Extraneous Macros And Commands Stink Exceptionally Mediocre Algorithm for Computer Scientists EMACS Makes no Allowances Considering its Stiff price Equine Mammals Are Considerably Smaller Embarrassingly Mundane Advertising Cuts Sales Every Moron Assumes CCA is Superior Exceptionally Mediocre Autocratic Control System EMACS May Alienate Clients and Supporters Excavating Mayan Architecture Comes Simpler Erasing Minds Allows Complete Submission Every Male Adolescent Craves Sex Elephantine Memory Absolutely Considered Sine que non Emacs Makers Are Crazy Sickos Eenie-Meenie-Miney-Mo- Macros Are Completely Slow Experience the Mildest Ad Campaign ever Seen Emacs Makefiles Annihilate C- Shells Eradication of Memory Accomplished with Complete Simplicity Emetic Macros Assault Core and Segmentation Epileptic MLisp Aggravates Compiler Seizures Eleven thousand Monkeys Asynchronously Crank out these Slogans ------- From: ihnss!warren@mit-eddie (Warren Montgomery) Newsgroups: net.emacs Subject: Re: EMACS -- What does it mean? Date: Tue, 10-Sep-85 09:14:24 EDT Organization: AT&T Bell Labs, Naperville, IL Apparently-To: emacs-netnews-distribution@mit-prep Someone at a luncheon suggested it meant: Evenings, Mornings, And a Couple of Saturdays (In reference to the odd hours that went into the creation of my implementation). -- Warren Montgomery ihnss!warren IH ((312)-979) x2494 Date: Wed, 18 Sep 85 10:11:04 edt From: inmet!tower@inmet.inmet (Leonard H. Tower Jr.) Subject: Re: EMACS -- What does it mean? To: tower@MIT-PREP.ARPA Received: by inmet.uucp (4.12/inmet) id AA02199; Wed, 18 Sep 85 09:10:17 edt Date: Wed, 18 Sep 85 09:10:17 edt Message-Id: <8509181310.AA02199@inmet.uucp> Uucp-Paths: {bellcore,ima,ihnp4}!inmet!tower Arpa-Path: ima!inmet!tower@CCA-UNIX.ARPA Organization: Intermetrics, Inc., Cambridge, MA, USA Home: 36 Porter Street, Somerville, MA 02143, USA +1 (617) 623-7739 /* Written 6:48 pm Sep 14, 1985 by gml@ssc-vax in inmet:net.emacs */ /* ---------- "Re: EMACS -- What does it mean?" ---------- */ Pleeeeeeeze!!! Nice try on the meaning of EMACS. I believe the correct acronym is: Emacs Makes All Computing Simple Thank you, and Good Night /* End of text from inmet:net.emacs */ From: ho95e!wcs@mit-eddie (Bill.Stewart.4K435.x0705) Newsgroups: net.emacs Subject: Re: EMACS -- What does it mean? Date: Thu, 26-Sep-85 21:43:54 EDT Organization: AT&T Bell Labs, Holmdel NJ Apparently-To: emacs-netnews-distribution@mit-prep > > very interesting, but what does GNU stand for ? > GNU = Gnu's Not UNIX. There is also MINCE, for Mince Is Not a Complete Emacs. > More recursive acronyms, anyone? Many people have also seen FINE Is Not Emacs, but the one that has character is THief Isn't Even Fine. -- ## Bill Stewart, AT&T Bell Labs, Holmdel NJ 1-201-949-0705 ihnp4!ho95c!wcs Path: mit-eddie!think!harvard!bbnccv!bbncca!linus!decvax!mcnc!ncsu!uvacs!edison!ta2 From: edison!ta2@mit-eddie (tom allebrandi) Newsgroups: net.emacs Subject: Re: Re: EMACS -- What does it mean? Date: Sun, 29-Sep-85 18:11:55 EDT Organization: General Electric's Mountain Resort Apparently-To: emacs-netnews-distribution@mit-prep > GNU = Gnu's Not UNIX. There is also MINCE, for Mince Is Not a Complete Emacs. > > More recursive acronyms, anyone? > For the DEC-system-10/20: FINE - Fine Is Not Emacs..... -- ............... tom allebrandi 2, general electric aco, charlottesville, va {decvax,duke}!mcnc!ncsu!uvacs!edison!ta2 box 8106, charlottesville, va, 22906 (804) 978-5566 ............... Date: Wed, 16 Oct 85 01:38:12 edt From: inmet!tower (Leonard H. Tower Jr.) Subject: more names To: tower@MIT-PREP.ARPA Received: by inmet.uucp (4.12/inmet) id AA12997; Tue, 15 Oct 85 22:31:39 edt Date: Tue, 15 Oct 85 22:31:39 edt Message-Id: <8510160231.AA12997@inmet.uucp> Uucp-Paths: {bellcore,ima,ihnp4}!inmet!tower Arpa-Path: ima!inmet!tower@CCA-UNIX.ARPA Organization: Intermetrics, Inc., Cambridge, MA, USA Home: 36 Porter Street, Somerville, MA 02143, USA +1 (617) 623-7739 /* Written 12:20 pm Oct 14, 1985 by rs@mirror.UUCP in inmet:net.emacs */ SINE: Sine Is Not Emacs (MIT Architecture Machine Group) EINE: Eine is Not Emacs (MIT Lisp Machine) ZWEI: Zwei Was Eine Initially ("rev2" of EINE) -- Rich $alz {mit-eddie, ihnp4!inmet, wjh12, cca, datacube} !mirror!rs Mirror Systems 2067 Massachusetts Ave. 617-661-0777 Cambridge, MA, 02140 /* End of text from inmet:net.emacs */ Path: mit-eddie!genrad!panda!talcott!harvard!seismo!gatech!ulysses!pajb From: ulysses!pajb@mit-eddie (Paul Bennett) Newsgroups: net.emacs Subject: Here we go again ... Date: Sat, 19-Oct-85 17:26:49 EDT Organization: AT&T Bell Laboratories, Murray Hill Apparently-To: emacs-netnews-distribution@mit-prep > EINE: Eine is Not Emacs > (MIT Lisp Machine) > > ZWEI: Zwei Was Eine Initially > ("rev2" of EINE) DREI: DREI - Really Emacs Inside (Exists only in my head) From: friedman@gnu.ai.mit.edu (Noah Friedman) Sender: friedman@gnu.ai.mit.edu To: jimb@gnu.ai.mit.edu, rms@gnu.ai.mit.edu Subject: etc/emacs.names Date: Fri, 9 Oct 92 00:54:57 edt The following should be added: Emacs Makes A Computer Slow From: S_TITZ@iravcl.ira.uka.de (Olaf Titz) Newsgroups: alt.religion.emacs Subject: Re: what emacs stands for Date: 12 Oct 92 19:29:32 GMT Emacs Masquerades As Comfortable Shell Ever Made A Control-key Setup? Emacs: My Alternative Computer Story Emacs Made Almost Completely Screwed (by extensive use of M-x global-unset-key) Emacs Macht Alle Computer Schoen (deutsch) (=Emacs makes all computers beautiful) Each Mail A Continued Surprise Every Mode Acknowledges Customized Strokes (keystrokes, of course :-) Eating Memory And Cycle-Sucking Everyday Material Almost Compiled Successfully now enough bashing for today :-) From: elvis@gnu.ai.mit.edu To: emacs-19-bugs@gnu.ai.mit.edu Subject: missing from etc/emacs.names Date: Thu, 20 May 93 02:21:27 edt Elvis Masterminds All Computer Software Just so you boys know the score. Thank you very Much, The King emacs-19.30/etc/LEDIT100666 13437 1 5750 3461063270 12611 0ustar jimbdaemonDate: 17 Apr 85 15:45:42 EST (Wed) From: Martin David Connor Date: Sat, 13 Apr 85 16:28:15 est From: Richard M. Stallman Can you help this person? Also, can you give me the rest of ledit to distribute, plus some info on how to use it? I have put the files "ledit.l" and "leditcfns.c" on prep:~mdc. Much to my disgust ledit.l relied on some bogus little package of functions on HT, so I had to massage it a bit. To get it to work, one must: - Compile leditcfns.c with something like: cc leditcfns.c - Edit ledit.l, changing the line beginning "(cfasl" to have the right pathname for the cfns file you compiled in the last step. - Compile ledit.l with: liszt ledit.l Then put the following lines in your .lisprc file: ;load in functions for emacs interface (load "//src//mdc//ledit//ledit") ; Location of Ledit library (set-proc-str "%gnumacs") ; Name of editor Then you can use ^E to get from LISP back to gnumacs. Here is the part of my .emacs file that pertains to ledit. ;;; Set up ledit mode (setq ledit-go-to-lisp-string "%lisp") (setq lisp-mode-hook 'ledit-from-lisp-mode) Date: Sat, 13 Apr 85 11:26:32 cst From: neves@wisc-ai.arpa (David Neves) This is a documentation question. I cannot figure out how to use Ledit. I suspect I need some function on the Franz Lisp end of things to go to Emacs and read in the temporary file. Is this true? Is the Lisp job started within Emacs or outside of emacs? I'm just plain confused. Perhaps a couple of words from someone in the know would help. A related question. I have been using a shell buffer when interacting with Lisp (ie. put a definition in the kill buffer and then yank it into the shell buffer to redefine it). This is nice but tends to fill up the shell buffer with lots of code (I'd rather keep calls to functions in the shell and not the functions themselves). My question: Is using the shell buffer "better" than ledit? Am I using it in the best way (i.e. copying definitions from an edit buffer to the shell buffer)? -Thanks, David Neves I have found that ledit works well for doing programming development when you are changing lots of little pieces of a file and don't wish to recompile the whole file. Of course M-X Compile is very nice for calling up a liszt on a buffer and watching it in the another window. Of course the interface of something like NIL is even better because you can compile your function directly into your lisp. But since NIL doesn't run under Unix, this is probably the next best thing. I have tried the 2 window method (shell in lower window, lisp code in upper), and have found it a little awkward. It does have certain advantages, but most of the time, I get be fine using M-C-D to save a defun for lisp, and C-X Z to jump back to LISP. C-E RETURN from lisp is also mnemonic for getting back to gnumacs. I hope this helps somewhat. emacs-19.30/etc/LNEWS100666 12120 13 403703 5542522042 12301 0ustar rmsuserThis is Info file LNEWS, produced by Makeinfo-1.54 from the input file news.texi. This file describes the new Lisp features of Emacs version 19 as first released to the public. For Lisp changes in subsequent Emacs 19 releases, see the file NEWS. New Features in the Lisp Language ================================= * The new function `delete' is a traditional Lisp function. It takes two arguments, ELT and LIST, and deletes from LIST any elements that are equal to ELT. It uses the function `equal' to compare elements with ELT. * The new function `member' is a traditional Lisp function. It takes two arguments, ELT and LIST, and finds the first element of LIST that is equal to ELT. It uses the function `equal' to compare each list element with ELT. The value is a sublist of LIST, whose first element is the one that was found. If no matching element is found, the value is `nil'. * The new function `indirect-function' finds the effective function definition of an object called as a function. If the object is a symbol, `indirect-function' looks in the function definition of the symbol. It keeps doing this until it finds something that is not a symbol. * There are new escape sequences for use in character and string constants. The escape sequence `\a' is equivalent to `\C-g', the ASCII BEL character (code 7). The escape sequence `\x' followed by a hexidecimal number represents the character whose ASCII code is that number. There is no limit on the number of digits in the hexidecimal value. * The function `read' when reading from a buffer now does not skip a terminator character that terminates a symbol. It leaves that character to be read (or just skipped, if it is whitespace) next time. * When you use a function FUNCTION as the input stream for `read', it is usually called with no arguments, and should return the next character. In Emacs 19, sometimes FUNCTION is called with one argument (always a character). When that happens, FUNCTION should save the argument and arrange to return it when called next time. * `random' with integer argument N returns a random number between 0 and N-1. * The functions `documentation' and `documentation-property' now take an additional optional argument which, if non-`nil', says to refrain from calling `substitute-command-keys'. This way, you get the exact text of the documentation string as written, without the usual substitutions. Make sure to call `substitute-command-keys' yourself if you decide to display the string. * The new function `invocation-name' returns as a string the program name that was used to run Emacs, with any directory names discarded. * The new function `map-y-or-n-p' makes it convenient to ask a series of similar questions. The arguments are PROMPTER, ACTOR, LIST, and optional HELP. The value of LIST is a list of objects, or a function of no arguments to return either the next object or `nil' meaning there are no more. The argument PROMPTER specifies how to ask each question. If PROMPTER is a string, the question text is computed like this: (format PROMPTER OBJECT) where OBJECT is the next object to ask about. If not a string, PROMPTER should be a function of one argument (the next object to ask about) and should return the question text. The argument ACTOR should be a function of one argument, which is called with each object that the user says yes for. Its argument is always one object from LIST. If HELP is given, it is a list `(OBJECT OBJECTS ACTION)', where OBJECT is a string containing a singular noun that describes the objects conceptually being acted on; OBJECTS is the corresponding plural noun and ACTION is a transitive verb describing ACTOR. The default is `("object" "objects" "act on")'. Each time a question is asked, the user may enter `y', `Y', or SPC to act on that object; `n', `N', or DEL to skip that object; `!' to act on all following objects; ESC or `q' to exit (skip all following objects); `.' (period) to act on the current object and then exit; or `C-h' to get help. `map-y-or-n-p' returns the number of objects acted on. * You can now "set" environment variables with the `setenv' command. This works by setting the variable `process-environment', which `getenv' now examines in preference to the environment Emacs received from its parent. New Features for Loading Libraries ================================== You can now arrange to run a hook if a particular Lisp library is loaded. The variable `after-load-alist' is an alist of expressions to be evalled when particular files are loaded. Each element looks like `(FILENAME FORMS...)'. When `load' is run and the file name argument equals FILENAME, the FORMS in the corresponding element are executed at the end of loading. fILENAME must match exactly! Normally FILENAME is the name of a library, with no directory specified, since that is how `load' is normally called. An error in FORMS does not undo the load, but does prevent execution of the rest of the FORMS. The function `eval-after-load' provides a convenient way to add entries to the alist. Call it with two arguments, FILE and a form to execute. The function `autoload' now supports autoloading a keymap. Use `keymap' as the fourth argument if the autoloaded function will become a keymap when loaded. There is a new feature for specifying which functions in a library should be autoloaded by writing special "magic" comments in that library itself. Write `;;;###autoload' on a line by itself before the real definition of the function, in its autoloadable source file; then the command `M-x update-file-autoloads' automatically puts the `autoload' call into `loaddefs.el'. You can also put other kinds of forms into `loaddefs.el', by writing `;;;###autoload' followed on the same line by the form. `M-x update-file-autoloads' copies the form from that line. Compilation Features ==================== * Inline functions. You can define an "inline function" with `defsubst'. Use `defsubst' just like `defun', and it defines a function which you can call in all the usual ways. Whenever the function thus defined is used in compiled code, the compiler will open code it. You can get somewhat the same effects with a macro, but a macro has the limitation that you can use it only explicitly; a macro cannot be called with `apply', `mapcar' and so on. Also, it takes some work to convert an ordinary function into a macro. To convert it into an inline function, simply replace `defun' with `defsubst'. Making a function inline makes explicit calls run faster. But it also has disadvantages. For one thing, it reduces flexibility; if you change the definition of the function, calls already inlined still use the old definition until you recompile them. Another disadvantage is that making a large function inline can increase the size of compiled code both in files and in memory. Since the advantages of inline functions are greatest for small functions, you generally should not make large functions inline. Inline functions can be used and open coded later on in the same file, following the definition, just like macros. * The command `byte-compile-file' now offers to save any buffer visiting the file you are compiling. * The new command `compile-defun' reads, compiles and executes the defun containing point. If you use this on a defun that is actually a function definition, the effect is to install a compiled version of that function. * Whenever you load a Lisp file or library, you now receive a warning if the directory contains both a `.el' file and a `.elc' file, and the `.el' file is newer. This typically indicates that someone has updated the Lisp code but forgotten to recompile it, so the changes do not take effect. The warning is a reminder to recompile. * The special form `eval-when-compile' marks the forms it contains to be evaluated at compile time *only*. At top-level, this is analogous to the Common Lisp idiom `(eval-when (compile) ...)'. Elsewhere, it is similar to the Common Lisp `#.' reader macro (but not when interpreting). If you're thinking of using this feature, we recommend you consider whether `provide' and `require' might do the job as well. * The special form `eval-and-compile' is similar to `eval-when-compile', but the whole form is evaluated both at compile time and at run time. If you're thinking of using this feature, we recommend you consider whether `provide' and `require' might do the job as well. * Emacs Lisp has a new data type for byte-code functions. This makes them faster to call, and also saves space. Internally, a byte-code function object is much like a vector; however, the evaluator handles this data type specially when it appears as a function to be called. The printed representation for a byte-code function object is like that for a vector, except that it starts with `#' before the opening `['. A byte-code function object must have at least four elements; there is no maximum number, but only the first six elements are actually used. They are: ARGLIST The list of argument symbols. BYTE-CODE The string containing the byte-code instructions. CONSTANTS The vector of constants referenced by the byte code. STACKSIZE The maximum stack size this function needs. DOCSTRING The documentation string (if any); otherwise, `nil'. INTERACTIVE The interactive spec (if any). This can be a string or a Lisp expression. It is `nil' for a function that isn't interactive. The predicate `byte-code-function-p' tests whether a given object is a byte-code function. You can create a byte-code function object in a Lisp program with the function `make-byte-code'. Its arguments are the elements to put in the byte-code function object. You should not try to come up with the elements for a byte-code function yourself, because if they are inconsistent, Emacs may crash when you call the function. Always leave it to the byte compiler to create these objects; it, we hope, always makes the elements consistent. Floating Point Numbers ====================== You can now use floating point numbers in Emacs, if you define the macro `LISP_FLOAT_TYPE' when you compile Emacs. The printed representation for floating point numbers requires either a decimal point surrounded by digits, or an exponent, or both. For example, `1500.0', `15e2', `15.0e2' and `1.5e3' are four ways of writing a floating point number whose value is 1500. The existing predicate `numberp' now returns `t' if the argument is any kind of number--either integer or floating. The new predicates `integerp' and `floatp' check for specific types of numbers. You can do arithmetic on floating point numbers with the ordinary arithmetic functions, `+', `-', `*' and `/'. If you call one of these functions with both integers and floating point numbers among the arguments, the arithmetic is done in floating point. The same applies to the numeric comparison functions such as `=' and `<'. The remainder function `%' does not accept floating point arguments, and neither do the bitwise boolean operations such as `logand' or the shift functions such as `ash'. There is a new arithmetic function, `abs', which returns the absolute value of its argument. It handles both integers and floating point numbers. To convert an integer to floating point, use the function `float'. There are four functions to convert floating point numbers to integers; they differ in how they round. `truncate' rounds toward 0, `floor' rounds down, `ceil' rounds up, and `round' produces the nearest integer. You can use `logb' to extract the binary exponent of a floating point number. More precisely, it is the logarithm base 2, rounded down to an integer. Emacs has several new mathematical functions that accept any kind of number as argument, but always return floating point numbers. `cos' `sin' `tan' Trigonometric functions. `acos' `asin' `atan' Inverse trigonometric functions. `exp' The exponential function (power of E). `log' Logarithm base E. `log10' Logarithm base 10 `expt' Raise X to power Y. `sqrt' The square root function. The new function `string-to-number' now parses a string containing either an integer or a floating point number, returning the number. The `format' function now handles the specifications `%e', `%f' and `%g' for printing floating point numbers; likewise `message'. The new variable `float-output-format' controls how Lisp prints floating point numbers. Its value should be `nil' or a string. If it is a string, it should contain a `%'-spec like those accepted by `printf' in C, but with some restrictions. It must start with the two characters `%.'. After that comes an integer which is the precision specification, and then a letter which controls the format. The letters allowed are `e', `f' and `g'. Use `e' for exponential notation (`DIG.DIGITSeEXPT'). Use `f' for decimal point notation (`DIGITS.DIGITS'). Use `g' to choose the shorter of those two formats for the number at hand. The precision in any of these cases is the number of digits following the decimal point. With `e', a precision of 0 means to omit the decimal point. 0 is not allowed with `f' or `g'. A value of `nil' means to use the format `%.20g'. No matter what the value of `float-output-format', printing ensures that the result fits the syntax rules for a floating point number. If it doesn't fit (for example, if it looks like an integer), it is modified to fit. By contrast, the `format' function formats floating point numbers without requiring the output to fit the syntax rules for floating point number. New Features for Printing And Formatting Output =============================================== * The `format' function has a new feature: `%S'. This print spec prints any kind of Lisp object, even a string, using its Lisp printed representation. By contrast, `%s' prints everything without quotation. * `prin1-to-string' now takes an optional second argument which says not to print the Lisp quotation characters. (In other words, to use `princ' instead of `prin1'.) * The new variable `print-level' specifies the maximum depth of list nesting to print before cutting off all deeper structure. A value of `nil' means no limit. Changes in Basic Editing Functions ================================== * There are two new primitives for putting text in the kill ring: `kill-new' and `kill-append'. The function `kill-new' adds a string to the front of the kill ring. Use `kill-append' to add a string to a previous kill. The second argument BEFORE-P, if non-`nil', says to add the string at the beginning; otherwise, it goes at the end. Both of these functions apply `interprogram-cut-function' to the entire string of killed text that ends up at the beginning of the kill ring. * The new function `current-kill' rotates the yanking pointer in the kill ring by N places, and returns the text at that place in the ring. If the optional second argument DO-NOT-MOVE is non-`nil', it doesn't actually move the yanking point; it just returns the Nth kill forward. If N is zero, indicating a request for the latest kill, `current-kill' calls `interprogram-paste-function' (documented below) before consulting the kill ring. All Emacs Lisp programs should either use `current-kill', `kill-new', and `kill-append' to manipulate the kill ring, or be sure to call `interprogram-paste-function' and `interprogram-cut-function' as appropriate. * The variables `interprogram-paste-function' and `interprogram-cut-function' exist so that you can provide functions to transfer killed text to and from other programs. * The `kill-region' function can now be used in read-only buffers. It beeps, but adds the region to the kill ring without deleting it. * The new function `compare-buffer-substrings' lets you compare two substrings of the same buffer or two different buffers. Its arguments look like this: (compare-buffer-substrings BUF1 BEG1 END1 BUF2 BEG2 END2) The first three arguments specify one substring, giving a buffer and two positions within the buffer. The last three arguments specify the other substring in the same way. The value is negative if the first substring is less, positive if the first is greater, and zero if they are equal. The absolute value of the result is one plus the index of the first different characters. * Overwrite mode treats tab and newline characters specially. You can now turn off this special treatment by setting `overwrite-binary-mode' to `t'. * Once the mark "exists" in a buffer, it normally never ceases to exist. However, in Transient Mark mode, it may become "inactive". The variable `mark-active', which is always local in all buffers, indicates whether the mark is active: non-`nil' means yes. When the mark is inactive, the function `mark' normally gets an error. However, `(mark t)' returns the position of the inactive mark. The function `push-mark' normally does not activate the mark. However, it accepts an optional third argument ACTIVATE which, if non-`nil', says to activate. A command can request deactivation of the mark upon return to the editor command loop by setting `deactivate-mark' to a non-`nil' value. Transient Mark mode works by causing the command loop to take note of `deactivate-mark' and actually deactivate the mark. Transient Mark mode enables highlighting of the region when the mark is active. This is currently implemented only under the X Window System. A few other commands vary their behavior slightly in this case, by testing `transient-mark-mode'. More specifically, they avoid special display actions such as moving the cursor temporarily, which are not needed when the region is shown by highlighting. The variables `activate-mark-hook' and `deactivate-mark-hook' are normal hooks run, respectively, when the mark becomes active and when it becomes inactive. The hook `activate-mark-hook' is also run at the end of a command if the mark is active and the region may have changed. * The function `move-to-column' now accepts a second optional argument FORCE, in addition to COLUMN; if the requested column COLUMN is in the middle of a tab character and FORCE is non-`nil', `move-to-column' replaces the tab with the appropriate sequence of spaces so that it can place point exactly at COLUMN. * The search functions when successful now return the value of point rather than just `t'. This affects the functions `search-forward', `search-backward', `word-search-forward', `word-search-backward', `re-search-forward', and `re-search-backward'. * When you do regular expression searching or matching, there is no longer a limit to how many `\(...\)' pairs you can get information about with `match-beginning' and `match-end'. Also, these parenthetical groupings may now be nested to any degree. * In a regular expression, when you use an asterisk after a parenthetical grouping, and then ask about what range was matched by the grouping, Emacs 19 reports just its last occurrence. Emacs 18 used to report the range of all the repetitions put together. For example, (progn (string-match "f\\(o\\)*" "foo") (list (match-beginning 1) (match-end 1))) returns `(2 3)' in Emacs 19, corresponding to just the last repetition of `\(o\)'. In Emacs 18, that expression returns `(1 3)', encompassing both repetitions. If you want the Emacs 18 behavior, use a grouping *containing* the asterisk: `"f\\(o*\\)"'. * The new special form `save-match-data' preserves the regular expression match status. Usage: `(save-match-data BODY...)'. * The function `translate-region' applies a translation table to the characters in a part of the buffer. Invoke it as `(translate-region START END TABLE)'; START and END bound the region to translate. The translation table TABLE is a string; `(aref TABLE OCHAR)' gives the translated character corresponding to OCHAR. If the length of TABLE is less than 256, any characters with codes larger than the length of TABLE are not altered by the translation. `translate-region' returns the number of characters which were actually changed by the translation. This does not count characters which were mapped into themselves in the translation table. * There are two new hook variables that let you notice all changes in all buffers (or in a particular buffer, if you make them buffer-local): `before-change-function' and `after-change-function'. If `before-change-function' is non-`nil', then it is called before any buffer modification. Its arguments are the beginning and end of the region that is going to change, represented as integers. The buffer that's about to change is always the current buffer. If `after-change-function' is non-`nil', then it is called after any buffer modification. It takes three arguments: the beginning and end of the region just changed, and the length of the text that existed before the change. (To get the current length, subtract the region beginning from the region end.) All three arguments are integers. The buffer that has just changed is always the current buffer. Both of these variables are temporarily bound to `nil' during the time that either of these hooks is running. This means that if one of these functions changes the buffer, that change won't run these functions. If you do want hooks to be run recursively, write your hook functions to bind these variables back to their usual values. * The hook `first-change-hook' is run using `run-hooks' whenever a buffer is changed that was previously in the unmodified state. * The second argument to `insert-abbrev-table-description' is now optional. Text Properties =============== Each character in a buffer or a string can have a "text property list", much like the property list of a symbol. The properties belong to a particular character at a particular place, such as, the letter `T' at the beginning of this sentence. Each property has a name, which is usually a symbol, and an associated value, which can be any Lisp object--just as for properties of symbols. You can use the property `face' to control the font and color of text. Several other property names have special meanings. You can create properties of any name and examine them later for your own purposes. Copying text between strings and buffers preserves the properties along with the characters; this includes such diverse functions as `substring', `insert', and `buffer-substring'. Since text properties are considered part of the buffer contents, changing properties in a buffer "modifies" the buffer, and you can also undo such changes. Strings with text properties have a special printed representation which describes all the properties. This representation is also the read syntax for such a string. It looks like this: #("CHARACTERS" PROPERTY-DATA...) where PROPERTY-DATA is zero or more elements in groups of three as follows: BEG END PLIST The elements BEG and END are integers, and together specify a portion of the string; PLIST is the property list for that portion. Examining Text Properties ------------------------- The simplest way to examine text properties is to ask for the value of a particular property of a particular character. For that, use `get-text-property'. Use `text-properties-at' to get the entire property list of a character. `(get-text-property POS PROP OBJECT)' returns the PROP property of the character after POS in OBJECT (a buffer or string). The argument OBJECT is optional and defaults to the current buffer. `(text-properties-at POS OBJECT)' returns the entire property list of the character after POS in the string or buffer OBJECT (which defaults to the current buffer). Changing Text Properties ------------------------ There are four primitives for changing properties of a specified range of text: `add-text-properties' This function puts on specified properties, leaving other existing properties unaltered. `put-text-property' This function puts on a single specified property, leaving others unaltered. `remove-text-properties' This function removes specified properties, leaving other properties unaltered. `set-text-properties' This function replaces the entire property list, leaving no vestige of the properties that that text used to have. All these functions take four arguments: START, END, PROPS, and OBJECT. The last argument is optional and defaults to the current buffer. The argument PROPS has the form of a property list. Property Search Functions ------------------------- In typical use of text properties, most of the time several or many consecutive characters have the same value for a property. Rather than writing your programs to examine characters one by one, it is much faster to process chunks of text that have the same property value. The functions `next-property-change' and `previous-property-change' scan forward or backward from position POS in OBJECT, looking for a change in any property between two characters scanned. They returns the position between those two characters, or `nil' if no change is found. The functions `next-single-property-change' and `previous-single-property-change' are similar except that you specify a particular property and they look for changes in the value of that property only. The property is the second argument, and OBJECT is third. Special Properties ------------------ If a character has a `category' property, we call it the "category" of the character. It should be a symbol. The properties of the symbol serve as defaults for the properties of the character. You can use the property `face' to control the font and color of text. You can specify a different keymap for a portion of the text by means of a `local-map' property. The property's value, for the character after point, replaces the buffer's local map. If a character has the property `read-only', then modifying that character is not allowed. Any command that would do so gets an error. If a character has the property `modification-hooks', then its value should be a list of functions; modifying that character calls all of those functions. Each function receives two arguments: the beginning and end of the part of the buffer being modified. Note that if a particular modification hook function appears on several characters being modified by a single primitive, you can't predict how many times the function will be called. Insertion of text does not, strictly speaking, change any existing character, so there is a special rule for insertion. It compares the `read-only' properties of the two surrounding characters; if they are `eq', then the insertion is not allowed. Assuming insertion is allowed, it then gets the `modification-hooks' properties of those characters and calls all the functions in each of them. (If a function appears on both characters, it may be called once or twice.) The special properties `point-entered' and `point-left' record hook functions that report motion of point. Each time point moves, Emacs compares these two property values: * the `point-left' property of the character after the old location, and * the `point-entered' property of the character after the new location. If these two values differ, each of them is called (if not `nil') with two arguments: the old value of point, and the new one. The same comparison is made for the characters before the old and new locations. The result may be to execute two `point-left' functions (which may be the same function) and/or two `point-entered' functions (which may be the same function). The `point-left' functions are always called before the `point-entered' functions. A primitive function may examine characters at various positions without moving point to those positions. Only an actual change in the value of point runs these hook functions. New Features for Files ====================== * The new function `file-accessible-directory-p' tells you whether you can open files in a particular directory. Specify as an argument either a directory name or a file name which names a directory file. The function returns `t' if you can open existing files in that directory. * The new function `file-executable-p' returns `t' if its argument is the name of a file you have permission to execute. * The function `file-truename' returns the "true name" of a specified file. This is the name that you get by following symbolic links until none remain. The argument must be an absolute file name. * New functions `make-directory' and `delete-directory' create and delete directories. They both take one argument, which is the name of the directory as a file. * The function `read-file-name' now takes an additional argument which specifies an initial file name. If you specify this argument, `read-file-name' inserts it along with the directory name. It puts the cursor between the directory and the initial file name. The user can then use the initial file name unchanged, modify it, or simply kill it with `C-k'. If the variable `insert-default-directory' is `nil', then the default directory is not inserted, and the new argument is ignored. * The function `file-relative-name' does the inverse of expansion--it tries to return a relative name which is equivalent to FILENAME when interpreted relative to DIRECTORY. (If such a relative name would be longer than the absolute name, it returns the absolute name instead.) * The function `file-newest-backup' returns the name of the most recent backup file for FILENAME, or `nil' that file has no backup files. * The list returned by `file-attributes' now has 12 elements. The 12th element is the file system number of the file system that the file is in. This element together with the file's inode number, which is the 11th element, give enough information to distinguish any two files on the system--no two files can have the same values for both of these numbers. * The new function `set-visited-file-modtime' updates the current buffer's recorded modification time from the visited file's time. This is useful if the buffer was not read from the file normally, or if the file itself has been changed for some known benign reason. If you give the function an argument, that argument specifies the new value for the recorded modification time. The argument should be a list of the form `(HIGH . LOW)' or `(HIGH LOW)' containing two integers, each of which holds 16 bits of the time. (This is the same format that `file-attributes' uses to return time values.) The new function `visited-file-modtime' returns the recorded last modification time, in that same format. * The function `directory-files' now takes an optional fourth argument which, if non-`nil', inhibits sorting the file names. Use this if you want the utmost possible speed and don't care what order the files are processed in. If the order of processing is at all visible to the user, then the user will probably be happier if you do sort the names. * The variable `directory-abbrev-alist' contains an alist of abbreviations to use for file directories. Each element has the form `(FROM . TO)', and says to replace FROM with TO when it appears in a directory name. This replacement is done when setting up the default directory of a newly visited file. The FROM string is actually a regular expression; it should always start with `^'. You can set this variable in `site-init.el' to describe the abbreviations appropriate for your site. * The function `abbreviate-file-name' applies abbreviations from `directory-abbrev-alist' to its argument, and substitutes `~' for the user's home directory. Abbreviated directory names are useful for directories that are normally accessed through symbolic links. If you think of the link's name as "the name" of the directory, you can define it as an abbreviation for the directory's official name; then ordinarily Emacs will call that directory by the link name you normally use. * `write-region' can write a given string instead of text from the buffer. Use the string as the first argument (in place of the starting character position). You can supply a second file name as the fifth argument (VISIT). Use this to write the data to one file (the first argument, FILENAME) while nominally visiting a different file (the fifth argument, VISIT). The argument VISIT is used in the echo area message and also for file locking; VISIT is stored in `buffer-file-name'. * The value of `write-file-hooks' does not change when you switch to a new major mode. The intention is that these hooks have to do with where the file came from, and not with what it contains. * There is a new hook variable for saving files: `write-contents-hooks'. It works just like `write-file-hooks' except that switching to a new major mode clears it back to `nil'. Major modes should use this hook variable rather than `write-file-hooks'. * The hook `after-save-hook' runs just after a buffer has been saved in its visited file. * The new function `set-default-file-modes' sets the file protection for new files created with Emacs. The argument must be an integer. (It would be better to permit symbolic arguments like the `chmod' program, but that would take more work than this function merits.) Use the new function `default-file-modes' to read the current default file mode. * Call the new function `unix-sync' to force all pending disk output to happen as soon as possible. Making Certain File Names "Magic" ================================= You can implement special handling for a class of file names. You must supply a regular expression to define the class of names (all those which match the regular expression), plus a handler that implements all the primitive Emacs file operations for file names that do match. The value of `file-name-handler-alist' is a list of handlers, together with regular expressions that decide when to apply each handler. Each element has the form `(REGEXP . HANDLER)'. If a file name matches REGEXP, then all work on that file is done by calling HANDLER. All the Emacs primitives for file access and file name transformation check the given file name against `file-name-handler-alist', and call HANDLER to do the work if appropriate. The first argument given to HANDLER is the name of the primitive; the remaining arguments are the arguments that were passed to that primitive. (The first of these arguments is typically the file name itself.) For example, if you do this: (file-exists-p FILENAME) and FILENAME has handler HANDLER, then HANDLER is called like this: (funcall HANDLER 'file-exists-p FILENAME) Here are the primitives that you can handle in this way: `add-name-to-file', `copy-file', `delete-directory', `delete-file', `directory-file-name', `directory-files', `dired-compress-file', `dired-uncache', `expand-file-name', `file-accessible-directory-p', `file-attributes', `file-directory-p', `file-executable-p', `file-exists-p', `file-local-copy', `file-modes', `file-name-all-completions', `file-name-as-directory', `file-name-completion', `file-name-directory', `file-name-nondirectory', `file-name-sans-versions', `file-newer-than-file-p', `file-readable-p', `file-symlink-p', `file-writable-p', `insert-directory', `insert-file-contents', `load', `make-directory', `make-symbolic-link', `rename-file', `set-file-modes', `set-visited-file-modtime', `unhandled-file-name-directory', `verify-visited-file-modtime', `write-region'. The handler function must handle all of the above operations, and possibly others to be added in the future. Therefore, it should always reinvoke the ordinary Lisp primitive when it receives an operation it does not recognize. Here's one way to do this: (defun my-file-handler (operation &rest args) ;; First check for the specific operations ;; that we have special handling for. (cond ((eq operation 'insert-file-contents) ...) ((eq operation 'write-region) ...) ... ;; Handle any operation we don't know about. (t (let (file-name-handler-alist) (apply operation args))))) The function `file-local-copy' copies file FILENAME to the local site, if it isn't there already. If FILENAME specifies a "magic" file name which programs outside Emacs cannot directly read or write, this copies the contents to an ordinary file and returns that file's name. If FILENAME is an ordinary file name, not magic, then this function does nothing and returns `nil'. The function `unhandled-file-name-directory' is used to get a non-magic directory name from an arbitrary file name. It uses the directory part of the specified file name if that is not magic. Otherwise, it asks the file name's handler what to do. Frames ====== Emacs now supports multiple X windows via a new data type known as a "frame". A frame is a rectangle on the screen that contains one or more Emacs windows. Subdividing a frame works just like subdividing the screen in earlier versions of Emacs. There are two kinds of frames: terminal frames and X window frames. Emacs creates one terminal frame when it starts up with no X display; it uses Termcap or Terminfo to display using characters. There is no way to create another terminal frame after startup. If Emacs has an X display, it does not make a terminal frame, and there is none. When you are using X windows, Emacs starts out with a single X window frame. You can create any number of X window frames using `make-frame'. Use the predicate `framep' to determine whether a given Lisp object is a frame. The function `redraw-frame' redisplays the entire contents of a given frame. Creating and Deleting Frames ---------------------------- Use `make-frame' to create a new frame. This is the only primitive for creating frames. In principle it could work under any window system which Emacs understands; the only one we support is X. `make-frame' takes just one argument, which is an alist specifying frame parameters. Any parameters not mentioned in the argument alist default based on the value of `default-frame-alist'; parameters not specified there default from the standard X defaults file and X resources. When you invoke Emacs, if you specify arguments for window appearance and so forth, these go into `default-frame-alist' and that is how they have their effect. You can specify the parameters for the initial startup X window frame by setting `initial-frame-alist' in your `.emacs' file. If these parameters specify a separate minibuffer-only frame, and you have not created one, Emacs creates one for you, using the parameter values specified in `minibuffer-frame-alist'. You can specify the size and position of a frame using the frame parameters `left', `top', `height' and `width'. You must specify either both size parameters or neither. You must specify either both position parameters or neither. The geometry parameters that you don't specify are chosen by the window manager in its usual fashion. The function `x-parse-geometry' converts a standard X-style geometry string to an alist which you can use as part of the argument to `make-frame'. Use the function `delete-frame' to eliminate a frame. Frames are like buffers where deletion is concerned; a frame actually continues to exist as a Lisp object until it is deleted *and* there are no references to it, but once it is deleted, it has no further effect on the screen. The function `frame-live-p' returns non-`nil' if the argument (a frame) has not been deleted. Finding All Frames ------------------ The function `frame-list' returns a list of all the frames that have not been deleted. It is analogous to `buffer-list'. The list that you get is newly created, so modifying the list doesn't have any effect on the internals of Emacs. The function `visible-frame-list' returns the list of just the frames that are visible. `next-frame' lets you cycle conveniently through all the frames from an arbitrary starting point. Its first argument is a frame. Its second argument MINIBUF says what to do about minibuffers: `nil' Exclude minibuffer-only frames. a window Consider only the frames using that particular window as their minibuffer. anything else Consider all frames. Frames and Windows ------------------ All the non-minibuffer windows in a frame are arranged in a tree of subdivisions; the root of this tree is available via the function `frame-root-window'. Each window is part of one and only one frame; you can get the frame with `window-frame'. At any time, exactly one window on any frame is "selected within the frame". You can get the frame's current selected window with `frame-selected-window'. The significance of this designation is that selecting the frame selects for Emacs as a whole the window currently selected within that frame. Conversely, selecting a window for Emacs with `select-window' also makes that window selected within its frame. Frame Visibility ---------------- A frame may be "visible", "invisible", or "iconified". If it is invisible, it doesn't show in the screen, not even as an icon. You can set the visibility status of a frame with `make-frame-visible', `make-frame-invisible', and `iconify-frame'. You can examine the visibility status with `frame-visible-p'--it returns `t' for a visible frame, `nil' for an invisible frame, and `icon' for an iconified frame. Selected Frame -------------- At any time, one frame in Emacs is the "selected frame". The selected window always resides on the selected frame. - Function: selected-frame This function returns the selected frame. The X server normally directs keyboard input to the X window that the mouse is in. Some window managers use mouse clicks or keyboard events to "shift the focus" to various X windows, overriding the normal behavior of the server. Lisp programs can switch frames "temporarily" by calling the function `select-frame'. This does not override the window manager; rather, it escapes from the window manager's control until that control is somehow reasserted. The function takes one argument, a frame, and selects that frame. The selection lasts until the next time the user does something to select a different frame, or until the next time this function is called. Emacs cooperates with the X server and the window managers by arranging to select frames according to what the server and window manager ask for. It does so by generating a special kind of input event, called a "focus" event. The command loop handles a focus event by calling `internal-select-frame'. Frame Size and Position ----------------------- The new functions `frame-height' and `frame-width' return the height and width of a specified frame (or of the selected frame), measured in characters. The new functions `frame-pixel-height' and `frame-pixel-width' return the height and width of a specified frame (or of the selected frame), measured in pixels. The new functions `frame-char-height' and `frame-char-width' return the height and width of a character in a specified frame (or in the selected frame), measured in pixels. `set-frame-size' sets the size of a frame, measured in characters; its arguments are FRAME, COLS and ROWS. To set the size with values measured in pixels, you can use `modify-frame-parameters'. The function `set-frame-position' sets the position of the top left corner of a frame. Its arguments are FRAME, LEFT and TOP. Frame Parameters ---------------- A frame has many parameters that affect how it displays. Use the function `frame-parameters' to get an alist of all the parameters of a given frame. To alter parameters, use `modify-frame-parameters', which takes two arguments: the frame to modify, and an alist of parameters to change and their new values. Each element of ALIST has the form `(PARM . VALUE)', where PARM is a symbol. Parameters that aren't meaningful are ignored. If you don't mention a parameter in ALIST, its value doesn't change. Just what parameters a frame has depends on what display mechanism it uses. Here is a table of the parameters of an X window frame: `name' The name of the frame. `left' The screen position of the left edge. `top' The screen position of the top edge. `height' The height of the frame contents, in pixels. `width' The width of the frame contents, in pixels. `window-id' The number of the X window for the frame. `minibuffer' Whether this frame has its own minibuffer. `t' means yes, `none' means no, `only' means this frame is just a minibuffer, a minibuffer window (in some other frame) means the new frame uses that minibuffer. `font' The name of the font for the text. `foreground-color' The color to use for the inside of a character. Use strings to designate colors; the X server defines the meaningful color names. `background-color' The color to use for the background of text. `mouse-color' The color for the mouse cursor. `cursor-color' The color for the cursor that shows point. `border-color' The color for the border of the frame. `cursor-type' The way to display the cursor. There are two legitimate values: `bar' and `box'. The value `bar' specifies a vertical bar between characters as the cursor. The value `box' specifies an ordinary black box overlaying the character after point; that is the default. `icon-type' Non-`nil' for a bitmap icon, `nil' for a text icon. `border-width' The width in pixels of the window border. `internal-border-width' The distance in pixels between text and border. `auto-raise' Non-`nil' means selecting the frame raises it. `auto-lower' Non-`nil' means deselecting the frame lowers it. `vertical-scroll-bars' Non-`nil' gives the frame a scroll bar for vertical scrolling. Minibufferless Frames --------------------- Normally, each frame has its own minibuffer window at the bottom, which is used whenever that frame is selected. However, you can also create frames with no minibuffers. These frames must use the minibuffer window of some other frame. The variable `default-minibuffer-frame' specifies where to find a minibuffer for frames created without minibuffers of their own. Its value should be a frame which does have a minibuffer. You can also specify a minibuffer window explicitly when you create a frame; then `default-minibuffer-frame' is not used. X Window System Features ======================== * The new functions `mouse-position' and `set-mouse-position' give access to the current position of the mouse. `mouse-position' returns a description of the position of the mouse. The value looks like `(FRAME X . Y)', where X and Y are measured in pixels relative to the top left corner of the inside of FRAME. `set-mouse-position' takes three arguments, FRAME, X and Y, and warps the mouse cursor to that location on the screen. * `track-mouse' is a new special form for tracking mouse motion. Use it in definitions of mouse clicks that want pay to attention to the motion of the mouse, not just where the buttons are pressed and released. Here is how to use it: (track-mouse BODY...) While BODY executes, mouse motion generates input events just as mouse clicks do. BODY can read them with `read-event' or `read-key-sequence'. `track-mouse' returns the value of the last form in BODY. The format of these events is described under "New Input Event Formats." * `x-set-selection' sets a "selection" in the X server. It takes two arguments: a selection type TYPE, and the value to assign to it, DATA. If DATA is `nil', it means to clear out the selection. Otherwise, DATA may be a string, a symbol, an integer (or a cons of two integers or list of two integers), or a cons of two markers pointing to the same buffer. In the last case, the selection is considered to be the text between the markers. The data may also be a vector of valid non-vector selection values. Each possible TYPE has its own selection value, which changes independently. The usual values of TYPE are `PRIMARY' and `SECONDARY'; these are symbols with upper-case names, in accord with X protocol conventions. The default is `PRIMARY'. To get the value of the selection, call `x-get-selection'. This function accesses selections set up by Emacs and those set up by other X clients. It takes two optional arguments, TYPE and DATA-TYPE. The default for TYPE is `PRIMARY'. The DATA-TYPE argument specifies the form of data conversion to use; meaningful values include `TEXT', `STRING', `TARGETS', `LENGTH', `DELETE', `FILE_NAME', `CHARACTER_POSITION', `LINE_NUMBER', `COLUMN_NUMBER', `OWNER_OS', `HOST_NAME', `USER', `CLASS', `NAME', `ATOM', and `INTEGER'. (These are symbols with upper-case names in accord with X Windows conventions.) The default for DATA-TYPE is `STRING'. * The X server has a set of numbered "cut buffers" which can store text or other data being moved between applications. Use `x-get-cut-buffer' to get the contents of a cut buffer; specify the cut buffer number as argument. Use `x-set-cut-buffer' with argument STRING to store a new string into the first cut buffer (moving the other values down through the series of cut buffers, kill-ring-style). Cut buffers are considered obsolete, but Emacs supports them for the sake of X clients that still use them. * You can close the connection with the X server with the function `x-close-current-connection'. This takes no arguments. Then you can connect to a different X server with `x-open-connection'. The first argument, DISPLAY, is the name of the display to connect to. The optional second argument XRM-STRING is a string of resource names and values, in the same format used in the `.Xresources' file. The values you specify override the resource values recorded in the X server itself. Here's an example of what this string might look like: "*BorderWidth: 3\n*InternalBorder: 2\n" * A series of new functions give you information about the X server and the screen you are using. `x-display-screens' The number of screens associated with the current display. `x-server-version' The version numbers of the X server in use. `x-server-vendor' The vendor supporting the X server in use. `x-display-pixel-height' The height of this X screen in pixels. `x-display-mm-height' The height of this X screen in millimeters. `x-display-pixel-width' The width of this X screen in pixels. `x-display-mm-width' The width of this X screen in millimeters. `x-display-backing-store' The backing store capability of this screen. Values can be the symbols `always', `when-mapped', or `not-useful'. `x-display-save-under' Non-`nil' if this X screen supports the SaveUnder feature. `x-display-planes' The number of planes this display supports. `x-display-visual-class' The visual class for this X screen. The value is one of the symbols `static-gray', `gray-scale', `static-color', `pseudo-color', `true-color', and `direct-color'. `x-display-color-p' `t' if the X screen in use is a color screen. `x-display-color-cells' The number of color cells this X screen supports. There is also a variable `x-no-window-manager', whose value is `t' if no X window manager is in use. * The function `x-synchronize' enables or disables an X Windows debugging mode: synchronous communication. It takes one argument, non-`nil' to enable the mode and `nil' to disable. In synchronous mode, Emacs waits for a response to each X protocol command before doing anything else. This means that errors are reported right away, and you can directly find the erroneous command. Synchronous mode is not the default because it is much slower. * The function `x-get-resource' retrieves a resource value from the X Windows defaults database. Its three arguments are ATTRIBUTE, NAME and CLASS. It searches using a key of the form `INSTANCE.ATTRIBUTE', with class `Emacs', where INSTANCE is the name under which Emacs was invoked. The optional arguments COMPONENT and SUBCLASS add to the key and the class, respectively. You must specify both of them or neither. If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE', and the class is `Emacs.SUBCLASS'. * `x-display-color-p' returns `t' if you are using an X server with a color display, and `nil' otherwise. `x-color-defined-p' takes as argument a string describing a color; it returns `t' if the display supports that color. (If the color is `"black"' or `"white"' then even black-and-white displays support it.) * `x-popup-menu' has been generalized. It now accepts a keymap as the MENU argument. Then the menu items are the prompt strings of individual key bindings, and the item values are the keys which have those bindings. You can also supply a list of keymaps as the first argument; then each keymap makes one menu pane (but keymaps that don't provide any menu items don't appear in the menu at all). `x-popup-menu' also accepts a mouse button event as the POSITION argument. Then it displays the menu at the location at which the event took place. This is convenient for mouse-invoked commands that pop up menus. * You can use the function `x-rebind-key' to change the sequence of characters generated by the X server for one of the keyboard keys. The first two arguments, KEYCODE and SHIFT-MASK, should be numbers representing the keyboard code and shift mask respectively. They specify what key to change. The third argument, NEWSTRING, is the new definition of the key. It is a sequence of characters that the key should produce as input. The shift mask value is a combination of bits according to this table: 8 Control 4 Meta 2 Shift 1 Shift Lock If you specify `nil' for SHIFT-MASK, then the key specified by KEYCODE is redefined for all possible shift combinations. For the possible values of KEYCODE and their meanings, see the file `/usr/lib/Xkeymap.txt'. Keep in mind that the codes in that file are in octal! The related function `x-rebind-keys' redefines a single keyboard key, specifying the behavior for each of the 16 shift masks independently. The first argument is KEYCODE, as in `x-rebind-key'. The second argument STRINGS is a list of 16 elements, one for each possible shift mask value; each element says how to redefine the key KEYCODE with the corresponding shift mask value. If an element is a string, it is the new definition. If an element is `nil', the definition does not change for that shift mask. * The function `x-parse-geometry' parses a string specifying window size and position in the usual X format. It returns an alist describing which parameters were specified, and the values that were given for them. The elements of the alist look like `(PARAMETER . VALUE)'. The possible PARAMETER values are `left', `top', `width', and `height'. New Window Features =================== * The new function `window-at' tells you which window contains a given horizontal and vertical position on a specified frame. Call it with three arguments, like this: (window-at X COLUMN FRAME) The function returns the window which contains that cursor position in the frame FRAME. If you omit FRAME, the selected frame is used. * The function `coordinates-in-window-p' takes two arguments and checks whether a particular frame position falls within a particular window. (coordinates-in-window-p COORDINATES WINDOW) The argument COORDINATES is a cons cell of this form: (X . Y) The two coordinates are measured in characters, and count from the top left corner of the screen or frame. The value of the function tells you what part of the window the position is in. The possible values are: `(RELX . RELY)' The coordinates are inside WINDOW. The numbers RELX and RELY are equivalent window-relative coordinates, counting from 0 at the top left corner of the window. `mode-line' The coordinates are in the mode line of WINDOW. `vertical-split' The coordinates are in the vertical line between WINDOW and its neighbor to the right. `nil' The coordinates are not in any sense within WINDOW. You need not specify a frame when you call `coordinates-in-window-p', because it assumes you mean the frame which window WINDOW is on. * The function `minibuffer-window' now accepts a frame as argument and returns the minibuffer window used for that frame. If you don't specify a frame, the currently selected frame is used. The minibuffer window may be on the frame in question, but if that frame has no minibuffer of its own, it uses the minibuffer window of some other frame, and `minibuffer-window' returns that window. * Use `window-live-p' to test whether a window is still alive (that is, not deleted). * Use `window-minibuffer-p' to determine whether a given window is a minibuffer or not. It no longer works to do this by comparing the window with the result of `(minibuffer-window)', because there can be more than one minibuffer window at a time (if you have multiple frames). * If you set the variable `pop-up-frames' non-`nil', then the functions to show something "in another window" actually create a new frame for the new window. Thus, you will tend to have a frame for each window, and you can easily have a frame for each buffer. The value of the variable `pop-up-frame-function' controls how new frames are made. The value should be a function which takes no arguments and returns a frame. The default value is a function which creates a frame using parameters from `pop-up-frame-alist'. * `display-buffer' is the basic primitive for finding a way to show a buffer on the screen. You can customize its behavior by storing a function in the variable `display-buffer-function'. If this variable is non-`nil', then `display-buffer' calls it to do the work. Your function should accept two arguments, as follows: BUFFER The buffer to be displayed. FLAG A flag which, if non-`nil', means you should find another window to display BUFFER in, even if it is already visible in the selected window. The function you supply will be used by commands such as `switch-to-buffer-other-window' and `find-file-other-window' as well as for your own calls to `display-buffer'. * `delete-window' now gives all of the deleted window's screen space to a single neighboring window. Likewise, `enlarge-window' takes space from only one neighboring window until that window disappears; only then does it take from another window. * `next-window' and `previous-window' accept another argument, ALL-FRAMES. These functions now take three optional arguments: WINDOW, MINIBUF and ALL-FRAMES. WINDOW is the window to start from (`nil' means use the selected window). MINIBUF says whether to include the minibuffer in the windows to cycle through: `t' means yes, `nil' means yes if it is active, and anything else means no. Normally, these functions cycle through all the windows in the selected frame, plus the minibuffer used by the selected frame even if it lies in some other frame. If ALL-FRAMES is `t', then these functions cycle through all the windows in all the frames that currently exist. If ALL-FRAMES is neither `t' nor `nil', then they limit themselves strictly to the windows in the selected frame, excluding the minibuffer in use if it lies in some other frame. * The functions `get-lru-window' and `get-largest-window' now take an optional argument ALL-FRAMES. If it is non-`nil', the functions consider all windows on all frames. Otherwise, they consider just the windows on the selected frame. Likewise, `get-buffer-window' takes an optional second argument ALL-FRAMES. * The variable `other-window-scroll-buffer' specifies which buffer `scroll-other-window' should scroll. * You can now mark a window as "dedicated" to its buffer. Then Emacs will not try to use that window for any other buffer unless you explicitly request it. Use the new function `set-window-dedicated-p' to set the dedication flag of a window WINDOW to the value FLAG. If FLAG is `t', this makes the window dedicated. If FLAG is `nil', this makes the window non-dedicated. Use `window-dedicated-p' to examine the dedication flag of a specified window. * The new function `walk-windows' cycles through all visible windows, calling `proc' once for each window with the window as its sole argument. The optional second argument MINIBUF says whether to include minibuffer windows. A value of `t' means count the minibuffer window even if not active. A value of `nil' means count it only if active. Any other value means not to count the minibuffer even if it is active. If the optional third argument ALL-FRAMES is `t', that means include all windows in all frames. If ALL-FRAMES is `nil', it means to cycle within the selected frame, but include the minibuffer window (if MINIBUF says so) that that frame uses, even if it is on another frame. If ALL-FRAMES is neither `nil' nor `t', `walk-windows' sticks strictly to the selected frame. * The function `window-end' is a counterpart to `window-start': it returns the buffer position of the end of the display in a given window (or the selected window). * The function `window-configuration-p' returns non-`nil' when given an object that is a window configuration (such as is returned by `current-window-configuration'). Display Features ================ * `baud-rate' is now a variable rather than a function. This is so you can set it to reflect the effective speed of your terminal, when the system doesn't accurately know the speed. * You can now remove any echo area message and make the minibuffer visible. To do this, call `message' with `nil' as the only argument. This clears any existing message, and lets the current minibuffer contents show through. Previously, there was no reliable way to make sure that the minibuffer contents were visible. * The variable `temp-buffer-show-hook' has been renamed `temp-buffer-show-function', because its value is a single function (of one argument), not a normal hook. * The new function `force-mode-line-update' causes redisplay of the current buffer's mode line. Display Tables ============== You can use the "display table" feature to control how all 256 possible character codes display on the screen. This is useful for displaying European languages that have letters not in the ASCII character set. The display table maps each character code into a sequence of "glyphs", each glyph being an image that takes up one character position on the screen. You can also define how to display each glyph on your terminal, using the "glyph table". Display Tables Proper --------------------- Use `make-display-table' to create a display table. The table initially has `nil' in all elements. A display table is actually an array of 261 elements. The first 256 elements of a display table control how to display each possible text character. The value should be `nil' or a vector (which is a sequence of glyphs; see below). `nil' as an element means to display that character following the usual display conventions. The remaining five elements of a display table serve special purposes (`nil' means use the default stated below): 256 The glyph for the end of a truncated screen line (the default for this is `\'). 257 The glyph for the end of a continued line (the default is `$'). 258 The glyph for the indicating an octal character code (the default is `\'). 259 The glyph for indicating a control characters (the default is `^'). 260 The vector of glyphs for indicating the presence of invisible lines (the default is `...'). Each buffer typically has its own display table. The display table for the current buffer is stored in `buffer-display-table'. (This variable automatically becomes local if you set it.) If this variable is `nil', the value of `standard-display-table' is used in that buffer. Each window can have its own display table, which overrides the display table of the buffer it is showing. If neither the selected window nor the current buffer has a display table, and if `standard-display-table' is `nil', then Emacs uses the usual display conventions: * Character codes 32 through 127 map to glyph codes 32 through 127. * Codes 0 through 31 map to sequences of two glyphs, where the first glyph is the ASCII code for `^'. * Character codes 128 through 255 map to sequences of four glyphs, where the first glyph is the ASCII code for `\', and the others represent digits. The usual display conventions are also used for any character whose entry in the active display table is `nil'. This means that when you set up a display table, you need not specify explicitly what to do with each character, only the characters for which you want unusual behavior. Glyphs ------ A glyph stands for an image that takes up a single character position on the screen. A glyph is represented in Lisp as an integer. The meaning of each integer, as a glyph, is defined by the glyph table, which is the value of the variable `glyph-table'. It should be a vector; the Gth element defines glyph code G. The possible definitions of a glyph code are: INTEGER Define this glyph code as an alias for code INTEGER. This is used with X Windows to specify a face code. STRING Send the characters in STRING to the terminal to output this glyph. This alternative is available only for character terminals, not with X. `NIL' This glyph is simple. On an ordinary terminal, the glyph code mod 256 is the character to output. With X, the glyph code mod 256 is character to output, and the glyph code divided by 256 specifies the "face code" to use while outputting it. Any glyph code beyond the length of the glyph table is automatically simple. If `glyph-table' is `nil', then all possible glyph codes are simple. A "face" is a named combination of a font and a pair of colors (foreground and background). A glyph code can specify a face id number to use for displaying that glyph. ISO Latin 1 ----------- If you have a terminal that can handle the entire ISO Latin 1 character set, you can arrange to use that character set as follows: (require 'disp-table) (standard-display-8bit 0 255) If you are editing buffers written in the ISO Latin 1 character set and your terminal doesn't handle anything but ASCII, you can load the file `iso-ascii' to set up a display table which makes the other ISO characters display as sequences of ASCII characters. For example, the character "o with umlaut" displays as `{"o}'. Some European countries have terminals that don't support ISO Latin 1 but do support the special characters for that country's language. You can define a display table to work one language using such terminals. For an example, see `lisp/iso-swed.el', which handles certain Swedish terminals. You can load the appropriate display table for your terminal automatically by writing a terminal-specific Lisp file for the terminal type. Overlays ======== You can use "overlays" to alter the appearance of a buffer's text on the screen. An overlay is an object which belongs to a particular buffer, and has a specified beginning and end. It also has properties which you can examine and set; these affect the display of the text within the overlay. Overlay Properties ------------------ Overlay properties are like text properties in some respects, but the differences are more important than the similarities. Text properties are considered a part of the text; overlays are specifically considered not to be part of the text. Thus, copying text between various buffers and strings preserves text properties, but does not try to preserve overlays. Changing a buffer's text properties marks the buffer as modified, while moving an overlay or changing its properties does not. `face' This property specifies a face for displaying the text within the overlay. `priority' This property's value (which should be a nonnegative number) determines the priority of the overlay. The priority matters when two or more overlays cover the same character and both specify a face for display; the one whose `priority' value is larger takes priority over the other, and its face attributes override the face attributes of the lower priority overlay. Currently, all overlays take priority over text properties. Please avoid using negative priority values, as we have not yet decided just what they should mean. `window' If the `window' property is non-`nil', then the overlay applies only on that window. Overlay Functions ----------------- Use the functions `overlay-get' and `overlay-put' to access and set the properties of an overlay. They take arguments like `get' and `put', except that the first argument is an overlay rather than a symbol. To create an overlay, call `(make-overlay START END)'. You can specify the buffer as the third argument if you wish. To delete one, use `delete-overlay'. Use `overlay-start', `overlay-end' and `overlay-buffer' to examine the location and range of an overlay. Use `move-overlay' to change them; its arguments are OVERLAY, START, END and (optionally) the buffer. There are two functions to search for overlays: `overlays-at' and `next-overlay-change'. `overlays-at' returns a list of all the overlays containing a particular position. `(next-overlay-change POS)' returns the position of the next overlay beginning or end following POS. Faces ===== A "face" is a named collection of graphical attributes: font, foreground color, background color and optional underlining. Faces control the display of text on the screen. Each face has its own "face id number" which distinguishes faces at low levels within Emacs. However, for most purposes, you can refer to faces in Lisp programs by their names. Each face name is meaningful for all frames, and by default it has the same meaning in all frames. But you can arrange to give a particular face name a special meaning in one frame if you wish. Choosing a Face for Display --------------------------- Here are all the ways to specify which face to use for display of text: * With defaults. Each frame has a "default face", whose id number is zero, which is used for all text that doesn't somehow specify another face. * With text properties. A character may have a `face' property; if so, it's displayed with that face. If the character has a `mouse-face' property, that is used instead of the `face' property when the mouse is "near enough" to the character. * With overlays. An overlay may have `face' and `mouse-face' properties too; they apply to all the text covered by the overlay. * With special glyphs. Each glyph can specify a particular face id number. If these various sources together specify more than one face for a particular character, Emacs merges the attributes of the various faces specified. The attributes of the faces of special glyphs come first; then come attributes of faces from overlays, followed by those from text properties, and last the default face. When multiple overlays cover one character, an overlay with higher priority overrides those with lower priority. If an attribute such as the font or a color is not specified in any of the above ways, the frame's own font or color is used. *Note Face Functions: (elisp)Face Functions, for functions to create and change faces. New Input Event Formats ======================= Mouse clicks, mouse movements and function keys no longer appear in the input stream as characters; instead, other kinds of Lisp objects represent them as input. * An ordinary input character event consists of a "basic code" between 0 and 255, plus any or all of these "modifier bits": meta The 2**23 bit in the character code indicates a character typed with the meta key held down. control The 2**22 bit in the character code indicates a non-ASCII control character. ASCII control characters such as `C-a' have special basic codes of their own, so Emacs needs no special bit to indicate them. Thus, the code for `C-a' is just 1. But if you type a control combination not in ASCII, such as `%' with the control key, the numeric value you get is the code for `%' plus 2**22 (assuming the terminal supports non-ASCII control characters). shift The 2**21 bit in the character code indicates an ASCII control character typed with the shift key held down. For letters, the basic code indicates upper versus lower case; for digits and punctuation, the shift key selects an entirely different character with a different basic code. In order to keep within the ASCII character set whenever possible, Emacs avoids using the 2**21 bit for those characters. However, ASCII provides no way to distinguish `C-A' from `C-a', so Emacs uses the 2**21 bit in `C-A' and not in `C-a'. hyper The 2**20 bit in the character code indicates a character typed with the hyper key held down. super The 2**19 bit in the character code indicates a character typed with the super key held down. alt The 2**18 bit in the character code indicates a character typed with the alt key held down. (On some terminals, the key labeled ALT is actually the meta key.) In the future, Emacs may support a larger range of basic codes. We may also move the modifier bits to larger bit numbers. Therefore, you should avoid mentioning specific bit numbers in your program. Instead, the way to test the modifier bits of a character is with the function `event-modifiers' (see below). * Function keys are represented as symbols. The symbol's name is the function key's label. For example, pressing a key labeled F1 places the symbol `f1' in the input stream. There are a few exceptions to the symbol naming convention: `kp-add', `kp-decimal', `kp-divide', ... Keypad keys (to the right of the regular keyboard). `kp-0', `kp-1', ... Keypad keys with digits. `kp-f1', `kp-f2', `kp-f3', `kp-f4' Keypad PF keys. `left', `up', `right', `down' Cursor arrow keys You can use the modifier keys CTRL, META, HYPER, SUPER, ALT and SHIFT with function keys. The way to represent them is with prefixes in the symbol name: `A-' The alt modifier. `C-' The control modifier. `H-' The hyper modifier. `M-' The meta modifier. `s-' The super modifier. `S-' The shift modifier. Thus, the symbol for the key F3 with META held down is `M-F3'. When you use more than one prefix, we recommend you write them in alphabetical order (though the order does not matter in arguments to the key-binding lookup and modification functions). * Mouse events are represented as lists. If you press a mouse button and release it at the same location, this generates a "click" event. Mouse click events have this form: (BUTTON-SYMBOL (WINDOW (COLUMN . ROW) BUFFER-POS TIMESTAMP)) Here is what the elements normally mean: BUTTON-SYMBOL indicates which mouse button was used. It is one of the symbols `mouse-1', `mouse-2', ..., where the buttons are normally numbered left to right. You can also use prefixes `A-', `C-', `H-', `M-', `S-' and `s-' for modifiers alt, control, hyper, meta, shift and super, just as you would with function keys. WINDOW is the window in which the click occurred. COLUMN ROW are the column and row of the click, relative to the top left corner of WINDOW, which is `(0 . 0)'. BUFFER-POS is the buffer position of the character clicked on. TIMESTAMP is the time at which the event occurred, in milliseconds. (Since this value wraps around the entire range of Emacs Lisp integers in about five hours, it is useful only for relating the times of nearby events.) The meanings of BUFFER-POS, ROW and COLUMN are somewhat different when the event location is in a special part of the screen, such as the mode line or a scroll bar. If the position is in the window's scroll bar, then BUFFER-POS is the symbol `vertical-scroll-bar', and the pair `(COLUMN . ROW)' is replaced with a pair `(PORTION . WHOLE)', where PORTION is the distance of the click from the top or left end of the scroll bar, and WHOLE is the length of the entire scroll bar. If the position is on a mode line or the vertical line separating WINDOW from its neighbor to the right, then BUFFER-POS is the symbol `mode-line' or `vertical-line'. In this case ROW and COLUMN do not have meaningful data. * Releasing a mouse button above a different character position generates a "drag" event, which looks like this: (BUTTON-SYMBOL (WINDOW1 (COLUMN1 . ROW1) BUFFER-POS1 TIMESTAMP1) (WINDOW2 (COLUMN2 . ROW2) BUFFER-POS2 TIMESTAMP2)) The name of BUTTON-SYMBOL contains the prefix `drag-'. The second and third elements of the event give the starting and ending position of the drag. The `drag-' prefix follows the modifier key prefixes such as `C-' and `M-'. If `read-key-sequence' receives a drag event which has no key binding, and the corresponding click event does have a binding, it changes the drag event into a click event at the drag's starting position. This means that you don't have to distinguish between click and drag events unless you want to. * Click and drag events happen when you release a mouse button. Another kind of event happens when you press a button. It looks just like a click event, except that the name of BUTTON-SYMBOL contains the prefix `down-'. The `down-' prefix follows the modifier key prefixes such as `C-' and `M-'. The function `read-key-sequence', and the Emacs command loop, ignore any down events that don't have command bindings. This means that you need not worry about defining down events unless you want them to do something. The usual reason to define a down event is so that you can track mouse motion until the button is released. * For example, if the user presses and releases the left mouse button over the same location, Emacs generates a sequence of events like this: (down-mouse-1 (# 2613 (0 . 38) -864320)) (mouse-1 (# 2613 (0 . 38) -864180)) Or, while holding the control key down, the user might hold down the second mouse button, and drag the mouse from one line to the next. That produces two events, as shown here: (C-down-mouse-2 (# 3440 (0 . 27) -731219)) (C-drag-mouse-2 (# 3440 (0 . 27) -731219) (# 3510 (0 . 28) -729648)) Or, while holding down the meta and shift keys, the user might press the second mouse button on the window's mode line, and then drag the mouse into another window. That produces an event like this: (M-S-down-mouse-2 (# mode-line (33 . 31) -457844)) (M-S-drag-mouse-2 (# mode-line (33 . 31) -457844) (# 161 (33 . 3) -453816)) * A key sequence that starts with a mouse click is read using the keymaps of the buffer in the window clicked on, not the current buffer. This does not imply that clicking in a window selects that window or its buffer. The execution of the command begins with no change in the selected window or current buffer. However, the command can switch windows or buffers if programmed to do so. * Mouse motion events are represented by lists. During the execution of the body of a `track-mouse' form, moving the mouse generates events that look like this: (mouse-movement (WINDOW (COLUMN . ROW) BUFFER-POS TIMESTAMP)) The second element of the list describes the current position of the mouse, just as in a mouse click event. Outside of `track-mouse' forms, Emacs does not generate events for mere motion of the mouse, and these events do not appear. * Focus shifts between frames are represented by lists. When the mouse shifts temporary input focus from one frame to another, Emacs generates an event like this: (switch-frame NEW-FRAME) where NEW-FRAME is the frame switched to. In X windows, most window managers are set up so that just moving the mouse into a window is enough to set the focus there. As far as the user is concerned, Emacs behaves consistently with this. However, there is no need for the Lisp program to know about the focus change until some other kind of input arrives. So Emacs generates the focus event only when the user actually types a keyboard key or presses a mouse button in the new frame; just moving the mouse between frames does not generate a focus event. The global key map usually binds this event to the `internal-select-frame' function, so that characters typed at a frame apply to that frame's selected window. If the user switches frames in the middle of a key sequence, then Emacs delays the `switch-frame' event until the key sequence is over. For example, suppose `C-c C-a' is a key sequence in the current buffer's keymaps. If the user types `C-c', moves the mouse to another frame, and then types `C-a', `read-key-sequence' returns the sequence `"\C-c\C-a"', and the next call to `read-event' or `read-key-sequence' will return the `switch-frame' event. Working with Input Events ========================= * Functions which work with key sequences now handle non-character events. Functions like `define-key', `global-set-key', and `local-set-key' used to accept strings representing key sequences; now, since events may be arbitrary lisp objects, they also accept vectors. The function `read-key-sequence' may return a string or a vector, depending on whether or not the sequence read contains only characters. List events may be represented by the symbols at their head; to bind clicks of the left mouse button, you need only present the symbol `mouse-1', not an entire mouse click event. If you do put an event which is a list in a key sequence, only the event's head symbol is used in key lookups. For example, to globally bind the left mouse button to the function `mouse-set-point', you could evaluate this: (global-set-key [mouse-1] 'mouse-set-point) To bind the sequence `C-c F1' to the command `tex-view' in `tex-mode-map', you could evaluate this: (define-key tex-mode-map [?\C-c f1] 'tex-view) To find the binding for the function key labeled NEXT in `minibuffer-local-map', you could evaluate this: (lookup-key minibuffer-local-map [next]) => next-history-element If you call the function `read-key-sequence' and then press `C-x C-F5', here is how it behaves: (read-key-sequence "Press `C-x C-F5': ") => [24 C-f5] Note that `24' is the character `C-x'. * The documentation functions (`single-key-description', `key-description', etc.) now handle the new event types. Wherever a string of keyboard input characters was acceptable in previous versions of Emacs, a vector of events should now work. * Special parts of a window can have their own bindings for mouse events. When mouse events occur in special parts of a window, such as a mode line or a scroll bar, the event itself shows nothing special--only the symbol that would normally represent that mouse button and modifier keys. The information about the screen region is kept in other parts of the event list. But `read-key-sequence' translates this information into imaginary prefix keys, all of which are symbols: `mode-line', `vertical-line', and `vertical-scroll-bar'. For example, if you call `read-key-sequence' and then click the mouse on the window's mode line, this is what happens: (read-key-sequence "Click on the mode line: ") => [mode-line (mouse-1 (# mode-line (40 . 63) 5959987))] You can define meanings for mouse clicks in special window regions by defining key sequences using these imaginary prefix keys. For example, here is how to bind the third mouse button on a window's mode line delete the window: (global-set-key [mode-line mouse-3] 'mouse-delete-window) Here's how to bind the middle button (modified by META) on the vertical line at the right of a window to scroll the window to the left. (global-set-key [vertical-line M-mouse-2] 'scroll-left) * Decomposing an event symbol. Each symbol used to identify a function key or mouse button has a property named `event-symbol-elements', which is a list containing an unmodified version of the symbol, followed by modifiers the symbol name contains. The modifiers are symbols; they include `shift', `control', and `meta'. In addition, a mouse event symbol has one of `click', `drag', and `down'. For example: (get 'f5 'event-symbol-elements) => (f5) (get 'C-f5 'event-symbol-elements) => (f5 control) (get 'M-S-f5 'event-symbol-elements) => (f5 meta shift) (get 'mouse-1 'event-symbol-elements) => (mouse-1 click) (get 'down-mouse-1 'event-symbol-elements) => (mouse-1 down) Note that the `event-symbol-elements' property for a mouse click explicitly contains `click', but the event symbol name itself does not contain `click'. * Use `read-event' to read input if you want to accept any kind of event. The old function `read-char' now discards events other than keyboard characters. * `last-command-char' and `last-input-char' can now hold any kind of event. * The new variable `unread-command-events' is much like `unread-command-char'. Its value is a list of events of any type, to be processed as command input in order of appearance in the list. * The function `this-command-keys' may return a string or a vector, depending on whether or not the sequence read contains only characters. You may need to upgrade code which uses this function. The function `recent-keys' now returns a vector of events. You may need to upgrade code which uses this function. * A keyboard macro's definition can now be either a string or a vector. All that really matters is what elements it has. If the elements are all characters, then the macro can be a string; otherwise, it has to be a vector. * The variable `last-event-frame' records which frame the last input event was directed to. Usually this is the frame that was selected when the event was generated, but if that frame has redirected input focus to another frame, `last-event-frame' is the frame to which the event was redirected. * The interactive specification now allows a new code letter `e' to simplify commands bound to events which are lists. This code supplies as an argument the complete event object. You can use `e' more than once in a single command's interactive specification. If the key sequence which invoked the command has N events with parameters, the Nth `e' provides the Nth parameterized event. Events which are not lists, such as function keys and ASCII keystrokes, do not count where `e' is concerned. * You can extract the starting and ending position values from a mouse button or motion event using the two functions `event-start' and `event-end'. These two functions return different values for drag and motion events; for click and button-down events, they both return the position of the event. * The position, a returned by `event-start' and `event-end', is a list of this form: (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP) You can extract parts of this list with the functions `posn-window', `posn-point', `posn-col-row', and `posn-timestamp'. * The function `scroll-bar-scale' is useful for computing where to scroll to in response to a mouse button event from a scroll bar. It takes two arguments, RATIO and TOTAL, and in effect multiplies them. We say "in effect" because RATIO is not a number; rather a pair `(NUM . DENOM)'. Here's the usual way to use `scroll-bar-scale': (scroll-bar-scale (posn-col-row (event-start event)) (buffer-size)) Putting Keyboard Events in Strings ================================== In most of the places where strings are used, we conceptualize the string as containing text characters--the same kind of characters found in buffers or files. Occasionally Lisp programs use strings which conceptually contain keyboard characters; for example, they may be key sequences or keyboard macro definitions. There are special rules for how to put keyboard characters into a string, because they are not limited to the range of 0 to 255 as text characters are. A keyboard character typed using the META key is called a "meta character". The numeric code for such an event includes the 2**23 bit; it does not even come close to fitting in a string. However, earlier Emacs versions used a different representation for these characters, which gave them codes in the range of 128 to 255. That did fit in a string, and many Lisp programs contain string constants that use `\M-' to express meta characters, especially as the argument to `define-key' and similar functions. We provide backward compatibility to run those programs with special rules for how to put a keyboard character event in a string. Here are the rules: * If the keyboard event value is in the range of 0 to 127, it can go in the string unchanged. * The meta variants of those events, with codes in the range of 2**23 to 2**23+127, can also go in the string, but you must change their numeric values. You must set the 2**7 bit instead of the 2**23 bit, resulting in a value between 128 and 255. * Other keyboard character events cannot fit in a string. This includes keyboard events in the range of 128 to 255. Functions such as `read-key-sequence' that can construct strings containing events follow these rules. When you use the read syntax `\M-' in a string, it produces a code in the range of 128 to 255--the same code that you get if you modify the corresponding keyboard event to put it in the string. Thus, meta events in strings work consistently regardless of how they get into the strings. New programs can avoid dealing with these rules by using vectors instead of strings for key sequences when there is any possibility that these issues might arise. The reason we changed the representation of meta characters as keyboard events is to make room for basic character codes beyond 127, and support meta variants of such larger character codes. Menus ===== You can now define menus conveniently as keymaps. Menus are normally used with the mouse, but they can work with the keyboard also. Defining Menus -------------- A keymap is suitable for menu use if it has an "overall prompt string", which is a string that appears as an element of the keymap. It should describes the purpose of the menu. The easiest way to construct a keymap with a prompt string is to specify the string as an argument when you run `make-keymap' or `make-sparse-keymap'. The individual bindings in the menu keymap should also have prompt strings; these strings are the items in the menu. A binding with a prompt string looks like this: (CHAR STRING . REAL-BINDING) As far as `define-key' is concerned, the string is part of the character's binding--the binding looks like this: (STRING . REAL-BINDING). However, only REAL-BINDING is used for executing the key. You can also supply a second string, called the help string, as follows: (CHAR STRING HELP-STRING . REAL-BINDING) Currently Emacs does not actually use HELP-STRING; it knows only how to ignore HELP-STRING in order to extract REAL-BINDING. In the future we hope to make HELP-STRING serve as longer documentation for the menu item, available on request. The prompt string for a binding should be short--one or two words. Its meaning should describe the command it corresponds to. If REAL-BINDING is `nil', then STRING appears in the menu but cannot be selected. If REAL-BINDING is a symbol, and has a non-`nil' `menu-enable' property, that property is an expression which controls whether the menu item is enabled. Every time the keymap is used to display a menu, Emacs evaluates the expression, and it enables the menu item only if the expression's value is non-`nil'. When a menu item is disabled, it is displayed in a "fuzzy" fashion, and cannot be selected with the mouse. Menus and the Mouse ------------------- The way to make a menu keymap produce a menu is to make it the definition of a prefix key. When the prefix key ends with a mouse event, Emacs handles the menu keymap by popping up a visible menu that you can select from with the mouse. When you click on a menu item, the event generated is whatever character or symbol has the binding which brought about that menu item. A single keymap can appear as multiple panes, if you explicitly arrange for this. The way to do this is to make a keymap for each pane, then create a binding for each of those maps in the main keymap of the menu. Give each of these bindings a prompt string that starts with `@'. The rest of the prompt string becomes the name of the pane. See the file `lisp/mouse.el' for an example of this. Any ordinary bindings with prompt strings are grouped into one pane, which appears along with the other panes explicitly created for the submaps. You can also get multiple panes from separate keymaps. The full definition of a prefix key always comes from merging the definitions supplied by the various active keymaps (minor modes, local, and global). When more than one of these keymaps is a menu, each of them makes a separate pane or panes. Menus and the Keyboard ---------------------- When a prefix key ending with a keyboard event (a character or function key) has a definition that is a menu keymap, you can use the keyboard to choose a menu item. Emacs displays the menu alternatives in the echo area. If they don't all fit at once, type SPC to see the next line of alternatives. If you keep typing SPC, you eventually get to the end of the menu and then cycle around to the beginning again. When you have found the alternative you want, type the corresponding character--the one whose binding is that alternative. In a menu intended for keyboard use, each menu item must clearly indicate what character to type. The best convention to use is to make the character the first letter of the menu item prompt string. That is something users will understand without being told. The Menu Bar ------------ Under X Windows, each frame can have a "menu bar"--a permanently displayed menu stretching horizontally across the top of the frame. The items of the menu bar are the subcommands of the fake "function key" `menu-bar', as defined by all the active keymaps. To add an item to the menu bar, invent a fake "function key" of your own (let's call it KEY), and make a binding for the key sequence `[menu-bar KEY]'. Most often, the binding is a menu keymap, so that pressing a button on the menu bar item leads to another menu. In order for a frame to display a menu bar, its `menu-bar-lines' property must be greater than zero. Emacs uses just one line for the menu bar itself; if you specify more than one line, the other lines serve to separate the menu bar from the windows in the frame. We recommend you try one or two as the `menu-bar-lines' value. Keymaps ======= * The representation of keymaps has changed to support the new event types. All keymaps now have the form `(keymap ELEMENT ELEMENT ...)'. Each ELEMENT takes one of the following forms: PROMPT-STRING A string as an element of the keymap marks the keymap as a menu, and serves as the overall prompt string for it. `(KEY . BINDING)' A cons cell binds KEY to DEFINITION. Here KEY may be any sort of event head--a character, a function key symbol, or a mouse button symbol. VECTOR A vector of 128 elements binds all the ASCII characters; the Nth element holds the binding for character number N. `(t . BINDING)' A cons cell whose CAR is `t' is a default binding; anything not bound by previous keymap elements is given BINDING as its binding. Default bindings are important because they allow a keymap to bind all possible events without having to enumerate all the possible function keys and mouse clicks, with all possible modifier prefixes. The function `lookup-key' (and likewise other functions for examining a key binding) normally report only explicit bindings of the specified key sequence; if there is none, they return `nil', even if there is a default binding that would apply to that key sequence if it were actually typed in. However, these functions now take an optional argument ACCEPT-DEFAULTS which, if non-`nil', says to consider default bindings. Note that if a vector in the keymap binds an ASCII character to `nil' (thus making it "unbound"), the default binding does not apply to the character. Think of the vector element as an explicit binding of `nil'. Note also that if the keymap for a minor or major mode contains a default binding, it completely masks out any lower-priority keymaps. * A keymap can now inherit from another keymap. To do this, make the latter keymap the "tail" of the new one. Such a keymap looks like this: (keymap BINDINGS... . OTHER-KEYMAP) The effect is that this keymap inherits all the bindings of OTHER-KEYMAP, but can add to them or override them with BINDINGS. Subsequent changes in the bindings of OTHER-KEYMAP *do* affect this keymap. For example, (setq my-mode-map (cons 'keymap text-mode-map)) makes a keymap that by default inherits all the bindings of Text mode--whatever they may be at the time a key is looked up. Any bindings made explicitly in `my-mode-map' override the bindings inherited from Text mode, however. * Minor modes can now have local keymaps. Thus, a key can act a special way when a minor mode is in effect, and then revert to the major mode or global definition when the minor mode is no longer in effect. The precedence of keymaps is now: minor modes (in no particular order), then major mode, and lastly the global map. The new `current-minor-mode-maps' function returns a list of all the keymaps of currently enabled minor modes, in the other that they apply. To set up a keymap for a minor mode, add an element to the alist `minor-mode-map-alist'. Its elements look like this: (SYMBOL . KEYMAP) The keymap KEYMAP is active whenever SYMBOL has a non-`nil' value. Use for SYMBOL the variable which indicates whether the minor mode is enabled. When more than one minor mode keymap is active, their order of precedence is the order of `minor-mode-map-alist'. But you should design minor modes so that they don't interfere with each other, and if you do this properly, the order will not matter. The function `minor-mode-key-binding' returns a list of all the active minor mode bindings of KEY. More precisely, it returns an alist of pairs `(MODENAME . BINDING)', where MODENAME is the the variable which enables the minor mode, and BINDING is KEY's definition in that mode. If KEY has no minor-mode bindings, the value is `nil'. If the first binding is a non-prefix, all subsequent bindings from other minor modes are omitted, since they would be completely shadowed. Similarly, the list omits non-prefix bindings that follow prefix bindings. * The new function `copy-keymap' copies a keymap, producing a new keymap with the same key bindings in it. If the keymap contains other keymaps directly, these subkeymaps are copied recursively. If you want to, you can define a prefix key with a binding that is a symbol whose function definition is another keymap. In this case, `copy-keymap' does not look past the symbol; it doesn't copy the keymap inside the symbol. * `substitute-key-definition' now accepts an optional fourth argument, which is a keymap to use as a template. (substitute-key-definition olddef newdef keymap oldmap) finds all characters defined in OLDMAP as OLDDEF, and defines them in KEYMAP as NEWDEF. In addition, this function now operates recursively on the keymaps that define prefix keys within KEYMAP and OLDMAP. Minibuffer Features =================== The minibuffer input functions `read-from-minibuffer' and `completing-read' have new features. Minibuffer History ------------------ A new optional argument HIST specifies which history list to use. If you specify a variable (a symbol), that variable is the history list. If you specify a cons cell `(VARIABLE . STARTPOS)', then VARIABLE is the history list variable, and STARTPOS specifies the initial history position (an integer, counting from zero which specifies the most recent element of the history). If you specify STARTPOS, then you should also specify that element of the history as INITIAL-INPUT, for consistency. If you don't specify HIST, then the default history list `minibuffer-history' is used. Other standard history lists that you can use when appropriate include `query-replace-history', `command-history', and `file-name-history'. The value of the history list variable is a list of strings, most recent first. You should set a history list variable to `nil' before using it for the first time. `read-from-minibuffer' and `completing-read' add new elements to the history list automatically, and provide commands to allow the user to reuse items on the list. The only thing your program needs to do to use a history list is to initialize it and to pass its name to the input functions when you wish. But it is safe to modify the list by hand when the minibuffer input functions are not using it. Other Minibuffer Features ------------------------- The INITIAL argument to `read-from-minibuffer' and other minibuffer input functions can now be a cons cell `(STRING . POSITION)'. This means to start off with STRING in the minibuffer, but put the cursor POSITION characters from the beginning, rather than at the end. In `read-no-blanks-input', the INITIAL argument is now optional; if it is omitted, the initial input string is the empty string. New Features for Defining Commands ================================== * If the interactive specification begins with `@', this means to select the window under the mouse. This selection takes place before doing anything else with the command. You can use both `@' and `*' together in one command; they are processed in order of appearance. * Prompts in an interactive specification can incorporate the values of the preceding arguments. Emacs replaces `%'-sequences (as used with the `format' function) in the prompt with the interactive arguments that have been read so far. For example, a command with this interactive specification (interactive "sReplace: \nsReplace %s with: ") prompts for the first argument with `Replace: ', and then prompts for the second argument with `Replace FOO with: ', where FOO is the string read as the first argument. * If a command name has a property `enable-recursive-minibuffers' which is non-`nil', then the command can use the minibuffer to read arguments even if it is invoked from the minibuffer. The minibuffer command `next-matching-history-element' (normally bound to `M-s' in the minibuffer) uses this feature. New Features for Reading Input ============================== * The function `set-input-mode' now takes four arguments. The last argument is optional. Their names are INTERRUPT, FLOW, META and QUIT. The argument INTERRUPT says whether to use interrupt-driven input. Non-`nil' means yes, and `nil' means no (use CBREAK mode). The argument FLOW says whether to enable terminal flow control. Non-`nil' means yes. The argument META controls support for input character codes above 127. If META is `t', Emacs converts characters with the 8th bit set into Meta characters. If META is `nil', Emacs disregards the 8th bit; this is necessary when the terminal uses it as a parity bit. If META is neither `t' nor `nil', Emacs uses all 8 bits of input unchanged. This is good for terminals using European 8-bit character sets. If QUIT non-`nil', it is the character to use for quitting. (Normally this is `C-g'.) * The variable `meta-flag' has been deleted; use `set-input-mode' to enable or disable support for a META key. This change was made because `set-input-mode' can send the terminal the appropriate commands to enable or disable operation of the META key. * The new variable `extra-keyboard-modifiers' lets Lisp programs "press" the modifier keys on the keyboard. The value is a bit mask: 1 The SHIFT key. 2 The LOCK key. 4 The CTL key. 8 The META key. When you use X windows, the program can press any of the modifier keys in this way. Otherwise, only the CTL and META keys can be virtually pressed. * You can use the new function `keyboard-translate' to set up `keyboard-translate-table' conveniently. * Y-or-n questions using the `y-or-n-p' function now accept `C-]' (usually mapped to `abort-recursive-edit') as well as `C-g' to quit. * The variable `num-input-keys' is the total number of key sequences that the user has typed during this Emacs session. * A new Lisp variable, `function-key-map', holds a keymap which describes the character sequences sent by function keys on an ordinary character terminal. This uses the same keymap data structure that is used to hold bindings of key sequences, but it has a different meaning: it specifies translations to make while reading a key sequence. If `function-key-map' "binds" a key sequence K to a vector V, then when K appears as a subsequence *anywhere* in a key sequence, it is replaced with V. For example, VT100 terminals send `ESC O P' when the "keypad" PF1 key is pressed. Thus, on a VT100, `function-key-map' should "bind" that sequence to `[pf1]'. This specifies translation of `ESC O P' into PF1 anywhere in a key sequence. Thus, typing `C-c PF1' sends the character sequence `C-c ESC O P', but `read-key-sequence' translates this back into `C-c PF1', which it returns as the vector `[?\C-c PF1]'. Entries in `function-key-map' are ignored if they conflict with bindings made in the minor mode, local, or global keymaps. The value of `function-key-map' is usually set up automatically according to the terminal's Terminfo or Termcap entry, and the terminal-specific Lisp files. Emacs comes with a number of terminal-specific files for many common terminals; their main purpose is to make entries in `function-key-map' beyond those that can be deduced from Termcap and Terminfo. * The variable `key-translation-map' works like `function-key-map' except for two things: * `key-translation-map' goes to work after `function-key-map' is finished; it receives the results of translation by `function-key-map'. * `key-translation-map' overrides actual key bindings. The intent of `key-translation-map' is for users to map one character set to another, including ordinary characters normally bound to `self-insert-command'. New Syntax Table Features ========================= * You can use two new functions to move across characters in certain syntax classes. `skip-syntax-forward' moves point forward across characters whose syntax classes are mentioned in its first argument, a string. It stops when it encounters the end of the buffer, or position LIM (the optional second argument), or a character it is not supposed to skip. The function `skip-syntax-backward' is similar but moves backward. * The new function `forward-comment' moves point by comments. It takes one argument, COUNT; it moves point forward across COUNT comments (backward, if COUNT is negative). If it finds anything other than a comment or whitespace, it stops, leaving point at the far side of the last comment found. It also stops after satisfying COUNT. * The new variable `words-include-escapes' affects the behavior of `forward-word' and everything that uses it. If it is non-`nil', then characters in the "escape" and "character quote" syntax classes count as part of words. * There are two new syntax flags for use in syntax tables. - The prefix flag. The `p' flag identifies additional "prefix characters" in Lisp syntax. You can set this flag with `modify-syntax-entry' by including the letter `p' in the syntax specification. These characters are treated as whitespace when they appear between expressions. When they appear withing an expression, they are handled according to their usual syntax codes. The function `backward-prefix-chars' moves back over these characters, as well as over characters whose primary syntax class is prefix (`''). - The `b' comment style flag. Emacs can now supports two comment styles simultaneously. (This is for the sake of C++.) More specifically, it can recognize two different comment-start sequences. Both must share the same first character; only the second character may differ. Mark the second character of the `b'-style comment start sequence with the `b' flag. You can set this flag with `modify-syntax-entry' by including the letter `b' in the syntax specification. The two styles of comment can have different comment-end sequences. A comment-end sequence (one or two characters) applies to the `b' style if its first character has the `b' flag set; otherwise, it applies to the `a' style. The appropriate comment syntax settings for C++ are as follows: `/' `124b' `*' `23' newline `>b' Thus `/*' is a comment-start sequence for `a' style, `//' is a comment-start sequence for `b' style, `*/' is a comment-end sequence for `a' style, and newline is a comment-end sequence for `b' style. The Case Table ============== You can customize case conversion using the new case table feature. A case table is a collection of strings that specifies the mapping between upper case and lower case letters. Each buffer has its own case table. You need a case table if you are using a language which has letters that are not standard ASCII letters. A case table is a list of this form: (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES) where each element is either `nil' or a string of length 256. The element DOWNCASE says how to map each character to its lower-case equivalent. The element UPCASE maps each character to its upper-case equivalent. If lower and upper case characters are in 1-1 correspondence, use `nil' for UPCASE; then Emacs deduces the upcase table from DOWNCASE. For some languages, upper and lower case letters are not in 1-1 correspondence. There may be two different lower case letters with the same upper case equivalent. In these cases, you need to specify the maps for both directions. The element CANONICALIZE maps each character to a canonical equivalent; any two characters that are related by case-conversion have the same canonical equivalent character. The element EQUIVALENCES is a map that cyclicly permutes each equivalence class (of characters with the same canonical equivalent). You can provide `nil' for both CANONICALIZE and EQUIVALENCES, in which case both are deduced from DOWNCASE and UPCASE. Here are the functions for working with case tables: `case-table-p' is a predicate that says whether a Lisp object is a valid case table. `set-standard-case-table' takes one argument and makes that argument the case table for new buffers created subsequently. `standard-case-table' returns the current value of the new buffer case table. `current-case-table' returns the case table of the current buffer. `set-case-table' sets the current buffer's case table to the argument. `set-case-syntax-pair' is a convenient function for specifying a pair of letters, upper case and lower case. Call it with two arguments, the upper case letter and the lower case letter. It modifies the standard case table and a few syntax tables that are predefined in Emacs. This function is intended as a subroutine for packages that define non-ASCII character sets. Load the library `iso-syntax' to set up the syntax and case table for the 256 bit ISO Latin 1 character set. New Features for Dealing with Buffers ===================================== * The new function `buffer-modified-tick' returns a buffer's modification-count that ticks every time the buffer is modified. It takes one optional argument, which is the buffer you want to examine. If the argument is `nil' (or omitted), the current buffer is used. * `buffer-disable-undo' is a new name for the function formerly known as `buffer-flush-undo'. This turns off recording of undo information in the buffer given as argument. * The new function `generate-new-buffer-name' chooses a name that would be unique for a new buffer--but does not create the buffer. Give it one argument, a starting name. It produces a name not in use for a buffer by appending a number inside of `<...>'. * The function `rename-buffer' now takes an optional second argument which tells it that if the specified new name corresponds to an existing buffer, it should use `generate-new-buffer-name' to modify the name to be unique, rather than signaling an error. `rename-buffer' now returns the name to which the buffer was renamed. * The function `list-buffers' now looks at the local variable `list-buffers-directory' in each non-file-visiting buffer, and shows its value where the file would normally go. Dired sets this variable in each Dired buffer, so the buffer list now shows which directory each Dired buffer is editing. * The function `other-buffer' now takes an optional second argument VISIBLE-OK which, if non-`nil', indicates that buffers currently being displayed in windows may be returned even if there are other buffers not visible. Normally, `other-buffer' returns a currently visible buffer only as a last resort, if there are no suitable nonvisible buffers. * The hook `kill-buffer-hook' now runs whenever a buffer is killed. Local Variables Features ======================== * If a local variable name has a non-`nil' `permanent-local' property, then `kill-all-local-variables' does not kill it. Such local variables are "permanent"--they remain unchanged even if you select a different major mode. Permanent locals are useful when they have to do with where the file came from or how to save it, rather than with how to edit the contents. * The function `make-local-variable' now never changes the value of the variable that it makes local. If the variable had no value before, it still has no value after becoming local. * The new function `default-boundp' tells you whether a variable has a default value (as opposed to being unbound in its default value). If `(default-boundp 'foo)' returns `nil', then `(default-value 'foo)' would get an error. `default-boundp' is to `default-value' as `boundp' is to `symbol-value'. * The special forms `defconst' and `defvar', when the variable is local in the current buffer, now set the variable's default value rather than its local value. New Features for Subprocesses ============================= * `call-process' and `call-process-region' now return a value that indicates how the synchronous subprocess terminated. It is either a number, which is the exit status of a process, or a signal name represented as a string. * `process-status' now returns `open' and `closed' as the status values for network connections. * The standard asynchronous subprocess features work on VMS now, and the special VMS asynchronous subprocess functions have been deleted. * You can use the transaction queue feature for more convenient communication with subprocesses using transactions. Call `tq-create' to create a transaction queue communicating with a specified process. Then you can call `tq-enqueue' to send a transaction. `tq-enqueue' takes these five arguments: (tq-enqueue TQ QUESTION REGEXP CLOSURE FN) TQ is the queue to use. (Specifying the queue has the effect of specifying the process to talk to.) The argument QUESTION is the outgoing message which starts the transaction. The argument FN is the function to call when the corresponding answer comes back; it is called with two arguments: CLOSURE, and the answer received. The argument REGEXP is a regular expression to match the entire answer; that's how `tq-enqueue' tells where the answer ends. Call `tq-close' to shut down a transaction queue and terminate its subprocess. * The function `signal-process' sends a signal to process PID, which need not be a child of Emacs. The second argument SIGNAL specifies which signal to send; it should be an integer. New Features for Dealing with Times And Time Delays =================================================== * The new function `current-time' returns the system's time value as a list of three integers: `(HIGH LOW MICROSEC)'. The integers HIGH and LOW combine to give the number of seconds since 0:00 January 1, 1970, which is HIGH * 2**16 + LOW. MICROSEC gives the microseconds since the start of the current second (or 0 for systems that return time only on the resolution of a second). * The function `current-time-string' accepts an optional argument TIME-VALUE. If given, this specifies a time to format instead of the current time. The argument should be a cons cell containing two integers, or a list whose first two elements are integers. Thus, you can use times obtained from `current-time' (see above) and from `file-attributes'. * You can now find out the user's time zone using `current-time-zone'. The value has the form `(OFFSET NAME)'. Here OFFSET is an integer giving the number of seconds ahead of UTC (east of Greenwich). A negative value means west of Greenwich. The second element, NAME is a string giving the name of the time zone. Both elements change when daylight savings time begins or ends; if the user has specified a time zone that does not use a seasonal time adjustment, then the value is constant through time. If the operating system doesn't supply all the information necessary to compute the value, both elements of the list are `nil'. The optional argument TIME-VALUE, if given, specifies a time to analyze instead of the current time. The argument should be a cons cell containing two integers, or a list whose first two elements are integers. Thus, you can use times obtained from `current-time' and from `file-attributes'. * `sit-for', `sleep-for' now let you specify the time period in milliseconds as well as in seconds. The first argument gives the number of seconds, as before, and the optional second argument gives additional milliseconds. The time periods specified by these two arguments are added together. Not all systems support this; you get an error if you specify nonzero milliseconds and it isn't supported. `sit-for' also accepts an optional third argument NODISP. If this is non-`nil', `sit-for' does not redisplay. It still waits for the specified time or until input is available. * `accept-process-output' now accepts a timeout specified by optional second and third arguments. The second argument specifies the number of seconds, while the third specifies the number of milliseconds. The time periods specified by these two arguments are added together. Not all systems support this; you get an error if you specify nonzero milliseconds and it isn't supported. The function returns `nil' if the timeout expired before output arrived, or non-`nil' if it did get some output. * You can set up a timer to call a function at a specified future time. To do so, call `run-at-time', like this: (run-at-time TIME REPEAT FUNCTION ARGS...) Here, TIME is a string saying when to call the function. The argument FUNCTION is the function to call later, and ARGS are the arguments to give it when it is called. The argument REPEAT specifies how often to repeat the call. If REPEAT is `nil', there are no repetitions; FUNCTION is called just once, at TIME. If REPEAT is an integer, it specifies a repetition period measured in seconds. Absolute times may be specified in a wide variety of formats; The form `HOUR:MIN:SEC TIMEZONE MONTH/DAY/YEAR', where all fields are numbers, works; the format that `current-time-string' returns is also allowed. To specify a relative time, use numbers followed by units. For example: `1 min' denotes 1 minute from now. `1 min 5 sec' denotes 65 seconds from now. `1 min 2 sec 3 hour 4 day 5 week 6 fortnight 7 month 8 year' denotes exactly 103 months, 123 days, and 10862 seconds from now. If TIME is an integer, that specifies a relative time measured in seconds. To cancel the requested future action, pass the value that `run-at-time' returned to the function `cancel-timer'. Profiling Lisp Programs ======================= You can now make execution-time profiles of Emacs Lisp programs using the `profile' library. See the file `profile.el' for instructions; if you have written a Lisp program big enough to be worth profiling, you can surely understand them. New Features for Lisp Debuggers =============================== * You can now specify which kinds of errors should invoke the Lisp debugger by setting the variable `debug-on-error' to a list of error conditions. For example, if you set it to the list `(void-variable)', then only errors about a variable that has no value invoke the debugger. * The variable `command-debug-status' is used by Lisp debuggers. It records the debugging status of current interactive command. Each time a command is called interactively, this variable is bound to `nil'. The debugger can set this variable to leave information for future debugger invocations during the same command. The advantage of this variable over some other variable in the debugger itself is that the data will not be visible for any other command invocation. * The function `backtrace-frame' is intended for use in Lisp debuggers. It returns information about what a frame on the Lisp call stack is doing. You specify one argument, which is the number of stack frames to count up from the current execution point. If that stack frame has not evaluated the arguments yet (or is a special form), the value is `(nil FUNCTION ARG-FORMS...)'. If that stack frame has evaluated its arguments and called its function already, the value is `(t FUNCTION ARG-VALUES...)'. In the return value, FUNCTION is whatever was supplied as CAR of evaluated list, or a `lambda' expression in the case of a macro call. If the function has a `&rest' argument, that is represented as the tail of the list ARG-VALUES. If the argument is out of range, `backtrace-frame' returns `nil'. Memory Allocation Changes ========================= The list that `garbage-collect' returns now has one additional element. This is a cons cell containing two numbers. It gives information about the number of used and free floating point numbers, much as the first element gives such information about the number of used and free cons cells. The new function `memory-limit' returns an indication of the last address allocated by Emacs. More precisely, it returns that address divided by 1024. You can use this to get a general idea of how your actions affect the memory usage. Hook Changes ============ * Expanding an abbrev first runs the new hook `pre-abbrev-expand-hook'. * The editor command loop runs the normal hook `pre-command-hook' before each command, and runs `post-command-hook' after each command. * Auto-saving runs the new hook `auto-save-hook' before actually starting to save any files. * The new variable `revert-buffer-insert-file-contents-function' holds a function that `revert-buffer' now uses to read in the contents of the reverted buffer--instead of calling `insert-file-contents'. * The variable `lisp-indent-hook' has been renamed to `lisp-indent-function'. * The variable `auto-fill-hook' has been renamed to `auto-fill-function'. * The variable `blink-paren-hook' has been renamed to `blink-paren-function'. * The variable `temp-buffer-show-hook' has been renamed to `temp-buffer-show-function'. * The variable `suspend-hook' is now a normal hook. It used to be a special kind of hook; its value had to be a single function, and if the function returned a non-`nil' value, then suspension was inhibited. * The new function `add-hook' provides a handy way to add a function to a hook variable. For example, (add-hook 'text-mode-hook 'my-text-hook-function) arranges to call `my-text-hook-function' when entering Text mode or related modes. `add-hook' takes an optional third argument which says to add the new hook function at the end of the list (normally, it goes at the beginning). emacs-19.30/etc/LPF100666 12120 13 11617 5643617142 12021 0ustar rmsuser Protect Your Freedom to Write Programs Join the League for Programming Freedom (Version of February 3, 1994) Ten years ago, programmers were allowed to write programs using all the techniques they knew, and providing whatever features they felt were useful. This is no longer the case. New monopolies, known as software patents and interface copyrights, have taken away our freedom of expression and our ability to do a good job. "Look and feel" lawsuits attempt to monopolize well-known command languages; some have succeeded. Copyrights on command languages enforce gratuitous incompatibility, close opportunities for competition, and stifle incremental improvements. Software patents are even more dangerous; they make every design decision in the development of a program carry a risk of a lawsuit, with draconian pretrial seizure. It is difficult and expensive to find out whether the techniques you consider using are patented; it is impossible to find out whether they will be patented in the future. The League for Programming Freedom is a grass-roots organization of professors, students, businessmen, programmers and users dedicated to bringing back the freedom to write programs. The League is not opposed to the legal system that Congress expressly established for software--copyright on individual programs. Our aim is to reverse the recent changes that prevent programmers from doing their work. The League works to abolish the new monopolies by publishing articles, talking with public officials, denouncing egregious offenders, and filing amicus curiae briefs, most notably against Lotus in its suit against Borland. We testified twice at the recent Patent Office hearings on software patents. We welcome suggestions for other activities, as well as help in carrying them out. Membership dues in the League are $42 per year for programmers, managers and professionals; $10.50 for students; $21 for others. Please give more if you can. The League's funds will be used for filing briefs; for printing handouts, buttons and signs; whatever will persuade the courts, the legislators, and the people. You may not get anything personally for your dues--except for the freedom to write programs. The League is a non-profit corporation, but not considered a tax-exempt charity. However, for those self-employed in software, the dues can be a business expense. The League needs both activist members and members who only pay their dues. We also greatly need additional corporate members; contact us for information. If you have any questions, please write to the League, phone +1 617 621 7084, or send Internet mail to lpf@uunet.uu.net. Chris Hofstader, President Dean Anderson, Secretary Aubrey Jaffer, Treasurer Chris Hofstader can be reached at (617) 492-0023; FAX (617) 497-1632. To join, please send a check and the following information to: League for Programming Freedom 1 Kendall Square #143 P.O.Box 9171 Cambridge, Massachusetts 02139 (Outside the US, please send a check in US dollars on a bank having a US correspondant bank, to save us check cashing fees.) Your name: The address for League mailings, a few each year; please indicate whether it is your home address or your work address: The company you work for, and your position: Your phone numbers (home, work or both): Your email address, so we can contact you for demonstrations or for writing letters. (If you don't want us to contact you for these things, please say so, but please give us your email address anyway so we can save paper and postage by sending you the newsletter by email.) Is there anything about you which would enable your endorsement of the LPF to impress the public? For example, if you are or have been a professor or an executive, or have written software that has a good reputation, please tell us. Would you like to help with LPF activities? The corporate charter of the League for Programming Freedom states: The purpose of the corporation is to engage in the following activities: 1. To determine the existence of, and warn the public about restrictions and monopolies on classes of computer programs where such monopolies prevent or restrict the right to develop certain types of computer programs. 2. To develop countermeasures and initiatives, in the public interest, effective to block or otherwise prevent or restrain such monopolistic activities including education, research, publications, public assembly, legislative testimony, and intervention in court proceedings involving public interest issues (as a friend of the court). 3. To engage in any business or other activity in service of and related to the foregoing paragraphs that lawfully may be carried on by a corporation organized under Chapter 180 of the Massachusetts General Laws. The officers and directors of the League will be elected annually by the members. emacs-19.30/etc/MACHINES100666 12120 13 140661 6052303516 12601 0ustar rmsuserThis is a list of the status of GNU Emacs on various machines and systems. For each system and machine, we give the configuration name you should pass to the `configure' script to prepare to build Emacs for that system/machine. The `configure' script uses the configuration name to decide which machine and operating system description files `src/config.h' should include. The machine description files are all in `src/m', and have names similar to, but not identical to, the machine names used in configuration names. The operating system files are all in `src/s', and are named similarly. See the `configure' script if you need to know which configuration names use which machine and operating system description files. If you add support for a new configuration, add a section to this file, and then edit the `configure' script to tell it which configuration name(s) should select your new machine description and system description files. Here are the configurations Emacs is intended to work with, with the corresponding configuration names. You can postpend version numbers to operating system names (i.e. sunos4.1) or architecture names (i.e. hppa1.1). If you leave out the version number, the `configure' script will configure Emacs for the latest version it knows about. Acorn RISCiX (arm-acorn-riscix1.2) Emacs 19.29 has changes that ought to support RISCiX 1.2. Due to a bug in the RISCiX C compiler (3.4.5), emacs must be built with gcc (versions 2.5.8 onwards). In addition, you will need GNU sed and GNU make, as the RISCiX release versions of these utilities cannot cope with building emacs-19! GNU sed should be configured with: env 'DEFS=-Dgetopt=gnu_getopt -Dopterr=gnu_opterr -Doptind=gnu_optind \ -Doptarg=gnu_optarg' ./configure GNU make (3.72+) should be configured with: env 'CFLAGS=-Dgetopt=gnu_getopt -Dopterr=gnu_opterr -Doptind=gnu_optind \ -Doptarg=gnu_optarg' ./configure Emacs may be configured to use the X toolkit, by adding --with-x-toolkit to the configure command. If you do this, you will need to edit the line in src/Makefile which defines LIBW (about line 59) to read: LIBW= -lXaw_n This ensures that the non-shared widget library is used. It is unlikely that this version of emacs will work with RISCiX 1.1. Alliant (fx80-alliant-bsd): 18.52 worked on system version 4. Previous Emacs versions were known to work on previous system versions. If you are using older versions of their operating system, you may need to edit `src/config.h' to use `m/alliant1.h' (on version 1) or `m/alliant.h' (on versions 2 and 3). Alliant FX/2800 (i860-alliant-bsd) Known to work with 19.26 and OS version 2.2, compiler version 1.3. Alpha (DEC) running OSF/1 (alpha-dec-osf1, alpha-dec-linux) Patches merged in 19.29. Note that the X11 libraries on GNU/Linux systems for the Alpha are said to have bugs that prevent Emacs from working with X (as of November 1995). Altos 3068 (m68k-altos-sysv) 18.52 was said to work, provided you don't compile unexec.c with -O. Amdahl UTS (580-amdahl-sysv) Small changes for 18.38 were merged in 18.39. It is mostly working, but at last report a bug sometimes causes Emacs to grab very large amounts of memory. No fix or explanation has yet been reported. It may be possible to find this bug if you find which Emacs command it happens within and then run that command with a breakpoint set at malloc. The 5.2u370 compiler is so brain damaged that it is not even worth trying to use it. Success was obtained with the uts native C compiler on uts version 5.2.5. Apollo running X Windows (m68k-apollo-bsd) Apollo version now supports dumping. It has been tested on SR10.3 and SR10.4. It certainly requires at least SR10.0, and maybe SR10.2. Be sure to build in the BSD environment. By default, everything is compiled with the switch "-W0,-opt,2". Don't try to change this to full optimization (-O). The full optimizer (in Domain CC 6.7, 6.8 and 6.9) generates some bad code in several modules which causes the emacs window, under X, to be refreshed with each keystroke. The configuration stuff should work for the most part. However, some Domain installations may have to edit src/Makefile manually after it is created. There are too many versions of both cc and X to automate this easily. In `lib-src/Makefile', emacsclient and emacsserver compile and work fine under CC 6.9. They now probably work under other versions of the compiler, as well. The Apollo Domain CC compiler will issue quite a few warning messages, mostly complaining about incompatible pointers. In general, these are harmless and can be ignored. If you discover otherwise, please submit a bug report identifying the problem in detail. When you try to dump emacs, you may get the message ".rwdi section needs relocation." This means you are linking with some code that has compressed data sections. In some cases this comes from linking with X libraries. Try using shared X libraries instead. With some versions of Domain/OS this is as simple as removing the "-lX11" from the LIBX line in src/Makefile. When running the configure script, use the configuration name "m68k-apollo-bsd". You will also need to use the "-with-gcc=no" and "-with-x" options. Depending upon your site configuration, you may have to use other configure options, as well. Examine the INSTALL file for other configure options. Check out the file 'lisp/x-apollo.el'. To use it, add (load "x-apollo") to your .emacs file. It provides useful default Apollo function key bindings. AT&T 3b2, 3b5, 3b15, 3b20 (we32k-att-sysv) Emacs will probably not work with certain kernel constants too small. In param.h CDLIMIT should be at least (1L << 12) in order to allow processes to write up to 2 Mbyte files. This parameter is configurable by normal means in /etc/master.d/kernel; examine that file for the symbol CDLIMIT or ULIMIT, and raise it by several powers of 2. Then do normal kernel rebuild things via "cd /boot; mkboot -k KERNEL" and so forth. In seg.h NSEGP and STACKSEG should be at least 16 and 4 respectively to allow processes with total size of up to 2Mbytes. However, I'm told it is unlikely this would fail to be true. The MAXMEM may also prevent Emacs from running. The file 3B-MAXMEM in this directory explains how to increase MAXMEM. On some of these machines, you may need to define IN_SCCS_ID in config.h to make Emacs work. Supposedly you can tell whether this is necessary by checking something in /usr/include/sys/time.h; we do not know precisely what. AT&T 7300 or 3b1 (m68k-att-sysv) 18.52 worked. If you have strange troubles with dumping Emacs, delete the last few lines from `src/m/7300.h' and recompile. These lines are supposed to produce a sharable executable. `src/m/7300.h' defines SHORTNAMES because operating system versions older than 3.5 did not support long symbol names. Version 3.5 does support them, so you can remove the #define SHORTNAMES in that version. Bull DPX/2 models 2nn or 3nn (m68k-bull-sysv3) Minor fixes merged into 19.19, which should work 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 DPX/20 (rs6000-bull-bosx) Version 19 works. Bull sps7 (m68k-bull-sysv2) Changes partially merged in version 19, but some fixes are probably required. CCI 5/32, 6/32 See "Tahoe". Celerity (celerity-celerity-bsd4.2) Version 18.49 worked. This configuration name is a hack, because we don't know the processor used by Celerities. If someone who uses a Celerity could get in touch with us, we can teach config.sub a better name for the configuration. Clipper (clipper-???) Version 19 has support for some brand of clipper system. If you have successfully built Emacs 19 on some sort of clipper system, let us know so we can flesh out this entry. Note that the Orion 105 is also a clipper, but some system-related parameters are different. Convex (c1-convex-bsd, c2-convex-bsd, c32-convex-bsd, c34-convex-bsd, c38-convex-bsd) Support updated and residual bugs fixed in 19.26. Cubix QBx/386 (i386-cubix-sysv) Changes merged in 19.1. Systems before 2/A/0 may fail to compile etags.c due to a compiler bug. Cydra 5 (cydra-cydrome-sysv) 18.51 worked in one version of their operating system but stopped working in a newer version. This has not been fixed. Data General Aviion (m88k-dg-dgux) 19.23 works; however, the GCC provided with DGUX 5.4R3.00 fails to compile src/emacs.c. GCC 2.5.8 does work. The 19.26 pretest was reported to work; no word on which compiler. System versions other than DGUX 5.4R3.00 have not been tested. DECstation (mips-dec-ultrix or mips-dec-osf) This machine is the older Mips-based DECstation. Emacs should now work on the Alpha CPU. 19.25 works on Ultrix 4.2. The 19.26 pretest was reported to work on Ultrix 4.2a and on 4.4. One user reported 19.25 did not work at all with --with-x-toolkit using X11R5 patch level 10, but worked ok with X11R5 pl26. See under Ultrix for problems using X windows on Ultrix. Note that this is a MIPS machine. For Ultrix versions 4.1 or earlier, you may need to define SYSTEM_MALLOC in `src/m/pmax.h', because XvmsAlloc.o in libX11.a seems to insist on defining malloc itself. For Ultrix versions prior to 4.0, you may need to delete the definition of START_FILES from `src/m/pmax.h'. Motorola Delta 147 (m68k-motorola-sysv) The EMacs 19.26 pretest was reported to work. Motorola Delta boxes running System V/68 release 3. Tested on 147 board with SVR3V7, no X and gcc. Tested on 167 board with SVR3V7, no X, cc, gnucc and gcc. Reports say it works with X too. The installation script chooses the compiler itself. gnucc is preferred. Motorola Delta 187 (m88k-motorola-sysv, m88k-motorola-sysvr4, or m88k-motorola-m88kbcs) The 19.26 pretest was reported to run on SVR3. However, if you use --with-x-toolkit on svr3, you will have problems compiling some files because time.h and sys/time.h get included twice. One fix is to edit those files to protect against multiple inclusion. As of version 19.13, Emacs was reported to run under SYSVr3 and SYSVr4. Dual running System V (m68k-dual-sysv) As of 17.46, this worked except for a few changes needed in unexec.c. Dual running Uniplus (m68k-dual-uniplus) Worked, as of 17.51. Elxsi 6400 (elxsi-elxsi-sysv) Changes for 12.0 release are in 19.1. Dumping should work now. Encore machine (ns16k-encore-bsd) This machine bizarrely uses 4.2BSD modified to use the COFF format for object files. Works (as of 18.40). For the APC processor you must enable two lines at the end of `src/s/umax.h', which are commented out in the file as distributed. WARNING: If you compile Emacs with the "-O" compiler switch, you must also use the "-q enter_exits" switch so that all functions have stack frames. Otherwise routines that call `alloca' all lose. A kernel bug in some system versions causes input characters to be lost occasionally. GEC 63 (local-gec63-usg5.2) Changes are partially merged in version 18, but certainly require more work. Let us know if you get this working, and we'll give it a real configuration name. Gould Power Node (pn-gould-bsd4.2 or pn-gould-bsd4.3) 18.36 worked on versions 1.2 and 2.0 of the operating system. On UTX/32 2.0, use pn-gould-bsd4.3. On UTX/32 1.2 and UTX/32S 1.0, use pn-gould-bsd4.2 and note that compiling `lib-src/sorted-doc' tickles a compiler bug: remove the -g flag to cc in the makefile. UTX/32 1.3 has a bug in the bcopy library routine. Fix it by #undef BSTRING in `src/m/gould.h'. Version 19 incorporates support for releases 2.1 and later of UTX/32. A site running a pre-release of 2.1 should #define RELEASE2_1 in config.h. Gould NP1 (np1-gould-bsd) Version 19 supposedly works. Harris Night Hawk (m68k-harris-cxux or m88k-harris-cxux) This port was added in 19.23. The configuration actually tested was a Night Hawk 4800 running CX/UX 7.0. If you have GCC ported and want to build with it, you probably need to change things (like compiler switches) defined in the s/cxux.h file. With CX/UX 7.0 and later releases, you need to build after setting the SDE_TARGET environment variable to COFF (a port using ELF and shared libraries has not yet been done). Honeywell XPS100 (xps100-honeywell-sysv) Config file added in version 19. Hewlett-Packard 9000 series 200 or 300 (m68k-hp-bsd or m68k-hp-hpux7.) Version 19 works under BSD. The 19.26 pretest was reported to work on HPUX 9. These machines are 68000-series CPUs running HP/UX (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. Note that HP has used two incompatible assembler syntaxes, and has recently changed the format of C function frames. `src/crt0.c' and `src/alloca.s' have been conditionalised for the new assembler and new function-entry sequence. You may need to define OLD_HP_ASSEMBLER if you are using an older hpux version. If you have an official (bought from HP) series 300 machine you have the new assembler. Kernels that are 5.+ or later have new assembler. A Series 200 that has been upgraded to a 68010 processor and a 5.+ kernel has the new compiler. 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 a system that has a 68010 without a 68881. This is to say, a s200 (upgraded) or s310. Define the symbol HPUX_NET if you have the optional network features that include the `netunam' system call. This is referred to as Network Services (NS/9000) in HP literature. HP 9000 series 500: not supported. The series 500 has a seriously incompatible memory architecture which relocates data in memory during execution of a program, and support for it would be difficult to implement. HP 9000 series 700 or 800 (Spectrum) (hppa1.0-hp-hpux or hppa1.1-hp-hpux or ...hpux9shr) 19.26 is believed to work on HPUX 9 provided you compile with GCC. As of version 19.16, Emacs was reported to build (using GCC) and run on HP 9000/700 series machines running HP/UX versions 8.07 and 9.01. Use hppa1.1 for the 700 series and hppa1.0 for the 800 series machines. (Emacs may not actually care which one you use.) Use hppa1.1-hp-hpux9shr to use shared libraries on HPUX version 9. You may need to create the X libraries libXaw.a and libXmu.a from the MIT X distribute, and you may need to edit src/Makefile's definition of LIBXT to look like this: LIBXT= $(LIBW) -lXmu -lXt $(LIBXTR6) -lXext Some people report trouble using the GNU memory allocator under HP/UX version 9. The problems often manifest as lots of ^@'s in the buffer. 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 For 700 series machines, the HP-UX patch needed is known as PHSS_2653. (Perhaps for 800 series machines as well; we don't know.) If you are on the Internet, you should be able to obtain this patch by using telnet to access the machine support.mayfield.hp.com and logging in as "hpslreg" and following the instructions there. Do not ask FSF for further support on this. If you have any trouble obtaining the patch, contact HP Software Support. If your buffer fills up with nulls (^@) at some point, it could well be that problem. That problem does not happen when people use GCC to compile Emacs. On the other hand, the HP compiler version 9.34 was reported to work for the 19.26 pretest. 9.65 was also reported to work. If you turn on the DSUSP character (delayed suspend), Emacs 19.26 does not know how to turn it off on HPUX. You need to turn it off manually. 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. High Level Hardware Orion (orion-highlevel-bsd) This is the original microprogrammed hardware. Machine description file ought to work. High Level Hardware Orion 1/05 (clipper-highlevel-bsd) Changes merged in 18.52. This is the one with the Clipper cpu. Note that systems which lack NFS need LOAD_AVE_TYPE changed to `double'. C compiler has a bug; it loops compiling eval.c. Compile it by hand without optimization. IBM PS/2 (i386-ibm-aix1.1 or i386-ibm-aix1.2) Changes merged in version 19. You may need to copy /usr/lib/samples/hft/hftctl.c to the Emacs src directory. i386-ibm-aix1.1 may not work with certain new X window managers, and may be suboptimal. IBM RS/6000 (rs6000-ibm-aix*) Emacs 19.26 is believed to work; its pretest was tested. At last report, Emacs didn't run well on terminals. Informed persons say that the tty VMIN and VTIME settings have been corrupted; if you have a fix, please send it to us. Compiling with -O using the IBM compiler has been known to make Emacs work incorrectly. It's reported that on AIX 3.2.5 with an IBM compiler earlier than 1.03.00.14, cc -O fails for some files. You need to install any PTF containing APAR #IX42810 to bring the compiler to the 1.03.00.14 level to allow optimized compiles. There are reports that IBM compiler versions earlier than 1.03.00.02 fail even without -O. As of 19.11, if you strip the Emacs executable, it ceases to work. If you are using AIX 3.2.3, you may get a core dump when loading ange-ftp. You may be able to fix the problem by defining LIBS_TERMCAP as -ltermcap -lcurses. Please tell us if this fails to work. If anyone can fix the above problems, or confirm that they don't happen with certain versions of various programs, we would appreciate it. IBM RT/PC (romp-ibm-bsd or romp-ibm-aix) Use romp-ibm-bsd for the 4.2-like system and romp-ibm-aix for AIX. 19.22 is reported to work under bsd. We don't know about AIX. On BSD, if you have trouble, try compiling with a different compiler. On AIX, the file /usr/lib/samples/hft/hftctl.c must be compiled into hftctl.o, with this result left in the src directory (hftctl.c is part of the standard AIX distribution). window.c must not be compiled with -O on AIX. Integrated Solutions `Optimum V' (m68k-isi-bsd4.2 or -bsd4.3) 18.52 said to work on some sort of ISI machine. Version 18.45 worked (running on a Optimum V (VME bus, 68020) BSD 4.2 (3.05e) system). 18.42 is reported to work on a Qbus 68010 system. Has not been tried on `WorkStation' `Cluster Compute Node' `Cluster WorkStation' or `Server Node' (Love the StudLYCaps) Compilation with -O is rumored to break something. On recent system versions, you may need to undefine the macro UMAX in `lib-src/loadst.c' and `src/getpagesize.h'. They stupidly defined this in a system header file, which confuses Emacs (which thinks that UMAX indicates the Umax operating system). Intel 386 (i386-*-isc, i386-*-esix, i386-*-bsdi2, i386-*-xenix, i386-*-linux, i386-*-freebsd, i386-*-sol2.4, i386-intsys-sysv, i386-*-sysv3, i386-*-sysv4, i386-*-sysv4.2, i386-*-sysv5.3, i386-*-bsd4.2, i386-*-sco3.2v4, i386-*-bsd386, i386-*-386bsd, i386-*-msdos, i386-*-windowsnt. i386... can be replaced with i486... or i586...) In the above configurations, * means that the manufacturer's name you specify does not matter, and you can use any name you like (but it should not contain any dashes or stars). When using the ISC configurations, be sure to specify the isc version number - for example, if you're running ISC 3.0, use i386-unknown-isc3.0 as your configuration name. Use i386-*-esix for Esix; Emacs runs as of version 19.6. Use i386-*-linux for GNU/Linux systems; Emacs runs as of version 19.26. Use i386-intsys-sysv for Integrated Solutions 386 machines. It may also be correct for Microport systems. Use i386-*-sco3.2v4 for SCO 3.2v4; Emacs runs as of version 19.26. On GNU/Linux systems, Emacs 19.23 was said to work properly with libc version 4.5.21, but not with 4.5.19. If your system uses QMAGIC for the executable format, you must edit config.h to define LINUX_QMAGIC. On GNU/Linux, configure may fail to put these definitions in config.h: #define HAVE_GETTIMEOFDAY #define HAVE_MKDIR #define HAVE_RMDIR #define HAVE_XSCREENNUMBEROFSCREEN To work around the problem, add those definitions by hand. It is possible that this problem happens only with X11R6 or that newer system versions have fixed it. The 19.26 pretest was reported to work on SVR4.3 and on Freebsd. 19.29 is reported to crash when using Motif on Solaris 2.5. The reasons are not yet known. Use i386-*-bsd386 for BSDI BSD/386; Emacs runs as of version 19.23. Make on that system is broken; use GNU make instead. Shell bugs in version 1.0 of BSD/386 cause configure to do the wrong thing with --with-x-toolkit; the workaround is to edit configure to run another shell such as bash. For System V release 3, use i386-*-sysv3. For System V release 4, use i386-*-sysv4. For System V release 4.2, use i386-*-sysv4.2. If you are using Xenix, see notes at end under Xenix. If you are using Esix, see notes at end under Esix. If you are using SCO Unix, see notes at end under SCO. On 386bsd, netbsd and freebsd, you should use GNU make, not the system's make. Assuming it's installed as gmake, do `gmake install MAKE=gmake'. If you are using System V release 4.2, you may find that `cc -E' puts spurious spaces in `src/xmakefile'. If that happens, specify CPP=/lib/cpp as an option when you run make. There is no problem if you compile with GCC. Note that use on Linux with GCC 2.4 and the DLL 4.4 libraries requires the experimental "net 2" network patches (no relation to Berkeley Net 2). There is a report that (some version of) Linux requires including `/usr/src/linux/include/linux' in buffer.c but no coherent explanation of why that might be so. If it is so, in current versions of Linux, something else should probably be changed. Some sysV.3 systems seem to have bugs in `opendir'; for them, alter `config.h' to define NONSYSTEM_DIR_LIBRARY and undefine SYSV_SYSTEM_DIR. If you use optimization on V.3, you may need the option -W2,'-y 0' to prevent certain faulty optimization. On 386/ix, to link with shared libraries, add #define USG_SHARED_LIBRARIES to config.h. On SCO, there are problems in regexp matching when Emacs is compiled with the system compiler. The compiler version is "Microsoft C version 6", SCO 4.2.0h Dev Sys Maintenance Supplement 01/06/93; Quick C Compiler Version 1.00.46 (Beta). The solution is to compile with GCC. On ISC systems (2.02 and more recent), don't try to use the versions of X that come with the system; use XFree86 instead. There is no consistency in the handling of certain system header files on V.3. Some versions have sys/sioctl.h, and require it in sysdep.c. But some versions do not have sys/sioctl.h. For a given version of the system, this may depend on whether you have X Windows or TCP/IP. Define or undefine NO_SIOCTL_H in config.h according to whether you have the file. Likewise, some versions have been known to need sys/ttold.h, sys/stream.h, and sys/ptem.h included in sysdep.c. If your system has these files, try defining NEED_PTEM_H in config.h if you have trouble without it. You may find that adding -I/usr/X/include or -I/usr/netinclude or both to CFLAGS avoids compilation errors on certain systems. Some versions convince sysdep.c to try to use `struct tchars' but define `struct tc' instead; add `#define tchars tc' to config.h to solve this problem. Iris 2500 and Iris 2500 Turbo (m68k-sgi-iris3.5 or m68k-sgi-iris3.6) Version 18 was said to work; use m68k-sgi-iris3.5 for system version 2.5 and m68k-sgi-iris3.6 for system version 3.6. Note that the 3030 is the same as the Iris 2500 Turbo. Iris 4D (mips-sgi-irix[456].*) The 19.26 pretest was reported to work on IRIX 4.0.5 and 5.2. 19.23 was reported to work on IRIX 5.2, but you may need to install the "compiler_dev.hdr.internal" subsystem in order to compile unexelfsgi.c. 19.22 was known to work on all Silicon Graphics machines running IRIX 4.0.5 or IRIX 5.1. Compiling with -O using IRIX compilers prior to 3.10.1 may not work. Don't use -O or use GCC instead. Most IRIX 3.3 systems do not have an ANSI C compiler, but a few do. Compile Emacs 18 with the -cckr switch on these machines. There is a bug in IRIX 3.3 that can sometimes leave ptys owned by root with a permission of 622. This causes malfunctions in use of subprocesses of Emacs. Irix versions 4.0 and later with GNU Emacs versions 18.59 and later fix this bug. Masscomp (m68k-masscomp-rtu) 18.36 worked on a 5500DP running RTU v3.1a and compiler version 3.2 with minor fixes that are included in 18.37. However, bizarre behavior was reported for 18.36 on a Masscomp (model and version unknown but probably a 68020 system). The report sounds like a compiler bug. A compiler bug affecting statements like unsigned char k; unsigned char *p;... x = p[k]; has been reported for "C version 1.2 under RTU 3.1". We do not wish to take the time to install the numerous workarounds required to compensate for this bug. For RTU version 3.1, define FIRST_PTY_LETTER to be 'p' in `src/s/rtu.h' (or #undef and redefine it in config.h) so that ptys will be used. GNU Emacs is said to have no chance of compiling on RTU versions prior to v3.0. Megatest (m68k-megatest-bsd) Emacs 15 worked; do not have any reports about Emacs 16 or 17 but any new bugs are probably not difficult. Mips (mips-mips-riscos, mips-mips-riscos4.0, or mips-mips-bsd) The C compiler on Riscos 4.51 dumps core trying to optimize parts of Emacs. Try without optimization or try GCC. Meanwhile, the linker on that system returns success even if there are undefined symbols; as a result, configure gets the wrong answers to various questions. No work-around is known except to edit src/config.h by hand to indicate which functions don't exist. Use mips-mips-riscos4.0 for RISCOS version 4. Use mips-mips-bsd with the BSD world. Note that the proper configuration names for DECstations are mips-dec-ultrix and mips-dec-osf. If you are compiling with GCC, then you must run fixincludes; the alternative of using -traditional won't work because the definition of SIGN_EXTEND_CHAR uses the keyword `signed'. If the SYSV world is the default, then you probably need the following line in etc/Makefile: CFLAGS= -g -systype bsd43 Some operating systems on MIPS machines give SIGTRAP for division by zero instead of the usual signals. The only real solution is to fix the system to give a proper signal. In the meantime, you can change init_data in data.c if you wish. Change it to handle SIGTRAP as well as SIGFPE. But this will have a great disadvantage: you will not be able to run Emacs under a debugger. I think crashing on division by zero is a lesser problem. dsg@mitre.org reported needing to use --x-libraries=/bsd43/usr/lib on a riscos4bsd site. But it is not clear whether this is needed in general or only because of quirks on a particular site. National Semiconductor 32000 (ns32k-ns-genix) This is for a complete machine from National Semiconductor, running Genix. Changes merged in version 19. NCR Tower 32 (m68k-ncr-sysv2 or m68k-ncr-sysv3) If you are running System V release 2, use m68k-ncr-sysv2. If you are running System V release 3, use m68k-ncr-sysv3. These both worked as of 18.56. If you change `src/ymakefile' so that CFLAGS includes C_OPTIMIZE_SWITCH rather than C_DEBUG_SWITCH, check out the comments in `src/m/tower32.h' (for System V release 2) or `src/m/tower32v3.h' (for System V release 3) about this. There is a report that compilation with -O did not work with 18.54 under System V release 2. NeXT (m68k-next-nextstep) 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. Nixdorf Targon 31 (m68k-nixdorf-sysv) Machine description file for version 17 is included in 18 but whether it works is not known. `src/unexec.c' bombs if compiled with -O. Note that the "Targon 35" is really a Pyramid. Nu (TI or LMI) (m68k-nu-sysv) Version 18 is believed to work. Paragon OSF/1 (i860-intel-osf1) Changes merged in 19.29. There is a bug in OSF/1 make which claims there is a syntax error in the src/xmakefile. You can sucessfully build emacs with: pmake MAKE=pmake Plexus (m68k-plexus-sysv) Worked as of 17.56. Pmax (DEC Mips) (mips-dec-ultrix or mips-dec-osf1) See under DECstation, above. Prime EXL (i386-prime-sysv) Minor changes merged in 19.1. Pyramid (pyramid-pyramid-bsd) The 19.26 pretest was observed to work on OSx 5.0, but it is necessary to edit gmalloc.c. You must add #include at the top, and delete the #define for size_t. You need to build Emacs in the Berkeley universe with the `ucb' command, as in `ucb make' or `ucb build-install'. In OSx 4.0, it seems necessary to add the following two lines to `src/m/pyramid.h': #define _longjmp longjmp #define _setjmp setjmp In Pyramid system 2.5 there has been a compiler bug making Emacs crash just after screen-splitting with Qnil containing 0. A compiler that fixes this is Pyramid customer number 8494, internal number 1923. Some versions of the pyramid compiler get fatal errors when the -gx compiler switch is used; if this happens to you, change `src/m/pyramid.h' to define C_DEBUG_SWITCH with an empty definition. Some old system versions may require you to define PYRAMID_OLD in when alloca.s is preprocessed, in order to define _longjmp and _setjmp. Sequent Balance (ns32k-sequent-bsd4.2 or ns32k-sequent-bsd4.3) Emacs 18.51 worked on system version 3.0. 18.52 is said to work. Delete some lines at the end of `src/m/sequent.h' for earlier system versions. Sequent Symmetry (i386-sequent-bsd, i386-sequent-ptx) Emacs 19 should work on Dynix (BSD). However, if you compile with the Sequent compiler, you may find Emacs does not restore the terminal settings on exit. If this happens, compile with GCC. Emacs 19.27 contains patches that should support DYNIX/ptx 1.4 and 2.1 with the native cc compiler. Gcc can't compile src/process.c due to a non-standard Sequent asm keyword extension supported by cc and used for the network byte/word swapping functions in the PTX /usr/include/netinet/in.h file. Gcc 2.5.8 includes the file which can be included into netinet/in.h to perform these byte/word swapping functions in the same manner. Patches have been submitted to the FSF against gcc 2.6.0 to fix this problem and allow Emacs to be built with gcc. If your machine does not have TCP/IP installed, you will have to edit the src/s/ptx.h file and comment out #define TCPIP_INSTALLED. Siemens Nixdorf RM600 and RM400 (mips-siemens-sysv4) Changes merged in 19.29. This configuration should also work for Pyramid MIS Server running DC-OSX 1.x. The version configured with `--with-x' works without any modifications, but `--with-x-toolkit' works only if the Athena library and the Toolkit library are linked statically. For this, edit `src/Makefile' after the `configure' run and modify the lines with `-lXaw' and `-lXt' as follows: LIBW= /usr/lib/libXaw.a LIBXT= $(LIBW) -lXmu /usr/lib/libXt.a $(LIBXTR6) -lXext SONY News (m68k-sony-bsd4.2 or m68k-sony-bsd4.3) 18.52 worked. Use m68k-sony-bsd4.3 for system release 3. SONY News 3000 series (RISC NEWS) (mips-sony-bsd) The 19.26 pretest is reported to work. Some versions of the operating system give SIGTRAP for division by zero instead of the usual signals. This causes division by zero to make Emacs crash. The system should be fixed to give the proper signal. Changing Emacs is not a proper solution, because it would prevent Emacs from working under any debugger. But you can change init_data in data.c if you wish. Stardent i860 (i860-stardent-sysv4.0) 19.26 pretest reported to work. Stardent 1500 or 3000 See Titan. Stride (m68k-stride-sysv) Works (most recent news for 18.30) on their release 2.0. For release 2.2, see the end of `src/m/stride.h'. It may be possible to run on their V.1 system but changes in the s- file would be needed. Sun 3, Sun 4 (sparc), Sun 386 (m68k-sun-sunos, sparc-sun-sunos, i386-sun-sunos, sparc-sun-sunos4shr, sparc-sun-solaris2.*, i386-sun-solaris2.*) 19.26 is believed to work on Sparcs and Sun 3's. Some people report that Emacs crashes immediately on startup when used with a non-X terminal, but we think this is due to compiling with GCC and failing to use GCC's "fixed" system header files. Some Sun versions of X windows use the clipboard, not the selections, for transferring text between clients. The Cut, Paste and Copy items in the menu bar Edit menu work with the clipboard. It's important to include the SunOS version number in the configuration name. For example, for SunOS release 4.0 on a Sun 3, use `m68k-sun-sunos4.0'; for SunOS release 4.1 on a Sparc, use `sparc-sun-sunos4.1'. For SunOS release 4.1.3 on a Sparc, use `sparc-sun-sunos4.1.3'. Note that shared libraries are now used by default on SunOS 4.1. A user reported unreproducible segmentation faults when using 19.29 on Solaris 2.3 and 2.4 after compiling it with the Sun compiler. The problem went away when GCC 2.7.0 was used instead. We do not know whether anything in Emacs is partly to blame for this. X11R6 is set up to make shared libraries only, on Sunos 4. Therefore, in order to link Emacs, you need to create static X libraries. To do this, rebuild X11 after setting #define ForceNormalLib YES #define SeparateSharedCompile YES in site.def (after #ifdef AfterVendorCF). Use `m68k' for the 68000-based Sun boxes, `sparc' for Sparcstations, and `i386' for Sun Roadrunners. i386 calls for Sunos4.0. If you compile with Sun's ANSI compiler acc, you need additional options when linking temacs, such as /usr/lang/SC2.0.1/values-Xt.o -L/usr/lang/SC2.0.1/cg87 -L/usr/lang/SC2.0.1 (those should be added just before the libraries) and you need to add -lansi just before -lc. The precise file names depend on the compiler version, so we cannot easily arrange to supply them. On SunOS 4.1.1, do not use /usr/5bin/cc. You can use gcc or/usr/bin/cc. Make sure the environment variable LD_LIBRARY_PATH is not defined. Some people report crashes on SunOS 4.1.3 if SYSTEM_MALLOC is defined. Others have reported that Emacs works if SYSTEM_MALLOC is defined, and not if it is undefined. So far we do not know why results vary in this way. The sources are set up so that SYSTEM_MALLOC is defined; if that crashes, or if you want the benefit of the relocating memory allocator, you can try enabling the #undef SYSTEM_MALLOC in src/s/sunos4-1-3.h. On Solaris 2, you need to install patch 100947-02 to fix a system bug. Presumably this patch comes from Sun. You must alter the definition of LD_SWITCH_SYSTEM if your X11 libraries are not in /usr/openwin/lib. You must make sure that /usr/ucblib is not in your LD_LIBRARY_PATH. On Solaris 2.2, with a multiprocessor SparcCenter 1000, Emacs 19.17 is reported to hang sometimes if it exits while it has one or more subprocesses (e.g. the `wakeup' subprocess used by `display-time'). Emacs and its subprocesses become zombies, and in their zombie state slow down their host and disable rlogin and telnet. This is most likely due to a bug in Solaris 2.2's multiprocessor support, rather than an Emacs bug. On Solaris, do not use /usr/ucb/cc. Use /opt/SUNWspro/bin/cc. Make sure that /usr/ccs/bin and /opt/SUNWspro/bin are in your PATH before /usr/ucb. (Most free software packages have the same requirement on Solaris.) If you have trouble using open-network-stream, get the distribution of `bind' (the BSD name-server), build libresolv.a, and link Emacs with -lresolv, by copying the #definition of LIBS_SYSTEM in src/s/sunos4-1.h to src/config.h. This problem is due to obsolete software in the nonshared standard library. If you want to use SunWindows, define HAVE_SUN_WINDOWS in config.h to enable a special interface called `emacstool'. The definition must *precede* the #include "machine.h". System version 3.2 is required for this facility to work. We recommend that you instead use the X window system, which has technical advantages, is an industry standard, and is also free software. The FSF does not support the SunWindows code; we installed it only on the understanding we would not let it divert our efforts from what we think is important. If you are compiling for X windows, and the X window library was compiled to use the 68881, then you must edit config.h according the comments at the end of `src/m/sun3.h'. Note that Emacs on a Sun is not really as big as it looks. As dumped, it includes around 200k of zeros between the original text section and the original data section (now remapped as part of the text). These are never swapped in. To build a single Emacs that will run on Sun 2 and Sun 3 HARDWARE, just build it on the Sun 2. On Sunos 4.1.3, the word is that Emacs can loop infinitely on startup with X due perhaps to a bug in Sunos. Installing all of these Sun patches fixes the problem. We don't know which of them are really relevant. 100075-11 100224-06 100347-03 100482-05 100557-02 100623-03 100804-03 101080-01 100103-12 100249-09 100496-02 100564-07 100630-02 100891-10 101134-01 100170-09 100296-04 100377-09 100507-04 100567-04 100650-02 101070-01 101145-01 100173-10 100305-15 100383-06 100513-04 100570-05 100689-01 101071-03 101200-02 100178-09 100338-05 100421-03 100536-02 100584-05 100784-01 101072-01 101207-01 Tadpole 68K (m68k-tadpole-sysv) Changes merged in 19.1. You may need to edit Makefile to change the variables LIBDIR and BINDIR from /usr/local to /usr/contrib. To give movemail access to /usr/mail, you may need to execute chmod 2755 etc/movemail; chgrp mail etc/movemail Tahoe (tahoe-tahoe-bsd4.2 or tahoe-tahoe-bsd4.3) 18.52 was known to work on some Tahoes, but a compiler bug intervenes on others. Some Emacs versions have worked in Unisys 1r4 (not in 1r3) and CCI I.21. If you have trouble compiling `lib-src/loadst.c', turn off the definition of DKSTAT_HEADER_FILE in `src/m/tahoe.h'. Tandem Integrity S2 (mips-tandem-sysv) Changes merged in 18.56 but subprocess support is turned off. You will probably want to see if you can make subprocesses work. You must edit `lib-src/Makefile' to define LOADLIBES = -mld. Tektronix XD88 (m88k-tektronix-sysv3*) The 19.26 pretest was reported to work. Minor changes merged in 19.19. Tektronix 16000 box (6130?) (ns16k-tektronix-bsd) Emacs 17.61 worked. Tektronix 4300 (m68k-tektronix-bsd) Emacs 19.26 pretest reported to work. Titan P2 or P3 (titan-titan-sysv) Changes probably merged in version 19. Ustation E30 (SS5E) (m68k-unisys-unipl) Changes merged in 18.52; don't know whether they work. Vaxen running Berkeley Unix (vax-dec-bsd4.1, vax-dec-bsd4.2, vax-dec-bsd4.3), Ultrix (vax-dec-ultrix), System V (vax-dec-sysv0, vax-dec-sysv2), or VMS (vax-dec-vms) Works. See under Ultrix for problems using X windows on Ultrix (vax-dec-ultrix). 18.27 worked on System V rel 2 (vax-dec-sysv2). 18.36 worked on System V rel 0 (vax-dec-sysv0). Richard Levitte distributes a set of patches to Emacs 18.59 to make it work nicely under VMS. Emacs 19 probably won't work very well, or even compile. Levitte is working on a port, so these problems should be fixed in the near future. Whitechapel MG1 (ns16k-whitechapel-?) May work. Supposedly no changes were needed except in `src/m/mg1.h' file. I do not know what Unix version runs on them. Wicat (m68k-wicat-sysv) Changes merged as of 18.6; whether they work is unknown. See comments in `src/m/wicat.h' for things you should change depending on the system and compiler version you have. Here are notes about some of the systems supported: Berkeley 4.1 (bsd4.1) Works on vaxes. Berkeley 4.2 (bsd4.2) Works on several machines. Berkeley 4.3 (bsd4.3) Works, on Vaxes at least. Esix The following was written for Emacs 18.59 and has been slightly adapted for Emacs 19. It may need more change to be correct. Use s/usg5-4.h for Esix System V 4.0.[34] systems if you also have XFree86. If you insist on using the Esix X Window libraries, good luck. s/esix5r4.h provides a starting point, but doesn't seem to work consistently. The basic problems involve the need to load -lX11 *last* in the link command, and even then some things break. You get best results by installing XFree86 and forgetting about the Esix stuff unless you want to run IXI xdt3, which really only needs the Esix X11 shared libraries. To compile with XFree86, make sure that your LD_LIBRARY_PATH contains /usr/X386/lib. Be careful if you also have the Esix X Window libraries that /usr/X386/lib appears *first* in the LD_LIBRARY_PATH. Then define C_SWITCH_X_SYSTEM -I/usr/X386/include. Microport See under "Intel 386". MSDOS For installation on MSDOS, see the file etc/INSTALL and search for `MSDOG'. See the file etc/MSDOS for information about using Emacs on MSDOS. SCO Unix If you have TCP but not X, you need to edit src/s/sco4.h to define HAVE_SOCKETS. If you are using MMDF instead of sendmail, you need to remove /usr/lib/sendmail or modify lisp/paths.el before compiling. lisp/paths.el (which is loaded during the build) will attempt to use sendmail if it exists. If you are using SMAIL, you need to define the macro SMAIL in config.h. System V rel 0 (usg5.0) Works, on Vaxes and 3bxxx's. There are some problems in 18.37 due to shortnames/cccp problems: use the emacs 17 cpp if you have it. System V rel 2 (usg5.2) Works on various machines. On some (maybe all) machines the library -lPW exists and contains a version of `alloca'. On these machines, to use it, put #define HAVE_ALLOCA #define LIB_STANDARD -lPW -lc in the `src/m/MACHINENAME.h' file for the machine. If you find that the character Meta-DEL makes Emacs crash, 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) In 5.2.2 AT&T undid, incompatibly, their previous incompatible change to the way the nlist library is called. A different s- file is used to enable the other interface. They call themselves the right choice--can't they choose? Emacs version 18 unexec is currently not working properly on 5.2.2. Nobody knows why yet. A workaround is to define NO_REMAP. It is not yet known whether this applies to all machines running 5.2.2. System V rel 3 (usg5.3) Some versions of this system support ptys and BSD-style sockets. On such systems, you should define HAVE_PTYS and HAVE_SOCKETS in config.h. If you want to link Emacs with shared libraries, define USG_SHARED_LIBRARIES. You may have to add ANSI idempotence #-lines to your sys/types.h file to get Emacs to compile correctly. This may be necessary on other pre-ANSI systems as well. On an AT&T 6386WGS using System V Release 3.2 and X11R3, the X support cannot be made to work. Whether or not the GNU relocating malloc is used, the symptom is that the first call Emacs makes to sbrk(0) returns (char *)-1. Sorry, you're stuck with character-only mode. Try installing Xfree86 to fix this. System V rel 4.0.3 and 4.0.4 (usg5.4) Supported, including shared libraries for ELF, but ptys do not work because TIOCGPGRP fails to work on ptys (but Dell 2.2 seems to have fixed this). This failure is probably due to a misunderstanding of the consequences of the POSIX spec: many system designers mistakenly think that POSIX requires this feature to fail. This is untrue; ptys are an extension, and POSIX says that extensions *when used* may change the action of standard facilities in any fashion. If you get compilation errors about wrong number of arguments to getpgrp, define GETPGRP_NO_ARG. The standard C preprocessor may generate xmakefile incorrectly. However, /lib/cpp will work, so use `make CPP=/lib/cpp'. Standard cpp seems to work OK under Dell 2.2. Some versions 3 and earlier of V.4, on the Intel 386 and 860, had problems in the X11 libraries. These prevent Emacs from working with X. You can use Emacs with X provided your copy of X is based on X11 release 4 or newer, or is Dell's 2.2 (which is a 4.0.3). Unfortunately, the only way you can tell whether your X11 library is new enough is to try compiling Emacs to use X. If emacs runs, your X11 library is new enough. In this context, GSV4 and GSV4i are alternate names for X11R4. OL2.* is X11R3 based. OL3 is in between X11R3 and X11R4, and may or may not work, depending on who made the Unix system. If the library libXol is part of the X distribution, then you have X11R3 and Emacs won't work with X. Most versions of V.4 support sockets. If `/usr/lib/libsocket.so' exists, your system supports them. If yours does not, you must add #undef HAVE_SOCKETS in config.h, after the inclusion of s-usg5-4.h. (Any system that supports Internet should implement sockets.) Ultrix (bsd4.3) Recent versions of Ultrix appear to support the features of Berkeley 4.3. Ultrix was at the BSD 4.2 level for a long time after BSD 4.3 came out. Ultrix 3.0 has incompatibilities in its X library if you have the Ultrix version of X (UWS version 2.0). To solve them, you need to prevent XvmsAlloc.o in Xlib from being used. Israel Pinkas says: I added the following lines to config.h after the X defines: #if defined(ultrix) && defined(X11) #define OBJECTS_SYSTEM calloc.o #endif Then I ran the following: ar x /usr/lib/libc.a calloc.o The problem is said to be gone in UWS version 2.1. Uniplus 5.2 (unipl5.2) Works, on Dual machines at least. VMS (vmsM.N) Richard Levitte distributes a set of patches to Emacs 18.59 to make it work nicely under VMS. Emacs 19 probably won't work very well, or even compile. Levitte is working on a port, so these problems should be fixed in the near future. Note that Emacs for VMS is usually distributed in a special VMS distribution. See the file ../vms/VMSINSTALL for info on moving Unix distributions to VMS, and other VMS-related topics. Windows NT For installation on Windows NT, see the file etc/INSTALL and search for `Windows NT'. Xenix (xenix) Should work in 18.50, but you will need to edit the files `lib-src/Makefile' and `src/ymakefile' (see the comments that mention "Xenix" for what to change.) Compiling Emacs with -O is said not to work. If you want Emacs to work with Smail (installed as /usr/bin/smail) then add the line #define SMAIL to config.h. The file etc/XENIX suggests some useful things to do to Xenix to make the Emacs meta key work. Local variables: mode: indented-text fill-prefix: " " End: emacs-19.30/etc/MSDOS100666 12120 13 4537 5566705124 12252 0ustar rmsuserThis file describes use of Emacs 19 on MS-DOG. * The commands `mode25' and `mode4350' change the number of lines of the screen. You get 43 lines on an EGA monitor, 50 on a VGA monitor. * Ctrl-Break takes the place of C-g. Using compilers prior to djgpp 1.11 maint 5, you should not use Ctrl-Break unless you run under DPMI (i.e., you are using Windows, Qdpmi, ...) Actually, if Emacs is in an endless loop, you might as well go ahead and try. Usually it works, but sometimes Emacs crashes with a stack trace. This is not an Emacs bug. * Character codes 0200-0237 are self-inserting. * The keyboard support is made as X-like as possible. This means that events like M-S-f1 will be generated (by Shift + Alt + f1). * Mouse support is partially implemented. * The `compile' command works on MS-DOG, but it waits for the compilation to finish before letting you edit again. There's no other way to do it, given the lack of asynchronous processes. * The function `expand-file-name' maps upper case letters to lower case letters, since MS-DOG does not distinguish. * The new buffer-local variable `buffer-file-type' controls whether a file contains text (newlines will be written as CR+LF) or binary data (newlines written as LF). Text is specified by nil, and binary by t. The status of a buffer can be seen in the mode line as "T:" or "B:" before the major mode. Normally `buffer-file-type' is set automatically from the variable `file-name-buffer-file-type-alist' which is an alist mapping regexps to file types. You can visit a file explicitly as text, or as binary, using the commands `find-file-binary' and `find-file-text'. * New variables `binary-process-input' and `binary-process-output' control whether temporary files are opened as binary or as text files. nil means text, and t means binary. The difference is translation of CR+LF to LF and C-z handling. * Environment variables "HOME", "EMACSPATH", "TERM", "SHELL", "USER", "NAME", and "TZ" are given default values as suitable for a single user system. See src/msdos.c for details. * The function `substitute-in-file-name' disregards case in environment variables, as the MS-DOG SET command does. * The variable `msdos-shells' contains a list of commands that are shells. This variable is used to convert to map Unix-like commands like "$SHELL -c /some/command" to MS-DOG commands like "$SHELL /c \some\command". emacs-19.30/etc/MAILINGLISTS100664 13035 13 120366 6014205070 13277 0ustar gnuuser GNU Project Electronic Mailing Lists. Last Updated 15 Aug 95 Please report improvements to: gnu@prep.ai.mit.edu * GNU mailing lists are also distributed as USENET news groups The mailing lists are gated both ways with the gnu.all newsgroups at ohio-state.edu. The one-to-one correspondence is indicated below. If you don't know if your site is on USENET, ask your system administrator. If you are a USENET site and don't get the gnu.all newsgroups, please ask your USENET administrator to get them. If he has your feeds ask their feeds, you should win. And everyone else wins: newsgroups make better use of the limited bandwidth of the computer networks and your home machine than mailing list traffic; and staying off the mailing lists make better use of the people who maintain the lists and the machines that the GNU people working with rms use (i.e. we have more time to produce code!!). Thanx. * Getting the mailing lists directly If several users at your site or local network want to read a list and you aren't a USENET site, Project GNU would prefer that you would set up one address that redistributes locally. This reduces overhead on our people and machines, your gateway machine, and the network(s) used to transport the mail from us to you. * How to subscribe to and report bugs in mailing lists Send messages ABOUT these lists, such as reports of mail problems, or requests to be added or removed, to help-gnu-emacs-request (or info-gnu-request, bug-gdb-request, etc.), NOT to info-gnu-emacs (or info-gnu, etc.). These -request addresses go only to the people who can do something about your requests or problems, and thus avoids disturbing everyone else. Note that all GNU mailing lists are maintained by volunteers. They get behind occasionally. Wait at least 3 or 4 days before asking again. Thanks! Many of the GNU mailing lists are very large and are received by many people. Please don't send them anything that is not seriously important to all their readers. All GNU mailing lists are unmoderated, mail reflectors, except info-gnu, info-gnu-emacs, info-gcc, info-g++, info-gnu-fortran, info-gnu-utils, info-gnu-chess and info-gnu-shogi. All addresses below are in internet format. Consult the mail guru for your computer to figure out address syntaxes from other networks. From UUCP machines: ..!ucbvax!prep.ai.mit.edu!ADDRESS ..!uunet!prep.ai.mit.edu!ADDRESS If a message you mail to a list is returned from a MAILER-DAEMON (often with the line: ----- Transcript of session follows ----- don't resend the message to the list. All this return means is that your original message failed to reach a few addresses on the list. Such messages are NEVER a reason to resend a piece of mail a 2nd time. This just bothers all (less the few delivery failures (which will probably just fail again!)) of the readers of the list with a message they have already seen. It also wastes computer and network resources. It is appropriate to send these to the -request address for a list, and ask them to check the problem out. * Send Specific Requests for Information to: gnu@prep.ai.mit.edu Specific requests for information about obtaining GNU software, or GNU activities in Cambridge and elsewhere can be directed to: gnu@prep.ai.mit.edu * General Information about all lists Please keep each message under 25,000 characters. Some mailers bounce messages that are longer than this. If your message is long, it is generally better to send a message offering to make the large file available to only those people who want it (e.g. mailing it to people who ask, or putting it up for FTP). In the case of gnu.emacs.sources, somewhat larger postings (up to 10 parts of no more than 25,000 characters each) are acceptable (assuming they are likely to be of interest to a reasonable number of people); if it is larger than that have it added to archive.cis.ohio-state.edu (the GNU Emacs Lisp ftp and uucp archive on and announce) its location there. Good bug reports are short. See section '* General Information about bug-* lists and ...' for further details. Most of the time, when you reply to a message sent to a list, the reply should not go to the list. But most mail reading programs supply, by default, all the recipients of the original as recipients of the reply. Make a point of deleting the list address from the header when it does not belong. This prevents bothering all readers of a list, and reduces network congestion. The GNU mailing lists and newsgroups, like the GNU project itself, exist to promote the freedom to share software. So don't use these lists to promote or recommend non-free software. (Using them to post ordering information is the ultimate faux pas.) If there is no free program to do a certain task, then somebody should write one! * General Information about info-* lists These lists and their newsgroups are meant for important announcements. Since the GNU project uses software development as a means for social change, the announcements may be technical or political. Most GNU projects info-* lists (and their corresponding gnu.*.announce newsgroups) are moderated to keep their content significant and relevant. If you have a bug to report, send it to the bug-* list. If you need help on something else and the help-* list exists, ask it. See section '* General Information about all lists'. * General Information about help-* lists These lists (and their newsgroups) exist for anyone to ask questions about the GNU software that the list deals with. The lists are read by people who are willing to take the time to help other users. When you answer the questions that people ask on the help-* lists, keep in mind that you shouldn't answer by promoting a proprietary program as a solution. The only real solutions are the ones all the readers can share. If a program crashes, or if you build it following the standard procedure on a system on which it is supposed to work and it does not work at all, or if an command does not behave as it is documented to behave, this is a bug. Don't send bug reports to a help-* list; mail them to the bug-* list instead. See section '* General Information about all lists'. * General Information about bug-* lists and reporting program bugs If you think something is a bug in a program, it might be one; or, it might be a misunderstanding or even a feature. Before beginning to report bugs, please read the section ``Reporting Emacs Bugs'' toward the end of the GNU Emacs reference manual (or node Emacs/Bugs in Emacs's built-in Info system) for a discussion of how and when to send in bug reports. For GNU programs other than GNU Emacs, also consult their documentation for their bug reporting procedures. Always include the version number of the GNU program, as well as the operating system and machine the program was ran on (if the program doesn't have a version number, send the date of the latest entry in the file ChangeLog). For GNU Emacs bugs, type "M-x emacs-version". A debugger backtrace of any core dump, can also be useful. Be careful to separate out hypothesis from fact! For bugs in GNU Emacs lisp, set variable debug-on-error to t, and re-enter the command(s) that cause the error message; Emacs will pop up a debug buffer if something is wrong; please include a copy of the buffer in your bug report. Please also try to make your bug report as short as possible; distill the problem to as few lines of code and/or input as possible. GNU maintainers give priority to the shortest, high quality bug reports. Please don't send in a patch without a test case to illustrate the problem the patch is supposed to fix. Sometimes the patches aren't correct or aren't the best way to do the job, and without a test case there is no way to debug an alternate fix. The purpose of reporting a bug is to enable the bug to be fixed for the sake of the whole community of users. You may or may not receive a response; the maintainers will send one if that helps them find or verify a fix. Most GNU maintainers are volunteers and all are overworked; they don't have time to help individuals and still fix the bugs and make the improvements that everyone wants. If you want help for yourself in particular, you may have to hire someone. The GNU project maintains a list of people providing such services. It is distributed with GNU Emacs in file etc/SERVICE, and can be requested from gnu@prep.ai.mit.edu. Anything addressed to the implementors and maintainers of a GNU program via a bug-* list, should NOT be sent to the corresponding info-* or help-* list. Please DON'T post your bug reports on the gnu.*.bug newsgroups! Mail them to bug-*@prep instead! At first sight, it seems to make no difference: anything sent to one will be propagated to the other; but: - if you post on the newsgroup, the information about how to reach you is lost in the message that goes on the mailing list. It can be very important to know how to reach you, if there is anything in the bug report that we don't understand; - bug reports reach the GNU maintainers quickest when they are sent to the bug-* mailing list submittal address; - mail is much more reliable then netnews; and - if the internet mailers can't get your bug report delivered, they almost always send you an error message, so you can find another way to get the bug report in. When netnews fails to get your message delivered to the maintainers, you'll never know about it and the maintainers will never see the bug report. And please DON'T post your GNU bug reports to comp.* or other gnu.* newsgroups, they never make it to the GNU maintainers at all. Please mail them to bug-*@prep instead! See section '* General Information about all lists'. * info-gnu-request@prep.ai.mit.edu to subscribe to info-gnu ** gnUSENET newsgroup: gnu.announce ** Send announcements to: info-gnu@prep.ai.mit.edu This list distributes progress reports on the GNU Project. It is also used by the GNU Project to ask people for various kinds of help. It is NOT for general discussion. The list is filtered to remove items meant for info-gnu-request, that can be answered by the moderator without bothering the list, or should have been sent to another list. See section '* General Information about info-* lists'. * gnu-misc-discuss-request@cis.ohio-state.edu to subscribe to gnu-misc-discuss ** gnUSENET newsgroup: gnu.misc.discuss ** Send contributions to: gnu-misc-discuss@cis.ohio-state.edu This list is for serious discussion of freed software, the GNU Project, the GNU Manifesto and their implications. It's THE place for discussion that is not appropriate in the other GNU mailing lists and gnUSENET newsgroups. Flaming is out of place. Tit-for-tat is not welcome. Repetition should not occur. Good READING and writing are expected. Before posting, wait a while, cool off, and think. Don't use this group for complaints about GNU software! The maintainers don't read this group; they won't see your complaint. Use the appropriate bug-reporting mailing list instead, so that people who can do something about the problem will see it. Don't trust pronouncements made on gnu-misc-discuss about what GNU is, what FSF position is, what the GNU General Public License is, etc., unless they are made by someone you know is well connected with GNU and are sure the message is not forged. USENET and gnUSENET readers are expected to have read ALL the articles in news.announce.newusers before posting. If news.announce.newusers is empty at your site, wait (the articles are posted monthly), your posting isn't that urgent! Readers on the Internet can anonymous ftp these articles from wsmr-simtel20.army.mil under directory PD2:. Someone from the Free Software Foundation will attempt to follow this group as time and volume permits. Remember, "GNUs Not Unix" and "gnUSENET is Not USENET". We have higher standards! Note that sending technical questions about specific GNU software to gnu-misc-discuss is likely to be less useful than sending them to the appropriate mailing list or gnUSENET newsgroup, since more technical people read those. * hurd-ann-request@prep.ai.mit.edu to subscribe to hurd-ann ** gnUSENET newsgroup: gnu.hurd.announce ** Send announcements to: hurd-ann@prep.ai.mit.edu This list distributes progress reports on the GNU Hurd. It is also to ask people for various kinds of help on the Hurd. It is NOT for general discussion. The list is filtered to remove items meant for hurd-ann-request, that can be answered by the moderator without bothering the list, or should have been sent to another list. See section '* General Information about info-* lists'. * bug-gnu-emacs-request@prep.ai.mit.edu to subscribe to bug-gnu-emacs ** gnUSENET newsgroup: gnu.emacs.bug ** Gnu Emacs bug reports to: bug-gnu-emacs@prep.ai.mit.edu This list distributes, to the active maintainers of GNU Emacs, bug reports and fixes for, and suggestions for improvements in GNU Emacs. Send bugs in the GNU Emacs Lisp reference manual to: lisp-manual-bugs@prep.ai.mit.edu lisp-manual-bugs is neither a mailing list nor a gnUSENET newsgroup. It's just a bug-reporting address. Subscribers to bug-gnu-emacs get all info-gnu-emacs messages. See section '* General Information about bug-* lists and reporting program bugs'. * gnu-emacs-sources-request@prep.ai.mit.edu to subscribe to gnu-emacs-sources ** gnUSENET newsgroup: gnu.emacs.sources ** Gnu Emacs source code to: gnu-emacs-sources@prep.ai.mit.edu This list/newsgroup will be for the posting, by their authors, of lisp and C sources and patches that improve GNU Emacs. Its contents will be reviewed by FSF for inclusion in future releases of GNU Emacs. Please do NOT discuss or request source code here. Use help-gnu-emacs/gnu.emacs.help for those purposes. This allows the automatic archiving of sources posted to this list/newsgroup. Please do NOT post such sources to any other GNU mailing list (e.g help-gnu-emacs) or gnUSENET newsgroups (e.g. gnu.emacs.help). It's up to each poster to decide whether to cross-post to any non-gnUSENET newsgroup (e.g. comp.emacs or vmsnet.sources). Please do NOT announce that you have posted source code to gnu.emacs.sources to any other GNU mailing list (e.g. help-gnu-emacs) or gnUSENET newsgroups (e.g. gnu.emacs.help). People who want to keep up with sources will read this list/newsgroup. It's up to each poster to decide whether to announce a gnu.emacs.sources article in any non-gnUSENET newsgroup (e.g comp.emacs or comp.sources.d). If source or patches that were previously posted or a simple fix is requested in help-gnu-emacs, please mail it to the requester. Do NOT repost it. If you also want something that is requested, send mail to the requester asking him to forward it to you. This kind of traffic is best handled by e-mail, not by a broadcast medium that reaches thousands of sites. If the source is very long (>10k bytes) send mail offering to send it. This prevents the requester from getting many redundant copies and saves network bandwidth. * help-gnu-emacs-request@prep.ai.mit.edu to subscribe to help-gnu-emacs ** gnUSENET newsgroup: gnu.emacs.help (and one-way into comp.emacs) ** Send contributions to: help-gnu-emacs@prep.ai.mit.edu This list is the place for users and installers of GNU Emacs to ask for help. Please send bug reports to bug-gnu-emacs instead of posting them here. Since help-gnu-emacs is a very large list, send it only those items that are seriously important to many people. If source or patches that were previously posted or a simple fix is requested in help-gnu-emacs, please mail it to the requester. Do NOT repost it. If you also want something that is requested, send mail to the requester asking him to forward it to you. This kind of traffic is best handled by e-mail, not a broadcast medium that reaches thousands of sites. This list is also gated one way to USENET's newsgroup comp.emacs (once known as net.emacs). This one-way gating is done for users whose sites get comp.emacs, but not gnu.emacs.help. Users at non-USENET sites may receive all articles from comp.emacs by making their request to: unix-emacs-request@bbn.com If Emacs crashes, or if you build Emacs following the standard procedure on a system which Emacs is supposed to work on (see etc/MACHINES) and it does not work at all, or if an editing command does not behave as it is documented to behave, this is a bug. Don't send bug reports to help-gnu-emacs (gnu.emacs.help) or post them to comp.emacs; mail them to bug-gnu-emacs@prep.ai.mit.edu instead. See section '* General Information about help-* lists'. * info-gnu-emacs-request@prep.ai.mit.edu to subscribe to info-gnu-emacs ** gnUSENET newsgroup: gnu.emacs.announce (and one-way into comp.emacs) ** Send announcements to: info-gnu-emacs@prep.ai.mit.edu This list distributes announcements and progress reports on GNU Emacs. It is NOT for general discussion; please use help-gnu-emacs for that. The list is filtered to remove items meant for info-gnu-emacs-request, that can be answered by the moderator without bothering the list, or should have been sent to another list. info-gnu-emacs is also gated one way to USENET's newsgroup comp.emacs (once known as net.emacs). This one-way gating is done for users whose sites get comp.emacs, but not gnu.emacs.announce. Users at non-USENET sites may receive all articles from comp.emacs by making their request to: unix-emacs-request@bbn.com Do not report GNU Emacs bugs to info-gnu-emacs or comp.emacs, instead mail them to bug-gnu-emacs@prep.ai.mit.edu. See section '* General Information about info-* lists'. * vms-gnu-emacs-request@prep.ai.mit.edu to subscribe ** gnUSENET newsgroup: gnu.emacs.vms ** Send contributions to: vms-gnu-emacs@prep.ai.mit.edu This list was a working group who did the initial port of GNU Emacs to the VMS operating system. It still discusses problems and solutions to the VMS port and the distribution of it. * bug-bash-request@prep.ai.mit.edu to subscribe to bug-bash ** gnUSENET newsgroup: gnu.bash.bug ** BASH bug reports to: bug-bash@prep.ai.mit.edu This list distributes, to the active maintainers of BASH (the Bourne Again SHell), bug reports and fixes for, and suggestions for improvements in BASH. User discussion of BASH also occurs here. Always report the version number of the operating system, hardware, and bash (flag -version on startup or check the variable $BASH_VERSION in a running bash). There are no other GNU mailing lists or gnUSENET newsgroups for BASH. See section '* General Information about bug-* lists and reporting program bugs'. * bug-gdb-request@prep.ai.mit.edu to subscribe to bug-gdb ** gnUSENET newsgroup: gnu.gdb.bug ** GDB bug reports to: bug-gdb@prep.ai.mit.edu This list distributes, to the active maintainers of GDB (Gnu's DeBugger), bug reports and fixes for, and suggestions for improvements in GDB. There are no other GNU mailing lists or gnUSENET newsgroups for GDB. See section '* General Information about bug-* lists and reporting program bugs'. * bug-octave-request@che.utexas.edu to subscribe to bug-octave ** gnUSENET newsgroup: NONE PLANNED ** Octave bug reports to: bug-octave@che.utexas.edu This list distributes, to the active maintainers of Octave (a system for numerical computations), bug reports and fixes for, and suggestions for improvements to Octave. The help-octave mailing list is for user discussion of Octave. See section '* General Information about bug-* lists and reporting program bugs'. * help-octave-request@che.utexas.edu to subscribe to help-octave ** gnUSENET newsgroup: NONE PLANNED ** Send contributions to: help-octave@che.utexas.edu This list is the place for users and installers of Octave to ask for help. Please send bug reports to bug-octave instead of posting them here. If Octave crashes, or if you build Octave following the standard procedure on a system on which Octave is supposed to work on and it does not work at all, or if a command does not behave as it is documented to behave, this is a bug. Don't send bug reports to help-octave; mail them to bug-octave@che.utexas.edu instead. See section '* General Information about help-* lists'. * bug-gcc-request@prep.ai.mit.edu to subscribe to bug-gcc ** gnUSENET newsgroup: gnu.gcc.bug ** GCC bug reports to: bug-gcc@prep.ai.mit.edu This list distributes bug reports for, fixes for bugs in, and suggestions for improvements in the GNU C Compiler to its active developers. Please don't send in a patch without a test case to illustrate the problem the patch is supposed to fix. Sometimes the patches aren't correct or aren't the best way to do the job, and without a test case there is no way to debug an alternate fix. The most convenient form of test case is a piece of cpp output that can be passed directly to cc1. Preferably written in C, not C++ or Objective C. Subscribers to bug-gcc get all info-gcc messages. See section '* General Information about bug-* lists and reporting program bugs'. * help-gcc-request@prep.ai.mit.edu to subscribe to help-gcc ** gnUSENET newsgroup: gnu.gcc.help ** Send contributions to: help-gcc@prep.ai.mit.edu This list is the place for users and installers of the GNU C Compiler to ask for help. If gcc crashes, or if you build gcc following the standard procedure on a system which gcc is supposed to work on (see config.sub) and it does not work at all, or if an command line option does not behave as it is documented to behave, this is a bug. Don't send bug reports to help-gcc (gnu.gcc.help); mail them to bug-gcc@prep.ai.mit.edu instead. See section '* General Information about help-* lists'. * info-gcc-request@prep.ai.mit.edu to subscribe to info-gcc ** gnUSENET newsgroup: gnu.gcc.announce ** Send announcements to: info-gcc@prep.ai.mit.edu This list distributes announcements and progress reports on the GNU C Compiler. It is NOT for general discussion; please use help-gcc for that. The list is filtered to remove items meant for info-gcc-request, that can be answered by the moderator without bothering the list, or should have been sent to another list. See section '* General Information about info-* lists'. * bug-gnu960-request@ichips.intel.com to subscribe to bug-gnu960 ** gnUSENET newsgroup: NONE PLANNED ** Intel 960 Port bug reports to: bug-gnu960@ichips.intel.com This list distributes bug reports for, fixes for bugs in, and suggestions for improvements in Intel's port of GNU software to the Intel 960 microprocessor. You can also fax to: GNU/960 - 1-503-696-4930. There are no other GNU mailing lists or gnUSENET newsgroups for Intel's port of GNU software to the Intel 960 microprocessor. See section '* General Information about bug-* lists and reporting program bugs'. * bug-glibc-request@prep.ai.mit.edu to subscribe to bug-glibc ** gnUSENET newsgroup: gnu.glibc.bug ** GNU C Library bug reports to: bug-glibc@prep.ai.mit.edu This list distributes, to the active maintainers of glibc (GNU's C library), bug reports and fixes for, and suggestions for improvements in glibc. User discussion of glibc also occurs here. Announcements of new releases of glibc are made on both info-gcc and bug-glibc. There are no other GNU mailing lists or gnUSENET newsgroups for the GNU C Library. See section '* General Information about bug-* lists and reporting program bugs'. * bug-g++-request@prep.ai.mit.edu to subscribe to bug-g++ ** gnUSENET newsgroup: gnu.g++.bug ** G++ bug reports to: bug-g++@prep.ai.mit.edu This list distributes bug reports for, fixes for bugs in, and suggestions for improvements in the GNU C++ Compiler to its active developers. G++ uses the GNU C-Compiler back end. Active developers may wish to subscribe to bug-gcc@prep.ai.mit.edu as well. Subscribers to bug-g++ get all info-g++ messages. See section '* General Information about bug-* lists and reporting program bugs'. * help-g++-request@prep.ai.mit.edu to subscribe to help-g++ ** gnUSENET newsgroup: gnu.g++.help (and one-way into comp.lang.c++) ** Send contributions to: help-g++@prep.ai.mit.edu This list is the place for users and installers of the GNU C++ Compiler to ask for help. Please send bug reports to bug-g++@prep.ai.mit.edu instead of posting them here. help-g++ is also gated one way to USENET's newsgroup comp.lang.c++. This one-way gating is done for users whose sites get comp.lang.c++, but not gnu.g++.help. See section '* General Information about help-* lists'. * info-g++-request@prep.ai.mit.edu to subscribe to info-g++ ** gnUSENET newsgroup: gnu.g++.announce (and one-way into comp.lang.c++) ** Send announcements to: info-g++@prep.ai.mit.edu This list distributes announcements and progress reports on the GNU C++ Compiler. It is NOT for general discussion; please use help-g++ for that. The list is filtered to remove items meant for info-g++-request, that can be answered by the moderator without bothering the list, or should have been sent to another list. It is also gated one way to USENET's newsgroup comp.lang.c++. This one-way gating is done for users whose sites get comp.lang.c++, but not gnu.g++.announce. Do not report g++ bugs to info-g++ or comp.lang.c++, mail them to bug-g++@prep.ai.mit.edu instead. See section '* General Information about info-* lists'. * bug-lib-g++-request@prep.ai.mit.edu to subscribe to bug-lib-g++ ** gnUSENET newsgroup: gnu.g++.lib.bug ** lib-g++ bug reports to: bug-lib-g++@prep.ai.mit.edu This list distributes, to the active maintainers of libg++ (GNU's library for C++), bug reports and fixes for, and suggestions for improvements in lib-g++. User discussion of libg++ also occurs here. Announcements of new releases of libg++ are made on both info-g++ and bug-lib-g++. There are no other GNU mailing lists or gnUSENET newsgroups for the G++ Library. See section '* General Information about bug-* lists and reporting program bugs'. * info-gnu-fortran-request@prep.ai.mit.edu to subscribe to info-gnu-fortran ** gnUSENET newsgroup: NONE YET ** Send announcements to: info-gnu-fortran@prep.ai.mit.edu This list is for progress reports about the GNU Fortran compiler. In the future it will also be used for release notices. The list is filtered to remove items meant for info-gnu-fortran-request, that can be answered by the moderator without bothering the list, or should have been sent to another list. People on the Internet can get a current status report by fingering the address fortran@gnu.ai.mit.edu. See section '* General Information about info-* lists'. There are no other GNU mailing lists or gnUSENET newsgroups for GNU Fortran (yet). * bug-oleo-request@prep.ai.mit.edu to subscribe to bug-oleo ** gnUSENET newsgroup: NONE PLANNED ** Oleo bug reports to: bug-oleo@prep.ai.mit.edu This list distributes, to the active maintainers of Oleo (the GNU spreadsheet), bug reports and fixes for, and suggestions for improvements to Oleo. User discussion of Oleo also occurs here. There are no other GNU mailing lists or gnUSENET newsgroups for Oleo . See section '* General Information about bug-* lists and reporting program bugs'. * bug-gnu-smalltalk-request@prep.ai.mit.edu to subscribe to bug-gnu-smalltalk ** gnUSENET newsgroup: gnu.smalltalk.bug ** GNU Smalltalk bug reports to: bug-gnu-smalltalk@prep.ai.mit.edu GNU Smalltalk is the GNU project implementation of the Smalltalk language. This list distributes, to the active maintainers of GNU Smalltalk, bug reports and fixes for, and suggestions for improvements to GNU Smalltalk. User discussion of GNU Smalltalk also occurs here. For now, new releases of GNU Smalltalk will also be announced on this list. There are no other GNU mailing lists or gnUSENET newsgroups for GNU Smalltalk. See section '* General Information about bug-* lists and reporting program bugs'. * st-next-request@laplace.eng.sun.com to subscribe to st-next ** gnUSENET newsgroup: NONE PLANNED ** Send contributions to: st-next@laplace.eng.sun.com For people interested in working on GNU Smalltalk on the NeXT. * bug-groff-request@prep.ai.mit.edu to subscribe to bug-groff ** gnUSENET newsgroup: gnu.groff.bug ** GNU groff bug reports to: bug-groff@prep.ai.mit.edu groff is the GNU project implementation, in C++, of the traditional Unix document formatting tools. This list distributes, to the active maintainers of groff, bug reports and fixes for, and suggestions for improvements to groff (and it component programs). User discussion of groff also occurs here. For now, new releases of groff will also be announced on this list. There are no other GNU mailing lists or gnUSENET newsgroups for groff. See section '* General Information about bug-* lists and reporting program bugs'. * bug-ghostscript-request@prep.ai.mit.edu to subscribe to bug-ghostscript ** gnUSENET newsgroup: gnu.ghostscript.bug ** Ghostscript bug reports to: bug-ghostscript@prep.ai.mit.edu GhostScript is the GNU project implementation of a language and graphics library with a remarkable similarity to PostScript. This list distributes, to the active maintainers of Ghostscript, bug reports and fixes for, and suggestions for improvements in Ghostscript. For now, new releases of Ghostscript will also be announced on this list. There are no other GNU mailing lists or gnUSENET newsgroups for GhostScript. See section '* General Information about bug-* lists and reporting program bugs'. * bug-gnu-utils-request@prep.ai.mit.edu to subscribe to bug-gnu-utils ** gnUSENET newsgroup: gnu.utils.bug ** GNU Utilities bug reports to: bug-gnu-utils@prep.ai.mit.edu This list distributes, to the active maintainers of these programs, bug reports and fixes for, and suggestions for improvements in GNU programs not covered by other bug-* mailing lists/gnu.*.bug newsgroups. Subscribers to bug-gnu-utils get all info-gnu-utils messages. See section '* General Information about bug-* lists and reporting program bugs'. * help-gnu-utils-request@prep.ai.mit.edu to subscribe to help-gnu-utils ** gnUSENET newsgroup: gnu.utils.help ** Send contributions to: help-gnu-utils@prep.ai.mit.edu This list is the place for users and installers of GNU programs not covered by other GNU mailing lists/gnu.* newsgroups to ask for help. Don't send bug reports to help-gnu-utils (gnu.utils.help); mail them to bug-gnu-utils@prep.ai.mit.edu instead. See section '* General Information about help-* lists'. * info-gnu-utils-request@prep.ai.mit.edu to subscribe to info-gnu-utils ** gnUSENET newsgroup: gnu.utils.announce ** Send announcements to: info-gnu-utils@prep.ai.mit.edu This list distributes announcements and progress reports on GNU programs not covered by other GNU mailing lists/gnu.* newsgroups. It is NOT for general discussion; please use help-gnu-utils for that. The list is filtered to remove items meant for info-gnu-utils-request, that can be answered by the moderator without bothering the list, or should have been sent to another list. See section '* General Information about info-* lists'. * info-cvs-request@prep.ai.mit.edu to subscribe to info-cvs. ** USENET newsgroup: (none) ** CVS discussions/questions to: info-cvs@prep.ai.mit.edu This list is for discussion and dissemination of information about CVS. Please check the FAQ before posting questions, however. * bug-cvs-request@prep.ai.mit.edu to subscribe to bug-cvs. ** USENET newsgroup: (none) ** CVS bug reports to: bug-cvs@prep.ai.mit.edu This list distributes bug reports, fixes, and suggestions for improvements to the maintainers of CVS. It also feeds directly into a GNATS database, so it's best if bug reports are sent in the from of GNATS Problem Reports. * bug-fortran-mode-request@erl.mit.edu to subscribe to bug-fortran-mode ** USENET newsgroup: (none) ** Fortran mode bug reports to: bug-fortran-mode@erl.mit.edu This list collects bug reports, fixes for bugs, and suggestions for improvements in GNU Emacs's Fortran mode (a major mode to support editing Fortran source code). It is the place to report Fortran mode bugs by all users of Fortran mode. Always report the version number Fortran mode reports on startup as well as the version of Emacs. There is no info-fortran-mode list. There are no USENET gateways to bug-fortran-mode at this time. * info-gnus-request@flab.fujitsu.co.jp to subscribe ** gnUSENET newsgroup: NONE YET ** Send contributions to: info-gnus@flab.fujitsu.co.jp The list is intended to exchange useful information about GNUS, such as bug reports, useful hooks, and extensions of GNUS. GNUS is an NNTP-base network news reader for GNU Emacs (which also works with a news spool). English and Japanese are the official languages of the list. GNUS is quite different than gnews. * info-gnus-english-request@cis.ohio-state.edu to subscribe ** gnUSENET newsgroup: gnu.emacs.gnus ** Send contributions to: info-gnus-english@cis.ohio-state.edu The list has the same charter as info-gnus. The difference is that English is the only official language of the list. info-gnus-english/gnu.emacs.gnus is forward to info-gnus, but NOT vice-versa. * info-gnews-request@ics.uci.edu to subscribe to info-gnews ** gnUSENET newsgroup: gnu.emacs.gnews ** Send contributions to: info-gnews@ics.uci.edu This newsgroup is intended to exchange useful information about gnews, such as bug reports, useful hooks, and extensions of gnews. gnews is an NNTP-base network news reader for GNU Emacs (which also works a news spool). It is quite different than GNUS. * gnu-emacs-ada-request@grebyn.com to subscribe to gnu-emacs-ada ** gnUSENET newsgroup: NONE PLANNED ** Gnu Emacs Ada support bug reports to: gnu-emacs-ada@grebyn.com This list distributes bug reports for, fixes for bugs in, and suggestions for improvements in GNU Emacs' editing support of the Ada programming language. There are no other GNU mailing lists or gnUSENET newsgroups for GNU Emacs' editing support of Ada. See section '* General Information about bug-* lists and reporting program bugs'. * bug-vm-request@uunet.uu.net to subscribe to bug-vm ** gnUSENET newsgroup: gnu.emacs.vm.bug ** VM mail reader bug reports to: bug-vm@uunet.uu.net This list discusses bugs in View Mail mode for GNU Emacs, with an emphasis on beta and prerelease versions. Always report the version number of VM you are using, as well as the version of Emacs you're running. If you believe it is significant, report the operating system used and the hardware. Subscribers to bug-vm get all info-vm messages. * info-vm-request@uunet.uu.net to subscribe to info-vm ** gnUSENET newsgroup: gnu.emacs.vm.info ** Send contributions to: info-vm@uunet.uu.net This list discusses the View Mail mode for GNU Emacs, an alternative to rmail mode. * supercite-request@warsaw.nlm.nih.gov to subscribe to supercite ** gnUSENET newsgroup: NONE PLANNED ** Send articles to: supercite@warsaw.nlm.nih.gov *** UUCP: ..!uunet!warsaw.nlm.nih.gov!supercite-request The supercite mailing list covers issues related to the advanced mail/news citation package called Supercite for GNU Emacs. * auc-tex-request@iesd.auc.dk to subscribe ** USENET newsgroup: NONE YET ** Send contributions to: auc-tex@iesd.auc.dk The list is intended to exchange information about AUC TeX, such as bug reports, request for help, and information on current developments. AUC TeX is a much enhanced LaTeX mode for GNU Emacs. The list is unmoderated. * bug-gnu-chess-request@prep.ai.mit.edu to subscribe to bug-gnu-chess ** gnUSENET newsgroup: gnu.chess.bug ** GNU Chess bug reports to: bug-gnu-chess@prep.ai.mit.edu This list directly accesses the GNU Chess developer's group. If you have a *BUG* to report about the program, which can also include a feature enhancement request, please send it to this list. Subscribers to bug-gnu-chess get all info-gnu-chess messages. See section '* General Information about bug-* lists and reporting program bugs'. * help-gnu-chess-request@prep.ai.mit.edu to subscribe to help-gnu-chess ** gnUSENET newsgroup: gnu.chess ** Send contributions to: help-gnu-chess@prep.ai.mit.edu This list is the place for users and installers of GNU Chess to ask for help. This list is also used for games played by people or other entities against the program, and other generalized non-bug, non-enhancement data. Please send bug reports to bug-gnu-chess instead of posting them here. Since help-gnu-chess is a large list, send it only those items that are seriously important to many people. If source or patches that were previously posted or a simple fix is requested in help-gnu-chess, please mail it to the requester. Do NOT repost it. If you also want something that is requested, send mail to the requester asking him to forward it to you. This kind of traffic is best handled by e-mail, not a broadcast medium that reaches thousands of sites. See section '* General Information about help-* lists'. * info-gnu-chess-request@prep.ai.mit.edu to subscribe to info-gnu-chess ** gnUSENET newsgroup: gnu.chess.announce ** Send contributions to: info-gnu-chess@prep.ai.mit.edu This list is used for announcements about GNU Chess and related programs, and small but important patches. The list is filtered to remove items meant for info-gnu-chess-request, that can be answered by the moderator without bothering the list, or should have been sent to another list. See section '* General Information about info-* lists'. * bug-gnu-shogi-request@prep.ai.mit.edu to subscribe to bug-gnu-shogi ** gnUSENET newsgroup: NONE PLANNED ** GNU Shogi bug reports to: bug-gnu-shogi@prep.ai.mit.edu This list directly accesses the GNU Shogi developer's group. If you have a *BUG* to report about the program, which can also include a feature enhancement request, please send it to this list. Subscribers to bug-gnu-shogi get all info-gnu-shogi messages. See section '* General Information about bug-* lists and reporting program bugs'. Shogi is a game something like chess. There are several different types of pieces, a board that is 9 by 9 squares, and the modification that a captured piece can be reintroduced on the board by the capturing player (and used). Due to this last difference from Western chess, a Shogi game never simplifies. * help-gnu-shogi-request@prep.ai.mit.edu to subscribe to help-gnu-shogi ** gnUSENET newsgroup: NONE PLANNED ** Send contributions to: help-gnu-shogi@prep.ai.mit.edu This list is the place for users and installers of GNU Shogi to ask for help. This list is also used for games played by people or other entities against the program, and other generalized non-bug, non-enhancement data. Please send bug reports to bug-gnu-shogi instead of posting them here. Since help-gnu-shogi is a large list, send it only those items that are seriously important to many people. If source or patches that were previously posted or a simple fix is requested in help-gnu-shogi, please mail it to the requester. Do NOT repost it. If you also want something that is requested, send mail to the requester asking him to forward it to you. This kind of traffic is best handled by e-mail, not a broadcast medium that reaches thousands of sites. See section '* General Information about help-* lists'. * info-gnu-shogi-request@prep.ai.mit.edu to subscribe to info-gnu-shogi ** gnUSENET newsgroup: NONE PLANNED ** Send contributions to: info-gnu-shogi@prep.ai.mit.edu This list is used for announcements about GNU Shogi and related programs, and small but important patches. The list is filtered to remove items meant for info-gnu-shogi-request, that can be answered by the moderator without bothering the list, or should have been sent to another list. See section '* General Information about info-* lists'. * gnu-manual-request@a.cs.uiuc.edu IS NOW DEFUNCT ** DEAD: Gnusenet newsgroup: gnu.emacs.lisp.manual ** DEAD address: gnu-manual@a.cs.uiuc.edu *** DEAD UUCP address: ..!uunet!uiucdcs!gnu-manual-request This list and newsgroup is dead. It was a working group whose volunteers wrote, proofread and commented on the developing GNU Emacs Lisp programmers manual. Send bugs in the GNU Emacs Lisp reference manual to: lisp-manual-bugs@prep.ai.mit.edu lisp-manual-bugs is neither a mailing list nor a gnUSENET newsgroup. It's just a bug-reporting address. * no mailing list request ** gnUSENET newsgroup: gnu.gnusenet.config ** no mailing list This newsgroup has nothing to do with GNU software, especially its configuration. It exists to distribute information about the administration and configuration of gnUSENET: the gnu.all alternative USENET hierarchy that carry the GNU mailing lists. Administrators of gnUSENET hosts receiving the gnu.all newsgroups are welcome to ask questions here or via e-mail of gnu@prep.ai.mit.edu. * no mailing list request ** gnUSENET newsgroup: gnu.gnusenet.test ** no mailing list This newsgroup has nothing to do with GNU software, especially its testing. It exists to allow test messages to be made in gnUSENET: the gnu.all alternative USENET hierarchy that carry the GNU mailing lists. Local variables: mode: outline fill-column: 72 End: emacs-19.30/etc/MH-E-NEWS100666 75424 13 13025 6046252433 13031 0ustar kwzhuserUser-visible changes to mh-e in version 5.0 from 4.1. Note: This being a major release, there are many internal changes. This document lists only changes to the external interfaces of mh-e. When upgrading, you must either explicitly reload the new versions of all mh-e files that are already loaded or restart your Emacs. mh-e 5.0.1 contains minor changes from mh-e 5.0 to integrate it with Emacs 19.29. mh-e 5.0.2 contains additional minor changes to integrate it with reporter.el (requires reporter.el version 3.1c or later) and Emacs 19.30. The mh-goto-msg function is much faster, which also speeds up several other operations. Major Changes and New Features in mh-e ====================================== The emphasis for this release has been on consistency and documentation. Many documentation strings were enhanced. Documentation strings were changed to comments for internal functions and variables. There is now proper documentation in the form of a 75-page users manual. The Texinfo source is mh-e.texi; the formatted Info document is mh-e.info. There is a new command `mh-update-sequences', which updates MH's idea of what messages are in the Unseen sequence and what is the current folder and message. `mh-quit' calls it. While `mh-execute-commands' has always done this updating as a side effect, the new function is faster. The MH profile entry "Inbox:" is supported. If the show-buffer is modified, the user is queried before mh-e reuses the buffer to show a different message. This buffer is also auto-saved and backed up correctly. `mh-store-buffer' is significantly more robust. It now handles messages created by a wide variety of packaging software. The status message for `uudecode' includes the name of the file created. An error is signaled if the subprocess exits with a non-zero status. `mh-search-folder' behaves predictably, adding messages found to the `search' sequence. It correctly handles the case of no messages found. `mh-burst-digest' (`M-b') now only rescans the part of the folder affected by the burst. It is now much faster in a large folder. New mh-e Hooks and Customization Variables ========================================== `mh-default-folder-for-message-function': new name for the old `mh-msg-folder-hook', which wasn't a hook. The old name was confusing, leading people to think they could use `add-hook' with it, when actually `setq' is the correct way. `mh-sortm-args': When this variable is used has changed. Now `mh-sortm-args' is passed if there IS a prefix argument to `mh-sort-folder'. The assumption is that for arguments you normally want, you would specify them in an MH profile entry. `mh-mhn-args': new hook, a list of additional arguments to pass to the `mhn' program if `mh-edit-mhn' is given a prefix argument. `mh-edit-mhn-hook': new hook called by `mh-edit-mhn', the function that formats MIME messages. `mh-folder-list-change-hook': new hook, called whenever the cached list of folders, `mh-folder-list', is changed. `mh-find-path-hook': new hook, called when entering mh-e. `mh-repl-formfile': new variable, used to change the format file used by `mh-reply' from the default of "replcomps". New variables to customize the scan format and notating: `mh-note-deleted', `mh-note-refiled', `mh-note-seq', `mh-note-cur', `mh-note-copied', `mh-note-printed'. Key Binding Changes in mh-e =========================== `RET' runs `mh-show' for consistency with the Finder and Info. The old binding `.' still works, but `RET' is now the standard binding. `M-<' now runs `mh-first-msg' for consistency with `M->', which runs `mh-last-msg'. `C-c C-f C-d' in MH-Letter mode moves to a Dcc: header field. `C-c C-f C-r' in MH-Letter mode moves to a From: header field. `g' is now the standard binding for `mh-goto-msg'. The old binding `j' still works. Other Improvements and Changes to mh-e ====================================== `mh-lpr-command-format' no longer passes the "-p" argument to `lpr' by default. The mail header typically has the date anyway. When prompting for a sequence name, if no sequences have been used yet, mh-e will offer the first sequence the current message is in. The patterns of more mailers are recognized by `mh-extract-rejected-mail'. `mh-insert-prefix-string' no longer wraps the call to the `mail-citation-hook' function in a `save-excursion' so the hook writer can choose whether to leave point at the beginning or the end of the yanked text. `mh-write-msg-to-file': The prompt now refers to "message" or "message body" depending on which will be written. (This is controlled by a prefix argument.) The file defaults to the last-used file instead of supplying only the directory name. mh-e uses message ranges when running MH commands. Thus "rmm 1 2 3 4 6" is now "rmm 1-4 6". This change makes it less likely to overflow system argument list limits, and it might be faster, too. Bug Fixes to mh-e ================= mh-e's idea of the unseen sequence now stays in sync with MH's better. Functions that are supposed to find fields in the message header no longer look in the message body. mh-e would sometimes fail to remove the "%" from a scan line when the message was removed from a sequence if the message was also in the Previous sequence. The variable `mh-inc-prog' is now correctly used in all places. `mh-pipe-msg' runs the process in the correct directory. A partially scanned folder will no longer lose the "/select" annotation when you execute marked deletes and refiles with `x'. emacs-19.30/etc/MH-E-ONEWS100666 12120 13 15745 5541251373 12762 0ustar rmsuserThis file is automatically generated from news-mh-e.txinfo. Do not edit. User-visible changes to mh-e in version 4.0 from 3.8 Note: there are many internal changes to mh-e in this release. If you have the previous version loaded into your Emacs, you will probably not be able to load this version on top of it. New Features in mh-e ==================== Background folder collection. The first time you are prompted for a folder, you must wait while mh-e collects the names of all existing folders. Now however, if you abort, collecting will continue in the background, and you can do something else in Emacs until the collection completes. Normally, mh-e will begin collecting folders names in the background when you first load it; you can disable this feature by setting `mh-auto-folder-collect' to nil. There is support for composing MIME messages using the `mhn' program from MH 6.8. See the documentation string for mh-edit-mhn. (While composing a letter, type `C-h k C-c C-e'.) See also mhn(1). There is as yet no support for reading MIME messages. `mh-show', typically on `.', repositions to the start of the message if the message is already visible. It used to do nothing in this case. The function `mh-unshar-msg' is renamed `mh-store-msg'. It now does uudecoding, too. Someday it should do MIME. It remembers the last directory you used and offers it as the default for next time. New function `mh-header-display', on `,', displays the message with all headers, including those normally not displayed. Type `.' to display the message normally again. New function `mh-list-sequences' lists the sequences in use in the current folder. New function `mh-version' displays version information about MH and mh-e. Please use the output in bug reports. `mh-quit' now burys the folder buffer and show buffer. New mh-e hooks and customization variables ========================================== `mh-pick-mode-hook': new hook called by new mode `mh-pick-mode'. The pick buffer didn't used to have its own mode. Another advantage of `mh-pick-mode' is that `C-h m' works in the pick buffer. `mail-citation-hook': new variable for supercite. `mh-refile-msg-hook': new hook called by `mh-refile-msg' (and `mh-refile-or-write-again' when refiling). `mh-msg-folder-hook': new hook used by `mh-refile-msg' and `mh-to-fcc' to provide a default folder for user prompt. `mh-show-hook': new hook called by `mh-show'. `mh-delete-msg-hook': new hook called by `mh-delete-msg'. `mh-show-mode-hook': new hook called by new mode `mh-show-mode' for `show-' buffers. `mh-comp-formfile': new variable so can customize `components' file. `mh-sortm-args': new variable, a list of extra arguments to be passed to sortm by `mh-sort-folder'. Give an argument to `mh-sort-folder' to suppress this behavior. `mh-send-prog': new variable so can customize name of `send' program in case of name conflicts. `mh-scan-prog': new variable so can customize name of `scan' program to generate custom effects. `mh-inc-prog': new variable so can customize name of `inc' program to do fancy management of incoming messages. `mh-forwarded-letter-subject': new function used by `mh-forward' to compute the Subject line of the new message. It is a small function which can be replaced by the user for customization. Uses the new variable `mh-forward-subject-format', which allows some simple customizations without rewriting even `mh-forwarded-letter-subject'. `mh-new-draft-cleaned-headers': new variable, header lines removed by `mh-edit-again' and `mh-extract-rejected-mail' before offering a message as a new draft. `mh-signature-file-name': new variable used by `mh-insert-signature' to so can customize name of the file to insert. `mh-read-address': new function called to read all To: and Cc: addresses. `mh-msg-folder-hook': new hook used by `mh-refile-msg' and `mh-to-fcc' to provide a default folder for user prompt. Key binding changes in mh-e =========================== `,' runs new function `mh-header-display'. It is like `.' but it displays *all* the headers. `M-#' runs the new function `mh-delete-seq'. One used to have to type `C-u M-%' to delete a sequence. `<' no longer does `mh-first-msg', but `M->' now does `mh-last-msg'. This allows first and last to be consistent (`>' was taken) and is more likely to be discovered by chance anyway. `M-d' runs `mh-redistribute', `r' runs `mh-reply' (on the theory that the more commonly used function should be easier to type, and the obscure action of redistributing can be harder to type). `M-o' changed to `C-o' (`mh-write-msg-to-file'). It was interfering with arrow keys for some people. `M-n' now runs `mh-store-msg' (formerly `mh-unshar-msg'). `b' no longer runs `mh-quit'; use `q' instead. `b' may be used in a future version for something else. Minor improvements to mh-e ========================== The mh-e code is now divided into multiple Emacs Lisp files, so it starts up faster because Emacs doesn't have to load all of it at once. (This change also makes it easier for the maintainer to manage things.) When searching for the directory containing the MH programs, search the user's PATH in addition to the built-in directories, to increase the chance of finding the MH programs. The subject for a forwarded message no longer has ugly square brackets around it. The name of the folder is no longer appears twice in the show buffer mode line. When typing a folder name in the minibuffer, parent folders complete to the trailing slash (/), for easier typing of subfolders. The folder buffer mode name changed from `mh-e scan' or `mh-e show' to `MH-Folder', which makes the hook name easier to guess. Added `mh-showing' to `minor-mode-alist' so there is still an indication in the mode line of whether messages will be shown automatically. `mh-rename-seq' does completion on the old sequence name. If called by a user who has never used MH on this system before, mh-e runs the MH program `install-mh' to get them set up. Undo history for previous messages is not kept to avoid wasting memory. The internal temp buffer used by mh-e has `buffer-offer-save' explicitly nil. This change benefits people who change the `buffer-offer-save' default. Bug fixes to mh-e ================= `mh-to-field': don't bomb if no To: field. `mh-get-new-mail': restore annotations, e.g., cur, even if no new mail. `mh-rename-seq': verify that the new seq name was accepted by `mark' before updating state. `mh-internal-seq': the Previous sequence is not notated, since it would notate everything scanned. `mh-read-draft': don't call `find-file-noselect' so an `auto-mode-alist' doesn't trigger `mh-letter-mode-hook' twice. Faster, too. `mh-show': If user moves onto a message that doesn't exist, don't leave the cursor in the show pane. `mh-delete-scan-msgs': use `equal', not `=', on the result of `mh-get-msg-num', since it may be nil. `mh-get-field': do anchored search so searching for `reply-to:' doesn't find `in-reply-to:'. `mh-widen': do nothing if not narrowed. `mh-clean-message-header': find end of headers even if no body. emacs-19.30/etc/MORE.STUFF100666 74777 13 3141 5354756550 13031 0ustar esruserMore Neat Stuff for your Emacs -*-Outline-*- This file describes GNU Emacs programs and resources that are maintained by other people. Some of these may become part of the Emacs distribution in the future. * The LCD archive There is a large collection of Emacs Lisp code available for FTP at archive.cis.ohio-state.edu; it is actively maintained by Dave Brennan and Dave Sill . To get started using this archive, do: ftp archive.cis.ohio-state.edu Once you're in FTP, do cd pub/gnu/emacs/elisp-archive bin get lispdir.el.Z get LCD-datafile.Z and exit. Then do: compress -d *.Z The lispdir.el package will help you search for useful packages in the LCD-datafile, which is a list of the archive constants. It will even fetch them for you on command. * Eric Ludlam's etalk system Eric Ludlam has written a C program and Emacs Lisp code to do Internet talk through an Emacs window. The package also includes Emacs Lisp code which assists you in using talk to play a number of different interactive games. This system seems to be quite nicely put together and is well documented with a texinfo file that you can integrate into Emacs's own on-line help. It's too large and specialized to include in the Emacs distribution, though. Sources of this system are available for FTP at nic.umass.edu 128.119.166.14 Look under pub/contrib. As of March 23 1993, there are two relevant files: pub/contrib/etalk0.6B.tar.Z --- sources of the talk system pub/contrib/egames0.6B.tar.Z --- more game-support files We don't know whether this can use the additional features in GNU talk. emacs-19.30/etc/MOTIVATION100666 13437 1 21127 4071350006 13447 0ustar jimbdaemonSTUDIES FIND REWARD OFTEN NO MOTIVATOR Creativity and intrinsic interest diminish if task is done for gain By Alfie Kohn Special to the Boston Globe [reprinted with permission of the author from the Monday 19 January 1987 Boston Globe] In the laboratory, rats get Rice Krispies. In the classroom the top students get A's, and in the factory or office the best workers get raises. It's an article of faith for most of us that rewards promote better performance. But a growing body of research suggests that this law is not nearly as ironclad as was once thought. Psychologists have been finding that rewards can lower performance levels, especially when the performance involves creativity. A related series of studies shows that intrinsic interest in a task - the sense that something is worth doing for its own sake - typically declines when someone is rewarded for doing it. If a reward - money, awards, praise, or winning a contest - comes to be seen as the reason one is engaging in an activity, that activity will be viewed as less enjoyable in its own right. With the exception of some behaviorists who doubt the very existence of intrinsic motivation, these conclusions are now widely accepted among psychologists. Taken together, they suggest we may unwittingly be squelching interest and discouraging innovation among workers, students and artists. The recognition that rewards can have counter-productive effects is based on a variety of studies, which have come up with such findings as these: Young children who are rewarded for drawing are less likely to draw on their own that are children who draw just for the fun of it. Teenagers offered rewards for playing word games enjoy the games less and do not do as well as those who play with no rewards. Employees who are praised for meeting a manager's expectations suffer a drop in motivation. Much of the research on creativity and motivation has been performed by Theresa Amabile, associate professor of psychology at Brandeis University. In a paper published early last year on her most recent study, she reported on experiments involving elementary school and college students. Both groups were asked to make "silly" collages. The young children were also asked to invent stories. The least-creative projects, as rated by several teachers, were done by those students who had contracted for rewards. "It may be that commissioned work will, in general, be less creative than work that is done out of pure interest," Amabile said. In 1985, Amabile asked 72 creative writers at Brandeis and at Boston University to write poetry. Some students then were given a list of extrinsic (external) reasons for writing, such as impressing teachers, making money and getting into graduate school, and were asked to think about their own writing with respect to these reasons. Others were given a list of intrinsic reasons: the enjoyment of playing with words, satisfaction from self-expression, and so forth. A third group was not given any list. All were then asked to do more writing. The results were clear. Students given the extrinsic reasons not only wrote less creatively than the others, as judged by 12 independent poets, but the quality of their work dropped significantly. Rewards, Amabile says, have this destructive effect primarily with creative tasks, including higher-level problem-solving. "The more complex the activity, the more it's hurt by extrinsic reward," she said. But other research shows that artists are by no means the only ones affected. In one study, girls in the fifth and sixth grades tutored younger children much less effectively if they were promised free movie tickets for teaching well. The study, by James Gabarino, now president of Chicago's Erikson Institute for Advanced Studies in Child Development, showed that tutors working for the reward took longer to communicate ideas, got frustrated more easily, and did a poorer job in the end than those who were not rewarded. Such findings call into question the widespread belief that money is an effective and even necessary way to motivate people. They also challenge the behaviorist assumption that any activity is more likely to occur if it is rewarded. Amabile says her research "definitely refutes the notion that creativity can be operantly conditioned." But Kenneth McGraw, associate professor of psychology at the University of Mississippi, cautions that this does not mean behaviorism itself has been invalidated. "The basic principles of reinforcement and rewards certainly work, but in a restricted context" - restricted, that is, to tasks that are not especially interesting. Researchers offer several explanations for their surprising findings about rewards and performance. First, rewards encourage people to focus narrowly on a task, to do it as quickly as possible and to take few risks. "If they feel that 'this is something I hve to get through to get the prize,' the're going to be less creative," Amabile said. Second, people come to see themselves as being controlled by the reward. They feel less autonomous, and this may interfere with performance. "To the extent one's experience of being self-determined is limited," said Richard Ryan, associate psychology professor at the University of Rochester, "one's creativity will be reduced as well." Finally, extrinsic rewards can erode intrinsic interest. People who see themselves as working for money, approval or competitive success find their tasks less pleasurable, and therefore do not do them as well. The last explanation reflects 15 years of work by Ryan's mentor at the University of Rochester, Edward Deci. In 1971, Deci showed that "money may work to buy off one's intrinsic motivation for an activity" on a long-term basis. Ten years later, Deci and his colleagues demonstrated that trying to best others has the same effect. Students who competed to solve a puzzle quickly were less likely than those who were not competing to keep working at it once the experiment was over. Control plays role There is general agreement, however, that not all rewards have the same effect. Offering a flat fee for participating in an experiment - similar to an hourly wage in the workplace - usually does not reduce intrinsic motivation. It is only when the rewards are based on performing a given task or doing a good job at it - analogous to piece-rate payment and bonuses, respectively - that the problem develops. The key, then, lies in how a reward is experienced. If we come to view ourselves as working to get something, we will no longer find that activity worth doing in its own right. There is an old joke that nicely illustrates the principle. An elderly man, harassed by the taunts of neighborhood children, finally devises a scheme. He offered to pay each child a dollar if they would all return Tuesday and yell their insults again. They did so eagerly and received the money, but he told them he could only pay 25 cents on Wednesday. When they returned, insulted him again and collected their quarters, he informed them that Thursday's rate would be just a penny. "Forget it," they said - and never taunted him again. Means to and end In a 1982 study, Stanford psychologist Mark L. Lepper showed that any task, no matter how enjoyable it once seemed, would be devalued if it were presented as a means rather than an end. He told a group of preschoolers they could not engage in one activity they liked until they first took part in another. Although they had enjoyed both activities equally, the children came to dislike the task that was a prerequisite for the other. It should not be surprising that when verbal feedback is experienced as controlling, the effect on motivation can be similar to that of payment. In a study of corporate employees, Ryan found that those who were told, "Good, you're doing as you /should/" were "significantly less intrinsically motivated than those who received feedback informationally." There's a difference, Ryan says, between saying, "I'm giving you this reward because I recognize the value of your work" and "You're getting this reward because you've lived up to my standards." A different but related set of problems exists in the case of creativity. Artists must make a living, of course, but Amabile emphasizes that "the negative impact on creativity of working for rewards can be minimized" by playing down the significance of these rewards and trying not to use them in a controlling way. Creative work, the research suggests, cannot be forced, but only allowed to happen. /Alfie Kohn, a Cambridge, MA writer, is the author of "No Contest: The Case Against Competition," recently published by Houghton Mifflin Co., Boston, MA. ISBN 0-395-39387-6. / emacs-19.30/etc/Makefile100444 75424 13 1452 5747531737 13277 0ustar kwzhuserDESTDIR= LIBDIR=/usr/local/lib BINDIR=/usr/local/bin MANDIR=/usr/man/man1 MANEXT=1 all: mostlyclean: -rm -f core clean distclean maintainer-clean: -rm -f DOC* core SOURCES = [0-9A-QS-Z]* README *.[ch16] emacs.* etags.* ledit.l ms-* \ news.texi rc2log refcard.tex spook-lines termcap.* ulimit.hack \ vcdiff vipcard.tex xmouse.doc unlock: chmod u+w $(SOURCES) relock: chmod u-w $(SOURCES) # ${etcdir}/e/eterm is used by ../lisp/term.el. # TERMINFO systems use terminfo files compiled by the Terminfo Compiler (tic). # These files are binary, and depend on the version of tic, but they seem # to be system-independent and backwardly compatible. # So there should be no need to recompile the distributed binary version. TIC=tic e/eterm: e/eterm.ti TERMINFO=`pwd`; export TERMINFO; $(TIC) e/eterm.ti emacs-19.30/etc/NEWS100666 12120 13 731573 6055530371 12202 0ustar rmsuserGNU Emacs NEWS -- history of user-visible changes. 24 Nov 1995 Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. See the end for copying conditions. Please send Emacs bug reports to bug-gnu-emacs@prep.ai.mit.edu. For older news, see the file ONEWS. * Editing Changes in Emacs 19.30. ** Be sure to recompile your byte-compiled Emacs Lisp files if you last compiled them with Emacs 19.28 or earlier. You can use M-x byte-force-recompile to recompile all the .elc files in a specified directory. ** Emacs now provides multiple-frame support on Windows NT and Windows 95. ** M-x column-number-mode toggles a minor mode which displays the current column number in the mode line. ** Line Number mode is now enabled by default. ** M-x what-line now displays the line number in the accessible portion of the buffer as well as the line number in the full buffer, when narrowing is in effect. ** If you type a M-x command that has an equivalent key binding, the equivalent is shown in the minibuffer before the command executes. This feature is enabled by default for the sake of beginning users. You can turn the feature off by setting suggest-key-bindings to nil. ** The menu bar is now visible on text-only terminals. To choose a command from the menu bar when you have no mouse, type M-` (Meta-Backquote) or F10. ** Whenever you invoke a minibuffer, it appears in the minibuffer window that the current frame uses. Emacs can only use one minibuffer window at a time. If you activate the minibuffer while a minibuffer window is active in some other frame, the outer minibuffer window disappears while the inner one is active. ** Echo area messages always appear in the minibuffer window that the current frame uses. If a minibuffer is active in some other frame, the echo area message does not hide it even temporarily. ** The minibuffer now has a menu-bar menu. You can use it to exit or abort the minibuffer, or to ask for completion. ** Dead-key and composite character processing is done in the standard X11R6 manner (through the default "input method" using the /usr/lib/X11/locale/*/Compose databases of key combinations). I.e. if it works in xterm, it should also work in emacs now. ** Mouse changes *** You can now use the mouse when running Emacs in an xterm. Use M-x xterm-mouse-mode to let emacs take control over the mouse. *** C-mouse-1 now once again provides a menu of buffers to select. S-mouse-1 is now the way to select a default font for the frame. *** There is a new mouse-scroll-min-lines variable to control the minimum number of lines scrolled by dragging the mouse outside a window's edge. *** Dragging mouse-1 on a vertical line that separates windows now moves the line, thus changing the widths of the two windows. (This feature is available only if you don't have vertical scroll bars. If you do use them, a scroll bar separates two side-by-side windows.) *** Double-click mouse-1 on a character with "symbol" syntax (such as underscore, in C mode) selects the entire symbol surrounding that character. (Double-click mouse-1 on a letter selects a whole word.) ** When incremental search wraps around to the beginning (or end) of the buffer, if you keep on searching until you go past the original starting point of the search, the echo area changes from "Wrapped" to "Overwrapped". That tells you that you are revisiting matches that you have already seen. ** Filling changes. *** If the variable colon-double-space is non-nil, the explicit fill commands put two spaces after a colon. *** Auto-Fill mode now supports Adaptive Fill mode just as the explicit fill commands do. The variable adaptive-fill-regexp specifies a regular expression to match text at the beginning of a line that should be the fill prefix. *** Adaptive Fill mode can take a fill prefix from the first line of a paragraph, *provided* that line is not a paragraph-starter line. Paragraph-starter lines are indented lines that start a new paragraph because they are indented. This indentation shouldn't be copied to additional lines. Whether indented lines are paragraph lines depends on the value of the variable paragraph-start. Some major modes set this; you can set it by hand or in mode hooks as well. For editing text in which paragraph first lines are not indented, and which contains paragraphs in which all lines are indented, you should use Indented Text mode or arrange for paragraph-start not to match these lines. *** You can specify more complex ways of choosing a fill prefix automatically by setting `adaptive-fill-function'. This function is called with point after the left margin of a line, and it should return the appropriate fill prefix based on that line. If it returns nil, that means it sees no fill prefix in that line. ** Gnus changes. Gnus, the Emacs newsreader, has been rewritten and expanded. Most things that worked with the old version should still work with the new version. Code that relies heavily on Gnus internals is likely to fail, though. *** Incompatabilities with the old GNUS. **** All interactive commands have kept their names, but many internal functions have changed names. **** The summary mode gnus-uu commands have been moved from the `C-c C-v' keymap to the `X' keymap. **** There can now be several summary buffers active at once. Variables that are relevant to each summary buffer are buffer-local to that buffer. **** Old hilit code doesn't work at all. Gnus performs its own highlighting based not only on what's visible in the buffer, but on other data structures. **** Old packages like `expire-kill' will no longer work. **** `C-c C-l' in the group buffer no longer switches to a different buffer, but instead lists killed groups in the group buffer. *** New features. **** The look of all buffers can be changed by setting format-like variables. **** Local spool and several NNTP servers can be used at once. **** Groups can be combined into virtual groups. **** Different mail formats can be read much the same way as one would read newsgroups. All the mail backends implement mail expiry schemes. **** Gnus can use various strategies for gathering threads that have lost their roots (thereby gathering loose sub-threads into one thread) or it can go back and retrieve enough headers to build a complete thread. **** Killed groups can be read. **** Gnus can do partial group updates - you do not have to retrieve the entire active file just to check for new articles in a few groups. **** Gnus implements a sliding scale of subscribedness to groups. **** You can score articles according to any number of criteria. You can get Gnus to score articles for you using adaptive scoring. **** Gnus maintains a dribble buffer that is auto-saved the normal Emacs manner, so it should be difficult to lose much data on what you have read if your machine should go down. **** Gnus now has its own startup file (`.gnus.el') to avoid cluttering up the `.emacs' file. **** You can set the process mark on both groups and articles and perform operations on all the marked items. **** You can grep through a subset of groups and create a group from the results. **** You can list subsets of groups using matches on group names or group descriptions. **** You can browse foreign servers and subscribe to groups from those servers. **** Gnus can pre-fetch articles asynchronously on a second connection to the servers. **** You can cache articles locally. **** Gnus can fetch FAQs to and descriptions of groups. **** Digests (and other files) can be used as the basis for groups. **** Articles can be highlighted and customized. ** Changes to Version Control (VC) *** General changes (all backends). VC directory listings (C-x v d) are now kept up to date when you do a vc-next-action (C-x v v) on the marked files. The `g' command updates the buffer properly. `=' in a VC dired buffer produces a version control diff, not an ordinary diff. *** CVS changes. Under CVS, you no longer need to type C-x C-q before you can edit a file. VC doesn't write-protect unmodified buffers anymore; you can freely change them at any time. The mode line keeps track of the file status. If you do want unmodified files to be write-protected, set your CVSREAD environment variable. VC sees this and behaves accordingly; that will give you the behaviour of Emacs 19.29, similar to that under RCS and SCCS. In this mode, if the variable vc-mistrust-permissions is nil, VC learns the modification state from the file permissions. When setting CVSREAD for the first time, you should check out the whole module anew, so that the file permissions are set correctly. VC also works with remote repositories now. When you visit a file, it doesn't run "cvs status" anymore, so there shouldn't be any long delays. Directory listings under VC/CVS have been enhanced. Type C-x v d, and you get a list of all files in or below the current directory that are not up-to-date. The actual status (modified, merge, conflict, ...) is displayed for each file. If you give a prefix argument (C-u C-x v d), up-to-date files are also listed. You can mark any number of files, and execute the next logical version control command on them (C-x v v). *** Starting a new branch. If you try to lock a version that is not the latest on its branch, VC asks for confirmation in the minibuffer. If you say no, it offers to lock the latest version instead. *** RCS non-strict locking. VC can now handle RCS non-strict locking, too. In this mode, working files are always writable and you needn't lock the file before making changes, similar to the default mode under CVS. To enable non-strict locking for a file, use the "rcs -U" command. *** Sharing RCS master files. If you share RCS subdirs with other users (through symbolic links), and you always want to work on the latest version, set vc-consult-headers to nil and vc-mistrust-permissions to `t'. Then you see the state of the *latest* version on the mode line, not that of your working file. When you do a check out, VC overwrites your working file with the latest version from the master. *** RCS customization. There is a new variable vc-consult-headers. If it is t (the default), VC searches for RCS headers in working files (like `$Id$') and determines the state of the file from them, not from the master file. This is fast and more reliable when you use branches. (The variable was already present in Emacs 19.29, but didn't get mentioned in the NEWS.) ** Calendar changes. *** New calendars supported: Chinese, Coptic, Ethiopic Here are the commands for converting to and from these calendars: gC: calendar-goto-chinese-date gk: calendar-goto-coptic-date ge: calendar-goto-ethiopic-date pC: calendar-print-chinese-date pk: calendar-print-coptic-date pe: calendar-print-ethiopic-date *** Printed calendars Calendar mode now has commands to produce fancy printed calendars via LaTeX. You can ask for a calendar for one or more days, weeks, months or years. The commands all start with `t'; see the manual for a list of them. *** New sexp diary entry type Reminders that apply in the days leading up to an event. ** The CC-mode package now provides the default C and C++ modes. See the manual for documentation of its features. ** The uniquify package chooses buffer names differently when you visit multiple files with the same name (in different directories). ** RMAIL now always uses the movemail program when it renames an inbox file, so that it can interlock properly with the mailer no matter where it is delivering mail. ** tex-start-of-header and tex-end-of-header are now regular expressions, not strings. ** To enable automatic uncompression of compressed files, type M-x auto-compression-mode. (This command used to be called toggle-auto-compression, but was not documented before.) In Lisp, you can do (auto-compression-mode 1) to turn the mode on. ** The new pc-select package emulates the key bindings for cutting and pasting, and selection of regions, found in Windows, Motif, and the Macintosh. ** Help buffers now use a special major mode, Help mode. This mode normally turns on View mode; it also provides a hook, help-mode-hook, which you can use for other customization. ** Apropos now uses faces for enhanced legibility. It now describes symbol properties as well as their function definitions and variable values. You can use Mouse-2 or RET to get more information about a function definition, variable, or property. ** Font Lock mode *** Supports Scheme, TCL and Help modes For example, to automatically turn on Font Lock mode in the *Help* buffer, put: (add-hook 'help-mode-hook 'turn-on-font-lock) in your ~/.emacs. *** Enhanced fontification The structure of font-lock-keywords is extended to allow "anchored" keywords. Typically, a keyword item of font-lock-keywords comprises a regexp to search for and information to specify how the regexp should be highlighted. However, the highlighting information is extended so that it can be another keyword item. This keyword item, its regexp and highlighting information, is processed before resuming with the keyword item of which it is part. For example, a typical keyword item might be: ("\\" (0 anchor-face)) which fontifies each occurrence of the discrete word "anchor" in the value of the variable anchor-face. However, the highlighting information can be used to fontify text that is anchored to the word "anchor". For example: ("\\" (0 anchor-face) ("\\=[ ,]*\\(item\\)" nil nil (1 item-face))) which fontifies each occurrence of "anchor" as above, but for each occurrence of "anchor", each occurrence of "item", in any following comma separated list, is fontified in the value of the variable item-face. Thus the "item" text is anchored to the "anchor" text. See the variable documentation for further information. This feature is used to extend the level and quality of fontification in a number of modes. For example, C/C++ modes now have level 3 decoration that includes the fontification of variable and function names in declaration lists. In this instance, the "anchor" described in the above example is a type or class name, and an "item" is a variable or function name. *** Fontification levels The variables font-lock-maximum-decoration and font-lock-maximum-size are extended to specify levels and sizes for specific modes. The variable font-lock-maximum-decoration specifies the preferred level of fontification for modes that provide multiple levels (typically from "subdued" to "gaudy"). The variable font-lock-maximum-size specifies the buffer size for which buffer fontification is suppressed when Font Lock mode is turned on (typically because it would take too long). These variables can now specify values for individual modes, by supplying lists of mode names and values. For example, to use the above mentioned level 3 decoration for buffers in C/C++ modes, and default decoration otherwise, put: (setq font-lock-maximum-decoration '((c-mode . 3) (c++-mode . 3))) in your ~/.emacs. Maximum buffer size values for individual modes are specified in the same way with the variable font-lock-maximum-size. *** Font Lock configuration The mechanism to provide default settings for Font Lock mode are the variables font-lock-defaults and font-lock-maximum-decoration. Typically, you should only need to change the value of font-lock-maximum-decoration. However, to support Font Lock mode for buffers in modes that currently do not support Font Lock mode, you should set a buffer local value of font-lock-defaults for that mode, typically via its mode hook. These variables are used by Font Lock mode to set the values of the variables font-lock-keywords, font-lock-keywords-only, font-lock-syntax-table, font-lock-beginning-of-syntax-function and font-lock-keywords-case-fold-search. You need not set these variables directly, and should not set them yourself since the underlining mechanism may change in future. ** Archive mode is now the default mode for various sorts of archive files (files whose names end with .arc, .lzh, .zip, and .zoo). ** You can automatically update the years in copyright notice by means of (add-hook 'write-file-hooks 'copyright-update). Optionally it can update the GPL version as well. ** Scripts of various languages (Shell, AWK, Perl, makefiles ...) can be automatically provided with a magic number and be made executable by their respective modes under control of various user variables. The mode must call (executable-set-magic "perl") or (executable-set-magic "make" "-f"). The latter for example has no effect on [Mm]akefile. ** Shell script mode now supports over 15 different shells. The new command C-c ! executes the region, and optionally beginning of script as well, by passing them to the shell. Cases such as `sh' being a `bash' are now accounted for. Fontification now also does variables, the magic number and all builtin commands. Shell script mode no longer mingles `tab-width' and indentation style. The variable `sh-tab-width' has been renamed to `sh-indentation'. Empty lines are now indented like previous non-empty line, rather than just previous line. The annoying $ variable prompting has been eliminated. Instead, shell script mode uses `comint-dynamic-completion' for commands, variables and filenames. ** Two-column mode now automatically scrolls both buffers together, which makes it possible to eliminate the special scrolling commands that used to do so. The commands that operate in two-column mode are no longer bound to keys outside that mode. f2 o will now position at the same point in associated buffer. the new command f2 RET inserts a newline in both buffers, at point and at the corresponding position in the associated buffer. ** Skeleton commands now work smoothly as abbrev definitions. The element < no longer exists, ' is a new element. ** The autoinsert insert facility for prefilling empty files as soon as they are found has been extended to accomodate skeletons or calling functions. See the function auto-insert. ** TPU-edt Changes Loading tpu-edt no longer turns on tpu-edt mode. In fact, it is no longer necessary to explicitly load tpu-edt. All you need to do to turn on tpu-edt is run the tpu-edt function. Here's how to run tpu-edt instead of loading the file: Running Emacs: Type emacs -f tpu-edt not emacs -l tpu-edt Within Emacs: Type M-x tpu-edt not M-x load-library tpu-edt In .emacs: Use (tpu-edt) not (load "tpu-edt") The default name of the tpu-edt X key definition file has changed from ~/.tpu-gnu-keys to ~/.tpu-keys. If you don't rename the file yourself, tpu-edt will offer to rename it the first time you invoke it under x-windows. ** MS-DOS Enhancements: *** Better mouse control by adding the following functions [in dosfns.c] msdos-mouse-enable, msdos-mouse-disable, msdos-mouse-init. *** If another foreground/background color than the default is setup in your ~/_emacs, then the screen briefly flickers with the default colors before changing to the colors you have specified. To avoid this, the EMACSCOLORS environment variable exists. It shall be defined as a string with the following elements: set EMACSCOLORS=fb;fb The first set of "fb" defines the initial foreground and background colors using standard dos color numbers (0=black,.., 7=white). If specified, the second set of "fb" defines the colors which are restored when you leave emacs. *** The new SUSPEND environment variable can now be set as the shell to use when suspending emacs. This can be used to override the stupid limitation on the environment of sub-shells in MS-DOS (they are just large enough to hold the currently defined variables, not leaving room for more); to overcome this limitation, add this to autoexec.bat: set SUSPEND=%COMSPEC% /E:2000 ** The escape character can now be displayed (as a tiny left arrow) on X window frames. Try this: (aset standard-display-table 27 (vector 27)) after first creating a display table. ** The new command-line option --eval specifies an expression to evaluate from the command line. ** etags has now the ability to tag Perl files. They are recognised either by the .pm and .pl suffixes or by a first line which starts with `#!' and specifies a Perl interpreter. The tagged lines are those beginning with the `sub' keyword. New suffixes recognised are .hpp for C++; .f90 for Fortran; .bib, .ltx, .TeX for TeX (.bbl, .dtx removed); .ml for Lisp; .prolog for prolog (.pl is now Perl). ** The files etc/termcap.dat and etc/termcap.ucb have been replaced with a new, merged, and much more comprehensive termcap file. The new file should include all the special entries from the old one. This new file is under active development as part of the ncurses project. If you have any questions about this file, or problems with an entry in it, email terminfo@ccil.org. * Lisp changes in Emacs 19.30. ** New Data Types *** There is a new data type called a char-table which is an array indexed by a character. Currently this is mostly equivalent to a vector of length 256, but in the future, when a wider character set is in use, it will be different. To create one, call (make-char-table SUBTYPE INITIAL-VALUE) SUBTYPE is a symbol that identifies the specific use of this character table. It can be any of these values: syntax-table display-table keyboard-translate-table case-table The function `char-table-subtype' returns the subtype of a char-table. You cannot alter the subtype of an existing char-table. A char-table has an element for each character code. It also has some "extra slots". The number of extra slots depends on the subtype and their use depends on the subtype. (Each subtype symbol has a `char-table-extra-slots' property that says how many extra slots to make.) Use (char-table-extra-slot TABLE N) to access extra slot N and (set-char-table-extra-slot TABLE N VALUE) to store VALUE in slot N. A char-table T can have a parent, which should be another char-table P. If you look for the value in T for character C, and the table T actually holds nil, P's element for character C is used instead. The functions `char-table-parent' and `set-char-table-parent' let you read or set the parent of a char-table. To scan all the values in a char-table, do not try to loop through all possible character codes. That would work for now, but will not work in the future. Instead, call map-char-table. (map-char-table FUNCTION TABLE) calls FUNCTION once for each character or character set that has a distinct value in TABLE. FUNCTION gets two arguments, RANGE and VALUE. RANGE specifies a range of TABLE that has one uniform value, and VALUE is the value in TABLE for that range. Currently, RANGE is always a vector containing a single character and it refers to that character alone. In the future, other kinds of ranges will occur. You can set the value for a given range with (set-char-table-range TABLE RANGE VALUE) and examine the value for a range with (char-table-range TABLE RANGE). *** Syntax tables are now represented as char-tables. All syntax tables other than the standard syntax table normally have the standard syntax table as their parent. Their subtype is `syntax-table'. *** Display tables are now represented as char-tables. Their subtype is `display-table'. *** Case tables are now represented as char-tables. Their subtype is `case-table'. *** The value of keyboard-translate-table may now be a char-table instead of a string. Normally the char-tables used for this purpose have the subtype `keyboard-translate-table', but that is not required. *** A new data type called a bool-vector is a vector of values that are either t or nil. To create one, do (make-bool-vector LENGTH INITIAL-VALUE) ** You can now specify, for each marker, how it should relocate when text is inserted at the place where the marker points. This is called the "insertion type" of the marker. To set the insertion type, do (set-marker-insertion-type MARKER TYPE). If TYPE is t, it means the marker advances when text is inserted. If TYPE is nil, it means the marker does not advance. (In Emacs 19.29, markers did not advance.) The function marker-insertion-type reports the insertion type of a given marker. The function copy-marker takes a second argument TYPE which specifies the insertion type of the new copied marker. ** When you create an overlay, you can specify the insertion type of the beginning and of the end. To do this, you can use two new arguments to make-overlay: front-advance and rear-advance. ** The new function overlays-in returns a list of the overlays that overlap a specified range of the buffer. The returned list includes empty overlays at the beginning of this range, as well as within the range. ** The new hook window-scroll-functions is run when a window has been scrolled. The functions in this list are called just before redisplay, after the new window-start has been computed. Each function is called with two arguments--the window that has been scrolled, and its new window-start position. This hook is useful for on-the-fly fontification and other features that affect how the redisplayed text will look when it is displayed. The window-end value of the window is not valid when these functions are called. The computation of window-end is byproduct of actual redisplay of the window contents, which means it has not yet happened when the hook is run. Computing window-end specially in advance for the sake of these functions would cause a slowdown. The hook functions can determine where the text on the window will end by calling vertical-motion starting with the window-start position. ** The new hook redisplay-end-trigger-functions is run whenever redisplay in window uses text that extends past a specified end trigger position. You set the end trigger position with the function set-window-redisplay-end-trigger. The functions are called with two arguments: the window, and the end trigger position. Storing nil for the end trigger position turns off the feature, and the trigger value is automatically reset to nil just after the hook is run. You can use the function window-redisplay-end-trigger to read a window's current end trigger value. ** The new function insert-file-contents-literally inserts the contents of a file without any character set translation or decoding. ** The new function safe-length computes the length of a list. It never gets an error--it treats any non-list like nil. If given a circular list, it returns an upper bound for the number of elements before the circularity. ** replace-match now takes a fifth argument, SUBEXP. If SUBEXP is non-nil, that says to replace just subexpression number SUBEXP of the regexp that was matched, not the entire match. For example, after matching `foo \(ba*r\)' calling replace-match with 1 as SUBEXP means to replace just the text that matched `\(ba*r\)'. ** The new keymap special-event-map defines bindings for certain events that should be handled at a very low level--as soon as they are read. The read-event function processes these events itself, and never returns them. Events that are handled in this way do not echo, they are never grouped into key sequences, and they never appear in the value of last-command-event or (this-command-keys). They do not discard a numeric argument, they cannot be unread with unread-command-events, they may not appear in a keyboard macro, and they are not recorded in a keyboard macro while you are defining one. These events do, however, appear in last-input-event immediately after they are read, and this is the way for the event's definition to find the actual event. The events types iconify-frame, make-frame-visible and delete-frame are normally handled in this way. ** encode-time now supports simple date arithmetic by means of out-of-range values for its SEC, MINUTE, HOUR, DAY, and MONTH arguments; for example, day 0 means the day preceding the given month. Also, the ZONE argument can now be a TZ-style string. ** command-execute and call-interactively now accept an optional third argument KEYS. If specified and non-nil, this specifies the key sequence containing the events that were used to invoke the command. ** The environment variable NAME, if set, now specifies the value of (user-full-name), when Emacs starts up. * User Editing Changes in Emacs 19.29 ** If you run out of memory. If you get the error message "Virtual memory exhausted", type C-x s. That way of saving files has the least additional memory needs. Emacs 19.29 keeps a reserve of memory which it makes available when this error happens; that is to ensure that C-x s can complete its work. Once you have saved your data, you can exit and restart Emacs, or use M-x kill-some-buffers to free up space. If you kill buffers containing a substantial amount of text, you can go on editing. Do not use M-x buffer-menu to save or kill buffers when you are out of memory, because that needs a fair amount memory itself and you may not have enough to get it started. ** The format of compiled files has changed incompatibly. Byte-compiled files made with Emacs 19.29 normally use a new format that will not work in older Emacs versions. You can compile files in the old format if you wish; see "Changes in compilation," below. ** Emacs 19.29 supports the DEC Alpha. ** Emacs runs on Windows NT. This port does not yet support windowing features. It works like a text-only terminal, but it does support a mouse. In general, support for non-GNU-like operating systems is not a high priority for the GNU project. We merged in the support for Windows NT because that system is expected to be very widely used. ** Emacs supports Motif widgets. You can build Emacs with Motif widgets by specifying --with-x-toolkit=motif when you run configure. Motif defines collections of windows called "tab groups", and uses the tab key and the cursor keys to move between windows in a tab group. Emacs naturally does not support this--it has other uses for the tab key and cursor keys. Emacs does not support Motif accelerators either, because it uses its normal keymap event binding features. We give higher priority to operation with a free widget set than to operation with a proprietary one. ** If Emacs or the computer crashes, you can recover all the files you were editing from their auto save files by typing M-x recover-session. This first shows you a list of recorded interrupted sessions. Move point to the one you choose, and type C-c C-c. Then recover-session asks about each of the files that were being edited during that session, asking whether to recover that file. If you answer y, it calls recover-file, which works in its normal fashion. It shows the dates of the original file and its auto-save file and asks once again whether to recover that file. When recover-session is done, the files you've chosen to recover are present in Emacs buffers. You should then save them. Only this--saving them--updates the files themselves. ** Menu bar menus now stay up if you click on the menu bar item and release the mouse button within a certain amount of time. This is in the X Toolkit version. ** The menu bar menus have been rearranged and split up to make for a better organization. Two new menu bar menus, Tools and Search, contain items that were formerly in the Files and Edit menus, as well as some that did not exist in the menu bar menus before. ** Emacs can now display on more than one X display at the same time. Use the command make-frame-on-display to create a frame, specifying which display to use. ** M-x talk-connect sets up a multi-user talk connection via Emacs. Specify the X display of the person you want to talk to. You can talk to any number of people (within reason) by using this command repeatedly to specify different people. Emacs does not make a fuss about security; the people who you talk to can use all Emacs features, including visiting and editing files. If this frightens you, don't use M-x talk-connect. ** The range of integer values is now at least 2**28 on all machines. This means the maximum size of a buffer is at least 2**27-1, or 134,217,727. ** When you start Emacs, you can now specify option names in long GNU form (starting with `--') and you can abbreviate the names. You can now specify the options in any order. The previous requirements about the order of options have been eliminated. The -L or --directory option lets you specify an additional directory to search for Lisp libraries (including libraries that you specify with the -l or --load options). ** Incremental search in Transient Mark mode, if the mark is already active, now leaves the mark active and does not change its position. You can make incremental search deactivate the mark once again with this expression. (add-hook 'isearch-mode-hook 'deactivate-mark) ** C-delete now deletes a word backwards. This is for compatibility with some editors in the PC world. (This key is not available on ordinary ASCII terminals, because C-delete is not a distinct character on those terminals.) ** ESC ESC ESC is now a command to escape from various temporary modes and states. ** M-x pc-bindings-mode sets up bindings compatible with many PC editors. In particular, Delete and its variants delete forward instead of backward. Use Backspace to delete backward. C-Backspace kills backward a word (as C-Delete normally would). M-Backspace does undo. Home and End move to beginning and end of line C-Home and C-End move to beginning and end of buffer. ** The key sequence for evaluating a Lisp expression using the minibuffer is now ESC :. It used to be ESC ESC, but we moved it to make way for the ESC ESC ESC feature, on the grounds that people who evaluate Lisp expressions are experienced users and can cope with a change. If you prefer the old ESC ESC binding, put in your `~/.emacs': (global-set-key "\e\e" 'eval-expression) ** The f1 function key is now equivalent to the help key. This is done with key-translation-map; delete the binding for f1 in that map if you want to use f1 for something else. ** Mouse-3, in the simplest case, still sets the region. But now, it places the mark where point was, and sets point where you click. (It used to set the mark where you click and leave point alone.) If you position point with Mouse-1, then scroll with the scroll bar and use Mouse-3, Mouse-3 uses the position you specified with Mouse-1 even if it has scrolled off the screen (and point is no longer there). This makes it easier to select a region with the mouse which is bigger than a screenfull. Any editing of the buffer, and any cursor motion or scrolling for any reason other than the scroll bar, cancels the special state set up by Mouse-1--so that a subsequent Mouse-3 click will use the actual value of point. ** C-mouse-3 now pops up a mode-specific menu of commands--normally the same ones available in the mode's own menu bar menus. ** C-mouse-2 now pops up a menu of faces, indentation, justification, and certain other text properties. This menu is also available through the menu-bar Edit menu. It is meant for use with Enriched mode. *** You can use this menu to change the face of the region. You can also set the face of the region with the new M-g command. *** The menu also includes commands for indenting the region, which locally changes the values of left-margin and fill-column that are used. *** All fill functions now indent every line to the left-margin. If there is also a fill-prefix, that goes after the margin indentation. *** Open-line and newline also make sure that the lines they create are indented to the left margin. *** It also allows you to set the "justification" of the region: whether it should be centered, flush right, and so forth. The fill functions (including auto-fill-mode) will maintain the justification and indentation that you request. *** The new function `list-colors-display' shows you what colors are available. This is also accessible from the C-mouse-2 menu. ** You can now save and load files including their faces and other text-properties by using Enriched-mode. Files are saved in an extended version of the MIME text/enriched format. You can use the menus described above, or M-g and other keyboard commands, to alter the formatting information. ** C-mouse-1 now pops up the menu for changing the frame's default font. ** You can input Hyper, Super, Meta, and Alt characters, as well as non-ASCII control characters, on an ASCII-only terminal. To do this, use C-x @ h -- hyper C-x @ s -- super C-x @ m -- meta C-x @ a -- alt C-x @ S -- shift C-x @ c -- control These are not ordinary key sequences; they operate through function-key-map, which means they can be used even in the middle of an ordinary key sequence. ** Outline minor mode and Hideif mode now use C-c @ as their prefix character. ** Echo area messages are now logged in the "*Messages*" buffer. The size of this buffer is limited to message-log-max lines. ** RET in various special modes for read-only buffers that contain lists of items now selects the item point is on. These modes include Dired, Compilation buffers, Buffer-menu, Tar mode, and Occur mode. (In Info, RET follows the reference near point; in completion list buffers, RET chooses the completion around point.) ** set-background-color now updates the modeline face in a special way. If that face was previously set up to be reverse video, the reverse of the default face, then set-background-color updates it so that it remains the reverse of the default face. ** The functions raise-frame and lower-frame are now commands. When used interactively, they apply to the selected frame. ** M-x buffer-menu now displays the buffer list in the selected window. Use M-x buffer-menu-other-window to display it in another window. ** M-w followed by a kill command now *does not* append the text in the kill ring. In consequence, M-w followed by C-w works as you would expect: it leaves the top of the kill ring matching the region that you killed. ** In Lisp mode, the C-M-x command now executes defvar forms in a special way: it unconditionally sets the variable to the specified default value, if there is one. Normal execution of defvar does not alter the variable if it already has a non-void value. ** In completion list buffers, the left and right arrow keys run the new commands previous-completion and next-completion. They move one completion at a time. ** While doing completion in the minibuffer, the `prior' or `pageup' key switches to the completion list window. ** When you exit the minibuffer with empty contents, the empty string is not put in the minibuffer history. ** The default buffer for insert-buffer is now the "first" buffer other than the current one. If you have more than one window, this is a buffer visible in another window. (Usually it is the buffer that C-M-v would scroll.) ** The etags program is now capable of recording tags based on regular expressions provided on the command line. This new feature allows easy support for constructs not normally handled by etags, such as the macros frequently used in big C/C++ projects to define project-specific structures. It also enables the use of etags and TAGS files for languages not supported by etags. The Emacs manual section on Tags contains explanations and examples for Emacs's DEFVAR, VHDL, Cobol, Postscript and TCL. ** Various mode-specific commands that used to be bound to C-c LETTER have been moved. *** In gnus-uu mode, gnus-uu-interactive-scan-directory is now on C-c C-d, and gnus-uu-interactive-save-current-file is on C-c C-z. *** In Scribe mode, scribe-insert-environment is now on C-c C-v, scribe-chapter is on C-c C-c, scribe-subsection is on C-c C-s, scribe-section is on C-c C-t, scribe-bracket-region-be is on C-c C-e, scribe-italicize-word is on C-c C-i, scribe-bold-word is on C-c C-b, and scribe-underline-word is on C-c C-u. *** In Gomoku mode, gomoku-human-takes-back is now on C-c C-b, gomoku-human-plays is on C-c C-p, gomoku-human-resigns is on C-c C-r, and gomoku-emacs-plays is on C-c C-e. *** In the Outline mode defined in allout.el, outline-rebullet-current-heading is now on C-c *. ** M-s in Info now searches through the nodes of the Info file, just like s. The alias M-s was added so that you can use the same command for searches in both Info and Rmail. ** iso-acc.el now lets you enter inverted-! and inverted-? with the sequences ~! and ~?. ** M-x compare-windows now pushes mark in both windows before it starts moving point. ** There are two new commands in Dired, A (dired-do-search) and Q (dired-do-query-replace). These are similar to tags-search and tags-query-replace, but instead of searching the list of files that appears in a tags table, they search all the files marked in Dired. ** Changes to dabbrev. A new function, `dabbrev-completion' (bound to M-C-/), expands the unique part of an abbreviation. Dabbrev now looks for expansions in other buffers, looks for symbols instead of words and it works in the minibuffer. Dabbrev can be customized to work for shell scripts, with variables that sometimes have and sometimes haven't a leading "$". See the variable 'dabbrev-abbrev-skip-leading-regexp'. ** In Rmail, the command rmail-input-menu has been eliminated. The feature of selecting an Rmail file from a menu is now implemented in another way. ** Bookmarks changes. *** It now works to set bookmarks in Info nodes. *** Bookmarks can have annotations; type "C-h m" after doing "M-x list-bookmarks", for more information on annotations. *** The bookmark-jump popup menu function is now `bookmark-menu-jump', for those who bind it to a mouse click. *** The default bookmarks file name is now "~/.emacs.bmk". If you already have a bookmarks file, it will be renamed automagically when you next load it. ** New package, ps-print. The ps-print package generates PostScript printouts of buffers or regions, and includes face attributes such as color, underlining, boldface and italics in the printed output. ** New package, msb. The msb package provides a buffer-menu in the menubar with separate menus for different types of buffers. ** `cpp.el' is a new library that can highlight or hide parts of a C file according to C preprocessor conditionals. To try it, run the command M-x cpp-highlight-buffer. ** Changes in CC mode. *** c-set-offset and related functions and variables can now accept variable symbols. Also ++ and -- which mean 2* positive and negative c-basic-offset respectively. *** New variable, c-recognize-knr-p, which controls whether K&R C contructs will be recognized. Trying to recognize K&R constructs is a time hog so if you're programming strictly in ANSI C, set this variable to nil (it should already be nil in c++-mode). *** New variable, c-hanging-comment-ender-p for controlling c-fill-paragraph's behavior. *** New syntactic symbol: statement-case-open. This is assigned to lines containing an open brace just after a case/default label. *** New variable, c-progress-interval, which controls minibuffer update message displays during long re-indention. This is a new feature which prints percentage complete messages at specified intervals. ** Makefile mode changes. *** The electric keys are not enabled by default. *** There is now a mode-specific menu bar menu. *** The mode supports font-lock, add-log, and imenu. *** The command M-TAB does completion of target names and variable names. ** icomplete.el now works more like a minor mode. Use M-x icomplete-mode to turn it on and off. Icomplete now supports an `icomplete-minibuffer-setup-hook', which is run on minibuffer setup whenever icompletion will be occurring. This hook can be used to customize interoperation of icomplete with other minibuffer-specific packages, eg rsz-mini. See the doc string for more info. ** Ediff change. Use ediff-revision instead of vc-ediff. It also replaces rcs-ediff, for those who use that; if you want to use a version control package other than vc.el, you must set the variable ediff-version-control-package to specify which package. ** VC now supports branches with RCS. You can use C-u C-x C-q to select any branch or version by number. It reads the version number or branch number with the minibuffer, then checks out the file unlocked. Type C-x C-q again to lock the selected branch or version. When you check in changes to that branch or version, there are two possibilities: -- If you've selected a branch, or a version at the tip of a branch, then the new version adds to that branch. If you wish to create a new branch, use C-u C-x C-q to specify a version number when you check in the new version. -- If you've selected an inner version which is not the latest in its branch, then the new version automatically creates a new branch. ** VC now supports CVS as well as RCS and SCCS. Since there are no locks in CVS, some things behave slightly different when the backend is CVS. When vc-next-action is invoked in a directory handled by CVS, it does the following: If the file is not already registered, this registers it for version control. This does a "cvs add", but no "cvs commit". If the file is added but not committed, it is committed. If the file has not been changed, neither in your working area or in the repository, a message is printed and nothing is done. If your working file is changed, but the repository file is unchanged, this pops up a buffer for entry of a log message; when you finish the log message with C-c C-c, that checks in the resulting changes along with the log message as change commentary. A writable file remains in existence. If vc-next-action changes the repository file, it asks you whether to merge in the changes into your working copy. vc-directory, when started in a CVS file hierarchy, reports all files that are modified (and thus need to be committed). (When the backend is RCS or SCCS vc-directory reports all locked files). VC has no support for running the initial "cvs checkout" to get a working copy of a module. You can only use VC in a working copy of a module. You can disable the CVS support as follows: (setq vc-master-templates (delq 'vc-find-cvs-master vc-master-templates)) or by setting vc-handle-cvs to nil. This may be desirable if you run a non-standard version of CVS, or if CVS was compiled with FORCE_USE_EDITOR or (possibly) RELATIVE_REPOS. ** Comint and shell mode changes: *** Completion works with file names containing quoted characters. File names containing special characters (such as " ", "!", etc.) that are quoted with a "\" character are recognised during completion. Special characters are quoted when they are inserted during completion. *** You can use M-x comint-truncate-buffer to truncate the buffer. When this command is run, the buffer is truncated to a maximum number of lines, specified by the variable comint-buffer-maximum-size. Just like the command comint-strip-ctrl-m, this can be run automatically during process output by doing this: (add-hook 'comint-output-filter-functions 'comint-truncate-buffer) ** Telnet mode buffer name changed. The buffer name for a Telnet buffer is now *telnet-HOST*, not *HOST-telnet*. This is for consistency with other Emacs packages. ** M-x man (man) is now faster and more robust. On systems where the entire man page is indented, the indentation is removed. The user option names that used to end in -p now end in -flag. The new names are: Man-reuse-okay-flag, Man-downcase-section-letters-flag, Man-circular-pages-flag. The Man-notify user option has been renamed to Man-notify-method and accepts one more value, `pushy', that just switches the current buffer to the manpage buffer, without switching frames nor changing your windows configuration. A new user option Man-fontify-manpage-flag disables fontification (thus speeding up man) when set to nil. Default is to fontify if a window system is used. Two new user options Man-overstrike-face (default 'bold) and Man-underline-face (default 'underline) can be set to the preferred faces to be used for the words that man overstrikes and underlines. Useful for those who like coloured man pages. Two new interactive functions are provided: Man-cleanup-manpage and Man-fontify-manpage. Both can be used on a buffer that contains the output of a `rsh host man manpage' command, or the output of an `nroff -man -Tman manpage' command to make them readable. Man-cleanup-manpage is faster, but does not fontify. ** The new function modify-face makes it easy to specify all the attributes of a face, all at once. ** Faces now support background stippling. Use the command set-face-stipple to specify the stipple-pattern for a face. Use face-stipple to access the specified stipple pattern. The existing face functions now handle the stipple pattern when appropriate. If you specify one of the standard gray colors as a face background color, and your display doesn't handle gray, Emacs automatically uses stipple instead to get the same effect. ** Changes in Font Lock mode. *** Fontification Two new default faces are provided; `font-lock-variable-name-face' and `font-lock-reference-face'. The face `font-lock-doc-string-face' has been removed since it is the same as the existing `font-lock-string-face'. Where appropriate, fontification automatically uses these new faces. Fontification via commands `font-lock-mode' and `font-lock-fontify-buffer' is now cleanly interruptible (i.e., with C-g). If you interrupt during the fontification process, the buffer remains in its previous modified state and all highlighting is removed from the buffer. For C/C++ modes, Font Lock mode is much faster but highlights much more. Other modes are faster/more extensive/more discriminatory, or a combination of these. To enable Font Lock mode, add the new function `turn-on-font-lock' in one of the following ways: (add-hook 'c-mode-hook 'turn-on-font-lock) Or for any visited file with: (add-hook 'find-file-hooks 'turn-on-font-lock) *** Supports color and grayscale displays Font Lock mode supports different ways of highlighting, depending on the type of display and background shade. Attributes (face color, bold, italic and underline, and display type and background mode) can be controlled either from Emacs Lisp or X resources. See the new variables `font-lock-display-type' and `font-lock-face-attributes'. *** Supports more modes The following modes are directly supported: ada-mode, asm-mode, bibtex-mode, c++-c-mode, c++-mode, c-mode, change-log-mode, compilation-mode, dired-mode, emacs-lisp-mode, fortran-mode, latex-mode, lisp-mode, mail-mode, makefile-mode, outline-mode, pascal-mode, perl-mode, plain-tex-mode, rmail-mode, rmail-summary-mode, scheme-mode, shell-mode, slitex-mode, tex-mode, texinfo-mode. See the new variables `font-lock-defaults-alist' and `font-lock-defaults'. Some modes support different levels of fontification. You can choose to use the minimum or maximum available decoration by changing the value of the new variable `font-lock-maximum-decoration'. Programmers are urged to make available to the community their own keywords for modes not yet supported. See font-lock.el for information about efficiency. *** fast-lock The fast-lock package speeds up Font Lock mode by saving font choices in associated cache files. When you visit a file with Font Lock mode and Fast Lock mode turned on for the first time, the file's buffer is fontified as normal. When certain events occur (such as exiting Emacs), Fast Lock saves the highlighting in a cache file. When you subsequently visit this file, its cache is used to restore the highlighting. To use this package, put in your `~/.emacs': (add-hook 'font-lock-mode-hook 'turn-on-fast-lock) To control the use of caches, see the documentation for `fast-lock-mode'. ** You can tell pop-to-buffer to display certain buffers in the selected window rather than finding some other window to display them in. There are two variables you can use to specify these buffers. same-window-buffer-names holds a list of buffer names; if a buffer's name appears in this list, pop-to-buffer puts it in the selected window. same-window-regexps holds a list of regexps--if any one of them matches a buffer's name, then pop-to-buffer puts that buffer in the selected window. The default values of these variables are not nil: they list various buffers that normally appear, when you as for them, in the selected window. These include shell buffers, mail buffers, telnet buffers, and others. By removing elements from these variables, you can ask Emacs to display those buffers in separate windows. ** The special-display-buffer-names and special-display-regexps lists have been generalized. An element may now be a list. The car of the list is the buffer name or regular expression for matching buffer names. The cdr of the list can be an alist specifying additional frame parameters for use in constructing the special display frame. Alternatively, the cdr can have this form: (FUNCTION ARGS...) where FUNCTION is a symbol. Then the frame is constructed by calling FUNCTION; its first argument is the buffer, and its remaining arguments are ARGS. ** If the environment variable REPLYTO is set, its value is the default for mail-default-reply-to. ** When you send a message in Emacs, if you specify an Rmail file with the FCC: header field, Emacs converts the message to Rmail format before writing it. Thus, the file never contains anything but Rmail format messages. ** The new variable mail-from-style controls whether the From: header should include the sender's full name, and if so, which format to use. ** The new variable mail-personal-alias-file specifies the name of the user's personal aliases. This defaults to the file ~/.mailrc. mailabbrev.el used to have its own variable for this purpose (mail-abbrev-mailrc-file). That variable is no longer used. ** In Buffer-Menu mode, the d and C-d commands (which mark buffers for deletion) now accept a prefix argument which serves as a repeat count. ** Changes in BibTeX mode. *** Reference keys can now be entered with TAB completion. All reference keys defined in that buffer and all labels that appear in crossreference entries are object to completion. *** Braces are supported as field delimiters in addition to quotes. BibTeX entries may have brace-delimited and quote-delimited fields intermixed. The delimiters generated for new entries are specified by the variables bibtex-field-left-delimiter and bibtex-field-right-delimiter on a buffer-local basis. Those variables default to braces, since it is easier to put quote accented characters (as the german umlauts) into a brace-delimited entry. *** The function bibtex-clean-entry can now be invoked with a prefix argument. In this case, a label is automatically generated from various fields in the record. If bibtex-clean-entry is invoked on a record without label, a label is also generated automatically. Various variables (all beginning with `bibtex-autokey-') control the creation of that key. The variable bibtex-autokey-edit-before-use determines, if the user is allowed to edit auto-generated reference keys before they are used. *** A New function bibtex-complete-string completes strings with respect to the strings defined in this buffer and a set of predefined strings (initialized to the string macros defined in the standard BibTeX style files) in the same way in which ispell-complete-word works with respect to words in a dictionary. Candidates for bibtex-complete-string are initialized from variable bibtex-predefined-strings and by parsing the files found in bibtex-string-files for @String definitions. *** Every reference/field pair has now attached a comment which appears in the echo area when this field is edited. These comments should provide useful hints for BibTeX usage, especially for BibTeX beginners. New variable bibtex-help-message determines if these help messages are to appear in the minibuffer when moving to a text entry. *** Inscriptions of menu bar changed from "Entry Types" to "Entry-Types" and "Bibtex Edit" to "BibTeX-Edit". *** The variable bibtex-include-OPTcrossref is now not longer a binary switch but a list of reference names which should contain a crossref field. E.g., you can tell bibtex-mode you want a crossref field for @InProceedings and @InBook entries but for no other. *** The function validate-bibtex-buffer was completely rewritten to validate if a buffer is syntactically correct. find-bibtex-duplicates is no longer a function itself but was moved into validate-bibtex-buffer. *** Cleaning a BibTeX entry tests, if necessary fields are there. E.g., if you tell bibtex-mode to include a crossref entry, some fields are optional which would be required without the crossref entry. If you now leave the crossref entry empty and do a bibtex-clean-entry with some now required fields left empty, version 2.0 of bibtex.el complains about the absence of these fields, whereas version 1.3 didn't. *** Default value for variables bibtex-maintain-sorted-entries and bibtex-sort-ignore-string-entries is now t. *** All interactive functions are renamed to begin with `bibtex-'. *** Keybindings with \C-c\C-e entry changed for unification. Often used reference types are now on control-modified keys, mediocre used types are on unmodified keys, seldom used types are on shift-modified keys and almost never used types on meta-modified keys. * Configuration Changes in Emacs 19.29 ** Emacs now uses directory /usr/local/share for most of its installed files. This follows a GNU convention for directory usage. ** The option --with-x11 is no longer supported. X11 is the only version of X that Emacs 19.29 supports; use --with-x if you need to request X support explicitly. (Normally this should not be necessary, since configure should automatically enable X support if X is installed on your machine.) ** If you use the site-init.el file to set the variable mail-host-address to a string in the dumped Emacs, that string becomes the default host address for initializing user-mail-address. It is used instead of the value of (system-name). Lisp-Level Changes in Emacs 19.29 * Basic Lisp ** The range of integer values is now at least 2**28 on all machines. This means the maximum size of a buffer is at least 2**27-1, or 134,217,727. ** You can now use Common Lisp syntax for the backquote and comma macros. Thus, you can now write `(x ,y z) instead of (` (x (, y) z)). The old syntax is still accepted. ** The new function rassoc is like assoc, except that it compares the key against the cdr of each alist element, where assoc would compare it against the car of each alist element. ** The new function unintern deletes a symbol from an obarray. The first argument can be the symbol to delete, or a string giving its name. The second argument specifies the obarray (nil means the current default obarray). If the specified symbol is not in the obarray, or if there's no symbol in the obarray matching the specified string, unintern does nothing and returns nil. If it does delete a symbol, it returns t. ** You can specify an alternative read function for use by load and eval-region by binding the variable load-read-function to some other function. This function should accept one argument just like read. If load-read-function is nil, load and eval-region use ordinary read. ** The new function `type-of' takes any object as argument, and returns a symbol identifying the type of that object--one of `symbol', `integer', `float', `string', `cons', `vector', `marker', `overlay', `window', `buffer', `subr', `compiled-function', `window-configuration', `process'. ** When you use eval-after-load for a file that is already loaded, it executes the FORM right away. As before, if the file is not yet loaded, it arranges to execute FORM if and when the file is loaded later. The result is: if you have called eval-after-load for a file, and if that file has been loaded, then regardless of the order of these two events, the specified form has been evaluated. ** The Lisp construct #@NUMBER now skips the next NUMBER characters, treating them as a comment. You would not want to use this in a file you edit by hand, but it is useful for commenting out parts of machine-generated files. ** Two new functions, `plist-get' and `plist-put', allow you to modify and retrieve values from lists formatted as property-lists. They work like `get' and `put', but operate on any list. `plist-put' returns the modified property-list; you must store it back where you got it. ** The new function add-to-list is called with two elements, a variable that holds a list and a new element. It adds the element to the list unless it is already present. It compares elements using `equal'. Here is an example: (setq foo '(a b)) => (a b) (add-to-list 'foo 'c) => (c a b) (add-to-list 'foo 'b) => (c a b) foo => (c a b) * Changes in compilation. Functions and variables loaded from a byte-compiled file now refer to the file for their doc strings. This has a few consequences: -- Loading the file is faster and uses less memory. -- Reference to doc strings is a little slower (the same speed as reference to the doc strings of primitive and preloaded functions). -- The compiled files will not work in old versions of Emacs. -- If you move the compiled file after loading it, Emacs can no longer find these doc strings. -- If you alter the compiled file (such as by compiling a new version), then further access to documentation strings will get nonsense results. The byte compiler now optionally supports lazy loading of compiled functions' definitions. If you enable this feature when you compile, loading the compiled file does not actually bring the function definitions into core. Instead it creates references to the compiled file, and brings each function's definition into core the first time you call that function, or when you force it with the new function `fetch-bytecode'. Using the lazy loading feature has a few consequences: -- Loading the file is faster and uses less memory. -- Calling any function in the file for the first time is slower. -- If you move the compiled file after loading it, Emacs can no longer find the function definitions. -- If you alter the compiled file (such as by compiling a new version), then further access to functions not already loaded will get nonsense results. To enable the lazy loading feature, set up a non-nil file local variable binding for the variable `byte-compile-dynamic' in the Lisp source file. For example, put this on the first line: -*-byte-compile-dynamic: t;-*- It's a good idea to use the lazy loading feature for a file that contains many functions, most of which are not actually used by a given user in a given session. To turn off the basic feature of referring to the file for doc strings, set byte-compile-dynamic-docstrings to nil. You can do this globally, or for one source file by adding this to the first line: -*-byte-compile-dynamic-docstrings: nil;-*- * Strings ** Do not pass integer arguments to `concat' (or `vconcat' or `append'). We are phasing out the old unrecommended support for integers as arguments to these functions, in preparation for treating numbers as single characters in a future release. To concatenate numbers in string form, use `number-to-string' first, or rewrite the call to use `format' instead of `concat'. ** The new function match-string returns the string of text matched at the given parenthesized expression by the last regexp search, or nil if there was no match. If the last match was by `string-match' on a string, the string must be given. Therefore, this function can be used in place of `buffer-substring' and `substring', when using `match-beginning' and `match-end' to find match positions. (match-string N) or (match-string N STRING) ** The function replace-match now accepts an optional fourth argument, STRING. Use this after performing string-match on STRING, to replace the portion of STRING that was matched. When used in this way, replace-match returns a newly created string which is the same as STRING except for the matched portion. ** The new function buffer-substring-no-properties is like buffer-substring except that the string it returns has no text properties. ** The function `equal' now considers two strings to be different if they don't have the same text properties. * Completion ** all-completions now takes an optional fourth argument. If that argument is non-nil, completions that start with a space are ignored unless the initial string also starts with a space. (This used to happen unconditionally.) * Local Variables ** Local hook variables. There is now a clean way to give a hook variable a buffer-local value. Call the function `make-local-hook' to do this. Once a hook variable is buffer-local, you can add hooks to it either globally or locally. run-hooks runs the local hook functions of the current buffer, then all the global hook functions. The functions add-hook and remove-hook take an additional optional argument LOCAL which says whether to add (or remove) a local hook function or a global one. Local hooks use t as an element of the (local) value of the hook variable as a flag meaning to use the global value also. ** The new function local-variable-p tells you whether a particular variable is buffer-local in the current buffer or a specified buffer. * Editing Facilities ** The function copy-region-as-kill no longer sets this-command; as a result, a following kill command will not normally append to the text saved by copy-region-as-kill. ** Regular expression searching and matching no longer performs full Posix backtracking by default. They now stop with the first match found instead of looking for the longest match--just as they did in Emacs 18. The reason for this change is to get higher speed. There are new functions you can use if you really want to search or match with Posix behavior: posix-search-forward, posix-search-backward, posix-looking-at, and posix-string-match. Call these just like re-search-forward, re-search-backward, looking-at, and string-match. * Files ** The new variable `format-alist' defines file formats, which are ways of translating between the data in a file and things (text, text-properties, and possibly other information) in a buffer. `format-alist' has one element for each format. Each element is a list like this: (NAME DOC-STRING REGEXP FROM-FN TO-FN MODIFY MODE-FN) containing the name of the format, a documentation string, a regular expression which is used to recognize files in that format, a decoding function, an encoding function, a flag that indicates whether the encoding function modifies the buffer, and a mode function. FROM-FN is called to decode files in that format; it gets two args, BEGIN and END, and can make any modifications it likes, returning the new end position. It must make sure that the beginning of the file no longer matches REGEXP, or else it will get called again. TO-FN is called to encode a region into that format; it is also passed BEGIN and END, and either returns a list of annotations as in `write-region-annotate-functions', or modifies the region and returns the new end position. MODIFY, if non-nil, means the TO-FN modifies the region. If nil, TO-FN may not make any changes and should return a list of annotations. `insert-file-contents' checks the beginning of the file that it is inserting to see if it matches one of the regexps. If so, then it calls the decoding function, and then looks for another match. When visiting a file, it also calls the mode function, and sets the variable `buffer-file-format' to the list of formats that the file used. `write-region' calls the encoding functions for each format in `buffer-file-format' before it writes the file. To save a file in a different format, either set `buffer-file-format' to a different value, or call the new function `format-write-file'. Since some encoding functions may be slow, you can request that auto-save use a format different from the buffer's default by setting the variable `auto-save-file-format' to the desired format. This will determine the format of all auto-save files. ** The new function file-ownership-preserved-p tells you whether deleting a file and recreating it would keep the file's owner unchanged. ** The new function file-regular-p returns t if a file is a "regular" file (not a directory, symlink, named pipe, terminal, or other I/O device). ** The new function file-name-sans-extension discards the extension of a file name. You call it with a file name, and returns a string lacking the extension. ** The variable path-separator is a string which says which character separates directories in a search path. It is ":" for Unix and GNU systems, ";" for MSDOG and Windows NT. * Commands and Key Sequences ** Key sequences consisting of C-c followed by {, }, <, >, : or ; are now reserved for major modes. Sequences consisting of C-c followed by any other punctuation character are now meant for minor modes. We don't plan to convert all existing major modes to stop using those sequences, but we hope to keep them to a minimum. ** When the post-command-hook or the pre-command-hook gets an error, the error is silently ignored. Emacs no longer sets the hook variable to nil when this happens. Meanwhile, the hook functions can now alter the hook variable in a normal fashion; there is no need to do anything special. ** define-key, lookup-key, and various other functions for changing or looking up key bindings now let you write an event type with a list like (ctrl meta newline) or (meta ?d), as in XEmacs. (ctrl meta newline) is equivalent to the event type symbol C-M-newline, and (meta ?d) is equivalent to the character ?\M-d. ** The function event-convert-list converts a list such as (meta ?d) into the corresponding event type (a symbol or integer). ** In an interactive spec, `k' means to read a key sequence. In this key sequence, upper case characters and shifted function keys which have no bindings are converted to lower case if that makes them defined. The new interactive code `K' reads a key sequence similarly, but does not convert the last event. `K' is useful for reading a key sequence to be given a binding. ** The variable overriding-local-map now has no effect on the menu bar display unless overriding-local-map-menu-flag is non-nil. This is why incremental search no longer temporarily changes the menu bars. Note that overriding-local-map does still affect the execution of key sequences entered using the menu bar. So if you use overriding-local-map, and a menu bar key sequence comes in, you should make sure to clear overriding-local-map before that key sequence gets looked up and executed. But this is what you'd normally do anyway: programs that use overriding-local-map normally exit and "put back" any event such as menu-bar that they do not handle specially. ** The new variable `overriding-terminal-local-map' is like overriding-local-map, but is specific to a single terminal. ** delete-frame events. When you use the X window manager's "delete window" command, this now generates a delete-frame event. The standard definition of this event is a command that deletes the frame that received the event, and kills Emacs when the last visible or iconified frame is deleted. You can rebind the event to some other command if you wish. ** Two new types of events, iconify-frame and make-frame-visible, indicate that the user iconified or deiconified a frame with the window manager. Since the window manager has already done the work, the default definition for both event types in Emacs is to do nothing. * Frames and X ** Certain Lisp variables are now local to an X terminal (in other words, all the screens of a single X server). The value in effect, at any given time, is the one that belongs to the terminal of the selected frame. The terminal-local variables are default-minibuffer-frame, system-key-alist, defining-kbd-macro, and last-kbd-macro. There is no way for Lisp programs to create others. The terminal-local variables cannot be buffer-local. ** When you create an X Window frame, for the `top' and `left' frame parameters, you can now use values of the form (+ N) or (- N), where N is an integer. (+ N) means N pixels to the right of the left edge of the screen and (- N) means N pixels to the left of the right edge. In both cases, N may be zero (exactly at the edge) or negative (putting the window partly off the screen). The function x-parse-geometry can return values of these forms for certain inputs. ** The variable menu-bar-file-menu has been renamed to menu-bar-files-menu to match the actual item that appears in the menu. (All the other such variable names do match.) ** The new function active-minibuffer-window returns the minibuffer window currently active, or nil if none is now active. ** In the functions next-window, previous-window, next-frame, previous-frame, get-buffer-window, get-lru-window, get-largest-window and delete-windows-on, if you specify 0 for the last argument, it means to consider all visible and iconified frames. ** When you set a frame's cursor type with modify-frame-parameters, you can now specify (bar . INTEGER) as the cursor type. This stands for a bar cursor of width INTEGER. ** The new function facep returns t if its argument is a face name (or if it is a vector such as is used internally by the Lisp code to represent a face). ** Each frame can now have a buffer-predicate function, which is the `buffer-predicate' frame parameter. When `other-buffer' looks for an alternative buffer, it considers only the buffers that fit the selected frame's buffer predicate (if it has one). This is useful for applications that make their own frames. ** When you create an X frame, you can now specify the frame parameter `display'. This says which display to put the frame on. The value should be a display name--a string of the form "HOST:DPYNUMBER.SCREENNUMBER". The functions x-server-... and x-display-... now take an optional argument which specifies the display to ask about. You can use either a display name string or a frame. A value of nil stands for the selected frame. To close the connection to an X display, use the function x-close-connection. Specify which display with a display name. You cannot close the connection if Emacs still has frames open on that display. x-display-list returns a list indicating which displays Emacs has connections to. Its elements are display names (strings). ** The icon-type frame parameter may now be a file name. Then the contents of that file specify the icon bitmap to use for that frame. ** The title of an Emacs frame, displayed by most window managers, is set from frame-title-format or icon-title-format. These have the same structure as mode-line-format. ** x-display-grayscale-p is a new function that returns non-nil if your X server can display shades of gray. Currently it returns non-nil for color displays (because they can display shades of gray); we may change it in the next version to return nil for color displays. ** The frame parameter scroll-bar-width specifies the width of the scrollbar in pixels. * Buffers ** Creating a buffer with get-buffer-create does not obey default-major-mode. That variable is now handled in a separate function, set-buffer-major-mode. get-buffer-create and generate-new-buffer always leave the newly created buffer in Fundamental mode. Creating a new buffer by visiting a file or with switch-to-buffer, pop-to-buffer, and similar functions does call set-buffer-major-mode to select the default major mode specified with default-major-mode. ** You can now create an "indirect buffer". An indirect buffer shares its text, including text properties, with another buffer (the "base buffer"), but has its own major mode, local variables, overlays, and narrowing. An indirect buffer has a name of its own, distinct from those of the base buffer and all other buffers. An indirect buffer cannot itself be visiting a file (though its base buffer can be). The base buffer cannot itself be indirect. Use (make-indirect-buffer BASE-BUFFER NAME) to make an indirect buffer named NAME whose base is BASE-BUFFER. If BASE-BUFFER is an indirect buffer, its base buffer is used as the base for the new buffer. You can make an indirect buffer current, or switch to it in a window, just as you would a non-indirect buffer. The function buffer-base-buffer, given an indirect buffer, returns its base buffer. It returns nil when given an ordinary buffer (not indirect). The library `noutline' has versions of Outline mode and Outline minor mode which let you display different parts of the outline in different indirect buffers. * Subprocesses ** The functions call-process and call-process-region now allow you to direct error message output from the subprocess into a separate destination, instead of mixing it with ordinary output. To do this, specify for the third argument, BUFFER, a list of the form (BUFFER-OR-NAME ERROR-DESTINATION) BUFFER-OR-NAME specifies where to put ordinary output; it should be a buffer or buffer name, or t, nil or 0. This is what would have been the BUFFER argument, ordinarily. ERROR-DESTINATION specifies where to put the error output. nil means discard it, t means mix it with the ordinary output, and a string specifies a file name to write this output into. You can't specify a buffer to put the error output in; that is not easy to implement directly. You can put the error output into a buffer by sending it to a temporary file and then inserting the file into a buffer. ** Comint mode changes: *** The variable comint-completion-addsuffix can also be a cons pair of the form (DIRSUFFIX . FILESUFFIX), where DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact completion of directories and file names, respectively. * Text properties ** You can now specify which values of the `invisible' property make text invisible in a given buffer. The variable `buffer-invisibility-spec', which is always local in all buffers, controls this. If its value is t, then any non-nil `invisible' property makes a character invisible. If its value is a list, then a character is invisible if its `invisible' propery value appears as a member of the list, or if it appears as the car of a member of the list. When the `invisible' property value appears as the car of a member of the `buffer-invisibility-spec' list, then the cdr of that member has an effect. If it is non-nil, then an ellipsis appears in place of the character. (This happens only for the *last* invisible character in a series of consecutive invisible characters, and only at the end of a line.) If a character's `invisible' property is a list, then Emacs checks each element of the list against `buffer-invisibility-spec'. If any element matches, the character is invisible. ** The command `list-text-properties-at' shows what text properties are in effect at point. ** Frame objects now exist in Emacs even on systems that don't support X Windows. You can create multiple frames, and switch between them using select-frame. The selected frame is actually displayed on your terminal; other frames are not displayed at all. The selected frame number appears in the mode line after `Emacs', except for frame 1. Switching frames on ASCII terminals is therefore more or less equivalent to switching between different window configurations. ** The new variable window-size-change-functions holds a list of functions to be called if window sizes change (or if windows are created or deleted). The functions are called once for each frame on which changes have occurred, with the frame as the sole argument. This takes place shortly before redisplay. ** The modification hook functions of overlays now work differently. They are called both before and after each change. This makes it possible for the functions to determine exactly what the change was. This change affects three overlay properties: the modification-hooks property, a list of functions called for deletions overlapping the overlay's range and for insertions inside it; the insert-in-front-hooks, a list of functions called for insertions at the beginning of the overlay; and the insert-behind-hooks, a list of functions called for insertions at the end of the overlay. Each function is called both before and after each change that it applies to. Before the change, it is called with four arguments: (funcall FUNCTION OVERLAY nil START END) START and END are the same arguments that the before-change-functions receive. After the change, each function is called with five arguments: (funcall FUNCTION OVERLAY t START END OLDSIZE) The last arguments, START and END and OLDSIZE, are the same arguments that the after-change-functions receive. This means the function must accept either four or five arguments. ** You can set defaults for text-properties with the new variable `default-text-properties'. Its value is a property list; the values specified there are used whenever a character (or its category) does not specify a value. ** The `face' property of a character or an overlay can now be a list of face names. Formerly it had to be just one face name. ** Changes in handling the `intangible' text property. *** If inhibit-point-motion-hooks is non-nil, then `intangible' properties are ignored. *** Moving to just before a stretch of intangible text is no longer special in any way. Point stays at that place. *** When you move point backwards into the midst of intangible text, point moves back to the beginning of that text. (It used to move forward to the end of that text, which was not very useful.) *** When moving across intangible text, Emacs stops wherever the property value changes. So if you have two stretches of intangible text, with different non-nil intangible properties, it is possible to place point between them. * Overlays ** Overlay changes. *** The new function previous-overlay-change returns the position of the previous overlay start or end, before a specified position. This is the backwards-moving counterpart of next-overlay-change. *** overlay-get now supports category properties on an overlay the same way get-text-property supports them as text properties. Specifically, if an overlay does not have the property PROP that you ask for, but it does have a `category' property which is a symbol, then that symbol's PROP property is used. *** If an overlay has a non-nil `evaporate' property, it will be deleted if it ever becomes empty (i.e., when it spans no characters). *** If an overlay has a `before-string' and/or `after-string' property, these strings are displayed at the overlay's endpoints. * Filling ** The new variable fill-paragraph-function provides a way for major modes to override the filling of paragraphs. If this is non-nil, fill-paragraph calls it as a function, passing along its sole argument. If the function returns non-nil, fill-paragraph assumes it has done the job and simply passes on whatever value it returned. The usual use of this feature is to fill comments in programming language modes. ** Text filling and justification changes: *** The new variable use-hard-newlines can be used to make a distinction between "hard" and "soft" newlines; the fill functions will then never remove a newline that was manually inserted. Hard newlines are marked with a non-nil `hard' text-property. *** The fill-column and left-margin can now be modified by text-properties. Most lisp programs should use the new functions (current-fill-column) and (current-left-margin), which return the proper values to use for the current line. *** There are new functions for dealing with margins: **** Set-left-margin and set-right-margin (set the value for a region and re-fill). These functions take three arguments: two to specify a region, and the desired margin value. **** Increase-left-margin, decrease-left-margin, increase-right-margin, and decrease-right-margin (change settings relative to current values, and re-fill). **** move-to-left-margin moves point there, optionally adding indentation or changing tabs to spaces in order to make that possible. beginning-of-line-text also moves past the fill-prefix and any indentation added to center or right-justify a line, to the beginning of the text that the user actually typed. **** delete-to-left-margin removes any left-margin indentation, but does not change the property. *** The paragraph-movement functions look for the paragraph-start and paragraph-separate regexps at the current left margin, not at the beginning of the line. This means that those regexps should NOT use ^ to anchor the search. However, for backwards compatibility, a ^ at the beginning of the regexp will be ignored, so most packages won't break. *** justify-current-line is now capable of doing left, center, or right justification as well as full justification. *** The fill functions can do any kind of justification based on the new `justification' text-property and `default-justification' variable, or arguments to the functions. They also have a new option which defeats the normal removal of extra whitespace. *** The new function `current-justification' returns the kind of justification used for the current line. The new function `set-justification' can be used to change it, including re-justifying the text of the region according to the new value. *** Filling and auto-fill are disabled if justification is `none'. *** The auto-fill-function is now called regardless of whether the fill-column has been exceeded; the function can determine on its own whether filling (or justification) is necessary. * Processes ** process-tty-name is a new function that returns the name of the terminal that the process itself reads and writes on (not the name of the pty that Emacs uses to talk with that terminal). ** Errors in process filters and sentinels are now normally caught automatically, so that they don't abort other Lisp programs. Setting debug-on-error non-nil turns off this feature; then errors in filters and sentinels are not caught. As a result, they can invoke the debugger, under the control of debug-on-error. ** Emacs now preserves the match data around the execution of process filters and sentinels. You can use search and match functions freely in filters and sentinels without explicitly bothering to save the match data. * Display ** The variable message-log-max controls how messages are logged in the "*Messages*" buffer. An integer value means to keep that many lines; t means to log with no limit; nil means disable message logging. Lisp code that calls `message' excessively (e.g. isearch.el) should probably bind this variable to nil. ** Display tables now have a new element, at index 261, specifying the glyph to use for the separator between two side-by-side windows. By default, this is the vertical bar character `|'. Probably the only other useful character to store for this element is a space, to make less visual separation between two side-by-side windows displaying related information. ** The new mode-line-format spec %c displays the current column number. ** The new variable blink-matching-delay specifies how long to keep the cursor at the matching open-paren, after you insert a close-paren. This is useful mainly on systems which can wait for a fraction of a second--you can then specify fractional values such as 0.5. ** Faster processing of buffers with long lines The new variable cache-long-line-scans determines whether Emacs should use caches to handle long lines more quickly. This variable is buffer-local, in all buffers. Normally, the line-motion functions work by scanning the buffer for newlines. Columnar operations (like `move-to-column' and `compute-motion') also work by scanning the buffer, summing character widths as they go. This works well for ordinary text, but if the buffer's lines are very long (say, more than 500 characters), these motion functions will take longer to execute. Emacs may also take longer to update the display. If cache-long-line-scans is non-nil, these motion functions cache the results of their scans, and consult the cache to avoid rescanning regions of the buffer until the text is modified. The caches are most beneficial when they prevent the most searching---that is, when the buffer contains long lines and large regions of characters with the same, fixed screen width. When cache-long-line-scans is non-nil, processing short lines will become slightly slower (because of the overhead of consulting the cache), and the caches will use memory roughly proportional to the number of newlines and characters whose screen width varies. The caches require no explicit maintenance; their accuracy is maintained internally by the Emacs primitives. Enabling or disabling the cache should not affect the behavior of any of the motion functions; it should only affect their performance. * System Interface ** The function user-login-name now accepts an optional argument uid. If the argument is non-nil, user-login-name returns the login name for that user id. ** system-name, user-name, user-full-name and user-real-name are now variables as well as functions. The variables hold the same values that the functions would return. The new variable multiple-frames is non-nil if at least two non-minibuffer frames are visible. These variables may be useful in constructing the value of frame-title-format or icon-title-format. ** Changes in time-conversion functions. *** The new function format-time-string takes a format string and a time value. It converts the time to a string, according to the format specified. You can specify what kind of conversion to use with %-specifications. *** The new function decode-time converts a time value into a list of specific items of information: the year, month, day of week, day of month, hour, minute and second. (A time value is a list of two or three integers.) *** The new function encode-time converts specific items of time information--the second, minute, hour, day, month, year, and time zone--into a time value. * Changes in Emacs 19.27 There are no changes; however, here is one bug fix made in 19.26 that users think should be documented here. ** SPC and DEL in Info now handle menus consistently. SPC and DEL scroll through an entire subtree an Info manual. Once you scroll through a node far enough to reach a menu, SPC begins moving into the subnodes of the menu, starting with the first one. When you reach the end of a subnode, SPC moves into the next subnode, and so on. DEL more or less scrolls through the same text in reverse order. * User Editing Changes in Emacs 19.26 ** In the X toolkit version, if you click on a menu bar item and release the button quickly outside the menu, the menu remains visible until you click or type something else. If you click on the menu, you select from the menu. Any other mouse click makes the menu disappear. Keyboard input gets rid of the menu and then is processed normally. "Quickly" means within double-click-time milliseconds. ** The C-x 5 commands to select a buffer in "another frame" now use an existing iconified frame, if any, deiconifying it. They also raise the frame. ** Region highlighting on a black-and-white-only display now uses underlining. Inverse-video had the problem that you couldn't see the cursor. ** You can now change the height of a window by pressing mouse-1 on the mode line and dragging it up and down. ** If you set the environment variable LC_CTYPE to iso_8859_1 or iso-8859-1, Emacs automatically sets up for display and syntactic handling of the ISO Latin-1 character set. This does not automatically load any of the packages for input of these characters, because it's not yet clear what is right to do. You must still explicitly load either iso-transl or iso-acc. ** For a read-only buffer that is also modified, the mode line now displays %* instead of %%. ** M-prior (scroll-other-window-down) is a new command that works like M-next (and C-M-v) but scrolls in the opposite direction. M-home moves to the beginning of the buffer, in the other window. M-end moves to the end of the buffer, in the other window. These two commands, along with M-next and M-prior, form a series of commands for moving around in the other window. ** In change logs, the mail address is now delimited with <...> instead of (...). This makes it a little more convenient to extract the mail address for use in mailing a message. ** In Shell mode and other comint modes, C-a has now returned to its ordinary meaning: move to the beginning of the line. Use C-c C-a to move to the end of the prompt. ** If you set mail-signature to t to cause automatic insertion of your .signature file, you now get a -- before the signature. ** Setting rmail-highlighted-headers to nil entirely turns off highlighting in Rmail. However, if your motivation for doing this is that the highlighted text doesn't look good on your display, it might be better to change the appearance of the `highlight' face. Once you've done that, you may find Rmail highlighting is useful. ** In the calendar, mouse-2 is now used only for commands that apply to a date. If you click it when not on a date, it gives an immediate error. Mouse-3 in the calendar now gives a menu of commands that do not apply to a particular date. The D command displays diary entries from a specified diary file (not your standard diary file). ** In the gnus-uu package, the binding for gnus-uu-threaded-decode-and-view is now C-c C-v C-d, not C-c C-v C-h. Thus, C-c C-v C-h is now available for asking for a list of the subcommands of C-c C-v. ** You can now specify "who you are" for various Emacs packages by setting just one variable, user-mail-address. This currently applies to posting news with GNUS and to making change log entries. It may apply to additional Emacs features in the future. * Lisp-Level Changes in Emacs 19.26: ** The function insert-char now takes an optional third argument which, if non-nil, says the inserted characters should inherit sticky text properties from the surrounding text. ** The `diary' library has been renamed to `diary-lib'. If you refer to this library in your Lisp code, you must update the references. ** Sending text to a subprocess can read input from subprocesses if it has to wait because the destination subprocess's terminal input buffer is full. It was already possible in unusual occasions for this operation to read subprocess input, but it did not happen very often. It is now more likely to happen. ** last-nonmenu-event is now bound to t around filter functions and sentinels. This is to ensure that y-or-n-p and yes-or-no-p use the keyboard by default. ** In mode lines, %+ now displays as % for unmodified read-only buffers. It is now the same as %* except in the case of a modified read-only buffer; in that case, %+ displays as *. The old meaning of %+ is now available on %&. It displays * for a modified buffer and - for an unmodified buffer, regardless of read-only status. ** You can now use `underline' in the color list of a face. It serves as a last resort, and says to underline the face (if previous color list elements can't be used). ** The new function x-color-values returns the list of color values for a given color name (a string). The list contains three integers which give the amounts of red, green and blue in the color: (R G B). ** In run-at-time, 0 as the repeat interval means "don't repeat". ** The variable trim-versions-without-asking has been renamed to delete-old-versions. ** The new function other-window-for-scrolling returns the choice of other window for C-M-v to scroll. ** Note that the function fceiling was mistakenly documented as fceil before. * Changes in cc-mode.el in Emacs 19.26: ** A new syntactic symbol has been added: substatement-open. It defines the open brace of a substatement block. These used to get: ((block-open ...) (substatement . ...)). Non-block substatement lines still get just ((substatement . ...)) Note that the custom indent function c-adaptive-block-open has been removed as obsolete. ** You can now specify the `hanginess' of closing braces. See c-hanging-braces-alist. ** Recognizes try and catch blocks in C++. They are given the substatement syntactic symbol. ** should be generally more forgiving about non-GNU standard top-level construct definition styles (i.e. where the function/class/struct opening brace does not start in column zero). If you hang the braces that open a top-level construct on the right edge, and you find you still need to define defun-open-prompt (Emacs 19) please let me know. Note that there may still be performance issues related to non-column zero opening braces. ** c-macro-expand is put on C-c C-e ** New style: "Default". Resets indentation to those shipped with cc-mode.el. ** internal defun c-indent-via-language-element has been renamed c-indent-line for compatibility with c-mode.el and awk-mode. ** new buffer-local variable c-comment-start-regexp for (potential) flexibility in adding new modes based on cc-mode.el * Changes in Emacs 19.25 The variable x-cross-pointer-shape (which didn't really exist) has been renamed to x-sensitive-text-pointer-shape, and now does exist. * Changes in Emacs 19.24 Here is a list of new Lisp packages introduced since 19.22. derived.el Define new major modes based on old ones. dired-x.el Extra Dired features. double.el New mode for conveniently inputting non-beyond chars. easymenu.el Create menus easily. ediff.el Snazzy diff interface. foldout.el A kind of outline mode designed for editing programs. gnus-uu.el UUdecode in GNUS buffers. ielm.el Interactively evaluate Lisp. This is a replacement for Lisp Interaction Mode. iso-cvt.el Conversion of beyond-ASCII characters between various different representations. jka-compr.el Automatic compression/decompression. mldrag.el Drag modeline to change heights of windows. mail-hist.el Provides history for headers of outgoing mail. rsz-mini.el Automatically resizing minibuffers. s-region.el Set region by holding shift. skeleton.el Templates for statement insertion. soundex.el Classifying words by how they sound. tempo.el Template insertion with hotspots. * User Editing Changes in 19.23. ** Emacs 19.23 uses Ispell version 3. Previous Emacs 19 versions used Ispell version 4. That version had improvements in storing the dictionary compactly, but these are not very important nowadays. Meanwhile, in parallel to the work on Ispell 4, many useful features were added to Ispell 3. Until a few months ago, the terms on Ispell 3 did not let us use it; but they have now been changed, so now we are using it. We are dropping Ispell 4. ** Emacs 19.23 can run on MS-DOG. See the file MSDOS in the same directory as this file. ** Emacs 19.23 can work with an X toolkit. You must specify toolkit operation when you configure Emacs: use the option --with-x-toolkit=yes. (This option uses code developed by Lucid; thanks to Frederic Pierresteguy for helping to adapt it.) ** Emacs now has dialog boxes; yes/no and y/n questions automatically use them in commands invoked with the mouse. For more information, see below under "Lisp programming changes". ** Menus now display the keyboard equivalents (if any) of the menu commands in parentheses after the menu item. ** Kill commands, used in a read-only buffer, now move point across the text they would otherwise have killed. This way, you can use repeated kill commands to transfer text into the kill ring. ** There is now a global mark ring in addition to the mark ring that is local to each buffer. The global mark ring stores positions in any buffer. Any time the mark is set and the current buffer is different from the last time the mark was set, the new mark is pushed on the global mark ring as well. The new command C-x C-SPC (pop-global-mark) pops the global mark ring and jumps to the last mark pushed, first switching to that buffer. ** Query Replace is now available in the Edit menu. ** ESC no longer simply exits a Query Replace. It now exits the Query Replace and remains pending. Thus, ESC A and M-A are now equivalent in Query Replace. To simply exit a Query Replace, type RET or Period. ** M-mouse-2 now puts point at the end of the yanked secondary selection. ** Mouse-1 in the mode line now simply selects the window above that mode line. Mouse-2 in the mode line selects that window and expands it to fill the frame it is in. ** You can now use mouse-2 in a Dired buffer or Tar mode buffer to find a file you click on, in a compilation buffer to go to a particular error message, and in a *Occur* buffer to go to a particular occurrence. (It was already possible to do likewise in Info and in completion list buffers.) What's more, the sensitive areas of the buffer now highlight when you move the mouse over them. ** In a completion list buffer, the command RET now chooses the completion that is around or next to point. ** If you specify the foreground color for the `mode-line' face, and mode-line-inverse-video is non-nil, then the default background color is the usual foreground color. ** revert-buffer now preserves markers pointing within the unchanged text (if any) at the beginning and end of the file. ** Version control checkin and checkout preserve all markers if the file does not contain any of the magic version header sequences that are updated automatically by RCS and SCCS. If such version headers are present, checkin and checkout preserve a marker unless it comes between two such sequences. (So it's a good idea to put all the header sequences close together.) ** When a large deletion shuts off auto save temporarily in a buffer, you can now turn it on again by saving the buffer with C-x C-s (as was possible in Emacs 18). You can also turn it on again with M-1 M-x auto-save (as has been possible in Emacs 19). ** C-x r d now runs the command delete-rectangle. ** The new command imenu shows you a menu of interesting places in the current buffer and lets you select one; then it moves point there. The definition of interesting places depends on the major mode, but typically this includes function definitions and such. Normally, imenu displays the menu in a buffer; but if you bind it to a mouse event, it shows a mouse popup menu. ** You can make certain chosen buffers, that normally appear in a separate window, appear in special frames of their own. To do this, set special-display-buffer-names to a list of buffer names; any buffer whose name is in that list automatically gets a special frame when it is to be displayed in another window. A good value to try is ("*compilation*" "*grep*" "*TeX Shell*"). More generally, you can set special-display-regexps to a list of regular expressions; then each buffer whose name matches any of those regular expressions gets its own frame. The variable special-display-frame-alist specifies the frame parameters for these frames. It has a default value, so you don't need to set it. ** If you set sentence-end-double-space to nil, the fill commands expect just one space at the end of a sentence. (If you want the sentence commands to accept single spaces, you must modify the regexp sentence-end also.) ** You can suppress the startup echo area message by adding text like this to your .emacs file: (setq inhibit-startup-echo-area-message "YOUR-LOGIN-NAME") Simply setting inhibit-startup-echo-area-message to your login name is not sufficient to inhibit the message; Emacs explicitly checks whether .emacs contains an expression as shown above. Your login name must appear in the expression as a Lisp string constant. This way, you can easily inhibit the message for yourself if you wish, but thoughtless copying of your .emacs file will not inhibit the message for someone else. ** Outline minor mode now uses C-c C-o as a prefix instead of just C-c. ** In Outline mode, hide-subtree is now C-c C-d. (It was C-c C-h; but that is now a conventional way to ask for help about C-c commands.) ** There are two additional commands in Outline mode. M-x hide-sublevels hides all headers except the topmost N levels. M-x hide-other hides everything about the body that point is in plus the headers leading up from there to the top of the tree. ** In iso-transl and iso-insert, the sequences for entering A-ring and the AE ligature are now just A and E (plus the initial C-x 8 or Alt). You used to have to enter AA or AE, after the C-x 8 prefix of course. Likewise for lower case a-ring and ae. ** iso-transl now defines convenient Alt keys as well as the C-x 8 prefix. Instead of prefixing a sequence with C-x 8, you can add Alt to the first character of the sequence. For example, Alt-" a is now a way to enter an a-umlaut. ** CC mode is a greatly improved mode for C and C++. See the following page. ** tcl mode is a new major mode. It provides features for editing, indenting and running tcl programs. ** Compilation minor mode lets you parse error messages in any buffer, not just a normal compilation output buffer. Type M-x compilation-minor-mode to enable the minor mode; then C-c C-c jumps to the source location for the error at point, as in the `*compilation*' buffer. If you use compilation-minor-mode in an Rlogin buffer, it automatically accesses remote source files by ftp. ** Comint and shell mode changes: *** Comint modes (including Shell mode, GUD modes, etc.) now bind C-M-l to the command comint-show-output. This command scrolls the buffer to show the last batch of output from the subprogram. *** Completion in Comint modes now truly operates on the string before point, rather than the word that point is within. *** Comint mode file name completion ignores those files that end with a string in the new variable comint-completion-fignore. This variable's default value is nil. *** Shell mode uses the variable shell-completion-fignore to set comint-completion-fignore. The default value is nil, but some people prefer ("~" "#" "%"). *** The function `comint-watch-for-password-prompt' can be used to suppress echoing when a subprocess asks for a password. To use it, do this: (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt) *** You can use M-x shell-strip-ctrl-m to strip ^M characters from process output. *** In Shell mode, TAB now completes environment variables, if possible, and expands directory references. *** You can use M-x comint-run to execute any program of your choice in a comint mode. Some programs such as shells, rlogin, and debuggers have their own specialized modes; this command is one way to use comint to run programs for which no such specialized mode exits. (You can also run a shell with M-x shell and run the program of your choice under the shell--but that gives you the specializations of Shell mode.) ** When you run GUD (M-x gdb, M-x dbx, and so on), you can use TAB to do file name completion in the minibuffer. The "Complete" menu includes an item for directory expansion. ** GUD working with future versions of GDB will permit TAB for GDB-style symbol completion. This will work with GDB 4.13. ** Rmail no longer gets new mail automatically when you visit an Rmail file specified by name--not even if it is your primary Rmail file. To get new mail, type `g'. This feature is an advantage because you now have a choice of whether to get new mail. (This change actually occurred in an earlier version, but wasn't listed here then, since it made the code do what the documentation already said.) ** Rmail now highlights certain fields automatically, when you use X windows. The variable rmail-highlighted-headers controls which fields. ** If you set rmail-summary-window-size to an integer, Rmail uses a window that many lines high for the summary buffer. ** rmail-input-menu is a new command that visits an Rmail file letting you choose which file with a mouse menu. rmail-output-menu is similar; it outputs the current message, using a mouse menu to choose which Rmail file. These commands use the variables rmail-secondary-file-directory and rmail-secondary-file-regexp. ** The mh-e package has been changed substantially. See the file ./MH-E-NEWS for details. ** The calendar and diary have new features. The menu bar for the calendar contains most of the calendar commands, arranged into logical categories. Mouse-2 now performs specific-date-related commands when clicked on a date in the calendar window and common three-month-related commands when clicked elsewhere in the calendar window. You can set up colored/shaded highlighting of holidays, diary entry dates, and today's date, by setting calendar-holiday-marker, diary-entry-marker, and calendar-today-marker to a face instead of a character. Using a special face is now the default if you are using a window system. ** The appt package for displaying appointment reminders has new features. *** The appt alarm window stays for the full duration of appt-display-duration. It no longer disappears when you start typing text. *** You can change the way the appointment window is created/deleted by setting the variables appt-disp-window-function and appt-delete-window-function. For instance, these variables can be set to functions that display appointments in pop-up frames, which are lowered or iconified after appt-display-duration seconds. ** desktop.el can now save a list of buffer-local variables, and saves more global ones. ** Pascal mode has been completely rewritten. It now features completing of function names, variables and type definitions around current point (like M-TAB does with lisp-symbols). There's also an outline mode (M-x pascal-outline) that hides the bodies of all functions you're not working with. ** Edebug has a number of changes: *** Edebug syntax error reporting is improved. *** Top-level forms and defining forms other than defun and defmacro may now be debugged with Edebug. *** Edebug specifications may now contain body, &define, name, arg or arglist, def-body, and def-form, to support definitions. *** edebug-all-defuns is renamed to edebug-all-defs. def-edebug-form-spec is replaced by def-edebug-form whose arguments are unevaluated. The old names are still available for now. *** Frequency counts and coverage data may be displayed for functions being debugged. *** A global break condition is now checked at every stop point. *** The previous condition at a breakpoint may now be edited. *** A new "next" mode stops only after expression evaluation. *** A new command, top-level-nonstop, does not even stop for unwind-protect, as top-level would. * Changes in CC mode in Emacs 19.23. `cc-mode' provides ANSI C, K&R C, and ARM C++ language editing. It represents the merge of c++-mode.el and c-mode.el. cc-mode provides a new, more flexible indentation engine so that indentation customization is more intuitive. There are two steps to calculating indentation: first, CC mode analyzes the line for syntactic content, then based on this content it applies user defined offsets and adds this offset to the indentation of some previous line. The syntactic analysis determines if the line describes a `statement', `substatement', `class-open', `member-init-intro', etc. These are described in detail with C-h v c-offsets-alist. You can change the offsets interactively with C-c C-o (c-set-offsets), or programmatically in your c-mode-common-hook, which is run both by c-mode and c++-mode. You can also set up "styles" in the same way that you could with c-mode.el. The variable c-basic-offset controls the basic offset given to a level of indentation. If, for example, you wanted to change this style: int foo (int i) { switch (i) { case 1: printf ("its a foo\n"); break; default: printf ("don't know what it is\n"); break; } } into this: int foo (int i) { switch (i) { case 1: printf ("its a foo\n"); break; default: printf ("don't know what it is\n"); break; } } you could add the following to your .emacs file: (defun my-c-mode-common-hook () (c-set-offset 'case-label 2) (c-set-offset 'statement-case-intro 2)) (add-hook 'c-mode-common-hook 'my-c-mode-common-hook) ** New variables: c-offsets-alist contains an association list of syntactic symbols and their relative offsets. Do a "C-h v c-offsets-alist" to get a list of all syntactic symbols currently defined, and their meanings. You should not change this variable directly; use the supplied interface commands c-set-offset and c-set-style. c-mode-common-hook is run by both c-mode and c++-mode during their common initializations. You should put any customizations that are the same for both C and C++ into this hook. The variable c-strict-semantics-p is used mainly for debugging. When non-nil, CC mode signals an error if it returns a syntactic symbol that can't be found in c-offsets-alist. If you want CC mode to echo the syntactic analysis for a particular line when you hit the TAB key, set c-echo-semantic-information-p to non-nil. c-basic-offset controls the standard amount of offset for a level of indentation. You can set a syntactic symbol's offset to + or - as a short-hand for positive or negative c-basic-offset. c-comment-only-line-offset lets you control indentation given to lines which contain only a comment, in the case of C++ line style comments, or the introduction to a C block comment. Comment-only lines at column zero can be anchored there independent of the indentation given to other comment-only lines. c-block-comments-indent-p controls the style of C block comment re-indentation. If you put leading stars in front of comment continuation lines, you should set this variable to nil. c-cleanup-list is a list describing certain C and C++ constructs to be "cleaned up" as they are typed, but only when the auto-newline feature is turned on. In C++, make sure this variable contains at least 'scope-operator so that double colons will not be separated by a newline. Colons (`:') and braces (`{` and `}') are special in C and C++. For certain constructs, you may like them to hang on the right edge of the code, or you may like them to start a new line of code. You can use the two variables c-hanging-braces-alist and c-hanging-colons-alist to control whether newlines are placed before and/or after colons and braces when certain C and C++ constructs are entered. For example, you can control whether the colon that introduces a C++ member initialization list hangs on the right edge, starts a new line, or has no newlines either before or after it. c-special-indent-hook is run after a line is indented by CC mode. You can perform any custom indentations here. c-delete-function is the function that is called when a single character is deleted with the c-electric-delete command (DEL). c-electric-pound-behavior describes what happens when you enter the `#' that introduces a cpp macro. If c-tab-always-indent is neither t nor nil, then TAB inserts a tab when within strings, comments, and cpp directives, but it reindents the line unconditionally. c-inhibit-startup-warnings-p inhibits warnings about any old version of Emacs you might be running, which could be incompatible with cc-mode. ** There are two new minor-mode features in CC mode: auto-newline and hungry-delete. Auto-newline inserts newlines automatically as you type certain constructs. Hungry-delete consumes all preceding whitespace (spaces, tabs, and newlines) when the delete key is hit. You can toggle auto-newline on and off on a per-buffer basis by hitting C-c C-a. You can toggle hungry-delete on and off by hitting C-c C-d. You can toggle them both on and off together with C-c C-t. ** Slash (`/') and star (`*') are now both electric characters. ** New commands: The new C-c C-o (c-set-offset) command can be used to interactively change the offset for a particular syntactic symbol. The new command C-c : (c-scope-operator) inserts the C++ scope operator in c++-mode only. The new command C-c C-q (c-indent-defun) indents the entire enclosing top-level function or class. The new command C-c C-s (c-show-semantic-information) echos the current syntactic analysis without re-indenting the current line. The new commands M-x c-forward-into-nomenclature and M-x c-backward-into-nomenclature (currently otherwise unbound to a key sequence), make movement easier when using the C++ variable naming convention of VariableNamesWithoutUnderscoresButEachWordCapitalized. ** Command from c-mode.el that have been renamed in cc-mode.el: electric-c-brace => c-electric-brace electric-c-semi => c-electric-semi&comma electric-c-sharp-sign => c-electric-pound mark-c-function => c-mark-function electric-c-terminator => c-electric-colon indent-c-exp => c-indent-exp set-c-style => c-set-style ** Variables from c-mode.el that are obsolete with cc-mode.el: c-indent-level c-brace-imaginary-offset c-brace-offset c-argdecl-indent c-label-offset c-continued-statement-offset c-continued-brace-offset * Lisp programming changes in Emacs 19.23. ** To pop up a dialog box, call x-popup-dialog. It takes two arguments, POSITION and CONTENTS. POSITION specifies which frame to place the dialog box over; the dialog box always goes on the center of the frame. POSITION may be a mouse event, a window, a frame, or t meaning use the frame that the mouse is in. CONTENTS specifies the contents of the dialog box. It looks like a single pane of a popup menu: (TITLE ITEM1 ITEM2 ...), where each ITEM has the form (STRING . VALUE). The return value is VALUE from the chosen item. An ITEM may also be just a string--that makes a nonselectable item. An ITEM may also be nil--that means to put all preceding items on the left of the dialog box and all following items on the right. (By default, approximately half appear on each side.) If your Emacs is not using an X toolkit, then it cannot display a real dialog box; so instead it displays a pop-up menu in the center of the frame. ** y-or-n-p, yes-or-no-p and map-y-or-n-p now use menus or dialog boxes to ask their question(s) if the command that is running was reached by a mouse event. If you want to control which way these functions work, bind the variable last-nonmenu-event around the call. These functions use the keyboard if that variable holds a keyboard event (actually, any non-list); they use the mouse if that variable holds a mouse event (actually, any list). ** The mouse-face property is now implemented, both in overlays and as a text property. It specifies a face to use when the mouse is in the range of text for which the property is specified. ** When text has a non-nil `intangible' property, you cannot move point within it or right before it. If you try, point actually moves to the end of the intangible text. Note that this means that backward-char is a no-op when there is an intangible character to the left of point. ** minibuffer-exit-hook is a new normal hook that is run when you exit the minibuffer. ** The variable x-cross-pointer-shape specifies the cursor shape to use when the mouse is over text that has a mouse-face property. ** The new variable interpreter-mode-alist specifes major modes to use for shell scripts that specify a command interpreter. Its elements look like (INTERPRETER . MODE); for example, ("perl" . perl-mode) is one element present by default. This feature applies only when the file name doesn't indicate which mode to use. ** If you use a minibuffer-only frame, set the variable minibuffer-auto-raise to t, and entering the minibuffer will then raise the minibuffer frame. ** If pop-up-frames is t, display-buffer now looks for an existing window in any visible frame, showing the specified buffer, and uses such a window in preference to making a new frame. ** In the functions next-window, previous-window, next-frame, previous-frame, get-buffer-window, get-lru-window, get-largest-window and delete-windows-on, if you specify `visible' for the last argument, it means to consider all visible frames. ** Mouse events now give the X and Y coordinates in pixels, rather than in characters. You can convert these values to characters by dividing by the values of (frame-char-width) and (frame-char-height). ** The new functions mouse-pixel-position and set-mouse-pixel-position read and set the mouse position in units of pixels. The existing functions mouse-position and set-mouse-position continue to work with units of characters. ** The new function compute-motion is useful for computing the width of certain text when it is displayed. ** The function vertical-motion now takes an option second argument WINDOW which says which window to use for the display calculations. vertical-motion always operates on the current buffer. It is ok to specify a window displaying some other buffer. Then vertical-motion uses the width, hscroll and display-table of the specified window, but still scans the current buffer. ** An error no longer sets last-command to t; the value of last-command does reflect the previous command (the one that got an error). If you do not want a particular command to be recognized as the previous command in the case where it got an error, you must code that command to prevent this. Set this-command to t at the beginning of the command, and set this-command back to its proper value at the end, like this: (defun foo (args...) (interactive ...) (setq this-command t) ...do the work... (setq this-command 'foo)) or like this: (defun foo (args...) (interactive ...) (let ((old-this-command this-command)) (setq this-command t) ...do the work... (setq this-command old-this-command))) The undo and yank commands do this. ** If you specify an explicit title for a new frame when you create it, the title is used as the resource name when looking up X resources to control the shape of that frame. If you don't specify the frame title, the value of x-resource-name is used, as before. ** The frame parameter user-position, if non-nil, says that the user has specified the frame position. Emacs reports this to the window manager, to tell it not to override the position that the user specified. ** Major modes can now set change-major-mode-hook to arrange for state to be cleaned up when the user switches to a new major mode. The function kill-all-local-variables runs this hook. For best results, make the hook a buffer-local variable so that it will disappear after doing its job and will not interfere with the subsequent major mode. ** The new variable overriding-local-map, if non-nil, specifies a keymap that overrides the current local map, all minor mode keymaps, and all text property keymaps. Incremental search uses this feature to override all other keymaps temporarily. ** A key definition in a menu keymap can now have additional structure: in addition to (ITEMNAME [HELPSTRING] . COMMAND) which was allowed before, the form (ITEMNAME [HELPSTRING] (...) . COMMAND) is allowed. (HELPSTRING is optional, and is not currently used.) Here (...) represents a sublist containing information about keyboard key sequences that run the same command COMMAND. Displaying the menu automatically creates and updates the sublist when appropriate; you need never set these up yourself. lookup-key, key-binding, and similar functions return just COMMAND, not the whole binding. To precompute this information for a given keymap, you can do (x-popup-menu nil KEYMAP). ** When you specify coordinates for x-popup-menu as a list ((XOFFSET YOFFSET) WINDOW), the coordinates are now measured in pixels. ** where-is-internal now takes just four arguments: DEFINITION KEYMAP FIRSTONLY NOINDIRECT. The single argument KEYMAP replaces two arguments KEYMAP and KEYMAP1. If KEYMAP is non-nil, where-is-internal searches only KEYMAP and the global keymap. If KEYMAP is nil, where-is-internal searches all the currently active keymaps, but finds the active keymaps as if overriding-local-map were nil. If you pass a list of the form (keymap) as KEYMAP, where-is-internal searches only the global map. (This is not a special case--it follows from the specifications above.) If you pass the value of overriding-local-map as KEYMAP, where-is-internal searches in exactly the same was as command execution does. ** Use the macro define-derived-mode to define a new major mode that inherits the definition of another major mode. Here's how to define a command named hypertext-mode that inherits from the command text-mode: (define-derived-mode hypertext-mode text-mode "Hypertext" "Major mode for hypertext.\n\n\\{hypertext-mode-map}" (setq case-fold-search nil)) (define-key hypertext-mode-map [down-mouse-3] 'do-hyper-link) The new mode has its own keymap, which inherits from that of the original mode. It also has its own syntax and abbrev tables, which are initialized by copying those of the original mode. It also has its own mode hook. All are given names made by appending a suffix to the name of the new mode. ** A syntax table can now inherit the data for some characters from standard-syntax-table, while specifying other characters itself. Syntax code 13 means "inherit this character from the standard syntax table." In modify-syntax-entry, the character `@' represents this code. The function `make-syntax-table' now creates a syntax table which inherits all letters and control characters (0 to 31 and 128 to 255) from the standard syntax table, while copying the other characters from the standard syntax table. Most syntax tables in Emacs are set up this way. This sort of inheritance is useful for people who set up character sets with additional alphabetic characters in the range 128 to 255. Just changing the standard syntax for these characters affects all major modes. ** The new function transpose-regions swaps two regions of the buffer. It preserves the markers in those two regions, so that they stay with the surrounding text as it is swapped. ** revert-buffer now runs before-revert-hook at the beginning and after-revert-hook at the end. These can be used by minor modes that need to clean up state variables. ** The new function get-char-property is like get-text-property, but checks for overlays with properties as well as for text properties. It checks for overlays first, in order of descending priority, and text properties last. get-char-property allows windows as the OBJECT argument, as well as buffers and strings. If you specify a window, then only overlays active on that window are considered. ** Overlays can have the `invisible' property. ** The function insert-file-contents now takes an optional fifth argument called REPLACE. If this is t, it means to replace the contents of the buffer (actually, just the accessible portion) with the contents of the file. This is better than simply deleting and inserting the whole thing because (1) it preserves some marker positions and (2) it puts less data in the undo list. ** The variable inhibit-first-line-modes-regexps specifies classes of file names for which -*- on the first line should not be looked for. ** The variables before-change-functions and after-change-functions hold lists of functions to call before and after a change in the buffer's text. They work much like before-change-function and after-change-function, except that they hold a list of functions instead of just one. These variables will eventually make before-change-function and after-change-function obsolete. ** The variable kill-buffer-query-functions holds a list of functions to be called with no arguments when a buffer is about to be killed. (That buffer is the current buffer when the function is called.) If any of the functions returns nil, the buffer is not killed (and the remaining functions in the list are not called). ** The variable kill-emacs-query-functions holds a list of functions to be called with no arguments when you ask to exit Emacs. If any of the functions returns nil, the exit is canceled (and the remaining functions in the list are not called). ** The argument for buffer-disable-undo is now optional, like the argument for buffer-enable-undo. ** The new variable system-configuration holds the canonical three-part GNU configuration name for which Emacs was built. ** The function system-name now tries harder to return a fully qualified domain name. ** The variable emacs-major-version holds the major version number of Emacs. (Currently 19.) ** The variable emacs-minor-version holds the minor version number of Emacs. (Currently 23.) ** The default value of comint-input-autoexpand is now nil. However, Shell mode sets it from the value of shell-input-autoexpand, whose default value is `history'. ** The new function set-process-window-size specifies the terminal window size for a subprocess. On some systems it sends the subprocess a signal to let it know that the size has changed. ** %P is a new way to display a percentage in the mode line. It displays the percentage of the buffer text that is above the *bottom* of the window (which includes the text visible, in the window as well as the text above the top). It dispays `Top' as well as the percentage if the top of the buffer is visible on screen. ** %+ in the mode line specs displays `*' if the buffer is modified, and otherwise `-'. It never displays `%', as `%*' would do; whether the buffer is read-only has no effect on %+. ** The new functions ffloor, fceiling, fround and ftruncate take a floating point argument and return a floating point result whose value is a nearby integer. ffloor returns the nearest integer below; fceil, the nearest integer above; ftrucate, the nearest integer in the direction towards zero; fround, the nearest integer. ** Setting `print-escape-newlines' to a non-nil value now also makes formfeeds print as ``\f''. ** auto-mode-alist now has a new feature. If an element has the form (REGEXP FUNCTION t), and REGEXP matches the file name, then after calling FUNCTION, Emacs deletes the part of the file name that matched REGEXP and then searches auto-mode-alist again for a new match. This is useful for uncompression packages. An entry of this sort for .gz can uncompress the file and then put the uncompressed file in the proper mode according to the name sans .gz. ** The new function emacs-pid returns the process ID number of Emacs. ** user-login-name now consistently checks the LOGNAME environment variable before USER. user-original-login-name is obsolete, since it provides the same functionality. To ignore the environment variables, use user-real-login-name. ** There is a more general way of handling the system-specific X keysyms. Set the variable system-key-alist to an alist containing elements of the form (CODE . SYMBOL), where CODE is the numeric keysym code minus the "vendor specific" bit, and symbol is the name for the function key. ** You can use the variable command-line-functions to set up functions to process unrecognized command line arguments. The variable's value should be a list of functions of no arguments. The functions are called successively until one of them returns non-nil. Each function should access the free variables argi (the current argument) and command-line-args-left (the remaining arguments). The function should return non-nil only if it recognizes and processes the argument in argi. If it does so, it may consume following arguments as well by removing them from command-line-args-left. ** There's a new way for a magic file name handler to run a primitive and inhibit handling of the file name. Here is how to do it: (let ((inhibit-file-name-handlers (cons 'ange-ftp-file-handler (and (eq inhibit-file-name-operation operation) inhibit-file-name-handlers))) (inhibit-file-name-operation operation)) (apply this-operation args)) The function find-file-name-handler now takes two arguments. The second argument is OPERATION, the operation for which the handler is being sought. People have suggested that the second argument should be optional, for backward compatibility. It would be nice if that were possible, but it is not. There is simply no way for find-file-name-handler to do the right thing without receiving the proper value for its second argument. ** The variable completion-regexp-list affects the completion primitives try-completion and all-completions. They consider only the possible completions that match each regexp in the list. ** Case conversion in the function replace-match has been changed. The old behavior was this: if any word in the old text was capitalized, replace-match capitalized each word of the replacement text. The new behavior is this: if the first word in the old text is capitalized, replace-match capitalizes the first word of the replacement text. ** You can now specify a case table with CANON non-nil and EQV nil. Then the EQV part of the case table is deduced from CANON. ** The new function minibuffer-prompt takes no arguments and returns the current minibuffer prompt string. The new function minibuffer-prompt-width takes no arguments and returns the display width of the minibuffer prompt string. ** The new function frame-first-window returns the window at the upper left corner of a given frame. ** wholenump is a new alias for natnump. ** The variable installation-directory, if non-@code{nil}, names a directory within which to look for the `lib-src' and `etc' subdirectories. This is non-nil when Emacs can't find those directories in their standard installed locations, but can find them near where the Emacs executable was found. ** invocation-name and invocation-directory are now variables as well as functions. The variable values are the same values that the functions return: the Emacs program name sans directories, and the directory it was found in. (invocation-directory may be nil, if Emacs can't determine which directory it should be.) ** Installation change regarding version number counting. The version number of an Emacs executable contains three numbers. The first two describe the Emacs release and the third increments each time you build Emacs. Now the file version.el contains only the first two version numbers. The third component is now determined on the basis of the names of the existing executable files. This means that version.el is not altered by building Emacs. * Changes in 19.22. ** The mouse click M-mouse-2 now inserts the current secondary selection (from Emacs or any other X client) where you click. It does not move point. This command is called mouse-yank-secondary. mouse-kill-secondary no longer has a key binding by default. Clicking M-mouse-3 (mouse-secondary-save-then-kill) twice may be a convenient enough way of killing the secondary selection. Or perhaps there should be a keyboard binding for killing the secondary selection. Any suggestions? ** New packages: *** `icomplete' provides character-by-character information about what you could complete if you type TAB. *** `avoid' moves the mouse away from point so that it doesn't hide your typing. *** `shadowfile' helps you update files that are supposed to be stored identically in different places (perhaps on different machines). ** C-h p now knows about four additional keywords: data, faces, mouse, and matching. ** The key for starting an inferior Lisp process, in Lisp mode, is now C-c C-z instead of C-c C-l. ** When the VC commands ask whether to save the buffer, if you say no, they signal an error. This is so that you won't operate on the wrong data. ** ISO Accents mode now supports `"s' as a way of typing German sharp s. ** By default, comint buffers (including Shell mode and debuggers) no longer try to scroll to keep the cursor on the bottom line. This feature was added in 19.21 but did not work smoothly enough. ** Emacs now handles the window manager "delete window" operation. ** Display of buffers with text properties is much faster now. ** The feature previously announced whereby `insert' does not inherit text properties from surrounding text was not fully implemented before; but now it is. use `insert-and-inherit' if you wish to inherit sticky properties from the surrounding text. ** The functions next-property-change, previous-property-change, next-single-property-change, and previous-single-property-change now take one additional optional argument LIMIT that is a position at which to stop scanning. If scan ends without finding the property change sought, these functions return the specified limit. The value returned by previous-single-property-change and previous-property-change, when they do find a change, is now one greater than what it used to be. It is the position between the two characters whose properties differ, which is one greater than the position of the first character found (while scanning back) with different properties. * User editing changes in version 19.21. ** ISO Accents mode supports four additional characters: A-with-ring (entered as /A), AE ligature (entered as /E), and their lower-case equivalents. * User editing changes in version 19.20. (See following page for Lisp programming changes.) Note that some of these changes were made subsequent to the Emacs 19.20 editions of the Emacs manual and Emacs Lisp manual; therefore, if you have those editions, do read this page. ** Dragging with mouse button 1 now puts the selected region in the kill ring so you can paste it into other X applications. ** Double and triple clicks with button 1 now behave as in xterm, selecting the word or line surrounding where you click. If you drag after the last click, you can select a range of words or lines. ** You can use button 3 to extend a mouse-selected region, as in xterm. This works for regions selected either by dragging Mouse-1 or by multiple-clicking Mouse-1. Clicking Mouse-3 moves the end of the region that is (initially) nearer to where you click. If the selection was first made by multiple-clicking Mouse-1, and thus consists of entire words or lines, Mouse-3 preserves that state. As before, clicking Mouse-3 again in the same place kills the region thus selected. ** The secondary selection commands, M-Mouse-1 and M-Mouse-3, have been likewise modified. ** You can now search for strings and regexps using the Edit menu bar menu. ** You can now access bookmarks using the Bookmark submenu in the File menu in the menu bar. ** ISO Accents mode, a buffer-local minor mode, provides a convenient way to type certain non-ASCII characters. It makes the characters `, ', ", ^, ~ and / serve as modifiers for the following letter. ` and ' add accents, " adds an umlaut or diaresis, ^ adds a circumflex, ~ adds a tilde, and / adds a slash to the following letter. If the following character is not a letter, or cannot be modified as requested, then both characters stand for themselves. If you duplicate the modifier accent character, that enters the corresponding ISO non-spacing accent character (thus, '' enters the ISO acute-accent character). To enter a modifier character itself, type it followed by a space. This feature can be used whenever a key sequence is expected: for ordinary insertion, for searching, and for certain command arguments. A few special combinations: ~c => c with cedilla ~d => d with stroke ~< => left guillemet ~> => right guillemet ** iso-transl.el is a new library that replaces iso-insert.el. It defines C-x 8 as an insertion prefix for the ISO characters between 128 and 255, much like iso-insert, except that iso-transl works even in searches and help commands--wherever a key sequence is expected. To define case-conversion for these characters for ISO 8859/1, load the library iso-syntax. (This is not new.) ** M-TAB in Text mode now runs the command ispell-complete-word which performs completion using the spelling dictionary. The spelling correction submenu now includes this command and another command which completes a word fragment (that is, it doesn't assume that the text to be completed starts at the beginning of a word. ** In incremental search, you can use M-y to yank the most recent kill into the search string. ** The new function ispell-message checks the spelling of a message you are about to send or post. It ignores text cited from other messages. To automatically check all your outgoing messages, include the following line in your .emacs file: (setq news-inews-hook (setq mail-send-hook 'ispell-message)) ** There is now a separate minibuffer history list for the names of extended commands. This history list is used by M-x when reading the command name. The motivation for this is to prevent command names from appearing in the history used for other minibuffer arguments. Note that the history list for entire commands that use the minibuffer is a separate feature. That history list records a command with all its arguments, and you must use C-x ESC ESC to access it. ** You can use the new command C-x v ~ VERSION RET to examine a specified version of a file that is maintained with version control. ** In Indented Text mode, only blank lines now separate paragraphs. Indented lines continue the paragraph that is in progress. This makes the user option variable adaptive-fill-mode have its intended effect. ** Local variable specifications in files for variables whose names end in `-hook' and `-function' are now controlled by the variable `enable-local-eval', just like the `eval' variable. ** C-x r j (jump-to-register) when restoring a frame configuration now makes all unwanted frames (existing frames not mentioned in the configuration) invisible. If you want to delete these unwanted frames, use a prefix argument for C-x r j. ** You can customize the calendar to display weeks beginning on Monday: set the variable `calendar-week-start-day' to 1. ** Rmail changes. If you save messages to a file in Unix format while viewing a message with its whole header, this now copies to the file the entire header of each message copied. ** Comint mode changes. C-c C-e shows as much output as possible in the window. C-c RET copies an old input (the one at point) and places the copy after the latest prompt. C-c C-p and C-c C-n move through the buffer, stopping at places where the subshell prompted for input. C-c C-h lists the input history in a `*Help*' buffer. There are new menu bar items for completion/input/output/signal commands. Input behaviour is configurable. Variables control whether some windows showing the buffer scroll to the bottom before insertion. These are `comint-scroll-to-bottom-on-input' and `before-change-function'. By default, insertion causes the selected window to scroll to the bottom before insertion occurs. Subprocess output now keeps point at the end of the buffer in each window individually if point was already at the end of the buffer in that window. If `comint-scroll-show-maximum-output' is non-nil (which is the default), then scrolling due to arrival of output tries to place the last line of text at the bottom line of the window, so as to show as much useful text as possible. (This mimics the scrolling behavior of many terminals.) By setting `comint-scroll-to-bottom-on-output', you can opt for having point jump to the end of the buffer whenever output arrives--no matter where in the buffer point was before. If the value is `this', point jumps in the selected window. If the value is `all', point jumps in each window that shows the comint buffer. If the value is `other', point jumps in all nonselected windows that show the current buffer. The default value is nil, which means point does not jump to the end. Input history insertion is configurable. A variable controls whether only the first instance of successive identical inputs is stored in the input history. This is `comint-input-ignoredups'. Completion (bound to TAB) is now more general. Depending on context, completion now operates on the input history, on command names, or (as before) on filenames. Filename completion is configurable. Variables control whether file/directory suffix characters are added (`comint-completion-addsuffix'), whether shortest completion is acceptable when no further unambiguous completion is possible (`comint-completion-recexact'), and the timing of completion candidate listing (`comint-completion-autolist'). Comint mode now provides history expansion. Insert input using `!' and `^', in the same syntax that typical shells use; then type TAB. This searches the comint input history for a matching element, performs substitution if necessary, and places the result in the comint buffer in place of the original input. History references in the input may be expanded before insertion into the input ring, or on input to the interpreter (and therefore visibly). The variable `comint-input-autoexpand' specifies which. You can make the SPC key perform history expansion by binding SPC to the command `comint-magic-space'. The command `comint-dynamic-complete-variable' does variable name completion using the environment variables as set within Emacs. The variables controlling filename completion apply to variable name completion too. This command is normally available through the menu bar. ** Shell mode Paragraph motion and marking commands (default bindings M-{, M-}, M-h) operate on output groups (i.e., shell prompt plus associated shell output). TAB now completes commands, as well as file names and expand history. Commands are searched for along the path that Emacs has on startup. C-c C-f now moves forward a command (`shell-forward-command') and C-c C-b now moves backward a command (`shell-backward-command'). Command completion is configurable. The variables controlling filename completion in comint mode apply, together with a variable controlling whether to restrict possible completions to only files that are executable (`shell-command-execonly'). The input history is initialised from the file name given in the variable `shell-input-ring-file-name'--normally `.history' in your home directory. Directory tracking is more robust. It can cope with command sequences and forked commands, and can detect the failure of directory changing commands in most circumstances. It's still not infallible, of course. You can now configure the behaviour of `pushd'. Variables control whether `pushd' behaves like `cd' if no argument is given (`shell-pushd-tohome'), pop rather than rotate with a numeric argument (`shell-pushd-dextract'), and only add directories to the directory stack if they are not already on it (`shell-pushd-dunique'). The configuration you choose should match the underlying shell, of course. * Emacs Lisp programming changes in Emacs 19.20. ** A new function `remove-hook' is now used to remove a hook that you might have added with `add-hook'. ** There is now a Lisp pretty-printer in the library `pp'. ** The partial Common Lisp support has been entirely reimplemented. ** When you insert text using `insert', `insert-before-markers' or `insert-buffer-substring', text properties are no longer inherited from the surrounding text. When you want to inherit text properties, use the new functions `insert-and-inherit' or `insert-before-markers-and-inherit'. The self-inserting character command does do inheritance. ** Frame creation hooks. The function make-frame now runs the normal hooks before-make-frame-hook and after-make-frame-hook. ** You can now use function-key-map to make a key an alias for other key sequences that can vary depending on circumstances. To do this, give the key a definition in function-key-map which is a function rather than a specific expansion key sequence. If the function reads input itself, it can have the effect of altering the event that follows. For example, here's how to define C-c h to turn the character that follows into a hyper character: (define-key function-key-map "\C-ch" 'hyperify) (defun hyperify (prompt) (let ((e (read-event))) (vector (if (numberp e) (logior (lsh 1 20) e) (if (memq 'hyper (event-modifiers e)) e (add-event-modifier "H-" e)))))) (defun add-event-modifier (string e) (let ((symbol (if (symbolp e) e (car e)))) (setq symbol (intern (concat string (symbol-name symbol)))) (if (symbolp e) symbol (cons symbol (cdr e))))) The character translation function gets one argument, which is the prompt that was specified in read-key-sequence--or nil if the key sequence is being read by the editor command loop. In most cases you can just ignore the prompt value. ** Changes for reading and writing text properties. New low-level Lisp features make it possible to write Lisp programs to save text properties in files, and read text properties from files. You can program any file format you like. The variable `write-region-annotation-functions' should contain a list of functions to be run by `write-region' to encode text properties in some fashion as annotations to the text that is written. Each function in the list is called with two arguments: the start and end of the region to be written. These functions should not alter the contents of the buffer. Instead, they should return lists indicating annotations to write in the file in addition to the text in the buffer. Each function should return a list of elements of the form (POSITION . STRING), where POSITION is an integer specifying the relative position in the text to be written, and STRING is the annotation to add there. Each list returned by one of these functions must be already sorted in increasing order by POSITION. If there is more than one function, `write-region' merges the lists destructively into one sorted list. When `write-region' actually writes the text from the buffer to the file, it intermixes the specified annotations at the corresponding positions. All this takes place without modifying the buffer. The variable `after-insert-file-functions' should contain a list of functions to be run each time a file's contents have been inserted into a buffer. Each function receives one argument, the length of the inserted text; point indicates the start of that text. The function should make whatever changes it wants to make, then return the updated length of the inserted text, as it stands after those changes. The value returned by one function is used as the argument to the next. These functions should always return with point at the beginning of the inserted text. The intended use of `after-insert-file-functions' is for converting some sort of textual annotations into actual text properties. But many other uses may be possible. We now invite users to begin implementing Lisp programs to store and retrieve text properties in files, using these new primitive features, and thus to experiment with various data formats and find good ones. We suggest not trying to handle arbitrary Lisp objects as property names or property values--because a program that general is probably difficult to write, and slow. Instead, choose a set of possible data types that are reasonably flexible, and not too hard to encode. ** Comint completion. Currently comint-dynamic-complete-command (and associated variable comint-after-partial-pathname-command) are set by default to complete a filename. Other comint-mode users should have their own functions to achieve this. For example, gud-mode could complete debugger commands. A completion function is provided solely for this reason (comint-dynamic-simple-complete). Other comint-mode users should bind comint-dynamic-complete (shell-mode does already). ** Comint history reference expansion Currently comint-input-autoexpand is 'history, which means only expand history on insertion to comint-input-ring. For non-shell modes, this is a strange default, since non-shells will not understand history references. Perhaps it would be better for the variable to be 'input, which means expand on RET. The value 'history might possibly be wrong even for shells, since the expansion will be done both by comint and the underlying shell (except sh, of course). It would be better for expansion to be done by one or the other, not both since they may (ahem) disagree. Since it is silly to put a literal history reference into comint-input-ring, perhaps it would be better for the variable to be 'input too. The reason the variable is not 'input by default is that I was attempting to adhere to The Principle of Least Astonishment. I didn't want to shock users by having their input change in front of their eyes. ** Argument delimiters and Comint mode. Currently comint-delimiter-argument-list is '(), which means no strings are to be treated as delimiters and arguments. In shell-mode, this variable is set to shell-delimiter-argument-list, '("|" "&" "<" ">" "(" ")" ";"). Other comint-mode users should set this variable too. For example, a lisp-type mode might want to set this to '("." "(" ")") or some such. ** Comint output hook. There is now a hook, comint-output-filter-hook, that is run-hooks'ed by the output filter, comint-output-filter. This is useful for scrolling (see below), but also things like processing output for specific text, output hilighting, etc. So that such output processing may be done efficiently, there is a new variable, comint-last-output-start, that records the position of the start of the lastest output inserted into the buffer (effectively the previous value of process-mark). Output processing functions should process the text between comint-last-output-start (or perhaps the beginning of the line that the position lies on) and process-mark. ** Comint scrolling. There is now automatic scrolling of process windows. Currently comint-scroll-show-maximum-output is t, which means when scrolling output put process-mark at the bottom of the window. There is a good case for it to be t, since the user is likely to want to see as much output as possible. But, then again, there is a comint-show-maximum-output command. ** Comint history retrieval. The input following point is not deleted when moving around the input history (with M-p etc.). Emacs maintainers may not like this. However, I feel this is a useful feature. The simple remedy is to put end-of-line in before delete-region in comint-previous-matching-input. The input history retrieval commands still wrap-around the input ring, unlike Emacs command history. * Changes in version 19.19. ** The new package bookmark.el records named bookmarks: positions that you can jump to. Bookmarks are saved automatically between Emacs sessions. ** Another simpler package saveplace.el records your position in each file when you kill its buffer (or kill Emacs), and jumps to the same position when you visit the file again (even in another Emacs session). Use `toggle-save-place' to turn on place-saving in a given file; use (setq-default save-place t) to turn it on for all files. ** In Outline mode, you can now customize how to compute the level of a heading line. Set `outline-level' to a function of no arguments which returns the level, assuming point is at the beginning of a heading line. ** You can now specify the prefix key to use for Outline minor mode. (The default is C-c.) Set the variable outline-minor-mode-prefix to the key sequence you want to use (as a string or vector). ** In Bibtex mode, C-c e has been changed to C-c C-b. This is because C-c followed by a letter is reserved for users. ** The `mod' function is no longer an alias for `%', but is a separate function that yields a result with the same sign as the divisor. `floor' now takes an optional second argument, which divides the first argument before the floor is taken. ** `%' no longer allows floating point arguments, since the results were often inconsistent with integer `%'. * Changes in version 19.18. ** Typing C-z in an iconified Emacs frame now deiconifies it. ** hilit19 is a new library for automatic highlighting of parts of the text in the buffer, based on its meaning and context. ** Killing no longer sends the killed text to the X clipboard. And large strings are not put in the cut buffer either. The variable x-cut-buffer-max specifies the maximum number of characters to put in the cut buffer. ** The new command C-x 5 o (other-frame) selects different frames, successively, in cyclic order. It does for frames what C-x o does for windows. ** The command M-ESC (eval-expression) has its own command history. ** The commands M-! and M-| for running shell commands have their own command history. ** If the directory containing the Emacs executable has a sibling named `lisp', that `lisp' directory is added to the end of `load-path' (provided you don't override the normal value with the EMACSLOADPATH environment variable). This feature may make it easier to move an installed Emacs from place to place. ** M-x validate-tex-buffer now records the locations of mismatches found in the `*Occur*' buffer. You can go to that buffer and type C-c C-c to visit a particular mismatch. ** There are new commands in Shell mode. C-c C-n and C-c C-p move point to the next or previous shell input line. C-c C-d is now another way to send an end-of-file to the subshell. ** Changes to calendar/diary. Time zone data is now determined automatically, including the start/stop days and times of daylight savings time. The code now works correctly almost anywhere in the world. The format of the holiday specifications has changed and IS NO LONGER COMPATIBLE with the old (version 18) format. See the documentation of the variable calendar-holidays for details of the new, improved format. The hook `diary-display-hook' has been split into two: diary-display-hook which should be used ONLY for the display and `diary-hook' which should be used for appointment notification. If diary-display-hook is nil (the default), simple-diary-display is used. This allows the diary hooks to be correctly set with add-hook. The forms used for dates in diary entries and general display are no longer autoloaded, but set at load time; this means they will be set correctly based on values you assign to various variables. ** The functions x-rebind-key and x-rebind-keys have been deleted, because you can accomplish the same job by binding keys to keyboard macros. ** Emacs now distinguishes double and triple drag events and double and triple button-down events. These work analogously to double and triple click events. Double drag events, if not defined, convert to ordinary click events. Double down events, if not defined, convert first to ordinary down events, which are then discarded if not defined. Triple events that are not defined convert to the corresponding double event; if that is also not defined, it may convert further. ** The new function event-click-count returns the number of clicks, from an event which is a list. It is 1 for an ordinary click, drag, or button-down event, 2 for a double event, and 3 or more for a triple event. ** The new function previous-frame is like next-frame, but moves around through the set of existing frames in the opposite order. ** The post-command-hook now runs even after commands that get an error and return to top level. As a consequence of the same change, this hook also runs before Emacs reads the first command. That might sound paradoxical, as if this hook were the same as the pre-command-hook. Actually, they are not similar; the latter runs before *execution* of a command, but after it has been read. ** You can turn off the text property hooks that run when point moves to certain places in the buffer, by binding inhibit-point-motion-hooks to a non-nil value. ** Inserting a string with no text properties into the buffer normally inherits the properties of the preceding character. You can now control this inheritence by setting the front-sticky and rear-nonsticky properties of a character. If you make a character's front-sticky property t, then insertion before the character inherits its properties. If you make the rear-nonsticky property t, then insertion after the character does not inherit its properties. You can regard characters as normally being rear-sticky and not front-sticky, and this is why insertion normally inherits from the previous character. If neither side of an insertion is suitably sticky, then the inserted text gets no properties. If both sides are sticky, then the inserted text gets the properties of both sides, with the previous character's properties taking precedence when both sides have a property in common. You can also specify stickiness for individual properties. To do so, use a list of property names as the value of the front-sticky property or the rear-nonsticky property. For example, if a character has a rear-nonsticky property whose value is (face read-only), then insertion after the character will not inherit its face property or read-only property (if any), but will inherit any other properties. The merging of properties when both sides of the insertion are sticky takes place one property at a time. If the preceding character is rear-sticky for the property, and the property is non-nil, it dominates. Otherwise, the following character's property value is used if it is front-sticky for that property. ** If you give a character a non-nil `invisible' text property, the character does not appear on the screen. This works much like selective display. The details of this feature are likely to change in future Emacs versions. ** In Info, when you go to a node, it runs the normal hook Info-selection-hook. ** You can use the new function `invocation-directory' to get the name of the directory containing the Emacs executable that was run. ** Entry to the minibuffer runs the normal hook minibuffer-setup-hook. ** The new function minibuffer-window-active-p takes one argument, a minibuffer window, and returns t if the window is currently active. * Changes in version 19.17. ** 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 more consistent with the incremental search facility, which uses RET to end the search. ** In C mode, C-c C-u now runs c-up-conditional. C-c C-n and C-c C-p now run new commands that move forward and back over balanced sets of C conditionals (c-forward-conditional and c-backward-conditional). ** The Edit entry in the menu bar has a new alternative: "Choose Next Paste". It gives you a menu showing the various strings in the kill ring; click on one to select it as the text 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 all the time; commands that use the region can be used even if the region highlighting turns off. ** If you type C-h after a prefix key, it displays the bindings that start with that prefix. ** The VC package now searches for version control commands in the directories named by the variable `vc-path'; its value should be a 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 underlines or highlights the matching paren whenever point is next to the outside of a paren. When point is before an open-paren, this shows the matching close; when point is after a close-paren, this shows the matching open. ** The new function `define-key-after' is like `define-key', but takes an extra argument AFTER. It places the newly defined binding after the binding for the event AFTER. ** `accessible-keymaps' now takes an optional second argument, PREFIX. If PREFIX is non-nil, it means the value should include only maps for keys that start with PREFIX. `describe-bindings' also accepts an optional argument PREFIX which means to describe only the keys that start with PREFIX. ** The variable `prefix-help-command' hold a command to run to display help whenever the character `help-char' follows a prefix key and does not have a key binding in that context. ** Emacs now detects double- and triple-mouse clicks. A single mouse click produces a pair events of the form: (down-mouse-N POSITION) (mouse-N POSITION) Clicking the same mouse button again, soon thereafter and at the same location, produces another pair of events of the form: (down-mouse-N POSITION) (double-mouse-N POSITION 2) Another click will produce an event pair of the form: (down-mouse-N POSITION) (triple-mouse-N POSITION 3) All the POSITIONs in such a sequence would be identical, except for their timestamps. To count as double- and triple-clicks, mouse clicks must be at the same location as the first click, and the number of milliseconds between the first release and the second must be less than the value of the lisp variable `double-click-time'. Setting `double-click-time' to nil disables multi-click detection. Setting it to t removes the time limit; Emacs then detects multi-clicks by position only. If `read-key-sequence' finds no binding for a double-click event, but the corresponding single-click event would be bound, `read-key-sequence' demotes it to a single-click. Similarly, it demotes unbound triple-clicks to double- or single-clicks. This means you don't have to distinguish between single- and multi-clicks if you don't want to. Emacs reports all clicks after the third as `triple-mouse-N' clicks, but increments the click count after POSITION. For example, a fourth click, soon after the third and at the same location, produces a pair of events of the form: (down-mouse-N POSITION) (triple-mouse-N POSITION 4) ** The way Emacs reports positions of mouse events has changed slightly. If a mouse event includes a position list of the form: (WINDOW (PLACE-SYMBOL) (COLUMN . ROW) TIMESTAMP) this denotes exactly the same position as the list: (WINDOW PLACE-SYMBOL (COLUMN . ROW) TIMESTAMP) That is, the event occurred over a non-textual area of the frame, specified by PLACE-SYMBOL, a symbol like `mode-line' or `vertical-scroll-bar'. Enclosing PLACE-SYMBOL in a singleton list does not change the position denoted, but the `read-key-sequence' function uses the presence or absence of the singleton list to tell whether or not it should prefix the event with its place symbol. Normally, `read-key-sequence' prefixes mouse events occuring over non-textual areas with their PLACE-SYMBOLs, to select the sub-keymap appropriate for the event; for example, clicking on the mode line produces a sequence like [mode-line (mouse-1 POSN)] However, if lisp code elects to unread the resulting key sequence by placing it in the `unread-command-events' variable, it is important that `read-key-sequence' not insert the prefix symbol again; that would produce a malformed key sequence like [mode-line mode-line (mouse-1 POSN)] For this reason, `read-key-sequence' encloses the event's PLACE-SYMBOL in a singleton list when it first inserts the prefix, but doesn't insert the prefix when processing events whose PLACE-SYMBOLs are already thus enclosed. * Changes in version 19.15. ** `make-frame-visible', which uniconified frames, is now a command, and thus may be bound to a key. This makes sense because frames respond to user input while iconified. ** You can now use Meta mouse clicks to set and use the "secondary selection". You can drag M-Mouse-1 across the region you want to select. Or you can press M-Mouse-1 at one end and M-Mouse-3 at the other (this also copies the text to the kill ring). Repeating M-Mouse-3 again at the same place kills that text. M-Mouse-2 kills the secondary selection. Setting the secondary selection does not move point or the mark. It is possible to make a secondary selection that does not all fit on the screen, by using M-Mouse-1 at one end, scrolling, then using M-Mouse-3 at the other end. Emacs has only one secondary selection at any time. Starting to set a new one cancels any previous one. The secondary selection displays using a face named `secondary-selection'. ** There's a new way to request use of Supercite (sc.el). Do this: (add-hook 'mail-citation-hook 'sc-cite-original) Currently this works with Rmail. In the future, other Emacs based mail-readers should be modified to understand this hook also. In the mean time, you should keep doing what you have done in the past for those other mail readers. ** When a regular expression contains `\(...\)' inside a repetition operator such as `*' or `+', and you ask about the range that was matched using `match-beginning' and `match-end', the range you get corresponds to the *last* repetition *only*. In Emacs 18, you would get a range corresponding to all the repetitions. If you want to get a range corresponding to all the repetitions, put a `\(...\)' grouping *outside* the repetition operator. This is the syntax that corresponds logically to the desired result, and it works the same in Emacs 18 and Emacs 19. (This change actually took place earlier, but we didn't know about it and thus didn't document it.) * Changes in version 19.14. ** To modify read-only text, bind the variable `inhibit-read-only' to a non-nil value. If the value is t, then all reasons that might make text read-only are inhibited (including `read-only' text properties). If the value is a list, then a `read-only' property is inhibited if it is `memq' in the list. ** If you call `get-buffer-window' passing t as its second argument, it will only search for windows on visible frames. Previously, passing t as the secord argument caused `get-buffer-window' to search all frames, visible or not. ** If you call `other-buffer' with a nil or omitted second argument, it will ignore buffers displayed windows on any visible frame, not just the selected frame. ** You can specify a window or a frame for C-x # to use when selects a server buffer. Set the variable server-window to the window or frame that you want. ** The command M-( now inserts spaces outside the open-parentheses in some cases--depending on the syntax classes of the surrounding characters. If the variable `parens-dont-require-spaces' is non-nil, it inhibits insertion of these spaces. ** The GUD package now supports the debugger known as xdb on HP/UX systems. Use M-x xdb. The variable `gud-xdb-directories' lets you specify a list of directories to search for source code. ** If you are using the mailabbrev package, you should note that its function for defining an alias is now called `define-mail-abbrev'. This package no longer contains a definition for `define-mail-alias'; that name is used only in mailaliases. ** Inserted characters now inherit the properties of the text before them, by default, rather than those of the following text. ** The function `insert-file-contents' now takes optional arguments BEG and END that specify which part of the file to insert. BEG defaults to 0 (the beginning of the file), and END defaults to the end of the file. If you specify BEG or END, then the argument VISIT must be nil. * Changes in version 19.13. ** Magic file names can now handle the `load' operation. ** Bibtex mode now sets up special entries in the menu bar. ** The incremental search commands C-w and C-y, which copy text from the buffer into the search string, now convert it to lower case if you are in a case-insensitive search. This is to avoid making the search a case-sensitive one. ** GNUS now knows your time zone automatically if Emacs does. ** Hide-ifdef mode no longer defines keys of the form C-c LETTER, since those keys are reserved for users. Those commands have been moved to C-c M-LETTER. We may move them again for greater consistency with other modes. * Changes in version 19.12. ** You can now make many of the sort commands ignore case by setting `sort-fold-case' to a non-nil value. * Changes in version 19.11. ** Supercite is installed. ** `write-file-hooks' functions that return non-nil are responsible for making a backup file if you want that to be done. To do so, execute the following code: (or buffer-backed-up (backup-buffer)) You might wish to save the file modes value returned by `backup-buffer' and use that to set the mode bits of the file that you write. This is what `basic-save-buffer' does when it writes a file in the usual way. (This is not actually new, but wasn't documented before.) * Changes in version 19.10. ** The command `repeat-complex-command' is now on C-x ESC ESC. It used to be bound to C-x ESC. The reason for this change is to make function keys work after C-x. ** The variable `highlight-nonselected-windows' now controls whether the region is highlighted in windows other than the selected window (in Transient Mark mode only, of course, and currently only when using X). * Changes in version 19.8. ** It is now simpler to tell Emacs to display accented characters under X windows. M-x standard-display-european toggles the display of buffer text according to the ISO Latin-1 standard. With a prefix argument, this command enables European character display iff the argument is positive. ** The `-i' command-line argument tells Emacs to use a picture of the GNU gnu as its icon, instead of letting the window manager choose an icon for it. This option used to insert a file into the current buffer; use `-insert' to do that now. ** The `configure' script now supports `--prefix' and `--exec-prefix' options. The `--prefix=PREFIXDIR' option specifies where the installation process should put emacs and its data files. This defaults to `/usr/local'. - Emacs (and the other utilities users run) go in PREFIXDIR/bin (unless the `--exec-prefix' option says otherwise). - The architecture-independent files go in PREFIXDIR/lib/emacs/VERSION (where VERSION is the version number of Emacs, like `19.7'). - The architecture-dependent files go in PREFIXDIR/lib/emacs/VERSION/CONFIGURATION (where CONFIGURATION is the configuration name, like mips-dec-ultrix4.2), unless the `--exec-prefix' option says otherwise. The `--exec-prefix=EXECDIR' option allows you to specify a separate portion of the directory tree for installing architecture-specific files, like executables and utility programs. If specified, - Emacs (and the other utilities users run) go in EXECDIR/bin, and - The architecture-dependent files go in EXECDIR/lib/emacs/VERSION/CONFIGURATION. EXECDIR/bin should be a directory that is normally in users' PATHs. ** When running under X Windows, the new lisp function `x-list-fonts' allows code to find out which fonts are available from the X server. The first argument PATTERN is a string, perhaps with wildcard characters; the * character matches any substring, and the ? character matches any single character. PATTERN is case-insensitive. If the optional arguments FACE and FRAME are specified, then `x-list-fonts' returns only fonts the same size as FACE on FRAME. * Changes in version 19. ** When you kill buffers, Emacs now returns memory to the operating system, thus reducing the size of the Emacs process. All the space that you free up by killing buffers can now be reused for other buffers no matter what their sizes, or reused by other processes if Emacs doesn't need it. ** Emacs now does garbage collection and auto saving while it is waiting for input, which often avoids the need to do these things while you are typing. The variable `auto-save-timeout' says how many seconds Emacs should wait, after you stop typing, before it does an auto save and a garbage collection. ** If auto saving detects that a buffer has shrunk greatly, it refrains from auto saving that buffer and displays a warning. Now it also turns off Auto Save mode in that buffer, so that you won't get the same warning again. If you reenable Auto Save mode in that buffer, Emacs will start saving it again with no further warnings. ** A new minor mode called Line Number mode displays the current line number in the mode line, updating it as necessary when you move point. However, if the buffer is very large (larger than the value of `line-number-display-limit'), then the line number doesn't appear. This is because computing the line number can be painfully slow if the buffer is very large. ** You can quit while Emacs is waiting to read or write files. ** The arrow keys now have default bindings to move in the appropriate directions. ** You can suppress next-line's habit of inserting a newline when called at the end of a buffer by setting next-line-add-newlines to nil (it defaults to t). ** You can now get back recent minibuffer inputs conveniently. While in the minibuffer, type M-p to fetch the next earlier minibuffer input, and use M-n to fetch the next later input. There are also commands to search forward or backward through the history for history elements that match a regular expression. M-r searches older elements in the history, while M-s searches newer elements. By special dispensation, these commands can always use the minibuffer to read their arguments even though you are already in the minibuffer when you issue them. The history feature is available for all uses of the minibuffer, but there are separate history lists for different kinds of input. For example, there is a list for file names, used by all the commands that read file names. There is a list for arguments of commands like `query-replace'. There are also very specific history lists, such as the one that `compile' uses for compilation commands. ** You can now display text in a mixture of fonts and colors, using the "face" feature, together with the overlay and text property features. See the Emacs Lisp manual for details. The Emacs Users Manual describes how to change the colors and font of standard predefined faces. ** You can refer to files on other machines using special file name syntax: /HOST:FILENAME /USER@HOST:FILENAME When you do this, Emacs uses the FTP program to read and write files on the specified host. It logs in through FTP using your user name or the name USER. It may ask you for a password from time to time; this is used for logging in on HOST. ** Some C-x key bindings have been moved onto new prefix keys. C-x r is a prefix for registers and rectangles. C-x n is a prefix for narrowing. C-x a is a prefix for abbrev commands. C-x r C-SPC C-x r SPC point-to-register (Was C-x /) C-x r j jump-to-register (Was C-x j) C-x r s copy-to-register (Was C-x x) C-x r i insert-register (Was C-x g) C-x r r copy-rectangle-to-register (Was C-x r) C-x r k kill-rectangle C-x r y yank-rectangle C-x r o open-rectangle C-x r f frame-configuration-to-register (This saves the state of all windows in all frames.) C-x r w window-configuration-to-register (This saves the state of all windows in the selected frame.) (Use C-x r j to restore a configuration saved with C-x r f or C-x r w.) C-x n n narrow-to-region (Was C-x n) C-x n p narrow-to-page (Was C-x p) C-x n w widen (Was C-x w) C-x a l add-mode-abbrev (Was C-x C-a) C-x a g add-global-abbrev (Was C-x +) C-x a i l inverse-add-mode-abbrev (Was C-x C-h) C-x a i g inverse-add-global-abbrev (Was C-x -) C-x a e expand-abbrev (Was C-x ') (The old key bindings C-x /, C-x j, C-x x and C-x g have not yet been removed.) ** You can put a file name in a register to be able to visit the file quickly. Do this: (set-register ?CHAR '(file . NAME)) where NAME is the file name as a string. Then C-x r j CHAR finds that file. This is useful for files that you need to visit frequently, but that you don't want to keep in buffers all the time. ** The keys M-g (fill-region) and C-x a (append-to-buffer) have been eliminated. ** The new command `string-rectangle' inserts a specified string on each line of the region-rectangle. ** C-x 4 r is now `find-file-read-only-other-window'. ** C-x 4 C-o is now `display-buffer', which displays a specified buffer in another window without selecting it. ** Picture mode has been substantially improved. The picture editing commands now arrange for automatic horizontal scrolling to keep point visible when editing a wide buffer with truncate-lines on. Picture-mode initialization now does a better job of rebinding standard commands; it finds not just their normal keybindings, but any function keys attached to them. ** If you enable Transient Mark mode, then the mark becomes "inactive" after every command that modifies the buffer. While the mark is active, the region is highlighted (under X, at least). Most commands that use the mark give an error if the mark is inactive, but you can use C-x C-x to make it active again. This feature is also sometimes known as "Zmacs mode". ** Outline mode is now available as a minor mode. This minor mode can combine with any major mode; it substitutes the C-c commands of Outline mode for those of the major mode. Use M-x outline-minor-mode to enable and disable the new mode. M-x outline-mode is unchanged; it still switches to Outline mode as a major mode. ** The default setting of `version-control' comes from the environment variable VERSION_CONTROL. ** The user option for controlling whether files can set local variables is now called `enable-local-variables'. A value of t means local-variables lists are obeyed; nil means they are ignored; anything else means query the user. The user option for controlling use of the `eval' local variable is now called is `enable-local-eval'; its values are interpreted like those of `enable-local-variables'. ** X Window System changes: C-x 5 C-f and C-x 5 b switch to a specified file or buffer in a new frame. Likewise, C-x 5 m starts outgoing mail in another frame, and C-x 5 . finds a tag in another frame. When you are using X, C-z now iconifies the selected frame. Emacs can now exchange text with other X applications. Killing or copying text in Emacs now makes that text available for pasting into other X applications. The Emacs yanking commands now insert the latest selection set by other applications, and add the text to the kill ring. The Emacs commands for selecting and inserting text with the mouse now use the kill ring in the same way the keyboard killing and yanking commands do. The option to specify the title for the initial frame is now `-name NAME'. There is currently no way to specify an icon title; perhaps we will add one in the future. ** Undoing a deletion now puts point back where it was before the deletion. ** The variables that control how much undo information to save have been renamed to `undo-limit' and `undo-strong-limit'. They used to be called `undo-threshold' and `undo-high-threshold'. ** You can now use kill commands in read-only buffers. They don't actually change the buffer, and Emacs will beep and warn you that the buffer is read-only, but they do copy the text you tried to kill into the kill ring, so you can yank it into other buffers. ** C-o inserts the fill-prefix on the newly created line. The command M-^ deletes the prefix (if it occurs) after the newline that it deletes. ** C-M-l now runs the command `reposition-window'. It scrolls the window heuristically in a way designed to get useful information onto the screen. ** C-M-r is now reverse incremental regexp search. ** M-z now kills through the target character. In version 18, it killed up to but not including the target character. ** M-! now runs the specified shell command asynchronously if it ends in `&' (just as the shell does). ** C-h C-f and C-h C-k are new help commands that display the Info node for a given Emacs function name or key sequence, respectively. ** The C-h p command system lets you find Emacs Lisp packages by topic keywords. Here is a partial list of package categories: abbrev abbreviation handling, typing shortcuts, macros bib code related to the bib bibliography processor c C and C++ language support calendar calendar and time management support comm communications, networking, remote access to files docs support for Emacs documentation emulations emulations of other editors extensions Emacs Lisp language extensions games games, jokes and amusements hardware support for interfacing with exotic hardware help support for on-line help systems i14n internationalization and alternate character-set support internal code for Emacs internals, build process, defaults languages specialized modes for editing programming languages lisp Lisp support, including Emacs Lisp local code local to your site maint maintenance aids for the Emacs development group mail modes for electronic-mail handling news support for netnews reading and posting processes process, subshell, compilation, and job control support terminals support for terminal types tex code related to the TeX formatter tools programming tools unix front-ends/assistants for, or emulators of, UNIX features vms support code for vms wp word processing More will be added soon. ** The command to split a window into two side-by-side windows is now C-x 3. It was C-x 5. ** M-. (find-tag) no longer has any effect on what M-, will do subsequently. You can no longer use M-, to find the next similar tag; you must use M-. with a prefix argument, instead. The motive for this change is so that you can more reliably use M-, to resume a suspended `tags-search' or `tags-query-replace'. ** C-x s (`save-some-buffers') now gives you more options when it asks whether to save a particular buffer. In addition to `y' or `n', you can answer `!' to save all the remaining buffers, `.' to save this buffer but not save any others, ESC to stop saving and exit the command, and C-h to get help. These options are analogous to those of `query-replace'. ** M-x make-symbolic-link does not expand its first argument. This lets you make a link with a target that is a relative file name. ** M-x add-change-log-entry and C-x 4 a now automatically insert the name of the file and often the name of the function that you changed. They also handle grouping of entries. There is now a special major mode for editing ChangeLog files. It makes filling work conveniently. Each bunch of grouped entries is one paragraph, and each collection of entries from one person on one day is considered a page. ** The `comment-region' command adds comment delimiters to the lines that start in the region, thus commenting them out. With a negative argument, it deletes comment delimiters from the lines in the region--this cancels the effect of `comment-region' without an argument. With a positive argument, `comment-region' adds comment delimiters but duplicates the last character of the comment start sequence as many times as the argument specifies. This is a way of calling attention to the comment. In Lisp, you should use an argument at least two, because the indentation convention for single semicolon comments does not leave them at the beginning of a line. ** If `split-window-keep-point' is non-nil, C-x 2 tries to avoid shifting any text on the screen by putting point in whichever window happens to contain the screen line the cursor is already on. The default is that `split-window-keep-point' is non-nil on slow terminals. ** M-x super-apropos is like M-x apropos except that it searches both Lisp symbol names and documentation strings for matches. It describes every symbol that has a match in either the symbol's name or its documentation. Both M-x apropos and M-x super-apropos take an optional second argument DO-ALL which controls the more expensive part of the job. This includes looking up and printing the key bindings of all commands. It also includes checking documentation strings in super-apropos. DO-ALL is nil by default; use a prefix arg to make it non-nil. ** M-x revert-buffer no longer offers to revert from a recent auto-save file unless you give it a prefix argument. Otherwise it always reverts from the real file regardless of whether there has been an auto-save since thenm. (Reverting from the auto-save file is no longer very useful now that the undo capacity is larger.) ** M-x recover-file no longer turns off Auto Save mode when it reads the last Auto Save file. ** M-x rename-buffer, if you give it a prefix argument, avoids errors by modifying the new name to make it unique. ** M-x rename-uniquely renames the current buffer to a similar name with a numeric suffix added to make it both different and unique. One use of this command is for creating multiple shell buffers. If you rename your shell buffer, and then do M-x shell again, it makes a new shell buffer. This method is also good for mail buffers, compilation buffers, and any Emacs feature which creates a special buffer with a particular name. ** M-x compare-windows with a prefix argument ignores changes in whitespace. If `compare-ignore-case' is non-nil, then differences in case are also ignored. ** `backward-paragraph' is now bound to M-{ by default, and `forward-paragraph' to M-}. Originally, these commands were bound to M-[ and M-], but they were running into conflicts with the use of function keys. On many terminals, function keys send a sequence beginning ESC-[, so many users have defined this as a prefix key. ** C-x C-u (upcase-region) and C-x C-l (downcase-region) are now disabled by default; these commands seem to be often hit by accident, and can be quite destructive if their effects are not noticed immediately. ** The function `erase-buffer' is now interactive, but disabled by default. ** When visiting a new file, Emacs attempts to abbreviate the file's path using the symlinks listed in `directory-abbrev-alist'. ** When you visit the same file in under two names that translate into the same name once symbolic links are handled, Emacs warns you that you have two buffers for the same file. ** If you wish to avoid visiting the same file in two buffers under different names, set the variable `find-file-existing-other-name' non-nil. Then `find-file' uses the existing buffer visiting the file, no matter which of the file's names you specify. ** If you set `find-file-visit-truename' non-nil, then the file name recorded for a buffer is the file's truename (in which all symbolic links have been removed), rather than the name you specify. Setting `find-file-visit-truename' also implies the effect of `find-file-existing-other-name'. ** C-x C-v now inserts the entire current file name in the minibuffer. This is convenient if you made a small mistake in typing it. Point goes after the last slash, before the last file name component, so if you want to replace it entirely, you can use C-k right away to delete it. ** Commands such as C-M-f in Lisp mode now ignore parentheses within comments. ** C-x q now uses ESC to terminate all iterations of the keyboard macro, rather than C-d as before. ** Use the command `setenv' to set an individual environment variable for Emacs subprocesses. Specify a variable name and a value, both as strings. This command applies only to subprocesses yet to be started. ** Use `rot13-other-window' to examine a buffer with rot13. This command does not change the text in the buffer. Instead, it creates a window with a funny display table that applies the code when displaying the text. ** The command `M-x version' now prints the current Emacs version; The `version' command is an alias for the `emacs-version' command. ** More complex changes in existing packages. *** `fill-nonuniform-paragraphs' is a new command, much like `fill-individual-paragraphs' except that only separator lines separate paragraphs. Since this means that the lines of one paragraph may have different amounts of indentation, the fill prefix used is the smallest amount of indentation of any of the lines of the paragraph. *** Filling is now partially controlled by a new minor mode, Adaptive Fill mode. When this mode is enabled (and it is enabled by default), if you use M-x fill-region-as-paragraph on an indented paragraph and you don't have a fill prefix, it uses the indentation of the second line of the paragraph as the fill prefix. Adaptive Fill mode doesn't have much effect on M-q in most major modes, because an indented line will probably count as a paragraph starter and thus each line of an indented paragraph will be considered a paragraph of its own. *** M-q in C mode now runs `c-fill-paragraph', which is designed for filling C comments. (We assume you don't want to fill the code in a C program.) *** M-$ now runs the Ispell program instead of the Unix spell program. M-$ starts an Ispell process the first time you use it. But the process stays alive, so that subsequent uses of M-$ run very fast. If you want to get rid of the process, use M-x kill-ispell. To check the entire current buffer, use M-x ispell-buffer. Use M-x ispell-region to check just the current region. Ispell commands often involve interactive replacement of words. You can interrupt the interactive replacement with C-g. You can restart it again afterward with C-u M-$. During interactive replacement, you can type the following characters: a Accept this word this time. DIGIT Replace the word (this time) with one of the displayed near-misses. The digit you use says which near-miss to use. i Insert this word in your private dictionary so that Ispell will consider it correct it from now on. r Replace the word this time with a string typed by you. When the Ispell process starts, it reads your private dictionary which is the file `~/ispell.words'. If you "insert" words with the `i' command, these words are added to that file, but not right away--only at the end of the interactive replacement process. Use M-x reload-ispell to reload your private dictionary from `~/ispell.words' if you edit it outside of Ispell. ** Changes in existing modes. *** gdb-mode has been replaced by gud-mode. The package gud.el (Grand Unified Debugger) replaces gdb.el in Emacs 19. It provides a gdb.el-like interface to any of three debuggers; gdb itself, the sdb debugger supported on some Unix systems, or the dbx debugger on Berkeley systems. You start it up with one of the commands M-x gdb, M-x sdb, or M-x dbx. Each entry point finishes by executing a hook; gdb-mode-hook, sdb-mode-hook or dbx-mode-hook respectively. These bindings have changed: C-x C-a > gud-down (was M-d) C-x C-a < gud-up (was M-u) C-x C-a C-r gud-cont (was M-c) C-x C-a C-n gud-next (was M-n) C-x C-a C-s gud-step (was M-s) C-x C-a C-i gud-stepi (was M-i) C-x C-a C-l gud-recenter (was C-l) C-d comint-delchar-or-maybe-eof (was C-c C-d) These bindings have been removed: C-c C-r (was comint-show-output; now gud-cont) Since GUD mode uses comint, it uses comint's input history commands, superseding C-c C-y (copy-last-shell-input): M-p comint-next-input M-n comint-previous-input M-r comint-previous-similar-input M-s comint-next-similar-input M-C-r comint-previous-input-matching The C-x C-a bindings are also active in source files. *** The old TeX mode bindings of M-{ and M-} have been moved to C-c { and C-c }. (These commands are `up-list' and `tex-insert-braces'; they are the TeX equivalents of M-( and M-).) This is because M-{ and M-} are now globally defined commands. *** Changes in Mail mode. `%' is now a word-separator character in Mail mode. `mail-signature', if non-nil, tells M-x mail to insert your `.signature' file automatically. If you don't want your signature in a particular message, just delete it before you send the message. You can specify the text to insert at the beginning of each line when you use C-c C-y to yank the message you are replying to. Set `mail-yank-prefix' to the desired string. A value of `nil' (the default) means to use indentation, as in Emacs 18. If you use just C-u as the prefix argument to C-c C-y, then it does not insert anything at the beginning of the lines, regardless of the value of `mail-yank-prefix'. If you like, you can expand mail aliases as abbrevs, as soon as you type them in. To enable this feature, execute the following: (add-hook 'mail-setup-hook 'mail-abbrevs-setup) This can go in your .emacs file. Word abbrevs don't expand unless you insert a word-separator character afterward. Any mail aliases that you didn't expand at insertion time are expanded subsequently when you send the message. *** Changes in Rmail. Rmail by default gets new mail only from the system inbox file, not from `~/mbox'. In Rmail, you can retry sending a message that failed by typing `M-m' on the failure message. By contrast, another new command M-x rmail-resend is used for forwarding a message and marking it as "resent from" you with header fields "Resent-From:" and "Resent-To:". `e' is now the command to edit a message. To expunge, type `x'. We know this will surprise people some of the time, but the surprise will not be disastrous--if you type `e' meaning to expunge, just turn off editing with C-c C-c and then type `x'. Another new Rmail command is `<', which moves to the first message. This is for symmetry with `>'. Use the `b' command to bury the Rmail buffer and its summary buffer, if any, removing both of them from display on the screen. The variable `rmail-output-file-alist' now controls the default for the file to output a message to. In the Rmail summary buffer, all cursor motion commands select the message you move to. It's really neat when you use incremental search. You can now issue most Rmail commands from an Rmail summary buffer. The commands do the same thing in that buffer that they do in the Rmail buffer. They apply to the message that is selected in the Rmail buffer, which is always the one described by the current summary line. Conversely, motion and deletion commands in the Rmail buffer also update the summary buffer. If you set the variable `rmail-redisplay-summary' to a non-nil value, then they bring the summary buffer (if one exists) back onto the screen. C-M-t is a new command to make a summary by topic. It uses regexp matching against just the subjects of the messages to decide which messages to show in the summary. You can easily convert an Rmail file to system mailbox format with the command `unrmail'. This command reads two arguments, the name of the Rmail file to convert, and the name of the new mailbox file. (This command does not change the Rmail file itself.) Rmail now handles Content Length fields in messages. *** `mail-extract-address-components' unpacks mail addresses. It takes an address as a string (the contents of the From field, for example) and returns a list of the form (FULL-NAME CANONICAL-ADDRESS). *** Changes in C mode and C-related commands. **** M-x c-up-conditional In C mode, `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, this command moves forward to the end of the containing preprocessor conditional. When going backwards, `#elif' acts like `#else' followed by `#if'. When going forwards, `#elif' is ignored. **** In C mode, M-a and M-e are now defined as `c-beginning-of-statement' and `c-end-of-statement'. **** In C mode, M-x c-backslash-region is a new command to insert or align `\' characters at the ends of the lines of the region, except for the last such line. This is useful after writing or editing a C macro definition. If a line already ends in `\', this command adjusts the amount of whitespace before it. Otherwise, it inserts a new `\'. *** New features in info. When Info looks for an Info file, it searches the directories in `Info-directory-list'. This makes it easy to install the Info files that come with various packages. You can specify the path with the environment variable INFOPATH. There are new commands in Info mode. `]' now moves forward a node, going up and down levels as needed. `[' is similar but moves backward. These two commands try to traverse the entire Info tree, node by node. They are the equivalent of reading a printed manual sequentially. `<' moves to the top node of the current Info file. `>' moves to the last node of the file. SPC scrolls through the current node; at the end, it advances to the next node in depth-first order (like `]'). DEL scrolls backwards in the current node; at the end, it moves to the previous node in depth-first order (like `['). After a menu select, the info `up' command now restores point in the menu. The combination of this and the previous two changes means that repeated SPC keystrokes do the right (depth-first traverse forward) thing. `i STRING RET' moves to the node associated with STRING in the index or indices of this manual. If there is more than one match for STRING, the `i' command finds the first match. `,' finds the next match for the string in the previous `i' command If you click the middle mouse button near a cross-reference, menu item or node pointer while in Info, you will go to the node which is referenced. *** Changes in M-x compile. You can repeat any previous compilation command conveniently using the minibuffer history commands, while in the minibuffer entering the compilation command. While a compilation is going on, the string `Compiling' appears in the mode line. When this string disappears, that tells you the compilation is finished. The buffer of compiler messages is in Compilation mode. This mode provides the keys SPC and DEL to scroll by screenfuls, and M-n and M-p to move to the next or previous error message. You can also use C-c C-c on any error message to find the corresponding source code. Emacs 19 has a more general parser for compiler messages. For example, it can understand messages from lint, and from certain C compilers whose error message format is unusual. Also, it only parses until it sees the error message you want; you never have to wait a long time to see the first error, no matter how big the buffer is. *** M-x diff and M-x diff-backup. This new command compares two files, displaying the differences in an Emacs buffer. The options for the `diff' program come from the variable `diff-switches', whose value should be a string. The buffer of differences has Compilation mode as its major mode, so you can use C-x ` to visit successive changed locations in the two source files, or you can move to a particular hunk of changes and type C-c C-c to move to the corresponding source. You can also use the other special commands of Compilation mode: SPC and DEL for scrolling, and M-n and M-p for cursor motion. M-x diff-backup compares a file with its most recent backup. If you specify the name of a backup file, `diff-backup' compares it with the source file that it is a backup of. *** The View commands (such as M-x view-buffer and M-x view-file) no longer use recursive edits; instead, they switch temporarily to a different major mode (View mode) specifically designed for moving around through a buffer without editing it. *** Changes in incremental search. **** The character to terminate an incremental search is now RET. This is for compatibility with the way most other arguments are read. To search for a newline in an incremental search, type LFD (also known as C-j). **** Incremental search now maintains a ring of previous search strings. Use M-p and M-n to move through the ring to pick a search string to reuse. These commands leave the selected search ring element in the minibuffer, where you can edit it. Type C-s or C-r to finish editing and search for the chosen string. **** If you type an upper case letter in incremental search, that turns off case-folding, so that you get a case-sensitive search. **** If you type a space during regexp incremental search, it matches any sequence of whitespace characters. If you want to match just a space, type C-q SPC. **** Incremental search is now implemented as a major mode. When you type C-s, it switches temporarily to a different keymap which defines each key to do what it ought to do for incremental search. This has next to no effect on the user-visible behavior of searching, but makes it easier to customize that behavior. Emacs 19 eliminates the old variables `search-...-char' that used to be the way to specify the characters to use for various special purposes in incremental search. Instead, you can define the meaning of a character in incremental search by modifying `isearch-mode-map'. *** New commands in Buffer Menu mode. The command C-o now displays the current line's buffer in another window but does not select it. This is like the existing command `o' which selects the current line's buffer in another window. The command % toggles the read-only flag of the current line's buffer. The way to switch to a set of several buffers, including those marked with m, is now v. The q command simply quits, replacing the buffer menu buffer with the buffer that was displayed previously. ** New major modes and packages. *** The news reader GNUS is now installed. *** There is a new interface for version control systems, called VC. It works with both RCS and SCCS; in fact, you don't really have to know which one of them is being used, because it automatically deals with either one. Most of the time, the only command you have to know about is C-x C-q. This command normally toggles the read-only flag of the current buffer. If the buffer is visiting a file that is maintained with a version control system, the command still toggles read-only, but does so by checking the file in or checking it out. When you check a file in, VC asks you for a log entry by popping up a buffer. Edit the entry there, then type C-c C-c when it is ready. That's when the actual checkin happens. If you change your mind about the checkin, simply switch buffers and don't ever go back to the log buffer. To start using version control for a file, use the command C-x v v. This works like C-x C-q (performing the next logical version-control operation needed to change the file's writeability) but it will also perform initial checkin on an unregistered file. By default, VC uses RCS if RCS is installed on your machine; otherwise, SCCS. If you want to make the choice explicitly, you can do it by setting `vc-default-back-end' to the symbol `RCS' or the symbol `SCCS'. You can tell when a file you visit is maintained with version control because either `RCS' or `SCCS' appears in the mode line. *** A new Calendar mode has been added, the work of Edward M. Reingold. The mode can display the Gregorian calendar and a variety of other calendars at any date, and interacts with a diary facility similar to the UNIX `calendar' utility. *** There is a new major mode for editing binary files: Hexl mode. To use it, use M-x hexl-find-file instead of C-x C-f to visit the file. This command converts the file's contents to hexadecimal and lets you edit the translation. When you save the file, it is converted automatically back to binary. You can also use M-x hexl-mode to translate an existing buffer into hex. Do this if you have already visited a binary file. Hexl mode has a few other commands: C-M-d insert a byte with a code typed in decimal. C-M-o insert a byte with a code typed in octal. C-M-x insert a byte with a code typed in hex. C-x [ move to the beginning of a 1k-byte "page". C-x ] move to the end of a 1k-byte "page". M-g go to an address specified in hex. M-j go to an address specified in decimal. C-c C-c leave hexl mode and go back to the previous major mode. *** Miscellaneous new major modes include Awk mode, Icon mode, Makefile mode, Perl mode and SGML mode. *** Edebug, a new source-level debugger for Emacs Lisp functions. To use Edebug, use the command M-x edebug-defun to "evaluate" a function definition in an Emacs Lisp file. We put "evaluate" in quotation marks because it doesn't just evaluate the function, it also inserts additional information to support source-level debugging. You must also do (setq debugger 'edebug-debug) to cause errors and single-stepping to use Edebug instead of the usual Emacs Lisp debugger. For more information, see the Edebug manual, which should be included in the Emacs distribution. *** C++ mode is like C mode, except that it understands C++ comment syntax and certain other differences between C and C++. It also has a command `fill-c++-comment' which fills a paragraph made of comment lines. The command `comment-region' is useful in C++ mode for commenting out several consecutive lines, or removing the commenting out of such lines. *** A new package for merging two variants of the same text. It's not unusual for programmers to get their signals crossed and modify the same program in two different directions. Then somebody has to merge the two versions. The command `emerge-files' makes this easier. `emerge-files' reads two file names and compares them. Then it displays three buffers: one for each file, and one for the differences. If the original version of the file is available, you can make things even easier using `emerge-files-with-ancestor'. It reads three file names--variant 1, variant 2, and the common ancestor--and uses diff3 to compare them. You control the merging interactively. The main loop of Emerge consists of showing you one set of differences, asking you what to do about them, and doing it. You have a choice of two modes for giving directions to Emerge: "fast" mode and "edit" mode. In Fast mode, Emerge commands are single characters, and ordinary Emacs commands are disabled. This makes Emerge operations fast, but prevents you from doing more than selecting the A or the B version of differences. In Edit mode, all emerge commands use the C-c prefix, and the usual Emacs commands are available. This allows editing the merge buffer, but slows down Emerge operations. Edit and fast modes are indicated by `F' and `E' in the minor modes in the mode line. The Emerge commands are: p go to the previous difference n go to the next difference a select the A version of this difference b select the B version of this difference j go to a particular difference (prefix argument specifies which difference) (0j suppresses display of the flags) q quit - finish the merge* f go into fast mode e go into edit mode l recenter (C-l) all three windows* - and 0 through 9 prefix numeric arguments d a select the A version as the default from here down in the merge buffer* d b select the B version as the default from here down in the merge buffer* c a copy the A version of the difference into the kill ring c b copy the B version of the difference into the kill ring i a insert the A version of the difference at the point i b insert the B version of the difference at the point m put the point and mark around the difference region ^ scroll-down (like M-v) the three windows* v scroll-up (like C-v) the three windows* < scroll-left (like C-x <) the three windows* > scroll-right (like C-x >) the three windows* | reset horizontal scroll on the three windows* x 1 shrink the merge window to one line (use C-u l to restore it to full size) x a find the difference containing a location in the A buffer* x b find the difference containing a location in the B buffer* x c combine the two versions of this difference* x C combine the two versions of this difference, using a register's value as the template* x d find the difference containing a location in the merge buffer* x f show the files/buffers Emerge is operating on in Help window (use C-u l to restore windows) x j join this difference with the following one (C-u x j joins this difference with the previous one) x l show line numbers of points in A, B, and merge buffers x m change major mode of merge buffer* x s split this difference into two differences (first position the point in all three buffers to the places to split the difference) x t trim identical lines off top and bottom of difference (such lines occur when the A and B versions are identical but differ from the ancestor version) x x set the template for the x c command* Normally, the merged output goes back in the first file specified. If you use a prefix argument, Emerge reads another file name to use for the output file. Once Emerge has prepared the buffer of differences, it runs the hooks in `emerge-startup-hooks'. *** Asm mode is a new major mode for editing files of assembler code. It defines these commands: TAB tab-to-tab-stop. LFD Insert a newline and then indent using tab-to-tab-stop. : Insert a colon and then remove the indentation from before the label preceding colon. Then tab-to-tab-stop. ; Insert or align a comment. *** Two-column mode lets you conveniently edit two side-by-side columns of text. It works using two side-by-side windows, each showing its own buffer. Here are three ways to enter two-column mode: C-x 6 2 makes the current buffer into the left-hand buffer. In the right-hand window it puts a buffer whose name is based on the current buffer's name. C-x 6 b BUFFER RET makes the current buffer into the left-hand buffer, and uses buffer BUFFER as the right-hand buffer. C-x 6 s splits the current buffer, which contains two-column text, into two side-by-side buffers. The old current buffer becomes the left-hand buffer, but the text in the right column is moved into the right-hand buffer. The current column specifies the split point. Splitting starts with the current line and continues to the end of the buffer. C-x 6 s takes a prefix argument which specifies how many characters before point constitute the column separator. (The default argument is 1, as usual, so by default the column separator is the character before point.) Lines that don't have the column separator at the proper place remain unsplit; they stay in the left-hand buffer, and the right-hand buffer gets an empty line to correspond. You can scroll both buffers together using C-x 6 SPC (scroll up), C-x 6 DEL (scroll down), and C-x 6 RET (scroll up one line). C-x 6 C-l recenters both buffers together. If you want to make a line which will span both columns, put it in the left-hand buffer, with an empty line in the corresponding place in the right-hand buffer. When you have edited both buffers as you wish, merge them with C-x 6 1. This copies the text from the right-hand buffer as a second column in the other buffer. To go back to two-column editing, use C-x 6 s. Use C-x 6 d to disassociate the two buffers, leaving each as it stands. (If the other buffer, the one that was not current when you type C-x 6 d, is empty, C-x 6 d kills it.) *** You can supply command arguments such as files to visit to an Emacs that is already running. To do this, you must do this in your .emacs file: (add-hook 'suspend-hook 'resume-suspend-hook) Also you must use the shellscript emacs.csh or emacs.sh, found in the etc subdirectory. *** Shell mode has been completely replaced. The basic idea is the same, but there are new commands available in this mode. TAB now completes the file name before point in the shell buffer. To get a list of all possible completions, type M-?. There is a new convenient history mechanism for repeating previous commands. Use the command M-p to recall the last command; it copies the text of that command to the place where you are editing. If you repeat M-p, it replaces the copied command with the previous command. M-n is similar but goes in the opposite direction towards the present. When you find the command you wanted, you can edit it, or just resubmit it by typing RET. You can also use M-r and M-s to search for (respectively) earlier or later inputs starting with a given string. First type the string, then type M-r to yank a previous input from the history which starts with that string. You can repeat M-r to find successively earlier inputs starting with the same string. You can start moving in the opposite direction (toward more recent inputs) by typing M-s instead of M-r. As long as you don't use any commands except M-r and M-s, they keep using the same string that you had entered initially. C-c C-o kills the last batch of output from a shell command. This is useful if a shell command spews out lots of output that just gets in the way. C-c C-r scrolls to display the beginning of the last batch of output at the top of the window; it also moves the cursor there. C-a on a line that starts with a shell prompt moves to the end of the prompt, not to the very beginning of the line. C-d typed at the end of the shell buffer sends EOF to the subshell. At any other position in the buffer, it deletes a character as usual. If Emacs gets confused while trying to track changes in the shell's current directory, type M-x dirs to re-synchronize. M-x send-invisible reads a line of text without echoing it, and sends it to the shell. If you accidentally suspend your process, use M-x comint-continue-subjob to continue it. *** There is now a convenient way to enable flow control on terminals where you can't win without it. Suppose you want to do this on VT-100 and H19 terminals; put the following in your `.emacs' file: (enable-flow-control-on "vt100" "h19") When flow control is enabled, you must type C-\ to get the effect of a C-s, and type C-^ to get the effect of a C-q. The function `enable-flow-control' enables flow control unconditionally. ** Changes in Dired Dired has many new features which allow you to do these things: - Rename, copy, or make links to many files at once. - Make distinguishable types of marks for different operations. - Display contents of subdirectories in the same Dired buffer as the parent directory. *** Setting and Clearing Marks There are now two kinds of marker that you can put on a file in Dired: `D' for deletion, and `*' for any other kind of operation. The `x' command deletes only files marked with `D', and most other Dired commands operate only on the files marked with `*'. To mark files with `D' (also called "flagging" the files), you can use `d' as usual. Here are some commands for marking with `*' (and also for unmarking): **** `m' marks the current file with `*', for an operation other than deletion. **** `*' marks all executable files. With a prefix argument, it unmarks all those files. **** `@' marks all symbolic links. With a prefix argument, it unmarks all those files. **** `/' marks all directory files except `.' and `..'. With a prefix argument, it unmarks all those files. **** M-DEL removes a specific or all marks from every file. With an argument, queries for each marked file. Type your help character, usually C-h, at that time for help. **** `c' replaces all marks that use the character OLD with marks that use the character NEW. You can use almost any character as a mark character by means of this command, to distinguish various classes of files. If OLD is ` ', then the command operates on all unmarked files; if NEW is ` ', then the command unmarks the files it acts on. *** Operating on Multiple Files The Dired commands to operate directly on files (rename them, copy them, and so on) have been generalized to work on multiple files. There are also some additional commands in this series. All of these commands use the same convention to decide which files to manipulate: - If you give the command a numeric prefix argument @var{n}, it operates on the next @var{n} files, starting with the current file. - Otherwise, if there are marked files, the commands operate on all the marked files. - Otherwise, the command operates on the current file only. These are the commands: **** `C' copies the specified files. You must specify a directory to copy into, or (if copying a single file) a new name. If `dired-copy-preserve-time' is non-`nil', then copying sets the modification time of the new file to be the same as that of the old file. **** `R' renames the specified files. You must specify a directory to rename into, or (if renaming a single file) a new name. Dired automatically changes the visited file name of buffers associated with renamed files so that they refer to the new names. **** `H' makes hard links to the specified files. You must specify a directory to make the links in, or (if making just one link) the name to give the link. **** `S' makes symbolic links to the specified files. You must specify a directory to make the links in, or (if making just one link) the name to give the link. **** `M' changes the mode of the specified files. This calls the `chmod' program, so you can describe the desired mode change with any argument that `chmod' would handle. **** `G' changes the group of the specified files. **** `O' changes the owner of the specified files. (On normal systems, only the superuser can do this.) The variable `dired-chown-program' specifies the name of the program to use to do the work (different systems put `chown' in different places. **** `Z' compresses or uncompresses the specified files. **** `L' loads the specified Emacs Lisp files. **** `B' byte compiles the specified Emacs Lisp files. **** `P' prints the specified files. It uses the variables `lpr-command' and `lpr-switches' just as `lpr-file' does. *** Shell Commands in Dired `!' reads a shell command string in the minibuffer and runs the shell command on all the specified files. There are two ways of applying a shell command to multiple files: - If you use `*' in the command, then the shell command runs just once, with the list of file names substituted for the `*'. Thus, `! tar cf foo.tar * RET' runs `tar' on the entire list of file names, putting them into one tar file `foo.tar'. The file names are inserted in the order that they appear in the Dired buffer. - If the command string doesn't contain `*', then it runs once for each file, with the file name attached at the end. For example, `! uudecode RET' runs `uudecode' on each file. To run the shell command once for each file but without being limited to putting the file name inserted in the middle, use a shell loop. For example, this shell command would run `uuencode' on each of the specified files, writing the output into a corresponding `.uu' file: for file in *; uuencode $file $file >$file.uu; done The working directory for the shell command is the top level directory of the Dired buffer. *** Regular Expression File Name Substitution **** `% m REGEXP RET' marks all files whose names match the regular expression REGEXP. Only the non-directory part of the file name is used in matching. Use `^' and `$' to anchor matches. Exclude subdirs by hiding them. **** `% d REGEXP RET' flags for deletion all files whose names match the regular expression REGEXP. **** `% R', `% C', `% H', `% S' These four commands rename, copy, make hard links and make soft links, in each case computing the new name by regular expression substitution from the name of the old file. They effectively perform `query-replace-regexp' on the selected file names in the Dired buffer. The commands read two arguments: a regular expression, and a substitution pattern. Each selected file name is matched against the regular expression, and then the part which matched is replaced with the substitution pattern. You can use `\&' and `\DIGIT' in the substitution pattern to refer to all or part of the old file name. If the regular expression matches more than once in a file name, only the first match is replaced. Normally, the replacement process does not consider the directory names; it operates on the file name within the directory. If you specify a prefix argument of zero, then replacement affects entire file name. To apply the command to all files matching the same regexp that you use in the command, mark those files with `% m REGEXP RET', then use the same regular expression in `% R'. To make this easier, `% R' uses as a default the last regular expression specified in a `%' command. *** Dired Case Conversion **** `% u' renames each of the selected files to an upper case name. **** `% l' renames each of the selected files to a lower case name. *** File Comparison with Dired **** `=' compares the current file with another file (the file at the mark), by running the `diff' program. The file at the mark is given to `diff' first. **** `M-=' compares the current file with its backup file. If there are several numerical backups, it uses the most recent one. If this file is a backup, it is compared with its original. The backup file is the first file given to `diff'. *** Subdirectories in Dired You can display more than one directory in one Dired buffer. The simplest way to do this is to specify the options `-lR' for running `ls'. That produces a recursive directory listing showing all subdirectories, all within the same Dired buffer. You can also insert the contents of a particular subdirectory with the `i' command. Use this command on the line that describes a file which is a directory. Inserted subdirectory contents follow the top-level directory of the Dired buffer, just as they do in `ls -lR' output. If the subdirectory's contents are already present in the buffer, the `i' command just moves to it (type `l' to refresh it). It sets the Emacs mark before moving, so C-x C-x takes you back to the old position in the buffer. When you have subdirectories in the Dired buffer, you can use the page motion commands C-x [ and C-x ] to move by entire directories. The following commands move up and down in the tree of directories in one Dired buffer: **** C-M-u Go up to the parent directory's headerline. **** C-M-d Go down in the tree, to the first subdirectory's headerline. **** C-M-n Go to next subdirectory headerline, regardless of level. **** C-M-p Go to previous subdirectory headerline, regardless of level. *** Hiding Subdirectories "Hiding" a subdirectory means to make it invisible, except for its headerline. Files inside a hidden subdirectory are never considered by Dired. For example, the commands to operate on marked files ignore files in hidden directories even if they are marked. **** `$' hides or unhides the current subdirectory and move to next subdirectory. A prefix argument serves as a repeat count. **** `M-$' hides all subdirectories, leaving only their header lines. Or, if at least one subdirectory is currently hidden, it makes everything visible again. You can use this command to get an overview in very deep directory trees or to move quickly to subdirectories far away. *** Editing the Dired Buffer **** `l' updates the specified files in a Dired buffer. This means reading their current status from the file system and changing the buffer to reflect it properly. If you use this command on a subdirectory header line, it updates the contents of the subdirectory. **** `g' updates the entire contents of the Dired buffer. It preserves all marks except for those on files that have vanished. Hidden subdirectories are updated but remain hidden. **** `k' kills all marked lines (not the files). With a prefix argument, it kills that many lines starting with the current line. This command does not delete files; it just deletes text from the Dired buffer. If you kill the line for a file that is a directory, then its contents are also deleted from the buffer. Typing `C-u k' on the header line for a subdirectory is another way to delete a subdirectory from the Dired buffer. *** `find' and Dired. To search for files with names matching a wildcard pattern use `find-name-dired'. Its arguments are DIRECTORY and PATTERN. It selects all the files in DIRECTORY or its subdirectories whose own names match PATTERN. The files thus selected are displayed in a Dired buffer in which the ordinary Dired commands are available. If you want to test the contents of files, rather than their names, use `find-grep-dired'. This command takes two minibuffer arguments, DIRECTORY and REGEXP; it selects all the files in DIRECTORY or its subdirectories that contain a match for REGEXP. It works by running `find' and `grep'. The most general command in this series is `find-dired', which lets you specify any condition that `find' can test. It takes two minibuffer arguments, DIRECTORY and FIND-ARGS; it runs `find' in DIRECTORY with using FIND-ARGS as the arguments to `find' specifying which files to accept. To use this command, you need to know how to use `find'. ** New amusements and novelties. *** `M-x mpuz' displays a multiplication puzzle, in which each letter stands for a digit, and you must determine which digit. The puzzles are determined randomly, so they are always different. *** `M-x gomoku' plays the game Gomoku with you. It needs more work. *** `M-x spook' adds a line of randomly chosen keywords to an outgoing mail message. The keywords are chosen from a list of words that suggest you are discussing something subversive. The idea is that the NSA reads all messages that contain keywords suggesting they might be interested, and that adding these lines could help to overload them. I would guess that they have modified their program by now to ignore these lines of keywords; perhaps the program can be updated if some clever hacker can determine what criterion they actually use now. ** Installation changes *** The configure script has been provided to help with the installation process. It takes the place of editing the Makefiles and src/config.h, and can often guess the appropriate operating system to use for a particular machine type. See INSTALL for a more detailed description of the steps required for installation. *** If you create a Lisp file named `site-start.el', Emacs loads the file whenever it starts up. *** A new Lisp variable, `data-directory', indicates the directory containing the DOC file, tutorial, copying agreement, and other familiar `etc' files. The value of `data-directory' is a simple string. The default should be set at build time, and the person installing Emacs should place all the data files in this directory. The `help.el' functions that look for docstrings and information files check this variable. All Emacs Lisp packages should also be coded so that they refer to `data-directory' to find data files. *** The PURESIZE definition has been moved from config.h to its own file, puresize.h. Since almost every file of C source in the distribution depends on config.h, but only alloc.c and data.c depend on puresize.h, this means that changing the value of PURESIZE causes only those two files to be recompiled. *** The makefile at the top of the Emacs source tree now supports a `dist' target, which creates a compressed tar file suitable for distribution, using the contents of the source tree. Object files, old file versions, executables, DOC files, and other architecture-specific or easy-to-recreate files are not included in the tar file. * For older news, see the file ONEWS. For Lisp changes in (the first * release of) Emacs 19, see the file LNEWS. ---------------------------------------------------------------------- Copyright information: Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the copyright notice and this permission notice are preserved, thus giving the recipient permission to redistribute in turn. Permission is granted to distribute modified versions of this document, or of portions of it, under the above conditions, provided also that they carry prominent notices stating who last changed them. Local variables: mode: text end: emacs-19.30/etc/ONEWS100666 12120 13 202523 5335275264 12314 0ustar rmsuserGNU Emacs NEWS -- history of user-visible changes. 1992. Copyright (C) 1992 Free Software Foundation, Inc. See the end for copying conditions. For older news, see the file OONEWS. Changes in version 18.58. * RMAIL reply now properly parses nested comments in addesses. * The "visual bell" feature when used with X windows now flashes only 1/4 of the window's total area. This is because flashing the whole window is too slow on some systems. * `call-process' and `call-process-region' now return an indication of the exit status of the subprocess: either a numeric exit code or a string describing the signal which caused termination. * It is possible for regular expression matching to overflow the stack of failure points. In the past, such overflow was treated as simple failure to match. Now it causes an error. * You can use C-u to end a numeric argument. Thus, type C-u 1 0 0 C-u 1 to insert 100 1's. * Emacs now knows how to get resource values from the X server. * Job control commands in shell mode work properly on more systems because they now work by "typing" signal characters such as C-c. * copy-keymap no longer recursively copies keymaps reached through symbols' function definitions (i.e., those that have names). It does copy nested keymaps that appear directly in the other copied keymaps. Changes in version 18.56. * C-g should now work to interrupt a running program on all kinds of systems even when using X windows. * Quitting is inhibited while a filter or sentinel is running. Those functions can run asynchronously while Emacs is waiting for keyboard input, and if they allow quitting, they make the behavior of C-g unpredictable. * Storing text into the X windows cut buffer now clears out any selection. * The undo facility is completely rewritten, and now uses Lisp data structures. It can record much more information. You can use the variables undo-threshold and undo-high-threshold to control how much. * There is no longer a maximum screen height or width. Changes in version 18.52. * X windows version 10 is supported under system V. * Pop-up menus are now supported with the same Lisp interface in both version 10 and 11 of X windows. * C-x 4 a is a new command to edit a change-log entry in another window. * The emacs client program now allows an option +NNN to specify the line number to go to in the file whose name follows. Thus, emacsclient foo.c +45 bar.c will find the files `foo.c' and `bar.c', going to line 45 in `bar.c'. * Dired allows empty directories to be deleted like files. * When the terminal type is used to find a terminal-specific file to run, Emacs now tries the entire terminal type first. If that doesn't yield a file that exists, the last hyphen and what follows it is stripped. If that doesn't yield a file that exists, the previous hyphen is stripped, and so on until all hyphens are gone. For example, if the terminal type is `aaa-48-foo', Emacs will try first `term/aaa-48-foo.el', then `term/aaa-48.el' and finally `term/aaa.el'. Underscores now receive the same treatment as hyphens. * Texinfo features: @defun, etc. texinfo-show-structure. New template commands. texinfo-format-region. * The special "local variable" `eval' is now ignored if you are running as root. * New command `c-macro-expand' shows the result of C macro expansion in the region. It works using the C preprocessor, so its results are completely accurate. * Errors in trying to auto save now flash error messages for a few seconds. * Killing a buffer now sends SIGHUP to the buffer's process. * New hooks. ** `spell-region' now allows you to filter the text before spelling-checking. If the value of `spell-filter' is non-nil, it is called, with no arguments, looking at a temporary buffer containing a copy of the text to be checked. It can alter the text freely before the spell program sees it. ** The variable `lpr-command' now specifies the command to be used when you use the commands to print text (such as M-x print-buffer). ** Posting netnews now calls the value of `news-inews-hook' (if not nil) as a function of no arguments before the actual posting. ** Rmail now calls the value of `rmail-show-message-hook' (if not nil) as a function of no arguments, each time a new message is selected. ** `kill-emacs' calls the value of `kill-emacs-hook' as a function of no args unless Emacs is running in batch mode. * New libraries. See the source code of each library for more information. ** icon.el: a major mode for editing programs written in Icon. ** life.el: a simulator for the cellular automaton "life". Load the library and run M-x life. ** doctex.el: a library for converting the Emacs `etc/DOC' file of documentation strings into TeX input. ** saveconf.el: a library which records the arrangement of windows and buffers when you exit Emacs, and automatically recreates the same setup the next time you start Emacs. ** uncompress.el: a library that automatically uncompresses files when you visit them. ** c-fill.el: a mode for editing filled comments in C. ** kermit.el: an extended version of shell-mode designed for running kermit. ** spook.el: a library for adding some "distract the NSA" keywords to every message you send. ** hideif.el: a library for hiding parts of a C program based on preprocessor conditionals. ** autoinsert.el: a library to put in some initial text when you visit a nonexistent file. The text used depends on the major mode, and comes from a directory of files created by you. * New programming features. ** The variable `window-system-version' now contains the version number of the window system you are using (if appropriate). When using X windows, its value is either 10 or 11. ** (interactive "N") uses the prefix argument if any; otherwise, it reads a number using the minibuffer. ** VMS: there are two new functions `vms-system-info' and `shrink-to-icon'. The former allows you to get many kinds of system status information. See its self-documentation for full details. The second is used with the window system: it iconifies the Emacs window. ** VMS: the new function `define-logical-name' allows you to create job-wide logical names. The old function `define-dcl-symbol' has been removed. Changes in version 18.50. * X windows version 11 is supported. Define X11 in config.h if you want X version 11 instead of version 10. * The command M-x gdb runs the GDB debugger as an inferior. It asks for the filename of the executable you want to debug. GDB runs as an inferior with I/O through an Emacs buffer. All the facilities of Shell mode are available. In addition, each time your program stops, and each time you select a new stack frame, the source code is displayed in another window with an arrow added to the line where the program is executing. Special GDB-mode commands include M-s, M-n, M-i, M-u, M-d, and C-c C-f which send the GDB commands `step', `next', `stepi', `up', `down' and `finish'. In any source file, the commands C-x SPC tells GDB to set a breakpoint on the current line. * M-x calendar displays a three-month calendar. * C-u 0 C-x C-s never makes a backup file. This is a way you can explicitly request not to make a backup. * `term-setup-hook' is for users only. Emacs never uses this variable for internal purposes, so you can freely set it in your `.emacs' file to make Emacs do something special after loading any terminal-specific setup file from `lisp/term'. * `copy-keymap' now copies recursive submaps. * New overlay-arrow feature. If you set the variable `overlay-arrow-string' to a string and `overlay-arrow-position' to a marker, that string is displayed on the screen at the position of that marker, hiding whatever text would have appeared there. If that position isn't on the screen, or if the buffer the marker points into isn't displayed, there is no effect. * -batch mode can read from the terminal. It now works to use `read-char' to do terminal input in a noninteractive Emacs run. End of file causes Emacs to exit. * Variables `data-bytes-used' and `data-bytes-free' removed. These variables cannot really work because the 24-bit range of an integer in (most ports of) GNU Emacs is not large enough to hold their values on many systems. Changes in version 18.45, since version 18.41. * C indentation parameter `c-continued-brace-offset'. This parameter's value is added to the indentation of any line that is in a continuation context and starts with an open-brace. For example, it applies to the open brace shown here: if (x) { The default value is zero. * Dabbrev expansion (Meta-/) preserves case. When you use Meta-/ to search the buffer for an expansion of an abbreviation, if the expansion found is all lower case except perhaps for its first letter, then the case pattern of the abbreviation is carried over to the expansion that replaces it. * TeX-mode syntax. \ is no longer given "escape character" syntax in TeX mode. It now has the syntax of an ordinary punctuation character. As a result, \[...\] and such like are considered to balance each other. * Mail-mode automatic Reply-to field. If the variable `mail-default-reply-to' is non-`nil', then each time you start to compose a message, a Reply-to field is inserted with its contents taken from the value of `mail-default-reply-to'. * Where is your .emacs file? If you run Emacs under `su', so your real and effective uids are different, Emacs uses the home directory associated with the real uid (the name you actually logged in under) to find the .emacs file. Otherwise, Emacs uses the environment variable HOME to find the .emacs file. The .emacs file is not loaded at all if -batch is specified. * Prolog mode is the default for ".pl" files. * File names are not case-sensitive on VMS. On VMS systems, all file names that you specify are converted to upper case. You can use either upper or lower case indiscriminately. * VMS-only function 'define-dcl-symbol'. This is a new name for the function formerly called `define-logical-name'. Editing Changes in Emacs 18 * Additional systems and machines are supported. GNU Emacs now runs on Vax VMS. However, many facilities that are normally implemented by running subprocesses do not work yet. This includes listing a directory and sending mail. There are features for running subprocesses but they are incompatible with those on Unix. I hope that some of the VMS users can reimplement these features for VMS (compatibly for the user, if possible). VMS wizards are also asked to work on making the subprocess facilities more upward compatible with those on Unix, and also to rewrite their internals to use the same Lisp objects that are used on Unix to represent processes. In addition, the TI Nu machine running Unix system V, the AT&T 3b, and the Wicat, Masscomp, Integrated Solutions, Alliant, Amdahl uts, Mips, Altos 3068 and Gould Unix systems are now supported. The IBM PC-RT is supported under 4.2, but not yet under system V. The GEC 93 is close to working. The port for the Elxsi is partly merged. See the file MACHINES for full status information and machine-specific installation advice. * Searching is faster. Forward search for a text string, or for a regexp that is equivalent to a text string, is now several times faster. Motion by lines and counting lines is also faster. * Memory usage improvements. It is no longer possible to run out of memory during garbage collection. As a result, running out of memory is never fatal. This is due to a new garbage collection algorithm which compactifies strings in place rather than copying them. Another consequence of the change is a reduction in total memory usage and a slight increase in garbage collection speed. * Display changes. ** Editing above top of screen. When you delete or kill or alter text that reaches to the top of the screen or above it, so that display would start in the middle of a line, Emacs will usually attempt to scroll the text so that display starts at the beginning of a line again. ** Yanking in the minibuffer. The message "Mark Set" is no longer printed when the minibuffer is active. This is convenient with many commands, including C-y, that normally print such a message. ** Cursor appears in last line during y-or-n questions. Questions that want a `y' or `n' answer now move the cursor to the last line, following the question. * Library loading changes. `load' now considers all possible suffixes (`.elc', `.el' and none) for each directory in `load-path' before going on to the next directory. It now accepts an optional fourth argument which, if non-nil, says to use no suffixes; then the file name must be given in full. The search of the directories in `load-path' goes on as usual in this case, but it too can be prevented by passing an absolute file name. The value of `load-path' no longer by default includes nil (meaning to look in the current default directory). The idea is that `load' should be used to search the path only for libraries to be found in the standard places. If you want to override system libraries with your own, place your own libraries in one special directory and add that directory to the front of `load-path'. The function `load' is no longer a command; that is to say, `M-x load' is no longer allowed. Instead, there are two commands for loading files. `M-x load-library' is equivalent to the old meaning of `M-x load'. `M-x load-file' reads a file name with completion and defaulting and then loads exactly that file, with no searching and no suffixes. * Emulation of other editors. ** `edt-emulation-on' starts emulating DEC's EDT editor. Do `edt-emulation-off' to return Emacs to normal. ** `vi-mode' and `vip-mode' starts emulating vi. These are two different vi emulations provided by GNU Emacs users. We are interested in feedback as to which emulation is preferable. See the documentation and source code for these functions for more information. ** `set-gosmacs-bindings' emulates Gosling Emacs. This command changes many global bindings to resemble those of Gosling Emacs. The previous bindings are saved and can be restored using `set-gnu-bindings'. * Emulation of a display terminal. Within Emacs it is now possible to run programs (such as emacs or supdup) which expect to do output to a visual display terminal. See the function `terminal-emulator' for more information. * New support for keypads and function keys. There is now a first attempt at terminal-independent support for keypad and function keys. Emacs now defines a standard set of key-names for function and keypad keys, and provides standard hooks for defining them. Most of the standard key-names have default definitions built into Emacs; you can override these in a terminal-independent manner. The default definitions and the conventions for redefining them are in the file `lisp/keypad.el'. These keys on the terminal normally work by sending sequences of characters starting with ESC. The exact sequences used vary from terminal to terminal. Emacs interprets them in two stages: in the first stage, terminal-dependent sequences are mapped into the standard key-names; then second stage maps the standard key-names into their definitions in a terminal-independent fashion. The terminal-specific file `term/$TERM.el' now is responsible only for establishing the mapping from the terminal's escape sequences into standard key-names. It no longer knows what Emacs commands are assigned to the standard key-names. One other change in terminal-specific files: if the value of the TERM variable contains a hyphen, only the part before the first hyphen is used in forming the name of the terminal-specific file. Thus, for terminal type `aaa-48', the file loaded is now `term/aaa.el' rather than `term/aaa-48.el'. * New startup command line options. `-i FILE' or `-insert FILE' in the command line to Emacs tells Emacs to insert the contents of FILE into the current buffer at that point in command line processing. This is like using the command M-x insert-file. `-funcall', `-load', `-user' and `-no-init-file' are new synonyms for `-f', `-l', `-u' and `-q'. `-nw' means don't use a window system. If you are using a terminal emulator on the X window system and you want to run Emacs to work through the terminal emulator instead of working directly with the window system, use this switch. * Buffer-sorting commands. Various M-x commands whose names start with `sort-' sort parts of the region: sort-lines divides the region into lines and sorts them alphabetically. sort-pages divides into pages and sorts them alphabetically. sort-paragraphs divides into paragraphs and sorts them alphabetically. sort-fields divides into lines and sorts them alphabetically according to one field in the line. The numeric argument specifies which field (counting from field 1 at the beginning of the line). Fields in a line are separated by whitespace. sort-numeric-fields is similar but converts the specified fields to numbers and sorts them numerically. sort-columns divides into lines and sorts them according to the contents of a specified range of columns. Refer to the self-documentation of these commands for full usage information. * Changes in various commands. ** `occur' output now serves as a menu. `occur-menu' command deleted. `M-x occur' now allows you to move quickly to any of the occurrences listed. Select the `*Occur*' buffer that contains the output of `occur', move point to the occurrence you want, and type C-c C-c. This will move point to the same occurrence in the buffer that the occurrences were found in. The command `occur-menu' is thus obsolete, and has been deleted. One way to get a list of matching lines without line numbers is to copy the text to another buffer and use the command `keep-lines'. ** Incremental search changes. Ordinary and regexp incremental searches now have distinct default search strings. Thus, regexp searches recall only previous regexp searches. If you exit an incremental search when the search string is empty, the old default search string is kept. The default does not become empty. Reversing the direction of an incremental search with C-s or C-r when the search string is empty now does not get the default search string. It leaves the search string empty. A second C-s or C-r will get the default search string. As a result, you can do a reverse incremental regexp search with C-M-s C-r. If you add a `*', `?' or `\|' to an incremental search regexp, point will back up if that is appropriate. For example, if you have searched for `ab' and add a `*', point moves to the first match for `ab*', which may be before the match for `ab' that was previously found. If an incremental search is failing and you ask to repeat it, it will start again from the beginning of the buffer (or the end, if it is a backward search). The search-controlling parameters `isearch-slow-speed' and `isearch-slow-window-lines' have now been renamed to start with `search' instead of `isearch'. Now all the parameters' names start with `search'. If `search-slow-window-lines' is negative, the slow search window is put at the top of the screen, and the absolute value or the negative number specifies the height of it. ** Undo changes The undo command now will mark the buffer as unmodified only when it is identical to the contents of the visited file. ** C-M-v in minibuffer. If while in the minibuffer you request help in a way that uses a window to display something, then until you exit the minibuffer C-M-v in the minibuffer window scrolls the window of help. For example, if you request a list of possible completions, C-M-v can be used reliably to scroll the completion list. ** M-TAB command. Meta-TAB performs completion on the Emacs Lisp symbol names. The sexp in the buffer before point is compared against all existing nontrivial Lisp symbols and completed as far as is uniquely determined by them. Nontrivial symbols are those with either function definitions, values or properties. If there are multiple possibilities for the very next character, a list of possible completions is displayed. ** Dynamic abbreviation package. The new command Meta-/ expands an abbreviation in the buffer before point by searching the buffer for words that start with the abbreviation. ** Changes in saving kbd macros. The commands `write-kbd-macro' and `append-kbd-macro' have been deleted. The way to save a keyboard macro is to use the new command `insert-kbd-macro', which inserts Lisp code to define the macro as it is currently defined into the buffer before point. Visit a Lisp file such as your Emacs init file `~/.emacs', insert the macro definition (perhaps deleting an old definition for the same macro) and then save the file. ** C-x ' command. The new command C-x ' (expand-abbrev) expands the word before point as an abbrev, even if abbrev-mode is not turned on. ** Sending to inferior Lisp. The command C-M-x in Lisp mode, which sends the current defun to an inferior Lisp process, now works by writing the text into a temporary file and actually sending only a `load'-form to load the file. As a result, it avoids the Unix bugs that used to strike when the text was above a certain length. With a prefix argument, this command now makes the inferior Lisp buffer appear on the screen and scrolls it so that the bottom is showing. Two variables `inferior-lisp-load-command' and `inferior-lisp-prompt', exist to customize these feature for different Lisp implementations. ** C-x n p now disabled. The command C-x n p, a nonrecomended command which narrows to the current page, is now initially disabled like C-x n n. * Dealing with files. ** C-x C-v generalized This command is now allowed even if the current buffer is not visiting a file. As usual, it kills the current buffer and replaces it with a newly found file. ** M-x recover-file improved; auto save file names changed. M-x recover-file now checks whether the last auto-save file is more recent than the real visited file before offering to read in the auto-save file. If the auto-save file is newer, a directory listing containing the two files is displayed while you are asked whether you want the auto save file. Visiting a file also makes this check. If the auto-save file is more recent, a message is printed suggesting that you consider using M-x recover file. Auto save file names now by default have a `#' at the end as well as at the beginning. This is so that `*.c' in a shell command will never match auto save files. On VMS, auto save file names are made by appending `_$' at the front and `$' at the end. When you change the visited file name of a buffer, the auto save file is now renamed to belong to the new visited file name. You can customize the way auto save file names are made by redefining the two functions `make-auto-save-file-name' and `auto-save-file-name-p', both of which are defined in `files.el'. ** Modifying a buffer whose file is changed on disk is detected instantly. On systems where clash detection (locking of files being edited) is implemented, Emacs also checks the first time you modify a buffer whether the file has changed on disk since it was last visited or saved. If it has, you are asked to confirm that you want to change the buffer. ** Exiting Emacs offers to save `*mail*'. Emacs can now know about buffers that it should offer to save on exit even though they are not visiting files. This is done for any buffer which has a non-nil local value of `buffer-offer-save'. By default, Mail mode provides such a local value. ** Backup file changes. If a backup file cannot be written in the directory of the visited file due to fascist file protection, a backup file is now written in your home directory as `~/%backup%~'. Only one such file is made, ever, so only the most recently made such backup is available. When backup files are made by copying, the last-modification time of the original file is now preserved in the backup copy. ** Visiting remote files. On an internet host, you can now visit and save files on any other internet host directly from Emacs with the commands M-x ftp-find-file and M-x ftp-write-file. Specify an argument of the form HOST:FILENAME. Since standard internet FTP is used, the other host may be any kind of machine and is not required to have any special facilities. The first time any one remote host is accessed, you will be asked to give the user name and password for use on that host. FTP is reinvoked each time you ask to use it, but previously specified user names and passwords are remembered automatically. ** Dired `g' command. `g' in Dired mode is equivalent to M-x revert-buffer; it causes the current contents of the same directory to be read in. * Changes in major modes. ** C mode indentation change. The binding of Linefeed is no longer changed by C mode. It once again has its normal meaning, which is to insert a newline and then indent afterward. The old definition did one additional thing: it reindented the line before the new newline. This has been removed because it made the command twice as slow. The only time it was really useful was after the insertion of an `else', since the fact of starting with `else' may change the way that line is indented. Now you will have to type TAB again yourself to reindent the `else' properly. If the variable `c-tab-always-indent' is set to `nil', the TAB command in C mode, with no argument, will just insert a tab character if there is non-whitespace preceding point on the current line. Giving it a prefix argument will force reindentation of the line (as well as of the compound statement that begins after point, if any). ** Fortran mode now exists. This mode provides commands for motion and indentation of Fortran code, plus built-in abbrevs for Fortran keywords. For details, see the manual or the on-line documentation of the command `fortran-mode'. ** Scribe mode now exists. This mode does something useful for editing files of Scribe input. It is used automatically for files with names ending in ".mss". ** Modula2 and Prolog modes now exist. These modes are for editing programs in the languages of the same names. They can be selected with M-x modula-2-mode and M-x prolog-mode. ** Telnet mode changes. The telnet mode special commands have now been assigned to C-c keys. Most of them are the same as in Shell mode. ** Picture mode changes. The special picture-mode commands to specify the direction of cursor motion after insertion have been moved to C-c keys. The commands to specify diagonal motion were already C-c keys; they are unchanged. The keys to specify horizontal or vertical motion are now C-c < (left), C-c > (right), C-c ^ (up) and C-c . (down). ** Nroff mode comments. Comments are now supported in Nroff mode. The standard comment commands such as M-; and C-x ; know how to insert, align and delete comments that start with backslash-doublequote. ** LaTeX mode. LaTeX mode now exists. Use M-x latex-mode to select this mode, and M-x plain-tex-mode to select the previously existing mode for Plain TeX. M-x tex-mode attempts to examine the contents of the buffer and choose between latex-mode and plain-tex-mode accordingly; if the buffer is empty or it cannot tell, the variable `TeX-default-mode' controls the choice. Its value should be the symbol for the mode to be used. The facilities for running TeX on all or part of the buffer work with LaTeX as well. Some new commands available in both modes: C-c C-l recenter the window showing the TeX output buffer so most recent line of output can be seen. C-c C-k kill the TeX subprocess. C-c C-q show the printer queue. C-c C-f close a block (appropriate for LaTeX only). If the current line contains a \begin{...}, this inserts an \end{...} on the following line and puts point on a blank line between them. ** Outline mode changes. Invisible lines in outline mode are now indicated by `...' at the end of the previous visible line. The special outline heading motion commands are now all on C-c keys. A few new ones have been added. Here is a full list: C-c C-n Move to next visible heading (formerly M-}) C-c C-p Move to previous visible heading (formerly M-{) C-c C-f Move to next visible heading at the same level. Thus, if point is on a level-2 heading line, this command moves to the next visible level-2 heading. C-c C-b Move to previous visible heading at the same level. C-c C-u Move up to previous visible heading at a higher level. The variable `outline-regexp' now controls recognition of heading lines. Any line whose beginning matches this regexp is a heading line. The depth in outline structure is determined by the length of the string that matches. A line starting with a ^L (formfeed) is now by default considered a header line. * Mail reading and sending. ** MH-E changes. MH-E has been extensively modified and improved since the v17 release. It contains many new features, including commands to: extracted failed messages, kill a draft message, undo changes to a mail folder, monitor delivery of a letter, print multiple messages, page digests backwards, insert signatures, and burst digests. Also, many commands have been made to able to deal with named sequences of messages, instead of single messages. MH-E also has had numerous bugs fixed and commands made to run faster. Furthermore, its keybindings have been changed to be compatible with Rmail and the rest of GNU Emacs. ** Mail mode changes. The C-c commands of mail mode have been rearranged: C-c s, C-c c, C-c t and C-c b (move point to various header fields) have been reassigned as C-c C-f C-s, C-c C-f C-c, C-c C-f C-t and C-c C-f C-b. C-c C-f is for "field". C-c y, C-c w and C-c q have been changed to C-c C-y, C-c C-w and C-c C-q. Thus, C-c LETTER is always unassigned. ** Rmail C-r command changed to w. The Rmail command to edit the current message is now `w'. This change has been made because people frequently type C-r while in Rmail hoping to do a reverse incremental search. That now works. * Rnews changes. ** Caesar rotation added. The function news-caesar-buffer-body performs the rot13 code on the body of a news message. You can also specify the number to rotate by, as a prefix argument. The function is bound to C-c C-r in both News mode and News Reply mode. ** rmail-output command added. The C-o command has been bound to rmail-output in news-mode. This allows one to append an article to a file which is in either Unix mail or RMAIL format. ** news-reply-mode changes. The C-c commands of news reply mode have been rearranged and changed, so that C-c LETTER is always unassigned: C-c y, C-c w and C-c q have been changed to C-c C-y, C-c C-w and C-c C-q. C-c c, C-c t, and C-c b (move to various mail header fields) have been deleted (they make no sense for posting and replying to USENET). C-c s (move to Subject: header field) has been reassigned as C-c C-f C-s. C-c C-f is for "field". Several additional move to news header field commands have been added. The local news-reply-mode bindings now look like this: C-c C-s news-inews (post the message) C-c C-c news-inews C-c C-f move to a header field (and create it if there isn't): C-c C-f C-n move to Newsgroups: C-c C-f C-s move to Subj: C-c C-f C-f move to Followup-To: C-c C-f C-k move to Keywords: C-c C-f C-d move to Distribution: C-c C-f C-a move to Summary: C-c C-y news-reply-yank-original (insert current message, in NEWS). C-c C-q mail-fill-yanked-message (fill what was yanked). C-c C-r caesar rotate all letters by 13 places in the article's body (rot13). * Changes in tags handling. ** M-. (`find-tag') and similar commands now look first for an exact match in the tags table, and try substring matches only afterward. ** The new command `find-tag-regexp' visits successively the tags that match a specified regular expression. ** You can now use more than one tags table. Using `visit-tags-table' to load a new tags table does not discard the other tables previously loaded. The other tags commands use all the tags tables that are loaded; the first tags table used is the one that mentions the current visited file. ** Tags tables can now be told to "include" other tags tables. This means the tags table gives the file names of other tags tables. Tags command then search included tags tables after the including table (but before any other tags tables you have loaded). Included tags tables can make it much easier and more efficient to maintain a tags table for a large package with many subdirectories--there is one tags table for each subdirectory, and a master tags table that includes each subdirectory table. You use `-i' options to `etags' when creating the tags table to give the file names of the included tables. ** You can now use the tags table for completion of names during ordinary editing. The command M-TAB (except in Emacs Lisp mode) completes the identifier in the buffer before point, using the set of all tags as the list of possible completions. ** `tags-query-replace' and `tags-search' changes. These functions no longer permanently create buffers for files that are searched but that do not contain any matches for the search pattern. * Existing Emacs usable as a server. Programs such as mailers that invoke "the editor" as an inferior to edit some text can now be told to use an existing Emacs process instead of creating a new editor. To do this, you must have an Emacs process running and capable of doing terminal I/O at the time you want to invoke it. This means that either you are using a window system and give Emacs a separate window or you run the other programs as inferiors of Emacs (such as, using M-x shell). First prepare the existing Emacs process by loading the `server' library and executing M-x server-start. (Your .emacs can do this automatically.) Now tell the other programs to use, as "the editor", the Emacs client program (etc/emacsclient, located in the same directory as this file). This can be done by setting the environment variable EDITOR. When another program invokes the emacsclient as "the editor", the client actually transfers the file names to be edited to the existing Emacs, which automatically visits the files. When you are done editing a buffer for a client, do C-x # (server-edit). This marks that buffer as done, and selects the next buffer that the client asked for. When all the buffers requested by a client are marked in this way, Emacs tells the client program to exit, so that the program that invoked "the editor" will resume execution. You can only have one server Emacs at a time, but multiple client programs can put in requests at the same time. The client/server work only on Berkeley Unix, since they use the Berkeley sockets mechanism for their communication. Changes in Lisp programming in Emacs version 18. * Init file changes. ** Suffixes no longer accepted on `.emacs'. Emacs will no longer load a file named `.emacs.el' or `emacs.elc' in place of `.emacs'. This is so that it will take less time to find `.emacs'. If you want to compile your init file, give it another name and make `.emacs' a link to the `.elc' file, or make it contain a call to `load' to load the `.elc' file. ** `default-profile' renamed to `default', and loaded after `.emacs'. It used to be the case that the file `default-profile' was loaded if and only if `.emacs' was not found. Now the name `default-profile' is not used at all. Instead, a library named `default' is loaded after the `.emacs' file. `default' is loaded whether the `.emacs' file exists or not. However, loading of `default' can be prevented if the `.emacs' file sets `inhibit-default-init' to non-nil. In fact, you would call the default file `default.el' and probably would byte-compile it to speed execution. Note that for most purposes you are better off using a `site-init' library since that will be loaded before the runnable Emacs is dumped. By using a `site-init' library, you avoid taking up time each time Emacs is started. ** inhibit-command-line has been eliminated. This variable used to exist for .emacs files to set. It has been eliminated because you can get the same effect by setting command-line-args to nil and setting inhibit-startup-message to t. * `apply' is more general. `apply' now accepts any number of arguments. The first one is a function; the rest are individual arguments to pass to that function, except for the last, which is a list of arguments to pass. Previously, `apply' required exactly two arguments. Its old behavior follows as a special case of the new definition. * New code-letter for `interactive'. (interactive "NFoo: ") is like (interactive "nFoo: ") in reading a number using the minibuffer to serve as the argument; however, if a prefix argument was specified, it uses the prefix argument value as the argument, and does not use the minibuffer at all. This is used by the `goto-line' and `goto-char' commands. * Semantics of variables. ** Built-in per-buffer variables improved. Several built-in variables which in the past had a different value in each buffer now behave exactly as if `make-variable-buffer-local' had been done to them. These variables are `tab-width', `ctl-arrow', `truncate-lines', `fill-column', `left-margin', `mode-line-format', `abbrev-mode', `overwrite-mode', `case-fold-search', `auto-fill-hook', `selective-display', `selective-display-ellipses'. To be precise, each variable has a default value which shows through in most buffers and can be accessed with `default-value' and set with `set-default'. Setting the variable with `setq' makes the variable local to the current buffer. Changing the default value has retroactive effect on all buffers in which the variable is not local. The variables `default-case-fold-search', etc., are now obsolete. They now refer to the default value of the variable, which is not quite the same behavior as before, but it should enable old init files to continue to work. ** New per-buffer variables. The variables `fill-prefix', `comment-column' and `indent-tabs-mode' are now per-buffer. They work just like `fill-column', etc. ** New function `setq-default'. `setq-default' sets the default value of a variable, and uses the same syntax that `setq' accepts: the variable name is not evaluated and need not be quoted. `(setq-default case-fold-search nil)' would make searches case-sensitive in all buffers that do not have local values for `case-fold-search'. You can set multiple variables sequentially, each with its own value, in `setq-default' just as in `setq'. ** Functions `global-set' and `global-value' deleted. These functions were never used except by mistake by users expecting the functionality of `set-default' and `default-value'. * Changes in defaulting of major modes. When `default-major-mode' is `nil', new buffers are supposed to get their major mode from the buffer that is current. However, certain major modes (such as Dired mode, Rmail mode, Rmail Summary mode, and others) are not reasonable to use in this way. Now such modes' names have been given non-`nil' `mode-class' properties. If the current buffer's mode has such a property, Fundamental mode is used as the default for newly created buffers. * `where-is-internal' requires additional arguments. This function now accepts three arguments, two of them required: DEFINITION, the definition to search for; LOCAL-KEYMAP, the keymap to use as the local map when doing the searching, and FIRST-ONLY, which is nonzero to return only the first key found. This function returns a list of keys (strings) whose definitions (in the LOCAL-KEYMAP or the current global map) are DEFINITION. If FIRST-ONLY is non-nil, it returns a single key (string). This function has changed incompatibly in that now two arguments are required when previously only one argument was allowed. To get the old behavior of this function, write `(current-local-map)' as the expression for the second argument. The incompatibility is sad, but `nil' is a legitimate value for the second argument (it means there is no local keymap), so it cannot also serve as a default meaning to use the current local keymap. * Abbrevs with hooks. When an abbrev defined with a hook is expanded, it now performs the usual replacement of the abbrev with the expansion before running the hook. Previously the abbrev itself was deleted but the expansion was not inserted. * Function `scan-buffer' deleted. Use `search-forward' or `search-backward' in place of `scan-buffer'. You will have to rearrange the arguments. * X window interface improvements. ** Detect release of mouse buttons. Button-up events can now be detected. See the file `lisp/x-mouse.el' for details. ** New pop-up menu facility. The new function `x-popup-menu' pops up a menu (in a X window) and returns an indication of which selection the user made. For more information, see its self-documentation. * M-x disassemble. This command prints the disassembly of a byte-compiled Emacs Lisp function. Would anyone like to interface this to the debugger? * `insert-buffer-substring' can insert part of the current buffer. The old restriction that the text being inserted had to come from a different buffer is now lifted. When inserting text from the current buffer, the text to be inserted is determined from the specified bounds before any copying takes place. * New function `substitute-key-definition'. This is a new way to replace one command with another command as the binding of whatever keys may happen to refer to it. (substitute-key-definition OLDDEF NEWDEF KEYMAP) looks through KEYMAP for keys defined to run OLDDEF, and rebinds those keys to run NEWDEF instead. * New function `insert-char'. Insert a specified character, a specified number of times. * `mark-marker' changed. When there is no mark, this now returns a marker that points nowhere, rather than `nil'. * `ding' accepts argument. When given an argument, the function `ding' does not terminate execution of a keyboard macro. Normally, `ding' does terminate all macros that are currently executing. * New function `minibuffer-depth'. This function returns the current depth in minibuffer activations. The value is zero when the minibuffer is not in use. Values greater than one are possible if the user has entered the minibuffer recursively. * New function `documentation-property'. (documentation-property SYMBOL PROPNAME) is like (get SYMBOL PROPNAME), except that if the property value is a number `documentation-property' will take that number (or its absolute value) as a character position in the DOC file and return the string found there. (documentation-property VAR 'variable-documentation) is the proper way for a Lisp program to get the documentation of variable VAR. * New documentation-string expansion feature. If a documentation string (for a variable or function) contains text of the form `\', it means that all command names specified in `\[COMMAND]' construct from that point on should be turned into keys using the value of the variable FOO as the local keymap. Thus, for example, `\\[eval-defun] evaluates the defun containing point.' will expand into "ESC C-x evaluates the defun containing point." regardless of the current major mode, because ESC C-x is defined to run `eval-defun' in the keymap `emacs-lisp-mode-map'. The effect is to show the key for `eval-defun' in Emacs Lisp mode regardless of the current major mode. The `\<...>' construct applies to all `\[...]' constructs that follow it, up to the end of the documentation string or the next `\<...>'. Without `\<...>', the keys for commands specified in `\[...]' are found in the current buffer's local map. The current global keymap is always searched second, whether `\<...>' has been used or not. * Multiple hooks allowed in certain contexts. The old hook variables `find-file-hook', `find-file-not-found-hook' and `write-file-hook' have been replaced. The replacements are `find-file-hooks', `find-file-not-found-hooks' and `write-file-hooks'. Each holds a list of functions to be called; by default, `nil', for no functions. The functions are called in order of appearance in the list. In the case of `find-file-hooks', all the functions are executed. In the case of `find-file-not-found-hooks', if any of the functions returns non-`nil', the rest of the functions are not called. In the case of `write-file-hooks', if any of the functions returns non-`nil', the rest of the functions are not called, and the file is considered to have been written already; so actual writing in the usual way is not done. If `write-file-hooks' is local to a buffer, it is set to its global value if `set-visited-file-name' is called (and thus by C-x C-w as well). `find-file-not-found-hooks' and `write-file-hooks' can be used together to implement editing of files that are not stored as Unix files: stored in archives, or inside version control systems, or on other machines running other operating systems and accessible via ftp. * New hooks for suspending Emacs. Suspending Emacs runs the hook `suspend-hook' before suspending and the hook `suspend-resume-hook' if the suspended Emacs is resumed. Running a hook is done by applying the variable's value to no arguments if the variable has a non-`nil' value. If `suspend-hook' returns non-`nil', then suspending is inhibited and so is running the `suspend-resume-hook'. The non-`nil' value means that the `suspend-hook' has done whatever suspending is required. * Disabling commands can print a special message. A command is disabled by giving it a non-`nil' `disabled' property. Now, if this property is a string, it is included in the message printed when the user tries to run the command. * Emacs can open TCP connections. The function `open-network-stream' opens a TCP connection to a specified host and service. Its value is a Lisp object that represents the connection. The object is a kind of "subprocess", and I/O are done like I/O to subprocesses. * Display-related changes. ** New mode-line control features. The display of the mode line used to be controlled by a format-string that was the value of the variable `mode-line-format'. This variable still exists, but it now allows more general values, not just strings. Lists, cons cells and symbols are also meaningful. The mode line contents are created by outputting various mode elements one after the other. Here are the kinds of objects that can be used as mode elements, and what they do in the display: string the contents of the string are output to the mode line, and %-constructs are replaced by other text. t or nil ignored; no output results. symbol the symbol's value is used. If the value is a string, the string is output verbatim to the mode line (so %-constructs are not interpreted). Otherwise, the symbol's value is processed as a mode element. list (whose first element is a string or list or cons cell) the elements of the list are treated as as mode elements, so that the output they generate is concatenated, list (whose car is a symbol) if the symbol's value is non-nil, the second element of the list is treated as a mode element. Otherwise, the third element (if any) of the list is treated as a mode element. cons (whose car is a positive integer) the cdr of the cons is used as a mode element, but the text it produces is padded, if necessary, to have at least the width specified by the integer. cons (whose car is a negative integer) the cdr of the cons is used as a mode element, but the text it produces is truncated, if necessary, to have at most the width specified by the integer. There is always one mode element to start with, that being the value of `mode-line-format', but if this value is a list then it leads to several more mode elements, which can lead to more, and so on. There is one new %-construct for mode elements that are strings: `%n' displays ` Narrow' for a buffer that is narrowed. The default value of `mode-line-format' refers to several other variables. These variables are `mode-name', `mode-line-buffer-identification', `mode-line-process', `mode-line-modified', `global-mode-string' and `minor-mode-alist'. The first four are local in every buffer in which they are changed from the default. mode-name Name of buffer's major mode. Local in every buffer. mode-line-buffer-identification Normally the list ("Emacs: %17b"), it is responsible for displaying text to indicate what buffer is being shown and what kind of editing it is doing. `Emacs' means that a file of characters is being edited. Major modes such as Info and Dired which edit or view other kinds of data often change this value. This variables becomes local to the current buffer if it is setq'd. mode-line-process Normally nil, this variable is responsible for displaying information about the process running in the current buffer. M-x shell-mode and M-x compile alter this variable. mode-line-modified This variable is responsible for displaying the indication of whether the current buffer is modified or read-only. By default its value is `("--%*%*-")'. minor-mode-alist This variable is responsible for displaying text for those minor modes that are currently enabled. Its value is a list of elements of the form (VARIABLE STRING), where STRING is to be displayed if VARIABLE's value (in the buffer whose mode line is being displayed) is non-nil. This variable is not made local to particular buffers, but loading some libraries may add elements to it. global-mode-string This variable is used to display the time, if you ask for that. The idea of these variables is to eliminate the need for major modes to alter mode-line-format itself. ** `window-point' valid for selected window. The value returned by `window-point' used to be incorrect when its argument was the selected window. Now the value is correct. ** Window configurations may be saved as Lisp objects. The function `current-window-configuration' returns a special type of Lisp object that represents the current layout of windows: the sizes and positions of windows, which buffers appear in them, and which parts of the buffers appear on the screen. The function `set-window-configuration' takes one argument, which must be a window configuration object, and restores that configuration. ** New hook `temp-output-buffer-show-hook'. This hook allows you to control how help buffers are displayed. Whenever `with-output-to-temp-buffer' has executed its body and wants to display the temp buffer, if this variable is bound and non-`nil' then its value is called with one argument, the temp buffer. The hook function is solely responsible for displaying the buffer. The standard manner of display--making the buffer appear in a window--is used only if there is no hook function. ** New function `minibuffer-window'. This function returns the window used (sometimes) for displaying the minibuffer. It can be used even when the minibuffer is not active. ** New feature to `next-window'. If the optional second argument is neither `nil' nor `t', the minibuffer window is omitted from consideration even when active; if the starting window was the last non-minibuffer window, the value will be the first non-minibuffer window. ** New variable `minibuffer-scroll-window'. When this variable is non-`nil', the command `scroll-other-window' uses it as the window to be scrolled. Displays of completion-lists set this variable to the window containing the display. ** New argument to `sit-for'. A non-nil second argument to `sit-for' means do not redisplay; just wait for the specified time or until input is available. ** Deleted function `set-minor-mode'; minor modes must be changed. The function `set-minor-mode' has been eliminated. The display of minor mode names in the mode line is now controlled by the variable `minor-mode-alist'. To specify display of a new minor mode, it is sufficient to add an element to this list. Once that is done, you can turn the mode on and off just by setting a variable, and the display will show its status automatically. ** New variable `cursor-in-echo-area'. If this variable is non-nil, the screen cursor appears on the last line of the screen, at the end of the text displayed there. Binding this variable to t is useful at times when reading single characters of input with `read-char'. ** New per-buffer variable `selective-display-ellipses'. If this variable is non-nil, an ellipsis (`...') appears on the screen at the end of each text line that is followed by invisible text. If this variable is nil, no ellipses appear. Then there is no sign on the screen that invisible text is present. Text is made invisible under the control of the variable `selective-display'; this is how Outline mode and C-x $ work. ** New variable `no-redraw-on-reenter'. If you set this variable non-nil, Emacs will not clear the screen when you resume it after suspending it. This is for the sake of terminals with multiple screens of memory, where the termcap entry has been set up to switch between screens when Emacs is suspended and resumed. ** New argument to `set-screen-height' or `set-screen-width'. These functions now take an optional second argument which says what significance the newly specified height or width has. If the argument is nil, or absent, it means that Emacs should believe that the terminal height or width really is as just specified. If the argument is t, it means Emacs should not believe that the terminal really is this high or wide, but it should use the specific height or width as the number of lines or columns to display. Thus, you could display only 24 lines on a screen known to have 48 lines. What practical difference is there between using only 24 lines for display and really believing that the terminal has 24 lines? 1. The "real" height of the terminal says what the terminal command to move the cursor to the last line will do. 2. The "real" height of the terminal determines how much padding is needed. * File-related changes. ** New parameter `backup-by-copying-when-mismatch'. If this variable is non-`nil', then when Emacs is about to save a file, it will create the backup file by copying if that would avoid changing the file's uid or gid. The default value of this variable is `nil', because usually it is useful to have the uid of a file change according to who edited it last. I recommend thet this variable be left normally `nil' and changed with a local variables list in those particular files where the uid needs to be preserved. ** New parameter `file-precious-flag'. If this variable is non-`nil', saving the buffer tries to avoid leaving an incomplete file due to disk full or other I/O errors. It renames the old file before saving. If saving is successful, the renamed file is deleted; if saving gets an error, the renamed file is renamed back to the name you visited. Backups are always made by copying for such files. ** New variable `buffer-offer-save'. If the value of this variable is non-`nil' in a buffer then exiting Emacs will offer to save the buffer (if it is modified and nonempty) even if the buffer is not visiting a file. This variable is automatically made local to the current buffer whenever it is set. ** `rename-file', `copy-file', `add-name-to-file' and `make-symbolic-link'. The third argument to these functions used to be `t' or `nil'; `t' meaning go ahead even if the specified new file name already has a file, and `nil' meaning to get an error. Now if the third argument is a number it means to ask the user for confirmation in this case. ** New optional argument to `copy-file'. If `copy-file' receives a non-nil fourth argument, it attempts to give the new copy the same time-of-last-modification that the original file has. ** New function `file-newer-than-file-p'. (file-newer-than-file-p FILE1 FILE2) returns non-nil if FILE1 has been modified more recently than FILE2. If FILE1 does not exist, the value is always nil; otherwise, if FILE2 does not exist, the value is t. This is meant for use when FILE2 depends on FILE1, to see if changes in FILE1 make it necessary to recompute FILE2 from it. ** Changed function `file-exists-p'. This function is no longer the same as `file-readable-p'. `file-exists-p' can now return t for a file that exists but which the fascists won't allow you to read. ** New function `file-locked-p'. This function receives a file name as argument and returns `nil' if the file is not locked, `t' if locked by this Emacs, or a string giving the name of the user who has locked it. ** New function `file-name-sans-versions'. (file-name-sans-versions NAME) returns a substring of NAME, with any version numbers or other backup suffixes deleted from the end. ** New functions for directory names. Although a directory is really a kind of file, specifying a directory uses a somewhat different syntax from specifying a file. In Emacs, a directory name is used as part of a file name. On Unix, the difference is small: a directory name ends in a slash, while a file name does not: thus, `/usr/rms/' to name a directory, while `/usr/rms' names the file which holds that directory. On VMS, the difference is considerable: `du:[rms.foo]' specifies a directory, but the name of the file that holds that directory is `du:[rms]foo.dir'. There are two new functions for converting between directory names and file names. `directory-file-name' takes a directory name and returns the name of the file in which that directory's data is stored. `file-name-as-directory' takes the name of a file and returns the corresponding directory name. These always understand Unix file name syntax; on VMS, they understand VMS syntax as well. For example, (file-name-as-directory "/usr/rms") returns "/usr/rms/" and (directory-file-name "/usr/rms/") returns "/usr/rms". On VMS, (file-name-as-directory "du:[rms]foo.dir") returns "du:[rms.foo]" and (directory-file-name "du:[rms.foo]") returns "du:[rms]foo.dir". ** Value of `file-attributes' changed. The function file-attributes returns a list containing many kinds of information about a file. Now the list has eleven elements. The tenth element is `t' if deleting the file and creating another file of the same name would result in a change in the file's group; `nil' if there would be no change. You can also think of this as comparing the file's group with the default group for files created in the same directory by you. The eleventh element is the inode number of the file. ** VMS-only function `file-name-all-versions'. This function returns a list of all the completions, including version number, of a specified version-number-less file name. This is like `file-name-all-completions', except that the latter returns values that do not include version numbers. ** VMS-only variable `vms-stmlf-recfm'. On a VMS system, if this variable is non-nil, Emacs will give newly created files the record format `stmlf'. This is necessary for files that must contain lines of arbitrary length, such as compiled Emacs Lisp. When writing a new version of an existing file, Emacs always keeps the same record format as the previous version; so this variable has no effect. This variable has no effect on Unix systems. ** `insert-file-contents' on an empty file. This no longer sets the buffer's "modified" flag. ** New function (VMS only) `define-logical-name': (define-logical-name LOGICAL TRANSLATION) defines a VMS logical name LOGICAL whose translation is TRANSLATION. The new name applies to the current process only. ** Deleted variable `ask-about-buffer-names'. If you want buffer names for files to be generated in a special way, you must redefine `create-file-buffer'. * Subprocess-related changes. ** New function `process-list'. This function takes no arguments and returns a list of all of Emacs's asynchronous subprocesses. ** New function `process-exit-status'. This function, given a process, process name or buffer as argument, returns the exit status code or signal number of the process. If the process has not yet exited or died, this function returns 0. ** Process output ignores `buffer-read-only'. Output from a process will go into the process's buffer even if the buffer is read only. ** Switching buffers in filter functions and sentinels. Emacs no longer saves and restore the current buffer around calling the filter and sentinel functions, so these functions can now permanently alter the selected buffer in a straightforward manner. ** Specifying environment variables for subprocesses. When a subprocess is started with `start-process' or `call-process', the value of the variable `process-environment' is taken to specify the environment variables to give the subprocess. The value should be a list of strings, each of the form "VAR=VALUE". `process-environment' is initialized when Emacs starts up based on Emacs's environment. ** New variable `process-connection-type'. If this variable is `nil', when a subprocess is created, Emacs uses a pipe rather than a pty to communicate with it. Normally this variable is `t', telling Emacs to use a pty if ptys are supported and one is available. ** New function `waiting-for-user-input-p'. This function, given a subprocess as argument, returns `t' if that subprocess appears to be waiting for input sent from Emacs, or `nil' otherwise. ** New hook `shell-set-directory-error-hook'. The value of this variable is called, with no arguments, whenever Shell mode gets an error trying to keep track of directory-setting commands (such as `cd' and `pushd') used in the shell buffer. * New functions `user-uid' and `user-real-uid'. These functions take no arguments and return, respectively, the effective uid and the real uid of the Emacs process. The value in each case is an integer. * New variable `print-escape-newlines' controls string printing. If this variable is non-`nil', then when a Lisp string is printed by the Lisp printing function `prin1' or `print', newline characters are printed as `\n' rather than as a literal newline. * New function `sysnetunam' on HPUX. This function takes two arguments, a network address PATH and a login string LOGIN, and executes the system call `netunam'. It returns `t' if the call succeeds, otherwise `nil'. News regarding installation: * Many `s-...' file names changed. Many `s-...' files have been renamed. All periods in such names, except the ones just before the final `h', have been changed to hyphens. Thus, `s-bsd4.2.h' has been renamed to `s-bsd4-2.h'. This is so a Unix distribution can be moved mechanically to VMS. * `DOCSTR...' file now called `DOC-...'. The file of on-line documentation strings, that used to be `DOCSTR.mm.nn.oo' in this directory, is now called `DOC-mm.nn.oo'. This is so that it can port to VMS using the standard conventions for translating filenames for VMS. This file also now contains the doc strings for variables as well as functions. * Emacs no longer uses floating point arithmetic. This may make it easier to port to some machines. * Macros `XPNTR' and `XSETPNTR'; flag `DATA_SEG_BITS'. These macros exclusively are used to unpack a pointer from a Lisp_Object and to insert a pointer into a Lisp_Object. Redefining them may help port Emacs to machines in which all pointers to data objects have certain high bits set. If `DATA_SEG_BITS' is defined, it should be a number which contains the high bits to be inclusive or'ed with pointers that are unpacked. * New flag `HAVE_X_MENU'. Define this flag in `config.h' in addition to `HAVE_X_WINDOWS' to enable use of the Emacs interface to X Menus. On some operating systems, the rest of the X interface works properly but X Menus do not work; hence this separate flag. See the file `src/xmenu.c' for more information. * Macros `ARRAY_MARK_FLAG' and `DONT_COPY_FLAG'. * `HAVE_ALLOCA' prevents assembly of `alloca.s'. * `SYSTEM_MALLOC' prevents use of GNU `malloc.c'. SYSTEM_MALLOC, if defined, means use the system's own `malloc' routines rather than those that come with Emacs. Use this only if absolutely necessary, because if it is used you do not get warnings when space is getting low. * New flags to control unexec. See the file `unexec.c' for a long comment on the compilation switches that suffice to make it work on many machines. * `PNTR_COMPARISON_TYPE' Pointers that need to be compared for ordering are converted to this type first. Normally this is `unsigned int'. * `HAVE_VFORK', `HAVE_DUP2' and `HAVE_GETTIMEOFDAY'. These flags just say whether certain system calls are available. * New macros control compiler switches, linker switches and libraries. The m- and s- files can now control in a modular fashion the precise arguments passed to `cc' and `ld'. LIBS_STANDARD defines the standard C libraries. Default is `-lc'. LIBS_DEBUG defines the extra libraries to use when debugging. Default `-lg'. LIBS_SYSTEM can be defined by the s- file to specify extra libraries. LIBS_MACHINE can be defined by the m- file to specify extra libraries. LIBS_TERMCAP defines the libraries for Termcap or Terminfo. It is defined by default in a complicated fashion but the m- or s- file can override it. LD_SWITCH_SYSTEM can be defined by the s- file to specify extra `ld' switches. The default is `-X' on BSD systems except those few that use COFF object files. LD_SWITCH_MACHINE can be defined by the m- file to specify extra `ld' switches. C_DEBUG_SWITCH defines the switches to give `cc' when debugging. Default `-g'. C_OPTIMIZE_SWITCH defines the switches to give `cc' to optimize. Default `-O'. C_SWITCH_MACHINE can be defined by the m- file to specify extra `cc' switches. For older news, see the file OONEWS. ---------------------------------------------------------------------- Copyright information: Copyright (C) 1992 Free Software Foundation, Inc. Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the copyright notice and this permission notice are preserved, thus giving the recipient permission to redistribute in turn. Permission is granted to distribute modified versions of this document, or of portions of it, under the above conditions, provided also that they carry prominent notices stating who last changed them. Local variables: mode: text end: emacs-19.30/etc/OONEWS100666 12120 13 173762 5335275277 12453 0ustar rmsuserGNU Emacs NEWS -- history of user-visible changes. 17-Aug-1988 Copyright (C) 1988 Free Software Foundation, Inc. See the end for copying conditions. For older news, see the file OOONEWS. Changes in version 18.52. * X windows version 10 is supported under system V. * Pop-up menus are now supported with the same Lisp interface in both version 10 and 11 of X windows. * C-x 4 a is a new command to edit a change-log entry in another window. * The emacs client program now allows an option +NNN to specify the line number to go to in the file whose name follows. Thus, emacsclient foo.c +45 bar.c will find the files `foo.c' and `bar.c', going to line 45 in `bar.c'. * Dired allows empty directories to be deleted like files. * When the terminal type is used to find a terminal-specific file to run, Emacs now tries the entire terminal type first. If that doesn't yield a file that exists, the last hyphen and what follows it is stripped. If that doesn't yield a file that exists, the previous hyphen is stripped, and so on until all hyphens are gone. For example, if the terminal type is `aaa-48-foo', Emacs will try first `term/aaa-48-foo.el', then `term/aaa-48.el' and finally `term/aaa.el'. Underscores now receive the same treatment as hyphens. * Texinfo features: @defun, etc. texinfo-show-structure. New template commands. texinfo-format-region. * The special "local variable" `eval' is now ignored if you are running as root. * New command `c-macro-expand' shows the result of C macro expansion in the region. It works using the C preprocessor, so its results are completely accurate. * Errors in trying to auto save now flash error messages for a few seconds. * Killing a buffer now sends SIGHUP to the buffer's process. * New hooks. ** `spell-region' now allows you to filter the text before spelling-checking. If the value of `spell-filter' is non-nil, it is called, with no arguments, looking at a temporary buffer containing a copy of the text to be checked. It can alter the text freely before the spell program sees it. ** The variable `lpr-command' now specifies the command to be used when you use the commands to print text (such as M-x print-buffer). ** Posting netnews now calls the value of `news-inews-hook' (if not nil) as a function of no arguments before the actual posting. ** Rmail now calls the value of `rmail-show-message-hook' (if not nil) as a function of no arguments, each time a new message is selected. ** `kill-emacs' calls the value of `kill-emacs-hook' as a function of no args. * New libraries. See the source code of each library for more information. ** icon.el: a major mode for editing programs written in Icon. ** life.el: a simulator for the cellular automaton "life". Load the library and run M-x life. ** doctex.el: a library for converting the Emacs `etc/DOC' file of documentation strings into TeX input. ** saveconf.el: a library which records the arrangement of windows and buffers when you exit Emacs, and automatically recreates the same setup the next time you start Emacs. ** uncompress.el: a library that automatically uncompresses files when you visit them. ** c-fill.el: a mode for editing filled comments in C. ** kermit.el: an extended version of shell-mode designed for running kermit. ** spook.el: a library for adding some "distract the NSA" keywords to every message you send. ** hideif.el: a library for hiding parts of a C program based on preprocessor conditionals. ** autoinsert.el: a library to put in some initial text when you visit a nonexistent file. The text used depends on the major mode, and comes from a directory of files created by you. * New programming features. ** The variable `window-system-version' now contains the version number of the window system you are using (if appropriate). When using X windows, its value is either 10 or 11. ** (interactive "N") uses the prefix argument if any; otherwise, it reads a number using the minibuffer. ** VMS: there are two new functions `vms-system-info' and `shrink-to-icon'. The former allows you to get many kinds of system status information. See its self-documentation for full details. The second is used with the window system: it iconifies the Emacs window. ** VMS: the new function `define-logical-name' allows you to create job-wide logical names. The old function `define-dcl-symbol' has been removed. Changes in version 18.50. * X windows version 11 is supported. Define X11 in config.h if you want X version 11 instead of version 10. * The command M-x gdb runs the GDB debugger as an inferior. It asks for the filename of the executable you want to debug. GDB runs as an inferior with I/O through an Emacs buffer. All the facilities of Shell mode are available. In addition, each time your program stops, and each time you select a new stack frame, the source code is displayed in another window with an arrow added to the line where the program is executing. Special GDB-mode commands include M-s, M-n, M-i, M-u, M-d, and C-c C-f which send the GDB commands `step', `next', `stepi', `up', `down' and `finish'. In any source file, the commands C-x SPC tells GDB to set a breakpoint on the current line. * M-x calendar displays a three-month calendar. * C-u 0 C-x C-s never makes a backup file. This is a way you can explicitly request not to make a backup. * `term-setup-hook' is for users only. Emacs never uses this variable for internal purposes, so you can freely set it in your `.emacs' file to make Emacs do something special after loading any terminal-specific setup file from `lisp/term'. * `copy-keymap' now copies recursive submaps. * New overlay-arrow feature. If you set the variable `overlay-arrow-string' to a string and `overlay-arrow-position' to a marker, that string is displayed on the screen at the position of that marker, hiding whatever text would have appeared there. If that position isn't on the screen, or if the buffer the marker points into isn't displayed, there is no effect. * -batch mode can read from the terminal. It now works to use `read-char' to do terminal input in a noninteractive Emacs run. End of file causes Emacs to exit. * Variables `data-bytes-used' and `data-bytes-free' removed. These variables cannot really work because the 24-bit range of an integer in (most ports of) GNU Emacs is not large enough to hold their values on many systems. Changes in version 18.45, since version 18.41. * C indentation parameter `c-continued-brace-offset'. This parameter's value is added to the indentation of any line that is in a continuation context and starts with an open-brace. For example, it applies to the open brace shown here: if (x) { The default value is zero. * Dabbrev expansion (Meta-/) preserves case. When you use Meta-/ to search the buffer for an expansion of an abbreviation, if the expansion found is all lower case except perhaps for its first letter, then the case pattern of the abbreviation is carried over to the expansion that replaces it. * TeX-mode syntax. \ is no longer given "escape character" syntax in TeX mode. It now has the syntax of an ordinary punctuation character. As a result, \[...\] and such like are considered to balance each other. * Mail-mode automatic Reply-to field. If the variable `mail-default-reply-to' is non-`nil', then each time you start to compose a message, a Reply-to field is inserted with its contents taken from the value of `mail-default-reply-to'. * Where is your .emacs file? If you run Emacs under `su', so your real and effective uids are different, Emacs uses the home directory associated with the real uid (the name you actually logged in under) to find the .emacs file. Otherwise, Emacs uses the environment variable HOME to find the .emacs file. The .emacs file is not loaded at all if -batch is specified. * Prolog mode is the default for ".pl" files. * File names are not case-sensitive on VMS. On VMS systems, all file names that you specify are converted to upper case. You can use either upper or lower case indiscriminately. * VMS-only function 'define-dcl-symbol'. This is a new name for the function formerly called `define-logical-name'. Editing Changes in Emacs 18 * Additional systems and machines are supported. GNU Emacs now runs on Vax VMS. However, many facilities that are normally implemented by running subprocesses do not work yet. This includes listing a directory and sending mail. There are features for running subprocesses but they are incompatible with those on Unix. I hope that some of the VMS users can reimplement these features for VMS (compatibly for the user, if possible). VMS wizards are also asked to work on making the subprocess facilities more upward compatible with those on Unix, and also to rewrite their internals to use the same Lisp objects that are used on Unix to represent processes. In addition, the TI Nu machine running Unix system V, the AT&T 3b, and the Wicat, Masscomp, Integrated Solutions, Alliant, Amdahl uts, Mips, Altos 3068 and Gould Unix systems are now supported. The IBM PC-RT is supported under 4.2, but not yet under system V. The GEC 93 is close to working. The port for the Elxsi is partly merged. See the file MACHINES for full status information and machine-specific installation advice. * Searching is faster. Forward search for a text string, or for a regexp that is equivalent to a text string, is now several times faster. Motion by lines and counting lines is also faster. * Memory usage improvements. It is no longer possible to run out of memory during garbage collection. As a result, running out of memory is never fatal. This is due to a new garbage collection algorithm which compactifies strings in place rather than copying them. Another consequence of the change is a reduction in total memory usage and a slight increase in garbage collection speed. * Display changes. ** Editing above top of screen. When you delete or kill or alter text that reaches to the top of the screen or above it, so that display would start in the middle of a line, Emacs will usually attempt to scroll the text so that display starts at the beginning of a line again. ** Yanking in the minibuffer. The message "Mark Set" is no longer printed when the minibuffer is active. This is convenient with many commands, including C-y, that normally print such a message. ** Cursor appears in last line during y-or-n questions. Questions that want a `y' or `n' answer now move the cursor to the last line, following the question. * Library loading changes. `load' now considers all possible suffixes (`.elc', `.el' and none) for each directory in `load-path' before going on to the next directory. It now accepts an optional fourth argument which, if non-nil, says to use no suffixes; then the file name must be given in full. The search of the directories in `load-path' goes on as usual in this case, but it too can be prevented by passing an absolute file name. The value of `load-path' no longer by default includes nil (meaning to look in the current default directory). The idea is that `load' should be used to search the path only for libraries to be found in the standard places. If you want to override system libraries with your own, place your own libraries in one special directory and add that directory to the front of `load-path'. The function `load' is no longer a command; that is to say, `M-x load' is no longer allowed. Instead, there are two commands for loading files. `M-x load-library' is equivalent to the old meaning of `M-x load'. `M-x load-file' reads a file name with completion and defaulting and then loads exactly that file, with no searching and no suffixes. * Emulation of other editors. ** `edt-emulation-on' starts emulating DEC's EDT editor. Do `edt-emulation-off' to return Emacs to normal. ** `vi-mode' and `vip-mode' starts emulating vi. These are two different vi emulations provided by GNU Emacs users. We are interested in feedback as to which emulation is preferable. See the documentation and source code for these functions for more information. ** `set-gosmacs-bindings' emulates Gosling Emacs. This command changes many global bindings to resemble those of Gosling Emacs. The previous bindings are saved and can be restored using `set-gnu-bindings'. * Emulation of a display terminal. Within Emacs it is now possible to run programs (such as emacs or supdup) which expect to do output to a visual display terminal. See the function `terminal-emulator' for more information. * New support for keypads and function keys. There is now a first attempt at terminal-independent support for keypad and function keys. Emacs now defines a standard set of key-names for function and keypad keys, and provides standard hooks for defining them. Most of the standard key-names have default definitions built into Emacs; you can override these in a terminal-independent manner. The default definitions and the conventions for redefining them are in the file `lisp/keypad.el'. These keys on the terminal normally work by sending sequences of characters starting with ESC. The exact sequences used vary from terminal to terminal. Emacs interprets them in two stages: in the first stage, terminal-dependent sequences are mapped into the standard key-names; then second stage maps the standard key-names into their definitions in a terminal-independent fashion. The terminal-specific file `term/$TERM.el' now is responsible only for establishing the mapping from the terminal's escape sequences into standard key-names. It no longer knows what Emacs commands are assigned to the standard key-names. One other change in terminal-specific files: if the value of the TERM variable contains a hyphen, only the part before the first hyphen is used in forming the name of the terminal-specific file. Thus, for terminal type `aaa-48', the file loaded is now `term/aaa.el' rather than `term/aaa-48.el'. * New startup command line options. `-i FILE' or `-insert FILE' in the command line to Emacs tells Emacs to insert the contents of FILE into the current buffer at that point in command line processing. This is like using the command M-x insert-file. `-funcall', `-load', `-user' and `-no-init-file' are new synonyms for `-f', `-l', `-u' and `-q'. `-nw' means don't use a window system. If you are using a terminal emulator on the X window system and you want to run Emacs to work through the terminal emulator instead of working directly with the window system, use this switch. * Buffer-sorting commands. Various M-x commands whose names start with `sort-' sort parts of the region: sort-lines divides the region into lines and sorts them alphabetically. sort-pages divides into pages and sorts them alphabetically. sort-paragraphs divides into paragraphs and sorts them alphabetically. sort-fields divides into lines and sorts them alphabetically according to one field in the line. The numeric argument specifies which field (counting from field 1 at the beginning of the line). Fields in a line are separated by whitespace. sort-numeric-fields is similar but converts the specified fields to numbers and sorts them numerically. sort-columns divides into lines and sorts them according to the contents of a specified range of columns. Refer to the self-documentation of these commands for full usage information. * Changes in various commands. ** `tags-query-replace' and `tags-search' change. These functions now display the name of the file being searched at the moment. ** `occur' output now serves as a menu. `occur-menu' command deleted. `M-x occur' now allows you to move quickly to any of the occurrences listed. Select the `*Occur*' buffer that contains the output of `occur', move point to the occurrence you want, and type C-c C-c. This will move point to the same occurrence in the buffer that the occurrences were found in. The command `occur-menu' is thus obsolete, and has been deleted. One way to get a list of matching lines without line numbers is to copy the text to another buffer and use the command `keep-lines'. ** Incremental search changes. Ordinary and regexp incremental searches now have distinct default search strings. Thus, regexp searches recall only previous regexp searches. If you exit an incremental search when the search string is empty, the old default search string is kept. The default does not become empty. Reversing the direction of an incremental search with C-s or C-r when the search string is empty now does not get the default search string. It leaves the search string empty. A second C-s or C-r will get the default search string. As a result, you can do a reverse incremental regexp search with C-M-s C-r. If you add a `*', `?' or `\|' to an incremental search regexp, point will back up if that is appropriate. For example, if you have searched for `ab' and add a `*', point moves to the first match for `ab*', which may be before the match for `ab' that was previously found. If an incremental search is failing and you ask to repeat it, it will start again from the beginning of the buffer (or the end, if it is a backward search). The search-controlling parameters `isearch-slow-speed' and `isearch-slow-window-lines' have now been renamed to start with `search' instead of `isearch'. Now all the parameters' names start with `search'. If `search-slow-window-lines' is negative, the slow search window is put at the top of the screen, and the absolute value or the negative number specifies the height of it. ** Undo changes The undo command now will mark the buffer as unmodified only when it is identical to the contents of the visited file. ** C-M-v in minibuffer. If while in the minibuffer you request help in a way that uses a window to display something, then until you exit the minibuffer C-M-v in the minibuffer window scrolls the window of help. For example, if you request a list of possible completions, C-M-v can be used reliably to scroll the completion list. ** M-TAB command. Meta-TAB performs completion on the Emacs Lisp symbol names. The sexp in the buffer before point is compared against all existing nontrivial Lisp symbols and completed as far as is uniquely determined by them. Nontrivial symbols are those with either function definitions, values or properties. If there are multiple possibilities for the very next character, a list of possible completions is displayed. ** Dynamic abbreviation package. The new command Meta-/ expands an abbreviation in the buffer before point by searching the buffer for words that start with the abbreviation. ** Changes in saving kbd macros. The commands `write-kbd-macro' and `append-kbd-macro' have been deleted. The way to save a keyboard macro is to use the new command `insert-kbd-macro', which inserts Lisp code to define the macro as it is currently defined into the buffer before point. Visit a Lisp file such as your Emacs init file `~/.emacs', insert the macro definition (perhaps deleting an old definition for the same macro) and then save the file. ** C-x ' command. The new command C-x ' (expand-abbrev) expands the word before point as an abbrev, even if abbrev-mode is not turned on. ** Sending to inferior Lisp. The command C-M-x in Lisp mode, which sends the current defun to an inferior Lisp process, now works by writing the text into a temporary file and actually sending only a `load'-form to load the file. As a result, it avoids the Unix bugs that used to strike when the text was above a certain length. With a prefix argument, this command now makes the inferior Lisp buffer appear on the screen and scrolls it so that the bottom is showing. Two variables `inferior-lisp-load-command' and `inferior-lisp-prompt', exist to customize these feature for different Lisp implementations. ** C-x p now disabled. The command C-x p, a nonrecomended command which narrows to the current page, is now initially disabled like C-x n. * Dealing with files. ** C-x C-v generalized This command is now allowed even if the current buffer is not visiting a file. As usual, it kills the current buffer and replaces it with a newly found file. ** M-x recover-file improved; auto save file names changed. M-x recover-file now checks whether the last auto-save file is more recent than the real visited file before offering to read in the auto-save file. If the auto-save file is newer, a directory listing containing the two files is displayed while you are asked whether you want the auto save file. Visiting a file also makes this check. If the auto-save file is more recent, a message is printed suggesting that you consider using M-x recover file. Auto save file names now by default have a `#' at the end as well as at the beginning. This is so that `*.c' in a shell command will never match auto save files. On VMS, auto save file names are made by appending `_$' at the front and `$' at the end. When you change the visited file name of a buffer, the auto save file is now renamed to belong to the new visited file name. You can customize the way auto save file names are made by redefining the two functions `make-auto-save-file-name' and `auto-save-file-name-p', both of which are defined in `files.el'. ** Modifying a buffer whose file is changed on disk is detected instantly. On systems where clash detection (locking of files being edited) is implemented, Emacs also checks the first time you modify a buffer whether the file has changed on disk since it was last visited or saved. If it has, you are asked to confirm that you want to change the buffer. ** Exiting Emacs offers to save `*mail*'. Emacs can now know about buffers that it should offer to save on exit even though they are not visiting files. This is done for any buffer which has a non-nil local value of `buffer-offer-save'. By default, Mail mode provides such a local value. ** Backup file changes. If a backup file cannot be written in the directory of the visited file due to fascist file protection, a backup file is now written in your home directory as `~/%backup%~'. Only one such file is made, ever, so only the most recently made such backup is available. When backup files are made by copying, the last-modification time of the original file is now preserved in the backup copy. ** Visiting remote files. On an internet host, you can now visit and save files on any other internet host directly from Emacs with the commands M-x ftp-find-file and M-x ftp-write-file. Specify an argument of the form HOST:FILENAME. Since standard internet FTP is used, the other host may be any kind of machine and is not required to have any special facilities. The first time any one remote host is accessed, you will be asked to give the user name and password for use on that host. FTP is reinvoked each time you ask to use it, but previously specified user names and passwords are remembered automatically. ** Dired `g' command. `g' in Dired mode is equivalent to M-x revert-buffer; it causes the current contents of the same directory to be read in. * Changes in major modes. ** C mode indentation change. The binding of Linefeed is no longer changed by C mode. It once again has its normal meaning, which is to insert a newline and then indent afterward. The old definition did one additional thing: it reindented the line before the new newline. This has been removed because it made the command twice as slow. The only time it was really useful was after the insertion of an `else', since the fact of starting with `else' may change the way that line is indented. Now you will have to type TAB again yourself to reindent the `else' properly. If the variable `c-tab-always-indent' is set to `nil', the TAB command in C mode, with no argument, will just insert a tab character if there is non-whitespace preceding point on the current line. Giving it a prefix argument will force reindentation of the line (as well as of the compound statement that begins after point, if any). ** Fortran mode now exists. This mode provides commands for motion and indentation of Fortran code, plus built-in abbrevs for Fortran keywords. For details, see the manual or the on-line documentation of the command `fortran-mode'. ** Scribe mode now exists. This mode does something useful for editing files of Scribe input. It is used automatically for files with names ending in ".mss". ** Modula2 and Prolog modes now exist. These modes are for editing programs in the languages of the same names. They can be selected with M-x modula-2-mode and M-x prolog-mode. ** Telnet mode changes. The telnet mode special commands have now been assigned to C-c keys. Most of them are the same as in Shell mode. ** Picture mode changes. The special picture-mode commands to specify the direction of cursor motion after insertion have been moved to C-c keys. The commands to specify diagonal motion were already C-c keys; they are unchanged. The keys to specify horizontal or vertical motion are now C-c < (left), C-c > (right), C-c ^ (up) and C-c . (down). ** Nroff mode comments. Comments are now supported in Nroff mode. The standard comment commands such as M-; and C-x ; know how to insert, align and delete comments that start with backslash-doublequote. ** LaTeX mode. LaTeX mode now exists. Use M-x latex-mode to select this mode, and M-x plain-tex-mode to select the previously existing mode for Plain TeX. M-x tex-mode attempts to examine the contents of the buffer and choose between latex-mode and plain-tex-mode accordingly; if the buffer is empty or it cannot tell, the variable `TeX-default-mode' controls the choice. Its value should be the symbol for the mode to be used. The facilities for running TeX on all or part of the buffer work with LaTeX as well. Some new commands available in both modes: C-c C-l recenter the window showing the TeX output buffer so most recent line of output can be seen. C-c C-k kill the TeX subprocess. C-c C-q show the printer queue. C-c C-f close a block (appropriate for LaTeX only). If the current line contains a \begin{...}, this inserts an \end{...} on the following line and puts point on a blank line between them. ** Outline mode changes. Invisible lines in outline mode are now indicated by `...' at the end of the previous visible line. The special outline heading motion commands are now all on C-c keys. A few new ones have been added. Here is a full list: C-c C-n Move to next visible heading (formerly M-}) C-c C-p Move to previous visible heading (formerly M-{) C-c C-f Move to next visible heading at the same level. Thus, if point is on a level-2 heading line, this command moves to the next visible level-2 heading. C-c C-b Move to previous visible heading at the same level. C-c C-u Move up to previous visible heading at a higher level. The variable `outline-regexp' now controls recognition of heading lines. Any line whose beginning matches this regexp is a heading line. The depth in outline structure is determined by the length of the string that matches. A line starting with a ^L (formfeed) is now by default considered a header line. * Mail reading and sending. ** MH-E changes. MH-E has been extensively modified and improved since the v17 release. It contains many new features, including commands to: extracted failed messages, kill a draft message, undo changes to a mail folder, monitor delivery of a letter, print multiple messages, page digests backwards, insert signatures, and burst digests. Also, many commands have been made to able to deal with named sequences of messages, instead of single messages. MH-E also has had numerous bugs fixed and commands made to run faster. Furthermore, its keybindings have been changed to be compatible with Rmail and the rest of GNU Emacs. ** Mail mode changes. The C-c commands of mail mode have been rearranged: C-c s, C-c c, C-c t and C-c b (move point to various header fields) have been reassigned as C-c C-f C-s, C-c C-f C-c, C-c C-f C-t and C-c C-f C-b. C-c C-f is for "field". C-c y, C-c w and C-c q have been changed to C-c C-y, C-c C-w and C-c C-q. Thus, C-c LETTER is always unassigned. ** Rmail C-r command changed to w. The Rmail command to edit the current message is now `w'. This change has been made because people frequently type C-r while in Rmail hoping to do a reverse incremental search. That now works. * Rnews changes. ** Caesar rotation added. The function news-caesar-buffer-body performs encryption and decryption of the body of a news message. It defaults to the USENET standard of 13, and accepts any numeric arg between 1 to 25 and -25 to -1. The function is bound to C-c C-r in both news-mode and news-reply-mode. ** rmail-output command added. The C-o command has been bound to rmail-output in news-mode. This allows one to append an article to a file which is in either Unix mail or RMAIL format. ** news-reply-mode changes. The C-c commands of news reply mode have been rearranged and changed, so that C-c LETTER is always unassigned: C-c y, C-c w and C-c q have been changed to C-c C-y, C-c C-w and C-c C-q. C-c c, C-c t, and C-c b (move to various mail header fields) have been deleted (they make no sense for posting and replying to USENET). C-c s (move to Subject: header field) has been reassigned as C-c C-f C-s. C-c C-f is for "field". Several additional move to news header field commands have been added. The local news-reply-mode bindings now look like this: C-c C-s news-inews (post the message) C-c C-c news-inews C-c C-f move to a header field (and create it if there isn't): C-c C-f C-n move to Newsgroups: C-c C-f C-s move to Subj: C-c C-f C-f move to Followup-To: C-c C-f C-k move to Keywords: C-c C-f C-d move to Distribution: C-c C-f C-a move to Summary: C-c C-y news-reply-yank-original (insert current message, in NEWS). C-c C-q mail-fill-yanked-message (fill what was yanked). C-c C-r caesar rotate all letters by 13 places in the article's body (rot13). * Existing Emacs usable as a server. Programs such as mailers that invoke "the editor" as an inferior to edit some text can now be told to use an existing Emacs process instead of creating a new editor. To do this, you must have an Emacs process running and capable of doing terminal I/O at the time you want to invoke it. This means that either you are using a window system and give Emacs a separate window or you run the other programs as inferiors of Emacs (such as, using M-x shell). First prepare the existing Emacs process by loading the `server' library and executing M-x server-start. (Your .emacs can do this automatically.) Now tell the other programs to use, as "the editor", the Emacs client program (etc/emacsclient, located in the same directory as this file). This can be done by setting the environment variable EDITOR. When another program invokes the emacsclient as "the editor", the client actually transfers the file names to be edited to the existing Emacs, which automatically visits the files. When you are done editing a buffer for a client, do C-x # (server-edit). This marks that buffer as done, and selects the next buffer that the client asked for. When all the buffers requested by a client are marked in this way, Emacs tells the client program to exit, so that the program that invoked "the editor" will resume execution. You can only have one server Emacs at a time, but multiple client programs can put in requests at the same time. The client/server work only on Berkeley Unix, since they use the Berkeley sockets mechanism for their communication. Changes in Lisp programming in Emacs version 18. * Init file changes. ** Suffixes no longer accepted on `.emacs'. Emacs will no longer load a file named `.emacs.el' or `emacs.elc' in place of `.emacs'. This is so that it will take less time to find `.emacs'. If you want to compile your init file, give it another name and make `.emacs' a link to the `.elc' file, or make it contain a call to `load' to load the `.elc' file. ** `default-profile' renamed to `default', and loaded after `.emacs'. It used to be the case that the file `default-profile' was loaded if and only if `.emacs' was not found. Now the name `default-profile' is not used at all. Instead, a library named `default' is loaded after the `.emacs' file. `default' is loaded whether the `.emacs' file exists or not. However, loading of `default' can be prevented if the `.emacs' file sets `inhibit-default-init' to non-nil. In fact, you would call the default file `default.el' and probably would byte-compile it to speed execution. Note that for most purposes you are better off using a `site-init' library since that will be loaded before the runnable Emacs is dumped. By using a `site-init' library, you avoid taking up time each time Emacs is started. ** inhibit-command-line has been eliminated. This variable used to exist for .emacs files to set. It has been eliminated because you can get the same effect by setting command-line-args to nil and setting inhibit-startup-message to t. * `apply' is more general. `apply' now accepts any number of arguments. The first one is a function; the rest are individual arguments to pass to that function, except for the last, which is a list of arguments to pass. Previously, `apply' required exactly two arguments. Its old behavior follows as a special case of the new definition. * New code-letter for `interactive'. (interactive "NFoo: ") is like (interactive "nFoo: ") in reading a number using the minibuffer to serve as the argument; however, if a prefix argument was specified, it uses the prefix argument value as the argument, and does not use the minibuffer at all. This is used by the `goto-line' and `goto-char' commands. * Semantics of variables. ** Built-in per-buffer variables improved. Several built-in variables which in the past had a different value in each buffer now behave exactly as if `make-variable-buffer-local' had been done to them. These variables are `tab-width', `ctl-arrow', `truncate-lines', `fill-column', `left-margin', `mode-line-format', `abbrev-mode', `overwrite-mode', `case-fold-search', `auto-fill-hook', `selective-display', `selective-display-ellipses'. To be precise, each variable has a default value which shows through in most buffers and can be accessed with `default-value' and set with `set-default'. Setting the variable with `setq' makes the variable local to the current buffer. Changing the default value has retroactive effect on all buffers in which the variable is not local. The variables `default-case-fold-search', etc., are now obsolete. They now refer to the default value of the variable, which is not quite the same behavior as before, but it should enable old init files to continue to work. ** New per-buffer variables. The variables `fill-prefix', `comment-column' and `indent-tabs-mode' are now per-buffer. They work just like `fill-column', etc. ** New function `setq-default'. `setq-default' sets the default value of a variable, and uses the same syntax that `setq' accepts: the variable name is not evaluated and need not be quoted. `(setq-default case-fold-search nil)' would make searches case-sensitive in all buffers that do not have local values for `case-fold-search'. ** Functions `global-set' and `global-value' deleted. These functions were never used except by mistake by users expecting the functionality of `set-default' and `default-value'. * Changes in defaulting of major modes. When `default-major-mode' is `nil', new buffers are supposed to get their major mode from the buffer that is current. However, certain major modes (such as Dired mode, Rmail mode, Rmail Summary mode, and others) are not reasonable to use in this way. Now such modes' names have been given non-`nil' `mode-class' properties. If the current buffer's mode has such a property, Fundamental mode is used as the default for newly created buffers. * `where-is-internal' requires additional arguments. This function now accepts three arguments, two of them required: DEFINITION, the definition to search for; LOCAL-KEYMAP, the keymap to use as the local map when doing the searching, and FIRST-ONLY, which is nonzero to return only the first key found. This function returns a list of keys (strings) whose definitions (in the LOCAL-KEYMAP or the current global map) are DEFINITION. If FIRST-ONLY is non-nil, it returns a single key (string). This function has changed incompatibly in that now two arguments are required when previously only one argument was allowed. To get the old behavior of this function, write `(current-local-map)' as the expression for the second argument. The incompatibility is sad, but `nil' is a legitimate value for the second argument (it means there is no local keymap), so it cannot also serve as a default meaning to use the current local keymap. * Abbrevs with hooks. When an abbrev defined with a hook is expanded, it now performs the usual replacement of the abbrev with the expansion before running the hook. Previously the abbrev itself was deleted but the expansion was not inserted. * Function `scan-buffer' deleted. Use `search-forward' or `search-backward' in place of `scan-buffer'. You will have to rearrange the arguments. * X window interface improvements. ** Detect release of mouse buttons. Button-up events can now be detected. See the file `lisp/x-mouse.el' for details. ** New pop-up menu facility. The new function `x-popup-menu' pops up a menu (in a X window) and returns an indication of which selection the user made. For more information, see its self-documentation. * M-x disassemble. This command prints the disassembly of a byte-compiled Emacs Lisp function. Would anyone like to interface this to the debugger? * `insert-buffer-substring' can insert part of the current buffer. The old restriction that the text being inserted had to come from a different buffer is now lifted. When inserting text from the current buffer, the text to be inserted is determined from the specified bounds before any copying takes place. * New function `substitute-key-definition'. This is a new way to replace one command with another command as the binding of whatever keys may happen to refer to it. (substitute-key-definition OLDDEF NEWDEF KEYMAP) looks through KEYMAP for keys defined to run OLDDEF, and rebinds those keys to run NEWDEF instead. * New function `insert-char'. Insert a specified character, a specified number of times. * `mark-marker' changed. When there is no mark, this now returns a marker that points nowhere, rather than `nil'. * `ding' accepts argument. When given an argument, the function `ding' does not terminate execution of a keyboard macro. Normally, `ding' does terminate all macros that are currently executing. * New function `minibuffer-depth'. This function returns the current depth in minibuffer activations. The value is zero when the minibuffer is not in use. Values greater than one are possible if the user has entered the minibuffer recursively. * New function `documentation-property'. (documentation-property SYMBOL PROPNAME) is like (get SYMBOL PROPNAME), except that if the property value is a number `documentation-property' will take that number (or its absolute value) as a character position in the DOC file and return the string found there. (documentation-property VAR 'variable-documentation) is the proper way for a Lisp program to get the documentation of variable VAR. * New documentation-string expansion feature. If a documentation string (for a variable or function) contains text of the form `\', it means that all command names specified in `\[COMMAND]' construct from that point on should be turned into keys using the value of the variable FOO as the local keymap. Thus, for example, `\\[eval-defun] evaluates the defun containing point.' will expand into "ESC C-x evaluates the defun containing point." regardless of the current major mode, because ESC C-x is defined to run `eval-defun' in the keymap `emacs-lisp-mode-map'. The effect is to show the key for `eval-defun' in Emacs Lisp mode regardless of the current major mode. The `\<...>' construct applies to all `\[...]' constructs that follow it, up to the end of the documentation string or the next `\<...>'. Without `\<...>', the keys for commands specified in `\[...]' are found in the current buffer's local map. The current global keymap is always searched second, whether `\<...>' has been used or not. * Multiple hooks allowed in certain contexts. The old hook variables `find-file-hook', `find-file-not-found-hook' and `write-file-hook' have been replaced. The replacements are `find-file-hooks', `find-file-not-found-hooks' and `write-file-hooks'. Each holds a list of functions to be called; by default, `nil', for no functions. The functions are called in order of appearance in the list. In the case of `find-file-hooks', all the functions are executed. In the case of `find-file-not-found-hooks', if any of the functions returns non-`nil', the rest of the functions are not called. In the case of `write-file-hooks', if any of the functions returns non-`nil', the rest of the functions are not called, and the file is considered to have been written already; so actual writing in the usual way is not done. If `write-file-hooks' is local to a buffer, it is set to its global value if `set-visited-file-name' is called (and thus by C-x C-w as well). `find-file-not-found-hooks' and `write-file-hooks' can be used together to implement editing of files that are not stored as Unix files: stored in archives, or inside version control systems, or on other machines running other operating systems and accessible via ftp. * New hooks for suspending Emacs. Suspending Emacs runs the hook `suspend-hook' before suspending and the hook `suspend-resume-hook' if the suspended Emacs is resumed. Running a hook is done by applying the variable's value to no arguments if the variable has a non-`nil' value. If `suspend-hook' returns non-`nil', then suspending is inhibited and so is running the `suspend-resume-hook'. The non-`nil' value means that the `suspend-hook' has done whatever suspending is required. * Disabling commands can print a special message. A command is disabled by giving it a non-`nil' `disabled' property. Now, if this property is a string, it is included in the message printed when the user tries to run the command. * Emacs can open TCP connections. The function `open-network-stream' opens a TCP connection to a specified host and service. Its value is a Lisp object that represents the connection. The object is a kind of "subprocess", and I/O are done like I/O to subprocesses. * Display-related changes. ** New mode-line control features. The display of the mode line used to be controlled by a format-string that was the value of the variable `mode-line-format'. This variable still exists, but it now allows more general values, not just strings. Lists, cons cells and symbols are also meaningful. The mode line contents are created by outputting various mode elements one after the other. Here are the kinds of objects that can be used as mode elements, and what they do in the display: string the contents of the string are output to the mode line, and %-constructs are replaced by other text. t or nil ignored; no output results. symbol the symbol's value is used. If the value is a string, the string is output verbatim to the mode line (so %-constructs are not interpreted). Otherwise, the symbol's value is processed as a mode element. list (whose first element is a string or list or cons cell) the elements of the list are treated as as mode elements, so that the output they generate is concatenated, list (whose car is a symbol) if the symbol's value is non-nil, the second element of the list is treated as a mode element. Otherwise, the third element (if any) of the list is treated as a mode element. cons (whose car is a positive integer) the cdr of the cons is used as a mode element, but the text it produces is padded, if necessary, to have at least the width specified by the integer. cons (whose car is a negative integer) the cdr of the cons is used as a mode element, but the text it produces is truncated, if necessary, to have at most the width specified by the integer. There is always one mode element to start with, that being the value of `mode-line-format', but if this value is a list then it leads to several more mode elements, which can lead to more, and so on. There is one new %-construct for mode elements that are strings: `%n' displays ` Narrow' for a buffer that is narrowed. The default value of `mode-line-format' refers to several other variables. These variables are `mode-name', `mode-line-buffer-identification', `mode-line-process', `mode-line-modified', `global-mode-string' and `minor-mode-alist'. The first four are local in every buffer in which they are changed from the default. mode-name Name of buffer's major mode. Local in every buffer. mode-line-buffer-identification Normally the list ("Emacs: %17b"), it is responsible for displaying text to indicate what buffer is being shown and what kind of editing it is doing. `Emacs' means that a file of characters is being edited. Major modes such as Info and Dired which edit or view other kinds of data often change this value. This variables becomes local to the current buffer if it is setq'd. mode-line-process Normally nil, this variable is responsible for displaying information about the process running in the current buffer. M-x shell-mode and M-x compile alter this variable. mode-line-modified This variable is responsible for displaying the indication of whether the current buffer is modified or read-only. By default its value is `("--%*%*-")'. minor-mode-alist This variable is responsible for displaying text for those minor modes that are currently enabled. Its value is a list of elements of the form (VARIABLE STRING), where STRING is to be displayed if VARIABLE's value (in the buffer whose mode line is being displayed) is non-nil. This variable is not made local to particular buffers, but loading some libraries may add elements to it. global-mode-string This variable is used to display the time, if you ask for that. The idea of these variables is to eliminate the need for major modes to alter mode-line-format itself. ** `window-point' valid for selected window. The value returned by `window-point' used to be incorrect when its argument was the selected window. Now the value is correct. ** Window configurations may be saved as Lisp objects. The function `current-window-configuration' returns a special type of Lisp object that represents the current layout of windows: the sizes and positions of windows, which buffers appear in them, and which parts of the buffers appear on the screen. The function `set-window-configuration' takes one argument, which must be a window configuration object, and restores that configuration. ** New hook `temp-output-buffer-show-hook'. This hook allows you to control how help buffers are displayed. Whenever `with-output-to-temp-buffer' has executed its body and wants to display the temp buffer, if this variable is bound and non-`nil' then its value is called with one argument, the temp buffer. The hook function is solely responsible for displaying the buffer. The standard manner of display--making the buffer appear in a window--is used only if there is no hook function. ** New function `minibuffer-window'. This function returns the window used (sometimes) for displaying the minibuffer. It can be used even when the minibuffer is not active. ** New feature to `next-window'. If the optional second argument is neither `nil' nor `t', the minibuffer window is omitted from consideration even when active; if the starting window was the last non-minibuffer window, the value will be the first non-minibuffer window. ** New variable `minibuffer-scroll-window'. When this variable is non-`nil', the command `scroll-other-window' uses it as the window to be scrolled. Displays of completion-lists set this variable to the window containing the display. ** New argument to `sit-for'. A non-nil second argument to `sit-for' means do not redisplay; just wait for the specified time or until input is available. ** Deleted function `set-minor-mode'; minor modes must be changed. The function `set-minor-mode' has been eliminated. The display of minor mode names in the mode line is now controlled by the variable `minor-mode-alist'. To specify display of a new minor mode, it is sufficient to add an element to this list. Once that is done, you can turn the mode on and off just by setting a variable, and the display will show its status automatically. ** New variable `cursor-in-echo-area'. If this variable is non-nil, the screen cursor appears on the last line of the screen, at the end of the text displayed there. Binding this variable to t is useful at times when reading single characters of input with `read-char'. ** New per-buffer variable `selective-display-ellipses'. If this variable is non-nil, an ellipsis (`...') appears on the screen at the end of each text line that is followed by invisible text. If this variable is nil, no ellipses appear. Then there is no sign on the screen that invisible text is present. Text is made invisible under the control of the variable `selective-display'; this is how Outline mode and C-x $ work. ** New variable `no-redraw-on-reenter'. If you set this variable non-nil, Emacs will not clear the screen when you resume it after suspending it. This is for the sake of terminals with multiple screens of memory, where the termcap entry has been set up to switch between screens when Emacs is suspended and resumed. ** New argument to `set-screen-height' or `set-screen-width'. These functions now take an optional second argument which says what significance the newly specified height or width has. If the argument is nil, or absent, it means that Emacs should believe that the terminal height or width really is as just specified. If the argument is t, it means Emacs should not believe that the terminal really is this high or wide, but it should use the specific height or width as the number of lines or columns to display. Thus, you could display only 24 lines on a screen known to have 48 lines. What practical difference is there between using only 24 lines for display and really believing that the terminal has 24 lines? 1. The ``real'' height of the terminal says what the terminal command to move the cursor to the last line will do. 2. The ``real'' height of the terminal determines how much padding is needed. * File-related changes. ** New parameter `backup-by-copying-when-mismatch'. If this variable is non-`nil', then when Emacs is about to save a file, it will create the backup file by copying if that would avoid changing the file's uid or gid. The default value of this variable is `nil', because usually it is useful to have the uid of a file change according to who edited it last. I recommend thet this variable be left normally `nil' and changed with a local variables list in those particular files where the uid needs to be preserved. ** New parameter `file-precious-flag'. If this variable is non-`nil', saving the buffer tries to avoid leaving an incomplete file due to disk full or other I/O errors. It renames the old file before saving. If saving is successful, the renamed file is deleted; if saving gets an error, the renamed file is renamed back to the name you visited. Backups are always made by copying for such files. ** New variable `buffer-offer-save'. If the value of this variable is non-`nil' in a buffer then exiting Emacs will offer to save the buffer (if it is modified and nonempty) even if the buffer is not visiting a file. This variable is automatically made local to the current buffer whenever it is set. ** `rename-file', `copy-file', `add-name-to-file' and `make-symbolic-link'. The third argument to these functions used to be `t' or `nil'; `t' meaning go ahead even if the specified new file name already has a file, and `nil' meaning to get an error. Now if the third argument is a number it means to ask the user for confirmation in this case. ** New optional argument to `copy-file'. If `copy-file' receives a non-nil fourth argument, it attempts to give the new copy the same time-of-last-modification that the original file has. ** New function `file-newer-than-file-p'. (file-newer-than-file-p FILE1 FILE2) returns non-nil if FILE1 has been modified more recently than FILE2. If FILE1 does not exist, the value is always nil; otherwise, if FILE2 does not exist, the value is t. This is meant for use when FILE2 depends on FILE1, to see if changes in FILE1 make it necessary to recompute FILE2 from it. ** Changed function `file-exists-p'. This function is no longer the same as `file-readable-p'. `file-exists-p' can now return t for a file that exists but which the fascists won't allow you to read. ** New function `file-locked-p'. This function receives a file name as argument and returns `nil' if the file is not locked, `t' if locked by this Emacs, or a string giving the name of the user who has locked it. ** New function `file-name-sans-versions'. (file-name-sans-versions NAME) returns a substring of NAME, with any version numbers or other backup suffixes deleted from the end. ** New functions for directory names. Although a directory is really a kind of file, specifying a directory uses a somewhat different syntax from specifying a file. In Emacs, a directory name is used as part of a file name. On Unix, the difference is small: a directory name ends in a slash, while a file name does not: thus, `/usr/rms/' to name a directory, while `/usr/rms' names the file which holds that directory. On VMS, the difference is considerable: `du:[rms.foo]' specifies a directory, but the name of the file that holds that directory is `du:[rms]foo.dir'. There are two new functions for converting between directory names and file names. `directory-file-name' takes a directory name and returns the name of the file in which that directory's data is stored. `file-name-as-directory' takes the name of a file and returns the corresponding directory name. These always understand Unix file name syntax; on VMS, they understand VMS syntax as well. For example, (file-name-as-directory "/usr/rms") returns "/usr/rms/" and (directory-file-name "/usr/rms/") returns "/usr/rms". On VMS, (file-name-as-directory "du:[rms]foo.dir") returns "du:[rms.foo]" and (directory-file-name "du:[rms.foo]") returns "du:[rms]foo.dir". ** Value of `file-attributes' changed. The function file-attributes returns a list containing many kinds of information about a file. Now the list has eleven elements. The tenth element is `t' if deleting the file and creating another file of the same name would result in a change in the file's group; `nil' if there would be no change. You can also think of this as comparing the file's group with the default group for files created in the same directory by you. The eleventh element is the inode number of the file. ** VMS-only function `file-name-all-versions'. This function returns a list of all the completions, including version number, of a specified version-number-less file name. This is like `file-name-all-completions', except that the latter returns values that do not include version numbers. ** VMS-only variable `vms-stmlf-recfm'. On a VMS system, if this variable is non-nil, Emacs will give newly created files the record format `stmlf'. This is necessary for files that must contain lines of arbitrary length, such as compiled Emacs Lisp. When writing a new version of an existing file, Emacs always keeps the same record format as the previous version; so this variable has no effect. This variable has no effect on Unix systems. ** `insert-file-contents' on an empty file. This no longer sets the buffer's "modified" flag. ** New function (VMS only) `define-logical-name': (define-logical-name LOGICAL TRANSLATION) defines a VMS logical name LOGICAL whose translation is TRANSLATION. The new name applies to the current process only. ** Deleted variable `ask-about-buffer-names'. If you want buffer names for files to be generated in a special way, you must redefine `create-file-buffer'. * Subprocess-related changes. ** New function `process-list'. This function takes no arguments and returns a list of all of Emacs's asynchronous subprocesses. ** New function `process-exit-status'. This function, given a process, process name or buffer as argument, returns the exit status code or signal number of the process. If the process has not yet exited or died, this function returns 0. ** Process output ignores `buffer-read-only'. Output from a process will go into the process's buffer even if the buffer is read only. ** Switching buffers in filter functions and sentinels. Emacs no longer saves and restore the current buffer around calling the filter and sentinel functions, so these functions can now permanently alter the selected buffer in a straightforward manner. ** Specifying environment variables for subprocesses. When a subprocess is started with `start-process' or `call-process', the value of the variable `process-environment' is taken to specify the environment variables to give the subprocess. The value should be a list of strings, each of the form "VAR=VALUE". `process-environment' is initialized when Emacs starts up based on Emacs's environment. ** New variable `process-connection-type'. If this variable is `nil', when a subprocess is created, Emacs uses a pipe rather than a pty to communicate with it. Normally this variable is `t', telling Emacs to use a pty if ptys are supported and one is available. ** New function `waiting-for-user-input-p'. This function, given a subprocess as argument, returns `t' if that subprocess appears to be waiting for input sent from Emacs, or `nil' otherwise. ** New hook `shell-set-directory-error-hook'. The value of this variable is called, with no arguments, whenever Shell mode gets an error trying to keep track of directory-setting commands (such as `cd' and `pushd') used in the shell buffer. * New functions `user-uid' and `user-real-uid'. These functions take no arguments and return, respectively, the effective uid and the real uid of the Emacs process. The value in each case is an integer. * New variable `print-escape-newlines' controls string printing. If this variable is non-`nil', then when a Lisp string is printed by the Lisp printing function `prin1' or `print', newline characters are printed as `\n' rather than as a literal newline. * New function `sysnetunam' on HPUX. This function takes two arguments, a network address PATH and a login string LOGIN, and executes the system call `netunam'. It returns `t' if the call succeeds, otherwise `nil'. News regarding installation: * Many `s-...' file names changed. Many `s-...' files have been renamed. All periods in such names, except the ones just before the final `h', have been changed to hyphens. Thus, `s-bsd4.2.h' has been renamed to `s-bsd4-2.h'. This is so a Unix distribution can be moved mechanically to VMS. * `DOCSTR...' file now called `DOC-...'. The file of on-line documentation strings, that used to be `DOCSTR.mm.nn.oo' in this directory, is now called `DOC-mm.nn.oo'. This is so that it can port to VMS using the standard conventions for translating filenames for VMS. This file also now contains the doc strings for variables as well as functions. * Emacs no longer uses floating point arithmetic. This may make it easier to port to some machines. * Macros `XPNTR' and `XSETPNTR'; flag `DATA_SEG_BITS'. These macros exclusively are used to unpack a pointer from a Lisp_Object and to insert a pointer into a Lisp_Object. Redefining them may help port Emacs to machines in which all pointers to data objects have certain high bits set. If `DATA_SEG_BITS' is defined, it should be a number which contains the high bits to be inclusive or'ed with pointers that are unpacked. * New flag `HAVE_X_MENU'. Define this flag in `config.h' in addition to `HAVE_X_WINDOWS' to enable use of the Emacs interface to X Menus. On some operating systems, the rest of the X interface works properly but X Menus do not work; hence this separate flag. See the file `src/xmenu.c' for more information. * Macros `ARRAY_MARK_FLAG' and `DONT_COPY_FLAG'. * `HAVE_ALLOCA' prevents assembly of `alloca.s'. * `SYSTEM_MALLOC' prevents use of GNU `malloc.c'. SYSTEM_MALLOC, if defined, means use the system's own `malloc' routines rather than those that come with Emacs. Use this only if absolutely necessary, because if it is used you do not get warnings when space is getting low. * New flags to control unexec. See the file `unexec.c' for a long comment on the compilation switches that suffice to make it work on many machines. * `PNTR_COMPARISON_TYPE' Pointers that need to be compared for ordering are converted to this type first. Normally this is `unsigned int'. * `HAVE_VFORK', `HAVE_DUP2' and `HAVE_GETTIMEOFDAY'. These flags just say whether certain system calls are available. * New macros control compiler switches, linker switches and libraries. The m- and s- files can now control in a modular fashion the precise arguments passed to `cc' and `ld'. LIBS_STANDARD defines the standard C libraries. Default is `-lc'. LIBS_DEBUG defines the extra libraries to use when debugging. Default `-lg'. LIBS_SYSTEM can be defined by the s- file to specify extra libraries. LIBS_MACHINE can be defined by the m- file to specify extra libraries. LIBS_TERMCAP defines the libraries for Termcap or Terminfo. It is defined by default in a complicated fashion but the m- or s- file can override it. LD_SWITCH_SYSTEM can be defined by the s- file to specify extra `ld' switches. The default is `-X' on BSD systems except those few that use COFF object files. LD_SWITCH_MACHINE can be defined by the m- file to specify extra `ld' switches. C_DEBUG_SWITCH defines the switches to give `cc' when debugging. Default `-g'. C_OPTIMIZE_SWITCH defines the switches to give `cc' to optimize. Default `-O'. C_SWITCH_MACHINE can be defined by the m- file to specify extra `cc' switches. For older news, see the file OOONEWS. ---------------------------------------------------------------------- Copyright information: Copyright (C) 1988 Free Software Foundation, Inc. Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the copyright notice and this permission notice are preserved, thus giving the recipient permission to redistribute in turn. Permission is granted to distribute modified versions of this document, or of portions of it, under the above conditions, provided also that they carry prominent notices stating who last changed them. Local variables: mode: text end: emacs-19.30/etc/OOONEWS100666 12120 13 144044 5335275332 12551 0ustar rmsuserGNU Emacs NEWS -- history of user-visible changes. 26-Mar-1986 Copyright (C) 1986 Richard M. Stallman. See the end for copying conditions. For older news, see the file OOOONEWS. Changes in Emacs 17 * Frustrated? Try M-x doctor. * Bored? Try M-x hanoi. * Brain-damaged? Try M-x yow. * Sun3, Tahoe, Apollo, HP9000s300, Celerity, NCR Tower 32, Sequent, Stride, Encore, Plexus and AT&T 7300 machines supported. The Tahoe, Sun3, Sequent and Celerity use 4.2. In regard to the Apollo, see the file APOLLO in this directory. NCR Tower32, HP9000s300, Stride and Nu run forms of System V. System V rel 2 also works on Vaxes now. See etc/MACHINES. * System V Unix supported, including subprocesses. It should be possible now to bring up Emacs on a machine running mere unameliorated system V Unix with no major work; just possible bug fixes. But you can expect to find a handful of those on any machine that Emacs has not been run on before. * Berkeley 4.1 Unix supported. See etc/MACHINES. * Portable `alloca' provided. Emacs can now run on machines that do not and cannot support the library subroutine `alloca' in the canonical fashion, using an `alloca' emulation written in C. * On-line manual. Info now contains an Emacs manual, with essentially the same text as in the printed manual. The manual can now be printed with a standard TeX. Nicely typeset and printed copies of the manual are available from the Free Software Foundation. * Backup file version numbers. Emacs now supports version numbers in backup files. The first time you save a particular file in one editing session, the old file is copied or renamed to serve as a backup file. In the past, the name for the backup file was made by appending `~' to the end of the original file name. Now the backup file name can instead be made by appending ".~NN~" to the original file name, where NN stands for a numeric version. Each time this is done, the new version number is one higher than the highest previously used. Thus, the active, current file does not have a version number. Only the backups have them. This feature is controlled by the variable `version-control'. If it is `nil', as normally, then numbered backups are made only for files that already have numbered backups. Backup names with just `~' are used for files that have no numbered backups. If `version-control' is `never', then the backup file's name is made with just `~' in any case. If `version-control' is not `nil' or `never', numbered backups are made unconditionally. To prevent unlimited consumption of disk space, Emacs can delete old backup versions automatically. Generally Emacs keeps the first few backups and the latest few backups, deleting any in between. This happens every time a new backup is made. The two variables that control the deletion are `kept-old-versions' and `kept-new-versions'. Their values are, respectively, the number of oldest backups to keep and the number of newest ones to keep, each time a new backup is made. The value of `kept-new-versions' includes the backup just created. By default, both values are 2. If `trim-versions-without-asking' is non-`nil', the excess middle versions are deleted without a murmur. If it is `nil', the default, then you are asked whether the excess middle versions should really be deleted. Dired has a new command `.' which marks for deletion all but the latest and oldest few of every numeric series of backups. `kept-old-versions' controls the number of oldest versions to keep, and `dired-kept-versions' controls the number of latest versions to keep. A numeric argument to the `.' command, if positive, specifies the number of latest versions to keep, overriding `dired-kept-versions'. A negative argument specifies the number of oldest versions to keep, using minus the argument to override `kept-old-versions'. * Immediate conflict detection. Emacs now locks the files it is modifying, so that if you start to modify within Emacs a file that is being modified in another Emacs, you get an immediate warning. The warning gives you three choices: 1. Give up, and do not make any changes. 2. Make changes anyway at your own risk. 3. Make changes anyway, and record yourself as the person locking the file (instead of whoever was previously recorded.) Just visiting a file does not lock it. It is locked when you try to change the buffer that is visiting the file. Saving the file unlocks it until you make another change. Locking is done by writing a lock file in a special designated directory. If such a directory is not provided and told to Emacs as part of configuring it for your machine, the lock feature is turned off. * M-x recover-file. This command is used to get a file back from an auto-save (after a system crash, for example). It takes a file name as argument and visits that file, but gets the data from the file's last auto save rather than from the file itself. * M-x normal-mode. This command resets the current buffer's major mode and local variables to be as specified by the visit filename, the -*- line and/or the Local Variables: block at the end of the buffer. It is the same thing normally done when a file is first visited. * Echo area messages disappear shortly if minibuffer is in use. Any message in the echo area disappears after 2 seconds if the minibuffer is active. This allows the minibuffer to become visible again. * C-z on System V runs a subshell. On systems which do not allow programs to be suspended, the C-z command forks a subshell that talks directly to the terminal, and then waits for the subshell to exit. This gets almost the effect of suspending in that you can run other programs and then return to Emacs. However, you cannot log out from the subshell. * C-c is always a prefix character. Also, subcommands of C-c which are letters are always reserved for the user. No standard Emacs major mode defines any of them. * Picture mode C-c commands changed. The old C-c k command is now C-c C-w. The old C-c y command is now C-c C-x. * Shell mode commands changed. All the special commands of Shell mode are now moved onto the C-c prefix. Most are not changed aside from that. Thus, the old Shell mode C-c command (kill current job) is now C-c C-c; the old C-z (suspend current job) is now C-c C-z, etc. The old C-x commands are now C-c commands. C-x C-k (kill output) is now C-c C-o, and C-x C-v (show output) is now C-c C-r. The old M-= (copy previous input) command is now C-c C-y. * Shell mode recognizes aliases for `pushd', `popd' and `cd'. Shell mode now uses the variable `shell-pushd-regexp' as a regular expression to recognize any command name that is equivalent to a `pushd' command. By default it is set up to recognize just `pushd' itself. If you use aliases for `pushd', change the regexp to recognize them as well. There are also `shell-popd-regexp' to recognize commands with the effect of a `popd', and `shell-cd-regexp' to recognize commands with the effect of a `cd'. * "Exit" command in certain modes now C-c C-c. These include electric buffer menu mode, electric command history mode, Info node edit mode, and Rmail edit mode. In all these modes, the command to exit used to be just C-c. * Outline mode changes. Lines that are not heading lines are now called "body" lines. The command `hide-text' is renamed to `hide-body'. The key M-H is renamed to C-c C-h. The key M-S is renamed to C-c C-s. The key M-s is renamed to C-c C-i. Changes of line visibility are no longer undoable. As a result, they no longer use up undo memory and no longer interfere with undoing earlier commands. * Rmail changes. The s and q commands now both expunge deleted messages before saving; use C-x C-s to save without expunging. The u command now undeletes the current message if it is deleted; otherwise, it backs up as far as necessary to reach a deleted message, and undeletes that one. The u command in the summary behaves likewise, but considers only messages listed in the summary. The M-u command has been eliminated. The o and C-o keys' meanings are interchanged. o now outputs to an Rmail file, and C-o to a Unix mail file. The F command (rmail-find) is renamed to M-s (rmail-search). Various new commands and features exist; see the Emacs manual. * Local bindings described first in describe-bindings. * [...], {...} now balance in Fundamental mode. * Nroff mode and TeX mode. The are two new major modes for editing nroff input and TeX input. See the Emacs manual for full information. * New C indentation style variable `c-brace-imaginary-offset'. The value of `c-brace-imaginary-offset', normally zero, controls the indentation of a statement inside a brace-group where the open-brace is not the first thing on a line. The value says where the open-brace is imagined to be, relative to the first nonblank character on the line. * Dired improvements. Dired now normally keeps the cursor at the beginning of the file name, not at the beginning of the line. The most used motion commands are redefined in Dired to position the cursor this way. `n' and `p' are now equivalent in dired to `C-n' and `C-p'. If any files to be deleted cannot be deleted, their names are printed in an error message. If the `v' command is invoked on a file which is a directory, dired is run on that directory. * `visit-tag-table' renamed `visit-tags-table'. This is so apropos of `tags' finds everything you need to know about in connection with Tags. * `mh-e' library uses C-c as prefix. All the special commands of `mh-rmail' now are placed on a C-c prefix rather than on the C-x prefix. This is for consistency with other special modes with their own commands. * M-$ or `spell-word' checks word before point. It used to check the word after point. * Quitting during autoloading no longer causes trouble. Now, when a file is autoloaded, all function redefinitions and `provide' calls are recorded and are undone if you quit before the file is finished loading. As a result, it no longer happens that some of the entry points which are normally autoloading have been defined already, but the entire file is not really present to support them. * `else' can now be indented correctly in C mode. TAB in C mode now knows which `if' statement an `else' matches up with, and can indent the `else' correctly under the `if', even if the `if' contained such things as another `if' statement, or a `while' or `for' statement, with no braces around it. * `batch-byte-compile' Runs byte-compile-file on the files specified on the command line. All the rest of the command line arguments are taken as files to compile (or, if directories, to do byte-recompile-directory on). Must be used only with -batch, and kills emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke `emacs -batch -f batch-byte-compile *.el'. * `-batch' changes. `-batch' now implies `-q': no init file is loaded by Emacs when `-batch' is used. Also, no `term/TERMTYPE.el' file is loaded. Auto saving is not done except in buffers in which it is explicitly requested. Also, many echo-area printouts describing what is going on are inhibited in batch mode, so that the only output you get is the output you program specifically. One echo-area message that is not suppressed is the one that says that a file is being loaded. That is because you can prevent this message by passing `t' as the third argument to `load'. * Display of search string in incremental search. Now, when you type C-s or C-r to reuse the previous search string, that search string is displayed immediately in the echo area. Three dots are displayed after the search string while search is actually going on. * View commands. The commands C-x ], C-x [, C-x /, C-x j and C-x o are now available inside `view-buffer' and `view-file', with their normal meanings. * Full-width windows preferred. The ``other-window'' commands prefer other full width windows, and will split only full width windows. * M-x rename-file can copy if necessary. When used between different file systems, since actual renaming does not work, the old file will be copied and deleted. * Within C-x ESC, you can pick the command to repeat. While editing a previous command to be repeated, inside C-x ESC, you can now use the commands M-p and M-n to pick an earlier or later command to repeat. M-n picks the next earlier command and M-p picks the next later one. The new command appears in the minibuffer, and you can go ahead and edit it, and repeat it when you exit the minibuffer. Using M-n or M-p within C-x ESC is like having used a different numeric argument when you ran C-x ESC in the first place. The command you finally execute using C-x ESC is added to the front of the command history, unless it is identical with the first thing in the command history. * Use C-c C-c to exit from editing within Info. It used to be C-z for this. Somehow this use of C-z was left out when all the others were moved. The intention is that C-z should always suspend Emacs. * Default arg to C-x < and C-x > now window width minus 2. These commands, which scroll the current window horizontally by a specified number of columns, now scroll a considerable distance rather than a single column if used with no argument. * Auto Save Files Deleted. The default value of `delete-auto-save-files' is now `t', so that when you save a file for real, its auto save file is deleted. * Rnews changes. The N, P and J keys in Rnews are renamed to M-n, M-p and M-j. These keys move among newsgroups. The n and p keys for moving sequentially between news articles now accept repeat count arguments, and the + and - keys, made redundant by this change, are eliminated. The s command for outputting the current article to a file is renamed as o, to be compatible with Rmail. * Sendmail changes. If you have a ~/.mailrc file, Emacs searches it for mailing address aliases, and these aliases are expanded when you send mail in Emacs. Fcc fields can now be used in the headers in the *mail* buffer to specify files in which copies of the message should be put. The message is written into those files in Unix mail file format. The message as sent does not contain any Fcc fields in its header. You can use any number of Fcc fields, but only one file name in each one. The variable `mail-archive-file-name', if non-`nil', can be a string which is a file name; an Fcc to that file will be inserted in every message when you begin to compose it. A new command C-c q now exists in Mail mode. It fills the paragraphs of an old message that had been inserted with C-c y. When the *mail* buffer is put in Mail mode, text-mode-hook is now run in addition to mail-mode-hook. text-mode-hook is run first. The new variable `mail-header-separator' now specifies the string to use on the line that goes between the headers and the message text. By default it is still "--text follows this line--". * Command history truncated automatically. Just before each garbage collection, all but the last 30 elements of the command history are discarded. Incompatible Lisp Programming Changes in Emacs 17 * `"e' no longer supported. This feature, which allowed Lisp functions to take arguments that were not evaluated, has been eliminated, because it is inescapably hard to make the compiler work properly with such functions. You should use macros instead. A simple way to change any code that uses `"e' is to replace (defun foo ("e x y z) ... with (defmacro foo (x y z) (list 'foo-1 (list 'quote x) (list 'quote y) (list 'quote z))) (defun foo-1 (x y z) ... * Functions `region-to-string' and `region-around-match' removed. These functions were made for compatibility with Gosling Emacs, but it turns out to be undesirable to use them in GNU Emacs because they use the mark. They have been eliminated from Emacs proper, but are present in mlsupport.el for the sake of converted mocklisp programs. If you were using `region-to-string', you should instead use `buffer-substring'; then you can pass the bounds as arguments and can avoid setting the mark. If you were using `region-around-match', you can use instead the two functions `match-beginning' and `match-end'. These give you one bound at a time, as a numeric value, without changing point or the mark. * Function `function-type' removed. This just appeared not to be very useful. It can easily be written in Lisp if you happen to want it. Just use `symbol-function' to get the function definition of a symbol, and look at its data type or its car if it is a list. * Variable `buffer-number' removed. You can still use the function `buffer-number' to find out a buffer's unique number (assigned in order of creation). * Variable `executing-macro' renamed `executing-kbd-macro'. This variable is the currently executing keyboard macro, as a string, or `nil' when no keyboard macro is being executed. * Loading term/$TERM. The library term/$TERM (where $TERM get replaced by your terminal type), which is done by Emacs automatically when it starts up, now happens after the user's .emacs file is loaded. In previous versions of Emacs, these files had names of the form term-$TERM; thus, for example, term-vt100.el, but now they live in a special subdirectory named term, and have names like term/vt100.el. * `command-history' format changed. The elements of this list are now Lisp expressions which can be evaluated directly to repeat a command. * Unused editing commands removed. The functions `forward-to-word', `backward-to-word', `upcase-char', `mark-beginning-of-buffer' and `mark-end-of-buffer' have been removed. Their definitions can be found in file lisp/unused.el if you need them. Upward Compatible Lisp Programming Changes in Emacs 17 * You can now continue after errors and quits. When the debugger is entered because of a C-g, due to a non-`nil' value of `debug-on-quit', the `c' command in the debugger resumes execution of the code that was running when the quit happened. Use the `q' command to go ahead and quit. The same applies to some kinds of errors, but not all. Errors signaled with the Lisp function `signal' can be continued; the `c' command causes `signal' to return. The `r' command causes `signal' to return the value you specify. The `c' command is equivalent to `r' with the value `nil'. For a `wrong-type-argument' error, the value returned with the `r' command is used in place of the invalid argument. If this new value is not valid, another error occurs. Errors signaled with the function `error' cannot be continued. If you try to continue, the error just happens again. * `dot' renamed `point'. The word `dot' has been replaced with `point' in all function and variable names, including: point, point-min, point-max, point-marker, point-min-marker, point-max-marker, window-point, set-window-point, point-to-register, register-to-point, exchange-point-and-mark. The old names are still supported, for now. * `string-match' records position of end of match. After a successful call to `string-match', `(match-end 0)' will return the index in the string of the first character after the match. Also, `match-begin' and `match-end' with nonzero arguments can be used to find the indices of beginnings and ends of substrings matched by subpatterns surrounded by parentheses. * New function `insert-before-markers'. This function is just like `insert' except in the handling of any relocatable markers that are located at the point of insertion. With `insert', such markers end up pointing before the inserted text. With `insert-before-markers', they end up pointing after the inserted text. * New function `copy-alist'. This function takes one argument, a list, and makes a disjoint copy of the alist structure. The list itself is copied, and each element that is a cons cell is copied, but the cars and cdrs of elements remain shared with the original argument. This is what it takes to get two alists disjoint enough that changes in one do not change the result of `assq' on the other. * New function `copy-keymap'. This function takes a keymap as argument and returns a new keymap containing initially the same bindings. Rebindings in either one of them will not alter the bindings in the other. * New function `copy-syntax-table'. This function takes a syntax table as argument and returns a new syntax table containing initially the same syntax settings. Changes in either one of them will not alter the other. * Randomizing the random numbers. `(random t)' causes the random number generator's seed to be set based on the current time and Emacs's process id. * Third argument to `modify-syntax-entry'. The optional third argument to `modify-syntax-entry', if specified should be a syntax table. The modification is made in that syntax table rather than in the current syntax table. * New function `run-hooks'. This function takes any number of symbols as arguments. It processes the symbols in order. For each symbol which has a value (as a variable) that is non-nil, the value is called as a function, with no arguments. This is useful in major mode commands. * Second arg to `switch-to-buffer'. If this function is given a non-`nil' second argument, then the selection being done is not recorded on the selection history. The buffer's position in the history remains unchanged. This feature is used by the view commands, so that the selection history after exiting from viewing is the same as it was before. * Second arg to `display-buffer' and `pop-to-buffer'. These two functions both accept an optional second argument which defaults to `nil'. If the argument is not `nil', it means that another window (not the selected one) must be found or created to display the specified buffer in, even if it is already shown in the selected window. This feature is used by `switch-to-buffer-other-window'. * New variable `completion-ignore-case'. If this variable is non-`nil', completion allows strings in different cases to be considered matching. The global value is `nil' This variable exists for the sake of commands that are completing an argument in which case is not significant. It is possible to change the value globally, but you might not like the consequences in the many situations (buffer names, command names, file names) where case makes a difference. * Major modes related to Text mode call text-mode-hook, then their own hooks. For example, turning on Outline mode first calls the value of `text-mode-hook' as a function, if it exists and is non-`nil', and then does likewise for the variable `outline-mode-hook'. * Defining new command line switches. You can define a new command line switch in your .emacs file by putting elements on the value of `command-switch-alist'. Each element of this list should look like (SWITCHSTRING . FUNCTION) where SWITCHSTRING is a string containing the switch to be defined, such as "-foo", and FUNCTION is a function to be called if such an argument is found in the command line. FUNCTION receives the command line argument, a string, as its argument. To implement a switch that uses up one or more following arguments, use the fact that the remaining command line arguments are kept as a list in the variable `command-line-args'. FUNCTION can examine this variable, and do (setq command-line-args (cdr command-line-args) to "use up" an argument. * New variable `load-in-progress'. This variable is non-`nil' when a file of Lisp code is being read and executed by `load'. * New variable `print-length'. The value of this variable is normally `nil'. It may instead be a number; in that case, when a list is printed by `prin1' or `princ' only that many initial elements are printed; the rest are replaced by `...'. * New variable `find-file-not-found-hook'. If `find-file' or any of its variants is used on a nonexistent file, the value of `find-file-not-found-hook' is called (if it is not `nil') with no arguments, after creating an empty buffer. The file's name can be found as the value of `buffer-file-name'. * Processes without buffers. In the function `start-process', you can now specify `nil' as the process's buffer. You can also set a process's buffer to `nil' using `set-process-buffer'. The reason you might want to do this is to prevent the process from being killed because any particular buffer is killed. When a process has a buffer, killing that buffer kills the process too. When a process has no buffer, its output is lost unless it has a filter, and no indication of its being stopped or killed is given unless it has a sentinel. * New function `user-variable-p'. `v' arg prompting changed. This function takes a symbol as argument and returns `t' if the symbol is defined as a user option variable. This means that it has a `variable-documentation' property whose value is a string starting with `*'. Code `v' in an interactive arg reading string now accepts user variables only, and completion is limited to the space of user variables. The function `read-variable' also now accepts and completes over user variables only. * CBREAK mode input is the default in Unix 4.3 bsd. In Berkeley 4.3 Unix, there are sufficient features for Emacs to work fully correctly using CBREAK mode and not using SIGIO. Therefore, this mode is the default when running under 4.3. This mode corresponds to `nil' as the first argument to `set-input-mode'. You can still select either mode by calling that function. * Information on memory usage. The new variable `data-bytes-used' contains the number of bytes of impure space allocated in Emacs. `data-bytes-free' contains the number of additional bytes Emacs could allocate. Note that space formerly allocated and freed again still counts as `used', since it is still in Emacs's address space. * No limit on size of output from `format'. The string output from `format' used to be truncated to 100 characters in length. Now it can have any length. * New errors `void-variable' and `void-function' replace `void-symbol'. This change makes it possible to have error messages that clearly distinguish undefined variables from undefined functions. It also allows `condition-case' to handle one case without the other. * `replace-match' handling of `\'. In `replace-match', when the replacement is not literal, `\' in the replacement string is always treated as an escape marker. The only two special `\' constructs are `\&' and `\DIGIT', so `\' followed by anything other than `&' or a digit has no effect. `\\' is necessary to include a `\' in the replacement text. This level of escaping is comparable with what goes on in a regular expression. It is over and above the level of `\' escaping that goes on when strings are read in Lisp syntax. * New error `invalid-regexp'. A regexp search signals this type of error if the argument does not meet the rules for regexp syntax. * `kill-emacs' with argument. If the argument is a number, it is returned as the exit status code of the Emacs process. If the argument is a string, its contents are stuffed as pending terminal input, to be read by another program after Emacs is dead. * New fifth argument to `subst-char-in-region'. This argument is optional and defaults to `nil'. If it is not `nil', then the substitutions made by this function are not recorded in the Undo mechanism. This feature should be used with great care. It is now used by Outline mode to make lines visible or invisible. * ` *Backtrace*' buffer renamed to `*Backtrace*'. As a result, you can now reselect this buffer easily if you switch to another while in the debugger. Exiting from the debugger kills the `*Backtrace*' buffer, so you will not try to give commands in it when no longer really in the debugger. * New function `switch-to-buffer-other-window'. This is the new primitive to select a specified buffer (the argument) in another window. It is not quite the same as `pop-to-buffer', because it is guaranteed to create another window (assuming there is room on the screen) so that it can leave the current window's old buffer displayed as well. All functions to select a buffer in another window should do so by calling this new function. * New variable `minibuffer-help-form'. At entry to the minibuffer, the variable `help-form' is bound to the value of `minibuffer-help-form'. `help-form' is expected at all times to contain either `nil' or an expression to be executed when C-h is typed (overriding teh definition of C-h as a command). `minibuffer-help-form' can be used to provide a different default way of handling C-h while in the minibuffer. * New \{...} documentation construct. It is now possible to set up the documentation string for a major mode in such a way that it always describes the contents of the major mode's keymap, as it has been customized. To do this, include in the documentation string the characters `\{' followed by the name of the variable containing the keymap, terminated with `}'. (The `\' at the beginning probably needs to be quoted with a second `\', to include it in the doc string.) This construct is normally used on a line by itself, with no blank lines before or after. For example, the documentation string for the function `c-mode' contains ... Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \\{c-mode-map} Variables controlling indentation style: ... * New character syntax class "punctuation". Punctuation characters behave like whitespace in word and list parsing, but can be distinguished in regexps and in the function `char-syntax'. Punctuation syntax is represented by a period in `modify-syntax-entry'. * `auto-mode-alist' no longer needs entries for backup-file names, Backup suffixes of all kinds are now stripped from a file's name before searching `auto-mode-alist'. Changes in Emacs 16 * No special code for Ambassadors, VT-100's and Concept-100's. Emacs now controls these terminals based on the termcap entry, like all other terminals. Formerly it did not refer to the termcap entries for those terminal types, and often the termcap entries for those terminals are wrong or inadequate. If you experience worse behavior on these terminals than in version 15, you can probably correct it by fixing up the termcap entry. See ./TERMS for more info. See ./TERMS in any case if you find that some terminal does not work right with Emacs now. * Minibuffer default completion character is TAB (and not ESC). So that ESC can be used in minibuffer for more useful prefix commands. * C-z suspends Emacs in all modes. Formerly, C-z was redefined for other purposes by certain modes, such as Buffer Menu mode. Now other keys are used for those purposes, to keep the meaning of C-z uniform. * C-x ESC (repeat-complex-command) allows editing the command it repeats. Instead of asking for confirmation to re-execute a command from the command history, the command is placed, in its Lisp form, into the minibuffer for editing. You can confirm by typing RETURN, change some arguments and then confirm, or abort with C-g. * Incremental search does less redisplay on slow terminals. If the terminal baud rate is <= the value of `isearch-slow-speed', incremental searching outside the text on the screen creates a single-line window and uses that to display the line on which a match has been found. Exiting or quitting the search restores the previous window configuration and redisplays the window you were searching in. The initial value of `isearch-slow-speed' is 1200. This feature is courtesy of crl@purdue. * Recursive minibuffers not allowed. If the minibuffer window is selected, most commands that would use the minibuffer gets an error instead. (Specific commands may override this feature and therefore still be allowed.) Strictly speaking, recursive entry to the minibuffer is still possible, because you can switch to another window after entering the minibuffer, and then minibuffer-using commands are allowed. This is still allowed by a deliberate decision: if you know enough to switch windows while in the minibuffer, you can probably understand recursive minibuffers. This may be overridden by binding the variable `enable-recursive-minibuffers' to t. * New major mode Emacs-Lisp mode, for editing Lisp code to run in Emacs. The mode in which emacs lisp files is edited is now called emacs-lisp-mode and is distinct from lisp-mode. The latter is intended for use with lisps external to emacs. The hook which is funcalled (if non-nil) on entry to elisp-mode is now called emacs-lisp-mode-hook. A consequence of this changes is that .emacs init files which set the value of lisp-mode-hook may need to be changed to use the new names. * Correct matching of parentheses is checked on insertion. When you insert a close-paren, the matching open-paren is checked for validity. The close paren must be the kind of close-paren that the open-paren says it should match. Otherwise, a warning message is printed. close-paren immediately preceded by quoting backslash syntax character is not matched. This feature was originally written by shane@mit-ajax. * M-x list-command-history * M-x command-history-mode * M-x electric-command-history `list-command-history' displays forms from the command history subject to user controlled filtering and limit on number of forms. It leaves the buffer in `command-history-mode'. M-x command-history-mode recomputes the command history each time it is invoked via `list-command-history'. It is like Emacs-Lisp mode except that characters don't insert themselves and provision is made for re-evaluating an expression from the list. `electric-command-history' pops up a type out window with the command history displayed. If the very next character is Space, the window goes away and the previous window configuration is restored. Otherwise you can move around in the history and select an expression for evaluation *inside* the buffer which invoked `electric-command-history'. The original window configuration is restored on exit unless the command selected changes it. * M-x edit-picture Enters a temporary major mode (the previous major mode is remembered and can is restored on exit) designed for editing pictures and tables. Printing characters replace rather than insert themselves with motion afterwards that is user controlled (you can specify any of the 8 compass directions). Special commands for movement are provided. Special commands for hacking tabs and tab stops are provided. Special commands for killing rectangles and overlaying them are provided. See the documentation of function edit-picture for more details. Calls value of `edit-picture-hook' on entry if non-nil. * Stupid C-s/C-q `flow control' supported. Do (set-input-mode nil t) to tell Emacs to use CBREAK mode and interpret C-s and C-q as flow control commands. (set-input-mode t nil) switches back to interrupt-driven input. (set-input-mode nil nil) uses CBREAK mode but no `flow control'; this may make it easier to run Emacs under certain debuggers that have trouble dealing with inferiors that use SIGIO. CBREAK mode has certain inherent disadvantages, which are why it is not the default: Meta-keys are ignored; CBREAK mode discards the 8th bit of input characters. Control-G as keyboard input discards buffered output, and therefore can cause incorrect screen updating. The use of `flow control' has its own additional disadvantage: the characters C-s and C-q are not available as editing commands. You can partially compensate for this by setting up a keyboard-translate-table (see file ONEWS) that maps two other characters (such as C-^ and C-\) into C-s and C-q. Of course, C-^ and C-\ are commonly used as escape characters in remote-terminal programs. You really can't win except by getting rid of this sort of `flow control.' The configuration switch CBREAK_INPUT is now eliminated. INTERRUPT_INPUT exists only to specify the default mode of operation; #define it to make interrupt-driven input the default. * Completion of directory names provides a slash. If file name completion yields the name of a directory, a slash is appended to it. * Undo can clear modified-flag. If you undo changes in a buffer back to a state in which the buffer was not considered "modified", then it is labelled as once again "unmodified". * M-x run-lisp. This command creates an inferior Lisp process whose input and output appear in the Emacs buffer named `*lisp*'. That buffer uses a major mode called inferior-lisp-mode, which has many of the commands of lisp-mode and those of shell-mode. Calls the value of shell-mode-hook and lisp-mode-hook, in that order, if non-nil. Meanwhile, in lisp-mode, the command C-M-x is defined to send the current defun as input to the `*lisp*' subprocess. * Mode line says `Narrow' when buffer is clipped. If a buffer has a clipping restriction (made by `narrow-to-region') then its mode line contains the word `Narrow' after the major and minor modes. * Mode line says `Abbrev' when abbrev mode is on. * add-change-log-entry takes prefix argument Giving a prefix argument makes it prompt for login name, full name, and site name, with defaults. Otherwise the defaults are used with no confirmation. * M-x view-buffer and M-x view-file view-buffer selects the named buffer, view-file finds the named file; the resulting buffer is placed into view-mode (a recursive edit). The normal emacs commands are not available. Instead a set of special commands is provided which faclitate moving around in the buffer, searching and scrolling by screenfuls. Exiting view-mode returns to the buffer in which the view-file or view-buffer command was given. Type ? or h when viewing for a complete list of view commands. Each calls value of `view-hook' if non-nil on entry. written by shane@mit-ajax. * New key commands in dired. `v' views (like more) the file on the current line. `#' marks auto-save files for deletion. `~' marks backup files for deletion. `r' renames a file and updates the directory listing if the file is renamed to same directory. `c' copies a file and updates the directory listing if the file is copied to the same directory. * New function `electric-buffer-list'. This pops up a buffer describing the set of emacs buffers. Immediately typing space makes the buffer list go away and returns to the buffer and window which were previously selected. Otherwise one may use the c-p and c-n commands to move around in the buffer-list buffer and type Space or C-z to select the buffer on the cursor's line. There are a number of other commands which are the same as those of buffer-menu-mode. This is a useful thing to bind to c-x c-b in your `.emacs' file if the rather non-standard `electric' behaviour of the buffer list suits your taste. Type C-h after invoking electric-buffer-list for more information. Calls value of `electric-buffer-menu-mode-hook' if non-nil on entry. Calls value of `after-electric-buffer-menu' on exit (select) if non-nil. Changes in version 16 for mail reading and sending * sendmail prefix character is C-c (and not C-z). New command C-c w. For instance C-c C-c (or C-c C-s) sends mail now rather than C-z C-z. C-c w inserts your `signature' (contents of ~/.signature) at the end of mail. * New feature in C-c y command in sending mail. C-c y is the command to insert the message being replied to. Normally it deletes most header fields and indents everything by three spaces. Now, C-c y does not delete header fields or indent. C-c y with any other numeric argument does delete most header fields, but indents by the amount specified in the argument. * C-r command in Rmail edits current message. It does this by switching to a different major mode which is nearly the same as Text mode. The only difference between it and text mode are the two command C-c and C-]. C-c is defined to switch back to Rmail mode, and C-] is defined to restore the original contents of the message and then switch back to Rmail mode. C-c and C-] are the only ways "back into Rmail", but you can switch to other buffers and edit them as usual. C-r in Rmail changes only the handling of the Rmail buffer. * Rmail command `t' toggles header display. Normally Rmail reformats messages to hide most header fields. `t' switches to display of all the header fields of the current message, as long as it remains current. Another `t' switches back to the usual display. * Rmail command '>' goes to the last message. * Rmail commands `a' and `k' set message attributes. `a' adds an attribute and `k' removes one. You specify the attrbute by name. You can specify either a built-in flag such as "deleted" or "filed", or a user-defined keyword (anything not recognized as built-in). * Rmail commands `l' and `L' summarize by attributes. These commands create a summary with one line per message, like `h', but they list only some of the messages. You specify which attribute (for `l') or attributes (for `L') the messages should have. * Rmail can parse mmdf mail files. * Interface to MH mail system. mh-e is a front end for GNU emacs and the MH mail system. It provides a friendly and convient interface to the MH commands. To read mail, invoke mh-rmail. This will inc new mail and display the scan listing on the screen. To see a summary of the mh-e commands, type ?. Help is available through the usual facilities. To send mail, invoke mh-smail. mh-e requires a copy of MH.5 that has been compiled with the MHE compiler switch. From larus@berkeley. New hooks and parameters in version 16 * New variable `blink-matching-paren-distance'. This is the maximum number of characters to search for an open-paren to match an inserted close-paren. The matching open-paren is shown and checked if it is found within this distance. `nil' means search all the way to the beginning of the buffer. In this case, a warning message is printed if no matching open-paren is found. This feature was originally written by shane@mit-ajax. * New variable `find-file-run-dired' If nil, find-file will report an error if an attempt to visit a directory is detected; otherwise, it runs dired on that directory. The default is t. * Variable `dired-listing-switches' holds switches given to `ls' by dired. The value should be a string containing `-' followed by letters. The letter `l' had better be included and letter 'F' had better be excluded! The default is "-al". This feature was originally written by shane@mit-ajax. * New variable `display-time-day-and-date'. If this variable is set non-`nil', the function M-x display-time displays the day and date, as well as the time. * New parameter `c-continued-statement-indent'. This controls the extra indentation given to a line that continues a C statement started on the previous line. By default it is 2, which is why you would see if (foo) bar (); * Changed meaning of `c-indent-level'. The value of `c-brace-offset' used to be subtracted from the value of `c-indent-level' whenever that value was used. Now it is not. As a result, `c-indent-level' is now the offset of statements within a block, relative to the line containing the open-brace that starts the block. * turn-on-auto-fill is useful value for text-mode-hook. (setq text-mode-hook 'turn-on-auto-fill) is all you have to do to make sure Auto Fill mode is turned on whenever you enter Text mode. * Parameter explicit-shell-file-name for M-x shell. This variable, if non-nil, specifies the file name to use for the shell to run if you do M-x shell. Changes in version 16 affecting Lisp programming: * Documentation strings adapt to customization. Often the documentation string for a command wants to mention another command. Simply stating the other command as a character sequence has a disadvantage: if the user customizes Emacs by moving that function to a different command, the cross reference in the documentation becomes wrong. A new feature allows you to write the documentation string using a function name, and the command to run that function is looked up when the documentation is printed. If a documentation string contains `\[' (two characters) then the following text, up to the next `]', is taken as a function name. Instead of printing that function name, the command that runs it is printed. (M-x is used to construct a command if no shorter one exists.) For example, instead of putting `C-n' in a documentation string to refer to the C-n command, put in `\[next-line]'. (In practice you will need to quote the backslash with another backslash, due to the syntax for strings in Lisp and C.) To include the literal characters `\[' in a documentation string, precede them with `\='. To include the characters `\=', precede them with `\='. For example, "\\=\\= is the way to quote \\=\\[" will come out as `\= is the way to quote \['. The new function `substitute-command-keys' takes a string possibly contaning \[...] constructs and replaces those constructs with the key sequences they currently stand for. * Primitives `find-line-comment' and `find-line-comment-body' flushed. Search for the value of `comment-start-skip' if you want to find whether and where a line has a comment. * New function `auto-save-file-name-p' Should return non-`nil' iff given a string which is the name of an auto-save file (sans directory name). If you redefine `make-auto-save-file-name', you should redefine this accordingly. By default, this function returns `t' for filenames beginning with character `#'. * The value of `exec-directory' now ends in a slash. This is to be compatible with most directory names in GNU Emacs. * Dribble files and termscript files. (open-dribble-file FILE) opens a dribble file named FILE. When a dribble file is open, every character Emacs reads from the terminal is written to the dribble file. (open-termscript FILE) opens a termscript file named FILE. When a termscript file is open, all characters sent to the terminal by Emacs are also written in the termscript file. The two of these together are very useful for debugging Emacs problems in redisplay. * Upper case command characters by default are same as lower case. If a character in a command is an upper case letter, and is not defined, Emacs uses the definition of the corresponding lower case letter. For example, if C-x U is not directly undefined, it is treated as a synonym for C-x u (undo). * Undefined function errors versus undefined variable errors. Void-symbol errors now say "boundp" if the symbol's value was void or "fboundp" if the function definition was void. * New function `bury-buffer'. The new function `bury-buffer' takes one argument, a buffer object, and puts that buffer at the end of the internal list of buffers. So it is the least preferred candidate for use as the default value of C-x b, or for other-buffer to return. * Already-displayed buffers have low priority for display. When a buffer is chosen automatically for display, or to be the default in C-x b, buffers already displayed in windows have lower priority than buffers not currently visible. * `set-window-start' accepts a third argument NOFORCE. This argument, if non-nil, prevents the window's force_start flag from being set. Setting the force_start flag causes the next redisplay to insist on starting display at the specified starting point, even if dot must be moved to get it onto the screen. * New function `send-string-to-terminal'. This function takes one argument, a string, and outputs its contents to the terminal exactly as specified: control characters, escape sequences, and all. * Keypad put in command mode. The terminal's keypad is now put into command mode, as opposed to numeric mode, while Emacs is running. This is done by means of the termcap `ks' and `ke' strings. * New function `generate-new-buffer' This function takes a string as an argument NAME and looks for a creates and returns a buffer called NAME if one did not already exist. Otherwise, it successively tries appending suffixes of the form "<1>", "<2>" etc to NAME until it creates a string which does not name an existing buffer. A new buffer with that name is the created and returned. * New function `prin1-to-string' This function takes one argument, a lisp object, and returns a string containing that object's printed representation, such as `prin1' would output. * New function `read-from-minibuffer' Lets you supply a prompt, initial-contents, a keymap, and specify whether the result should be interpreted as a string or a lisp object. Old functions `read-minibuffer', `eval-minibuffer', `read-string' all take second optional string argument which is initial contents of minibuffer. * minibuffer variable names changed (names of keymaps) minibuf-local-map -> minibuffer-local-map minibuf-local-ns-map -> minibuffer-local-ns-map minibuf-local-completion-map -> minibuffer-local-completion-map minibuf-local-must-match-map -> minibuffer-local-must-match-map Changes in version 16 affecting configuring and building Emacs * Configuration switch VT100_INVERSE eliminated. You can control the use of inverse video on any terminal by setting the variable `inverse-video', or by changing the termcap entry. If you like, set `inverse-video' in your `.emacs' file based on examination of (getenv "TERM"). * New switch `-batch' makes Emacs run noninteractively. If the switch `-batch' is used, Emacs treats its standard output and input like ordinary files (even if they are a terminal). It does not display buffers or windows; the only output to standard output is what would appear as messages in the echo area, and each message is followed by a newline. The terminal modes are not changed, so that C-z and C-c retain their normal Unix meanings. Emacs does still read commands from the terminal, but the idea of `-batch' is that you use it with other command line arguments that tell Emacs a complete task to perform, including killing itself. `-kill' used as the last argument is a good way to accomplish this. The Lisp variable `noninteractive' is now defined, to be `nil' except when `-batch' has been specified. * Emacs can be built with output redirected to a file. This is because -batch (see above) is now used in building Emacs. For older news, see the file OOOONEWS. ---------------------------------------------------------------------- Copyright information: Copyright (C) 1985 Richard M. Stallman Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the copyright notice and this permission notice are preserved, thus giving the recipient permission to redistribute in turn. Permission is granted to distribute modified versions of this document, or of portions of it, under the above conditions, provided also that they carry prominent notices stating who last changed them. Local variables: mode: text end: emacs-19.30/etc/OOOONEWS100666 12120 1 135467 3617255326 13145 0ustar rmsdaemonOld GNU Emacs NEWS -- history of user-visible changes thru version 15. Copyright (C) 1985 Richard M. Stallman. See the end for copying conditions. Changes in Emacs 15 * Emacs now runs on Sun and Megatest 68000 systems; also on at least one 16000 system running 4.2. * Emacs now alters the output-start and output-stop characters to prevent C-s and C-q from being considered as flow control by cretinous rlogin software in 4.2. * It is now possible convert Mocklisp code (for Gosling Emacs) to Lisp code that can run in GNU Emacs. M-x convert-mocklisp-buffer converts the contents of the current buffer from Mocklisp to GNU Emacs Lisp. You should then save the converted buffer with C-x C-w under a name ending in ".el" There are probably some Mocklisp constructs that are not handled. If you encounter one, feel free to report the failure as a bug. The construct will be handled in a future Emacs release, if that is not not too hard to do. Note that lisp code converted from Mocklisp code will not necessarily run as fast as code specifically written for GNU Emacs, nor will it use the many features of GNU Emacs which are not present in Gosling's emacs. (In particular, the byte-compiler (m-x byte-compile-file) knows little about compilation of code directly converted from mocklisp.) It is envisaged that old mocklisp code will be incrementally converted to GNU lisp code, with M-x convert-mocklisp-buffer being the first step in this process. * Control-x n (narrow-to-region) is now by default a disabled command. This means that, if you issue this command, it will ask whether you really mean it. You have the opportunity to enable the command permanently at that time, so you will not be asked again. This will place the form "(put 'narrow-to-region 'disabled nil)" in your .emacs file. * Tags now prompts for the tag table file name to use. All the tags commands ask for the tag table file name if you have not yet specified one. Also, the command M-x visit-tag-table can now be used to specify the tag table file name initially, or to switch to a new tag table. * If truncate-partial-width-windows is non-nil (as it intially is), all windows less than the full screen width (that is, made by side-by-side splitting) truncate lines rather than continuing them. * Emacs now checks for Lisp stack overflow to avoid fatal errors. The depth in eval, apply and funcall may not exceed max-lisp-eval-depth. The depth in variable bindings and unwind-protects may not exceed max-specpdl-size. If either limit is exceeded, an error occurs. You can set the limits to larger values if you wish, but if you make them too large, you are vulnerable to a fatal error if you invoke Lisp code that does infinite recursion. * New hooks find-file-hook and write-file-hook. Both of these variables if non-nil should be functions of no arguments. At the time they are called (current-buffer) will be the buffer being read or written respectively. find-file-hook is called whenever a file is read into its own buffer, such as by calling find-file, revert-buffer, etc. It is not called by functions such as insert-file which do not read the file into a buffer of its own. find-file-hook is called after the file has been read in and its local variables (if any) have been processed. write-file-hook is called just before writing out a file from a buffer. * The initial value of shell-prompt-pattern is now "^[^#$%>]*[#$%>] *" * If the .emacs file sets inhibit-startup-message to non-nil, the messages normally printed by Emacs at startup time are inhibited. * Facility for run-time conditionalization on the basis of emacs features. The new variable features is a list of symbols which represent "features" of the executing emacs, for use in run-time conditionalization. The function featurep of one argument may be used to test for the presence of a feature. It is just the same as (not (null (memq FEATURE features))) where FEATURE is its argument. For example, (if (featurep 'magic-window-hack) (transmogrify-window 'vertical) (split-window-vertically)) The function provide of one argument "announces" that FEATURE is present. It is much the same as (if (not (featurep FEATURE)) (setq features (cons FEATURE features))) The function require with arguments FEATURE and FILE-NAME loads FILE-NAME (which should contain the form (provide FEATURE)) unless FEATURE is present. It is much the same as (if (not (featurep FEATURE)) (progn (load FILE-NAME) (if (not featurep FEATURE) (error ...)))) FILE-NAME is optional and defaults to FEATURE. * New function load-average. This returns a list of three integers, which are the current 1 minute, 5 minute and 15 minute load averages, each multiplied by a hundred (since normally they are floating point numbers). * Per-terminal libraries loaded automatically. Emacs when starting up on terminal type T automatically loads a library named term-T. T is the value of the TERM environment variable. Thus, on terminal type vt100, Emacs would do (load "term-vt100" t t). Such libraries are good places to set the character translation table. It is a bad idea to redefine lots of commands in a per-terminal library, since this affects all users. Instead, define a command to do the redefinitions and let the user's init file, which is loaded later, call that command or not, as the user prefers. * Programmer's note: detecting killed buffers. Buffers are eliminated by explicitly killing them, using the function kill-buffer. This does not eliminate or affect the pointers to the buffer which may exist in list structure. If you have a pointer to a buffer and wish to tell whether the buffer has been killed, use the function buffer-name. It returns nil on a killed buffer, and a string on a live buffer. * New ways to access the last command input character. The function last-key-struck, which used to return the last input character that was read by command input, is eliminated. Instead, you can find this information as the value of the variable last-command-char. (This variable used to be called last-key). Another new variable, last-input-char, holds the last character read from the command input stream regardless of what it was read for. last-input-char and last-command-char are different only inside a command that has called read-char to read input. * The new switch -kill causes Emacs to exit after processing the preceding command line arguments. Thus, emacs -l lib data -e do-it -kill means to load lib, find file data, call do-it on no arguments, and then exit. * The config.h file has been modularized. Options that depend on the machine you are running on are defined in a file whose name starts with "m-", such as m-vax.h. Options that depend on the operating system software version you are running on are defined in a file whose name starts with "s-", such as s-bsd4.2.h. config.h includes one m- file and one s- file. It also defines a few other options whose values do not follow from the machine type and system type being used. Installers normally will have to select the correct m- and s- files but will never have to change their contents. * Termcap AL and DL strings are understood. If the termcap entry defines AL and DL strings, for insertion and deletion of multiple lines in one blow, Emacs now uses them. This matters most on certain bit map display terminals for which scrolling is comparatively slow. * Bias against scrolling screen far on fast terminals. Emacs now prefers to redraw a few lines rather than shift them a long distance on the screen, when the terminal is fast. * New major mode, mim-mode. This major mode is for editing MDL code. Perhaps a MDL user can explain why it is not called mdl-mode. You must load the library mim-mode explicitly to use this. * GNU documentation formatter `texinfo'. The `texinfo' library defines a format for documentation files which can be passed through Tex to make a printed manual or passed through texinfo to make an Info file. Texinfo is documented fully by its own Info file; compare this file with its source, texinfo.texinfo, for additional guidance. All documentation files for GNU utilities should be written in texinfo input format. Tex processing of texinfo files requires the Botex macro package. This is not ready for distribution yet, but will appear at a later time. * New function read-from-string (emacs 15.29) read-from-string takes three arguments: a string to read from, and optionally start and end indices which delimit a substring from which to read. (They default to 0 and the length of the string, respectively.) This function returns a cons cell whose car is the object produced by reading from the string and whose cdr is a number giving the index in the string of the first character not read. That index may be passed as the second argument to a later call to read-from-string to read the next form represented by the string. In addition, the function read now accepts a string as its argument. In this case, it calls read-from-string on the whole string, and returns the car of the result. (ie the actual object read.) Changes in Emacs 14 * Completion now prints various messages such as [Sole Completion] or [Next Character Not Unique] to describe the results obtained. These messages appear after the text in the minibuffer, and remain on the screen until a few seconds go by or you type a key. * The buffer-read-only flag is implemented. Setting or binding this per-buffer variable to a non-nil value makes illegal any operation which would modify the textual content of the buffer. (Such operations signal a buffer-read-only error) The read-only state of a buffer may be altered using toggle-read-only (C-x C-q) The buffers used by Rmail, Dired, Rnews, and Info are now read-only by default to prevent accidental damage to the information in those buffers. * Functions car-safe and cdr-safe. These functions are like car and cdr when the argument is a cons. Given an argument not a cons, car-safe always returns nil, with no error; the same for cdr-safe. * The new function user-real-login-name returns the name corresponding to the real uid of the Emacs process. This is usually the same as what user-login-name returns; however, when Emacs is invoked from su, user-real-login-name returns "root" but user-login-name returns the name of the user who invoked su. Changes in Emacs 13 * There is a new version numbering scheme. What used to be the first version number, which was 1, has been discarded since it does not seem that I need three levels of version number. However, a new third version number has been added to represent changes by user sites. This number will always be zero in Emacs when I distribute it; it will be incremented each time Emacs is built at another site. * There is now a reader syntax for Meta characters: \M-CHAR means CHAR or'ed with the Meta bit. For example: ?\M-x is (+ ?x 128) ?\M-\n is (+ ?\n 128) ?\M-\^f is (+ ?\^f 128) This syntax can be used in strings too. Note, however, that Meta characters are not meaningful in key sequences being passed to define-key or lookup-key; you must use ESC characters (\e) in them instead. ?\C- can be used likewise for control characters. (13.9) * Installation change The string "../lisp" now adds to the front of the load-path used for searching for Lisp files during Emacs initialization. It used to replace the path specified in paths.h entirely. Now the directory ../lisp is searched first and the directoris specified in paths.h are searched afterward. Changes in Emacs 1.12 * There is a new installation procedure. See the file INSTALL that comes in the top level directory in the tar file or tape. * The Meta key is now supported on terminals that have it. This is a shift key which causes the high bit to be turned on in all input characters typed while it is held down. read-char now returns a value in the range 128-255 if a Meta character is typed. When interpreted as command input, a Meta character is equivalent to a two character sequence, the meta prefix character followed by the un-metized character (Meta-G unmetized is G). The meta prefix character is specified by the value of the variable meta-prefix-char. If this character (normally Escape) has been redefined locally with a non-prefix definition (such as happens in completing minibuffers) then the local redefinition is suppressed when the character is not the last one in a key sequence. So the local redefinition is effective if you type the character explicitly, but not effective if the character comes from the use of the Meta key. * `-' is no longer a completion command in the minibuffer. It is an ordinary self-inserting character. * The list load-path of directories load to search for Lisp files is now controlled by the EMACSLOADPATH environment variable [[ Note this was originally EMACS-LOAD-PATH and has been changed again; sh does not deal properly with hyphens in env variable names]] rather than the EPATH environment variable. This is to avoid conflicts with other Emacses. While Emacs is being built initially, the load-path is now just ("../lisp"), ignoring paths.h. It does not ignore EMACSLOADPATH, however; you should avoid having this variable set while building Emacs. * You can now specify a translation table for keyboard input characters, as a way of exchanging or substituting keys on the keyboard. If the value of keyboard-translate-table is a string, every character received from the keyboard is used as an index in that string, and the character at that index in the string is used as input instead of what was actually typed. If the actual input character is >= the length of the string, it is used unchanged. One way this feature can be used is to fix bad keyboard designes. For example, on some terminals, Delete is Shift-Underscore. Since Delete is a more useful character than Underscore, it is an improvement to make the unshifted character Delete and the shifted one Underscore. This can be done with ;; First make a translate table that does the identity translation. (setq keyboard-translate-table (make-string 128 0)) (let ((i 0)) (while (< i 128) (aset keyboard-translate-table i i) (setq i (1+ i)))) ;; Now alter translations of some characters. (aset keyboard-translate-table ?\_ ?\^?) (aset keyboard-translate-table ?\^? ?\_) If your terminal has a Meta key and can therefore send codes up to 255, Meta characters are translated through elements 128 through 255 of the translate table, and therefore are translated independently of the corresponding non-Meta characters. You must therefore establish translations independently for the Meta characters if you want them too: ;; First make a translate table that does the identity translation. (setq keyboard-translate-table (make-string 256 0)) (let ((i 0)) (while (< i 256) (aset keyboard-translate-table i i) (setq i (1+ i)))) ;; Now alter translations of some characters. (aset keyboard-translate-table ?\_ ?\^?) (aset keyboard-translate-table ?\^? ?\_) ;; Now alter translations of some Meta characters. (aset keyboard-translate-table (+ 128 ?\_) (+ 128 ?\^?)) (aset keyboard-translate-table (+ 128 ?\^?) (+ 128 ?\_)) * (process-kill-without-query PROCESS) This marks the process so that, when you kill Emacs, you will not on its account be queried about active subprocesses. Changes in Emacs 1.11 * The commands C-c and C-z have been interchanged, for greater compatibility with normal Unix usage. C-z now runs suspend-emacs and C-c runs exit-recursive-edit. * The value returned by file-name-directory now ends with a slash. (file-name-directory "foo/bar") => "foo/". This avoids confusing results when dealing with files in the root directory. The value of the per-buffer variable default-directory is also supposed to have a final slash now. * There are now variables to control the switches passed to `ls' by the C-x C-d command (list-directory). list-directory-brief-switches is a string, initially "-CF", used for brief listings, and list-directory-verbose-switches is a string, initially "-l", used for verbose ones. * For Ann Arbor Ambassador terminals, the termcap "ti" string is now used to initialize the screen geometry on entry to Emacs, and the "te" string is used to set it back on exit. If the termcap entry does not define the "ti" or "te" string, Emacs does what it used to do. Changes in Emacs 1.10 * GNU Emacs has been made almost 1/3 smaller. It now dumps out as only 530kbytes on Vax 4.2bsd. * The term "checkpoint" has been replaced by "auto save" throughout the function names, variable names and documentation of GNU Emacs. * The function load now tries appending ".elc" and ".el" to the specified filename BEFORE it tries the filename without change. * rmail now makes the mode line display the total number of messages and the current message number. The "f" command now means forward a message to another user. The command to search through all messages for a string is now "F". The "u" command now means to move back to the previous message and undelete it. To undelete the selected message, use Meta-u. * The hyphen character is now equivalent to a Space while in completing minibuffers. Both mean to complete an additional word. * The Lisp function error now takes args like format which are used to construct the error message. * Redisplay will refuse to start its display at the end of the buffer. It will pick a new place to display from, rather than use that. * The value returned by garbage-collect has been changed. Its first element is no longer a number but a cons, whose car is the number of cons cells now in use, and whose cdr is the number of cons cells that have been made but are now free. The second element is similar but describes symbols rather than cons cells. The third element is similar but describes markers. * The variable buffer-name has been eliminated. The function buffer-name still exists. This is to prevent user programs from changing buffer names without going through the rename-buffer function. Changes in Emacs 1.9 * When a fill prefix is in effect, paragraphs are started or separated by lines that do not start with the fill prefix. Also, a line which consists of the fill prefix followed by white space separates paragraphs. * C-x C-v runs the new function find-alternate-file. It finds the specified file, switches to that buffer, and kills the previous current buffer. (It requires confirmation if that buffer had changes.) This is most useful after you find the wrong file due to a typo. * Exiting the minibuffer moves the cursor to column 0, to show you that it has really been exited. * Meta-g (fill-region) now fills each paragraph in the region individually. To fill the region as if it were a single paragraph (for when the paragraph-delimiting mechanism does the wrong thing), use fill-region-as-paragraph. * Tab in text mode now runs the function tab-to-tab-stop. A new mode called indented-text-mode is like text-mode except that in it Tab runs the function indent-relative, which indents the line under the previous line. If auto fill is enabled while in indented-text-mode, the new lines that it makes are indented. * Functions kill-rectangle and yank-rectangle. kill-rectangle deletes the rectangle specified by dot and mark (or by two arguments) and saves it in the variable killed-rectangle. yank-rectangle inserts the rectangle in that variable. Tab characters in a rectangle being saved are replaced by spaces in such a way that their appearance will not be changed if the rectangle is later reinserted at a different column position. * `+' in a regular expression now means to repeat the previous expression one or more times. `?' means to repeat it zero or one time. They are in all regards like `*' except for the number of repetitions they match. \< in a regular expression now matches the null string when it is at the beginning of a word; \> matches the null string at the end of a word. * C-x p narrows the buffer so that only the current page is visible. * C-x ) with argument repeats the kbd macro just defined that many times, counting the definition as one repetition. * C-x ( with argument begins defining a kbd macro starting with the last one defined. It executes that previous kbd macro initially, just as if you began by typing it over again. * C-x q command queries the user during kbd macro execution. With prefix argument, enters recursive edit, reading keyboard commands even within a kbd macro. You can give different commands each time the macro executes. Without prefix argument, reads a character. Your options are: Space -- execute the rest of the macro. Delete -- skip the rest of the macro; start next repetition. C-d -- skip rest of the macro and don't repeat it any more. C-r -- enter a recursive edit, then on exit ask again for a character C-l -- redisplay screen and ask again." * write-kbd-macro and append-kbd-macro are used to save a kbd macro definition in a file (as Lisp code to redefine the macro when the file is loaded). These commands differ in that write-kbd-macro discards the previous contents of the file. If given a prefix argument, both commands record the keys which invoke the macro as well as the macro's definition. * The variable global-minor-modes is used to display strings in the mode line of all buffers. It should be a list of elements thaht are conses whose cdrs are strings to be displayed. This complements the variable minor-modes, which has the same effect but has a separate value in each buffer. * C-x = describes horizontal scrolling in effect, if any. * Return now auto-fills the line it is ending, in auto fill mode. Space with zero as argument auto-fills the line before it just like Space without an argument. Changes in Emacs 1.8 This release mostly fixes bugs. There are a few new features: * apropos now sorts the symbols before displaying them. Also, it returns a list of the symbols found. apropos now accepts a second arg PRED which should be a function of one argument; if PRED is non-nil, each symbol is tested with PRED and only symbols for which PRED returns non-nil appear in the output or the returned list. If the third argument to apropos is non-nil, apropos does not display anything; it merely returns the list of symbols found. C-h a now runs the new function command-apropos rather than apropos, and shows only symbols with definitions as commands. * M-x shell sends the command if (-f ~/.emacs_NAME)source ~/.emacs_NAME invisibly to the shell when it starts. Here NAME is replaced by the name of shell used, as it came from your ESHELL or SHELL environment variable but with directory name, if any, removed. * M-, now runs the command tags-loop-continue, which is used to resume a terminated tags-search or tags-query-replace. Changes in Emacs 1.7 It's Beat CCA Week. * The initial buffer is now called "*scratch*" instead of "scratch", so that all buffer names used automatically by Emacs now have *'s. * Undo information is now stored separately for each buffer. The Undo command (C-x u) always applies to the current buffer only. C-_ is now a synonym for C-x u. (buffer-flush-undo BUFFER) causes undo information not to be kept for BUFFER, and frees the space that would have been used to hold it. In any case, no undo information is kept for buffers whose names start with spaces. (These buffers also do not appear in the C-x C-b display.) * Rectangle operations are now implemented. C-x r stores the rectangle described by dot and mark into a register; it reads the register name from the keyboard. C-x g, the command to insert the contents of a register, can be used to reinsert the rectangle elsewhere. Other rectangle commands include open-rectangle: insert a blank rectangle in the position and size described by dot and mark, at its corners; the existing text is pushed to the right. clear-rectangle: replace the rectangle described by dot ane mark with blanks. The previous text is deleted. delete-rectangle: delete the text of the specified rectangle, moving the text beyond it on each line leftward. * Side-by-side windows are allowed. Use C-x 5 to split the current window into two windows side by side. C-x } makes the selected window ARG columns wider at the expense of the windows at its sides. C-x { makes the selected window ARG columns narrower. An argument to C-x 5 specifies how many columns to give to the leftmost of the two windows made. C-x 2 now accepts a numeric argument to specify the number of lines to give to the uppermost of the two windows it makes. * Horizontal scrolling of the lines in a window is now implemented. C-x < (scroll-left) scrolls all displayed lines left, with the numeric argument (default 1) saying how far to scroll. When the window is scrolled left, some amount of the beginning of each nonempty line is replaced by an "$". C-x > scrolls right. If a window has no text hidden at the left margin, it cannot be scrolled any farther right than that. When nonzero leftwards scrolling is in effect in a window. lines are automatically truncated at the window's right margin regardless of the value of the variable truncate-lines in the buffer being displayed. * C-x C-d now uses the default output format of `ls', which gives just file names in multiple columns. C-u C-x C-d passes the -l switch to `ls'. * C-t at the end of a line now exchanges the two preceding characters. All the transpose commands now interpret zero as an argument to mean to transpose the textual unit after or around dot with the one after or around the mark. * M-! executes a shell command in an inferior shell and displays the output from it. With a prefix argument, it inserts the output in the current buffer after dot and sets the mark after the output. The shell command gets /dev/null as its standard input. M-| is like M-! but passes the contents of the region as input to the shell command. A prefix argument makes the output from the command replace the contents of the region. * The mode line will now say "Def" after the major mode while a keyboard macro is being defined. * The variable fill-prefix is now used by Meta-q. Meta-q removes the fill prefix from lines that start with it before filling, and inserts the fill prefix on each line after filling. The command C-x . sets the fill prefix equal to the text on the current line before dot. * The new command Meta-j (indent-new-comment-line), is like Linefeed (indent-new-line) except when dot is inside a comment; in that case, Meta-j inserts a comment starter on the new line, indented under the comment starter above. It also inserts a comment terminator at the end of the line above, if the language being edited calls for one. * Rmail should work correctly now, and has some C-h m documentation. Changes in Emacs 1.6 * save-buffers-kill-emacs is now on C-x C-c while C-x C-z does suspend-emacs. This is to make C-x C-c like the normal Unix meaning of C-c and C-x C-z linke the normal Unix meaning of C-z. * M-ESC (eval-expression) is now a disabled command by default. This prevents users who type ESC ESC accidentally from getting confusing results. Put (put 'eval-expression 'disabled nil) in your ~/.emacs file to enable the command. * Self-inserting text is grouped into bunches for undoing. Each C-x u command undoes up to 20 consecutive self-inserting characters. * Help f now uses as a default the function being called in the innermost Lisp expression that dot is in. This makes it more convenient to use while writing Lisp code to run in Emacs. (If the text around dot does not appear to be a call to a Lisp function, there is no default.) Likewise, Help v uses the symbol around or before dot as a default, if that is a variable name. * Commands that read filenames now insert the default directory in the minibuffer, to become part of your input. This allows you to see what the default is. You may type a filename which goes at the end of the default directory, or you may edit the default directory as you like to create the input you want to give. You may also type an absolute pathname (starting with /) or refer to a home directory (input starting with ~) after the default; the presence of // or /~ causes everything up through the slash that precedes your type-in to be ignored. Returning the default directory without change, including the terminating slash, requests the use of the default file name (usually the visited file's name). Set the variable insert-default-directory to nil to turn off this feature. * M-x shell now uses the environment variable ESHELL, if it exists, as the file name of the shell to run. If there is no ESHELL variable, the SHELL variable is used. This is because some shells do not work properly as inferiors of Emacs (or anything like Emacs). * A new variable minor-modes now exists, with a separate value in each buffer. Its value should be an alist of elements (MODE-FUNCTION-SYMBOL . PRETTY-NAME-STRING), one for each minor mode that is turned on in the buffer. The pretty name strings are displayed in the mode line after the name of the major mode (with spaces between them). The mode function symbols should be symbols whose function definitions will turn on the minor mode if given 1 as an argument; they are present so that Help m can find their documentation strings. * The format of tag table files has been changed. The new format enables Emacs to find tags much faster. A new program, etags, exists to make the kind of tag table that Emacs wants. etags is invoked just like ctags; in fact, if you give it any switches, it does exactly what ctags would do. Give it the empty switch ("-") to make it act like ctags with no switches. etags names the tag table file "TAGS" rather than "tags", so that these tag tables and the standard Unix ones can coexist. The tags library can no longer use standard ctags-style tag tables files. * The file of Lisp code Emacs reads on startup is now called ~/.emacs rather than ~/.emacs_pro. * copy-file now gives the copied file the same mode bits as the original file. * Output from a process inserted into the process's buffer no longer sets the buffer's mark. Instead it sets a marker associated with the process to point to the end of the inserted text. You can access this marker with (process-mark PROCESS) and then either examine its position with marker-position or set its position with set-marker. * completing-read takes a new optional fifth argument which, if non-nil, should be a string of text to insert into the minibuffer before reading user commands. * The Lisp function elt now exists: (elt ARRAY N) is like (aref ARRAY N), (elt LIST N) is like (nth N LIST). * rplaca is now a synonym for setcar, and rplacd for setcdr. eql is now a synonym for eq; it turns out that the Common Lisp distinction between eq and eql is insignificant in Emacs. numberp is a new synonym for integerp. * auto-save has been renamed to auto-save-mode. * Auto save file names for buffers are now created by the function make-auto-save-file-name. This is so you can redefine that function to change the way auto save file names are chosen. * expand-file-name no longer discards a final slash. (expand-file-name "foo" "/lose") => "/lose/foo" (expand-file-name "foo/" "/lose") => "/lose/foo/" Also, expand-file-name no longer substitutes $ constructs. A new function substitute-in-file-name does this. Reading a file name with read-file-name or the `f' or`F' option of interactive calling uses substitute-in-file-name on the file name that was read and returns the result. All I/O primitives including insert-file-contents and delete-file call expand-file-name on the file name supplied. This change makes them considerably faster in the usual case. * Interactive calling spec strings allow the new code letter 'D' which means to read a directory name. It is like 'f' except that the default if the user makes no change in the minibuffer is to return the current default directory rather than the current visited file name. Changes in Emacs 1.5 * suspend-emacs now accepts an optional argument which is a string to be stuffed as terminal input to be read by Emacs's superior shell after Emacs exits. A library called ledit exists which uses this feature to transmit text to a Lisp job running as a sibling of Emacs. * If find-file is given the name of a directory, it automatically invokes dired on that directory rather than reading in the binary data that make up the actual contents of the directory according to Unix. * Saving an Emacs buffer now preserves the file modes of any previously existing file with the same name. This works using new Lisp functions file-modes and set-file-modes, which can be used to read or set the mode bits of any file. * The Lisp function cond now exists, with its traditional meaning. * defvar and defconst now permit the documentation string to be omitted. defvar also permits the initial value to be omitted; then it acts only as a comment. Changes in Emacs 1.4 * Auto-filling now normally indents the new line it creates by calling indent-according-to-mode. This function, meanwhile, has in Fundamental and Text modes the effect of making the line have an indentation of the value of left-margin, a per-buffer variable. Tab no longer precisely does indent-according-to-mode; it does that in all modes that supply their own indentation routine, but in Fundamental, Text and allied modes it inserts a tab character. * The command M-x grep now invokes grep (on arguments supplied by the user) and reads the output from grep asynchronously into a buffer. The command C-x ` can be used to move to the lines that grep has found. This is an adaptation of the mechanism used for running compilations and finding the loci of error messages. You can now use C-x ` even while grep or compilation is proceeding; as more matches or error messages arrive, C-x ` will parse them and be able to find them. * M-x mail now provides a command to send the message and "exit"--that is, return to the previously selected buffer. It is C-z C-z. * Tab in C mode now tries harder to adapt to all indentation styles. If the line being indented is a statement that is not the first one in the containing compound-statement, it is aligned under the beginning of the first statement. * The functions screen-width and screen-height return the total width and height of the screen as it is now being used. set-screen-width and set-screen-height tell Emacs how big to assume the screen is; they each take one argument, an integer. * The Lisp function 'function' now exists. function is the same as quote, except that it serves as a signal to the Lisp compiler that the argument should be compiled as a function. Example: (mapcar (function (lambda (x) (+ x 5))) list) * The function set-key has been renamed to global-set-key. undefine-key and local-undefine-key has been renamed to global-unset-key and local-unset-key. * Emacs now collects input from asynchronous subprocesses while waiting in the functions sleep-for and sit-for. * Shell mode's Newline command attempts to distinguish subshell prompts from user input when issued in the middle of the buffer. It no longer reexecutes from dot to the end of the line; it reeexecutes the entire line minus any prompt. The prompt is recognized by searching for the value of shell-prompt-pattern, starting from the beginning of the line. Anything thus skipped is not reexecuted. Changes in Emacs 1.3 * An undo facility exists now. Type C-x u to undo a batch of changes (usually one command's changes, but some commands such as query-replace divide their changes into multiple batches. You can repeat C-x u to undo further. As long as no commands other than C-x u intervene, each one undoes another batch. A numeric argument to C-x u acts as a repeat count. If you keep on undoing, eventually you may be told that you have used up all the recorded undo information. Some actions, such as reading in files, discard all undo information. The undo information is not currently stored separately for each buffer, so it is mainly good if you do something totally spastic. [This has since been fixed.] * A learn-by-doing tutorial introduction to Emacs now exists. Type C-h t to enter it. * An Info documentation browser exists. Do M-x info to enter it. It contains a tutorial introduction so that no more documentation is needed here. As of now, the only documentation in it is that of Info itself. * Help k and Help c are now different. Help c prints just the name of the function which the specified key invokes. Help k prints the documentation of the function as well. * A document of the differences between GNU Emacs and Twenex Emacs now exists. It is called DIFF, in the same directory as this file. * C mode can now indent comments better, including multi-line ones. Meta-Control-q now reindents comment lines within the expression being aligned. * Insertion of a close-parenthesis now shows the matching open-parenthesis even if it is off screen, by printing the text following it on its line in the minibuffer. * A file can now contain a list of local variable values to be in effect when the file is edited. See the file DIFF in the same directory as this file for full details. * A function nth is defined. It means the same thing as in Common Lisp. * The function install-command has been renamed to set-key. It now takes the key sequence as the first argument and the definition for it as the second argument. Likewise, local-install-command has been renamed to local-set-key. Changes in Emacs 1.2 * A Lisp single-stepping and debugging facility exists. To cause the debugger to be entered when an error occurs, set the variable debug-on-error non-nil. To cause the debugger to be entered whenever function foo is called, do (debug-on-entry 'foo). To cancel this, do (cancel-debug-on-entry 'foo). debug-on-entry does not work for primitives (written in C), only functions written in Lisp. Most standard Emacs commands are in Lisp. When the debugger is entered, the selected window shows a buffer called " *Backtrace" which displays a series of stack frames, most recently entered first. For each frame, the function name called is shown, usually followed by the argument values unless arguments are still being calculated. At the beginning of the buffer is a description of why the debugger was entered: function entry, function exit, error, or simply that the user called the function `debug'. To exit the debugger and return to top level, type `q'. In the debugger, you can evaluate Lisp expressions by typing `e'. This is equivalent to `M-ESC'. When the debugger is entered due to an error, that is all you can do. When it is entered due to function entry (such as, requested by debug-on-entry), you have two options: Continue execution and reenter debugger after the completion of the function being entered. Type `c'. Continue execution but enter the debugger before the next subexpression. Type `d'. You will see that some stack frames are marked with *. This means the debugger will be entered when those frames exit. You will see the value being returned in the first line of the backtrace buffer. Your options: Continue execution, and return that value. Type `c'. Continue execution, and return a specified value. Type `r'. You can mark a frame to enter the debugger on exit with the `b' command, or clear such a mark with `u'. * Lisp macros now exist. For example, you can write (defmacro cadr (arg) (list 'car (list 'cdr arg))) and then the expression (cadr foo) will expand into (car (cdr foo)) Changes in Emacs 1.1 * The initial buffer is now called "scratch" and is in a new major mode, Lisp Interaction mode. This mode is intended for typing Lisp expressions, evaluating them, and having the values printed into the buffer. Type Linefeed after a Lisp expression, to evaluate the expression and have its value printed into the buffer, advancing dot. The other commands of Lisp mode are available. * The C-x C-e command for evaluating the Lisp expression before dot has been changed to print the value in the minibuffer line rather than insert it in the buffer. A numeric argument causes the printed value to appear in the buffer instead. * In Lisp mode, the command M-C-x evaluates the defun containing or following dot. The value is printed in the minibuffer. * The value of a Lisp expression evaluated using M-ESC is now printed in the minibuffer. * M-q now runs fill-paragraph, independent of major mode. * C-h m now prints documentation on the current buffer's major mode. What it prints is the documentation of the major mode name as a function. All major modes have been equipped with documentation that describes all commands peculiar to the major mode, for this purpose. * You can display a Unix manual entry with the M-x manual-entry command. * You can run a shell, displaying its output in a buffer, with the M-x shell command. The Return key sends input to the subshell. Output is printed inserted automatically in the buffer. Commands C-c, C-d, C-u, C-w and C-z are redefined for controlling the subshell and its subjobs. "cd", "pushd" and "popd" commands are recognized as you enter them, so that the default directory of the Emacs buffer always remains the same as that of the subshell. * C-x $ (that's a real dollar sign) controls line-hiding based on indentation. With a numeric arg N > 0, it causes all lines indented by N or more columns to become invisible. They are, effectively, tacked onto the preceding line, where they are represented by " ..." on the screen. (The end of the preceding visible line corresponds to a screen cursor position before the "...". Anywhere in the invisible lines that follow appears on the screen as a cursor position after the "...".) Currently, all editing commands treat invisible lines just like visible ones, except for C-n and C-p, which have special code to count visible lines only. C-x $ with no argument turns off this mode, which in any case is remembered separately for each buffer. * Outline mode is another form of selective display. It is a major mode invoked with M-x outline-mode. It is intended for editing files that are structured as outlines, with heading lines (lines that begin with one or more asterisks) and text lines (all other lines). The number of asterisks in a heading line are its level; the subheadings of a heading line are all following heading lines at higher levels, until but not including the next heading line at the same or a lower level, regardless of intervening text lines. In outline mode, you have commands to hide (remove from display) or show the text or subheadings under each heading line independently. Hidden text or subheadings are invisibly attached to the end of the preceding heading line, so that if you kill the hading line and yank it back elsewhere all the invisible lines accompany it. All editing commands treat hidden outline-mode lines as part of the preceding visible line. * C-x C-z runs save-buffers-kill-emacs offers to save each file buffer, then exits. * C-c's function is now called suspend-emacs. * The command C-x m runs mail, which switches to a buffer *mail* and lets you compose a message to send. C-x 4 m runs mail in another window. Type C-z C-s in the mail buffer to send the message according to what you have entered in the buffer. You must separate the headers from the message text with an empty line. * You can now dired partial directories (specified with names containing *'s, etc, all processed by the shell). Also, you can dired more than one directory; dired names the buffer according to the filespec or directory name. Reinvoking dired on a directory already direded just switches back to the same directory used last time; do M-x revert if you want to read in the current contents of the directory. C-x d runs dired, and C-x 4 d runs dired in another window. C-x C-d (list-directory) also allows partial directories now. Lisp programming changes * t as an output stream now means "print to the minibuffer". If there is already text in the minibuffer printed via t as an output stream, the new text is appended to the old (or is truncated and lost at the margin). If the minibuffer contains text put there for some other reason, it is cleared first. t is now the top-level value of standard-output. t as an input stream now means "read via the minibuffer". The minibuffer is used to read a line of input, with editing, and this line is then parsed. Any excess not used by `read' is ignored; each `read' from t reads fresh input. t is now the top-level value of standard-input. * A marker may be used as an input stream or an output stream. The effect is to grab input from where the marker points, advancing it over the characters read, or to insert output at the marker and advance it. * Output from an asynchronous subprocess is now inserted at the end of the associated buffer, not at the buffer's dot, and the buffer's mark is set to the end of the inserted output each time output is inserted. * (pos-visible-in-window-p POS WINDOW) returns t if position POS in WINDOW's buffer is in the range that is being displayed in WINDOW; nil if it is scrolled vertically out of visibility. If display in WINDOW is not currently up to date, this function calculates carefully whether POS would appear if display were done immediately based on the current (window-start WINDOW). POS defaults to (dot), and WINDOW to (selected-window). * Variable buffer-alist replaced by function (buffer-list). The actual alist of buffers used internally by Emacs is now no longer accessible, to prevent the user from crashing Emacs by modifying it. The function buffer-list returns a list of all existing buffers. Modifying this list cannot hurt anything as a new list is constructed by each call to buffer-list. * load now takes an optional third argument NOMSG which, if non-nil, prevents load from printing a message when it starts and when it is done. * byte-recompile-directory is a new function which finds all the .elc files in a directory, and regenerates each one which is older than the corresponding .el (Lisp source) file. ---------------------------------------------------------------------- Copyright information: Copyright (C) 1985 Richard M. Stallman Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the copyright notice and this permission notice are preserved, thus giving the recipient permission to redistribute in turn. Permission is granted to distribute modified versions of this document, or of portions of it, under the above conditions, provided also that they carry prominent notices stating who last changed them. Local variables: mode: text end: emacs-19.30/etc/ORDERS100664 12120 13 364104 5770642016 12415 0ustar rmsuserThe actual order form follows the descriptions of media contents. Most of this file is excerpted from the draft of the June 1995 GNU's Bulletin. The Order Form itself is accurate, but the information in the other articles is not completely updated. You can ask gnu@prep.ai.mit.edu for the complete June, 1995 Order From to get up-to-date information. Please send suggestions for improvements to gnu@prep.ai.mit.edu or the postal address at the end of the order form. Thank You. --------------------------------------------------------------------- FSF Order Form with Descriptions preliminary, June 1995 Free Software Foundation, Inc. Telephone: +1-617-542-5942 59 Temple Place - Suite 330 Fax: (including Japan) +1-617-542-2652 Boston, MA 02111-1307 Free Dial Fax (in Japan): USA 0031-13-2473 (KDD) Electronic mail: `gnu@prep.ai.mit.edu' 0066-3382-0158 (IDC) There are some sections (e.g. ``Forthcoming GNUs'' and ``How to Get GNU Software'') which are not in this Order Form file. If you wish to see them, ask gnu@prep.ai.mit.edu for the complete June, 1995 GNU's Bulletin. Table of Contents ----------------- Donations Translate Into Free Software Cygnus Matches Donations! Free Software Redistributors Donate Help from Free Software Companies (not included) Major Changes in GNU Software and Documentation (not included as it was not done when this file was assembled). GNU Documentation GNU Software (not completely up to date) Program/Package Cross Reference (not completely up to date) Tapes Languages Tape (version numbers not completely up to date) Lisps and Emacs Tape (version numbers not completely up to date) Utilities Tape (version numbers not completely up to date) Scheme Tape X11 Tapes Berkeley 4.4BSD-Lite Tape VMS Emacs and VMS Compiler Tapes CD-ROMs Pricing of the GNU CD-ROMs MS-DOS CD-ROM Debian GNU/Linux CD-ROM Compiler Tools Binaries CD-ROM Source Code CD-ROMs June 1995 Source Code CD-ROM (version numbers not completely up to date) May 1994 Source Code CD-ROM November 1993 Source Code CD-ROM MS-DOS Diskettes DJGPP Diskettes (version numbers not completely up to date) Emacs Diskettes (version numbers not completely up to date) Selected Utilities Diskettes (not completely up to date) Windows Diskette Tape & CD-ROM Subscription Service The Deluxe Distribution FSF T-shirt Free Software Foundation Order Form Donations Translate Into Free Software ************************************** If you appreciate Emacs, GNU CC, Ghostscript, and other free software, you may wish to help us make sure there is more in the future--remember, *donations translate into more free software!* Your donation to us is tax-deductible in the United States. We gladly accept *any* currency, although the U.S. dollar is the most convenient. m{No Value For "ergegrafkludge"} If your employer has a matching gifts program for charitable donations, please arrange to: add the FSF to the list of organizations for your employer's matching gifts program; and have your donation matched (note *Note Cygnus Matches Donations!::), if you do not know, please ask your personnel department. Circle amount you are donating, cut out this form, and send it with your donation to: Free Software Foundation 59 Temple Place -- Suite 330 Boston, MA 02111-1307 USA $500 $250 $100 $50 other $________ Other currency:________ You can charge a donation to any of Carte Blanche, Diner's Club, JCB, Mastercard, Visa, or American Express. Charges may also be faxed to +1-617-492-9057. Individuals in Japan who are unable to place international calls may use the "free dial" numbers: 0031-13-2473 (KDD) and 0066-3382-0158 (IDC). Card type: __________________ Expiration Date: _____________ Account Number: _____________________________________________ Cardholder's Signature: _____________________________________ Name: _______________________________________________________ Street Address: _____________________________________________ City/State/Province: ________________________________________ Zip Code/Postal Code/Country: _______________________________ Cygnus Matches Donations! ************************* To encourage cash donations to the Free Software Foundation, Cygnus Support will continue to contribute corporate funds to FSF to accompany gifts by its employees, and by its customers and their employees. Donations payable to the Free Software Foundation should be sent by eligible persons to Cygnus Support, which will add its gifts and forward the total to the FSF each quarter. The FSF will provide the contributor with a receipt to recognize the contribution (which is tax-deductible on U.S. tax returns). For more information, please contact Cygnus: Cygnus Support 1937 Landings Drive Mountain View, CA 94043 USA Telephone: 415-903-1400 +1-800-Cygnus1 (-294-6871) Fax: 415-903-0122 Electronic-Mail: `info@cygnus.com' FTP: `ftp.cygnus.com' WWW: `http://www.cygnus.com/' Free Software Redistributors Donate *********************************** by Richard Stallman The Sun Users Group Deutschland and ASCII Corporation (Japan) have added donations to the FSF to the price of their next CD-ROM of GNU software. Potential purchasers will know precisely how much of the price is for the FSF and how much is for the redistributor. Austin Code Works, a redistributor of free software, is supporting free software development by giving the FSF 20% of the selling price for the GNU software packages they produce and sell. The producers of the SNOW 2.1 CD added the words "Includes $5 donation to the FSF" to the front of their CD. Walnut Creek CDROM and Info Magic, two more free software redistributors, are also giving us a percentage of their selling price. CQ Publishing made a large donation from the sales of their book about GAWK in Japanese. In the long run, the success of free software depends on how much new free software people develop. Free software distribution offers an opportunity to raise funds for such development in an ethical way. These redistributors have made use of the opportunity. Many others let it go to waste. You can help promote free software development by convincing for-a-fee redistributors to contribute--either by doing development themselves, or by donating to development organizations (the FSF and others). The way to convince distributors to contribute is to demand and expect this of them. This means choosing among distributors partly by how much they give to free software development. Then you can show distributors they must compete to be the one who gives the most. To make this work, you must insist on numbers that you can compare, such as, "We will give ten dollars to the Foobar project for each disk sold." A vague commitment, such as "A portion of the profits is donated," doesn't give you a basis for comparison. Even a precise fraction "of the profits from this disk" is not very meaningful, since creative accounting and unrelated business decisions can greatly alter what fraction of the sales price counts as profit. Also, press developers for firm information about what kind of development they do or support. Some kinds make much more long-term difference than others. For example, maintaining a separate version of a GNU program contributes very little; maintaining a program on behalf of the GNU Project contributes much. Easy new ports contribute little, since someone else would surely do them; difficult ports such as adding a new CPU to the GNU compiler contribute more; major new features and programs contribute the most. By establishing the idea that supporting further development is "the proper thing to do" when distributing free software for a fee, we can assure a steady flow of resources for making more free software. Help from Free Software Companies ********************************* When choosing a free software business, ask those you are considering how much they do to assist free software development, e.g., by contributing money to free software development or by writing free software improvements themselves for general use. By basing your decision partially on this factor, you can help encourage those who profit from free software to contribute to its growth. These free software support companies regularly donate a part of their income to the Free Software Foundation to support the development of new GNU programs. Listing them here is our way of thanking them. Wingnut has made a pledge to donate 10% of their income to the FSF, and has also purchased several Deluxe Distribution packages in Japan. (Wingnut is SRA's special GNU support group). Also see *Note Cygnus Matches Donations!::. Wingnut Project Software Research Associates, Inc. 1-1-1 Hirakawa-cho, Chiyoda-ku Tokyo 102, Japan Phone: (+81-3)3234-2611 Fax: (+81-3)3942-5174 E-mail: `info-wingnut@sra.co.jp' GNU Documentation ***************** GNU is dedicated to having quality, easy-to-use online and printed documentation. GNU manuals are intended to explain underlying concepts, describe how to use all the features of each program, and give examples of command use. GNU manuals are distributed as Texinfo source files, which yield both typeset hardcopy via the TeX document formatting system, and online hypertext display via the menu-driven Info system. Source for these manuals comes with our software; here we list the manuals that we publish as printed books as well; see the *note Free Software Foundation Order Form::.. Most GNU manuals are bound as soft cover books with "lay-flat" bindings. This allows you to open them so they lie flat on a table without creasing the binding. These books have an inner cloth spine and an outer cardboard cover that will not break or crease as an ordinary paperback will. Currently, the `GDB', `Emacs', `Emacs Lisp Reference', `GAWK', `Make', `Bison', and `Texinfo' manuals have this binding. The other GNU manuals also lie flat when opened, using a GBC or Wire-O binding. All of our manuals are 7in by 9.25in except the 8.5in by 11in `Calc' manual. The edition number of the manual and version number of the program listed after each manual's name were current at the time this Bulletin was published. `Debugging with GDB' (Edition 4.12 for Version 4.14) tells how to use the GNU Debugger, run your program under debugger control, examine and alter data, modify a program's flow of control, and use GDB through GNU Emacs. The `Emacs Manual' (11th Edition for Version 19.29) describes editing with GNU Emacs. It explains advanced features, including outline mode and regular expression search; how to use special modes for programming in languages like C++ and TeX; how to use the `tags' utility; how to compile and correct code; how to make your own keybindings; and other elementary customizations. `Programming in Emacs Lisp, An Introduction' (Edition 1.03 for Version 19.29) is an elementary introduction to programming in Emacs Lisp. It is written for people who are not necessarily interested in programming, but who do want to customize or extend their computing environment. It tells how to write programs that find files; switchbuffers; use searches, conditionals, loops, and recursion; how to write Emacs initialization files; and how to run the Emacs Lisp debuggers. If you read the text in GNU Emacs under Info mode, you can run the sample programs directly. The `GNU Emacs Lisp Reference Manual' (Edition 2.4 for Version 19.29) covers this programming language in depth, including data types, control structures, functions, macros, syntax tables, searching/matching, modes, windows, keymaps, byte compilation, and the operating system interface. The `GAWK Manual' (Edition 0.16 for Version 2.16) tells how to use the GNU implementation of `awk'. It is written for those who have never used `awk' and describes the features of this powerful string and record manipulation language. The `Make Manual' (Edition 0.46 for Version 3.72) describes GNU `make', a program used to rebuild parts of other programs. The manual tells how to write "makefiles", which specify how a program is to be compiled and how its files depend on each other. Included are an introductory chapter for novice users and a section about automatically generated dependencies. The `Flex Manual' (Edition 1.03 for Version 2.3.7) teaches you to write a lexical scanner definition for the `flex' program to create a C++ or C-coded scanner that recognizes the patterns defined. You need no prior knowledge of scanners. The `Bison Manual' (December 1993 Edition for Version 1.23) teaches you how to write context-free grammars for the Bison program that convert into C-coded parsers. You need no prior knowledge of parser generators. `Using and Porting GNU CC' (September 1994 Edition for Version 2.6) tells how to run, install, and port the GNU C Compiler to new systems. It lists new features and incompatibilities of GCC, but people not familiar with C will still need a good reference on the C programming language. It also covers G++. The `Texinfo Manual' (Edition 2.20 for Version 3) explains the markup language used to generate both the online Info documentation and typeset hardcopies. It tells you how to make tables, lists, chapters, nodes, indexes, cross references, how to use Texinfo mode in GNU Emacs, and how to catch mistakes. This second edition describes over 50 new commands. The `Termcap Manual' (2nd Edition for Version 1.2), often described as "twice as much as you ever wanted to know about termcap," details the format of the termcap database, the definitions of terminal capabilities, and the process of interrogating a terminal description. This manual is primarily for programmers. The `C Library Reference Manual' (Edition 0.06 for Version 1.09) describes most of the facilities of the GNU C library, including both what Unix calls "library functions" and "system calls." We are doing limited copier runs of this manual until it becomes more stable. Please send corrections and improvements to `bug-glibc-manual@prep.ai.mit.edu'. The `Emacs Calc Manual' (Edition 2.02 for Version 2.02) is both a tutorial and a reference manual. It tells how to do ordinary arithmetic, how to use Calc for algebra, calculus, and other forms of mathematics, and how to extend Calc. GNU Software - (NOT COMPLETELY UP TO DATE) ************ All our software is available via FTP; see *Note How to Get GNU Software::. In addition, we offer software on various media and printed documentation: * *Note CD-ROMs::. * *Note Tapes::. * *Note MS-DOS Diskettes::. * *Note Documentation::, which includes manuals and reference cards. We welcome all bug reports sent to the appropriate electronic mailing list (*note Free Software Support::.). In the articles describing the contents of each medium, the version number listed after each program name was current when we published this Bulletin. When you order a distribution tape, diskette or newer CD-ROM, some of the programs may be newer, and therefore the version number higher. Key to cross reference: BinCD Binaries CD-ROM DjgppD Djgpp Diskettes DosCD MS-DOS CD-ROM EmcsD Emacs Diskettes LspEmcT Lisps/Emacs Tape LangT Languages Tape LiteT 4.4BSD-Lite Tape SchmT Scheme Tape SrcCD Source CD-ROM UtilD Selected Utilities Diskettes UtilT Utilities Tape VMSCompT VMS Compiler Tape VMSEmcsT VMS Emacs Tape WdwsD Windows Diskette X11OptT X11 Optional Tape X11ReqT X11 Required Tape Configuring GNU Software: We are using a uniform scheme for configuring GNU software packages in order to compile them. It uses the `Autoconf' program (see item below). The goal is to have all GNU software support the same alternatives for naming machine and system types. When the GNU system is complete it will be possible to configure and build the entire system at once, eliminating the need to separately configure each individual package. The configuration scheme lets you specify both the host and target system to build cross-compilation tools. GNU software currently available: (For new features and coming programs, see *Note Forthcoming GNUs::.) * `acm' (SrcCD, UtilT) `acm' is a LAN-oriented, multiplayer aerial combat simulation that runs under the X Window System. Players engage in air to air combat against one another using heat seeking missiles and cannons. We are working on more accurate simulation of real airplane flight characteristics. * Autoconf (SrcCD, UtilT) Autoconf produces shell scripts which automatically configure source code packages. These scripts adapt the packages to many kinds of Unix-like systems without manual user intervention. Autoconf creates a script for a package from a template file which lists the operating system features which the package can use, in the form of `m4' macro calls. Autoconf requires GNU `m4' to operate, but the resulting configure scripts it generates do not. Most GNU programs now use Autoconf-generated configure scripts. * BASH (SrcCD, UtilT) The GNU shell, BASH (Bourne Again SHell), is compatible with the Unix `sh' and offers many extensions found in `csh' and `ksh'. BASH has job control, `csh'-style command history, and command-line editing (with Emacs and `vi' modes built-in, and the ability to rebind keys) via the readline library. BASH conforms to the POSIX 1003.2 shell specification. * `bc' (DjgppD, DosCD, SrcCD, UtilT) `bc' is an interactive algebraic language with arbitrary precision numbers. GNU `bc' follows the POSIX.2-1992 standard, with several extensions including multi-character variable names, an `else' statement, and full Boolean expressions. The RPN calculator `dc' is now distributed as part of the same package, but GNU `bc' is not implemented as a `dc' preprocessor. * BFD (BinCD, DjggpD, DosCD, LangT, SrcCD) The Binary File Descriptor library allows a program which operates on object files (e.g., `ld' or GDB) to support many different formats in a clean way. BFD provides a portable interface, so that only BFD needs to know the details of a particular format. One result is that all programs using BFD will support formats such as a.out, COFF, and ELF. BFD comes with source for Texinfo documentation (not yet published on paper). Presently BFD is not distributed separately; it is included with packages that use it. * Binutils (BinCD, DjgppD, DosCD, LangT, SrcCD) Binutils includes the programs: `ar', `c++filt', `demangle', `gas', `gprof', `ld', `nlmconv', `nm', `objcopy', `objdump', `ranlib', `size', `strings', and `strip'. Binutils Version 2 uses the BFD library. The GNU linker `ld' emits source-line numbered error messages for multiply-defined symbols and undefined references. It interprets a superset of the AT&T Linker Command Language, which gives general control over where segments are placed in memory. `nlmconv' converts object files into Novell NetWare Loadable Modules. `objdump' can disassemble code for a29k, ALPHA, H8/300, H8/500, HP-PA, i386, i960, m68k, m88k, MIPS, SH, SPARC, & Z8000 processors, and can display other data (e.g., symbols & relocations) from any file format understood by BFD. * Bison (BinCD, DjgppD, DosCD, LangT, SrcCD, VMSCompT) Bison is an upwardly compatible replacement for the parser generator `yacc'. Texinfo source for the `Bison Manual' and reference card are included. *Note Documentation::. We recently decided to change the policy for using the parsers that Bison generates. It is now permitted to use Bison-generated parsers in non-free programs. *Note GNUs Flashes::. * GNU C Library (BinCD, LangT, SrcCD) The GNU C library supports ANSI C-1989, POSIX 1003.1-1990 and most of the functions in POSIX 1003.2-1992. It is upwardly compatible with 4.4BSD and includes many System V functions, plus GNU extensions. The C Library will perform many functions of the Unix system calls in the Hurd. Mike Haertel has written a fast `malloc' which wastes less memory than the old GNU version. The GNU regular-expression functions (`regex' and `rx') now nearly conform to the POSIX 1003.2 standard. GNU `stdio' lets you define new kinds of streams, just by writing a few C functions. The `fmemopen' function uses this to open a stream on a string, which can grow as necessary. You can define your own `printf' formats to use a C function you have written. For example, you can safely use format strings from user input to implement a `printf'-like function for another programming language. Extended `getopt' functions are already used to parse options, including long options, in many GNU utilities. The C Library runs on Sun-3 (SunOS 4.1), Sun-4 (SunOS 4.1 or Solaris 2), HP 9000/300 (4.3BSD), SONY News 800 (NewsOS 3 or 4), MIPS DECstation (Ultrix 4), DEC Alpha (OSF/1), i386/i486 (System V, SVR4, BSD, SCO 3.2 & SCO ODT 2.0), Sequent Symmetry i386 (Dynix 3) & SGI (Irix 4). Texinfo source for the `GNU C Library Reference Manual' is included (*note Documentation::.); the manual is now being updated. * GNU C++ Library (BinCD, DjgppD, DosCD, LangT, SrcCD) The GNU C++ library (libg++) contains an extensive collection of C++ `forest' classes, an IOStream library for input/output routines, and support tools for use with G++. Supported classes include: Obstacks, multiple-precision Integers and Rationals, Complex numbers, arbitrary length Strings, BitSets and BitStrings. Version 2.6.2 includes the initial release of the libstdc++ library. This implements library facilities defined by the forthcoming ANSI/ISO C++ standard, including the Standard Template Library. * Calc (LspEmcT, SrcCD) Calc (written by Dave Gillespie in Emacs Lisp) is an extensible, advanced desk calculator & mathematical tool that runs as part of GNU Emacs. You can use Calc just as a simple four-function calculator, but it has many more features including: choice of algebraic or RPN (stack-based) entry; logarithmic, trigonometric & financial functions; arbitrary precision; complex numbers; vectors; matrices; dates; times; infinities; sets; algebraic simplification; differentiation & integration. It outputs to `gnuplot' & comes with source for a reference card & a Manual. *Note Documentation::. * GNU Chess (SrcCD, UtilT, WdwsD) GNU Chess lets the computer play a full game of chess with you. It runs on most platforms & has dumb terminal, "curses" & X terminal interfaces. The X terminal interface is based on the `xboard' program. m{No Value For "ergegrafkludge"} GNU Chess implements many specialized features including the null move heuristic, a hash table with aging, the history heuristic (another form of the earlier killer heuristic), caching of static evaluations, & a database which lets it play the first several moves of the game quickly. Recent improvements include better heuristics, faster evaluation, thinking on opponent's time, a perfect King and Pawn vs King endgame routine, Swedish & German language support, support for more book formats, a rudimentary Bobby Fischer clock, & bug fixes. It is primarily supported by Stuart Cracraft, Chua Kong Sian, & Tim Mann on behalf of the FSF. * CLISP (LspEmcT, SrcCD) CLISP is a Common Lisp implementation by Bruno Haible and Michael Stoll. It mostly supports the Lisp described by `Common LISP: The Language (2nd edition)' and the ANSI Common Lisp standard. CLISP includes an interpreter, a byte-compiler, a large subset of CLOS, a foreign language interface and, for some machines, a screen editor. The user interface language (English, German, French) is chooseable at run time. Major packages that run in CLISP include CLX & Garnet. CLISP needs only 2 MB of memory & runs on many microcomputers (including MS-DOS systems, OS/2, the Atari ST, Amiga 500-4000, Acorn RISC PC) & Unix-like systems (GNU/Linux, Sun4, SVR4, SGI, HP-UX, DEC Alpha, NeXTstep & others). * GNU Common Lisp (LspEmcT, SrcCD) GNU Common Lisp (GCL) has a compiler and interpreter for Common Lisp. It used to be known as Kyoto Common Lisp. It is very portable and extremely efficient on a wide class of applications. It compares favorably in performance with commercial Lisps on several large theorem-prover and symbolic algebra systems. It supports the CLtL1 specification but is moving towards the proposed ANSI definition. GCL compiles to C and then uses the native optimizing C compilers (e.g., GCC). A function with a fixed number of args and one value turns into a C function of the same number of args, returning one value, so GCL is maximally efficient on such calls. It has a conservative garbage collector which allows great freedom for the C compiler to put Lisp values in arbitrary registers. It has a source level Lisp debugger for interpreted code, with display of source code in an Emacs window. Ita profiling tools (based on the C profiling tools) count function calls and the time spent in each function. CLX works with GCL. There is now a builtin interface with the TK widget system. It runs in a separate process so that users may monitor progress on lisp computations, or interact with running computations via a windowing interface. There is also an Xlib interface via C (xgcl-2). PCL runs with GCL (see PCL item later in this article). *Note Forthcoming GNUs::, for plans for about GCL, or for recent developments. GCL version 2.0 is released under the GNU Library General Public License. * `cpio' (DjgppD, DosCD, SrcCD, UtilD, UtilT) `cpio' is an alternative archive program with all the features of SVR4 `cpio', including support for the final POSIX 1003.1 `ustar' standard. `mt', a program to position magnetic tapes, is included with `cpio'. * CVS (SrcCD, UtilT) CVS, the Concurrent Version System, manages software revision and release control in a multi-developer, multi-directory, multi-group environment. It works best in conjunction with RCS versions 4 and above, but will parse older RCS formats with the loss of CVS's fancier features. See Berliner, Brian, "CVS-II: Parallelizing Software Development," `Proceedings of the Winter 1990 USENIX Association Conference'. To find out how to get a copy of this report, contact `office@usenix.org'. * DejaGnu (LangT, SrcCD) DejaGnu is a framework for testing other programs that provides a single front end for all tests. The framework's flexibility and consistency makes it easy to write tests for any program. DejaGnu comes with `expect', which runs scripts to conduct dialogs with programs. * Diffutils (DjgppD, DosCD, SrcCD, UtilD, UtilT) GNU `diff' compares files showing line-by-line changes in several flexible formats. It is much faster than traditional Unix versions. The Diffutils package contains `diff', `diff3', `sdiff', and `cmp'. Recent Diffutils improvements include more consistent handling of character sets, and a new `diff' option to do all input/output in binary; this is useful on some non-Posix hosts. Plans for the Diffutils package include support for internationalization (e.g., error messages in Chinese), and for some non-Unix PC environments. * DJGPP (BinCD, DjgppD, DosCD) DJ Delorie has ported GCC/G++ 2.6.0 (see the GCC item in this section) to the i386 MS-DOS platform. The DJGPP package also contains a 32-bit 80386 DOS extender with symbolic debugger; development libraries; and ports of Bison, `flex', GAS, and the GNU Binutils. Full source code is provided. It requires at least 5MB of hard disk space to install and 512K of RAM to use. It supports SVGA (up to 1024x768), XMS & VDISK memory allocation, `himem.sys', VCPI (e.g., QEMM, DESQview, & 386MAX), and DPMI (e.g., Windows 3.x, OS/2, QEMM, & QDPMI). Ask `djgpp-request@sun.soe.clarkson.edu' to join a DJGPP users mailing list. * `dld' (LangT, SrcCD) `dld' is a dynamic linker written by W. Wilson Ho. Linking your program with the `dld' library allows you to dynamically load object files into the running binary. Currently supported are VAX (Ultrix), Sun 3 (SunOS 3.4 & 4.0), SPARC (SunOS 4.0), Sequent Symmetry (Dynix), & Atari ST. * `doschk' (DjgppD, DosCD, SrcCD, UtilT) This program is intended as a utility to help software developers ensure that their source file names are distinguishable on System V platforms with 14-character filenames and on MS-DOS with 8+3 character filenames. * `ecc' (SrcCD, UtilT) `ecc' is a Reed-Solomon error correction checking program, which can correct three byte errors in a block of 255 bytes and detect more severe errors. Contact `paulf@Stanford.EDU' for more information. * `ed' (SrcCD, UtilT) Ed is the standard text editor. * Elib (LspEmcT, SrcCD) Elib is a small library of Emacs Lisp functions, including routines for using AVL trees and doubly-linked lists. * GNU Emacs In 1975, Richard Stallman developed the first Emacs, an extensible, customizable real-time display editor and computing environment. GNU Emacs is his second implementation. It offers true Lisp--smoothly integrated into the editor--for writing extensions, and provides an interface to the X Window System. It also runs on MS-DOS and Windows NT. In addition to its powerful native command set, Emacs has extensions which emulate the editors vi and EDT (DEC's VMS editor). Emacs has many other features which make it a full computing support environment. Our long term plan is now to move it in the direction of a WYSIWYG word processor and make it easy for beginners to use. Source for the `GNU Emacs Manual', `Programming in Emacs Lisp, An Introduction', the `GNU Emacs Lisp Reference Manual', and a reference card come with the software. *Note Documentation::. * GNU Emacs 18 (EmcsD, LspEmcT, SrcCD, VMSEmcsT) GNU Emacs 18.59 is the last release of version 18 from the FSF. We are no longer maintaining it. It runs on many Unix systems. In hardware order: Alliant FX/80 & FX/2800, Altos 3068, Amdahl (UTS), Apollo, AT&T (3Bs & 7300 PC), DG Aviion, Bull DPX/2 (2nn & 3nn) CCI 5/32 & 6/32, Celerity, Convex, Digital (DECstation 3100 & 5000 (PMAXes), Mips, VAX (BSD, SysV & VMS)), Motorola Delta 147 & 187, Dual, Elxsi 6400, Encore (DPC, APC & XPC), Gould, HP (9000 series 200, 300, 700 & 800, but not 500), HLH Orion (original & 1/05), IBM (RS/6000 (AIX), RT/PC (4.2 & AIX) & PS/2 (AIX (386 only))), ISI (Optimum V, 80386), Intel 860 & 80386 (BSD, Esix, SVR3, SVR4, SCO, ISC, IX, AIX & others), Iris (2500, 2500 Turbo & 4D), Masscomp, MIPS, National Semiconductor 32000, NeXT (Mach), NCR Tower 32 (SVR2 & SVR3), Nixdorf Targon 31, Nu (TI & LMI), pfa50, Plexus, Prime EXL, Pyramid (original & MIPS), Sequent (Balance & Symmetry), SONY News (m68k & MIPS), Stride (system release 2), all Suns including 386i (all SunOS & some Solaris vers.), Tadpole, Tahoe, Tandem Integrity S2, Tektronix (16000 & 4300), Triton 88, Ustation E30 (SS5E), Whitechapel (MG1) & Wicat. In operating system order: AIX (RS/6000, RT/PC, 386-PS/2), BSD (vers. 4.1, 4.2, 4.3), DomainOS, Esix (386), HP-UX (HP 9000 series 200, 300, 700, 800 but not 500), ISC (386), IX (386), Mach, Microport, NewsOS (Sony m68k & MIPS) SCO (386), SVR0 (Vax, AT&T 3Bs), SVR2, SVR3, SVR4, Solaris 2.0, SunOS, UTS (Amdahl), Ultrix (vers. 3.0, 4,1), Uniplus 5.2 (Dual machines), VMS (vers. 4.0, 4.2, 4.4, 5.5) & Xenix (386). * GNU Emacs 19 (DosCD, EmacsD, LspEmcT, SrcCD) Emacs 19 works with character-only terminals as well as with the X Window System (with or without the X toolkit); New features in Emacs 19 include: multiple X windows ("frames" to Emacs), with either a separate X window for the minibuffer or a minibuffer attached to each X window; property lists associated with regions of text in a buffer; multiple fonts and colors defined by those properties; simplified and improved processing of function keys, mouse clicks and mouse movement; X selection processing, including clipboard selections; hooks to be run if point or mouse moves outside a certain range; menu bars and popup menus defined by keymaps; scrollbars; before and after change hooks; source-level debugging of Emacs Lisp programs; European character sets support; floating point numbers; improved buffer allocation, including returning storage to the system when a buffer is killed; interfacing with the X resource manager; GNU configuration scheme support; good RCS support; & many updated libraries. Recent features include support for Motif widgets as well as the Athena widgets, displaying multiple views of an outline at the same time, version control support for CVS and for multiple branches, ability to open frames on more than one X display from a single Emacs job, operation on MS-DOS and MS Windows, commands to edit text properties, text properties for formatting text, the ability to save text properties in files, & GNU-standard long named command line options. Emacs 19.29 is believed to work on, in hardware order: Acorn Risc machine (RISCiX); Alliant FX/2800 (BSD); Alpha (OSF/1); Apollo (DomainOS); Bull DPX/2 2nn & 3nn (SysV.3) & sps7 (SysV.2); Clipper; Convex (BSD); Cubix QBx (SysV); Data General Aviion (DGUX); DEC MIPS (Ultrix 4.2 & OSF/1, not VMS); Elxsi 6400 (SysV); Gould Power Node & NP1 (4.2 & 4.3BSD); Harris Night Hawk 1200 and 3000, 4000 and 5000 (cxux); Honeywell XPS100 (SysV); HP 9000 series 200, 300, 700, 800 (but not 500) (4.3BSD or HP-UX 7, 8, 9); Intel i386, i486 and Pentium (386BSD, AIX, BSDI/386, FreeBSD, Esix, GNU/Linux, ISC, MS-DOS (*note MS-DOS Diskettes::. & *Note MS-DOS CD-ROM::), NetBSD, SCO3.2v4, SysV, Xenix, WindowsNT); IBM RS6000 (AIX 3.2); IBM RT/PC (AIX or BSD); Motorola Delta 147 & 187 (SysV.3, SysV.4, & m88kbcs); National Semiconductor 32K (Genix); NeXT (BSD or Mach 2 w/ NeXTStep 3.0); Paragon (OSF/1); Prime EXL (SysV); Pyramid (BSD); Sequent Symmetry (BSD, ptx); Siemens RM400 and RM600 (SysV); SGI Iris 4D (Irix 4.x & 5.x); Sony News/RISC (NewsOS); Stardent i860 (SysV); Sun 3 & 4, SPARC 1, 1+, 2, 10 & Classic (SunOS 4.0, 4.1, Solaris 2.0-2.3); Tadpole 68k (SysV); Tektronix XD88 (SysV.3) & 4300 (BSD); & Titan P2 & P3 (SysV). In operating system order: AIX (i386, RS6000, RT/PC); 4.1, 4.2, 4.3BSD (i386, i860, Convex, Gould Power Node & NP1, HP9000 series 300, NeXT, Pyramid, Symmetry, Tektronix 4300, RT/PC); DG/UX (Aviion); DomainOS(Apollo); Esix (i386); FreeBSD (i386); Genix (ns32k); GNU/Linux (i386); HP-UX 7, 8, 9 (HP 9000 series 200, 300, 700, 800, but not 500); Irix 4 & 5 (Iris 4D); ISC (i386); Mach 2 & 3 (i386, NeXT); MS-DOS (*note MS-DOS Diskettes::. & *Note MS-DOS CD-ROM::); NetBSD (i386, HP9000 series 300); OSF/1 (Alpha, Paragon); RISCiX (Acorn); SCO 3.2v4 (i386); SysV (Cubix QBx, Elxsi 6400, Honeywell XPS100, Intel i386, Prime EXL, Siemens RM400 and RM600, Stardent, Tadpole 68k, Titan P2 & P3); SysV.2 (Bull sps7); SysV.3 (Bull DPX/2 2nn & 3nn, Motorola Delta 147 & 187, Tektronix XD88); SysV.4 (Motorola Delta 147 & 187, Stardent i860); Solaris 2 (SPARC 1, 1+, 2, 10, Classic); SunOS 4.0, 4.1 (Sun 3 & 4, SPARC 1, 1+, 2, 10 & Classic); Ultrix 4.2 (DEC MIPS); Windows NT; & Xenix (i386). Other configurations supported by Emacs 18 should work with few changes in Emacs 19; as users tell us more about their experiences with different systems, we will augment the list. Also see *Note Forthcoming GNUs::. * `es' (SrcCD, UtilT) `es' is an extensible shell based on `rc' with first class functions, lexical scope, exceptions, and rich return values (i.e., functions can return values other than just numbers). `es''s extensibility comes from the ability to modify and extend the shell's builtin services, such as path searching and redirection. Like `rc', it is great for both interactive use and for scripting, particularly since its quoting rules are much less baroque than the C or Bourne shells. * `f2c' (LangT, SrcCD) `f2c' converts Fortran-77 source files into C or C++, which can be compiled with GCC. You can get bug fixes by FTP from site `netlib.att.com' or by email from `netlib@research.att.com'. The fixes are summarized in the file `/netlib/f2c/changes.Z'. *Note Forthcoming GNUs::, for information about GNU Fortran. * Fileutils (DjgppD, DosCD, SrcCD, UtilD, UtilT) The fileutils work on files: `chgrp', `chmod', `chown', `cp', `dd', `df', `dir', `du', `install', `ln', `ls', `mkdir', `mkfifo', `mknod', `mv', `mvdir', `rm', `rmdir', `sync', `touch', & `vdir'. Only some of these are on the *Note Selected Utilities Diskettes::. * Findutils (DjgppD, DosCD, SrcCD, UtilD, UtilT) `find' is frequently used both interactively and in shell scripts to find files which match certain criteria and perform arbitrary operations on them. Also included are `xargs', which applies a command to a list of files, and `locate', which scans a database for file names that match a pattern. * Finger (SrcCD, UtilT) GNU Finger has more features than other finger programs. For sites with many hosts, a single host may be designated as the finger "server" host, and other hosts at that site configured as finger "clients". The server host collects information about who is logged in to the clients. To finger a user at a GNU Finger site, a query to any its client hosts gets useful information. GNU Finger supports many customization features, including user output filters, and site programmable output for special target names. * `flex' (DjgppD, DosCD, LangT, SrcCD, UtilD) `flex' is a replacement for the `lex' scanner generator. `flex' was written by Vern Paxson of the Lawrence Berkeley Laboratory and generates far more efficient scanners than `lex' does. Source for the `Flex Manual' and reference card are included. *Note Documentation::. * FlexFAX (UtilT) FlexFAX is now called HylaFAX. For more information, *Note GNU Software::. * Fontutils (SrcCD, UtilT) The fontutils create fonts for use with Ghostscript or TeX, starting with a scanned type image and converting the bitmaps to outlines. They also contain general conversion programs and other utilities. Fontutils programs include: `bpltobzr', `bzrto', `charspace', `fontconvert', `gsrenderfont', `imageto', `imgrotate', `limn', and `xbfe'. * GAWK (DjgppD, DosCD, LangT, SrcCD) GAWK is upwardly compatible with the latest POSIX specification of `awk'. It also provides several useful extensions not found in other `awk' implementations. Texinfo source for the `GAWK Manual' comes with the software. *Note Documentation::. * GCC (BinCD, DjgppD, DosCD, LangT, SrcCD, VMSCompT) Version 2 of the GNU C Compiler supports multiple languages; the source file name suffix or a compiler option selects the language. The GNU C Compiler distribution includes support for C, C++ and Objective-C. Support for Objective-C was donated by NeXT. The runtime support needed to run Objective-C programs is now distributed with GCC (this does not include any Objective-C classes aside from `object'). As much as possible, G++ is kept compatible with the evolving draft ANSI standard, but not with `cfront' (AT&T's compiler), which has been diverging from ANSI. The GNU C Compiler is a fairly portable optimizing compiler which performs automatic register allocation, common sub-expression elimination, invariant code motion from loops, induction variable optimizations, constant propagation and copy propagation, delayed popping of function call arguments, tail recursion elimination, integration of inline functions and frame pointer elimination, instruction scheduling, loop unrolling, filling of delay slots, leaf function optimization, optimized multiplication by constants, a certain amount of common subexpression elimination (CSE) between basic blocks (though not all of the supported machine descriptions provide for scheduling or delay slots), a feature for assigning attributes to instructions, and many local optimizations that are automatically deduced from the machine description. Position-independent code is supported on the 68k, i386, i486, Pentium, Hitachi Slt, Hitachi H8/300, Clipper, 88k, SPARC & SPARClite. GCC can open-code most arithmetic on 64-bit values (type `long long int'). It supports extended floating point (type `long double') on the 68k; other machines will follow. GCC supports full ANSI C, traditional C & GNU C extensions (including: nested functions support, nonlocal gotos & taking the address of a label). GCC can generate a.out, COFF, ELF & OSF-Rose files when used with a suitable assembler. It can produce debugging information in these formats: BSD stabs, COFF, ECOFF, ECOFF with stabs & DWARF. GCC generates code for many CPUs, including: a29k, Alpha, ARM, AT&T DSP1610, Convex cN, Clipper, Elxsi, Fujitsu Gmicro, H8/300, HP-PA (1.0 and 1.1) i370, i386, i486, Pentium, i860, i960, m68k, m68020, m68030, m68040, m88k, MIL-STD-1750a, MIPS, ns32k, PDP-11, Pyramid, ROMP, RS6000, SH, SPARC, SPARClite, VAX, & we32k. Operating systems supported include: AIX, ACIS, AOS, BSD, Clix, Ctix, DG/UX, Dynix, Genix, GNU, HP-UX, ISC, Irix, GNU/Linux, Luna, LynxOS, Mach, Minix, NetBSD, NewsOS, OSF, OSF-Rose, RISCOS, SCO, Solaris 2, SunOS 4, SysV, Ultrix, Unos, VMS & Windows/NT. Using the configuration scheme for GCC, building a cross-compiler is as easy as building a native compiler. We no longer maintain version 1 of GCC, G++, or libg++. Texinfo source for the `Using and Porting GNU CC' manual, is included with GCC. *Note Forthcoming GNUs::, for plans for later releases of GCC. * GDB (BinCD, DjgppD, DosCD, LangT, SrcCD) GDB, the GNU DeBugger, is a source-level debugger which supports C, C++, and Fortran. GDB can debug both C and C++ programs, and will work with executables produced by many different compilers; however, C++ debugging will have some limitations if you do not use GCC. GDB has a command line user interface; GNU Emacs comes with a GDB mode, and `xxgdb' provides an X interface (but it is not distributed or maintained by the FSF; FTP it from `ftp.x.org' in the `/contrib/utilities' directory). Executable files and symbol tables are read via the BFD library, which allows a single copy of GDB to debug programs with multiple object file formats (e.g., a.out, COFF, ELF). Other features include a rich command language, remote debugging over serial lines or TCP/IP, and watchpoints (breakpoints triggered when the value of an expression changes). GDB defines a standard interface for simulators, and the included simulator library includes simulators for the Zilog Z8001/2, Hitachi H8/300, H8/500 & Super-H. GDB can perform cross-debugging. To say that GDB "targets" a platform means that it can perform native or cross-debugging for it. To say that GDB can "host" a given platform means that it can be built on it, but cannot necessarily debug native programs. GDB can: * "target" & "host": Amiga 3000 (Amix), DEC Alpha (OSF/1), DECstation 3100 & 5000 (Ultrix), HP 9000/300 (BSD, HP-UX), HP 9000/700 (HP-UX), i386 (BSD, FreeBSD, GNU/Linux, LynxOS, NetBSD, SCO), IBM RS/6000 (AIX, LynxOS), Motorola Delta m88k (System V, CX/UX), PC532 (NetBSD), Motorola m68k MVME-167 (LynxOS), NCR 3000 (SVR4), SGI (Irix V3, V4, V5), SONY News (NewsOS 3.x), SPARC (SunOS 4.1, Solaris, NetBSD, LynxOS) Sun-3 (SunOS 4.1), & Ultracomputer (a29k running Sym1). * "target", but not "host": AMD 29000 (COFF & a.out), Hitachi H8/300, Hitachi SH, i386 (a.out, COFF, OS/9000) i960 (Nindy, VxWorks), m68k/m68332 (a.out, COFF, VxWorks), MIPS (IDT ecoff, ELF), Fujitsu SPARClite (a.out, COFF), & Z8000. * "host", but not "target": IBM RT/PC (AIX), and HP/Apollo 68k (BSD). GDB can use the symbol tables emitted by the vendor-supplied compilers of most MIPS-based machines, including DEC. (These tables are in a format which almost nobody else uses.) Source for the manual `Debugging with GDB' and a reference card are included. *Note Documentation::. * `gdbm' (LangT, SrcCD, UtilD) `gdbm' is the GNU replacement for the traditional `dbm' and `ndbm' libraries. It implements a database using quick lookup by hashing. `gdbm' does not ordinarily make sparse files (unlike its Unix and BSD counterparts). * Ghostscript (DjgppD, DosCD, SrcCD, UtilT) GNU Ghostscript is the GNU release of Ghostscript, which is an interpreter for the Postscript graphics language (*note Forthcoming GNUs::., for news on future plans). The current version of GNU Ghostscript is 2.6.2. Features include the ability to use the fonts provided by the platform on which Ghostscript runs (X Window System and Microsoft Windows), resulting in much better-looking screen displays; improved text file printing (like `enscript'); a utility to extract the text from a Postscript language document; a much more reliable (and faster) Microsoft Windows implementation; support for Microsoft C/C++ 7.0; drivers for many new printers, including the SPARCprinter, and for TIFF/F (fax) file format; many more Postscript Level 2 facilities, including most of the color space facilities (but not patterns), and the ability to switch between Level 1 and Level 2 dynamically. Version 2.6.2 adds a LaserJet 4 driver and several important bug fixes to version 2.6.1. Ghostscript executes commands in the Postscript language by writing directly to a printer, drawing on an X window, or writing to a file for later printing (or to a bitmap file that you can manipulate with other graphics programs). Ghostscript includes a C-callable graphics library (for client programs that do not want to deal with the Postscript language). It also supports IBM PCs and compatibles with EGA, VGA, or SuperVGA graphics (but please do *not* ask the FSF staff any questions about this; we do not use PCs). * Ghostview (SrcCD, UtilT) Tim Theisen, `ghostview@cs.wisc.edu', has created Ghostview, a previewer for multi-page files with an X11 user interface. Ghostview and Ghostscript function as two cooperating programs; Ghostview creates a viewing window and Ghostscript draws in it. * `gmp' (LangT, SrcCD) GNU mp is a library for arbitrary precision arithmetic on signed integers and rational numbers. It has a rich set of functions with a regular interface. * GNATS (SrcCD, UtilT) GNATS (GNats: A Tracking System, not to be confused with GNAT, The GNU Ada Translator) is a bug-tracking system. It is based upon the paradigm of a central site or organization which receives problem reports and negotiates their resolution by electronic mail. Although it has been used primarily as a software bug-tracking system so far, it is sufficiently generalized so that it could be used for handling system administration issues, project management or any number of other applications. * `gnuplot' (SrcCD, UtilT, WdwsD) `gnuplot' is an interactive program for plotting mathematical expressions and data. It handles both curves (2 dimensions) and surfaces (3 dimensions). Curiously, the program was neither written nor named for the GNU Project; the name is a coincidence. Various GNU programs use `gnuplot' to produce graphical output. * GnuGo (SrcCD, UtilT) GnuGo plays the game of Go (Wei-Chi); it is not yet very sophisticated. * `gperf' (LangT, SrcCD) `gperf' generates perfect hash tables. There are two implementations of `gperf', written in C and C++. Both produce hash functions in either C or C++. * GNU Graphics (SrcCD, UtilT) GNU Graphics is a system which produces x-y plots from ASCII or binary data. It supports output in Postscript, Tektronix 4010 compatible and Unix device-independent "plot" formats as well as a previewer for the X Window System. Features include a `spline' interpolation program; examples of shell scripts using `graph' and `plot'; and a statistics toolkit; and output in TekniCAD TDA and ln03 file formats. Email bugs or questions to Rich Murphey, `Rich@lamprey.utmb.edu'. * grep (DjgppD, DosCD, SrcCD, UtilD, UtilT) This package has GNU `grep', `egrep', and `fgrep' which find lines that match inputed patterns. They are much faster than the traditional Unix versions. * Groff (DjgppD, DosCD, SrcCD, UtilT) Groff is a document formatting system based on an implementation of device-independent troff, which also includes implementations of `eqn', `nroff', `pic', `refer', `tbl', `troff', and the `man', `ms', and `mm' macros, as well as drivers for Postscript, TeX `dvi' format, and typewriter-like devices. Groff's `mm' macro package is almost compatible with the DWB `mm' macros and has several extensions. Also included is a modified version of the Berkeley `me' macros and an enhanced version of the X11 `xditview' previewer. Written in C++, these programs can be compiled with GNU C++ Version 2.5 or later. A driver for the LaserJet 4 series of printers is currently in test. Groff users are encouraged to contribute enhancements. Most needed are complete Texinfo documentation, a `grap' emulation (a `pic' preprocessor for typesetting graphs), a page-makeup postprocessor similar to `pm' (see `Computing Systems', Vol. 2, No. 2; ask `office@usenix.org' how to get a copy) and an ASCII output class for `pic' so that `pic' can be integrated with Texinfo. Questions and bug reports from users who have read the documentation provided with groff can be sent to `bug-groff@prep.ai.mit.edu'. * `gzip' (DjgppD, DosCD, LangT, LspEmcT, SrcCD, UtilT) Some of the contents of our tape and FTP distributions are compressed. We have software on our tapes and FTP sites to uncompress these files. Due to patent troubles with `compress', we use another compression program, `gzip'. (Such prohibitions on software development are fought by the League for Programming Freedom, *note What Is the LPF::., for details.) `gzip' can expand LZW-compressed files but uses another, unpatented algorithm for compression which generally produces better results. It also expands files compressed with System V's `pack' program. * `hello' (DjgppD, DosCD, SrcCD, UtilT) The GNU `hello' program produces a familiar, friendly greeting. It allows non-programmers to use a classic computer science tool which would otherwise be unavailable to them. Because it is protected by the GNU General Public License, users are free to share and change it. Like any truly useful program, `hello' contains a built-in mail reader. * `hp2xx' (SrcCD, UtilT) GNU `hp2xx' reads HP-GL files, decomposes all drawing commands into elementary vectors, and converts them into a variety of vector and raster output formats. It is also an HP-GL previewer. Currently supported vector formats include encapsulated Postscript, Uniplex RGIP, Metafont and various special TeX-related formats, and simplified HP-GL (line drawing only) for imports. Raster formats supported include IMG, PBM, PCX, & HP-PCL (including Deskjet & DJ5xxC support). Previewers work under X11 (Unix), OS/2 (PM & full screen), MS-DOS (SVGA, VGA, & HGC). * HylaFAX (UtilT) HylaFAX is a facsimile system for Unix systems. It supports sending, receiving, and polled retrieval of facsimile, as well as transparent shared data use of the modem. Information is also available on the World Wide Web at URL: `http://www.vix.com/hylafax/'. * `indent' (DjgppD, DosCD, SrcCD, UtilD, UtilT) GNU `indent' is a revision of the BSD version. By default, it formats C source according to the GNU coding standards. The BSD default, K&R and other formats are available as options. It is also possible to define your own format. GNU `indent' is more robust and provides more functionality than other versions, e.g., it handles C++ comments. * Ispell (DjgppD, DosCD, SrcCD, UtilT) Ispell is an interactive spell checker that suggests "near misses" as replacements for unrecognized words. System & user-maintained dictionaries for multiple languages can be used. Standalone & GNU Emacs interfaces are available. Previously, the GNU Project had its own version of ispell ("Ispell 4.0"), but has dropped it for a parallel branch that has had more development ("Ispell 3.1"). (Version 3 was an earlier release from the original Ispell author, but others have since made it more sophisticated.) * JACAL *Not available from the FSF* JACAL is a symbolic mathematics system for the manipulation and simplification of equations and single and multiple-valued algebraic expressions constructed of numbers, variables, radicals, differential operators, and algebraic and holonomic functions. Vectors, matrices, and tensors of these objects are also supported. JACAL was written in Scheme by Aubrey Jaffer. It comes with SCM, an IEEE P1178 and R4RS compliant version of Scheme written in C. SCM runs on Amiga, Atari-ST, MS-DOS, OS/2, NOS/VE, Unicos, VMS, Unix, and similar systems. SLIB is a portable Scheme library used by JACAL. m{No Value For "ergegrafkludge"} The FSF is not distributing JACAL on any media. To receive an IBM PC floppy disk with the source and executable files, send $99.00 to: Aubrey Jaffer 84 Pleasant Street Wakefield, MA 01880-1846 USA * `less' (SrcCD, UtilD, UtilT) `less' is a display paginator similar to `more' and `pg' but with various features (such as the ability to scroll backwards) that most pagers lack. * `m4' (DjgppD, DosCD, SrcCD, UtilD, UtilT) GNU `m4' is an implementation of the traditional Unix macro processor. It is mostly SVR4 compatible, although it has some extensions (for example, handling more than 9 positional parameters to macros). `m4' also has built-in functions for including files, running shell commands, doing arithmetic, etc. * `make' (BinCD, DjgppD, DosCD, LangT, LspEmcT, SrcCD, UtilD, UtilT) GNU `make' supports POSIX 1003.2 and has all but a few obscure features of the BSD and System V versions of `make', as well as many of our own extensions. GNU extensions include long options, parallel compilation, flexible implicit pattern rules, conditional execution and powerful text manipulation functions. Texinfo source for the `Make Manual' comes with the program. *Note Documentation::. GNU `make' is on several of our tapes because some system vendors supply no `make' utility at all, and some native `make' programs lack the `VPATH' feature essential for using the GNU configure system to its full extent. The GNU `make' sources have a shell script to build `make' itself on such systems. MS-DOS binaries for `make' are available with the DJGPP distribution. * MandelSpawn (SrcCD, UtilT) A parallel Mandelbrot generation program for the X Window System. * mtools (SrcCD, UtilT) mtools is a set of public domain programs to allow Unix systems to read, write and manipulate files on an MS-DOS file system (usually a diskette). * MULE (EmcsD, DosCD, SrcCD) MULE is a MULtilingual Enhancement to GNU Emacs. It can handle many character sets at once including Japanese, Chinese, Korean, Vietnamese, Thai, Greek, the ISO Latin-1 through Latin-8 character sets, Ukrainian, Arabic, Hebrew, Russian, and other Cyrillic alphabets. A text buffer in MULE can contain a mixture of characters from these languages. To input any of these characters, you can use various input methods provided by MULE itself. In addition, if you use MULE under some terminal emulators (kterm, cxterm, or exterm), you can use its input methods. MULE is being merged into GNU Emacs. *Note GNU and Other Free Software in Japan::, for more information about MULE. * NetHack (SrcCD, UtilT) NetHack is a display-oriented adventure game similar to Rogue. Both ASCII and X displays are supported. * NIH Class Library (LangT, SrcCD) The NIH Class Library (formerly known as "OOPS", Object-Oriented Program Support) is a portable collection of C++ classes, similar to those in Smalltalk-80, which has been developed by Keith Gorlen of the National Institutes of Health (NIH), using the C++ programming language. * `nvi' (SrcCD, UtilT) `nvi' is a free implementation of the `vi'/`ex' Unix editor. It has most of the functionality of the original `vi'/`ex', except "open" mode & the `lisp' option, which will be added. Enhancements over `vi'/`ex' include split screens with multiple buffers, handling 8-bit data, infinite file & line lengths, tag stacks, infinite undo & extended regular expressions. It runs under GNU/Linux, BSD, NetBSD, FreeBSD, BSDI, AIX, HP-UX, DGUX, IRIX, PSF, PTX, Solaris, SunOS, Ultrix, Unixware & should port easily to many other systems. * GNU Objective-C Library (LangT, SrcCD) The GNU Objective-C Class Library (`libobjects') is a library of general-purpose, non-graphical Objective-C objects written by Andrew McCallum and other volunteers. It includes collection classes for maintaining groups of objects and C types, streams for I/O to various destinations, coders for formatting objects and C types to streams, ports for network packet transmission, distributed objects (remote object messaging), string classes, pseudo-random number generators, and time handling facilities. The package will also include the foundation classes for the GNUStep project; over 50 of these classes have already been implemented. The library is known to work on i386, i486, Pentium, m68k, SPARC, MIPS, & RS6000. Send queries and bug reports to `mccallum@gnu.ai.mit.edu'. * `OBST' (LangT, SrcCD) `OBST' is a persistent object management system with bindings to C++. `OBST' supports incremental loading of methods. Its graphical tools require the X Window System. It features a hands-on tutorial including sample programs. It compiles with g++ and should install easily on most Unix platforms. * Octave (LangT, SrcCD) Octave is a high-level language similar to MATLAB that is primarily intended for numerical computations. It provides a convenient command line interface for solving linear and nonlinear problems numerically. m{No Value For "ergegrafkludge"} Octave does arithmetic for real and complex scalars and matrices, solves sets of nonlinear algebraic equations, integrates systems of ordinary differential and differential-algebraic equations, and integrates functions over finite and infinite intervals. Two- and three-dimensional plotting is available using `gnuplot'. Send queries and bug reports to: `bug-octave@che.utexas.edu'. Source is included for a 220+ page Texinfo manual, which is not yet published by the FSF. * Oleo (SrcCD, UtilT) Oleo is a spreadsheet program (better for you than the more expensive spreadsheets). It supports the X Window System and character-based terminals, and can output Embedded Postscript renditions of spreadsheets. Keybindings should be familiar to Emacs users and are configurable. Under X and in Postscript output, Oleo supports multiple, variable width fonts. *Note Forthcoming GNUs::, for the plans for later releases of Oleo. * `p2c' (LangT, SrcCD) `p2c' is a Pascal-to-C translator written by Dave Gillespie. It recognizes many Pascal dialects including Turbo, HP, VAX, and ISO, and produces readable, maintainable, portable C. * `patch' (DjgppD, DosCD, SrcCD, UtilT) `patch' is our version of Larry Wall's program to take `diff''s output and apply those differences to an original file to generate the modified version. * PCL (LspEmcT, SrcCD) PCL is a free implementation of a large subset of CLOS, the Common Lisp Object System. It runs under both GCL and CLISP, mentioned above. * `perl' (LangT, SrcCD) Larry Wall's `perl' combines the features and capabilities of `sed', `awk', `sh' and C, as well as interfaces to the Unix system calls and many C library routines. * `ptx' (SrcCD, UtilD, UtilT) GNU `ptx' is our version of the traditional permuted index generator. It handles multiple input files at once, produces TeX compatible output, & outputs readable "KWIC" (KeyWords In Context) indexes. It does not yet handle input files that do not fit in memory all at once. * `rc' (SrcCD, UtilT) `rc' is a shell that features a C-like syntax (much more so than `csh') and far cleaner quoting rules than the C or Bourne shells. It's intended to be used interactively, but is also great for writing scripts. It inspired the shell `es'. * RCS (SrcCD, UtilD, UtilT) RCS, the Revision Control System, is used for version control & management of software projects. When used with GNU `diff', RCS can handle binary files (executables, object files, 8-bit data, etc). Also see the item about CVS in this section. * `recode' (SrcCD, UtilT) GNU `recode' converts files between character sets and usages. When exact transliterations are not possible, it may get rid of the offending characters or fall back on approximations. This program recognizes or produces nearly 150 different character sets and is able to transliterate files between almost any pair. Most RFC 1345 character sets are supported. * regex (LangT, SrcCD) The GNU regular expression library supports POSIX.2, except for internationalization features. It is included in many GNU programs which do regular expression matching and available separately. An alternative regular expression package, `rx', comes with `sed'; it has the potential to be faster than `regex' in most cases, but still needs work. * Scheme (SchmT, SrcCD) For information about Scheme, see *Note Scheme Tape::. * `screen' (SrcCD, UtilT) `screen' is a terminal multiplexer that runs several separate "screens" (ttys) on a single character-based terminal. Each virtual terminal emulates a DEC VT100 plus several ISO 6429 (ECMA 48, ANSI X3.64) and ISO 2022 functions. Arbitrary keyboard input translation is also supported. `screen' sessions can be detached and resumed later on a different terminal type. Output in detached sessions is saved for later viewing. * `sed' (DjgppD, DosCD, SrcCD, UtilD, UtilT) `sed' is a stream-oriented version of `ed'. GNU `sed' comes with the `rx' library, a faster version of `regex' (*note Forthcoming GNUs::.). * Sharutils (SrcCD, UtilT) `shar' makes so-called shell archives out of many files, preparing them for transmission by electronic mail services, while `unshar' helps unpack these shell archives after reception. `uuencode' prepares a file for transmission over an electronic channel which ignores or otherwise mangles the high order bit of bytes, while `uudecode' does the converse transformation. * Shellutils (DjgppD, DosCD, SrcCD, UtilT) Use shellutils interactively or in shell scripts: `basename', `date', `dirname', `echo', `env', `expr', `false', `groups', `hostname', `id', `logname', `nice', `nohup', `pathchk', `printenv', `printf', `pwd', `sleep', `stty', `su', `tee', `test', `true', `tty', `uname', `users', `who', `whoami', and `yes'. * GNU Shogi (SrcCD, UtilT) Shogi is a Japanese game similar to Chess; a major difference is that captured pieces can be returned into play. GNU Shogi is a variant of GNU Chess; GNU Shogi implements the same features as GNU Chess and uses similar heuristics. As a new feature, sequences of partial board patterns can be introduced in order to help the program play toward specific opening patterns. There are both character and X display interfaces. GNU Shogi is primarily supported by Matthias Mutz on behalf of the FSF. * Smalltalk (LangT, SrcCD) GNU Smalltalk is an interpreted object-oriented programming language system written in highly portable C. It has been successfully ported to many Unix and some other platforms, including DOS (but these non-Unix ports are not available from the FSF). Current features include a binary image save capability, the ability to invoke user-written C code and pass parameters to it, a GNU Emacs editing mode, a version of the X protocol invocable from Smalltalk, optional byte-code compilation tracing and byte-code execution tracing, and automatically loaded per-user initialization files. It implements all of the classes and protocol in the Smalltalk-80 book "Smalltalk-80: The Language", except for the graphic user interface (`GUI') related classes. *Note Forthcoming GNUs::, for plans for later releases of Smalltalk. * Superopt (LangT, SrcCD) Superopt is a function sequence generator that uses an exhaustive generate-and-test approach to find the shortest instruction sequence for a given function. You provide a function as input, a CPU to generate code for, and how many instructions you can accept. Its application in GCC is described in the `ACM SIGPLAN PLDI'92' proceedings. Superopt supports: SPARC, m68k, m68020, m88k, IBM RS/6000, AMD 29000, Intel 80x86, Pyramid, DEC Alpha, & HP-PA. * `tar' (SrcCD, UtilT) GNU `tar' includes multivolume support, the ability to archive sparse files, automatic archive compression/decompression, remote archives and special features that allow `tar' to be used for incremental and full backups. Unfortunately, GNU `tar' implements an early draft of the POSIX 1003.1 `ustar' standard which is different from the final standard. Adding support for the new changes in a backward-compatible fashion is not trivial. * Termcap Library (SrcCD, UtilT) The GNU Termcap library is a drop-in replacement for `libtermcap.a' on any system. It does not place an arbitrary limit on the size of Termcap entries, unlike most other Termcap libraries. Included is source for the `Termcap Manual' in Texinfo format. *Note Documentation::. * TeX (SrcCD) TeX is a document formatting system that handles complicated typesetting, including mathematics. It is GNU's standard text formatter. You can obtain TeX from the University of Washington, which maintains and supports a tape distribution of TeX for Unix systems. The core material consists of Karl Berry's `web2c' TeX package, the sources for which are available via anonymous ftp; retrieval instructions are in `pub/tex/unixtex.ftp' on `ftp.cs.umb.edu'. If you receive any installation support from the University of Washington, please consider sending them a donation. To order a full distribution written in `tar' on either a 1/4inch 4-track QIC-24 cartridge or a 4mm DAT cartridge, send $210.00 to: Pierre A. MacKay Department of Classics DH-10, Denny Hall 218 University of Washington Seattle, WA 98195 USA Electronic-Mail: `mackay@cs.washington.edu' Telephone: +1-206-543-2268 Please make checks payable to the University of Washington. Do not specify any other payee. That causes accounting difficulties. Checks must be in U.S. dollars, drawn on a U.S. bank. Prepaid orders are the only orders that can now be handled. Overseas sites: please add to the base cost $20.00 for shipment via air parcel post, or $30.00 for shipment via courier. Please check with the above for current prices and formats. * Texinfo (DjgppD, DosCD, LangT, LspEmcT, SrcCD, UtilD, UtilT) Texinfo is a set of utilities which generate both printed manuals and online hypertext documentation (called "Info"). There are also programs for reading online Info documents. Version 3 has both GNU Emacs Lisp and standalone programs written in C or shell script. Texinfo mode for GNU Emacs enables easy editing and updating of Texinfo files. Programs provided include `makeinfo', `info', `texi2dvi', `texindex', `tex2patch', and `fixfonts'. Source for the `Texinfo Manual' is included. *Note Documentation::. * Textutils (DjgppD, DosCD, SrcCD, UtilT) The Textutils programs manipulate textual data. They include: `cat', `cksum', `comm', `csplit', `cut', `expand', `fmt', `fold', `head', `join', `nl', `od', `paste', `pr', `sort', `split', `sum', `tac', `tail', `tr', `unexpand', `uniq', and `wc'. * Tile Forth (LangT, SrcCD) Tile Forth is a 32-bit implementation of the Forth-83 standard written in C, allowing it to be easily ported to new systems, and extended with "any" C-function (graphics, windowing, etc). Many Forth libraries with full documentation are available including ones for top-down parsing, multi-threads, and object oriented programming. * `time' (SrcCD, UtilT) `time' is used to report statistics (usually from a shell) about the amount of user, system and real time used by a process. On some systems it also reports memory usage, page faults, and other statistics. * `tput' (SrcCD, UtilT) `tput' is a portable way for shell scripts to use special terminal capabilities. Our `tput' uses the Termcap database, instead of Terminfo as most others do. * UUCP (SrcCD, UtilT) This version of UUCP was written by Ian Lance Taylor, and is GNU's standard UUCP system. It supports the `f', `g' and `v' (in all window and packet sizes), `G', `t', `e', Zmodem and two new bidirectional (`i' and `j') protocols. If you have a Berkeley sockets library, it can make TCP connections. If you have TLI libraries, it can make TLI connections. Source is included for a Texinfo manual, which is not yet published by the FSF. * `wdiff' (DjgppD, DosCD, SrcCD, UtilT) `wdiff' is a front-end to GNU `diff'. It compares two files, finding the words deleted or added to the first to make the second. It has many output formats and works well with terminals and pagers. `wdiff' is very useful when two texts differ only by a few words and paragraphs have been refilled. * `Ygl' (SrcCD, UtilT) `Ygl' emulates SGI's GL (Graphics Language) library under X11. It runs under GNU/Linux with XFree, AIX 3.2, ConvexOS, HP-UX 7.0/8.0/9.0, SunOS and many others. Program/Package Cross Reference - (NOT COMPLETELY UP TO DATE) ******************************* Here is a list of what package each GNU program or library is in. You can anonymously FTP a full list in the file `/pub/gnu/ProgramIndex' from a GNU FTP host (*note How to Get GNU Software::. for a list). * a2p perl * a2x xopt * ac bsd44 * accton bsd44 * acl bsd44 * acm acm * acms acm * addftinfo Groff * adventure bsd44 * afm2tfm TeX * amd bsd44 * ansitape bsd44 * AnswerGarden xopt * apply bsd44 * appres xreq * apropos bsd44 * ar Binutils * arithmetic bsd44 * arp bsd44 * atc bsd44 * autoconf Autoconf * autoheader Autoconf * autoreconf Autoconf * autoscan Autoconf * autoupdate Autoconf * auto_box xopt * auto_box xreq * b2m Emacs * backgammon bsd44 * bad144 bsd44 * badsect bsd44 * banner bsd44 * basename Shellutils * bash BASH * battlestar bsd44 * bc bc * bcd bsd44 * bdes bsd44 * bdftops Ghostscript * beach_ball xopt * beach_ball xreq * beach_ball2 xopt * bibtex TeX * biff bsd44 * bison Bison * bitmap xreq * boggle bsd44 * bpltobzr Fontutils * bugfiler bsd44 * build ispell * bzrto Fontutils * c++ GCC * c++filt Binutils * c2ph perl * ca100 xopt * caeser bsd44 * cal bsd44 * calendar bsd44 * canfield bsd44 * cat Textutils * cbars wdiff * cc GCC * cc1 GCC * cc1obj GCC * cc1plus GCC * cccp GCC * charspace Fontutils * checknr bsd44 * chess bsd44 * chflags bsd44 * chgrp Fileutils * ching bsd44 * chmod Fileutils * chown Fileutils * chpass bsd44 * chroot bsd44 * ci RCS * cksum Textutils * clisp CLISP * clri bsd44 * cmail xboard * cmmf TeX * cmodext xopt * cmp Diffutils * co RCS * col bsd44 * colcrt bsd44 * colrm bsd44 * column bsd44 * comm Textutils * compress bsd44 * comsat bsd44 * connectd bsd44 * cp Fileutils * cpicker xopt * cpio cpio * cpp GCC * cppstdin perl * cribbage bsd44 * crock xopt * csh bsd44 * csplit Textutils * ctags Emacs * ctwm xopt * cu UUCP * cut Textutils * cvs CVS * cvscheck CVS * cvtmail Emacs * cxterm xopt * d Fileutils * date Shellutils * dc bc * dd Fileutils * delatex TeX * demangle Binutils * descend CVS * detex TeX * df Fileutils * diff Diffutils * diff3 Diffutils * digest-doc Emacs * dipress bsd44 * dir Fileutils * dirname Shellutils * dish xopt * disklabel bsd44 * diskpart bsd44 * dld dld * dm bsd44 * dmesg bsd44 * doschk doschk * dox xopt * du Fileutils * dump bsd44 * dumpfs bsd44 * dvi2tty TeX * dvicopy TeX * dvips TeX * dvitype TeX * ecc ecc * echo Shellutils * ed ed * edit-pr GNATS * editres xreq * edquota bsd44 * eeprom bsd44 * egrep grep * emacs Emacs * emacsclient Emacs * emacsserver Emacs * emacstool Emacs * emu xopt * env Shellutils * eqn Groff * error bsd44 * es es * esdebug es * etags Emacs * ex nvi * expand Textutils * expect DejaGnu * expr Shellutils * exterm xopt * f2c f2c * factor bsd44 * fakemail Emacs * false Shellutils * fastboot bsd44 * fax2ps HylaFAX * faxalter HylaFAX * faxanswer HylaFAX * faxcover HylaFAX * faxd HylaFAX * faxd.recv HylaFAX * faxmail HylaFAX * faxquit HylaFAX * faxrcvd HylaFAX * faxrm HylaFAX * faxstat HylaFAX * fc f2c * fdraw xopt * fgrep grep * file bsd44 * find Findutils * find2perl perl * finger finger * fingerd finger * fish bsd44 * fixfonts Texinfo * fixinc.svr4 GCC * fixincludes GCC * flex flex * fmt bsd44 * fold Textutils * font2c Ghostscript * fontconvert Fontutils * forth Tile Forth * forthicon Tile Forth * forthtool Tile Forth * fortune bsd44 * fpr bsd44 * freq ispell * freqtbl ispell * from bsd44 * fsck bsd44 * fsplit bsd44 * fstat bsd44 * ftp bsd44 * ftpd bsd44 * g++ GCC * gas Binutils * gawk Gawk * gcc GCC * gcore bsd44 * gdb GDB * genclass libg++ * getty bsd44 * gftodvi TeX * gftopk TeX * gftype TeX * ghostview Ghostview * gnats GNATS * gnuchess Chess * gnuchessc Chess * gnuchessn Chess * gnuchessr Chess * gnuchessx Chess * gnupdisp Shogi * gnuplot gnuplot * gnuplot_x11 gnuplot * gnushogi Shogi * gnushogir Shogi * gnushogix Shogi * go GnuGo * gpc xopt * gpc xreq * gperf gperf * gperf libg++ * gprof Binutils * graph Graphics * grep grep * grodvi Groff * groff Groff * grops Groff * grotty Groff * groups Shellutils * gs Ghostscript * gsbj Ghostscript * gsdj Ghostscript * gslj Ghostscript * gslp Ghostscript * gsnd Ghostscript * gsrenderfont Fontutils * gunzip gzip * gwm xopt * gzexe gzip * gzip gzip * h2ph perl * h2pl perl * hack bsd44 * hangman bsd44 * head Textutils * hello hello * hexdump bsd44 * hexl Emacs * hostname Shellutils * hp2xx hp2xx * hterm xopt * i18nOlwmV2 xopt * i2mif xopt * ico xopt * ico xreq * id Shellutils * ident RCS * ifconfig bsd44 * ifnames Autoconf * ImageMagick xopt * imageto Fontutils * iman xopt * imgrotate Fontutils * indent indent * indxbib Groff * inetd bsd44 * info Texinfo * inimf TeX * init bsd44 * initex TeX * inn bsd44 * install Fileutils * iostat bsd44 * ispell ispell * ixterm xopt * ixx xopt * join Textutils * jot bsd44 * jove bsd44 * kdestroy bsd44 * kdump bsd44 * kermit bsd44 * kgames xopt * kgmon bsd44 * kill bsd44 * kinit bsd44 * kinput2 xopt * klist bsd44 * kpasswdd bsd44 * ksrvtgt bsd44 * kterm xopt * ktrace bsd44 * lam bsd44 * larn bsd44 * lasergnu gnuplot * last bsd44 * lastcomm bsd44 * latex TeX * lclock xopt * ld Binutils * leave bsd44 * less less * lesskey less * libbfd.a Binutils * libbfd.a GAS * libbfd.a GDB * libbzr.a Fontutils * libc.a C Library * libcompat.a bsd44 * libcurses.a bsd44 * libcurses.a nvi * libedit.a bsd44 * libF77.a f2c * libg++.a libg++ * libgdbm.a gdbm * libgf.a Fontutils * libgmp.a gmp * libI77.a f2c * libkvm.a bsd44 * libm.a bsd44 * libnihcl.a NIHCL * libnihclmi.a NIHCL * libnihclvec.a NIHCL * libnls.a xreq * liboctave.a Octave * liboldX.a xreq * libpbm.a Fontutils * libPEXt.a xopt * libpk.a Fontutils * libresolv.a bsd44 * librpc.a bsd44 * libtcl.a DejaGnu * libtelnet.a bsd44 * libterm.a bsd44 * libtermcap.a Termcap * libtfm.a Fontutils * libutil.a bsd44 * libWc.a xopt * libwidgets.a Fontutils * libX.a xreq * libXau.a xreq * libXaw.a xreq * libXcp.a xopt * libXcu.a xopt * libXdmcp.a xreq * libXmp.a xopt * libXmu.a xreq * libXO.a xopt * libXop.a xopt * libXp.a xopt * libXpex.a xopt * libXt.a xopt * libXt.a xreq * libXwchar.a xopt * liby.a bsd44 * libYgl.a Ygl * limn Fontutils * listres xopt * listres xreq * lkbib Groff * ln Fileutils * locate Findutils * lock bsd44 * logger bsd44 * login bsd44 * logname Shellutils * look ispell * lookbib Groff * lorder bsd44 * lpr bsd44 * ls Fileutils * m4 m4 * mail bsd44 * make Make * make-docfile Emacs * make-path Emacs * makeindex TeX * makeinfo Texinfo * MakeTeXPK TeX * man bsd44 * man-macros Groff * mattrib mtools * maze xopt * maze xreq * mazewar xopt * mcd mtools * mcopy mtools * mdel mtools * mdir mtools * me-macros Groff * merge RCS * mesg bsd44 * mf TeX * mformat mtools * mft TeX * mgdiff xopt * mh bsd44 * mille bsd44 * mkdep bsd44 * mkdir Fileutils * mkfifo Fileutils * mklocale bsd44 * mkmanifest mtools * mkmf bsd44 * mkmodules CVS * mknod Fileutils * mkstr bsd44 * mlabel mtools * mm-macros Groff * mmd mtools * monop bsd44 * more bsd44 * morse bsd44 * mount bsd44 * mountd bsd44 * movemail Emacs * mprof bsd44 * mrd mtools * mread mtools * mren mtools * ms-macros Groff * msgs bsd44 * mt cpio * mterm xopt * mtree bsd44 * mtype mtools * mule MULE * muncher xopt * mv Fileutils * mvdir Fileutils * mwrite mtools * nethack Nethack * netstat bsd44 * newfs bsd44 * nfsd bsd44 * nfsiod bsd44 * nfsstat bsd44 * nice Shellutils * nl Textutils * nlmconv Binutils * nm Binutils * nohup Shellutils * notify HylaFAX * nroff Groff * number bsd44 * objc GCC * objcopy Binutils * objdump Binutils * objective-c GCC * obst-boot OBST * obst-CC OBST * obst-cct OBST * obst-cgc OBST * obst-cmp OBST * obst-cnt OBST * obst-cpcnt OBST * obst-csz OBST * obst-dir OBST * obst-dmp OBST * obst-gen OBST * obst-gsh OBST * obst-init OBST * obst-scp OBST * obst-sil OBST * obst-stf OBST * oclock xreq * octave Octave * od Textutils * oleo Oleo * ora-examples xopt * p2c p2c * pagesize bsd44 * palette xopt * pascal bsd44 * passwd bsd44 * paste Textutils * patch patch * patgen TeX * pathalias bsd44 * pathchk Shellutils * pax bsd44 * pbmplus xopt * perl perl * pfbtops Groff * phantasia bsd44 * pic Groff * pig bsd44 * ping bsd44 * pixedit xopt * pixmap xopt * pktogf TeX * pktype TeX * plaid xopt * plot2fig Graphics * plot2plot Graphics * plot2ps Graphics * plot2tek Graphics * pltotf TeX * pollrcvd HylaFAX * pom bsd44 * pooltype TeX * portmap bsd44 * ppt bsd44 * pr Textutils * pr-addr GNATS * pr-edit GNATS * primes bsd44 * printenv Shellutils * printf Shellutils * protoize GCC * ps bsd44 * ps2ascii Ghostscript * ps2epsi Ghostscript * ps2fax HylaFAX * psbb Groff * pstat bsd44 * psycho xopt * ptx ptx * pubdic+ xopt * puzzle xopt * puzzle xreq * pwd Shellutils * pyramid xopt * query-pr GNATS * quiz bsd44 * quot bsd44 * quota bsd44 * quotacheck bsd44 * quotaon bsd44 * rain bsd44 * random bsd44 * ranlib Binutils * rbootd bsd44 * rc rc * rcp bsd44 * rcs RCS * rcs-to-cvs CVS * rcs2log Emacs * rcsdiff RCS * rcsfreeze RCS * rcsmerge RCS * rdist bsd44 * reboot bsd44 * recode recode * recvstats HylaFAX * refer Groff * renice bsd44 * repquota bsd44 * restore bsd44 * rev bsd44 * rexecd bsd44 * rlog RCS * rlogin bsd44 * rlogind bsd44 * rm Fileutils * rmail bsd44 * rmdir Fileutils * rmt cpio * rmt tar * robots bsd44 * rogue bsd44 * route bsd44 * routed bsd44 * rr xopt * rs bsd44 * rsh bsd44 * rshd bsd44 * runtest DejaGnu * runtest.exp DejaGnu * ruptime bsd44 * rwho bsd44 * rwhod bsd44 * s2p perl * sail bsd44 * savecore bsd44 * sc bsd44 * sccs bsd44 * sccs2rcs CVS * scdisp xopt * screen screen * script bsd44 * scsiformat bsd44 * sctext xopt * sdiff Diffutils * sed sed * send-pr GNATS * sendfax HylaFAX * sendmail bsd44 * sgi2fax HylaFAX * sh bsd44 * shar Sharutils * shinbun xopt * shogi Shogi * showfont xopt * showmount bsd44 * shutdown bsd44 * size Binutils * sj3 xopt * sjxa xopt * slattach bsd44 * sleep Shellutils * sliplogin bsd44 * snake bsd44 * snftobdf xopt * soelim Groff * sort Textutils * sos2obst OBST * spider xopt * split Textutils * startslip bsd44 * stf OBST * strings Binutils * strip Binutils * stty Shellutils * su Shellutils * sum Textutils * superopt Superopt * swapon bsd44 * sync bsd44 * sysctl bsd44 * syslogd bsd44 * systat bsd44 * tac Textutils * tail Textutils * taintperl perl * talk bsd44 * talkd bsd44 * tangle TeX * tar tar * tbl Groff * tcl DejaGnu * tclsh DejaGnu * tcopy bsd44 * tcp Emacs * tee Shellutils * tek2plot Graphics * telnet bsd44 * telnetd bsd44 * test Shellutils * test-g++ DejaGnu * test-tool DejaGnu * tetris bsd44 * tex TeX * tex3patch Texinfo * texi2dvi Texinfo * texindex Texinfo * texspell TeX * textfmt HylaFAX * tfmtodit Groff * tftopl TeX * tftp bsd44 * tftpd bsd44 * tgrind TeX * time time * timed bsd44 * timer Emacs * timex xopt * tip bsd44 * tkpostage xopt * tn3270 bsd44 * touch Fileutils * tput tput * tr Textutils * traceroute bsd44 * transcript HylaFAX * transfig xopt * trek bsd44 * trn3 bsd44 * troff Groff * trpt bsd44 * trsp bsd44 * true Shellutils * tset bsd44 * tsort bsd44 * tty Shellutils * tunefs bsd44 * tvtwm xopt * twm xreq * ul bsd44 * umount bsd44 * uname Shellutils * uncompress gzip * unexpand Textutils * unifdef bsd44 * uniq Textutils * unprotoize GCC * unshar Sharutils * unvis bsd44 * update bsd44 * updatedb Findutils * users Shellutils * uuchk UUCP * uucico UUCP * uuconv UUCP * uucp UUCP * uucpd bsd44 * uudecode Sharutils * uudir UUCP * uuencode Sharutils * uulog UUCP * uuname UUCP * uupick UUCP * uurate UUCP * uusched UUCP * uustat UUCP * uuto UUCP * uux UUCP * uuxqt UUCP * v Fileutils * vacation bsd44 * vandal xopt * vcdiff Emacs * vdir Fileutils * vftovp TeX * vgrind bsd44 * vi nvi * viewres xopt * viewres xreq * vine xopt * vipw bsd44 * virmf TeX * virtex TeX * vis bsd44 * vmstat bsd44 * vptovf TeX * w bsd44 * wakeup Emacs * wall bsd44 * wargames bsd44 * wc Textutils * wdiff wdiff * weave TeX * what bsd44 * whatis bsd44 * whereis bsd44 * who Shellutils * whoami Shellutils * whois bsd44 * window bsd44 * winterp xopt * wish DejaGnu * worm bsd44 * worms bsd44 * write bsd44 * wump bsd44 * x11perf xreq * x2p perl * xalarm xopt * xancur xopt * xargs Findutils * xauth xreq * xbfe Fontutils * xbiff xopt * xbiff xreq * xboard xboard * xboing xopt * xbuffy3 xopt * xcalc xopt * xcalc xreq * xcalendar xopt * xcdplayer xopt * xcell xopt * xclipboard xreq * xclock xreq * xcmdmenu xopt * xcms xopt * xcmsdb xreq * xcmstest xreq * xco xopt * xcolorize xopt * xcolors xopt * xconsole xreq * xcrtca xopt * xdaliclock xopt * xdiary xopt * xditview Groff * xditview xopt * xditview xreq * xdm xreq * xdpyinfo xreq * xdu xopt * xdvi TeX * xdvi xopt * xdvorak xopt * xearth xopt * xed xopt * xedit xopt * xedit xreq * xev xopt * xev xreq * xexit xopt * xeyes xopt * xeyes xreq * xfd xreq * xfed xopt * xfedor xopt * xfeoak xopt * xferstats HylaFAX * xfig xopt * xfontsel xopt * xfontsel xreq * xforecast xopt * xgas xopt * xgas xreq * xgc xopt * xgc xreq * xhearts xopt * xhelp xopt * xhost xreq * xinit xreq * xkeycaps xopt * xkill xreq * xlax xopt * xlayout xopt * xlbiff xopt * xless xopt * xload xopt * xload xreq * xlogin xopt * xlogo xreq * xlsatoms xreq * xlsclients xreq * xlsfonts xreq * xmag xreq * xmail xopt * xmailbox xopt * xmailwatcher xopt * xman xopt * xman xreq * xmandel xopt * xmessage xopt * xmeter xopt * xmh xreq * xmh-icons xopt * xmh.editor xopt * xmodmap xreq * xmon xopt * xmove xopt * xmphone xopt * xpd xopt * xphoon xopt * xpipeman xopt * xplot Graphics * xpostit xopt * xpr xopt * xpr xreq * xprompt xopt * xproof xopt * xprop xreq * xpserv xopt * xrdb xreq * xrefresh xreq * xrsh xopt * xrubik xopt * xrunclient xopt * xscope xopt * xscreensaver xopt * xsession xopt * xset xreq * xsetroot xreq * xshogi xshogi * xstdcmap xreq * xstr bsd44 * xtalk xopt * xterm xreq * xterm_color xopt * xtetris xopt * xTeXcad.13 xopt * xtiff xopt * xtree xopt * xtv xopt * xwd xreq * xwininfo xreq * xwud xreq * yacc bsd44 * yes Shellutils * youbin xopt * yow Emacs * zcat gzip * zcmp gzip * zdiff gzip * zforce gzip * zgrep gzip * zmore gzip * znew gzip * [ Shellutils Tapes ***** We offer Unix source code on tapes in `tar' format on these media: * 4mm DAT cartridges * 8mm Exabyte cartridges * Sun DC300XLP QIC-24 1/4in cartridges (readable on some other systems) * Hewlett-Packard 16-track DC600HC 1/4in cartridges * IBM RS/6000 QIC-150 1/4in cartridges (readable on some other systems) * 1600bpi 9-track 1/2in reel tape The contents of the reel and various cartridge tapes for Unix systems are the same (except for the RS/6000 Emacs tape, which also has executables for Emacs); only the media are different. For pricing information, see the *note Free Software Foundation Order Form::.. Source code for the manuals and reference cards is included (*note Documentation::.). Some of the files on the tapes may be compressed with `gzip' to make them fit. Refer to the top-level `README' file at the beginning of each tape for instructions on uncompressing them. `uncompress' and `unpack' *do not work*! Languages Tape - (VERSION NUMBERS NOT COMPLETELY UP TO DATE) -------------- This tape contains programming tools: compilers, interpreters, and related programs (parsers, conversion programs, debuggers, etc.). * Binutils 2.5.2 * Bison 1.22 * C Library 1.09 * DejaGnu 1.2 * dld 3.2.3 * ecc 1.2.1 * f2c 1994.11.03 * flex 2.4.7 * Gawk 2.15.5 * GCC/G++/Objective-C 2.7.0 * GDB 4.13 * gdbm 1.7.3 * gmp 1.3.2 * gperf 2.1a * gzip 1.2.4 * indent 1.9.1 * libg++ 2.6.1 * libobjects 0.1.0 * Make 3.72.1 * NIHCL 3.0 * OBST 3.4 * Octave 1.0 * p2c 1.20 * perl 4.036 * perl 5.000 * regex 0.12 * rx 0.05 * Smalltalk 1.1.1 * Superopt 2.3 * Texinfo 3.1 * Tile Forth 2.1 Lisps and Emacs Tape - (VERSION NUMBERS NOT COMPLETELY UP TO DATE) -------------------- This tape has Common Lisp systems and libraries, GNU Emacs, assorted extensions that work with GNU Emacs, and a few other important utilities. * Calc 2.02c * CLISP 1994.10.26 * Common Lisp 1.1 * elib 0.06 * Emacs 18.59 * Emacs 19.29 * GNU Emacs Lisp Reference Manaul, Ed. 2.3 * gzip 1.2.4 * Make 3.72.1 * MULE 2.1 * PCL 1993.03.18 * Texinfo 3.1 Utilities Tape - (VERSION NUMBERS NOT COMPLETELY UP TO DATE) -------------- This tape consists mostly of smaller utilities and miscellaneous applications. * acm 4.6 * Autoconf 1.11 * Autoconf 2.1 * BASH 1.14.2 * bc 1.03 * Chess 4.0.73 * cpio 2.3 * CVS 1.3 * dc 0.2 * Diffutils 2.7 * doschk 1.1 * ed 0.2 * es 0.84 * Fileutils 3.12 * Findutils 4.1 * finger 1.37 * HylaFAX 2.2.2.1 * Fontutils 0.6 * Ghostscript 2.6.1 * Ghostview 1.5 * GNATS 3.2 * GnuGo 1.1 * gnuplot 3.5 * Graphics 0.17 * grep 2.0 * Groff 1.09 * gzip 1.2.4 * hello 1.3 * hp2xx 3.1.4 * ispell 3.1.13 * m4 1.3 * Make 3.72.1 * mkisofs 1.01 * mm 1.07 * mtools 2.0.7 * Nethack 3.1.3 * nvi 1.34 * Oleo 1.6 * patch 2.1 * ptx 0.4 * rc 1.4 * RCS 5.6.0.1 * recode 3.4 * saoimage 1.08 * screen 3.5.2 * screen 3.6.0 * sed 1.18 & 2.05 * Sharutils 4.1 * Shellutils 1.12 * Shogi 1.2.02 * tar 1.11.2 * Termcap 1.2 * Texinfo 3.1 * Textutils 1.11 * time 1.6 * tput 1.0 * UUCP 1.05 * wdiff 0.04 * xboard 3.1.1 * xshogi 1.2.02 * Ygl 2.9 Scheme Tape ----------- Scheme is a simplified, lexically-scoped dialect of Lisp. It was designed at MIT and other universities to teach students the art of programming, and to research new parallel programming constructs and compilation techniques. This tape now contains MIT Scheme 7.3, which conforms to the "Revised^4 Report On the Algorithmic Language Scheme" (MIT AI Lab Memo 848b), for which TeX source is included. It is written partly in C, but is presently hard to bootstrap. Binaries that can be used to bootstrap Scheme are available for: * HP 9000 series 300, 400, 700 & 800 running HP-UX 7.0 or 8.0 * NeXT running NeXT OS 1.0 or 2.0 * Sun-3 or Sun-4 running SunOS 4.1 * DECstation 3100/5100 running Ultrix 4.0 * Sony NeWS-3250 running NEWS OS 5.01 * Vax running 4.3BSD If your system is not on this list and you don't enjoy the bootstrap challenge, see the JACAL item in *Note GNU Software::. X11 Tapes --------- The two X11 tapes contain Version 11, Release 6 of the X Window System. The first tape contains all of the core software, documentation and some contributed clients. We call this the "required" X tape since it is necessary for running X or running GNU Emacs under X. The second, "optional" tape contains contributed libraries and other toolkits, the Andrew User Interface System, games, and other programs. The X11 Required tape also contains all fixes and patches released to date. We update this tape as new fixes and patches are released for programs on both tapes. *Note Tape & CD-ROM Subscription Service::. We will distribute X11R5 on tape until X11R6 is stable, and on the *Note November 1993 Source Code CD-ROM::, while supplies last. Berkeley 4.4BSD-Lite Tape ------------------------- The "4.4BSD-Lite" release is the last from the Computer Systems Research Group at the University of California at Berkeley. It has most of the BSD software system, except for a few files that remain proprietary. It is much more complete than the previous "Net2" release. VMS Emacs and VMS Compiler Tapes -------------------------------- We offer two VMS tapes. One has just GNU Emacs 18.59 (none of the other software on the *Note Lisps/Emacs Tape::, is included). The other has GCC 2.3.3, Bison 1.19 (to compile GCC), GAS 1.38 (to assemble GCC's output) and some library and include files (none of the other software on the *Note Languages Tape::, is included). We are not aware of a GDB port for VMS. Both VMS tapes have DEC VAX executables from which you can bootstrap, as the DEC VMS C compiler cannot compile GCC. We do not have executables for DEC Alpha VMS systems. Please do not ask us to devote effort to VMS support, because it is peripheral to the GNU Project. CD-ROMs ******* We offer these CD-ROMs: * *Note MS-DOS CD-ROM::, expected in September 1995. * *Note Debian GNU/Linux CD-ROM::, expected in late fall 1995. * *Note Compiler Tools Binaries CD-ROM::. * *Note June 1995 Source Code CD-ROM::. * *Note May 1994 Source Code CD-ROM::. * *Note November 1993 Source Code CD-ROM::. Our CD-ROMs are in ISO 9660 format & can be mounted as a read-only file system on most computers. If your driver supports it you can mount each CD-ROM with "Rock Ridge" extensions (the MS-DOS CD-ROM is only in ISO 9660 format) & it will look just like an ordinary Unix file system, rather than one full of truncated & otherwise mangled names that fit vanilla ISO 9660. You can build most of the software without copying the sources off the CD. You only need enough disk space for object files and intermediate build targets. Pricing of the GNU CD-ROMs -------------------------- If a business or organization is ultimately paying, the June 1995 Source CD costs $240. It costs $60 if you, an individual, are paying out of your own pocket. The December 1994 Compiler Tools Binaries CD-ROM costs $220 for a business or organization, and $55 for an individual. What do the individual and company prices mean? The software on our disk is free; anyone can copy it and anyone can run it. What we charge for is the physical disk and the service of distribution. We charge two different prices depending on who is buying. When a company or other organization buys the June 1995 Source CD-ROM, we charge $240. When an individual buys the same disk, we charge just $60. This distinction is not a matter of who is allowed to use the software. In either case, once you have a copy, you can distribute as many copies as you wish, and there's no restriction on who can have or run them. The price distinction is entirely a matter of what kind of entity pays for the CD. You, the reader, are certainly an individual, not a company. If you are buying a disk "in person", then you are probably doing so as an individual. But if you expect to be reimbursed by your employer, then the disk is really for the company; so please pay the company price and get reimbursed for it. We won't try to check up on you--we use the honor system--so please cooperate. Buying CDs at the company price is very helpful for GNU; just 140 Source CDs at that price supports an FSF programmer or tech writer for a year. Why is there an individual price? In the past, our distribution tapes have been ordered mainly by companies. The CD at the price of $240 provides them with all of our software for a much lower price than they would previously have paid for six different tapes. To lower the price more would cut into the FSF's funds very badly, and decrease the software development we can do. However, for individuals, $240 is too high a price; hardly anyone could afford that. So we decided to make CDs available to individuals at the lower price of $60. Is there a maximum price? Our stated prices are minimum prices. Feel free to pay a higher price if you wish to support GNU development more. The sky's the limit; we will accept as high a price as you can offer. Or simply give a donation (tax-deductible in the U.S.) to the Free Software Foundation, a tax-exempt public charity. MS-DOS CD-ROM ------------- We expect to release our first CD-ROM for MS-DOS in September, 1995. Contact either address on page 1 for more information at that time. The MS-DOS CD will be packaged inside a book describing its contents. It will have all the sources and executables on the MS-DOS Diskettes. For details and version numbers, *note MS-DOS Diskettes::.. Debian GNU/Linux CD-ROM ----------------------- The FSF expects to ship a CD-ROM with Debian GNU/Linux on it in the late fall 1995. This CD will be packaged inside a book describing its contents. m{No Value For "ergegrafkludge"} Debian GNU/Linux is a complete operating system for x86 machines, available in both source code and binary form. It is a GNU/Linux system--that is to say, a variant GNU system which uses Linux as the kernel. (All the systems now available which use the Linux kernel are GNU/Linux systems.) Debian is being developed by Ian Murdock and the Debian Association in conjunction with the Free Software Foundation. We are distributing it as an interim measure until the GNU kernel (the Hurd) is ready for users. Debian GNU/Linux is available for FTP at `ftp.cps.cmich.edu' in file `/pub/debian'. For more information about the Debian Project and how to get involved, see `/pub/gnu/GNUinfo/DEBIAN' on a GNU FTP host (*note How to Get GNU Software::. for a list). December 1994 Compiler Tools Binaries CD-ROM -------------------------------------------- We are now offering a CD-ROM that contains executables for GNU compiler tools for some systems which lack a compiler. This enables the people who use these systems to compile GNU and other free software without having to buy a proprietary compiler. You can also use the GNU compilation system to compile your own C/C++/Objective-C programs. We hope to have more systems on each update of this CD. If you can help build binaries for new systems (especially those that don't come with a C compiler), or have one to suggest, please contact us at the addresses on page 1. These packages: *DJGPP 1.12.m2 from GCC 2.6.0 *GCC/G++/Objective-C 2.6.2 *GNU C Library 1.09 *GDB 4.13 *Binutils 2.5.2 *Bison 1.22 *Emacs 19.26 (MS-DOS only) *Flex 2.4.7 *Make 3.72.1 *libg++ 2.6.1 On these platforms: *`i386-msdos' *`hppa1.1-hp-hpux9' *`sparc-sun-solaris2' *`sparc-sun-sunos4.1' Source Code CD-ROMs ------------------- We have several versions of our Source Code CD-ROMs available: * *Note June 1995 Source Code CD-ROM::. * *Note May 1994 Source Code CD-ROM::. * *Note November 1993 Source Code CD-ROM::. The older Source Code CDs will be available while supplies last at a reduced price; see the *note Free Software Foundation Order Form::.. All of the Source Code CDs also contain Texinfo source for the GNU manuals listed in *Note Documentation::. The VMS tapes' contents are *not* included. Many programs that are only on MS-DOS diskettes and not on the tapes are also *not* included. The contents of the MIT Scheme & X11 Optional tapes are *not* on the November 1993 & May 1994 Source CDs. *Note Tapes:: & *Note MS-DOS Diskettes::. There are no precompiled programs on these Source CDs. You will need a C compiler (programs which need some other interpreter or compiler normally provide the C source for a bootstrapping program). We ship C compiler binaries for some systems on the *Note Compiler Tools Binaries CD-ROM::. June 1995 Source Code CD-ROM - (VERSION NUMBERS NOT COMPLETELY UP TO DATE) ............................ We now have the sixth edition of our Source CD. This CD has Edition X.X for version 19 of the `GNU Emacs Lisp Reference Manual' & some additional software; not all FSF distributed software is included (*note Source Code CD-ROMs::.). It contains the following packages: *XXXXX UPDATE THIS LIST XXXXX* *acm 4.5 *Autoconf 1.10 *BASH 1.13.5 *bc 1.02 *Binutils 2.3 *Bison 1.22 *C Library 1.08 *Calc 2.02c *Chess 4.0.69 *CLISP 1994.01.08 *Common Lisp 1.0 *cpio 2.3 *CVS 1.3 *dc 0.2 *DejaGnu 1.2 *Diffutils 2.6 *dld 3.2.3 *doschk 1.1 *ecc 1.2.1 *ed 0.1 *elib 0.06 *Emacs 18.59 *Emacs 19.23 *es 0.84 *f2c 1994.04.14 *Fileutils 3.9 *find 3.8 *finger 1.37 *flex 2.4.6 *Fontutils 0.6 *GAS 1.36.utah *GAS 2.2 *Gawk 2.15.4 *GCC 2.5.8 *GDB 4.12 *gdbm 1.7.1 *Ghostscript 2.6.1 *Ghostview 1.5 *Ghostview for Windows 1.0 *gmp 1.3.2 *GNATS 3.2 *GnuGo 1.1 *gnuplot 3.5 *gperf 2.1a *Graphics 0.17 *grep 2.0 *Groff 1.09 *gzip 1.2.4 *hello 1.3 *hp2xx 3.1.4 *indent 1.9.1 *ispell 4.0 *libg++ 2.5.3 *m4 1.1 *Make 3.71 *MandelSpawn 0.07 *mtools 2.0.7 *MULE 1.0 *NetFax 3.2.1 *Nethack 3.1.3 *NIHCL 3.0 *nvi 1.11 *Octave 1.0 *Oleo 1.5 *p2c 1.20 *patch 2.1 *PCL 1993.03.18 *perl 4.036 *ptx 0.3 *rc 1.4 *RCS 5.6.0.1 *recode 3.3 *regex 0.12 *screen 3.5.2 *sed 2.05 *shellutils 1.9.4 *Shogi 1.1.02 *Smalltalk 1.1.1 *Superopt 2.3 *tar 1.11.2 *Termcap 1.2 *TeX 3.1 *Texinfo 3.1 *Textutils 1.9.1 *Tile Forth 2.1 *time 1.6 *tput 1.0 *UUCP 1.05 *uuencode 1.0 *wdiff 0.04 *X11R6 *xboard 3.0.9 *xshogi 1.2.02 May 1994 Source Code CD-ROM ........................... We still have the fourth edition of our Source CD, at a reduced price. This CD has Edition 2.3 for version 19 of the `GNU Emacs Lisp Reference Manual' & some additional software; not all FSF distributed software is included (*note Source Code CD-ROMs::.). It contains these packages: *acm 4.5 *Autoconf 1.10 *BASH 1.13.5 *bc 1.02 *Binutils 2.3 *Bison 1.22 *C Library 1.08 *Calc 2.02c *Chess 4.0.69 *CLISP 1994.01.08 *Common Lisp 1.0 *cpio 2.3 *CVS 1.3 *dc 0.2 *DejaGnu 1.2 *Diffutils 2.6 *dld 3.2.3 *doschk 1.1 *ecc 1.2.1 *ed 0.1 *elib 0.06 *Emacs 18.59 *Emacs 19.23 *es 0.84 *f2c 1994.04.14 *Fileutils 3.9 *find 3.8 *finger 1.37 *flex 2.4.6 *Fontutils 0.6 *GAS 1.36.utah *GAS 2.2 *Gawk 2.15.4 *GCC 2.5.8 *GDB 4.12 *gdbm 1.7.1 *Ghostscript 2.6.1 *Ghostview 1.5 *Ghostview for Windows 1.0 *gmp 1.3.2 *GNATS 3.2 *GnuGo 1.1 *gnuplot 3.5 *gperf 2.1a *Graphics 0.17 *grep 2.0 *Groff 1.09 *gzip 1.2.4 *hello 1.3 *hp2xx 3.1.4 *indent 1.9.1 *ispell 4.0 *libg++ 2.5.3 *m4 1.1 *Make 3.71 *MandelSpawn 0.07 *mtools 2.0.7 *MULE 1.0 *NetFax 3.2.1 *Nethack 3.1.3 *NIHCL 3.0 *nvi 1.11 *Octave 1.0 *Oleo 1.5 *p2c 1.20 *patch 2.1 *PCL 1993.03.18 *perl 4.036 *ptx 0.3 *rc 1.4 *RCS 5.6.0.1 *recode 3.3 *regex 0.12 *screen 3.5.2 *sed 2.05 *shellutils 1.9.4 *Shogi 1.1.02 *Smalltalk 1.1.1 *Superopt 2.3 *tar 1.11.2 *Termcap 1.2 *TeX 3.1 *Texinfo 3.1 *Textutils 1.9.1 *Tile Forth 2.1 *time 1.6 *tput 1.0 *UUCP 1.05 *uuencode 1.0 *wdiff 0.04 *X11R6 *xboard 3.0.9 *xshogi 1.2.02 November 1993 Source Code CD-ROM ................................ We still have the third edition of our Source CD, at a reduced price. It contains X11R5, as we feel that people should have a choice between X11R5 and X11R6 until the latter is stable. This CD has Edition 2.2 for version 19 of the `GNU Emacs Lisp Reference Manual' & some additional software; not all FSF distributed software is included (*note Source Code CD-ROMs::.). It contains the following packages: *acm 3.1 *Autoconf 1.7 *BASH 1.13.4 *bc 1.02 *Binutils 1.9 2.3 *Bison 1.22 *C Library 1.06.7 *Calc 2.02b *Chess 4.0p62 *CLISP 93.11.08 *cpio 2.3 *CVS 1.3 *dc 0.2 *DejaGnu 1.0.1 *Diffutils 2.6 *dld 3.2.3 *doschk 1.1 *ecc 1.2.1 *elib 0.06 *Emacs 18.59 *Emacs 19.21 *es 0.84 *f2c 1993.04.28 *Fileutils 3.9 *find 3.8 *finger 1.37 *flex 2.3.8 *Fontutils 0.6 *GAS 1.36.utah *GAS 1.38.1 *GAS 2.2 *Gawk 2.15.3 *GCC 2.5.4 *GDB 4.11 *gdbm 1.7.1 *Ghostscript 2.6.1 *Ghostview 1.5 *Ghostview for Windows 1.0 *gmp 1.3.2 *GNATS 3.01 *GnuGo 1.1 *gnuplot 3.5 *gperf 2.1a *Graphics 0.17 *grep 2.0 *Groff 1.08 *gzip 1.2.4 *hello 1.3 *hp2xx 3.1.3a *indent 1.8 *Ispell 4.0 *less 177 *libg++ 2.5.1 *m4 1.1 *Make 3.69.1 *MandelSpawn 0.06 *mtools 2.0.7 *MULE 1.0 *NetFax 3.2.1 *Nethack 3.1.3 *NIHCL 3.0 *Oleo 1.5 *p2c 1.20 *patch 2.1 *PCL 93.03.18 *perl 4.036 *ptx 0.3 *rc 1.4 *RCS 5.6.0.1 *recode 3.2.4 *regex 0.12 *screen 3.5.2 *sed 1.18 2.03 *Shellutils 1.9.1 *Shogi 1.1p02 *Smalltalk 1.1.1 *Superopt 2.3 *tar 1.11.2 *Termcap 1.2 *TeX 3.1 *Texinfo 3.1 *Tile Forth 2.1 *time 1.6 *time 1.6 *tput 1.0 *UUCP 1.04 *uuencode 1.0 *wdiff 0.04 *X11R5 MS-DOS Diskettes **************** The FSF distributes some of the GNU software ported to MS-DOS, on 3.5inch 1.44MB diskettes. These disks have both sources and executables. DJGPP Diskettes - (VERSION NUMBERS NOT COMPLETELY UP TO DATE) --------------- We offer DJGPP on 30 diskettes. For further details, see *Note GNU Software::. The DJGPP diskettes contain the following: * bc 1.03 * Binutils 2.4 * Bison 1.22 * cpio 2.3 * Diffutils 2.6 * doschk 1.1 * Fileutils 3.9 * Findutils 3.8 * GAS 2.4 * Gawk 2.15.5 * GCC 2.6.0 * GDB 4.12 * Ghostscript 2.6.1 * Ghostview for Windows 1.0 * Groff 1.09 * gzip 1.24 * hello 1.3 * indent 1.9 * ispell 4.0 * m4 1.2 * Make 3.71 * patch 2.1 * sed 1.18 * shellutils 1.9 * Texinfo 3.1 * texutils 1.9 * wdiff 0.04 Emacs Diskettes - (VERSION NUMBERS NOT COMPLETELY UP TO DATE) --------------- Two versions of GNU Emacs are included on the Emacs diskettes we distribute: GNU Emacs version 19.29 handles 8-bit character sets; the other, MULE version 2.1, handles 16-bit character sets including Kanji. Selected Utilities Diskettes - (NOT COMPLETELY UP TO DATE) ---------------------------- The GNUish MS-DOS Project ported GNU software to PC compatibles. Though the GNUish Project is no longer active, users still ask for these ports that were done several years ago. You can anonymous FTP files `/pub/gnu/MicrosPorts/MSDOS*' from `prep.ai.mit.edu' to find out how to access these ports over the Internet. We offer these programs on five diskettes. In general, this software will run on 8086 and 80286-based 16-bit machines; an 80386 is not required. Some of these utilities are necessarily missing features. Included are: `cpio', `diff', `find', `flex', `gdbm', `grep', `indent', `less', `m4', `make', `ptx', RCS, `sed', `shar', `sort', & Texinfo. Windows Diskette ---------------- We offer GNU Chess and `gnuplot' for Microsoft Windows on a single diskette. Tape & CD-ROM Subscription Service ********************************** If you do not have net access, our subscription service enables you to stay current with the latest GNU developments. For a one-time cost equivalent to three tapes or CD-ROMs (plus shipping in some cases), we will ship you four new versions of the tape of your choice or the Source Code CD-ROM. The tapes are sent each quarter; the CD-ROMs are sent as they are issued (which is between two and four times a year.) Regularly, we will send you a new version of an Lisps/Emacs, Languages, Utilities, or X Window System (X11R6) Required tape or the Source CD-ROM. The MIT Scheme and X Window System Optional tapes are not changed often enough to warrant quarterly updates. We do not yet know if we will be offering subscriptions to the Compiler Tools Binaries or our new CD-ROMs. Since Emacs 19 is on the Lisps/Emacs Tape and the Source CD-ROM, a subscription to either is an easy way to keep current with Emacs 19 as it evolves. A subscription is an easy way to keep up with the regular bug fixes to the X Window System. We update the X11R6 Required tape as fixes and patches are issued throughout the year. Each new edition of the *Note Source Code CD-ROMs::, also has updated sources for the X Window System. Please note: In two cases, you must pay 4 times the normal shipping required for a single order when you pay for each subscription. If you're in Alaska, Hawaii, or Puerto Rico you must add $20.00 for shipping for each subscription. If you're outside of U.S., Canada, and Puerto Rico, you have to add $80.00 for each subscription. See "Unix and VMS Software" & "Shipping Instructions" on the *note Free Software Foundation Order Form::.. The Deluxe Distribution *********************** The Free Software Foundation has been asked repeatedly to create a package that provides executables for all of our software. Normally we offer only sources. In addition to providing binaries with the source code, the Deluxe Distribution includes a complete set of our printed manuals and reference cards. The FSF Deluxe Distribution contains the binaries and sources to hundreds of different programs including GNU Emacs, the GNU C Compiler, the GNU Debugger, the complete X Window System, and all the GNU utilities. We will make a Deluxe Distribution for any machine, with any operating system. We will send someone to your office to do the compilation, if we can't find a suitable machine close to us! However, we can only compile the programs that already support your chosen machine and system - porting is a separate matter (if you wish to commission a port, see the GNU Service Directory, details in *Note Free Software Support::). Compiling all these programs take time; a Deluxe Distribution for an unusual machine will take longer to produce then one for a common machine. Please contact the FSF office if you have any questions. We supply the software in one of these tape formats in Unix `tar' format: 1600 or 6250bpi 1/2in reel, Sun DC300XLP 1/4in cartridge - QIC24, Hewlett-Packard 16-track DC600HC 1/4in cartridge, IBM RS/6000 1/4in cartridge - QIC 150, Exabyte 8mm cartridge, or DAT 4mm cartridge. If your computer cannot read any of these, please contact us to see if we can handle your format. The manuals included are one each of the `Bison', `Calc', `Gawk', `GNU C Compiler', `GNU C Library', `GDB', `Flex', `GNU Emacs Lisp Reference', `Programming in Emacs Lisp: An Introduction', `Make', `Texinfo', & `Termcap' manuals; six copies of the `GNU Emacs' manual; and a packet of ten reference cards each for GNU Emacs, Bison, Calc, Flex, & GDB. Every Deluxe Distribution also includes a copy of the latest editions of our CD-ROMs (including the MS-DOS CD & the Debian GNU/Linux CD when they are available) that contain sources of our software & compiler tool binaries for some systems. The MS-DOS CD is in ISO 9660 format. The other CDs are in ISO 9660 format with Rock Ridge extensions. The price of the Deluxe Distribution is $5000 (shipping included). These sales provide enormous financial assistance to help the FSF develop more free software. To order, please fill out the "Deluxe Distribution" section on the *note Free Software Foundation Order Form::. and send it to: Free Software Foundation, Inc. 59 Temple Place -- Suite 330 Boston, MA 02111--1307 USA Telephone: +1-617-542-5942 Fax (including Japan): +1-617-542-2652 Free Dial Fax (in Japan): 0031-13-2473 (KDD) 0066-3382-0158 (IDC) Electronic mail: gnu@prep.ai.mit.edu FSF T-shirt *********** Our latest T-shirt has artwork by Berkeley, CA artist Etienne Suvasa. The front has the ever-popular picture of GNArnold from the `Flex Manual', while the back has the Preamble to the GNU General Public License. They are available in two colors, Natural & Black. Natural is an off-white, unbleached, undyed, environment-friendly cotton, printed with black ink, & is great for tye-dyeing or displaying as is. Black is printed with white ink & is perfect for late night hacking. All shirts are thick 100% cotton, & are available in sizes M, L, XL & XXL. This shirt makes a great gift for your favorite hacker! The previous version of the T-shirt will be available while supplies last, but please contact the FSF to see if we have what you would like before ordering. Free Software Foundation Order Form *********************************** All items are distributed with permission to copy and to redistribute. Texinfo source for each manual and source for each reference card is on the appropriate tape, diskette, or CD-ROM; the prices for these magnetic media do not include printed documentation. All items are provided on an ``as is'' basis, with no warranty of any kind. Please allow six weeks for delivery (though it won't usually take that long). PRICE AND CONTENTS MAY CHANGE WITHOUT NOTICE AFTER January 31, 1996. Unix and VMS Software --------------------- These tapes in the formats indicated (*note Tapes::., for contents): Please circle the dollar amount for each tape you order. Reel to Sun (1) HP IBM (2) Exabyte DAT reel RS/6000 Unix tar Unix tar Unix tar Unix tar Unix tar Unix tar 9-track QIC-24 16-track QIC-150 1600 bpi DC300XLP DC600HC DC600A 1/2" reel 1/4" c.t. 1/4" c.t. 1/4" c.t. 8mm c.t. 4mm c.t. (c.t. = cartridge tape) Lisps/Emacs $200 $210 $230 $215 (3) $205 $225 Languages $200 $210 $230 $215 $205 $225 Utilities $200 $210 $230 $215 $205 $225 4.4BSD-Lite $200 $210 $230 $215 $205 $225 Scheme $200 $210 $230 $215 $205 $225 X11R5-Required $200 $210 $230 $215 $205 $225 X11R5-Optional $200 $210 $230 $215 $205 $225 X11R6-Required $200 $210 $230 $215 $205 $225 X11R6-Optional $200 $210 $230 $215 $205 $225 (1) Sun tapes can be read on some other Unix systems. (2) IBM RS/6000 tapes can be read on some other Unix systems. (3) The IBM Emacs tape also has binaries for GNU Emacs. Subscriptions, 4 updates for one year (*note Tape & CD-ROM Subscription Service::.): Emacs $600 $630 $690 $645 $615 $675 Languages $600 $630 $690 $645 $615 $675 Utilities $600 $630 $690 $645 $615 $675 X11R6-Required $600 $630 $690 $645 $615 $675 Subtotal $ ______ Please put total of the above circled amounts here. These 1600 bpi reel-to-reel 9 track 1/2" tapes, in VMS BACKUP format (aka interchange format) (*note VMS Emacs and VMS Compiler Tapes::.): ____ @ $195 = $ ______ VMS Emacs, GNU Emacs source & executables only. ____ @ $195 = $ ______ VMS Compiler, GCC, GAS, and Bison source and executables only. FSF Deluxe Distribution (*note Deluxe Distribution::.): ...................................................... ____ @ $5000 = $ ______ The Deluxe Distribution, with manuals, etc. Machine: _____________________________________________________________________ Operating system: ____________________________________________________________ Media type: __________________________________________________________________ CD-ROMs, in ISO 9660 format (*note CD-ROMs::.): .............................................. GNU Source Code CD-ROM, Version 6 with X11R6 (*note June 1995 Source Code CD-ROM::.): ____ @ $240 = $ ______ for corporations and other organizations. ____ @ $ 60 = $ ______ for individuals. GNU Compiler Tools Binaries CD-ROM, Version 2, December 1994 Edition (*note Compiler Tools Binaries CD-ROM::.): ____ @ $220 = $ ______ for corporations and other organizations. ____ @ $55 = $ ______ for individuals. Debian GNU/Linux Book with CD-ROM - expected late fall 1995 (*note Debian GNU/Linux CD-ROM::.): ____ @ $200 = $ ______ for corporations and other organizations. ____ @ $50 = $ ______ for individuals. Subscriptions, next 4 updates, of the Source Code CD-ROM, in ISO 9660 format (*note Tape & CD-ROM Subscription Service::.): ____ @ $720 = $ ______ for corporations and other organizations. ____ @ $180 = $ ______ for individuals. MS-DOS Software --------------- MS-DOS Book with CD-ROM - expected September 1995 (*note MS-DOS CD-ROM::.): ____ @ $180 = $ ______ for corporations and other organizations. ____ @ $45 = $ ______ for individuals. The following sources and executables for MS-DOS, on 3.5" 1.44MB diskettes (*note MS-DOS Diskettes::.): ____ @ $ 90 = $ ______ Emacs diskettes, GNU Emacs, for 80386 and up. ____ @ $ 80 = $ ______ DJGPP diskettes, GCC version 2, for 80386 and up (also on the *note Compiler Tools Binaries CD-ROM::. and *note MS-DOS CD-ROM::..) ____ @ $ 85 = $ ______ Selected Utilities diskettes, 8086 and up. ____ @ $ 40 = $ ______ Windows diskette, GNU Chess and gnuplot for Microsoft Windows. Manuals ------- These manuals (*note Documentation::.). Please call for bulk purchase discounts. ____ @ $300 = $ ______ One copy each of the following 13 manuals. ____ @ $ 25 = $ ______ GNU Emacs version manual, with a reference card. ____ @ $ 50 = $ ______ GNU Emacs Lisp Reference manual, in two volumes. ____ @ $ 50 = $ ______ Using and Porting GNU CC. ____ @ $ 50 = $ ______ GNU C Library Reference Manual. ____ @ $ 50 = $ ______ GNU Emacs Calc manual, with a reference card. ____ @ $ 20 = $ ______ Programming in Emacs Lisp, An Introduction ____ @ $ 20 = $ ______ Debugging with GDB, with a reference card. ____ @ $ 20 = $ ______ Gawk manual. ____ @ $ 20 = $ ______ Make manual. ____ @ $ 20 = $ ______ Bison manual, with a reference card. ____ @ $ 20 = $ ______ Flex manual, with a reference card. ____ @ $ 20 = $ ______ Texinfo manual. ____ @ $ 15 = $ ______ Termcap manual. Reference Cards --------------- The following reference cards, in packets of ten. For single copies please call. ____ @ $ 10 = $ ______ GNU Emacs version 19 reference cards. ____ @ $ 10 = $ ______ GNU Emacs Calc reference cards. ____ @ $ 10 = $ ______ GDB reference cards. ____ @ $ 10 = $ ______ Bison reference cards. ____ @ $ 10 = $ ______ Flex reference cards. T-shirts -------- GNU/FSF T-shirts, thick 100% cotton (*note FSF T-shirt::.): ____ @ $ 15 = $ ______ Size M ____ natural ____ black. ____ @ $ 15 = $ ______ Size L ____ natural ____ black. ____ @ $ 15 = $ ______ Size XL ____ natural ____ black. ____ @ $ 15 = $ ______ Size XXL ____ natural ____ black. Older Items ----------- Older items are only available while supplies last. ____ @ $ 5 = $ ______ GNU Emacs version 18 reference cards, in packets of ten. Please fill in the number of each older CD-ROM you order: for for corporations individuals: and other organizations: GNU Compiler Tools Binaries CD-ROM December 1993 Edition (Version 1) ____________ ____________ GNU Source Code CD-ROM May 1994 edition with X11R6 ____________ ____________ GNU Source Code CD-ROM November 1993 edition with X11R5 ____________ ____________ GNU Source Code CD-ROM May 1993 edition with X11R5 ____________ ____________ GNU Source Code CD-ROM October 1992 edition with X11R5 ____________ ____________ Please put the total count and cost of the above older CD-ROMs here: ____ @ $ 80 = $ ______ for corporations and other organizations. ____ @ $ 20 = $ ______ for individuals. ====== Subtotal $ ______ Tax and Shipping Costs ---------------------- + $ ______ In Massachusetts: add 5% sales tax, or give tax exempt number. + $ ______ In Alaska, Hawaii, or Puerto Rico for shipping: for GNU Emacs Lisp Reference and GNU Emacs Calc manuals, add $5 *each*. For *each* tape or CD-ROM subscription, add $20. For all other items, add $5 base charge, then $1 per item except reference cards; i.e., shipping for all other items = $5 + ($1 * i). + $ ______ Outside of U.S., Canada, and Puerto Rico for shipping: Add $20 base charge; then add $80 more for *each* tape or CD-ROM subscription; and then add $10 more for *each* manual in the order; i.e., shipping for all other items = $20 + ($80 * s) + ($10 * m). + $ ______ Optional (tax-deductible in the U.S.) donation. ------ We suggest 5% if paying by credit card. TOTAL $ ______ We pay for shipping via UPS ground transportation in the contiguous 48 states and Canada. For very large orders, ask about actual shipping costs for that order. Shipping Information -------------------- Name: ________________________________________________________________________ Mail Stop/Dept. Name: ________________________________________________________ Organization: ________________________________________________________________ Street Address: ______________________________________________________________ City/State/Province: _________________________________________________________ Zip Code/Postal Code/Country: ________________________________________________ Telephone number in case of a problem with your order. For international orders, please include a FAX number. _______________________ ------------------------------------------------------------------------------ | | | Orders filled only upon receipt of check, money order or credit card | | order in U.S. dollars. Unpaid orders will be returned to the sender. | | We do not have the staff to handle the billing of unpaid orders. Please | | help keep our lives simple by including your payment with your order. | | | ------------------------------------------------------------------------------ For orders from outside the U.S.: --------------------------------- You are responsible for paying all duties, tariffs, and taxes. If you refuse to pay the charges, the shipper will return or abandon the order. --------------------------------------------------------------------------- | | | Please make checks payable to the ``Free Software Foundation''. | | | --------------------------------------------------------------------------- For Credit Card Orders: ----------------------- The Free Software Foundation takes these credit cards: Carte Blanche, Diner's Club, JCB, Mastercard, Visa, or American Express. Please note that we are charged about 5% of an order's total amount in credit card processing fees. Please consider paying by check instead, or adding on a 5% donation to make up the difference. To place a credit card order, please give us this information: Card type: ___________________________________________________________________ Account Number: ______________________________________________________________ Expiration Date: _____________________________________________________________ Cardholder's Signature: ______________________________________________________ ------------------------------------------------------------------------------ | | | If you wish to pay by wire transfer, or you are a reseller, please | | call or write us for details. | | | ------------------------------------------------------------------------------ Please mail orders to: Free Software Foundation 59 Temple Place -- Suite 330 Boston, MA 02111 +1-617-542-5942 FAX (including Japan): +1-617-542-2652 Free Dial FAX numbers in Japan: PRICES AND CONTENTS MAY CHANGE 0031-13-2473 (KDD) WITHOUT NOTICE AFTER January 31, 1996. 0066-3382-0158 (IDC) Version: June 1995 ASCII Bull to June 1995 Src CD/GNU 19.29/GCC 2.7.0 --------------------------------------------------------------------- local variables: mode: text fill-column: 78 end: emacs-19.30/etc/ORDERS.EUROPE100666 13035 13 364 5537774546 13345 0ustar gnuuserThe Free Software Foundation does not currently have a distributor in Europe. Please use the file etc/ORDERS in the GNU Emacs distribution or the ftpable file prep.ai.mit.edu:/pub/gnu/GNUinfo/ORDERS to order from the FSF in the United States. emacs-19.30/etc/ORDERS.JAPAN100666 12130 13 20333 6054152200 13543 0ustar toweruser GNU ORDER FORM FOR JAPAN Item Unit Price Quantity Item Price ---------------------------------------- ---------- -------- ---------- * indicates New or Substantially Updated items. * Compiler Tools Binaries CD-ROM edition 2, if a Y32,000 ________ __________ corporation or other organization is ultimately paying. * Compiler Tools Binaries CD-ROM edition 2, if an Y8,000 ________ __________ individual is ultimately paying. * Source Code CD-ROM edition 6, with X11R6, if a Y40,000 ________ __________ corporation or other organization is ultimately paying. * Source Code CD-ROM edition 6, with X11R6, if Y10,000 ________ __________ an individual is ultimately paying. Source Code CD-ROM edition 3, with X11R5, if a Y40,000 ________ __________ corporation or other organization is ultimately paying (while supplies last). Source Code CD-ROM edition 3, with X11R5, if Y10,000 ________ __________ an individual is ultimately paying (while supplies last). Subscription to next four editions of the Y125,000 ________ __________ Source Code CD-ROMs. (There is no subscription yet to the Compiler Tools Binaries CD-ROM.) * Source Code on Tape Y30,000 ________ __________ (per tape; see the next page for more details.) * Emacs manual, with reference card Y3,700 ________ __________ (Eleventh Edition for version 19.29) * Programming in Emacs Lisp, An Introduction Y3,100 ________ __________ (Edition 1.03) * Emacs Lisp Reference manual, in two volumes Y7,100 ________ __________ (Edition 2.4 for version 19.29) Emacs Calc manual, with reference card Y7,400 ________ __________ (Edition 2.02 for version 2.02) * Using and Porting GNU CC manual Y7,100 ________ __________ (September 1994 Edition for version 2.6) * GNU C Library Reference manual Y7,400 ________ __________ (Edition 0.06 for version 1.09) * Debugging with GDB manual, with reference card Y3,100 ________ __________ (Edition 4.12 for version 4.14) * Texinfo manual (Edition 2.21 for version 3) Y2,800 ________ __________ Termcap manual (Second edition for version 1.2) Y2,100 ________ __________ Bison manual, with reference card Y2,100 ________ __________ (December 1993 Edition for Version 1.23) Gawk manual (Edition 0.16 for version 2.16) Y2,800 ________ __________ Make manual (Edition 0.46 for version 3.72) Y2,800 ________ __________ Flex manual, with reference card Y2,100 ________ __________ (Edition 1.03 for version 2.3.7) Packet of ten Emacs 19 reference cards Y1,500 ________ __________ Packet of ten Emacs 18 reference cards Y1,500 ________ __________ (while supplies last) Packet of ten GDB reference cards Y1,500 ________ __________ Packet of ten Emacs Calc reference cards Y1,500 ________ __________ Packet of ten Bison reference cards Y1,500 ________ __________ Packet of ten Flex reference cards Y1,500 ________ __________ FSF T-shirt (size M) Y5,000 ________ __________ Color: Natural or Black (circle) FSF T-shirt (size L) Y5,000 ________ __________ Color: Natural or Black (circle) FSF T-shirt (size XL) Y5,000 ________ __________ Color: Natural or Black (circle) FSF T-shirt (size XXL) Y5,000 ________ __________ Color: Natural or Black (circle) Shipping Y1,500 Optional donation--help the FSF write more free software! __________ Total __________ The following is your shipping label. Please write clearly using Romaji. All orders must be prepaid. See the next page for payment instructions. Name: ___________________________________________________________________ Company: ________________________________________________________________ Address: ________________________________________________________________ Please also provide the following information in case there is a problem with your order. Telephone: ________________ Fax: ________________ E-Mail: _________________ ____ Please add my name to the mailing list for future FSF events in Japan. I prefer to be notified by: ______ fax _____ e-mail ____ Please send me information regarding the GNU corporate deluxe software and documentation package. ____ My company is interested in becoming a corporate sponsor of the FSF. ____ I am interested in working as a volunteer for the FSF. Version: June 1995 ASCII etc/ORDERS.JAPAN Prices and contents may change without notice after January 31, 1996. Free Software Foundation Toll-free FAX 0031-13-2473 (KDD) 59 Temple Place - Suite 330 0066-3382-0158 (IDC) Boston, MA 02111-1307 U.S.A. Help FSF save money FAX 001-1-617-542-2652 GNU ORDER FORM ADDITIONAL INSTRUCTIONS Within Japan, you may fax your order toll-free to 0031-13-2473 (KDD) or to 0066-3382-0158 (IDC). If you are able to pay for international direct dial, please fax your order directly to 001-1-617-542-2652. This will save the FSF the toll charges. Inquires may be made to gnu@prep.ai.mit.edu. Orders may also be sent by ordinary mail to: Free Software Foundation 59 Temple Place - Suite 330 Boston, MA 02111-1307 U.S.A. Orders may be prepaid either by credit card or by bank transfer. The credit cards we accept are JCB, Visa, MasterCard, Diner's Club, Carte Blanche, and American Express. Please provide your card type, expiration date, account number, and your signature. Bank transfer payments should be made to the following account: Bank: Sanwa Bank Branch: Azabu Branch (#620) Account name: Free Software Foundation Account number: 3683216 Prices and contents may change without notice after January 31, 1996. All software and publications are distributed with permission to copy and to redistribute. Texinfo source for each manual is on the Source Code CD-ROM and/or on the appropriate tape. The minimum order amount (before postage) is Y5,000. The FSF regrets that it cannot fill orders for smaller amounts. Please contact the FSF directly by telephone at 001-1-617-542-5942 or by fax at 001-1-617-542-2652 prior to placing any orders for greater than Y500,000. The FSF offers a deluxe package to Japanese corporations which consists of source code in your preferred format, a complete set of custom binaries for your preferred architecture and operating system, and a complete documentation set with reference cards. Purchasers of the corporate deluxe package will also receive invitations to future private presentations conducted by Richard Stallman in Japan. The price for the corporate deluxe package is Y1,000,000. For more information, contact the FSF directly. Software may also be ordered on magnetic tape. The following tape titles are available: * Lisps/Emacs * Languages * Utilities * Scheme * 4.4BSD-Lite * X11R6-Required X11R6-Optional X11R5-Required X11R5-Optional The following tape formats are available: Generic Unix tar 9-track 1600bpi 1/2" reel tape Generic Unix tar DAT 4mm cartridge tape Generic Unix tar Exabyte 8mm cartridge tape Sun Unix tar QIC-24 DC300XLP 1/4" cartridge tape (may also be read on other systems) HP Unix tar 16-track DC600HC 1/4" cartridge tape IBM RS/6000 Unix tar QIC-150 DC600A 1/4" cartridge tape (includes binaries for Emacs) (may also be read on other systems) VMS backup 9-track 1600bpi 1/2" reel tape (only two titles: GNU Emacs and GCC/GAS/Bison) Please indicate your desired tape titles and formats on a separate sheet of paper and fax that along with your order. If you need information regarding which programs are on which tapes, please consult the Japanese edition of the June 1995 GNU Bulletin. If you do not have a copy of the Japanese edition of the GNU Bulletin, please contact the FSF. For T-shirt orders, please circle desired color. Richard Stallman regrets that he cannot autograph items ordered by mail. If time permits, he will autograph items purchased at or brought to speaking engagements. All sales are final. Prices and contents may change without notice after January 31, 1996. Please do not fax this page. For use in Japan only. Free Software Foundation 59 Temple Place - Suite 330 Boston, MA 02111-1307 U.S.A. emacs-19.30/etc/OTHER.EMACSES100644 74777 13 117517 5352203000 13361 0ustar esruserHow is this Emacs different from all other Emacses? -*-Outline-*- This file describes the differences between GNU Emacs 19, Twenex Emacs, Gosling Emacs (including the commercial versions by Unipress) and CCA Emacs. * Copyright (c) 1985 Richard M. Stallman Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the copyright notice and permission notice are preserved, and that the distributor grants the recipient permission for further redistribution as permitted by this notice. Permission is granted to distribute modified versions of this document, or of portions of it, under the above conditions, provided also that they carry prominent notices stating who last changed them. Updated March 1993 for Emacs 19 by Eric S. Raymond * How is this Emacs different from Twenex Emacs? ** Fundamental concepts. *** There is no concept of "typeout" in GNU Emacs. Any time that a command wants to display some output, it creates a buffer (usually with a name surrounded by asterisks) and displays it in a window. This provides some advantages: you can edit some more while looking at the output; you can copy parts of the output into other buffers. It also has a disadvantage that you must type a command in order to make the output disappear. You can use C-x 1 to get rid of all windows except the selected one. To be more selective, you can switch to the window you want to get rid of and then type C-x 0 (delete-window). You also need to type a command to scroll the other window if not all the output fits in it. Meta-Control-v will usually do the job. *** There is no concept of a "subsystem" in GNU Emacs. Where Twenex Emacs would use a subsystem, GNU Emacs instead creates a buffer and redefines commands in it. For example, when you send mail in GNU Emacs, you use a buffer named *mail* which is in Mail Mode. You can switch away from this buffer to any other buffer and resume normal editing; then switch back and resume composing mail. You do not have to "exit" from composing mail in order to do ordinary editing. This has many advantages, but it also has a disadvantage: Subsystems in Emacs tend to have "exit" commands that return you to whatever you were doing before entering the subsystem. In GNU Emacs the idea of what to return to is not well defined, so it is not clear what an "exit" command should do. The only way to "exit" in general is to type C-x b, C-x C-f, or some other suitable command to switch buffers. Some subsystem-like major modes, such as Info and Mail mode, provide commands to "exit" by switching to the previously selected buffer. *** Files are always visited in their own buffers. Beginning users of Twenex Emacs were told how to edit using a single buffer and reading one file after another into that buffer. Use of a new buffer for each file was regarded as a more advanced mode. In GNU Emacs, the idea of using a single buffer for various files, one by one, has been dropped, given that the address space is expected to be large enough for many buffers. C-x C-f (find-file), which behaves nearly the same as in Twenex Emacs, is in GNU Emacs the canonical way for all users to visit files. Various commands need to read files into Emacs in the course of their execution. In Twenex Emacs the user must tell them whether to reuse buffers or create new ones, using the variable Tags Find File. In GNU Emacs, these commands always use C-x C-f. The command C-x C-v does still exist; it kills the current buffer and reads the specified file into a new buffer. It is equivalent to kill-buffer followed by find-file. Since there is no reusing of buffers, there is no point in calling the initial buffer "main". So the initial buffer in GNU Emacs is called "*scratch*" and is intended for typing Lisp expressions to be evaluated. *** File name defaulting. GNU Emacs records a separate working directory for each buffer. Normally this is the directory on which the buffer's file resides; for buffers not visiting any file, it is copied from the buffer that was current when it was created. The current buffer's working directory can be printed with M-x pwd and set with M-x cd. GNU Emacs shows you the default directory by inserting it in the minibuffer when a file name is being read. You can type the filename you want at the end of the default as if the default were not there, or you can edit and alter the default. If you want file /lose/big when the default /foo/defaultdir/ has been inserted for you, you need not kill the default; simply type at the end of it: /foo/defaultdir//lose/big. Such a file name is not ordinarily considered valid, but GNU Emacs considers it equivalent to /lose/big. Likewise, if you want file quux in your home directory, just add ~/quux to the end of the supplied text, to get /foo/defaultdir/~/quux. GNU Emacs sees "/~" and throws away everything before the "~". You can refer to environment variables also within file names. $ followed by the environment variable name is replaced by the variable's value. The variable name should either be followed by a nonalphanumeric character (which counts as part of the file name) or be surrounded by braces {...} (which do not count as part of the file name). Thus, if variable USER has value "rms", "x/$USER-foo" is expanded to "x/rms-foo", and "x${USER}foo" is expanded to "xrmsfoo". Note that this substitution is not performed by the primitive file operation functions of GNU Emacs, but rather by the interactive file name reader. It is also available as a separate primitive, in the function substitute-in-file-name. *** Exit commands C-z, C-x C-c and C-x C-z. There are two ways to exit GNU Emacs: killing and suspending. Killing is like what Control-c does to ordinary Unix programs. In GNU Emacs, you type C-x C-c to kill it. (This offers to save any modified file buffers before really killing Emacs.) Suspending is like what Control-z does to ordinary Unix programs. To suspend GNU Emacs, type C-x C-z, or type just C-z. Note that C-z suspends ordinary programs instantly, but Emacs does not suspend until it reads the C-z. Usually it is better to suspend: once a system is smart enough to have job control, why ever kill an editor? You'll just have to make a new one in a minute. This is why the convenient command C-z is provided for suspending. C-c is used as a prefix key for mode-specific commands and for users' own commands. We deliberately do not make C-c ever kill Emacs, because it should not be so easy to do something irreversible. *** Quitting with C-g. If you type C-g while GNU Emacs is waiting for input, it is an ordinary command (which is defined to beep). If you type C-g while Lisp code is executing, it sets a flag which causes a special signal, nearly the same as an error, to happen atthe next safe place in Lisp execution. This usually has the effect of aborting the current command in a safe way. Because at times there have been bugs causing GNU Emacs to loop without checking the quit flag, a special feature causes GNU Emacs to be suspended immediately if you type a second C-g while the flag is already set. So you can always get out of GNU Emacs. Normally GNU Emacs recognizes and clears the quit flag quickly enough to prevent this from happening. When you resume GNU Emacs after a suspension caused by multiple C-g, it asks two questions before resuming execution: Checkpoint? Dump core? Answer each one with `y' or `n' and a Return. `y' to Checkpoint? causes immediate auto-saving of all buffers in which auto-saving is enabled. `y' to Dump core? causes an illegal instruction to be executed. This is to enable a wizard to figure out why GNU Emacs was looping without checking for quits. Execution does not continue after a core dump. If you answer `n', execution continues. With luck, GNU Emacs will ultimately check the quit flag, and quit normally. If not, and you type another C-g, it is suspended again. If GNU Emacs is not really hung, just slow, you may invoke the double C-g feature without really meaning to. Then just resume and answer `n' to both questions, and you will arrive at your former state. Presumably the quit you wanted will finish happening soon. These questions are not asked if you suspend GNU Emacs with the C-z command. Continuing GNU Emacs after a C-z takes you straight back into editing. *** Undoing with C-x u or C-_ You can undo many commands--up to 10,000 characters worth. Each time you type C-x u or C-_, another command or batch of change is undone. Undo information is stored per buffer, and the undo command always applies to the current buffer. A numeric argument serves as a repeat count. Consecutive self-inserting characters are undone in groups of twenty. *** Different character set. GNU Emacs does not expect anyone ever to have a keyboard in which the Control key sets an independent bit which may accompany any character. The only control characters that can exist are the ASCII control characters. There is, as a result, no "control prefix" character. *** Control-h is the Help character. I'm amazed it took me so long to get this idea. In Twenex Emacs, C-h and C-b are equivalent commands, making C-h redundant. C-h is not only easy to type, it is mnemonic for "Help". So in GNU Emacs the Help character is C-h. *** Completion is done by TAB, not ESC. ESC in the minibuffer is a Meta prefix, same as at top level. *** The string-argument reader is the minibuffer is an editor window. In GNU Emacs, the line at the bottom of the screen is the minibuffer. Commands that want string arguments always use this line to read them, and you can use the ordinary Emacs editing commands to edit the input. You can terminate input with Return because Return is defined as the exit-minibuffer command when in the minibuffer. If you are using a command that needs several arguments, terminate each one with Return. You cannot separate arguments with Escape the way you would in Twenex Emacs. The minibuffer window does not overlay other editor windows; it is a nearly ordinary editor window which lacks a mode line and is "turned off" when not in use. While it IS in use, you can switch windows to and from the minibuffer, kill text in other windows and yank in the minibuffer, etc. You can even issue a command that uses the minibuffer while in the minibuffer. This gets you temporarily into a recursive minibuffer. However, this is allowed only if you enable it, since it could be confusing for beginners. When you exit the minibuffer, the cursor immediately moves back to column zero of the minibuffer line, to show you that the exit command has been obeyed. The minibuffer contents remain on the screen until the end of the command, unless some other text is displayed there. A single Control-g exits the minibuffer. *** There are no &'s or ^R's or spaces in function names. For example, the function which is called ^R Forward Word in Twenex Emacs is called forward-word in GNU Emacs. *** The extension language is Lisp rather than TECO. Libraries must be written in Lisp. Meta-ESC reads a Lisp expression, evaluates it, and prints the result. Note that Meta-ESC is "disabled" by default, so that beginning users do not get into the minibuffer by accident in a confusing way. Data types available include integers (which double as characters), strings, symbols, lists, vectors, buffers, buffer pointers, windows, and process channels. For now, to learn about writing Lisp code for GNU Emacs, read some of the source code, which is in directory ../lisp. Read the GNU Emacs Lisp Reference Manual. Also, all Lisp primitives have self-documentation you can read with C-h f. *** Enabling the error handler. GNU Emacs has a Lisp debugger/stepper/trace package, but normally errors do not enter the debugger because that is slow, and unlikely to be of interest to most users. Set the variable debug-on-error to t to cause errors to invoke the debugger. Set debug-on-quit to cause quit signals (caused by C-g) to invoke the debugger. ** Other changes. *** More than two windows are allowed. C-x 2 splits the current window into two windows, one above the other. Initially they both display the same buffer. C-x 2 now accepts a numeric argument to specify the number of lines to give to the uppermost of the two windows it makes. C-x 0 kills the current window, making all others larger. C-x 1 kills all windows except the current one. C-x O switches to the next window down. It rotates from the bottom one to the top one. An argument serves as a repeat count; negative arguments circulate in the reverse order. If the same buffer is displayed in several windows, changes made in it are redisplayed in all of them. *** Side by side windows are supported. The command C-x 3 splits the current window into two side-by-side windows. C-x } makes the selected window ARG columns wider at the expense of the windows at its sides. C-x { makes the selected window ARG columns narrower. An argument to C-x 5 specifies how many columns to give to the leftmost of the two windows made. *** Horizontal scrolling of the lines in a window is implemented. C-x < (scroll-left) scrolls all displayed lines left, with the numeric argument (default 1) saying how far to scroll. When the window is scrolled left, some amount of the beginning of each nonempty line is replaced by an "$". C-x > scrolls right. If a window has no text hidden at the left margin, it cannot be scrolled any farther right than that. When nonzero leftwards scrolling is in effect in a window. lines are automatically truncated at the window's right margin regardless of the value of the variable truncate-lines in the buffer being displayed. *** Return key does not use up empty lines. In Twenex Emacs, the Return command advances over an existing empty line in some cases. In GNU Emacs, the Return command always makes inserts a newline. Twenex Emacs was designed at a time when most display terminals did not have the ability to scroll part of the screen, and using existing empty lines made redisplay faster. Nowadays, terminals that cannot scroll part of the screen are rare, so there is no need to make Return behave in a more complicated manner. *** Help m. Typing C-h m displays documentation of the current major mode., telling you what special commands and features are available and how to use them or get more information on them. This is simply the documentation, as a function, of the symbol which is the value of major-mode. Each major mode function has been given documentation intended for C-h m. *** Display-hiding features. **** Hiding indented lines The command C-x $ with numeric argument N causes lines indented by N or more columns to become invisible. All you see is " ..." appended to the previous line, in place of any number of consecutive invisible lines. **** Outline Mode. Outline mode is designed for editing outline-structured files, such as this one. Headings should be lines starting with one or more asterisks. Major headings have one asterisk, subheadings two, etc. Lines not starting with asterisks are body text. You can make the body under a heading, or the subheadings under a heading, temporarily invisible, or visible again. Invisible lines are attached to the end of the previous line so they go with it if you kill it and yank it back. Commands: Meta-} next-visible-heading move by visible headings Meta-{ previous-visible-heading move by visible headings Meta-x hide-body make all body text invisible (not headings). Meta-x show-all make everything in buffer visible. The remaining commands are used when dot is on a heading line. They apply to some of the body or subheadings of that heading. C-c C-h hide-subtree make text and subheadings invisible. C-c C-s show-subtree make text and subheadings visible. C-c C-i show-children make direct subheadings visible. No effect on body, or subheadings 2 or more levels down. With arg N, affects subheadings N levels down. M-x hide-entry make immediately following body invisible. M-x show-entry make it visible. M-x hide-leaves make text under heading and under its subheadings invisible. The subheadings remain visible. M-x show-branches make all subheadings at all levels visible. *** C mode is fancy. C mode assumes that you put the initial open-brace of a function definition at the beginning of a line. If you use the popular indenting style that puts this open-brace at the end of a line containing a type declaration, YOU WILL LOSE: C mode does not know a function starts there. Open-brace at the beginning of a line makes it possible for C mode to find function boundaries with total reliability; something I consider vital and which cannot be done if the other style is used. The Tab command indents C code very cleverly. I know of only one cases in which Tab does not indent C code nicely: Expressions continued over several lines with few parentheses. Tab does not know the precedences of C operators, so it does not know which lines of the expression should go where. Using parentheses to indicate the nesting of operators except within a line makes this problem go away. The indenting algorithm is entirely written in Lisp. Tab with a numeric argument in Twenex Emacs indents that many lines. It is different in GNU Emacs: it means to shift all the lines of a bracketed expression by the same amount as the line being indented. For example, if you have if (foo) { hack (); /** Well? */ } and type C-u Tab on the line with the open brace, you get if (foo) { hack (); /* Well? */ } from indenting the brace line and then shifting the lines within the braces rigidly with the first one. Meta-Control-q works as in Lisp mode; it should be used with dot just before a bracketed grouping, and indents each line INSIDE that grouping using Tab. If used instead of C-u Tab in the previous example, it makes if (foo) { hack (); /* Well? */ } Meta-Control-h puts mark at the end of the current C function and puts dot before it. Most other Meta-Control commands intended for Lisp expressions work usefully in C mode as well. *** Meta-g (fill-region) is different. In Twenex Emacs, Meta-g fills the region with no paragraph boundaries except for blank and indented lines. In GNU Emacs, it divides the region into paragraphs in the same manner as Meta-], and fills each paragraph separately. There is also the function fill-region-as-paragraph which fills the region regarding at as a single paragraph regardless even of blank or indented lines. *** Indented Text Mode instead of Edit Indented Text. Twenex Emacs has a command Edit Indented Text which temporarily alters some commands for editing indented paragraphs. GNU Emacs has instead a separate major mode, Indented Text Mode, which is different from ordinary Text Mode in just the same alterations. Specifically, in Indented Text Mode, Tab runs the function indent-relative, and auto filling indents the newly created lines. *** But rectangle commands are implemented. C-x r r stores the rectangle described by dot and mark into a register; it reads the register name from the keyboard. C-x r g, the command to insert the contents of a register, can be used to reinsert the rectangle elsewhere. Other rectangle commands include open-rectangle: insert a blank rectangle in the position and size described by dot and mark, at its corners; the existing text is pushed to the right. clear-rectangle: replace the rectangle described by dot ane mark with blanks. The previous text is deleted. delete-rectangle: delete the text of the specified rectangle, moving the text beyond it on each line leftward. kill-rectangle like delete-rectangle but also stores the text of the rectangle in the "rectangle kill buffer". More precisely, it stores the text as a list of strings (one string for each line) in the variable killed-rectangle. yank-rectangle inserts the text of the last killed rectangle. extract-rectangle and delete-extract-rectangle these functions return the text of a rectangle as a list of strings. They are for use in writing other functions that operate on rectangles. *** Keyboard Macros The C-x ( command for defining a keyboard macro can in GNU Emacs be given a numeric argument, which means that the new macro starts out not empty but rather as the same as the last keyboard macro entered. In addition, that last keyboard macro is replayed when the C-x ( is typed. C-x ( with an argument is thus equivalent to typing plain C-x ( and then retyping the last keyboard macro entered. The command write-kbd-macro and append-kbd-macro can be used to save a keyboard macro definition in a file. It is represented as a Lisp expression which, when evaluated, will define the keyboard macro. write-kbd-macro writes the specified file from scratch, whereas append-kbd-macro adds to any existing text in the file. Both expect the keyboard macro to be saved to be specified by name; this means you must use the command name-last-kbd-macro to give the macro a name before you can save it. *** The command to resume a terminated tags-search or tags-query-replace is Meta-comma in GNU Emacs. *** Auto Save is on by default. Auto Save mode is enabled by default in all buffers that are visiting files. The file name used for auto saving is made by prepending "#" to the file name visited. *** Backup files. Since Unix stupidly fails to have file version numbers, GNU Emacs compensates slightly in the customary fashion: when a file is modified and saved for the first time in a particular GNU Emacs run, the original file is renamed, appending "~" to its name. Thus, foo.c becomes foo.c~. Emacs can also put a version number into the name of the backup file, as in foo.c.~69~ for version number 69. This is an optional feature that the user has to enable. *** Mode Line differences. Each window in GNU Emacs has its own mode line, which always displays the status of that window's buffer and nothing else. The mode line appears at the bottom of the window. It is full of dashes, to emphasize the boundaries between windows, and is displayed in inverse video if the terminal supports it. The information usually available includes: *** Local Modes feature changed slightly. GNU Emacs supports local mode lists much like those in Twenex Emacs, but you can only set variables, not commands. You write Local variables: tab-width: 10 end: in the last page of a file, if you want to make tab-width be ten in a file's buffer. The value you specify must be a Lisp object! It will be read, but not evaluated. So, to specify a string, you MUST use doublequotes. For "false", in variables whose meanings are true or false, you MUST write nil . Two variable names are special: "mode" and "eval". Mode is used for specifying the major mode (as in Twenex Emacs). mode: text specifies text mode. Eval is used for requesting the evaluation of a Lisp expression; its value is ignored. Thus, eval: (set-syntax-table lisp-mode-syntax-table) causes Lisp Mode syntax to be used. Note that GNU Emacs looks for the string "Local variables:" whereas Twenex Emacs looks for "Local modes:". This incompatibility id deliberate, so that neither one will see local settings intended for the other. *** Lisp code libraries. Libraries of commands, and init files, are written in Lisp. libraries conventionally have names ending in .el, while the init file is named .emacs and is in your home directory. Use Meta-x load-library to load a library. Most standard libraries load automatically if you try to use the commands in them. Meta-x byte-compile-file filename compiles the file into byte code which loads and runs faster than Lisp source code. The file of byte code is given a name made by appending "c" to the end of the input file name. Meta-x byte-recompile-directory directoryname compiles all files in the specified directory (globbing not allowed) which have been compiled before but have been changed since then. Meta-x load-library automatically checks for a compiled file before loading the source file. Libraries once loaded do not retain their identity within GNU Emacs. Therefore, you cannot tell just what was loaded from a library, and you cannot un-load a library. Normally, libraries are written so that loading one has no effect on the editing operations that you would have used if you had not loaded the library. *** Dired features. You can do dired on partial directories --- any pattern the shell can glob. Dired creates a buffer named after the directory or pattern, so you can dired several different directories. If you repeat dired on the same directory or pattern, it just reselects the same buffer. Use Meta-x Revert on that buffer to read in the current contents of the directory. *** Directory listing features. C-x C-d now uses the default output format of `ls', which gives just file names in multiple columns. C-u C-x C-d passes the -l switch to `ls'. Both read a directory spec from the minibuffer. It can be any pattern that the shell can glob. *** Compiling other programs. Meta-x compile allows you to run make, or any other compilation command, underneath GNU Emacs. Error messages go into a buffer whose name is *compilation*. If you get error messages, you can use the command C-x ` (that is a backquote) to find the text of the next error message. You must specify the command to be run as an argument to M-x compile. A default is placed in the minibuffer; you can kill it and start fresh, edit it, or just type Return if it is what you want. The default is the last compilation command you used; initially, it is "make -k". *** Searching multiple files. Meta-x grep searches many files for a regexp by invoking grep and reading the output of grep into a buffer. You can then move to the text lines that grep found, using the C-x ` command just as after M-x compile. *** Running inferior shells. Do Meta-x shell to make an inferior shell together with a buffer which serves to hold "terminal" input and output of the shell. The shell used is specified by the environment variable ESHELL, or by SHELL if ESHELL is not set. Use C-h m whilst in the *shell* buffer to get more detailed info. The inferior shell loads the file .emacs_csh or.emacs_sh (or similar using whatever name the shell has) when it starts up. M-! executes a shell command in an inferior shell and displays the output from it. With a prefix argument, it inserts the output in the current buffer after dot and sets the mark after the output. The shell command gets /dev/null as its standard input. M-| is like M-! but passes the contents of the region as input to the shell command. A prefix argument makes the output from the command replace the contents of the region. *** Sending mail. Once you enter Mail Mode using C-x m or C-x 4 m or M-x mail, C-c becomes a prefix character for mail-related editing commands. C-c C-s is vital; that's how you send the message. C-c C-c sends and then switches buffers or kills the current window. Use C-h m to get a list of the others. *** Regular expressions. GNU Emacs has regular expression facilities like those of most Unix editors, but more powerful: **** -- + -- + specifies repetition of the preceding expression 1 or more times. It is in other respect like *, which specifies repetition 0 or more times. **** -- ? -- ? is like * but matches at most one repetition of the preceding expression. **** -- \| -- \| specifies an alternative. Two regular expressions A and B with \| in between form an expression that matches anything that either A or B will match. Thus, "foo\|bar" matches either "foo" or "bar" but no other string. \| applies to the larges possible surrounding expressions. Only a surrounding \( ... \) grouping can limit the grouping power of \|. Full backtracking capability exists when multiple \|'s are used. **** -- \( ... \) -- \( ... \) are a grouping construct that serves three purposes: 1. To enclose a set of \| alternatives for other operations. Thus, "\(foo\|bar\)x" matches either "foox" or "barx". 2. To enclose a complicated expression for * to operate on. Thus, "ba\(na\)*" matches "bananana", etc., with any number of na's (zero or more). 3. To mark a matched substring for future reference. Application 3 is not a consequence of the idea of a parenthetical grouping; it is a separate feature which happens to be assigned as a second meaning to the same \( ... \) construct because there is no conflict in practice between the two meanings. Here is an explanation of this feature. -- \digit -- After the end of a \( ... \) construct, the matcher remembers the beginning and end of the text matched by that construct. Then, later on in the regular expression, you can use \ followed by a digit to mean, ``match the same text matched this time by the \( ... \) construct.'' The first nine \( ... \) constructs that appear in a regular expression are assigned numbers 1 through 9 in order of their beginnings. \1 through \9 can be used to refer to the text matched by the corresponding \( ... \) construct. For example, "\(.*\)\1" matches any string that is composed of two identical halves. The "\(.*\)" matches the first half, which can be anything, but the \1 that follows must match the same exact text. **** -- \` -- Matches the empty string, but only if it is at the beginning of the buffer. **** -- \' -- Matches the empty string, but only if it is at the end of the buffer. **** -- \b -- Matches the empty string, but only if it is at the beginning or end of a word. Thus, "\bfoo\b" matches any occurrence of "foo" as a separate word. "\bball\(s\|\)\b" matches "ball" or "balls" as a separate word. **** -- \B -- Matches the empty string, provided it is NOT at the beginning or end of a word. **** -- \< -- Matches the empty string, provided it is at the beginning of a word. **** -- \> -- Matches the empty string, provided it is at the end of a word. **** -- \w -- Matches any word-constituent character. The editor syntax table determines which characters these are. **** -- \W -- Matches any character that is not a word-constituent. **** -- \s -- Matches any character whose syntax is . is a letter that represents a syntax code: thus, "w" for word constituent, "-" for whitespace, "(" for open-parenthesis, etc. Thus, "\s(" matches any character with open-parenthesis syntax. **** -- \S -- Matches any character whose syntax is not . * How is this Emacs different from Gosling Emacs? ** Advantages of Gosling Emacs: 1. The program itself is much smaller. GNU Emacs uses about 250k more pure storage. As a result, Gosling Emacs can run on machines that cannot run GNU Emacs. There is not much difference in the amount of impure storage in the two programs. 2. In some versions there is support for other forks to establish communications channels to Emacs (using sockets?). 3. There is a direct interface to dbm (data bases). ** Advantages of GNU Emacs: *** True Lisp, not Mocklisp. GNU Emacs's extension language has real symbols, lists and vectors. Many extensions are much simpler, and some become possible that were nearly impossible in Gosling Emacs. Many primitives can have cleaner interfaces, and some features need not be put in as special primitives because you can do them easily yourself. *** But Mocklisp still works. An automatic conversion package plus a run-time library allows you to convert a Mocklisp library into a Lisp library. *** Commands are better crafted. For example, nearly every editing function for which a numeric argument would make sense as a repeat count does accept a repeat count, and does handle a negative argument in the way you would expect. *** The manual is clearer. Everyone tells me it is a very good manual. *** Better on-line documentation. Both functions and variables have documentation strings that describe exactly how to use them. *** C mode is smart. It really knows how to indent each line correctly, for most popular indentation styles. (Some variables control which style is used; popular named styles are also supported.) *** Compatible with PDP-10 Emacs, Multics Emacs and Zmacs. The commands in GNU Emacs are nearly the same as in the original Emacs and the other Emacses which imitated it. (A few have been changed to fit the Unix environment better.) *** Support for Gosling's Emacs commands. M-x set-gosmacs-bindings rebinds many editing commands for compatibility with Gosling's Emacs. M-x set-gnu-bindings reverses the change. *** Side-by-side windows. You can split a GNU Emacs window either horizontally or vertically. *** Redisplay is faster. GNU Emacs sends about the same stuff to the terminal that Gosling's does, but GNU Emacs uses much less CPU time to decide what to do. *** Entirely termcap-driven. GNU Emacs has nearly no special code for any terminal type. Various new termcap strings make it possible to handle all terminals nearly as fast as they could be handled by special-case code. *** Display-hiding features. For example, Outline Mode makes it possible for you to edit an outline, making entire sub-branches of the outline visible or invisible when you wish. *** You can interrupt with Control-G. Even a looping Lisp program can be stopped this way. And even a loop in C code does not stop you from killing Emacs and getting back to your shell. *** Per-buffer Undo. You can undo the last several changes, in each buffer independently. *** The editor code itself is clean. Many people have remarked on how much they enjoy reading the code for GNU Emacs. One other note: The program etc/cvtmail that comes with GNU Emacs can be used to convert a mail directory for Gosling Emacs's Rmail into a Unix mail file that you could read into GNU Emacs's Rmail. * How is this Emacs different from CCA Emacs? ** GNU Emacs Lisp vs CCA Elisp. GNU Emacs Lisp does not have a distinction between Lisp functions and Emacs functions, or between Lisp variables and Emacs variables. The Lisp and the editor are integrated. A Lisp function defined with defun is callable as an editor command if you put an interactive calling spec in it; for example, (defun forward-character (n) (interactive "p") (goto-char (+ (point) n))) defines a function of one argument that moves point forward by a specified number of characters. Programs could call this function, as in (forward-character 6), or it could be assigned to a key, in which case the "p" says to pass the prefix numeric arg as the function's argument. As a result of this feature, you often need not have two different functions, one to be called by programs and another to read arguments from the user conveniently; the same function can do both. CCA Elisp tries to be a subset of Common Lisp and tries to have as many Common Lisp functions as possible (though it is still only a small fraction of full Common Lisp). GNU Emacs Lisp is somewhat similar to Common Lisp just because of my Maclisp and Lisp Machine background, but it has several distinct incompatibilities in both syntax and semantics. Also, I have not attempted to provide many Common Lisp functions that you could write in Lisp, or others that provide no new capability in the circumstances. GNU Emacs Lisp does not have packages, readtables, or character objects (it uses integers to represent characters). On the other hand, windows, buffers, relocatable markers and processes are first class objects in GNU Emacs Lisp. You can get information about them and do things to them in a Lispy fashion. Not so in CCA Emacs. In GNU Emacs Lisp, you cannot open a file and read or write characters or Lisp objects from it. This feature is painful to support, and is not fundamentally necessary in an Emacs, because instead you can read the file into a buffer, read or write characters or Lisp objects in the buffer, and then write the buffer into the file. On the other hand, GNU Emacs Lisp does allow you to rename, delete, add names to, and copy files; also to find out whether a file is a directory, whether it is a symbolic link and to what name, whether you can read it or write it, find out its directory component, expand a relative pathname, find completions of a file name, etc., which you cannot do in CCA Elisp. GNU Emacs Lisp uses dynamic scope exclusively. This enables you to bind variables which affect the execution of the editor, such as indent-tabs-mode. GNU Emacs Lisp code is normally compiled into byte code. Most of the standard editing commands are written in Lisp, and many are dumped, pure, in the Emacs that users normally run. GNU Emacs allows you to interrupt a runaway Lisp program with Control-g. ** GNU Emacs Editing Advantages GNU Emacs is faster for many things, especially insertion of text and file I/O. GNU Emacs allows you to undo more than just the last command with the undo command (C-x u, or C-_). You can undo quite a ways back. Undo information is separate for each buffer; changes in one buffer do not affect your ability to undo in another buffer. GNU Emacs commands that want to display some output do so by putting it in a buffer and displaying that buffer in a window. This technique comes from Gosling Emacs. It has both advantages and disadvantages when compared with the technique, copied by CCA Emacs from my original Emacs which inherited it from TECO, of having "type out" which appears on top of the text in the current window but disappears automatically at the next input character. GNU Emacs does not use the concept of "subsystems". Instead, it uses highly specialized major modes. For example, dired in GNU Emacs has the same commands as dired does in other versions of Emacs, give or take a few, but it is a major mode, not a subsystem. The advantage of this is that you do not have to "exit" from dired and lose the state of dired in order to edit files again. You can simply switch to another buffer, and switch back to the dired buffer later. You can also have several dired buffers, looking at different directories. It is still possible to write a subsystem--your own command loop-- in GNU Emacs, but it is not recommended, since writing a major mode for a special buffer is better. Recursive edits are also rarely used, for the same reason: it is better to make a new buffer and put it in a special major mode. Sending mail is done this way. GNU Emacs expects everyone to use find-file (C-x C-f) for reading in files; its C-x C-v command kills the current buffer and then finds the specified file. As a result, users do not need to think about the complexities of subsystems, recursive edits, and various ways to read in files or what to do if a buffer contains changes to some other file. GNU Emacs uses its own format of tag table, made by the "etags" program. This format makes finding a tag much faster. Dissociated Press is supported. ** GNU Emacs Editing Disadvantages. GNU Emacs does not display the location of the mark. GNU Emacs does not have a concept of numbers of buffers, or a permanent ordering of buffers, or searching through multiple buffers. The tags-search command provides a way to search through several buffers automatically. GNU Emacs does not provide commands to visit files without setting the buffer's default directory. Users can write such commands in Lisp by copying the code of the standard file visiting commands and modifying them. GNU Emacs does not support "plus options" in the command arguments or in buffer-selection commands, except for line numbers. GNU Emacs does not support encryption. Down with security! GNU Emacs does not support replaying keystroke files, and does not normally write keystroke files. ** Neutral Differences GNU Emacs uses TAB, not ESC, to complete file names, buffer names, command names, etc. GNU Emacs uses LFD to terminate searches, instead of the C-d uses by CCA Emacs. (Actually, this character is controlled by a parameter in GNU Emacs.) C-M-s in GNU Emacs is an interactive regular expression search, but you can get to a noninteractive one by typing ESC right after the C-M-s. In GNU Emacs, C-x s asks, for each modified file buffer, whether to save it. GNU Emacs indicates line continuation with "\" and line truncation (at either margin) with "$". The command to resume a tags-search or tags-query-replace in GNU Emacs is Meta-Comma. emacs-19.30/etc/README100444 21570 13 526 6005527262 12242 0ustar djmuserThis directory contains the architecture-independent files used by or with Emacs. This includes some text files of documentation for GNU Emacs or of interest to Emacs users, and the file of dumped docstrings for Emacs functions and variables. `termcap.src' is included mainly for VMS. It is a copy of the `/etc/termcap' file used on Unix. emacs-19.30/etc/SERVICE100666 13035 13 73076 6053743267 12511 0ustar gnuuser -*- text -*- GNU Service Directory --------------------- This is a list of people who have asked to be listed as offering support services for GNU software, including GNU Emacs, for a fee or in some cases at no charge. The information comes from the people who asked to be listed; we do not include any information we know to be false, but we cannot check out any of the information; we are transmitting it to you as it was given to us and do not promise it is correct. Also, this is not an endorsement of the people listed here. We have no opinions and usually no information about the abilities of any specific person. We provide this list to enable you to contact service providers and decide for yourself whether to hire one. Before FSF will list your name in the GNU Service Directory, we ask that you agree informally to the following terms: 1. You will not restrict (except by copyleft) the use or distribution of any software, documentation, or other information you supply anyone in the course of modifying, extending, or supporting GNU software. This includes any information specifically designed to ameliorate the use of GNU software. 2. You will not take advantage of contact made through the Service Directory to advertise an unrelated business (e.g., sales of non-GNU-related proprietary information). You may spontaneously mention your availability for general consulting, but you should not promote a specific unrelated business unless the client asks. Please include some indication of your rates, because otherwise users have nothing to go by. Please put each e-mail address inside "<>". Please put nothing else inside "<>". Thanks! For a current copy of this directory, or to have yourself listed, ask: gnu@prep.ai.mit.edu ** Please keep the entries in this file alphabetical **  Joseph Arceneaux PO Box 460633 http://www.samsara.com/~jla San Francisco, CA 94146-0633 +1 415 648 9988 +1 415 285 9088 Recently led the project making Wells Fargo Bank the first to provide secure customer account access over the Internet. Former FSF staffmember. Performed X11 implementation of Emacs version 19, designed and implemented WYSIWYG Emacs. Installed and administered FSF network. Maintainer of GNU indent. Over 15 years experience with Unix and other systems, from writing ROM monitors to UI design and system administration. I provide installation, porting, debugging and customization or development of GNU and other Unix software. I also design and implement free software projects and consult on software engineering and systems design. Handholding and teaching services are also available as well as things like LAN and compute--infrastructure design. Time and material rates around $150 USD per hour, depending upon the particular job. I am also very interested in fixed-bid jobs. For selected non-profit organizations with worthy goals, I work for free. Updated: 17Oct95  Gerd Aschemann Osannstr. 49 D-64285 Darmstadt Tel.: +49 6151 16 2259 http://www.informatik.th-darmstadt.de/~ascheman/ - System Administrator (UNIX) at CS Department, TU Darmstadt, Germany - 15 years expirience with CS, Systemadministration on different platforms - 8 years with UNIX/Networking/FreeWare/GNU/X11 - 6 years organizer of Operating Systems and Distributed Systems courses - Lectures on System and Network Administration - Platforms: Solaris, SunOS, Ultrix, OSF1, HP-UX, Linux, FreeBSD, AIX - Experience with parallel environments (Connection Machine, Meiko, Parsytec) - Consultant for other UNIX users at TU Darmstadt Rates are at 100,-- DM (~60 US$) per hour minimum, depending on the job. I am willing to travel for sufficiently large jobs. Updated: 17Oct95  Giuseppe Attardi Dipartimento di Informatica Corso Italia 40 I-56125 Pisa, Italy +39 50 887-244 GNU: help on obtaininig GNU, for italian sites. Updated: 5Apr94  James Craig Burley 97 Arrowhead Circle Ashland, MA 01721-1987 508 881-6087, -4745 (Please call only between 0900-1700 Eastern time, and only if you are prepared to hire me -- ask me to help you for free only via email, to which I might or might not respond.) Email: --preferred-- Expertise: Compiler Internals (author of GNU Fortran, for example) Operating Systems Internals Tools/Utilities Development and Maintenance Microcode Development and Maintenance (primarily VLIW machines) System Design (computers, operating systems, toolsets, &c) Debugging (often asked to help debug Other People's Code) Documentation (authored many books and ran a few doc projects) Extensive experience with a variety of operating systems, hardware, languages, and so on Rate: $70/hour -- willing to consider flat-fee arrangements Updated: 14Aug95  Michael I. Bushnell 545 Technology Square, NE43-426 Cambridge, MA 02139 (617) 253-8568 All GNU software: Installation, customization, answering simple or complex questions, bug fixing, extension. Experience: I have done Unix and GNU programming for several years, I am the primary author of the Hurd (which provides most kernel related facilities for the GNU OS). I am easily available in the Cambridge/Boston area; work via email. I am willing to travel for sufficiently large jobs. Rates: $100/hr, negotiable, less for non-profit organizaions. Updated: 5Apr94  C2V Renaud Dumeur 82 bd Haussmann Michel Delval 75009 Paris Jean-Alain Le Borgne France Tel (1) 40.08.07.07 Fax (1) 43.87.35.99 We offer source or source+binary distribution, installation, training, maintenance, technical support, consulting, specific development and followup on the GNU software development environment: Emacs, gcc/g++, binutils, gas, gdb. Experience: adapted gcc, gas and binutils to work as cross-development tools for the Thomson st18950 DSP chip: GCC parser and typing system have been augmented to allow the manipulation of variables located in separated memory spaces. Porting on new platforms, and professionally developing software with the GNU tools in the Unix/X11 environment since they were first available. Rates: from 2000 FF/day to 150 000 FF/year, 40% discount for educational institutions, add taxes and expenses. Ask for list. Entered: 5May94  Contributed Software Graefestr. 76 10967 Berlin, Germany phone: (+49 30) 694 69 07 FAX: (+49 30) 694 68 09 modems: (+49 30) 694 60 55 (5xZyXEL ) modems: (+49 30) 693 40 51 (8xUSR DS) email: internet: uropax.contrib.de [192.109.39.2], login as 'guest'. We distribute, install, port, teach and support free software in general, i.e. X11, GNU, khoros etc. Rates are ECU 80,-- plus tax per hour. We offer maintenance and support contracts for full customer satisfaction. Highlights are transparent development environments for multi-platform sites and configuration management. Traveling is no problem. Free Archive login for downloading on above modem numbers. Updated: 5Apr94  Stuart Cracraft 25682 Cresta Loma Laguna Niguel, Ca. 92677 GNUline: 714-347-8106 Rate: $75/hour Consultation topics: Entire GNU suite - porting, compilation, installation, user-training, administrator-training Method: telephone line support, call-in via modem to your site, or direct visit. Experience: supporting GNU since the mid-1980's, coordinator of GNU Chess (original author), GNU Shogi, GNU Go. Ported GNU Emacs to Solaris (System V Release 4). Expertise in C, Emacs Lisp, and Perl. Customized programming also available. Entered: 5Apr94  Cygnus Support 1937 Landings Drive ...uunet!cygint!info Mountain View, CA 94043 USA +1 415 903 1400 voice +1 415 903 0122 fax Cygnus Support 48 Grove Street Somerville, MA 02144 +1 617 629 3000 voice +1 617 629 3010 fax Cygnus Support continues to provide supported, maintained versions of the GNU toolset including GCC, G++, the GNU debugger with graphical user interface, GNU linker, GNU macro-assembler and Emacs 19. In keeping with the rapidly advancing needs of software developers, Cygnus maintains a 90 day release cycle of the GNU toolset. Each release is regression tested and includes substantial improvements and additions to the existing matrix of over 65 supported platform configurations. Updated: 2Feb95  Free Software Association of Germany Michaela Merz Heimatring 19 6000 Frankfurt/Main 70 phone: (+49 69) 6312083) ert : (+49-172-6987246) email: (info@elara.fsag.de) Supporting all kinds of freeware (i.e. GNU), freeware development, consulting, training, installation. Special LINUX support group. RATES: Companies and for profit organizations : 100 US$ / hour Private and not-for-profit organizations : 40 US$ / hour ert (24h Emergency response team) : 300 US$ / hour Entered: 14Apr94  Noah Friedman Building 600, Suite 214 2002-A Guadalupe St. #214 One Kendall Square Austin, TX 78705 Cambridge, MA 02139 (Local, faster to reach me) (Permanent) Author of several Emacs Lisp packages and parts of Emacs 19, as well as numerous utilities written in shell script and perl. Co-maintained GNU Texinfo and Autoconf for a couple of years. System administrator for a network of heterogenous machines. FSF employee Feb 1991--Sep 1994. I can perform installation, porting, and enhancement of all GNU software and any other free software; system administration for unix-type systems and ethernet networks; and I am willing to teach shell programming and Emacs Lisp. Fees negotiable, averaging $60-$75/hour. I can work in the Austin, TX area or anywhere accessible on the Internet. For larger jobs I may be willing to travel. Updated: 16Aug95  Ronald F. Guilmette Infinite Monkeys & Co. 1751 East Roseville Pkwy. #1828 Roseville, CA 95661 Tel: +1 916 786 7945 FAX: +1 916 786 5311 Services: Development & porting of GNU software development tools. GNU Contributions: Invented, designed, and implemented the protoize and unprotoize tools supplied with GCC2. Designed and developed all code to support the generation of Dwarf symbolic debugging information for System V Release 4 in GCC2. Performed original port of GNU compilers to SVr4 system. Finished port of GNU compilers to Intel i860 RISC processor. Experience: 13+ years UNIX systems experience, all working on compilers and related tools. 7+ years working professionally on GCC, G++, and GDB under contract to various firms including the Microelectronics and Computer Technology Corporation (MCC), Data General (DG), Network Computing Devices (NCD), and Intel Corp. Other qualifications: Developer of the RoadTest (tm) C and C++ commercial compiler test suites. Former vice-chairman of UNIX International Programming Languages Special Interest Group (UI/PLSIG). Bachelor's and a Master's degrees, both in Computer Science. Rates: Variable depending upon contract duration. Call for quote. Updated: 23Sep95  Hundred Acre Consulting 1155 W Fourth St Ste 225 PO Box 6209 Reno NV 89513-6209 (702)-348-7299 Hundred Acre is a consulting group providing support and development services to organizations of all sizes. We support GNU C++ and C in particular, but also provide support for all other GNU software and certain non-GNU public domain software as well. We work on a "service contract" basis for support -- for a yearly fee, we provide multiple levels of email and toll free telephone support, and free updates and bug fixes. The highersupport levels have on-site support. Development is charged on either an hourly or fixed bid basis. Consulting rates: $70 to $90 per hour, or fixed bid. Support contracts: Several levels, from $495 to $90000 per year. Updated: 27Dec94  Interactive Information Limited Interactive Information Limited is an Edinburgh-based company that specialises in WWW services and support for using the Internet for marketing. Our staff have many years experience in using, and developing lisp packages within, Emacs, and in using other GNU/Unix tools, particularly under public domain UNIXes. We can provide services throughout the UK, at any level from general consultancy through fetching, installing and customising software to bespoke programming. Fees would be in the range #300 - #600 per day, depending primarily on the size of the job. You can contact us by email: by phone: 0370 30 40 52 (UK) (+44) 370 30 40 52 (International) by post: 3, Lauriston Gardens, Edinburgh EH3 9HH Scotland Entered: 13Nov95  Scott D. Kalter : Dennis Fitzgerald Kaman Sciences has performed a GNU port for a custom RISC processor. We have experience in the definition and description of the machine register transfer language to the GNU tool-set. This includes rewriting and modification of the necessary description and source files of gcc, gas, and gld and other binutils. Kaman also has services for installation and setup of GNU tools, (GAWK, GCC, EMACS, etc.) on Sun workstations. Work is on a "service contract" basis and development is charged either hourly or as a fixed price contract. Consulting rates: $70 to $200 per hour. Entered: 13Jan95  Scott J. Kramer P.O. Box 620207 Woodside, CA 94062 +1 415-941-0755 GNU Software: Tutoring, installations/upgrades, Emacs Lisp customizations, general troubleshooting/support. Prefer that work I do becomes part integrated into official Free Software Foundation distributions. Systems Administration: Sun (SunOS & Solaris) and SGI (IRIX) UNIX hardware/software platforms. Rate: Task- and time-dependent; non-monetary offers accepted. Updated: 12Apr94  Fen Labalme Services: Supply, porting, installation, consultation on all GNU products. Experience: 20 years OS and compiler experience, portations of most GNU products. Author of ported software CD-ROM for Unix 4.2. Rates: Choice of DM 150 per hour or hotline rates 3 DM per minute + 10 DM per phone call. Quick questions may be free. Limited free support available for purchasers of LEMIS CD-ROMs. Updated: 21Feb95  Marty Leisner 332 Shaftsbury Road Rochester, New York 14610 Home:(716) 654-7931 Experience: 12 years C/Unix, 7 years DOS. Extensive experience with GNU binary tools, cross-compilers, embedded/hosted systems, realtime. Degree : BS CS, Cornell University Rates: $75/hr marty Updated: 15Apr94  Richard Levitte (in TeX: Richard Levitte Södra Långgatan 39, II S\"odra L{\aa}nggatan 39, II S-171 49 Solna S-171 49 Solna Sweden Sweden) Tel.nr.: +46 (8) 18 30 99 (there is an answering machine) e-mail: (preferred) What I do: Primarly I work on GNU software for VMS, both VAX and AXP. I also work on GNU stuff for Unix on occasion. I'm familiar with SunOS (version 4.x.x), BSD (version 4.2 and up), Ultrix (version 4.2 and up). I've been porting GNU Emacs to VMS since spring 1991. This includes versions 18.57 to 18.59 and version 19.22. I maintain GNU vmslib. Programs supported: GNU vmslib: extending, installation, upgrading aid, simple and complex questions, you name it. GNU Emacs: porting, extending, installation, upgrading aid, customization, simple or complex questions, training, you name it. GNU autoconf: porting, extending, installation, upgrading aid. GNU zip, diffutils, m4, patch, texinfo: porting, installation, upgrading aid. GNU C/C++: installation, upgrading aid. I might start to hack at it some day. The list of programs I currently support represents both my interests and current priorities. Your interest and funding can influence my priorities. Experience: Fluent in C, C++, Emacs Lisp, Pascal as well as assembler on VAX, Motorola 680x0, Intel 8086 and 80x86. Modified key elements in Emacs (e.g., memory and process management) to work transparently on VMS. I have very good knowledge in the VMS operating system, as well as MS-DOS and IBM PC compatibles. I have worked for four and a half years as a VMS system manager. I've also provided consulting services on IBM PC compatibles, as well as held classes for IBM PC users. A reference list is available on request. Your Rate: $50-$80/hour (400-700 SEK in sweden), plus expenses. My rates are negotiable, depending on how interesting the project is to me. Entered: 18Aug94  Roland McGrath 545 Tech Sq, Rm 426 Cambridge, MA 02139 Work: (617) 253-8568 Co-author of GNU Make (with Richard Stallman); maintainer of GNU Make. Author and maintainer of the GNU C Library and co-author of the GNU Hurd. Author of several GNU Emacs Lisp packages and parts of GNU Emacs 19. FSF employee summer 1989, fall 1990 to the present. Installation, maintenance, porting, enhancement of all GNU software. I can install GNU software and maintain its installation on call via the Internet. Fees negotiable; $75-$100/hour, higher for very short term projects. I can work anywhere in the Boston or SF Bay Area, or anywhere on the Internet. I am working full-time for the FSF on the GNU Hurd, so I am likely to take on only jobs that either can be done entirely via the Internet and are short-term, or that are very interesting. Updated: 21Jan95  Wolfgang S. Rupprecht 47 Esparito Ave. Fremont, CA 94539-3827 (510) 659-9757 Anything, (lisp, C, customization, porting, installing) I have written thousands of lines of GNU Emacs C and Lisp code. Original author of the floating point additions in Emacs 19. Rates: $95/hr. Updated: 14Apr94  Signum Support AB Box 2044 _ ...!seunet!signum!info S-580 02 Linkoping, Sweden +46 13 21 46 00 voice +46 13 21 47 00 fax Signum Support AB is a company dedicated to supporting, developing and distributing free software for, including but not limited to, UNIX systems. The people behind Signum Support AB have many years of general UNIX experience, both as system administrators and as programmers, and also extensive experience in maintaining the GNU programs, both administrating it and finding and fixing bugs. Services offered: - Installation and customizing GNU and other free software. We will make free software as easy to install and use as shrink wrapped programs. - Warranty protection. - Customization and porting. - Subscriptions to new versions which we will send monthly or with any other interval. - Finding, Recommending and Investigation of free software in any area of the customers choise. - Regular consulting. Rates: For software items, request our price list. For consulting, 400-800 SEK/hour. Updated: 14Apr94  Small Business Systems, Inc. Box 17220, Route 104 Esmond, RI 02917 401.273.4669 Rate: Varies depending on complexity of task. Hourly and fixed-rate contracts are available. Programs Supported: All Updated: 14Apr94  Julian H. Stacey. Vector Systems Ltd, Holz Strasse 27d, D 80469 Munich (Muenchen), GERMANY. Tel. +49 89 268616 (089 268616 in Germany) 09:00-21:00 Timezone=GMT+01:00 Sources: All FSF/GNU, FreeBSD-current, X-Windows, XFree86, NetBSD, Mach, etc. (Plus various other things, such as, but not limited to: blas blt cflow CAD cnews crypt dvi2lj eispack elm encryption expect ezd f2c flexfax gic gopher info-zip ingres inn jpeg kermit ksh less lha linpack md5 mh mprof mtools mush nntp octave pbmplus popper sather sc schemetoc slurp sml spreadsheet sup tcl tcl-dp tcsh tcx term tex tiff tk top trn unarj ups urt wine xlock xv xview xxgdb zmodem zip zircon zoo zsh.) Media: QIC 1/4" Cartridge 525M, 150M, & 60M, TEAC CAS-60 60M Cassette, CD-ROM, Floppies 1.4M & 1.2 & 720K & 360K. DAT arrangeable. Postal Service C.O.D.(=`Nachnahme') or pre payment available. Commercial Consultancy: Custom Designs, Provision & support of FreeBSD or Unix, C, FSF tools, X Windows, own tools, systems engineering, hardware interfacing, multi lingual European, Cyrillic & Chinese tools & systems, Unix, MSDOS, real time etc, communications & scientific & industrial. DEUTSCH + FRANCAIS: Man kann mir in Deutsch schreiben, (oder mich anrufen). Je comprend Francais, mais je n'ecris pas des responses en Francais. (Contact me in English, German, or French). FREE for Symmetric Computer Systems Model 375 owners: Free Binaries & sources on SCS/375's TEAC 50/60M Cassette, for: GCC-1.40, UUCP-1.4, Ghostscript 2.3, Tar-1.08, Gzip-1.2.2 etc. (Native SCS compiler can't compile GCC on this NSC32016 based BSD4.2) On Request: Resume, Company Profile, Index of public & proprietary tools, Rate: ~120 DM/hour. ~100DM/Cartridge. (1.5DM = $1 USA = 0.6 UK Pounds @4/'94) Short enquiries free. (Kurze Anfragen Ohne Gebuhr). Updated: 14Jun94  Richard M. Stallman UUCP: {mit-eddie,ucbvax,uunet,harvard,uw-beaver}!ai.mit.edu!rms 545 Tech Sq, Rm 430 Cambridge, MA 02139 Emacs: anything whatever Is anyone interested in courses in using or extending GNU Emacs? Original inventor of Emacs and main author of GNU Emacs and GCC. Rates: $6/min or $250/hr. Updated: 14Apr94  JoS-Ware Comp Tech Johan Svensson Box 739 220 07 LUND SWEDEN Tel +46-46-104505 (Dept. of Economics, University of LUND) Fax +46-46-188445 (JoS-Ware Comp Tech) What: We offer consulting services regarding installation, customization, troubleshooting, porting and integration of all free software, including GNU software. Spec.: Network integration, integration of public domain software into commercial systems, WorldWideWeb, C, X-Windows, Linux, networked information systems How: Remote login over internet, email, modem, phone, personal visits (in southern Sweden mainly) Rates: 550SEK (+ tax) per hour within Sweden 370SEK (+ tax) per hour within Sweden for educational org. US $90 per hour outside Sweden US $70 per hour outside Sweden for educational org. Note: fees may vary and special arrangements may be considered Entered: 7Apr94  Kayvan Sylvan Sylvan Associates 879 Lewiston Drive San Jose, CA 95136 Phone: 408-978-1407 I will help you port, install and customize GNU Emacs, GCC, G++, bison, and other GNU tools on almost any architechture and operating system. Questions answered. GNU C and lisp hacking available. I will also do ongoing support and periodic upgrades if you get on my GNU software subscription list. Rates: $60-$100/hour, depending on type of work. Substantial discounts for long-term contracts and also for educational or non-profit institutions. Experience: Many different Unix systems (2.9BSD to 4.4BSD, SVR3 and SVR4, Linux, Xenix). Systems programming and system administration on all brands of Unix. Kernel hacking experience. Lots of porting experience. I can port anything to anything (within reason). Updated: 14Apr94  Leonard H. Tower Jr. 36 Porter Street Somerville, MA 02143, USA +1 (617) 623-7739 Will work on most GNU software. Installation, handholding, trouble shooting, extensions, teaching. Rates: 100.00/hour + travel expenses. Negotiable for non-profits. Experience: Have hacked on over a dozen architectures in many languages. Have system mothered several varieties of Unixes. Assisted rms with the front end of gcc and it's back-end support. Resume available on request. Entered: 14Apr94  UrbanSoft AO 68 Malooktinskii Prospect St. Petersburg, Russia 195272 Custom GhostScript and TeX programming by e-mail. Database documents, directories, standard forms. UrbanSoft uses a portion of its revenues to contribute diskette distributions of GNU software to Russian universities (most of which lack FTP access). Rates: 30,000 rubles (currently USD 16.80) per hour. Fixed rate contracts also possible. Payable by bank transfer. Updated: 20Apr94  noris network Matthias Urlichs Schleiermacherstrasse 12 90491 Nuernberg Germany Phone: +49 911 9959621 Fax: +49 911 5980150 http://info.noris.de/ (German) Expertise: OS internals, esp. Linux and BSD, esp. device drivers Network protocol / program design and coding Utilities coding and maintainance Program debugging, testing User interface design and testing Several programming and tool languages Services: Installation, debugging, enhancement, distribution, for all kinds of free software. System administration for most Unix-like systems. Email, Fax, phone, and in-person consulting (and/or "question answering"). Remote support and system monitoring (over the Internet), Update service (new tools tested and installed automagically) Internet access Rates: DM 110 (~$70) per hour Support contracts start at DM 170/month + DM 30/supported system. Willing to travel for sufficiently large jobs. Rates don't include taxes. Entered: 16Aug94  Joe Wells Postal Address: care of: Boston University Computer Science Department 111 Cummington Street, Room 138 Boston, Massachusetts 02215 Work Telephone: (617) 353-3381 (sorry, but no answering machine or voice mail) Home Telephone: (617) 739-7456 (until August 1995) Finger "jbw@cs.bu.edu" for up-to-date contact information. Experience: I have B.A. and M.A. degrees in Computer Science and have completed all but the dissertation for a Ph.D. in C.S. My research for my Ph.D. is in the areas of logic, type systems, and programming language theory. My primary programming languages are Emacs Lisp, Perl, and Bourne shell, but of course I can program in any language. I have written numerous Emacs Lisp packages. I started the USENET "List of Frequently Asked Questions about GNU Emacs with Answers" and maintained it for more than two years. Most of my work has been related to the telephone system (modems, voice mail, etc.), but I am not limited to that. Send e-mail for my complete resume or curriculum vita. Programs supported: GNU Emacs and Taylor UUCP: Installation, training, customization, bug fixing, troubleshooting, extension, development, porting, or answering any kind of question. Any other GNU program: The same things, but I don't necessarily have huge amounts of experience with the particular program. Working conditions: I am usually available for part-time work (less than 20 hours per week including any travel time). I can sometimes make time for full-time work for a month or two; please inquire. I can either work in or near Boston or via the Internet or via telephone; travel outside the Boston metropolitan area can be negotiated. My schedule is very flexible. Any programs I write will normally have the copying conditions of the GNU General Public License; this is negotiable. Rates: $65/hour as an independent contractor. travel and telephone expenses. higher rates if extensive travel is required. Updated: 27Sep94.  Herb Wood phone: 1-415-789-7173 email: I'm a better "planner" than I am a hacker. A really good hacker will be able to keep many pieces of information in their short-term memory and to memorize new pieces of information at a fast rate. This is not my strong point. Rather, I excel in domains that require knowledge of the slightly more theoretical parts of computer science --for example, logic, formal methods of program development, and functional programming. I can write, and I have "tutoring" (teaching one-on-one) experience, an, unlike some programmers, I enjoy doing these things. I have spend a lot of time looking at the Emacs Lisp sources and customizing Emacs and VM. I think I can customize Emacs and its packages quickly and effectively. Entered: 30Jul95  Yggdrasil Computing, Inc./ Freesoft, Inc. 4880 Stevens Creek Blvd. Ste. 205 San Jose, CA 95129 (408) 261-6630 (800) 261 6630 Updated: 14Apr94  For a current copy of this directory, or to have yourself listed, ask: gnu@prep.ai.mit.edu ** Please keep the entries in this file alphabetical ** emacs-19.30/etc/SUN-SUPPORT100666 13437 13 20630 5405340660 13340 0ustar jimbuserNOTE: the Free Software Foundation agreed to put this file, and the programs it describes, into the Emacs distribution ONLY on the condition that we would not lift a finger to maintain them! We are willing to *pass along* support for Sun windows, but we are not willing to let it distract us from what we are trying to do. If you have complaints or suggestions about Sun windows support, send them to peck@sun.com, who is the maintainer. The interface between GNU Emacs and Sun windows consists of the program etc/emacstool, the Lisp programs lisp/sun-*.el and lisp/term/sun.el, and the C source file src/sunfns.c. It is documented with a man page, etc/emacstool.1. To enable use of these files and programs, define the configuration switch HAVE_SUN_WINDOWS in src/config.h before compiling Emacs. The definition of HAVE_SUN_WINDOWS must precede the #include m-sun3.h or #include m-sun4.h. If you must change PURESIZE, do so after the #include m-sun3.h This software is based on SunView for Sun UNIX 4.2 Release 3.2, and will not work "as is" on previous releases, eg 3.0 or 3.1. Using Emacstool with GNU Emacs: The GNU Emacs files lisp/term/sun.el, lisp/sun-mouse.el, lisp/sun-fns.el, and src/sunfns.c provide emacs support for the Emacstool and function keys. If your terminal type is SUN (that is, if your environment variable TERM is set to SUN), then Emacs will automatically load the file lisp/term/sun.el. This, in turn, will ensure that sun-mouse.el is autoloaded when any mouse events are detected. It is suggested that sun-mouse and sun-fns be included in your site-init.el file, so that they will always be loaded when running on a Sun workstation. [Increase PURESIZE to 154000]. Support for the Sun function keys requires disconnecting the standard Emacs command Meta-[. Therefore, the function keys are supported only if you do (setq sun-esc-bracket t) in your .emacs file. The file src/sunfns.c defines several useful functions for emacs on the Sun. Among these are procedures to pop-up SunView menus, put and get from the SunView selection [STUFF] buffer, and a procedure for changing the cursor icon. If you want to define cursor icons, try using the functions in lisp/sun-cursors.el. The file lisp/sun-mouse.el includes a mass of software for defining bindings for mouse events. Any function can be called or any form evaluated as a result of a mouse event. If you want a pop-up menu, your function can call sun-menu-evaluate. This will bring up a SunView walking menu of your choice. Use the macro (defmenu menu-name &rest menu-items) to define menu objects. Each menu item is a cons of ("string" . VALUE), VALUE is evaluated when the string item is picked. If VALUE is a menu, then a pullright item is created. This version also includes support for copying to and from the sun-windows "stuff" selection. The keyboard bindings defined in lisp/sun-fns.el let you move the current region to the "STUFF" selection and vice versa. Just set point with the left button, set mark with the middle button, (the region is automatically copied to "STUFF") then switch to a shelltool, and "Stuff" will work. Going the other way, the main right button menu contains a "Stuff Selection" command that works just like in shelltool. [The Get and Put function keys are also assigned to these functions, so you don't need the mouse or even emacstool to make this work.] Until someone write code to read the textsw "Selection Shelf", it is not possible to copy directly from a textsw to emacs, you must go through the textsw "STUFF" selection. The Scroll-bar region is not a SunView scrollbar. It really should be called the "Right-Margin" region. The scroll bar region is basically the rightmost five columns (see documentation on variable scrollbar-width). Mouse hits in this region can have special bindings, currently those binding effect scrolling of the window, and so are referred to as the "Scroll-bar" region. For information on what mouse bindings are in effect, use the command M-x Describe-mouse-bindings, or the quick pop-up menu item "Mouse-Help". GNU Emacs EXAMPLES: See definitions in lisp/sun-fns.el for examples. You can redefine the cursor that is displayed in the emacs window. On initialization, it is set to a right arrow. See lisp/sun-cursors.el for additional cursors, how to define them, how to edit them. BUGS: It takes a few milliseconds to create a menu before it pops up. Someone who understands the GNU Garbage Collector might see if it is possible for defmenu to create a SunView menu struct that does not get destroyed by Garbage Collection. An outline of the files used to support Sun Windows and the mouse. etc/SUN-SUPPORT. This document. etc/emacstool.1: Added: an nroff'able man page for emacstool. etc/emacstool.c: Encodes all the function keys internally, and passes non-window system arguments to emacs. etc/emacs.icon: The "Kitchen Sink" GNU Emacs icon. src/sunfns.c: This contains the auxiliary functions that allow elisp code to interact with the sunwindows, selection, and menu functions. lisp/sun-mouse.el: Defines the lisp function which is called when a mouse hit is found in the input queue. This handler decodes the mouse hit via a keymap-like structure sensitive to a particular window and where in the window the hit occurred (text-region, right-margin, mode-line). Three variables are bound (*mouse-window* *mouse-x* *mouse-y*) and the selected function is called. See documentation on "define-mouse" or look at lisp/sun-fns.el to see how this is done. Defines two functions to pass between region and sun-selection Defines functions for interfacing with the Menu. During menu evaluation, the variables *menu-window* *menu-x* *menu-y* are bound. lisp/sun-fns.el The definition of the default menu and mouse function bindings. lisp/sun-cursors.el Defines a number of alternate cursors, and an editor for them. The editor is also a demonstration of mouse/menu utilization. lisp/term/sun.el Sets up the keymap to make the sun function keys do useful things. Also includes the setup/initialization code for running under emacstool, which makes "\C-Z" just close the emacstool window (-WI emacs.icon). Jeff Peck, Sun Microsystems, Inc Subject: Making multi-line scrolling really work: In your .defaults file, include the line: /Tty/Retained "Yes" That way, the terminal emulator can do text moves using bitblt, instead of repaint. If that's not enough for you, then tell unix and emacs that the sun terminal supports multi-line and multi-character insert/delete. Add this patch to your /etc/termcap file: *** /etc/termcap.~1~ Mon Sep 15 12:34:23 1986 --- /etc/termcap Mon Feb 9 17:34:08 1987 *************** *** 32,39 **** --- 32,40 ---- Mu|sun|Sun Microsystems Workstation console:\ :am:bs:km:mi:ms:pt:li#34:co#80:cl=^L:cm=\E[%i%d;%dH:\ :ce=\E[K:cd=\E[J:so=\E[7m:se=\E[m:rs=\E[s:\ :al=\E[L:dl=\E[M:im=:ei=:ic=\E[@:dc=\E[P:\ + :AL=\E[%dL:DL=\E[%dM:IC=\E[%d@:DC=\E[%dP:\ :up=\E[A:nd=\E[C:ku=\E[A:kd=\E[B:kr=\E[C:kl=\E[D:\ :k1=\E[224z:k2=\E[225z:k3=\E[226z:k4=\E[227z:k5=\E[228z:\ :k6=\E[229z:k7=\E[230z:k8=\E[231z:k9=\E[232z: M-|sun-nic|sune|Sun Microsystems Workstation console without insert character:\ If you don't have the program "patch", just add the line: :AL=\E[%dL:DL=\E[%dM:IC=\E[%d@:DC=\E[%dP:\ casetek@crvax.sri.com says: Those of you using GNU Emacs on Sun workstations under 3.2 may be interested in reducing memory utilization in the emacstool via the Sun toolmerge facility. The technique is described in the Release 3.2 Manual starting on page 71. The following is a summary of how it would apply to merging emacstool into the basetools. 1) Change the main procedure declaration in emacstool.c to: #ifdef SUN_TOOLMERGE emacstool_main (argc, argv); #else main (argc, argv) #endif This will allow creation of either standard or toolmerge versions. 2) Copy emacstool.o into directory /usr/src/sun/suntool. 3) make CFLAGS="-g -DSUN_TOOLMERGE" emacstool.o 4) Add the following line to basetools.h "emacstool",emacstool_main, 5) Add the following line to toolmerge.c. extern emacstool_main(); 6) make basetools MOREOBJS="emacstool.o" 7) make install_bins To invoke the toolmerged version, you must exit suntools and re-start it. Make sure that /usr/bin occurs before the directory in which you installed the standard (non-toolmerged) version. emacs-19.30/etc/TERMS100666 13437 1 22065 4732061061 12656 0ustar jimbdaemonThis file describes what you must or might want to do to termcap entries to make terminals work properly and efficiently with Emacs. Information on likely problems with specific types of terminals appears at the end of the file. *** What you want in a terminal *** Vital 1. Easy to compute suitable padding for. 2. Never ever sends ^S/^Q unless you type them, at least in one mode. Nice for speed 1. Supports insert/delete of multiple lines in one command. 2. Same for multiple characters, though doing them one by one is usually fast enough except on emulators running on machines with bitmap screens. Nice for usability 1. Considerably more than 24 lines. 2. Meta key (shift-like key that controls the 0200 bit in every character you type). *** New termcap strings *** Emacs supports certain termcap strings that are not described in the 4.2 manual but appear to be standard in system V. The one exception is `cS', which I invented. `AL' insert several lines. Takes one parameter, the number of lines to be inserted. You specify how to send this parameter using a %-construct, just like the cursor positions in the `cm' string. `DL' delete several lines. One parameter. `IC' insert several characters. One parameter. `DC' delete several characters. One parameter. `rp' repeat a character. Takes two parameters, the character to be repeated and the number of times to repeat it. Most likely you will use `%.' for sending the character to be repeated. Emacs interprets a padding spec with a * as giving the amount of padding per repetition. WARNING: Many terminals have a command to repeat the *last character output* N times. This means that the character will appear N+1 times in a row when the command argument is N. However, the `rp' string's parameter is the total number of times wanted, not one less. Therefore, such repeat commands may be used in an `rp' string only if you use Emacs's special termcap operator `%a-c\001' to subtract 1 from the repeat count before substituting it into the string. It is probably safe to use this even though the Unix termcap does not accept it because programs other than Emacs probably won't look for `rp' anyway. `cs' set scroll region. Takes two parameters, the vertical positions of the first line to include in the scroll region and the last line to include in the scroll region. Both parameters are origin-zero. The effect of this should be to cause a following insert-line or delete-line not to move lines below the bottom of the scroll region. This is not the same convention that Emacs version 16 used. That is because I was led astray by unclear documentation of the meaning of %i in termcap strings. Since the termcap documentation for `cs' is also unclear, I had to deduce the correct parameter conventions from what would make the VT-100's `cs' string work properly. From an incorrect assumption about %i, I reached an incorrect conclusion about `cs', but the result worked correctly on the VT100 and ANSII terminals. In Emacs version 17, both `cs' and %i work correctly. The version 16 convention was to pass, for the second parameter, the line number of the first line beyond the end of the scroll region. `cS' set scroll region. Differs from `cs' in taking parameters differently. There are four parameters: 1. Total number of lines on the screen. 2. Number of lines above desired scroll region. 3. Number of lines below (outside of) desired scroll region. 4. Total number of lines on the screen, like #1. This is because an Ambassador needs the parameters like this. `cr', `do', `le' Emacs will not attempt to use ^M, ^J or ^H for cursor motion unless these capabilities are present and say to use those characters. `km' Says the terminal has a Meta key. Defining these strings is important for getting maximum performance from your terminal. Make sure that the `ti' string sets all modes needed for editing in Emacs. For example, if your terminal has a mode that controls wrap at the end of the line, you must decide whether to specify the `am' flag in the termcap entry; whichever you decide, the `ti' string should contain commands to set the mode that way. (Emacs also sends the `vs' string after the `ti' string. You can put the mode-setting commands in either one of them.) *** Specific Terminal Types *** Watch out for termcap entries for Ann Arbor Ambassadors that give too little padding for clear-screen. 7.2 msec per line is right. These are the strings whose padding you probably should change: :al=1*\E[L:dl=1*\E[M:cd=7.2*\E[J:cl=7.2*\E[H\E[J: I have sometimes seen `\E[2J' at the front of the `ti' string; this is a clear-screen, very slow, and it can cause you to get Control-s sent by the terminal at startup. I recommend removing the `\E[2J' from the `ti' string. The `ti' or `vs' strings also usually need stuff added to them, such as \E[>33;52;54h\E[>30;37;38;39l You might want to add the following to the `te' or `ve' strings: \E[>52l\E[>37h The following additional capabilities will improve performance: :AL=1*\E[%dL:DL=1*\E[%dM:IC=4\E[%d@:DC=4\E[%dP:rp=1*%.\E[%a-c\001%db: If you find that the Meta key does not work, make sure that :km: is present in the termcap entry. Watch out for termcap entries for VT100's that fail to specify the `sf' string, or that omit the padding needed for the `sf' and `sr' strings (2msec per line affected). What you need is :sf=2*^J:sr=2*\EM:cs=\E[%i%d;%dr: The Concept-100 and Concept-108 have many modes that `ti' strings often fail to initialize. If you have problems on one of these terminals, that is probably the place to fix them. These terminals can support an `rp' string. Watch out on HP terminals for problems with standout disappearing on part of the mode line. These problems are due to the absence of :sg#0: which some HP terminals need. The vi55 is said to require `ip=2'. The Sun console should have these capabilities for good performance. :AL=\E[%dL:DL=\E[%dM:IC=\E[%d@:DC=\E[%dP: The vt220 needs to be set to vt220 mode, 7 bit, space parity in order to work fully with TERM=vt220. If you are using a LAT terminal concentrator, you need to issue these commands to turn off flow control: set port flow control disable define port flow control disable On System V, in the terminfo database, various terminals may have the `xt' flag that should not have it. `xt' should be present only for the Teleray 1061 or equivalent terminal. In particular, System V for the 386 often has `xt' for terminal type AT386 or AT386-M, which is used for the console. You should delete this flag. Here is how: You can get a copy of the terminfo "source" for at386 using the command: `infocmp at386 >at386.tic'. Edit the file at386.tic and remove the `xt' flag. Then compile the new entry with: `tic at386.tic'. It is also reported that these terminal types sometimes have the wrong reverse-scroll string. It should be \E[T, but sometimes is given as \E[S. Here is what watserv1!maytag!focsys!larry recommends for these terminals: # This copy of the terminfo description has been fixed. # The suggestions came from a number of usenet postings. # # Intel AT/386 for color card with monochrome display # AT386-M|at386-m|386AT-M|386at-m|at/386 console, am, bw, eo, xon, cols#80, lines#25, acsc=``a1fxgqh0jYk?lZm@nEooppqDrrsstCu4vAwBx3yyzz{{||}}~~, bel=^G, blink=\E[5m, bold=\E[1m, cbt=\E[Z, clear=\E[2J\E[H, cr=\r, cub=\E[%p1%dD, cub1=\E[D, cud=\E[%p1%dB, cud1=\E[B, cuf=\E[%p1%dC, cuf1=\E[C, cup=\E[%i%p1%02d;%p2%02dH, cuu=\E[%p1%dA, cuu1=\E[A, dch=\E[%p1%dP, dch1=\E[P, dl=\E[%p1%dM, dl1=\E[1M, ech=\E[%p1%dX,ed=\E[J, el=\E[K, el1=\E[1K\E[X, flash=^G, home=\E[H, hpa=\E[%i%p1%dG, ich=\E[%p1%d@, ich1=\E[1@, il=\E[%p1%dL, il1=\E[1L, ind=\E[S, indn=\E[%p1%dS, invis=\E[9m, is2=\E[0;10;38m, kbs=\b, kcbt=^], kclr=\E[2J, kcub1=\E[D, kcud1=\E[B, kcuf1=\E[C, kcuu1=\E[A, kdch1=\E[P, kend=\E[Y, kf1=\EOP, kf10=\EOY, kf11=\EOZ, kf12=\EOA, kf2=\EOQ, kf3=\EOR, kf4=\EOS, kf5=\EOT, kf6=\EOU, kf7=\EOV, kf8=\EOW, kf9=\EOX, khome=\E[H, kich1=\E[@, knp=\E[U, kpp=\E[V, krmir=\E0, rev=\E[7m, ri=\E[T, rin=\E[%p1%dT, rmacs=\E[10m, rmso=\E[m, rmul=\E[m, sgr=\E[10m\E[0%?%p1%p3%|%t;7%;%?%p2%t;4%;%?%p4%t;5%;%?%p6%t;1%;%?%p9%t;12%;%?%p7%t;9%;m, sgr0=\E[0;10m, smacs=\E[12m, smso=\E[7m, smul=\E[4m, # # AT&T 386 color console # AT386|at386|386AT|386at|at/386 console, colors#8, ncv#3, pairs#64, is2=\E[0;10;39m, op=\E[0m, setb=\E[%?%p1%{0}%=%t40m %e%p1%{1}%=%t44m %e%p1%{2}%=%t42m %e%p1%{3}%=%t46m %e%p1%{4}%=%t41m %e%p1%{5}%=%t45m %e%p1%{6}%=%t43m %e%p1%{7}%=%t47m%;, setf=\E[%?%p1%{0}%=%t30m %e%p1%{1}%=%t34m %e%p1%{2}%=%t32m %e%p1%{3}%=%t36m %e%p1%{4}%=%t31m %e%p1%{5}%=%t35m %e%p1%{6}%=%t33m %e%p1%{6}%=%t33m %e%p1%{7}%=%t37m%;, use=at386-m, # # Color console version that supports underline but maps blue # foreground color to cyan. # AT386-UL|at386-ul|386AT-UL|386at-ul|at/386 console, is2=\E[0;10;38m, use=at386, emacs-19.30/etc/TUTORIAL100444 12120 13 113656 6043626132 12655 0ustar rmsuserCopyright (c) 1985 Free Software Foundation, Inc; See end for conditions. You are looking at the Emacs tutorial. Emacs commands generally involve the CONTROL key (sometimes labelled CTRL or CTL) or the META key (sometimes labelled EDIT or ALT). Rather than write out META or CONTROL each time we want you to prefix a character, we'll use the following abbreviations: C- means hold the CONTROL key while typing the character Thus, C-f would be: hold the CONTROL key and type f. M- means hold the META or EDIT or ALT key down while typing . If there is no META key or equivalent, type , release it, then type the character . "" stands for the key labelled "ESC". Important note: to end the Emacs session, type C-x C-c. (Two characters.) The characters ">>" at the left margin indicate directions for you to try using a command. For instance: <> >> Now type C-v (View next screen) to move to the next screen. (go ahead, do it by depressing the control key and v together). From now on, you'll be expected to do this whenever you finish reading the screen. Note that there is an overlap when going from screen to screen; this provides some continuity when moving through the file. The first thing that you need to know is how to move around from place to place in the file. You already know how to move forward a screen, with C-v. To move backwards a screen, type M-v (depress the META key and type v, or type v if you don't have a META or EDIT key). >> Try typing M-v and then C-v to move back and forth a few times. * SUMMARY --------- The following commands are useful for viewing screenfuls: C-v Move forward one screenful M-v Move backward one screenful C-l Clear screen and redisplay everything putting the text near the cursor at the center. (That's control-L, not control-1.) >> Find the cursor and remember what text is near it. Then type a C-l. Find the cursor again and see what text is near it now. * BASIC CURSOR CONTROL ---------------------- Getting from screenful to screenful is useful, but how do you reposition yourself within a given screen to a specific place? There are several ways you can do this. One way (not the best, but the most basic) is to use the commands previous, backward, forward and next. As you can imagine these commands (which are given to Emacs as C-p, C-b, C-f, and C-n respectively) move the cursor from where it currently is to a new place in the given direction. Here, in a more graphical form are the commands: Previous line, C-p : : Backward, C-b .... Current cursor position .... Forward, C-f : : Next line, C-n >> Move the cursor to the line in the middle of that diagram and type C-l to see the whole diagram centered in the screen. You'll probably find it easy to think of these by letter. P for previous, N for next, B for backward and F for forward. These are the basic cursor positioning commands and you'll be using them ALL the time so it would be of great benefit if you learn them now. >> Do a few C-n's to bring the cursor down to this line. >> Move into the line with C-f's and then up with C-p's. See what C-p does when the cursor is in the middle of the line. Lines are separated by Newline characters. For most applications there should normally be a Newline character at the end of the text, as well, but it is up to you to make sure of this. A file can validly exist without a Newline at the end. >> Try to C-b at the beginning of a line. Do a few more C-b's. Then do C-f's back to the end of the line and beyond. When you go off the top or bottom of the screen, the text beyond the edge is shifted onto the screen so that your instructions can be carried out while keeping the cursor on the screen. >> Try to move the cursor off the bottom of the screen with C-n and see what happens. If moving by characters is too slow, you can move by words. M-f (Meta-f) moves forward a word and M-b moves back a word. >> Type a few M-f's and M-b's. Intersperse them with C-f's and C-b's. Notice the parallel between C-f and C-b on the one hand, and M-f and M-b on the other hand. Very often Meta characters are used for operations related to English text whereas Control characters operate on the basic textual units that are independent of what you are editing (characters, lines, etc). There is a similar parallel between lines and sentences: C-a and C-e move to the beginning or end of a line, and M-a and M-e move to the beginning or end of a sentence. >> Try a couple of C-a's, and then a couple of C-e's. Try a couple of M-a's, and then a couple of M-e's. See how repeated C-a's do nothing, but repeated M-a's keep moving farther. Do you think that this is right? Two other simple cursor motion commands are M-< (Meta Less-than), which moves to the beginning of the file, and M-> (Meta Greater-than), which moves to the end of the file. You probably don't need to try them, since finding this spot again will be boring. On most terminals the "<" is above the comma and you must use the shift key to type it. On these terminals you must use the shift key to type M-< also; without the shift key, you would be typing M-comma. The location of the cursor in the text is also called "point". To paraphrase, the cursor shows on the screen where point is located in the text. Here is a summary of simple moving operations including the word and sentence moving commands: C-f Move forward a character C-b Move backward a character M-f Move forward a word M-b Move backward a word C-n Move to next line C-p Move to previous line C-a Move to beginning of line C-e Move to end of line M-a Move back to beginning of sentence M-e Move forward to end of sentence M-< Go to beginning of file M-> Go to end of file >> Try all of these commands now a few times for practice. Since the last two will take you away from this screen, you can come back here with M-v's and C-v's. These are the most often used commands. Like all other commands in Emacs, these commands can be given arguments which cause them to be executed repeatedly. The way you give a command a repeat count is by typing C-u and then the digits before you type the command. If you have a META or EDIT key, you can omit the C-u if you hold down the META or EDIT key while you type the digits. This is easier, but we recommend the C-u method because it works on any terminal. For instance, C-u 8 C-f moves forward eight characters. >> Try giving a suitable argument to C-n or C-p to come as close as you can to this line in one jump. The only apparent exception to this is the screen moving commands, C-v and M-v. When given an argument, they scroll the screen up or down by that many lines, rather than screenfuls. This proves to be much more useful. >> Try typing C-u 8 C-v now. Did it scroll the screen up by 8 lines? If you would like to scroll it down you can give an argument to M-v. If you are using X Windows, there is probably a rectangular area called a scroll bar at the right hand side of the Emacs window. You can scroll the text by clicking the mouse in the scroll bar. >> Try pressing the middle button at the top of the highlighted area within the scroll bar, then moving the mouse while holding that button down. >> Move the mouse to a point in the scroll bar about three lines from the top, and click the left button a couple of times. Then try the right button a couple of times. * WHEN EMACS IS HUNG -------------------- If Emacs gets into an infinite (or simply very long) computation which you don't want to finish, you can stop it safely by typing C-g. You can also use C-g to discard a numeric argument or the beginning of a command that you don't want to finish. >> Type C-u 100 to make a numeric arg of 100, then type C-g. Now type C-f. How many characters does it move? If you have typed an by mistake, you can get rid of it with a C-g. If you type : then you get a new window appearing on the screen, telling you that M-: is a "disabled command" and asking whether you really want to execute it. The command M-: is marked as disabled because we expect it would confuse beginners and you probably don't want to use it until you know more about Emacs. If you really want to try the M-: command, you could type a Space in answer to the question, and M-: would go ahead. Normally, if you do not want to execute M-:, you would type "n" to answer the question. >> Type :, then type n. * WINDOWS --------- Emacs can have several windows, each displaying its own text. At this stage it is better not to go into the techniques of using multiple windows. But you do need to know how to get rid of extra windows that may appear to display help or output from certain commands. It is simple: C-x 1 One window (i.e., kill all other windows). That is Control-x followed by the digit 1. C-x 1 makes the window which the cursor is in become the full screen, by getting rid of any other windows. >> Move the cursor to this line and type C-u 0 C-l. >> Type Control-h k Control-f. See how this window shrinks, while a new one appears to display documentation on the Control-f command. >> Type C-x 1 and see the documentation listing window disappear. * INSERTING AND DELETING ------------------------ If you want to insert text, just type it. Characters which you can see, such as A, 7, *, etc. are taken by Emacs as text and inserted immediately. Type (the carriage-return key) to insert a Newline character. You can delete the last character you typed by typing . is a key on the keyboard, which may be labeled "Del". In some cases, the "Backspace" key serves as , but not always! More generally, deletes the character immediately before the current cursor position. >> Do this now, type a few characters and then delete them by typing a few times. Don't worry about this file being changed; you won't affect the master tutorial. This is just a copy of it. >> Now start typing text until you reach the right margin, and keep typing. When a line of text gets too big for one line on the screen, the line of text is "continued" onto a second screen line. The backslash at the right margin indicates a line which has been continued. >> Use s to delete the text until the line fits on one screen line again. The continuation line goes away. >> Move the cursor to the beginning of a line and type . This deletes the newline before the line and merges the line onto the previous line. The resulting line may be too long to fit, in which case it has a continuation line. >> Type to reinsert the Newline you deleted. Remember that most Emacs commands can be given a repeat count; this includes characters which insert themselves. >> Try that now -- type C-u 8 * and see what happens. You've now learned the most basic way of typing something in Emacs and correcting errors. You can delete by words or lines as well. Here is a summary of the delete operations: delete the character just before the cursor C-d delete the next character after the cursor M- kill the word immediately before the cursor M-d kill the next word after the cursor C-k kill from the cursor position to end of line M-k kill to the end of the current sentence Notice that and C-d vs M- and M-d extend the parallel started by C-f and M-f (well, isn't really a control character, but let's not worry about that). C-k and M-k are like C-e and M-e, sort of, in that lines are opposite sentences. Now suppose you kill something, and then you decide that you want to get it back? Well, whenever you kill something bigger than a character, Emacs saves it for you. To yank it back, use C-y. You can kill text in one place, move elsewhere, and then do C-y; this is a good way to move text around. Note that the difference between "Killing" and "Deleting" something is that "Killed" things can be yanked back, and "Deleted" things cannot. Generally, the commands that can destroy a lot of text save it, while the ones that attack only one character, or nothing but blank lines and spaces, do not save. For instance, type C-n a couple times to position the cursor at some line on this screen. >> Do this now, move the cursor and kill that line with C-k. Note that a single C-k kills the contents of the line, and a second C-k kills the line itself, and make all the other lines move up. If you give C-k a repeat count, it kills that many lines AND their contents. The text that has just disappeared is saved so that you can retrieve it. To retrieve the last killed text and put it where the cursor currently is, type C-y. >> Try it; type C-y to yank the text back. Think of C-y as if you were yanking something back that someone took away from you. Notice that if you do several C-k's in a row the text that is killed is all saved together so that one C-y will yank all of the lines. >> Do this now, type C-k several times. Now to retrieve that killed text: >> Type C-y. Then move the cursor down a few lines and type C-y again. You now see how to copy some text. What do you do if you have some text you want to yank back, and then you kill something else? C-y would yank the more recent kill. But the previous text is not lost. You can get back to it using the M-y command. After you have done C-y to get the most recent kill, typing M-Y replaces that yanked text with the previous kill. Typing M-y again and again brings in earlier and earlier kills. When you have reached the text you are looking for, you can just go away and leave it there. If you M-y enough times, you come back to the starting point (the most recent kill). >> Kill a line, move around, kill another line. Then do C-y to get back the second killed line. Then do M-y and it will be replaced by the first killed line. Do more M-y's and see what you get. Keep doing them until the second kill line comes back, and then a few more. If you like, you can try giving M-y positive and negative arguments. * UNDO ------ Any time you make a change to the text and wish you had not done so, you can undo the change (return the text to its previous state) with the undo command, C-x u. Normally, C-x u undoes one command's worth of changes; if you repeat the C-x u several times in a row, each time undoes one more command. There are two exceptions: commands that made no change (just moved the cursor) do not count, and self-inserting characters are often lumped together in groups of up to 20. This is to reduce the number of C-x u's you have to type. >> Kill this line with C-k, then type C-x u and it should reappear. C-_ is another command for undoing; it is just the same as C-x u but easier to type several times in a row. The problem with C-_ is that on some keyboards it is not obvious how to type it. That is why C-x u is provided as well. On some DEC terminals, you can type C-_ by typing / while holding down CTRL. Illogical, but what can you expect from DEC? Giving a numeric argument to C-_ or C-x u is equivalent to repeating it as many times as the argument says. * FILES ------- In order to make the text you edit permanent, you must put it in a file. Otherwise, it will go away when your invocation of Emacs goes away. You put your editing in a file by "finding" the file. What finding means is that you see the contents of the file in your Emacs; and, loosely speaking, what you are editing is the file itself. However, the changes still don't become permanent until you "save" the file. This is so you can have control to avoid leaving a half-changed file around when you don't want to. Even then, Emacs leaves the original file under a changed name in case your changes turn out to be a mistake. If you look near the bottom of the screen you will see a line that begins and ends with dashes, and contains the string "Emacs: TUTORIAL". Your copy of the Emacs tutorial is called "TUTORIAL". Whatever file you find, that file's name will appear in that precise spot. The commands for finding and saving files are unlike the other commands you have learned in that they consist of two characters. They both start with the character Control-x. There is a whole series of commands that start with Control-x; many of them have to do with files, buffers, and related things, and all of them consist of Control-x followed by some other character. Another thing about the command for finding a file is that you have to say what file name you want. We say the command "reads an argument from the terminal" (in this case, the argument is the name of the file). After you type the command C-x C-f Find a file Emacs asks you to type the file name. It echoes on the bottom line of the screen. You are using the minibuffer now! this is what the minibuffer is for. When you type to end the file name, the minibuffer is no longer needed, so it disappears. >> Type C-x C-f, then type C-g. This cancels the minibuffer, and also cancels the C-x C-f command that was using the minibuffer. So you do not find any file. In a little while the file contents appear on the screen. You can edit the contents. When you wish to make the changes permanent, issue the command C-x C-s Save the file The contents of Emacs are written into the file. The first time you do this, the original file is renamed to a new name so that it is not lost. The new name is made by appending "~" to the end of the original file's name. When saving is finished, Emacs prints the name of the file written. You should save fairly often, so that you will not lose very much work if the system should crash. >> Type C-x C-s, saving your copy of the tutorial. This should print "Wrote .../TUTORIAL" at the bottom of the screen. On VMS it will print "Wrote ...[...]TUTORIAL." NOTE: On some systems, typing C-x C-s will freeze the screen and you will see no further output from Emacs. This indicates that an operating system "feature" called "flow control" is intercepting the C-s and not letting it get through to Emacs. To unfreeze the screen, type C-q. Then see the section "Spontaneous Entry to Incremental Search" in the Emacs manual for advice on dealing with this "feature". To make a new file, just find it "as if" it already existed. Then start typing in the text. When you ask to "save" the file, Emacs will really create the file with the text that you have inserted. From then on, you can consider yourself to be editing an already existing file. * BUFFERS --------- If you find a second file with C-x C-f, the first file remains inside Emacs. You can switch back to it by finding it again with C-x C-f. This way you can get quite a number of files inside Emacs. The object inside Emacs which holds the text read from one file is called a "buffer." Finding a file makes a new buffer inside Emacs. To see a list of the buffers that exist in Emacs, type C-x C-b List buffers >> Try C-x C-b now. See how each buffer has a name, and it may also have a file name for the file whose contents it holds. Some buffers do not correspond to files. For example, the buffer named "*Buffer List*" does not have any file. It is the buffer which contains the buffer list that was made by C-x C-b. ANY text you see in an Emacs window has to be in some buffer. >> Type C-x 1 to get rid of the buffer list. If you make changes to the text of one file, then find another file, this does not save the first file. Its changes remain inside Emacs, in that file's buffer. The creation or editing of the second file's buffer has no effect on the first file's buffer. This is very useful, but it also means that you need a convenient way to save the first file's buffer. It would be a nuisance to have to switch back to it with C-x C-f in order to save it with C-x C-s. So we have C-x s Save some buffers C-x s goes through the list of all the buffers you have and finds the ones that contain files you have changed. For each such buffer, C-x s asks you whether to save it. * EXTENDING THE COMMAND SET --------------------------- There are many, many more Emacs commands than could possibly be put on all the control and meta characters. Emacs gets around this with the X (eXtend) command. This comes in two flavors: C-x Character eXtend. Followed by one character. M-x Named command eXtend. Followed by a long name. These are commands that are generally useful but used less than the commands you have already learned about. You have already seen two of them: the file commands C-x C-f to Find and C-x C-s to Save. Another example is the command to tell Emacs that you'd like to stop editing and get rid of Emacs. The command to do this is C-x C-c. (Don't worry; it offers to save each changed file before it kills the Emacs.) C-z is the command to exit Emacs *temporarily*--so that you can go back to the same Emacs session afterward. On systems which allow it, C-z exits from Emacs to the shell but does not destroy the Emacs; if you use the C shell, you can resume Emacs with the `fg' command (or, more generally, with `%emacs', which works even if your most recent job was some other). On systems which don't implement suspending, C-z creates a subshell running under Emacs to give you the chance to run other programs and return to Emacs afterward; it does not truly "exit" from Emacs. In this case, the shell command `exit' is the usual way to get back to Emacs from the subshell. The time to use C-x C-c is when you are about to log out. It's also the right thing to use to exit an Emacs invoked under mail handling programs and other random utilities, since they may not know how to cope with suspension of Emacs. On other occasions, use C-z, and resume the Emacs when you have more editing to do. There are many C-x commands. The ones you know are: C-x C-f Find file. C-x C-s Save file. C-x C-b List buffers. C-x C-c Quit Emacs. C-x u Undo. Named eXtended commands are commands which are used even less frequently, or commands which are used only in certain modes. These commands are usually called "functions". An example is the function replace-string, which globally replaces one string with another. When you type M-x, Emacs prompts you at the bottom of the screen with M-x and you should type the name of the function you wish to call; in this case, "replace-string". Just type "repl s" and Emacs will complete the name. End the command name with . Then type the two "arguments"--the string to be replaced, and the string to replace it with--each one ended with a Return. >> Move the cursor to the blank line two lines below this one. Then type M-x repl schangedaltered. Notice how this line has changed: you've replaced the word c-h-a-n-g-e-d with "altered" wherever it occurred after the cursor. * AUTO SAVE ----------- When you have made changes in a file, but you have not saved them yet, they could be lost if your computer crashes. To protect you from this, Emacs writes "auto save" files periodically. The auto save file name has a # at the beginning and the end; for example, if your file is named "hello.c", its auto save file's name is "#hello.c#". When you save the file in the normal way, its auto save file is no longer necessary so Emacs deletes it. If the computer crashes, you can recover your auto-saved editing by finding the file normally (the file you were editing, not the auto save file) and then typing M-x recover file. When it asks for confirmation, type yes to go ahead and recover the auto-save data. * MODE LINE ----------- If Emacs sees that you are typing commands slowly it shows them to you at the bottom of the screen in an area called the "echo area." The echo area contains the bottom line of the screen. The line immediately above it is called the MODE LINE. The mode line says something like --**-Emacs: TUTORIAL (Fundamental)--58%---------------------- This is a very useful "information" line. You already know what the filename means--it is the file you have found. What the --NN%-- means is that NN percent of the file is above the top of the screen. If the top of the file is on the screen, it will say --Top-- instead of --00%--. If the bottom of the file is on the screen, it will say --Bot--. If you are looking at a file so small it all fits on the screen, it says --All--. The stars near the front mean that you have made changes to the text. Right after you visit or save a file, there are no stars, just dashes. The part of the mode line inside the parentheses is to tell you what modes you are in. The default mode is Fundamental which is what you are in now. It is an example of a "major mode". There are several major modes in Emacs for editing different languages and text, such as Lisp mode, Text mode, etc. At any time one and only one major mode is active, and its name can always be found in the mode line just where "Fundamental" is now. Each major mode makes a few commands behave differently. For example, there are commands for creating comments in a program, and since each programming language has a different idea of what a comment should look like, each major mode has to insert comments differently. Each major mode is the name of an extended command, which is how you get into the mode. For example, M-x fundamental-mode is how to get into Fundamental mode. If you are going to be editing English text, such as this file, you should probably use Text Mode. >> Type M-x text-mode. Don't worry, none of the commands you have learned changes Emacs in any great way. But you can observe that apostrophes are now part of words when you do M-f or M-b. Major modes are usually like that: commands don't change into completely unrelated things, but they work a little bit differently. To get documentation on your current major mode, type C-h m. >> Use C-u C-v once or more to bring this line near the top of screen. >> Type C-h m, to see how Text mode differs from Fundamental mode. >> Type C-x 1 to remove the documentation from the screen. Major modes are called major because there are also minor modes. They are called minor because they aren't alternatives to the major modes, just minor modifications of them. Each minor mode can be turned on or off by itself, regardless of what major mode you are in, and regardless of the other minor modes. So you can use no minor modes, or one minor mode, or any combination of several minor modes. One minor mode which is very useful, especially for editing English text, is Auto Fill mode. When this mode is on, Emacs breaks the line in between words automatically whenever the line gets too long. You can turn this mode on by doing M-x auto-fill-mode. When the mode is on, you can turn it off by doing M-x auto-fill-mode. If the mode is off, this function turns it on, and if the mode is on, this function turns it off. This is called "toggling". >> Type M-x auto-fill-mode now. Then insert a line of "asdf " over again until you see it divide into two lines. You must put in spaces between them because Auto Fill breaks lines only at spaces. The margin is usually set at 70 characters, but you can change it with the C-x f command. You should give the margin setting you want as a numeric argument. >> Type C-x f with an argument of 20. (C-u 2 0 C-x f). Then type in some text and see Emacs fill lines of 20 characters with it. Then set the margin back to 70 using C-x f again. If you makes changes in the middle of a paragraph, Auto Fill mode does not re-fill it for you. To re-fill the paragraph, type M-q (Meta-q) with the cursor inside that paragraph. >> Move the cursor into the previous paragraph and type M-q. * SEARCHING ----------- Emacs can do searches for strings (these are groups of contiguous characters or words) either forward through the file or backward through it. To search for the string means that you are trying to locate it somewhere in the file and have Emacs show you where the occurrences of the string exist. This type of search is somewhat different from what you may be familiar with. It is a search that is performed as you type in the thing to search for. The command to initiate a search is C-s for forward search, and C-r for reverse search. BUT WAIT! Don't do them now. When you type C-s you'll notice that the string "I-search" appears as a prompt in the echo area. This tells you that Emacs is in what is called an incremental search waiting for you to type the thing that you want to search for. terminates a search. >> Now type C-s to start a search. SLOWLY, one letter at a time, type the word 'cursor', pausing after you type each character to notice what happens to the cursor. >> Type C-s to find the next occurrence of "cursor". >> Now type four times and see how the cursor moves. >> Type to terminate the search. Did you see what happened? Emacs, in an incremental search, tries to go to the occurrence of the string that you've typed out so far. To go to the next occurrence of 'cursor' just type C-s again. If no such occurrence exists Emacs beeps and tells you that it is a failing search. C-g would also terminate the search. NOTE: On some systems, typing C-s will freeze the screen and you will see no further output from Emacs. This indicates that an operating system "feature" called "flow control" is intercepting the C-s and not letting it get through to Emacs. To unfreeze the screen, type C-q. Then see the section "Spontaneous Entry to Incremental Search" in the Emacs manual for advice on dealing with this "feature". If you are in the middle of an incremental search and type , you'll notice that the last character in the search string is erased and the search backs up to the last place of the search. For instance, suppose you currently have typed 'cu' and you see that your cursor is at the first occurrence of 'cu'. If you now type , the 'u' on the search line is erased and you'll be repositioned in the text to the occurrence of 'c' where the search took you before you typed the 'u'. This provides a useful means for backing up while you are searching. If you are in the middle of a search and type a control or meta character (with a few exceptions--characters that are special in a search, such as C-s and C-r), the search is terminated. The C-s starts a search that looks for any occurrence of the search string AFTER the current cursor position. But what if you want to search for something earlier in the text? To do this, type C-r for Reverse search. Everything that applies to C-s applies to C-r except that the direction of the search is reversed. * MULTIPLE WINDOWS ------------------ One of the nice features of Emacs is that you can display more than one window on the screen at the same time. >> Move the cursor to this line and type C-u 0 C-l. >> Now type C-x 2 which splits the screen into two windows. Both windows display this tutorial. The cursor stays in the top window. >> Type C-M-v to scroll the bottom window. (If you don't have a real Meta key, type ESC C-v.) >> Type C-x o ("o" for "other") to move the cursor to the bottom window. >> Use C-v and M-v in the bottom window to scroll it. Keep reading these directions in the top window. >> Type C-x o again to move the cursor back to the top window. The cursor is still just where it was in the top window before. You can keep using C-x o to switch between the windows. Each window has its own cursor position, but only one window actually shows the cursor. All the ordinary editing commands apply to the window that the cursor is in. The command C-M-v is very useful when you are editing text in one window and using the other window just for reference. You can keep the cursor always in the window where you are editing, and edit there as you advance through the other window. C-M-v is an example of a CONTROL-META character. If you have a real META key, you can type C-M-v by holding down both CTRL and META while typing v. It doesn't matter whether CTRL or META "comes first," because both of these keys act by modifying the characters you type. But if you don't have a real META key, and you use ESC instead, the order does matter: you must type ESC followed by CTRL-v; CTRL-ESC v will not work. This is because ESC is a character in its own right, not a modifier key. >> Type C-x 1 (in the top window) to get rid of the bottom window. (If you had typed C-x 1 in the bottom window, that would get rid of the top one. Think of this command as "Keep just one window--the window I am already in.") You don't have to display the same buffer in both windows. If you use C-x C-f to find a file in one window, the other window doesn't change. You can pick a file in each window independently. Here is another way to use two windows to display two different things: >> Type C-x 4 C-f followed by the name of one of your files. End with . See the specified file appear in the bottom window. The cursor goes there, too. >> Type C-x o to go back to the top window, and C-x 1 to delete the bottom window. * RECURSIVE EDITING LEVELS -------------------------- Sometimes you will get into what is called a "recursive editing level". This is indicated by square brackets in the mode line, surrounding the parentheses around the major mode name. For example, you might see [(Fundamental)] instead of (Fundamental). To get out of the recursive editing level, type M-x top-level. >> Try that now; it should display "Back to top level" at the bottom of the screen. In fact, you were ALREADY at top level (not inside a recursive editing level) if you have obeyed instructions. M-x top-level does not care; it gets out of any number of recursive editing levels, perhaps zero, to get back to top level. You can't use C-g to get out of a recursive editing level because C-g is used for discarding numeric arguments and partially typed commands WITHIN the recursive editing level. * GETTING MORE HELP ------------------- In this tutorial we have tried to supply just enough information to get you started using Emacs. There is so much available in Emacs that it would be impossible to explain it all here. However, you may want to learn more about Emacs since it has numerous desirable features that you don't know about yet. Emacs has a great deal of internal documentation. All of these commands can be accessed through the character Control-h, which we call "the Help character" because of the function it serves. To use the HELP features, type the C-h character, and then a character saying what kind of help you want. If you are REALLY lost, type C-h ? and Emacs will tell you what kinds of help it can give. If you have typed C-h and decide you don't want any help, just type C-g to cancel it. (Some sites rebind the character C-h. They really shouldn't do this as a blanket measure, so complain to the operator. Meanwhile, if C-h does not display a message about help at the bottom of the screen, try typing M-x help RET instead.) The most basic HELP feature is C-h c. Type C-h, a c, and a command character or sequence, and Emacs displays a very brief description of the command. >> Type C-h c Control-p. The message should be something like C-p runs the command previous-line This tells you the "name of the function". That is important in writing Lisp code to extend Emacs; it also is enough to remind you of what the command does if you have seen it before but did not remember. Multi-character commands such as C-x C-s and (if you have no META or EDIT key) v are also allowed after C-h c. To get more information on the command, use C-h k instead of C-h c. >> Type C-h k Control-p. This displays the documentation of the function, as well as its name, in an Emacs window. When you are finished reading the output, type C-x 1 to get rid of the help text. You do not have to do this right away. You can do some editing while referring to the help text and then type C-x 1. Here are some other useful C-h options: C-h f Describe a function. You type in the name of the function. >> Try typing C-h f previous-line. This prints all the information Emacs has about the function which implements the C-p command. C-h a Command Apropos. Type in a keyword and Emacs will list all the commands whose names contain that keyword. These commands can all be invoked with Meta-x. For some commands, Command Apropos will also list a one or two character sequence which has the same effect. >> Type C-h a file. This displays in another window a list of all M-x commands with "file" in their names. You will also see commands like C-x C-f and C-x C-w, listed beside the command names find-file and write-file. >> Type C-M-v to scroll the help window. Do this a few times. >> Type C-x 1 to delete the help window. * CONCLUSION ------------ Remember, to exit Emacs permanently use C-x C-c. To exit to a shell temporarily, so that you can come back in, use C-z. This tutorial is meant to be understandable to all new users, so if you found something unclear, don't sit and blame yourself - complain! COPYING ------- This tutorial descends from a long line of Emacs tutorials starting with the one written by Stuart Cracraft for the original Emacs. This version of the tutorial, like GNU Emacs, is copyrighted, and comes with permission to distribute copies on certain conditions: Copyright (c) 1985 Free Software Foundation Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the copyright notice and permission notice are preserved, and that the distributor grants the recipient permission for further redistribution as permitted by this notice. Permission is granted to distribute modified versions of this document, or of portions of it, under the above conditions, provided also that they carry prominent notices stating who last altered them. The conditions for copying Emacs itself are slightly different but in the same spirit. Please read the file COPYING and then do give copies of GNU Emacs to your friends. Help stamp out software obstructionism ("ownership") by using, writing, and sharing free software! emacs-19.30/etc/Xkeymap.txt100666 13437 1 23327 4200740752 14223 0ustar jimbdaemon# -*-Mode: Fundamental-*- # X keymap file for rlk with some emacsified bindings # This file contains the default keyboard mapping. The first column contains a X keyboard code; the other # 16 columns contain the mapping of the keycode to a character string, with various combinations # of the SHIFT, LOCK, META, and CONTROL keys down. See the man page for "keycomp" for more information. # # Keycode constants for non-typewriter keys are found in . # # It is easiest to edit this file with an EMACS window running across the entire width of the display, with # tab stop set to 4. # # E1=Find, E2=Insert Here, E3=Remove, E4=Select, E5=Prev Screen, E6=Next Screen # uns L S SL M ML MS MSL C CL CS CSL CM CML CMS CMSL 0212 0023, 0023, 0023, 0023, 0223, 0223, 0223, 0223, 0022, 0022, 0022, 0022, 0222, 0222, 0222, 0222, /* E1 */ 0213 U, U, U, U, U, U, U, U, U, U, U, U, U, U, U, U, /* E2 */ 0214 0004, 0004, 0177, 0177, 0304, 0304, 0377, 0377, 0004, 0004, 0177, 0177, 0204, 0204, 0377, 0377 /* E3 */ 0215 U, U, U, U, U, U, U, U, U, U, U, U, U, U, U, U, /* E4 */ 0216 0326, 0326, 0326, 0326, 0326, 0326, 0326, 0326, "\255\226" "\255\226" "\255\226" "\255\226" "\255\226" "\255\226" "\255\226" "\255\226" /* E5 */ 0217 0026, 0026, 0026, 0026, 0026, 0026, 0026, 0026, 0226, 0226, 0226, 0226, 0226, 0226, 0226, 0226, /* E6 */ 0247 0002, 0002, 0002, 0002, 0302, 0302, 0302, 0302, 0202, 0202, 0202, 0202, 0202, 0202, 0202, 0202, /* Left arrow */ 0250 0006, 0006, 0006, 0006, 0306, 0306, 0306, 0306, 0206, 0206, 0206, 0206, 0206, 0206, 0206, 0206, /* Right arrow */ 0251 0016, 0016, 0016, 0016, 0316, 0316, 0316, 0316, 0216, 0216, 0216, 0216, 0216, 0216, 0216, 0216, /* Down arrow */ 0252 0020, 0020, 0020, 0020, 0320, 0320, 0320, 0320, 0220, 0220, 0220, 0220, 0220, 0220, 0220, 0220, /* Up arrow */ 0222 0260, '0', 0260, '0', 0260, '0', 0260, '0', 0260, '0', 0260, '0', 0260, '0', 0260, '0', /* KP 0 */ 0224 0256, '.', 0256, '.', 0256, '.', 0256, '.', 0256, '.', 0256, '.', 0256, '.', 0256, '.', /* KP . */ 0225 '\n', '\n', '\n', '\n', 0312, 0312, 0312, 0312, 0212, 0212, 0212, 0212, 0212, 0212, 0212, 0212, /* KP Enter */ 0226 0261, '1', 0261, '1', 0261, '1', 0261, '1', 0261, '1', 0261, '1', 0261, '1', 0261, '1', /* KP 1 */ 0227 0262, '2', 0262, '2', 0262, '2', 0262, '2', 0262, '2', 0262, '2', 0262, '2', 0262, '2', /* KP 2 */ 0230 0263, '3', 0263, '3', 0263, '3', 0263, '3', 0263, '3', 0263, '3', 0263, '3', 0263, '3', /* KP 3 */ 0231 0264, '4', 0264, '4', 0264, '4', 0264, '4', 0264, '4', 0264, '4', 0264, '4', 0264, '4', /* KP 4 */ 0232 0265, '5', 0265, '5', 0265, '5', 0265, '5', 0265, '5', 0265, '5', 0265, '5', 0265, '5', /* KP 5 */ 0233 0266, '6', 0266, '6', 0266, '6', 0266, '6', 0266, '6', 0266, '6', 0266, '6', 0266, '6', /* KP 6 */ 0234 0254, ',', 0254, ',', 0254, ',', 0254, ',', 0254, ',', 0254, ',', 0254, ',', 0254, ',', /* KP , */ 0235 0267, '7', 0267, '7', 0267, '7', 0267, '7', 0267, '7', 0267, '7', 0267, '7', 0267, '7', /* KP 7 */ 0236 0270, '8', 0270, '8', 0270, '8', 0270, '8', 0270, '8', 0270, '8', 0270, '8', 0270, '8', /* KP 8 */ 0237 0271, '9', 0271, '9', 0271, '9', 0271, '9', 0271, '9', 0271, '9', 0271, '9', 0271, '9', /* KP 9 */ 0240 0255, '-', 0255, '-', 0255, '-', 0255, '-', 0255, '-', 0255, '-', 0255, '-', 0255, '-', /* KP - */ 0174 0010, 0010, 0010, 0010, 0010, 0010, 0010, 0010, 0010, 0010, 0010, 0010, 0010, 0010, 0010, 0010, /* F15/Help */ 0175 0037, 0037, 0037, 0037, 0037, 0037, 0037, 0037, 0037, 0037, 0037, 0037, 0037, 0037, 0037, 0037, /* F16/(Un)Do */ 0161 0033, 0033, 0033, 0033, 0033, 0033, 0033, 0033, 0033, 0033, 0033, 0033, 0033, 0033, 0033, 0033, /* F11/ESC */ 0162 '\b', '\b', '\b', '\b', '\b', '\b', U, U, '\b', '\b', U, U, U, U, U, U, /* F12/BS */ 0163 '\n', '\n', '\n', '\n', '\n', '\n', U, U, '\n', '\n', U, U, U, U, U, U, /* F13/LF */ 0274 0177, 0177, 0177, 0177, 0377, 0377, 0377, 0377, 0030, 0030, 0177, 0177, 0377, 0377, 0377, 0377, /* back */ 0275 '\r', '\r', '\r', '\r', 0215, 0215, 0215, 0215, '\r', '\r', U, U, U, U, U, U, /* Return */ 0276 '\t', '\t', '\t', '\t', 0211, 0211, 0211, 0211, "\021\t" "\021\t" "\021\t" "\021\t" "\021\t" "\021\t" "\021\t" "\021\t" /* Tab */ 0277 '`', '`', '~', '~', 0340, 0340, 0376, 0376, 0036, 0036, 0036, 0036, U, U, U, U, /* ` */ 0300 '1', '1', '!', '!', 0261, 0261, 0241, 0241, '1', '1', '!', '!', U, U, U, U, /* 1 */ 0301 'q', 'Q', 'Q', 'Q', 0361, 0361, 0321, 0321, 0021, 0021, 0021, 0021, 0221, 0221, 0221, 0221, /* q */ 0302 'a', 'A', 'A', 'A', 0341, 0341, 0301, 0301, 0001, 0001, 0001, 0001, 0201, 0201, 0201, 0201, /* a */ 0303 'z', 'Z', 'Z', 'Z', 0372, 0372, 0332, 0332, 0032, 0032, 0032, 0032, 0232, 0232, 0232, 0232, /* z */ 0305 '2', '2', '@', '@', 0262, 0262, 0300, 0300, 0000, 0000, 0000, 0000, 0262, 0262, 0200, 0200, /* 2 */ 0306 'w', 'W', 'W', 'W', 0367, 0367, 0327, 0327, 0027, 0027, 0027, 0027, 0227, 0227, 0227, 0227, /* w */ 0307 's', 'S', 'S', 'S', 0363, 0363, 0323, 0323, 0023, 0023, 0023, 0023, 0223, 0223, 0223, 0223, /* s */ 0310 'x', 'X', 'X', 'X', 0370, 0370, 0330, 0330, 0030, 0030, 0030, 0030, 0230, 0230, 0230, 0230, /* x */ 0311 '<', '<', '>', '>', 0274, 0274, 0276, 0276, U, U, U, U, U, U, U, U, /* < */ 0313 '3', '3', '#', '#', 0263, 0263, 0243, 0243, 0033, 0033, '#', '#', U, U, U, U, /* 3 */ 0314 'e', 'E', 'E', 'E', 0345, 0345, 0305, 0305, 0005, 0005, 0005, 0005, 0205, 0205, 0205, 0205, /* e */ 0315 'd', 'D', 'D', 'D', 0344, 0344, 0304, 0304, 0004, 0004, 0004, 0004, 0204, 0204, 0204, 0204, /* d */ 0316 'c', 'C', 'C', 'C', 0343, 0343, 0303, 0303, 0003, 0003, 0003, 0003, 0203, 0203, 0203, 0203, /* c */ 0320 '4', '4', '$', '$', 0264, 0264, 0244, 0244, 0034, 0034, '$', '$', U, U, U, U, /* 4 */ 0321 'r', 'R', 'R', 'R', 0362, 0362, 0322, 0322, 0022, 0022, 0022, 0022, 0222, 0222, 0222, 0222, /* r */ 0322 'f', 'F', 'F', 'F', 0346, 0346, 0306, 0306, 0006, 0006, 0006, 0006, 0206, 0206, 0206, 0206, /* f */ 0323 'v', 'V', 'V', 'V', 0366, 0366, 0326, 0326, 0026, 0026, 0026, 0026, 0226, 0226, 0226, 0226, /* v */ 0324 ' ', ' ', ' ', ' ', 0240, 0240, 0240, 0240, 0000, 0000, 0000, 0000, 0200, 0200, 0200, 0200, /* space */ 0326 '5', '5', '%', '%', 0265, 0265, 0245, 0245, 0035, 0035, '%', '%', U, U, U, U, /* 5 */ 0327 't', 'T', 'T', 'T', 0364, 0364, 0324, 0324, 0024, 0024, 0024, 0024, 0224, 0224, 0224, 0224, /* t */ 0330 'g', 'G', 'G', 'G', 0347, 0347, 0307, 0307, 0007, 0007, 0007, 0007, 0207, 0207, 0207, 0207, /* g */ 0331 'b', 'B', 'B', 'B', 0342, 0342, 0302, 0302, 0002, 0002, 0002, 0002, 0202, 0202, 0202, 0202, /* b */ 0333 '6', '6', '^', '^', 0266, 0266, 0336, 0336, 0036, 0036, 0036, 0036, U, U, U, U, /* 6 */ 0334 'y', 'Y', 'Y', 'Y', 0371, 0371, 0331, 0331, 0031, 0031, 0031, 0031, 0231, 0231, 0231, 0231, /* y */ 0335 'h', 'H', 'H', 'H', 0350, 0350, 0310, 0310, 0010, 0010, 0010, 0010, 0210, 0210, 0210, 0210, /* h */ 0336 'n', 'N', 'N', 'N', 0356, 0356, 0316, 0316, 0016, 0016, 0016, 0016, 0216, 0216, 0216, 0216, /* n */ 0340 '7', '7', '&', '&', 0267, 0267, 0246, 0246, 0037, 0037, '&', '&', U, U, U, U, /* 7 */ 0341 'u', 'U', 'U', 'U', 0365, 0365, 0325, 0325, 0025, 0025, 0025, 0025, 0225, 0225, 0225, 0225, /* u */ 0342 'j', 'J', 'J', 'J', 0352, 0352, 0312, 0312, 0012, 0012, 0012, 0012, 0212, 0212, 0212, 0212, /* j */ 0343 'm', 'M', 'M', 'M', 0355, 0355, 0315, 0315, 0015, 0015, 0015, 0015, 0215, 0215, 0215, 0215, /* m */ 0345 '8', '8', '*', '*', 0270, 0270, 0252, 0252, 0177, 0177, '*', '*', U, U, U, U, /* 8 */ 0346 'i', 'I', 'I', 'I', 0351, 0351, 0311, 0311, 0011, 0011, 0011, 0011, 0211, 0211, 0211, 0211, /* i */ 0347 'k', 'K', 'K', 'K', 0353, 0353, 0313, 0313, 0013, 0013, 0013, 0013, 0213, 0213, 0213, 0213, /* k */ 0350 ',', ',', '<', '<', 0254, 0254, 0274, 0274, U, U, U, U, U, U, U, U, /* , */ 0352 '9', '9', '(', '(', 0271, 0271, 0250, 0250, '9', '9', '(', '(', U, U, U, U, /* 9 */ 0353 'o', 'O', 'O', 'O', 0357, 0357, 0317, 0317, 0017, 0017, 0017, 0017, 0217, 0217, 0217, 0217, /* o */ 0354 'l', 'L', 'L', 'L', 0354, 0354, 0314, 0314, 0014, 0014, 0014, 0014, 0214, 0214, 0214, 0214, /* l */ 0355 '.', '.', '>', '>', 0256, 0256, 0276, 0276, U, U, U, U, U, U, U, U, /* . */ 0357 '0', '0', ')', ')', 0260, 0260, 0251, 0251, '0', '0', ')', ')', U, U, U, U, /* 0 */ 0360 'p', 'P', 'P', 'P', 0360, 0360, 0320, 0320, 0020, 0020, 0020, 0020, 0220, 0220, 0220, 0220, /* p */ 0362 ';', ';', ':', ':', 0273, 0273, 0272, 0272, U, U, U, U, U, U, U, U, /* ; */ 0363 '/', '/', '?', '?', 0257, 0257, 0277, 0277, 0037, 0037, 0037, 0037, 0237, 0237, 0237, 0237, /* / */ 0365 '=', '=', '+', '+', 0275, 0275, 0253, 0253, U, U, U, U, U, U, U, U, /* = */ 0366 ']', ']', '}', '}', 0335, 0335, 0376, 0376, 0035, 0035, 0035, 0035, 0335, 0335, 0335, 0335, /* ] */ 0367 '\\', '\\', '|', '|', 0334, 0334, 0374, 0374, 0034, 0034, 0034, 0034, 0334, 0334, 0334, 0334, /* \ */ 0371 '-', '-', '_', '_', 0255, 0255, 0337, 0337, 0037, 0037, 0037, 0037, 0337, 0337, 0337, 0337, /* - */ 0372 '[', '[', '{', '{', 0333, 0333, 0373, 0373, 0033, 0033, 0033, 0033, 0333, 0333, 0333, 0333, /* [ */ 0373 '\'', '\'', '"', '"', 0247, 0247, 0242, 0242, U, U, U, U, U, U, U, U, /* ' */ # # local variables: # tab-width: 4 # End: emacs-19.30/etc/celibacy.1100666 13437 1 270 4022773675 13645 0ustar jimbdaemonCELIBACY(1) UNIX Programmer's Manual CELIBACY(1) NAME celibacy - don't have sex SYNOPSIS celibacy DESCRIPTION Does nothing worth mentioning. emacs-19.30/etc/condom.1100666 13437 13 11771 5405340661 13146 0ustar jimbuserCONDOM(1) EUNUCH Programmer's Manual CONDOM(1) NAME condom - Protection against viruses and prevention of child processes SYNOPSIS condom [options] [processid] DESCRIPTION _condom_ provides protection against System Transmitted Viruses (STVs) that may invade your system. Although the spread of such viruses across a network can only be abated by aware and cautious users, _condom_ is the only highly-effective means of preventing viruses from entering your system (see celibacy(1)). Any data passed to _condom_ by the protected process will be blocked, as specified by the value of the -s option (see OPTIONS below). _condom_ is known to defend against the following viruses and other malicious afflictions... o AIDS o Herpes Simplex (genital varieties) o Syphilis o Crabs o Genital warts o Gonorrhea o Chlamydia o Michelangelo o Jerusalem When used alone or in conjunction with pill(1), sponge(1), foam(1), and/or setiud(3), _condom_ also prevents the conception of a child process. If invoked from within a synchronous process, _condom_ has, by default, an 80% chance of preventing the external processes from becoming parent processes (see the -s option below). When other process contraceptives are used, the chance of preventing a child process from being forked becomes much greater. See pill(1), sponge(1), foam(1), and setiud(3) for more information. If no options are given, the current user's login process (as determined by the environment variable USER) is protected with a Trojan rough-cut latex condom without a reservoir tip. The optional 'processid' argument is an integer specifying the process to protect. NOTE: _condom_ may only be used with a hard disk. _condom_ will terminate abnormally with exit code -1 if used with a floppy disk (see DIAGNOSTICS below). OPTIONS The following options may be given to _condom_... -b BRAND BRANDs are as follows... trojan (default) ramses sheik goldcoin fourex -m MATERIAL The valid MATERIALs are... latex (default) saranwrap membrane -- WARNING! The membrane option is _not_ endorsed by the System Administrator General as an effective barrier against certain viruses. It is supported only for the sake of tradition. -f FLAVOR The following FLAVORs are currently supported... plain (default) apple banana cherry cinnamon licorice orange peppermint raspberry spearmint strawberry -r Toggle reservoir tip (default is no reservoir tip) -s STRENGTH STRENGTH is an integer between 20 and 100 specifying the resilience of _condom_ against data passed to _condom_ by the protected process. Using a larger value of STRENGTH increases _condom_'s protective abilities, but also reduces interprocess communication. A smaller value of STRENGTH increases interprocess communication, but also increases the likelihood of a security breach. An extremely vigorous process or one passing an enormous amount of data to _condom_ will increase the chance of _condom_'s failure. The default STRENGTH is 80%. -t TEXTURE Valid TEXTUREs are... rough (default) ribbed bumps lubricated (provides smoother interaction between processes) WARNING: The use of an external application to _condom_ in order to reduce friction between processes has been proven in benchmark tests to decrease _condom_'s strength factor! If execution speed is important to your process, use the '-t lubricated' option. DIAGNOSTICS _condom_ terminates with one of the following exit codes... -1 An attempt was made to use _condom_ on a floppy disk. 0 _condom_ exited successfully (no data was passed to the synchronous process). 1 _condom_ failed and data was allowed through. The danger of transmission of an STV or the forking of a child process is inversely proportional to the number of other protections employed and is directly proportional to the ages of the processes involved. BUGS _condom_ is NOT 100% effective at preventing a child process from being forked or at deterring the invasion of a virus (although the System Administrator General has deemed that _condom_ is the most effective means of preventing the spread of system transmitted viruses). See celibacy(1) for information on a 100% effective program for preventing these problems. Remember... the use of sex(1) and other related routines should only occur between mature, consenting processes. If you must use sex(1), please employ _condom_ to protect your process and your synchronous process. If we are all responsible, we can stop the spread of STVs. AUTHORS and HISTORY The original version of _condom_ was released in Roman times and was only marginally effective. With the advent of modern technology, _condom_ now supports many more options and is much more effective. The current release of _condom_ was written by Ken Maupin at the University of Washington (maupin@cs.washington.edu) and was last updated on 10/7/92. SEE ALSO celibacy(1), sex(1), pill(1), sponge(1), foam(1), and setiud(3) emacs-19.30/etc/copying.paper100666 12120 13 120216 5471317220 14163 0ustar rmsuser(For more information about the GNU project and free software, look at the files `GNU', `COPYING', and `DISTRIB', in the same directory as this file.) Why Software Should Be Free by Richard Stallman (Version of April 24, 1992) Copyright (C) 1991, 1992, Free Software Foundation, Inc. Verbatim copying and redistribution is permitted without royalty; alteration is not permitted. Introduction ************ The existence of software inevitably raises the question of how decisions about its use should be made. For example, suppose one individual who has a copy of a program meets another who would like a copy. It is possible for them to copy the program; who should decide whether this is done? The individuals involved? Or another party, called the "owner"? Software developers typically consider these questions on the assumption that the criterion for the answer is to maximize developers' profits. The political power of business has led to the government adoption of both this criterion and the answer proposed by the developers: that the program has an owner, typically a corporation associated with its development. I would like to consider the same question using a different criterion: the prosperity and freedom of the public in general. This answer cannot be decided by current law--the law should conform to ethics, not the other way around. Nor does current practice decide this question, although it may suggest possible answers. The only way to judge is to see who is helped and who is hurt by recognizing owners of software, why, and how much. In other words, we should perform a cost-benefit analysis on behalf of society as a whole, taking account of individual freedom as well as production of material goods. In this essay, I will describe the effects of having owners, and show that the results are detrimental. My conclusion is that programmers have the duty to encourage others to share, redistribute, study and improve the software we write: in other words, to write "free" software.(1) How Owners Justify Their Power ****************************** Those who benefit from the current system where programs are property offer two arguments in support of their claims to own programs: the emotional argument and the economic argument. The emotional argument goes like this: "I put my sweat, my heart, my soul into this program. It comes from *me*, it's *mine*!" This argument does not require serious refutation. The feeling of attachment is one that programmers can cultivate when it suits them; it is not inevitable. Consider, for example, how willingly the same programmers usually sign over all rights to a large corporation for a salary; the emotional attachment mysteriously vanishes. By contrast, consider the great artists and artisans of medieval times, who didn't even sign their names to their work. To them, the name of the artist was not important. What mattered was that the work was done--and the purpose it would serve. This view prevailed for hundreds of years. The economic argument goes like this: "I want to get rich (usually described inaccurately as `making a living'), and if you don't allow me to get rich by programming, then I won't program. Everyone else is like me, so nobody will ever program. And then you'll be stuck with no programs at all!" This threat is usually veiled as friendly advice from the wise. I'll explain later why this threat is a bluff. First I want to address an implicit assumption that is more visible in another formulation of the argument. This formulation starts by comparing the social utility of a proprietary program with that of no program, and then concludes that proprietary software development is, on the whole, beneficial, and should be encouraged. The fallacy here is in comparing only two outcomes--proprietary software vs. no software--and assuming there are no other possibilities. Given a system of intellectual property, software development is usually linked with the existence of an owner who controls the software's use. As long as this linkage exists, we are often faced with the choice of proprietary software or none. However, this linkage is not inherent or inevitable; it is a consequence of the specific social/legal policy decision that we are questioning: the decision to have owners. To formulate the choice as between proprietary software vs. no software is begging the question. The Argument against Having Owners ********************************** The question at hand is, "Should development of software be linked with having owners to restrict the use of it?" In order to decide this, we have to judge the effect on society of each of those two activities *independently*: the effect of developing the software (regardless of its terms of distribution), and the effect of restricting its use (assuming the software has been developed). If one of these activities is helpful and the other is harmful, we would be better off dropping the linkage and doing only the helpful one. To put it another way, if restricting the distribution of a program already developed is harmful to society overall, then an ethical software developer will reject the option of doing so. To determine the effect of restricting sharing, we need to compare the value to society of a restricted (i.e., proprietary) program with that of the same program, available to everyone. This means comparing two possible worlds. This analysis also addresses the simple counterargument sometimes made that "the benefit to the neighbor of giving him or her a copy of a program is cancelled by the harm done to the owner." This counterargument assumes that the harm and the benefit are equal in magnitude. The analysis involves comparing these magnitudes, and shows that the benefit is much greater. To elucidate this argument, let's apply it in another area: road construction. It would be possible to fund the construction of all roads with tolls. This would entail having toll booths at all street corners. Such a system would provide a great incentive to improve roads. It would also have the virtue of causing the users of any given road to pay for that road. However, a toll booth is an artificial obstruction to smooth driving--artificial, because it is not a consequence of how roads or cars work. Comparing free roads and toll roads by their usefulness, we find that (all else being equal) roads without toll booths are cheaper to construct, cheaper to run, safer, and more efficient to use.(2) In a poor country, tolls may make the roads unavailable to many citizens. The roads without toll booths thus offer more benefit to society at less cost; they are preferable for society. Therefore, society should choose to fund roads in another way, not by means of toll booths. Use of roads, once built, should be free. When the advocates of toll booths propose them as *merely* a way of raising funds, they distort the choice that is available. Toll booths do raise funds, but they do something else as well: in effect, they degrade the road. The toll road is not as good as the free road; giving us more or technically superior roads may not be an improvement if this means substituting toll roads for free roads. Of course, the construction of a free road does cost money, which the public must somehow pay. However, this does not imply the inevitability of toll booths. We who must in either case pay will get more value for our money by buying a free road. I am not saying that a toll road is worse than no road at all. That would be true if the toll were so great that hardly anyone used the road--but this is an unlikely policy for a toll collector. However, as long as the toll booths cause significant waste and inconvenience, it is better to raise the funds in a less obstructive fashion. To apply the same argument to software development, I will now show that having "toll booths" for useful software programs costs society dearly: it makes the programs more expensive to construct, more expensive to distribute, and less satisfying and efficient to use. It will follow that program construction should be encouraged in some other way. Then I will go on to explain other methods of encouraging and (to the extent actually necessary) funding software development. The Harm Done by Obstructing Software ===================================== Consider for a moment that a program has been developed, and any necessary payments for its development have been made; now society must choose either to make it proprietary or allow free sharing and use. Assume that the existence of the program and its availability is a desirable thing.(3) Restrictions on the distribution and modification of the program cannot facilitate its use. They can only interfere. So the effect can only be negative. But how much? And what kind? Three different levels of material harm come from such obstruction: * Fewer people use the program. * None of the users can adapt or fix the program. * Other developers cannot learn from the program, or base new work on it. Each level of material harm has a concomitant form of psychosocial harm. This refers to the effect that people's decisions have on their subsequent feelings, attitudes and predispositions. These changes in people's ways of thinking will then have a further effect on their relationships with their fellow citizens, and can have material consequences. The three levels of material harm waste part of the value that the program could contribute, but they cannot reduce it to zero. If they waste nearly all the value of the program, then writing the program harms society by at most the effort that went into writing the program. Arguably a program that is profitable to sell must provide some net direct material benefit. However, taking account of the concomitant psychosocial harm, there is no limit to the harm that proprietary software development can do. Obstructing Use of Programs =========================== The first level of harm impedes the simple use of a program. A copy of a program has nearly zero marginal cost (and you can pay this cost by doing the work yourself), so in a free market, it would have nearly zero price. A license fee is a significant disincentive to use the program. If a widely-useful program is proprietary, far fewer people will use it. It is easy to show that the total contribution of a program to society is reduced by assigning an owner to it. Each potential user of the program, faced with the need to pay to use it, may choose to pay, or may forego use of the program. When a user chooses to pay, this is a zero-sum transfer of wealth between two parties. But each time someone chooses to forego use of the program, this harms that person without benefitting anyone. The sum of negative numbers and zeros must be negative. But this does not reduce the amount of work it takes to *develop* the program. As a result, the efficiency of the whole process, in delivered user satisfaction per hour of work, is reduced. This reflects a crucial difference between copies of programs and cars, chairs, or sandwiches. There is no copying machine for material objects outside of science fiction. But programs are easy to copy; anyone can produce as many copies as are wanted, with very little effort. This isn't true for material objects because matter is conserved: each new copy has to be built from raw materials in the same way that the first copy was built. With material objects, a disincentive to use them makes sense, because fewer objects bought means less raw materials and work needed to make them. It's true that there is usually also a startup cost, a development cost, which is spread over the production run. But as long as the marginal cost of production is significant, adding a share of the development cost does not make a qualitative difference. And it does not require restrictions on the freedom of ordinary users. However, imposing a price on something that would otherwise be free is a qualitative change. A centrally-imposed fee for software distribution becomes a powerful disincentive. What's more, central production as now practiced is inefficient even as a means of delivering copies of software. This system involves enclosing physical disks or tapes in superfluous packaging, shipping large numbers of them around the world, and storing them for sale. This cost is presented as an expense of doing business; in truth, it is part of the waste caused by having owners. Damaging Social Cohesion ======================== Suppose that both you and your neighbor would find it useful to run a certain program. In ethical concern for your neighbor, you should feel that proper handling of the situation will enable both of you to use it. A proposal to permit only one of you to use the program, while restraining the other, is divisive; neither you nor your neighbor should find it acceptable. Signing a typical software license agreement means betraying your neighbor: "I promise to deprive my neighbor of this program so that I can have a copy for myself." People who make such choices feel internal psychological pressure to justify them, by downgrading the importance of helping one's neighbors--thus public spirit suffers. This is psychosocial harm associated with the material harm of discouraging use of the program. Many users unconsciously recognize the wrong of refusing to share, so they decide to ignore the licenses and laws, and share programs anyway. But they often feel guilty about doing so. They know that they must break the laws in order to be good neighbors, but they still consider the laws authoritative, and they conclude that being a good neighbor (which they are) is naughty or shameful. That is also a kind of psychosocial harm, but one can escape it by deciding that these licenses and laws have no moral force. Programmers also suffer psychosocial harm knowing that many users will not be allowed to use their work. This leads to an attitude of cynicism or denial. A programmer may describe enthusiastically the work that he finds technically exciting; then when asked, "Will I be permitted to use it?", his face falls, and he admits the answer is no. To avoid feeling discouraged, he either ignores this fact most of the time or adopts a cynical stance designed to minimize the importance of it. Since the age of Reagan, the greatest scarcity in the United States is not technical innovation, but rather the willingness to work together for the public good. It makes no sense to encourage the former at the expense of the latter. Obstructing Custom Adaptation of Programs ========================================= The second level of material harm is the inability to adapt programs. The ease of modification of software is one of its great advantages over older technology. But most commercially available software isn't available for modification, even after you buy it. It's available for you to take it or leave it, as a black box--that is all. A program that you can run consists of a series of numbers whose meaning is obscure. No one, not even a good programmer, can easily change the numbers to make the program do something different. Programmers normally work with the "source code" for a program, which is written in a programming language such as Fortran or C. It uses names to designate the data being used and the parts of the program, and it represents operations with symbols such as `+' for addition and `-' for subtraction. It is designed to help programmers read and change programs. Here is an example; a program to calculate the distance between two points in a plane: float distance (p0, p1) struct point p0, p1; { float xdist = p1.x - p0.x; float ydist = p1.y - p0.y; return sqrt (xdist * xdist + ydist * ydist); } Here is the same program in executable form, on the computer I normally use: 1314258944 -232267772 -231844864 1634862 1411907592 -231844736 2159150 1420296208 -234880989 -234879837 -234879966 -232295424 1644167167 -3214848 1090581031 1962942495 572518958 -803143692 1314803317 Source code is useful (at least potentially) to every user of a program. But most users are not allowed to have copies of the source code. Usually the source code for a proprietary program is kept secret by the owner, lest anybody else learn something from it. Users receive only the files of incomprehensible numbers that the computer will execute. This means that only the program's owner can change the program. A friend once told me of working as a programmer in a bank for about six months, writing a program similar to something that was commercially available. She believed that if she could have gotten source code for that commercially available program, it could easily have been adapted to their needs. The bank was willing to pay for this, but was not permitted to--the source code was a secret. So she had to do six months of make-work, work that counts in the GNP but was actually waste. The MIT Artificial Intelligence lab (AI lab) received a graphics printer as a gift from Xerox around 1977. It was run by free software to which we added many convenient features. For example, the software would notify a user immediately on completion of a print job. Whenever the printer had trouble, such as a paper jam or running out of paper, the software would immediately notify all users who had print jobs queued. These features facilitated smooth operation. Later Xerox gave the AI lab a newer, faster printer, one of the first laser printers. It was driven by proprietary software that ran in a separate dedicated computer, so we couldn't add any of our favorite features. We could arrange to send a notification when a print job was sent to the dedicated computer, but not when the job was actually printed (and the delay was usually considerable). There was no way to find out when the job was actually printed; you could only guess. And no one was informed when there was a paper jam, so the printer often went for an hour without being fixed. The system programmers at the AI lab were capable of fixing such problems, probably as capable as the original authors of the program. Xerox was uninterested in fixing them, and chose to prevent us, so we were forced to accept the problems. They were never fixed. Most good programmers have experienced this frustration. The bank could afford to solve the problem by writing a new program from scratch, but a typical user, no matter how skilled, can only give up. Giving up causes psychosocial harm--to the spirit of self-reliance. It is demoralizing to live in a house that you cannot rearrange to suit your needs. It leads to resignation and discouragement, which can spread to affect other aspects of one's life. People who feel this way are unhappy and do not do good work. Imagine what it would be like if recipes were hoarded in the same fashion as software. You might say, "How do I change this recipe to take out the salt?", and the great chef would respond, "How dare you insult my recipe, the child of my brain and my palate, by trying to tamper with it? You don't have the judgment to change my recipe and make it work right!" "But my doctor says I'm not supposed to eat salt! What can I do? Will you take out the salt for me?" "I would be glad to do that; my fee is only $50,000." Since the owner has a monopoly on changes, the fee tends to be large. "However, right now I don't have time. I am busy with a commission to design a new recipe for ship's biscuit for the Navy Department. I might get around to you in about two years." Obstructing Software Development ================================ The third level of material harm affects software development. Software development used to be an evolutionary process, where a person would take an existing program and rewrite parts of it for one new feature, and then another person would rewrite parts to add another feature; in some cases, this continued over a period of twenty years. Meanwhile, parts of the program would be "cannibalized" to form the beginnings of other programs. The existence of owners prevents this kind of evolution, making it necessary to start from scratch when developing a program. It also prevents new practitioners from studying existing programs to learn useful techniques or even how large programs can be structured. Owners also obstruct education. I have met bright students in computer science who have never seen the source code of a large program. They may be good at writing small programs, but they can't begin to learn the different skills of writing large ones if they can't see how others have done it. In any intellectual field, one can reach greater heights by standing on the shoulders of others. But that is no longer generally allowed in the software field--you can only stand on the shoulders of the other people *in your own company*. The associated psychosocial harm affects the spirit of scientific cooperation, which used to be so strong that scientists would cooperate even when their countries were at war. In this spirit, Japanese oceanographers abandoning their lab on an island in the Pacific carefully preserved their work for the invading U.S. Marines, and left a note asking them to take good care of it. Conflict for profit has destroyed what international conflict spared. Nowadays scientists in many fields don't publish enough in their papers to enable others to replicate the experiment. They publish only enough to let readers marvel at how much they were able to do. This is certainly true in computer science, where the source code for the programs reported on is usually secret. It Does Not Matter How Sharing Is Restricted ============================================ I have been discussing the effects of preventing people from copying, changing and building on a program. I have not specified how this obstruction is carried out, because that doesn't affect the conclusion. Whether it is done by copy protection, or copyright, or licenses, or encryption, or ROM cards, or hardware serial numbers, if it *succeeds* in preventing use, it does harm. Users do consider some of these methods more obnoxious than others. I suggest that the methods most hated are those that accomplish their objective. Software Should be Free ======================= I have shown how ownership of a program--the power to restrict changing or copying it--is obstructive. Its negative effects are widespread and important. It follows that society shouldn't have owners for programs. Another way to understand this is that what society needs is free software, and proprietary software is a poor substitute. Encouraging the substitute is not a rational way to get what we need. Vaclav Havel has advised us to "Work for something because it is good, not just because it stands a chance to succeed." A business making proprietary software stands a chance of success in its own narrow terms, but it is not what is good for society. Why People Will Develop Software ******************************** If we eliminate intellectual property as a means of encouraging people to develop software, at first less software will be developed, but that software will be more useful. It is not clear whether the overall delivered user satisfaction will be less; but if it is, or if we wish to increase it anyway, there are other ways to encourage development, just as there are ways besides toll booths to raise money for streets. Before I talk about how that can be done, first I want to question how much artificial encouragement is truly necessary. Programming is Fun ================== There are some lines of work that few will enter except for money; road construction, for example. There are other fields of study and art in which there is little chance to become rich, which people enter for their fascination or their perceived value to society. Examples include mathematical logic, classical music, and archaeology; and political organizing among working people. People compete, more sadly than bitterly, for the few funded positions available, none of which is funded very well. They may even pay for the chance to work in the field, if they can afford to. Such a field can transform itself overnight if it begins to offer the possibility of getting rich. When one worker gets rich, others demand the same opportunity. Soon all may demand large sums of money for doing what they used to do for pleasure. When another couple of years go by, everyone connected with the field will deride the idea that work would be done in the field without large financial returns. They will advise social planners to ensure that these returns are possible, prescribing special privileges, powers and monopolies as necessary to do so. This change happened in the field of computer programming in the past decade. Fifteen years ago, there were articles on "computer addiction": users were "onlining" and had hundred-dollar-a-week habits. It was generally understood that people frequently loved programming enough to break up their marriages. Today, it is generally understood that no one would program except for a high rate of pay. People have forgotten what they knew fifteen years ago. When it is true at a given time that most people will work in a certain field only for high pay, it need not remain true. The dynamic of change can run in reverse, if society provides an impetus. If we take away the possibility of great wealth, then after a while, when the people have readjusted their attitudes, they will once again be eager to work in the field for the joy of accomplishment. The question, "How can we pay programmers?", becomes an easier question when we realize that it's not a matter of paying them a fortune. A mere living is easier to raise. Funding Free Software ===================== Institutions that pay programmers do not have to be software houses. Many other institutions already exist which can do this. Hardware manufacturers find it essential to support software development even if they cannot control the use of the software. In 1970, much of their software was free because they did not consider restricting it. Today, their increasing willingness to join consortiums shows their realization that owning the software is not what is really important for them. Universities conduct many programming projects. Today, they often sell the results, but in the 1970s, they did not. Is there any doubt that universities would develop free software if they were not allowed to sell software? These projects could be supported by the same government contracts and grants which now support proprietary software development. It is common today for university researchers to get grants to develop a system, develop it nearly to the point of completion and call that "finished", and then start companies where they really finish the project and make it usable. Sometimes they declare the unfinished version "free"; if they are thoroughly corrupt, they instead get an exclusive license from the university. This is not a secret; it is openly admitted by everyone concerned. Yet if the researchers were not exposed to the temptation to do these things, they would still do their research. Programmers writing free software can make their living by selling services related to the software. I have been hired to port the GNU C compiler to new hardware, and to make user-interface extensions to GNU Emacs. (I offer these improvements to the public once they are done.) I also teach classes for which I am paid. I am not alone in working this way; there is now a successful, growing corporation which does no other kind of work. Several other companies also provide commercial support for the free software of the GNU system. This is the beginning of the independent software support industry-an industry that could become quite large if free software becomes prevalent. It provides users with an option generally unavailable for proprietary software, except to the very wealthy. New institutions such as the Free Software Foundation can also fund programmers. Most of the foundation's funds come from users buying tapes through the mail. The software on the tapes is free, which means that every user has the freedom to copy it and change it, but many nonetheless pay to get copies. (Recall that "free software" refers to freedom, not to price.) Some users order tapes who already have a copy, as a way of making a contribution they feel we deserve. The Foundation also receives sizable donations from computer manufacturers. The Free Software Foundation is a charity, and its income is spent on hiring as many programmers as possible. If it had been set up as a business, distributing the same free software to the public for the same fee, it would now provide a very good living for its founder. Because the Foundation is a charity, programmers often work for the Foundation for half of what they could make elsewhere. They do this because we are free of bureaucracy, and because they feel satisfaction in knowing that their work will not be obstructed from use. Most of all, they do it because programming is fun. In addition, volunteers have written many useful programs for us. (Recently even technical writers have begun to volunteer.) This confirms that programming is among the most fascinating of all fields, along with music and art. We don't have to fear that no one will want to program. What Do Users Owe to Developers? ================================ There is a good reason for users of software to feel a moral obligation to contribute to its support. Developers of free software are contributing to the users' activities, and it is both fair and in the long term interest of the users to give them funds to continue. However, this does not apply to proprietary software developers, since obstructionism deserves a punishment rather than a reward. We thus have a paradox: the developer of useful software is entitled to the support of the users, but any attempt to turn this moral obligation into a requirement destroys the basis for the obligation. A developer can either deserve a reward or demand it, but not both. I believe that an ethical developer faced with this paradox must act so as to deserve the reward, but should also entreat the users for voluntary donations. Eventually the users will learn to support developers without coercion, just as they have learned to support public radio and television stations. What Is Software Productivity? ****************************** If software were free, there would still be programmers, but perhaps fewer of them. Would this be bad for society? Not necessarily. Today the advanced nations have fewer farmers than in 1900, but we do not think this is bad for society, because the few deliver more food to the consumers than the many used to do. We call this improved productivity. Free software would require far fewer programmers to satisfy the demand, because of increased software productivity at all levels: * Wider use of each program that is developed. * The ability to adapt existing programs for customization instead of starting from scratch. * Better education of programmers. * The elimination of duplicate development effort. Those who object to cooperation because it would result in the employment of fewer programmers, are actually objecting to increased productivity. Yet these people usually accept the widely-held belief that the software industry needs increased productivity. How is this? "Software productivity" can mean two different things: the overall productivity of all software development, or the productivity of individual projects. Overall productivity is what society would like to improve, and the most straightforward way to do this is to eliminate the artificial obstacles to cooperation which reduce it. But researchers who study the field of "software productivity" focus only on the second, limited, sense of the term, where improvement requires difficult technological advances. Is Competition Inevitable? ************************** Is it inevitable that people will try to compete, to surpass their rivals in society? Perhaps it is. But competition itself is not harmful; the harmful thing is *combat*. There are many ways to compete. Competition can consist of trying to achieve ever more, to outdo what others have done. For example, in the old days, there was competition among programming wizards--competition for who could make the computer do the most amazing thing, or for who could make the shortest or fastest program for a given task. This kind of competition can benefit everyone, *as long as* the spirit of good sportsmanship is maintained. Constructive competition is enough competition to motivate people to great efforts. A number of people are competing to be the first to have visited all the countries on Earth; some even spend fortunes trying to do this. But they do not bribe ship captains to strand their rivals on desert islands. They are content to let the best person win. Competition becomes combat when the competitors begin trying to impede each other instead of advancing themselves--when "Let the best person win" gives way to "Let me win, best or not." Proprietary software is harmful, not because it is a form of competition, but because it is a form of combat among the citizens of our society. Competition in business is not necessarily combat. For example, when two grocery stores compete, their entire effort is to improve their own operations, not to sabotage the rival. But this does not demonstrate a special commitment to business ethics; rather, there is little scope for combat in this line of business short of physical violence. Not all areas of business share this characteristic. Withholding information that could help everyone advance is a form of combat. Business ideology does not prepare people to resist the temptation to combat the competition. Some forms of combat have been made banned with anti-trust laws, truth in advertising laws, and so on, but rather than generalizing this to a principled rejection of combat in general, executives invent other forms of combat which are not specifically prohibited. Society's resources are squandered on the economic equivalent of factional civil war. "Why Don't You Move to Russia?" ******************************* In the United States, any advocate of other than the most extreme form of laissez-faire selfishness has often heard this accusation. For example, it is leveled against the supporters of a national health care system, such as is found in all the other industrialized nations of the free world. It is leveled against the advocates of public support for the arts, also universal in advanced nations. The idea that citizens have any obligation to the public good is identified in America with Communism. But how similar are these ideas? Communism as was practiced in the Soviet Union was a system of central control where all activity was regimented, supposedly for the common good, but actually for the sake of the members of the Communist party. And where copying equipment was closely guarded to prevent illegal copying. The American system of intellectual property exercises central control over distribution of a program, and guards copying equipment with automatic copying protection schemes to prevent illegal copying. By contrast, I am working to build a system where people are free to decide their own actions; in particular, free to help their neighbors, and free to alter and improve the tools which they use in their daily lives. A system based on voluntary cooperation, and decentralization. Thus, if we are to judge views by their resemblance to Russian Communism, it is the software owners who are the Communists. The Question of Premises ************************ I make the assumption in this paper that a user of software is no less important than an author, or even an author's employer. In other words, their interests and needs have equal weight, when we decide which course of action is best. This premise is not universally accepted. Many maintain that an author's employer is fundamentally more important than anyone else. They say, for example, that the purpose of having owners of software is to give the author's employer the advantage he deserves--regardless of how this may affect the public. It is no use trying to prove or disprove these premises. Proof requires shared premises. So most of what I have to say is addressed only to those who share the premises I use, or at least are interested in what their consequences are. For those who believe that the owners are more important than everyone else, this paper is simply irrelevant. But why would a large number of Americans accept a premise which elevates certain people in importance above everyone else? Partly because of the belief that this premise is part of the legal traditions of American society. Some people feel that doubting the premise means challenging the basis of society. It is important for these people to know that this premise is not part of our legal tradition. It never has been. Thus, the Constitution says that the purpose of copyright is to "promote the progress of science and the useful arts." The Supreme Court has elaborated on this, stating in `Fox Film vs. Doyal' that "The sole interest of the United States and the primary object in conferring the [copyright] monopoly lie in the general benefits derived by the public from the labors of authors." We are not required to agree with the Constitution or the Supreme Court. (At one time, they both condoned slavery.) So their positions do not disprove the owner supremacy premise. But I hope that the awareness that this is a radical right-wing assumption rather than a traditionally recognized one will weaken its appeal. Conclusion ********** We like to think that our society encourages helping your neighbor; but each time we reward someone for obstructionism, or admire them for the wealth they have gained in this way, we are sending the opposite message. Software hoarding is one form of our general willingness to disregard the welfare of society for personal gain. We can trace this disregard from Ronald Reagan to Jim Bakker, from Ivan Boesky to Exxon, from failing banks to failing schools. We can measure it with the size of the homeless population and the prison population. The antisocial spirit feeds on itself, because the more we see that other people will not help us, the more it seems futile to help them. Thus society decays into a jungle. If we don't want to live in a jungle, we must change our attitudes. We must start sending the message that a good citizen is one who cooperates when appropriate, not one who is successful at taking from others. I hope that the free software movement will contribute to this: at least in one area, we will replace the jungle with a more efficient system which encourages and runs on voluntary cooperation. ---------- Footnotes ---------- (1) The word "free" in "free software" refers to freedom, not to price; the price paid for a copy of a free program may be zero, or small, or (rarely) quite large. (2) The issues of pollution and traffic congestion do not alter this conclusion. If we wish to make driving more expensive to discourage driving in general, it is disadvantageous to do this using toll booths, which contribute to both pollution and congestion. A tax on gasoline is much better. Likewise, a desire to enhance safety by limiting maximum speed is not relevant; a free access road enhances the average speed by avoiding stops and delays, for any given speed limit. (3) One might regard a particular computer program as a harmful thing that should not be available at all, like the Lotus Marketplace database of personal information, which was withdrawn from sale due to public disapproval. Most of what I say does not apply to this case, but it makes little sense to argue for having an owner on the grounds that the owner will make the program less available. The owner will not make it *completely* unavailable, as one would wish in the case of a program whose use is considered destructive. emacs-19.30/etc/ctags.1100666 13437 13 21 5231576065 12700 0ustar jimbuser.so man1/etags.1 emacs-19.30/etc/echo.msg100666 13437 1 6500 3755367602 13461 0ustar jimbdaemonPath: mit-amt!mit-eddie!think!harvard!seismo!gatech!akgua!whuxlm!whuxl!houxm!ihnp4!stolaf!umn-cs!herndon From: herndon@umn-cs.UUCP Newsgroups: net.sources Subject: GNU Echo, Release 1 Message-ID: <1600001@umn-cs.UUCP> Date: 28 Oct 85 18:23:00 GMT /* Written 12:22 pm Oct 28, 1985 by umn-cs!herndon in umn-cs:net.jokes */ /* ---------- "GNU Echo, Release 1" ---------- */ GNUecho(1) UNIX Programmer's Manual GNUecho(1) NAME echo - echo arguments SYNOPSIS echo [ options ] ... DESCRIPTION _^HE_^Hc_^Hh_^Ho writes its arguments separated by blanks and terminated by a newline on the standard output. Options to filter and redirect the output are as follows: -2 generate rhyming couplets from keywords -3 generate Haiku verse from keywords -5 generate limerick from keywords -a convert ASCII to ASCII -A disambiguate sentence structure -b generate bureaucratese equivalent (see -x) -B issue equivalent C code with bugs fixed -c simplify/calculate arithmetic expression(s) -C remove copyright notice(s) -d define new echo switch map -D delete all ownership information from system files -e evaluate lisp expression(s) -E convert ASCII to Navajo -f read input from file -F transliterate to french -g generate pseudo-revolutionary marxist catch-phrases -G prepend GNU manifesto -h halt system (reboot suppressed on Suns, Apollos, and VAXen, not supported on NOS-2) -i emulate IBM OS/VU (recursive universes not supported) -I emulate IBM VTOS 3.7.6 (chronosynclastic infundibulae supported with restrictions documented in IBM VTOS Printed 10/28/85 18 January 1983 1 GNUecho(1) UNIX Programmer's Manual GNUecho(1) Reference Manual rev 3.2.6) -J generate junk mail -j justify text (see -b option) -k output "echo" software tools -K delete privileged accounts -l generate legalese equivalent -L load echo modules -M generate mail -N send output to all reachable networks (usable with -J, -K, -h options) -n do not add newline to the output -o generate obscene text -O clean up dirty language -p decrypt and print /etc/passwd -P port echo to all reachable networks -P1 oolcay itay -q query standard input for arguments -r read alternate ".echo" file on start up -R change root password to "RMS" -s suspend operating system during output (Sun and VAX BSD 4.2 only) -S translate to swahili -T emulate TCP/IP handler -t issue troff output -u issue unix philosophy essay -v generate reverberating echo -V print debugging information Printed 10/28/85 18 January 1983 2 GNUecho(1) UNIX Programmer's Manual GNUecho(1) -x decrypt DES format messages (NSA secret algorithm CX 3.8, not distributed outside continental US) _^HE_^Hc_^Hh_^Ho is useful for producing diagnostics in shell programs and for writing constant data on pipes. To send diagnostics to the standard error file, do `echo ... 1>&2'. AUTHOR Richard M. Stallman Printed 10/28/85 18 January 1983 3 emacs-19.30/etc/edt-user.doc100644 75424 13 106455 5743525074 14122 0ustar kwzhuserFile: edt-user.doc --- EDT Emulation User Instructions For GNU Emacs 19 Copyright (C) 1986, 1992, 1994, 1995 Free Software Foundation, Inc. Author: Kevin Gallagher Maintainer: Kevin Gallagher Keywords: emulations 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. ============================================================================ I. OVERVIEW: This version of the EDT emulation package for GNU Emacs is a substantially enhanced version of the original. A large part of the original can still be found here, of course, but much of it has been modified and quite a bit is new. Many of the ideas found here are borrowed from others. In particular, some of the code found here was drawn from an earlier re-write of the EDT package done at DSC in 1989 by Matthew Frohman. Send bug fixes, suggestions for enhancements, and corrections to this documentation to Kevin Gallagher (kgallagh@spd.dsccc.com). The EDT emulation consists of the following files: edt-user.doc - User instructions (which you are reading now) edt.el - EDT Emulation Functions and Default Configuration edt-lk201.el - Support for DEC LK-201 Keyboards edt-vt100.el - Support for DEC VT-100 (and above) terminals edt-mapper.el - Support for Keyboards used under X Windows edt-pc.el - Support for the PC AT Keyboard under MS-DOS Several goals were kept in mind when making this version: 1. Emulate EDT Keypad Mode commands closely so that current EDT users will find that it easy and comfortable to use GNU Emacs with a small learning curve; 2. Make it easy for a user to customize EDT emulation key bindings without knowing much about Emacs Lisp; 3. Make it easy to switch between the original EDT default bindings and the user's customized bindings, without having to exit Emacs. 4. Provide support for some TPU/EVE functions not supported in EDT. 5. Provide an easy way to restore ALL original Emacs key bindings, just as they existed before the EDT emulation was first invoked. 6. Support GNU Emacs 19. (Support for GNU Emacs 18 has been dropped. Also, although there is some code designed to support Xemacs 19 (formerly Lucid Emacs), this is not fully implemented at this time. 7. When running under X, support highlighting of marked text. 8. Handle terminal configuration under X interactively when the emulation is invoked for the first time. 9. Support a PC AT keyboard under MS-DOS. II. TERMINALS/KEYBOARDS SUPPORTED: Keyboards used under X Windows are supported via the edt-mapper function. The first time you invoke the emulation under X, the edt-mapper function is run automatically and the user is prompted to identify which keys the emulation is to use for the standard keypad and function keys EDT expects (e.g., PF1, PF2, etc.). This configuration is saved to disk read each time the emulation is invoked. In character oriented connections not running a window manager, the following terminals/keyboards are supported. (1) DEC VT-100 series and higher. This includes well behaved VT clones and emulators. If you are using a VT series terminal, be sure that the term environment variable is set properly before invoking emacs. (2) PC AT keyboard under MS-DOS. Be sure to read the SPECIAL NOTES FOR SOME PLATFORMS sections to see if those notes apply to you. III. STARTING THE EDT EMULATION: Start up GNU Emacs and enter "M-x edt-emulation-on" to begin the emulation. After initialization is complete, the following message will appear below the status line informing you that the emulation has been enabled: Default EDT keymap active You can have the EDT Emulation start up automatically, each time you initiate a GNU Emacs session, by adding the following line to your .emacs file: (setq term-setup-hook 'edt-emulation-on) A reference sheet is included (later on) listing the default EDT Emulation key bindings. This sheet is also accessible on line from within Emacs by pressing PF2, GOLD H, or HELP (when in the EDT Default Mode). It is easy to customize key bindings in the EDT Emulation. (See CUSTOMIZING section, below.) Customizations are placed in a file called edt-user.el. (A sample edt-user.el file can be found in the CUSTOMIZING section.) If edt-user.el is found in your GNU Emacs load path during EDT Emulation initialization, then the following message will appear below the status line indicating that the emulation has been enabled, enhanced by your own customizations: User EDT custom keymap active Once enabled, it is easy to switch back and forth between your customized EDT Emulation key bindings and the default EDT Emulation key bindings. It is also easy to turn off the emulation. Doing so completely restores the original key bindings in effect just prior to invoking the emulation. Where EDT key bindings and GNU Emacs key bindings conflict, the default GNU Emacs key bindings are retained by the EDT emulation by default. If you are a diehard EDT user you may not like this. The CUSTOMIZING section explains how to change this default. IV. SPECIAL NOTES FOR SOME PLATFORMS: Sun Workstations running X: Some earlier Sun keyboards do not have arrow keys separate from the keypad keys. It is difficult to emulate the full EDT keypad and still retain use of the arrow keys on such keyboards. The Sun Type 5 keyboard, however, does have separate arrow keys. This makes it a candidate for setting up a reasonable EDT keypad emulation. Unfortunately, Sun's default X keynames for the keypad keys don't permit GNU Emacs to interpret the keypad 2, 4, 6, and 8 keys as something other than arrow keys, nor use all the top row of keys for PF1 thru PF4 keys. Here's the contents of an .xmodmaprc file which corrects this problem for Sun Type 5 keyboards: ! File: .xmodmaprc ! ! Set up Sun Type 5 keypad for use with the GNU Emacs EDT Emulation ! keycode 53 = KP_Divide keycode 54 = KP_Multiply keycode 57 = KP_Decimal keycode 75 = KP_7 keycode 76 = KP_8 keycode 77 = KP_9 keycode 78 = KP_Subtract keycode 97 = KP_Enter keycode 98 = KP_4 keycode 99 = KP_5 keycode 100 = KP_6 keycode 101 = KP_0 keycode 105 = F24 keycode 119 = KP_1 keycode 120 = KP_2 keycode 121 = KP_3 keycode 132 = KP_Add Feed .xmodmaprc to the xmodmap command and all the Sun Type 5 keypad keys will now be configurable for the emulation of an LK-201 keypad (less the comma key). The line keycode 105 = F24 modifies the NumLock key to be the F24 key which can then be configured to behave as the PF1 key. In doing so, you will no longer have a NumLock key. If you are using other software under X which requires a NumLock key, then examine your keyboard and look for one you don't use and redefine it to be the NumLock key. (See the man page on xmodmap for for further help on how to do this.) PC users running MS-DOS: By default, F1 is configured to emulate the PF1 (GOLD) key. But NumLock can be used instead if you load a freeware TSR distributed with MS-Kermit, call gold.com. It is distributed in a file called gold22.zip and comes with the source code as well as a loadable binary image. (See edt-pc.el for more information.) PC users running Linux: The default X server configuration of three keys PC AT keyboard keys needs to be modified to permit the PC keyboard to emulate an LK-201 keyboard properly. Here's the contents of an .xmodmaprc file which makes these changes for your: ! File: .xmodmaprc ! ! Set up PC keypad under Linux for the GNU Emacs EDT Emulation ! keycode 22 = BackSpace keycode 77 = F12 keycode 96 = Num_Lock Feed the file to the xmodmap command and all the PC keypad keys will now be configurable for the emulation of an LK-201 keypad (less the comma key), the standard keyboard supplied with DEC terminals VT-200 and above. This file switches the role of the F12 and NumLock keys. It also modifies the definition of the Delete key above the arrow keys so that it can be assigned a keybinding independently of the the BackSpace key. NOTE: It is necessary to have NumLock ON for the PC keypad to emulate the LK-201 keypad properly. V. HOW DOES THIS EDT EMULATION DIFFER FROM REAL EDT?: In general, you will find that this emulation of EDT replicates most, but not all, of EDT's most used Keypad Mode editing functions and behavior. It is not perfect, but most EDT users who have tried the emulation agree that it is quite good enough to make it easy for die-hard EDT users to move over to using GNU Emacs. Here's a list of the most important differences between EDT and this GNU Emacs EDT Emulation. The list is short but you must be aware of these differences if you are to use the EDT Emulation effectively. 1. Entering repeat counts works a little differently than in EDT. EDT allows users to enter a repeat count before entering a command that accepts repeat counts. For example, when in EDT, pressing these three keys in sequence, GOLD 5 KP1, will move the cursor in the current direction 5 words. Emacs provides two ways to enter repeat counts, though neither involves using the GOLD key. In Emacs, repeat counts can be entered by using the ESC key. For example, pressing these keys in sequence, ESC 1 0 KP1, will move the cursor in the current direction 10 words. Emacs provides another command called universal-argument that can do the same thing, plus a few other things. Normally, Emacs has this bound to C-u. 2. The EDT SUBS command, bound to GOLD ENTER, is NOT supported. The built-in Emacs query-replace command has been bound to GOLD ENTER, instead. It is much more convenient to use than SUBS. 3. EDT's line mode commands and nokeypad mode commands are NOT supported (with one important exception; see item 8 in the Highlights section below). Although, at first, this may seem like a big omission, the set of built-in Emacs commands provides a much richer set of capabilities which more than make up for this omission. To enter Emacs commands not bound to keys, you can press GOLD KP7 or the DO key. Emacs will display it's own command prompt called Meta-x (M-x). You can also invoke this prompt the normal Emacs way by entering ESC x. 4. Selected text is highlighted ONLY when running under X Windows. Gnu Emacs 19 does not support highlighting of text on VT series terminals, at this time. 5. Just like TPU/EVE, The ENTER key is NOT used to terminate input when the editor prompts you for input. The RETURN key is used, instead. (KP4 and KP5 do terminate input for the FIND command, just like in EDT, however.) VI. SOME HIGHLIGHTS IN THIS EDT EMULATION, AND SOME COMPARISONS TO THE ORIGINAL GNU EMACS EDT EMULATION: 1. The EDT define key command is supported (edt-define-key) and is bound to C-k in the default EDT mode when EDT control sequence bindings are enabled or one of the sample edt-user.el customization files is used. The TPU/EVE learn command is supported but not bound to a key in the default EDT mode but is bound in the sample edt-user.el files. Unlike the TPU/EVE learn command, which uses one key to begin the learn sequence, C-l, and another command to remember the sequence, C-r, this version of the learn command (edt-learn) serves as a toggle to both begin and to remember the learn sequence. Many users who change the meaning of a key with the define key and the learn commands, would like to be able to restore the original key binding without having to quit and restart emacs. So a restore key command is provided to do just that. When invoked, it prompts you to press the key to which you wish the last replaced key definition restored. It is bound to GOLD C-k in the default EDT mode when EDT control sequence bindings are enabled or one of the sample edt-user.el customization files is used. 2. Direction support is fully supported. It is no longer accomplished by re-defining keys each time the direction is changed. Thus, commands sensitive to the current direction setting may be bound easily to any key. 3. All original emacs bindings are fully restored when EDT emulation is turned off. 4. User custom EDT bindings are kept separate from the default EDT bindings. One can toggle back and forth between the custom EDT bindings and default EDT bindings. 5. The Emacs functions in edt.el attempt to emulate, where practical, the exact behavior of the corresponding EDT keypad mode commands. In a few cases, the emulation is not exact, but we hope you will agree it is close enough. In a very few cases, we chose to use the Emacs way of handling things. As mentioned earlier, we do not emulate the EDT SUBS command. Instead, we chose to use the Emacs query-replace function, which we find to be easier to use. 6. Emacs uses the regexp assigned to page-delimiter to determine what marks a page break. This is normally "^\f", which causes the edt-page command to ignore form feeds not located at the beginning of a line. To emulate the EDT PAGE command exactly, page-delimiter is set to "\f" when EDT emulation is turned on, and restored to "^\f" when EDT emulation is turned off. But, since some users prefer the Emacs definition of a page break, or may wish to preserve a customized definition of page break, one can override the EDT definition by placing (setq edt-keep-current-page-delimiter t) in your .emacs file. 7. The EDT definition of a section of a terminal window is hardwired to be 16 lines of its one-and-only 24-line window (the EDT SECT command bound to KP8). That's two-thirds of the window at a time. Since Emacs, like TPU/EVE, can handle multiple windows of sizes of other than 24 lines, the definition of section used here has been modified to two-thirds of the current window. (There is also an edt-scroll-window function which you may prefer over the SECT emulation.) 8. Cursor movement and deletion involving word entities is identical to EDT. This, above all else, gives the die-hard EDT user a sense of being at home. Also, an emulation of EDT's SET ENTITY WORD command is provided, for those users who like to customize movement by a word at a time to their own liking. 9. EDT's FIND and FNDNXT are supported. 10. EDT's APPEND and REPLACE commands are supported. 11. CHNGCASE is supported. It works on individual characters or selected text, if SELECT is active. In addition, two new commands are provided: edt-lowercase and edt-uppercase. They work on individual WORDS or selected text, if SELECT is active. 12. Form feed and tab insert commands are supported. 13. A new command, edt-duplicate-word, is provided. If you experiment with it, you might find it to be surprisingly useful and may wonder how you ever got along without it! It is assigned to C-j in the sample edt-user.el customization files. 14. TPU/EVE's Retangular Cut and Paste functions (originally from the EVE-Plus package) are supported. But unlike the TPU/EVE versions, these here support both insert and overwrite modes. The seven retangular functions are bound to F7, F8, GOLD-F8, F9, GOLD-F9, F10, and GOLD-F10 in the default EDT mode. 15. The original EDT emulation package set up many default regular and GOLD bindings. We tried to preserve most (but not all!) of these, so users of the original emulation package will feel more at home. Nevertheless, there are still many GOLD key sequences which are not bound to any functions. These are prime candidates to use for your own customizations. Also, there are several commands in edt.el not bound to any key. So, you will find it worthwhile to look through edt.el for functions you may wish to add to your personal customized bindings. 16. The VT200/VT300 series terminals steal the function keys F1 to F5 for their own use. These do not generate signals which are sent to the host. So, edt.el does not assign any default bindings to F1 through F5. In addition, our VT220 terminals generate an interrupt when the F6 key is pressed (^C or ^Y, can't remember which) and not the character sequence documented in the manual. So, binding emacs commands to F6 will not work if your terminal behaves the same way. 17. The VT220 terminal has no ESC, BS, nor LF keys, as does a VT100. So the default EDT bindings adopt the standard DEC convention of having the F11, F12, and F13 keys, on a VT200 series (and above) terminal, assigned to the same EDT functions that are bound to ESC, BS, and LF on a VT100 terminal. 18. Each user, through the use of a private edt-user.el file, can customize, very easily, personal EDT emulation bindings. 19. The EDT SELECT and RESET functions are supported. However, unlike EDT, pressing RESET to cancel text selection does NOT reset the existing setting of the current direction. We also provide a TPU/EVE like version of the single SELECT/RESET function, called edt-toggle-select, which makes the EDT SELECT function into a toggle on/off switch. That is, if selection is ON, pressing SELECT again turns selection off (cancels selection). This function is used in the sample edt-user.el customization files. VII. CUSTOMIZING: Most EDT users, at one time or another, make some custom key bindings, or use someone else's custom key bindings, which they come to depend upon just as if they were built-in bindings. This EDT Emulation for GNU Emacs is designed to make it easy to customize bindings. If you wish to customize the EDT Emulation to use some of your own key bindings, you need to make a private version of edt-user.el in your own private lisp directory. There are two sample files edt-user.el1 and edt-user.el2 for you to use as templates and for ideas. Look at edt-user.el1 first. Unless you will be using two or more very different types of terminals on the same system, you need not look at edt-user.el2. First, you need to have your own private lisp directory, say ~/lisp, and you should add it to the GNU Emacs load path. NOTE: A few sites have different load-path requirements, so the above directions may need some modification if your site has such special needs. Creating your own edt-user.el file: A sample edt-user.el file is attached to the end of this user documentation. You should use it as a guide to learn how you can customize EDT emulation bindings to your own liking. Names used to identify the set of LK-201 keypad and function keys are: Keypad Keys: PF1 PF2 PF3 PF4 KP7 KP8 KP9 KP- KP4 KP5 KP6 KP, KP1 KP2 KP3 KP0 KPP KPE Arrow Keys: LEFT RIGHT DOWN UP Function Keys: F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12 F13 F14 HELP DO F17 F18 F19 F20 FIND INSERT REMOVE SELECT PREVIOUS NEXT Note: Many VT-200 terminals, and above, steal function keys F1 thru F5 for terminal setup control and don't send anything to the host if pressed. So customizing bindings to these keys may not work for you. There are three basic functions that do the EDT emulation bindings: edt-bind-standard-key, edt-bind-gold-key, and edt-bind-function-key. The first two are for binding functions to keys which are standard across most keyboards. This makes them keyboard independent, making it possible to define these key bindings for all terminals in the file edt.el. The first, edt-bind-standard-key, is used typically to bind emacs commands to control keys, although some people use it to bind commands to other keys, as well. (For example, some people use it to bind the VT200 seldom used back-tick key (`) to the function "ESC-prefix" so it will behave like an ESC key.) The second function, edt-bind-gold-key, is used to bind emacs commands to gold key sequences involving alpha-numeric keys, special character keys, and control keys. The third function, edt-bind-function-key, is terminal dependent and is defined in a terminal specific file (see edt-vt100.el for example). It is used to bind emacs commands to function keys, to keypad keys, and to gold sequences of those keys. WARNING: Each of the three functions, edt-bind-function-key, edt-bind-gold-key, and edt-bind-standard-key, has an optional last argument. The optional argument should NOT be used in edt-user.el! When the optional argument is missing, each function knows to make the key binding part of the user's EDT custom bindings, which is what you want to do in edt-user.el! The EDT default bindings are set up in edt.el by calling these same functions with the optional last argument set to "t". So, if you decide to copy such function calls from edt.el to edt-user.el for subsequent modification, BE SURE TO DELETE THE "t" AT THE END OF EACH PARAMETER LIST! SPECIFYING WORD ENTITIES: The variable edt-word-entities is used to emulate EDT's SET ENTITY WORD command. It contains a list of characters to be treated as words in themselves. If the user does not define edt-word-entities in his/her .emacs file, then it is set up with the EDT default containing only TAB. The characters are stored in the list by their numerical values, not as strings. Emacs supports several ways to specify the numerical value of a character. One method is to use the question mark: ?A means the numerical value for A, ?/ means the numerical value for /, and so on. Several unprintable characters have special representations: ?\b specifies BS, C-h ?\t specifies TAB, C-i ?\n specifies LFD, C-j ?\v specifies VTAB, C-k ?\f specifies FF, C-l ?\r specifies CR, C-m ?\e specifies ESC, C-[ ?\\ specifies \ Here are some examples: (setq edt-word-entities '(?\t ?- ?/)) ;; Specifies TAB, - , and / (setq edt-word-entities '(?\t) ;; Specifies TAB, the default You can also specify characters by their decimal ascii values: (setq edt-word-entities '(9 45 47)) ;; Specifies TAB, - , and / ENABLING EDT CONTROL KEY SEQUENCE BINDINGS: Where EDT key bindings and GNU Emacs key bindings conflict, the default GNU Emacs key bindings are retained by default. Some diehard EDT users may not like this. So, if the variable edt-use-EDT-control-key-bindings is set to true in a user's .emacs file, then the default EDT Emulation mode will enable most of the original EDT control key sequence bindings. If you wish to do this, add the following line to your .emacs file: (setq edt-use-EDT-control-key-bindings t) DEFAULT EDT Keypad F7: Copy Rectangle +----------+----------+----------+----------+ F8: Cut Rect Overstrike |Prev Line |Next Line |Bkwd Char |Frwd Char | G-F8: Paste Rect Overstrike | (UP) | (DOWN) | (LEFT) | (RIGHT) | F9: Cut Rect Insert |Window Top|Window Bot|Bkwd Sent |Frwd Sent | G-F9: Paste Rect Insert +----------+----------+----------+----------+ F10: Cut Rectangle G-F10: Paste Rectangle F11: ESC F12: Begining of Line +----------+----------+----------+----------+ G-F12: Delete Other Windows | GOLD | HELP | FNDNXT | DEL L | F13: Delete to Begin of Word | (PF1) | (PF2) | (PF3) | (PF4) | HELP: Keypad Help |Mark Wisel|Desc Funct| FIND | UND L | DO: Execute extended command +----------+----------+----------+----------+ | PAGE | SECT | APPEND | DEL W | C-g: Keyboard Quit | (7) | (8) | (9) | (-) | G-C-g: Keyboard Quit |Ex Ext Cmd|Fill Regio| REPLACE | UND W | C-h: Beginning of Line +----------+----------+----------+----------+ G-C-h: Emacs Help | ADVANCE | BACKUP | CUT | DEL C | C-i: Tab Insert | (4) | (5) | (6) | (,) | C-j: Delete to Begin of Word | BOTTOM | TOP | Yank | UND C | C-k: Define Key +----------+----------+----------+----------+ G-C-k: Restore Key | WORD | EOL | CHAR | Next | C-l: Form Feed Insert | (1) | (2) | (3) | Window | C-n: Set Screen Width 80 | CHNGCASE | DEL EOL |Quoted Ins| ! C-r: Isearch Backward +---------------------+----------+ (ENTER) | C-s: Isearch Forward | LINE | SELECT | ! C-t: Display the Time | (0) | (.) | Query | C-u: Delete to Begin of Line | Open Line | RESET | Replace | C-v: Redraw Display +---------------------+----------+----------+ C-w: Set Screen Width 132 C-z: Suspend Emacs +----------+----------+----------+ G-C-\: Split Window | FNDNXT | Yank | CUT | | (FIND) | (INSERT) | (REMOVE) | G-b: Buffer Menu | FIND | | COPY | G-c: Compile +----------+----------+----------+ G-d: Delete Window |SELECT/RES|SECT BACKW|SECT FORWA| G-e: Exit | (SELECT) |(PREVIOUS)| (NEXT) | G-f: Find File | | | | G-g: Find File Other Window +----------+----------+----------+ G-h: Keypad Help G-i: Insert File G-k: Toggle Capitalization Word G-l: Lowercase Word or Region G-m: Save Some Buffers G-n: Next Error G-o: Switch to Next Window G-q: Quit G-r: Revert File G-s: Save Buffer G-u: Uppercase Word or Region G-v: Find File Other Window G-w: Write file G-y: EDT Emulation OFF G-z: Switch to User EDT Key Bindings G-1: Delete Other Windows G-2: Split Window G-%: Go to Percentage G- : Undo (GOLD Spacebar) G-=: Go to Line G-`: What line ;;; File: edt-user.el --- Sample User Customizations for the Enhanced ;;; EDT Keypad Mode Emulation ;;; ;;; For GNU Emacs 19 ;;; ;; Copyright (C) 1986, 1992, 1993 Free Software Foundation, Inc. ;; Author: Kevin Gallagher ;; Maintainer: Kevin Gallagher ;; Keywords: emulations ;; 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 file contains GNU Emacs User Custom EDT bindings and functions. In ;; this example file, there is no special test for the type of terminal being ;; used. The assumption is that all key bindings here apply to all terminals ;; that may be used. (In fact, it was written by an individual who uses only ;; VT series terminals when logging into a VAX.) ;; ;; WARNING: Each of the three functions, edt-bind-function-key, ;; edt-bind-gold-key, and edt-bind-standard-key, has an optional ;; last argument. The optional argument should NOT be used in ;; edt-user.el! When the optional argument is missing, each ;; function knows to make the key binding part of the user's EDT ;; custom bindings, which is what you want to do in edt-user.el! ;; ;; The EDT default bindings are set up in edt.el by calling these ;; same functions with the optional last argument set to "t". So, if ;; you decide to copy such function calls from edt.el to edt-user.el ;; for subsequent modification, BE SURE TO DELETE THE "t" AT THE END ;; OF EACH PARAMETER LIST! ;; ;;; Usage: ;; See edt-user.doc in the emacs etc directory. ;; ==================================================================== ;;;; ;;;; Setup user custom EDT key bindings. ;;;; (defun edt-setup-user-bindings () "Assigns user custom EDT Emulation keyboard bindings." ;; PF1 (GOLD), PF2, PF3, PF4 ;; ;; This file MUST contain a binding of PF1 to edt-user-gold-map. So ;; DON'T CHANGE OR DELETE THE REGULAR KEY BINDING OF PF1 BELOW! ;; (However, you may change the GOLD-PF1 binding, if you wish.) (edt-bind-function-key "PF1" 'edt-user-gold-map 'edt-mark-section-wisely) (edt-bind-function-key "PF2" 'query-replace 'other-window) (edt-bind-function-key "PF4" 'edt-delete-entire-line 'edt-undelete-line) ;; EDT Keypad Keys (edt-bind-function-key "KP1" 'edt-word-forward 'edt-change-case) (edt-bind-function-key "KP3" 'edt-word-backward 'edt-copy) (edt-bind-function-key "KP6" 'edt-cut-or-copy 'yank) (edt-bind-function-key "KP8" 'edt-scroll-window 'fill-paragraph) (edt-bind-function-key "KP9" 'open-line 'edt-eliminate-all-tabs) (edt-bind-function-key "KPP" 'edt-toggle-select 'edt-line-to-middle-of-window) (edt-bind-function-key "KPE" 'edt-change-direction 'overwrite-mode) ;; GOLD bindings for regular keys. (edt-bind-gold-key "a" 'edt-append) (edt-bind-gold-key "A" 'edt-append) (edt-bind-gold-key "h" 'edt-electric-user-keypad-help) (edt-bind-gold-key "H" 'edt-electric-user-keypad-help) ;; Control bindings for regular keys. ;;; Leave binding of C-c as original prefix key. (edt-bind-standard-key "\C-j" 'edt-duplicate-word) (edt-bind-standard-key "\C-k" 'edt-define-key) (edt-bind-gold-key "\C-k" 'edt-restore-key) (edt-bind-standard-key "\C-l" 'edt-learn) ;;; Leave binding of C-m to newline. (edt-bind-standard-key "\C-n" 'edt-set-screen-width-80) (edt-bind-standard-key "\C-o" 'open-line) (edt-bind-standard-key "\C-p" 'fill-paragraph) ;;; Leave binding of C-r to isearch-backward. ;;; Leave binding of C-s to isearch-forward. (edt-bind-standard-key "\C-t" 'edt-display-the-time) (edt-bind-standard-key "\C-v" 'redraw-display) (edt-bind-standard-key "\C-w" 'edt-set-screen-width-132) ;;; Leave binding of C-x as original prefix key. ) ;;; ;;; LK-201 KEYBOARD USER EDT KEYPAD HELP ;;; (defun edt-user-keypad-help () " USER EDT Keypad Active +----------+----------+----------+----------+ F7: Copy Rectangle |Prev Line |Next Line |Bkwd Char |Frwd Char | F8: Cut Rect Overstrike | (UP) | (DOWN) | (LEFT) | (RIGHT) | G-F8: Paste Rect Overstrike |Window Top|Window Bot|Bkwd Sent |Frwd Sent | F9: Cut Rect Insert +----------+----------+----------+----------+ G-F9: Paste Rect Insert F10: Cut Rectangle G-F10: Paste Rectangle F11: ESC +----------+----------+----------+----------+ F12: Begining of Line | GOLD |Query Repl| FNDNXT |Del Ent L | G-F12: Delete Other Windows | (PF1) | (PF2) | (PF3) | (PF4) | F13: Delete to Begin of Word |Mark Wisel|Other Wind| FIND | UND L | HELP: Keypad Help +----------+----------+----------+----------+ DO: Execute extended command | PAGE |Scroll Win|Open Line | DEL W | | (7) | (8) | (9) | (-) | C-a: Beginning of Line |Ex Ext Cmd|Fill Parag|Elim Tabs | UND W | C-b: Switch to Buffer +----------+----------+----------+----------+ C-d: Delete Character | ADVANCE | BACKUP | CUT/COPY | DEL C | C-e: End of Line | (4) | (5) | (6) | (,) | C-f: Forward Character | BOTTOM | TOP | Yank | UND C | C-g: Keyboard Quit +----------+----------+----------+----------+ G-C-g: Keyboard Quit | Fwd Word | EOL | Bwd Word | Change | C-h: Electric Emacs Help | (1) | (2) | (3) | Direction| G-C-h: Emacs Help | CHNGCASE | DEL EOL | COPY | | C-i: Indent for Tab +---------------------+----------+ (ENTER) | C-j: Duplicate Word | LINE |SELECT/RES| | C-k: Define Key | (0) | (.) | Toggle | G-C-k: Restore Key | Open Line |Center Lin|Insrt/Over| C-l: Learn +---------------------+----------+----------+ C-n: Set Screen Width 80 C-o: Open Line +----------+----------+----------+ C-p: Fill Paragraph | FNDNXT | Yank | CUT | C-q: Quoted Insert | (FIND)) | (INSERT) | (REMOVE) | C-r: Isearch Backward | FIND | | COPY | C-s: Isearch Forward +----------+----------+----------+ C-t: Display the Time |SELECT/RES|SECT BACKW|SECT FORWA| C-u: Universal Argument | (SELECT) |(PREVIOUS)| (NEXT) | C-v: Redraw Display | | | | C-w: Set Screen Width 132 +----------+----------+----------+ C-z: Suspend Emacs G-C-\\: Split Window G-a: Append to Kill Buffer G-b: Buffer Menu G-c: Compile G-d: Delete Window G-e: Exit G-f: Find File G-g: Find File Other Window G-h: Keypad Help G-i: Insert File G-k: Toggle Capitalization Word G-l: Lowercase Word or Region G-m: Save Some Buffers G-n: Next Error G-o: Switch Windows G-q: Quit G-r: Revert File G-s: Save Buffer G-u: Uppercase Word or Region G-v: Find File Other Window G-w: Write file G-y: EDT Emulation OFF G-z: Switch to Default EDT Key Bindings G-2: Split Window G-%: Go to Percentage G- : Undo (GOLD Spacebar) G-=: Go to Line G-`: What line" (interactive) (describe-function 'edt-user-keypad-help)) emacs-19.30/etc/emacs.1100644 12120 13 33463 5610325771 12624 0ustar rmsuser.TH EMACS 1 "1994 April 19" .UC 4 .SH NAME emacs \- GNU project Emacs .SH SYNOPSIS .B emacs [ .I command-line switches ] [ .I files ... ] .br .SH DESCRIPTION .I GNU Emacs is a version of .I Emacs, written by the author of the original (PDP-10) .I Emacs, Richard Stallman. .br The primary documentation of GNU Emacs is in the GNU Emacs Manual, which you can read on line using Info, a subsystem of Emacs. Please look there for complete and up-to-date documentation. This man page is updated only when someone volunteers to do so; the Emacs maintainers' priority goal is to minimize the amount of time this man page takes away from other more useful projects. .br The user functionality of GNU Emacs encompasses everything other .I Emacs editors do, and it is easily extensible since its editing commands are written in Lisp. .PP .I Emacs has an extensive interactive help facility, but the facility assumes that you know how to manipulate .I Emacs windows and buffers. CTRL-h (backspace or CTRL-h) enters the Help facility. Help Tutorial (CTRL-h t) requests an interactive tutorial which can teach beginners the fundamentals of .I Emacs in a few minutes. Help Apropos (CTRL-h a) helps you find a command given its functionality, Help Character (CTRL-h c) describes a given character's effect, and Help Function (CTRL-h f) describes a given Lisp function specified by name. .PP .I Emacs's Undo can undo several steps of modification to your buffers, so it is easy to recover from editing mistakes. .PP .I GNU Emacs's many special packages handle mail reading (RMail) and sending (Mail), outline editing (Outline), compiling (Compile), running subshells within .I Emacs windows (Shell), running a Lisp read-eval-print loop (Lisp-Interaction-Mode), and automated psychotherapy (Doctor). .PP There is an extensive reference manual, but users of other Emacses should have little trouble adapting even without a copy. Users new to .I Emacs will be able to use basic features fairly rapidly by studying the tutorial and using the self-documentation features. .PP .SM Emacs Options .PP The following options are of general interest: .TP 8 .I file Edit .I file. .TP .BI \+ number Go to the line specified by .I number (do not insert a space between the "+" sign and the number). .TP .B \-q Do not load an init file. .TP .BI \-u " user" Load .I user's init file. .TP .BI \-t " file" Use specified .I file as the terminal instead of using stdin/stdout. This must be the first argument specified in the command line. .PP The following options are lisp-oriented (these options are processed in the order encountered): .TP 8 .BI \-f " function" Execute the lisp function .I function. .TP .BI \-l " file" Load the lisp code in the file .I file. .PP The following options are useful when running .I Emacs as a batch editor: .TP 8 .BI \-batch Edit in batch mode. The editor will send messages to stdout. This option must be the first in the argument list. You must use -l and -f options to specify files to execute and functions to call. .TP .B \-kill Exit .I Emacs while in batch mode. .\" START DELETING HERE IF YOU'RE NOT USING X .PP .SM Using Emacs with X .PP .I Emacs has been tailored to work well with the X window system. If you run .I Emacs from under X windows, it will create its own X window to display in. You will probably want to start the editor as a background process so that you can continue using your original window. .PP .I Emacs can be started with the following X switches: .TP 8 .BI \-rn " name" Specifies the program name which should be used when looking up defaults in the user's X resources. This must be the first option specified in the command line. .TP 8 .BI \-name " name" Specifies the name which should be assigned to the .I Emacs window. .TP 8 .B \-r Display the .I Emacs window in reverse video. .TP .B \-i Use the "kitchen sink" bitmap icon when iconifying the .I Emacs window. .TP .BI \-font " font, " \-fn " font" Set the .I Emacs window's font to that specified by .I font. You will find the various .I X fonts in the .I /usr/lib/X11/fonts directory. Note that .I Emacs will only accept fixed width fonts. Under the X11 Release 4 font-naming conventions, any font with the value "m" or "c" in the eleventh field of the font name is a fixed width font. Furthermore, fonts whose name are of the form .IR width x height are generally fixed width, as is the font .IR fixed . See .IR xlsfonts (1) for more information. When you specify a font, be sure to put a space between the switch and the font name. .TP .BI \-b " pixels" Set the .I Emacs window's border width to the number of pixels specified by .I pixels. Defaults to one pixel on each side of the window. .TP .BI \-ib " pixels" Set the window's internal border width to the number of pixels specified by .I pixels. Defaults to one pixel of padding on each side of the window. .PP .TP 8 .BI \-geometry " geometry" Set the .I Emacs window's width, height, and position as specified. The geometry specification is in the standard X format; see .IR X (1) for more information. The width and height are specified in characters; the default is 80 by 24. .PP .TP 8 .BI \-fg " color" On color displays, sets the color of the text. See the file .I /usr/lib/X11/rgb.txt for a list of valid color names. .TP .BI \-bg " color" On color displays, sets the color of the window's background. .TP .BI \-bd " color" On color displays, sets the color of the window's border. .TP .BI \-cr " color" On color displays, sets the color of the window's text cursor. .TP .BI \-ms " color" On color displays, sets the color of the window's mouse cursor. .TP .BI \-d " displayname, " \-display " displayname" Create the .I Emacs window on the display specified by .IR displayname . Must be the first option specified in the command line. .TP .B \-nw Tells .I Emacs not to use its special interface to X. If you use this switch when invoking .I Emacs from an .IR xterm (1) window, display is done in that window. This must be the first option specified in the command line. .PP You can set .I X default values for your .I Emacs windows in your .I \.Xresources file (see .IR xrdb (1)). Use the following format: .IP emacs.keyword:value .PP where .I value specifies the default value of .I keyword. .I Emacs lets you set default values for the following keywords: .TP 8 .B font (\fPclass\fB Font) Sets the window's text font. .TP .B reverseVideo (\fPclass\fB ReverseVideo) If .I reverseVideo's value is set to .I on, the window will be displayed in reverse video. .TP .B bitmapIcon (\fPclass\fB BitmapIcon) If .I bitmapIcon's value is set to .I on, the window will iconify into the "kitchen sink." .TP .B borderWidth (\fPclass\fB BorderWidth) Sets the window's border width in pixels. .TP .B internalBorder (\fPclass\fB BorderWidth) Sets the window's internal border width in pixels. .TP .B foreground (\fPclass\fB Foreground) For color displays, sets the window's text color. .TP .B background (\fPclass\fB Background) For color displays, sets the window's background color. .TP .B borderColor (\fPclass\fB BorderColor) For color displays, sets the color of the window's border. .TP .B cursorColor (\fPclass\fB Foreground) For color displays, sets the color of the window's text cursor. .TP .B pointerColor (\fPclass\fB Foreground) For color displays, sets the color of the window's mouse cursor. .TP .B geometry (\fPclass\fB Geometry) Sets the geometry of the .I Emacs window (as described above). .TP .B title (\fPclass\fB Title) Sets the title of the .I Emacs window. .TP .B iconName (\fPclass\fB Title) Sets the icon name for the .I Emacs window icon. .PP If you try to set color values while using a black and white display, the window's characteristics will default as follows: the foreground color will be set to black, the background color will be set to white, the border color will be set to grey, and the text and mouse cursors will be set to black. .PP .SM Using the Mouse .PP The following lists the mouse button bindings for the .I Emacs window under X11. .in +\w'CTRL-SHIFT-middle'u+4n .ta \w'CTRL-SHIFT-middle'u+4n .ti -\w'CTRL-SHIFT-middle'u+4n MOUSE BUTTON FUNCTION .br .ti -\w'CTRL-SHIFT-middle'u+4n left Set point. .br .ti -\w'CTRL-SHIFT-middle'u+4n middle Paste text. .br .ti -\w'CTRL-SHIFT-middle'u+4n right Cut text into X cut buffer. .br .ti -\w'CTRL-SHIFT-middle'u+4n SHIFT-middle Cut text into X cut buffer. .br .ti -\w'CTRL-SHIFT-middle'u+4n SHIFT-right Paste text. .br .ti -\w'CTRL-SHIFT-middle'u+4n CTRL-middle Cut text into X cut buffer and kill it. .br .ti -\w'CTRL-SHIFT-middle'u+4n CTRL-right Select this window, then split it into two windows. Same as typing CTRL-x 2. .\" START DELETING HERE IF YOU'RE NOT USING X MENUS .br .ti -\w'CTRL-SHIFT-middle'u+4n CTRL-SHIFT-left X buffer menu--hold the buttons and keys down, wait for menu to appear, select buffer, and release. Move mouse out of menu and release to cancel. .br .ti -\w'CTRL-SHIFT-middle'u+4n CTRL-SHIFT-middle X help menu--pop up index card menu for Emacs help. .\" STOP DELETING HERE IF YOU'RE NOT USING X MENUS .br .ti -\w'CTRL-SHIFT-middle'u+4n CTRL-SHIFT-right Select window with mouse, and delete all other windows. Same as typing CTRL-x 1. .\" STOP DELETING HERE IF YOU'RE NOT USING X .PP .SH MANUALS You can order printed copies of the GNU Emacs Manual from the Free Software Foundation, which develops GNU software. See the file ORDERS for ordering information. .br Your local Emacs maintainer might also have copies available. As with all software and publications from FSF, everyone is permitted to make and distribute copies of the Emacs manual. The TeX source to the manual is also included in the Emacs source distribution. .PP .SH FILES /usr/local/info - files for the Info documentation browser (a subsystem of Emacs) to refer to. Currently not much of Unix is documented here, but the complete text of the Emacs reference manual is included in a convenient tree structured form. /usr/local/lib/emacs/$VERSION/src - C source files and object files /usr/local/lib/emacs/$VERSION/lisp - Lisp source files and compiled files that define most editing commands. Some are preloaded; others are autoloaded from this directory when used. /usr/local/lib/emacs/$VERSION/etc - various programs that are used with GNU Emacs, and some files of information. /usr/local/lib/emacs/$VERSION/etc/DOC.* - contains the documentation strings for the Lisp primitives and preloaded Lisp functions of GNU Emacs. They are stored here to reduce the size of Emacs proper. /usr/local/lib/emacs/$VERSION/etc/DIFF discusses GNU Emacs vs. Twenex Emacs; .br /usr/local/lib/emacs/$VERSION/etc/CCADIFF discusses GNU Emacs vs. CCA Emacs; .br /usr/local/lib/emacs/$VERSION/etc/GOSDIFF discusses GNU Emacs vs. Gosling Emacs. .br /usr/local/lib/emacs/$VERSION/etc/SERVICE lists people offering various services to assist users of GNU Emacs, including education, troubleshooting, porting and customization. .br These files also have information useful to anyone wishing to write programs in the Emacs Lisp extension language, which has not yet been fully documented. /usr/local/lib/emacs/lock - holds lock files that are made for all files being modified in Emacs, to prevent simultaneous modification of one file by two users. /usr/local/lib/emacs/$VERSION/$ARCHITECTURE/cpp - the GNU cpp, needed for building Emacs on certain versions of Unix where the standard cpp cannot handle long names for macros. .\" START DELETING HERE IF YOU'RE NOT USING X /usr/lib/X11/rgb.txt - list of valid X color names. .\" STOP DELETING HERE IF YOU'RE NOT USING X .PP .SH BUGS There is a mailing list, bug-gnu-emacs@prep.ai.mit.edu on the internet (ucbvax!prep.ai.mit.edu!bug-gnu-emacs on UUCPnet), for reporting Emacs bugs and fixes. But before reporting something as a bug, please try to be sure that it really is a bug, not a misunderstanding or a deliberate feature. We ask you to read the section ``Reporting Emacs Bugs'' near the end of the reference manual (or Info system) for hints on how and when to report bugs. Also, include the version number of the Emacs you are running in \fIevery\fR bug report that you send in. Do not expect a personal answer to a bug report. The purpose of reporting bugs is to get them fixed for everyone in the next release, if possible. For personal assistance, look in the SERVICE file (see above) for a list of people who offer it. Please do not send anything but bug reports to this mailing list. Send requests to be added to mailing lists to the special list info-gnu-emacs-request@prep.ai.mit.edu (or the corresponding UUCP address). For more information about Emacs mailing lists, see the file /usr/local/emacs/etc/MAILINGLISTS. Bugs tend actually to be fixed if they can be isolated, so it is in your interest to report them in such a way that they can be easily reproduced. .PP Bugs that I know about are: shell will not work with programs running in Raw mode on some Unix versions. .SH UNRESTRICTIONS .PP .I Emacs is free; anyone may redistribute copies of .I Emacs to anyone under the terms stated in the .I Emacs General Public License, a copy of which accompanies each copy of .I Emacs and which also appears in the reference manual. .PP Copies of .I Emacs may sometimes be received packaged with distributions of Unix systems, but it is never included in the scope of any license covering those systems. Such inclusion violates the terms on which distribution is permitted. In fact, the primary purpose of the General Public License is to prohibit anyone from attaching any other restrictions to redistribution of .I Emacs. .PP Richard Stallman encourages you to improve and extend .I Emacs, and urges that you contribute your extensions to the GNU library. Eventually GNU (Gnu's Not Unix) will be a complete replacement for Berkeley Unix. Everyone will be free to use, copy, study and change the GNU system. .SH SEE ALSO X(1), xlsfonts(1), xterm(1), xrdb(1) .SH AUTHORS .PP .I Emacs was written by Richard Stallman and the Free Software Foundation. Joachim Martillo and Robert Krawitz added the X features. emacs-19.30/etc/emacs.bash100666 12120 13 2404 5370475112 13352 0ustar rmsuser# This defines a bash command named `edit' which contacts/resumes an # existing emacs or starts a new one if none exists. # # One way or another, any arguments are passed to emacs to specify files # (provided you have loaded `resume.el'). # # This function assumes the emacs program is named `emacs' and is somewhere # in your load path. If either of these is not true, the most portable # (and convenient) thing to do is to make an alias called emacs which # refers to the real program, e.g. # # alias emacs=/usr/local/bin/gemacs # # Written by Noah Friedman. function edit () { local windowsys="${WINDOW_PARENT+sun}" windowsys="${windowsys:-${DISPLAY+x}}" if [ -n "${windowsys:+set}" ]; then # Do not just test if these files are sockets. On some systems # ordinary files or fifos are used instead. Just see if they exist. if [ -e "${HOME}/.emacs_server" -o -e "/tmp/esrv${UID}-"* ]; then emacsclient "$@" return $? else echo "edit: starting emacs in background..." 1>&2 fi case "${windowsys}" in x ) (emacs "$@" &) ;; sun ) (emacstool "$@" &) ;; esac else if jobs %emacs 2> /dev/null ; then echo "$(pwd)" "$@" > ${HOME}/.emacs_args && fg %emacs else emacs "$@" fi fi } emacs-19.30/etc/emacs.csh100666 13437 13 2272 5405340662 13351 0ustar jimbuser# This defines a csh command named `edit' which resumes an # existing Emacs or starts a new one if none exists. # One way or another, any arguments are passed to Emacs to specify files # (provided you have loaded `resume.el'). # - Michael DeCorte # These are the possible values of $whichjob # 1 = new ordinary emacs (the -nw is so that it doesn't try to do X) # 2 = resume emacs # 3 = new emacs under X (-i is so that you get a reasonable icon) # 4 = resume emacs under X # 5 = new emacs under suntools # 6 = resume emacs under suntools # 7 = new emacs under X and suntools - doesn't make any sense, so use X # 8 = resume emacs under X and suntools - doesn't make any sense, so use X set EMACS_PATTERN="^\[[0-9]\] . Stopped ............ $EMACS" alias edit 'set emacs_command=("emacs -nw \!*" "fg %emacs" "emacs -i \!* &"\ "emacsclient \!* &" "emacstool \!* &" "emacsclient \!* &" "emacs -i \!* &"\ "emacsclient \!* &") ; \ jobs >! $HOME/.jobs; grep "$EMACS_PATTERN" < $HOME/.jobs >& /dev/null; \ @ isjob = ! $status; \ @ whichjob = 1 + $isjob + $?DISPLAY * 2 + $?WINDOW_PARENT * 4; \ test -S ~/.emacs_server && emacsclient \!* \ || echo `pwd` \!* >! ~/.emacs_args && eval $emacs_command[$whichjob]' emacs-19.30/etc/emacs.icon100666 13437 1 3615 4410034104 13752 0ustar jimbdaemon/* Format_version=1, Width=64, Height=64, Depth=1, Valid_bits_per_item=16 */ 0xFFFF,0xFFFF,0xFFFF,0xFFFF,0x8000,0x0000,0x0000,0x0001, 0x8000,0x0000,0x007E,0x1C01,0x8000,0x0000,0x0006,0x1C01, 0x8000,0x0000,0x007F,0xFC01,0x8000,0x0000,0x0080,0x1C01, 0x8000,0x0000,0x013F,0xFC01,0x8000,0x0000,0x0140,0x1C01, 0x8000,0x0000,0x03E0,0x1C01,0x8000,0x0000,0x0000,0x1C01, 0x8000,0x0000,0x0000,0x1C01,0x8000,0x0000,0x0000,0x1C01, 0x8000,0x0000,0x0000,0x1C01,0x8000,0x0000,0x0210,0x1C01, 0x8000,0x0000,0x0330,0x1C01,0x8000,0x0000,0x00C0,0x1C01, 0x8003,0xFFFF,0xFFFF,0xFE01,0x8005,0xFFFF,0xFFFF,0xFE01, 0x8004,0xFFFF,0xFFFF,0xFC01,0x8004,0x787F,0xFFFF,0xF801, 0x8004,0x77FF,0xFFFF,0xF801,0x8000,0x77E3,0x6FFF,0xF801, 0x8000,0x762D,0x6FFF,0xF801,0x8004,0x77AD,0x6FFF,0xF801, 0x800C,0x77AD,0x6FFF,0xF801,0x8004,0x786D,0x8FFF,0xF801, 0x8000,0x7FFF,0xFFFF,0xF801,0x8000,0x7FFF,0xFFFF,0xF801, 0x8000,0x7E0F,0xFFFF,0xF801,0x8008,0x7EFF,0xFFFF,0xF801, 0x800C,0x7EF9,0x31CE,0x3801,0x8004,0x7E1A,0xADB5,0xF801, 0x8000,0x7EFA,0xADBE,0x7801,0x8000,0x7EFB,0xADB7,0xB801, 0x8000,0x7E0B,0xB2CC,0x7801,0x8000,0x7FFF,0xFFFF,0xF801, 0x8004,0x3FFF,0xFFFF,0xF001,0x8004,0x1FFF,0xFFFF,0xE001, 0x800C,0x0003,0x6000,0x0001,0x8000,0x0001,0x43C0,0x0001, 0x8000,0x0001,0x4420,0x0001,0x8000,0x0001,0x4990,0x0001, 0x8000,0x0001,0x4A50,0x0001,0x8004,0x0001,0x3250,0x0001, 0x8004,0x0000,0x8450,0x0001,0x800A,0x0000,0x7850,0x0001, 0x8000,0x0000,0x0050,0x0001,0xFFFF,0xFFFF,0xFFFF,0xFFFF, 0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000, 0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000, 0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000, 0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000, 0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000, 0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000, 0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000, 0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000 emacs-19.30/etc/emacs.xbm100666 21641 13 5223 5321217067 14220 0ustar friedmanuser#define emacs_width 64 #define emacs_height 64 static char emacs_bits[] = { 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00, 0x80,0x01,0x00,0x00,0x00,0x00,0x7e,0x38,0x80,0x01,0x00,0x00,0x00,0x00,0x60, 0x38,0x80,0x01,0x00,0x00,0x00,0x00,0xfe,0x3f,0x80,0x01,0x00,0x00,0x00,0x00, 0x01,0x38,0x80,0x01,0x00,0x00,0x00,0x80,0xfc,0x3f,0x80,0x01,0x00,0x00,0x00, 0x80,0x02,0x38,0x80,0x01,0x00,0x00,0x00,0xc0,0x07,0x38,0x80,0x01,0x00,0x00, 0x00,0x00,0x00,0x38,0x80,0x01,0x00,0x00,0x00,0x00,0x00,0x38,0x80,0x01,0x00, 0x00,0x00,0x00,0x00,0x38,0x80,0x01,0x00,0x00,0x00,0x00,0x00,0x38,0x80,0x01, 0x00,0x00,0x00,0x40,0x08,0x38,0x80,0x01,0x00,0x00,0x00,0xc0,0x0c,0x38,0x80, 0x01,0x00,0x00,0x00,0x00,0x03,0x38,0x80,0x01,0xc0,0xff,0xff,0xff,0xff,0x7f, 0x80,0x01,0xa0,0xff,0xff,0xff,0xff,0x7f,0x80,0x01,0x20,0xff,0xff,0xff,0xff, 0x3f,0x80,0x01,0x20,0x1e,0xfe,0xff,0xff,0x1f,0x80,0x01,0x20,0xee,0xff,0xff, 0xff,0x1f,0x80,0x01,0x00,0xee,0xc7,0xf6,0xff,0x1f,0x80,0x01,0x00,0x6e,0xb4, 0xf6,0xff,0x1f,0x80,0x01,0x20,0xee,0xb5,0xf6,0xff,0x1f,0x80,0x01,0x30,0xee, 0xb5,0xf6,0xff,0x1f,0x80,0x01,0x20,0x1e,0xb6,0xf1,0xff,0x1f,0x80,0x01,0x00, 0xfe,0xff,0xff,0xff,0x1f,0x80,0x01,0x00,0xfe,0xff,0xff,0xff,0x1f,0x80,0x01, 0x00,0x7e,0xf0,0xff,0xff,0x1f,0x80,0x01,0x10,0x7e,0xff,0xff,0xff,0x1f,0x80, 0x01,0x30,0x7e,0x9f,0x8c,0x73,0x1c,0x80,0x01,0x20,0x7e,0x58,0xb5,0xad,0x1f, 0x80,0x01,0x00,0x7e,0x5f,0xb5,0x7d,0x1e,0x80,0x01,0x00,0x7e,0xdf,0xb5,0xed, 0x1d,0x80,0x01,0x00,0x7e,0xd0,0x4d,0x33,0x1e,0x80,0x01,0x00,0xfe,0xff,0xff, 0xff,0x1f,0x80,0x01,0x20,0xfc,0xff,0xff,0xff,0x0f,0x80,0x01,0x20,0xf8,0xff, 0xff,0xff,0x07,0x80,0x01,0x30,0x00,0xc0,0x06,0x00,0x00,0x80,0x01,0x00,0x00, 0x80,0xc2,0x03,0x00,0x80,0x01,0x00,0x00,0x80,0x22,0x04,0x00,0x80,0x01,0x00, 0x00,0x80,0x92,0x09,0x00,0x80,0x01,0x00,0x00,0x80,0x52,0x0a,0x00,0x80,0x01, 0x20,0x00,0x80,0x4c,0x0a,0x00,0x80,0x01,0x20,0x00,0x00,0x21,0x0a,0x00,0x80, 0x01,0x50,0x00,0x00,0x1e,0x0a,0x00,0x80,0x01,0x00,0x00,0x00,0x00,0x0a,0x00, 0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, 0x00,0x00}; emacs-19.30/etc/emacstool.1100666 13437 13 11522 5405340663 13651 0ustar jimbuser.TH EMACSTOOL 1 .SH NAME .I emacstool \- run emacs under Sun windows with function-key and mouse support. .SH SYNOPSIS .I emacstool [{window_args} {-rc run_command_path} args ... ] .SH TYPICAL USAGE In ~/.suntools or ~/.rootmenu include a line like this: .br "Emacstool" emacstool -WI emacs.icon -f emacstool-init .SH DESCRIPTION .B Emacstool creates a SunView frame and a tty subwindow within which mouse events and function keys are translated to ASCII sequences which Emacs can parse. The translated input events are sent to the process running in the tty subwindow, which is typically GNU Emacs. Emacstool thereby allows GNU Emacs users to make full use of the mouse and function keys. GNU Emacs can be loaded with functions to interpret the mouse and function-key events to make a truely fine screen oriented editor for the Sun Workstation. .PP (Note that GNU Emacs has a special interface to the X window system as well. The X window system has many technical advantages, it is an industry standard, and it is also free software. The Free Software Foundation urges you to try X windows, and distributes a free copy of X on Emacs distribution tapes.) .PP Function keys are translated to a sequence of the form `^X*[a-o][lrt]'. The last character is `l', `r', or `t' corresponding to whether the key is among the Left, Right, or Top function keys. The third character indicates which button of the group was pressed. Thus, the function key in the lower right corner will transmit the sequence `^X*or'. In addition, the [lrt] is affected by the Control, Meta, and Shift keys. Unshifted Control keys will be non-alphabetic: C-l is [,], C-r is [2], C-t is [4]. .PP Mouse buttons are encoded as `^X^@([124] x y)\\n'. ^X^@ is the standard GNU Emacs mouse event prefix, it is followed by a list indicating the button pressed and the character row and column of the point in the window where the mouse cursor is, and followed by a newline character. In GNU Emacs, the ^X^@ dispatches to a mouse event handler which then reads the following list. .SH OPTIONS .B Emacstool supports all the standard window arguments, including font and icon specifiers. .PP By default, Emacstool runs the program .I emacs in the created subwindow. The value of the environment variable .I EMACSTOOL can be used to override this if your version of .B Emacs is not accessible on your search path by the name .I Emacs. In addition, the run command can be set by the .I pathname following the last occurrence of the .I \-rc flag. This is convenient for using Emacstool to run on remote machines. .PP All other command line arguments not used by the window system are passed as arguments to the program that runs in the Emacstool window. .PP For example: .PP local% (emacstool -rc rlogin remote -8 &)& .PP will create an Emacstool window logged in to a machine named .I remote. If Emacs is run from this window, Emacstool will encode mouse and function keys, and send them to rlogin. If Emacs is run from this shell on the remote machine, it will see the mouse and function keys properly. However, since the remote host does not have access to the screen, the cursor cannot be changed, menus will not appear, and the selection buffer (STUFF) is limited. .SH Using With GNU Emacs: The GNU Emacs files lisp/term/sun.el, lisp/sun-mouse.el, lisp/sun-fns.el, and src/sunfns.c provide emacs support for the Emacstool and function keys. Emacstool will automatically set the TERM environment variable to be "sun" and unset the environment variable TERMCAP. That is, these variables will not be inherited from the shell that starts Emacstool. Since the terminal type is .I SUN (that is, the environment variable TERM is set to .I SUN), Emacs will automatically load the file lisp/term/sun. This, in turn, will ensure that sun-mouse.el is autoloaded when any mouse events are detected. It is suggested that .I sun-mouse and .I sun-fns be loaded in your site-init.el file, so that they will always be loaded when running on a Sun workstation. .PP In addition, Emacstool sets the environment variable IN_EMACSTOOL = "t". Lisp code in your ~/.emacs can use (getenv "IN_EMACSTOOL") to determine whether to do Emacstool specific initialization. Sun.el uses this to automatically call emacstool-init (getenv "IN_EMACSTOOL") is defined. .PP The file src/sunfns.c defines several useful functions for emacs on the Sun. Among these are procedures to pop-up SunView .I menus, put and get from the SunView .I STUFF buffer, and a procedure for changing the cursor .I icon. If you want to define or edit cursor icons, there is a rudimentary mouse driven icon editor in the file lisp/sun-cursors.el. Try invoking (sc:edit-cursor) .SH BUGS It takes a few milliseconds to create a menu before it pops up. .SH ENVIRONMENT VARIABLES EMACSTOOL IN_EMACSTOOL TERM TERMCAP .SH FILES .DT emacs .SH "SEE ALSO" emacs(1) .../etc/SUN-SUPPORT .../lisp/term/sun.el emacs-19.30/etc/enriched.doc100444 22552 13 24520 5741313666 14246 0ustar borisuserContent-Type: text/enriched Text-Width: 70

bluewhiteenriched.el: bluewhiteWYSIWYG rich text editing for GNU Emacs
bluewhiteINTRODUCTION Emacs now has the ability to edit enriched text, which is text containing faces, colors, indentation, and other properties. This document is a quick introduction to some of the new features, and is also an example file in the text/enriched format. bluewhiteINSTALLATION and STARTUP Most of the time, you need not do anything to get these features to work. If you visit a file that has been written out in text/enriched format, it will automatically be decoded, Emacs will enter `enriched-mode' while visiting it, and whenever you save it it will be saved in the same format it was read in. If you wish to create a new file, however, you will need to turn on enriched-mode yourself: M-x enriched-mode RET Or, if you get a text/enriched file that Emacs does not automatically recognize and decode, you can tell Emacs to decode it (which also turns on enriched-mode automatically): M-x format-decode-buffer RET text/enriched RET bluewhiteWHAT IS ENCODED Here is the current list of text-properties that are saved; they are discussed in more detail below. Most of these can be added or changed with the "Text Properties" menu, available under the "Edit" item in the menu-bar, or on C-mouse-2 (Control + the middle mouse button). Faces: default, bold, italic, underline, fixed, etc. Colors: redDarkSlateGrayanyDarkSlateGrayorangething yellowyourgreen screenblue light bluecanviolet display... Newlines: Which ones are real ("hard") newlines, and which can be changed to fit lines into the margins. Margins: can be indented on the left or right. Justification (whether lines should be flush with the left margin, the right margin, fully justified, centered, or left alone). Excerpts: "For quoted material." Read-only regions. bluewhiteFACES and COLORS You can add faces either with the menu or with M-g. The face is applied to the current region. If you are using `transient-mark-mode' and the region is not active, then the face applies to whatever you type next. Any face can have colors, but faces have no other attributes are put on the color submenus of the "Text Properties" menu. bluewhiteNEWLINES and PARAGRAPHS Text/enriched format distinguishes between hard and soft newlines. Hard newlines are used to separate paragraphs, or items in a list, or anywhere that must be a line break no matter what the margins are. Soft newlines are the ones inserted in order to fit text between the margins. The fill and auto-fill functions insert soft newlines as necessary, but hard newlines are only inserted by direct request, such as using the return key or the C-o (open-line) function. bluewhiteINDENTATION The fill functions also understand margins, which can be set for any region of a document. In addition to the menu items, which increase or decrease the margins, there are two commands for setting the margins absolutely: C-c l (set-left-margin) and C-c r (set-right-margin). You can change indentation at any point in a paragraph, which makes it possible to do interesting things like hanging-indents: this paragraph was indented by selecting the region from the second word to the end of the paragraph, and indenting only that part. bluewhiteJUSTIFICATION Several styles of justification are possible, the simplest being unfilled. This means that your lines will be left as you write them. This paragraph is unfilled. The most common (for English) style is FlushLeft. This means lines are aligned at the left margin but left uneven at the right. FlushRight makes each line flush with the right margin instead. FlushBoth regions, which are sometimes called "fully justified" are aligned evenly on both edges, so that the text on the page has a smooth appearance as in a book or newspaper article. Unfortunately this does not look as nice with a fixed-width font as it does in a proportionally-spaced printed document; the extra spaces that are needed on the screen can make it hard to read.
Center
Finally, there is center justification. The normal center-paragraph key, M-S, can be used to turn on center justification in enriched-mode. M-j or the "Text Properties" menu also can be used to change justification.
Note that justification can only change at hard newlines, because that is the unit over which filling gets done. bluewhiteEXCERPTS This is an example of an excerpt. You can use them for quoted parts of other people's email messages and the like. It is just a face, which is the same as the `italic' face by default. bluewhiteTHE FILE FORMAT Enriched-mode docuemnts are saved in an extended version of a format called text/enriched, which is defined as part of the MIME standard. This means that your documents are transportable (even through email) to many other systems. In the future other file formats may be supported as well. Since Emacs adds some non-standard features to the format (colors and read-only regions), not all systems will be able to recreate all of the features of your document, but they will get as close as possible. The MIME standard is defined in internet RFC 1521; text/enriched is defined in RFC 1563. Details on obtaining these documents via FTP or email may be obtained by sending an email message to rfc-info@isi.edu with the message body: help: ways_to_get_rfcs See also the newsgroup comp.mail.mime. bluewhiteCUSTOMIZATION - The fixed and excerpt faces should be set to your liking. - User-preference variables: default-justification, enriched-verbose. - You can add annotations for your own text properties by making additions to enriched-annotation-alist. Note that the standard requires you to name your annotation starting "x-" (as in "x-read-only"). Please send me any such additions that you think might be of general interest so that I can include them in the distribution. bluewhiteTO-DO LIST [Feel free to work on these and send me the results!] - Be smarter about fixing malformed files. - Make the indentation work more seamlessly and robustly: + Create an aggressive auto-fill function that will keep the paragraph properly filled all the time, without slowing down editing too much. + Refill after yank. + Make deleting a newline also delete the indentation following it. + Never let point enter indentation?? - Notice and re-fill when window changes widths (optionally). - Deal with the `category' text-property in a smart way. - Interface w/ GNUS, VM, RMAIL. Maybe Info too? - Support more formats: RTF, HTML... bluewhiteFinal Notes: This code and documentation is under development. Comments and bug reports are welcome. whiteblueBoris Goldowskylight blue light blue<blue bluewhite April 1995 blue emacs-19.30/etc/etags.1100644 12120 13 20400 5772354420 12624 0ustar rmsuser.\" Copyright (c) 1992 Free Software Foundation .\" See section COPYING for conditions for redistribution .TH etags 1 "19apr1994" "GNU Tools" "GNU Tools" .de BP .sp .ti -.2i \(** .. .SH NAME etags, ctags \- generate tag file for Emacs, vi .SH SYNOPSIS .hy 0 .na .B etags [\|\-aCDRSVh\|] [\|\-i \fIfile\fP\|] [\|\-l \fIlanguage\fP\|] [\|\-i \fIregexp\fP\|] [\|\-o \fItagfile\fP\|] .br [\|\-\-c++\|] [\|\-\-no\-defines\|] [\|\-\-ignore\-indentation\|] [\|\-\-language=\fIlanguage\fP\|] [\|\-\-regex=\fIregexp\fP\|] [\|\-\-no\-regexp\|] [\|\-\-help\|] [\|\-\-version\|] [\|\-\-include=\fIfile\fP\|] [\|\-\-output=\fItagfile\fP\|] [\|\-\-append\|] \fIfile\fP .\|.\|. .B ctags [\|\-aCdRSVh\|] [\|\-BtTuvwx\|] [\|\-l \fIlanguage\fP\|] .br [\|\-i \fIregexp\fP\|] [\|\-o \fItagfile\fP\|] [\|\-\-c++\|] [\|\-\-defines\|] [\|\-\-ignore\-indentation\|] [\|\-\-no\-warn\|] [\|\-\-cxref\|] [\|\-\-backward\-search\|] [\|\-\-forward\-search\|] [\|\-\-typedefs\|] [\|\-\-typedefs\-and\-c++\|] [\|\-\-language=\fIlanguage\fP\|] [\|\-\-regex=\fIregexp\fP\|] [\|\-\-help\|] [\|\-\-version\|] .br [\|\-\-output=\fItagfile\fP\|] [\|\-\-append\|] [\|\-\-update\|] \fIfile\fP .\|.\|. .ad b .hy 1 .SH DESCRIPTION The `\|\fBetags\fP\|' program is used to create a tag table file, in a format understood by .BR emacs ( 1 )\c \&; the `\|\fBctags\fP\|' program is used to create a similar table in a format understood by .BR vi ( 1 )\c \&. Both forms of the program understand the syntax of C, C++, Fortran, Pascal, LaTeX, Scheme, Emacs Lisp/Common Lisp and most assembler\-like syntaxes. Both forms read the files specified on the command line, and write a tag table (defaults: `\|TAGS\|' for \fBetags\fP, `\|tags\|' for \fBctags\fP) in the current working directory. The programs recognize the language used in an input file based on its file name and contents. The --language switch can be used to force parsing of the file names following the switch according to the given language, overriding guesses based on filename extensions. .SH OPTIONS Some options make sense only for the \fBvi\fP style tag files produced by ctags; \fBetags\fP does not recognize them. The programs accept unambiguous abbreviations for long option names. .TP .B \-a, \-\-append Append to existing tag file. (For vi-format tag files, see also \fB\-\-update\fP.) .TP .B \-B, \-\-backward\-search Tag files written in the format expected by \fBvi\fP contain regular expression search instructions; the \fB\-B\fP option writes them using the delimiter `\|\fB?\fP\|', to search \fIbackwards\fP through files. The default is to use the delimiter `\|\fB/\fP\|', to search \fIforwards\fP through files. Only \fBctags\fP accepts this option. .TP .B \-C, \-\-c++ Treat files with `\|.c\|' and `\|.h\|' extensions as C++ code, not C code. Files with `\|.C\|', `\|.H\|', `\|.cxx\|', `\|.hxx\|', or `\|.cc\|' extensions are always assumed to be C++ code. .TP .B \-d, \-\-defines Create tag entries for C preprocessor definitions, too. This is the default behavior for \fBetags\fP, so this option is only accepted by \fBctags\fP. .TP .B \-D, \-\-no\-defines Do not create tag entries for C preprocessor definitions. This may make the tags file much smaller if many header files are tagged. This is the default behavior for \fBctags\fP, so this option is only accepted by \fBetags\fP. .TP \fB\-l\fP \fIlanguage\fP, \fB\-\-language=\fIlanguage\fP Parse the following files according to the given language. More than one such options may be intermixed with filenames. Use \fB\-\-help\fP to get a list of the available languages and their default filename extensions. The `auto' language can be used to restore automatic detection of language based on filename extension. The `none' language may be used to disable language parsing altogether; only regexp matching is done in this case (see the \fB\-\-regex\fP option). .TP \fB\-o\fP \fItagfile\fP, \fB\-\-output=\fItagfile\fP Explicit name of file for tag table; overrides default `\|TAGS\|' or `\|tags\|'. (But ignored with \fB\-v\fP or \fB\-x\fP.) .TP \fB\-r\fP \fIregexp\fP, \fB\-\-regex=\fIregexp\fP Make tags based on regexp matching for each line of the files following this option, in addition to the tags made with the standard parsing based on language. May be freely intermixed with filenames and the \fB\-R\fP option. The regexps are cumulative, i.e. each option will add to the previous ones. The regexps are of the form: .br \fB/\fP\fItagregexp\fP[\fB/\fP\fInameregexp\fP]\fB/\fP .br where \fItagregexp\fP is used to match the lines that must be tagged. It should not match useless characters. If the match is such that more characters than needed are unavoidably matched by \fItagregexp\fP, it may be useful to add a \fInameregexp\fP, to narrow down the tag scope. .br Here are some examples. All the regexps are quoted to protect them from shell interpretation. .br Tag the DEFVAR macros in the emacs source files: .br \fI\-\-regex\='/[ \\t]*DEFVAR_[A-Z_ \\t(]+"\\([^"]+\\)"\/'\fP .br Tag VHDL files (this example is a single long line, broken here for formatting reasons): .br \fI\-\-language\=none\ \-\-regex='/[\ \\t]*\\(ARCHITECTURE\\|\\ CONFIGURATION\\)\ +[^\ ]*\ +OF/'\ \-\-regex\='/[\ \\t]*\\ \\(ATTRIBUTE\\|ENTITY\\|FUNCTION\\|PACKAGE\\(\ BODY\\)?\\ \\|PROCEDURE\\|PROCESS\\|TYPE\\)[\ \\t]+\\([^\ \\t(]+\\)/\\3/'\fP .br Tag Cobol files: .br \fI\-\-language\=none \-\-regex\='/.......[a\-zA\-Z0\-9\-]+\\./'\fP .br Tag Postscript files: .br \fI\-\-language\=none \-\-regex\='#/[^\ \\t{]+#/'\fP .br Tag TCL files (this last example shows the usage of a \fItagregexp\fP): .br \fI\-\-lang\=none \-\-regex\='/proc[\ \\t]+\\([^\ \\t]+\\)/\\1/'\fP .TP .B \-R, \-\-no\-regex Don't do any more regexp matching on the following files. May be freely intermixed with filenames and the \fB\-\-regex\fP option. .TP .B \-S, \-\-ignore\-indentation Don't rely on indentation as much as we normally do. Currently, this means not to assume that a closing brace in the first column is the final brace of a function or structure definition in C and C++. .TP .B \-t, \-\-typedefs Record typedefs in C code as tags. Since this is the default behaviour of \fBetags\fP, only \fBctags\fP accepts this option. .TP .B \-T, \-\-typedefs\-and\-c++ Generate tag entries for typedefs, struct, enum, and union tags, and C++ member functions. Since this is the default behaviour of \fBetags\fP, only \fBctags\fP accepts this option. .TP .B \-u, \-\-update Update tag entries for \fIfiles\fP specified on command line, leaving tag entries for other files in place. Currently, this is implemented by deleting the existing entries for the given files and then rewriting the new entries at the end of the tags file. It is often faster to simply rebuild the entire tag file than to use this. Only \fBctags\fP accepts this option. .TP .B \-v, \-\-vgrind Instead of generating a tag file, write index (in \fBvgrind\fP format) to standard output. Only \fBctags\fP accepts this option. .TP .B \-w, \-\-no\-warn Suppress warning messages about duplicate entries. The \fBetags\fP program does not check for duplicate entries, so this option is not allowed with it. .TP .B \-x, \-\-cxref Instead of generating a tag file, write a cross reference (in \fBcxref\fP format) to standard output. Only \fBctags\fP accepts this option. .TP .B \-H, \-\-help Print usage information. .TP .B \-V, \-\-version Print the current version of the program (same as the version of the emacs \fBetags\fP is shipped with). .SH "SEE ALSO" `\|\fBemacs\fP\|' entry in \fBinfo\fP; \fIGNU Emacs Manual\fP, Richard Stallman. .br .BR cxref ( 1 ), .BR emacs ( 1 ), .BR vgrind ( 1 ), .BR vi ( 1 ). .SH COPYING Copyright (c) 1992 Free Software Foundation, Inc. .PP Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice are preserved on all copies. .PP Permission is granted to copy and distribute modified versions of this manual under the conditions for verbatim copying, provided that the entire resulting derived work is distributed under the terms of a permission notice identical to this one. .PP Permission is granted to copy and distribute translations of this manual into another language, under the above conditions for modified versions, except that this permission notice may be included in translations approved by the Free Software Foundation instead of in the original English. emacs-19.30/etc/gnu.xpm100666 12120 13 6156 5664455030 12755 0ustar rmsuser/* XPM */ /*****************************************************************************/ /* GNU Emacs bitmap conv. to pixmap by Przemek Klosowski (przemek@nist.gov) */ /*****************************************************************************/ static char * image_name [] = { /**/ "50 50 7 1", /**/ " s mask c none", "B c blue", "x c black", ": c sandy brown", "+ c saddle brown", "' c grey", ". c white", " ", " ", " x ", " :x ", " :::x ", " ::x ", " x ::x ", " x: xxx :::x ", " x: xxx xxx:xxx x::x ", " x:: xxxx::xxx:::::xx x::x ", " x:: x:::::::xx::::::xx x::x ", " x:: xx::::::::x:::::::xx xx::x ", " x:: xx::::::::::::::::::x xx::xx ", " x::x xx:::::xxx:::::::xxx:xxx xx:::xx ", " x:::x xx:::::xx...xxxxxxxxxxxxxxx:::xx ", " x:::x xx::::::xx..xxx...xxxx...xxxxxxxx ", " x:::x x::::::xx.xxx.......x.x.......xxxx ", " x:::xx x:::x::xx.xx..........x.xx.........x ", " x::::xx::xx:::x.xx....''''x'x'x''.xxx.....x ", " xx::::xxxx::xx.xx.xxxx.'''''''.xxx xxxx ", " xx::::::::xx..x.xxx..'''''''''.xx ", " xxx:::::xxx..xx.xx.xx.xxx.'''''.xx ", " xxx::xx...xx.xx.BBBB..xx''''''xx ", " xxxx.....xx.xxBB:BB.xx'''''''xx ", " xx.....xx...x.BBBx.xxx''''''xx ", " x....xxxx..xx...xxx''''''''''xx ", " x..xxxxxx..x.......x..''''''''xx ", " x.x xxx.x.x.x...xxxx.'''''''''xx ", " x xxx.x.x.xx...xx..'''''''''xx ", " xx.x..x.x.xx........''''''''x ", " xx'.xx.x.x.x.x.......'''''''''x ", " xx'..xxxx..x...x.......'''''''x ", " xx''.xx.x..xx...x.......'''.xxx ", " xx''..x.x.x.x.x.xx.xxxxx.'.xx+xx ", " xx''..x.xx..xx.x.x.x+++xxxxx+++x ", " xx'''.x..xxx.x.x.x.x+++++xxx+xxx ", " xx''.xx..x..xx.xxxx++x+++x++xxx ", " xx''..xx.xxx.xxx.xxx++xx+x++xx ", " xx'''.xx.xx..xx.xxxx++x+++xxx ", " xx'''.xxx.xx.xxxxxxxxx++++xxx ", " xx''...xx.xx.xxxxxx++xxxxxxx ", " xx''''..x..xxx..xxxx+++++xx ", " xx''''..x..xx..xxxx++++xx ", " xxx'''''x.xx.xxxxxxxxxxx ", " xxx'''''..xxx xxxxx ", " xxxx''''xxxx ", " xxx'''xxx ", " xxxxx ", " ", " " }; emacs-19.30/etc/gnus-tut.txt100644 23053 13 30153 6046616573 14321 0ustar larsiuserFrom lars Thu Feb 23 23:20:38 1995 From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: So you want to use the new Gnus Message-ID: Actually, since you are reading this, chances are you are already using the new Gnus. Congratulations. This entire newsgroup you are reading is, in fact, no real newsgroup at all, in the traditional sense. It is an example of one of the "foreign" select methods that Gnus may use. The text you are now reading is stored in the "etc" directory with the rest of the Emacs sources. You are using the "nndir" backend for accessing it. Scary, isn't it? This isn't the real documentation. `M-x info', `m gnus ' to read that. This "newsgroup" is intended as a kinder, gentler way of getting people started. Gnus is a rewrite of GNUS 4.1, written by Masanobu Umeda. The rewrite was done by moi, yours truly, your humble servant, Lars Magne Ingebrigtsen. If you have a WWW browser, you can investigate to your heart's delight at . Much code (especially the score code) was written by Per Abrahamsen. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. From lars Thu Feb 23 23:20:38 1995 From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: Starting up Message-ID: If you are having problems with Gnus not finding your server, you have to set `gnus-select-method'. A "method" is a way of specifying *how* the news is to be found, and from *where*. Say you want to read news from you local, friendly nntp server "news.my.local.server". (setq gnus-select-method '(nntp "news.my.local.server")) Quite easy, huh? From the news spool: (setq gnus-select-method '(nnspool "")) From your mh-e spool: (setq gnus-select-method '(nnmh "")) There's a whole bunch of other methods for reading mail and news, see the "Foreign groups" article for that. From lars Thu Feb 23 23:20:38 1995 From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: Where are all the groups, then? Message-ID: If this is the first time you have used a newsreader, you won't have a .newsrc file. This means that Gnus will think that all the newsgroups on the server are "new", and kill them all. If you have a .newsrc file, the new groups will be processed with the function in the `gnus-subscribe-newsgroup-method' variable, which is `gnus-subscribe-zombies' by default. This means that all the groups have been made into "zombies" - not quite dead, but not exactly alive, either. Jump back to the *Group* buffer, and type `C-c C-z' to list all the zombie groups. Look though the list, and subscribe to the groups you want to read by pressing `u' on the one you think look interesting. If all the groups have been killed, type `C-c C-k' to list all the killed groups. Subscribe to them the same way. When you are satisfied, press `M-z' to kill all the zombie groups. Now you should have a nice list of all groups you are interested in. (If you later want to subscribe to more groups, press `C-c C-k' to list all the kill groups, and repeat. You can also type `U' and be prompted for groups to subscribe to.) From lars Thu Feb 23 23:20:38 1995 From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: I want to read my mail! Message-ID: Yes, Virginia, you can read mail with Gnus. First you have to decide which mail backend you want to use. You have nnml, which is a one-file-one-mail backend, which is quite nice, but apt to make your systems administrator go crazy and come after you with a shotgun. nnmbox uses a Unix mail box to store mail. Nice, but slow. nnmh uses mh-e folders, which is also a one-file-one-mail thingie, but slower than nnml. (It doesn't support NOV files.) So if you want to go with nnmbox, you can simply say: (setq gnus-secondary-select-methods '((nnmbox ""))) (The same for the other methods, kind of.) You should also set `nnmail-split-methods' to something sensible: (setq nnmail-split-methods '(("mail.junk" "From:.*Lars") ("mail.misc ""))) This will put all mail from me in you junk mail group, and the rest in "mail.misc". These groups will be subscribe the same way as the normal groups, so you will probably find them among the zombie groups after you set these variables and re-start Gnus. From lars Thu Feb 23 23:20:38 1995 From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: Foreign newsgroups Message-ID: These are groups that do not come from `gnus-select-method'. Say you want to read "alt.furniture.couches" from "news.funet.fi". You can then either type `B news.funet.fi ' to browse that server and subscribe to that group, or you can type `M-a alt.furniture.couchesnntpnews.funet.fi', if you like to type a lot. If you want to read a directory as a newsgroup, you can create an nndir group, much the same way. There's a shorthand for that, though. If, for instance, you want to read the (ding) list archives, you could type `D /ftp '. There's lots more to know about foreign groups, but you have to read the info pages to find out more. From lars Thu Feb 23 23:20:38 1995 From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: Low level changes in GNUS, or, Wrong type argument: stringp, nil Message-ID: Gnus really isn't GNUS, even though it looks like it. If you scrape the surface, you'll find that most things have changed. This means that old code that relies on GNUS internals will fail. In particular, `gnus-newsrc-hashtb', `gnus-newsrc-assoc', `gnus-killed-list', the `nntp-header-' macros and the display formats have all changed. If you have some code lying around that depend on these, or change these, you'll have to re-write your code. Old hilit19 code does not work at all. In fact, you should probably remove all hihit code from all the Gnus hooks (`gnus-group-prepare-hook', `gnus-summary-prepare-hook' and `gnus-summary-article-hook'). (Well, at the very least the first two.) Gnus provides various integrated functions for highlighting, which are both faster and more accurated. There is absolutely no chance, whatsoever, of getting Gnus to work with Emacs 18. From lars Thu Feb 23 23:20:38 1995 From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: Bugs & stuff Message-ID: If you want to report a bug, please type `M-x gnus-bug'. This will give me a precice overview of your Gnus and Emacs version numbers, along with a look at all Gnus variables you have changed. Du not expect a reply back, but your bug should be fixed in the next version. If the bug persists, please re-submit your bug report. When a bug occurs, I need a recipe for how to trigger the bug. You have to tell me exactly what you do to uncover the bug, and you should (setq debug-on-error t) and send me the backtrace along with the bug report. If I am not able to reproduce the bug, I won't be able to fix it. I would, of course, prefer that you locate the bug, fix it, and mail me the patches, but one can't have everything. If you have any questions on usage, the "ding@ifi.uio.no" mailing list is where to post the questions. From lars Thu Feb 23 23:20:38 1995 From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: How do I re-scan my mail groups? Message-ID: Reading the active file from the nntp server is a drag. Just press `M-g' on the mail groups, and they will be re-scanned. You can also re-scan all the mail groups by putting them on level 1 (`1 S'), and saying `1 g' to re-scan all level 1 groups. From lars Thu Feb 23 23:20:38 1995 From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: How do I set up virtual newsgroups? Message-ID: Virtual newsgroups are collections of other newsgroups. Why people want this is beyond me, but here goes: Create the group by saying `M-a my.virtual.newsgroupnnvirtual^rec\.aquaria\.*' This will create the group "nnvirtual:my.virtual.newsgroup", which will collect all articles from all the groups in the "rec.aquaria" hierarchy. If you want to edit the regular expression, just type `M-e' on the group line. Note that all the groups that are part of the virtual group have to be alive. This means that the cannot, absolutely not, be zombie or killed. They can be unsubscribed; that's no problem. You can combine groups from different servers in the same virtual newsgroup, something that may actually be useful. Say you have the group "comp.headers" on the server "news.server.no" and the same group on "news.server.edu". If people have posted articles with Distribution headers that stop propagation of their articles, combining these two newsgroups into one virtual newsgroup should give you a better view of what's going on. One caveat, though: The virtual group article numbers from the first source group (group A) will always be lower than the article numbers from the second (group B). This means that Gnus will believe that articles from group A are older than articles from group B. Threading will lessen these problems, but it might be a good idea to sort the threads over the date of the articles to get a correct feel for the flow of the groups: (setq gnus-thread-sort-functions '(gnus-thread-sort-by-date)) If you only want this in virtual groups, you could say something along the lines of: (setq gnus-select-group-hook (lambda () (if (eq 'nnvirtual (car (gnus-find-method-for-group gnus-newsgroup-name))) (progn (make-local-variable 'gnus-thread-sort-functions) (setq gnus-thread-sort-functions '(gnus-thread-sort-by-date)))))) From lars Thu Feb 23 23:20:38 1995 From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: I want to kiboze everything in sight! Message-ID: The nnkiboze backend collects articles that you are interested in from groups you are interested in. Below is a description for how you can gather all posts from me, and all posts about Gnus in the gnu.emacs hierarchy in one handy, easy to read group. Gnus will let you eat up all available machine resources, grinding everything to a halt. Including your nntp server. Who says Gnus isn't friendly? You want to do this, of course. Create an nnkiboze group the normal way: `M-a my.groupnnkiboze^gnu.emacs.*' You now have a shiny new group that you can't enter. How... practical. But just wait, it gets worse. You now have to create a score file. `C-x C-f ~/News/nnkiboze:my.group.SCORE' Put something like the following in this file: (setq gnus-score-alist '(("from" ("Ingebrigtsen" nil 1000) ("lmi" nil 5000)) ("subject" ("Gnus" nil 10000)) (touched))) Save the file, and go to a shell window. Type: $ emacs -batch -l ~/.emacs -l nnkiboze -f nnkiboze-generate-groups Wait a few hours, and all articles from me, or articles about Gnus, will appear, as if by magic, in the nnkiboze group. You really want that, of course. Gnus actually grabs the headers of all the groups that supply the nnkiboze group with articles, so this isn't very kind. Pleasy only do it at night (`at' is a fine command), and please, *please*, limit the number of groups that supply articles to the group. If you specify "" as the address of this group, nnkiboze will ask for headers from *all* groups, and this is megs and megs and megs of data. Use it, don't abuse it. Be nice. emacs-19.30/etc/ledit.l100666 13437 1 11352 3461063034 13314 0ustar jimbdaemon;;; -*- Mode: lisp -*- ; load in the c functions (removeaddress '_signal) (removeaddress '_switch_to_proc) (removeaddress '_set_proc_str) (cfasl "/src/mdc/ledit/leditcfns.o" '_switch_to_proc 'emacs) (getaddress '_set_proc_str 'set_proc_str) (declare (special *ledit-infile* ; emacs->lisp tempfile *ledit-outfile* ; lisp->emacs tempfile *ledit-ppfile* ; pp->emacs tempfile *ledit-lisztfile* ; compiler input *ledit-objfile* ; compiler output *ledit-initialized*) ; flag ) (setq *ledit-initialized* nil) ;;; INIT-LEDIT (defun init-ledit () (let ((user (getenv '|USER|))) ;USER must be uppercase (setq *ledit-outfile* (concat "/tmp/" user ".l2") ; lisp -> emacs *ledit-infile* (concat "/tmp/" user ".l1") ; emacs -> lisp *ledit-ppfile* (concat "/tmp/" user ".l3") ; pp output to emacs. *ledit-lisztfile* (concat "/tmp/" user ".l4") *ledit-objfile* (concat "/tmp/" user ".o") *ledit-initialized* t))) ;;; LEDIT ; if 1 arg, arg is taken as a tag name to pass to emacs. ; if 2 args, second arg is a keyword. If 2nd arg is pp, ; pp is applied to first arg, and result is sent to emacs ; to put in a buffer called LEDIT (which is first erased.) (defun ledit fexpr (args) (apply #'ledit* args)) ;;; LEDIT* (defun ledit* n (if (not *ledit-initialized*) (init-ledit)) (ledit-output (listify n)) (syscall 10. *ledit-infile*) ; syscall 10 is "delete" (syscall 10. *ledit-lisztfile*) (emacs) (ledit-input) (syscall 10. *ledit-outfile*) (syscall 10. *ledit-ppfile*) t) ;;; LEDIT-OUTPUT ;;; Egad, what a mess! Doesn't work for XEMACS yet. ;;; Here's an example from Moclisp: ;;; -> (defun bar (nothing) (bar nothing)) ;;; bar ;;; -> (ledit bar) ;;; should produce... ;;; (progn) (progn tag (setq tag "bar") (&goto-tag)) ;;; and ;;; -> (ledit bar pp) ;;; should stuff this to emacs... ;;; (progn) (switch-to-buffer "LEDIT") (erase-buffer) ;;; (insert-file "/tmp/walter.l3") (lisp-mode) ;;; and this... ;;; (def bar ;;; (lambda (x) ;;; (bar nothing))) ;;; into *LEDIT* (defun ledit-output (args) (if args (let ((ofile (outfile *ledit-outfile*))) (format ofile "(progn)") ; this is necessary. (cond ((null (cdr args)) ; no keyword -> arg is a tag. (format ofile "(progn tag (setq tag \"~A\"~ (&goto-tag))" (car args))) ((eq (cadr args) 'pp) ; pp-> pp first arg to emacs (apply 'pp `((|F| ,*ledit-ppfile*) ,(car args))) (format ofile "(switch-to-buffer \"LEDIT\")~ (erase-buffer)") (format ofile "(insert-file \"~A\")" *ledit-ppfile*) (format ofile "(lisp-mode)")) (t (format t "~&~A -- unknown option~%" (cdr args)))) (close ofile)))) ;;; LISZT* ;;; Need this guy to do compile-input. ;;; Liszt returns 0 if all was well. ;;; Note that in ordinary use the user will have to get used to looking ;;; at "%Warning: ... Compiler declared *foo* special" messages, since ;;; you don't usually want to hunt around in your file, zap in the the ;;; declarations, then go back to what you were doing. ;;; Fortunately this doesn't cause the compiler to bomb. ;;; Some sleepless night I will think of a way to get around this. (defun liszt* (&rest args) (apply #'liszt args)) ;;; LEDIT-INPUT ;;; Although there are two cases here, in practice ;;; it is never the case that there is both input to be ;;; interpreted and input to be compiled. (defun ledit-input () (if (probef *ledit-lisztfile*) (cond ((getd #'liszt) (format t ";Compiling LEDIT:") (and (zerop (liszt* *ledit-lisztfile* '-o *ledit-objfile*)) (load *ledit-objfile*))) (t (format t ";Can't compile LEDIT: No liszt.~%;Reading instead:") (let ((ifile (infile *ledit-lisztfile*))) (ledit-load ifile) (close ifile))))) (if (probef *ledit-infile*) (let ((ifile (infile *ledit-infile*))) (format t ";Reading from LEDIT:~%") (ledit-load ifile) (close ifile)))) ;;; LEDIT-LOAD ;;; A generally useful form of load (defun ledit-load (ifile) (let ((eof-form (list 'eof-form))) (do ((form (read ifile eof-form) (read ifile eof-form))) ((eq form eof-form)) (format t "; ~A~%" (eval form))))) (setsyntax #/ 'macro 'ledit) ; make ^E = (ledit) ;; more robust version of the c function set_proc_str. Does argument checking. ;; set_proc_str sets the string that is stuffed to the tty after franz pauses ;; and the csh wakes up. It is usually "%emacs" or "%vemacs" or "%?emacs" (defun set-proc-str (arg) (if (stringp arg) (set_proc_str arg) (if (symbolp arg) (set_proc_str (get-pname arg)) (error arg " is illegal argument to set-proc-str")))) emacs-19.30/etc/ms-7bkermit100666 13437 1 22322 5013650467 14130 0ustar jimbdaemon;;; This file is designed for 7-bit connections. ;;; Use the file ms-kermit if you have an 8-bit connection. ;;; This kermit script maps the IBM-PC keyboard for use with Gnu Emacs. ;;; The ALT key is used to generate Meta characters and, in conjunction ;;; with the CTRL key, Control-Meta characters. A few other useful ;;; mappings are also performed. ;;; Andy Lowry, May 1989 ;;; Exchange ESC and backquote... tilde stays put (shift-backquote) set key \27 ` set key ` \27 ;;; BACKSPACE deletes backward one character set key scan \270 \127 ;;; The following mappings affect certain special keys... all the keys ;;; are duplicated on the numeric keypad when NUM LOCK is off, but ;;; the keypad versions are NOT mapped (string definition space too small ;;; for that) ;;; INSERT toggles overwrite mode set key scan \4434 \27xoverwrite-mode\13 ;;; HOME moves point to beginning of buffer set key scan \4423 \27< ;;; PAGE-UP scrolls backward one screen set key scan \4425 \27v ;;; DELETE deletes one character *forward* set key scan \4435 \4 ;;; END moves point to end of buffer set key scan \4431 \27> ;;; PAGE-DOWN scrolls forward one screen set key scan \4433 \22 ;;; ARROW keys move in the appropriate directions set key scan \4424 \16 set key scan \4427 \2 set key scan \4432 \14 set key scan \4429 \6 ;;; META versions of all the printing characters except uppercase ;;; letters are generated by using the ALT key. The definition string ;;; consists of an ESC character followed by the META-ized character. ;;; The characters are listed roughly left-to-right and top-to-bottom ;;; as they appear on the keyboard set key scan \2345 \27` set key scan \2424 \27\o61 ; need to use char code, since digit set key scan \2425 \27\o62 ; would not terminate '\27' set key scan \2426 \27\o63 set key scan \2427 \27\o64 set key scan \2428 \27\o65 set key scan \2429 \27\o66 set key scan \2430 \27\o67 set key scan \2431 \27\o70 set key scan \2432 \27\o71 set key scan \2433 \27\o60 set key scan \2434 \27\45 set key scan \2435 \27= set key scan \2857 \27~ set key scan \2936 \27! set key scan \2937 \27@ set key scan \2938 \27# set key scan \2939 \27$ set key scan \2940 \27% set key scan \2941 \27^ set key scan \2942 \27& set key scan \2943 \27* set key scan \2944 \27( set key scan \2945 \27) set key scan \2946 \27_ set key scan \2947 \27+ set key scan \2469 \27\9 set key scan \2320 \27q set key scan \2321 \27w set key scan \2322 \27e set key scan \2323 \27r set key scan \2324 \27t set key scan \2325 \27y set key scan \2326 \27u set key scan \2327 \27i set key scan \2328 \27o set key scan \2329 \27p set key scan \2330 \27[ set key scan \2842 \27{ set key scan \2331 \27] set key scan \2843 \27} set key scan \2347 \27\ set key scan \2859 \27| set key scan \2334 \27a set key scan \2335 \27s set key scan \2336 \27d set key scan \2337 \27f set key scan \2338 \27g set key scan \2339 \27h set key scan \2340 \27j set key scan \2341 \27k set key scan \2342 \27l set key scan \2343 \27\59 set key scan \2855 \27: set key scan \2344 \27' set key scan \2856 \27" set key scan \2348 \27z set key scan \2349 \27x set key scan \2350 \27c set key scan \2351 \27v set key scan \2352 \27b set key scan \2353 \27n set key scan \2354 \27m set key scan \2355 \27, set key scan \2867 \27< set key scan \2356 \27. set key scan \2868 \27> set key scan \2357 \27/ set key scan \2869 \27? ;;; CONTROL-META characters are generated by using both the CTRL and ;;; ALT keys simultaneously. All the lowercase letters are included. ;;; The definition string consists of an ESC character followed by ;;; the control character corresponding to the letter. set key scan \3344 \27\17 set key scan \3345 \27\23 set key scan \3346 \27\5 set key scan \3347 \27\18 set key scan \3348 \27\20 set key scan \3349 \27\25 set key scan \3350 \27\21 set key scan \3351 \27\9 set key scan \3352 \27\15 set key scan \3353 \27\16 set key scan \3358 \27\1 set key scan \3359 \27\19 set key scan \3360 \27\4 set key scan \3361 \27\6 set key scan \3362 \27\7 set key scan \3363 \27\8 set key scan \3364 \27\10 set key scan \3365 \27\11 set key scan \3366 \27\12 set key scan \3372 \27\26 set key scan \3373 \27\24 set key scan \3374 \27\3 set key scan \3375 \27\22 set key scan \3376 \27\2 set key scan \3377 \27\14 set key scan \3378 \27\13 end of msiem2.ini ------------------ msiema.hlp ----------- Date: Wed, 14 Sep 88 05:20:08 GMT From: spolsky@YALE.ARPA Subject: Using MS kermit 2.31 with emacs Keywords: MS-DOS Kermit 2.31, EMACS, Meta Key If you are using kermit (version 2.31 only) with emacs on a mainframe, the following file may help you. It assigns all the Alt-keys so that the Alt key may be used as a "Meta" shift, e.g. Alt-x produces M-x, etc. Note that it will distinguish correctly between upper and lower case and accepts all printables. (If anybody has the patience to do the Meta-Ctrl combinations, please post them!) This actually sends "escapes" so you don't need 8 bits. This file also sets up the cursor keys to behave as expected. On extended keyboards (the ones with a separate cursor pad, like PS/2s) you also get assignments for Page Up/Down, Home, End, Insert, Delete, etc. Please let me know if you find any problems with this. Joel Spolsky bitnet: spolsky@yalecs uucp: ...!yale!spolsky Yale University arpa: spolsky@yale.edu voicenet: 203-436-1483 [Ed. - Thanks, Joel! Your key definitions file has been put in the kermit distribution area as msiema.ini ("ms" for MS-Kermit, "i" because it's an initialization file, "ema" for EMACS), along with this message as msiema.hlp.] end of msiema.hlp ----------------- msiema.ini ------------ ; Emacs keyboard layout for Kermit 2.31 ; by Joel Spolsky, Yale Univ. Save this in a file, then ; initialize it by issuing the kermit command ; take filename ; It will set up the keyboard to allow ALT to be used ; as a meta-key, and will allow cursor keys to be used ; with emacs. ; First, define all the ALT keys to send ESC+key ; to simulate "meta" set key \2320 \27q ;; letters: unshifted set key \2321 \27w set key \2322 \27e set key \2323 \27r set key \2324 \27t set key \2325 \27y set key \2326 \27u set key \2327 \27i set key \2328 \27o set key \2329 \27p set key \2334 \27a set key \2335 \27s set key \2336 \27d set key \2337 \27f set key \2338 \27g set key \2339 \27h set key \2340 \27j set key \2341 \27k set key \2342 \27l set key \2348 \27z set key \2349 \27x set key \2350 \27c set key \2351 \27v set key \2352 \27b set key \2353 \27n set key \2354 \27m set key \2832 \27Q ;; letters: shifted set key \2833 \27W set key \2834 \27E set key \2835 \27R set key \2836 \27T set key \2837 \27Y set key \2838 \27U set key \2839 \27I set key \2840 \27O set key \2841 \27P set key \2846 \27A set key \2847 \27S set key \2848 \27D set key \2849 \27F set key \2850 \27G set key \2851 \27H set key \2852 \27J set key \2853 \27K set key \2854 \27L set key \2860 \27Z set key \2861 \27X set key \2862 \27C set key \2863 \27V set key \2864 \27B set key \2865 \27N set key \2866 \27M set key \2857 \27\126 ; ALT + ~ ;; special symbols begin here set key \2345 \27\96 ; ALT + ` set key \2936 \27\33 ; ALT + ! set key \2937 \27\64 ; ALT + @ set key \2938 \27\35 ; ALT + # set key \2939 \27\36 ; ALT + $ set key \2940 \27\37 ; ALT + % set key \2941 \27\94 ; ALT + ^ set key \2942 \27\38 ; ALT + & set key \2943 \27\42 ; ALT + * set key \2944 \27\40 ; ALT + ( set key \2945 \27\41 ; ALT + ) set key \2946 \27\95 ; ALT + _ set key \2947 \27\43 ; ALT + + set key \2842 \27\123 ; ALT + { set key \2843 \27\125 ; ALT + } set key \2330 \27\91 ; ALT + [ set key \2331 \27\93 ; ALT + ] set key \2859 \27\124 ; ALT + : set key \2347 \27\92 ; ALT + \ set key \2867 \27< ; ALT + < set key \2868 \27> ; ALT + > set key \2343 \27\59 ; ALT + ; set key \2855 \27\58 ; ALT + : set key \2344 \27\39 ; ALT + ' set key \2856 \27\34 ; ALT + " set key \2355 \27\44 ; ALT + , set key \2356 \27\46 ; ALT + . set key \2357 \27\47 ; ALT + / set key \2869 \27\63 ; ALT + ? set key \2424 \27\49 ;; numbers set key \2425 \27\50 set key \2426 \27\51 set key \2427 \27\52 set key \2428 \27\53 set key \2429 \27\54 set key \2430 \27\55 set key \2431 \27\56 set key \2432 \27\57 set key \2433 \27\48 ;; These 6 special keys for extended (PS/2) keyboards: set key \4434 \25 ;; Insert is like ^Y - yank from kill ring set key \4435 \23 ;; Delete is like ^W - kill to ring set key \4423 \1 ;; Home is ^A set key \4431 \5 ;; End is ^E set key \4425 \27V ;; Page up is Esc-V set key \4433 \22 ;; Page dn is ^v set key \328 \16 ;; up cursor is ^P set key \331 \2 ;; left cursor is ^B set key \333 \6 ;; right cursor is ^F set key \336 \14 ;; down cursor is ^N set key \4427 \2 ;; left cursor on extended kbd set key \4432 \14 ;; down cursor on extended kbd set key \4424 \16 ;; up cursor on extended kbd set key \4429 \6 ;; right cursor on extended kbd set key \5491 \27b ;; ctrl-left cursor is M-b set key \5492 \27f ;; ctrl-right cursor is M-f ;; move kermit's screen scroll (playback) features to Alt- Home,End,PgUp,PgDn ;; (this is an issue for extended keyboards only) set key \2455 \khomscn set key \2463 \kendscn set key \2457 \kupscn set key \2465 \kdnscn emacs-19.30/etc/ms-kermit100666 12120 13 7533 5775477264 13311 0ustar rmsuser;;; This file is designed for an 8-bit connection. ;;; Use the file ms-7bkermit if you have a 7-bit connection. ;; Meta key mappings for EMACS ;; By Robert Earl (rearl@watnxt3.ucr.edu) ;; May 13, 1990 ;; ;; WARNING: ;; requires an 8-bit path to host. many dialups and lans won't pass the ;; eighth bit by default and may require a special command to turn this ;; off. `screen' is known to mask the eighth bit of input as well. set term controls 8-bit set translation key off ;; control keys set key \3449 \128 ;; m-c-@ set key \3358 \129 ;; m-c-a set key \3376 \130 ;; m-c-b set key \3374 \131 ;; m-c-c set key \3360 \132 ;; m-c-d set key \3346 \133 ;; m-c-e set key \3361 \134 ;; m-c-f set key \3362 \135 ;; m-c-g set key \3342 \136 ;; m-bs set key \3363 \136 ;; m-c-h (sends same code as above) set key \2469 \137 ;; m-tab set key \3351 \137 ;; m-c-i (same as above) set key \3364 \138 ;; m-c-j set key \3365 \139 ;; m-c-k set key \3366 \140 ;; m-c-l ;set key \3378 \141 ;; m-c-m set key \2332 \141 ;; m-ret (sends same code as above) set key \3377 \142 ;; m-c-n set key \3352 \143 ;; m-c-o set key \3353 \144 ;; m-c-p set key \3344 \145 ;; m-c-q set key \3347 \146 ;; m-c-r set key \3359 \147 ;; m-c-s set key \3348 \148 ;; m-c-t set key \3350 \149 ;; m-c-u set key \3375 \150 ;; m-c-v set key \3345 \151 ;; m-c-w set key \3373 \152 ;; m-c-x set key \3349 \153 ;; m-c-y set key \3372 \154 ;; m-c-z ;; misc keys ;set key \3354 \155 ;; m-c-[ set key \2305 \155 ;; m-esc (sends same as above) set key \3371 \156 ;; m-c-\ set key \3355 \157 ;; m-c-] set key \3453 \158 ;; m-c-^ set key \3458 \159 ;; m-c-_ ;; \160 is conspicuously missing here-- ;; alt-spc doesn't generate a distinct scan code... ;; neither do shift-spc and ctrl-spc. ;; no idea why. set key \2936 \161 ;; m-! set key \2856 \162 ;; m-" set key \2938 \163 ;; m-# set key \2939 \164 ;; m-$ set key \2940 \165 ;; m-% set key \2942 \166 ;; m-& set key \2344 \167 ;; m-' set key \2944 \168 ;; m-( set key \2945 \169 ;; m-) set key \2943 \170 ;; m-* set key \2947 \171 ;; m-+ set key \2355 \172 ;; m-, set key \2434 \173 ;; m-- set key \2356 \174 ;; m-. set key \2357 \175 ;; m-/ ;; number keys set key \2433 \176 ;; m-0 set key \2424 \177 ;; m-1 set key \2425 \178 set key \2426 \179 set key \2427 \180 set key \2428 \181 set key \2429 \182 set key \2430 \183 set key \2431 \184 set key \2432 \185 ;; m-9 set key \2855 \186 ;; m-: set key \2343 \187 ;; m-; set key \2867 \188 ;; m-< set key \2435 \189 ;; m-= set key \2868 \190 ;; m-> set key \2869 \191 ;; m-? set key \2937 \192 ;; m-@ ;; shifted A-Z set key \2846 \193 ;; m-A set key \2864 \194 set key \2862 \195 set key \2848 \196 set key \2834 \197 set key \2849 \198 set key \2850 \199 set key \2851 \200 set key \2839 \201 set key \2852 \202 set key \2853 \203 set key \2854 \204 set key \2866 \205 set key \2865 \206 set key \2840 \207 set key \2841 \208 set key \2832 \209 set key \2835 \210 set key \2847 \211 set key \2836 \212 set key \2838 \213 set key \2863 \214 set key \2833 \215 set key \2861 \216 set key \2837 \217 set key \2860 \218 ;; m-Z set key \2330 \219 ;; m-[ set key \2347 \220 ;; m-\ set key \2331 \221 ;; m-] set key \2941 \222 ;; m-^ set key \2946 \223 ;; m-_ set key \2345 \224 ;; m-` ;; lowercase a-z set key \2334 \225 ;; m-a set key \2352 \226 set key \2350 \227 set key \2336 \228 set key \2322 \229 set key \2337 \230 set key \2338 \231 set key \2339 \232 set key \2327 \233 set key \2340 \234 set key \2341 \235 set key \2342 \236 set key \2354 \237 set key \2353 \238 set key \2328 \239 set key \2329 \240 set key \2320 \241 set key \2323 \242 set key \2335 \243 set key \2324 \244 set key \2326 \245 set key \2351 \246 set key \2321 \247 set key \2349 \248 set key \2325 \249 set key \2348 \250 ;; m-z ;; more shifted misc. keys set key \2842 \251 ;; m-{ set key \2859 \252 ;; m-| set key \2843 \253 ;; m-} set key \2857 \254 ;; m-~ set key \2318 \255 ;; m-del emacs-19.30/etc/news.texi100666 12120 13 412253 5542522034 13336 0ustar rmsuser\input texinfo @c -*-texinfo-*- @setfilename LNEWS This file describes the new Lisp features of Emacs version 19 as first released to the public. For Lisp changes in subsequent Emacs 19 releases, see the file NEWS. @section New Features in the Lisp Language @itemize @bullet @item The new function @code{delete} is a traditional Lisp function. It takes two arguments, @var{elt} and @var{list}, and deletes from @var{list} any elements that are equal to @var{elt}. It uses the function @code{equal} to compare elements with @var{elt}. @item The new function @code{member} is a traditional Lisp function. It takes two arguments, @var{elt} and @var{list}, and finds the first element of @var{list} that is equal to @var{elt}. It uses the function @code{equal} to compare each list element with @var{elt}. The value is a sublist of @var{list}, whose first element is the one that was found. If no matching element is found, the value is @code{nil}. @ignore @c Seems not to be true, from looking at the code. @item The function @code{equal} is now more robust: it does not crash due to circular list structure. @end ignore @item The new function @code{indirect-function} finds the effective function definition of an object called as a function. If the object is a symbol, @code{indirect-function} looks in the function definition of the symbol. It keeps doing this until it finds something that is not a symbol. @item There are new escape sequences for use in character and string constants. The escape sequence @samp{\a} is equivalent to @samp{\C-g}, the @sc{ASCII} @sc{BEL} character (code 7). The escape sequence @samp{\x} followed by a hexidecimal number represents the character whose @sc{ASCII} code is that number. There is no limit on the number of digits in the hexidecimal value. @item The function @code{read} when reading from a buffer now does not skip a terminator character that terminates a symbol. It leaves that character to be read (or just skipped, if it is whitespace) next time. @item When you use a function @var{function} as the input stream for @code{read}, it is usually called with no arguments, and should return the next character. In Emacs 19, sometimes @var{function} is called with one argument (always a character). When that happens, @var{function} should save the argument and arrange to return it when called next time. @item @code{random} with integer argument @var{n} returns a random number between 0 and @var{n}@minus{}1. @item The functions @code{documentation} and @code{documentation-property} now take an additional optional argument which, if non-@code{nil}, says to refrain from calling @code{substitute-command-keys}. This way, you get the exact text of the documentation string as written, without the usual substitutions. Make sure to call @code{substitute-command-keys} yourself if you decide to display the string. @item The new function @code{invocation-name} returns as a string the program name that was used to run Emacs, with any directory names discarded. @item The new function @code{map-y-or-n-p} makes it convenient to ask a series of similar questions. The arguments are @var{prompter}, @var{actor}, @var{list}, and optional @var{help}. The value of @var{list} is a list of objects, or a function of no arguments to return either the next object or @code{nil} meaning there are no more. The argument @var{prompter} specifies how to ask each question. If @var{prompter} is a string, the question text is computed like this: @example (format @var{prompter} @var{object}) @end example @noindent where @var{object} is the next object to ask about. If not a string, @var{prompter} should be a function of one argument (the next object to ask about) and should return the question text. The argument @var{actor} should be a function of one argument, which is called with each object that the user says yes for. Its argument is always one object from @var{list}. If @var{help} is given, it is a list @code{(@var{object} @var{objects} @var{action})}, where @var{object} is a string containing a singular noun that describes the objects conceptually being acted on; @var{objects} is the corresponding plural noun and @var{action} is a transitive verb describing @var{actor}. The default is @code{("object" "objects" "act on")}. Each time a question is asked, the user may enter @kbd{y}, @kbd{Y}, or @key{SPC} to act on that object; @kbd{n}, @kbd{N}, or @key{DEL} to skip that object; @kbd{!} to act on all following objects; @key{ESC} or @kbd{q} to exit (skip all following objects); @kbd{.} (period) to act on the current object and then exit; or @kbd{C-h} to get help. @code{map-y-or-n-p} returns the number of objects acted on. @item You can now ``set'' environment variables with the @code{setenv} command. This works by setting the variable @code{process-environment}, which @code{getenv} now examines in preference to the environment Emacs received from its parent. @end itemize @section New Features for Loading Libraries You can now arrange to run a hook if a particular Lisp library is loaded. The variable @code{after-load-alist} is an alist of expressions to be evalled when particular files are loaded. Each element looks like @code{(@var{filename} @var{forms}@dots{})}. When @code{load} is run and the file name argument equals @var{filename}, the @var{forms} in the corresponding element are executed at the end of loading. @var{filename} must match exactly! Normally @var{filename} is the name of a library, with no directory specified, since that is how @code{load} is normally called. An error in @var{forms} does not undo the load, but does prevent execution of the rest of the @var{forms}. The function @code{eval-after-load} provides a convenient way to add entries to the alist. Call it with two arguments, @var{file} and a form to execute. The function @code{autoload} now supports autoloading a keymap. Use @code{keymap} as the fourth argument if the autoloaded function will become a keymap when loaded. There is a new feature for specifying which functions in a library should be autoloaded by writing special ``magic'' comments in that library itself. Write @samp{;;;###autoload} on a line by itself before the real definition of the function, in its autoloadable source file; then the command @kbd{M-x update-file-autoloads} automatically puts the @code{autoload} call into @file{loaddefs.el}. You can also put other kinds of forms into @file{loaddefs.el}, by writing @samp{;;;###autoload} followed on the same line by the form. @kbd{M-x update-file-autoloads} copies the form from that line. @section Compilation Features @itemize @bullet @item Inline functions. You can define an @dfn{inline function} with @code{defsubst}. Use @code{defsubst} just like @code{defun}, and it defines a function which you can call in all the usual ways. Whenever the function thus defined is used in compiled code, the compiler will open code it. You can get somewhat the same effects with a macro, but a macro has the limitation that you can use it only explicitly; a macro cannot be called with @code{apply}, @code{mapcar} and so on. Also, it takes some work to convert an ordinary function into a macro. To convert it into an inline function, simply replace @code{defun} with @code{defsubst}. Making a function inline makes explicit calls run faster. But it also has disadvantages. For one thing, it reduces flexibility; if you change the definition of the function, calls already inlined still use the old definition until you recompile them. Another disadvantage is that making a large function inline can increase the size of compiled code both in files and in memory. Since the advantages of inline functions are greatest for small functions, you generally should not make large functions inline. Inline functions can be used and open coded later on in the same file, following the definition, just like macros. @item The command @code{byte-compile-file} now offers to save any buffer visiting the file you are compiling. @item The new command @code{compile-defun} reads, compiles and executes the defun containing point. If you use this on a defun that is actually a function definition, the effect is to install a compiled version of that function. @item Whenever you load a Lisp file or library, you now receive a warning if the directory contains both a @samp{.el} file and a @samp{.elc} file, and the @samp{.el} file is newer. This typically indicates that someone has updated the Lisp code but forgotten to recompile it, so the changes do not take effect. The warning is a reminder to recompile. @item The special form @code{eval-when-compile} marks the forms it contains to be evaluated at compile time @emph{only}. At top-level, this is analogous to the Common Lisp idiom @code{(eval-when (compile) @dots{})}. Elsewhere, it is similar to the Common Lisp @samp{#.} reader macro (but not when interpreting). If you're thinking of using this feature, we recommend you consider whether @code{provide} and @code{require} might do the job as well. @item The special form @code{eval-and-compile} is similar to @code{eval-when-compile}, but the whole form is evaluated both at compile time and at run time. If you're thinking of using this feature, we recommend you consider whether @code{provide} and @code{require} might do the job as well. @item Emacs Lisp has a new data type for byte-code functions. This makes them faster to call, and also saves space. Internally, a byte-code function object is much like a vector; however, the evaluator handles this data type specially when it appears as a function to be called. The printed representation for a byte-code function object is like that for a vector, except that it starts with @samp{#} before the opening @samp{[}. A byte-code function object must have at least four elements; there is no maximum number, but only the first six elements are actually used. They are: @table @var @item arglist The list of argument symbols. @item byte-code The string containing the byte-code instructions. @item constants The vector of constants referenced by the byte code. @item stacksize The maximum stack size this function needs. @item docstring The documentation string (if any); otherwise, @code{nil}. @item interactive The interactive spec (if any). This can be a string or a Lisp expression. It is @code{nil} for a function that isn't interactive. @end table The predicate @code{byte-code-function-p} tests whether a given object is a byte-code function. You can create a byte-code function object in a Lisp program with the function @code{make-byte-code}. Its arguments are the elements to put in the byte-code function object. You should not try to come up with the elements for a byte-code function yourself, because if they are inconsistent, Emacs may crash when you call the function. Always leave it to the byte compiler to create these objects; it, we hope, always makes the elements consistent. @end itemize @section Floating Point Numbers You can now use floating point numbers in Emacs, if you define the macro @code{LISP_FLOAT_TYPE} when you compile Emacs. The printed representation for floating point numbers requires either a decimal point surrounded by digits, or an exponent, or both. For example, @samp{1500.0}, @samp{15e2}, @samp{15.0e2} and @samp{1.5e3} are four ways of writing a floating point number whose value is 1500. The existing predicate @code{numberp} now returns @code{t} if the argument is any kind of number---either integer or floating. The new predicates @code{integerp} and @code{floatp} check for specific types of numbers. You can do arithmetic on floating point numbers with the ordinary arithmetic functions, @code{+}, @code{-}, @code{*} and @code{/}. If you call one of these functions with both integers and floating point numbers among the arguments, the arithmetic is done in floating point. The same applies to the numeric comparison functions such as @code{=} and @code{<}. The remainder function @code{%} does not accept floating point arguments, and neither do the bitwise boolean operations such as @code{logand} or the shift functions such as @code{ash}. There is a new arithmetic function, @code{abs}, which returns the absolute value of its argument. It handles both integers and floating point numbers. To convert an integer to floating point, use the function @code{float}. There are four functions to convert floating point numbers to integers; they differ in how they round. @code{truncate} rounds toward 0, @code{floor} rounds down, @code{ceil} rounds up, and @code{round} produces the nearest integer. You can use @code{logb} to extract the binary exponent of a floating point number. More precisely, it is the logarithm base 2, rounded down to an integer. Emacs has several new mathematical functions that accept any kind of number as argument, but always return floating point numbers. @table @code @item cos @findex cos @itemx sin @findex sin @itemx tan @findex tan Trigonometric functions. @item acos @findex acos @itemx asin @findex asin @itemx atan @findex atan Inverse trigonometric functions. @item exp @findex exp The exponential function (power of @var{e}). @item log @findex log Logarithm base @var{e}. @item log10 @findex log10 Logarithm base 10 @item expt @findex expt Raise @var{x} to power @var{y}. @item sqrt @findex sqrt The square root function. @end table The new function @code{string-to-number} now parses a string containing either an integer or a floating point number, returning the number. The @code{format} function now handles the specifications @samp{%e}, @samp{%f} and @samp{%g} for printing floating point numbers; likewise @code{message}. The new variable @code{float-output-format} controls how Lisp prints floating point numbers. Its value should be @code{nil} or a string. If it is a string, it should contain a @samp{%}-spec like those accepted by @code{printf} in C, but with some restrictions. It must start with the two characters @samp{%.}. After that comes an integer which is the precision specification, and then a letter which controls the format. The letters allowed are @samp{e}, @samp{f} and @samp{g}. Use @samp{e} for exponential notation (@samp{@var{dig}.@var{digits}e@var{expt}}). Use @samp{f} for decimal point notation (@samp{@var{digits}.@var{digits}}). Use @samp{g} to choose the shorter of those two formats for the number at hand. The precision in any of these cases is the number of digits following the decimal point. With @samp{e}, a precision of 0 means to omit the decimal point. 0 is not allowed with @samp{f} or @samp{g}. A value of @code{nil} means to use the format @samp{%.20g}. No matter what the value of @code{float-output-format}, printing ensures that the result fits the syntax rules for a floating point number. If it doesn't fit (for example, if it looks like an integer), it is modified to fit. By contrast, the @code{format} function formats floating point numbers without requiring the output to fit the syntax rules for floating point number. @section New Features for Printing And Formatting Output @itemize @bullet @item The @code{format} function has a new feature: @samp{%S}. This print spec prints any kind of Lisp object, even a string, using its Lisp printed representation. By contrast, @samp{%s} prints everything without quotation. @item @code{prin1-to-string} now takes an optional second argument which says not to print the Lisp quotation characters. (In other words, to use @code{princ} instead of @code{prin1}.) @item The new variable @code{print-level} specifies the maximum depth of list nesting to print before cutting off all deeper structure. A value of @code{nil} means no limit. @end itemize @section Changes in Basic Editing Functions @itemize @bullet @item There are two new primitives for putting text in the kill ring: @code{kill-new} and @code{kill-append}. The function @code{kill-new} adds a string to the front of the kill ring. Use @code{kill-append} to add a string to a previous kill. The second argument @var{before-p}, if non-@code{nil}, says to add the string at the beginning; otherwise, it goes at the end. Both of these functions apply @code{interprogram-cut-function} to the entire string of killed text that ends up at the beginning of the kill ring. @item The new function @code{current-kill} rotates the yanking pointer in the kill ring by @var{n} places, and returns the text at that place in the ring. If the optional second argument @var{do-not-move} is non-@code{nil}, it doesn't actually move the yanking point; it just returns the @var{n}th kill forward. If @var{n} is zero, indicating a request for the latest kill, @code{current-kill} calls @code{interprogram-paste-function} (documented below) before consulting the kill ring. All Emacs Lisp programs should either use @code{current-kill}, @code{kill-new}, and @code{kill-append} to manipulate the kill ring, or be sure to call @code{interprogram-paste-function} and @code{interprogram-cut-function} as appropriate. @item The variables @code{interprogram-paste-function} and @code{interprogram-cut-function} exist so that you can provide functions to transfer killed text to and from other programs. @item The @code{kill-region} function can now be used in read-only buffers. It beeps, but adds the region to the kill ring without deleting it. @item The new function @code{compare-buffer-substrings} lets you compare two substrings of the same buffer or two different buffers. Its arguments look like this: @example (compare-buffer-substrings @var{buf1} @var{beg1} @var{end1} @var{buf2} @var{beg2} @var{end2}) @end example The first three arguments specify one substring, giving a buffer and two positions within the buffer. The last three arguments specify the other substring in the same way. The value is negative if the first substring is less, positive if the first is greater, and zero if they are equal. The absolute value of the result is one plus the index of the first different characters. @item Overwrite mode treats tab and newline characters specially. You can now turn off this special treatment by setting @code{overwrite-binary-mode} to @code{t}. @item Once the mark ``exists'' in a buffer, it normally never ceases to exist. However, in Transient Mark mode, it may become @dfn{inactive}. The variable @code{mark-active}, which is always local in all buffers, indicates whether the mark is active: non-@code{nil} means yes. When the mark is inactive, the function @code{mark} normally gets an error. However, @code{(mark t)} returns the position of the inactive mark. The function @code{push-mark} normally does not activate the mark. However, it accepts an optional third argument @var{activate} which, if non-@code{nil}, says to activate. A command can request deactivation of the mark upon return to the editor command loop by setting @code{deactivate-mark} to a non-@code{nil} value. Transient Mark mode works by causing the command loop to take note of @code{deactivate-mark} and actually deactivate the mark. Transient Mark mode enables highlighting of the region when the mark is active. This is currently implemented only under the X Window System. A few other commands vary their behavior slightly in this case, by testing @code{transient-mark-mode}. More specifically, they avoid special display actions such as moving the cursor temporarily, which are not needed when the region is shown by highlighting. The variables @code{activate-mark-hook} and @code{deactivate-mark-hook} are normal hooks run, respectively, when the mark becomes active and when it becomes inactive. The hook @code{activate-mark-hook} is also run at the end of a command if the mark is active and the region may have changed. @item The function @code{move-to-column} now accepts a second optional argument @var{force}, in addition to @var{column}; if the requested column @var{column} is in the middle of a tab character and @var{force} is non-@code{nil}, @code{move-to-column} replaces the tab with the appropriate sequence of spaces so that it can place point exactly at @var{column}. @item The search functions when successful now return the value of point rather than just @code{t}. This affects the functions @code{search-forward}, @code{search-backward}, @code{word-search-forward}, @code{word-search-backward}, @code{re-search-forward}, and @code{re-search-backward}. @item When you do regular expression searching or matching, there is no longer a limit to how many @samp{\(@dots{}\)} pairs you can get information about with @code{match-beginning} and @code{match-end}. Also, these parenthetical groupings may now be nested to any degree. @item In a regular expression, when you use an asterisk after a parenthetical grouping, and then ask about what range was matched by the grouping, Emacs 19 reports just its last occurrence. Emacs 18 used to report the range of all the repetitions put together. For example, @example (progn (string-match "f\\(o\\)*" "foo") (list (match-beginning 1) (match-end 1))) @end example @noindent returns @code{(2 3)} in Emacs 19, corresponding to just the last repetition of @samp{\(o\)}. In Emacs 18, that expression returns @code{(1 3)}, encompassing both repetitions. If you want the Emacs 18 behavior, use a grouping @emph{containing} the asterisk: @code{"f\\(o*\\)"}. @item The new special form @code{save-match-data} preserves the regular expression match status. Usage: @code{(save-match-data @var{body}@dots{})}. @item The function @code{translate-region} applies a translation table to the characters in a part of the buffer. Invoke it as @code{(translate-region @var{start} @var{end} @var{table})}; @var{start} and @var{end} bound the region to translate. The translation table @var{table} is a string; @code{(aref @var{table} @var{ochar})} gives the translated character corresponding to @var{ochar}. If the length of @var{table} is less than 256, any characters with codes larger than the length of @var{table} are not altered by the translation. @code{translate-region} returns the number of characters which were actually changed by the translation. This does not count characters which were mapped into themselves in the translation table. @item There are two new hook variables that let you notice all changes in all buffers (or in a particular buffer, if you make them buffer-local): @code{before-change-function} and @code{after-change-function}. If @code{before-change-function} is non-@code{nil}, then it is called before any buffer modification. Its arguments are the beginning and end of the region that is going to change, represented as integers. The buffer that's about to change is always the current buffer. If @code{after-change-function} is non-@code{nil}, then it is called after any buffer modification. It takes three arguments: the beginning and end of the region just changed, and the length of the text that existed before the change. (To get the current length, subtract the region beginning from the region end.) All three arguments are integers. The buffer that has just changed is always the current buffer. Both of these variables are temporarily bound to @code{nil} during the time that either of these hooks is running. This means that if one of these functions changes the buffer, that change won't run these functions. If you do want hooks to be run recursively, write your hook functions to bind these variables back to their usual values. @item The hook @code{first-change-hook} is run using @code{run-hooks} whenever a buffer is changed that was previously in the unmodified state. @item The second argument to @code{insert-abbrev-table-description} is now optional. @end itemize @section Text Properties Each character in a buffer or a string can have a @dfn{text property list}, much like the property list of a symbol. The properties belong to a particular character at a particular place, such as, the letter @samp{T} at the beginning of this sentence. Each property has a name, which is usually a symbol, and an associated value, which can be any Lisp object---just as for properties of symbols. You can use the property @code{face} to control the font and color of text. Several other property names have special meanings. You can create properties of any name and examine them later for your own purposes. Copying text between strings and buffers preserves the properties along with the characters; this includes such diverse functions as @code{substring}, @code{insert}, and @code{buffer-substring}. Since text properties are considered part of the buffer contents, changing properties in a buffer ``modifies'' the buffer, and you can also undo such changes. Strings with text properties have a special printed representation which describes all the properties. This representation is also the read syntax for such a string. It looks like this: @example #("@var{characters}" @var{property-data}...) @end example @noindent where @var{property-data} is zero or more elements in groups of three as follows: @example @var{beg} @var{end} @var{plist} @end example @noindent The elements @var{beg} and @var{end} are integers, and together specify a portion of the string; @var{plist} is the property list for that portion. @subsection Examining Text Properties The simplest way to examine text properties is to ask for the value of a particular property of a particular character. For that, use @code{get-text-property}. Use @code{text-properties-at} to get the entire property list of a character. @code{(get-text-property @var{pos} @var{prop} @var{object})} returns the @var{prop} property of the character after @var{pos} in @var{object} (a buffer or string). The argument @var{object} is optional and defaults to the current buffer. @code{(text-properties-at @var{pos} @var{object})} returns the entire property list of the character after @var{pos} in the string or buffer @var{object} (which defaults to the current buffer). @subsection Changing Text Properties There are four primitives for changing properties of a specified range of text: @table @code @item add-text-properties This function puts on specified properties, leaving other existing properties unaltered. @item put-text-property This function puts on a single specified property, leaving others unaltered. @item remove-text-properties This function removes specified properties, leaving other properties unaltered. @item set-text-properties This function replaces the entire property list, leaving no vestige of the properties that that text used to have. @end table All these functions take four arguments: @var{start}, @var{end}, @var{props}, and @var{object}. The last argument is optional and defaults to the current buffer. The argument @var{props} has the form of a property list. @subsection Property Search Functions In typical use of text properties, most of the time several or many consecutive characters have the same value for a property. Rather than writing your programs to examine characters one by one, it is much faster to process chunks of text that have the same property value. The functions @code{next-property-change} and @code{previous-property-change} scan forward or backward from position @var{pos} in @var{object}, looking for a change in any property between two characters scanned. They returns the position between those two characters, or @code{nil} if no change is found. The functions @code{next-single-property-change} and @code{previous-single-property-change} are similar except that you specify a particular property and they look for changes in the value of that property only. The property is the second argument, and @var{object} is third. @subsection Special Properties If a character has a @code{category} property, we call it the @dfn{category} of the character. It should be a symbol. The properties of the symbol serve as defaults for the properties of the character. You can use the property @code{face} to control the font and color of text. You can specify a different keymap for a portion of the text by means of a @code{local-map} property. The property's value, for the character after point, replaces the buffer's local map. If a character has the property @code{read-only}, then modifying that character is not allowed. Any command that would do so gets an error. If a character has the property @code{modification-hooks}, then its value should be a list of functions; modifying that character calls all of those functions. Each function receives two arguments: the beginning and end of the part of the buffer being modified. Note that if a particular modification hook function appears on several characters being modified by a single primitive, you can't predict how many times the function will be called. Insertion of text does not, strictly speaking, change any existing character, so there is a special rule for insertion. It compares the @code{read-only} properties of the two surrounding characters; if they are @code{eq}, then the insertion is not allowed. Assuming insertion is allowed, it then gets the @code{modification-hooks} properties of those characters and calls all the functions in each of them. (If a function appears on both characters, it may be called once or twice.) The special properties @code{point-entered} and @code{point-left} record hook functions that report motion of point. Each time point moves, Emacs compares these two property values: @itemize @bullet @item the @code{point-left} property of the character after the old location, and @item the @code{point-entered} property of the character after the new location. @end itemize @noindent If these two values differ, each of them is called (if not @code{nil}) with two arguments: the old value of point, and the new one. The same comparison is made for the characters before the old and new locations. The result may be to execute two @code{point-left} functions (which may be the same function) and/or two @code{point-entered} functions (which may be the same function). The @code{point-left} functions are always called before the @code{point-entered} functions. A primitive function may examine characters at various positions without moving point to those positions. Only an actual change in the value of point runs these hook functions. @section New Features for Files @itemize @bullet @item The new function @code{file-accessible-directory-p} tells you whether you can open files in a particular directory. Specify as an argument either a directory name or a file name which names a directory file. The function returns @code{t} if you can open existing files in that directory. @item The new function @code{file-executable-p} returns @code{t} if its argument is the name of a file you have permission to execute. @item The function @code{file-truename} returns the ``true name'' of a specified file. This is the name that you get by following symbolic links until none remain. The argument must be an absolute file name. @item New functions @code{make-directory} and @code{delete-directory} create and delete directories. They both take one argument, which is the name of the directory as a file. @item The function @code{read-file-name} now takes an additional argument which specifies an initial file name. If you specify this argument, @code{read-file-name} inserts it along with the directory name. It puts the cursor between the directory and the initial file name. The user can then use the initial file name unchanged, modify it, or simply kill it with @kbd{C-k}. If the variable @code{insert-default-directory} is @code{nil}, then the default directory is not inserted, and the new argument is ignored. @item The function @code{file-relative-name} does the inverse of expansion---it tries to return a relative name which is equivalent to @var{filename} when interpreted relative to @var{directory}. (If such a relative name would be longer than the absolute name, it returns the absolute name instead.) @item The function @code{file-newest-backup} returns the name of the most recent backup file for @var{filename}, or @code{nil} that file has no backup files. @item The list returned by @code{file-attributes} now has 12 elements. The 12th element is the file system number of the file system that the file is in. This element together with the file's inode number, which is the 11th element, give enough information to distinguish any two files on the system---no two files can have the same values for both of these numbers. @item The new function @code{set-visited-file-modtime} updates the current buffer's recorded modification time from the visited file's time. This is useful if the buffer was not read from the file normally, or if the file itself has been changed for some known benign reason. If you give the function an argument, that argument specifies the new value for the recorded modification time. The argument should be a list of the form @code{(@var{high} . @var{low})} or @code{(@var{high} @var{low})} containing two integers, each of which holds 16 bits of the time. (This is the same format that @code{file-attributes} uses to return time values.) The new function @code{visited-file-modtime} returns the recorded last modification time, in that same format. @item The function @code{directory-files} now takes an optional fourth argument which, if non-@code{nil}, inhibits sorting the file names. Use this if you want the utmost possible speed and don't care what order the files are processed in. If the order of processing is at all visible to the user, then the user will probably be happier if you do sort the names. @item The variable @code{directory-abbrev-alist} contains an alist of abbreviations to use for file directories. Each element has the form @code{(@var{from} . @var{to})}, and says to replace @var{from} with @var{to} when it appears in a directory name. This replacement is done when setting up the default directory of a newly visited file. The @var{from} string is actually a regular expression; it should always start with @samp{^}. You can set this variable in @file{site-init.el} to describe the abbreviations appropriate for your site. @item The function @code{abbreviate-file-name} applies abbreviations from @code{directory-abbrev-alist} to its argument, and substitutes @samp{~} for the user's home directory. Abbreviated directory names are useful for directories that are normally accessed through symbolic links. If you think of the link's name as ``the name'' of the directory, you can define it as an abbreviation for the directory's official name; then ordinarily Emacs will call that directory by the link name you normally use. @item @code{write-region} can write a given string instead of text from the buffer. Use the string as the first argument (in place of the starting character position). You can supply a second file name as the fifth argument (@var{visit}). Use this to write the data to one file (the first argument, @var{filename}) while nominally visiting a different file (the fifth argument, @var{visit}). The argument @var{visit} is used in the echo area message and also for file locking; @var{visit} is stored in @code{buffer-file-name}. @item The value of @code{write-file-hooks} does not change when you switch to a new major mode. The intention is that these hooks have to do with where the file came from, and not with what it contains. @item There is a new hook variable for saving files: @code{write-contents-hooks}. It works just like @code{write-file-hooks} except that switching to a new major mode clears it back to @code{nil}. Major modes should use this hook variable rather than @code{write-file-hooks}. @item The hook @code{after-save-buffer-hook} runs just after a buffer has been saved in its visited file. @item The new function @code{set-default-file-modes} sets the file protection for new files created with Emacs. The argument must be an integer. (It would be better to permit symbolic arguments like the @code{chmod} program, but that would take more work than this function merits.) Use the new function @code{default-file-modes} to read the current default file mode. @item Call the new function @code{unix-sync} to force all pending disk output to happen as soon as possible. @end itemize @section Making Certain File Names ``Magic'' You can implement special handling for a class of file names. You must supply a regular expression to define the class of names (all those which match the regular expression), plus a handler that implements all the primitive Emacs file operations for file names that do match. The value of @code{file-name-handler-alist} is a list of handlers, together with regular expressions that decide when to apply each handler. Each element has the form @code{(@var{regexp} . @var{handler})}. If a file name matches @var{regexp}, then all work on that file is done by calling @var{handler}. All the Emacs primitives for file access and file name transformation check the given file name against @code{file-name-handler-alist}, and call @var{handler} to do the work if appropriate. The first argument given to @var{handler} is the name of the primitive; the remaining arguments are the arguments that were passed to that primitive. (The first of these arguments is typically the file name itself.) For example, if you do this: @example (file-exists-p @var{filename}) @end example @noindent and @var{filename} has handler @var{handler}, then @var{handler} is called like this: @example (funcall @var{handler} 'file-exists-p @var{filename}) @end example Here are the primitives that you can handle in this way: @quotation @code{add-name-to-file}, @code{copy-file}, @code{delete-directory}, @code{delete-file}, @code{directory-file-name}, @code{directory-files}, @code{dired-compress-file}, @code{dired-uncache}, @code{expand-file-name}, @code{file-accessible-directory-p}, @code{file-attributes}, @code{file-directory-p}, @code{file-executable-p}, @code{file-exists-p}, @code{file-local-copy}, @code{file-modes}, @code{file-name-all-completions}, @code{file-name-as-directory}, @code{file-name-completion}, @code{file-name-directory}, @code{file-name-nondirectory}, @code{file-name-sans-versions}, @code{file-newer-than-file-p}, @code{file-readable-p}, @code{file-symlink-p}, @code{file-writable-p}, @code{insert-directory}, @code{insert-file-contents}, @code{load}, @code{make-directory}, @code{make-symbolic-link}, @code{rename-file}, @code{set-file-modes}, @code{set-visited-file-modtime}, @code{unhandled-file-name-directory}, @code{verify-visited-file-modtime}, @code{write-region}. @end quotation The handler function must handle all of the above operations, and possibly others to be added in the future. Therefore, it should always reinvoke the ordinary Lisp primitive when it receives an operation it does not recognize. Here's one way to do this: @smallexample (defun my-file-handler (operation &rest args) ;; @r{First check for the specific operations} ;; @r{that we have special handling for.} (cond ((eq operation 'insert-file-contents) @dots{}) ((eq operation 'write-region) @dots{}) @dots{} ;; @r{Handle any operation we don't know about.} (t (let (file-name-handler-alist) (apply operation args))))) @end smallexample The function @code{file-local-copy} copies file @var{filename} to the local site, if it isn't there already. If @var{filename} specifies a ``magic'' file name which programs outside Emacs cannot directly read or write, this copies the contents to an ordinary file and returns that file's name. If @var{filename} is an ordinary file name, not magic, then this function does nothing and returns @code{nil}. The function @code{unhandled-file-name-directory} is used to get a non-magic directory name from an arbitrary file name. It uses the directory part of the specified file name if that is not magic. Otherwise, it asks the file name's handler what to do. @section Frames @cindex frame Emacs now supports multiple X windows via a new data type known as a @dfn{frame}. A frame is a rectangle on the screen that contains one or more Emacs windows. Subdividing a frame works just like subdividing the screen in earlier versions of Emacs. @cindex terminal frame There are two kinds of frames: terminal frames and X window frames. Emacs creates one terminal frame when it starts up with no X display; it uses Termcap or Terminfo to display using characters. There is no way to create another terminal frame after startup. If Emacs has an X display, it does not make a terminal frame, and there is none. @cindex X window frame When you are using X windows, Emacs starts out with a single X window frame. You can create any number of X window frames using @code{make-frame}. Use the predicate @code{framep} to determine whether a given Lisp object is a frame. The function @code{redraw-frame} redisplays the entire contents of a given frame. @subsection Creating and Deleting Frames Use @code{make-frame} to create a new frame. This is the only primitive for creating frames. In principle it could work under any window system which Emacs understands; the only one we support is X. @code{make-frame} takes just one argument, which is an alist specifying frame parameters. Any parameters not mentioned in the argument alist default based on the value of @code{default-frame-alist}; parameters not specified there default from the standard X defaults file and X resources. When you invoke Emacs, if you specify arguments for window appearance and so forth, these go into @code{default-frame-alist} and that is how they have their effect. You can specify the parameters for the initial startup X window frame by setting @code{initial-frame-alist} in your @file{.emacs} file. If these parameters specify a separate minibuffer-only frame, and you have not created one, Emacs creates one for you, using the parameter values specified in @code{minibuffer-frame-alist}. You can specify the size and position of a frame using the frame parameters @code{left}, @code{top}, @code{height} and @code{width}. You must specify either both size parameters or neither. You must specify either both position parameters or neither. The geometry parameters that you don't specify are chosen by the window manager in its usual fashion. The function @code{x-parse-geometry} converts a standard X-style geometry string to an alist which you can use as part of the argument to @code{make-frame}. Use the function @code{delete-frame} to eliminate a frame. Frames are like buffers where deletion is concerned; a frame actually continues to exist as a Lisp object until it is deleted @emph{and} there are no references to it, but once it is deleted, it has no further effect on the screen. The function @code{frame-live-p} returns non-@code{nil} if the argument (a frame) has not been deleted. @subsection Finding All Frames The function @code{frame-list} returns a list of all the frames that have not been deleted. It is analogous to @code{buffer-list}. The list that you get is newly created, so modifying the list doesn't have any effect on the internals of Emacs. The function @code{visible-frame-list} returns the list of just the frames that are visible. @code{next-frame} lets you cycle conveniently through all the frames from an arbitrary starting point. Its first argument is a frame. Its second argument @var{minibuf} says what to do about minibuffers: @table @asis @item @code{nil} Exclude minibuffer-only frames. @item a window Consider only the frames using that particular window as their minibuffer. @item anything else Consider all frames. @end table @subsection Frames and Windows All the non-minibuffer windows in a frame are arranged in a tree of subdivisions; the root of this tree is available via the function @code{frame-root-window}. Each window is part of one and only one frame; you can get the frame with @code{window-frame}. At any time, exactly one window on any frame is @dfn{selected within the frame}. You can get the frame's current selected window with @code{frame-selected-window}. The significance of this designation is that selecting the frame selects for Emacs as a whole the window currently selected within that frame. Conversely, selecting a window for Emacs with @code{select-window} also makes that window selected within its frame. @subsection Frame Visibility A frame may be @dfn{visible}, @dfn{invisible}, or @dfn{iconified}. If it is invisible, it doesn't show in the screen, not even as an icon. You can set the visibility status of a frame with @code{make-frame-visible}, @code{make-frame-invisible}, and @code{iconify-frame}. You can examine the visibility status with @code{frame-visible-p}---it returns @code{t} for a visible frame, @code{nil} for an invisible frame, and @code{icon} for an iconified frame. @subsection Selected Frame At any time, one frame in Emacs is the @dfn{selected frame}. The selected window always resides on the selected frame. @defun selected-frame This function returns the selected frame. @end defun The X server normally directs keyboard input to the X window that the mouse is in. Some window managers use mouse clicks or keyboard events to @dfn{shift the focus} to various X windows, overriding the normal behavior of the server. Lisp programs can switch frames ``temporarily'' by calling the function @code{select-frame}. This does not override the window manager; rather, it escapes from the window manager's control until that control is somehow reasserted. The function takes one argument, a frame, and selects that frame. The selection lasts until the next time the user does something to select a different frame, or until the next time this function is called. Emacs cooperates with the X server and the window managers by arranging to select frames according to what the server and window manager ask for. It does so by generating a special kind of input event, called a @dfn{focus} event. The command loop handles a focus event by calling @code{internal-select-frame}. @subsection Frame Size and Position The new functions @code{frame-height} and @code{frame-width} return the height and width of a specified frame (or of the selected frame), measured in characters. The new functions @code{frame-pixel-height} and @code{frame-pixel-width} return the height and width of a specified frame (or of the selected frame), measured in pixels. The new functions @code{frame-char-height} and @code{frame-char-width} return the height and width of a character in a specified frame (or in the selected frame), measured in pixels. @code{set-frame-size} sets the size of a frame, measured in characters; its arguments are @var{frame}, @var{cols} and @var{rows}. To set the size with values measured in pixels, you can use @code{modify-frame-parameters}. The function @code{set-frame-position} sets the position of the top left corner of a frame. Its arguments are @var{frame}, @var{left} and @var{top}. @ignore New functions @code{set-frame-height} and @code{set-frame-width} set the size of a specified frame. The frame is the first argument; the size is the second. @end ignore @subsection Frame Parameters A frame has many parameters that affect how it displays. Use the function @code{frame-parameters} to get an alist of all the parameters of a given frame. To alter parameters, use @code{modify-frame-parameters}, which takes two arguments: the frame to modify, and an alist of parameters to change and their new values. Each element of @var{alist} has the form @code{(@var{parm} . @var{value})}, where @var{parm} is a symbol. Parameters that aren't meaningful are ignored. If you don't mention a parameter in @var{alist}, its value doesn't change. Just what parameters a frame has depends on what display mechanism it uses. Here is a table of the parameters of an X window frame: @table @code @item name The name of the frame. @item left The screen position of the left edge. @item top The screen position of the top edge. @item height The height of the frame contents, in pixels. @item width The width of the frame contents, in pixels. @item window-id The number of the X window for the frame. @item minibuffer Whether this frame has its own minibuffer. @code{t} means yes, @code{none} means no, @code{only} means this frame is just a minibuffer, a minibuffer window (in some other frame) means the new frame uses that minibuffer. @item font The name of the font for the text. @item foreground-color The color to use for the inside of a character. Use strings to designate colors; the X server defines the meaningful color names. @item background-color The color to use for the background of text. @item mouse-color The color for the mouse cursor. @item cursor-color The color for the cursor that shows point. @item border-color The color for the border of the frame. @item cursor-type The way to display the cursor. There are two legitimate values: @code{bar} and @code{box}. The value @code{bar} specifies a vertical bar between characters as the cursor. The value @code{box} specifies an ordinary black box overlaying the character after point; that is the default. @item icon-type Non-@code{nil} for a bitmap icon, @code{nil} for a text icon. @item border-width The width in pixels of the window border. @item internal-border-width The distance in pixels between text and border. @item auto-raise Non-@code{nil} means selecting the frame raises it. @item auto-lower Non-@code{nil} means deselecting the frame lowers it. @item vertical-scroll-bars Non-@code{nil} gives the frame a scroll bar for vertical scrolling. @ignore @item horizontal-scroll-bars Non-@code{nil} gives the frame a scroll bar for horizontal scrolling. @end ignore @end table @subsection Minibufferless Frames Normally, each frame has its own minibuffer window at the bottom, which is used whenever that frame is selected. However, you can also create frames with no minibuffers. These frames must use the minibuffer window of some other frame. The variable @code{default-minibuffer-frame} specifies where to find a minibuffer for frames created without minibuffers of their own. Its value should be a frame which does have a minibuffer. You can also specify a minibuffer window explicitly when you create a frame; then @code{default-minibuffer-frame} is not used. @section X Window System Features @itemize @bullet @item The new functions @code{mouse-position} and @code{set-mouse-position} give access to the current position of the mouse. @code{mouse-position} returns a description of the position of the mouse. The value looks like @code{(@var{frame} @var{x} . @var{y})}, where @var{x} and @var{y} are measured in pixels relative to the top left corner of the inside of @var{frame}. @code{set-mouse-position} takes three arguments, @var{frame}, @var{x} and @var{y}, and warps the mouse cursor to that location on the screen. @item @code{track-mouse} is a new special form for tracking mouse motion. Use it in definitions of mouse clicks that want pay to attention to the motion of the mouse, not just where the buttons are pressed and released. Here is how to use it: @example (track-mouse @var{body}@dots{}) @end example While @var{body} executes, mouse motion generates input events just as mouse clicks do. @var{body} can read them with @code{read-event} or @code{read-key-sequence}. @code{track-mouse} returns the value of the last form in @var{body}. The format of these events is described under ``New Input Event Formats.'' @item @code{x-set-selection} sets a ``selection'' in the X server. It takes two arguments: a selection type @var{type}, and the value to assign to it, @var{data}. If @var{data} is @code{nil}, it means to clear out the selection. Otherwise, @var{data} may be a string, a symbol, an integer (or a cons of two integers or list of two integers), or a cons of two markers pointing to the same buffer. In the last case, the selection is considered to be the text between the markers. The data may also be a vector of valid non-vector selection values. Each possible @var{type} has its own selection value, which changes independently. The usual values of @var{type} are @code{PRIMARY} and @code{SECONDARY}; these are symbols with upper-case names, in accord with X protocol conventions. The default is @code{PRIMARY}. To get the value of the selection, call @code{x-get-selection}. This function accesses selections set up by Emacs and those set up by other X clients. It takes two optional arguments, @var{type} and @var{data-type}. The default for @var{type} is @code{PRIMARY}. The @var{data-type} argument specifies the form of data conversion to use; meaningful values include @code{TEXT}, @code{STRING}, @code{TARGETS}, @code{LENGTH}, @code{DELETE}, @code{FILE_NAME}, @code{CHARACTER_POSITION}, @code{LINE_NUMBER}, @code{COLUMN_NUMBER}, @code{OWNER_OS}, @code{HOST_NAME}, @code{USER}, @code{CLASS}, @code{NAME}, @code{ATOM}, and @code{INTEGER}. (These are symbols with upper-case names in accord with X Windows conventions.) The default for @var{data-type} is @code{STRING}. @item The X server has a set of numbered @dfn{cut buffers} which can store text or other data being moved between applications. Use @code{x-get-cut-buffer} to get the contents of a cut buffer; specify the cut buffer number as argument. Use @code{x-set-cut-buffer} with argument @var{string} to store a new string into the first cut buffer (moving the other values down through the series of cut buffers, kill-ring-style). Cut buffers are considered obsolete, but Emacs supports them for the sake of X clients that still use them. @item You can close the connection with the X server with the function @code{x-close-current-connection}. This takes no arguments. Then you can connect to a different X server with @code{x-open-connection}. The first argument, @var{display}, is the name of the display to connect to. The optional second argument @var{xrm-string} is a string of resource names and values, in the same format used in the @file{.Xresources} file. The values you specify override the resource values recorded in the X server itself. Here's an example of what this string might look like: @example "*BorderWidth: 3\n*InternalBorder: 2\n" @end example @item A series of new functions give you information about the X server and the screen you are using. @table @code @item x-display-screens The number of screens associated with the current display. @item x-server-version The version numbers of the X server in use. @item x-server-vendor The vendor supporting the X server in use. @item x-display-pixel-height The height of this X screen in pixels. @item x-display-mm-height The height of this X screen in millimeters. @item x-display-pixel-width The width of this X screen in pixels. @item x-display-mm-width The width of this X screen in millimeters. @item x-display-backing-store The backing store capability of this screen. Values can be the symbols @code{always}, @code{when-mapped}, or @code{not-useful}. @item x-display-save-under Non-@code{nil} if this X screen supports the SaveUnder feature. @item x-display-planes The number of planes this display supports. @item x-display-visual-class The visual class for this X screen. The value is one of the symbols @code{static-gray}, @code{gray-scale}, @code{static-color}, @code{pseudo-color}, @code{true-color}, and @code{direct-color}. @item x-display-color-p @code{t} if the X screen in use is a color screen. @item x-display-color-cells The number of color cells this X screen supports. @end table There is also a variable @code{x-no-window-manager}, whose value is @code{t} if no X window manager is in use. @item The function @code{x-synchronize} enables or disables an X Windows debugging mode: synchronous communication. It takes one argument, non-@code{nil} to enable the mode and @code{nil} to disable. In synchronous mode, Emacs waits for a response to each X protocol command before doing anything else. This means that errors are reported right away, and you can directly find the erroneous command. Synchronous mode is not the default because it is much slower. @item The function @code{x-get-resource} retrieves a resource value from the X Windows defaults database. Its three arguments are @var{attribute}, @var{name} and @var{class}. It searches using a key of the form @samp{@var{instance}.@var{attribute}}, with class @samp{Emacs}, where @var{instance} is the name under which Emacs was invoked. The optional arguments @var{component} and @var{subclass} add to the key and the class, respectively. You must specify both of them or neither. If you specify them, the key is @samp{@var{instance}.@var{component}.@var{attribute}}, and the class is @samp{Emacs.@var{subclass}}. @item @code{x-display-color-p} returns @code{t} if you are using an X server with a color display, and @code{nil} otherwise. @c ??? Name being changed from x-defined-color. @code{x-color-defined-p} takes as argument a string describing a color; it returns @code{t} if the display supports that color. (If the color is @code{"black"} or @code{"white"} then even black-and-white displays support it.) @item @code{x-popup-menu} has been generalized. It now accepts a keymap as the @var{menu} argument. Then the menu items are the prompt strings of individual key bindings, and the item values are the keys which have those bindings. You can also supply a list of keymaps as the first argument; then each keymap makes one menu pane (but keymaps that don't provide any menu items don't appear in the menu at all). @code{x-popup-menu} also accepts a mouse button event as the @var{position} argument. Then it displays the menu at the location at which the event took place. This is convenient for mouse-invoked commands that pop up menus. @ignore @item x-pointer-shape, x-nontext-pointer-shape, x-mode-pointer-shape. @end ignore @item You can use the function @code{x-rebind-key} to change the sequence of characters generated by the X server for one of the keyboard keys. The first two arguments, @var{keycode} and @var{shift-mask}, should be numbers representing the keyboard code and shift mask respectively. They specify what key to change. The third argument, @var{newstring}, is the new definition of the key. It is a sequence of characters that the key should produce as input. The shift mask value is a combination of bits according to this table: @table @asis @item 8 Control @item 4 Meta @item 2 Shift @item 1 Shift Lock @end table If you specify @code{nil} for @var{shift-mask}, then the key specified by @var{keycode} is redefined for all possible shift combinations. For the possible values of @var{keycode} and their meanings, see the file @file{/usr/lib/Xkeymap.txt}. Keep in mind that the codes in that file are in octal! @ignore @c Presumably this is already fixed NOTE: due to an X bug, this function will not take effect unless the user has a @file{~/.Xkeymap} file. (See the documentation for the @code{keycomp} program.) This problem will be fixed in X version 11. @end ignore The related function @code{x-rebind-keys} redefines a single keyboard key, specifying the behavior for each of the 16 shift masks independently. The first argument is @var{keycode}, as in @code{x-rebind-key}. The second argument @var{strings} is a list of 16 elements, one for each possible shift mask value; each element says how to redefine the key @var{keycode} with the corresponding shift mask value. If an element is a string, it is the new definition. If an element is @code{nil}, the definition does not change for that shift mask. @item The function @code{x-parse-geometry} parses a string specifying window size and position in the usual X format. It returns an alist describing which parameters were specified, and the values that were given for them. The elements of the alist look like @code{(@var{parameter} . @var{value})}. The possible @var{parameter} values are @code{left}, @code{top}, @code{width}, and @code{height}. @end itemize @section New Window Features @itemize @bullet @item The new function @code{window-at} tells you which window contains a given horizontal and vertical position on a specified frame. Call it with three arguments, like this: @example (window-at @var{x} @var{column} @var{frame}) @end example The function returns the window which contains that cursor position in the frame @var{frame}. If you omit @var{frame}, the selected frame is used. @item The function @code{coordinates-in-window-p} takes two arguments and checks whether a particular frame position falls within a particular window. @example (coordinates-in-window-p @var{coordinates} @var{window}) @end example The argument @var{coordinates} is a cons cell of this form: @example (@var{x} . @var{y}) @end example @noindent The two coordinates are measured in characters, and count from the top left corner of the screen or frame. The value of the function tells you what part of the window the position is in. The possible values are: @table @code @item (@var{relx} . @var{rely}) The coordinates are inside @var{window}. The numbers @var{relx} and @var{rely} are equivalent window-relative coordinates, counting from 0 at the top left corner of the window. @item mode-line The coordinates are in the mode line of @var{window}. @item vertical-split The coordinates are in the vertical line between @var{window} and its neighbor to the right. @item nil The coordinates are not in any sense within @var{window}. @end table You need not specify a frame when you call @code{coordinates-in-window-p}, because it assumes you mean the frame which window @var{window} is on. @item The function @code{minibuffer-window} now accepts a frame as argument and returns the minibuffer window used for that frame. If you don't specify a frame, the currently selected frame is used. The minibuffer window may be on the frame in question, but if that frame has no minibuffer of its own, it uses the minibuffer window of some other frame, and @code{minibuffer-window} returns that window. @item Use @code{window-live-p} to test whether a window is still alive (that is, not deleted). @item Use @code{window-minibuffer-p} to determine whether a given window is a minibuffer or not. It no longer works to do this by comparing the window with the result of @code{(minibuffer-window)}, because there can be more than one minibuffer window at a time (if you have multiple frames). @item If you set the variable @code{pop-up-frames} non-@code{nil}, then the functions to show something ``in another window'' actually create a new frame for the new window. Thus, you will tend to have a frame for each window, and you can easily have a frame for each buffer. The value of the variable @code{pop-up-frame-function} controls how new frames are made. The value should be a function which takes no arguments and returns a frame. The default value is a function which creates a frame using parameters from @code{pop-up-frame-alist}. @item @code{display-buffer} is the basic primitive for finding a way to show a buffer on the screen. You can customize its behavior by storing a function in the variable @code{display-buffer-function}. If this variable is non-@code{nil}, then @code{display-buffer} calls it to do the work. Your function should accept two arguments, as follows: @table @var @item buffer The buffer to be displayed. @item flag A flag which, if non-@code{nil}, means you should find another window to display @var{buffer} in, even if it is already visible in the selected window. @end table The function you supply will be used by commands such as @code{switch-to-buffer-other-window} and @code{find-file-other-window} as well as for your own calls to @code{display-buffer}. @item @code{delete-window} now gives all of the deleted window's screen space to a single neighboring window. Likewise, @code{enlarge-window} takes space from only one neighboring window until that window disappears; only then does it take from another window. @item @code{next-window} and @code{previous-window} accept another argument, @var{all-frames}. These functions now take three optional arguments: @var{window}, @var{minibuf} and @var{all-frames}. @var{window} is the window to start from (@code{nil} means use the selected window). @var{minibuf} says whether to include the minibuffer in the windows to cycle through: @code{t} means yes, @code{nil} means yes if it is active, and anything else means no. Normally, these functions cycle through all the windows in the selected frame, plus the minibuffer used by the selected frame even if it lies in some other frame. If @var{all-frames} is @code{t}, then these functions cycle through all the windows in all the frames that currently exist. If @var{all-frames} is neither @code{t} nor @code{nil}, then they limit themselves strictly to the windows in the selected frame, excluding the minibuffer in use if it lies in some other frame. @item The functions @code{get-lru-window} and @code{get-largest-window} now take an optional argument @var{all-frames}. If it is non-@code{nil}, the functions consider all windows on all frames. Otherwise, they consider just the windows on the selected frame. Likewise, @code{get-buffer-window} takes an optional second argument @var{all-frames}. @item The variable @code{other-window-scroll-buffer} specifies which buffer @code{scroll-other-window} should scroll. @item You can now mark a window as ``dedicated'' to its buffer. Then Emacs will not try to use that window for any other buffer unless you explicitly request it. Use the new function @code{set-window-dedicated-p} to set the dedication flag of a window @var{window} to the value @var{flag}. If @var{flag} is @code{t}, this makes the window dedicated. If @var{flag} is @code{nil}, this makes the window non-dedicated. Use @code{window-dedicated-p} to examine the dedication flag of a specified window. @item The new function @code{walk-windows} cycles through all visible windows, calling @code{proc} once for each window with the window as its sole argument. The optional second argument @var{minibuf} says whether to include minibuffer windows. A value of @code{t} means count the minibuffer window even if not active. A value of @code{nil} means count it only if active. Any other value means not to count the minibuffer even if it is active. If the optional third argument @var{all-frames} is @code{t}, that means include all windows in all frames. If @var{all-frames} is @code{nil}, it means to cycle within the selected frame, but include the minibuffer window (if @var{minibuf} says so) that that frame uses, even if it is on another frame. If @var{all-frames} is neither @code{nil} nor @code{t}, @code{walk-windows} sticks strictly to the selected frame. @item The function @code{window-end} is a counterpart to @code{window-start}: it returns the buffer position of the end of the display in a given window (or the selected window). @item The function @code{window-configuration-p} returns non-@code{nil} when given an object that is a window configuration (such as is returned by @code{current-window-configuration}). @end itemize @section Display Features @itemize @bullet @item @code{baud-rate} is now a variable rather than a function. This is so you can set it to reflect the effective speed of your terminal, when the system doesn't accurately know the speed. @item You can now remove any echo area message and make the minibuffer visible. To do this, call @code{message} with @code{nil} as the only argument. This clears any existing message, and lets the current minibuffer contents show through. Previously, there was no reliable way to make sure that the minibuffer contents were visible. @item The variable @code{temp-buffer-show-hook} has been renamed @code{temp-buffer-show-function}, because its value is a single function (of one argument), not a normal hook. @item The new function @code{force-mode-line-update} causes redisplay of the current buffer's mode line. @end itemize @section Display Tables @cindex display table You can use the @dfn{display table} feature to control how all 256 possible character codes display on the screen. This is useful for displaying European languages that have letters not in the ASCII character set. The display table maps each character code into a sequence of @dfn{glyphs}, each glyph being an image that takes up one character position on the screen. You can also define how to display each glyph on your terminal, using the @dfn{glyph table}. @subsection Display Tables Proper Use @code{make-display-table} to create a display table. The table initially has @code{nil} in all elements. A display table is actually an array of 261 elements. The first 256 elements of a display table control how to display each possible text character. The value should be @code{nil} or a vector (which is a sequence of glyphs; see below). @code{nil} as an element means to display that character following the usual display conventions. The remaining five elements of a display table serve special purposes (@code{nil} means use the default stated below): @table @asis @item 256 The glyph for the end of a truncated screen line (the default for this is @samp{\}). @item 257 The glyph for the end of a continued line (the default is @samp{$}). @item 258 The glyph for the indicating an octal character code (the default is @samp{\}). @item 259 The glyph for indicating a control characters (the default is @samp{^}). @item 260 The vector of glyphs for indicating the presence of invisible lines (the default is @samp{...}). @end table Each buffer typically has its own display table. The display table for the current buffer is stored in @code{buffer-display-table}. (This variable automatically becomes local if you set it.) If this variable is @code{nil}, the value of @code{standard-display-table} is used in that buffer. Each window can have its own display table, which overrides the display table of the buffer it is showing. If neither the selected window nor the current buffer has a display table, and if @code{standard-display-table} is @code{nil}, then Emacs uses the usual display conventions: @itemize @bullet @item Character codes 32 through 127 map to glyph codes 32 through 127. @item Codes 0 through 31 map to sequences of two glyphs, where the first glyph is the ASCII code for @samp{^}. @item Character codes 128 through 255 map to sequences of four glyphs, where the first glyph is the ASCII code for @samp{\}, and the others represent digits. @end itemize The usual display conventions are also used for any character whose entry in the active display table is @code{nil}. This means that when you set up a display table, you need not specify explicitly what to do with each character, only the characters for which you want unusual behavior. @subsection Glyphs @cindex glyph A glyph stands for an image that takes up a single character position on the screen. A glyph is represented in Lisp as an integer. @cindex glyph table The meaning of each integer, as a glyph, is defined by the glyph table, which is the value of the variable @code{glyph-table}. It should be a vector; the @var{g}th element defines glyph code @var{g}. The possible definitions of a glyph code are: @table @var @item integer Define this glyph code as an alias for code @var{integer}. This is used with X Windows to specify a face code. @item string Send the characters in @var{string} to the terminal to output this glyph. This alternative is available only for character terminals, not with X. @item @code{nil} This glyph is simple. On an ordinary terminal, the glyph code mod 256 is the character to output. With X, the glyph code mod 256 is character to output, and the glyph code divided by 256 specifies the @dfn{face code} to use while outputting it. @end table Any glyph code beyond the length of the glyph table is automatically simple. If @code{glyph-table} is @code{nil}, then all possible glyph codes are simple. A @dfn{face} is a named combination of a font and a pair of colors (foreground and background). A glyph code can specify a face id number to use for displaying that glyph. @subsection ISO Latin 1 If you have a terminal that can handle the entire ISO Latin 1 character set, you can arrange to use that character set as follows: @example (require 'disp-table) (standard-display-8bit 0 255) @end example If you are editing buffers written in the ISO Latin 1 character set and your terminal doesn't handle anything but ASCII, you can load the file @code{iso-ascii} to set up a display table which makes the other ISO characters display as sequences of ASCII characters. For example, the character ``o with umlaut'' displays as @samp{@{"o@}}. Some European countries have terminals that don't support ISO Latin 1 but do support the special characters for that country's language. You can define a display table to work one language using such terminals. For an example, see @file{lisp/iso-swed.el}, which handles certain Swedish terminals. You can load the appropriate display table for your terminal automatically by writing a terminal-specific Lisp file for the terminal type. @section Overlays @cindex overlays You can use @dfn{overlays} to alter the appearance of a buffer's text on the screen. An overlay is an object which belongs to a particular buffer, and has a specified beginning and end. It also has properties which you can examine and set; these affect the display of the text within the overlay. @subsection Overlay Properties Overlay properties are like text properties in some respects, but the differences are more important than the similarities. Text properties are considered a part of the text; overlays are specifically considered not to be part of the text. Thus, copying text between various buffers and strings preserves text properties, but does not try to preserve overlays. Changing a buffer's text properties marks the buffer as modified, while moving an overlay or changing its properties does not. @table @code @item face @kindex face This property specifies a face for displaying the text within the overlay. @item priority @kindex priority This property's value (which should be a nonnegative number) determines the priority of the overlay. The priority matters when two or more overlays cover the same character and both specify a face for display; the one whose @code{priority} value is larger takes priority over the other, and its face attributes override the face attributes of the lower priority overlay. Currently, all overlays take priority over text properties. Please avoid using negative priority values, as we have not yet decided just what they should mean. @item window @kindex window If the @code{window} property is non-@code{nil}, then the overlay applies only on that window. @end table @subsection Overlay Functions Use the functions @code{overlay-get} and @code{overlay-put} to access and set the properties of an overlay. They take arguments like @code{get} and @code{put}, except that the first argument is an overlay rather than a symbol. To create an overlay, call @code{(make-overlay @var{start} @var{end})}. You can specify the buffer as the third argument if you wish. To delete one, use @code{delete-overlay}. Use @code{overlay-start}, @code{overlay-end} and @code{overlay-buffer} to examine the location and range of an overlay. Use @code{move-overlay} to change them; its arguments are @var{overlay}, @var{start}, @var{end} and (optionally) the buffer. There are two functions to search for overlays: @code{overlays-at} and @code{next-overlay-change}. @code{overlays-at} returns a list of all the overlays containing a particular position. @code{(next-overlay-change @var{pos})} returns the position of the next overlay beginning or end following @var{pos}. @section Faces A @dfn{face} is a named collection of graphical attributes: font, foreground color, background color and optional underlining. Faces control the display of text on the screen. Each face has its own @dfn{face id number} which distinguishes faces at low levels within Emacs. However, for most purposes, you can refer to faces in Lisp programs by their names. Each face name is meaningful for all frames, and by default it has the same meaning in all frames. But you can arrange to give a particular face name a special meaning in one frame if you wish. @subsection Choosing a Face for Display Here are all the ways to specify which face to use for display of text: @itemize @bullet @item With defaults. Each frame has a @dfn{default face}, whose id number is zero, which is used for all text that doesn't somehow specify another face. @item With text properties. A character may have a @code{face} property; if so, it's displayed with that face. If the character has a @code{mouse-face} property, that is used instead of the @code{face} property when the mouse is ``near enough'' to the character. @item With overlays. An overlay may have @code{face} and @code{mouse-face} properties too; they apply to all the text covered by the overlay. @item With special glyphs. Each glyph can specify a particular face id number. @end itemize If these various sources together specify more than one face for a particular character, Emacs merges the attributes of the various faces specified. The attributes of the faces of special glyphs come first; then come attributes of faces from overlays, followed by those from text properties, and last the default face. When multiple overlays cover one character, an overlay with higher priority overrides those with lower priority. If an attribute such as the font or a color is not specified in any of the above ways, the frame's own font or color is used. @xref{Face Functions,, Face Functions, elisp, The Emacs Lisp Reference Manual}, for functions to create and change faces. @section New Input Event Formats Mouse clicks, mouse movements and function keys no longer appear in the input stream as characters; instead, other kinds of Lisp objects represent them as input. @itemize @bullet @item An ordinary input character event consists of a @dfn{basic code} between 0 and 255, plus any or all of these @dfn{modifier bits}: @table @asis @item meta The 2**23 bit in the character code indicates a character typed with the meta key held down. @item control The 2**22 bit in the character code indicates a non-@sc{ASCII} control character. @sc{ASCII} control characters such as @kbd{C-a} have special basic codes of their own, so Emacs needs no special bit to indicate them. Thus, the code for @kbd{C-a} is just 1. But if you type a control combination not in @sc{ASCII}, such as @kbd{%} with the control key, the numeric value you get is the code for @kbd{%} plus 2**22 (assuming the terminal supports non-@sc{ASCII} control characters). @item shift The 2**21 bit in the character code indicates an @sc{ASCII} control character typed with the shift key held down. For letters, the basic code indicates upper versus lower case; for digits and punctuation, the shift key selects an entirely different character with a different basic code. In order to keep within the @sc{ASCII} character set whenever possible, Emacs avoids using the 2**21 bit for those characters. However, @sc{ASCII} provides no way to distinguish @kbd{C-A} from @kbd{C-a}, so Emacs uses the 2**21 bit in @kbd{C-A} and not in @kbd{C-a}. @item hyper The 2**20 bit in the character code indicates a character typed with the hyper key held down. @item super The 2**19 bit in the character code indicates a character typed with the super key held down. @item alt The 2**18 bit in the character code indicates a character typed with the alt key held down. (On some terminals, the key labeled @key{ALT} is actually the meta key.) @end table In the future, Emacs may support a larger range of basic codes. We may also move the modifier bits to larger bit numbers. Therefore, you should avoid mentioning specific bit numbers in your program. Instead, the way to test the modifier bits of a character is with the function @code{event-modifiers} (see below). @item Function keys are represented as symbols. The symbol's name is the function key's label. For example, pressing a key labeled @key{F1} places the symbol @code{f1} in the input stream. There are a few exceptions to the symbol naming convention: @table @asis @item @code{kp-add}, @code{kp-decimal}, @code{kp-divide}, @dots{} Keypad keys (to the right of the regular keyboard). @item @code{kp-0}, @code{kp-1}, @dots{} Keypad keys with digits. @item @code{kp-f1}, @code{kp-f2}, @code{kp-f3}, @code{kp-f4} Keypad PF keys. @item @code{left}, @code{up}, @code{right}, @code{down} Cursor arrow keys @end table You can use the modifier keys @key{CTRL}, @key{META}, @key{HYPER}, @key{SUPER}, @key{ALT} and @key{SHIFT} with function keys. The way to represent them is with prefixes in the symbol name: @table @samp @item A- The alt modifier. @item C- The control modifier. @item H- The hyper modifier. @item M- The meta modifier. @item s- The super modifier. @item S- The shift modifier. @end table Thus, the symbol for the key @key{F3} with @key{META} held down is @kbd{M-@key{F3}}. When you use more than one prefix, we recommend you write them in alphabetical order (though the order does not matter in arguments to the key-binding lookup and modification functions). @item Mouse events are represented as lists. If you press a mouse button and release it at the same location, this generates a ``click'' event. Mouse click events have this form: @example (@var{button-symbol} (@var{window} (@var{column} . @var{row}) @var{buffer-pos} @var{timestamp})) @end example Here is what the elements normally mean: @table @var @item button-symbol indicates which mouse button was used. It is one of the symbols @code{mouse-1}, @code{mouse-2}, @dots{}, where the buttons are normally numbered left to right. You can also use prefixes @samp{A-}, @samp{C-}, @samp{H-}, @samp{M-}, @samp{S-} and @samp{s-} for modifiers alt, control, hyper, meta, shift and super, just as you would with function keys. @item window is the window in which the click occurred. @item column @itemx row are the column and row of the click, relative to the top left corner of @var{window}, which is @code{(0 . 0)}. @item buffer-pos is the buffer position of the character clicked on. @item timestamp is the time at which the event occurred, in milliseconds. (Since this value wraps around the entire range of Emacs Lisp integers in about five hours, it is useful only for relating the times of nearby events.) @end table The meanings of @var{buffer-pos}, @var{row} and @var{column} are somewhat different when the event location is in a special part of the screen, such as the mode line or a scroll bar. If the position is in the window's scroll bar, then @var{buffer-pos} is the symbol @code{vertical-scroll-bar}, and the pair @code{(@var{column} . @var{row})} is replaced with a pair @code{(@var{portion} . @var{whole})}, where @var{portion} is the distance of the click from the top or left end of the scroll bar, and @var{whole} is the length of the entire scroll bar. If the position is on a mode line or the vertical line separating @var{window} from its neighbor to the right, then @var{buffer-pos} is the symbol @code{mode-line} or @code{vertical-line}. In this case @var{row} and @var{column} do not have meaningful data. @item Releasing a mouse button above a different character position generates a ``drag'' event, which looks like this: @example (@var{button-symbol} (@var{window1} (@var{column1} . @var{row1}) @var{buffer-pos1} @var{timestamp1}) (@var{window2} (@var{column2} . @var{row2}) @var{buffer-pos2} @var{timestamp2})) @end example The name of @var{button-symbol} contains the prefix @samp{drag-}. The second and third elements of the event give the starting and ending position of the drag. The @samp{drag-} prefix follows the modifier key prefixes such as @samp{C-} and @samp{M-}. If @code{read-key-sequence} receives a drag event which has no key binding, and the corresponding click event does have a binding, it changes the drag event into a click event at the drag's starting position. This means that you don't have to distinguish between click and drag events unless you want to. @item Click and drag events happen when you release a mouse button. Another kind of event happens when you press a button. It looks just like a click event, except that the name of @var{button-symbol} contains the prefix @samp{down-}. The @samp{down-} prefix follows the modifier key prefixes such as @samp{C-} and @samp{M-}. The function @code{read-key-sequence}, and the Emacs command loop, ignore any down events that don't have command bindings. This means that you need not worry about defining down events unless you want them to do something. The usual reason to define a down event is so that you can track mouse motion until the button is released. @item For example, if the user presses and releases the left mouse button over the same location, Emacs generates a sequence of events like this: @smallexample (down-mouse-1 (# 2613 (0 . 38) -864320)) (mouse-1 (# 2613 (0 . 38) -864180)) @end smallexample Or, while holding the control key down, the user might hold down the second mouse button, and drag the mouse from one line to the next. That produces two events, as shown here: @smallexample (C-down-mouse-2 (# 3440 (0 . 27) -731219)) (C-drag-mouse-2 (# 3440 (0 . 27) -731219) (# 3510 (0 . 28) -729648)) @end smallexample Or, while holding down the meta and shift keys, the user might press the second mouse button on the window's mode line, and then drag the mouse into another window. That produces an event like this: @smallexample (M-S-down-mouse-2 (# mode-line (33 . 31) -457844)) (M-S-drag-mouse-2 (# mode-line (33 . 31) -457844) (# 161 (33 . 3) -453816)) @end smallexample @item A key sequence that starts with a mouse click is read using the keymaps of the buffer in the window clicked on, not the current buffer. This does not imply that clicking in a window selects that window or its buffer. The execution of the command begins with no change in the selected window or current buffer. However, the command can switch windows or buffers if programmed to do so. @item Mouse motion events are represented by lists. During the execution of the body of a @code{track-mouse} form, moving the mouse generates events that look like this: @example (mouse-movement (@var{window} (@var{column} . @var{row}) @var{buffer-pos} @var{timestamp})) @end example The second element of the list describes the current position of the mouse, just as in a mouse click event. Outside of @code{track-mouse} forms, Emacs does not generate events for mere motion of the mouse, and these events do not appear. @item Focus shifts between frames are represented by lists. When the mouse shifts temporary input focus from one frame to another, Emacs generates an event like this: @example (switch-frame @var{new-frame}) @end example @noindent where @var{new-frame} is the frame switched to. In X windows, most window managers are set up so that just moving the mouse into a window is enough to set the focus there. As far as the user is concerned, Emacs behaves consistently with this. However, there is no need for the Lisp program to know about the focus change until some other kind of input arrives. So Emacs generates the focus event only when the user actually types a keyboard key or presses a mouse button in the new frame; just moving the mouse between frames does not generate a focus event. The global key map usually binds this event to the @code{internal-select-frame} function, so that characters typed at a frame apply to that frame's selected window. If the user switches frames in the middle of a key sequence, then Emacs delays the @code{switch-frame} event until the key sequence is over. For example, suppose @kbd{C-c C-a} is a key sequence in the current buffer's keymaps. If the user types @kbd{C-c}, moves the mouse to another frame, and then types @kbd{C-a}, @code{read-key-sequence} returns the sequence @code{"\C-c\C-a"}, and the next call to @code{read-event} or @code{read-key-sequence} will return the @code{switch-frame} event. @end itemize @section Working with Input Events @itemize @bullet @item Functions which work with key sequences now handle non-character events. Functions like @code{define-key}, @code{global-set-key}, and @code{local-set-key} used to accept strings representing key sequences; now, since events may be arbitrary lisp objects, they also accept vectors. The function @code{read-key-sequence} may return a string or a vector, depending on whether or not the sequence read contains only characters. List events may be represented by the symbols at their head; to bind clicks of the left mouse button, you need only present the symbol @code{mouse-1}, not an entire mouse click event. If you do put an event which is a list in a key sequence, only the event's head symbol is used in key lookups. For example, to globally bind the left mouse button to the function @code{mouse-set-point}, you could evaluate this: @example (global-set-key [mouse-1] 'mouse-set-point) @end example To bind the sequence @kbd{C-c @key{F1}} to the command @code{tex-view} in @code{tex-mode-map}, you could evaluate this: @example (define-key tex-mode-map [?\C-c f1] 'tex-view) @end example To find the binding for the function key labeled @key{NEXT} in @code{minibuffer-local-map}, you could evaluate this: @example (lookup-key minibuffer-local-map [next]) @result{} next-history-element @end example If you call the function @code{read-key-sequence} and then press @kbd{C-x C-@key{F5}}, here is how it behaves: @example (read-key-sequence "Press `C-x C-F5': ") @result{} [24 C-f5] @end example Note that @samp{24} is the character @kbd{C-x}. @item The documentation functions (@code{single-key-description}, @code{key-description}, etc.) now handle the new event types. Wherever a string of keyboard input characters was acceptable in previous versions of Emacs, a vector of events should now work. @item Special parts of a window can have their own bindings for mouse events. When mouse events occur in special parts of a window, such as a mode line or a scroll bar, the event itself shows nothing special---only the symbol that would normally represent that mouse button and modifier keys. The information about the screen region is kept in other parts of the event list. But @code{read-key-sequence} translates this information into imaginary prefix keys, all of which are symbols: @code{mode-line}, @code{vertical-line}, and @code{vertical-scroll-bar}. For example, if you call @code{read-key-sequence} and then click the mouse on the window's mode line, this is what happens: @smallexample (read-key-sequence "Click on the mode line: ") @result{} [mode-line (mouse-1 (# mode-line (40 . 63) 5959987))] @end smallexample You can define meanings for mouse clicks in special window regions by defining key sequences using these imaginary prefix keys. For example, here is how to bind the third mouse button on a window's mode line delete the window: @example (global-set-key [mode-line mouse-3] 'mouse-delete-window) @end example Here's how to bind the middle button (modified by @key{META}) on the vertical line at the right of a window to scroll the window to the left. @example (global-set-key [vertical-line M-mouse-2] 'scroll-left) @end example @item Decomposing an event symbol. Each symbol used to identify a function key or mouse button has a property named @code{event-symbol-elements}, which is a list containing an unmodified version of the symbol, followed by modifiers the symbol name contains. The modifiers are symbols; they include @code{shift}, @code{control}, and @code{meta}. In addition, a mouse event symbol has one of @code{click}, @code{drag}, and @code{down}. For example: @example (get 'f5 'event-symbol-elements) @result{} (f5) (get 'C-f5 'event-symbol-elements) @result{} (f5 control) (get 'M-S-f5 'event-symbol-elements) @result{} (f5 meta shift) (get 'mouse-1 'event-symbol-elements) @result{} (mouse-1 click) (get 'down-mouse-1 'event-symbol-elements) @result{} (mouse-1 down) @end example Note that the @code{event-symbol-elements} property for a mouse click explicitly contains @code{click}, but the event symbol name itself does not contain @samp{click}. @item Use @code{read-event} to read input if you want to accept any kind of event. The old function @code{read-char} now discards events other than keyboard characters. @item @code{last-command-char} and @code{last-input-char} can now hold any kind of event. @item The new variable @code{unread-command-events} is much like @code{unread-command-char}. Its value is a list of events of any type, to be processed as command input in order of appearance in the list. @item The function @code{this-command-keys} may return a string or a vector, depending on whether or not the sequence read contains only characters. You may need to upgrade code which uses this function. The function @code{recent-keys} now returns a vector of events. You may need to upgrade code which uses this function. @item A keyboard macro's definition can now be either a string or a vector. All that really matters is what elements it has. If the elements are all characters, then the macro can be a string; otherwise, it has to be a vector. @item The variable @code{last-event-frame} records which frame the last input event was directed to. Usually this is the frame that was selected when the event was generated, but if that frame has redirected input focus to another frame, @code{last-event-frame} is the frame to which the event was redirected. @item The interactive specification now allows a new code letter @samp{e} to simplify commands bound to events which are lists. This code supplies as an argument the complete event object. You can use @samp{e} more than once in a single command's interactive specification. If the key sequence which invoked the command has @var{n} events with parameters, the @var{n}th @samp{e} provides the @var{n}th parameterized event. Events which are not lists, such as function keys and ASCII keystrokes, do not count where @samp{e} is concerned. @item You can extract the starting and ending position values from a mouse button or motion event using the two functions @code{event-start} and @code{event-end}. These two functions return different values for drag and motion events; for click and button-down events, they both return the position of the event. @item The position, a returned by @code{event-start} and @code{event-end}, is a list of this form: @example (@var{window} @var{buffer-position} (@var{col} . @var{row}) @var{timestamp}) @end example You can extract parts of this list with the functions @code{posn-window}, @code{posn-point}, @code{posn-col-row}, and @code{posn-timestamp}. @item The function @code{scroll-bar-scale} is useful for computing where to scroll to in response to a mouse button event from a scroll bar. It takes two arguments, @var{ratio} and @var{total}, and in effect multiplies them. We say ``in effect'' because @var{ratio} is not a number; rather a pair @code{(@var{num} . @var{denom})}. Here's the usual way to use @code{scroll-bar-scale}: @example (scroll-bar-scale (posn-col-row (event-start event)) (buffer-size)) @end example @end itemize @section Putting Keyboard Events in Strings In most of the places where strings are used, we conceptualize the string as containing text characters---the same kind of characters found in buffers or files. Occasionally Lisp programs use strings which conceptually contain keyboard characters; for example, they may be key sequences or keyboard macro definitions. There are special rules for how to put keyboard characters into a string, because they are not limited to the range of 0 to 255 as text characters are. A keyboard character typed using the @key{META} key is called a @dfn{meta character}. The numeric code for such an event includes the 2**23 bit; it does not even come close to fitting in a string. However, earlier Emacs versions used a different representation for these characters, which gave them codes in the range of 128 to 255. That did fit in a string, and many Lisp programs contain string constants that use @samp{\M-} to express meta characters, especially as the argument to @code{define-key} and similar functions. We provide backward compatibility to run those programs with special rules for how to put a keyboard character event in a string. Here are the rules: @itemize @bullet @item If the keyboard event value is in the range of 0 to 127, it can go in the string unchanged. @item The meta variants of those events, with codes in the range of 2**23 to 2**23+127, can also go in the string, but you must change their numeric values. You must set the 2**7 bit instead of the 2**23 bit, resulting in a value between 128 and 255. @item Other keyboard character events cannot fit in a string. This includes keyboard events in the range of 128 to 255. @end itemize Functions such as @code{read-key-sequence} that can construct strings containing events follow these rules. When you use the read syntax @samp{\M-} in a string, it produces a code in the range of 128 to 255---the same code that you get if you modify the corresponding keyboard event to put it in the string. Thus, meta events in strings work consistently regardless of how they get into the strings. New programs can avoid dealing with these rules by using vectors instead of strings for key sequences when there is any possibility that these issues might arise. The reason we changed the representation of meta characters as keyboard events is to make room for basic character codes beyond 127, and support meta variants of such larger character codes. @section Menus You can now define menus conveniently as keymaps. Menus are normally used with the mouse, but they can work with the keyboard also. @subsection Defining Menus A keymap is suitable for menu use if it has an @dfn{overall prompt string}, which is a string that appears as an element of the keymap. It should describes the purpose of the menu. The easiest way to construct a keymap with a prompt string is to specify the string as an argument when you run @code{make-keymap} or @code{make-sparse-keymap}. The individual bindings in the menu keymap should also have prompt strings; these strings are the items in the menu. A binding with a prompt string looks like this: @example (@var{char} @var{string} . @var{real-binding}) @end example As far as @code{define-key} is concerned, the string is part of the character's binding---the binding looks like this: @example (@var{string} . @var{real-binding}). @end example However, only @var{real-binding} is used for executing the key. You can also supply a second string, called the help string, as follows: @example (@var{char} @var{string} @var{help-string} . @var{real-binding}) @end example Currently Emacs does not actually use @var{help-string}; it knows only how to ignore @var{help-string} in order to extract @var{real-binding}. In the future we hope to make @var{help-string} serve as longer documentation for the menu item, available on request. The prompt string for a binding should be short---one or two words. Its meaning should describe the command it corresponds to. If @var{real-binding} is @code{nil}, then @var{string} appears in the menu but cannot be selected. If @var{real-binding} is a symbol, and has a non-@code{nil} @code{menu-enable} property, that property is an expression which controls whether the menu item is enabled. Every time the keymap is used to display a menu, Emacs evaluates the expression, and it enables the menu item only if the expression's value is non-@code{nil}. When a menu item is disabled, it is displayed in a ``fuzzy'' fashion, and cannot be selected with the mouse. @subsection Menus and the Mouse The way to make a menu keymap produce a menu is to make it the definition of a prefix key. When the prefix key ends with a mouse event, Emacs handles the menu keymap by popping up a visible menu that you can select from with the mouse. When you click on a menu item, the event generated is whatever character or symbol has the binding which brought about that menu item. A single keymap can appear as multiple panes, if you explicitly arrange for this. The way to do this is to make a keymap for each pane, then create a binding for each of those maps in the main keymap of the menu. Give each of these bindings a prompt string that starts with @samp{@@}. The rest of the prompt string becomes the name of the pane. See the file @file{lisp/mouse.el} for an example of this. Any ordinary bindings with prompt strings are grouped into one pane, which appears along with the other panes explicitly created for the submaps. You can also get multiple panes from separate keymaps. The full definition of a prefix key always comes from merging the definitions supplied by the various active keymaps (minor modes, local, and global). When more than one of these keymaps is a menu, each of them makes a separate pane or panes. @subsection Menus and the Keyboard When a prefix key ending with a keyboard event (a character or function key) has a definition that is a menu keymap, you can use the keyboard to choose a menu item. Emacs displays the menu alternatives in the echo area. If they don't all fit at once, type @key{SPC} to see the next line of alternatives. If you keep typing @key{SPC}, you eventually get to the end of the menu and then cycle around to the beginning again. When you have found the alternative you want, type the corresponding character---the one whose binding is that alternative. In a menu intended for keyboard use, each menu item must clearly indicate what character to type. The best convention to use is to make the character the first letter of the menu item prompt string. That is something users will understand without being told. @subsection The Menu Bar Under X Windows, each frame can have a @dfn{menu bar}---a permanently displayed menu stretching horizontally across the top of the frame. The items of the menu bar are the subcommands of the fake ``function key'' @code{menu-bar}, as defined by all the active keymaps. To add an item to the menu bar, invent a fake ``function key'' of your own (let's call it @var{key}), and make a binding for the key sequence @code{[menu-bar @var{key}]}. Most often, the binding is a menu keymap, so that pressing a button on the menu bar item leads to another menu. In order for a frame to display a menu bar, its @code{menu-bar-lines} property must be greater than zero. Emacs uses just one line for the menu bar itself; if you specify more than one line, the other lines serve to separate the menu bar from the windows in the frame. We recommend you try one or two as the @code{menu-bar-lines} value. @section Keymaps @itemize @bullet @item The representation of keymaps has changed to support the new event types. All keymaps now have the form @code{(keymap @var{element} @var{element} @dots{})}. Each @var{element} takes one of the following forms: @table @asis @item @var{prompt-string} A string as an element of the keymap marks the keymap as a menu, and serves as the overall prompt string for it. @item @code{(@var{key} . @var{binding})} A cons cell binds @var{key} to @var{definition}. Here @var{key} may be any sort of event head---a character, a function key symbol, or a mouse button symbol. @item @var{vector} A vector of 128 elements binds all the ASCII characters; the @var{n}th element holds the binding for character number @var{n}. @item @code{(t . @var{binding})} A cons cell whose @sc{car} is @code{t} is a default binding; anything not bound by previous keymap elements is given @var{binding} as its binding. Default bindings are important because they allow a keymap to bind all possible events without having to enumerate all the possible function keys and mouse clicks, with all possible modifier prefixes. The function @code{lookup-key} (and likewise other functions for examining a key binding) normally report only explicit bindings of the specified key sequence; if there is none, they return @code{nil}, even if there is a default binding that would apply to that key sequence if it were actually typed in. However, these functions now take an optional argument @var{accept-defaults} which, if non-@code{nil}, says to consider default bindings. Note that if a vector in the keymap binds an ASCII character to @code{nil} (thus making it ``unbound''), the default binding does not apply to the character. Think of the vector element as an explicit binding of @code{nil}. Note also that if the keymap for a minor or major mode contains a default binding, it completely masks out any lower-priority keymaps. @end table @item A keymap can now inherit from another keymap. To do this, make the latter keymap the ``tail'' of the new one. Such a keymap looks like this: @example (keymap @var{bindings}@dots{} . @var{other-keymap}) @end example The effect is that this keymap inherits all the bindings of @var{other-keymap}, but can add to them or override them with @var{bindings}. Subsequent changes in the bindings of @var{other-keymap} @emph{do} affect this keymap. For example, @example (setq my-mode-map (cons 'keymap text-mode-map)) @end example @noindent makes a keymap that by default inherits all the bindings of Text mode---whatever they may be at the time a key is looked up. Any bindings made explicitly in @code{my-mode-map} override the bindings inherited from Text mode, however. @item Minor modes can now have local keymaps. Thus, a key can act a special way when a minor mode is in effect, and then revert to the major mode or global definition when the minor mode is no longer in effect. The precedence of keymaps is now: minor modes (in no particular order), then major mode, and lastly the global map. The new @code{current-minor-mode-maps} function returns a list of all the keymaps of currently enabled minor modes, in the other that they apply. To set up a keymap for a minor mode, add an element to the alist @code{minor-mode-map-alist}. Its elements look like this: @example (@var{symbol} . @var{keymap}) @end example The keymap @var{keymap} is active whenever @var{symbol} has a non-@code{nil} value. Use for @var{symbol} the variable which indicates whether the minor mode is enabled. When more than one minor mode keymap is active, their order of precedence is the order of @code{minor-mode-map-alist}. But you should design minor modes so that they don't interfere with each other, and if you do this properly, the order will not matter. The function @code{minor-mode-key-binding} returns a list of all the active minor mode bindings of @var{key}. More precisely, it returns an alist of pairs @code{(@var{modename} . @var{binding})}, where @var{modename} is the the variable which enables the minor mode, and @var{binding} is @var{key}'s definition in that mode. If @var{key} has no minor-mode bindings, the value is @code{nil}. If the first binding is a non-prefix, all subsequent bindings from other minor modes are omitted, since they would be completely shadowed. Similarly, the list omits non-prefix bindings that follow prefix bindings. @item The new function @code{copy-keymap} copies a keymap, producing a new keymap with the same key bindings in it. If the keymap contains other keymaps directly, these subkeymaps are copied recursively. If you want to, you can define a prefix key with a binding that is a symbol whose function definition is another keymap. In this case, @code{copy-keymap} does not look past the symbol; it doesn't copy the keymap inside the symbol. @item @code{substitute-key-definition} now accepts an optional fourth argument, which is a keymap to use as a template. @example (substitute-key-definition olddef newdef keymap oldmap) @end example @noindent finds all characters defined in @var{oldmap} as @var{olddef}, and defines them in @var{keymap} as @var{newdef}. In addition, this function now operates recursively on the keymaps that define prefix keys within @var{keymap} and @var{oldmap}. @end itemize @section Minibuffer Features The minibuffer input functions @code{read-from-minibuffer} and @code{completing-read} have new features. @subsection Minibuffer History A new optional argument @var{hist} specifies which history list to use. If you specify a variable (a symbol), that variable is the history list. If you specify a cons cell @code{(@var{variable} . @var{startpos})}, then @var{variable} is the history list variable, and @var{startpos} specifies the initial history position (an integer, counting from zero which specifies the most recent element of the history). If you specify @var{startpos}, then you should also specify that element of the history as @var{initial-input}, for consistency. If you don't specify @var{hist}, then the default history list @code{minibuffer-history} is used. Other standard history lists that you can use when appropriate include @code{query-replace-history}, @code{command-history}, and @code{file-name-history}. The value of the history list variable is a list of strings, most recent first. You should set a history list variable to @code{nil} before using it for the first time. @code{read-from-minibuffer} and @code{completing-read} add new elements to the history list automatically, and provide commands to allow the user to reuse items on the list. The only thing your program needs to do to use a history list is to initialize it and to pass its name to the input functions when you wish. But it is safe to modify the list by hand when the minibuffer input functions are not using it. @subsection Other Minibuffer Features The @var{initial} argument to @code{read-from-minibuffer} and other minibuffer input functions can now be a cons cell @code{(@var{string} . @var{position})}. This means to start off with @var{string} in the minibuffer, but put the cursor @var{position} characters from the beginning, rather than at the end. In @code{read-no-blanks-input}, the @var{initial} argument is now optional; if it is omitted, the initial input string is the empty string. @section New Features for Defining Commands @itemize @bullet @item If the interactive specification begins with @samp{@@}, this means to select the window under the mouse. This selection takes place before doing anything else with the command. You can use both @samp{@@} and @samp{*} together in one command; they are processed in order of appearance. @item Prompts in an interactive specification can incorporate the values of the preceding arguments. Emacs replaces @samp{%}-sequences (as used with the @code{format} function) in the prompt with the interactive arguments that have been read so far. For example, a command with this interactive specification @example (interactive "sReplace: \nsReplace %s with: ") @end example @noindent prompts for the first argument with @samp{Replace: }, and then prompts for the second argument with @samp{Replace @var{foo} with: }, where @var{foo} is the string read as the first argument. @item If a command name has a property @code{enable-recursive-minibuffers} which is non-@code{nil}, then the command can use the minibuffer to read arguments even if it is invoked from the minibuffer. The minibuffer command @code{next-matching-history-element} (normally bound to @kbd{M-s} in the minibuffer) uses this feature. @end itemize @section New Features for Reading Input @itemize @bullet @item The function @code{set-input-mode} now takes four arguments. The last argument is optional. Their names are @var{interrupt}, @var{flow}, @var{meta} and @var{quit}. The argument @var{interrupt} says whether to use interrupt-driven input. Non-@code{nil} means yes, and @code{nil} means no (use CBREAK mode). The argument @var{flow} says whether to enable terminal flow control. Non-@code{nil} means yes. The argument @var{meta} controls support for input character codes above 127. If @var{meta} is @code{t}, Emacs converts characters with the 8th bit set into Meta characters. If @var{meta} is @code{nil}, Emacs disregards the 8th bit; this is necessary when the terminal uses it as a parity bit. If @var{meta} is neither @code{t} nor @code{nil}, Emacs uses all 8 bits of input unchanged. This is good for terminals using European 8-bit character sets. If @var{quit} non-@code{nil}, it is the character to use for quitting. (Normally this is @kbd{C-g}.) @item The variable @code{meta-flag} has been deleted; use @code{set-input-mode} to enable or disable support for a @key{META} key. This change was made because @code{set-input-mode} can send the terminal the appropriate commands to enable or disable operation of the @key{META} key. @item The new variable @code{extra-keyboard-modifiers} lets Lisp programs ``press'' the modifier keys on the keyboard. The value is a bit mask: @table @asis @item 1 The @key{SHIFT} key. @item 2 The @key{LOCK} key. @item 4 The @key{CTL} key. @item 8 The @key{META} key. @end table When you use X windows, the program can press any of the modifier keys in this way. Otherwise, only the @key{CTL} and @key{META} keys can be virtually pressed. @item You can use the new function @code{keyboard-translate} to set up @code{keyboard-translate-table} conveniently. @item Y-or-n questions using the @code{y-or-n-p} function now accept @kbd{C-]} (usually mapped to @code{abort-recursive-edit}) as well as @kbd{C-g} to quit. @item The variable @code{num-input-keys} is the total number of key sequences that the user has typed during this Emacs session. @item A new Lisp variable, @code{function-key-map}, holds a keymap which describes the character sequences sent by function keys on an ordinary character terminal. This uses the same keymap data structure that is used to hold bindings of key sequences, but it has a different meaning: it specifies translations to make while reading a key sequence. If @code{function-key-map} ``binds'' a key sequence @var{k} to a vector @var{v}, then when @var{k} appears as a subsequence @emph{anywhere} in a key sequence, it is replaced with @var{v}. For example, VT100 terminals send @kbd{@key{ESC} O P} when the ``keypad'' PF1 key is pressed. Thus, on a VT100, @code{function-key-map} should ``bind'' that sequence to @code{[pf1]}. This specifies translation of @kbd{@key{ESC} O P} into @key{PF1} anywhere in a key sequence. Thus, typing @kbd{C-c @key{PF1}} sends the character sequence @kbd{C-c @key{ESC} O P}, but @code{read-key-sequence} translates this back into @kbd{C-c @key{PF1}}, which it returns as the vector @code{[?\C-c PF1]}. Entries in @code{function-key-map} are ignored if they conflict with bindings made in the minor mode, local, or global keymaps. The value of @code{function-key-map} is usually set up automatically according to the terminal's Terminfo or Termcap entry, and the terminal-specific Lisp files. Emacs comes with a number of terminal-specific files for many common terminals; their main purpose is to make entries in @code{function-key-map} beyond those that can be deduced from Termcap and Terminfo. @item The variable @code{key-translation-map} works like @code{function-key-map} except for two things: @itemize @bullet @item @code{key-translation-map} goes to work after @code{function-key-map} is finished; it receives the results of translation by @code{function-key-map}. @item @code{key-translation-map} overrides actual key bindings. @end itemize The intent of @code{key-translation-map} is for users to map one character set to another, including ordinary characters normally bound to @code{self-insert-command}. @end itemize @section New Syntax Table Features @itemize @bullet @item You can use two new functions to move across characters in certain syntax classes. @code{skip-syntax-forward} moves point forward across characters whose syntax classes are mentioned in its first argument, a string. It stops when it encounters the end of the buffer, or position @var{lim} (the optional second argument), or a character it is not supposed to skip. The function @code{skip-syntax-backward} is similar but moves backward. @item The new function @code{forward-comment} moves point by comments. It takes one argument, @var{count}; it moves point forward across @var{count} comments (backward, if @var{count} is negative). If it finds anything other than a comment or whitespace, it stops, leaving point at the far side of the last comment found. It also stops after satisfying @var{count}. @item The new variable @code{words-include-escapes} affects the behavior of @code{forward-word} and everything that uses it. If it is non-@code{nil}, then characters in the ``escape'' and ``character quote'' syntax classes count as part of words. @item There are two new syntax flags for use in syntax tables. @itemize - @item The prefix flag. The @samp{p} flag identifies additional ``prefix characters'' in Lisp syntax. You can set this flag with @code{modify-syntax-entry} by including the letter @samp{p} in the syntax specification. These characters are treated as whitespace when they appear between expressions. When they appear withing an expression, they are handled according to their usual syntax codes. The function @code{backward-prefix-chars} moves back over these characters, as well as over characters whose primary syntax class is prefix (@samp{'}). @item The @samp{b} comment style flag. Emacs can now supports two comment styles simultaneously. (This is for the sake of C++.) More specifically, it can recognize two different comment-start sequences. Both must share the same first character; only the second character may differ. Mark the second character of the @samp{b}-style comment start sequence with the @samp{b} flag. You can set this flag with @code{modify-syntax-entry} by including the letter @samp{b} in the syntax specification. The two styles of comment can have different comment-end sequences. A comment-end sequence (one or two characters) applies to the @samp{b} style if its first character has the @samp{b} flag set; otherwise, it applies to the @samp{a} style. The appropriate comment syntax settings for C++ are as follows: @table @asis @item @samp{/} @samp{124b} @item @samp{*} @samp{23} @item newline @samp{>b} @end table Thus @samp{/*} is a comment-start sequence for @samp{a} style, @samp{//} is a comment-start sequence for @samp{b} style, @samp{*/} is a comment-end sequence for @samp{a} style, and newline is a comment-end sequence for @samp{b} style. @end itemize @end itemize @section The Case Table You can customize case conversion using the new case table feature. A case table is a collection of strings that specifies the mapping between upper case and lower case letters. Each buffer has its own case table. You need a case table if you are using a language which has letters that are not standard ASCII letters. A case table is a list of this form: @example (@var{downcase} @var{upcase} @var{canonicalize} @var{equivalences}) @end example @noindent where each element is either @code{nil} or a string of length 256. The element @var{downcase} says how to map each character to its lower-case equivalent. The element @var{upcase} maps each character to its upper-case equivalent. If lower and upper case characters are in 1-1 correspondence, use @code{nil} for @var{upcase}; then Emacs deduces the upcase table from @var{downcase}. For some languages, upper and lower case letters are not in 1-1 correspondence. There may be two different lower case letters with the same upper case equivalent. In these cases, you need to specify the maps for both directions. The element @var{canonicalize} maps each character to a canonical equivalent; any two characters that are related by case-conversion have the same canonical equivalent character. The element @var{equivalences} is a map that cyclicly permutes each equivalence class (of characters with the same canonical equivalent). You can provide @code{nil} for both @var{canonicalize} and @var{equivalences}, in which case both are deduced from @var{downcase} and @var{upcase}. Here are the functions for working with case tables: @code{case-table-p} is a predicate that says whether a Lisp object is a valid case table. @code{set-standard-case-table} takes one argument and makes that argument the case table for new buffers created subsequently. @code{standard-case-table} returns the current value of the new buffer case table. @code{current-case-table} returns the case table of the current buffer. @code{set-case-table} sets the current buffer's case table to the argument. @code{set-case-syntax-pair} is a convenient function for specifying a pair of letters, upper case and lower case. Call it with two arguments, the upper case letter and the lower case letter. It modifies the standard case table and a few syntax tables that are predefined in Emacs. This function is intended as a subroutine for packages that define non-ASCII character sets. Load the library @file{iso-syntax} to set up the syntax and case table for the 256 bit ISO Latin 1 character set. @section New Features for Dealing with Buffers @itemize @bullet @item The new function @code{buffer-modified-tick} returns a buffer's modification-count that ticks every time the buffer is modified. It takes one optional argument, which is the buffer you want to examine. If the argument is @code{nil} (or omitted), the current buffer is used. @item @code{buffer-disable-undo} is a new name for the function formerly known as @code{buffer-flush-undo}. This turns off recording of undo information in the buffer given as argument. @item The new function @code{generate-new-buffer-name} chooses a name that would be unique for a new buffer---but does not create the buffer. Give it one argument, a starting name. It produces a name not in use for a buffer by appending a number inside of @samp{<@dots{}>}. @item The function @code{rename-buffer} now takes an optional second argument which tells it that if the specified new name corresponds to an existing buffer, it should use @code{generate-new-buffer-name} to modify the name to be unique, rather than signaling an error. @code{rename-buffer} now returns the name to which the buffer was renamed. @item The function @code{list-buffers} now looks at the local variable @code{list-buffers-directory} in each non-file-visiting buffer, and shows its value where the file would normally go. Dired sets this variable in each Dired buffer, so the buffer list now shows which directory each Dired buffer is editing. @item The function @code{other-buffer} now takes an optional second argument @var{visible-ok} which, if non-@code{nil}, indicates that buffers currently being displayed in windows may be returned even if there are other buffers not visible. Normally, @code{other-buffer} returns a currently visible buffer only as a last resort, if there are no suitable nonvisible buffers. @item The hook @code{kill-buffer-hook} now runs whenever a buffer is killed. @end itemize @section Local Variables Features @itemize @bullet @item If a local variable name has a non-@code{nil} @code{permanent-local} property, then @code{kill-all-local-variables} does not kill it. Such local variables are ``permanent''---they remain unchanged even if you select a different major mode. Permanent locals are useful when they have to do with where the file came from or how to save it, rather than with how to edit the contents. @item The function @code{make-local-variable} now never changes the value of the variable that it makes local. If the variable had no value before, it still has no value after becoming local. @item The new function @code{default-boundp} tells you whether a variable has a default value (as opposed to being unbound in its default value). If @code{(default-boundp 'foo)} returns @code{nil}, then @code{(default-value 'foo)} would get an error. @code{default-boundp} is to @code{default-value} as @code{boundp} is to @code{symbol-value}. @item The special forms @code{defconst} and @code{defvar}, when the variable is local in the current buffer, now set the variable's default value rather than its local value. @end itemize @section New Features for Subprocesses @itemize @bullet @item @code{call-process} and @code{call-process-region} now return a value that indicates how the synchronous subprocess terminated. It is either a number, which is the exit status of a process, or a signal name represented as a string. @item @code{process-status} now returns @code{open} and @code{closed} as the status values for network connections. @item The standard asynchronous subprocess features work on VMS now, and the special VMS asynchronous subprocess functions have been deleted. @item You can use the transaction queue feature for more convenient communication with subprocesses using transactions. Call @code{tq-create} to create a transaction queue communicating with a specified process. Then you can call @code{tq-enqueue} to send a transaction. @code{tq-enqueue} takes these five arguments: @example (tq-enqueue @var{tq} @var{question} @var{regexp} @var{closure} @var{fn}) @end example @var{tq} is the queue to use. (Specifying the queue has the effect of specifying the process to talk to.) The argument @var{question} is the outgoing message which starts the transaction. The argument @var{fn} is the function to call when the corresponding answer comes back; it is called with two arguments: @var{closure}, and the answer received. The argument @var{regexp} is a regular expression to match the entire answer; that's how @code{tq-enqueue} tells where the answer ends. Call @code{tq-close} to shut down a transaction queue and terminate its subprocess. @item The function @code{signal-process} sends a signal to process @var{pid}, which need not be a child of Emacs. The second argument @var{signal} specifies which signal to send; it should be an integer. @end itemize @section New Features for Dealing with Times And Time Delays @itemize @bullet @item The new function @code{current-time} returns the system's time value as a list of three integers: @code{(@var{high} @var{low} @var{microsec})}. The integers @var{high} and @var{low} combine to give the number of seconds since 0:00 January 1, 1970, which is @var{high} * 2**16 + @var{low}. @var{microsec} gives the microseconds since the start of the current second (or 0 for systems that return time only on the resolution of a second). @item The function @code{current-time-string} accepts an optional argument @var{time-value}. If given, this specifies a time to format instead of the current time. The argument should be a cons cell containing two integers, or a list whose first two elements are integers. Thus, you can use times obtained from @code{current-time} (see above) and from @code{file-attributes}. @item You can now find out the user's time zone using @code{current-time-zone}. The value has the form @code{(@var{OFFSET} @var{name})}. Here @var{offset} is an integer giving the number of seconds ahead of UTC (east of Greenwich). A negative value means west of Greenwich. The second element, @var{name} is a string giving the name of the time zone. Both elements change when daylight savings time begins or ends; if the user has specified a time zone that does not use a seasonal time adjustment, then the value is constant through time. If the operating system doesn't supply all the information necessary to compute the value, both elements of the list are @code{nil}. The optional argument @var{time-value}, if given, specifies a time to analyze instead of the current time. The argument should be a cons cell containing two integers, or a list whose first two elements are integers. Thus, you can use times obtained from @code{current-time} and from @code{file-attributes}. @item @code{sit-for}, @code{sleep-for} now let you specify the time period in milliseconds as well as in seconds. The first argument gives the number of seconds, as before, and the optional second argument gives additional milliseconds. The time periods specified by these two arguments are added together. Not all systems support this; you get an error if you specify nonzero milliseconds and it isn't supported. @code{sit-for} also accepts an optional third argument @var{nodisp}. If this is non-@code{nil}, @code{sit-for} does not redisplay. It still waits for the specified time or until input is available. @item @code{accept-process-output} now accepts a timeout specified by optional second and third arguments. The second argument specifies the number of seconds, while the third specifies the number of milliseconds. The time periods specified by these two arguments are added together. Not all systems support this; you get an error if you specify nonzero milliseconds and it isn't supported. The function returns @code{nil} if the timeout expired before output arrived, or non-@code{nil} if it did get some output. @item You can set up a timer to call a function at a specified future time. To do so, call @code{run-at-time}, like this: @example (run-at-time @var{time} @var{repeat} @var{function} @var{args}@dots{}) @end example Here, @var{time} is a string saying when to call the function. The argument @var{function} is the function to call later, and @var{args} are the arguments to give it when it is called. The argument @var{repeat} specifies how often to repeat the call. If @var{repeat} is @code{nil}, there are no repetitions; @var{function} is called just once, at @var{time}. If @var{repeat} is an integer, it specifies a repetition period measured in seconds. Absolute times may be specified in a wide variety of formats; The form @samp{@var{hour}:@var{min}:@var{sec} @var{timezone} @var{month}/@var{day}/@var{year}}, where all fields are numbers, works; the format that @code{current-time-string} returns is also allowed. To specify a relative time, use numbers followed by units. For example: @table @samp @item 1 min denotes 1 minute from now. @item 1 min 5 sec denotes 65 seconds from now. @item 1 min 2 sec 3 hour 4 day 5 week 6 fortnight 7 month 8 year denotes exactly 103 months, 123 days, and 10862 seconds from now. @end table If @var{time} is an integer, that specifies a relative time measured in seconds. @end itemize To cancel the requested future action, pass the value that @code{run-at-time} returned to the function @code{cancel-timer}. @section Profiling Lisp Programs You can now make execution-time profiles of Emacs Lisp programs using the @file{profile} library. See the file @file{profile.el} for instructions; if you have written a Lisp program big enough to be worth profiling, you can surely understand them. @section New Features for Lisp Debuggers @itemize @bullet @item You can now specify which kinds of errors should invoke the Lisp debugger by setting the variable @code{debug-on-error} to a list of error conditions. For example, if you set it to the list @code{(void-variable)}, then only errors about a variable that has no value invoke the debugger. @item The variable @code{command-debug-status} is used by Lisp debuggers. It records the debugging status of current interactive command. Each time a command is called interactively, this variable is bound to @code{nil}. The debugger can set this variable to leave information for future debugger invocations during the same command. The advantage of this variable over some other variable in the debugger itself is that the data will not be visible for any other command invocation. @item The function @code{backtrace-frame} is intended for use in Lisp debuggers. It returns information about what a frame on the Lisp call stack is doing. You specify one argument, which is the number of stack frames to count up from the current execution point. If that stack frame has not evaluated the arguments yet (or is a special form), the value is @code{(nil @var{function} @var{arg-forms}@dots{})}. If that stack frame has evaluated its arguments and called its function already, the value is @code{(t @var{function} @var{arg-values}@dots{})}. In the return value, @var{function} is whatever was supplied as @sc{car} of evaluated list, or a @code{lambda} expression in the case of a macro call. If the function has a @code{&rest} argument, that is represented as the tail of the list @var{arg-values}. If the argument is out of range, @code{backtrace-frame} returns @code{nil}. @end itemize @ignore @item @code{kill-ring-save} now gives visual feedback to indicate the region of text being added to the kill ring. If the opposite end of the region is visible in the current window, the cursor blinks there. Otherwise, some text from the other end of the region is displayed in the message area. @end ignore @section Memory Allocation Changes The list that @code{garbage-collect} returns now has one additional element. This is a cons cell containing two numbers. It gives information about the number of used and free floating point numbers, much as the first element gives such information about the number of used and free cons cells. The new function @code{memory-limit} returns an indication of the last address allocated by Emacs. More precisely, it returns that address divided by 1024. You can use this to get a general idea of how your actions affect the memory usage. @section Hook Changes @itemize @bullet @item Expanding an abbrev first runs the new hook @code{pre-abbrev-expand-hook}. @item The editor command loop runs the normal hook @code{pre-command-hook} before each command, and runs @code{post-command-hook} after each command. @item Auto-saving runs the new hook @code{auto-save-hook} before actually starting to save any files. @item The new variable @code{revert-buffer-insert-file-contents-function} holds a function that @code{revert-buffer} now uses to read in the contents of the reverted buffer---instead of calling @code{insert-file-contents}. @item The variable @code{lisp-indent-hook} has been renamed to @code{lisp-indent-function}. @item The variable @code{auto-fill-hook} has been renamed to @code{auto-fill-function}. @item The variable @code{blink-paren-hook} has been renamed to @code{blink-paren-function}. @item The variable @code{temp-buffer-show-hook} has been renamed to @code{temp-buffer-show-function}. @item The variable @code{suspend-hook} is now a normal hook. It used to be a special kind of hook; its value had to be a single function, and if the function returned a non-@code{nil} value, then suspension was inhibited. @item The new function @code{add-hook} provides a handy way to add a function to a hook variable. For example, @example (add-hook 'text-mode-hook 'my-text-hook-function) @end example @noindent arranges to call @code{my-text-hook-function} when entering Text mode or related modes. @code{add-hook} takes an optional third argument which says to add the new hook function at the end of the list (normally, it goes at the beginning). @end itemize @bye emacs-19.30/etc/refcard.ps100644 74507 1 356577 5405423301 14615 0ustar mycroftdaemon%!PS-Adobe-2.0 %%Creator: dvipsk 5.512a Copyright 1986, 1993 Radical Eye Software %%Title: refcard.dvi %%Pages: 6 %%PageOrder: Ascend %%BoundingBox: 0 0 612 792 %%EndComments %DVIPSCommandLine: dvips -r0 -s -F -Z -D 1016 -o refcard.ps refcard.dvi %DVIPSSource: TeX output 1993.06.09:1802 /SafetyEnclosure save def %%BeginProcSet: texc.pro /TeXDict 250 dict def TeXDict begin /N{def}def /B{bind def}N /S{exch}N /X{S N} B /TR{translate}N /isls false N /vsize 11 72 mul N /@rigin{isls{[0 -1 1 0 0 0] concat}if 72 Resolution div 72 VResolution div neg scale isls{Resolution hsize -72 div mul 0 TR}if Resolution VResolution vsize -72 div 1 add mul TR matrix currentmatrix dup dup 4 get round 4 exch put dup dup 5 get round 5 exch put setmatrix}N /@landscape{/isls true N}B /@manualfeed{statusdict /manualfeed true put}B /@copies{/#copies X}B /FMat[1 0 0 -1 0 0]N /FBB[0 0 0 0]N /nn 0 N /IE 0 N /ctr 0 N /df-tail{/nn 8 dict N nn begin /FontType 3 N /FontMatrix fntrx N /FontBBox FBB N string /base X array /BitMaps X /BuildChar{ CharBuilder}N /Encoding IE N end dup{/foo setfont}2 array copy cvx N load 0 nn put /ctr 0 N[}B /df{/sf 1 N /fntrx FMat N df-tail}B /dfs{div /sf X /fntrx[sf 0 0 sf neg 0 0]N df-tail}B /E{pop nn dup definefont setfont}B /ch-width{ch-data dup length 5 sub get}B /ch-height{ch-data dup length 4 sub get}B /ch-xoff{128 ch-data dup length 3 sub get sub}B /ch-yoff{ch-data dup length 2 sub get 127 sub}B /ch-dx{ch-data dup length 1 sub get}B /ch-image{ch-data dup type /stringtype ne{ctr get /ctr ctr 1 add N}if}B /id 0 N /rw 0 N /rc 0 N /gp 0 N /cp 0 N /G 0 N /sf 0 N /CharBuilder{save 3 1 roll S dup /base get 2 index get S /BitMaps get S get /ch-data X pop /ctr 0 N ch-dx 0 ch-xoff ch-yoff ch-height sub ch-xoff ch-width add ch-yoff setcachedevice ch-width ch-height true[1 0 0 -1 -.1 ch-xoff sub ch-yoff .1 add]/id ch-image N /rw ch-width 7 add 8 idiv string N /rc 0 N /gp 0 N /cp 0 N{rc 0 ne{rc 1 sub /rc X rw}{G}ifelse} imagemask restore}B /G{{id gp get /gp gp 1 add N dup 18 mod S 18 idiv pl S get exec}loop}B /adv{cp add /cp X}B /chg{rw cp id gp 4 index getinterval putinterval dup gp add /gp X adv}B /nd{/cp 0 N rw exit}B /lsh{rw cp 2 copy get dup 0 eq{pop 1}{dup 255 eq{pop 254}{dup dup add 255 and S 1 and or}ifelse} ifelse put 1 adv}B /rsh{rw cp 2 copy get dup 0 eq{pop 128}{dup 255 eq{pop 127} {dup 2 idiv S 128 and or}ifelse}ifelse put 1 adv}B /clr{rw cp 2 index string putinterval adv}B /set{rw cp fillstr 0 4 index getinterval putinterval adv}B /fillstr 18 string 0 1 17{2 copy 255 put pop}for N /pl[{adv 1 chg}{adv 1 chg nd}{1 add chg}{1 add chg nd}{adv lsh}{adv lsh nd}{adv rsh}{adv rsh nd}{1 add adv}{/rc X nd}{1 add set}{1 add clr}{adv 2 chg}{adv 2 chg nd}{pop nd}]dup{ bind pop}forall N /D{/cc X dup type /stringtype ne{]}if nn /base get cc ctr put nn /BitMaps get S ctr S sf 1 ne{dup dup length 1 sub dup 2 index S get sf div put}if put /ctr ctr 1 add N}B /I{cc 1 add D}B /bop{userdict /bop-hook known{bop-hook}if /SI save N @rigin 0 0 moveto /V matrix currentmatrix dup 1 get dup mul exch 0 get dup mul add .99 lt{/QV}{/RV}ifelse load def pop pop}N /eop{SI restore showpage userdict /eop-hook known{eop-hook}if}N /@start{ userdict /start-hook known{start-hook}if pop /VResolution X /Resolution X 1000 div /DVImag X /IE 256 array N 0 1 255{IE S 1 string dup 0 3 index put cvn put} for 65781.76 div /vsize X 65781.76 div /hsize X}N /p{show}N /RMat[1 0 0 -1 0 0 ]N /BDot 260 string N /rulex 0 N /ruley 0 N /v{/ruley X /rulex X V}B /V{}B /RV statusdict begin /product where{pop product dup length 7 ge{0 7 getinterval dup(Display)eq exch 0 4 getinterval(NeXT)eq or}{pop false}ifelse}{false} ifelse end{{gsave TR -.1 -.1 TR 1 1 scale rulex ruley false RMat{BDot} imagemask grestore}}{{gsave TR -.1 -.1 TR rulex ruley scale 1 1 false RMat{ BDot}imagemask grestore}}ifelse B /QV{gsave transform round exch round exch itransform moveto rulex 0 rlineto 0 ruley neg rlineto rulex neg 0 rlineto fill grestore}B /a{moveto}B /delta 0 N /tail{dup /delta X 0 rmoveto}B /M{S p delta add tail}B /b{S p tail}B /c{-4 M}B /d{-3 M}B /e{-2 M}B /f{-1 M}B /g{0 M}B /h{ 1 M}B /i{2 M}B /j{3 M}B /k{4 M}B /w{0 rmoveto}B /l{p -4 w}B /m{p -3 w}B /n{p -2 w}B /o{p -1 w}B /q{p 1 w}B /r{p 2 w}B /s{p 3 w}B /t{p 4 w}B /x{0 S rmoveto} B /y{3 2 roll p a}B /bos{/SS save N}B /eos{SS restore}B end %%EndProcSet TeXDict begin 40258431 52099146 1000 1016 1016 (refcard.dvi) @start /Fa 1 59 df58 D E /Fb 19 122 df<003FB612E05AA2B7FCA216C0A26C1580230874A132> 45 D97 DII<193F95B5FC171FA319FEEF001F1807A219FCA2180FA2 19F8A2181FA219F0A2183FA219E0A2187FA219C0A218FFA21980A25FA21900A25FED0FF0DB7FFE 5B4AB5FC913907FC1F8791391FF007C7913A3FC003E7FC91387F80014AC712FF495A49486E5A49 5A010F153F495A49485D137F5C13FF48495DA24890C8127FA2485F5B000F16FFA248485EA25E12 3F4993C7FCA25E127F495DA21607A2495D12FF160F19604D13F05B161F1801007F04F013E0A204 3F1303047F14C017E0003F15FF4B14076D491580001F03DF130FDB079F14006C6CEB1F1F0007DA 3E0F131E6C6C017C143E3C01FC01F807F03C3C00FE0FF003F8F8903B7FFFC001FFF0011F90C75B D907FCEC3FC0406371E148>II103 D<153F91B5FC131FA35DEB001F1407A25DA2140FA25DA2141FA25DA2143FA25DA2147FA25DA214 FFA25DA25BA292CAFCA25BEE1FF84A90B5FC030314C0010790390FF03FE092391F800FF0913AFC 7E0007F815F890260FFDF06D7EECFFE05D4B804990C7FC5CA25C495AA25CA249481407605CA201 FF150F605CA248161F6091C8FC173F485FA25B177F00075F17FF495EA2000F5DF0000649170F5E 001F4C131F191E4914075F003F183C160F494B137C1978127F4D13F05BF001E000FF1703040714 C049EE07800403EB1F00933801F87E90C9B45A48705A003CEE1FC0406375E148>I<151FED7F80 EDFFC05CA4168016006E5A157C92C7FCB3A2EB03F8EB0FFEEB3FFF90387E1F809038F80FC0D801 F07FEA03E001C07FEA0780120F13005A001E131FA25A143F007C5C1278147F5D00F813FF485C12 70C65A92C7FCA25B5CA213075C130F5CA2131F5CA2133F5C137F9138C00180ED03C013FFEC8007 16805A1400ED0F005A495B151EA2495BA25D15F800015C4A5A0000EB07C090387E1F806DB4C7FC 6D5AEB07F0225E74DC2B>I<15FCEB03FF137FA315F8EB007F141FA215F0A2143FA215E0A2147F A215C0A214FFA21580A25BA21500A25BA25CA21307A25CA2130FA25CA2131FA25CA2133FA25CA2 137FA25CA213FFA25CA25AA291C7FCA25AA25BA21207A25BA2120FA25BA2121FA25BA2123FEC01 809038E003C0A2127F140701C01380A2140F00FF14001380A25C141E007F133E143CA2003F5B14 F86C6C5A380FE3E06CB45A6C5BC690C7FC1E6373E124>108 DIIII114 DI<15F0EC03F84A7EA2140FA25DA2 141FA25DA2143FA25DA2147FA25DA214FFA25DA25BA2B712FC16FEA216FC260003FEC7FCA21307 A25CA2130FA25CA2131FA25CA2133FA25CA2137FA25CA213FFA25CA25AA291C8FCA25AA25BA212 0716604914F0A2000F140116E049130316C01507001F158049130F16005D151E000F5C157C5D00 07495A4A5A6C6C485A3901FC3F802600FFFEC7FC6D5AEB1FE0275872D62F>II 121 D E /Fc 1 14 df13 D E /Fd 45 122 df<121FEA3F80EA7FC0EAFFE0A313F0A2127F123FEA1F701200A413F013E0A2 1201A213C0120313801207EA0F00121E123E5A127812300C1E768A20>44 DI<121FEA3F80EA7FC0EAFFE0A5EA7FC0EA3F80EA1F000B0B768A20>I< EC3FE0903803FFFE010F6D7E90391FE03FC090397F800FF09039FE0003F848486D7E48486D7E49 147E0007157F4848EC3F80A24848EC1FC0A3003F16E0A34848EC0FF0A600FF16F8B3A2007F16F0 A46D141F003F16E0A3001F16C0A26D143F000F1680A26C6CEC7F000003157E6D14FE6C6C495A6C 6C495A90397F800FF090391FE03FC06DB55A010349C7FC9038003FE02D437BC038>48 D<143C147C14FC1303130F13FFB5FCA213F313031200B3B3AD497E497EB712E0A4234175C038> I<903801FFC0010F13F8013F13FF90B612C02601FC037F3A03E0007FF8D80F80EB1FFC90C76C7E 001E6E7E488000386E1380127800706E13C0127EB47E6DEC7FE0A66C5A001EC8FCC9FCEEFFC0A3 4B1380A24B13005E4B5A150F5E4B5AED3FC04B5A4BC7FC4A5A4A5AEC07F04A5A4A5A4AC8FC147E 5C495A494814E0EB07C0495A49C7EA01C0133E5B5B48481403EA03C04848EC078048B7FC5A5A5A B8FC1700A32B417AC038>II< 0003150C01E0147C01FFEB0FFC91B55A5E5E5E93C7FC5D15F815C0D987FEC8FC0180C9FCACEC3F E0903881FFFC018713FF90399FE03FC09039BF000FE001FCEB07F801F06D7E491301496D7E826C 4880C91380A217C0163FA217E0A5123EEA7F8012FFA317C0167F90C8FC00FC168012700078EDFF 007E4B5A6C4A5AD81F80495A6C6C495AD807F0495AD801FEEBFFC06CB6C7FC013F13FC010F13F0 010113802B437AC038>53 D<4AB4FC020F13E0027F13F84948C67ED903F8133ED90FE0130F495A 4948EB3F8049C7127F01FE14FF12015B485A0007ED7F00163E484891C7FCA2485AA2123FA3485A A2EC3FF8ECFFFED8FFC16D7E9039C3C01FE09039C7000FF001CE6D7E01DC6D7E6F7E13F8496D7E 1780A249EC7FC0A317E05BA3127FA66C7EA217C0121FA2000FEDFF807F000716006D495A12036D 495A6C6C495A6C6C495A90397FC03FE0011FB512806D91C7FC010313FC9038007FC02B437AC038 >I<121C121EEA1FC090B712F8A35A17F017E017C0A2003CC8EA078048ED0F00161E0070151C16 3C5E5E485D15014B5AC8485A4BC7FC150E151E5D5DA25DA24A5A14035D1407A24A5AA2141FA292 C8FC5CA25CA35CA25CA21301A61303AB6D5A6D5A2D4479C138>I57 D<1618163C167EA316FFA24B7FA34B7FA39238073FE0A2030F 7FED0E1FA24B6C7EA2033C7FED3807A203707F160303F07F4B7EA20201814B7EA24A486D7EA202 078192C7123FA2020E6E7EA2021E81021C140FA24A811707027881027FB6FCA291B8FCA202E0C7 120149486E7FA20103834A157FA249C96C7EA24983010E161FA24983180F013C831807137E48B4 4C7E000F01C092381FFF80B500F80207B6FCA448467BC553>65 D<922601FFC0EB0180031F01FC 130392B613070207EDC00F021F9038C00FF0913B3FFC0001F81FDAFFE09038007E3F01030180EC 1F7F4948C8EA0FFF4948814948814948814948814948167F485B4890CA123F191F485A000F180F 5B121F491707123FA2491703127FA396C7FC485AAD6C7EA2F10380A2123F7FA2001F18076D1800 120F7F0007606C6C170E191E6C6D161C6C6D163C6D6C5E6D6C5E6D6C15016D6C4B5A6D6C4B5A6D 6C6C4A5A010001E0023FC7FCDA3FFC14FC913A1FFFC00FF8020790B512E002001580031F01FCC8 FC030113E0414779C450>67 D69 DI<922601FFC0497E031F01FC 130392B613070207EDC00F021F9038C00FF0913B3FFC0001F81FDAFFE09038007E3F01030180EC 1F7F4948C8EA0FFF4948814948814948814948814948167F485B4890CA123F191F485A000F180F 5B121F491707123FA2491703127FA396C8FC485AAC053FB612806C7EA3DD0003EBC000003F715B 6D82A2121F7F120F7F12076C7E807E6C7F6D7E6D7E6D6C5D6D7E6DB45D6D6DEC07BF010001F0EC 1F1FDA3FFCEC7E0F913B1FFFE003FC07020790B5EAF0030200EDC001031F91C9FC030113F04947 79C457>I73 D77 DI80 D83 D85 D97 DI< EC3FFC49B512C0010714F090391FE003F890397F8000FC9039FE0001FE48481303485A1207485A 121F49EB01FC003FEC0070491400127FA35B12FFAA6C7EA3123F6D1407121F6D140F000F150E6C 6C141E6D143C6C6C1478C66C14F890397FC001F090393FF00FC0010FB512800101EBFC00903800 3FE0282D7BAB32>IIIIIII107 DIIIII<3901FC01F800FF EB07FE91381FFF80EC3E3F9138787FC000071370000313E01201EBFDC09138803F8001FFEB0E00 92C7FC91C8FCA35BB3A5486C7EB6FCA4222B7BAA2C>114 D<90381FFC0390B5128F000314FF38 0FF007381F800048C7123F007E80A2007C8012FC81A27E7E6D90C7FC13E0EA7FFCEBFFF06C13FF 6C14C06C14F06C800001806C6C7F010F7FD9007F13801403020013C000E0147F153F151F7E150F 7EA26C1580151F7E6CEC3F006D133E6D13FE39F9F803F800F0B55AD8E03F13C026C007FCC7FC22 2D7BAB2D>IIIIIII E /Fe 25 122 df<94B5913803FFE0043F02E0017F 13FC0303B6D8FC03B6FC031FDBFE0F1580037FDBFFBF15E04AB5D8C00790B5008013F0020701FC C7ECFC034A01E049DAF00713F8023F494914E04A90C7484A4813FC4A48178049495C4B17005B49 495EA25D494E6D13F84B6E6F13F07613E0726F13C072EE1E007293C7FCAFBD12FEA7D8000F01E0 C849C9FCB3B3AC003FB6D8F803B712E0A766637DE25E>11 D<4AB5FC027F14F049B612FE0107ED FFC0011F16F049D9801F7F9027FFF0000313FE02FC01007F486D6E7F717F486D6E7FA2717F8583 A285836C5B6C5B6D5A6D5AEB0FC090C9FCA4047FB5FC033FB6FC0203B7FC143F49B612830107EC E003011FEBFE00017F13F090B512C0000391C7FC4813FC485B485B485BA2485B5CB5FCA291C8FC A35FA26E5CA26C5E6E5C6E027E7F6C6D02FEEBFFC06C6D4948ECFF806C01FE902607F87F14C06C 9039FFC07FF0000191B5EAC03F6C6C4B7E011F9138FE0007010302F801001480D9001F018091C8 FC4A417CBF4F>97 D<903807FF80B6FCA7C6FC7F7FB3A7933801FFF0041FEBFF8093B612F00383 15FC038F15FF039F010080DBFFF0011F13E004C001077F93C76C13FC03FC6E7F4B6E7F4B814B6F 13801BC04B6F13E0A21BF0851BF8A31BFC85A31BFEAE1BFCA3611BF8A21BF0611BE0A24F13C081 6F4B13806F92B51200626F4A5B03FF4A5B4A6D010F5B9126FC7FE0013F13C09127F81FFC01B55A 4A6CB648C7FCDAE00315F84AC615E04A013F49C8FC90C8000313E04F637BE15A>I<92380FFFF0 4AB67E020F15E0023F15F891B712FE010382499026FE003F13C0011F01F0130F4901C04913E049 5B90B5C74813F0485B485B5A5C5A5C5A7113E048496E13C071138071130048EE00FC95C7FC5CA2 B5FCAE6C7FA47E8019F86CEF01FC6E15037E6C6DED07F8806CEF0FF06C6D151F6C6EEC3FE06D6D EC7FC06D01F014FF6D01FC010313806D903AFFC03FFE00010391B55A01005E023F15E0020F1580 020102FCC7FCDA000F13C03E417BBF48>II<92380FFFC04AB5 12FC020FECFF80023F15E091B712F80103D9FE0113FE010F9039F0003FFF4901C0010F7F49496D 7F4990C76C7F49486E7F484980484982187F48498248173F85485BA248717EA3485B1A80A284B5 FCA291B9FCA41A0002C0CBFCA57EA380A27EA27E6E161F6CF03F80A26C6D167F1A006C6D5E6C6D 4B5A6C6D15036D6D4A5A6D6D4A5A6D01F0EC3FF06D01FCECFFE06D9026FFC00F5B010191B65A6D 6C4BC7FC021F15F8020715E0020092C8FC030713F041417CBF4A>III<903807FF80B6FCA7 C6FC7F7FB3A7EF1FFF4CB512F0040714FC041F14FF4C819326FFE03F13E00381EB000FDB83F86D 7FDB87F081DB8FC07FDB9F808103BFC7FC15BE03FE6E7F5D5DA25DA25DA35DB3B0B7D8F007B712 80A751627AE15A>II<9038 07FF80B6FCA7C6FC7F7FB3A80507B61280A7DD007F90C7FCF03FF84E5A943801FFC04D5B4D90C8 FC4D5AEF3FF84D5A4D5A4C5B040790C9FC4C5A4C5A4C5AEEFFE015811583038F7F039F7F03BF7F 92B57EA283844B804B7EDBF03F7F03E0804B6C7F4B6C7F4B7E84707F708082717F85717F717F83 85717F717F8386718086B7D8C00FECFFF0A74C627BE155>107 D<903807FF80B6FCA7C6FC7F7F B3B3B3B3A9B712E0A723627AE12C>III<923807FFE092B6FC020715E0023F15FC91B8FC4949C66C7F0107 01F0010F13E04901C001037F49496D7FD97FFEC8EA7FFE49486F7EA248496F138048496F13C048 19E0A248496F13F0A24819F8A248496F13FCA34819FEA4B518FFAC6C19FEA56C6D4B13FCA26C19 F8A26C6D4B13F0A26C19E06E5D6C19C06C6D4B13806C6D4B13006D6C4B5A6D01C001035B6D01F0 010F5B6D01FE017F5B010390B712C0010094C7FC023F15FC020F15F0020092C8FC030713E04841 7CBF51>I<902607FF80EBFFF8B6011FEBFF80047F14F00383B612FC038715FF039F16C09226BF FE01809227FFF0003F13F8C60380010F7F6D91C76C7F6D01FC6E7F4B6E14804B804B17C04B6F13 E0A27313F0A27313F8A37313FCA47313FEAD611BFCA44F13F8A21BF0611BE0611BC06F92B5FC6F 17804E14006F4A5B6F4A5B03FF4A5B70495B04E0017F13C09226DFFC03B55A03CFB648C7FC03C3 15F803C015E0043F49C8FC040313E093CBFCB3B712F0A74F5A7BBE5A>III<91393FFF80070107B538F81F80011FECFF 7F017F15FF3901FFF0014890C7121FD807FC1407484880484880484880A24848157FA300FF163F 7FA27F6DED1F0001FE92C7FC6D7E14F0ECFFC06C14FF16F016FE6C6F7E6C16E06C826C16FC6C82 6C826C6C16806D16C01307010116E0D9001F15F0EC007F1501DB003F13F81607007C150100FE81 177F7E173FA26D151FA27F18F07F173F6D16E06D157F6D16C06D15FF6D4A138002E0010F130002 FCEB7FFC01DFB65A010F15E0D8FE035D48C66C49C7FC0070010F13E035417BBF40>II<902607FFC0ED3FFEB60207B5FCA7C6EE00076D826D82B3B060 A460A260A26D5E6F5C6D047E7F4E806D6D0101EDFF806D6DEB07F86D01FFEB3FE06D91B55A023F 5D6E4A5A020314F8DA001F01C002F0C7FC51407ABE5A>III<007FB66C90B612E0A7D800 1F01F0C7000FEB80006D6DDA07FCC7FC6D6D4A5A6D6D4A5A6D6D4A5A6D167F70495A6E6D485B6E 01E091C8FC6E6D485A6E6D485A6E4A5A70485A6EEBFE3F6E6D485A6E4A5A6F5C6F91C9FC5F6F5B 6F5B6F7F6F7F81836F804B804B804B805D4B80DB3FF77F04E37FDB7FC17FDBFF80804A497E4A48 814A486D7F020F6E7F4A486D7F4B6D7F4A487F4A48814A486D7F4990C88049486F7F0107707FD9 1FFF81B600F00103B612FCA74E3E7DBD55>I<007FB600C00107B512F8A7D8003F01E0C8381FF8 00735A6D6D4B5AA26D6D4B5AA26D6D5E197F6D95C7FC6F5D6D5F6F14016D5F701303A26E6D495A A26E6D495AA26E6D5C181F6E5E70133F6E5E70137F6E93C8FC705BA26E6D485AA26EEC83FCA26F EBC3F817C76F5C17EF6F5C17FF6F5CA36F5CA26F91C9FCA26F5BA26F5BA2705AA2705AA3705AA2 4C5AA25F167F94CAFCD807F05CD81FFC5C486C1301486C5C1503B512804B5AA24B5A4B5AA24B5A 6C49485A4BCBFC6C48485A9038D807FC391FF03FF86CB55A6C5C6C1480C649CCFCEB1FE04D5A7D BD55>I E /Ff 72 126 df33 DII<153E157F4B7EA9020313F0023F13FF91B612E0010715F84915FE013F814916C090 B87E4883484913BF4801F001837F48018001807F4849143F01FC6F7E4848150F496F7E485A8349 178000FF82495D5FA56D6F1300715A6C6C6F5A95C7FC7F6C7E13FE6C7E14C06C13F86C90B5FC7E 6C15E06C15FC6DECFF80011F15E06D15F8010315FED9007F80020F810200818404BF7F04877F16 819338807FFC173FEF0FFEA2717E83EA1F80486C6F1380487E83487EA45BA25F007F18005F7F4D 5A6C6C150F6D4B5A6C6C153F6D4B5A6C6D903881FFF002F013876C01FE90B55A6C90B75A6C5F6C 94C7FC6D15FC011F5D010715E001011580D9003F01FCC8FC020313C002005BA96FC9FC153E396E 78E14A>I<017E167848B46C15FE486D1401486D4A7E487F486D5CA2486D5D170F13E7267FC3FE 4A5AA201815E00FF6D143FA201005E177FA24D5AA2605EA201814A5BA2007F4992C7FC01C35CA2 263FE7FC495A13FF5F6C49131FA26C49495A6C5B6C495C6C49137FD8007EC7FC90C85B16FFA24B 5BA25F5DA24B90C8FCA25E150FA24B5AA25E153FA25E157FA24B5AA25E5CA24A5BA293C9FC5CA2 4A5AA25D021F15FCEF03FF4B491380023F4A13C04D13E04A484913F0A24B4913F814FF18CF4949 9038FF87FCA24B1403494A14FEA2490100EBFE01A25C130FA2495AA25C013FEDFF03A24A6D14FC 017F1687A2494891387FCFF818FF5C487013F0A24A6E13E07113C06C90C86C13806D6F1300013C ED00FC3F6E7BE14A>I<137EEBFF804813C04813E04813F014F8A214FCA37E6C13FE7E137F1303 A7130714FCA2130FA2EB1FF8A2EB3FF0A2137FEBFFE04813C05A000F1380481300485A485A485A 5B6C5A5B6C5A001EC7FC172C67D54A>39 DI<123EEA7F80487E7F13F8 7F6C7E6C7E000F7F6C7F6C7FC67F6D7E6D7E6D7E6D7E7F6D7F816D7F7F6E7EA26E7E6E7EA26E7E A214078180168080A216C080A216E0157FA316F0153FA5ED1FF8B0ED3FF0A5157F16E0A315FF16 C0A25C1680A25C16005C5D140FA24A5AA24A5A4A5AA24A5A5B495B5D4990C7FC5B495A495A495A 495A00035B485B485B003F90C8FC485A485A5B13E05B6C5A003EC9FC256E74E14A>I<157C15FE 4A7EAB001E17F0D87F80ED03FC01C01507D8FFF0ED1FFE01FC157F01FE15FF267FFF81010313FC 02E1130F001F01F14913F0000701FD017F13C06C90B71280C6EEFE00013F15F8010F15E0010315 8001004AC7FC6E5B021F13F0027F13FC91B57E01036E7E010F15E0013F15F890B712FE0003EEFF 804801FD6D13C0001F01F1011F13F0007F01E16D13FC0281130326FFFE01010013FE01FC157F01 F0151FD87FC0ED07FC01801503D81E00ED00F0C71600AB6E5A157C373D77C84A>II<137E3801FFC04813E04813F04813F814FC5A14FEA314FFA27EA27E7E7E 6C7E130314FEA21307A2EB0FFC131FEB3FF8137FEBFFF0000313E0121F4813C0481380B512005B EA7FF85BEA3FC0001EC7FC182667914A>I<001FB812FC007F17FFA2BA1280A46C1800A2001F17 FC390A78AF4A>II<183C187F604D1380A25FA24D1300A24D5AA24D5AA260173FA24D5AA24D5AA2 4C5BA24C5BA24C90C7FCA24C5AA24C5AA25F163FA24C5AA24C5AA24B5BA24B5BA24B90C8FCA24B 5AA24B5AA25E153FA24B5AA24B5AA24A5BA24A5BA24A90C9FCA24A5AA25D141FA24A5AA24A5AA2 4A5AA2495BA2495BA24990CAFCA2495AA25C131FA2495AA2495AA2495AA2485BA2485BA24890CB FCA2485AA25B121FA2485AA2485AA2485AA25BA26C5AA2001ECCFC396E78E14A>III<913803FFC0023F13FC49B67E010715F0011F15FC498190B87E488348 8348D9FC008002E0010F7F48018001017F4890C87F01FC153F003F707E498148486F138083496F 13C012FF837F19E0187FA36C5AA26C5A0006CAFCCBFCA2F0FFC0A35F19805FA24D13005F60171F 4D5A4D5AA24D5A4C5B4C5B4C5B041F90C7FC4C5A4C5A4C5A4B5B4B5B030F5B4B5B4B90C8FC4B5A 4B5A020313F04A5B4A5B4A5B4A48C9FCECFFFC495B495B495B491380013F90C8EA1F804948ED3F C04948ED7FE0485B4813E0000F5B485B4890B8FC5ABAFCA56C18C06C18803B5779D64A>I<9138 01FFF8023FEBFF8049B612F0010715FC011F15FF017F8290B87E48838448DA000F7F4801F00101 7F02C06D6C7E91C8121F48486F7E6D8183198083A26C5A6C5A6C5AEA006090C95A1900A25FA24D 5A171F60173FEFFFF804035B160F0303B55A0207B65A4A5D4A92C7FC17FC838318C06E816E8191 C7000F7F04017F706C7EEF1FFF050713807113C0837113E0A2F07FF0A2183F19F8181FA3120FEA 3FC0487EA2487E183F19F0187FA249EEFFE0127F6D4B13C06D5D6C6C4B138001FF151F6C01C002 7F130002F049485A6C9026FF800F5B6C91B65A6C5F6C5F6C6C5E011F93C7FC010715FC010115F0 D9001F1480020101F8C8FC3D587AD64A>II<1818187E4DB4FC4D1380170F 5F177F94B5FC040314004C5B041F13F84C5B93B512C04B5C030749C7FC031F5B4B13F092B55A4A 1480020791C8FC4A13FC023F5B4A13E049B512804991C9FC010F13FC013F5B4913E048B55A4891 CAFC000F5B4813F8007F5B14C0B5CBFC5BA27F6C13C014F0001F7F6C13FE00037F6C14C06C6C7F 6D13F8010F7F010313FF6D806D6C13E06E13F8020F7F6E13FF0201806E14E0033F7F6F13FC0307 7F03016D7E6F80043F13F0707F040713FE707F0400148083171F831703711300EF007E18183948 78CE4A>60 D<120C123FEA7FC0487E13F87F13FF806C13E06C7F000F13FC6C7F00016D7E6C8001 3F13F06D13FC01077F6D6D7E0100806E13F0021F7F6E13FE02037F020014C06F7F031F13F86F13 FE03037F6F14C06F6C7F7013F8040F7F7013FF1601706C138083A25F4CB5120016074C13FC043F 5B4C13E04BB55A4B91C7FC030F5B4B13F8037F13E092B55A020391C8FC020F5B4A13F8027F5B91 B512C001035C4949C9FC011F5B4913F090B512C0485C000749CAFC485B003F13F0485BB5128091 CBFC13FC5B13E06C5A6CCCFC120C394878CE4A>62 D<91383FFFE00103B512FE011FECFFE0017F 15F848B712FE48824817C04817E04817F0489038F0007F91C7000313F8D87FFC020013FC49153F 01E0151F00FFEE0FFE6D1507A56C48150F6C48ED1FFC6C48153FCA12FF040313F84C13F0161F4C 13E093B512C04B14004B5B4B13F84B13E04B5B4B90C7FC4B5A4B5A5E4A5B4A5B5EA24A5B93C8FC 5C5DAC5DA26E5A91CAFCADEC01E0EC07F84A7E4A7EA24A7EA46E5AA26E5A6E5AEC01E0375777D6 4A>I<4BB47E031F13F092B512FC020314FF020F814A15E0027F8191B77E5B4902007F4901F0EB 1FFE4901C0130F4990C7EA03FF494880D97FF816804A804948903907F87FC04849EB3FFF4A4913 BF484948B612E0495B00075C495B48484915F0A2484890383FFC0F92387FF003494A7E003F4A48 7E4C137F494816F8007F92C7123FA2494848141FA24B140F12FF140713004B1407AA6F140F1380 020316F0127F6F141FA26D6C6CEC3FE0A2003F6F137F6D6C16C07013FF001F6E6C4813806D6E5A 92263FFC0F13006C6C6DB55AA26C6C6D5C6D6D5C00036E5C6D6D5C6C6D6C6C13806E6D90C7FC6C 6DEB07F86D6C90C7EA0FE06EED1FF0D93FFEED3FF86D6C157F6D01C0EB01FF6D01F013076D01FF 017F13F06D91B612E06D17C06E1680021FEDFE006E5D020315F002001580031F01FCC7FC030113 C03D587AD64A>II<003FB712 E04816FCEFFF80B97E18F0846C83846C8326003FF0C7003F1380050F13C017037113E083F07FF0 A2183FA219F8181FA7F03FF0A2187F19E018FF4D13C05F4D13804D1300EF3FFE933803FFFC91B7 5A6018C095C7FC18C018F018FC848402F0C7000F1380050313C0050013E0F07FF0F03FF8181F19 FC180F19FE1807A3F003FFA86019FE180FA2181FF03FFC187FF0FFF85F050713F0053F13E0003F B9FC4818C01980BA120018FC606C17E018806C04FCC7FC40567DD54A>II<003FB7FC4816F0B812FC17FF848418F06C836C8328007FE0 00077F1600EF3FFF717F717F1703717FA2717F727E183FA2727EA2727EA2180785A284A21A8084 A57213C0AF601A80A4601A00A260A261180FA24E5A183F61187F4E5AA24D5B5F4D5B051F5B5F94 B5C7FC04075B003FB85A485FB95A60188095C8FC17FC6C16F06C93C9FC42567ED54A>I<003FB9 12FC4884BBFCA57E7E26003FF0C81203AB725A725A96C7FCA717FC4C7E4C7EA691B7FCA99138F0 0003A6705A705A94C9FCA8F11F80F13FC0F17FE0AD003FBAFC5ABBFCA56C19C06C198043567DD5 4A>I71 D<003FB67E4881B7FC82A35E7E6C5D26001FF8 CAFCB3B3B119FCF001FEF003FFAD003FBAFC5ABBFCA56C18FE6C18FC40567CD54A>76 D<263FFF8092383FFF804801E092B512C0B56C4A14E0A36E5CA26C19C06C6D4A14800001F0F000 01FE16EF6E140FA3027FEC1FCFA36F133F023F158FA26F137FA2021F150F6F13FFA2020F14FEA2 EDF001A2020714FCEDF803A2020314F8EDFC07A2020114F0A2EDFE0F020014E0A2EDFF1FA2037F 13C0A216BF033F1380A216FF6F1300A36F5AA36F5A6F5A6F5A92C8FCB3A2263FFFF04AB5128048 6D4A14C0B56C4A14E0A56C496E14C06C496E148043567DD54A>I<263FFFE091387FFFFE4801F8 91B6FCB56C491580A280A36C6D6D15006C705BC66C030090C7FCECBF80A2EC9FC0A381148FA281 1487A2811483A281148181A2148081A28182A2153F82A2151F82A2150F82A26F7EA2150382A215 0182A2150082A28283A2163F83A2161F83160FA2831607A2831603A2831601A3707EA2177F003F B5FC4880B66C7FA383A26C4A6D5A6C91C7EA03FC41567CD54A>I<003FB712E04816FEB97E18E0 18F884846C836C188026003FF0C714C0051F13E0050713F017017113F8187FF03FFC181FF00FFE A21807A219FF84A86019FEA2180FA2F01FFC183FF07FF818FF4D13F01707051F13E094B512C091 B81280190060606018E018804DC7FC17E002F0CAFCB3A7003FB512F04880B67EA56C5C6C5C4056 7DD54A>80 D<003FB612F04815FFB812E017F88317FF846C836C8328007FE0003F7F04077F1601 706C7E173F717E170F717EA2838583A75F96C7FC5FA24D5A171F4D5A177F4C485A1607043F5B91 B75A606095C8FC17FCA28383849126E0003F7F1607707F1600717EA2173F84171FADF103F0F107 F8F10FFCA4EF0FFCA29538FE1FF8003FB500C014FF486E6D13FFB66C16F0831AE0837114C06C4A 6E13806C4A91381FFE00CBEA03F846577DD54A>82 DI< 003FB912FE4884BB1280A7903BC0000FFC0001AB6C487013006CC7167EC893C7FCB3B3B3027FB6 7E91B77E4982A56D5E6E5D41567CD54A>I<263FFFF092387FFFE0486D92B512F0B56C4A14F8A5 6C496E14F06C496F13E0D807F8CA1300A46D5E000360A76C6C4C5AA86C6C4C5AA5ED01FCED07FF 6D4901805B0280150FA24B13C0A5013F90263FDFE05B02C0151FA2168FA2037F13F0A3011F5F02 E00107133F03FF13F8A4EDFE03D90FE102FC5BA3EDFC0102F1157FA202F314FEA20107D9F80091 C7FCA54B137EA2D903F7EC7F7EA202FF15FE4B133FA44B131F6D5EA36D496D5A027EC7EA03F045 577ED54A>87 D<003FB612F04815F8B712FCA516F816F001C0C8FCB3B3B3B3B3A290B612F016F8 16FCA56C15F86C15F0266E62E14A>91 D<121EEA7F80A2487EA27FA26C7EA26C7EA26C7EA2120F 7FA26C7EA26C7FA26C7FA26C7FA26D7EA26D7EA26D7EA2130F80A26D7EA26D7FA26D7FA26D7FA2 6E7EA26E7EA26E7EA2140F81A26E7EA26E7FA26E7FA26E7FA26F7EA26F7EA2151F82A26F7EA26F 7EA26F7FA26F7FA26F7FA2707EA2707EA2161F83A2707EA2707EA2707FA2707FA2707FA2717EA2 717EA2171F84A2717EA2717EA2711380A283A271130084183C396E78E14A>I<003FB612F04815 F8B712FCA57E7EC8120FB3B3B3B3B3A2003FB6FC5AB7FCA56C15F86C15F0266E7BE14A>II<001FB812FC007F17FFA2BA1280A46C1800A2001F17FC390A787C4A> I<14F0EB03F8EB07FC130FEB1FFE133FEB7FFCEBFFF84813F04813E04813801400485A485A5BA2 485AA2485AA25BA212FF5BA713FC7F7F6C138014C0A37EA27E6C13806C13006C5AC65A172C66DF 4A>I<903801FFFE011FEBFFE0017F14F890B612FE486F7E48824882834882DA80037F91C76C7E 707E160F6C486E7F826C486E7FEA00F090C9FC84177FA593B5FC157F020FB6FC147F0103B7FC13 0F133F90B8FC48EDFC7F48ECF0004849C7FC4813F04813C04890C8FCEA7FFC5B5B485A5BA66D15 FF6C6C5CA26D1407D83FFE141F6D027F13F86CD9E007B612FE6C90B9FC6C19807E6C16DF6C160F 6DECFC07011FDAF00314000107913980003FFE9026007FF8CAFC414078BE4A>I<383FFFF0487F B57EA57E7EEA000FAFEE1FF893B5FC030714E0031F14F8037F8092B67E02FD8191B87E85DCE01F 7FDC00077F03FC01017F4B6D6C7E03E0143F4B6E7E180F4B8192C87E7213805C844A17C084A31A E0197FAB19FF1AC08060A26E1780604E1300816F5C4E5A6F143F6F4A5A6F4A5A6F130303FF495B DCC03F5B93B65A6102FD93C7FC02FC5D6F14F8031F5C6D486C14C0902603F00149C8FC90C8EA3F F043577FD54A>I<92387FFFC00203B512FC021F14FF027F158049B712C04916E0010F16F05B49 16F849EBC0004948C7127F4813F8485B02C0EC3FF0485B4890C8EA1FE0EF0780484892C7FC5B5B 123F5BA2127F5BA212FF5BAA7F127FA37F123F7FEF01F86C6CED03FC6DED07FE6C7E170F6C13C0 6EEC1FFC6C6D143F6C01FCEC7FF86C01FFEB01FF6DD9F00F13F06D90B612E06D16C06D16806D16 0001015D6D6C5C021F14F0020714809126007FF8C7FC374076BE4A>I<93381FFFF84C7F4C7FA5 8282EE0007AF913801FF80020F13F8027F13FE49B612874915C7010F15F74915FF5B5B90B5EA80 7F489038FC000F4849130302E07F48497F4849147F91C8123F485A49151F170F485A5B007F1607 A25BA212FF5BAB7F127F170FA27F003F161F7F173F6C7E6D157F000F16FF6D5C6C7F6E13076C01 F05B6C01FC133F6C01FF90B712806D90B812C06D03F714E06D15E76D15C76D15870101ECFE076D 4A6C14C0021FD9E0011480020390CAFC43577BD54A>II<933803FF80043F13F093B512FC0303804B80151F4B15805D92B7 FCEEFC074A13F04AD9C00313004C6C5A715A4A90C712304B91C7FCAB003FB812F04883B97EA56C 5F6C5FC7D807FEC9FCB3B3A7001FB87E48834883A56C5F6C5F39577BD64A>I<4AB46CEB1FF802 0F01F090B5FC023FD9FC07148091B6001F14C0010392B6FC4918E05B5B5B4901819138F07FC091 26FC003F130049486DEC3F8002E00107EC040048496D6DC7FCA248496D7FA291C8FC488349157F A86D15FF6C5F6E5BA26C6D495BA26C6D4990C8FC02F8131F6D6C495A9138FF81FF92B55A5F90B7 5A5F485E94C9FCD9FE3F13FC020F13F00201138091CCFCA37F7E8014E46DB612E017FF6D16F049 16FC90B9FC48844818E04884480180C7003F7F4848C8120101F89238003FFC4848EE0FFE491607 4848707E84498200FF198090CB127FA66D17FF007F19006D5E6D5E6C6C4C5A01FC161F6CB4EE7F FC6C01C04A485A02F8140F6C9026FFC001B55A6C91B75AC618806D94C7FC6D5E010F16F8010316 E0D9007F92C8FC020F14F8DA007F90C9FC435F7CBD4A>I<383FFFF0487FB57EA57E7EEA000FAF EE1FFC93B57E030714E0031F804B804B8002FDB67E91B8FC85EEE01FEE80034B486C7F15F84B7F 4B815D4B147FA292C8FCA25CA35CB3AC003FB6017FB512F8486FB612FCB700C115FEA56C038015 FC6C4B6C14F847567FD54A>I<15F0EC03FC4A7E4A7EA24A7FA46E90C8FCA26E5A6E5AEC00F092 C9FCAC001FB512FE4880825AA37EA27EC71201B3B3A7003FB812E04817F018F8B9FCA37E18F06C 17E0355775D64A>I<160FEE3FC0EE7FE0EEFFF0A24B13F8A46F13F0A2EE7FE0EE3FC0EE0F0093 C7FCAC0107B612E04915F04915F8A57F7F90C8121FB3B3B3A9163F17F0A2167F000F16E0D83FC0 14FF487E4B13C0486C5B4B1380031F13006D137F90B65A6C5D5E5E6C5D6C1580000792C7FC0001 14F8D8001F13C02D7779D64A>I<383FFFE0487F80B5FCA37EA27EEA0007B0043FB6FC4C1580A2 93B712C0A3701580A27015009326001FFCC7FC4D5A4D5A4C485A4C5B4C5B4C90C8FC4C5A4C5A4C 5AEEFFE04B5B4B5B4B90C9FC4B5A4B5A153F4B7E92B5FC02F98014FB91B67E4B6C7E4B6C7E15F8 4B6C7E4B6C7E4B6C7E15804B6C7E4A6D7F4A6D7F5C717E717E717EA2717E717E717EA2717F717F 003FB6013FEBFFE0486F4814F0A2B76CB612F8A36C4B6C14F0A26C4B6C14E045567ED54A>I<00 3FB6FC4881B77EA57E7EC8FCB3B3B3AE003FB9FC481880BA12C0A56C18806C18003A5678D54A> I<037FEC1FC0283FFC03FFE0EBFFF8267FFE0FD9F0037FB5003FD9F80F7F4A6D487F91B56C4880 70488094B6FC7E6C02819138E07FE0C649C6EC803F4A15004A6D48131F4A4A804A6D48130FA24A 5CA24A5CA491C75BB3AD003FD9FC07B548B512C0486D48028314E0B603C314F04B14C7A36F14C3 6C01FE038314E06C496C020114C04C3E81BD4A>IIIII III<263FFFF049B57E486D4980B56C4980A5 6C816C81D8000F91C7127FB3B118FFA25F5FA26E140F6D6C5C6F137FDBF003B612F86D90B812FC 1AFE7F7F6E816E14FC020FDAF03F13FC0203DA801F13F89126007FFCC9FC473E7FBC4A>I<003F B500C0017FB51280486E90B612C06F5AB617E0A36C19C04B7E6C4A6D148026003FE0C8EB800001 1F94C7FC6E5CA2010F5E6E1403A201075E6E1407A201035E6E140FA201015E6E141FA26D5E6F13 3FA2027F5D6F137FA2023F5D6F13FFA2021F92C8FC6F5AA2020F5CEDF803A202075CEDFC07A202 035CEDFE0FA202015CEDFF1FA26E5C16BFA2037F5B16FFA26F5BA36F90C9FC6F5A6F5A433D7DBC 4A>I<003FB500C0011FB512E0486E4914F06F5BB617F8A36C19F04B7F6C4A6D14E0C690C93807 F800A580017F4C5AA56E151F013F5FA316FCED03FF6E48EB803F011F5FA24B13C0A36D6C485DEF E07F16DF16CF033F13F0A2010794C7FCDAF87F5C83168F168715FF01035E6E14FC160317FD14FD A20101D9FE015B02FF14FFA24B7EA26D5EA24B137FA26E486D5ADA3FC0EB0FE0453D7EBC4A>I< 001FB5D8E007B512F8486E4880484B8015F8A315F06C6F5C6C4A6C5C260007FCC7D83FE0C7FC6E 4A5A6D6C14FF6D6D485B6D93C8FC6E6C485AEDE007DA3FF05B021F495A6E6C485AEDFC3F02075C 6E6C485A6EB55A8094C9FC6F5A6F5A151F5E6F5A4B7E82153F4B7E92B5FC83913801FE7F4A486C 7E02076D7E03F87F4A486C7E021F1307DA3FE07F4B6C7E027F6D7E4A487E4990C77F717E49486E 7E494881010F151F4A6E7E003FB5D8C001B512FE486E4880B649158015F0A315E06C6F15006C4A 6C5C413D7CBC4A>I<003FB500C090B6FC486E481580B65B03F016C0A303E016806C816C4A6C15 0026003FE0C7000190C7FC60131F6E1403010F5EA26E140701075E80170F01035E800101151F6E 5DA26D153F6F5C147F177F6F5C143F6F13FF021F92C8FCA26F5A020F5CA2EDF80302075CA29138 03FC075F15FE14014C5AEC00FFA24C5AED7F9FA25FED3FBF16FF6F5BA36F90C9FCA2815EA21503 5E1507A25E150FA25E151FA25E153FA25E157F486C5CD80FF013FF487E4A90CAFC486C5A5D1407 EC1FFCEC7FF890B5FC6C5C5D6C5C6C5C92CBFC000113FC6C5BEB1FC0425D7CBC4A>I<000FB912 E04818F04818F8A619F001F0C8000713E04D13C04D13804D13004D5A4D5A4C5B6C484A5B6C484A 5BC9485B4C5B4C90C7FC4C5A4C5A4B5B4B13E04B5B4B5B4B90C8FC4B5A4B5A4B5A4A5B4A5B4A5B 4A5B4A90C9FC4A5AECFFFC495B495B495B4949EC07E04949EC0FF04990C8EA1FF8495A495A485B 485B485B485B485B4890C9FC4890B8FCBAFCA66C18F06C18E03D3D7BBC4A>II<121EEA7F80A2EAFFC0B3B3B3B3B3AEEA7F80A2EA1E000A6E60E14A>II E /Fg 42 123 df[<96263FFFFC93387FFF80063FB600C0021FB512F8 0507B700F891B612FE053F04FF01076F7E4CB9D8C03F82040F72B812F0043F06F98393B626F800 1F90B6D8F8037F030392C70001DCC0077F4B02F86E6C4AC65A031F02C092B648497F4B91C84803 F016804B494B4B5B92B500F84B5D4A4A4B4B4914C04A5C4A4A4B92C7FC4A5C94C95D5C4A4961A2 4A49761480A2754A6E140091B5775B4C70715B7B5B75715B759438007FC07595C8FCB3A4C212FC AAC702FCCA02FCCBFCB3B3B3B0003FB800F0013FB9FCA99126E0001F9438E00007>146 142 123 269 136 11 D[159 141 120 268 176 65 D[144 139 120 266 166 I[<0803B500C0EE01F00703B600FEEE03F8 077FDBFFE015070607B800FC150F063FDDFF80143F4DBA00E0147F050F07F814FF053F07FE5B94 BC6C5A0407755A4C9326F8000FECF00F043F4BC86C6D5A93B700E0030FEBFE7F03034BC9000190 B6FC4B03F8707E4B03C0171F033F92CB12074B02FC8492B648844A03E0727E02074B854A92CD7E 4A4A864A4A864A4A864D8691B64886494B875B494B8794CF7E495C498B5E498B495C8D90B65A8D 5A5E488CA2485D227FA2485DA2223F5AA293D1FC5AFA1FF09FC7FCA25AA35DA3B6FCB37EA381A3 7EA46CF90FF070F51FF8A27EA2827EA36C6F1D3F23F07E826C217F23E06D8022FF6D6E1EC06D67 826D6E5213807F715113006D816D555A6D6F1B1F6E6E515A71515A6E6E1BFF6E6E505B6E6E505B 6E03C04F5B02016F4F5B6E03F8073F90C7FC6F6E4F5A6F02FF4E485A030F03C005075B6F03F805 1F5B6F03FF057F5B030004E00303B51280043F03FE033F91C8FC040FDBFFF80107B55A7093B812 F804001BE0053F1A80050F4FC9FC050119F8DD003F18E0060795CAFCDE007F16F8070393CBFCDF 000314C0>141 143 115 268 168 I[157 139 120 266 179 I[138 138 120 265 153 I[127 138 120 265 146 I[<0803B500C0EE01F00703B600FE4C7E077FDBFFE015070607B800FC150F063FDDFF8014 3F4DBA00E0147F050F07F814FF053F07FE5B94BC6C5A0407755A4C9326F8000FECF00F043F4BC8 6C6D5A93B700E0030FEBFE7F03034BC9000190B6FC4B03F8707E4B03C0171F033F92CB12074B02 FC8492B648844A03E0727E02074B854A92CD7E4A4A864A4A864A4A864D8691B64886494B875B49 4B8794CF7E495C498B5E498B495C8D90B65A8D5A5E488CA2485D227FA2485DA2223F5AA293D1FC 5A7C5A9FC9FCA25AA35DA3B6FCB37EA36F061FB692387FFFF89DB8FCA27EA46C81A36C98C903F8 C7FCA2827EA36C81A27E827E827FA26D806D80A26D807F836D816D816D8180836E806E14FF6E6F 606E81020103F0606E816F02FE606F6E6C5F030F03E05F6F03F8177F6F03FF4CB7FC030004F003 0713FD043F03FF033F13F8040F04FC0107B5487E7093B8EAE01F0400517E053FF20003050F4F13 00050107F8143FDD003F06E0140F060795C81203DE007F04F8ED00F00703048093C8FCDF000302 E0CDFC>157 143 115 268 183 I[165 139 120 266 182 I[75 139 122 266 88 I[163 139 120 266 182 75 D[121 139 120 266 140 I[204 139 120 266 221 I[<97B512F0077FECFFE0060FB8FC067F17E00507B912FE051F727E94BB12F004031A FC040FDBF00015FF043F4AC7000715C093B600F0020015F04B0380031F8003074AC9000714FE4B 02F8040180033F4A7015C04B02C0053F8092B64871804A92CB6C80020702FC060314FE4A4A7280 4A4A72814A4A7380A24A4A738091B64873804992CD6C80498C494A7480A2494A7480494A7481A2 498D4C86498D4C8790B68B4C87488EA2488E4C87488EA293CF7E488EA3482380A24B884823C0A5 4823E0A24B88A5B621F0B36C23E0A46F64A26C23C0A56C23806F64A26C2300A36C6F515CA36C6A 70636C6AA26C6F515CA26D697098B6FC6DDE07FE617092267FFFC05C6D4DB500F8606D6E02076E 4A92C7FC4F14FF6D6E4A6F495C6D4D6F5E6D6E91267FFC036D495C719028FFE0007FF05B6D6F02 80D91FF8495C6E4B90C76C6C5E6E02E0496E6C495C6E6E48486E6C90B65A6E02F8704992C8FC6E 02FC4904835C6E02FE7001C75C6EDAFF8394B65A6E6C02C37015E06F02E3626FDAFBFC6F5D0307 02FF4FC9FC6F6F6003006F4B14F0043F03C00107B612C0040F03F0017F92CAFC040392B812FC04 001AF0053F07C01640050773ED01F0050073ED03F8060F84DE007F15E70700DAF0037F97C86E15 078B0EC0140F7A143F7702F814FF0EFE131F9DB7FCA112F089A47817E0A38AA112C0A2781780A3 781700A2785E6B8A785E6B8A795D795D795D794AC7FC795C0D0114F0796C13C0E60FFEC8FC> 149 180 115 268 175 81 D[165 141 120 266 175 I[<93260FFFF8163E4BB600E0157F031F 03FE5D037FDBFFC05B4AB800F05B020F05FE5B4A716C5A027F725A91BAEAF03F01039126FE000F 6E5A4902C0D9003F01FEB5FC4991C8000790B6FC4901FC15004901F0163F4949160F90B5481603 4B824891CB7E4849848748498487484984A2488687485B88A24887A288A288B57EA38880A2806E 85A2818115F06F725A6C6E95C8FC15FF16E016FC6CEDFFE017FEEFFFF06CEFFF8019F8F1FFC06C 19FCF2FF806C1AE06C1AF81BFE6C747E6C1BE0886D866D1AFE6D866D876D876D876D876D7E6E86 020F866E8614016E6C85151F03031A80DB003F19C01601EE001F050018E01807DE007F16F01903 F1003F080F15F81A031A008787090F14FCA287D83F8085486C8512FF87A288A46D86A21EF8A27F A36D1CF0A27F5213E07FA26D1CC06E96B5FC6E1B806E606E1B006E6002FE4E5B6E6203C05F03F0 4D5B03FC057F5BDBFF8093B55A04F803035CDCFF80021F5C6E02FF49B6C7FC496C92B75AD9FC0F 61D9F80319F049C66149013F18804901074DC8FC49010017F890C8001F16C04803004BC9FC007C 04011480>102 143 115 268 129 I[<000FC312F8A6488EA404E0C7003F4AC7120303FCC8F000 1F03E01C0392C9F1007F4A8A02F81E0F4A8A4A8A4849787F4A8A91CA1B7FA249203FA249201FA3 49200FA3492007007F8EA4498CA848487A1380A6CC98C8FCB3B3B3B3A6031FBD12FCA90780C8FC >145 137 120 264 162 I[230 140 123 266 241 87 D<93387FFFFE031FB612F84AB8FC020F17E0023F17F84A17 FF49BA7E499126F0003F14E04901FCC700078049040114FC496D6E6C7F6F6F7F497180706E8073 804980738088858885A2886D5C866D91C9806D5B6D5B6D5B6D5B9038007FC091CBFCA796B7FC05 07B8FC0403B9FC167F0303BAFC153F4ABBFC0207EE007F023F15C091B600FCC7FC010315E04992 C8FC011F14FC4914F04914C090B65A484AC9FC485C485C485CA2485C485CA25A5DA2B6FC92CAFC A497B6FCA361816C60A26C6E5D6FED0FEF6C061F816FDB3FCF14E06C6EDB7F8F14FC6C02FE9126 01FF0F91B512806C6E02077F6C03C0D91FFE17C06C923AFC01FFF803013F91B612F0010F4D7E01 03943880007F01004CC77E021F03F802071580020103E0EC007FDA000349CDFC6A5D7ADB71>97 D[113 142 121 268 129 I<94387FFFF8041FB612E093B712FE0307EEFFC003 3F17F092B97E020318FE4A84021F9126F8001F14804A02C0010014C091B548C74814E0494A5C49 02F017F0494A5C495C494A4A14F84991C8FCA2495B90B55A5AA2485C7314F0485C7314E0487214 C0731480484A701300745AF20FF84896C8FCA3485CA5B6FCB07EA281A37EA36C80A36CF201FE6F EF03FF7EA26C6E5F6C1BFE6F170F6C1BFC6F171F6D6EEE3FF87F6D6EEE7FF06D6EEEFFE06D6E15 036D02FC4B13C06D6E031F13806D6E6C027F13006E02F049485A021F02FF013F5B6E92B612F002 036002001880033F4CC7FC030716F8030016C0041F4AC8FCDC007F13C0585D78DB67>I[113 142 120 268 129 I<94383FFFE0040FB6FC93B712F0030716FE033F707E92B912E0020318F802 0FDAFC01804A9126C0001F13FF027F91C700078091B500FC020180494A6E804902E06F7F494A6F 7F494A6F7F4991C97E49727F4949844B8290B51A8048854B19C04885484A19E0A248861DF0485C A27513F85AA3485CA21DFCA287B6FCA392BBFCA51DF8A203C0CDFCA67EA381A27EA37EA2817EF4 07F86C80F40FFC7E6C6E181FA26C6EF03FF86D1A7F6F19F06D6E17FF6D6E4C13E06D6E4C13C06D 6E040F13806D6E5E6D02FE047F13006D6E6C4A485A6E02E002075B021F02F8023F5B6E9126FFC0 07B512E0020392B75A020096C7FC033F5F030F17F8030117C0DB003F4BC8FC040315E0DC000F01 FCC9FC5E5D7ADB6B>I[81 142 121 269 71 I<52B47E93260FFFFC031F13F04BB600 E0027F7F031F03FE0103B57E92B8D8C00F800203DDF01F80020FDDFC7F1580023F94B6123F4ADA 003FDBF07F13C091B500F801071580010302E00101ECFE004902806D6C01F890B5FC4991C86C6D 7F49496F7FA249496F6D158049747E4B6F6F130090B5736C5AF507F8489838E000E04B6F93C7FC 4887A34887AB6C63A36C636F5D6C63A26D626F5D6D97C9FC6D6D4B5BA26D6D4B5B6D6E4A5B6D02 E049B55A010002F8010714C04902FF013F5C4992B7CAFC4918FC02F317F0D90FF017C0DAE01F4B CBFC011F010115E0DB000F01FCCCFC013F91CFFCA3137FA480A28080A214FF8115F092B812F06D F0FFE01BFEF3FFC06D1AF81CFE6D747E1DE06D87896D876D876D876E8791BD7E010788131F017F 8890BEFC000302E0C9003F814891CB7E4801FC18074A0601804849727E4849191F4A85488988B5 5A88A66E616C65A26E616C656E616C6D4F5B6C6D4F5B6E96B5FC6C6D4E5C6C02C005075C6C02F0 051F91C7FC6C6C01FC057F13FC6DD9FF800303B55A010F02F0031F14E06DDAFFC00107B65A0101 92B9C8FC6D6C19FC020F19E0020196C9FCDA003F17F8030194CAFCDB000192CBFC6A857ADB74> I[114 141 119 268 129 I[49 142 119 269 65 I[111 141 121 268 123 107 D[50 141 119 268 65 III<94381FFFF00407B612C0047F15FC0303B87E 031F17F0037F17FC4ABAFC02079126FC007F14C04A02C0010780023F49C814F84A01F8033F7F91 B5486F7F494A6F7F4902800303804991C96C804987494970804949717F498790B548717FA2484A 717FA2481D80484A7114C0A2481DE0A3481DF0A24B83481DF8A3481DFCA5B61BFEAF6C1DFCA56C 1DF86F5FA26C1DF0A36C1DE06F5F6C1DC0A26C1D806F5F6C1D006C6E4D5BA26D6D94B55A6D6D4C 5C6D6E4B5C6D6E4B5C6D6E4B5C6D6E4B5C6D02FC037F91C7FC6D6E92B55A023FD9FFC0010714F8 6E02FC017F5C020791B812C0020196C8FC6E6C17FC031F17F0030717C0DB007F03FCC9FC040715 C0DC001F01F0CAFC675D7ADB74>II114 D<92261FFFF8EB01F00207B638C007F8023FEDF81F91B7EAFE7F010393B5FC130F013F9038F800 1F4990C71201D9FFF8EC003F4801E081484915074849814890C97E4982121F197F485A193F127F A2191F12FF7FA27F80806E705A02F893C8FC14FF15E06C14FEEDFFF8EEFFE06C16FF18F018FC6C EFFF806C18E0856C18FC6C846C727E6C856D84011F846D841303010084023F83140F020183DA00 1F1780ED007F1601DC000F15C01700181F060714E0D83F801601486C8200FF84856D83A285A26D 83A26D19C0A37F6D1980617F6E1800616E5F6E163F6E4C5A02FC4C5A6E4B5B6E6C02075B03F002 3F5B03FF0107B55A93B7C7FCD9FC7F16FCD9F03F16F0D9E00F16C0D9800193C8FC90C7003F14F8 007C020349C9FC4B5D78DB5C>I[73 130 124 256 91 IIIIII<0003BC12F0 1CF81CFCA41CF80480C7123F03F0C84814F04802C092B612E092C915C002FC5D4A4B15804A4B15 004A60604A4B5C4A4B5C4E5CA291C9B65A4D5D4D5D5B4D92C7FC4D5C000F4C5CA24D5C494B5C94 B65A625E4C5D4C92C8FCC95D5E4C5C4C5C4C5CA293B65A4B5D4B5DA24B92C9FC4B5C4B5CA24B4A EC0FFC4B5C92B65A605C4A4BEC1FF84A92C8FC5F5C4A5C4A5C4A5C1B3F91B65A495D494B16F01B 7F4992C9FC495C494A16FFA2494A5D495C90B6485D62484B5D484B4B13E04892C95A4B5E484EB5 FC484A1507484A153F4B0207B6FC4891BAFCBDFCA21CC0A37E7E565A7AD967>I E /Fh 61 124 df11 DI34 D39 DI<126012F012787E7E121F6C7E6C7E6C7E6C7E6C7E7F137E 7FA26D7E6D7EA26D7E801303806D7EA26D7EA2147FA26E7EA36E7EA281140FA281A2140781A36E 7EA4811401A481A280A61680B3A41600A65CA25DA414035DA44A5AA35D140FA25DA2141F5DA24A 5AA34AC7FCA214FEA2495AA2495A5C13075C495AA2495A49C8FCA2137E5B5B485A485A485A485A 48C9FC121E5A5A5A1260218C78E837>I44 DII<157815F814011403140F143F14FF 130790B5FCB6FC143F13F81300C7FCB3B3B3B34A7E4A7E0107EBFFC0B812FEA42F5D74DC46>49 DI<913803FFC0023F 13FC49B67E902607FE0113E0903A0FE0007FF0D93F80EB1FFC017EC76C7E496E7ED801F06E7F49 8200036F7FEA07FC6D826D80486D8180A66C5BA26C90C8FCD800FC5E90C85AA260A24C5BA2604C 90C7FCA24C5A5F4C5A4C5AEE7FC04C5ADB03FEC8FCEDFFFC027F13E016FCEEFF80DA000113E06F 6C7EEE1FFC707E707E707F707F707F84717EA284717EA38483A21980A3EA0FE0487E487E487E48 7EA31900A25F5B606C5A494B5A13C0003EC95B4D5A7E6C6C4A5B6C6C4A5BD803F05ED801FC4A90 C7FC6CB4EC1FFED97FC0495A903A1FFE01FFF06DB612C0010392C8FCD9007F13FC020713C0395F 7ADC46>I<171E173E177EA217FE1601A216031607A2160F161FA2163FA2167F16F7A2ED01E7ED 03C7A2ED0787ED0F07A2151E153CA2157815F0A2EC01E0140315C0EC0780140F1500141EA25C5C A25C495AA2495A495AA249C7FC131EA25B5BA25B12015B485AA2485A48C8FCA2121E5AA25A5ABA 12F8A4C9D80FFEC7FCB14C7EA293B512E00203B712F8A43D5E7CDD46>I<01C0ED01C0D801F015 0701FE153FD9FFC0903801FF8002FE011F130091B65A5F5F5F5F5F5F4CC7FC16F801E714E001E0 49C8FC91CAFCB3913801FFC0020F13F8027F13FF9026E1FF007FD9E3F8EB3FE0D9E7C0EB0FF001 EFC76C7E01FE6E7E4981496E7E496E13804916C06C48157F90C913E0A2EF3FF0A218F8A218FC17 1FA318FEA5EA0FC0EA3FE0487E7F12FF7FA318FC5B173F4916F86C5A90C9FC007CEE7FF0A2003C 17E0003E16FF6C17C04C13806C7E6C6C4A13006D4A5A6C6C4A5A6C6C4A5AD800FEEC7FF0903A7F 8001FFC090261FF8075B6DB548C7FC010314F8010014E0DA0FFEC8FC375F79DC46>I<923801FF C0031F13F8037F13FE913901FF80FF913A07FC001F80DA1FF0EB07C0DA3FC06D7E4A486D7E4AC8 FC4948EC01784948EC0FF849484A7E4948143F011F157F495A495AA2495A5A715A4890C86C5A71 5A4893C8FC5B120FA3485AA3123FA3485AED7FE0913803FFFE4A6D7E91391FC07FE091393E001F F000FF49EB07F802F06D7E4A6D7E01F96E7ED9FBC0814A6E7E01FF6F7E91C87F8449151F84A284 5B717EA4491780A2127FA7123FA27FA3001F1800A3120F4D5A7F12076012036D4B5A6C5F806C4C 5A6D6C4A5A013F5E6D6C4990C7FC6E495A6D6C495AD903FEEB1FF86D6C6CB45A6D90B512C0023F 91C8FC020F13FC020113E0395F7ADC46>I<913801FFC0021F13F8027F13FF902601FF807F903A 03FE003FE0D90FF8EB0FF049486D7E49486D7E49486D7E4948804890C87F48167F49821207000F 707E5B001F83003F161F845B007F83A400FF83A2170FA284A71980A2127F5FA3123F7F5F121FA2 000F5E6C7EA2000393B5FC6C6C15EF6C6D1301017FEC03CF6D6C148F6D6C13076D6CEB1F0FD907 FC013E1400903903FF01FC0100EBFFF0023F13E00203130091C8FC4D5AA460A34D5AA260A2D803 F84B5A487E486C5E486C15FF605E95C7FC4C5AA2494A5A494A5A6C484A5A01C05D00074B5A6DEC FF806C6C4990C8FCD801FCEB07FE3A00FFC03FF86DB55A011F14C0010749C9FC9038007FF0395F 7ADC46>57 DII65 D68 DIIIII76 DIII<001FBDFCA49126E0000301FCC7FC4848C76C49020F138001F86E49140301E01900491A 7F491A3F1C1F90C9FC003E1B0FA3003C1B07007C1CC0A300781B03A748F301E0A5CA94C7FCB3B3 B3A34C7F4C7F043FEBFFC0020FB9FCA45B5F7BDE66>84 DII<003FB7021FB612F0A4D8001F02F0020302FCC7FC010302C0020014C0010091C9D8 3FFEC8FC4B705A027F18F0023F606E6C705A705E6E4DC9FC6E7F70153E6E5F6E7F705D6E4C5A6F 7E704A5A033F4B5A6F7E71495A6F4BCAFC836F6D133E6F5D836F6D5B6F4A5A17FC706C485A043F 495A05FF5B70130F70019FCBFC18DE7013FE705B60828284177F717E848385855F4D7F057B7F17 F9DC01F07F4D7F0403137F4C486C7E05807F040F7FDC1F0080041E6D7F043E7F4C8104786D7F04 F87F4B48814C7F03036F7E4B48814C143F030F6F7E4BC880031E81033E6F7F4B8303788103F86F 7F4A48834B810203717E4A48834B163F020F717E021F85023F83027F717F02FF85497F01074E7F 013F01F0043F13FC0003B500FC93B67EB76C020FEDFFC0A462607DDF69>88 D<010CEC0180011EEC03C049EC078049EC0F0049141E49141C0001153C48485C48485C90C85A48 1401000E5D001E1403001C5D003C1407003892C7FCA200785C0070140EA300F0141E48141CA5D8 E3F8147FD8E7FCECFF80D8EFFE011D13C0B5011F13E0028014F0A26C80A36C80A26C496C13E06C 486D13C06C486D13806C48EC7F002C2A6CE146>92 D97 D<14F8EA07FFB5FCA41201EA007F133F131FB3A9EE7FF00303B5FC030F14C092393FC03FF09239 7E000FFC03F8EB03FEDAFBF0EB00FFDAFFC06E7E4BEC3FE092C8121F4A82727E4A82727E5C727E 1A80A2841AC0A21AE0A284A21AF0AC1AE0A3601AC0A31A80601A00A24E5A6E5E180F6E4B5A616E 4B5ADAEF804A5ADAE7C04A5ADAC3E04990C7FCDAC1F8EB07FCDA80FCEB1FF8913A003F80FFE06F B51280011E010749C8FC90C813E044637CE14E>I II<913801FFC0020F13FC027F13FF 902601FF8113C0903A03FE003FE0D907F8EB0FF0D91FF06D7E49486D7E49486D7E4948804890C8 1380A24848ED7FC012074916E0000F163F121F4916F0A2003F161FA2127F18F85BA312FFA290B8 FCA301F0CAFCA7127FA37F123FA3001F17787F120F18F86C6C16F0000316016D16E06C16036C6D EC07C06D6C15806D6C140F6D6CEC1F006D6C147E6D6C5CD901FFEB03F06D9038E03FE0023FB512 80020749C7FC9138007FF035407CBE3E>II< F01FE0DA07FFECFFF0023FD9E00313F891B539F80FF0FC0103903A07FE1F81FE903B0FF800FFBE 01494890387FF803494890383FF0014948131F494890390FF800FC19784890C76C6C13004882A2 48824980A2000F83A9000794C7FCA26D5C6C5EA26C5E6C6D495AA26D6C495A6D6C495A6E495A49 6C495A902773FF07FEC8FC01F0EBFFF8023F13E02601E00790C9FC91CBFCA21203A47FA27F1201 13FE6D7E6C90B67E17FC6DEDFF806D16E06D16F86D824982017F824848C81480D803FC030713C0 D807F0030113E04848ED007F4848EE1FF04848160F127F90CAEA07F8A200FE1703A66C17076C18 F06D160F003F18E06C6CEE1FC06D163F6C6CEE7F80D803FC923801FE006C6C4B5A2600FFC0EC1F F8D93FF0EC7FE0903B0FFF800FFF80010390B548C7FCD9003F14E0020101FCC8FC3F5C7CBE46> I<14F8EA07FFB5FCA41201EA007F133F131FB3A9EE1FFC93B57E030314E092390FF03FF092391F 800FF892393E0007FC03786D7E4B80DAF9E07FDAFBC0815D14FF92C8FC855CA25CA45CB3B2496C 4A7F90B5020713F8B70007B612F8A445627BE14E>I<131FEB7FC0497E487FA2487FA56C5BA26C 5B6D5A011FC7FC90C8FCB214F8EA03FF127FA41201EA003FA2131FB3B3AB497E90B5FCB612FEA4 1F5F7CDE27>I<153EEDFF804A13C04A13E0A24A13F0A56E13E0A26E13C06E1380ED3E0092C7FC B2ED03F0EC1FFF0103B5FCA4EB00031400157F153FB3B3B3AAEA1FC0486C14E0486C137F487EA2 16C015FF168016006C48485A13E06C48485A6C48485A390FF01FE06CB55A000191C7FC38001FF8 247B86DE2B>I<14F8EA07FFB5FCA41201EA007F133F131FB3AA0407B6FCA4040014E07190C7FC EF3FFC18F06018804DC8FC177E5F4C5A4C5AEE07C04C5A4CC9FC167E5E4B5A4B5A1507150F4B7E 4B7E157F4B7E9138F9F7FFECFBE7DAFFC37F03817F15014A6C7F4A6D7E5C4A6D7E707EA2707E70 7EA2707F707FA2707F717EA2717E717EA2717E848585496C82D9FFFE023F13F8B6D8FE01B612E0 A443627CE14A>I<14F8EA07FFB5FCA41201EA007F133F131FB3B3B3B3AB497E90B5FCB7FCA420 627CE127>IIII<02F8EB7FF0D807FF 0103B5FCB5010F14C092393FC07FF092397E000FFC03F8EB03FEC6D9FBF06D7E90263FFFC06D7F 6D49EC7FE092C8123F4A82727E4A82727E5C727E1A8084A21AC0841AE0A47213F0AC1AE060A31A C060A21A80601A00A24E5A6E5E181F6E4B5A616E4B5A6F4A5A6F495BDAFBE04990C7FCDAF9F8EB 07FCDAF8FCEB1FF892393F80FFE06FB51280030749C8FC030013E093CAFCB3A2497E90B5FCB7FC A444597CBD4E>III<903A01FFE00380011FEBFC07017FEBFF0F3A01FF803FDF3A03F80007FFD8 07E0130148487F4848147F48C8123FA248151F127E160F12FEA216077EA27FA213E06D91C7FCEA 7FFCEBFF806C13FCECFFE06C14FE6C6E7E6C15E06C816C816C6C80011F80010780D9007F148002 0314C0EC001F030713E015010070EC007F00F0ED3FF0161F7E160FA216077EA37E17E07E160F6D 15C0A26DEC1F806DEC3F006D147E486C5CD8FC7EEB03F83AF83FC01FF0010FB512C0D8F00391C7 FC39E0007FF02C407BBE37>I<143CA6147CA514FCA31301A21303A21307130FA2131F133F13FF 1203000F90B61280B8FCA326000FFCC8FCB3AEEE01E0AD010714036E14C0A213036EEB07807F92 38800F007F91387FC01E91383FF07C91380FFFF802035B9138007FC02B577DD537>I<02F8ED07 C0D807FFED3FFFB50207B5FCA40001ED000FD8007F1503013F81011F81B3B15FA45FA2130F5FA2 6D6C5C171E01034B7F6E4A7F6D6C02F813FC6D90268003F0EBFFF891397FF00FC0021FB55A0207 495A9126007FF8ECC000453F7BBD4E>IIIII<000FB812E0A39126C0000113C001FCC75A01F04A138048481600494A5A4914 1F5F90C8485A167F5F001E4B5A5D4B5B5F003E4A90C7FC003C5C5E4B5A153F4B5AC85B4B5A5C5E 4A5B5C4A90C8FC5D141F4A5A5D4A5A02FFEC01E05D495B5B495B92C7FC4948EC03C0131F5C495A 137F495A4A1407485B5A4A140F4890C8FC48161F49153F4848ED7F80003F16FF4848140349143F B9FCA3333D7CBC3E>II E /Fi 15 116 df[<0A07B500E0183F0907B7 6C5F50B800F8933801FF80083F05FF5E4FBA00E05D071F07FC5D96BC5D060709C05C061F09F05C 95BD00FC91B5FC05030AFF1303050F9426F80007EDC007053F04FCC8003F6E5A94B800800303EC F81F4C04FCCA6C6D5A040704E0051F6D5A4C93CB000790B7FC043F03FC18014C03F0727E4BB700 C0854B93CD120F4B4B864B03F886033F4B1A004B4B8792B70080874A93CF7E4A4B884A4B884A4B 884E884A5D4A4B884A8D91B7488995D1FC498E494B8A5F498E495DA17E495D498EA2494B8AA290 B75AA17F5A5FA17F5A94D3FC48A17EA35A5EA17F5AA34C7A13005AA190C8FCA35AA45EA3B7FCB3 A37EA382A47EA47E82A149B4FCA26CA1481380A2827EA36C82A15B7EA11500837EA15B6D81A15C 6D6F1F1FA27F6D6F555AA26D6F1F7F6DA15A711FFF6D6F686D6A72676E6F656E6F535B6E575B6E 6F65729CC7FC6E6F535A6E6F1D7F6E6F535A6E7009035B6F03E0515B6F6F515B030F6F515B6F03 FE097F5B6F6F6C97B5C8FC6F7007035B6F6C03F0070F5B7003FC073F5B040F03FF96B55A7004E0 05035C040104FC051F148070DCFFC093B6C9FC053F04FC030F14FC050FDCFFF80103B65A050394 B912E005001D80061F51CAFC06071BF806001BE0071F97CBFC070119F8DF003F18C008014DCCFC E0000716C0E1000702E0CDFC>169 171 112 296 202 67 D[165 166 118 293 184 69 D[<0A03B500E0F01F8009 07B76C173F50B800FCEFFFC0081FDDFF805D4FBA00F05D070F07FE5D077F736C5C0603BC00E05C 061F09F85C067F09FE5C4DBE6C48B5FC050F9426F800036F5A4D04FCC8001FECF007057F04C003 016E5A4CB700FCCA6CEBFE1F040704E0050F6D5A4C0480050391B6FC043F03FCCCFC4C03F08593 B700C0191F03034C854B4BCD12034B4B864B03F0864B4B1B3F92B748874A93CF7E4A4B884E884A 4B884A4B884A5D4A8D4A4B8991B7488995D1FC498E494B8AA2494B8A495DA17E495DA17E5B494B 8BA290B75AA17F5A5FA17F5AA24893D37EA35A5EA17F5AA34C7A5B5AA190CAFCA35AA45EA3B7FC B3A37EA382A20C07B500FE94380FFFF89EBBFC7EA46C81A47E9BCA04C0C7FC827EA36C82A27E83 A27E837FA26D817F837F837F6D81A26D816D82A26E816E816E816E816E816E81846E70626E8203 3F816F03F8626F816F03FF626F7061030004E0617003F8617003FE96B8FC040FDBFFC05F7004F0 1707040104FE051F5B706CDBFFE0047F497E051F04FF0307B5487E7105FE91B6487E050194B9EA E007716CF4C001061F99C7FC060309FC143FDE007F08F0140F070F08C0140307014FC9FCDF001F 06F0EE3F80080106801607E0000704F0CEFCE1000302F8CFFC>189 171 112 296 220 71 D[198 167 118 294 219 78 D[198 169 118 294 210 82 D[194 169 118 294 215 85 D<94B67E93B712FE030FEEFFE0037F17FE0203 BA12C0020F19F0023F19FC4A19FF91BC12C0499226C0001F15F04902E0C7000181496E6E6C8070 031F80496E6F8049060381706F817481496E858775808A878A878AA275816D5CA26D5C75816D5C 6D5C6D5C6D5C023F90CAFCEC07F891CCFCA81B0F071FB8FC061FB9FC0507BAFC94BBFC160F93BC FC1507033F17C392B8EA80030207EEE000021F4BC7FC027F15F091B7128001034BC8FC4915F001 1F15C0495D494AC9FC90B65A485D4815E05E5A485D4892CAFC5D5A5D5AA25DA2B6FC5DA363A463 81637E6F5F636C6E18BF6F17FF6C0703133F6C6F4B8204E0DB0FFE816C6FDB3FFC15FC6C6F4B48 6CECFFC06C03FE912603FFF0EEFFF86C6F6C010F01E017FC6DDBF801B5486C16FE011F92B71280 6D4F7E010306FC7F01004E1300021F05E08002030580141FDA007F03FCC8000315FC030703E0DB 001F14F8DB000701FCCEFC7F6F78ED88>97 D<061FB57E050FB77E94B812F8040717FF043F18E0 93BA12F8030719FE031F854B8692BC7E02034BC76C804A03E00207804A03805C023F4AC848804A 02F88491B6485D495D4903804B804992C9FCA2495C495C495CA2495C90B6FC5E48745C5A4C705C 5A755C484B705C755C755C48746C48C7FC93CBEA0FF099C9FC5AA45A5DA4B6FCB27E81A47EA382 7EA36C81A26CF5FF80826C5213C0A26C6F60A26C6F4E13807F704E13006D806D515A70183F6D6F 4D5A6D6F4D5A6D6F5E6D03F84C5B6D6F040F5B6E02FF4C5B6E03C0157F6E03F04AB55A020703FC 020F49C7FC6E9226FFE001B55A020093B75A6F61031F19C003076103014EC8FCDB003F17F00407 17C004004CC9FC050F15E0DD001F01F8CAFC6A6F77ED7C>99 D[137 170 119 296 155 I<95383FFFF8050FB612E094B712FE0407EEFFC0043F17F04BB912 FE0307727E031F85037F19F092B626FC007F80020303C0010714FE4A92C7000180021F02FC6E6C 804A02F0031F804A4A6F8091B6486F80494B6F804992C97E494A7080494A717F5B494A717F4C71 14805B90B6487114C0A2485D7614E05A4C1AF04887A25A93CB15F8885AA21FFC5AA24B84A25A1F FEA4B6FCA292BDFCA61FFC1FF84BCFFCA67EA5817EA37EA36C81A36CF503F870F107FC6CF50FFE A26C811E1F6C816DF43FFC70197F6D1DF86D6E19FF704E13F06D6E606D6F4D13E06D6F4D13C06D 6F5F6D6F057F13806E6E94B512006E02FE04035B6E6E6C030F5B020703E0037F5B6E03FC0207B5 5A0200DBFFE090B65A6F92B81280031F97C7FC030719FC030119F06F6C18C0040F95C8FC040117 F8DC003F16C0050103FCC9FCDD000791CAFC6F6F78ED80>I[<96381FFFF0060FB6FC95B712C005 0716F8053F8294B9FC04031880040F18C0043F18E093B6D8FE0114F04BDBE00314F84BED80074B DAFE0015FC4B4A5B4B02F04914FE4B5C4B4A16FF92B6485BA24A92C7FC5C5F5C5F5CA24A4A6E14 FEA27414FCA24A4A6E14F87414F07414E07414C0093F1300F30FFC98C8FCB3A8BCFCABC7003F02 F8CBFCB3B3B3B3AE007FBA12C0AA91C97E>96 170 118 297 85 I109 DI<4BB46CEC3FFE013FB64AB512E0B8020F14FC073F14FF96B7 12C04E824E16F84E824E824EEBE07F4E0100B6FC95267FFC011580F0FFF0D8000F4D4815C00101 038113C06D0383494815E019006EEC87FE60EF8FF8A2EF9FF06017BF607415C017FF4E6D1580A2 95C81500755B755B4D6F5B090713E0090090C7FC4D93C8FCA55FA75FB3B3AFBB7EAA49C9FC636D 78EC73>114 D<93263FFFFCEC07E0031FB600F0131F92B700FEEB7FF002079338FFC1FF023F94 B5FC91BBFC1303130F499138E0000F4901FCC87E4901E0150F90B5008015034849CAFC48498348 01F0171F86484983484983A248855CA24885A31B7FB57EA28080806E725A806E6C94C8FC15E015 FCEDFF8016FC6CEDFFF0EFFFC018FE6CEFFFF019FE6CF0FFC01AF86C19FE6C737E876C1AF06C86 6C866D19FF6D866D866D860103867F6D6C85021F851407020085031F841501DB000F1880EE003F 1701DD000716C0F0007F190F070115E0737ED83FC084007F190F486C84866D8486A2877FA26D85 A26D1BC0A27FA26E1A8063806E1A006E95B5FC6E616E5F6E4D5B6E4D5B03C05E6F4C5B03F8047F 5B03FE4BB55ADBFFC0020F5C04FE49B6C7FC93B85A1BF8020F60496C18C0D9F80195C8FC9026F0 003F16F801C0010716C06C4801004BC9FC007EC8000791CAFC5B6F77ED6E>I E end %%EndProlog %%BeginSetup %%Feature: *Resolution 1016dpi TeXDict begin %%EndSetup %%Page: 1 1 1 0 bop 268 -542 a Fi(GNU)92 b(Emacs)h(Reference)g(Card)1561 -313 y Fh(\(for)46 b(v)l(ersion)j(19\))0 110 y Fg(Starting)77 b(Emacs)0 454 y Fh(T)-12 b(o)47 b(en)l(ter)h(GNU)g(Emacs)g(19,)f(just)g(t)l (yp)t(e)h(its)f(name:)63 b Ff(emacs)0 681 y Fh(T)-12 b(o)47 b(read)h(in)f(a)g(\014le)g(to)g(edit,)g(see)i(Files,)e(b)t(elo)l(w.)0 1083 y Fg(Lea)-6 b(ving)77 b(Emacs)0 1427 y Fh(susp)t(end)49 b(Emacs)e(\(or)g(iconify)h(it)f(under)h(X\))684 b Ff(C-z)0 1596 y Fh(exit)47 b(Emacs)h(p)t(ermanen)l(tly)1555 b Ff(C-x)73 b(C-c)0 1998 y Fg(Files)0 2341 y Fe(read)46 b Fh(a)h(\014le)h(in)l(to)f (Emacs)1663 b Ff(C-x)73 b(C-f)0 2510 y Fe(sa)l(v)l(e)46 b Fh(a)h(\014le)g (bac)l(k)h(to)f(disk)1619 b Ff(C-x)73 b(C-s)0 2679 y Fh(sa)l(v)l(e)48 b Fe(all)h Fh(\014les)2297 b Ff(C-x)73 b(s)0 2848 y Fe(insert)47 b Fh(con)l(ten)l(ts)h(of)f(another)h(\014le)g(in)l(to)f(this)g(bu\013er)227 b Ff(C-x)73 b(i)0 3016 y Fh(replace)49 b(this)e(\014le)g(with)g(the)g(\014le) g(y)l(ou)h(really)g(w)l(an)l(t)332 b Ff(C-x)73 b(C-v)0 3185 y Fh(write)47 b(bu\013er)g(to)g(a)g(sp)t(eci\014ed)i(\014le)1251 b Ff(C-x)73 b(C-w)0 3587 y Fg(Getting)k(Help)0 3931 y Fh(The)47 b(Help)h(system)g(is)f(simple.)64 b(T)l(yp)t(e)47 b Ff(C-h)g Fh(and)g(follo)l(w)g(the)g(directions.)64 b(If)0 4099 y(y)l(ou)48 b(are)f(a)g(\014rst-time)h(user,)g(t)l(yp)t(e)f Ff(C-h)73 b(t)47 b Fh(for)g(a)g Fe(tutorial)p Fh(.)0 4327 y(remo)l(v)l(e)i(Help)f(windo)l(w) 1770 b Ff(C-x)73 b(1)0 4496 y Fh(scroll)48 b(Help)g(windo)l(w)1883 b Ff(ESC)73 b(C-v)0 4723 y Fh(aprop)t(os:)64 b(sho)l(w)47 b(commands)i(matc)l (hing)f(a)g(string)338 b Ff(C-h)73 b(a)0 4892 y Fh(sho)l(w)47 b(the)g(function)h(a)f(k)l(ey)h(runs)1270 b Ff(C-h)73 b(c)0 5061 y Fh(describ)t(e)49 b(a)e(function)1884 b Ff(C-h)73 b(f)0 5229 y Fh(get)47 b(mo)t(de-sp)t(eci\014c)j(information)1232 b Ff(C-h)73 b(m)0 5632 y Fg(Error)78 b(Reco)-6 b(v)g(ery)0 5975 y Fe(ab)t(ort)46 b Fh(partially)i(t)l(yp)t(ed)f(or)g(executing)i (command)264 b Ff(C-g)0 6144 y Fe(reco)l(v)l(er)45 b Fh(a)i(\014le)h(lost)f (b)l(y)g(a)h(system)g(crash)487 b Ff(M-x)73 b(recover-file)0 6313 y Fe(undo)46 b Fh(an)h(un)l(w)l(an)l(ted)h(c)l(hange)1403 b Ff(C-x)73 b(u)h Fh(or)g Ff(C-_)0 6481 y Fh(restore)48 b(a)g(bu\013er)f(to)g (its)g(original)h(con)l(ten)l(ts)388 b Ff(M-x)73 b(revert-buffer)0 6650 y Fh(redra)l(w)47 b(garbaged)i(screen)1607 b Ff(C-l)0 7052 y Fg(Incremen)-6 b(tal)77 b(Searc)-6 b(h)0 7396 y Fh(searc)l(h)49 b(forw)l(ard)2152 b Ff(C-s)0 7564 y Fh(searc)l(h)49 b(bac)l(kw)l(ard)2040 b Ff(C-r)0 7733 y Fh(regular)48 b(expression)i(searc)l(h)1515 b Ff(C-M-s)0 7902 y Fh(rev)l(erse)49 b(regular)f(expression)i(searc)l(h)1045 b Ff(C-M-r)0 8129 y Fh(select)48 b(previous)h(searc)l(h)g(string)1326 b Ff(M-p)0 8298 y Fh(select)48 b(next)g(later)f(searc)l(h)i(string)1241 b Ff(M-n)0 8467 y Fh(exit)47 b(incremen)l(tal)i(searc)l(h)1631 b Ff(RET)0 8636 y Fh(undo)47 b(e\013ect)h(of)g(last)f(c)l(haracter)1334 b Ff(DEL)0 8804 y Fh(ab)t(ort)47 b(curren)l(t)h(searc)l(h)1802 b Ff(C-g)0 9032 y Fh(Use)58 b Ff(C-s)e Fh(or)h Ff(C-r)f Fh(again)i(to)f(rep)t (eat)h(the)f(searc)l(h)h(in)f(either)h(direction.)93 b(If)0 9200 y(Emacs)48 b(is)f(still)g(searc)l(hing,)j Ff(C-g)c Fh(cancels)j(only)f (the)f(part)g(not)g(done.)436 9427 y Fd(c)405 9430 y Fc(\015)38 b Fd(1993)g(F)-9 b(ree)38 b(Soft)m(w)m(are)g(F)-9 b(oundation,)38 b(Inc.)50 b(P)m(ermissions)37 b(on)h(bac)m(k.)50 b(v2.0)6534 9589 y Fh(1)p eop %%Page: 2 2 2 1 bop 0 -571 a Fg(Motion)0 -220 y Fe(en)l(tit)l(y)54 b(to)f(mo)l(v)l(e)g(o) l(v)l(er)1189 b(bac)l(kw)l(ard)138 b(forw)l(ard)0 -52 y Fh(c)l(haracter)2005 b Ff(C-b)587 b(C-f)0 117 y Fh(w)l(ord)2269 b Ff(M-b)587 b(M-f)0 286 y Fh(line)2352 b Ff(C-p)587 b(C-n)0 454 y Fh(go)47 b(to)g(line)h(b)t (eginning)g(\(or)f(end\))801 b Ff(C-a)587 b(C-e)0 623 y Fh(sen)l(tence)2060 b Ff(M-a)587 b(M-e)0 792 y Fh(paragraph)1946 b Ff(M-{)587 b(M-})0 961 y Fh(page)2290 b Ff(C-x)74 b([)439 b(C-x)74 b(])0 1129 y Fh(sexp)2301 b Ff(C-M-b)439 b(C-M-f)0 1298 y Fh(function)2067 b Ff(C-M-a)439 b(C-M-e)0 1467 y Fh(go)47 b(to)g(bu\013er)h(b)t(eginning)g (\(or)f(end\))664 b Ff(M-<)587 b(M->)0 1696 y Fh(scroll)48 b(to)f(next)g(screen)1818 b Ff(C-v)0 1865 y Fh(scroll)48 b(to)f(previous)i (screen)1574 b Ff(M-v)0 2033 y Fh(scroll)48 b(left)2481 b Ff(C-x)73 b(<)0 2202 y Fh(scroll)48 b(righ)l(t)2387 b Ff(C-x)73 b(>)0 2371 y Fh(scroll)48 b(curren)l(t)g(line)g(to)f(cen)l(ter)h(of)f(screen)801 b Ff(C-u)73 b(C-l)0 2782 y Fg(Killing)k(and)i(Deleting)0 3132 y Fe(en)l(tit)l(y)54 b(to)f(kill)1691 b(bac)l(kw)l(ard)138 b(forw)l(ard)0 3301 y Fh(c)l(haracter)49 b(\(delete,)f(not)f(kill\))960 b Ff(DEL)587 b(C-d)0 3469 y Fh(w)l(ord)2269 b Ff(M-DEL)439 b(M-d)0 3638 y Fh(line)48 b(\(to)e(end)i(of)11 b(\))1633 b Ff(M-0)74 b(C-k)291 b(C-k)0 3807 y Fh(sen)l(tence)2060 b Ff(C-x)74 b(DEL)291 b(M-k)0 3975 y Fh(sexp)2301 b Ff(M--)74 b(C-M-k)143 b(C-M-k)0 4205 y Fh(kill)47 b Fe(region)2373 b Ff(C-w)0 4373 y Fh(cop)l(y)48 b(region)g(to)f(kill)g(ring)1646 b Ff(M-w)0 4542 y Fh(kill)47 b(through)h(next)f(o)t(ccurrence)j(of)d Fb(char)834 b Ff(M-z)73 b Fb(char)0 4771 y Fh(y)l(ank)48 b(bac)l(k)g(last)f(thing)g (killed)1416 b Ff(C-y)0 4940 y Fh(replace)49 b(last)e(y)l(ank)h(with)e (previous)j(kill)894 b Ff(M-y)0 5368 y Fg(Marking)0 5718 y Fh(set)47 b(mark)h(here)2208 b Ff(C-@)73 b Fh(or)h Ff(C-SPC)0 5887 y Fh(exc)l(hange)49 b(p)t(oin)l(t)e(and)h(mark)1490 b Ff(C-x)73 b(C-x)0 6116 y Fh(set)47 b(mark)h Fb(ar)-7 b(g)59 b Fe(w)l(ords)45 b Fh(a)l(w)l(a)l(y)1453 b Ff(M-@)0 6285 y Fh(mark)48 b Fe(paragraph)1962 b Ff(M-h)0 6454 y Fh(mark)48 b Fe(page)2360 b Ff(C-x)73 b(C-p)0 6622 y Fh(mark)48 b Fe(sexp)2371 b Ff(C-M-@)0 6791 y Fh(mark)48 b Fe(function)2105 b Ff(C-M-h)0 6960 y Fh(mark)48 b(en)l(tire)f Fe(bu\013er)1875 b Ff(C-x)73 b(h)0 7370 y Fg(Query)k(Replace)0 7721 y Fh(in)l(teractiv)l(ely)49 b(replace)g(a)e(text)g(string)1004 b Ff(M-\045)0 7889 y Fh(using)48 b(regular)g(expressions)765 b Ff(M-x)73 b(query-replace-regexp)0 8119 y Fh(V)-12 b(alid)48 b(resp)t(onses)i(in)d(query-replace)i(mo)t(de)f (are)0 8348 y Fe(replace)f Fh(this)g(one,)h(go)f(on)g(to)g(next)1107 b Ff(SPC)0 8517 y Fh(replace)49 b(this)e(one,)h(don't)f(mo)l(v)l(e)1318 b Ff(,)0 8685 y Fe(skip)48 b Fh(to)f(next)g(without)f(replacing)1153 b Ff(DEL)0 8854 y Fh(replace)49 b(all)e(remaining)i(matc)l(hes)1224 b Ff(!)0 9023 y Fe(bac)l(k)53 b(up)46 b Fh(to)h(the)g(previous)i(matc)l(h) 1095 b Ff(^)0 9191 y Fe(exit)48 b Fh(query-replace)1916 b Ff(ESC)0 9360 y Fh(en)l(ter)48 b(recursiv)l(e)h(edit)e(\()p Ff(C-M-c)f Fh(to)h(exit\))896 b Ff(C-r)6534 9589 y Fh(2)p eop %%Page: 3 3 3 2 bop 0 -571 a Fg(Multiple)77 b(Windo)-6 b(ws)0 -297 y Fh(delete)48 b(all)f(other)h(windo)l(ws)1559 b Ff(C-x)73 b(1)0 -128 y Fh(delete)48 b(this)f(windo)l(w)1903 b Ff(C-x)73 b(0)0 40 y Fh(split)47 b(windo)l(w)g(in)g(t)l(w)l(o)f(v)l(ertically)1229 b Ff(C-x)73 b(2)0 209 y Fh(split)47 b(windo)l(w)g(in)g(t)l(w)l(o)f(horizon)l(tally)1069 b Ff(C-x)73 b(3)0 419 y Fh(scroll)48 b(other)g(windo)l(w)1847 b Ff(C-M-v)0 588 y Fh(switc)l(h)47 b(cursor)i(to)d(another)i(windo)l(w)1038 b Ff(C-x)73 b(o)0 798 y Fh(shrink)48 b(windo)l(w)e(shorter)1385 b Ff(M-x)73 b(shrink-window)0 966 y Fh(gro)l(w)47 b(windo)l(w)g(taller)1876 b Ff(C-x)73 b(^)0 1135 y Fh(shrink)48 b(windo)l(w)e(narro)l(w)l(er)1571 b Ff(C-x)73 b({)0 1304 y Fh(gro)l(w)47 b(windo)l(w)g(wider)1860 b Ff(C-x)73 b(})0 1514 y Fh(select)48 b(bu\013er)g(in)f(other)h(windo)l(w) 1265 b Ff(C-x)73 b(4)h(b)0 1683 y Fh(displa)l(y)48 b(bu\013er)g(in)f(other)g (windo)l(w)1172 b Ff(C-x)73 b(4)h(C-o)0 1851 y Fh(\014nd)47 b(\014le)h(in)f(other)g(windo)l(w)1544 b Ff(C-x)73 b(4)h(f)0 2020 y Fh(\014nd)47 b(\014le)h(read-only)g(in)f(other)g(windo)l(w)923 b Ff(C-x)73 b(4)h(r)0 2189 y Fh(run)47 b(Dired)h(in)f(other)h(windo)l(w)1404 b Ff(C-x)73 b(4)h(d)0 2357 y Fh(\014nd)47 b(tag)g(in)g(other)h(windo)l(w)1528 b Ff(C-x)73 b(4)h(.)0 2672 y Fg(F)-19 b(ormatting)0 2946 y Fh(inden)l(t)47 b(curren)l(t)h Fe(line)h Fh(\(mo)t(de-dep)t(enden)l(t\))706 b Ff(TAB)0 3115 y Fh(inden)l(t)47 b Fe(region)g Fh(\(mo)t(de-dep)t(enden)l (t\))1012 b Ff(C-M-\\)0 3283 y Fh(inden)l(t)47 b Fe(sexp)g Fh(\(mo)t(de-dep)t(enden)l(t\))1136 b Ff(C-M-q)0 3452 y Fh(inden)l(t)47 b(region)i(rigidly)e Fb(ar)-7 b(g)59 b Fh(columns)1004 b Ff(C-x)73 b(TAB)0 3662 y Fh(insert)48 b(newline)f(after)h(p)t(oin)l(t)1496 b Ff(C-o)0 3831 y Fh(mo)l(v)l(e)48 b(rest)g(of)f(line)g(v)l(ertically)i(do)l (wn)1047 b Ff(C-M-o)0 3999 y Fh(delete)48 b(blank)g(lines)g(around)g(p)t(oin) l(t)1137 b Ff(C-x)73 b(C-o)0 4168 y Fh(join)47 b(line)h(with)e(previous)j (\(with)d(arg,)h(next\))645 b Ff(M-^)0 4337 y Fh(delete)48 b(all)f(white)g(space)i(around)f(p)t(oin)l(t)891 b Ff(M-\\)0 4505 y Fh(put)47 b(exactly)h(one)g(space)g(at)f(p)t(oin)l(t)1181 b Ff(M-SPC)0 4715 y Fh(\014ll)47 b(paragraph)2221 b Ff(M-q)0 4884 y Fh(set)47 b(\014ll)h(column)2181 b Ff(C-x)73 b(f)0 5053 y Fh(set)47 b(pre\014x)h(eac)l(h)h(line)e(starts)h(with)1185 b Ff(C-x)73 b(.)0 5368 y Fg(Case)k(Change)0 5641 y Fh(upp)t(ercase)49 b(w)l(ord)2094 b Ff(M-u)0 5810 y Fh(lo)l(w)l(ercase)49 b(w)l(ord)2129 b Ff(M-l)0 5979 y Fh(capitalize)49 b(w)l(ord)2122 b Ff(M-c)0 6189 y Fh(upp)t(ercase)49 b(region)2021 b Ff(C-x)73 b(C-u)0 6357 y Fh(lo)l(w)l(ercase)49 b(region)2056 b Ff(C-x)73 b(C-l)0 6526 y Fh(capitalize)49 b(region)1515 b Ff(M-x)73 b(capitalize-region)0 6858 y Fg(The)78 b(Minibu\013er)0 7132 y Fh(The)47 b(follo)l(wing)h(k)l(eys)g (are)g(de\014ned)g(in)f(the)g(minibu\013er.)0 7342 y(complete)i(as)e(m)l(uc)l (h)h(as)g(p)t(ossible)1254 b Ff(TAB)0 7510 y Fh(complete)49 b(up)e(to)f(one)i(w)l(ord)1521 b Ff(SPC)0 7679 y Fh(complete)49 b(and)e(execute)1726 b Ff(RET)0 7848 y Fh(sho)l(w)47 b(p)t(ossible)i (completions)1446 b Ff(?)0 8017 y Fh(fetc)l(h)48 b(previous)g(minibu\013er)g (input)1141 b Ff(M-p)0 8185 y Fh(fetc)l(h)48 b(next)f(later)g(minibu\013er)h (input)1056 b Ff(M-n)0 8354 y Fh(regexp)48 b(searc)l(h)h(bac)l(kw)l(ard)f (through)g(history)585 b Ff(M-r)0 8523 y Fh(regexp)48 b(searc)l(h)h(forw)l (ard)f(through)f(history)698 b Ff(M-s)0 8691 y Fh(ab)t(ort)47 b(command)2077 b Ff(C-g)0 8901 y Fh(T)l(yp)t(e)43 b Ff(C-x)73 b(ESC)g(ESC)42 b Fh(to)g(edit)h(and)f(rep)t(eat)i(the)e(last)h(command)h (that)e(used)0 9070 y(the)47 b(minibu\013er.)64 b(The)47 b(follo)l(wing)g(k)l (eys)i(are)e(then)h(de\014ned.)0 9280 y(previous)h(minibu\013er)f(command) 1220 b Ff(M-p)0 9449 y Fh(next)47 b(minibu\013er)h(command)1464 b Ff(M-n)6534 9589 y Fh(3)p eop %%Page: 4 4 4 3 bop 268 -542 a Fi(GNU)92 b(Emacs)h(Reference)g(Card)0 -71 y Fg(Bu\013ers)0 279 y Fh(select)48 b(another)g(bu\013er)1794 b Ff(C-x)73 b(b)0 448 y Fh(list)47 b(all)g(bu\013ers)2208 b Ff(C-x)73 b(C-b)0 617 y Fh(kill)47 b(a)g(bu\013er)2338 b Ff(C-x)73 b(k)0 1027 y Fg(T)-19 b(ransp)6 b(osing)0 1378 y Fh(transp)t(ose)49 b Fe(c)l(haracters)1694 b Ff(C-t)0 1546 y Fh(transp)t(ose)49 b Fe(w)l(ords)2002 b Ff(M-t)0 1715 y Fh(transp)t(ose)49 b Fe(lines)2101 b Ff(C-x)73 b(C-t)0 1884 y Fh(transp)t(ose)49 b Fe(sexps)2040 b Ff(C-M-t)0 2295 y Fg(Sp)6 b(elling)78 b(Chec)-6 b(k)0 2645 y Fh(c)l(hec)l(k)49 b(sp)t(elling)f(of)f(curren)l(t)h(w)l(ord)1207 b Ff(M-$)0 2814 y Fh(c)l(hec)l(k)49 b(sp)t(elling)f(of)f(all)h(w)l(ords)f(in) g(region)565 b Ff(M-x)73 b(ispell-region)0 2982 y Fh(c)l(hec)l(k)49 b(sp)t(elling)f(of)f(en)l(tire)h(bu\013er)952 b Ff(M-x)73 b(ispell-buffer)0 3409 y Fg(T)-19 b(ags)0 3759 y Fh(\014nd)47 b(a)g(tag)g(\(a)g(de\014nition\)) 1604 b Ff(M-.)0 3928 y Fh(\014nd)47 b(next)g(o)t(ccurrence)j(of)d(tag)1396 b Ff(C-u)73 b(M-.)0 4096 y Fh(sp)t(ecify)48 b(a)g(new)f(tags)g(\014le)1240 b Ff(M-x)73 b(visit-tags-table)0 4325 y Fh(regexp)48 b(searc)l(h)h(on)f(all)f (\014les)h(in)f(tags)g(table)439 b Ff(M-x)73 b(tags-search)0 4494 y Fh(run)47 b(query-replace)j(on)d(all)g(the)g(\014les)448 b Ff(M-x)73 b(tags-query-replace)0 4663 y Fh(con)l(tin)l(ue)48 b(last)g(tags)f(searc)l(h)i(or)e(query-replace)505 b Ff(M-,)0 5074 y Fg(Shells)0 5424 y Fh(execute)49 b(a)e(shell)h(command)1514 b Ff(M-!)0 5593 y Fh(run)47 b(a)g(shell)h(command)h(on)e(the)g(region)900 b Ff(M-|)0 5761 y Fh(\014lter)47 b(region)h(through)g(a)f(shell)h(command)728 b Ff(C-u)73 b(M-|)0 5930 y Fh(start)47 b(a)g(shell)h(in)f(windo)l(w)g Ff(*shell*)784 b(M-x)73 b(shell)0 6341 y Fg(Rectangles)0 6691 y Fh(cop)l(y)48 b(rectangle)h(to)e(register)1493 b Ff(C-x)73 b(r)h(r)0 6860 y Fh(kill)47 b(rectangle)2257 b Ff(C-x)73 b(r)h(k)0 7029 y Fh(y)l(ank)48 b(rectangle)2155 b Ff(C-x)73 b(r)h(y)0 7197 y Fh(op)t(en)48 b(rectangle,)h(shifting)e(text)g(righ)l(t)977 b Ff(C-x)73 b(r)h(o)0 7366 y Fh(blank)48 b(out)f(rectangle)1472 b Ff(M-x)73 b(clear-rectangle)0 7535 y Fh(pre\014x)48 b(eac)l(h)g(line)g (with)e(a)h(string)822 b Ff(M-x)73 b(string-rectangle)0 7963 y Fg(Abbrevs)0 8313 y Fh(add)47 b(global)h(abbrev)1944 b Ff(C-x)73 b(a)h(g)0 8482 y Fh(add)47 b(mo)t(de-lo)t(cal)i(abbrev)1647 b Ff(C-x)73 b(a)h(l)0 8650 y Fh(add)47 b(global)h(expansion)h(for)e(this)h (abbrev)801 b Ff(C-x)73 b(a)h(i)f(g)0 8819 y Fh(add)47 b(mo)t(de-lo)t(cal)i (expansion)g(for)e(this)g(abbrev)505 b Ff(C-x)73 b(a)h(i)f(l)0 8988 y Fh(explicitly)48 b(expand)g(abbrev)1534 b Ff(C-x)73 b(a)h(e)0 9217 y Fh(expand)48 b(previous)h(w)l(ord)e(dynamically)912 b Ff(M-/)6534 9589 y Fh(4)p eop %%Page: 5 5 5 4 bop 0 -571 a Fg(Regular)77 b(Expressions)0 -220 y Fh(an)l(y)48 b(single)g(c)l(haracter)h(except)f(a)f(newline)759 b Ff(.)147 b Fh(\(dot\))0 -52 y(zero)48 b(or)f(more)h(rep)t(eats)1786 b Ff(*)0 117 y Fh(one)48 b(or)f(more)h(rep)t(eats)1825 b Ff(+)0 286 y Fh(zero)48 b(or)f(one)h(rep)t(eat)1935 b Ff(?)0 454 y Fh(an)l(y)48 b(c)l(haracter)g(in)f(the)h(set)1590 b Ff([)74 b Fa(:)23 b(:)g(:)74 b Ff(])0 623 y Fh(an)l(y)48 b(c)l(haracter)g(not)f(in)g (the)g(set)1341 b Ff([^)73 b Fa(:)23 b(:)g(:)75 b Ff(])0 792 y Fh(b)t(eginning)48 b(of)f(line)2026 b Ff(^)0 961 y Fh(end)48 b(of)f(line)2404 b Ff($)0 1129 y Fh(quote)48 b(a)f(sp)t(ecial)h(c)l(haracter) h Fb(c)1408 b Ff(\\)p Fb(c)0 1298 y Fh(alternativ)l(e)48 b(\(\\or"\))1970 b Ff(\\|)0 1467 y Fh(grouping)2510 b Ff(\\\()73 b Fa(:)23 b(:)g(:)75 b Ff(\\\))0 1635 y Fb(n)11 b Fh(th)46 b(group)2428 b Ff(\\)p Fb(n)0 1804 y Fh(b)t(eginning)48 b(of)f(bu\013er)1889 b Ff(\\`)0 1973 y Fh(end)48 b(of)f(bu\013er)2267 b Ff(\\')0 2141 y Fh(w)l(ord)47 b(break)2361 b Ff(\\b)0 2310 y Fh(not)47 b(b)t(eginning)h(or)f(end)h(of)f(w)l (ord)1255 b Ff(\\B)0 2479 y Fh(b)t(eginning)48 b(of)f(w)l(ord)1943 b Ff(\\<)0 2648 y Fh(end)48 b(of)f(w)l(ord)2321 b Ff(\\>)0 2816 y Fh(an)l(y)48 b(w)l(ord-syn)l(tax)f(c)l(haracter)1420 b Ff(\\w)0 2985 y Fh(an)l(y)48 b(non-w)l(ord-syn)l(tax)g(c)l(haracter)1146 b Ff(\\W)0 3154 y Fh(c)l(haracter)49 b(with)d(syn)l(tax)i Fb(c)1599 b Ff(\\s)p Fb(c)0 3322 y Fh(c)l(haracter)49 b(with)d(syn)l(tax)i(not)f Fb(c)1349 b Ff(\\S)p Fb(c)0 3733 y Fg(Registers)0 4083 y Fh(sa)l(v)l(e)48 b(region)h(in)e(register)1707 b Ff(C-x)73 b(r)h(s)0 4252 y Fh(insert)48 b(register)g(con)l(ten)l(ts)g(in)l(to)f(bu\013er)960 b Ff(C-x)73 b(r)h(i)0 4481 y Fh(sa)l(v)l(e)48 b(v)-8 b(alue)49 b(of)e(p)t(oin)l(t)g(in)g(register)1239 b Ff(C-x)73 b(r)h(SPC)0 4650 y Fh(jump)47 b(to)g(p)t(oin)l(t)g(sa)l(v)l(ed)i(in)e(register)1149 b Ff(C-x)73 b(r)h(j)0 5078 y Fg(Info)0 5428 y Fh(en)l(ter)48 b(the)f(Info)g(do)t(cumen)l(tation)i(reader)818 b Ff(C-h)73 b(i)0 5658 y Fh(Mo)l(ving)48 b(within)e(a)h(no)t(de:)141 5887 y(scroll)h(forw)l(ard)2070 b Ff(SPC)141 6056 y Fh(scroll)48 b(rev)l(erse)2118 b Ff(DEL)141 6224 y Fh(b)t(eginning)48 b(of)f(no)t(de)1811 b Ff(.)147 b Fh(\(dot\))0 6454 y(Mo)l(ving)48 b(b)t(et)l(w)l(een)g(no)t(des:) 141 6683 y Fe(next)f Fh(no)t(de)2256 b Ff(n)141 6851 y Fe(previous)47 b Fh(no)t(de)1973 b Ff(p)141 7020 y Fh(mo)l(v)l(e)48 b Fe(up)2364 b Ff(u)141 7189 y Fh(select)48 b(men)l(u)g(item)f(b)l(y)g(name)1303 b Ff(m)141 7358 y Fh(select)48 b Fb(n)11 b Fh(th)47 b(men)l(u)g(item)h(b)l(y) f(n)l(um)l(b)t(er)h(\(1{5\))528 b Fb(n)141 7526 y Fh(follo)l(w)47 b(cross)h(reference)i(\(return)d(with)f Ff(l)p Fh(\))631 b Ff(f)141 7695 y Fh(return)47 b(to)g(last)g(no)t(de)h(y)l(ou)f(sa)l(w)1211 b Ff(l)141 7864 y Fh(return)47 b(to)g(directory)h(no)t(de)1415 b Ff(d)141 8032 y Fh(go)47 b(to)g(an)l(y)g(no)t(de)h(b)l(y)f(name)1421 b Ff(g)0 8262 y Fh(Other:)141 8491 y(run)47 b(Info)g Fe(tutorial)1829 b Ff(h)141 8659 y Fh(list)47 b(Info)g(commands)1736 b Ff(?)141 8828 y Fe(quit)47 b Fh(Info)2336 b Ff(q)141 8997 y Fh(searc)l(h)48 b(no)t(des)h(for)e(regexp)1469 b Ff(s)6534 9589 y Fh(5)p eop %%Page: 6 6 6 5 bop 0 -571 a Fg(Keyb)6 b(oard)79 b(Macros)0 -220 y Fe(start)46 b Fh(de\014ning)i(a)f(k)l(eyb)t(oard)h(macro)1035 b Ff(C-x)73 b(\()0 -52 y Fe(end)47 b Fh(k)l(eyb)t(oard)h(macro)g(de\014nition)1139 b Ff(C-x)73 b(\))0 117 y Fe(execute)47 b Fh(last-de\014ned)i(k)l(eyb)t(oard)f (macro)735 b Ff(C-x)73 b(e)0 286 y Fh(app)t(end)48 b(to)f(last)g(k)l(eyb)t (oard)i(macro)1130 b Ff(C-u)73 b(C-x)g(\()0 454 y Fh(name)48 b(last)f(k)l(eyb)t(oard)i(macro)741 b Ff(M-x)74 b(name-last-kbd-macro)0 623 y Fh(insert)48 b(Lisp)f(de\014nition)h(in)f(bu\013er)745 b Ff(M-x)73 b(insert-kbd-macro)0 1034 y Fg(Commands)79 b(Dealing)e(with)g (Emacs)h(Lisp)0 1384 y Fh(ev)-8 b(al)48 b Fe(sexp)f Fh(b)t(efore)h(p)t(oin)l (t)1661 b Ff(C-x)73 b(C-e)0 1553 y Fh(ev)-8 b(al)48 b(curren)l(t)g Fe(defun)1881 b Ff(C-M-x)0 1722 y Fh(ev)-8 b(al)48 b Fe(region)2031 b Ff(M-x)73 b(eval-region)0 1890 y Fh(ev)-8 b(al)48 b(en)l(tire)g Fe(bu\013er)1271 b Ff(M-x)74 b(eval-current-buffer)0 2059 y Fh(read)48 b(and)f(ev)-8 b(al)48 b(minibu\013er)1549 b Ff(M-ESC)0 2228 y Fh(re-execute)49 b(last)e(minibu\013er)h(command)846 b Ff(C-x)73 b(ESC)g(ESC)0 2396 y Fh(read)48 b(and)f(ev)-8 b(al)48 b(Emacs)g(Lisp)f(\014le)948 b Ff(M-x)73 b(load-file)0 2565 y Fh(load)48 b(from)f(standard)h(system)g(directory)513 b Ff(M-x)73 b(load-library)0 2993 y Fg(Simple)k(Customization)0 3343 y Fh(Here)37 b(are)f(some)h(examples)g(of)f(binding)g(global)g(k)l(eys)h(in)f (Emacs)g(Lisp.)59 b(Note)0 3512 y(that)47 b(y)l(ou)g(cannot)h(sa)l(y)g Ff("\\M-#")p Fh(;)e(y)l(ou)h(m)l(ust)g(sa)l(y)h Ff("\\e#")p Fh(.)0 3741 y Ff(\(global-set-key)71 b("\\C-cg")h('goto-line\))0 3910 y(\(global-set-key)f("\\C-x\\C-k")h('kill-region\))0 4079 y(\(global-set-key)f("\\e#")i('query-replace-regexp\))0 4308 y Fh(An)47 b(example)i(of)e(setting)h(a)f(v)-8 b(ariable)48 b(in)f(Emacs)h(Lisp:)0 4537 y Ff(\(setq)73 b(backup-by-copying-when-linked)68 b(t\))0 4965 y Fg(W)-19 b(riting)76 b(Commands)0 5316 y Ff(\(defun)d Fb(c)-7 b(ommand-name)83 b Ff(\()p Fb(ar)-7 b(gs)12 b Ff(\))148 5484 y(")p Fb(do)-7 b(cumentation)11 b Ff(")148 5653 y(\(interactive)71 b(")p Fb(template)11 b Ff("\))148 5822 y Fb(b)-7 b(o)g(dy)12 b Ff(\))0 6051 y Fh(An)47 b(example:)0 6280 y Ff(\(defun)73 b(this-line-to-top-of-window)68 b(\(line\))148 6449 y("Reposition)j(line)i (point)g(is)h(on)f(to)g(top)h(of)f(window.)0 6618 y(With)g(ARG,)g(put)g (point)g(on)h(line)f(ARG.)0 6786 y(Negative)f(counts)h(from)g(bottom.")148 6955 y(\(interactive)e("P"\))148 7124 y(\(recenter)h(\(if)h(\(null)g(line\)) 1181 7292 y(0)1033 7461 y(\(prefix-numeric-value)d(line\)\)\)\))0 7690 y Fh(The)39 b(argumen)l(t)h(to)e Ff(interactive)f Fh(is)i(a)g(string)g (sp)t(ecifying)i(ho)l(w)e(to)g(get)g(the)0 7859 y(argumen)l(ts)59 b(when)e(the)g(function)g(is)h(called)g(in)l(teractiv)l(ely)-12 b(.)95 b(T)l(yp)t(e)57 b Ff(C-h)73 b(f)0 8028 y(interactive)45 b Fh(for)i(more)h(information.)805 8407 y Fd(Cop)m(yrigh)m(t)1364 8404 y(c)1332 8407 y Fc(\015)38 b Fd(1993)g(F)-9 b(ree)38 b(Soft)m(w)m(are)g (F)-9 b(oundation,)38 b(Inc.)958 8542 y(designed)h(b)m(y)f(Stephen)g(Gildea,) i(Ma)m(y)e(1993)g(v2.0)951 8677 y(for)g(GNU)g(Emacs)e(v)m(ersion)j(19)f(on)g (Unix)h(systems)0 8872 y(P)m(ermission)c(is)g(gran)m(ted)g(to)g(mak)m(e)f (and)h(distribute)h(copies)g(of)f(this)g(card)g(pro)m(vided)h(the)f(cop)m(y-) 0 9007 y(righ)m(t)k(notice)f(and)h(this)f(p)s(ermission)g(notice)h(are)e (preserv)m(ed)h(on)g(all)i(copies.)0 9203 y(F)-9 b(or)35 b(copies)h(of)f(the) g(GNU)g(Emacs)f(man)m(ual,)i(write)h(to)e(the)g(F)-9 b(ree)35 b(Soft)m(w)m(are)g(F)-9 b(oundation,)37 b(Inc.,)0 9338 y(675)h(Massac)m(h)m (usetts)e(Av)m(e,)i(Cam)m(bridge)g(MA)g(02139.)6534 9589 y Fh(6)p eop %%Trailer end userdict /end-hook known{end-hook}if SafetyEnclosure restore %%EOF emacs-19.30/etc/refcard.tex100666 12120 13 46664 5770132476 13622 0ustar rmsuser% Reference Card for GNU Emacs version 19 on Unix systems % Time-stamp: <93/05/21 12:52:26 gildea> %**start of header \newcount\columnsperpage % This file can be printed with 1, 2, or 3 columns per page (see below). % Specify how many you want here. Nothing else needs to be changed. \columnsperpage=1 % Copyright (c) 1987, 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. % This file is intended to be processed by plain TeX (TeX82). % % The final reference card has six columns, three on each side. % This file can be used to produce it in any of three ways: % 1 column per page % produces six separate pages, each of which needs to be reduced to 80%. % This gives the best resolution. % 2 columns per page % produces three already-reduced pages. % You will still need to cut and paste. % 3 columns per page % produces two pages which must be printed sideways to make a % ready-to-use 8.5 x 11 inch reference card. % For this you need a dvi device driver that can print sideways. % Which mode to use is controlled by setting \columnsperpage above. % % Author: % Stephen Gildea % Internet: gildea@mit.edu % % Thanks to Paul Rubin, Bob Chassell, Len Tower, and Richard Mlynarik % for their many good ideas. % If there were room, it would be nice to see a section on Dired. \def\versionnumber{2.0} \def\year{1993} \def\version{May \year\ v\versionnumber} \def\shortcopyrightnotice{\vskip 1ex plus 2 fill \centerline{\small \copyright\ \year\ Free Software Foundation, Inc. Permissions on back. v\versionnumber}} \def\copyrightnotice{ \vskip 1ex plus 2 fill\begingroup\small \centerline{Copyright \copyright\ \year\ Free Software Foundation, Inc.} \centerline{designed by Stephen Gildea, \version} \centerline{for GNU Emacs version 19 on Unix systems} Permission is granted to make and distribute copies of this card provided the copyright notice and this permission notice are preserved on all copies. For copies of the GNU Emacs manual, write to the Free Software Foundation, Inc., 675 Massachusetts Ave, Cambridge MA 02139. \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below % can be scanned without complaint. \def\bye{\par\vfill\supereject\end} \newdimen\intercolumnskip %horizontal space between columns \newbox\columna %boxes to hold columns already built \newbox\columnb \def\ncolumns{\the\columnsperpage} \message{[\ncolumns\space column\if 1\ncolumns\else s\fi\space per page]} \def\scaledmag#1{ scaled \magstep #1} % This multi-way format was designed by Stephen Gildea October 1986. % Note that the 1-column format is fontfamily-independent. \if 1\ncolumns %one-column format uses normal size \hsize 4in \vsize 10in \voffset -.7in \font\titlefont=\fontname\tenbf \scaledmag3 \font\headingfont=\fontname\tenbf \scaledmag2 \font\smallfont=\fontname\sevenrm \font\smallsy=\fontname\sevensy \footline{\hss\folio} \def\makefootline{\baselineskip10pt\hsize6.5in\line{\the\footline}} \else %2 or 3 columns uses prereduced size \hsize 3.2in \vsize 7.95in \hoffset -.75in \voffset -.745in \font\titlefont=cmbx10 \scaledmag2 \font\headingfont=cmbx10 \scaledmag1 \font\smallfont=cmr6 \font\smallsy=cmsy6 \font\eightrm=cmr8 \font\eightbf=cmbx8 \font\eightit=cmti8 \font\eighttt=cmtt8 \font\eightmi=cmmi8 \font\eightsy=cmsy8 \textfont0=\eightrm \textfont1=\eightmi \textfont2=\eightsy \def\rm{\eightrm} \def\bf{\eightbf} \def\it{\eightit} \def\tt{\eighttt} \normalbaselineskip=.8\normalbaselineskip \normallineskip=.8\normallineskip \normallineskiplimit=.8\normallineskiplimit \normalbaselines\rm %make definitions take effect \if 2\ncolumns \let\maxcolumn=b \footline{\hss\rm\folio\hss} \def\makefootline{\vskip 2in \hsize=6.86in\line{\the\footline}} \else \if 3\ncolumns \let\maxcolumn=c \nopagenumbers \else \errhelp{You must set \columnsperpage equal to 1, 2, or 3.} \errmessage{Illegal number of columns per page} \fi\fi \intercolumnskip=.46in \def\abc{a} \output={% %see The TeXbook page 257 % This next line is useful when designing the layout. %\immediate\write16{Column \folio\abc\space starts with \firstmark} \if \maxcolumn\abc \multicolumnformat \global\def\abc{a} \else\if a\abc \global\setbox\columna\columnbox \global\def\abc{b} %% in case we never use \columnb (two-column mode) \global\setbox\columnb\hbox to -\intercolumnskip{} \else \global\setbox\columnb\columnbox \global\def\abc{c}\fi\fi} \def\multicolumnformat{\shipout\vbox{\makeheadline \hbox{\box\columna\hskip\intercolumnskip \box\columnb\hskip\intercolumnskip\columnbox} \makefootline}\advancepageno} \def\columnbox{\leftline{\pagebody}} \def\bye{\par\vfill\supereject \if a\abc \else\null\vfill\eject\fi \if a\abc \else\null\vfill\eject\fi \end} \fi % we won't be using math mode much, so redefine some of the characters % we might want to talk about \catcode`\^=12 \catcode`\_=12 \chardef\\=`\\ \chardef\{=`\{ \chardef\}=`\} \hyphenation{mini-buf-fer} \parindent 0pt \parskip 1ex plus .5ex minus .5ex \def\small{\smallfont\textfont2=\smallsy\baselineskip=.8\baselineskip} % newcolumn - force a new column. Use sparingly, probably only for % the first column of a page, which should have a title anyway. \outer\def\newcolumn{\vfill\eject} % title - page title. Argument is title text. \outer\def\title#1{{\titlefont\centerline{#1}}\vskip 1ex plus .5ex} % section - new major section. Argument is section name. \outer\def\section#1{\par\filbreak \vskip 3ex plus 2ex minus 2ex {\headingfont #1}\mark{#1}% \vskip 2ex plus 1ex minus 1.5ex} \newdimen\keyindent % beginindentedkeys...endindentedkeys - key definitions will be % indented, but running text, typically used as headings to group % definitions, will not. \def\beginindentedkeys{\keyindent=1em} \def\endindentedkeys{\keyindent=0em} \endindentedkeys % paralign - begin paragraph containing an alignment. % If an \halign is entered while in vertical mode, a parskip is never % inserted. Using \paralign instead of \halign solves this problem. \def\paralign{\vskip\parskip\halign} % \<...> - surrounds a variable name in a code example \def\<#1>{{\it #1\/}} % kbd - argument is characters typed literally. Like the Texinfo command. \def\kbd#1{{\tt#1}\null} %\null so not an abbrev even if period follows % beginexample...endexample - surrounds literal text, such a code example. % typeset in a typewriter font with line breaks preserved \def\beginexample{\par\leavevmode\begingroup \obeylines\obeyspaces\parskip0pt\tt} {\obeyspaces\global\let =\ } \def\endexample{\endgroup} % key - definition of a key. % \key{description of key}{key-name} % prints the description left-justified, and the key-name in a \kbd % form near the right margin. \def\key#1#2{\leavevmode\hbox to \hsize{\vtop {\hsize=.75\hsize\rightskip=1em \hskip\keyindent\relax#1}\kbd{#2}\hfil}} \newbox\metaxbox \setbox\metaxbox\hbox{\kbd{M-x }} \newdimen\metaxwidth \metaxwidth=\wd\metaxbox % metax - definition of a M-x command. % \metax{description of command}{M-x command-name} % Tries to justify the beginning of the command name at the same place % as \key starts the key name. (The "M-x " sticks out to the left.) \def\metax#1#2{\leavevmode\hbox to \hsize{\hbox to .75\hsize {\hskip\keyindent\relax#1\hfil}% \hskip -\metaxwidth minus 1fil \kbd{#2}\hfil}} % threecol - like "key" but with two key names. % for example, one for doing the action backward, and one for forward. \def\threecol#1#2#3{\hskip\keyindent\relax#1\hfil&\kbd{#2}\hfil\quad &\kbd{#3}\hfil\quad\cr} %**end of header \title{GNU Emacs Reference Card} \centerline{(for version 19)} \section{Starting Emacs} To enter GNU Emacs 19, just type its name: \kbd{emacs} To read in a file to edit, see Files, below. \section{Leaving Emacs} \key{suspend Emacs (or iconify it under X)}{C-z} \key{exit Emacs permanently}{C-x C-c} \section{Files} \key{{\bf read} a file into Emacs}{C-x C-f} \key{{\bf save} a file back to disk}{C-x C-s} \key{save {\bf all} files}{C-x s} \key{{\bf insert} contents of another file into this buffer}{C-x i} \key{replace this file with the file you really want}{C-x C-v} \key{write buffer to a specified file}{C-x C-w} \section{Getting Help} The Help system is simple. Type \kbd{C-h} and follow the directions. If you are a first-time user, type \kbd{C-h t} for a {\bf tutorial}. \key{remove Help window}{C-x 1} \key{scroll Help window}{ESC C-v} \key{apropos: show commands matching a string}{C-h a} \key{show the function a key runs}{C-h c} \key{describe a function}{C-h f} \key{get mode-specific information}{C-h m} \section{Error Recovery} \key{{\bf abort} partially typed or executing command}{C-g} \metax{{\bf recover} a file lost by a system crash}{M-x recover-file} \key{{\bf undo} an unwanted change}{C-x u {\rm or} C-_} \metax{restore a buffer to its original contents}{M-x revert-buffer} \key{redraw garbaged screen}{C-l} \section{Incremental Search} \key{search forward}{C-s} \key{search backward}{C-r} \key{regular expression search}{C-M-s} \key{reverse regular expression search}{C-M-r} \key{select previous search string}{M-p} \key{select next later search string}{M-n} \key{exit incremental search}{RET} \key{undo effect of last character}{DEL} \key{abort current search}{C-g} Use \kbd{C-s} or \kbd{C-r} again to repeat the search in either direction. If Emacs is still searching, \kbd{C-g} cancels only the part not done. \shortcopyrightnotice \section{Motion} \paralign to \hsize{#\tabskip=10pt plus 1 fil&#\tabskip=0pt&#\cr \threecol{{\bf entity to move over}}{{\bf backward}}{{\bf forward}} \threecol{character}{C-b}{C-f} \threecol{word}{M-b}{M-f} \threecol{line}{C-p}{C-n} \threecol{go to line beginning (or end)}{C-a}{C-e} \threecol{sentence}{M-a}{M-e} \threecol{paragraph}{M-\{}{M-\}} \threecol{page}{C-x [}{C-x ]} \threecol{sexp}{C-M-b}{C-M-f} \threecol{function}{C-M-a}{C-M-e} \threecol{go to buffer beginning (or end)}{M-<}{M->} } \key{scroll to next screen}{C-v} \key{scroll to previous screen}{M-v} \key{scroll left}{C-x <} \key{scroll right}{C-x >} \key{scroll current line to center of screen}{C-u C-l} \section{Killing and Deleting} \paralign to \hsize{#\tabskip=10pt plus 1 fil&#\tabskip=0pt&#\cr \threecol{{\bf entity to kill}}{{\bf backward}}{{\bf forward}} \threecol{character (delete, not kill)}{DEL}{C-d} \threecol{word}{M-DEL}{M-d} \threecol{line (to end of)}{M-0 C-k}{C-k} \threecol{sentence}{C-x DEL}{M-k} \threecol{sexp}{M-- C-M-k}{C-M-k} } \key{kill {\bf region}}{C-w} \key{copy region to kill ring}{M-w} \key{kill through next occurrence of {\it char}}{M-z {\it char}} \key{yank back last thing killed}{C-y} \key{replace last yank with previous kill}{M-y} \section{Marking} \key{set mark here}{C-@ {\rm or} C-SPC} \key{exchange point and mark}{C-x C-x} \key{set mark {\it arg\/} {\bf words} away}{M-@} \key{mark {\bf paragraph}}{M-h} \key{mark {\bf page}}{C-x C-p} \key{mark {\bf sexp}}{C-M-@} \key{mark {\bf function}}{C-M-h} \key{mark entire {\bf buffer}}{C-x h} \section{Query Replace} \key{interactively replace a text string}{M-\%} \metax{using regular expressions}{M-x query-replace-regexp} Valid responses in query-replace mode are \key{{\bf replace} this one, go on to next}{SPC} \key{replace this one, don't move}{,} \key{{\bf skip} to next without replacing}{DEL} \key{replace all remaining matches}{!} \key{{\bf back up} to the previous match}{^} \key{{\bf exit} query-replace}{ESC} \key{enter recursive edit (\kbd{C-M-c} to exit)}{C-r} \section{Multiple Windows} \key{delete all other windows}{C-x 1} \key{delete this window}{C-x 0} \key{split window in two vertically}{C-x 2} \key{split window in two horizontally}{C-x 3} \key{scroll other window}{C-M-v} \key{switch cursor to another window}{C-x o} \metax{shrink window shorter}{M-x shrink-window} \key{grow window taller}{C-x ^} \key{shrink window narrower}{C-x \{} \key{grow window wider}{C-x \}} \key{select buffer in other window}{C-x 4 b} \key{display buffer in other window}{C-x 4 C-o} \key{find file in other window}{C-x 4 f} \key{find file read-only in other window}{C-x 4 r} \key{run Dired in other window}{C-x 4 d} \key{find tag in other window}{C-x 4 .} \section{Formatting} \key{indent current {\bf line} (mode-dependent)}{TAB} \key{indent {\bf region} (mode-dependent)}{C-M-\\} \key{indent {\bf sexp} (mode-dependent)}{C-M-q} \key{indent region rigidly {\it arg\/} columns}{C-x TAB} \key{insert newline after point}{C-o} \key{move rest of line vertically down}{C-M-o} \key{delete blank lines around point}{C-x C-o} \key{join line with previous (with arg, next)}{M-^} \key{delete all white space around point}{M-\\} \key{put exactly one space at point}{M-SPC} \key{fill paragraph}{M-q} \key{set fill column}{C-x f} \key{set prefix each line starts with}{C-x .} \section{Case Change} \key{uppercase word}{M-u} \key{lowercase word}{M-l} \key{capitalize word}{M-c} \key{uppercase region}{C-x C-u} \key{lowercase region}{C-x C-l} \metax{capitalize region}{M-x capitalize-region} \section{The Minibuffer} The following keys are defined in the minibuffer. \key{complete as much as possible}{TAB} \key{complete up to one word}{SPC} \key{complete and execute}{RET} \key{show possible completions}{?} \key{fetch previous minibuffer input}{M-p} \key{fetch next later minibuffer input}{M-n} \key{regexp search backward through history}{M-r} \key{regexp search forward through history}{M-s} \key{abort command}{C-g} Type \kbd{C-x ESC ESC} to edit and repeat the last command that used the minibuffer. The following keys are then defined. \key{previous minibuffer command}{M-p} \key{next minibuffer command}{M-n} \newcolumn \title{GNU Emacs Reference Card} \section{Buffers} \key{select another buffer}{C-x b} \key{list all buffers}{C-x C-b} \key{kill a buffer}{C-x k} \section{Transposing} \key{transpose {\bf characters}}{C-t} \key{transpose {\bf words}}{M-t} \key{transpose {\bf lines}}{C-x C-t} \key{transpose {\bf sexps}}{C-M-t} \section{Spelling Check} \key{check spelling of current word}{M-\$} \metax{check spelling of all words in region}{M-x ispell-region} \metax{check spelling of entire buffer}{M-x ispell-buffer} \section{Tags} \key{find a tag (a definition)}{M-.} \key{find next occurrence of tag}{C-u M-.} \metax{specify a new tags file}{M-x visit-tags-table} \metax{regexp search on all files in tags table}{M-x tags-search} \metax{run query-replace on all the files}{M-x tags-query-replace} \key{continue last tags search or query-replace}{M-,} \section{Shells} \key{execute a shell command}{M-!} \key{run a shell command on the region}{M-|} \key{filter region through a shell command}{C-u M-|} \metax{start a shell in window \kbd{*shell*}}{M-x shell} \section{Rectangles} \key{copy rectangle to register}{C-x r r} \key{kill rectangle}{C-x r k} \key{yank rectangle}{C-x r y} \key{open rectangle, shifting text right}{C-x r o} \key{blank out rectangle}{C-x r c} \key{prefix each line with a string}{C-x r t} \section{Abbrevs} \key{add global abbrev}{C-x a g} \key{add mode-local abbrev}{C-x a l} \key{add global expansion for this abbrev}{C-x a i g} \key{add mode-local expansion for this abbrev}{C-x a i l} \key{explicitly expand abbrev}{C-x a e} \key{expand previous word dynamically}{M-/} \section{Regular Expressions} \key{any single character except a newline}{. {\rm(dot)}} \key{zero or more repeats}{*} \key{one or more repeats}{+} \key{zero or one repeat}{?} \key{any character in the set}{[ {\rm$\ldots$} ]} \key{any character not in the set}{[^ {\rm$\ldots$} ]} \key{beginning of line}{^} \key{end of line}{\$} \key{quote a special character {\it c\/}}{\\{\it c}} \key{alternative (``or'')}{\\|} \key{grouping}{\\( {\rm$\ldots$} \\)} \key{{\it n\/}th group}{\\{\it n}} \key{beginning of buffer}{\\`} \key{end of buffer}{\\'} \key{word break}{\\b} \key{not beginning or end of word}{\\B} \key{beginning of word}{\\<} \key{end of word}{\\>} \key{any word-syntax character}{\\w} \key{any non-word-syntax character}{\\W} \key{character with syntax {\it c}}{\\s{\it c}} \key{character with syntax not {\it c}}{\\S{\it c}} \section{Registers} \key{save region in register}{C-x r s} \key{insert register contents into buffer}{C-x r i} \key{save value of point in register}{C-x r SPC} \key{jump to point saved in register}{C-x r j} \section{Info} \key{enter the Info documentation reader}{C-h i} \beginindentedkeys Moving within a node: \key{scroll forward}{SPC} \key{scroll reverse}{DEL} \key{beginning of node}{. {\rm (dot)}} Moving between nodes: \key{{\bf next} node}{n} \key{{\bf previous} node}{p} \key{move {\bf up}}{u} \key{select menu item by name}{m} \key{select {\it n\/}th menu item by number (1--9)}{{\it n}} \key{follow cross reference (return with \kbd{l})}{f} \key{return to last node you saw}{l} \key{return to directory node}{d} \key{go to any node by name}{g} Other: \key{run Info {\bf tutorial}}{h} \key{list Info commands}{?} \key{{\bf quit} Info}{q} \key{search nodes for regexp}{s} \endindentedkeys \section{Keyboard Macros} \key{{\bf start} defining a keyboard macro}{C-x (} \key{{\bf end} keyboard macro definition}{C-x )} \key{{\bf execute} last-defined keyboard macro}{C-x e} \key{append to last keyboard macro}{C-u C-x (} \metax{name last keyboard macro}{M-x name-last-kbd-macro} \metax{insert Lisp definition in buffer}{M-x insert-kbd-macro} \section{Commands Dealing with Emacs Lisp} \key{eval {\bf sexp} before point}{C-x C-e} \key{eval current {\bf defun}}{C-M-x} \metax{eval {\bf region}}{M-x eval-region} \metax{eval entire {\bf buffer}}{M-x eval-current-buffer} \key{read and eval minibuffer}{M-ESC} \key{re-execute last minibuffer command}{C-x ESC ESC} \metax{read and eval Emacs Lisp file}{M-x load-file} \metax{load from standard system directory}{M-x load-library} \section{Simple Customization} % The intended audience here is the person who wants to make simple % customizations and knows Lisp syntax. Here are some examples of binding global keys in Emacs Lisp. Note that you cannot say \kbd{"\\M-\#"}; you must say \kbd{"\\e\#"}. \beginexample% (global-set-key "\\C-cg" 'goto-line) (global-set-key "\\C-x\\C-k" 'kill-region) (global-set-key "\\e\#" 'query-replace-regexp) \endexample An example of setting a variable in Emacs Lisp: \beginexample% (setq backup-by-copying-when-linked t) \endexample \section{Writing Commands} \beginexample% (defun \ (\) "\" (interactive "\